diff --git a/s7/LICENSE b/s7/LICENSE
new file mode 100644
index 0000000..0d4b05b
--- /dev/null
+++ b/s7/LICENSE
@@ -0,0 +1 @@
+0-clause BSD
\ No newline at end of file
diff --git a/s7/README.md b/s7/README.md
new file mode 100644
index 0000000..27b92ae
--- /dev/null
+++ b/s7/README.md
@@ -0,0 +1,33 @@
+# s7
+
+s7 is a Scheme interpreter.
+
+[documentation](https://ccrma.stanford.edu/software/snd/snd/s7.html)
+
+[git repository](https://cm-gitlab.stanford.edu/bil/s7.git)
+  if you get a certificate complaint: git config --global http.sslVerify false
+
+[daily tarball](https://ccrma.stanford.edu/software/s7/s7.tar.gz)
+
+[mailing list](http://ccrma-mail.stanford.edu/mailman/listinfo/cmdist)
+
+[mailing list archive](https://cm-mail.stanford.edu/pipermail/cmdist/)
+
+[svn site (Snd)](https://sourceforge.net/p/snd/svn1/)
+
+[scheme-for-max](https://github.com/iainctduncan/scheme-for-max) and [scheme-for-pd](https://github.com/iainctduncan/scheme-for-pd) (Iain Duncan)
+
+[radium](https://users.notam02.no/~kjetism/radium/) (Kjetil Matheussen)
+
+[SchemeMosaic](http://xelf.me/scheme-mosaic.html) (David O'Toole)
+
+[libs7](https://github.com/obazl/libs7/) (Gregg Reynolds)
+
+[Common Music](http://commonmusic.sourceforge.net/) (Rick Taube)
+
+docker container: docker run -it schemers/s7:head (Lassi Kortela)
+
+[web assembly](https://github.com/actonDev/s7-playground/) (Christos Vagias)
+  also (https://github.com/iainctduncan/s7-wasm) (Iain Duncan)
+
+[the original](https://en.wikipedia.org/wiki/Sunbeam_S7_and_S8)
diff --git a/s7/case.scm b/s7/case.scm
new file mode 100644
index 0000000..b715caa
--- /dev/null
+++ b/s7/case.scm
@@ -0,0 +1,661 @@
+;;; case extension including pattern matching
+;;;
+;;;   The nomenclature of r7rs is (case key ((datum...) expression...)),
+;;;     but I prefer "selector" to "key", "target" to "datum", and "body" to "expression".
+;;;
+;;;   any target not a list, vector, or pattern descriptor (see below) is matched with equivalent?
+;;;   pattern descriptors are of the form #< whatever >
+;;;
+;;;     #<>           any expr matches
+;;;     #<func>       expr matches if (func expr)
+;;;     #<label:func> expr matches as above, expr is saved under "label"
+;;;     #<label:>     any expr matches, and is saved under "label"
+;;;     #<label>      expr must match value saved under "label"
+;;;     #<...>        skip exprs covered by the ellipsis
+;;;     #<label:...>  skip as above, saved skipped exprs under "label" as a quoted list
+;;;                   a pattern can have any number of labelled ellipses overall, but just one unnamed ellipsis, and only one ellipsis per pair or vector
+;;;     #<label,func:...> labelled ellipsis which matches if (func expr) -- expr is the ellipsis list
+;;;                   label is not optional in this case
+;;;     #<"regexp">   pattern is a regular expression to be matched against a string
+;;;     #<label:"regexp"> labelled string that matches regexp
+;;;
+;;;   lists and vectors are matched item by item, other sequences are matched directly via equivalent?
+;;;   if a label occurs in the result body, the expression it labelled is substituted for it
+;;;   the labels and case*'s matching function can be used anywhere -- see below, "match?" etc
+;;;
+;;;   (case* x ((3.14) 'pi)) returns 'pi if x is 3.14
+;;;   (case* "asdf" (("asde") 0) (("asdf") 1) (else 2)) is 1
+;;;   (case* "asdf" ((#<"asd*">) 0) (("asdf") 1) (else 2)) is 0
+;;;   (case* x ((#<symbol?>))) returns #t if x is a symbol
+;;;   (case* x (((+ 1 #<symbol?>)))) matches if x is any list of the form '(+ 1 x) or any other symbol in place of "x"
+;;;   (case* x (((#<symbol?> #<e1:...> (+ #<e2:...>))) (append #<e1> #<e2>))), passed '(a b c d (+ 1 2)), returns '(b c d 1 2)
+
+(provide 'case.scm)
+(unless (provided? 'windows) 
+  (require libc.scm))
+
+(define case* 
+  (let ((case*-labels (lambda (label)
+			(let ((labels ((funclet ((funclet 'case*) 'case*-helper)) 'labels)))
+			  (labels (symbol->string label))))) ; if ellipsis, this has been quoted by case*
+	
+	(case*-match? (lambda* (matchee pattern (e (curlet)))
+			(let ((matcher ((funclet ((funclet 'case*) 'case*-helper)) 'handle-sequence)))
+			  (or (equivalent? matchee pattern)
+			      (and (or (pair? matchee) 
+				       (vector? matchee))
+				   (begin
+				     (fill! ((funclet ((funclet 'case*) 'case*-helper)) 'labels) #f) ; clear labels
+				     ((matcher pattern e) matchee)))))))
+	(case*-helper
+	 (with-let (unlet)
+	   (define labels (make-hash-table))
+
+	   (define (ellipsis? pat)
+	     (and (undefined? pat)
+		  (or (equal? pat #<...>)
+		      (let ((str (object->string pat)))
+			(and (char-position #\: str)
+			     (string=? "...>" (substring str (- (length str) 4))))))))
+	     
+	   (define (ellipsis-pair-position pos pat)
+	     (and (pair? pat)
+		  (if (ellipsis? (car pat))
+		      pos
+		      (ellipsis-pair-position (+ pos 1) (cdr pat)))))
+
+	   (define (ellipsis-vector-position pat vlen)
+	     (let loop ((pos 0))
+	       (and (< pos vlen)
+		    (if (ellipsis? (pat pos))
+			pos
+			(loop (+ pos 1))))))
+
+	   (define (splice-out-ellipsis sel pat pos e)
+	     (let ((sel-len (length sel))
+		   (new-pat-len (- (length pat) 1))
+		   (ellipsis-label (and (not (eq? (pat pos) #<...>))              
+					(let* ((str (object->string (pat pos)))
+					       (colon (char-position #\: str)))
+					  (and colon
+					       (substring str 2 colon))))))
+	       (let ((func (and (string? ellipsis-label)
+				(let ((comma (char-position #\, ellipsis-label)))
+				  (and comma
+				       (let ((str (substring ellipsis-label (+ comma 1))))
+					 (set! ellipsis-label (substring ellipsis-label 0 comma))
+					 (let ((func-val (symbol->value (string->symbol str) e)))
+					   (if (undefined? func-val)
+					       (error 'unbound-variable "function ~S is undefined\n" func))
+					   (if (not (procedure? func-val))
+					       (error 'wrong-type-arg "~S is not a function\n" func))
+					   func-val)))))))
+		 (if (pair? pat)
+		     (cond ((= pos 0)               ; ellipsis at start of pattern
+			    (if ellipsis-label
+				(set! (labels ellipsis-label) 
+				      (list 'quote (copy sel (make-list (- sel-len new-pat-len))))))
+			    (values (list-tail sel (- sel-len new-pat-len))
+				    (cdr pat)
+				    (or (not func)
+					(func (cadr (labels ellipsis-label)))))) ; value is (quote ...) and we want the original list here
+			   
+			   ((= pos new-pat-len)     ; ellipsis at end of pattern
+			    (if ellipsis-label
+				(set! (labels ellipsis-label) 
+				      (list 'quote (copy sel (make-list (- sel-len pos)) pos))))
+			    (values (copy sel (make-list pos))
+				    (copy pat (make-list pos))
+				    (or (not func) 
+					(func (cadr (labels ellipsis-label))))))
+			   
+			   (else                    ; ellipsis somewhere in the middle
+			    (let ((new-pat (make-list new-pat-len))
+				  (new-sel (make-list new-pat-len)))
+			      (if ellipsis-label
+				  (set! (labels ellipsis-label) 
+					(list 'quote (copy sel (make-list (- sel-len new-pat-len)) pos))))
+			      (copy pat new-pat 0 pos)
+			      (copy pat (list-tail new-pat pos) (+ pos 1))
+			      (copy sel new-sel 0 pos)
+			      (copy sel (list-tail new-sel pos) (- sel-len pos))
+			      (values new-sel new-pat
+				      (or (not func) 
+					  (func (cadr (labels ellipsis-label))))))))
+		     
+		     (cond ((= pos 0)
+			    (if ellipsis-label
+				(set! (labels ellipsis-label) 
+				      (list 'quote (copy sel (make-list (- sel-len new-pat-len))))))
+			    (values (subvector sel (max 0 (- sel-len new-pat-len)) sel-len) ; was new-pat-len (max 0 (- sel-len new-pat-len))
+				    (subvector pat 1 (+ new-pat-len 1))                     ;     new-pat-len 1
+				    (or (not func) 
+					(func (cadr (labels ellipsis-label))))))
+			   
+			   ((= pos new-pat-len)
+			    (if ellipsis-label
+				(set! (labels ellipsis-label) 
+				      (list 'quote (copy sel (make-list (- sel-len new-pat-len)) pos))))
+			    (values (subvector sel 0 new-pat-len)
+				    (subvector pat 0 new-pat-len)
+				    (or (not func) 
+					(func (cadr (labels ellipsis-label))))))
+			   
+			   (else
+			    (let ((new-pat (make-vector new-pat-len))
+				  (new-sel (make-vector new-pat-len)))
+			      (if ellipsis-label
+				  (set! (labels ellipsis-label) 
+					(list 'quote (copy sel (make-list (- sel-len new-pat-len)) pos))))
+			      (copy pat new-pat 0 pos)
+			      (copy pat (subvector new-pat pos new-pat-len) (+ pos 1))       ; (- new-pat-len pos) pos)   copy: (+ pos 1))
+			      (copy sel new-sel 0 pos)
+			      (copy sel (subvector new-sel pos new-pat-len) (- sel-len pos))
+			                                                                     ; (- new-pat-len pos) pos)  copy: (- sel-len pos))
+			      (values new-sel new-pat
+				      (or (not func) 
+					  (cadr (func (labels ellipsis-label))))))))))))
+	     
+	   (define handle-regex
+	     (let ((rg ((*libc* 'regex.make))) ; is this safe?
+		   (local-regcomp (*libc* 'regcomp))
+		   (local-regerror (*libc* 'regerror))
+		   (local-regexec (*libc* 'regexec))
+		   (local-regfree (*libc* 'regfree)))
+	       (lambda (reg)
+		 (lambda (x)
+		   (and (string? x)
+			(let ((res (local-regcomp rg (substring reg 1 (- (length reg) 1)) 0)))
+			  (unless (zero? res)
+			    (error 'regex-error "~S~%" (local-regerror res rg)))
+			  (set! res (local-regexec rg x 0 0))
+			  (local-regfree rg)
+			  (zero? res)))))))
+
+	   (define (undefined->function undef e)   ; handle the pattern descriptor ("undef") of the form #< whatever >, "e" = caller's curlet
+	     (let* ((str1 (object->string undef))
+		    (str1-end (- (length str1) 1)))
+	       (if (not (char=? (str1 str1-end) #\>))
+		   (error 'wrong-type-arg "pattern descriptor does not end in '>': ~S\n" str1))
+	       (let ((str (substring str1 2 str1-end)))
+		 (if (= (length str) 0)                                           ; #<> = accept anything
+		     (lambda (x) #t)
+		     (let ((colon (char-position #\: str)))
+		       (cond (colon                                               ; #<label:...> might be #<label:> or #<label:func>
+			      (let ((label (substring str 0 colon))               ; str is label:...
+				    (func (substring str (+ colon 1))))           ; func might be ""
+				(cond ((labels label)                             ; see if we already have saved something under this label
+				       (lambda (sel)                              ;   if so, return function that will return an error
+					 (error 'syntax-error "label ~S is defined twice: old: ~S, new: ~S~%" label (labels label) sel)))
+				      
+				      ;; otherwise the returned function needs to store the current sel-item under label in labels
+				      ((zero? (length func))
+				       (lambda (x)
+					 (set! (labels label) x)                  ; #<label:>, set label, accept anything
+					 #t))
+				      
+				      ((char=? (func 0) #\")                      ; labelled regex, #<label:"regexp">
+				       (lambda (x)
+					 (set! (labels label) x)
+					 (handle-regex func)))
+				      
+				      (else                                       ; #<label:func>
+				       (let ((func-val (symbol->value (string->symbol func) e)))
+					 (if (undefined? func-val)
+					     (error 'unbound-variable "function ~S is undefined\n" func)
+					     (if (not (procedure? func-val))
+						 (error 'wrong-type-arg "~S is not a function\n" func)
+						 (lambda (x)                     ; set label and call func
+						   (set! (labels label) x)
+						   (func-val x)))))))))
+			     
+			     ;; if no colon either #<label> or #<func> or #<"regexp"> -- label means match its saved expr, func = call func
+			     ((char=? (str 0) #\")
+			      (handle-regex str))
+			     
+			     (else                                                ; #<label> or #<func>
+			      (let ((saved (labels str)))
+				(if saved                                         ; #<label>
+				    (lambda (x) (equivalent? x saved))
+				    (symbol->value (string->symbol str) e)))))))))) ; #<func> using curlet=e passed in above
+	   
+	   (define (handle-pattern sel-item pat-item e)
+	     (and (undefined? pat-item)      ; turn #<func> into func and call it on the current selector element
+		  (not (eq? pat-item #<undefined>))
+		  (let ((func (undefined->function pat-item e)))
+		    (if (undefined? func)
+			(error 'unbound-variable "function ~S is undefined\n" pat-item))
+		    (if (not (procedure? func))
+			(error 'wrong-type-arg "~S is not a function\n" func))
+		    (func sel-item))))
+
+	   (define (handle-sequence pat e)
+	     (lambda (sel)
+	       ;(format *stderr* "~S ~S~%" sel pat)
+	       (and (eq? (type-of sel) (type-of pat))
+		    (let ((func-ok #t))
+
+		      (when (or (pair? pat)                           ; look for ellipsis
+				(vector? pat))
+			(if (pair? (cyclic-sequences pat))
+			    (error 'wrong-type-arg "case* pattern is cyclic: ~S~%" pat))
+			(let ((pos (if (pair? pat)
+				       (ellipsis-pair-position 0 pat)
+				       (ellipsis-vector-position pat (length pat)))))
+			  (when (and pos
+				     (>= (length sel) (- (length pat) 1))) ; else pat without ellipsis is too long for sel
+			    (let ((new-vars (list (splice-out-ellipsis sel pat pos e))))
+			      (set! sel (car new-vars))
+			      (set! pat (cadr new-vars))
+			      (set! func-ok (caddr new-vars))))))
+
+		      (and (= (length sel) (length pat))             ; march through selector and current target matching elements
+			   func-ok
+			   (call-with-exit
+			    (lambda (return)
+			      (for-each 
+			       (lambda (sel-item pat-item)
+				 (or (equivalent? sel-item pat-item) ; items match
+
+				     (and (or (pair? pat-item)       ; recursive check (* (+ #<symbol?> 1) 2), pat-item: (+ #symbol?> 1)
+					      (vector? pat-item))    ; pat-item, not sel-item here so pat-item can cover anything (a list for example)
+					  ((handle-sequence pat-item e) sel-item))
+
+				     (handle-pattern sel-item pat-item e)
+
+				     (return #f)))                   ; else give up (selector does not match target)
+			       sel pat)
+			      
+			      ;; dotted list, check final cdr
+			      (unless (or (not (pair? sel)) 
+					  (proper-list? sel))
+				(let ((sel-item (list-tail sel (abs (length sel))))
+				      (pat-item (list-tail pat (abs (length pat)))))
+				  (return (or (equivalent? sel-item pat-item)
+					      (handle-pattern sel-item pat-item e)))))
+				      
+			      #t)))))))
+
+	   (define (find-labelled-pattern tree)
+	     ;; walk body looking for a labelled pattern
+	     (or (undefined? tree)
+		 (and (pair? tree)
+		      (or (find-labelled-pattern (car tree))
+			  (find-labelled-pattern (cdr tree))))
+		 (and (vector? tree)
+		      (let vector-walker ((pos 0))
+			(and (< pos (length tree))
+			     (or (undefined? (tree pos))
+				 (and (pair? (tree pos))
+				      (find-labelled-pattern (tree pos)))
+				 (and (vector? (tree pos))
+				      (vector-walker (tree pos)))
+				 (vector-walker (+ pos 1))))))))
+
+	   (define (handle-body select body return e)
+	     (if (null? body)
+		 (return select))
+
+	     (when (find-labelled-pattern body) ; if labelled, remake the body substituting the labelled-exprs for the labels
+	       (set! body (let pair-builder ((tree body))
+			    (cond ((undefined? tree)
+				   (let ((label (let ((str (object->string tree)))
+						  (substring str 2 (- (length str) 1)))))
+				     (or (labels label) tree)))
+				  
+				  ((pair? tree)
+				   (cons (pair-builder (car tree))
+					 (pair-builder (cdr tree))))
+				  
+				  ((vector? tree)
+				   (vector (map pair-builder tree)))
+				  
+				  (else tree)))))
+		 
+	     ;; evaluate the result (case* expands into a call on case*-helper; we need to evaluate the result expressions ourselves)
+	     (return (eval (if (null? (cdr body))
+			       (car body)
+			       (if (eq? (car body) '=>)
+				   (list (cadr body) select)
+				   (cons 'begin body)))
+			   e)))
+		
+	   ;; case*-helper
+	   (lambda (select clauses e)
+	     (call-with-exit
+	      (lambda (return)
+		(for-each
+		 (lambda (clause)                                        ;((target...) body...)
+		   (let ((targets (car clause))
+			 (body (cdr clause)))
+		     (fill! labels #f)                                   ; clear previous labels
+		     (if (memq targets '(else #t))                       ; (else...) or (#t...)
+			 (return (eval (cons 'begin body) e))
+			 (for-each
+			  (lambda (target)
+			    (if (or (equivalent? target select)
+				    (and (undefined? target)              ; #<...>
+					 (not (eq? target #<undefined>))
+					 (let ((func (undefined->function target e)))
+					   ;(format *stderr* "func: ~S~%" func)
+					   ;; (if (undefined? func) (error 'unbound-variable "function ~A is undefined\n" str))
+					   ;; not the above check because we want to be able to pass patterns as selectors! (scase37 in s7test)
+					   ;;    this seems like a mistake: #<symbol?> won't work? 
+					   (and (procedure? func)
+						(func select))))
+				    (and (sequence? target)
+					 ((handle-sequence target e) select)))
+				(handle-body select body return e)))
+			  targets))))
+		 clauses)))))))
+    ;; case*
+    (#_macro (selector . clauses)
+      `(((#_funclet 'case*) 'case*-helper) ,selector ',clauses (#_curlet)))))
+
+
+;;; --------------------------------------------------------------------------------
+
+#|
+;;; there are more tests in s7test.scm
+
+(define-macro (test expr res)
+  `(let ((value ,expr))
+     (unless (equivalent? value ,res)
+       (format *stderr* "~S, expected: ~S, got: ~S~%" ',expr ,res value))))
+
+(define (scase x)
+ (case* x
+   ((a b) 'a-or-b)
+   ((1 2/3 3.0) => (lambda (a) (* a 2)))
+   ((pi) 1 123)
+   (("string1" "string2"))
+   ((#<symbol?>) 'symbol!)
+   (((+ x #<symbol?>)) 'got-list)
+   ((#(1 x 3)) 'got-vector)
+   (((+ #<>)) 'empty)
+   (((* #<x:symbol?> #<x>)) 'got-label)
+   (((#<> #<x:> #<x>)) 'repeated)
+   (((#<symbol?> #<symbol?>)) 'two)
+   (((#<x:> #<x>)) 'pair)
+   ((#(#<x:> #<x>)) 'vector)
+   ((#(#<symbol?> #<...> #<number?>)) 'vectsn)
+   ((#(#<...> #<number?>)) 'vectstart)
+   ((#(#<string?> #<char-whitespace?> #<...>)) 'vectstr)
+   (else 'oops)))
+
+(test (scase 3.0) 6.0)
+(test (scase 'pi) 123)
+(test (scase "string1") "string1")
+(test (scase "string3") 'oops)
+(test (scase 'a) 'a-or-b)
+(test (scase 'abc) 'symbol!)
+(test (scase #()) 'oops)
+(test (scase '(+ x z)) 'got-list)
+(test (scase #(1 x 3)) 'got-vector)
+(test (scase '(+ x 3)) 'oops)
+(test (scase '(+ x)) 'empty)
+(test (scase '(* z z)) 'got-label)
+(test (scase '(* z x)) 'oops)
+(test (scase '(+ (abs x) (abs x))) 'repeated)
+(test (scase '(+ (abs x) (abs y))) 'oops)
+(test (scase '(a b)) 'two)
+(test (scase '(1 1)) 'pair)
+(test (scase '(1 1 2)) 'oops)
+(test (scase #(1 1)) 'vector)
+(test (scase #(a b c 3)) 'vectsn)
+(test (scase #(1 b 2)) 'vectstart)
+(test (scase #("asdf" #\space +nan.0 #<eof>)) 'vectstr)
+(test (scase #(a 3)) 'vectsn)
+(test (scase #(1)) 'vectstart)
+(test (scase #("asdf" #\space)) 'vectstr)
+(test (scase #("asdf")) 'oops)
+
+(define (scase3 x)
+  (let ((local-func (lambda (target) (eqv? target 1))))
+    (case* x
+	   ((2 3 a) 'oops)
+	   ((#<local-func>) 'yup))))
+(test (scase3 2) 'oops)
+(test (scase3 32) #<unspecified>)
+(test (scase3 1) 'yup)
+
+(define (ecase x)
+  (case* x
+    (((#<symbol?> #<...> #<symbol?>)) 'both-symbol)
+    (((#<symbol?> #<...>)) 'car-symbol)
+    (((#<...> #<symbol?> #<symbol?>)) 'two-symbols)
+    (((#<...> #<symbol?>)) 'end-symbol)
+    (else #f)))
+
+(test (ecase '(a b 1)) 'car-symbol)
+(test (ecase '(1 2 c)) 'end-symbol)
+(test (ecase '(a 1 2 3 c)) 'both-symbol)
+(test (ecase '(1 2 3 b c)) 'two-symbols)
+
+(define (palindrome? x) ; x can be a list or a vector
+  (case* x
+    ((() (#<>) #() #(#<>)) 
+     #t)
+    (((#<x:> #<middle:...> #<x>) #(#<x:> #<middle:...> #<x>))
+     (palindrome? #<middle>))
+    (else #f)))
+
+(test (palindrome? '(a b a)) #t)
+(test (palindrome? '(a b c a)) #f)
+(test (palindrome? '(a b c b a)) #t)
+(test (palindrome? #(a b a)) #t)
+(test (palindrome? #(a b c a)) #f)
+(test (palindrome? #(a b c b a)) #t)
+
+(define (scase15 x)
+  (case* x
+    (((+ #<x:> #<x>)) (* 2 #<x>))
+    (((#<x:> #<y:>)) (list #<y> #<x>))
+    (else 'oops)))
+(test (scase15 '(1 2)) '(2 1))
+(test (scase15 '(+ 1 1)) 2)
+(test (scase15 '(+ (* 2 3) (* 2 3))) 12)
+
+(define (scase16 x)
+  (case* x
+   (((+ (* #<symbol?> 2) 3)) 0)
+   (else 1)))
+(test (scase16 '(+ (* y 2) 3)) 0)
+(test (scase16 '(+ (* y 1) 3)) 1)
+
+(define (scase17 x)
+  (let ((a1 3))
+    (case* x
+      (((+ #<add1:symbol?> (* #<mul1:number?> 2))) (+ #<mul1> (* #<add1> 2)))
+      (else 'oops))))
+(test (scase17 '(+ a1 (* 5 2))) 11)
+
+(define (case-reverse x) ; maybe the least efficient reverse ever
+  (case* x
+    (((#<>) ()) x)
+    (((#<first:> #<rest:...>))
+     (append (case-reverse #<rest>)
+	     (list (quote #<first>))))))
+(test (case-reverse '(a b c)) '(c b a))
+(test (case-reverse '(a b)) '(b a))
+
+(define (scase19 x)
+  (case* x
+    (((#<integer?> . #<symbol?>)) 'ok)
+    (else #f)))
+(test (scase19 (cons 1 'a)) 'ok)
+(test (scase19 (list 1 'a)) #f)
+
+(define (scase20 x)
+  (case* x
+   ((#(+ (* #<symbol?> 2) 3)) 0)
+   (else 1)))
+(test (scase20 #(+ (* y 2) 3)) 0)
+(test (scase20 #(+ (* y 1) 3)) 1)
+
+(define (scase21 x)
+  (let ((pair2? (lambda (p) 
+		  (= (length p) 2))))
+    (case* x
+      (((+ #<pair2?> 3)) #t)
+      (else #f))))
+(test (scase21 '(+ (abs x) 3)) #t)
+(test (scase21 '(+ (* 2 x) 3)) #f)
+
+(define (scase22 x)
+  (letrec ((symbols? 
+	    (lambda (x)
+	      (or (null? x)
+		  (and (pair? x)
+                       (symbol? (car x))
+		       (symbols? (cdr x)))))))
+  (case* x
+    ((#<symbols?>) #t)
+    (else #f))))
+(display (scase22 '(+ a b c))) (newline)
+(display (scase22 '(+ a b 3))) (newline)
+
+(define (scase23 x)
+  (let ((numeric-op? (lambda (x)
+		       (let ((func (symbol->value x)))
+			 (and (signature func)
+			      (memq (car (signature func)) '(number? complex? real? float? rational? integer? byte?)))))))
+    (case* x
+      (((#<numeric-op?> #<number?>)
+	(#<numeric-op?> #<number?> #<number?>)) #t)
+      (else #f))))
+(display (scase23 '(+ 1 2))) (newline)
+(display (scase23 '(floor 32.1))) (newline)
+(display (scase23 '(abs))) (newline)
+
+(define (scase24 x)
+  (case* x
+    (((+ #<rest:...>))
+     (+ (apply values #<rest>)))
+    (else 'oops)))
+(display (scase24 '(+ 1 2 3))) (newline)
+(display (let ((a 1) (b 2) (c 3)) (scase24 `(+ ,a ,b ,c)))) (newline)
+
+(define (scase25 x)
+  (case* x
+    (((#<symbol?> #<ellip1:...> (+ #<ellip2:...>))) (append #<ellip1> #<ellip2>))
+    (else #f)))
+(display (scase25 '(a b c d (+ 1 2)))) (newline)
+
+(define (scase26 x)
+  (case* x
+    (((if (not #<test:>) (begin #<body:...>))) (cons 'unless (cons '#<test> #<body>)))
+    (((if (not #<test:>) #<body:>))            (cons 'unless (list '#<test> '#<body>)))
+    (((if #<test:> (begin #<body:...>)))       (cons 'when (cons '#<test> #<body>)))
+    (((if #<test:> #<body:>))                  (cons 'when (list '#<test> '#<body>)))))
+
+(display (scase26 '(if (not (> i 3)) (display i)))) (newline)                   ; '(unless (> i 3) (display i))
+(display (scase26 '(if (not (> i 3)) (begin (display i) (newline))))) (newline) ; '(unless (> i 3) (display i) (newline))
+(display (scase26 '(if (> i 3) (display i)))) (newline)                         ; '(when (> i 3) (display i))
+(display (scase26 '(if (> i 3) (begin (display i) (newline))))) (newline)       ; '(when (> i 3) (display i) (newline))
+
+(define (scase27 x)
+  (let ((efunc? (lambda (x)
+		  (and (pair? x)
+		       (number? (car x))))))
+    (case* x
+      (((#<label,efunc?:...>)) #t)
+      (else #f))))
+(display (scase27 '(1 2 3))) (newline)
+(display (scase27 '(a 2 3))) (newline)
+(display (scase27 '(3))) (newline)
+(display (scase27 ())) (newline)
+
+(define (scase29 x)
+  (let ((match? ((funclet 'case*) 'case*-match?)))
+    (let ((multiplier? (lambda (x)
+			 (or (match? x '(* 1 #<integer?>))
+			     (match? x '(* 2 #<integer?>))))))
+    (case* x
+      (((+ #<integer?> #<multiplier?> #<integer?>)) #t)
+      (else #f)))))
+
+(display (scase29 '(+ 1 (* 1 2) 3))) (newline)
+(display (scase29 '(+ 1 (* 3 2) 3))) (newline)
+
+(define (scase30 x)
+  (let ((match? ((funclet 'case*) 'case*-match?)))
+    (match? x '(+ #<symbol?> 1))))
+
+(display (scase30 '(+ a 1))) (newline)
+(display (scase30 '(+ 1 1))) (newline)
+
+(define* (scase31 x (e (curlet)))
+  (let ((match? ((funclet 'case*) 'case*-match?))
+        (labels ((funclet 'case*) 'case*-labels)))
+    (and (match? x '(#<symbol?> #<ellip1:...> (+ #<ellip2:...>)))
+         (append (cadr (labels 'ellip1)) (cadr (labels 'ellip2))))))
+
+(display (scase31 '(a b c d (+ 1 2)))) (newline)
+
+(define (scase32 x)
+  (let ((match? ((funclet 'case*) 'case*-match?))
+        (labels ((funclet 'case*) 'case*-labels)))
+    (if (match? x '(if #<test:> (begin #<body:...>)))
+	(cons 'when (cons (labels 'test) (cadr (labels 'body)))))))
+
+(display (scase32 '(if (> i 3) (begin (display i) (newline))))) (newline)
+(display (scase32 '(if 32/15 (begin (display i) (newline))))) (newline)
+
+(define (scase33 x)
+  (case* x
+    ((#<"a.b">) #t)
+    (else #f)))
+
+(display (scase33 "a1b")) (newline)
+(display (scase33 "abc")) (newline)
+(display (scase33 "a123b")) (newline)
+(display (scase33 'a1b)) (newline)
+
+(define (scase34 x)
+  (case* x
+    ((#<reg:"a.b">) #<reg>)
+    (else #f)))
+
+(display (scase34 "a1b")) (newline)
+
+(define (scase35 x)
+  (let ((quotes? (lambda (x)
+		   (char-position #\" x))))
+    (case* x
+      ((#<"^dog">) 'dog0)
+      ((#<"gray\|grey">) 'graey) ; basic regex so it needs \, apparently doesn't work in OSX?
+      ((#<"h\(a\|e\)y">) 'haey) 
+      ((#<"p[ae]y">) 'paey)
+      ((#<"b[aeiou]bble">) 'bxbble)
+      ((#<"z\{3,6\}">) 'zzz)
+      ((#<"\d">) 'digit)
+      ((#<"<>">) 'brackets)
+      ((#<quotes?>) 'quotes)
+      ((#<"[^i*&2@]">) 'not-i)
+      (else #f))))
+
+(display (scase35 "dog")) (newline)
+(display (scase35 "i7+")) (newline)
+(display (scase35 "gray")) (newline)
+(display (scase35 "hay")) (newline)
+(display (scase35 "pay")) (newline)
+(display (scase35 "bubble")) (newline)
+(display (scase35 "ab0d")) (newline)
+(display (scase35 "+-<>-+")) (newline)
+(display (scase35 "zzzz")) (newline)
+(display (scase35 (string #\a #\"))) (newline)
+
+;;; for other types:
+(define (hlt x)
+  (case* (with-input-from-string (object->string x) read)
+    (((hash-table 'a #<integer?>)) 'hash-table)
+    (((inlet 'a #<integer?>)) 'inlet)
+    (else #f)))
+
+(display (hlt (inlet 'a 1))) (newline)
+(display (hlt (hash-table 'a 1))) (newline)
+
+(append (list 'float-vector) (vector->list #r(1 2 3))): (float-vector 1.0 2.0 3.0)
+
+|#
diff --git a/s7/cload.scm b/s7/cload.scm
new file mode 100644
index 0000000..f36f9d9
--- /dev/null
+++ b/s7/cload.scm
@@ -0,0 +1,800 @@
+(provide 'cload.scm)
+
+;;; --------------------------------------------------------------------------------
+;;; automatically link a C function into s7 (there are a bunch of examples below)
+;;;     (c-define '(double j0 (double)) "m" "math.h")
+;;; means link the name m:j0 to the math library function j0 passing a double arg and getting a double result (reals in s7)
+;;;
+;;; (c-define c-info prefix headers cflags ldflags)
+;;;    prefix is some arbitrary prefix (it can be "") that you want prepended to various names.
+;;;    headers is a list of headers (as strings) that the c-info relies on, (("math.h") for example).
+;;;    cflags are any special C compiler flags that are needed ("-I." in particular).
+;;;    ldflags is the similar case for the loader.
+;;;    c-info is a list that describes the C entities that you want to tie into s7.
+;;;       it can be either one list describing one entity, or a list of such lists.
+;;;       Each description has the form: (return-type entity-name-in-C (argument-type...))
+;;;       where each entry is a symbol, and C names are used throughout.  So, in the j0
+;;;       example above, (double j0 (double)) says we want access to j0, it returns
+;;;       a C double, and takes one argument, also a C double.  s7 tries to figure out 
+;;;       what the corresponding s7 type is, but in tricky cases, you should tell it
+;;;       by replacing the bare type name with a list: (C-type underlying-C-type).  For example,
+;;;       the Snd function set_graph_style takes an (enum) argument of type graph_style_t.
+;;;       This is actually an int, so we use (graph_style_t int) as the type:
+;;;         (void set_graph_style ((graph_style_t int)))
+;;;       If the C entity is a constant, then the descriptor list has just two entries,
+;;;       the C-type and the entity name: (int F_OK) for example. The entity name can also be a list 
+;;;       (an enum listing for example).
+;;;       If the C type has a space ("struct tm*" for example), use (symbol "struct tm*") 
+;;;       to construct the corresponding symbol.
+;;;    The entity is placed in the current s7 environment under the name (string-append prefix ":" name)
+;;;    where the ":" is omitted if the prefix is null.  So in the j0 example, we get in s7 the function m:j0.
+;;;
+;;; some examples:
+;;;
+;;;  (c-define '((double j0 (double)) 
+;;;              (double j1 (double)) 
+;;;              (double erf (double)) 
+;;;              (double erfc (double))
+;;;              (double lgamma (double)))
+;;;             "m" "math.h")
+;;; 
+;;;
+;;; (c-define '(char* getenv (char*)))
+;;; (c-define '(int setenv (char* char* int)))
+;;; (define get-environment-variable (let () (c-define '(char* getenv (char*))) getenv))
+;;;
+;;; (define file-exists? (let () (c-define '((int F_OK) (int access (char* int))) "" "unistd.h") (lambda (arg) (= (access arg F_OK) 0))))
+;;; (define delete-file (let () (c-define '(int unlink (char*)) "" "unistd.h") (lambda (file) (= (unlink file) 0)))) ; 0=success, -1=failure
+;;;
+;;;
+;;; these pick up Snd stuff:
+;;;   (c-define '(char* version_info ()) "" "snd.h" "-I.")
+;;;   (c-define '(mus_float_t mus_degrees_to_radians (mus_float_t)) "" "snd.h" "-I.")
+;;;
+;;;   (c-define '(snd_info* any_selected_sound ()) "" "snd.h" "-I.")
+;;;   (c-define '(void select_channel (snd_info* int)) "" "snd.h" "-I.")
+;;;   (c-define '(((graph_style_t int) (GRAPH_LINES GRAPH_DOTS GRAPH_FILLED GRAPH_DOTS_AND_LINES GRAPH_LOLLIPOPS)) 
+;;;               (void set_graph_style ((graph_style_t int)))) 
+;;;             "" "snd.h" "-I.")
+;;;   
+;;;
+;;;  (c-define '(char* getcwd (char* size_t)) "" "unistd.h")
+;;;    :(let ((str (make-string 32))) (getcwd str 32) str)
+;;;    "/home/bil/cl\x00                   "
+;;;    so it works in a sense -- there is a memory leak here
+;;; 
+;;;
+;;; (c-define (list '(time_t* calloc (size_t size_t))
+;;;		    '(void free (time_t*))
+;;;		    '(void time (time_t*))
+;;;		    (list (symbol "struct tm*") 'localtime '(time_t*))
+;;;                 (list 'size_t 'strftime (list 'char* 'size_t 'char* (symbol "struct tm*"))))
+;;;          "" "time.h")
+;;;   > (let ((p (calloc 1 8)) (str (make-string 32))) 
+;;;       (time p) (let ((bytes (strftime str 32 "%a %d-%b-%Y %H:%M %Z" (localtime p)))) (free p) (substring str 0 bytes)))
+;;;   "Sat 11-Aug-2012 08:55 PDT
+;;;
+;;;
+;;; (c-define '((int closedir (DIR*))
+;;; 	        (DIR* opendir (char*))
+;;; 		(in-C "static char *read_dir(DIR *p) \
+;;;                    {                             \
+;;;                      struct dirent *dirp;         \
+;;;                      dirp = readdir(p);           \
+;;;                      if (!dirp) return(NULL);     \
+;;;                      else return(dirp->d_name);   \
+;;;                     }")
+;;; 	        (char* read_dir (DIR*)))
+;;;   "" '("sys/types.h" "dirent.h"))
+;;; 
+;;; (define (memory-usage)
+;;;   (with-let *libc*
+;;;     (let ((v (rusage.make))) 
+;;;       (getrusage RUSAGE_SELF v)
+;;;       (let ((mem (rusage.ru_maxrss v))) 
+;;;         (free v) 
+;;;         (* 1024 mem)))))
+;;; --------------------------------------------------------------------------------
+
+(define *cload-cflags* (if (provided? 'clang) "-fPIC" ""))
+(define *cload-ldflags* "")
+(unless (defined? '*cload-directory*)
+  (define *cload-directory* ""))
+(unless (defined? '*cload-library-name*)
+  (define *cload-library-name* #f))
+
+(define *cload-c-compiler* ;(if (provided? 'tcc)  ; how to get tcc to write a .so file?
+			       ;"tcc"
+			       (if (and (provided? 'gcc) 
+					(not (provided? 'openbsd))) 
+				   "gcc"
+				   (if (provided? 'clang) 
+				       "clang"
+				       "cc")));)
+
+(define-macro (defvar name value) 
+  `(if (not (defined? ',name)) 
+       (define ,name ,value)))
+
+(defvar c-define-output-file-counter 0)   ; ugly, but I can't find a way around this (dlopen/dlsym stupidity)
+
+
+;;; to place the new function in the caller's current environment, we need to pass the environment in explicitly:
+(define-macro (c-define . args) 
+  (cons 'c-define-1 (cons '(curlet) args)))
+
+
+(define* (c-define-1 cur-env function-info (prefix "") (headers ()) (cflags "") (ldflags "") output-name)
+  ;; write a C shared library module that links in the functions in function-info
+  ;;    function info is either a list: (return-type c-name arg-type) or a list thereof
+  ;;    the new functions are placed in cur-env
+
+  (define handlers (list '(integer s7_is_integer s7_integer s7_make_integer s7_int)
+			 '(boolean s7_is_boolean s7_boolean s7_make_boolean bool)
+			 '(real s7_is_real s7_number_to_real_with_caller s7_make_real s7_double)
+
+			 ;; '(complex s7_is_complex #f s7_make_complex s7_Complex)
+			 ;; the typedef is around line 6116 in s7.c, but we also need s7_complex which requires the s7_Complex type
+			 ;; xen.h uses (s7_real_part(a) + s7_imag_part(a) * _Complex_I) instead since c++ won't let use define s7_Complex in s7.h
+
+			 '(string s7_is_string s7_string s7_make_string char*)
+			 (list 'character 's7_is_character 's7_character 's7_make_character (symbol "unsigned char"))
+			 '(c_pointer s7_is_c_pointer s7_c_pointer s7_make_c_pointer_with_type void*)
+			 '(s7_pointer #f #f #f s7_pointer)
+			 ))
+
+  (define (C-type->s7-type type)
+
+    (if (pair? type)                                  ; in case the type name does not make its C type obvious: (graph_style_t int)
+	(C-type->s7-type (cadr type))
+	(let ((type-name (symbol->string type)))
+	  (cond ((string-position "**" type-name)     ; any complicated C pointer is uninterpreted
+		 'c_pointer)
+
+		((string=? "s7_pointer" type-name)
+		 's7_pointer)
+		
+		((string-position "char*" type-name)  ; but not char** (caught above)
+		 'string)
+
+		((or (string-position "*" type-name)  ; float* etc
+		     (string-position "pointer" type-name))
+		 'c_pointer)
+
+		((assoc type-name '(("char" . character) 
+				    ("bool" . boolean)) string-position)
+		 => cdr)
+		
+		;; ((string-position "complex" type-name)
+		;;  'complex)                              ; double complex or complex double (mus_edot_product in clm.c uses the latter)
+
+		((or (string-position "float" type-name) 
+		     (string-position "double" type-name)) 
+		 'real)
+
+		((or (string-position "int" type-name) 
+		     (string-position "long" type-name) ; assuming not "long double" here so we need to look for it first (above)
+		     (string-position "short" type-name) 
+		     (string-position "size" type-name)
+		     (string-position "byte" type-name)) 
+		 'integer)
+
+		(#t #t)))))
+
+  (define (find-handler type choice)
+    (cond ((assq (C-type->s7-type type) handlers) => choice) (else #t)))
+
+  (define (C->s7-cast type)
+    (find-handler type (lambda (p) (list-ref p 4))))
+    
+  (define (C->s7 type)
+    (find-handler type cadddr))
+    
+  (define (s7->C type)
+    (find-handler type caddr))
+
+  (define (checker type)
+    (find-handler type cadr))
+
+  (define (signature->pl type)
+    (case type
+      ((integer?)   #\i)
+      ((boolean?)   #\b)
+      ((real?)      #\r)
+      ((float?)     #\d)
+      ((char?)      #\c)
+      ((string?)    #\s)
+      ((c-pointer?) #\x)
+      (else         #\t)))
+
+  (set! c-define-output-file-counter (+ c-define-output-file-counter 1))
+
+  (let ((file-name (string-append *cload-directory* 
+				  (if (and (> (length *cload-directory*) 0)
+					   (not (char=? (string-ref *cload-directory* (- (length *cload-directory*) 1)) #\/)))
+				      "/" "")
+				  (or output-name (format #f "temp-s7-output-~D" c-define-output-file-counter)))))
+    (let ((c-file-name (string-append file-name ".c"))
+	  (o-file-name (string-append file-name ".o"))
+	  (so-file-name (string-append file-name ".so"))
+	  (init-name (if (string? output-name)
+			 (string-append output-name "_init")
+			 (string-append "init_" (number->string c-define-output-file-counter))))
+	  (functions ())
+	  (constants ())
+	  (macros ())     ; these are protected by #ifdef ... #endif
+	  (inits ())      ; C code (a string in s7) inserted in the library initialization function
+	  (type-symbols ())
+	  (p #f)
+	  (pp (open-output-string))
+	  (int-funcs ())  ; functions guaranteed to return int
+	  (double-funcs ())  ; functions returning double, all args double
+	  (double-int-funcs ()) ; functions return double, args are (integer double)
+	  (sig-symbols (list (cons 'integer? 0) (cons 'boolean? 0) (cons 'real?  0) (cons 'float? 0) 
+			     (cons 'char? 0) (cons 'string? 0) (cons 'c-pointer? 0) (cons 't 0)))
+	  (signatures (make-hash-table)))
+      
+      (define make-signature 
+	(let ((cload->signature 
+	       (lambda* (type rtn)
+		 (case (C-type->s7-type type)
+		   ((real)      (if rtn 'float? 'real?))
+		   ((integer)   'integer?)
+		   ((string)    'string?)
+		   ((boolean)   'boolean?)
+		   ((character) 'char?)
+		   ((c_pointer) 'c-pointer?)
+		   (else #t)))))
+	  (lambda (rtn args)
+	    (let ((sig (list (cload->signature rtn #t)))
+		  (cyclic #f))
+	      (for-each
+	       (lambda (arg)
+		 (set! sig (cons (cload->signature arg) sig)))
+	       args)
+	      (let ((len (length sig)))
+		(set! sig (do ((sig sig (cdr sig)))
+			      ((not (and (pair? sig) 
+					 (pair? (cdr sig))
+					 (eq? (car sig) (cadr sig))))
+			       sig)))
+		(set! cyclic (not (= len (length sig)))))
+	      (set! sig (cons cyclic (reverse sig)))      ; need to include cyclic in key else trailing same-type args are dropped from the signature
+	      (unless (signatures sig)                    ; it's not in our collection yet
+		(let ((pl (make-string (+ (if cyclic 3 2) (length sig))))
+		      (loc (if cyclic 4 3)))
+		  (set! (pl 0) #\p) 
+		  (if cyclic
+		      (begin (set! (pl 1) #\c) (set! (pl 2) #\l) (set! (pl 3) #\_))
+		      (begin (set! (pl 1) #\l) (set! (pl 2) #\_)))
+		  (for-each 
+		   (lambda (typer)
+		     (set! (pl loc) (signature->pl typer))
+		     (let ((count (or (assq typer sig-symbols)
+				      (assq 't sig-symbols))))
+		       (set-cdr! count (+ (cdr count) 1)))
+		     (set! loc (+ loc 1)))
+		   (cdr sig))
+		  (set! (signatures sig) pl)))
+	      sig))))
+      
+      (define (initialize-c-file)
+	;; C header stuff
+	(set! p (open-output-file c-file-name))
+	(format p "#include <stdlib.h>~%")
+	(format p "#include <stdio.h>~%")
+	(format p "#include <string.h>~%")
+	(if (string? headers)
+	    (format p "#include <~A>~%" headers)
+	    (for-each
+	     (lambda (header)
+	       (format p "#include <~A>~%" header))
+	     headers))
+	(format p "#include \"s7.h\"~%~%")
+	(format p "static s7_pointer fsym, ffunc, c_pointer_string, string_string, character_string, boolean_string, real_string, complex_string, integer_string;~%"))
+      
+      (define collides?
+	(let ((all-names (hash-table)))
+	  (lambda (name)
+	    (if (hash-table-ref all-names name) 
+		(format *stderr* "~A twice?~%" name)
+		(hash-table-set! all-names name #t))
+	    name)))
+
+      (define (hyphen->space type)
+	(let* ((name (symbol->string type))
+	       (pos (char-position #\- name)))
+	  (when pos
+	    (string-set! name pos #\space)
+	    (set! pos (char-position #\- name (+ pos 1)))
+	    (if pos
+		(string-set! name pos #\space)))
+	  name))
+	    
+      (define (type->type-symbol type)
+	(cond ((assoc type type-symbols) => cdr)
+	      (else 
+	       (let ((name (symbol->string type)))
+		 (do ((len (length name))
+		      (i 0 (+ i 1)))
+		     ((= i len))
+		   (if (memv (name i) '(#\* #\- #\space)) ; "struct tm*" for example
+		       (set! (name i) #\_)))
+		 (set! name (symbol name "_symbol"))
+		 (set! type-symbols (cons (cons type name) type-symbols))
+		 name))))
+      
+      (define add-one-function 
+	(let ()
+	  (define (sig-every? f sequence)
+	    (do ((arg sequence (cdr arg)))
+		((not (and (pair? arg)
+			   (f (car arg))))
+		 (null? arg))))
+
+	  (lambda* (return-type name arg-types doc)
+	    ;; (format *stderr* "~A ~A ~A~%" return-type name arg-types): double j0 (double) for example
+	    ;; C function -> scheme
+	    (let ((func-name (symbol->string (collides? name))))
+	      (let ((num-args (length arg-types))
+		    (base-name (string-append (if (> (length prefix) 0) prefix "s7_") "_" func-name)) ; not "g" -- collides with glib
+		    (scheme-name (string-append prefix (if (> (length prefix) 0) ":" "") func-name)))
+		
+		(if (and (= num-args 1) 
+			 (eq? (car arg-types) 'void))
+		    (set! num-args 0))
+		(format pp "~%/* -------- ~A -------- */~%" func-name)
+		(format pp "static s7_pointer ~A(s7_scheme *sc, s7_pointer args)~%" base-name)
+		(format pp "{~%")
+		
+		;; get the Scheme args, check their types, assign to local C variables
+		(when (positive? num-args)
+		  (format pp "  s7_pointer p, arg;~%")
+		  (do ((i 0 (+ i 1))
+		       (type arg-types (cdr type)))
+		      ((= i num-args))
+		    (format pp "  ~A ~A_~D;~%" (hyphen->space ((if (pair? (car type)) caar car) type)) base-name i))
+		  (format pp "  p = args;~%")
+		  (do ((i 0 (+ i 1))
+		       (type arg-types (cdr type)))
+		      ((= i num-args))
+		    (let* ((nominal-type ((if (pair? (car type)) caar car) type))  ; double in the example
+			   (true-type    ((if (pair? (car type)) cadar car) type))
+			   (s7-type      (C-type->s7-type true-type)))             ; real
+		      (format pp "  arg = s7_car(p);~%")
+		      (if (eq? true-type 's7_pointer)
+			  (format pp "    ~A_~D = arg;~%" base-name i)
+			  (if (eq? s7-type 'c_pointer)
+			      (format pp "  ~A_~D = (~A)s7_c_pointer_with_type(sc, arg, ~S, __func__, ~S);~%" 
+				      base-name i 
+				      (hyphen->space nominal-type)
+				      (type->type-symbol nominal-type)  ;(symbol->string nominal-type)
+				      (if (= num-args 1) 0 (+ i 1)))
+
+			      (let ((function-name (if *cload-library-name*
+						       (string-append "(" *cload-library-name* " '" scheme-name ")")
+						       (if (> (length prefix) 0)
+							   scheme-name
+							   (substring base-name 4)))))
+				(format pp "  if (~A(arg))~%" (checker true-type))
+				(format pp "    ~A_~D = (~A)~A(~Aarg~A);~%"
+					base-name i
+					(hyphen->space nominal-type)
+					(s7->C true-type)                               ; s7_number_to_real which requires 
+					(if (memq s7-type '(boolean real))              ;   the extra sc arg
+					    "sc, " 
+					    "")
+					(if (memq s7-type '(boolean real))              ;   the extra trailing caller arg
+					    ", __func__" 
+					    ""))
+				(format pp "  else return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, ~S, ~D), ~D, arg, ~A_string));~%"
+					function-name
+					(length function-name)
+					(if (= num-args 1) 0 (+ i 1))
+					s7-type))))
+
+		      (if (< i (- num-args 1))
+			  (format pp "  p = s7_cdr(p);~%")))))
+		
+		;; return C value to Scheme
+		(if (pair? return-type) 
+		    (set! return-type (cadr return-type)))
+		(let ((return-translator (C->s7 return-type)))
+		  (format pp "  ")
+		  (if (not (eq? return-translator #t))
+		      (format pp "return("))
+		  (if (symbol? return-translator)
+		      (format pp "~A(sc, (~A)" return-translator (C->s7-cast return-type)))
+		  (format pp "~A(" func-name)
+		  (do ((i 0 (+ i 1)))
+		      ((>= i (- num-args 1)))
+		    (format pp "~A_~D, " base-name i))
+		  (if (positive? num-args)
+		      (format pp "~A_~D" base-name (- num-args 1)))
+		  (format pp ")")
+		  
+		  (if (eq? return-translator 's7_make_c_pointer_with_type)
+		      (format pp ", ~S, s7_f(sc))" (type->type-symbol return-type))
+		      (if (symbol? return-translator)
+			  (format pp ")")))
+		  (format pp (if (not (eq? return-translator #t))
+				 ");~%"
+				 ";~%  return(s7_unspecified(sc));~%"))
+		  (format pp "}~%"))
+		
+		;; add optimizer connection
+		(when (and (eq? return-type 'double)
+			   (< num-args 5)
+			   (sig-every? (lambda (p) (eq? p 'double)) arg-types)
+			   (not (defined? (symbol scheme-name) (rootlet)))) ; see below, double-funcs entry not used if already defined
+		  (let ((local-name #f))
+		    (case num-args
+		      ((0)
+		       (set! local-name "_d")
+		       (format pp "static s7_double ~A~A(void) {return(~A());}~%"
+			       func-name local-name func-name))
+		      ((1)
+		       (set! local-name "_d_d")
+		       (format pp "static s7_double ~A~A(s7_double x) {return(~A(x));}~%"
+			       func-name local-name func-name))
+		      ((2)
+		       (set! local-name "_d_dd")
+		       (format pp "static s7_double ~A~A(s7_double x1, s7_double x2) {return(~A(x1, x2));}~%"
+			       func-name local-name func-name))
+		      ((3)
+		       (set! local-name "_d_ddd")
+		       (format pp "static s7_double ~A~A(s7_double x1, s7_double x2, s7_double x3) {return(~A(x1, x2, x3));}~%"
+			       func-name local-name func-name))
+		      ((4)
+		       (set! local-name "_d_dddd")
+		       (format pp "static s7_double ~A~A(s7_double x1, s7_double x2, s7_double x3, s7_double x4) {return(~A(x1, x2, x3, x4));}~%"
+			       func-name local-name func-name)))
+		    (set! double-funcs (cons (list func-name scheme-name local-name) double-funcs))))
+
+		(when (and (memq return-type '(int size_t))        ; int (f int|double|void)
+			   (not (defined? (symbol scheme-name) (rootlet))) ; see below, int-funcs entry not used if already defined
+			   (or ;(= num-args 0)
+			    (and (= num-args 1)
+				 (memq (car arg-types) '(int size_t double)))
+			    (and (= num-args 2)
+				 (memq (car arg-types) '(int size_t))
+				 (memq (cadr arg-types) '(int size_t)))))
+		  (let ((local-name #f))
+		    (case (car arg-types)
+		      ((void)
+		       (set! local-name "_i")
+		       (format pp "static s7_int ~A~A(void) {return(~A());}~%" func-name local-name func-name))
+		      ((double)
+		       (set! local-name "_i_7d")
+		       (format pp "static s7_int ~A~A(s7_scheme *sc, s7_double x) {return(~A(x));}~%" func-name local-name func-name))
+		      ((int size_t)
+		       (if (= num-args 1)
+			   (begin
+			     (set! local-name "_i_i")
+			     (format pp "static s7_int ~A~A(s7_int i1) {return(~A(i1));}~%" func-name local-name (if (string=? func-name "abs") "llabs" func-name)))
+			   (begin
+			     (set! local-name "_i_ii")
+			     (format pp "static s7_int ~A~A(s7_int i1, s7_int i2) {return(~A(i1, i2));}~%" func-name local-name func-name)))))
+		    (set! int-funcs (cons (list func-name scheme-name local-name) int-funcs))))
+		
+		(when (and (eq? return-type 'double)
+			   (= num-args 2)
+			   (memq (car arg-types) '(int size_t))
+			   (eq? (cadr arg-types) 'double))
+		  (format pp "static s7_double ~A~A(s7_int x1, s7_double x2) {return(~A(x1, x2));}~%" func-name "_d_id" func-name)
+		  (set! double-int-funcs (cons (list func-name scheme-name "_d_id") double-int-funcs)))
+		
+		;; other possibilities: d_7pi|pii p=double* etc piid=checks in s7 (assumes float-vector)
+		;;   d_pd [lots of d_pdd, d_p, p_i and i_p]
+		;;   but how to recognize the "p" portions? (d_7pi with p="s7_pointer" gets no hits in libgsl)
+		;; libgsl: d_i: 15, d_ii: 5, [handled: d_id: 32], d_iid: 7, d_ddi: 4, d_idd: 10, d_idi: 6, i_ddd i_iii: 1, i_dddd: 4
+		
+		(format pp "~%")
+		(set! functions (cons (list scheme-name base-name 
+					    (if (and (string? doc)
+						     (> (length doc) 0))
+						doc
+						(format #f "~A ~A~A" return-type func-name arg-types))
+					    num-args 0 
+					    (make-signature return-type arg-types))
+				      functions)))))))
+      
+      (define (end-c-file)
+	(when (pair? type-symbols)
+	  (format p "static s7_pointer ")
+	  (let ((len (length type-symbols))
+		(loc 1))
+	    (for-each
+	     (lambda (sym)
+	       (format p "~A~A~A" (cdr sym) (if (< loc len) (values "," " ") (values ";" #\newline)))
+	       (set! loc (+ loc 1)))
+	     type-symbols)))
+	(newline p)
+
+	(display (get-output-string pp) p)
+	(close-output-port pp)
+
+	;; now the init function
+	;;   the new scheme variables and functions are placed in the current environment
+	
+	(format p "void ~A(s7_scheme *sc);~%" init-name)
+	(format p "void ~A(s7_scheme *sc)~%" init-name)
+	(format p "{~%")
+	(format p "  s7_pointer cur_env;~%")
+
+	(when (> (hash-table-entries signatures) 0)   ; maybe just constants (no functions)
+	  (format p "  s7_pointer ")
+	  (let ((pls (hash-table-entries signatures))
+		(loc 1))
+	    (for-each
+	     (lambda (s)
+	       (format p "~A~A~A" (cdr s) (if (< loc pls) (values "," " ") (values ";" #\newline)))
+	       (set! loc (+ loc 1)))
+	     signatures))
+	  
+	  (let ((syms ())
+		(names ()))
+	    (for-each
+	     (lambda (q)
+	       (when (positive? (cdr q))
+		 (set! syms (cons (car q) syms))
+		 (set! names (cons (signature->pl (car q)) names))))
+	     sig-symbols)
+	    (when (pair? syms)
+	      (format p "  {~%    s7_pointer ~{~C~^, ~};~%" names)
+	      (for-each
+	       (lambda (name sym)
+		 (format p (if (eq? sym 't)
+			       "    t = s7_t(sc);~%"
+			       (values "    ~C = s7_make_symbol(sc, ~S);~%" name (symbol->string sym)))))
+	       names syms)))
+	  (format p "~%")
+	  (for-each
+	   (lambda (sig)
+	     (let ((siglen (length (cdar sig)))
+		   (cyclic (char=? ((cdr sig) 1) #\c)))
+	       (format p (if cyclic 
+			     (values "    ~A = s7_make_circular_signature(sc, ~D, ~D" (cdr sig) (- siglen 1) siglen)
+			     (values "    ~A = s7_make_signature(sc, ~D" (cdr sig) siglen)))
+	       (format p "~{~^, ~C~}" (substring (cdr sig) (if cyclic 4 3)))
+	       (format p ");~%")))
+	   signatures)
+	  (format p "  }~%~%"))
+
+	(format p "  string_string = s7_make_semipermanent_string(sc, \"a string\");~%")
+	(format p "  c_pointer_string = s7_make_semipermanent_string(sc, \"a c-pointer\");~%")
+	(format p "  character_string = s7_make_semipermanent_string(sc, \"a character\");~%")
+	(format p "  boolean_string = s7_make_semipermanent_string(sc, \"a boolean\");~%")
+	(format p "  real_string = s7_make_semipermanent_string(sc, \"a real\");~%")
+	(format p "  complex_string = s7_make_semipermanent_string(sc, \"a complex number\");~%")
+	(format p "  integer_string = s7_make_semipermanent_string(sc, \"an integer\");~%")
+
+	(format p "  cur_env = s7_curlet(sc);~%") ; changed from s7_outlet(s7_curlet) 20-Aug-17
+	
+	;; send out any special initialization code
+	(for-each
+	 (lambda (init-str)
+	   (format p "  ~A~%" init-str))
+	 (reverse inits))
+
+	(when (pair? type-symbols)
+	  (newline p)
+	  (for-each
+	   (lambda (sym)
+	     (format p "  ~S = s7_make_symbol(sc, ~S);~%" (cdr sym) (symbol->string (car sym))))
+	   type-symbols))
+	
+	;; constants
+	(when (pair? constants)
+	  (format p "~%")
+	  (for-each
+	   (lambda (c)
+	     (let* ((type (c 0))
+		    (c-name (c 1))
+		    (scheme-name (string-append prefix (if (> (length prefix) 0) ":" "") c-name))
+		    (trans (C->s7 type)))
+	       (if (eq? trans 's7_make_c_pointer_with_type)
+		   (format p "  s7_define(sc, cur_env, s7_make_symbol(sc, ~S), ~A(sc, (~A)~A, s7_make_symbol(sc, ~S), s7_f(sc)));~%" 
+			   scheme-name
+			   trans
+			   (C->s7-cast type)
+			   c-name
+			   (if (eq? type 'c-pointer) "void*" (symbol->string type)))
+		   (format p "  s7_define(sc, cur_env, s7_make_symbol(sc, ~S), ~A(sc, (~A)~A));~%" 
+			   scheme-name
+			   trans
+			   (C->s7-cast type)
+			   c-name))))
+	   constants))
+	
+	;; C macros -- need #ifdef name #endif wrapper
+	(when (pair? macros)
+	  (format p "~%")
+	  (for-each
+	   (lambda (c)
+	     (let* ((type (c 0))
+		    (c-name (c 1))
+		    (scheme-name (string-append prefix (if (> (length prefix) 0) ":" "") c-name))
+		    (trans (C->s7 type)))
+	       (format p "#ifdef ~A~%" c-name)
+	       (if (eq? trans 's7_make_c_pointer_with_type)
+		   (format p "  s7_define(sc, cur_env, s7_make_symbol(sc, ~S), s7_make_c_pointer_with_type(sc, (~A)~A, s7_make_symbol(sc, \"~S\"), s7_f(sc)));~%" 
+			   scheme-name
+			   (C->s7-cast type)
+			   c-name
+			   type)
+		   (format p "  s7_define(sc, cur_env, s7_make_symbol(sc, ~S), ~A(sc, (~A)~A));~%" 
+			   scheme-name
+			   trans
+			   (C->s7-cast type)
+			   c-name))
+	       (format p "#endif~%")))
+	   macros))
+	
+	;; functions
+	(for-each
+	 (lambda (f) 
+	   (let ((scheme-name (f 0))
+		 (base-name   (f 1))
+		 (helpf       (f 2))
+		 (num-args    (f 3))
+		 (opt-args    (if (> (length f) 4) (f 4) 0))
+		 (sig         (and (> (length f) 5) (f 5))))
+	     (format p "~%  s7_define(sc, cur_env,~%            fsym = s7_make_symbol(sc, ~S),~%" scheme-name)
+	     (format p "            ffunc = s7_make_typed_function(sc, ~S, ~A, ~D, ~D, false, ~S, ~A));~%"
+		     scheme-name
+		     base-name
+		     num-args
+		     opt-args
+		     helpf
+		     (if (pair? sig) (signatures sig) 'NULL))
+	     (format p "  s7_symbol_set_initial_value(sc, fsym, ffunc);~%"))) ; not sure this is a good idea, added 24-May-24
+	 functions)
+	
+	;; optimizer connection
+	(when (pair? double-funcs)
+	  (format p "~%  /* double optimizer connections */~%")
+	  (for-each
+	   (lambda (f)
+	     (unless (defined? (symbol (cadr f)) (rootlet))
+	       (format p "  s7_set~A_function(sc, s7_name_to_value(sc, ~S), ~A~A);~%" (caddr f) (cadr f) (car f) (caddr f))))
+	   double-funcs))
+	
+	(when (pair? int-funcs)
+	  (format p "~%  /* int optimizer connections */~%")
+	  (for-each
+	   (lambda (f)
+	     (unless (defined? (symbol (cadr f)) (rootlet))
+	       (format p "  s7_set~A_function(sc, s7_name_to_value(sc, ~S), ~A~A);~%" (caddr f) (cadr f) (car f) (caddr f))))
+	   int-funcs))
+
+	(when (pair? double-int-funcs)
+	  (format p "~%  /* double-int optimizer connections */~%")
+	  (for-each
+	   (lambda (f)
+	     (unless (defined? (symbol (cadr f)) (rootlet))
+	       (format p "  s7_set~A_function(sc, s7_name_to_value(sc, ~S), ~A~A);~%" (caddr f) (cadr f) (car f) (caddr f))))
+	   double-int-funcs))
+	
+	(format p "}~%")
+	(close-output-port p)
+
+	(unless (or (file-exists? "s7.h")
+		    (not (pair? *load-path*)))
+	  (set! *cload-cflags* (append *cload-cflags* (format #f " -I~A" (car *load-path*)))))
+	
+	;; now we have the module .c file -- make it into a shared object
+	
+	(cond ((provided? 'osx)
+	       ;; I assume the caller is also compiled with these flags?
+	       (system (format #f "~A -c ~A -o ~A ~A ~A" 
+			       *cload-c-compiler* c-file-name o-file-name *cload-cflags* cflags))
+	       (system (format #f "~A ~A -o ~A -dynamic -bundle -undefined suppress -flat_namespace ~A ~A" 
+			       *cload-c-compiler* o-file-name so-file-name *cload-ldflags* ldflags)))
+	      
+	      ((provided? 'freebsd)
+	       (system (format #f "cc -fPIC -c ~A -o ~A ~A ~A" 
+			       c-file-name o-file-name *cload-cflags* cflags))
+	       (system (format #f "cc ~A -shared -o ~A ~A ~A" 
+			       o-file-name so-file-name *cload-ldflags* ldflags)))
+	      
+	      ((provided? 'openbsd)
+	       (system (format #f "~A -fPIC -c ~A -o ~A ~A ~A" 
+			       *cload-c-compiler* c-file-name o-file-name *cload-cflags* cflags))
+	       (system (format #f "~A ~A -shared -o ~A ~A ~A" 
+			       *cload-c-compiler* o-file-name so-file-name *cload-ldflags* ldflags)))
+	      
+	      ((provided? 'sunpro_c) ; just guessing here...
+	       (system (format #f "cc -c ~A -o ~A ~A ~A" 
+			       c-file-name o-file-name *cload-cflags* cflags))
+	       (system (format #f "cc ~A -G -o ~A ~A ~A" 
+			       o-file-name so-file-name *cload-ldflags* ldflags)))
+	      
+	      ((or (provided? 'mingw) (provided? 'msys2)) ; from chai xiaoxiang
+	       ;; you'll need dlfcn which can be installed with pacman, and remember to build s7 with -DWITH_C_LOADER=1
+	       ;; in msys2:  gcc s7.c -o s7 -DWITH_MAIN -DWITH_C_LOADER=1 -I. -O2 -g -ldl -lm -Wl,-export-all-symbols,--out-implib,s7.lib
+	       (system (format #f "gcc ~A s7.lib -shared -o ~A -I. ~A ~A"
+			       c-file-name so-file-name cflags ldflags)))
+	       
+	      (else ; linux netbsd
+	       (system (format #f "~A -fPIC -c ~A -o ~A ~A ~A" 
+			       *cload-c-compiler* c-file-name o-file-name *cload-cflags* cflags))
+	       (system (format #f "~A ~A -shared -o ~A ~A ~A" 
+			       *cload-c-compiler* o-file-name so-file-name *cload-ldflags* ldflags)))))
+      
+      (define handle-declaration 
+	(let ()
+	  (define (add-one-constant type name)
+	    ;; C constant -> scheme
+	    (let ((c-type (if (pair? type) (cadr type) type)))
+	      (if (symbol? name)
+		  (set! constants (cons (list c-type (symbol->string (collides? name))) constants))
+		  (for-each 
+		   (lambda (c)
+		     (set! constants (cons (list c-type (symbol->string (collides? c))) constants)))
+		   name))))
+	  
+	  (define (add-one-macro type name)
+	    ;; C macro (with definition check) -> scheme
+	    (let ((c-type (if (pair? type) (cadr type) type)))
+	      (if (symbol? name)
+		  (set! macros (cons (list c-type (symbol->string (collides? name))) macros))
+		  (for-each 
+		   (lambda (c)
+		     (set! macros (cons (list c-type (symbol->string (collides? c))) macros)))
+		   name))))
+	  
+	  (define (check-doc func-data)
+	    (let ((doc (caddr func-data)))
+	      (if (and (string? doc)
+		       (> (length doc) 0))
+		  func-data
+		  (append (list (car func-data) (cadr func-data) (car func-data)) (cdddr func-data)))))
+	  
+	  (lambda (func)
+	    ;; functions
+	    (if (pair? func)
+		(if (>= (length func) 3)
+		    (apply add-one-function func)
+		    (case (car func)
+		      ((in-C)       (format pp "~A~%" (cadr func)))
+		      ((C-init)     (set! inits (cons (cadr func) inits)))
+		      ((C-macro)    (apply add-one-macro (cadr func)))
+		      ((C-function) (collides? (caadr func)) (set! functions (cons (check-doc (cadr func)) functions)))
+		      (else         (apply add-one-constant func))))
+		(error 'wrong-type-arg "~S (func arg to handle-declaration in cload.scm) should be a pair" func)))))
+      
+      
+      ;; c-define-1 (called in c-define macro above)
+      (unless (and output-name
+		   (file-exists? c-file-name)
+		   (file-exists? so-file-name)
+		   (provided? 'system-extras)
+		   (>= (file-mtime so-file-name) (file-mtime c-file-name))
+		   (not (and (file-exists? (port-filename))
+			     (< (file-mtime so-file-name) (file-mtime (port-filename))))))
+	(format *stderr* "writing ~A~%" c-file-name)
+	;; write a new C file and compile it
+	(initialize-c-file)
+	
+	(if (and (pair? (cdr function-info))
+		 (symbol? (cadr function-info)))
+	    (handle-declaration function-info)
+	    (for-each handle-declaration function-info))
+	
+	(end-c-file)
+	(delete-file o-file-name))
+      
+      ;; load the object file, clean up
+      (varlet cur-env 'init_func (string->symbol init-name))
+      (format *stderr* "loading ~A~%" so-file-name)
+      (load so-file-name cur-env))))
+
+
+#|
+(let ((cd (symbol "complex double"))
+      (cd* (symbol "complex double *")))
+  (c-define (list cd 'mus_edot_product (list cd cd* 'int))))
+
+;complex double mus_edot_product(complex double freq, complex double *data, mus_long_t size)
+|#
diff --git a/s7/debug.scm b/s7/debug.scm
new file mode 100644
index 0000000..68a2af0
--- /dev/null
+++ b/s7/debug.scm
@@ -0,0 +1,410 @@
+(provide 'debug.scm)
+
+(let-temporarily (((*s7* 'debug) 0))          ; trace-in call should not be added to trace-in!
+
+  (define trace-in
+    (let (;; these are for external use
+	  (*debug-port* *stderr*)             ; an output port or #f
+	  (*debug-stack* #f)                  ; either a vector or #f (provides a C-style call stack)
+	  (*debug-function* #f)               ; either #f or a function of 3 arguments, the current function, the calling expression, and the current environment
+	  ;; these are normally internal
+	  (*debug-repl* (lambda (call e) #f)) ; called by break
+	  (*debug-breaks* ())                 ; list of functions with active breakpoints
+	  ;; rest are for output formatting etc
+	  (*debug-spaces* 0)                  ; indentation (when reporting result)
+	  (*debug-max-spaces* (*s7* 'max-format-length))
+	  (*debug-start-output* (lambda (p) #f))
+	  (*debug-end-output* newline)
+	  (*debug-curlet* #f)                ; currently just for debug-frame
+	  (*debug-unwatch-hook* (make-hook 'var)))
+
+      (set! (setter '*debug-spaces*) integer?)
+      (set! (setter '*debug-max-spaces*) integer?)
+      (set! (setter '*debug-breaks*) list?)
+      (set! (setter '*debug-start-output*) procedure?)
+      (set! (setter '*debug-end-output*) procedure?)
+
+      (set! (setter '*debug-port*)
+	    (lambda (s v)
+	      (if (or (output-port? v) (not v))
+		  v
+		  (error 'wrong-type-arg "~S can't be set! to ~S" s v))))
+
+      (set! (setter '*debug-stack*)
+	    (lambda (s v)
+	      (if (or (vector? v) (not v))
+		  v
+		  (error 'wrong-type-arg "~S can't be set! to ~S" s v))))
+
+      (set! (setter '*debug-function*)
+	    (lambda (s v)
+	      (if (or (not v)
+		      (and (procedure? v)
+			   (= (car (arity v)) 3)))
+		  v
+		  (error 'wrong-type-arg "~S must be #f or a procedure of 3 arguments" s))))
+
+
+      (define trace-out
+	(let ((funcname #f))
+	  (lambda (e val)              ; report value returned
+	    (let-temporarily (((*s7* 'history-enabled) #f))
+	      (set! *debug-spaces* (max 0 (- *debug-spaces* 2)))
+	      (let-temporarily (((*s7* 'openlets) #f)) ; val local object->string might cause an infinite loop
+		(format *debug-port* "~NC  -> ~S" (min *debug-spaces* *debug-max-spaces*) #\space val))
+
+	      (set! funcname (*function* e :name))
+	      (when (symbol? funcname)
+		(let ((sig (signature (symbol->value funcname e))))   ; check result type, if a signature exists
+		  (when (and (pair? sig)
+			     (not ((symbol->value (car sig)) val)))
+		    (format *debug-port* ", result is not ~S" (car sig))))))
+
+	    (*debug-end-output* *debug-port*)
+	    val)))
+
+
+      (lambda (e)                   ; trace-in: report function call and return value
+	(when (> (*s7* 'debug) 0)
+	  (let-temporarily (((*s7* 'history-enabled) #f))
+
+	    (let* ((func (*function* e))
+		   (funcname (if (pair? func) (car func) func))
+		   (args (let-temporarily (((*s7* 'debug) 0)) ; keep s7 from adding trace-in to this map function
+			   (map (let ((n 0)
+				      (func-arity (and (symbol? funcname) 
+						       (arity (symbol->value funcname e)))))   
+				  (lambda (x)
+				    (set! n (+ n 1))
+				    (if (and (symbol? funcname)
+					     (pair? x)
+					     (pair? (cdr x))
+					     (pair? func-arity)
+					     (= (cdr func-arity) 536870912)
+					     (> n (car func-arity)))
+					(apply values (cdr x))
+					(if (and (or (pair? (cdr x))
+						     (and (symbol? (cdr x))
+							  (not (keyword? (cdr x)))))
+						 (not (and func (macro? (symbol->value funcname e)))))
+					    (list 'quote (cdr x))
+					    (cdr x)))))
+				e)))
+
+		   (call (let-temporarily (((*s7* 'openlets) #f))  ; ignore local object->string methods
+			   (format #f "(~S~{~^ ~S~})"
+				   (or funcname '_)
+				   args))))
+
+	      (set! *debug-curlet* e)
+
+	      (if (vector? *debug-stack*)
+		  (vector-set! *debug-stack* (max 0 (min (- (length *debug-stack*) 1)
+							 (/ *debug-spaces* 2)))
+			       call))
+
+	      (cond ((and *debug-function*
+			  (*debug-function* func call e))) ; if it returns #f, try rest of possibilities
+
+		    ((and funcname
+			  (memq funcname *debug-breaks*))
+		     (*debug-repl* call e))
+
+		    (else
+		     (*debug-start-output* *debug-port*)
+		     (format *debug-port* "~NC~A" (min *debug-spaces* *debug-max-spaces*) #\space call)
+		     (if (pair? func)
+			 (format *debug-port* "    ; ~S: ~A[~D]" (car func) (cadr func) (caddr func)))
+		     (if (and (> (port-line-number) 0)
+			      (not (string=? (port-filename) "*stdin*"))
+			      (or (not (pair? func))
+				  (not (= (caddr func) (port-line-number)))
+				  (not (string=? (cadr func) (port-filename)))))
+			 (if (and (pair? func)
+				  (string=? (cadr func) (port-filename)))
+			     (format *debug-port* " called from line ~D?"
+				     (port-line-number))
+			     (format *debug-port* "~A called from ~A[~D]"
+				     (if (pair? func) "" "    ;")
+				     (port-filename)
+				     (port-line-number))))
+
+		     (when (symbol? funcname)
+		       (let ((sig (signature (symbol->value funcname e))))   ; check arg types, if a signature exists
+			 (when (pair? sig)
+			   (let ((ctr 1))
+			     (for-each (lambda (typer value)
+					 (when (and (symbol? typer)
+						    (not ((symbol->value typer) value)))
+					   (format *debug-port* "~%    ; ~S arg ~D not ~S" funcname ctr typer))
+					 (set! ctr (+ ctr 1)))
+				       (cdr sig) args)))))
+
+		     (newline *debug-port*)))
+	      (set! *debug-spaces* (+ *debug-spaces* 2))))
+
+	  (dynamic-unwind trace-out e)))))
+
+  (define debug-port (dilambda
+		      (lambda ()
+			((funclet trace-in) '*debug-port*))
+		      (lambda (new-port)
+			(set! ((funclet trace-in) '*debug-port*) new-port))))
+  
+  (define debug-stack (dilambda
+		       (lambda ()
+			 ((funclet trace-in) '*debug-stack*))
+		       (lambda (new-stack)
+			 ;; (set! (debug-stack) (make-vector 64 #f)) or (set! (debug-stack) #f)
+			 (set! ((funclet trace-in) '*debug-stack*) new-stack))))
+  
+  (define debug-function (dilambda
+			  (lambda ()
+			    ((funclet trace-in) '*debug-function*))
+			  (lambda (new-function)
+			    (set! ((funclet trace-in) '*debug-function*) new-function))))
+  
+  (define debug-repl (dilambda
+		      (lambda ()
+			((funclet trace-in) '*debug-repl*))
+		      (lambda (new-repl)
+			(set! ((funclet trace-in) '*debug-repl*) new-repl)))))
+
+
+;;; -------- trace
+(define-bacro* (trace (func :unset))
+  ;; a bacro because we can be called anywhere (repl top-level-let), we're being asked to trace something in that let probably,
+  ;;   but outlet(trace), if trace is a macro, is (rootlet) if (load "debug.scm"), so trace thinks func is undefined.
+  ;;   a macro might work if the entire body were returned, and a second quasiquote level used for the set!?
+  (if (eq? func :unset)
+      (set! (*s7* 'debug) 3)
+      (catch #t
+	(lambda ()
+
+	  (let ((func-val (eval func)))         ; func can be arbitrarily complex
+	   (if (not (or (procedure? func-val)
+			(macro? func-val)))
+	       (format (debug-port) "trace: ~S is not a procedure or macro" func)
+
+	       (let ((func-name (object->string func-val))
+		     ;; the name is usually a string internally, so this isn't as wasteful as it appears
+		     (source (procedure-source func-val))                        ; (lambda (x) (+ x 1))
+		     (setf (setter func-val)))                                   ; preseve possible setter
+		 (set! func-name (if (char=? (func-name 0) #\#) '_ (symbol func-name)))
+
+		 (set! (*s7* 'debug) (max 1 (*s7* 'debug))) ; not sure about this, but it's a bother to type in the repl
+
+		 (if (pair? source)
+		     (unless (and (pair? (caddr source))
+				  (eq? (caaddr source) 'trace-in))
+		       (let ((new-source (cons (car source)                      ; lambda
+					       (cons (cadr source)               ; args
+						     (cons '(trace-in (curlet))  ; (trace-in (curlet))
+							   (cddr source)))))     ; body
+			     (out (outlet (funclet func-val))))                  ; preserve possible local closure
+			 (if setf
+			     `(set! ,func (with-let ,out 
+					    (dilambda (let () 
+							(define ,func-name ,new-source))
+						      ,setf)))
+			     `(set! ,func (with-let ,out 
+					    (let () 
+					      (define ,func-name ,new-source)))))))
+		     ;; we need to use define to get the function name saved for *function* later, but
+		     ;;   we also need to clobber the old definition (not just shadow it) so that existing calls
+		     ;;   will be traced.  So, use a redundant define in a let returning its new value, setting the current one.
+
+		     (let ((old-func (gensym)))
+		       (if setf
+			   `(set! ,func (dilambda
+					 (let ()
+					   (define ,func-name
+					     (let ((,old-func ,func))
+					       (lambda args
+						 (trace-in (curlet))
+						 (apply ,old-func args)))))
+					 ,setf))
+			   `(set! ,func (let ()
+					  (define ,func-name
+					    (let ((,old-func ,func))
+					      (lambda args
+						(trace-in (curlet))
+						(apply ,old-func args)))))))))))))
+	(lambda (type info)
+	  (format (debug-port) "can't trace ~S: ~S~%" func (apply format #f info))))))
+
+
+;;; -------- untrace
+(define-bacro* (untrace (func :unset))
+  (if (eq? func :unset)
+      (set! (*s7* 'debug) 0)
+
+      (catch #t
+	(lambda ()
+
+	  (let ((func-val (eval func)))         ; func can be arbitrarily complex
+	   (if (not (or (procedure? func-val)
+			(macro? func-val)))
+	       (format (debug-port) "untrace: ~S is not a procedure or macro" func)
+
+	       (let ((func-name (symbol (object->string func-val)))
+		     (source (procedure-source func-val))
+		     (setf (setter func-val)))
+
+		 (when (and (pair? source)
+			    (pair? (caddr source))
+			    (eq? (caaddr source) 'trace-in))
+		   (let ((cdddr-source (cdddr source)))
+		     (if (and (eq? (caar cdddr-source) 'apply)
+			      (gensym? (cadar cdddr-source)))
+			 (let ((orig-func (symbol->value (cadar cdddr-source) (funclet func-val))))
+			   (if setf
+			       `(set! ,func (dilambda ,orig-func ,setf))
+			       `(set! ,func ,orig-func)))
+			 (let ((new-source (cons (car source)
+						 (cons (cadr source)
+						       cdddr-source)))
+			       (out (outlet (funclet func-val))))
+			   (if setf
+			       `(set! ,func (with-let ,out
+					      (dilambda (let ()
+							  (define ,func-name
+							    ,new-source))
+							,setf)))
+			       `(set! ,func (with-let ,out
+					      (let ()
+						(define ,func-name
+						  ,new-source)))))))))))))
+	(lambda (type info)
+	  (format (debug-port) "can't untrace ~S: ~S~%" func (apply format #f info))))))
+
+
+;;; -------- break
+(define-bacro (break func)
+  (let ((func-val (eval func)))
+    (if (not (or (procedure? func-val)
+		 (macro? func-val)))
+	(format (debug-port) "break: ~S is not a procedure or macro" func)
+	(let ((func-name (symbol (object->string func-val))))
+	  (unless (memq func-name ((funclet trace-in) '*debug-breaks*))
+	    `(begin
+	       (trace ,func)
+	       (set! ((funclet trace-in) '*debug-breaks*)
+		     (cons ',func-name 
+			   ((funclet trace-in) '*debug-breaks*)))))))))
+
+;;; -------- unbreak
+(define-bacro* (unbreak (func :unset))
+  (if (eq? func :unset)
+      (set! ((funclet trace-in) '*debug-breaks*) ())
+      (let ((func-name (symbol (object->string (eval func)))))
+	`(set! ((funclet trace-in) '*debug-breaks*)
+	       (let remove ((lst ((funclet trace-in) '*debug-breaks*)) (new-lst ()))
+		 (if (null? lst)
+		     (reverse new-lst)
+		     (remove (cdr lst)
+			     (if (eq? (car lst) ',func-name)
+				 new-lst
+				 (cons (car lst) new-lst)))))))))
+
+
+;;; -------- watch
+(define-macro (watch var)   ; notification if var set!
+  (if (pair? var)
+      `(with-let ,(car var)
+	 (set! (setter ,(cadr var))
+	       (let ((old-setter (setter ,(cadr var))))
+		 (lambda (s v e)
+		   (format (debug-port) "~S set! to ~S~%" s v)
+		   (if old-setter
+		       (if (eqv? (cdr (arity old-setter)) 2)
+			   (old-setter s v)
+			   (old-setter s v e))
+		       v)))))
+      `(set! (setter ',var)
+	     (let ((old-setter (setter ',var)))
+	       (lambda (s v e)
+		 (format (debug-port) "~S set! to ~S~%" s v)
+		 (if old-setter
+		     (if (eqv? (cdr (arity old-setter)) 2)
+			 (old-setter s v)
+			 (old-setter s v e))
+		     v))))))
+
+;;; -------- unwatch
+(define-macro (unwatch var)
+  (if (pair? var)
+      `(with-let ,(car var)
+	 (set! (setter ,(cadr var)) (with-let (funclet (setter ,(cadr var))) old-setter)) ; (cadr var) is a quoted symbol or a keyword(?)
+	 (((funclet trace-in) '*debug-unwatch-hook*) ,(cadr var)))
+      `(begin
+	 (set! (setter ',var) (with-let (funclet (setter ',var)) old-setter))
+	 (((funclet trace-in) '*debug-unwatch-hook*) ',var))))
+
+;;; -------- stack
+(define (show-debug-stack)
+  (let ((stack (debug-stack))
+	(depth ((funclet trace-in) '*debug-spaces*)))
+    (when stack
+      (format (debug-port) "~NCstack:\n" depth #\space)
+      (do ((i 0 (+ i 1)))
+	  ((or (= i (length stack))
+	       (> i (/ ((funclet trace-in) '*debug-spaces*) 2))
+	       (not (string? (vector-ref stack i)))))
+	(format (debug-port) "~NC~A~%" (+ depth 2) #\space (vector-ref stack i)))
+      ;(newline (debug-port))
+      #f)))
+
+
+;;; -------- debug-frame
+(define (debug-frame n)
+  (do ((p ((funclet trace-in) '*debug-curlet*) (outlet p))
+       (i 0 (+ i 1)))
+      ((or (= i n) (not (let? p)))
+       (format (debug-port) "~S~%" p))))
+
+
+#|
+;; trace with a function to call at the trace point, rather than trace-in's code
+(set! (debug-function) (lambda (func call e) ...)) ; return #f to include normal tracing
+
+;; trace one function specially:
+(set! (debug-function)
+      (lambda (func call e)             ; if this returns #f, trace-in goes on as normally
+        (and (eq? func desired-func)
+             ... 
+             #t)))
+
+;; break one function specially, or break-if: this is as above but (*debug-repl* call e)
+
+;; log trace info
+(call-with-output-file "test.log"
+  (lambda (port)
+    (let-temporarily (((debug-port) port))
+      ...)))
+
+;; debug-stack in s7_error if debug.scm loaded, debug>1 and stack exists
+;;   if sc->debug>1, we know trace-in is loaded, so closure_let(symbol->value(sc, make_symbol(sc, "trace-in"))) has *debug-stack* etc
+
+;; in motif-snd, break does not stop or give the right prompt, but curlet is correct??
+;;   (load "debug.scm")
+;;     #<lambda (call e)>
+;;   (set! (*s7* 'debug) 1)
+;;     1
+;;   (define (g1 x)  (+ x 1))
+;;     g1
+;;   (break g1)
+;;     (g1)
+;;   (g1 2)  -> 3
+;;     3
+;;   (curlet)
+;;     (inlet 'x 2)
+;; nogui-snd does work (it's repl.scm based)
+;; watching for c-q via dynamic-unwind does not work right, tmp/snd-xen.c
+;; perhaps a (listener) function for Snd? (include event loop etc: check_for_event in snd-motif.c and snd-gutils.c)
+;;   also failed in motif (listener widget callbacks are inactive??)
+|#
+
+
+(when (defined? 'debug.scm-init) ; connect to the repl, if any
+  ((symbol->value 'debug.scm-init)))
diff --git a/s7/dup.scm b/s7/dup.scm
new file mode 100644
index 0000000..987f086
--- /dev/null
+++ b/s7/dup.scm
@@ -0,0 +1,140 @@
+;;; dup.scm
+;;; (dup size file alloc-lines):
+;;;    find all matches of "size" successive lines in "file" ignoring empty lines and leading/trailing whitespace
+;;;    "alloc-lines" is any number bigger than the number of lines in "file"
+;;;    (dups 16 "s7.c" 91000) finds all 16-line matches in s7.c which (we wish) has less than 91000 lines in all
+
+(define dup
+  (let ((unique #f))
+
+    (define-constant (all-positive? start len)
+      (do ((j (+ start len) (- j 1)))
+	  ((or (vector-ref unique j)
+	       (= j start))
+	   j)))
+
+    (lambda (size file alloc-lines)
+      (let ((lines (make-vector alloc-lines ""))
+	    (original-lines (make-vector alloc-lines ""))
+	    (lens (make-int-vector alloc-lines))
+	    (linenums (make-int-vector alloc-lines))
+	    (size-1 0)
+	    (reported-already (make-vector alloc-lines #f)))
+	(set! unique (make-vector alloc-lines #f))
+
+	(call-with-input-file file
+	  (lambda (p)
+	    ;; get lines, original and trimmed
+	    (let ((total-lines
+		   (do ((i 0 (+ i 1))
+			(j 0)
+			(line (read-line p) (read-line p)))
+		       ((eq? line #<eof>) j)
+		     ;; save original lines
+		     (vector-set! original-lines i line)
+		     (let ((len (length line)))
+		       (when (> len 0)
+			 ;; trim leading whitespace
+			 (do ((k 0 (+ k 1)))
+			     ((or (= k len)
+				  (not (char-whitespace? (string-ref line k))))
+			      (when (> k 0)
+				(set! line (substring line k))
+				(set! len (- len k)))))
+			 ;; trim trailing whitespace
+			 (when (> len 0)
+			   (do ((j (- len 1) (- j 1)))
+			       ((or (< j 0)
+				    (not (char-whitespace? (string-ref line j))))
+				(unless (= j (- len 1))
+				  (set! line (substring line 0 (+ j 1)))
+				  (set! len (+ j 1)))))
+			   (when (> len 0)
+			     (int-vector-set! linenums j i)
+			     (vector-set! lines j line)
+			     (int-vector-set! lens j (length line))
+			     (set! j (+ j 1)))))))))
+
+	      (set! size (min size total-lines))
+	      (set! size-1 (- size 1))
+	      ;; (format *stderr* "lines: ~S~%" total-lines)         ; 84201 2-jul-19, 89690 29-Aug-20, 85715 28-May-22, 88607 17-Jan-24
+
+	      ;; mark unmatchable strings
+	      (let ((sortv (make-vector total-lines)))
+		(do ((i 0 (+ i 1)))
+		    ((= i total-lines))
+		  (vector-set! sortv i (cons (vector-ref lines i) i)))
+		(set! sortv (sort! sortv (lambda (a b)
+					   (string<? (car a) (car b)))))
+		(let ((unctr -1)
+		      (matches #f)
+		      (current (vector-ref sortv 0)))
+		  (for-each (lambda (srt)
+			      (if (string=? (car current) (car srt))
+				  (set! matches #t)
+				  (begin
+				    (unless matches
+				      (int-vector-set! lens (cdr current) unctr)
+				      (vector-set! unique (cdr current) #t) ; unique = (negative? (lens...))
+				      (set! unctr (- unctr 1)))
+				    (set! matches #f)
+				    (set! current srt))))
+			    sortv)
+		  ;; (format *stderr* "unmatched: ~D~%" (abs unctr)) ; 33796
+		  ))
+
+	      ;; look for matches
+	      (do ((first #t #t)
+		   (last-line (- total-lines size))
+		   (i 0 (+ i 1)))
+		  ((>= i last-line)) ; >= because i is set below
+		(unless (vector-ref reported-already i) ; this match was reported earlier
+		  (let ((j (all-positive? i size-1)))   ; is a match possible?
+		    (if (not (= j i))
+			(set! i j)
+			(let ((lenseq (subvector lens i (+ i size)))
+			      (lineseq (subvector lines i (+ size i))))
+			  (do ((k (+ i 1) (+ k 1)))
+			      ((or (>= i k)   ; i incremented by full-size when local matches end
+				   (>= k last-line)))
+			    (let ((jk (all-positive? k size-1)))
+			      (if (not (= jk k))
+				  (set! k jk)
+				  (when (and (equal? lenseq (subvector lens k (+ size k)))
+					     (equal? lineseq (subvector lines k (+ size k))))
+				    (vector-set! reported-already k #t)
+				    (let ((full-size size))
+				      (do ((nk (+ k size) (+ nk 1))
+					   (ni (+ i size) (+ ni 1)))  ; here if i==k we run to the end and quit
+					  ((or (= nk total-lines)
+					       (not (= (int-vector-ref lens ni) (int-vector-ref lens nk)))
+					       (not (string=? (vector-ref lines ni) (vector-ref lines nk))))
+					   (set! full-size (- nk k))))
+				      (if first
+					  (let ((first-line (int-vector-ref linenums i)))
+					    (vector-set! reported-already i #t)
+					    (format *stderr* "~NC~%~{~A~%~}~%  lines ~D ~D" 8 #\- ; lineseq
+						    (subvector original-lines first-line (int-vector-ref linenums (+ i size)))
+						    first-line
+						    (int-vector-ref linenums k))
+					    (set! first #f))
+					  (format *stderr* " ~D" (int-vector-ref linenums k)))
+				      (set! i (+ i full-size))
+				      (when (< size full-size)
+					(format *stderr* "[~D]" full-size)))))))
+			  (unless first
+			    (format *stderr* "~%")))))))))))))
+  )
+
+(set! (*s7* 'heap-size) 4096000)
+
+(dup 16 "s7.c" 110000)
+;(dup 12 "s7.c" 110000)
+;(dup 8 "s7.c" 110000)
+;(dup 12 "ffitest.c" 10000)
+;(dup 8 "ffitest.c" 10000)
+;(dup 1 "s7test.scm" 110000)
+
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(exit)
diff --git a/s7/ffitest.c b/s7/ffitest.c
new file mode 100644
index 0000000..76ea2c9
--- /dev/null
+++ b/s7/ffitest.c
@@ -0,0 +1,2884 @@
+/* s7 ffi tester
+ *
+ * gcc -o ffitest ffitest.c -g3 -Wall s7.o -lm -I. -ldl -Wl,-export-dynamic
+ * gcc -o ffitest ffitest.c -g3 -Wall s7.o -DWITH_GMP -lgmp -lmpfr -lmpc -lm -I. -ldl -Wl,-export-dynamic
+ * gcc -o ffitest ffitest.c -fsanitize=address -fsanitize=bounds -fsanitize=pointer-compare -g3 -Wall -lasan -lubsan s7.o -lm -I. -ldl -Wl,-export-dynamic
+ * valgrind --leak-check=full --show-reachable=no --suppressions=/home/bil/cl/free.supp ffitest
+ */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <stdarg.h>
+#include <inttypes.h>
+
+#if WITH_GMP
+#include <gmp.h>
+#include <mpfr.h>
+#include <mpc.h>
+#endif
+
+#include "s7.h"
+
+#define ld64 PRId64
+
+#ifndef WITH_GMP
+  #define WITH_GMP 0
+#endif
+
+#define ld64 PRId64
+
+#define TO_STR(x) s7_object_to_c_string(sc, x)
+#define TO_S7_INT(x) s7_make_integer(sc, x)
+
+static s7_pointer a_function(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_car(args));
+}
+
+static s7_pointer test_hook_function(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer val;
+  val = s7_symbol_local_value(sc, s7_make_symbol(sc, "a"), s7_car(args));
+  if ((!s7_is_integer(val)) ||
+      (s7_integer(val) != 1))
+    {
+      char *s1;
+      s1 = TO_STR(val);
+      fprintf(stderr, "%d: (hook 'a) is %s\n", __LINE__, s1);
+      free(s1);
+    }
+  return(val);
+}
+
+static char last_c;
+static void my_print(s7_scheme *sc, unsigned char c, s7_pointer port)
+{
+  last_c = c;
+}
+
+static s7_pointer my_read(s7_scheme *sc, s7_read_t peek, s7_pointer port)
+{
+  return(s7_make_character(sc, '0'));
+}
+
+static s7_pointer my_error(s7_scheme *sc, s7_pointer args)
+{
+  s7_error(sc, s7_make_symbol(sc, "my-error"), s7_list(sc, 1, s7_make_integer(sc, 60)));
+  return(s7_f(sc));
+}
+
+static s7_pointer my_no_error(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, 30));
+}
+
+static s7_pointer my_error_handler(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_car(s7_cadr(args)));
+}
+
+static bool tested_begin_hook = false;
+static void test_begin_hook(s7_scheme *sc, bool *val)
+{
+  tested_begin_hook = true;
+}
+
+static s7_pointer test_error_handler(s7_scheme *sc, s7_pointer args)
+{
+  s7_display(sc, s7_make_symbol(sc, "error!"), s7_current_error_port(sc));
+  return(s7_f(sc));
+}
+
+static s7_pointer set_sym, set_val;
+static s7_pointer scheme_set_notification(s7_scheme *sc, s7_pointer args)
+{
+  set_sym = s7_car(args);
+  set_val = s7_cadr(args);
+  return(set_val);
+}
+
+
+typedef struct {
+  s7_double x;
+  s7_pointer data;
+} dax;
+
+static s7_int dax_type_tag = 0, dx_type_tag = 0;
+
+static s7_pointer dax_to_string(s7_scheme *sc, s7_pointer args)
+{
+  char *data_str, *str;
+  s7_pointer result;
+  int data_str_len;
+  dax *o = (dax *)s7_c_object_value(s7_car(args));
+  data_str = TO_STR(o->data);
+  data_str_len = strlen(data_str);
+  str = (char *)calloc(data_str_len + 32, sizeof(char));
+  snprintf(str, data_str_len + 32, "#<dax %.3f %s>", o->x, data_str);
+  free(data_str);
+  result = s7_make_string(sc, str);
+  free(str);
+  return(result);
+}
+
+static void free_dax(void *val)
+{
+  if (val) free(val);
+}
+
+static void mark_dax(void *val)
+{
+  dax *o = (dax *)val;
+  if (o) s7_mark(o->data);
+}
+
+static s7_pointer make_dax(s7_scheme *sc, s7_pointer args)
+{
+  dax *o;
+  o = (dax *)malloc(sizeof(dax));
+  o->x = s7_real(s7_car(args));
+  if (s7_cdr(args) != s7_nil(sc))
+    o->data = s7_car(s7_cdr(args));
+  else o->data = s7_nil(sc);
+  return(s7_make_c_object(sc, dax_type_tag, (void *)o));
+}
+
+static s7_pointer is_dax(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_boolean(sc,
+			 s7_is_c_object(s7_car(args)) &&
+			 s7_c_object_type(s7_car(args)) == dax_type_tag));
+}
+
+static s7_pointer dax_x(s7_scheme *sc, s7_pointer args)
+{
+  dax *o;
+  o = (dax *)s7_c_object_value(s7_car(args));
+  return(s7_make_real(sc, o->x));
+}
+
+static s7_pointer set_dax_x(s7_scheme *sc, s7_pointer args)
+{
+  dax *o;
+  o = (dax *)s7_c_object_value(s7_car(args));
+  o->x = s7_real(s7_car(s7_cdr(args)));
+  return(s7_car(s7_cdr(args)));
+}
+
+static s7_pointer dax_data(s7_scheme *sc, s7_pointer args)
+{
+  dax *o;
+  o = (dax *)s7_c_object_value(s7_car(args));
+  return(o->data);
+}
+
+static s7_pointer set_dax_data(s7_scheme *sc, s7_pointer args)
+{
+  dax *o;
+  o = (dax *)s7_c_object_value(s7_car(args));
+  o->data = s7_car(s7_cdr(args));
+  return(o->data);
+}
+
+static bool equal_dax(void *val1, void *val2) /* this is the old form of equal? */
+{
+  dax *d1, *d2;
+  if (val1 == val2)
+    return(true);
+  d1 = (dax *)val1;
+  d2 = (dax *)val2;
+  return((d1->x == d2->x) &&
+	 (d1->data == d2->data));  /* we want s7_is_equal here, but the interpreter is not passed to us */
+}
+
+static s7_pointer equality_dax(s7_scheme *sc, s7_pointer args) /* this is the new form of equal? */
+{
+  s7_pointer p1, p2;
+  dax *d1, *d2;
+  p1 = s7_car(args);      /* we know this is a dax object */
+  p2 = s7_cadr(args);
+  if (p1 == p2)
+    return(s7_t(sc));
+  if ((!s7_is_c_object(p2)) ||
+      (s7_c_object_type(p2) != dax_type_tag))
+    return(s7_f(sc));
+  d1 = (dax *)s7_c_object_value(p1);
+  d2 = (dax *)s7_c_object_value(p2);
+  return(s7_make_boolean(sc,       /* here we can call s7_is_equal */
+			 (d1->x == d2->x) &&
+			 (s7_is_equal(sc, d1->data, d2->data))));
+}
+
+
+static s7_pointer free_dx(s7_scheme *sc, s7_pointer obj)
+{
+  free(s7_c_object_value(obj));
+  return(NULL);
+}
+
+static s7_pointer mark_dx(s7_scheme *sc, s7_pointer obj)
+{
+  dax *o = (dax *)s7_c_object_value(obj);
+  if (o) s7_mark(o->data);
+  return(NULL);
+}
+
+static s7_pointer dx_to_list(s7_scheme *sc, s7_pointer obj)
+{
+  return(s7_nil(sc));
+}
+
+
+static s7_pointer plus(s7_scheme *sc, s7_pointer args)
+{
+  /* (define* (plus (red 32) blue) (+ (* 2 red) blue)) */
+  return(TO_S7_INT(2 * s7_integer(s7_car(args)) + s7_integer(s7_car(s7_cdr(args)))));
+}
+
+static s7_pointer plus1(s7_scheme *sc, s7_pointer args) /* check recursion in "unsafe" case */
+{
+  s7_pointer d;
+  if (s7_integer(s7_car(args)) == 4)
+    d = s7_apply_function_star(sc, s7_name_to_value(sc, "plus1"),
+			       s7_list(sc, 3,
+				       s7_make_integer(sc, 1),
+				       s7_make_integer(sc, 2),
+				       s7_make_integer(sc, 3)));
+  else d = s7_make_integer(sc, 0);
+  return(s7_make_integer(sc, s7_integer(s7_car(args)) +
+			 s7_integer(s7_cadr(args)) +
+			 s7_integer(s7_caddr(args)) +
+			 s7_integer(d)));
+}
+
+s7_pointer fs1(s7_scheme* sc, s7_pointer args) {if (s7_is_pair(args)) return(s7_car(args)); return s7_nil(sc);}
+s7_pointer fs2(s7_scheme* sc, s7_pointer args) {if (s7_is_pair(args)) return(s7_car(args)); return s7_nil(sc);}
+s7_pointer fs3(s7_scheme* sc, s7_pointer args) {if (s7_is_pair(args)) return(s7_car(args)); return s7_nil(sc);}
+s7_pointer fs31(s7_scheme* sc, s7_pointer args) {if (s7_is_pair(args)) return(s7_car(args)); return s7_nil(sc);}
+
+s7_pointer fs4(s7_scheme* sc, s7_pointer args) {if (s7_is_pair(args)) return(s7_car(args)); return s7_nil(sc);}
+s7_pointer fs5(s7_scheme* sc, s7_pointer args) {if (s7_is_pair(args)) return(s7_car(args)); return s7_nil(sc);}
+s7_pointer fs6(s7_scheme* sc, s7_pointer args) {if (s7_is_pair(args)) return(s7_car(args)); return s7_nil(sc);}
+s7_pointer fs61(s7_scheme* sc, s7_pointer args) {if (s7_is_pair(args)) return(s7_car(args)); return s7_nil(sc);}
+
+static s7_pointer mac_plus(s7_scheme *sc, s7_pointer args)
+{
+  /* (define-macro (plus a b) `(+ ,a ,b)) */
+  s7_pointer a, b;
+  a = s7_car(args);
+  b = s7_cadr(args);
+  return(s7_list(sc, 3, s7_make_symbol(sc, "+"),  a, b));
+}
+
+static s7_pointer mac_plus_mv(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_list(sc, 2, s7_make_symbol(sc, "+"), s7_values(sc, args))); /* s7_values is not a good idea here */
+}
+
+static s7_pointer open_plus(s7_scheme *sc, s7_pointer args)
+{
+  #define plus_help "(plus obj ...) applies obj's plus method to obj and any trailing arguments."
+  s7_pointer obj, method;
+  obj = s7_car(args);
+  if (s7_is_openlet(obj))
+    {
+      method = s7_method(sc, obj, s7_make_symbol(sc, "plus"));
+      if (s7_is_procedure(method))
+	return(s7_apply_function(sc, method, s7_cdr(args)));
+    }
+  return(s7_f(sc));
+}
+
+static s7_pointer g_car(s7_scheme *sc, s7_pointer args) {return(s7_car(s7_car(args)));}
+
+
+typedef struct {
+  size_t size;
+  double *data;
+} g_block;
+
+static s7_int g_block_type = 0;
+static s7_pointer g_block_methods;
+
+static s7_pointer g_make_block(s7_scheme *sc, s7_pointer args)
+{
+  #define g_make_block_help "(make-block size) returns a new block of the given size"
+  g_block *g;
+  s7_pointer new_g;
+  g = (g_block *)calloc(1, sizeof(g_block));
+  g->size = (size_t)s7_integer(s7_car(args));
+  g->data = (double *)calloc(g->size, sizeof(double));
+  new_g = s7_make_c_object(sc, g_block_type, (void *)g);
+  s7_c_object_set_let(sc, new_g, g_block_methods);
+  s7_openlet(sc, new_g);
+  return(new_g);
+}
+
+static s7_pointer g_to_block(s7_scheme *sc, s7_pointer args)
+{
+#define g_block_help "(block ...) returns a block c_object with the arguments as its contents."
+  s7_pointer p, b;
+  size_t i, len;
+  g_block *gb;
+  len = s7_list_length(sc, args);
+  b = g_make_block(sc, s7_cons(sc, s7_make_integer(sc, len), s7_nil(sc)));
+  gb = (g_block *)s7_c_object_value(b);
+  for (i = 0, p = args; i < len; i++, p = s7_cdr(p))
+    gb->data[i] = s7_number_to_real(sc, s7_car(p));
+  return(b);
+}
+
+static s7_pointer g_block_to_string(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_string(sc, "<block>"));
+}
+
+static void g_block_free(void *value)
+{
+  g_block *g = (g_block *)value;
+  free(g->data);
+  free(g);
+}
+
+static bool g_blocks_are_eql(void *val1, void *val2)
+{
+  s7_int i, len;
+  g_block *b1 = (g_block *)val1;
+  g_block *b2 = (g_block *)val2;
+  if (val1 == val2) return(true);
+  len = b1->size;
+  if (len != b2->size) return(false);
+  for (i = 0; i < len; i++)
+    if (b1->data[i] != b2->data[i])
+      return(false);
+  return(true);
+}
+
+static s7_pointer g_blocks_are_equal(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_boolean(sc, g_blocks_are_eql((void *)s7_c_object_value(s7_car(args)), (void *)s7_c_object_value(s7_cadr(args)))));
+}
+
+static s7_pointer g_blocks_are_equivalent(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer v1, v2, arg1, arg2;
+  g_block *g1, *g2;
+  bool result;
+  uint32_t gc1, gc2;
+  size_t len;
+  arg1 = s7_car(args);
+  arg2 = s7_cadr(args);
+  if (!s7_is_c_object(arg2))
+    return(s7_f(sc));
+  if (arg1 == arg2)
+    return(s7_make_boolean(sc, true));
+  if (s7_is_let(arg1))             /* (block-let (block)) */
+    return(s7_make_boolean(sc, false));    /* checked == above */
+  g1 = (g_block *)s7_c_object_value_checked(arg1, g_block_type);
+  if (!g1) return(s7_f(sc));
+  g2 = (g_block *)s7_c_object_value(arg2);
+  len = g1->size;
+  if (len != g2->size)
+    return(s7_make_boolean(sc, false));
+  v1 = s7_make_float_vector_wrapper(sc, len, g1->data, 1, NULL, false);
+  gc1 = s7_gc_protect(sc, v1);
+  v2 = s7_make_float_vector_wrapper(sc, len, g2->data, 1, NULL, false);
+  gc2 = s7_gc_protect(sc, v2);
+  result = s7_is_equivalent(sc, v1, v2);
+  s7_gc_unprotect_at(sc, gc1);
+  s7_gc_unprotect_at(sc, gc2);
+  return(s7_make_boolean(sc, result));
+}
+
+static void g_block_mark(void *val)
+{
+  /* nothing to mark */
+}
+
+static s7_pointer g_block_ref(s7_scheme *sc, s7_pointer args)
+{
+  g_block *g;
+  size_t index;
+  g = (g_block *)s7_c_object_value(s7_car(args));
+  index = (size_t)s7_integer(s7_cadr(args));
+  if (index < g->size)
+    return(s7_make_real(sc, g->data[index]));
+  return(s7_out_of_range_error(sc, "block-ref", 2, s7_cadr(args), "should be less than block length"));
+}
+
+static s7_pointer g_block_set(s7_scheme *sc, s7_pointer args)
+{
+  g_block *g;
+  s7_int index;
+  if (s7_list_length(sc, args) != 3)
+    return(s7_wrong_number_of_args_error(sc, "block-set! takes 3 arguments: ~S", args));
+  g = (g_block *)s7_c_object_value(s7_car(args));
+  index = s7_integer(s7_cadr(args));
+  if ((index >= 0) && (index < g->size))
+    {
+      g->data[index] = s7_number_to_real(sc, s7_caddr(args));
+      return(s7_caddr(args));
+    }
+  return(s7_out_of_range_error(sc, "block-set", 2, s7_cadr(args), "should be less than block length"));
+}
+
+static s7_pointer g_block_length(s7_scheme *sc, s7_pointer args)
+{
+  g_block *g = (g_block *)s7_c_object_value(s7_car(args));
+  return(s7_make_integer(sc, g->size));
+}
+
+static s7_pointer g_block_copy(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer obj, new_g;
+  g_block *g, *g1;
+  obj = s7_car(args);
+  g = (g_block *)s7_c_object_value(obj);
+  new_g = g_make_block(sc, s7_cons(sc, s7_make_integer(sc, g->size), s7_nil(sc)));
+  g1 = (g_block *)s7_c_object_value(new_g);
+  memcpy((void *)(g1->data), (void *)(g->data), g->size * sizeof(double));
+  return(new_g);
+}
+
+static s7_pointer g_block_reverse(s7_scheme *sc, s7_pointer args)
+{
+  size_t i, j;
+  s7_pointer obj, new_g;
+  g_block *g, *g1;
+  obj = s7_car(args);
+  g = (g_block *)s7_c_object_value(obj);
+  new_g = g_make_block(sc, s7_cons(sc, s7_make_integer(sc, g->size), s7_nil(sc)));
+  g1 = (g_block *)s7_c_object_value(new_g);
+  for (i = 0, j = g->size - 1; i < g->size; i++, j--)
+    g1->data[i] = g->data[j];
+  return(new_g);
+}
+
+static s7_pointer g_block_fill(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer obj;
+  size_t i;
+  double fill_val;
+  g_block *g;
+  obj = s7_car(args);
+  g = (g_block *)s7_c_object_value(obj);
+  fill_val = s7_number_to_real(sc, s7_cadr(args));
+  for (i = 0; i < g->size; i++)
+    g->data[i] = fill_val;
+  return(obj);
+}
+
+static bool symbol_func(const char *symbol_name, void *data)
+{
+  return(false);
+}
+
+static bool symbol_func_1(const char *symbol_name, void *data)
+{
+  return(false);
+}
+
+static s7_pointer our_abs(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_real(sc, (s7_Double)(1.0 + s7_number_to_real(sc, s7_car(args)))));
+}
+
+
+static s7_scheme *cur_sc;
+
+static const char *pretty_print(s7_scheme *sc, s7_pointer obj) /* (pretty-print obj) */
+{
+  return(s7_string(
+          s7_eval_c_string_with_environment(sc,
+            "(catch #t                                \
+               (lambda ()                             \
+                 (unless (defined? 'pp)		      \
+                   (load \"write.scm\"))	      \
+                 (pp obj))			      \
+               (lambda (type info)		      \
+                 (apply format #f info)))",
+	   s7_inlet(sc, s7_list(sc, 1, s7_cons(sc, s7_make_symbol(sc, "obj"), obj))))));
+}
+
+#if WITH_GMP
+static s7_pointer big_add_1(s7_scheme *sc, s7_pointer args)
+{
+  /* add 1 to either a normal number or a bignum */
+  s7_pointer x, n;
+  x = s7_car(args);
+  if (s7_is_big_integer(x))
+    {
+      mpz_t big_n;
+      mpz_init_set(big_n, *s7_big_integer(x));
+      mpz_add_ui(big_n, big_n, 1);
+      n = s7_make_big_integer(sc, &big_n);
+      mpz_clear(big_n);
+      return(n);
+    }
+  if (s7_is_big_ratio(x))
+    {
+      mpq_t big_q;
+      mpq_init(big_q);
+      mpq_set_si(big_q, 1, 1);
+      mpq_add(big_q, *s7_big_ratio(x), big_q);
+      mpq_canonicalize(big_q);
+      n = s7_make_big_ratio(sc, &big_q);
+      mpq_clear(big_q);
+      return(n);
+    }
+  if (s7_is_big_real(x))
+    {
+      mpfr_t big_x;
+      mpfr_init_set(big_x, *s7_big_real(x), MPFR_RNDN);
+      mpfr_add_ui(big_x, big_x, 1, MPFR_RNDN);
+      n = s7_make_big_real(sc, &big_x);
+      mpfr_clear(big_x);
+      return(n);
+    }
+  if (s7_is_big_complex(x))
+    {
+      mpc_t big_z;
+      mpc_init2(big_z, mpc_get_prec(*s7_big_complex(x)));
+      mpc_add_ui(big_z, *s7_big_complex(x), 1, MPC_RNDNN);
+      n = s7_make_big_complex(sc, &big_z);
+      mpc_clear(big_z);
+      return(n);
+    }
+  if (s7_is_integer(x))
+    return(s7_make_integer(sc, 1 + s7_integer(x)));
+  if (s7_is_rational(x))
+    return(s7_make_ratio(sc, s7_numerator(x) + s7_denominator(x), s7_denominator(x)));
+  if (s7_is_real(x))
+    return(s7_make_real(sc, 1.0 + s7_real(x)));
+  if (s7_is_complex(x))
+    return(s7_make_complex(sc, 1.0 + s7_real_part(x), s7_imag_part(x)));
+  return(s7_wrong_type_arg_error(sc, "add-1", 0, x, "a number"));
+}
+#endif
+
+static const char *snd_names[8] = {
+    "*clm-array-print-length*", "ws.scm",
+    "*clm-channels*", "ws.scm",
+    "zone-tailed-hawk", "animals.scm",
+    "zoom-spectrum", "examp.scm",
+};
+
+
+static s7_double opt_d_func(void) {return(1.0);}
+static s7_pointer g_d_func(s7_scheme *sc, s7_pointer args) {return(s7_make_real(sc, 1.0));}
+
+static s7_double opt_d_d_func(s7_double x) {return(x + 1.0);}
+static s7_pointer g_d_d_func(s7_scheme *sc, s7_pointer args) {return(s7_make_real(sc, s7_real(s7_car(args)) + 1.0));}
+
+static s7_double opt_d_dd_func(s7_double x, s7_double y) {return(x + y);}
+static s7_pointer g_d_dd_func(s7_scheme *sc, s7_pointer args) {return(s7_make_real(sc, s7_real(s7_car(args)) + s7_real(s7_cadr(args))));}
+
+static s7_double opt_d_ddd_func(s7_double x, s7_double y, s7_double z) {return(x + y + z);}
+static s7_pointer g_d_ddd_func(s7_scheme *sc, s7_pointer args) {return(s7_make_real(sc, s7_real(s7_car(args)) + s7_real(s7_cadr(args)) + s7_real(s7_caddr(args))));}
+
+static s7_double opt_d_dddd_func(s7_double w, s7_double x, s7_double y, s7_double z) {return(w + x + y + z);}
+static s7_pointer g_d_dddd_func(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_real(sc, s7_real(s7_car(args)) + s7_real(s7_cadr(args)) + s7_real(s7_caddr(args)) + s7_real(s7_cadddr(args))));
+}
+
+static s7_double opt_d_p_func(s7_pointer x) {return(s7_real(x));}
+static s7_pointer g_d_p_func(s7_scheme *sc, s7_pointer args) {return(s7_make_real(sc, s7_real(s7_car(args))));}
+
+static s7_int opt_i_i_func(s7_int x) {return(x + 1);}
+static s7_pointer g_i_i_func(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, s7_integer(s7_car(args)) + 1));}
+
+static s7_int opt_i_ii_func(s7_int x, s7_int y) {return(x + y);}
+static s7_pointer g_i_ii_func(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, s7_integer(s7_car(args)) + s7_integer(s7_cadr(args))));}
+
+static s7_double opt_d_id_func(s7_int x, s7_double y) {return(x + y);}
+static s7_pointer g_d_id_func(s7_scheme *sc, s7_pointer args) {return(s7_make_real(sc, s7_integer(s7_car(args)) + s7_real(s7_cadr(args))));}
+
+static s7_double opt_d_ip_func(s7_int x, s7_pointer y) {return(x + s7_real(y));}
+static s7_pointer g_d_ip_func(s7_scheme *sc, s7_pointer args) {return(s7_make_real(sc, s7_integer(s7_car(args)) + s7_real(s7_cadr(args))));}
+
+static s7_int opt_i_7d_func(s7_scheme *sc, s7_double x) {return((s7_int)x);}
+static s7_pointer g_i_7d_func(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, (s7_int)s7_real(s7_car(args))));}
+
+static s7_int opt_i_7p_func(s7_scheme *sc, s7_pointer x) {return(s7_integer(x));}
+static s7_pointer g_i_7p_func(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, s7_integer(s7_car(args))));}
+
+static s7_double opt_d_pd_func(s7_pointer x, s7_double y) {return(s7_real(x) + y);}
+static s7_pointer g_d_pd_func(s7_scheme *sc, s7_pointer args) {return(s7_make_real(sc, s7_real(s7_car(args)) + s7_real(s7_cadr(args))));}
+
+static s7_double opt_d_7pi_func(s7_scheme *sc, s7_pointer x, s7_int y) {return(s7_real(x) + y);}
+static s7_pointer g_d_7pi_func(s7_scheme *sc, s7_pointer args) {return(s7_make_real(sc, s7_real(s7_car(args)) + s7_integer(s7_cadr(args))));}
+
+static s7_double opt_d_7pid_func(s7_scheme *sc, s7_pointer x, s7_int y, s7_double z) {return(s7_real(x) + y + z);}
+static s7_pointer g_d_7pid_func(s7_scheme *sc, s7_pointer args) {return(s7_make_real(sc, s7_real(s7_car(args)) + s7_integer(s7_cadr(args)) + s7_real(s7_caddr(args))));}
+
+static bool opt_b_p_func(s7_pointer x) {return(s7_is_real(x));}
+static s7_pointer g_b_p_func(s7_scheme *sc, s7_pointer args) {return(s7_make_boolean(sc, s7_is_real(s7_car(args))));}
+
+static s7_pointer opt_p_d_func(s7_scheme *sc, s7_double x) {return(s7_make_real(sc, x));}
+static s7_pointer g_p_d_func(s7_scheme *sc, s7_pointer args) {return(s7_car(args));}
+
+static s7_double opt_d_v_func(void *x) {g_block *g = (g_block *)x; return(g->data[0]);}
+static s7_pointer g_d_v_func(s7_scheme *sc, s7_pointer args) {g_block *g; g = (g_block *)s7_c_object_value(s7_car(args)); return(s7_make_real(sc, g->data[0]));}
+
+static s7_double opt_d_vd_func(void *x, s7_double y) {g_block *g = (g_block *)x; return(y + g->data[0]);}
+static s7_pointer g_d_vd_func(s7_scheme *sc, s7_pointer args)
+{
+  g_block *g;
+  g = (g_block *)s7_c_object_value(s7_car(args));
+  return(s7_make_real(sc, s7_real(s7_cadr(args)) + g->data[0]));
+}
+
+static s7_double opt_d_vid_func(void *x, s7_int y, s7_double z) {g_block *g = (g_block *)x; return(z + g->data[y]);}
+static s7_pointer g_d_vid_func(s7_scheme *sc, s7_pointer args)
+{
+  g_block *g;
+  g = (g_block *)s7_c_object_value(s7_car(args));
+  return(s7_make_real(sc, s7_real(s7_caddr(args)) + g->data[s7_integer(s7_cadr(args))]));
+}
+
+static s7_double opt_d_vdd_func(void *x, s7_double y, s7_double z) {g_block *g = (g_block *)x; return(y + z + g->data[0]);}
+static s7_pointer g_d_vdd_func(s7_scheme *sc, s7_pointer args)
+{
+  g_block *g;
+  g = (g_block *)s7_c_object_value(s7_car(args));
+  return(s7_make_real(sc, s7_real(s7_cadr(args)) + s7_real(s7_caddr(args)) + g->data[0]));
+}
+
+/* s7_call_with_catch */
+static s7_pointer make_func, catcher1, catcher2;
+static s7_pointer ter_bad_func(s7_scheme *sc, s7_pointer args) {s7_eval_c_string(sc, "(/ 10 0)"); return(s7_t(sc));}
+static s7_pointer ter_error_handler(s7_scheme *sc, s7_pointer args) {return s7_f(sc);}
+static s7_pointer ter1_bad_func(s7_scheme *sc, s7_pointer args) {return(s7_call_with_catch(sc, s7_t(sc), make_func, catcher1));}
+static s7_pointer ter1_error_handler(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, 123));}
+
+static s7_pointer ter2_bad_func(s7_scheme *sc, s7_pointer args) {return(s7_wrong_type_error(sc, s7_make_symbol(sc, "ter2"), 0, args, s7_make_string(sc, "oops")));}
+static s7_pointer ter2_error_handler(s7_scheme *sc, s7_pointer args) {return(s7_apply_function(sc, s7_name_to_value(sc, "format"), s7_cons(sc, s7_f(sc), s7_cadr(args))));}
+
+/* another s7_call_with_catch case thanks to Woody Douglass */
+static int32_t wd_val = 0;
+static s7_pointer wd_inner_test(s7_scheme *s, s7_pointer args)
+{
+  s7_error(s, s7_make_symbol(s, "test-error"), s7_list(s, 1, s7_make_string(s, "TEST ERROR")));
+  return s7_nil(s);
+}
+static s7_pointer wd_test_fn(s7_scheme *s, s7_pointer args)
+{
+  wd_val = 1;
+  s7_call_with_catch(s, s7_t(s), s7_name_to_value(s, "wd-inner-test"), s7_name_to_value(s, "wd-inner-test-handler"));
+  wd_val = 2;
+  return s7_nil(s);
+}
+static s7_pointer wd_inner_test_handler(s7_scheme *s, s7_pointer args) {return s7_nil(s);}
+
+
+static int32_t wd1_val = 0, wd2_val = 0;
+static s7_pointer wd1_test_fn(s7_scheme *s, s7_pointer args)
+{
+  wd1_val = 1;
+  s7_call_with_catch(s, s7_t(s), s7_name_to_value(s, "wd1-inner-fn"), s7_name_to_value(s, "wd-inner-test-handler"));
+  wd1_val = 2;
+  return s7_nil(s);
+}
+static s7_pointer wd1_inner_fn(s7_scheme *s, s7_pointer args)
+{
+  wd2_val = 11;
+  s7_call_with_catch(s, s7_t(s), s7_name_to_value(s, "wd-inner-test"), s7_name_to_value(s, "wd-inner-test-handler"));
+  wd2_val = 12;
+  return s7_nil(s);
+}
+
+
+
+int main(int argc, char **argv)
+{
+  s7_scheme *sc;
+  s7_pointer p, p1, perm1, perm2;
+  s7_int i, gc_loc;
+  char *s1, *s2;
+
+  sc = s7_init();
+  cur_sc = sc;
+
+  {
+    char b1[32];
+    snprintf(b1, 32, "%d.%d", S7_MAJOR_VERSION, S7_MINOR_VERSION);
+    if (strcmp(b1, S7_VERSION) != 0) fprintf(stderr, "version mismatch: %d.%d != %s\n", S7_MAJOR_VERSION, S7_MINOR_VERSION, S7_VERSION);
+    if (strlen(S7_DATE) < 6) fprintf(stderr, "S7_DATE: %s\n", S7_DATE);
+  }
+
+  s7_set_history_enabled(sc, false);
+  if (s7_history_enabled(sc)) fprintf(stderr, "%d: history is enabled\n", __LINE__);
+
+  /* try each straight (no errors) case */
+
+  if (!s7_is_null(sc, s7_nil(sc)))
+    {fprintf(stderr, "%d: %s is not null?\n", __LINE__, s1 = TO_STR(s7_nil(sc))); free(s1);}
+
+  if (s7_is_pair(s7_nil(sc)))
+    {fprintf(stderr, "%d: %s is a pair?\n", __LINE__, s1 = TO_STR(s7_nil(sc))); free(s1);}
+
+  if (!s7_is_boolean(s7_t(sc)))
+    {fprintf(stderr, "%d: %s is not boolean?\n", __LINE__, s1 = TO_STR(s7_t(sc))); free(s1);}
+
+  if (!s7_is_boolean(s7_f(sc)))
+    {fprintf(stderr, "%d: %s is not boolean?\n", __LINE__, s1 = TO_STR(s7_f(sc))); free(s1);}
+
+  if (s7_boolean(sc, s7_f(sc)))
+    {fprintf(stderr, "%d: %s is #t?\n", __LINE__, s1 = TO_STR(s7_f(sc))); free(s1);}
+
+  if (!s7_boolean(sc, s7_t(sc)))
+    {fprintf(stderr, "%d: %s is #f?\n", __LINE__, s1 = TO_STR(s7_t(sc))); free(s1);}
+
+  p = s7_make_boolean(sc, true);
+  if (p != s7_t(sc))
+    {fprintf(stderr, "%d: %s is not #t?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_make_boolean(sc, false);
+  if (p != s7_f(sc))
+    {fprintf(stderr, "%d: %s is not #f?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_eq(s7_f(sc), s7_f(sc)))
+    {fprintf(stderr, "%d: (eq? %s %s) -> #f?\n", __LINE__, s1 = TO_STR(s7_f(sc)), s2 = TO_STR(s7_f(sc))); free(s1); free(s2);}
+
+  if (!s7_is_eqv(sc, s7_f(sc), s7_f(sc)))
+    {fprintf(stderr, "%d: (eqv? %s %s) -> #f?\n", __LINE__, s1 = TO_STR(s7_f(sc)), s2 = TO_STR(s7_f(sc))); free(s1); free(s2);}
+
+  if (!s7_is_equal(sc, s7_f(sc), s7_f(sc)))
+    {fprintf(stderr, "%d: (equal? %s %s) -> #f?\n", __LINE__, s1 = TO_STR(s7_f(sc)), s2 = TO_STR(s7_f(sc))); free(s1); free(s2);}
+
+  if (!s7_is_unspecified(sc, s7_unspecified(sc)))
+    {fprintf(stderr, "%d: %s is not #<unspecified>?\n", __LINE__, s1 = TO_STR(s7_unspecified(sc))); free(s1);}
+
+  if (s7_is_eq(s7_eof_object(sc), s7_undefined(sc)))
+    {fprintf(stderr, "%d: (eq? %s %s) -> #t?\n", __LINE__, s1 = TO_STR(s7_eof_object(sc)), s2 = TO_STR(s7_undefined(sc))); free(s1); free(s2);}
+
+  if (s7_is_eqv(sc, s7_eof_object(sc), s7_undefined(sc)))
+    {fprintf(stderr, "%d: (eqv? %s %s) -> #t?\n", __LINE__, s1 = TO_STR(s7_eof_object(sc)), s2 = TO_STR(s7_undefined(sc))); free(s1); free(s2);}
+
+  if (s7_is_equal(sc, s7_eof_object(sc), s7_undefined(sc)))
+    {fprintf(stderr, "%d: (equal? %s %s) -> #t?\n", __LINE__, s1 = TO_STR(s7_eof_object(sc)), s2 = TO_STR(s7_undefined(sc))); free(s1); free(s2);}
+
+  if (!s7_is_valid(sc, s7_t(sc)))
+    {fprintf(stderr, "%d: %s is not valid?\n", __LINE__, s1 = TO_STR(s7_t(sc))); free(s1);}
+  {
+    typedef struct fake_cell {
+      union {
+	uint64_t flag;
+	uint8_t type_field;
+      } tf;
+      int64_t hloc, i1, i2, i3;
+    } fake_cell;
+    fake_cell *x;
+    x = calloc(1, sizeof(fake_cell));
+    x->tf.flag = 53 + (1 << 11);
+    if (s7_is_valid(sc, (s7_pointer)x))
+      fprintf(stderr, "fake_cell is ok?\n");
+    if (!s7_is_provided(sc, "debugging"))
+      {
+	s1 = TO_STR((s7_pointer)x);
+	free(s1);
+      }
+    free(x);
+  }
+  if (s7_is_c_pointer(s7_t(sc)))
+    {fprintf(stderr, "%d: %s is a raw c pointer?\n", __LINE__, s1 = TO_STR(s7_t(sc))); free(s1);}
+
+  i = 32;
+  p = s7_make_c_pointer(sc, (void *)(&i));
+  if (!s7_is_c_pointer(p))
+    {fprintf(stderr, "%d: %s is not a raw c pointer?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  i = (*((int *)s7_c_pointer(p)));
+  if (i != 32)
+    fprintf(stderr, "%d: 32 -> %" ld64 " via raw c pointer?\n", __LINE__, i);
+
+  s7_provide(sc, "ffitest");
+  if (!s7_is_provided(sc, "ffitest"))
+    {fprintf(stderr, "%d: *features* %s doesn't provide 'ffitest?\n", __LINE__, s1 = TO_STR(s7_name_to_value(sc, "*features*"))); free(s1);}
+
+  p = s7_cons(sc, s7_f(sc), s7_t(sc));
+  gc_loc = s7_gc_protect(sc, p);
+  if (p != s7_gc_protected_at(sc, gc_loc))
+    {fprintf(stderr, "%d: %s is not gc protected at %" ld64 ": %s?\n", __LINE__, s1 = TO_STR(p), gc_loc, s2 = TO_STR(s7_gc_protected_at(sc, gc_loc))); free(s1); free(s2);}
+
+  if (s7_car(p) != s7_f(sc))
+    {fprintf(stderr, "%d: (car %s) is not #f?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_cdr(p) != s7_t(sc))
+    {fprintf(stderr, "%d: (cdr %s) is not #t?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_pair(p))
+    {fprintf(stderr, "%d: %s is not a pair?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_set_car(p, s7_eof_object(sc));
+  if (s7_car(p) != s7_eof_object(sc))
+    {fprintf(stderr, "%d: (car %s) is not #<eof>?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_set_cdr(p, s7_unspecified(sc));
+  if (s7_cdr(p) != s7_unspecified(sc))
+    {fprintf(stderr, "%d: (cdr %s) is not #<unspecified>?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_gc_unprotect_at(sc, gc_loc);
+
+  { /* force realloc of protected_objects array */
+    s7_int gc_locs[20];
+    for (i = 0; i < 18; i++) /* initial size = 16 */
+      gc_locs[i] = s7_gc_protect(sc, s7_cons(sc, s7_f(sc), s7_t(sc)));
+    for (i = 0; i < 18; i++)
+      s7_gc_unprotect_at(sc, gc_locs[i]);
+  }
+
+  p = TO_S7_INT(123);
+  gc_loc = s7_gc_protect(sc, p);
+
+  if (!s7_is_integer(p))
+    {fprintf(stderr, "%d: %s is not integral?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_rational(p))
+    {fprintf(stderr, "%d: %s is not rational?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_is_ratio(p))
+    {fprintf(stderr, "%d: %s is a ratio?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_real(p))
+    {fprintf(stderr, "%d: %s is not real?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_complex(p))
+    {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_number(p))
+    {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_integer(p) != 123)
+    {fprintf(stderr, "%d: %s is not 123?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s2 = s7_number_to_string(sc, p, 10);
+  if (strcmp(s2, "123") != 0)
+    {fprintf(stderr, "%d: (number->string %s) is not \"123\"?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  free(s2);
+
+  if (s7_number_to_integer(sc, p) != 123)
+    {fprintf(stderr, "%d: s7_number_to_integer %s is not 123?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_number_to_integer_with_caller(sc, p, "ffitest") != 123)
+    {fprintf(stderr, "%d: s7_number_to_integer_with_caller %s is not 123?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_string(s7_object_to_string(sc, p, false)))
+    {fprintf(stderr, "%s is not a string\n", s1 = TO_STR(s7_object_to_string(sc, p, false))); free(s1);}
+  if (strcmp(s7_string(s7_object_to_string(sc, p, true)), "123") != 0)
+    fprintf(stderr, "%s is not \"123\"", s7_string(s7_object_to_string(sc, p, true)));
+
+  s7_gc_unprotect_at(sc, gc_loc);
+
+
+  p = s7_make_ratio(sc, 123, 5);
+  gc_loc = s7_gc_protect(sc, p);
+
+  if (s7_is_integer(p))
+    {fprintf(stderr, "%d: %s is integral?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_rational(p))
+    {fprintf(stderr, "%d: %s is not rational?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_ratio(p))
+    {fprintf(stderr, "%d: %s is not a ratio?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_real(p))
+    {fprintf(stderr, "%d: %s is not real?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_complex(p))
+    {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_number(p))
+    {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_numerator(p) != 123)
+    {fprintf(stderr, "%d: (numerator %s) is not 123?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_denominator(p) != 5)
+    {fprintf(stderr, "%d: (denominator %s) is not 5?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s2 = s7_number_to_string(sc, p, 10);
+  if (strcmp(s2, "123/5") != 0)
+    {fprintf(stderr, "%d: (number->string %s) is not \"123/5\"?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  free(s2);
+
+  s7_gc_unprotect_at(sc, gc_loc);
+
+
+  p = s7_make_real(sc, 1.5);
+  gc_loc = s7_gc_protect(sc, p);
+
+  if (s7_is_integer(p))
+    {fprintf(stderr, "%d: %s is integral?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_is_rational(p))
+    {fprintf(stderr, "%d: %s is rational?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_is_ratio(p))
+    {fprintf(stderr, "%d: %s is a ratio?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_real(p))
+    {fprintf(stderr, "%d: %s is not real?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_complex(p))
+    {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_number(p))
+    {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_real(p) != 1.5)
+    {fprintf(stderr, "%d: %s is not 1.5?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s2 = s7_number_to_string(sc, p, 10);
+  if (strcmp(s2, "1.5") != 0)
+    {fprintf(stderr, "%d: (number->string %s) is not \"1.5\"?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  free(s2);
+
+  if (s7_number_to_real(sc, p) != 1.5)
+    {fprintf(stderr, "%d: s7_number_to_real %s is not 1.5?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_number_to_real_with_caller(sc, p, "ffitest") != 1.5)
+    {fprintf(stderr, "%d: s7_number_to_real_with_caller %s is not 1.5?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_number_to_real_with_location(sc, p, s7_make_symbol(sc, "ffitest")) != 1.5)
+    {fprintf(stderr, "%d: s7_number_to_real_with_location %s is not 1.5?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_gc_unprotect_at(sc, gc_loc);
+
+  p = s7_make_mutable_real(sc, 1.5);
+  if (!s7_is_real(p))
+    {fprintf(stderr, "%d: %s is not real?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_make_complex(sc, 1.0, 1.0);
+  gc_loc = s7_gc_protect(sc, p);
+
+  if (s7_is_integer(p))
+    {fprintf(stderr, "%d: %s is integral?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_is_rational(p))
+    {fprintf(stderr, "%d: %s is rational?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_is_ratio(p))
+    {fprintf(stderr, "%d: %s is a ratio?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_is_real(p))
+    {fprintf(stderr, "%d: %s is real?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_complex(p))
+    {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_number(p))
+    {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_real_part(p) != 1.0)
+    {fprintf(stderr, "%d: (real-part %s) is not 1.0?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_imag_part(p) != 1.0)
+    {fprintf(stderr, "%d: (imag-part %s) is not 1.0?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s2 = s7_number_to_string(sc, p, 10);
+  if (strcmp(s2, "1.0+1.0i") != 0)
+    {fprintf(stderr, "%d: (number->string %s) is not \"1.0+1.0i\"?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  free(s2);
+
+  s7_immutable(p);
+  if (!s7_is_immutable(p))
+    fprintf(stderr, "s7_immutable failed?\n");
+  s7_gc_unprotect_at(sc, gc_loc);
+
+  p = s7_signature(sc, s7_name_to_value(sc, "abs"));
+  if (!s7_is_pair(p))
+    {fprintf(stderr, "%d: %s is not a pair?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  {
+    s7_pointer p;
+    p = s7_shadow_rootlet(sc);
+    if ((!s7_is_null(sc, p)) &&
+	(!s7_is_let(p)))
+      {fprintf(stderr, "shadow rootlet is %s\n", s1 = TO_STR(p)); free(s1);}
+    s7_set_shadow_rootlet(sc, p);
+  }
+
+  if (s7_c_pointer(s7_make_c_pointer(sc, NULL)))
+    fprintf(stderr, "s7_c_pointer 0 is not null\n");
+  if (s7_c_pointer_type(s7_make_c_pointer_with_type(sc, NULL, s7_nil(sc), s7_f(sc))) != s7_nil(sc))
+    fprintf(stderr, "s7_c_pointer_type is not ()\n");
+  {
+    s7_pointer csc;
+    csc = s7_make_c_pointer_with_type(sc, (void *)sc, s7_make_symbol(sc, "s7_scheme*"), s7_f(sc));
+    if (!s7_is_c_pointer_of_type(csc, s7_make_symbol(sc, "s7_scheme*")))
+      {fprintf(stderr, "c-pointer type %s != s7_scheme*\n", s1 = TO_STR(s7_c_pointer_type(csc))); free(s1);}
+    s7_c_pointer_with_type(sc, csc, s7_make_symbol(sc, "s7_scheme*"), "ffitest", __LINE__);
+    csc = s7_make_c_pointer_wrapper_with_type(sc, (void *)sc, s7_make_symbol(sc, "s7_scheme*"), s7_f(sc));
+    if (!s7_is_c_pointer_of_type(csc, s7_make_symbol(sc, "s7_scheme*")))
+      {fprintf(stderr, "c-pointer wrapper type %s != s7_scheme*\n", s1 = TO_STR(s7_c_pointer_type(csc))); free(s1);}
+  }
+  if (!s7_is_int_vector(s7_make_int_vector(sc, 3, 1, NULL)))
+    fprintf(stderr, "s7_make_int_vector did not make an int-vector\n");
+  if (s7_is_float_vector(s7_make_int_vector(sc, 3, 1, NULL)))
+    fprintf(stderr, "s7_make_int_vector made a float-vector?\n");
+
+  {
+    s7_int* dims;
+    s7_pointer p;
+    s7_double *els;
+    uint8_t *bels;
+    dims = (s7_int *)malloc(2 * sizeof(s7_int));
+    dims[0] = 2;
+    dims[1] = 3;
+
+    p = s7_make_int_vector(sc, 6, 2, dims);
+    if (s7_vector_rank(p) != 2) fprintf(stderr, "int vector rank not 2?\n");
+    p = s7_make_float_vector(sc, 6, 2, dims);
+    if (s7_vector_rank(p) != 2) fprintf(stderr, "float vector rank not 2?\n");
+    if (s7_vector_dimension(p, 0) != 2) fprintf(stderr, "%d: s7_vector_dimension 0: %" ld64 "\n", __LINE__, s7_vector_dimension(p, 0));
+    if (s7_vector_dimension(p, 1) != 3) fprintf(stderr, "%d: s7_vector_dimension 1: %" ld64 "\n", __LINE__, s7_vector_dimension(p, 1));
+
+    p = s7_make_float_vector(sc, 6, 1, NULL);
+    s7_float_vector_set(p, 1, 32.0);
+    if (s7_float_vector_ref(p, 1) != 32.0) fprintf(stderr, "float_vector[1] not 32.0?\n");
+    els = s7_float_vector_elements(p);
+    if (els[1] != 32.0) fprintf(stderr, "float_vector els[1] not 32.0?\n");
+    if (!s7_is_float_vector(p)) fprintf(stderr, "not a float_vector?\n");
+
+    p = s7_make_byte_vector(sc, 6, 2, dims);
+    s7_byte_vector_set(p, 1, 32);
+    if (s7_byte_vector_ref(p, 1) != 32) fprintf(stderr, "byte_vector[1] not 32?\n");
+    bels = s7_byte_vector_elements(p);
+    if (bels[1] != 32) fprintf(stderr, "byte_vector bels[1] not 32?\n");
+    if (!s7_is_byte_vector(p)) fprintf(stderr, "not a byte_vector?\n");
+    free(dims); /* ?? */
+  }
+
+  {
+    s7_pointer p, q;
+    s7_int *els;
+    p = s7_make_int_vector(sc, 6, 1, NULL);
+    s7_int_vector_set(p, 1, 32);
+    if (s7_int_vector_ref(p, 1) != 32) fprintf(stderr, "int_vector[1] not 32?\n");
+    els = s7_int_vector_elements(p);
+    if (els[1] != 32) fprintf(stderr, "int_vector els[1] not 32?\n");
+    if (!s7_is_int_vector(p)) fprintf(stderr, "not an int_vector?\n");
+    q = s7_vector_to_list(sc, p);
+    if (!s7_is_pair(q)) {fprintf(stderr, "%d vector->list is not a list %s\n", __LINE__, s1 = TO_STR(q)); free(s1);}
+    if (s7_list_length(sc, q) != 6) {fprintf(stderr, "%d vector->list len != 6 %s\n", __LINE__, s1 = TO_STR(q)); free(s1);}
+    if (s7_vector_dimension(p, 0) != 6) fprintf(stderr, "%d: s7_vector_dimension: %" ld64 "\n", __LINE__, s7_vector_dimension(p, 0));
+  }
+
+  {
+    s7_int* dims;
+    s7_pointer p;
+    s7_pointer *els;
+    dims = (s7_int *)malloc(2 * sizeof(s7_int));
+    dims[0] = 2;
+    dims[1] = 3;
+    p = s7_make_normal_vector(sc, 6, 2, dims);
+    if (s7_vector_rank(p) != 2) fprintf(stderr, "vector rank not 2?\n");
+    if (s7_vector_dimension(p, 0) != 2) fprintf(stderr, "%d: s7_vector_dimension 0: %" ld64 "\n", __LINE__, s7_vector_dimension(p, 0));
+    if (s7_vector_dimension(p, 1) != 3) fprintf(stderr, "%d: s7_vector_dimension 1: %" ld64 "\n", __LINE__, s7_vector_dimension(p, 1));
+    s7_vector_set(sc, p, 1, s7_make_integer(sc, 1));
+    if (s7_integer(s7_vector_ref(sc, p, 1)) != 1) fprintf(stderr, "vector[1] not 1?\n");
+    els = s7_vector_elements(p);
+    if (s7_integer(els[1]) != 1) fprintf(stderr, "vector els[1] not 1?\n");
+    if (!s7_is_vector(p)) fprintf(stderr, "not a vector?\n");
+    free(dims); /* ?? */
+  }
+
+  {
+    s7_int len;
+    len = s7_integer(s7_starlet_ref(sc, s7_make_symbol(sc, "print-length")));
+    s7_starlet_set(sc, s7_make_symbol(sc, "print-length"), s7_make_integer(sc, len));
+  }
+
+  p = s7_rationalize(sc, 1.5, 1e-12);
+  gc_loc = s7_gc_protect(sc, p);
+  s1 = TO_STR(p);
+  if (strcmp(s1, "3/2") != 0)
+    fprintf(stderr, "%d: ratio is %s?\n", __LINE__, s1);
+  free(s1);
+  s7_gc_unprotect_at(sc, gc_loc);
+
+  s7_set_default_random_state(sc, 1234, 5678);
+  s7_random(sc, NULL);
+  s7_stacktrace(sc);
+
+  if (s7_list(sc, 0) != s7_nil(sc))
+    fprintf(stderr, "s7_list 0 is not ()\n");
+  if (s7_list_nl(sc, 0, NULL) != s7_nil(sc))
+    fprintf(stderr, "s7_list_nl 0 is not ()\n");
+
+  p = s7_make_vector(sc, 12);
+  gc_loc = s7_gc_protect(sc, p);
+
+  if (!s7_is_vector(p))
+    {fprintf(stderr, "%d: %s is not a vector?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_type_of(sc, p) != s7_make_symbol(sc, "vector?"))
+    fprintf(stderr, "type-of(vector) confused?\n");
+
+  if (s7_vector_rank(p) != 1)
+    {fprintf(stderr, "%d: (dimensions %s) is not 1?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_vector_set(sc, p, 1, s7_t(sc));
+  if (s7_vector_ref(sc, p, 1) != s7_t(sc))
+    {fprintf(stderr, "%d: (%s 1) is not #t?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_vector_fill(sc, p, TO_S7_INT(123));
+  if (s7_integer(s7_vector_ref(sc, p, 1)) != 123)
+    {fprintf(stderr, "%d: (%s 1) is not 123?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_gc_unprotect_at(sc, gc_loc);
+
+  p = s7_make_and_fill_vector(sc, 3, TO_S7_INT(3));
+  gc_loc = s7_gc_protect(sc, p);
+
+  if (s7_integer(s7_vector_ref(sc, p, 1)) != 3)
+    {fprintf(stderr, "%d: (%s 1) is not 3?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p1 = s7_vector_copy(sc, p);
+  if ((p == p1) ||
+      (!s7_is_vector(p1)))
+    {fprintf(stderr, "%d: copied vector: %s\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+  s7_gc_unprotect_at(sc, gc_loc);
+
+
+  p = s7_make_string(sc, "1234");
+  gc_loc = s7_gc_protect(sc, p);
+
+  if (!s7_is_string(p))
+    {fprintf(stderr, "%d: %s is not a string?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_string_length(p) != 4)
+    {fprintf(stderr, "%d: (length %s) is 4?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (strcmp(s7_string(p), "1234") != 0)
+    {fprintf(stderr, "%d: %s is not \"1234\"?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (strcmp(s7_string(s7_copy(sc, s7_cons(sc, p, s7_nil(sc)))), "1234") != 0)
+    {fprintf(stderr, "%d: copy(%s) is not \"1234\"?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_fill(sc, s7_cons(sc, p, s7_cons(sc, s7_make_character(sc, 'c'), s7_nil(sc))));
+  if (strcmp(s7_string(p), "cccc") != 0)
+    {fprintf(stderr, "%d: fill(%s) is not \"cccc\"?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_gc_unprotect_at(sc, gc_loc);
+
+  p = s7_make_permanent_string(sc, "asdf");
+  perm1 = p;
+  if (!s7_is_string(p))
+    {fprintf(stderr, "%d: %s is not a string?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_string_length(p) != 4)
+    {fprintf(stderr, "%d: (length %s) is 4?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  {
+    s7_int gc_loc;
+    s7_pointer q;
+    p = s7_make_string_with_length(sc, "asdf", 4);
+    gc_loc = s7_gc_protect(sc, p);
+    if (!s7_is_string(p))
+      {fprintf(stderr, "%d: %s is not a string?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+    if (s7_string_length(p) != 4)
+      {fprintf(stderr, "%d: (length %s) is 4?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+    s7_gc_protect_via_location(sc, q = s7_make_string(sc, "fdsa"), gc_loc);
+    if (q != s7_gc_protected_at(sc, gc_loc))
+      {fprintf(stderr, "%d: wrong thing at gc_loc? %s\n", __LINE__, s1 = TO_STR(s7_gc_protected_at(sc, gc_loc))); free(s1);}
+    s7_gc_unprotect_via_location(sc, gc_loc);
+    p = s7_make_string_wrapper(sc, "hiho");
+    if (!s7_is_string(p))
+      {fprintf(stderr, "%d: %s is not a string?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+    if (s7_string_length(p) != 4)
+      {fprintf(stderr, "%d: (length %s) is 4?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  }
+
+  p = s7_make_character(sc, 65);
+  if (!s7_is_character(p))
+    {fprintf(stderr, "%d: %s is not a character?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_character(p) != 'A')
+    {fprintf(stderr, "%d: %s is not #\\A?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+
+  p = s7_list(sc, 3, TO_S7_INT(1), TO_S7_INT(2), TO_S7_INT(3));
+  gc_loc = s7_gc_protect(sc, p);
+  if (s7_tree_memq(sc, s7_make_symbol(sc, "oops"), p))
+    fprintf(stderr, "'oops is in the list?\n");
+
+  if (!s7_is_list(sc, p))
+    {fprintf(stderr, "%d: %s is not a list?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_list_length(sc, p) != 3)
+    {fprintf(stderr, "%d: (length %s) is not 3?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_integer(s7_list_ref(sc, p, 1)) != 2)
+    {fprintf(stderr, "%d: (%s 1) is not 2?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_integer(s7_car(p)) != 1)
+    {fprintf(stderr, "%d: (car %s) is not 1?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_integer(s7_cadr(p)) != 2)
+    {fprintf(stderr, "%d: (cadr %s) is not 2?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_integer(s7_caddr(p)) != 3)
+    {fprintf(stderr, "%d: (caddr %s) is not 2?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_integer(s7_car(s7_cddr(p))) != 3)
+    {fprintf(stderr, "%d: (car (cddr %s)) is not 2?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_list_set(sc, p, 1, s7_f(sc));
+  if (s7_list_ref(sc, p, 1) != s7_f(sc))
+    {fprintf(stderr, "%d: (%s 1) is not #f?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_gc_unprotect_at(sc, gc_loc);
+
+  p = s7_make_list(sc, 3, s7_make_integer(sc, 123));
+  if (!s7_is_list(sc, p))
+    {fprintf(stderr, "%d: %s is not a list?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_list_length(sc, p) != 3)
+    {fprintf(stderr, "%d: (length %s) is not 3?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_integer(s7_list_ref(sc, p, 1)) != 123)
+    {fprintf(stderr, "%d: (%s 1) is not 123?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_list_nl(sc, 3, TO_S7_INT(1), TO_S7_INT(2), TO_S7_INT(3), NULL);
+  gc_loc = s7_gc_protect(sc, p);
+  if (!s7_is_list(sc, p))
+    {fprintf(stderr, "%d: %s is not a list?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_list_length(sc, p) != 3)
+    {fprintf(stderr, "%d: (length %s) is not 3?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_integer(s7_list_ref(sc, p, 1)) != 2)
+    {fprintf(stderr, "%d: (%s 1) is not 2?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  s7_gc_unprotect_at(sc, gc_loc);
+
+  {
+    s7_pointer array[3];
+    for (i = 1; i < 4; i++) array[i - 1] = s7_make_integer(sc, i);
+    p = s7_array_to_list(sc, 3, array);
+    gc_loc = s7_gc_protect(sc, p);
+    if (!s7_is_list(sc, p))
+      {fprintf(stderr, "%d: %s is not a list?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+    if (s7_list_length(sc, p) != 3)
+      {fprintf(stderr, "%d: (length %s) is not 3?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+    if (s7_integer(s7_list_ref(sc, p, 1)) != 2)
+      {fprintf(stderr, "%d: (%s 1) is not 2?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+    s7_gc_unprotect_at(sc, gc_loc);
+  }
+  p = s7_array_to_list(sc, 0, NULL);
+  if (!s7_is_null(sc, p))
+    {fprintf(stderr, "%d: %s is not null?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  {
+    s7_pointer c1, c2, c3, c12, c23, c123, c1234, c1d2, c2d3, c3d4, c12d3, c23d4, c123d4, c1234d5;
+    s7_gc_on(sc, false);
+    c1 = s7_list(sc, 1, TO_S7_INT(1));                                              /* (1) */
+    c2 = s7_list(sc, 1, TO_S7_INT(2));                                              /* (2) */
+    c3 = s7_list(sc, 1, TO_S7_INT(3));                                              /* (3) */
+    c12 = s7_list(sc, 2, TO_S7_INT(1), TO_S7_INT(2));                               /* (1 2) */
+    c23 = s7_list(sc, 2, TO_S7_INT(2), TO_S7_INT(3));                               /* (2 3) */
+    c123 = s7_list(sc, 3, TO_S7_INT(1), TO_S7_INT(2), TO_S7_INT(3));                /* (1 2 3) */
+    c1234 = s7_list(sc, 4, TO_S7_INT(1), TO_S7_INT(2), TO_S7_INT(3), TO_S7_INT(4)); /* (1 2 3 4) */
+    c1d2 = s7_cons(sc, TO_S7_INT(1), TO_S7_INT(2));                                 /* (1 . 2) */
+    c2d3 = s7_cons(sc, TO_S7_INT(2), TO_S7_INT(3));                                 /* (2 . 3) */
+    c3d4 = s7_cons(sc, TO_S7_INT(3), TO_S7_INT(4));                                 /* (3 . 4) */
+    c12d3 = s7_cons(sc, TO_S7_INT(1), s7_cons(sc, TO_S7_INT(2), TO_S7_INT(3)));     /* (1 2 . 3) */
+    c23d4 = s7_cons(sc, TO_S7_INT(2), s7_cons(sc, TO_S7_INT(3), TO_S7_INT(4)));     /* (2 3 . 4) */
+    c123d4 = s7_cons(sc, TO_S7_INT(1), s7_cons(sc, TO_S7_INT(2), s7_cons(sc, TO_S7_INT(3), TO_S7_INT(4))));                             /* (1 2 3 . 4) */
+    c1234d5 = s7_cons(sc, TO_S7_INT(1), s7_cons(sc, TO_S7_INT(2), s7_cons(sc, TO_S7_INT(3), s7_cons(sc, TO_S7_INT(4), TO_S7_INT(5))))); /* (1 2 3 4 . 5) */
+
+    if (s7_integer(p = s7_caar(s7_list(sc, 1, c1))) != 1)
+      {fprintf(stderr, "%d: caar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cadr(c12)) != 2)
+      {fprintf(stderr, "%d: cadr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cdar(s7_list(sc, 1, c1d2))) != 2)
+      {fprintf(stderr, "%d: cdar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cddr(c12d3)) != 3)
+      {fprintf(stderr, "%d: cddr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_caaar(s7_list(sc, 1, s7_list(sc, 1, c1)))) != 1)
+      {fprintf(stderr, "%d: caaar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_caadr(s7_list(sc, 2, TO_S7_INT(1), c2))) != 2)
+      {fprintf(stderr, "%d: caadr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cadar(s7_list(sc, 1, c12))) != 2)
+      {fprintf(stderr, "%d: cadar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cdaar(s7_list(sc, 1, s7_list(sc, 1, c1d2)))) != 2)
+      {fprintf(stderr, "%d: cdaar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_caddr(c123)) != 3)
+      {fprintf(stderr, "%d: caddr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cdddr(c123d4)) != 4)
+      {fprintf(stderr, "%d: cdddr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cdadr(s7_list(sc, 2, TO_S7_INT(1), c2d3))) != 3)
+      {fprintf(stderr, "%d: cdadr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cddar(s7_list(sc, 1, c12d3))) != 3)
+      {fprintf(stderr, "%d: cddar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_caaaar(s7_list(sc, 1, s7_list(sc, 1, s7_list(sc, 1, c1))))) != 1)
+      {fprintf(stderr, "%d: caaaar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_caaadr(s7_list(sc, 2, TO_S7_INT(1), s7_list(sc, 1, c2)))) != 2)
+      {fprintf(stderr, "%d: caaadr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_caadar(s7_list(sc, 1, s7_list(sc, 2, TO_S7_INT(1), c2)))) != 2)
+      {fprintf(stderr, "%d: caadar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cadaar(s7_list(sc, 1, s7_list(sc, 1, c12)))) != 2)
+      {fprintf(stderr, "%d: cadaar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_caaddr(s7_list(sc, 3, TO_S7_INT(1), TO_S7_INT(2), c3))) != 3)
+      {fprintf(stderr, "%d: caaddr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cadddr(c1234)) != 4)
+      {fprintf(stderr, "%d: cadddr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cadadr(s7_list(sc, 2, TO_S7_INT(1), c23))) != 3)
+      {fprintf(stderr, "%d: cadadr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_caddar(s7_list(sc, 1, c123))) != 3)
+      {fprintf(stderr, "%d: caddar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cdaaar(s7_list(sc, 1, s7_list(sc, 1, s7_list(sc, 1, c1d2))))) != 2)
+      {fprintf(stderr, "%d: cdaaar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cdaadr(s7_list(sc, 2, TO_S7_INT(1), s7_list(sc, 1, c2d3)))) != 3)
+      {fprintf(stderr, "%d: cdaadr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cdadar(s7_list(sc, 1, s7_list(sc, 2, TO_S7_INT(1), c2d3)))) != 3)
+      {fprintf(stderr, "%d: cdadar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cddaar(s7_list(sc, 1, s7_list(sc, 1, c12d3)))) != 3)
+      {fprintf(stderr, "%d: cddaar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cdaddr(s7_list(sc, 3, TO_S7_INT(1), TO_S7_INT(2), c3d4))) != 4)
+      {fprintf(stderr, "%d: cdaddr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cddddr(c1234d5)) != 5)
+      {fprintf(stderr, "%d: cdddd is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cddadr(s7_list(sc, 2, TO_S7_INT(1), c23d4))) != 4)
+      {fprintf(stderr, "%d: cddadr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cdddar(s7_list(sc, 1, c123d4))) != 4)
+      {fprintf(stderr, "%d: cdddar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    p = s7_reverse(sc, c123);
+    s1 = TO_STR(p);
+    if (strcmp(s1, "(3 2 1)") != 0)
+      {fprintf(stderr, "%d: (reverse '(1 2 3)) is %s?\n", __LINE__, s1);}
+    free(s1);
+
+    p = s7_append(sc, c1, c2);
+    s1 = TO_STR(p);
+    if (strcmp(s1, "(1 2)") != 0)
+      {fprintf(stderr, "%d: (append '(1) '(2)) is %s?\n", __LINE__, s1);}
+    free(s1);
+
+    p = s7_list(sc, 2, s7_cons(sc, s7_make_symbol(sc, "a"), TO_S7_INT(32)), s7_cons(sc, s7_make_symbol(sc, "b"), TO_S7_INT(1)));
+    p1 = s7_assq(sc, s7_make_symbol(sc, "a"), p);
+    s1 = TO_STR(p1);
+    if (strcmp(s1, "(a . 32)") != 0)
+      {fprintf(stderr, "%d: (assq 'a '((a . 32) (b . 1)))) is %s?\n", __LINE__, s1);}
+    free(s1);
+
+    p1 = s7_assoc(sc, s7_make_symbol(sc, "b"), p);
+    s1 = TO_STR(p1);
+    if (strcmp(s1, "(b . 1)") != 0)
+      {fprintf(stderr, "%d: (assoc 'b '((a . 32) (b . 1))) is %s?\n", __LINE__, s1);}
+    free(s1);
+
+    p = s7_member(sc, TO_S7_INT(2), c1234);
+    s1 = TO_STR(p);
+    if (strcmp(s1, "(2 3 4)") != 0)
+      {fprintf(stderr, "%d: (member 2 '(1 2 3 4)) is %s?\n", __LINE__, s1);}
+    free(s1);
+
+    p = s7_list(sc, 2, s7_make_symbol(sc, "a"), s7_make_symbol(sc, "b"));
+    p1 = s7_memq(sc, s7_make_symbol(sc, "b"), p);
+    s1 = TO_STR(p1); /* s1 is "(b)" here but valgrind complains */
+    if (strcmp(s1, "(b)") != 0)
+      {fprintf(stderr, "%d: (memq 'b '(a b)) is %s?\n", __LINE__, s1);}
+    free(s1);
+
+    s7_set_car(c1234, s7_make_symbol(sc, "+"));
+    p = s7_eval(sc, c1234, s7_sublet(sc, s7_rootlet(sc), s7_nil(sc)));
+    if (s7_integer(p) != 9)
+      {fprintf(stderr, "%d: (eval '(+ 2 3 4)) is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+    s7_gc_on(sc, true);
+
+    p = s7_eval(sc, s7_cons(sc, s7_make_symbol(sc, "+"), /* s7.html example */
+               s7_cons(sc, s7_make_integer(sc, 1),
+                  s7_cons(sc, s7_make_integer(sc, 2), s7_nil(sc)))),
+               s7_nil(sc));
+    if (s7_integer(p) != 3)
+       {fprintf(stderr, "%d: (eval '(+ 1 2)) is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+    p = s7_eval_with_location(sc, s7_cons(sc, s7_make_symbol(sc, "+"),
+					  s7_cons(sc, s7_make_integer(sc, 1),
+						  s7_cons(sc, s7_make_integer(sc, 2), s7_nil(sc)))),
+			      s7_nil(sc), "ffitest", __FILE__, __LINE__);
+    if (s7_integer(p) != 3)
+       {fprintf(stderr, "%d: (eval '(+ 1 2)) is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+    p = s7_eval(sc, s7_cons(sc, s7_make_symbol(sc, "+"), /* s7.html example */
+               s7_cons(sc, s7_make_integer(sc, 1),
+                  s7_cons(sc, s7_make_integer(sc, 3), s7_nil(sc)))),
+               s7_rootlet(sc));
+    if (s7_integer(p) != 4)
+       {fprintf(stderr, "%d: (eval '(+ 1 3)) is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+    p = s7_eval_c_string(sc, "(+ 2 3)");
+    if (s7_integer(p) != 5)
+       {fprintf(stderr, "%d: (eval-string '(+ 2 3)) is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  }
+
+  s7_for_each_symbol_name(sc, symbol_func, NULL);
+  s7_for_each_symbol(sc, symbol_func_1, NULL);
+  s7_symbol_name(s7_make_symbol(sc, "a_symbol"));
+
+  {
+    const char *str = s7_symbol_name(s7_make_symbol(sc, "asdf"));
+    if (strcmp(str, "asdf") != 0)
+      fprintf(stderr, "%d: s7_symbol_name('asdf): %s\n", __LINE__, str);
+  }
+
+  p = s7_symbol_initial_value(s7_make_symbol(sc, "abs"));
+  if (p != s7_name_to_value(sc, "abs"))
+    {fprintf(stderr, "%d: s7_symbol_initial_value('abs): %s\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_symbol_set_initial_value(sc, s7_make_symbol(sc, "asdf"), s7_make_integer(sc, 321));
+  if (s7_integer(p) != 321)
+    {fprintf(stderr, "%d: s7_symbol_set_initial_value('asdf, 321): %s\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_make_hash_table(sc, 255);
+  gc_loc = s7_gc_protect(sc, p);
+
+  if (!s7_is_hash_table(p))
+    {fprintf(stderr, "%d: %s is not a hash-table?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_hash_table_ref(sc, p, s7_eof_object(sc)) != s7_f(sc))
+    {fprintf(stderr, "%d: (hash-table-ref %s #<eof>) is not #f?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_hash_table_set(sc, p, s7_eof_object(sc), s7_unspecified(sc));
+  if (s7_hash_table_ref(sc, p, s7_eof_object(sc)) != s7_unspecified(sc))
+    {fprintf(stderr, "%d: (hash-table-ref %s #<eof>) is not #<unspecified>?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  s7_gc_unprotect_at(sc, gc_loc);
+
+  p = s7_current_input_port(sc);
+  if (!s7_is_input_port(sc, p))
+    {fprintf(stderr, "%d: %s is not an input port?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  s7_port_line_number(sc, p);
+  s7_add_to_history(sc, s7_nil(sc));
+  s7_history(sc);
+
+  p = s7_current_output_port(sc);
+  if (!s7_is_output_port(sc, p))
+    {fprintf(stderr, "%d: %s is not an output port?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_name_to_value(sc, "abs");
+  if (!s7_is_procedure(p))
+    {fprintf(stderr, "%d: %s is not a procedure?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_make_symbol(sc, "abs");
+  if (!s7_is_symbol(p))
+    {fprintf(stderr, "%d: %s is not a symbol?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_is_syntax(p))
+    {fprintf(stderr, "%d: %s is syntax?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_gensym(sc, "abs");
+  if (!s7_is_symbol(p))
+    {fprintf(stderr, "%d: %s is not a symbol?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_make_keyword(sc, "key");
+  if (!s7_is_keyword(p))
+    {fprintf(stderr, "%d: %s is not a keyword?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_keyword_to_symbol(sc, p) != s7_make_symbol(sc, "key"))
+    fprintf(stderr, "%d: key->sym != sym?\n", __LINE__);
+
+  if (!s7_is_eq(p, p))
+    {fprintf(stderr, "%d: %s is not a self-eq??\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_rootlet(sc);
+  if (!s7_is_let(p))
+    {fprintf(stderr, "%d: %s is not an environment?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_curlet(sc);
+  if ((!s7_is_null(sc, p)) && (!s7_is_let(p)))
+    {fprintf(stderr, "%d: %s is not an environment?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_define_constant(sc, "a_constant", s7_t(sc));
+  if (!s7_is_immutable(s7_name_to_value(sc, "a_constant")))
+    {fprintf(stderr, "%d: a_constant is not a constant?\n", __LINE__);}
+  if (!s7_is_defined(sc, "a_constant"))
+    {fprintf(stderr, "%d: a_constant is not defined?\n", __LINE__);}
+  p = s7_symbol_table_find_name(sc, "a_constant");
+  if (!s7_is_symbol(p))
+    {fprintf(stderr, "%d: %s is not a symbol (from s7_symbol_find_name)?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_define_constant_with_documentation(sc, "another_constant", s7_t(sc), "another constant");
+  if (s7_name_to_value(sc, "another_constant") != s7_t(sc))
+    {fprintf(stderr, "%d: another_constant: %s?\n", __LINE__, s1 = TO_STR(s7_name_to_value(sc, "another_constant"))); free(s1);}
+  {
+    const char *s;
+    s = s7_documentation(sc, s7_make_symbol(sc, "another_constant"));
+    if ((!s) || (strcmp(s, "another constant") != 0))
+      fprintf(stderr, "%d: another_constant doc: %s\n", __LINE__, s);
+  }
+  s7_define_variable_with_documentation(sc, "another_variable", s7_t(sc), "another variable");
+  if (s7_name_to_value(sc, "another_variable") != s7_t(sc))
+    {fprintf(stderr, "%d: another_variable: %s?\n", __LINE__, s1 = TO_STR(s7_name_to_value(sc, "another_variable"))); free(s1);}
+  {
+    const char *s;
+    s = s7_documentation(sc, s7_make_symbol(sc, "another_variable"));
+    if ((!s) || (strcmp(s, "another variable") != 0))
+      fprintf(stderr, "%d: another_variable doc: %s\n", __LINE__, s);
+  }
+
+  s7_define_safe_function(sc, "a_function", a_function, 1, 0, false, "a function");
+  if (!s7_is_defined(sc, "a_function"))
+    {fprintf(stderr, "%d: a_function is not defined?\n", __LINE__);}
+  if (!s7_is_function(s7_name_to_value(sc, "a_function")))
+    {fprintf(stderr, "%d: a_function is not a function?\n", __LINE__);}
+
+  p = s7_apply_function(sc, s7_name_to_value(sc, "a_function"), s7_cons(sc, TO_S7_INT(32), s7_nil(sc)));
+  if (!s7_is_integer(p))
+    {fprintf(stderr, "%d: %s is not an integer?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_integer(p) != 32)
+    {fprintf(stderr, "%d: %s is not 32?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+
+  dax_type_tag = s7_make_c_type(sc, "dax");
+  s7_c_type_set_free(sc, dax_type_tag, free_dax);
+  s7_c_type_set_equal(sc, dax_type_tag, equal_dax);
+  s7_c_type_set_is_equal(sc, dax_type_tag, equality_dax);
+  s7_c_type_set_mark(sc, dax_type_tag, mark_dax);
+  s7_c_type_set_to_string(sc, dax_type_tag, dax_to_string);
+
+  s7_define_function(sc, "make-dax", make_dax, 2, 0, false, "(make-dax x data) makes a new dax");
+  s7_define_typed_function(sc, "dax?", is_dax, 1, 0, false, "(dax? anything) returns #t if its argument is a dax object", s7_make_signature(sc, 1, s7_t(sc)));
+  if (s7_car(s7_signature(sc, s7_name_to_value(sc, "dax?"))) != s7_t(sc))
+    {fprintf(stderr, "%d: dax? signature: %s\n", __LINE__, s1 = TO_STR(s7_signature(sc, s7_name_to_value(sc, "dax?")))); free(s1);}
+  p = s7_make_function(sc, "make-dax", make_dax, 2, 0, false, "(make-dax x data) makes a new dax");
+  if (!s7_is_procedure(p)) fprintf(stderr, "%d: make-dax is not a procedure\n", __LINE__);
+  p = s7_make_safe_function(sc, "make-dax", make_dax, 2, 0, false, "(make-dax x data) makes a new dax");
+  if (!s7_is_procedure(p)) fprintf(stderr, "%d: make-dax is not a (safe) procedure\n", __LINE__);
+
+  s7_define_variable(sc, "dax-x",
+                     s7_dilambda(sc, "dax-x", dax_x, 1, 0, set_dax_x, 2, 0, "dax x field (a real)"));
+
+  s7_define_variable(sc, "dax-xx",
+                     s7_typed_dilambda(sc, "dax-x", dax_x, 1, 0, set_dax_x, 2, 0, "dax x field (a real)",
+				       s7_make_signature(sc, 1, s7_make_symbol(sc, "real?")),
+				       s7_make_circular_signature(sc, 0, 1, s7_make_symbol(sc, "real?"))));
+
+  s7_define_variable(sc, "dax-data",
+                     s7_dilambda_with_environment(sc, s7_nil(sc), "dax-data", dax_data, 1, 0, set_dax_data, 2, 0, "dax data field"));
+
+  if (!s7_is_dilambda(s7_name_to_value(sc, "dax-x")))
+    {fprintf(stderr, "%d: dax-x is not a pws?\n", __LINE__);}
+
+  p = make_dax(sc, s7_cons(sc, s7_make_real(sc, 1.0), s7_cons(sc, TO_S7_INT(2), s7_nil(sc))));
+  gc_loc = s7_gc_protect(sc, p);
+
+  if (!s7_is_c_object(p))
+    {fprintf(stderr, "%d: %s is not a c_object?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p1 = s7_apply_function(sc, s7_name_to_value(sc, "dax?"), s7_cons(sc, p, s7_nil(sc)));
+  if (p1 != s7_t(sc))
+    {fprintf(stderr, "%d: %s is not a dax c_object?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s1 = TO_STR(p);
+  if (strcmp(s1, "#<dax 1.000 2>") != 0)
+    {fprintf(stderr, "%d: dax prints as %s?\n", __LINE__, s2 = TO_STR(p)); free(s2);}
+  free(s1);
+
+  p1 = s7_apply_function(sc, s7_name_to_value(sc, "dax-data"), s7_cons(sc, p, s7_nil(sc)));
+  if (!s7_is_integer(p1))
+    {fprintf(stderr, "%d: %s is not an integer?\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+  if (s7_integer(p1) != 2)
+    {fprintf(stderr, "%d: %s is not 2?\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+
+  s7_apply_function(sc, s7_setter(sc, s7_name_to_value(sc, "dax-data")), s7_cons(sc, p, s7_cons(sc, TO_S7_INT(32), s7_nil(sc))));
+  p1 = s7_apply_function(sc, s7_name_to_value(sc, "dax-data"), s7_cons(sc, p, s7_nil(sc)));
+  if (!s7_is_integer(p1))
+    {fprintf(stderr, "%d: %s is not an integer?\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+  if (s7_integer(p1) != 32)
+    {fprintf(stderr, "%d: %s is not 32?\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+
+  s7_gc_unprotect_at(sc, gc_loc);
+
+  s7_define_function(sc, "dx->list", dx_to_list, 1, 0, false, NULL);
+  dx_type_tag = s7_make_c_type(sc, "dx");
+  s7_c_type_set_gc_free(sc, dx_type_tag, free_dx);
+  s7_c_type_set_gc_mark(sc, dx_type_tag, mark_dx);
+  s7_c_type_set_getter(sc, dx_type_tag, s7_name_to_value(sc, "abs"));
+  s7_c_type_set_setter(sc, dx_type_tag, s7_name_to_value(sc, "list-ref"));
+  s7_c_type_set_to_list(sc, dx_type_tag, dx_to_list);
+
+  s7_define_function_star(sc, "plus", plus, "(red 32) blue", "an example of define* from C");
+  if (!s7_is_procedure(s7_name_to_value(sc, "plus")))
+    {fprintf(stderr, "%d: plus is not a function?\n", __LINE__);}
+
+  p = s7_apply_function(sc, s7_name_to_value(sc, "plus"), s7_cons(sc, TO_S7_INT(1), s7_cons(sc, TO_S7_INT(2), s7_nil(sc))));
+  if (!s7_is_integer(p))
+    {fprintf(stderr, "%d: %s is not an integer?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_integer(p) != 4)
+    {fprintf(stderr, "%d: %s is not 4?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  {
+    s7_int val;
+    val = s7_integer(s7_apply_function_star(sc, s7_name_to_value(sc, "plus"),
+					    s7_list(sc, 2, s7_make_integer(sc, 1), s7_make_integer(sc, 2))));
+    if (val != 4)
+      fprintf(stderr, "%d: plus: %" ld64 "\n", __LINE__, val);
+    val = s7_integer(s7_apply_function_star(sc, s7_name_to_value(sc, "plus"),
+					    s7_list(sc, 2, s7_make_keyword(sc, "blue"), s7_make_integer(sc, 2))));
+    if (val != 66)
+      fprintf(stderr, "%d: plus: %" ld64 "\n", __LINE__, val);
+    val = s7_integer(s7_apply_function_star(sc, s7_name_to_value(sc, "plus"),
+					    s7_list(sc, 2, s7_make_symbol(sc, ":blue"), s7_make_integer(sc, 2))));
+    if (val != 66)
+      fprintf(stderr, "%d: plus: %" ld64 "\n", __LINE__, val);
+    val = s7_integer(s7_apply_function_star(sc, s7_name_to_value(sc, "plus"),
+					    s7_list(sc, 2, s7_make_symbol(sc, "blue:"), s7_make_integer(sc, 2))));
+    if (val != 66)
+      fprintf(stderr, "%d: plus: %" ld64 "\n", __LINE__, val);
+  }
+
+  s7_define_function_star(sc, "plus1", plus1, "a b c", "an example of define* from C");
+  {
+    s7_int val;
+    val = s7_integer(s7_apply_function_star(sc, s7_name_to_value(sc, "plus1"),
+					    s7_list(sc, 3,
+						    s7_make_integer(sc, 4),
+						    s7_make_integer(sc, 5),
+						    s7_make_integer(sc, 6))));
+    if (val != 21)
+      fprintf(stderr, "plus1: %" ld64 "\n", val);
+
+    p = s7_make_c_object_without_gc(sc, dax_type_tag, perm2 = (void *)malloc(sizeof(dax)));
+    {
+      dax *o;
+      o = (dax *)malloc(sizeof(dax));
+      o->x = 1.0;
+      o->data = s7_nil(sc);
+      p = s7_make_c_object_with_let(sc, dax_type_tag, (void *)o, s7_sublet(sc, s7_curlet(sc), s7_nil(sc)));
+    }
+  }
+
+  {
+    s7_pointer old_port, val;
+    const char *doc;
+    old_port = s7_current_error_port(sc);
+
+    s7_define_function_star(sc, "fs1", fs1, "(opts (inlet 'f \"b\"))", NULL);
+    p = s7_make_symbol(sc, "fs1");
+    s7_set_documentation(sc, p, "new doc");
+    doc = s7_documentation(sc, p);
+    if ((!doc) || (strcmp(s7_documentation(sc, p), "new doc") != 0))
+      fprintf(stderr, "%d: s7_set_documentation: %s\n", __LINE__, s7_documentation(sc, p));
+    s7_define_typed_function_star(sc, "fs2", fs2, "", NULL, s7_make_signature(sc, 1, s7_t(sc)));
+    if (s7_car(s7_signature(sc, s7_name_to_value(sc, "fs2"))) != s7_t(sc))
+      {fprintf(stderr, "%d: fs2 signature: %s\n", __LINE__, s1 = TO_STR(s7_signature(sc, s7_name_to_value(sc, "fs2")))); free(s1);}
+    s7_set_current_error_port(sc, s7_f(sc));
+    s7_define_function_star(sc, "fs3", fs3, ":allow-other-keys", NULL);
+    s7_set_current_error_port(sc, old_port);
+    s7_define_function_star(sc, "fs31", fs31, "(a 32) :allow-other-keys", NULL);
+
+    s7_define_safe_function_star(sc, "fs4", fs4, "(opts (inlet 'f \"b\"))", NULL);
+    s7_define_safe_function_star(sc, "fs5", fs5, "", NULL);
+    s7_set_current_error_port(sc, s7_f(sc));
+    s7_define_safe_function_star(sc, "fs6", fs6, ":allow-other-keys", NULL);
+    s7_set_current_error_port(sc, old_port);
+    s7_define_safe_function_star(sc, "fs61", fs61, "(a #(0)) :allow-other-keys", NULL);
+    val = s7_make_function_star(sc, "fs4", fs4, "(opts (inlet 'f \"b\"))", NULL);
+    if (!s7_is_procedure(val)) fprintf(stderr, "%d: fs4 is not a procedure\n", __LINE__);
+    val = s7_make_safe_function_star(sc, "fs4", fs4, "(opts (inlet 'f \"b\"))", NULL);
+    if (!s7_is_procedure(val)) fprintf(stderr, "%d: fs4 is not a (safe) procedure\n", __LINE__);
+
+    val = s7_eval_c_string(sc, "(fs1)");
+    if (!s7_is_let(val)) {fprintf(stderr, "(fs1): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs1 #f)");
+    if (!s7_is_eq(val, s7_f(sc))) {fprintf(stderr, "(fs1 #f): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs2)");
+    if (!s7_is_null(sc, val)) {fprintf(stderr, "(fs2): %s\n", s1 = TO_STR(val)); free(s1);}
+
+    val = s7_eval_c_string(sc, "(fs31)");
+    if (s7_integer(val) != 32) {fprintf(stderr, "(fs31): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs31 32)");
+    if (s7_integer(val) != 32) {fprintf(stderr, "(fs31 32): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs31 :a 31)");
+    if (s7_integer(val) != 31) {fprintf(stderr, "(fs31 :a 31): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs31 :ignored #f)");
+    if (s7_integer(val) != 32) {fprintf(stderr, "(fs31 :ignored #f): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs31 :a 30 :ignored #f)");
+    if (s7_integer(val) != 30) {fprintf(stderr, "(fs31 :a 30 :ignored #f): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs31 :ignored #f :a 29)");
+    if (s7_integer(val) != 29) {fprintf(stderr, "(fs31 :ignored #f :a 29): %s\n", s1 = TO_STR(val)); free(s1);}
+
+    val = s7_eval_c_string(sc, "(fs4)");
+    if (!s7_is_let(val)) {fprintf(stderr, "(fs4): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs4 #f)");
+    if (!s7_is_eq(val, s7_f(sc))) {fprintf(stderr, "(fs4 #f): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs5)");
+    if (!s7_is_null(sc, val)) {fprintf(stderr, "(fs5): %s\n", s1 = TO_STR(val)); free(s1);}
+
+    val = s7_eval_c_string(sc, "(fs61)");
+    if (!s7_is_vector(val)) {fprintf(stderr, "(fs61): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs61 32)");
+    if (s7_integer(val) != 32) {fprintf(stderr, "(fs61 32): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs61 :a 31)");
+    if (s7_integer(val) != 31) {fprintf(stderr, "(fs61 :a 31): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs61 :ignored #f)");
+    if (!s7_is_vector(val)) {fprintf(stderr, "(fs61 :ignored #f): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs61 :a 30 :ignored #f)");
+    if (s7_integer(val) != 30) {fprintf(stderr, "(fs61 :a 30 :ignored #f): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs61 :ignored #f :a 29)");
+    if (s7_integer(val) != 29) {fprintf(stderr, "(fs61 :ignored #f :a 29): %s\n", s1 = TO_STR(val)); free(s1);}
+  }
+
+  p = s7_apply_function(sc, s7_name_to_value(sc, "plus"), s7_cons(sc, s7_make_keyword(sc, "blue"), s7_cons(sc, TO_S7_INT(2), s7_nil(sc))));
+  if (!s7_is_integer(p))
+    {fprintf(stderr, "%d: %s is not an integer?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_integer(p) != 66)
+    {fprintf(stderr, "%d: %s is not 66?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_define_variable(sc, "my-1", s7_make_integer(sc, 1));
+  p = s7_name_to_value(sc, "my-1");
+  if (!s7_is_integer(p))
+    {fprintf(stderr, "%d: %s is not an integer?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_integer(p) != 1)
+    {fprintf(stderr, "%d: %s is not 1?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_symbol_set_value(sc, s7_make_symbol(sc, "my-1"), s7_make_integer(sc, 32));
+  p = s7_name_to_value(sc, "my-1");
+  if (s7_integer(p) != 32)
+    {fprintf(stderr, "%d: %s is not 32?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+
+  s7_define_macro(sc, "mac-plus", mac_plus, 2, 0, false, "plus adds its two arguments");
+  p = s7_eval_c_string(sc, "(mac-plus 2 3)");
+  if (s7_integer(p) != 5)
+    {fprintf(stderr, "%d: %s is not 5?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  p1 = s7_apply_function(sc,
+	s7_name_to_value(sc, "mac-plus"),
+	s7_list(sc, 2, s7_make_integer(sc, 3), s7_make_integer(sc, 4)));
+  p = s7_eval(sc, p1, s7_rootlet(sc));
+  if ((!s7_is_integer(p)) ||
+      (s7_integer(p) != 7))
+    {char *s2; fprintf(stderr, "%d: %s -> %s is not 7?\n", __LINE__, s1 = TO_STR(p1), s2 = TO_STR(p)); free(s1); free(s2);}
+
+  s7_define_macro(sc, "mac-plus-mv", mac_plus_mv, 2, 0, false, "macro values test");
+  p = s7_eval_c_string(sc, "(let () (+ (mac-plus-mv 2 3)))");
+  if (s7_integer(p) != 5)
+    {fprintf(stderr, "%d: %s is not 5?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_values(sc, s7_list(sc, 2, s7_make_integer(sc, 1), s7_make_integer(sc, 2)));
+  if (!s7_is_multiple_value(p))
+    {fprintf(stderr, "%d: %s is not a multiple-values object?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  p = s7_values(sc, s7_nil(sc));
+  if ((!s7_is_unspecified(sc, p)) || (p == s7_unspecified(sc)))
+    {fprintf(stderr, "%d: %s is not a no-values object?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  p = s7_values(sc, s7_list(sc, 1, s7_f(sc)));
+  if (s7_is_multiple_value(p))
+    {fprintf(stderr, "%d: %s is a multiple-values object?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_define_semisafe_typed_function(sc, "open-plus", open_plus, 1, 0, true, plus_help, s7_make_circular_signature(sc, 1, 2, s7_make_symbol(sc, "number?"), s7_t(sc)));
+  p = s7_sublet(sc, s7_rootlet(sc), s7_cons(sc, s7_cons(sc, s7_make_symbol(sc, "plus"), s7_name_to_value(sc, "plus")), s7_nil(sc)));
+  s7_openlet(sc, p);
+  p1 = s7_apply_function(sc, s7_name_to_value(sc, "open-plus"), s7_list(sc, 3, p, s7_make_integer(sc, 2), s7_make_integer(sc, 3)));
+  if ((!s7_is_integer(p1)) ||
+      (s7_integer(p1) != 7))
+    {fprintf(stderr, "%d: %s is not 7?\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+
+
+  s7_eval_c_string(sc,  "(define my-vect (make-vector '(2 3 4) 0))");
+  s7_eval_c_string(sc,  "(set! (my-vect 1 1 1) 32)");
+  p1 = s7_name_to_value(sc, "my-vect");
+
+  p = s7_vector_ref_n(sc,  p1, 3, 0LL, 0LL, 0LL);
+  if (s7_integer(p) != 0)
+    {fprintf(stderr, "%d: %s is not 0?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_vector_ref_n(sc,  p1, 3, 0LL, 0LL, 0LL);
+  if (s7_integer(p) != 0)
+    {fprintf(stderr, "%d: %s is not 0?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_vector_ref_n(sc,  p1, 3, 1LL, 1LL, 1LL);
+  if (s7_integer(p) != 32)
+    {fprintf(stderr, "%d: %s is not 32?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_vector_ref_n(sc,  p1, 3, 1LL, 1LL, 1LL);
+  if (s7_integer(p) != 32)
+    {fprintf(stderr, "%d: %s is not 32?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_vector_set_n(sc,  p1, TO_S7_INT(12), 3, 1LL, 1LL, 2LL);
+  p = s7_vector_ref_n(sc,  p1, 3, 1LL, 1LL, 2LL);
+  if (s7_integer(p) != 12)
+    {fprintf(stderr, "%d: %s is not 12?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_vector_length(p1) != 24)
+    {fprintf(stderr, "%d: (length %s) is not 24?\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+  if (s7_vector_rank(p1) != 3)
+    {fprintf(stderr, "%d: (vector-dimensions %s) is not 3?\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+
+  {
+    s7_int *dims, *offs;
+    s7_pointer *els;
+    s7_int ndims;
+
+    ndims = s7_vector_rank(p1);
+    dims = (s7_int *)malloc(ndims * sizeof(s7_int));
+    offs = (s7_int *)malloc(ndims * sizeof(s7_int));
+    s7_vector_dimensions(p1, dims, ndims);
+    s7_vector_offsets(p1, offs, ndims);
+    els = s7_vector_elements(p1);
+
+    if (dims[0] != 2) fprintf(stderr, "%d: dims[0]: %" ld64 "?\n", __LINE__, dims[0]);
+    if (dims[1] != 3) fprintf(stderr, "%d: dims[1]: %" ld64 "?\n", __LINE__, dims[1]);
+    if (dims[2] != 4) fprintf(stderr, "%d: dims[2]: %" ld64 "?\n", __LINE__, dims[2]);
+    if (offs[0] != 12) fprintf(stderr, "%d: offs[0]: %" ld64 "?\n", __LINE__, offs[0]);
+    if (offs[1] != 4) fprintf(stderr, "%d: offs[1]: %" ld64 "?\n", __LINE__, offs[1]);
+    if (s7_integer(p = els[12 + 4 + 1]) != 32)
+      {fprintf(stderr, "%d: %s is not 32?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    free(dims);
+    free(offs);
+  }
+
+  s7_vector_fill(sc, p1, s7_t(sc));
+  p = s7_vector_ref_n(sc,  p1, 3, 1LL, 1LL, 1LL);
+  if (p != s7_t(sc))
+    {fprintf(stderr, "%d: %s is not #t?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+
+  {
+    s7_pointer new_env, old_env;
+    new_env = s7_sublet(sc, old_env = s7_curlet(sc), s7_nil(sc));
+    gc_loc = s7_gc_protect(sc, new_env);
+
+    s7_define(sc, new_env, s7_make_symbol(sc, "var1"), s7_make_integer(sc, 32));
+
+    if (new_env == s7_curlet(sc))
+      {fprintf(stderr, "%d: %s is the current env?\n", __LINE__, s1 = TO_STR(new_env)); free(s1);}
+
+    s1 = TO_STR(s7_let_to_list(sc, new_env));
+    if (strcmp(s1, "((var1 . 32))") != 0)
+      {fprintf(stderr, "%d: new-env is %s?\n", __LINE__, s1);}
+    free(s1);
+
+    p = s7_let_ref(sc, new_env, s7_make_symbol(sc, "var1"));
+    if (s7_integer(p) != 32)
+      {fprintf(stderr, "%d: %s is not 32?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    s7_let_set(sc, new_env, s7_make_symbol(sc, "var1"), TO_S7_INT(3));
+    p = s7_let_ref(sc, new_env, s7_make_symbol(sc, "var1"));
+    if (s7_integer(p) != 3)
+      {fprintf(stderr, "%d: %s is not 3?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    s7_set_curlet(sc, new_env);
+    p = s7_slot(sc, s7_make_symbol(sc, "var1"));
+    if (s7_integer(s7_slot_value(p)) != 3)
+      {fprintf(stderr, "%d: slot-value %s is not 3?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    s7_slot_set_value(sc, p, s7_f(sc));
+    p = s7_let_ref(sc, new_env, s7_make_symbol(sc, "var1"));
+    if (p != s7_f(sc))
+      {fprintf(stderr, "%d: set slot-value %s is not #f?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if ((s7_outlet(sc, new_env) != old_env) && (old_env != s7_nil(sc)))
+      {fprintf(stderr, "%d: outer-env %s?\n", __LINE__, s1 = TO_STR(old_env)); free(s1);}
+
+    s7_make_slot(sc, new_env, s7_make_symbol(sc, "var2"), TO_S7_INT(-1));
+    p = s7_let_ref(sc, new_env, s7_make_symbol(sc, "var2"));
+    if (s7_integer(p) != -1)
+      {fprintf(stderr, "%d: make_slot %s is not -1?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    s7_symbol_set_value(sc, s7_make_symbol(sc, "var2"), s7_t(sc));
+    p = s7_symbol_local_value(sc, s7_make_symbol(sc, "var2"), new_env);
+    if (p != s7_t(sc))
+      {fprintf(stderr, "%d: set symbol-value %s is not #t?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    p = s7_let_to_list(sc, new_env);
+    {
+      int gloc;
+      gloc = s7_gc_protect(sc, p);
+      s1 = TO_STR(p);
+      if ((strcmp(s1, "((var2 . #t) (var1 . #f))") != 0) && (strcmp(s1, "((var1 . #f) (var2 . #t))") != 0))
+	{fprintf(stderr, "%d: env->list: %s\n", __LINE__, s1);}
+      free(s1);
+      s7_gc_unprotect_at(sc, gloc);
+    }
+
+    s7_define_constant_with_environment(sc, new_env, "new-env-var", s7_make_integer(sc, 123));
+    if (s7_integer(s7_name_to_value(sc, "new-env-var")) != 123)
+      {fprintf(stderr, "%d: constant: %s\n", __LINE__, s1 = TO_STR(s7_name_to_value(sc, "new-env-var"))); free(s1);}
+
+    s7_set_curlet(sc, old_env);
+    s7_gc_unprotect_at(sc, gc_loc);
+  }
+
+  {
+    s7_pointer e, yp, old_e, arg;
+    e = s7_sublet(sc, s7_curlet(sc), s7_nil(sc));
+    s7_gc_protect_via_stack(sc, e);
+    old_e = s7_set_curlet(sc, e);
+    arg = s7_make_symbol(sc, "arg");
+    yp = s7_make_slot(sc, e, arg, s7_make_mutable_real(sc, 1.0));
+    s7_gc_protect_2_via_stack(sc, yp, old_e);
+    if (s7_real(s7_slot_value(yp)) != 1.0)
+      {fprintf(stderr, "%d: mutable real slot-value %s is not 1.0?\n", __LINE__, s1 = TO_STR(s7_slot_value(yp))); free(s1);}
+    s7_slot_set_real_value(sc, yp, 2.0);
+    if (s7_real(s7_slot_value(yp)) != 2.0)
+      {fprintf(stderr, "%d: mutable real slot-value %s is not 2.0?\n", __LINE__, s1 = TO_STR(s7_slot_value(yp))); free(s1);}
+    s7_varlet(sc, e, s7_make_symbol(sc, "new-var"), s7_make_integer(sc, 123));
+    if (s7_integer(s7_name_to_value(sc, "new-var")) != 123)
+      {fprintf(stderr, "%d: new-var: %s\n", __LINE__, s1 = TO_STR(s7_name_to_value(sc, "new-var"))); free(s1);}
+    s7_set_curlet(sc, old_e);
+    s7_gc_unprotect_via_stack(sc, e);
+  }
+
+  if (!s7_is_list(sc, p = s7_load_path(sc)))
+    {fprintf(stderr, "%d: %s is not a list?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  s7_add_to_load_path(sc, "/home/bil/");
+  if (!s7_is_pair(s7_member(sc, s7_make_string(sc, "/home/bil/"), s7_load_path(sc))))
+    {fprintf(stderr, "/home/bil/ not in *load-path*: %s\n", s1 = TO_STR(s7_load_path(sc))); free(s1);}
+
+  {
+    s7_pointer port;
+    port = s7_open_output_file(sc, "ffitest.scm", "w");
+
+    if (!s7_is_output_port(sc, port))
+      {fprintf(stderr, "%d: %s is not an output port?\n", __LINE__, s1 = TO_STR(port)); free(s1);}
+    else
+      {
+	/* (define loaded_var 321) hopefully */
+	gc_loc = s7_gc_protect(sc, port);
+	s7_write_char(sc, s7_make_character(sc, (uint8_t)'('), port);
+	s7_write(sc, s7_make_symbol(sc, "define"), port);
+	s7_write_char(sc, s7_make_character(sc, (uint8_t)' '), port);
+	s7_display(sc, s7_make_symbol(sc, "loaded_var"), port);
+	s7_write_char(sc, s7_make_character(sc, (uint8_t)' '), port);
+	s7_format(sc, s7_list(sc, 3, port, s7_make_string(sc, "~A)"), TO_S7_INT(321)));
+	s7_newline(sc, port);
+	s7_flush_output_port(sc, port);
+	s7_close_output_port(sc, port);
+	s7_gc_unprotect_at(sc, gc_loc);
+
+	s7_load(sc, "ffitest.scm");
+	if (!s7_is_defined(sc, "loaded_var"))
+	  {fprintf(stderr, "%d: load ffitest.scm unhappy?\n", __LINE__);}
+	else
+	  {
+	    if (s7_integer(p = s7_name_to_value(sc, "loaded_var")) != 321)
+	      {fprintf(stderr, "%d: %s is not 321?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+	    port = s7_open_input_file(sc, "ffitest.scm", "r");
+	    if (!s7_is_input_port(sc, port))
+	      {fprintf(stderr, "%d: %s is not an input port?\n", __LINE__, s1 = TO_STR(port)); free(s1);}
+	    else
+	      {
+		uint8_t c;
+		const char *filename;
+		gc_loc = s7_gc_protect(sc, port);
+		c = s7_character(s7_peek_char(sc, port));
+		if (c != (int)'(')
+		  {fprintf(stderr, "%d: peek-char sees %c?\n", __LINE__, (unsigned char)c);}
+
+		c = s7_character(s7_read_char(sc, port));
+		if (c != (uint8_t)'(')
+		  {fprintf(stderr, "%d: read-char sees %c?\n", __LINE__, (unsigned char)c);}
+
+		filename = s7_port_filename(sc, port);
+		if (strcmp(filename, "ffitest.scm") != 0)
+		  fprintf(stderr, "%d: s7_port_filename: %s\n", __LINE__, filename);
+
+		s7_close_input_port(sc, port);
+		s7_gc_unprotect_at(sc, gc_loc);
+
+		port = s7_open_input_file(sc, "ffitest.scm", "r");
+		gc_loc = s7_gc_protect(sc, port);
+
+		p = s7_read(sc, port);
+		s1 = TO_STR(p);
+		if (strcmp(s1, "(define loaded_var 321)") != 0)
+		  {fprintf(stderr, "%d: read file sees %s?\n", __LINE__, s1);}
+		free(s1);
+
+		s7_close_input_port(sc, port);
+		s7_gc_unprotect_at(sc, gc_loc);
+	      }
+	  }
+      }
+
+    {
+      s7_pointer e, val;
+      e = s7_inlet(sc, s7_nil(sc));
+      gc_loc = s7_gc_protect(sc, e);
+      val = s7_load_with_environment(sc, "~/ffitest.scm", e);
+      if (val)
+	fprintf(stderr, "%d: load ~/ffitest.scm found!?\n", __LINE__);
+      val = s7_load_with_environment(sc, "~/cl/ffitest.scm", e);
+      if (!val)
+	fprintf(stderr, "%d: load ~/cl/ffitest.scm not found\n", __LINE__);
+      else
+	{
+	  if (s7_symbol_local_value(sc, s7_make_symbol(sc, "loaded_var"), e) == s7_undefined(sc))
+	    {fprintf(stderr, "%d: load ~/ffitest.scm unhappy? %s\n", __LINE__, s1 = TO_STR(e)); free(s1);}
+	}
+      val = s7_load(sc, "/home/bil/snd-motif/");
+      if (val)
+	fprintf(stderr, "s7_load(directory) did not fail?\n");
+      s7_gc_unprotect_at(sc, gc_loc);
+    }
+
+    {
+      s7_pointer e;
+      unsigned char another_var[] = {0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x61, 0x6e, 0x6f, 0x74, /* (define another-var 123)\n */
+				     0x68, 0x65, 0x72, 0x2d, 0x76, 0x61, 0x72, 0x20, 0x31, 0x32, 0x33, 0x29,
+				     0x0a, 0};
+      unsigned int another_var_len = 25;
+      unsigned char yet_another_var[] = {0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x79, 0x65, 0x74, 0x2d, /* (define yet-another-var 123)\n */
+					 0x61, 0x6e, 0x6f, 0x74, 0x68, 0x65, 0x72, 0x2d, 0x76, 0x61, 0x72, 0x20,
+					 0x31, 0x32, 0x33, 0x29, 0x0a, 0};
+      unsigned int yet_another_var_len = 29;
+      unsigned char a_global_var[] = {0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x61, 0x2d, 0x67, 0x6c, /* (define a_global_var 321)\n */
+				      0x6f, 0x62, 0x61, 0x6c, 0x2d, 0x76, 0x61, 0x72, 0x20, 0x33, 0x32, 0x31,
+				      0x29, 0x0a, 0};
+      unsigned int a_global_var_len = 26;
+
+      unsigned char a_test_var[] = {0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x61, 0x2d, 0x74, 0x65,
+				    0x73, 0x74, 0x2d, 0x76, 0x61, 0x72, 0x20, 0x33, 0x32, 0x31, 0x29, 0x0a, 0};
+      unsigned int a_test_var_len = 24;
+
+      s7_load_c_string(sc, (const char *)another_var, another_var_len);
+      p = s7_symbol_value(sc, s7_make_symbol(sc, "another-var"));
+      if (s7_integer(p) != 123)
+	{fprintf(stderr, "load_c_string: %s\n", s1 = TO_STR(p)); free(s1);}
+
+      e = s7_inlet(sc, s7_nil(sc));
+      gc_loc = s7_gc_protect(sc, e);
+      s7_load_c_string_with_environment(sc, (const char *)yet_another_var, yet_another_var_len, e);
+      p = s7_symbol_local_value(sc, s7_make_symbol(sc, "yet-another-var"), e);
+      if (s7_integer(p) != 123)
+	{fprintf(stderr, "load_c_string_with_environment: %s\n", s1 = TO_STR(p)); free(s1);}
+      s7_gc_unprotect_at(sc, gc_loc);
+
+      s7_load_c_string_with_environment(sc, (const char *)a_global_var, a_global_var_len, s7_nil(sc));
+      p = s7_symbol_value(sc, s7_make_symbol(sc, "a-global-var"));
+      if (s7_integer(p) != 321)
+	{fprintf(stderr, "load_c_string_with_environment nil: %s\n", s1 = TO_STR(p)); free(s1);}
+
+      s7_load_c_string_with_environment(sc, (const char *)a_test_var, a_test_var_len, s7_rootlet(sc));
+      p = s7_symbol_value(sc, s7_make_symbol(sc, "a-test-var"));
+      if (s7_integer(p) != 321)
+	{fprintf(stderr, "load_c_string_with_environment rootlet: %s\n", s1 = TO_STR(p)); free(s1);}
+
+      s7_load_with_environment(sc, "~/cl/ffitest.scm", s7_rootlet(sc));  /* rootlet=segfault 10-Jul-21 */
+    }
+
+    port = s7_open_input_string(sc, "(+ 1 2)");
+    if (!s7_is_input_port(sc, port))
+      {fprintf(stderr, "%d: %s is not an input port?\n", __LINE__, s1 = TO_STR(port)); free(s1);}
+    gc_loc = s7_gc_protect(sc, port);
+    p = s7_read(sc, port);
+    s1 = TO_STR(p);
+    if (strcmp(s1, "(+ 1 2)") != 0)
+      {fprintf(stderr, "%d: read string sees %s?\n", __LINE__, s1);}
+    free(s1);
+    s7_close_input_port(sc, port);
+    s7_gc_unprotect_at(sc, gc_loc);
+
+    /* make sure s7_read does not ignore #<eof> */
+    port = s7_open_input_string(sc, "(define aaa 32)\n(define bbb 33)\n");
+    if (!s7_is_input_port(sc, port))
+      {fprintf(stderr, "%d: %s is not an input port?\n", __LINE__, s1 = TO_STR(port)); free(s1);}
+    gc_loc = s7_gc_protect(sc, port);
+    while(true)
+      {
+	s7_pointer code;
+	code = s7_read(sc, port);
+	if (code == s7_eof_object(sc)) break;
+	s7_eval(sc, code, s7_nil(sc));
+      }
+    s7_close_input_port(sc, port);
+    s7_gc_unprotect_at(sc, gc_loc);
+
+    port = s7_open_input_string(sc, "(define ccc 34)\n(define ddd 35)");
+    if (!s7_is_input_port(sc, port))
+      {fprintf(stderr, "%d: %s is not an input port?\n", __LINE__, s1 = TO_STR(port)); free(s1);}
+    gc_loc = s7_gc_protect(sc, port);
+    while(true)
+      {
+	s7_pointer code;
+	code = s7_read(sc, port);
+	if (code == s7_eof_object(sc)) break;
+	s7_eval(sc, code, s7_nil(sc));
+      }
+    s7_close_input_port(sc, port);
+    s7_gc_unprotect_at(sc, gc_loc);
+    {
+      s7_pointer val;
+      val = s7_name_to_value(sc, "aaa");
+      if ((!s7_is_integer(val)) || (s7_integer(val) != 32))
+	{fprintf(stderr, "aaa: %s\n", s1 = TO_STR(val)); free(s1);}
+      val = s7_name_to_value(sc, "bbb");
+      if ((!s7_is_integer(val)) || (s7_integer(val) != 33))
+	{fprintf(stderr, "bbb: %s\n", s1 = TO_STR(val)); free(s1);}
+      val = s7_name_to_value(sc, "ccc");
+      if ((!s7_is_integer(val)) || (s7_integer(val) != 34))
+	{fprintf(stderr, "ccc: %s\n", s1 = TO_STR(val)); free(s1);}
+      val = s7_name_to_value(sc, "ddd");
+      if ((!s7_is_integer(val)) || (s7_integer(val) != 35))
+	{fprintf(stderr, "ddd: %s\n", s1 = TO_STR(val)); free(s1);}
+    }
+
+    port = s7_open_output_string(sc);
+    if (!s7_is_output_port(sc, port))
+      {fprintf(stderr, "%d: %s is not an output port?\n", __LINE__, s1 = TO_STR(port)); free(s1);}
+    gc_loc = s7_gc_protect(sc, port);
+    s7_display(sc, s7_make_string(sc, "(+ 2 3)"), port);
+    {
+      const char *s2;
+      s7_pointer s3;
+      s2 = s7_get_output_string(sc, port);
+      if (strcmp(s2, "(+ 2 3)") != 0)
+	{fprintf(stderr, "%d: s7_get_output_string returns %s?\n", __LINE__, s2);}
+      s3 = s7_output_string(sc, port);
+      if ((!s7_is_string(s3)) ||
+	  (strcmp(s7_string(s3), "(+ 2 3)") != 0))
+	{fprintf(stderr, "%d: s7_output_string returns %s?\n", __LINE__, s2);}
+    }
+    s7_close_output_port(sc, port);
+    s7_gc_unprotect_at(sc, gc_loc);
+
+    p = s7_set_current_output_port(sc, s7_open_output_function(sc, my_print));
+    p1 = s7_open_input_function(sc, my_read);
+    gc_loc = s7_gc_protect(sc, p1);
+
+    s7_display(sc, s7_make_character(sc, '3'), s7_current_output_port(sc));
+    if (last_c != '3')
+      {fprintf(stderr, "%d: last_c: %c, c: %c\n", __LINE__, last_c, '3');}
+    last_c = s7_character(s7_read_char(sc, p1));
+    if (last_c != '0')
+      {fprintf(stderr, "%d: last_c: %c\n", __LINE__, last_c);}
+    s7_set_current_output_port(sc, p);
+    s7_gc_unprotect_at(sc, gc_loc);
+  }
+
+  {
+    s7_pointer port, val;
+    s7_autoload(sc, s7_make_symbol(sc, "auto_var"), s7_make_string(sc, "ffitest.scm"));
+    port = s7_open_output_file(sc, "ffitest.scm", "w");
+    gc_loc = s7_gc_protect(sc, port);
+    s7_display(sc, s7_make_string(sc, "(define auto_var 123)"), port);
+    s7_newline(sc, port);
+    s7_close_output_port(sc, port);
+    s7_gc_unprotect_at(sc, gc_loc);
+    val = s7_eval_c_string(sc, "(+ auto_var 1)");
+    if ((!s7_is_integer(val)) ||
+	(s7_integer(val) != 124))
+      {fprintf(stderr, "%d: auto_var+1 = %s?\n", __LINE__, s1 = TO_STR(val)); free(s1);}
+    s7_autoload_set_names(sc, snd_names, 8);
+  }
+
+  {
+    s7_pointer test_hook;
+    test_hook = s7_eval_c_string(sc, "(make-hook 'a 'b)");
+    s7_define_constant(sc, "test-hook", test_hook);
+    s7_hook_set_functions(sc, test_hook,
+			  s7_cons(sc, s7_make_function(sc, "test-hook-function", test_hook_function, 1, 0, false, "a test-hook function"),
+				  s7_hook_functions(sc, test_hook)));
+    s7_call(sc, test_hook, s7_list(sc, 2, TO_S7_INT(1), TO_S7_INT(2)));
+    s7_call_with_location(sc, test_hook, s7_list(sc, 2, TO_S7_INT(1), TO_S7_INT(2)), "ffitest", "ffitest.c", __LINE__);
+  }
+
+  {
+    s7_pointer x, kar; /* from s7.h */
+    kar = s7_make_function(sc, "kar", g_car, 1, 0, false, "(car obj)");
+    x = s7_call(sc, kar, s7_cons(sc, s7_cons(sc, s7_make_integer(sc, 123), s7_nil(sc)), s7_nil(sc)));
+    if ((!s7_is_integer(x)) ||
+	(s7_integer(x) != 123))
+      {fprintf(stderr, "s7_call x: %s\n", s1 = TO_STR(x)); free(s1);}
+  }
+
+  {
+    s7_pointer x, y, funcs;
+    funcs = s7_eval_c_string(sc, "(let ((x 0)) (list (lambda () (set! x 1)) (lambda () (set! x (+ x 1))) (lambda () (set! x (+ x 1))) (lambda () x)))");
+    gc_loc = s7_gc_protect(sc, funcs);
+    y = s7_dynamic_wind(sc, s7_car(funcs), s7_cadr(funcs), s7_caddr(funcs));
+    x = s7_call(sc, s7_cadddr(funcs), s7_nil(sc));
+    if ((!s7_is_integer(x)) ||
+	(!s7_is_integer(y)) ||
+	(s7_integer(x) != 3) ||
+	(s7_integer(y) != 2))
+      {fprintf(stderr, "s7_dynamic_wind: x: %s, y: %s\n", s1 = TO_STR(x), s2 = TO_STR(y)); free(s1); free(s2);}
+    y = s7_dynamic_wind(sc, s7_f(sc), s7_car(funcs), s7_cadr(funcs));
+    x = s7_call(sc, s7_cadddr(funcs), s7_nil(sc));
+    if ((!s7_is_integer(x)) ||
+	(!s7_is_integer(y)) ||
+	(s7_integer(x) != 2) ||
+	(s7_integer(y) != 1))
+      {fprintf(stderr, "s7_dynamic_wind (init #f): x: %s, y: %s\n", s1 = TO_STR(x), s2 = TO_STR(y)); free(s1); free(s2);}
+    y = s7_dynamic_wind(sc, s7_f(sc), s7_cadr(funcs), s7_f(sc));
+    x = s7_call(sc, s7_cadddr(funcs), s7_nil(sc));
+    if ((!s7_is_integer(x)) ||
+	(!s7_is_integer(y)) ||
+	(s7_integer(x) != 3) ||
+	(s7_integer(y) != 3))
+      {fprintf(stderr, "s7_dynamic_wind (init #f, finish #f): x: %s, y: %s\n", s1 = TO_STR(x), s2 = TO_STR(y)); free(s1); free(s2);}
+    y = s7_dynamic_wind(sc, s7_cadr(funcs), s7_cadr(funcs), s7_f(sc));
+    x = s7_call(sc, s7_cadddr(funcs), s7_nil(sc));
+    if ((!s7_is_integer(x)) ||
+	(!s7_is_integer(y)) ||
+	(s7_integer(x) != 5) ||
+	(s7_integer(y) != 5))
+      {fprintf(stderr, "s7_dynamic_wind (finish #f): x: %s, y: %s\n", s1 = TO_STR(x), s2 = TO_STR(y)); free(s1); free(s2);}
+    s7_gc_unprotect_at(sc, gc_loc);
+  }
+
+  if (s7_begin_hook(sc))
+    {fprintf(stderr, "%d: begin_hook is not null?\n", __LINE__);}
+  tested_begin_hook = false;
+  s7_set_begin_hook(sc, test_begin_hook);
+  s7_eval_c_string(sc, "(begin #f (+ 1 2))");
+  if (!tested_begin_hook)
+    {fprintf(stderr, "%d: begin_hook not called?\n", __LINE__);}
+  if (s7_begin_hook(sc) != test_begin_hook)
+    {fprintf(stderr, "%d: begin_hook was not set?\n", __LINE__);}
+  s7_set_begin_hook(sc, NULL);
+
+
+  p1 = s7_name_to_value(sc, "abs");
+  if (!s7_is_procedure(p1))
+    {fprintf(stderr, "%d: (procedure? abs) = #f?\n", __LINE__);}
+  if (s7_is_macro(sc, p1))
+    {fprintf(stderr, "%d: (macro? abs) = #t?\n", __LINE__);}
+
+  if (!s7_is_aritable(sc, p1, 1))
+    {fprintf(stderr, "%d: (aritable? abs 1) = #f?\n", __LINE__);}
+  if (s7_is_aritable(sc, p1, 2))
+    {fprintf(stderr, "%d: (aritable? abs 2) = #t?\n", __LINE__);}
+  p = s7_arity(sc, p1);
+  if ((!s7_is_pair(p)) || (s7_integer(s7_car(p)) != 1) || (s7_integer(s7_cdr(p)) != 1))
+    {fprintf(stderr, "%d: (arity abs) = %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_is_proper_list(sc, p))
+    fprintf(stderr, "%d: arity is a proper-list?\n", __LINE__);
+
+  p = s7_funclet(sc, p1);
+  if (p != s7_rootlet(sc))
+    {fprintf(stderr, "%d: (funclet abs) = %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  {
+    const char *s3;
+    s3 = s7_documentation(sc, p1);
+    if (strcmp(s3, "(abs x) returns the absolute value of the real number x") != 0)
+      {fprintf(stderr, "%d: (documentation abs) = %s?\n", __LINE__, s3);}
+
+    s3 = s7_help(sc, p1);
+    if (strcmp(s3, "(abs x) returns the absolute value of the real number x") != 0)
+      {fprintf(stderr, "%d: (help abs) = %s?\n", __LINE__, s3);}
+
+    s3 = s7_documentation(sc, s7_make_symbol(sc, "abs"));
+    if (strcmp(s3, "(abs x) returns the absolute value of the real number x") != 0)
+      {fprintf(stderr, "%d: (documentation 'abs) = %s?\n", __LINE__, s3);}
+  }
+
+  p = s7_eval_c_string(sc, "(lambda (a b . c) (+ a b (apply * c)))");
+  gc_loc = s7_gc_protect(sc, p);
+
+  if (!s7_is_procedure(p))
+    {fprintf(stderr, "%d: %s is not a procedure?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s1 = TO_STR(s7_closure_body(sc, p));
+  if (strcmp(s1, "((+ a b (apply * c)))") != 0)
+    {fprintf(stderr, "%d: s7_closure_body is %s?\n", __LINE__, s1);}
+  free(s1);
+
+  s1 = TO_STR(s7_closure_args(sc, p));
+  if (strcmp(s1, "(a b . c)") != 0)
+    {fprintf(stderr, "%d: s7_closure_args is %s?\n", __LINE__, s1);}
+  free(s1);
+
+  s1 = TO_STR(s7_closure_let(sc, p));
+  if (strcmp(s1, "(rootlet)") != 0)
+    {fprintf(stderr, "%d: s7_closure_let is %s?\n", __LINE__, s1);}
+  free(s1);
+
+  if (s7_closure_body(sc, s7_name_to_value(sc, "abs")) != s7_nil(sc))
+    fprintf(stderr, "closure_body(abs) is not nil?\n");
+  if (s7_closure_args(sc, s7_name_to_value(sc, "abs"))  != s7_nil(sc))
+    fprintf(stderr, "closure_args(abs) is not nil?\n");
+  if (s7_closure_let(sc, s7_name_to_value(sc, "abs"))  != s7_rootlet(sc))
+    fprintf(stderr, "closure_let(abs) is not rootlet?\n");
+
+  if (!s7_is_aritable(sc, p, 2))
+    {fprintf(stderr, "%d: aritable? lambda 2 = #f?\n", __LINE__);}
+  if (s7_is_aritable(sc, p, 1))
+    {fprintf(stderr, "%d: aritable? lambda 1 = #t?\n", __LINE__);}
+
+  s7_gc_unprotect_at(sc, gc_loc);
+
+  {
+    /* iterators */
+    s7_pointer iter, hash, x;
+    s7_int gc1, gc2;
+
+    /* iterate over list */
+    iter = s7_make_iterator(sc, s7_list(sc, 3, TO_S7_INT(1), TO_S7_INT(2), TO_S7_INT(3)));
+    if (!s7_is_iterator(iter))
+      {fprintf(stderr, "%d: %s is not an iterator\n", __LINE__, s1 = TO_STR(iter)); free(s1);}
+    if (s7_iterator_is_at_end(sc, iter))
+      {fprintf(stderr, "%d: %s is prematurely done\n", __LINE__, s1 = TO_STR(iter)); free(s1);}
+    x = s7_iterate(sc, iter);
+    if ((!s7_is_integer(x)) || (s7_integer(x) != 1))
+      {fprintf(stderr, "%d: %s should be 1\n", __LINE__, s1 = TO_STR(x)); free(s1);}
+    x = s7_iterate(sc, iter);
+    if ((!s7_is_integer(x)) || (s7_integer(x) != 2))
+      {fprintf(stderr, "%d: %s should be 2\n", __LINE__, s1 = TO_STR(x)); free(s1);}
+    x = s7_iterate(sc, iter);
+    if ((!s7_is_integer(x)) || (s7_integer(x) != 3))
+      {fprintf(stderr, "%d: %s should be 3\n", __LINE__, s1 = TO_STR(x)); free(s1);}
+    x = s7_iterate(sc, iter);
+    if ((x != s7_eof_object(sc)) || (!s7_iterator_is_at_end(sc, iter)))
+      {fprintf(stderr, "%d: %s should be #<eof> and iter should be done\n", __LINE__, s1 = TO_STR(x)); free(s1);}
+
+    /* iterate over hash table */
+    hash = s7_make_hash_table(sc, 8);
+    gc1 = s7_gc_protect(sc, hash);
+    s7_hash_table_set(sc, hash, s7_make_symbol(sc, "a"), s7_make_integer(sc, 1));
+    s7_hash_table_set(sc, hash, s7_make_symbol(sc, "b"), s7_make_integer(sc, 2));
+    iter = s7_make_iterator(sc, hash);
+    gc2 = s7_gc_protect(sc, iter);
+    x = s7_iterate(sc, iter);
+    if (!s7_is_pair(x))
+      {fprintf(stderr, "x: %s\n", s1 = TO_STR(x)); free(s1);}
+    x = s7_iterate(sc, iter);
+    if (!s7_is_pair(x))
+      {fprintf(stderr, "x: %s\n", s1 = TO_STR(x)); free(s1);}
+    x = s7_iterate(sc, iter);
+    if (!s7_is_eq(s7_eof_object(sc), x))
+      {fprintf(stderr, "x: %s\n", s1 = TO_STR(x)); free(s1);}
+    s7_gc_unprotect_at(sc, gc1);
+    s7_gc_unprotect_at(sc, gc2);
+  }
+
+  g_block_type = s7_make_c_type(sc, "<block>");
+  s7_c_type_set_free(sc, g_block_type, g_block_free);
+  s7_c_type_set_equal(sc, g_block_type, g_blocks_are_eql);
+  s7_c_type_set_is_equal(sc, g_block_type, g_blocks_are_equal);
+  s7_c_type_set_is_equivalent(sc, g_block_type, g_blocks_are_equivalent);
+  s7_c_type_set_mark(sc, g_block_type, g_block_mark);
+  s7_c_type_set_ref(sc, g_block_type, g_block_ref);
+  s7_c_type_set_set(sc, g_block_type, g_block_set);
+  s7_c_type_set_length(sc, g_block_type, g_block_length);
+  s7_c_type_set_copy(sc, g_block_type, g_block_copy);
+  s7_c_type_set_reverse(sc, g_block_type, g_block_reverse);
+  s7_c_type_set_fill(sc, g_block_type, g_block_fill);
+  s7_c_type_set_to_string(sc, g_block_type, g_block_to_string);
+
+  s7_define_function(sc, "make-block", g_make_block, 1, 0, false, g_make_block_help);
+  s7_define_function(sc, "block", g_to_block, 0, 0, true, g_block_help);
+
+  g_block_methods = s7_eval_c_string(sc, "(inlet (cons 'vector? (lambda (p) #t)))");
+  s7_gc_protect(sc, g_block_methods);
+
+  {
+    g_block *g;
+    s7_pointer gp;
+
+    gp = g_make_block(sc, s7_list(sc, 1, TO_S7_INT(32)));
+    gc_loc = s7_gc_protect(sc, gp);
+    if (!s7_is_c_object(gp))
+      {fprintf(stderr, "%d: g_block %s is not a c_object?\n", __LINE__, s1 = TO_STR(gp)); free(s1);}
+    g = (g_block *)s7_c_object_value(gp);
+    if (s7_c_object_type(gp) != g_block_type)
+      {fprintf(stderr, "%d: g_block types: %" ld64 " %" ld64 "\n", __LINE__, g_block_type, s7_c_object_type(gp));}
+    if (s7_c_object_value_checked(gp, g_block_type) != g)
+      {fprintf(stderr, "%d: checked g_block types: %" ld64 " %" ld64 "\n", __LINE__, g_block_type, s7_c_object_type(gp));}
+    if (s7_c_object_let(gp) != g_block_methods)
+      fprintf(stderr, "%d: s7_c_object_let trouble\n", __LINE__);
+    s7_gc_unprotect_at(sc, gc_loc);
+  }
+
+  {
+    s7_pointer old_port;
+    const char *errmsg = NULL;
+
+    old_port = s7_set_current_error_port(sc, s7_open_output_string(sc));
+    gc_loc = s7_gc_protect(sc, old_port);
+
+    s7_eval_c_string(sc, "(+ 1 #\\c)");
+    errmsg = s7_get_output_string(sc, s7_current_error_port(sc));
+    if (!errmsg)
+      fprintf(stderr, "%d: no error!\n", __LINE__);
+
+    s7_close_output_port(sc, s7_current_error_port(sc));
+    s7_set_current_error_port(sc, old_port);
+    s7_gc_unprotect_at(sc, gc_loc);
+  }
+
+  {
+    int gc_loc1;
+    s7_pointer old_port, result, func;
+    const char *errmsg = NULL;
+
+    s7_define_unsafe_typed_function(sc, "error-handler", test_error_handler, 1, 0, false, "our error handler", s7_make_signature(sc, 2, s7_t(sc), s7_t(sc)));
+
+    s7_eval_c_string(sc, "(set! (hook-functions *error-hook*)                                 \n\
+                            (list (lambda (hook)                                              \n\
+                                    (error-handler                                            \n\
+				     (string-append \"hook: \" (apply format #f (hook 'data)))) \n\
+                                    (set! (hook 'result) 'our-error))))");
+
+    old_port = s7_set_current_error_port(sc, s7_open_output_string(sc));
+    gc_loc = s7_gc_protect(sc, old_port);
+
+    result = s7_eval_c_string(sc, "(+ 1 #\\c)");
+    if (result != s7_make_symbol(sc, "our-error"))
+      {fprintf(stderr, "%d: error hook result: %s\n", __LINE__, s1 = TO_STR(result)); free(s1);}
+    errmsg = s7_get_output_string(sc, s7_current_error_port(sc));
+    if ((errmsg) && (*errmsg))
+      {
+	if (strcmp(errmsg, "error!") != 0)
+	  fprintf(stderr, "%d: error: %s\n", __LINE__, errmsg);
+      }
+    else fprintf(stderr, "%d: no error!\n", __LINE__);
+
+    s7_close_output_port(sc, s7_current_error_port(sc));
+    s7_set_current_error_port(sc, old_port);
+    s7_gc_unprotect_at(sc, gc_loc);
+
+
+    old_port = s7_set_current_error_port(sc, s7_open_output_string(sc));
+    gc_loc = s7_gc_protect(sc, old_port);
+
+    func = s7_eval_c_string(sc, "(lambda (x) (+ x 1))");
+    result = s7_call(sc, func, s7_list(sc, 1, s7_make_integer(sc, 2)));
+    if ((!s7_is_integer(result)) || (s7_integer(result) != 3))
+      {fprintf(stderr, "%d: s7_call (x+1) result: %s\n", __LINE__, s1 = TO_STR(result)); free(s1);}
+
+    result = s7_call(sc, func, s7_list(sc, 1, s7_make_vector(sc, 0)));
+    if (result != s7_make_symbol(sc, "our-error"))
+      {fprintf(stderr, "%d: s7_call error hook result: %s\n", __LINE__, s1 = TO_STR(result)); free(s1);}
+    errmsg = s7_get_output_string(sc, s7_current_error_port(sc));
+    if ((errmsg) && (*errmsg))
+      {
+	if (strcmp(errmsg, "error!") != 0)
+	  fprintf(stderr, "%d: error: %s\n", __LINE__, errmsg);
+      }
+    else fprintf(stderr, "%d: no error!\n", __LINE__);
+
+    s7_close_output_port(sc, s7_current_error_port(sc));
+    s7_set_current_error_port(sc, old_port);
+    s7_gc_unprotect_at(sc, gc_loc);
+
+
+    old_port = s7_set_current_error_port(sc, s7_open_output_string(sc));
+    gc_loc = s7_gc_protect(sc, old_port);
+
+    func = s7_eval_c_string(sc, "(let ((x 0)) (list (lambda () (set! x 1)) (lambda () (set! x (+ x #()))) (lambda () (set! x (+ x 1))) (lambda () x)))");
+    gc_loc1 = s7_gc_protect(sc, func);
+    result = s7_dynamic_wind(sc, s7_car(func), s7_cadr(func), s7_caddr(func));
+
+    if (result != s7_make_symbol(sc, "our-error"))
+      {fprintf(stderr, "%d: s7_dynamic_wind error hook result: %s\n", __LINE__, s1 = TO_STR(result)); free(s1);}
+    errmsg = s7_get_output_string(sc, s7_current_error_port(sc));
+    if ((errmsg) && (*errmsg))
+      {
+	if (strcmp(errmsg, "error!") != 0)
+	  fprintf(stderr, "%d: error: %s\n", __LINE__, errmsg);
+      }
+    else fprintf(stderr, "%d: no error!\n", __LINE__);
+
+    s7_close_output_port(sc, s7_current_error_port(sc));
+    s7_set_current_error_port(sc, old_port);
+    s7_gc_unprotect_at(sc, gc_loc);
+    s7_gc_unprotect_at(sc, gc_loc1);
+
+
+    s7_eval_c_string(sc, "(set! (hook-functions *error-hook*) ())");
+  }
+
+#if WITH_GMP
+  s7_define_function(sc, "add-1", big_add_1, 1, 0, false, "(add-1 num) adds 1 to num");
+  p = s7_eval_c_string(sc, "(add-1 (*s7* 'most-positive-fixnum))");
+  if ((!s7_is_bignum(p)) || (!s7_is_big_integer(p))) {fprintf(stderr, "add-1: %s\n", s1 = TO_STR(p)); free(s1);}
+  {
+    mpz_t val, val1;
+    mpz_init_set(val, *s7_big_integer(p));
+    mpz_init(val1);
+    mpz_set_si(val1, s7_integer(s7_starlet_ref(sc, s7_make_symbol(sc, "most-positive-fixnum"))));
+    mpz_add_ui(val1, val1, 1);
+    if (mpz_cmp(val, val1) != 0) {fprintf(stderr, "add-1: %s\n", s1 = TO_STR(p)); free(s1);}
+    mpz_clear(val);
+    mpz_clear(val1);
+  }
+#endif
+
+  s7_define_function(sc, "notify-C", scheme_set_notification, 2, 0, false, "called if notified-var is set!");
+  s7_define_variable(sc, "notified-var", s7_make_integer(sc, 0));
+  s7_set_setter(sc, s7_make_symbol(sc, "notified-var"), s7_name_to_value(sc, "notify-C"));
+  s7_eval_c_string(sc, "(set! notified-var 32)");
+  p = s7_name_to_value(sc, "notified-var");
+  if (s7_integer(p) != 32)
+    {fprintf(stderr, "%d: sym set: %s\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_integer(set_val) != 32)
+    {fprintf(stderr, "%d: sym val: %s\n", __LINE__, s1 = TO_STR(set_val)); free(s1);}
+  if (set_sym != s7_make_symbol(sc, "notified-var"))
+    {fprintf(stderr, "%d: sym: %s\n", __LINE__, s1 = TO_STR(set_sym)); free(s1);}
+
+  {
+    s7_pointer e, val;
+    e = s7_inlet(sc, s7_list(sc, 2, s7_make_symbol(sc, "init_func"), s7_make_symbol(sc, "block_init")));
+    gc_loc = s7_gc_protect(sc, e);
+    val = s7_load_with_environment(sc, "s7test-block.so", e);
+    if (!val)
+      fprintf(stderr, "can't load s7test-block.so\n");
+    s7_gc_unprotect_at(sc, gc_loc);
+  }
+
+  {
+    s7_pointer body, err, result;
+    s7_int gc_body, gc_err;
+    body = s7_eval_c_string(sc, "(lambda () (+ 1 2))");
+    gc_body = s7_gc_protect(sc, body);
+    err = s7_eval_c_string(sc, "(lambda (type info) 'oops)");
+    gc_err = s7_gc_protect(sc, err);
+    result = s7_call_with_catch(sc, s7_t(sc), body, err);                                                     /* Ln L */
+    if ((!s7_is_integer(result)) || (s7_integer(result) != 3))
+      {fprintf(stderr, "catch (3): %s\n", s1 = TO_STR(result)); free(s1);}
+    s7_gc_unprotect_at(sc, gc_body);
+    s7_gc_unprotect_at(sc, gc_err);
+
+    body = s7_eval_c_string(sc, "(lambda () (+ #f 2))");                                                      /* Le L */
+    gc_body = s7_gc_protect(sc, body);
+    result = s7_call_with_catch(sc, s7_t(sc), body, err);
+    if (result != s7_make_symbol(sc, "oops"))
+      {fprintf(stderr, "catch (oops): %s\n", s1 = TO_STR(result)); free(s1);}
+    s7_gc_unprotect_at(sc, gc_body);
+
+    body = s7_make_function(sc, "my-error", my_error, 0, 0, false, "call s7_error");
+    gc_body = s7_gc_protect(sc, body);
+    result = s7_call_with_catch(sc, s7_t(sc), body, s7_eval_c_string(sc, "(lambda (type info) (car info))")); /* Ce L */
+    if (s7_integer(result) != 60)
+      /* '(60) returned from my_error via its error handler, car(info) -> 60 above */
+      {fprintf(stderr, "%d: catch my_error via car: %s\n", __LINE__, s1 = TO_STR(result)); free(s1);}
+    s7_gc_unprotect_at(sc, gc_body);
+
+    err = s7_make_function(sc, "my-error-handler", my_error_handler, 2, 0, false, "handle error");
+    gc_err = s7_gc_protect(sc, err);
+    result = s7_call_with_catch(sc, s7_t(sc), body, err);                                                     /* Ce C */
+    if (s7_integer(result) != 60)
+      {fprintf(stderr, "%d: catch my_error via my_error_handler: %s\n", __LINE__, s1 = TO_STR(result)); free(s1);}
+
+    body = s7_make_function(sc, "my-no-error", my_no_error, 0, 0, false, "don't call s7_error");
+    gc_body = s7_gc_protect(sc, body);
+    result = s7_call_with_catch(sc, s7_t(sc), body, s7_eval_c_string(sc, "(lambda (type info) (car info))")); /* Cn L */
+    if (s7_integer(result) != 30)
+      {fprintf(stderr, "%d: catch my_no_error: %s\n", __LINE__, s1 = TO_STR(result)); free(s1);}
+
+    result = s7_call_with_catch(sc, s7_t(sc), s7_eval_c_string(sc, "(lambda () (+ #f 2))"), err);
+    if ((!s7_is_string(result)) || (strcmp(s7_string(result), "~A ~:D argument, ~S, is ~A but should be ~A") != 0))
+      {fprintf(stderr, "%d: catch (+ #f 2) via my_error_handler: %s\n", __LINE__, s1 = TO_STR(result)); free(s1);}
+    s7_gc_unprotect_at(sc, gc_err);
+
+    err = s7_make_function(sc, "my-error-handler", my_error_handler, 2, 0, false, "handle error");
+    gc_err = s7_gc_protect(sc, err);
+    result = s7_call_with_catch(sc, s7_t(sc), body, err);                                                     /* Cn C */
+    if (s7_integer(result) != 30)
+      {fprintf(stderr, "%d: catch my_error via my_error_handler: %s\n", __LINE__, s1 = TO_STR(result)); free(s1);}
+    s7_gc_unprotect_at(sc, gc_body);
+
+    body = s7_eval_c_string(sc, "(lambda () (+ 1 2))");
+    gc_body = s7_gc_protect(sc, body);
+    result = s7_call_with_catch(sc, s7_t(sc), body, err);                                                     /* Ln C */
+    if ((!s7_is_integer(result)) || (s7_integer(result) != 3))
+      {fprintf(stderr, "%d: catch (3): %s\n", __LINE__, s1 = TO_STR(result)); free(s1);}
+    s7_gc_unprotect_at(sc, gc_body);
+    s7_gc_unprotect_at(sc, gc_err);
+  }
+
+  {
+    s7_pointer make_func2, catcher2;
+    make_func2 = s7_make_function(sc, "bad-func-define", ter_bad_func, 0, 0, false, NULL);
+    catcher2 = s7_make_function(sc, "error-handler", ter_error_handler, 2, 0, false, NULL);
+    s7_call_with_catch(sc, s7_t(sc), make_func2, catcher2);
+    s7_call_with_catch(sc, s7_t(sc), make_func2, catcher2);
+  }
+
+  {
+    s7_pointer result1, result2;
+    s7_define_function(sc, "bad-func", ter_bad_func, 0, 0, false, NULL);
+    s7_define_function(sc, "error-handler", ter_error_handler, 2, 0, false, NULL);
+    result1 = s7_call_with_catch(sc, s7_t(sc), s7_name_to_value(sc, "bad-func"), s7_name_to_value(sc, "error-handler"));
+    result2 = s7_eval_c_string(sc, "(catch #t bad-func error-handler)");
+    if (result1 != result2)
+      {fprintf(stderr, "%d: %s != %s\n", __LINE__, s1 = TO_STR(result1), s2 = TO_STR(result2)); free(s1); free(s2);}
+  }
+
+  {
+    s7_pointer catcher, make_func1, val;
+    make_func = s7_make_function(sc, "bad", ter_bad_func, 0, 0, false, NULL);
+    catcher = s7_make_function(sc, "catcher", ter_error_handler, 2, 0, false, NULL);
+    make_func1 = s7_make_function(sc, "bad1", ter1_bad_func, 0, 0, false, NULL);
+    catcher1 = s7_make_function(sc, "catcher1", ter1_error_handler, 2, 0, false, NULL);
+    val = s7_call_with_catch(sc, s7_t(sc), make_func, catcher);
+    if (val != s7_f(sc)) {fprintf(stderr, "%d: %s should be #f\n", __LINE__, s1 = TO_STR(val)); free(s1);}
+    val = s7_call_with_catch(sc, s7_t(sc), make_func, catcher);
+    if (val != s7_f(sc)) {fprintf(stderr, "%d: %s should be #f\n", __LINE__, s1 = TO_STR(val)); free(s1);}
+    val = s7_call_with_catch(sc, s7_t(sc), make_func1, catcher1);
+    if (s7_integer(val) != 123) {fprintf(stderr, "%d: %s should be 123\n", __LINE__, s1 = TO_STR(val)); free(s1);}
+    val = s7_call_with_catch(sc, s7_t(sc), make_func1, catcher1);
+    if (s7_integer(val) != 123) {fprintf(stderr, "%d: %s should be 123\n", __LINE__, s1 = TO_STR(val)); free(s1);}
+    val = s7_call_with_catch(sc, s7_t(sc), make_func, catcher);
+    if (val != s7_f(sc)) {fprintf(stderr, "%d: %s should be #f\n", __LINE__, s1 = TO_STR(val)); free(s1);}
+
+    make_func = s7_make_function(sc, "bad2", ter2_bad_func, 0, 0, false, NULL);
+    catcher2 = s7_make_function(sc, "catcher2", ter2_error_handler, 2, 0, false, NULL);
+    val = s7_call_with_catch(sc, s7_t(sc), make_func, catcher2);
+    if (strcmp(s7_string(val), "ter2 argument, (), is nil but should be oops") != 0)
+      fprintf(stderr, "%d: %s is unexpected\n", __LINE__, s7_string(val));
+  }
+
+  {
+    s7_define_function(sc, "wd-test-fn", wd_test_fn, 0, 1, false, "call the inner test");
+    s7_define_function(sc, "wd-inner-test", wd_inner_test, 0, 0, false, "throw");
+    s7_define_function(sc, "wd-inner-test-handler", wd_inner_test_handler, 2, 0, false, "do nothing");
+    s7_eval_c_string(sc, "(wd-test-fn #f)");
+    if (wd_val != 2) fprintf(stderr, "%d: s7_call_with_catch wd_val(1): %d\n", __LINE__, wd_val);
+    s7_eval_c_string(sc, "(catch #t wd-test-fn (lambda (t i) 'oops))");
+    if (wd_val != 2) fprintf(stderr, "%d: s7_call_with_catch wd_val(2): %d\n", __LINE__, wd_val);
+    s7_eval_c_string(sc, "(call-with-exit wd-test-fn)");
+    if (wd_val != 2) fprintf(stderr, "%d: s7_call_with_catch wd_val(3): %d\n", __LINE__, wd_val);
+    s7_define_function(sc, "wd1-test-fn", wd1_test_fn, 1, 0, false, "call the inner test");
+    s7_define_function(sc, "wd1-inner-fn", wd1_inner_fn, 1, 0, false, "call the inner test");
+    s7_eval_c_string(sc, "(wd1-test-fn #f)");
+    if (wd1_val != 2) fprintf(stderr, "%d: s7_call_with_catch wd1_val: %d\n", __LINE__, wd1_val);
+    if (wd2_val != 12) fprintf(stderr, "%d: s7_call_with_catch wd2_val: %d\n", __LINE__, wd2_val);
+  }
+
+  {
+    const char *str;
+    s7_pointer obj;
+    obj = s7_eval_c_string(sc, "'(* 3 (+ 1 2))");
+    gc_loc = s7_gc_protect(sc, obj);
+    str = pretty_print(sc, obj);
+    s7_gc_unprotect_at(sc, gc_loc);
+    if ((!str) || (strcmp(str, "(* 3 (+ 1 2))") != 0))
+      fprintf(stderr, "pretty_print: \"%s\"\n", str);
+  }
+
+  {
+    s7_int size = 256, gc_loc, loc, code;
+    s7_pointer hasher, key, result;
+    hasher = s7_make_and_fill_vector(sc, size, s7_nil(sc));
+    gc_loc = s7_gc_protect(sc, hasher);
+    key = s7_make_integer(sc, 3);
+    code = s7_hash_code(sc, key, s7_f(sc));
+    loc = code % size;
+    s7_vector_set(sc, hasher, loc, s7_cons(sc, s7_cons(sc, key, s7_make_symbol(sc, "abc")), s7_vector_ref(sc, hasher, loc)));
+    result = s7_cdr(s7_assoc(sc, key, s7_vector_ref(sc, hasher, loc)));
+    if (result != s7_make_symbol(sc, "abc"))
+      {fprintf(stderr, "hash-code: %s\n", s1 = TO_STR(result)); free(s1);}
+    s7_gc_unprotect_at(sc, gc_loc);
+  }
+
+  {
+    s7_pointer p;
+    p = s7_random_state(sc, s7_cons(sc, s7_make_integer(sc, 123456), s7_cons(sc, s7_make_integer(sc, 654321), s7_nil(sc))));
+    if (!s7_is_random_state(p))
+      {fprintf(stderr, "%d: s7_random_state returned %s\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+    if (s7_type_of(sc, p) != s7_make_symbol(sc, "random-state?"))
+      {fprintf(stderr, "%d: s7_random_state returned %s\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+#if (!WITH_GMP)
+    {
+      s7_pointer q;
+      q = s7_random_state_to_list(sc, s7_cons(sc, p, s7_nil(sc)));
+      if (!s7_is_pair(q))
+	{fprintf(stderr, "%d: s7_random_state_to_list is %s\n", __LINE__, s1 = TO_STR(q)); free(s1);}
+    }
+#endif
+  }
+
+  {
+    s7_pointer lst;
+    s7_pointer arr[3];
+    lst = s7_list(sc, 3, s7_make_integer(sc, 1), s7_make_integer(sc, 2), s7_make_integer(sc, 3));
+    s7_list_to_array(sc, lst, arr, 3);
+    if (s7_integer(arr[1]) != 2) {fprintf(stderr, "arr[1]: %s\n", s1 = TO_STR(arr[1])); free(s1);}
+  }
+
+  {
+    s7_float_function func;
+    s7_pfunc sfunc;
+    s7_pointer symbol;
+    symbol = s7_define_safe_function(sc, "d-func", g_d_func, 0, 0, false, "d opt func");
+    s7_set_d_function(sc, s7_name_to_value(sc, "d-func"), opt_d_func);
+    func = s7_float_optimize(sc, s7_list(sc, 1, s7_list(sc, 1, symbol))); /* ((d-func)) -- the extra list layer is an historical artifact */
+    if ((!WITH_GMP) && (!func)) fprintf(stderr, "%d: d-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-d-func", g_d_d_func, 1, 0, false, "d-d opt func");
+    s7_set_d_d_function(sc, s7_name_to_value(sc, "d-d-func"), opt_d_d_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 2, symbol, s7_make_real(sc, 2.0)))); /* ((d-d-func 2.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-d-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-dd-func", g_d_dd_func, 2, 0, false, "d-dd opt func");
+    s7_set_d_dd_function(sc, s7_name_to_value(sc, "d-dd-func"), opt_d_dd_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 3, symbol, s7_make_real(sc, 2.0), s7_make_real(sc, 3.0)))); /* ((d-dd-func 2.0 3.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-dd-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-ddd-func", g_d_ddd_func, 3, 0, false, "d-ddd opt func");
+    s7_set_d_ddd_function(sc, s7_name_to_value(sc, "d-ddd-func"), opt_d_ddd_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 4, symbol, s7_make_real(sc, 2.0), s7_make_real(sc, 3.0), s7_make_real(sc, 4.0)))); /* ((d-ddd-func 2.0 3.0 4.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-ddd-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-dddd-func", g_d_dddd_func, 4, 0, false, "d-dddd opt func");
+    s7_set_d_dddd_function(sc, s7_name_to_value(sc, "d-dddd-func"), opt_d_dddd_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1,
+       s7_list(sc, 5, symbol, s7_make_real(sc, 2.0), s7_make_real(sc, 3.0), s7_make_real(sc, 4.0), s7_make_real(sc, 5.0)))); /* ((d-dddd-func 2.0 3.0 4.0 5.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-dddd-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "i-i-func", g_i_i_func, 1, 0, false, "i-i opt func");
+    s7_set_i_i_function(sc, s7_name_to_value(sc, "i-i-func"), opt_i_i_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 2, symbol, s7_make_integer(sc, 2)))); /* ((i-i-func 2)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: i-i-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "i-ii-func", g_i_ii_func, 2, 0, false, "i-ii opt func");
+    s7_set_i_ii_function(sc, s7_name_to_value(sc, "i-ii-func"), opt_i_ii_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 3, symbol, s7_make_integer(sc, 2), s7_make_integer(sc, 3)))); /* ((i-ii-func 2 3)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: i-ii-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-id-func", g_d_id_func, 2, 0, false, "d-id opt func");
+    s7_set_d_id_function(sc, s7_name_to_value(sc, "d-id-func"), opt_d_id_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 3, symbol, s7_make_integer(sc, 2), s7_make_real(sc, 3.0)))); /* ((d-id-func 2 3.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-id-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-ip-func", g_d_ip_func, 2, 0, false, "d-ip opt func");
+    s7_set_d_ip_function(sc, s7_name_to_value(sc, "d-ip-func"), opt_d_ip_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 3, symbol, s7_make_integer(sc, 2), s7_make_real(sc, 3.0)))); /* ((d-ip-func 2 3.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-ip-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "i-7d-func", g_i_7d_func, 1, 0, false, "i-7d opt func");
+    s7_set_i_7d_function(sc, s7_name_to_value(sc, "i-7d-func"), opt_i_7d_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 2, symbol, s7_make_real(sc, 2.0)))); /* ((i-7d-func 2.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: i-7d-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "i-7p-func", g_i_7p_func, 1, 0, false, "i-7p opt func");
+    s7_set_i_7p_function(sc, s7_name_to_value(sc, "i-7p-func"), opt_i_7p_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 2, symbol, s7_make_integer(sc, 2)))); /* ((i-7p-func 2)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: i-7p-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-p-func", g_d_p_func, 1, 0, false, "d-p opt func");
+    s7_set_d_p_function(sc, s7_name_to_value(sc, "d-p-func"), opt_d_p_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 2, symbol, s7_make_real(sc, 2.0)))); /* ((d-p-func 2.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-p-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-pd-func", g_d_pd_func, 2, 0, false, "d-pd opt func");
+    s7_set_d_pd_function(sc, s7_name_to_value(sc, "d-pd-func"), opt_d_pd_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 3, symbol, s7_make_real(sc, 2.0), s7_make_real(sc, 3.0)))); /* ((d-pd-func 2.0 3.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-pd-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-7pi-func", g_d_7pi_func, 2, 0, false, "d-7pi opt func");
+    s7_set_d_7pi_function(sc, s7_name_to_value(sc, "d-7pi-func"), opt_d_7pi_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 3, symbol, s7_make_real(sc, 2.0), s7_make_integer(sc, 3)))); /* ((d-7pi-func 2.0 3)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-7pi-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-7pid-func", g_d_7pid_func, 3, 0, false, "d-7pid opt func");
+    s7_set_d_7pid_function(sc, s7_name_to_value(sc, "d-7pid-func"), opt_d_7pid_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 4, symbol, s7_make_real(sc, 2.0), s7_make_integer(sc, 3), s7_make_real(sc, 4.0)))); /* ((d-7pid-func 2.0 3 4.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-7pid-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "b-p-func", g_b_p_func, 1, 0, false, "b-p opt func");
+    s7_set_b_p_function(sc, s7_name_to_value(sc, "b-p-func"), opt_b_p_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 2, symbol, s7_make_real(sc, 2.0)))); /* ((b-p-func 2.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: b-p-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "p-d-func", g_p_d_func, 1, 0, false, "p-d opt func");
+    s7_set_p_d_function(sc, s7_name_to_value(sc, "p-d-func"), opt_p_d_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 2, symbol, s7_make_real(sc, 2.0)))); /* ((p-d-func 2.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: p-d-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-v-func", g_d_v_func, 1, 0, false, "d-v opt func");
+    s7_set_d_v_function(sc, s7_name_to_value(sc, "d-v-func"), opt_d_v_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 2, symbol, s7_list(sc, 2, s7_make_symbol(sc, "block"), s7_make_integer(sc, 2))))); /* ((d-v-func (block 2))) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-v-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-vd-func", g_d_vd_func, 2, 0, false, "d-vd opt func");
+    s7_set_d_vd_function(sc, s7_name_to_value(sc, "d-vd-func"), opt_d_vd_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1,
+                              s7_list(sc, 3, symbol,
+                                             s7_list(sc, 2, s7_make_symbol(sc, "block"), s7_make_integer(sc, 2)),
+				             s7_make_real(sc, 0.0)))); /* ((d-vd-func (block 2) 0.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-vd-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-vid-func", g_d_vid_func, 3, 0, false, "d-vid opt func");
+    s7_set_d_vid_function(sc, s7_name_to_value(sc, "d-vid-func"), opt_d_vid_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1,
+                              s7_list(sc, 4, symbol,
+                                             s7_list(sc, 2, s7_make_symbol(sc, "block"), s7_make_integer(sc, 2)),
+				             s7_make_integer(sc, 0),
+				             s7_make_real(sc, 0.0)))); /* ((d-vid-func (block 2) 0 0.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-vid-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-vdd-func", g_d_vdd_func, 3, 0, false, "d-vdd opt func");
+    s7_set_d_vdd_function(sc, s7_name_to_value(sc, "d-vdd-func"), opt_d_vdd_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1,
+                              s7_list(sc, 4, symbol,
+                                             s7_list(sc, 2, s7_make_symbol(sc, "block"), s7_make_integer(sc, 2)),
+				             s7_make_real(sc, 0.0),
+				             s7_make_real(sc, 0.0)))); /* ((d-vdd-func (block 2) 0.0 0.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-vdd-func not optimized\n", __LINE__);
+  }
+
+  {
+    s7_pointer old_port, new_port, res;
+    new_port = s7_open_input_string(sc, "01234");
+    old_port = s7_set_current_input_port(sc, new_port);
+    res = s7_eval_c_string(sc, "(read-char)");
+    if (s7_character(res) != '0') {fprintf(stderr, "%d: read-char: %s\n", __LINE__, s1 = TO_STR(res)); free(s1);}
+    s7_set_current_input_port(sc, old_port);
+  }
+
+  {
+    s7_pointer res;
+    s7_define_function(sc, "abs", our_abs, 1, 0, false, "abs replacement"); /* make sure #_abs is not touched */
+    res = s7_eval_c_string(sc, "(#_abs -1.0)");
+    if (s7_real(res) != 1.0) {fprintf(stderr, "#_abs: %s?\n", s1 = TO_STR(res)); free(s1);}
+    res = s7_eval_c_string(sc, "(abs -1.0)");
+    if (s7_real(res) != 0.0) {fprintf(stderr, "(our_)abs: %s?\n", s1 = TO_STR(res)); free(s1);}
+  }
+
+  { /* check realloc'd large block handling in s7_free */
+    int i;
+    s7_int addrs[20000];
+
+    for (i = 0; i < 20000; i++)   /* gc_protected_objects */
+      addrs[i] = s7_gc_protect(sc, s7_cons(sc, s7_f(sc), s7_t(sc)));
+
+    for (i = 19999; i >= 0; i--)
+      s7_gc_unprotect_at(sc, addrs[i]);
+
+    for (i = 0; i < 10000; i++)   /* rootlet */
+      {
+	char buf[128];
+	snprintf(buf, 128, "sym-%d", i);
+	s7_define(sc, s7_nil(sc), s7_make_symbol(sc, (const char *)buf), s7_make_integer(sc, i));
+      }
+
+    for (i = 0; i < 10000; i++)   /* stack */
+      {
+	s7_pointer p = s7_make_vector(sc, 3);
+	s7_gc_protect_via_stack(sc, p);
+	s7_object_to_string(sc, p, false); /* for check_stack_size */
+      }}
+
+  s7_quit(sc);
+  free(perm1);
+  free(perm2);
+  s7_free(sc);
+
+  return(0);
+}
diff --git a/s7/gdbinit b/s7/gdbinit
new file mode 100644
index 0000000..622094c
--- /dev/null
+++ b/s7/gdbinit
@@ -0,0 +1,97 @@
+define s7print
+print s7_object_to_c_string(cur_sc, $arg0)
+end
+document s7print
+interpret the argument as an s7 value and display it
+end
+
+# the current expression is sc->cur_code
+# the current environment is sc->envir
+# the error environment is sc->owlet
+# so for example, to see the current local variables, s7p sc->envir
+# source ~/.gdbinit reloads
+
+# set print elements 123123 in gdb to get full string
+
+define s7eval
+print s7_object_to_c_string(cur_sc, s7_eval_c_string(cur_sc, $arg0))
+end
+document s7eval
+eval the argument (a string)
+end
+
+
+define s7stack
+print s7_object_to_c_string(cur_sc, s7_stacktrace(sc))
+end
+document s7stack
+display the currently active local environments
+end
+
+
+define s7value
+# print s7_object_to_c_string(cur_sc, s7_name_to_value(cur_sc, $arg0))
+print s7_object_to_c_string(cur_sc, s7_eval_c_string(cur_sc, $arg0))
+end
+document s7value
+print the value of the expression passed as a string: s7v "*features*"
+end
+
+
+define s7let
+print s7_show_let(cur_sc)
+end
+document s7let
+show all non-global variables that are currently accessible
+end
+
+
+define s7history
+print s7_show_history(cur_sc)
+end
+document s7history
+show the entries in the history buffer
+end
+
+define s7crawl
+print s7_show_stack(cur_sc)
+end
+document s7history
+show the ops in the stack
+end
+
+
+define s7bt
+set logging overwrite on
+set logging redirect on
+set logging enabled on
+if $argc == 1
+  bt $arg0
+end
+if $argc == 0
+  bt
+end
+set logging enabled off
+# now gdb.txt has the backtrace
+print s7_decode_bt(cur_sc)
+end
+document s7bt
+print a C backtrace with s7 objects decoded as much as possible
+end
+
+define s7btfull
+set logging overwrite on
+set logging redirect on
+set logging enabled on
+if $argc == 1
+  bt full $arg0
+end
+if $argc == 0
+  bt full
+end
+set logging enabled off
+print s7_decode_bt(cur_sc)
+end
+document s7btfull
+print a full C backtrace with s7 objects decoded as much as possible
+end
diff --git a/s7/json.scm b/s7/json.scm
new file mode 100644
index 0000000..4045d6d
--- /dev/null
+++ b/s7/json.scm
@@ -0,0 +1,316 @@
+(define json->s7
+  (let ()
+    (define (strlet . args)            ; inlet with keys as strings
+      (apply inlet (do ((p args (cddr p))
+			(fields ()))
+		       ((null? p)
+			(reverse! fields))
+		     (set! fields (cons (cadr p) 
+					(cons (symbol (car p)) 
+					      fields))))))
+    (let ((jlet (curlet)))
+      (lambda (str)
+	(do ((p (open-output-string))
+	     (len (length str))
+	     (i 0 (+ i 1)))
+	    ((= i len)
+	     (let ((result (eval-string (get-output-string p) jlet))) ; jlet so that strlet is defined
+	       (close-output-port p)
+	       result))
+	  
+	  (case (str i)
+	    ((#\{)                      ; {...} -> (inlet ...) via strlet above
+	     (display "(strlet " p))
+	    
+	    ((#\[)                      ; [...] -> (vector ...)
+	     (display "(vector " p))
+	    
+	    ((#\} #\]) 
+	     (write-char #\) p))
+	    
+	    ((#\: #\,) 
+	     (write-char #\space p))
+	    
+	    ((#\")
+	     (let ((qpos (char-position #\" str (+ i 1))))
+	       (if (not qpos)
+		   (format *stderr* "no close quote: ~S ~S~%" (substring str 0 i) (substring str i)))
+	       (if (char=? (str (- qpos 1)) #\\)                    ; stopgap...
+		   (set! qpos (char-position #\" str (+ qpos 1))))
+	       (display (substring str i (+ qpos 1)) p)
+	       (set! i qpos)))
+	    
+	    ((#\t)                       ; true -> #t
+	     (if (and (< i (- len 3))
+		      (string=? (substring str i (+ i 4)) "true"))
+		 (begin
+		   (display "#t" p)
+		   (set! i (+ i 3)))
+		 (format *stderr* "bad entry: ~S~%" (substring str i))))
+	    
+	    ((#\n)                       ; null -> ()
+	     (if (and (< i (- len 3))
+		      (string=? (substring str i (+ i 4)) "null"))
+		 (begin
+		   (display "()" p)
+		   (set! i (+ i 3)))
+		 (format *stderr* "bad entry: ~S~%" (substring str i))))
+	    
+	    ((#\f)                       ; false -> #f
+	     (if (and (< i (- len 4))
+		      (string=? (substring str i (+ i 5)) "false"))
+		 (begin
+		   (display "#f" p)
+		   (set! i (+ i 4)))
+		 (format *stderr* "bad entry: ~S~%" (substring str i))))
+
+	    (else 
+	     (write-char (str i) p))))))))
+
+;;; TODO: in the strings we need to support the 4-digit stuff (\\uxxxx I think)
+;;;   (json->s7 "{\"test\" : \"a\\u1234b\"}") -> (inlet 'test "a\x1234;b")
+
+(define* (s7->json obj (port (current-output-port)))
+  (case (type-of obj)
+    ((integer? float?) 
+     (display obj port))
+
+    ((string?)
+     (write obj port))
+
+    ((vector? float-vector? int-vector? byte-vector?)
+     (let ((len (length obj)))
+       (if (zero? len)
+	   (display "[]" port)
+	   (begin
+	     (write-char #\[ port)
+	     (do ((i 0 (+ i 1)))
+		 ((= i (- len 1))
+		  (s7->json (obj i) port)
+		  (write-char #\] port))
+	       (s7->json (obj i) port)
+	       (display ", " port))))))
+
+    ((let?)
+     (let ((len (length obj)))
+       (if (zero? len)
+	   (display "{}" port)
+	   (let ((slot-ctr 1))
+	     (write-char #\{ port)
+	     (for-each (lambda (slot)
+			 (write (symbol->string (car slot)) port)
+			 (display " : " port)
+			 (s7->json (cdr slot) port)
+			 (if (< slot-ctr len)
+			     (display ", " port)
+			     (write-char #\} port))
+			 (set! slot-ctr (+ slot-ctr 1)))
+		       (reverse obj))))))
+    (else
+     (format *stderr* "bad entry: ~S~%" obj))))
+
+
+#|
+;;; -------------------------------- tests --------------------------------
+
+(display (with-output-to-string (lambda () (s7->json (vector 1 2))))) (newline) ; "[1, 2]"
+(display (with-output-to-string (lambda () (s7->json (vector "asdf" #i(1 2)))))) (newline) ; "[\"asdf\", [1, 2]]"
+(display (with-output-to-string (lambda () (s7->json (inlet 'a 2))))) (newline) ; "{\"a\" : 2}
+
+(display 
+ (with-output-to-string
+   (lambda ()
+     (s7->json (json->s7 "{\"title\": \"Person\", \"type\": \"object\"}")))))
+(newline)
+
+
+(write (json->s7 "{\"test\":\"a\\\\b\"}")) (newline) ; (inlet 'test "a\\b") = (#\a #\\ #\b)
+(write (json->s7 "{\"test\" : \"a\tb\"}")) (newline) ; (string->list ((inlet 'test "a\x09b") 'test)) = (#\a #\tab #\b)
+(write (json->s7 "{\"test\":\"a\fb\"}")) (newline)   ; (inlet 'test "a\x0cb")
+(write (json->s7 "{\"test\":\"a\rb\"}")) (newline)   ; (inlet 'test "a\x0db")
+(write (json->s7 "{\"test\":\"a\bb\"}")) (newline)   ; (inlet 'test "a\x08b")
+(write (json->s7 "{\"test\":\"a\/b\"}")) (newline)   ; (inlet 'test "a/b")
+
+(write (json->s7 "[123 321]")) (newline)
+(write (json->s7 "{\"asdf\" : 123}")) (newline)
+(write (json->s7 "{\"asdf\":123}")) (newline)
+(write (json->s7 "[1 {\"asdf\" : \"fsda\"} 2]")) (newline)
+(write (json->s7 "[1.2 [3 [\"asdf\"]]]")) (newline)
+(write (json->s7 "[{} [] \"\"]")) (newline)
+
+;; some examples from json-schema.org and another site -- sitepoint?
+(write (json->s7 "{
+    \"title\": \"Person\",
+    \"type\": \"object\",
+    \"properties\": {
+        \"firstName\": {
+            \"type\": \"string\"
+        },
+        \"lastName\": {
+            \"type\": \"string\"
+        },
+        \"age\": {
+            \"description\": \"Age in years\",
+            \"type\": \"integer\",
+            \"minimum\": 0
+        }
+    },
+    \"required\": [\"firstName\", \"lastName\"]
+}"))
+(newline)
+
+(write (json->s7 "{ \"id\": \"http://json-schema.org/geo\", \"$schema\": \"http://json-schema.org/draft-06/schema#\", \"description\": \"A geographical coordinate\", \"type\": \"object\", \"properties\": { \"latitude\": { \"type\": \"number\" }, \"longitude\": { \"type\": \"number\" } } }")) (newline)
+
+(write (json->s7 "{ \"$schema\": \"http://json-schema.org/draft-06/schema#\", \"description\": \"A representation of a person, company, organization, or place\", \"type\": \"object\", \"required\": [\"familyName\", \"givenName\"], \"properties\": { \"fn\": { \"description\": \"Formatted Name\", \"type\": \"string\" }, \"familyName\": { \"type\": \"string\" }, \"givenName\": { \"type\": \"string\" }, \"additionalName\": { \"type\": \"array\", \"items\": { \"type\": \"string\" } }, \"honorificPrefix\": { \"type\": \"array\", \"items\": { \"type\": \"string\" } }, \"honorificSuffix\": { \"type\": \"array\", \"items\": { \"type\": \"string\" } }, \"nickname\": { \"type\": \"string\" }, \"url\": { \"type\": \"string\", \"format\": \"uri\" }, \"email\": { \"type\": \"object\", \"properties\": { \"type\": { \"type\": \"string\" }, \"value\": { \"type\": \"string\", \"format\": \"email\" } } }, \"tel\": { \"type\": \"object\", \"properties\": { \"type\": { \"type\": \"string\" }, \"value\": { \"type\": \"string\", \"format\": \"phone\" } } }, \"adr\": { \"$ref\": \"http://json-schema.org/address\" }, \"geo\": { \"$ref\": \"http://json-schema.org/geo\" }, \"tz\": { \"type\": \"string\" }, \"photo\": { \"type\": \"string\" }, \"logo\": { \"type\": \"string\" }, \"sound\": { \"type\": \"string\" }, \"bday\": { \"type\": \"string\", \"format\": \"date\" }, \"title\": { \"type\": \"string\" }, \"role\": { \"type\": \"string\" }, \"org\": { \"type\": \"object\", \"properties\": { \"organizationName\": { \"type\": \"string\" }, \"organizationUnit\": { \"type\": \"string\" } } } } } ")) (newline)
+
+(write (json->s7 "{ \"$schema\": \"http://json-schema.org/draft-06/schema#\", \"description\": \"A representation of an event\", \"type\": \"object\", \"required\": [ \"dtstart\", \"summary\" ], \"properties\": { \"dtstart\": { \"format\": \"date-time\", \"type\": \"string\", \"description\": \"Event starting time\" }, \"dtend\": { \"format\": \"date-time\", \"type\": \"string\", \"description\": \"Event ending time\" }, \"summary\": { \"type\": \"string\" }, \"location\": { \"type\": \"string\" }, \"url\": { \"type\": \"string\", \"format\": \"uri\" }, \"duration\": { \"format\": \"time\", \"type\": \"string\", \"description\": \"Event duration\" }, \"rdate\": { \"format\": \"date-time\", \"type\": \"string\", \"description\": \"Recurrence date\" }, \"rrule\": { \"type\": \"string\", \"description\": \"Recurrence rule\" }, \"category\": { \"type\": \"string\" }, \"description\": { \"type\": \"string\" }, \"geo\": { \"$ref\": \"http://json-schema.org/geo\" } } } ")) (newline)
+
+(write (json->s7 "{ \"$schema\": \"http://json-schema.org/draft-06/schema#\", \"description\": \"An Address following the convention of http://microformats.org/wiki/hcard\", \"type\": \"object\", \"properties\": { \"post-office-box\": { \"type\": \"string\" }, \"extended-address\": { \"type\": \"string\" }, \"street-address\": { \"type\": \"string\" }, \"locality\":{ \"type\": \"string\" }, \"region\": { \"type\": \"string\" }, \"postal-code\": { \"type\": \"string\" }, \"country-name\": { \"type\": \"string\"} }, \"required\": [\"locality\", \"region\", \"country-name\"], \"dependencies\": { \"post-office-box\": [\"street-address\"], \"extended-address\": [\"street-address\"] } } ")) (newline)
+
+(write (json->s7 "{
+    \"id\": 1,
+    \"name\": \"A green door\",
+    \"price\": 12.50,
+    \"tags\": [\"home\", \"green\"]
+}")) (newline)
+
+(write (json->s7 "[
+    {
+        \"id\": 2,
+        \"name\": \"An ice sculpture\",
+        \"price\": 12.50,
+        \"tags\": [\"cold\", \"ice\"],
+        \"dimensions\": {
+            \"length\": 7.0,
+            \"width\": 12.0,
+            \"height\": 9.5
+        },
+        \"warehouseLocation\": {
+            \"latitude\": -78.75,
+            \"longitude\": 20.4
+        }
+    },
+    {
+        \"id\": 3,
+        \"name\": \"A blue mouse\",
+        \"price\": 25.50,
+        \"dimensions\": {
+            \"length\": 3.1,
+            \"width\": 1.0,
+            \"height\": 1.0
+        },
+        \"warehouseLocation\": {
+            \"latitude\": 54.4,
+            \"longitude\": -32.7
+        }
+    }
+]"))
+(newline)
+
+(write (json->s7 "{
+    \"id\": \"http://some.site.somewhere/entry-schema#\",
+    \"$schema\": \"http://json-schema.org/draft-06/schema#\",
+    \"description\": \"schema for an fstab entry\",
+    \"type\": \"object\",
+    \"required\": [ \"storage\" ],
+    \"properties\": {
+        \"storage\": {
+            \"type\": \"object\",
+            \"oneOf\": [
+                { \"$ref\": \"#/definitions/diskDevice\" },
+                { \"$ref\": \"#/definitions/diskUUID\" },
+                { \"$ref\": \"#/definitions/nfs\" },
+                { \"$ref\": \"#/definitions/tmpfs\" }
+            ]
+        },
+        \"fstype\": {
+            \"enum\": [ \"ext3\", \"ext4\", \"btrfs\" ]
+        },
+        \"options\": {
+            \"type\": \"array\",
+            \"minItems\": 1,
+            \"items\": { \"type\": \"string\" },
+            \"uniqueItems\": true
+        },
+        \"readonly\": { \"type\": \"boolean\" }
+    },
+    \"definitions\": {
+        \"diskDevice\": {
+            \"properties\": {
+                \"type\": { \"enum\": [ \"disk\" ] },
+                \"device\": {
+                    \"type\": \"string\",
+                    \"pattern\": \"^/dev/[^/]+(/[^/]+)*$\"
+                }
+            },
+            \"required\": [ \"type\", \"device\" ],
+            \"additionalProperties\": false
+        },
+        \"diskUUID\": {
+            \"properties\": {
+                \"type\": { \"enum\": [ \"disk\" ] },
+                \"label\": {
+                    \"type\": \"string\",
+                    \"pattern\": \"^[a-fA-F0-9]{8}-[a-fA-F0-9]{4}-[a-fA-F0-9]{4}-[a-fA-F0-9]{4}-[a-fA-F0-9]{12}$\"
+                }
+            },
+            \"required\": [ \"type\", \"label\" ],
+            \"additionalProperties\": false
+        },
+        \"nfs\": {
+            \"properties\": {
+                \"type\": { \"enum\": [ \"nfs\" ] },
+                \"remotePath\": {
+                    \"type\": \"string\",
+                    \"pattern\": \"^(/[^/]+)+$\"
+                },
+                \"server\": {
+                    \"type\": \"string\",
+                    \"oneOf\": [
+                        { \"format\": \"hostname\" },
+                        { \"format\": \"ipv4\" },
+                        { \"format\": \"ipv6\" }
+                    ]
+                }
+            },
+            \"required\": [ \"type\", \"server\", \"remotePath\" ],
+            \"additionalProperties\": false
+        },
+        \"tmpfs\": {
+            \"properties\": {
+                \"type\": { \"enum\": [ \"tmpfs\" ] },
+                \"sizeInMB\": {
+                    \"type\": \"integer\",
+                    \"minimum\": 16,
+                    \"maximum\": 512
+                }
+            },
+            \"required\": [ \"type\", \"sizeInMB\" ],
+            \"additionalProperties\": false
+        }
+    }
+}
+")) (newline)
+
+
+(write (json->s7 "{
+  \"aliceblue\": [240, 248, 255, 1],
+  \"antiquewhite\": [250, 235, 215, 1],
+  \"aqua\": [0, 255, 255, 1],
+  \"aquamarine\": [127, 255, 212, 1],
+  \"azure\": [240, 255, 255, 1],
+  \"beige\": [245, 245, 220, 1],
+  \"bisque\": [255, 228, 196, 1],
+  \"black\": [0, 0, 0, 1],
+  \"blanchedalmond\": [255, 235, 205, 1],
+  \"blue\": [0, 0, 255, 1],
+  \"blueviolet\": [138, 43, 226, 1],
+  \"brown\": [165, 42, 42, 1],
+  \"burlywood\": [222, 184, 135, 1],
+  \"cadetblue\": [95, 158, 160, 1],
+  \"chartreuse\": [127, 255, 0, 1],
+  \"chocolate\": [210, 105, 30, 1],
+  \"coral\": [255, 127, 80, 1],
+}"))
+(newline)
+|#
diff --git a/s7/libarb_s7.c b/s7/libarb_s7.c
new file mode 100644
index 0000000..d9e0084
--- /dev/null
+++ b/s7/libarb_s7.c
@@ -0,0 +1,467 @@
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+
+#include <gmp.h>
+#include <mpfr.h>
+#include <mpc.h>
+
+#include <flint/arb.h>
+#include <flint/acb.h>
+#include <flint/acb_hypgeom.h>
+#include <flint/acb_elliptic.h>
+
+#define WITH_GMP 1
+#include "s7.h"
+
+static void s7_number_to_acb(s7_scheme *sc, acb_t z, s7_pointer x, slong prec)
+{
+  if (s7_is_big_real(x))
+    {
+      arf_set_mpfr((arf_struct *)acb_realref(z), *s7_big_real(x));
+      arb_zero(acb_imagref(z));
+    }
+  else
+    {
+      if (s7_is_big_integer(x))
+	{
+	  arf_set_mpz((arf_struct *)acb_realref(z), *s7_big_integer(x));
+	  arb_zero(acb_imagref(z));
+	}
+      else
+	{
+	  if (s7_is_integer(x))
+	    acb_set_si(z, s7_integer(x));
+	  else
+	    {
+	      if (s7_is_big_ratio(x))
+		{
+		  mpfr_t mq;
+		  mpfr_init2(mq, prec);
+		  mpfr_set_q(mq, *s7_big_ratio(x), MPFR_RNDN);
+		  arf_set_mpfr((arf_struct *)acb_realref(z), mq);
+		  arb_zero(acb_imagref(z));
+		  mpfr_clear(mq);
+		}
+	      else
+		{
+		  if (s7_is_real(x))
+		    acb_set_d(z, s7_real(x));
+		  else 
+		    {
+		      if (s7_is_big_complex(x))
+			{
+			  arf_set_mpfr((arf_struct *)acb_realref(z), mpc_realref(*s7_big_complex(x)));
+			  arf_set_mpfr((arf_struct *)acb_imagref(z), mpc_imagref(*s7_big_complex(x)));
+			}
+		      else
+			{
+			  if (s7_is_complex(x))
+			    acb_set_d_d(z, s7_real_part(x), s7_imag_part(x));
+			}}}}}}
+}
+
+static s7_pointer acb_to_s7(s7_scheme *sc, acb_t w, slong prec)
+{
+  s7_pointer result;
+  if (arb_is_zero(acb_imagref(w)))
+    {
+      mpfr_t mp;
+      mpfr_init2(mp, prec);
+      arf_get_mpfr(mp, (const arf_struct *)acb_realref(w), MPFR_RNDN);
+      result = s7_make_big_real(sc, &mp);
+      mpfr_clear(mp);
+    }
+  else
+    {
+      mpc_t mp;
+      mpc_init2(mp, prec);
+      arf_get_mpfr(mpc_realref(mp), (const arf_struct *)acb_realref(w), MPFR_RNDN);
+      arf_get_mpfr(mpc_imagref(mp), (const arf_struct *)acb_imagref(w), MPFR_RNDN);
+      result = s7_make_big_complex(sc, &mp);
+      mpc_clear(mp);
+    }
+  return(result);
+}
+
+
+static acb_t nu, w, z, b;
+/* these should be local to s7_scheme someday via a void* list or something */
+
+
+/* -------------------------------- aci -------------------------------- */
+static s7_pointer aci(s7_scheme *sc, s7_pointer args, const char *b_name, void acb_func(acb_t res, const acb_t z, slong prec))
+{
+  s7_pointer n;
+  slong prec;
+
+  prec = s7_integer(s7_starlet_ref(sc, s7_make_symbol(sc, "bignum-precision")));
+
+  n = s7_car(args);
+  if (!s7_is_number(n))
+    return(s7_wrong_type_arg_error(sc, b_name, 1, n, "number"));
+  s7_number_to_acb(sc, z, n, prec);
+
+  acb_func(w, z, prec);
+  return(acb_to_s7(sc, w, prec));
+}
+
+static s7_pointer a_erf(s7_scheme *sc, s7_pointer args)          {return(aci(sc, args, "acb_erf",          acb_hypgeom_erf));}
+static s7_pointer a_erfc(s7_scheme *sc, s7_pointer args)         {return(aci(sc, args, "acb_erfc",         acb_hypgeom_erfc));}
+static s7_pointer a_erfi(s7_scheme *sc, s7_pointer args)         {return(aci(sc, args, "acb_erfi",         acb_hypgeom_erfi));}
+static s7_pointer a_ei(s7_scheme *sc, s7_pointer args)           {return(aci(sc, args, "acb_ei",           acb_hypgeom_ei));}
+static s7_pointer a_si(s7_scheme *sc, s7_pointer args)           {return(aci(sc, args, "acb_si",           acb_hypgeom_si));}
+static s7_pointer a_ci(s7_scheme *sc, s7_pointer args)           {return(aci(sc, args, "acb_ci",           acb_hypgeom_ci));}
+static s7_pointer a_shi(s7_scheme *sc, s7_pointer args)          {return(aci(sc, args, "acb_shi",          acb_hypgeom_shi));}
+static s7_pointer a_chi(s7_scheme *sc, s7_pointer args)          {return(aci(sc, args, "acb_chi",          acb_hypgeom_chi));}
+static s7_pointer a_erf_1f1a(s7_scheme *sc, s7_pointer args)     {return(aci(sc, args, "acb_erf_1f1a",     acb_hypgeom_erf_1f1a));}
+static s7_pointer a_erf_1f1b(s7_scheme *sc, s7_pointer args)     {return(aci(sc, args, "acb_erf_1f1b",     acb_hypgeom_erf_1f1b));}
+static s7_pointer a_ei_asymp(s7_scheme *sc, s7_pointer args)     {return(aci(sc, args, "acb_ei_asymp",     acb_hypgeom_ei_asymp));}
+static s7_pointer a_ei_2f2(s7_scheme *sc, s7_pointer args)       {return(aci(sc, args, "acb_ei_2f2",       acb_hypgeom_ei_2f2));}
+static s7_pointer a_si_asymp(s7_scheme *sc, s7_pointer args)     {return(aci(sc, args, "acb_si_asymp",     acb_hypgeom_si_asymp));}
+static s7_pointer a_si_1f2(s7_scheme *sc, s7_pointer args)       {return(aci(sc, args, "acb_si_1f2",       acb_hypgeom_si_1f2));}
+static s7_pointer a_ci_asymp(s7_scheme *sc, s7_pointer args)     {return(aci(sc, args, "acb_ci_asymp",     acb_hypgeom_ci_asymp));}
+static s7_pointer a_ci_2f3(s7_scheme *sc, s7_pointer args)       {return(aci(sc, args, "acb_ci_2f3",       acb_hypgeom_ci_2f3));}
+static s7_pointer a_chi_asymp(s7_scheme *sc, s7_pointer args)    {return(aci(sc, args, "acb_chi_asymp",    acb_hypgeom_chi_asymp));}
+static s7_pointer a_chi_2f3(s7_scheme *sc, s7_pointer args)      {return(aci(sc, args, "acb_chi_2f3",      acb_hypgeom_chi_2f3));}
+static s7_pointer a_dilog_bernoulli(s7_scheme *sc, s7_pointer args) {return(aci(sc, args, "acb_dilog_bernoulli", acb_hypgeom_dilog_bernoulli));}
+static s7_pointer a_dilog_zero_taylor(s7_scheme *sc, s7_pointer args) {return(aci(sc, args, "acb_dilog_zero_taylor", acb_hypgeom_dilog_zero_taylor));}
+static s7_pointer a_dilog_zero(s7_scheme *sc, s7_pointer args)   {return(aci(sc, args, "acb_dilog_zero",   acb_hypgeom_dilog_zero));}
+static s7_pointer a_dilog(s7_scheme *sc, s7_pointer args)        {return(aci(sc, args, "acb_dilog",        acb_hypgeom_dilog));}
+static s7_pointer a_elliptic_k(s7_scheme *sc, s7_pointer args)   {return(aci(sc, args, "acb_elliptic_k",   acb_elliptic_k));}
+static s7_pointer a_elliptic_e(s7_scheme *sc, s7_pointer args)   {return(aci(sc, args, "acb_elliptic_e",   acb_elliptic_e));}
+static s7_pointer a_elliptic_rc1(s7_scheme *sc, s7_pointer args) {return(aci(sc, args, "acb_elliptic_rc1", acb_elliptic_rc1));}
+static s7_pointer a_gamma(s7_scheme *sc, s7_pointer args)        {return(aci(sc, args, "acb_gamma",        acb_gamma));}
+static s7_pointer a_rgamma(s7_scheme *sc, s7_pointer args)       {return(aci(sc, args, "acb_rgamma",       acb_rgamma));}
+static s7_pointer a_lgamma(s7_scheme *sc, s7_pointer args)       {return(aci(sc, args, "acb_lgamma",       acb_lgamma));}
+static s7_pointer a_log_sin_pi(s7_scheme *sc, s7_pointer args)   {return(aci(sc, args, "acb_log_sin_pi",   acb_log_sin_pi));}
+static s7_pointer a_digamma(s7_scheme *sc, s7_pointer args)      {return(aci(sc, args, "acb_digamma",      acb_digamma));}
+static s7_pointer a_zeta(s7_scheme *sc, s7_pointer args)         {return(aci(sc, args, "acb_zeta",         acb_zeta));}
+static s7_pointer a_log_barnes_g(s7_scheme *sc, s7_pointer args) {return(aci(sc, args, "acb_log_barnes_g", acb_log_barnes_g));}
+static s7_pointer a_barnes_g(s7_scheme *sc, s7_pointer args)     {return(aci(sc, args, "acb_barnes_g",     acb_barnes_g));}
+static s7_pointer a_sinc(s7_scheme *sc, s7_pointer args)         {return(aci(sc, args, "acb_sinc",         acb_sinc));}
+static s7_pointer a_sinc_pi(s7_scheme *sc, s7_pointer args)      {return(aci(sc, args, "acb_sinc_pi",      acb_sinc_pi));}
+static s7_pointer a_agm1(s7_scheme *sc, s7_pointer args)         {return(aci(sc, args, "acb_agm1",         acb_agm1));}
+
+
+/* -------------------------------- acci -------------------------------- */
+static s7_pointer acci(s7_scheme *sc, s7_pointer args, const char *b_name, void acb_func(acb_t res, const acb_t nu, const acb_t z, slong prec))
+{
+  s7_pointer n, x;
+  slong prec;
+
+  prec = s7_integer(s7_starlet_ref(sc, s7_make_symbol(sc, "bignum-precision")));
+
+  n = s7_car(args);
+  if (!s7_is_number(n))
+    return(s7_wrong_type_arg_error(sc, b_name, 1, n, "number"));
+  s7_number_to_acb(sc, nu, n, prec);
+
+  x = s7_cadr(args);
+  if (!s7_is_number(x))
+    return(s7_wrong_type_arg_error(sc, b_name, 2, x, "number"));
+  s7_number_to_acb(sc, z, x, prec);
+
+  acb_func(w, nu, z, prec);
+  return(acb_to_s7(sc, w, prec));
+}
+			
+static s7_pointer a_bessel_j(s7_scheme *sc, s7_pointer args) {return(acci(sc, args, "acb_bessel_j", acb_hypgeom_bessel_j));}
+static s7_pointer a_bessel_y(s7_scheme *sc, s7_pointer args) {return(acci(sc, args, "acb_bessel_y", acb_hypgeom_bessel_y));}
+static s7_pointer a_bessel_i(s7_scheme *sc, s7_pointer args) {return(acci(sc, args, "acb_bessel_i", acb_hypgeom_bessel_i));}
+static s7_pointer a_bessel_k(s7_scheme *sc, s7_pointer args) {return(acci(sc, args, "acb_bessel_k", acb_hypgeom_bessel_k));}
+
+static s7_pointer a_hermite_h(s7_scheme *sc, s7_pointer args)       {return(acci(sc, args, "acb_hermite_h",       acb_hypgeom_hermite_h));}
+static s7_pointer a_chebyshev_t(s7_scheme *sc, s7_pointer args)     {return(acci(sc, args, "acb_chebyshev_t",     acb_hypgeom_chebyshev_t));}
+static s7_pointer a_chebyshev_u(s7_scheme *sc, s7_pointer args)     {return(acci(sc, args, "acb_chebyshev_u",     acb_hypgeom_chebyshev_u));}
+static s7_pointer a_bessel_j_0f1(s7_scheme *sc, s7_pointer args)    {return(acci(sc, args, "acb_bessel_j_0f1",    acb_hypgeom_bessel_j_0f1));}
+static s7_pointer a_bessel_j_asymp(s7_scheme *sc, s7_pointer args)  {return(acci(sc, args, "acb_bessel_j_asymp",  acb_hypgeom_bessel_j_asymp));}
+static s7_pointer a_bessel_i_scaled(s7_scheme *sc, s7_pointer args) {return(acci(sc, args, "acb_bessel_i_scaled", acb_hypgeom_bessel_i_scaled));}
+static s7_pointer a_bessel_k_scaled(s7_scheme *sc, s7_pointer args) {return(acci(sc, args, "acb_bessel_k_scaled", acb_hypgeom_bessel_k_scaled));}
+static s7_pointer a_expint(s7_scheme *sc, s7_pointer args)          {return(acci(sc, args, "acb_expint",          acb_hypgeom_expint));}
+static s7_pointer a_elliptic_pi(s7_scheme *sc, s7_pointer args)     {return(acci(sc, args, "acb_elliptic_pi",     acb_elliptic_pi));}
+static s7_pointer a_elliptic_p(s7_scheme *sc, s7_pointer args)      {return(acci(sc, args, "acb_elliptic_p",      acb_elliptic_p));}
+static s7_pointer a_elliptic_zeta(s7_scheme *sc, s7_pointer args)   {return(acci(sc, args, "acb_elliptic_zeta",   acb_elliptic_zeta));}
+static s7_pointer a_elliptic_sigma(s7_scheme *sc, s7_pointer args)  {return(acci(sc, args, "acb_elliptic_sigma",  acb_elliptic_sigma));}
+static s7_pointer a_elliptic_inv_p(s7_scheme *sc, s7_pointer args)  {return(acci(sc, args, "acb_elliptic_inv_p",  acb_elliptic_inv_p));}
+static s7_pointer a_hurwitz_zeta(s7_scheme *sc, s7_pointer args)    {return(acci(sc, args, "acb_hurwitz_zeta",    acb_hurwitz_zeta));}
+static s7_pointer a_polygamma(s7_scheme *sc, s7_pointer args)       {return(acci(sc, args, "acb_polygamma",       acb_polygamma));}
+static s7_pointer a_polylog(s7_scheme *sc, s7_pointer args)         {return(acci(sc, args, "acb_polylog",         acb_polylog));}
+static s7_pointer a_agm(s7_scheme *sc, s7_pointer args)             {return(acci(sc, args, "acb_agm",             acb_agm));}
+static s7_pointer a_dilog_continuation(s7_scheme *sc, s7_pointer args) {return(acci(sc, args, "acb_dilog_continuation", acb_hypgeom_dilog_continuation));}
+
+
+/* -------------------------------- accii -------------------------------- */
+static s7_pointer accii(s7_scheme *sc, s7_pointer args, const char *b_name, void acb_func(acb_t res, const acb_t nu, const acb_t z, int scaled, slong prec))
+{
+  s7_pointer n, x, scl;
+  slong prec;
+  s7_int scaled;
+
+  prec = s7_integer(s7_starlet_ref(sc, s7_make_symbol(sc, "bignum-precision")));
+
+  n = s7_car(args);
+  if (!s7_is_number(n))
+    return(s7_wrong_type_arg_error(sc, b_name, 1, n, "number"));
+  s7_number_to_acb(sc, nu, n, prec);
+
+  x = s7_cadr(args);
+  if (!s7_is_number(x))
+    return(s7_wrong_type_arg_error(sc, b_name, 2, x, "number"));
+  s7_number_to_acb(sc, z, x, prec);
+
+  scl = s7_caddr(args);
+  if (!s7_is_integer(scl))
+    return(s7_wrong_type_arg_error(sc, b_name, 3, scl, "integer"));
+  scaled = s7_integer(scl);
+
+  acb_func(w, nu, z, scaled, prec);
+  return(acb_to_s7(sc, w, prec));
+}
+
+static s7_pointer a_bessel_i_0f1(s7_scheme *sc, s7_pointer args)       {return(accii(sc, args, "acb_bessel_i_0f1",       acb_hypgeom_bessel_i_0f1));}
+static s7_pointer a_bessel_i_asymp(s7_scheme *sc, s7_pointer args)     {return(accii(sc, args, "acb_bessel_i_asymp",     acb_hypgeom_bessel_i_asymp));}
+static s7_pointer a_bessel_k_0f1(s7_scheme *sc, s7_pointer args)       {return(accii(sc, args, "acb_bessel_k_0f1",       acb_hypgeom_bessel_k_0f1));}
+static s7_pointer a_bessel_k_asymp(s7_scheme *sc, s7_pointer args)     {return(accii(sc, args, "acb_bessel_k_asymp",     acb_hypgeom_bessel_k_asymp));}
+static s7_pointer a_hypgeom_0f1_asymp(s7_scheme *sc, s7_pointer args)  {return(accii(sc, args, "acb_hypgeom_0f1_asymp",  acb_hypgeom_0f1_asymp));}
+static s7_pointer a_hypgeom_0f1_direct(s7_scheme *sc, s7_pointer args) {return(accii(sc, args, "acb_hypgeom_0f1_direct", acb_hypgeom_0f1_direct));}
+static s7_pointer a_hypgeom_0f1(s7_scheme *sc, s7_pointer args)        {return(accii(sc, args, "acb_hypgeom_0f1",        acb_hypgeom_0f1));}
+static s7_pointer a_gamma_lower(s7_scheme *sc, s7_pointer args)        {return(accii(sc, args, "acb_gamma_lower",        acb_hypgeom_gamma_lower));}
+static s7_pointer a_gamma_upper_asymp(s7_scheme *sc, s7_pointer args)  {return(accii(sc, args, "acb_gamma_upper_asymp",  acb_hypgeom_gamma_upper_asymp));}
+static s7_pointer a_gamma_upper_1f1a(s7_scheme *sc, s7_pointer args)   {return(accii(sc, args, "acb_gamma_upper_1f1a",   acb_hypgeom_gamma_upper_1f1a));}
+static s7_pointer a_gamma_upper_1f1b(s7_scheme *sc, s7_pointer args)   {return(accii(sc, args, "acb_gamma_upper_1f1b",   acb_hypgeom_gamma_upper_1f1b));}
+static s7_pointer a_gamma_upper(s7_scheme *sc, s7_pointer args)        {return(accii(sc, args, "acb_gamma_upper",        acb_hypgeom_gamma_upper));}
+static s7_pointer a_elliptic_e_inc(s7_scheme *sc, s7_pointer args)     {return(accii(sc, args, "acb_elliptic_e_inc",     acb_elliptic_e_inc));}
+static s7_pointer a_elliptic_f(s7_scheme *sc, s7_pointer args)         {return(accii(sc, args, "acb_elliptic_f",         acb_elliptic_f));}
+
+
+/* -------------------------------- accci -------------------------------- */
+static s7_pointer accci(s7_scheme *sc, s7_pointer args, const char *b_name, void acb_func(acb_t res, const acb_t nu, const acb_t z, const acb_t b, slong prec))
+{
+  s7_pointer n, x, b1;
+  slong prec;
+
+  prec = s7_integer(s7_starlet_ref(sc, s7_make_symbol(sc, "bignum-precision")));
+
+  n = s7_car(args);
+  if (!s7_is_number(n))
+    return(s7_wrong_type_arg_error(sc, b_name, 1, n, "number"));
+  s7_number_to_acb(sc, nu, n, prec);
+
+  x = s7_cadr(args);
+  if (!s7_is_number(x))
+    return(s7_wrong_type_arg_error(sc, b_name, 2, x, "number"));
+  s7_number_to_acb(sc, z, x, prec);
+
+  b1 = s7_caddr(args);
+  if (!s7_is_number(b1))
+    return(s7_wrong_type_arg_error(sc, b_name, 3, b1, "number"));
+  s7_number_to_acb(sc, b, b1, prec);
+
+  acb_func(w, nu, z, b, prec);
+  return(acb_to_s7(sc, w, prec));
+}
+
+static s7_pointer a_hypgeom_u_1f1(s7_scheme *sc, s7_pointer args) {return(accci(sc, args, "acb_hypgeom_u_1f1", acb_hypgeom_u_1f1));}
+static s7_pointer a_hypgeom_u(s7_scheme *sc, s7_pointer args)     {return(accci(sc, args, "acb_hypgeom_u",     acb_hypgeom_u));}
+static s7_pointer a_gegenbauer_c(s7_scheme *sc, s7_pointer args)  {return(accci(sc, args, "acb_gegenbauer_c",  acb_hypgeom_gegenbauer_c));}
+static s7_pointer a_laguerre_l(s7_scheme *sc, s7_pointer args)    {return(accci(sc, args, "acb_laguerre_l",    acb_hypgeom_laguerre_l));}
+
+
+/* -------------------------------- acccii -------------------------------- */
+static s7_pointer acccii(s7_scheme *sc, s7_pointer args, const char *b_name, void acb_func(acb_t res, const acb_t nu, const acb_t z, const acb_t b, int scaled, slong prec))
+{
+  s7_pointer n, x, scl, b1;
+  slong prec;
+  s7_int scaled;
+
+  prec = s7_integer(s7_starlet_ref(sc, s7_make_symbol(sc, "bignum-precision")));
+
+  n = s7_car(args);
+  if (!s7_is_number(n))
+    return(s7_wrong_type_arg_error(sc, b_name, 1, n, "number"));
+  s7_number_to_acb(sc, nu, n, prec);
+
+  x = s7_cadr(args);
+  if (!s7_is_number(x))
+    return(s7_wrong_type_arg_error(sc, b_name, 2, x, "number"));
+  s7_number_to_acb(sc, z, x, prec);
+
+  b1 = s7_caddr(args);
+  if (!s7_is_number(b1))
+    return(s7_wrong_type_arg_error(sc, b_name, 3, b1, "number"));
+  s7_number_to_acb(sc, b, b1, prec);
+
+  scl = s7_cadddr(args);
+  if (!s7_is_integer(scl))
+    return(s7_wrong_type_arg_error(sc, b_name, 4, scl, "integer"));
+  scaled = s7_integer(scl);
+
+  acb_func(w, nu, z, b, scaled, prec);
+  return(acb_to_s7(sc, w, prec));
+}
+
+static s7_pointer a_hypgeom_m_asymp(s7_scheme *sc, s7_pointer args)    {return(acccii(sc, args, "acb_hypgeom_m_asymp",    acb_hypgeom_m_asymp));}
+static s7_pointer a_hypgeom_m_1f1(s7_scheme *sc, s7_pointer args)      {return(acccii(sc, args, "acb_hypgeom_m_1f1",      acb_hypgeom_m_1f1));}
+static s7_pointer a_hypgeom_m(s7_scheme *sc, s7_pointer args)          {return(acccii(sc, args, "acb_hypgeom_m",          acb_hypgeom_m));}
+static s7_pointer a_hypgeom_1f1(s7_scheme *sc, s7_pointer args)        {return(acccii(sc, args, "acb_hypgeom_1f1",        acb_hypgeom_1f1));}
+static s7_pointer a_hypgeom_beta_lower(s7_scheme *sc, s7_pointer args) {return(acccii(sc, args, "acb_beta_lower",         acb_hypgeom_beta_lower));}
+static s7_pointer a_hypgeom_legendre_p(s7_scheme *sc, s7_pointer args) {return(acccii(sc, args, "acb_legendre_p",         acb_hypgeom_legendre_p));}
+static s7_pointer a_hypgeom_legendre_q(s7_scheme *sc, s7_pointer args) {return(acccii(sc, args, "acb_legendre_q",         acb_hypgeom_legendre_q));}
+static s7_pointer a_elliptic_rf(s7_scheme *sc, s7_pointer args)        {return(acccii(sc, args, "acb_elliptic_rf",        acb_elliptic_rf));}
+static s7_pointer a_elliptic_rg(s7_scheme *sc, s7_pointer args)        {return(acccii(sc, args, "acb_elliptic_rg",        acb_elliptic_rg));}
+static s7_pointer a_elliptic_pi_inc(s7_scheme *sc, s7_pointer args)    {return(acccii(sc, args, "acb_elliptic_pi_inc",    acb_elliptic_pi_inc));}
+
+
+/* -------------------------------- libarb_s7_init -------------------------------- */
+
+void libarb_s7_init(s7_scheme *sc);
+void libarb_s7_init(s7_scheme *sc)
+{
+  s7_pointer old_shadow, arb, old_curlet, aci_sig, acci_sig, accii_sig, accci_sig, acccii_sig;
+
+  acb_init(b);
+  acb_init(nu);
+  acb_init(w);
+  acb_init(z);
+
+  s7_define_constant(sc, "*arb*", arb = s7_inlet(sc, s7_nil(sc)));
+  old_curlet = s7_set_curlet(sc, arb);
+  old_shadow = s7_set_shadow_rootlet(sc, arb);
+
+  aci_sig = s7_make_signature(sc, 2, s7_make_symbol(sc, "number?"), s7_make_symbol(sc, "number?")); /* "i" in aci=precision */
+  acci_sig = s7_make_signature(sc, 3, s7_make_symbol(sc, "number?"), s7_make_symbol(sc, "number?"), s7_make_symbol(sc, "number?"));
+  accii_sig = s7_make_signature(sc, 4, s7_make_symbol(sc, "number?"), s7_make_symbol(sc, "number?"), s7_make_symbol(sc, "number?"), s7_make_symbol(sc, "integer?"));
+  accci_sig = s7_make_signature(sc, 4, s7_make_symbol(sc, "number?"), s7_make_symbol(sc, "number?"), s7_make_symbol(sc, "number?"), s7_make_symbol(sc, "number?"));
+  acccii_sig = s7_make_signature(sc, 5, s7_make_symbol(sc, "number?"), s7_make_symbol(sc, "number?"), 
+				 s7_make_symbol(sc, "number?"), s7_make_symbol(sc, "number?"), s7_make_symbol(sc, "integer?"));
+
+  s7_define_typed_function(sc, "acb_erf",             a_erf,             1, 0, false, "(acb_erf x)",             aci_sig);
+  s7_define_typed_function(sc, "acb_erfc",            a_erfc,            1, 0, false, "(acb_erfc x)",            aci_sig);
+  s7_define_typed_function(sc, "acb_erfi",            a_erfi,            1, 0, false, "(acb_erfi x)",            aci_sig);
+  s7_define_typed_function(sc, "acb_ei",              a_ei,              1, 0, false, "(acb_ei x)",              aci_sig);
+  s7_define_typed_function(sc, "acb_si",              a_si,              1, 0, false, "(acb_si x)",              aci_sig);
+  s7_define_typed_function(sc, "acb_ci",              a_ci,              1, 0, false, "(acb_ci x)",              aci_sig);
+  s7_define_typed_function(sc, "acb_shi",             a_shi,             1, 0, false, "(acb_shi x)",             aci_sig);
+  s7_define_typed_function(sc, "acb_chi",             a_chi,             1, 0, false, "(acb_chi x)",             aci_sig);
+  s7_define_typed_function(sc, "acb_erf_1f1a",        a_erf_1f1a,        1, 0, false, "(acb_erf_1f1a x)",        aci_sig);
+  s7_define_typed_function(sc, "acb_erf_1f1b",        a_erf_1f1b,        1, 0, false, "(acb_erf_1f1b x)",        aci_sig);
+  s7_define_typed_function(sc, "acb_ei_asymp",        a_ei_asymp,        1, 0, false, "(acb_ei_asymp x)",        aci_sig);
+  s7_define_typed_function(sc, "acb_ei_2f2",          a_ei_2f2,          1, 0, false, "(acb_ei_2f2 x)",          aci_sig);
+  s7_define_typed_function(sc, "acb_si_asymp",        a_si_asymp,        1, 0, false, "(acb_si_asymp x)",        aci_sig);
+  s7_define_typed_function(sc, "acb_si_1f2",          a_si_1f2,          1, 0, false, "(acb_si_1f2 x)",          aci_sig);
+  s7_define_typed_function(sc, "acb_ci_asymp",        a_ci_asymp,        1, 0, false, "(acb_ci_asymp x)",        aci_sig);
+  s7_define_typed_function(sc, "acb_ci_2f3",          a_ci_2f3,          1, 0, false, "(acb_ci_2f3 x)",          aci_sig);
+  s7_define_typed_function(sc, "acb_chi_asymp",       a_chi_asymp,       1, 0, false, "(acb_chi_asymp x)",       aci_sig);
+  s7_define_typed_function(sc, "acb_chi_2f3",         a_chi_2f3,         1, 0, false, "(acb_chi_2f3 x)",         aci_sig);
+  s7_define_typed_function(sc, "acb_dilog_bernoulli", a_dilog_bernoulli, 1, 0, false, "(acb_dilog_bernoulli x)", aci_sig);
+  s7_define_typed_function(sc, "acb_dilog_zero_taylor", a_dilog_zero_taylor, 1, 0, false, "(acb_dilog_zero_taylor x)", aci_sig);
+  s7_define_typed_function(sc, "acb_dilog_zero",      a_dilog_zero,      1, 0, false, "(acb_dilog_zero x)",      aci_sig);
+  s7_define_typed_function(sc, "acb_dilog",           a_dilog,           1, 0, false, "(acb_dilog x)",           aci_sig);
+  s7_define_typed_function(sc, "acb_elliptic_k",      a_elliptic_k,      1, 0, false, "(acb_elliptic_k x)",      aci_sig);
+  s7_define_typed_function(sc, "acb_elliptic_e",      a_elliptic_e,      1, 0, false, "(acb_elliptic_e x)",      aci_sig);
+  s7_define_typed_function(sc, "acb_elliptic_rc1",    a_elliptic_rc1,    1, 0, false, "(acb_elliptic_rc1 x)",    aci_sig);
+  s7_define_typed_function(sc, "acb_gamma",           a_gamma,           1, 0, false, "(acb_gamma x)",           aci_sig);
+  s7_define_typed_function(sc, "acb_rgamma",          a_rgamma,          1, 0, false, "(acb_rgamma x)",          aci_sig);
+  s7_define_typed_function(sc, "acb_lgamma",          a_lgamma,          1, 0, false, "(acb_lgamma x)",          aci_sig);
+  s7_define_typed_function(sc, "acb_log_sin_pi",      a_log_sin_pi,      1, 0, false, "(acb_log_sin_pi x)",      aci_sig);
+  s7_define_typed_function(sc, "acb_digamma",         a_digamma,         1, 0, false, "(acb_digamma x)",         aci_sig);
+  s7_define_typed_function(sc, "acb_zeta",            a_zeta,            1, 0, false, "(acb_zeta x)",            aci_sig);
+  s7_define_typed_function(sc, "acb_log_barnes_g",    a_log_barnes_g,    1, 0, false, "(acb_log_barnes_g x)",    aci_sig);
+  s7_define_typed_function(sc, "acb_barnes_g",        a_barnes_g,        1, 0, false, "(acb_barnes_g x)",        aci_sig);
+  s7_define_typed_function(sc, "acb_sinc",            a_sinc,            1, 0, false, "(acb_sinc x)",            aci_sig);
+  s7_define_typed_function(sc, "acb_sinc_pi",         a_sinc_pi,         1, 0, false, "(acb_sinc_pi x)",         aci_sig);
+  s7_define_typed_function(sc, "acb_agm1",            a_agm1,            1, 0, false, "(acb_agm1 x)",            aci_sig);
+
+  s7_define_typed_function(sc, "acb_bessel_j",        a_bessel_j,        2, 0, false, "(acb_bessel_j n x)",      acci_sig);
+  s7_define_typed_function(sc, "acb_bessel_y",        a_bessel_y,        2, 0, false, "(acb_bessel_y n x)",      acci_sig);
+  s7_define_typed_function(sc, "acb_bessel_i",        a_bessel_i,        2, 0, false, "(acb_bessel_i n x)",      acci_sig);
+  s7_define_typed_function(sc, "acb_bessel_k",        a_bessel_k,        2, 0, false, "(acb_bessel_k n x)",      acci_sig);
+  s7_define_typed_function(sc, "acb_hermite_h",       a_hermite_h,       2, 0, false, "(acb_hermite_h n x)",     acci_sig);
+  s7_define_typed_function(sc, "acb_chebyshev_t",     a_chebyshev_t,     2, 0, false, "(acb_chebyshev_t n x)",   acci_sig);
+  s7_define_typed_function(sc, "acb_chebyshev_u",     a_chebyshev_u,     2, 0, false, "(acb_chebyshev_u n x)",   acci_sig);
+  s7_define_typed_function(sc, "acb_bessel_j_0f1",    a_bessel_j_0f1,    2, 0, false, "(acb_bessel_j_0f1 n x)",  acci_sig);
+  s7_define_typed_function(sc, "acb_bessel_j_asymp",  a_bessel_j_asymp,  2, 0, false, "(acb_bessel_j_asymp n x)", acci_sig);
+  s7_define_typed_function(sc, "acb_bessel_i_scaled", a_bessel_i_scaled, 2, 0, false, "(acb_bessel_i_scaled n x)", acci_sig);
+  s7_define_typed_function(sc, "acb_bessel_k_scaled", a_bessel_k_scaled, 2, 0, false, "(acb_bessel_k_scaled n x)", acci_sig);
+  s7_define_typed_function(sc, "acb_expint",          a_expint,          2, 0, false, "(acb_expint n x)",        acci_sig);
+  s7_define_typed_function(sc, "acb_elliptic_pi",     a_elliptic_pi,     2, 0, false, "(acb_elliptic_pi)",       acci_sig);
+  s7_define_typed_function(sc, "acb_elliptic_p",      a_elliptic_p,      2, 0, false, "(acb_elliptic_p)",        acci_sig);
+  s7_define_typed_function(sc, "acb_elliptic_zeta",   a_elliptic_zeta,   2, 0, false, "(acb_elliptic_zeta)",     acci_sig);
+  s7_define_typed_function(sc, "acb_elliptic_sigma",  a_elliptic_sigma,  2, 0, false, "(acb_elliptic_sigma)",    acci_sig);
+  s7_define_typed_function(sc, "acb_elliptic_inv_p",  a_elliptic_inv_p,  2, 0, false, "(acb_elliptic_inv_p)",    acci_sig);
+  s7_define_typed_function(sc, "acb_hurwitz_zeta",    a_hurwitz_zeta,    2, 0, false, "(acb_hurwitz_zeta)",      acci_sig);
+  s7_define_typed_function(sc, "acb_polygamma",       a_polygamma,       2, 0, false, "(acb_polygamma)",         acci_sig);
+  s7_define_typed_function(sc, "acb_polylog",         a_polylog,         2, 0, false, "(acb_polylog)",           acci_sig);
+  s7_define_typed_function(sc, "acb_agm",             a_agm,             2, 0, false, "(acb_agm)",               acci_sig);
+  s7_define_typed_function(sc, "acb_dilog_continuation", a_dilog_continuation, 2, 0, false, "(acb_dilog_continuation)", acci_sig);
+
+  s7_define_typed_function(sc, "acb_bessel_i_0f1",       a_bessel_i_0f1,       3, 0, false, "(acb_bessel_i_0f1)",       accii_sig);
+  s7_define_typed_function(sc, "acb_bessel_i_asymp",     a_bessel_i_asymp,     3, 0, false, "(acb_bessel_i_asymp)",     accii_sig);
+  s7_define_typed_function(sc, "acb_bessel_k_0f1",       a_bessel_k_0f1,       3, 0, false, "(acb_bessel_k_0f1)",       accii_sig);
+  s7_define_typed_function(sc, "acb_bessel_k_asymp",     a_bessel_k_asymp,     3, 0, false, "(acb_bessel_k_asymp)",     accii_sig);
+  s7_define_typed_function(sc, "acb_hypgeom_0f1_asymp",  a_hypgeom_0f1_asymp,  3, 0, false, "(acb_hypgeom_0f1_asymp)",  accii_sig);
+  s7_define_typed_function(sc, "acb_hypgeom_0f1_direct", a_hypgeom_0f1_direct, 3, 0, false, "(acb_hypgeom_0f1_direct)", accii_sig);
+  s7_define_typed_function(sc, "acb_hypgeom_0f1",        a_hypgeom_0f1,        3, 0, false, "(acb_hypgeom_0f1)",        accii_sig);
+  s7_define_typed_function(sc, "acb_gamma_lower",        a_gamma_lower,        3, 0, false, "(acb_gamma_lower)",        accii_sig);
+  s7_define_typed_function(sc, "acb_gamma_upper_asymp",  a_gamma_upper_asymp,  3, 0, false, "(acb_gamma_upper_asymp)",  accii_sig);
+  s7_define_typed_function(sc, "acb_gamma_upper_1f1a",   a_gamma_upper_1f1a,   3, 0, false, "(acb_gamma_upper_1f1a)",   accii_sig);
+  s7_define_typed_function(sc, "acb_gamma_upper_1f1b",   a_gamma_upper_1f1b,   3, 0, false, "(acb_gamma_upper_1f1b)",   accii_sig);
+  s7_define_typed_function(sc, "acb_gamma_upper",        a_gamma_upper,        3, 0, false, "(acb_gamma_upper)",        accii_sig);
+  s7_define_typed_function(sc, "acb_elliptic_e_inc",     a_elliptic_e_inc,     3, 0, false, "(acb_elliptic_e_inc)",     accii_sig);
+  s7_define_typed_function(sc, "acb_elliptic_f",         a_elliptic_f,         3, 0, false, "(acb_elliptic_f)",         accii_sig);
+
+  s7_define_typed_function(sc, "acb_hypgeom_u_1f1",      a_hypgeom_u_1f1,      3, 0, false, "(acb_hypgeom_u_1f1)", accci_sig);
+  s7_define_typed_function(sc, "acb_hypgeom_u",          a_hypgeom_u,          3, 0, false, "(acb_hypgeom_u)",     accci_sig);
+  s7_define_typed_function(sc, "acb_gegenbauer_c",       a_gegenbauer_c,       3, 0, false, "(acb_gegenbauer_c)",  accci_sig);
+  s7_define_typed_function(sc, "acb_laguerre_l",         a_laguerre_l,         3, 0, false, "(acb_laguerre_l)",    accci_sig);
+
+  s7_define_typed_function(sc, "acb_hypgeom_m_asymp",    a_hypgeom_m_asymp,    4, 0, false, "(acb_hypgeom_m_asymp)", acccii_sig);
+  s7_define_typed_function(sc, "acb_hypgeom_m_1f1",      a_hypgeom_m_1f1,      4, 0, false, "(acb_hypgeom_m_1f1)",   acccii_sig);
+  s7_define_typed_function(sc, "acb_hypgeom_m",          a_hypgeom_m,          4, 0, false, "(acb_hypgeom_m)",       acccii_sig);
+  s7_define_typed_function(sc, "acb_hypgeom_1f1",        a_hypgeom_1f1,        4, 0, false, "(acb_hypgeom_1f1)",     acccii_sig);
+  s7_define_typed_function(sc, "acb_beta_lower",         a_hypgeom_beta_lower, 4, 0, false, "(acb_beta_lower)",      acccii_sig);
+  s7_define_typed_function(sc, "acb_legendre_p",         a_hypgeom_legendre_p, 4, 0, false, "(acb_legendre_p)",      acccii_sig);
+  s7_define_typed_function(sc, "acb_legendre_q",         a_hypgeom_legendre_q, 4, 0, false, "(acb_legendre_q)",      acccii_sig);
+  s7_define_typed_function(sc, "acb_elliptic_rf",        a_elliptic_rf,        4, 0, false, "(acb_elliptic_rf)",     acccii_sig);
+  s7_define_typed_function(sc, "acb_elliptic_rg",        a_elliptic_rg,        4, 0, false, "(acb_elliptic_rg)",     acccii_sig);
+  s7_define_typed_function(sc, "acb_elliptic_pi_inc",    a_elliptic_pi_inc,    4, 0, false, "(acb_elliptic_pi_inc)", acccii_sig);
+
+
+  s7_set_curlet(sc, old_curlet);
+  s7_set_shadow_rootlet(sc, old_shadow);
+}
+
+/* gcc -fPIC -c libarb_s7.c
+ * gcc libarb_s7.o -shared -o libarb_s7.so -lflint -larb
+ *   this is the gmp version of s7
+ * repl
+ *   > (load "libarb_s7.so" (inlet 'init_func 'libarb_s7_init))
+ *   > (acb_bessel_j 0 1.0)
+ *   7.651976865579665514497175261026632209096E-1
+ */
+
+
+#if 0
+;; src_ptr?
+void acb_hypgeom_pfq(acb_t res, acb_srcptr a, slong p, acb_srcptr b, slong q, const acb_t z, int regularized, slong prec);
+
+void acb_hypgeom_airy(acb_t ai, acb_t aip, acb_t bi, acb_t bip, const acb_t z, slong prec);
+void acb_hypgeom_coulomb(acb_t F, acb_t G, acb_t Hpos, acb_t Hneg, const acb_t l, const acb_t eta, const acb_t z, slong prec);
+void acb_hypgeom_fresnel(acb_t res1, acb_t res2, const acb_t z, int normalized, slong prec);
+void acb_hypgeom_bessel_jy(acb_t res1, acb_t res2, const acb_t nu, const acb_t z, slong prec);
+
+void acb_hypgeom_2f1(acb_t res, const acb_t a, const acb_t b, const acb_t c, const acb_t z, int regularized, slong prec);
+void acb_elliptic_rj(acb_t res, const acb_t x, const acb_t y, const acb_t z, const acb_t p, int flags, slong prec);
+
+;; fmpz?
+void acb_lambertw(acb_t res, const acb_t z, const fmpz_t k, int flags, slong prec);
+void acb_quadratic_roots_fmpz(acb_t r1, acb_t r2, const fmpz_t a, const fmpz_t b, const fmpz_t c, slong prec);
+
+void acb_hypgeom_li(acb_t res, const acb_t z, int offset, slong prec);
+
+void acb_chebyshev_t_ui(acb_t a, ulong n, const acb_t x, slong prec);
+void acb_chebyshev_u_ui(acb_t a, ulong n, const acb_t x, slong prec);
+void acb_chebyshev_t2_ui(acb_t a, acb_t b, ulong n, const acb_t x, slong prec);
+void acb_chebyshev_u2_ui(acb_t a, acb_t b, ulong n, const acb_t x, slong prec);
+#endif
diff --git a/s7/libc.scm b/s7/libc.scm
new file mode 100644
index 0000000..7fa8845
--- /dev/null
+++ b/s7/libc.scm
@@ -0,0 +1,1888 @@
+;;; libc.scm
+;;;
+;;; tie the C library into the *libc* environment
+(provide 'libc.scm)
+
+;; if loading from a different directory, pass that info to C
+(let ((directory (let ((current-file (port-filename)))
+		   (and (memv (current-file 0) '(#\/ #\~))
+			(substring current-file 0 (- (length current-file) 9))))))
+  (when (and directory (not (member directory *load-path*)))
+    (set! *load-path* (cons directory *load-path*)))
+  (with-let (rootlet)
+    (require cload.scm))
+  (when (and directory (not (string-position directory *cload-cflags*)))
+    (set! *cload-cflags* (string-append "-I" directory " " *cload-cflags*))))
+
+(unless (defined? '*libc*)
+    (define *libc*
+      (with-let (sublet (unlet))
+
+	(set! *cload-library-name* "*libc*")
+	(set! *libraries* (cons (cons "libc.scm" (curlet)) *libraries*))
+
+	;; -------- stddef.h --------
+	(define NULL (c-pointer 0 'void*))
+	;(define (c-null? p) (and (c-pointer? p) (zero? (car (c-pointer->list p)))))
+
+	;; -------- stdbool.h --------
+	;(define false #f)
+	;(define true #t)
+	;scheme objects like false or c-null in *libc* will not appear in *libc* normally: no s7_define -> shadow_rootlet,
+	;  and this file itself is not loaded except when libc_s7.c is written (when libc_s7.so is out of date)
+
+	;; -------- iso646.h --------
+	;; spelled-out names for & = bitand et al
+
+	;; -------- stdarg.h --------
+	;; the varargs macros
+
+	;; -------- assert.h --------
+	;; assert macro
+#|
+	(define-expansion (assert assertion)
+	  (reader-cond ((not (defined? 'NDEBUG))
+	                `(if (not ,assertion)
+			    (error 'assert-failure "~S[~D]: ~A failed~%"
+				   (port-filename) (port-line-number) ',assertion)))
+	               (#t (values))))
+        (define (hiho a) (assert (> a 2)) (+ a 1))
+|#
+
+	;; -------- setjmp.h --------
+	;; longjmp etc
+
+	;; -------- dlfn.h --------
+	;; see libdl.scm, similarly for pthreads see libpthread.scm
+
+	;; -------- sys/types.h inttypes.h getopt.h--------
+	;; C type declarations
+
+	(c-define
+	 '(;; -------- limits.h --------
+	   (C-macro (int (SCHAR_MIN SCHAR_MAX UCHAR_MAX CHAR_BIT CHAR_MIN CHAR_MAX __WORDSIZE
+			  SHRT_MIN SHRT_MAX USHRT_MAX INT_MIN INT_MAX UINT_MAX LONG_MIN LONG_MAX ULONG_MAX
+			  LLONG_MIN LLONG_MAX ULLONG_MAX
+			  _POSIX_AIO_LISTIO_MAX _POSIX_AIO_MAX _POSIX_ARG_MAX _POSIX_CHILD_MAX _POSIX_DELAYTIMER_MAX _POSIX_HOST_NAME_MAX
+			  _POSIX_LINK_MAX _POSIX_LOGIN_NAME_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT _POSIX_MQ_OPEN_MAX _POSIX_MQ_PRIO_MAX
+			  _POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_OPEN_MAX _POSIX_FD_SETSIZE _POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_RE_DUP_MAX
+			  _POSIX_RTSIG_MAX _POSIX_SEM_NSEMS_MAX _POSIX_SEM_VALUE_MAX _POSIX_SIGQUEUE_MAX _POSIX_SSIZE_MAX _POSIX_STREAM_MAX
+			  _POSIX_SYMLINK_MAX _POSIX_SYMLOOP_MAX _POSIX_TIMER_MAX _POSIX_TTY_NAME_MAX _POSIX_TZNAME_MAX _POSIX_QLIMIT
+			  _POSIX_HIWAT _POSIX_UIO_MAXIOV _POSIX_CLOCKRES_MIN SSIZE_MAX NGROUPS_MAX _POSIX2_BC_BASE_MAX _POSIX2_BC_DIM_MAX
+			  _POSIX2_BC_SCALE_MAX _POSIX2_BC_STRING_MAX _POSIX2_COLL_WEIGHTS_MAX _POSIX2_EXPR_NEST_MAX _POSIX2_LINE_MAX
+			  _POSIX2_RE_DUP_MAX _POSIX2_CHARCLASS_NAME_MAX BC_BASE_MAX BC_DIM_MAX BC_SCALE_MAX BC_STRING_MAX COLL_WEIGHTS_MAX
+			  EXPR_NEST_MAX LINE_MAX CHARCLASS_NAME_MAX RE_DUP_MAX)))
+
+
+	   ;; -------- float.h --------
+	   (C-macro (int (FLT_RADIX FLT_MANT_DIG DBL_MANT_DIG LDBL_MANT_DIG FLT_DIG DBL_DIG LDBL_DIG FLT_MIN_EXP DBL_MIN_EXP
+		          LDBL_MIN_EXP FLT_MIN_10_EXP DBL_MIN_10_EXP LDBL_MIN_10_EXP FLT_MAX_EXP DBL_MAX_EXP LDBL_MAX_EXP
+			  FLT_MAX_10_EXP DBL_MAX_10_EXP LDBL_MAX_10_EXP FLT_ROUNDS FLT_EVAL_METHOD)))
+	   (C-macro (double (FLT_MAX DBL_MAX LDBL_MAX FLT_EPSILON DBL_EPSILON LDBL_EPSILON FLT_MIN DBL_MIN LDBL_MIN)))
+
+
+	   ;; -------- stdint.h --------
+	   (C-macro (int (INT8_MIN INT16_MIN INT32_MIN INT64_MIN INT8_MAX INT16_MAX INT32_MAX INT64_MAX UINT8_MAX UINT16_MAX
+			  UINT32_MAX UINT64_MAX INT_LEAST8_MIN INT_LEAST16_MIN INT_LEAST32_MIN INT_LEAST64_MIN INT_LEAST8_MAX
+			  INT_LEAST16_MAX INT_LEAST32_MAX INT_LEAST64_MAX UINT_LEAST8_MAX UINT_LEAST16_MAX UINT_LEAST32_MAX
+			  UINT_LEAST64_MAX INT_FAST8_MIN INT_FAST16_MIN INT_FAST32_MIN INT_FAST64_MIN INT_FAST8_MAX INT_FAST16_MAX
+			  INT_FAST32_MAX INT_FAST64_MAX UINT_FAST8_MAX UINT_FAST16_MAX UINT_FAST32_MAX UINT_FAST64_MAX INTPTR_MIN
+			  INTPTR_MAX UINTPTR_MAX INTMAX_MIN INTMAX_MAX UINTMAX_MAX PTRDIFF_MIN PTRDIFF_MAX SIG_ATOMIC_MIN SIG_ATOMIC_MAX
+			  SIZE_MAX WCHAR_MIN WCHAR_MAX WINT_MIN WINT_MAX )))
+
+	   (FILE* (stdin stdout stderr))
+
+	   ;; -------- endian.h --------
+	   ;; also has htobe16 etc
+	   (C-macro (int (__BYTE_ORDER __BIG_ENDIAN __LITTLE_ENDIAN)))
+
+
+	   (in-C "
+                  static s7_pointer g_c_pointer_to_string(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_string_with_length(sc, (const char *)s7_c_pointer(s7_car(args)), s7_integer(s7_cadr(args))));}
+                  static s7_pointer g_string_to_c_pointer(s7_scheme *sc, s7_pointer args)
+                  {
+                   if (s7_is_string(s7_car(args)))
+                     return(s7_make_c_pointer_with_type(sc, (void *)s7_string(s7_car(args)), s7_make_symbol(sc, \"void*\"), s7_f(sc)));
+                   return(s7_car(args));
+                  }")
+
+	   (C-function ("c-pointer->string" g_c_pointer_to_string "" 2))
+	   (C-function ("string->c-pointer" g_string_to_c_pointer "" 1))
+
+	   ;; -------- ctype.h --------
+	   (int isalnum (int))
+	   (int isalpha (int))
+	   (int iscntrl (int))
+	   (int isdigit (int))
+	   (int islower (int))
+	   (int isgraph (int))
+	   (int isprint (int))
+	   (int ispunct (int))
+	   (int isspace (int))
+	   (int isupper (int))
+	   (int isxdigit (int))
+	   (int tolower (int))
+	   (int toupper (int))
+
+	   ;; -------- fcntl.h --------
+	   (C-macro (int (S_IFMT S_IFDIR S_IFCHR S_IFBLK S_IFREG S_IFIFO __S_IFLNK S_IFSOCK S_ISUID S_ISGID S_IRUSR
+			  S_IWUSR S_IXUSR S_IRWXU S_IRGRP S_IWGRP S_IXGRP S_IRWXG S_IROTH S_IWOTH S_IXOTH S_IRWXO R_OK W_OK X_OK
+			  F_OK SEEK_SET SEEK_CUR SEEK_END F_ULOCK F_LOCK F_TLOCK F_TEST O_ACCMODE O_RDONLY O_WRONLY O_RDWR O_CREAT
+			  O_EXCL O_NOCTTY O_TRUNC O_APPEND O_NONBLOCK O_NDELAY O_SYNC O_FSYNC O_ASYNC O_DSYNC O_RSYNC O_LARGEFILE
+			  F_DUPFD F_GETFD F_SETFD F_GETFL F_SETFL F_GETLK F_SETLK F_SETLKW F_GETLK64 F_SETLK64 F_SETLKW64
+			  FD_CLOEXEC F_RDLCK F_WRLCK F_UNLCK POSIX_FADV_NORMAL POSIX_FADV_RANDOM POSIX_FADV_SEQUENTIAL
+			  POSIX_FADV_WILLNEED POSIX_FADV_DONTNEED POSIX_FADV_NOREUSE)))
+	   (int fcntl (int int))
+	   (in-C "
+                  static s7_pointer g_c_open(s7_scheme *sc, s7_pointer args)
+                  {
+                    s7_pointer arg;
+                    char* name;
+                    int flags, mode;
+                    arg = args;
+                    if (s7_is_string(s7_car(arg)))
+                       name = (char*)s7_string(s7_car(arg));
+                    else return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libc* 'open)\", 14), 1, s7_car(arg), string_string));
+                    arg = s7_cdr(arg);
+                    if (s7_is_integer(s7_car(arg)))
+                       flags = (int)s7_integer(s7_car(arg));
+                    else return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libc* 'open)\", 14), 2, s7_car(arg), integer_string));
+                    if (s7_is_pair(s7_cdr(arg)))
+                      {
+                        arg = s7_cdr(arg);
+                        if (s7_is_integer(s7_car(arg)))
+                          mode = (int)s7_integer(s7_car(arg));
+                        else return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libc* 'open)\", 14), 3, s7_car(arg), integer_string));
+                        return(s7_make_integer(sc, (s7_int)open(name, flags, mode)));
+                       }
+                     return(s7_make_integer(sc, (s7_int)open(name, flags)));
+                    }")
+	   (C-function ("open" g_c_open "" 2 1))
+	   (int creat (char* (mode_t int)))
+	   (int lockf (int int int))
+	   (reader-cond ((provided? 'linux)
+			 (int posix_fadvise (int int int int))
+			 (int posix_fallocate (int int int))))
+
+
+	   ;; -------- fenv.h --------
+	   (C-macro (int (FE_INEXACT FE_DIVBYZERO FE_UNDERFLOW FE_OVERFLOW FE_INVALID FE_ALL_EXCEPT
+			  FE_TONEAREST FE_UPWARD FE_DOWNWARD FE_TOWARDZERO)))
+	   (int feclearexcept (int))
+	   (int fegetexceptflag (fexcept_t* int))
+	   (int feraiseexcept (int))
+	   (int fesetexceptflag (fexcept_t* int))
+	   (int fetestexcept (int))
+	   (int fegetround (void))
+	   (int fesetround (int))
+	   (int fegetenv (fenv_t*))
+	   (int feholdexcept (fenv_t*))
+	   (int fesetenv (fenv_t*))
+	   (int feupdateenv (fenv_t*))
+	   ;(C-macro (fenv_t* (FE_DFL_ENV)))
+	   (in-C "
+                  static s7_pointer g_fenv_t_make(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(fenv_t)), s7_make_symbol(sc, \"fenv_t*\"), s7_f(sc)));}")
+	   (C-function ("fenv_t.make" g_fenv_t_make "" 0))
+
+
+
+	   ;; -------- fnmatch.h --------
+	   (C-macro (int (FNM_PATHNAME FNM_NOESCAPE FNM_PERIOD FNM_FILE_NAME FNM_LEADING_DIR FNM_CASEFOLD FNM_EXTMATCH FNM_NOMATCH)))
+	   (int fnmatch (char* char* int))
+
+
+	   ;; -------- string.h --------
+	   (void* memcpy (void* void* size_t))
+	   (void* memmove (void* void* size_t))
+	   (void* memset (void* int size_t))
+	   (int memcmp (void* void* size_t))
+	   (void* memchr (void* int size_t))
+	   (char* strcpy (char* char*))
+	   (char* strncpy (char* char* size_t))
+	   (char* strcat (char* char*))
+	   (char* strncat (char* char* size_t))
+	   (int strcmp (char* char*))
+	   (int strncmp (char* char* size_t))
+	   (int strcoll (char* char*))
+	   (size_t strxfrm (char* char* size_t))
+	   (char* strchr (char* int))
+	   (char* strrchr (char* int))
+	   (size_t strcspn (char* char*))
+	   (size_t strspn (char* char*))
+	   (char* strpbrk (char* char*))
+	   (char* strstr (char* char*))
+	   (char* strtok (char* char*))
+	   (size_t strlen (char*))
+	   (reader-cond ((not (provided? 'osx)) (size_t strnlen (char* size_t))))
+	   ;; strnlen is in OSX 10.8, not 10.6
+	   (char* strerror (int))
+	   (int strcasecmp (char* char*))
+	   (int strncasecmp (char* char* size_t))
+
+#|
+	   (reader-cond
+	    ((provided? 'linux)
+	     ;; -------- semaphore.h --------
+	     (int sem_init (sem_t* int int))
+	     (int sem_destroy (sem_t*))
+	     (sem_t* sem_open (char* int int int))
+	     (int sem_close (sem_t*))
+	     (int sem_unlink (char*))
+	     (int sem_wait (sem_t*))
+	     (int sem_post (sem_t*))))
+	   ;; not in clang??
+|#
+
+	   ;; -------- stdio.h --------
+	   (C-macro (int (_IOFBF _IOLBF _IONBF BUFSIZ EOF L_tmpnam TMP_MAX FILENAME_MAX L_ctermid L_cuserid FOPEN_MAX IOV_MAX)))
+	   (C-macro (char* P_tmpdir))
+
+	   (int remove (char*))
+	   (int rename (char* char*))
+	   (FILE* tmpfile (void))
+;	   (reader-cond ((not (provided? 'osx)) (char* tmpnam (char*)) (char* tempnam (char* char*))))
+	   (int fclose (FILE*))
+	   (int fflush (FILE*))
+	   ;;		    (reader-cond ((provided? 'linux) (int fcloseall (void))))
+	   (FILE* fopen (char* char*))
+	   (FILE* freopen (char*  char* FILE*))
+	   (FILE* fdopen (int char*))
+	   (void setbuf (FILE* char*))
+	   (int setvbuf (FILE* char* int size_t))
+	   (void setlinebuf (FILE*))
+	   (int fgetc (FILE*))
+	   (int getc (FILE*))
+	   (int getchar (void))
+	   (int fputc (int FILE*))
+	   (int putc (int FILE*))
+	   (int putchar (int))
+	   (char* fgets (char* int FILE*))
+	   (int fputs (char* FILE*))
+	   (int puts (char*))
+	   (int ungetc (int FILE*))
+	   (size_t fread (void* size_t size_t FILE*))
+	   (size_t fwrite (void* size_t size_t FILE*))
+	   (int fseek (FILE* int int))
+	   (int ftell (FILE*))
+	   (void rewind (FILE*))
+	   (int fgetpos (FILE* fpos_t*))
+	   (int fsetpos (FILE* fpos_t*))
+	   (void clearerr (FILE*))
+	   (int feof (FILE*))
+	   (int ferror (FILE*))
+	   (void perror (char*))
+	   (int fileno (FILE*))
+	   (FILE* popen (char* char*))
+	   (int pclose (FILE*))
+	   (char* ctermid (char*))
+	   ;;		    (reader-cond ((provided? 'linux) (char* cuserid (char*))))
+	   (void flockfile (FILE*))
+	   (int ftrylockfile (FILE*))
+	   (void funlockfile (FILE*))
+	   ;; int fprintf (FILE* char* ...)
+	   ;; int printf (char* ...)
+	   ;; int sprintf (char* char* ...)
+	   ;; int vfprintf (FILE* char* va_list)
+	   ;; int vprintf (char* va_list)
+	   ;; int vsprintf (char* char* va_list)
+	   ;; int snprintf (char* size_t char* ...)
+	   ;; int vsnprintf (char* size_t char* va_list)
+	   ;; int vasprintf (char** char* va_list)
+	   ;; int asprintf (char** char* ...)
+	   ;; int fscanf (FILE* char* ...)
+	   ;; int scanf (char* ...)
+	   ;; int sscanf (char* char* ...)
+	   ;; int vfscanf (FILE* char* va_list)
+	   ;; int vscanf (char* va_list)
+	   ;; int vsscanf (char* char* va_list)
+
+
+	   ;; -------- stdlib.h --------
+	   (C-macro (int (RAND_MAX EXIT_FAILURE EXIT_SUCCESS MB_CUR_MAX)))
+	   (double atof (char*))
+	   (int atoi (char*))
+	   (int atol (char*))
+	   (int atoll (char*))
+	   (int random (void))
+	   (void srandom (int))
+	   (char* initstate (int char* size_t))
+	   (char* setstate (char*))
+	   (int rand (void))
+	   (void srand (int))
+	   (void* malloc (size_t))
+	   (void* calloc (size_t size_t))
+	   (void* realloc (void* size_t))
+;	   (void free (void*))
+	   (void abort (void))
+	   (void exit (int))
+	   (char* getenv (char*))
+	   (int putenv (char*))
+	   (int setenv (char* char* int))
+	   (int unsetenv (char*))
+;	   (char* mktemp (char*))
+	   (int mkstemp (char*))
+	   (int system (char*))
+;	   (char* realpath (char* char*))
+	   (int abs (int))
+	   (int labs (int))
+
+	   (in-C "
+                  static s7_pointer g_llabs(s7_scheme *sc, s7_pointer args)
+                  {
+                  #if  ((__GNUC__) && ((__GNUC__ < 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ < 4))))
+                    return(s7_make_integer(sc, labs(s7_integer(s7_car(args)))));
+                  #else
+                    return(s7_make_integer(sc, llabs(s7_integer(s7_car(args)))));
+                  #endif
+                  }
+                 static s7_pointer g_realpath(s7_scheme *sc, s7_pointer args)
+                  {
+                    char *s7_dl_realpath_0, *res;
+                    if (s7_is_string(s7_car(args)))
+                       s7_dl_realpath_0 = (char*)s7_string(s7_car(args));
+                    else return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libc* 'realpath)\", 18), 1, s7_car(args), string_string));
+                    res = realpath(s7_dl_realpath_0, NULL);
+                    if (res) {s7_pointer str; str = s7_make_string(sc, res); free(res); return(str);}
+                    return(s7_f(sc));
+                 }
+                 static s7_pointer g_free(s7_scheme *sc, s7_pointer args)
+                 {free(s7_c_pointer(s7_car(args))); return(s7_f(sc));}
+                 static s7_pointer g_strtod(s7_scheme *sc, s7_pointer args)
+                 {return(s7_make_real(sc, strtod(s7_string(s7_car(args)), NULL)));}
+                 static s7_pointer g_strtof(s7_scheme *sc, s7_pointer args)
+                 {return(s7_make_real(sc, strtof(s7_string(s7_car(args)), NULL)));}
+                 static s7_pointer g_strtol(s7_scheme *sc, s7_pointer args)
+                 {return(s7_make_integer(sc, strtol(s7_string(s7_car(args)), NULL, s7_integer(s7_cadr(args)))));}
+                 static s7_pointer g_strtoll(s7_scheme *sc, s7_pointer args)
+                 {return(s7_make_integer(sc, strtoll(s7_string(s7_car(args)), NULL, s7_integer(s7_cadr(args)))));}
+                 static s7_pointer g_ldiv(s7_scheme *sc, s7_pointer args)
+                 {
+                   ldiv_t d;
+                   if (!s7_is_integer(s7_car(args))) return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libc* 'ldiv)\", 14), 1, s7_car(args), integer_string));
+                   if (!s7_is_integer(s7_cadr(args))) return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libc* 'ldiv)\", 14), 2, s7_cadr(args), integer_string));
+                   d = ldiv(s7_integer(s7_car(args)), s7_integer(s7_cadr(args)));
+                   return(s7_list(sc, 2, s7_make_integer(sc, d.quot), s7_make_integer(sc, d.rem)));
+                 }
+                  ")
+	   (C-function ("llabs" g_llabs "" 1))
+	   (C-function ("free" g_free "" 1))
+	   (C-function ("strtod" g_strtod "" 1))
+	   (C-function ("strtof" g_strtof "" 1))
+	   (C-function ("strtol" g_strtol "" 2))
+	   (C-function ("strtoll" g_strtoll "" 2))
+	   (C-function ("div" g_ldiv "" 2))
+	   (C-function ("ldiv" g_ldiv "" 2))
+	   (C-function ("realpath" g_realpath "" 2))
+
+
+	   ;; -------- errno.h --------
+	   ;; pws for errno?
+	   (C-macro (int (__GLIBC__ __GLIBC_MINOR__ ; features.h from errno.h
+			  ECANCELED EOWNERDEAD ENOTRECOVERABLE ERFKILL EILSEQ
+			  ;; asm-generic/errno-base.h
+			  EPERM ENOENT ESRCH EINTR EIO ENXIO E2BIG ENOEXEC EBADF ECHILD EAGAIN ENOMEM EACCES EFAULT
+			  ENOTBLK EBUSY EEXIST EXDEV ENODEV ENOTDIR EISDIR EINVAL ENFILE EMFILE ENOTTY ETXTBSY EFBIG
+			  ENOSPC ESPIPE EROFS EMLINK EPIPE EDOM ERANGE
+			  )))
+	   (in-C "
+                  static s7_pointer g_errno(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, errno));}
+                  static s7_pointer g_set_errno(s7_scheme *sc, s7_pointer args) {errno = (int)s7_integer(s7_car(args)); return(s7_car(args));}")
+	   (C-function ("errno" g_errno "" 0))
+	   (C-function ("set_errno" g_set_errno "" 1))
+
+
+	   ;; -------- locale.h --------
+	   (C-macro (int (LC_CTYPE LC_NUMERIC LC_TIME LC_COLLATE LC_MONETARY LC_MESSAGES LC_ALL LC_PAPER LC_NAME
+			  LC_ADDRESS LC_TELEPHONE LC_MEASUREMENT LC_IDENTIFICATION)))
+	   (char* setlocale (int char*))
+	   (in-C "
+             static s7_pointer g_localeconv(s7_scheme *sc, s7_pointer args)
+             {
+               struct lconv *lc;
+               lc = localeconv();
+               return(s7_inlet(sc, s7_list(sc, 36,
+             		     s7_make_symbol(sc, \"decimal_point\"),     s7_make_string(sc, lc->decimal_point),
+             		     s7_make_symbol(sc, \"thousands_sep\"),     s7_make_string(sc, lc->thousands_sep),
+             		     s7_make_symbol(sc, \"grouping\"),          s7_make_string(sc, lc->grouping),
+             		     s7_make_symbol(sc, \"int_curr_symbol\"),   s7_make_string(sc, lc->int_curr_symbol),
+             		     s7_make_symbol(sc, \"currency_symbol\"),   s7_make_string(sc, lc->currency_symbol),
+             		     s7_make_symbol(sc, \"mon_decimal_point\"), s7_make_string(sc, lc->mon_decimal_point),
+             		     s7_make_symbol(sc, \"mon_thousands_sep\"), s7_make_string(sc, lc->mon_thousands_sep),
+             		     s7_make_symbol(sc, \"mon_grouping\"),      s7_make_string(sc, lc->mon_grouping),
+             		     s7_make_symbol(sc, \"positive_sign\"),     s7_make_string(sc, lc->positive_sign),
+             		     s7_make_symbol(sc, \"negative_sign\"),     s7_make_string(sc, lc->negative_sign),
+
+             		     s7_make_symbol(sc, \"int_frac_digits\"),   s7_make_integer(sc, lc->int_frac_digits),
+             		     s7_make_symbol(sc, \"frac_digits\"),       s7_make_integer(sc, lc->frac_digits),
+             		     s7_make_symbol(sc, \"p_cs_precedes\"),     s7_make_integer(sc, lc->p_cs_precedes),
+             		     s7_make_symbol(sc, \"p_sep_by_space\"),    s7_make_integer(sc, lc->p_sep_by_space),
+             		     s7_make_symbol(sc, \"n_cs_precedes\"),     s7_make_integer(sc, lc->n_cs_precedes),
+             		     s7_make_symbol(sc, \"n_sep_by_space\"),    s7_make_integer(sc, lc->n_sep_by_space),
+             		     s7_make_symbol(sc, \"p_sign_posn\"),       s7_make_integer(sc, lc->p_sign_posn),
+             		     s7_make_symbol(sc, \"n_sign_posn\"),       s7_make_integer(sc, lc->n_sign_posn))));
+              }")
+	   (C-function ("localeconv" g_localeconv "" 0))
+
+
+	   ;; -------- sys/utsname.h --------
+	   (in-C "
+             static s7_pointer g_uname(s7_scheme *sc, s7_pointer args)
+             {
+               struct utsname buf;
+               uname(&buf);
+               return(s7_list(sc, 5, s7_make_string(sc, buf.sysname),
+             		        s7_make_string(sc, buf.machine),
+             		        s7_make_string(sc, buf.nodename),
+             		        s7_make_string(sc, buf.version),
+             		        s7_make_string(sc, buf.release)));
+             }")
+	   (C-function ("uname" g_uname "" 0))
+
+
+	   ;; -------- unistd.h --------
+	   (C-macro (int (_POSIX_VERSION _POSIX2_VERSION _POSIX_JOB_CONTROL _POSIX_SAVED_IDS _POSIX_PRIORITY_SCHEDULING _POSIX_SYNCHRONIZED_IO
+			  _POSIX_FSYNC _POSIX_MAPPED_FILES _POSIX_MEMLOCK _POSIX_MEMLOCK_RANGE _POSIX_MEMORY_PROTECTION _POSIX_CHOWN_RESTRICTED
+			  _POSIX_VDISABLE _POSIX_NO_TRUNC _POSIX_THREADS _POSIX_REENTRANT_FUNCTIONS _POSIX_THREAD_SAFE_FUNCTIONS
+			  _POSIX_THREAD_PRIORITY_SCHEDULING _POSIX_THREAD_ATTR_STACKSIZE _POSIX_THREAD_ATTR_STACKADDR _POSIX_THREAD_PRIO_INHERIT
+			  _POSIX_THREAD_PRIO_PROTECT _POSIX_SEMAPHORES _POSIX_REALTIME_SIGNALS _POSIX_ASYNCHRONOUS_IO _POSIX_ASYNC_IO
+			  _POSIX_PRIORITIZED_IO _POSIX_SHARED_MEMORY_OBJECTS _POSIX_CPUTIME _POSIX_THREAD_CPUTIME _POSIX_REGEXP
+			  _POSIX_READER_WRITER_LOCKS _POSIX_SHELL _POSIX_TIMEOUTS _POSIX_SPIN_LOCKS _POSIX_SPAWN _POSIX_TIMERS
+			  _POSIX_BARRIERS _POSIX_MESSAGE_PASSING _POSIX_THREAD_PROCESS_SHARED _POSIX_MONOTONIC_CLOCK _POSIX_CLOCK_SELECTION
+			  _POSIX_ADVISORY_INFO _POSIX_IPV6 _POSIX_RAW_SOCKETS _POSIX2_CHAR_TERM _POSIX_SPORADIC_SERVER _POSIX_THREAD_SPORADIC_SERVER
+			  _POSIX_TRACE _POSIX_TRACE_EVENT_FILTER _POSIX_TRACE_INHERIT _POSIX_TRACE_LOG _POSIX_TYPED_MEMORY_OBJECTS
+			  STDIN_FILENO STDOUT_FILENO STDERR_FILENO)))
+
+	   (C-macro
+	    (int (_PC_LINK_MAX _PC_MAX_CANON _PC_MAX_INPUT _PC_NAME_MAX _PC_PATH_MAX _PC_PIPE_BUF _PC_CHOWN_RESTRICTED _PC_NO_TRUNC
+		  _PC_VDISABLE _PC_SYNC_IO _PC_ASYNC_IO _PC_PRIO_IO _PC_SOCK_MAXBUF _PC_FILESIZEBITS _PC_REC_INCR_XFER_SIZE _PC_REC_MAX_XFER_SIZE
+		  _PC_REC_MIN_XFER_SIZE _PC_REC_XFER_ALIGN _PC_ALLOC_SIZE_MIN _PC_SYMLINK_MAX _PC_2_SYMLINKS _SC_ARG_MAX _SC_CHILD_MAX _SC_CLK_TCK
+		  _SC_NGROUPS_MAX _SC_OPEN_MAX _SC_STREAM_MAX _SC_TZNAME_MAX _SC_JOB_CONTROL _SC_SAVED_IDS _SC_REALTIME_SIGNALS _SC_PRIORITY_SCHEDULING
+		  _SC_TIMERS _SC_ASYNCHRONOUS_IO _SC_PRIORITIZED_IO _SC_SYNCHRONIZED_IO _SC_FSYNC _SC_MAPPED_FILES _SC_MEMLOCK _SC_MEMLOCK_RANGE
+		  _SC_MEMORY_PROTECTION _SC_MESSAGE_PASSING _SC_SEMAPHORES _SC_SHARED_MEMORY_OBJECTS _SC_AIO_LISTIO_MAX _SC_AIO_MAX _SC_AIO_PRIO_DELTA_MAX
+		  _SC_DELAYTIMER_MAX _SC_MQ_OPEN_MAX _SC_MQ_PRIO_MAX _SC_VERSION _SC_PAGESIZE _SC_PAGE_SIZE _SC_RTSIG_MAX _SC_SEM_NSEMS_MAX _SC_SEM_VALUE_MAX
+		  _SC_SIGQUEUE_MAX _SC_TIMER_MAX _SC_BC_BASE_MAX _SC_BC_DIM_MAX _SC_BC_SCALE_MAX _SC_BC_STRING_MAX _SC_COLL_WEIGHTS_MAX _SC_EQUIV_CLASS_MAX
+		  _SC_EXPR_NEST_MAX _SC_LINE_MAX _SC_RE_DUP_MAX _SC_CHARCLASS_NAME_MAX _SC_2_VERSION _SC_2_C_BIND _SC_2_C_DEV _SC_2_FORT_DEV _SC_2_FORT_RUN
+		  _SC_2_SW_DEV _SC_2_LOCALEDEF _SC_PII _SC_PII_XTI _SC_PII_SOCKET _SC_PII_INTERNET _SC_PII_OSI _SC_POLL _SC_SELECT _SC_UIO_MAXIOV
+		  _SC_IOV_MAX _SC_PII_INTERNET_STREAM _SC_PII_INTERNET_DGRAM _SC_PII_OSI_COTS _SC_PII_OSI_CLTS _SC_PII_OSI_M _SC_T_IOV_MAX _SC_THREADS
+		  _SC_THREAD_SAFE_FUNCTIONS _SC_GETGR_R_SIZE_MAX _SC_GETPW_R_SIZE_MAX _SC_LOGIN_NAME_MAX _SC_TTY_NAME_MAX _SC_THREAD_DESTRUCTOR_ITERATIONS
+		  _SC_THREAD_KEYS_MAX _SC_THREAD_STACK_MIN _SC_THREAD_THREADS_MAX _SC_THREAD_ATTR_STACKADDR _SC_THREAD_ATTR_STACKSIZE
+		  _SC_THREAD_PRIO_INHERIT _SC_THREAD_PRIO_PROTECT _SC_THREAD_PROCESS_SHARED _SC_NPROCESSORS_CONF _SC_NPROCESSORS_ONLN _SC_PHYS_PAGES
+		  _SC_AVPHYS_PAGES _SC_ATEXIT_MAX _SC_PASS_MAX _SC_2_CHAR_TERM _SC_2_C_VERSION _SC_2_UPE _SC_CHAR_BIT _SC_CHAR_MAX _SC_CHAR_MIN _SC_INT_MAX
+		  _SC_INT_MIN _SC_LONG_BIT _SC_WORD_BIT _SC_MB_LEN_MAX _SC_NZERO _SC_SSIZE_MAX _SC_SCHAR_MAX _SC_SCHAR_MIN _SC_SHRT_MAX _SC_SHRT_MIN
+		  _SC_UCHAR_MAX _SC_UINT_MAX _SC_ULONG_MAX _SC_USHRT_MAX _SC_NL_ARGMAX _SC_NL_LANGMAX _SC_NL_MSGMAX _SC_NL_NMAX _SC_NL_SETMAX
+		  _SC_NL_TEXTMAX _SC_ADVISORY_INFO _SC_BARRIERS _SC_BASE _SC_C_LANG_SUPPORT _SC_C_LANG_SUPPORT_R _SC_CLOCK_SELECTION _SC_CPUTIME
+		  _SC_THREAD_CPUTIME _SC_DEVICE_IO _SC_DEVICE_SPECIFIC _SC_DEVICE_SPECIFIC_R _SC_FD_MGMT _SC_FIFO _SC_PIPE _SC_FILE_ATTRIBUTES
+		  _SC_FILE_LOCKING _SC_FILE_SYSTEM _SC_MONOTONIC_CLOCK _SC_MULTI_PROCESS _SC_SINGLE_PROCESS _SC_NETWORKING _SC_READER_WRITER_LOCKS
+		  _SC_SPIN_LOCKS _SC_REGEXP _SC_REGEX_VERSION _SC_SHELL _SC_SIGNALS _SC_SPAWN _SC_SPORADIC_SERVER _SC_THREAD_SPORADIC_SERVER
+		  _SC_SYSTEM_DATABASE _SC_SYSTEM_DATABASE_R _SC_TIMEOUTS _SC_TYPED_MEMORY_OBJECTS _SC_USER_GROUPS _SC_USER_GROUPS_R
+		  _SC_2_PBS _SC_2_PBS_ACCOUNTING _SC_2_PBS_LOCATE _SC_2_PBS_MESSAGE _SC_2_PBS_TRACK _SC_SYMLOOP_MAX _SC_STREAMS _SC_2_PBS_CHECKPOINT
+		  _SC_HOST_NAME_MAX _SC_TRACE _SC_TRACE_EVENT_FILTER _SC_TRACE_INHERIT _SC_TRACE_LOG _SC_LEVEL1_ICACHE_SIZE _SC_LEVEL1_ICACHE_ASSOC
+		  _SC_LEVEL1_ICACHE_LINESIZE _SC_LEVEL1_DCACHE_SIZE _SC_LEVEL1_DCACHE_ASSOC _SC_LEVEL1_DCACHE_LINESIZE _SC_LEVEL2_CACHE_SIZE
+		  _SC_LEVEL2_CACHE_LINESIZE _SC_LEVEL3_CACHE_SIZE _SC_LEVEL3_CACHE_ASSOC _SC_LEVEL3_CACHE_LINESIZE _SC_LEVEL4_CACHE_SIZE
+		  _SC_LEVEL4_CACHE_LINESIZE _SC_IPV6 _SC_RAW_SOCKETS _SC_SS_REPL_MAX _SC_TRACE_EVENT_NAME_MAX _SC_TRACE_NAME_MAX _SC_TRACE_SYS_MAX
+		  _SC_TRACE_USER_EVENT_MAX _SC_THREAD_ROBUST_PRIO_INHERIT _SC_THREAD_ROBUST_PRIO_PROTECT _CS_PATH _CS_GNU_LIBC_VERSION
+		  _SC_THREAD_PRIORITY_SCHEDULING _SC_LEVEL2_CACHE_ASSOC _SC_LEVEL4_CACHE_ASSOC _CS_GNU_LIBPTHREAD_VERSION)))
+
+	   (int access (char* int))
+	   (int lseek (int int int))
+	   (int close (int))
+	   (ssize_t read (int void* size_t))
+	   (ssize_t write (int void* size_t))
+	   (ssize_t pread (int void* size_t int))
+	   (ssize_t pwrite (int void* size_t int))
+	   (int pipe (int*))
+	   (int alarm (int))
+	   (int sleep (int))
+	   (int pause (void))
+	   (int chown (char* int int))
+	   (int chdir (char*))
+	   (char* getcwd (char* size_t))
+	   ;; (deprecated) (char* getwd (char*))
+	   (int dup (int))
+	   (int dup2 (int int))
+	   (void _exit (int))
+	   (int pathconf (char* int))
+	   (int fpathconf (int int))
+	   (int sysconf (int))
+	   (size_t confstr (int char* size_t))
+	   (int getpid (void))
+	   (int getppid (void))
+	   (int getpgid (int))
+	   (int setpgid (int int))
+	   (int setsid (void))
+	   (int getsid (int))
+	   (int getuid (void))
+	   (int geteuid (void))
+	   (int getgid (void))
+	   (int getegid (void))
+	   (int setuid (int))
+	   (int setgid (int))
+	   (int fork (void))
+	   (char* ttyname (int))
+	   (int isatty (int))
+	   (int link (char* char*))
+	   (int unlink (char*))
+	   (int rmdir (char*))
+	   (int tcgetpgrp (int))
+	   (int tcsetpgrp (int int))
+	   (char* getlogin (void))
+	   (int truncate (char* int))
+	   (int ftruncate (int int))
+
+	   (in-C "
+                  extern char **environ;
+                  static s7_pointer getenvs(s7_scheme *sc, s7_pointer args)
+                  {
+                    s7_pointer p;
+                    int i;
+                    p = s7_nil(sc);
+                    for (i = 0; environ[i]; i++)
+                      {
+                       const char *eq;
+                       s7_pointer name, value;
+                       eq = strchr((const char *)environ[i], (int)'=');
+                       name = s7_make_string_with_length(sc, environ[i], eq - environ[i]);
+                       value = s7_make_string(sc, (char *)(eq + 1));
+                       p = s7_cons(sc, s7_cons(sc, name, value), p);
+                      }
+                    return(p);
+           }
+                  static s7_pointer g_getgroups(s7_scheme *sc, s7_pointer args)
+                  {
+                    gid_t *gds;
+                    int i, size, res;
+                    s7_pointer lst;
+                    size = s7_integer(s7_car(args));
+                    if (size == 0)
+                      return(s7_make_integer(sc, getgroups(0, NULL)));
+                    gds = (gid_t *)calloc(size, sizeof(gid_t));
+                    res = getgroups(size, gds);
+                    if (res != -1)
+                      {
+                        lst = s7_nil(sc);
+                        for (i = 0; i < size; i++)
+                          lst = s7_cons(sc, s7_make_integer(sc, gds[i]), lst);
+                      }
+                    else lst = s7_make_integer(sc, -1);
+                    free(gds);
+                    return(lst);
+                  }
+                  ")
+	   (C-function ("getenvs" getenvs "(getenvs) returns all the environment variables in an alist" 0))
+	   (C-function ("getgroups" g_getgroups "" 1))
+
+	   ;; perhaps call these as (define* n (path ...) = args? and use execve for all?
+	   ;;   but are these useful in this context?  How is fork used here?
+	   ;; int execve (char* path  char* argv[]  char* envp[])
+	   ;; int execv (char* path  char* argv[])
+	   ;; int execle (char* path  char* arg  ...)
+	   ;; int execl (char* path  char* arg  ...)
+	   ;; int execvp (char* file  char* argv[])
+	   ;; int execlp (char* file  char* arg  ...)
+
+
+	   ;; -------- dirent.h --------
+	   (DIR* opendir (char*))
+	   (int closedir (DIR*))
+	   (void rewinddir (DIR*))
+	   (in-C "
+                  static char *read_dir(DIR *p)
+                           {
+                             struct dirent *dirp;
+                             dirp = readdir(p);
+                             if (!dirp) return(NULL);
+                             else return(dirp->d_name);
+                           }")
+	   (char* read_dir (DIR*))
+	   ;; int scandir (char* dirent*** func func)
+	   ;; int alphasort (dirent** dirent**)
+
+
+	   ;; -------- ftw.h --------
+	   (C-macro (int (FTW_F FTW_D FTW_DNR FTW_NS)))
+	   (in-C "
+                  static s7_scheme *internal_ftw_sc = NULL;
+                  static s7_pointer internal_ftw_closure = NULL, internal_ftw_arglist = NULL;
+
+                  static int internal_ftw_function(const char *fpath, const struct stat *sb, int typeflag)
+                  {
+                    s7_list_set(internal_ftw_sc, internal_ftw_arglist, 0, s7_make_string(internal_ftw_sc, fpath));
+                    s7_list_set(internal_ftw_sc, internal_ftw_arglist, 1,
+                                s7_make_c_pointer_with_type(internal_ftw_sc, (void *)sb,  /* need cast due to const */
+                                                            s7_make_symbol(internal_ftw_sc, \"stat*\"), s7_f(internal_ftw_sc)));
+                    s7_list_set(internal_ftw_sc, internal_ftw_arglist, 2, s7_make_integer(internal_ftw_sc, typeflag));
+                    return((int)s7_integer(s7_call(internal_ftw_sc, internal_ftw_closure, internal_ftw_arglist)));
+                  }
+
+                  static s7_pointer g_ftw(s7_scheme *sc, s7_pointer args)
+                  {
+                    /* ftw(file-name, function(path, stat, type), nopenfd=max open dirs) */
+                    internal_ftw_sc = sc;
+                    internal_ftw_arglist = s7_list(sc, 3, s7_nil(sc), s7_nil(sc), s7_nil(sc));
+                    s7_gc_protect_via_stack(sc, internal_ftw_arglist);
+                    internal_ftw_closure = s7_cadr(args);
+                    return(s7_make_integer(sc, ftw(s7_string(s7_car(args)), internal_ftw_function, s7_integer(s7_caddr(args)))));
+                  }")
+	   (C-function ("ftw" g_ftw "" 3))
+
+
+	   ;; -------- sys/stat.h --------
+	   (C-macro (int S_IFLNK))
+
+	   (in-C "
+                  static s7_pointer g_stat(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_integer(sc, stat(s7_string(s7_car(args)),
+                                                     (struct stat *)s7_c_pointer_with_type(sc, s7_cadr(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))));}
+                  static s7_pointer g_fstat(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_integer(sc, fstat(s7_integer(s7_car(args)),
+                                                      (struct stat *)s7_c_pointer_with_type(sc, s7_cadr(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))));}
+                  static s7_pointer g_lstat(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_integer(sc, lstat(s7_string(s7_car(args)),
+                                                (struct stat *)s7_c_pointer_with_type(sc, s7_cadr(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))));}
+                  ")
+	   (C-function ("stat" g_stat "" 2))
+	   (C-function ("fstat" g_fstat "" 2))
+	   (C-function ("lstat" g_lstat "" 2))
+
+	   (int chmod (char* int))
+	   (int mkdir (char* int))
+	   (int mknod (char* int int))
+	   (int mkfifo (char* int))
+
+	   (in-C "
+                  static s7_pointer g_isdir(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_boolean(sc, S_ISDIR(s7_integer(s7_car(args)))));}
+                  static s7_pointer g_ischr(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_boolean(sc, S_ISCHR(s7_integer(s7_car(args)))));}
+                  static s7_pointer g_isblk(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_boolean(sc, S_ISBLK(s7_integer(s7_car(args)))));}
+                  static s7_pointer g_isreg(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_boolean(sc, S_ISREG(s7_integer(s7_car(args)))));}
+                  static s7_pointer g_isfifo(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_boolean(sc, S_ISFIFO(s7_integer(s7_car(args)))));}
+                  static s7_pointer g_islnk(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_boolean(sc, S_ISLNK(s7_integer(s7_car(args)))));}
+                  static s7_pointer g_issock(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_boolean(sc, S_ISSOCK(s7_integer(s7_car(args)))));}
+                  static s7_pointer g_st_dev(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_dev));}
+                  static s7_pointer g_st_ino(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_ino));}
+                  static s7_pointer g_st_mode(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_mode));}
+                  static s7_pointer g_st_nlink(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_nlink));}
+                  static s7_pointer g_st_uid(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_uid));}
+                  static s7_pointer g_st_gid(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_gid));}
+                  static s7_pointer g_st_rdev(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_rdev));}
+                  static s7_pointer g_st_size(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_size));}
+                  static s7_pointer g_st_blksize(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_blksize));}
+                  static s7_pointer g_st_blocks(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_blocks));}
+                  static s7_pointer g_st_atime(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_atime));}
+                  static s7_pointer g_st_mtime(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_mtime));}
+                  static s7_pointer g_st_ctime(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_ctime));}
+                  static s7_pointer g_stat_make(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(struct stat)), s7_make_symbol(sc, \"stat*\"), s7_f(sc)));}
+                  static s7_pointer g_stat_free(s7_scheme *sc, s7_pointer args) {free(s7_c_pointer(s7_car(args))); return(s7_f(sc));}
+                  ")
+
+	   (C-function ("S_ISDIR" g_isdir "" 1))
+	   (C-function ("S_ISCHR" g_ischr "" 1))
+	   (C-function ("S_ISBLK" g_isblk "" 1))
+	   (C-function ("S_ISREG" g_isreg "" 1))
+	   (C-function ("S_ISFIFO" g_isfifo "" 1))
+	   (C-function ("S_ISLNK" g_islnk "" 1))
+	   (C-function ("S_ISSOCK" g_issock "" 1))
+
+	   (C-function ("stat.st_dev" g_st_dev "" 1))
+	   (C-function ("stat.st_ino" g_st_ino "" 1))
+	   (C-function ("stat.st_mode" g_st_mode "" 1))
+	   (C-function ("stat.st_nlink" g_st_nlink "" 1))
+	   (C-function ("stat.st_uid" g_st_uid "" 1))
+	   (C-function ("stat.st_gid" g_st_gid "" 1))
+	   (C-function ("stat.st_rdev" g_st_rdev "" 1))
+	   (C-function ("stat.st_size" g_st_size "" 1))
+	   (C-function ("stat.st_blksize" g_st_blksize "" 1))
+	   (C-function ("stat.st_blocks" g_st_blocks "" 1))
+	   (C-function ("stat.st_atime" g_st_atime "" 1))
+	   (C-function ("stat.st_mtime" g_st_mtime "" 1))
+	   (C-function ("stat.st_ctime" g_st_ctime "" 1))
+	   (C-function ("stat.free" g_stat_free "" 1))
+	   (C-function ("stat.make" g_stat_make "" 0))
+
+
+	   ;; -------- time.h sys/time.h --------
+	   (C-macro (int (CLOCKS_PER_SEC CLOCK_REALTIME CLOCK_MONOTONIC CLOCK_PROCESS_CPUTIME_ID CLOCK_THREAD_CPUTIME_ID
+			  CLOCK_MONOTONIC_RAW CLOCK_REALTIME_COARSE CLOCK_MONOTONIC_COARSE))) ; also CLOCK_TAI in linux
+	   (int clock (void))
+
+	   (int time (time_t*))
+	   (double difftime ((time_t integer) (time_t integer)))
+	   (tm* gmtime (time_t*))
+	   (char* ctime (time_t*))
+	   (tm* localtime (time_t*))
+
+	   (in-C "
+                  static s7_pointer g_mktime(s7_scheme *sc, s7_pointer args)
+                  {
+                    return(s7_make_integer(sc, (s7_int)mktime((struct tm *)s7_c_pointer(s7_car(args)))));
+                  }
+                  static s7_pointer g_time_make(s7_scheme *sc, s7_pointer args)
+                  {
+                    time_t *tm;
+                    tm = (time_t *)calloc(1, sizeof(time_t));
+                    (*tm) = (time_t)s7_integer(s7_car(args));
+                    return(s7_make_c_pointer_with_type(sc, (void *)tm, s7_make_symbol(sc, \"time_t*\"), s7_f(sc)));
+                  }
+                  static s7_pointer g_time_free(s7_scheme *sc, s7_pointer args) {free(s7_c_pointer(s7_car(args))); return(s7_f(sc));}
+                  static s7_pointer g_strftime(s7_scheme *sc, s7_pointer args)
+                  {
+                    return(s7_make_integer(sc, (s7_int)strftime((char *)s7_string(s7_car(args)),
+                  				             (size_t)s7_integer(s7_cadr(args)),
+                  					     s7_string(s7_caddr(args)),
+                  					     (const struct tm *)s7_c_pointer(s7_cadddr(args)))));
+                  }
+                  static s7_pointer g_gettimeofday(s7_scheme *sc, s7_pointer args)
+                  {
+                    struct timeval t0;
+                    gettimeofday(&t0, NULL);
+                    return(s7_list(sc, 2, s7_make_integer(sc, t0.tv_sec), s7_make_integer(sc, t0.tv_usec)));
+                  }
+                  static s7_pointer g_nanosleep(s7_scheme *sc, s7_pointer args)
+                  {
+                    struct timespec t0;
+                    t0.tv_sec = (time_t)s7_integer(s7_car(args));
+                    t0.tv_nsec = (long)s7_integer(s7_cadr(args));
+                    return(s7_make_integer(sc, nanosleep(&t0, NULL)));
+                  }
+                  static s7_pointer g_clock_getres(s7_scheme *sc, s7_pointer args)
+                  {
+                    #if (!__APPLE__)
+                    struct timespec t0;
+                    int res;
+                    res = clock_getres(s7_integer(s7_car(args)), &t0);
+                    return(s7_list(sc, 3, s7_make_integer(sc, res), s7_make_integer(sc, t0.tv_sec), s7_make_integer(sc, t0.tv_nsec)));
+                    #else
+                    return(s7_make_integer(sc, -1));
+                    #endif
+                  }
+                  static s7_pointer g_clock_gettime(s7_scheme *sc, s7_pointer args)
+                  {
+                    #if (!__APPLE__)
+                    struct timespec t0;
+                    int res;
+                    res = clock_gettime(s7_integer(s7_car(args)), &t0);
+                    return(s7_list(sc, 3, s7_make_integer(sc, res), s7_make_integer(sc, t0.tv_sec), s7_make_integer(sc, t0.tv_nsec)));
+                    #else
+                    return(s7_make_integer(sc, -1));
+                    #endif
+                  }
+                  static s7_pointer g_clock_settime(s7_scheme *sc, s7_pointer args)
+                  {
+                    #if (!__APPLE__)
+                    struct timespec t0;
+                    t0.tv_sec = (time_t)s7_integer(s7_cadr(args));
+                    t0.tv_nsec = (long)s7_integer(s7_caddr(args));
+                    return(s7_make_integer(sc, clock_settime(s7_integer(s7_car(args)), &t0)));
+                    #else
+                    return(s7_make_integer(sc, -1));
+                    #endif
+                  }
+                  static s7_pointer g_clock_getcpuclockid(s7_scheme *sc, s7_pointer args)
+                  {
+                    #if __linux__
+                    clockid_t c = 0;
+                    clock_getcpuclockid((pid_t)s7_integer(s7_car(args)), &c);
+                    return(s7_make_integer(sc, (s7_int)c));
+                    #else
+                    return(s7_make_integer(sc, -1));
+                    #endif
+                  }
+                  static s7_pointer g_clock_nanosleep(s7_scheme *sc, s7_pointer args)
+                  {
+                    #if __linux__
+                    struct timespec t0;
+                    t0.tv_sec = (time_t)s7_integer(s7_caddr(args));
+                    t0.tv_nsec = (long)s7_integer(s7_cadddr(args));
+                    return(s7_make_integer(sc, clock_nanosleep((clockid_t)s7_integer(s7_car(args)), (int)s7_integer(s7_cadr(args)), &t0, NULL)));
+                    #else
+                    return(s7_make_integer(sc, -1));
+                    #endif
+                  }
+                  ")
+	   (C-function ("time.make" g_time_make "" 1))
+	   (C-function ("time.free" g_time_free "" 1))
+	   (C-function ("mktime" g_mktime "" 1))
+	   (C-function ("strftime" g_strftime "" 4))
+	   (C-function ("gettimeofday" g_gettimeofday "" 0))
+	   (C-function ("nanosleep" g_nanosleep "" 2))
+	   (C-function ("clock_getres" g_clock_getres "" 1))
+	   (C-function ("clock_gettime" g_clock_gettime "" 1)) ; these need -lrt
+	   (C-function ("clock_settime" g_clock_settime "" 3))
+	   (reader-cond ((not (provided? 'solaris)) (C-function ("clock_getcpuclockid" g_clock_getcpuclockid "" 1))))
+	   (C-function ("clock_nanosleep" g_clock_nanosleep "" 4))
+
+
+	   ;; -------- utime.h --------
+	   (in-C "
+                  static s7_pointer g_utime(s7_scheme *sc, s7_pointer args)
+                  {
+                    struct utimbuf tb;
+                    tb.actime = (time_t)s7_integer(s7_cadr(args));
+                    tb.modtime = (time_t)s7_integer(s7_caddr(args));
+                    return(s7_make_integer(sc, utime(s7_string(s7_car(args)), &tb)));
+                  }")
+	   (C-function ("utime" g_utime "" 3))
+
+
+	   ;; -------- termios.h --------
+	   (C-macro (int (VINTR VQUIT VERASE VKILL VEOF VTIME VMIN VSWTC VSTART VSTOP VSUSP VEOL VREPRINT
+			  VDISCARD VWERASE VLNEXT VEOL2 IGNBRK BRKINT IGNPAR PARMRK INPCK ISTRIP INLCR
+			  IGNCR ICRNL IUCLC IXON IXANY IXOFF IMAXBEL IUTF8 OPOST OLCUC ONLCR OCRNL ONOCR
+			  ONLRET OFILL OFDEL ISIG ICANON ECHO ECHOE ECHOK ECHONL NOFLSH TOSTOP IEXTEN
+			  TCOOFF TCOON TCIOFF TCION TCIFLUSH TCOFLUSH TCIOFLUSH TCSANOW TCSADRAIN TCSAFLUSH)))
+
+	   (int tcsendbreak (int int))
+	   (int tcdrain (int))
+	   (int tcflush (int int))
+	   (int tcflow (int int))
+
+	   (in-C "
+                  static s7_pointer g_cfgetospeed(s7_scheme *sc, s7_pointer args)
+                  {
+                    struct termios *p;
+                    p = (struct termios *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"termios*\"), __func__, 1);
+                    return(s7_make_integer(sc, (s7_int)cfgetospeed(p)));
+                  }
+                  static s7_pointer g_cfgetispeed(s7_scheme *sc, s7_pointer args)
+                  {
+                    struct termios *p;
+                    p = (struct termios *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"termios*\"), __func__, 1);
+                    return(s7_make_integer(sc, (s7_int)cfgetispeed(p)));
+                  }
+                  static s7_pointer g_cfsetospeed(s7_scheme *sc, s7_pointer args)
+                  {
+                    struct termios *p;
+                    p = (struct termios *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"termios*\"), __func__, 1);
+                    return(s7_make_integer(sc, cfsetospeed(p, (speed_t)s7_integer(s7_cadr(args)))));
+                  }
+                  static s7_pointer g_cfsetispeed(s7_scheme *sc, s7_pointer args)
+                  {
+                    struct termios *p;
+                    p = (struct termios *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"termios*\"), __func__, 1);
+                    return(s7_make_integer(sc, cfsetispeed(p, (speed_t)s7_integer(s7_cadr(args)))));
+                  }
+                  static s7_pointer g_tcgetattr(s7_scheme *sc, s7_pointer args)
+                  {
+                    struct termios *p;
+                    p = (struct termios *)s7_c_pointer_with_type(sc, s7_cadr(args), s7_make_symbol(sc, \"termios*\"), __func__, 1);
+                    return(s7_make_integer(sc, tcgetattr(s7_integer(s7_car(args)), p)));
+                  }
+                  static s7_pointer g_tcsetattr(s7_scheme *sc, s7_pointer args)
+                  {
+                    struct termios *p;
+                    p = (struct termios *)s7_c_pointer_with_type(sc, s7_caddr(args), s7_make_symbol(sc, \"termios*\"), __func__, 1);
+                    return(s7_make_integer(sc, tcsetattr(s7_integer(s7_car(args)), s7_integer(s7_cadr(args)), p)));
+                   }
+                  static s7_pointer g_termios_make(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(struct termios)), s7_make_symbol(sc, \"termios*\"), s7_f(sc)));}
+
+                  static s7_pointer g_termios_c_lflag(s7_scheme *sc, s7_pointer args)
+                  {
+                    struct termios *p;
+                    p = (struct termios *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"termios*\"), __func__, 1);
+                    return(s7_make_integer(sc, (s7_int)(p->c_lflag)));
+                  }
+                  static s7_pointer g_termios_set_c_lflag(s7_scheme *sc, s7_pointer args)
+                  {
+                    struct termios *p;
+                    p = (struct termios *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"termios*\"), __func__, 1);
+                    p->c_lflag = (tcflag_t)s7_integer(s7_cadr(args));
+                    return(s7_cadr(args));
+                  }
+                  static s7_pointer g_termios_set_c_cc(s7_scheme *sc, s7_pointer args)
+                  {
+                    struct termios *p;
+                    p = (struct termios *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"termios*\"), __func__, 1);
+                    p->c_cc[(int)s7_integer(s7_cadr(args))] = (cc_t)s7_integer(s7_caddr(args));
+                    return(s7_caddr(args));
+                  }
+                  ")
+	   ;; tcflag_t c_iflag, c_oflag, c_cflag; cc_t c_line;
+	   ;; cc_t c_cc[NCCS];
+
+	   (C-function ("cfgetospeed" g_cfgetospeed "" 1))
+	   (C-function ("cfgetispeed" g_cfgetispeed "" 1))
+	   (C-function ("cfsetospeed" g_cfsetospeed "" 2))
+	   (C-function ("cfsetispeed" g_cfsetispeed "" 2))
+	   (C-function ("tcgetattr" g_tcgetattr "" 2))
+	   (C-function ("tcsetattr" g_tcsetattr "" 3))
+	   (C-function ("termios.make" g_termios_make "" 0))
+	   (C-function ("termios.c_lflag" g_termios_c_lflag "" 1))
+	   (C-function ("termios.set_c_lflag" g_termios_set_c_lflag "" 2))
+	   (C-function ("termios.set_c_cc" g_termios_set_c_cc "" 3))
+
+
+	   ;; -------- grp.h --------
+	   (in-C "
+                  static s7_pointer g_getgrgid(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_c_pointer_with_type(sc, getgrgid(s7_integer(s7_car(args))), s7_make_symbol(sc, \"group*\"), s7_f(sc)));}
+                  static s7_pointer g_getgrnam(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_c_pointer_with_type(sc, getgrnam(s7_string(s7_car(args))), s7_make_symbol(sc, \"group*\"), s7_f(sc)));}
+                  static s7_pointer g_group_gr_name(s7_scheme *sc, s7_pointer args)
+                    {
+                      struct group *g;
+                      g = (struct group *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"group*\"), __func__, 1);
+                      if (!g) return(s7_make_string(sc, \"\"));
+                      return(s7_make_string(sc, ((struct group *)g)->gr_name));
+                    }
+                  static s7_pointer g_group_gr_passwd(s7_scheme *sc, s7_pointer args)
+                    {
+                      struct group *g;
+                      g = (struct group *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"group*\"), __func__, 1);
+                      if (!g) return(s7_make_string(sc, \"\"));
+                      return(s7_make_string(sc, ((struct group *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"group*\"), __func__, 1))->gr_passwd));
+                    }
+                  static s7_pointer g_group_gr_gid(s7_scheme *sc, s7_pointer args)
+                    {
+                      struct group *g;
+                      g = (struct group *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"group*\"), __func__, 1);
+                      if (!g) return(s7_make_integer(sc, -1));
+                      return(s7_make_integer(sc, (s7_int)(((struct group *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"group*\"), __func__, 1))->gr_gid)));
+                    }
+                  static s7_pointer g_group_gr_mem(s7_scheme *sc, s7_pointer args)
+                    {
+                      s7_pointer p;
+                      int i;
+                      struct group *g;
+                      g = (struct group *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"group*\"), __func__, 1);
+                      p = s7_nil(sc);
+                      for (i = 0; g->gr_mem[i]; i++)
+                        p = s7_cons(sc, s7_make_string(sc, g->gr_mem[i]), p);
+                      return(p);
+                      }
+                      ")
+	   (C-function ("getgrgid" g_getgrgid "" 1))
+	   (C-function ("getgrnam" g_getgrnam "" 1))
+	   (C-function ("group.gr_name" g_group_gr_name "" 1))
+	   (C-function ("group.gr_passwd" g_group_gr_passwd "" 1))
+	   (C-function ("group.gr_gid" g_group_gr_gid "" 1))
+	   (C-function ("group.gr_mem" g_group_gr_mem "" 1))
+	   ;; ((*libc* 'group.gr_name) ((*libc* 'getgrnam) "wheel")) -> "wheel" (if any)
+	   ;; ((*libc* 'group.gr_name) ((*libc* 'getgrgid) 0)) -> "root"
+	   ;; ((*libc* 'group.gr_gid) ((*libc* 'getgrnam) "root")) -> 0
+
+
+	   ;; -------- pwd.h --------
+	   (C-macro (int NSS_BUFLEN_PASSWD))
+	   (void setpwent (void))
+	   (void endpwent (void))
+	   (passwd* getpwent (void))
+	   (passwd* getpwuid (int))
+	   (passwd* getpwnam (char*))
+	   (in-C "
+                  static s7_pointer g_passwd_pw_name(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_string(sc, ((struct passwd *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"passwd*\"), __func__, 1))->pw_name));}
+                  static s7_pointer g_passwd_pw_passwd(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_string(sc, ((struct passwd *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"passwd*\"), __func__, 1))->pw_passwd));}
+                  static s7_pointer g_passwd_pw_uid(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_integer(sc, ((struct passwd *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"passwd*\"), __func__, 1))->pw_uid));}
+                  static s7_pointer g_passwd_pw_gid(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_integer(sc, ((struct passwd *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"passwd*\"), __func__, 1))->pw_gid));}
+                  static s7_pointer g_passwd_pw_gecos(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_string(sc, ((struct passwd *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"passwd*\"), __func__, 1))->pw_gecos));}
+                  static s7_pointer g_passwd_pw_dir(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_string(sc, ((struct passwd *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"passwd*\"), __func__, 1))->pw_dir));}
+                  static s7_pointer g_passwd_pw_shell(s7_scheme *sc, s7_pointer args)
+                    {return(s7_make_string(sc, ((struct passwd *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"passwd*\"), __func__, 1))->pw_shell));}
+                  ")
+	   (C-function ("passwd.pw_name" g_passwd_pw_name "" 1))
+	   (C-function ("passwd.pw_passwd" g_passwd_pw_passwd "" 1))
+	   (C-function ("passwd.pw_uid" g_passwd_pw_uid "" 1))
+	   (C-function ("passwd.pw_gid" g_passwd_pw_gid "" 1))
+	   (C-function ("passwd.pw_gecos" g_passwd_pw_gecos "" 1))
+	   (C-function ("passwd.pw_dir" g_passwd_pw_dir "" 1))
+	   (C-function ("passwd.pw_shell" g_passwd_pw_shell "" 1))
+	   ;; ((*libc* 'passwd.pw_name) ((*libc* 'getpwnam) "bil")) -> "bil"
+
+
+	   ;; -------- wordexp.h --------
+	   (reader-cond ((not (provided? 'openbsd))
+			 (int (WRDE_DOOFFS WRDE_APPEND WRDE_NOCMD WRDE_REUSE WRDE_SHOWERR WRDE_UNDEF
+					   WRDE_NOSPACE WRDE_BADCHAR WRDE_BADVAL WRDE_CMDSUB WRDE_SYNTAX))
+			 (int wordexp (char* wordexp_t* int))
+			 (void wordfree (wordexp_t*))
+			 (in-C "
+                  static s7_pointer g_wordexp_free(s7_scheme *sc, s7_pointer args) {free(s7_c_pointer(s7_car(args))); return(s7_f(sc));}
+                  static s7_pointer g_wordexp_make(s7_scheme *sc, s7_pointer args)
+                           {return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(wordexp_t)), s7_make_symbol(sc, \"wordexp_t*\"), s7_f(sc)));}
+                           static s7_pointer g_wordexp_we_wordc(s7_scheme *sc, s7_pointer args)
+                           {return(s7_make_integer(sc, ((wordexp_t *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"wordexp_t*\"), __func__, 1))->we_wordc));}
+                           static s7_pointer g_wordexp_we_wordv(s7_scheme *sc, s7_pointer args)
+                           {
+                             s7_pointer p;
+                             size_t i;
+                             wordexp_t *g;
+                             g = (wordexp_t *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"wordexp_t*\"), __func__, 1);
+                             p = s7_nil(sc);
+                             for (i = 0; i < g->we_wordc; i++)
+                               p = s7_cons(sc, s7_make_string(sc, g->we_wordv[i]), p);
+                             return(p);
+                           }")
+			 (C-function ("wordexp.make" g_wordexp_make "" 0))
+			 (C-function ("wordexp.free" g_wordexp_free "" 1))
+			 (C-function ("wordexp.we_wordc" g_wordexp_we_wordc "" 1))
+			 (C-function ("wordexp.we_wordv" g_wordexp_we_wordv "" 1))))
+	   ;; (with-let (sublet *libc*) (let ((w (wordexp.make))) (wordexp "~/cl/snd-gdraw" w 0) (wordexp.we_wordv w))) -> ("/home/bil/cl/snd-gdraw")
+
+
+	   ;; -------- glob.h --------
+	   ;; does any of this work in openbsd?
+	   (C-macro (int (GLOB_ERR GLOB_MARK GLOB_NOSORT GLOB_DOOFFS GLOB_NOCHECK GLOB_APPEND GLOB_NOESCAPE GLOB_PERIOD
+			  GLOB_MAGCHAR GLOB_ALTDIRFUNC GLOB_BRACE GLOB_NOMAGIC GLOB_TILDE GLOB_ONLYDIR GLOB_TILDE_CHECK
+			  GLOB_NOSPACE GLOB_ABORTED GLOB_NOMATCH GLOB_NOSYS)))
+	   (void globfree (glob_t*))
+	   (in-C "
+                  static s7_pointer g_glob_make(s7_scheme *sc, s7_pointer args)
+                           {return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(glob_t)), s7_make_symbol(sc, \"glob_t*\"), s7_f(sc)));}
+                           static s7_pointer g_glob_gl_pathc(s7_scheme *sc, s7_pointer args)
+                           {return(s7_make_integer(sc, ((glob_t *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"glob_t*\"), __func__, 1))->gl_pathc));}
+                           static s7_pointer g_glob(s7_scheme *sc, s7_pointer args)
+                           {return(s7_make_integer(sc, glob(s7_string(s7_car(args)), s7_integer(s7_cadr(args)), NULL,
+                                                            (glob_t *)s7_c_pointer_with_type(sc, s7_caddr(args), s7_make_symbol(sc, \"glob_t*\"), __func__, 1))));}
+                           static s7_pointer g_glob_gl_pathv(s7_scheme *sc, s7_pointer args)
+                           {
+                             s7_pointer p;
+                             size_t i;
+                             glob_t *g;
+                             g = (glob_t *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"glob_t*\"), __func__, 1);
+                             p = s7_nil(sc);
+                             for (i = 0; i < g->gl_pathc; i++)
+                               p = s7_cons(sc, s7_make_string(sc, g->gl_pathv[i]), p);
+                             return(p);
+                           }")
+	   (C-function ("glob.make" g_glob_make "" 0))
+	   (C-function ("glob.gl_pathc" g_glob_gl_pathc "" 1))
+	   (C-function ("glob.gl_pathv" g_glob_gl_pathv "" 1))
+	   (C-function ("glob" g_glob "" 3))
+
+
+	   ;; -------- signal.h sys/wait.h --------
+	   (C-macro (int (SIGHUP SIGINT SIGQUIT SIGILL SIGTRAP SIGABRT SIGIOT SIGBUS SIGFPE
+			  SIGKILL SIGUSR1 SIGSEGV SIGUSR2 SIGPIPE SIGALRM SIGTERM SIGSTKFLT
+			  SIGCLD SIGCHLD SIGCONT SIGSTOP SIGTSTP SIGTTIN SIGTTOU SIGURG
+			  SIGXCPU SIGXFSZ SIGVTALRM SIGPROF SIGWINCH SIGPOLL SIGIO SIGPWR SIGSYS
+			  (reader-cond ((not (provided? 'osx)) SIGUNUSED))
+			  WNOHANG WUNTRACED WSTOPPED WEXITED WCONTINUED WNOWAIT
+			  RLIMIT_CPU RLIMIT_FSIZE RLIMIT_DATA RLIMIT_STACK RLIMIT_CORE RLIMIT_RSS
+			  RLIMIT_NOFILE RLIMIT_OFILE RLIMIT_AS RLIMIT_NPROC RLIMIT_MEMLOCK RLIMIT_LOCKS
+			  RLIMIT_SIGPENDING RLIMIT_MSGQUEUE RLIMIT_NICE RLIMIT_RTPRIO RLIMIT_NLIMITS
+			  RLIM_NLIMITS RLIM_INFINITY RLIM_SAVED_MAX RLIM_SAVED_CUR RUSAGE_SELF
+			  RUSAGE_CHILDREN RUSAGE_THREAD RUSAGE_LWP
+			  PRIO_MIN PRIO_MAX PRIO_PROCESS PRIO_PGRP PRIO_USER
+			  SA_NOCLDSTOP SA_NOCLDWAIT SA_SIGINFO SA_ONSTACK SA_RESTART SA_NODEFER SA_RESETHAND SA_NOMASK SA_ONESHOT SA_STACK
+			  SIG_BLOCK SIG_UNBLOCK SIG_SETMASK
+			  )))
+
+	   ;; (let ((v (rusage.make))) (getrusage (*libc* 'RUSAGE_SELF) v)  (let ((mem (rusage.ru_maxrss v))) (free v) mem))
+
+	   (int kill (int int))
+	   (int raise (int))
+	   (int sigemptyset (sigset_t*))
+	   (int sigfillset (sigset_t*))
+	   (int sigaddset (sigset_t* int))
+	   (int sigdelset (sigset_t* int))
+	   (int sigismember (sigset_t* int))
+	   (int sigprocmask (int sigset_t* sigset_t*))
+	   (int sigsuspend (sigset_t*))
+	   (int sigpending (sigset_t*))
+	   (int getpriority (int int))
+	   (int setpriority (int int int))
+
+	   (in-C "
+                  static s7_pointer g_rlimit_make(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(struct rlimit)), s7_make_symbol(sc, \"rlimit*\"), s7_f(sc)));}
+                  static s7_pointer g_rlimit_rlim_cur(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((struct rlimit *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"rlimit*\"), __func__, 1))->rlim_cur));}
+                  static s7_pointer g_rlimit_rlim_max(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((struct rlimit *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"rlimit*\"), __func__, 1))->rlim_max));}
+
+                  static s7_pointer g_rusage_make(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(struct rusage)), s7_make_symbol(sc, \"rusage*\"), s7_f(sc)));}
+                  static s7_pointer g_rusage_ru_maxrss(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((struct rusage *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"rusage*\"), __func__, 1))->ru_maxrss));}
+                  static s7_pointer g_rusage_ru_minflt(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((struct rusage *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"rusage*\"), __func__, 1))->ru_minflt));}
+                  static s7_pointer g_rusage_ru_majflt(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((struct rusage *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"rusage*\"), __func__, 1))->ru_majflt));}
+                  static s7_pointer g_rusage_ru_inblock(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((struct rusage *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"rusage*\"), __func__, 1))->ru_inblock));}
+                  static s7_pointer g_rusage_ru_oublock(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((struct rusage *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"rusage*\"), __func__, 1))->ru_oublock));}
+                  static s7_pointer g_rusage_ru_nvcsw(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((struct rusage *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"rusage*\"), __func__, 1))->ru_nvcsw));}
+                  static s7_pointer g_rusage_ru_nivcsw(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((struct rusage *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"rusage*\"), __func__, 1))->ru_nivcsw));}
+                  static s7_pointer g_rusage_ru_utime(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_c_pointer(sc, &(((struct rusage *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"rusage*\"), __func__, 1))->ru_utime)));}
+                  static s7_pointer g_rusage_ru_stime(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_c_pointer(sc, &(((struct rusage *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"rusage*\"), __func__, 1))->ru_stime)));}
+                  static s7_pointer g_getrusage(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, getrusage(s7_integer(s7_car(args)),
+                                                (struct rusage *)s7_c_pointer_with_type(sc, s7_cadr(args), s7_make_symbol(sc, \"rusage*\"), __func__, 1))));}
+
+                  static s7_pointer g_sigset_make(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(sigset_t)), s7_make_symbol(sc, \"sigset_t*\"), s7_f(sc)));}
+
+                  #if __linux__
+                  static s7_pointer g_WEXITSTATUS(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, WEXITSTATUS(s7_integer(s7_car(args)))));}
+                  static s7_pointer g_WTERMSIG(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, WTERMSIG(s7_integer(s7_car(args)))));}
+                  static s7_pointer g_WSTOPSIG(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, WSTOPSIG(s7_integer(s7_car(args)))));}
+                  static s7_pointer g_WIFEXITED(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, WIFEXITED(s7_integer(s7_car(args)))));}
+                  static s7_pointer g_WIFSIGNALED(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, WIFSIGNALED(s7_integer(s7_car(args)))));}
+                  static s7_pointer g_WIFSTOPPED(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, WIFSTOPPED(s7_integer(s7_car(args)))));}
+                  #endif
+
+                  static s7_pointer g_wait(s7_scheme *sc, s7_pointer args)
+                  {
+                    int status, result;
+                    result = wait(&status);
+                    return(s7_list(sc, 2, s7_make_integer(sc, result), s7_make_integer(sc, status)));
+                  }
+                  static s7_pointer g_waitpid(s7_scheme *sc, s7_pointer args)
+                  {
+                    int status, result;
+                    result = waitpid((pid_t)s7_integer(s7_car(args)), &status, s7_integer(s7_cadr(args)));
+                    return(s7_list(sc, 2, s7_make_integer(sc, result), s7_make_integer(sc, status)));
+                  }
+                  static s7_pointer g_sigqueue(s7_scheme *sc, s7_pointer args)
+                  {
+                    #if (__linux__)
+                      union sigval val;
+                      if (s7_is_integer(s7_caddr(args)))
+                        val.sival_int = (int)s7_integer(s7_caddr(args));
+                      else val.sival_ptr = (void *)s7_c_pointer(s7_caddr(args));
+                      return(s7_make_integer(sc, sigqueue((pid_t)s7_integer(s7_car(args)), s7_integer(s7_cadr(args)), val)));
+                    #else
+                      return(s7_f(sc));
+                    #endif
+                  }
+                  static s7_pointer g_sigwait(s7_scheme *sc, s7_pointer args)
+                  {
+                    #if (!__sun)
+                    int status, result;
+                    result = sigwait((const sigset_t *)s7_c_pointer(s7_car(args)), &status);
+                    return(s7_list(sc, 2, s7_make_integer(sc, result), s7_make_integer(sc, status)));
+                    #else
+                    return(s7_f(sc));
+                    #endif
+                  }
+                  static s7_pointer g_sigtimedwait(s7_scheme *sc, s7_pointer args)
+                  {
+                    #if (__linux__)
+                     return(s7_make_integer(sc, sigtimedwait((const sigset_t *)s7_c_pointer(s7_car(args)),
+                  					   (siginfo_t *)s7_c_pointer(s7_cadr(args)),
+                                                             (const struct timespec *)s7_c_pointer(s7_caddr(args)))));
+                    #else
+                      return(s7_f(sc));
+                    #endif
+                  }
+                  #if __linux__
+                  static s7_pointer g_siginfo_make(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(siginfo_t)), s7_make_symbol(sc, \"siginfo_t*\"), s7_f(sc)));}
+                  static s7_pointer g_siginfo_si_signo(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"siginfo_t*\"), __func__, 1))->si_signo));}
+                  static s7_pointer g_siginfo_si_errno(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"siginfo_t*\"), __func__, 1))->si_errno));}
+                  static s7_pointer g_siginfo_si_code(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"siginfo_t*\"), __func__, 1))->si_code));}
+                  static s7_pointer g_siginfo_si_pid(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"siginfo_t*\"), __func__, 1))->si_pid));}
+                  static s7_pointer g_siginfo_si_uid(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"siginfo_t*\"), __func__, 1))->si_uid));}
+                  static s7_pointer g_siginfo_si_status(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"siginfo_t*\"), __func__, 1))->si_status));}
+                  static s7_pointer g_siginfo_si_utime(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"siginfo_t*\"), __func__, 1))->si_utime));}
+                  static s7_pointer g_siginfo_si_stime(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"siginfo_t*\"), __func__, 1))->si_stime));}
+                  static s7_pointer g_siginfo_si_value(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_c_pointer(sc, &(((siginfo_t *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"siginfo_t*\"), __func__, 1))->si_value)));}
+                  static s7_pointer g_siginfo_si_int(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"siginfo_t*\"), __func__, 1))->si_int));}
+                  static s7_pointer g_siginfo_si_overrun(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"siginfo_t*\"), __func__, 1))->si_overrun));}
+                  static s7_pointer g_siginfo_si_timerid(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"siginfo_t*\"), __func__, 1))->si_timerid));}
+                  static s7_pointer g_siginfo_si_band(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"siginfo_t*\"), __func__, 1))->si_band));}
+                  static s7_pointer g_siginfo_si_fd(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"siginfo_t*\"), __func__, 1))->si_fd));}
+                  static s7_pointer g_siginfo_si_ptr(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_c_pointer_with_type(sc,
+                            ((siginfo_t *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"siginfo_t*\"), __func__, 1))->si_ptr,
+                            s7_make_symbol(sc, \"siginfo_t*\"), s7_f(sc)));}
+                  static s7_pointer g_siginfo_si_addr(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_c_pointer_with_type(sc,
+                            ((siginfo_t *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"siginfo_t*\"), __func__, 1))->si_addr,
+                            s7_make_symbol(sc, \"siginfo_t*\"), s7_f(sc)));}
+                  #endif
+
+                  static s7_pointer g_timespec_make(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(struct timespec)), s7_make_symbol(sc, \"timespec*\"), s7_f(sc)));}
+                  static s7_pointer g_timespec_tv_sec(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((struct timespec *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"timespec*\"), __func__, 1))->tv_sec));}
+                  static s7_pointer g_timespec_tv_nsec(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((struct timespec *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"timespec*\"), __func__, 1))->tv_nsec));}
+
+                  static s7_pointer g_sigaction_make(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(struct sigaction)), s7_make_symbol(sc, \"sigaction*\"), s7_f(sc)));}
+                  static s7_pointer g_sigaction_sa_flags(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((struct sigaction *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"sigaction*\"), __func__, 1))->sa_flags));}
+                  static s7_pointer g_sigaction_set_sa_flags(s7_scheme *sc, s7_pointer args)
+                  {((struct sigaction *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"sigaction*\"), __func__, 1))->sa_flags = s7_integer(s7_cadr(args)); return(s7_cadr(args));}
+                  static s7_pointer g_sigaction_sa_mask(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_c_pointer_with_type(sc, (void *)(&(((struct sigaction *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"sigaction*\"), __func__, 1))->sa_mask)), s7_make_symbol(sc, \"sigset_t*\"), s7_f(sc)));}
+                  static s7_pointer g_sigaction_sa_handler(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_c_pointer(sc, (void *)(((struct sigaction *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"sigaction*\"), __func__, 1))->sa_handler)));}
+
+                  static s7_pointer sighandlers = NULL;
+                  static s7_scheme *sighandlers_s7 = NULL;
+                  static void s7_signal_handler(int sig)
+                  {
+                    if (sighandlers)
+                      {
+                        s7_pointer handler;
+                        handler = s7_vector_ref(sighandlers_s7, sighandlers, sig);
+                        if (handler != s7_nil(sighandlers_s7))
+                           s7_call(sighandlers_s7, handler, s7_cons(sighandlers_s7, s7_make_integer(sighandlers_s7, sig), s7_nil(sighandlers_s7)));
+                       }
+                  }
+                  #ifndef SIGUNUSED
+                    #define SIGUNUSED 65
+                  #endif
+                  static s7_pointer g_sigaction_set_sa_handler(s7_scheme *sc, s7_pointer args)
+                  {
+                    /* (sigaction.set_sa_handler ptr handler) */
+                    if (!sighandlers)
+                      {
+                        sighandlers_s7 = sc;
+                        sighandlers = s7_make_and_fill_vector(sc, SIGUNUSED + 1, s7_nil(sc));
+                        s7_gc_protect(sc, sighandlers);
+                      }
+                    if (s7_is_c_pointer(s7_cadr(args)))
+                      {
+                        if (s7_c_pointer(s7_cadr(args)) == (void *)SIG_DFL)
+                           ((struct sigaction *)s7_c_pointer(s7_car(args)))->sa_handler = SIG_DFL;
+                        else
+                          {
+                            if (s7_c_pointer(s7_cadr(args)) == (void *)SIG_IGN)
+                               ((struct sigaction *)s7_c_pointer(s7_car(args)))->sa_handler = SIG_IGN;
+                          }}
+                    else
+                      {
+                        ((struct sigaction *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"sigaction*\"), __func__, 1))->sa_handler = s7_signal_handler;
+                        s7_vector_set(sighandlers_s7, sighandlers, SIGUNUSED,
+                          s7_cons(sc, s7_cons(sc, s7_car(args), s7_cadr(args)), s7_vector_ref(sighandlers_s7, sighandlers, SIGUNUSED)));
+                      }
+                    return(s7_cadr(args));
+                  }
+                static s7_pointer g_sigaction(s7_scheme *sc, s7_pointer args)
+                {
+                  int sig;
+                  const struct sigaction *new_act;
+                  struct sigaction *old_act;
+                  s7_pointer handler;
+                  sig = (int)s7_integer(s7_car(args));
+                  new_act = (const struct sigaction *)s7_c_pointer_with_type(sc, s7_cadr(args), s7_make_symbol(sc, \"sigaction*\"), __func__, 1);
+                  old_act = (struct sigaction *)s7_c_pointer_with_type(sc, s7_caddr(args), s7_make_symbol(sc, \"sigaction*\"), __func__, 1);
+                  if (s7_is_pair(s7_vector_ref(sighandlers_s7, sighandlers, SIGUNUSED)))
+                    {
+                      handler = s7_assq(sc, s7_cadr(args), s7_vector_ref(sighandlers_s7, sighandlers, SIGUNUSED));
+                      if (s7_is_pair(handler))
+                        s7_vector_set(sighandlers_s7, sighandlers, sig, s7_cdr(handler));
+                    }
+                  return(s7_make_integer(sc, sigaction(sig, new_act, old_act)));
+                }
+                static s7_pointer g_signal(s7_scheme *sc, s7_pointer args)
+                {
+                  int sig;
+                  if (!sighandlers)
+                    {
+                      sighandlers_s7 = sc;
+                      sighandlers = s7_make_and_fill_vector(sc, SIGUNUSED + 1, s7_nil(sc));
+                      s7_gc_protect(sc, sighandlers);
+                    }
+                  sig = s7_integer(s7_car(args));
+                  if (s7_is_c_pointer(s7_cadr(args)))
+                    {
+                      if (s7_c_pointer(s7_cadr(args)) == (void *)SIG_DFL)
+                         return(s7_make_c_pointer(sc, (void *)signal(sig, SIG_DFL)));
+                      if (s7_c_pointer(s7_cadr(args)) == (void *)SIG_IGN)
+                         return(s7_make_c_pointer(sc, (void *)signal(sig, SIG_IGN)));
+                     }
+                  s7_vector_set(sc, sighandlers, sig, s7_cadr(args));
+                  return(s7_make_c_pointer(sc, (void *)signal(sig, s7_signal_handler)));
+                }
+                  ")
+
+	   (C-function ("rlimit.make" g_rlimit_make "" 0))
+	   (C-function ("rlimit.rlim_cur" g_rlimit_rlim_cur "" 1))
+	   (C-function ("rlimit.rlim_max" g_rlimit_rlim_max "" 1))
+
+	   (C-function ("rusage.make" g_rusage_make "" 0))
+	   (C-function ("getrusage" g_getrusage "" 2))
+	   (C-function ("rusage.ru_maxrss" g_rusage_ru_maxrss "" 1))
+	   (C-function ("rusage.ru_minflt" g_rusage_ru_minflt "" 1))
+	   (C-function ("rusage.ru_majflt" g_rusage_ru_majflt "" 1))
+	   (C-function ("rusage.ru_inblock" g_rusage_ru_inblock "" 1))
+	   (C-function ("rusage.ru_oublock" g_rusage_ru_oublock "" 1))
+	   (C-function ("rusage.ru_nvcsw" g_rusage_ru_nvcsw "" 1))
+	   (C-function ("rusage.ru_nivcsw" g_rusage_ru_nivcsw "" 1))
+	   (C-function ("rusage.ru_utime" g_rusage_ru_utime "" 1))
+	   (C-function ("rusage.ru_stime" g_rusage_ru_stime "" 1))
+
+	   (reader-cond ((provided? 'linux)
+			 (C-function ("siginfo.make" g_siginfo_make "" 0))
+			 (C-function ("siginfo.si_signo" g_siginfo_si_signo "" 1))
+			 (C-function ("siginfo.si_errno" g_siginfo_si_errno "" 1))
+			 (C-function ("siginfo.si_code" g_siginfo_si_code "" 1))
+			 (C-function ("siginfo.si_pid" g_siginfo_si_pid "" 1))
+			 (C-function ("siginfo.si_uid" g_siginfo_si_uid "" 1))
+			 (C-function ("siginfo.si_status" g_siginfo_si_status "" 1))
+			 (C-function ("siginfo.si_utime" g_siginfo_si_utime "" 1))
+			 (C-function ("siginfo.si_stime" g_siginfo_si_stime "" 1))
+			 (C-function ("siginfo.si_value" g_siginfo_si_value "" 1))
+			 (C-function ("siginfo.si_int" g_siginfo_si_int "" 1))
+			 (C-function ("siginfo.si_overrun" g_siginfo_si_overrun "" 1))
+			 (C-function ("siginfo.si_timerid" g_siginfo_si_timerid "" 1))
+			 (C-function ("siginfo.si_band" g_siginfo_si_band "" 1))
+			 (C-function ("siginfo.si_fd" g_siginfo_si_fd "" 1))
+			 (C-function ("siginfo.si_ptr" g_siginfo_si_ptr "" 1))
+			 (C-function ("siginfo.si_addr" g_siginfo_si_addr "" 1))))
+
+	   (C-function ("timespec.make" g_timespec_make "" 0))
+	   (C-function ("timespec.tv_sec" g_timespec_tv_sec "" 1))
+	   (C-function ("timespec.tv_nsec" g_timespec_tv_nsec "" 1))
+
+	   (C-function ("sigaction.make" g_sigaction_make "" 0))
+	   (C-function ("sigaction.sa_handler" g_sigaction_sa_handler "" 1))
+	   (C-function ("sigaction.sa_flags" g_sigaction_sa_flags "" 1))
+	   (C-function ("sigaction.sa_mask" g_sigaction_sa_mask "" 1))
+	   (C-function ("sigaction.set_sa_handler" g_sigaction_set_sa_handler "" 2))
+	   (C-function ("sigaction.set_sa_flags" g_sigaction_set_sa_flags "" 2))
+#|
+	   (with-let (sublet *libc*)
+	     (let ((sa (sigaction.make)))
+	       (sigemptyset (sigaction.sa_mask sa))
+	       (sigaction.set_sa_flags sa SA_RESTART)
+	       (sigaction.set_sa_handler sa SIG_IGN)
+               ;; (sigaction.set_sa_handler sa (lambda (i) (format *stderr* "i: ~S~%" i)))
+	       (sigaction SIGINT sa NULL)
+	       ;; now C-C is ignored
+	       (do ((i 0 (+ i 1)))
+		   ((= i 10))
+		 (sleep 1))))
+|#
+	   (reader-cond ((provided? 'linux)
+			 (C-function ("WEXITSTATUS" g_WEXITSTATUS "" 1))
+			 (C-function ("WTERMSIG" g_WTERMSIG "" 1))
+			 (C-function ("WSTOPSIG" g_WSTOPSIG "" 1))
+			 (C-function ("WIFEXITED" g_WIFEXITED "" 1))
+			 (C-function ("WIFSIGNALED" g_WIFSIGNALED "" 1))
+			 (C-function ("WIFSTOPPED" g_WIFSTOPPED "" 1))))
+
+	   (C-function ("wait" g_wait "" 0))
+	   (C-function ("waitpid" g_waitpid "" 2))
+	   (C-function ("sigqueue" g_sigqueue "" 3))
+	   (reader-cond ((not (provided? 'solaris)) (C-function ("sigwait" g_sigwait "" 1))))
+	   (C-function ("sigaction" g_sigaction "" 3))
+	   (C-function ("sigtimedwait" g_sigtimedwait "" 3))
+	   (C-function ("sigset.make" g_sigset_make "" 0))
+
+	   (C-function ("signal" g_signal "" 2))
+
+	   (int getrlimit (int struct-rlimit*))
+	   (int setrlimit (int struct-rlimit*))
+	   (reader-cond ((provided? 'linux)
+			 (int sigwaitinfo (sigset_t* siginfo_t*))
+			 (int waitid ((idtype_t int) int siginfo_t* int))))
+
+	   (c-pointer (SIG_ERR SIG_DFL SIG_IGN))
+
+
+	   ;; -------- netdb.h --------
+	   (reader-cond ((provided? 'linux)
+			 (int (IPPORT_ECHO IPPORT_DISCARD IPPORT_SYSTAT IPPORT_DAYTIME IPPORT_NETSTAT IPPORT_FTP IPPORT_TELNET IPPORT_SMTP
+			       IPPORT_TIMESERVER IPPORT_NAMESERVER IPPORT_WHOIS IPPORT_MTP IPPORT_TFTP IPPORT_RJE IPPORT_FINGER IPPORT_TTYLINK
+			       IPPORT_SUPDUP IPPORT_EXECSERVER IPPORT_LOGINSERVER IPPORT_CMDSERVER IPPORT_EFSSERVER IPPORT_BIFFUDP
+			       IPPORT_WHOSERVER IPPORT_ROUTESERVER IPPORT_RESERVED IPPORT_USERRESERVED))))
+
+	   (C-macro (int (AI_PASSIVE AI_CANONNAME AI_NUMERICHOST AI_V4MAPPED AI_ALL AI_ADDRCONFIG AI_NUMERICSERV
+			  EAI_BADFLAGS EAI_NONAME EAI_AGAIN EAI_FAIL EAI_FAMILY EAI_SOCKTYPE EAI_SERVICE EAI_MEMORY EAI_SYSTEM EAI_OVERFLOW
+			  NI_NUMERICHOST NI_NUMERICSERV NI_NOFQDN NI_NAMEREQD NI_DGRAM
+			  SOCK_STREAM SOCK_DGRAM SOCK_RAW SOCK_RDM SOCK_SEQPACKET SOCK_DCCP SOCK_PACKET SOCK_CLOEXEC SOCK_NONBLOCK
+			  PF_UNSPEC PF_LOCAL PF_UNIX PF_FILE PF_INET PF_AX25 PF_IPX PF_APPLETALK PF_NETROM PF_BRIDGE
+			  PF_ATMPVC PF_X25 PF_INET6 PF_ROSE PF_DECnet PF_NETBEUI PF_SECURITY PF_KEY PF_NETLINK PF_ROUTE
+			  PF_PACKET PF_ASH PF_ECONET PF_ATMSVC PF_RDS PF_SNA PF_IRDA PF_PPPOX PF_WANPIPE PF_LLC PF_CAN
+			  PF_TIPC PF_BLUETOOTH PF_IUCV PF_RXRPC PF_ISDN PF_PHONET PF_IEEE802154 PF_MAX
+			  AF_UNSPEC AF_LOCAL AF_UNIX AF_FILE AF_INET AF_AX25 AF_IPX AF_APPLETALK AF_NETROM AF_BRIDGE
+			  AF_ATMPVC AF_X25 AF_INET6 AF_ROSE AF_DECnet AF_NETBEUI AF_SECURITY AF_KEY AF_NETLINK AF_ROUTE
+			  AF_PACKET AF_ASH AF_ECONET AF_ATMSVC AF_RDS AF_SNA AF_IRDA AF_PPPOX AF_WANPIPE AF_LLC
+			  AF_CAN AF_TIPC AF_BLUETOOTH AF_IUCV AF_RXRPC AF_ISDN AF_PHONET AF_IEEE802154 AF_MAX
+			  MSG_OOB MSG_PEEK MSG_DONTROUTE MSG_CTRUNC MSG_PROXY MSG_TRUNC MSG_DONTWAIT MSG_EOR MSG_WAITFORONE
+			  MSG_WAITALL MSG_FIN MSG_SYN MSG_CONFIRM MSG_RST MSG_ERRQUEUE MSG_NOSIGNAL MSG_MORE MSG_CMSG_CLOEXEC
+			  IPPROTO_IP IPPROTO_HOPOPTS IPPROTO_ICMP IPPROTO_IGMP IPPROTO_IPIP IPPROTO_TCP IPPROTO_EGP IPPROTO_PUP
+			  IPPROTO_UDP IPPROTO_IDP IPPROTO_TP IPPROTO_DCCP IPPROTO_IPV6 IPPROTO_ROUTING IPPROTO_FRAGMENT
+			  IPPROTO_RSVP IPPROTO_GRE IPPROTO_ESP IPPROTO_AH IPPROTO_ICMPV6 IPPROTO_NONE IPPROTO_DSTOPTS
+			  IPPROTO_MTP IPPROTO_ENCAP IPPROTO_PIM IPPROTO_COMP IPPROTO_SCTP IPPROTO_UDPLITE IPPROTO_RAW
+			  SOL_RAW SOL_DECNET SOL_X25 SOL_PACKET SOL_ATM SOL_AAL SOL_IRDA
+			  SHUT_RD SHUT_WR SHUT_RDWR)))
+
+	   (C-macro (char* (_PATH_HEQUIV _PATH_HOSTS _PATH_NETWORKS _PATH_NSSWITCH_CONF _PATH_PROTOCOLS _PATH_SERVICES)))
+
+	   (reader-cond ((not (provided? 'msys))
+			 (hostent* gethostent (void))
+			 (void setnetent (int))
+			 (void endnetent (void))
+			 (netent* getnetent (void))
+			 (netent* getnetbyname (char*))
+			 (netent* getnetbyaddr (int int))))
+
+	   (void sethostent (int))
+	   (void endhostent (void))
+
+	   (void setservent (int))
+	   (void endservent (void))
+	   (servent* getservent (void))
+
+	   (void setprotoent (int))
+	   (void endprotoent (void))
+	   (protoent* getprotoent (void))
+
+
+	   (int socket (int int int))
+	   (int listen (int int))
+	   (int shutdown (int int))
+
+	   (hostent* gethostbyname (char*))
+	   (hostent* gethostbyaddr (void* int int))
+	   (servent* getservbyname (char* char*))
+	   (servent* getservbyport (int char*))
+	   (protoent* getprotobyname (char*))
+	   (protoent* getprotobynumber (int))
+
+	   (void freeaddrinfo (struct-addrinfo*))
+	   (char* gai_strerror (int))
+
+	   (int bind (int const-struct-sockaddr* int))
+	   (int connect (int const-struct-sockaddr* int))
+	   (int send (int void* int int))
+	   (int recv (int void* int int))
+	   (int sendto (int void* int int const-struct-sockaddr* int))
+	   (int sendmsg (int const-struct-msghdr* int))
+	   (int recvmsg (int struct-msghdr* int))
+
+	   (in-C "
+                  static s7_pointer g_ntohl(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, ntohl(s7_integer(s7_car(args)))));}
+                  static s7_pointer g_ntohs(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, ntohs(s7_integer(s7_car(args)))));}
+                  static s7_pointer g_htonl(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, htonl(s7_integer(s7_car(args)))));}
+                  static s7_pointer g_htons(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, htons(s7_integer(s7_car(args)))));}
+
+                  static s7_pointer g_addrinfo_make(s7_scheme *sc, s7_pointer args)
+                  {
+                    return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(struct addrinfo)), s7_make_symbol(sc, \"addrinfo*\"), s7_f(sc)));
+                  }
+
+                  static s7_pointer g_addrinfo_ai_flags(s7_scheme *sc, s7_pointer args)
+                  {
+                    return(s7_make_integer(sc, ((struct addrinfo *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"addrinfo*\"), __func__, 1))->ai_flags));
+                  }
+                  static s7_pointer g_addrinfo_set_ai_flags(s7_scheme *sc, s7_pointer args)
+                  {
+                    ((struct addrinfo *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"addrinfo*\"), __func__, 1))->ai_flags = (int)s7_integer(s7_cadr(args));
+                    return(s7_cadr(args));
+                  }
+
+                  static s7_pointer g_addrinfo_ai_family(s7_scheme *sc, s7_pointer args)
+                  {
+                    return(s7_make_integer(sc, ((struct addrinfo *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"addrinfo*\"), __func__, 1))->ai_family));
+                  }
+                  static s7_pointer g_addrinfo_set_ai_family(s7_scheme *sc, s7_pointer args)
+                  {
+                    ((struct addrinfo *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"addrinfo*\"), __func__, 1))->ai_family = (int)s7_integer(s7_cadr(args));
+                    return(s7_cadr(args));
+                  }
+
+                  static s7_pointer g_addrinfo_ai_socktype(s7_scheme *sc, s7_pointer args)
+                  {
+                    return(s7_make_integer(sc, ((struct addrinfo *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"addrinfo*\"), __func__, 1))->ai_socktype));
+                  }
+                  static s7_pointer g_addrinfo_set_ai_socktype(s7_scheme *sc, s7_pointer args)
+                  {
+                    ((struct addrinfo *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"addrinfo*\"), __func__, 1))->ai_socktype = (int)s7_integer(s7_cadr(args));
+                    return(s7_cadr(args));
+                  }
+
+                  static s7_pointer g_addrinfo_ai_protocol(s7_scheme *sc, s7_pointer args)
+                  {
+                    return(s7_make_integer(sc, ((struct addrinfo *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"addrinfo*\"), __func__, 1))->ai_protocol));
+                  }
+                  static s7_pointer g_addrinfo_set_ai_protocol(s7_scheme *sc, s7_pointer args)
+                  {
+                    ((struct addrinfo *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"addrinfo*\"), __func__, 1))->ai_protocol = (int)s7_integer(s7_cadr(args));
+                    return(s7_cadr(args));
+                  }
+                  static s7_pointer g_addrinfo_ai_canonname(s7_scheme *sc, s7_pointer args)
+                  {
+                    return(s7_make_string(sc, ((struct addrinfo *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"addrinfo*\"), __func__, 1))->ai_canonname));
+                  }
+                  static s7_pointer g_addrinfo_ai_next(s7_scheme *sc, s7_pointer args)
+                  {
+                    return(s7_make_c_pointer_with_type(sc, (void *)(((struct addrinfo *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"addrinfo*\"), __func__, 1))->ai_next), s7_make_symbol(sc, \"addrinfo*\"), s7_f(sc)));
+                  }
+
+                  static s7_pointer g_getaddrinfo(s7_scheme *sc, s7_pointer args)
+                  {
+                     struct addrinfo *result;
+                     int err;
+                     err = getaddrinfo(s7_string(s7_car(args)),
+                  		     s7_string(s7_cadr(args)),
+                  		     (const struct addrinfo *)s7_c_pointer_with_type(sc, s7_caddr(args), s7_make_symbol(sc, \"addrinfo*\"), __func__, 1),
+                                     &result);
+                    return(s7_list(sc, 2, s7_make_integer(sc, err),
+                                          s7_make_c_pointer_with_type(sc, (void *)result, s7_make_symbol(sc, \"addrinfo*\"), s7_f(sc))));
+                  }
+
+                  static s7_pointer g_getnameinfo(s7_scheme *sc, s7_pointer args)
+                  {
+                    #ifndef NI_MAXHOST
+                      #define NI_MAXHOST 1025
+                    #endif
+                    #ifndef NI_MAXSERV
+                      #define NI_MAXSERV 32
+                    #endif
+                    char *host, *service;
+                    int err;
+                    host = (char *)calloc(NI_MAXHOST, sizeof(char));
+                    service = (char *)calloc(NI_MAXSERV, sizeof(char));
+                    err = getnameinfo((const struct sockaddr *)s7_c_pointer(s7_car(args)), s7_integer(s7_cadr(args)),
+                  		    host, NI_MAXHOST,
+                  		    service, NI_MAXSERV,
+                  		    s7_integer(s7_caddr(args)));
+                    return(s7_list(sc, 3, s7_make_integer(sc, err), s7_make_string(sc, host), s7_make_string(sc, service)));
+                  }
+
+                  static s7_pointer g_socketpair(s7_scheme *sc, s7_pointer args)
+                  {
+                    int fds[2];
+                    int err;
+                    err = socketpair(s7_integer(s7_car(args)), s7_integer(s7_cadr(args)), s7_integer(s7_caddr(args)), fds);
+                    return(s7_list(sc, 3, s7_make_integer(sc, err), s7_make_integer(sc, fds[0]), s7_make_integer(sc, fds[1])));
+                  }
+
+                  static s7_pointer g_getsockname(s7_scheme *sc, s7_pointer args)
+                  {
+                    int err;
+                    socklen_t res;
+                    res = s7_integer(s7_caddr(args));
+                    err = getsockname(s7_integer(s7_car(args)), (struct sockaddr *)s7_c_pointer(s7_cadr(args)), &res);
+                    return(s7_list(sc, 2, s7_make_integer(sc, err), s7_make_integer(sc, res)));
+                  }
+                  static s7_pointer g_getpeername(s7_scheme *sc, s7_pointer args)
+                  {
+                    int err;
+                    socklen_t res;
+                    res = s7_integer(s7_caddr(args));
+                    err = getpeername(s7_integer(s7_car(args)), (struct sockaddr *)s7_c_pointer(s7_cadr(args)), &res);
+                    return(s7_list(sc, 2, s7_make_integer(sc, err), s7_make_integer(sc, res)));
+                  }
+                  static s7_pointer g_accept(s7_scheme *sc, s7_pointer args)
+                  {
+                    int err;
+                    socklen_t res;
+                    res = s7_integer(s7_caddr(args));
+                    err = accept(s7_integer(s7_car(args)), (struct sockaddr *)s7_c_pointer(s7_cadr(args)), &res);
+                    return(s7_list(sc, 2, s7_make_integer(sc, err), s7_make_integer(sc, res)));
+                  }
+                  static s7_pointer g_getsockopt(s7_scheme *sc, s7_pointer args)
+                  {
+                    int err;
+                    socklen_t res;
+                    res = (socklen_t)s7_integer(s7_list_ref(sc, args, 4));
+                    err = getsockopt(s7_integer(s7_car(args)), s7_integer(s7_cadr(args)), s7_integer(s7_caddr(args)), s7_c_pointer(s7_cadddr(args)), &res);
+                    return(s7_list(sc, 2, s7_make_integer(sc, err), s7_make_integer(sc, (s7_int)res)));
+                  }
+                  static s7_pointer g_setsockopt(s7_scheme *sc, s7_pointer args)
+                  {
+                    socklen_t res;
+                    res = (socklen_t)s7_integer(s7_list_ref(sc, args, 4));
+                    return(s7_make_integer(sc, setsockopt(s7_integer(s7_car(args)), s7_integer(s7_cadr(args)),
+                           s7_integer(s7_caddr(args)), s7_c_pointer(s7_cadddr(args)), res)));
+                  }
+                  static s7_pointer g_recvfrom(s7_scheme *sc, s7_pointer args)
+                  {
+                    int err;
+                    socklen_t res;
+                    res = (socklen_t)s7_integer(s7_list_ref(sc, args, 5));
+                    err = recvfrom(s7_integer(s7_car(args)),
+                  		 s7_c_pointer(s7_cadr(args)),  /* void* buf */
+                  		 s7_integer(s7_caddr(args)),
+                  		 s7_integer(s7_cadddr(args)),
+                  		 (struct sockaddr *)s7_c_pointer(s7_list_ref(sc, args, 4)),
+                  		 &res);
+                    return(s7_list(sc, 2, s7_make_integer(sc, err), s7_make_integer(sc, (s7_int)res)));
+                  }
+
+                  static s7_pointer g_hostent_h_name(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_string(sc, ((struct hostent *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"hostent*\"), __func__, 1))->h_name));}
+                  static s7_pointer g_netent_n_name(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_string(sc, ((struct netent *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"netent*\"), __func__, 1))->n_name));}
+                  static s7_pointer g_servent_s_name(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_string(sc, ((struct servent *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"servent*\"), __func__, 1))->s_name));}
+                  static s7_pointer g_servent_s_proto(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_string(sc, ((struct servent *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"servent*\"), __func__, 1))->s_proto));}
+                  static s7_pointer g_protoent_p_name(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_string(sc, ((struct protoent *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"protoent*\"), __func__, 1))->p_name));}
+
+                  static s7_pointer g_hostent_h_addrtype(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((struct hostent *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"hostent*\"), __func__, 1))->h_addrtype));}
+                  static s7_pointer g_hostent_h_length(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((struct hostent *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"hostent*\"), __func__, 1))->h_length));}
+                  static s7_pointer g_netent_n_addrtype(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((struct netent *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"netent*\"), __func__, 1))->n_addrtype));}
+                  static s7_pointer g_netent_n_net(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((struct netent *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"netent*\"), __func__, 1))->n_net));}
+                  static s7_pointer g_servent_s_port(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((struct servent *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"servent*\"), __func__, 1))->s_port));}
+                  static s7_pointer g_protoent_p_proto(s7_scheme *sc, s7_pointer args)
+                  {return(s7_make_integer(sc, ((struct protoent *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"protoent*\"), __func__, 1))->p_proto));}
+
+                  static s7_pointer g_hostent_h_aliases(s7_scheme *sc, s7_pointer args)
+                  {
+                    s7_pointer p;
+                    char **str;
+                    struct hostent *h;
+                    p = s7_nil(sc);
+                    h = (struct hostent *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"hostent*\"), __func__, 1);
+                    for (str = h->h_aliases; (str) && (*str); str++)
+                      p = s7_cons(sc, s7_make_string(sc, *str), p);
+                    return(p);
+                  }
+                  static s7_pointer g_servent_s_aliases(s7_scheme *sc, s7_pointer args)
+                  {
+                    s7_pointer p;
+                    char **str;
+                    struct servent *h;
+                    p = s7_nil(sc);
+                    h = (struct servent *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"servent*\"), __func__, 1);
+                    for (str = h->s_aliases; (str) && (*str); str++)
+                      p = s7_cons(sc, s7_make_string(sc, *str), p);
+                    return(p);
+                  }
+                  static s7_pointer g_netent_n_aliases(s7_scheme *sc, s7_pointer args)
+                  {
+                    s7_pointer p;
+                    char **str;
+                    struct netent *h;
+                    p = s7_nil(sc);
+                    h = (struct netent *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"netvent*\"), __func__, 1);
+                    for (str = h->n_aliases; (str) && (*str); str++)
+                      p = s7_cons(sc, s7_make_string(sc, *str), p);
+                    return(p);
+                  }
+                  static s7_pointer g_protoent_p_aliases(s7_scheme *sc, s7_pointer args)
+                  {
+                    s7_pointer p;
+                    char **str;
+                    struct protoent *h;
+                    p = s7_nil(sc);
+                    h = (struct protoent *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"protoent*\"), __func__, 1);
+                    for (str = h->p_aliases; (str) && (*str); str++)
+                      p = s7_cons(sc, s7_make_string(sc, *str), p);
+                    return(p);
+                  }
+                 ")
+	   (C-function ("htonl" g_htonl "" 1))
+	   (C-function ("htons" g_htons "" 1))
+	   (C-function ("ntohl" g_ntohl "" 1))
+	   (C-function ("ntohs" g_ntohs "" 1))
+
+	   (C-function ("getaddrinfo" g_getaddrinfo "" 3))
+	   (C-function ("getnameinfo" g_getnameinfo "" 3))
+	   (C-function ("addrinfo.make" g_addrinfo_make "" 0))
+	   (C-function ("addrinfo.ai_flags" g_addrinfo_ai_flags "" 1))
+	   (C-function ("addrinfo.set_ai_flags" g_addrinfo_set_ai_flags "" 2))
+	   (C-function ("addrinfo.ai_family" g_addrinfo_ai_family "" 1))
+	   (C-function ("addrinfo.set_ai_family" g_addrinfo_set_ai_family "" 2))
+	   (C-function ("addrinfo.ai_socktype" g_addrinfo_ai_socktype "" 1))
+	   (C-function ("addrinfo.set_ai_socktype" g_addrinfo_set_ai_socktype "" 2))
+	   (C-function ("addrinfo.ai_protocol" g_addrinfo_ai_protocol "" 1))
+	   (C-function ("addrinfo.set_ai_protocol" g_addrinfo_set_ai_protocol "" 2))
+	   (C-function ("addrinfo.ai_canonname" g_addrinfo_ai_canonname "" 1))
+	   (C-function ("addrinfo.ai_next" g_addrinfo_ai_next "" 1))
+
+	   (C-function ("hostent.h_name" g_hostent_h_name "" 1))
+	   (C-function ("netent.n_name" g_netent_n_name "" 1))
+	   (C-function ("servent.s_name" g_servent_s_name "" 1))
+	   (C-function ("servent.s_proto" g_servent_s_proto "" 1))
+	   (C-function ("protoent.p_name" g_protoent_p_name "" 1))
+	   (C-function ("hostent.h_addrtype" g_hostent_h_addrtype "" 1))
+	   (C-function ("hostent.h_length" g_hostent_h_length "" 1))
+	   (C-function ("netent.n_addrtype" g_netent_n_addrtype "" 1))
+	   (C-function ("netent.n_net" g_netent_n_net "" 1))
+	   (C-function ("servent.s_port" g_servent_s_port "" 1))
+	   (C-function ("protoent.p_proto" g_protoent_p_proto "" 1))
+
+	   (C-function ("hostent.h_aliases" g_hostent_h_aliases "" 1))
+	   (C-function ("servent.s_aliases" g_servent_s_aliases "" 1))
+	   (C-function ("netent.n_aliases" g_netent_n_aliases "" 1))
+	   (C-function ("protoent.p_aliases" g_protoent_p_aliases "" 1))
+	   ;; (define h (gethostbyname "fatty4"))
+	   ;; ((*libc* 'hostent.h_aliases) h) -> ("localhost" "localhost.localdomain")
+
+	   (C-function ("socketpair" g_socketpair "" 3))
+	   (C-function ("getsockname" g_getsockname "" 3))
+	   (C-function ("getpeername" g_getpeername "" 3))
+	   (C-function ("accept" g_accept "" 3))
+	   (C-function ("getsockopt" g_getsockopt "" 5))
+	   (C-function ("setsockopt" g_setsockopt "" 5))
+	   (C-function ("recvfrom" g_recvfrom "" 6))
+
+	   ;; -------- regex.h --------
+
+	   (C-macro (int (REG_NOTBOL REG_NOTEOL REG_NOMATCH REG_ESPACE REG_BADBR REG_BADPAT REG_BADRPT REG_ECOLLATE REG_ECTYPE REG_EESCAPE
+			  REG_ESUBREG REG_EBRACK REG_EPAREN REG_EBRACE REG_ERANGE REG_EXTENDED REG_ICASE REG_NOSUB REG_NEWLINE)))
+
+	   (in-C "
+                  static s7_pointer g_regcomp(s7_scheme *sc, s7_pointer args)
+                  {
+                    int res, flags;
+                    regex_t *regexp;
+                    const char *str;
+                    if (!s7_is_string(s7_cadr(args)))
+                       return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libc* 'regcomp)\", 17), 2, s7_cadr(args), string_string));
+                    if (!s7_is_integer(s7_caddr(args)))
+                       return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libc* 'regcomp)\", 17), 3, s7_caddr(args), integer_string));
+                    regexp = (regex_t *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"regex_t*\"), __func__, 1);
+                    str = (const char *)s7_string(s7_cadr(args));
+                    flags = s7_integer(s7_caddr(args));
+                    res = regcomp(regexp, str, flags);
+                    return(s7_make_integer(sc, res));
+                  }
+
+                  static s7_pointer g_regexec(s7_scheme *sc, s7_pointer args)
+                  {
+                    int i, res, flags, nmatches;
+                    regex_t *regexp;
+                    const char *str;
+                    regmatch_t *matches;
+                    s7_pointer subs;
+                    s7_int *els;
+
+                    if (!s7_is_string(s7_cadr(args)))
+                       return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libc* 'regexec)\", 17), 2, s7_cadr(args), string_string));
+                    if (!s7_is_integer(s7_caddr(args)))
+                       return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libc* 'regexec)\", 17), 3, s7_caddr(args), integer_string));
+                    if (!s7_is_integer(s7_cadddr(args)))
+                       return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libc* 'regexec)\", 17), 4, s7_cadddr(args), integer_string));
+                    regexp = (regex_t *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"regex_t*\"), __func__, 1);
+                    str = (const char *)s7_string(s7_cadr(args));
+                    nmatches = s7_integer(s7_caddr(args));
+                    flags = s7_integer(s7_cadddr(args));
+                    if (nmatches == 0)
+                       return(s7_make_integer(sc, regexec(regexp, str, 0, NULL, flags)));
+                    matches = (regmatch_t *)calloc(nmatches, sizeof(regmatch_t));
+                    res = regexec(regexp, str, nmatches, matches, flags);
+                    if (res != 0)
+                       {
+                         free(matches);
+                         return(s7_make_integer(sc, res));
+                       }
+                    subs = s7_make_int_vector(sc, nmatches * 2, 1, NULL);
+                    els = s7_int_vector_elements(subs);
+                    for (i = 0; i < nmatches; i++)
+                      {
+                        els[i * 2] = matches[i].rm_so;
+                        els[i * 2 + 1] = matches[i].rm_eo;
+                      }
+                    free(matches);
+                    return(subs);
+                  }
+
+                  static s7_pointer g_regex_make(s7_scheme *sc, s7_pointer args)
+                  {
+                    return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(regex_t)), s7_make_symbol(sc, \"regex_t*\"), s7_f(sc)));
+                  }
+
+                  static s7_pointer g_regfree(s7_scheme *sc, s7_pointer args)
+                  {
+                    regfree((regex_t *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"regex_t*\"), __func__, 1));
+                    return(s7_f(sc));
+                  }
+
+                  static s7_pointer g_regex_free(s7_scheme *sc, s7_pointer args)
+                  {
+                    free((void *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"regex_t*\"), __func__, 1));
+                    return(s7_f(sc));
+                  }
+
+                  static s7_pointer g_regerror(s7_scheme *sc, s7_pointer args)
+                  {
+                    size_t len;
+                    int errcode;
+                    regex_t *regexp;
+                    char *err;
+                    s7_pointer result;
+                    errcode = s7_integer(s7_car(args));
+                    regexp = (regex_t *)s7_c_pointer_with_type(sc, s7_cadr(args), s7_make_symbol(sc, \"regex_t*\"), __func__, 1);
+                    len = regerror (errcode, regexp, NULL, 0);
+                    err = (char *)malloc(len);
+                    regerror(errcode, regexp, err, len);
+                    result = s7_make_string_with_length(sc, err, len - 1);
+                    free(err);
+                    return(result);
+                  }
+                 ")
+	   (C-function ("regex.make" g_regex_make "" 0))
+	   (C-function ("regex.free" g_regex_free "" 1))
+	   (C-function ("regfree" g_regfree "" 1))
+	   (C-function ("regcomp" g_regcomp "" 3))
+	   (C-function ("regexec" g_regexec "" 4)) ; (regexec regex string nmatches flags)
+	   (C-function ("regerror" g_regerror "" 2))
+	   )
+
+	 ""
+	 (list "limits.h" "ctype.h" "errno.h" "float.h" "stdint.h" "locale.h" "stdlib.h" "string.h" "fcntl.h"
+	       "fenv.h" "stdio.h" "sys/utsname.h" "unistd.h" "dirent.h" "ftw.h" "sys/stat.h" "time.h" "sys/time.h"
+	       "utime.h" "termios.h" "grp.h" "pwd.h" "fnmatch.h" "glob.h" "signal.h" "sys/wait.h" "netdb.h"
+	       "sys/resource.h" "regex.h"
+	       (reader-cond ((provided? 'linux) "semaphore.h"))
+	       (reader-cond ((not (provided? 'openbsd)) "wordexp.h"))
+	       (reader-cond ((provided? 'freebsd) "sys/socket.h" "netinet/in.h"))
+	       )
+	 ""
+	 (if (provided? 'linux) "-lrt"
+	     (if (provided? 'openbsd) "-pthread" ""))
+	 "libc_s7")
+
+	(curlet))))
+
+*libc*
diff --git a/s7/libdl.scm b/s7/libdl.scm
new file mode 100644
index 0000000..bcac640
--- /dev/null
+++ b/s7/libdl.scm
@@ -0,0 +1,34 @@
+;;; libdl.scm
+;;;
+;;; tie the dynamic loader library into the *libdl* environment
+
+(require cload.scm)
+(provide 'libdl.scm)
+
+;; if loading from a different directory, pass that info to C
+(let ((directory (let ((current-file (port-filename)))
+		   (and (memv (current-file 0) '(#\/ #\~))
+			(substring current-file 0 (- (length current-file) 9))))))
+  (when (and directory (not (member directory *load-path*)))
+    (set! *load-path* (cons directory *load-path*)))
+  (with-let (rootlet)
+    (require cload.scm))
+  (when (and directory (not (string-position directory *cload-cflags*)))
+    (set! *cload-cflags* (string-append "-I" directory " " *cload-cflags*))))
+
+
+(if (not (defined? '*libdl*))
+    (define *libdl*
+      (with-let (sublet (unlet))
+	(set! *libraries* (cons (cons "libdl.scm" (curlet)) *libraries*))
+	(set! *cload-library-name* "*libdl*")
+	(c-define '((void* dlopen (char* int))
+		    (int dlclose (void*))
+		    (void* dlsym (void* char*))
+		    (char* dlerror (void))
+		    (C-macro (int (RTLD_LAZY RTLD_NOW RTLD_BINDING_MASK RTLD_NOLOAD RTLD_DEEPBIND RTLD_GLOBAL RTLD_LOCAL RTLD_NODELETE))))
+		  "" "dlfcn.h" "" "" "libdl_s7")
+	(curlet))))
+
+*libdl*
+;; the loader will return *libdl*
diff --git a/s7/libgdbm.scm b/s7/libgdbm.scm
new file mode 100644
index 0000000..578c7b0
--- /dev/null
+++ b/s7/libgdbm.scm
@@ -0,0 +1,261 @@
+;;; libgdbm.scm
+;;;
+;;; tie libgdbm into s7
+
+(require cload.scm)
+(provide 'libgdbm.scm)
+
+;; if loading from a different directory, pass that info to C
+(let ((directory (let ((current-file (port-filename)))
+		   (and (memv (current-file 0) '(#\/ #\~))
+			(substring current-file 0 (- (length current-file) 9))))))
+  (when (and directory (not (member directory *load-path*)))
+    (set! *load-path* (cons directory *load-path*)))
+  (with-let (rootlet)
+    (require cload.scm))
+  (when (and directory (not (string-position directory *cload-cflags*)))
+    (set! *cload-cflags* (string-append "-I" directory " " *cload-cflags*))))
+
+
+(if (not (defined? '*libgdbm*))
+    (define *libgdbm*
+      (with-let (sublet (unlet))
+	(set! *libraries* (cons (cons "libgdbm.scm" (curlet)) *libraries*))
+	(set! *cload-library-name* "*libgdbm*")
+	
+	(c-define '((C-macro (int (GDBM_READER GDBM_WRITER GDBM_WRCREAT GDBM_NEWDB GDBM_FAST GDBM_SYNC GDBM_NOLOCK
+				   GDBM_INSERT GDBM_REPLACE GDBM_CACHESIZE GDBM_FASTMODE GDBM_SYNCMODE GDBM_CENTFREE 
+				   GDBM_COALESCEBLKS GDBM_OPENMASK GDBM_NOMMAP GDBM_CLOEXEC GDBM_SETCACHESIZE GDBM_SETSYNCMODE 
+				   GDBM_SETCENTFREE GDBM_SETCOALESCEBLKS GDBM_SETMAXMAPSIZE GDBM_SETMMAP GDBM_GETFLAGS GDBM_GETMMAP 
+				   GDBM_GETCACHESIZE GDBM_GETSYNCMODE GDBM_GETCENTFREE GDBM_GETCOALESCEBLKS GDBM_GETMAXMAPSIZE GDBM_GETDBNAME)))
+		    (C-macro (int (GDBM_VERSION_MAJOR GDBM_VERSION_MINOR GDBM_VERSION_PATCH)))
+		    (C-macro (int (GDBM_NO_ERROR GDBM_MALLOC_ERROR GDBM_BLOCK_SIZE_ERROR GDBM_FILE_OPEN_ERROR GDBM_FILE_WRITE_ERROR
+				   GDBM_FILE_SEEK_ERROR GDBM_FILE_READ_ERROR GDBM_BAD_MAGIC_NUMBER GDBM_EMPTY_DATABASE GDBM_CANT_BE_READER
+				   GDBM_CANT_BE_WRITER GDBM_READER_CANT_DELETE GDBM_READER_CANT_STORE GDBM_READER_CANT_REORGANIZE
+				   GDBM_ITEM_NOT_FOUND GDBM_REORGANIZE_FAILED GDBM_CANNOT_REPLACE GDBM_ILLEGAL_DATA
+				   GDBM_OPT_ALREADY_SET GDBM_OPT_ILLEGAL GDBM_BYTE_SWAPPED GDBM_BAD_FILE_OFFSET GDBM_BAD_OPEN_FLAGS
+				   GDBM_FILE_STAT_ERROR GDBM_FILE_EOF)))
+
+		    (in-C "static s7_pointer g_gdbm_version(s7_scheme *sc, s7_pointer args) {return(s7_make_string(sc, gdbm_version));}")
+		    (C-function ("gdbm_version" g_gdbm_version "(gdbm_version) returns the current gbdm version" 0))
+		    (in-C "static s7_pointer g_gdbm_errno(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, gdbm_errno));}")
+		    (C-function ("gdbm_errno" g_gdbm_errno "(gdbm_errno) returns the current gdbm error number" 0))
+		    (char* gdbm_strerror (int))
+
+		    (int gdbm_fdesc ((GDBM_FILE c_pointer)))
+		    (int gdbm_reorganize ((GDBM_FILE c_pointer)))
+		    (void gdbm_close ((GDBM_FILE c_pointer)))
+		    (void gdbm_sync ((GDBM_FILE c_pointer)))
+
+		    ;(int gdbm_export ((GDBM_FILE c_pointer) char* int int))
+		    ;(int gdbm_import ((GDBM_FILE c_pointer) char* int))
+
+		    (in-C "
+static void *make_datum(datum key) {datum *p; p = (datum *)malloc(sizeof(datum)); p->dptr = key.dptr; p->dsize = key.dsize; return((void *)p);}
+static s7_pointer g_gdbm_firstkey(s7_scheme *sc, s7_pointer args)
+{
+  if (s7_is_c_pointer(s7_car(args)))
+    {
+      datum key;
+      key = gdbm_firstkey((GDBM_FILE)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"GDBM_FILE\"), __func__, 0));
+      if (key.dptr)
+         return(s7_cons(sc, s7_make_string_with_length(sc, key.dptr, key.dsize), 
+                            s7_make_c_pointer_with_type(sc, make_datum(key), s7_make_symbol(sc, \"datum*\"), s7_f(sc))));
+      return(s7_eof_object(sc));
+    }
+  return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libgdbm* 'firstkey)\", 21), 0, s7_car(args), 
+                                 s7_make_string_wrapper_with_length(sc, \"a gdbm file\", 11)));
+}
+
+static s7_pointer g_gdbm_nextkey(s7_scheme *sc, s7_pointer args)
+{
+  if (s7_is_c_pointer(s7_car(args)))
+    {
+      if (s7_is_c_pointer(s7_cadr(args)))
+        {
+	  datum *p;
+          datum key, rtn;
+          p = (datum *)s7_c_pointer_with_type(sc, s7_cadr(args), s7_make_symbol(sc, \"datum*\"), __func__, 2);
+	  key.dptr = p->dptr;
+	  key.dsize = p->dsize;
+          rtn = gdbm_nextkey((GDBM_FILE)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"GDBM_FILE\"), __func__, 0), key);
+          free(key.dptr);
+	  free(p);
+          if (rtn.dptr)
+	     return(s7_cons(sc, s7_make_string_with_length(sc, rtn.dptr, rtn.dsize), 
+                                s7_make_c_pointer_with_type(sc, make_datum(rtn), s7_make_symbol(sc, \"datum*\"), s7_f(sc))));
+          return(s7_eof_object(sc));
+	}
+      return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libgdbm* 'nextkey)\", 20), 2, s7_cadr(args), string_string));
+    }
+  return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libgdbm* 'nextkey)\", 20), 1, s7_car(args), 
+                                 s7_make_string_wrapper_with_length(sc, \"a gdbm file\", 11)));
+}
+
+static s7_pointer g_gdbm_exists(s7_scheme *sc, s7_pointer args)
+{
+  if (s7_is_c_pointer(s7_car(args)))
+    {
+      if (s7_is_string(s7_cadr(args)))
+        {
+          datum key;
+          key.dptr = (char *)s7_string(s7_cadr(args));
+          key.dsize = (int)s7_string_length(s7_cadr(args));
+          return(s7_make_integer(sc, gdbm_exists((GDBM_FILE)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"GDBM_FILE\"), __func__, 0), key)));
+	}
+      return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libgdbm* 'exists)\", 19), 2, s7_cadr(args), string_string));
+    }
+  return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libgdbm* 'exists)\", 19), 1, s7_car(args), 
+                                 s7_make_string_wrapper_with_length(sc, \"a gdbm file\", 11)));
+}
+
+static s7_pointer g_gdbm_delete(s7_scheme *sc, s7_pointer args)
+{
+  if (s7_is_c_pointer(s7_car(args)))
+    {
+      if (s7_is_string(s7_cadr(args)))
+        {
+          datum key;
+          key.dptr = (char *)s7_string(s7_cadr(args));
+          key.dsize = (int)s7_string_length(s7_cadr(args));
+          return(s7_make_integer(sc, gdbm_delete((GDBM_FILE)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"GDBM_FILE\"), __func__, 0), key)));
+        }  
+      return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libgdbm* 'delete)\", 19), 2, s7_cadr(args), string_string));
+    }
+  return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libgdbm* 'delete)\", 19), 1, s7_car(args), 
+                                 s7_make_string_wrapper_with_length(sc, \"a gdbm file\", 11)));
+}
+
+static s7_pointer g_gdbm_fetch(s7_scheme *sc, s7_pointer args)
+{
+  if (s7_is_c_pointer(s7_car(args)))
+    {
+      if (s7_is_string(s7_cadr(args)))
+        {
+          datum key, rtn;
+          key.dptr = (char *)s7_string(s7_cadr(args));
+          key.dsize = (int)s7_string_length(s7_cadr(args));
+          rtn = gdbm_fetch((GDBM_FILE)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"GDBM_FILE\"), __func__, 0), key);
+          if (rtn.dptr)
+            {
+  	      s7_pointer result;
+              result = s7_make_string_with_length(sc, rtn.dptr, rtn.dsize - 1);
+              free(rtn.dptr);
+              return(result);
+	    }
+          else return(s7_make_string_with_length(sc, \"#<undefined>\", 12));
+	}
+      return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libgdbm* 'fetch)\", 18), 2, s7_cadr(args), string_string));
+    }
+  return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libgdbm* 'fetch)\", 18), 1, s7_car(args), 
+                                 s7_make_string_wrapper_with_length(sc, \"a gdbm file\", 11)));
+}
+
+static s7_pointer g_gdbm_store(s7_scheme *sc, s7_pointer args)
+{
+  if (s7_is_c_pointer(s7_car(args)))
+    {
+      if (s7_is_string(s7_cadr(args)))
+        {
+          if (s7_is_string(s7_caddr(args)))
+            {
+              if (s7_is_integer(s7_cadddr(args)))
+                {
+                  datum key, val;
+                  key.dptr = (char *)s7_string(s7_cadr(args));
+                  key.dsize = (int)s7_string_length(s7_cadr(args));
+                  val.dptr = (char *)s7_string(s7_caddr(args));
+                  val.dsize = (int)s7_string_length(s7_caddr(args)) + 1;
+                  return(s7_make_integer(sc, gdbm_store((GDBM_FILE)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"GDBM_FILE\"), __func__, 1),
+                                                        key, val, (int)s7_integer(s7_cadddr(args)))));
+                }
+              return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libgdbm* 'store)\", 18), 4, s7_cadddr(args), 
+                                             s7_make_string_wrapper_with_length(sc, \"an integer (flag)\", 17)));
+	    }
+          return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libgdbm* 'store)\", 18), 3, s7_caddr(args), string_string));
+	}
+      return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libgdbm* 'store)\", 18), 2, s7_cadr(args), string_string));
+    }
+  return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libgdbm* 'store)\", 18), 1, s7_car(args), 
+                                 s7_make_string_wrapper_with_length(sc, \"a gdbm file\", 11)));
+}
+
+static s7_pointer open_error_func = NULL;
+static s7_scheme *open_error_s7 = NULL;
+static void gdbm_open_error(const char *name)
+{
+  if (open_error_func)
+    s7_apply_function(open_error_s7, open_error_func, s7_list(open_error_s7, 1, s7_make_string(open_error_s7, name)));
+}
+
+static s7_pointer g_gdbm_open(s7_scheme *sc, s7_pointer args)
+{
+  if (s7_is_string(s7_car(args)))
+    {
+      char *name;
+      name = (char *)s7_string(s7_car(args));
+      args = s7_cdr(args);
+      if (s7_is_integer(s7_car(args)))
+        {
+	  int block_size;
+          block_size = (int)s7_integer(s7_car(args));
+          args = s7_cdr(args);
+          if (s7_is_integer(s7_car(args)))
+            {
+	      int flags;
+              flags = (int)s7_integer(s7_car(args));
+              args = s7_cdr(args);
+              if (s7_is_integer(s7_car(args)))
+                {
+	          int mode;
+                  mode = (int)s7_integer(s7_car(args));
+		  if (s7_is_procedure(s7_cadr(args)))
+		    {
+                      open_error_func = s7_cadr(args);
+                      open_error_s7 = sc;
+                    }
+                  else
+		    {
+                      open_error_func = NULL;
+                      open_error_s7 = NULL;
+                    }
+                  return(s7_make_c_pointer_with_type(sc, (void *)gdbm_open(name, block_size, flags, mode, gdbm_open_error), s7_make_symbol(sc, \"GDBM_FILE\"), s7_f(sc)));
+                }
+              return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libgdbm* 'open)\", 17), 4, s7_car(args), 
+                                             s7_make_string_wrapper_with_length(sc, \"an integer (mode)\", 17)));
+            }
+          return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libgdbm* 'open)\", 17), 3, s7_car(args), 
+                                         s7_make_string_wrapper_with_length(sc, \"an integer (flags)\", 18)));
+        }
+      return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libgdbm* 'open)\", 17), 2, s7_car(args), 
+                                     s7_make_string_wrapper_with_length(sc, \"an integer (block_size)\", 23)));
+    }
+  return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libgdbm* 'open)\", 17), 1, s7_car(args), string_string));
+}
+")
+                    (C-function ("gdbm_firstkey" g_gdbm_firstkey "(gdbm_firstkey gdbm)" 1))
+                    (C-function ("gdbm_exists" g_gdbm_exists "(gdbm_exists gdbm key)" 2))
+                    (C-function ("gdbm_delete" g_gdbm_delete "(gdbm_delete gdbm key)" 2))
+                    (C-function ("gdbm_nextkey" g_gdbm_nextkey "(gdbm_nextkey gdbm prev)" 2))
+                    (C-function ("gdbm_fetch" g_gdbm_fetch "(gdbm_fetch gdbm key)" 2))
+                    (C-function ("gdbm_store" g_gdbm_store "(gdbm_store gdbm key context flag)" 4))
+                    (C-function ("gdbm_open" g_gdbm_open "(gdbm_open filename size flags mode func) opens a gdbm data base" 5))
+
+		    )
+		  "" "gdbm.h" "" "-lgdbm" "libgdbm_s7")
+	
+	(curlet))))
+
+*libgdbm*
+
+
+
+;;; extern int gdbm_setopt (GDBM_FILE, int, void *, int)
+;;; this is a huge mess
+
+#|
+(define gfile ((*libgdbm* 'gdbm_open) "test.gdbm" 1024 (*libgdbm* 'GDBM_NEWDB) #o664 (lambda (str) (format *stderr* "str: ~S~%" str))))
+((*libgdbm* 'gdbm_store) gfile "1" "1234" (*libgdbm* 'GDBM_REPLACE))
+((*libgdbm* 'gdbm_fetch) gfile "1")
+((*libgdbm* 'gdbm_close) gfile)
+|#
diff --git a/s7/libgsl.scm b/s7/libgsl.scm
new file mode 100644
index 0000000..119feee
--- /dev/null
+++ b/s7/libgsl.scm
@@ -0,0 +1,3320 @@
+;;; libgsl.scm
+;;;
+;;; tie the gsl library into the *libgsl* environment
+
+(require cload.scm)
+(provide 'libgsl.scm)
+
+;; if loading from a different directory, pass that info to C
+(let ((directory (let ((current-file (port-filename)))
+		   (and (memv (current-file 0) '(#\/ #\~))
+			(substring current-file 0 (- (length current-file) 9))))))
+  (when (and directory (not (member directory *load-path*)))
+    (set! *load-path* (cons directory *load-path*)))
+  (with-let (rootlet)
+    (require cload.scm))
+  (when (and directory (not (string-position directory *cload-cflags*)))
+    (set! *cload-cflags* (string-append "-I" directory " " *cload-cflags*))))
+
+
+(when (provided? 'pure-s7)
+  (define (make-polar mag ang)
+    (if (and (real? mag) (real? ang))
+	(complex (* mag (cos ang)) (* mag (sin ang)))
+	(error 'wrong-type-arg "make-polar args should be real"))))
+
+
+;; since we might be loading this locally, reader-cond (in that case) won't find gsl-version unless...
+(unless (defined? '*libgsl*)
+  (with-let (rootlet)
+    (define gsl-version 0.0)		; define at top-level no matter where we are now
+    (when (and (provided? 'linux)
+	       (defined? 'system))
+      (let* ((version (#_system "pkg-config gsl --modversion" #t))
+	     (len (length version)))
+	(when (positive? len)
+	  (set! gsl-version (string->number (if (char=? (version (- len 1)) #\newline)
+						(substring version 0 (- len 1))
+						version)))
+	  (unless (number? gsl-version) ; "2.2.1" -> 2.2?
+	    (let ((i1 (char-position #\. version (+ (char-position #\. version) 1))))
+	      (if (integer? i1)
+		  (set! gsl-version (string->number (substring version 0 i1)))))))))))
+
+(unless (defined? '*libgsl*)
+  (define *libgsl*
+    (with-let (sublet (unlet))
+      (define GSL_REAL real-part)
+      (define GSL_IMAG imag-part)
+      (define GSL_COMPLEX_EQ equal?)
+      (define GSL_COMPLEX_ONE 1.0)
+      (define GSL_COMPLEX_ZERO 0.0)
+      (define GSL_COMPLEX_NEGONE -1.0)
+      (define gsl_complex_polar make-polar)
+      (define gsl_complex_rect complex)
+      (define GSL_IS_ODD odd?)
+      (define GSL_IS_EVEN even?)
+      (define (GSL_IS_REAL n) (and (number? n) (not (nan? n)) (not (infinite? n))))
+      (define (GSL_SIGN x) (if (negative? x) -1 1))
+      (define GSL_MAX max)
+      (define GSL_MIN min)
+      (define GSL_MAX_INT max)
+      (define GSL_MIN_INT min)
+      (define GSL_MAX_DBL max)
+      (define GSL_MIN_DBL min)
+      (define gsl_max max)
+      (define gsl_min min)
+
+      (set! *libraries* (cons (cons "libgsl.scm" (curlet)) *libraries*))
+      (set! *cload-library-name* "*libgsl*")
+
+      (c-define
+       '((C-macro (double (GSL_CONST_CGS_SPEED_OF_LIGHT GSL_CONST_CGS_GRAVITATIONAL_CONSTANT GSL_CONST_CGS_PLANCKS_CONSTANT_H
+			   GSL_CONST_CGS_PLANCKS_CONSTANT_HBAR GSL_CONST_CGS_ASTRONOMICAL_UNIT GSL_CONST_CGS_LIGHT_YEAR
+			   GSL_CONST_CGS_PARSEC GSL_CONST_CGS_GRAV_ACCEL GSL_CONST_CGS_ELECTRON_VOLT GSL_CONST_CGS_MASS_ELECTRON
+			   GSL_CONST_CGS_MASS_MUON GSL_CONST_CGS_MASS_PROTON GSL_CONST_CGS_MASS_NEUTRON GSL_CONST_CGS_RYDBERG
+			   GSL_CONST_CGS_BOLTZMANN GSL_CONST_CGS_MOLAR_GAS GSL_CONST_CGS_STANDARD_GAS_VOLUME GSL_CONST_CGS_MINUTE
+			   GSL_CONST_CGS_HOUR GSL_CONST_CGS_DAY GSL_CONST_CGS_WEEK GSL_CONST_CGS_INCH GSL_CONST_CGS_FOOT
+			   GSL_CONST_CGS_YARD GSL_CONST_CGS_MILE GSL_CONST_CGS_NAUTICAL_MILE GSL_CONST_CGS_FATHOM GSL_CONST_CGS_MIL
+			   GSL_CONST_CGS_POINT GSL_CONST_CGS_TEXPOINT GSL_CONST_CGS_MICRON GSL_CONST_CGS_ANGSTROM GSL_CONST_CGS_HECTARE
+			   GSL_CONST_CGS_ACRE GSL_CONST_CGS_BARN GSL_CONST_CGS_LITER GSL_CONST_CGS_US_GALLON GSL_CONST_CGS_QUART
+			   GSL_CONST_CGS_PINT GSL_CONST_CGS_CUP GSL_CONST_CGS_FLUID_OUNCE GSL_CONST_CGS_TABLESPOON GSL_CONST_CGS_TEASPOON
+			   GSL_CONST_CGS_CANADIAN_GALLON GSL_CONST_CGS_UK_GALLON GSL_CONST_CGS_MILES_PER_HOUR GSL_CONST_CGS_KILOMETERS_PER_HOUR
+			   GSL_CONST_CGS_KNOT GSL_CONST_CGS_POUND_MASS GSL_CONST_CGS_OUNCE_MASS GSL_CONST_CGS_TON GSL_CONST_CGS_METRIC_TON
+			   GSL_CONST_CGS_UK_TON GSL_CONST_CGS_TROY_OUNCE GSL_CONST_CGS_CARAT GSL_CONST_CGS_UNIFIED_ATOMIC_MASS
+			   GSL_CONST_CGS_GRAM_FORCE GSL_CONST_CGS_POUND_FORCE GSL_CONST_CGS_KILOPOUND_FORCE GSL_CONST_CGS_POUNDAL
+			   GSL_CONST_CGS_CALORIE GSL_CONST_CGS_BTU GSL_CONST_CGS_THERM GSL_CONST_CGS_HORSEPOWER GSL_CONST_CGS_BAR
+			   GSL_CONST_CGS_STD_ATMOSPHERE GSL_CONST_CGS_TORR GSL_CONST_CGS_METER_OF_MERCURY GSL_CONST_CGS_INCH_OF_MERCURY
+			   GSL_CONST_CGS_INCH_OF_WATER GSL_CONST_CGS_PSI GSL_CONST_CGS_POISE GSL_CONST_CGS_STOKES GSL_CONST_CGS_STILB
+			   GSL_CONST_CGS_LUMEN GSL_CONST_CGS_LUX GSL_CONST_CGS_PHOT GSL_CONST_CGS_FOOTCANDLE GSL_CONST_CGS_LAMBERT
+			   GSL_CONST_CGS_FOOTLAMBERT GSL_CONST_CGS_CURIE GSL_CONST_CGS_ROENTGEN GSL_CONST_CGS_RAD GSL_CONST_CGS_SOLAR_MASS
+			   GSL_CONST_CGS_BOHR_RADIUS GSL_CONST_CGS_NEWTON GSL_CONST_CGS_DYNE GSL_CONST_CGS_JOULE GSL_CONST_CGS_ERG
+			   GSL_CONST_CGS_STEFAN_BOLTZMANN_CONSTANT GSL_CONST_CGS_THOMSON_CROSS_SECTION GSL_CONST_CGSM_SPEED_OF_LIGHT
+			   GSL_CONST_CGSM_GRAVITATIONAL_CONSTANT GSL_CONST_CGSM_PLANCKS_CONSTANT_H GSL_CONST_CGSM_PLANCKS_CONSTANT_HBAR
+			   GSL_CONST_CGSM_ASTRONOMICAL_UNIT GSL_CONST_CGSM_LIGHT_YEAR GSL_CONST_CGSM_PARSEC GSL_CONST_CGSM_GRAV_ACCEL
+			   GSL_CONST_CGSM_ELECTRON_VOLT GSL_CONST_CGSM_MASS_ELECTRON GSL_CONST_CGSM_MASS_MUON GSL_CONST_CGSM_MASS_PROTON
+			   GSL_CONST_CGSM_MASS_NEUTRON GSL_CONST_CGSM_RYDBERG GSL_CONST_CGSM_BOLTZMANN GSL_CONST_CGSM_MOLAR_GAS
+			   GSL_CONST_CGSM_STANDARD_GAS_VOLUME GSL_CONST_CGSM_MINUTE GSL_CONST_CGSM_HOUR GSL_CONST_CGSM_DAY
+			   GSL_CONST_CGSM_WEEK GSL_CONST_CGSM_INCH GSL_CONST_CGSM_FOOT GSL_CONST_CGSM_YARD GSL_CONST_CGSM_MILE
+			   GSL_CONST_CGSM_NAUTICAL_MILE GSL_CONST_CGSM_FATHOM GSL_CONST_CGSM_MIL GSL_CONST_CGSM_POINT GSL_CONST_CGSM_TEXPOINT
+			   GSL_CONST_CGSM_MICRON GSL_CONST_CGSM_ANGSTROM GSL_CONST_CGSM_HECTARE GSL_CONST_CGSM_ACRE GSL_CONST_CGSM_BARN
+			   GSL_CONST_CGSM_LITER GSL_CONST_CGSM_US_GALLON GSL_CONST_CGSM_QUART GSL_CONST_CGSM_PINT GSL_CONST_CGSM_CUP
+			   GSL_CONST_CGSM_FLUID_OUNCE GSL_CONST_CGSM_TABLESPOON GSL_CONST_CGSM_TEASPOON GSL_CONST_CGSM_CANADIAN_GALLON
+			   GSL_CONST_CGSM_UK_GALLON GSL_CONST_CGSM_MILES_PER_HOUR GSL_CONST_CGSM_KILOMETERS_PER_HOUR GSL_CONST_CGSM_KNOT
+			   GSL_CONST_CGSM_POUND_MASS GSL_CONST_CGSM_OUNCE_MASS GSL_CONST_CGSM_TON GSL_CONST_CGSM_METRIC_TON
+			   GSL_CONST_CGSM_UK_TON GSL_CONST_CGSM_TROY_OUNCE GSL_CONST_CGSM_CARAT GSL_CONST_CGSM_UNIFIED_ATOMIC_MASS
+			   GSL_CONST_CGSM_GRAM_FORCE GSL_CONST_CGSM_POUND_FORCE GSL_CONST_CGSM_KILOPOUND_FORCE GSL_CONST_CGSM_POUNDAL
+			   GSL_CONST_CGSM_CALORIE GSL_CONST_CGSM_BTU GSL_CONST_CGSM_THERM GSL_CONST_CGSM_HORSEPOWER GSL_CONST_CGSM_BAR
+			   GSL_CONST_CGSM_STD_ATMOSPHERE GSL_CONST_CGSM_TORR GSL_CONST_CGSM_METER_OF_MERCURY GSL_CONST_CGSM_INCH_OF_MERCURY
+			   GSL_CONST_CGSM_INCH_OF_WATER GSL_CONST_CGSM_PSI GSL_CONST_CGSM_POISE GSL_CONST_CGSM_STOKES GSL_CONST_CGSM_STILB
+			   GSL_CONST_CGSM_LUMEN GSL_CONST_CGSM_LUX GSL_CONST_CGSM_PHOT GSL_CONST_CGSM_FOOTCANDLE GSL_CONST_CGSM_LAMBERT
+			   GSL_CONST_CGSM_FOOTLAMBERT GSL_CONST_CGSM_CURIE GSL_CONST_CGSM_ROENTGEN GSL_CONST_CGSM_RAD GSL_CONST_CGSM_SOLAR_MASS
+			   GSL_CONST_CGSM_BOHR_RADIUS GSL_CONST_CGSM_NEWTON GSL_CONST_CGSM_DYNE GSL_CONST_CGSM_JOULE GSL_CONST_CGSM_ERG
+			   GSL_CONST_CGSM_STEFAN_BOLTZMANN_CONSTANT GSL_CONST_CGSM_THOMSON_CROSS_SECTION GSL_CONST_CGSM_BOHR_MAGNETON
+			   GSL_CONST_CGSM_NUCLEAR_MAGNETON GSL_CONST_CGSM_ELECTRON_MAGNETIC_MOMENT GSL_CONST_CGSM_PROTON_MAGNETIC_MOMENT
+			   GSL_CONST_CGSM_FARADAY GSL_CONST_CGSM_ELECTRON_CHARGE GSL_CONST_MKS_SPEED_OF_LIGHT GSL_CONST_MKS_GRAVITATIONAL_CONSTANT
+			   GSL_CONST_MKS_PLANCKS_CONSTANT_H GSL_CONST_MKS_PLANCKS_CONSTANT_HBAR GSL_CONST_MKS_ASTRONOMICAL_UNIT
+			   GSL_CONST_MKS_LIGHT_YEAR GSL_CONST_MKS_PARSEC GSL_CONST_MKS_GRAV_ACCEL GSL_CONST_MKS_ELECTRON_VOLT
+			   GSL_CONST_MKS_MASS_ELECTRON GSL_CONST_MKS_MASS_MUON GSL_CONST_MKS_MASS_PROTON GSL_CONST_MKS_MASS_NEUTRON
+			   GSL_CONST_MKS_RYDBERG GSL_CONST_MKS_BOLTZMANN GSL_CONST_MKS_MOLAR_GAS GSL_CONST_MKS_STANDARD_GAS_VOLUME
+			   GSL_CONST_MKS_MINUTE GSL_CONST_MKS_HOUR GSL_CONST_MKS_DAY GSL_CONST_MKS_WEEK GSL_CONST_MKS_INCH GSL_CONST_MKS_FOOT
+			   GSL_CONST_MKS_YARD GSL_CONST_MKS_MILE GSL_CONST_MKS_NAUTICAL_MILE GSL_CONST_MKS_FATHOM GSL_CONST_MKS_MIL
+			   GSL_CONST_MKS_POINT GSL_CONST_MKS_TEXPOINT GSL_CONST_MKS_MICRON GSL_CONST_MKS_ANGSTROM GSL_CONST_MKS_HECTARE
+			   GSL_CONST_MKS_ACRE GSL_CONST_MKS_BARN GSL_CONST_MKS_LITER GSL_CONST_MKS_US_GALLON GSL_CONST_MKS_QUART
+			   GSL_CONST_MKS_PINT GSL_CONST_MKS_CUP GSL_CONST_MKS_FLUID_OUNCE GSL_CONST_MKS_TABLESPOON GSL_CONST_MKS_TEASPOON
+			   GSL_CONST_MKS_CANADIAN_GALLON GSL_CONST_MKS_UK_GALLON GSL_CONST_MKS_MILES_PER_HOUR GSL_CONST_MKS_KILOMETERS_PER_HOUR
+			   GSL_CONST_MKS_KNOT GSL_CONST_MKS_POUND_MASS GSL_CONST_MKS_OUNCE_MASS GSL_CONST_MKS_TON GSL_CONST_MKS_METRIC_TON
+			   GSL_CONST_MKS_UK_TON GSL_CONST_MKS_TROY_OUNCE GSL_CONST_MKS_CARAT GSL_CONST_MKS_UNIFIED_ATOMIC_MASS
+			   GSL_CONST_MKS_GRAM_FORCE GSL_CONST_MKS_POUND_FORCE GSL_CONST_MKS_KILOPOUND_FORCE GSL_CONST_MKS_POUNDAL
+			   GSL_CONST_MKS_CALORIE GSL_CONST_MKS_BTU GSL_CONST_MKS_THERM GSL_CONST_MKS_HORSEPOWER GSL_CONST_MKS_BAR
+			   GSL_CONST_MKS_STD_ATMOSPHERE GSL_CONST_MKS_TORR GSL_CONST_MKS_METER_OF_MERCURY GSL_CONST_MKS_INCH_OF_MERCURY
+			   GSL_CONST_MKS_INCH_OF_WATER GSL_CONST_MKS_PSI GSL_CONST_MKS_POISE GSL_CONST_MKS_STOKES GSL_CONST_MKS_STILB
+			   GSL_CONST_MKS_LUMEN GSL_CONST_MKS_LUX GSL_CONST_MKS_PHOT GSL_CONST_MKS_FOOTCANDLE GSL_CONST_MKS_LAMBERT GSL_CONST_MKS_FOOTLAMBERT
+			   GSL_CONST_MKS_CURIE GSL_CONST_MKS_ROENTGEN GSL_CONST_MKS_RAD GSL_CONST_MKS_SOLAR_MASS GSL_CONST_MKS_BOHR_RADIUS
+			   GSL_CONST_MKS_NEWTON GSL_CONST_MKS_DYNE GSL_CONST_MKS_JOULE GSL_CONST_MKS_ERG GSL_CONST_MKS_STEFAN_BOLTZMANN_CONSTANT
+			   GSL_CONST_MKS_THOMSON_CROSS_SECTION GSL_CONST_MKS_BOHR_MAGNETON GSL_CONST_MKS_NUCLEAR_MAGNETON
+			   GSL_CONST_MKS_ELECTRON_MAGNETIC_MOMENT GSL_CONST_MKS_PROTON_MAGNETIC_MOMENT GSL_CONST_MKS_FARADAY
+			   GSL_CONST_MKS_ELECTRON_CHARGE GSL_CONST_MKS_VACUUM_PERMITTIVITY GSL_CONST_MKS_VACUUM_PERMEABILITY GSL_CONST_MKS_DEBYE
+			   GSL_CONST_MKS_GAUSS GSL_CONST_MKSA_SPEED_OF_LIGHT GSL_CONST_MKSA_GRAVITATIONAL_CONSTANT GSL_CONST_MKSA_PLANCKS_CONSTANT_H
+			   GSL_CONST_MKSA_PLANCKS_CONSTANT_HBAR GSL_CONST_MKSA_ASTRONOMICAL_UNIT GSL_CONST_MKSA_LIGHT_YEAR GSL_CONST_MKSA_PARSEC
+			   GSL_CONST_MKSA_GRAV_ACCEL GSL_CONST_MKSA_ELECTRON_VOLT GSL_CONST_MKSA_MASS_ELECTRON GSL_CONST_MKSA_MASS_MUON
+			   GSL_CONST_MKSA_MASS_PROTON GSL_CONST_MKSA_MASS_NEUTRON GSL_CONST_MKSA_RYDBERG GSL_CONST_MKSA_BOLTZMANN
+			   GSL_CONST_MKSA_MOLAR_GAS GSL_CONST_MKSA_STANDARD_GAS_VOLUME GSL_CONST_MKSA_MINUTE GSL_CONST_MKSA_HOUR
+			   GSL_CONST_MKSA_DAY GSL_CONST_MKSA_WEEK GSL_CONST_MKSA_INCH GSL_CONST_MKSA_FOOT GSL_CONST_MKSA_YARD
+			   GSL_CONST_MKSA_MILE GSL_CONST_MKSA_NAUTICAL_MILE GSL_CONST_MKSA_FATHOM GSL_CONST_MKSA_MIL GSL_CONST_MKSA_POINT
+			   GSL_CONST_MKSA_TEXPOINT GSL_CONST_MKSA_MICRON GSL_CONST_MKSA_ANGSTROM GSL_CONST_MKSA_HECTARE GSL_CONST_MKSA_ACRE
+			   GSL_CONST_MKSA_BARN GSL_CONST_MKSA_LITER GSL_CONST_MKSA_US_GALLON GSL_CONST_MKSA_QUART GSL_CONST_MKSA_PINT
+			   GSL_CONST_MKSA_CUP GSL_CONST_MKSA_FLUID_OUNCE GSL_CONST_MKSA_TABLESPOON GSL_CONST_MKSA_TEASPOON GSL_CONST_MKSA_CANADIAN_GALLON
+			   GSL_CONST_MKSA_UK_GALLON GSL_CONST_MKSA_MILES_PER_HOUR GSL_CONST_MKSA_KILOMETERS_PER_HOUR GSL_CONST_MKSA_KNOT
+			   GSL_CONST_MKSA_POUND_MASS GSL_CONST_MKSA_OUNCE_MASS GSL_CONST_MKSA_TON GSL_CONST_MKSA_METRIC_TON GSL_CONST_MKSA_UK_TON
+			   GSL_CONST_MKSA_TROY_OUNCE GSL_CONST_MKSA_CARAT GSL_CONST_MKSA_UNIFIED_ATOMIC_MASS GSL_CONST_MKSA_GRAM_FORCE
+			   GSL_CONST_MKSA_POUND_FORCE GSL_CONST_MKSA_KILOPOUND_FORCE GSL_CONST_MKSA_POUNDAL GSL_CONST_MKSA_CALORIE GSL_CONST_MKSA_BTU
+			   GSL_CONST_MKSA_THERM GSL_CONST_MKSA_HORSEPOWER GSL_CONST_MKSA_BAR GSL_CONST_MKSA_STD_ATMOSPHERE GSL_CONST_MKSA_TORR
+			   GSL_CONST_MKSA_METER_OF_MERCURY GSL_CONST_MKSA_INCH_OF_MERCURY GSL_CONST_MKSA_INCH_OF_WATER GSL_CONST_MKSA_PSI
+			   GSL_CONST_MKSA_POISE GSL_CONST_MKSA_STOKES GSL_CONST_MKSA_STILB GSL_CONST_MKSA_LUMEN GSL_CONST_MKSA_LUX GSL_CONST_MKSA_PHOT
+			   GSL_CONST_MKSA_FOOTCANDLE GSL_CONST_MKSA_LAMBERT GSL_CONST_MKSA_FOOTLAMBERT GSL_CONST_MKSA_CURIE GSL_CONST_MKSA_ROENTGEN
+			   GSL_CONST_MKSA_RAD GSL_CONST_MKSA_SOLAR_MASS GSL_CONST_MKSA_BOHR_RADIUS GSL_CONST_MKSA_NEWTON GSL_CONST_MKSA_DYNE
+			   GSL_CONST_MKSA_JOULE GSL_CONST_MKSA_ERG GSL_CONST_MKSA_STEFAN_BOLTZMANN_CONSTANT GSL_CONST_MKSA_THOMSON_CROSS_SECTION
+			   GSL_CONST_MKSA_BOHR_MAGNETON GSL_CONST_MKSA_NUCLEAR_MAGNETON GSL_CONST_MKSA_ELECTRON_MAGNETIC_MOMENT
+			   GSL_CONST_MKSA_PROTON_MAGNETIC_MOMENT GSL_CONST_MKSA_FARADAY GSL_CONST_MKSA_ELECTRON_CHARGE GSL_CONST_MKSA_VACUUM_PERMITTIVITY
+			   GSL_CONST_MKSA_VACUUM_PERMEABILITY GSL_CONST_MKSA_DEBYE GSL_CONST_MKSA_GAUSS GSL_CONST_NUM_FINE_STRUCTURE GSL_CONST_NUM_AVOGADRO
+			   GSL_CONST_NUM_YOTTA GSL_CONST_NUM_ZETTA GSL_CONST_NUM_EXA GSL_CONST_NUM_PETA GSL_CONST_NUM_TERA GSL_CONST_NUM_GIGA
+			   GSL_CONST_NUM_MEGA GSL_CONST_NUM_KILO GSL_CONST_NUM_MILLI GSL_CONST_NUM_MICRO GSL_CONST_NUM_NANO GSL_CONST_NUM_PICO
+			   GSL_CONST_NUM_FEMTO GSL_CONST_NUM_ATTO GSL_CONST_NUM_ZEPTO GSL_CONST_NUM_YOCTO
+			   GSL_DBL_EPSILON GSL_SQRT_DBL_EPSILON GSL_ROOT3_DBL_EPSILON GSL_ROOT4_DBL_EPSILON GSL_ROOT5_DBL_EPSILON
+			   GSL_ROOT6_DBL_EPSILON GSL_LOG_DBL_EPSILON GSL_DBL_MIN GSL_SQRT_DBL_MIN GSL_ROOT3_DBL_MIN GSL_ROOT4_DBL_MIN
+			   GSL_ROOT5_DBL_MIN GSL_ROOT6_DBL_MIN GSL_LOG_DBL_MIN GSL_DBL_MAX GSL_SQRT_DBL_MAX GSL_ROOT3_DBL_MAX
+			   GSL_ROOT4_DBL_MAX GSL_ROOT5_DBL_MAX GSL_ROOT6_DBL_MAX GSL_LOG_DBL_MAX GSL_FLT_EPSILON GSL_SQRT_FLT_EPSILON
+			   GSL_ROOT3_FLT_EPSILON GSL_ROOT4_FLT_EPSILON GSL_ROOT5_FLT_EPSILON GSL_ROOT6_FLT_EPSILON GSL_LOG_FLT_EPSILON
+			   GSL_FLT_MIN GSL_SQRT_FLT_MIN GSL_ROOT3_FLT_MIN GSL_ROOT4_FLT_MIN GSL_ROOT5_FLT_MIN GSL_ROOT6_FLT_MIN
+			   GSL_LOG_FLT_MIN GSL_FLT_MAX GSL_SQRT_FLT_MAX GSL_ROOT3_FLT_MAX GSL_ROOT4_FLT_MAX GSL_ROOT5_FLT_MAX
+			   GSL_ROOT6_FLT_MAX GSL_LOG_FLT_MAX GSL_SFLT_EPSILON GSL_SQRT_SFLT_EPSILON GSL_ROOT3_SFLT_EPSILON GSL_ROOT4_SFLT_EPSILON
+			   GSL_ROOT5_SFLT_EPSILON GSL_ROOT6_SFLT_EPSILON GSL_LOG_SFLT_EPSILON GSL_MACH_EPS GSL_SQRT_MACH_EPS GSL_ROOT3_MACH_EPS
+			   GSL_ROOT4_MACH_EPS GSL_ROOT5_MACH_EPS GSL_ROOT6_MACH_EPS GSL_LOG_MACH_EPS)))
+
+	 (int (GSL_SUCCESS GSL_FAILURE GSL_CONTINUE GSL_EDOM GSL_ERANGE GSL_EFAULT GSL_EINVAL GSL_EFAILED GSL_EFACTOR GSL_ESANITY
+	       GSL_ENOMEM GSL_EBADFUNC GSL_ERUNAWAY GSL_EMAXITER GSL_EZERODIV GSL_EBADTOL GSL_ETOL GSL_EUNDRFLW GSL_EOVRFLW
+	       GSL_ELOSS GSL_EROUND GSL_EBADLEN GSL_ENOTSQR GSL_ESING GSL_EDIVERGE GSL_EUNSUP GSL_EUNIMPL GSL_ECACHE GSL_ETABLE
+	       GSL_ENOPROG GSL_ENOPROGJ GSL_ETOLF GSL_ETOLX GSL_ETOLG GSL_EOF
+	       GSL_IEEE_ROUND_TO_NEAREST GSL_IEEE_ROUND_DOWN GSL_IEEE_ROUND_UP GSL_IEEE_ROUND_TO_ZERO GSL_IEEE_MASK_INVALID
+	       GSL_IEEE_MASK_DENORMALIZED GSL_IEEE_MASK_DIVISION_BY_ZERO GSL_IEEE_MASK_OVERFLOW GSL_IEEE_MASK_UNDERFLOW
+	       GSL_IEEE_MASK_ALL GSL_IEEE_TRAP_INEXACT
+	       GSL_INTEG_GAUSS15 GSL_INTEG_GAUSS21 GSL_INTEG_GAUSS31 GSL_INTEG_GAUSS41 GSL_INTEG_GAUSS51 GSL_INTEG_GAUSS61
+	       GSL_EIGEN_SORT_VAL_ASC GSL_EIGEN_SORT_VAL_DESC GSL_EIGEN_SORT_ABS_ASC GSL_EIGEN_SORT_ABS_DESC
+	       gsl_fft_forward gsl_fft_backward
+	       GSL_IEEE_TYPE_NAN GSL_IEEE_TYPE_INF GSL_IEEE_TYPE_NORMAL GSL_IEEE_TYPE_DENORMAL GSL_IEEE_TYPE_ZERO
+	       GSL_IEEE_SINGLE_PRECISION GSL_IEEE_DOUBLE_PRECISION GSL_IEEE_EXTENDED_PRECISION GSL_LINALG_MOD_NONE
+	       GSL_LINALG_MOD_TRANSPOSE GSL_LINALG_MOD_CONJUGATE
+	       GSL_MESSAGE_MASK_A GSL_MESSAGE_MASK_B GSL_MESSAGE_MASK_C GSL_MESSAGE_MASK_D GSL_MESSAGE_MASK_E
+	       GSL_MESSAGE_MASK_F GSL_MESSAGE_MASK_G GSL_MESSAGE_MASK_H
+	       gsl_wavelet_forward gsl_wavelet_backward))
+
+	 (C-macro (int (GSL_PREC_DOUBLE GSL_PREC_SINGLE GSL_PREC_APPROX GSL_SF_MATHIEU_COEFF GSL_SF_FACT_NMAX GSL_SF_DOUBLEFACT_NMAX
+		        GSL_MAJOR_VERSION GSL_MINOR_VERSION
+			GSL_MODE_DEFAULT
+			GSL_INTEG_COSINE GSL_INTEG_SINE)))
+
+	 (C-macro (double (GSL_SF_GAMMA_XMAX
+			   GSL_POSINF GSL_NEGINF GSL_NAN GSL_POSZERO GSL_NEGZERO)))
+
+	 (C-macro (char* GSL_VERSION))
+
+	 (int (CblasRowMajor CblasColMajor CblasNoTrans CblasTrans CblasConjTrans
+	       CblasUpper CblasLower CblasNonUnit CblasUnit CblasLeft CblasRight))
+
+	 (in-C "static s7_pointer g_free(s7_scheme *sc, s7_pointer args)
+                 {free(s7_c_pointer(s7_car(args))); return(s7_f(sc));}")
+	 (C-function ("free" g_free "" 1))
+
+	 ;; redirect GSL errors to s7_error
+	 (in-C "
+                static s7_scheme *gsl_error_s7;
+                static void g_gsl_error(const char *reason, const char *file, int line, int gsl_errno)
+                {
+                  s7_error(gsl_error_s7, s7_make_symbol(gsl_error_s7, \"gsl-error\"),
+                	   s7_list(gsl_error_s7, 5,
+                		   s7_make_string(gsl_error_s7, \"GSL: ~A, ~A in ~A line ~A\"),
+                		   s7_make_string(gsl_error_s7, gsl_strerror(gsl_errno)),
+                		   s7_make_string(gsl_error_s7, reason),
+                		   s7_make_string(gsl_error_s7, file),
+                		   s7_make_integer(gsl_error_s7, line)));
+                }")
+	 (C-init "gsl_error_s7 = sc;")
+	 (C-init "gsl_set_error_handler(g_gsl_error);")
+	 (C-init "s7_define(sc, cur_env, s7_make_symbol(sc, \"version\"), s7_make_string(sc, (char *)gsl_version));")
+
+	 (C-macro (int (GSL_SF_LEGENDRE_SCHMIDT GSL_SF_LEGENDRE_SPHARM GSL_SF_LEGENDRE_FULL GSL_SF_LEGENDRE_NONE)))
+
+	 ;; special functions
+	 ;; ((*libgsl* 'gsl_sf_bessel_J0) 1.0) -> 0.7651976865579666
+	 ;; (let ((sfr ((*libgsl* 'gsl_sf_result.make)))) ((*libgsl* 'gsl_sf_bessel_J0_e) 1.0 sfr) ((*libgsl* 'gsl_sf_result.val) sfr))
+
+	 (int gsl_sf_airy_Ai_e (double int gsl_sf_result*))
+	 (double gsl_sf_airy_Ai (double int))
+	 (int gsl_sf_airy_Bi_e (double int gsl_sf_result*))
+	 (double gsl_sf_airy_Bi (double int))
+	 (int gsl_sf_airy_Ai_scaled_e (double int gsl_sf_result*))
+	 (double gsl_sf_airy_Ai_scaled (double int))
+	 (int gsl_sf_airy_Bi_scaled_e (double int gsl_sf_result*))
+	 (double gsl_sf_airy_Bi_scaled (double int))
+	 (int gsl_sf_airy_Ai_deriv_e (double int gsl_sf_result*))
+	 (double gsl_sf_airy_Ai_deriv (double int))
+	 (int gsl_sf_airy_Bi_deriv_e (double int gsl_sf_result*))
+	 (double gsl_sf_airy_Bi_deriv (double int))
+	 (int gsl_sf_airy_Ai_deriv_scaled_e (double int gsl_sf_result*))
+	 (double gsl_sf_airy_Ai_deriv_scaled (double int))
+	 (int gsl_sf_airy_Bi_deriv_scaled_e (double int gsl_sf_result*))
+	 (double gsl_sf_airy_Bi_deriv_scaled (double int))
+	 (int gsl_sf_airy_zero_Ai_e (int gsl_sf_result*))
+	 (double gsl_sf_airy_zero_Ai (int))
+	 (int gsl_sf_airy_zero_Bi_e (int gsl_sf_result*))
+	 (double gsl_sf_airy_zero_Bi (int))
+	 (int gsl_sf_airy_zero_Ai_deriv_e (int gsl_sf_result*))
+	 (double gsl_sf_airy_zero_Ai_deriv (int))
+	 (int gsl_sf_airy_zero_Bi_deriv_e (int gsl_sf_result*))
+	 (double gsl_sf_airy_zero_Bi_deriv (int))
+	 (int gsl_sf_bessel_J0_e (double gsl_sf_result*))
+	 (double gsl_sf_bessel_J0 (double))
+	 (int gsl_sf_bessel_J1_e (double gsl_sf_result*))
+	 (double gsl_sf_bessel_J1 (double))
+	 (int gsl_sf_bessel_Jn_e (int double gsl_sf_result*))
+	 (double gsl_sf_bessel_Jn (int double))
+	 (int gsl_sf_bessel_Jn_array (int int double double*))
+	 (int gsl_sf_bessel_Y0_e (double gsl_sf_result*))
+	 (double gsl_sf_bessel_Y0 (double))
+	 (int gsl_sf_bessel_Y1_e (double gsl_sf_result*))
+	 (double gsl_sf_bessel_Y1 (double))
+	 (int gsl_sf_bessel_Yn_e (int double gsl_sf_result*))
+	 (double gsl_sf_bessel_Yn (int double))
+	 (int gsl_sf_bessel_Yn_array (int int double double*))
+	 (int gsl_sf_bessel_I0_e (double gsl_sf_result*))
+	 (double gsl_sf_bessel_I0 (double))
+	 (int gsl_sf_bessel_I1_e (double gsl_sf_result*))
+	 (double gsl_sf_bessel_I1 (double))
+	 (int gsl_sf_bessel_In_e (int double gsl_sf_result*))
+	 (double gsl_sf_bessel_In (int double))
+	 (int gsl_sf_bessel_In_array (int int double double*))
+	 (int gsl_sf_bessel_I0_scaled_e (double gsl_sf_result*))
+	 (double gsl_sf_bessel_I0_scaled (double))
+	 (int gsl_sf_bessel_I1_scaled_e (double gsl_sf_result*))
+	 (double gsl_sf_bessel_I1_scaled (double))
+	 (int gsl_sf_bessel_In_scaled_e (int double gsl_sf_result*))
+	 (double gsl_sf_bessel_In_scaled (int double))
+	 (int gsl_sf_bessel_In_scaled_array (int int double double*))
+	 (int gsl_sf_bessel_K0_e (double gsl_sf_result*))
+	 (double gsl_sf_bessel_K0 (double))
+	 (int gsl_sf_bessel_K1_e (double gsl_sf_result*))
+	 (double gsl_sf_bessel_K1 (double))
+	 (int gsl_sf_bessel_Kn_e (int double gsl_sf_result*))
+	 (double gsl_sf_bessel_Kn (int double))
+	 (int gsl_sf_bessel_Kn_array (int int double double*))
+	 (int gsl_sf_bessel_K0_scaled_e (double gsl_sf_result*))
+	 (double gsl_sf_bessel_K0_scaled (double))
+	 (int gsl_sf_bessel_K1_scaled_e (double gsl_sf_result*) )
+	 (double gsl_sf_bessel_K1_scaled (double))
+	 (int gsl_sf_bessel_Kn_scaled_e (int double gsl_sf_result*))
+	 (double gsl_sf_bessel_Kn_scaled (int double))
+	 (int gsl_sf_bessel_Kn_scaled_array (int int double double*))
+	 (int gsl_sf_bessel_j0_e (double gsl_sf_result*))
+	 (double gsl_sf_bessel_j0 (double))
+	 (int gsl_sf_bessel_j1_e (double gsl_sf_result*))
+	 (double gsl_sf_bessel_j1 (double))
+	 (int gsl_sf_bessel_j2_e (double gsl_sf_result*))
+	 (double gsl_sf_bessel_j2 (double))
+	 (int gsl_sf_bessel_jl_e (int double gsl_sf_result*))
+	 (double gsl_sf_bessel_jl (int double))
+	 (int gsl_sf_bessel_jl_array (int double double*))
+	 (int gsl_sf_bessel_jl_steed_array (int double double*))
+	 (int gsl_sf_bessel_y0_e (double gsl_sf_result*))
+	 (double gsl_sf_bessel_y0 (double))
+	 (int gsl_sf_bessel_y1_e (double gsl_sf_result*))
+	 (double gsl_sf_bessel_y1 (double))
+	 (int gsl_sf_bessel_y2_e (double gsl_sf_result*))
+	 (double gsl_sf_bessel_y2 (double))
+	 (int gsl_sf_bessel_yl_e (int double gsl_sf_result*))
+	 (double gsl_sf_bessel_yl (int double))
+	 (int gsl_sf_bessel_yl_array (int double double*))
+	 (int gsl_sf_bessel_i0_scaled_e (double gsl_sf_result*))
+	 (double gsl_sf_bessel_i0_scaled (double))
+	 (int gsl_sf_bessel_i1_scaled_e (double gsl_sf_result*))
+	 (double gsl_sf_bessel_i1_scaled (double))
+	 (int gsl_sf_bessel_i2_scaled_e (double gsl_sf_result*))
+	 (double gsl_sf_bessel_i2_scaled (double))
+	 (int gsl_sf_bessel_il_scaled_e (int double gsl_sf_result*))
+	 (double gsl_sf_bessel_il_scaled (int double))
+	 (int gsl_sf_bessel_il_scaled_array (int double double*))
+	 (int gsl_sf_bessel_k0_scaled_e (double gsl_sf_result*))
+	 (double gsl_sf_bessel_k0_scaled (double))
+	 (int gsl_sf_bessel_k1_scaled_e (double gsl_sf_result*))
+	 (double gsl_sf_bessel_k1_scaled (double))
+	 (int gsl_sf_bessel_k2_scaled_e (double gsl_sf_result*))
+	 (double gsl_sf_bessel_k2_scaled (double))
+	 (int gsl_sf_bessel_kl_scaled_e (int double gsl_sf_result*))
+	 (double gsl_sf_bessel_kl_scaled (int double))
+	 (int gsl_sf_bessel_kl_scaled_array (int double double*))
+	 (int gsl_sf_bessel_Jnu_e (double double gsl_sf_result*))
+	 (double gsl_sf_bessel_Jnu (double double))
+	 (int gsl_sf_bessel_Ynu_e (double double gsl_sf_result*))
+	 (double gsl_sf_bessel_Ynu (double double))
+	 (int gsl_sf_bessel_sequence_Jnu_e (double int size_t double*))
+	 (int gsl_sf_bessel_Inu_scaled_e (double double gsl_sf_result*))
+	 (double gsl_sf_bessel_Inu_scaled (double double))
+	 (int gsl_sf_bessel_Inu_e (double double gsl_sf_result*))
+	 (double gsl_sf_bessel_Inu (double double))
+	 (int gsl_sf_bessel_Knu_scaled_e (double double gsl_sf_result*))
+	 (double gsl_sf_bessel_Knu_scaled (double double))
+	 (reader-cond ((>= gsl-version 1.15) (int gsl_sf_bessel_Knu_scaled_e10_e (double double gsl_sf_result_e10*))))
+	 (int gsl_sf_bessel_Knu_e (double double gsl_sf_result*))
+	 (double gsl_sf_bessel_Knu (double double))
+	 (int gsl_sf_bessel_lnKnu_e (double double gsl_sf_result*))
+	 (double gsl_sf_bessel_lnKnu (double double))
+	 (int gsl_sf_bessel_zero_J0_e (int gsl_sf_result*))
+	 (double gsl_sf_bessel_zero_J0 (int))
+	 (int gsl_sf_bessel_zero_J1_e (int gsl_sf_result*))
+	 (double gsl_sf_bessel_zero_J1 (int))
+	 (int gsl_sf_bessel_zero_Jnu_e (double int gsl_sf_result*))
+	 (double gsl_sf_bessel_zero_Jnu (double int))
+	 (int gsl_sf_clausen_e (double gsl_sf_result*))
+	 (double gsl_sf_clausen (double))
+	 (int gsl_sf_hydrogenicR_1_e (double double gsl_sf_result*))
+	 (double gsl_sf_hydrogenicR_1 (double double))
+	 (int gsl_sf_hydrogenicR_e (int int double double gsl_sf_result*))
+	 (double gsl_sf_hydrogenicR (int int double double))
+	 (int gsl_sf_coulomb_wave_FG_e (double double double int gsl_sf_result* gsl_sf_result* gsl_sf_result* gsl_sf_result* double* double*))
+	 (int gsl_sf_coulomb_wave_F_array (double int double double double* double*))
+	 (int gsl_sf_coulomb_wave_FG_array (double int double double double* double* double* double*))
+	 (int gsl_sf_coulomb_wave_FGp_array (double int double double double* double* double* double* double* double*))
+	 (int gsl_sf_coulomb_wave_sphF_array (double int double double double* double*))
+	 (int gsl_sf_coulomb_CL_e (double double gsl_sf_result*))
+	 (int gsl_sf_coulomb_CL_array (double int double double*))
+	 (int gsl_sf_coupling_3j_e (int int int int int int gsl_sf_result*))
+	 (double gsl_sf_coupling_3j (int int int int int int))
+	 ;; out 2.4 (int gsl_sf_coupling_6j_e (int int int int int int gsl_sf_result*))
+	 ;; out 2.4 (double gsl_sf_coupling_6j (int int int int int int))
+	 (int gsl_sf_coupling_RacahW_e (int int int int int int gsl_sf_result*))
+	 (double gsl_sf_coupling_RacahW (int int int int int int))
+	 (int gsl_sf_coupling_9j_e (int int int int int int int int int gsl_sf_result*))
+	 (double gsl_sf_coupling_9j (int int int int int int int int int))
+	 (int gsl_sf_dawson_e (double gsl_sf_result*))
+	 (double gsl_sf_dawson (double))
+	 (int gsl_sf_debye_1_e (double gsl_sf_result*))
+	 (double gsl_sf_debye_1 (double))
+	 (int gsl_sf_debye_2_e (double gsl_sf_result*))
+	 (double gsl_sf_debye_2 (double))
+	 (int gsl_sf_debye_3_e (double gsl_sf_result*))
+	 (double gsl_sf_debye_3 (double))
+	 (int gsl_sf_debye_4_e (double gsl_sf_result*))
+	 (double gsl_sf_debye_4 (double))
+	 (int gsl_sf_debye_5_e (double gsl_sf_result*))
+	 (double gsl_sf_debye_5 (double))
+	 (int gsl_sf_debye_6_e (double gsl_sf_result*))
+	 (double gsl_sf_debye_6 (double))
+	 (int gsl_sf_dilog_e (double gsl_sf_result*))
+	 (double gsl_sf_dilog (double))
+	 (int gsl_sf_complex_dilog_xy_e (double double gsl_sf_result* gsl_sf_result*))
+	 (int gsl_sf_complex_dilog_e (double double gsl_sf_result* gsl_sf_result*))
+	 (int gsl_sf_complex_spence_xy_e (double double gsl_sf_result* gsl_sf_result*))
+	 (int gsl_sf_multiply_e (double double gsl_sf_result*))
+	 (double gsl_sf_multiply (double double))
+	 (int gsl_sf_multiply_err_e (double double double double gsl_sf_result*))
+	 (int gsl_sf_ellint_Kcomp_e (double int gsl_sf_result*))
+	 (double gsl_sf_ellint_Kcomp (double int))
+	 (int gsl_sf_ellint_Ecomp_e (double int gsl_sf_result*))
+	 (double gsl_sf_ellint_Ecomp (double int))
+	 (int gsl_sf_ellint_Pcomp_e (double double int gsl_sf_result*))
+	 (double gsl_sf_ellint_Pcomp (double double int))
+	 (int gsl_sf_ellint_Dcomp_e (double int gsl_sf_result*))
+	 (double gsl_sf_ellint_Dcomp (double int))
+	 (int gsl_sf_ellint_F_e (double double int gsl_sf_result*))
+	 (double gsl_sf_ellint_F (double double int))
+	 (int gsl_sf_ellint_E_e (double double int gsl_sf_result*))
+	 (double gsl_sf_ellint_E (double double int))
+	 (int gsl_sf_ellint_P_e (double double double int gsl_sf_result*))
+	 (double gsl_sf_ellint_P (double double double int))
+	 (reader-cond ((< gsl-version 2.0)
+		       (int gsl_sf_ellint_D_e (double double double int gsl_sf_result*))
+		       (double gsl_sf_ellint_D (double double double int)))
+		      (#t
+		       (int gsl_sf_ellint_D_e (double double int gsl_sf_result*))
+		       (double gsl_sf_ellint_D (double double int))))
+	 (int gsl_sf_ellint_RC_e (double double int gsl_sf_result*))
+	 (double gsl_sf_ellint_RC (double double int))
+	 (int gsl_sf_ellint_RD_e (double double double int gsl_sf_result*))
+	 (double gsl_sf_ellint_RD (double double double int))
+	 (int gsl_sf_ellint_RF_e (double double double int gsl_sf_result*))
+	 (double gsl_sf_ellint_RF (double double double int))
+	 (int gsl_sf_ellint_RJ_e (double double double double int gsl_sf_result*))
+	 (double gsl_sf_ellint_RJ (double double double double int))
+	 (int gsl_sf_elljac_e (double double double* double* double*)) ; these are double by reference
+	 (int gsl_sf_erfc_e (double gsl_sf_result*))
+	 (double gsl_sf_erfc (double))
+	 (int gsl_sf_log_erfc_e (double gsl_sf_result*))
+	 (double gsl_sf_log_erfc (double))
+	 (int gsl_sf_erf_e (double gsl_sf_result*))
+	 (double gsl_sf_erf (double))
+	 (int gsl_sf_erf_Z_e (double gsl_sf_result*))
+	 (int gsl_sf_erf_Q_e (double gsl_sf_result*))
+	 (double gsl_sf_erf_Z (double))
+	 (double gsl_sf_erf_Q (double))
+	 (int gsl_sf_hazard_e (double gsl_sf_result*))
+	 (double gsl_sf_hazard (double))
+	 (int gsl_sf_exp_e (double gsl_sf_result*))
+	 (double gsl_sf_exp (double))
+	 (int gsl_sf_exp_e10_e (double gsl_sf_result_e10*))
+	 (int gsl_sf_exp_mult_e (double double gsl_sf_result*))
+	 (double gsl_sf_exp_mult (double double))
+	 (int gsl_sf_exp_mult_e10_e (double double gsl_sf_result_e10*))
+	 (int gsl_sf_expm1_e (double gsl_sf_result*))
+	 (double gsl_sf_expm1 (double))
+	 (int gsl_sf_exprel_e (double gsl_sf_result*))
+	 (double gsl_sf_exprel (double))
+	 (int gsl_sf_exprel_2_e (double gsl_sf_result*))
+	 (double gsl_sf_exprel_2 (double))
+	 (int gsl_sf_exprel_n_e (int double gsl_sf_result*))
+	 (double gsl_sf_exprel_n (int double))
+	 (int gsl_sf_exprel_n_CF_e (double double gsl_sf_result*))
+	 (int gsl_sf_exp_err_e (double double gsl_sf_result*))
+	 (int gsl_sf_exp_err_e10_e (double double gsl_sf_result_e10*))
+	 (int gsl_sf_exp_mult_err_e (double double double double gsl_sf_result*))
+	 (int gsl_sf_exp_mult_err_e10_e (double double double double gsl_sf_result_e10*))
+	 (int gsl_sf_expint_E1_e (double gsl_sf_result*))
+	 (double gsl_sf_expint_E1 (double))
+	 (int gsl_sf_expint_E2_e (double gsl_sf_result*))
+	 (double gsl_sf_expint_E2 (double))
+	 (int gsl_sf_expint_En_e (int double gsl_sf_result*))
+	 (double gsl_sf_expint_En (int double))
+	 (int gsl_sf_expint_E1_scaled_e (double gsl_sf_result*))
+	 (double gsl_sf_expint_E1_scaled (double))
+	 (int gsl_sf_expint_E2_scaled_e (double gsl_sf_result*))
+	 (double gsl_sf_expint_E2_scaled (double))
+	 (int gsl_sf_expint_En_scaled_e (int double gsl_sf_result*))
+	 (double gsl_sf_expint_En_scaled (int double))
+	 (int gsl_sf_expint_Ei_e (double gsl_sf_result*))
+	 (double gsl_sf_expint_Ei (double))
+	 (int gsl_sf_expint_Ei_scaled_e (double gsl_sf_result*))
+	 (double gsl_sf_expint_Ei_scaled (double))
+	 (int gsl_sf_Shi_e (double gsl_sf_result*))
+	 (double gsl_sf_Shi (double))
+	 (int gsl_sf_Chi_e (double gsl_sf_result*))
+	 (double gsl_sf_Chi (double))
+	 (int gsl_sf_expint_3_e (double gsl_sf_result*))
+	 (double gsl_sf_expint_3 (double))
+	 (int gsl_sf_Si_e (double gsl_sf_result*))
+	 (double gsl_sf_Si (double))
+	 (int gsl_sf_Ci_e (double gsl_sf_result*))
+	 (double gsl_sf_Ci (double))
+	 (int gsl_sf_atanint_e (double gsl_sf_result*))
+	 (double gsl_sf_atanint (double))
+	 (int gsl_sf_fermi_dirac_m1_e (double gsl_sf_result*))
+	 (double gsl_sf_fermi_dirac_m1 (double))
+	 (int gsl_sf_fermi_dirac_0_e (double gsl_sf_result*))
+	 (double gsl_sf_fermi_dirac_0 (double))
+	 (int gsl_sf_fermi_dirac_1_e (double gsl_sf_result*))
+	 (double gsl_sf_fermi_dirac_1 (double))
+	 (int gsl_sf_fermi_dirac_2_e (double gsl_sf_result*))
+	 (double gsl_sf_fermi_dirac_2 (double))
+	 (int gsl_sf_fermi_dirac_int_e (int double gsl_sf_result*))
+	 (double gsl_sf_fermi_dirac_int (int double))
+	 (int gsl_sf_fermi_dirac_mhalf_e (double gsl_sf_result*))
+	 (double gsl_sf_fermi_dirac_mhalf (double))
+	 (int gsl_sf_fermi_dirac_half_e (double gsl_sf_result*))
+	 (double gsl_sf_fermi_dirac_half (double))
+	 (int gsl_sf_fermi_dirac_3half_e (double gsl_sf_result*))
+	 (double gsl_sf_fermi_dirac_3half (double))
+	 (int gsl_sf_fermi_dirac_inc_0_e (double double gsl_sf_result*))
+	 (double gsl_sf_fermi_dirac_inc_0 (double double))
+	 (int gsl_sf_lngamma_e (double gsl_sf_result*))
+	 (double gsl_sf_lngamma (double))
+	 (int gsl_sf_lngamma_sgn_e (double gsl_sf_result* double*))
+	 (int gsl_sf_gamma_e (double gsl_sf_result*))
+	 (double gsl_sf_gamma (double))
+	 (int gsl_sf_gammastar_e (double gsl_sf_result*))
+	 (double gsl_sf_gammastar (double))
+	 (int gsl_sf_gammainv_e (double gsl_sf_result*))
+	 (double gsl_sf_gammainv (double))
+	 (int gsl_sf_lngamma_complex_e (double double gsl_sf_result* gsl_sf_result*))
+	 (int gsl_sf_taylorcoeff_e (int double gsl_sf_result*))
+	 (double gsl_sf_taylorcoeff (int double))
+	 (int gsl_sf_fact_e (int gsl_sf_result*))
+	 (double gsl_sf_fact (int))
+	 (int gsl_sf_doublefact_e (int gsl_sf_result*))
+	 (double gsl_sf_doublefact (int))
+	 (int gsl_sf_lnfact_e (int gsl_sf_result*))
+	 (double gsl_sf_lnfact (int))
+	 (int gsl_sf_lndoublefact_e (int gsl_sf_result*))
+	 (double gsl_sf_lndoublefact (int))
+	 (int gsl_sf_lnchoose_e (int int gsl_sf_result*))
+	 (double gsl_sf_lnchoose (int int))
+	 (int gsl_sf_choose_e (int int gsl_sf_result*))
+	 (double gsl_sf_choose (int int))
+	 (int gsl_sf_lnpoch_e (double double gsl_sf_result*))
+	 (double gsl_sf_lnpoch (double double))
+	 (int gsl_sf_lnpoch_sgn_e (double double gsl_sf_result* double*))
+	 (int gsl_sf_poch_e (double double gsl_sf_result*))
+	 (double gsl_sf_poch (double double))
+	 (int gsl_sf_pochrel_e (double double gsl_sf_result*))
+	 (double gsl_sf_pochrel (double double))
+	 (int gsl_sf_gamma_inc_Q_e (double double gsl_sf_result*))
+	 (double gsl_sf_gamma_inc_Q (double double))
+	 (int gsl_sf_gamma_inc_P_e (double double gsl_sf_result*))
+	 (double gsl_sf_gamma_inc_P (double double))
+	 (int gsl_sf_gamma_inc_e (double double gsl_sf_result*))
+	 (double gsl_sf_gamma_inc (double double))
+	 (int gsl_sf_lnbeta_e (double double gsl_sf_result*))
+	 (double gsl_sf_lnbeta (double double))
+	 (int gsl_sf_lnbeta_sgn_e (double double gsl_sf_result* double*))
+	 (int gsl_sf_beta_e (double double gsl_sf_result*))
+	 (double gsl_sf_beta (double double))
+	 (int gsl_sf_beta_inc_e (double double double gsl_sf_result*))
+	 (double gsl_sf_beta_inc (double double double))
+	 (int gsl_sf_gegenpoly_1_e (double double gsl_sf_result*))
+	 (int gsl_sf_gegenpoly_2_e (double double gsl_sf_result*))
+	 (int gsl_sf_gegenpoly_3_e (double double gsl_sf_result*))
+	 (double gsl_sf_gegenpoly_1 (double double))
+	 (double gsl_sf_gegenpoly_2 (double double))
+	 (double gsl_sf_gegenpoly_3 (double double))
+	 (int gsl_sf_gegenpoly_n_e (int double double gsl_sf_result*))
+	 (double gsl_sf_gegenpoly_n (int double double))
+	 (int gsl_sf_gegenpoly_array (int double double double*))
+	 (int gsl_sf_hyperg_0F1_e (double double gsl_sf_result*))
+	 (double gsl_sf_hyperg_0F1 (double double))
+	 (int gsl_sf_hyperg_1F1_int_e (int int double gsl_sf_result*))
+	 (double gsl_sf_hyperg_1F1_int (int int double))
+	 (int gsl_sf_hyperg_1F1_e (double double double gsl_sf_result*))
+	 (double gsl_sf_hyperg_1F1 (double double double))
+	 (int gsl_sf_hyperg_U_int_e (int int double gsl_sf_result*))
+	 (double gsl_sf_hyperg_U_int (int int double))
+	 (int gsl_sf_hyperg_U_int_e10_e (int int double gsl_sf_result_e10*))
+	 (int gsl_sf_hyperg_U_e (double double double gsl_sf_result*))
+	 (double gsl_sf_hyperg_U (double double double))
+	 (int gsl_sf_hyperg_U_e10_e (double double double gsl_sf_result_e10*))
+	 (int gsl_sf_hyperg_2F1_e (double double double double gsl_sf_result*))
+	 (double gsl_sf_hyperg_2F1 (double double double double))
+	 (int gsl_sf_hyperg_2F1_conj_e (double double double double gsl_sf_result*))
+	 (double gsl_sf_hyperg_2F1_conj (double double double double))
+	 (int gsl_sf_hyperg_2F1_renorm_e (double double double double gsl_sf_result*))
+	 (double gsl_sf_hyperg_2F1_renorm (double double double double))
+	 (int gsl_sf_hyperg_2F1_conj_renorm_e (double double double double gsl_sf_result*))
+	 (double gsl_sf_hyperg_2F1_conj_renorm (double double double double))
+	 (int gsl_sf_hyperg_2F0_e (double double double gsl_sf_result*))
+	 (double gsl_sf_hyperg_2F0 (double double double))
+	 (int gsl_sf_laguerre_1_e (double double gsl_sf_result*))
+	 (int gsl_sf_laguerre_2_e (double double gsl_sf_result*))
+	 (int gsl_sf_laguerre_3_e (double double gsl_sf_result*))
+	 (double gsl_sf_laguerre_1 (double double))
+	 (double gsl_sf_laguerre_2 (double double))
+	 (double gsl_sf_laguerre_3 (double double))
+	 (int gsl_sf_laguerre_n_e (int double double gsl_sf_result*))
+	 (double gsl_sf_laguerre_n (int double double))
+	 (int gsl_sf_lambert_W0_e (double gsl_sf_result*))
+	 (double gsl_sf_lambert_W0 (double))
+	 (int gsl_sf_lambert_Wm1_e (double gsl_sf_result*))
+	 (double gsl_sf_lambert_Wm1 (double))
+	 (int gsl_sf_legendre_Pl_e (int double gsl_sf_result*))
+	 (double gsl_sf_legendre_Pl (int double))
+	 (int gsl_sf_legendre_Pl_array (int double double*))
+	 (int gsl_sf_legendre_Pl_deriv_array ( int double double* double*))
+	 (int gsl_sf_legendre_P1_e (double gsl_sf_result*))
+	 (int gsl_sf_legendre_P2_e (double gsl_sf_result*))
+	 (int gsl_sf_legendre_P3_e (double gsl_sf_result*))
+	 (double gsl_sf_legendre_P1 (double))
+	 (double gsl_sf_legendre_P2 (double))
+	 (double gsl_sf_legendre_P3 (double))
+	 (int gsl_sf_legendre_Q0_e (double gsl_sf_result*))
+	 (double gsl_sf_legendre_Q0 (double))
+	 (int gsl_sf_legendre_Q1_e (double gsl_sf_result*))
+	 (double gsl_sf_legendre_Q1 (double))
+	 (int gsl_sf_legendre_Ql_e (int double gsl_sf_result*))
+	 (double gsl_sf_legendre_Ql (int double))
+	 (int gsl_sf_legendre_Plm_e (int int double gsl_sf_result*))
+	 (double gsl_sf_legendre_Plm (int int double))
+	 (int gsl_sf_legendre_sphPlm_e (int int double gsl_sf_result*))
+	 (double gsl_sf_legendre_sphPlm (int int double))
+
+	 (reader-cond ((< gsl-version 2.0)
+		       (int gsl_sf_legendre_array_size (int int))
+		       (int gsl_sf_legendre_Plm_array (int int double double*))
+		       (int gsl_sf_legendre_Plm_deriv_array (int int double double* double*))
+		       (int gsl_sf_legendre_sphPlm_array (int int double double*))
+		       (int gsl_sf_legendre_sphPlm_deriv_array (int int double double* double*)))
+		      (#t
+		       (int gsl_sf_legendre_array ((gsl_sf_legendre_t int) size_t double double*))
+		       (int gsl_sf_legendre_array_e ((gsl_sf_legendre_t int) size_t double double double*))
+		       (int gsl_sf_legendre_deriv_array ((gsl_sf_legendre_t int) size_t double double* double*))
+		       (int gsl_sf_legendre_deriv_array_e ((gsl_sf_legendre_t int) size_t double double double* double*))
+		       (int gsl_sf_legendre_deriv_alt_array ((gsl_sf_legendre_t int) size_t double double* double*))
+		       (int gsl_sf_legendre_deriv_alt_array_e ((gsl_sf_legendre_t int) size_t double double double* double*))
+		       (int gsl_sf_legendre_deriv2_array ((gsl_sf_legendre_t int) size_t double double* double* double*))
+		       (int gsl_sf_legendre_deriv2_array_e ((gsl_sf_legendre_t int) size_t double double double* double* double*))
+		       (int gsl_sf_legendre_deriv2_alt_array ((gsl_sf_legendre_t int) size_t double double* double* double*))
+		       (int gsl_sf_legendre_deriv2_alt_array_e ((gsl_sf_legendre_t int) size_t double double double* double* double*))
+		       (size_t gsl_sf_legendre_array_n (size_t))
+		       (size_t gsl_sf_legendre_array_index (size_t size_t))
+		       (size_t gsl_sf_legendre_nlm (size_t))))
+
+	 (reader-cond ((>= gsl-version 2.4)
+		       (int gsl_sf_hermite_prob_e (int double gsl_sf_result*))
+		       (double gsl_sf_hermite_prob (int double))
+		       (int gsl_sf_hermite_func_e (int double gsl_sf_result*))
+		       (double gsl_sf_hermite_func (int double))
+		       (int gsl_sf_hermite_prob_array (int double double*))
+		       (int gsl_sf_hermite_prob_series_e (int double double* gsl_sf_result*))
+		       (double gsl_sf_hermite_prob_series (int double double*))
+		       (int gsl_sf_hermite_func_array (int double double*))
+		       (int gsl_sf_hermite_func_series_e (int double double* gsl_sf_result*))
+		       (double gsl_sf_hermite_func_series (int double double*))
+		       (int gsl_sf_hermite_func_der_e (int int double gsl_sf_result*))
+		       (double gsl_sf_hermite_func_der (int int double))
+		       (int gsl_sf_hermite_prob_zero_e (int int gsl_sf_result*))
+		       (double gsl_sf_hermite_prob_zero (int int))
+		       (int gsl_sf_hermite_func_zero_e (int int gsl_sf_result*))
+		       (double gsl_sf_hermite_func_zero (int int))))
+
+	 (reader-cond ((>= gsl-version 2.6)
+		       (int gsl_sf_hermite_prob_deriv_e (int int double gsl_sf_result*))
+		       (double gsl_sf_hermite_prob_deriv (int int double))
+		       (int gsl_sf_hermite_e (int double gsl_sf_result*))
+		       (double gsl_sf_hermite(int double))
+		       (int gsl_sf_hermite_deriv_e (int int double gsl_sf_result*))
+		       (double gsl_sf_hermite_deriv (int int double))
+		       (int gsl_sf_hermite_prob_array_deriv (int int double double*))
+		       (int gsl_sf_hermite_prob_deriv_array (int int double double*))
+		       (int gsl_sf_hermite_array (int double double*))
+		       (int gsl_sf_hermite_array_deriv (int int double double*))
+		       (int gsl_sf_hermite_deriv_array (int int double double*))
+		       (int gsl_sf_hermite_series_e (int double double* gsl_sf_result*))
+		       (double gsl_sf_hermite_series (int double double*))
+		       (int gsl_sf_hermite_zero_e (int int gsl_sf_result*))
+		       (double gsl_sf_hermite_zero (int int))
+		       (int gsl_sf_hermite_func_fast_e (int double gsl_sf_result*))
+		       (double gsl_sf_hermite_func_fast (int double))))
+
+	 (int gsl_sf_conicalP_half_e (double double gsl_sf_result*))
+	 (double gsl_sf_conicalP_half (double double))
+	 (int gsl_sf_conicalP_mhalf_e (double double gsl_sf_result*))
+	 (double gsl_sf_conicalP_mhalf (double double))
+	 (int gsl_sf_conicalP_0_e (double double gsl_sf_result*))
+	 (double gsl_sf_conicalP_0 (double double))
+	 (int gsl_sf_conicalP_1_e (double double gsl_sf_result*))
+	 (double gsl_sf_conicalP_1 (double double))
+	 (int gsl_sf_conicalP_sph_reg_e (int double double gsl_sf_result*))
+	 (double gsl_sf_conicalP_sph_reg (int double double))
+	 (int gsl_sf_conicalP_cyl_reg_e (int double double gsl_sf_result*))
+	 (double gsl_sf_conicalP_cyl_reg (int double double))
+	 (int gsl_sf_legendre_H3d_0_e (double double gsl_sf_result*))
+	 (double gsl_sf_legendre_H3d_0 (double double))
+	 (int gsl_sf_legendre_H3d_1_e (double double gsl_sf_result*))
+	 (double gsl_sf_legendre_H3d_1 (double double))
+	 (int gsl_sf_legendre_H3d_e (int double double gsl_sf_result*))
+	 (double gsl_sf_legendre_H3d (int double double))
+	 (int gsl_sf_legendre_H3d_array (int double double double*))
+	 (int gsl_sf_log_e (double gsl_sf_result*))
+	 (double gsl_sf_log (double))
+	 (int gsl_sf_log_abs_e (double gsl_sf_result*))
+	 (double gsl_sf_log_abs (double))
+	 (int gsl_sf_complex_log_e (double double gsl_sf_result* gsl_sf_result*))
+	 (int gsl_sf_log_1plusx_e (double gsl_sf_result*))
+	 (double gsl_sf_log_1plusx (double))
+	 (int gsl_sf_log_1plusx_mx_e (double gsl_sf_result*))
+	 (double gsl_sf_log_1plusx_mx (double))
+	 (int gsl_sf_mathieu_a_array (int int double gsl_sf_mathieu_workspace* double*))
+	 (int gsl_sf_mathieu_b_array (int int double gsl_sf_mathieu_workspace* double*))
+	 (int gsl_sf_mathieu_a_coeff (int double double double*))
+	 (int gsl_sf_mathieu_b_coeff (int double double double*))
+	 (gsl_sf_mathieu_workspace* gsl_sf_mathieu_alloc (size_t double))
+	 (void gsl_sf_mathieu_free (gsl_sf_mathieu_workspace*))
+	 (int gsl_sf_mathieu_ce_array (int int double double gsl_sf_mathieu_workspace* double*))
+	 (int gsl_sf_mathieu_se_array (int int double double gsl_sf_mathieu_workspace* double*))
+	 (reader-cond ((< gsl-version 2.0)
+		       (int gsl_sf_mathieu_Mc (int int double double gsl_sf_result*))
+		       (int gsl_sf_mathieu_Ms (int int double double gsl_sf_result*))
+		       (int gsl_sf_mathieu_ce (int double double gsl_sf_result*))
+		       (int gsl_sf_mathieu_se (int double double gsl_sf_result*))
+		       (int gsl_sf_mathieu_a (int double gsl_sf_result*))
+		       (int gsl_sf_mathieu_b (int double gsl_sf_result*)))
+		      (#t
+		       (int gsl_sf_mathieu_Mc_e (int int double double gsl_sf_result*))
+		       (double gsl_sf_mathieu_Mc (int int double double))
+		       (int gsl_sf_mathieu_Ms_e (int int double double gsl_sf_result*))
+		       (double gsl_sf_mathieu_Ms (int int double double))
+		       (int gsl_sf_mathieu_a_e (int double gsl_sf_result*))
+		       (double gsl_sf_mathieu_a (int double))
+		       (int gsl_sf_mathieu_b_e (int double gsl_sf_result*))
+		       (double gsl_sf_mathieu_b (int double))
+		       (int gsl_sf_mathieu_ce_e (int double double gsl_sf_result*))
+		       (double gsl_sf_mathieu_ce (int double double))
+		       (int gsl_sf_mathieu_se_e (int double double gsl_sf_result*))
+		       (double gsl_sf_mathieu_se (int double double))))
+	 (int gsl_sf_mathieu_Mc_array (int int int double double gsl_sf_mathieu_workspace* double*))
+	 (int gsl_sf_mathieu_Ms_array (int int int double double gsl_sf_mathieu_workspace* double*))
+	 (int gsl_sf_pow_int_e (double int gsl_sf_result*))
+	 (double gsl_sf_pow_int (double int))
+	 (int gsl_sf_psi_int_e (int gsl_sf_result*))
+	 (double gsl_sf_psi_int (int))
+	 (int gsl_sf_psi_e (double gsl_sf_result*))
+	 (double gsl_sf_psi (double))
+	 (int gsl_sf_psi_1piy_e (double gsl_sf_result*))
+	 (double gsl_sf_psi_1piy (double))
+	 (int gsl_sf_complex_psi_e (double double gsl_sf_result* gsl_sf_result*))
+	 (int gsl_sf_psi_1_int_e (int gsl_sf_result*))
+	 (double gsl_sf_psi_1_int (int))
+	 (int gsl_sf_psi_1_e (double gsl_sf_result*))
+	 (double gsl_sf_psi_1 (double))
+	 (int gsl_sf_psi_n_e (int double gsl_sf_result*))
+	 (double gsl_sf_psi_n (int double))
+	 (int gsl_sf_result_smash_e (gsl_sf_result_e10* gsl_sf_result*))
+	 (int gsl_sf_synchrotron_1_e (double gsl_sf_result*))
+	 (double gsl_sf_synchrotron_1 (double))
+	 (int gsl_sf_synchrotron_2_e (double gsl_sf_result*))
+	 (double gsl_sf_synchrotron_2 (double))
+	 (int gsl_sf_transport_2_e (double gsl_sf_result*))
+	 (double gsl_sf_transport_2 (double))
+	 (int gsl_sf_transport_3_e (double gsl_sf_result*))
+	 (double gsl_sf_transport_3 (double))
+	 (int gsl_sf_transport_4_e (double gsl_sf_result*))
+	 (double gsl_sf_transport_4 (double))
+	 (int gsl_sf_transport_5_e (double gsl_sf_result*))
+	 (double gsl_sf_transport_5 (double))
+	 (int gsl_sf_sin_e (double gsl_sf_result*))
+	 (double gsl_sf_sin (double))
+	 (int gsl_sf_cos_e (double gsl_sf_result*))
+	 (double gsl_sf_cos (double))
+	 (int gsl_sf_hypot_e (double double gsl_sf_result*))
+	 (double gsl_sf_hypot (double double))
+	 (int gsl_sf_complex_sin_e (double double gsl_sf_result* gsl_sf_result*))
+	 (int gsl_sf_complex_cos_e (double double gsl_sf_result* gsl_sf_result*))
+	 (int gsl_sf_complex_logsin_e (double double gsl_sf_result* gsl_sf_result*))
+	 (int gsl_sf_sinc_e (double gsl_sf_result*))
+	 (double gsl_sf_sinc (double))
+	 (int gsl_sf_lnsinh_e (double gsl_sf_result*))
+	 (double gsl_sf_lnsinh (double))
+	 (int gsl_sf_lncosh_e (double gsl_sf_result*))
+	 (double gsl_sf_lncosh (double))
+	 (int gsl_sf_polar_to_rect (double double gsl_sf_result* gsl_sf_result*))
+	 (int gsl_sf_rect_to_polar (double double gsl_sf_result* gsl_sf_result*))
+	 (int gsl_sf_sin_err_e (double double gsl_sf_result*))
+	 (int gsl_sf_cos_err_e (double double gsl_sf_result*))
+	 (int gsl_sf_angle_restrict_symm_e (double*))
+	 (double gsl_sf_angle_restrict_symm (double))
+	 (int gsl_sf_angle_restrict_pos_e (double*))
+	 (double gsl_sf_angle_restrict_pos (double))
+	 (int gsl_sf_angle_restrict_symm_err_e (double gsl_sf_result*))
+	 (int gsl_sf_angle_restrict_pos_err_e (double gsl_sf_result*))
+	 (int gsl_sf_zeta_int_e (int gsl_sf_result*))
+	 (double gsl_sf_zeta_int (int))
+	 (int gsl_sf_zeta_e (double gsl_sf_result*))
+	 (double gsl_sf_zeta (double))
+	 (int gsl_sf_zetam1_e (double gsl_sf_result*))
+	 (double gsl_sf_zetam1 (double))
+	 (int gsl_sf_zetam1_int_e (int gsl_sf_result*))
+	 (double gsl_sf_zetam1_int (int))
+	 (int gsl_sf_hzeta_e (double double gsl_sf_result*))
+	 (double gsl_sf_hzeta (double double))
+	 (int gsl_sf_eta_int_e (int gsl_sf_result*))
+	 (double gsl_sf_eta_int (int))
+	 (int gsl_sf_eta_e (double gsl_sf_result*))
+	 (double gsl_sf_eta (double))
+
+	 (in-C "
+                static s7_pointer g_gsl_sf_result_make(s7_scheme *sc, s7_pointer args)
+                {
+                  return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(gsl_sf_result)), gsl_sf_result__symbol, s7_f(sc)));
+                }
+                static s7_pointer g_gsl_sf_result_free(s7_scheme *sc, s7_pointer args)
+                {
+                  free(s7_c_pointer(s7_car(args)));
+                  return(s7_f(sc));
+                }
+                static s7_pointer g_gsl_sf_result_val(s7_scheme *sc, s7_pointer args)
+                {
+                  return(s7_make_real(sc, ((gsl_sf_result *)s7_c_pointer_with_type(sc, s7_car(args), gsl_sf_result__symbol, __func__, 1))->val));
+                }
+                static s7_pointer g_gsl_sf_result_err(s7_scheme *sc, s7_pointer args)
+                {
+                  return(s7_make_real(sc, ((gsl_sf_result *)s7_c_pointer_with_type(sc, s7_car(args), gsl_sf_result__symbol, __func__, 1))->err));
+                }
+                static s7_pointer g_gsl_sf_result_e10_make(s7_scheme *sc, s7_pointer args)
+                {
+                  return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(gsl_sf_result_e10)), gsl_sf_result_e10__symbol, s7_f(sc)));
+                }
+                static s7_pointer g_to_doubles(s7_scheme *sc, s7_pointer args)
+                {
+                  if (s7_is_vector(s7_car(args)))
+                    return(s7_make_c_pointer_with_type(sc, (void *)s7_float_vector_elements(s7_car(args)), double__symbol, s7_f(sc)));
+                  return(s7_car(args));
+                }
+                static s7_pointer g_to_wrapped_doubles(s7_scheme *sc, s7_pointer args)
+                {
+                  if (s7_is_vector(s7_car(args)))
+                    return(s7_make_c_pointer_wrapper_with_type(sc, (void *)s7_float_vector_elements(s7_car(args)), double__symbol, s7_f(sc)));
+                  return(s7_car(args));
+                }
+                ")
+
+	 (C-function ("gsl_sf_result.make" g_gsl_sf_result_make "" 0))
+	 (C-function ("gsl_sf_result.free" g_gsl_sf_result_free "" 1))
+	 (C-function ("gsl_sf_result_e10.make" g_gsl_sf_result_e10_make "" 0))
+	 (C-function ("gsl_sf_result.val" g_gsl_sf_result_val "" 1))
+	 (C-function ("gsl_sf_result.err" g_gsl_sf_result_err "" 1))
+	 (C-function ("double*" g_to_doubles "" 1))
+	 (C-function ("wrap-double*" g_to_wrapped_doubles "" 1))
+
+	 (double gsl_log1p (double))
+	 (double gsl_expm1 (double))
+	 (double gsl_hypot (double double))
+	 (double gsl_hypot3 (double double double))
+	 (double gsl_acosh (double))
+	 (double gsl_asinh (double))
+	 (double gsl_atanh (double))
+	 (int gsl_isnan (double))
+	 (int gsl_isinf (double))
+	 (int gsl_finite (double))
+	 (double gsl_nan (void))
+	 (double gsl_posinf (void))
+	 (double gsl_neginf (void))
+	 (double gsl_fdiv (double double))
+	 (double gsl_coerce_double (double))
+	 (double gsl_ldexp (double int))
+
+	 (in-C "
+                static s7_pointer g_gsl_frexp(s7_scheme *sc, s7_pointer args)
+                {
+                  int e = 0;
+                  double res;
+                  res = gsl_frexp(s7_real(s7_car(args)), &e);
+                  return(s7_list(sc, 2, s7_make_real(sc, res), s7_make_integer(sc, e)));
+                }
+                ")
+	 (C-function ("gsl_frexp" g_gsl_frexp "" 1))
+
+	 (int gsl_fcmp (double double double))
+	 (double gsl_pow_2 (double))
+	 (double gsl_pow_3 (double))
+	 (double gsl_pow_4 (double))
+	 (double gsl_pow_5 (double))
+	 (double gsl_pow_6 (double))
+	 (double gsl_pow_7 (double))
+	 (double gsl_pow_8 (double))
+	 (double gsl_pow_9 (double))
+	 (double gsl_pow_int (double int))
+
+	 ;; gsl_cdf
+	 (double gsl_cdf_ugaussian_P (double))
+	 (double gsl_cdf_ugaussian_Q (double))
+	 (double gsl_cdf_ugaussian_Pinv (double))
+	 (double gsl_cdf_ugaussian_Qinv (double))
+	 (double gsl_cdf_gaussian_P (double double))
+	 (double gsl_cdf_gaussian_Q (double double))
+	 (double gsl_cdf_gaussian_Pinv (double double))
+	 (double gsl_cdf_gaussian_Qinv (double double))
+	 (double gsl_cdf_gamma_P (double double double))
+	 (double gsl_cdf_gamma_Q (double double double))
+	 (double gsl_cdf_gamma_Pinv (double double double))
+	 (double gsl_cdf_gamma_Qinv (double double double))
+	 (double gsl_cdf_cauchy_P (double double))
+	 (double gsl_cdf_cauchy_Q (double double))
+	 (double gsl_cdf_cauchy_Pinv (double double))
+	 (double gsl_cdf_cauchy_Qinv (double double))
+	 (double gsl_cdf_laplace_P (double double))
+	 (double gsl_cdf_laplace_Q (double double))
+	 (double gsl_cdf_laplace_Pinv (double double))
+	 (double gsl_cdf_laplace_Qinv (double double))
+	 (double gsl_cdf_rayleigh_P (double double))
+	 (double gsl_cdf_rayleigh_Q (double double))
+	 (double gsl_cdf_rayleigh_Pinv (double double))
+	 (double gsl_cdf_rayleigh_Qinv (double double))
+	 (double gsl_cdf_chisq_P (double double))
+	 (double gsl_cdf_chisq_Q (double double))
+	 (double gsl_cdf_chisq_Pinv (double double))
+	 (double gsl_cdf_chisq_Qinv (double double))
+	 (double gsl_cdf_exponential_P (double double))
+	 (double gsl_cdf_exponential_Q (double double))
+	 (double gsl_cdf_exponential_Pinv (double double))
+	 (double gsl_cdf_exponential_Qinv (double double))
+	 (double gsl_cdf_exppow_P (double double double))
+	 (double gsl_cdf_exppow_Q (double double double))
+	 (double gsl_cdf_tdist_P (double double))
+	 (double gsl_cdf_tdist_Q (double double))
+	 (double gsl_cdf_tdist_Pinv (double double))
+	 (double gsl_cdf_tdist_Qinv (double double))
+	 (double gsl_cdf_fdist_P (double double double))
+	 (double gsl_cdf_fdist_Q (double double double))
+	 (double gsl_cdf_fdist_Pinv (double double double))
+	 (double gsl_cdf_fdist_Qinv (double double double))
+	 (double gsl_cdf_beta_P (double double double))
+	 (double gsl_cdf_beta_Q (double double double))
+	 (double gsl_cdf_beta_Pinv (double double double))
+	 (double gsl_cdf_beta_Qinv (double double double))
+	 (double gsl_cdf_flat_P (double double double))
+	 (double gsl_cdf_flat_Q (double double double))
+	 (double gsl_cdf_flat_Pinv (double double double))
+	 (double gsl_cdf_flat_Qinv (double double double))
+	 (double gsl_cdf_lognormal_P (double double double))
+	 (double gsl_cdf_lognormal_Q (double double double))
+	 (double gsl_cdf_lognormal_Pinv (double double double))
+	 (double gsl_cdf_lognormal_Qinv (double double double))
+	 (double gsl_cdf_gumbel1_P (double double double))
+	 (double gsl_cdf_gumbel1_Q (double double double))
+	 (double gsl_cdf_gumbel1_Pinv (double double double))
+	 (double gsl_cdf_gumbel1_Qinv (double double double))
+	 (double gsl_cdf_gumbel2_P (double double double))
+	 (double gsl_cdf_gumbel2_Q (double double double))
+	 (double gsl_cdf_gumbel2_Pinv (double double double))
+	 (double gsl_cdf_gumbel2_Qinv (double double double))
+	 (double gsl_cdf_weibull_P (double double double))
+	 (double gsl_cdf_weibull_Q (double double double))
+	 (double gsl_cdf_weibull_Pinv (double double double))
+	 (double gsl_cdf_weibull_Qinv (double double double))
+	 (double gsl_cdf_pareto_P (double double double))
+	 (double gsl_cdf_pareto_Q (double double double))
+	 (double gsl_cdf_pareto_Pinv (double double double))
+	 (double gsl_cdf_pareto_Qinv (double double double))
+	 (double gsl_cdf_logistic_P (double double))
+	 (double gsl_cdf_logistic_Q (double double))
+	 (double gsl_cdf_logistic_Pinv (double double))
+	 (double gsl_cdf_logistic_Qinv (double double))
+	 (double gsl_cdf_binomial_P (int double int))
+	 (double gsl_cdf_binomial_Q (int double int))
+	 (double gsl_cdf_poisson_P (int double))
+	 (double gsl_cdf_poisson_Q (int double))
+	 (double gsl_cdf_geometric_P (int double))
+	 (double gsl_cdf_geometric_Q (int double))
+	 (double gsl_cdf_negative_binomial_P (int double double))
+	 (double gsl_cdf_negative_binomial_Q (int double double))
+	 (double gsl_cdf_pascal_P (int double int))
+	 (double gsl_cdf_pascal_Q (int double int))
+	 (double gsl_cdf_hypergeometric_P (int int int int))
+	 (double gsl_cdf_hypergeometric_Q (int int int int))
+
+
+	 ;; gsl_dht
+	 (gsl_dht* gsl_dht_alloc (size_t))
+	 (gsl_dht* gsl_dht_new (size_t double double))
+	 (int gsl_dht_init (gsl_dht* double double))
+	 (double gsl_dht_x_sample (gsl_dht* int))
+	 (double gsl_dht_k_sample (gsl_dht* int))
+	 (void gsl_dht_free (gsl_dht*))
+	 (int gsl_dht_apply (gsl_dht* double* double*))
+
+	 ;; gsl_filter
+	 (reader-cond ((>= gsl-version 2.5)
+		       (int (GSL_FILTER_END_PADZERO GSL_FILTER_END_PADVALUE GSL_FILTER_END_TRUNCATE
+			     GSL_FILTER_SCALE_MAD GSL_FILTER_SCALE_IQR GSL_FILTER_SCALE_SN GSL_FILTER_SCALE_QN))
+		       (gsl_filter_gaussian_workspace* gsl_filter_gaussian_alloc (size_t))
+	               (void gsl_filter_gaussian_free (gsl_filter_gaussian_workspace*))
+	               (int gsl_filter_gaussian ((gsl_filter_end_t int) double size_t gsl_vector* gsl_vector* gsl_filter_gaussian_workspace*))
+	               (int gsl_filter_gaussian_kernel (double size_t int gsl_vector*))
+	               (gsl_filter_median_workspace* gsl_filter_median_alloc (size_t))
+	               (void gsl_filter_median_free (gsl_filter_median_workspace*))
+	               (int gsl_filter_median ((gsl_filter_end_t int) gsl_vector* gsl_vector* gsl_filter_median_workspace*))
+	               (gsl_filter_rmedian_workspace* gsl_filter_rmedian_alloc (size_t))
+	               (void gsl_filter_rmedian_free (gsl_filter_rmedian_workspace*))
+	               (int gsl_filter_rmedian ((gsl_filter_end_t int) gsl_vector* gsl_vector* gsl_filter_rmedian_workspace*))
+;	               ;2.6 (int gsl_filter_rmedian2 (gsl_vector* gsl_vector* gsl_filter_rmedian_workspace*))
+	               (gsl_filter_impulse_workspace* gsl_filter_impulse_alloc (size_t))
+	               (void gsl_filter_impulse_free (gsl_filter_impulse_workspace*))
+	               (int gsl_filter_impulse ((gsl_filter_end_t int) (gsl_filter_scale_t int) double gsl_vector* gsl_vector* gsl_vector* gsl_vector* size_t*
+                                                gsl_vector_int* gsl_filter_impulse_workspace*))))
+
+	 ;; gsl_movstat
+	 (reader-cond ((>= gsl-version 2.5)
+		       (int (GSL_MOVSTAT_END_PADZERO GSL_MOVSTAT_END_PADVALUE GSL_MOVSTAT_END_TRUNCATE))
+	               (gsl_movstat_workspace* gsl_movstat_alloc (size_t))
+	               (gsl_movstat_workspace* gsl_movstat_alloc2 (size_t size_t))
+	               (gsl_movstat_workspace* gsl_movstat_alloc_with_size (size_t size_t size_t))
+	               (void gsl_movstat_free (gsl_movstat_workspace*))
+	               (int gsl_movstat_apply_accum ((gsl_movstat_end_t int) gsl_vector* gsl_movstat_accum* void* gsl_vector* gsl_vector* gsl_movstat_workspace*))
+	               (int gsl_movstat_apply ((gsl_movstat_end_t int) gsl_movstat_function* gsl_vector* gsl_vector* gsl_movstat_workspace*))
+	               (size_t gsl_movstat_fill ((gsl_movstat_end_t int) gsl_vector* size_t size_t size_t double*))
+	               (int gsl_movstat_mean ((gsl_movstat_end_t int) gsl_vector* gsl_vector* gsl_movstat_workspace*))
+	               (int gsl_movstat_variance ((gsl_movstat_end_t int) gsl_vector* gsl_vector* gsl_movstat_workspace*))
+	               (int gsl_movstat_sd ((gsl_movstat_end_t int) gsl_vector* gsl_vector* gsl_movstat_workspace*))
+	               (int gsl_movstat_median ((gsl_movstat_end_t int) gsl_vector* gsl_vector* gsl_movstat_workspace*))
+	               (int gsl_movstat_min ((gsl_movstat_end_t int) gsl_vector* gsl_vector* gsl_movstat_workspace*))
+	               (int gsl_movstat_max ((gsl_movstat_end_t int) gsl_vector* gsl_vector* gsl_movstat_workspace*))
+	               (int gsl_movstat_minmax ((gsl_movstat_end_t int) gsl_vector* gsl_vector* gsl_vector* gsl_movstat_workspace*))
+	               (int gsl_movstat_mad0 ((gsl_movstat_end_t int) gsl_vector* gsl_vector* gsl_vector* gsl_movstat_workspace*))
+	               (int gsl_movstat_mad ((gsl_movstat_end_t int) gsl_vector* gsl_vector* gsl_vector* gsl_movstat_workspace*))
+	               (int gsl_movstat_qqr ((gsl_movstat_end_t int) gsl_vector* double gsl_vector* gsl_movstat_workspace*))
+	               (int gsl_movstat_Sn ((gsl_movstat_end_t int) gsl_vector* gsl_vector* gsl_movstat_workspace*))
+	               (int gsl_movstat_Qn ((gsl_movstat_end_t int) gsl_vector* gsl_vector* gsl_movstat_workspace*))
+	               (int gsl_movstat_sum ((gsl_movstat_end_t int) gsl_vector* gsl_vector* gsl_movstat_workspace*))
+#|
+	               (gsl_movstat_accum* (gsl_movstat_accum_mad gsl_movstat_accum_max gsl_movstat_accum_mean gsl_movstat_accum_median gsl_movstat_accum_min
+	                                    gsl_movstat_accum_minmax gsl_movstat_accum_sd gsl_movstat_accum_Sn gsl_movstat_accum_sum gsl_movstat_accum_Qn
+	                                    gsl_movstat_accum_qqr gsl_movstat_accum_userfunc gsl_movstat_accum_variance))
+|#
+		       ))
+
+	 ;; gsl_statistics
+	 (double gsl_stats_mean (double* size_t size_t))
+	 (double gsl_stats_variance (double* size_t size_t))
+	 (double gsl_stats_sd (double* size_t size_t))
+	 (double gsl_stats_variance_with_fixed_mean (double* size_t size_t double))
+	 (double gsl_stats_sd_with_fixed_mean (double* size_t size_t double))
+	 (double gsl_stats_tss (double* size_t size_t))
+	 (double gsl_stats_tss_m (double* size_t size_t double))
+	 (double gsl_stats_absdev (double* size_t size_t))
+	 (double gsl_stats_skew (double* size_t size_t))
+	 (double gsl_stats_kurtosis (double* size_t size_t))
+	 (double gsl_stats_lag1_autocorrelation (double* size_t size_t))
+	 (double gsl_stats_covariance (double* size_t double* size_t size_t))
+	 (double gsl_stats_correlation (double* size_t double* size_t size_t))
+	 (reader-cond ((>= gsl-version 1.16) (double gsl_stats_spearman (double* size_t double* size_t size_t double*))))
+	 (double gsl_stats_variance_m (double* size_t size_t double))
+	 (double gsl_stats_sd_m (double* size_t size_t double))
+	 (double gsl_stats_absdev_m (double* size_t size_t double))
+	 (double gsl_stats_skew_m_sd (double* size_t size_t double double))
+	 (double gsl_stats_kurtosis_m_sd (double* size_t size_t double double))
+	 (double gsl_stats_lag1_autocorrelation_m (double* size_t size_t double))
+	 (double gsl_stats_covariance_m (double* size_t double* size_t size_t double double))
+	 (double gsl_stats_wmean (double* size_t double* size_t size_t))
+	 (double gsl_stats_wvariance (double* size_t double* size_t size_t))
+	 (double gsl_stats_wsd (double* size_t double* size_t size_t))
+	 (double gsl_stats_wvariance_with_fixed_mean (double* size_t double* size_t size_t double))
+	 (double gsl_stats_wsd_with_fixed_mean (double* size_t double* size_t size_t double))
+	 (double gsl_stats_wtss (double* size_t double* size_t size_t))
+	 (double gsl_stats_wtss_m (double* size_t double* size_t size_t double))
+	 (double gsl_stats_wabsdev (double* size_t double* size_t size_t))
+	 (double gsl_stats_wskew (double* size_t double* size_t size_t))
+	 (double gsl_stats_wkurtosis (double* size_t double* size_t size_t))
+	 (double gsl_stats_wvariance_m (double* size_t double* size_t size_t double))
+	 (double gsl_stats_wsd_m (double* size_t double* size_t size_t double))
+	 (double gsl_stats_wabsdev_m (double* size_t double* size_t size_t double))
+	 (double gsl_stats_wskew_m_sd (double* size_t double* size_t size_t double double))
+	 (double gsl_stats_wkurtosis_m_sd (double* size_t double* size_t size_t double double))
+	 (double gsl_stats_pvariance (double* size_t size_t double* size_t size_t))
+	 (double gsl_stats_ttest (double* size_t size_t double* size_t size_t))
+	 (double gsl_stats_max (double* size_t size_t))
+	 (double gsl_stats_min (double* size_t size_t))
+	 (void gsl_stats_minmax (double* double* double* size_t size_t))
+	 (size_t gsl_stats_max_index (double* size_t size_t))
+	 (size_t gsl_stats_min_index (double* size_t size_t))
+	 (void gsl_stats_minmax_index (size_t* size_t* double* size_t size_t))
+	 (double gsl_stats_median_from_sorted_data (double* size_t size_t))
+	 (double gsl_stats_quantile_from_sorted_data (double* size_t size_t double))
+
+	 (reader-cond ((>= gsl-version 2.5)
+ 	               (double gsl_stats_select (double* size_t size_t size_t))
+	               (double gsl_stats_median (double* size_t size_t))
+	               (double gsl_stats_trmean_from_sorted_data (double double* size_t size_t))
+	               (double gsl_stats_gastwirth_from_sorted_data (double* size_t size_t))
+	               (double gsl_stats_mad0 (double* size_t size_t double*))
+	               (double gsl_stats_mad (double* size_t size_t double*))
+	               (double gsl_stats_Sn0_from_sorted_data (double* size_t size_t double*))
+	               (double gsl_stats_Sn_from_sorted_data (double* size_t size_t double*))
+	               (double gsl_stats_Qn0_from_sorted_data (double* size_t size_t double* int*))
+	               (double gsl_stats_Qn_from_sorted_data (double* size_t size_t double* int*))))
+
+
+	 (gsl_interp_type* (gsl_interp_linear gsl_interp_polynomial gsl_interp_cspline gsl_interp_cspline_periodic
+			    gsl_interp_akima gsl_interp_akima_periodic))
+	 (gsl_min_fminimizer_type* (gsl_min_fminimizer_goldensection gsl_min_fminimizer_brent gsl_min_fminimizer_quad_golden))
+	 (gsl_multimin_fminimizer_type* (gsl_multimin_fminimizer_nmsimplex gsl_multimin_fminimizer_nmsimplex2 gsl_multimin_fminimizer_nmsimplex2rand))
+	 (gsl_multiroot_fsolver_type* (gsl_multiroot_fsolver_dnewton gsl_multiroot_fsolver_broyden gsl_multiroot_fsolver_hybrid gsl_multiroot_fsolver_hybrids))
+	 (double* (gsl_prec_eps gsl_prec_sqrt_eps gsl_prec_root3_eps gsl_prec_root4_eps gsl_prec_root5_eps gsl_prec_root6_eps))
+	 (gsl_root_fsolver_type* (gsl_root_fsolver_bisection gsl_root_fsolver_brent gsl_root_fsolver_falsepos))
+	 (char* (gsl_version))
+	 (gsl_wavelet_type* (gsl_wavelet_daubechies gsl_wavelet_daubechies_centered gsl_wavelet_haar gsl_wavelet_haar_centered gsl_wavelet_bspline
+			     gsl_wavelet_bspline_centered))
+
+	 (reader-cond ((>= gsl-version 1.16)
+		       (gsl_multifit_robust_type* (gsl_multifit_robust_default gsl_multifit_robust_bisquare gsl_multifit_robust_cauchy gsl_multifit_robust_fair
+				                   gsl_multifit_robust_huber gsl_multifit_robust_ols gsl_multifit_robust_welsch))))
+
+	 (reader-cond ((>= gsl-version 2.0)
+		       (gsl_interp_type* (gsl_interp_steffen))))
+
+	 (int (gsl_message_mask gsl_check_range))
+
+	 ;; randist, rng
+	 (gsl_qrng_type* (gsl_qrng_niederreiter_2 gsl_qrng_sobol gsl_qrng_halton gsl_qrng_reversehalton))
+	 (gsl_rng_type* (gsl_rng_default gsl_rng_borosh13 gsl_rng_coveyou gsl_rng_cmrg gsl_rng_fishman18 gsl_rng_fishman20 gsl_rng_fishman2x gsl_rng_gfsr4
+		         gsl_rng_knuthran gsl_rng_knuthran2 gsl_rng_knuthran2002 gsl_rng_lecuyer21 gsl_rng_minstd gsl_rng_mrg gsl_rng_mt19937
+			 gsl_rng_mt19937_1999 gsl_rng_mt19937_1998 gsl_rng_r250 gsl_rng_ran0 gsl_rng_ran1 gsl_rng_ran2 gsl_rng_ran3 gsl_rng_rand
+			 gsl_rng_rand48 gsl_rng_random128_bsd gsl_rng_random128_glibc2 gsl_rng_random128_libc5 gsl_rng_random256_bsd
+			 gsl_rng_random256_glibc2 gsl_rng_random256_libc5 gsl_rng_random32_bsd gsl_rng_random32_glibc2 gsl_rng_random32_libc5
+			 gsl_rng_random64_bsd gsl_rng_random64_glibc2 gsl_rng_random64_libc5 gsl_rng_random8_bsd gsl_rng_random8_glibc2
+			 gsl_rng_random8_libc5 gsl_rng_random_bsd gsl_rng_random_glibc2 gsl_rng_random_libc5 gsl_rng_randu
+			 gsl_rng_ranf gsl_rng_ranlux gsl_rng_ranlux389 gsl_rng_ranlxd1 gsl_rng_ranlxd2 gsl_rng_ranlxs0 gsl_rng_ranlxs1
+			 gsl_rng_ranlxs2 gsl_rng_ranmar gsl_rng_slatec gsl_rng_taus gsl_rng_taus2 gsl_rng_taus113 gsl_rng_transputer
+			 gsl_rng_tt800 gsl_rng_uni gsl_rng_uni32 gsl_rng_vax gsl_rng_waterman14 gsl_rng_zuf gsl_rng_default_seed))
+
+	 (gsl_qrng* gsl_qrng_alloc (gsl_qrng_type* int))
+	 (int gsl_qrng_memcpy (gsl_qrng* gsl_qrng*))
+	 (gsl_qrng* gsl_qrng_clone (gsl_qrng*))
+	 (void gsl_qrng_free (gsl_qrng*))
+	 (void gsl_qrng_init (gsl_qrng*))
+	 (char* gsl_qrng_name (gsl_qrng*))
+	 (size_t gsl_qrng_size (gsl_qrng*))
+	 (void* gsl_qrng_state (gsl_qrng*))
+	 (int gsl_qrng_get (gsl_qrng* double*))
+	 (int gsl_ran_bernoulli (gsl_rng* double))
+	 (double gsl_ran_bernoulli_pdf (int double))
+	 (double gsl_ran_beta (gsl_rng* double double))
+	 (double gsl_ran_beta_pdf (double double double))
+	 (int gsl_ran_binomial (gsl_rng* double int))
+	 (int gsl_ran_binomial_knuth (gsl_rng* double int))
+	 (int gsl_ran_binomial_tpe (gsl_rng* double int))
+	 (double gsl_ran_binomial_pdf (int double int))
+	 (double gsl_ran_exponential (gsl_rng* double))
+	 (double gsl_ran_exponential_pdf (double double))
+	 (double gsl_ran_exppow (gsl_rng* double double))
+	 (double gsl_ran_exppow_pdf (double double double))
+	 (double gsl_ran_cauchy (gsl_rng* double))
+	 (double gsl_ran_cauchy_pdf (double double))
+	 (double gsl_ran_chisq (gsl_rng* double))
+	 (double gsl_ran_chisq_pdf (double double))
+	 (void gsl_ran_dirichlet (gsl_rng* size_t double* double*))
+	 (double gsl_ran_dirichlet_pdf (size_t double* double*))
+	 (double gsl_ran_dirichlet_lnpdf (size_t double* double*))
+	 (double gsl_ran_erlang (gsl_rng* double double))
+	 (double gsl_ran_erlang_pdf (double double double))
+	 (double gsl_ran_fdist (gsl_rng* double double))
+	 (double gsl_ran_fdist_pdf (double double double))
+	 (double gsl_ran_flat (gsl_rng* double double))
+	 (double gsl_ran_flat_pdf (double double double))
+	 (double gsl_ran_gamma (gsl_rng* double double))
+	 (double gsl_ran_gamma_int (gsl_rng* int))
+	 (double gsl_ran_gamma_pdf (double double double))
+	 (double gsl_ran_gamma_mt (gsl_rng* double double))
+	 (double gsl_ran_gamma_knuth (gsl_rng* double double))
+	 (double gsl_ran_gaussian (gsl_rng* double))
+	 (double gsl_ran_gaussian_ratio_method (gsl_rng* double))
+	 (double gsl_ran_gaussian_ziggurat (gsl_rng* double))
+	 (double gsl_ran_gaussian_pdf (double double))
+	 (double gsl_ran_ugaussian (gsl_rng*))
+	 (double gsl_ran_ugaussian_ratio_method (gsl_rng*))
+	 (double gsl_ran_ugaussian_pdf (double))
+	 (double gsl_ran_gaussian_tail (gsl_rng* double double))
+	 (double gsl_ran_gaussian_tail_pdf (double double double))
+	 (double gsl_ran_ugaussian_tail (gsl_rng* double))
+	 (double gsl_ran_ugaussian_tail_pdf (double double))
+	 (void gsl_ran_bivariate_gaussian (gsl_rng* double double double double* double*))
+	 (double gsl_ran_bivariate_gaussian_pdf (double double double double double))
+	 (double gsl_ran_landau (gsl_rng*))
+	 (double gsl_ran_landau_pdf (double))
+	 (int gsl_ran_geometric (gsl_rng* double))
+	 (double gsl_ran_geometric_pdf (int double))
+	 (int gsl_ran_hypergeometric (gsl_rng* int int int))
+	 (double gsl_ran_hypergeometric_pdf (int int int int))
+	 (double gsl_ran_gumbel1 (gsl_rng* double double))
+	 (double gsl_ran_gumbel1_pdf (double double double))
+	 (double gsl_ran_gumbel2 (gsl_rng* double double))
+	 (double gsl_ran_gumbel2_pdf (double double double))
+	 (double gsl_ran_logistic (gsl_rng* double))
+	 (double gsl_ran_logistic_pdf (double double))
+	 (double gsl_ran_lognormal (gsl_rng* double double))
+	 (double gsl_ran_lognormal_pdf (double double double))
+	 (int gsl_ran_logarithmic (gsl_rng* double))
+	 (double gsl_ran_logarithmic_pdf (int double))
+	 ;; int*		    (void gsl_ran_multinomial (gsl_rng* size_t int double* int*)) ; unsigned int*
+	 ;; int*		    (double gsl_ran_multinomial_pdf (size_t double* int*))        ; unsigned int*
+	 ;; int*		    (double gsl_ran_multinomial_lnpdf (size_t double* int*))      ; unsigned int*
+	 (int gsl_ran_negative_binomial (gsl_rng* double double))
+	 (double gsl_ran_negative_binomial_pdf (int double double))
+	 (int gsl_ran_pascal (gsl_rng* double int))
+	 (double gsl_ran_pascal_pdf (int double int))
+	 (double gsl_ran_pareto (gsl_rng* double double))
+	 (double gsl_ran_pareto_pdf (double double double))
+	 (int gsl_ran_poisson (gsl_rng* double))
+	 ;; int*		    (void gsl_ran_poisson_array (gsl_rng* size_t int* double))   ; unsigned int*
+	 (double gsl_ran_poisson_pdf (int double))
+	 (double gsl_ran_rayleigh (gsl_rng* double))
+	 (double gsl_ran_rayleigh_pdf (double double))
+	 (double gsl_ran_rayleigh_tail (gsl_rng* double double))
+	 (double gsl_ran_rayleigh_tail_pdf (double double double))
+	 (double gsl_ran_tdist (gsl_rng* double))
+	 (double gsl_ran_tdist_pdf (double double))
+	 (double gsl_ran_laplace (gsl_rng* double))
+	 (double gsl_ran_laplace_pdf (double double))
+	 (double gsl_ran_levy (gsl_rng* double double))
+	 (double gsl_ran_levy_skew (gsl_rng* double double double))
+	 (double gsl_ran_weibull (gsl_rng* double double))
+	 (double gsl_ran_weibull_pdf (double double double))
+	 (void gsl_ran_dir_2d (gsl_rng* double* double*))
+	 (void gsl_ran_dir_2d_trig_method (gsl_rng* double* double*))
+	 (void gsl_ran_dir_3d (gsl_rng* double* double* double*))
+	 (void gsl_ran_dir_nd (gsl_rng* size_t double*))
+	 (void gsl_ran_shuffle (gsl_rng* void* size_t size_t))
+	 (int gsl_ran_choose (gsl_rng* void* size_t void* size_t size_t))
+	 (void gsl_ran_sample (gsl_rng* void* size_t void* size_t size_t))
+	 (gsl_ran_discrete_t* gsl_ran_discrete_preproc (size_t double*))
+	 (void gsl_ran_discrete_free (gsl_ran_discrete_t*))
+	 (size_t gsl_ran_discrete (gsl_rng* gsl_ran_discrete_t*))
+	 (double gsl_ran_discrete_pdf (size_t gsl_ran_discrete_t*))
+	 (gsl_rng_type** gsl_rng_types_setup (void))
+	 (gsl_rng* gsl_rng_alloc (gsl_rng_type*))
+	 (int gsl_rng_memcpy (gsl_rng* gsl_rng*))
+	 (gsl_rng* gsl_rng_clone (gsl_rng*))
+	 (void gsl_rng_free (gsl_rng*))
+	 (void gsl_rng_set (gsl_rng* int))
+	 (int gsl_rng_max (gsl_rng*))
+	 (int gsl_rng_min (gsl_rng*))
+	 (char* gsl_rng_name (gsl_rng*))
+	 (int gsl_rng_fread (FILE* gsl_rng*))
+	 (int gsl_rng_fwrite (FILE* gsl_rng*))
+	 (size_t gsl_rng_size (gsl_rng*))
+	 (void* gsl_rng_state (gsl_rng*))
+	 (void gsl_rng_print_state (gsl_rng*))
+	 (gsl_rng_type* gsl_rng_env_setup (void))
+	 (int gsl_rng_get (gsl_rng*))
+	 (double gsl_rng_uniform (gsl_rng*))
+	 (double gsl_rng_uniform_pos (gsl_rng*))
+	 (int gsl_rng_uniform_int (gsl_rng* int))
+
+	 ;; gsl_complex
+	 (in-C "#define S7_TO_GSL_COMPLEX(sg, g) GSL_SET_COMPLEX(&g, s7_real_part(sg), s7_imag_part(sg))
+                #define GSL_TO_S7_COMPLEX(sc, g) s7_make_complex(sc, GSL_REAL(g), GSL_IMAG(g))
+
+                static s7_pointer s7_gsl_c_c(s7_scheme *sc, s7_pointer arg1, gsl_complex (*callee)(gsl_complex a))
+                {
+                  gsl_complex g, g1;
+                  S7_TO_GSL_COMPLEX(arg1, g1);
+                  g = callee(g1);
+                  return(GSL_TO_S7_COMPLEX(sc, g));
+                }
+                static s7_pointer s7_gsl_r_c(s7_scheme *sc, s7_pointer arg1, gsl_complex (*callee)(double a))
+                {
+                  gsl_complex g;
+                  g = callee(s7_number_to_real_with_caller(sc, arg1, __func__));
+                  return(GSL_TO_S7_COMPLEX(sc, g));
+                }
+                static s7_pointer s7_gsl_c_r(s7_scheme *sc, s7_pointer arg1, double (*callee)(gsl_complex a))
+                {
+                  gsl_complex g1;
+                  S7_TO_GSL_COMPLEX(arg1, g1);
+                  return(s7_make_real(sc, callee(g1)));
+                }
+                static s7_pointer s7_gsl_cc_c(s7_scheme *sc, s7_pointer arg1, s7_pointer arg2, gsl_complex (*callee)(gsl_complex a, gsl_complex b))
+                {
+                  gsl_complex g, g1, g2;
+                  S7_TO_GSL_COMPLEX(arg1, g1);
+                  S7_TO_GSL_COMPLEX(arg2, g2);
+                  g = callee(g1, g2);
+                  return(GSL_TO_S7_COMPLEX(sc, g));
+                }
+                static s7_pointer s7_gsl_cr_c(s7_scheme *sc, s7_pointer arg1, s7_pointer arg2, gsl_complex (*callee)(gsl_complex a, double b))
+                {
+                  gsl_complex g, g1;
+                  S7_TO_GSL_COMPLEX(arg1, g1);
+                  g = callee(g1, s7_number_to_real_with_caller(sc, arg2, __func__));
+                  return(GSL_TO_S7_COMPLEX(sc, g));
+                }
+                static s7_pointer g_gsl_complex_arg(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_r(sc, s7_car(args), gsl_complex_arg));}
+                static s7_pointer g_gsl_complex_abs(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_r(sc, s7_car(args), gsl_complex_abs));}
+                static s7_pointer g_gsl_complex_abs2(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_r(sc, s7_car(args), gsl_complex_abs2));}
+                static s7_pointer g_gsl_complex_logabs(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_r(sc, s7_car(args), gsl_complex_logabs));}
+                static s7_pointer g_gsl_complex_conjugate(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_conjugate));}
+                static s7_pointer g_gsl_complex_inverse(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_inverse));}
+                static s7_pointer g_gsl_complex_negative(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_negative));}
+                static s7_pointer g_gsl_complex_sqrt(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_sqrt));}
+                static s7_pointer g_gsl_complex_exp(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_exp));}
+                static s7_pointer g_gsl_complex_log(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_log));}
+                static s7_pointer g_gsl_complex_log10(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_log10));}
+                static s7_pointer g_gsl_complex_sin(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_sin));}
+                static s7_pointer g_gsl_complex_cos(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_cos));}
+                static s7_pointer g_gsl_complex_sec(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_sec));}
+                static s7_pointer g_gsl_complex_csc(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_csc));}
+                static s7_pointer g_gsl_complex_tan(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_tan));}
+                static s7_pointer g_gsl_complex_cot(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_cot));}
+                static s7_pointer g_gsl_complex_sinh(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_sinh));}
+                static s7_pointer g_gsl_complex_cosh(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_cosh));}
+                static s7_pointer g_gsl_complex_sech(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_sech));}
+                static s7_pointer g_gsl_complex_csch(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_csch));}
+                static s7_pointer g_gsl_complex_tanh(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_tanh));}
+                static s7_pointer g_gsl_complex_coth(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_coth));}
+                static s7_pointer g_gsl_complex_arctan(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arctan));}
+                static s7_pointer g_gsl_complex_arccot(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arccot));}
+                static s7_pointer g_gsl_complex_arcsinh(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arcsinh));}
+                static s7_pointer g_gsl_complex_arcsech(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arcsech));}
+                static s7_pointer g_gsl_complex_arccsch(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arccsch));}
+                static s7_pointer g_gsl_complex_arccoth(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arccoth));}
+                static s7_pointer g_gsl_complex_arcsin(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arcsin));}
+                static s7_pointer g_gsl_complex_arccos(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arccos));}
+                static s7_pointer g_gsl_complex_arcsec(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arcsec));}
+                static s7_pointer g_gsl_complex_arccsc(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arccsc));}
+                static s7_pointer g_gsl_complex_arccosh(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arccosh));}
+                static s7_pointer g_gsl_complex_arctanh(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arctanh));}
+                static s7_pointer g_gsl_complex_sqrt_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_r_c(sc, s7_car(args), gsl_complex_sqrt_real));}
+                static s7_pointer g_gsl_complex_arcsin_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_r_c(sc, s7_car(args), gsl_complex_arcsin_real));}
+                static s7_pointer g_gsl_complex_arccos_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_r_c(sc, s7_car(args), gsl_complex_arccos_real));}
+                static s7_pointer g_gsl_complex_arcsec_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_r_c(sc, s7_car(args), gsl_complex_arcsec_real));}
+                static s7_pointer g_gsl_complex_arccsc_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_r_c(sc, s7_car(args), gsl_complex_arccsc_real));}
+                static s7_pointer g_gsl_complex_arccosh_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_r_c(sc, s7_car(args), gsl_complex_arccosh_real));}
+                static s7_pointer g_gsl_complex_arctanh_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_r_c(sc, s7_car(args), gsl_complex_arctanh_real));}
+                static s7_pointer g_gsl_complex_add(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cc_c(sc, s7_car(args), s7_cadr(args), gsl_complex_add));}
+                static s7_pointer g_gsl_complex_sub(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cc_c(sc, s7_car(args), s7_cadr(args), gsl_complex_sub));}
+                static s7_pointer g_gsl_complex_mul(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cc_c(sc, s7_car(args), s7_cadr(args), gsl_complex_mul));}
+                static s7_pointer g_gsl_complex_div(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cc_c(sc, s7_car(args), s7_cadr(args), gsl_complex_div));}
+                static s7_pointer g_gsl_complex_log_b(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cc_c(sc, s7_car(args), s7_cadr(args), gsl_complex_log_b));}
+                static s7_pointer g_gsl_complex_pow(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cc_c(sc, s7_car(args), s7_cadr(args), gsl_complex_pow));}
+                static s7_pointer g_gsl_complex_add_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cr_c(sc, s7_car(args), s7_cadr(args), gsl_complex_add_real));}
+                static s7_pointer g_gsl_complex_sub_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cr_c(sc, s7_car(args), s7_cadr(args), gsl_complex_sub_real));}
+                static s7_pointer g_gsl_complex_mul_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cr_c(sc, s7_car(args), s7_cadr(args), gsl_complex_mul_real));}
+                static s7_pointer g_gsl_complex_div_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cr_c(sc, s7_car(args), s7_cadr(args), gsl_complex_div_real));}
+                static s7_pointer g_gsl_complex_add_imag(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cr_c(sc, s7_car(args), s7_cadr(args), gsl_complex_add_imag));}
+                static s7_pointer g_gsl_complex_sub_imag(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cr_c(sc, s7_car(args), s7_cadr(args), gsl_complex_sub_imag));}
+                static s7_pointer g_gsl_complex_mul_imag(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cr_c(sc, s7_car(args), s7_cadr(args), gsl_complex_mul_imag));}
+                static s7_pointer g_gsl_complex_div_imag(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cr_c(sc, s7_car(args), s7_cadr(args), gsl_complex_div_imag));}
+                static s7_pointer g_gsl_complex_pow_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cr_c(sc, s7_car(args), s7_cadr(args), gsl_complex_pow_real));}
+                ")
+
+	 (C-function ("gsl_complex_arg" g_gsl_complex_arg "" 1))
+	 (C-function ("gsl_complex_abs" g_gsl_complex_abs "" 1))
+	 (C-function ("gsl_complex_abs2" g_gsl_complex_abs2 "" 1))
+	 (C-function ("gsl_complex_logabs" g_gsl_complex_logabs "" 1))
+
+	 (C-function ("gsl_complex_conjugate" g_gsl_complex_conjugate "" 1))
+	 (C-function ("gsl_complex_inverse" g_gsl_complex_inverse "" 1))
+	 (C-function ("gsl_complex_negative" g_gsl_complex_negative "" 1))
+	 (C-function ("gsl_complex_sqrt" g_gsl_complex_sqrt "" 1))
+	 (C-function ("gsl_complex_exp" g_gsl_complex_exp "" 1))
+	 (C-function ("gsl_complex_log" g_gsl_complex_log "" 1))
+	 (C-function ("gsl_complex_log10" g_gsl_complex_log10 "" 1))
+	 (C-function ("gsl_complex_sin" g_gsl_complex_sin "" 1))
+	 (C-function ("gsl_complex_cos" g_gsl_complex_cos "" 1))
+	 (C-function ("gsl_complex_sec" g_gsl_complex_sec "" 1))
+	 (C-function ("gsl_complex_csc" g_gsl_complex_csc "" 1))
+	 (C-function ("gsl_complex_tan" g_gsl_complex_tan "" 1))
+	 (C-function ("gsl_complex_cot" g_gsl_complex_cot "" 1))
+	 (C-function ("gsl_complex_sinh" g_gsl_complex_sinh "" 1))
+	 (C-function ("gsl_complex_cosh" g_gsl_complex_cosh "" 1))
+	 (C-function ("gsl_complex_sech" g_gsl_complex_sech "" 1))
+	 (C-function ("gsl_complex_csch" g_gsl_complex_csch "" 1))
+	 (C-function ("gsl_complex_tanh" g_gsl_complex_tanh "" 1))
+	 (C-function ("gsl_complex_coth" g_gsl_complex_coth "" 1))
+	 (C-function ("gsl_complex_arctan" g_gsl_complex_arctan "" 1))
+	 (C-function ("gsl_complex_arccot" g_gsl_complex_arccot "" 1))
+	 (C-function ("gsl_complex_arcsinh" g_gsl_complex_arcsinh "" 1))
+	 (C-function ("gsl_complex_arcsech" g_gsl_complex_arcsech "" 1))
+	 (C-function ("gsl_complex_arccsch" g_gsl_complex_arccsch "" 1))
+	 (C-function ("gsl_complex_arccoth" g_gsl_complex_arccoth "" 1))
+	 (C-function ("gsl_complex_arcsin" g_gsl_complex_arcsin "" 1))
+	 (C-function ("gsl_complex_arccos" g_gsl_complex_arccos "" 1))
+	 (C-function ("gsl_complex_arcsec" g_gsl_complex_arcsec "" 1))
+	 (C-function ("gsl_complex_arccsc" g_gsl_complex_arccsc "" 1))
+	 (C-function ("gsl_complex_arccosh" g_gsl_complex_arccosh "" 1))
+	 (C-function ("gsl_complex_arctanh" g_gsl_complex_arctanh "" 1))
+
+	 (C-function ("gsl_complex_sqrt_real" g_gsl_complex_sqrt_real "" 1))
+	 (C-function ("gsl_complex_arcsin_real" g_gsl_complex_arcsin_real "" 1))
+	 (C-function ("gsl_complex_arccos_real" g_gsl_complex_arccos_real "" 1))
+	 (C-function ("gsl_complex_arcsec_real" g_gsl_complex_arcsec_real "" 1))
+	 (C-function ("gsl_complex_arccsc_real" g_gsl_complex_arccsc_real "" 1))
+	 (C-function ("gsl_complex_arccosh_real" g_gsl_complex_arccosh_real "" 1))
+	 (C-function ("gsl_complex_arctanh_real" g_gsl_complex_arctanh_real "" 1))
+
+	 (C-function ("gsl_complex_add" g_gsl_complex_add "" 2))
+	 (C-function ("gsl_complex_sub" g_gsl_complex_sub "" 2))
+	 (C-function ("gsl_complex_mul" g_gsl_complex_mul "" 2))
+	 (C-function ("gsl_complex_div" g_gsl_complex_div "" 2))
+	 (C-function ("gsl_complex_log_b" g_gsl_complex_log_b "" 2))
+	 (C-function ("gsl_complex_pow" g_gsl_complex_pow "" 2))
+
+	 (C-function ("gsl_complex_add_real" g_gsl_complex_add_real "" 2))
+	 (C-function ("gsl_complex_sub_real" g_gsl_complex_sub_real "" 2))
+	 (C-function ("gsl_complex_mul_real" g_gsl_complex_mul_real "" 2))
+	 (C-function ("gsl_complex_div_real" g_gsl_complex_div_real "" 2))
+	 (C-function ("gsl_complex_add_imag" g_gsl_complex_add_imag "" 2))
+	 (C-function ("gsl_complex_sub_imag" g_gsl_complex_sub_imag "" 2))
+	 (C-function ("gsl_complex_mul_imag" g_gsl_complex_mul_imag "" 2))
+	 (C-function ("gsl_complex_div_imag" g_gsl_complex_div_imag "" 2))
+	 (C-function ("gsl_complex_pow_real" g_gsl_complex_pow_real "" 2))
+
+
+	 ;; cheb
+	 (gsl_cheb_series* gsl_cheb_alloc (size_t))
+	 (void gsl_cheb_free (gsl_cheb_series*))
+	 (size_t gsl_cheb_order (gsl_cheb_series*))
+	 (size_t gsl_cheb_size (gsl_cheb_series*))
+	 (double* gsl_cheb_coeffs (gsl_cheb_series*))
+	 (double gsl_cheb_eval (gsl_cheb_series* double))
+	 (int gsl_cheb_eval_err (gsl_cheb_series* double double* double*))
+	 (double gsl_cheb_eval_n (gsl_cheb_series* size_t double))
+	 (int gsl_cheb_eval_n_err (gsl_cheb_series* size_t double double* double*))
+	 (double gsl_cheb_eval_mode (gsl_cheb_series* double int))
+	 (int gsl_cheb_eval_mode_e (gsl_cheb_series* double int double* double*))
+	 (int gsl_cheb_calc_deriv (gsl_cheb_series* gsl_cheb_series*))
+	 (int gsl_cheb_calc_integ (gsl_cheb_series* gsl_cheb_series*))
+
+	 ;; gsl_function is a struct with double function(double void*) and void* params
+	 (in-C "
+                static s7_scheme *gsl_f_s7;
+                static gsl_function gsl_f;
+                static double gsl_f_caller(double x, void *p)
+                {
+                  return(s7_real(s7_call(gsl_f_s7, (s7_pointer)p, s7_cons(gsl_f_s7, s7_make_real(gsl_f_s7, x), s7_nil(gsl_f_s7)))));
+                }
+                #define make_gsl_function(Args) do {gsl_f.function = gsl_f_caller; gsl_f.params = (void *)Args; gsl_f_s7 = sc;} while (0)
+                static s7_pointer g_gsl_cheb_init(s7_scheme *sc, s7_pointer args)
+                {
+                  make_gsl_function(s7_cadr(args));
+                  return(s7_make_integer(sc, gsl_cheb_init((gsl_cheb_series *)s7_c_pointer_with_type(sc, s7_car(args), gsl_cheb_series__symbol, __func__, 1),
+                                                           &gsl_f, s7_real(s7_caddr(args)), s7_real(s7_cadddr(args)))));
+                }
+                ")
+	 (C-function ("gsl_cheb_init" g_gsl_cheb_init "" 4))
+
+	 ;; interp
+	 (gsl_interp_accel* gsl_interp_accel_alloc (void))
+	 (int gsl_interp_accel_reset (gsl_interp_accel*))
+	 (void gsl_interp_accel_free (gsl_interp_accel*))
+	 (gsl_interp* gsl_interp_alloc (gsl_interp_type* size_t))
+	 (int gsl_interp_init (gsl_interp* double* double* size_t))
+	 (char* gsl_interp_name (gsl_interp*))
+	 (int gsl_interp_min_size (gsl_interp*))
+	 (reader-cond ((>= gsl-version 1.15) (int gsl_interp_type_min_size (gsl_interp_type*))))
+	 (int gsl_interp_eval_e (gsl_interp* double* double* double gsl_interp_accel* double*))
+	 (double gsl_interp_eval (gsl_interp* double* double* double gsl_interp_accel*))
+	 (int gsl_interp_eval_deriv_e (gsl_interp* double* double* double gsl_interp_accel* double*))
+	 (double gsl_interp_eval_deriv (gsl_interp* double* double* double gsl_interp_accel*))
+	 (int gsl_interp_eval_deriv2_e (gsl_interp* double* double* double gsl_interp_accel* double*))
+	 (double gsl_interp_eval_deriv2 (gsl_interp* double* double* double gsl_interp_accel*))
+	 (int gsl_interp_eval_integ_e (gsl_interp* double* double* double double gsl_interp_accel* double*))
+	 (double gsl_interp_eval_integ (gsl_interp* double* double* double double gsl_interp_accel*))
+	 (void gsl_interp_free (gsl_interp*))
+	 (size_t gsl_interp_bsearch (double* double size_t size_t))
+	 (size_t gsl_interp_accel_find (gsl_interp_accel* double* size_t double))
+
+	 ;; spline (based on interp above)
+	 (gsl_spline* gsl_spline_alloc (gsl_interp_type* size_t))
+	 (int gsl_spline_init (gsl_spline* double* double* size_t))
+	 (char* gsl_spline_name (gsl_spline*))
+	 (int gsl_spline_min_size (gsl_spline*))
+	 (int gsl_spline_eval_e (gsl_spline* double gsl_interp_accel* double*))
+	 (double gsl_spline_eval (gsl_spline* double gsl_interp_accel*))
+	 (int gsl_spline_eval_deriv_e (gsl_spline* double gsl_interp_accel* double*))
+	 (double gsl_spline_eval_deriv (gsl_spline* double gsl_interp_accel*))
+	 (int gsl_spline_eval_deriv2_e (gsl_spline* double gsl_interp_accel* double*))
+	 (double gsl_spline_eval_deriv2 (gsl_spline* double gsl_interp_accel*))
+	 (int gsl_spline_eval_integ_e (gsl_spline* double double gsl_interp_accel* double*))
+	 (double gsl_spline_eval_integ (gsl_spline* double double gsl_interp_accel*))
+	 (void gsl_spline_free (gsl_spline*))
+
+	 ;; bspline
+	 (gsl_bspline_workspace* gsl_bspline_alloc (size_t size_t))
+	 (void gsl_bspline_free (gsl_bspline_workspace*))
+	 (size_t gsl_bspline_ncoeffs (gsl_bspline_workspace*))
+	 (size_t gsl_bspline_order (gsl_bspline_workspace*))
+	 (size_t gsl_bspline_nbreak (gsl_bspline_workspace*))
+	 (double gsl_bspline_breakpoint (size_t gsl_bspline_workspace*))
+	 (reader-cond ((>= gsl-version 1.16)
+		       (double gsl_bspline_greville_abscissa (size_t gsl_bspline_workspace*))
+		       (int gsl_bspline_knots_greville (gsl_vector* gsl_bspline_workspace* double*))))
+	 (int gsl_bspline_knots (gsl_vector* gsl_bspline_workspace*))
+	 (int gsl_bspline_knots_uniform (double double gsl_bspline_workspace*))
+	 (int gsl_bspline_eval (double gsl_vector* gsl_bspline_workspace*))
+	 (int gsl_bspline_eval_nonzero (double gsl_vector* size_t* size_t* gsl_bspline_workspace*))
+	   ;;; out 2.0 (gsl_bspline_deriv_workspace* gsl_bspline_deriv_alloc (size_t))
+	   ;;; out 2.0 (void gsl_bspline_deriv_free (gsl_bspline_deriv_workspace*))
+	 (reader-cond ((>= gsl-version 2.0)
+		       (int gsl_bspline_deriv_eval (double size_t gsl_matrix* gsl_bspline_workspace*))
+		       (int gsl_bspline_deriv_eval_nonzero (double size_t gsl_matrix* size_t* size_t* gsl_bspline_workspace*))))
+
+	 ;; sort
+	 ;; perhaps size_t* -> int vector?
+
+	 (void gsl_sort (double* size_t size_t))
+	 (reader-cond ((>= gsl-version 1.16)
+		       (void gsl_sort2 (double* size_t double* size_t size_t))
+		       (void gsl_sort_vector2 (gsl_vector* gsl_vector*))
+		       (int gsl_poly_dd_hermite_init (double* double* double* double* double* size_t))))
+	 (void gsl_sort_index (size_t* double* size_t size_t))
+	 (int gsl_sort_smallest (double* size_t double* size_t size_t))
+	 (int gsl_sort_smallest_index (size_t* size_t double* size_t size_t))
+	 (int gsl_sort_largest (double* size_t double* size_t size_t))
+	 (int gsl_sort_largest_index (size_t* size_t double* size_t size_t))
+	 (void gsl_sort_vector (gsl_vector*))
+	 (int gsl_sort_vector_index (gsl_permutation* gsl_vector*))
+	 (int gsl_sort_vector_smallest (double* size_t gsl_vector*))
+	 (int gsl_sort_vector_largest (double* size_t gsl_vector*))
+	 (int gsl_sort_vector_smallest_index (size_t* size_t gsl_vector*))
+	 (int gsl_sort_vector_largest_index (size_t* size_t gsl_vector*))
+
+	 ;; poly
+	 (double gsl_poly_eval (double* int double))
+	 (int gsl_poly_eval_derivs (double* size_t double double* size_t))
+	 (int gsl_poly_dd_init (double* double* double* size_t))
+	 (double gsl_poly_dd_eval (double* double* size_t double))
+	 (int gsl_poly_dd_taylor (double* double double* double* size_t double*))
+	 (void gsl_poly_complex_workspace_free (gsl_poly_complex_workspace*))
+	 (gsl_poly_complex_workspace* gsl_poly_complex_workspace_alloc (size_t))
+
+	 (in-C "
+                static s7_pointer g_gsl_poly_complex_eval(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_complex z, rz;
+                  S7_TO_GSL_COMPLEX(s7_caddr(args), z);
+                  rz = gsl_poly_complex_eval((double *)s7_c_pointer_with_type(sc, s7_car(args), double__symbol, __func__, 1), (int)s7_integer(s7_cadr(args)), z);
+                  return(GSL_TO_S7_COMPLEX(sc, rz));
+                }
+                static s7_pointer g_gsl_complex_poly_complex_eval(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_complex *z;
+                  gsl_complex rz, x;
+                  int i, n;
+                  s7_pointer v;
+                  v = s7_car(args);
+                  n = s7_integer(s7_cadr(args));
+                  z = (gsl_complex *)calloc(n, sizeof(gsl_complex));
+                  for (i = 0; i < n; i++)
+                    S7_TO_GSL_COMPLEX(s7_vector_ref(sc, v, i), z[i]);
+                  S7_TO_GSL_COMPLEX(s7_caddr(args), x);
+                  rz = gsl_complex_poly_complex_eval(z, n, x);
+                  free(z);
+                  return(GSL_TO_S7_COMPLEX(sc, rz));
+                }
+                static s7_pointer g_gsl_poly_complex_solve_quadratic(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_complex z0, z1;
+                  int result;
+                  s7_pointer res;
+
+                  res = s7_cadddr(args);
+                  result = gsl_poly_complex_solve_quadratic(s7_number_to_real_with_caller(sc, s7_car(args), __func__),
+                                                            s7_number_to_real_with_caller(sc, s7_cadr(args), __func__),
+                                                            s7_number_to_real_with_caller(sc, s7_caddr(args), __func__), &z0, &z1);
+                  s7_vector_set(sc, res, 0, GSL_TO_S7_COMPLEX(sc, z0));
+                  s7_vector_set(sc, res, 1, GSL_TO_S7_COMPLEX(sc, z1));
+
+                  return(s7_make_integer(sc, result));
+                }
+                static s7_pointer g_gsl_poly_complex_solve_cubic(s7_scheme *sc, s7_pointer args)
+                {
+                  /* trailing args are by ref, but I think I'll mimic the real solver above */
+                  gsl_complex z0, z1, z2;
+                  int result;
+                  s7_pointer res;
+
+                  result = gsl_poly_complex_solve_cubic(s7_number_to_real_with_caller(sc, s7_car(args), __func__),
+                                                        s7_number_to_real_with_caller(sc, s7_cadr(args), __func__),
+                                                        s7_number_to_real_with_caller(sc, s7_caddr(args), __func__), &z0, &z1, &z2);
+                  res = s7_cadddr(args);
+                  s7_vector_set(sc, res, 0, GSL_TO_S7_COMPLEX(sc, z0));
+                  s7_vector_set(sc, res, 1, GSL_TO_S7_COMPLEX(sc, z1));
+                  s7_vector_set(sc, res, 2, GSL_TO_S7_COMPLEX(sc, z2));
+
+                  return(s7_make_integer(sc, result));
+                }
+
+                static s7_pointer g_gsl_poly_complex_solve(s7_scheme *sc, s7_pointer args)
+                {
+                  /* trailing args are by ref, but I think I'll mimic the real solver above */
+                  double *z;
+                  gsl_poly_complex_workspace *w;
+                  int result, i, size;
+                  s7_pointer res;
+
+                  size = s7_integer(s7_cadr(args));
+                  res = s7_caddr(args);
+
+                  z = (double *)calloc(size * 2, sizeof(double));
+                  w = gsl_poly_complex_workspace_alloc(size);
+                  result = gsl_poly_complex_solve((double *)s7_c_pointer_with_type(sc, s7_car(args), double__symbol, __func__, 1), size, w, (gsl_complex_packed_ptr)z);
+                  gsl_poly_complex_workspace_free(w);
+
+                  for (i = 0; i < size - 1; i++)
+                    s7_vector_set(sc, res, i, s7_make_complex(sc, z[2 * i], z[2 * i + 1]));
+                  free(z);
+
+                  return(s7_make_integer(sc, result));
+                }
+
+                static s7_pointer g_gsl_poly_solve_quadratic(s7_scheme *sc, s7_pointer args)
+                {
+                  double x0, x1;
+                  int result;
+                  double *res;
+                  res = (double *)s7_c_pointer_with_type(sc, s7_cadddr(args), double__symbol, __func__, 4);
+                  result = gsl_poly_solve_quadratic(s7_number_to_real_with_caller(sc, s7_car(args), __func__),
+                                                    s7_number_to_real_with_caller(sc, s7_cadr(args), __func__),
+                                                    s7_number_to_real_with_caller(sc, s7_caddr(args), __func__), &x0, &x1);
+                  res[0] = x0;
+                  res[1] = x1;
+                  return(s7_make_integer(sc, result));
+                }
+
+                static s7_pointer g_gsl_poly_solve_cubic(s7_scheme *sc, s7_pointer args)
+                {
+                  double x0, x1, x2;
+                  int result;
+                  double *res;
+                  res = (double *)s7_c_pointer_with_type(sc, s7_cadddr(args), double__symbol, __func__, 4);
+                  result = gsl_poly_solve_cubic(s7_number_to_real_with_caller(sc, s7_car(args), __func__),
+                                                s7_number_to_real_with_caller(sc, s7_cadr(args), __func__),
+                                                s7_number_to_real_with_caller(sc, s7_caddr(args), __func__), &x0, &x1, &x2);
+                  res[0] = x0;
+                  res[1] = x1;
+                  res[2] = x2;
+                  return(s7_make_integer(sc, result));
+                }
+                ")
+
+	 (C-function ("gsl_poly_complex_eval" g_gsl_poly_complex_eval "" 3))
+	 (C-function ("gsl_complex_poly_complex_eval" g_gsl_complex_poly_complex_eval "" 3))
+	 (C-function ("gsl_poly_complex_solve_quadratic" g_gsl_poly_complex_solve_quadratic "" 4))
+	 (C-function ("gsl_poly_complex_solve_cubic" g_gsl_poly_complex_solve_cubic "" 4))
+	 (C-function ("gsl_poly_complex_solve" g_gsl_poly_complex_solve "" 3))
+	 (C-function ("gsl_poly_solve_quadratic" g_gsl_poly_solve_quadratic "" 4))
+	 (C-function ("gsl_poly_solve_cubic" g_gsl_poly_solve_cubic "" 4))
+
+	 ;; vector
+	 (in-C "
+                static s7_pointer g_float_vector_to_gsl_vector(s7_scheme *sc, s7_pointer args)
+                {
+                   gsl_vector *g;
+                   int size;
+                   s7_pointer v;
+                   v = s7_car(args);
+                   size = s7_vector_length(v);
+                   g = (gsl_vector *)s7_c_pointer_with_type(sc, s7_cadr(args), gsl_vector__symbol, __func__, 2);
+                   memcpy((void *)(g->data), (void *)s7_float_vector_elements(v), size * sizeof(double));
+                   return(s7_cadr(args));
+                }
+                static s7_pointer g_gsl_vector_to_float_vector(s7_scheme *sc, s7_pointer args)
+                {
+                   gsl_vector *g;
+                   int size;
+                   s7_pointer v;
+                   v = s7_cadr(args);
+                   size = s7_vector_length(v);
+                   g = (gsl_vector *)s7_c_pointer_with_type(sc, s7_car(args), gsl_vector__symbol, __func__, 1);
+                   memcpy((void *)s7_float_vector_elements(v), (void *)(g->data), size * sizeof(double));
+                   return(s7_cadr(args));
+                }
+                ")
+	 (C-function ("float-vector->gsl_vector" g_float_vector_to_gsl_vector "" 2))
+	 (C-function ("gsl_vector->float-vector" g_gsl_vector_to_float_vector "" 2))
+
+	 (gsl_vector* gsl_vector_alloc (size_t))
+	 (gsl_vector* gsl_vector_calloc (size_t))
+	 (gsl_vector* gsl_vector_alloc_from_vector (gsl_vector* size_t size_t size_t))
+	 (void gsl_vector_free (gsl_vector*))
+	 (void gsl_vector_set_zero (gsl_vector*))
+	 (void gsl_vector_set_all (gsl_vector* double))
+	 (int gsl_vector_set_basis (gsl_vector* size_t))
+	 (int gsl_vector_fread (FILE* gsl_vector*))
+	 (int gsl_vector_fwrite (FILE* gsl_vector*))
+	 (int gsl_vector_fscanf (FILE* gsl_vector*))
+	 (int gsl_vector_fprintf (FILE* gsl_vector* char*))
+	 (int gsl_vector_memcpy (gsl_vector* gsl_vector*))
+	 (int gsl_vector_reverse (gsl_vector*))
+	 (int gsl_vector_swap (gsl_vector* gsl_vector*))
+	 (int gsl_vector_swap_elements (gsl_vector* size_t size_t))
+	 (double gsl_vector_max (gsl_vector*))
+	 (double gsl_vector_min (gsl_vector*))
+	 (size_t gsl_vector_max_index (gsl_vector*))
+	 (size_t gsl_vector_min_index (gsl_vector*))
+	 (int gsl_vector_add (gsl_vector* gsl_vector*))
+	 (int gsl_vector_sub (gsl_vector* gsl_vector*))
+	 (int gsl_vector_mul (gsl_vector* gsl_vector*))
+	 (int gsl_vector_div (gsl_vector* gsl_vector*))
+	 (int gsl_vector_scale (gsl_vector* double))
+	 (int gsl_vector_add_constant (gsl_vector* double))
+	 (reader-cond ((>= gsl-version 1.15) (int gsl_vector_equal (gsl_vector* gsl_vector*))))
+	 (int gsl_vector_isnull (gsl_vector*))
+	 (int gsl_vector_ispos (gsl_vector*))
+	 (int gsl_vector_isneg (gsl_vector*))
+	 (int gsl_vector_isnonneg (gsl_vector*))
+	 (double gsl_vector_get (gsl_vector* size_t))
+	 (void gsl_vector_set (gsl_vector* size_t double))
+	 (double* gsl_vector_ptr (gsl_vector* size_t))
+	 (double* gsl_vector_const_ptr (gsl_vector* size_t))
+	 (void gsl_vector_minmax (gsl_vector* double* double*)) ; by ref
+	 (void gsl_vector_minmax_index (gsl_vector* size_t* size_t*)) ; by ref
+
+	 ;; matrix
+	 (in-C "
+                static s7_pointer g_float_vector_to_gsl_matrix(s7_scheme *sc, s7_pointer args)
+                {
+                   gsl_matrix *g;
+                   int size;
+                   s7_pointer v;
+                   v = s7_car(args);
+                   size = s7_vector_length(v);
+                   g = (gsl_matrix *)s7_c_pointer_with_type(sc, s7_cadr(args), gsl_matrix__symbol, __func__, 2);
+                   memcpy((void *)(g->data), (void *)s7_float_vector_elements(v), size * sizeof(double));
+                   return(s7_cadr(args));
+                }
+                static s7_pointer g_gsl_matrix_to_float_vector(s7_scheme *sc, s7_pointer args)
+                {
+                   gsl_matrix *g;
+                   int size;
+                   s7_pointer v;
+                   v = s7_cadr(args);
+                   size = s7_vector_length(v);
+                   g = (gsl_matrix *)s7_c_pointer_with_type(sc, s7_car(args), gsl_matrix__symbol, __func__, 1);
+                   memcpy((void *)s7_float_vector_elements(v), (void *)(g->data), size * sizeof(double));
+                   return(s7_cadr(args));
+                }
+                ")
+	 (C-function ("float-vector->gsl_matrix" g_float_vector_to_gsl_matrix "" 2))
+	 (C-function ("gsl_matrix->float-vector" g_gsl_matrix_to_float_vector "" 2))
+
+	 (gsl_matrix* gsl_matrix_alloc (size_t size_t))
+	 (gsl_matrix* gsl_matrix_calloc (size_t size_t))
+	 (gsl_matrix* gsl_matrix_alloc_from_matrix (gsl_matrix* size_t size_t size_t size_t))
+	 (gsl_vector* gsl_vector_alloc_row_from_matrix (gsl_matrix* size_t))
+	 (gsl_vector* gsl_vector_alloc_col_from_matrix (gsl_matrix* size_t))
+	 (void gsl_matrix_free (gsl_matrix*))
+	 (void gsl_matrix_set_zero (gsl_matrix*))
+	 (void gsl_matrix_set_identity (gsl_matrix*))
+	 (void gsl_matrix_set_all (gsl_matrix* double))
+	 (int gsl_matrix_fread (FILE* gsl_matrix*) )
+	 (int gsl_matrix_fwrite (FILE* gsl_matrix*) )
+	 (int gsl_matrix_fscanf (FILE* gsl_matrix*))
+	 (int gsl_matrix_fprintf (FILE* gsl_matrix* char*))
+	 (int gsl_matrix_memcpy (gsl_matrix* gsl_matrix*))
+	 (int gsl_matrix_swap (gsl_matrix* gsl_matrix*))
+	 (int gsl_matrix_swap_rows (gsl_matrix* size_t size_t))
+	 (int gsl_matrix_swap_columns (gsl_matrix* size_t size_t))
+	 (int gsl_matrix_swap_rowcol (gsl_matrix* size_t size_t))
+	 (int gsl_matrix_transpose (gsl_matrix*))
+	 (int gsl_matrix_transpose_memcpy (gsl_matrix* gsl_matrix*))
+	 (double gsl_matrix_max (gsl_matrix*))
+	 (double gsl_matrix_min (gsl_matrix*))
+	 (void gsl_matrix_minmax (gsl_matrix* double* double*))
+	 (void gsl_matrix_max_index (gsl_matrix* size_t* size_t*))
+	 (void gsl_matrix_min_index (gsl_matrix* size_t* size_t*))
+	 (void gsl_matrix_minmax_index (gsl_matrix* size_t* size_t* size_t* size_t*))
+	 (reader-cond ((>= gsl-version 1.15) (int gsl_matrix_equal (gsl_matrix* gsl_matrix*))))
+	 (int gsl_matrix_isnull (gsl_matrix*))
+	 (int gsl_matrix_ispos (gsl_matrix*))
+	 (int gsl_matrix_isneg (gsl_matrix*))
+	 (int gsl_matrix_isnonneg (gsl_matrix*))
+	 (int gsl_matrix_add (gsl_matrix* gsl_matrix*))
+	 (int gsl_matrix_sub (gsl_matrix* gsl_matrix*))
+	 (int gsl_matrix_mul_elements (gsl_matrix* gsl_matrix*))
+	 (int gsl_matrix_div_elements (gsl_matrix* gsl_matrix*))
+	 (int gsl_matrix_scale (gsl_matrix* double))
+	 (int gsl_matrix_add_constant (gsl_matrix* double))
+	 (int gsl_matrix_add_diagonal (gsl_matrix* double))
+	 (int gsl_matrix_get_row (gsl_vector* gsl_matrix* size_t))
+	 (int gsl_matrix_get_col (gsl_vector* gsl_matrix* size_t))
+	 (int gsl_matrix_set_row (gsl_matrix* size_t gsl_vector*))
+	 (int gsl_matrix_set_col (gsl_matrix* size_t gsl_vector*))
+	 (double gsl_matrix_get (gsl_matrix* size_t size_t))
+	 (void gsl_matrix_set (gsl_matrix* size_t size_t double))
+	 (double* gsl_matrix_ptr (gsl_matrix* size_t size_t))
+	 (double* gsl_matrix_const_ptr (gsl_matrix* size_t size_t))
+	 (in-C "
+                static s7_pointer g_gsl_matrix_size(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_matrix *g; g = (gsl_matrix *)s7_c_pointer_with_type(sc, s7_car(args), gsl_matrix__symbol, __func__, 1);
+                  return(s7_cons(sc, s7_make_integer(sc, (s7_int)(g->size1)), s7_make_integer(sc, (s7_int)(g->size2))));
+                }")
+	 (C-function ("gsl_matrix_size" g_gsl_matrix_size "" 1))
+
+	 ;; cblas
+	 (int gsl_blas_zdotu (gsl_vector_complex* gsl_vector_complex* gsl_complex*))
+	 (int gsl_blas_zdotc (gsl_vector_complex* gsl_vector_complex* gsl_complex*))
+	 (double gsl_blas_dnrm2 (gsl_vector*))
+	 (double gsl_blas_dasum (gsl_vector*))
+	 (double gsl_blas_dznrm2 (gsl_vector_complex*))
+	 (double gsl_blas_dzasum (gsl_vector_complex*))
+	 (size_t_t gsl_blas_idamax (gsl_vector*))
+	 (size_t_t gsl_blas_izamax (gsl_vector_complex*))
+	 (int gsl_blas_dswap (gsl_vector* gsl_vector*))
+	 (int gsl_blas_dcopy (gsl_vector* gsl_vector*))
+	 (int gsl_blas_daxpy (double gsl_vector* gsl_vector*))
+	 (int gsl_blas_zswap (gsl_vector_complex* gsl_vector_complex*))
+	 (int gsl_blas_zcopy (gsl_vector_complex* gsl_vector_complex*))
+	 (int gsl_blas_drotg (double* double* double* double*))
+	 (int gsl_blas_drotmg (double* double* double* double double*))
+	 (int gsl_blas_drot (gsl_vector* gsl_vector* double double))
+	 (int gsl_blas_drotm (gsl_vector* gsl_vector* double*))
+	 (void gsl_blas_dscal (double gsl_vector*))
+	 (void gsl_blas_zdscal (double gsl_vector_complex*))
+	 (int gsl_blas_dgemv ((CBLAS_TRANSPOSE_t int) double gsl_matrix* gsl_vector* double gsl_vector*))
+	 (int gsl_blas_dtrmv ((CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_DIAG_t int) gsl_matrix* gsl_vector*))
+	 (int gsl_blas_dtrsv ((CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_DIAG_t int) gsl_matrix* gsl_vector*))
+	 (int gsl_blas_ztrmv ((CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_DIAG_t int) gsl_matrix_complex* gsl_vector_complex*))
+	 (int gsl_blas_ztrsv ((CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_DIAG_t int) gsl_matrix_complex* gsl_vector_complex*))
+	 (int gsl_blas_dsymv ((CBLAS_UPLO_t int) double gsl_matrix* gsl_vector* double gsl_vector*))
+	 (int gsl_blas_dger (double gsl_vector* gsl_vector* gsl_matrix*))
+	 (int gsl_blas_dsyr ((CBLAS_UPLO_t int) double gsl_vector* gsl_matrix*))
+	 (int gsl_blas_dsyr2 ((CBLAS_UPLO_t int) double gsl_vector* gsl_vector* gsl_matrix*))
+	 (int gsl_blas_zher ((CBLAS_UPLO_t int) double gsl_vector_complex* gsl_matrix_complex*))
+	 (int gsl_blas_dgemm ((CBLAS_TRANSPOSE_t int) (CBLAS_TRANSPOSE_t int) double gsl_matrix* gsl_matrix* double gsl_matrix*))
+	 (int gsl_blas_dsymm ((CBLAS_SIDE_t int) (CBLAS_UPLO_t int) double gsl_matrix* gsl_matrix* double gsl_matrix*))
+	 (int gsl_blas_dsyrk ((CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) double gsl_matrix* double gsl_matrix*))
+	 (int gsl_blas_dsyr2k ((CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) double gsl_matrix* gsl_matrix* double gsl_matrix*))
+	 (int gsl_blas_dtrmm ((CBLAS_SIDE_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_DIAG_t int) double gsl_matrix* gsl_matrix*))
+	 (int gsl_blas_dtrsm ((CBLAS_SIDE_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_DIAG_t int) double gsl_matrix* gsl_matrix*))
+	 (int gsl_blas_zherk ((CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) double gsl_matrix_complex* double gsl_matrix_complex*))
+	 (double cblas_ddot (int double* int double* int))
+	 (void cblas_zdotu_sub (int double* int double* int double*))
+	 (void cblas_zdotc_sub (int double* int double* int double*))
+	 (double cblas_dnrm2 (int double* int))
+	 (double cblas_dasum (int double* int))
+	 (double cblas_dznrm2 (int void* int))
+	 (double cblas_dzasum (int void* int))
+	 (size_t cblas_idamax (int double* int))
+	 (size_t cblas_icamax (int void* int))
+	 (size_t cblas_izamax (int void* int))
+	 (void cblas_dswap (int double* int double* int))
+	 (void cblas_dcopy (int double* int double* int))
+	 (void cblas_daxpy (int double double* int double* int))
+	 (void cblas_zswap (int double* int double* int))
+	 (void cblas_zcopy (int double* int double* int))
+	 (void cblas_zaxpy (int double* double* int double* int))
+	 (void cblas_drotg (double* double* double* double*))
+	 (void cblas_drotmg (double* double* double* double double*))
+	 (void cblas_drot (int double* int double* int double double))
+	 (void cblas_drotm (int double* int double* int double*))
+	 (void cblas_dscal (int double double* int))
+	 (void cblas_zscal (int double* double* int))
+	 (void cblas_zdscal (int double double* int))
+	 (void cblas_dgemv ((CBLAS_ORDER_t int) (CBLAS_TRANSPOSE_t int) int int double double* int double* int double double* int))
+	 (void cblas_dgbmv ((CBLAS_ORDER_t int) (CBLAS_TRANSPOSE_t int) int int int int double double* int double* int double double* int))
+	 (void cblas_dtrmv ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_DIAG_t int) int double* int double* int))
+	 (void cblas_dtbmv ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_DIAG_t int) int int double* int double* int))
+	 (void cblas_dtpmv ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_DIAG_t int) int double* double* int))
+	 (void cblas_dtrsv ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_DIAG_t int) int double* int double* int))
+	 (void cblas_dtbsv ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_DIAG_t int) int int double* int double* int))
+	 (void cblas_dtpsv ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_DIAG_t int) int double* double* int))
+	 (void cblas_zgemv ((CBLAS_ORDER_t int) (CBLAS_TRANSPOSE_t int) int int double* double* int double* int double* double* int))
+	 (void cblas_zgbmv ((CBLAS_ORDER_t int) (CBLAS_TRANSPOSE_t int) int int int int double* double* int double* int double* double* int))
+	 (void cblas_ztrmv ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_DIAG_t int) int double* int double* int))
+	 (void cblas_ztbmv ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_DIAG_t int) int int double* int double* int))
+	 (void cblas_ztpmv ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_DIAG_t int) int double* double* int))
+	 (void cblas_ztrsv ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_DIAG_t int) int double* int double* int))
+	 (void cblas_ztbsv ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_DIAG_t int) int int double* int double* int))
+	 (void cblas_ztpsv ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_DIAG_t int) int double* double* int))
+	 (void cblas_dsymv ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) int double double* int double* int double double* int))
+	 (void cblas_dsbmv ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) int int double double* int double* int double double* int))
+	 (void cblas_dspmv ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) int double double* double* int double double* int))
+	 (void cblas_dger ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) int double double* int double* int double* int))
+	 (void cblas_dsyr ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) int double double* int double* int))
+	 (void cblas_dspr ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) int double double* int double*))
+	 (void cblas_dsyr2 ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) int double double* int double* int double* int))
+	 (void cblas_dspr2 ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) int double double* int double* int double*))
+	 (void cblas_zhemv ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) int double* double* int double* int double* double* int))
+	 (void cblas_zhbmv ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) int int double* double* int double* int double* double* int))
+	 (void cblas_zhpmv ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) int double* double* double* int double* double* int))
+	 (void cblas_zgeru ((CBLAS_ORDER_t int) int int double* double* int double* int double* int))
+	 (void cblas_zgerc ((CBLAS_ORDER_t int) int int double* double* int double* int double* int))
+	 (void cblas_zher ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) int double double* int double* int))
+	 (void cblas_zhpr ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) int double double* int double*))
+	 (void cblas_zher2 ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) int double* double* int double* int double* int))
+	 (void cblas_zhpr2 ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) int double* double* int double* int double*))
+	 (void cblas_dgemm ((CBLAS_ORDER_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_TRANSPOSE_t int) int int int double double* int double* int double double* int))
+	 (void cblas_dsymm ((CBLAS_ORDER_t int) (CBLAS_SIDE_t int) (CBLAS_UPLO_t int) int int double double* int double* int double double* int))
+	 (void cblas_dsyrk ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) int int double double* int double double* int))
+	 (void cblas_dsyr2k ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) int int double double* int double* int double double* int))
+	 (void cblas_dtrmm ((CBLAS_ORDER_t int) (CBLAS_SIDE_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_DIAG_t int) int int double double* int double* int))
+	 (void cblas_dtrsm ((CBLAS_ORDER_t int) (CBLAS_SIDE_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_DIAG_t int) int int double double* int double* int))
+	 (void cblas_zgemm ((CBLAS_ORDER_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_TRANSPOSE_t int) int int int double* double* int double* int double* double* int))
+	 (void cblas_zsymm ((CBLAS_ORDER_t int) (CBLAS_SIDE_t int) (CBLAS_UPLO_t int) int int double* double* int double* int double* double* int))
+	 (void cblas_zsyrk ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) int int double* double* int double* double* int))
+	 (void cblas_zsyr2k ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) int int double* double* int double* int double* double* int))
+	 (void cblas_ztrmm ((CBLAS_ORDER_t int) (CBLAS_SIDE_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_DIAG_t int) int int double* double* int double* int))
+	 (void cblas_ztrsm ((CBLAS_ORDER_t int) (CBLAS_SIDE_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) (CBLAS_DIAG_t int) int int double* double* int double* int))
+	 (void cblas_zhemm ((CBLAS_ORDER_t int) (CBLAS_SIDE_t int) (CBLAS_UPLO_t int) int int double* double* int double* int double* double* int))
+	 (void cblas_zherk ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) int int double double* int double double* int))
+	 (void cblas_zher2k ((CBLAS_ORDER_t int) (CBLAS_UPLO_t int) (CBLAS_TRANSPOSE_t int) int int double* double* int double* int double double* int))
+
+	 ;; combination
+	 (gsl_combination* gsl_combination_alloc (size_t size_t))
+	 (gsl_combination* gsl_combination_calloc (size_t size_t))
+	 (void gsl_combination_init_first (gsl_combination*))
+	 (void gsl_combination_init_last (gsl_combination*))
+	 (void gsl_combination_free (gsl_combination*))
+	 (int gsl_combination_memcpy (gsl_combination* gsl_combination*) )
+	 (int gsl_combination_fread (FILE* gsl_combination*))
+	 (int gsl_combination_fwrite (FILE* gsl_combination*))
+	 (int gsl_combination_fscanf (FILE* gsl_combination*))
+	 (int gsl_combination_fprintf (FILE* gsl_combination* char*))
+	 (size_t gsl_combination_n (gsl_combination*))
+	 (size_t gsl_combination_k (gsl_combination*))
+					;(size_t* gsl_combination_data (gsl_combination*))
+	 (int gsl_combination_valid (gsl_combination*))
+	 (int gsl_combination_next (gsl_combination*))
+	 (int gsl_combination_prev (gsl_combination*))
+	 (size_t gsl_combination_get (gsl_combination* size_t))
+	 (in-C "
+                static s7_pointer g_gsl_combination_to_int_vector(s7_scheme *sc, s7_pointer args)
+                {
+                   gsl_combination *g;
+                   int i, size;
+                   s7_int *el;
+                   s7_pointer v;
+                   v = s7_cadr(args);
+                   size = s7_vector_length(v);
+                   g = (gsl_combination *)s7_c_pointer_with_type(sc, s7_car(args), gsl_combination__symbol, __func__, 1);
+                   el = s7_int_vector_elements(v);
+                   for (i = 0; i < size; i++) el[i] = (s7_int)(g->data[i]);
+                   return(s7_cadr(args));
+                }
+                ")
+	 (C-function ("gsl_combination->int-vector" g_gsl_combination_to_int_vector "" 2))
+
+	 ;; rl+im for complex in most of these cases
+	 (int gsl_dft_complex_forward (double* size_t size_t double*))
+	 (int gsl_dft_complex_backward (double* size_t size_t double*))
+	 (int gsl_dft_complex_inverse (double* size_t size_t double*))
+	 (int gsl_dft_complex_transform (double* size_t size_t double* (gsl_fft_direction int)))
+	 (int gsl_fft_complex_radix2_forward (double* size_t size_t))
+	 (int gsl_fft_complex_radix2_backward (double* size_t size_t))
+	 (int gsl_fft_complex_radix2_inverse (double* size_t size_t))
+	 (int gsl_fft_complex_radix2_transform (double* size_t size_t (gsl_fft_direction int)))
+	 (int gsl_fft_complex_radix2_dif_forward (double* size_t size_t))
+	 (int gsl_fft_complex_radix2_dif_backward (double* size_t size_t))
+	 (int gsl_fft_complex_radix2_dif_inverse (double* size_t size_t))
+	 (int gsl_fft_complex_radix2_dif_transform (double* size_t size_t (gsl_fft_direction int)))
+	 (gsl_fft_complex_wavetable* gsl_fft_complex_wavetable_alloc (size_t))
+	 (void gsl_fft_complex_wavetable_free (gsl_fft_complex_wavetable*))
+	 (gsl_fft_complex_workspace* gsl_fft_complex_workspace_alloc (size_t))
+	 (void gsl_fft_complex_workspace_free (gsl_fft_complex_workspace*))
+	 (int gsl_fft_complex_memcpy (gsl_fft_complex_wavetable* gsl_fft_complex_wavetable*))
+	 (int gsl_fft_complex_forward (double* size_t size_t gsl_fft_complex_wavetable* gsl_fft_complex_workspace*))
+	 (int gsl_fft_complex_backward (double* size_t size_t gsl_fft_complex_wavetable* gsl_fft_complex_workspace*))
+	 (int gsl_fft_complex_inverse (double* size_t size_t gsl_fft_complex_wavetable* gsl_fft_complex_workspace*))
+	 (int gsl_fft_complex_transform (double* size_t size_t gsl_fft_complex_wavetable* gsl_fft_complex_workspace* (gsl_fft_direction int)))
+	 (int gsl_fft_real_radix2_transform (double* size_t size_t) )
+	 (gsl_fft_real_wavetable* gsl_fft_real_wavetable_alloc (size_t))
+	 (void gsl_fft_real_wavetable_free (gsl_fft_real_wavetable*))
+	 (gsl_fft_real_workspace* gsl_fft_real_workspace_alloc (size_t))
+	 (void gsl_fft_real_workspace_free (gsl_fft_real_workspace*))
+	 (int gsl_fft_real_transform (double* size_t size_t gsl_fft_real_wavetable* gsl_fft_real_workspace*))
+	 (int gsl_fft_real_unpack (double* double* size_t size_t))
+
+
+	 (gsl_eigen_symm_workspace* gsl_eigen_symm_alloc (size_t))
+	 (void gsl_eigen_symm_free (gsl_eigen_symm_workspace*))
+	 (int gsl_eigen_symm (gsl_matrix* gsl_vector* gsl_eigen_symm_workspace*))
+	 (gsl_eigen_symmv_workspace* gsl_eigen_symmv_alloc (size_t))
+	 (void gsl_eigen_symmv_free (gsl_eigen_symmv_workspace*))
+	 (int gsl_eigen_symmv (gsl_matrix* gsl_vector* gsl_matrix* gsl_eigen_symmv_workspace*))
+	 (gsl_eigen_herm_workspace* gsl_eigen_herm_alloc (size_t))
+	 (void gsl_eigen_herm_free (gsl_eigen_herm_workspace*))
+	 (int gsl_eigen_herm (gsl_matrix_complex* gsl_vector* gsl_eigen_herm_workspace*))
+	 (gsl_eigen_hermv_workspace* gsl_eigen_hermv_alloc (size_t))
+	 (void gsl_eigen_hermv_free (gsl_eigen_hermv_workspace*))
+	 (int gsl_eigen_hermv (gsl_matrix_complex* gsl_vector* gsl_matrix_complex* gsl_eigen_hermv_workspace*))
+	 (gsl_eigen_francis_workspace* gsl_eigen_francis_alloc (void))
+	 (void gsl_eigen_francis_free (gsl_eigen_francis_workspace*))
+	 (void gsl_eigen_francis_T (int gsl_eigen_francis_workspace*))
+	 (int gsl_eigen_francis (gsl_matrix* gsl_vector_complex* gsl_eigen_francis_workspace*))
+	 (int gsl_eigen_francis_Z (gsl_matrix* gsl_vector_complex* gsl_matrix* gsl_eigen_francis_workspace*))
+	 (gsl_eigen_nonsymm_workspace* gsl_eigen_nonsymm_alloc (size_t))
+	 (void gsl_eigen_nonsymm_free (gsl_eigen_nonsymm_workspace*))
+	 (void gsl_eigen_nonsymm_params (int int gsl_eigen_nonsymm_workspace*))
+	 (int gsl_eigen_nonsymm (gsl_matrix* gsl_vector_complex* gsl_eigen_nonsymm_workspace*))
+	 (int gsl_eigen_nonsymm_Z (gsl_matrix* gsl_vector_complex* gsl_matrix* gsl_eigen_nonsymm_workspace*))
+	 (gsl_eigen_nonsymmv_workspace* gsl_eigen_nonsymmv_alloc (size_t))
+	 (void gsl_eigen_nonsymmv_free (gsl_eigen_nonsymmv_workspace*))
+	 (reader-cond ((>= gsl-version 1.15) (void gsl_eigen_nonsymmv_params (int gsl_eigen_nonsymmv_workspace*))))
+	 (int gsl_eigen_nonsymmv (gsl_matrix* gsl_vector_complex* gsl_matrix_complex* gsl_eigen_nonsymmv_workspace*))
+	 (int gsl_eigen_nonsymmv_Z (gsl_matrix* gsl_vector_complex* gsl_matrix_complex* gsl_matrix* gsl_eigen_nonsymmv_workspace*))
+	 (gsl_eigen_gensymm_workspace* gsl_eigen_gensymm_alloc (size_t))
+	 (void gsl_eigen_gensymm_free (gsl_eigen_gensymm_workspace*))
+	 (int gsl_eigen_gensymm (gsl_matrix* gsl_matrix* gsl_vector* gsl_eigen_gensymm_workspace*))
+	 (int gsl_eigen_gensymm_standardize (gsl_matrix* gsl_matrix*))
+	 (gsl_eigen_gensymmv_workspace* gsl_eigen_gensymmv_alloc (size_t))
+	 (void gsl_eigen_gensymmv_free (gsl_eigen_gensymmv_workspace*))
+	 (int gsl_eigen_gensymmv (gsl_matrix* gsl_matrix* gsl_vector* gsl_matrix* gsl_eigen_gensymmv_workspace*))
+	 (gsl_eigen_genherm_workspace* gsl_eigen_genherm_alloc (size_t))
+	 (void gsl_eigen_genherm_free (gsl_eigen_genherm_workspace*))
+	 (int gsl_eigen_genherm (gsl_matrix_complex* gsl_matrix_complex* gsl_vector* gsl_eigen_genherm_workspace*))
+	 (int gsl_eigen_genherm_standardize (gsl_matrix_complex* gsl_matrix_complex*))
+	 (gsl_eigen_genhermv_workspace* gsl_eigen_genhermv_alloc (size_t))
+	 (void gsl_eigen_genhermv_free (gsl_eigen_genhermv_workspace*))
+	 (int gsl_eigen_genhermv (gsl_matrix_complex* gsl_matrix_complex* gsl_vector* gsl_matrix_complex* gsl_eigen_genhermv_workspace*))
+	 (gsl_eigen_gen_workspace* gsl_eigen_gen_alloc (size_t))
+	 (void gsl_eigen_gen_free (gsl_eigen_gen_workspace*))
+	 (void gsl_eigen_gen_params (int int int gsl_eigen_gen_workspace*))
+	 (int gsl_eigen_gen (gsl_matrix* gsl_matrix* gsl_vector_complex* gsl_vector* gsl_eigen_gen_workspace*))
+	 (int gsl_eigen_gen_QZ (gsl_matrix* gsl_matrix* gsl_vector_complex* gsl_vector* gsl_matrix* gsl_matrix* gsl_eigen_gen_workspace*))
+	 (gsl_eigen_genv_workspace* gsl_eigen_genv_alloc (size_t))
+	 (void gsl_eigen_genv_free (gsl_eigen_genv_workspace*))
+	 (int gsl_eigen_genv (gsl_matrix* gsl_matrix* gsl_vector_complex* gsl_vector* gsl_matrix_complex* gsl_eigen_genv_workspace*))
+	 (int gsl_eigen_genv_QZ (gsl_matrix* gsl_matrix* gsl_vector_complex* gsl_vector* gsl_matrix_complex* gsl_matrix* gsl_matrix* gsl_eigen_genv_workspace*))
+	 (int gsl_eigen_symmv_sort (gsl_vector* gsl_matrix* (gsl_eigen_sort_t int)))
+	 (int gsl_eigen_hermv_sort (gsl_vector* gsl_matrix_complex* (gsl_eigen_sort_t int)))
+	 (int gsl_eigen_nonsymmv_sort (gsl_vector_complex* gsl_matrix_complex* (gsl_eigen_sort_t int)))
+	 (int gsl_eigen_gensymmv_sort (gsl_vector* gsl_matrix* (gsl_eigen_sort_t int)))
+	 (int gsl_eigen_genhermv_sort (gsl_vector* gsl_matrix_complex* (gsl_eigen_sort_t int)))
+	 (int gsl_eigen_genv_sort (gsl_vector_complex* gsl_vector* gsl_matrix_complex* (gsl_eigen_sort_t int)))
+	 (int gsl_schur_gen_eigvals (gsl_matrix* gsl_matrix* double* double* double* double* double*))
+	 (int gsl_schur_solve_equation (double gsl_matrix* double double double gsl_vector* gsl_vector* double* double* double))
+	 (int gsl_schur_solve_equation_z (double gsl_matrix* gsl_complex* double double gsl_vector_complex* gsl_vector_complex* double* double* double))
+	 (int gsl_eigen_invert_jacobi (gsl_matrix* gsl_matrix* int))
+	 (in-C "
+                static s7_pointer g_gsl_eigen_jacobi(s7_scheme *sc, s7_pointer args)
+                {
+                  unsigned int ref_arg = 0;
+                  return(s7_make_integer(sc, (s7_int)gsl_eigen_jacobi((gsl_matrix*)s7_c_pointer_with_type(sc, s7_car(args), gsl_matrix__symbol, __func__, 1), (gsl_vector*)s7_c_pointer_with_type(sc, s7_cadr(args), gsl_vector__symbol, __func__, 2),
+                                             (gsl_matrix*)s7_c_pointer_with_type(sc, s7_caddr(args), gsl_matrix__symbol, __func__, 3), (int)s7_integer(s7_cadddr(args)), &ref_arg)));
+                }")
+	 (C-function ("gsl_eigen_jacobi" g_gsl_eigen_jacobi "" 4))
+
+	 (void gsl_error (char* char* int int))
+	 (void gsl_stream_printf (char* char* int char*))
+	 (char* gsl_strerror (int))
+	 (gsl_error_handler_t* gsl_set_error_handler (gsl_error_handler_t*))
+	 (gsl_error_handler_t* gsl_set_error_handler_off (void))
+	 (gsl_stream_handler_t* gsl_set_stream_handler (gsl_stream_handler_t*))
+	 (FILE* gsl_set_stream (FILE*))
+
+	 (int gsl_fit_linear (double* size_t double* size_t size_t double* double* double* double* double* double*))
+	 (int gsl_fit_wlinear (double* size_t double* size_t double* size_t size_t double* double* double* double* double* double*))
+	 (int gsl_fit_linear_est (double double double double double double double* double*))
+	 (int gsl_fit_mul (double* size_t double* size_t size_t double* double* double*))
+	 (int gsl_fit_wmul (double* size_t double* size_t double* size_t size_t double* double* double*))
+	 (int gsl_fit_mul_est (double double double double* double*))
+
+	 (gsl_histogram* gsl_histogram_alloc (size_t))
+	 (gsl_histogram* gsl_histogram_calloc (size_t))
+	 (gsl_histogram* gsl_histogram_calloc_uniform (size_t double double))
+	 (void gsl_histogram_free (gsl_histogram*))
+	 (int gsl_histogram_increment (gsl_histogram* double))
+	 (int gsl_histogram_accumulate (gsl_histogram* double double))
+	 (int gsl_histogram_find (gsl_histogram* double size_t*))
+	 (double gsl_histogram_get (gsl_histogram* size_t))
+	 (int gsl_histogram_get_range (gsl_histogram* size_t double* double*))
+	 (double gsl_histogram_max (gsl_histogram*))
+	 (double gsl_histogram_min (gsl_histogram*))
+	 (size_t gsl_histogram_bins (gsl_histogram*))
+	 (void gsl_histogram_reset (gsl_histogram*))
+	 (gsl_histogram* gsl_histogram_calloc_range (size_t double*))
+	 (int gsl_histogram_set_ranges (gsl_histogram* double* size_t))
+	 (int gsl_histogram_set_ranges_uniform (gsl_histogram* double double))
+	 (int gsl_histogram_memcpy (gsl_histogram* gsl_histogram*))
+	 (gsl_histogram* gsl_histogram_clone (gsl_histogram*))
+	 (double gsl_histogram_max_val (gsl_histogram*))
+	 (size_t gsl_histogram_max_bin (gsl_histogram*))
+	 (double gsl_histogram_min_val (gsl_histogram*))
+	 (size_t gsl_histogram_min_bin (gsl_histogram*))
+	 (int gsl_histogram_equal_bins_p (gsl_histogram* gsl_histogram*))
+	 (int gsl_histogram_add (gsl_histogram* gsl_histogram*))
+	 (int gsl_histogram_sub (gsl_histogram* gsl_histogram*))
+	 (int gsl_histogram_mul (gsl_histogram* gsl_histogram*))
+	 (int gsl_histogram_div (gsl_histogram* gsl_histogram*))
+	 (int gsl_histogram_scale (gsl_histogram* double))
+	 (int gsl_histogram_shift (gsl_histogram* double))
+	 (double gsl_histogram_sigma (gsl_histogram*))
+	 (double gsl_histogram_mean (gsl_histogram*))
+	 (double gsl_histogram_sum (gsl_histogram*))
+	 (int gsl_histogram_fwrite (FILE* gsl_histogram*) )
+	 (int gsl_histogram_fread (FILE* gsl_histogram*))
+	 (int gsl_histogram_fprintf (FILE* gsl_histogram* char* char*))
+	 (int gsl_histogram_fscanf (FILE* gsl_histogram*))
+	 (gsl_histogram_pdf* gsl_histogram_pdf_alloc (size_t))
+	 (int gsl_histogram_pdf_init (gsl_histogram_pdf* gsl_histogram*))
+	 (void gsl_histogram_pdf_free (gsl_histogram_pdf*))
+	 (double gsl_histogram_pdf_sample (gsl_histogram_pdf* double))
+	 (gsl_histogram2d* gsl_histogram2d_alloc (size_t size_t))
+	 (gsl_histogram2d* gsl_histogram2d_calloc (size_t size_t))
+	 (gsl_histogram2d* gsl_histogram2d_calloc_uniform (size_t size_t double double double double))
+	 (void gsl_histogram2d_free (gsl_histogram2d*))
+	 (int gsl_histogram2d_increment (gsl_histogram2d* double double))
+	 (int gsl_histogram2d_accumulate (gsl_histogram2d* double double double))
+	 (int gsl_histogram2d_find (gsl_histogram2d* double double size_t* size_t*))
+	 (double gsl_histogram2d_get (gsl_histogram2d* size_t size_t))
+	 (int gsl_histogram2d_get_xrange (gsl_histogram2d* size_t double* double*))
+	 (int gsl_histogram2d_get_yrange (gsl_histogram2d* size_t double* double*))
+	 (double gsl_histogram2d_xmax (gsl_histogram2d*))
+	 (double gsl_histogram2d_xmin (gsl_histogram2d*))
+	 (size_t gsl_histogram2d_nx (gsl_histogram2d*))
+	 (double gsl_histogram2d_ymax (gsl_histogram2d*))
+	 (double gsl_histogram2d_ymin (gsl_histogram2d*))
+	 (size_t gsl_histogram2d_ny (gsl_histogram2d*))
+	 (void gsl_histogram2d_reset (gsl_histogram2d*))
+	 (gsl_histogram2d* gsl_histogram2d_calloc_range (size_t size_t double* double*))
+	 (int gsl_histogram2d_set_ranges_uniform (gsl_histogram2d* double double double double))
+	 (int gsl_histogram2d_memcpy (gsl_histogram2d* gsl_histogram2d*))
+	 (gsl_histogram2d* gsl_histogram2d_clone (gsl_histogram2d*))
+	 (double gsl_histogram2d_max_val (gsl_histogram2d*))
+	 (void gsl_histogram2d_max_bin (gsl_histogram2d* size_t* size_t*))
+	 (double gsl_histogram2d_min_val (gsl_histogram2d*))
+	 (void gsl_histogram2d_min_bin (gsl_histogram2d* size_t* size_t*))
+	 (double gsl_histogram2d_xmean (gsl_histogram2d*))
+	 (double gsl_histogram2d_ymean (gsl_histogram2d*))
+	 (double gsl_histogram2d_xsigma (gsl_histogram2d*))
+	 (double gsl_histogram2d_ysigma (gsl_histogram2d*))
+	 (double gsl_histogram2d_cov (gsl_histogram2d*))
+	 (double gsl_histogram2d_sum (gsl_histogram2d*))
+	 (int gsl_histogram2d_equal_bins_p (gsl_histogram2d* gsl_histogram2d*) )
+	 (int gsl_histogram2d_add (gsl_histogram2d* gsl_histogram2d*))
+	 (int gsl_histogram2d_sub (gsl_histogram2d* gsl_histogram2d*))
+	 (int gsl_histogram2d_mul (gsl_histogram2d* gsl_histogram2d*))
+	 (int gsl_histogram2d_div (gsl_histogram2d* gsl_histogram2d*))
+	 (int gsl_histogram2d_scale (gsl_histogram2d* double))
+	 (int gsl_histogram2d_shift (gsl_histogram2d* double))
+	 (int gsl_histogram2d_fwrite (FILE* gsl_histogram2d*) )
+	 (int gsl_histogram2d_fread (FILE* gsl_histogram2d*))
+	 (int gsl_histogram2d_fprintf (FILE* gsl_histogram2d* char* char*))
+	 (int gsl_histogram2d_fscanf (FILE* gsl_histogram2d*))
+	 (gsl_histogram2d_pdf* gsl_histogram2d_pdf_alloc (size_t size_t))
+	 (int gsl_histogram2d_pdf_init (gsl_histogram2d_pdf* gsl_histogram2d*))
+	 (void gsl_histogram2d_pdf_free (gsl_histogram2d_pdf*))
+	 (int gsl_histogram2d_pdf_sample (gsl_histogram2d_pdf* double double double* double*))
+
+					;(void gsl_ieee_printf_double (double*) ) ; these are ridiculous
+					;(void gsl_ieee_fprintf_double (FILE* double*) )
+					;(void gsl_ieee_double_to_rep (double* gsl_ieee_double_rep*) )
+	 (void gsl_ieee_env_setup (void) ) ; looks for GSL_IEEE_MODE home var
+					;(int gsl_ieee_read_mode_string (char* int* int* int*) ) ; int by ref
+	 (int gsl_ieee_set_mode (int int int) )
+
+	 (in-C "
+                static s7_pointer g_gsl_deriv_central(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_function gsl_f;
+                  make_gsl_function(s7_car(args));
+                  return(s7_make_integer(sc, gsl_deriv_central(&gsl_f, s7_real(s7_cadr(args)), s7_real(s7_caddr(args)),
+                                             (double *)s7_c_pointer_with_type(sc, s7_cadddr(args), double__symbol, __func__, 4),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 4), double__symbol, __func__, 5))));
+                }
+               static s7_pointer g_gsl_deriv_backward(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_function gsl_f;
+                  make_gsl_function(s7_car(args));
+                  return(s7_make_integer(sc, gsl_deriv_backward(&gsl_f, s7_real(s7_cadr(args)), s7_real(s7_caddr(args)),
+                                             (double *)s7_c_pointer_with_type(sc, s7_cadddr(args), double__symbol, __func__, 4),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 4), double__symbol, __func__, 5))));
+                }
+               static s7_pointer g_gsl_deriv_forward(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_function gsl_f;
+                  make_gsl_function(s7_car(args));
+                  return(s7_make_integer(sc, gsl_deriv_forward(&gsl_f, s7_real(s7_cadr(args)), s7_real(s7_caddr(args)),
+                                             (double *)s7_c_pointer_with_type(sc, s7_cadddr(args), double__symbol, __func__, 4),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 4), double__symbol, __func__, 5))));
+                }
+                ")
+	 (C-function ("gsl_deriv_central" g_gsl_deriv_central "" 5))
+	 (C-function ("gsl_deriv_backward" g_gsl_deriv_backward "" 5))
+	 (C-function ("gsl_deriv_forward" g_gsl_deriv_forward "" 5))
+
+
+	 (gsl_integration_workspace* gsl_integration_workspace_alloc (size_t))
+	 (void gsl_integration_workspace_free (gsl_integration_workspace*))
+	 (gsl_integration_qaws_table* gsl_integration_qaws_table_alloc (double double int int))
+	 (int gsl_integration_qaws_table_set (gsl_integration_qaws_table* double double int int))
+	 (void gsl_integration_qaws_table_free (gsl_integration_qaws_table*))
+;	 (gsl_integration_qawo_table* gsl_integration_qawo_table_alloc (double double int size_t))
+;	 (int gsl_integration_qawo_table_set (gsl_integration_qawo_table* double double int))
+;	 (int gsl_integration_qawo_table_set_length (gsl_integration_qawo_table* double))
+	 (void gsl_integration_qawo_table_free (gsl_integration_qawo_table*))
+	 (reader-cond ((>= gsl-version 2.5)
+		       (gsl_integration_romberg_workspace* gsl_integration_romberg_alloc (size_t))
+                       (void gsl_integration_romberg_free (gsl_integration_romberg_workspace*))))
+
+	 (in-C "#define Integration(Name) \
+                  static s7_pointer g_gsl_integration_ ## Name (s7_scheme *sc, s7_pointer args)   \
+                {                                                                                 \
+                  gsl_function gsl_f;                                                             \
+                  make_gsl_function(s7_car(args));                                                \
+                  gsl_integration_ ## Name (&gsl_f, s7_real(s7_cadr(args)), s7_real(s7_caddr(args)), \
+                                       (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 3), double__symbol, __func__, 4), \
+                                       (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 4), double__symbol, __func__, 5), \
+                                       (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 5), double__symbol, __func__, 6), \
+                                       (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 6), double__symbol, __func__, 7)); \
+                  return(s7_car(args));                                                          \
+                }
+               Integration(qk15)
+               Integration(qk21)
+               Integration(qk31)
+               Integration(qk41)
+               Integration(qk51)
+               Integration(qk61)
+               ")
+	 (C-function ("gsl_integration_qk15" g_gsl_integration_qk15 "" 7))
+	 (C-function ("gsl_integration_qk21" g_gsl_integration_qk21 "" 7))
+	 (C-function ("gsl_integration_qk31" g_gsl_integration_qk31 "" 7))
+	 (C-function ("gsl_integration_qk41" g_gsl_integration_qk41 "" 7))
+	 (C-function ("gsl_integration_qk51" g_gsl_integration_qk51 "" 7))
+	 (C-function ("gsl_integration_qk61" g_gsl_integration_qk61 "" 7))
+
+	 (reader-cond ((>= gsl-version 2.5)
+		       (in-C "
+                static s7_pointer g_gsl_integration_romberg(s7_scheme *sc, s7_pointer args)
+                              {
+                                gsl_function gsl_f; make_gsl_function(s7_car(args));
+                                gsl_integration_romberg(&gsl_f,
+                                                        s7_real(s7_cadr(args)), s7_real(s7_caddr(args)),
+                                                        s7_real(s7_cadddr(args)), s7_real(s7_list_ref(sc, args, 4)),
+                                                        (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 5), double__symbol, __func__, 6),
+                                                        (size_t *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 6), double__symbol, __func__, 7),
+                                                        (gsl_integration_romberg_workspace *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 7), gsl_integration_romberg_workspace__symbol, __func__, 7));
+                                return(s7_car(args));
+                              }")
+		       (C-function ("gsl_integration_romberg" g_gsl_integration_romberg "" 8))))
+
+
+	 (in-C "
+                static s7_pointer g_gsl_integration_qcheb(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_function gsl_f; make_gsl_function(s7_car(args));
+                  gsl_integration_qcheb(&gsl_f, s7_real(s7_cadr(args)), s7_real(s7_caddr(args)),
+                                             (double *)s7_c_pointer_with_type(sc, s7_cadddr(args), double__symbol, __func__, 4),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 4), double__symbol, __func__, 5));
+                  return(s7_car(args));
+                }
+                static s7_pointer g_gsl_integration_qng(s7_scheme *sc, s7_pointer args)
+                {
+                  size_t ref;
+                  gsl_function gsl_f; make_gsl_function(s7_car(args));
+                  return(s7_make_integer(sc, gsl_integration_qng(&gsl_f,
+                                             s7_real(s7_list_ref(sc, args, 1)), s7_real(s7_list_ref(sc, args, 2)),
+                                             s7_real(s7_list_ref(sc, args, 3)), s7_real(s7_list_ref(sc, args, 4)),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 5), double__symbol, __func__, 6),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 6), double__symbol, __func__, 7),
+                                             &ref)));
+                }
+                static s7_pointer g_gsl_integration_qag(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_function gsl_f; make_gsl_function(s7_car(args));
+                  return(s7_make_integer(sc, gsl_integration_qag(&gsl_f,
+                                             s7_real(s7_list_ref(sc, args, 1)), s7_real(s7_list_ref(sc, args, 2)),
+                                             s7_real(s7_list_ref(sc, args, 3)), s7_real(s7_list_ref(sc, args, 4)),
+                                             (size_t)s7_integer(s7_list_ref(sc, args, 5)), (int)s7_integer(s7_list_ref(sc, args, 6)),
+                                             (gsl_integration_workspace *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 7), gsl_integration_workspace__symbol, __func__, 7),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 8), double__symbol, __func__, 9),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 9), double__symbol, __func__, 10))));
+                }
+                static s7_pointer g_gsl_integration_qagi(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_function gsl_f; make_gsl_function(s7_car(args));
+                  return(s7_make_integer(sc, gsl_integration_qagi(&gsl_f,
+                                             s7_real(s7_list_ref(sc, args, 1)), s7_real(s7_list_ref(sc, args, 2)),
+                                             (size_t)s7_integer(s7_list_ref(sc, args, 3)),
+                                             (gsl_integration_workspace *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 4), gsl_integration_workspace__symbol, __func__, 4),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 5), double__symbol, __func__, 6),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 6), double__symbol, __func__, 7))));
+                }
+                static s7_pointer g_gsl_integration_qagiu(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_function gsl_f; make_gsl_function(s7_car(args));
+                  return(s7_make_integer(sc, gsl_integration_qagiu(&gsl_f,
+                                             s7_real(s7_list_ref(sc, args, 1)), s7_real(s7_list_ref(sc, args, 2)), s7_real(s7_list_ref(sc, args, 3)),
+                                             (size_t)s7_integer(s7_list_ref(sc, args, 4)),
+                                             (gsl_integration_workspace *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 5), gsl_integration_workspace__symbol, __func__, 5),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 6), double__symbol, __func__, 7),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 7), double__symbol, __func__, 8))));
+                }
+                static s7_pointer g_gsl_integration_qagil(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_function gsl_f; make_gsl_function(s7_car(args));
+                  return(s7_make_integer(sc, gsl_integration_qagil(&gsl_f,
+                                             s7_real(s7_list_ref(sc, args, 1)), s7_real(s7_list_ref(sc, args, 2)), s7_real(s7_list_ref(sc, args, 3)),
+                                             (size_t)s7_integer(s7_list_ref(sc, args, 4)),
+                                             (gsl_integration_workspace *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 5), gsl_integration_workspace__symbol, __func__, 5),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 6), double__symbol, __func__, 7),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 7), double__symbol, __func__, 8))));
+                }
+                static s7_pointer g_gsl_integration_qags(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_function gsl_f; make_gsl_function(s7_car(args));
+                  return(s7_make_integer(sc, gsl_integration_qags(&gsl_f,
+                                             s7_real(s7_list_ref(sc, args, 1)), s7_real(s7_list_ref(sc, args, 2)),
+                                             s7_real(s7_list_ref(sc, args, 3)), s7_real(s7_list_ref(sc, args, 4)),
+                                             (size_t)s7_integer(s7_list_ref(sc, args, 5)),
+                                             (gsl_integration_workspace *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 6), gsl_integration_workspace__symbol, __func__, 6),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 7), double__symbol, __func__, 8),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 8), double__symbol, __func__, 9))));
+                }
+                static s7_pointer g_gsl_integration_qagp(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_function gsl_f; make_gsl_function(s7_car(args));
+                  return(s7_make_integer(sc, gsl_integration_qagp(&gsl_f,
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 1), double__symbol, __func__, 2),
+                                             (size_t)s7_integer(s7_list_ref(sc, args, 2)),
+                                             s7_real(s7_list_ref(sc, args, 3)), s7_real(s7_list_ref(sc, args, 4)),
+                                             (size_t)s7_integer(s7_list_ref(sc, args, 5)),
+                                             (gsl_integration_workspace *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 6), gsl_integration_workspace__symbol, __func__, 6),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 7), double__symbol, __func__, 8),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 8), double__symbol, __func__, 9))));
+                }
+                static s7_pointer g_gsl_integration_qawc(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_function gsl_f; make_gsl_function(s7_car(args));
+                  return(s7_make_integer(sc, gsl_integration_qawc(&gsl_f,
+                                             s7_real(s7_list_ref(sc, args, 1)), s7_real(s7_list_ref(sc, args, 2)),
+                                             s7_real(s7_list_ref(sc, args, 3)), s7_real(s7_list_ref(sc, args, 4)),
+                                             s7_real(s7_list_ref(sc, args, 5)),
+                                             (size_t)s7_integer(s7_list_ref(sc, args, 6)),
+                                             (gsl_integration_workspace *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 7), gsl_integration_workspace__symbol, __func__, 7),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 8), double__symbol, __func__, 9),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 9), double__symbol, __func__, 10))));
+                }
+                static s7_pointer g_gsl_integration_qaws(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_function gsl_f; make_gsl_function(s7_car(args));
+                  return(s7_make_integer(sc, gsl_integration_qaws(&gsl_f,
+                                             s7_real(s7_list_ref(sc, args, 1)), s7_real(s7_list_ref(sc, args, 2)),
+                                             (gsl_integration_qaws_table *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 3), gsl_integration_qaws_table__symbol, __func__, 3),
+                                             s7_real(s7_list_ref(sc, args, 4)), s7_real(s7_list_ref(sc, args, 5)),
+                                             (size_t)s7_integer(s7_list_ref(sc, args, 6)),
+                                             (gsl_integration_workspace *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 7), gsl_integration_workspace__symbol, __func__, 7),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 8), double__symbol, __func__, 9),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 9), double__symbol, __func__, 10))));
+                }
+                static s7_pointer g_gsl_integration_qawo(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_function gsl_f; make_gsl_function(s7_car(args));
+                  return(s7_make_integer(sc, gsl_integration_qawo(&gsl_f,
+                                             s7_real(s7_list_ref(sc, args, 1)), s7_real(s7_list_ref(sc, args, 2)),
+                                             s7_real(s7_list_ref(sc, args, 3)),
+                                             (size_t)s7_integer(s7_list_ref(sc, args, 4)),
+                                             (gsl_integration_workspace *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 5), gsl_integration_workspace__symbol, __func__, 5),
+                                             (gsl_integration_qawo_table *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 6), gsl_integration_qawo_table__symbol, __func__, 6),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 7), double__symbol, __func__, 8),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 8), double__symbol, __func__, 9))));
+                }
+                static s7_pointer g_gsl_integration_qawf(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_function gsl_f; make_gsl_function(s7_car(args));
+                  return(s7_make_integer(sc, gsl_integration_qawf(&gsl_f,
+                                             s7_real(s7_list_ref(sc, args, 1)), s7_real(s7_list_ref(sc, args, 2)),
+                                             (size_t)s7_integer(s7_list_ref(sc, args, 3)),
+                                             (gsl_integration_workspace *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 4), gsl_integration_workspace__symbol, __func__, 4),
+                                             (gsl_integration_workspace *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 5), gsl_integration_workspace__symbol, __func__, 5),
+                                             (gsl_integration_qawo_table *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 6), gsl_integration_qawo_table__symbol, __func__, 6),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 7), double__symbol, __func__, 8),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 8), double__symbol, __func__, 9))));
+                }
+                static s7_pointer g_gsl_integration_glfixed(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_function gsl_f; make_gsl_function(s7_car(args));
+                  return(s7_make_real(sc, gsl_integration_glfixed(&gsl_f,
+                                             s7_real(s7_list_ref(sc, args, 1)), s7_real(s7_list_ref(sc, args, 2)),
+                                             (const gsl_integration_glfixed_table *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 3), gsl_integration_glfixed_table__symbol, __func__, 3))));
+                }
+                static s7_pointer g_gsl_integration_qk(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_function gsl_f; make_gsl_function(s7_list_ref(sc, args, 6));
+                  gsl_integration_qk((int)s7_integer(s7_car(args)),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 1), double__symbol, __func__, 2),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 2), double__symbol, __func__, 3),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 3), double__symbol, __func__, 4),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 4), double__symbol, __func__, 5),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 5), double__symbol, __func__, 6),
+                                             &gsl_f,
+                                             s7_real(s7_list_ref(sc, args, 7)), s7_real(s7_list_ref(sc, args, 8)),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 9), double__symbol, __func__, 10),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 10), double__symbol, __func__, 11),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 11), double__symbol, __func__, 12),
+                                             (double *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 12), double__symbol, __func__, 13));
+                  return(s7_car(args));
+                }")
+	 (C-function ("gsl_integration_qcheb" g_gsl_integration_qcheb "" 5))
+	 (C-function ("gsl_integration_qng" g_gsl_integration_qng "" 7))
+	 (C-function ("gsl_integration_qag" g_gsl_integration_qag "" 10))
+	 (C-function ("gsl_integration_qagi" g_gsl_integration_qagi "" 7))
+	 (C-function ("gsl_integration_qagiu" g_gsl_integration_qagiu "" 8))
+	 (C-function ("gsl_integration_qagil" g_gsl_integration_qagil "" 8))
+	 (C-function ("gsl_integration_qags" g_gsl_integration_qags "" 9))
+	 (C-function ("gsl_integration_qagp" g_gsl_integration_qagp "" 9))
+	 (C-function ("gsl_integration_qawc" g_gsl_integration_qawc "" 10))
+	 (C-function ("gsl_integration_qaws" g_gsl_integration_qaws "" 10))
+	 (C-function ("gsl_integration_qawo" g_gsl_integration_qawo "" 9))
+	 (C-function ("gsl_integration_qawf" g_gsl_integration_qawf "" 9))
+	 (C-function ("gsl_integration_qk" g_gsl_integration_qk "" 13))
+	 (C-function ("gsl_integration_glfixed" g_gsl_integration_glfixed "" 4))
+
+	 (gsl_integration_glfixed_table* gsl_integration_glfixed_table_alloc (size_t))
+	 (void gsl_integration_glfixed_table_free (gsl_integration_glfixed_table*))
+	 (reader-cond ((>= gsl-version 1.15)
+		       (int gsl_integration_glfixed_point (double double size_t double* double* gsl_integration_glfixed_table*))
+		       (gsl_integration_cquad_workspace* gsl_integration_cquad_workspace_alloc (size_t))
+		       (void gsl_integration_cquad_workspace_free (gsl_integration_cquad_workspace*))))
+
+	 (int gsl_linalg_matmult (gsl_matrix* gsl_matrix* gsl_matrix*))
+	 (int gsl_linalg_matmult_mod (gsl_matrix* (gsl_linalg_matrix_mod_t int) gsl_matrix* (gsl_linalg_matrix_mod_t int) gsl_matrix*))
+	 (int gsl_linalg_exponential_ss (gsl_matrix* gsl_matrix* int))
+	 (double gsl_linalg_householder_transform (gsl_vector*))
+	 (int gsl_linalg_householder_hv (double gsl_vector* gsl_vector*))
+	 (int gsl_linalg_householder_hm1 (double gsl_matrix*))
+
+	 (in-C "
+                static s7_pointer g_gsl_linalg_complex_householder_transform(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_complex g;
+                  g = gsl_linalg_complex_householder_transform((gsl_vector_complex *)s7_c_pointer_with_type(sc, s7_car(args), gsl_vector_complex__symbol, __func__, 1));
+                  return(GSL_TO_S7_COMPLEX(sc, g));
+                }
+                static s7_pointer g_gsl_linalg_complex_householder_hv(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_complex g;
+                  S7_TO_GSL_COMPLEX(s7_car(args), g);
+                  return(s7_make_integer(sc, gsl_linalg_complex_householder_hv(g, (gsl_vector_complex *)s7_c_pointer_with_type(sc, s7_cadr(args), gsl_vector_complex__symbol, __func__, 2),
+                                                                                  (gsl_vector_complex *)s7_c_pointer_with_type(sc, s7_caddr(args), gsl_vector_complex__symbol, __func__, 3))));
+                }
+                static s7_pointer g_gsl_linalg_complex_LU_det(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_complex g;
+                  g = gsl_linalg_complex_LU_det((gsl_matrix_complex *)s7_c_pointer_with_type(sc, s7_car(args), gsl_matrix_complex__symbol, __func__, 1), (int)s7_integer(s7_cadr(args)));
+                  return(GSL_TO_S7_COMPLEX(sc, g));
+                }
+                static s7_pointer g_gsl_linalg_complex_LU_sgndet(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_complex g;
+                  g = gsl_linalg_complex_LU_sgndet((gsl_matrix_complex *)s7_c_pointer_with_type(sc, s7_car(args), gsl_matrix_complex__symbol, __func__, 1), (int)s7_integer(s7_cadr(args)));
+                  return(GSL_TO_S7_COMPLEX(sc, g));
+                }
+                ")
+	 (C-function ("gsl_linalg_complex_householder_transform" g_gsl_linalg_complex_householder_transform "" 1))
+	 ;(C-function ("gsl_linalg_complex_householder_hm" g_gsl_linalg_complex_householder_hm "" 3)) ; deprecated 2.6
+	 ;(C-function ("gsl_linalg_complex_householder_mh" g_gsl_linalg_complex_householder_mh "" 3))
+	 (C-function ("gsl_linalg_complex_householder_hv" g_gsl_linalg_complex_householder_hv "" 3))
+	 (C-function ("gsl_linalg_complex_LU_det" g_gsl_linalg_complex_LU_det "" 2))
+	 (C-function ("gsl_linalg_complex_LU_sgndet" g_gsl_linalg_complex_LU_sgndet "" 2))
+
+	 (int gsl_linalg_hessenberg_decomp (gsl_matrix* gsl_vector*))
+	 (int gsl_linalg_hessenberg_unpack (gsl_matrix* gsl_vector* gsl_matrix*))
+	 (int gsl_linalg_hessenberg_unpack_accum (gsl_matrix* gsl_vector* gsl_matrix*))
+	 (int gsl_linalg_hessenberg_set_zero (gsl_matrix*))
+	 (int gsl_linalg_hessenberg_submatrix (gsl_matrix* gsl_matrix* size_t gsl_vector*))
+	 ;; out 2.4 (int gsl_linalg_hessenberg (gsl_matrix* gsl_vector*))
+	 (int gsl_linalg_hesstri_decomp (gsl_matrix* gsl_matrix* gsl_matrix* gsl_matrix* gsl_vector*))
+	 (int gsl_linalg_SV_decomp (gsl_matrix* gsl_matrix* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_SV_decomp_mod (gsl_matrix* gsl_matrix* gsl_matrix* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_SV_decomp_jacobi (gsl_matrix* gsl_matrix* gsl_vector*))
+	 (int gsl_linalg_SV_solve (gsl_matrix* gsl_matrix* gsl_vector* gsl_vector* gsl_vector*))
+	 (reader-cond ((>= gsl-version 1.16) (int gsl_linalg_SV_leverage (gsl_matrix* gsl_vector*))))
+	 (in-C "
+                static s7_pointer g_gsl_linalg_LU_decomp(s7_scheme *sc, s7_pointer args)
+                {
+                  int s = 0;
+                  return(s7_make_integer(sc, (s7_int)gsl_linalg_LU_decomp((gsl_matrix *)s7_c_pointer_with_type(sc, s7_car(args), gsl_matrix__symbol, __func__, 1),
+                                             (gsl_permutation *)s7_c_pointer_with_type(sc, s7_cadr(args), gsl_permutation__symbol, __func__, 2), &s)));
+                }")
+	 (C-function ("gsl_linalg_LU_decomp" g_gsl_linalg_LU_decomp "" 2))
+	 (int gsl_linalg_LU_solve (gsl_matrix* gsl_permutation* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_LU_svx (gsl_matrix* gsl_permutation* gsl_vector*))
+	 (int gsl_linalg_LU_refine (gsl_matrix* gsl_matrix* gsl_permutation* gsl_vector* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_LU_invert (gsl_matrix* gsl_permutation* gsl_matrix*))
+	 (double gsl_linalg_LU_det (gsl_matrix* int))
+	 (double gsl_linalg_LU_lndet (gsl_matrix*))
+	 (int gsl_linalg_LU_sgndet (gsl_matrix* int))
+	 (in-C "
+                static s7_pointer g_gsl_linalg_complex_LU_decomp(s7_scheme *sc, s7_pointer args)
+                {
+                  int s = 0;
+                  return(s7_make_integer(sc, (s7_int)gsl_linalg_complex_LU_decomp((gsl_matrix_complex *)s7_c_pointer_with_type(sc, s7_car(args), gsl_matrix_complex__symbol, __func__, 1),
+                                             (gsl_permutation *)s7_c_pointer_with_type(sc, s7_cadr(args), gsl_permutation__symbol, __func__, 2), &s)));
+                }")
+	 (C-function ("gsl_linalg_complex_LU_decomp" g_gsl_linalg_complex_LU_decomp "" 2))
+	 (int gsl_linalg_complex_LU_solve (gsl_matrix_complex* gsl_permutation* gsl_vector_complex* gsl_vector_complex*))
+	 (int gsl_linalg_complex_LU_svx (gsl_matrix_complex* gsl_permutation* gsl_vector_complex*))
+	 (int gsl_linalg_complex_LU_refine (gsl_matrix_complex* gsl_matrix_complex* gsl_permutation* gsl_vector_complex* gsl_vector_complex* gsl_vector_complex*))
+	 (int gsl_linalg_complex_LU_invert (gsl_matrix_complex* gsl_permutation* gsl_matrix_complex*))
+	 (double gsl_linalg_complex_LU_lndet (gsl_matrix_complex*))
+	 (int gsl_linalg_QR_decomp (gsl_matrix* gsl_vector*))
+	 (int gsl_linalg_QR_solve (gsl_matrix* gsl_vector* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_QR_svx (gsl_matrix* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_QR_lssolve (gsl_matrix* gsl_vector* gsl_vector* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_QR_QRsolve (gsl_matrix* gsl_matrix* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_QR_Rsolve (gsl_matrix* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_QR_Rsvx (gsl_matrix* gsl_vector*))
+	 (int gsl_linalg_QR_update (gsl_matrix* gsl_matrix* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_QR_QTvec (gsl_matrix* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_QR_Qvec (gsl_matrix* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_QR_QTmat (gsl_matrix* gsl_vector* gsl_matrix*))
+	 (reader-cond ((>= gsl-version 2.0)
+		       (int gsl_linalg_QR_matQ (gsl_matrix* gsl_vector* gsl_matrix*))
+		       (void gsl_linalg_givens (double double double* double*))
+		       (void gsl_linalg_givens_gv (gsl_vector* size_t size_t double double))))
+	 (int gsl_linalg_QR_unpack (gsl_matrix* gsl_vector* gsl_matrix* gsl_matrix*))
+	 (int gsl_linalg_R_solve (gsl_matrix* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_R_svx (gsl_matrix* gsl_vector*))
+	 (in-C "
+                static s7_pointer g_gsl_linalg_QRPT_decomp(s7_scheme *sc, s7_pointer args)
+                {
+                  int s = 0;
+                  return(s7_make_integer(sc, (s7_int)gsl_linalg_QRPT_decomp(
+                                             (gsl_matrix *)s7_c_pointer_with_type(sc, s7_car(args), gsl_matrix__symbol, __func__, 1),
+                                             (gsl_vector *)s7_c_pointer_with_type(sc, s7_cadr(args), gsl_vector__symbol, __func__, 2),
+                                             (gsl_permutation *)s7_c_pointer_with_type(sc, s7_caddr(args), gsl_permutation__symbol, __func__, 3), &s,
+                                             (gsl_vector *)s7_c_pointer_with_type(sc, s7_cadddr(args), gsl_vector__symbol, __func__, 4))));
+                }")
+	 (C-function ("gsl_linalg_QRPT_decomp" g_gsl_linalg_QRPT_decomp "" 4))
+	 (in-C "
+                static s7_pointer g_gsl_linalg_QRPT_decomp2(s7_scheme *sc, s7_pointer args)
+                {
+                  int s = 0;
+                  return(s7_make_integer(sc, (s7_int)gsl_linalg_QRPT_decomp2(
+                                             (gsl_matrix *)s7_c_pointer_with_type(sc, s7_car(args), gsl_matrix__symbol, __func__, 1),
+                                             (gsl_matrix *)s7_c_pointer_with_type(sc, s7_cadr(args), gsl_matrix__symbol, __func__, 2),
+                                             (gsl_matrix *)s7_c_pointer_with_type(sc, s7_caddr(args), gsl_matrix__symbol, __func__, 3),
+                                             (gsl_vector *)s7_c_pointer_with_type(sc, s7_cadddr(args), gsl_vector__symbol, __func__, 4),
+                                             (gsl_permutation *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 5), gsl_permutation__symbol, __func__, 5),
+                                             &s,
+                                             (gsl_vector *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 6), gsl_vector__symbol, __func__, 6))));
+                }")
+	 (C-function ("gsl_linalg_QRPT_decomp2" g_gsl_linalg_QRPT_decomp2 "" 6))
+	 (int gsl_linalg_QRPT_solve (gsl_matrix* gsl_vector* gsl_permutation* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_QRPT_svx (gsl_matrix* gsl_vector* gsl_permutation* gsl_vector*))
+	 (int gsl_linalg_QRPT_QRsolve (gsl_matrix* gsl_matrix* gsl_permutation* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_QRPT_Rsolve (gsl_matrix* gsl_permutation* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_QRPT_Rsvx (gsl_matrix* gsl_permutation* gsl_vector*))
+	 (int gsl_linalg_QRPT_update (gsl_matrix* gsl_matrix* gsl_permutation* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_LQ_decomp (gsl_matrix* gsl_vector*))
+	 (int gsl_linalg_LQ_solve_T (gsl_matrix* gsl_vector* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_LQ_svx_T (gsl_matrix* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_LQ_lssolve_T (gsl_matrix* gsl_vector* gsl_vector* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_LQ_Lsolve_T (gsl_matrix* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_LQ_Lsvx_T (gsl_matrix* gsl_vector*))
+	 (int gsl_linalg_L_solve_T (gsl_matrix* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_LQ_vecQ (gsl_matrix* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_LQ_vecQT (gsl_matrix* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_LQ_unpack (gsl_matrix* gsl_vector* gsl_matrix* gsl_matrix*))
+	 (int gsl_linalg_LQ_update (gsl_matrix* gsl_matrix* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_LQ_LQsolve (gsl_matrix* gsl_matrix* gsl_vector* gsl_vector*))
+	 (in-C "
+                static s7_pointer g_gsl_linalg_PTLQ_decomp(s7_scheme *sc, s7_pointer args)
+                {
+                  int s = 0;
+                  return(s7_make_integer(sc, (s7_int)gsl_linalg_PTLQ_decomp(
+                                             (gsl_matrix *)s7_c_pointer_with_type(sc, s7_car(args), gsl_matrix__symbol, __func__, 1),
+                                             (gsl_vector *)s7_c_pointer_with_type(sc, s7_cadr(args), gsl_vector__symbol, __func__, 2),
+                                             (gsl_permutation *)s7_c_pointer_with_type(sc, s7_caddr(args), gsl_permutation__symbol, __func__, 3),
+                                             &s,
+                                             (gsl_vector *)s7_c_pointer_with_type(sc, s7_cadddr(args), gsl_vector__symbol, __func__, 4))));
+                }")
+	 (C-function ("gsl_linalg_PTLQ_decomp" g_gsl_linalg_PTLQ_decomp "" 4))
+	 (in-C "
+                static s7_pointer g_gsl_linalg_PTLQ_decomp2(s7_scheme *sc, s7_pointer args)
+                {
+                  int s = 0;
+                  return(s7_make_integer(sc, (s7_int)gsl_linalg_PTLQ_decomp2(
+                                             (gsl_matrix *)s7_c_pointer_with_type(sc, s7_car(args), gsl_matrix__symbol, __func__, 1),
+                                             (gsl_matrix *)s7_c_pointer_with_type(sc, s7_cadr(args), gsl_matrix__symbol, __func__, 2),
+                                             (gsl_matrix *)s7_c_pointer_with_type(sc, s7_caddr(args), gsl_matrix__symbol, __func__, 3),
+                                             (gsl_vector *)s7_c_pointer_with_type(sc, s7_cadddr(args), gsl_vector__symbol, __func__, 4),
+                                             (gsl_permutation *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 5), gsl_permutation__symbol, __func__, 5),
+                                             &s,
+                                             (gsl_vector *)s7_c_pointer_with_type(sc, s7_list_ref(sc, args, 6), gsl_vector__symbol, __func__, 6))));
+                }")
+	 (C-function ("gsl_linalg_PTLQ_decomp2" g_gsl_linalg_PTLQ_decomp2 "" 6))
+	 (int gsl_linalg_PTLQ_solve_T (gsl_matrix* gsl_vector* gsl_permutation* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_PTLQ_svx_T (gsl_matrix* gsl_vector* gsl_permutation* gsl_vector*))
+	 (int gsl_linalg_PTLQ_LQsolve_T (gsl_matrix* gsl_matrix* gsl_permutation* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_PTLQ_Lsolve_T (gsl_matrix* gsl_permutation* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_PTLQ_Lsvx_T (gsl_matrix* gsl_permutation* gsl_vector*))
+	 (int gsl_linalg_PTLQ_update (gsl_matrix* gsl_matrix* gsl_permutation* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_cholesky_decomp (gsl_matrix*))
+	 (int gsl_linalg_cholesky_solve (gsl_matrix* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_cholesky_svx (gsl_matrix* gsl_vector*))
+	 (int gsl_linalg_cholesky_invert (gsl_matrix*))
+	 (int gsl_linalg_cholesky_decomp_unit (gsl_matrix* gsl_vector*))
+	 (int gsl_linalg_complex_cholesky_decomp (gsl_matrix_complex*))
+	 (int gsl_linalg_complex_cholesky_solve (gsl_matrix_complex* gsl_vector_complex* gsl_vector_complex*))
+	 (int gsl_linalg_complex_cholesky_svx (gsl_matrix_complex* gsl_vector_complex*))
+	 (reader-cond ((>= gsl-version 1.15) (int gsl_linalg_complex_cholesky_invert (gsl_matrix_complex*))))
+	 (int gsl_linalg_symmtd_decomp (gsl_matrix* gsl_vector*))
+	 (int gsl_linalg_symmtd_unpack (gsl_matrix* gsl_vector* gsl_matrix* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_symmtd_unpack_T (gsl_matrix* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_hermtd_decomp (gsl_matrix_complex* gsl_vector_complex*))
+	 (int gsl_linalg_hermtd_unpack (gsl_matrix_complex* gsl_vector_complex* gsl_matrix_complex* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_hermtd_unpack_T (gsl_matrix_complex* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_HH_solve (gsl_matrix* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_HH_svx (gsl_matrix* gsl_vector*))
+	 (int gsl_linalg_solve_symm_tridiag (gsl_vector* gsl_vector* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_solve_tridiag (gsl_vector* gsl_vector* gsl_vector* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_solve_symm_cyc_tridiag (gsl_vector* gsl_vector* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_solve_cyc_tridiag (gsl_vector* gsl_vector* gsl_vector* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_bidiag_decomp (gsl_matrix* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_bidiag_unpack (gsl_matrix* gsl_vector* gsl_matrix* gsl_vector* gsl_matrix* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_bidiag_unpack2 (gsl_matrix* gsl_vector* gsl_vector* gsl_matrix*))
+	 (int gsl_linalg_bidiag_unpack_B (gsl_matrix* gsl_vector* gsl_vector*))
+	 (int gsl_linalg_balance_matrix (gsl_matrix* gsl_vector*))
+	 (int gsl_linalg_balance_accum (gsl_matrix* gsl_vector*))
+	 (int gsl_linalg_balance_columns (gsl_matrix* gsl_vector*))
+	 (reader-cond ((>= gsl-version 2.6)
+		       (int gsl_linalg_LQ_lssolve (gsl_matrix* gsl_vector* gsl_vector* gsl_vector* gsl_vector*))
+		       (int gsl_linalg_LQ_QTvec (gsl_matrix* gsl_vector* gsl_vector*))
+		       (int gsl_linalg_ldlt_decomp (gsl_matrix*))
+		       (int gsl_linalg_ldlt_solve (gsl_matrix* gsl_vector* gsl_vector*))
+		       (int gsl_linalg_ldlt_svx (gsl_matrix* gsl_vector*))
+		       (int gsl_linalg_ldlt_rcond (gsl_matrix* double* gsl_vector*))
+		       (int gsl_linalg_ldlt_band_decomp (gsl_matrix*))
+		       (int gsl_linalg_ldlt_band_solve (gsl_matrix* gsl_vector* gsl_vector*))
+		       (int gsl_linalg_ldlt_band_svx (gsl_matrix* gsl_vector*))
+		       (int gsl_linalg_ldlt_band_unpack (gsl_matrix* gsl_matrix* gsl_vector*))
+		       (int gsl_linalg_ldlt_band_rcond (gsl_matrix* double* gsl_vector*))))
+
+	 (gsl_matrix_complex* gsl_matrix_complex_alloc (size_t size_t))
+	 (gsl_matrix_complex* gsl_matrix_complex_calloc (size_t size_t))
+	 (gsl_matrix_complex* gsl_matrix_complex_alloc_from_matrix (gsl_matrix_complex* size_t size_t size_t size_t))
+	 (gsl_vector_complex* gsl_vector_complex_alloc_row_from_matrix (gsl_matrix_complex* size_t))
+	 (gsl_vector_complex* gsl_vector_complex_alloc_col_from_matrix (gsl_matrix_complex* size_t))
+	 (gsl_vector_complex* gsl_vector_complex_alloc (size_t))
+	 (void gsl_vector_complex_free (gsl_vector_complex*))
+	 (void gsl_matrix_complex_free (gsl_matrix_complex*))
+	 (void gsl_matrix_complex_set_zero (gsl_matrix_complex*))
+	 (void gsl_matrix_complex_set_identity (gsl_matrix_complex*))
+	 (int gsl_matrix_complex_fread (FILE* gsl_matrix_complex*) )
+	 (int gsl_matrix_complex_fwrite (FILE* gsl_matrix_complex*) )
+	 (int gsl_matrix_complex_fscanf (FILE* gsl_matrix_complex*))
+	 (int gsl_matrix_complex_fprintf (FILE* gsl_matrix_complex* char*))
+	 (int gsl_matrix_complex_memcpy (gsl_matrix_complex* gsl_matrix_complex*))
+	 (int gsl_matrix_complex_swap (gsl_matrix_complex* gsl_matrix_complex*))
+	 (int gsl_matrix_complex_swap_rows (gsl_matrix_complex* size_t size_t))
+	 (int gsl_matrix_complex_swap_columns (gsl_matrix_complex* size_t size_t))
+	 (int gsl_matrix_complex_swap_rowcol (gsl_matrix_complex* size_t size_t))
+	 (int gsl_matrix_complex_transpose (gsl_matrix_complex*))
+	 (int gsl_matrix_complex_transpose_memcpy (gsl_matrix_complex* gsl_matrix_complex*))
+	 (reader-cond ((>= gsl-version 1.15) (int gsl_matrix_complex_equal (gsl_matrix_complex* gsl_matrix_complex*))))
+	 (int gsl_matrix_complex_isnull (gsl_matrix_complex*))
+	 (int gsl_matrix_complex_ispos (gsl_matrix_complex*))
+	 (int gsl_matrix_complex_isneg (gsl_matrix_complex*))
+	 (int gsl_matrix_complex_isnonneg (gsl_matrix_complex*))
+	 (int gsl_matrix_complex_add (gsl_matrix_complex* gsl_matrix_complex*))
+	 (int gsl_matrix_complex_sub (gsl_matrix_complex* gsl_matrix_complex*))
+	 (int gsl_matrix_complex_mul_elements (gsl_matrix_complex* gsl_matrix_complex*))
+	 (int gsl_matrix_complex_div_elements (gsl_matrix_complex* gsl_matrix_complex*))
+
+	 (in-C "
+                static s7_pointer g_gsl_matrix_complex_set_all(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_complex g;
+                  S7_TO_GSL_COMPLEX(s7_cadr(args), g);
+                  gsl_matrix_complex_set_all((gsl_matrix_complex *)s7_c_pointer_with_type(sc, s7_car(args), gsl_matrix_complex__symbol, __func__, 1), g);
+                  return(s7_cadr(args));
+                }
+                static s7_pointer g_gsl_matrix_complex_set(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_complex g;
+                  s7_pointer cg;
+                  cg = s7_cadddr(args);
+                  S7_TO_GSL_COMPLEX(cg, g);
+                  gsl_matrix_complex_set((gsl_matrix_complex *)s7_c_pointer_with_type(sc, s7_car(args), gsl_matrix_complex__symbol, __func__, 1), s7_integer(s7_cadr(args)), s7_integer(s7_caddr(args)), g);
+                  return(cg);
+                }
+                static s7_pointer g_gsl_matrix_complex_get(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_complex g;
+                  g = gsl_matrix_complex_get((gsl_matrix_complex *)s7_c_pointer_with_type(sc, s7_car(args), gsl_matrix_complex__symbol, __func__, 1), s7_integer(s7_cadr(args)), s7_integer(s7_caddr(args)));
+                  return(GSL_TO_S7_COMPLEX(sc, g));
+                }
+                static s7_pointer g_gsl_matrix_complex_scale(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_complex g;
+                  S7_TO_GSL_COMPLEX(s7_cadr(args), g);
+                  return(s7_make_integer(sc, gsl_matrix_complex_scale((gsl_matrix_complex *)s7_c_pointer_with_type(sc, s7_car(args), gsl_matrix_complex__symbol, __func__, 1), g)));
+                }
+                static s7_pointer g_gsl_matrix_complex_add_constant(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_complex g;
+                  S7_TO_GSL_COMPLEX(s7_cadr(args), g);
+                  return(s7_make_integer(sc, gsl_matrix_complex_add_constant((gsl_matrix_complex *)s7_c_pointer_with_type(sc, s7_car(args), gsl_matrix_complex__symbol, __func__, 1), g)));
+                }
+                static s7_pointer g_gsl_matrix_complex_add_diagonal(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_complex g;
+                  S7_TO_GSL_COMPLEX(s7_cadr(args), g);
+                  return(s7_make_integer(sc, gsl_matrix_complex_add_diagonal((gsl_matrix_complex *)s7_c_pointer_with_type(sc, s7_car(args), gsl_matrix_complex__symbol, __func__, 1), g)));
+                }
+                static s7_pointer g_gsl_vector_complex_get(s7_scheme *sc, s7_pointer args)
+                {
+                  gsl_complex g;
+                  g = gsl_vector_complex_get((gsl_vector_complex *)s7_c_pointer_with_type(sc, s7_car(args), gsl_vector_complex__symbol, __func__, 1), s7_integer(s7_cadr(args)));
+                  return(GSL_TO_S7_COMPLEX(sc, g));
+                }
+                ")
+	 (C-function ("gsl_matrix_complex_set_all" g_gsl_matrix_complex_set_all "" 2))
+	 (C-function ("gsl_matrix_complex_set" g_gsl_matrix_complex_set "" 4))
+	 (C-function ("gsl_matrix_complex_get" g_gsl_matrix_complex_get "" 3))
+	 (C-function ("gsl_vector_complex_get" g_gsl_vector_complex_get "" 2))
+	 (C-function ("gsl_matrix_complex_scale" g_gsl_matrix_complex_scale "" 2))
+	 (C-function ("gsl_matrix_complex_add_constant" g_gsl_matrix_complex_add_constant "" 2))
+	 (C-function ("gsl_matrix_complex_add_diagonal" g_gsl_matrix_complex_add_diagonal "" 2))
+
+	 (int gsl_matrix_complex_get_row (gsl_vector_complex* gsl_matrix_complex* size_t))
+	 (int gsl_matrix_complex_get_col (gsl_vector_complex* gsl_matrix_complex* size_t))
+	 (int gsl_matrix_complex_set_row (gsl_matrix_complex* size_t gsl_vector_complex*))
+	 (int gsl_matrix_complex_set_col (gsl_matrix_complex* size_t gsl_vector_complex*))
+	 (gsl_complex* gsl_matrix_complex_ptr (gsl_matrix_complex* size_t size_t))
+	 (gsl_complex* gsl_matrix_complex_const_ptr (gsl_matrix_complex* size_t size_t))
+
+	 (void gsl_message (char* char* int int))
+
+	 (gsl_min_fminimizer* gsl_min_fminimizer_alloc (gsl_min_fminimizer_type*) )
+	 (void gsl_min_fminimizer_free (gsl_min_fminimizer*))
+	 (int gsl_min_fminimizer_set (gsl_min_fminimizer* gsl_function* double double double))
+	 (int gsl_min_fminimizer_set_with_values (gsl_min_fminimizer* gsl_function* double double double double double double))
+	 (int gsl_min_fminimizer_iterate (gsl_min_fminimizer*))
+	 (char* gsl_min_fminimizer_name (gsl_min_fminimizer*))
+	 (double gsl_min_fminimizer_x_minimum (gsl_min_fminimizer*))
+	 (double gsl_min_fminimizer_x_lower (gsl_min_fminimizer*))
+	 (double gsl_min_fminimizer_x_upper (gsl_min_fminimizer*))
+	 (double gsl_min_fminimizer_f_minimum (gsl_min_fminimizer*))
+	 (double gsl_min_fminimizer_f_lower (gsl_min_fminimizer*))
+	 (double gsl_min_fminimizer_f_upper (gsl_min_fminimizer*))
+	 (double gsl_min_fminimizer_minimum (gsl_min_fminimizer*))
+	 (int gsl_min_test_interval (double double double double))
+	 (int gsl_min_find_bracket (gsl_function* double* double* double* double* double* double* size_t))
+
+	 ;; gsl_monte* is not doable -- they chose to pass a bare double* array to the (parameter) gsl_monte_function,
+	 ;;   and there's nothing I can do with that.  To wrap and unwrap it on every call would make it unusable.
+	 ;;   I could keep wrappers around of all so-far-used sizes, but not until someone actually needs them.
+	 ;; the fdf cases [removed in gsl 2.0?] are similar, I think, and the ode functions.  GSL also assumes direct access to their
+	 ;; structs (as in matrix size1/2) -- not very nice for our style of use.
+
+	 (gsl_multifit_linear_workspace* gsl_multifit_linear_alloc (size_t size_t))
+	 (void gsl_multifit_linear_free (gsl_multifit_linear_workspace*))
+	 (int gsl_multifit_linear (gsl_matrix* gsl_vector* gsl_vector* gsl_matrix* double* gsl_multifit_linear_workspace*))
+	 (int gsl_multifit_wlinear (gsl_matrix* gsl_vector* gsl_vector* gsl_vector* gsl_matrix* double* gsl_multifit_linear_workspace*))
+	 (int gsl_multifit_wlinear_svd (gsl_matrix* gsl_vector* gsl_vector* double size_t* gsl_vector* gsl_matrix* double* gsl_multifit_linear_workspace*))
+	 (int gsl_multifit_wlinear_usvd (gsl_matrix* gsl_vector* gsl_vector* double size_t* gsl_vector* gsl_matrix* double* gsl_multifit_linear_workspace*))
+	 (int gsl_multifit_linear_est (gsl_vector* gsl_vector* gsl_matrix* double* double*))
+	 (reader-cond ((>= gsl-version 2.1)
+		       (double gsl_multifit_linear_rcond (gsl_multifit_linear_workspace*))))
+	 (reader-cond ((>= gsl-version 2.3)
+		       (size_t gsl_multifit_linear_rank (double gsl_multifit_linear_workspace*))))
+	 (int gsl_multifit_linear_residuals (gsl_matrix* gsl_vector* gsl_vector* gsl_vector*))
+	 (reader-cond ((>= gsl-version 1.16)
+		       (gsl_multifit_robust_workspace* gsl_multifit_robust_alloc (gsl_multifit_robust_type* size_t size_t))
+		       (void gsl_multifit_robust_free (gsl_multifit_robust_workspace*))
+		       (int gsl_multifit_robust_tune (double gsl_multifit_robust_workspace*))
+		       (char* gsl_multifit_robust_name (gsl_multifit_robust_workspace*))
+		       (gsl_multifit_robust_stats gsl_multifit_robust_statistics (gsl_multifit_robust_workspace*))
+		       (int gsl_multifit_robust (gsl_matrix* gsl_vector* gsl_vector* gsl_matrix* gsl_multifit_robust_workspace*))
+		       (int gsl_multifit_robust_est (gsl_vector* gsl_vector* gsl_matrix* double* double*))
+		       (int gsl_multifit_fsolver_driver (gsl_multifit_fsolver* size_t double double))))
+	 (int gsl_multifit_gradient (gsl_matrix* gsl_vector* gsl_vector*))
+	 (int gsl_multifit_covar (gsl_matrix* double gsl_matrix*))
+	 (gsl_multifit_fsolver* gsl_multifit_fsolver_alloc (gsl_multifit_fsolver_type* size_t size_t))
+	 (void gsl_multifit_fsolver_free (gsl_multifit_fsolver*))
+	 (int gsl_multifit_fsolver_set (gsl_multifit_fsolver* gsl_multifit_function* gsl_vector*))
+	 (int gsl_multifit_fsolver_iterate (gsl_multifit_fsolver*))
+	 (char* gsl_multifit_fsolver_name (gsl_multifit_fsolver*))
+	 (gsl_vector* gsl_multifit_fsolver_position (gsl_multifit_fsolver*))
+	 (int gsl_multifit_test_delta (gsl_vector* gsl_vector* double double))
+	 (int gsl_multifit_test_gradient (gsl_vector* double))
+
+	 (reader-cond
+	  ((< gsl-version 2.0)
+	   (int gsl_multifit_linear_svd (gsl_matrix* gsl_vector* double size_t* gsl_vector* gsl_matrix* double* gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_linear_usvd (gsl_matrix* gsl_vector* double size_t* gsl_vector* gsl_matrix* double* gsl_multifit_linear_workspace*)))
+
+	  ((= gsl-version 2.0)
+	   (int gsl_multifit_linear_svd (gsl_matrix* gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_linear_bsvd (gsl_matrix* gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_linear_solve (double gsl_matrix* gsl_vector* gsl_vector* double* double* gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_linear_applyW (gsl_matrix* gsl_vector* gsl_vector* gsl_matrix* gsl_vector* gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_linear_stdform1 (gsl_vector* gsl_matrix* gsl_vector* gsl_matrix* gsl_vector* gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_linear_wstdform1 (gsl_vector* gsl_matrix* gsl_vector* gsl_vector* gsl_matrix* gsl_vector* gsl_multifit_linear_workspace*))
+
+	   (int gsl_multifit_linear_stdform2 (gsl_matrix* gsl_matrix* gsl_vector* gsl_matrix* gsl_vector* gsl_matrix* gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_linear_wstdform2 (gsl_matrix* gsl_matrix* gsl_vector* gsl_vector* gsl_matrix* gsl_vector* gsl_matrix* gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_linear_genform1 (gsl_vector* gsl_vector* gsl_vector* gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_linear_genform2 (gsl_matrix* gsl_matrix* gsl_vector* gsl_vector* gsl_matrix* gsl_vector* gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_linear_wgenform2 (gsl_matrix* gsl_matrix* gsl_vector* gsl_vector* gsl_vector* gsl_matrix* gsl_vector* gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_linear_lreg (double double gsl_vector*))
+	   (int gsl_multifit_linear_lcurve (gsl_vector* gsl_vector* gsl_vector* gsl_vector* gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_linear_lcorner (gsl_vector* gsl_vector* size_t*))
+	   (int gsl_multifit_linear_lcorner2 (gsl_vector* gsl_vector* size_t*))
+	   (int gsl_multifit_linear_Lk (size_t size_t gsl_matrix*))
+	   (int gsl_multifit_linear_Lsobolev (size_t size_t gsl_vector* gsl_matrix* gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_robust_maxiter (size_t gsl_multifit_robust_workspace*))
+	   (int gsl_multifit_robust_weights (gsl_vector* gsl_vector* gsl_multifit_robust_workspace*))
+	   (int gsl_multifit_robust_residuals (gsl_matrix* gsl_vector* gsl_vector* gsl_vector* gsl_multifit_robust_workspace*))
+	   (int gsl_multifit_covar_QRPT (gsl_matrix* gsl_permutation* double gsl_matrix*)))
+
+	  (#t
+	   (int gsl_multifit_linear_svd (gsl_matrix* gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_linear_bsvd (gsl_matrix* gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_linear_solve (double gsl_matrix* gsl_vector* gsl_vector* double* double* gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_linear_applyW (gsl_matrix* gsl_vector* gsl_vector* gsl_matrix* gsl_vector*))
+	   (int gsl_multifit_linear_stdform1 (gsl_vector* gsl_matrix* gsl_vector* gsl_matrix* gsl_vector* gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_linear_wstdform1 (gsl_vector* gsl_matrix* gsl_vector* gsl_vector* gsl_matrix* gsl_vector* gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_linear_stdform2 (gsl_matrix* gsl_vector* gsl_matrix* gsl_vector* gsl_matrix* gsl_vector* gsl_matrix* gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_linear_wstdform2 (gsl_matrix* gsl_vector* gsl_matrix* gsl_vector* gsl_vector* gsl_matrix* gsl_vector* gsl_matrix*
+							   gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_linear_genform1 (gsl_vector* gsl_vector* gsl_vector* gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_linear_genform2 (gsl_matrix* gsl_vector* gsl_matrix* gsl_vector* gsl_vector* gsl_matrix* gsl_vector* gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_linear_wgenform2 (gsl_matrix* gsl_vector* gsl_matrix* gsl_vector* gsl_vector* gsl_vector* gsl_matrix* gsl_vector*
+							   gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_linear_lreg (double double gsl_vector*))
+	   (int gsl_multifit_linear_lcurve (gsl_vector* gsl_vector* gsl_vector* gsl_vector* gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_linear_lcorner (gsl_vector* gsl_vector* size_t*))
+	   (int gsl_multifit_linear_lcorner2 (gsl_vector* gsl_vector* size_t*))
+	   (int gsl_multifit_linear_Lk (size_t size_t gsl_matrix*))
+	   (int gsl_multifit_linear_Lsobolev (size_t size_t gsl_vector* gsl_matrix* gsl_multifit_linear_workspace*))
+	   (int gsl_multifit_robust_maxiter (size_t gsl_multifit_robust_workspace*))
+	   (int gsl_multifit_robust_weights (gsl_vector* gsl_vector* gsl_multifit_robust_workspace*))
+	   (int gsl_multifit_robust_residuals (gsl_matrix* gsl_vector* gsl_vector* gsl_vector* gsl_multifit_robust_workspace*))
+	   (int gsl_multifit_covar_QRPT (gsl_matrix* gsl_permutation* double gsl_matrix*))
+
+	   (gsl_multilarge_linear_workspace* gsl_multilarge_linear_alloc (gsl_multilarge_linear_type* size_t))
+	   (void gsl_multilarge_linear_free (gsl_multilarge_linear_workspace*))
+	   (char* gsl_multilarge_linear_name (gsl_multilarge_linear_workspace*))
+	   (int gsl_multilarge_linear_reset (gsl_multilarge_linear_workspace*))
+	   (int gsl_multilarge_linear_accumulate (gsl_matrix* gsl_vector* gsl_multilarge_linear_workspace*))
+	   (int gsl_multilarge_linear_solve (double gsl_vector* double* double* gsl_multilarge_linear_workspace*))
+	   (int gsl_multilarge_linear_rcond (double* gsl_multilarge_linear_workspace*))
+	   (int gsl_multilarge_linear_lcurve (gsl_vector* gsl_vector* gsl_vector* gsl_multilarge_linear_workspace*))
+	   (int gsl_multilarge_linear_wstdform1 (gsl_vector* gsl_matrix* gsl_vector* gsl_vector* gsl_matrix* gsl_vector* gsl_multilarge_linear_workspace*))
+	   (int gsl_multilarge_linear_stdform1 (gsl_vector* gsl_matrix* gsl_vector* gsl_matrix* gsl_vector* gsl_multilarge_linear_workspace*))
+	   (int gsl_multilarge_linear_L_decomp (gsl_matrix* gsl_vector*))
+	   (int gsl_multilarge_linear_wstdform2 (gsl_matrix* gsl_vector* gsl_matrix* gsl_vector* gsl_vector* gsl_matrix*  gsl_vector* gsl_multilarge_linear_workspace*))
+	   (int gsl_multilarge_linear_stdform2 (gsl_matrix* gsl_vector* gsl_matrix* gsl_vector* gsl_matrix* gsl_vector* gsl_multilarge_linear_workspace*))
+	   (int gsl_multilarge_linear_genform1 (gsl_vector* gsl_vector* gsl_vector* gsl_multilarge_linear_workspace*))
+	   (int gsl_multilarge_linear_genform2 (gsl_matrix* gsl_vector* gsl_vector* gsl_vector* gsl_multilarge_linear_workspace*))))
+
+	 (gsl_multimin_fminimizer* gsl_multimin_fminimizer_alloc (gsl_multimin_fminimizer_type* size_t))
+	 (void gsl_multimin_fminimizer_free (gsl_multimin_fminimizer*))
+	 (char* gsl_multimin_fminimizer_name (gsl_multimin_fminimizer*))
+	 (int gsl_multimin_fminimizer_iterate (gsl_multimin_fminimizer*))
+	 (gsl_vector* gsl_multimin_fminimizer_x (gsl_multimin_fminimizer*))
+	 (double gsl_multimin_fminimizer_minimum (gsl_multimin_fminimizer*))
+	 (double gsl_multimin_fminimizer_size (gsl_multimin_fminimizer*))
+	 (int gsl_multimin_test_gradient (gsl_vector* double))
+	 (int gsl_multimin_test_size (double double))
+
+	 ;; multimin_function is double f(gsl_vector* void*) -- so we can handle it (but not the fdf brand)
+	 (in-C "
+                static s7_scheme *gsl_mmf_s7;
+                static gsl_multimin_function gsl_mmf;
+                static double gsl_mmf_caller(const gsl_vector *x, void *p)
+                {
+                  return(s7_real(s7_call(gsl_mmf_s7, (s7_pointer)p,
+                                         s7_cons(gsl_mmf_s7,
+                                                 s7_make_c_pointer_with_type(gsl_mmf_s7, (void *)x, s7_make_symbol(gsl_mmf_s7, \"gsl_vector*\"), s7_f(gsl_mmf_s7)),
+                                                 s7_nil(gsl_mmf_s7)))));
+                }
+                #define make_gsl_mm_function(Args, Size) do {gsl_mmf.f = gsl_mmf_caller; gsl_mmf.n = Size; gsl_mmf.params = (void *)Args; gsl_mmf_s7 = sc;} while (0)
+                static s7_pointer g_gsl_multimin_fminimizer_set(s7_scheme *sc, s7_pointer args)
+                {
+                  make_gsl_mm_function(s7_cadr(args), ((gsl_vector *)s7_c_pointer_with_type(sc, s7_caddr(args), gsl_vector__symbol, __func__, 3))->size);
+                  return(s7_make_integer(sc, gsl_multimin_fminimizer_set((gsl_multimin_fminimizer *)s7_c_pointer_with_type(sc, s7_car(args), gsl_multimin_fminimizer__symbol, __func__, 1),
+                                                &gsl_mmf, (gsl_vector *)s7_c_pointer_with_type(sc, s7_caddr(args), gsl_vector__symbol, __func__, 3),
+                                                          (gsl_vector *)s7_c_pointer_with_type(sc, s7_cadddr(args), gsl_vector__symbol, __func__, 4))));
+                }
+                static s7_pointer g_gsl_multimin_diff(s7_scheme *sc, s7_pointer args)
+                {
+                  make_gsl_mm_function(s7_caddr(args), ((gsl_vector *)s7_c_pointer_with_type(sc, s7_car(args), gsl_vector__symbol, __func__, 1))->size);
+                  return(s7_make_integer(sc, gsl_multimin_diff(&gsl_mmf, (gsl_vector *)s7_c_pointer_with_type(sc, s7_cadr(args), gsl_vector__symbol, __func__, 2), (gsl_vector *)s7_c_pointer_with_type(sc, s7_caddr(args), gsl_vector__symbol, __func__, 3))));
+                }
+                static s7_pointer g_gsl_multimin_fminimizer_fval(s7_scheme *sc, s7_pointer args)
+                {return(s7_make_real(sc, ((gsl_multimin_fminimizer *)s7_c_pointer_with_type(sc, s7_car(args), gsl_multimin_fminimizer__symbol, __func__, 1))->fval));}
+               ")
+	 (C-function ("gsl_multimin_fminimizer_set" g_gsl_multimin_fminimizer_set "" 4))
+	 (C-function ("gsl_multimin_diff" g_gsl_multimin_diff "" 3))
+	 (C-function ("gsl_multimin_fminimizer_fval" g_gsl_multimin_fminimizer_fval "" 1))
+
+
+	 ;; int f(const gsl_vector* void* gsl_vector*) so the function is doable
+	 (in-C "
+                static s7_scheme *gsl_rf_s7;
+                static gsl_multiroot_function gsl_rf;
+                static int gsl_rf_caller(const gsl_vector *x, void *p, gsl_vector *y)
+                {
+                  return(s7_integer(s7_call(gsl_rf_s7, (s7_pointer)p,
+                          s7_cons(gsl_rf_s7, s7_make_c_pointer_with_type(gsl_rf_s7, (void *)x, s7_make_symbol(gsl_rf_s7, \"gsl_vector*\"), s7_f(gsl_rf_s7)),
+                             s7_cons(gsl_rf_s7, s7_make_c_pointer_with_type(gsl_rf_s7, (void *)y, s7_make_symbol(gsl_rf_s7, \"gsl_vector*\"), s7_f(gsl_rf_s7)),
+                                     s7_nil(gsl_rf_s7))))));
+                }
+                #define make_gsl_rf_function(Args, Size) do {gsl_rf.f = gsl_rf_caller; gsl_rf.n = Size; gsl_rf.params = (void *)Args; gsl_rf_s7 = sc;} while (0)
+                static s7_pointer g_gsl_multiroot_fsolver_set(s7_scheme *sc, s7_pointer args)
+                {
+                  make_gsl_rf_function(s7_cadr(args),
+                                       ((gsl_vector *)s7_c_pointer_with_type(sc, s7_caddr(args), gsl_vector__symbol, __func__, 1))->size);
+                  return(s7_make_integer(sc, gsl_multiroot_fsolver_set(
+                                                (gsl_multiroot_fsolver *)s7_c_pointer_with_type(sc, s7_car(args), gsl_multiroot_fsolver__symbol, __func__, 2),
+                                                &gsl_rf,
+                                                (const gsl_vector *)s7_c_pointer_with_type(sc, s7_caddr(args), gsl_vector__symbol, __func__, 3))));
+                }
+                static s7_pointer g_gsl_multiroot_fdjacobian(s7_scheme *sc, s7_pointer args)
+                {
+                  make_gsl_rf_function(s7_car(args),
+                                       ((gsl_vector *)s7_c_pointer_with_type(sc, s7_cadr(args), gsl_vector__symbol, __func__, 2))->size);
+                  return(s7_make_integer(sc, gsl_multiroot_fdjacobian(
+                                                &gsl_rf,
+                                                (gsl_vector *)s7_c_pointer_with_type(sc, s7_cadr(args), gsl_vector__symbol, __func__, 2),
+                                                (gsl_vector *)s7_c_pointer_with_type(sc, s7_caddr(args), gsl_vector__symbol, __func__, 3),
+                                                s7_real(s7_cadddr(args)),
+                                                (gsl_matrix *)s7_list_ref(sc, args, 5))));
+                }")
+	 (C-function ("gsl_multiroot_fsolver_set" g_gsl_multiroot_fsolver_set "" 3))
+	 (C-function ("gsl_multiroot_fdjacobian" g_gsl_multiroot_fdjacobian "" 5))
+	 (gsl_multiroot_fsolver* gsl_multiroot_fsolver_alloc (gsl_multiroot_fsolver_type* size_t) )
+	 (void gsl_multiroot_fsolver_free (gsl_multiroot_fsolver*))
+	 (int gsl_multiroot_fsolver_iterate (gsl_multiroot_fsolver*))
+	 (char* gsl_multiroot_fsolver_name (gsl_multiroot_fsolver*))
+	 (gsl_vector* gsl_multiroot_fsolver_root (gsl_multiroot_fsolver*))
+	 (gsl_vector* gsl_multiroot_fsolver_dx (gsl_multiroot_fsolver*))
+	 (gsl_vector* gsl_multiroot_fsolver_f (gsl_multiroot_fsolver*))
+	 (int gsl_multiroot_test_delta (gsl_vector* gsl_vector* double double))
+	 (int gsl_multiroot_test_residual (gsl_vector* double))
+
+	 (gsl_multiset* gsl_multiset_alloc (size_t size_t))
+	 (gsl_multiset* gsl_multiset_calloc (size_t size_t))
+	 (void gsl_multiset_init_first (gsl_multiset*))
+	 (void gsl_multiset_init_last (gsl_multiset*))
+	 (void gsl_multiset_free (gsl_multiset*))
+	 (int gsl_multiset_memcpy (gsl_multiset* gsl_multiset*))
+	 (int gsl_multiset_fread (FILE* gsl_multiset*))
+	 (int gsl_multiset_fwrite (FILE* gsl_multiset*))
+	 (int gsl_multiset_fscanf (FILE* gsl_multiset*))
+	 (int gsl_multiset_fprintf (FILE* gsl_multiset* char*))
+	 (size_t gsl_multiset_n (gsl_multiset*))
+	 (size_t gsl_multiset_k (gsl_multiset*))
+	 (size_t* gsl_multiset_data (gsl_multiset*))
+	 (int gsl_multiset_valid (gsl_multiset*))
+	 (int gsl_multiset_next (gsl_multiset*))
+	 (int gsl_multiset_prev (gsl_multiset*))
+	 (size_t gsl_multiset_get (gsl_multiset* size_t))
+
+	 ;; the ode functions all pass bare double* arrays to the called function.
+	 (gsl_permutation* gsl_permutation_alloc (size_t))
+	 (gsl_permutation* gsl_permutation_calloc (size_t))
+	 (void gsl_permutation_init (gsl_permutation*))
+	 (void gsl_permutation_free (gsl_permutation*))
+	 (int gsl_permutation_memcpy (gsl_permutation* gsl_permutation*))
+	 (int gsl_permutation_fread (FILE* gsl_permutation*))
+	 (int gsl_permutation_fwrite (FILE* gsl_permutation*))
+	 (int gsl_permutation_fscanf (FILE* gsl_permutation*))
+	 (int gsl_permutation_fprintf (FILE* gsl_permutation* char*))
+	 (size_t gsl_permutation_size (gsl_permutation*))
+	 (size_t* gsl_permutation_data (gsl_permutation*))
+	 (int gsl_permutation_swap (gsl_permutation* size_t size_t))
+	 (int gsl_permutation_valid (gsl_permutation*))
+	 (void gsl_permutation_reverse (gsl_permutation*))
+	 (int gsl_permutation_inverse (gsl_permutation* gsl_permutation*))
+	 (int gsl_permutation_next (gsl_permutation*))
+	 (int gsl_permutation_prev (gsl_permutation*))
+	 (int gsl_permutation_mul (gsl_permutation* gsl_permutation* gsl_permutation*))
+	 (int gsl_permutation_linear_to_canonical (gsl_permutation* gsl_permutation*))
+	 (int gsl_permutation_canonical_to_linear (gsl_permutation* gsl_permutation*))
+	 (size_t gsl_permutation_inversions (gsl_permutation*))
+	 (size_t gsl_permutation_linear_cycles (gsl_permutation*))
+	 (size_t gsl_permutation_canonical_cycles (gsl_permutation*))
+	 (size_t gsl_permutation_get (gsl_permutation* size_t))
+	 (int gsl_permute_complex (size_t* double* size_t size_t))
+	 (int gsl_permute_complex_inverse (size_t* double* size_t size_t))
+	 (int gsl_permute (size_t* double* size_t size_t))
+	 (int gsl_permute_inverse (size_t* double* size_t size_t))
+	 (int gsl_permute_vector_complex (gsl_permutation* gsl_vector_complex*))
+	 (int gsl_permute_vector_complex_inverse (gsl_permutation* gsl_vector_complex*))
+	 (int gsl_permute_vector (gsl_permutation* gsl_vector*))
+	 (int gsl_permute_vector_inverse (gsl_permutation* gsl_vector*))
+
+	 (gsl_root_fsolver* gsl_root_fsolver_alloc (gsl_root_fsolver_type*))
+	 (void gsl_root_fsolver_free (gsl_root_fsolver*))
+	 (int gsl_root_fsolver_set (gsl_root_fsolver* gsl_function* double double))
+	 (int gsl_root_fsolver_iterate (gsl_root_fsolver*))
+	 (char* gsl_root_fsolver_name (gsl_root_fsolver*))
+	 (double gsl_root_fsolver_root (gsl_root_fsolver*))
+	 (double gsl_root_fsolver_x_lower (gsl_root_fsolver*))
+	 (double gsl_root_fsolver_x_upper (gsl_root_fsolver*))
+	 (int gsl_root_test_interval (double double double double))
+	 (int gsl_root_test_residual (double double))
+	 (int gsl_root_test_delta (double double double double))
+
+	 (gsl_sum_levin_u_workspace* gsl_sum_levin_u_alloc (size_t))
+	 (void gsl_sum_levin_u_free (gsl_sum_levin_u_workspace*))
+	 (int gsl_sum_levin_u_accel (double* size_t gsl_sum_levin_u_workspace* double* double*))
+	 (int gsl_sum_levin_u_minmax (double* size_t size_t size_t gsl_sum_levin_u_workspace* double* double*))
+	 (int gsl_sum_levin_u_step (double size_t size_t gsl_sum_levin_u_workspace* double*))
+	 (gsl_sum_levin_utrunc_workspace* gsl_sum_levin_utrunc_alloc (size_t))
+	 (void gsl_sum_levin_utrunc_free (gsl_sum_levin_utrunc_workspace*))
+	 (int gsl_sum_levin_utrunc_accel (double* size_t gsl_sum_levin_utrunc_workspace* double* double*))
+	 (int gsl_sum_levin_utrunc_minmax (double* size_t size_t size_t gsl_sum_levin_utrunc_workspace* double* double*))
+	 (int gsl_sum_levin_utrunc_step (double size_t gsl_sum_levin_utrunc_workspace* double*))
+
+	 (gsl_wavelet* gsl_wavelet_alloc (gsl_wavelet_type* size_t))
+	 (void gsl_wavelet_free (gsl_wavelet*))
+	 (char* gsl_wavelet_name (gsl_wavelet*))
+	 (gsl_wavelet_workspace* gsl_wavelet_workspace_alloc (size_t))
+	 (void gsl_wavelet_workspace_free (gsl_wavelet_workspace*))
+	 (int gsl_wavelet_transform (gsl_wavelet* double* size_t size_t (gsl_wavelet_direction int) gsl_wavelet_workspace*))
+	 (int gsl_wavelet_transform_forward (gsl_wavelet* double* size_t size_t gsl_wavelet_workspace*))
+	 (int gsl_wavelet_transform_inverse (gsl_wavelet* double* size_t size_t gsl_wavelet_workspace*))
+	 (int gsl_wavelet2d_transform (gsl_wavelet* double* size_t size_t size_t (gsl_wavelet_direction int) gsl_wavelet_workspace*))
+	 (int gsl_wavelet2d_transform_forward (gsl_wavelet* double* size_t size_t size_t gsl_wavelet_workspace*))
+	 (int gsl_wavelet2d_transform_inverse (gsl_wavelet* double* size_t size_t size_t gsl_wavelet_workspace*))
+	 (int gsl_wavelet2d_nstransform (gsl_wavelet* double* size_t size_t size_t (gsl_wavelet_direction int) gsl_wavelet_workspace*))
+	 (int gsl_wavelet2d_nstransform_forward (gsl_wavelet* double* size_t size_t size_t gsl_wavelet_workspace*))
+	 (int gsl_wavelet2d_nstransform_inverse (gsl_wavelet* double* size_t size_t size_t gsl_wavelet_workspace*))
+	 (int gsl_wavelet2d_transform_matrix (gsl_wavelet* gsl_matrix* (gsl_wavelet_direction int) gsl_wavelet_workspace*))
+	 (int gsl_wavelet2d_transform_matrix_forward (gsl_wavelet* gsl_matrix* gsl_wavelet_workspace*))
+	 (int gsl_wavelet2d_transform_matrix_inverse (gsl_wavelet* gsl_matrix* gsl_wavelet_workspace*))
+	 (int gsl_wavelet2d_nstransform_matrix (gsl_wavelet* gsl_matrix* (gsl_wavelet_direction int) gsl_wavelet_workspace*))
+	 (int gsl_wavelet2d_nstransform_matrix_forward (gsl_wavelet* gsl_matrix* gsl_wavelet_workspace*))
+	 (int gsl_wavelet2d_nstransform_matrix_inverse (gsl_wavelet* gsl_matrix* gsl_wavelet_workspace*))
+
+	 (reader-cond ((>= gsl-version 2.0)
+		       ;; rstat
+		       (gsl_rstat_quantile_workspace* gsl_rstat_quantile_alloc (double))
+		       (void gsl_rstat_quantile_free (gsl_rstat_quantile_workspace*))
+		       (int gsl_rstat_quantile_add (double gsl_rstat_quantile_workspace*))
+		       (double gsl_rstat_quantile_get (gsl_rstat_quantile_workspace*))
+		       (gsl_rstat_workspace* gsl_rstat_alloc (void))
+		       (void gsl_rstat_free (gsl_rstat_workspace*))
+		       (size_t gsl_rstat_n (gsl_rstat_workspace*))
+		       (int gsl_rstat_add (double gsl_rstat_workspace*))
+		       (double gsl_rstat_min (gsl_rstat_workspace*))
+		       (double gsl_rstat_max (gsl_rstat_workspace*))
+		       (double gsl_rstat_mean (gsl_rstat_workspace*))
+		       (double gsl_rstat_variance (gsl_rstat_workspace*))
+		       (double gsl_rstat_sd (gsl_rstat_workspace*))
+		       (double gsl_rstat_sd_mean (gsl_rstat_workspace*))
+		       (double gsl_rstat_median (gsl_rstat_workspace*))
+		       (double gsl_rstat_skew (gsl_rstat_workspace*))
+		       (double gsl_rstat_kurtosis (gsl_rstat_workspace*))
+		       (int gsl_rstat_reset (gsl_rstat_workspace*))
+
+		       ;; spblas
+		       (int gsl_spblas_dgemv ((CBLAS_TRANSPOSE_t int) double gsl_spmatrix* gsl_vector* double gsl_vector*))
+		       (int gsl_spblas_dgemm (double gsl_spmatrix* gsl_spmatrix* gsl_spmatrix*))
+		       ;(size_t gsl_spblas_scatter (gsl_spmatrix* size_t double size_t* double* int gsl_spmatrix* size_t))
+
+		       ;; splinalg
+		       (gsl_splinalg_itersolve_type* gsl_splinalg_itersolve_gmres)
+
+		       (gsl_splinalg_itersolve* gsl_splinalg_itersolve_alloc (gsl_splinalg_itersolve_type* size_t size_t))
+		       (void gsl_splinalg_itersolve_free (gsl_splinalg_itersolve*))
+		       (char* gsl_splinalg_itersolve_name (gsl_splinalg_itersolve*))
+		       (int gsl_splinalg_itersolve_iterate (gsl_spmatrix* gsl_vector* double gsl_vector* gsl_splinalg_itersolve*))
+		       (double gsl_splinalg_itersolve_normr (gsl_splinalg_itersolve*))
+
+		       ;; spmatrix
+		       (C-macro (int (GSL_SPMATRIX_TRIPLET GSL_SPMATRIX_CCS)))
+		       ;; #define GSL_SPMATRIX_ISTRIPLET (m)  ((m)->sptype == GSL_SPMATRIX_TRIPLET)
+		       ;; #define GSL_SPMATRIX_ISCCS (m)  ((m)->sptype == GSL_SPMATRIX_CCS)
+
+		       (gsl_spmatrix* gsl_spmatrix_alloc (size_t size_t))
+		       (gsl_spmatrix* gsl_spmatrix_alloc_nzmax (size_t size_t size_t size_t))
+		       (void gsl_spmatrix_free (gsl_spmatrix*))
+		       (int gsl_spmatrix_realloc (size_t gsl_spmatrix*))
+		       (int gsl_spmatrix_set_zero (gsl_spmatrix*))
+		       (size_t gsl_spmatrix_nnz (gsl_spmatrix*))
+		       ;(int gsl_spmatrix_compare_idx (size_t size_t size_t size_t))
+		       (int gsl_spmatrix_memcpy (gsl_spmatrix* gsl_spmatrix*))
+		       (double gsl_spmatrix_get (gsl_spmatrix* size_t size_t))
+		       (int gsl_spmatrix_set (gsl_spmatrix* size_t size_t double))
+		       (gsl_spmatrix* gsl_spmatrix_compcol (gsl_spmatrix*))
+		       ;(void gsl_spmatrix_cumsum (size_t size_t*))
+		       (int gsl_spmatrix_scale (gsl_spmatrix* double))
+		       (int gsl_spmatrix_minmax (gsl_spmatrix* double* double*))
+		       (int gsl_spmatrix_add (gsl_spmatrix* gsl_spmatrix* gsl_spmatrix*))
+		       (int gsl_spmatrix_d2sp (gsl_spmatrix* gsl_matrix*))
+		       (int gsl_spmatrix_sp2d (gsl_matrix* gsl_spmatrix*))
+		       (int gsl_spmatrix_equal (gsl_spmatrix* gsl_spmatrix*))
+		       (int gsl_spmatrix_transpose_memcpy (gsl_spmatrix* gsl_spmatrix*))
+
+		       ;; interp2d
+		       (gsl_interp2d_type* (gsl_interp2d_bilinear gsl_interp2d_bicubic))
+
+		       (gsl_interp2d* gsl_interp2d_alloc (gsl_interp2d_type* size_t size_t))
+		       (char* gsl_interp2d_name (gsl_interp2d*))
+		       (size_t gsl_interp2d_min_size (gsl_interp2d*))
+		       (size_t gsl_interp2d_type_min_size (gsl_interp2d_type*))
+		       (int gsl_interp2d_set (gsl_interp2d* double* size_t size_t double))
+		       (double gsl_interp2d_get (gsl_interp2d* double* size_t size_t))
+		       (size_t gsl_interp2d_idx (gsl_interp2d* size_t size_t))
+		       (int gsl_interp2d_init (gsl_interp2d* double* double* double* size_t size_t))
+		       (void gsl_interp2d_free (gsl_interp2d*))
+		       (double gsl_interp2d_eval (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel*))
+		       (double gsl_interp2d_eval_extrap (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel*))
+		       (int gsl_interp2d_eval_e (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel* double*))
+		       ;2.6 (int gsl_interp2d_eval_e_extrap (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel* double*))
+		       (reader-cond ((>= gsl-version 2.6)
+				     (int gsl_interp2d_eval_extrap_e (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel* double*))))
+		       (double gsl_interp2d_eval_deriv_x (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel*))
+		       (int gsl_interp2d_eval_deriv_x_e (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel* double*))
+		       (double gsl_interp2d_eval_deriv_y (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel*))
+		       (int gsl_interp2d_eval_deriv_y_e (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel* double*))
+		       (double gsl_interp2d_eval_deriv_xx (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel*))
+		       (int gsl_interp2d_eval_deriv_xx_e (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel* double*))
+		       (double gsl_interp2d_eval_deriv_yy (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel*))
+		       (int gsl_interp2d_eval_deriv_yy_e (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel* double*))
+		       (double gsl_interp2d_eval_deriv_xy (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel*))
+		       (int gsl_interp2d_eval_deriv_xy_e (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel* double*))
+
+		       ;; spline2n
+		       (gsl_spline2d* gsl_spline2d_alloc (gsl_interp2d_type* size_t size_t))
+		       (int gsl_spline2d_init (gsl_spline2d* double* double* double* size_t size_t))
+		       (void gsl_spline2d_free (gsl_spline2d*))
+		       (double gsl_spline2d_eval (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel*))
+		       (int gsl_spline2d_eval_e (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel* double*))
+		       (double gsl_spline2d_eval_deriv_x (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel*))
+		       (int gsl_spline2d_eval_deriv_x_e (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel* double*))
+		       (double gsl_spline2d_eval_deriv_y (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel*))
+		       (int gsl_spline2d_eval_deriv_y_e (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel* double*))
+		       (double gsl_spline2d_eval_deriv_xx (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel*))
+		       (int gsl_spline2d_eval_deriv_xx_e (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel* double*))
+		       (double gsl_spline2d_eval_deriv_yy (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel*))
+		       (int gsl_spline2d_eval_deriv_yy_e (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel* double*))
+		       (double gsl_spline2d_eval_deriv_xy (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel*))
+		       (int gsl_spline2d_eval_deriv_xy_e (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel* double*))
+		       (size_t gsl_spline2d_min_size (gsl_spline2d*))
+		       (char* gsl_spline2d_name (gsl_spline2d*))
+		       (int gsl_spline2d_set (gsl_spline2d* double* size_t size_t double))
+		       (double gsl_spline2d_get (gsl_spline2d* double* size_t size_t))
+		       ))
+
+	 (reader-cond ((>= gsl-version 2.7)
+		       (double gsl_vector_sum (gsl_vector*))
+		       (double gsl_matrix_norm1 (gsl_matrix*))
+		       (int gsl_matrix_scale_rows (gsl_matrix* gsl_vector*))
+		       (int gsl_matrix_scale_columns (gsl_matrix* gsl_vector*))
+		       (int gsl_spmatrix_dense_add (gsl_matrix* gsl_spmatrix*))
+		       (int gsl_spmatrix_dense_sub (gsl_matrix* gsl_spmatrix*))
+		       (double gsl_spmatrix_norm1 (gsl_spmatrix*))
+		       (int gsl_linalg_QL_decomp (gsl_matrix* gsl_vector*))
+		       (int gsl_linalg_QL_unpack (gsl_matrix* gsl_vector* gsl_matrix* gsl_matrix*))
+		       (int gsl_linalg_complex_QR_decomp (gsl_matrix_complex* gsl_vector_complex*))
+		       (int gsl_linalg_complex_QR_decomp_r (gsl_matrix_complex* gsl_matrix_complex*))
+		       (int gsl_linalg_complex_QR_solve (gsl_matrix_complex* gsl_vector_complex* gsl_vector_complex* gsl_vector_complex*))
+		       (int gsl_linalg_complex_QR_solve_r (gsl_matrix_complex* gsl_matrix_complex* gsl_vector_complex* gsl_vector_complex*))
+		       (int gsl_linalg_complex_QR_svx (gsl_matrix_complex* gsl_vector_complex* gsl_vector_complex*))
+		       (int gsl_linalg_complex_QR_lssolve (gsl_matrix_complex* gsl_vector_complex* gsl_vector_complex* gsl_vector_complex* gsl_vector_complex*))
+		       (int gsl_linalg_complex_QR_lssolve_r (gsl_matrix_complex* gsl_matrix_complex* gsl_vector_complex* gsl_vector_complex* gsl_vector_complex*))
+		       (int gsl_linalg_complex_QR_QHvec (gsl_matrix_complex* gsl_vector_complex* gsl_vector_complex*))
+		       (int gsl_linalg_complex_QR_QHvec_r(gsl_matrix_complex* gsl_matrix_complex* gsl_vector_complex* gsl_vector_complex*))
+		       (int gsl_linalg_complex_QR_Qvec (gsl_matrix_complex* gsl_vector_complex* gsl_vector_complex*))
+		       (int gsl_linalg_complex_QR_unpack (gsl_matrix_complex* gsl_vector_complex* gsl_matrix_complex* gsl_matrix_complex*))
+		       (int gsl_linalg_complex_QR_unpack_r(gsl_matrix_complex* gsl_matrix_complex* gsl_matrix_complex* gsl_matrix_complex*))
+		       (int gsl_linalg_cholesky_band_decomp(gsl_matrix*))
+		       (int gsl_linalg_cholesky_band_solve (gsl_matrix* gsl_vector* gsl_vector*))
+		       (int gsl_linalg_cholesky_band_svx (gsl_matrix* gsl_vector*))
+		       (int gsl_linalg_cholesky_band_solvem (gsl_matrix* gsl_matrix* gsl_matrix*))
+		       (int gsl_linalg_cholesky_band_svxm (gsl_matrix* gsl_matrix*))
+		       (int gsl_linalg_cholesky_band_invert (gsl_matrix* gsl_matrix*))
+		       (int gsl_linalg_cholesky_band_unpack (gsl_matrix* gsl_matrix*))
+		       (int gsl_linalg_cholesky_band_scale(gsl_matrix* gsl_vector*))
+		       (int gsl_linalg_cholesky_band_scale_apply(gsl_matrix* gsl_vector*))
+		       (int gsl_linalg_cholesky_band_rcond (gsl_matrix* double* gsl_vector*))
+		       ))
+
+	 ;; some 2.8 functions
+	 ;;    (gsl_matrix_complex_conjugate (gsl_matrix_complex*))
+	 ;;    (int gsl_linalg_QR_lssolvem_r (gsl_matrix* gsl_matrix* gsl_matrix* gsl_matrix* gsl_matrix*))
+	 ;;    (int gsl_linalg_complex_QR_QHmat_r(gsl_matrix_complex* gsl_matrix_complex* gsl_matrix_complex* gsl_matrix_complex*))
+	 ;;    (int gsl_linalg_complex_QR_lssolvem_r (gsl_matrix_complex* gsl_matrix_complex* gsl_matrix_complex* gsl_matrix_complex* gsl_matrix_complex*))
+	 ;;    (int gsl_linalg_complex_cholesky_scale(gsl_matrix_complex* gsl_vector*))
+	 ;;    (int gsl_linalg_complex_cholesky_scale_apply(gsl_matrix_complex* gsl_vector*))
+	 ;;    (int gsl_linalg_complex_cholesky_decomp2(gsl_matrix_complex* gsl_vector*))
+	 ;;    (int gsl_linalg_complex_cholesky_svx2 (gsl_matrix_complex* gsl_vector* gsl_vector_complex*))
+	 ;;    (int gsl_linalg_complex_cholesky_solve2 (gsl_matrix_complex* gsl_vector* gsl_vector_complex* gsl_vector_complex*))
+	 ;;    (int gsl_linalg_cholesky_decomp2(gsl_matrix* gsl_vector*))
+	 ;;    (int gsl_linalg_cholesky_svx2 (gsl_matrix* gsl_vector* gsl_vector*))
+	 ;;    (int gsl_linalg_cholesky_solve2 (gsl_matrix* gsl_vector* gsl_vector* gsl_vector*))
+
+	 )
+       "" (list "gsl/gsl_blas.h"
+		"gsl/gsl_blas_types.h"
+		"gsl/gsl_block.h"
+		"gsl/gsl_block_complex_double.h"
+		"gsl/gsl_block_double.h"
+		"gsl/gsl_bspline.h"
+		"gsl/gsl_cblas.h"
+		"gsl/gsl_cdf.h"
+		"gsl/gsl_chebyshev.h"
+		"gsl/gsl_check_range.h"
+		"gsl/gsl_combination.h"
+		"gsl/gsl_complex.h"
+		"gsl/gsl_complex_math.h"
+		"gsl/gsl_const.h"
+		"gsl/gsl_const_cgs.h"
+		"gsl/gsl_const_cgsm.h"
+		"gsl/gsl_const_mks.h"
+		"gsl/gsl_const_mksa.h"
+		"gsl/gsl_const_num.h"
+		"gsl/gsl_deriv.h"
+		"gsl/gsl_dft_complex.h"
+		"gsl/gsl_dht.h"
+		"gsl/gsl_diff.h"
+		"gsl/gsl_eigen.h"
+		"gsl/gsl_errno.h"
+		"gsl/gsl_fft.h"
+		"gsl/gsl_fft_complex.h"
+		"gsl/gsl_fft_real.h"
+		(reader-cond ((>= gsl-version 2.5)
+			      "gsl/gsl_filter.h"
+			      "gsl/gsl_movstat.h"))
+		"gsl/gsl_fit.h"
+		"gsl/gsl_heapsort.h"
+		"gsl/gsl_histogram.h"
+		"gsl/gsl_histogram2d.h"
+		"gsl/gsl_ieee_utils.h"
+		"gsl/gsl_inline.h"
+		"gsl/gsl_integration.h"
+		"gsl/gsl_interp.h"
+		(reader-cond ((>= gsl-version 2.0)
+			      "gsl/gsl_interp2d.h"))
+		"gsl/gsl_linalg.h"
+		"gsl/gsl_machine.h"
+		"gsl/gsl_math.h"
+		"gsl/gsl_matrix.h"
+		"gsl/gsl_matrix_complex_double.h"
+		"gsl/gsl_matrix_double.h"
+		"gsl/gsl_message.h"
+		"gsl/gsl_min.h"
+		"gsl/gsl_minmax.h"
+		"gsl/gsl_mode.h"
+		"gsl/gsl_multifit.h"
+		"gsl/gsl_multifit_nlin.h"
+		(reader-cond ((>= gsl-version 2.1)
+			      "gsl/gsl_multilarge.h"))
+		"gsl/gsl_multimin.h"
+		"gsl/gsl_multiroots.h"
+		"gsl/gsl_multiset.h"
+		"gsl/gsl_nan.h"
+		"gsl/gsl_permutation.h"
+		"gsl/gsl_permute.h"
+		"gsl/gsl_permute_complex_double.h"
+		"gsl/gsl_permute_double.h"
+		"gsl/gsl_permute_vector.h"
+		"gsl/gsl_permute_vector_complex_double.h"
+		"gsl/gsl_permute_vector_double.h"
+		"gsl/gsl_poly.h"
+		"gsl/gsl_pow_int.h"
+		"gsl/gsl_precision.h"
+		"gsl/gsl_qrng.h"
+		"gsl/gsl_randist.h"
+		"gsl/gsl_rng.h"
+		"gsl/gsl_roots.h"
+		(reader-cond ((>= gsl-version 2.0)
+			      "gsl/gsl_rstat.h"))
+		"gsl/gsl_sf.h"
+		"gsl/gsl_sf_airy.h"
+		"gsl/gsl_sf_bessel.h"
+		"gsl/gsl_sf_clausen.h"
+		"gsl/gsl_sf_coulomb.h"
+		"gsl/gsl_sf_coupling.h"
+		"gsl/gsl_sf_dawson.h"
+		"gsl/gsl_sf_debye.h"
+		"gsl/gsl_sf_dilog.h"
+		"gsl/gsl_sf_elementary.h"
+		"gsl/gsl_sf_ellint.h"
+		"gsl/gsl_sf_elljac.h"
+		"gsl/gsl_sf_erf.h"
+		"gsl/gsl_sf_exp.h"
+		"gsl/gsl_sf_expint.h"
+		"gsl/gsl_sf_fermi_dirac.h"
+		"gsl/gsl_sf_gamma.h"
+		"gsl/gsl_sf_gegenbauer.h"
+		"gsl/gsl_sf_hyperg.h"
+		"gsl/gsl_sf_laguerre.h"
+		"gsl/gsl_sf_lambert.h"
+		"gsl/gsl_sf_legendre.h"
+		"gsl/gsl_sf_log.h"
+		"gsl/gsl_sf_mathieu.h"
+		"gsl/gsl_sf_pow_int.h"
+		"gsl/gsl_sf_psi.h"
+		"gsl/gsl_sf_result.h"
+		(reader-cond ((>= gsl-version 2.0)
+			      "gsl/gsl_spblas.h"
+			      "gsl/gsl_splinalg.h"
+			      "gsl/gsl_spline2d.h"
+			      "gsl/gsl_spmatrix.h"))
+		"gsl/gsl_sf_synchrotron.h"
+		"gsl/gsl_sf_transport.h"
+		"gsl/gsl_sf_trig.h"
+		"gsl/gsl_sf_zeta.h"
+		"gsl/gsl_siman.h"
+		"gsl/gsl_sort.h"
+		"gsl/gsl_sort_double.h"
+		"gsl/gsl_sort_vector.h"
+		"gsl/gsl_sort_vector_double.h"
+		"gsl/gsl_specfunc.h"
+		"gsl/gsl_spline.h"
+		"gsl/gsl_statistics.h"
+		"gsl/gsl_statistics_double.h"
+		"gsl/gsl_sum.h"
+		"gsl/gsl_sys.h"
+		"gsl/gsl_vector.h"
+		"gsl/gsl_vector_complex.h"
+		"gsl/gsl_vector_complex_double.h"
+		"gsl/gsl_vector_double.h"
+		"gsl/gsl_version.h"
+		"gsl/gsl_wavelet.h"
+		"gsl/gsl_wavelet2d.h"
+		)
+
+       "-I/usr/local/include -g3 -DGSL_DISABLE_DEPRECATED"
+       "-L/usr/local/lib -lgsl -lgslcblas"
+       "libgsl_s7")
+					; GSL_DISABLE_DEPRECATED is needed to avoid a name collision (dating from version 1.7!!)
+      (curlet))))
+
+*libgsl*
diff --git a/s7/libm.scm b/s7/libm.scm
new file mode 100644
index 0000000..f2d9078
--- /dev/null
+++ b/s7/libm.scm
@@ -0,0 +1,156 @@
+;;; libm.scm
+;;;
+;;; tie the math library into the *libm* environment
+
+(require cload.scm)
+(provide 'libm.scm)
+
+;; if loading from a different directory, pass that info to C
+(let ((directory (let ((current-file (port-filename)))
+		   (and (memv (current-file 0) '(#\/ #\~))
+			(substring current-file 0 (- (length current-file) 9))))))
+  (when (and directory (not (member directory *load-path*)))
+    (set! *load-path* (cons directory *load-path*)))
+  (with-let (rootlet)
+    (require cload.scm))
+  (when (and directory (not (string-position directory *cload-cflags*)))
+    (set! *cload-cflags* (string-append "-I" directory " " *cload-cflags*))))
+
+
+(unless (defined? '*libm*)
+  (define *libm*
+    (with-let (sublet (unlet))
+      
+      (set! *libraries* (cons (cons "libm.scm" (curlet)) *libraries*))
+      (set! *cload-library-name* "*libm*")
+      
+      (c-define
+       '((double j0 (double) "Bessel j0") 
+	 (double j1 (double)) 
+	 (double jn (int double)) 
+	 (double erf (double)) 
+	 (double erfc (double))
+	 (double lgamma (double))
+	 
+	 (double fabs (double))
+	 (double ceil (double))
+	 (reader-cond ((not (provided? 'netbsd))
+		       (double nearbyint (double))
+		       (double scalbln (double int))
+		       (double fma (double double double))))
+	 (double rint (double))
+	 (int llrint (double))
+	 (int llround (double))
+	 (double trunc (double))
+	 (double fmod (double double))
+	 (double ldexp (double int))
+	 (double scalbn (double int))
+	 (double exp2 (double))
+	 (double expm1 (double))
+	 (double log10 (double))
+	 (double log1p (double))
+	 (double log2 (double))
+	 (int ilogb (double))
+	 (double cbrt (double))
+	 (double hypot (double double))
+	 (double pow (double double))
+	 (double fdim (double double))
+	 (double tgamma (double))
+	 (double copysign (double double))
+	 (double nan (char*))
+	 (double nextafter (double double))
+	 (double nexttoward (double double))
+	 ;; C2x: double getpayload(const double *x), int setpayload(double *x, double payload)
+	 
+	 (reader-cond ((not (provided? 'solaris)) 
+		       (int fpclassify (double))
+		       (int isfinite (double))
+		       (int isinf (double))
+		       (int isnan (double))
+		       (int isnormal (double))
+		       (int signbit (double))))
+	 
+	 ;; exporting these will overwrite the built-in versions
+	 (double floor (double))
+	 (double round (double))
+	 (double remainder (double double))
+	 (double exp (double))
+	 (double log (double))
+	 (double sqrt (double))
+	 (double cos (double))
+	 (double sin (double))
+	 (double tan (double))
+	 (double cosh (double))
+	 (double sinh (double))
+	 (double tanh (double))
+	 (double acos (double))
+	 (double asin (double))
+	 (double atan (double))
+	 (double atan2 (double double))
+	 (double acosh (double))
+	 (double asinh (double))
+	 (double atanh  (double))
+	 
+	 (int (FP_NAN FP_INFINITE FP_ZERO FP_SUBNORMAL FP_NORMAL))
+	 (double (M_E M_LOG2E M_LOG10E M_LN2 M_LN10 M_PI M_PI_2 M_PI_4 M_1_PI M_2_PI M_2_SQRTPI M_SQRT2 M_SQRT1_2))
+	 
+	 (C-macro (char* __VERSION__))
+	 (C-macro (int (__SIZEOF_LONG_LONG__ __SIZEOF_INT__ __SIZEOF_POINTER__ __SIZEOF_LONG__ __SIZEOF_LONG_DOUBLE__ __SIZEOF_SIZE_T__ 
+					     __SIZEOF_FLOAT__ __SIZEOF_SHORT__ __SIZEOF_DOUBLE__ __CHAR_BIT__ __DBL_MIN_EXP__ __DBL_MIN_10_EXP__ __LDBL_MAX_EXP__ 
+					     __DBL_DIG__ __DECIMAL_DIG__ __BIGGEST_ALIGNMENT__ __DBL_MAX_EXP__ __LONG_LONG_MAX__ __FLT_MIN_EXP__ __FLT_MANT_DIG__ 
+					     __FLT_RADIX__ __FLT_MAX_10_EXP__ __LONG_MAX__ __LDBL_MANT_DIG__ __FLT_DIG__ __INT_MAX__ __FLT_MAX_EXP__ 
+					     __DBL_MANT_DIG__ __LDBL_MIN_EXP__ __LDBL_MAX_10_EXP__ __INTMAX_MAX__ __FLT_MIN_10_EXP__ __DBL_MAX_10_EXP__ 
+					     __LDBL_MIN_10_EXP__ __LDBL_DIG__)))
+	 (C-macro (double (__FLT_MIN__ __DBL_DENORM_MIN__ __LDBL_MAX__ __FLT_EPSILON__ __LDBL_MIN__ __DBL_MAX__ __DBL_MIN__ 
+				       __LDBL_EPSILON__ __DBL_EPSILON__ __FLT_DENORM_MIN__ __FLT_MAX__ __LDBL_DENORM_MIN__)))
+	 
+	 ;; these have arg by reference, return list in s7
+	 (in-C "
+static s7_pointer g_remquo(s7_scheme *sc, s7_pointer args)
+{
+  if (s7_is_real(s7_car(args)))
+    {
+      if (s7_is_real(s7_cadr(args)))
+        {
+          int quo = 0;
+          double rem;
+          rem = remquo(s7_number_to_real_with_caller(sc, s7_car(args), __func__), s7_number_to_real_with_caller(sc, s7_cadr(args), __func__), &quo);
+          return(s7_list(sc, 2, s7_make_real(sc, rem), s7_make_integer(sc, quo)));
+        }
+      return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libm* 'remquo)\", 16), 2, s7_cadr(args), real_string));
+     }
+  return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libm* 'remquo)\", 16), 1, s7_car(args), real_string));
+}
+static s7_pointer g_frexp(s7_scheme *sc, s7_pointer args)
+{
+  if (s7_is_real(s7_car(args)))
+    {
+      int ex = 0;
+      double frac;
+      frac = frexp(s7_number_to_real_with_caller(sc, s7_car(args), __func__), &ex);
+      return(s7_list(sc, 2, s7_make_real(sc, frac), s7_make_integer(sc, ex)));
+     }
+  return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libm* 'frexp)\", 15), 0, s7_car(args), real_string));
+}
+static s7_pointer g_modf(s7_scheme *sc, s7_pointer args)
+{
+  if (s7_is_real(s7_car(args)))
+    {
+      double frac, ip = 0.0;
+      frac = modf(s7_number_to_real_with_caller(sc, s7_car(args), __func__), &ip);
+      return(s7_list(sc, 2, s7_make_real(sc, frac), s7_make_real(sc, ip)));
+     }
+  return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libm* 'modf)\", 14), 0, s7_car(args), real_string));
+}
+")
+         (C-function ("remquo" g_remquo "(remquo x y) returns a list: (remainder messed-up-quotient)" 2))
+         (C-function ("frexp" g_frexp "(frexp x) returns a list: (fraction exponent)" 1))
+         (C-function ("modf" g_modf "(modf x) returns a list: (int-part frac-part) -- this is not the same as fmod!" 1))
+	 )
+       "" "math.h" "" "" "libm_s7")
+      
+      (curlet))))
+
+*libm*
+;; the loader will return *libm*
+
diff --git a/s7/libutf8proc.scm b/s7/libutf8proc.scm
new file mode 100644
index 0000000..8fa1ed2
--- /dev/null
+++ b/s7/libutf8proc.scm
@@ -0,0 +1,209 @@
+;;; utf8proc.scm
+;;;
+;;; tie the utf8proc library into the *libutf8proc* environment
+
+(set! (*s7* 'print-length) 123123)
+
+(require cload.scm)
+(provide 'libutf8proc.scm)
+
+;; if loading from a different directory, pass that info to C
+(let ((directory (let ((current-file (port-filename)))
+		   (and (memv (current-file 0) '(#\/ #\~))
+			(substring current-file 0 (- (length current-file) 9))))))
+  (when (and directory (not (member directory *load-path*)))
+    (set! *load-path* (cons directory *load-path*)))
+  (with-let (rootlet)
+    (require cload.scm))
+  (when (and directory (not (string-position directory *cload-cflags*)))
+    (set! *cload-cflags* (string-append "-I" directory " " *cload-cflags*))))
+
+
+(if (not (defined? '*libutf8proc*))
+    (define *libutf8proc*
+      (with-let (sublet (unlet))
+	
+	(set! *libraries* (cons (cons "libutf8proc.scm" (curlet)) *libraries*))
+
+	(c-define 
+	 '((C-macro (int (UTF8PROC_VERSION_MAJOR UTF8PROC_VERSION_MINOR UTF8PROC_VERSION_PATCH)))
+
+	   (int (UTF8PROC_NULLTERM UTF8PROC_STABLE UTF8PROC_COMPAT UTF8PROC_COMPOSE UTF8PROC_DECOMPOSE
+		 UTF8PROC_IGNORE UTF8PROC_REJECTNA UTF8PROC_NLF2LS UTF8PROC_NLF2PS UTF8PROC_NLF2LF   
+		 UTF8PROC_STRIPCC UTF8PROC_CASEFOLD UTF8PROC_CHARBOUND UTF8PROC_LUMP UTF8PROC_STRIPMARK))
+
+	   (C-macro (int (UTF8PROC_ERROR_NOMEM UTF8PROC_ERROR_OVERFLOW UTF8PROC_ERROR_INVALIDUTF8 UTF8PROC_ERROR_NOTASSIGNED UTF8PROC_ERROR_INVALIDOPTS)))
+
+	   (int (UTF8PROC_CATEGORY_CN UTF8PROC_CATEGORY_LU UTF8PROC_CATEGORY_LL UTF8PROC_CATEGORY_LT UTF8PROC_CATEGORY_LM
+		 UTF8PROC_CATEGORY_LO UTF8PROC_CATEGORY_MN UTF8PROC_CATEGORY_MC UTF8PROC_CATEGORY_ME UTF8PROC_CATEGORY_ND
+                 UTF8PROC_CATEGORY_NL UTF8PROC_CATEGORY_NO UTF8PROC_CATEGORY_PC UTF8PROC_CATEGORY_PD UTF8PROC_CATEGORY_PS
+                 UTF8PROC_CATEGORY_PE UTF8PROC_CATEGORY_PI UTF8PROC_CATEGORY_PF UTF8PROC_CATEGORY_PO UTF8PROC_CATEGORY_SM
+                 UTF8PROC_CATEGORY_SC UTF8PROC_CATEGORY_SK UTF8PROC_CATEGORY_SO UTF8PROC_CATEGORY_ZS UTF8PROC_CATEGORY_ZL
+                 UTF8PROC_CATEGORY_ZP UTF8PROC_CATEGORY_CC UTF8PROC_CATEGORY_CF UTF8PROC_CATEGORY_CS UTF8PROC_CATEGORY_CO))
+
+	   (int (UTF8PROC_BIDI_CLASS_L UTF8PROC_BIDI_CLASS_LRE UTF8PROC_BIDI_CLASS_LRO UTF8PROC_BIDI_CLASS_R UTF8PROC_BIDI_CLASS_AL
+                 UTF8PROC_BIDI_CLASS_RLE UTF8PROC_BIDI_CLASS_RLO UTF8PROC_BIDI_CLASS_PDF UTF8PROC_BIDI_CLASS_EN UTF8PROC_BIDI_CLASS_ES
+                 UTF8PROC_BIDI_CLASS_ET UTF8PROC_BIDI_CLASS_AN UTF8PROC_BIDI_CLASS_CS UTF8PROC_BIDI_CLASS_NSM UTF8PROC_BIDI_CLASS_BN
+                 UTF8PROC_BIDI_CLASS_B UTF8PROC_BIDI_CLASS_S UTF8PROC_BIDI_CLASS_WS UTF8PROC_BIDI_CLASS_ON UTF8PROC_BIDI_CLASS_LRI
+                 UTF8PROC_BIDI_CLASS_RLI UTF8PROC_BIDI_CLASS_FSI UTF8PROC_BIDI_CLASS_PDI))
+
+	   (int (UTF8PROC_DECOMP_TYPE_FONT UTF8PROC_DECOMP_TYPE_NOBREAK UTF8PROC_DECOMP_TYPE_INITIAL UTF8PROC_DECOMP_TYPE_MEDIAL
+                 UTF8PROC_DECOMP_TYPE_FINAL UTF8PROC_DECOMP_TYPE_ISOLATED UTF8PROC_DECOMP_TYPE_CIRCLE UTF8PROC_DECOMP_TYPE_SUPER
+                 UTF8PROC_DECOMP_TYPE_SUB UTF8PROC_DECOMP_TYPE_VERTICAL UTF8PROC_DECOMP_TYPE_WIDE UTF8PROC_DECOMP_TYPE_NARROW
+                 UTF8PROC_DECOMP_TYPE_SMALL UTF8PROC_DECOMP_TYPE_SQUARE UTF8PROC_DECOMP_TYPE_FRACTION UTF8PROC_DECOMP_TYPE_COMPAT))
+
+	   (int (UTF8PROC_BOUNDCLASS_START UTF8PROC_BOUNDCLASS_OTHER UTF8PROC_BOUNDCLASS_CR UTF8PROC_BOUNDCLASS_LF
+                 UTF8PROC_BOUNDCLASS_CONTROL UTF8PROC_BOUNDCLASS_EXTEND UTF8PROC_BOUNDCLASS_L UTF8PROC_BOUNDCLASS_V
+                 UTF8PROC_BOUNDCLASS_T UTF8PROC_BOUNDCLASS_LV UTF8PROC_BOUNDCLASS_LVT UTF8PROC_BOUNDCLASS_REGIONAL_INDICATOR
+                 UTF8PROC_BOUNDCLASS_SPACINGMARK))
+
+	   ;; in version 2: 
+	   ;;    UTF8PROC_BOUNDCLASS_PREPEND UTF8PROC_BOUNDCLASS_ZWJ UTF8PROC_BOUNDCLASS_E_BASE
+	   ;;    UTF8PROC_BOUNDCLASS_E_MODIFIER UTF8PROC_BOUNDCLASS_GLUE_AFTER_ZWJ UTF8PROC_BOUNDCLASS_E_BASE_GAZ
+	   ;;    utf8proc_int32_t utf8proc_totitle(utf8proc_int32_t c)
+	   ;;    utf8proc_bool utf8proc_grapheme_break_stateful(utf8proc_int32_t codepoint1, utf8proc_int32_t codepoint2, utf8proc_int32_t *state)
+
+	   (char* utf8proc_version (void))
+	   (char* utf8proc_errmsg (int))
+	   (int utf8proc_tolower ((utf8proc_int32_t int)))
+	   (int utf8proc_toupper ((utf8proc_int32_t int)))
+	   (int utf8proc_islower (utf8proc_int32_t))
+	   (int utf8proc_isupper (utf8proc_int32_t))
+	   (int utf8proc_charwidth ((utf8proc_int32_t int)))
+	   (int utf8proc_category ((utf8proc_int32_t int)))
+	   (char* utf8proc_category_string ((utf8proc_int32_t int)))
+	   (bool utf8proc_codepoint_valid ((utf8proc_int32_t int)))
+	   (bool utf8proc_grapheme_break ((utf8proc_int32_t int) (utf8proc_int32_t int)))
+
+	   (char* utf8proc_NFD (char*)) ; these return newly allocated memory -- should probably free it here
+	   (char* utf8proc_NFC (char*))
+	   (char* utf8proc_NFKD (char*))
+	   (char* utf8proc_NFKC (char*))
+
+	   (in-C "static s7_pointer g_utf8proc_iterate(s7_scheme *sc, s7_pointer args)
+                  {
+                    utf8proc_int32_t code_ref = 0;
+                    s7_int len, res;
+                    char *str;
+                    str = (char *)s7_string(s7_car(args));
+                    len = s7_integer(s7_cadr(args));
+                    res = utf8proc_iterate(str, len, &code_ref);
+                    return(s7_cons(sc, s7_make_integer(sc, res), s7_make_integer(sc, code_ref)));
+                   }")
+	   (C-function ("utf8proc_iterate" g_utf8proc_iterate "" 2))
+
+	   (in-C "static s7_pointer g_utf8proc_encode_char(s7_scheme *sc, s7_pointer args)
+                  {
+                    ssize_t res;
+                    utf8proc_uint8_t buf[8];
+                    res = utf8proc_encode_char((utf8proc_int32_t)s7_integer(s7_car(args)), buf);
+                    return(s7_list(sc, 2, s7_make_string_with_length(sc, buf, res), s7_make_integer(sc, res)));
+                   }")
+	   (C-function ("utf8proc_encode_char" g_utf8proc_encode_char "" 1))
+
+	   (in-C "static s7_pointer g_utf8proc_reencode(s7_scheme *sc, s7_pointer args)
+                  {
+                    s7_pointer buffer, codepoints, options;
+                    ssize_t res;
+                    buffer = s7_car(args);
+                    codepoints = s7_cadr(args);
+                    options = s7_caddr(args);
+                    res = utf8proc_reencode((utf8proc_int32_t *)s7_string(buffer), 
+                                            (utf8proc_ssize_t)s7_integer(codepoints), 
+                                            (utf8proc_option_t)s7_integer(options));
+                    return(s7_make_integer(sc, res));
+                   }")
+	   (C-function ("utf8proc_reencode" g_utf8proc_reencode "" 3))
+	   (in-C "static s7_pointer g_utf8proc_get_property(s7_scheme *sc, s7_pointer args)
+                  {
+	            const utf8proc_property_t *info;
+                    info = utf8proc_get_property((utf8proc_int32_t)s7_integer(s7_car(args)));
+                    return(s7_inlet(sc, s7_list(sc, 30,
+                             s7_make_symbol(sc, \"category\"),           s7_make_integer(sc, info->category),
+                             s7_make_symbol(sc, \"combining_class\"),    s7_make_integer(sc, info->combining_class),
+                             s7_make_symbol(sc, \"bidi_class\"),         s7_make_integer(sc, info->bidi_class),
+                             s7_make_symbol(sc, \"decomp_type\"),        s7_make_integer(sc, info->decomp_type),
+                 #if (UTF8PROC_VERSION_MAJOR >= 2)
+                             s7_make_symbol(sc, \"uppercase_seqindex\"), s7_make_integer(sc, info->uppercase_seqindex),
+                             s7_make_symbol(sc, \"lowercase_seqindex\"), s7_make_integer(sc, info->lowercase_seqindex),
+                             s7_make_symbol(sc, \"titlecase_seqindex\"), s7_make_integer(sc, info->titlecase_seqindex),
+                             s7_make_symbol(sc, \"casefold_seqindex\"),  s7_make_integer(sc, info->casefold_seqindex),
+                             s7_make_symbol(sc, \"comb_index\"),         s7_make_integer(sc, info->comb_index),
+                 #else
+                             s7_make_symbol(sc, \"uppercase_mapping\"),  s7_make_integer(sc, info->uppercase_mapping),
+                             s7_make_symbol(sc, \"lowercase_mapping\"),  s7_make_integer(sc, info->lowercase_mapping),
+                             s7_make_symbol(sc, \"titlecase_mapping\"),  s7_make_integer(sc, info->titlecase_mapping),
+                             s7_make_symbol(sc, \"comb1st_index\"),      s7_make_integer(sc, info->comb1st_index),
+                             s7_make_symbol(sc, \"comb2nd_index\"),      s7_make_integer(sc, info->comb2nd_index),
+                 #endif
+                             s7_make_symbol(sc, \"bidi_mirrored\"),      s7_make_integer(sc, info->bidi_mirrored),
+                             s7_make_symbol(sc, \"comp_exclusion\"),     s7_make_integer(sc, info->comp_exclusion),
+                             s7_make_symbol(sc, \"ignorable\"),          s7_make_integer(sc, info->ignorable),
+                             s7_make_symbol(sc, \"control_boundary\"),   s7_make_integer(sc, info->control_boundary),
+                             s7_make_symbol(sc, \"boundclass\"),         s7_make_integer(sc, info->boundclass),
+                             s7_make_symbol(sc, \"charwidth\"),          s7_make_integer(sc, info->charwidth))));
+                   }")
+	   (C-function ("utf8proc_get_property" g_utf8proc_get_property "" 1))
+
+	   (in-C "static s7_pointer g_utf8proc_decompose_char(s7_scheme *sc, s7_pointer args)
+                  {
+                    s7_pointer code, opt, str;
+                    int last_boundclass;
+                    utf8proc_ssize_t size;
+                    utf8proc_int32_t *dst;
+                    ssize_t res;
+                    code = s7_car(args);
+                    str = s7_cadr(args);
+                    opt = s7_caddr(args);
+                    dst = (utf8proc_int32_t *)s7_string(str);
+                    size = (utf8proc_ssize_t)s7_string_length(str);
+                    res = utf8proc_decompose_char((utf8proc_int32_t)s7_integer(code), dst, size, (utf8proc_option_t)s7_integer(opt), &last_boundclass);
+                    return(s7_make_integer(sc, res));
+                  }")
+	   (C-function ("utf8proc_decompose_char" g_utf8proc_decompose_char "" 3))
+
+	   (in-C "static s7_pointer g_utf8proc_map(s7_scheme *sc, s7_pointer args) /* returns (cons string-or-#f size-of-string-or-error-integer) */
+                  {
+                    s7_pointer opt, str, p;
+                    utf8proc_ssize_t res;
+                    s7_int len;
+                    utf8proc_uint8_t *dst, *new_str;
+                    str = s7_car(args);
+                    len = s7_string_length(str);
+                    opt = s7_cadr(args);
+                    new_str = (utf8proc_uint8_t *)malloc(len + 1);
+                    memcpy((void *)new_str, (const void *)s7_string(str), len); /* online example uses len+1? */
+                    res = utf8proc_map(new_str, len, &dst, (utf8proc_option_t)s7_integer(opt));
+                    if (res < 0)
+                      {
+                        free(new_str);
+                        return(s7_cons(sc, s7_f(sc), s7_make_integer(sc, res))); /* utf8proc library frees dst in this case */
+                      }
+                    p = s7_make_string_with_length(sc, dst, res);
+                    free(new_str);
+                    free(dst);
+                    return(s7_cons(sc, p, s7_make_integer(sc, res)));
+                  }")
+	   (C-function ("utf8proc_map" g_utf8proc_map "" 2))
+
+	   (in-C "static s7_pointer g_utf8proc_decompose(s7_scheme *sc, s7_pointer args)
+                  {
+                    s7_pointer opt, str;
+                    s7_int len;
+                    ssize_t res;
+                    utf8proc_int32_t *dst;
+                    str = s7_car(args);
+                    opt = s7_cadr(args);
+                    len = s7_string_length(str);
+                    dst = (utf8proc_int32_t *)malloc(len * 4);
+                    res = utf8proc_decompose((const utf8proc_uint8_t *)s7_string(str), len, dst, len, (utf8proc_option_t)s7_integer(opt));
+                    if (res < 0) return(s7_make_integer(sc, res));
+                    return(s7_make_string_with_length(sc, (char *)dst, res));
+                  }")
+	   (C-function ("utf8proc_decompose" g_utf8proc_decompose "" 2))
+	   )
+
+	 "" "utf8proc.h" "" "-lutf8proc" "utf8proc_s7")
+	(curlet))))
+
+*libutf8proc*
diff --git a/s7/lint.scm b/s7/lint.scm
new file mode 100644
index 0000000..181d4a1
--- /dev/null
+++ b/s7/lint.scm
@@ -0,0 +1,24111 @@
+;;; lint for s7 scheme
+;;;
+;;; (lint "file.scm") checks file.scm for infelicities
+;;; to control the kinds of checks, set the variables below.
+;;; for tests and examples, see lint-test in s7test.scm
+
+(provide 'lint.scm)
+
+(define *report-unused-parameters* #f)                    ; many of these are reported anyway if they are passed some non-#f value
+(define *report-unused-top-level-functions* #f)           ; very common in Scheme, but #t makes the ghastly leakage of names obvious
+(define *report-shadowed-variables* #f)                   ; shadowed parameters, etc
+(define *report-undefined-identifiers* #f)                ; names we can't account for
+(define *report-multiply-defined-top-level-functions* #f) ; top-level funcs defined in more than one file
+(define *report-nested-if* 4)                             ; 3 is lowest, this sets the nesting level that triggers an if->cond suggestion
+(define *report-short-branch* 12)                         ; controls when a lop-sided if triggers a reordering suggestion
+(define *report-one-armed-if* 90)                         ; if -> when/unless, can be #f/#t; if an integer, sets tree length which triggers revision (80 is too small)
+(define *report-loaded-files* #f)                         ; if load is encountered, include that file in the lint process
+(define *report-any-!-as-setter* #t)                      ; unknown funcs/macros ending in ! are treated as setters
+(define *report-doc-strings* #f)                          ; old-style (CL) doc strings (definstrument ignores this switch -- see ws.scm)
+(define *report-func-as-arg-arity-mismatch* #f)           ; as it says...
+(define *report-combinable-lets* #t)                      ; report lets that can be combined
+(define *report-splittable-lets* #f)                      ; report let*'s that can be split into a few nested lets
+
+(define *report-ridiculous-variable-names* 50)            ; max length of var name
+(define *report-bad-variable-names* '(l ll .. O ~ else))  ; bad names -- a list to check such as:
+;;;             '(l ll .. ~ else data datum new item info temp tmp temporary val vals value foo bar baz aux dummy O var res retval result count str)
+;;;   else is evaluated in cond
+;;;   => is evaluated in both cond and case, so both are better left alone (see s7test.scm for examples)
+;;;     at the top-level, r7rs deems it an error to change their value
+;;;   also '+signature+ and '+documentation+ as local vars could cause confusion
+
+(define *report-built-in-functions-used-as-variables* #f) ; string and length are the most common cases
+(define *report-forward-functions* #f)                    ; functions used before being defined
+(define *report-sloppy-assoc* #f)                         ; i.e. (cdr (assoc x y)) and the like
+(define *report-bloated-arg* 24)                          ; min arg expr tree size that can trigger a rewrite-as-let suggestion (32 is too high I think)
+(define *report-clobbered-function-return-value* #f)      ; function returns constant sequence, which is then stomped on -- very rare!
+(define *report-boolean-functions-misbehaving* #t)        ; function name ends in #\? but function returns a non-boolean value -- dubious.
+(define *report-quasiquote-rewrites* #t)                  ; simple quasiquote stuff rewritten as a normal list expression
+(define *report-||-rewrites* #t)                          ; | has no special meaning in s7, |...| does not represent the symbol ...
+(define *report-constant-expressions-in-do* #t)           ; a first stab at this
+(define *report-recursion->iteration* #t)                 ; named-let -> do and the like
+
+;;; these turn out to be less useful than I expected
+(define *report-repeated-code-fragments* #f)              ; #t, #f, or an int = min reported fragment size * uses * uses, #t=130.
+(define *fragment-max-size* 128)  ; biggest seen if 512: 180 -- appears to be in a test suite, if 128 max at 125
+(define *fragment-min-size* 5)    ; smallest seen - 1 -- maybe 8 would be better
+
+(define *report-laconically* #f)                          ; leave out introductory verbiage
+
+(define *lint* #f)                                        ; the lint let
+;; this gives other programs a way to extend or edit lint's tables: for example, the
+;;   table of functions that are simple (no side effects) is (*lint* 'no-side-effect-functions)
+;;   see snd-lint.scm.
+
+;;; --------------------------------------------------------------------------------
+
+(when (provided? 'pure-s7)
+  (define (make-polar mag ang) (complex (* mag (cos ang)) (* mag (sin ang))))
+
+  (define (char-ci=? . chars) (apply char=? (map char-upcase chars)))
+  (define (char-ci<=? . chars) (apply char<=? (map char-upcase chars)))
+  (define (char-ci>=? . chars) (apply char>=? (map char-upcase chars)))
+  (define (char-ci<? . chars) (apply char<? (map char-upcase chars)))
+  (define (char-ci>? . chars) (apply char>? (map char-upcase chars)))
+
+  (define (string-ci=? . strs) (apply string=? (map string-upcase strs)))
+  (define (string-ci<=? . strs) (apply string<=? (map string-upcase strs)))
+  (define (string-ci>=? . strs) (apply string>=? (map string-upcase strs)))
+  (define (string-ci<? . strs) (apply string<? (map string-upcase strs)))
+  (define (string-ci>? . strs) (apply string>? (map string-upcase strs)))
+
+  (define (let->list e)
+    (if (let? e)
+	(reverse! (map values e))
+	(error 'wrong-type-arg "let->list argument should be an environment: ~A" str))))
+
+
+(format *stderr* "loading lint.scm~%")
+
+(unless (defined? 'need-lint-line-numbers)
+  (define need-lint-line-numbers #t))
+
+(when (and (provided? 'debugging) need-lint-line-numbers)
+  (with-let (rootlet) ; force this to be top-level even in repl
+    (define-expansion (lint-format str caller . args)
+      `(begin
+	 (format (*lint* 'outport) "lint.scm line ~A~%" ,(port-line-number))
+	 ((*lint* 'lint-format-1) ,str ,caller ,@args)))))
+
+(if (and (provided? 'debugging) need-lint-line-numbers)
+    (with-let (rootlet)
+      (define-expansion (out-format port . args)
+	`(begin
+	   (format ,port "lint.scm line ~A~%" ,(port-line-number))
+	   (format ,port ,@args))))
+
+    (with-let (rootlet)
+      (define-expansion (out-format port . args)
+	`(format ,port ,@args))))
+
+(define var-name car)
+(define var-member assq)
+
+;;; --------------------------------------------------------------------------------
+(define lint
+
+  (let ((no-side-effect-functions
+	 (let ((ht (make-hash-table)))
+	   (for-each
+	    (lambda (op)
+	      (set! (ht op) #t))
+	    '(* + - / < <= = > >=
+	      abs acos acosh and angle append aritable? arity ash asin asinh assoc assq assv atan atanh
+	      begin boolean? byte-vector byte-vector-ref byte-vector?
+	      caaaar caaadr caaar caadar caaddr caadr caar cadaar cadadr cadar caddar cadddr caddr cadr
+	      call-with-input-string call-with-input-file
+	      c-pointer c-pointer? c-object? c-object-type call-with-exit car case catch
+	      cdaaar cdaadr cdaar cdadar cdaddr cdadr cdar cddaar cddadr
+	      cddar cdddar cddddr cdddr cddr cdr ceiling char->integer char-alphabetic? char-ci<=?
+	      char-ci<? char-ci=? char-ci>=? char-ci>? char-downcase char-lower-case? char-numeric?
+	      char-position char-ready? char-upcase char-upper-case? char-whitespace? char<=? char<?
+	      char=? char>=? char>? char? complex complex? cond cons continuation? cos constant?
+	      cosh curlet current-error-port current-input-port current-output-port cyclic-sequences
+	      defined? denominator dilambda? do dynamic-wind
+	      eof-object? eq? equal? eqv? even? exact->inexact exact? exp expt
+	      float? float-vector float-vector-ref float-vector? floor for-each funclet
+	      gcd gensym gensym?
+	      hash-table  hash-table-entries hash-table-ref hash-table-key-typer hash-table-value-typer hash-table? help hook-functions
+	      if imag-part immutable? inexact->exact inexact? infinite? inlet input-port?
+	      int-vector int-vector-ref int-vector? iterator-at-end? iterator-sequence integer->char
+	      integer-decode-float integer-length integer? iterator?
+	      keyword->symbol keyword?
+	      lambda lambda* lcm let->list length let let* let-ref let? letrec letrec* list list->string list->vector list-ref
+	      list-tail list? log logand logbit? logior lognot logxor
+	      macro? magnitude make-byte-vector make-float-vector make-int-vector make-hash-table make-hook make-iterator make-list make-polar
+	      make-rectangular subvector make-string make-vector map max member memq memv min modulo equivalent?
+	      nan? negative? not null? number->string number? numerator
+	      object->let object->string odd? openlet? or outlet output-port? owlet
+	      pair-line-number pair-filename pair? port-closed? port-filename port-line-number positive? documentation
+	      setter signature procedure-arglist procedure-source procedure? proper-list? provided?
+	      quasiquote quote quotient
+	      random-state random-state->list random-state? rational? rationalize real-part real? remainder reverse rootlet round
+	      sequence? sin sinh square sqrt stacktrace string string->list string->number string->symbol string->keyword string-append
+	      string-ci<=? string-ci<? string-ci=? string-ci>=? string-ci>? string-downcase string-length
+	      string-position string-ref string-upcase string<=? string<? string=? string>=? string>? string?
+	      sublet substring subvector? subvector-position subvector-vector
+	      symbol symbol->dynamic-value symbol-initial-value symbol->keyword symbol->string symbol->value symbol? syntax?
+	      tan tanh tree-leaves tree-memq tree-set-memq tree-count tree-cyclic? truncate type-of
+	      unless unspecified? undefined?
+	      values vector vector-append vector->list vector-dimensions vector-dimension vector-rank vector-length vector-ref vector-typer vector?
+	      when with-baffle with-let with-input-from-file with-input-from-string with-output-to-string
+	      zero?
+
+	      c-pointer-weak2 c-pointer-type bignum port-position byte-vector->string c-pointer-info c-pointer->list subvector-vector c-pointer-weak1
+	      funclet? bignum? weak-hash-table? goto? port-file port-string byte? hash-code
+	      dilambda ; these 3 lines added 5-May-22, not getenv directory->list or file-mtime because bools are evaluated if constant args!
+
+	      list-values apply-values unquote))
+	   ;; do not include file-exists? or directory? (also not peek-char because these are checked via eval)
+	   ht))
+
+	(built-in-functions (let ((ht (make-hash-table)))
+			      (for-each
+			       (lambda (op)
+				 (set! (ht op) #t))
+			       '(symbol? gensym? keyword? let? openlet? iterator? macro? c-pointer? c-object? c-object-type constant? subvector?
+			         input-port? output-port? eof-object? integer? number? real? complex? rational? random-state?
+			         char? string? list? pair? vector? float-vector? int-vector? byte-vector? hash-table?
+			         continuation? procedure? dilambda? boolean? float? proper-list? sequence? null? gensym
+			         symbol->string string->symbol symbol symbol->value symbol->dynamic-value
+			         string->keyword symbol->keyword keyword->symbol outlet rootlet curlet unlet sublet varlet
+			         cutlet inlet owlet coverlet openlet let-ref let-set! make-iterator iterate iterator-sequence
+			         iterator-at-end? provided? provide defined? c-pointer port-line-number port-filename
+			         pair-line-number pair-filename port-closed? current-input-port current-output-port
+			         current-error-port let->list char-ready? close-input-port close-output-port flush-output-port
+			         open-input-file open-output-file open-input-string open-output-string get-output-string
+			         newline write display read-char peek-char write-char write-string read-byte write-byte
+			         read-line read-string read call-with-input-string call-with-input-file with-input-from-string
+			         with-input-from-file call-with-output-string call-with-output-file with-output-to-string
+			         with-output-to-file real-part imag-part numerator denominator even? odd? zero? positive?
+			         negative? infinite? nan? complex magnitude angle rationalize abs exp log sin cos tan asin
+			         acos atan sinh cosh tanh asinh acosh atanh sqrt expt floor ceiling truncate round lcm gcd
+			         + - * / max min quotient remainder modulo = < > <= >= logior logxor logand lognot ash
+			         random-state random inexact->exact exact->inexact integer-length make-polar make-rectangular
+			         logbit? integer-decode-float exact? inexact? random-state->list number->string string->number
+			         char-upcase char-downcase char->integer integer->char char-upper-case? char-lower-case?
+			         char-alphabetic? char-numeric? char-whitespace? char=? char<? char>? char<=? char>=?
+			         char-position string-position make-string string-ref string-set! string=? string<? string>?
+			         string<=? string>=? char-ci=? char-ci<? char-ci>? char-ci<=? char-ci>=? string-ci=? string-ci<?
+			         string-ci>? string-ci<=? string-ci>=? string-copy string-fill! list->string string-length
+			         string->list string-downcase string-upcase string-append substring string object->string
+			         format cons car cdr set-car! set-cdr! caar cadr cdar cddr caaar caadr cadar cdaar caddr
+			         cdddr cdadr cddar caaaar caaadr caadar cadaar caaddr cadddr cadadr caddar cdaaar cdaadr
+			         cdadar cddaar cdaddr cddddr cddadr cdddar assoc member list list-ref list-set! list-tail
+			         make-list length copy fill! reverse reverse! sort! append assq assv memq memv vector-append
+			         list->vector vector-fill! vector-length vector->list vector-ref vector-set! vector-dimensions vector-dimension
+			         make-vector subvector vector float-vector make-float-vector float-vector-set! vector-rank vector-typer
+			         float-vector-ref int-vector make-int-vector int-vector-set! int-vector-ref string->byte-vector
+			         byte-vector make-byte-vector hash-table  make-hash-table hash-table-ref hash-table-key-typer hash-table-value-typer
+			         hash-table-set! hash-table-entries cyclic-sequences call/cc call-with-current-continuation
+			         call-with-exit load autoload eval eval-string apply for-each map dynamic-wind values
+			         catch throw error documentation signature help procedure-arglist procedure-source funclet
+			         setter arity aritable? not eq? eqv? equal? equivalent? gc emergency-exit symbol-initial-value
+			         exit dilambda make-hook hook-functions stacktrace tree-leaves tree-memq object->let
+				 getenv directory? file-exists? type-of immutable! immutable? byte-vector-set! syntax?
+				 list-values apply-values unquote set-current-output-port unspecified? undefined? byte-vector-ref
+				 set-current-input-port set-current-error-port directory->list system subvector-position
+				 tree-count tree-set-memq tree-cyclic?))
+			      ht))
+
+	(side-effect-functions '(provide list-set! fill! reverse! sort! vector-fill! vector-set! float-vector-set! int-vector-set! byte-vector-set!
+				 string->byte-vector string-set! hash-table-set! call/cc call-with-current-continuation load autoload eval eval-string
+				 apply set-current-error-port display set-current-input-port set-current-output-port write close-input-port
+				 close-output-port flush-output-port open-input-file open-output-file open-input-string open-output-string
+				 get-output-string newline read-char peek-char write-char write-string read-byte write-byte read-line read-string
+				 read call-with-output-string call-with-output-file string-fill! with-output-to-file system format set-car! set-cdr!
+				 immutable! varlet cutlet coverlet openlet random let-set! iterate
+				 emergency-exit exit error throw))
+
+	(makers (let ((h (make-hash-table)))
+		  (for-each
+		   (lambda (op)
+		     (set! (h op) #t))
+		   '(gensym sublet inlet make-iterator let->list random-state random-state->list number->string object->let
+		     make-string string string-copy copy list->string string->list string-append substring object->string
+		     format cons list make-list reverse append vector-append list->vector vector->list make-vector
+		     subvector vector make-float-vector float-vector make-int-vector int-vector byte-vector
+		     hash-table  make-hash-table make-hook list-values append gentemp)) ; gentemp for other schemes
+		  h))
+
+	(non-negative-ops (let ((h (make-hash-table)))
+			    (for-each
+			     (lambda (op)
+			       (set! (h op) #t))
+			     '(string-length vector-length abs magnitude denominator gcd lcm tree-leaves
+			       char->integer hash-table-entries write-byte
+			       char-position string-position pair-line-number port-line-number))
+			    h))
+
+	(numeric-ops (let ((h (make-hash-table)))
+		       (for-each
+			(lambda (op)
+			  (set! (h op) #t))
+			'(+ * - /
+			  sin cos tan asin acos atan sinh cosh tanh asinh acosh atanh
+			  log exp expt sqrt make-polar complex make-rectangular
+			  imag-part real-part abs magnitude angle max min exact->inexact
+			  modulo remainder quotient lcm gcd
+			  rationalize inexact->exact random
+			  logior lognot logxor logand integer-length numerator denominator
+			  floor round truncate ceiling ash
+
+			  ;; r7rs
+			  exact inexact
+
+			  ;; hooboy...
+			  fix:+ fx+ flo:+ fl+ fix:* fx* flo:* fl* fix:- fx- flo:- fl- fix:/ fx/ flo:/ fl/
+			  ))
+		       h))
+
+	(bools (let ((h (make-hash-table)))
+		 (for-each
+		  (lambda (op)
+		    (set! (h op) #t))
+		  '(symbol? byte? integer? rational? real? number? complex? float? keyword? gensym? byte-vector? string? list? sequence?
+		    char? boolean? float-vector? int-vector? vector? let? hash-table? input-port? null? pair? proper-list?
+		    output-port? iterator? continuation? dilambda? procedure? macro? random-state? eof-object? c-pointer?
+		    unspecified? immutable? constant? syntax? undefined? tree-cyclic? openlet? subvector?))
+		 h))
+
+	(booleans (let ((h (make-hash-table)))
+		  (for-each
+		   (lambda (op)
+		     (set! (h op) #t))
+		   '(symbol? byte? integer? rational? real? number? complex? float? keyword? gensym? byte-vector? string? list? sequence?
+		     char? boolean? float-vector? int-vector? vector? let? hash-table? input-port? null? pair? proper-list?
+		     output-port? iterator? continuation? dilambda? procedure? macro? random-state? eof-object? c-pointer?
+		     unspecified? exact? inexact? defined? provided? even? odd? char-whitespace? char-numeric? char-alphabetic?
+		     negative? positive? zero? syntax? undefined? tree-cyclic? not openlet? ; immutable? constant?
+		     infinite? nan? char-upper-case? char-lower-case? directory? file-exists? iterator-at-end? subvector?))
+		  h))
+
+	(setters '(symbol? syntax? gensym? keyword? let? openlet? iterator? macro? c-pointer? input-port? output-port? eof-object?
+		   integer? byte? number? real? float? complex? rational? random-state? char? string? list? pair? vector? float-vector?
+		   int-vector? byte-vector? hash-table? continuation? procedure? dilambda? boolean? properd-list? sequence? null?
+		   undefined? unspecified? c-object? subvector? weak-hash-table?))
+
+	(notables (let ((h (make-hash-table)))
+		    (for-each
+		     (lambda (op)
+		       (set! (h (car op)) (cadr op)))
+		     '((< >=) (> <=) (<= >) (>= <)
+		       (char<? char>=?) (char>? char<=?) (char<=? char>?) (char>=? char<?)
+		       (string<? string>=?) (string>? string<=?) (string<=? string>?) (string>=? string<?)
+		       (char-ci<? char-ci>=?) (char-ci>? char-ci<=?) (char-ci<=? char-ci>?) (char-ci>=? char-ci<?)
+		       (string-ci<? string-ci>=?) (string-ci>? string-ci<=?) (string-ci<=? string-ci>?) (string-ci>=? string-ci<?)
+		       (odd? even?) (even? odd?) (exact? inexact?) (inexact? exact?)))
+		    h))
+
+	(reversibles (let ((h (make-hash-table)))
+		       (for-each
+			(lambda (op)
+			  (set! (h (car op)) (cadr op)))
+			'((< >) (> <) (<= >=) (>= <=)
+			  (* *) (+ +) (= =) (char=? char=?) (string=? string=?)
+			  (eq? eq?) (eqv? eqv?) (equal? equal?) (equivalent? equivalent?)
+			  (logand logand) (logxor logxor) (logior logior)
+			  (max max) (min min) (lcm lcm) (gcd gcd)
+			  (char<? char>?) (char>? char<?) (char<=? char>=?) (char>=? char<=?)
+			  (string<? string>?) (string>? string<?) (string<=? string>=?) (string>=? string<=?)
+			  (char-ci<? char-ci>?) (char-ci>? char-ci<?) (char-ci<=? char-ci>=?) (char-ci>=? char-ci<=?)
+			  (string-ci<? string-ci>?) (string-ci>? string-ci<?) (string-ci<=? string-ci>=?) (string-ci>=? string-ci<=?)))
+		       h))
+
+	(syntaces (let ((h (make-hash-table)))
+		    (for-each
+		     (lambda (op)
+		       (set! (h op) #t))
+		     '(quote #_quote if begin let let* letrec letrec* cond case or and do set! unless when
+		       with-let with-baffle
+		       lambda lambda* define define*
+		       define-macro define-macro* define-bacro define-bacro*
+		       define-constant define-expansion))
+		    h))
+
+	(definers '(define define* define-constant lambda lambda* curlet require load eval eval-string
+		    define-macro define-macro* define-bacro define-bacro* define-expansion
+		    definstrument define-animal define-envelope
+		    define-values define-module define-method
+		    define-syntax define-public define-inlinable define-integrable define^))
+
+	(open-definers '(define define* define-constant require load eval eval-string
+			 define-macro define-macro* define-bacro define-bacro* define-expansion
+			 definstrument define-animal define-envelope defgenerator
+			 define-values define-module define-method
+			 define-syntax define-public define-inlinable define-integrable define^))
+
+	(cxars (hash-table 'car ()  'caar 'car  'cdar 'cdr
+			   'caaar 'caar  'cdaar 'cdar  'cddar 'cddr  'cadar 'cadr
+			   'caaaar 'caaar  'caadar 'caadr  'cadaar 'cadar  'caddar 'caddr
+			   'cdaaar 'cdaar  'cdadar 'cdadr  'cddaar 'cddar  'cdddar 'cdddr))
+
+	(outport #t)
+	(linted-files ())
+	(big-constants (make-hash-table))
+	(other-names-counts (make-hash-table))
+	(*e* #f)
+	(other-identifiers (make-hash-table))
+	(quote-warnings 0)
+	;; these line numbers are trying to reduce redundant output, but they sometimes squelch useful feedback
+	(last-simplify-boolean-line-number -1)
+	(last-simplify-numeric-line-number -1)
+	(last-simplify-cxr-line-number -1)
+	(last-if-line-number -1)
+	(last-if->case-line-number -1)
+	(last-let->case-line-number -1)
+	(last-checker-line-number -1)
+	(last-cons-line-number -1)
+	(last-rewritten-internal-define #f)
+	(last-lambda-let #f)
+	(last-lambda-let-funcs #f)
+	(local-function-context 40)
+	(line-number -1)
+	(lint-in-with-let #f)
+	(pp-left-margin 4)
+	(lint-left-margin 1)
+	(*current-file* "")
+	(*top-level-objects* (make-hash-table))
+	(*output-port* *stderr*)
+	(fragments (make-vector *fragment-max-size* #f))
+	(fragmin *fragment-max-size*)
+	(fragmax 0)
+	;(recent-names (make-list 8 #f))
+	(*max-cdr-len* 16)) ; 40 is too high, 24 questionable, if #f the let+do rewrite is turned off
+
+    ;; (let ((st (symbol-table))) (for-each (lambda (x) (if (and (procedure? (symbol->value x)) (not (hash-table-ref built-in-functions x))) (format *stderr* "~A~%" x))) st))
+
+    (set! *e* (curlet))
+    (set! *lint* (curlet))                ; external access to (for example) the built-in-functions hash-table via (*lint* 'built-in-functions)
+    ;(set-cdr! (list-tail recent-names 7) recent-names)
+
+    (define denote define-constant)
+
+    (define definers-table
+      (let ((h (make-hash-table)))
+	(for-each (lambda (d)
+		    (set! (h d) #t))
+		  definers)
+	h))
+
+    (define open-definers-table
+      (let ((h (make-hash-table)))
+	(for-each (lambda (d)
+		    (set! (h d) #t))
+		  open-definers)
+	h))
+
+    (define (lint-tree-leaves tree)
+      (if (pair? tree)
+	  (tree-leaves tree)
+	  0))
+
+    (define (lint-tree-memq obj tree)
+      (or (eq? obj tree)
+	  (and (pair? tree)
+	       (tree-memq obj tree))))
+
+    (define (lint-tree-set-memq objs tree)
+      (if (pair? tree)
+	  (tree-set-memq objs tree)
+	  (if (pair? objs)
+	      (memq tree objs)
+	      (eq? tree objs))))
+
+    (define (lint-tree-count obj tree max-count)
+      (if (pair? tree)
+	  (tree-count obj tree max-count)
+	  0)) ; originally: (if (eq? obj tree) 1 0)))
+
+
+    ;; -------- lint-format --------
+    (define target-line-length 80) ; also 120 via let-temporarily
+
+    (denote (lint-truncate-string str)
+      (if (< (length str) target-line-length)
+	  str
+	  (do ((i (- target-line-length 6) (- i 1)))
+		((or (= i 40)
+		     (char-whitespace? (string-ref str i)))
+		 (string-append (substring str 0 (if (<= i 40)
+						     (- target-line-length 6)
+						     i))
+				"...")))))
+
+    (denote (truncated-list->string form)
+      ;; return form -> string with limits on its length
+      (lint-truncate-string (object->string form #t target-line-length)))
+
+    (define lint-pp #f) ; avoid crosstalk with other schemes' definitions of pp and pretty-print (make-lint-var also collides)
+    (define lint-pp-funclet #f)
+    (let ()
+      (require write.scm)
+      (set! lint-pp pp)
+      (set! lint-pp-funclet (funclet pretty-print)))
+
+    (denote (lists->string f1 f2)
+      (let ((str1 (lint-truncate-string (object->string f1 #t (+ target-line-length 2)))))
+	(if (> (lint-tree-leaves f2) 10)
+	    (begin
+	      (set! (lint-pp-funclet '*pretty-print-left-margin*) pp-left-margin)
+	      (set! (lint-pp-funclet '*pretty-print-length*) (- 114 pp-left-margin))
+	      (format #f "~%~NC~A ->~%~NC~A" pp-left-margin #\space str1 pp-left-margin #\space (lint-pp f2)))
+	    (let ((str2 (lint-truncate-string (object->string f2 #t (+ target-line-length 2)))))
+	      (if (< (+ (length str1) (length str2)) target-line-length)
+		  (format #f "~A -> ~A" str1 str2)
+		  (format #f "~%~NC~A ->~%~NC~A" pp-left-margin #\space str1 pp-left-margin #\space str2))))))
+
+    (define (truncated-lists->string f1 f2)
+      ;; same but 2 strings that may need to be lined up vertically and both are truncated
+      (let ((str1 (lint-truncate-string (object->string f1 #t (+ target-line-length 2))))
+	    (str2 (lint-truncate-string (object->string f2 #t (+ target-line-length 2)))))
+	(if (< (+ (length str1) (length str2)) target-line-length)
+	    (format #f "~A -> ~A" str1 str2)
+	    (format #f "~%~NC~A ->~%~NC~A" pp-left-margin #\space str1 pp-left-margin #\space str2))))
+
+    (define made-suggestion 0)
+
+    (denote (lint-format-1 str caller . args)
+      (let ((outstr (if *report-laconically*
+ 			(apply format #f str args)
+			(apply format #f
+			   (string-append (if (and (integer? line-number) (> line-number 0))
+					      "~NC~A (line ~D): "
+					      "~NC~A: ")
+					  str "~%")
+			   lint-left-margin #\space
+			   (truncated-list->string caller)
+			   (if (and (integer? line-number) (> line-number 0))
+			       (values line-number args)
+			       args)))))
+	(set! made-suggestion (+ made-suggestion 1))
+	(display outstr outport)
+	(if (or *report-laconically*
+		(> (length outstr) (+ target-line-length 40)))
+	    (newline outport))))
+
+    (unless (and (provided? 'debugging) need-lint-line-numbers)
+      (define lint-format lint-format-1))
+
+    (denote (local-line-number tree)
+      (let ((tree-line (and (pair? tree) (pair-line-number tree))))
+	(if (and (integer? tree-line)
+		 (> tree-line 0)
+		 (not (= tree-line line-number)))
+	    (format #f " (line ~D)" tree-line)
+	    "")))
+
+
+    ;; -------- vars --------
+    (denote (var? v) (and (pair? v) (let? (cdr v))))
+    (denote var-ref     (dilambda (lambda (v) (let-ref (cdr v) 'ref))     (lambda (v x) (let-set! (cdr v) 'ref x))))
+    (denote var-set     (dilambda (lambda (v) (let-ref (cdr v) 'set))     (lambda (v x) (let-set! (cdr v) 'set x))))
+    (denote var-history (dilambda (lambda (v) (let-ref (cdr v) 'history)) (lambda (v x) (let-set! (cdr v) 'history x))))
+    (denote var-ftype   (dilambda (lambda (v) (let-ref (cdr v) 'ftype))   (lambda (v x) (if (defined? 'ftype (cdr v) #t) (let-set! (cdr v) 'ftype x)))))
+    (denote var-retcons (dilambda (lambda (v) (let-ref (cdr v) 'retcons)) (lambda (v x) (let-set! (cdr v) 'retcons x))))
+    (denote var-arglist (dilambda (lambda (v) (let-ref (cdr v) 'arglist)) (lambda (v x) (let-set! (cdr v) 'arglist x))))
+    (denote var-definer (dilambda (lambda (v) (let-ref (cdr v) 'definer)) (lambda (v x) (let-set! (cdr v) 'definer x))))
+    (denote var-scope   (dilambda (lambda (v) (let-ref (cdr v) 'scope))   (lambda (v x) (let-set! (cdr v) 'scope x))))
+    (denote var-setters (dilambda (lambda (v) (let-ref (cdr v) 'setters)) (lambda (v x) (let-set! (cdr v) 'setters x))))
+    (denote var-env     (dilambda (lambda (v) (let-ref (cdr v) 'env))     (lambda (v x) (let-set! (cdr v) 'env x))))
+    (denote (var-arity v)
+      (let ((val (let-ref (cdr v) 'arit)))
+	(and (not (eq? val #<undefined>))
+	     val)))
+    (denote (var-initial-value v) (let-ref (cdr v) 'initial-value)) ; not (easily) settable
+
+    (denote var-refenv
+      (dilambda (lambda (v)
+		  (let-ref (cdr v) 'refenv))
+		(lambda (v e)
+		  (let ((old-e (let-ref (cdr v) 'refenv)))
+		    (if (null? old-e)                         ; nil if unset
+			(let-set! (cdr v) 'refenv e)          ;   so set to current
+			(if (not (eq? old-e e))               ; not eq, so (for now) set to #f
+			    (let-set! (cdr v) 'refenv #f))))
+		  e)))
+
+    (denote var-side-effect
+      (dilambda (lambda (v)
+		  (case (let-ref (cdr v) 'side-effect)
+		    ((()) (let-set! (cdr v) 'side-effect (get-side-effect v)))
+		    (else)))
+		(lambda (v x)
+		  (let-set! (cdr v) 'side-effect x))))
+
+    (denote var-signature
+      (dilambda (lambda (v)
+		  (case (let-ref (cdr v) 'sig)
+		    ((()) (let-set! (cdr v) 'sig (get-signature v)))
+		    (else)))
+		(lambda (v x)
+		  (if (defined? 'sig (cdr v) #t)
+		      (let-set! (cdr v) 'sig x))))) ; perhaps fallback on varlet here and in var-ftype above?
+
+    (denote (make-lint-var name initial-value definer)
+      (let ((old (or (hash-table-ref other-identifiers name) ())))
+	(if (pair? old)
+	    (hash-table-set! other-identifiers name #f) ; remove name
+	    )
+#|
+	    (begin
+	      ;(format *stderr* "~S ~S ~S~%" name initial-value definer)
+	      (set-car! recent-names (list name definer initial-value))
+	      (set! recent-names (cdr recent-names))))
+|#
+	(cons name (inlet 'history (if initial-value
+				       (cons initial-value old)
+				       old)
+			  'ref (length old)
+			  'scope ()
+			  'initial-value initial-value
+			  'refenv ()
+			  'set 0
+			  'definer definer
+			  'env ()
+			  'setters ()
+			  ))))
+
+
+    ;; -------- the usual list functions --------
+
+    (denote (len=1? x)
+      (and (pair? x)
+	   (null? (cdr x))))
+
+    (denote (len=2? x)
+      (and (pair? x)
+	   (pair? (cdr x))
+	   (null? (cddr x))))
+
+    (denote (len=3? x)
+      (and (pair? x)
+	   (pair? (cdr x))
+	   (pair? (cddr x))
+	   (null? (cdddr x))))
+
+    (denote (len>1? x)
+      (and (pair? x)
+	   (pair? (cdr x))))
+
+    (denote (len>2? x)
+      (and (pair? x)
+	   (pair? (cdr x))
+	   (pair? (cddr x))))
+
+    (denote (last-ref x)
+      (let ((len (length x)))
+	(and (integer? len)
+	     (positive? len)
+	     (list-ref x (- len 1)))))
+
+    (denote (proper-pair? x)
+      (and (pair? x)
+	   (proper-list? (cdr x))))
+
+    (denote (unquoted-pair? x)
+      (and (pair? x)
+	   (not (memq (car x) '(quote #_quote)))))
+
+    (define (remove-one item sequence)
+      (cond ((not (pair? sequence)) sequence)
+	    ((equal? item (car sequence)) (cdr sequence))
+	    (else (cons (car sequence)
+			(remove-one item (cdr sequence))))))
+
+    (define (remq-set items sequence)
+      (cond ((not (pair? sequence))
+	     sequence)
+	    ((memq (car sequence) items)
+	     (remq-set items (cdr sequence)))
+	    (else
+	     (cons (car sequence)
+		   (remq-set items (cdr sequence))))))
+
+    (define (remove-all item sequence)
+      (map (lambda (x)
+	     (if (equal? x item)
+		 (values)
+		 x))
+	   sequence))
+
+    (define (remove-if p lst)
+      (cond ((not (pair? lst)) lst)
+	    ((p (car lst)) (remove-if p (cdr lst)))
+	    (else (cons (car lst)
+			(remove-if p (cdr lst))))))
+
+    (denote (lint-remove-duplicates lst env)
+      (reverse (let rem-dup ((lst lst)
+			     (nlst ()))
+		 (cond ((null? lst) nlst)
+		       ((and (member (car lst) nlst)
+			     (not (and (pair? (car lst))
+				       (side-effect? (car lst) env))))
+			(rem-dup (cdr lst) nlst))
+		       (else (rem-dup (cdr lst) (cons (car lst) nlst)))))))
+
+    (define applicable? arity)
+
+    (denote (code-constant? x)
+      (and (constant? x)
+	   (or (not (pair? x))
+	       (memq (car x) '(quote #_quote)))))
+
+    (denote lint-every?
+      (let ((+documentation+ "(lint-every? func sequence) returns #t if func approves of every member of the list sequence")
+	    (+signature+ '(boolean? procedure? list?)))
+	(lambda (f sequence)
+	  (if (pair? sequence)
+	      (and (f (car sequence))
+		   (lint-every? f (cdr sequence)))
+	      (null? sequence)))))
+
+    (denote (just-pairs? sequence)
+      (or (null? sequence)
+	  (and (pair? (car sequence))
+	       (just-pairs? (cdr sequence)))))
+
+    (denote (just-symbols? sequence)
+      (or (null? sequence)
+	  (and (symbol? (car sequence))
+	       (just-symbols? (cdr sequence)))))
+
+    (denote (just-keywords? sequence)
+      (or (null? sequence)
+	  (and (keyword? (car sequence))
+	       (just-keywords? (cdr sequence)))))
+
+    (denote (just-integers? sequence)
+      (or (null? sequence)
+	  (and (integer? (car sequence))
+	       (just-integers? (cdr sequence)))))
+
+    (denote (just-rationals? sequence)
+      (or (null? sequence)
+	  (and (rational? (car sequence))
+	       (just-rationals? (cdr sequence)))))
+
+    (denote (just-reals? sequence)
+      (or (null? sequence)
+	  (and (real? (car sequence))
+	       (just-reals? (cdr sequence)))))
+
+    (denote (just-len>1? sequence)
+      (or (null? sequence)
+	  (and (len>1? (car sequence))
+	       (just-len>1? (cdr sequence)))))
+
+    (denote (just-code-constants? sequence)
+      (or (null? sequence)
+	  (and (code-constant? (car sequence))
+	       (just-code-constants? (cdr sequence)))))
+
+    (denote lint-any?
+      (let ((+documentation+ "(lint-any? func sequence) returns #t if func approves of any member of the list sequence")
+	    (+signature+ '(boolean? procedure? list?)))
+	(lambda (f sequence)
+	  (and (pair? sequence)
+	       (or (f (car sequence))
+		   (lint-any? f (cdr sequence)))))))
+
+    (denote (any-side-effect? form env vars)
+      (and (pair? form)
+	   (or (side-effect-with-vars? (car form) env vars)
+	       (any-side-effect? (cdr form) env vars))))
+
+    (denote (any-pairs? sequence)
+      (and (pair? sequence)
+	   (or (pair? (car sequence))
+	       (any-pairs? (cdr sequence)))))
+
+    (denote (any-keywords? sequence)
+      (and (pair? sequence)
+	   (or (keyword? (car sequence))
+	       (any-keywords? (cdr sequence)))))
+
+    (denote (any-numbers? sequence)
+      (and (pair? sequence)
+	   (or (number? (car sequence))
+	       (any-numbers? (cdr sequence)))))
+
+    (denote lint-find-if
+      (let ((+documentation+ "(lint-find-if func lst) applies func to each member of the list lst.\n\
+              If func approves of one, find-if returns that member of the sequence")
+	    (+signature+ '(#t procedure? list?)))
+	(lambda (f lst)
+	  (and (pair? lst)
+	       (if (f (car lst))
+		   (car lst)
+		   (lint-find-if f (cdr lst)))))))
+
+    (define (collect-if f lst)
+      (map (lambda (arg) (if (f arg) arg (values))) lst))
+
+    (define (collect-if-rational lst)
+      (map (lambda (x) (if (rational? x) x (values))) lst))
+
+    (define (collect-if-integer lst)
+      (map (lambda (x) (if (integer? x) x (values))) lst))
+
+    (define (collect-if-real lst)
+      (map (lambda (x) (if (real? x) x (values))) lst))
+
+    (define (collect-if-not-number lst)
+      (map (lambda (x) (if (number? x) (values) x)) lst))
+
+
+    ;; -------- trees --------
+
+    (define (proper-tree? tree)
+      (or (not (pair? tree))
+	  (lint-every? proper-tree? tree)))
+
+    (define (shadowed? sym tree1)
+      (let shadow? ((tree tree1))
+	(and (pair? tree)
+	     (or (and (null? (cdr tree))
+		      (shadow? (car tree)))
+		 (and (pair? (cdr tree))
+		      (null? (cddr tree))
+		      (or (shadow? (car tree))
+			  (shadow? (cdr tree))))
+		 (and (pair? (cdr tree))
+		      (pair? (cddr tree))
+		 (case (car tree)
+		   ((let let*)
+		    (and (len>1? (cdr tree))
+			 (or (eq? sym (cadr tree))
+			     (let ((vars ((if (symbol? (cadr tree)) caddr cadr) tree)))
+			       (or (and (pair? vars)
+					(assq sym vars))
+				   (shadow? ((if (symbol? (cadr tree)) cdddr cddr) tree)))))))
+
+		   ((letrec letrec* do)
+		    (or (and (pair? (cadr tree))
+			     (assq sym (cadr tree)))
+			(shadow? (cddr tree))))
+
+		   ((define lambda define-macro define-constant)
+		    (or (eq? sym (cadr tree))
+			(and (pair? (cadr tree))
+			     (memq sym (cadr tree)))
+			(shadow? (cddr tree))))
+
+		   ((lambda* define* define-macro*)
+		    (or (eq? sym (cadr tree))
+			(and (pair? (cadr tree))
+			     (member sym (cadr tree) (lambda (a b)
+						       (or (eq? a b)
+							   (and (pair? b)
+								(eq? a (car b)))))))
+			(shadow? (cddr tree))))
+		   (else
+		    (or (shadow? (car tree))
+			(shadow? (cdr tree))))))))))
+
+    (define (gather-symbols tree)
+      (let ((syms ()))
+	(let walk ((p tree))
+	  (if (pair? p)
+	      (if (or (symbol? (car p)) (eq? (car p) #_quote))
+		  (if (not (memq (car p) '(quote #_quote)))
+		      (for-each (lambda (a)
+				  (if (symbol? a)
+				      (if (not (memq a syms))
+					  (set! syms (cons a syms)))
+				      (if (pair? a) (walk a))))
+				(cdr p)))
+		  (when (pair? (car p))
+		    (walk (car p))
+		    (walk (cdr p))))
+	      (if (and (symbol? tree)
+		       (not (memq tree syms)))
+		  (set! syms (cons tree syms)))))
+	syms))
+
+    (define (tree-arg-member sym tree)
+      (and (proper-list? tree)
+	   (or (and (memq sym (cdr tree))
+		    tree)
+	       (and (pair? (car tree))
+		    (tree-arg-member sym (car tree)))
+	       (and (pair? (cdr tree))
+		    (call-with-exit
+		     (lambda (return)
+		       (for-each
+			(lambda (b)
+			  (cond ((and (pair? b)
+				      (tree-arg-member sym b))
+				 => return)))
+			(cdr tree))
+		       #f))))))
+
+    (define (tree-member sym tree1) ; tree-memq ignoring quote and no match if tree1 == bare sym -- nearly all of these "members" should be "memqs"
+      (let tm ((tree tree1))
+	(and (pair? tree)
+	     (or (eq? (car tree) sym)
+		 (tm (car tree))
+		 (tm (cdr tree))))))
+
+    (define (tree-equal-member sym tree)
+      (and (pair? tree)
+	   (or (equal? (car tree) sym)
+	       (tree-equal-member sym (car tree))
+	       (tree-equal-member sym (cdr tree)))))
+
+    (define (tree-unquoted-member sym tree)
+      (and (pair? tree)
+	   (lint-tree-memq sym tree)))
+
+    (define (tree-car-member sym tree)
+      (and (pair? tree)
+	   (or (eq? (car tree) sym)
+	       (and (pair? (car tree))
+		    (tree-car-member sym (car tree)))
+	       (and (pair? (cdr tree))
+		    (member sym (cdr tree) tree-car-member)))))
+
+    (define (tree-sym-set-member sym set tree) ; sym as arg, set as car
+      (and (pair? tree)
+	   (or (memq (car tree) set)
+	       (and (pair? (car tree))
+		    (tree-sym-set-member sym set (car tree)))
+	       (and (pair? (cdr tree))
+		    (or (member sym (cdr tree))
+			(member #f (cdr tree) (lambda (a b) (tree-sym-set-member sym set b))))))))
+
+    (define (tree-set-member set tree1)
+      (case (length set)
+	((0) #f)
+	((1) (lint-tree-memq (car set) tree1))
+	((2) (or (lint-tree-memq (car set) tree1)
+		 (lint-tree-memq (cadr set) tree1)))
+	(else
+	 (let ts ((tree tree1))
+	   (if (pair? tree)
+	       (and (not (memq (car tree) '(quote #_quote)))
+		    (or (ts (car tree))
+			(ts (cdr tree))))
+	       (memq tree set))))))
+
+    (define (tree-set-car-member set tree) ; set as car
+      (and (pair? tree)
+	   (or (and (memq (car tree) set)
+		    tree)
+	       (and (pair? (car tree))
+		    (tree-set-car-member set (car tree)))
+	       (and (pair? (cdr tree))
+		    (do ((p (cdr tree) (cdr p)))
+			((or (not (pair? p))
+			     (tree-set-car-member set (car p)))
+			 (pair? p)))))))
+
+    (define (tree-table-car-member set tree) ; hash-table as car
+      (and (pair? tree)
+	   (or (and (hash-table-ref set (car tree))
+		    tree)
+	       (and (pair? (car tree))
+		    (tree-table-car-member set (car tree)))
+	       (and (pair? (cdr tree))
+		    (do ((p (cdr tree) (cdr p)))
+			((or (not (pair? p))
+			     (tree-table-car-member set (car p)))
+			 (pair? p)))))))
+
+    (define (maker? tree)
+      (tree-table-car-member makers tree))
+
+    (define (tree-symbol-walk tree syms)
+      (if (pair? tree)
+	  (case (car tree)
+	    ((quote #_quote)
+	     (if (and (pair? (cdr tree))
+		      (symbol? (cadr tree))
+		      (not (memq (cadr tree) (car syms))))
+		 (tree-symbol-walk (cddr tree) (begin (set-car! syms (cons (cadr tree) (car syms))) syms))))
+	    ((list-values #_list-values)
+	     (if (and (pair? (cdr tree))
+		      (pair? (cadr tree))
+		      (memq (caadr tree) '(quote #_quote))
+		      (symbol? (cadadr tree))
+		      (not (memq (cadadr tree) (cadr syms))))
+		 (tree-symbol-walk (cddr tree) (begin (list-set! syms 1 (cons (cadadr tree) (cadr syms))) syms))))
+	    (else
+	     (tree-symbol-walk (car tree) syms)
+	     (tree-symbol-walk (cdr tree) syms)))))
+
+    (denote (unbegin x)
+      ((if (and (pair? x)
+		(list? (cdr x))
+		(eq? (car x) 'begin))
+	  cdr list)
+       x))
+
+
+    ;; -------- types --------
+
+    (denote (quoted-pair? x)
+      (and (pair? x)
+	   (memq (car x) '(quote #_quote))
+	   (pair? (cdr x))
+	   (pair? (cadr x))))
+
+    (denote (quoted-undotted-pair? x)
+      (and (quoted-pair? x)
+	   (positive? (length (cadr x)))))
+
+    (denote (quoted-null? x)
+      (and (len=2? x)
+	   (memq (car x) '(quote #_quote))
+	   (null? (cadr x))))
+
+    (denote (any-null? x)
+      (or (null? x)
+	  (and (pair? x)
+	       (case (car x)
+		 ((quote #_quote)
+		  (and (pair? (cdr x))
+		       (null? (cadr x))))
+		 ((list)
+		  (null? (cdr x)))
+		 ;; no hits (in this context): (make-list 0 ...) (string->list "") (vector->list #()) (reverse ()) (copy ()) (append ()) (append)
+		 (else #f)))))
+
+    (denote (quoted-not? x)
+      (and (len=2? x)
+	   (memq (car x) '(quote #_quote))
+	   (not (cadr x))))
+
+    (denote (quoted-symbol? x)
+      (and (pair? x)
+	   (memq (car x) '(quote #_quote))
+	   (pair? (cdr x))
+	   (symbol? (cadr x))))
+
+    (define constant-expression?
+      (let ((constant-functions (let ((ht (make-hash-table)))
+				  (for-each
+				   (lambda (op)
+				     (set! (ht op) #t))
+				   '(* + - / < <= = > >=
+				     abs acos acosh and angle append aritable? arity ash asin asinh assoc assq assv atan atanh
+				     begin boolean? byte? byte-vector byte-vector?
+				     caaaar caaadr caaar caadar caaddr caadr caar cadaar cadadr cadar caddar cadddr caddr cadr
+				     c-pointer c-pointer? c-object? c-object-type car case cdaaar cdaadr cdaar cdadar cdaddr cdadr cdar cddaar cddadr
+				     cddar cdddar cddddr cdddr cddr cdr ceiling char->integer char-alphabetic? char-ci<=?
+				     char-ci<? char-ci=? char-ci>=? char-ci>? char-downcase char-lower-case? char-numeric?
+				     char-position char-upcase char-upper-case? char-whitespace? char<=? char<?
+				     char=? char>=? char>? char? complex complex? cons continuation? cos constant?
+				     cosh cyclic-sequences
+				     denominator dilambda?
+				     eof-object? eq? equal? eqv? even? exact->inexact exact? exp expt
+				     float? float-vector-ref float-vector? floor
+				     gcd gensym?
+				     hash-table-entries hash-table-ref hash-table?
+				     imag-part immutable? inexact->exact inexact? infinite? inlet input-port?
+				     int-vector-ref int-vector? iterator-at-end? iterator-sequence integer->char
+				     integer-decode-float integer-length integer? iterator?
+				     keyword->symbol keyword?
+				     lcm let->list length let-ref let? list-ref
+				     list-tail list? log logand logbit? logior lognot logxor
+				     macro? magnitude make-polar
+				     make-rectangular max member memq memv min modulo equivalent?
+				     nan? negative? not null? number->string number? numerator
+				     object->string odd? openlet? or output-port?
+				     pair? port-closed? positive?
+				     setter signature procedure? proper-list? provided?
+				     quote #_quote quotient
+				     random-state? rational? rationalize real-part real? remainder reverse round
+				     sequence? sin sinh square sqrt string->number string->symbol
+				     string-ci<=? string-ci<? string-ci=? string-ci>=? string-ci>? string-downcase string-length
+				     string-position string-ref string-upcase string<=? string<? string=? string>=? string>? string?
+				     sublet substring  subvector? symbol symbol->keyword symbol->string symbol? syntax?
+				     tan tanh tree-leaves tree-memq truncate
+				     unspecified? undefined?
+				     vector-dimensions vector-dimension vector-length vector-ref vector?
+				     zero?))
+				  ht)))
+	(lambda (val env)
+	  (or (code-constant? val)
+	      (and (pair? val)
+		   (hash-table-ref constant-functions (car val))
+		   (not (var-member (car val) env))
+		   (just-code-constants? (cdr val)))))))
+
+
+    ;; -------- func info --------
+    (define (arg-signature fnc e)
+      (and (symbol? fnc)
+	   (let ((fd (var-member fnc e)))
+	     (if fd
+		 (and (symbol? (var-ftype fd))
+		      (var-signature fd))
+		 (signature (symbol->value fnc))))))
+
+    (define (arg-arity fnc env)
+      (and (symbol? fnc)
+	   (cond ((var-member fnc env) => var-arity)
+		 (else
+		  (let ((f (symbol->value fnc (rootlet))))
+		    (and (procedure? f)
+			 (arity f)))))))
+
+    (define (dummy-func caller form f)
+      (catch #t
+	(lambda ()
+	  (eval f))
+	(lambda args
+	  (lint-format "in ~A, ~A" caller
+		       (truncated-list->string form)
+		       (apply format #f (cadr args))))))
+
+    (define (count-values body)
+      (let ((mn #f)
+	    (mx #f))
+	(if (pair? body)
+	    (let counter ((ignored #f) ; 'ignored is for member's benefit
+			  (tree (last-ref body)))
+	      (if (pair? tree)
+		  (if (eq? (car tree) 'values)
+		      (if (pair? (cdr tree))
+			  (let ((args (- (length tree) 1)))
+			    (for-each (lambda (p)
+					(if (and (pair? p)
+						 (eq? (car p) 'values))
+					    (set! args (+ args (length p) -2))))
+				      (cdr tree))
+			    (set! mn (min (or mn args) args))
+			    (set! mx (max (or mx args) args))))
+		      (begin
+			(if (pair? (car tree))
+			    (counter 'values (car tree)))
+			(if (pair? (cdr tree))
+			    (member #f (cdr tree) counter)))))
+	      #f)) ; return #f so member doesn't quit early
+	(and mn (list mn mx))))
+
+
+    (define (get-signature v)
+      (let ((ftype (var-ftype v))
+	    (initial-value (var-initial-value v))
+	    (arglist (var-arglist v))
+	    (env (var-env v)))
+	(let ((body (and (memq ftype '(define define* lambda lambda* let))
+			 (cddr initial-value))))
+	  (and (pair? body)
+	       (let ((sig (let signer ((endb (last-ref body)))
+			    (cond ((not (pair? endb))
+				   (and (not (symbol? endb))
+					(list (->lint-type endb))))
+
+				  ((side-effect? endb env)
+				   (list (case (car endb)
+					   ((display write)
+					    (->lint-type (cadr endb)))
+
+					   ((write-char write-byte string-copy openlet float-vector-set! read-char read-byte
+					    open-output-string open-input-file int-vector-set! dilambda open-input-string
+					    get-output-string read-line newline close-output-port close-input-port coverlet
+					    peek-char open-output-file string->byte-vector read-string file-exists? directory?)
+					    => ->lint-type)
+
+					   (else #t))))
+
+				  ((arg-signature (car endb) env)
+				   => (lambda (a)
+					(and (pair? a)
+					     (list (car a)))))
+				  (else
+				   (let ((len (length endb)))
+				     (case (car endb)
+				       ((if)
+					(and (= len 4)
+					     (let ((a1 (signer (caddr endb)))
+						   (a2 (signer (cadddr endb))))
+					       (and (equal? a1 a2) a1))))
+
+				       ((let let* letrec letrec* unless when with-let let-temporarily with-baffle)
+					(and (> len 2)
+					     (signer (list-ref endb (- len 1)))))
+
+				       ((begin)
+					(and (> len 1)
+					     (signer (list-ref endb (- len 1)))))
+
+				       ((do)
+					(and (> len 2)
+					     (pair? (caddr endb))
+					     (pair? (cdaddr endb)) ; if nil -> unspecified?
+					     (signer (last-ref (cdaddr endb)))))
+
+				       (else #f))))))))
+		 (if (not (pair? sig))
+		     (set! sig (list #t)))
+
+		 (when (and (proper-list? arglist)
+			    (not (any-keywords? arglist)))
+		   (for-each
+		    (lambda (arg)       ; new function's parameter
+		      (set! sig (cons #t sig))
+		      ;; (if (pair? arg) (set! arg (car arg)))
+		      ;; causes trouble when tree-count sees keyword args in s7test.scm
+		      (if (= (lint-tree-count arg body 2) 1)
+			  (let ((p (tree-arg-member arg body)))
+			    (when (pair? p)
+			      (let ((f (car p))
+				    (m (memq arg (cdr p))))
+				(if (pair? m)
+				    (let ((fsig (arg-signature f env)))
+				      (if (pair? fsig)
+					  (let ((chk (catch #t
+						       (lambda ()
+							 (fsig (- (length p) (length m))))
+						       (lambda args #f))))
+					    (if (and (symbol? chk) ; it defaults to #t
+						     (not (memq chk '(integer:any? integer:real?))))
+						(set-car! sig chk)))))))))))
+		    arglist))
+		 (and (lint-any? (lambda (a) (not (eq? a #t))) sig)
+		      (reverse sig)))))))
+
+    (denote (args->proper-list args)
+      (cond ((symbol? args)
+	     (list args))
+	    ((not (pair? args))
+	     ())
+	    ((pair? (car args))
+	     (cons (caar args) (args->proper-list (cdr args))))
+	    ((keyword? (car args))              ; omit :rest et al
+	     (args->proper-list (cdr args)))
+	    (else
+	     (cons (car args) (args->proper-list (cdr args))))))
+
+    (define out-vars
+      (let ((ref ())
+	    (set ()))
+
+	(define (var-walk-body tree e)
+	  (when (pair? tree)
+	    (for-each (lambda (p) (set! e (var-walk p e))) tree)))
+
+	(define (shadowed v e)
+	  (if (and (or (memq v e)
+		       (memq v ref))
+		   (not (memq v set)))
+	      (set! set (cons v set)))
+	  v)
+
+	(define (var-walk tree e)
+	  (if (symbol? tree)
+	      (if (not (or (memq tree e)
+			   (memq tree ref)
+			   (defined? tree (rootlet))))
+		  (set! ref (cons tree ref)))
+	      (when (pair? tree)
+		(if (not (pair? (cdr tree)))
+		    (var-walk (car tree) e)
+		    (if (not (pair? (cddr tree)))
+			(begin
+			  (var-walk (car tree) e)
+			  (var-walk (cadr tree) e))
+			(case (car tree)
+			  ((set! vector-set! list-set! hash-table-set! float-vector-set! int-vector-set!
+				 string-set! let-set! fill! string-fill! list-fill! vector-fill!
+				 reverse! sort! set-car! set-cdr!)
+			   (let ((sym (if (symbol? (cadr tree))
+					  (cadr tree)
+					  (if (pair? (cadr tree)) (caadr tree)))))
+			     (if (not (or (memq sym e) (memq sym set)))
+				 (set! set (cons sym set)))
+			     (var-walk (cddr tree) e)))
+
+			  ((let letrec)
+			   (let* ((named (symbol? (cadr tree)))
+				  (vars (if named
+					    (list (shadowed (cadr tree) e))
+					    ()))
+				  (varlist ((if named caddr cadr) tree)))
+			     (when (pair? varlist)
+			       (for-each (lambda (v)
+					   (when (len>1? v)
+					     (var-walk (cadr v) e)
+					     (set! vars (cons (shadowed (car v) e) vars))))
+					 ((if named caddr cadr) tree)))
+			     (var-walk-body ((if named cdddr cddr) tree) (append vars e))))
+
+			  ((let* letrec*)
+			   (let* ((named (symbol? (cadr tree)))
+				  (vars (if named (list (cadr tree)) ()))
+				  (varlist ((if named caddr cadr) tree)))
+			     (when (pair? varlist)
+			       (for-each (lambda (v)
+					   (when (len>1? v)
+					     (var-walk (cadr v) (append vars e))
+					     (set! vars (cons (shadowed (car v) e) vars))))
+					 varlist))
+			     (var-walk-body ((if named cdddr cddr) tree) (append vars e))))
+
+			  ((case)
+			   (var-walk (cadr tree) e)
+			   (for-each (lambda (c)
+				       (when (pair? c)
+					 (var-walk (cdr c) e)))
+				     (cddr tree)))
+
+			  ((quote #_quote) #f)
+
+			  ((do)
+			   (let ((vars ()))
+			     (when (pair? (cadr tree))
+			       (for-each (lambda (v)
+					   (when (len>1? v)
+					     (var-walk (cadr v) e)
+					     (set! vars (cons (shadowed (car v) e) vars))))
+					 (cadr tree))
+			       (for-each (lambda (v)
+					   (if (len>2? v)
+					       (var-walk (caddr v) (append vars e))))
+					 (cadr tree)))
+			     (var-walk (caddr tree) (append vars e))
+			     (var-walk-body (cdddr tree) (append vars e))))
+
+			  ((lambda lambda*)
+			   (var-walk-body (cddr tree) (append (args->proper-list (cadr tree)) e)))
+
+			  ((define* define-macro define-macro* define-bacro define-bacro*)
+			   (when (pair? (cadr tree))
+			     (set! e (cons (caadr tree) e))
+			     (var-walk-body (cddr tree) (append (args->proper-list (cdadr tree)) e))))
+
+			  ((define define-constant)
+			   (cond ((symbol? (cadr tree))
+				  (var-walk (caddr tree) e)
+				  (set! e (cons (cadr tree) e)))
+				 ((pair? (cadr tree))
+				  (set! e (cons (caadr tree) e))
+				  (var-walk-body (cddr tree) (append (args->proper-list (cdadr tree)) e)))))
+
+			  (else
+			   (var-walk (car tree) e)
+			   (var-walk (cdr tree) e)))))))
+	  e)
+	(lambda (func-name arglist body)
+	  (set! ref ())
+	  (set! set ())
+	  (var-walk body (cons func-name arglist))
+	  (list ref set))))
+
+    (define (get-side-effect v)
+      (let ((ftype (var-ftype v)))
+	(or (not (memq ftype '(define define* lambda lambda* define-public)))
+	    (let ((body (cddr (var-initial-value v)))
+		  (env (var-env v))
+		  (args (cons (var-name v) (args->proper-list (var-arglist v)))))
+	      (let ((outvars (append (cadr (out-vars (var-name v) args body)) args)))
+		;; this should omit lambda and lambda* since reference to the name is a recursive call but
+		;;   then we get an inifinite loop remaking var-side-effect (a bug).
+		(let ((fv (copy v)))
+		  (let-set! (cdr fv) 'side-effect #f)
+		  (set! env (cons fv env)))
+		(any-side-effect? body env outvars))))))
+
+    (denote (tree-subst new old tree)
+      (cond ((equal? old tree)
+	     new)
+
+	    ((not (pair? tree))
+	     tree)
+
+	    ((memq (car tree) '(quote #_quote))
+	     (copy tree))
+
+	    (else (cons (tree-subst new old (car tree))
+			(tree-subst new old (cdr tree))))))
+
+
+    (define (do->make-list caller form original-form var1 var2) ; (var1: (... (+/-)) var2: (... (cons)))
+      (when (and (len=2? (cdr var2))
+		 (len=3? (caddr var1))
+		 (len=3? (caddr var2)))
+	(let ((name1 (car var1))
+	      (name2 (car var2))
+	      (init1 (cadr var1))
+	      (init2 (cadr var2))
+	      (step1 (caddr var1))
+	      (step2 (caddr var2))
+	      ;; (do ((i 0 (+ i 1)) (lst () (cons 1 lst))) ((= i 10) lst)) -> (make-list 10 1)
+	      ;;      name1: i, init1: 0 :step1: (+ i 1), name2: lst, init2: (), step2: (cons 1 lst)
+	      ;;                                          end: (= i 10), result: (lst)
+	      (end (and (pair? (caddr form)) (caaddr form)))
+	      (result (and (pair? (caddr form)) (cdaddr form))))
+
+	  ;; the equivalent named let:
+	  ;; (let loop ((i 0) (lst ())) (if (= i 10) lst (loop (+ i 1) (cons 1 lst))))
+
+	  (when (eq? (car end) 'negative?)
+	    (set! end `(< ,(cadr end) 0)))
+
+	  (when (and (len=1? result)
+		     (eq? name2 (caddr step2))
+		     (eq? name1 (cadr end))
+		     (eq? (car result) name2)
+		     (len=3? end)
+		     (any-null? init2)
+		     (if (eq? (car step1) '+)          ; (+ i 1) or (+ 1 i)
+			 (and (memv 1 step1)
+			      (memq name1 step1)
+			      (memq (car end) '(= >= >)))
+			 (and (eq? name1 (cadr step1)) ; (- i 1)
+			      (eqv? 1 (caddr step1))
+			      (memq (car end) '(= <= <)))))
+
+	    (let ((fill (cadr step2)))
+	      (cond ((or (not (pair? fill))
+			 (memq (car fill) '(quote #_quote))
+			 (not (lint-tree-memq name1 fill))) ; perhaps if (pair? fill) check somehow for changing fill values
+		     (unless (eq? name1 fill) ; "iota" in this case
+		       (let ((len (cond
+				   ((and (integer? init1)
+					 (integer? (caddr end)))
+				    (if (memq (car end) '(> <))
+					(+ (abs (- init1 (caddr end))) 1)
+					(abs (- init1 (caddr end)))))
+
+				   ((eq? (car step1) '+)
+				    (if (eqv? init1 0)
+					(if (eq? (car end) '>)
+					    `(+ ,(caddr end) 1)
+					    (caddr end))
+					(if (eq? (car end) '>)
+					    `(+ (- ,(caddr end) ,init1) 1)
+					    `(- ,(caddr end) ,init1))))
+
+				   ;; else (car step1) is '-
+				   ((eqv? (caddr end) 0)
+				    (if (eq? (car end) '<)
+					`(+ ,init1 1)
+					init1))
+
+				   ((eq? (car end) '<)
+				    `(+ (- ,init1 ,(caddr end)) 1))
+				   (else `(- ,init1 ,(caddr end))))))
+
+			 (lint-format "perhaps ~A~A" caller
+				      (if (and (pair? fill)
+					       (not (memq (car fill) '(quote #_quote))))
+					  (format #f ", (assuming ~S is not problematic), " fill)
+					  "")
+				      (lists->string original-form
+						     `(make-list ,len ,fill))))))
+
+		    ((and (memq (car fill) '(string-ref vector-ref))
+			  (len=3? fill)
+			  (or (eq? (caddr fill) name1)
+			      (equal? (caddr fill) `(- ,name1 1))))
+		     (lint-format "perhaps ~A" caller
+				  (format #f "~A -> ~A" original-form
+					  (if (eq? (car fill) 'string-ref) 'string->list 'vector->list))))
+
+		    ((and (len=2? fill)
+			  (len=3? (cadr fill))
+			  (memq (caadr fill) '(vector-ref string-ref byte-vector-ref float-vector-ref int-vector-ref  list-ref))
+			  (eq? name1 (caddr (cadr fill))))
+		     (lint-format "perhaps ~A" caller
+				  (format #f "~A -> ~A" original-form
+					  `(map ,(car fill) ,(cadadr fill)))))))))))
+
+    (define recursion->iteration
+      (let ((rewrite-map
+	     (lambda (map? name iter sequence form outer-form)
+	       (let* ((new-form (cons 'lambda
+				      (cons (list '<1>)
+					    (let rem ((tree form))
+					      (cond ((not (unquoted-pair? tree))
+						     tree)
+						    ((and (pair? (cdr tree))
+							  (eq? (cadr tree) iter)
+							  (hash-table-ref cxars (car tree)))
+						     => (lambda (cxar)
+							  (if (null? cxar)
+							      '<1>
+							      (list cxar '<1>))))
+						    (else (cons (rem (car tree))
+								(rem (cdr tree)))))))))
+		      (leftovers (lint-tree-memq iter new-form))) ; did we catch every reference to the iter?
+		 (unless leftovers
+		   (if (and map?
+			    (eq? '<1> (caddr new-form)))
+		       (lint-format "perhaps ~A" name (lists->string outer-form (list 'copy sequence)))
+		       (begin
+			 (if (and (len=1? (cddr new-form))
+				  (len=2? (caddr new-form))
+				  (eq? '<1> (cadr (caddr new-form))))
+			     (set! new-form (caaddr new-form)))
+			 (lint-format "perhaps ~A" name
+				      (lists->string outer-form
+						     (if (eq? (car outer-form) 'let) ; named-let, not define
+							 (list (if map? 'map 'for-each) new-form sequence)
+							 (list (car outer-form) (cadr outer-form)
+							       (list (if map? 'map 'for-each) new-form sequence))))))))
+		 (not leftovers)))))
+
+	(lambda (name ftype arglist initial-value env)
+	  ;; look for recursion -> simpler iteration possibilities
+
+	  (when (and (pair? initial-value)
+		     (proper-pair? arglist)
+		     (= (lint-tree-count name (cddr initial-value) 2) 1))
+
+	    (let ((body ((if (memq ftype '(let let*)) cdddr cddr) initial-value))
+		  (for-each-case #f)) ; avoid rewriting twice
+	      (when (and (len=1? body)
+			 (len>1? (car body))
+			 (let ((exprs (cdar body)))
+			   (case (caar body)        ; change body to use if
+			     ((if)                  ; only 1 hit for 2 reversal branches, say 20 hits for 2 ifs + repeated return vals (collapsible) -- see tmp
+			      (len>1? exprs))
+			     ((when)
+			      (and (len>1? exprs)
+				   (set! body `((if ,(car exprs)
+						    ,@(if (null? (cddr exprs))
+							  (cdr exprs)
+							  (list (cons 'begin (cdr exprs)))))))))
+			     ((unless)
+			      (and (len>1? exprs)
+				   (set! body `((if (not ,(car exprs))
+						    ,@(if (null? (cddr exprs))
+							  (cdr exprs)
+							  (list (cons 'begin (cdr exprs)))))))))
+			     ((cond)
+			      (and (<= 1 (length exprs) 2)
+				   (not (lint-tree-memq '=> exprs))
+				   (or (null? (cdr exprs))
+				       (and (pair? (cadr exprs))
+					    (memq (caadr exprs) '(else #t))))
+				   (let ((arg1 (car exprs)))
+				     (and (proper-list? arg1)
+					  (set! body `((if ,(car arg1)
+							   ,@(if (null? (cdr arg1)) '(#t)
+								 (if (null? (cddr arg1)) (cdr arg1)
+								     (list (cons 'begin (cdr arg1)))))
+							   ,@(if (not (= (length exprs) 2))
+								 ()
+								 (let ((arg2 (cdadr exprs)))
+								   (if (null? (cdr arg2))
+								       arg2
+								       `((begin ,@arg2))))))))))))
+			     ((case)
+			      (and (<= 2 (length exprs) 3)
+				   (not (lint-tree-memq '=> exprs))
+				   (let ((selector (car exprs))
+					 (arg1 (cadr exprs))
+					 (rest (cddr exprs)))
+				     (and (or (null? rest)
+					      (and (pair? (car rest))
+						   (eq? 'else (caar rest))))
+					  (set! body `((if (memv ,selector ',(car arg1))
+							   ,@(if (null? (cddr arg1)) (cdr arg1)
+								 (list (cons 'begin (cdr arg1))))
+							   ,@(if (not (pair? rest))
+								 ()
+								 (let ((arg2 (cdar rest)))
+								   (if (null? (cdr arg2))
+								       arg2
+								       `((begin ,@arg2))))))))))))
+
+			     ;; ((and or) (let ((last (last-ref exprs))) (if (and (pair? last) (eq? (car last) name)) (format *stderr* "~S~%" body)) #f))
+			     ;;   -> ((or done? (loop (process-stderr server)))) etc
+			     ;; zillions of or/and (well, 200) -- the problem is the result, and do is not shorter
+			     ;; (if (and (memq (caar body) '(or and)) (pair? (cadar body)) (memq (caadar body) '(= < > <= >=)) (format *stderr* "~A~%~%" (lint-pp body)))
+			     ;; (or (>= i len) (and (x i) (rec (+ i 1))))
+			     ;;   (do ((i 0 (+ i 1))) ((or (>= i len) (not (x i))) (>= i len)))
+			     ;; (and (< i len) (or (x i) (rec (+ i 1))))
+			     ;;   (do ((i 0 (+ i 1))) ((or (= i len) (x i)) (< i len)))
+			     ;; memx here might be shorter if var is a list
+
+			     (else #f))))
+
+		;; (caar body) is 'if
+
+		;; 2 arg map case
+		(when (and (= (length arglist) 2)
+			   (eq? ftype 'let))
+		  (let ((args (caddr initial-value)))
+		    (let ((iter (car args))
+			  (res (cadr args)))
+
+		      (when (and (len>1? iter)
+				 (any-null? (cadr iter)))
+			(set! iter (cadr args))
+			(set! res (car args)))
+
+		      (when (and (len=2? res)
+				 (any-null? (cadr res))
+				 (<= 2 (lint-tree-count (car res) body 4) 3))
+
+			(let ((nf (cdar body)))       ;((null? lst) (reverse...) (loop ...))
+			  (when (and (len>2? nf)
+				     (pair? (car nf))
+				     (memq (caar nf) '(null? not pair?))) ; no hits for list? or eq?+any-null?
+			    (let ((cdrf #f)
+				  (recur #f)
+				  (iter-name (car iter))
+				  (res-name (car res)))
+
+			      ;; the wrapper case [(cons (reverse res) ...) at the end] in non-problematic code gets about 10 hits
+			      (when (and (or (and (len=2? (cadr nf))
+						  (memq (caadr nf) '(reverse reverse!))
+						  (eq? (cadadr nf) res-name)
+						  (or (equal? (car nf) (list 'null? iter-name))
+						      (equal? (car nf) (list 'not (list 'pair? iter-name))))
+						  (set! cdrf (caddr nf)))
+					     (and (len=2? (caddr nf))
+						  (memq (caaddr nf) '(reverse reverse!))
+						  (eq? (cadr (caddr nf)) res-name)
+						  (or (equal? (car nf) (list 'not (list 'null? iter-name)))
+						      (equal? (car nf) (list 'pair? iter-name)))
+						  (set! cdrf (cadr nf))))
+					 (pair? cdrf)
+					 ;; here the end test looks ok, and its branch reverses the apparent result
+					 ;;   cdrf is the other branch
+					 (or (and (eq? name (car cdrf))
+						  (set! recur cdrf))
+					     (and (memq (car cdrf) '(begin let let*))
+						  (let ((ret (last-ref cdrf)))
+						    (and (pair? ret)
+							 (eq? name (car ret))
+							 (set! recur ret)))))   ; recur is the looper
+					 (len=3? recur)
+					 (or (and (eq? iter-name (caar args)) ; order should be (cdr iter) res
+						  (equal? (cadr recur) (list 'cdr iter-name))
+						  (set! recur (caddr recur)))
+					     (and (eq? res-name (caar args)) ; order should be res (cdr iter)
+						  (equal? (caddr recur) (list 'cdr iter-name))
+						  (set! recur (cadr recur)))))
+				;; now recur is the portion that conses up the growing list
+				;;   it can be (cons ... res) or some variant thereof
+				;;   (append ... res) -> (values ...), res by itself -> (values)
+				;; so whatever recur has, its only return exprs are (cons|append ... res) or res
+				;;   but what about the body above? -- we have (body ... recur) and need to edit just recur
+				;; if (eq? name (car cdrf)) return edited recur else (body[-1]+edited recur)
+
+				(let ((nmap (call-with-exit
+					     (lambda (quit)
+					       (let subst ((tree recur))
+						 (cond ((eq? tree res-name)
+							(quit #f))
+
+						       ((not (unquoted-pair? tree))
+							tree)
+
+						       ((and (eq? (car tree) 'cons)
+							     (eq? res-name (caddr tree)))
+							(cadr tree))
+
+						       ((eq? (car tree) 'append)
+							(if (and (len=3? tree)
+								 (eq? (caddr tree) res-name))
+							    (list 'apply 'values (cadr tree))
+							    (quit #f)))
+
+						       ((and (eq? (car tree) 'if)
+							     (len=3? (cdr tree))
+							     (not (lint-tree-memq res-name (cadr tree)))
+							     (lint-tree-memq res-name (cddr tree)))
+							(list 'if (cadr tree)
+							      (if (eq? (caddr tree) res-name)
+								  '(values)
+								  (subst (caddr tree)))
+							      (if (eq? (cadddr tree) res-name)
+								  '(values)
+								  (subst (cadddr tree)))))
+
+						       (else (cons (subst (car tree))
+								   (subst (cdr tree))))))))))
+				  (if (pair? nmap)
+				      (set! for-each-case (rewrite-map #t name iter-name (cadr iter)
+								       (if (eq? (car cdrf) name)
+									   (copy (unbegin nmap))
+									   (tree-subst nmap recur cdrf))
+								       initial-value))))))))))))
+		;; for two arg for-each gets about a dozen hits
+
+		;; one arg...
+		(when (null? (cdr arglist))
+		  ;; recursion -> for-each and map
+
+		  (let ((nf (cdar body))
+			(sequence (case (car initial-value)
+				    ((let let*) ; named-let, not define
+				     (let ((args (cdar (caddr initial-value))))
+				       (and (pair? args)
+					    (car args))))
+				    ((lambda lambda*)
+				     (caadr initial-value))
+				    (else (cadadr initial-value)))))
+
+		    (when (len>1? nf)
+		      (when (and (pair? (cddr nf))
+				 (pair? (car nf))
+				 (memq (caar nf) '(null? not pair?)))
+			;; recursion -> map
+			(let ((cdrf #f)
+			      (iter (car arglist)))
+			  (when (and (or (and (or (any-null? (cadr nf))
+						  (eq? (cadr nf) iter)) ; actually, if (not (pair? iter)) this will not be null -- no hits
+					      (or (equal? (car nf) (list 'null? iter))
+						  (equal? (car nf) (list 'not (list 'pair? iter))))
+					      (set! cdrf (caddr nf)))
+					 (and (or (any-null? (caddr nf))
+						  (eq? (caddr nf) iter))
+					      (or (equal? (car nf) (list 'not (list 'null? iter)))
+						  (equal? (car nf) (list 'pair? iter)))
+					      (set! cdrf (cadr nf))))
+				     (pair? cdrf)
+				     (case (car cdrf)
+				       ((cons)
+					(and (len>1? (cdr cdrf))
+					     (equal? (caddr cdrf) (list name (list 'cdr iter)))))
+
+				       ((let) ; this only get 5 hits
+					(and (len=1? (cadr cdrf))
+					     (len=1? (cddr cdrf))
+					     (len=3? (caddr cdrf))
+					     (eq? (caaddr cdrf) 'cons)
+					     (len>1? (cdaddr cdrf))
+					     (equal? (cadr (caadr cdrf)) (list 'car iter))
+					     (equal? (caddr (caddr cdrf)) (list name (list 'cdr iter)))
+					     (set! cdrf (list 'cons
+							      (tree-subst (list 'car iter) (caaadr cdrf) (cadr (caddr cdrf)))
+							      (caddr (caddr cdrf))))))
+
+				       (else #f)))
+			    (set! for-each-case (rewrite-map #t name iter sequence
+							     (copy (unbegin (cadr cdrf)))
+							     initial-value)))))
+
+		      (let ((iters ()))
+			;; recursion -> for-each
+			(when (and (null? (cddr nf))
+				   (let ((lst (cadr nf))
+					 (find-iter (lambda (args)
+						      (lint-any? (lambda (p)
+								   (and (pair? p)
+									(eq? (car p) 'cdr)
+									(let ((sym (cadr p)))
+									  (and (symbol? sym)
+									       (set! iters (cons sym iters))))))
+								 args))))
+				     (and (pair? lst)
+					  (or (and (eq? name (car lst))
+						   (find-iter (cdr lst)))
+					      (and (memq (car lst) '(begin when unless let let*))
+						   (let ((ret (last-ref lst)))
+						     (and (pair? ret)
+							  (eq? name (car ret))
+							  (find-iter (cdr ret))))))))
+				   (len=1? iters)
+				   (eq? (car iters) (car arglist))
+				   (or (equal? (car nf) (list 'pair? (car iters)))
+				       (equal? (car nf) (list 'not (list 'null? (car iters))))))
+			  (set! for-each-case (rewrite-map #f name
+							   (car iters) sequence
+							   (unbegin (copy (cadr nf) (make-list (- (length (cadr nf)) 1))))
+							   initial-value)))))))
+
+		;; any number of args here, still if-based as above
+		;;
+		;; recursion->do
+		;;   (n ((a b) (c d)) (if .1. (begin .2. (n (+ a 1) (cdr c))) .3.)) -> (do ((a b (+ a 1)) (c d (cdr c))) ((not .1.) .3.) .2.)
+		;;   (n ((a b)) (if .1. .2. (begin .3. (n (f a))))) -> (do ((a b (f a))) (.1. .2.) .3.)
+		;;
+		;; if (define loop (lambda ...)), then initial-value is (lambda ...)
+		;;   but name is :lambda -- define-walker around 12440 catches this case and gives true name, so it calls this function
+
+		(unless for-each-case                   ; one rewrite is enough
+		  (let ((f (cdar body)))
+		    (let ((end-test (car f))            ; assume (if test result recur)
+			  (result (cadr f))
+			  (do-body (if (pair? (cddr f))
+				       (caddr f)
+				       (list 'begin)))) ; assume end in rewrite below is ,@(unbegin...)
+
+		      (when (lint-tree-memq name result)     ; flip above assumption: (if test recur result)
+			(set! end-test (simplify-boolean (list 'not end-test) () () env))
+			(let ((old-res result))
+			  (set! result do-body)
+			  (set! do-body old-res)))
+
+		      (when (and (pair? do-body)
+				 (< (lint-tree-leaves result) 50))
+			(let ((call (if (eq? (car do-body) name)
+					do-body
+					(and (eq? (car do-body) 'begin)
+					     (let ((lp (last-ref do-body)))
+					       (and (pair? lp)
+						    (eq? (car lp) name)
+						    lp))))))
+			  (when (and (pair? call)
+				     (pair? (cdr call))
+				     ;; now check arglist/call -- each arg just current name or outer vars [leaving aside car]
+				     (or (and (null? (cddr call))
+					      (null? (cdr arglist)))
+					 (let check-iters ((pars arglist) (args (cdr call)))
+					   (if (null? pars)
+					       (null? args)
+					       (and (pair? args)
+						    (let ((par ((if (pair? (car pars)) caar car) pars)))
+						      (and (not (memq (car args) (remove-one par arglist)))
+							   (not (lint-tree-set-memq (remove-one par arglist) (car args)))
+							   (check-iters (cdr pars) (cdr args)))))))))
+			    (let ((do-loop `(do ,(map (lambda (par init arg)
+							(let ((var (if (pair? par) (car par) par)))
+							  (if (eq? var arg)
+							      (list var
+								    (if (len>1? init) (cadr init) init))
+							      (list var
+								    (if (len>1? init) (cadr init) init)
+								    arg))))
+						      arglist
+						      (if (memq ftype '(let let*))
+							  (caddr initial-value)
+							  (map (lambda (p)
+								 (if (pair? p)
+								     (car p)
+								     p))
+							       arglist))
+						      (cdr call))
+						(,end-test ,@(unbegin result))
+					      ,@(if (eq? (car do-body) name)
+						    ()
+						    (unbegin (copy do-body (make-list (- (length do-body) 1))))))))
+			      (lint-format "perhaps ~A" name
+					   (lists->string initial-value
+							  (if (memq ftype '(let let*))
+							      do-loop
+							      (list (car initial-value) (cadr initial-value) do-loop))))
+
+			      (when (and (len=2? arglist)
+					 (null? (cdddr do-loop))) ; no body
+				(let ((var1 (caadr do-loop)))
+				  (if (and (len=2? (cdr var1))
+					   (pair? (caddr var1))
+					   (eq? (caaddr var1) 'cons))
+				      (do->make-list name do-loop initial-value (cadadr do-loop) var1)
+				      (let ((var2 (cadadr do-loop)))
+					(if (and (len=2? (cdr var2))
+						 (pair? (caddr var2))
+						 (eq? (caaddr var2) 'cons))
+					    (do->make-list name do-loop initial-value var1 var2))))))
+			      )))))))))))))
+
+    (define (improper-arglist->define* name ftype arglist initial-value)
+      ;; look for define/lambda -> define*/lambda*
+
+      (when (and (or (symbol? arglist)
+		     (and (pair? arglist)
+			  (not (proper-list? arglist)))) ; can't be named-let
+		 (memq ftype '(define lambda))
+		 (len=1? (cddr initial-value)))
+	(let ((body (caddr initial-value)))
+	  (when (and (len>1? body)
+		     (memq (car body) '(let let*))
+		     (pair? (cadr body)))
+	    (let* ((rest-name (if (symbol? arglist)
+				  arglist
+				  (list-tail arglist (abs (length arglist)))))
+		   (rest-refs (tree-count rest-name body 3)))
+
+	      (when (= rest-refs 2) ; more refs for added optargs got few hits (and they were riddled with mistakes)
+		(let ((var1 (caadr body))
+		      (default-value :unset))
+		  (when (and (len>1? var1)
+			     (pair? (cadr var1)))
+		    (let ((value (cadr var1)))
+		      (when (and (eq? (car value) 'if) ; cond (in ((null? rest) defval) (else (car rest))) gets 3 hits
+				 (len=3? (cdr value)))
+			(let ((test (cadr value))
+			      (access (list 'car rest-name)))
+			  (if (and (equal? (cadddr value) access)
+				   (or (equal? test (list 'null? rest-name))
+				       (equal? test (list 'not (list 'pair? rest-name)))))
+			      (set! default-value (caddr value))
+			      (if (and (equal? (caddr value) access)
+				       (or (equal? test (list 'pair? rest-name))
+					   (equal? test (list 'not (list 'null? rest-name)))
+					   (eq? test rest-name)   ; actually incorrect but it happens
+					   (equal? test access))) ; same
+				  (set! default-value (cadddr value))))
+			  (unless (eq? default-value :unset)
+			    (let ((new-arglist (if (symbol? arglist)
+						   (list (if default-value
+							     (list (car var1) default-value)
+							     (car var1)))
+						   (append (copy arglist (make-list (abs (length arglist))))
+							   (list (if default-value ; #f is default
+								     (list (car var1) default-value)
+								     (car var1))))))
+				  (new-body (if (null? (cdadr body))               ; 0 other vars
+						'...
+						(list (if (or (eq? (car body) 'let)
+							      (null? (cddadr body)))  ; 1 other var
+							  'let 'let*)
+						      (cdadr body)
+						      '...))))
+			      ;; we're assuming that trailing args are a mistake -- we could add :rest or something to allow them
+			      (lint-format "perhaps ~A" name
+					   (lists->string initial-value
+							  (if (eq? (car initial-value) 'define)
+							      (list 'define* (cons (caadr initial-value) new-arglist)
+								    new-body)
+							      (list 'lambda* new-arglist
+								    new-body)))))))))))))))))
+
+    (define form->arity
+      (let ((max-arity 536870912))
+	(lambda (form)
+	  ;; this ignores non-s7 keywords and the like (#!optional :: etc), treating them as parameter names
+	  (and (pair? form)
+	       (case (car form)
+		 ((lambda)
+		  (cond ((list? (cadr form))
+			 (let ((len (length (cadr form))))
+			   (if (negative? len)
+			       (cons (abs len) max-arity)
+			       (cons len len))))
+			((symbol? (cadr form))
+			 (cons 0 max-arity))
+			(else #f)))
+
+		 ((define define-constant define-macro define-bacro)
+		  (cond ((list? (cdadr form))
+			 (let ((len (length (cdadr form))))
+			   (if (negative? len)
+			       (cons (abs len) 536870912)
+			       (cons len len))))
+			((symbol? (cdadr form))
+			 (cons 0 max-arity))
+			(else #f)))
+
+		 ((let)                              ; let = named let
+		  (let ((len (length (caddr form))))
+		    (cons len len)))
+
+		 ((let*)
+		  (cons 0 (length (caddr form))))
+
+		 ((lambda*)
+		  (let ((args (cadr form)))
+		    (cond ((list? args)
+			   (let ((len (length args))
+				 (rest (or (memq :rest args)
+					   (memq :allow-other-keys args))))
+			     (cons 0 (if (or rest (negative? len))
+					 max-arity
+					 len))))
+			  ((symbol? args)
+			   (cons 0 max-arity))
+			  (else #f))))
+
+		 ((define* define-macro* define-bacro*)
+		  (let ((args (cdadr form)))
+		    (cond ((list? args)
+			   (let ((len (length args))
+				 (rest (or (memq :rest args)
+					   (memq :allow-other-keys args))))
+			     (cons 0 (if (or rest (negative? len))
+					 max-arity
+					 len))))
+			  ((symbol? args)
+			   (cons 0 max-arity))
+			  (else #f))))
+
+		 ((defmacro)
+		  (cond ((list? (caddr form))
+			 (let ((len (length (caddr form))))
+			   (if (negative? len)
+			       (cons (abs len) max-arity)
+			       (cons len len))))
+			((symbol? (caddr form))
+			 (cons 0 max-arity))
+			(else #f)))
+
+		 (else #f))))))
+
+    (define (report-shadower caller head vtype v expr env)
+      (when (symbol? v)
+	(if (var-member v env)
+	    (lint-format "~A ~A ~A in ~S shadows an earlier declaration" caller head vtype v expr)
+	    (if (defined? v (rootlet))
+		(lint-format "~A ~A ~A shadows built-in ~A" caller head vtype v v)))))
+
+    (define (make-fvar name ftype arglist initial-value env)
+      (when (and *report-recursion->iteration* (not (keyword? name)))
+	(recursion->iteration name ftype arglist initial-value env))
+      (improper-arglist->define* name ftype arglist initial-value)
+
+      (when *report-shadowed-variables*
+	(for-each (lambda (v)
+		    (report-shadower ftype name 'parameter v arglist env))
+		  (args->proper-list arglist)))
+
+      (let ((new (let ((old (hash-table-ref other-identifiers name))
+		       (allow-keys (and (pair? arglist)
+					(memq ftype '(define* define-macro* define-bacro* defmacro*))
+					(eq? (last-ref arglist) :allow-other-keys)))
+		       (nv (and (pair? initial-value)
+				(lint-tree-memq 'values initial-value)
+				(count-values (cddr initial-value)))))
+		   (let ((hist (if old
+				   (begin
+				     (hash-table-set! other-identifiers name #f) ; remove name
+				     (if initial-value (cons initial-value old) old))
+				   (if initial-value (list initial-value) ())))
+			 (rf (if old (length old) 0))
+			 (ar (form->arity initial-value)))
+		     (cons name
+			   (inlet 'history hist
+				  'ref rf
+				  'ftype ftype
+				  'scope ()
+				  'initial-value initial-value
+				  'set 0
+				  'refenv ()
+				  'env env
+				  'sig ()
+				  'arglist arglist
+				  'side-effect ()
+				  'setters ()
+				  'arit ar
+				  'retcons #f
+				  'nvalues nv
+				  'allow-other-keys allow-keys))))))
+	(reduce-function-tree new env)
+	new))
+
+    (define (return-type sym e)
+      (let ((sig (arg-signature sym e)))
+	(and (pair? sig)
+	     (or (eq? (car sig) 'values) ; turn it into #t for now
+		 (car sig)))))           ; this might be undefined in the current context (eg oscil? outside clm)
+
+    (define any-macro?
+      (let ((macros (let ((h (make-hash-table)))
+		      (for-each
+		       (lambda (m)
+			 (set! (h m) #t))
+		       '(call-with-values let-values define-values let*-values cond-expand require quasiquote
+			 multiple-value-bind reader-cond match while))
+		      h)))
+	(lambda (f env)
+	  (or (hash-table-ref macros f)
+	      (let ((fd (var-member f env)))
+		(and fd
+		     (memq (var-ftype fd) '(define-macro define-macro* define-expansion
+					    define-bacro define-bacro* defmacro defmacro* define-syntax))))))))
+
+    (define (any-procedure? f v)
+      (or (hash-table-ref built-in-functions f)
+	  (and v (memq (var-ftype v) '(define define* lambda lambda*))))) ; this order seems a bit faster
+
+    (define ->simple-type
+      (let ((markers (list (cons :call/exit 'continuation?)
+			   (cons :call/cc 'continuation?)
+			   (cons :dilambda 'dilambda?)
+			   (cons :lambda 'procedure?))))
+	(lambda (c)
+	  (case (type-of c)
+	    ((symbol?)
+	     (or (not (keyword? c))
+		 (cond ((assq c markers) => cdr)
+		       (else 'keyword?))))
+	    ((procedure?)
+	     (if (dilambda? c) 'dilambda? 'procedure?))
+	    (else)))))
+
+    (define (define->type c)
+      (and (pair? c)
+	   (case (car c)
+	     ((define)
+	      (or (not (pair? (cdr c)))
+		  (if (pair? (cadr c))
+		      'procedure?
+		      (and (pair? (cddr c))
+			   (->lint-type (caddr c))))))
+	     ((define* lambda lambda* case-lambda) 'procedure?)
+	     ((dilambda) 'dilambda?)
+	     ((define-macro define-macro* define-bacro define-bacro* defmacro defmacro* define-expansion) 'macro?)
+	     ((:call/cc :call/exit) 'continuation?)
+	     (else #t))))
+
+    (define (->lint-type c)
+      ;(format *stderr* "lint-type ~S~%" c)
+      (cond ((not (pair? c))	        (->simple-type c))
+	    ((procedure? (car c))       (return-type (car c) ()))     ; (#_abs ...)
+	    ((and (not (symbol? (car c))) (not (eq? (car c) #_quote))) (or (sequence? (car c)) 'pair?))
+	    ((not (memq (car c) '(quote #_quote))) (or (return-type (car c) ()) (define->type c)))
+	    ((not (pair? (cdr c)))      (->simple-type c)) ; ??
+	    ((symbol? (cadr c))         'symbol?)
+	    (else                       (->simple-type (cadr c)))))   ; don't look for return type!
+
+    (define (compatible? type1 type2) ; we want type1, we have type2 -- is type2 ok?
+      (or (eq? type1 type2)
+	  (not (and (symbol? type1)
+		    (symbol? type2)
+		    (hash-table-ref booleans type1)
+		    (hash-table-ref booleans type2)))
+	  (case type1
+	    ((number? complex?)  (memq type2 '(float? real? rational? integer? number? complex? exact? inexact? zero? negative? positive? even? odd? infinite? nan? byte?)))
+	    ((real?)             (memq type2 '(float? rational? integer? complex? number? exact? inexact? zero? negative? positive? even? odd? infinite? nan? byte?)))
+	    ((zero?)             (memq type2 '(float? real? rational? integer? number? complex? exact? inexact? even? byte?)))
+	    ((negative? positive?) (memq type2 '(float? real? rational? integer? complex? number? exact? inexact? even? odd? infinite? nan?)))
+	    ((float?)            (memq type2 '(real? complex? number? inexact? zero? negative? positive? infinite? nan?)))
+	    ((rational?)         (memq type2 '(integer? real? complex? number? exact? zero? negative? positive? even? odd? byte?)))
+	    ((integer?)          (memq type2 '(real? rational? complex? number? exact? even? odd? zero? negative? positive? byte?)))
+	    ((odd? even?)        (memq type2 '(real? rational? complex? number? exact? integer? zero? negative? positive? byte?)))
+	    ((exact?)            (memq type2 '(real? rational? complex? number? integer? zero? negative? positive? odd? even? byte?)))
+	    ((inexact?)          (memq type2 '(real? number? complex? float? zero? negative? positive? infinite? nan?)))
+	    ((infinite? nan?)    (memq type2 '(real? number? complex? positive? negative? inexact? float?)))
+	    ((vector?)           (memq type2 '(float-vector? int-vector? byte-vector? sequence? subvector?)))
+	    ((float-vector? int-vector? byte-vector? subvector?) (memq type2 '(vector? sequence? subvector?)))
+	    ((sequence?)         (memq type2 '(list? pair? null? proper-list? vector? float-vector? int-vector? byte-vector? tree-cyclic? openlet? subvector?
+					       string? let? hash-table? iterator? procedure? directory? file-exists?))) ; procedure? for extended iterator
+	    ((symbol?)           (memq type2 '(gensym? keyword? defined? provided?)))
+	    ((string?)           (memq type2 '(sequence? directory? file-exists?)))
+	    ((not)               (eq? type2 'boolean?))
+	    ((output-port? boolean?) (eq? type2 'not))
+	    ((keyword? gensym?)  (memq type2 '(symbol? defined? provided?)))
+	    ((defined?)          (memq type2 '(symbol? provided? keyword?)))
+	    ((list?)             (memq type2 '(null? pair? proper-list? sequence? tree-cyclic?)))
+	    ((proper-list?)      (memq type2 '(null? pair? list? sequence? tree-cyclic?)))
+	    ((pair?)             (memq type2 '(list? proper-list? sequence? tree-cyclic?)))
+	    ((null?)             (memq type2 '(list? proper-list? sequence?)))
+	    ((dilambda?)         (memq type2 '(procedure? macro? iterator?)))
+	    ((procedure?)        (memq type2 '(dilambda? iterator? macro? sequence? continuation?)))
+	    ((macro?)            (memq type2 '(dilambda? iterator? procedure?)))
+	    ((continuation?)     (eq? type2 'procedure?))
+	    ((iterator?)         (memq type2 '(dilambda? procedure? sequence?))); iterator-at-end?)))
+	    ((let?)              (memq type2 '(defined? sequence? openlet?)))
+	    ((openlet?)          (memq type2 '(let? c-pointer? macro? procedure? sequence? defined? undefined?)))
+	    ((hash-table?)       (eq? type2 'sequence?))
+	    ((char? char-whitespace? char-numeric? char-alphabetic? char-upper-case? char-lower-case?)
+	     (memq type2 '(char? char-whitespace? char-numeric? char-alphabetic? char-upper-case? char-lower-case?)))
+	    ((tree-cyclic?)      (memq type2 '(list? pair? sequence?)))
+	    ((provided?)         (memq type2 '(defined? symbol?)))
+	    ((directory?)        (memq type2 '(string? sequence? file-exists?)))
+	    ((file-exists?)      (memq type2 '(string? sequence? directory?)))
+	    ;;((iterator-at-end?)  (memq type2 '(iterator? sequence?)))
+	    (else #f))))
+
+    (define (any-compatible? type1 type2)
+      ;; type1 and type2 can be either a list of types or a type
+      (if (symbol? type1)
+	  (if (symbol? type2)
+	      (compatible? type1 type2)
+	      (and (pair? type2)
+		   (or (compatible? type1 (car type2))
+		       (any-compatible? type1 (cdr type2)))))
+	  (and (pair? type1)
+	       (or (compatible? (car type1) type2)
+		   (any-compatible? (cdr type1) type2)))))
+
+    (define (subsumes? type1 type2)
+      (or (eq? type1 type2)
+	  (case type1
+	    ((integer?)         (memq type2 '(even? odd?)))
+	    ((rational?)        (memq type2 '(integer? byte? exact? odd? even?)))
+	    ((exact?)           (memq type2 '(integer? byte? rational?)))
+	    ((real?)            (memq type2 '(integer? byte? rational? float? negative? positive? zero? odd? even?)))
+	    ((complex? number?) (memq type2 '(integer? byte? rational? float? real? complex? number? negative? positive? zero?
+					      even? odd? exact? inexact? nan? infinite?)))
+	    ((list?)            (memq type2 '(pair? null? proper-list?)))
+	    ((proper-list?)     (eq? type2 'null?))
+	    ((vector?)          (memq type2 '(float-vector? int-vector? byte-vector?)))
+	    ((symbol?)          (memq type2 '(keyword? gensym?))) ; defined? provided? ??
+	    ((sequence?)        (memq type2 '(list? pair? null? proper-list? vector?  subvector? float-vector? int-vector? byte-vector?
+					      string? let? hash-table? directory? file-exists?)))
+	    ((char?)            (memq type2 '(char-whitespace? char-numeric? char-alphabetic? char-upper-case? char-lower-case?)))
+	    ((iterator)         (eq? type2 'iterator-at-end?))
+	    (else #f))))
+
+    (define (never-false expr)
+      (or (eq? expr #t)
+	  (let ((type (if (pair? expr)
+			  (return-type (car expr) ())
+			  (->lint-type expr))))
+	    (or (and (symbol? type)
+		     (not (symbol? expr))
+		     (not (memq type '(not boolean? values))))
+		(not (or (not (pair? type))
+			 (memq #t type)
+			 (memq 'boolean? type)
+			 (memq 'not type)
+			 (memq 'values type)))))))
+
+    (define (never-true expr)
+      (or (not expr)
+	  (and (len>1? expr)
+	       (eq? (car expr) 'not)
+	       (never-false (cadr expr)))))
+
+    (define (prettify-checker-unq op)
+      (if (pair? op)
+	  (string-append (prettify-checker-unq (car op)) " or " (prettify-checker-unq (cadr op)))
+	  (case op
+	    ((rational?) "rational")
+	    ((real?)     "real")
+	    ((complex?)  "complex")
+	    ((null?)     "null")
+	    ((length)    "a sequence")
+	    ((unspecified?) "untyped")
+	    ((undefined?) "not defined")
+	    ((not)        "#f")
+	    (else
+	     (let ((op-name (symbol->string op)))
+	       (string-append (if (memv (op-name 0) '(#\a #\e #\i #\o #\u)) "an " "a ")
+			      (substring op-name 0 (- (length op-name) 1))))))))
+
+    (define (prettify-checker op)
+      (if (pair? op)
+	  (string-append (prettify-checker-unq (car op)) " or " (prettify-checker (cadr op)))
+	  (case op
+	    ((rational?) "rational?")
+	    ((real?)     "real?")
+	    ((complex?)  "complex?")
+	    ((null?)     "null?")
+	    ((unspecified?) "untyped")
+	    ((undefined?) "not defined")
+	    ((not)        "#f")
+	    (else
+	     (let ((op-name (symbol->string op)))
+	       (string-append (if (memv (op-name 0) '(#\a #\e #\i #\o #\u)) "an " "a ") op-name))))))
+
+    (define (side-effect-with-vars? form env vars)
+      ;; could evaluation of form have any side effects (like IO etc)
+      ;;   vars is not null only in get-side-effect which is checking a function (in var-side-effect)
+      (if (or (not (proper-list? form))                   ; we don't want dotted lists or () here
+	      (null? form))
+
+	  (and (symbol? form)
+	       (or (eq? form '=>)                         ; (cond ((x => y))...) -- someday check y...
+		   (let ((e (var-member form env)))
+		     (if e
+			 (and (symbol? (var-ftype e))
+			      (var-side-effect e))
+			 (and (not (hash-table-ref no-side-effect-functions form))
+			      (procedure? (symbol->value form *e*))))))) ; i.e. function passed as argument
+
+	  ;; can't optimize ((...)...) because the car might eval to a function
+	  (or (and (not (hash-table-ref no-side-effect-functions (car form))) ; includes quote, let, etc
+		   ;; if it's not in the no-side-effect table and ...
+
+		   (let ((e (var-member (car form) env)))
+		     (or (not e)
+			 (not (symbol? (var-ftype e)))
+			 (var-side-effect e)))
+
+		   (or (not (eq? (car form) 'format))              ; (format #f ...)
+		       (not (pair? (cdr form)))                    ; (format)!
+		       (cadr form))
+
+		   (or (null? vars)
+		       (not (memq (car form) '(set! define define* define-macro define-macro* define-bacro define-bacro*)))))
+
+	      ;; it's not the common (format #f ...) special case, then...(goto case below)
+	      ;; else return #t: side-effects are possible -- this is too hard to read
+	      (case (car form)
+
+		((define-constant define-expansion) #t)
+
+		((define define* define-macro define-macro* define-bacro define-bacro*
+		  quote)
+		 #f) ;; was (null? vars) which (leaving aside quote) is never the case (see above)
+
+		((set!)
+		 (or (not (pair? (cdr form)))
+		     (not (symbol? (cadr form)))
+		     (memq (cadr form) vars)))
+
+		((case)
+		 (or (not (pair? (cdr form)))
+		     (side-effect-with-vars? (cadr form) env vars) ; the selector
+		     (let case-effect? ((f (cddr form)))
+		       (and (pair? f)
+			    (or (not (pair? (car f)))
+				(any-side-effect? (cdar f) env vars)
+				(case-effect? (cdr f)))))))
+
+		((cond)
+		 (or (not (pair? (cdr form)))
+		     (not (pair? (cadr form)))
+		     (let cond-effect? ((f (cdr form))
+					(e env))
+		       (and (pair? f)
+			    (or (and (pair? (car f))
+				     (any-side-effect? (car f) e vars))
+				(cond-effect? (cdr f) e))))))
+
+		((let let* letrec letrec*)
+		 ;; here if the var value involves a member of vars, we have to add it to vars
+		 (or (< (length form) 3)
+		     (let ((syms (cadr form))
+			   (body (cddr form))
+			   (e env))
+		       (when (symbol? (cadr form))
+			 (set! syms (caddr form))
+			 (let ((fv (make-lint-var (cadr form) #f 'let)))
+			   (varlet (cdr fv) 'side-effect #f)
+			   (varlet (cdr fv) 'ftype 'let)
+			   (set! e (cons fv env)))
+			 (set! body (cdddr form)))
+		       (if (and (pair? vars)
+				(pair? syms))
+			   (for-each (lambda (sym)
+				       (when (and (len>1? sym)
+						  (lint-tree-set-memq vars (cdr sym)))
+					 (set! vars (cons (car sym) vars))))
+				     syms))
+		       (or (let let-effect? ((f syms))
+			     (and (pair? f)
+				  (or (not (pair? (car f)))
+				      (not (pair? (cdar f))) ; an error, reported elsewhere: (let ((x)) x)
+				      (side-effect-with-vars? (cadar f) e vars)
+				      (let-effect? (cdr f)))))
+			   (any-side-effect? body e vars)))))
+
+		((do)
+		 (or (< (length form) 3)
+		     (not (list? (cadr form)))
+		     (not (list? (caddr form)))
+		     (let do-effect? ((f (cadr form))	(e env))
+		       (and (pair? f)
+			    (or (not (pair? (car f)))
+				(not (pair? (cdar f)))
+				(side-effect-with-vars? (cadar f) e vars)
+				(and (pair? (cddar f))
+				     (side-effect-with-vars? (caddar f) e vars))
+				(do-effect? (cdr f) e))))
+		     (any-side-effect? (caddr form) env vars)
+		     (any-side-effect? (cdddr form) env vars)))
+
+		;; ((lambda lambda*) (lint-any? (lambda (ff) (side-effect-with-vars? ff env vars)) (cddr form))) ; this is trickier than it looks
+
+		(else
+		 (or (lint-any? (lambda (f)                              ; any subform has a side-effect
+				  (and (not (null? f))
+				       (side-effect-with-vars? f env vars)))
+			   (cdr form))
+		     (let ((sig (signature (symbol->value (car form))))) ; sig has func arg and it is not known safe
+		       (and (pair? sig)
+			    (memq 'procedure? (cdr sig))
+			    (call-with-exit
+			     (lambda (return)
+			       (for-each
+				(lambda (sg arg)
+				  (when (and (eq? sg 'procedure?)
+					     (not (and (symbol? arg)
+						       (hash-table-ref no-side-effect-functions arg))))
+				    (return #t)))
+				(cdr sig) (cdr form))
+			       #f))))))))))
+
+    (define (side-effect? form env)
+      (side-effect-with-vars? form env ()))
+
+    (define (just-constants? form env)
+      ;; can we probably evaluate form given just built-in stuff?
+      ;;   watch out here -- this is used later by 'if, so (defined 'hiho) should not be evalled to #f!
+      (if (not (pair? form))
+	  (constant? form)
+	  (and (symbol? (car form))
+	       (hash-table-ref no-side-effect-functions (car form))
+	       (hash-table-ref built-in-functions (car form)) ; and not hook-functions
+	       (not (var-member (car form) env))              ; e.g. exp declared locally as a list
+	       (lint-every? (lambda (p) (just-constants? p env)) (cdr form)))))
+
+    (define (repeated-member? lst env)
+      (and (pair? lst)
+	   (or (and (pair? (cdr lst))
+		    (member (car lst) (cdr lst))
+		    (not (and (pair? (car lst))
+			      (side-effect? (car lst) env))))
+	       (repeated-member? (cdr lst) env))))
+
+    (define (update-scope v caller env)
+      (unless (or (memq caller (var-scope v))
+		  (assq caller (var-scope v)))
+	(let ((cv (var-member caller env)))
+	  (set! (var-scope v)
+		(cons (if (and cv
+			       (memq (var-ftype cv) '(define lambda define* lambda*))) ; named-let does not define ftype
+			  caller
+			  (cons caller env))
+		      (var-scope v))))))
+
+    (define check-for-bad-variable-name
+      (let ((bad-var-names ())
+	    (sname #f) (slen #f) (s0 #f))
+	(define (initialize-bad-var-names vars)
+	  (set! bad-var-names ())
+	  (for-each (lambda (n)
+		      (let ((name (symbol->string n)))
+			(cond ((assq (string-ref name 0) bad-var-names) =>
+			       (lambda (cur)
+				 (set! (cdr cur) (cons (list n name (length name)) (cdr cur)))))
+			      (else
+			       (set! bad-var-names (cons (list (string-ref name 0) (list n name (length name))) bad-var-names))))))
+		    vars))
+	(initialize-bad-var-names *report-bad-variable-names*)
+
+	(set! (setter '*report-bad-variable-names*) ; update these local variables if the global variable changes
+	      (lambda (sym val)
+		(when (just-symbols? val)
+		  (initialize-bad-var-names val))
+		val))
+
+	(lambda (caller vname)
+	  (set! sname (symbol->string vname)) ;(if (keyword? vname) (keyword->symbol vname) vname)))
+	  (set! slen (length sname))
+	  (set! s0 (string-ref sname 0))
+
+	  (cond ((assq s0 bad-var-names) =>
+		 (lambda (baddies)
+		   (if (or (assq vname (cdr baddies))
+			   (lint-any? (lambda (b)
+					(and (eqv? (string-position (cadr b) sname) 0)
+					     (string->number (substring sname (caddr b)))))
+				      (cdr baddies)))
+		       (lint-format "surely there's a better name for this variable than ~A" caller vname)))))
+
+	  (if (> slen *report-ridiculous-variable-names*)
+	      (lint-format "the name ~A (~A chars!) is unreadable" caller vname slen)
+
+	      (case s0
+		((#\i)
+		 (if (eqv? (string-position "is-" sname) 0)                   ; is-x? -> x?
+		     (if (char=? (sname (- slen 1)) #\?)
+			 (lint-format "'~A is redundant: perhaps use '~A" caller vname (string->symbol (substring sname 3)))
+			 (lint-format "perhaps use '~A?, not '~A" caller (string->symbol (substring sname 3)) vname))))
+
+		((#\c)
+		 (if (and (> slen 8)
+			  (or (string=? "compute" (substring sname 0 7))      ; compute-* is as bad as get-*
+			      (string=? "calculate" (substring sname 0 9))))  ;   perhaps one exception: computed-goto*
+		     (lint-format "surely there's a better name for this variable than ~A" caller vname)))
+
+		((#\@)
+		 (lint-format "the name ~A will be problematic in quasiquote" caller vname))
+		;; a check for other malformed numbers got no hits
+
+		((#\+)
+		 (if (memq vname '(+i +2i +0.i +1.0i +2.0i +2.i +3.141592653589793i))
+		     (lint-format "~A is not a number" caller vname)))
+
+		((#\-)
+		 (if (memq vname '(-i -0.i -1.0i -2.0i -2i -3.141592653589793i -8.i -8i))
+		     (lint-format "~A is not a number" caller vname)))
+
+		((#\|)
+		 (if (and *report-||-rewrites*
+			  (> slen 2)
+			  (eqv? (char-position #\| (substring sname 1)) (- slen 2))) ; starting at 1, so ends -2
+		     (lint-format "| is not a special character, so ~A is not the symbol ~A" caller
+				  vname (substring sname 1 (- slen 1))))))))))
+
+    (denote (set-ref name caller form env)
+      ;; if name is in env, set its "I've been referenced" flag
+      (let ((data (var-member name env)))
+	(if data
+	    (begin
+	      (set! (var-ref data) (+ (var-ref data) 1))
+	      (update-scope data caller env)
+	      (when (and form (not (memq form (var-history data))))
+		(set! (var-history data) (cons form (var-history data)))
+		(set! (var-refenv data) env)))
+	    (if (and (symbol? name)
+		     (not (defined? name (rootlet))))
+		(let ((old (hash-table-ref other-identifiers name)))
+		  (check-for-bad-variable-name caller name)
+		  (hash-table-set! other-identifiers name (cons form (or old ())))))))
+      env)
+
+
+    (denote (set-set name caller form env)
+      (let ((data (var-member name env)))
+	(when data
+	  (set! (var-set data) (+ (var-set data) 1))
+	  (update-scope data caller env)
+	  (if (not (memq caller (var-setters data)))
+	      (set! (var-setters data) (cons caller (var-setters data))))
+	  (unless (memq form (var-history data))
+	    (set! (var-history data) (cons form (var-history data)))
+	    (set! (var-refenv data) env))
+	  (set! (var-signature data) #f)
+	  (set! (var-ftype data) #f))))
+
+
+    (denote (proper-list lst)
+      ;; return lst as a proper list
+      (if (not (pair? lst))
+	  lst
+	  (cons (car lst)
+		(if (pair? (cdr lst))
+		    (proper-list (cdr lst))
+		    (case (cdr lst) ((())) (else => list))))))
+
+    (define (keywords lst count)
+      (if (pair? lst)
+	  (keywords (cdr lst) (if (keyword? (car lst)) (+ count 1) count))
+	  count))
+
+    (define (eqv-selector clause)
+      (if (not (pair? clause))
+	  (memq clause '(else #t))
+	  (case (car clause)
+	    ((memq memv member)
+	     (and (= (length clause) 3)
+		  (cadr clause)))
+	    ((eq? eqv? = equal? char=? char-ci=? string=? string-ci=?)
+	     (and (= (length clause) 3)
+		  ((if (code-constant? (cadr clause)) caddr cadr) clause)))
+	    ((or)
+	     (and (pair? (cdr clause))
+		  (eqv-selector (cadr clause))))
+	    ((not null? eof-object? zero? boolean?)
+	     (and (pair? (cdr clause))
+		  (cadr clause)))
+ 	    (else #f))))
+
+    (define (->eqf x)
+      (case x
+	((char?) '(eqv? char=?))
+	((integer? rational? real? number? complex? float? infinite? nan?) '(eqv? =))
+	((symbol? keyword? boolean? not null? procedure? syntax? macro? unspecified?) '(eq? eq?))
+	((string?) '(equal? string=?))
+	((pair? vector? float-vector? int-vector? byte-vector? subvector? hash-table?) '(equal? equal?))
+	((eof-object?) '(eq? eof-object?))
+	(else
+	 (if (and (len>1? x)
+		  (or (and (or (memq 'boolean? x)
+			       (memq 'not x))
+			   (or (memq 'real? x) (memq 'number? x) (memq 'integer? x)))
+		      (and (memq 'eof-object? x)
+			   (or (memq 'char? x) (memq 'integer? x)))))
+	     '(eqv? eqv?)
+	     '(#t #t)))))
+
+    (define (eqf selector env)
+      (cond ((symbol? selector)
+	     (if (and (or (hash-table-ref built-in-functions selector)
+			  (hash-table-ref syntaces selector))
+		      (not (var-member selector env)))
+		 '(eq? eq?)
+		 '(#t #t)))
+
+	    ((not (pair? selector))
+	     (->eqf (->lint-type selector)))
+
+	    ((and (memq (car selector) '(quote #_quote))
+		  (pair? (cdr selector)))
+	     (cond ((or (symbol? (cadr selector))
+			(memq (cadr selector) '(#f #t #<unspecified> #<undefined> #<eof> ())))
+		    '(eq? eq?))
+		   ((char? (cadr selector))   '(eqv? char=?))
+		   ((string? (cadr selector)) '(equal? string=?))
+		   ((number? (cadr selector)) '(eqv? =))
+		   (else                      '(equal? equal?))))
+
+	    ((and (eq? (car selector) 'list)
+		  (null? (cdr selector)))
+	     '(eq? eq?))
+
+	    ((symbol? (car selector))
+	     (let ((sig (arg-signature (car selector) env)))
+	       (if (pair? sig)
+		   (->eqf (car sig))
+		   '(#t #t))))
+
+	    (else '(#t #t))))
+
+    (define (unquoted x)
+      (if (and (len=2? x)
+	       (memq (car x) '(quote #_quote)))
+	  (cadr x)
+	  x))
+
+    (define (distribute-quote x)
+      (map (lambda (item)
+	     (if (or (symbol? item)
+		     (pair? item))
+		 (list #_quote item)
+		 item))
+	   x))
+
+    (define (focus-str str focus)
+      (let ((len (length str)))
+	(if (< len 40)
+	    str
+	    (let ((pos (string-position focus str))
+		  (focus-len (length focus)))
+	      (if (not pos)
+		  str
+		  (if (<= pos 20)
+		      (string-append (substring str 0 (min 60 (- len 1) (+ focus-len pos 20))) " ...")
+		      (string-append "... " (substring str (- pos 20) (min (- len 1) (+ focus-len pos 20))) " ...")))))))
+
+    (define check-star-parameters
+      (let ((pi-arg (lambda (a b) (or (eq? b 'pi) (and (pair? b) (eq? (car b) 'pi))))))
+	(lambda (f args env)
+	  (if (lint-any? (lambda (k) (memq k '(:key :optional))) args)
+	      (let ((kw (if (memq :key args) :key :optional)))
+		(out-format outport "~NC~A: ~A is no longer accepted: ~A~%" lint-left-margin #\space f kw
+			(focus-str (object->string args) (symbol->string kw)))))
+
+	  (if (member 'pi args pi-arg)
+	      (out-format outport "~NC~A: parameter can't be a constant: ~A~%" lint-left-margin #\space f
+		      (focus-str (object->string args) "pi")))
+
+	  (let ((r (memq :rest args)))
+	    (when (pair? r)
+	      (if (not (pair? (cdr r)))
+		  (out-format outport "~NC~A: :rest parameter needs a name: ~A~%" lint-left-margin #\space f args)
+		  (if (pair? (cadr r))
+		      (out-format outport "~NC~A: :rest parameter can't specify a default value: ~A~%" lint-left-margin #\space f args)))))
+
+	  (let ((a (memq :allow-other-keys args)))
+	    (when (pair? a)
+	      (if (pair? (cdr a))
+		  (out-format outport "~NC~A: :allow-other-keys should be at the end of the parameter list: ~A~%" lint-left-margin #\space f
+			  (focus-str (object->string args) ":allow-other-keys")))
+	      (if (len=1? args)
+		  (out-format outport "~NC~A: :allow-other-keys can't be the only parameter: ~A~%" lint-left-margin #\space f args))))
+
+	  (for-each (lambda (p)
+		      (if (len>1? p)
+			  (lint-walk f (cadr p) env)))
+		    args))))
+
+    (define (checked-eval form)
+      (and (proper-list? form) ;(not (infinite? (length form))) but when would a dotted list work?
+	   (catch #t
+	     (lambda ()
+	       (eval (copy form) (rootlet)))  ; :readable))) -- use rootlet else "form" is defined (in curlet)
+	     (lambda args
+	       :checked-eval-error))))
+
+    (define (eval/error caller form)
+      (catch #t
+	(lambda ()
+	  (eval form))
+	(lambda args
+	  (lint-format "~A: ~A" caller (car args) (apply format #f (cadr args)))
+	  :error)))
+
+    (define (return-type-ok? type ret)
+      (or (eq? type ret)
+	  (and (pair? ret)
+	       (memq type ret))))
+
+
+    (define last-and-incomplete-arg2 #f)
+
+    (define (and-incomplete form head arg1 arg2 env)           ; head: 'and | 'or (not ...) | 'if | 'if2 -- symbol arg1 in any case
+      (unless (or (memq (car arg2) '(and or not list cons vector)) ; these don't tell us anything about arg1's type
+		  (eq? arg2 last-and-incomplete-arg2))
+	(let ((v (var-member arg1 env)))                       ; try to avoid the member->cdr trope
+	  (unless (and v
+		       (pair? (var-history v))
+		       (member #f (var-history v)
+			       (lambda (a b)
+				 (and (pair? b)
+				      (memq (car b) '(char-position string-position format string->number assoc assq assv memq memv member))))))
+	    (let* ((pos (do ((i 0 (+ i 1))                     ; get arg number of arg1 in arg2
+			     (p arg2 (cdr p))) ; 0th=car -> (and x (x))
+			    ((or (null? p)
+				 (eq? (car p) arg1))
+			     i)))
+		   (arg-type (let ((sig (and (positive? pos)   ; signature for arg2
+					     (arg-signature (car arg2) env))))
+			       (if (zero? pos)                 ; its type indication for arg1's position
+				   'procedure? ; or sequence? -- how to distinguish? use 'applicable?
+				   (and (pair? sig)
+					(< pos (length sig))
+					(list-ref sig pos))))))
+	      (set! last-and-incomplete-arg2 arg2)             ; ignore unwanted repetitions due to recursive simplifications
+	      (if (and (symbol? arg-type)
+		       (not (eq? arg-type 'unused-parameter?)))
+		  (let ((ln (and (< 0 line-number 100000) line-number))
+			(comment (if (and (eq? arg-type 'procedure?)
+					  (= pos 0)
+					  (pair? (cdr arg2)))
+				     " ; or maybe sequence? " ""))
+			(old-arg (case head
+				   ((and if cond when) arg1)
+				   ((or if2)           (list 'not arg1))
+				   (else 'error)))
+			(new-arg (case head
+				   ((and if cond when) (list arg-type arg1))
+				   ((or if2)           (list 'not (list arg-type arg1)))
+				   (else 'error))))
+		    (out-format outport "~NCin ~A~A,~%~NCperhaps change ~S to ~S~A~%"
+			    lint-left-margin #\space
+			    (truncated-list->string form)
+			    (if (and (integer? ln) (> ln 0)) (format #f " (line ~D)" ln) "")
+			    (+ lint-left-margin 4) #\space
+			    old-arg new-arg comment))))))))
+
+    (define (and-redundant? arg1 arg2)
+      ;(format *stderr* "ar: ~A ~A~%" arg1 arg2)
+      (let ((type1 (car arg1))
+	    (type2 (car arg2)))
+	(and (symbol? type1)
+	     (symbol? type2)
+	     (hash-table-ref booleans type1)
+	     (or (hash-table-ref booleans type2)     ; return #f if not (obviously) redundant, else return which of the two to keep
+		 (eq? type2 'not)
+		 (and (memq type2 '(= char=? string=? eq?))
+		      (pair? (cddr arg2))))
+	     (if (eq? type1 type2)
+		 type1
+		 (case type1
+		   ((number? complex?)
+		    (case type2
+		      ((float? real? rational? integer?) type2)
+		      ((number? complex?) type1)
+		      ((=) (let ((x (and (len=3? arg2)
+					 ((if (number? (caddr arg2)) caddr cadr) arg2))))
+			     (and (number? x)
+				  (if (= x (floor x)) 'memv 'eqv?))))
+		      (else #f)))
+
+		   ((real?)
+		    (case type2
+		      ((float? rational? integer?) type2)
+		      ((number? complex?) type1)
+		      ((=) (let ((x ((if (real? (caddr arg2)) caddr cadr) arg2)))
+			     (and (real? x)
+				  (if (= x (floor x)) 'memv 'eqv?))))
+		      (else #f)))
+
+		   ((float?)
+		    (and (memq type2 '(real? complex? number? inexact?)) type1))
+
+		   ((rational?)
+		    (case type2
+		      ((integer?) type2)
+		      ((real? complex? number? exact?) type1)
+		      ((=)
+		       (and (or (rational? (caddr arg2))
+				(rational? (cadr arg2)))
+			    'eqv?))
+		      (else #f)))
+
+		   ((integer?)
+		    (case type2
+		      ((real? rational? complex? number? exact?) type1)
+		      ((=)
+		       (and (pair? (cddr arg2))
+			    (or (integer? (caddr arg2))
+				(integer? (cadr arg2)))
+			    'eqv?))
+		      (else #f)))
+
+		   ((exact?)
+		    (and (memq type2 '(rational? integer?)) type2))
+
+		   ((even? odd?)
+		    (and (memq type2 '(integer? rational? real? complex? number?)) type1)) ; not zero? -> 0.0
+
+		   ((zero?)
+		    (and (memq type2 '(complex? number? real?)) type1))
+
+		   ((negative? positive?)
+		    (and (eq? type2 'real?) type1))
+
+		   ((inexact?)
+		    (and (eq? type2 'float?) type2))
+
+		   ((infinite? nan?)
+		    (and (memq type2 '(number? complex? inexact?)) type1))
+
+		   ((vector?)
+		    (and (memq type2 '(float-vector? int-vector? byte-vector?)) type2))
+
+		   ((float-vector? int-vector? byte-vector?)
+		    (and (eq? type2 'vector?) type1))
+
+		   ((symbol?)
+		    (case type2
+		      ((keyword? gensym?) type2)
+		      ((eq?)
+		       (and (or (quoted-symbol? (cadr arg2))
+				(quoted-symbol? (caddr arg2)))
+			    'eq?))
+		      (else #f)))
+
+		   ((keyword?)
+		    (case type2
+		      ((symbol? constant?) type1)
+		      ((eq?)
+		       (and (or (keyword? (cadr arg2))
+				(keyword? (caddr arg2)))
+			    'eq?))
+		      (else #f)))
+
+		   ((gensym? defined? provided?)
+		    (and (eq? type2 'symbol?) type1))
+
+		   ((boolean?)
+		    (and (or (eq? type2 'not)
+			     (and (eq? type2 'eq?)
+				  (len=2? (cdr arg2))
+				  (or (boolean? (cadr arg2))
+				      (boolean? (caddr arg2)))))
+			 type2))
+
+		   ((list?)
+		    (and (memq type2 '(null? pair? proper-list?)) type2))
+
+		   ((null?)
+		    (and (memq type2 '(list? proper-list?)) type1))
+
+		   ((pair?)
+		    (and (eq? type2 'list?) type1))
+
+		   ((proper-list?)
+		    (and (eq? type2 'null?) type2))
+
+		   ((string?)
+		    (and (eq? type2 'string=?)
+			 (or (eq? (->lint-type (cadr arg2)) 'string?)
+			     (eq? (->lint-type (caddr arg2)) 'string?))
+			 'equal?))
+
+		   ((char?)
+		    (and (eq? type2 'char=?)
+			 (or (eq? (->lint-type (cadr arg2)) 'char?)
+			     (eq? (->lint-type (caddr arg2)) 'char?))
+			 'eqv?))
+
+		   ((char-numeric? char-whitespace? char-alphabetic? char-upper-case? char-lower-case?)
+		    (and (eq? type2 'char?) type1))
+
+		   ((directory?)
+		    (and (memq type2 '(string? file-exists?)) type1))
+
+		   ((file-exists?)
+		    (if (eq? type2 'string?)
+			type1
+			(and (eq? type2 'directory?)
+			     type2)))
+
+		   (else #f))))))
+
+
+    (define (and-forgetful form head arg1 arg2 env)
+      (unless (or (memq (car arg2) '(and or not list cons vector)) ; these don't tell us anything about arg1's type
+		  (eq? arg2 last-and-incomplete-arg2))
+	(let* ((pos (do ((i 0 (+ i 1))                         ; get arg number of arg1 in arg2
+			 (p arg2 (cdr p))) ; 0th=car -> (and x (x))
+			((or (null? p)
+			     (equal? (car p) (cadr arg1)))
+			 (if (null? p) -1 i))))
+	       (arg-type (let ((sig (and (positive? pos)       ; signature for arg2
+					 (arg-signature (car arg2) env))))
+			   (if (zero? pos)                     ; its type indication for arg1's position
+			       'procedure?                     ; or sequence? -- how to distinguish? use 'applicable?
+			       (and (pair? sig)
+				    (< pos (length sig))
+				    (list-ref sig pos))))))
+	  (when (symbol? arg-type)
+	    (let ((new-type (and-redundant? arg1 (cons arg-type (cdr arg1)))))
+	      (when (and new-type
+			 (not (eq? new-type (car arg1))))
+		(let ((old-arg (case head
+				 ((and if cond when) arg1)
+				 ((or if2)           (list 'not arg1))
+				 (else 'error)))
+		      (new-arg (case head
+				 ((and if cond when) (list new-type (cadr arg1)))
+				 ((or if2)           (list 'not (list new-type (cadr arg1))))
+				 (else 'error)))
+		      (ln (and (< 0 line-number 100000) line-number))
+		      (comment (if (and (eq? arg-type 'procedure?)
+					(= pos 0)
+					(pair? (cdr arg2)))
+				   " ; or maybe sequence? " "")))
+		  (set! last-and-incomplete-arg2 arg2)
+		  (out-format outport "~NCin ~A~A,~%~NCperhaps change ~S to ~S~A~%"
+			  lint-left-margin #\space
+			  (truncated-list->string form)
+			  (if (and (integer? ln) (> ln 0)) (format #f " (line ~D)" ln) "")
+			  (+ lint-left-margin 4) #\space
+			  old-arg new-arg comment)))))))
+
+      ;; perhaps change pair? -> eq? or ignore it?
+      (when (and (pair? (cdr arg2))
+		 (not (eq? (car arg1) 'pair?)))
+	(let ((a2 (if (eq? (car arg2) 'not)
+		      (cadr arg2)
+		      arg2)))
+	  (when (and (pair? a2)
+		     (memq (car a2) '(memq memv member assq assv assoc eq? eqv? equal?))
+		     (equal? (cadr arg1) (cadr a2)))
+	    (let ((new-e (case (car (->eqf (car arg1)))
+			   ((eq?)
+			    (case (car a2)
+			      ((memq assq eq?))
+			      ((memv member) 'memq)
+			      ((assv assoc) 'assq)
+			      ((eqv? equal?) 'eq?)))
+			   ((eqv?)
+			    (case (car a2)
+			      ((memv assv eqv?))
+			      ((memq member) 'memv)
+			      ((assq assoc) 'assv)
+			      ((eq? equal?) 'eqv?)))
+			   ((equal?)
+			    (case (car a2)
+			      ((member assoc equal?))
+			      ((memq memv) 'member)
+			      ((assq assv) 'assoc)
+			      ((eq? eqv?) 'equal?)))
+			   (else (car a2)))))
+	      (when (and (not (eq? (car a2) new-e))
+			 (symbol? new-e))
+		(let ((ln (and (< 0 line-number 100000) line-number)))
+		  (out-format outport "~NCin ~A~A,~%~NCperhaps change ~A to ~A~%"
+			  lint-left-margin #\space
+			  (truncated-list->string form)
+			  (if (and (integer? ln) (> ln 0)) (format #f " (line ~D)" ln) "")
+			  (+ lint-left-margin 4) #\space
+			  (truncated-list->string a2)
+			  (list new-e '...)))))))))
+
+
+    ;; --------------------------------
+    (define simplify-boolean
+
+      (let ((relsub
+	     (let ((relops '((< <= > number?) (<= < >= number?) (> >= < number?) (>= > <= number?)
+			     (char<? char<=? char>? char?) (char<=? char<? char>=? char?)  ; these never happen
+			     (char>? char>=? char<? char?) (char>=? char>? char<=? char?)
+			     (string<? string<=? string>? string?) (string<=? string<? string>=? string?)
+			     (string>? string>=? string<? string?) (string>=? string>? string<=? string?))))
+	       (lambda (A B rel-op env)
+		 (call-with-exit
+		  (lambda (return)
+		    (when (and (pair? A)
+			       (pair? B)
+			       (= (length A) (length B) 3))
+		      (let ((Adata (assq (car A) relops))
+			    (Bdata (assq (car B) relops)))
+			(when (and Adata Bdata)
+			  (let ((op1 (car A))
+				(op2 (car B))
+				(A1 (cadr A))
+				(A2 (caddr A))
+				(B1 (cadr B))
+				(B2 (caddr B)))
+			    (let ((x (if (and (not (number? A1))
+					      (member A1 B))
+					 A1
+					 (and (not (number? A2))
+					      (member A2 B)
+					      A2))))
+			      (when x
+				(let ((c1 (if (equal? x A1) A2 A1))
+				      (c2 (if (equal? x B1) B2 B1))
+				      (type (cadddr Adata)))
+				  (if (or (side-effect? c1 env)
+					  (side-effect? c2 env)
+					  (side-effect? x env))
+				      (return 'ok))
+				  (if (equal? x A2) (set! op1 (caddr Adata)))
+				  (if (equal? x B2) (set! op2 (caddr Bdata)))
+
+				  (let ((typer #f)
+					(gtes #f)
+					(gts #f)
+					(eqop #f))
+				    (case type
+				      ((number?)
+				       (set! typer number?)
+				       (set! gtes '(>= <=))
+				       (set! gts  '(< >))
+				       (set! eqop '=))
+				      ((char?)
+				       (set! typer char?)
+				       (set! gtes '(char>=? char<=?))
+				       (set! gts  '(char<? char>?))
+				       (set! eqop 'char=?))
+				      ((string?)
+				       (set! typer string?)
+				       (set! gtes '(string>=? string<=?))
+				       (set! gts  '(string<? string>?))
+				       (set! eqop 'string=?)))
+
+				    (case rel-op
+				      ((and)
+				       (cond ((equal? c1 c2)
+					      (return (cond ((eq? op1 op2)
+							     (list op1 x c1))
+
+							    ((eq? op2 (cadr (assq op1 relops)))
+							     (list (if (memq op2 gtes) op1 op2) x c1))
+
+							    ((and (memq op1 gtes)
+								  (memq op2 gtes))
+							     (list eqop x c1))
+
+							    (else #f))))
+
+					     ((and (typer c1)
+						   (typer c2))
+					      (cond ((or (eq? op1 op2)
+							 (eq? op2 (cadr (assq op1 relops))))
+						     (return (if ((symbol->value op1 (rootlet)) c1 c2)
+								 (list op1 x c1)
+								 (list op2 x c2))))
+
+						    ((eq? op1 (caddr (assq op2 relops)))
+						     (if ((symbol->value op1 (rootlet)) c2 c1)
+							 (return (list op1 c2 x c1))
+							 (if (memq op1 gts)
+							     (return #f))))
+
+						    ((and (eq? op2 (hash-table-ref reversibles (cadr (assq op1 relops))))
+							  ((symbol->value op1 (rootlet)) c1 c2))
+						     (return #f))))
+
+					     ((eq? op2 (caddr (assq op1 relops)))
+					      (return (list op1 c2 x c1)))))
+
+				      ((or)
+				       (cond ((equal? c1 c2)
+					      (return (cond ((eq? op1 op2)
+							     (list op1 x c1))
+
+							    ((eq? op2 (cadr (assq op1 relops)))
+							     (list (if (memq op2 gtes) op2 op1) x c1))
+
+							    ((and (memq op1 gts)
+								  (memq op2 gts))
+							     (list 'not (list eqop x c1)))
+
+							    (else #t))))
+
+					     ((and (typer c1)
+						   (typer c2))
+					      (cond ((or (eq? op1 op2)
+							 (eq? op2 (cadr (assq op1 relops))))
+						     (return (if ((symbol->value op1 (rootlet)) c1 c2)
+								 (list op2 x c2)
+								 (list op1 x c1))))
+
+						    ((eq? op1 (caddr (assq op2 relops)))
+						     (if ((symbol->value op1 (rootlet)) c2 c1)
+							 (return #t))
+						     (return (list 'not (list (cadr (assq op1 relops)) c1 x c2))))
+
+						    ((and (eq? op2 (hash-table-ref reversibles (cadr (assq op1 relops))))
+							  ((symbol->value op1 (rootlet)) c2 c1))
+						     (return #t))))
+
+					     ((eq? op2 (caddr (assq op1 relops)))
+					      (return (list 'not (list (cadr (assq op1 relops)) c1 x c2)))))))))))))))
+		    'ok))))))
+
+	(define (contradictory? ands)
+	  (let ((vars ()))
+	    (call-with-exit
+	     (lambda (return)
+	       (do ((b ands (cdr b)))
+		   ((null? b) #f)
+		 (if (and (pair? b)
+			  (len>1? (car b)))
+		     (let ((func (caar b))
+			   (args (cdar b)))
+		       (if (and (memq func '(eq? eqv? equal?))
+				(len>1? args))
+			   (if (and (or (symbol? (car args)) (eq? (car args) #_quote))
+				    (code-constant? (cadr args)))
+			       (set! func (->lint-type (cadr args)))
+			       (if (and (or (symbol? (cadr args)) (eq? (cadr args) #_quote))
+					(code-constant? (car args)))
+				   (set! func (->lint-type (car args))))))
+
+		       (if (symbol? func)
+			   (for-each
+			    (lambda (arg)
+			      (if (symbol? arg)
+				  (let ((type (assq arg vars)))
+				    (if (not type)
+					(set! vars (cons (cons arg func) vars))
+					(unless (compatible? (cdr type) func)
+					  (return #t))))))
+			    args)))))))))
+
+	(define (and-redundants env . args)
+	  (do ((locals ())
+	       (diffs #f)
+	       (p args (cdr p)))
+	      ((or (null? p)
+		   (not (and (len>1? (car p))
+			     (hash-table-ref booleans (caar p)))))
+	       (and (null? p)
+		    (pair? locals)
+		    (or diffs
+			(lint-any? (lambda (a) (pair? (cddr a))) locals))
+		    (let ((keepers ()))
+		      (for-each (lambda (a)
+				  (let ((next-a (cdr a)))
+				    (cond ((null? (cdr next-a))
+					   (set! keepers (cons (car next-a) keepers)))
+
+					  ((null? (cddr next-a))
+					   (let ((res (apply and-redundant? (reverse next-a))))
+					     (if res
+						 (begin
+						   (set! keepers (cons ((if (eq? res (caar next-a)) car cadr) next-a) keepers))
+						   (set! diffs #t))
+						 (set! keepers (cons (car next-a) (cons (cadr next-a) keepers))))))
+
+					  (else
+					   (let ((ar (reverse next-a)))
+					     (let ((ar1 (car ar))
+						   (ar2 (cadr ar))
+						   (ar3 (caddr ar)))
+					       (let ((res1 (and-redundant? ar1 ar2))     ; if res1 either 1 or 2 is out
+						     (res2 (and-redundant? ar2 ar3))     ; if res2 either 2 or 3 is out
+						     (res3 (and-redundant? ar1 ar3)))    ; if res3 either 1 or 3 is out
+						 ;; only in numbers can 3 actually be reducible
+						 (if (not (or res1 res2 res3))
+						     (set! keepers (append (cdr a) keepers))
+						     (begin
+						       (set! diffs #t)
+						       (if (and (or (not res1)
+								    (eq? res1 (car ar1)))
+								(or (not res3)
+								    (eq? res3 (car ar1))))
+							   (set! keepers (cons ar1 keepers)))
+						       (if (and (or (not res1)
+								    (eq? res1 (car ar2)))
+								(or (not res2)
+								    (eq? res2 (car ar2))))
+							   (set! keepers (cons ar2 keepers)))
+						       (if (and (or (not res2)
+								    (eq? res2 (car ar3)))
+								(or (not res3)
+								    (eq? res3 (car ar3))))
+							   (set! keepers (cons ar3 keepers)))
+						       (if (pair? (cdddr ar))
+							   (set! keepers (append (reverse (cdddr ar)) keepers))))))))))))
+				(reverse locals))
+		      (and diffs (reverse keepers)))))
+	    (let* ((bool (car p))
+		   (local (assoc (cadr bool) locals)))
+	      (if (pair? local)
+		  (if (member bool (cdr local))
+		      (set! diffs #t)
+		      (set-cdr! local (cons bool (cdr local))))
+		  (set! locals (cons (list (cadr bool) bool) locals))))))
+
+	(define (and-not-redundant arg1 arg2)
+	  (let ((type1 (car arg1))    ; (? ...)
+		(type2 (caadr arg2))) ; (not (? ...))
+	    (and (symbol? type1)
+		 (symbol? type2)
+		 (hash-table-ref booleans type1)
+		 (if (eq? type1 type2)     ; (and (?) (not (?))) -> #f
+		     'contradictory
+		     (and (hash-table-ref booleans type2)
+			  (case type1
+			    ((pair?)
+			     (case type2
+			       ((list? sequence?) 'contradictory)
+			       ((proper-list? tree-cyclic?) #f)
+			       (else arg1)))
+
+			    ((null?)
+			     (if (memq type2 '(list? sequence? proper-list?))
+				 'contradictory
+				 arg1))
+
+			    ((list?)
+			     (case type2
+			       ((pair?) 'null?)
+			       ((null?) 'pair?)
+			       ((proper-list? tree-cyclic?) #f)
+			       ((sequence?) 'contradictory)
+			       (else arg1)))
+
+			    ((proper-list?)
+			     (case type2
+			       ((list? sequence?) 'contradictory)
+			       ((null?) #f)
+			       ((pair?) 'null?)
+			       (else arg1)))
+
+			    ((symbol?)
+			     (and (not (memq type2 '(keyword? gensym? defined? provided?)))
+				  arg1))
+
+			    ((keyword? gensym?)
+			     (and (eq? type2 'symbol?)
+				  'contradictory))
+
+			    ((char=?)
+			     (if (eq? type2 'char?)
+				 'contradictory
+				 (and (or (char? (cadr arg1))
+					  (char? (caddr arg1)))
+				      (cons 'eqv? (cdr arg1))))) ; arg2 might be (not (eof-object?...))
+
+			    ((real?)
+			     (case type2
+			       ((rational? exact?)  (cons float? (cdr arg1)))
+			       ((inexact?)          (cons 'rational? (cdr arg1)))
+			       ((complex? number?)  'contradictory)
+			       ((negative? positive? even? odd? zero? integer? float? infinite? nan?) #f)
+			       (else arg1)))
+
+			    ((integer?)
+			     (case type2
+			       ((real? complex? number? rational? exact?) 'contradictory)
+			       ((float? inexact? infinite? nan?) arg1)
+			       (else #f)))
+
+			    ((rational?)
+			     (case type2
+			       ((real? complex? number? exact?) 'contradictory)
+			       ((float? inexact? infinite? nan?) arg1)
+			       (else #f)))
+
+			    ((complex? number?)
+			     (and (memq type2 '(complex? number?))
+				  'contradictory))
+
+			    ((float?)
+			     (case type2
+			       ((real? complex? number? inexact?) 'contradictory)
+			       ((rational? integer? exact?) arg1)
+			       (else #f)))
+
+			    ((exact?)
+			     (case type2
+			       ((rational?) 'contradictory)
+			       ((inexact? infinite? nan?) arg1)
+			       (else #f)))
+
+			    ((even? odd?)
+			     (case type2
+			       ((integer? exact? rational? real? number? complex?) 'contradictory)
+			       ((infinite? nan?) arg1)
+			       (else #f)))
+
+			    ((zero? negative? positive?)
+			     (and (memq type2 '(complex? number? real?))
+				  'contradictory))
+
+			    ((infinite? nan?)
+			     (case type2
+			       ((number? complex? inexact? real?) 'contradictory)
+			       ((integer? rational? exact? even? odd?) arg1)
+			       (else #f)))
+
+			    ((float-vector? int-vector? byte-vector?)
+			     (and (memq type2 '(vector? sequence?))
+				  'contradictory))
+
+			    ((string? let? hash-table? openlet? vector?)
+			     (and (eq? type2 'sequence?)
+				  'contradictory))
+
+			    ((tree-cyclic?)
+			     (and (memq type2 '(sequence? list? pair?))
+				  'contradictory))
+
+			    ((char-whitespace? char-numeric? char-alphabetic? char-upper-case? char-lower-case?)
+			     (and (eq? type2 'char?)
+				  'contradictory))
+
+			    ((directory? file-exists?)
+			     (and (memq type2 '(string? sequence?))
+				  'contradictory))
+
+			    ((continuation? dilambda?)
+			     (and (eq? type2 'procedure?)
+				  'contradictory))
+
+			    (else
+			     ;; none of the rest happen
+			     #f)))))))
+
+	(define (or-not-redundant arg1 arg2)
+	  (let ((type1 (car arg1))    ; (? ...)
+		(type2 (caadr arg2))) ; (not (? ...))
+	    (and (symbol? type1)
+		 (symbol? type2)
+		 (hash-table-ref bools type1)
+		 (if (eq? type1 type2)     ; (or (?) (not (?))) -> #t
+		     'true
+		     (and (hash-table-ref bools type2)
+			  (case type1
+			    ((null?)
+			     (case type2
+			       ((list?) ; not proper-list? here
+				(list 'not (list 'pair? (cadr arg1))))
+			       ((proper-list? sequence? constant? immutable?) #f)
+			       (else arg2)))
+			    ((list?)
+			     (and (memq type2 '(pair? null? proper-list? tree-cyclic?))
+				  'true))
+			    ((proper-list?)
+			     (and (eq? type2 'null?)
+				  'true))
+			    ((pair?)
+			     (and (eq? type2 'tree-cyclic?)
+				  'true))
+			    ((eof-object?)
+			     (and (not (memq type2 '(constant? immutable?)))
+				  arg2))
+			    ((string?)
+			     (and (not (memq type2 '(constant? immutable? sequence?)))
+				  arg2))
+			    ((sequence?)
+			     (and (memq type2 '(string? vector? proper-list? null? let? list? pair? float-vector? int-vector? byte-vector? hash-table? tree-cyclic?))
+				  'true))
+			    ((symbol?)
+			     (and (memq type2 '(keyword? gensym?))
+				  'true))
+			    ((complex? number?)
+			     (and (memq type2 '(float? real? integer? number? complex? rational?))
+				  'true))
+			    ((real?)
+			     (and (memq type2 '(float? integer? rational?))
+				  'true))
+			    ((rational?)
+			     (and (eq? type2 'integer?)
+				  'true))
+			    ((procedure?)
+			     (and (memq type2 '(continuation? dilambda?))
+				  'true))
+			    ((vector?)
+			     (and (memq type2 '(float-vector? int-vector? byte-vector?))
+				  'true))
+			    ;; next two are not currently in bools
+			    ;;((exact?) (and (memq type2 '(integer? rational?)) 'true))
+			    ;;((inexact?) (and (eq? type2 'float?) 'true))
+			    ((iterator-at-end?)
+			     (and (eq? type2 'iterator?)
+				  'true))
+			    (else #f)))))))
+
+	(define (gather-or-eqf-elements eqfnc sym vals env)
+	  (let* ((func (case eqfnc
+			 ((eq?) 'memq)
+			 ((eqv? char=?) 'memv)
+			 (else 'member)))
+		 (equals (if (and (eq? func 'member)
+				  (not (eq? eqfnc 'equal?)))
+			     (list eqfnc)
+			     ()))
+		 (elements (lint-remove-duplicates (map unquoted vals) env)))
+	    (cond ((null? (cdr elements))
+		   (cons eqfnc (cons sym elements)))
+
+		  ((and (eq? eqfnc 'char=?)
+			(= (length elements) 2)
+			(char-ci=? (car elements) (cadr elements)))
+		   (list 'char-ci=? sym (car elements)))
+
+		  ((and (eq? eqfnc 'string=?)
+			(= (length elements) 2)
+			(string-ci=? (car elements) (cadr elements)))
+		   (list 'string-ci=? sym (car elements)))
+
+		  ((member elements '((#t #f) (#f #t)))
+		   (list 'boolean? sym))		; zero? doesn't happen
+
+		  ((and (eq? eqfnc '=)                  ; (or (= <expr> 20) (= <expr> 21)) -> (<= 20 <expr> 21)
+			(pair? sym)
+			(eq? (car sym) 'length)
+			(= (length elements) 2)         ;    this used to be -> (member '(20 21) =)
+			(integer? (car elements))
+			(integer? (cadr elements))
+			(= (abs (- (car elements) (cadr elements))) 1))
+		   `(,(if (< (cadr elements) (car elements)) '<= '>=) ,(cadr elements) ,sym ,(car elements)))
+
+		  (else
+		   `(,func ,sym ',(reverse elements) ,@equals)))))
+
+	(define (reversible-member expr lst)
+	  (and (pair? lst)
+	       (or (member expr lst)
+		   (and (eqv? (length expr) 3)
+			(let ((rev-op (hash-table-ref reversibles (car expr))))
+			  (and rev-op
+			       (member (list rev-op (caddr expr) (cadr expr)) lst)))))))
+
+	(define and-rel-ops (let ((h (make-hash-table)))
+			      (for-each (lambda (op)
+					  (hash-table-set! h op #t))
+					'(< = > <= >= char-ci>=? char-ci<? char-ready? char<? char-ci=? char>?
+					    char<=? char-ci>? char-ci<=? char>=? char=? string-ci<=? string=?
+					    string-ci>=? string<? string-ci<? string-ci=? string-ci>? string>=? string<=? string>?
+					    eqv? equal? eq? equivalent?))
+			      h))
+
+	(define (booleans-with-not? arg1 arg2)
+	  (and (eq? (car arg2) 'not)
+	       (len>1? (cadr arg2))
+	       (equal? (cdr arg1) (cdadr arg2))))
+
+	(define (collect-nots start end)
+	  (if (eq? (cdr start) end) ; just one not
+	      (car start)
+	      (do ((nf ())
+		   (np start (cdr np)))
+		  ((eq? np end)
+		   (reverse nf))
+		(set! nf (cons (cadar np) nf)))))
+
+	;; -------- invert-successive-nots --------
+	(define (invert-successive-nots return form len env)
+	  (let ((nots 0)
+		(ctr 0)
+		(max-ctr 0)
+		(revers 0)
+		(arglen (- len 1))
+		(new-head (if (eq? (car form) 'or) 'and 'or)))
+	    (for-each (lambda (a)
+			(if (len>1? a)
+			    (if (eq? (car a) 'not)
+				(begin
+				  (set! nots (+ nots 1))
+				  (set! ctr (+ ctr 1)))
+				(begin
+				  (set! max-ctr (max max-ctr ctr))
+				  (set! ctr 0)
+				  (if (hash-table-ref notables (car a))
+				      (set! revers (+ revers 1)))))))
+		      (cdr form))
+
+	    (cond ((= nots arglen)                               ; every arg is `(not ...)
+		   (let ((nf (simplify-boolean (cons new-head (map cadr (cdr form))) () () env)))
+		     (return (simplify-boolean (list 'not nf) () () env))))
+
+		  ((and (> nots 1)                           ; if nots+revers=arglen, entire thing can be inverted
+			(= (+ nots revers) arglen))          ;   revers>0 because we checked for nots=arglen above
+		   (return (simplify-boolean
+			    (list 'not (cons new-head (map (lambda (p)
+							     (if (eq? (car p) 'not)
+								 (cadr p)
+								 (cons (hash-table-ref notables (car p)) (cdr p))))
+							   (cdr form))))
+			    () () env)))
+
+		  ((and (> arglen 2)
+			(or (>= nots (/ (* 3 arglen) 4))      ; > 2/3 seems to get some ugly rewrites
+			    (and (>= nots (/ (* 2 arglen) 3)) ; was > 1/2 here
+				 (> revers 0))))
+		   (let ((nf (cons new-head (map (lambda (p)
+						   (cond ((not (pair? p))
+							  (list 'not p))
+							 ((eq? (car p) 'not)
+							  (cadr p))
+							 ((hash-table-ref notables (car p)) =>
+							  (lambda (op)
+							    (cons op (cdr p))))
+							 (else (list 'not p))))
+						 (cdr form)))))
+		     (return (simplify-boolean (list 'not nf) () () env))))
+
+		  ((> max-ctr 2)
+		   (return (simplify-boolean
+			    (cons (car form)
+				  (do ((start ())
+				       (new-form ())
+				       (p (cdr form) (cdr p)))
+				      ((null? p)
+				       (reverse
+					(if (pair? start)
+					    (cons (list 'not (cons new-head (collect-nots start p))) new-form)
+					    new-form)))
+				    (let ((c (car p)))
+				      (if (and (pair? c)
+					       (eq? (car c) 'not))
+					  (if (null? start)
+					      (set! start p))
+					  (begin
+					    (when (pair? start)
+					      (set! new-form (cons (list 'not (cons new-head (collect-nots start p))) new-form))
+					      (set! start ()))
+					    (set! new-form (cons c new-form)))))))
+			    () () env))))))
+
+	;; -------- or->memx --------
+	(define (or->memx return form env)
+	  (do ((sym #f)
+	       (eqfnc #f)
+	       (vals ())
+	       (start #f)
+	       (fp (cdr form) (cdr fp)))
+	      ((null? fp))
+	    (let ((p (car fp)))
+	      (if (and (pair? p)
+		       (if (not sym)
+			   (set! sym (eqv-selector p))
+			   (equal? sym (eqv-selector p)))
+		       (or (not (memq eqfnc '(char-ci=? string-ci=? =)))
+			   (memq (car p) '(char-ci=? string-ci=? =)))
+
+		       ;; = can't share: (equal? 1 1.0) -> #f, so (or (not x) (= x 1)) can't be simplified
+		       ;;   except via member+equivalent? but that brings in float-epsilon and NaN differences.
+		       ;;   We could add both: 1 1.0 as in cond?
+		       ;;
+		       ;; another problem: using memx below means the returned value of the expression
+		       ;;   may not match the original (#t -> '(...)), so perhaps we should add a one-time
+		       ;;   warning about this, and wrap it in (pair? (mem...)) as an example.
+		       ;;
+		       ;; and another thing... the original might be broken: (eq? x #(1)) where equal?
+		       ;;   is more sensible, but that also changes the behavior of the expression:
+		       ;;   (memq x '(#(1))) may be #f (or #t!) when (member x '(#(1))) is '(#(1)).
+		       ;;
+		       ;; I think I'll try to turn out a more-or-less working expression, but warn about it.
+
+		       (case (car p)
+			 ((string=? equal?)
+			  (set! eqfnc (if (or (not eqfnc)
+					      (eq? eqfnc (car p)))
+					  (car p)
+					  'equal?))
+			  (and (= (length p) 3)
+			       (if (code-constant? (cadr p))
+				   (set! vals (cons (cadr p) vals))
+				   (and (code-constant? (caddr p))
+					(set! vals (cons (caddr p) vals))))))
+			 ((char=?)
+			  (if (memq eqfnc '(#f char=?))
+			      (set! eqfnc 'char=?)
+			      (if (not (eq? eqfnc 'equal?))
+				  (set! eqfnc 'eqv?)))
+			  (and (= (length p) 3)
+			       (if (code-constant? (cadr p))
+				   (set! vals (cons (cadr p) vals))
+				   (and (code-constant? (caddr p))
+					(set! vals (cons (caddr p) vals))))))
+
+			 ((eq? eqv?)
+			  (let ((leqf (car (->eqf (->lint-type ((if (code-constant? (cadr p)) cadr caddr) p))))))
+			    (cond ((not eqfnc)
+				   (set! eqfnc leqf))
+
+				  ((or (memq leqf '(#t equal?))
+				       (not (eq? eqfnc leqf)))
+				   (set! eqfnc 'equal?))
+
+				  ((memq eqfnc '(#f eq?))
+				   (set! eqfnc leqf))))
+			  (and (= (length p) 3)
+			       (if (code-constant? (cadr p))
+				   (set! vals (cons (cadr p) vals))
+				   (and (code-constant? (caddr p))
+					(set! vals (cons (caddr p) vals))))))
+
+			 ((char-ci=? string-ci=? =)
+			  (and (or (not eqfnc)
+				   (eq? eqfnc (car p)))
+			       (set! eqfnc (car p))
+			       (= (length p) 3)
+			       (if (code-constant? (cadr p))
+				   (set! vals (cons (cadr p) vals))
+				   (and (code-constant? (caddr p))
+					(set! vals (cons (caddr p) vals))))))
+
+			 ((eof-object?)
+			  (set! eqfnc (case eqfnc ((string=? string-ci=? = equal?) 'equal?) ((#f eq?) 'eq?) (else 'eqv?)))
+			  (set! vals (cons #<eof> vals)))
+
+			 ((not)
+			  (set! eqfnc (case eqfnc ((string=? string-ci=? = equal?) 'equal?) ((#f eq?) 'eq?) (else 'eqv?)))
+			  (set! vals (cons #f vals)))
+
+			 ((boolean?)
+			  (set! eqfnc (case eqfnc ((string=? string-ci=? = equal?) 'equal?) ((#f eq?) 'eq?) (else 'eqv?)))
+			  (set! vals (cons #f (cons #t vals))))
+
+			 ((zero?)
+			  (if (memq eqfnc '(#f eq?)) (set! eqfnc 'eqv?))
+			  (set! vals (cons 0 (cons 0.0 vals))))
+
+			 ((null?)
+			  (set! eqfnc (case eqfnc ((string=? string-ci=? = equal?) 'equal?) ((#f eq?) 'eq?) (else 'eqv?)))
+			  (set! vals (cons () vals)))
+
+			 ((memq memv member)
+			  (cond ((eq? (car p) 'member)
+				 (set! eqfnc 'equal?))
+
+				((eq? (car p) 'memv)
+				 (set! eqfnc (if (eq? eqfnc 'string=?) 'equal? 'eqv?)))
+
+				((not eqfnc)
+				 (set! eqfnc 'eq?)))
+			  (and (= (length p) 3)
+			       (quoted-pair? (caddr p))
+			       (proper-list? (cadr (caddr p)))
+			       (set! vals (append (cadr (caddr p)) vals))))
+
+			 (else #f)))
+
+		  (if (not start)
+		      (set! start fp) ; we're in a loop above...
+		      (if (and (proper-list? form)
+			       (len=1? fp))
+			  (return (if (eq? start (cdr form))
+				      (gather-or-eqf-elements eqfnc sym vals env)
+				      `(or ,@(copy (cdr form) (make-list (do ((g (cdr form) (cdr g))
+									      (len 0 (+ len 1)))
+									     ((eq? g start)
+									      len))))
+					   ,(gather-or-eqf-elements eqfnc sym vals env))))))
+
+		  ;; false branch of if above -- not consequent on previous
+		  (when (pair? start)
+		    (if (eq? fp (cdr start))
+			(begin
+			  (set! sym #f)
+			  (set! eqfnc #f)
+			  (set! vals ())
+			  (set! start #f))
+			;; here we have possible header stuff + more than one match + trailing stuff
+			(let ((trailer (if (not (len>1? fp))
+					   fp
+					   (let ((nfp (simplify-boolean (cons 'or fp) () () env)))
+					     ((if (and (pair? nfp)
+						       (eq? (car nfp) 'or))
+						  cdr list)
+					      nfp)))))
+			  (return (if (eq? start (cdr form))
+				      (cons 'or (cons (gather-or-eqf-elements eqfnc sym vals env) trailer))
+				      `(or ,@(copy (cdr form) (make-list (do ((g (cdr form) (cdr g))
+									      (len 0 (+ len 1)))
+									     ((eq? g start)
+									      len))))
+					   ,(gather-or-eqf-elements eqfnc sym vals env)
+					     ,@trailer))))))))))
+
+	;; -------- or->case --------
+	(define (or->case return form)
+	  (do ((selector #f)              ; (or (and (eq?...)...)....) -> (case ....)
+	       (keys ())
+	       (fp (cdr form) (cdr fp)))
+	      ((or (null? fp)
+		   (let ((p (and (pair? fp)
+				 (car fp))))
+		     (not (and (len>1? p)
+			       (eq? (car p) 'and)
+			       (len>1? (cadr p))
+			       (or selector
+				   (set! selector (cadadr p)))
+			       (let ((expr (cadr p))
+				     (arg1 (cadadr p)))
+				 (case (car expr)
+				   ((null?)
+				    (and (equal? selector arg1)
+					 (not (memq () keys))
+					 (set! keys (cons () keys))))
+				   ;; we have to make sure no keys are repeated:
+				   ;;   (or (and (eq? x 'a) (< y 1)) (and (eq? x 'a) (< y 2)))
+				   ;;   this rewrite has become much trickier than expected...
+
+				   ((boolean?)
+				    (and (equal? selector arg1)
+					 (not (memq #f keys))
+					 (not (memq #t keys))
+					 (set! keys (cons #f (cons #t keys)))))
+
+				   ((eof-object?)
+				    (and (equal? selector arg1)
+					 (not (memq #<eof> keys))
+					 (set! keys (cons #<eof> keys))))
+
+				   ((zero?)
+				    (and (equal? selector arg1)
+					 (not (memv 0 keys))
+					 (not (memv 0.0 keys))
+					 (set! keys (cons 0.0 (cons 0 keys)))))
+
+				   ((memq memv)
+				    (and (equal? selector arg1)
+					 (pair? (cddr expr))
+					 (quoted-pair? (caddr expr))
+					 (not (lint-any? (lambda (g)
+							   (memv g keys))
+							 (cadr (caddr expr))))
+					 (set! keys (append (cadr (caddr expr)) keys))))
+
+				   ((eq? eqv? char=?)
+				    (and (len=1? (cddr expr))
+					 (or (and (equal? selector arg1)
+						  (code-constant? (caddr expr))
+						  (not (memv (unquoted (caddr expr)) keys))
+						  (set! keys (cons (unquoted (caddr expr)) keys)))
+					     (and (equal? selector (caddr expr))
+						  (code-constant? arg1)
+						  (not (memv (unquoted arg1) keys))
+						  (set! keys (cons (unquoted arg1) keys))))))
+
+				   ((not)
+				    ;; no hits here for last+not eq(etc)+no collision in keys
+				    (and (equal? selector arg1)
+					 (not (memq #f keys))
+					 (set! keys (cons #f keys))))
+
+				   (else #f)))))))
+	       (if (null? fp)
+		   (return `(case ,selector
+			      ,@(map (lambda (p)
+				       (let ((result (if (null? (cdddr p))
+							 (caddr p)
+							 (cons 'and (cddr p))))
+					     (key (let ((expr (cadr p)))
+						    (case (car expr)
+						      ((eq? eqv? char=?)
+						       (let ((repeats (equal? selector (cadr expr))))
+							 (list (unquoted ((if repeats caddr cadr) expr)))))
+						      ((memq memv)   (unquoted (caddr expr)))
+						      ((null?)       (list ()))
+						      ((eof-object?) (list #<eof>))
+						      ((zero?)       (list 0 0.0))
+						      ((not)         (list #f))
+						      ((boolean?)    (list #t #f))))))
+					 (list key result)))
+				     (cdr form))
+			      (else #f)))))))
+
+
+	(define (classify e env)
+	  (if (not (just-constants? e env))
+	      e
+	      (catch #t
+		(lambda ()
+		  (let ((val (eval e)))
+		    (if (boolean? val)
+			val
+			e)))
+		(lambda ignore e))))
+
+	;; -------- reduce-or --------
+	(define (reduce-or return form len true false env)
+	  (do ((new-form ())
+	       (retry #f)
+	       (exprs (cdr form) (cdr exprs)))
+	      ((not (pair? exprs))
+	       (return (and (pair? new-form)
+			    (if (null? (cdr new-form))
+				(car new-form)
+				(if retry
+				    (simplify-boolean (cons 'or (reverse new-form)) () () env)
+				    (cons 'or (reverse new-form)))))))
+	    (let ((val (classify (car exprs) env))
+		  (old-form new-form))
+
+	      (when (and (pair? val)
+			 (memq (car val) '(and or not)))
+		(set! val (classify (simplify-boolean val true false env) env))
+		(when (and (> len 3)
+			   (len=2? val) ; pair? val needs to precede car val
+			   (eq? (car val) 'not)
+			   (pair? (cdr exprs)))
+		  (if (symbol? (cadr val))
+		      (if (and (pair? (cadr exprs))
+			       (memq (cadr val) (cadr exprs)))
+			  (and-incomplete form 'or (cadr val) (cadr exprs) env)
+			  (do ((ip (cdr exprs) (cdr ip))
+			       (found-it #f))
+			      ((or found-it
+				   (not (pair? ip))))
+			    (do ((p (car ip) (cdr p)))
+				((or (not (pair? p))
+				     (and (memq (cadr val) p)
+					  (set! found-it p)))
+				 (if (pair? found-it)
+				     (and-incomplete form 'or (cadr val) found-it env))))))
+		      (when (and (pair? (cadr val))
+				 (pair? (cadr exprs))
+				 (hash-table-ref bools (caadr val)))
+			(if (member (cadadr val) (cadr exprs))
+			    (and-forgetful form 'or (cadr val) (cadr exprs) env)
+			    (do ((p (cadr exprs) (cdr p)))
+				((or (not (pair? p))
+				     (and (pair? (car p))
+					  (member (cadadr val) (car p))))
+				 (if (pair? p)
+				     (and-forgetful form 'or (cadr val) (car p) env)))))))))
+	      (if (not (or retry
+			   (equivalent? val (car exprs)))) ; morally because val might be NaN!
+		  (set! retry #t))
+
+	      (cond ((not val))                     ; #f in or is ignored
+
+		    ((or (eq? val #t)               ; #t or any non-#f constant in or ends the expression
+			 (code-constant? val))
+		     (set! new-form (cons val       ; (or x1 123) -> value of x1 first
+					  (if (null? new-form)
+					      ()
+					      new-form)))
+		     ;; reversed when returned
+		     (set! exprs '(#t)))
+
+		    ((and (pair? val)                       ; (or ...) -> splice into current
+			  (proper-list? val)
+			  (eq? (car val) 'or))
+		     (set! exprs (append val (cdr exprs)))) ; we'll skip the 'or in do step
+
+		    ((not (or (memq val new-form)
+			      (and (len>1? val)         ;   and redundant tests
+				   (hash-table-ref booleans (car val))
+				   (lint-any? (lambda (p)
+						(and (len>1? p)
+						     (subsumes? (car p) (car val))
+						     (equal? (cadr val) (cadr p))))
+					      new-form))))
+		     (set! new-form (cons val new-form))))
+
+	      (if (and (not (eq? new-form old-form))
+		       (pair? (cdr new-form)))
+		  (let ((rel (relsub (cadr new-form) (car new-form) 'or env))) ; new-form is reversed
+		    (if (or (boolean? rel)
+			    (pair? rel))
+			(set! new-form (cons rel (cddr new-form)))))))))
+
+	;; -------- reduce-and --------
+	(define reduce-and
+	  (let ((last-reduce-and-form #f)) ; try to reduce repetitive output
+	    (lambda (return form len false env)
+	      (do ((new-form ())
+		   (retry #f)
+		   (exprs (cdr form) (cdr exprs)))
+		  ((null? exprs)
+		   (or (null? new-form)      ; (and) -> #t
+		       (let ((newer-form (let ((nform (reverse new-form)))
+					   (map (lambda (x cdr-x)
+						  (if (and x (code-constant? x))
+						      (values)
+						      x))
+						nform (cdr nform)))))
+			 (return
+			  (cond ((null? newer-form)
+				 (car new-form))
+
+				((and (eq? (car new-form) #t) ; trailing #t is dumb if next-to-last is boolean func
+				      (pair? (cdr new-form))
+				      (pair? (cadr new-form))
+				      (symbol? (caadr new-form))
+				      (eq? (return-type (caadr new-form) env) 'boolean?))
+				 (if (null? (cdr newer-form))
+				     (car newer-form)
+				     (cons 'and newer-form)))
+
+				(retry
+				 (simplify-boolean `(and ,@newer-form ,(car new-form)) () () env))
+
+				(else `(and ,@newer-form ,(car new-form))))))))
+
+		(let* ((e (car exprs))
+		       (val (classify e env))
+		       (old-form new-form))
+
+		  (if (and (pair? val)
+			   (memq (car val) '(and or not)))
+		      (set! val (classify (set! e (simplify-boolean val () false env)) env))
+
+		      (when (and (> len 3)
+				 (pair? (cdr exprs)))
+			(if (symbol? val)
+			    (if (and (pair? (cadr exprs))
+				     (memq val (cadr exprs)))
+				(let ((nval (simplify-boolean (list 'and val (cadr exprs)) () false env)))
+				  (if (and (pair? nval)
+					   (eq? (car nval) 'and))
+				      (and-incomplete form 'and val (cadr exprs) env)
+				      (begin
+					(set! val nval)
+					(set! exprs (cdr exprs)))))
+				(do ((ip (cdr exprs) (cdr ip))
+				     (found-it #f))
+				    ((or found-it
+					 (not (pair? ip))))
+				  (do ((p (car ip) (cdr p)))
+				      ((or (not (pair? p))
+					   (and (memq val p)
+						(let ((nval (simplify-boolean (list 'and val p) () false env)))
+						  (if (and (pair? nval)
+							   (eq? (car nval) 'and))
+						      (set! found-it p)
+						      (let ((ln (and (< 0 line-number 100000) line-number)))
+							(out-format outport "~NCin ~A~A,~%~NCperhaps change ~S to ~S~%"
+								lint-left-margin #\space
+								(truncated-list->string form)
+								(if (and (integer? ln) (> ln 0)) (format #f " (line ~D)" ln) "")
+								(+ lint-left-margin 4) #\space
+								(list 'and '... val '... p)
+								nval)
+							(set! found-it #t)))))
+					   (and (pair? (car p))
+						(memq val (car p))
+						(set! found-it (car p))))
+				       (if (pair? found-it)
+					   (and-incomplete form 'and val found-it env))))))
+			    (when (and (pair? val)
+				       (pair? (cadr exprs))
+				       (hash-table-ref bools (car val)))
+			      (if (member (cadr val) (cadr exprs))
+				  (and-forgetful form 'and val (cadr exprs) env)
+				  (do ((p (cadr exprs) (cdr p)))
+				      ((or (not (pair? p))
+					   (and (pair? (car p))
+						(member (cadr val) (car p))))
+				       (if (pair? p)
+					   (and-forgetful form 'and val (car p) env)))))))))
+
+		  (if (not (or retry
+			       (equivalent? e (car exprs)))) ; NaN again
+		      (set! retry #t))
+
+		  ;; (and x1 x2 x1) is not reducible
+		  ;;   the final thing has to remain at the end, but can be deleted earlier if it can't short-circuit the evaluation,
+		  ;;   but if there are expressions following the first x1, we can't be sure that it is not
+		  ;;   protecting them:
+		  ;;       (and false-or-0 (display (list-ref lst false-or-0)) false-or-0)
+		  ;;   so I'll not try to optimize that case.  But (and x x) is optimizable.
+
+					;(format *stderr* "  new-form: ~S\n  val: ~S\n  e: ~S\n  exprs: ~S~%" new-form val e exprs)
+		  (cond ((eq? val #t)
+			 (if (null? (cdr exprs))     ; (and x y #t) should not remove the #t
+			     (if (or (and (pair? e)
+					  (eq? (return-type (car e) env) 'boolean?))
+				     (eq? e #t))
+				 (set! new-form (cons val new-form))
+				 (if (or (null? new-form)
+					 (not (equal? e (car new-form))))
+				     (set! new-form (cons e new-form))))
+			     (if (and (not (eq? e #t))
+				      (or (null? new-form)
+					  (not (member e new-form))))
+				 (set! new-form (cons e new-form)))))
+
+			((not val)             ; #f in 'and' ends the expression
+			 (set! new-form (if (or (null? new-form)
+						(just-symbols? new-form))
+					    '(#f)
+					    (cons #f new-form)))
+			 (set! exprs '(#f)))
+
+			((and (pair? e)       ; if (and ...) splice into current
+			      (eq? (car e) 'and))
+			 (set! exprs (append e (cdr exprs))))
+
+			((and (len>1? e)       ; (and (list? p) (pair? p) ...) -> (and (pair? p) ...)
+			      (pair? (cdr exprs))
+			      (len>1? (cadr exprs))
+			      (eq? (and-redundant? e (cadr exprs)) (caadr exprs))
+			      (equal? (cadr e) (cadadr exprs))))
+
+			((and (len>1? e)       ; (and (list? p) (not (null? p)) ...) -> (and (pair? p) ...)
+			      (memq (car e) '(list? pair?))
+			      (pair? (cdr exprs))
+			      (let ((p (cadr exprs)))
+				(and (pair? p)
+				     (eq? (car p) 'not)
+				     (len>1? (cadr p))
+				     (eq? (caadr p) 'null?)
+				     (equal? (cadr e) (cadadr p)))))
+			 (set! new-form (cons (list 'pair? (cadr e)) new-form))
+			 (set! exprs (cdr exprs)))
+
+			;; redundant type check after something like list-ref never happens
+
+			(else
+
+			 (when (and (not (eq? form last-reduce-and-form))
+				    (pair? (cdr form))
+				    (pair? (cddr form))
+				    (pair? (cadr form))
+				    (hash-table-ref booleans (caadr form))
+				    (pair? (caddr form))
+				    (memq (caaddr form) '(or memq memv member assq assv assoc =)))
+			   (let* ((ande (cadr form))
+				  (othere (caddr form))
+				  (andf (car ande))
+				  (otherf (car othere)))
+			     (set! last-reduce-and-form form)
+			     (cond ((memq andf '(integer? rational?))
+				    (cond ((and (eq? otherf '=)                ; (and (integer? x) (= x 0)) -> (eqv? x 0), ok because we explicitly want 0, not 0.0
+						(len=3? othere)
+						(memq (cadr ande) othere))
+					   (let ((num ((if (eq? (cadr ande) (caddr othere)) cadr caddr) othere)))
+					     (if (and (number? num) ; might be an expression
+						      (not ((symbol->value andf) num)))
+						 (lint-format "~S, but ~S is not ~S" 'and form num andf)
+						 (lint-format "perhaps ~S -> ~S" 'and form (list 'eqv? (cadr ande) num)))))
+
+					  ((eq? otherf 'or)                    ; (and (integer? x) (or (= x 0) (= x 1))) -> (memv x '(0 1))
+					   (let ((vals (call-with-exit
+							(lambda (return)
+							  (map (lambda (x)
+								 (if (and (len=3? x)
+									  (eq? (car x) '=)
+									  (memq (cadr ande) x))
+								     (if (number? (cadr x))
+									 (cadr x)
+									 (if (number? (caddr x))
+									     (caddr x)
+									     (return #f)))))
+							       (cdr othere))))))
+					     (if (and (pair? vals)
+						      (not (memq #<unspecified> vals)))
+						 (lint-format "perhaps ~S -> ~S" 'and form
+							      (list 'memv (cadr ande) (list #_quote vals))))))))
+				   ;; there are also cases with zero? etc
+
+				   ((eq? andf 'exact?)
+				    (let ((num ((if (eq? (cadr ande) (caddr othere)) cadr caddr) othere)))
+				      (if (and (eq? otherf '=)
+					       (len=3? othere)
+					       (memq (cadr ande) othere)
+					       (or (not (number? num))
+						   ((symbol->value andf) num)))
+					  (lint-format "perhaps ~S -> ~S" 'and form
+						       (list 'eqv? (cadr ande) num)))))
+
+				   ((and (eq? andf 'symbol?)
+					 (eq? otherf 'memq)
+					 (eq? (cadr ande) (cadr othere)))
+				    (lint-format "perhaps ~S -> ~S" 'and form othere))
+
+				   ((and (eq? andf 'not)
+					 (eq? otherf 'or)
+					 (pair? (cadr ande))
+					 (eq? (caadr ande) 'eof-object?))
+				    (let ((vals (call-with-exit
+						 (lambda (return)
+						   (map (lambda (x)
+							  (if (and (len=3? x)
+								   (eq? (car x) 'char=?)
+								   (memq (cadadr ande) x))
+							      (if (char? (cadr x))
+								  (cadr x)
+								  (if (char? (caddr x))
+								      (caddr x)
+								      (return #f)))))
+							(cdr othere))))))
+				      (if (and (pair? vals)
+					       (not (memq #<unspecified> vals)))
+					  (lint-format "perhaps ~S -> ~S" 'and form
+						       (list 'memv (cadadr ande) (list #_quote vals)))))))))
+
+			 (unless (or (and (len>2? e)                   ; (and ... (or ... 123) ...) -> splice out or
+					  (pair? (cdr exprs))
+					  (eq? (car e) 'or)
+					  (cond ((last-ref e) => code-constant?) ; (or ... #f)
+						(else #f)))
+				     (and (pair? new-form)
+					  (or (eq? val (car new-form)) ; omit repeated tests
+					      (and (len>1? val)        ;   and redundant tests
+						   (hash-table-ref booleans (car val))
+						   (lint-any? (lambda (p)
+								(and (len>1? p)
+								     (subsumes? (car val) (car p))
+								     (equal? (cadr val) (cadr p))))
+							      new-form)))))
+			   (set! new-form (cons val new-form)))))
+
+		  (if (and (not (eq? new-form old-form))
+			   (pair? (cdr new-form)))
+		      (let ((rel (relsub (car new-form) (cadr new-form) 'and env)))
+			;; rel #f should halt everything as above, and it looks ugly in the output,
+			;;   but it never happens in real code
+			(if (or (pair? rel)
+				(boolean? rel))
+			    (set! new-form (cons rel (cddr new-form)))))))))))
+
+	;; -------- bool-simp-1 --------
+	(define (bool-simp-1 form true false len env)
+	  (let ((op (case (car form)
+		      ((or) 'and)
+		      ((and) 'or)
+		      (else #f))))
+	    (if (and op
+		     (>= len 3)
+		     (lint-every? (lambda (p)
+				    (and (len>2? p)
+					 (eq? (car p) op)))
+				  (cdr form)))
+		(let ((first (cadadr form)))
+		  (if (lint-every? (lambda (p)
+				     (equal? (cadr p) first))
+				   (cddr form))
+		      (set! form `(,op ,first (,(car form) ,@(map (lambda (p)
+								    (if (null? (cdddr p))
+									(caddr p)
+									(cons op (cddr p))))
+								  (cdr form)))))
+		      (if (null? (cdddr (cadr form)))
+			  (let ((last (caddr (cadr form))))
+			    (if (lint-every? (lambda (p)
+					       (and (null? (cdddr p))
+						    (equal? (caddr p) last)))
+					     (cddr form))
+				(set! form (list op
+						 (cons (car form)
+						       (map cadr (cdr form)))
+						 last)))))))))
+	  ;; (or (and A B) (and A C)) -> (and A (or B C))
+	  ;; (or (and A B) (and C B)) -> (and (or A C) B)
+	  ;; (and (or A B) (or A C)) -> (or A (and B C))
+	  ;; (and (or A B) (or C B)) -> (or (and A C) B)
+
+	  (case (car form)
+	    ;; --------------------------------
+	    ((not)
+	     ;(format *stderr* "not: ~S~%" form)
+	     (if (not (= len 2))
+		 form
+		 (let* ((arg (cadr form))
+			(val (classify (if (and (pair? arg)
+						(memq (car arg) '(and or not)))
+					   (simplify-boolean arg true false env)
+					   arg)
+				       env))
+			(arg-op (and (pair? arg)
+				     (car arg))))
+
+		   (cond ((boolean? val)
+			  (not val))
+
+			 ((or (code-constant? arg)
+			      (and (pair? arg)
+				   (symbol? arg-op)
+				   (hash-table-ref no-side-effect-functions arg-op)
+				   (let ((ret (return-type arg-op env)))
+				     (and (or (symbol? ret)
+					      (pair? ret))
+					  (not (return-type-ok? 'boolean? ret))
+					  (not (return-type-ok? 'not ret))))
+				   (not (var-member arg-op env))))
+			  #f)
+
+			 ((and (pair? val)
+			       (> (length val) 1)                           ; (not (not ...)) -> ...  this is usually internally generated,
+			       (memq (car val) '(not if cond case begin)))  ;   so the message about (and x #t) is in special-case-functions below
+			  (case (car val)
+			    ((not)
+			     (cadr val))
+
+			    ((if)
+			     (if (not (pair? (cddr val)))
+				 form
+				 (let ((if-true (simplify-boolean (list 'not (caddr val)) () () env))
+				       (if-false (or (not (pair? (cdddr val)))  ; (not #<unspecified>) -> #t
+						     (simplify-boolean (list 'not (cadddr val)) () () env))))
+				   ;; ideally we'd call if-walker on this to simplify further
+				   (list 'if (cadr val) if-true if-false))))
+
+			    ((cond case)
+			     `(,(car val)
+			       ,@(if (eq? (car val) 'cond) () (list (cadr val)))
+			       ,@(map (lambda (c)
+					(if (not (and (pair? c)
+						      (> (length c) 1)))
+					    c
+					    (let* ((len (length (cdr c)))
+						   (new-last (let ((last (list-ref c len)))
+							       (if (and (pair? last)
+									(eq? (car last) 'error))
+								   last
+								   (simplify-boolean (list 'not last) () () env)))))
+					      `(,(car c) ,@(copy (cdr c) (make-list (- len 1))) ,new-last))))
+				      ((if (eq? (car val) 'cond) cdr cddr) val))))
+
+			    ((begin)
+			     (let* ((len-1 (- (length val) 1))
+				    (new-last (simplify-boolean (list 'not (list-ref val len-1)) () () env)))
+			       (append (copy val (make-list len-1)) (list new-last))))))
+
+			 ((not (equal? val arg))
+			  (list 'not val))
+
+			 ((not (pair? arg))
+			  form)
+
+			 ((and (memq arg-op '(and or))        ; (not (or|and x (not y))) -> (and|or (not x) y)
+			       (= (length arg) 3)
+			       (or (and (pair? (cadr arg))
+					(eq? (caadr arg) 'not))
+				   (and (pair? (caddr arg))
+					(eq? (caaddr arg) 'not))))
+			  (let ((rel (if (eq? arg-op 'or) 'and 'or)))
+			    (cons rel (map (lambda (p)
+					     (if (and (len=2? p)
+						      (eq? (car p) 'not))
+						 (cadr p)
+						 (simplify-boolean (list 'not p) () () env)))
+					   (cdr arg)))))
+
+			 ((<= (length arg) 3)           ; avoid (<= 0 i 12) and such
+			  (case arg-op
+			    ((< > <= >= odd? even? exact? inexact?char<? char>? char<=? char>=? string<? string>? string<=? string>=?
+				char-ci<? char-ci>? char-ci<=? char-ci>=? string-ci<? string-ci>? string-ci<=? string-ci>=?)
+			     (cons (hash-table-ref notables arg-op) (cdr arg)))
+
+			    ;; null? is not quite right because (not (null? 3)) -> #t
+			    ;; char-upper-case? and lower are not switchable here
+
+			    ((zero?)       ; (not (zero? (logand p 2^n | (ash 1 i)))) -> (logbit? p i)
+			     (if (not (pair? (cdr arg)))
+				 form
+				 (let ((zarg (cadr arg)))  ; (logand...)
+				   (if (not (and (len=3? zarg)
+						 (eq? (car zarg) 'logand)))
+				       form
+				       (let ((arg1 (cadr zarg))
+					     (arg2 (caddr zarg))) ; these are never reversed
+					 (or (and (len>1? arg2)
+						  (eq? (car arg2) 'ash)
+						  (eqv? (cadr arg2) 1)
+						  (list 'logbit? arg1 (caddr arg2)))
+					     (and (integer? arg2)
+						  (positive? arg2)
+						  (zero? (logand arg2 (- arg2 1))) ; it's a power of 2
+						  (list 'logbit? arg1 (floor (log arg2 2)))) ; floor for freeBSD?
+					     form))))))
+
+			    (else form)))
+			 (else form)))))
+
+	    ;; --------------------------------
+	    ((or)
+	     (case len
+	       ((1) #f)
+	       ((2) (if (code-constant? (cadr form)) (cadr form) (classify (cadr form) env)))
+	       (else
+		(call-with-exit
+		 (lambda (return)
+		   (when (= len 3)
+		     (let ((arg1 (cadr form))
+			   (arg2 (caddr form)))
+
+		       (if (and (len>1? arg2)     ; (or A (and ... A ...)) -> A
+				(eq? (car arg2) 'and)
+				(member arg1 (cdr arg2))
+				(not (side-effect? arg2 env)))
+			   (return arg1))
+		       (if (and (pair? arg1)     ; (or (and ... A) A) -> A
+				(eq? (car arg1) 'and)
+				(equal? arg2 (last-ref arg1))
+				(not (side-effect? arg1 env)))
+			   (return arg2))
+
+		       (when (pair? arg2)
+			 (if (and (eq? (car arg2) 'and) ; (or A (and (not A) B)) -> (or A B)
+				  (pair? (cdr arg2))
+				  (len>1? (cadr arg2)))
+			     (if (and (eq? (caadr arg2) 'not)
+				      (equal? arg1 (cadadr arg2)))
+				 (return (cons 'or (cons arg1 (cddr arg2))))
+				 (if (or (and (pair? (cadr arg2))
+					      (eq? (caadr arg2) 'not)
+					      (equal? arg1 (cadadr arg2)))
+					 (and (pair? arg1)
+					      (hash-table-ref reversibles (car arg1))
+					      (equal? arg1 ;(simplify-boolean arg1 () () env)
+						      (simplify-boolean (list 'not (cadr arg2)) () () env))))
+				     (lint-format "perhaps ~A" 'or  ; (or (< x y) (and (>= x y) (= x 2))) -> (or (< x y) (= x 2))
+						  ;; this could be much fancier, but it's not hit much (the 'and case below is not hit at all I think)
+						  (lists->string form
+								 (or (null? (cddr arg2))
+								     (list 'or arg1
+									   (if (pair? (cdddr arg2))
+									       (cons 'and (cddr arg2))
+									       (caddr arg2)))))))))
+			 (when (pair? arg1)
+			   (when (and (eq? (car arg1) 'not)
+				      (len=1? (cdr arg1)))
+			     (if (symbol? (cadr arg1))
+				 (if (memq (cadr arg1) arg2)
+				     (begin
+				       (if (eq? (car arg2) 'boolean?)
+					   (return arg2))
+				       (and-incomplete form 'or (cadr arg1) arg2 env))
+				     (do ((p arg2 (cdr p)))
+					 ((or (not (pair? p))
+					      (and (pair? (car p))
+						   (memq (cadr arg1) (car p))))
+					  (if (pair? p)
+					      (and-incomplete form 'or (cadr arg1) (car p) env)))))
+				 (if (and (len=2? (cadr arg1))   ; (or (not (number? x)) (> x 2)) -> (or (not (real? x)) (> x 2))
+					  (hash-table-ref bools (caadr arg1)))
+				     (if (member (cadadr arg1) arg2)
+					 (and-forgetful form 'or (cadr arg1) arg2 env)
+					 (do ((p arg2 (cdr p)))
+					     ((or (not (pair? p))
+						  (and (pair? (car p))
+						       (member (cadadr arg1) (car p))))
+					      (if (pair? p)
+						  (and-forgetful form 'or (cadr arg1) (car p) env)))))))
+
+			     (if (and (eq? (car arg2) 'and) ; (or (not A) (and A B)) -> (or (not A) B) -- this stuff actually happens!
+				      (len>1? (cdr arg2))
+				      (equal? (cadr arg1) (cadr arg2)))
+				 (return (cons 'or (cons arg1 (cddr arg2))))))
+
+			   (when (and (eq? (car arg1) 'and)
+				      (eq? (car arg2) 'and)
+				      (= 3 (length arg1) (length arg2))
+				      ;; (not (side-effect? arg1 env)) ; maybe??
+				      (or (equal? (cadr arg1) (list 'not (cadr arg2)))
+					  (equal? (list 'not (cadr arg1)) (cadr arg2)))
+				      (not (equal? (caddr arg1) (list 'not (caddr arg2))))
+				      (not (equal? (list 'not (caddr arg1)) (caddr arg2))))
+			     ;; kinda dumb, but common: (or (and A B) (and (not A) C)) -> (if A B C)
+			     ;;    the other side: (and (or A B) (or (not A) C)) -> (if A C (and B #t)), but it never happens
+			     (lint-format "perhaps ~A" 'or
+					  (lists->string form
+							 (if (and (pair? (cadr arg1))
+								  (eq? (caadr arg1) 'not))
+							     (list 'if (cadr arg2) (caddr arg2) (caddr arg1))
+							     (list 'if (cadr arg1) (caddr arg1) (caddr arg2))))))
+			   (let ((t1 (and (pair? (cdr arg1))
+					  (pair? (cdr arg2))
+					  (or (equal? (cadr arg1) (cadr arg2))
+					      (and (len=1? (cddr arg2))
+						   (equal? (cadr arg1) (caddr arg2))))
+					  (not (side-effect? arg1 env))
+					  (and-redundant? arg1 arg2))))
+			     (if t1
+				 (return (if (eq? t1 (car arg1)) arg2 arg1))))
+
+			   ;; if all clauses are (eq-func x y) where one of x/y is a symbol|simple-expr repeated throughout
+			   ;;   and the y is a code-constant, or -> memq and friends.
+			   ;;   This could also handle cadr|caddr reversed, but it apparently never happens.
+			   (if (and (or (and (eq? (car arg2) '=)
+					     (memq (car arg1) '(< > <= >=)))
+					(and (eq? (car arg1) '=)
+					     (memq (car arg2) '(< > <= >=))))
+				    (= (length arg1) 3)
+				    (equal? (cdr arg1) (cdr arg2)))
+			       (return (cons (if (or (memq (car arg1) '(< <=))
+						     (memq (car arg2) '(< <=)))
+						 '<= '>=)
+					     (cdr arg1))))
+
+			   ;; this makes some of the code above redundant
+			   (let ((rel (relsub arg1 arg2 'or env)))
+			     (if (or (boolean? rel)
+				     (pair? rel))
+				 (return rel)))
+
+			   ;; (or (pair? x) (null? x)) -> (list? x)
+			   (when (and (pair? (cdr arg1))
+				      (pair? (cdr arg2))
+				      (equal? (cadr arg1) (cadr arg2)))
+			     (if (and (memq (car arg1) '(null? pair?))
+				      (memq (car arg2) '(null? pair?))
+				      (not (eq? (car arg1) (car arg2))))
+				 (return (list 'list? (cadr arg1))))
+
+			     (if (and (eq? (car arg1) 'zero?)  ; (or (zero? x) (positive? x)) -> (not (negative? x)) -- other cases don't happen
+				      (memq (car arg2) '(positive? negative?)))  ; but +nan.0 messes this up -- perhaps add that to the suggestion?
+				 (return (list 'not (list (if (eq? (car arg2) 'positive?) 'negative? 'positive?)
+							  (cadr arg1))))))
+
+			   ;; (or (and A B) (and (not A) (not B))) -> (eq? (not A) (not B))
+			   ;; more accurately (if A B (not B)), but every case I've seen is just boolean
+			   ;; perhaps also (or (not (or A B)) (not (or (not A) (not B)))), but it never happens
+			   (let ((a1 (cadr form))
+				 (a2 (caddr form)))
+			     (when (and (len=3? a1)
+					(len=3? a2)
+					(eq? (car a1) 'and)
+					(eq? (car a2) 'and))
+			       (let ((A ((if (and (pair? (cadr a1)) (eq? (caadr a1) 'not)) cadadr cadr) a1))
+				     (B (if (and (pair? (caddr a1)) (eq? (caaddr a1) 'not)) (cadr (caddr a1)) (caddr a1))))
+				 (if (or (equal? form `(or (and ,A ,B) (and (not ,A) (not ,B))))
+					 (equal? form `(or (and (not ,A) (not ,B)) (and ,A ,B))))
+				     (return `(eq? (not ,A) (not ,B))))
+				 (if (or (equal? form `(or (and ,A (not ,B)) (and (not ,A) ,B)))
+					 (equal? form `(or (and (not ,A) ,B) (and ,A (not ,B)))))
+				     (return `(not (eq? (not ,A) (not ,B))))))))
+
+			   (when (and (pair? (cdr arg1))
+				      (pair? (cdr arg2))
+				      (not (eq? (car arg1) (car arg2))))
+			     (when (subsumes? (car arg1) (car arg2))
+			       (return arg1))
+
+			     (let ((t2 (if (eq? (car arg1) 'not)
+					   (and (booleans-with-not? arg2 arg1)
+						(or-not-redundant arg2 arg1))
+					   (and (booleans-with-not? arg1 arg2)
+						(or-not-redundant arg1 arg2)))))
+			       (when t2
+				 (if (eq? t2 'true)
+				     (return #t)
+				     (if (pair? t2)
+					 (return t2))))))
+
+			   ;; (or (if a c d) (if b c d)) -> (if (or a b) c d) never happens, sad to say
+			   ;;   or + if + if does happen but not in this easily optimized form
+			   )))) ; len = 3
+
+		   ;; len > 3 or nothing was caught above
+		   (invert-successive-nots return form len env)
+		   (or->memx return form env)
+		   (or->case return form)
+		   (reduce-or return form len true false env))))))
+
+	    ;; --------------------------------
+	    ((and)
+	     (case len
+	       ((1) #t)
+	       ((2) (classify (cadr form) env))
+	       (else
+		(and (not (contradictory? (cdr form)))
+		     (call-with-exit
+		      (lambda (return)
+			(when (= len 3)
+			  (let ((arg1 (cadr form))
+				(arg2 (caddr form)))
+			    (if (and (len>1? arg2)                ; (and A (or A ...)) -> A
+				     (eq? (car arg2) 'or))
+				(if (and (equal? arg1 (cadr arg2))
+					 (not (side-effect? arg2 env)))
+				    (return arg1)
+				    (if (or (and (pair? (cadr arg2))
+						 (eq? (caadr arg2) 'not)
+						 (equal? arg1 (cadadr arg2)))
+					    (and (pair? arg1)
+						 (hash-table-ref reversibles (car arg1))
+						 (equal? arg1 ;(simplify-boolean arg1 () () env)
+							 (simplify-boolean (list 'not (cadr arg2)) () () env))))
+					(lint-format "perhaps ~A" 'and  ; (and (< x y) (or (>= x y) (= x 2))) -> (and (< x y) (= x 2)) ??
+						     (lists->string form
+								    (and (not (null? (cddr arg2)))
+									 (list 'and arg1
+									       (if (pair? (cdddr arg2))
+										   (cons 'or (cddr arg2))
+										   (caddr arg2)))))))))
+			    (if (and (pair? arg1)                ; (and (or ... A ...) A) -> A
+				     (eq? (car arg1) 'or)
+				     (member arg2 (cdr arg1))
+				     (not (side-effect? arg1 env)))
+				(return arg2))
+			    ;; the and equivalent of (or (not A) (and A B)) never happens
+
+			    (when (pair? arg2)
+			      (if (symbol? arg1)                 ; (and x (pair? x)) -> (pair? x)
+				  (if (memq arg1 arg2)
+				      (begin
+					(case (car arg2)
+					  ((not)      (return #f))
+					  ((boolean?) (return (list 'eq? arg1 #t))))
+					(and-incomplete form 'and arg1 arg2 env)
+					(if (hash-table-ref booleans (car arg2))
+					    (return arg2)))
+				      (do ((p arg2 (cdr p)))   ; (and x (+ (log x) 1)) -> (and (number? x)...)
+					  ((or (not (pair? p))
+					       (and (pair? (car p))
+						    (memq arg1 (car p))))
+					   (if (pair? p)
+					       (and-incomplete form 'and arg1 (car p) env)))))
+				  (if (and (len>1? arg1)               ; (and (number? x) (> x 2)) -> (and (real? x) (> x 2))
+					   (hash-table-ref bools (car arg1)))
+				      (if (member (cadr arg1) arg2)
+					  (and-forgetful form 'and arg1 arg2 env)
+					  (do ((p arg2 (cdr p)))
+					      ((or (not (pair? p))
+						   (and (pair? (car p))
+							(member (cadr arg1) (car p))))
+					       (if (pair? p)
+						   (and-forgetful form 'and arg1 (car p) env))))))))
+
+			    (if (and (not (side-effect? arg1 env))
+				     (equal? arg1 arg2))                  ; (and x x) -> x
+				(return arg1))
+
+			    (when (and (len>1? arg1)
+				       (len>1? arg2))
+			      (let ((t1 (and (or (equal? (cadr arg1) (cadr arg2))
+						 (and (len=1? (cddr arg2))
+						      (equal? (cadr arg1) (caddr arg2))))
+					     (not (side-effect? arg1 env))
+					     (and-redundant? arg1 arg2)))) ; (and (integer? x) (number? x)) -> (integer? x)
+				(when t1
+				  (return (cond
+					   ((memq t1 '(eq? eqv? equal?))
+					    (cons t1 (cdr arg2)))
+
+					   ((eq? t1 'memv)
+					    (let ((x ((if (equal? (cadr arg1) (cadr arg2)) caddr cadr) arg2)))
+					      (if (rational? x)
+						  `(memv ,(cadr arg1) '(,x ,(* 1.0 x)))
+						  `(memv ,(cadr arg1) '(,(floor x) ,x)))))
+
+					   ((eq? t1 (car arg1)) arg1)
+					   (else arg2)))))
+
+			      (when (and (hash-table-ref reversibles (car arg1))
+					 (len=1? (cddr arg1))
+					 (len=1? (cddr arg2))
+					 (not (side-effect? arg2 env))             ; arg1 is hit in any case
+					 (or (eq? (car arg1) (car arg2))           ; either ops are equal or
+					     (let ((rf (hash-table-ref reversibles (car arg2))))  ;    try reversed op for arg2
+					       (and (eq? (car arg1) rf)
+						    (set! arg2 (cons rf (reverse (cdr arg2))))))))
+				(when (and (memq (car arg1) '(< <= >= >))          ; (and (op x y) (op x z)) -> (op x (min|max y z))
+					   (equal? (cadr arg1) (cadr arg2)))
+				  (if (and (rational? (caddr arg1))
+					   (rational? (caddr arg2)))
+				      (return (list (car arg1)
+						    (cadr arg1)
+						    ((if (memq (car arg1) '(< <=)) min max) (caddr arg1) (caddr arg2)))))
+				  (if (equal? (caddr arg1) (caddr arg2))             ; (and (< 0 x) (> x 0)) -> (< 0 x)
+				      (return arg1))
+				  (return (list (car arg1)
+						(cadr arg1)
+						(list (if (memq (car arg1) '(< <=)) 'min 'max)
+						      (caddr arg1)
+						      (caddr arg2)))))
+
+				(when (and (or (equal? (caddr arg1) (cadr arg2))     ; (and (op x y) (op y z))
+					       (equal? (cadr arg1) (caddr arg2))     ; (and (op x y) (op z x))
+					       (and (memq (car arg1) '(= char=? string=? char-ci=? string-ci=?))
+						    (or (equal? (cadr arg1) (cadr arg2))
+							(equal? (caddr arg1) (caddr arg2)))))
+					   (let ((ary (arg-arity (car arg1) env)))   ; don't try to combine (and (eq? x y) (eq? y z))!
+					     (and (pair? ary)
+						  (> (cdr ary) 2))))
+				  (let ((op1 (car arg1))
+					(arg1-1 (cadr arg1))
+					(arg1-2 (caddr arg1))
+					(arg2-1 (cadr arg2))
+					(arg2-2 (caddr arg2)))
+				    (return
+				     (cond ((equal? arg1-2 arg2-1)       ; (and (op x y) (op y z)) -> (op x y z)
+					    (if (equal? arg1-1 arg2-2)
+						(if (memq op1 '(= char=? string=? char-ci=? string-ci=?))
+						    arg1
+						    (and (memq op1 '(<= >= char<=? char>=? string<=? string>=?
+									char-ci<=? char-ci>=? string-ci<=? string-ci>=?))
+							 (cons (case op1
+								 ((>= <=) '=)
+								 ((char<= char>=) 'char=?)
+								 ((char-ci<= char-ci>=) 'char-ci=?)
+								 ((string<= string>=) 'string=?)
+								 ((string-ci<= string-ci>=) 'string-ci=?)
+								 (else 'error))
+							       (cdr arg1))))
+						(and (or (not (code-constant? arg1-1))
+							 (not (code-constant? arg2-2))
+							 ((symbol->value op1 (rootlet)) arg1-1 arg2-2))
+						     (list op1 arg1-1 arg2-1 arg2-2))))
+
+					   ((equal? arg1-1 arg2-2)       ; (and (op x y) (op z x)) -> (op z x y)
+					    (if (equal? arg1-2 arg2-1)
+						(and (memq op1 '(= char=? string=? char-ci=? string-ci=?))
+						     arg1)
+						(and (or (not (code-constant? arg2-1))
+							 (not (code-constant? arg1-2))
+							 ((symbol->value op1 (rootlet)) arg2-1 arg1-2))
+						     (list op1 arg2-1 arg1-1 arg1-2))))
+
+					   ;; here we're restricted to equalities and we know arg1 != arg2
+					   ((equal? arg1-1 arg2-1)        ; (and (op x y) (op x z)) -> (op x y z)
+					    (if (and (code-constant? arg1-2)
+						     (code-constant? arg2-2))
+						(and ((symbol->value op1 (rootlet)) arg1-2 arg2-2)
+						     arg1)
+						(list op1 arg1-1 arg1-2 arg2-2)))
+
+					   ;; equalities again
+					   ((and (code-constant? arg1-1)
+						 (code-constant? arg2-1))
+					    (and ((symbol->value op1 (rootlet)) arg1-1 arg2-1)
+						 arg1))
+
+					   (else (list op1 arg1-1 arg1-2 arg2-1)))))))
+
+			      ;; check some special cases
+			      (when (and (or (equal? (cadr arg1) (cadr arg2))
+					     (and (len=1? (cddr arg2))
+						  (equal? (cadr arg1) (caddr arg2))))
+					 (hash-table-ref booleans (car arg1)))
+				(when (or (eq? (car arg1) 'zero?)  ; perhaps rational? and integer? here -- not many hits
+					  (eq? (car arg2) 'zero?))
+				  (if (or (memq (car arg1) '(integer? rational? exact?))
+					  (memq (car arg2) '(integer? rational? exact?)))
+				      (return (list 'eqv? (cadr arg1) 0)))
+				  (if (or (eq? (car arg1) 'inexact?)
+					  (eq? (car arg2) 'inexact?))
+				      (return (list 'eqv? (cadr arg1) 0.0))))
+
+				(when (hash-table-ref and-rel-ops (car arg2))
+				  (when (and (eq? (car arg1) 'symbol?)
+					     (memq (car arg2) '(eq? eqv? equal?))
+					     (or (quoted-symbol? (cadr arg2))
+						 (quoted-symbol? (caddr arg2))))
+				    (return (cons 'eq? (cdr arg2))))
+
+				  (when (and (eq? (car arg1) 'positive?)
+					     (eq? (car arg2) '<)
+					     (eq? (cadr arg1) (cadr arg2)))
+				    (return (list '< 0 (cadr arg1) (caddr arg2))))))
+
+			      (when (and (member (cadr arg1) arg2)
+					 (memq (car arg2) '(string=? char=? eq? eqv? equal?))
+					 (len=2? (cdr arg2))
+					 (hash-table-ref bools (car arg1))
+					 (or (and (code-constant? (cadr arg2))
+						  (compatible? (car arg1) (->lint-type (cadr arg2))))
+					     (and (code-constant? (caddr arg2))
+						  (compatible? (car arg1) (->lint-type (caddr arg2))))))
+				(return (cons (if (eq? (car arg1) 'char?) 'eqv? 'equal?)
+					      (cdr arg2))))
+
+			      (when (and (equal? (cadr arg1) (cadr arg2))
+					 (eq? (car arg1) 'inexact?)
+					 (eq? (car arg2) 'real?))
+				(return (list 'and arg2 arg1)))
+
+			      ;; this makes some of the code above redundant
+			      (let ((rel (relsub arg1 arg2 'and env)))
+				(if (or (boolean? rel)
+					(pair? rel))
+				    (return rel)))
+
+			      ;; (and ... (not...))
+			      (unless (eq? (car arg1) (car arg2))
+				(let ((t2 (if (eq? (car arg1) 'not)
+					      (and (booleans-with-not? arg2 arg1)
+						   (and-not-redundant arg2 arg1))
+					      (and (booleans-with-not? arg1 arg2)
+						   (and-not-redundant arg1 arg2)))))
+				  (cond
+				   ((eq? t2 'contradictory) (return #f))
+				   ((symbol? t2)            (return (cons t2 (cdr (if (eq? (car arg1) 'not) arg2 arg1)))))
+				   ((pair? t2)	            (return t2))))
+				(when (and (eq? (car arg1) 'not)        ; (and (not (eof-object x)) (char=? x #\a)) -> (eqv? x #\a)
+					   (eq? (car arg2) 'char=?)
+					   (pair? (cadr arg1))
+					   (eq? (caadr arg1) 'eof-object?)
+					   (eq? (cadadr arg1) (cadr arg2)))
+				  (return (cons 'eqv? (cdr arg2)))))
+
+			      (when (hash-table-ref bools (car arg1))
+				(let ((p (member (cadr arg1) (cdr arg2))))
+				  (when p
+				    (let ((sig (arg-signature (car arg2) env))
+					  (pos (- (length arg2) (length p))))
+
+				      (when (pair? sig)
+					(let ((arg-type (and (> (length sig) pos)
+							     (list-ref sig pos))))
+					  (unless (compatible? (car arg1) arg-type)
+					    (let ((ln (and (< 0 line-number 100000) line-number)))
+					      (out-format outport "~NCin ~A~A, ~A is ~A, but ~A wants ~A"
+						      lint-left-margin #\space
+						      (truncated-list->string form)
+						      (if (and (integer? ln) (> ln 0)) (format #f " (line ~D)" ln) "")
+						      (cadr arg1)
+						      (prettify-checker-unq (car arg1))
+						      (car arg2)
+						      (prettify-checker arg-type))))))))))
+
+			      (cond ((not (and (eq? (car arg1) 'equal?) ; (and (equal? (car a1) (car a2)) (equal? (cdr a1) (cdr a2))) -> (equal? a1 a2)
+					       (eq? (car arg2) 'equal?)
+					       (pair? (cadr arg1))
+					       (pair? (caddr arg1))
+					       (pair? (cadr arg2))
+					       (pair? (caddr arg2))
+					       (eq? (caadr arg1) (caaddr arg1)))))
+
+				    ((assq (caadr arg1)
+					   '((car cdr #t)
+					     (caar cdar car) (cadr cddr cdr)
+					     (caaar cdaar caar) (caadr cdadr cadr) (caddr cdddr cddr) (cadar cddar cdar)
+					     (cadddr cddddr cdddr) (caaaar cdaaar caaar) (caaadr cdaadr caadr) (caadar cdadar cadar)
+					     (caaddr cdaddr caddr) (cadaar cddaar cdaar) (cadadr cddadr cdadr) (caddar cdddar cddar)))
+				     => (lambda (x)
+					  (if (and (eq? (caadr arg2) (cadr x))
+						   (eq? (caaddr arg2) (cadr x))
+						   (equal? (cadadr arg1) (cadadr arg2))
+						   (equal? (cadr (caddr arg1)) (cadr (caddr arg2))))
+					      (return (if (symbol? (caddr x))
+							  `(equal? (,(caddr x) ,(cadadr arg1)) (,(caddr x) ,(cadr (caddr arg1))))
+							  `(equal? ,(cadadr arg1) ,(cadr (caddr arg1))))))))))))
+
+			;; len > 3 or nothing was caught above
+			(invert-successive-nots return form len env)
+
+			(if (lint-every? (lambda (a)
+					   (and (len>1? a)
+						(or (eq? (car a) 'zero?)
+						    (and (eq? (car a) '=)
+							 (len=2? (cdr a))
+							 (or (eqv? (cadr a) 0)
+							     (eqv? (caddr a) 0))))))
+					 (cdr form))
+			    (return (cons '= (cons 0 (lint-remove-duplicates
+						      (map (lambda (a)
+							     ((if (or (eq? (car a) 'zero?)
+								      (not (eqv? (cadr a) 0)))
+								  cadr caddr)
+							      a))
+							   (cdr form))
+						      env)))))
+
+			(let ((diff (apply and-redundants env (cdr form))))
+			  (when diff
+			    (if (null? (cdr diff))
+				(return (car diff)))
+			    (return (simplify-boolean (cons 'and diff) () () env))))
+			;; now there are redundancies below (see subsumes?) but they assumed the tests were side-by-side
+#|
+			;; (and (or x y) x y) -> (and x y) which doesn't happen to anyone but me
+			(when (= (length form) 4) ; len here does not always reflect form length?
+			  (let ((arg1 (cadr form))
+				(arg2 (caddr form))
+				(arg3 (cadddr form)))
+			    (when (and (pair? arg1) (eq? (car arg1) 'or) (len=3? arg1)
+				       (equal? (cadr arg1) arg2)
+				       (equal? (caddr arg1) arg3))
+			      (return (list 'and arg2 arg3)))))
+|#
+			(reduce-and return form len false env)))))))))
+
+	(define (bsimp x env) ; quick check for common easy cases
+	  (set! last-simplify-boolean-line-number line-number)
+	  (if (not (len>1? x))
+	      x
+	      (case (car x)
+		((and) (and (cadr x)              ; (and #f ...) -> #f
+			    x))
+		((or) (if (and (cadr x)           ; (or #t ...) -> #t
+			       (code-constant? (cadr x)))
+			  (cadr x)
+			  x))
+		(else
+		 (if (not (and (len=2? x)
+			       (pair? (cadr x))
+			       (symbol? (caadr x))))
+		     x
+		     (let ((rt (if (and (memq (caadr x) '(quote #_quote))
+					(pair? (cdadr x)))
+				   (->simple-type (cadadr x))
+				   (return-type (caadr x) env)))
+			   (head (car x)))
+		       (or (and (subsumes? head rt) #t) ; don't return the memq list!
+			   (and (or (memq rt '(#t #f values))
+				    (any-compatible? head rt))
+				(case head
+				  ((null?) (if (eq? (caadr x) 'list)
+					       (null? (cdadr x))
+					       x))
+				  ((pair?) (if (eq? (caadr x) 'list)
+					       (pair? (cdadr x))
+					       x))
+				  ((negative?) (and (not (hash-table-ref non-negative-ops (caadr x)))
+						    x))
+				  (else x))))))))))
+
+	(define (bcomp x true false env) ; not so quick...
+	  (cond ((not (pair? x))
+		 x)
+
+		((eq? (car x) 'and)
+		 (call-with-exit
+		  (lambda (return)
+		    (let ((newx (list 'and)))
+		      (do ((p (cdr x) (cdr p))
+			   (sidex newx)
+			   (endx newx))
+			  ((not (pair? p))
+			   (and (null? p) newx))
+			(let ((next (car p)))
+			  (if (or (not next)        ; #f in and -> end of expr
+				  (member next false))
+			      (if (eq? sidex newx)  ; no side-effects
+				  (return #f)
+				  (begin
+				    (set-cdr! endx (list #f))
+				    (return newx)))
+			      (if (or (code-constant? next)  ; (and ... true-expr ...)
+				      (member next sidex)    ; if a member, and no side-effects since, it must be true
+				      (member next true))
+				  (if (and (null? (cdr p))
+					   (not (equal? next (car endx))))
+				      (set-cdr! endx (list next)))
+				  (begin
+				    (set-cdr! endx (list next))
+				    (set! endx (cdr endx))
+				    (if (side-effect? next env)
+					(set! sidex endx)))))))))))
+
+		((not (eq? (car x) 'or))
+		 x)
+
+		(else
+		 (call-with-exit
+		  (lambda (return)
+		    (let ((newx (list 'or)))
+		      (do ((p (cdr x) (cdr p))
+			   (sidex newx)
+			   (endx newx))
+			  ((not (pair? p))
+			   (if (null? p) newx x))
+			(let ((next (car p)))
+			  (if (or (and next                 ; (or ... #t ...)
+				       (code-constant? next))
+				  (member next true))
+			      (begin
+				(set-cdr! endx (list next))
+				(return newx))          ; we're done since this is true
+			      (if (or (not next)
+				      (member next sidex) ; so its false in some way
+				      (member next false))
+				  (if (and (null? (cdr p))
+					   (not (equal? next (car endx))))
+				      (set-cdr! endx (list next)))
+				  (begin
+				    (set-cdr! endx (list next))
+				    (set! endx (cdr endx))
+				    (if (side-effect? next env)
+					(set! sidex endx)))))))))))))
+
+	;; --------------------------------
+	;; simplify-boolean
+	;;   this is not really simplify boolean as in boolean algebra because in scheme there are many unequal truths, but only one falsehood
+	;;   'and and 'or are not boolean operators in a sense
+	(lambda (in-form true false env)
+	  ;(format *stderr* "simplify-boolean ~S~%" in-form)
+	  (and (not (or (reversible-member in-form false)
+			(and (len>1? in-form)
+			     (eq? (car in-form) 'not)
+			     (reversible-member (cadr in-form) true))))
+	       (or (and (reversible-member in-form true) #t)
+		   (and (len>1? in-form)
+			(eq? (car in-form) 'not)
+			(reversible-member (cadr in-form) false)
+			#t)
+		   (if (not (pair? in-form))
+		       in-form
+		       (let ((form (bcomp (bsimp in-form env) true false env)))
+			 (if (not (and (pair? form)
+				       (memq (car form) '(or and not))))
+			     (classify form env)
+			     (let ((len (length form)))
+			       (if (< len 0)
+				   form
+				   (bool-simp-1 form true false len env)))))))))))
+
+
+    ;; --------------------------------
+    (define undumb
+      (let ((dumb-ops '((fix:+ . +) (fx+ . +) (flo:+ . +) (fl+ . +)
+			(fix:* . *) (fx* . *) (flo:* . *) (fl* . *)
+			(fix:- . -) (fx- . -) (flo:- . -) (fl- . -)
+			(fix:/ . /) (fx/ . /) (flo:/ . /) (fl/ . /)
+			(fix:= . =) (fx= . =) (flo:= . =) (fl= . =)
+			(fix:< . <) (fx< . <) (flo:< . <) (fl< . <)
+			(fix:> . >) (fx> . >) (flo:> . >) (fl> . >)
+			(fix:<= . <=) (fx<= . <=) (flo:<= . <=) (fl<= . <=)
+			(fix:>= . >=) (fx>= . >=) (flo:>= . >=) (fl>= . >=)
+			(fxlogand . logand) (fxlogior . logior) (fxlogxor . logxor) (fxlognot . lognot)
+			(fxand . logand) (fxior . logior) (fxxor . logxor) (fxnot . lognot)
+			(fix:quotient . quotient) (fix:min . min) (fix:max . max) (fxquotient . quotient)
+			(flmax . max) (flmin . min)
+			(flo:abs . abs) (flabs . abs)
+			(flo:sin . sin) (flsin . sin)
+			(flo:cos . cos) (flcos . cos)
+			(flo:tan . tan) (fltan . tan)
+			(flo:asin . asin) (flasin . asin)
+			(flo:acos . acos) (flacos . acos)
+			(flo:atan . atan) (flatan . atan)
+			(flo:sqrt . sqrt) (flsqrt . sqrt)
+			(flo:exp . exp) (flexp . exp) (flexpt . expt)
+			(flo:log . log) (fllog . log)
+			(bignum+ . +) (bignum* . *) (bignum/ . /) (bignum- . -)
+			(bignum< . <) (bignum<= . <=) (bignum> . >) (bignum>= . >=) (bignum= . =)
+			(bignum-quotient . quotient) (bignum-negative? . negative?) (bignum-magnitude . magnitude)
+			(bignum-expt . expt) (bignum-zero? . zero?) (bignum-abs . abs) (bignum-remainder . remainder))))
+	(lambda (tree)
+	  (cond ((assq tree dumb-ops) => cdr)
+		((or (not (pair? tree))
+		     (memq (car tree) '(quote #_quote)))
+		 tree)
+		(else (cons (undumb (car tree))
+			    (undumb (cdr tree))))))))
+
+    (define (splice-if func lst)
+      (cond ;((null? lst) ())
+	    ((not (pair? lst)) lst)
+	    ((and (pair? (car lst))
+		  (eq? func (caar lst))
+		  (proper-list? (cdar lst))) ; for apply
+	     (append (splice-if func (cdar lst))
+		     (splice-if func (cdr lst))))
+	    (else (cons (car lst)
+			(splice-if func (cdr lst))))))
+
+    (define simplify-numerics
+      ;; this returns a form, possibly the original simplified
+
+      (let ()
+
+	(define (integer-result? op)
+	  (memq op '(logior lognot logxor logand numerator denominator floor round truncate ceiling ash int-vector-ref)))
+
+	(define (remove-inexactions val)
+	  (when (and (or (assq 'exact->inexact val)
+			 (assq 'inexact val))
+		     (not (lint-tree-memq 'random val))
+		     (any-numbers? val))
+	    (set! val (map (lambda (x)
+			     (if (and (len>1? x)
+				      (memq (car x) '(inexact exact->inexact)))
+				 (cadr x)
+				 x))
+			   val))
+	    (if (not (lint-any? (lambda (x)
+				  (and (number? x)
+				       (inexact? x)))
+				val))
+		(do ((p val (cdr p)))
+		    ((or (null? p)
+			 (number? (car p)))
+		     (if (pair? p)
+			 (set-car! p (* 1.0 (car p))))))))
+	  val)
+
+	;; polar notation (@) is never used anywhere except test suites
+
+	(define numerics-table
+	  (let ((h (make-hash-table)))
+
+	    (let ((coeffs (make-vector 4 0)))
+	      (define (horners-rule form)
+		(and (pair? form)
+		     (call-with-exit
+		      (lambda (return)
+			(fill! coeffs 0)
+			(do ((p form (cdr p))
+			     (top 0)
+			     (sym #f))
+			    ((not (pair? p))
+			     (do ((x (- top 1) (- x 1))
+				  (result (vector-ref coeffs top)))
+				 ((< x 0)
+				  result)
+			       (set! result
+				      (case (vector-ref coeffs x)
+					((0) (list '* sym result))
+					((0.0) `(inexact (* ,sym ,result)))
+					(else `(+ ,(vector-ref coeffs x) (* ,sym ,result)))))))
+			  (let ((cx (car p)))
+			    (cond ((number? cx)
+				   (vector-set! coeffs 0 (+ (vector-ref coeffs 0) cx)))
+
+				  ((symbol? cx)
+				   (if (not sym)
+				       (set! sym cx)
+				       (if (not (eq? sym cx))
+					   (return #f)))
+				   (set! top (max top 1))
+				   (vector-set! coeffs 1 (+ (vector-ref coeffs 1) 1)))
+
+				  ((not (and (pair? cx)
+					     (eq? (car cx) '*)))
+				   (return #f))
+
+				  (else
+				   (let ((ctr 0)
+					 (ax 1))
+				     (for-each (lambda (qx)
+						 (if (symbol? qx)
+						     (if (not sym)
+							 (begin
+							   (set! sym qx)
+							   (set! ctr 1))
+							 (if (not (eq? sym qx))
+							     (return #f)
+							     (set! ctr (+ ctr 1))))
+						     (if (number? qx)
+							 (set! ax (* ax qx))
+							 (return #f))))
+					       (cdr cx))
+				     (if (>= ctr (length coeffs))
+					 (set! coeffs (copy coeffs (make-vector (* ctr 2) 0))))
+				     (set! top (max top ctr))
+				     (vector-set! coeffs ctr (+ (vector-ref coeffs ctr) ax)))))))))))
+
+	      (define (num+ args form env)
+		(case (length args)
+		  ((0))
+		  ((1) (car args))
+		  (else
+		   (let ((val (remove-all 0 (splice-if '+ args))))
+		     (if (lint-every? (lambda (x) (or (not (number? x)) (rational? x))) val)
+			 (let ((rats (collect-if-rational val)))
+			   (if (len>1? rats)
+			       (let ((y (catch #t (lambda () (apply + rats)) (lambda (type info) (apply format outport info) +nan.0))))
+				 (set! val (if (zero? y)
+					       (collect-if-not-number val)
+					       (cons y (collect-if-not-number val))))))))
+		     (set! val (remove-inexactions val))
+		     (if (lint-any? (lambda (p)        ; collect all + and - vals -> (- (+ ...) ...)
+				      (and (pair? p)
+					   (eq? (car p) '-)))
+				    val)
+			 (let ((plus ())
+			       (minus ())
+			       (c 0))
+			   (for-each (lambda (p)
+				       (if (not (and (pair? p)
+						     (eq? (car p) '-)))
+					   (if (rational? p)
+					       (set! c (+ c p))
+					       (set! plus (cons p plus)))
+					   (if (pair? (cdr p)) ; drop (-)?
+					       (if (null? (cddr p))
+						   (if (rational? (cadr p))
+						       (set! c (- c (cadr p)))
+						       (if (and (pair? (cadr p))
+								(eq? (caadr p) '+))
+							   (set! minus (append (cdadr p) minus))
+							   (set! minus (cons (cadr p) minus))))
+						   (begin
+						     (if (rational? (cadr p))
+							 (set! c (+ c (cadr p)))
+							 (set! plus (cons (cadr p) plus)))
+						     (for-each (lambda (p1)
+								 (if (rational? p1)
+								     (set! c (- c p1))
+								     (set! minus (cons p1 minus))))
+							       (cddr p)))))))
+				     val)
+
+			   (if (not (rational? c)) ; overflow: (+ 9223372036854775806 x (- 12 x))?
+			       (cons '+ val)
+			       (begin
+				 ;; (+ (- x 1) 1000): plus '(x), minus (), c 999 -> (+ x 999)
+				 ;; (+ (- 1 x) 1000):       ()         '(x), 1001 -> (- 1001 x)
+				 ;; (+ (- x y 1) 2 z)      '(z x)      '(y), 1 -> (- (+ x z 1) y)
+				 (when (and (pair? plus)
+					    (pair? minus))
+				   (do ((p plus (cdr p))
+					(np ()))
+				       ((null? p)
+					(set! plus (reverse np)))
+				     (if (and (member (car p) minus)            ; not just member because it matches (random...) etc
+					      (not (side-effect? (car p) env)))
+					 (set! minus (remove-one (car p) minus))
+					 (set! np (cons (car p) np)))))
+
+				 ;; perhaps compare tree-length of the new and old versions, and choose the smaller?
+				 (let ((new-form
+					(if (null? minus)
+					    (simplify-numerics `(+ ,@(reverse plus) ,c) env)
+					    (if (null? plus)
+						(simplify-numerics `(- ,c ,@(reverse minus)) env)
+						(simplify-numerics `(- (+ ,@(reverse plus) ,@(if (positive? c) (list c) ()))
+								       ,@(reverse minus) ,@(if (negative? c) (list (abs c)) ()))
+								   env)))))
+				   (if (> (+ (lint-tree-leaves val) 1) (lint-tree-leaves new-form))
+				       new-form
+				       (cons '+ val))))))  ; to (let ((plus)... above
+
+			 (case (length val)
+			   ((0))                                        ; (+) -> 0
+			   ((1) (car val))                              ; (+ x) -> x
+			   ((2)
+			    (let ((arg1 (car val))
+				  (arg2 (cadr val)))
+			      (cond ((and (real? arg2)                  ; (+ x -1) -> (- x 1)
+					  (negative? arg2)
+					  (not (number? arg1))
+					  (not (= arg2 (*s7* 'most-negative-fixnum)))) ; abs here is now an error
+				     (list '- arg1 (abs arg2)))
+
+				    ((and (real? arg1)                  ; (+ -1 x) -> (- x 1)
+					  (negative? arg1)
+					  (not (number? arg2))
+					  (not (= arg1 (*s7* 'most-negative-fixnum))))
+				     (list '- arg2 (abs arg1)))
+
+				    ((and (pair? arg1)                  ; (+ (if x 0 y) z) -> (if x z (+ y z))
+					  (eq? (car arg1) 'if)
+					  (= (length arg1) 4))
+				     (if (and (pair? arg2)
+					      (eq? (car arg2) 'if))
+					 (cons '+ val)
+					 (let ((true (caddr arg1))
+					       (false (cadddr arg1)))
+					   (if (eqv? true 0) ; does not include 0.0
+					       (if (eqv? false 0)
+						   arg2
+						   `(if ,(cadr arg1) ,arg2 (+ ,false ,arg2)))
+					       (if (eqv? false 0)
+						   `(if ,(cadr arg1) (+ ,true ,arg2) ,arg2)
+						   (cons '+ val))))))
+
+				    ((and (pair? arg2)                   ; (+ z (if x 0 y)) -> (if x z (+ z y))
+					  (eq? (car arg2) 'if)
+					  (= (length arg2) 4))
+				     (let ((true (caddr arg2))
+					   (false (cadddr arg2)))
+				       (if (eqv? true 0) ; does not include 0.0
+					   (if (eqv? false 0)
+					       arg1
+					       `(if ,(cadr arg2) ,arg1 (+ ,arg1 ,false)))
+					   (if (eqv? false 0)
+					       `(if ,(cadr arg2) (+ ,arg1 ,true) ,arg1)
+					       (cons '+ val)))))
+
+				    ((not (and (pair? arg1)
+					       (pair? arg2)))
+				     (cons '+ val))
+
+				    ((and (eq? (car arg1) '*)           ; (+ (* a b) (* a c)) -> (* a (+ b c))
+					  (eq? (car arg2) '*)
+					  (lint-any? (lambda (a)
+						       (member a (cdr arg2)))
+						     (cdr arg1)))
+				     (do ((times ())
+					  (pluses ())
+					  (rset (cdr arg2))
+					  (p (cdr arg1) (cdr p)))
+					 ((null? p)
+					  ;; times won't be () because we checked above for a match
+					  ;;  if pluses is (), arg1 is completely included in arg2
+					  ;;  if rset is (), arg2 is included in arg1
+					  (simplify-numerics `(* ,@(reverse times)
+								 (+ (* ,@(reverse (if (pair? pluses) pluses (list (if (null? pluses) 1 pluses)))))
+								    (* ,@rset)))
+							     env))
+				       (if (member (car p) rset)
+					   (begin
+					     (set! times (cons (car p) times))
+					     (set! rset (remove-one (car p) rset)))
+					   (set! pluses (cons (car p) pluses)))))
+
+				    ((and (eq? (car arg1) '/)  ; (+ (/ a b) (/ c b)) -> (/ (+ a c) b)
+					  (eq? (car arg2) '/)
+					  (pair? (cddr arg1))
+					  (pair? (cddr arg2))
+					  (equal? (cddr arg1) (cddr arg2)))
+				     (cons '/ (cons (list '+ (cadr arg1) (cadr arg2)) (cddr arg1))))
+
+				    ((and (len=2? arg1)         ; (+ (log a) (log b)) -> (log (* a b))
+					  (eq? (car arg1) 'log)
+					  (len=2? arg2)
+					  (eq? (car arg2) 'log))
+				     (list 'log (list '* (cadr arg1) (cadr arg2))))
+
+				    (else (cons '+ val)))))
+			   (else
+			    (or (horners-rule val)
+				;; not many cases here, oddly enough, Horner's rule gets most
+				(cons '+ val)))))))))
+	      (hash-table-set! h '+ num+)
+
+	      (define (dumb+ args form env) (if (var-member (car form) env) form (num+ (undumb args) #f env))) ; not (undone form) because num+ ignores arg2
+	      (for-each (lambda (f) (hash-table-set! h f dumb+)) '(fix:+ fx+ flo:+ fl+ bignum+)))
+
+	    (let ()
+	      (define (num* args form env)
+		(case (length args)
+		  ((0) 1)
+		  ((1) (car args))
+		  (else
+		   (let ((val (remove-all 1 (splice-if '* args))))
+		     (if (lint-every? (lambda (x) (or (not (number? x)) (rational? x))) val)
+			 (let ((rats (collect-if-rational val)))
+			   (if (len>1? rats)
+			       (let ((y (catch #t (lambda () (apply * rats)) (lambda (type info) (apply format outport info) +nan.0))))
+				 (set! val (if (= y 1)
+					       (collect-if-not-number val)
+					       (cons y (collect-if-not-number val))))))))
+		     (set! val (remove-inexactions val))
+
+		     (if (lint-any? (lambda (p)
+				      (and (pair? p)
+					   (eq? (car p) '/)))
+				    val)
+			 (let ((plus ())
+			       (minus ())
+			       (c 1))
+			   (for-each (lambda (p)
+				       (if (not (and (pair? p)
+						     (eq? (car p) '/)))
+					   (if (rational? p)
+					       (set! c (* c p))
+					       (set! plus (cons p plus)))
+					   (if (pair? (cdr p)) ; drop (/)?
+					       (if (null? (cddr p))
+						   (if (rational? (cadr p))
+						       (set! c (/ c (cadr p)))
+						       (set! minus (cons (cadr p) minus)))
+						   (begin
+						     (if (rational? (cadr p))
+							 (set! c (* c (cadr p)))
+							 (set! plus (cons (cadr p) plus)))
+						     (for-each (lambda (p1)
+								 (if (rational? p1)
+								     (set! c (/ c p1))
+								     (set! minus (cons p1 minus))))
+							       (cddr p)))))))
+				     val)
+			   (if (not (rational? c))
+			       (cons '* val)
+			       (begin
+				 (when (and (pair? plus)
+					    (pair? minus))
+				   (do ((p plus (cdr p))
+					(np ()))
+				       ((null? p)
+					(set! plus (reverse np)))
+				     (if (and (member (car p) minus)            ; not just member because it matches (random...) etc
+					      (not (side-effect? (car p) env)))
+					 (set! minus (remove-one (car p) minus))
+					 (set! np (cons (car p) np)))))
+
+				 (let ((new-form
+					(if (null? minus)
+					    (if (null? plus)                      ; (* (/ x y) (/ y x)) -> 1
+						c
+						(if (and (eqv? c 1)
+							 (null? (cdr plus)))
+						    (car plus)                    ; (* x y (/ y)) -> x
+						    (simplify-numerics `(* ,@(if (eqv? c 1) () (list c))
+									   ,@(reverse plus))
+								       env)))     ; (* x (/ y 2) 2 z) -> (* x y z)
+					    (if (null? plus)
+						(if (and (eqv? c 1)
+							 (null? (cdr minus)))
+						    `(/ ,(car minus))             ; (* (/ x) (x x y)) -> (/ y)
+						    (simplify-numerics `(/ ,c ,@(reverse minus)) env)) ; (* (/ x) (/ y) (/ z) -> (/ 1 x y z)
+						(simplify-numerics `(/ ,@(if (and (eqv? c 1)
+										  (null? (cdr plus)))
+									     plus
+									     (list (cons '* (if (eqv? c 1)
+												(reverse plus)
+												(cons c (reverse plus))))))
+								       ,@(reverse minus))
+								   env))))) ; to (let ((plus)... above
+				   (if (> (+ (lint-tree-leaves val) 1) (lint-tree-leaves new-form))
+				       new-form
+				       (cons '* val))))))  ; to (let ((plus)... above
+
+			 (case (length val)
+			   ((0) 1)
+			   ((1) (car val))                         ; (* x) -> x
+			   ((2)
+			    (let ((arg1 (car val))
+				  (arg2 (cadr val)))
+			      (cond ((just-rationals? val)
+				     (let ((new-val (catch #t (lambda () (apply * val)) (lambda (type info) (apply format outport info) +nan.0))))
+				       ;; huge numbers here are less readable
+				       (if (< (abs new-val) 1000000)
+					   new-val
+					   (cons '* val))))
+
+				    ((memv 0 val)                         ; (* x 0) -> 0
+				     0)
+				    ((memv -1 val)
+				     (cons '- (remove-one -1 val)))       ; (* -1 x) -> (- x)
+
+				    ((and (pair? arg1)                    ; (* (if x 1 y) z) -> (if x z (* y z))
+					  (eq? (car arg1) 'if)            ; (* (if x 0 y) z) -> (if x 0 (* y z))
+					  (= (length arg1) 4))
+				     (if (and (pair? arg2)
+					      (eq? (car arg2) 'if))
+					 (cons '* val)
+					 (let ((true (caddr arg1))
+					       (false (cadddr arg1)))
+					   (if (memv true '(0 1)) ; does not include 0.0
+					       `(if ,(cadr arg1) ,(if (eqv? true 1) arg2 0) (* ,false ,arg2))
+					       (if (memv false '(0 1))
+						   `(if ,(cadr arg1) (* ,true ,arg2) ,(if (eqv? false 1) arg2 0))
+						   (cons '* val))))))
+
+				    ((and (pair? arg2)                   ; (* z (if x 1 y)) -> (if x z (* z y))
+					  (eq? (car arg2) 'if)
+					  (= (length arg2) 4))
+				     (let ((true (caddr arg2))
+					   (false (cadddr arg2)))
+				       (if (memv true '(0 1)) ; does not include 0.0
+					   `(if ,(cadr arg2) ,(if (eqv? true 1) arg1 0) (* ,arg1 ,false))
+					   (if (memv false '(0 1))
+					       `(if ,(cadr arg2) (* ,arg1 ,true) ,(if (eqv? false 1) arg1 0))
+					       (cons '* val)))))
+
+				    ((or (equal? arg2 (list '/ arg1))        ; (* a (/ a)) -> 1
+					 (equal? arg2 (list '/ 1 arg1)))
+				     1)
+				    ((or (equal? arg1 (list '/ arg2))        ; (* (/ a) a) -> 1
+					 (equal? arg1 (list '/ 1 arg2)))
+				     1)
+
+				    ((not (pair? arg2))
+				     (cons '* val))
+
+				    ((pair? arg1)
+				     (let ((op1 (car arg1))
+					   (op2 (car arg2)))
+				       (cond ((and (eq? op1 '-)           ; (* (- x) (- y)) -> (* x y)
+						   (null? (cddr arg1))
+						   (eq? op2 '-)
+						   (null? (cddr arg2)))
+					      (list '* (cadr arg1) (cadr arg2)))
+
+					     ((and (eq? op1 '/)           ; (* (/ x) (/ y)) -> (/ (* x y)) etc
+						   (eq? op2 '/))
+					      (let ((op1-arg1 (cadr arg1))
+						    (op2-arg1 (cadr arg2)))
+						(if (null? (cddr arg1))
+						    (if (null? (cddr arg2))
+							(list '/ (list '* op1-arg1 op2-arg1))
+							(if (equal? op1-arg1 op2-arg1)
+							    (list '/ (caddr arg2))
+							    (simplify-numerics `(/ ,op2-arg1 (* ,op1-arg1 ,(caddr arg2))) env)))
+						    (if (null? (cddr arg2))
+							(if (equal? op1-arg1 op2-arg1)
+							    (list '/ (caddr arg1))
+							    (simplify-numerics `(/ ,op1-arg1 (* ,(caddr arg1) ,op2-arg1)) env))
+							(simplify-numerics `(/ (* ,op1-arg1 ,op2-arg1) (* ,@(cddr arg1) ,@(cddr arg2))) env)))))
+
+					     ((and (= (length arg1) 3)
+						   (equal? (cdr arg1) (cdr arg2))
+						   (case op1
+						     ((gcd) (eq? op2 'lcm))
+						     ((lcm) (eq? op2 'gcd))
+						     (else #f)))
+					      (list 'abs (cons '* (cdr arg1))))    ; (* (gcd a b) (lcm a b)) -> (abs (* a b)) but only if 2 args?
+
+					     ((and (eq? op1 'exp)         ; (* (exp a) (exp b)) -> (exp (+ a b))
+						   (eq? op2 'exp))
+					      (list 'exp (list '+ (cadr arg1) (cadr arg2))))
+
+					     ((and (eq? op1 'sqrt)                ; (* (sqrt x) (sqrt y)) -> (sqrt (* x y))??
+						   (eq? op2 'sqrt))
+					      (list 'sqrt (list '* (cadr arg1) (cadr arg2))))
+
+					     ((not (and (eq? op1 'expt) (eq? op2 'expt)))
+					      (cons '* val))
+
+					     ((equal? (cadr arg1) (cadr arg2)) ; (* (expt x y) (expt x z)) -> (expt x (+ y z))
+					      (list 'expt (cadr arg1) (list '+ (caddr arg1) (caddr arg2))))
+
+					     ((equal? (caddr arg1) (caddr arg2)) ; (* (expt x y) (expt z y)) -> (expt (* x z) y)
+					      (list 'expt (list '* (cadr arg1) (cadr arg2)) (caddr arg1)))
+
+					     (else (cons '* val)))))
+
+				    ((and (eq? (car arg2) '/) (null? (cddr arg2))) ; (* a (/ b)) -> (/ a b)
+				     (list '/ arg1 (cadr arg2)))
+
+				    ((and (number? arg1)                  ; (* 2 (random 3.0)) -> (random 6.0) [except for (random 1)...]
+					  (eq? (car arg2) 'random)
+					  (pair? (cdr arg2))
+					  (number? (cadr arg2))
+					  (not (rational? (cadr arg2))))
+				     (list 'random (* arg1 (cadr arg2))))
+
+				    (else (cons '* val)))))
+			   (else
+			    (cond ((just-rationals? val)
+				   (let ((new-val (catch #t (lambda () (apply * val)) (lambda (type info) (apply format outport info) +nan.0))))
+				     ;; huge numbers here are less readable
+				     (if (< (abs new-val) 1000000)
+					 new-val
+					 (cons '* val))))
+
+				  ((memv 0 val)                   ; (* x 0 2) -> 0
+				   0)
+
+				  ((memv -1 val)
+				   (list '- (cons '* (remove-one -1 val))))    ; (* -1 x y) -> (- (* x y))
+
+				  ((let search ((args val))       ; (* x (if y 0 z) w) -> (if y 0 (* x z w))
+				     (and (pair? args)
+					  (let ((has-zero (and (pair? (car args))
+							       (eq? (caar args) 'if)
+							       (= (length (car args)) 4)
+							       (or (eqv? (caddar args) 0)
+								   (eqv? (car (cdddar args)) 0))
+							       (car args))))
+					    (or has-zero
+						(search (cdr args))))))
+				   => (lambda (gif)
+					(let ((other-args (remove-one gif val)))
+					  (list 'if (cadr gif)
+						(if (eqv? (caddr gif) 0) 0 (cons '* (cons (caddr gif) other-args)))
+						(if (eqv? (cadddr gif) 0) 0 (cons '* (cons (cadddr gif) other-args)))))))
+
+				  ((lint-any? (lambda (p)              ; collect * and / vals -> (/ (* ...) ...)
+						(and (pair? p)
+						     (eq? (car p) '/)))
+					      val)
+				   (let ((mul ())
+					 (div ()))
+				     (for-each (lambda (p)
+						 (if (not (and (len>1? p)
+							       (eq? (car p) '/)))
+						     (set! mul (cons p mul))
+						     (if (null? (cddr p))
+							 (set! div (cons (cadr p) div))
+							 (begin
+							   (set! mul (cons (cadr p) mul))
+							   (set! div (append (cddr p) div))))))
+					       val)
+				     (for-each (lambda (n)
+						 (when (member n div)
+						   (set! div (remove-one n div))
+						   (set! mul (remove-one n mul))))
+					       (copy mul))
+				     (let ((expr (if (null? mul)
+						     (if (null? div)
+							 (list '*)       ; for simplify-numerics' benefit
+							 (cons '/ (cons 1 (reverse div))))
+						     (if (null? div)
+							 (cons '* (reverse mul))
+							 `(/ (* ,@(reverse mul)) ,@(reverse div))))))
+				       (if (equivalent? expr form) ; possible NaN
+					   form
+					   (simplify-numerics expr env)))))
+
+				  (else (cons '* val))))))))))
+	      (hash-table-set! h '* num*)
+
+	      (define (dumb* args form env) (if (var-member (car form) env) form (num* (undumb args) form env)))
+	      (for-each (lambda (f) (hash-table-set! h f dumb*)) '(fix:* fx* flo:* fl* bignum*)))
+
+	    (let ()
+	      (define (num- args form env)
+		(let ((args (remove-inexactions args)))
+		  (case (length args)
+		    ((0) form)
+		    ((1) ; negate
+		     (if (number? (car args))
+			 (catch #t (lambda () (- (car args))) (lambda (type info) (apply format outport info) +nan.0))
+			 (if (not (list? (car args)))
+			     (cons '- args)
+			     (case (length (car args))
+			       ((2) (if (eq? (caar args) '-)
+					(cadar args)                 ; (- (- x)) -> x
+					(let ((arg2 (car args)))
+					  (if (and (eq? (car arg2) 'floor) ; (- (floor (- x))) -> (ceiling x)
+						   (pair? (cadr arg2))
+						   (eq? (caadr arg2) '-)
+						   (pair? (cdadr arg2))
+						   (null? (cddadr arg2)))
+					      `(ceiling ,(cadadr arg2))
+					      (if (eq? (car arg2) '*s7*)
+						  (let ((arg22 (eval arg2)))
+						    (catch #t (lambda () (- arg22)) (lambda (type info) (apply format outport info) +nan.0)))
+						  (cons '- args))))))
+			       ((3) (if (eq? (caar args) '-)
+					(list '- (caddar args) (cadar args)) ; (- (- x y)) -> (- y x)
+					(cons '- args)))
+			       (else (cons '- args))))))
+		    (else
+		     (if (just-rationals? args)
+			 (catch #t (lambda () (apply - args)) (lambda (type info) (apply format outport info) +nan.0))
+			 (let ((val (remove-all 0 (splice-if '+ (cdr args)))))
+			   (if (lint-every? (lambda (x) (or (not (number? x)) (rational? x))) val)
+			       (let ((rats (collect-if-rational val)))
+				 (if (len>1? rats)
+				     (let ((y (catch #t (lambda () (apply + rats)) (lambda (type info) (apply format outport info) +nan.0))))
+				       (set! val (if (zero? y)
+						     (collect-if-not-number val)
+						     (cons y (collect-if-not-number val))))))))
+			   (let ((first-arg (car args))
+				 (nargs val))
+
+			     (when (and (member first-arg nargs)
+					(not (side-effect? first-arg env)))
+			       (set! nargs (remove-one first-arg nargs))
+			       (set! first-arg 0))
+
+			     (let ((plus ())
+				   (minus ())
+				   (c 0))
+
+			       (if (not (pair? first-arg))
+				   (set! plus (list first-arg))
+				   (case (car first-arg)
+				     ((+) (set! plus (cdr first-arg)))
+				     ((-)
+				      (if (null? (cddr first-arg))
+					  (set! minus (list (cadr first-arg)))
+					  (begin
+					    (set! plus (list (cadr first-arg)))
+					    (set! minus (cddr first-arg)))))
+				     (else (set! plus (list first-arg)))))
+
+			       (for-each
+				(lambda (arg)
+				  (if (not (pair? arg))
+				      (set! minus (cons arg minus))
+				      (case (car arg)
+					((+) (set! minus (append (cdr arg) minus)))
+					((-)
+					 (if (null? (cddr arg))
+					     (set! plus (cons (cadr arg) plus))
+					     (begin
+					       (set! minus (cons (cadr arg) minus))
+					       (set! plus (append (cddr arg) plus)))))
+					(else (set! minus (cons arg minus))))))
+				nargs)
+
+			       (let ((new-minus ())
+				     (new-plus ()))
+				 (for-each
+				  (lambda (arg)
+				    (if (and (member arg plus)
+					     (not (side-effect? arg env)))
+					(set! plus (remove-one arg plus))
+					(if (rational? arg)
+					    (set! c (catch #t (lambda () (- c arg)) (lambda (type info) (apply format outport info) +nan.0))) ;(- c arg))
+					    (set! new-minus (cons arg new-minus)))))
+				  minus)
+
+				 (for-each
+				  (lambda (arg)
+				    (if (rational? arg)
+					(set! c (+ c arg))
+					(set! new-plus (cons arg new-plus))))
+				  plus)
+
+				 (if (not (rational? c))
+				     (cons '- args)
+				     (let ((new-form
+					    (if (null? new-plus)
+						(if (null? new-minus)
+						    c                                                     ; (- (+ x y) (+ y x)) -> 0
+						    (if (positive? c)
+							`(- ,c ,@new-minus)                               ; (- (+ x 1) (+ y x)) -> (- 1 y)
+							(if (negative? c)
+							    (let ((absc (catch #t (lambda () (abs c)) (lambda (type info) (apply format outport info) (abs (* 1.0 c))))))
+							      `(- (+ ,@new-minus ,absc)))                 ; (- x (+ y x 1)) -> (- (+ y 1))
+							    (if (null? (cdr new-minus))
+								`(- ,(car new-minus))                     ; (- 0 0 x) -> (- x)
+								`(- (+ ,@new-minus))))))                  ; (- 0 0 x y) -> (- (+ x y))
+						(if (null? new-minus)
+						    (if (zero? c)
+							(if (null? (cdr new-plus))
+							    (car new-plus)                                ; (- (+ x 1) (- x y) 1) -> y
+							    `(+ ,@new-plus))                              ; (- (+ x z) (- x y) 0) -> (+ z y)
+							(if (and (negative? c)
+								 (null? (cdr new-plus)))
+							    (let ((absc (catch #t (lambda () (abs c)) (lambda (type info) (apply format outport info) (abs (* 1.0 c))))))
+							      `(- ,(car new-plus) ,absc))                 ; (- (+ x 1) (- x y) 2) -> (- y 1)
+							    `(+ ,@new-plus ,c)))                          ; (- (+ x 1) (- x y) -2) -> (+ y 3)
+						    (if (positive? c)
+							`(- (+ ,@new-plus ,c) ,@new-minus)                ; (- (+ x z 2) x y 1) -> (- (+ z 1) y)
+							(if (negative? c)
+							    (let ((absc (catch #t (lambda () (abs c)) (lambda (type info) (apply format outport info) (abs (* 1.0 c))))))
+							      (if (null? (cdr new-plus))
+								  `(- ,(car new-plus) ,@new-minus ,absc) ; (- (+ x z) x y 1) -> (- z y 1)
+								  `(- (+ ,@new-plus) ,@new-minus ,absc))) ; (- (+ x z w) x y 1) -> (- (+ w z) y 1)
+							    (if (null? (cdr new-plus))
+								`(- ,(car new-plus) ,@new-minus)          ; (- (+ x z) x y) -> (- z y)
+								`(- (+ ,@new-plus) ,@new-minus))))))))    ; (- (+ x z w) x y) -> (- (+ w z) y)
+
+				       (if (len=3? new-form)
+					   (let ((arg1 (cadr new-form))
+						 (arg2 (caddr new-form)))
+					     (cond
+					      ((and (len>1? arg2)                     ; (- x (truncate x)) -> (remainder x 1)
+						    (eq? (car arg2) 'truncate)
+						    (equal? arg1 (cadr arg2)))
+					       (list 'remainder arg1 1))
+
+					      ((and (len>2? arg1)
+						    (len>2? arg2)
+						    (eq? (car arg1) '/)               ; (- (/ a b) (/ c b)) -> (/ (- a c) b)
+						    (eq? (car arg2) '/)
+						    (equal? (cddr arg1) (cddr arg2)))
+					       (cons '/ (cons (list '- (cadr arg1) (cadr arg2)) (cddr arg1))))
+
+					      ((and (len=3? arg1)
+						    (len=3? arg2)
+						    (eq? (car arg1) '*)               ; (- (* a b) (* a c)) -> (* a (- b c))
+						    (eq? (car arg2) '*)               ; (- (* b a) (* c a)) -> (* a (- b c)) etc
+						    (or (member (cadr arg1) arg2)
+							(member (caddr arg1) arg2)))
+					       (if (member (cadr arg1) arg2)
+						   (list '* (cadr arg1) (list '- (caddr arg1) ((if (equal? (cadr arg1) (cadr arg2)) caddr cadr) arg2)))
+						   (list '* (caddr arg1) (list '- (cadr arg1) ((if (equal? (caddr arg1) (cadr arg2)) caddr cadr) arg2)))))
+
+					      ((and (len=2? arg1)                     ; (- (log a) (log b)) -> (log (/ a b))
+						    (eq? (car arg1) 'log)
+						    (len=2? arg2)
+						    (eq? (car arg2) 'log))
+					       (list 'log (list '/ (cadr arg1) (cadr arg2))))
+
+					      ((and (pair? arg2)                      ; (- x (if y 0 z)) -> (if y x (- x z))
+						    (eq? (car arg2) 'if)              ; (- x (if y z 0)) -> (if y (- x z) x)
+						    (= (length arg2) 4)
+						    (or (eqv? (caddr arg2) 0)
+							(eqv? (cadddr arg2) 0)))
+					       (let ((true (caddr arg2))
+						     (false (cadddr arg2)))
+						 `(if ,(cadr arg2)
+						      ,(if (eqv? true 0) arg1 (list '- arg1 true))
+						      ,(if (eqv? true 0) (list '- arg1 false) arg1))))
+
+					      ((and (len=3? arg2)                     ; (- x (* y (quotient x y))) or reversed -> (remainder x y)
+						    (eq? (car arg2) '*)
+						    (or (and (len=3? (caddr arg2))    ; arg2 here is (* y (quotient x y)), arg1 is x
+							     (eq? (caaddr arg2) 'quotient)
+							     (equal? arg1 (cadr (caddr arg2)))
+							     (equal? (cadr arg2) (caddr (caddr arg2)))
+							     `(remainder ,arg1 ,(cadr arg2)))
+							(and (len=3? (cadr arg2))     ; arg2 here is (* (quotient x y) y), arg1 is x
+							     (eq? (caadr arg2) 'quotient)
+							     (equal? arg1 (cadadr arg2))
+							     (equal? (caddr arg2) (caddr (cadr arg2)))
+							     `(remainder ,arg1 ,(caddr arg2))))))
+
+					      (else
+					       (if (> (lint-tree-leaves form) (lint-tree-leaves new-form))
+						   new-form
+						   form))))
+
+					   (if (or (eqv? c 0)
+						   (> (lint-tree-leaves form) (lint-tree-leaves new-form)))
+					       new-form
+					       form)))))))))))))
+	      (hash-table-set! h '- num-)
+
+	      (define (dumb- args form env) (if (var-member (car form) env) form (num- (undumb args) (undumb form) env)))
+	      (for-each (lambda (f) (hash-table-set! h f dumb-)) '(fix:- fx- flo:- fl- bignum-)))
+
+
+	    (let ()
+	      (define (num/ args form env)
+		(let* ((args (remove-inexactions args))
+		       (arg1 (and (pair? args) (car args))))
+		  (case (length args)
+		    ((0) form)
+		    ((1) ; invert
+		     (if (number? arg1)
+			 (if (zero? arg1)
+			     (list '/ arg1)
+			     (/ arg1))
+			 (if (not (pair? arg1))
+			     (cons '/ args)
+			     (case (car arg1)
+			       ((/)
+				(case (length arg1)
+				  ((1) form) ; (/)?
+				  ((2)                         ; (/ (/ x)) -> x
+				   (cadr arg1))
+				  ((3)                         ; (/ (/ z x)) -> (/ x z)
+				   (cons '/ (reverse (cdr arg1))))
+				  (else
+				   (if (eqv? (cadr arg1) 1)
+				       (cons '* (cddr arg1))   ; (/ (/ 1 x y)) -> (* x y)
+				       `(/ (* ,@(cddr arg1)) ,(cadr arg1)))))) ; (/ (/ z x y)) -> (/ (* x y) z)
+			       ((expt)                         ; (/ (expt x y)) -> (expt x (- y))
+				(if (len=2? (cdr arg1))
+				    (list 'expt (cadr arg1) (list '- (caddr arg1)))
+				    (cons '/ args)))
+			       ((exp)                          ; (/ (exp x)) -> (exp (- x))
+				(if (len>1? arg1)
+				    (list 'exp (list '- (cadr arg1)))
+				    (cons '/ args)))
+			       (else (cons '/ args))))))
+		    ((2)
+		     (if (and (just-rationals? args)
+			      (not (zero? (cadr args))))
+			 (catch #t (lambda () (apply / args)) (lambda (type info) (apply format outport info) +nan.0)) ; including (/ 0 12) -> 0
+			 (let ((arg2 (cadr args)))
+			   (let ((op1 (and (pair? arg1) (car arg1)))
+				 (op2 (and (pair? arg2) (car arg2))))
+			     (let ((op1-arg1 (and op1 (pair? (cdr arg1)) (cadr arg1)))
+				   (op2-arg1 (and op2 (pair? (cdr arg2)) (cadr arg2))))
+			       (cond ((eqv? arg1 1)                  ; (/ 1 x) -> (/ x)
+				      (simplify-numerics (list '/ arg2) env))
+
+				     ((eqv? arg2 1)                  ; (/ x 1) -> x
+				      arg1)
+
+				     ((memv arg1 '(0 0.0))           ; (/ 0 x) -> 0 -- this used to worry that arg2 might be 0 or NaN, but the others don't
+				      (if (memv arg2 '(0 0.0))
+					  form                       ; not sure what they intended by (/ 0 0)
+					  arg1))
+
+				     ((eqv? arg1 arg2)               ; (/ x x) -> 1 ignoring infs/NaNs
+				      1)
+
+				     ((or (and (len=2? arg2)         ; (/ (- x) x) -> -1
+					       (eq? op2 '-)
+					       (eqv? arg1 (cadr arg2)))
+					  (and (len=2? arg1)
+					       (eq? op1 '-)
+					       (eqv? (cadr arg1) arg2)))
+				      -1)
+
+				     ((and (len>2? arg1)             ; (/ (/ a b) c) -> (/ a b c)
+					   (eq? op1 '/)
+					   (not (and (pair? arg2)
+						     (eq? op2 '/))))
+				      `(/ ,op1-arg1 ,@(cddr arg1) ,arg2))
+
+				     ((and (pair? arg1)              ; (/ (/ a) (/ b)) -> (/ b a)??
+					   (eq? op1 '/)
+					   (pair? arg2)
+					   (eq? '/ op2))
+				      (let ((a1 (if (null? (cddr arg1)) (list 1 op1-arg1) (cdr arg1)))
+					    (a2 (if (null? (cddr arg2)) (list 1 op2-arg1) (cdr arg2))))
+					(simplify-numerics `(/ (* ,(car a1) ,@(cdr a2)) (* ,@(cdr a1) ,(car a2))) env)))
+
+				     ((and (pair? arg2)
+					   (eq? op2 '*)
+					   (not (side-effect? arg1 env))
+					   (member arg1 (cdr arg2)))
+				      (let ((n (remove-one arg1 (cdr arg2))))
+					(cons '/ (if (len=1? n)
+						     n                ; (/ x (* y x)) -> (/ y)
+					             (cons 1 n)))))   ; (/ x (* y x z)) -> (/ 1 y z)
+
+				     ((and (len>1? arg2)              ; (/ c (/ a b)) -> (/ (* c b) a)
+					   (eq? op2 '/))
+				      (cond ((null? (cddr arg2))
+					     (list '* arg1 op2-arg1)) ; ignoring divide by zero here (/ x (/ y)) -> (* x y)
+					    ((memv op2-arg1 '(0 0.0))
+					     (cons 'a args))          ; same: (/ x (/ 0 ...)) -- give up
+					    ((eqv? op2-arg1 1)
+					     (cons '* (cons arg1 (cddr arg2))))  ; (/ x (/ 1 y z)) -> (* x y z) -- these never actually happen
+					    ((not (pair? (cddr arg2)))
+					     (cons '/ args))          ; no idea...
+					    ((and (rational? arg1)
+						  (rational? op2-arg1)
+						  (null? (cdddr arg2)))
+					     (let ((val (/ arg1 op2-arg1)))
+					       (case val
+						 ((1)  (caddr arg2))
+						 ((-1) (list '- (caddr arg2)))
+						 (else (list '* val (caddr arg2))))))
+					    (else `(/ (* ,arg1 ,@(cddr arg2)) ,op2-arg1))))
+
+				     ((and (len=2? arg1)             ; (/ (log x) (log y)) -> (log x y) -- (log number) for (log y) never happens
+					   (len=2? arg2)
+					   (case op1
+					     ((log) (eq? op2 'log))
+					     ((sin)
+					      (and (eq? op2 'cos)
+						   (equal? op1-arg1 op2-arg1)))
+					     (else #f)))
+				      (if (eq? op1 'log)
+					  (list 'log op1-arg1 op2-arg1)
+					  (list 'tan op1-arg1)))
+
+				     ((and (eq? op1 'sqrt)           ; (/ (sqrt x) (sqrt y)) -> (sqrt (/ x y))
+					   (eq? op2 'sqrt))
+				      (list 'sqrt (list '/ (cadr arg1) (cadr arg2))))
+
+				     ((and (eq? op1 'exp)            ; (/ (exp x) (exp y)) -> (exp (- x y))
+					   (eq? op2 'exp))
+				      (list 'exp (list '- (cadr arg1) (cadr arg2))))
+
+				     ((and (eq? op1 'expt)            ; (/ (expt a x) (expt a y)) -> (expt a (- x y))
+					   (eq? op2 'expt)
+					   (equal? (cadr arg1) (cadr arg2)))
+				      (list 'expt (cadr arg1) (list '- (caddr arg1) (caddr arg2))))
+
+				     ((and (len=2? arg1)             ; (/ (- x) (- y)) -> (/ x y)
+					   (len=2? arg2)
+					   (eq? op1 '-)
+					   (eq? op2 '-))
+				      (list '/ op1-arg1 op2-arg1))
+
+				     ((and (len=3? arg1)
+					   (eq? op1 '-)
+					   (len=3? arg2)
+					   (memq op2 '(+ -))
+					   (len=3? (cadr arg1))
+					   (eq? (caadr arg1) '*)
+					   (equal? (cadadr arg1) (cadr(cdadr arg1)))
+					   (len=3? (caddr arg1))
+					   (eq? (caaddr arg1) '*)
+					   (equal? (cadr (caddr arg1)) (caddr (caddr arg1)))
+					   (equal? (cadr arg2) (cadadr arg1))
+					   (equal? (caddr arg2) (cadr (caddr arg1))))
+				      (cons (if (eq? op2 '-) '+ '-) (cdr arg2)))
+
+				     ((and (pair? arg1)             ; (/ (* x y) (* z y)) -> (/ x z)
+					   (pair? arg2)
+					   (eq? op1 '*)
+					   (case op2
+					     ((*)
+					      (and (= (length arg1) (length arg2) 3)
+						   (equal? (caddr arg1) (caddr arg2))))
+					     ((log)
+					      (cond ((assq 'log (cdr arg1))
+						     => (lambda (p)
+							  (= (length p) 2)))
+						    (else #f)))
+					     (else #f))           ; (/ (* 12 (log x)) (log 2)) -> (* 12 (log x 2))
+					   (if (eq? op2 '*)
+					       (list '/ op1-arg1 op2-arg1)
+					       (let ((used-log op2-arg1))
+						 (cons '* (map (lambda (p)
+								  (if (and used-log
+									   (pair? p)
+									   (eq? (car p) 'log))
+								      (let ((val (list 'log (cadr p) used-log)))
+									(set! used-log #f)
+									val)
+								      p))
+								(cdr arg1)))))))
+
+				     ((and (len>1? arg1)           ; (/ (sqrt x) x) -> (/ (sqrt x))
+					   (eq? (car arg1) 'sqrt)
+					   (equal? (cadr arg1) arg2))
+				      (list '/ arg1))
+
+				     ((and (len>1? arg2)           ; (/ x (sqrt x)) -> (sqrt x)
+					   (eq? (car arg2) 'sqrt)
+					   (equal? (cadr arg2) arg1))
+				      arg2)
+
+				     (else (cons '/ args))))))))
+
+		    (else
+		     ;; spot check of divides in lg didn't turn up any that need the plus/minus style handling of + et al above
+		     (if (memv arg1 '(0 0.0))                      ; (/ 0 x y) -> 0 (to be consistent with other results)
+			 arg1
+			 (if (and (just-rationals? args)
+				  (not (memv 0 (cdr args)))
+				  (not (memv 0.0 (cdr args))))
+			     (catch #t (lambda () (apply / args)) (lambda (type info) (apply format outport info) +nan.0))
+			     ;; if no overflow catch we can hit divide by zero here
+			     (let ((nargs                            ; (/ x a (* b 1 c) d) -> (/ x a b c d)
+				    (remove-all 1 (splice-if '* (cdr args)))))
+			       (if (null? nargs) ; (/ x 1 1) -> x
+				   arg1
+				   (if (and (member (car args) (cdr args))
+					    (not (side-effect? arg1 env)))
+				       (let ((n (remove-one arg1 (cdr args))))
+					 (cons '/ (if (null? (cdr n))
+						      n                ; (/ x y x) -> (/ y)
+						      (cons 1 n))))    ; (/ x y x z) -> (/ 1 y z)
+				       (cons '/ (cons arg1 nargs)))))))))))
+	      (hash-table-set! h '/ num/)
+
+	      (define (dumb/ args form env) (if (var-member (car form) env) form (num/ (undumb args) (undumb form) env)))
+	      (for-each (lambda (f) (hash-table-set! h f dumb/)) '(fix:/ fx/ flo:/ fl/ bignum/)))
+
+	    (let ()
+	      (define (numtrig args form env)
+		(let ((head (car form)))
+		  ;; perhaps someday, for amusement:
+		  ;;    (sin (acos x)) == (cos (asin x)) == (sqrt (- 1 (expt x 2)))
+		  ;;    (asin (cos x)) == (acos (sin x)) == (- (* 1/2 pi) x)
+		  ;; also since (for example) sin(x - y) = -sin(y - x) and cos(x - y) = cos(y - x), can other simplifiers swap?
+		  (cond ((not (len=1? args))
+			 (cons head args))
+
+			((and (len=2? (car args))                 ; (sin (asin x)) -> x
+			      (eq? (caar args)
+				   (case head
+				     ((sin) 'asin)
+				     ((cos) 'acos)
+				     ((tan) 'atan)
+				     ((asin) 'sin)
+				     ((acos) 'cos)
+				     ((atan) 'tan)
+				     ((sinh) 'asinh)
+				     ((cosh) 'acosh)
+				     ((tanh) 'atanh)
+				     ((asinh) 'sinh)
+				     ((acosh) 'cosh)
+				     ((atanh) 'tanh)
+				     ((log) 'exp)
+				     ((exp) 'log)
+				     (else 'error))))
+			 (cadar args))
+
+			((eqv? (car args) 0)                     ; (sin 0) -> 0
+			 (case head
+			   ((sin asin sinh asinh tan tanh atanh) 0)
+			   ((exp cos cosh) 1)
+			   (else (cons head args))))
+
+			((and (eq? head 'cos)                    ; (cos (- x)) -> (cos x)
+			      (len=2? (car args))
+			      (eq? (caar args) '-))
+			 (list 'cos (cadar args)))
+
+			((or (eq? (car args) 'pi)                ; (sin pi) -> 0.0
+			     (and (len=2? (car args))
+				  (eq? (caar args) '-)
+				  (eq? (cadar args) 'pi)))
+			 (case head
+			   ((sin tan) 0.0)
+			   ((cos) -1.0)
+			   (else (cons head args))))
+
+			((eqv? (car args) 0.0)             ; (sin 0.0) -> 0.0
+			 ((symbol->value head (rootlet)) 0.0))
+
+			((and (eq? head 'acos)             ; (acos -1) -> pi
+			      (eqv? (car args) -1))
+			 'pi)
+
+			((and (eq? head 'exp)              ; (exp (* a (log b))) -> (expt b a)
+			      (pair? (car args))
+			      (eq? (caar args) '*))
+			 (let ((targ (cdar args)))
+			   (cond ((not (= (length targ) 2))
+				  (cons head args))
+				 ((and (len=2? (car targ))
+				       (eq? (caar targ) 'log))
+				  (list 'expt (cadar targ) (cadr targ)))
+				 ((and (len=2? (cadr targ))
+				       (eq? (caadr targ) 'log))
+				  (list 'expt (cadadr targ) (car targ)))
+				 (else (cons head args)))))
+
+			(else (cons head args)))))
+	      (for-each
+	       (lambda (f)
+		 (hash-table-set! h f numtrig))
+	       '(sin cos tan asin acos sinh cosh tanh asinh acosh atanh exp)))
+
+	    (let ()
+	      (define (numlog args form env)
+		(let ((len (length args)))
+		  (cond ((not (pair? args)) form)
+
+			((eqv? (car args) 1) 0)      ; (log 1 ...) -> 0
+
+			((and (= len 1)              ; (log (exp x)) -> x
+			      (len=2? (car args))
+			      (eq? (caar args) 'exp))
+			 (cadar args))
+
+			((and (= len 1)
+			      (pair? (car args))
+			      (eq? (caar args) '/)
+			      (or (len=2? (car args))
+				  (and (len=3? (car args))
+				       (eqv? (cadar args) 1))))
+			 (list '- (list 'log (if (len=2? (car args)) (cadar args) (caddar args)))))
+
+			((and (len=2? (car args))     ; (log (sqrt x)) -> (* 1/2 (log x))
+			      (eq? (caar args) 'sqrt))
+			 `(* 1/2 (log ,(cadar args) ,@(cdr args))))
+
+			((and (len=3? (car args))     ; (log (expt x y)) -> (* y (log x))
+			      (eq? (caar args) 'expt))
+			 `(* ,(caddar args) (log ,(cadar args) ,@(cdr args))))
+
+			((not (and (= len 2)         ; (log x x) -> 1.0
+				   (equal? (car args) (cadr args))))
+			 (cons 'log args))
+
+			((integer? (car args)) 1)
+
+			(else 1.0))))
+	      (hash-table-set! h 'log numlog))
+
+	    (let ()
+	      (define (numintlen args form env)
+		(if (and (len=1? (cdr form))
+			 (integer? (cadr form)))
+		    (integer-length (cadr form))
+		    form))
+	      (hash-table-set! h 'integer-length numintlen))
+
+	    (let ()
+	      (define (numsqrt args form env)
+		(cond ((not (pair? args))
+		       form)
+		      ((and (rational? (car args))
+			    (rational? (sqrt (car args)))
+			    (= (car args) (sqrt (* (car args) (car args)))))
+		       (sqrt (car args))) ; don't collapse (sqrt (* a a)), a=-1 for example, or -1-i -> 1+i whereas 1-i -> 1-i etc
+		      ((and (len>1? (car args))
+			    (eq? (caar args) 'exp))
+		       (list 'exp (list '/ (cadar args) 2))) ; (sqrt (exp x)) -> (exp (/ x 2))
+		      (else (cons 'sqrt args))))
+	      (hash-table-set! h 'sqrt numsqrt))
+
+	    (let ()
+	      (define (numfloor args form env)
+		(cond ((not (len=1? args))
+		       form)
+
+		      ((number? (car args))
+		       (catch #t
+			 (lambda () (apply (symbol->value (car form) (rootlet)) args))
+			 (lambda any (cons (car form) args))))
+
+		      ((not (len>1? (car args)))
+		       (cons (car form) args))
+
+		      ((or (integer-result? (caar args))
+			   (and (eq? (caar args) 'random)
+				(pair? (cdar args))
+				(integer? (cadar args))))
+		       (car args))
+
+		      ((and (eq? (car form) 'truncate)  ; (truncate (/ x y)) -> (quotient x y)
+			    (pair? (cdr form))
+			    (pair? (cadr form))
+			    (eq? (caadr form) '/)
+			    (len=3? (cadr form)))
+		       (cons 'quotient (cdadr form)))
+		      ;; if we know arg1 is int, (quotient arg1 -1) -> (- arg1)
+
+		      ((memq (caar args) '(inexact->exact exact))
+		       (list (car form) (cadar args)))
+
+		      ((memq (caar args) '(* + / -)) ; maybe extend this list
+		       `(,(car form) (,(caar args) ,@(map (lambda (p)
+							    (if (and (len=2? p)
+								     (memq (car p) '(inexact->exact exact)))
+								(cadr p)
+								p))
+							  (cdar args)))))
+		      ((and (eq? (caar args) 'random)
+			    (eq? (car form) 'floor)
+			    (null? (cddar args))
+			    (float? (cadar args))
+			    (not (nan? (cadar args)))   ; (floor (random +nan.0))!
+			    (= (floor (cadar args)) (cadar args)))
+		       (list 'random (floor (cadar args))))
+
+		      (else (cons (car form) args))))
+
+	      (for-each
+	       (lambda (f)
+		 (hash-table-set! h f numfloor))
+	       '(floor round ceiling truncate)))
+
+	    (let ()
+	      (define (numabs args form env)
+		(cond ((not (len=1? args))
+		       form)
+
+		      ((and (pair? (car args))        ; (abs (abs x)) -> (abs x)
+			    (hash-table-ref non-negative-ops (caar args)))
+		       (car args))
+
+		      ((rational? (car args))
+		       (catch #t (lambda () (abs (car args))) (lambda (type info) (apply format outport info) +nan.0))) ; (abs -9223372036854775808)
+
+		      ((not (pair? (car args)))
+		       (cons (car form) args))
+
+		      ((and (memq (caar args) '(modulo random))
+			    (= (length (car args)) 3) ; (abs (modulo x 2)) -> (modulo x 2)
+			    (real? (caddar args))
+			    (positive? (caddar args)))
+		       (car args))
+
+		      ((and (eq? (caar args) '-)      ; (abs (- x)) -> (abs x)
+			    (len=1? (cdar args)))
+		       (list (car form) (cadar args)))
+
+		      ;; make-polar as arg never happens
+
+		      (else (cons (car form) args))))
+	      (hash-table-set! h 'abs numabs)
+	      (hash-table-set! h 'magnitude numabs))
+
+	    (let ()
+	      (define (real-result? op)
+		(memq op '(imag-part real-part abs magnitude angle max min exact->inexact inexact modulo remainder quotient lcm gcd)))
+
+	      (define (numimag args form env)
+		(if (not (len=1? args))
+		    form
+		    (if (or (real? (car args))
+			    (and (pair? (car args))
+				 (real-result? (caar args))))
+			0.0
+			(cons 'imag-part args))))
+	      (hash-table-set! h 'imag-part numimag)
+
+	      (define (numreal args form env)
+		(if (not (len=1? args))
+		    form
+		    (if (or (real? (car args))
+			    (and (pair? (car args))
+				 (real-result? (caar args))))
+			(car args)
+			(cons 'real-part args))))
+	      (hash-table-set! h 'real-part numreal))
+
+	    (let ()
+	      (define (numden args form env)
+		(if (not (len=1? args))
+		    form
+		    (if (or (integer? (car args))
+			    (and (pair? (car args))
+				 (integer-result? (caar args))))
+			1
+			(list 'denominator (car args)))))
+	      (hash-table-set! h 'denominator numden))
+
+	    (let ()
+	      (define (numnum args form env)
+		(cond ((not (len=1? args))
+		       form)
+		      ((or (integer? (car args))
+			   (and (pair? (car args))
+				(integer-result? (caar args))))
+		       (car args))
+		      ((rational? (car args))
+		       (numerator (car args)))
+		      (else (list 'numerator (car args)))))
+	      (hash-table-set! h 'numerator numnum))
+
+	    (let ()
+	      (define (numran args form env)
+		(if (not (and (len=1? args)
+			      (number? (car args))))
+		    (cons 'random args)
+		    (case (car args)
+		      ((0 1 -1) 0)
+		      ((0.0) 0.0)
+		      (else (cons 'random args)))))
+	      (hash-table-set! h 'random numran))
+
+	    (let ()
+	      (define (numcmplx args form env)
+		;; (complex (/ a b) (/ c b)) can't be simplified because a b c might be complex and
+		;;    (/ (complex a c) b) would raise an error that a and c were not real (similarly for other such cases)
+		(if (and (len=2? args)
+			 (memv (cadr args) '(0 0.0))) ; (complex 2 0.0) -> 2 which is dubious...
+		    (car args)
+		    (cons 'complex args)))
+	      (hash-table-set! h 'complex numcmplx)
+	      (hash-table-set! h 'make-rectangular numcmplx))
+
+	    (let ()
+	      (define (numpol args form env)
+		(if (and (len=2? args)
+			 (equivalent? (cadr args) 0.0))
+		    (car args)
+		    (cons 'make-polar args)))
+	      (hash-table-set! h 'make-polar numpol))
+
+	    (let ()
+	      (define (numrat args form env)
+		(let ((len2 (= (length args) 2))
+		      (head (car form)))
+		  (cond ((just-rationals? args)
+			 (catch #t ; catch needed here for things like (ash 2 64)
+			   (lambda ()
+			     (apply (symbol->value head (rootlet)) args))
+			   (lambda ignore
+			     (cons head args)))) ; use this form to pick up possible arg changes
+
+			((and (eq? head 'ash)          ; (ash x 0) -> x
+			      len2
+			      (eqv? (cadr args) 0))
+			 (car args))
+
+			((case head
+			   ((quotient)                 ; (quotient (remainder x y) y) -> 0
+			    (and len2
+				 (len=3? (car args))
+				 (eq? (caar args) 'remainder)
+				 (eqv? (caddar args) (cadr args))))
+			   ((ash modulo)               ; (modulo 0 x) -> 0
+			    (and len2 (eqv? (car args) 0)))
+			   (else #f))
+			 0)
+
+			((and (eq? head 'modulo)       ; (modulo (abs x) y) -> (modulo x y)
+			      len2
+			      (pair? (car args))
+			      (eq? (caar args) 'abs))
+			 (list 'modulo (cadar args) (cadr args)))
+
+			(else (cons head args)))))
+	      (for-each
+	       (lambda (f)
+		 (hash-table-set! h f numrat))
+	       '(rationalize lognot ash modulo remainder quotient)))
+
+	    (let ()
+	      (define (numexpt args form env)
+		(cond ((not (len=2? args))
+		       form)
+
+		      ((and (eqv? (car args) 0)            ; (expt 0 x) -> 0
+			    (not (eqv? (cadr args) 0)))
+		       (if (and (integer? (cadr args))
+				(negative? (cadr args)))
+			   (lint-format "attempt to divide by 0: ~A" 'expt (truncated-list->string form)))
+		       0)
+
+		      ((or (and (eqv? (cadr args) 0)       ; (expt x 0) -> 1
+				(not (eqv? (car args) 0)))
+			   (eqv? (car args) 1))            ; (expt 1 x) -> 1
+		       1)
+
+		      ((eqv? (cadr args) 1)                ; (expt x 1) -> x
+		       (car args))
+
+		      ((eqv? (cadr args) -1)               ; (expt x -1) -> (/ x)
+		       (list '/ (car args)))
+
+		      ((just-rationals? args)              ; (expt 2 3) -> 8
+		       (catch #t
+			 (lambda ()
+			   (let ((val (apply expt args)))
+			     (if (and (integer? val)
+				      (< (abs val) 1000000))
+				 val
+				 (cons 'expt args))))
+			 (lambda args
+			   (cons 'expt args))))
+
+		      ((and (pair? (car args))             ; (expt (expt x y) z) -> (expt x (* y z))
+			    (eq? (caar args) 'expt))
+		       `(expt ,(cadar args) (* ,(caddar args) ,(cadr args))))
+
+		      ((and (pair? (car args))             ; (expt (exp x) y) -> (exp (* x y))
+			    (eq? (caar args) 'exp))
+		       `(exp (* ,(cadar args) ,(cadr args))))
+
+		      (else (cons 'expt args))))
+	      (hash-table-set! h 'expt numexpt))
+
+	    (let ()
+	      (define (numang args form env)
+		(cond ((not (pair? args)) form)
+		      ((eqv? (car args) -1) 'pi)
+		      ((or (equivalent? (car args) 0.0)
+			   (eq? (car args) 'pi))
+		       0.0)
+		      (else (cons 'angle args))))
+	      (hash-table-set! h 'angle numang))
+
+	    (let ()
+	      (define (numatan args form env)
+		(cond ((and (len=1? args)                    ; (atan (x y)) -> (atan x y)
+			    (len=3? (car args))
+			    (eq? (caar args) '/))
+		       (cons 'atan (cdar args)))
+		      ((and (len=2? args)                    ; (atan 0 -1) -> pi
+			    (eqv? (car args) 0)
+			    (eqv? (cadr args) -1))
+		       'pi)
+		      (else (cons 'atan args))))
+	      (hash-table-set! h 'atan numatan))
+
+	    (let ()
+	      (define (rational-result? op)
+		(memq op '(rationalize inexact->exact exact)))
+
+	      (define (numexact args form env)  ; inexact->exact
+		(cond ((not (len=1? args))
+		       form)
+
+		      ((or (rational? (car args))
+			   (and (pair? (car args))
+				(or (rational-result? (caar args))
+				    (integer-result? (caar args))
+				    (and (eq? (caar args) 'random)
+					 (pair? (cdar args))
+					 (rational? (cadar args)))))) ; perhaps (exact (random 10.0)) -> (random 10)??
+		       (car args))
+
+		      ((number? (car args))
+		       (catch #t (lambda () (inexact->exact (car args))) (lambda any (cons (car form) args))))
+
+		      (else (cons (car form) args))))
+	      (hash-table-set! h 'inexact->exact numexact)
+	      (hash-table-set! h 'exact numexact))
+
+	    (let ()
+	      (define (numinexact args form env) ; exact->inexact
+		(cond ((not (len=1? args))
+		       form)
+
+		      ((number? (car args))
+		       (catch #t (lambda () (exact->inexact (car args))) (lambda any (cons (car form) args))))
+
+		      ((and (pair? (car args))  ; this should be expanded
+			    (eq? (caar args) 'float-vector-ref))
+		       (car args))
+
+		      ((not (and (pair? (car args))
+				 (not (eq? (caar args) 'random))
+				 (hash-table-ref numeric-ops (caar args))
+				 (any-numbers? (cdar args))))
+		       (cons (car form) args))
+
+		      ((lint-any? (lambda (x)
+				    (and (number? x)
+					 (inexact? x)))
+				  (cdar args))
+		       (car args))
+
+		      (else
+		       (let ((new-form (copy (car args))))
+			 (do ((p (cdr new-form) (cdr p)))
+			     ((or (null? p)
+				  (number? (car p)))
+			      (if (pair? p)
+				  (set-car! p (* 1.0 (car p))))
+			      new-form))))))
+	      ;; not (inexact (random 3)) -> (random 3.0) because results are different
+	      (hash-table-set! h 'exact->inexact numinexact)
+	      (hash-table-set! h 'inexact numinexact))
+
+	    (let ()
+	      (define (numior args form env)
+		(let ((args (lint-remove-duplicates (remove-all 0 (splice-if 'logior args)) env)))
+		  (if (lint-every? (lambda (x) (or (not (number? x)) (integer? x))) args)
+		      (let ((rats (collect-if-integer args)))
+			(if (len>1? rats)
+			    (let ((y (apply logior rats)))
+			      (set! args (if (zero? y)
+					     (collect-if-not-number args)
+					     (cons y (collect-if-not-number args))))))))
+		  (cond ((null? args) 0)                ; (logior) -> 0
+			((null? (cdr args)) (car args)) ; (logior x) -> x
+			((memv -1 args) -1)             ; (logior ... -1 ...) -> -1
+			((just-integers? args) (apply logior args))
+			(else (cons 'logior args)))))
+	      (hash-table-set! h 'logior numior)
+
+	      (define (numand args form env)
+		(let ((args (lint-remove-duplicates (remove-all -1 (splice-if 'logand args)) env)))
+		  (if (lint-every? (lambda (x) (or (not (number? x)) (integer? x))) args)
+		      (let ((rats (collect-if-integer args)))
+			(if (len>1? rats)
+			    (let ((y (apply logand rats)))
+			      (set! args (if (= y -1)
+					     (collect-if-not-number args)
+					     (cons y (collect-if-not-number args))))))))
+		  (cond ((null? args) -1)
+			((null? (cdr args)) (car args)) ; (logand x) -> x
+			((memv 0 args) 0)
+			((just-integers? args) (apply logand args))
+			(else (cons 'logand args)))))
+
+	      ;; (logand 1 (logior 2 x)) -> (logand 1 x)?
+	      ;; (logand 1 (logior 1 x)) -> 1
+	      ;; (logand 3 (logior 1 x))?
+	      ;; similarly for (logior...(logand...))
+
+	      (hash-table-set! h 'logand numand)
+
+	      (define (numxor args form env)
+		(let ((args (splice-if 'logxor args))) ; is this correct??
+		  (cond ((null? args) 0)                                    ; (logxor) -> 0
+			((null? (cdr args)) (car args))                     ; (logxor x) -> x??
+			((just-integers? args) (apply logxor args))         ; (logxor 1 2) -> 3
+			((and (len=2? args) (equal? (car args) (cadr args))) 0) ; (logxor x x) -> 0
+			(else (cons 'logxor args)))))                           ; (logxor x (logxor y z)) -> (logxor x y z)
+	      (hash-table-set! h 'logxor numxor))
+
+	    (let ()
+	      (define (numgcd args form env)
+		(let ((args (lint-remove-duplicates (splice-if 'gcd args) env)))
+		  (cond ((null? args) 0)
+			((memv 1 args) 1)
+			((just-rationals? args)
+			 (catch #t  ; maybe (gcd -9223372036854775808 -9223372036854775808)
+			   (lambda ()
+			     (apply gcd args))
+			   (lambda ignore
+			     (cons 'gcd args))))
+			((null? (cdr args))   (list 'abs (car args)))
+			((eqv? (car args) 0)  (list 'abs (cadr args)))
+			((eqv? (cadr args) 0) (list 'abs (car args)))
+			(else (cons 'gcd args)))))
+	      (hash-table-set! h 'gcd numgcd))
+
+	    (let ()
+	      (define (numlcm args form env)
+		(let ((args (lint-remove-duplicates (splice-if 'lcm args) env)))
+		  (cond ((null? args) 1)         ; (lcm) -> 1
+			((memv 0 args) 0)        ; (lcm ... 0 ...) -> 0
+			((just-rationals? args)  ; (lcm 3 4) -> 12
+			 (catch #t
+			   (lambda ()
+			     (apply lcm args))
+			   (lambda ignore
+			     (cons 'lcm args))))
+			((null? (cdr args))      ; (lcm x) -> (abs x)
+			 (list 'abs (car args)))
+			(else (cons 'lcm args)))))
+	      (hash-table-set! h 'lcm numlcm))
+
+	    (let ()
+	      (define (nummax args form env)
+		(if (not (pair? args))
+		    form
+		    (begin
+		      (set! args (lint-remove-duplicates (splice-if (car form) args) env))
+		      (if (lint-any? (lambda (p) ; if non-negative-op, remove any non-positive numbers
+				       (and (pair? p)
+					    (hash-table-ref non-negative-ops (car p))))
+				     args)
+			  (set! args (remove-if (lambda (x)
+						  (and (real? x)
+						       (not (positive? x))))
+						args)))
+		      (if (len=1? args)
+			  (car args)
+			  (if (and (len>1? args)
+				   (just-reals? args))
+			      (apply (symbol->value (car form) (rootlet)) args)
+			      (let ((nums (collect-if-real args))
+				    (other (if (eq? (car form) 'min) 'max 'min)))
+				(if (pair? nums)
+				    (let ((relop (if (eq? (car form) 'min) >= <=)))
+				      (if (pair? (cdr nums))
+					  (set! nums (list (apply (symbol->value (car form) (rootlet)) nums))))
+				      (let ((new-args (append nums (collect-if-not-number args))))
+					(let ((c1 (car nums)))
+					  (set! new-args (collect-if (lambda (x)
+								       (or (not (pair? x))
+									   (<= (length x) 2)
+									   (not (eq? (car x) other))
+									   (let ((c2 (lint-find-if real? (cdr x))))
+									     (or (not c2)
+										 (relop c1 c2)))))
+								     new-args)))
+					(if (< (length new-args) (length args))
+					    (set! args new-args)))))            ; might set args to ()?
+
+				;; if (max c1 (min c2 . args1) . args2) where (> c1 c2) -> (max c1 . args2), if = -> c1
+				;; if (min c1 (max c2 . args1) . args2) where (< c1 c2) -> (min c1 . args2), if = -> c1
+				;;   and if (max 4 x (min x 4)) -- is it (max x 4)?
+				;; (max a b) is (- (min (- a) (- b))), but that doesn't help here -- the "-" gets in our way
+				;;   (min (- a) (- b)) -> (- (max a b))?
+				;; (+ a (max|min b c)) = (max|min (+ a b) (+ a c)))
+
+				(cond ((not (pair? args))  ; something is messed up in the original expression
+				       form)
+				      ((null? (cdr args))  ; (max (min x 3) (min x 3)) -> (max (min x 3)) -> (min x 3)
+				       (car args))
+				      ((and (null? (cddr args))   ; (max|min x (min|max x ...) -> x
+					    (or (and (pair? (car args))
+						     (eq? (caar args) other)
+						     (member (cadr args) (car args))
+						     (not (side-effect? (cadr args) env)))
+						(and (pair? (cadr args))
+						     (eq? (caadr args) other)
+						     (member (car args) (cadr args))
+						     (not (side-effect? (car args) env)))))
+				       ((if (len>1? (car args)) cadr car) args))
+				      (else (cons (car form) args)))))))))
+
+	      (hash-table-set! h 'max nummax)
+	      (hash-table-set! h 'min nummax))
+	    h)) ; define numerics-table
+
+	(lambda (form env)                         ; simplify-numerics??
+	  (define (simplify-arg x)
+	    (if (or (null? x)                      ; constants and the like look dumb if simplified
+		    (not (proper-list? x))
+		    (not (hash-table-ref no-side-effect-functions (car x)))
+		    (var-member (car x) env))
+		x
+		(simplify-numerics x env)))
+	  (let ((args (map simplify-arg (cdr form))))
+	    (cond ((hash-table-ref numerics-table (car form))
+		   => (lambda (f)
+			(f args form env)))
+		  (else (cons (car form) args)))))))
+
+    (define (binding-ok? caller head binding env second-pass)
+      ;; check let-style variable binding for various syntactic problems
+      (cond (second-pass
+	     (and (len>1? binding)
+		  (symbol? (car binding))
+		  (not (constant? (car binding)))
+		  (or (null? (cddr binding))
+		      (and (eq? head 'do)
+			   (len=1? (cddr binding)))))) ; (do ((i 0 . 1))...)
+
+	    ((not (pair? binding)) 	   (lint-format "~A binding is not a list? ~S" caller head binding) #f)    ; (let (a) a)
+	    ((not (symbol? (car binding))) (lint-format "~A variable is not a symbol? ~S" caller head binding) #f) ; (let ((1 2)) #f)
+	    ((keyword? (car binding))	   (lint-format "~A variable is a keyword? ~S" caller head binding) #f)    ; (let ((:a 1)) :a)
+	    ((constant? (car binding))	   (lint-format "can't bind a constant: ~S" caller binding) #f)            ; (let ((pi 2)) #f)
+	    ((not (pair? (cdr binding)))
+	     (lint-format (if (null? (cdr binding))
+			      "~A variable value is missing? ~S"     ; (let ((a)) #f)
+			      "~A binding is an improper list? ~S")  ; (let ((a . 1)) #f)
+			  caller head binding)
+	     #f)
+	    ((and (pair? (cddr binding))               ; (let loop ((pi 1.0) (+ pi 1))...)
+		  (or (not (eq? head 'do))
+		      (pair? (cdddr binding))))
+	     (lint-format "~A binding is messed up: ~A" caller head binding)
+	     #f)
+	    ((and (eq? caller (car binding))
+		  (let ((fv (var-member caller env)))
+		    (and fv
+			 (memq (var-ftype fv) '(define lambda let define* lambda*)))))
+	     (lint-format "~A variable ~A in ~S shadows the current function?" caller head caller binding)
+	     #t)
+	    (*report-shadowed-variables*               ; (let ((x 1)) (+ (let ((x 2)) (+ x 1)) x))
+	     (report-shadower caller head 'variable (car binding) binding env)
+	     #t)
+	    (else #t)))
+
+    (define (check-char-cmp caller op form)
+      (if (and (lint-tree-memq 'char->integer (cdr form))
+	       (lint-every? (lambda (x)
+			      (or (and (integer? x)
+				       (<= 0 x 255))
+				  (and (len=2? x)
+				       (eq? (car x) 'char->integer))))
+			    (cdr form)))
+	  (lint-format "perhaps ~A" caller             ; (< (char->integer x) 95) -> (char<? x #\_)
+		       (lists->string form
+				      (cons (case op ((=) 'char=?) ((>) 'char>?) ((<) 'char<?) ((>=) 'char>=?) (else 'char<=?))
+					    (map (lambda (arg)
+						   ((if (integer? arg) integer->char cadr) arg))
+						 (cdr form)))))))
+
+    (define (write-port expr) ; ()=not specified (*stdout*), #f=something is wrong (not enough args)
+      (and (pair? expr)
+	   (if (eq? (car expr) 'newline)
+	       (if (pair? (cdr expr))
+		   (cadr expr)
+		   ())
+	       (and (pair? (cdr expr))
+		    (if (pair? (cddr expr))
+			(caddr expr)
+			())))))
+
+    (define (display->format d)
+      (case (car d)
+	((newline) (copy "~%"))
+
+	((display)
+	 (let* ((arg (cadr d))
+		(arg-arg (and (len>1? arg)
+			      (cadr arg))))
+	   (cond ((string? arg)
+		  arg)
+
+		 ((char? arg)
+		  (string arg))
+
+		 ((and (pair? arg)
+		       (eq? (car arg) 'number->string))
+		  (if (= (length arg) 3)
+		      (case (caddr arg)
+			((2) (values "~B" arg-arg))
+			((8) (values "~O" arg-arg))
+			((10) (values "~D" arg-arg))
+			((16) (values "~X" arg-arg))
+			(else (values "~A" arg)))
+		      (values "~A" arg-arg)))
+
+		 ((not (and (pair? arg)
+			    (eq? (car arg) 'string-append)))
+		  (values "~A" arg))
+
+		 ((null? (cddr arg))
+		  (if (string? arg-arg)
+		      arg-arg
+		      (values "~A" arg-arg)))
+
+		 ((not (null? (cdddr arg)))
+		  (values "~A" arg))
+
+		 ((string? arg-arg)
+		  (values (string-append arg-arg "~A") (caddr arg)))
+
+		 ((string? (caddr arg))
+		  (values (string-append "~A" (caddr arg)) arg-arg))
+
+		 (else (values "~A" arg)))))
+
+	((write)
+	 ;; very few special cases actually happen here, unlike display above
+	 (if (string? (cadr d))
+	     (string-append "\"" (cadr d) "\"")
+	     (if (char? (cadr d))
+		 (string (cadr d))
+		 (values "~S" (cadr d)))))
+
+	((write-char)
+	 (if (char? (cadr d))
+	     (string (cadr d))
+	     (values "~C" (cadr d))))
+
+	((write-string)  ; same as display but with possible start|end indices
+	 (let ((indices (and (len>1? (cddr d)) ; port
+			     (cdddr d))))
+	   (if (string? (cadr d))
+	       (if (not indices)
+		   (cadr d)
+		   (if (and (integer? (car indices))
+			    (or (null? (cdr indices))
+				(and (pair? indices)
+				     (integer? (cadr indices)))))
+		       (apply substring (cadr d) indices)
+		       (values "~A" (cons 'substring (cons (cadr d) indices)))))
+	       (values "~A" (if indices (cons 'substring (cons (cadr d) indices)) (cadr d))))))))
+
+    (denote (lint-set!? form env)
+      (and *report-any-!-as-setter* ; (inc! x) when inc! is unknown, assume it sets x
+	   (symbol? (car form))
+	   (pair? (cdr form))
+	   (or (symbol? (cadr form))
+	       (and (pair? (cddr form))
+		    (symbol? (caddr form))))
+	   (not (hash-table-ref built-in-functions (car form)))
+	   (let ((str (symbol->string (car form))))
+	     (char=? (string-ref str (- (length str) 1)) #\!))
+	   (not (var-member (car form) env))))
+
+    (denote (easy-lambda? x)
+      (and (len>2? x)
+	   (eq? (car x) 'lambda)
+	   (len=1? (cadr x))))
+
+    (denote (identity? x) ; (lambda (x) x), or (define (x) x) -> procedure-source
+      (and (easy-lambda? x)
+	   (null? (cdddr x))
+	   (eq? (caddr x) (caadr x))))
+
+    (denote (simple-lambda? x)
+      (and (easy-lambda? x)
+	   (null? (cdddr x))
+	   (= (lint-tree-count (caadr x) (caddr x) 2) 1)))
+
+    (define (less-simple-lambda? x)
+      (and (easy-lambda? x)
+	   (= (lint-tree-count (caadr x) (cddr x) 2) 1)))
+
+    (define (cdr-count c)
+      (case c ((cdr) 1) ((cddr) 2) ((cdddr) 3) (else 4)))
+
+    (define* (find-unique-name f1 f2 (i 1))
+      (let ((sym (string->symbol (format #f "<~D>" i))))
+	(if (not (or (eq? sym f1)
+		     (eq? sym f2)
+		     (lint-tree-memq sym f1)
+		     (lint-tree-memq sym f2)))
+	    sym
+	    (find-unique-name f1 f2 (+ i 1)))))
+
+    (define (unrelop caller head form)         ; assume len=3
+      (let ((arg1 (cadr form))
+	    (arg2 (caddr form)))
+	(if (len=3? arg1)
+	    (if (eq? (car arg1) '-)
+		(if (memv arg2 '(0 0.0))               ; (< (- x y) 0) -> (< x y), need both 0 and 0.0 because (eqv? 0 0.0) is #f
+		    (lint-format "perhaps ~A" caller
+				 (lists->string form
+						(list head (cadr arg1) (caddr arg1))))
+		    (if (and (integer? arg2)           ; (> (- x 50868) 256) -> (> x 51124)
+			     (integer? (caddr arg1)))
+			(lint-format "perhaps ~A" caller
+				     (lists->string form
+						    (list head (cadr arg1) (+ (caddr arg1) arg2))))))
+		;; (> (- x) (- y)) (> (- x 1) (- y 1)) and so on -- do these ever happen? (no, not even if we allow +-*/)
+
+		(if (and (eq? (car arg1) '+)           ; (< (+ x 1) 3) -> (< x 2)
+			 (integer? arg2)
+			 (integer? (caddr arg1)))
+		    (lint-format "perhaps ~A" caller
+				 (lists->string form
+						(list head (cadr arg1) (- arg2 (caddr arg1)))))))
+	    (if (len=3? arg2)
+		(if (eq? (car arg2) '-)
+		    (if (memv arg1 '(0 0.0))           ; (< 0 (- x y)) -> (> x y)
+			(lint-format "perhaps ~A" caller
+				     (lists->string form
+						    (list (hash-table-ref reversibles head) (cadr arg2) (caddr arg2))))
+			(if (and (integer? arg1)
+				 (integer? (caddr arg2)))
+			    (lint-format "perhaps ~A" caller
+					 (lists->string form
+							(list (hash-table-ref reversibles head) (cadr arg2) (+ arg1 (caddr arg2)))))))
+		    (if (and (eq? (car arg2) '+)       ; (< 256 (+ fltdur 50868)) -> (> fltdur -50612)
+			     (integer? arg1)
+			     (integer? (caddr arg2)))
+			(lint-format "perhaps ~A" caller
+				     (lists->string form
+						    (list (hash-table-ref reversibles head) (cadr arg2) (- arg1 (caddr arg2)))))))))))
+
+
+    (define (check-start-and-end caller head form ff env)
+      (if (len>1? form)
+	  (if (pair? (cddr form))
+	      (lint-format "~A: too many indices: ~A" caller head ff)
+	      (if (or (and (integer? (car form))
+			   (integer? (cadr form))
+			   (apply >= form))
+		      (and (equal? (car form) (cadr form))
+			   (not (side-effect? (car form) env))))
+		  (lint-format "these ~A indices make no sense: ~A" caller head ff)))))  ; (copy x y 1 0)
+
+    (define (other-case c)
+      ((if (char-upper-case? c) char-downcase char-upcase) c))
+
+    (define (check-boolean-affinity caller form env)
+      ;; does built-in boolean func's arg make sense
+      (when (= (length form) 2)
+
+	(unless (or (and (symbol? (cadr form))
+			 (not (keyword? (cadr form))))
+		    (= line-number last-simplify-boolean-line-number))
+	  (let ((expr (simplify-boolean form () () env)))
+	    (if (not (equal? expr form))
+		(lint-format "perhaps ~A" caller (lists->string form expr))  ; (char? '#\a) -> #t
+		(if (code-constant? (cadr form))
+		    (let ((val (eval/error caller form)))
+		      (if (not (eq? val :error))
+			  (lint-format "perhaps ~A" caller (lists->string form val))))))))
+
+	(if (and (symbol? (cadr form))                  ; (number? pi) -> #t
+		 (not (keyword? (cadr form)))
+		 (not (var-member (cadr form) env)))
+	    (let ((val (checked-eval form)))
+	      (if (not (eq? val :checked-eval-error))
+		  (lint-format "perhaps ~A" caller (lists->string form val)))))
+
+	(when (and (pair? (cadr form))
+		   (or (symbol? (caadr form)) (eq? (caadr form) #_quote)))
+	  (let ((rt (if (and (memq (caadr form) '(quote #_quote))
+			     (pair? (cdadr form)))
+			(->simple-type (cadadr form))
+			(return-type (caadr form) env)))
+		(head (car form)))
+	    (if (subsumes? head rt)
+		(lint-format "~A is always #t" caller (truncated-list->string form)) ; (char? '#\a) is always #t
+		(if (not (or (memq rt '(#t #f values))
+			     (any-compatible? head rt)))
+		    (lint-format "~A is always #f" caller (truncated-list->string form)))))))) ; (number? (make-list 1)) is always #f
+
+    (define combinable-cxrs (let ((h (make-hash-table)))
+			      (for-each (lambda (c)
+					  (hash-table-set! h c (let ((name (symbol->string c)))
+								 (substring name 1 (- (length name) 1)))))
+					'(car cdr caar cadr cddr cdar caaar caadr caddr cdddr cdaar cddar cadar cdadr cadddr cddddr))
+			      h))
+    ;; not combinable: caaaar caaadr caadar caaddr cadaar cadadr caddar cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar
+
+    (define combine-cxrs
+      (let ((cxr? (lambda (s)
+		    (and (pair? (cdr s))
+			 (len=2? (cadr s))
+			 (hash-table-ref combinable-cxrs (caadr s))))))
+	(lambda (form)
+	  (and (cxr? form)
+	       (let* ((arg1 (cadr form))
+		      (arg2 (and arg1 (cxr? arg1) (cadr arg1)))
+		      (arg3 (and arg2 (cxr? arg2) (cadr arg2))))
+		 (values (string-append (hash-table-ref combinable-cxrs (car form))
+					(hash-table-ref combinable-cxrs (car arg1))
+					(if arg2 (hash-table-ref combinable-cxrs (car arg2)) "")
+					(if arg3 (hash-table-ref combinable-cxrs (car arg3)) ""))
+			 (let ((val (cadr (or arg3 arg2 arg1))))
+			   (if (keyword? val) ; tricky! ...(cddr :hi)... here is passed to lambda* below as last arg -> error because :hi has no argument!
+			       (lint-format "~A can't be a pair" (car form) val)
+			       val))))))))
+#|
+    ;; this builds the lists below:
+    (let ((ci ())
+	  (ic ()))
+      (for-each
+       (lambda (c)
+	 (let ((name (reverse (substring (symbol->string c) 1 (- (length (symbol->string c)) 1)))))
+	   (do ((sum 0)
+		(len (length name))
+		(i 0 (+ i 1))
+		(bit 0 (+ bit 2)))
+	       ((= i len)
+		(set! ci (cons (cons c sum) ci))
+		(set! ic (cons (cons sum c) ic)))
+	     (set! sum (+ sum (expt 2 (if (char=? (name i) #\a) bit (+ bit 1))))))))
+       '(car cdr caar cadr cddr cdar caaar caadr caddr cdddr cdaar cddar cadar cdadr cadddr cddddr
+	     caaaar caaadr caadar caaddr cadaar cadadr caddar cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar))
+      (list (reverse ci) (reverse ic)))
+|#
+    (define match-cxr
+      (let ((int->cxr (hash-table 1 'car 2 'cdr
+				  5 'caar 6 'cadr 10 'cddr 9 'cdar
+				  21 'caaar 22 'caadr 26 'caddr 42 'cdddr 37 'cdaar 41 'cddar 25 'cadar 38 'cdadr
+				  106 'cadddr 170 'cddddr 85 'caaaar 86 'caaadr 89 'caadar 90 'caaddr 101 'cadaar 102 'cadadr
+				  105 'caddar 149 'cdaaar 150 'cdaadr 153 'cdadar 154 'cdaddr 165 'cddaar 166 'cddadr 169 'cdddar))
+	    (cxr->int (hash-table 'car 1  'cdr 2
+				  'caar 5  'cadr 6  'cddr 10  'cdar 9
+				  'caaar 21  'caadr 22  'caddr 26  'cdddr 42  'cdaar 37  'cddar 41  'cadar 25  'cdadr 38
+				  'cadddr 106  'cddddr 170  'caaaar 85  'caaadr 86  'caadar 89  'caaddr 90  'cadaar 101  'cadadr 102
+				  'caddar 105  'cdaaar 149  'cdaadr 150 'cdadar 153 'cdaddr 154 'cddaar 165 'cddadr 166  'cdddar 169)))
+	(lambda (c1 c2)
+	  (hash-table-ref int->cxr (logand (or (hash-table-ref cxr->int c1) 0)
+					   (or (hash-table-ref cxr->int c2) 0))))))
+
+    (define (mv-range producer env)
+      (if (symbol? producer)
+	  (let ((v (var-member producer env)))
+	    (and (pair? v)
+		 (pair? ((cdr v) 'nvalues))
+		 ((cdr v) 'nvalues)))
+          (and (pair? producer)
+               (case (car producer)
+		 ((lambda lambda*)
+		  (and (len>1? (cdr producer))
+		       (count-values (cddr producer))))
+		 ((values)
+		  (let ((len (- (length producer) 1)))
+		    (for-each
+		     (lambda (p)
+		       (if (and (pair? p) (eq? (car p) 'values))
+			   (set! len (+ len (length p) -2))))
+		     (cdr producer))
+		    (list len len)))
+		 (else (mv-range (car producer) env))))))
+
+    (define (eval-constant-expression caller form)
+      (if (just-code-constants? (cdr form))
+	  (catch #t
+	    (lambda ()
+	      (let ((val (checked-eval (copy form)))); :readable))))
+		(if (not (eq? val :checked-eval-error)) ; (abs -9223372036854775808)
+		    (lint-format "perhaps ~A" caller (lists->string form val))))) ; (eq? #(0) #(0)) -> #f
+	    (lambda args
+	      #t))))
+
+    (define (unlist-values tree)
+      (if (not (and (pair? tree)
+		    (list? (cdr tree))
+		    (not (memq (car tree) '(quote #_quote)))))
+	  tree
+	  (case (car tree)
+	    ((list-values #_list-values)
+	     (if (and (or (assq 'apply-values (cdr tree))
+			  (assq #_apply-values (cdr tree)))
+		      (len=2? (cdr tree))
+		      (pair? (caddr tree)))
+		 (if (and (pair? (cadr tree))
+			  (memq (caadr tree) '(apply-values #_apply-values)))
+		     (list 'append (cadadr tree) (cadr (caddr tree)))
+		     (list 'cons (cadr tree) (cadr (caddr tree))))
+		 (cons 'list (unlist-values (cdr tree))))) ; #_list perhaps? and #_cons #_append above?
+
+	    ((append)
+	     (if (and (len=2? (cdr tree))
+		      (pair? (cadr tree))
+		      (memq (caadr tree) '(list-values #_list-values)))
+		 (let ((lst (unlist-values (cadr tree)))
+		       (rest (caddr tree)))
+		   (if (pair? rest) (set! rest (unlist-values rest)))
+		   (let ((lst-len (length lst)))
+		     (case lst-len
+		       ((2) (list 'cons (cadr lst) rest))
+		       ((3) (list 'cons (cadr lst) (list 'cons (caddr lst) rest)))
+		       (else (cons 'append (unlist-values (cdr tree)))))))))
+
+	    (else (cons (unlist-values (car tree))
+			(unlist-values (cdr tree)))))))
+
+    (define (qq-tree? tree)
+      (and (pair? tree)
+	   (or (memq (car tree) '(apply-values #_apply-values))
+	       (if (and (memq (car tree) '(list-values #_list-values))
+			(pair? (cdr tree))              ; (assq '(list-values #_list-values  .\ " (  \"))...)
+			(or (assq 'apply-values (cdr tree))
+			    (assq #_apply-values (cdr tree))))
+		   (or (not (= (length tree) 3))
+		       (not (and (pair? (caddr tree))
+				 (memq (caaddr tree) '(apply-values #_apply-values))))
+		       (qq-tree? (cadr (caddr tree)))
+		       (let ((applying (and (pair? (cadr tree))
+					    (memq (caadr tree) '(apply-values #_apply-values)))))
+			 (qq-tree? ((if applying cadadr cadr) tree))))
+		   (or (qq-tree? (car tree))
+		       (qq-tree? (cdr tree)))))))
+
+
+    (define (func-definer? f)
+      (and (len>2? f)
+	   (or (eq? (car f) 'define*)
+	       (and (eq? (car f) 'define)
+		    (or (pair? (cadr f))
+			(and (symbol? (cadr f))
+			     (pair? (caddr f))
+			     (memq (caaddr f) '(lambda lambda*))))))))
+
+
+    (define special-case-functions
+      (let ((special-case-table (make-hash-table)))
+
+	(define (hash-special key value)
+	  (if (hash-table-ref special-case-table key)
+	      (format *stderr* "~A already has a value: ~A~%" key (hash-table-ref special-case-table key)))
+	  (hash-table-set! special-case-table key value))
+
+	(define string->char=
+	  (let ((substring->char? (lambda (s2)
+				    (and (eq? (car s2) 'substring)
+					 (= (length s2) 4)
+					 (integer? (caddr s2))
+					 (integer? (cadddr s2))
+					 (= (+ (caddr s2) 1) (cadddr s2))))))
+	    (lambda (caller form original-form)
+	      ;; called by string=? and equal? returns true if it makes a suggestion
+	      ;;   look for args of form "x" (string x) (substring x 1 2) and reduces to char= (caller also tries args reversed)
+	      (and (pair? (caddr form))
+		   (let ((sug made-suggestion)
+			 (s1 (cadr form))
+			 (s2 (caddr form)))
+		     (cond ((string? s1)
+			    (when (= (length s1) 1)
+			      (if (eq? (car s2) 'string)          ; (equal? "[" (string r)) -> (char=? #\[ r)
+				  (if (not (len=2? s2))           ; (eqv? "a" (string)) or (string=? "a" (string a b))
+				      (lint-format "~A is #f" caller original-form)
+				      (lint-format "perhaps ~A" caller
+						   (lists->string original-form (list 'char=? (string-ref s1 0) (cadr s2)))))
+				  (if (substring->char? s2)       ; (equal? "^" (substring s 0 1)) -> (char=? #\^ (string-ref s 0))
+				      (lint-format "perhaps ~A" caller
+						   (lists->string original-form `(char=? ,(string-ref s1 0) (string-ref ,(cadr s2) ,(caddr s2)))))))))
+			   ((not (pair? s1)))
+
+			   ((not (eq? (car s1) 'string))
+			    (if (and (substring->char? s1)        ; (string=? (substring x 0 1) (substring y 2 3))
+				     (substring->char? s2))
+				(lint-format "perhaps ~A" caller
+					     (lists->string original-form `(char=? (string-ref ,(cadr s1) ,(caddr s1)) (string-ref ,(cadr s2) ,(caddr s2)))))))
+
+			   ((eq? (car s2) 'string)                ; (string=? (string x) (string y)) -> (char=? x y)
+			    (if (not (eqv? (length s1) (length s2)))
+				(lint-format "~A is #f" caller original-form)
+				(if (len=2? s1)
+				    (lint-format "perhaps ~A" caller (lists->string original-form (list 'char=? (cadr s1) (cadr s2)))))))
+
+			   ((and (len=2? s1)                      ; (string=? (string x) (substring y 3 4)) -> (char=? x (string-ref y 3))
+				 (substring->char? s2))
+			    (lint-format "perhaps ~A" caller
+					 (lists->string original-form `(char=? ,(cadr s1) (string-ref ,(cadr s2) ,(caddr s2)))))))
+
+		     (not (= sug made-suggestion)))))))
+
+	;; ---------------- member and assoc ----------------
+	(let ()
+	  (define sp-memx
+	    (let ((list-one? (lambda (p)
+			       (and (len=2? p)
+				    (case (car p)
+				      ((list) cadr)
+				      ((quote #_quote)
+				       (and (len=1? (cadr p))
+					    (if (symbol? (caadr p))
+						(lambda (x)
+						  (list #_quote (caadr x)))
+						caadr)))
+				      (else #f))))))
+	      (lambda (caller head form env)
+		;(format *stderr* "memx: ~S~%" form)
+		(case (length form)
+		  ((3)
+		   (let ((selector (cadr form))
+			 (items (caddr form)))
+
+		     (let ((current-eqf (case head ((memq assq) 'eq?) ((memv assv) 'eqv?) (else 'equal?)))
+			   (selector-eqf (car (eqf selector env)))
+			   (one-item (and (memq head '(memq memv member)) (list-one? items))))
+		       ;; one-item assoc doesn't simplify cleanly
+		       (if one-item
+			   (let* ((target (one-item items))
+				  (iter-eqf (eqf target env)))
+			     (if (or (symbol? target)
+				     (unquoted-pair? target))
+				 (set! target (list #_quote target))) ; ; (member x (list "asdf")) -> (string=? x "asdf") -- maybe equal? here?
+			     (lint-format "perhaps ~A" caller (lists->string form (list (cadr iter-eqf) selector target))))
+
+			   ;; not one-item
+			   (letrec ((duplicates? (lambda (lst fnc)
+						   (and (pair? lst)
+							(or (fnc (car lst) (cdr lst))
+							    (duplicates? (cdr lst) fnc)))))
+				    (duplicate-constants? (lambda (lst fnc)
+							    (and (pair? lst)
+								 (or (and (constant? (car lst))
+									  (fnc (car lst) (cdr lst)))
+								     (duplicate-constants? (cdr lst) fnc))))))
+			     (if (and (symbol? selector-eqf)   ; (memq 1.0 x): perhaps memq -> memv
+				      (not (eq? selector-eqf current-eqf))
+				      (or (not (eq? 'eq? current-eqf))
+					  (not (memq 'char=? (eqf selector env))))) ; eq? used with chars is ok in s7: (assq (string-ref name 0) bad-var-names)
+				 (lint-format "~A: perhaps ~A -> ~A" caller (truncated-list->string form) head
+					      (if (memq head '(memq memv member))
+						  (case selector-eqf ((eq?) 'memq) ((eqv?) 'memv) ((equal?) 'member) (else 'error))
+						  (case selector-eqf ((eq?) 'assq) ((eqv?) 'assv) ((equal?) 'assoc) (else 'error)))))
+
+			     ;; --------------------------------
+			     ;; check for head mismatch with items
+			     (when (pair? items)
+			       (when (or (eq? (car items) 'list)
+					 (quoted-pair? items))
+				 (let ((elements ((if (memq (car items) '(quote #_quote)) cadr cdr) items)))
+				   (let ((baddy #f))
+				     (catch #t
+				       (lambda ()
+					 (set! baddy ((if (eq? (car items) 'list) duplicate-constants? duplicates?)
+						      elements (symbol->value head))))
+				       (lambda args #f))
+				     (if (pair? baddy) ; (member x (list "asd" "abc" "asd"))
+					 (lint-format "duplicated entry ~S in ~A" caller (car baddy) items)))
+
+				   (when (proper-list? elements)
+				     (let ((maxf #f)
+					   (keys (if (memq (car items) '(quote #_quote))
+						     (if (memq head '(memq memv member))
+							 elements
+							 (and (just-pairs? elements)
+							      (map car elements)))
+						     (if (memq head '(memq memv member))
+							 (and (just-code-constants? elements)
+							      elements)
+							 (and (lint-every? (lambda (e)
+									     (and (len=2? e)
+										  (memq (car e) '(quote #_quote))
+										  (pair? (cadr e))))
+									   elements)
+							      (map caadr elements))))))
+				       (when (proper-list? keys)
+					 (if (memq (car items) '(quote #_quote))
+					     (do ((p keys (cdr p)))
+						 ((or (null? p)
+						      (memq maxf '(equal? #t))))
+					       (let ((element (car p)))
+						 (if (symbol? element)
+						     (if (not maxf)
+							 (set! maxf 'eq?))
+						     (if (pair? element)
+							 (begin
+							   (if (and (memq (car element) '(quote #_quote))
+								    (pair? (cdr element)))
+							       (lint-format "stray quote? ~A" caller form)) ; (memq x '(a 'b c))
+							   (set! maxf #t))
+							 (let ((type (if (or (symbol? element) (eq? element #<undefined>))
+									 'eq?
+									 (car (->eqf (->simple-type element))))))
+							   (if (or (memq maxf '(#f eq?))
+								   (memq type '(#t equal?)))
+							       (set! maxf type)))))))
+					     ;; else (list ...)
+					     (do ((p keys (cdr p)))
+						 ((or (null? p)
+						      (memq maxf '(equal? #t))))
+					       (let ((element (car p)))
+						 (if (symbol? element)
+						     (set! maxf #t)
+						     (let ((type (car (eqf element env))))
+						       (if (or (memq maxf '(#f eq?))
+							       (memq type '(#t equal?)))
+							   (set! maxf type)))))))
+					 (case maxf
+					   ((eq?)
+					    (if (not (memq head '(memq assq))) ; (member (car op) '(x y z))
+						(lint-format "~A could be ~A in ~A" caller
+							     head
+							     (if (memq head '(memv member)) 'memq 'assq)
+							     form)))
+					   ((eqv?)
+					    (if (not (memq head '(memv assv))) ; (memq (strname 0) '(#\{ #\[ #\()))
+						(lint-format "~A ~Aould be ~A in ~A" caller
+							     head
+							     (if (memq head '(memq assq)) "sh" "c")
+							     (if (memq head '(memq member)) 'memv 'assv)
+							     form)))
+					   ((equal? #t)                        ; (memq (car op) '("a" #()))
+					    (if (not (memq head '(member assoc)))
+						(lint-format "~A should be ~A in ~A" caller
+							     head
+							     (if (memq head '(memq memv)) 'member 'assoc)
+							     form))))))
+
+				     (if (and (= (length elements) 2)  ; (memq expr '(#t #f))
+					      (memq #t elements)
+					      (memq #f elements))
+					 (lint-format "perhaps ~A" caller (lists->string form (list 'boolean? selector)))))))
+			       ;; not (memv x '(0 0.0)) -> (zero? x) because x might not be a number
+
+			       (case (car items)
+				 ((map)
+				  (let ((memx (memq head '(memq memv member))))
+				    (when (and memx (= (length items) 3))
+				      (let ((mapf (cadr items))
+					    (map-items (caddr items)))
+					(cond ((eq? mapf 'car)         ; (memq x (map car y)) -> (assq x y)
+					       (lint-format "perhaps use assoc: ~A" caller
+							    (lists->string form (list (case current-eqf ((eq?) 'assq) ((eqv?) 'assv) ((equal?) 'assoc) (else 'error))
+										      selector map-items))))
+
+					      ((eq? selector #t)
+					       (if (eq? mapf 'null?)   ; (memq #t (map null? items)) -> (memq () items)
+						   (lint-format "perhaps ~A" caller
+								(lists->string form (list 'memq () map-items)))
+						   (let ((b (if (eq? mapf 'b) 'c 'b)))
+						     ;; (memq #t (map cadr items)) -> (member #t items (lambda (a b) (cadr b)))
+						     (lint-format "perhaps avoid 'map: ~A" caller
+								  (lists->string form `(member #t ,map-items (lambda (a ,b) (,mapf ,b))))))))
+
+					      ((and (pair? selector)
+						    (eq? (car selector) 'string->symbol) ; this could be extended, but it doesn't happen
+						    (eq? mapf 'string->symbol)
+						    (not (and (pair? map-items)
+							      (memq (car map-items) '(quote #_quote)))))
+					       (lint-format "perhaps ~A" caller
+							    ;; (memq (string->symbol x) (map string->symbol y)) -> (member x y string=?)
+							    (lists->string form `(member ,(cadr selector) ,map-items string=?))))
+
+					      (else
+					       ;; (member x (map b items)) -> (member x items (lambda (a c) (equal? a (b c))))
+					       (let ((b (if (eq? mapf 'b) 'c 'b))) ; a below can't collide because eqf won't return 'a
+						 (lint-format "perhaps avoid 'map: ~A" caller
+							      (lists->string form `(member ,selector ,map-items
+											   (lambda (a ,b) (,current-eqf a (,mapf ,b)))))))))))))
+
+				 ((string->list)             ; (memv c (string->list s)) -> (char-position c s)
+				  (lint-format "perhaps ~A" caller
+					       (lists->string form (cons 'char-position (cons (cadr form) (cdr items))))))
+
+				 ((cons)                     ; (member x (cons y z)) -> (or (equal? x y) (member x z))
+				  (if (and (not (pair? selector))
+					   (len=3? items))
+				      (lint-format "perhaps avoid 'cons: ~A" caller
+						   (lists->string form `(or (,current-eqf ,selector ,(cadr items))
+									    (,head ,selector ,(caddr items)))))))
+
+				 ((append)                   ; (member x (append (list x) y)) -> (or (equal? x x) (member x y))
+				  (if (and (not (pair? selector))
+					   (len=3? items)
+					   (len=2? (cadr items))
+					   (eq? (caadr items) 'list))
+				      (lint-format "perhaps ~A" caller
+						   (lists->string form `(or (,current-eqf ,selector ,(cadadr items))
+									    (,head ,selector ,(caddr items))))))))))))
+		     (when (and (memq head '(memq memv))
+				(quoted-pair? items))
+		       (let ((nitems (length (cadr items))))
+
+			 (if (pair? selector)                        ; (memv (string-ref x 0) '(+ -)) -> #f etc
+			     (let ((sig (arg-signature (car selector) env)))
+			       (if (and (pair? sig)
+					(symbol? (car sig))
+					(not (eq? (car sig) 'values)))
+				   (let ((vals (let ((car-sig-val (symbol->value (car sig))))
+						 (map (lambda (item)
+							(if (car-sig-val item) item (values)))
+						      (cadr items)))))
+				     (if (not (= (length vals) nitems))
+					 (lint-format "perhaps ~A" caller
+						      (lists->string form
+								     (and (pair? vals)
+									  `(,head ,selector ',vals)))))))))
+			 (if (> nitems 20)
+			     (lint-format "perhaps use a hash-table here, rather than ~A" caller (truncated-list->string form)))
+
+			 (let ((bad (lint-find-if (lambda (x)
+						    (not (or (symbol? x)
+							     (char? x)
+							     (number? x)
+							     (procedure? x) ; (memq abs '(1 #_abs 2)) !
+							     (syntax? x)    ; (memq x '(quote #_quote))
+							     (memq x '(#f #t () #<unspecified> #<undefined> #<eof>)))))
+						  (cadr items))))
+			   (if bad
+			       (lint-format (if (and (pair? bad)
+						     (eq? (car bad) 'unquote))
+						(values "stray comma? ~A" caller)  ; (memq x '(a (unquote b) c))
+						(values "pointless list member: ~S in ~A" caller bad))
+					    ;; quoted item here is caught above    ; (memq x '(a (+ 1 2) 3))
+					    form)))))))
+
+		  ((4)
+		   (let ((func (list-ref form 3)))
+		     (if (symbol? func)
+			 (if (memq func '(eq? eqv? equal?))   ; (member x y eq?) -> (memq x y)
+			     (let ((op (if (eq? head 'member) ; (member (car x) entries equal?) -> (member (car x) entries)
+					   (case func ((eq?) 'memq) ((eqv?) 'memv) (else 'member))
+					   (case func ((eq?) 'assq) ((eqv?) 'assv) (else 'assoc)))))
+			       (lint-format "perhaps ~A" caller (lists->string form (list op (cadr form) (caddr form)))))
+			     (let ((sig (signature (symbol->value func)))) ; arg-signature here is too cranky
+			       (if (and (pair? sig)
+					(not (eq? 'boolean? (car sig)))
+					(or (not (pair? (car sig)))
+					    (not (or (memq 'boolean? (car sig))
+						     (memq 'not (car sig)))))) ; (assoc a b string-position) sig: ((integer? not) string? string? integer?)
+				   (lint-format "~A is a questionable ~A function" caller func head)))) ; (member 1 x abs)
+			 ;; func not a symbol
+			 (when (and (len>2? func)
+				    (eq? (car func) 'lambda)
+				    (pair? (cadr func)))
+			   (if (not (memv (length (cadr func)) '(2 -1)))
+			       (lint-format "~A equality function (optional third arg) should take two arguments" caller head)
+			       (when (eq? head 'member)
+				 (when (and (= (length func) 3)                    ; (member 'a x (lambda (a b c) (eq? a b)))
+					    (pair? (caddr func)))
+				   (let ((eq (caddr func))
+					 (args (cadr func)))
+				     (if (and (memq (car eq) '(eq? eqv? equal?))
+					      (eq? (car args) (cadr eq))
+					      (len>1? (caddr eq))
+					      (eq? (caaddr eq) 'car)
+					      (pair? (cdr args))
+					      (eq? (cadr args) (cadr (caddr eq))))
+					 (lint-format "member might perhaps be ~A" ; (member 'a x (lambda (a b) (eq? a (car b))))
+						      caller
+						      (if (or (eq? func 'eq?)
+							      (eq? (caaddr func) 'eq?))
+							  'assq
+							  (if (eq? (caaddr func) 'eqv?)
+							      'assv
+							      'assoc))))))
+				 (when (pair? (cadr form))                         ; (member (abs x) lst (lambda (a b) (< b 2)))
+				   (let ((args (cadr func)))
+				     (when (and (pair? args)
+						(not (lint-tree-memq (car args) (cddr func))))
+				       (lint-format "~A is ignored, so perhaps (member #f ...)" caller (car args)))))))))))))))
+
+	  (for-each (lambda (f)
+		      (hash-special f sp-memx))
+		    '(memq assq memv assv member assoc)))
+
+	;; ---------------- car, cdr, etc ----------------
+	(let ()
+	  (define (sp-crx caller head form env)
+	    (if (not (= line-number last-simplify-cxr-line-number))
+		((lambda* (cxr arg)
+		   (when cxr
+		     (set! last-simplify-cxr-line-number line-number)
+		     (cond ((< (length cxr) 5)                           ; (car (cddr x)) -> (caddr x)
+			    (lint-format "perhaps ~A" caller
+					 (lists->string form (list (symbol "c" cxr "r") arg))))
+
+			   ;; if it's car|cdr followed by cdr's, use list-ref|tail
+			   ((not (char-position #\a cxr))                ; (cddddr (cddr x)) -> (list-tail x 6)
+			    (lint-format "perhaps ~A" caller (lists->string form (list 'list-tail arg (length cxr)))))
+
+			   ((not (char-position #\a (substring cxr 1)))  ; (car (cddddr (cddr x))) -> (list-ref x 6)
+			    (lint-format "perhaps ~A" caller (lists->string form (list 'list-ref arg (- (length cxr) 1)))))
+
+			   (else (set! last-simplify-cxr-line-number -1)))))
+		 (combine-cxrs form)))
+
+	    (when (and (len>1? form)
+		       (len>1? (cadr form)))
+	      (let ((arg (cadr form)))
+
+		(when (eq? head 'car)
+		  (case (car arg)
+		    ((list-tail)                      ; (car (list-tail x y)) -> (list-ref x y)
+		     (if (len=3? arg)
+			 (lint-format "perhaps ~A" caller (lists->string form (list 'list-ref (cadr arg) (caddr arg))))))
+
+		    ((list)                           ; (car (list x ...)) -> x, (car (list)) is handled elsewhere, (car (cons...)) is below
+		     (unless (and (pair? (cdr arg))
+				  (pair? (cadr arg))  ; (car (list (eval ...))) to catch first of mv
+				  (memq (caadr arg) '(eval-string eval apply values))) ; actually any closure here might return multiple values
+		       (lint-format "perhaps ~A" caller (lists->string form (cadr arg)))))
+
+		    ((append)                      ; (car (append x ...)) -> (car x)
+		     (lint-format "perhaps ~A" caller (lists->string form (list 'car (cadr arg)))))
+
+		    ((memq memv member assq assv assoc)
+		     (if (pair? (cdr arg))         ; (car (memq x ...)) is either x or (car #f) -> error
+			 (lint-format "~A is ~A, or an error" caller (truncated-list->string form) (cadr arg))))))
+
+		(when (and (eq? (car arg) 'or)     ; (cdr (or (assoc x y) (cons 1 2))) -> (cond ((assoc x y) => cdr) (else 2))
+			   (not (eq? form last-rewritten-internal-define))
+			   (len=3? arg))
+		  (let ((arg1 (cadr arg))
+			(arg2 (caddr arg)))
+		    (if (and (pair? arg2)
+			     (or (and (memq (car arg2) '(cons list list-values #_list-values))
+				      (eq? head 'cdr))
+				 (memq (car arg2) '(error throw))
+				 (quoted-pair? arg2)))
+			(let ((else-val (catch #t
+					  (lambda ()
+					    (case (car arg2)
+					      ((quote #_quote) ((symbol->value head) (cadr arg2)))
+					      ((cons) (caddr arg2))
+					      ((error throw) arg2)
+					      (else (cons 'list (cddr arg2)))))
+					  (lambda args
+					    :error))))
+			  (if (not (eq? else-val :error))
+			      (lint-format "perhaps ~A" caller
+					   (lists->string form ; (cdr (or (assoc n oi) (list n y))) -> (cond ((assoc n oi) => cdr) (else (list y)))
+							  `(cond (,arg1 => ,head) (else ,else-val)))))))))
+
+		(if (and (quoted-pair? arg)   ; (cdr '(a)) -> ()
+			 (null? (cddr form))  ; else possibly bad trailing args in form (like (read-char))
+			 (not (var-member head env)))
+		    (let ((val (checked-eval form)))
+		      (if (not (eq? val :checked-eval-error))
+			  (lint-format "perhaps ~A -> ~A~A" caller
+				       (object->string form)
+				       (if (or (pair? val) (symbol? val)) "'" "")
+				       (object->string val)))))
+
+		(if (and (memq head '(car cdr))
+			 (eq? (car arg) 'cons)
+			 (len>1? (cdr arg)))
+		    (lint-format "(~A~A) is the same as ~A"       ; (car (cons 1 2)) is the same as 1
+				 caller head
+				 (truncated-list->string arg)
+				 (truncated-list->string ((if (eq? head 'car) cadr caddr) arg))))
+
+		(when (memq head '(car cadr caddr cadddr))
+		  (case (car arg)
+		    ((string->list vector->list)    ; (car (string->list x)) -> (string-ref x 0)
+		     (lint-format "perhaps ~A" caller (lists->string form
+								     (list (if (eq? (car arg) 'string->list) 'string-ref 'vector-ref)
+									   (cadr arg)
+									   (case head ((car) 0) ((cadr) 1) ((caddr) 2) (else 3))))))
+		    ((reverse reverse!)
+		     (lint-format "perhaps ~A~A" caller           ; (car (reverse x)) -> (list-ref x (- (length x) 1))
+				  (if (eq? head 'car)
+				      "use 'last from srfi-1, or "
+				      "")
+				  (lists->string form
+						 (if (symbol? (cadr arg))
+						     `(list-ref ,(cadr arg)
+								(- (length ,(cadr arg))
+								   ,(case head ((car) 1) ((cadr) 2) ((caddr) 3) (else 4))))
+						     `(let ((<1> ,(cadr arg)))  ; let is almost certainly cheaper than reverse
+							(list-ref <1> (- (length <1>)
+									 ,(case head ((car) 1) ((cadr) 2) ((caddr) 3) (else 4))))))))))))))
+	  (for-each (lambda (f)
+		      (hash-special (car f) sp-crx))
+		    combinable-cxrs))
+	;; not combinable cxrs:
+	;;    caaaar caaadr caadar caaddr cadaar cadadr caddar
+	;;    cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar
+
+	;; ---------------- set-car! ----------------
+	(let ()
+	  (define (sp-set-car! caller head form env)
+	    (when (= (length form) 3)
+	      (let ((target (cadr form)))
+		(if (code-constant? target)
+		    (lint-format "~A is a constant, so ~A is problematic" caller
+				 target
+				 (truncated-list->string form)))
+		(if (pair? target)
+		    (case (car target)
+
+		      ((list-tail)                              ; (set-car! (list-tail x y) z) -> (list-set! x y z)
+		       (lint-format "perhaps ~A" caller (lists->string form (list 'list-set! (cadr target) (caddr target) (caddr form)))))
+
+		      ((cdr cddr cdddr cddddr)                  ; (set-car! (cddr (cdddr x)) y) -> (list-set! x 5 y)
+		       (set! last-simplify-cxr-line-number line-number)
+		       (lint-format "perhaps ~A" caller
+				    (lists->string form
+						   (if (and (pair? (cadr target))
+							    (memq (caadr target) '(cdr cddr cdddr cddddr)))
+						       ;; (set-car! (cdr (cddr x)) y) -> (list-set! x 3 y)
+						       (list 'list-set!
+							     (cadadr target)
+							     (+ (cdr-count (car target)) (cdr-count (caadr target)))
+							     (caddr form))
+						       ;; (set-car! (cdr x) y) -> (list-set! x 1 y)
+						       (list 'list-set!
+							     (cadr target)
+							     (cdr-count (car target))
+							     (caddr form)))))))))))
+	  (hash-special 'set-car! sp-set-car!))
+
+	(let ()
+	  (define (sp-set-cdr! caller head form env)
+	    (when (= (length form) 3)
+	      (let ((target (cadr form)))
+		(if (code-constant? target)
+		    (lint-format "~A is a constant, so ~A is problematic" caller
+				 target
+				 (truncated-list->string form))))))
+	  (hash-special 'set-cdr! sp-set-cdr!))
+
+	;; ---------------- not ----------------
+	(let ()
+	  (define (sp-not caller head form env)
+	    ;(format *stderr* "sp-not ~S~%" form)
+	    (if (and (pair? (cdr form))
+		     (pair? (cadr form)))
+		(if (eq? (caadr form) 'not)
+		    (when (len>1? (cadr form))
+		      (let* ((arg (cadadr form))
+			     (str (truncated-list->string arg))) ; (not (not x)) -> (and x #t)
+			(if (and (pair? arg)                     ; (not (not (pair? x))) -> (pair? x)
+				 (eq? (return-type (car arg) env) 'boolean?))
+			    (lint-format "~A returns a boolean, so (not (not ~A)) -> ~A" 'paranoia (car arg) arg arg)
+			    (lint-format "if you want a boolean, (not (not ~A)) -> (and ~A #t)" 'paranoia str str))))
+		    (unless (eq? (caadr form) 'for-each)
+		      (let ((sig (arg-signature (caadr form) env)))
+			(if (and (pair? sig)
+				 (if (pair? (car sig))                      ; (not (+ x y))
+				     (not (or (memq 'boolean? (car sig))
+					      (memq 'not (car sig))))
+				     (not (memq (car sig) '(#t values boolean? not)))))
+			    (lint-format "~A can't be true (~A never returns #f)" caller (truncated-list->string form) (caadr form)))))))
+
+	    (if (not (= line-number last-simplify-boolean-line-number))
+		(let ((val (simplify-boolean form () () env)))
+		  (set! last-simplify-boolean-line-number line-number)
+		  (if (not (equal? form val))                               ;  (not (and (> x 2) (not z))) -> (or (<= x 2) z)
+		      (lint-format "perhaps ~A" caller (lists->string form val))))))
+
+	  (hash-special 'not sp-not))
+
+	;; ---------------- and/or ----------------
+	(let ()
+	  (define (sp-and caller head form env)
+	    (if (not (= line-number last-simplify-boolean-line-number))
+		(let ((val (simplify-boolean form () () env)))
+		  (set! last-simplify-boolean-line-number line-number)
+		  (if (not (equal? form val))          ; (and (not x) (not y)) -> (not (or x y))
+		      (lint-format "perhaps ~A" caller (lists->string form val)))))
+	    (if (pair? (cdr form))
+		(do ((p (cdr form) (cdr p)))
+		    ((null? (cdr p)))
+		  (if (and (len=3? (car p))            ; (and (member n cvars) (if (pair? open) (not (member n open))) (not (eq? n open)))
+			   (eq? (caar p) 'if))
+		      (lint-format "one-armed if might cause confusion here: ~A" caller form)))))
+	  (hash-special 'and sp-and)
+	  (hash-special 'or sp-and))
+
+	;; ---------------- = ----------------
+	(let ()
+	  (define (any-real? lst)                      ; ignore 0.0 and 1.0 in this since they normally work
+	    (and (pair? lst)
+		 (or (and (number? (car lst))
+			  (not (rational? (car lst)))
+			  (not (member (car lst) '(0.0 1.0) =)))
+		     (any-real? (cdr lst)))))    ; (= x 1.5)
+	 (define (sp-= caller head form env)
+	   ;; repeated factors (= (+ x y) (+ x z)) never happen
+	   (let ((len (length form)))
+	     (if (and (> len 2)
+		      (any-real? (cdr form)))
+		 (lint-format "= can be troublesome with floats: ~A" caller (truncated-list->string form)))
+
+	     (let ((cleared-form (cons = (remove-if (lambda (x) (not (number? x))) (cdr form)))))
+	       (if (and (> (length cleared-form) 2)
+			(not (checked-eval cleared-form)))    ; (= 1 y 2)
+		   (lint-format "this comparison can't be true: ~A" caller (truncated-list->string form))))
+
+	     (when (= len 3)
+	       (let ((arg1 (cadr form))
+		     (arg2 (caddr form)))
+		 (if (or (and (memv arg1 '(0 1))
+			      (len>1? arg2)
+			      (eq? (car arg2) 'denominator))
+			 (and (memv arg2 '(0 1))
+			      (len>1? arg1)
+			      (eq? (car arg1) 'denominator)))
+		     (if (or (eqv? arg1 0) (eqv? arg2 0))
+			 (lint-format "denominator is never 0: ~A" caller form)
+			 (lint-format "perhaps ~A" caller (lists->string form (list 'integer? (cadr (if (pair? arg1) arg1 arg2))))))
+
+		     ;; (= (+ x a) (+ y a)) and various equivalents happen very rarely (only in test suites it appears)
+		     (let ((var (or (and (memv arg1 '(0 1))
+					 (len>1? arg2)
+					 (eq? (car arg2) 'length)
+					 (cadr arg2))
+				    (and (memv arg2 '(0 1))
+					 (len>1? arg1)
+					 (eq? (car arg1) 'length)
+					 (cadr arg1)))))
+		       ;; we never seem to have var-member/initial-value/history here to distinguish types
+		       ;;   and a serious attempt to do so was a bust. (the enclosing expr is not in the var-history yet)
+		       (if var
+			   (if (or (eqv? arg1 0)    ;  (= (length x) 0) -> (null? x)
+				   (eqv? arg2 0))
+			       (lint-format "perhaps (assuming ~A is a list), ~A" caller var
+					    (lists->string form (list 'null? var)))
+			       (if (symbol? var)    ;  (= (length x) 1) -> (and (pair? x) (null? (cdr x)))
+				   (lint-format "perhaps (assuming ~A is a list), ~A" caller var
+						(lists->string form `(and (pair? ,var) (null? (cdr ,var)))))))))))
+	       (unrelop caller '= form))
+	     (check-char-cmp caller '= form)))
+	 (hash-special '= sp-=))
+
+	(let ()
+	  (define (sp-=->eq caller head form env)
+	    (if (= (length form) 3)
+		(let ((old made-suggestion))
+		  (lint-format "perhaps 'eq? not '~A in ~A" caller head (truncated-list->string form))
+		  (set! made-suggestion old))))
+	  (hash-special 'boolean=? sp-=->eq)
+	  (hash-special 'symbol=? sp-=->eq))
+
+	;; ---------------- < > <= >= ----------------
+	(let ()
+	  (define (sp-< caller head form env)
+	    (let ((len (length form)))
+	      (let ((cleared-form (cons head ; keep operator
+					(remove-if (lambda (x)
+						     (not (number? x)))
+						   (cdr form)))))
+		(if (and (> (length cleared-form) 2)
+			 (not (checked-eval cleared-form)))  ; (< x 1 2 0 y)
+		    (lint-format "this comparison can't be true: ~A" caller (truncated-list->string form))))
+
+	      (if (= len 3)
+		  (unrelop caller head form)
+		  (when (> len 3)
+		    (if (memq head '(< >))              ; (< x y x) -> #f
+			(if (or (repeated-member? (cdr form) env)
+				(and (= len 4)          ; (< 0 (floor x) 1) -> #f -- this gets no hits, but I like it...
+				     (integer? (cadr form))
+				     (pair? (caddr form))
+				     (integer? (cadddr form))
+				     (= (abs (- (cadr form) (cadddr form))) 1)
+				     (cond ((arg-signature (caaddr form) env) =>
+					    (lambda (sig)
+					      (eq? 'integer? (car sig))))
+					   (else #f))))
+				(lint-format "perhaps ~A" caller (lists->string form #f)))
+			(if (and (memq head '(<= >=))
+				 (repeated-member? (cdr form) env))
+			    (do ((last-arg (cadr form))
+				 (new-args (list (cadr form)))
+				 (lst (cddr form) (cdr lst)))
+				((null? lst)
+				 (if (repeated-member? new-args env)       ; (<= x y x z x) -> (= x y z)
+				     (lint-format "perhaps ~A" caller (truncated-lists->string form (cons '= (lint-remove-duplicates (reverse new-args) env))))
+				     (if (< (length new-args) (- len 1))
+					 (lint-format "perhaps ~A" caller  ; (<= x x y z) -> (= x y z)
+						      (truncated-lists->string form (or (null? (cdr new-args))
+											(cons '= (reverse new-args))))))))
+			      (unless (equal? (car lst) last-arg)
+				(set! last-arg (car lst))
+				(set! new-args (cons last-arg new-args))))))))
+
+	      (cond ((not (= len 3)))
+
+		    ((and (real? (cadr form))
+			  (or (< (cadr form) 0)
+			      (and (zero? (cadr form))
+				   (eq? head '>)))
+			  (pair? (caddr form))   ; (> 0 (string-length x))
+			  (hash-table-ref non-negative-ops (caaddr form)))
+		     (lint-format "~A can't be negative: ~A" caller (caaddr form) (truncated-list->string form)))
+
+		    ((and (real? (caddr form))
+			  (or (< (caddr form) 0)
+			      (and (zero? (caddr form))
+				   (eq? head '<)))
+			  (pair? (cadr form))    ; (< (string-length x) 0)
+			  (hash-table-ref non-negative-ops (caadr form)))
+		     (lint-format "~A can't be negative: ~A" caller (caadr form) (truncated-list->string form)))
+
+		    ((and (pair? (cadr form))
+			  (eq? (caadr form) 'length))
+		     (let ((arg (cadadr form)))
+		       (when (symbol? arg)       ;  (>= (length x) 0) -> (list? x)
+			 ;; see comment above about distinguishing types!  (twice I've wasted my time)
+			 (if (eqv? (caddr form) 0)
+			     (lint-format "perhaps~A ~A" caller
+					  (if (eq? head '<) "" (format #f " (assuming ~A is a proper list)," arg))
+					  (lists->string form
+							 (case head
+							   ((<)  `(and (pair? ,arg) (not (proper-list? ,arg))))
+							   ((<=) (list 'null? arg))
+							   ((>)  (list 'pair? arg))
+							   ((>=) (list 'list? arg)))))
+			     (if (and (eqv? (caddr form) 1)
+				      (not (eq? head '>)))  ; (<= (length x) 1) -> (or (null? x) (null? (cdr x)))
+				 (lint-format "perhaps (assuming ~A is a proper list), ~A" caller arg
+					      (lists->string form
+							     (case head
+							       ((<)  (list 'null? arg))
+							       ((<=) `(or (null? ,arg) (null? (cdr ,arg))))
+							       ((>)  `(and (pair? ,arg) (pair? (cdr ,arg))))
+							       ((>=) (list 'pair? arg))
+							       (else 'error)))))))))
+		    ((and (len>1? (caddr form))
+			  (eq? (caaddr form) 'length))
+		     (let ((arg (cadr (caddr form))))
+		       (when (symbol? arg)                  ;  (>= 0 (length x)) -> (null? x)
+			 (if (eqv? (cadr form) 0)
+			     (lint-format "perhaps~A ~A" caller
+					  (if (eq? head '>) "" (format #f " (assuming ~A is a proper list)," arg))
+					  (lists->string form
+							 (case head
+							   ((<)  (list 'pair? arg))
+							   ((<=) (list 'list? arg))
+							   ((>)  `(and (pair? ,arg) (not (proper-list? ,arg))))
+							   ((>=) (list 'null? arg))
+							   (else 'error))))
+			     (if (and (eqv? (cadr form) 1)
+				      (not (eq? head '<))) ; (> 1 (length x)) -> (null? x)
+				 (lint-format "perhaps (assuming ~A is a proper list), ~A" caller arg
+					      (lists->string form
+							     (case head
+							       ((<)  `(and (pair? ,arg) (pair? (cdr ,arg))))
+							       ((<=) (list 'pair? arg))
+							       ((>)  (list 'null? arg))
+							       ((>=) `(or (null? ,arg) (null? (cdr ,arg))))
+							       (else 'error)))))))))
+		    ((and (eq? head '<)
+			  (eqv? (caddr form) 1)
+			  (len>1? (cadr form))           ; (< (vector-length x) 1) -> (equal? x #())
+			  (memq (caadr form) '(string-length vector-length)))
+		     (lint-format "perhaps ~A" caller (lists->string form (list (if (eq? (caadr form) 'string-length) 'string=? 'equal?)
+										(cadadr form)
+										(if (eq? (caadr form) 'string-length) "" #())))))
+		    ((and (eq? head '>)
+			  (eqv? (cadr form) 1)
+			  (len>1? (caddr form))          ; (> 1 (string-length x)) -> (string=? x "")
+			  (memq (caaddr form) '(string-length vector-length)))
+		     (lint-format "perhaps ~A" caller (lists->string form (list (if (eq? (caaddr form) 'string-length) 'string=? 'equal?)
+										(cadr (caddr form))
+										(if (eq? (caaddr form) 'string-length) "" #())))))
+		    ((and (eqv? (caddr form) 0)
+			  (pair? (cadr form))
+			  (eq? (caadr form) 'denominator))
+		     (lint-format "denominator is ~A ~A than 0: ~A" caller
+				  (if (memq head '(< <=)) "never" "always")
+				  head
+				  form))
+
+		    ((and (memq head '(<= >=))
+			  (or (and (eqv? (caddr form) 0)
+				   (pair? (cadr form))  ; (<= (string-length m) 0) -> (= (string-length m) 0)
+				   (hash-table-ref non-negative-ops (caadr form)))
+			      (and (eqv? (cadr form) 0)
+				   (pair? (caddr form))
+				   (hash-table-ref non-negative-ops (caaddr form)))))
+		     (lint-format "~A is never negative, so ~A" caller
+				  ((if (eqv? (caddr form) 0) caadr caaddr) form)
+				  (lists->string form (or (not (eq? (eq? head '<=)
+								    (eqv? (caddr form) 0)))
+							  (cons '= (cdr form))))))
+		    ((and (eqv? (caddr form) 256)
+			  (pair? (cadr form))          ; (< (char->integer key) 256) -> #t
+			  (eq? (caadr form) 'char->integer))
+		     (lint-format "perhaps ~A" caller
+				  (lists->string form (and (memq head '(< <=)) #t))))
+
+		    ((or (and (eqv? (cadr form) 0)     ; (> (numerator x) 0) -> (> x 0)
+			      (len>1? (caddr form))
+			      (eq? (caaddr form) 'numerator))
+			 (and (eqv? (caddr form) 0)
+			      (len>1? (cadr form))
+			      (eq? (caadr form) 'numerator)))
+		     (lint-format "perhaps ~A" caller
+				  (lists->string form
+						 (if (eqv? (cadr form) 0)
+						     (list head (cadr form) (cadr (caddr form)))
+						     (list head (cadadr form) (caddr form)))))))
+	      (check-char-cmp caller head form)))
+	  ;; could change (> x 0) to (positive? x) and so on, but the former is clear and ubiquitous
+
+	  (for-each (lambda (f)
+		      (hash-special f sp-<))
+		    '(< > <= >=))) ; '= handled by sp-= above
+
+	;; ---------------- char< char> etc ----------------
+	(let ()
+	  (define (sp-char< caller head form env)
+	    ;; only once: (char<=? #\0 c #\1)
+	    (let ((cleared-form (cons head ; keep operator
+				      (remove-if (lambda (x)
+						   (not (char? x)))
+						 (cdr form)))))
+	      (if (and (> (length cleared-form) 2)   ; (char>? x #\a #\b y)
+		       (not (checked-eval cleared-form)))
+		  (lint-format "this comparison can't be true: ~A" caller (truncated-list->string form))))
+	    (if (and (eq? head 'char-ci=?)           ; (char-ci=? x #\return)
+		     (len=3? form)
+		     (or (and (char? (cadr form))
+			      (char=? (cadr form) (other-case (cadr form))))
+			 (and (char? (caddr form))
+			      (char=? (caddr form) (other-case (caddr form))))))
+		(lint-format "char-ci=? could be char=? here: ~A" caller form)
+
+		(when (and (eq? head 'char=?)        ; (char=? #\a (char-downcase x)) -> (char-ci=? #\a x)
+			   (pair? (cdr form))
+			   (let ((casef (let ((op #f))
+					  (lambda (a)
+					    (or (char? a)
+						(and (pair? a)
+						     (memq (car a) '(char-downcase char-upcase))
+						     (if op
+							 (eq? op (car a))
+							 (set! op (car a)))))))))
+			     (lint-every? casef (cdr form))))
+		  (lint-format "perhaps ~A" caller
+			       (lists->string form   ; (char=? #\a (char-downcase x)) -> (char-ci=? #\a x)
+					      (cons 'char-ci=? (map (lambda (a)
+								      (if (and (len>1? a)
+									       (memq (car a) '(char-upcase char-downcase)))
+									  (cadr a)
+									  a))
+								    (cdr form))))))))
+	  (for-each (lambda (f)
+		      (hash-special f sp-char<))
+		    '(char<? char>? char<=? char>=? char=? char-ci<? char-ci>? char-ci<=? char-ci>=? char-ci=?)))
+
+
+	;; ---------------- string< string> etc ----------------
+	(let ()
+	  (define (sp-string< caller head form env)
+	    (let ((cleared-form (cons head ; keep operator
+				      (remove-if (lambda (x)
+						   (not (string? x)))
+						 (cdr form)))))
+	      (if (and (> (length cleared-form) 2)  ; (string>? "a" x "b" y)
+		       (not (checked-eval cleared-form)))
+		  (lint-format "this comparison can't be true: ~A" caller (truncated-list->string form))))
+
+	    ;; all the ops are upcase|downcase and all ops match.  Not unmatched ops because (string=? (upcase x) (downcase x)) is not (string-ci=? x x)
+	    (if (and (> (length form) 2)
+		     (let ((casef (let ((op #f))
+				    (lambda (a)
+				      (and (pair? a)
+					   (memq (car a) '(string-downcase string-upcase))
+					   (if op
+					       (eq? op (car a))
+					       (set! op (car a))))))))
+		       (lint-every? casef (cdr form))))
+		(lint-format "perhaps ~A" caller    ; (string=? (string-downcase x) (string-downcase y)) -> (string-ci=? x y)
+			     (lists->string form
+					    (let ((op (case head
+							((string=?) 'string-ci=?)
+							((string<=?) 'string-ci<=?)
+							((string>=?) 'string-ci>=?)
+							((string<?) 'string-ci<?)
+							((string>?) 'string-ci>?)
+							(else))))
+					      (cons op (map (lambda (a)
+							      (if (and (pair? a)
+								       (memq (car a) '(string-upcase string-downcase)))
+								  (cadr a)
+								  a))
+							    (cdr form)))))))
+
+	    (if (lint-any? (lambda (a) ; string-copy is redundant in arg list
+			     (and (len=2? a)
+				  (memq (car a) '(copy string-copy))))
+			   (cdr form))
+		(let cleaner ((args (cdr form)) (new-args ())) ; (string=? "" (string-copy "")) -> (string=? "" "")
+		  (if (not (pair? args))
+		      (lint-format "perhaps ~A" caller (lists->string form (cons head (reverse new-args))))
+		      (let ((a (car args)))
+			(cleaner (cdr args)
+				 (cons (if (and (len=2? a)
+						(memq (car a) '(copy string-copy)))
+					   (cadr a)
+					   a)
+				       new-args))))))
+
+	    (when (and (eq? head 'string=?)
+		       (= (length form) 3))
+	      (unless (string->char= caller form form)     ; (string=? "x" (string y))
+		(string->char= caller (cons (car form) (reverse (cdr form))) form))
+
+	      (if (and (pair? (cadr form))                 ; (string=? (symbol->string a) (symbol->string b)) -> (eq? a b)
+		       (eq? (caadr form) 'symbol->string)
+		       (pair? (caddr form))
+		       (eq? (caaddr form) 'symbol->string))
+		  (lint-format "perhaps ~A" caller (lists->string form (list 'eq? (cadadr form) (cadr (caddr form))))))))
+
+	  (for-each (lambda (f)
+		      (hash-special f sp-string<))
+		    '(string<? string>? string<=? string>=? string=? string-ci<? string-ci>? string-ci<=? string-ci>=? string-ci=?)))
+
+	;; ---------------- length ----------------
+	(let ()
+	 (define (sp-length caller head form env)
+	   (when (pair? (cdr form))
+	     (if (pair? (cadr form))
+		 (let ((arg (cadr form)))
+		   (if (eq? (car arg) 'list)              ; (length (list 'a 'b 'c)) -> 3
+		       (lint-format "perhaps ~A" caller (lists->string form (- (length arg) 1)))
+		       (let ((arg-args (cdadr form)))
+			 (when (pair? arg-args)
+			   (case (car arg)
+			     ((string->list vector->list)
+			      (if (null? (cdr arg-args))           ; string->list has start:end etc ; (length (string->list x)) -> (length x)
+				  (lint-format "perhaps ~A" caller (lists->string form (list 'length (car arg-args))))
+				  (if (len>2? arg-args)
+				      (if (and (integer? (caddr arg-args))  ; (length (vector->list x 1)) -> (- (length x) 1)
+					       (integer? (cadr arg-args)))
+					  (lint-format "perhaps ~A -> ~A" caller (truncated-list->string form) (max 0 (- (caddr arg-args) (cadr arg-args))))
+					  (lint-format "perhaps ~A" caller (lists->string form (list '- (caddr arg-args) (cadr arg-args)))))
+				      (lint-format "perhaps ~A" caller (lists->string form (list '- (list 'length (car arg-args)) (cadr arg-args)))))))
+
+			     ((reverse reverse! list->vector list->string let->list)
+			      (lint-format "perhaps ~A" caller (lists->string form (list 'length (car arg-args)))))
+
+			     ((cons)                          ; (length (cons item items)) -> (+ (length items) 1)
+			      (if (pair? (cdr arg-args))
+				  (lint-format "perhaps ~A" caller (lists->string form (list '+ (list 'length (cadr arg-args)) 1)))))
+
+			     ((make-list)                     ; (length (make-list 3)) -> 3
+			      (lint-format "perhaps ~A" caller (lists->string form (car arg-args))))
+
+			     ((append)                        ; (length (append x y)) -> (+ (length x) (length y))
+			      (if (= (length arg) 3)
+				  (lint-format "perhaps ~A" caller (lists->string form `(+ (length ,(car arg-args)) (length ,(cadr arg-args)))))))
+
+			     ((quote #_quote)                 ; (length '(1 2 3)) -> 3
+			      (if (list? (car arg-args))
+				  (lint-format "perhaps ~A" caller (lists->string form (length (car arg-args)))))))))))
+
+		 ;; not pair cadr
+		 (if (code-constant? (cadr form))     ; (length 0) -> #f
+		     (lint-format "perhaps ~A -> ~A" caller
+				  (truncated-list->string form)
+				  (length ((if (and (pair? (cadr form))
+						    (memq (caadr form) '(quote #_quote)))
+					       cadadr cadr)
+					   form)))))))
+	 (hash-special 'length sp-length))
+
+	;; ---------------- zero? positive? negative? ----------------
+	(let ()
+	  (define (sp-zero? caller head form env)
+	    (when (pair? (cdr form))
+	      (let ((arg (cadr form)))
+		(if (and (real? arg)                   ; (zero? 0) -> #t
+			 (null? (cddr form))
+			 (not (var-member head env)))
+		    (lint-format "perhaps ~A" caller (lists->string form (eval/error caller form))))
+
+		(when (pair? arg)
+		  (if (and (eq? head 'negative?)   ; (negative? (string-length s))
+			   (hash-table-ref non-negative-ops (car arg)))
+		      (lint-format "~A can't be negative: ~A" caller (car arg) (truncated-list->string form))
+		      (if (and (eq? head 'zero?)   ; (zero? (denominator x)) -> error
+			       (eq? (car arg) denominator))
+			  (lint-format "denominator can't be zero: ~A" caller form)
+			  (when (proper-pair? (cdr arg))
+			    (case (car arg)
+			      ((-)
+			       (lint-format "perhaps ~A" caller  ; (zero? (- x)) -> (zero? x), (positive? (- x y)) -> (> x y)
+					    (lists->string form
+							   (let ((op '((zero? = zero?) (positive? > negative?) (negative? < positive?))))
+							     (if (null? (cddr arg))
+								 (list (caddr (assq head op)) (cadr arg))
+								 (list (cadr (assq head op)) (cadr arg)
+								       (if (null? (cdddr arg))
+									   (caddr arg)
+									   (cons '+ (cddr arg)))))))))
+
+			      ((abs magnitude)          ; (zero? (abs x)) -> (zero? x)
+			       (if (eq? head 'zero?)
+				   (lint-format "perhaps ~A" caller (lists->string form (cons 'zero? (cdr arg))))))
+
+			      ((imag-part)              ; (zero? (imag-part x)) -> (real? x)
+			       (if (eq? head 'zero?)
+				   (lint-format "perhaps ~A" caller (lists->string form (cons 'real? (cdr arg))))))
+
+			      ((numerator)              ; (negative? (numerator x)) -> (negative? x)
+			       (lint-format "perhaps ~A" caller (lists->string form (list head (cadr arg)))))
+
+			      ((remainder modulo)
+			       (if (integer? (caddr arg))
+				   (if (and (eq? head 'zero?)
+					    (= (caddr arg) 2))
+				       (lint-format "perhaps (assuming ~A is an integer) ~A"
+						    caller (cadr arg) (lists->string form `(even? ,(cadr arg))))
+				       (if (and (eq? (car arg) 'modulo)
+						(not (eq? head 'zero?))
+						(not (zero? (caddr arg))))
+					   (lint-format "perhaps ~A" caller
+							(lists->string form (case head
+									      ((positive?) (positive? (caddr arg)))
+									      ((negative?) (negative? (caddr arg)))
+									      (else #f))))))))
+
+			      ((string-length)          ; (zero? (string-length x)) -> (string=? x "")
+			       (if (eq? head 'zero?)
+				   (lint-format "perhaps ~A" caller (lists->string form (list 'string=? (cadr arg) "")))))
+
+			      ((vector-length)          ; (zero? (vector-length c)) -> (equal? c #())
+			       (if (eq? head 'zero?)
+				   (lint-format "perhaps ~A" caller (lists->string form (list 'equal? (cadr arg) #())))))
+
+			      ((length)                 ;  (zero? (length routes)) -> (null? routes)
+			       (if (eq? head 'zero?)
+				   (lint-format "perhaps (assuming ~A is list) use null? instead of length: ~A" caller (cadr arg)
+						(lists->string form (list 'null? (cadr arg))))))))))))))
+
+	  ;; (zero? (logand...)) is nearly always preceded by not and handled elsewhere
+	  (for-each (lambda (f)
+		      (hash-special f sp-zero?))
+		    '(zero? positive? negative?)))
+
+	;; ---------------- / ----------------
+	(let ()
+	 (define (sp-/ caller head form env)
+	   (cond ((not (pair? (cdr form))))
+
+		 ((and (null? (cddr form))
+		       (number? (cadr form))
+		       (zero? (cadr form)))                    ; (/ 0)
+		  (lint-format "attempt to invert zero: ~A" caller (truncated-list->string form)))
+
+		 ((and (pair? (cddr form))                     ; (/ x y 2 0)
+		       (memv 0 (cddr form)))
+		  (lint-format "attempt to divide by 0: ~A" caller (truncated-list->string form)))
+
+		 (else
+		  (let ((len (if (null? (cddr form))           ; (/ (length x))
+				 (and (len=2? (cadr form))
+				      (eq? (caadr form) 'length)
+				      (cadr form))
+				 (assq 'length (cddr form))))) ; (/ x y (length z))
+		    (if (len=2? len)
+			(lint-format "~A will cause division by 0 if ~A is empty" caller len (cadr len)))))))
+
+	 (hash-special '/ sp-/))
+
+	;; ---------------- copy ----------------
+	(let ()
+	  (define (sp-copy caller head form env)
+	    (cond ((not (pair? (cdr form))))        ; (copy) argnum error reported elsewhere
+
+		  ((or (number? (cadr form))        ; (copy 1)
+		       (boolean? (cadr form))
+		       (char? (cadr form))
+		       (and (pair? (cadr form))     ; (copy (copy x)) -> (copy x)
+			    (null? (cddr form))     ;   not (copy (copy x) (list ...))
+			    (memq (caadr form) '(copy string-copy)))) ; or any maker?
+		   (lint-format "~A could be ~A" caller (truncated-list->string form) (cadr form)))
+
+		  ((and (pair? (cadr form))         ; (copy (copy x) ...) -> (copy x ...)
+			(pair? (cddr form))
+			(eq? (caadr form) 'copy)
+			(pair? (cdadr form))
+			(null? (cddadr form)))
+		   (lint-format "~A could be ~A" caller (truncated-list->string form) `(copy ,(cadadr form) ,@(cddr form))))
+
+		  ((equal? (cadr form) '(owlet))    ; (copy (owlet)) -> (owlet)
+		   (lint-format "~A could be (owlet): owlet is copied internally" caller form))
+
+		  ((not (pair? (cddr form))))
+
+		  ((and (eq? (cadr form) (caddr form))  ; (copy x x)
+			(or (null? (cdddr form))
+			    (and (eqv? (cadddr form) 0) ; (copy x x 0)
+				 (null? (cddddr form)))))
+		   (lint-format "~A is a no-op" caller form))
+
+		  ((= (length form) 5)
+		   (check-start-and-end caller 'copy (cdddr form) form env))))
+	  (hash-special 'copy sp-copy))
+
+	;; ---------------- string-copy ----------------
+	(let ()
+	  (define (sp-string-copy caller head form env)
+	    (if (and (pair? (cdr form))
+		     (pair? (cadr form))   ; (string-copy (string-copy x)) could be (string-copy x)
+		     (memq (caadr form) '(copy string-copy string make-string string-upcase string-downcase
+					  string-append list->string symbol->string number->string)))
+		(if (null? (cddr form))
+		    (lint-format "~A could be ~A" caller (truncated-list->string form) (cadr form))
+		    (if (and (pair? (cddr form))
+			     (pair? (cdadr form))
+			     (null? (cddadr form)))
+			(lint-format "~A could be ~A" caller (truncated-list->string form) `(string-copy ,(cadadr form) ,@(cddr form)))))))
+	  (hash-special 'string-copy sp-string-copy))
+
+	;; ---------------- string-down|upcase ----------------
+	(let ()
+	  (define (sp-string-upcase caller head form env)
+	    (if (and (pair? (cdr form))
+		     (string? (cadr form))) ; (string-downcase "SPEAK") -> "speak"
+	       (lint-format "perhaps ~A" caller (lists->string form
+							       ((if (eq? head 'string-upcase) string-upcase string-downcase)
+								(cadr form))))))
+	  (hash-special 'string-upcase sp-string-upcase)
+	  (hash-special 'string-downcase sp-string-upcase))
+
+	;; ---------------- string ----------------
+	(let ()
+	  (define (sp-string caller head form env)
+	    (if (lint-every? (lambda (x)
+			       (and (char? x)
+				    (char<=? #\space x #\~))) ; #\0xx chars here look dumb
+			     (cdr form))
+		(lint-format "~A could be ~S" caller (truncated-list->string form) (apply string (cdr form)))
+		(if (and (pair? (cdr form))              ; (string (string-ref x 0)) -> (substring x 0 1)
+			 (pair? (cadr form)))
+		    (if (null? (cddr form))
+			(if (eq? (caadr form) 'string-ref)
+			    (let ((arg (cdadr form)))
+			      (if (and (len>1? arg)
+				       (integer? (cadr arg)))     ; (string (string-ref x 0)) -> (substring x 0 1)
+				  (lint-format "perhaps ~A" caller
+					       (lists->string form
+							      (list 'substring (car arg) (cadr arg) (+ 1 (cadr arg))))))))
+			(if (and (memq (caadr form) '(char-upcase char-downcase))
+				 (lint-every? (lambda (p)
+						(eq? (caadr form) (car p)))
+					      (cddr form)))
+			    ;; (string (char-downcase (string-ref x 1)) (char-downcase (string-ref x 2))) ->
+			    ;;    (string-downcase (string (string-ref x 1) (string-ref x 2)))
+			    (lint-format "perhaps ~A" caller
+					 (lists->string form `(,(if (eq? (caadr form) 'char-upcase) 'string-upcase 'string-downcase)
+							       (string ,@(map cadr (cdr form)))))))))))
+	  ;; repeated args as in vector/list (sp-list below) got no hits
+	  (hash-special 'string sp-string))
+
+	;; ---------------- string? ----------------
+	(let ()
+	  (define (sp-string? caller head form env)
+	    (if (and (pair? (cdr form))
+		     (pair? (cadr form))
+		     (memq (caadr form) '(format number->string)))
+		(if (eq? (caadr form) 'format)                      ; (string? (number->string x)) -> #t
+		    (lint-format "format returns either #f or a string, so ~A" caller (lists->string form (cadr form)))
+		    (lint-format "number->string always returns a string, so ~A" caller (lists->string form #t)))
+		(check-boolean-affinity caller form env)))
+	  (hash-special 'string? sp-string?))
+
+	;; ---------------- number? ----------------
+	(let ()
+	  (define (sp-number? caller head form env)
+	    (if (and (pair? (cdr form))
+		     (pair? (cadr form))
+		     (eq? (caadr form) 'string->number))  ; (number? (string->number x)) -> (string->number x)
+		(lint-format "string->number returns either #f or a number, so ~A" caller (lists->string form (cadr form)))
+		(check-boolean-affinity caller form env)))
+	  (hash-special 'number? sp-number?))
+
+	;; ---------------- exact? inexact? infinite? nan? ----------------
+	(let ()
+	  (define (sp-exact? caller head form env)
+	    (if (and (pair? (cdr form))
+		     (number? (cadr form)))
+		(check-boolean-affinity caller form env)))
+	  (for-each (lambda (f)
+		      (hash-special f sp-exact?))
+		    '(exact? inexact? infinite? nan?)))
+
+	;; ---------------- symbol? etc ----------------
+	(let ()
+	  (define (sp-symbol? caller head form env)
+	    (check-boolean-affinity caller form env))
+	  (for-each (lambda (f)
+		      (hash-special f sp-symbol?))
+		    '(symbol? rational? real? complex? float? keyword? gensym? byte-vector? proper-list? sequence? constant?
+		      char? boolean? float-vector? int-vector? vector? let? hash-table? input-port? byte?
+		      output-port? iterator? continuation? dilambda? procedure? macro? random-state? eof-object? c-pointer?
+		      syntax? undefined? unspecified?)))
+
+	;; ---------------- pair? list? ----------------
+	(let ()
+	  (define (sp-pair? caller head form env)
+	    (check-boolean-affinity caller form env)
+	    (if (and (pair? (cdr form))     ; (pair? (member x y)) -> (member x y)
+		     (pair? (cadr form))
+		     (memq (caadr form) '(memq memv member assq assv assoc signature)))
+		(lint-format "~A returns either #f or a pair, so ~A" caller (caadr form)
+			     (lists->string form (cadr form)))))
+	  (for-each (lambda (f)
+		      (hash-special f sp-pair?))
+		    '(pair? list?)))
+
+	;; ---------------- integer? ----------------
+	(let ()
+	  (define (sp-integer? caller head form env)
+	    (check-boolean-affinity caller form env)
+	    (if (and (pair? (cdr form))    ; (integer? (char-position x y)) -> (char-position x y)
+		     (pair? (cadr form))
+		     (memq (caadr form) '(char-position string-position)))
+		(lint-format "~A returns either #f or an integer, so ~A" caller (caadr form)
+			     (lists->string form (cadr form)))))
+	  (hash-special 'integer? sp-integer?))
+
+	;; ---------------- null? ----------------
+	(let ()
+	  (define (sp-null? caller head form env)
+	    (check-boolean-affinity caller form env)
+	    (if (and (pair? (cdr form))  ; (null? (string->list x)) -> (zero? (length x))
+		     (len>1? (cadr form))
+		     (memq (caadr form) '(vector->list string->list let->list)))
+		(lint-format "perhaps ~A" caller
+			     (lists->string form (list 'zero? (list 'length (cadadr form)))))))
+	  (hash-special 'null? sp-null?))
+
+	;; ---------------- odd? even? ----------------
+	(let ()
+	  (define (sp-odd? caller head form env)
+	    (if (and (pair? (cdr form))   ; (odd? (- x 1)) -> (even? x)
+		     (len=3? (cadr form))
+		     (memq (caadr form) '(+ -)))
+		(let* ((arg1 (cadadr form))
+		       (arg2 (caddr (cadr form)))
+		       (int-arg (or (and (integer? arg1) arg1)
+				    (and (integer? arg2) arg2))))
+		  (if int-arg
+		      (lint-format "perhaps ~A" caller
+				   (lists->string form
+						  (if (and (integer? arg1)
+							   (integer? arg2))
+						      (eval/error caller form)
+						      (list (if (eq? (eq? head 'even?) (even? int-arg)) 'even? 'odd?)
+							    (if (integer? arg1) arg2 arg1)))))))))
+	  (hash-special 'odd? sp-odd?)
+	  (hash-special 'even? sp-odd?))
+
+	;; ---------------- string-ref ----------------
+	(let ()
+	  (define (sp-string-ref caller head form env)
+	    (when (= (length form) 3)
+
+	      (if (equal? (cadr form) "")
+		  (lint-format "~A is an error" caller form)
+		  (when (just-code-constants? (cdr form))      ; (string-ref "abc" 0) -> #\a
+		    (catch #t
+		      (lambda ()
+			(let ((val (eval form)))
+			  (lint-format "perhaps ~A" caller (lists->string form val))))
+		      (lambda args
+			(lint-format "~A: ~A" caller
+				     (object->string form)
+				     (apply format #f (cadr args)))))))
+
+	      (when (pair? (cadr form))
+		(let ((target (cadr form)))
+		  (case (car target)
+		    ((substring)                      ;  (string-ref (substring x 1) 2) -> (string-ref x (+ 2 1))
+		     (if (= (length target) 3)
+			 (lint-format "perhaps ~A" caller (lists->string form `(string-ref ,(cadr target) (+ ,(caddr form) ,(caddr target)))))))
+
+		    ((symbol->string)                 ;  (string-ref (symbol->string 'abs) 1) -> #\b
+		     (if (and (integer? (caddr form))
+			      (pair? (cadr target))
+			      (memq (caadr target) '(quote #_quote))
+			      (symbol? (cadadr target)))
+			 (lint-format "perhaps ~A" caller (lists->string form (string-ref (symbol->string (cadadr target)) (caddr form))))))
+
+		    ((make-string)                    ;  (string-ref (make-string 3 #\a) 1) -> #\a
+		     (if (and (integer? (cadr target))
+			      (integer? (caddr form))
+			      (> (cadr target) (caddr form)))
+			 (lint-format "perhaps ~A" caller (lists->string form (if (= (length target) 3) (caddr target) #\space))))))))))
+
+	  (hash-special 'string-ref sp-string-ref))
+
+	;; ---------------- vector-ref etc ----------------
+	(let ()
+	  (define (sp-vector-ref caller head form env)
+	    (unless (= line-number last-checker-line-number)
+	      (when (= (length form) 3)
+		(let ((seq (cadr form)))
+
+		  (when (code-constant? (cadr form))
+		    (if (eqv? (length (cadr form)) 0)
+			(lint-format "~A is an error" caller form)
+			(when (just-code-constants? (cddr form))      ; (vector-ref #(1 2) 0) -> 1
+			  (catch #t
+			    (lambda ()
+			      (let ((val (eval form)))
+				(lint-format "perhaps ~A -> ~A~A" caller
+					     (truncated-list->string form)
+					     (if (or (pair? val)
+						     (symbol? val))
+						 "'" "")
+					     (object->string val))))
+			    (lambda args
+			      (lint-format "~A: ~A" caller
+					   (object->string form)
+					   (apply format #f (cadr args))))))))
+
+		  (if (and (eq? head 'list-ref)                       ; (list-ref lst 0) -> car etc
+			   (memv (caddr form) '(0 1 2))
+			   (not (and (pair? seq)
+				     (memq (car seq) '(cdr cddr cdddr)))))
+		      (lint-format "perhaps ~A" caller
+				   (lists->string form
+						  (if (and (pair? seq)
+							   (eq? (car seq) 'list-ref)
+							   (memv (caddr seq) '(0 1)))
+						      (list (vector-ref #2d((caar cadar caddar)     ; 0 [0 1 2]
+									    (caadr cadadr caddadr)) ; 1 [0 1 2]
+									(caddr seq)
+									(caddr form))
+							    (cadr seq))
+						      (list (case (caddr form)
+							      ((0) 'car)
+							      ((1) 'cadr)
+							      ((2) 'caddr)
+							      (else 'error))
+							    seq))))
+		      (when (pair? seq)
+			(if (and (memq (car seq) '(vector-ref int-vector-ref float-vector-ref list-ref hash-table-ref let-ref))
+				 (= (length seq) 3))  ; (vector-ref (vector-ref x i) j) -> (x i j)
+			    (let ((seq1 (cadr seq)))  ;   x
+			      (lint-format "perhaps ~A" caller
+					   (lists->string form
+							  (if (and (pair? seq1)   ; (vector-ref (vector-ref (vector-ref x i) j) k) -> (x i j k)
+								   (memq (car seq1) '(vector-ref int-vector-ref float-vector-ref list-ref hash-table-ref let-ref))
+								   (= (length seq1) 3))
+							      (list (cadr seq1) (caddr seq1) (caddr seq) (caddr form))
+							      (list seq1 (caddr seq) (caddr form))))))
+			    (if (memq (car seq) '(make-vector make-list vector list
+							      make-float-vector make-int-vector float-vector int-vector
+							      make-hash-table hash-table
+							      inlet))
+				(lint-format "this doesn't make much sense: ~A" caller form)))
+			(when (eq? head 'list-ref)
+			  (if (memq (car seq) '(quote #_quote))
+			      (if (proper-pair? (cadr seq))  ; ignore dumb (list-ref () 0), (list-ref '(#t #f) (random 2)) -> (vector-ref #(#t #f) (random 2))
+				  (lint-format "perhaps use a vector: ~A" caller
+					       (lists->string form (list 'vector-ref (apply vector (cadr seq)) (caddr form)))))
+			      (let ((index (caddr form)))    ; (list-ref (cdddr f) 2) -> (list-ref f 5)
+				(if (and (memq (car seq) '(cdr cddr cdddr))
+					 (or (integer? index)
+					     (and (pair? index)
+						  (eq? (car index) '-)
+						  (integer? (caddr index)))))
+				    (let ((offset (cdr (assq (car seq) '((cdr . 1) (cddr . 2) (cdddr . 3))))))
+				      (lint-format "perhaps ~A" caller
+						   (lists->string form
+								  (list 'list-ref (cadr seq)
+									(if (integer? index)
+									    (+ index offset)
+									    (let ((noff (- (caddr index) offset)))
+									      (if (zero? noff)
+										  (cadr index)
+										  (list '- (cadr index) noff))))))))))))))))
+	      (set! last-checker-line-number line-number)))
+	  (for-each (lambda (f)
+		      (hash-special f sp-vector-ref))
+		    '(vector-ref list-ref hash-table-ref let-ref int-vector-ref float-vector-ref)))
+
+	;; ---------------- vector-set! etc ----------------
+	(let ()
+	  (define (sp-vector-set! caller head form env)
+	    (when (= (length form) 4)
+	      (let ((target (cadr form))
+		    (index (caddr form))
+		    (val (cadddr form)))
+
+		(cond ((and (len=3? val)                   ; (vector-set! x 0 (vector-ref x 0))
+			    (eq? target (cadr val))
+			    (equal? index (caddr val))
+			    (memq (car val) '(vector-ref list-ref hash-table-ref string-ref let-ref float-vector-ref int-vector-ref)))
+		       (lint-format "redundant ~A: ~A" caller head (truncated-list->string form)))
+
+		      ((code-constant? target)             ; (vector-set! #(0 1 2) 1 3)??
+		       (let ((len (length target)))
+			 (cond ((eqv? len 0)
+				(lint-format "~A has no elements, so ~A makes no sense" caller target (truncated-list->string form)))
+			       ((and (integer? index)
+				     (integer? len)
+				     (>= index len))
+				(lint-format "index ~A is too large in ~A" caller index (truncated-list->string form)))
+			       (else
+				(lint-format "~S is a constant, so ~A is problematic, and ~S is discarded; perhaps ~A" caller
+					     target head target (lists->string form val))))))
+
+		      ((not (pair? target)))
+
+		      ((and (not (memq head '(string-set! hash-table-set! let-set!))) ; (vector-set! (vector-ref x 0) 1 2) -- vector within vector
+			    (memq (car target) '(vector-ref list-ref float-vector-ref int-vector-ref)))
+		       (lint-format "perhaps ~A" caller (lists->string form `(set! (,@(cdr target) ,index) ,val))))
+
+		      ((and (not (eq? head 'string-set!)) ; (hash-table-set! (vector-ref x 0) 'a 2) -> (set! ((x 0) 'a) 2)
+			    (memq (car target) '(vector-ref list-ref)))
+		       (lint-format "perhaps ~A" caller (lists->string form `(set! ((,@(cdr target)) ,index) ,val))))
+
+		      ((memq (car target) '(make-vector vector make-string string make-list list append cons
+					    vector-append inlet sublet copy vector-copy string-copy list-copy
+					    int-vector float-vector byte-vector string-append make-byte-vector
+					    make-int-vector make-float-vector make-hash-table hash-table
+					    )) ;list-copy is from r7rs
+		       (lint-format "~A is simply discarded; perhaps ~A" caller
+				    (truncated-list->string target)   ; (vector-set! (make-vector 3) 1 1) -- does this ever happen?
+				    (lists->string form val)))
+
+		      ((and (eq? head 'list-set!)
+			    (memq (car target) '(cdr cddr cdddr cddddr))
+			    (integer? (caddr form)))                  ; (list-set! (cdr x) 0 y) -> (list-set! x 1 y)
+		       (lint-format "perhaps ~A" caller
+				    (lists->string form
+						   `(list-set! ,(cadr target) ,(+ (caddr form) (cdr-count (car target))) ,(cadddr form)))))))))
+	  (for-each (lambda (f)
+		      (hash-special f sp-vector-set!))
+		    '(vector-set! list-set! hash-table-set! float-vector-set! int-vector-set! string-set! byte-vector-set! let-set!)))
+
+	;; ---------------- subvector ----------------
+	(let ()
+	  (define (sp-subvector caller head form env)
+	    (when (and (pair? (cdr form))
+		       (pair? (cddr form)))
+	      (let ((start (caddr form)))
+		(if (null? (cdddr form))
+		    (if (eqv? start 0)                           ; (subvector v 0) -> (subvector v)
+		      (lint-format "perhaps ~A" caller (lists->string form (list 'subvector (cadr form)))))
+		    (let ((end (cadddr form)))
+		      (if (null? (cddddr form))
+			  (if (and (eqv? start 0)
+				   (len=2? end)
+				   (eq? (cadr form) (cadr end))
+				   (memq (car end) '(length vector-length)))
+			      (lint-format "perhaps ~A" caller (lists->string form (list 'subvector (cadr form)))))
+			  (let ((dims (list-ref form 4))) ;(car (cddddr form))))
+			    (if (and (quoted-pair? dims)
+				     (integer? start)
+				     (integer? end)
+				     (null? (cdadr dims))
+				     (eqv? (caadr dims) (- end start)))
+				(lint-format "perhaps ~A" caller (lists->string form (list 'subvector (cadr form) start end)))))))))))
+
+	  (hash-special 'subvector sp-subvector))
+
+	;; ---------------- object->string ----------------
+	(let ()
+	  (define (sp-object->string caller head form env)
+	    (when (pair? (cdr form))
+	      (if (pair? (cadr form)) ; (object->string (object->string x)) could be (object->string x)
+		  (if (memq (caadr form) '(object->string symbol->string list->string number->string))
+		      (lint-format "~A could be ~A" caller (truncated-list->string form) (cadr form))
+		      (if (eq? (caadr form) 'string->symbol) ; (object->string (string->symbol x)) -> x
+			  (lint-format "~A could be ~A" caller (truncated-list->string form) (cadadr form))))
+		  (if (pair? (cddr form))
+		      (let ((arg2 (caddr form)))
+			(if (and (code-constant? arg2)                   ; (object->string x :else)
+				 (not (memq arg2 '(#f #t :readable))))   ; #f and #t are display|write choice, :readable = ~W
+			    (lint-format "bad second argument: ~A" caller arg2)))))))
+
+	(hash-special 'object->string sp-object->string))
+
+	(define (all-caps-warning arg)
+	  (and (string? arg)
+	       (or (string-position "ERROR" arg)
+		   (string-position "WARN" arg))))
+
+	;; ---------------- display ----------------
+	(let ()
+	  (define (sp-display caller head form env)
+	    (when (pair? (cdr form))
+	      (let ((arg (cadr form))
+		    (port (if (pair? (cddr form))
+			      (caddr form)
+			      ())))
+		(cond ((all-caps-warning arg)
+		       (lint-format  "There's no need to shout: ~A" caller (truncated-list->string form)))
+
+		      ((not port)
+		       (lint-format "~A could be ~A" caller form (cadr form)))
+
+		      ((not (len>1? arg)))
+
+		      ((and (eq? (car arg) 'format)    ; (display (format #f str x)) -> (format () str x)
+			    (not (cadr arg)))
+		       (lint-format "perhaps ~A" caller (lists->string form (cons 'format (cons port (cddr arg))))))
+
+		      ((and (eq? (car arg) 'apply)     ; (display (apply format #f str x) p) -> (apply format p str x)
+			    (eq? (cadr arg) 'format)
+			    (pair? (cddr arg))
+			    (not (caddr arg)))
+		       (lint-format "perhaps ~A" caller (lists->string form `(apply format ,port ,@(cdddr arg)))))
+
+		      ((and (pair? port)
+			    (eq? (car port) 'current-output-port))
+		       (lint-format "(current-output-port) is the default port for display: ~A" caller form))))))
+
+	  (hash-special 'display sp-display))
+
+	;; ---------------- flush-output-port, newline, close-output-port ----------------
+	(let ()
+	  (define (sp-flush-output-port caller head form env)
+	    (when (pair? (cdr form))
+	      (if (and (pair? (cadr form))
+		       (eq? (caadr form) 'current-output-port))
+		  (lint-format "(current-output-port) is the default port for ~A: ~A" caller head form)
+		  (unless (cadr form)
+		    (lint-format "~A is a no-op, returning ~A" caller form (if (eq? head 'flush-output-port) #f))))))
+	  (hash-special 'flush-output-port sp-flush-output-port)
+	  (hash-special 'close-output-port sp-flush-output-port)
+	  (hash-special 'newline sp-flush-output-port))
+
+	;; ---------------- write-char, write-byte, write ----------------
+	(let ()
+	  (define (sp-write-char caller head form env)
+	    (when (pair? (cdr form))
+	      (when (pair? (cddr form))
+		(if (and (pair? (caddr form))
+			 (eq? (caaddr form) 'current-output-port))
+		    (lint-format "(current-output-port) is the default port for ~A: ~A" caller head form)
+		    (if (not (caddr form))
+			(lint-format "~A could be ~A" caller form (cadr form)))))
+	      (case head
+		((write-byte)
+		 (if (and (integer? (cadr form))
+			  (not (<= 0 (cadr form) 255)))
+		     (lint-format "write-byte argument must be (<= 0 byte 255): ~A" caller form)))
+		((write-char)
+		 (if (eqv? (cadr form) #\newline)
+		     (lint-format "perhaps ~A" caller (lists->string form (cons 'newline (cddr form))))
+		     (if (and (len>1? (cadr form))
+			      (eq? (caadr form) 'integer->char))
+			 (lint-format "perhaps ~A" caller (lists->string form (cons 'write-byte (cons (cadadr form) (cddr form)))))))))))
+
+	  (hash-special 'write-char sp-write-char)
+	  (hash-special 'write-byte sp-write-char)
+	  (hash-special 'write sp-write-char))
+
+	;; ---------------- read, port-filename, port-line-number, read-char, read-byte ----------------
+	(let ()
+	  (define (sp-read caller head form env)
+	    (when (len=2? form)
+	      (if (and (pair? (cadr form))
+		       (eq? (caadr form) 'current-input-port))
+		  (lint-format "(current-input-port) is the default port for ~A: ~A" caller head form)
+		  (if (and (eq? head 'port-filename)
+			   (memq (cadr form) '(*stdin* *stdout* *stderr*)))
+		      (lint-format "~A: ~S" caller form
+				   (case (cadr form) ((*stdin*) "*stdin*") ((*stdout*) "*stdout*") ((*stderr*) "*stderr*") (else 'error)))))))
+	  (for-each (lambda (c)
+		      (hash-special c sp-read))
+		    '(read port-filename port-line-number read-char read-byte peek-char close-input-port)))
+
+	;; ---------------- char-alphabetic? char-lower-case? char-numeric? char-upper-case? char-whitespace? etc ----------------
+	(let ()
+	  (define (sp-char-numeric caller head form env)
+	    (if (and (len=1? (cdr form))
+		     (char? (cadr form))
+		     (not (var-member (car form) env)))
+		(lint-format "perhaps ~A" caller (lists->string form (eval/error caller form)))))
+	  (for-each (lambda (c)
+		      (hash-special c sp-char-numeric))
+		    '(char-alphabetic? char-lower-case? char-numeric? char-upper-case? char-whitespace? char-upcase char-downcase)))
+
+	;; ---------------- make-vector etc ----------------
+	(let ()
+	  (define (sp-make-vector caller head form env)
+	    ;; type of initial value (for make-float|int-vector) is checked elsewhere
+	    (when (>= (length form) 3)
+	      (case (caddr form)
+		((#<unspecified>)
+		 (if (eq? head 'make-vector)  ;  (make-vector 3 #<unspecified>)
+		     (lint-format "#<unspecified> is the default initial value in ~A" caller form)))
+		((0)
+		 (if (not (eq? head 'make-vector))
+		     (lint-format "0 is the default initial value in ~A" caller form)))
+		((0.0)
+		 (if (eq? head 'make-float-vector)
+		     (lint-format "0.0 is the default initial value in ~A" caller form))))
+
+	      (when (= (length form) 4)
+		(let ((typer (cadddr form)))
+		  (unless (memq typer setters)
+		    (lint-format "~A is not a built-in type" caller (cadddr form))))))
+
+	    (when (and (pair? (cdr form))
+		       (integer? (cadr form))
+		       (zero? (cadr form)))
+	      (if (pair? (cddr form))           ; (make-vector 0 0.0)
+		  (lint-format "initial value is pointless here: ~A" caller form))
+	      (lint-format "perhaps ~A" caller (lists->string form #()))))
+
+	  (for-each (lambda (f)
+		      (hash-special f sp-make-vector))
+		    '(make-vector make-int-vector make-float-vector)))
+
+	;; ---------------- make-string make-byte-vector ----------------
+	(let ()
+	  (define (sp-make-string caller head form env)
+	    (when (and (pair? (cdr form))
+		       (integer? (cadr form))
+		       (zero? (cadr form)))
+	      (if (pair? (cddr form))           ; (make-byte-vector 0 0)
+		  (lint-format "initial value is pointless here: ~A" caller form))
+	      (lint-format "perhaps ~A" caller (lists->string form (if (eq? head 'make-string) "" #u())))))
+	  (for-each (lambda (f)
+		      (hash-special f sp-make-string))
+		    '(make-string make-byte-vector)))
+
+	;; ---------------- make-list ----------------
+	(let ()
+	  (define (sp-make-list caller head form env)
+	    (when (and (pair? (cdr form))
+		       (integer? (cadr form))
+		       (zero? (cadr form)))
+	      (if (pair? (cddr form))           ; (make-list 0 #f)
+		  (lint-format "initial value is pointless here: ~A" caller form))
+	      (lint-format "perhaps ~A" caller (lists->string form ()))))
+	  (hash-special 'make-list sp-make-list))
+
+	;; ---------------- reverse string->list etc ----------------
+	(let ()
+	  (define (sp-reverse caller head form env)
+	    ;; not string->number -- no point in copying a number and it's caught below
+	    (when (pair? (cdr form))
+
+	      (if (just-code-constants? (cdr form))
+		  (let ((seq (checked-eval form)))
+		    (if (not (eq? seq :checked-eval-error))   ;  (symbol->string 'abs) -> "abs"
+			(lint-format "perhaps ~A -> ~A~A" caller
+				     (truncated-list->string form)
+				     (if (pair? seq) "'" "")
+				     (if (symbol? seq)
+					 (object->string seq :readable)
+					 (object->string seq))))))
+
+	      (when (len>1? (cadr form))
+		(let ((inverses '((reverse . reverse)
+				  (reverse! . reverse!)
+				  ;; reverse and reverse! are not completely interchangable:
+				  ;;   (reverse (cons 1 2)): (2 . 1)
+				  ;;   (reverse! (cons 1 2)): error: reverse! argument, (1 . 2), is a pair but should be a proper list
+				  (list->vector . vector->list)
+				  (vector->list . list->vector)
+				  (symbol->string . string->symbol)
+				  (string->symbol . symbol->string)
+				  (list->string . string->list)
+				  (string->list . list->string)
+				  (number->string . string->number))))
+		  (let ((inv-op (assq head inverses))
+			(arg (cadr form))
+			(arg-args (cdadr form))
+			(arg-of-arg (cadadr form))
+			(func-of-arg (caadr form)))
+		    (if (pair? inv-op) (set! inv-op (cdr inv-op)))
+
+		    (cond ((eq? func-of-arg inv-op)               ; (vector->list (list->vector x)) -> x
+			   (if (eq? head 'string->symbol)
+			       (lint-format "perhaps ~A" caller (lists->string form arg-of-arg))
+			       (lint-format "~A could be (copy ~S)" caller form arg-of-arg)))
+
+			  ((and (eq? head 'list->string)          ; (list->string (vector->list x)) -> (copy x (make-string (length x)))
+				(eq? func-of-arg 'vector->list))
+			   (lint-format "perhaps ~A" caller (lists->string form `(copy ,arg-of-arg (make-string (length ,arg-of-arg))))))
+
+			  ((and (eq? head 'list->string)          ; (list->string (make-list x y)) -> (make-string x y)
+				(eq? func-of-arg 'make-list))
+			   (lint-format "perhaps ~A" caller (lists->string form (cons 'make-string arg-args))))
+
+			  ((and (eq? head 'string->list)          ; (string->list (string x y)) -> (list x y)
+				(eq? func-of-arg 'string))
+			   (lint-format "perhaps ~A" caller (lists->string form (cons 'list arg-args))))
+
+			  ((and (eq? head 'list->vector)          ; (list->vector (make-list ...)) -> (make-vector ...)
+				(eq? func-of-arg 'make-list))
+			   (lint-format "perhaps ~A" caller (lists->string form (cons 'make-vector arg-args))))
+
+			  ((and (eq? head 'list->vector)          ; (list->vector (string->list x)) -> (copy x (make-vector (length x)))
+				(eq? func-of-arg 'string->list))
+			   (lint-format "perhaps ~A" caller (lists->string form `(copy ,arg-of-arg (make-vector (length ,arg-of-arg))))))
+
+			  ((and (eq? head 'list->vector)          ; (list->vector (append (vector->list v1) ...)) -> (append v1 ...)
+				(eq? func-of-arg 'append)
+				(lint-every? (lambda (a)
+					       (and (pair? a)
+						    (eq? (car a) 'vector->list)))
+					     (cdadr form)))
+			   (lint-format "perhaps ~A" caller
+					(lists->string form (cons 'append (map cadr (cdadr form))))))
+
+			  ((and (eq? head 'vector->list)          ; (vector->list (make-vector ...)) -> (make-list ...)
+				(eq? func-of-arg 'make-vector))
+			   (lint-format "perhaps ~A" caller (lists->string form (cons 'make-list arg-args))))
+
+			  ((and (eq? head 'vector->list)          ; (vector->list (vector ...)) -> (list ...)
+				(eq? func-of-arg 'vector))
+			   (lint-format "perhaps ~A" caller (lists->string form (cons 'list arg-args))))
+
+			  ((and (eq? head 'vector->list)          ; (vector->list (vector-copy ...)) -> (vector->list ...)
+				(eq? func-of-arg 'vector-copy))
+			   (lint-format "perhaps ~A" caller (lists->string form (cons 'vector->list arg-args))))
+
+			  ((and (memq func-of-arg '(reverse reverse! copy))
+				(len>1? arg-of-arg)                ; (list->string (reverse (string->list x))) -> (reverse x)
+				(eq? (car arg-of-arg) inv-op))
+			   (lint-format "perhaps ~A" caller (lists->string form (list (if (eq? func-of-arg 'reverse!) 'reverse func-of-arg) (cadr arg-of-arg)))))
+
+			  ((and (memq head '(reverse reverse!))   ; (reverse (string->list x)) -> (string->list (reverse x)) -- often redundant
+				(memq func-of-arg '(string->list vector->list sort!)))
+			   (cond ((not (eq? func-of-arg 'sort!))
+				  (if (null? (cdr arg-args))
+				      (lint-format "perhaps less consing: ~A" caller
+						   (lists->string form (list func-of-arg (list 'reverse arg-of-arg))))))
+				 ((and (len>1? arg-args)          ; (reverse (sort! x <)) -> (sort! x >)
+				       (hash-table-ref reversibles (cadr arg-args)))
+				  => (lambda (op)
+				       (lint-format "possibly ~A" caller (lists->string form (list 'sort! arg-of-arg op)))))))
+
+			  ((and (len>1? arg-of-arg)
+				(or (memq func-of-arg '(cdr cddr cdddr cddddr))
+				    (and (eq? func-of-arg 'list-tail)
+					 (len=2? arg-args)))
+				(case head
+				  ((list->string) (eq? (car arg-of-arg) 'string->list))
+				  ((list->vector) (eq? (car arg-of-arg) 'vector->list))
+				  (else #f)))
+			   (let ((len-diff (if (eq? func-of-arg 'list-tail)
+					       (cadr arg-args)
+					       (cdr-count func-of-arg))))
+			     (lint-format "perhaps ~A" caller     ; (list->string (cdr (string->list x))) -> (substring x 1)
+					  (lists->string form (if (eq? head 'list->string)
+								  (list 'substring (cadr arg-of-arg) len-diff)
+								  `(copy ,(cadr arg-of-arg) (make-vector (- (length ,(cadr arg-of-arg)) ,len-diff))))))))
+
+			  ((and (memq head '(list->vector list->string))
+				(eq? func-of-arg 'sort!)          ; (list->vector (sort! (vector->list x) y)) -> (sort! x y)
+				(len>1? arg-of-arg)
+				(len>1? arg-args)
+				(eq? (car arg-of-arg) (if (eq? head 'list->vector) 'vector->list 'string->list)))
+			   (lint-format "perhaps ~A" caller (lists->string form (list 'sort! (cadr arg-of-arg) (cadr arg-args)))))
+
+			  ((and (memq head '(list->vector list->string))
+				(or (memq func-of-arg '(list cons))
+				    (quoted-undotted-pair? arg)))
+			   (let ((maker (if (eq? head 'list->vector) 'vector 'string)))
+			     (case func-of-arg
+			       ((list)
+				(if (var-member maker env)    ; (list->string (list x y z)) -> (string x y z)
+				    (lint-format "~A could be simplified, but you've shadowed '~A" caller (truncated-list->string form) maker)
+				    (lint-format "perhaps ~A" caller (lists->string form (cons maker arg-args)))))
+
+			       ((cons)
+				(if (and (len>1? arg-args)
+					 (any-null? (cadr arg-args)))
+				    (if (var-member maker env) ; (list->string (cons x ())) -> (string x)
+					(lint-format "~A could be simplified, but you've shadowed '~A" caller (truncated-list->string form) maker)
+					(lint-format "perhaps ~A" caller (lists->string form (list maker arg-of-arg)))))))))
+
+			  ((and (memq head '(list->string list->vector))    ; (list->string (reverse x)) -> (reverse (apply string x))
+				(memq func-of-arg '(reverse reverse!)))
+			   (lint-format "perhaps ~A" caller (lists->string form (list 'reverse (list head arg-of-arg)))))
+
+			  ((and (eq? head 'string->symbol)        ; (string->symbol (string-append...)) -> (symbol ...)
+				(or (memq func-of-arg '(string-append append))
+				    (and (eq? func-of-arg 'apply)
+					 (memq arg-of-arg '(string-append append)))))
+			   (lint-format "perhaps ~A" caller
+					(lists->string form
+						       (if (eq? func-of-arg 'apply)
+							   (cons 'apply (cons 'symbol (cdr arg-args)))
+							   (cons 'symbol arg-args)))))
+
+			  ((and (eq? head 'string->symbol)        ; (string->symbol (if (not (null? x)) x "abc")) -> (if (not (null? x)) (string->symbol x) 'abc)
+				(eq? func-of-arg 'if)
+				(len>2? arg-args)
+				(or (string? (cadr arg-args))
+				    (string? (caddr arg-args)))
+				(not (or (equal? (cadr arg-args) "")  ; this is actually an error -- should we complain?
+					 (equal? (caddr arg-args) ""))))
+			   (lint-format "perhaps ~A" caller
+					(lists->string form
+						       (if (string? (cadr arg-args))
+							   (if (string? (caddr arg-args))
+							       `(if ,arg-of-arg ',(string->symbol (cadr arg-args)) ',(string->symbol (caddr arg-args)))
+							       `(if ,arg-of-arg ',(string->symbol (cadr arg-args)) (string->symbol ,(caddr arg-args))))
+							   `(if ,arg-of-arg (string->symbol ,(cadr arg-args)) ',(string->symbol (caddr arg-args)))))))
+
+			  ((case head                             ; (reverse (reverse! x)) could be (copy x)
+			     ((reverse) (eq? func-of-arg 'reverse!))
+			     ((reverse!) (eq? func-of-arg 'reverse))
+			     (else #f))
+			   (lint-format "~A could be (copy ~S)" caller form arg-of-arg))
+
+			  ((and (len>1? arg-of-arg)                ; (op (reverse (inv-op x))) -> (reverse x)
+				(eq? func-of-arg 'reverse)
+				(eq? inv-op (car arg-of-arg)))
+			   (lint-format "perhaps ~A" caller (lists->string form (list 'reverse (cadr arg-of-arg)))))))))
+
+	      (when (pair? (cddr form))                           ; (string->list x y y) is ()
+		(when (and (memq head '(vector->list string->list))
+			   (pair? (cdddr form)))
+		  (check-start-and-end caller head (cddr form) form env))
+
+		(when (and (eq? head 'number->string)             ; (number->string saturation 10)
+			   (eqv? (caddr form) 10))
+		  (lint-format "10 is the default radix for number->string: ~A" caller (truncated-list->string form))))
+
+	      (when (memq head '(reverse reverse!))
+		(if (eq? head 'reverse!)
+		    (if (symbol? (cadr form))
+			(let ((v (var-member (cadr form) env)))
+			  (if (and v
+				   (eq? (var-definer v) 'parameter))
+			      (lint-format "if ~A (a function argument) is a pair, ~A is ill-advised" caller
+					   (cadr form)
+					   (truncated-list->string form))))
+			(if (code-constant? (cadr form))
+			    (lint-format "~A is a constant, so ~A is problematic" caller
+					   (cadr form)
+					   (truncated-list->string form)))))
+
+		(when (pair? (cadr form))
+		  (let ((arg (cadr form))
+			(arg-op (caadr form))
+			(arg-args (cdadr form))
+			(arg-arg (and (pair? (cdadr form)) (cadadr form))))
+		    (when (and (pair? arg-args)
+			       (pair? arg-arg))
+		      (if (and (case arg-op
+				 ((cdr)       (len=1? arg-args))  ; (reverse (cdr (reverse lst))) = all but last of lst -> copy to len-1
+				 ((list-tail) (len=2? arg-args))
+				 (else #f))
+			       (memq (car arg-arg) '(reverse reverse!))
+			       (pair? (cdr arg-arg))
+			       (symbol? (cadr arg-arg)))
+			  (lint-format "perhaps ~A" caller
+				       (lists->string form `(copy ,(cadr arg-arg)
+								  (make-list (- (length ,(cadr arg-arg)) ,(if (eq? arg-op 'cdr) 1 (cadr arg-args))))))))
+
+		      (if (and (eq? arg-op 'append)           ; (reverse (append (reverse b) res)) = (append (reverse res) b)
+			       (eq? (car arg-arg) 'reverse)
+			       (len=1? (cdr arg-args)))
+			  (lint-format "perhaps ~A" caller (lists->string form `(append (reverse ,(cadr arg-args)) ,(cadr arg-arg))))))
+
+		    (when (and (= (length arg) 3)
+			       (pair? (cadr arg-args)))
+		      (cond ((and (eq? arg-op 'map)              ; (reverse (map abs (sort! x <))) -> (map abs (sort! x >))
+				  (eq? (caadr arg-args) 'sort!)
+				  (len=2? (cdadr arg-args))
+				  (hash-table-ref reversibles (caddr (cadr arg-args))))
+			     => (lambda (op)
+				  (lint-format "possibly ~A" caller (lists->string form `(,arg-op ,arg-arg (sort! ,(cadadr arg-args) ,op)))))))
+		      ;; (reverse (apply vector (sort! x <))) doesn't happen (nor does this map case, but it's too pretty to leave out)
+
+		      (if (and (eq? arg-op 'cons)             ; (reverse (cons x (reverse lst))) -- adds x to end -- (append lst (list x))
+			       (memq (caadr arg-args) '(reverse reverse!))
+			       (len=1? (cdadr arg-args)))
+			  (lint-format "perhaps ~A" caller (lists->string form `(append ,(cadadr arg-args) (list ,arg-arg)))))))))))
+
+	  (for-each (lambda (f)
+		      (hash-special f sp-reverse))
+		    '(reverse reverse! list->vector vector->list list->string string->list symbol->string string->symbol number->string)))
+
+	;; ---------------- char->integer string->number etc ----------------
+	(let ()
+	  (define (sp-char->integer caller head form env)
+	    ;(format *stderr* "c->i ~S~%" form)
+	    (when (pair? (cdr form))
+	      (let ((inverses '((char->integer . integer->char)
+				(integer->char . char->integer)
+				(symbol->keyword . keyword->symbol)
+				(keyword->symbol . symbol->keyword)
+				(string->number . number->string)))
+		    (arg (cadr form)))
+		(if (and (len>1? arg)                       ;  (string->number (number->string x)) could be x
+			 (eq? (car arg) (cond ((assq head inverses) => cdr))))
+		    (lint-format "~A could be ~A" caller (truncated-list->string form) (cadr arg))
+		    (case head
+		      ((integer->char)
+		       (if (let walk ((tree (cdr form)))
+			     (if (pair? tree)
+				 (and (walk (car tree))
+				      (walk (cdr tree)))
+				 (or (code-constant? tree)
+				     (not (side-effect? tree env)))))
+			   (let ((chr (checked-eval form)))  ; (integer->char (+ (char->integer #\space) 215)) -> #\xf7
+			     (if (char? chr)
+				 (lint-format "perhaps ~A" caller (lists->string form chr))))))
+
+		      ((char->integer)
+		       (if (and (pair? arg)
+				(memq (car arg) '(read read-char)))
+			   (lint-format "perhaps ~A" caller (lists->string form (cons 'read-byte (cdr arg))))))
+
+		      ((string->number)
+		       (if (and (pair? (cddr form))
+				(integer? (caddr form)) ; type error is checked elsewhere
+				(not (<= 2 (caddr form) 16)))  ;  (string->number "123" 21)
+			   (lint-format "string->number radix should be between 2 and 16: ~A" caller form)
+			   (if (and (len=2? arg)
+				    (eq? (car arg) 'string)
+				    (null? (cddr form)))  ; (string->number (string num-char)) -> (- (char->integer num-char) (char->integer #\0))
+			       (lint-format "perhaps ~A" caller
+					    (lists->string form `(- (char->integer ,(cadr arg)) (char->integer #\0)))))))
+
+		      ((symbol->keyword)
+		       (if (and (len>1? arg)             ;  (symbol->keyword (string->symbol x)) -> (string->keyword x)
+				(eq? (car arg) 'string->symbol))
+			   (lint-format "perhaps ~A" caller (lists->string form (list 'string->keyword (cadr arg))))
+			   (if (quoted-symbol? arg)
+			       (lint-format "perhaps ~A" caller (lists->string form (symbol->keyword (cadr arg)))))))
+
+		      ((keyword->symbol)
+		       (if (and (len>1? arg)
+				(eq? (car arg) 'string->keyword))
+			   (lint-format "perhaps ~A" caller (lists->string form (list 'string->symbol (cadr arg))))
+			   (if (keyword? arg)
+			       (lint-format "perhaps ~A -> '~A" caller (object->string form) (object->string (keyword->symbol arg)))))))))))
+
+	  (for-each (lambda (f)
+		      (hash-special f sp-char->integer))
+		    '(char->integer integer->char symbol->keyword keyword->symbol string->number)))
+
+	;; ---------------- symbol ----------------
+	(let ()
+	  (define (sp-symbol caller head form env)
+	    (when (pair? (cdr form))
+
+	      (if (just-code-constants? (cdr form))           ; (symbol "a") -> 'a
+		  (let ((seq (checked-eval form)))
+		    (if (and (not (eq? seq :checked-eval-error))
+			     (not (char=? (string-ref (object->string seq :readable) 0) #\()))   ; (symbol "a b") turns into itself
+			(lint-format "perhaps ~A -> ~A~A" caller
+				     (truncated-list->string form)
+				     (if (pair? seq) "'" "")
+				     (if (symbol? seq)
+					 (object->string seq :readable)
+					 (object->string seq))))))
+
+	      (when (and (null? (cddr form))                  ; (symbol (string-append a b)) -> (symbol a b)
+			 (pair? (cadr form))
+			 (or (memq (caadr form) '(string-append append))
+			     (and (eq? (caadr form) 'apply)
+				  (memq (cadadr form) '(string-append append)))))
+		(lint-format "perhaps ~A" caller
+			     (lists->string form
+					    (if (eq? (caadr form) 'apply)
+						(cons 'apply (cons 'symbol (cddadr form)))
+						(cons 'symbol (cdadr form))))))))
+	  (hash-special 'symbol sp-symbol))
+
+	;; ---------------- string->keyword ----------------
+	(let ()
+	  (define (sp-str->key caller head form env)
+	    (if (and (pair? (cdr form))
+		     (len>1? (cadr form)))
+		(if (eq? (caadr form) 'symbol->string)
+		    (lint-format "perhaps ~A" caller (lists->string form (list 'symbol->keyword (cadadr form))))
+		    (if (and (memq (caadr form) '(string-append append))
+			     (string? (cadadr form))
+			     (> (length (cadadr form)) 0)
+			     (eqv? ((cadadr form) 0) #\:))
+			(lint-format "string->keyword prepends #\\: for you: ~A" caller form)))))
+	  (hash-special 'string->keyword sp-str->key))
+
+	;; ---------------- string-append ----------------
+	(let ()
+	  (define (sp-string-append caller head form env)
+	    (unless (= line-number last-checker-line-number)
+	      (let ((args (remove-all "" (splice-if 'string-append (cdr form))))
+		    (combined #f))
+		(when (lint-any? (lambda (s)
+				   (or (string? s)
+				       (and (pair? s)
+					    (memq (car s) '(string apply)))))
+				 args)
+		  (do ((nargs ())               ; look for (string...) (string...) in the arg list and combine
+		       (p args (cdr p)))
+		      ((null? p)
+		       (set! args (reverse nargs)))
+		    (let ((arg (car p)))
+		      (cond ((and (len=3? arg)            ; (string-append (apply string-append strs) str) -> (string-append (apply values strs) str)
+				  (eq? (car arg) 'apply)  ;    unfortunately the values version is only slightly faster
+				  (eq? (cadr arg) 'string-append))
+			     (set! nargs (cons (list 'apply 'values (caddr arg)) nargs)))
+
+			    ((not (pair? (cdr p)))
+			     (set! nargs (cons arg nargs)))
+
+			    ((and (pair? arg)
+				  (eq? (car arg) 'string)
+				  (pair? (cadr p))
+				  (eq? (caadr p) 'string))
+			     (set! nargs (cons (cons 'string (append (cdr arg) (cdadr p))) nargs))
+			     (set! combined #t)
+			     (set! p (cdr p)))
+
+			    ((and (string? arg)
+				  (string? (cadr p)))
+			     (set! nargs (cons (string-append arg (cadr p)) nargs))
+			     (set! combined #t)
+			     (set! p (cdr p)))
+
+			    (else (set! nargs (cons (car p) nargs)))))))
+
+		;; (if ... "" ...) as arg split out got a couple dozen hits but we still need copy for the "" branch, so it's not much better
+
+		(cond ((null? args)                 ; (string-append) -> ""
+		       (lint-format "perhaps ~A" caller (lists->string form "")))
+
+		      ((null? (cdr args))           ; (string-append a) -> a
+		       (if (not (lint-tree-memq 'values (cdr form)))
+			   (lint-format "perhaps ~A~A" caller (lists->string form (car args))
+					(if combined "" ", or use copy")))) ; (string-append x "") appears to be a common substitute for string-copy
+
+		      ((lint-every? string? args)        ; (string-append "a" "b") -> "ab"
+		       (lint-format "perhaps ~A" caller (lists->string form (apply string-append args))))
+
+		      ((lint-every? (lambda (a)          ; (string-append "a" (string #\b)) -> "ab"
+				      (or (string? a)
+					  (and (pair? a)
+					       (eq? (car a) 'string)
+					       (or (null? (cdr a))
+						   (char? (cadr a))))))
+				    args)
+		       (catch #t
+			 (lambda ()                 ; (string-append (string #\C) "ZLl*()def") -> "CZLl*()def"
+			   (let ((val (if (not (any-pairs? args))
+					  (apply string-append args)
+					  (eval (cons 'string-append args)))))
+			     (lint-format "perhaps ~A -> ~S" caller (truncated-list->string form) val)))
+			 (lambda args #f)))
+
+		      ((lint-every? (lambda (c)          ; (string-append (make-string 3 #\a) (make-string 2 #\b)) -> (format #f "~NC~NC" 3 #\a 2 #\b)
+				      (and (len>2? c)
+					   (eq? (car c) 'make-string)))
+				    (cdr form))
+		       (lint-format "perhaps ~A" caller
+				    (lists->string form
+						   `(format #f ,(apply string-append (make-list (abs (length (cdr form))) "~NC"))
+							    ,@(map (lambda (c) (values (cadr c) (caddr c))) (cdr form))))))
+
+		      ((not (equal? args (cdr form)))  ; (string-append x (string-append y z)) -> (string-append x y z)
+		       (lint-format "perhaps ~A" caller (lists->string form (cons 'string-append args)))))
+		(set! last-checker-line-number line-number))))
+	  (hash-special 'string-append sp-string-append))
+
+	;; ---------------- vector-append ----------------
+	(let ()
+	  (define (sp-vector-append caller head form env)
+	    (unless (= line-number last-checker-line-number)
+	      (let ((args (map (lambda (v)
+				 (if (and (len=3? v)
+					  (eq? (car v) 'apply)
+					  (eq? (cadr v) 'vector-append))
+				     (list 'apply 'values (caddr v))
+				     v))
+			       (remove-all #() (splice-if 'vector-append (cdr form))))))
+		(cond ((null? args)                    ;  (vector-append) -> #()
+		       (lint-format "perhaps ~A" caller (lists->string form #())))
+
+		      ((null? (cdr args))              ; (vector-append x) -> (copy x)
+		       (lint-format "perhaps ~A" caller (lists->string form (list 'copy (car args)))))
+
+		      ((lint-every? vector? args)           ;  (vector-append #(1 2) (vector-append #(3))) -> #(1 2 3)
+		       (lint-format "perhaps ~A" caller (lists->string form (apply vector-append args))))
+
+		      ((not (equal? args (cdr form)))  ; (vector-append x (vector-append y z)) -> (vector-append x y z)
+		       (lint-format "perhaps ~A" caller (lists->string form (cons 'vector-append args)))))
+		(set! last-checker-line-number line-number))))
+	  (hash-special 'vector-append sp-vector-append))
+
+	;; ---------------- cons ----------------
+	(let ()
+	  (define (sp-cons caller head form env)
+	    (when (and (= (length form) 3)
+		       (not (= last-cons-line-number line-number)))
+	      (if (any-null? (caddr form))                  ; (cons x '()) -> (list x)
+		  (lint-format "perhaps ~A" caller (lists->string form (list 'list (cadr form))))
+
+		  (when (pair? (caddr form))
+		    (let ((op (caaddr form)))
+
+		      (cond ((or (eq? op 'list)         ; (cons x (list ...)) -> (list x ...)
+				 (and (memq op '(list-values #_list-values))
+				      (not (lint-tree-set-memq '(apply-values #_apply-values) (cdaddr form)))))
+			     (lint-format "perhaps ~A" caller (lists->string form (cons 'list (cons (cadr form) (unlist-values (cdaddr form)))))))
+
+			    ((and (pair? (cadr form))                   ; (cons (car x) (cdr x)) -> (copy x)
+				  (let ((x (assq (caadr form)           ;    but if cdr is a pair, copy is more expensive and slightly different
+						 '((car cdr #t)
+						   (caar cdar car) (cadr cddr cdr)
+						   (caaar cdaar caar) (caadr cdadr cadr) (caddr cdddr cddr) (cadar cddar cdar)
+						   (cadddr cddddr cdddr) (caaaar cdaaar caaar) (caaadr cdaadr caadr) (caadar cdadar cadar)
+						   (caaddr cdaddr caddr) (cadaar cddaar cdaar) (cadadr cddadr cdadr) (caddar cdddar cddar)))))
+				    (and x
+					 (eq? (cadr x) op)
+					 (caddr x))))
+			     => (lambda (cfunc)
+				  (if (and cfunc
+					   (equal? (cadadr form) (cadr (caddr form)))
+					   (not (side-effect? (cadadr form) env)))
+				      (lint-format "possibly ~A" caller
+						   (lists->string form
+								  (list 'copy
+									(if (symbol? cfunc)
+									    (list cfunc (cadadr form))
+									    (cadadr form))))))))
+			    (else
+			     (case op
+			       ((cons)   ; list handled above
+					; (cons a (cons b (cons ...))) -> (list a b ...), input ending in nil of course
+				(let loop ((args (list (cadr form))) (chain (caddr form)))
+				  (if (pair? chain)
+				      (if (eq? (car chain) 'list)
+					  (begin
+					    (lint-format "perhaps ~A" caller
+							 (lists->string form
+									(cons 'list (append (reverse args) (cdr chain)))))
+					    (set! last-cons-line-number line-number))
+					  (if (and (eq? (car chain) 'cons)
+						   (len>1? (cdr chain)))
+					      (if (any-null? (caddr chain))
+						  (begin
+						    (lint-format "perhaps ~A" caller (lists->string form `(list ,@(reverse args) ,(cadr chain))))
+						    (set! last-cons-line-number line-number))
+						  (if (and (pair? (caddr chain))
+							   (memq (caaddr chain) '(cons list)))
+						      (loop (cons (cadr chain) args) (caddr chain)))))))))
+
+			       ((else)
+				(lint-format "else (as car of second argument to cons) makes no sense: ~A" caller form))))))))))
+
+	  (hash-special 'cons sp-cons))
+
+	;; ---------------- append ----------------
+	(let ()
+	  (define (append->list . items)
+	    (let ((lst (list 'list)))
+	      (for-each
+	       (lambda (item)
+		 (set! lst (append lst (if (eq? (car item) 'list)
+					   (cdr item)
+					   ((if (eq? (car item) 'cons) list distribute-quote)
+					    (cadr item))))))
+	       items)
+	      lst))
+
+	  (define (transform-append form)
+	    (let ((len1 (- (length form) 1))
+		  (args (cdr form)))
+	      (case len1
+		((0) ())
+		((1) (car args))
+		((2)
+		 (let ((arg2 (cadr args))
+		       (arg1 (car args)))
+		   (cond ((or (any-null? arg2)
+			      (equal? arg2 '(list)))
+			  (list 'copy arg1))
+
+			 ((null? arg1)
+			  arg2)
+
+			 ((not (pair? arg1))
+			  form)
+
+			 ((and (pair? arg2)
+			       (or (eq? (car arg1) 'list)
+				   (and (eq? (car arg1) 'cons)
+					(any-null? (caddr arg1)))
+				   (quoted-undotted-pair? arg1))
+			       (or (eq? (car arg2) 'list)
+				   (and (eq? (car arg2) 'cons)
+					(len>1? (cdr arg2))
+					(any-null? (caddr arg2)))
+				   (quoted-undotted-pair? arg2)))
+			  (apply append->list args))
+
+			 ((and (eq? (car arg1) 'list)
+			       (len=1? (cdr arg1)))
+			  (list 'cons (cadr arg1) arg2))
+
+			 ((eq? (car arg1) 'cons)
+			  (if (any-null? (caddr arg1))
+			      (list 'cons (cadr arg1) arg2)
+			      (let ((cargs `(append ,(caddr arg1) ,arg2)))
+				`(cons ,(cadr arg1) ,cargs))))
+
+			 ((and (eq? (car arg1) 'list)
+			       (len=2? (cdr arg1)))
+			  `(cons ,(cadr arg1) (cons ,(caddr arg1) ,arg2)))
+
+			 ((and (quoted-pair? arg1)
+			       (null? (cdadr arg1)))
+			  (if (or (symbol? (caadr arg1))
+				  (pair? (caadr arg1)))
+			      `(cons ',(caadr arg1) ,arg2)
+			      (list 'cons (caadr arg1) arg2)))
+
+			 ((not (equal? (cdr form) args))
+			  (cons 'append args))
+
+			 (else form))))
+
+		      (else
+		       (cond ((lint-every? (lambda (item)
+					     (and (pair? item)
+						  (or (eq? (car item) 'list)
+						      (and (eq? (car item) 'cons)
+							   (len>1? (cdr item))
+							   (any-null? (caddr item)))
+						      (quoted-undotted-pair? item))))
+					   args)
+			      (apply append->list args))
+
+			     ((and (len=2? (car args))
+				   (eq? (caar args) 'list))
+			      (let ((cargs (transform-append `(append ,@(cdr args)))))
+			      `(cons ,(cadar args) ,cargs)))
+
+			     ((and (pair? (car args))
+				   (eq? (caar args) 'cons))
+			      (let ((cargs `(append ,(caddar args) ,@(cdr args))))
+				`(cons ,(cadar args) ,cargs)))
+
+			     ((let ((n-1 (list-ref args (- len1 2))))
+				(and (len=2? n-1)
+				     (eq? (car n-1) 'list)))
+			      `(append ,@(copy args (make-list (- len1 2)))
+				       (cons ,(cadr (list-ref args (- len1 2)))
+					     ,(list-ref args (- len1 1)))))
+
+			     ((not (equal? (cdr form) args))
+			      (cons 'append args))
+
+			     (else form))))))
+
+	  (define (sp-append caller head form env)
+	    (unless (= line-number last-checker-line-number)
+	      (set! last-checker-line-number line-number)
+	      (letrec ((splice-append (lambda (lst)
+					(cond ((null? lst)
+					       ())
+
+					      ((not (pair? lst))
+					       lst)
+
+					      ((and (pair? (car lst))
+						    (eq? (caar lst) 'append)
+						    (proper-list? (cdar lst))) ; for append below
+					       (if (null? (cdar lst))          ; (append) at end -> () to keep copy intact?
+						   (case (cdr lst) ((()) => list) (else => splice-append))
+						   (append (splice-append (cdar lst))
+							   (splice-append (cdr lst)))))
+
+					      ((and (len=2? (car lst))
+						    (eq? (caar lst) 'copy)
+						    (pair? (cdr lst)))
+					       (cons (cadar lst) (splice-append (cdr lst))))
+
+					      ((and (len=3? (car lst))   ; (append (apply append x)...) -> (append (apply values x)...)
+						    (eq? (caar lst) 'apply)
+						    (memq (cadar lst) '(append string-append vector-append)))
+					       (cons (list 'apply 'values (caddar lst))
+						     (splice-append (cdr lst))))
+
+					      ((or (null? (cdr lst))
+						   (not (or (any-null? (car lst))
+							    (and (len=1? (car lst))
+								 (eq? (caar lst) 'list)))))
+					       (cons (car lst)
+						     (splice-append (cdr lst))))
+
+					      (else (splice-append (cdr lst)))))))
+
+		(let ((new-args (splice-append (cdr form))))     ; (append '(1) (append '(2) '(3))) -> (append '(1) '(2) '(3))
+		  (let ((len1 (length new-args))
+			(suggestion made-suggestion))
+
+		    (when (and (> len1 2)
+			       (null? (list-ref new-args (- len1 1)))
+			       (pair? (list-ref new-args (- len1 2)))
+			       (memq (car (list-ref new-args (- len1 2))) '(list cons append map string->list vector->list make-list)))
+		      (set-cdr! (list-tail new-args (- len1 2)) ())
+		      (set! len1 (- len1 1)))
+
+		    (if (positive? len1)
+			(let ((last (list-ref new-args (- len1 1))))
+			  ;; (define (f) (append '(1) '(2))) (define a (f)) (set! (a 1) 32) (f) -> '(1 32)
+			  (if (quoted-pair? last)
+			      (lint-format "append does not copy its last argument, so ~A is dangerous" caller
+					   (truncated-list->string form)))))
+
+		    (case len1
+		      ((0)					        ; (append) -> ()
+		       (lint-format "perhaps ~A" caller (lists->string form ())))
+		      ((1)                                               ; (append x) -> x
+		       (lint-format "perhaps ~A" caller (lists->string form (car new-args))))
+		      ((2)                                               ; (append (list x) ()) -> (list x)
+		       (let ((arg2 (cadr new-args))
+			     (arg1 (car new-args)))
+
+			 (cond ((or (any-null? arg2)
+				    (member arg2 '((list) "" (string) #() (vector)))) ; (append '(1 2) ()) -> (copy '(1 2)), #() includes #i() et al
+				(lint-format "perhaps clearer: ~A" caller (lists->string form (list 'copy arg1))))
+
+			       ((null? arg1)                             ; (append () x) -> x
+				(lint-format "perhaps ~A" caller (lists->string form arg2)))
+
+			       ((not (pair? arg1)))
+
+			       ((and (pair? arg2)                        ; (append (list x y) '(z)) -> (list x y z) or extensions thereof
+				     (or (eq? (car arg1) 'list)
+					 (and (eq? (car arg1) 'cons)
+					      (any-null? (caddr arg1)))
+					 (quoted-undotted-pair? arg1))
+				     (or (eq? (car arg2) 'list)
+					 (and (eq? (car arg2) 'cons)
+					      (len>1? (cdr arg2))
+					      (any-null? (caddr arg2)))
+					 (quoted-undotted-pair? arg2)))
+				(lint-format "perhaps ~A" caller (lists->string form (apply append->list new-args))))
+
+			       ((and (eq? (car arg1) 'list)              ; (append (list x) y) -> (cons x y)
+				     (len=1? (cdr arg1)))
+				(lint-format "perhaps ~A" caller (lists->string form (list 'cons (cadr arg1) arg2))))
+
+			       ((eq? (car arg1) 'cons)                   ; (append (cons x y) z) -> (cons x z) or (cons z (append y z))
+				(lint-format "perhaps ~A" caller         ;    append insists on proper lists, so this should be equivalent
+					     (lists->string form
+							    (if (any-null? (caddr arg1))
+								(list 'cons (cadr arg1) arg2)
+								`(cons ,(cadr arg1) (append ,(caddr arg1) ,arg2))))))
+
+			       ((and (eq? (car arg1) 'list)              ; (append (list x y) z) -> (cons x (cons y z))
+				     (len=2? (cdr arg1)))
+				(lint-format "perhaps ~A" caller (lists->string form `(cons ,(cadr arg1) (cons ,(caddr arg1) ,arg2)))))
+
+			       ;; not sure about this: reports the un-qq'd form
+			       ((and (memq (car arg1) '(list-values #_list-values))
+				     (not (qq-tree? arg1)))
+				(set! last-checker-line-number -1)
+				(sp-append caller 'append (list 'append (unlist-values arg1) arg2) env))
+
+			       ((and (eq? (car arg1) 'vector->list)
+				     (pair? arg2)
+				     (eq? (car arg2) 'vector->list))
+				(lint-format "perhaps ~A" caller (lists->string form (list 'vector->list (list 'append (cadr arg1) (cadr arg2))))))
+
+			       ((and (quoted-pair? arg1)                 ; (append '(x) y) -> (cons 'x y)
+				     (null? (cdadr arg1)))
+				(lint-format "perhaps ~A" caller
+					     (lists->string form
+							    (if (or (symbol? (caadr arg1))
+								    (pair? (caadr arg1)))
+								`(cons ',(caadr arg1) ,arg2)
+								(list 'cons (caadr arg1) arg2)))))
+
+			       ((not (equal? (cdr form) new-args))      ; (append () '(1 2) 1) -> (append '(1 2) 1)
+				(lint-format "perhaps ~A" caller (lists->string form (cons 'append new-args)))))))
+		      (else
+		       (cond ((lint-every? (lambda (item)
+					     (and (pair? item)
+						  (or (eq? (car item) 'list)
+						      (and (eq? (car item) 'cons)
+							   (len>1? (cdr item))
+							   (any-null? (caddr item)))
+						      (quoted-undotted-pair? item))))
+					   new-args)                         ; (append '(1) (append '(2) '(3)) '(4)) -> (list 1 2 3 4)
+			      (lint-format "perhaps ~A" caller (lists->string form (apply append->list new-args))))
+
+			     ((and (len=2? (car new-args))               ; (append (list x) y (list z)) -> (cons x (append y (list z)))?
+				   (eq? (caar new-args) 'list))
+			      (let ((cargs (transform-append `(append ,@(cdr new-args)))))
+				(lint-format "perhaps ~A" caller (lists->string form `(cons ,(cadar new-args) ,cargs)))))
+
+			     ((and (pair? (car new-args))
+				   (eq? (caar new-args) 'cons))
+			      (let ((cargs (transform-append `(append ,(caddar new-args) ,@(cdr new-args)))))
+				(lint-format "perhaps ~A" caller
+					     (lists->string form `(cons ,(cadar new-args) ,cargs)))))
+
+			     ((let ((n-1 (list-ref new-args (- len1 2))))
+				(and (len=2? n-1)
+				     (eq? (car n-1) 'list)))            ; (append x (list y) z) -> (append x (cons y z))
+			      (lint-format "perhaps ~A" caller
+					   (lists->string form
+							  `(append ,@(copy new-args (make-list (- len1 2)))
+								   (cons ,(cadr (list-ref new-args (- len1 2)))
+									 ,(list-ref new-args (- len1 1)))))))
+
+			     ((not (equal? (cdr form) new-args))        ; (append x y (append)) -> (append x y ())
+			      (lint-format "perhaps ~A" caller (lists->string form (cons 'append new-args)))))))
+
+		    (if (and (= made-suggestion suggestion)
+			     (not (equal? (cdr form) new-args)))
+			(lint-format "perhaps ~A" caller (lists->string form (cons 'append new-args)))))))))
+	  (hash-special 'append sp-append)
+	  (hash-special '#<list*> sp-append)
+	  )
+
+	;; ---------------- apply ----------------
+	(let ()
+	  (define (sp-apply caller head form env)
+	    (when (pair? (cdr form))
+	      (let ((len (length form))
+		    (suggestion made-suggestion))
+		(if (= len 2)                ; (apply f) -> (f)
+		    (lint-format "perhaps ~A" caller (lists->string form (list (cadr form))))
+		    (if (not (or (<= len 2) ; it might be (apply)...
+				 (symbol? (cadr form))
+				 (applicable? (cadr form))))
+			(lint-format "~S is not applicable: ~A" caller (cadr form) (truncated-list->string form))
+			(let ((f (cadr form)))
+			  (unless (or (<= len 2)
+				      (any-macro? f env)
+				      (eq? f 'macroexpand)) ; handled specially (syntactic, not a macro)
+
+			    (when (and (symbol? f)
+				       (not (var-member f env)))
+			      (let ((func (symbol->value f *e*)))
+				(if (procedure? func)
+				    (let ((ary (arity func)))
+				      (when (pair? ary)             ; (apply real? 1 3 rest)
+					(if (> (- len 3) (cdr ary)) ; last apply arg might be var=()
+					    (lint-format "too many arguments for ~A: ~A" caller f form))
+					(if (and (= len 3)
+						 (= (car ary) 1)
+						 (= (cdr ary) 1))   ; (apply car x) -> (car (car x))
+					    (lint-format "perhaps ~A" caller (lists->string form (list f (list 'car (caddr form)))))))))))
+
+			    (let ((happy #f)
+				  (last-arg (form (- len 1))))
+			      (if (and (not (list? last-arg))
+				       (code-constant? last-arg))   ; (apply + 1)
+				  (lint-format "last argument should be a list: ~A" caller (truncated-list->string form))
+				  (if (= len 3)
+				      (let ((args (caddr form))
+					    (cdr-args (and (pair? (caddr form)) (cdaddr form))))
+					(if (identity? f)                         ; (apply (lambda (x) x) y) -> (car y)
+					    (lint-format "perhaps (assuming ~A is a list of one element) ~A" caller args
+							 (lists->string form (list 'car args)))
+					    (if (simple-lambda? f)                ; (apply (lambda (x) (f x)) y) -> (f (car y))
+						(lint-format "perhaps (assuming ~A is a list of one element) ~A" caller args
+							     (lists->string form (tree-subst (list 'car args) (caadr f) (caddr f))))))
+
+					(cond ((eq? f 'list)                      ; (apply list x) -> x?
+					       (lint-format "perhaps ~A" caller (lists->string form args)))
+
+					      ((any-null? args)                   ; (apply f ()) -> (f)
+					       (lint-format "perhaps ~A" caller (lists->string form (list f))))
+
+					      ((or (not (pair? args))
+						   (case (car args)
+						     ((list)             ; (apply f (list a b)) -> (f a b)
+						      (lint-format "perhaps ~A" caller (lists->string form (cons f cdr-args))))
+
+						     ((quote #_quote)    ; (apply eq? '(a b)) -> (eq? 'a 'b)
+						      (and (pair? cdr-args)
+							   (pair? (car cdr-args))
+							   (lint-format "perhaps ~A" caller
+									(lists->string form (cons f (distribute-quote (car cdr-args)))))))
+
+						     ((cons cons*)             ; (apply f (cons a b)) -> (apply f a b)
+						      (lint-format "perhaps ~A" caller
+								   (lists->string form
+										  (if (and (len>1? cdr-args)
+											   (len>1? (cadr cdr-args))
+											   (eq? (caadr cdr-args) 'cons))
+										      `(apply ,f ,(car cdr-args) ,@(cdadr cdr-args))
+										      (cons 'apply (cons f cdr-args))))))
+
+						     ((append)           ; (apply f (append (list ...)...)) -> (apply f ... ...)
+						      (and (pair? cdr-args)
+							   (pair? (car cdr-args))
+							   (eq? (caar cdr-args) 'list)
+							   (lint-format "perhaps ~A" caller
+									(lists->string form `(apply ,f ,@(cdar cdr-args)
+												    ,(if (not (pair? (cdr cdr-args)))
+													 (cdr cdr-args)
+													 (if (null? (cddr cdr-args))
+													     (cadr cdr-args)
+													     (cons 'append (cdr cdr-args)))))))))
+
+						     ((reverse reverse!)   ; (apply vector (reverse x)) -> (reverse (apply vector x))
+						      (and (memq f '(string vector int-vector float-vector))
+							   (pair? cdr-args)
+							   (lint-format "perhaps ~A" caller
+									(lists->string form (list 'reverse (list 'apply f (car cdr-args)))))))
+
+						     ((make-list)          ; (apply string (make-list x y)) -> (make-string x y)
+						      (if (memq f '(string vector))
+							  (lint-format "perhaps ~A" caller
+								       (lists->string form
+										      (cons (if (eq? f 'string) 'make-string 'make-vector)
+											    cdr-args)))))
+
+						     ((map)
+						      (case f
+							((string-append)        ; (apply string-append (map ...))
+							 (if (eq? (car cdr-args) 'symbol->string)
+							     (lint-format "perhaps ~A" caller ; (apply string-append (map symbol->string ...))
+									  (lists->string form (list 'format #f "~{~A~}" (cadr cdr-args))))
+							     (if (simple-lambda? (car cdr-args))
+								 (let ((body (caddar cdr-args)))
+								   (if (and (len=3? body)
+									    (eq? (car body) 'string-append)
+									    (or (and (string? (cadr body))
+										     (eq? (caddr body) (caadar cdr-args)))
+										(and (string? (caddr body))
+										     (eq? (cadr body) (caadar cdr-args)))))
+								       (let ((str (string-append "~{"
+												 (if (string? (cadr body)) (cadr body) "~A")
+												 (if (string? (caddr body)) (caddr body) "~A")
+												 "~}")))
+									 (lint-format "perhaps ~A" caller
+										      (lists->string form (list 'format #f str (cadr cdr-args))))))))))
+
+							((string)          ; (apply string (map char-downcase x)) -> (string-downcase (apply string x))
+							 (if (memq (car cdr-args) '(char-upcase char-downcase))
+							     (lint-format "perhaps, assuming ~A is a list, ~A" caller (cadr cdr-args)
+									  (lists->string form (list (if (eq? (car cdr-args) 'char-upcase)
+													'string-upcase 'string-downcase)
+												    (list 'apply string (cadr cdr-args)))))))
+
+							((append)        ; (apply append (map vector->list args)) -> (vector->list (apply append args))
+							 (case (car cdr-args)
+							   ((vector->list)
+							    (lint-format "perhaps ~A" caller (lists->string form `(vector->list (apply append ,@(cdr cdr-args))))))
+							   ((list)       ; (apply append (map list args)) -> args
+							    (lint-format "perhaps ~A" caller (lists->string form (cadr cdr-args))))))
+
+							(else #f)))
+						     ;; (apply append (map f ...)) is very common but changing it to
+						     ;;     (map (lambda (x) (apply values (f x))) ...)
+						     ;;     is not an obvious win.  The code is more complicated, and currently apply values
+						     ;;     copies its args as do apply and append -- how many copies are there here?!
+						     ;; cursory timing tests indicate that (apply append ...) is faster
+
+						     ;; need to check for only one apply values
+						     ((list-values #_list-values)          ; (apply f `(,x ,@z)) -> (apply f x z)
+						      (let ((last-arg (last-ref args)))
+							(if (and (pair? last-arg)
+								 (memq (car last-arg) '(apply-values #_apply-values))
+								 (or (= (tree-count 'apply-values args 2) 1)
+								     (= (tree-count #_apply-values args 2) 1)))
+							    (lint-format "perhaps ~A" caller
+									 (lists->string form
+											`(apply ,f
+												,@(copy args (make-list (- (length args) 2)) 1)
+												,(cadr last-arg))))
+							    (if (not (lint-tree-set-memq '(append apply-values #_apply-values) cdr-args))
+								(lint-format "perhaps ~A" caller
+									     (lists->string form
+											    (cons f (unlist-values cdr-args)))))))))))))
+				      ;; len > 3
+				      (unless (hash-table-ref syntaces f)                ; also not any-macro I presume
+					(when (and (pair? last-arg)
+						   (eq? (car last-arg) 'list))           ; (apply f y z (list a b)) -> (f y z a b)
+					  (lint-format "perhaps ~A" caller
+						       (lists->string form
+								      (append (copy (cdr form) (make-list (- len 2)))
+									      (cdr last-arg)))))
+					;; can't cleanly go from (apply write o p) to (write o (car p)) since p can be ()
+
+					(unless happy
+					  (if (any-null? last-arg)                       ; (apply f ... ()) -> (f ...)
+					      (lint-format "perhaps ~A" caller (lists->string form (cons f (copy (cddr form) (make-list (- len 3)))))))
+					  (if (and (= len 4)                             ; (apply f (car x) (cdr x)) -> (apply f x)
+						   (len=2? (caddr form))
+						   (eq? (caaddr form) 'car)
+						   (len=2? (cadddr form))
+						   (eq? (car (cadddr form)) 'cdr)
+						   (eq? (cadr (caddr form)) (cadr (cadddr form))))
+					      (lint-format "perhaps ~A" caller (lists->string form `(apply ,(cadr form) ,(cadr (caddr form))))))
+					  )))))))))
+		(if (and (= suggestion made-suggestion)
+			 (symbol? (cadr form)))
+		    (let ((ary (arg-arity (cadr form) env)))
+		      (if (and (pair? ary)             ; (apply make-string tcnt initializer) -> (make-string tcnt (car initializer))
+			       (= (car ary) (cdr ary)) ; else () as last, so can't suggest (car last)
+			       (= (cdr ary) (- len 2)))
+			  (lint-format "perhaps ~A" caller
+				       (lists->string form (append (copy (cdr form) (make-list (- len 2)))
+								   (list (list 'car (list-ref form (- len 1)))))))))))))
+
+	  (hash-special 'apply sp-apply))
+
+	;; ---------------- format ----------------
+	(let ()
+	  (define count-directives
+	    (let ((format-control-char (let ((chars (make-vector 256 #f)))
+					 (for-each
+					  (lambda (c)
+					    (vector-set! chars (char->integer c) #t))
+					  '(#\A #\S #\C #\F #\E #\G #\O #\D #\B #\X #\P #\N #\W #\, #\{ #\} #\* #\@
+					    #\a #\s #\c #\f #\e #\g #\o #\d #\b #\x #\p #\n #\w
+					    #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
+					 chars)))
+	      (lambda (head str caller form)
+		(let ((curlys 0)
+		      (dirs 0)
+		      (tildes 1)
+		      (returns 0)
+		      (pos (char-position #\~ str)))
+		  (when pos
+		    (do ((len (length str))
+			 (tilde-time #t)
+			 (i (+ pos 1) (+ i 1)))
+			((>= i len)
+			 (if tilde-time         ; (format #f "asdf~")
+			     (lint-format "~A control string ends in tilde: ~A" caller head (truncated-list->string form))))
+		      (if tilde-time
+			  (let ((c (string-ref str i)))
+			    ;(format *stderr* "~C ~S~%" c str)
+			    (when (and (= curlys 0)
+				       (not (memv c '(#\~ #\T #\t #\& #\% #\^ #\| #\newline #\}))) ; ~* consumes an arg
+				       (not (and (char=? c #\:) (< i (- len 1)) (memv (string-ref str (+ i 1)) '(#\D #\d))))
+				       (not (call-with-exit
+					     (lambda (return)
+					       (do ((k i (+ k 1)))
+						   ((= k len) #f)
+						 ;; this can be confused by pad chars in ~T
+						 (unless (or (char-numeric? (string-ref str k))
+							     (char=? (string-ref str k) #\,))
+						   ;(format *stderr* "~C ~C~%" (string-ref str k) c)
+						   (return (or (char=? (string-ref str k) #\') ; ~12,'-T
+							       (char-ci=? (string-ref str k) #\t)))))))))
+			      ;; the possibilities are endless, so I'll stick to the simplest
+			      (if (not (vector-ref format-control-char (char->integer c))) ; (format #f "~H" 1)
+				  (lint-format "unrecognized format directive: ~C in ~S, ~S" caller c str form))
+			      (set! dirs (+ dirs 1))
+
+			      ;; ~n so try to figure out how many args are needed (this is not complete)
+			      (when (char-ci=? c #\n)
+				(let ((j (+ i 1)))
+				  (if (>= j len)             ; (format p "~A~A" x)
+				      (lint-format "missing format directive: ~S" caller str)
+				      (begin
+					;; if ,n -- add another, if then not T, add another
+					(cond ((not (char=? (string-ref str j) #\,)))
+					      ((>= (+ j 1) len)
+					       (lint-format "missing format directive: ~S" caller str))
+					      ((char-ci=? (string-ref str (+ j 1)) #\n)
+					       (set! dirs (+ dirs 1))
+					       (set! j (+ j 2)))
+					      ((char-numeric? (string-ref str (+ j 1)))
+					       (set! j (+ j 2)))
+					      (else (set! j (+ j 1))))
+					(if (>= j len)
+					    (lint-format "missing format directive: ~S" caller str)
+					    (if (not (char-ci=? (string-ref str j) #\t))
+						(set! dirs (+ dirs 1)))))))))
+
+			    (set! tilde-time #f)
+			    (case c
+			      ((#\{) (set! curlys (+ curlys 1)))
+			      ((#\}) (set! curlys (- curlys 1)))
+			      ((#\%) (set! returns (+ returns 1)))
+			      ((#\^ #\|)
+			       (if (zero? curlys)   ; (format #f "~^")
+				   (lint-format "~A has ~~~C outside ~~{~~}?" caller str c))))
+			    (if (and (< (+ i 2) len)
+				     (member (substring str i (+ i 3)) '("%~&" "^~^" "|~|" "&~&" "\n~\n") string=?))
+				(lint-format "~A in ~A could be ~A" caller  ;  (format #f "~%~&")
+					     (substring str (- i 1) (+ i 3))
+					     str
+					     (substring str (- i 1) (+ i 1)))))
+			  (begin ; not tilde-time
+			    (set! pos (char-position #\~ str i))
+			    (if pos
+				(begin
+				  (set! tildes (+ tildes 1))
+				  (set! tilde-time #t)
+				  (set! i pos))
+				(set! i len))))))
+
+		  (if (not (= curlys 0))   ;  (format #f "~{~A" 1)
+		      (lint-format "~A has ~D unmatched ~A~A: ~A"
+				   caller head
+				   (abs curlys)
+				   (if (positive? curlys) "{" "}")
+				   (if (> curlys 1) "s" "")
+				   (truncated-list->string form)))
+		  (if (and (= tildes returns)
+			   (not (cadr form))                ; (format #f "...~%..." -> "...\n..."
+			   (positive? tildes))
+		      (lint-format "format is not needed in ~S: perhaps use \"~A\" instead"
+				   caller form
+				   (let ((strc (copy str))
+					 (len (length str)))
+				     (do ((i 0 (+ i 1)))
+					 ((>= i len) strc)
+				       (when (char=? (string-ref str i) #\~)
+					 (string-set! strc i #\\)
+					 (set! i (+ i 1))
+					 (string-set! strc i #\n))))))
+		  dirs))))
+
+	  (define (sp-format caller head form env)
+	    (if (< (length form) 3)
+		(begin
+		  (cond ((< (length form) 2)               ; (format)
+			 (lint-format "~A has too few arguments: ~A" caller head (truncated-list->string form)))
+
+			((and (pair? (cadr form))          ; (format (format #f str))
+			      (eq? (caadr form) 'format))
+			 (lint-format "redundant format: ~A" caller (truncated-list->string form)))
+
+			((and (code-constant? (cadr form)) ; (format 1)
+			      (not (string? (cadr form))))
+			 (lint-format "format with one argument takes a string: ~A" caller (truncated-list->string form)))
+
+			((and (string? (cadr form))        ; (format "str") -> str
+			      (eq? head 'format)           ; not snd-display, error, etc
+			      (not (char-position #\~ (cadr form))))
+			 (lint-format "perhaps ~A" caller (lists->string form (cadr form)))))
+		  env)
+
+		(let ((control-string ((if (string? (cadr form)) cadr caddr) form))
+		      (args ((if (string? (cadr form)) cddr cdddr) form)))
+
+		  (when (eq? head 'format)
+		    (if (string? (cadr form)) ; (format "s")
+			(lint-format "please include the port argument to format, perhaps ~A" caller (cons 'format (cons () (cdr form))))
+			(if (and (not (cadr form))
+				 (member (caddr form) '("~S" "~A"))
+				 (= (length form) 4)
+				 (not (and (pair? (cadddr form))
+					   (let ((sig (arg-signature (car (cadddr form)) env)))
+					     (and (pair? sig)
+						  (or (eq? (car sig) 'string?)
+						      (and (pair? (car sig))
+							   (memq 'string? (car sig)))))))))
+			    (lint-format "perhaps ~A" caller             ; (format #f "~S" x) -> (object->string x)
+					 (lists->string form
+							(cons 'object->string
+							      (cons (cadddr form)
+								    (if (string=? (caddr form) "~A") '(#f) ())))))))
+		    (if (and (eq? (cadr form) 't)                          ; (format t " ")
+			     (not (var-member 't env)))
+			(lint-format "'t in ~A should probably be #t" caller (truncated-list->string form))))
+
+		  (if (lint-any? all-caps-warning (cdr form))
+		      (lint-format "There's no need to shout: ~A" caller (truncated-list->string form)))
+
+		  (if (not (string? control-string))
+		      (if (not (proper-list? args))
+			  (lint-format "~S looks suspicious" caller form))
+		      (let ((ndirs (count-directives head control-string caller form))
+			    (nargs (if (list? args) (length args) 0)))
+			(let ((pos (char-position #\null control-string)))
+			  (if (and pos (< pos (length control-string)))  ; (format #f "~a\x00b" x)
+			      (lint-format "#\\null in a format control string will confuse both lint and format: ~S in ~A" caller control-string form)))
+			(cond ((not (or (= ndirs nargs)
+					(lint-tree-memq 'values form)))
+			       (lint-format "~A has ~A arguments: ~A"       ; (format #f "~nT" 1 2)
+					    caller head
+					    (if (> ndirs nargs) "too few" "too many")
+					    (truncated-list->string form))) ; this can be confused by (e.g) (format () "~A~96,'-T~A~%" red-text normal-text)
+
+			      ((and (eq? head 'format)
+				    (not (cadr form))                   ; (format #f "123")
+				    (zero? ndirs)
+				    (not (char-position #\~ control-string)))
+			       (lint-format "~A could be ~S, (format is a no-op here)" caller (truncated-list->string form) (caddr form)))
+
+			      ((string-position "~^~}" control-string)
+			       (lint-format "pointless ~~^ in ~S" caller control-string)))))
+
+		  (when (pair? args)
+		    (let ((pos (and (string? control-string)
+				    (char-position #\~ control-string))))
+		      (for-each
+		       (lambda (a)
+			 (let ((directive (and (integer? pos)
+					       (control-string (+ pos 1)))))
+			   (if (integer? pos)
+			       (set! pos (char-position #\~ control-string (+ pos 2))))
+
+			   (if (quoted-symbol? a) ; not integer -- might be counter, keyword and things like () get no hits
+			       (lint-format "perhaps put the argument ~A in the control string: ~A" caller
+					    a (truncated-list->string form))
+
+			       (when (and (len>1? a)
+					  (not (memv directive '(#\S #\s))))
+				 (case (car a)
+				   ((number->string)
+				    (if (null? (cddr a))                      ; (format #f "~A" (number->string x))
+					(lint-format "~A argument ~A could be ~A" caller head a (cadr a))
+					(if (and (pair? (cddr a))
+						 (integer? (caddr a))
+						 (memv (caddr a) '(2 8 10 16)))
+					    (if (= (caddr a) 10)
+						(lint-format "~A argument ~A could be ~A" caller head a (cadr a))
+						(lint-format "~A argument ~A could use the format directive ~~~A and change the argument to ~A" caller head a
+							     (case (caddr a) ((2) "B") ((8) "O") (else "X"))
+							     (cadr a))))))
+
+				   ((symbol->string string->symbol) ; (format #f "~A" (symbol->string 'x))
+				    (lint-format "~A argument ~A could be ~A" caller head a (cadr a)))
+
+				   ((object->string) ; object->string fourth arg is max string len returned
+				    (if (< (length a) 4)
+					(lint-format "~A argument ~A could be ~A" caller head a (cadr a))))
+
+				   ((make-string)                             ; (format #f "~A" (make-string len c))
+				    (if (pair? (cddr a))
+					(lint-format "~A argument ~A could use the format directive ~~NC and change the argument to ... ~A ~A ..." caller head a
+						     (cadr a) (if (char? (caddr a)) (format #f "~W" (caddr a)) (caddr a)))))
+
+				   ((apply)
+				    (if (and (len=3? a)
+					     (memq (cadr a) '(append string-append vector-append)))
+					(lint-format "use ~~{...~~} rather than ~A: ~A" caller (cadr a) a)))
+
+				   ((string-append)                           ; (format #f "~A" (string-append x y))
+				    (if (eq? head 'format)
+					(lint-format "format appends strings, so ~A seems wasteful" caller a))))))))
+		       args))))))
+	  (hash-special 'format sp-format))
+
+	;; ---------------- error/throw ----------------
+	(let ()
+	  (define (sp-error caller head form env)
+	    (when (pair? (cdr form))
+	      (let* ((tag (cadr form))
+		     (eq (eqf tag env)))
+		(if (string? tag)
+		    (lint-format "~A's first argument should be a catchable tag, not ~S" caller head tag)
+		    (if (not (member eq '((eq? eq?) (#t #t))))
+			(lint-format "~A tag ~S is unreliable (catch uses eq? to match tags)" caller 'error tag)))
+		(if (and (proper-pair? (cddr form))
+			 (string? (caddr form)))
+		    ((hash-table-ref special-case-functions 'format) caller head form env)))))
+
+	  (hash-special 'error sp-error)
+	  (hash-special 'throw sp-error))
+
+	;; ---------------- sort! ----------------
+	(let ()
+	  (define (sp-sort caller head form env)
+	    (when (= (length form) 3)
+		(let ((func (caddr form)))
+		  (if (memq func '(= eq? eqv? equal? string=? char=? string-ci=? char-ci=?))
+		      (lint-format "sort! with ~A may hang: ~A" caller func (truncated-list->string form))
+		      (if (symbol? func)
+			  (let ((sig (signature (symbol->value func (rootlet)))))
+			    (if (and (pair? sig)
+				     (not (eq? 'boolean? (car sig)))
+				     (not (and (pair? (car sig))
+					       (memq 'boolean? (car sig)))))  ;  (sort! x abs)
+				(lint-format "~A is a questionable sort! function" caller func))))))
+		(let ((target (cadr form)))
+		  (if (code-constant? target)            ; (sort #(1 2) <)
+		      (if (eqv? (length target) 0)
+			  (lint-format "~A is pointless" caller (truncated-list->string form))
+			  (lint-format "~S is a constant, so ~A is problematic" caller
+				       target (truncated-list->string form)))))))
+
+	  (hash-special 'sort! sp-sort))
+
+	;; ---------------- substring ----------------
+	(let ()
+	  (define (sp-substring caller head form env)
+	    (if (just-code-constants? (cdr form))
+		(catch #t
+		  (lambda ()
+		    (let ((val (eval form)))     ; (substring "abracadabra" 2 7) -> "racad"
+		      (lint-format "perhaps ~A -> ~S" caller (truncated-list->string form) val)))
+		  (lambda (type info)
+		    (lint-format "~A -> ~A" caller (truncated-list->string form) (apply format #f info))))
+
+		(let ((str (cadr form)))
+
+		  (when (string? str)           ; (substring "++++++" 0 2) -> (make-string 2 #\+)
+		    (let ((len (length str)))
+		      (when (and (> len 0)
+				 (string=? str (make-string len (string-ref str 0))))
+			(lint-format "perhaps ~A" caller
+				     (lists->string form
+						    (let ((chars (if (null? (cddr form))
+								     len
+								     (if (pair? (cdddr form))
+									 (if (eqv? (caddr form) 0)
+									     (cadddr form)
+									     (list '- (cadddr form) (caddr form)))
+									 (list '- len (caddr form))))))
+						      (list 'make-string chars (string-ref str 0))))))))
+
+		  (when (pair? (cddr form))
+		    (when (and (pair? str)                ; (substring (substring x 1) 2) -> (substring x 3)
+			       (eq? (car str) 'substring))
+		      (let ((inner-x (caddr str))
+			    (inner-y (and (pair? (cdddr str))
+					  (cadddr str)))
+			    (outer-x (caddr form))
+			    (outer-y (and (pair? (cdddr form))
+					  (cadddr form))))
+			(let ((x (if (and (integer? outer-x)
+					  (integer? inner-x))
+				     (+ outer-x inner-x)
+				     (list '+ outer-x inner-x))))
+			  (lint-format "perhaps ~A" caller
+				       (lists->string form
+						      (if (not (or inner-y outer-y))
+							  (list 'substring (cadr str) x)
+							  (list 'substring (cadr str) x
+								(if outer-y
+								    (if (and (integer? outer-y)
+									     (integer? inner-x))
+									(+ outer-y inner-x)
+									(list '+ outer-y inner-x))
+								    inner-y))))))))
+
+		    (if (and (eqv? (caddr form) 0)
+			     (null? (cdddr form)))   ;  (substring x 0) -> (copy x)
+			(lint-format "perhaps clearer: ~A" caller (lists->string form (list 'copy str))))
+
+		    (when (pair? (cdddr form))
+		      (let ((end (cadddr form)))
+			(if (equal? (caddr form) end)   ; (substring x (+ y 1) (+ y 1)) is ""
+			    (lint-format "leaving aside errors, ~A is \"\"" caller form))
+
+			(when (and (len=3? str)
+				   (eqv? (caddr form) 0)
+				   (eq? (car str) 'string-append))
+			  (let ((in-arg2 (caddr str)))
+			    (if (and (pair? in-arg2)    ;  (substring (string-append str (make-string len #\space)) 0 len) -> (copy str (make-string len #\space))
+				     (eq? (car in-arg2) 'make-string)
+				     (equal? (cadddr form) (cadr in-arg2)))
+				(lint-format "perhaps ~A" caller
+					     (lists->string form `(copy ,(cadr str) (make-string ,(cadddr form) ,(caddr in-arg2))))))))
+
+			(if (and (len>1? end)           ; (substring x start (length|string-length x)) -> (substring s start)
+				 (memq (car end) '(string-length length))
+				 (equal? (cadr end) str))
+			    (lint-format "perhaps ~A" caller (lists->string form (copy form (make-list 3))))
+
+			    (when (symbol? end)
+			      (let ((v (var-member end env)))
+				(if (and v
+					 (equal? (list 'string-length str) (var-initial-value v))
+					 (not (lint-any? (lambda (p)
+							   (lint-set!? p env))
+							 (var-history v))))   ;  if len is still (string-length x), (substring x 1 len) -> (substring x 1)
+				    (lint-format "perhaps, if ~A is still ~A, ~A" caller end (var-initial-value v)
+						 (lists->string form (copy form (make-list 3))))))))))))))
+
+	  (hash-special 'substring sp-substring))
+
+	;; ---------------- list, *vector ----------------
+	(let ((seq-maker (lambda (seq)
+			   (cdr (assq seq '((list . make-list)
+					    (vector . make-vector)
+					    (float-vector . make-float-vector)
+					    (int-vector . make-int-vector)
+					    (byte-vector . make-byte-vector))))))
+	      (seq-default (lambda (seq)
+			     (cdr (assq seq '((list . #f)
+					      (vector . #<unspecified>)
+					      (float-vector . 0.0)
+					      (int-vector . 0)
+					      (byte-vector . 0)))))))
+	  (define (sp-list caller head form env)
+	    (let ((len (length form))
+		  (val (and (pair? (cdr form))
+			    (cadr form))))
+	      (when (eq? head 'list)                ; (list) -> () but not (vector) -> #()
+		(if (= len 1)                       ;    (eq? (vector) #()) -> #f (same for string etc)
+		    (if (not (var-member 'list env))
+			(lint-format "perhaps (list) -> (); there is only one nil" caller))
+		    (if (and (> len 3)
+			     (len=2? (cadr form)))  ; (list (f a) (f b) (f c)) -> (map f (list a b c))
+			(let ((f (caadr form)))     ;    map orders this process whereas list is unordered?
+			  ;; not any-macro? f?? or no side-effect? in the args?
+			  (if (and (not (memq f '(quote #_quote values)))
+				   (lint-every? (lambda (p)
+						  (and (len=2? p)
+						       (eq? f (car p))))
+						(cddr form)))
+			      (lint-format "perhaps ~A" caller
+					   (truncated-lists->string form
+								    (if (lint-every? (lambda (p)
+										       (code-constant? (cadr p)))
+										     (cdr form))
+						`(map ,f ',(map (lambda (p) ; p = arg which might be quoted (not = f)
+								  ((if (and (pair? (cadr p))
+									    (memq (caadr p) '(quote #_quote)))
+								       cadadr cadr)
+								   p))
+								 (cdr form)))
+						`(map ,f (list ,@(map cadr (cdr form))))))))))))
+	      ;; *vector here gets a dozen or so hits but (apply vector (map f (list ...))) involves too much consing
+	      ;; list-values in this case is always apply-values as 'f
+	      ;; the only other hits in this area are and/or and test macros
+
+	      (when (and (> len 4)
+			 (lint-every? (lambda (a) (equal? a val)) (cddr form)))
+		(if (code-constant? val)        ; (vector 12 12 12 12 12 12) -> (make-vector 6 12)
+		    (lint-format "perhaps ~A~A" caller
+				 (lists->string form
+						(if (eqv? (seq-default head) val)
+						    (list (seq-maker head) (- len 1))
+						    (list (seq-maker head) (- len 1) val)))
+				 (if (and (sequence? val)
+					  (not (null? val)))
+				     (format #f "~%~NCor wrap (copy ~S) in a function and call that ~A times"
+					     lint-left-margin #\space
+					     val (- len 1))
+				     ""))
+		    (if (pair? val)
+			(if (or (side-effect? val env)
+				(hash-table-ref makers (car val)))
+			    (if (> (lint-tree-leaves val) 3)
+				;; I think we need to laboriously repeat the function call here:
+				;;    (let ((a 1) (b 2) (c 3))
+				;;      (define f (let ((ctr 0)) (lambda (x y z) (set! ctr (+ ctr 1)) (+ x y ctr (* 2 z)))))
+				;;      (list (f a b c) (f a b c) (f a b c) (f a b c))
+				;; so (apply list (make-list 4 (<1>))) or variants thereof fail
+				;;   (eval (append '(list) (make-list 4 '(<1>))))
+				;; works, but it's too ugly.
+				(lint-format "perhaps ~A" caller
+					     (lists->string form
+							    `(let ((<1> (lambda () ,val)))
+							       (,head ,@(make-list (- len 1) '(<1>)))))))
+			    ;; if seq copy else
+			    (lint-format "perhaps ~A" caller  ; (vector (car x) (car x) (car x) (car x)) -> (make-vector 4 (car x))
+					 (lists->string  form (list (seq-maker head) (- len 1) val)))))))))
+
+	  (for-each (lambda (f) (hash-special f sp-list)) '(list vector int-vector float-vector byte-vector)))
+
+	;; ---------------- list-tail ----------------
+	(let ()
+	  (define (sp-list-tail caller head form env)
+	    (cond
+	     ((not (= (length form) 3)) #f)
+
+	     ((eqv? (caddr form) 0)                     ; (list-tail x 0) -> x
+	      (lint-format "perhaps ~A" caller (lists->string form (cadr form))))
+
+	     ((and (pair? (cadr form))
+		   (eq? (caadr form) 'list-tail))
+	      (lint-format "perhaps ~A" caller          ; (list-tail (list-tail x 1) 2) -> (list-tail x 3)
+			   (lists->string form
+					  (list 'list-tail (cadadr form)
+						(if (and (integer? (caddr form))
+							 (integer? (caddr (cadr form))))
+						    (+ (caddr (cadr form)) (caddr form))
+						    (list '+ (caddr (cadr form)) (caddr form)))))))
+
+	     ((memv (caddr form) '(1 2))                ; (list-tail x 1) -> (cdr x)
+	      (lint-format "perhaps ~A" caller
+			   (lists->string form
+					  (list (if (eqv? (caddr form) 1) 'cdr 'cddr)
+						(cadr form)))))))
+
+	  (hash-special 'list-tail sp-list-tail))
+
+	;; ---------------- eq? ----------------
+	(let ()
+	  (define (sp-eq? caller head form env)
+	    (if (< (length form) 3)  ; (eq?)
+		(lint-format "eq? needs 2 arguments: ~A" caller (truncated-list->string form))
+		(let* ((arg1 (cadr form))
+		       (arg2 (caddr form))
+		       (eq1 (eqf arg1 env))
+		       (eq2 (eqf arg2 env))
+		       (specific-op (and (eq? (cadr eq1) (cadr eq2))
+					 (not (memq (cadr eq1) '(eqv? equal?)))
+					 (cadr eq1))))
+
+		  (eval-constant-expression caller form)
+
+		  (if (or (eq? (car eq1) 'equal?)
+			  (eq? (car eq2) 'equal?))         ; (eq? #(0) #(0))
+		      (lint-format "eq? should be equal?~A in ~A" caller
+				   (if specific-op (format #f " or ~A" specific-op) "")
+				   (truncated-list->string form))
+		      (if (or (eq? (car eq1) 'eqv?)
+			      (eq? (car eq2) 'eqv?))       ; (eq? x 1.5)
+			  (lint-format "eq? should be eqv?~A in ~A" caller
+				       (if specific-op (format #f " or ~A" specific-op) "")
+				       (truncated-list->string form))))
+
+		  (let ((expr 'unset))
+		    (cond ((or (not arg1)                  ; (eq? #f x) -> (not x)
+			       (quoted-not? arg1))
+			   (set! expr (simplify-boolean (list 'not arg2) () () env)))
+
+			  ((or (not arg2)                  ; (eq? x #f) -> (not x)
+			       (quoted-not? arg2))
+			   (set! expr (simplify-boolean (list 'not arg1) () () env)))
+
+			  ((and (any-null? arg1)           ; (eq? () x) -> (null? x)
+				(not (code-constant? arg2)))
+			   (set! expr (or (equal? arg2 '(list)) ; (eq? () (list)) -> #t
+					  (list 'null? arg2))))
+
+			  ((and (any-null? arg2)           ; (eq? x ()) -> (null? x)
+				(not (code-constant? arg1)))
+			   (set! expr (or (equal? arg1 '(list))
+					  (list 'null? arg1))))
+
+			  ((and (eq? arg1 #t)              ; (eq? #t <boolean-expr>) -> boolean-expr
+				(pair? arg2))              ; (eq? #t <never-#t-expr) -> #f
+			   (let ((rtn (return-type (car arg2) env)))
+			     (unless (boolean? rtn)        ; #t = any result possible, #f = no signature found, values->#t in return-type
+			       (cond ((eq? rtn 'boolean?) (set! expr arg2))
+				     ((not (pair? rtn)) (set! expr #f))
+				     ((not (or (memq 'boolean? rtn)
+					       (memq #t rtn)
+					       (memq 'values rtn)))
+				      (set! expr #f))))))
+
+			  ((and (eq? arg2 #t)              ; (eq? <boolean-expr> #t) -> boolean-expr
+				(pair? arg1))              ; (eq? <never-#t-expr) #t) -> #f
+			   (let ((rtn (return-type (car arg1) env)))
+			     (unless (boolean? rtn)
+			       (cond ((eq? rtn 'boolean?) (set! expr arg1))
+				     ((not (pair? rtn)) (set! expr #f))
+				     ((not (or (memq 'boolean? rtn)
+					       (memq #t rtn)
+					       (memq 'values rtn)))
+				      (set! expr #f)))))))
+
+		    (let ((t1 (->lint-type arg1))          ; (eq? (floor pi) 'a) -> #f
+			  (t2 (->lint-type arg2)))
+		      ;; ->lint-type -> #t if unknown
+		      (unless (compatible? t1 t2)
+			(set! expr #f)))
+
+		    (if (not (eq? expr 'unset))            ; (eq? x '()) -> (null? x)
+			(lint-format "perhaps ~A" caller (lists->string form expr)))))))
+	  (hash-special 'eq? sp-eq?))
+
+	;; ---------------- eqv? equal? ----------------
+	(let ()
+	  (define (useless-copy? a)
+	    (and (len=2? a)
+		 (memq (car a) '(copy string-copy vector-copy list-copy))))
+
+	  (define (sp-eqv? caller head form env)
+	    (if (< (length form) 3)
+		(lint-format "~A needs 2 arguments: ~A" caller head (truncated-list->string form))
+		(let* ((arg1 (cadr form))
+		       (arg2 (caddr form))
+		       (eq1 (eqf arg1 env))
+		       (eq2 (eqf arg2 env))
+		       (specific-op (and (eq? (cadr eq1) (cadr eq2))
+					 (not (memq (cadr eq1) '(eq? eqv? equal?)))
+					 (cadr eq1))))
+
+		  (eval-constant-expression caller form)
+
+		  (if (or (useless-copy? arg1)
+			  (useless-copy? arg2))       ; (equal? (vector-copy #(a b c)) #(a b c)) -> (equal? #(a b c) #(a b c))
+		      (lint-format "perhaps ~A" caller
+				   (lists->string form
+						  (list head
+							(if (useless-copy? arg1) (cadr arg1) arg1)
+							(if (useless-copy? arg2) (cadr arg2) arg2)))))
+		  (unless (string->char= caller form form)
+		    (string->char= caller (cons (car form) (reverse (cdr form))) form))
+
+		  (if (and (not (eq? (cadr eq1) (cadr eq2)))    ; (eqv? ":" (string-ref s 0))
+			   (memq (cadr eq1) '(char=? string=?))
+			   (memq (cadr eq2) '(char=? string=?)))
+		      (lint-format "this can't be right: ~A" caller form))
+
+		  ;; (equal? a (list b)) and equivalents happen a lot (well, a few dozen times), but is the extra consing worse than
+		  ;;    (and (pair? a) (null? (cdr a)) (equal? (car a) b)) -- code readability seems more important here
+		  ;;    also, a is often an expression, and let+local is worse than list
+
+		  (cond ((or (eq? (car eq1) 'equal?)
+			     (eq? (car eq2) 'equal?))
+			 (if (eq? head 'equal?)
+			     (if specific-op                    ; equal? could be string=? in (equal? (string x) (string-append y z))
+				 (lint-format "~A could be ~A in ~S" caller head specific-op form))
+			     (lint-format "~A should be equal?~A in ~S" caller head
+					  (if specific-op (format #f " or ~A" specific-op) "")
+					  form)))
+
+			((or (eq? (car eq1) 'eqv?)
+			     (eq? (car eq2) 'eqv?))
+			 (if (eq? head 'eqv?)
+			     (if specific-op                    ; (eqv? (integer->char x) #\null)
+				 (lint-format "~A could be ~A in ~S" caller head specific-op form))
+			     (lint-format "~A ~A be eqv?~A in ~S" caller head
+					  (if (eq? head 'eq?) "should" "could")
+					  (if specific-op (format #f " or ~A" specific-op) "")
+					  form)))
+
+			((not (or (eq? (car eq1) 'eq?)
+				  (eq? (car eq2) 'eq?))))
+
+			((not (and arg1 arg2))                  ; (eqv? x #f) -> (not x)
+			 (lint-format "~A could be not: ~A" caller head (lists->string form (list 'not (or arg1 arg2)))))
+
+			((or (any-null? arg1)
+			     (any-null? arg2))                  ; (eqv? x ()) -> (null? x)
+			 (lint-format "~A could be null?: ~A" caller head
+				      (lists->string form
+						     (list 'null? (if (any-null? arg1) arg2 arg1)))))
+
+			(else                                   ; (eqv? x 'a)
+			 (lint-format "~A could be eq?~A in ~S" caller head
+				      (if specific-op (format #f " or ~A" specific-op) "")
+				      form)))
+
+		    (let ((t1 (->lint-type arg1))               ; (eqv? (floor pi) 'a) -> #f
+			  (t2 (->lint-type arg2)))
+		      (unless (compatible? t1 t2)
+			(lint-format "perhaps ~A -> #f" caller form)))
+		    )))
+		  ;; very few hits:
+		  ;; (equal? (reverse em) '((0 -2 0) (0 -1 0) (1 -2 0) (1 -1 0)))
+
+	  (hash-special 'eqv? sp-eqv?)
+	  (hash-special 'equal? sp-eqv?))
+
+	(let ()
+	  (define (sp-equivalent caller head form env)
+	    (if (< (length form) 3)
+		(lint-format "~A needs 2 arguments: ~A" caller head (truncated-list->string form))
+		(if (= (length form) 3)
+		    (let ((arg1 (cadr form))
+			  (arg2 (caddr form)))
+		      (if (and (code-constant? arg1)
+			       (code-constant? arg2))     ; (equivalent? 1 1) -> #t
+			  (lint-format "perhaps ~A" caller
+				       (lists->string form
+						      (apply equivalent? (cdr form)))))
+		      (let ((t1 (->lint-type arg1))       ; (morallly-equal? (floor pi) 'a) -> #f
+			    (t2 (->lint-type arg2)))
+			(unless (compatible? t1 t2)
+			  (lint-format "perhaps ~A -> #f" caller form)))))))
+
+	  (hash-special 'equivalent? sp-equivalent))
+
+
+	;; ---------------- map for-each ----------------
+	(let ()
+	  (define (sp-map caller head form env)
+	    (let* ((len (length form))
+		   (args (- len 2)))
+	      (if (< len 3)                           ; (map (lambda (v) (vector-ref v 0)))
+		  (lint-format "~A missing argument~A in: ~A"
+			       caller head
+			       (if (= len 2) "" "s")
+			       (truncated-list->string form))
+		  (let ((func (cadr form))
+			(ary #f))
+
+		    ;; if zero or one args, the map/for-each is either a no-op or a function call
+		    (if (or (lint-any? any-null? (cddr form))  ; (map abs ())
+			    (lint-any? (lambda (p)
+					 (or (and (code-constant? p)
+						  (eqv? (length p) 0))
+					     (and (pair? p)
+						  (case (car p)
+						    ((vector string)
+						     (null? (cdr p)))
+						    ((quote #_quote)
+						     (and (pair? (cdr p))
+							  (eqv? (length (cadr p)) 0)))
+						    (else #f)))))
+				       (cddr form)))
+			(lint-format "this ~A has no effect (~A arg)" caller
+				     (truncated-list->string form)
+				     (if (lint-any? any-null? (cddr form)) "null" "zero length"))
+			(if (and (not (lint-tree-memq 'values form)) ; e.g. flatten in s7.html
+				 (lint-any? (lambda (p)
+					      (or (and (code-constant? p)
+						       (eqv? (length p) 1))
+						  (and (len>1? p)
+						       (case (car p)
+							 ((quote #_quote)
+							  (len=1? (cadr p)))
+							 ((list vector string)
+							  (null? (cddr p)))
+							 ((cons)
+							  (and (pair? (cddr p))
+							       (any-null? (caddr p))))
+							 (else #f)))))
+					    (cddr form)))    ; (for-each display (list a)) -> (display a)
+			    (lint-format "perhaps ~A" caller
+					 (lists->string form
+							(let ((args (map (lambda (a)
+									   (if (len>1? a)
+									       (case (car a)
+										 ((list cons vector string)
+										  (cadr a))       ; slightly inaccurate
+										 ((quote #_quote) ; might be '#(0) or '(0) etc
+										  (if (sequence? (cadr a))
+										      ((cadr a) 0)
+										      (list a 0)))
+										 (else (list a 0))) ; not car -- might not be a list
+									       (if (and (code-constant? a)
+											(sequence? a))
+										   (a 0)            ; (map abs #(1)) -> (list (abs 1))
+										   (list a 0))))    ;  but still not right -- arg might be a hash-table
+									 (cddr form))))
+							  (if (eq? head 'for-each)
+							      (cons (cadr form) args)
+							      (list 'list (cons (cadr form) args))))))))
+		    ;; 2 happens a lot, but introduces evaluation order quibbles
+		    ;;   we used to check for values if list arg -- got 4 hits!
+
+		    (if (and (symbol? func)
+			     (procedure? (symbol->value func *e*)))
+			(begin
+			  (set! ary (arity (symbol->value func *e*)))
+			  (if (and (eq? head 'map)
+				   (hash-table-ref no-side-effect-functions func)
+				   (= len 3)
+				   (pair? (caddr form))
+				   (or (memq (caaddr form) '(quote #_quote))
+				       (and (eq? (caaddr form) 'list)
+					    (just-code-constants? (cdaddr form)))))
+			      (catch #t
+				(lambda ()          ; (map symbol->string '(a b c d)) -> '("a" "b" "c" "d")
+				  (let ((val (eval form)))
+				    (lint-format "perhaps ~A" caller (lists->string form (list #_quote val)))))
+				(lambda args #f))))
+
+			(when (and (pair? func)
+				   (memq (car func) '(lambda lambda*)))
+			  (if (pair? (cadr func))
+			      (let ((arglen (length (cadr func))))
+				(set! ary (if (eq? (car func) 'lambda)
+					      (if (negative? arglen)
+						  (cons (abs arglen) 512000)
+						  (cons arglen arglen))
+					      (cons 0 (if (or (negative? arglen)
+							      (memq :rest (cadr func)))
+							  512000 arglen))))))
+			  (if (= len 3)
+			      (let ((body (cddr func)))       ; (map (lambda (a) #f) x) -> (make-list (abs (length x)) #f)
+				(if (and (null? (cdr body))
+					 (code-constant? (car body)))
+				    (lint-format "perhaps ~A" caller
+						 (lists->string form
+								`(make-list (abs (length ,(caddr form))) ,(car body)))))))))
+		    (if (pair? ary)
+			(if (< args (car ary))                ; (map (lambda (a b) a) '(1 2))
+			    (lint-format "~A has too few arguments in: ~A"
+					 caller head
+					 (truncated-list->string form))
+			    (if (> args (cdr ary))            ; (map abs '(1 2) '(3 4))
+				(lint-format "~A has too many arguments in: ~A"
+					     caller head
+					     (truncated-list->string form)))))
+		    (for-each
+		     (lambda (obj)
+		       (if (and (len>1? obj)
+				(memq (car obj) '(vector->list string->list let->list))) ; (vector->list #(1 2)) could be simplified to: #(1 2)
+			   (lint-format "~A could be simplified to:~%~NC~A ; (~A accepts non-list sequences)" caller
+					(truncated-list->string obj)
+					(+ lint-left-margin 4) #\space
+					(truncated-list->string (cadr obj))
+					head)))
+		     (cddr form))
+
+		    (when (eq? head 'map)
+		      (when (and (memq func '(char-downcase char-upcase))
+				 (pair? (caddr form))         ; (map char-downcase (string->list str)) -> (string->list (string-downcase str))
+				 (eq? (caaddr form) 'string->list))
+			(lint-format "perhaps ~A" caller
+				     (lists->string form (list 'string->list (list (if (eq? func 'char-upcase) 'string-upcase 'string-downcase)
+										   (cadr (caddr form)))))))
+		      (when (identity? func) ; to check f here as var is more work ; (map (lambda (x) x) lst) -> lst
+			(lint-format "perhaps ~A" caller (lists->string form (caddr form)))))
+
+		    (let ((arg1 (caddr form)))
+		      (when (and (len>1? arg1)
+				 (or (memq (car arg1) '(cdr cddr cdddr cddddr))
+				     (and (eq? (car arg1) 'list-tail)
+					  (pair? (cddr arg1))))
+				 (len>1? (cadr arg1))
+				 (memq (caadr arg1) '(string->list vector->list)))
+			(let ((string-case (eq? (caadr arg1) 'string->list))    ; (cdr (vector->list v)) -> (subvector v 1 (length v))
+			      (len-diff (case (car arg1) ((list-tail) (caddr arg1)) (else => cdr-count))))
+			  (lint-format "~A accepts ~A arguments, so perhaps ~A" caller head
+				       (if string-case 'string 'vector)
+				       (lists->string arg1 (if string-case
+							       (list 'substring (cadadr arg1) len-diff)
+							       `(subvector ,(cadadr arg1) ,len-diff (length ,(cadadr arg1)))))))))
+		    (when (and (eq? head 'for-each)
+			       (len>1? (cadr form))            ; (for-each (lambda (x) (+ (abs x) 1)) lst)
+			       (eq? (caadr form) 'lambda)
+			       (not (lint-any? (lambda (x) (side-effect? x env)) (cddadr form))))
+		      (lint-format "pointless for-each: ~A" caller (truncated-list->string form)))
+
+		    (when (= args 1)
+		      (let ((seq (caddr form)))
+
+			(when (pair? seq)
+			  (case (car seq)
+			    ((cons)                           ; (for-each display (cons msgs " "))
+			     (if (and (len>1? (cdr seq))
+				      (code-constant? (caddr seq)))
+				 (lint-format "~A will ignore ~S in ~A" caller head (caddr seq) seq)))
+
+			    ((map)
+			     (when (= (length seq) 3)
+			       ;; a toss-up -- probably faster to combine funcs here, and easier to read?
+			       ;;   but only if first arg is only used once in first func, and everything is simple (one-line or symbol)
+			       (let* ((seq-func (cadr seq))
+				      (arg-name (find-unique-name func seq-func)))
+
+				 (if (symbol? func)            ; (map f (map g h)) -> (map (lambda (<1>) (f (g <1>))) h) -- dubious
+				     (if (symbol? seq-func)
+					 (lint-format "perhaps ~A" caller
+						      (lists->string form `(,head (lambda (,arg-name)
+										    (,func (,seq-func ,arg-name)))
+										  ,(caddr seq))))
+					 (if (simple-lambda? seq-func)
+					     ;; (map f (map (lambda (x) (g x)) h)) -> (map (lambda (x) (f (g x))) h)
+					     (lint-format "perhaps ~A" caller
+							  (lists->string form `(,head (lambda (,arg-name)
+											(,func ,(tree-subst arg-name (caadr seq-func) (caddr seq-func))))
+										      ,(caddr seq))))))
+				     (if (less-simple-lambda? func)
+					 (if (symbol? seq-func)
+					     ;; (map (lambda (x) (f x)) (map g h)) -> (map (lambda (x) (f (g x))) h)
+					     (lint-format "perhaps ~A" caller
+							  (lists->string form `(,head (lambda (,arg-name)
+											,@(tree-subst (list seq-func arg-name) (caadr func) (cddr func)))
+										      ,(caddr seq))))
+					     (if (simple-lambda? seq-func)
+						 ;; (map (lambda (x) (f x)) (map (lambda (x) (g x)) h)) -> (map (lambda (x) (f (g x))) h)
+						 (lint-format "perhaps ~A" caller
+							      (lists->string form `(,head (lambda (,arg-name)
+											    ,@(tree-subst (tree-subst arg-name (caadr seq-func) (caddr seq-func))
+													  (caadr func) (cddr func)))
+											  ,(caddr seq)))))))))))))
+			;; repetitive code...
+			(when (eq? head 'for-each) ; args = 1 above  ; (for-each display (list a)) -> (format () "~A" a)
+			  (let ((func (cadr form)))
+			    (if (memq func '(display write newline write-char write-string))
+				(lint-format "perhaps ~A" caller
+					     (if (and (pair? seq)
+						      (memq (car seq) '(list quote)))
+						 (let ((op (if (eq? func 'write) "~S" "~A"))
+						       (len (- (length seq) 1)))
+						   (lists->string form `(format () ,(do ((i 0 (+ i 1))
+											 (str "" (string-append str op)))
+											((= i len) str))
+										,@(cdr seq))))
+						 (let ((op (if (eq? func 'write) "~{~S~}" "~{~A~}")))
+						   (lists->string form (list 'format () op seq)))))
+				(when (and (pair? func)
+					   (eq? (car func) 'lambda))
+				  (let ((body (cddr func)))
+				    (let ((op (write-port (car body)))
+					  (larg (and (pair? (cadr func))
+						     (caadr func))))
+				      (when (and (symbol? larg)
+						 (null? (cdadr func)) ; just one arg (one sequence to for-each) for now
+						 (lint-every? (lambda (x)
+								(and (pair? x)
+								     (memq (car x) '(display write newline write-char write-string))
+								     (or (eq? (car x) 'newline)
+									 (eq? (cadr x) larg)
+									 (string? (cadr x))
+									 (eqv? (cadr x) #\space)
+									 (and (len>1? (cadr x))
+									      (eq? (caadr x) 'number->string)
+									      (eq? (cadadr x) larg)))
+								     (eq? (write-port x) op)))
+							      body))
+					;; (for-each (lambda (x) (display x) (write-char #\space)) msg)
+					;; (for-each (lambda (elt) (display elt)) lst)
+					(let ((ctrl-string "")
+					      (arg-ctr 0))
+
+					  (define* (gather-format str (arg :unset))
+					    (set! ctrl-string (string-append ctrl-string str)))
+
+					  (for-each
+					   (lambda (d)
+					     (if (or (memq larg d)
+						     (and (pair? (cdr d))
+							  (pair? (cadr d))
+							  (memq larg (cadr d))))
+						 (set! arg-ctr (+ arg-ctr 1)))
+					     (gather-format (display->format d)))
+					   body)
+
+					  (when (= arg-ctr 1)  ; (for-each (lambda (x) (display x)) args) -> (format () "~{~A~}" args)
+					    (lint-format "perhaps ~A" caller
+							 (lists->string form (list 'format op (string-append "~{" ctrl-string "~}") seq))))))))))))))))))
+	  (for-each (lambda (f)
+		      (hash-special f sp-map))
+		    '(map for-each)))
+
+	;; ---------------- magnitude ----------------
+	(let ()
+	  (define (sp-magnitude caller head form env)
+	    (if (and (len=2? form)             ;  (magnitude 2/3)
+		     (memq (->lint-type (cadr form)) '(integer? rational? real?)))
+		(lint-format "perhaps use abs here: ~A" caller form)))
+	  (hash-special 'magnitude sp-magnitude))
+
+	;; ---------------- hash-table ----------------
+	(let ()
+	  (define (sp-hash caller head form env)
+	    (let ((len (length form)))
+	      (if (and (positive? len)
+		       (even? len))
+		  (lint-format "key with no value? ~A" caller (truncated-list->string form))
+		  (when (pair? (cdr form)) ; (hash-table)
+		    (do ((syms ())
+			 (p (cdr form) (cddr p)))
+			((null? p))
+		      (let ((sym (if (pair? (car p))
+				     (cadar p)
+				     (and (keyword? (car p))
+					  (keyword->symbol (car p))))))
+			(if sym
+			    (if (memq sym syms)
+				(lint-format "repeated key ~S in ~S" caller sym form)
+				(set! syms (cons sym syms))))))))))
+	  (hash-special 'hash-table sp-hash))
+
+	;; ---------------- inlet ----------------
+	(let ()
+	  (define (sp-inlet caller head form env)
+	    (when (pair? (cdr form)) ; (inlet)
+	      ;; (inlet (cons 'a 1) 'b 2) etc make this a pain
+	      (do ((syms ())
+		   (p (cdr form) (cdr p)))
+		  ((not (pair? p)))
+		(let ((sym (car p)))
+		  (if (quoted-symbol? sym)
+		      (set! sym (cadr sym)))
+		  (if (keyword? sym)
+		      (set! sym (keyword->symbol sym)))
+		  (when (symbol? sym)
+		    (if (memq sym syms)
+			(lint-format "repeated key ~S in ~S" caller sym form)
+			(set! syms (cons sym syms)))
+		    (if (pair? (cdr p))  ; not (inlet 'a 1 'b)
+			(set! p (cdr p))
+			(lint-format "no value for last entry ~S in ~S" caller (car p) form)))))))
+
+	  (hash-special 'inlet sp-inlet)
+	  )
+
+	;; ---------------- open-input-file open-output-file ----------------
+	(let ()
+	  (define (sp-open-input-file caller head form env)
+	    (if (and (len>1? (cdr form))
+		     (string? (caddr form))        ; (open-output-file x "fb+")
+		     (or (equal? (caddr form) "")  ; I think an empty string (passed to fopen) is an error
+			 (not (memv (string-ref (caddr form) 0) '(#\r #\w #\a))))) ; b + then e m c x if gcc
+		(lint-format "unexpected mode: ~A" caller form)))
+	  (for-each (lambda (f)
+		      (hash-special f sp-open-input-file))
+		    '(open-input-file open-output-file)))
+
+	;; ---------------- values ----------------
+	(let ()
+	  (define (car-values? a b)                              ;  (values 2 (values 3 4) 5) -> (values 2 3 4 5)
+	    (and (pair? b)
+		 (eq? (car b) 'values)))
+
+	  (define (sp-values caller head form env)
+	    (cond ((member #f (cdr form) car-values?)
+		   (lint-format "perhaps ~A" caller (lists->string form (cons 'values (splice-if 'values (cdr form))))))
+		  ((len=2? form)
+		   (lint-format "perhaps ~A" caller
+				(lists->string form              ;  (values (list-values 'x (apply-values y))) -> (cons 'x y)
+					       (if (and (pair? (cadr form))
+							(memq (caadr form) '(list-values #_list-values))
+							(not (qq-tree? (cadr form))))
+						   (unlist-values (cadr form))
+						   (cadr form)))))
+		  ((and (or (assq 'list-values (cdr form))
+			    (assq '#_list-values (cdr form)))
+			(not (lint-any? (lambda (a)
+					  (and (pair? a)
+					       (memq (car a) '(list-values #_list-values apply-values #_apply-values))
+					       (qq-tree? a)))
+					(cdr form))))
+		   (lint-format "perhaps ~A" caller
+				(lists->string form              ;  (values (list-values 'x y) a) -> (values (list 'x y) a)
+					       (cons 'values (map (lambda (a)
+								    (if (and (pair? a)
+									     (memq (car a) '(list-values #_list-values)))
+									(unlist-values a)
+									a))
+								  (cdr form))))))))
+	  (hash-special 'values sp-values))
+
+	;; ---------------- call-with-values ----------------
+	(let ()
+	  (define (sp-call/values caller head form env)  ; (call/values p c) -> (c (p))
+	    (when (= (length form) 3)
+	      (let ((producer (cadr form))
+		    (consumer (caddr form)))
+		(let* ((produced-values (mv-range producer env))
+		       (consumed-values (and produced-values
+					     (or (and (symbol? consumer)
+						      (arg-arity consumer env))
+						 (and (len>2? consumer)
+						      (eq? (car consumer) 'lambda)
+						      (pair? (cadr consumer))
+						      (let ((len (length (cadr consumer))))
+							(if (negative? len)
+							    (cons (abs len) 536870912)
+							    (cons len len))))))))
+		  (if (and consumed-values
+			   (or (> (car consumed-values) (car produced-values))
+			       (< (cdr consumed-values) (cadr produced-values))))
+		      (let ((clen ((if (> (car consumed-values) (car produced-values)) car cdr) consumed-values)))
+			(lint-format "call-with-values consumer ~A wants ~D value~P, but producer ~A returns ~A"
+				     caller
+				     (truncated-list->string consumer)
+				     clen clen
+				     (truncated-list->string producer)
+				     ((if (> (car consumed-values) (car produced-values)) car cadr) produced-values)))))
+
+		(cond ((not (pair? producer))             ;  (call-with-values log c)
+		       (if (and (symbol? producer)
+				(not (memq (return-type producer ()) '(#t #f values))))
+			   (lint-format "~A does not return multiple values" caller producer)
+			   (lint-format "perhaps ~A" caller (lists->string form (list consumer (list producer))))))
+
+		      ((not (eq? (car producer) 'lambda)) ; (call-with-values (eval p env) (eval c env)) -> ((eval c env) ((eval p env)))
+		       (lint-format "perhaps ~A" caller (lists->string form (list consumer (list producer)))))
+
+		      ((pair? (cadr producer))            ; (call-with-values (lambda (x) 0) list)
+		       (lint-format "~A requires too many arguments" caller (truncated-list->string producer)))
+
+		      ((symbol? (cadr producer))          ; (call-with-values (lambda x 0) list)
+		       (lint-format "~A's parameter ~A will always be ()" caller (truncated-list->string producer) (cadr producer)))
+
+		      ((len=1? (cddr producer))           ; (call-with-values (lambda () (read-char p)) cons)
+		       (let ((body (caddr producer)))
+			 (if (or (code-constant? body)
+				 (and (pair? body)
+				      (symbol? (car body))
+				      (not (memq (return-type (car body) ()) '(#t #f values)))))
+			     (lint-format "~A does not return multiple values" caller body)
+			     (lint-format "perhaps ~A" caller
+					  (lists->string form
+							 (if (and (pair? body)
+								  (eq? (car body) 'values))
+							     (cons consumer (cdr body))
+							     (list consumer body)))))))
+
+		      (else (lint-format "perhaps ~A" caller (lists->string form (list consumer (list producer)))))))))
+	  (hash-special 'call-with-values sp-call/values))
+
+	;; ---------------- multiple-value-bind ----------------
+	(let ()
+	  (define (sp-mvb caller head form env)
+	    (when (>= (length form) 4)
+	      (let ((vars (cadr form))
+		    (producer (caddr form))
+		    (body (cdddr form)))
+
+		(if (null? vars)
+		    (lint-format "this multiple-value-bind is pointless; perhaps ~A" caller
+				 (lists->string form
+						(if (side-effect? producer env)
+						    (cons 'begin (cons producer body))
+						    (if (null? (cdr body))
+							(car body)
+							(cons 'begin body)))))
+
+		    (unless (symbol? vars)                      ; else any number of values is ok
+		      (let ((vals (mv-range producer env))      ;  (multiple-value-bind (a b) (values 1 2 3) b)
+			    (args (length vars)))
+			(if (and (integer? args)
+				 (pair? vals)
+				 (not (<= (car vals) args (cadr vals))))
+			    (lint-format "multiple-value-bind wants ~D values, but ~A returns ~A"
+					 caller args
+					 (truncated-list->string producer)
+					 ((if (< args (car vals)) car cadr) vals)))
+
+			(if (and (pair? producer)               ;  (multiple-value-bind (a b) (f) b) -> ((lambda (a b) b) (f))
+				 (symbol? (car producer))
+				 (not (memq (return-type (car producer) ()) '(#t #f values))))
+			    (lint-format "~A does not return multiple values" caller (car producer))
+			    (lint-format "perhaps ~A" caller
+					 (lists->string form
+							(if (and (null? (cdr body))
+								 (pair? (car body))
+								 (symbol? (caar body))
+								 (equal? vars (cdar body))
+								 (defined? (caar body))
+								 (equal? (arity (symbol->value (caar body))) (cons args args)))
+							    (list (caar body) producer)
+							    `((lambda ,vars ,@body) ,producer)))))))))))
+	  (hash-special 'multiple-value-bind sp-mvb))
+
+	;; ---------------- let-values ----------------
+	(let ()
+	  (define (sp-let-values caller head form env)
+	    (if (and (pair? (cdr form))
+		     (proper-pair? (cadr form)))
+		(if (null? (cdadr form))                        ; just one set of vars
+		    (let ((call (caadr form)))
+		      (if (len>1? call)
+			  (lint-format "perhaps ~A" caller      ;  (let-values (((x) (values 1))) x) -> ((lambda (x) x) (values 1))
+				       (lists->string form
+						      `((lambda ,(car call)
+							  ,@(cddr form))
+							,(cadr call))))))
+		    (if (just-len>1? (cadr form))
+			(lint-format "perhaps ~A" caller        ;  (let-values (((x) (values 1)) ((y) (values 2))) (list x y)) ...
+				     (lists->string
+				      form
+				      `(with-let
+					   (apply sublet (curlet)
+						  (list ,@(map (lambda (v)
+								 `((lambda ,(car v)
+								     (values ,@(map (lambda (name)
+										      (values (symbol->keyword name) name))
+										    (args->proper-list (car v)))))
+								   ,(cadr v)))
+							       (cadr form))))
+					 ,@(cddr form))))))))
+	  (hash-special 'let-values sp-let-values))
+
+	;; ---------------- let*-values ----------------
+	(hash-special 'let*-values
+	  (lambda (caller head form env)
+	    (if (and (pair? (cdr form))
+		     (proper-pair? (cadr form))   ; every? uses for-each which ignores dotted-list cdr?
+		     (just-len>1? (cadr form)))
+		(lint-format "perhaps ~A" caller
+			     (lists->string form               ;   (let*-values (((a) (f x))) (+ a b)) -> (let ((a (f x))) (+ a b))
+					    (let loop ((var-data (cadr form)))
+					      (let ((v (car var-data)))
+						(if (and (pair? (car v))  ; just one var
+							 (null? (cdar v)))
+						    (if (null? (cdr var-data))
+							(cons 'let (cons (list (list (caar v) (cadr v))) (cddr form)))
+							`(let ((,(caar v) ,(cadr v))) ,(loop (cdr var-data))))
+						    (if (null? (cdr var-data))
+							`((lambda ,(car v) ,@(cddr form)) ,(cadr v))
+							`((lambda ,(car v) ,(loop (cdr var-data))) ,(cadr v)))))))))))
+
+	;; ---------------- define-values ----------------
+	(hash-special 'define-values
+	  (lambda (caller head form env)
+	    (when (pair? (cdr form))
+	      (if (null? (cadr form))
+		  (lint-format "~A is pointless" caller (truncated-list->string form))
+		  (when (pair? (cddr form))
+		    (lint-format "perhaps ~A" caller
+				 (cond ((symbol? (cadr form))
+					(lists->string form (list 'define (cadr form) (list 'list (caddr form)))))
+
+				       ((len=1? (cadr form))
+					(lists->string form (list 'define (caadr form) (caddr form))))
+
+				       (else           ;  (define-values (x y) (values 3 2)) -> (varlet (curlet) ((lambda (x y) (curlet)) (values 3 2)))
+					(let-temporarily ((target-line-length 120))
+					  (truncated-lists->string form
+								   `(varlet (curlet)
+								      ((lambda ,(cadr form)
+									 (curlet))
+								       ,(caddr form)))))))))))))
+	;; ---------------- eval ----------------
+	(let ()
+	  (define (sp-eval caller head form env)
+	    (case (length form)
+	      ((2)
+	       (let ((arg (cadr form)))
+		 (if (not (pair? arg))
+		     (if (not (symbol? arg))           ;  (eval 32)
+			 (lint-format "this eval is pointless; perhaps ~A" caller (lists->string form arg)))
+		     (case (car arg)
+		       ((quote #_quote)                ;  (eval 'x)
+			(if (pair? (cdr arg))
+			    (lint-format "perhaps ~A" caller (lists->string form (cadr arg)))))
+
+		       ((string->symbol)               ;  (eval (string->symbol "x")) -> x
+			(if (pair? (cdr arg))          ;  (eval (string->symbol x)) -> (eval-string x)
+			    (if (string? (cadr arg))
+				(if (equal? (cadr arg) "")
+				    (lint-format "string->symbol argument can't be a null string:~A" caller (truncated-list->string form))
+				    (lint-format "perhaps ~A" caller (lists->string form (string->symbol (cadr arg)))))
+				(lint-format "perhaps ~A" caller (lists->string form (list 'eval-string (cadr arg)))))))
+
+		       ((with-input-from-string call-with-input-string)
+			(if (and (len>1? (cdr arg))     ;  (eval (call-with-input-string port read)) -> (eval-string port)
+				 (eq? (caddr arg) 'read))
+			    (lint-format "perhaps ~A" caller (lists->string form (list 'eval-string (cadr arg))))))
+
+		       ((read)
+			(if (and (= (length arg) 2)    ;  (eval (read (open-input-string expr))) -> (eval-string expr)
+				 (len>1? (cadr arg))
+				 (eq? (caadr arg) 'open-input-string))
+			    (lint-format "perhaps ~A" caller (lists->string form (list 'eval-string (cadadr arg))))))
+
+		       ((list)
+			(if (lint-every? (lambda (p)        ;  (eval (list '* 2 x)) -> (* 2 (eval x))
+					   (or (symbol? p)
+					       (code-constant? p)))
+					 (cdr arg))
+			    (lint-format "perhaps ~A" caller
+					 (lists->string form
+							(map (lambda (p)
+							       (if (and (len>1? p)
+									(memq (car p) '(quote #_quote)))
+								   (cadr p)
+								   (if (code-constant? p)
+								       p
+								       (list 'eval p))))
+							     (cdr arg))))))))))
+	      ((3)
+	       (let ((arg (cadr form))
+		     (e (caddr form)))
+		 (if (and (not (code-constant? e)) ; error reported elsewhere
+			  (pair? arg)
+			  (memq (car arg) '(quote #_quote)))
+		     (lint-format "perhaps ~A" caller   ;  (eval 'x env) -> (env 'x)
+				  (lists->string form
+						 (if (symbol? (cadr arg))
+						     (list e arg)
+						     (cons 'with-let (cons e (unbegin (cadr arg))))))))))))
+	  (hash-special 'eval sp-eval))
+
+	;; ---------------- fill! etc ----------------
+	(let ()
+	  (define (sp-fill! caller head form env)
+	    (if (and (pair? (cdr form))
+		     (code-constant? (cadr form)))
+		(lint-format "~A is a constant, so ~A is problematic" caller
+			     (cadr form)
+			     (truncated-list->string form)))
+	    (if (= (length form) 5)
+		(check-start-and-end caller head (cdddr form) form env)))
+	  (for-each (lambda (f)
+		      (hash-special f sp-fill!))
+		    '(fill! string-fill! list-fill! vector-fill!)))
+
+	;; ---------------- write-string ----------------
+	(let ()
+	  (define (sp-write-string caller head form env)
+	    (cond ((not (len>1? form)))
+
+		  ((= (length form) 4)
+		   (check-start-and-end caller 'write-string (cddr form) form env))
+
+		  ((and (len>1? (cdr form))
+			(pair? (caddr form))
+			(eq? (caaddr form) 'current-output-port))
+		   (lint-format "(current-output-port) is the default port for ~A: ~A" caller head form))
+
+		  ((equal? (cadr form) (string #\newline))
+		   (lint-format "perhaps ~A" caller (lists->string form (cons 'newline (cddr form)))))
+
+		  ((equal? (cadr form) "")
+		   (lint-format "~A is pointless" caller form))))
+
+	(hash-special 'write-string sp-write-string))
+
+	;; ---------------- read-line ----------------
+	(let ()
+	  (define (sp-read-line caller head form env)
+	    (if (and (= (length form) 3)
+		     (code-constant? (caddr form))
+		     (not (boolean? (caddr form))))   ;  (read-line in-port 'concat)
+		(lint-format "the third argument should be boolean (#f=default, #t=include trailing newline): ~A" caller form)
+		(if (and (pair? (cdr form))
+			 (pair? (cadr form))
+			 (eq? (caadr form) 'current-input-port))
+		    (lint-format "(current-input-port) is the default port for ~A: ~A" caller head form))))
+	  (hash-special 'read-line sp-read-line))
+
+	;; ---------------- string-length ----------------
+	(let ()
+	  (define (sp-string-length caller head form env)
+	    (when (len=2? form)
+	      (if (string? (cadr form))              ;  (string-length "asdf") -> 4
+		  (lint-format "perhaps ~A -> ~A" caller (truncated-list->string form) (string-length (cadr form)))
+		  (if (and (len>1? (cadr form))       ;  (string-length (make-string 3)) -> 3
+			   (eq? (caadr form) 'make-string))
+		      (lint-format "perhaps ~A" caller (lists->string form (cadadr form)))))))
+
+	  (hash-special 'string-length sp-string-length))
+
+	;; ---------------- vector-length ----------------
+	(let ()
+	  (define (sp-vector-length caller head form env)
+	    (when (len=2? form)
+	      (if (vector? (cadr form))
+		  (lint-format "perhaps ~A -> ~A" caller (truncated-list->string form) (vector-length (cadr form)))
+		  (let ((arg (cadr form)))
+		    (if (len>1? arg)
+			(case (car arg)
+			  ((make-vector)                          ;  (vector-length (make-vector 10)) -> 10
+			   (lint-format "perhaps ~A" caller (lists->string form (cadr arg))))
+			  ((copy vector-copy)
+			   (if (proper-list? arg)
+			       (lint-format "perhaps ~A" caller   ;   (vector-length (copy arr)) -> (vector-length arr)
+					    (lists->string form   ;   (vector-length (vector-copy arr start end)) -> (- end start)
+							   (if (null? (cddr arg))
+							       (list 'vector-length (cadr arg))
+							       (if (eq? (car arg) 'copy)
+								   (list 'vector-length (caddr arg))
+								   (let ((start (caddr arg))
+									 (end (if (null? (cdddr arg))
+										  (list 'vector-length (cadr arg))
+										  (cadddr arg))))
+								     (list '- end start))))))))))))))
+	  (hash-special 'vector-length sp-vector-length))
+
+	;; ---------------- dynamic-wind ----------------
+	(let ()
+	  (define (sp-dw caller head form env)
+	    (when (= (length form) 4)
+	      (let ((init (cadr form))
+		    (body (caddr form))
+		    (end (cadddr form))
+		    (empty 0))
+		;; (equal? init end) as a mistake doesn't seem to happen
+
+		(when (and (len>1? init)
+			   (eq? (car init) 'lambda))
+		  (if (not (null? (cadr init)))
+		      (lint-format "dynamic-wind init function should be a thunk: ~A" caller init))
+		  (if (pair? (cddr init))
+		      (let ((last-expr (last-ref init)))
+			(if (not (pair? last-expr))
+			    (if (null? (cdddr init))
+				(set! empty 1))
+			    (unless (side-effect? last-expr env)
+			      (if (null? (cdddr init))
+				  (set! empty 1))    ;  (dynamic-wind (lambda () (+)) (lambda () (list)) (lambda () #f))
+			      (lint-format "this could be omitted: ~A in ~A" caller last-expr init))))))
+
+		(if (and (pair? body)
+			 (eq? (car body) 'lambda))
+		    (if (not (null? (cadr body)))
+			(lint-format "dynamic-wind body function should be a thunk: ~A" caller body))
+		    (set! empty 3)) ; don't try to access body below
+
+		(when (and (len>1? end)
+			   (eq? (car end) 'lambda))
+		  (if (not (null? (cadr end)))
+		      (lint-format "dynamic-wind end function should be a thunk: ~A" caller end))
+		  (if (pair? (cddr end))
+		      (let ((last-expr (last-ref end)))
+			(if (not (pair? last-expr))
+			    (if (null? (cdddr end))
+				(set! empty (+ empty 1)))
+			    (unless (side-effect? last-expr env) ; or if no side-effects in any (also in init)
+			      (if (null? (cdddr end))
+				  (set! empty (+ empty 1)))
+			      (lint-format "this could be omitted: ~A in ~A" caller last-expr end)))
+			(if (= empty 2)          ;  (dynamic-wind (lambda () #f) (lambda () #()) (lambda () #f)) -> #()
+			    (lint-format "this dynamic-wind is pointless, ~A" caller
+					 (lists->string form (if (null? (cdddr body)) (caddr body) (cons 'begin (cddr body))))))))))))
+	  (hash-special 'dynamic-wind sp-dw))
+
+	;; ---------------- with-output-to-string ----------------
+	(let ()
+	  (define (sp-wots caller head form env)
+	    ;; (with-output-to-string (lambda () (display object)))             -> (object->string object #f)
+	    ;; (with-output-to-string (lambda () (write (car defs)) (newline))) -> (format #f "~S~%" (car defs))
+	    ;; (with-output-to-string (lambda () (write answer)))               -> (object->string answer)
+	    (when (and (len=2? form)
+		       (len>1? (cadr form))
+		       (eq? (caadr form) 'lambda)
+		       (null? (cadadr form)))
+	      (let ((body (cddadr form)))
+		(when (and (pair? body)
+			   (len=2? (car body))
+			   (memq (caar body) '(write display))) ; write-char write-string never happen
+		  (if (null? (cdr body))
+		      (lint-format "perhaps ~A" caller
+				   (lists->string form (cons 'object->string
+							     (cons (cadar body)
+								   (if (eq? (caar body) 'display) '(#f) ())))))
+		      (if (and (len=1? (cdr body))
+			       (len=1? (cadr body))
+			       (eq? (caadr body) 'newline))
+			  (lint-format "perhaps ~A" caller
+				       (lists->string form
+						      (list 'format #f
+							    (if (eq? (caar body) 'display) "~A~%" "~S~%")
+							    (cadar body))))))))))
+	  (hash-special 'with-output-to-string sp-wots))
+
+	;; ---------------- help ----------------
+	(hash-special 'help
+	  (lambda (caller head form env)
+	    (if (and (not (var-member 'help env))
+		     (len=2? form)
+		     (string? (cadr form)))
+		(lint-format "s7's help function takes a symbol or a procedure as its argument: ~A" caller (truncated-list->string form)))))
+
+#|
+	;; ---------------- immutable! ----------------
+	(hash-special 'immutable!
+	  (lambda (caller head form env)
+	    (when (and (not (var-member 'immutable! env))
+		       (len=2? form))
+	      (let ((arg (cadr form)))
+		;; here we need to distinguish arg=symbol whose value is a sequence, arg=quoted symbol is ok etc
+		))))
+|#
+
+	;; ---------------- curlet ----------------
+	(hash-special 'curlet
+	  (lambda (caller head form env)
+	    (for-each (lambda (v)
+			(set! (var-ref v) (+ (var-ref v) 1)))
+		      env)))
+
+
+	;; ---------------- *s7* ----------------
+	(hash-special '*s7*
+	 (let ((s7-fields (let ((h (make-hash-table)))
+			    (for-each (lambda (f)
+					(hash-table-set! h f #t))
+				      '(stack-top stack-size stacktrace-defaults heap-size free-heap-size major-version minor-version
+				        gc-freed gc-protected-objects gc-total-freed gc-info file-names filenames rootlet-size c-types safety
+					undefined-identifier-warnings undefined-constant-warnings gc-stats max-heap-size
+					max-port-data-size max-stack-size cpu-time catches stack max-string-length
+					max-format-length max-list-length max-vector-length max-vector-dimensions
+					default-hash-table-length initial-string-port-length default-rationalize-error
+					default-random-state equivalent-float-epsilon hash-table-float-epsilon print-length
+					bignum-precision memory-usage float-format-precision history history-enabled
+					history-size profile profile-info profile-prefix autoloading? accept-all-keyword-arguments
+					muffle-warnings? most-positive-fixnum most-negative-fixnum output-port-data-size debug version
+					gc-temps-size gc-resize-heap-fraction gc-resize-heap-by-4-fraction openlets expansions?
+					number-separator symbol-quote? symbol-printer))
+			    h)))
+	   (lambda (caller head form env)
+	     (if (len=2? form)
+		 (let ((arg (cadr form)))
+		   (if (and (len>1? arg)
+			    (memq (car arg) '(quote #_quote))
+			    (symbol? (cadr arg))            ;  (*s7* 'vector-print-length)
+			    (not (hash-table-ref s7-fields (cadr arg))))
+		       (lint-format "unknown *s7* field: ~A" caller arg)))))))
+
+	;; ---------------- make-hash-table ----------------
+	(hash-special 'make-hash-table
+	 (lambda (caller head form env)
+	   (when (pair? (cdr form))                         ; (make-hash-table -1)
+	     (when (and (integer? (cadr form)) (<= (cadr form) 0))
+	       (lint-format "make-hash-table length: ~S?" caller (cadr form)))
+	     (when (pair? (cddr form))
+	       (let ((checker (caddr form)))
+		 (if (and (symbol? checker)               ; (make-hash-table 8 call/cc)
+			  (hash-table-ref built-in-functions checker)
+			  (not (memq checker '(eq? eqv? equal? equivalent? char=? char-ci=? string=? string-ci=? =))))
+		     (lint-format "make-hash-table function, ~A, is not a hash function" caller checker)))))))
+
+	;; ---------------- cond-expand ----------------
+	(let ()
+	  (define (sp-cond-expand caller head form env)
+	    (if (lint-every? (lambda (c)
+			       (not (len>1? c)))
+			     (cdr form))
+		(lint-format "pointless cond-expand: ~A" caller (truncated-list->string form))
+		(for-each (lambda (c)
+			    (if (not (or (symbol? (car c))
+					 (and (pair? (car c))
+					      (memq (caar c) '(and or not library)))))
+				(lint-format "messed up cond-expand clause: ~A" caller (truncated-list->string c))
+				(if (and (pair? (car c))
+					 (eq? (caar c) 'library))
+				    (lint-format "the cond-expand 'library' option is not implemented: ~A" caller (truncated-list->string c)))))
+			  (cdr form))))
+	  (hash-special 'cond-expand sp-cond-expand))
+
+	;; ---------------- macroexpand ----------------
+	(let ()
+	  (define (sp-macroexpand caller head form env)
+	    (let ((arg (and (len=1? (cdr form))
+			    (cadr form))))
+	      (unless (and (pair? arg)
+			   (symbol? (car arg))
+			   (or (any-macro? (car arg) env)
+			       (macro? (symbol->value (car arg))))) ; macro? includes bacro?
+		(lint-format "macroexpand's argument should be an expression whose car is a macro: ~A" caller (truncated-list->string form)))))
+	  (hash-special 'macroexpand sp-macroexpand))
+
+	;; ---------------- deprecated funcs ----------------
+	(let ((deprecated-ops '((global-environment . rootlet)
+				(current-environment . curlet)
+				(make-procedure-with-setter . dilambda)
+				(procedure-with-setter? . dilambda?)
+				(symbol-setter . setter)
+				(make-keyword . string->keyword)
+				(make-random-state . random-state))))
+
+	  (define (sp-deprecate caller head form env)  ;  (make-random-state 123 432)
+	    (lint-format "~A is deprecated; use ~A" caller head (cond ((assq head deprecated-ops) => cdr))))
+
+	  (for-each (lambda (op)
+		      (hash-special (car op) sp-deprecate))
+		    deprecated-ops))
+
+	;; ---------------- eq null eqv equal ----------------
+	(let ()
+	  (define sp-null
+	    (let ((spellings
+		   '((null . null?) (eq . eq?) (eqv . eqv?) (equal . equal?) (not? . not)  ; (null (cdr...))
+		     (set-car . set-car!) (set-cdr . set-cdr!) (list-set . list-set!) (vector-set . vector-set!) (string-set . string-set!))))
+	      (lambda (caller head form env)
+		(if (not (var-member head env))          ;  (if (null (cdr x)) 0)
+		    (lint-format "misspelled '~A in ~A?" caller (cdr (assq head spellings)) form)))))
+	  (for-each (lambda (f)
+		      (hash-special f sp-null))
+		    '(null eq eqv equal set-car set-cdr list-set vector-set string-set)))
+	  ;; memq? is in scheme48
+
+	(hash-special 'nth
+		      (lambda (caller head form env)
+			(if (not (var-member head env))
+			    (if (integer? (caddr form))
+				(lint-format "perhaps use list-ref here: ~A" caller form)
+				(if (integer? (cadr form))
+				    (lint-format "perhaps ~A" caller (lists->string form (cons 'list-ref (reverse (cdr form))))))))))
+
+	(hash-special 'sort
+		      (lambda (caller head form env)
+			(if (and (= (length form) 3)
+				 (not (and (pair? (cadr form))
+					   (eq? (caadr form) 'lambda))))
+			    (if (and (pair? (cadr form))
+				     (eq? (caadr form) 'map))
+				(lint-format "use sort! here: ~A" caller (truncated-list->string form))
+				(lint-format "perhaps ~A" caller
+					     (truncated-lists->string form
+								      (list 'sort! (list 'copy (cadr form)) (caddr form))))))))
+
+	;; ---------------- string-index ----------------
+	(let ()
+	  (define (sp-string-index caller head form env)
+	    (if (and (len>1? (cdr form))
+                     (not (var-member 'string-index env))
+		     (or (char? (caddr form))
+			 (let ((sig (arg-signature (caddr form) env)))
+			   (and (pair? sig)
+				(eq? (car sig) 'char?)))))
+		(lint-format "perhaps ~A" caller          ;  (string-index path #\/) -> (char-position #\/ path)
+			     (lists->string form `(char-position ,(caddr form) ,(cadr form) ,@(cdddr form))))))
+	  (hash-special 'string-index sp-string-index))
+
+	;; ---------------- cons* ----------------
+	(let ()
+	  (define (sp-cons* caller head form env)
+	    (unless (var-member 'cons env)
+	      (case (length form)
+		((2) (lint-format "perhaps ~A" caller (lists->string form (cadr form))))
+		((3) (lint-format "perhaps ~A" caller
+				  (lists->string form      ;  cons* x y) -> (cons x y)
+						 (if (any-null? (caddr form))
+						     (list 'list (cadr form))
+						     (cons 'cons (cdr form))))))
+		((4) (lint-format "perhaps ~A" caller
+				  (lists->string form      ;  (cons* (symbol->string v) " | " (w)) -> (cons (symbol->string v) (cons " | " (w)))
+						 (if (any-null? (cadddr form))
+						     (list 'list (cadr form) (caddr form))
+						     (list 'cons (cadr form) (cons 'cons (cddr form))))))))))
+	  (hash-special 'cons* sp-cons*))
+
+	;; ---------------- the-environment etc ----------------
+	(let ((other-names '((->string . object->string)
+			     (any . any?)
+			     (arithmetic-shift . ash)
+			     (bit-and . logand)
+			     (bit-not . lognot)
+			     (bit-or . logior)
+			     (bit-xor . logxor)
+			     (bitwise-and . logand)
+			     (bitwise-bit-set? . logbit?)
+			     (bitwise-ior . logior)
+			     (bitwise-not . lognot)
+			     (bitwise-xor . logxor)
+			     (bytevector . byte-vector)
+			     (bytevector-copy . copy)
+			     (bytevector-fill! . fill!)
+			     (bytevector-length . length)
+			     (bytevector? . byte-vector?)
+			     (bytevector-ref . byte-vector-ref)
+			     (bytevector-set! . byte-vector-set!)
+			     (bytevector-u8-ref . byte-vector-ref)
+			     (bytevector-u8-set! . byte-vector-set!)
+			     (byte-vector-length . length)
+			     (copy-list . copy)
+			     (copy-string . copy)
+			     (copy-vector . copy)
+			     (environment-copy . copy)
+			     (environment-ref . let-ref)
+			     (environment-set! . let-set!)
+			     (environment? . let?)
+			     (every . every?)
+			     (exact-integer? . integer?)
+			     (f64vector . float-vector)
+			     (f64vector-length . length)
+			     (f64vector-ref . float-vector-ref)
+			     (f64vector-set! . float-vector-set!)
+			     (f64vector? . float-vector?)
+			     (fixnum? . integer?)
+			     (floor-remainder . modulo)
+			     (flo:vector-length . length)
+			     (fluid-let . let-temporarily)
+			     (hash-for-each . for-each)
+			     (hash-ref . hash-table-ref)
+			     (hash-set! . hash-table-set!)     ; Guile
+			     (hash-table-exists? . hash-table-ref)
+			     (hash-table-get . hash-table-ref) ; Gauche
+			     (hash-table-copy . copy)
+			     (hash-table-num-entries . hash-table-entries)
+			     (hash-table-put! . hash-table-set!)
+			     (hashq-ref . hash-table-ref)
+			     (hashq-set! . hash-table-set!)
+			     (hashtable-copy . copy)
+			     (hashtable-get . hash-table-ref)
+			     (hashtable-put! . hash-table-set!)
+			     (hashtable-set! . hash-table-set!)
+			     (hashtable-size . hash-table-entries)
+			     (hashtable? . hash-table?)        ; Bigloo
+			     (hashv-ref . hash-table-ref)
+			     (hashv-set! . hash-table-set!)
+			     (interaction-environment . curlet)
+			     (intern . string->symbol)
+			     ;(list-copy . copy)
+			     ;(list-fill! . fill!)
+			     (list-length . length)
+			     (list-reverse . reverse)
+			     (make-bytevector . make-byte-vector)
+			     (make-f64vector . make-float-vector)
+			     (make-hashtable . make-hash-table)
+			     (make-s64vector . make-int-vector)
+			     (make-u8vector . make-byte-vector)
+			     (nreverse . reverse!)
+			     (open-input-bytevector . open-input-string)
+			     (open-output-bytevector . open-output-string)
+			     (peek-u8 . peek-char)
+			     (procedure-environment . funclet)
+			     (raise . error)
+			     (raise-continuable . error)
+			     (read-u8 . read-byte)
+			     (reverse-u8vector . reverse)
+			     (reverse-string . reverse)
+			     (s64vector . int-vector)
+			     (s64vector-length . length)
+			     (s64vector-ref . int-vector-ref)
+			     (s64vector-set! . int-vector-set!)
+			     (s64vector? . int-vector?)
+			     (some . any?)
+			     (some? . any?)
+			     ;(string-copy . copy)
+			     ;(string-fill! . fill!)
+			     (string-for-each . for-each)
+			     (string-reverse! . reverse!)
+			     (string-reverse . reverse)
+			     (symbol-name . symbol->string)
+			     (system-global-environment . rootlet)
+			     (the-environment . curlet)
+			     (truncate-quotient . quotient)
+			     (truncate-remainder . remainder)
+			     (u8-ready? . char-ready?)
+			     (u8vector . byte-vector)
+			     (u8vector-copy . copy)
+			     (u8vector? . byte-vector?)
+			     (u8vector-length . length)
+			     (u8vector-fill! . fill!)
+			     (u8vector-ref . byte-vector-ref)
+			     (u8vector-set! . byte-vector-set!)
+			     (unquote-splicing apply values ...)
+			     (unspecified . #<unspecified>)
+			     (unspecific . #<unspecified>)
+			     (user-global-environment . rootlet)
+			     (user-initial-environment . rootlet)
+			     ;(vector-copy . copy)
+			     ;(vector-fill! . fill!)
+			     (vector-for-each . for-each)
+			     (vector-reverse! . reverse!)
+			     (write-bytevector . write-string)
+			     (write-simple . write)
+			     (write-u8 . write-byte))))
+
+	  (define (sp-other-names caller head form env)
+	    (if (not (var-member head env))
+		(let ((counts (or (hash-table-ref other-names-counts head) 0))
+		      (our-name (cdr (assq head other-names))))
+		  (when (< counts 2)
+		    (hash-table-set! other-names-counts head (+ counts 1))
+		    (lint-format "~A is probably ~A" caller head our-name))
+		  (cond ((hash-table-ref special-case-functions our-name)
+			 => (lambda (f)
+			      (f caller our-name (cons our-name (cdr form)) env)))))))
+	  (for-each (lambda (f)
+		      (hash-special (car f) sp-other-names))
+		    other-names))
+
+	(hash-special '1+
+	 (lambda (caller head form env)
+	   (if (and (not (var-member '1+ env))
+		    (pair? (cdr form)))
+	       (lint-format "perhaps ~A" caller (lists->string form (list '+ (cadr form) 1))))))
+
+	(let ()
+	  (define (sp-1- caller head form env)
+	    (if (and (not (var-member '-1+ env))
+		     (pair? (cdr form)))
+		(lint-format "perhaps ~A" caller (lists->string form (list '- (cadr form) 1)))))
+
+	  (hash-special '-1+ sp-1-)
+	  (hash-special '1- sp-1-))
+
+	(let ()
+	  (define (sp-dumb-relop caller head form env)
+	    (if (not (var-member (car form) env))
+		(lint-format "perhaps ~A" caller
+			     (lists->string form
+					    (simplify-boolean (undumb form) env () ())))))
+	  (for-each (lambda (f)
+		      (hash-special f sp-dumb-relop))
+		    '(fix:= fx= flo:= fl= fix:< fx< flo:< fl< fix:> fx> flo:> fl> fix:<= fx<= flo:<= fl<= fix:>= fx>= flo:>= fl>=
+		      bignum= bignum< bignum<= bignum> bignum>= bignum-negative? bignum-zero?)))
+
+	(let ()
+	  (define (sp-dumb-fop caller head form env)
+	    (if (not (var-member (car form) env))
+		(lint-format "perhaps ~A" caller (lists->string form (undumb form)))))
+
+	  (for-each (lambda (f)
+		      (hash-special f sp-dumb-fop))
+		    '(flo:sin flsin flo:cos flcos flo:tan fltan flo:atan flatan flo:exp flexp flo:log fllog flo:sqrt flsqrt
+		      fxlogand fxlogior fxlogxor fxlognot
+		      bignum-expt bignum-quotient bignum-magnitude bignum-abs bignum-remainder)))
+
+
+	;; ---------------- push! pop! ----------------
+	(hash-special 'push!
+	 (lambda (caller head form env) ; not predefined
+	   (if (= (length form) 3)
+	       (set-set (caddr form) caller form env))))
+
+	(hash-special 'pop!
+	 (lambda (caller head form env) ; also not predefined
+	   (if (len=2? form)
+	       (set-set (cadr form) caller form env))))
+
+	;; ---------------- receive ----------------
+	(hash-special 'receive
+	 (lambda (caller head form env) ; this definition comes from Guile
+	   (if (and (> (length form) 3)
+		    (not (var-member 'receive env)))
+	       ((hash-table-ref special-case-table 'call-with-values)
+		caller 'call-with-values
+		`(call-with-values
+		     (lambda () ,(caddr form))
+		   (lambda ,(cadr form) ,@(cdddr form)))
+		env))))
+
+	;; ---------------- and=> ----------------
+	(hash-special 'and=>
+	 (lambda (caller head form env)  ;  (and=> (ref w k) v) -> (cond ((ref w k) => v) (else #f))
+	   (when (and (= (length form) 3)
+		      (not (var-member 'and=> env)))
+	     (lint-format "perhaps ~A" caller (lists->string form `(cond (,(cadr form) => ,(caddr form)) (else #f)))))))
+
+	;; ---------------- and-let* ----------------
+	(let ()
+	  (define (sp-and-let caller head form env)
+	    (when (and (> (length form) 2)
+		       (not (var-member 'and-let* env)))
+	      (let loop ((bindings (cadr form)))
+		(cond ((pair? bindings)
+		       (if (binding-ok? caller 'and-let* (car bindings) env #f)
+			   (loop (cdr bindings))))
+		      ((not (null? bindings))
+		       (lint-format "~A variable list is not a proper list? ~S" caller 'and-let* bindings))
+		      ((and (len=1? (cadr form))           ; (and-let* ((x (f y))) (abs x)) -> (cond ((f y) => abs))
+			    (pair? (cddr form)))
+		       (lint-format "perhaps ~A" caller
+				    (lists->string form   ;  (and-let* ((x (f y))) (abs x)) -> (cond ((f y) => abs))
+						   (if (and (null? (cdddr form))
+							    (len=2? (caddr form))
+							    (eq? (caaadr form) (cadr (caddr form))))
+						       (list 'cond (list (cadar (cadr form)) '=> (caaddr form)))
+						       `(cond (,(cadar (cadr form)) => (lambda (,(caaadr form)) ,@(cddr form))))))))))))
+	  (hash-special 'and-let* sp-and-let))
+
+	special-case-table))
+    ;; end special-case-functions
+    ;; ----------------------------------------
+
+
+    (define (unused-parameter? x) #t)
+    (define (unused-set-parameter? x) #t)
+
+    (define check-args
+      ;; check for obvious argument type problems
+      ;; caller = overall caller, head = current caller, checkers = proc or list of procs for checking args
+      (letrec ((every-compatible?
+		(lambda (type1 type2)
+		  (if (symbol? type1)
+		      (if (symbol? type2)
+			  (compatible? type1 type2)
+			  (and (pair? type2)                   ; here everything has to match
+			       (compatible? type1 (car type2))
+			       (every-compatible? type1 (cdr type2))))
+		      (and (pair? type1)                       ; here any match is good
+			   (or (compatible? (car type1) type2)
+			       (any-compatible? (cdr type1) type2))))))
+
+	       (check-checker
+		(lambda (checker at-end)
+		  (case checker
+		    ((integer:real?) (if at-end 'real? 'integer?))
+		    ((integer:any?)  (or at-end 'integer?))
+		    (else))))
+
+	       (any-checker?
+		(lambda (types arg)
+		  (if (and (symbol? types)
+			   (not (eq? types 'values)))
+		      ((symbol->value types *e*) arg) ; not (rootlet) for *e* since we have some local checkers: unused-parameter? etc
+		      (and (pair? types)
+			   (or (any-checker? (car types) arg)
+			       (any-checker? (cdr types) arg))))))
+
+	       (report-arg-trouble
+		(lambda (caller form head arg-number checker arg uop env)
+		  (when (and (or arg (not (eq? checker 'output-port?)))
+			     (not (and (eq? checker 'string?)
+				       (len>1? arg)
+				       (eq? (car arg) 'format)
+				       (not (null? (cadr arg)))))  ; other case involves a symbol that is an output-port
+			     (not (and (pair? arg)
+				       (eq? (car arg) 'length))))  ; same for length
+		    (let ((op (if (and (eq? checker 'real?)
+				       (eq? uop 'number?))
+				  'complex?
+				  uop))
+			  (prettify-arg-number (lambda (argn)
+						 (if (or (not (= argn 1))
+							 (pair? (cddr form)))
+						     (format #f "~:D " argn)
+						     ""))))
+		      (if (and (pair? op)
+			       (member checker op any-compatible?))
+			  (unless (or (not *report-sloppy-assoc*)
+				      (and (pair? arg)
+					   (memq (car arg) '(int-vector-ref float-vector-ref system)))
+				      (var-member :catch env))   ; (round (char-position #\a "asb"))
+			    (let ((other (remove-if (lambda (o) (any-compatible? checker o)) op)))
+			      (when (pair? other)
+				(lint-format "in ~A,~%~NC~A's ~Aargument should be ~A, but ~A might also be ~A" caller
+					     (truncated-list->string form)
+					     (+ lint-left-margin 4) #\space
+					     head
+					     (prettify-arg-number arg-number)
+					     (prettify-checker-unq checker)
+					     (truncated-list->string arg)
+					     (prettify-checker (car other))))))
+			  (if *report-laconically*
+			      (lint-format "~A's ~Aargument should be ~A, but ~A is ~A" caller
+				       head
+				       (prettify-arg-number arg-number)
+				       (prettify-checker-unq checker)
+				       (truncated-list->string arg)
+				       (prettify-checker op))
+			      (lint-format "in ~A,~%~NC~A's ~Aargument should be ~A, but ~A is ~A" caller
+					   (truncated-list->string form)
+					   (+ lint-left-margin 4) #\space
+					   head
+					   (prettify-arg-number arg-number)
+					   (prettify-checker-unq checker)
+					   (truncated-list->string arg)
+					   (prettify-checker op)))))))))
+
+	(lambda (caller head v form checkers env max-arity)
+	  (when (and *report-func-as-arg-arity-mismatch*
+		     v
+		     (memq (var-ftype v) '(define define* lambda lambda*))
+		     (zero? (var-set v)) ; perhaps this needs to wait for report-usage?
+		     (pair? (var-arglist v)))
+	    (let ((source (var-initial-value v)))
+	      (when (len>2? source)
+		(let ((vhead (cddr source))
+		      (head-arglist (var-arglist v))
+		      (arg-number 1))
+
+		  (when (pair? vhead)
+		    (for-each
+		     (lambda (arg)
+		       ;; only check func if head is var-member and has procedure-source (var-[initial-]value?)
+		       ;;   and arg has known arity, and check only if arg(par) is car, not (for example) cadr of apply
+
+		       (let ((ari (if (symbol? arg)
+				      (arg-arity arg env)
+				      (and (len>1? arg)
+					   (eq? (car arg) 'lambda)
+					   (let ((len (length (cadr arg))))
+					     (and (integer? len)
+						  (cons (abs len)
+							(if (negative? len) 500000 len)))))))
+			     (par (and (> (length head-arglist) (- arg-number 1))
+				       (list-ref head-arglist (- arg-number 1)))))
+			 (when (and (symbol? par)
+				    (pair? ari)
+				    (or (> (car ari) 0)
+					(< (cdr ari) 20)))
+
+			   ;; fwalk below needs to be smart about tree walking so that
+			   ;;   it does not confuse (c) in (lambda (c)...) with a call on the function c.
+			   ;; check only if current parameter name is not shadowed
+
+			   (let fwalk ((sym par) (tree vhead))
+			     (when (pair? tree)
+			       (if (eq? (car tree) sym)
+				   (let ((args (- (length tree) 1)))
+				     (if (> (car ari) args)
+					 (lint-format "~A's parameter ~A is passed ~A and called ~A, but ~A needs ~A argument~P" caller
+						      head par
+						      (truncated-list->string arg)
+						      (truncated-list->string tree)
+						      (truncated-list->string arg)
+						      (car ari) (car ari))
+					 (if (> args (cdr ari))
+					     (lint-format "~A's parameter ~A is passed ~A and called ~A, but ~A takes only ~A argument~P" caller
+							  head par
+							  (truncated-list->string arg)
+							  (truncated-list->string tree)
+							  (truncated-list->string arg)
+							  (cdr ari) (cdr ari)))))
+				   (case (car tree)
+				     ((let let*)
+				      (if (len>1? (cdr tree))
+					  (let ((vs ((if (symbol? (cadr tree)) caddr cadr) tree)))
+					    (if (not (lint-any? (lambda (a) (or (not (pair? a)) (eq? sym (car a)))) vs))
+						(fwalk sym ((if (symbol? (cadr tree)) cdddr cddr) tree))))))
+
+				     ((do letrec letrec*)
+				      (if (and (len>1? (cdr tree))
+					       (not (lint-any? (lambda (a) (or (not (pair? a)) (eq? sym (car a)))) (cadr tree))))
+					  (fwalk sym (cddr tree))))
+
+				     ((lambda lambda*)
+				      (if (and (len>1? (cdr tree))
+					       (not (lint-any? (lambda (a) (eq? sym a)) (args->proper-list (cadr tree)))))
+					  (fwalk sym (cddr tree))))
+
+				     ((define define-constant)
+				      (if (and (not (eq? sym (cadr tree)))
+					       (pair? (cadr tree))
+					       (not (lint-any? (lambda (a) (eq? sym a)) (args->proper-list (cdadr tree)))))
+					  (fwalk sym (cddr tree))))
+
+				     ((define* define-macro define-macro* define-expansion define-bacro define-bacro*)
+				      (if (and (len>1? (cdr tree))
+					       (pair? (cadr tree))
+					       (not (lint-any? (lambda (a) (eq? sym a)) (args->proper-list (cdadr tree)))))
+					  (fwalk sym (cddr tree))))
+
+				     ((quote #_quote) #f)
+
+				     ((case)
+				      (if (len>1? (cdr tree))
+					  (for-each (lambda (c) (fwalk sym (cdr c))) (cddr tree))))
+
+				     (else
+				      (if (pair? (car tree))
+					  (fwalk sym (car tree)))
+				      (if (pair? (cdr tree))
+					  (for-each (lambda (p) (fwalk sym p)) (cdr tree))))))))))
+
+		       (set! arg-number (+ arg-number 1)))
+		     (cdr form)))))))
+
+	  (when (pair? checkers)
+	    (let ((arg-number 1)
+		  (flen (- (length form) 1)))
+
+	      (define (check-cond-arg expr checker)
+		(unless (symbol? expr)
+		  (let ((op (->lint-type expr)))
+		    (when (pair? op)
+		      (set! op (remove-one 'boolean? op)) ; this is for cond test, no result -- returns test if not #f, so it can't be #f!
+		      (if (null? (cdr op))
+			  (set! op (car op))))
+		    (if (not (or (memq op '(#f #t values))
+				 (every-compatible? checker op)))
+			(report-arg-trouble caller form head arg-number checker expr op env)))))
+	      (call-with-exit
+	       (lambda (done)
+		 (for-each
+		  (lambda (arg)
+		    (let ((checker (check-checker (if (pair? checkers) (car checkers) checkers) (= arg-number flen))))
+		      ;; check-checker only fixes up :at-end cases
+
+		      (define (check-arg expr)
+			(unless (symbol? expr)
+			  (let ((op (->lint-type expr)))
+			    (if (not (or (memq op '(#f #t values))
+					 (every-compatible? checker op)))
+				(report-arg-trouble caller form head arg-number checker expr op env)))))
+		      ;; special case checker?
+		      (if (and (symbol? checker)
+			       (not (memq checker '(unused-parameter? unused-set-parameter?)))
+			       (not (hash-table-ref built-in-functions checker)))
+			  (let ((chk (symbol->value checker)))
+			    (if (and (procedure? chk)
+				     (equal? (arity chk) '(2 . 2)))
+				(catch #t
+				  (lambda ()
+				    (let ((res (chk form arg-number)))
+				      (set! checker #t)
+				      (if (symbol? res)
+					  (set! checker res)
+					  (if (string? res)
+					      (lint-format "~A's argument, ~A, should be ~A" caller head arg res)))))
+				  (lambda (type info)
+				    (set! checker #t))))))
+
+		      (if (and (pair? arg)
+			       (pair? (car arg)))
+			  (let ((rtn (return-type (caar arg) env)))
+			    (if (memq rtn '(boolean? real? integer? rational? number? complex? float? keyword? symbol? null? char?))
+				(lint-format "~A's argument ~A looks odd: ~A returns ~A which is not applicable" caller    ;  (cons ((pair? x) 2) y)
+					     head
+					     (truncated-list->string arg)
+					     (caar arg) rtn))))
+
+		      (when (or (pair? checker)
+				(symbol? checker)) ; otherwise ignore type check on this argument (#t -> anything goes)
+			(if arg
+			    (case checker
+			      ((unused-parameter?)     ;  (define (f5 a . b) a) (f5 1 2)
+			       (lint-format "~A's parameter ~A is not used, but a value is passed: ~A" caller
+					    head arg-number
+					    (truncated-list->string arg)))
+			      ((unused-set-parameter?) ;  (define (f21 x y) (set! x 3) (+ y 1)) (f21 (+ z 1) z)
+			       (lint-format "~A's parameter ~A's value is not used, but a value is passed: ~A" caller
+					    head arg-number
+					    (truncated-list->string arg)))))
+
+			(if (not (pair? arg))
+			    (let ((val (cond ((not (symbol? arg))
+					      arg)
+					     ((constant? arg)
+					      (symbol->value arg))
+					     ((and (hash-table-ref built-in-functions arg)
+						   (not (var-member :with-let env))
+						   (not (var-member arg env)))
+					      (symbol->value arg *e*))
+					     (else arg))))
+			      (if (not (or (and (symbol? val)
+						(not (keyword? val)))
+					   (any-checker? checker val)))
+				  (let ((op (->lint-type val)))
+				    (unless (or (memq op '(#f #t values))
+						(and (keyword? arg) ; (f :par arg) where f is define*
+						     (var? v)
+						     (memq (var-ftype v) '(define* lambda*))))
+				      (report-arg-trouble caller form head arg-number checker arg op env)))))
+
+			    (case (car arg)
+			      ((quote #_quote)   ; '1 -> 1
+			       (when (pair? (cdr arg))
+				 (let ((op (if (pair? (cadr arg)) 'list?
+					       (if (symbol? (cadr arg))
+						   'symbol?
+						   (->lint-type (cadr arg))))))
+				   ;; arg is quoted expression
+				   (if (not (or (memq op '(#f #t values))
+						(every-compatible? checker op)))
+				       (report-arg-trouble caller form head arg-number checker arg op env)))))
+
+			      ;; arg is an expression
+			      ((begin let let* letrec letrec* with-let)
+			       (let ((len (length arg)))
+				 (if (> len 1)
+				     (check-arg (and (pair? (cdr arg))
+						     (list-ref arg (- len 1)))))))
+
+			      ((if)
+			       (if (len>1? (cdr arg))
+				   (let ((f (if (pair? (cdddr arg)) (cadddr arg))))
+				     (check-arg (caddr arg))
+				     (when (and f (not (symbol? f)))
+				       (check-arg f)))))
+
+			      ((dynamic-wind catch)
+			       (if (= (length arg) 4)
+				   (let ((f (caddr arg)))
+				     (if (and (pair? f)
+					      (eq? (car f) 'lambda))
+					 (let ((len (length f)))
+					   (if (> len 2)
+					       (check-arg (list-ref f (- len 1)))))))))
+
+			      ((do)
+			       (if (len>1? (cdr arg))
+				   (let ((end+res (caddr arg)))
+				     (if (pair? end+res)
+					 (check-arg ((if (> (length end+res) 1) last-ref car) end+res)))))) ; car=test which is returned if no result
+
+			      ((case)
+			       (if (len>1? (cdr arg))
+				   (for-each
+				    (lambda (clause)
+				      (if (and (pair? clause)
+					       (> (length clause) 1)
+					       (not (eq? (cadr clause) '=>)))
+					  (check-arg (last-ref clause))))
+				    (cddr arg))))
+
+			      ((cond)
+			       (when (pair? (cdr arg))
+				 (for-each
+				  (lambda (clause)
+				    (if (pair? clause)
+					(if (pair? (cdr clause))
+					    (if (and (not (eq? (cadr clause) '=>))
+						     (proper-list? (cdr clause)))
+						(check-arg (last-ref clause)))
+					    (check-cond-arg (car clause) checker))))
+				  (cdr arg))))
+
+			      ((call/cc call-with-exit call-with-current-continuation)
+			       ;; find func in body (as car of list), check its arg as return value
+			       (when (and (pair? (cdr arg))
+					  (pair? (cadr arg))
+					  (eq? (caadr arg) 'lambda))
+				 (let ((f (cdadr arg)))
+				   (when (and (pair? f)
+					      (len=1? (car f))
+					      (symbol? (caar f)))
+				     (define c-walk
+				       (let ((rtn (caar f)))
+					 (lambda (tree)
+					   (if (len>1? tree)
+					       (if (eq? (car tree) rtn)
+						   (check-arg (if (null? (cdr tree)) () (cadr tree)))
+						   (begin
+						     (c-walk (car tree))
+						     (for-each (lambda (x) (if (pair? x) (c-walk x))) (cdr tree))))))))
+				     (for-each c-walk (cdr f))))))
+
+			      ((values)
+			       (cond ((not (positive? (length arg))))
+
+				     ((null? (cdr arg)) ; #<unspecified>
+				      (if (not (any-checker? checker #<unspecified>))
+					  (report-arg-trouble caller form head arg-number checker arg 'unspecified? env)))
+
+				     ((null? (cddr arg))
+				      (check-arg (cadr arg)))
+
+				     (else
+				      (for-each
+				       (lambda (expr rest)
+					 (check-arg expr)
+					 (set! arg-number (+ arg-number 1))
+					 (if (> arg-number max-arity) (done))
+					 (if (pair? checkers)
+					     (if (null? (cdr checkers))
+						 (done)
+						 (set! checkers (cdr checkers)))))
+				       (cdr arg) (cddr arg))
+				      (check-arg (last-ref arg)))))
+
+			      (else
+			       (let ((op (return-type (car arg) env)))
+				 (when (and (eq? (car arg) 'random) ; (make-byte-vector 2 (random 256)!
+					    (pair? (cdr arg)))      ; (random) in some schemes
+				   (set! op (->lint-type (cadr arg)))
+				   (if (and (eq? checker 'byte?)
+					    (integer? (cadr arg))
+					    (<= 0 (cadr arg) 256))
+				       (set! op 'byte?)))
+				 (let ((v (var-member (car arg) env)))
+				   (when (and v (not (memq form (var-history v))))
+				     (set! (var-history v) (cons form (var-history v)))
+				     (set! (var-refenv v) env)))
+
+				 ;; checker is arg-type, op is expression type (can also be a pair)
+				 (if (and (not (memq op '(#f #t values)))
+					  (not (memq checker '(unused-parameter? unused-set-parameter?)))
+					  (or (not (every-compatible? checker op))
+					      (and (just-constants? arg env) ; try to eval the arg
+						   (catch #t
+						     (lambda ()
+						       (not (any-checker? checker (eval arg))))
+						     (lambda ignore-catch-error-args
+						       #f)))))
+				     (report-arg-trouble caller form head arg-number checker arg op env)))))))
+
+		      (if (pair? checkers)
+			  (if (null? (cdr checkers))
+			      (done)
+			      (set! checkers (cdr checkers)))
+			  (if (memq checker '(unused-parameter? unused-set-parameter?))
+			      (set! checker #t)))
+		      (set! arg-number (+ arg-number 1))
+		      (if (> arg-number max-arity) (done))))
+		  (cdr form)))))))))
+
+    (define check-unordered-exprs
+      (let ((changers (let ((h (make-hash-table)))
+			(for-each (lambda (s)
+				    (hash-table-set! h s #t))
+				  (cons 'set! side-effect-functions))
+			h)))
+#|
+				  '(set!
+				    read read-byte read-char read-line read-string peek-char
+				    write write-byte write-char write-string format display newline
+				    reverse! set-cdr! sort! string-fill! vector-fill! fill!
+				    emergency-exit exit error throw))
+|#
+	(lambda (caller form vals env)
+	  (define (report-trouble)  ;  (let ((x (read-byte)) (y (read-byte))) (- x y))
+	    (lint-format "order of evaluation of ~A's ~A is unspecified, so ~A is trouble" caller
+			 (car form)
+			 (if (memq (car form) '(let letrec do)) "bindings" "arguments")
+			 (truncated-list->string form)))
+	  (let ((reads ())
+		(writes ())
+		(jumps ()))
+	    (call-with-exit
+	     (lambda (return)
+	       (for-each (lambda (p)
+			   (when (and (pair? p)
+				      (hash-table-ref changers (car p))
+				      (not (var-member (car p) env)))
+			     (if (pair? jumps)
+				 (return (report-trouble)))
+
+			     (case (car p)
+
+			       ((read read-char read-line read-byte)
+				(cond ((pair? (cdr p))
+				       (if (memq (cadr p) reads)
+					   (return (report-trouble))
+					   (set! reads (cons (cadr p) reads))))
+				      ((or (not (null? (cdr p)))
+					   (memq () reads))
+				       (return (report-trouble)))
+				      (else
+				       (set! reads (cons () reads)))))
+
+			       ((newline)
+				(cond ((pair? (cdr p))
+				       (if (memq (cadr p) writes)
+					   (return (report-trouble))
+					   (set! writes (cons (cadr p) writes))))
+				      ((or (not (null? (cdr p)))
+					   (memq () writes))
+				       (return (report-trouble)))
+				      (else
+				       (set! writes (cons () writes)))))
+
+			       ((read-string)
+				(if (not (len>1? (cdr p)))
+				    (if (memq () reads)
+					(return (report-trouble))
+					(set! reads (cons () reads)))
+				    (if (memq (caddr p) reads)
+					(return (report-trouble))
+					(set! reads (cons (caddr p) reads)))))
+
+			       ((display write write-char write-string write-byte)
+				(if (pair? (cdr p))
+				    (if (null? (cddr p))
+					(if (memq () writes)
+					    (return (report-trouble))
+					    (set! writes (cons () writes)))
+					(if (or (not (pair? (cddr p)))
+						(memq (caddr p) writes))
+					    (return (report-trouble))
+					    (set! writes (cons (caddr p) writes))))))
+
+			       ((format)
+				(if (and (pair? (cdr p))
+					 (not (string? (cadr p)))
+					 (cadr p)) ; i.e. not #f
+				    (if (memq (cadr p) writes)
+					(return (report-trouble))
+					(set! writes (cons (cadr p) writes)))))
+
+			       ((fill! string-fill! vector-fill!  reverse! sort! set! set-cdr!)
+				;; here there's trouble if cadr used anywhere -- but we need to check for shadowing which is tedious:
+				(if (and (len>1? p)
+					 (lint-any? (lambda (np)
+						      (and (not (eq? np p))
+							   (lint-tree-memq (cadr p) np)
+							   (not (shadowed? (cadr p) np))))
+						    vals))
+				    (return (report-trouble))))
+
+			       ((throw error exit emergency-exit)
+				(if (or (pair? reads)   ; jumps already checked above
+					(pair? writes))
+				    (return (report-trouble))
+				    (set! jumps (cons p jumps)))))))
+			 vals)))))))
+
+    (denote check-call
+      (let ((repeated-args-table (let ((h (make-hash-table)))
+				   (for-each
+				    (lambda (op)
+				      (set! (h op) #t))
+				    '(= / max min < > <= >= - quotient remainder modulo rationalize and or
+					string=? string<=? string>=? string<? string>? string-ci=? string-ci<=? string-ci>=? string-ci<? string-ci>?
+					char=? char<=? char>=? char<? char>? char-ci=? char-ci<=? char-ci>=? char-ci<? char-ci>?
+					boolean=? symbol=?))
+				   h))
+	    (repeated-args-table-2 (let ((h (make-hash-table)))
+				     (for-each
+				      (lambda (op)
+					(set! (h op) #t))
+				      '(= max min < > <= >= and or
+					  string=? string<=? string>=? string<? string>? string-ci=? string-ci<=? string-ci>=? string-ci<? string-ci>?
+					  char=? char<=? char>=? char<? char>? char-ci=? char-ci<=? char-ci>=? char-ci<? char-ci>?
+					  boolean=? symbol=?))
+				     h)))
+	(lambda (caller head form env)
+	  (let ((data (var-member head env)))
+	    (if (and (len>1? (cdr form))
+		     (any-procedure? head data))
+		(check-unordered-exprs caller form (cdr form) env))
+
+	    (if data
+		(let ((fdata (cdr data)))
+		  ;; a local var
+		  (when (symbol? (let-ref fdata 'ftype))
+		    (let ((args (let-ref fdata 'arglist))
+			  (ary (let-ref fdata 'arit))
+			  (sig (var-signature data)))
+		      (when (pair? ary)
+			(let ((opt (cdr ary))
+			      (pargs (if (pair? args)
+					 (proper-list args)
+					 (if (symbol? args)
+					     (list args)
+					     ()))))
+			  (let ((call-args (- (length form) 1))
+				(req (car ary)))
+			    (if (< call-args req)
+				(begin
+				  (for-each (lambda (p)
+					      (if (pair? p)
+						  (let ((v (var-member (car p) env)))
+						    (if v
+							(let ((vals (let-ref (cdr v) 'nvalues)))
+							  (if (pair? vals)
+							      (set! call-args (+ call-args -1 (cadr vals)))))))))
+					    (cdr form))
+				  (if (not (or (>= call-args req)
+					       (lint-tree-memq 'values (cdr form))
+					       (lint-tree-memq 'dilambda (let-ref fdata 'initial-value))))
+				      (lint-format "~A needs ~D argument~A: ~A"
+						   caller head
+						   req (if (> req 1) "s" "")
+						   (truncated-list->string form))))
+				(if (> (- call-args (keywords (cdr form) 0)) opt) ; multiple-values can make this worse, (values)=nothing doesn't apply here
+				    (lint-format "~A has too many arguments: ~A" caller head (truncated-list->string form)))))
+
+			  (unless (let-ref fdata 'allow-other-keys)
+			    (let ((last-was-key #f)
+				  (have-keys 0)
+				  (warned #f)
+				  (rest (if (len>1? form) (cddr form) ())))
+			      (for-each
+			       (lambda (arg)
+				 (if (and (keyword? arg)
+					  (not last-was-key))  ; keyarg might have key value
+				     (begin
+				       (set! have-keys (+ have-keys 1))
+				       (if (not (member (keyword->symbol arg) pargs
+							(lambda (a b)
+							  (eq? a (if (pair? b) (car b) b)))))
+					   (lint-format "~A keyword argument ~A (in ~A) does not match any argument in ~S" caller
+							head arg (truncated-list->string form) pargs))
+				       (if (memq arg rest)
+					   (lint-format "~W is repeated in ~A" caller arg (cdr form)))
+				       (set! last-was-key #t))
+				     (begin
+				       (when (and (positive? have-keys)
+						  (not last-was-key)
+						  (not warned))
+					 (set! warned #t)
+					 (lint-format "non-keyword argument ~A follows previous keyword~P" caller arg have-keys))
+				       (set! last-was-key #f)))
+				 (if (pair? rest)
+				     (set! rest (cdr rest))))
+			       (cdr form))))
+
+			  (check-args caller head data form (if (pair? sig) (cdr sig) ()) env opt)
+
+			  ;; for a complete var-history, we could run through the args here even if no type info
+			  ;; also if var passed to macro -- what to do?
+
+			  ;; look for problematic macro expansion
+			  (when (memq (let-ref fdata 'ftype) '(define-macro define-macro* defmacro defmacro*))
+
+			    (unless (list? (let-ref fdata 'macro-ops))
+			      (let ((syms (list () ())))
+				(tree-symbol-walk ((if (memq (let-ref fdata 'ftype) '(define-macro define-macro*))
+						       cddr cdddr)
+						   (let-ref fdata 'initial-value))
+						  syms)
+				(varlet fdata 'macro-locals (car syms) 'macro-ops (cadr syms))))
+
+			    (when (or (pair? (let-ref fdata 'macro-locals))
+				      (pair? (let-ref fdata 'macro-ops)))
+			      (let ((bad-locals ())
+				    (bad-quoted-locals ()))
+				(for-each
+				 (lambda (local)
+				   (if (tree-unquoted-member local (cdr form))
+				       (set! bad-locals (cons local bad-locals))))
+				 (let-ref fdata 'macro-locals))
+				(when (null? bad-locals)
+				  (for-each
+				   (lambda (local)
+				     (if (tree-member local (cdr form)) ; not tree-memq!
+					 (set! bad-quoted-locals (cons local bad-quoted-locals))))
+				   (let-ref fdata 'macro-locals)))
+				;(format *stderr* "~S ~S~%" bad-locals bad-quoted-locals)
+				(let ((bad-ops ()))
+				  (for-each
+				   (lambda (op)
+				     (let ((curf (var-member op env))
+					   (oldf (var-member op (let-ref fdata 'env))))
+				       (if (and (not (eq? curf oldf))
+						(or (pair? (let-ref fdata 'env))
+						    (defined? op (rootlet))))
+					   (set! bad-ops (cons op bad-ops)))))
+				   (let-ref fdata 'macro-ops))
+
+				  (if (equal? bad-quoted-locals '(quote #_quote)) (set! bad-quoted-locals ()))
+				  (when (or (pair? bad-locals)
+					    (pair? bad-quoted-locals)
+					    ;; (define-macro (mac8 b) `(let ((a 12)) (+ (symbol->value ,b) a)))
+					    ;; (let ((a 1)) (mac8 'a))
+					    ;; far-fetched!  and can be confused by recursive macros (m1 in tmac.scm)
+					    (pair? bad-ops))
+				    (lint-format "possible problematic macro expansion:~%  ~A ~A collide with subsequently defined ~A~A~A"
+						 caller
+						 (truncated-list->string form)
+						 (if (or (pair? bad-locals)
+							 (pair? bad-ops))
+						     "may"
+						     "could conceivably")
+						 (if (pair? bad-locals)
+						     (format #f "~{'~A~^, ~}" bad-locals)
+						     (if (pair? bad-quoted-locals)
+							 (format #f "~{'~A~^, ~}" bad-quoted-locals)
+							 ""))
+						 (if (and (pair? bad-locals) (pair? bad-ops)) ", " "")
+						 (if (pair? bad-ops)
+						     (format #f "~{~A~^, ~}" bad-ops)
+						     "")))))))
+			  )))))
+		;; not local var
+		(when (symbol? head)
+		  (let ((head-value (symbol->value head *e*))) ; head might be "arity"!
+		    (when (or (procedure? head-value)
+			      (macro? head-value))
+		      ;; check arg number
+		      (let ((ary (arity head-value)))
+			(let ((args (- (length form) 1))
+			      (min-arity (car ary))
+			      (max-arity (cdr ary)))
+			  (if (< args min-arity)
+			      (lint-format "~A needs ~A~D argument~A: ~A"
+					   caller head
+					   (if (= min-arity max-arity) "" "at least ")
+					   min-arity
+					   (if (> min-arity 1) "s" "")
+					   (truncated-list->string form))
+			      (if (and (not (setter head-value))
+				       (> (- args (keywords (cdr form) 0)) max-arity))
+				  (lint-format "~A has too many arguments: ~A" caller head (truncated-list->string form))))
+
+			  (when (and (procedure? head-value)
+				     (pair? (cdr form))) ; there are args (the not-enough-args case is checked above)
+			    (if (zero? max-arity)
+				(lint-format "too many arguments: ~A" caller (truncated-list->string form))
+				(begin
+
+				  (for-each (lambda (arg)
+					      (if (pair? arg)
+						  (if (negative? (length arg))
+						      (lint-format "missing quote? ~A in ~A" caller arg form)
+						      (if (eq? (car arg) 'unquote)
+							  (lint-format "stray comma? ~A in ~A" caller arg form)))))
+					    (cdr form))
+
+				  ;; if keywords, check that they are acceptable
+				  ;;    this only applies to lambda*'s that have been previously loaded (lint doesn't create them)
+				  (let ((source (procedure-source head-value)))
+				    (if (and (pair? source)
+					     (eq? (car source) 'lambda*))
+					(let ((decls (cadr source)))
+					  (if (not (memq :allow-other-keys decls))
+					      (for-each
+					       (lambda (arg)
+						 (if (and (keyword? arg)
+							  (not (eq? arg :rest))
+							  (not (member arg decls
+								       (lambda (a b)
+									 (eq? (keyword->symbol a) (if (pair? b) (car b) b))))))
+						     (lint-format "~A keyword argument ~A (in ~A) does not match any argument in ~S" caller
+								  head arg (truncated-list->string form) decls)))
+					       (cdr form))))))
+
+				  ;; we've already checked for head in the current env above
+				  (if (and (or (memq head '(eq? eqv?))
+					       (and (= (length form) 3)
+						    (hash-table-ref repeated-args-table head)))
+					   (repeated-member? (cdr form) env))
+				      (lint-format "this looks odd: ~A~A"
+						   caller
+						   ;; sigh (= a a) could be used to check for non-finite numbers, I suppose,
+						   ;;   and (/ 0 0) might be deliberate (as in gmp)
+						   ;;   but the former is better (not (nan? a)) and the latter is an error
+						   ;;   also (min (random x) (random x)) is not pointless
+						   (truncated-list->string form)
+						   (if (eq? head '=)
+						       (format #f ", perhaps use (not (nan? ~A))" (cadr form)) ; len=3 above, so only cadr is possible
+						       (if (and (eq? head 'eq?)   ; (eq? x x)
+								(eq? (cadr form) (caddr form)))
+							   ", isn't it always #t?"
+							   "")))
+				      (if (and (hash-table-ref repeated-args-table-2 head)
+					       (repeated-member? (cdr form) env))
+					  (lint-format "it looks odd to have repeated arguments in ~A" caller (truncated-list->string form))))
+
+				  (when (memq head '(eq? eqv?))
+				    (define (repeated-member-with-not? lst env)
+				      (and (pair? lst)
+					   (let ((this-repeats (and (not (and (pair? (car lst))
+									      (side-effect? (car lst) env)))
+								    (or (member (list 'not (car lst)) (cdr lst))
+									(and (len=2? (car lst))
+									     (eq? (caar lst) 'not)
+									     (member (cadar lst) (cdr lst)))))))
+					     (or this-repeats
+						 (repeated-member-with-not? (cdr lst) env)))))
+				    (if (repeated-member-with-not? (cdr form) env)
+					(lint-format "this looks odd: ~A" caller (truncated-list->string form))))
+
+				  ;; now try to check arg types
+				  (let ((arg-data (cond ((signature head-value) => cdr) (else #f))))
+				    (if (pair? arg-data)
+					(check-args caller head data form arg-data env max-arity))
+				    ))))))))))))))
+
+    (define (indirect-set? vname func arg1)
+      (case func
+	((set-car! set-cdr! vector-set! list-set! string-set!)
+	 (eq? arg1 vname))
+	((set! implicit-set)
+	 (and (pair? arg1)
+	      (eq? (car arg1) vname)))
+	(else #f)))
+
+    (define (env-difference name e1 e2 lst)
+      (if (or (null? e1)
+	      (null? e2)
+	      (eq? (car e1) (car e2)))
+	  (reverse lst)
+	  (env-difference name (cdr e1) e2
+			  (if (eq? name (var-name (car e1)))
+			      lst
+			      (cons (car e1) lst)))))
+
+    (denote report-usage
+      (let ((unwrap-cxr (hash-table 'caar '(car)  'cadr '(cdr)  'cddr '(cdr)  'cdar '(car)
+				     'caaar '(caar car)  'caadr '(cadr cdr)  'caddr '(cddr cdr)  'cdddr '(cddr cdr)
+				     'cdaar '(caar car)  'cddar '(cdar car)  'cadar '(cadr car)  'cdadr '(cadr cdr)
+				     'cadddr '(cdddr cddr cdr)  'cddddr '(cdddr cddr cdr)  'caaaar '(caaar caar car)  'caaadr '(caadr cadr cdr)
+				     'caadar '(cadar cdar car)  'caaddr '(caddr cddr cdr)  'cadaar '(cdaar caar car)  'cadadr '(cdadr cadr cdr)
+				     'caddar '(cddar cdar car)  'cdaaar '(caaar caar car)  'cdaadr '(caadr cadr cdr)  'cdadar '(cadar cdar car)
+				     'cdaddr '(caddr cddr cdr)  'cddaar '(cdaar caar car)  'cddadr '(cdadr cadr cdr)  'cdddar '(cddar cdar car)))
+	    (all-types-agree (lambda (v)
+			       (let ((base-type (->lint-type (var-initial-value v)))
+				     (vname (var-name v)))
+				 (let ((typef (lambda (p)
+						(or (not (and (len>2? p)
+							      (eq? (car p)  'set!)
+							      (eq? vname (cadr p))))
+						    (let ((nt (->lint-type (caddr p))))
+						      (or (subsumes? base-type nt)
+							  (and (subsumes? nt base-type)
+							       (set! base-type nt))
+							  (and (memq nt '(pair? null? proper-list?))
+							       (memq base-type '(pair? null? proper-list?))
+							       (set! base-type 'list?))))))))
+				   (and (lint-every? typef (var-history v))
+					base-type))))))
+
+	;; -------- defined-twice
+	(define (defined-twice caller head vars)
+	  (when (and (not (eq? head 'begin)) ; begin can redefine = set a variable
+		     (proper-pair? vars))
+	    (do ((cur vars (cdr cur))
+		 (rst (cdr vars) (cdr rst)))
+		((null? rst))
+	      (let ((vn (var-name (car cur))))
+		(if (not (memq vn '(:lambda :dilambda)))
+		    (let ((repeat (var-member vn rst)))
+		      (when repeat
+			(let ((type (if (eq? (var-definer repeat) 'parameter) 'parameter 'variable)))
+			  (case (var-definer (car cur))
+			    ((define)
+			     (lint-format "~A ~A ~A is redefined ~A" caller head type vn
+					  (if (equal? head "")
+					      (if (not (lint-tree-memq vn (var-initial-value (car cur))))
+						  "at the top level."
+						  (format #f "at the top level. Perhaps use set! instead: ~A"
+							  (truncated-list->string (list 'set! vn (var-initial-value (car cur))))))
+					      (format #f "in the ~A body.  Perhaps use set! instead: ~A"
+						      head (truncated-list->string (list 'set! vn (var-initial-value (car cur))))))))
+			    ((define-constant)
+			     (lint-format "~A ~A ~A is later redefined as a constant" caller head type vn))
+			    (else
+			     (lint-format "~A ~A ~A is declared twice" caller head type vn)))))))))))
+
+	;; -------- set->let
+	(define (set->let caller outer-form local-var env)
+	  ;; (let ((x 0)...) ... (set! x 1)...) -> move the set! value  to let init value
+	  ;; car body as set! is handled in let-walker etc
+	  (when (and (pair? outer-form)
+		     (positive? (var-set local-var))
+		     (memq (car outer-form) '(let let*))
+		     (list? (cadr outer-form))
+		     (not (side-effect? (var-initial-value local-var) env)))
+	    (let ((nxt (let ((len (length (var-history local-var))))
+			 (and (> len 1)
+			      (list-ref (var-history local-var) (- len 2)))))
+		  (vname (var-name local-var)))
+	      (when (and (pair? nxt)
+			 (eq? (car nxt) 'set!)
+			 (eq? (cadr nxt) vname)
+			 (code-constant? (caddr nxt)) ; so vname is not involved etc
+			 (not (lint-tree-memq vname (caddr outer-form))) ; not redundant with next -- need to exclude this case
+			 (let ((f (member vname (cdddr outer-form) tree-memq)))
+			   (and (pair? f)
+				(eq? (car f) nxt))))
+		(lint-format "perhaps change ~A's initial value to ~A, and remove ~A in ~A" caller
+			     vname (caddr nxt) nxt (truncated-list->string outer-form))))))
+
+	;; -------- use-dilambda
+	(denote (use-dilambda caller local-var vars env)
+	  ;; translate to dilambda fixing arg if necessary and mention generic set!
+	  (let ((init (var-initial-value local-var))
+		(vname (var-name local-var)))
+	    (when (and (len>1? init)
+		       (eq? (car init) 'define)
+		       (pair? (cadr init)))
+	      (let* ((vstr (symbol->string vname))
+		     (len (length vstr)))
+		(when (> len 4)
+		  (let ((setv #f)
+			(newv #f))
+		    (if (string=? (substring vstr 0 4) "get-")
+			(let ((sv (symbol "set-" (substring vstr 4))))
+			  (set! setv (or (var-member sv vars)
+					 (var-member sv env)))
+			  (set! newv (string->symbol (substring vstr 4))))
+			(if (string=? (substring vstr (- len 4)) "-ref")
+			    (let ((sv (symbol (substring vstr 0 (- len 4)) "-set!")))
+			      (set! setv (or (var-member sv vars)
+					     (var-member sv env)))
+			      (set! newv (string->symbol (substring vstr 0 (- len 4)))))
+			    (let ((pos (string-position "-get-" vstr)))
+			      (when pos ; this doesn't happen very often, others: Get-, -ref-, -set!- are very rare
+				(let ((sv (let ((s (copy vstr))) (set! (s (+ pos 1)) #\s) (string->symbol s))))
+				  (set! setv (or (var-member sv vars)
+						 (var-member sv env)))
+				  (set! newv (symbol (substring vstr 0 pos)
+						     (substring vstr (+ pos 4))))))))) ; +4 to include #\-
+		    (when (and setv
+			       (not (var-member newv vars))
+			       (not (var-member newv env)))
+		      (let ((getter init)
+			    (setter (var-initial-value setv)))
+			(when (and (pair? setter)
+				   (eq? (car setter) 'define)
+				   (pair? (cadr setter)))
+			  (let ((getargs (cdadr getter))
+				(setargs (cdadr setter)))
+			    (unless (null? setargs)
+			      (if (or (eq? newv getargs)
+				      (and (pair? getargs)
+					   (memq newv getargs)))
+				  (let ((unique (find-unique-name getter newv)))
+				    (set! getter (tree-subst unique newv getter))
+				    (set! getargs (cdadr getter))))
+			      (if (or (eq? newv setargs)
+				      (and (pair? setargs)
+					   (memq newv setargs)))
+				  (let ((unique (find-unique-name setter newv)))
+				    (set! setter (tree-subst unique newv setter))
+				    (set! setargs (cdadr setter))))
+			      (let ((getdots (if (null? getargs) "" " ..."))
+				    (setdots (if (or (not (pair? setargs)) (null? (cdr setargs))) "" " ..."))
+				    (setvalue (and (proper-list? setargs)
+						   (last-ref setargs))))
+				(if setvalue
+				    (out-format outport "~NC~A: perhaps use dilambda and generalized set! for ~A and ~A:~%~
+                                                  ~NCreplace (~A~A) with (~A~A) and (~A~A ~A) with (set! (~A~A) ~A)~%~
+                                                  ~NC~A~%"
+					    lint-left-margin #\space
+					    caller
+					    vname (var-name setv)
+					    (+ lint-left-margin 4) #\space
+					    vname getdots newv getdots
+					    (var-name setv) setdots setvalue
+					    newv setdots setvalue
+					    (+ lint-left-margin 4) #\space
+					    (lint-pp `(define ,newv (dilambda
+								     (lambda ,getargs ,@(cddr getter))
+								     (lambda ,setargs ,@(cddr setter)))))))))))))))))))
+
+	;; -------- bad-name
+	(denote (bad-name caller head local-var otype)
+	  (let ((vname (var-name local-var)))
+	    (cond ((hash-table-ref syntaces vname)
+		   (lint-format "~A ~A named ~A is asking for trouble" caller head otype vname))
+
+		  ((eq? vname 'l)
+		   (lint-format "\"l\" is a really bad variable name" caller))
+
+		  ((and *report-built-in-functions-used-as-variables*
+			(hash-table-ref built-in-functions vname))
+		   (lint-format "~A ~A named ~A is asking for trouble" caller
+				(if (and (len=1? (var-scope local-var))
+					 (symbol? (car (var-scope local-var))))
+				    (car (var-scope local-var))
+				    head)
+				otype vname))
+
+		  ((symbol? vname)
+		   (check-for-bad-variable-name caller vname)))))
+
+	;; -------- wrappable-var
+	(define (wrappable-var caller local-var otype outer-form env)
+	  (let ((hist (var-history local-var))
+		(vname (var-name local-var)))
+	    (let ((first (car hist)))                               ; all but the initial binding have to match this
+	      (when (pair? first)
+		(let ((op (car first)))
+		  (when (and (symbol? op)
+			     (not (or (memq op '(unquote apply-values #_apply-values list-values #_list-values))
+				      (hash-table-ref makers op)
+				      (eq? vname op)))              ; not a function (this kind if repetition is handled elsewhere)
+			     (len>1? (cdr hist))
+			     (pair? (cdr first))
+			     (not (side-effect? first env))
+			     (lint-every? (lambda (a)
+					    (or (eq? a vname)
+						(code-constant? a)))
+					  (cdr first))
+			     (or (code-constant? (var-initial-value local-var))
+				 (= (tree-count vname first 2) 1))
+			     (lint-every? (lambda (a)
+					    (and (pair? a)
+						 (or (equal? first a)
+						     (and (eq? (hash-table-ref reversibles (car first)) (car a))
+							  (equal? (cdr first) (reverse (cdr a))))
+						     (set! op (match-cxr op (car a))))))
+					  (if (eq? otype 'parameter)
+					      (cdr hist)
+					      (copy (cdr hist) (make-list (- (length hist) 2))))))
+		    (let* ((new-op (or op (car first)))
+			   (settee (let walker ((tree outer-form)) ; check for new-op dilambda as target of set!
+					 (and (pair? tree)
+					      (or (and (eq? (car tree) 'set!)
+						       (pair? (cdr tree))
+						       (pair? (cadr tree))
+						       (eq? (caadr tree) new-op))
+						  (walker (car tree))
+						  (walker (cdr tree)))))))
+		      (unless settee
+			(if (eq? otype 'parameter)
+			    (if (> (var-ref local-var) 2)
+				(lint-format "parameter ~A is always accessed (~A times) via ~S" caller
+					     vname (var-ref local-var) (cons new-op (cdr first))))
+			    (lint-format "~A is not set, and is always accessed via ~A~%~NCso its binding could probably be ~A in ~A" caller
+					 ;;        "probably" here because the accesses could have hidden protective assumptions
+					 ;;          i.e. full accessor is not valid at point of let binding
+					 vname
+					 (cons new-op (cdr first))
+					 (+ lint-left-margin 4) #\space
+					 (list vname (cons new-op (tree-subst (var-initial-value local-var) vname (cdr first))))
+					 (truncated-list->string outer-form)))))))))))
+
+	;; -------- use-vector
+	(define (use-vector caller local-var)
+	  (let ((hist (var-history local-var)))
+	    (when (> (length hist) 2) ; an experiment -- if all refs are by list-ref (in effect) suggest a vector
+	      (let ((init (var-initial-value local-var))
+		    (vname (var-name local-var)))
+		(when (and (pair? init)
+			   ;; list->vector
+			   (or (memq (car init) '(list make-list string->list vector->list))
+			       (and (memq (car init) '(quote #_quote))
+				    (pair? (cdr init))
+				    (pair? (cadr init))))
+			   (lint-every? (lambda (p)
+					  (and (pair? p)
+					       (or (eq? p init)
+						   (eq? (car p) vname)
+						   (hash-table-ref cxars (car p))
+						   (memq (car p) '(list-ref list-set! length reverse map for-each
+									    list->vector list->string list? pair? null? quote)))))
+					hist))
+		  (lint-format "~A could be a vector, rather than a list" caller vname))))))
+
+	;; -------- parlous-port
+	(denote (parlous-port caller local-var outer-form)
+	  ;; look for port opened but not closed, or not used
+	  ;;    (let ((p (open-output-file str))) (display 32 p) x)
+	  (when (and (pair? outer-form)
+		     (not (memq (var-definer local-var) '(call-with-input-string call-with-input-file call-with-output-string call-with-output-file)))
+		     ;; call-with-io-walker below uses open-input-string et al for the initial value to get type checks
+		     (let ((last (last-ref outer-form)))
+		       (or (not (lint-tree-memq (var-name local-var) last))
+			   (and (pair? last)
+				(memq (car last) '(close-input-port close-output-port close-port close))))))
+	    (let ((hist (var-history local-var))
+		  (open-set '(open-input-string open-input-file open-output-string open-output-file))
+		  (open-form #f)
+		  (vname (var-name local-var)))
+	      (when (lint-any? (lambda (tree)
+				 (and (pair? tree)
+				      (or (and (memq (car tree) open-set)
+					       (not (and (pair? (cdr tree))
+							 (memq vname (cdr tree)))))
+					  (and (eq? (car tree) 'set!)
+					       (len>1? (cdr tree))
+					       (eq? (cadr tree) vname)
+					       (pair? (caddr tree))
+					       (memq (caaddr tree) open-set)))
+				      (set! open-form tree)))
+			       hist)
+		(if (not (lint-tree-set-memq '(close-input-port close-output-port close-port close current-output-port current-input-port) hist))
+		    (lint-format "in ~A~%     perhaps ~A is opened via ~A, but never closed" caller
+				 (truncated-list->string outer-form)
+				 vname open-form)
+		    (if (= (length hist) 2)
+			(lint-format "in ~A~%   ~A is opened and closed, but never used" caller
+				     (truncated-list->string outer-form) vname)))))))
+
+	;; -------- parlous-output-string
+	(define (parlous-output-string local-var outer-form)
+	  (let ((init (var-initial-value local-var))) ; look for various open-output-string problems
+	    (when (and (pair? init)
+		       (eq? (car init) 'open-output-string)
+		       (pair? outer-form)
+		       (eq? (car outer-form) 'let)
+		       (len=1? (cadr outer-form)))
+	      (let ((var (caadr outer-form))
+		    (vname (var-name local-var)))
+		(when (and (eq? (car var) vname)
+			   (pair? (cadr var))
+			   (eq? (caadr var) 'open-output-string))
+		  (let ((hist (var-history local-var)))
+		    (if (and (pair? (car hist))
+			     (eq? (caar hist) 'close-output-port)
+			     (eq? vname (cadar hist))
+			     (not (lint-tree-memq 'get-output-string hist))
+			     (= (length hist) 3)
+			     (pair? (cadr hist))
+			     (memq (caadr hist) '(display write)))
+			(lint-format "~A is missing get-output-string" vname (truncated-list->string outer-form))
+			(when (len>1? (cddr outer-form))
+			  (let ((mid (cadddr outer-form)))
+			    (when (and (pair? mid)
+				       (eq? (car mid) 'let)
+				       (= (length hist) 4))
+			      (let ((writer (caddr hist)))
+				(when (and (pair? writer)
+					   (memq (car writer) '(write display))
+					   (pair? (cddr writer))
+					   (eq? (caddr writer) vname)
+					   (equal? writer (caddr outer-form)))  ; all this is sloppy -- maybe not worth this effort
+				  (lint-format "perhaps ~A" vname
+					       (lists->string outer-form
+							      (cons 'object->string
+								    (if (eq? (car writer) 'display)
+									(list (cadr writer) #f)
+									(list (cadr writer))))))))))))))))))
+
+	;; -------- reducible-scope
+	(denote (reducible-scope caller local-var otype env)
+	  (if (and (eq? otype 'variable)
+		   (or *report-unused-top-level-functions*
+		       (not (eq? caller top-level:))))
+	      (let ((scope (var-scope local-var)) ; might be #<undefined>?
+		    (vname (var-name local-var)))
+		(if (pair? scope) (set! scope (remove-one vname scope)))
+		(when (and (len=1? scope)
+			   (symbol? (car scope))
+			   (not (var-member (car scope) (let search ((e env))
+							  (if (null? e)
+							      env
+							      (if (eq? (caar e) vname)
+								  e
+								  (search (cdr e)))))))
+			   (not (and (memq (var-ftype local-var) '(define lambda define* lambda*))
+				     (> (lint-tree-leaves (var-initial-value local-var)) 80))))
+		  (out-format outport "~NC~A~A is ~A only in ~A~%"
+			  lint-left-margin #\space
+			  (if (eq? caller top-level:)
+			      "top-level: "
+			      "")
+			  vname
+			  (if (memq (var-ftype local-var) '(define lambda define* lambda*)) "called" "used")
+			  (car scope))))))
+
+	;; -------- unused-var
+	;;   (eval ...) in the form may have hidden var refs confusing this check
+	(define (unused-var caller head local-var otype)
+	  (let ((vname (var-name local-var)))
+	    (when (and (or (not (equal? head ""))
+			   *report-unused-top-level-functions*)
+		       (or *report-unused-parameters*
+			   (not (eq? otype 'parameter))))
+	      (if (positive? (var-set local-var))
+		  (let ((sets (map (lambda (call)
+				     (if (and (pair? call)
+					      (not (eq? (var-definer local-var) 'do))
+					      (eq? (car call) 'set!)
+					      (eq? (cadr call) vname))
+					 call
+					 (values)))
+				   (var-history local-var))))
+		    (if (pair? sets)
+			(if (null? (cdr sets))
+			    (lint-format "~A set, but not used: ~A" caller
+					 vname (truncated-list->string (car sets)))
+			    (lint-format "~A set, but not used: ~{~S~^ ~}" caller
+					 vname sets))
+			(lint-format "~A set, but not used: ~A from ~A" caller
+				     vname (truncated-list->string (var-initial-value local-var)) (var-definer local-var))))
+
+		  ;; not ref'd or set
+		  (unless (memq vname '(+documentation+ +signature+ +setter+ +iterator+ define-animal))
+		    (let ((val (truncated-list->string
+				(if (pair? (var-history local-var))
+				    (car (var-history local-var))
+				    (var-initial-value local-var))))
+			  (def (var-definer local-var)))
+		      (let-temporarily ((line-number (if (eq? caller top-level:) -1 line-number)))
+			;; eval confuses this message (eval '(+ x 1)), no other use of x [perhaps check :let initial-value = outer-form]
+			;;    so does let-ref syntax: (apply (*e* 'g1)...) will miss this reference to g1
+			(if (symbol? def)
+			    (if (eq? otype 'parameter)
+				(lint-format "~A not used" caller vname)
+				(lint-format "~A not used, initially: ~A from ~A" caller vname val def))
+			    (lint-format "~A not used, value: ~A" caller vname val)))))))))
+
+	;; -------- move local var inward
+	(define (move-var-inward caller local-var)
+	  (when (and (not (eq? caller top-level:))         ; don't move top-level vars
+		     (zero? (var-set local-var)))          ; counter in for-each, etc
+	    (let ((func (memq (var-ftype local-var) '(define define* lambda lambda*)))
+		  (deffunc (memq (var-ftype local-var) '(define define*)))
+		  (local-env (var-env local-var))
+		  (reflet (var-refenv local-var))
+		  (deflet (var-env local-var))
+		  (source (var-initial-value local-var))
+		  (vname (var-name local-var)))
+	      ;; if (define f (let ... (lambda ...))) the f is not in the deflet yet
+
+	      (if (and deffunc
+		       (pair? local-env))
+		  (let crawler ((ref (cdr local-env)))
+		    (if (pair? ref)
+			(if (keyword? (caar ref))
+			    (set! local-env ref)
+			    (crawler (cdr ref))))))
+
+	      (when (and (pair? reflet)
+			 (pair? deflet)
+			 (not (eq? local-env reflet))
+			 (or deffunc
+			     (code-constant? source))
+			 ;; code-constant? is very restrictive, but side-effect? leaves too many complications:
+			 ;;   (let ((a (car b))) (set! b c) (let ...))
+			 (let ((target (car deflet)))     ; the enclosing env
+			   (let crawler ((ref reflet))    ; the var's restricted env
+			     (and (pair? ref)
+				  (or (eq? (car ref) target)
+				      (and (not (eq? (caar ref) :do))     ; try not to move the variable inside a loop
+					   (not (and (eq? (caar ref) :let)
+						     (symbol? (cadr (var-initial-value (car ref))))))
+					   (crawler (cdr ref)))))))
+			 (or (not func)
+			     (let* ((source-args (args->proper-list ((if deffunc cdadr cadr) source)))
+				    (lets (if deffunc 1 0))
+				    (let-args (let ((target (car deflet)))
+						(let crawler ((ref reflet) (largs ()))
+						  ;; this includes locals that can't act as shadows
+						  (if (eq? (caar ref) :let)
+						      (set! lets (+ lets 1)))
+						  (if (eq? (car ref) target)
+						      largs
+						      (crawler (cdr ref)
+							       (if (and (pair? (car ref))
+									(not (keyword? (caar ref)))
+									(not (eq? (caar ref) vname)))
+								   (cons (caar ref) largs)
+								   largs)))))))
+			       (and (> lets 2)
+				    (not (lint-tree-set-memq (let remove-args ((args let-args) (nargs ()))
+							    (if (null? args)
+								nargs
+								(remove-args (cdr args)
+									     (if (memq (car args) source-args)
+										 nargs
+										 (cons (car args) nargs)))))
+							  (cddr source)))))))
+		;; possibilities are :let :catch :call/exit :call/cc :do :with-let :with-baffle
+
+		(let ((refval (var-initial-value (car reflet)))
+		      (makval (var-initial-value (car local-env))))
+		  (when (and (pair? refval)
+			     (eq? (car refval) 'let)
+			     (pair? (cadr refval))
+			     (pair? makval)
+			     (or (memq (car makval) '(define define* lambda lambda*))
+				 (and (memq (car makval) '(let let*))  ; check last var in let*, any var in let
+				      (pair? (cadr makval))            ; not a named let
+				      (or (eq? (caddr makval) refval)      ;   not a triply nested let
+					  (not (memq (caaddr makval) '(let let*))))
+				      (not (and (pair? (caddr makval)) ; not lambda's closure
+						(null? (cdddr makval))
+						(memq (caaddr makval) '(lambda lambda*)))))))
+		    (lint-format "perhaps move '~A~A into the inner let~A: ~A" caller
+				 vname
+				 (if (or deffunc
+					 (not (memq (car makval) '(define define*))))
+				     ""
+				     (local-line-number  (if (pair? (cadr makval))
+							     ((if (pair? (caadr makval)) caadr cadr) makval)
+							     makval)))
+				 (local-line-number (caadr refval))
+				 (truncated-lists->string
+				  makval
+				  (let ((new-var&val (list vname
+							   (if (not deffunc)
+							       source
+							       (cons (if (eq? (var-ftype local-var) 'define) 'lambda 'lambda*)
+								     (cons (cdadr source)
+									   (cddr source)))))))
+				    `(let (,new-var&val
+					   ,@(cadr refval))
+				       ,@(cddr refval)))))))))))
+
+	;; -------- parlous-return
+	(denote (parlous-return caller local-var env)
+	  (when (and *report-clobbered-function-return-value*
+		     (positive? (var-set local-var)))
+	    (let ((start (var-initial-value local-var))
+		  (vname (var-name local-var)))
+	      (let ((func #f)
+		    (retcons? (and (pair? start) ; is this var's initial value from a function that returns a constant sequence?
+				   (let ((v (var-member (car start) env)))
+				     (and v
+					  (eq? (var-retcons v) #t))))))
+		(for-each (lambda (f)
+			    (when (pair? f)
+			      (case (car f)
+				((set!)
+				 (set! retcons? (and (len>1? (cdr f))
+						     (eq? (cadr f) vname)
+						     (pair? (caddr f))
+						     (let ((v (var-member (caaddr f) env)))
+						       (and v
+							    (eq? #t (var-retcons v))
+							    (set! func f))))))
+				((string-set! list-set! vector-set! set-car! set-cdr!)
+				 (if (and retcons?
+					  (eq? (cadr f) vname))
+				     (lint-format "~A returns a constant sequence, but ~A appears to clobber it" caller
+						  func f))))))
+			  (reverse (var-history local-var)))))))
+
+	;; pointless-if
+	(define (pointless-if caller vname vtype func call)
+	  (when (and (not (eq? caller top-level:))
+		     (not (memq vtype '(boolean? #t values)))
+		     (memq func '(if when unless)) ; look for (if x ...) where x is never #f, this happens a dozen or so times
+		     (or (eq? (cadr call) vname)
+			 (and (pair? (cadr call))
+			      (eq? (caadr call) 'not)
+			      (eq? (cadadr call) vname))))
+	    (lint-format "~A is never #f, so ~A" caller
+			 vname
+			 (lists->string
+			  call
+			  (if (eq? vname (cadr call))
+			      (case func
+				((if) (caddr call))
+				((when) (if (pair? (cdddr call)) (cons 'begin (cddr call)) (caddr call)))
+				((unless) #<unspecified>)
+				(else 'error))
+			      (case func
+				((if) (if (pair? (cdddr call)) (cadddr call)))
+				((when) #<unspecified>)
+				((unless) (if (pair? (cdddr call)) (cons 'begin (cddr call)) (caddr call)))
+				(else 'error)))))))
+
+	;; -------- arg-mismatch
+	(define (arg-mismatch caller vname vtype func call e)
+	  (let ((p (memq vname (cdr call))))
+	    (when (pair? p)
+	      (let ((sig (arg-signature func e))
+		    (pos (- (length call) (length p))))
+		(when (and (pair? sig)
+			   (< pos (length sig)))
+		  (let ((desired-type (list-ref sig pos)))
+		    (cond ((not (or (symbol? desired-type)
+				    (eq? desired-type #t)
+				    (pair? desired-type)))
+			   (error 'wrong-type-arg "~S signature ~S is invalid" func sig))
+
+			  ((not (or (eq? desired-type #t)
+				    (any-compatible? vtype desired-type)))
+			   (lint-format "~A is ~A, but ~A in ~A wants ~A" caller
+					vname (prettify-checker-unq vtype)
+					func (truncated-list->string call)
+					(prettify-checker desired-type)))
+
+			  ((and (memq vtype '(float-vector? int-vector?))
+				(memq func '(vector-set! vector-ref)))
+			   (lint-format "~A is ~A, so perhaps use ~A, not ~A" caller
+					vname (prettify-checker-unq vtype)
+					(if (eq? vtype 'float-vector?)
+					    (if (eq? func 'vector-set!) 'float-vector-set! 'float-vector-ref)
+					    (if (eq? func 'vector-set!) 'int-vector-set! 'int-vector-ref))
+					func))
+
+			  ((and (eq? vtype 'float-vector?)
+				(eq? func 'equal?)
+				(or (eq? (cadr call) vname)
+				    (not (symbol? (cadr call))))) ; don't repeat the suggestion when we hit the second vector
+			   (lint-format "perhaps use equivalent? in ~A" caller (truncated-list->string call)))
+
+			  ((and (eq? vtype 'vector?)
+				(memq func '(float-vector-set! float-vector-ref int-vector-set! int-vector-ref byte-vector-set! byte-vector-ref)))
+			   (lint-format "~A is ~A, so use ~A, not ~A" caller
+					vname (prettify-checker-unq vtype)
+					(if (memq func '(float-vector-set! int-vector-set! byte-vector-set!))
+					    'vector-set! 'vector-ref)
+					func)))))))))
+
+	;; -------- pointless-type-check
+	(define (pointless-type-check caller local-var vtype func call call-arg1 vars)
+	  (let ((vname (var-name local-var)))
+	    (when (and (hash-table-ref bools func)
+		       (not (eq? vname func)))
+	      (when (or (eq? vtype func)
+			(and (compatible? vtype func)
+			     (not (subsumes? vtype func))
+			     (not (eq? vtype 'proper-list?))))
+		(lint-format "~A is ~A, so ~A is #t" caller vname (prettify-checker-unq vtype) call))
+
+	      (unless (compatible? vtype func)
+		(lint-format "~A is ~A, so ~A is #f" caller vname (prettify-checker-unq vtype) call)))
+
+	    (case func
+	      ;; need a way to mark exported variables so they won't be checked in this process
+	      ;; case can happen here, but it never seems to trigger a type error
+	      ((eq? eqv? equal?)
+	       ;; (and (pair? x) (eq? x #\a)) etc
+	       (when (or (and (code-constant? call-arg1)
+			      (not (compatible? vtype (->lint-type call-arg1))))
+			 (and (pair? (cddr call))
+			      (code-constant? (caddr call))
+			      (not (compatible? vtype (->lint-type (caddr call))))))
+		 (lint-format "~A is ~A, so ~A is #f" caller vname (prettify-checker-unq vtype) call)))
+
+	      ((and or)
+	       (when (let amidst? ((lst call))
+		       (and (len>1? lst)
+			    (or (eq? (car lst) vname)
+				(amidst? (cdr lst)))))   ; don't clobber possible trailing vname (returned by expression)
+		 (lint-format "~A is ~A, so ~A" caller   ; (let ((x 1)) (and x (< x 1))) -> (< x 1)
+			      vname (prettify-checker-unq vtype)
+			      (lists->string call
+					     (simplify-boolean (remove-one vname call) () () vars)))))
+	      ((not)
+	       (if (eq? vname (cadr call))
+		   (lint-format "~A is ~A, so ~A" caller
+				vname (prettify-checker-unq vtype)
+				(lists->string call #f))))
+
+	      ((/) (if (and (number? (var-initial-value local-var))
+			    (zero? (var-initial-value local-var))
+			    (zero? (var-set local-var))
+			    (memq vname (cddr call)))
+		       (lint-format "~A is ~A, so ~A is an error" caller
+				    vname (var-initial-value local-var)
+				    call))))))
+
+	;; -------- eqx-type-check
+	(define (eqx-type-check caller local-var vtype func call call-arg1)
+	  (let ((vname (var-name local-var)))
+	    (if (memq func '(eq? equal?))
+		(lint-format "~A is ~A, so ~A ~A be eqv? in ~A" caller
+			     vname (prettify-checker-unq vtype) func
+			     (if (eq? func 'eq?) "should" "could")
+			     call))
+	    ;; check other boolean exprs
+	    (when (and (zero? (var-set local-var))
+		       (number? (var-initial-value local-var))
+		       (eq? vname call-arg1)
+		       (null? (cddr call))
+		       (hash-table-ref booleans func))
+	      (let ((val (catch #t
+			   (lambda ()
+			     ((symbol->value func (rootlet)) (var-initial-value local-var)))
+			   (lambda args
+			     'error))))
+		(if (boolean? val)
+		    (lint-format "~A is ~A, so ~A is ~A" caller vname (var-initial-value local-var) call val))))))
+
+	;; -------- implicit-type-checks
+	(define (implicit-type-checks caller local-var vtype func call call-arg1)
+	  ;; these type checks are easily fooled by macros
+	  (when (and (memq vtype '(vector? float-vector? int-vector? string? list? byte-vector?))
+		     (pair? (cdr call)))
+	    (let ((vname (var-name local-var)))
+	      (when (eq? func vname)
+		(let ((init (var-initial-value local-var)))
+		  (if (not (compatible? 'integer? (->lint-type call-arg1)))
+		      (lint-format "~A is ~A, but the index ~A is ~A" caller
+				   vname (prettify-checker-unq vtype)
+				   call-arg1 (prettify-checker (->lint-type call-arg1))))
+
+		  (if (integer? call-arg1)
+		      (if (negative? call-arg1)
+			  (lint-format "~A's index ~A is negative" caller vname call-arg1)
+			  (if (zero? (var-set local-var))
+			      (let ((lim (cond ((code-constant? init)
+						(length init))
+
+					       ((memq (car init) '(vector float-vector int-vector string list byte-vector))
+						(- (length init) 1))
+
+					       (else
+						(and (pair? (cdr init))
+						     (integer? (cadr init))
+						     (memq (car init) '(make-vector make-float-vector make-int-vector
+										    make-string make-list make-byte-vector))
+						     (cadr init))))))
+				(if (and (real? lim)
+					 (>= call-arg1 lim))
+				    (lint-format "~A has length ~A, but index is ~A" caller vname lim call-arg1))))))))
+
+	      (when (eq? func 'implicit-set)
+		;; ref is already checked in other history entries
+		(let ((ref-type (case vtype
+				  ((float-vector?) 'real?) ; not 'float? because ints are ok here
+				  ((int-vector? byte-vector?) 'integer)
+				  ((string?) 'char?)
+				  (else #f))))
+		  (if ref-type
+		      (let ((val-type (->lint-type (caddr call))))
+			(if (not (compatible? val-type ref-type))
+			    (lint-format "~A wants ~A, but the value in ~A is ~A" caller
+					 vname (prettify-checker-unq ref-type)
+					 (cons 'set! (cdr call))
+					 (prettify-checker val-type))))))))))
+
+	;; -------- duplicated-calls
+	(define (duplicated-calls caller local-var env)
+	  (let ((vname (var-name local-var)))
+	    (when (and (> (var-ref local-var) 8)
+		       (zero? (var-set local-var))
+		       (eq? (var-ftype local-var) #<undefined>))
+	      (let ((h (make-hash-table)))
+		(for-each (lambda (call)
+			    (when (and (pair? call)
+				       (not (eq? (car call) vname)) ; ignore functions for now
+				       (not (side-effect? call env)))
+			      (hash-table-set! h call (+ 1 (or (hash-table-ref h call) 0)))
+			      (cond ((hash-table-ref unwrap-cxr (car call))
+				     => (lambda (lst)
+					  (for-each (lambda (c)
+						      (let ((cc (cons c (cdr call))))
+							(hash-table-set! h cc (+ 1 (or (hash-table-ref h cc) 0)))))
+						    lst))))))
+			  (var-history local-var))
+		(let ((intro #f)
+		      (column 0)
+		      (calls 0))
+		  (for-each (lambda (call)
+			      (when (and (or (and (eq? (caar call) 'length)
+						  (> (cdr call) 3))
+					     (and (not (memq (caar call) '(make-vector make-float-vector)))
+						  (> (cdr call) (max 3 (/ 20 (lint-tree-leaves (car call))))))) ; was 5
+					 (or (null? (cddar call))
+					     (lint-every? (lambda (p)               ; make sure only current var is involved
+							    (or (not (symbol? p))
+								(eq? p vname)))
+							  (cdar call))))
+				(unless intro
+				  (let ((str (format #f "~NC~A: ~A is not set, but "
+						     lint-left-margin #\space
+						     caller vname)))
+				    (set! column (length str))
+				    (display str outport))
+				  (set! intro #t))
+				(let ((str (truncated-list->string (car call))))
+				  (if (> (+ column (length str) 12) 100)
+				      (begin
+					(out-format outport "~%~NC" (+ lint-left-margin 4) #\space)
+					(set! column lint-left-margin)
+					(set! calls 1))
+				      (set! calls (+ calls 1)))
+				  (set! column (+ column (length str) 12))
+				  (out-format outport "~A~A occurs ~A times"
+					  (if (> calls 1) ", " "")
+					  str (cdr call)))))
+			    h)
+		  (if intro (newline outport)))))))
+
+	;; -------- repeated-args
+	(define (repeated-args caller local-var)
+	  ;; check for function parameters whose values never change and are not just symbols
+	  ;;   ignore recursive functions (arg=(+ k 1) -> counter or whatever)
+	  (let ((vname (var-name local-var)))
+	    (when (and (> (var-ref local-var) 1) ; was 3
+		       (zero? (var-set local-var))
+		       (memq (var-ftype local-var) '(define lambda))
+		       (pair? (var-arglist local-var))
+		       (not (lint-tree-memq vname (cddr (var-initial-value local-var)))) ; not recursive func
+		       (let loop ((calls (var-history local-var)))          ; if func passed as arg, ignore it
+			 (or (null? calls)
+			     (null? (cdr calls))
+			     (and (pair? (car calls))
+				  (not (memq vname (cdar calls)))
+				  (loop (cdr calls))))))
+	      (let ((pars (map list (proper-list (var-arglist local-var)))))
+		(do ((clauses (var-history local-var) (cdr clauses)))
+		    ((null? (cdr clauses)))                                 ; ignore the initial value
+		  (if (and (pair? (car clauses))
+			   (eq? (caar clauses) vname))
+		      (for-each (lambda (arg par)                           ; collect all arguments for each parameter
+				  (if (not (member arg (cdr par)))          ; we haven't seen this argument yet, so
+				      (set-cdr! par (cons arg (cdr par))))) ;   add it to the list for this parameter
+				(cdar clauses)
+				pars)))
+		(for-each (lambda (p)
+			    (when (and (pair? (cdr p))
+				       (not (symbol? (cadr p))))
+			      (if (and (null? (cddr p))
+				       (code-constant? (cadr p)))
+				  (lint-format "~A's '~A parameter is always ~S (~D calls)" caller
+					       vname (car p) (cadr p) (var-ref local-var)))
+			      (when (and (pair? (cadr p))
+					 (eq? (caadr p) 'lambda))
+				(let ((pars (cadadr p))
+				      (body (cddadr p)))
+				  (when (proper-list? pars)
+				    (let ((unused (do ((ps pars (cdr ps))
+						       (i 0 (+ i 1))
+						       (res ()))
+						      ((null? ps)
+						       res)
+						    (if (not (lint-tree-memq (car ps) body))
+							(set! res (cons i res))))))
+				      (if (and (pair? unused)
+					       (or (null? (cddr p))
+						   (lint-every? (lambda (arg)
+								  (and (pair? arg)
+								       (eq? (car arg) 'lambda)
+								       (proper-list? (cadr arg))
+								       (let ((new-unused (copy unused)))
+									 (for-each (lambda (parnum)
+										     (let ((par-name (list-ref (cadr arg) parnum)))
+										       (if (lint-tree-memq par-name (cddr arg))
+											   (set! new-unused (remove-one parnum new-unused)))))
+										   unused)
+									 (and (pair? new-unused)
+									      (set! unused new-unused)))))
+								(cddr p))))
+					  (lint-format "~A parameter ~A is a function whose parameter~P ~{~A~^, ~} ~A never used" caller
+						       vname (car p)
+						       (length unused)
+						       (map (lambda (p) (+ p 1)) (reverse unused))
+						       (if (> (length unused) 1) "are" "is")))))))))
+			  pars)))))
+
+	;; -------- report-usage --------
+	(lambda (caller head vars env)
+
+	  ;; report unused or set-but-unreferenced variables, then look at the overall history
+	  ;;   vars used before defined are kind of a mess -- history has #f for the (unknown) enclosing form
+	  ;;   and any definition wipes out the accumulated pre-def uses -- this should be by closed-body and
+	  ;;   ignore local defines (i.e. really only define[x] propagates backwards) -- changing this is
+	  ;;   tricky (fools current unused func arg + value message for example).
+
+	  (defined-twice caller head vars)
+
+	  ;; main loop -- goes to end
+	  (let ((old-line-number line-number)
+		(outer-form (cond ((var-member :let env) => var-initial-value) (else #f))))
+	    (for-each
+	     (lambda (local-var)
+	       (let ((otype (if (eq? (var-definer local-var) 'parameter) 'parameter 'variable)))
+		 ;; (var-name local-var) can be a pair (probably a bug): '(setter object-info)
+		 (set->let caller outer-form local-var env)
+
+		 ;; it's possible for an unused function to have ref=1, null cdr history, but it appears to
+		 ;;   always involve curlet exports and the like.
+
+		 ;; var not set
+		 (when (zero? (var-set local-var))
+		   (when (and (quoted-symbol? (var-initial-value local-var))     ; (let ((abc 'abc)) ...)
+			      (eq? (var-name local-var) (cadr (var-initial-value local-var)))
+			      (not (keyword? (var-name local-var))))
+		     (lint-format "pointless local variable: ~A, just use ~A directly" caller (var-name local-var) (var-initial-value local-var)))
+
+		   ;; do all refs to an unset var go through the same function (at some level)
+		   (when (and (> (var-ref local-var) 1)
+			      (pair? (var-history local-var))
+			      (pair? outer-form)                             ; if outer-form is #f, local-var is probably a top-level var
+			      (not (and (memq (car outer-form) '(let let*))  ; not a named-let parameter
+					(symbol? (cadr outer-form)))))
+		     (use-vector caller local-var)
+		     ;; string->byte-vector got no hits, vector->int|float-vector is mostly test stuff, there are only a few a-lists>20 in length
+		     (wrappable-var caller local-var otype outer-form env)))
+
+		 (unless (memq (var-name local-var) '(:lambda :dilambda))
+		   (use-dilambda caller local-var vars env)
+		   (bad-name caller head local-var otype)
+		   (reducible-scope caller local-var otype env)
+		   (if (and (eq? (var-ftype local-var) 'define-expansion)
+			    (not (eq? caller top-level:)))
+		       (out-format outport "~NCdefine-expansion for ~A is not at the top-level, so it is simply define-macro~%"
+			       lint-left-margin #\space
+			       (var-name local-var)))
+
+		   ;; define* -> define is tricky: multiple-values, renaming possibilities, etc
+		   ;; redundant vars are hard to find -- tons of false positives
+
+		   (parlous-port caller local-var outer-form)
+		   (parlous-output-string local-var outer-form)
+
+		   (if (zero? (var-ref local-var))
+		       (unused-var caller head local-var otype)
+		       (let ((vtype #f))
+			 (move-var-inward caller local-var)
+			 (when (and (not (memq (var-definer local-var) '(named-let named-let*)))
+				    (pair? (var-history local-var))
+				    (or (zero? (var-set local-var))
+					(set! vtype (all-types-agree local-var))))
+			   (unless vtype
+			     (set! vtype (or (eq? caller top-level:) ; might be a global var where init value is largely irrelevant
+					     (->lint-type (var-initial-value local-var)))))
+
+			   (let ((lit? (and (code-constant? (var-initial-value local-var))
+					    (not (quoted-null? (var-initial-value local-var)))))) ; something fishy is going on...
+
+			     ;; check each use of the local var
+			     (do ((clause (var-history local-var) (cdr clause)))
+				 ((null? (cdr clause)))             ; ignore the initial value which depends on a different env
+			       (let ((call (car clause)))
+				 (if (pair? call)
+				     (set! line-number (or (pair-line-number call) (max line-number 0))))
+
+				 (when (pair? call)
+				   (let ((func (car call))
+					 (vname (var-name local-var))
+					 (call-arg1 (and (pair? (cdr call)) (cadr call))))
+
+				     ;; check for assignments into constants
+				     (if (and lit?
+					      (sequence? (var-initial-value local-var)) ; not #f = no default
+					      (indirect-set? vname func call-arg1))
+					 (lint-format "~A's ~Avalue, ~S, is a literal constant, so this set! is trouble: ~A" caller
+						      vname
+						      (if (eq? (var-definer local-var) 'parameter) "default " "")
+						      (var-initial-value local-var)
+						      (truncated-list->string
+						       (if (eq? (car call) 'implicit-set)
+							   (cons 'set! (cdr call))
+							   call))))
+
+				     (when (and (symbol? vtype)
+						(not (eq? (var-definer local-var) 'parameter)))
+				       (pointless-if caller vname vtype func call)
+
+				       ;; check for incorrect types in function calls
+				       (unless (memq vtype '(boolean? null?)) ; null? here avoids problems with macros that call set!
+					 (when (len>1? call)
+					   (arg-mismatch caller vname vtype func call env))
+
+					 (let ((suggest made-suggestion))
+					   (pointless-type-check caller local-var vtype func call call-arg1 vars)
+					   ;; the usual eqx confusion
+					   (when (and (= suggest made-suggestion)
+						      (memq vtype '(char? number? integer? real? float? rational? complex?)))
+					     (eqx-type-check caller local-var vtype func call call-arg1)))
+
+					 ;; (x 1) where x is not a sequence is tricky:
+					 ;;   problem here is that e.g. let-values|fluid-let|define-record-structure name|field list becomes a call!
+					 (implicit-type-checks caller local-var vtype func call call-arg1)))))))
+
+			     (duplicated-calls caller local-var env)
+			     (repeated-args caller local-var)))))
+
+		   ;; vars with multiple incompatible ascertainable types don't happen much and obvious type errors are extremely rare
+		   (parlous-return caller local-var env))))
+	     vars)
+	    (set! line-number old-line-number)))))
+
+
+    (define (find-call sym body)
+      (call-with-exit
+       (lambda (return)
+	 (let tree-call ((tree body))
+	   (when (unquoted-pair? tree)
+	     (if (eq? (car tree) sym)
+		 (return tree))
+	     (if (memq (car tree) '(let let* letrec letrec* do lambda lambda* define))
+		 (return #f)) ; possible shadowing -- not worth the infinite effort to corroborate
+	     (if (pair? (car tree))
+		 (tree-call (car tree)))
+	     (if (pair? (cdr tree))
+		 (do ((p (cdr tree) (cdr p)))
+		     ((not (pair? p)) #f)
+		   (tree-call (car p)))))))))
+
+
+    (define (check-returns caller f env) ; f is not the last form in the body
+      (if (not (or (side-effect? f env)
+		   (eq? '=> f)))
+	  (lint-format "this could be omitted: ~A" caller (truncated-list->string f))
+	  (when (pair? f)
+	    (case (car f)
+	      ;; no-side-effect function as (car f) got a couple hits -- not worth the bother
+	      ((if)
+	       (when (len>1? (cdr f))
+		 (let ((true (caddr f))
+		       (false (if (pair? (cdddr f)) (cadddr f) 'no-false)))
+		   (let ((true-ok (side-effect? true env))
+			 (false-ok (or (eq? false 'no-false)
+				       (side-effect? false env))))
+		     (if true-ok
+			 (if (pair? true)
+			     (check-returns caller true env))
+			 (lint-format "this branch is pointless~A: ~A in ~A" caller
+				      (local-line-number true)
+				      (truncated-list->string true)
+				      (truncated-list->string f)))
+		     (if false-ok
+			 (if (pair? false)
+			     (check-returns caller false env))
+			 (lint-format "this branch is pointless~A: ~A in ~A" caller
+				      (local-line-number false)
+				      (truncated-list->string false)
+				      (truncated-list->string f)))))))
+	      ((cond case)
+	       (when (pair? (cdr f))
+		 ;; here all but last result exprs are already checked
+		 ;;   redundant begin can confuse this, but presumably we'll complain about that elsewhere
+		 ;;   also even in mid-body, if else clause has a side-effect, an earlier otherwise pointless clause might be avoiding that
+		 (let ((has-else (let ((last-clause (last-ref f)))
+				   (and (pair? last-clause)
+					(memq (car last-clause) '(else #t))
+					(lint-any? (lambda (c)
+						     (side-effect? c env))
+						   (cdr last-clause))))))
+		   (for-each (lambda (c)
+			       (if (and (len>1? c)
+					(proper-list? c)
+					(not (memq '=> (cdr c))))
+				   (let ((last-expr (last-ref c)))
+				     (cond ((side-effect? last-expr env)
+					    (if (pair? last-expr)
+						(check-returns caller last-expr env)))
+
+					   (has-else
+					    (if (or (pair? (cddr c))
+						    (eq? (car f) 'cond))
+						(lint-format "this ~A clause's result could be omitted" caller
+							     (truncated-list->string c))
+						(if (not (memq last-expr '(#f #t #<unspecified>))) ; it's not already obvious
+						    (lint-format "this ~A clause's result could be simply #f" caller
+								 (truncated-list->string c)))))
+					   ((and (eq? (car f) 'case)
+						 (or (eq? last-expr (cadr c))
+						     (not (lint-any? (lambda (p) (side-effect? p env)) (cdr c)))))
+					    (lint-format "this case clause can be omitted: ~A" caller
+							 (truncated-list->string c)))
+
+					   (else (lint-format "this is pointless: ~A in ~A" caller
+							      (truncated-list->string last-expr)
+							      (truncated-list->string c)))))))
+			     ((if (eq? (car f) 'cond) cdr cddr) f)))))
+
+	      ((let let*)
+	       (if (and (len>1? (cdr f))
+			(not (symbol? (cadr f))))
+		   (let ((last-expr (last-ref f)))
+		     (if (side-effect? last-expr env)
+			 (if (pair? last-expr)
+			     (check-returns caller last-expr env))
+			 (lint-format "this is pointless~A: ~A in ~A" caller
+				      (local-line-number last-expr)
+				      (truncated-list->string last-expr)
+				      (truncated-list->string f))))))
+
+	      ;; perhaps use truncated-lists->string here??
+	      ((and)
+	       (let ((len (length f)))
+		 (case len
+		   ((1) (lint-format "this ~A is pointless" caller f))
+		   ((2) (lint-format "perhaps ~A" caller (lists->string f (cadr f))))
+		   ((3) (lint-format "perhaps ~A" caller (lists->string f (list 'if (cadr f) (caddr f))))) ; (begin (and x (display y)) (log z)) -> (if x (display y))
+		   (else (lint-format "perhaps ~A" caller (lists->string f (list 'if (cadr f) (cons 'and (cddr f)))))))))
+
+	      ((or)
+	       (let ((len (length f)))
+		 (case len
+		   ((1) (lint-format "this ~A is pointless" caller f))
+		   ((2) (lint-format "perhaps ~A" caller (lists->string f (cadr f))))
+		   ((3) (lint-format "perhaps ~A" caller (lists->string f `(if (not ,(cadr f)) ,(caddr f)))))
+		   (else (lint-format "perhaps ~A" caller (lists->string f `(if (not ,(cadr f)) (or ,@(cddr f)))))))))
+
+	      ((not)
+	       (lint-format "this ~A is pointless" caller f))
+
+	      ((letrec letrec* with-let unless when begin with-baffle)
+	       (if (len>1? (cdr f))
+		   (let ((last-expr (last-ref f)))
+		     (if (side-effect? last-expr env)
+			 (if (pair? last-expr)
+			     (check-returns caller last-expr env))
+			 ;; (begin (if x (begin (display x) z)) z)
+			 (lint-format "this is pointless~A: ~A in ~A" caller
+				      (local-line-number last-expr)
+				      (truncated-list->string last-expr)
+				      (truncated-list->string f))))))
+	      ((do)
+	       (let ((returned (if (and (len>1? (cdr f))
+					(list? (caddr f)))
+				   (let* ((end+res (caddr f))
+					  (len (or (length end+res) -1)))
+				     (if (> len 1)
+					 (last-ref end+res))))))
+		 (unless (eq? returned #<unspecified>)
+		   (if (and (pair? returned)
+			    (side-effect? returned env))
+		       (check-returns caller returned env)
+		       ;; (begin (do ((i 0 (+ i 1))) ((= i 10) i) (display i)) x)
+		       (lint-format "~A: result ~A~A is not used" caller
+				    (truncated-list->string f)
+				    (truncated-list->string returned)
+				    (local-line-number returned))))))
+	      ((call-with-exit)
+	       (if (and (pair? (cdr f))
+			(len>1? (cadr f))
+			(eq? (caadr f) 'lambda)
+			(pair? (cadadr f)))
+		   (let ((return (car (cadadr f))))
+		     (let walk ((tree (cddadr f)))
+		       (if (pair? tree)
+			   (if (eq? (car tree) return)
+			       (if (and (pair? (cdr tree))
+					(or (not (boolean? (cadr tree)))
+					    (pair? (cddr tree))))
+				   ;; (begin (call-with-exit (lambda (quit) (if (< x 0) (quit (+ x 1))) (display x))) (+ x 2))
+				   (lint-format "th~A call-with-exit return value~A will be ignored: ~A" caller
+						(if (pair? (cddr tree))
+						    (values "ese" "s")
+						    (values "is" ""))
+						tree))
+			       (for-each walk tree)))))))
+
+	      ((map)
+	       (if (pair? (cdr f))          ;  (begin (map g123 x) x)
+		   (lint-format "map could be for-each: ~A" caller (truncated-list->string (cons 'for-each (cdr f))))))
+
+	      ((reverse!)
+	       (if (pair? (cdr f))          ;  (let ((x (list 23 1 3))) (reverse! x) x)
+		   (lint-format "~A might leave ~A in an undefined state; perhaps ~A" caller (car f) (cadr f)
+				(list 'set! (cadr f) f))))
+
+	      ((lambda lambda*)
+	       (lint-format "this has no effect: ~A" caller (truncated-list->string f)))
+
+	      ((format)
+	       (if (and (pair? (cdr f))
+			(eq? (cadr f) #t))  ;  (let () (format #t "~A" x) x)
+		   (lint-format "perhaps use () with format since the string value is discarded:~%    ~A"
+				caller (cons 'format (cons () (cddr f))))))))))
+
+    (define lint-current-form #f)
+    (define lint-mid-form #f)
+
+    (define (escape? form env)
+      (and (pair? form)
+	   (let ((v (var-member (car form) env)))
+	     (if v
+		 (memq (var-definer v) '(call/cc call-with-current-continuation call-with-exit))
+		 (memq (car form) '(error throw))))))
+
+
+    (define (lint-walk-body caller head body env)
+      (when (pair? body)
+	(when (len>1? (car body))
+
+	  (when (and (not (eq? last-rewritten-internal-define (car body))) ; we already rewrote this
+		     (pair? (cdr body))                ; define->named let, but this is only ok in a "closed" situation, not (begin (define...)) for example
+		     (pair? (cadr body))
+		     (memq (caar body) '(define define*))
+		     (pair? (cadar body)))
+	    (let ((fname (caadar body))
+		  (fargs (cdadar body))
+		  (fbody (cddar body)))
+	      (when (and (symbol? fname)
+			 (proper-list? fargs)
+			 (proper-list? body)
+			 (= (tree-count fname (cdr body) 2) 1)
+			 (not (any-keywords? fargs)))
+		(let ((call (find-call fname (cdr body))))
+		  (when (pair? call)
+		    (let ((new-args (if (eq? (caar body) 'define)
+					(map list fargs (cdr call))
+					(let loop ((pars fargs)
+						   (vals (cdr call))
+						   (args ()))
+					  (if (null? pars)
+					      (reverse args)
+					      (loop (cdr pars)
+						    (if (pair? vals)
+							(values (cdr vals)
+								(cons (list ((if (pair? (car pars)) caar car) pars) (car vals)) args))
+							(values ()
+								(cons (if (pair? (car pars)) (car pars) (list (car pars) #f)) args))))))))
+			  (new-let (if (eq? (caar body) 'define) 'let 'let*)))
+		      (if (and (len>1? fbody)
+			       (string? (car fbody)))
+			  (set! fbody (cdr fbody)))
+		      ;; (... (define* (f1 a b) (+ a b)) (f1 :c 1)) -> (... (let ((a :c) (b 1)) (+ a b)))
+		      (lint-format "perhaps ~A" caller
+				   (lists->string (cons '... body)
+						  (if (= (tree-count fname body 3) 2)
+						      (if (null? fargs)
+							  (if (null? (cdr fbody))
+							      (cons '... (tree-subst (car fbody) call (cdr body)))
+							      `(... ,@(tree-subst `(let () ,@fbody) call (cdr body))))
+							  `(... ,@(tree-subst `(let ,new-args ,@fbody) call (cdr body))))
+						      `(... ,@(tree-subst `(,new-let ,fname ,new-args ,@fbody) call (cdr body))))))))))))
+
+	  ;; look for non-function defines at the start of the body and use let(*) instead
+	  ;;   we're in a closed body here, so the define can't propagate backwards
+	  (let ((first-expr (car body)))
+	    ;; another case: f(args) (let(...)set! arg < no let>)
+	    (when (and (eq? (car first-expr) 'define)
+		       (symbol? (cadr first-expr))
+		       (pair? (cddr first-expr))
+		       ;;(not (tree-car-member (cadr first-expr) (caddr first-expr)))
+		       ;;(not (tree-set-car-member '(lambda lambda*) (caddr first-expr)))
+		       (not (and (pair? (caddr first-expr))
+				 (memq (caaddr first-expr) '(lambda lambda*))))
+		       (> (length body) 2))
+	      ;; this still is not ideal -- we need to omit let+lambda as well
+	      (do ((names ())
+		   (letx 'let)
+		   (vars&vals ())
+		   (p body (cdr p)))
+		  ((not (and (pair? p)
+			     (let ((expr (car p)))
+			       (and (len>2? expr)
+				    (eq? (car expr) 'define)
+				    (symbol? (cadr expr))          ; not (define (f ...))
+				    (not (and (pair? (caddr expr)) ; not (define f (lambda...))
+					      (memq (caaddr expr) '(lambda let lambda* let* letrec letrec*))))))))
+		   ;; (... (define x 3) 32) -> (... (let ((x 3)) ...))
+		   (if (pair? vars&vals)
+		       (lint-format "perhaps ~A" caller
+				    (lists->string (cons '... body)
+						   (list '... (list letx (reverse vars&vals) '...))))))
+		;; define acts like letrec(*), not let -- reference to name in lambda body is current name
+		(let ((expr (cdar p)))
+		  (set! vars&vals (cons (if (< (lint-tree-leaves (cdr expr)) 12)
+					    expr
+					    (list (car expr) '...))
+					vars&vals))
+		  (if (lint-tree-set-memq names (cdr expr))
+		      (set! letx 'let*))
+		  (set! names (cons (car expr) names)))))))
+
+	(let ((len (length body)))
+	  (when (> len 2)                           ; ... (define (x...)...) (x ...) -> (let (...) ...) or named let -- this happens a lot!
+	    (let ((n-1 (list-ref body (- len 2)))   ; or (define (x ...)...) (some expr calling x once) -> named let etc
+		  (n (list-ref body (- len 1))))
+	      (when (and (pair? n-1)
+			 (eq? (car n-1) 'define)
+			 (proper-pair? (cadr n-1))
+			 (symbol? (caadr n-1))
+			 (pair? n)
+			 (or (and (eq? (car n) (caadr n-1))
+				  (eqv? (length (cdadr n-1)) (length (cdr n)))) ; not values -> let!
+			     (and (< (lint-tree-leaves n-1) 12)
+				  (tree-car-member (caadr n-1) (cdr n))         ; skip car -- see preceding
+				  (= (tree-count (caadr n-1) n 2) 1))))
+		(let ((outer-form (cond ((var-member :let env) => var-initial-value) (else #f)))
+		      (new-var (caadr n-1)))
+		  (when (and (pair? outer-form)
+			     (not (let walker ((tree outer-form)) ; check even the enclosing env -- define in do body back ref'd in stepper for example
+				    (or (eq? new-var tree)
+					(and (unquoted-pair? tree)
+					     (not (eq? n tree))
+					     (not (eq? n-1 tree))
+					     (or (walker (car tree))
+						 (walker (cdr tree))))))))
+		    (let ((named (if (lint-tree-memq new-var (cddr n-1)) (list new-var) ())))
+		      (if (eq? (car n) (caadr n-1))
+			  (lint-format "perhaps change ~A to a ~Alet: ~A" caller new-var (if (pair? named) "named " "")
+				       (lists->string outer-form `(... (let ,@named ,(map list (cdadr n-1) (cdr n)) ...))))
+			  (let ((call (find-call new-var n)))
+			    (when (and (pair? call)
+				       (eqv? (length (cdadr n-1)) (length (cdr call))))
+			      (let ((new-call `(let ,@named ,(map list (cdadr n-1) (cdr call)) ,@(cddr n-1))))
+				(lint-format "perhaps embed ~A: ~A" caller new-var
+					     (lists->string outer-form (list '... (tree-subst new-call call n)))))))))))))
+
+	    (let ((suggest made-suggestion))
+	      (unless (lint-tree-memq 'curlet (list-ref body (- len 1)))
+		(do ((q body (cdr q))
+		     (k 0 (+ k 1)))
+		    ((null? q))
+		  (let ((expr (car q)))
+		    (when (and (len=3? expr)
+			       (eq? (car expr) 'define))
+		      (let ((name (and (symbol? (cadr expr)) (cadr expr))))
+			(when name
+			  (do ((lastref k)
+			       (p (cdr q) (cdr p))
+			       (i (+ k 1) (+ i 1)))
+			      ((null? p)
+			       (if (and (< k lastref (+ k 2))
+					(pair? (list-ref body (+ k 1))))
+				   (let ((end-dots (if (< lastref (- len 1)) '(...) ()))
+					 (letx (if (lint-tree-memq name (cddr expr)) 'letrec 'let))
+					 (use-expr (list-ref body (+ k 1)))
+					 (seen-earlier (or (var-member name env)
+							   (do ((s body (cdr s)))
+							       ((or (eq? s q)
+								    (and (pair? (car s))
+									 (lint-tree-memq name (car s))))
+								(not (eq? s q)))))))
+				     (cond (seen-earlier)
+
+					   ((not (eq? (car use-expr) 'define))
+					    (let-temporarily ((target-line-length 120))
+					      ;; (... (define f14 (lambda (x y) (if (positive? x) (+ x y) y))) (+ (f11 1 2) (f14 1 2))) ->
+					      ;;    (... (let ((f14 (lambda (x y) (if (positive? x) (+ x y) y)))) (+ (f11 1 2) (f14 1 2))))
+					      (lint-format "the scope of ~A could be reduced: ~A" caller name
+							   (truncated-lists->string (cons '... (cons expr (cons use-expr end-dots)))
+										    (cons '... (cons (list letx
+													   (list (list name (caddr expr)))
+													   use-expr)
+												     end-dots))))))
+					   ((eq? (cadr use-expr) name)
+					    ;; (let () (display 33) (define x 2) (define x (+ x y)) (display 43)) ->
+					    ;;    (... (set! x (+ x y)) ...)
+					    (lint-format "use set! to redefine ~A: ~A" caller name
+							 (lists->string (cons '... (cons use-expr end-dots))
+									(cons '... (cons (list 'set! name (caddr use-expr)) end-dots)))))
+					   ((pair? (cadr use-expr))
+					    (if (symbol? (caadr use-expr))
+						(let-temporarily ((target-line-length 120))
+						  ;; (let () (display 32) (define x 2) (define (f101 y) (+ x y)) (display 41) (f101 2)) ->
+						  ;;    (... (define f101 (let ((x 2)) (lambda (y) (+ x y)))) ...)
+						  (lint-format "perhaps move ~A into ~A's closure: ~A" caller name (caadr use-expr)
+							       (truncated-lists->string `(... ,expr ,use-expr ,@end-dots)
+											`(... (define ,(caadr use-expr)
+												(,letx ((,name ,(caddr expr)))
+												       (lambda ,(cdadr use-expr)
+													 ,@(cddr use-expr))))
+											      ,@end-dots))))))
+					   ((and (symbol? (cadr use-expr))
+						 (pair? (cddr use-expr)))
+					    (let-temporarily ((target-line-length 120))
+					      (if (and (pair? (caddr use-expr))
+						       (eq? (caaddr use-expr) 'lambda))
+						  ;; (let () (display 34) (define x 2) (define f101 (lambda (y) (+ x y))) (display 41) (f101 2))
+						  ;;    (... (define f101 (let ((x 2)) (lambda (y) (+ x y)))) ...)
+						  (lint-format "perhaps move ~A into ~A's closure: ~A" caller name (cadr use-expr)
+							       (truncated-lists->string `(... ,expr ,use-expr ,@end-dots)
+											`(... (define ,(cadr use-expr)
+												(,letx ((,name ,(caddr expr)))
+												       ,(caddr use-expr)))
+											      ,@end-dots)))
+						  ;; (... (define lib (r file)) (define exports (caddr lib)) ...) ->
+						  ;;    (... (define exports (let ((lib (r file))) (caddr lib))) ...)
+						  (lint-format "the scope of ~A could be reduced: ~A" caller name
+							       (truncated-lists->string `(... ,expr ,use-expr ,@end-dots)
+											`(... (define ,(cadr use-expr)
+												(,letx ((,name ,(caddr expr)))
+												       ,(caddr use-expr)))
+											      ,@end-dots))))))))
+				   (when (and (> len 3)
+					      (< k lastref (+ k 3))  ; larger cases happen very rarely -- 3 or 4 altogether
+					      (pair? (list-ref body (+ k 1)))
+					      (pair? (list-ref body (+ k 2))))
+				     (let ((end-dots (if (< lastref (- len 1)) '(...) ()))
+					   (letx (if (lint-tree-memq name (cddr expr)) 'letrec 'let))
+					   (seen-earlier (or (var-member name env)
+							     (do ((s body (cdr s)))
+								 ((or (eq? s q)
+								      (and (pair? (car s))
+									   (lint-tree-memq name (car s))))
+								  (not (eq? s q)))))))
+				       (unless seen-earlier
+					 (let ((use-expr1 (list-ref body (+ k 1)))
+					       (use-expr2 (list-ref body (+ k 2))))
+					   (if (not (or (lint-tree-set-memq '(define lambda) use-expr1)
+							(lint-tree-set-memq '(define lambda) use-expr2)))
+					       ;; (... (define f101 (lambda (y) (+ x y))) (display 41) (f101 2)) ->
+					       ;;    (... (let ((f101 (lambda (y) (+ x y)))) (display 41) (f101 2)))
+					       (lint-format "the scope of ~A could be reduced: ~A" caller name
+							    (let-temporarily ((target-line-length 120))
+							      (truncated-lists->string `(... ,expr ,use-expr1 ,use-expr2 ,@end-dots)
+										       `(... (,letx ((,name ,(caddr expr)))
+												    ,use-expr1
+												    ,use-expr2)
+											     ,@end-dots)))))))))))
+			    (when (lint-tree-memq name (car p))
+			      (set! lastref i)))))))))
+
+	      (when (= suggest made-suggestion)
+		;; look for define+binding-expr at end and combine
+		(do ((prev-f #f)
+		     (fs body (cdr fs)))
+		    ((not (pair? fs)))
+		  (let ((f (car fs)))
+		    ;; define can come after the use, and in an open body can be equivalent to set!:
+		    ;;   (let () (if x (begin (define y 12) (do ((i 0 (+ i 1))) ((= i y)) (f i))) (define y 21)) y)
+		    ;;   (let () (define (f x) (+ y x)) (if z (define y 12) (define y 1)) (f 12))
+		    ;; so we can't do this check in walk-open-body
+		    ;;
+		    ;; define + do -- if cadr prev-f not used in do inits, fold into do, else use let
+		    ;;   the let case is semi-redundant (it's already reported elsewhere)
+		    (when (and (len>1? prev-f)
+			       (len>1? f)
+			       (eq? (car prev-f) 'define)
+			       (symbol? (cadr prev-f))
+			       (list? (cadr f))
+			       (not (hash-table-ref other-identifiers (cadr prev-f))) ; (cadr prev-f) already ref'd, so it's a member of env
+			       (or (null? (cdr fs))
+				   (not (lint-tree-memq (cadr prev-f) (cdr fs)))))
+		      (if (and (eq? (car f) 'do)
+			       (len>2? f)
+			       (proper-list? (cadr f)))
+			  ;; (... (define z (f x)) (do ((i z (+ i 1))) ((= i 3)) (display (+ z i))) ...) -> (do ((i (f x) (+ i 1))) ((= i 3)) (display (+ z i)))
+			  (lint-format "perhaps ~A" caller
+				       (lists->string (list '... prev-f f '...)
+						      (if (lint-any? (lambda (p)
+								       (and (len>1? p)
+									    (lint-tree-memq (cadr prev-f) (cadr p))))
+								     (cadr f))
+							  (if (and (eq? (cadr prev-f) (cadr (caadr f)))
+								   (null? (cdadr f)))
+							      `(do ((,(caaadr f) ,(caddr prev-f) ,(caddr (caadr f)))) ,@(cddr f))
+							      `(let (,(cdr prev-f)) ,f))
+							  `(do (,(cdr prev-f)
+								,@(cadr f))
+							       ,@(cddr f)))))
+			  ;; just changing define -> let seems officious, though it does reduce (cadr prev-f)'s scope
+			  (if (and (proper-list? (cadr f))
+				   (or (and (eq? (car f) 'let)
+					    (not (lint-tree-memq (cadr prev-f) (cadr f))))
+				       (eq? (car f) 'let*)))
+			      (lint-format "perhaps ~A" caller
+					   (lists->string
+					    `(... ,prev-f ,f ,@(if (null? (cdr fs)) () '(...)))
+					    `(... (,(car f) (,(cdr prev-f) ,@(cadr f)) ...) ,@(if (null? (cdr fs)) () '(...))))))))
+		    (set! prev-f f))))))))
+
+      ;; definer as last in body is rare outside let-syntax, and tricky -- only one clear optimizable case found
+      (lint-walk-open-body caller head body env))
+
+    (define lint-walk-open-body
+      (let ()
+
+	;; -------- tree-change-member --------
+	(define (tree-change-member set tree)
+	  (and (unquoted-pair? tree)
+	       (or (and (eq? (car tree) 'set!)
+			(pair? (cdr tree)) ; a bug -- case with (set!) as key has confused tree-change-member!
+			(memq (cadr tree) set))
+		   (tree-change-member set (car tree))
+		   (tree-change-member set (cdr tree)))))
+
+	;; -------- combine-successive-ifs
+	(define (combine-successive-ifs caller fs prev-f f env)
+	  (let ((test1 (cadr prev-f))
+		(test2 (cadr f))
+		(f-func (and (pair? f) (car f))))
+	    ;;     (if A...) (if (not A)...) happens very rarely -- only two rewritable hits
+	    (let ((equal-tests  ; test1 = test2 [check for side-effects already]
+		   (lambda ()
+
+		     (if (and (pair? (caddr prev-f))
+			      (escape? (caddr prev-f) env))
+			 ;; (begin (if x (error 'oops)) (if x y)) -> begin: x is #f in (if x y) -- this never happens
+			 (lint-format "~A is #f in ~A" caller
+				      test2 (truncated-list->string f)))
+
+		     ;; (... (if (and A B) (f C)) (if (and B A) (g E) (h F)) ...) -> (... (if (and A B) (begin (f C) (g E)) (begin (h F))) ...)
+		     (lint-format "perhaps ~A" caller
+				  (lists->string
+				   (list '... prev-f f '...)
+				   (if (eq? f-func 'if)
+				       (if (and (null? (cdddr prev-f))
+						(null? (cdddr f)))
+					   ;; if (null (cdr fs)) we have to make sure the returned value is not changed by our rewrite
+					   ;;   but when/unless return their last value in s7 (or #<unspecified>), so I think this is ok
+					   (if (and (pair? test1)
+						    (eq? (car test1) 'not))
+					       `(... (unless ,(cadr test1)
+						       ,@(unbegin (caddr prev-f))
+						       ,@(unbegin (caddr f))) ...)
+					       `(... (when ,test1
+						       ,@(unbegin (caddr prev-f))
+						       ,@(unbegin (caddr f))) ...))
+					   `(... (if ,test1
+						     (begin
+						       ,@(unbegin (caddr prev-f))
+						       ,@(unbegin (caddr f)))
+						     (begin
+						       ,@(if (pair? (cdddr prev-f)) (unbegin (cadddr prev-f)) ())
+						       ,@(if (pair? (cdddr f)) (unbegin (cadddr f)) ())))
+						 ...))
+				       `(,f-func ,test1 ; f-func = when|unless
+						 ,@(cddr prev-f)
+						 ,@(cddr f)))))))
+		  (test1-in-test2
+		   (lambda ()
+		     (if (null? (cddr test2))
+			 (set! test2 (cadr test2)))
+		     ;;     (... (if A (f B)) (when (and A C) (g D) (h E)) ...) -> (... (when A (f B) (when C (g D) (h E))) ...)
+		     (lint-format "perhaps ~A" caller
+				  (lists->string (list '... prev-f f '...)
+						 (if (or (null? (cdddr prev-f))
+							 (eq? (car prev-f) 'when)) ; so prev-f is when or 1-arm if (as is f)
+						     `(... (when ,test1
+							     ,@(cddr prev-f)
+							     (when ,test2
+							       ,@(cddr f)))
+							   ,@(if (null? (cdr fs)) () '(...)))
+						     ;; prev-f is 2-arm if and f is when or 1-arm if (the other case is too ugly)
+						     `(... (if ,test1
+							       (begin
+								 ,(caddr prev-f)
+								 (when ,test2
+								   ,@(cddr f)))
+							       ,@(cdddr prev-f)) ...))))))
+
+		  (test2-in-test1
+		   (lambda ()
+		     (if (null? (cddr test1))
+			 (set! test1 (cadr test1)))
+		     ;; (... (if (and A B) (f C)) (if A (g E)) ...) -> (... (when A (when B (f C)) (g E)))
+		     (lint-format "perhaps ~A" caller
+				  (lists->string (list '... prev-f f '...)
+						 (if (or (null? (cdddr f))
+							 (eq? f-func 'when)) ; so f is when or 1-arm if (as is prev-f)
+						     `(... (when ,test2
+							     (when ,test1
+							       ,@(cddr prev-f))
+							     ,@(cddr f))
+							   ,@(if (null? (cdr fs)) () '(...)))
+						     ;; f is 2-arm if and prev-f is when or 1-arm if
+						     `(... (if ,test2
+							       (begin
+								 (when ,test1
+								   ,@(cddr prev-f))
+								 ,(caddr f))
+							       ,(cadddr f))
+							   ,@(if (null? (cdr fs)) () '(...)))))))))
+
+	      (cond ((equal? test1 test2)
+		     (when (and (eq? f-func (car prev-f))
+				(not (side-effect? test1 env)))
+		       (if (not (tree-change-member (gather-symbols test1) (cdr prev-f)))
+			   (equal-tests)
+			   ;; (if A b) (if A c) -> (when A b (if A c)))
+			   ;; (when A b) (when A c) -> (when A b (when A c))
+			   (if (and (or (not (eq? (car prev-f) 'if))
+					(= (length prev-f) 3))
+				    (or (not (eq? f-func 'if))
+					(= (length f) 3)))
+			       (lint-format "perhaps ~A" caller
+					    (lists->string (list '... prev-f f '...)
+							   (let ((func (if (eq? f-func 'unless) 'unless 'when)))
+							     `(... (,func ,test1
+									  ,@(if (eq? (car prev-f) 'if)
+										(unbegin (caddr prev-f))
+										(cddr prev-f))
+									  (,func ,test1
+										 ,@(if (eq? f-func 'if)
+										       (unbegin (caddr f))
+										       (cddr f))))
+								   ...))))))))
+		    ((or (eq? f-func 'unless)
+			 (eq? (car prev-f) 'unless))) ; too hard!
+
+		    ;; look for test1 as member of test2 (so we can use test1 as the outer test)
+		    ((and (pair? test2)
+			  (eq? (car test2) 'and)
+			  (member test1 (cdr test2))
+			  (or (eq? f-func 'when)     ; f has to be when or 1-arm if
+			      (null? (cdddr f)))
+			  (or (pair? (cdr fs))        ; if prev-f has false branch, we have to ignore the return value of f
+			      (eq? (car prev-f) 'when)
+			      (null? (cdddr prev-f)))
+			  (not (side-effect? test2 env))
+			  (not (tree-change-member (gather-symbols test1) (cddr prev-f))))
+		     (set! test2 (remove-one test1 test2))
+		     (test1-in-test2))
+
+		    ;; look for test2 as member of test1
+		    ((and (pair? test1)
+			  (eq? (car test1) 'and)
+			  (member test2 (cdr test1))
+			  (or (eq? (car prev-f) 'when)     ; prev-f has to be when or 1-arm if
+			      (null? (cdddr prev-f)))
+			  (not (side-effect? test1 env))
+			  (not (tree-change-member (gather-symbols test2) (cddr prev-f))))
+		     (set! test1 (remove-one test2 test1))
+		     (test2-in-test1))
+
+		    ;; look for some intersection of test1 and test2
+		    ((and (pair? test1)
+			  (pair? test2)
+			  (eq? (car test1) 'and)
+			  (eq? (car test2) 'and)
+			  (not (side-effect? test1 env))
+			  (not (side-effect? test2 env))
+			  (not (tree-change-member (gather-symbols test2) (cddr prev-f))))
+		     (let ((intersection ())
+			   (new-test1 ())
+			   (new-test2 ()))
+		       (for-each (lambda (tst)
+				   (if (member tst test2)
+				       (set! intersection (cons tst intersection))
+				       (set! new-test1 (cons tst new-test1))))
+				 (cdr test1))
+		       (for-each (lambda (tst)
+				   (if (not (member tst test1))
+				       (set! new-test2 (cons tst new-test2))))
+				 (cdr test2))
+		       (when (pair? intersection)
+			 (if (null? new-test1)
+			     (if (null? new-test2)
+				 (begin
+				   (set! test1 (cons 'and (reverse intersection)))
+				   (equal-tests))
+				 (when (and (or (eq? f-func 'when)
+						(null? (cdddr f)))
+					    (or (pair? (cdr fs))
+						(eq? (car prev-f) 'when)
+						(null? (cdddr prev-f))))
+				   (set! test1 (cons 'and (reverse intersection)))
+				   (set! test2 (cons 'and (reverse new-test2)))
+				   (test1-in-test2)))
+			     (if (null? new-test2)
+				 (when (or (eq? (car prev-f) 'when)
+					   (null? (cdddr prev-f)))
+				   (set! test2 (cons 'and (reverse intersection)))
+				   (set! test1 (cons 'and (reverse new-test1)))
+				   (test2-in-test1))
+
+				 (when (and (or (eq? f-func 'when)
+						(null? (cdddr f)))
+					    (or (eq? (car prev-f) 'when)
+						(null? (cdddr prev-f))))
+				   ;; (... (if (and A B) (f C)) (when (and B C) (g E)) ...) -> (... (when B (when A (f C)) (when C (g E))))
+				   (lint-format "perhaps ~A" caller
+						(let ((outer-test (if (null? (cdr intersection))
+								      (car intersection)
+								      (cons 'and (reverse intersection)))))
+						  (set! new-test1 (if (null? (cdr new-test1))
+								      (car new-test1)
+								      (cons 'and (reverse new-test1))))
+						  (set! new-test2 (if (null? (cdr new-test2))
+								      (car new-test2)
+								      (cons 'and (reverse new-test2))))
+						  (lists->string (list '... prev-f f '...)
+								 `(... (when ,outer-test
+									 (when ,new-test1
+									   ,@(cddr prev-f))
+									 (when ,new-test2
+									   ,@(cddr f)))
+								       ,@(if (null? (cdr fs)) () '(...))))))))))))))))
+
+	;; -------- ifs->case --------
+	(define (ifs->case caller fs prev-f f)
+	  ;; successive if's that can be combined into case
+	  ;;   else in last if could be accommodated as well
+	  ;; f and prev-f are known to be len=3 pairs here
+	  (and (eq? (car f) 'if)
+	       (eq? (car prev-f) 'if)
+	       (pair? (cadr f))
+	       (pair? (cadr prev-f))
+	       (memq (caadr prev-f) '(eq? eqv? = char=?)) ; not memx
+	       (memq (caadr f) '(eq? eqv? = char=?))
+	       (let ((a1 (cadadr prev-f))
+		     (a2 (caddr (cadr prev-f)))
+		     (b1 (cadadr f))
+		     (b2 (caddr (cadr f))))  ; other possibilities are never hit
+		 (and (equal? a1 b1)
+		      (code-constant? a2)
+		      (code-constant? b2)
+		      (not (tree-change-member (list a1) (cddr prev-f))) ; or any symbol in a1?
+		      ;; (... (if (= x 1) (display y)) (if (= x 2) (f y)) ...) -> (case x ((1) (display y)) ((2) (f y)) ((3) (display z)))
+		      (lint-format "perhaps ~A" caller
+				   (lists->string (list '... prev-f f '...)
+						  `(case ,a1
+						     ((,(unquoted a2)) ,@(unbegin (caddr prev-f)))
+						     ((,(unquoted b2)) ,@(unbegin (caddr f)))
+						     ,@(do ((more ())
+							    (nfs (cdr fs) (cdr nfs)))
+							   ((let ((nf (if (pair? nfs) (car nfs) ())))
+							      (not (and (len=3? nf)
+									(eq? (car nf) 'if)
+									(pair? (cadr nf))
+									(memq (caadr nf) '(eq? eqv? = char=?))
+									(equal? a1 (cadadr nf))
+									(code-constant? (caddr (cadr nf))))))
+							    ;; maybe add (not (tree-change-member (list a1) (cddr last-f)))
+							    ;;   but it never is needed
+							    (reverse more))
+							 (if (pair? nfs)
+							     (set! more (cons (cons (list (unquoted (caddr (cadar nfs))))
+										    (unbegin (caddar nfs)))
+									      more)))))))
+		      #t))))
+
+	;; -------- repeats->for-each --------
+	(define (repeats->for-each caller prev-f fs-end repeats start-repeats repeat-arg env)
+	  ;; check for repeated calls, but only one arg currently can change (more args = confusing separation in code)
+	  (if (zero? repeat-arg)		    ; simple case -- all exprs are identical
+	      (let ((step 'i))
+		(if (lint-tree-memq step prev-f)
+		    (set! step (find-unique-name prev-f)))
+		(lint-format "perhaps ~A... ->~%~NC(do ((~A 0 (+ ~A 1))) ((= ~A ~D)) ~A)" caller
+			     (truncated-list->string prev-f)
+			     pp-left-margin #\space
+			     step step step (+ repeats 1)                                  ; only use of repeats
+			     prev-f))
+
+	      (let ((args ())
+		    (constants? #t)
+		    (func-name (car prev-f))
+		    (new-arg (if (lint-tree-memq 'arg prev-f)
+				 (find-unique-name prev-f)
+				 'arg)))
+		(do ((p start-repeats (cdr p)))
+		    ((eq? p fs-end))
+		  (set! args (cons (list-ref (car p) repeat-arg) args))
+		  (if constants? (set! constants? (code-constant? (car args)))))
+
+		(let ((func (if (and (= repeat-arg 1)
+				     (null? (cddar start-repeats)))
+				func-name
+				(list 'lambda (list new-arg)
+				      (let ((call (copy prev-f)))
+					(list-set! call repeat-arg new-arg)
+					call)))))
+		  (if constants?
+		      (lint-format "perhaps ~A... ->~%~NC(for-each ~S '(~{~S~^ ~}))" caller
+				   (truncated-list->string (car start-repeats))
+				   pp-left-margin #\space
+				   func
+				   (map unquoted (reverse args)))
+		      (let ((v (var-member func-name env)))                                  ; only use of env
+			(if (or (and v
+				     (memq (var-ftype v) '(define define* lambda lambda*)))
+				(procedure? func-name) ; e.g. list-values??
+				(procedure? (symbol->value func-name *e*)))
+			    ;; (let () (write-byte 0) (write-byte 1) (write-byte 2) (write-byte 3) (write-byte 4)) ->
+			    ;;    (for-each write-byte '(0 1 2 3 4))
+			    (lint-format "perhaps ~A... ->~%~NC(for-each ~S (vector ~{~S~^ ~}))" caller
+					 ;; vector rather than list because it is easier on the GC (list copies in s7)
+					 (truncated-list->string (car start-repeats))
+					 pp-left-margin #\space
+					 func
+					 (reverse args))
+			    (if (not (or v
+					 (macro? (symbol->value func-name *e*))))
+				;; (let () (writ 0) (writ 1) (writ 2) (writ 3) (writ (* x 2))) -> (for-each writ (vector 0 1 2 3 (* x 2)))
+				(lint-format "assuming ~A is not a macro, perhaps ~A" caller
+					     func-name
+					     (lists->string (list '... (car start-repeats) '...)
+							    (list 'for-each func (cons 'vector (reverse args)))))))))))))
+
+	;; -------- set-cxr->copy --------
+	(define (set-cxr->copy caller prev-f f ctr len)
+	  ;; set-car! + set-cdr! here is usually "clever" code assuming eq?ness, so we can't rewrite it using cons
+	  ;;   but copy does not create a new cons... [if at end of body, the return values will differ]
+	  (let ((f-func (car f)))
+	    (when (and (memq f-func '(set-car! set-cdr!))  ; ...(set-car! x (car y)) (set-cdr! x (cdr y))... -> (copy y x)
+		       (memq (car prev-f) '(set-car! set-cdr!))
+		       (not (eq? (car prev-f) f-func))
+		       (equal? (cadr f) (cadr prev-f)))
+	      (let ((ncar (caddr (if (eq? f-func 'set-car!) f prev-f)))
+		    (ncdr (caddr (if (eq? f-func 'set-car!) prev-f f))))
+		(if (and (pair? ncar)
+			 (eq? (car ncar) 'car)
+			 (pair? ncdr)
+			 (eq? (car ncdr) 'cdr)
+			 (equal? (cadr ncar) (cadr ncdr)))
+		    (lint-format "perhaps ~A~A ~A~A -> ~A" caller
+				 (if (= ctr 0) "" "...")
+				 (truncated-list->string prev-f)
+				 (truncated-list->string f)
+				 (if (= ctr (- len 1)) "" "...")
+				 (list 'copy (cadr ncar) (cadr f))))))))
+
+	;; -------- combine-sets --------
+	(define (combine-sets caller prev-f f env)
+	  (let ((arg1 (caddr prev-f))
+		(arg2 (caddr f))
+		(settee (cadr f)))
+
+	    (if (and (or (and (equal? settee arg1)          ; (set! x y) (set! y x)
+			      (equal? arg2 (cadr prev-f)))
+			 (and (equal? settee (cadr prev-f)) ; (set! x y) (set! x y)
+			      (equal? arg1 arg2)))
+		     (not (tree-equal-member settee arg2)))
+		(lint-format "this pair of set!s looks odd: ~A" caller
+			     (list '... prev-f f '...)))
+
+	    (cond ((not (eq? settee (cadr prev-f)))
+		   (if (and (symbol? (cadr prev-f)) ; (set! x (A)) (set! y (A)) -> (set! x (A)) (set! y x)
+			    (unquoted-pair? arg1)   ;   maybe more trouble than it's worth
+			    (equal? arg1 arg2)
+			    (hash-table-ref no-side-effect-functions (car arg1))
+			    (not (tree-unquoted-member (cadr prev-f) arg1))
+			    (not (side-effect? arg1 env))
+			    (not (maker? arg1)))
+		       (lint-format "perhaps ~A" caller (lists->string f (list 'set! settee (cadr prev-f))))))
+
+		  ((not (and (pair? arg2)          ; (set! x 0) (set! x 1) -> "this could be omitted: (set! x 0)"
+			     (lint-tree-memq settee arg2)))
+		   (if (not (or (side-effect? arg1 env)
+				(side-effect? arg2 env)))
+		       (lint-format "this could be omitted: ~A" caller prev-f)))
+
+		  ((not (pair? arg2)))
+
+		  ((and (pair? arg1)               ; (set! x (cons 1 z)) (set! x (cons 2 x)) -> (set! x (cons 2 (cons 1 z)))
+			(eq? (car arg1) 'cons)
+			(eq? (car arg2) 'cons)
+			(eq? settee (caddr arg2))
+			(not (eq? settee (cadr arg2))))
+		   (lint-format "perhaps ~A ~A -> ~A" caller
+				prev-f f
+				`(set! ,settee (cons ,(cadr arg2) (cons ,@(cdr arg1))))))
+
+		  ((and (pair? arg1)               ; (set! x (append x y)) (set! x (append x z)) -> (set! x (append x y z))
+			(eq? (car arg1) 'append)
+			(eq? (car arg2) 'append)
+			(eq? settee (cadr arg1))
+			(eq? settee (cadr arg2))
+			(not (lint-tree-memq settee (cddr arg1)))
+			(not (lint-tree-memq settee (cddr arg2))))
+		   (lint-format "perhaps ~A ~A -> ~A" caller
+				prev-f f
+				`(set! ,settee (append ,settee ,@(cddr arg1) ,@(cddr arg2)))))
+
+		  ((and (= (tree-count settee arg2 2) 1)   ; (set! x y) (set! x (+ x 1)) -> (set! x (+ y 1))
+			(or (not (pair? arg1))
+			    (< (lint-tree-leaves arg1) 5)))
+		   (lint-format "perhaps ~A ~A ->~%~NC~A" caller
+				prev-f f pp-left-margin #\space
+				(object->string (list 'set! settee (tree-subst arg1 settee arg2))))))))
+
+	;; -------- redundant-set --------
+	(define (redundant-set caller prev-f f env)
+	  (cond ((and (eq? f #t)
+		      (if (eq? (car prev-f) 'set!)
+			  (and (len=2? (cdr prev-f))
+			       (pair? (caddr prev-f))
+			       (arg-signature (caaddr prev-f) env))
+			  (arg-signature (car prev-f) env)))
+		 => (lambda (sig)
+		      (if (not (or (memq (car sig) '(#t values boolean))
+				   (and (pair? (car sig))
+					(memq 'boolean (car sig)))))
+			  (lint-format "#t is probably redundant; ~A can't return #f" caller
+				       ((if (eq? (car prev-f) 'set!) caaddr car) prev-f)))))
+		((and (member f '(#<unspecified> (values)))
+		      (memq (car prev-f) '(for-each newline close-input-port close-output-port close-port)))
+		 (lint-format "~A is redundant; ~A returns #<unspecified>" caller f (car prev-f)))))
+
+	;; -------- redundant-return --------
+	(define (redundant-return caller body prev-f f env)
+	  (case (car prev-f)
+	    ((display write write-char write-byte)
+	     (if (and (equal? f (cadr prev-f))
+		      (not (side-effect? f env)))
+		 ;; (cond ((= x y) y) (else (begin (display x) x)))
+		 (lint-format "~A returns its first argument, so this could be omitted: ~A" caller
+			      (car prev-f) (truncated-list->string f))))
+
+	    ((vector-set! float-vector-set! int-vector-set! string-set! list-set! hash-table-set! let-set!  set-car! set-cdr!)
+	     (if (equal? f (last-ref prev-f))
+		 ;; (begin (vector-set! x 0 (* y 2)) (* y 2))
+		 (lint-format "~A returns the new value, so this could be omitted: ~A" caller
+			      (car prev-f) (truncated-list->string f)))
+	     (if (and (len>1? f)
+		      (eq? (cadr prev-f) (cadr f))
+		      (not (code-constant? (cadr f)))
+		      (let ((f-func (car f)))
+			(case (car prev-f)
+			  ((vector-set! float-vector-set! int-vector-set!)
+			   (memq f-func '(vector-ref float-vector-ref int-vector-ref)))
+			  ((list-set!)
+			   (eq? f-func 'list-ref))
+			  ((string-set!)
+			   (eq? f-func 'string-ref))
+			  ((set-car!)
+			   (eq? f-func 'car))
+			  ((set-cdr!)
+			   (eq? f-func 'cdr))
+			  (else #f)))
+		      (or (memq (car f) '(car cdr)) ; no indices
+			  (and (pair? (cddr f))     ; for the others check that indices match
+			       (equal? (caddr f) (caddr prev-f))
+			       (pair? (cdddr prev-f))
+			       (not (pair? (cddddr prev-f)))
+			       (not (pair? (cdddr f)))
+			       (not (side-effect? (caddr f) env)))))
+		 ;; (let ((x (list 1 2))) (set-car! x 3) (car x))
+		 (lint-format "~A returns the new value, so this could be omitted: ~A" caller
+			      (car prev-f) (truncated-list->string f))))
+
+	    ((copy)
+	     (if (or (and (null? (cddr prev-f))
+			  (equal? (cadr prev-f) f))
+		     (and (len=1? (cddr prev-f))
+			  (equal? (caddr prev-f) f)))
+		 (lint-format "~A returns the new value, so ~A could be omitted" caller
+			      (truncated-list->string prev-f)
+			      (truncated-list->string f))))
+
+	    ((set! define define* define-macro define-constant define-macro*
+		   defmacro defmacro* define-expansion define-bacro define-bacro*)
+	     (cond ((not (and (pair? (cddr prev-f))                 ; (set! ((L 1) 2)) an error, but lint should keep going
+			      (or (and (equal? (caddr prev-f) f)    ; (begin ... (set! x (...)) (...))
+				       (not (side-effect? f env)))
+				  (and (symbol? f)                  ; (begin ... (set! x ...) x)
+				       (eq? f (cadr prev-f)))       ; also (begin ... (define x ...) x)
+				  (and (not (eq? (car prev-f) 'set!))
+				       (pair? (cadr prev-f))        ; (begin ... (define (x...)...) x)
+				       (eq? f (caadr prev-f)))))))
+
+		   ((not (memq (car prev-f) '(define define*)))
+		    (lint-format "~A returns the new value, so this could be omitted: ~A" caller
+				 (car prev-f) (truncated-list->string f)))
+
+		   ((symbol? (cadr prev-f))
+		    (lint-format "perhaps omit ~A and return ~A" caller
+				 (cadr prev-f)
+				 (caddr prev-f)))
+
+		   ((= (lint-tree-count f body 3) 2)
+		    ;; (let () (define (f1 x) (+ x 1)) f1) -> (lambda (x) ...)
+		    (lint-format "perhaps omit ~A, and change ~A" caller
+				 f
+				 (lists->string (list (car prev-f) (cadr prev-f) '...)
+						(list (if (eq? (car prev-f) 'define) 'lambda 'lambda*)
+						      (cdadr prev-f)
+						      '...))))
+
+		   (else (lint-format "~A returns the new value, so this could be omitted: ~A" caller ; possibly still not right if letrec?
+				      (car prev-f) f))))))
+
+	;; -------- check-shadows --------
+	(define (check-shadows caller head f env)
+	  ;; mid-body defines happen by the million, so resistance is futile
+	  (let ((vname (if (symbol? (cadr f))
+			   (cadr f)
+			   (and (pair? (cadr f))
+				(symbol? (caadr f))
+				(caadr f)))))
+	    ;; if already in env, check shadowing request
+	    (if (var-member vname env)	; (let ((f33 33)) (define f33 4) (g f33 1))
+		(lint-format "~A variable ~A in ~S shadows an earlier declaration" caller head vname f))))
+
+	;; -------- check-escape --------
+	(define (check-escape caller fs f next-to-last? env)
+	  (if (and (escape? f env)
+		   (pair? (cdr fs)) ; do special case
+		   (lint-every? (lambda (arg)
+				  (not (and (symbol? arg)
+					    (let ((v (var-member arg env)))
+					      (and v
+						   (eq? (var-initial-value v) :call/cc))))))
+				(cdr f)))
+	      (if next-to-last?
+		  ;; (let () (error 'oops "an error") #t)
+		  (lint-format "~A makes this pointless: ~A" caller
+			       (truncated-list->string f)
+			       (truncated-list->string (cadr fs)))
+		  ;; (begin (stop) (exit 6) (print 4) (stop))
+		  (lint-format "~A makes the rest of the body unreachable: ~A" caller
+			       (truncated-list->string f)
+			       (truncated-list->string (list '... (cadr fs) '...))))))
+
+	;; -------- displays->format --------
+	(define (displays->format caller prev-f f dpy-f dpy-case dpy-len)
+	  ;; display sequence starts at dpy-start, goes to ctr (prev-f) unless not dpy-case
+	  (let ((ctrl-string "")
+		(args ())
+		(dctr 0)
+		(dpy-last (if (not dpy-case) prev-f f))
+		(op (write-port (car dpy-f)))
+		(exprs (make-list (if dpy-case (+ dpy-len 1) dpy-len) ())))
+
+	    (define* (gather-format str (arg :unset))
+	      (set! ctrl-string (string-append ctrl-string str))
+	      (unless (eq? arg :unset) (set! args (cons arg args))))
+
+	    (call-with-exit
+	     (lambda (done)
+	       (for-each
+		(lambda (d)
+		  (unless (equal? (write-port d) op)
+		    (lint-format "unexpected port change: ~A -> ~A in ~A" caller op (write-port d) d) ; ??
+		    (done))
+		  (list-set! exprs dctr d)
+		  (set! dctr (+ dctr 1))
+		  (gather-format (display->format d))
+		  (when (eq? d dpy-last) ; op can be null => send to (current-output-port), return #f or #<unspecified>
+		    ;; (begin (display x) (newline) (display y) (newline)) -> (format () "~A~%~A~%" x y)
+		    (lint-format "perhaps ~A" caller (lists->string (cons '... exprs)
+								    `(format ,op ,ctrl-string ,@(reverse args))))
+		    (done)))
+		dpy-f)))))
+
+	;; -------- define->let --------
+	(define (define->let caller fs prev-f f)
+	  ;; sometimes redundant -- scope reduction can overlap this
+	  (unless (or (null? (cdr fs))
+		      (and (null? (cddr fs)) ; ... (define x...) x at end (handled elsewhere)
+			   (pair? (cdr f))
+			   (eq? (cadr f) (cadr fs)))
+		      (and (symbol? (car prev-f))
+			   (or (and (eq? (car prev-f) 'begin)
+				    (lint-every? (lambda (p)
+						   (and (pair? p)
+							(symbol? (car p))
+							(let ((fstr (symbol->string (car p))))
+							  (and (>= (length fstr) 6)
+							       (string=? (substring fstr 0 6) "define")))))
+						 (cdr prev-f)))
+			       (memq (car prev-f) '(use declare require hash-table-set! test assert))
+			       ;; check for (if ... (define...)) as prev-f got only 1 hit
+			       (let ((fstr (symbol->string (car prev-f))))
+				 (and (>= (length fstr) 6)
+				      (string=? (substring fstr 0 3) "def"))))))
+	    (let ((new-var ((if (pair? (cadr f)) caadr cadr) f)))
+	      (lint-format "~A occurs in the midst of the body;~%~NCperhaps use let: ~A" caller
+			   (truncated-list->string f)
+			   (+ lint-left-margin 4) #\space
+			   (truncated-list->string
+			    `(let ((,new-var ,(if (pair? (cadr f))
+						  (cons (if (eq? (car f) 'define) 'lambda 'lambda*)
+							(cons (cdadr f)
+							      (cddr f)))
+						  (caddr f))))
+			       ,@(cdr fs)))))))
+
+
+	;; -------- walk-open-body --------
+	(lambda (caller head body env)
+	  ;; walk a body (a list of forms, the value of the last of which might be returned)
+	  (if (not (proper-list? body))
+	      (lint-format "stray dot? ~A" caller (truncated-list->string body))
+
+	      (let ((len (length body))
+		    (old-current-form lint-current-form)
+		    (old-mid-form lint-mid-form)
+		    (macdef (memq head '(defmacro defmacro* define-macro define-macro* define-bacro define-bacro*))))
+
+		(if (eq? head 'do) (set! len (+ len 1))) ; last form in do body is not returned
+		(do ((prev-f #f)
+		     (prev-len 0)
+		     (f-len 0)
+		     (repeats 0)
+		     (start-repeats body)
+		     (repeat-arg 0)
+		     (dpy-f #f)
+		     (dpy-start #f)
+		     (rewrote-already #f)
+		     (fs body (cdr fs))
+		     (ctr 0 (+ ctr 1)))
+		    ((not (pair? fs)))
+		  (let ((f (car fs)))
+		    (when (len>1? f)
+
+		      ;; successive combinable conds/cases/dos are tricky and rare
+		      (when (and *report-shadowed-variables*
+				 (eq? (car f) 'define))
+			(check-shadows caller head f env))
+		      (when (pair? (cddr f))
+			(when (and (len>2? prev-f) ; (if A ...) (if A ...) -> (when A ...) or equivalents
+				   (memq (car prev-f) '(if when unless))
+				   (memq (car f) '(if when unless)))
+			  (combine-successive-ifs caller fs prev-f f env))
+			(when (and (pair? prev-f)
+				   (memq (car f) '(define define*)))
+			  (define->let caller fs prev-f f))))
+
+		    (let ((feq (and (pair? prev-f)
+				    (pair? f)
+				    (eq? (car f) (car  prev-f))
+				    (or (equal? (cdr f) (cdr prev-f))
+					(do ((fp (cdr f) (cdr fp))
+					     (pp (cdr prev-f) (cdr pp))
+					     (i 1 (+ i 1)))
+					    ((or (and (null? pp)
+						      (null? fp))
+						 (not (pair? pp))
+						 (not (pair? fp))
+						 (if (= i repeat-arg)                   ; ignore the arg that's known to be changing
+						     (side-effect? (car pp) env)        ; (car pp) is the current arg (where i = repeat-arg)
+						     (and (not (equal? (car pp) (car fp)))
+							  (or (positive? repeat-arg)
+							      (and (set! repeat-arg i)  ; call this one the changer
+								   #f)))))
+					     (and (null? pp)
+						  (null? fp))))))))
+		      (if feq
+			  (set! repeats (+ repeats 1)))
+		      (when (or (not feq)
+				(= ctr (- len 1))) ; this assumes we're not returning the last value?
+			(when (and (> repeats 2)
+				   (or (zero? repeat-arg)        ; all forms are the identical
+				       (not (hash-table-ref syntaces (car prev-f))))) ; macros should be ok here if args are constants
+			  (repeats->for-each caller prev-f (if (not feq) fs (cdr fs)) repeats start-repeats repeat-arg env))
+			(set! repeats 0)
+			(set! repeat-arg 0)
+			(set! start-repeats fs)))
+
+		    (if (pair? f)
+			(begin
+			  (set! f-len (length f))
+			  (if (eq? (car f) 'begin)
+			      (lint-format "redundant begin: ~A" caller (truncated-list->string f))))
+			(begin
+			  (if (symbol? f)
+			      (set-ref f caller f env))
+			  (set! f-len 0)))
+
+		    (when (= f-len prev-len 3)
+		      (set-cxr->copy caller prev-f f ctr len)
+		      (if (not rewrote-already)
+			  (set! rewrote-already (ifs->case caller fs prev-f f)))
+
+		      (when (and (eq? (car f) 'set!)          ; other such funcs like fill! don't seem to happen
+				 (eq? (car prev-f) 'set!))
+			(combine-sets caller prev-f f env)))
+#|
+		    (when (and (= f-len prev-len 4)           ; (vector-set! v 0 1) (vector-set! v 0 2) -- this does not happen outside tests
+			       (eq? (car f) (car prev-f))
+			       (equal? (cadr f) (cadr prev-f))
+			       (equal? (caddr f) (caddr prev-f))
+			       (memq (car f) '(vector-set! list-set! hash-table-set! float-vector-set! int-vector-set! string-set! let-set!))
+			       (not (pair? (caddr f)))
+			       (not (side-effect? (cadddr f) env))
+			       (not (side-effect? (cadddr prev-f) env)))
+		      (lint-format "~S could be omitted" caller (truncated-list->string prev-f)))
+|#
+		    (if (< ctr (- len 1))
+			(begin		             ; f is not the last form, so its value is ignored
+			  (check-escape caller fs f (= ctr (- len 2)) env)
+			  (check-returns caller f env)) ; look for code that has no effect (not returned, no side-effect)
+
+			;; here f is the last form in the body
+			(when (pair? prev-f)
+			  (redundant-set caller prev-f f env)
+			  (when (pair? (cdr prev-f))
+			    (redundant-return caller body prev-f f env))))
+
+		    ;; needs f fs prev-f dpy-f dpy-start ctr len
+		    ;;   trap lint-format
+		    (let ((dpy-case (and (pair? f)
+					 (memq (car f) '(display write newline write-char write-string))))) ; flush-output-port?
+		      (when (and dpy-case
+				 (not dpy-start))
+			(set! dpy-f fs)
+			(set! dpy-start ctr))
+		      (when (and (integer? dpy-start)
+				 (> (- ctr dpy-start) (if dpy-case 1 2))
+				 (or (= ctr (- len 1))
+				     (not dpy-case)))
+			(displays->format caller prev-f f dpy-f dpy-case (- ctr dpy-start))
+			(set! dpy-start #f))
+		      (unless dpy-case (set! dpy-start #f)))
+
+		    (if (and macdef
+			     (pair? f)
+			     (lint-tree-memq 'unquote f))
+			(lint-format "~A probably has too many unquotes: ~A" caller head (truncated-list->string f)))
+
+		    (set! prev-f f)
+		    (set! prev-len f-len)
+
+		    (set! lint-current-form f)
+		    (if (= ctr (- len 1))
+			(set! env (lint-walk caller f env))
+			(begin
+			  (set! lint-mid-form f)
+			  (let ((e (lint-walk caller f env)))
+			    (if (and (pair? e)
+				     (not (memq (var-name (car e)) '(:lambda :dilambda))))
+				(set! env e)))))
+		    (set! lint-current-form #f)
+		    (set! lint-mid-form #f)
+
+		    ;; need to put off this ref tick until we have a var for it (lint-walk above)
+		    (when (and (= ctr (- len 1))
+			       (len>1? f))
+		      (if (and (pair? (cadr f))
+			       (memq (car f) '(define define* define-macro define-constant define-macro* define-expansion define-bacro define-bacro*)))
+			  (set-ref (caadr f) caller f env)
+			  (if (memq (car f) '(defmacro defmacro*))
+			      (set-ref (cadr f) caller f env))))))
+
+		(set! lint-mid-form old-mid-form)
+		(set! lint-current-form old-current-form)))
+	  env)))
+
+
+    (define (return-walker last func)
+      (if (not (and (pair? last)
+		    (proper-list? last)))
+	  (func last)
+	  (case (car last)
+
+	    ((begin let let* letrec letrec* when unless with-baffle with-let)
+	     (when (pair? (cdr last))
+	       (return-walker (last-ref last) func)))
+
+	    ((if)
+	     (when (len>1? (cdr last))
+	       (return-walker (caddr last) func)
+	       (if (pair? (cdddr last))
+		   (return-walker (cadddr last) func))))
+
+	    ((cond)
+	     (when (pair? (cdr last))
+	       (for-each (lambda (c)
+			   (when (pair? c)
+			     (return-walker (last-ref c) func)))
+			 (cdr last))))
+
+	    ((case)
+	     (when (len>1? (cdr last))
+	       (for-each (lambda (c)
+			   (when (pair? c)
+			     (return-walker (last-ref c) func)))
+			 (cddr last))))
+
+	    ((do)
+	     (if (and (len>1? (cdr last))
+		      (proper-list? (caddr last))
+		      (len>1? (caddr last)))
+		 (return-walker (last-ref (caddr last)) func)))
+
+	    ((set!)
+	     (if (len>1? (cdr last))
+		 (func (caddr last))))
+
+	    ((not)
+	     (func #f))
+
+	    ((or)
+	     (func #f)
+	     (for-each (lambda (c)
+			 (return-walker c func))
+		       (cdr last)))
+
+	    ((and)
+	     (func #f)
+	     (return-walker (last-ref last) func))
+
+	    ((dynamic-wind catch)
+	     (let ((body (and (= (length last) 4)
+			      (caddr last))))
+	       (if (and (pair? body)
+			(eq? (car body) 'lambda))
+		   (return-walker (last-ref (cddr body)) func))))
+
+	    (else (func last)) ; includes quote
+
+	    ;; call-with-exit: walker on last on body, and scan for return func, walker on arg(s...)->values?
+	    )))
+
+    (define (check-sequence-constant function-name last) ; if last is a sequence constant, complain
+      (return-walker last
+		     (lambda (in-seq)
+		       (when (or (not (pair? in-seq))
+				 (memq (car in-seq) '(quote #_quote)))
+			 (let ((seq (if (len>1? in-seq)              ; (quote . 1)??
+					(cadr in-seq)
+					in-seq)))
+			   (when (and (sequence? seq)
+				      (not (zero? (length seq))))
+			     (lint-format "returns ~A constant: ~A~S" function-name ; (define-macro (m a) `(+ 1 a))
+					  (if (pair? seq)
+					      (values "a list" "'" seq)
+					    (values (prettify-checker-unq (->lint-type in-seq)) "" seq)))
+			     (throw 'sequence-constant-done))))))) ; just report one constant -- the full list is annoying
+
+    (define (code-equal? a b) ; these extra tests get no hits
+      ;; given NaNs, these 'equal?s should probably be equivalent?
+      (or (equal? a b)
+	  (and (pair? a)
+	       (pair? b)
+	       (or (and (eq? (car a) (hash-table-ref reversibles (car b)))
+			(proper-list? b)
+			(equal? (cdr a) (reverse (cdr b))))
+		   (and (eq? (car a) 'not)
+			(pair? (cdr a))
+			(pair? (cadr a))
+			(eq? (hash-table-ref notables (caadr a)) (car b))
+			(equal? (cdadr a) (cdr b)))
+		   (and (eq? (car b) 'not)
+			(pair? (cdr b))
+			(pair? (cadr b))
+			(eq? (hash-table-ref notables (caadr b)) (car a))
+			(equal? (cdr a) (cdadr b)))))))
+
+
+    (define lint-function-body #f) ; a momentary kludge??
+    (define lint-function-name #f) ; and another!
+
+    (define (evert-function-locals form vars env)
+      ;; look for outer let with var value constant, not set in func body --
+      ;;   suggest moving it to closure, modulo endless quibbles of course.
+      ;;   ignore nested lets because there we assume locality is more important.
+      ;; we get here if (eq? form lint-function-body) and (symbol? lint-function-name)
+      ;;   and not named-let (can this happen?) and only this expr in body
+      ;; currently called only in let-walker, but might make sense in let*-walker and letrec-walker.
+      ;;   in letrec-walker it got only 1 hit.
+
+      (when (and (pair? lint-function-body)  ; (let ((v 3)) v)?
+		 (eq? form (car lint-function-body))
+		 (symbol? lint-function-name)
+		 (pair? form)                ; this is (car lint-function-body)
+		 (null? (cdr lint-function-body))
+		 ;(not (lint-tree-set-memq definers (cdr form)))
+		 )
+	(for-each
+	 (lambda (local-var)
+	   (let ((vname (var-name local-var))
+		 (vvalue (var-initial-value local-var)))
+	     (when (and (zero? (var-set local-var))
+			(not (eq? (var-definer local-var) 'parameter))
+			(or (constant-expression? vvalue env)
+			    (and (pair? vvalue)
+				 (memq (car vvalue) '(list vector float-vector int-vector byte-vector))
+				 (not (lint-any? (lambda (x)
+						   (or (and (pair? x)
+							    (not (memq (car x) '(quote #_quote))))
+						       (and (symbol? x) ; (list 1 x 2)
+							    (not (constant? x)))))
+						 (cdr vvalue)))))
+			(not (lint-any? (lambda (p)
+					  (and (pair? p)
+					       (or (memq (car p) '(vector-set! float-vector-set! int-vector-set!
+								   string-set! list-set! hash-table-set! let-set!
+								   set-car! set-cdr!))
+						   ;; maybe check for anything ending in ! here
+						   (lint-set!? p env))
+					       (eq? vname (cadr p))))
+					(var-history local-var))))
+	       (lint-format "~A can ~Abe moved to ~A's closure" lint-function-name
+			    vname
+			    (if (lint-any? (lambda (p)
+					     (and (pair? p)
+						  (side-effect? p env)))
+					   (var-history local-var))
+				"probably "
+				"")
+			    (if (not (or (keyword? lint-function-name)
+					 (memq lint-function-name '(let let* letrec))))
+				lint-function-name
+				"the enclosing function")))))
+	 vars)))
+
+    (define (report-doc-string definer function-name args body)
+      (lint-format "old-style doc string: ~S, use '+documentation+:~%~NC~A" function-name
+		   (car body) (+ lint-left-margin 4) #\space
+		   (lint-pp `(define ,function-name
+			       (let ((+documentation+ ,(car body)))
+				 (,(case definer
+				     ((define) 'lambda)
+				     ((define*) 'lambda*)
+				     (else))
+				  ,args
+				  ,@(cdr body)))))))
+
+    (define (lint-walk-function-body definer function-name args body env)
+      ;; walk function body, with possible doc string at the start
+      (when (and (len>1? body)
+		 (string? (car body)))
+	(if *report-doc-strings*
+	    (report-doc-string definer function-name args body))
+	(set! body (cdr body))) ; ignore old-style doc-string
+      ;; (set! arg ...) never happens as last in body
+
+      ;; but as first in body, it happens ca 100 times
+      (if (and (pair? body)
+	       (len>2? (car body))
+	       (eq? (caar body) 'set!)
+	       (or (eq? (cadar body) args)
+		   (and (pair? args)
+			(memq (cadar body) args))))
+	  ;; (define (f21 x y) (set! x 3) (+ y 1))
+	  (lint-format "perhaps ~A" function-name
+		       (lists->string (car body) `(let ((,(cadar body) ,(caddar body))) ...))))
+      ;; as first in let of body, maybe a half-dozen
+
+      (let ((tag 'yup))
+	(catch 'sequence-constant-done
+	  (lambda ()
+	    (check-sequence-constant function-name (last-ref body)) ; some of these are innocuous -- lambda forms in midst of outer body etc
+	    (set! tag 'nope))
+	  (lambda args #f))
+	(if (eq? tag 'yup)
+	    (let ((v (var-member function-name env)))
+	      (if (and v
+		       (symbol? (var-ftype v)))
+		  (set! (var-retcons v) #t)))))
+
+      (let-temporarily ((lint-function-body (and (not (eq? definer 'definstrument)) body))
+			(lint-function-name (and (null? (cdr body)) function-name)))
+	(lint-walk-body function-name definer body env)))
+
+    (define (lint-walk-function definer function-name args body form env)
+      ;; check out function arguments (adding them to the current env), then walk its body
+      ;; first check for (define (hi...) (ho...)) where ho has no opt args (and try to ignore possible string constant doc string)
+      (when (eq? definer 'define)
+	(let ((bval (if (and (len>1? body)
+			     (string? (car body)))
+			(cdr body)                   ; strip away the (old-style) documentation string
+			body)))
+
+	  (cond ((not (and (len=1? bval)             ; not (define (hi a) . 1)!
+			   (pair? (car bval))
+			   (symbol? (caar bval)))))  ; not (define (hi) ((if #f + abs) 0))
+
+		;; might be nice to (define (f x) x) -> (define f values) but that turns off the arg-num error check
+
+		((or (equal? args (cdar bval))
+		     (and (hash-table-ref reversibles (caar bval))
+			  (pair? (cdar bval))
+			  (equal? args (reverse (cdar bval)))))
+		 (let* ((cval (caar bval))
+			(p (symbol->value cval *e*))
+			(ary (arity p)))
+		   (if (or (procedure? p)
+			   (let ((e (var-member cval env) ))
+			     (and e
+				  (symbol? (var-ftype e))
+				  (let ((def (var-initial-value e))
+					(e-args (var-arglist e)))
+				    (and
+				     (pair? def)
+				     (memq (var-ftype e) '(define lambda))
+				     (or (and (null? args)
+					      (null? e-args))
+					 (and (symbol? args)
+					      (symbol? e-args))
+					 (and (pair? args)
+					      (pair? e-args)
+					      (= (length args) (length e-args)))))))))
+		       (lint-format "~A~A could be (define ~A ~A)" function-name
+				    (if (and (procedure? p)
+					     (not (= (car ary) (cdr ary)))
+					     (not (= (length args) (cdr ary))))
+					(format #f "leaving aside ~A's optional arg~P, " cval (- (cdr ary) (length args)))
+					;; optional args is only one of the problems:
+					;;   (define (f5 x) (read x)) (with-input-from-string f5) -- f5 is not a thunk
+					;;   (define (f5 x y) (macro x y)) -- f5 evals its arguments, passing (values x y) makes this worse
+					;;   (define (f5 x) (f6 x)) where f6 can be redefined later -- expectation is that new f6 is called
+					;;   (object->string (define (f5 x y) (+ x y)) :readable) returns "+"
+					;;   and undoubtedly many more
+					"")
+				    function-name
+				    function-name
+				    (if (equal? args (cdar bval))
+					cval
+					(hash-table-ref reversibles (caar bval))))
+		       (if (and (null? args)            ; perhaps this can be extended to any equal args
+				(null? (cdar bval)))
+			   ;; (define (getservent) (getserv)) -> (define getservent getserv)
+			   (lint-format "~A could probably be ~A" function-name
+					(truncated-list->string form)
+					(truncated-list->string (list 'define function-name cval)))))))
+
+		((and (or (symbol? args)
+			  (and (pair? args)
+			       (negative? (length args))))
+		      (eq? (caar bval) 'apply)
+		      (len>1? (cdar bval))
+		      (symbol? (cadar bval))
+		      (not (memq (cadar bval) '(and or)))
+		      (or (and (eq? args (caddar bval))
+			       (null? (cdddar bval)))
+			  (and (pair? args)
+			       (equal? (cddar bval) (proper-list args)))))
+		 ;; (define (f1 . x) (apply + x)) -> (define f1 +)
+		 (lint-format "~A could be (define ~A ~A)" function-name function-name function-name (cadar bval)))
+
+		((and (hash-table-ref combinable-cxrs (caar bval))
+		      (pair? (cdar bval))
+		      (pair? (cadar bval)))
+		 ((lambda* (cr arg)
+		    (and cr
+			 (< (length cr) 5)
+			 (len=1? args)
+			 (eq? (car args) arg)
+			 (let ((f (symbol "c" cr "r")))
+			   (if (eq? f function-name)
+			       ;; (define (cadddr l) (caddr (cdr l)))
+			       (lint-format "this redefinition of ~A is pointless (use (with-let (unlet)...) or #_~A)" definer function-name function-name)
+			       ;; (define (f1 x) (cdr (car x))) -> (define f1 cdar)
+			       (lint-format "~A could be (define ~A ~A)" function-name function-name function-name f)))))
+		  (combine-cxrs (car bval))))
+
+		((not (and (len>1? (cdar bval))
+			   (memq (caar bval) '(list-ref list-tail))
+			   (len=1? args)
+			   (eq? (car args) (cadar bval)))))
+
+		((eq? (caar bval) 'list-ref)
+		 (case (caddar bval)
+		   ((0) (lint-format "~A could be (define ~A car)" function-name function-name function-name))
+		   ((1) (lint-format "~A could be (define ~A cadr)" function-name function-name function-name))
+		   ((2) (lint-format "~A could be (define ~A caddr)" function-name function-name function-name))
+		   ((3) (lint-format "~A could be (define ~A cadddr)" function-name function-name function-name))))
+
+		(else
+		 (case (caddar bval)
+		   ((1) (lint-format "~A could be (define ~A cdr)" function-name function-name function-name))
+		   ((2) (lint-format "~A could be (define ~A cddr)" function-name function-name function-name))
+		   ((3) (lint-format "~A could be (define ~A cdddr)" function-name function-name function-name))
+		   ((4) (lint-format "~A could be (define ~A cddddr)" function-name function-name function-name)))))))
+
+      (let ((fvar (and (symbol? function-name)
+		       (let ((fname (case definer
+				      ((lambda lambda*) :lambda)
+				      ((dilambda)       :dilambda)
+				      (else             function-name)))
+			     (fargs ((case definer
+				       ((lambda lambda*)     cadr)
+				       ((defmacro defmacro*) caddr)
+				       (else                 cdadr))
+				     form)))
+			 (make-fvar fname definer fargs form env)))))
+	(when fvar
+	  (let-set! (cdr fvar) 'allow-other-keys
+		    (case definer
+		      ((lambda define-constant) #t)
+		      ((lambda*) (eq? (last-ref (cadr form)) :allow-other-keys))
+		      ((define*) (eq? (last-ref (cdadr form)) :allow-other-keys))
+		      ((defmacro defmacro*)
+		       (or (not (eq? definer 'defmacro*))
+			   (and (pair? (caddr form))
+				(eq? (last-ref (caddr form)) :allow-other-keys))))
+		      (else
+		       (or (not (memq definer '(define-macro* define-bacro*)))
+			   (eq? (last-ref (cdadr form)) :allow-other-keys))))))
+
+	(if (null? args)
+	    (begin
+	      (if (memq definer '(define* lambda* defmacro* define-macro* define-bacro*))
+		  (lint-format "~A could be ~A"       ; (define* (f1) 32)
+			       function-name definer
+			       (symbol (substring (symbol->string definer) 0 (- (length (symbol->string definer)) 1)))))
+	      (let ((cur-env (if fvar (cons fvar env) env)))
+		(let ((nvars (let ((e (lint-walk-function-body definer function-name args body cur-env)))
+			       (and (not (eq? e cur-env))
+				    (env-difference function-name e cur-env ())))))
+		  (if (pair? nvars)
+		      (report-usage function-name definer nvars cur-env)))
+		cur-env))
+
+	    (if (not (or (symbol? args)
+			 (pair? args)))
+		(begin
+		  (lint-format "strange ~A parameter list ~A" function-name definer args)
+		  env)
+		(let ((args-as-vars
+		       (if (symbol? args)                            ; this is getting arg names to add to the environment
+			   (begin
+			     (if (memq definer '(define* lambda* defmacro* define-macro* define-bacro*))
+				 (lint-format "~A could be ~A"       ; (lambda* args ...)
+					      function-name definer
+					      (symbol (substring (symbol->string definer) 0 (- (length (symbol->string definer)) 1)))))
+			     (list (make-lint-var args #f 'parameter)))
+			   (let ((star-definer (memq definer '(define* lambda* defmacro* define-macro* define-bacro* definstrument define*-public))))
+			     (map (lambda (arg)
+				    (if (symbol? arg)
+					(if (memq arg '(:rest :allow-other-keys))
+					    (values)                  ; omit :rest and :allow-other-keys
+					    (make-lint-var arg #f 'parameter))
+					(if (not (and star-definer (len=2? arg)))
+					    (begin
+					      (lint-format "strange parameter for ~A: ~S" function-name definer arg)
+					      (values))
+					    (begin
+					      (if (not (or (cadr arg)                      ; (define* (f4 (a #f)) a)
+							   (eq? definer 'define*-public))) ; who knows?
+						  (lint-format "the default argument value is #f in ~A, so ~A can be ~A" function-name
+							       definer arg (car arg)))
+					      (make-lint-var (car arg)
+							     (and star-definer (len=2? arg) (cadr arg)) ; default value -> initial-value
+							     'parameter)))))
+				  (proper-list args))))))
+
+		  (let* ((cur-env (cons (make-lint-var :let form definer)
+					(append args-as-vars (if fvar (cons fvar env) env))))
+			 (nvars (let ((e (lint-walk-function-body definer function-name args body cur-env)))
+				  (and (not (eq? e cur-env))
+				       (env-difference function-name e cur-env ())))))
+		    (report-usage function-name definer (append (or nvars ()) args-as-vars) cur-env))
+
+		  (if (not fvar)
+		      env
+		      (begin
+			(when (memq definer '(define lambda define-macro))
+			  ;; look for unused parameters that are passed a value other than #f
+			  (let ((set ())
+				(unused ()))
+			    (for-each
+			     (lambda (arg-var)
+			       (if (zero? (var-ref arg-var))
+				   (if (positive? (var-set arg-var))
+				       (set! set (cons (var-name arg-var) set))
+				       (if (not (memq (var-name arg-var) '(+documentation+ +signature+ +setter+ +iterator+)))
+					   (set! unused (cons (var-name arg-var) unused))))))
+			     args-as-vars)
+			    (when (or (pair? set)
+				      (pair? unused))
+			      (let ((proper-args (args->proper-list args)))
+				(let ((sig (var-signature fvar))
+				      (len (+ (length proper-args) 1)))
+				  (if (not sig)
+				      (set! sig (make-list len #t))
+				      (if (< (length sig) len)
+					  (set! sig (copy sig (make-list len #t)))))
+				  (do ((siglist (cdr sig) (cdr siglist))
+				       (arg proper-args (cdr arg)))
+				      ((null? arg))
+				    (if (memq (car arg) unused)
+					(set-car! siglist 'unused-parameter?)
+					(if (memq (car arg) set)
+					    (set-car! siglist 'unused-set-parameter?))))
+
+				  (set! (var-signature fvar) sig))))))
+			(cons fvar env))))))))
+
+    (define (check-bool-cond caller form c1 c2 env)
+      ;; (cond (x #f) (#t #t)) -> (not x)
+      ;; c1/c2 = possibly combined, so in (cond (x #t) (y #t) (else #f)), c1: ((or x y) #t), so -> (or x y)
+      (and (len=2? c1)
+	   (len>1? c2)
+	   (memq (car c2) '(#t else))
+	   (or (and (boolean? (cadr c1))
+		    (or (and (null? (cddr c2))
+			     (boolean? (cadr c2))
+			     (not (equal? (cadr c1) (cadr c2))) ; handled elsewhere
+			     (lint-format "perhaps ~A" caller
+					  (lists->string form (if (eq? (cadr c1) #t)
+								  (car c1)
+								  (simplify-boolean (list 'not (car c1)) () () env)))))
+			(and (not (cadr c1))   ; (cond (x #f) (else y)) -> (and (not x) y)
+			     (let ((cc1 (simplify-boolean (list 'not (car c1)) () () env)))
+			       (lint-format "perhaps ~A" caller
+					    (lists->string form
+							   (list 'and cc1
+								 (if (null? (cddr c2))
+								     (cadr c2)
+								     (cons 'begin (cdr c2))))))))
+			(and (pair? (car c1))  ; (cond ((null? x) #t) (else y)) -> (or (null? x) y)
+			     (eq? (return-type (caar c1) env) 'boolean?)
+			     (lint-format "perhaps ~A" caller
+					  (lists->string form
+							 (list 'or (car c1)
+							       (if (null? (cddr c2))
+								   (cadr c2)
+								   (cons 'begin (cdr c2)))))))))
+	       (and (boolean? (cadr c2))
+		    (null? (cddr c2))
+		    (not (equal? (cadr c1) (cadr c2)))
+		    ;; (cond ((= 3 (length eq)) (caddr eq)) (else #f)) -> (and (= 3 (length eq)) (caddr eq))
+		    (lint-format "perhaps ~A" caller
+				 (lists->string form
+						(if (cadr c2)
+						    (list 'or (list 'not (car c1)) (cadr c1))
+						    (if (and (pair? (car c1))
+							     (eq? (caar c1) 'and))
+							(append (car c1) (cdr c1))
+							(cons 'and c1)))))))))
+
+    (define (case-branch test eqv-select exprs)
+      (cons (case (car test)
+	      ((eq? eqv? = equal? char=?)
+	       (list (unquoted ((if (equal? eqv-select (cadr test)) caddr cadr) test))))
+	      ((memq memv member) (unquoted (caddr test)))
+	      ((not)         '(#f))
+	      ((null?)       '(()))
+	      ((eof-object?) '(#<eof>))
+	      ((zero?)       '(0 0.0))
+	      ((boolean?)    '(#t #f))
+	      ((char-ci=?)
+	       (if (equal? eqv-select (cadr test))
+		   (list (caddr test) (other-case (caddr test)))
+		   (list (cadr test) (other-case (cadr test)))))
+	      (else
+	       (map (lambda (p)
+		      (case (car p)
+			((eq? eqv? = equal? char=?)
+			 (unquoted ((if (equal? eqv-select (cadr p)) caddr cadr) p)))
+			((memq memv member) (apply values (caddr p)))
+			((not)              #f)
+			((null?)            ())
+			((eof-object?)      #<eof>)
+			((zero?)            (values 0 0.0))
+			((boolean?)         (values #t #f))
+			((char-ci=?)
+			 (if (equal? eqv-select (cadr p))
+			     (values (caddr p) (other-case (caddr p)))
+			     (values (cadr p) (other-case (cadr p)))))
+			(else               (error 'wrong-type-arg "oops"))))
+		    (cdr test))))
+
+	    (cond ((not (null? (cdr exprs)))
+		   exprs)
+
+		((equal? eqv-select (car exprs))
+		 ())
+
+		((and (len=2? (car exprs))
+		      (equal? eqv-select (cadar exprs)))
+		 (list '=> (caar exprs)))
+
+		(else exprs))))
+
+    (define (cond->case eqv-select new-clauses)
+      (cons 'case
+	    (cons eqv-select
+		  (map (lambda (clause)
+			 (let ((test (car clause))
+			       (exprs (cdr clause)))
+			   (if (null? exprs)                   ; cond returns the test result if no explicit results
+			       (set! exprs (list #t)))         ;   but all tests here return a boolean, and we win only if #t?? (memx is an exception)
+			   (cond ((not (memq test '(else #t)))
+				  (case-branch test eqv-select exprs))
+
+			       ((not (null? (cdr exprs)))
+				(cons 'else exprs))
+
+			       ((equal? eqv-select (car exprs))
+				(list 'else))
+
+			       ((and (len=2? (car exprs))
+				     (equal? eqv-select (cadar exprs)))
+				(list 'else '=> (caar exprs)))
+
+			       (else (cons 'else exprs)))))
+		       new-clauses))))
+
+    (define (eqv-code-constant? x)
+      (or (number? x)
+	  (char? x)
+	  (and (len>1? x)
+	       (memq (car x) '(quote #_quote))
+	       (or (symbol? (cadr x))
+		   (and (not (pair? (cadr x)))
+			(eqv-code-constant? (cadr x)))))
+	  (memq x '(#t #f () #<unspecified> #<undefined> #<eof>))))
+
+    (define (cond-eqv? clause eqv-select or-ok)
+      (if (not (len>1? clause))
+	  (memq clause '(else #t))
+	  ;; it's eqv-able either directly or via memq/memv, or via (or ... eqv-able clauses)
+	  ;;   all clauses involve the same (eventual case) selector
+	  (case (car clause)
+	    ((eq? eqv? = equal? char=? char-ci=?)
+	     (and (pair? (cddr clause))
+		  (if (eqv-code-constant? (cadr clause))
+		      (equal? eqv-select (caddr clause))
+		      (and (eqv-code-constant? (caddr clause))
+			   (equal? eqv-select (cadr clause))))))
+
+	    ((memq memv member)
+	     (and (pair? (cddr clause))
+		  (equal? eqv-select (cadr clause))
+		  (pair? (caddr clause))
+		  (memq (caaddr clause) '(quote #_quote))
+		  (or (not (eq? (car clause) 'member))
+		      (lint-every? (lambda (x)
+				     (or (number? x)
+					 (char? x)
+					 (symbol? x)
+					 (memq x '(#t #f () #<unspecified> #<undefined> #<eof>))))
+				   (cdaddr clause)))))
+	    ((or)
+	     (and or-ok
+		  (lint-every? (lambda (p)
+				 (cond-eqv? p eqv-select #f))
+			       (cdr clause))))
+
+	    ((not null? eof-object? zero? boolean?)
+	     (equal? eqv-select (cadr clause)))
+
+	    (else #f))))
+
+    (define (partition-form start len)
+      (let ((ps (make-vector len))
+	    (qs (make-vector len)))
+	(do ((i 0 (+ i 1))
+	     (p start (cdr p)))
+	    ((= i len))
+	  (set! (ps i) (cadar p))
+	  (set! (qs i) (reverse (cadar p))))
+
+	(let ((header-len (length (ps 0))))
+	  (let ((trailer-len header-len)
+		(result-min-len header-len))
+	    (do ((i 1 (+ i 1)))
+		((= i len))
+	      (set! result-min-len (min result-min-len (length (ps i))))
+	      (do ((k 1 (+ k 1))
+		   (p (cdr (ps i)) (cdr p))
+		   (f (cdr (ps 0)) (cdr f)))
+		  ((or (= k header-len)
+		       (not (pair? p))
+		       (not (equal? (car p) (car f))))
+		   (set! header-len k)))
+	      (do ((k 0 (+ k 1))
+		   (q (qs i) (cdr q))
+		   (f (qs 0) (cdr f)))
+		  ((or (= k trailer-len)
+		       (not (pair? q))
+		       (not (equal? (car q) (car f))))
+		   (set! trailer-len k))))
+
+	    (when (= result-min-len header-len)
+	      (set! header-len (- header-len 1))
+	      (set! trailer-len 0))
+	    (if (<= result-min-len (+ header-len trailer-len))
+		(set! trailer-len (- result-min-len header-len 1)))
+
+	    (values header-len trailer-len result-min-len)))))
+
+    (define (one-call-and-dots body) ; body is unchanged here, so it's not interesting
+      (if (< (lint-tree-leaves body) 30)
+	  (if (or (null? body)
+		  (null? (cdr body)))
+	      body
+	      (list (car body) '...))
+	  (if (pair? (car body))
+	      (list (list (caar body) '...))
+	      (list (car body) '...))))
+
+    (define (replace-redundant-named-let caller form outer-name outer-args inner)
+      (when (and (proper-list? outer-args)  ; can be null
+		 (len>2? inner))
+	(let ((inner-name (cadr inner))
+	      (inner-args (caddr inner))
+	      (inner-body (cdddr inner)))
+	  (when (pair? inner-body)
+	  (do ((p outer-args (cdr p))
+	       (a inner-args (cdr a)))
+	      ((or (null? p)
+		   (not (pair? a))
+		   (not (len=2? (car a)))
+		   (pair? (caar a))
+		   (and (not (eq? (car p) (caar a)))
+			(lint-tree-memq (car p) inner-body)))
+	       ;; args can be reversed, but rarely match as symbols
+	       (when (and (null? p)
+			  (or (null? a)
+			      (and (len=1? a)
+				   (len>1? (car a))
+				   (code-constant? (cadar a)))))
+		 (let* ((args-match (do ((p1 outer-args (cdr p1))
+					 (a1 inner-args (cdr a1)))
+					((or (null? p1)
+					     (null? (cdar a1))
+					     (not (eq? (car p1) (caar a1)))
+					     (not (eq? (caar a1) (cadar a1))))
+					 (null? p1))))
+			(args-aligned (and (not args-match)
+					   (do ((p1 outer-args (cdr p1))
+						(a1 inner-args (cdr a1)))
+					       ((or (null? p1)
+						    (not (eq? (car p1) (cadar a1))))
+						(null? p1))))))
+		   (when (or args-match args-aligned)
+		     (let ((definer (if (null? a) 'define 'define*))
+			   (extras (if (and (pair? a)
+					    (quoted-null? (cadar a)))
+				       (list (list (caar a) ()))
+				       a)))
+		       ;;     (define (f61 x) (let loop ((y x)) (if (positive? y) (loop (- y 1)) 0))) -> (define (f61 y) (if (positive? y) (f61 (- y 1)) 0))
+		       (lint-format "~A ~A" caller
+				    (if (null? a) "perhaps" "a toss-up -- perhaps")
+				    (lists->string form
+						   `(,definer (,outer-name
+							       ,@(if args-match
+								     outer-args
+								     (do ((result ())
+									  (p outer-args (cdr p))
+									  (a inner-args (cdr a)))
+									 ((null? p)
+									  (reverse result))
+								       (set! result (cons (caar a) result))))
+							       ,@extras)
+						      ,@(tree-subst outer-name inner-name inner-body))))))))))))))
+
+    (denote (set-target name form env)
+      (and (pair? form)
+	   (or (and (pair? (cdr form))
+		    (or (eq? (cadr form) name)    ; (pop! x)
+			(and (pair? (cddr form))  ; (push! y x)
+			     (eq? (caddr form) name)))
+		    (or (eq? (car form) 'set!)    ; (set! x y)
+			(lint-set!? form env)))
+	       (set-target name (car form) env)
+	       (set-target name (cdr form) env))))
+
+
+    (define (check-definee caller sym form env)
+      (cond ((not (pair? (cddr form))))
+
+	    ((keyword? sym)               ; (define :x 1)
+	     (lint-format "keywords are constants ~A" caller sym))
+
+	    ((and (eq? sym 'pi)           ; (define pi (atan 0 -1))
+		  (member (caddr form) '((atan 0 -1)
+					 (acos -1)
+					 (* 2 (acos 0))
+					 (* 4 (atan 1))
+					 (* 4 (atan 1 1)))))
+	     (lint-format "~A is one of its many names, but pi is a predefined constant" caller (caddr form)))
+
+	    ((constant? sym)              ; (define most-positive-fixnum 432)
+	     (if (memv sym '(pi +nan.0 -nan.0 +inf.0 -inf.0
+			     *unbound-variable-hook* *missing-close-paren-hook* *read-error-hook*
+			     *load-hook* *error-hook* *rootlet-redefinition-hook*))
+		 (lint-format "~A is a constant: ~A" caller sym form)))
+
+	    ((memq sym '(quote #_quote))
+	     (lint-format "either a stray quote, or a really bad idea: ~A" caller (truncated-list->string form)))
+
+	    ((pair? sym)
+	     (check-definee caller (car sym) form env))
+
+	    ((var-member sym env) => (lambda (v)
+				       (if (and (eq? (var-definer v) 'define-constant)
+						(len>2? form)
+						(not (equal? (caddr form) (var-initial-value v))))
+					   (let ((line (and (pair? (var-initial-value v))
+							    (pair-line-number (var-initial-value v)))))
+					     (lint-format "~A in ~A is already a constant, defined ~A~A" caller sym
+							  (truncated-list->string form)
+							  (if (and (integer? line) (> line 0)) (format #f "(line ~D): " line) "")
+							  (truncated-list->string (var-initial-value v)))))))
+
+	    ((memq sym '(else =>)) ; also in r7rs ... and _, but that is for syntax-rules
+	     (lint-format "redefinition of ~A is a bad idea: ~A" caller sym (truncated-list->string form)))))
+
+    (define walker-functions
+      (let ((binders '(let let* letrec letrec* do
+		       lambda lambda* define define*
+		       call/cc call-with-current-continuation
+		       define-macro define-macro* define-bacro define-bacro* define-constant define-expansion
+		       load eval eval-string require))
+    	    (walker-table (make-hash-table))
+	    (lint-let-reduction-factor 3)) ; maybe make this a global switch -- the higher this number, the fewer let-reduction suggestions
+
+	(define (hash-walker key value)
+	  (if (hash-table-ref walker-table key)
+	      (format *stderr* "~A already has a value: ~A~%" key (hash-table-ref walker-table key)))
+	  (hash-table-set! walker-table key value))
+
+	(define (check-pointless-let caller form body args)
+	  ;; used in define-walker and lambda-walker
+	  (when (pair? (cadr body))
+	    (do ((inner-vars (cadr body))
+		 (p args (cdr p)))
+		((not (pair? p)))
+	      (cond ((assq (car p) inner-vars) =>
+		     (lambda (v)
+		       (if (and (pair? (cdr v))
+				(eq? (cadr v) (car p)))
+			   (lint-format "in ~A this let binding is pointless: ~A" caller
+					(truncated-list->string form)
+					v))))))))
+
+	(define (local-movable-funcs body largs)
+	  (let ((ok-funcs ())
+		(bad-funcs ())
+		(all-bad #f))
+	    (for-each (lambda (f)
+			(if (not (func-definer? f))
+			    (set! all-bad #t)
+			    (let ((fname ((if (symbol? (cadr f)) cadr (if (pair? (cadr f)) caadr not)) f)))
+			      (if (or all-bad
+				      (not (symbol? fname))
+				      (memq fname largs)
+				      (not (pair? ((if (symbol? (cadr f)) (if (len>1? (caddr f)) caddr not) cadr) f)))
+				      (let ((fargs (args->proper-list (if (symbol? (cadr f)) (cadr (caddr f)) (cdadr f)))))
+					(lint-tree-set-memq (remq-set fargs largs) (cddr f))))
+				  (set! bad-funcs (cons fname bad-funcs))
+				  (set! ok-funcs (cons (cons fname f) ok-funcs))))))
+		      body)
+	    (map (lambda (f)
+		   (if (lint-tree-set-memq bad-funcs (cdddr f))
+		       (values)
+		       f))
+		 (reverse ok-funcs))))
+
+	;; -------- local-funcs->closure --------
+	(define local-funcs->closure
+	  (let* ((rewrite-funcs
+		  (let* ((funcs->list
+			  (lambda (ok-funcs)
+			    (map (lambda (f)
+				   (let ((def (cdr f)))
+				     (if (< (lint-tree-leaves def) local-function-context)
+					 def
+					 (list (car def) (cadr def) '...))))
+				 ok-funcs)))
+
+			 (rewrite-define
+			  (lambda (form ok-funcs outer-args let-case)
+			    `(define ,(caadr form)       ; define* -> lambda* below
+			       (,(or let-case 'let) ,(if let-case (funcs->list ok-funcs) ())
+				 ,@(if let-case () (funcs->list ok-funcs))
+				 (,(if (eq? (car form) 'define*) 'lambda* 'lambda)
+				  ,(cdr outer-args)
+				  ...)))))
+
+			 (rewrite-lambda
+			  (lambda (form ok-funcs outer-args let-case)
+			    `(,(or let-case 'let) ,(if let-case (funcs->list ok-funcs) ())
+			       ,@(if let-case () (funcs->list ok-funcs))
+			       (,(car form) ,outer-args ...)))))
+
+		    (lambda (caller form ok-funcs outer-args define-case let-case)
+		      (let ((msg (string-append "the "
+						(if let-case "local" "inner")
+						" function~A ~{~A~^, ~} could be moved "
+						(if define-case
+						    "to ~A's closure: ~A"
+						    "outside the ~A: ~A")))
+			    (rewriter (if define-case rewrite-define rewrite-lambda))
+			    (fname ((if define-case caadr car) form)))
+			(lint-format msg caller
+				     (if (null? (cdr ok-funcs)) "" "s")
+				     (map car ok-funcs)
+				     fname
+				     (lists->string form (rewriter form ok-funcs outer-args let-case)))))))
+
+		 (largs->let
+		  (lambda (caller form body largs outer-args define-case)
+		    (let ((ok-funcs (local-movable-funcs body largs)))
+		      (when (pair? ok-funcs)
+			(set! last-lambda-let body)
+			(set! last-lambda-let-funcs ok-funcs)
+			(rewrite-funcs caller form ok-funcs outer-args define-case #f)))))
+
+		 (ok-func?
+		  (lambda (var&val let-case largs)
+		    (and (len=1? (cdr var&val))
+			 (len>2? (cadr var&val))
+			 (memq (caadr var&val) '(lambda lambda*))
+			 (let* ((val (cdadr var&val))
+				(fargs (args->proper-list (car val))))
+			   (if (memq let-case '(letrec letrec*))
+			       (set! fargs (cons (car var&val) fargs)))
+			   (not (lint-tree-set-memq (let remove-shadows ((args largs) (nargs ()))
+						   (if (null? args)
+						       nargs
+						       (remove-shadows (cdr args)
+								       (if (memq (car args) fargs)
+									   nargs
+									   (cons (car args) nargs)))))
+						 (cdr val))))))))
+
+	    (lambda (caller form outer-args define-case)
+	      (let ((largs (args->proper-list outer-args))
+		    (body ((if (string? (caddr form)) cdddr cddr) form)))
+		(when (pair? body)
+		  (if (func-definer? (car body))
+		      (largs->let caller form body largs outer-args define-case)
+		      (when (and (null? (cdr body))
+				 (len>2? (car body))
+				 (memq (caar body) '(let let* letrec letrec*))
+				 (proper-list? (cadar body))
+				 (just-pairs? (cadar body))
+				 (pair? (cddar body)))
+			(if (func-definer? (caddar body))
+			    (largs->let caller form
+					(cddar body)
+					(if define-case
+					    (cons (caadr form) (append largs (map car (cadar body))))
+					    (append largs (map car (cadar body))))
+					outer-args define-case))
+			(let ((let-case (caar body)))            ; if not 'let, add locals to outer-args
+			  (unless (or (eq? let-case 'let)
+				      (and (eq? let-case 'letrec)
+					   (lint-every? (lambda (p)
+							  (ok-func? p let-case largs))
+							(cadar body))))
+			    (set! largs (append largs (map car (cadar body)))))
+			  (do ((ok-funcs ())
+			       (p (cadar body) (cdr p)))
+			      ((null? p)
+			       (when (pair? ok-funcs)
+				 (if (and (memq let-case '(let* letrec*))
+					  (null? (cdr ok-funcs)))
+				     (set! let-case 'let))
+				 (rewrite-funcs caller form ok-funcs outer-args define-case let-case)))
+			    (if (ok-func? (car p) let-case largs)
+				(set! ok-funcs (cons (cons (caar p) (car p)) ok-funcs))))))))))))
+
+
+	;; ---------------- define and defmacro ----------------
+	(let ()
+
+	  (define (check-define-macro caller form env)
+	    ;; used in define-walker and defmacro-walker
+	    (let ((val (cddr form))
+		  (outer-name (caadr form))
+		  (outer-args (cdadr form)))
+	      (when (len=1? val)
+		(let ((body (car val)))
+		  (if (and (null? outer-args)  ; look for C macros translated as define-macro! -- this happens a lot sad to say
+			   (or (not (symbol? body))
+			       (keyword? body))
+			   (or (not (pair? body))
+			       (and (memq (car body) '(quote #_quote))
+				    (pair? (cdr body))
+				    (not (symbol? (cadr body)))
+				    (not (unquoted-pair? (cadr body))))
+			       (not (or (memq (car body) '(quote #_quote quasiquote list cons append))
+					(lint-tree-set-memq '(list-values #_list-values apply-values #_apply-values append) body)))))
+		      (lint-format "perhaps ~A or ~A" caller
+				   (lists->string form (list 'define outer-name (unquoted body)))
+				   (truncated-list->string (list 'define (list outer-name) (unquoted body)))))
+
+		  (when (pair? body)
+		    (let ((args (cdr body)))
+		      (case (car body)
+			((list-values #_list-values) ; was list also briefly
+			 (when (and (pair? args)
+				    (quoted-symbol? (car args)))
+			   (if (proper-list? outer-args)
+			       (if (and (equal? (cdr args) outer-args)
+					(or (not (hash-table-ref syntaces (cadar args))) ; (define-macro (x y) `(lambda () ,y))
+					    (memq (cadar args) '(set! define))))
+				   (lint-format "perhaps ~A" caller                ; (define-macro (fx x) `(abs ,x)) -> (define fx abs)
+						(lists->string form (list 'define outer-name (cadar args))))
+
+				   (if (and (not (hash-table-ref syntaces (cadar args)))
+					    (not (any-macro? (cadar args) env))
+					    (lint-every? (lambda (a)
+							   (or (code-constant? a)
+							       (and (memq a outer-args)
+								    (= (lint-tree-count a (cdr args) 2) 1))))
+							 (cdr args)))
+				       ;; marginal -- there are many debatable cases here
+				       (lint-format "perhaps ~A" caller
+						    (lists->string form `(define (,outer-name ,@outer-args)
+									   (,(cadar args) ,@(map unquoted (cdr args))))))))
+
+			       (if (or (and (symbol? outer-args)          ; (define-macro (f . x) `(+ ,@x)) -> (define f +)
+					    (len=2? args)
+					    (len=2? (cadr args))
+					    (memq (caadr args) '(apply-values #_apply-values))
+					    (eq? (cadadr args) outer-args))
+				       (and (eqv? (length outer-args) -1) ; (define-macro (f a . x) `(+ a ,@x)) -> (define f +)
+					    (len=3? args)
+					    (eq? (cadr args) (car outer-args))
+					    (len=2? (caddr args))
+					    (memq (caaddr args) '(apply-values #_apply-values))
+					    (eq? (cadr (caddr args)) (cdr outer-args))))
+				   (lint-format "perhaps ~A"  caller
+						(lists->string form (list 'define outer-name (cadar args)))))))
+
+			 (let ((pargs (args->proper-list outer-args)))
+			   (for-each (lambda (p)
+				       (if (and (quoted-pair? p)
+						(lint-tree-set-memq pargs (cadr p)))
+					   (lint-format "missing comma? ~A" caller form)))
+				     args)))
+
+			((quote #_quote)
+			 ;; extra comma (unquote) is already caught elsewhere
+			 (if (and (pair? args)
+				  (pair? (car args))
+				  (lint-tree-set-memq (args->proper-list outer-args) (car args)))
+			     (lint-format "missing comma? ~A" caller form))))))))))
+
+
+	  ;; -------- uncurry --------
+	  (define (uncurry caller form env)
+	    (let ((sym (cadr form))
+		  (val (cddr form))
+		  (head (car form)))
+	      (let ((outer-args (cdr sym))
+		    (outer-name (if (eq? head 'define*)
+				    (remove-one :optional (car sym))
+				    (car sym))))
+		(if (symbol? (car outer-name))
+		    ;; perhaps a curried definition -- as a public service, we'll rewrite the dumb thing
+		    (begin
+		      (lint-format "perhaps ~A" caller
+				   (lists->string form `(,head ,outer-name
+							       (lambda ,outer-args
+								 ,@(cddr form)))))
+		      (lint-walk-function head (car outer-name) (cdr outer-name) val form env))
+		    (when (pair? (car outer-name))
+		      (if (symbol? (caar outer-name))
+			  (begin
+			    (lint-format "perhaps ~A" caller
+					 (lists->string form `(,head ,(car outer-name)
+								     (lambda ,(cdr outer-name)
+								       (lambda ,outer-args
+									 ,@(cddr form))))))
+			    (lint-walk-function head (caar outer-name) (cdar outer-name) val form env))
+			  (if (and (pair? (caar outer-name))
+				   (symbol? (caaar outer-name)))
+			      (begin
+				(lint-format "perhaps ~A" caller
+					     (lists->string form `(,head ,(caar outer-name)
+									 (lambda ,(cdar outer-name)
+									   (lambda ,(cdr outer-name)
+									     (lambda ,outer-args
+									       ,@(cddr form)))))))
+				(lint-walk-function head (caaar outer-name) (cdaar outer-name) val form env))
+			      ;; no hits beyond that case
+			      env)))))))
+
+	  ;; --------check-built-in-used-as-parameter --------
+	  (define (check-built-in-used-as-parameter caller form)
+	    ;; look for a built-in name used as a parameter name and used as a function internally(!)
+	    ;;   this requires a tree walker to ignore (for example) (let loop ((string string))...)
+	    (for-each (lambda (p)
+			(let ((par (if (pair? p) (car p) p)))
+			  (when (or (hash-table-ref built-in-functions par)
+				    (hash-table-ref syntaces par))
+			    (let ((call (call-with-exit
+					 (lambda (return)
+					   (let loop ((tree (cddr form)))
+					     (if (pair? tree)
+						 (if (eq? (car tree) par)
+						     (return tree)
+						     (case (car tree)
+						       ((quote #_quote) #f)
+						       ((let let*)
+							(if (len>1? (cdr tree))
+							    (if (symbol? (cadr tree))
+								(if (not (lint-tree-memq par (caddr tree)))
+								    (loop (cdddr tree)))
+								(if (not (lint-tree-memq par (cadr tree)))
+								    (loop (cddr tree))))))
+						       ((letrec letrec*)
+							(if (and (pair? (cdr tree))
+								 (not (lint-tree-memq par (cadr tree))))
+							    (loop (cddr tree))))
+						       ((do)
+							(if (and (len>1? (cdr tree))
+								 (not (lint-tree-memq par (cadr tree))))
+							    (loop (cdddr tree))))
+						       (else
+							(if (pair? (cdr tree))
+							    (for-each loop (cdr tree)))
+							(if (pair? (car tree))
+							    (loop (car tree))))))))))))
+			      (if (and (len>1? call)
+				       (not (eq? par (cadr call)))) ; (define (f50 abs) (abs -1))
+				  (lint-format "~A's parameter ~A is called ~A: find a less confusing parameter name!" caller
+					       (caadr form) par (truncated-list->string call)))))))
+		      (cdadr form)))
+
+	  ;; -------- inner-define->let --------
+	  (define (inner-define->let caller form)
+	    ;; perhaps this block should be on a *report-* switch --
+	    ;;   it translates some internal defines into named lets
+	    ;;   (or just normal lets, etc)
+	    ;; this is not redundant given the walk-body translations because here
+	    ;;   we have the outer parameters and can check those against the inner ones
+	    ;;   leading (sometimes) to much nicer rewrites.
+	    (let ((val (cddr form))
+		  (outer-args (cdadr form))
+		  (outer-name (caadr form)))
+	      (when (and (eq? (caar val) 'define) ; define* does not happen here
+			 (pair? (cdr val))
+			 (pair? (cadar val)))     ; inner define (name ...)
+		(let ((inner-name (caadar val))
+		      (inner-args (cdadar val))
+		      (inner-body (cddar val))
+		      (outer-body (cdddr form)))
+		  (when (and (symbol? inner-name)
+			     (proper-list? inner-args)
+			     (pair? (car outer-body))
+			     (= (lint-tree-count inner-name outer-body 2) 1))
+		    (let ((call (find-call inner-name outer-body)))
+		      (when (pair? call)
+			(set! last-rewritten-internal-define (car val))
+			(let ((new-call (if (lint-tree-memq inner-name inner-body)
+					    (if (and (null? inner-args)
+						     (null? outer-args))
+						(if (null? (cdr inner-body))
+						    (car (tree-subst outer-name inner-name inner-body))
+						    (cons 'begin (tree-subst outer-name inner-name inner-body)))
+						`(let ,inner-name
+						   ,(if (null? inner-args) () (map list inner-args (cdr call)))
+						   ,@inner-body))
+					    (if (or (null? inner-args)
+						    (and (equal? inner-args outer-args)
+							 (equal? inner-args (cdr call))))
+						(if (null? (cdr inner-body))
+						    (car (tree-subst outer-name inner-name inner-body))
+						    (cons 'begin (tree-subst outer-name inner-name inner-body)))
+						(cons 'let
+						      (cons (map list inner-args (cdr call))
+							    inner-body))))))
+			  ;; (define (f11 a b) (define (f12 a b) (if (positive? a) (+ a b) b)) (f12 a b)) ->
+			  ;;    (define (f11 a b) (if (positive? a) (+ a b) b))
+			  (lint-format "perhaps ~A" caller
+				       (lists->string form
+						      (cons (car form)
+							    (cons (cadr form)
+								  (let ((p (tree-subst new-call call outer-body)))
+								    (if (and (pair? p)
+									     (pair? (car p))
+									     (eq? (caar p) 'begin))
+									(cdar p)
+									p))))))))))))))
+
+	  ;; -------- letrec->define --------
+	  (define (letrec->define caller form)
+	    ;; (define x (letrec ((y (lambda...))) (lambda (...) (y...)))) -> (define (x...)...)
+	    ;;     let as well as letrec
+	    (when (memq (caaddr form) '(let letrec))
+	      (let* ((let-form (cdaddr form))
+		     (var (and (len=1? (car let-form))  ; just one var in let/rec
+			       (caar let-form))))
+		;; let-form here can be cdr of (lambda...) or (let|letrec ... lambda)
+		(when (and (len>1? var)
+			   (symbol? (car var))
+			   (len=1? (cdr let-form))      ; just one form in the let/rec
+			   (pair? (cadr let-form))
+			   (len>1? (cadr var))
+			   (eq? (caadr var) 'lambda)    ; var is lambda
+			   (proper-list? (cadadr var))) ; it has no rest arg
+		  (let ((body (cadr let-form))          ; the lambda for the outer define ("x" above)
+			(sym (cadr form)))
+		    (when (and (eq? (car body) 'lambda)     ; let/rec body is lambda calling var
+			       (proper-list? (cadr body))   ; rest args are a headache
+			       (pair? (caddr body))    ; (lambda (...) (...) where car is letrec func name
+			       (= (tree-count (car var) body 2) 1)) ; if more than 1 call, a named-let won't suffice
+		      (if (eq? (caaddr body) (car var))
+			  (lint-format "perhaps ~A" caller
+				       (lists->string form
+						      `(define (,sym ,@(cadr body))
+							 (let ,(car var)
+							   ,(map list (cadadr var) (cdaddr body))
+							   ,@(cddadr var)))))
+			  (let ((call (find-call (car var) (caddr body))))
+			    (when (and (pair? call)       ; inner lambda body is (...some-expr...(sym...) ...)
+				       (= (lint-tree-count (car var) (caddr body) 2) 1))
+			      (let ((new-call `(let ,(car var)
+						 ,(map list (cadadr var) (cdr call))
+						 ,@(cddadr var))))
+				(lint-format "perhaps ~A" caller
+					     (lists->string form
+							    `(define (,sym ,@(cadr body))
+							       ,(tree-subst new-call call
+									    (caddr body)))))))))))))))
+
+	  ;; -------- check-boolean-function --------
+	  (define (check-boolean-function caller form env)
+	    (let ((sym (caadr form))
+		  (val (cddr form)))
+	      (when (and (symbol? sym)
+			 (let ((sym-name (symbol->string sym)))
+			   (char=? #\? (sym-name (- (length sym-name) 1)))))
+		(catch 'one-is-enough
+		  (lambda ()
+		    (return-walker (last-ref val)
+				   (lambda (last)
+				     (when (or (and (code-constant? last)
+						    (not (boolean? last))
+						    (not (and (len=2? last)
+							      (memq (car last) '(quote #_quote))
+							      (boolean? (cadr last)))))
+					       (and (pair? last)
+						    (let ((sig (arg-signature (car last) env)))
+						      (and (pair? sig)
+							   (not (if (pair? (car sig))
+								    (tree-set-member '(boolean? #t values) (car sig))
+								    (memq (car sig) '(boolean? #t values))))))))
+				       (lint-format "~A looks boolean, but it can return ~A" caller
+						    sym
+						    (truncated-list->string last))
+				       (throw 'one-is-enough)))))
+		  (lambda args #f)))))
+
+	  ;; -------- rewrite-let-optionals --------
+	  (define (rewrite-let-optionals caller form outer-name outer-args val)
+	    (let ((args (args->proper-list outer-args)))
+	      (if (and (eq? (cadar val) (last-ref args))
+		       (lint-every? len=2? (caddar val))) ; some seem to include a type check?
+		  (lint-format "perhaps ~A" caller
+			       (lists->string form
+					      `(define* (,outer-name
+							 ,@(copy args (make-list (- (length args) 1)))
+							 ,@(map (lambda (p)
+								  (if (cadr p) p (car p))) ; remove #f default vals
+								(caddar val)))
+						 ...))))))
+
+	  ;; -------- define-walker --------
+	  (define (define-walker caller form env)
+	    (if (< (length form) 2)
+		(begin
+		  (lint-format "~S makes no sense" caller form)
+		  env)
+		(let ((sym (cadr form))
+		      (val (cddr form))
+		      (head (car form)))
+		  (if (symbol? sym)
+		      (begin
+			(check-definee caller sym form env)
+			(if (memq head '(define define-constant define-envelope
+					 define-public define*-public defmacro-public define-inlinable
+					 define-integrable define^))
+			    (let ((len (length form)))
+			      (if (not (= len 3))  ;  (define a b c)
+				  (lint-format "~A has ~A value~A?"
+					       caller (truncated-list->string form)
+					       (if (< len 3)
+						   (values "no" "")
+						   (values "too many" "s")))))
+			    (lint-format "~A is messed up" caller (truncated-list->string form)))
+
+			(if (not (pair? val))
+			    env
+			    (begin
+			      (if (and (null? (cdr val))
+				       (equal? sym (car val))) ; (define a a)
+				  (lint-format "this ~A is either not needed, or is an error: ~A" caller head (truncated-list->string form)))
+
+			      (if (not (pair? (car val)))
+				  (begin
+				    (cond ((and (not (memq caller '(module cond-expand)))
+						(hash-table-ref other-identifiers sym))
+					   => (lambda (p)
+						(lint-format "~A is used before it is defined: ~A" caller sym form))))
+				    (cons (make-lint-var sym (car val) head) env))
+
+				  (let ((e (lint-walk (if (and (pair? (car val))
+							       (eq? (caar val) 'letrec))
+							  'define sym)
+						      (car val) env)))
+				    (if (or (not (pair? e))
+					    (eq? e env)
+					    (not (memq (var-name (car e)) '(:lambda :dilambda)))) ; (define x (lambda ...))
+					(cons (make-lint-var sym (car val) head) env)
+					(begin
+					  (if (and *report-recursion->iteration* (eq? (var-name (car e)) :lambda))
+					      (recursion->iteration sym
+								    (var-ftype (car e))
+								    (var-arglist (car e))
+								    (var-initial-value (car e))
+								    e))
+					  (set! (var-name (car e)) sym)
+
+					  (let ((val (caddr form)))
+					    (when (and (eq? (car val) 'lambda) ; (define sym (lambda args (let name...))), let here happens rarely
+						       (proper-list? (cadr val))
+						       (len>1? (caddr val))
+						       (null? (cdddr val))
+						       (eq? (caaddr val) 'let)
+						       (symbol? (cadr (caddr val))))
+					      (replace-redundant-named-let caller form sym (cadr val) (caddr val))))
+
+					  (letrec->define caller form)
+					  e))))))) ; symbol? sym
+
+		      (begin                       ; not (symbol? sym)
+
+			(when (and (memq head '(define define*)) ; can't include define-macro et al because we use lambda(*) as rewrite
+				   (pair? val)
+				   (pair? sym))
+			  (local-funcs->closure caller form sym #t))
+
+			(cond ((not (and (pair? sym)
+					 (pair? val)))
+			       (lint-format "strange form: ~A" head (truncated-list->string form)))
+
+			      ((pair? (car sym))
+			       (uncurry caller form env))  ; curried func info thrown away (not included in returned env)
+
+			      (else
+			       (cond ((not *report-forward-functions*))
+				     ;; need to ignore macro usages here -- this happens ca 20000 times!
+				     ((hash-table-ref other-identifiers (car sym))
+				      => (lambda (p)
+					   (lint-format "~A is used before it is defined" caller (car sym)))))
+
+			       (if *report-boolean-functions-misbehaving*
+				   (check-boolean-function caller form env))
+
+			       (check-definee caller (car sym) form env)
+
+			       (let ((outer-args (cdr sym))
+				     (outer-name (car sym)))
+				 (when (len>1? (car val))
+				   (when (eq? (caar val) 'let)
+				     (check-pointless-let caller form (car val) outer-args)
+
+				     ;; define + redundant named-let -- sometimes rewrites to define*
+				     (when (and (symbol? (cadar val))
+						(null? (cdr val)))
+				       (replace-redundant-named-let caller form outer-name outer-args (car val))))
+
+				   (inner-define->let caller form)
+
+				   (if (memq (caar val) '(let-optionals let-optionals*))
+				       (rewrite-let-optionals caller form outer-name outer-args val)))
+
+				 (when (pair? outer-args)
+				   (if (repeated-member? (proper-list outer-args) env)
+				       (lint-format "~A parameter is repeated: ~A" caller head (truncated-list->string sym)))
+
+				   (cond ((memq head '(define* define-macro* define-bacro* define*-public))
+					  (check-star-parameters outer-name outer-args env))
+					 ((any-keywords? outer-args)
+					  (lint-format "~A parameter can't be a keyword: ~A" caller outer-name sym))
+					 ((memq 'pi outer-args)
+					  (lint-format "~A parameter can't be a constant: ~A" caller outer-name sym)))
+
+				   (check-built-in-used-as-parameter caller form))
+
+				 (when (eq? head 'define-macro) ; and define-expansion?
+				   (check-define-macro caller form env))
+
+				 (if (and (eq? head 'definstrument)
+					  (string? (car val)))
+				     (set! val (cdr val)))
+
+				 (if (not (keyword? outer-name))
+				     (set! env (lint-walk-function head outer-name outer-args val form env))))))
+			env)))))
+
+	  (for-each (lambda (op)
+		      (hash-walker op define-walker))
+		    '(define define* define-constant
+		      define-macro define-macro* define-bacro define-bacro* define-expansion
+		      definstrument define-animal define-envelope        ; for clm
+		      define-public define*-public defmacro-public define-inlinable
+		      define-integrable define^))                   ; these give more informative names in Guile and scmutils (MIT-scheme))
+
+
+	  ;; -------- defmacro-walker --------
+	  (define (defmacro-walker caller form env)
+	    (if (or (< (length form) 4)
+		    (not (symbol? (cadr form))))
+		(begin
+		  (if (and (> (length form) 2)
+			   (pair? (cadr form))
+			   (symbol? (caadr form)))
+		      (lint-format "~A used where s7 uses define-~A: ~A?" caller (car form) (car form) (truncated-list->string form))
+		      (lint-format "~A declaration is messed up: ~A" caller (car form) (truncated-list->string form)))
+		  env)
+		(let ((sym (cadr form))
+		      (args (caddr form))
+		      (body (cdddr form))
+		      (head (car form)))
+		  (if (and (pair? args)
+			   (repeated-member? args env))                        ; (defmacro hi (a b a) a)
+		      (lint-format "~A parameter is repeated: ~A" caller head (truncated-list->string args))
+		      (lint-format "~A is deprecated; perhaps ~A" caller head  ; (defmacro hi (a b) `(+ ,a ,b))
+				   (truncated-lists->string form
+							    (cons (if (eq? head 'defmacro) 'define-macro 'define-macro*)
+								  (cons (cons sym
+									      (let no-key ((lst args)) ; remove :key and :optional
+										(if (not (pair? lst))
+										    lst
+										    (if (memq (car lst) '(:key :optional))
+											(no-key (cdr lst))
+											(cons (car lst)
+											      (no-key (cdr lst)))))))
+									body)))))
+		  (if (eq? head 'defmacro)
+		      (check-define-macro caller
+					  (cons 'define-macro
+						(cons (cons sym args)
+						      body))
+					  env))
+
+		  (lint-walk-function head sym args body form env)
+		  (cons (make-lint-var sym form head) env))))
+
+	  (hash-walker 'defmacro defmacro-walker)
+	  (hash-walker 'defmacro* defmacro-walker))
+
+
+	;; ---------------- dilambda ----------------
+	(let ()
+	  (define (dilambda-walker caller form env)
+	    (let ((len (length form)))
+	      (if (not (= len 3))
+		  (begin
+		    (lint-format "dilambda takes two arguments: ~A" caller (truncated-list->string form))
+		    env)
+		  (let ((getter (cadr form))
+			(setter (caddr form)))
+		    (check-call caller 'dilambda form env)
+		    (lint-walk caller setter env)
+		    (let ((e (lint-walk caller getter env))) ; goes to lint-walk-function -> :lambda as first in e
+		      (if (and (pair? e)
+			       (eq? (var-name (car e)) :lambda))
+			  (set! (var-name (car e)) :dilambda))
+		      e)))))
+
+	  (hash-walker 'dilambda dilambda-walker))
+
+
+	;; ---------------- lambda, lambda* ----------------
+	(let ()
+
+	  ;; -------- lambda-walker --------
+	  (define (lambda-walker caller form env)
+	    (let ((len (length form))
+		  (head (car form)))
+	      (if (or (< len 3)
+		      (not (or (list? (cadr form))
+			       (symbol? (cadr form)))))
+		  (begin
+		    (lint-format "~A is messed up in ~A" caller head (truncated-list->string form))
+		    env)
+		  (let ((args (cadr form))
+			(arglen (length (cadr form))))
+
+		    ;; parameter error checks
+		    (when (list? args)
+		      (if (repeated-member? (proper-list args) env)
+			  (lint-format "~A parameter is repeated: ~A" caller head (truncated-list->string args)))
+		      (if (eq? head 'lambda*)                 ; (lambda* (a :b) ...)
+			  (check-star-parameters head args env)
+			  (if (any-keywords? args)            ; (lambda (:key) ...)
+			      (lint-format "lambda arglist can't handle keywords (use lambda*)" caller))))
+
+		    (if (and (eq? head 'lambda*)              ; (lambda* ()...) -> (lambda () ...)
+			     (null? args))                    ; (lambda* args ...) is caught elsewhere
+			(lint-format "lambda* could be lambda ~A" caller form))
+
+		    (when (pair? (cddr form))
+		      (local-funcs->closure caller form args #f))
+
+		    (when (or (= len 3)
+			      (and (= len 4)
+				   (string? (caddr form))))
+		      (let ((body ((if (= len 3) caddr cadddr) form)))
+
+			;; lambda -> body if rest args and apply
+			(if (or (symbol? args)                 ; (lambda args (apply f args)) -> f
+				(and (pair? args)              ; (lambda #\a ...) !
+				     (negative? arglen)))
+			    (if (and (len>2? body)
+				     (eq? (car body) 'apply)
+				     (symbol? (cadr body))
+				     (not (memq (cadr body) '(and or)))
+				     (or (eq? args (caddr body))
+					 (and (pair? args)
+					      (equal? (cddr body) (proper-list args)))))
+				;; (lambda args (apply + args)) -> +
+				(lint-format "perhaps ~A" caller (lists->string form (cadr body))))
+
+			    (when (list? args)
+			      ;; complain if let rebinds parameter uselessly
+			      (when (and (len>1? body)
+					 (eq? (car body) 'let))
+				(check-pointless-let caller form body (cadr form)))
+
+			      ;; lambda -> body when args are straightforward
+			      ;;   (lambda () (f)) -> f, (lambda (a b) (f a b)) -> f
+			      (cond ((not (and (pair? body)
+					       (symbol? (car body))
+					       (not (memq (car body) '(and or))))))
+
+				    ((equal? args (cdr body))           ; (lambda (a b) (> a b)) -> >
+				     (lint-format "perhaps ~A" caller (lists->string form (car body))))
+
+				    ((and (eq? (car body) 'not)
+					  (pair? (cdr body))
+					  (pair? (cadr body))
+					  (hash-table-ref notables (caadr body))
+					  (equal? args (cdadr body)))   ; (lambda (a b) (not (> a b))) -> <=
+				     (lint-format "perhaps ~A" caller (lists->string form (hash-table-ref notables (caadr body)))))
+
+				    ((equal? (reverse args) (cdr body)) ; (lambda (a b) (> b a)) -> <
+				     (let ((rf (hash-table-ref reversibles (car body))))
+				       (if rf (lint-format "perhaps ~A" caller (lists->string form rf)))))
+
+				    ((and (= arglen 1)                  ; (lambda (x) (cdr (cdr (car x)))) -> cddar
+					  (hash-table-ref combinable-cxrs (car body)))
+				     ((lambda* (cr arg) ; lambda* not lambda because combine-cxrs might return just #f
+					(and cr
+					     (< (length cr) 5)
+					     (eq? (car args) arg)
+					     (lint-format "perhaps ~A" caller
+							  (lists->string form (symbol "c" cr "r")))))
+				      (combine-cxrs body))))))))
+
+		    (lint-walk-function head caller args (cddr form) form env)
+		    ;; not env as return value here -- return the lambda+old env via lint-walk-function
+		    ))))
+
+	  (hash-walker 'lambda lambda-walker)
+	  (hash-walker 'lambda* lambda-walker))
+
+
+	;; ---------------- set! ----------------
+	(let ()
+	 (define (set-walker caller form env)
+	   (if (not (= (length form) 3))
+	       (begin
+		 (lint-format "set! has too ~A arguments: ~S" caller (if (> (length form) 3) "many" "few") form)
+		 env)
+	       (let ((settee (cadr form))
+		     (setval (caddr form)))
+		 (if (symbol? setval)
+		     (set-ref setval caller form env))
+		 (let ((result (lint-walk caller setval env)))
+
+		   (cond ((symbol? settee)
+			  (if (constant? settee)  ; (set! pi 3)
+			      (lint-format "can't set! ~A (it is a constant)" caller (truncated-list->string form))
+			      (let ((v (var-member settee env)))
+				(cond (v
+				       (if (eq? (var-definer v) 'define-constant)
+					   (let ((line (and (pair? (var-initial-value v))
+							    (pair-line-number (var-initial-value v)))))
+					     (lint-format "can't set! ~A in ~A (it is a constant: ~A~A)" caller settee
+							  (truncated-list->string form)
+							  (if (and (integer? line) (> line 0)) (format #f "(line ~D): " line) "")
+							  (truncated-list->string (var-initial-value v))))))
+
+				      ((and (not lint-in-with-let)
+					    (hash-table-ref built-in-functions settee))
+				       (lint-format "not recommended: ~A" caller (truncated-list->string form)))
+
+				      ((or (hash-table-ref syntaces settee)
+					   (memq settee '(else => ... _))) ; r7rs says (set! else #f) is an error
+				       (lint-format "bad idea: ~A" caller (truncated-list->string form)))))))
+
+			 ((not (pair? settee))  ; (set! 3 1)
+			  (lint-format "can't set! ~A" caller (truncated-list->string form)))
+
+			 (else
+			  (when (proper-list? settee)
+			    (let ((target (car settee)))
+			      (cond ((memq target '(vector-ref list-ref string-ref hash-table-ref int-vector-ref float-vector-ref byte-vector-ref let-ref))
+				     ;; (set! (vector-ref v 0) 3)
+				     (lint-format "perhaps ~A" caller
+						  (truncated-lists->string
+						   form
+						   (cons (case target
+							   ((vector-ref) 'vector-set!)
+							   ((int-vector-ref) 'int-vector-set!)
+							   ((float-vector-ref) 'float-vector-set!)
+							   ((byte-vector-ref) 'byte-vector-set!)
+							   ((list-ref) 'list-set!)
+							   ((string-ref) 'string-set!)
+							   ((hash-table-ref) 'hash-table-set!)
+							   ((let-ref) 'let-set!)
+							   (else 'error))
+							 (append (cdadr form) (cddr form))))))
+
+				    ((and (eq? target 'setter)
+					  (len>1? setval)
+					  (eq? (car setval) 'lambda)
+					  (list? (cadr setval))
+					  (not (= (length (cadr setval)) 2)))
+				     (lint-format "setter function should take 2 arguments: ~A" caller (truncated-list->string form)))
+
+				    ((or (string? target)
+					 (vector? target))
+				     (lint-format "~S is a constant so ~A is problematic" caller target (truncated-list->string form))))))
+
+			  (lint-walk caller settee env) ; this counts as a reference since it's by reference so to speak
+
+			  ;; try type check (dilambda signatures)
+			  (when (symbol? (car settee))
+			    (let ((f (symbol->value (car settee) *e*)))
+			      (when (dilambda? f)
+				(let ((sig (signature (setter f)))
+				      (settee-len (length settee)))
+				  (when (and (pair? sig)
+					     (positive? settee-len)
+					     (pair? (list-tail sig settee-len)))
+				    (let ((checker (list-ref sig settee-len))
+					  (arg-type (->lint-type setval)))
+				      (when (and (symbol? checker)
+						 (not (compatible? checker arg-type)))  ; (set! (print-length) "asd")
+					(lint-format "~A: new value should be a~A ~A: ~S: ~A"
+						     caller (car settee)
+						     (if (char=? (string-ref (object->string checker #f) 0) #\i) "n" "")
+						     checker arg-type
+						     (truncated-list->string form)))))))))
+			  (set! settee (do ((sym (car settee) (car sym)))
+					   ((not (pair? sym)) sym)))))
+
+		   (if (symbol? (cadr form)) ; see do directly above -- sets settee so we have to go back to (cadr form)
+		       (set-set (cadr form) caller form env)
+		       (if (and (pair? (cadr form))
+				(symbol? settee))
+			   (set-ref settee caller (cons 'implicit-set (cdr form)) env)))
+
+		   (if (or (equal? (cadr form) setval) ; not settee here!          ;  (set! a a)
+			   (and (symbol? (cadr form))
+				(equal? (caddr form) (list 'copy (cadr form)))))   ;  (set! a (copy a))
+		       (lint-format "pointless set! ~A" caller (truncated-list->string form)))
+
+		   (when (and (pair? setval)
+			      (symbol? settee))
+		     (case (car setval)
+		       ((if)                        ; (set! x (if y x 1)) -> (if (not y) (set! x 1))
+			(if (= (length setval) 4)
+			    (if (eq? settee (caddr setval))
+				(lint-format "perhaps ~A" caller
+					     (lists->string form `(if (not ,(cadr setval)) (set! ,settee ,(cadddr setval)))))
+				(if (eq? settee (cadddr setval))
+				    (lint-format "perhaps ~A" caller
+						 (lists->string form `(if ,(cadr setval) (set! ,settee ,(caddr setval)))))))))
+
+		       ((cond)                      ; (set! x (cond (z w) (else x))) -> (if z (set! x w)) -- this never happens
+			(if (and (= (length setval) 3)
+				 (pair? (caddr setval))
+				 (memq (caaddr setval) '(#t else))
+				 (null? (cddr (caddr setval)))
+				 (null? (cddadr setval)))
+			    (if (eq? (cadr (caddr setval)) (cadr form))
+				(lint-format "perhaps ~A" caller
+					     (lists->string form `(if ,(caadr setval) (set! ,(cadr form) ,(cadadr setval)))))
+				(if (eq? (cadadr setval) (cadr form))
+				    (lint-format "perhaps ~A" caller
+						 (lists->string form `(if (not ,(caadr setval)) (set! ,(cadr form) ,(cadr (caddr setval))))))))))
+
+		       ((append)                    ; in do loop, (set! sym (append sym ...)) -> (set! sym (cons ... sym)) + reverse later
+			(cond ((var-member :do env) =>
+			       (lambda (v)
+				 (let search ((tree (cddr (var-initial-value v))))
+				   (and (pair? tree)
+					(if (and (eq? (car tree) 'set!)
+						 (pair? (cdr tree))        ; (set!)?
+						 (symbol? (cadr tree))
+						 (pair? (cddr tree))
+						 (pair? (caddr tree))
+						 (eq? (caaddr tree) 'append)
+						 (pair? (cdaddr tree))
+						 (eq? (cadr tree) (cadr (caddr tree))))
+					    (lint-format "perhaps (set! ~A (append ~A ...)) -> (set! ~A (cons ... ~A)), reversing ~A at the end"
+							 caller (cadr tree) (cadr tree) (cadr tree) (cadr tree) (cadr tree))
+					    (or (search (car tree))
+						(search (cdr tree))))))))))
+
+		       ((or)                        ; (set! x (or x y)) -> (if (not x) (set! x y))
+			(if (and (= (length setval) 3)   ;    the other case here is not improved by using 'if
+				 (eq? settee (cadr setval)))
+			    (lint-format "perhaps ~A" caller
+					 (lists->string form `(if (not ,settee) (set! ,settee ,(caddr setval)))))))
+
+		       ((and)
+			(if (= (length setval) 3)   ; (set! x (and x y)) -> (if x (set! x y))
+			    (if (eq? settee (cadr setval))
+				(lint-format "perhaps ~A" caller
+					     (lists->string form `(if ,settee (set! ,settee ,(caddr setval)))))
+				(if (eq? settee (caddr setval))
+				    (lint-format "perhaps ~A" caller
+						 (lists->string form `(if (not ,(cadr setval)) (set! ,settee #f))))))))))
+		   result))))
+	 (hash-walker 'set! set-walker))
+
+
+	;; ---------------- quote ----------------
+	(let ()
+	 (define (quote-walker caller form env)
+	   (let ((len (length form)))
+	     (cond ((negative? len)
+		    (lint-format "stray dot in quote's arguments? ~S" caller form))
+
+		   ((not (= len 2))
+		    (lint-format "quote has too ~A arguments: ~S" caller (if (> len 2) "many" "few") form))
+
+		   (else
+		    (let ((arg (cadr form)))
+		      (if (pair? arg)
+			  (if (> (length arg) 8)
+			      (hash-table-set! big-constants arg (+ 1 (or (hash-table-ref big-constants arg) 0))))
+			  (unless (or (>= quote-warnings 20)
+				      (and (symbol? arg)
+					   (not (keyword? arg))))
+			    (set! quote-warnings (+ quote-warnings 1))           ; (char? '#\a)
+			    (lint-format "quote is not needed here: ~A~A" caller ; this is by far the most common message from lint
+					 (truncated-list->string form)
+					 (if (= quote-warnings 20) "; will ignore this error henceforth." ""))))))))
+	   env)
+	 (hash-walker 'quote quote-walker)
+	 (hash-walker #_quote quote-walker))
+
+
+	;; ---------------- if ----------------
+	(let ()
+
+	  ;; -------- sensible-if? --------
+	  (define (sensible-if? caller form test true false env)
+
+	    (if (eq? false #<unspecified>) ; true as #<unspecified> got no hits
+		(lint-format "this #<unspecified> is redundant: ~A" caller form))
+
+	    (if (never-false test)
+		(lint-format "if test is never false: ~A" caller (truncated-list->string form))
+		(if (and (never-true test) true) ; complain about (if #f #f) later, (if #f x y)
+		    (lint-format "if test is never true: ~A" caller (truncated-list->string form))))
+
+	    (if (and (symbol? test)
+		     (pair? true)
+		     (memq test true))
+		(and-incomplete form 'if test true env)
+		(when (len>1? test)
+		  (if (and (eq? (car test) 'not)
+			   (symbol? (cadr test))
+			   (pair? false)
+			   (memq (cadr test) false))
+		      (and-incomplete form 'if2 (cadr test) false env))
+		  (if (and (hash-table-ref bools (car test))
+			   (pair? true))
+		      (if (member (cadr test) true)
+			  (and-forgetful form 'if test true env)
+			  (do ((p true (cdr p)))
+			      ((or (not (pair? p))
+				   (and (pair? (car p))
+					(member (cadr test) (car p))))
+			       (if (pair? p)
+				   (and-forgetful form 'if test (car p) env)))))
+		      (if (and (eq? (car test) 'not)
+			       (len>1? (cadr test))
+			       (pair? false)
+			       (hash-table-ref bools (caadr test)))
+			  (if (member (cadadr test) false)
+			      (and-forgetful form 'if2 (cadr test) false env)
+			      (do ((p false (cdr p)))
+				  ((or (not (pair? p))
+				       (and (pair? (car p))
+					    (member (cadadr test) (car p))))
+				   (if (pair? p)
+				       (and-forgetful form 'if2 (cadr test) (car p) env))))))))))
+
+
+	  ;; -------- move-if-inward --------
+	  (define (move-if-inward caller form test true false env)
+	    (let ((true-op (and (pair? true) (car true)))
+		  (true-rest (and (pair? true) (cdr true)))
+		  (false-op (and (pair? false) (car false)))
+		  (false-rest (and (pair? false) (cdr false))))
+	      ;; move-if-inward
+	      (when (and (pair? true)
+			 (pair? false)
+			 (pair? true-rest)
+			 (not (memq true-op '(quote #_quote list-values #_list-values not)))
+			 (not (any-macro? true-op env))
+			 (or (not (hash-table-ref syntaces true-op))
+			     (memq true-op '(let let* set! and or begin))))
+
+		(define (tree-subst-eq new old tree)
+		  ;; tree-subst above substitutes every occurence of 'old with 'new, so we check
+		  ;;   in advance that 'old only occurs once in the tree (via tree-count).  Here
+		  ;;   'old may occur any number of times, but we want to change it only once,
+		  ;;   so we keep the actual pointer to it and use eq?.  (This assumes no shared code?)
+		  (cond ((eq? old tree)
+			 (cons new (cdr tree)))
+			((not (pair? tree))
+			 tree)
+			((memq (car tree) '(quote #_quote))
+			 (copy tree))
+			(else (cons (tree-subst-eq new old (car tree))
+				    (tree-subst-eq new old (cdr tree))))))
+
+		(when (and (case true-op                      ; (if old (list form) (cons form old)) -> (cons form (if old () old)) etc
+			     ((list) (eq? false-op 'cons))
+			     ((cons) (eq? false-op 'list))
+			     (else #f))
+			   (pair? true-rest)
+			   (pair? false-rest)
+			   (equal? (car true-rest) (car false-rest)))
+		  (if (eq? true-op 'list)
+		      (when (null? (cdr true-rest))
+			(set! true `(cons ,(car true-rest) ()))
+			(set! true-op 'cons)
+			(set! true-rest (list (car true-rest) ())))
+		      (when (null? (cdr false-rest))
+			(set! false `(cons ,(car false-rest) ()))
+			(set! false-op 'cons)
+			(set! false-rest (list (car false-rest) ())))))
+
+		;; maybe move the unless before this
+		;; reversible ops here got no real hits (test case junk)
+		(let ((diff (let differ-in-one ((p true)
+						(q false))
+			      (and (pair? p)
+				   (pair? q)
+				   (if (equal? (car p) (car q))
+				       (differ-in-one (cdr p) (cdr q))
+				       (and (equal? (cdr p) (cdr q))
+					    (or (and (unquoted-pair? (car p))
+						     (unquoted-pair? (car q))
+						     (differ-in-one (car p) (car q)))
+						(list p (list (car p) (car q))))))))))
+		  (if (pair? diff)
+		      (unless (or (and (equal? true-op (caadr diff))   ; (if x (+ y 1) (- y 1)) -- are we trying to keep really simple stuff out?
+				       (or (hash-table-ref syntaces true-op)
+					   (hash-table-ref syntaces false-op))
+				       (any-pairs? true-rest))         ; (if x (set! y (+ x 1)) (set! y 1))
+				  (and (eq? true-op 'set!)             ; (if x (set! y w) (set! z w))
+				       (equal? (caar diff) (car true-rest))))
+			(let ((subst-loc (car diff)))
+			  ;; for let/let* if tree-subst position can't affect the test, just subst, else save test first
+			  ;;   named let diff in args gets no hits
+			  (if (memq true-op '(let let*))
+			      (if (not (or (symbol? (car true-rest))   ; assume named let is moving an if outside the loop
+					   (eq? subst-loc true-rest))) ;   avoid confusion about the vars list
+				  (let ((vars (car true-rest)))
+				    ;; (if x (let ((y (abs x))) (display z) y) (let ((y (log x))) (display z) y)) -> (let ((y ((if x abs log) x))) (display z) y)
+				    (lint-format "perhaps ~A" caller
+						 (lists->string form
+								(if (and (pair? vars)
+									 (case true-op
+									   ((let)  (lint-tree-memq subst-loc vars))
+									   ((let*) (lint-tree-memq subst-loc (car vars)))
+									   (else #f)))
+								    (tree-subst-eq (cons 'if (cons test (cadr diff))) subst-loc true)
+								    `(let ((<1> ,test))
+								       ,(tree-subst-eq `(if <1> ,@(cadr diff)) subst-loc true)))))))
+
+			      ;; also not any-macro? (car true|false) probably
+			      ;; (if x (set! y #t) (set! y #f)) -> (set! y x)
+			      (let ((nform (cond ((eq? true-op (caadr diff))  ; very common!
+						  ;;          (if x (f y) (g y)) -> ((if x f g) y)
+						  ;; but f and g can't be or/and unless there are no expressions
+						  ;;   I now like all of these -- originally found them odd: CL influence!
+						  (cons (if (equal? true-op test)
+							    (list 'or test false-op)
+							    (list 'if test true-op false-op))
+							true-rest))
+
+						 ((and (eq? (caadr diff) #t)
+						       (not (cadadr diff)))
+						  ;;          (if x (set! y #t) (set! y #f)) -> (set! y x)
+						  (tree-subst-eq test subst-loc true))
+
+						 ((and (not (caadr diff))
+						       (eq? (cadadr diff) #t))
+						  ;;          (if x (set! y #f) (set! y #t)) -> (set! y (not x))
+						  (tree-subst-eq (simplify-boolean (list 'not test) () () env)
+								 subst-loc true))
+
+						 ((equal? (caadr diff) test)
+						  ;;          (if x (set! y x) (set! y 21)) -> (set! y (or x 21))
+						  (tree-subst-eq (simplify-boolean (cons 'or (cadr diff)) () () env)
+								 subst-loc true))
+
+						 ((and (len=2? test)
+						       (eq? (car test) 'not)
+						       (equal? (cadadr diff) (cadr test)))
+						  ;;          (if (not x) (set! y z) (set! y x)) -> (set! y (or x z))
+						  (tree-subst-eq (simplify-boolean (cons 'or (reverse (cadr diff))) () () env)
+								 subst-loc true))
+
+						 ((and (eq? true-op 'begin)
+						       (eq? (caar diff) (caadr diff)) ; so I think we're changing set! target, not value
+						       (pair? true) (pair? (cdr true)) (pair? (cadr true))
+						       (eq? (caadr true) 'set!))
+						  ;; tricky: (if x (begin (set! y x) (set! j x) k) (begin (set! m x) (set! j x) k)) ->
+						  ;;            (begin (set! (if x y m) x) (set! j x) k)
+						  ;;  without this check
+						  #f)
+
+						 ((or (memq true-op '(set! begin and or))
+						      (let list-memq ((a subst-loc) (lst true))
+							(and (pair? lst)
+							     (or (eq? a lst)
+								 (list-memq a (cdr lst)))))
+
+						      ;; (if x (set! y z) (set! y w)) -> (set! y (if x z w))
+						      ;; true op moved out, if test moved in
+						      ;;  (if A (and B C) (and B D)) -> (and B (if A C D))
+						      ;;  here differ-in-one means that preceding/trailing stuff must subst-loc exactly
+
+						      (not (and (pair? test)
+								(or (side-effect? test env)
+								    (memq (car test) '(list-values #_list-values apply-values #_apply-values append unquote))))))
+
+						  (tree-subst-eq (cons 'if (cons test (cadr diff))) subst-loc true))
+
+						 (else #f))))
+
+				(if (pair? nform)
+				    (lint-format "perhaps ~A" caller (lists->string form nform)))))))
+
+		      ;; else not pair? diff
+		      (unless (memq true-op '(let let* format))
+
+			;; differ-in-trailers can (sometimes) take advantage of values
+			(let ((enddiff
+			       (let ((op (if (memq true-op '(and or + * begin max min)) true-op 'values)))
+				 (let differ-in-trailers ((p true)
+							  (q false)
+							  (c 0))
+				   (and (pair? p)
+					(pair? q)
+					(if (equal? (car p) (car q))
+					    (differ-in-trailers (cdr p) (cdr q) (+ c 1))
+					    (and (> c (if (eq? op 'values) (max 2 (/ (length true) 2)) 1))
+						 (list p
+						       (if (null? (cdr p)) (car p) (cons op p))
+						       (if (null? (cdr q)) (car q) (cons op q))))))))))
+
+			  ;; (if A (+ B C E) (+ B D)) -> (+ B (if A (+ C E) D))
+			  ;; if p/q null, don't change because for example
+			  ;;   (if A (or B C) (or B C D F)) can't be (or B C (if A ...))
+			  ;;   but if this were not and/or, it could be (+ B (if A C (values C D F)))
+			  (if (pair? enddiff)
+			      (lint-format "perhaps ~A" caller
+					   (lists->string form (tree-subst `((if ,test ,@(cdr enddiff))) (car enddiff) true)))
+
+			      ;; differ-in-headers looks for equal trailers
+			      ;;   (if A (+ B B E C) (+ D D E C)) -> (+ (if A (+ B B) (+ D D)) E C)
+			      ;;   these are not always (read: almost never) an improvement
+			      (when (and (eq? true-op false-op)
+					 (not (eq? true-op 'values))
+					 (or (not (eq? true-op 'set!))
+					     (equal? (car true-rest) (car false-rest))))
+				(let ((headdiff (let differ-in-headers ((p true-rest)
+									(q false-rest)
+									(c 0)
+									(rp ())
+									(rq ()))
+						  (and (pair? p)
+						       (pair? q)
+						       (if (equal? p q)
+							   (and (< 0 c)
+								(<= c (length p))
+								(list p (reverse rp) (reverse rq)))
+							   (differ-in-headers (cdr p) (cdr q)
+									      (+ c 1)
+									      (cons (car p) rp) (cons (car q) rq)))))))
+				  (when (pair? headdiff)
+				    (let ((op (if (memq true-op '(and or + * begin max min)) true-op 'values)))
+				      (let ((tp (if (null? (cdadr headdiff))
+						    (caadr headdiff)
+						    (cons op (cadr headdiff))))
+					    (tq (if (null? (cdaddr headdiff))
+						    (caaddr headdiff)
+						    (cons op (caddr headdiff)))))
+					;; (if A (+ B B E C) (+ D D E C)) -> (+ (if A (+ B B) (+ D D)) E C)
+					(lint-format "perhaps ~A" caller
+						     (lists->string form
+								    (cons true-op
+									  (cons (list 'if test tp tq)
+										(car headdiff))))))))))))))))))
+
+	  ;; -------- if->cond --------
+	  (define (easy-if->cond caller form)
+	    (do ((iff form (cadddr iff))
+		 (iffs 0 (+ iffs 1)))
+		((not (and (<= iffs 2)
+			   (pair? iff)
+			   (= (length iff) 4)
+			   (eq? (car iff) 'if)))
+		 (when (or (> iffs 2)
+			   (and (= iffs 2)
+				(len=3? iff)
+				(eq? (car iff) 'if)))
+		   (set! last-if-line-number line-number)
+		   ;; (if a b (if c d (if e f g))) -> (cond (a b) (c d) (e f) (else g)) -- what about *report-nested-if*?
+		   (lint-format "perhaps use cond: ~A" caller
+				(lists->string form
+					       `(cond ,@(do ((iff form (cadddr iff))
+							     (clauses ()))
+							    ((not (and (pair? iff)
+								       (= (length iff) 4)
+								       (eq? (car iff) 'if)))
+							     (append (reverse clauses)
+								     (if (and (len=3? iff)
+									      (eq? (car iff) 'if))
+									 `((,(cadr iff) ,@(unbegin (caddr iff))))
+									 `((else ,@(unbegin iff))))))
+							  (set! clauses (cons (cons (cadr iff)
+										    (unbegin (caddr iff)))
+									      clauses))))))))))
+
+	  ;; -------- if->or/and --------
+	  (define (if->or/and caller form test true false env)
+	    (cond ((side-effect? test env))
+
+		  ((equal? test true)                       ; (if x x y) -> (or x y)
+		   (lint-format "perhaps ~A" caller
+				(lists->string form
+					       (simplify-boolean (list 'or test (if (eq? false 'no-false) #<unspecified> false))
+								 () () env))))
+		  ((or (equal? test (list 'not true))       ; (if x (not x) y) -> (and (not x) y)
+		       (equal? (list 'not test) true))      ; (if (not x) x y) -> (and x y)
+		   (lint-format "perhaps ~A" caller
+				(lists->string form
+					       (simplify-boolean (list 'and true (if (eq? false 'no-false) #<unspecified> false))
+								 () () env))))
+		  ((equal? test false)                      ; (if x y x) -> (and x y)
+		   (lint-format "perhaps ~A" caller
+				(lists->string form (simplify-boolean (list 'and test true) () () env))))
+
+		  ((or (equal? (list 'not test) false)      ; (if x y (not x)) -> (or (not x) y)
+		       (equal? test (list 'not false)))     ; (if (not x) y x) -> (or x y)
+		   (lint-format "perhaps ~A" caller
+				(lists->string form (simplify-boolean (list 'or false true) () () env))))))
+
+	  ;; -------- if->when --------
+	  (define (if->when caller form test expr true false)
+	    (when (and *report-one-armed-if*
+		       (eq? false 'no-false)
+		       (or (not (integer? *report-one-armed-if*))
+			   (and (pair? true) (eq? (car true) 'begin)) ; added 3-Nov-20
+			   (> (lint-tree-leaves true) *report-one-armed-if*)))
+	      ;; (if a (begin (set! x y) z)) -> (when a (set! x y) z)
+	      (lint-format "~A~A~A perhaps ~A" caller
+			   (if (and (integer? *report-one-armed-if*)
+				    (not (and (pair? true) (eq? (car true) 'begin))))
+			       "this one-armed if is too big"
+			       "")
+			   (local-line-number test)
+			   (if (and (integer? *report-one-armed-if*)
+				    (not (and (pair? true) (eq? (car true) 'begin))))
+			       ";" "")
+			   (truncated-lists->string
+			    form (if (and (pair? expr)
+					  (eq? (car expr) 'not))
+				     (cons 'unless (cons (cadr expr) (unbegin true)))
+				     (cons 'when (cons expr (unbegin true))))))))
+
+	  ;; -------- move-cond-outward --------
+	  (define (move-cond-outward caller form expr true false env)
+	    ;; true-op = case happens a lot, but never in a way that (not expr)->false can be combined in the case
+	    (when (and (proper-pair? true)
+		       (eq? (car true) 'cond)
+		       (not (boolean? false)) ; these cases are handled elsewhere via or/and
+		       (not (and (pair? false)
+				 (eq? (car false) 'cond))))
+	      ;; (if A (cond...) B) -> (cond ((not A) B) ...)
+	      ;;    if no false and cond is one-shot => this can be optimized to (cond ((and (not A) C) => ...))
+	      (lint-format "perhaps ~A" caller
+			   (let ((nexpr (simplify-boolean (list 'not expr) () () env))
+				 (nfalse (if (eq? false 'no-false)
+					     (if (eq? form lint-mid-form)
+						 ()
+						 '(#<unspecified>))
+					     (list (if (not (and (pair? false)
+								 (> (lint-tree-leaves false) 100)))
+						       false
+						       (if (pair? (car false))
+							   (list (list (caar false) '...))
+							   (list (car false) '...)))))))
+			     (lists->string form (cons 'cond (cons (cons nexpr nfalse) (cdr true))))))))
+
+	  ;; -------- if->cond --------
+	  (define (if->cond caller form env)
+	    ;; unravel complicated if-then-else nestings into a single cond, if possible.
+	    ;;
+	    ;; The (> new-len *report-nested-if*) below can mean (nearly) all nested ifs are turned into conds.
+	    ;;   For a long time I thought the if form was easier to read, but now
+	    ;;   I like cond better.  But cond also has serious readability issues:
+	    ;;   it needs to be clearer where the test separates from the result,
+	    ;;   and in a stack of these clauses, it's hard to see anything at all.
+	    ;;   Maybe a different color for the test than the result?
+	    ;;
+	    ;; Also, the check for tree-leaves being hugely different is taken
+	    ;;   from C -- I think it is easier to read a large if statement if
+	    ;;   the shortest clause is at the start -- especially in a nested if where
+	    ;;   it can be nearly impossible to see which dangling one-liner matches
+	    ;;   which if (this even in emacs because it unmarks or doesn't remark the matching
+	    ;;   paren as you're trying to scroll up to it).
+	    ;;
+	    ;; the cond form is not always an improvement:
+	    ;;   (if A (if B (if C a b) (if C c d)) (if B (if C e f) (if C g h)))
+	    ;;   (cond (A (cond (B (cond (C a) (else b))) ... oh forget it ...))))
+	    ;;   perhaps: (case (+ (if A 4 0) (if B 2 0) (if C 1 0)) ((#b000)...))!
+	    ;;   how often (and how deeply nested) does this happen? -- not very, but nesting can be ridiculous.
+	    ;;   and this assumes all tests are always hit
+	    ;;
+	    ;; the len>2 below could be len>1 + handling of empty false branch, but
+	    ;;   I don't like the rewrites (using cond).  There are a lot of hits here but they
+	    ;;   need special-case handling, perhaps.
+
+	    (define (swap-clauses form)
+	      (if (not (len>2? (cdr form)))
+		  form
+		  (let ((expr (cadr form))
+			(ltrue (caddr form))
+			(lfalse (cadddr form)))
+
+		    (if (or (and (pair? ltrue)
+				 (not (proper-list? ltrue)))
+			    (and (pair? lfalse)
+				 (not (proper-list? lfalse))))
+			form
+
+			(let ((true-n (lint-tree-leaves ltrue))
+			      (false-n (if (not (pair? lfalse))
+					   1
+					   (lint-tree-leaves lfalse))))
+
+			  (if (< false-n (/ true-n 4))
+			      (let ((new-expr (simplify-boolean (list 'not expr) () () env)))
+				(if (and (pair? ltrue)
+					 (eq? (car ltrue) 'if))
+				    (set! ltrue (swap-clauses ltrue)))
+				(if (and (pair? ltrue)
+					 (eq? (car ltrue) 'cond))
+				    `(cond (,new-expr ,@(unbegin lfalse))
+					   ,@(cdr ltrue))
+				    `(cond (,new-expr ,@(unbegin lfalse))
+					   (else ,@(unbegin ltrue)))))
+			      (begin
+				(if (and (pair? lfalse)
+					 (eq? (car lfalse) 'if))
+				    (set! lfalse (swap-clauses lfalse)))
+
+				(if (and (pair? lfalse)
+					 (eq? (car lfalse) 'cond))
+				    `(cond (,expr ,@(unbegin ltrue))
+					   ,@(cdr lfalse))
+				    `(cond (,expr ,@(unbegin ltrue))
+					   (else ,@(unbegin lfalse)))))))))))
+
+	    (let ((new-if (swap-clauses form)))
+	      (when (and (eq? (car new-if) 'cond)
+			 (> (length new-if) *report-nested-if*))
+		(set! last-if-line-number line-number)
+		(lint-format "perhaps ~A" caller (lists->string form new-if)))))
+
+	  ;; -------- if->bool --------
+	  (define (if->bool caller form expr true false env no-suggestion)
+	    (cond ((eq? expr #t) ; (if #t #f) -> #f
+		   (lint-format "perhaps ~A" caller (lists->string form true)))
+
+		  ((not expr)
+		   (if (eq? false 'no-false)
+		       (if true                             ; (if #f x) as a kludgey #<unspecified>
+			   (lint-format "perhaps ~A" caller (lists->string form #<unspecified>)))
+		       ;; (if (negative? (gcd x y)) a b) -> b
+		       (lint-format "perhaps ~A" caller (lists->string form false))))
+
+		  ((code-equal? true false)   ; (if x (+ y 1) (+ y 1)) -> (+ y 1)
+		   (lint-format "if is not needed here: ~A" caller
+				(lists->string form (if (not (side-effect? expr env))
+							true
+							(list 'begin expr true)))))
+
+		   ((boolean? true)
+		    (if (boolean? false)          ; !  (if expr #t #f) turned into something less verbose
+			;; (if x #f #t) -> (not x)
+			(lint-format "perhaps ~A" caller
+				     (lists->string form (if true expr (simplify-boolean (list 'not expr) () () env))))
+			(when no-suggestion	  ; (if x #f y) -> (and (not x) y)
+			  (lint-format "perhaps ~A" caller
+				       (lists->string form (if true
+							       (if (eq? false 'no-false)
+								   expr
+								   (simplify-boolean (list 'or expr false) () () env))
+							       (if (eq? form lint-mid-form)
+								   (if (and (pair? expr)
+									    (eq? (car expr) 'not))
+								       (cons 'when (cons (cadr expr) (unbegin false)))
+								       (cons 'unless (cons expr (unbegin false))))
+								   (simplify-boolean
+								    (if (eq? false 'no-false)
+									(list 'not expr)
+									(list 'and (list 'not expr) false))
+								    () () env))))))))
+		   ((and (boolean? false)
+			 no-suggestion)        ; (if x y #t) -> (or (not x) y)
+		    (lint-format "perhaps ~A" caller
+				 (let ((nexpr (cond (false
+						     (list 'or (if (and (len>1? expr)
+									(eq? (car expr) 'not))
+								   (cadr expr)
+								   (list 'not expr))
+							   true))
+						    ((not (eq? form lint-mid-form))
+						     (list 'and expr true))
+						    ((and (pair? expr)
+							  (eq? (car expr) 'not))
+						     (cons 'unless (cons (cadr expr) (unbegin true))))
+						    (else (cons 'when (cons expr (unbegin true)))))))
+				   (lists->string form
+						  (if (and (eq? form lint-mid-form)
+							   (eq? (car nexpr) 'when))
+						      nexpr
+						      (simplify-boolean nexpr () () env))))))))
+
+	  ;; -------- move-let-outward --------
+	  (define (move-let-outward caller form expr true false env)
+	    ;; this happens occasionally -- scarcely worth this much code! (gather copied vars outside the if)
+	    (when (and (len>1? true)     ; len>1? so true-rest is a pair
+		       (len>1? false)    ; same for false-rest
+		       (eq? (car true) 'let)
+		       (eq? (car false) 'let))
+	      (let ((true-rest (cdr true))
+		    (false-rest (cdr false)))
+		(when (and (pair? (car true-rest))
+			   (just-pairs? (car true-rest))
+			   (pair? (car false-rest))
+			   (just-pairs? (car false-rest)))
+		  (let ((true-vars (map car (car true-rest)))
+			(false-vars (map car (car false-rest)))
+			(shared-vars ()))
+		    (for-each (lambda (v)
+				(if (and (memq v false-vars)
+					 (equal? (cadr (assq v (car true-rest)))
+						 (cadr (assq v (car false-rest)))))
+				    (set! shared-vars (cons v shared-vars))))
+			      true-vars)
+		    (when (pair? shared-vars)
+		      ;; now remake true/false lets (maybe nil) without shared-vars
+		      (let ((ntv ())
+			    (nfv ())
+			    (sv ()))
+			(for-each (lambda (v)
+				    (if (memq (car v) shared-vars)
+					(set! sv (cons v sv))
+					(set! ntv (cons v ntv))))
+				  (car true-rest))
+			(set! ntv (if (or (pair? ntv)
+					  (pair? (cddr true-rest))) ; even define is safe here because outer let blocks it just as inner let used to
+				      (cons 'let (cons (reverse ntv) (cdr true-rest)))
+				      (cadr true-rest)))
+			(for-each (lambda (v)
+				    (if (not (memq (car v) shared-vars))
+					(set! nfv (cons v nfv))))
+				  (car false-rest))
+			(set! nfv (if (or (pair? nfv)
+					  (pair? (cddr false-rest)))
+				      (cons 'let (cons (reverse nfv) (cdr false-rest)))
+				      (cadr false-rest)))
+			;; (if (> (+ a b) 3) (let ((a x) (c y)) (* a (log c))) (let ((b z) (c y)) (+... ->
+			;;    (let ((c y)) (if (> (+ a b) 3) (let ((a x)) (* a (log c))) (let ((b z)) (+ b (log c)))))
+			(lint-format "perhaps ~A" caller
+				     (lists->string form
+						    (if (not (or (side-effect? expr env)
+								 (lint-tree-set-memq (map car sv) expr)))
+							(list 'let (reverse sv) (list 'if expr ntv nfv))
+							(let ((uniq (find-unique-name form)))
+							  `(let ((,uniq ,expr))
+							     (let ,(reverse sv)
+							       (if ,uniq ,ntv ,nfv))))))))))))))
+
+	  ;; -------- move-false-outward --------
+	  (define (move-false-outward caller form expr true false env)
+	    (let ((true-rest (and (pair? true) (cdr true)))
+		  (false-rest (cdr false)))
+	      (case (car false)
+		((cond)                 ; (if a A (cond...)) -> (cond (a  A) ...)
+		 (when (proper-list? false-rest)
+		   (lint-format "perhaps ~A" caller (lists->string form (cons 'cond (cons (list expr true) false-rest))))))
+
+		((if)
+		 (unless (= last-if->case-line-number line-number)
+		   (let ((eqv-select (eqv-selector expr))) ; this is just an accessor -- no check for case compatibility of expr
+		     ;; (if (= x 1) 2 (if (= x 3) 3 4)) -> (case x ((1) 2) ((3) 3) (else 4))
+		     (when (and eqv-select
+				(cond-eqv? expr eqv-select #t)
+				(pair? (cdr false))
+				(cond-eqv? (cadr false) eqv-select #t))
+		       (let ((clauses (list (list expr true))))
+			 (let gather-clauses ((f false))
+			   (if (and (len>2? f)
+				    (eq? (car f) 'if)
+				    (cond-eqv? (cadr f) eqv-select #t))
+			       (begin
+				 (set! clauses (cons (list (cadr f) (caddr f)) clauses))
+				 (if (pair? (cdddr f))
+				     (gather-clauses (cadddr f))))
+			       (set! clauses (cons (list 'else f) clauses))))
+			 (when (or (> (length clauses) 2)
+				   (not (eq? (caar clauses) 'else)))
+			   (set! last-if->case-line-number line-number)
+			   (lint-format "perhaps ~A" caller
+					(lists->string form
+						       (cond->case eqv-select (reverse clauses)))))))))
+
+		 (when (= (length false) 4)
+		   (let ((false-test (car false-rest))
+			 (false-true (cadr false-rest))
+			 (false-false (caddr false-rest)))
+		     (if (equal? true false-true)
+			 ;; (if a A (if b A B)) -> (if (or a b) A B)
+			 (lint-format "perhaps ~A" caller
+				      (if (and (pair? false-false)
+					       (eq? (car false-false) 'if)
+					       (equal? true (caddr false-false)))
+					  (lists->string form
+							 (let ((nexpr (simplify-boolean
+								       (list 'or expr false-test (cadr false-false))
+								       () () env)))
+							   `(if ,nexpr ,true ,@(cdddr false-false))))
+					  (if true
+					      (let ((nexpr (simplify-boolean (list 'or expr false-test) () () env)))
+						(lists->string form (list 'if nexpr true false-false)))
+					      (lists->string form
+							     (simplify-boolean
+							      `(and (not (or ,expr ,false-test)) ,false-false)
+							      () () env)))))
+			 (when (equal? true false-false)
+			   ;; (if a A (if b B A)) -> (if (or a (not b)) A B)
+			   (lint-format "perhaps ~A" caller
+					(if true
+					    (let ((nexpr (simplify-boolean `(or ,expr (not ,false-test)) () () env)))
+					      (lists->string form (list 'if nexpr true false-true)))
+					    (lists->string form
+							   (simplify-boolean
+							    `(and (not (or ,expr (not ,false-test))) ,false-true)
+							    () () env))))))))
+		 ;; (if (and x y) ... (if (and x z) ...)) gets 3 hits (one tricky)
+
+		 (when (and (len=3? true)
+			    (eq? (car true) 'if)
+			    (= (length false) 3)
+			    (equal? (cdr true-rest) (cdr false-rest)))
+		   ;; (if a (if b d) (if c d)) -> (if (if a b c) d)
+		   (lint-format "perhaps ~A" caller
+				(lists->string form
+					       (if (> (+ (lint-tree-leaves expr)
+							 (lint-tree-leaves (car true-rest))
+							 (lint-tree-leaves (car false-rest)))
+						      12)
+						   `(let ((<1> (if ,expr ,(car true-rest) ,(car false-rest))))
+						      (if <1> ,@(cdr true-rest)))
+						   `(if (if ,expr ,(car true-rest) ,(car false-rest)) ,@(cdr true-rest)))))))
+
+		((map)  ; (if (null? x) () (map abs x)) -> (map abs x)
+		 (when (and (len>1? expr)
+			    (eq? (car expr) 'null?)
+			    (or (null? true)
+				(equal? true (cadr expr)))
+			    (equal? (cadr expr) (cadr false-rest))
+			    (or (null? (cddr false-rest))
+				(not (side-effect? (cddr false-rest) env))))
+		   (lint-format "perhaps ~A" caller (lists->string form false))))
+
+		((case)
+		 (if (and (pair? expr)
+			  (pair? false-rest)
+			  (not (code-constant? (car false-rest)))
+			  (cond-eqv? expr (car false-rest) #t))
+		     ;; (if (eof-object? x) 32 (case x ((#\a) 3) (else 4))) -> (case x ((#<eof>) 32) ((#\a) 3) (else 4))
+		     (lint-format "perhaps ~A" caller
+				  (lists->string form `(case ,(car false-rest)
+							 ,(case-branch expr (car false-rest) (list true))
+							 ,@(cdr false-rest))))))
+
+		((else)  ; (if x (f y) (else z)) ! -- this gets 3 hits
+		 (if (not (var-member 'else env))
+		     (lint-format "else (as car of false branch of if) makes no sense: ~A" caller form))))
+
+	      (let ((false-test (and (pair? false-rest) (car false-rest))))
+		(if (and (eq? (car false) 'if)   ; (if x 3 (if (not x) 4)) -> (if x 3 4)
+			 (> (or (length false-rest) 0) 1) ; proper-list and len>1?
+			 (not (side-effect? expr env)))
+		    (if (equal? expr false-test)
+			(lint-format "perhaps ~A" caller (lists->string form `(if ,expr ,true ,@(cddr false-rest))))
+			(if (and (pair? false-test)
+				 (eq? (car false-test) 'not)
+				 (equal? expr (cadr false-test)))
+			    (lint-format "perhaps ~A" caller (lists->string form (list 'if expr true (cadr false-rest)))))))
+
+		(if (and (eq? (car false) 'if)          ; (if test0 expr (if test1 expr)) -> if (or test0 test1) expr)
+			 (len=2? false-rest)         ; other case is dealt with above
+			 (equal? true (cadr false-rest)))
+		    (let ((test1 (simplify-boolean (list 'or expr false-test) () () env)))
+		      (lint-format "~Aperhaps ~A" caller
+				   (if (equal? expr false-test) "weird repetition! " "")
+				   (lists->string form (list 'if test1 true))))))))
+
+	  ;; -------- if->min/max --------
+	  (define (if->min/max caller form test true)
+	    (when (pair? test)
+	      (let ((test-op (car test))
+		    (true-op (car true))
+		    (true-rest (cdr true)))
+		;; the min+max case is seldom hit, and takes about 50 lines
+		(when (and (memq test-op '(< > <= >=))
+			   (len=2? (cdr test)))
+		  (let ((rel-arg1 (cadr test))
+			(rel-arg2 (caddr test)))
+
+		    ;; (if (< x y) (set! x y) -> (set! x (max x y))
+		    (case true-op
+		      ((set!)
+		       (when (len>1? true-rest)
+			 (let ((settee (car true-rest))
+			       (setval (cadr true-rest)))
+			   (if (and (member settee test)
+				    (member setval test)) ; that's all there's room for
+			       (let ((f (if (equal? settee (if (memq test-op '(< <=)) rel-arg1 rel-arg2)) 'max 'min)))
+				 (lint-format "perhaps ~A" caller
+					      (lists->string form (list 'set! settee (cons f true-rest)))))))))
+
+		      ;; (if (<= (list-ref ind i) 32) (list-set! ind i 32)) -> (list-set! ind i (max (list-ref ind i) 32))
+		      ((list-set! vector-set!)
+		       (when (len>1? (cdr true-rest))
+			 (let ((settee (car true-rest))
+			       (index (cadr true-rest))
+			       (setval (caddr true-rest)))
+			   (let ((mx-op (if (and (equal? setval rel-arg1)
+						 (eqv? (length rel-arg2) 3)
+						 (equal? settee (cadr rel-arg2))
+						 (equal? index (caddr rel-arg2)))
+					    (if (memq test-op '(< <=)) 'min 'max)
+					    (and (equal? setval rel-arg2)
+						 (eqv? (length rel-arg1) 3)
+						 (equal? settee (cadr rel-arg1))
+						 (equal? index (caddr rel-arg1))
+						 (if (memq test-op '(< <=)) 'max 'min)))))
+			     (if mx-op
+				 (lint-format "perhaps ~A" caller
+					      (lists->string form (list true-op settee index (cons mx-op (cdr test))))))))))))))))
+
+	  ;; -------- inverted-if->min/max ---------
+	  (define (inverted-if->min/max caller form test true false)
+	    ;; no hits for negative?/positive? and 0/0.0 here
+	    (if (and (len=3? test)
+		     (memq (car test) '(< <= > >= =))       ; (if (< x y) x y) -> (min x y)
+		     (member false test)
+		     (member true test))
+		(if (eq? (car test) '=)                     ; (if (= x y) y x) -> y [this never happens]
+		    (lint-format "perhaps ~A" caller (lists->string form false))
+		    (let ((f (if (equal? (cadr test) (if (memq (car test) '(< <=)) true false))
+				 'min 'max)))
+		      (lint-format "perhaps ~A" caller (lists->string form (list f true false)))))))
+
+	  ;; -------- if+if->and --------
+	  (define (if+if->and caller form expr true env)
+	    (let ((true-op (car true))
+		  (true-rest (cdr true)))
+	      (cond ((not (pair? true-rest)))
+		    ((not (eq? (car true) 'if))                ; (if test0 (if test1 expr)) -> (if (and test0 test1) expr)
+		     (if (memq true-op '(when unless))         ; (if test0 (when test1 expr...)) -> (when (and test0 test1) expr...)
+			 (let ((test1 (simplify-boolean (list 'and expr (if (eq? true-op 'when)
+									    (car true-rest)
+									    (list 'not (car true-rest))))
+							() () env)))
+			   ;; (if (and (< x 1) y) (when z (display z) x)) -> (when (and (< x 1) y z) (display z) x)
+			   (lint-format "perhaps ~A" caller
+					(lists->string form
+						       (if (and (len>1? test1)
+								(eq? (car test1) 'not))
+							   (cons 'unless (cons (cadr test1) (cdr true-rest)))
+							   (cons 'when (cons test1 (cdr true-rest)))))))))
+		    ((len=1? (cdr true-rest))
+		     (let ((test1 (simplify-boolean (list 'and expr (car true-rest)) () () env)))
+		       (lint-format "perhaps ~A" caller (lists->string form (list 'if test1 (cadr true-rest))))))
+
+		    ((equal? expr (car true-rest))
+		     (lint-format "perhaps ~A" caller (lists->string form true)))
+
+		    ((and (equal? (car true-rest) (list 'not expr))
+			  (len>1? (cdr true-rest)))
+		     (lint-format "perhaps ~A" caller
+				  (lists->string form (caddr true-rest)))))))
+
+	  ;; -------- combine-if --------
+	  (define (combine-if caller form expr true false env)
+	    (let ((true-op (and (pair? true) (car true)))
+		  (true-rest (and (pair? true) (cdr true)))
+		  (false-op (and (pair? false) (car false)))
+		  (false-rest (and (pair? false) (cdr false))))
+	      (when (and (len>2? true)
+			 (eq? true-op 'if))
+		(let ((true-test (car true-rest))
+		      (true-true (and (pair? (cdr true-rest)) (cadr true-rest))))
+		  (if (= (length true) 4)
+		      (let ((true-false (caddr true-rest)))
+			(if (equal? expr (simplify-boolean (list 'not true-test) () () env))
+			    ;; (if a (if (not a) B C) A) -> (if a C A)
+			    (lint-format "perhaps ~A" caller
+					 (lists->string form (list 'if expr true-false false))))
+			(if (equal? expr true-test)
+			    ;; (if x (if x z w) y) -> (if x z y)
+			    (lint-format "perhaps ~A" caller
+					 (lists->string form (list 'if expr true-true false))))
+			(if (equal? false true-false)
+			    ;; (if a (if b B A) A) -> (if (and a b) B A)
+			    (lint-format "perhaps ~A" caller
+					 (lists->string form
+							(simplify-boolean
+							 (if (not false)
+							     (list 'and expr true-test true-true)
+							     (list 'if (list 'and expr true-test) true-true false))
+							 () () env)))
+			    (if (equal? false true-true)
+				;; (if a (if b A B) A) -> (if (and a (not b)) B A)
+				(lint-format "perhaps ~A" caller
+					     (lists->string form
+							    (simplify-boolean
+							     (if (not false)
+								 (list 'and expr (list 'not true-test) true-false)
+								 (list 'if (list 'and expr (list 'not true-test)) true-false false))
+							     () () env)))))
+
+			;; (if a (if b d e) (if c d e)) -> (if (if a b c) d e)? reversed does not happen.
+			;; (if a (if b d) (if c d)) -> (if (if a b c) d)
+			;; (if a (if b d e) (if (not b) d e)) -> (if (eq? (not a) (not b)) d e)
+			(when (and (pair? false)
+				   (eq? false-op 'if)
+				   (= (length false) 4)
+				   (not (equal? true-test (car false-rest)))
+				   (equal? (cdr true-rest) (cdr false-rest)))
+			  (let ((false-test (car false-rest)))
+			    (lint-format "perhaps ~A" caller
+					 (lists->string form
+							(cond ((and (len>1? true-test)
+								    (eq? (car true-test) 'not)
+								    (equal? (cadr true-test) false-test))
+							       (cons 'if (cons (list 'not (list 'eq? (list 'not expr) true-test))
+									       (cdr true-rest))))
+
+							      ((and (len>1? false-test)
+								    (eq? (car false-test) 'not)
+								    (equal? true-test (cadr false-test)))
+							       (cons 'if (cons (list 'eq? (list 'not expr) false-test)
+									       (cdr true-rest))))
+
+							      ((> (+ (lint-tree-leaves expr)
+								     (lint-tree-leaves true-test)
+								     (lint-tree-leaves false-test))
+								  12)
+							       `(let ((<1> (if ,expr ,true-test ,false-test)))
+								  (if <1> ,@(cdr true-rest))))
+
+							      (else
+							       (cons 'if (cons (list 'if expr true-test false-test) (cdr true-rest))))))))))
+		      (begin ; (length true) != 4
+			(if (equal? expr (simplify-boolean (list 'not true-test) () () env))
+			    (lint-format "perhaps ~A" caller  ; (if a (if (not a) B) A) -> (if (not a) A)
+					 (lists->string form (list 'if (list 'not expr) false))))
+			(if (equal? expr true-test)           ; (if x (if x z) w) -> (if x z w)
+			    (lint-format "perhaps ~A" caller
+					 (lists->string form (list 'if expr true-true false))))
+			(if (equal? false true-true)          ; (if a (if b A) A)
+			    (lint-format "perhaps ~A" caller
+					 (let ((nexpr (simplify-boolean (list 'or (list 'not expr) true-test) () () env)))
+					   (lists->string form (list 'if nexpr false)))))))))))
+
+	  ;; -------- evert-if --------
+	  (define (evert-if caller form expr true false env)
+	    ;; move repeated start/end statements out of the if
+	    (let ((ltrue (if (and (pair? true) (eq? (car true) 'begin)) true (list 'begin true)))
+		  (lfalse (if (and (pair? false) (eq? (car false) 'begin)) false (list 'begin false))))
+	      (let ((true-len (length ltrue))
+		    (false-len (length lfalse)))
+		(when (and (integer? true-len)
+			   (> true-len 1)
+			   (integer? false-len)
+			   (> false-len 1))
+		  (let ((start (if (and (equal? (cadr ltrue) (cadr lfalse))
+					(not (side-effect? expr env))) ; expr might affect start, so we can't pull it ahead
+				   (list (cadr ltrue))
+				   ()))
+			(end (if (and (not (= true-len false-len 2))
+				      (equal? (list-ref ltrue (- true-len 1))
+					      (list-ref lfalse (- false-len 1))))
+				 (list (list-ref ltrue (- true-len 1)))
+				 ())))
+		    (when (or (pair? start)
+			      (pair? end))
+		      (let ((new-true (cdr ltrue))
+			    (new-false (cdr lfalse)))
+			(when (pair? end)
+			  (set! new-true (copy new-true (make-list (- true-len 2)))) ; (copy lst ()) -> ()
+			  (set! new-false (copy new-false (make-list (- false-len 2)))))
+			(when (pair? start)
+			  (if (pair? new-true) (set! new-true (cdr new-true)))
+			  (if (pair? new-false) (set! new-false (cdr new-false))))
+			(when (or (pair? end)
+				  (and (pair? new-true)
+				       (pair? new-false))) ; otherwise the rewrite changes the returned value
+			  (if (pair? new-true)
+			      (set! new-true (if (null? (cdr new-true))
+						 (car new-true)
+						 (cons 'begin new-true))))
+			  (if (pair? new-false)
+			      (set! new-false (if (null? (cdr new-false))
+						  (car new-false)
+						  (cons 'begin new-false))))
+			  ;; (if x (display y) (begin (set! z y) (display y))) -> (begin (if (not x) (set! z y)) (display y))
+			  (let ((not-expr (and (pair? expr)
+					       (eq? (car expr) 'not))))
+			    ;; these are of the form (if expr1 (begin expr2... val) val) or its many variants
+			    ;;   see s7test.scm (lint-test "(if x (begin (display x) y) y)"...) and following
+			    ;;   that form goes to          (begin (if x (display x)) y)
+			    (lint-format "perhaps ~A" caller
+			      (lists->string form
+				(let ((body (if (null? new-true)
+						(cons (if (null? (cddr new-false)) ; (if|when|unless... )
+							  'if
+							  (if not-expr
+							      'when 'unless))
+						      (cons
+						       (if (null? (cddr new-false)) ; remove 'not if present else add unless unless
+							   (if not-expr
+							       (cadr expr)
+							       (list 'not expr))
+							   (if not-expr
+							       (cadr expr)
+							       expr))
+						       (if (and (pair? (cddr new-false))
+								(eq? (car new-false) 'begin))
+							   (cdr new-false)
+							   (list new-false))))
+
+						(if (null? new-false)
+						    (cons (if (null? (cddr new-true)) ; (if|when|unless... )
+							      'if
+							      (if not-expr
+								  'unless 'when))
+							  (cons
+							   (if (null? (cddr new-true))
+							       expr
+							       (if not-expr
+								   (cadr expr)
+								   expr))
+							   (if (and (pair? (cddr new-true))
+								    (eq? (car new-true) 'begin))
+							       (cdr new-true)
+							       (list new-true))))
+						    (list 'if expr new-true new-false)))))
+				  `(begin ,@start
+					  ,body
+					  ,@end)))))))))))))
+
+	  ;; -------- if+let->when --------
+	  (define (if+let->when caller form expr true false)
+	    ;; if+let() -> when: about a dozen hits
+	    (let ((ntrue (and (len>1? true)                    ; (if A B (let () (display x))) -> (if A B (begin (display x)))
+			      (eq? (car true) 'let)
+			      (null? (cadr true))
+			      (not (lint-tree-set-memq definers (cddr true)))
+			      (cddr true)))
+		  (nfalse (and (len>1? false)
+			       (eq? (car false) 'let)
+			       (null? (cadr false))
+			       (not (lint-tree-set-memq definers (cddr false)))
+			       (cddr false))))
+	      (if (or ntrue nfalse)
+		  (lint-format "perhaps ~A" caller
+			       (lists->string form
+					      (if (eq? false 'no-false)
+						  (cons 'when (cons expr ntrue))
+						  (if ntrue
+						      (if nfalse
+							  `(if ,expr (begin ,@ntrue) (begin ,@nfalse))
+							  `(if ,expr (begin ,@ntrue) ,false))
+						      `(if ,expr ,true (begin ,@nfalse)))))))))
+
+	  ;; -------- shorter-branch-first --------
+	  (define (shorter-branch-first caller form test true false env)
+	    (let ((true-len (lint-tree-leaves (caddr form))))
+	      (when (and (> true-len *report-short-branch*)
+			 (< (lint-tree-leaves (cadddr form)) (/ true-len *report-short-branch*)))
+		(let ((new-expr (simplify-boolean (list 'not test) () () env)))
+		  (lint-format "perhaps place the much shorter branch first~A: ~A" caller
+			       (local-line-number (cadr form))
+			       (truncated-lists->string form (list 'if new-expr false true)))))))
+
+	  ;; -------- flip-out-not --------
+	  (define (flip-out-not caller form expr true false)
+	    (when (and (len>1? expr)                       ; (if (not a) A B) -> (if a B A)
+		       (eq? (car expr) 'not)
+		       (> (lint-tree-leaves true) (lint-tree-leaves false)))
+	      (lint-format "perhaps ~A" caller
+			   (lists->string form (list 'if (cadr expr) false true)))))
+
+	  ;; -------- repeated-test->cond --------
+	  (define (repeated-test->cond caller form expr true false)
+	    (if (and (pair? expr)
+		     (len=1? (cdr true))
+		     (equal? expr (cadr true)))
+		(lint-format "perhaps ~A" caller
+			     (lists->string form
+					    (if (eq? false 'no-false)
+						(list 'cond (list expr '=> (car true)))
+						(list 'cond (list expr '=> (car true)) (list 'else false)))))))
+
+	  ;; -------- unrepeat-test --------
+	  (define (unrepeat-test caller form expr true false)
+	    ;; move repeated test to top, if no inner false branches -- aren't we assuming A does not affect B?  yes, but this never happens.
+	    ;;   (if A (if B C) (if B D)) -> (if B (if A C D))
+	    (when (and (len=3? true)
+		       (len=3? false)
+		       (eq? (car true) 'if)
+		       (eq? (car false) 'if)
+		       (equal? (cadr true) (cadr false)))
+	      (lint-format "perhaps ~A" caller
+			   (lists->string form `(if ,(cadr true)
+						    (if ,expr
+							,(caddr true)
+							,(caddr false)))))))
+
+	  ;; -------- simplify-if+ifs --------
+	  (define (simplify-if+ifs caller form expr true false env)
+	    (when (and (pair? false)
+		       (eq? (car true) 'if)
+		       (eq? (car false) 'if)
+		       (= (length true) (length false) 4)
+		       (equal? (cadr true) (cadr false)))
+	      (let ((true-rest (and (pair? true) (cdr true)))
+		    (false-rest (and (pair? false) (cddr false))))
+		(if (and (equal? (cadr true-rest) (cadr false-rest)) ; (if A (if B a b) (if B b a)) -> (if (eq? (not A) (not B)) a b)
+			 (equal? (caddr true-rest) (car false-rest)))
+		    (let* ((switch #f)
+			   (a (if (and (pair? expr)
+				       (eq? (car expr) 'not))
+				  (begin (set! switch #t) expr)
+				  (simplify-boolean (list 'not expr) () () env)))
+			   (b (if (and (pair? (car true-rest))
+				       (eq? (caar true-rest) 'not))
+				  (begin (set! switch (not switch)) (car true-rest))
+				  (simplify-boolean (list 'not (car true-rest)) () () env))))
+		      (lint-format "perhaps ~A" caller
+				   (lists->string form
+						  (if switch
+						      `(if (eq? ,a ,b) ,(car false-rest) ,(cadr true-rest))
+						      `(if (eq? ,a ,b) ,(cadr true-rest) ,(car false-rest))))))
+		    (unless (or (side-effect? expr env)
+				(equal? (cdr true-rest) false-rest)) ; handled elsewhere
+		      (if (equal? (cadr true-rest) (car false-rest))  ; (if A (if B a b) (if B a c)) -> (if B a (if A b c))
+			  (lint-format "perhaps ~A" caller
+				       (lists->string form
+						      `(if ,(car true-rest) ,(cadr true-rest)
+							   (if ,expr ,(caddr true-rest) ,(cadr false-rest)))))
+			  (if (equal? (caddr true-rest) (cadr false-rest)) ; (if A (if B a b) (if B c b)) -> (if B (if A a c) b)
+			      (lint-format "perhaps ~A" caller
+					   (lists->string form
+							  `(if ,(car true-rest)
+							       (if ,expr ,(cadr true-rest) ,(car false-rest))
+							       ,(caddr true-rest)))))))))))
+
+	  ;; -------- if->case-else --------
+	  (define (if->case-else caller form test true false) ; (if (eq? (caddr x) 'a) b (caddr x)) -> (case (caddr x) ((a) b) (else))
+	    (when (and (not (= last-let->case-line-number line-number))
+		       (or (and (len=2? test)
+				(memq (car test) '(null? not eof-object?)))   ; memx/charx got no hits
+			   (and (len=3? test)
+				(memq (car test) '(eq? eqv? =))
+				(lint-any? code-constant? test)))
+		       (or (and (unquoted-pair? false)
+				(or (member false test)
+				    (and (len=2? false)
+					 (unquoted-pair? (cadr false))
+					 (member (cadr false) test))))
+			   (and (unquoted-pair? true)
+				(or (member true test)
+				    (and (len=2? true)
+					 (unquoted-pair? (cadr true))
+					 (member (cadr true) test))))))
+	      (lint-format "perhaps use case: ~A" caller
+			   (lists->string form
+					  (let ((key #f)
+						(selector #f))
+					    (if (memq (car test) '(null? not eof-object?))
+						(begin
+						  (set! key (case (car test) ((not) #f) ((eof-object?) #<eof>) (else ())))
+						  (set! selector (cadr test)))
+						(begin
+						  (set! selector ((if (unquoted-pair? (cadr test)) cadr caddr) test))
+						  (set! key ((if (code-constant? (cadr test)) cadr caddr) test))
+						  (if (pair? key) (set! key (cadr key)))))
+
+					    (if (or (member false test)
+						    (and (len=2? false)
+							 (member (cadr false) test)))
+						`(case ,selector
+						   ((,key) ,true)
+						   (else ,@(if (member false test) () (list '=> (car false)))))
+						`(case ,selector
+						   ((,key) ,@(if (member true test) () (list '=> (car true))))
+						   (else ,false))))))))
+
+	  ;;-------- if->or/begin --------
+	  (define (if->or/begin caller form expr true false env)
+	    ;; cond version of this gets no hits
+	    ;; moving the test after the first statement assumes the statement won't affect the test.
+	    ;;   this seems to be always the case -- a check could involve outvars or
+	    ;;     (if (and (pair? true) (eq? (car true) 'set!) (lint-tree-memq (cadr true) expr))...)
+	    ;;   but it gets no hits.  The same problem probably affects move-false-outward etc.
+	    (unless (side-effect? expr env)
+	      (if (and (len>2? false)
+		       (memq (car false) '(or begin))
+		       (equal? true (cadr false)))
+		  (lint-format "perhaps ~A" caller            ; (if A (f x) (or (f x) ...)) -> (or (f x) (and (not A) (or ...)))
+			       (lists->string form
+					      (if (eq? (car false) 'or)
+						  `(or ,true (and ,(simplify-boolean (list 'not expr) () () env)
+								  ,(if (pair? (cdddr false))
+								       (cons 'or (cddr false))
+								       (caddr false))))
+						  `(begin ,true (when ,(simplify-boolean (list 'not expr) () () env)
+								  ,@(cddr false))))))
+		  (if (and (len>2? true)
+			   (memq (car true) '(or begin))      ; (if A (or (f x)...) (f x)) -> (or (f x) (and A (or ...)))
+			   (equal? false (cadr true)))
+		      (lint-format "perhaps ~A" caller
+				   (lists->string form
+						  (if (eq? (car true) 'or)
+						      `(or ,false (and ,expr
+								       ,(if (pair? (cdddr true))
+									    (cons 'or (cddr true))
+									    (caddr true))))
+						      `(begin ,false (when ,expr ,@(cddr true))))))))))
+
+	  ;; -------- if-walker --------
+	  (define (if-walker caller form env)
+	   (let ((len (length form)))
+	     (if (> len 4)
+		 (lint-format "if has too many clauses: ~A" caller (truncated-list->string form))
+		 (if (< len 3)
+		     (lint-format "if has too few clauses: ~A" caller (truncated-list->string form))
+		     (let ((true (caddr form))
+			   (false (if (= len 4) (cadddr form) 'no-false))
+			   (expr (simplify-boolean (cadr form) () () env)))
+
+		       (let ((test (cadr form)))
+			 (unless (equal? expr test)             ; (or (not (pair? x)) (not (pair? z))) -> (not (and (pair? x) (pair? z)))
+					                        ; (and (equal? (car x) (car orig)) (equal? (cdr x) (cdr orig))) -> (equal? x orig)
+			   (lint-format "perhaps ~A" caller (lists->string test expr)))
+			 ;; (if (cond...)...) doesn't happen much and is tricky to rewrite
+
+			 ;; (if ([=] x y) (f x) (f y)) gets only 2 hits, (if ([=] x y) x y) gets 1 hit -- are these so dumb we can't ignore them?
+			 ;; (if (not (null? o)) o '()) gets 2 hits
+			 ;; (if (and x...) ... (if (and (not x)...)...)) gets 6 hits and 1 is caught (and mangled)
+
+			 (let ((suggestion made-suggestion))
+			   (sensible-if? caller form test true false env)
+			   (move-if-inward caller form expr true false env)
+			   (unless (= last-if-line-number line-number)     ; avoid recursive (redundant) call
+			     (easy-if->cond caller form))
+			   (if->or/and caller form test true false env)
+			   (if->when caller form test expr true false) ; test is for a reasonable line number, expr is for a corrected test (sigh)
+			   (move-cond-outward caller form expr true false env)
+
+			 (when (= len 4)
+			   (combine-if caller form expr true false env)
+			   (when (pair? false)
+			     (move-false-outward caller form expr true false env)))
+
+			 (when (and (eq? false 'no-false)
+				    (pair? true))
+			   (if->min/max caller form test true)
+			   (if+if->and caller form expr true env))
+			 (inverted-if->min/max caller form test true false)
+			 (if->bool caller form expr true false env (= suggestion made-suggestion))
+
+			 (when (pair? true)
+			   (repeated-test->cond caller form expr true false)
+			   (simplify-if+ifs caller form expr true false env))
+#|
+			   ;; (if (not (eq? x y)) (set! x y)) -> (set! x y)
+			   (if (and (= len 3)
+				    (pair? test)
+				    (eq? (car test) 'not)
+				    (eq? (car true) 'set!)
+				    (pair? (cadr test))
+				    (eq? (caadr test) 'eq?)
+				    (equal? (cdadr test) (cdr true)))
+			       (lint-format "perhaps ~A -> ~A" caller (truncated-list->string form) true))
+			   ;; (if (eq? x y) (not (eq? x y)))
+			   (if (and (eq? (car true) 'not)
+				    (pair? (cdr true))
+				    (pair? (cadr true))
+				    (equal? test (cadr true)))
+			       (lint-format "perhaps ~A -> ~A" caller (truncated-list->string form) `(if ,test #f))))
+|#
+
+			 (when (and (= suggestion made-suggestion)
+				    (not (= line-number last-if-line-number)))
+			   (if->cond caller form env)
+			   (if+let->when caller form expr true false)
+
+			   (when (= len 4)
+			     (when (= suggestion made-suggestion) ; not redundant (if->cond above)
+			       (shorter-branch-first caller form expr true false env))
+			     (if->case-else caller form test true false)
+			     (unrepeat-test caller form expr true false)
+			     (evert-if caller form expr true false env)
+			     (when (and (= suggestion made-suggestion)      ; not redundant -- this will repeat the earlier suggestion in many cases
+					(not (= line-number last-if-line-number)))
+			       (flip-out-not caller form expr true false))
+			     (move-let-outward caller form expr true false env)
+			     (if->or/begin caller form expr true false env)))))
+
+		       ;; walking the if's with true/false lists for simplify-boolean found only 1 case of a collapsible test
+		       (if (symbol? expr)
+			   (set-ref expr caller form env)
+			   (lint-walk caller expr env))
+		       (if (symbol? true)
+			   (set-ref true caller form env)
+			   (set! env (lint-walk caller true env)))
+		       (if (symbol? false)
+			   (if (not (eq? false 'no-false))
+			       (set-ref false caller form env))
+			   (set! env (lint-walk caller false env))))))
+	     env))
+	 (hash-walker 'if if-walker))
+
+
+	;; -------- when, unless --------
+	(let ()
+	  (define (when-walker caller form env)
+	    (if (< (length form) 3)
+		(begin
+		  (lint-format "~A is messed up: ~A" caller (car form) (truncated-list->string form))
+		  env)
+		(let ((test (cadr form))
+		      (head (car form)))
+
+		  ;; when->unless and vice versa
+		  (when (pair? test)
+		    (cond ((eq? (car test) 'not)           ; (when (not a) (set! x y)) -> (unless a (set! x y))
+			   (lint-format "perhaps ~A"
+					caller
+					(truncated-lists->string form
+								 (cons (if (eq? head 'when) 'unless 'when)
+								       (cons (cadr test)
+									     (cddr form))))))
+			  ((and (eq? head 'unless)
+				(hash-table-ref notables (car test))) ; (unless (< y 3) ...) -> (when (>= y 3) ...)
+			   (lint-format "perhaps ~A"
+					caller
+					(truncated-lists->string form
+								 (cons 'when
+								       (cons (cons (hash-table-ref notables (car test)) (cdr test))
+									     (cddr form))))))))
+		  (if (never-false test)
+		      (lint-format "~A test is never false: ~A" caller head (truncated-list->string form))
+		      (if (never-true test)       ; (unless #f...)
+			  (lint-format "~A test is never true: ~A" caller head (truncated-list->string form))))
+
+		  (if (symbol? test)
+		      (begin
+			(set-ref test caller form env)
+			(if (and (eq? head 'when)
+				 (pair? (cddr form))
+				 (pair? (caddr form)))
+			    (if (memq test (caddr form))
+				(and-incomplete form head test (caddr form) env)
+				(do ((p (caddr form) (cdr p)))
+				    ((or (not (pair? p))
+					 (and (pair? (car p))
+					      (memq test (car p))))
+				     (if (pair? p)
+					 (and-incomplete form head test (car p) env)))))))
+		      (when (pair? test)
+			(if (and (eq? (car test) 'and)
+				 (len=3? test))
+			    (let ((arg1 (cadr test))
+				  (arg2 (caddr test)))
+			      (if (or (and (pair? arg1)
+					   (eq? (car arg1) 'not))
+				      (and (pair? arg2)
+					   (eq? (car arg2) 'not)))
+				  (if (eq? head 'unless)
+				      ;; (unless (and x (not y)) (display z)) -> (when (or (not x) y) ...)
+				      (lint-format "perhaps ~A" caller
+						   (lists->string form (list 'when (simplify-boolean (list 'not test) () () env) '...)))
+				      (if (and (pair? arg1)
+					       (eq? (car arg1) 'not)
+					       (pair? arg2)
+					       (eq? (car arg2) 'not))
+					  ;; (when (and (not x) (not y)) (display z)) -> (unless (or x y) ...)
+					  (lint-format "perhaps ~A" caller
+						       (lists->string form (list 'unless (list 'or (cadr arg1) (cadr arg2)) '...))))))))
+			(lint-walk caller test env)))
+
+		  (when (and (len=1? (cddr form))           ; (when t1 (if t2 A)) -> (when (and t1 t2) A)
+			     (len>1? (caddr form)))
+		    (let ((body (caddr form)))
+		      (if (and (eq? (car body) 'cond)       ; (when test (cond ...)) -> (cond ...)
+			       (proper-list? body))
+			  (lint-format "perhaps ~A" caller
+				       (truncated-lists->string form
+								(cons 'cond
+								      (cons (list (if (eq? (car form) 'when)
+										      (simplify-boolean (list 'not (cadr form)) () () env)
+										      (cadr form))
+										  #<unspecified>) ; was #f 12-Oct-21
+									    (cdr body)))))
+			  (when (or (memq (car body) '(when unless))
+				    (and (eq? (car body) 'if)
+					 (len=3? body)))
+			    (let ((new-test (let ((inner-test (if (eq? (car body) 'unless)
+								  (list 'not (cadr body))
+								  (cadr body)))
+						  (outer-test (if (eq? head 'unless)
+								  (list 'not test)
+								  test)))
+					      (simplify-boolean (list 'and outer-test inner-test) () () env))))
+			      ;; (when (and (< x 1) y) (if z (display z))) -> (when (and (< x 1) y z) (display z))
+			      (lint-format "perhaps ~A" caller
+					   (lists->string form
+							  (if (and (len=2? new-test)
+								   (eq? (car new-test) 'not))
+							      (cons 'unless (cons (cadr new-test) (cddr body)))
+							      (cons 'when (cons new-test (cddr body)))))))))))
+		  (lint-walk-open-body caller head (cddr form) env))))
+	  (hash-walker 'when when-walker)
+	  (hash-walker 'unless when-walker))
+
+
+	;; -------- check-results --------
+	;; called in cond, case, and do for => primarily
+	(define (check-results caller syn clause sequel env)
+	  (cond ((not (pair? sequel))
+		 (if (not (null? sequel))  ; (not (null?...)) here is correct -- we're looking for stray dots
+		     (lint-format "~A clause is messed up: ~A" caller syn (truncated-list->string clause))))
+
+		((not (eq? (car sequel) '=>))
+		 (lint-walk-open-body caller syn sequel env))
+
+		((or (not (pair? (cdr sequel)))
+		     (pair? (cddr sequel)))
+		 ;; (cond (x =>))
+		 (lint-format "~A => target is messed up: ~A" caller syn (truncated-list->string clause)))
+
+		(else (let ((f (cadr sequel)))
+			(if (symbol? f)
+			    (let ((val (symbol->value f *e*)))
+			      (when (procedure? val)
+				(if (not (aritable? val 1)) ; here values might be in test expr
+				    ;; (cond (x => expt))
+				    (lint-format "=> target (~A) may be unhappy: ~A" caller f clause))
+				(let ((sig (signature val)))
+				  (if (len>1? sig)
+				      (let ((from-type (->lint-type ((if (or (memq syn '(cond do-result))
+									     (not (pair? (car clause))))
+									 car caar) clause)))
+					    (to-type (cadr sig)))
+					(if (not (or (memq from-type '(#f #t values))
+						     (memq to-type '(#f #t values))
+						     (any-compatible? to-type from-type)))
+					    ;; (cond ((> x 0) => abs) (else y))
+					    (lint-format "in ~A, ~A returns a ~A, but ~A expects ~A" caller
+							 (truncated-list->string clause)
+							 (car clause) (prettify-checker-unq from-type)
+							 f to-type)))))))
+			    (if (and (len>1? f)
+				     (eq? (car f) 'lambda)
+				     (pair? (cadr f))
+				     (not (= (length (cadr f)) 1)))
+				(lint-format "=> target (~A) may be unhappy: ~A" caller f clause)))
+			(lint-walk caller f env)))))
+
+	;; ---------------- cond ----------------
+	(let ()
+	  ;; in s7, (cond (A) (B) (else #f)) is (or A B), but it probably never happens
+
+	  ;; -------- cond->header+cond+trailer --------
+	  (define (cond->header+cond+trailer caller form len env)
+	    ;; (cond (A (and B C)) (else (and B D))) et al never happens
+	    ;;    also (cond (A C) (B C)) -> (if (or A B) C) [non-pair C]
+	    ;; ----------------
+	    ;; if regular cond + else
+	    ;;   scan all return blocks
+	    ;;   if all one form, and either header or trailer always match,
+	    ;;   rewrite as header + cond|if + trailer
+	    ;; given values and the presence of else, every possibility is covered
+	    ;; at least (car result) has to match across all
+	    (when (and (> len 1) ; (cond (else ...)) is handled elsewhere
+		       (pair? (cdr form))
+		       (not (lint-tree-set-memq '(unquote list-values #_list-values) form)))
+	      (let ((first-clause (cadr form))
+		    (else-clause (list-ref form len)))
+		(when (and (len=1? (cdr first-clause))
+			   (pair? (cadr first-clause))
+			   (not (eq? (caadr first-clause) 'list))) ; (list (cond ...values...)) is worse than (cond ...list...)
+		  (let ((first-result (cadr first-clause))
+			(first-func (caadr first-clause)))
+		    (if (and (memq (car else-clause) '(#t else))
+			     (pair? (cdr else-clause))
+			     (pair? (cadr else-clause))
+			     (or (equal? first-func (caadr else-clause)) ; there's some hope we'll match
+				 (escape? (cadr else-clause) env)))
+			(let ((else-error (escape? (cadr else-clause) env)))
+			  (when (and (pair? (cdr first-result))
+				     (not (eq? first-func 'values))
+				     (or (not (hash-table-ref syntaces first-func))
+					 (eq? first-func 'set!))
+				     (lint-every? (lambda (c)
+						    (and (len=2? c)
+							 (len>1? (cadr c))
+							 (or (equal? first-func (caadr c))
+							     (and (eq? c else-clause)
+								  else-error))))
+						  (cddr form)))
+			    ((lambda (header-len trailer-len result-min-len)
+			       (when (and (>= header-len 0)
+					  (>= trailer-len 0)
+					  (or (not (eq? first-func 'set!))
+					      (> header-len 1))
+					  (or (not (eq? first-func '/))
+					      (> header-len 1)
+					      (> trailer-len 0)))
+				 (let ((header (copy first-result (make-list header-len)))
+				       (trailer (copy first-result (make-list trailer-len) (- (length first-result) trailer-len))))
+				   (if (= len 2)
+				       (unless (equal? first-result (cadr else-clause)) ; handled elsewhere (all results equal -> result)
+					 ;; (cond (x (for-each (lambda (x) (display (+ x a))) (f y))) (else (for-each... ->
+					 ;;    (for-each (lambda (x) (display (+ x a))) (if x (f y) (g y)))
+					 (lint-format "perhaps ~A" caller
+						      (let ((else-result (cadr else-clause)))
+							(let ((first-mid-len (- (length first-result) header-len trailer-len))
+							      (else-mid-len (- (length else-result) header-len trailer-len)))
+							  (let ((fmid (if (= first-mid-len 1)
+									  (list-ref first-result header-len)
+									  (cons 'values (copy first-result (make-list first-mid-len) header-len))))
+								(emid (if else-error
+									  else-result
+									  (if (= else-mid-len 1)
+									      (list-ref else-result header-len)
+									      (cons 'values (copy else-result (make-list else-mid-len) header-len))))))
+							    (lists->string form (append header (cons (list 'if (car first-clause) fmid emid) trailer))))))))
+				       ;; len > 2 so use cond in the revision
+				       (let ((middle (map (lambda (c)
+							    (if (and else-error
+								     (eq? c else-clause))
+								else-clause
+								(let ((test (car c))
+								      (result (cadr c)))
+								  (let ((mid-len (- (length result) header-len trailer-len)))
+								    (list test (if (= mid-len 1)
+										   (list-ref result header-len)
+										   (cons 'values (copy result (make-list mid-len) header-len))))))))
+							  (cdr form))))
+					 ;; (cond ((< x 1) (+ x 1)) ((< y 1) (+ x 3)) (else (+ x 2))) -> (+ x (cond ((< x 1) 1) ((< y 1) 3) (else 2)))
+					 (lint-format "perhaps ~A" caller
+						      (lists->string form (append header (cons (cons 'cond middle) trailer)))))))))
+			     (partition-form (cdr form) (if else-error (- len 1) len)))))
+
+			;; not escaping else here because the trailing args might be evaluated first
+			(when (and (not (hash-table-ref syntaces (car first-result)))
+				   (lint-every? (lambda (c)
+						  (and (len=2? c)
+						       (pair? (cadr c))
+						       (not (hash-table-ref syntaces (caadr c)))
+						       (equal? (cdadr c) (cdr first-result))))
+						(cddr form)))
+			  (if (lint-every? (lambda (c)
+					(eq? first-func (caadr c)))         ; all result clauses are the same!?
+				      (cddr form))                          ; possibly no else, so not always a duplicate message
+			      ;; (cond (X (f y z)) (Y (f y z)) (Z (f y z))) -> (if (or X Y Z) (f y z))
+			      (lint-format "perhaps ~A" caller
+					   (lists->string form
+							  (list 'if (cons 'or (map car (cdr form))) first-result)))
+			      ;; here we need an else clause else (apply #<unspecified> args)
+			      (if (memq (car else-clause) '(#t else))
+				  ;; (cond (X (f y z)) (else (g y z))) -> ((cond (X f) (else g)) y z)
+				  (lint-format "perhaps ~A" caller
+					       (lists->string form
+							      (cons (cons 'cond (map (lambda (c)
+										       (list (car c) (caadr c)))
+										     (cdr form)))
+								    (cdr first-result)))))))))))))
+
+	  ;; -------- cond->or --------
+	  (define (cond->or caller form all-eqv eqv-select simplifications env)
+	    (do ((new-clauses ())
+		 (current-clauses ())
+		 (clauses (cdr form) (cdr clauses)))
+		((null? clauses)
+		 (let ((len2 (= (length new-clauses) 2)))
+		   (unless (and len2         ; i.e. don't go to check-bool-cond
+				(check-bool-cond caller form (cadr new-clauses) (car new-clauses) env))
+		     ;; (cond ((= x 3) 3) ((= x 2) 4) ((= x 1) 4)) -> (case x ((3) 3) ((2 1) 4))
+		     (lint-format "perhaps ~A" caller
+				  (lists->string
+				   form
+				   (cond (all-eqv
+					  (cond->case eqv-select (reverse new-clauses)))
+					 ((not (and len2
+						    (memq (caar new-clauses) '(else #t))
+						    (len=1? (cadr new-clauses))
+						    (pair? (caadr new-clauses))
+						    (eq? (caaadr new-clauses) 'or)))
+					  (cons 'cond (reverse new-clauses)))
+					 ((null? (cddar new-clauses))  ; (cond (A) (B) (else C)) -> (or A B C)
+					  `(or ,@(cdaadr new-clauses) ,(cadar new-clauses)))
+					 (else `(or ,@(cdaadr new-clauses) (begin ,@(cdar new-clauses))))))))))
+
+	      (let* ((clause (car clauses))
+		     (result (cdr clause))) ; can be null in which case the test is the result
+		(cond ((and (pair? simplifications)
+			    (assq clause simplifications))
+		       => (lambda (e)
+			    (set! clause (cons (cdr e) result)))))
+		(if (and (pair? (cdr clauses))
+			 (equal? result (cdadr clauses)))
+		    (set! current-clauses (cons clause current-clauses))
+		    (if (pair? current-clauses)
+			(begin
+			  (set! current-clauses (cons clause current-clauses))
+			  (set! new-clauses (cons
+					     (cons (simplify-boolean (cons 'or (map car (reverse current-clauses))) () () env)
+						   result)
+					     new-clauses))
+			  (set! current-clauses ()))
+			(set! new-clauses (cons clause new-clauses)))))))
+
+	  ;; -------- cond->assoc --------
+	  (define (cond->assoc caller form simplifications)
+	    ;; look for repeated ((op x c1) c2) -> ((assoc x '((c1 . c2)...)) => cdr) anywhere in the clause list
+	    (let ((nc ())
+		  (op #f)
+		  (sym-access #f)
+		  (start #f)
+		  (changed #f))
+
+	      ;; extending this to memx possibilities got only 1 hit and involved ca. 20 lines
+
+	      (define (car-with-expr cls)
+		(cond ((and (pair? simplifications)
+			    (assq cls simplifications))
+		       => (lambda (e)
+			    (set! changed #t)
+			    (cons (cdr e) (cdr cls))))
+		      (else cls)))
+
+	      (define (start-search clauses test)
+		(if (code-constant? (cadr test))
+		    (if (memq (car test) '(= string=? string-ci=? eq? eqv? equal? char=? char-ci=?))
+			(set! sym-access caddr))
+		    (if (code-constant? (caddr test))
+			(set! sym-access cadr)))
+		(if sym-access
+		    (begin
+		      (set! start clauses)
+		      (set! op (car test)))
+		    (set! nc (cons (car-with-expr (car clauses)) nc))))
+
+	      (do ((clauses (cdr form) (cdr clauses)))
+		  ((null? clauses)
+		   (if (and changed
+			    (null? clauses))
+		       ;; (cond ((< x 2) 3) ((> x 0) 4) ((< x 2) 5)) -> (cond ((< x 2) 3) ((> x 0) 4))
+		       (lint-format "perhaps ~A" caller
+				    (lists->string form (cons 'cond (reverse (map (lambda (c)
+										    (if (not (car c)) (values) c))
+										  nc)))))))
+		(let ((test (caar clauses)))
+		  (let ((ok-but-at-end #f)
+			(looks-ok (let ((result (cdar clauses)))
+				    (and (len=3? test)
+					 (len=1? result)
+					 (not (symbol? (car result)))
+					 (or (not (pair? (car result))) ; quoted lists look bad in this context
+					     (and (len=2? (car result))
+						  (memq (caar result) '(quote #_quote))
+						  (not (pair? (cadar result)))))))))
+		    (if (not start)
+			(if (and looks-ok
+				 (not (null? (cdr clauses))))
+			    (start-search clauses test)
+			    (set! nc (cons (car-with-expr (car clauses)) nc)))
+
+			(unless (and looks-ok
+				     (eq? (car test) op)
+				     (equal? (sym-access test) (sym-access (caar start)))
+				     (code-constant? ((if (eq? sym-access cadr) caddr cadr) test))
+				     (not (set! ok-but-at-end (null? (cdr clauses)))))
+
+			  (if (eq? (cdr start) clauses) ; only one item in the block, or two but it's just two at the end
+			      (begin
+				(set! nc (cons (car start) nc))
+				(if (and looks-ok
+					 (not (null? (cdr clauses))))
+				    (start-search clauses test)
+				    (begin
+				      (set! start #f)
+				      (set! nc (cons (car-with-expr (car clauses)) nc)))))
+
+			      ;; multiple hits -- can we combine them?
+			      (let ((alist ())
+				    (cc (if (eq? sym-access cadr) caddr cadr)))
+				(set! changed #t)
+				(do ((sc start (cdr sc)))
+				    ((if ok-but-at-end
+					 (null? sc)
+					 (eq? sc clauses))
+				     (case op
+				       ((eq?)
+					(set! nc (cons `((assq ,(sym-access (caar start)) ',(reverse alist)) => cdr) nc)))
+
+				       ((eqv? char=?)
+					(set! nc (cons `((assv ,(sym-access (caar start)) ',(reverse alist)) => cdr) nc)))
+
+				       ((equal?)
+					(set! nc (cons `((assoc ,(sym-access (caar start)) ',(reverse alist)) => cdr) nc)))
+
+				       ((string=?)
+					;; this is probably faster than assoc + string=?, but it creates symbols
+					(let ((nlst (map (lambda (c)
+							   (cons (string->symbol (car c)) (cdr c)))
+							 alist)))
+					  (set! nc (cons `((assq (string->symbol ,(sym-access (caar start))) ',(reverse nlst)) => cdr) nc))))
+
+				       (else
+					(set! nc (cons `((assoc ,(sym-access (caar start)) ',(reverse alist) ,op) => cdr) nc)))))
+
+				  (set! alist (cons (cons (unquoted (cc (caar sc))) (unquoted (cadar sc))) alist)))
+
+				(if (and looks-ok
+					 (not (null? (cdr clauses))))
+				    (start-search clauses test)
+				    (begin
+				      (set! start #f)
+				      (if (not ok-but-at-end)
+					  (set! nc (cons (car-with-expr (car clauses)) nc))))))))))))))
+
+	  ;; -------- cond-remove-not --------
+	  (define (cond-remove-not caller form env)
+	    (let ((c1 (cadr form))
+		  (c2 (caddr form)))
+	      (cond ((equal? (simplify-boolean (car c1) () () env)
+			     (simplify-boolean (list 'not (car c2)) () () env))
+		     (lint-format "perhaps ~A" caller  ; (cond ((x) y) ((not (x)) z)) -> (cond ((x) y) (else z))
+				  (lists->string form (list 'cond c1 (cons 'else (cdr c2))))))
+		    ((and (pair? (cdr c2))
+			  (not (pair? (cadr c2)))
+			  (not (memq (car c2) '(else #t)))
+			  (equal? (cdr c1) (cdr c2)))
+		     (lint-format "perhaps ~A" caller
+				  (lists->string form
+						 `(if (or ,(car c1) ,(car c2))
+						      ,(if (null? (cddr c1))
+							   (cadr c1)
+							   (cons 'begin (cdr c1)))))))
+		    ((and (len>1? (car c1))        ; (cond ((not x) y) (else z)) -> (cond (x z) (else y))
+			  (pair? (cdr c1))         ;    null case is handled elsewhere
+			  (eq? (caar c1) 'not)
+			  (memq (car c2) '(else #t)))
+		     (let ((c1-len (lint-tree-leaves (cdr c1))) ; try to avoid the dangling short case as in if
+			   (c2-len (lint-tree-leaves (cdr c2))))
+		       (when (and (< (+ c1-len c2-len) 100)
+				  (> (* c1-len 4) c2-len))   ; maybe 4 is too much
+			 (lint-format "perhaps ~A" caller
+				      (lists->string form
+						     (if (or (pair? (cddr c1))
+							     (pair? (cddr c2)))
+							 `(cond (,(cadar c1) ,@(cdr c2)) (else ,@(cdr c1)))
+							 (list 'if (cadar c1) (cadr c2) (cadr c1)))))))))))
+
+	  ;; -------- simplify-cond --------
+	  (define (simplify-cond caller form env)
+	    (let ((first-clause (cadr form))
+		  (last-clause (caddr form))             ; next-to-last actually
+		  (else-clause (cdr (list-ref form 3)))) ; len = 3, might be junk following else=last-clause
+
+	      (when (and (pair? else-clause)
+			 (proper-list? last-clause))
+		(when (and (or (null? (cdr first-clause))
+			       (and (len=1? (cdr first-clause))
+				    (boolean? (cadr first-clause))))
+			   (or (null? (cdr last-clause))
+			       (null? (cddr last-clause))))
+
+		  (if (and (pair? (cdr first-clause))
+			   (not (cadr first-clause))            ; (cond (A #f) (B #t) (else C)) -> (and (not A) (or B C))
+			   (or (null? (cdr last-clause))
+			       (eq? (cadr last-clause) #t)))
+		      (lint-format "perhaps ~A" caller
+				   (lists->string form
+						  (simplify-boolean
+						   `(and (not ,(car first-clause))
+							 (or ,(car last-clause)
+							     ,@(if (null? (cdr else-clause))
+								   else-clause
+								   (cons 'begin else-clause))))
+						   () () env)))
+		      (if (and (or (null? (cdr first-clause))   ; (cond (A #t) (B C) (else #f)) -> (or A (and B C))
+				   (eq? (cadr first-clause) #t))
+			       (not (car else-clause))
+			       (null? (cdr else-clause)))
+			  (lint-format "perhaps ~A" caller
+				       (lists->string form
+						      `(or ,(car first-clause)
+							   (and ,@last-clause)))))))
+
+		(when (and (proper-list? else-clause)
+			   (equal? (cdr first-clause) else-clause) ; a = else result
+			   (pair? (cdr last-clause))               ; b does exist
+			   (not (eq? (cadr last-clause) '=>)))     ; no => in b
+		  ;; (cond (A a) (B b) (else a)) -> (if (or A (not B)) a b)
+		  (lint-format "perhaps ~A" caller
+			       (lists->string form
+					      (let ((A (car first-clause))
+						    (a (cdr first-clause))
+						    (B (car last-clause))
+						    (b (cdr last-clause)))
+						(let ((nexpr (simplify-boolean `(or ,A (not ,B)) () () env)))
+						  (cond ((not (and (null? (cdr a))
+								   (null? (cdr b))))
+							 `(cond (,nexpr ,@a) (else ,@b)))
+
+							((eq? (car a) #t)
+							 (if (not (car b))
+							     nexpr
+							     (simplify-boolean (list 'or nexpr (car b)) () () env)))
+
+							((car a) ; i.e a is not #f
+							 (list 'if nexpr (car a) (car b)))
+
+							((eq? (car b) #t)
+							 (simplify-boolean (list 'not nexpr) () () env))
+
+							(else (simplify-boolean `(and (not ,nexpr) ,(car b)) () () env)))))))))))
+
+	  ;; -------- simple-cond->if --------
+	  (define (simple-cond->if caller form suggest)
+	    (let ((clause (cadr form)))       ; (cond (a)) -> a, (cond (a b)) -> (if a b) etc
+	      (if (null? (cdr clause))
+		  (lint-format "perhaps ~A" caller (lists->string form (car clause)))
+		  (if (and (pair? (cdr clause))
+			   (not (eq? (cadr clause) '=>))
+			   (or (pair? (cddr clause))
+			       (= suggest made-suggestion)))
+		      ;; (cond ((= x 1) 32)) -> (if (= x 1) 32)
+		      (lint-format "perhaps ~A" caller
+				   (lists->string form
+						  (if (null? (cddr clause))
+						      (list 'if (car clause) (cadr clause))
+						      (if (and (pair? (car clause))
+							       (eq? (caar clause) 'not))
+							  (cons 'unless (append (cdar clause) (cdr clause)))
+							  (cons 'when clause)))))))))
+
+	  ;; -------- cond-repeated-else --------
+	  (define (cond-repeated-else caller form len env)
+	    ;; this is not ideal
+	    (let ((e (list-ref form len))      ; (cond (W X) (A B) (C D) (else B)) -> (cond (W X) ((or A (not C)) B) (else D))
+		  (b (list-ref form (- len 1)))
+		  (a (list-ref form (- len 2))))
+	      (if (and (len>1? a)              ; is (else) a legal cond clause? -- yes, it returns else...
+		       (proper-list? a)
+		       (equal? (cdr a) (cdr e))
+		       (len>1? b)
+		       (proper-list? b)
+		       (not (eq? (cadr b) '=>)))
+		  (let ((expr (simplify-boolean `(or ,(car a) (not ,(car b))) () () env)))
+		    (lint-format "perhaps ~A" caller
+				 (lists->string form `(cond ,(if (> len 4) '... (cadr form))
+							    (,expr ,@(cdr a))
+							    (else ,@(cdr b)))))))))
+
+	  ;; -------- combine-repeated-tests --------
+	  (define (combine-repeated-tests caller form env)
+	    ;; repeated test exprs handled once
+	    (let ((exprs ())
+		  (reps ())
+		  (ctr 0)
+		  (pos 0)
+		  (head-len 0)
+		  (else-leaves 0)
+		  (else-result #f))
+	      (for-each (lambda (c)
+			  (set! pos (+ pos 1))
+			  (cond ((memq (car c) '(#t else))
+				 (set! else-result (cdr c))
+				 (set! else-leaves (lint-tree-leaves else-result)))
+
+				((not (and (pair? (car c))
+					   (or (eq? (caar c) 'and)
+					       (member (car c) reps))))
+				 (set! exprs ())
+				 (set! reps ())
+				 (set! ctr 0))
+
+				((null? exprs)
+				 (set! head-len pos)
+				 (set! exprs (cdar c))
+				 (set! reps exprs)
+				 (set! ctr 1))
+
+				(else
+				 (set! ctr (+ ctr 1))
+				 (set! reps (remove-if (lambda (rc)
+							 (not (or (equal? rc (car c))
+								  (member rc (cdar c)))))
+						       reps)))))
+			(cdr form))
+	      (when (and (pair? reps)
+			 (> ctr 1)
+			 (< else-leaves (* ctr (length reps) 3)))
+		;; (cond ((pair? z) 32) ((and (pair? x) (pair? w)) 12) ((pair? x) 2) (else 0)) ->
+		;;    (cond ((pair? z) 32) ((not (pair? x)) 0) ((pair? w) 12) (else 2))
+		(lint-format "perhaps ~A" caller
+			     (lists->string form
+					    (let ((not-reps
+						   (simplify-boolean (list 'not (if (null? (cdr reps))
+										    (car reps)
+										    (cons 'and reps)))
+								     () () env)))
+					      `(,@(copy form (make-list head-len))
+						(,not-reps
+						 ,@(or else-result '(#<unspecified>)))
+						,@(let mapper ((clauses (list-tail form head-len))
+							       (lst ()))
+						    (if (null? clauses)
+							(reverse lst)
+							(let ((new-clause
+							       (let ((c (car clauses)))
+								 (if (memq (car c) '(else #t))
+								     c
+								     (cons (if (member (car c) reps)
+									       'else
+									       (remove-if (lambda (rc)
+											    (member rc reps))
+											  (car c)))
+									   (cdr c))))))
+							  (if (and (len=2? (car new-clause))
+								   (eq? (caar new-clause) 'and))
+							      (set-car! new-clause (cadar new-clause)))
+							  (if (memq (car new-clause) '(else #t))
+							      (reverse (cons new-clause lst))
+							      (mapper (cdr clauses) (cons new-clause lst)))))))))))))
+
+	  ;; -------- cond->case-at-end --------
+	  (define (cond->case-at-end caller form len has-else)
+	    ;; look for case at end (case in the middle is tricky due to #f handling)
+	    (let ((rform (reverse form))
+		  (eqv-select #f)
+		  (elen (if has-else (- len 1) len)))
+	      (if has-else (set! rform (cdr rform)))
+	      (set! eqv-select (eqv-selector (caar rform)))
+	      (when eqv-select
+		(do ((clauses rform (cdr clauses))
+		     (ctr 0 (+ ctr 1)))
+		    ((or (null? clauses)
+			 (let ((clause (car clauses)))
+			   (or (and (pair? (cdr clause))
+				    (eq? (cadr clause) '=>)) ; case sends selector, but cond sends test result
+			       (not (cond-eqv? (car clause) eqv-select #t)))))
+		     (when (and (pair? clauses)
+				(> ctr 1))
+		       ;; (cond ((pair? x) 3) ((eq? x 'a) z) ((eq? x 'b) (* 2 z)) ((eq? x 'c)... ->
+		       ;;    (if (pair? x) 3 (case x ((a) z) ((b) (* 2 z)) ((c) (display z))))
+		       (lint-format "possibly use case at the end: ~A" caller
+				    (lists->string form
+						   (let ((else-case (cond->case eqv-select  ; cond->case will handle the else branch
+										(list-tail (cdr form) (- elen ctr)))))
+						     (if (= (- elen ctr) 1)
+							 (if (equal? (cdadr form) '(#f))
+							     `(and (not ,(caadr form)) ,else-case)
+							     `(if ,@(cadr form) ,else-case))
+							 `(cond ,@(copy (cdr form) (make-list (- elen ctr)))
+								(else ,else-case))))))))))))
+
+	  ;; -------- combine-conds --------
+	  (define (combine-conds caller form has-else len env)
+	    (let ((last-clause (list-ref form (if has-else (- len 1) len)))) ; not the else branch! -- just before it.
+	      (if (and (len=2? last-clause)          ; (cond ... (A (cond ...)) (else B)) -> (cond ... ((not A) B) ...)
+		       (pair? (cadr last-clause))
+		       (memq (caadr last-clause) '(if cond)))
+		  (let ((new-test (simplify-boolean (list 'not (car last-clause)) () () env))
+			(new-result (if has-else
+					(cdr (list-ref form len))
+					(if (eq? form lint-mid-form)
+					    ()
+					    (list #<unspecified>)))))
+		    (if (and (eq? (caadr last-clause) 'cond)
+			     (proper-list? (cdadr last-clause)))
+			;; (cond (A (cond (B c) (else D))) (else E)) -> (cond ((not A) E) (B c) (else D))
+			(lint-format "perhaps ~A" caller
+				     (lists->string form
+						    `(cond ,@(copy (cdr form) (make-list (- len (if has-else 2 1))))
+							   (,new-test ,@new-result)
+							   ,@(cdadr last-clause))))
+			(if (= (length (cadr last-clause)) 4)
+			    (let ((if-form (cdadr last-clause)))
+			      ;; (cond (A B) (C (if D d E)) (else F)) -> (cond (A B) ((not C) F) (D d) (else E))
+			      (lint-format "perhaps ~A" caller
+					   (lists->string form
+							  `(cond ,@(copy (cdr form) (make-list (- len (if has-else 2 1))))
+								 (,new-test ,@new-result)
+								 (,(car if-form) ,@(unbegin (cadr if-form)))
+								 (else ,@(unbegin (caddr if-form))))))))))
+		  (when (> len 2)                           ; rewrite nested conds as one cond
+		    (let ((lim (if has-else (- len 2) len))
+			  (tlen (lint-tree-leaves form)))
+		      (when (< tlen 200)
+			(set! tlen (/ tlen 4))
+			(do ((i 0 (+ i 1))
+			     (k (+ lim 1) (- k 1))
+			     (p (cdr form) (cdr p)))
+			    ((or (not (pair? p))
+				 (= i lim)))
+			  (let ((nc (car p)))
+			    (if (and (len=2? nc)
+				     (pair? (cadr nc))
+				     (eq? (caadr nc) 'cond)
+				     (>= (length (cdadr nc)) (* 2 k))
+				     (> (lint-tree-leaves nc) tlen))
+				(let ((new-test (simplify-boolean (list 'not (car nc)) () () env))
+				      (new-result (if (and has-else
+							   (= i (- lim 1))
+							   (null? (cddadr p))
+							   (pair? (cdaddr p)) ;(else)
+							   (null? (cddr (caddr p))))
+						      (list 'if (caadr p) (cadadr p) (cadr (caddr p)))
+						      (cons 'cond (cdr p)))))
+				  ;; (cond ((= x 0) 1) ((= x 3) (cond ((not y) 1) ((pair? y) 2) ((eq? y 'a) 3) (else 4))) ((< x 200) 2) (else 5)) ->
+				  ;;   (cond ((= x 0) 1) ((not (= x 3)) (if (< x 200) 2 5)) ((not y) 1) ((pair? y) 2) ((eq? y 'a) 3) (else 4))
+				  (lint-format "perhaps ~A" caller
+					       (lists->string form
+							      `(cond ,@(copy (cdr form) (make-list i))
+								     (,new-test ,new-result)
+								     ,@(cdadr nc))))))))))))))
+
+	  ;; -------- cond-one-result --------
+	  (define (cond-one-result caller form last-clause len env)
+	    (let ((result (last-ref (cadr form)))
+		  (else-clause (cdr (list-ref form len))))
+	      (when (lint-every? (lambda (c)
+				   (and (len>1? c)
+					(equal? result (last-ref c))))
+				 (cddr form))
+		;;  (cond ((and (display x) x) 32) (#t 32)) -> (begin (and (display x) x) 32)
+		(lint-format "perhaps ~A" caller
+			     (lists->string form
+					    (if (= len 2)       ; one is else -- this case is very common
+						(let* ((c1-len (length (cdr last-clause)))
+						       (new-c1 (case c1-len
+								 ((1) #f)
+								 ((2) (cadr last-clause))
+								 (else (cons 'begin (copy (cdr last-clause) (make-list (- c1-len 1)))))))
+						       (else-len (length else-clause))
+						       (new-else (case else-len
+								   ((1) #f)
+								   ((2) (car else-clause))
+								   (else (cons 'begin (copy else-clause (make-list (- else-len 1))))))))
+						  `(begin
+						     ,(if (= c1-len 1)
+							  (if new-else
+							      `(if (not ,(car last-clause)) ,new-else)
+							      (car last-clause))
+							  (if (= else-len 1)
+							      (if new-c1
+								  `(if ,(car last-clause) ,new-c1)
+								  (car last-clause))
+							      `(if ,(car last-clause) ,new-c1 ,new-else)))
+						     ,result))
+						`(begin          ; this almost never happens
+						   (cond ,@(map (lambda (c)
+								  (let ((len (length c)))
+								    (if (= len 2)
+									(if (or (memq (car c) '(else #t))
+										(not (side-effect? (car c) env)))
+									    (values)
+									    (car c))
+									(copy c (make-list (- len 1))))))
+								(cdr form)))
+						   ,result)))))))
+
+ 	  ;; -------- cond-partial-test-repeat --------
+ 	  (define (cond-partial-test-repeat caller form)
+ 	    (let ((arg1 (cadr form))
+ 		  (arg2 (caddr form)))
+ 	      (when (and (len=2? arg1)
+ 			 (len>1? (car arg1))
+ 			 (len=2? arg2)
+ 			 (eq? (caar arg1) 'and)
+ 			 (member (car arg2) (cdar arg1))
+ 			 (len=2? (cdar arg1)))
+ 		;; (cond ((and A B) c) (B d) (else e)) -> (cond (B (if A c d)) (else e))
+ 		(lint-format "perhaps ~A" caller
+ 			     (lists->string form
+ 					    (cons 'cond
+ 						  (cons (list (car arg2)
+ 							      (list 'if
+ 								    ((if (equal? (car arg2) (cadar arg1)) caddar cadar) arg1)
+ 								    (cadr arg1)
+ 								    (cadr arg2)))
+ 							(cdddr form))))))))
+
+	  ;; -------- cond-combine-into-else --------
+	  (define (cond-combine-into-else caller form last-clause len)
+	    (if (and (len=1? last-clause)   ; (cond ... ((or ...)) (else ...)) -> (cond ... (else (or ... ...)))
+		     (pair? (car last-clause))
+		     (eq? (caar last-clause) 'or))
+		(let ((else-clause (let ((e (cdr (list-ref form len))))
+				     (if (null? (cdr e))
+					 (car e)
+					 (cons 'begin e)))))
+		  ;; (cond ((A) B) ((or C D)) (else E)) -> (cond ((A) B) (else (or C D E)))
+		  (lint-format "perhaps ~A" caller
+			       (lists->string form
+					      `(cond ,@(copy (cdr form) (make-list (- len 2)))
+						     (else (or ,@(cdar last-clause) ,else-clause)))))))
+	    ;; a few dozen hits here
+	    ;;   the 'case parallel gets 2 hits, complex selectors
+	    ;;   len = (- (length form) 1) = number of clauses
+	    ;; (cond ((= x y) 2) ((= x 2) #f) (else #t)) -> (cond ((= x y) 2) (else (not (= x 2))))
+	    ;; (cond ((= x y) 2) ((= x 2) #t) (else #f)) -> (cond ((= x y) 2) (else (= x 2)))
+	    (when (and (> len 2)
+		       (or (null? (cdr last-clause))
+			   (and (len=1? (cdr last-clause))
+				(boolean? (cadr last-clause)))))
+	      (let ((else-clause (cdr (list-ref form len)))
+		    (next-clause (cdr (list-ref form (- len 2)))))
+		(when (and (len=1? else-clause)
+			   (boolean? (car else-clause))
+			   (not (equal? (cdr last-clause) else-clause))
+			   (len=1? next-clause)
+			   (not (boolean? (car next-clause))))
+		  (lint-format "perhaps ~A" caller
+			       (lists->string form
+					      (append (copy form (make-list (- len 1)))
+						      (list (list 'else (if (car else-clause)
+									    (list 'not (car last-clause))
+									    (car last-clause)))))))))))
+
+	  ;; -------- cond-scan-clauses --------
+	  (define (cond-scan-clauses caller form len env)
+	    (let ((ctr 0)
+		  (result :unset)
+		  (has-else #f)
+		  (has-combinations #f)
+		  (simplifications ())
+		  (all-eqv #t)
+		  (eqv-select #f)
+		  (exprs ())
+		  (falses ())
+		  (trues ())
+		  (prev-bool #f)
+		  (prev-clause #f)
+		  (eqv-change 0))
+	      (for-each
+	       (lambda (clause)
+		 (set! ctr (+ ctr 1))
+		 (when all-eqv
+		   (unless eqv-select
+		     (set! eqv-select (eqv-selector (car clause))))
+		   (set! all-eqv (and eqv-select
+				      (not (and (pair? (cdr clause))
+						(eq? (cadr clause) '=>))) ; case sends selector, but cond sends test result
+				      (cond-eqv? (car clause) eqv-select #t)))
+		   (when (and (not all-eqv)
+			      eqv-select
+			      (pair? (car clause))
+			      (eq? (caar clause) 'not)
+			      (pair? (cdar clause))
+			      (pair? (cadar clause))
+			      (cond-eqv? (cadar clause) eqv-select #t))
+		     (set! eqv-change ctr)))
+
+		 ;; look for successive clause tests where the earlier includes the current (number? followed by integer? etc)
+		 ;;   slightly sloppy I guess -- the arg could be self-modifying!
+		 (if (not (and (len>1? (car clause))
+			       (hash-table-ref bools (caar clause))))
+		     (set! prev-bool #f)
+		     (begin
+		       (if (and prev-bool
+				(equal? (cadar prev-clause) (cadar clause))  ; args match
+				(subsumes? prev-bool (caar clause)))         ; previous test already included this case
+			   (lint-format "~A makes ~A pointless in ~A~A" caller
+					(car prev-clause)
+					(car clause)
+					(truncated-list->string form)
+					(if (eq? prev-bool 'list?)
+					    (format #f "~%~NC(r5rs list? is proper-list? in s7)" (+ lint-left-margin 4) #\space)
+					    "")))
+		       (set! prev-bool (caar clause))))
+
+		 (if (and (pair? prev-clause) ; i.e. not #f
+			  (not has-combinations)
+			  (> len 2)
+			  (equal? (cdr clause) (cdr prev-clause)))
+		     (if (memq (car clause) '(else #t))        ; (cond ... (x z) (else z)) -> (cond ... (else z))
+			 (unless (side-effect? (car prev-clause) env)
+			   ;; (cond (x y) (z 32) (else 32))
+			   (lint-format "this clause could be omitted: ~A" caller (truncated-list->string prev-clause)))
+			 (set! has-combinations #t)))          ; handle these later
+		 (set! prev-clause clause)
+
+		 (let ((expr (simplify-boolean (car clause) trues falses env))
+		       (test (car clause))
+		       (sequel (cdr clause))
+		       (first-sequel (and (pair? (cdr clause)) (cadr clause))))
+		   (if (not (equal? expr test))
+		       (set! simplifications (cons (cons clause expr) simplifications)))
+
+		   (when (and (pair? falses)          ; (cond ((not x) y) ((string=? x z)...))
+			      (pair? (car falses))
+			      (eq? (caar falses) 'not)
+			      (symbol? (cadar falses))
+			      (pair? test)
+			      (memq (cadar falses) test))
+		     (and-incomplete form 'if2 (cadar falses) test env))
+
+		   (if (symbol? test)
+		       (if (and (not (eq? test 'else))
+				(pair? first-sequel))
+			   (if (memq test first-sequel)
+			       (and-incomplete form 'cond test first-sequel env)
+			       (do ((p first-sequel (cdr p)))
+				   ((or (not (pair? p))
+					(and (pair? (car p))
+					     (memq test (car p))))
+				    (if (pair? p)
+					(and-incomplete form 'cond test (car p) env))))))
+		       (when (and (len>1? test)
+				  (pair? first-sequel)
+				  (hash-table-ref bools (car test)))
+			 (if (member (cadr test) first-sequel)
+			     (and-forgetful form 'cond test first-sequel env)
+			     (do ((p first-sequel (cdr p)))
+				 ((or (not (pair? p))
+				      (and (pair? (car p))
+					   (member (cadr test) (car p))))
+				  (if (pair? p)
+				      (and-forgetful form 'cond test (car p) env)))))))
+		   ;; code here to check every arg against its use in the sequel found no problems?!?
+
+		   (if (and (len>1? sequel)
+			    (memq '=> (cdr sequel)))
+		       (lint-format "'=> has no effect here: ~A~%" caller (truncated-list->string clause)))
+		   ;; args>1 never happens so no need for mismatch check
+
+		   (cond ((memq test '(else #t))
+			  (set! has-else #t)
+
+			  (when (pair? sequel)
+			    (if (eq? first-sequel #<unspecified>)    ; (cond ((= x y) z) (else #<unspecified>)
+				(lint-format "this #<unspecified> is redundant: ~A" caller clause))
+
+			    (when (and (pair? first-sequel)   ; (cond (a A) (else (cond ...))) -> (cond (a A) ...)
+				       (memq (car first-sequel) '(if cond when unless)))
+
+			      (if (null? (cdr sequel))
+				  (case (car first-sequel)
+				    ((cond)
+				     ;; (cond ((< x 1) 2) (else (cond ((< y 3) 2) (#t 4))))
+				     (lint-format "else clause could be folded into the outer cond: ~A" caller
+						  (lists->string form (append (copy form (make-list ctr))
+									      (cdr first-sequel)))))
+				    ((if)
+				     ;; (cond (a A) (else (if b B)))
+				     (when (and (len>1? (cdr first-sequel))
+						(proper-list? first-sequel))
+				       (lint-format "else clause could be folded into the outer cond: ~A" caller
+						    (lists->string form
+								   (append (copy form (make-list ctr))
+									   (if (= (length first-sequel) 3)
+									       (list (cdr first-sequel))
+									       `((,(cadr first-sequel) ,@(unbegin (caddr first-sequel)))
+										 (else ,@(unbegin (cadddr first-sequel))))))))))
+				    ((when unless)
+				     ;; (cond (a A) (else (when b B)))
+				     (when (> (length first-sequel) 2)
+				       (lint-format "else clause could be folded into the outer cond: ~A" caller
+						    (lists->string form
+								   (append (copy form (make-list ctr))
+									   (if (eq? (car first-sequel) 'when)
+									       `((,(cadr first-sequel) ,@(cddr first-sequel)))
+									       `(((not ,(cadr first-sequel)) ,@(cddr first-sequel))))))))))
+
+				  ;; combine else -> cond if the trailing result is very simple (it will be repeated)
+				  (when (and (pair? (cdr sequel))
+					     (null? (cddr sequel))
+					     (< (lint-tree-leaves (cadr sequel)) 7))
+				    (let ((result (cadr sequel)))
+				      (case (car first-sequel)
+					((cond)
+					 ;; (cond (A a) (B b) (else (cond (C c) (D d)) #t)) -> (cond (A a) (B b) (C c #t) (D d #t) (else #t))
+					 (lint-format "else clause could be folded into the outer cond: ~A" caller
+						      (lists->string form (append (copy form (make-list ctr))
+										  (map (lambda (c)
+											 (append c (list result)))
+										       (cdr first-sequel))
+										  (if (memq (car (last-ref first-sequel)) '(else #t))
+										      ()
+										      (list (list 'else result)))))))
+					((if)
+					 ;; (cond (A a) (B b) (else (if C c d) #t)) -> (cond (A a) (B b) (C c #t) (else d #t)
+					 (when (and (len>1? (cdr first-sequel))
+						    (proper-list? first-sequel))
+					   (lint-format "else clause could be folded into the outer cond: ~A" caller
+							(lists->string form
+								       (append (copy form (make-list ctr))
+									       (if (= (length first-sequel) 3)
+										   `((,@(cdr first-sequel) ,result)
+										     (else ,result))
+										   `((,(cadr first-sequel) ,@(unbegin (caddr first-sequel)) ,result)
+										     (else ,@(unbegin (cadddr first-sequel)) ,result))))))))
+					((when unless)
+					 ;; (cond (A a) (B b) (else (unless C c d) #t)) -> (cond (A a) (B b) ((not C) c d #t) (else #t))
+					 (when (> (length first-sequel) 2)
+					   (lint-format "else clause could be folded into the outer cond: ~A" caller
+							(lists->string form
+								       (append (copy form (make-list ctr))
+									       (if (eq? (car first-sequel) 'when)
+										   `((,(cadr first-sequel) ,@(cddr first-sequel) ,result)
+										     (else ,result))
+										   `(((not ,(cadr first-sequel)) ,@(cddr first-sequel) ,result)
+										     (else ,result)))))))))))))))
+			 ((not (= ctr len)))
+
+			 ((equal? test ''else)
+			  ;; (cond (x y) ('else z))
+			  (lint-format "odd cond clause test: is 'else supposed to be else? ~A" caller
+				       (truncated-list->string clause)))
+
+			 ((and (eq? test 't)
+			       (not (var-member 't env)))
+			  ;; (cond ((= x 1) 1) (t 2)
+			  (lint-format "odd cond clause test: is t supposed to be #t? ~A" caller
+				       (truncated-list->string clause))))
+
+		   (if (never-false expr)
+		       (if (not (= ctr len))
+			   ;; (cond ((getenv s) x) ((= y z) w))
+			   (lint-format "cond test ~A is never false: ~A" caller (car clause) (truncated-list->string form))
+			   (if (not (or (memq expr '(#t else))
+					(side-effect? test env)))
+			       (lint-format "cond last test could be #t: ~A" caller form)))
+		       (if (never-true expr)
+			   ;; (cond ((< 3 1) 2))
+			   (lint-format "cond test ~A is never true: ~A" caller (car clause) (truncated-list->string form))))
+
+		   (unless (side-effect? test env)
+		     (cond ((or (memq test '(else #t))
+				(not (pair? sequel))
+				(pair? (cdr sequel))))
+
+			   ((equal? test first-sequel)
+			    ;; (cond ((= x 0) x) ((= x 1) (= x 1)))
+			    (lint-format "no need to repeat the test: ~A" caller (lists->string clause (list test))))
+
+			   ((and (len=2? first-sequel)
+				 (equal? test (cadr first-sequel)))
+			    (if (eq? (car first-sequel) 'not)
+				;; (cond ((> x 2) (not (> x 2))))
+				(lint-format "perhaps replace ~A with #f" caller first-sequel)
+				;; (cond (x (abs x)))
+				(lint-format "perhaps use => here: ~A" caller
+					     (lists->string clause (list test '=> (car first-sequel))))))
+
+			   ((and (eq? first-sequel #t)
+				 (pair? test)
+				 (not (memq (car test) '(or and)))
+				 (eq? (return-type (car test) env) 'boolean?))
+			    ;; (cond ((null? x) #t) (else y))
+			    (lint-format "this #t could be omitted: ~A" caller (truncated-list->string clause))))
+
+		     (if (member test exprs)
+			 ;; (cond ((< x 2) 3) ((> x 0) 4) ((< x 2) 5))
+			 (lint-format "cond test repeated: ~A" caller (truncated-list->string clause))
+			 (set! exprs (cons test exprs))))
+
+		   (if (boolean? expr)
+		       (if (not expr)
+			   ;; (cond ((< 3 1) 2))
+			   (lint-format "cond test is always false: ~A" caller (truncated-list->string clause))
+			   (if (not (= ctr len))
+			       ;; (cond (#t 2) (x 3))
+			       (lint-format "cond #t clause is not the last: ~A" caller (truncated-list->string form))))
+		       (if (eq? test 'else)
+			   (if (not (= ctr len))
+			       ;; (cond (else 2) (x 3))
+			       (lint-format "cond else clause is not the last: ~A" caller (truncated-list->string form)))
+			   (lint-walk caller test env)))
+
+		   (if (and (symbol? expr)
+			    (not (var-member expr env))
+			    (procedure? (symbol->value expr *e*)))
+		       ;; (cond (< x 1) (else 1))
+		       (lint-format "strange cond test: ~A in ~A is a procedure" caller expr clause))
+
+		   (if (eq? result :unset)
+		       (set! result sequel)
+		       (if (not (equal? result sequel))
+			   (set! result :unequal)))
+
+		   (check-results caller 'cond clause sequel env)
+
+		   (if (side-effect? expr env)
+		       (begin
+			 (set! falses ())
+			 (set! trues ())
+			 (set! result :unequal))
+		       (begin
+			 (if (not (member expr falses))
+			     (set! falses (cons expr falses)))
+			 (when (len>1? expr)
+			   (if (and (eq? (car expr) 'not)
+				    (not (member (cadr expr) trues)))
+			       (set! trues (cons (cadr expr) trues)))
+			   (if (eq? (car expr) 'or)
+			       (for-each (lambda (p)
+					   (if (not (member p falses))
+					       (set! falses (cons p falses))))
+					 (cdr expr))))))))
+	       (cdr form)) ; for-each clause
+
+	      (if has-else
+		  (if (pair? result) ; all result clauses are the same (and not implicit)
+		      ;; (cond (x #t) (else #t)) -> #t
+		      (lint-format "perhaps ~A" caller (lists->string form
+								      (if (null? (cdr result))
+									  (car result)
+									  (cons 'begin result)))))
+		  (let* ((last-clause (and (> len 1)
+					   (list-ref form len)))
+			 (last-res (let ((clen (length last-clause)))
+				     (and (integer? clen)
+					  (> clen 1)
+					  (list-ref last-clause (- clen 1))))))
+		    (if (and (pair? last-res)
+			     (memq (car last-res) '(#t else)))
+			;; (cond (x y) (y z (else 3)))
+			(lint-format "perhaps cond else clause is misplaced: ~A in ~A" caller last-res last-clause))))
+
+	      (values has-else has-combinations simplifications all-eqv eqv-select eqv-change)))
+
+
+	  ;; -------- cond-walker --------
+
+	  (define (cond-walker-1 caller form len suggest env has-else has-combinations simplifications all-eqv eqv-select eqv-change)
+
+	    (when (and (= len 2)
+		       (not (check-bool-cond caller form (cadr form) (caddr form) env)))
+	      (cond-remove-not caller form env))
+	    ;; not+repeat got 1 hit
+
+	    (when has-combinations
+	      (cond->or caller form all-eqv eqv-select simplifications env)
+	      (set! simplifications ())
+	      (set! all-eqv #f))
+
+	    ;; cond -> case
+	    (if all-eqv
+		(if (> len (if has-else 2 1)) ; (cond (x y)) -- kinda dumb, but (if x y) isn't much shorter
+		    ;; (cond ((= x 0) x) ((= x 1) (= x 1))) -> (case x ((0) x) ((1) (= x 1)))
+		    (lint-format "perhaps use case instead of cond: ~A" caller
+				 (lists->string form (cond->case eqv-select (cdr form)))))
+
+		(when (and eqv-select
+			   (> len 1))
+		  (if (= len eqv-change)
+		      ;; (cond ((= x 0) 0) ((not (= x 1)) 1)) -> (case x ((0) 0) ((1) #<unspecified>) (else 1))
+		      (if (not (equal? (car (list-ref form (- len 1))) (cadar (list-ref form len))))
+			  (let ((new-cond (make-list (+ len 2))))
+			    (copy form new-cond 0 eqv-change)
+			    (list-set! new-cond len
+				       (list (cadar (list-ref form len)) #<unspecified>))
+			    (list-set! new-cond (+ len 1)
+				       (list 'else (cadr (list-ref form len))))
+			    (lint-format "perhaps use case instead of cond: ~A" caller
+					 (lists->string form
+							(cond->case eqv-select (cdr new-cond))))))
+		      (if (= len (+ eqv-change 1))
+			  ;; (cond ((= x 0) 0) ((not (= x 1)) 1) (else 2)) -> (case x ((0) 0) ((1) 2) (else 1))
+			  (let ((new-cond (make-list (+ len 1)))
+				(last-clause (list-ref form len))
+				(next-to-last-clause (list-ref form (- len 1))))
+			    (copy form new-cond 0 eqv-change)
+			    (list-set! new-cond (- len 1)
+				       (list (cadar next-to-last-clause)
+					     (if (memq (car last-clause) '(#t else))
+						 (cadr last-clause)
+						 (if (or (equal? (cadar next-to-last-clause) (car last-clause)) ; ((not (= x 1))...) ((= x 1)...)
+							 (and (eq? (caar last-clause) 'not)
+							      (not (member (cadar last-clause) new-cond))))     ; ((not (= x 1))...) ((not (= x 2))...)
+						     (cadr (list-ref form len))))))
+			    ;; (cond ((= x 0) 0) ((not (= x 1)) 1) ((= x 2) 2)) -> (case x ((0) 0) ((1) #<unspecified>) (else 1))
+			    ;; (cond ((= x 0) 0) ((not (= x 1)) 1) ((= x 1) 2)) -> (case x ((0) 0) ((1) 2) (else 1))
+			    ;; (cond ((= x 1) 1) ((not (= x 2)) 2) ((not (= x 3)) 3)) -> (case x ((1) 1) ((2) 3) (else 2))
+			    (list-set! new-cond len
+				       (list 'else (cadr (list-ref form (- len 1)))))
+			    (lint-format "perhaps use case instead of cond: ~A" caller
+					 (lists->string form
+							(cond->case eqv-select (cdr new-cond)))))))))
+	    (if (and (= len 2)
+		     has-else
+		     (null? (cdadr form)))
+		(let ((else-clause (if (null? (cdaddr form))
+				       'else
+				       (if (null? (cddr (caddr form)))
+					   (cadr (caddr form))
+					   (cons 'begin (cdaddr form))))))
+		  ;; (cond ((a)) (else A)) -> (or (a) A)
+		  ;;    but these two are not currently rewritten using if: (cond (A B) (else)) (cond (A B) (else C))
+		  (lint-format "perhaps ~A" caller (lists->string form `(or ,(caadr form) ,else-clause)))))
+
+	    (unless (or has-combinations all-eqv)
+	      (cond->assoc caller form simplifications))
+
+	    (when (and (> len 3)
+		       (= suggest made-suggestion))
+	      (cond->case-at-end caller form len has-else))
+
+	    (combine-repeated-tests caller form env)
+	    (if (= len 1)
+		(simple-cond->if caller form suggest)
+		(when has-else                                   ; len > 1 here
+		  (let ((last-clause (list-ref form (- len 1)))) ; not the else branch! -- just before it.
+
+		    (when (and (= suggest made-suggestion) ; look for all results the same
+			       (len>1? (cadr form)))
+		      (cond-one-result caller form last-clause len env))
+
+		    (when (= len 3)
+		      (simplify-cond caller form env))
+
+		    (when (> len 3)
+		      (cond-repeated-else caller form len env))
+
+ 		    (cond-partial-test-repeat caller form)
+		    (cond-combine-into-else caller form last-clause len))))
+
+	      (combine-conds caller form has-else len env))
+
+	  (define (cond-walker caller form env)
+	    (let ((len (- (length form) 1))
+		  (suggest made-suggestion))
+	      (if (or (< len 1)
+		      (not (just-pairs? (cdr form))))
+		  (lint-format "cond is messed up: ~A" caller (truncated-list->string form))
+		  (begin
+		    (cond->header+cond+trailer caller form len env) ; obviously out-of-place...
+		    (cond-walker-1 caller form len suggest env (cond-scan-clauses caller form len env))))
+	      env))
+
+	  (hash-walker 'cond cond-walker))
+
+
+	;; ---------------- case ----------------
+	(let ()
+
+	  ;; -------- case->header+case+trailer --------
+	  (define (case->header+case+trailer caller form len env)
+	    ;; if start/end args match (including func), move outside case (case sets whatever differs, using values if necessary)
+	    (let ((first-clause (caddr form))
+		  (else-clause (list-ref form (+ len 1))))
+	      (when (and (len=1? (cdr first-clause))
+			 (pair? (cadr first-clause))
+			 (len>1? else-clause)
+			 (eq? (car else-clause) 'else)
+			 (pair? (cadr else-clause))
+			 (or (equal? (caadr first-clause) (caadr else-clause)) ; there's some hope we'll match
+			     (escape? (cadr else-clause) env)))
+		(let ((first-result (cadr first-clause))
+		      (first-func (caadr first-clause))
+		      (else-error (escape? (cadr else-clause) env)))
+		  (when (and (pair? (cdr first-result))
+			     (not (eq? first-func 'values))
+			     (or (not (hash-table-ref syntaces first-func))
+				 (eq? first-func 'set!))
+			     (lint-every? (lambda (c)
+					    (and (len=2? c)
+						 (len>1? (cadr c))
+						 (or (equal? first-func (caadr c))
+						     (and (eq? c else-clause)
+							  else-error))))
+					  (cdddr form)))
+
+		    ((lambda (header-len trailer-len result-mid-len)
+		       (when (and (>= header-len 0)
+				  (>= trailer-len 0)
+				  (or (not (eq? first-func 'set!))
+				      (> header-len 1))
+				  (or (not (eq? first-func '/))
+				      (> header-len 1)
+				      (> trailer-len 0)))
+			 (let ((header (copy first-result (make-list header-len)))
+			       (trailer (copy first-result (make-list trailer-len) (- (length first-result) trailer-len))))
+			   (if (= len 2)
+			       (unless (equal? first-result (cadr else-clause)) ; handled elsewhere (all results equal -> result)
+				 ;; (case x ((1) (+ x 1)) (else (+ x 3))) -> (+ x (if (eqv? x 1) 1 3))
+				 (lint-format "perhaps ~A" caller
+					      (let ((else-result (cadr else-clause)))
+						(let ((first-mid-len (- (length first-result) header-len trailer-len))
+						      (else-mid-len (- (length else-result) header-len trailer-len)))
+						  (let* ((fmid (if (= first-mid-len 1)
+								   (list-ref first-result header-len)
+								   (cons 'values (copy first-result (make-list first-mid-len) header-len))))
+							 (emid (if else-error
+								   else-result
+								   (if (= else-mid-len 1)
+								       (list-ref else-result header-len)
+								       (cons 'values (copy else-result (make-list else-mid-len) header-len)))))
+							 (middle (if (len=1? (car first-clause))
+								     (list 'eqv? (cadr form) (caar first-clause))
+								     `(memv ,(cadr form) ',(car first-clause)))))
+						    (lists->string form (append header (cons (list 'if middle fmid emid) trailer))))))))
+			       ;; len > 2 so use case in the revision
+			       (let ((midctr 0)
+				     (valctr 0))
+				 (let ((middle
+					(map (lambda (c)
+					       (if (and else-error
+							(eq? c else-clause))
+						   else-clause
+						   (let ((test (car c))
+							 (result (cadr c)))
+						     (let ((mid-len (- (length result) header-len trailer-len)))
+						       (if (= mid-len 1)
+							   (set! midctr (+ midctr 1))
+							   (set! valctr (+ valctr 1)))
+						       (list test (if (= mid-len 1)
+								      (list-ref result header-len)
+								      (cons 'values (copy result (make-list mid-len) header-len))))))))
+					     (cddr form))))
+				   ;; (case x ((0) (log x 2)) ((1) (log x 3)) (else (error 'oops))) -> (log x (case x ((0) 2) ((1) 3) (else (error 'oops))))
+				   (if (> midctr valctr)
+				       (lint-format "perhaps ~A" caller
+						    (lists->string form `(,@header (case ,(cadr form) ,@middle) ,@trailer))))))))))
+		     (partition-form (cddr form) (if else-error (- len 1) len))))))))
+
+	  ;; -------- simplify-case --------
+	  (define (simplify-case caller form selector env)
+	    ;; case->simpler expr (eq? memq etc)
+	    (let ((clauses (cddr form)))            ; (case x ((a) #t) (else #f)) -> (eq? x 'a) -- this stuff actually happens!
+	      (if (null? (cdr clauses))
+		  (let ((clause (car clauses)))
+		    (when (and (len>1? clause)
+			       (pair? (car clause)))
+		      (let ((keys (car clause)))
+			;; (case 3 ((0) #t)) -> (if (eqv? 3 0) #t)
+			;; (case x ((#(0)) 2)) -> (if (eqv? x #(0)) 2)
+			(lint-format "perhaps ~A" caller
+				     (lists->string form
+						    (let ((test (cond ((pair? (cdr keys))
+								       `(memv ,(cadr form) ',keys))
+
+								      ((and (symbol? (car keys))
+									    (not (keyword? (car keys))))
+								       `(eq? ,(cadr form) ',(car keys)))
+
+								      ((or (keyword? (car keys))
+									   (null? (car keys)))
+								       (list 'eq? (cadr form) (car keys)))
+
+								      ((not (boolean? (car keys)))
+								       (list 'eqv? (cadr form) (car keys)))
+
+								      ((car keys)
+								       (cadr form))
+
+								      (else (list 'not (cadr form)))))
+
+							  (op (if (len>1? (cdr clause))
+								  'when 'if)))
+						      (cons op (cons test (cdr clause)))))))))
+		  (when (and (null? (cddr clauses))
+			     (len=2? (car clauses))
+			     (len=2? (cadr clauses))
+			     (eq? (caadr clauses) 'else)
+			     (not (equal? (cadadr clauses) (cadar clauses)))
+			     (pair? (caar clauses)))
+		    (let* ((akey (null? (cdaar clauses)))
+			   (keylist ((if akey caaar caar) clauses))
+			   (quoted (or (not akey) (symbol? keylist)))
+			   (op (if (just-symbols? (caar clauses))
+				   (if akey 'eq? 'memq)
+				   (if akey 'eqv? 'memv))))
+		      ;; can't use '= or 'char=? here because the selector may return anything
+		      ;; (case x ((#\a) 3) (else 4)) -> (if (eqv? x #\a) 3 4)
+		      ;; (case x ((a) #t) (else #f)) -> (eq? x 'a)
+		      (lint-format "perhaps ~A" caller
+				   (lists->string form
+						  (cond ((and (boolean? (cadar clauses))
+							      (boolean? (cadadr clauses)))
+							 (if (cadadr clauses)
+							     (list 'not (list op selector (if quoted (list #_quote keylist) keylist)))
+							     (list op selector (if quoted (list #_quote keylist) keylist))))
+
+							((not (cadadr clauses)) ; (else #f) happens a few times
+							 (simplify-boolean
+							  (if quoted
+							      `(and (,op ,selector ',keylist) ,(cadar clauses))
+							      `(and (,op ,selector ,keylist) ,(cadar clauses)))
+							  () () env))
+
+							(quoted
+							 `(if (,op ,selector ',keylist) ,(cadar clauses) ,(cadadr clauses)))
+
+							(else
+							 (let ((select-expr (if (and (eq? op 'eqv?)
+										     (boolean? keylist)
+										     (or (and (symbol? selector)
+											      (not keylist))
+											 (and (pair? selector)
+											      (symbol? (car selector))
+											      (let ((sig (arg-signature (car selector) env)))
+												(and (pair? sig)
+												     (eq? (car sig) 'boolean?))))))
+										(if keylist selector (list 'not selector))
+										(list op selector keylist))))
+							   (list 'if select-expr (cadar clauses) (cadadr clauses))))))))))))
+
+	  ;; -------- check-keys --------
+	  (define (check-keys caller form selector sel-type env)
+	    ;; combine repeated results, check for repeated or unmatchable keys
+	    (let ((all-keys ())
+		  (result :unset)
+		  (exprs-repeated #f)
+		  (else-foldable #f)
+		  (has-else #f))
+	      (let ((all-exprs ())
+		    (ctr 0)
+		    (len (length (cddr form))))
+		(for-each
+		 (lambda (clause)
+		   (set! ctr (+ ctr 1))
+		   (let ((keys (car clause))
+			 (exprs (cdr clause)))
+		     ;; exprs can be null (4-Jan-17)
+		     (if (eq? result :unset)
+			 (set! result exprs)
+			 (if (not (equal? result exprs))
+			     (set! result :unequal)))
+
+		     (if (and (len>1? exprs)           ; this gets no hits -- it paralells a similar bug in cond: (test expr => expr)
+			      (memq '=> (cdr exprs)))
+			 (lint-format "'=> has no effect here: ~A~%" caller (truncated-list->string clause)))
+
+		     (if (member exprs all-exprs)
+			 (set! exprs-repeated exprs)
+			 (set! all-exprs (cons exprs all-exprs)))
+
+		     (when (len=1? exprs)
+		       (if (or (equal? (car exprs) (cadr form))       ; (case x ((0 1) x) (else #f))
+			       (and (pair? keys)
+				    (null? (cdr keys))
+				    (code-constant? (car exprs))
+				    (eqv? (car keys) (car exprs))))
+			   (lint-format "in ~A, the result can be ~Aomitted" caller
+					clause
+					(if (and (pair? (car exprs))  ; all this paranoia for one hit
+						 (equal? (car exprs) (cadr form))
+						 (side-effect? (car exprs) env))
+					    "probably " "")))
+
+		       (when (and (len=2? (car exprs))
+				  (equal? selector (cadar exprs)))
+			 (if (and (pair? keys)                        ; (case x ((0) (f x)) ((1) (not x)))
+				  (eq? (caar exprs) 'not)
+				  (not (memq #f keys)))
+			     (lint-format "in ~A, perhaps replace ~A with #f" caller clause (car exprs))
+			     (if (eq? keys 'else)
+				 (lint-format "perhaps use => here: ~A" caller
+					      (lists->string clause (list 'else '=> (caar exprs))))))))
+
+		     (if (pair? keys)
+			 (if (not (proper-list? keys))
+			     ;; (case x ((0) 1) ((1) 2) ((3 . 0) 4))
+			     (lint-format (if (null? keys)
+					      "null case key list: ~A"
+					      "stray dot in case case key list: ~A")
+					  caller (truncated-list->string clause))
+			     (for-each
+			      (lambda (key)
+				;; TODO: (or type1...) -> memq (type-of..)..
+				(if (and (number? key)
+					 (nan? key))
+				    (lint-format "case key ~S in ~S is unlikely to work" caller key clause)
+				    (if (or (and (sequence? key)
+						 (not (null? key)))
+					    (memq (type-of key) '(procedure? macro? iterator? c-object? c-pointer? input-port? output-port? random-state?)))
+					;; (case x ((#(0)) 2)) or (apply case ...)
+					(lint-format "case key ~S in ~S is unlikely to work (case uses eqv? but ~S is a ~A)" caller
+						     key clause key
+						     (type-of key))))
+				(if (memv key all-keys)
+				    ;; (case x ((0) 1) ((1) 2) ((3 0) 4)) but not (case x ((0 0.0))...)
+				    (lint-format "repeated case key ~S in ~S" caller key clause)
+				    (set! all-keys (cons key all-keys)))
+				;; unintentional quote here, as in (case x ('a b)...) never happens and
+				;;   is hard to distinguish from (case x ((quote a) b)...) which happens a lot
+
+				(if (not (compatible? sel-type (if (symbol? key) 'symbol? (->lint-type key))))
+				    ;; (case (string->symbol x) ((a) 1) ((2 3) 3))
+				    (lint-format "case key ~S in ~S is pointless" caller key clause)))
+			      keys))
+
+			 (if (not (eq? keys 'else))
+			     ;; (case ((1) 1) (t 2))
+			     (lint-format "bad case key ~S in ~S" caller keys clause)
+			     (begin
+			       (set! has-else clause)
+			       ;; exprs: (res) or if case, ((case ...)...)
+			       (if (not (= ctr len))
+				   ;; (case x (else 2) ((0) 1))
+				   (lint-format "case else clause is not the last: ~A"
+						caller
+						(truncated-list->string (cddr form)))
+				   (when (and (len=1? exprs)
+					      (len>1? (car exprs)))
+				     (let ((expr (car exprs)))
+				       (case (car expr)
+					 ((case)                     ; just the case statement in the else clause
+					  (when (and (equal? selector (cadr expr))
+						     (not (side-effect? selector env)))
+					    (set! else-foldable (cddr expr))))
+					 ((if)                       ; just if -- if foldable, make it look like it came from case
+					  (when (and (equal? selector (eqv-selector (cadr expr)))
+						     (cond-eqv? (cadr expr) selector #t)
+						     (not (side-effect? selector env)))
+					    ;; else-foldable as (((keys-from-test) true-branch) (else false-branch))
+					    (set! else-foldable
+						  (if (pair? (cdddr expr))
+						      (list (case-branch (cadr expr) selector (list (caddr expr)))
+							    (list 'else (cadddr expr)))
+						      (list (case-branch (cadr expr) selector (cddr expr))))))))))))))
+
+		     (check-results caller (car form) clause exprs env))) ; walk the result exprs
+		 (cddr form)))
+
+	      (let ((key-phrase
+		     (let ((keylen (length all-keys)))
+		       (cond ((< keylen 20))
+			     ((lint-every? char? all-keys)
+			      "vector (indexed by char->integer)")
+			     ((lint-every? (lambda (k) (and (integer? k) (<= 0 k 1000))) all-keys)
+			      "vector")
+			     ((> keylen 40)
+			      "hash-table")))))
+		(when (string? key-phrase)
+		  (lint-format "perhaps use a ~A rather than a case statement:~%~NC~A" caller
+			       key-phrase
+			       (+ lint-left-margin 4) #\space
+			       (truncated-list->string form))))
+
+	      (when (and has-else
+			 (pair? result)
+			 (not else-foldable))
+		;; (case x (else (case x (else 1)))) -> 1
+		(lint-format "perhaps ~A" caller (lists->string form
+								(if (null? (cdr result))
+								    (car result)
+								    (cons 'begin result))))
+		(set! exprs-repeated #f))
+	      ;; repeated result (but not all completely equal) and with else never happens
+
+	      (when (or exprs-repeated else-foldable)
+		(let ((new-keys-and-exprs ())
+		      (mergers ())
+		      (else-clause (if else-foldable
+				       (call-with-exit
+					(lambda (return)
+					  (for-each (lambda (c) (if (eq? (car c) 'else) (return c))) else-foldable)
+					  ()))
+				       (or has-else ()))))
+
+		  (let ((merge-case-keys
+			 (let ((else-exprs (and (pair? else-clause) (cdr else-clause)))
+			       (a-few (lambda (lst)
+					(if (> (length lst) 3)
+					    (copy lst (make-list 4 '...) 0 3)
+					    lst))))
+			   (lambda (clause)
+			     (when (len>1? clause)             ; ignore clauses that are messed up
+			       (let ((keys (car clause))
+				     (exprs (cdr clause)))
+				 (unless (or (not (pair? keys)) ; else clause or buggy case key list
+					     (equal? exprs else-exprs))
+				   (let ((prev (member exprs new-keys-and-exprs (lambda (a b) (equal? a (cdr b))))))
+				     (if prev
+					 (let* ((cur-clause (car prev))
+						(cur-keys (car cur-clause)))
+					   (when (pair? cur-keys)
+					     (set! mergers (cons (list (a-few keys) (a-few cur-keys)) mergers))
+					     (set-car! cur-clause
+						       (append cur-keys
+							       (map (lambda (key)
+								      (if (memv key cur-keys) (values) key))
+								    keys)))))
+					 (set! new-keys-and-exprs (cons (cons (copy (car clause))
+									      (cdr clause))
+									new-keys-and-exprs)))))))))))
+
+		    (for-each merge-case-keys (cddr form))
+		    (if (pair? else-foldable)
+			(for-each merge-case-keys else-foldable)))
+
+		  (if (null? new-keys-and-exprs)
+		      (lint-format "perhaps ~A" caller
+				   ;; (case x (else (case x (else 1)))) -> 1
+				   (lists->string form
+						  (if (or (null? else-clause)    ; this can happen...
+							  (null? (cdr else-clause)))
+						      ()
+						      (if (null? (cddr else-clause))
+							  (cadr else-clause)
+							  (cons 'begin (cdr else-clause))))))
+		      (begin
+			;; (null? (cdr new-keys-and-exprs)) is rare and kinda dumb -- cases look like test suite entries
+			(for-each
+			 (lambda (clause)
+			   (if (len>1? (car clause))
+			       (if (just-integers? (car clause))
+				   (set-car! clause (sort! (car clause) <))
+				   (if (lint-every? char? (car clause))
+				       (set-car! clause (sort! (car clause) char<?))))))
+			 new-keys-and-exprs)
+			(let ((new-form (if (pair? else-clause)
+					    `(case ,(cadr form) ,@(reverse new-keys-and-exprs) ,else-clause)
+					    `(case ,(cadr form) ,@(reverse new-keys-and-exprs)))))
+			  ;; (case x ((0) 32) ((1) 32)) -> (case x ((0 1) 32))
+			  (lint-format "perhaps ~A" caller
+				       (if (pair? mergers)
+					   (format #f "merge keys ~{~{~A with ~A~}~^, ~}: ~A"
+						   (reverse mergers)
+						   (lists->string form new-form))
+					   (lists->string form new-form))))))))))
+
+	  ;; -------- case->symbol->value --------
+	  (define (case->symbol->value caller form) ; (case x ((abs) abs) ((expt) expt)...) -> (symbol->value x)
+	    (do ((selector (cadr form))
+		 (svs ())
+		 (others #f)
+		 (p (cddr form) (cdr p)))
+		((null? p)
+		 (when (pair? svs)
+		   (let-temporarily ((made-suggestion 0))
+		     (set! svs (reverse svs))
+		     (lint-format "perhaps use => here: ~A" caller
+				  (lists->string form
+						 `(case ,selector
+						    ,@(if (memv (car (caaddr form)) (cdar svs)) () '(...))
+						    ,@(map (lambda (sv)
+							     (list (reverse (cdr sv)) '=> (case (car sv)
+											    ((list-values #_list-values) 'list)
+											    (else))))
+							   svs)
+						    ,@(if others '(...) ())))))))
+	      (let ((c (car p)))
+		(cond ((not (and (len=2? c)
+				 (pair? (car c))))
+		       (set! others #t))
+
+		      ((and (null? (cdar c))                 ; ((a) a)
+			    (symbol? (caar c))
+			    (eq? (caar c) (cadr c)))         ; the quoted case happens only in test suites
+		       (cond ((assq 'symbol->value svs)
+			      => (lambda (sv-data)
+				   (set-cdr! sv-data (cons (caar c) (cdr sv-data)))))
+			     (else (set! svs (cons (list 'symbol->value (caar c)) svs)))))
+
+		      ((and (just-symbols? (car c))         ; ((a b c) (eval selector))
+			    (len=2? (cadr c))
+			    (memq (caadr c) '(eval symbol->value))
+			    (equal? (cadadr c) selector))
+		       (cond ((assq 'symbol->value svs)
+			      => (lambda (sv-data)
+				   (set-cdr! sv-data (append (reverse (car c)) (cdr sv-data)))))
+			     (else (set! svs (cons (cons 'symbol->value (reverse (car c))) svs)))))
+
+		      ((and (null? (cdar c))                 ; ((a) (f a))
+			    (len=2? (cadr c))
+			    (eqv? (caar c) (cadadr c))
+			    (not (memq (caadr c) '(quote #_quote values))))
+		       (cond ((assq (caadr c) svs)
+			      => (lambda (func-data)
+				   (set-cdr! func-data (cons (caar c) (cdr func-data)))))
+			     (else (set! svs (cons (list (caadr c) (caar c)) svs)))))
+
+		      ((not (and (len=2? (cadr c))
+				 (equal? (cadadr c) selector)))
+		       (set! others #t))
+
+		      ((assq (caadr c) svs)
+		       => (lambda (func-data)  ; ((1 b #f) (func selector))
+			    (set-cdr! func-data (append (reverse (car c)) (cdr func-data)))))
+
+		      (else
+		       (set! svs (cons (cons (caadr c) (reverse (car c))) svs)))))))
+
+
+	  ;; -------- case-walker --------
+	  (define case-walker
+	    (let ((selector-types '(#t symbol? char? boolean? integer? rational? real? complex? number? null? eof-object?)))
+
+	      (define (case->case+args caller form len)
+		;; if all args match, move outside case (case sets func)
+		(let ((first-clause (caddr form))
+		      (else-clause (list-ref form (+ len 1))))
+		  (when (and (eq? (car else-clause) 'else)
+			     (len=1? (cdr first-clause))
+			     (len>1? (cadr first-clause))
+			     (not (hash-table-ref syntaces (caadr first-clause)))
+			     (lint-every? (lambda (c)
+					    (and (len=2? c)
+						 (pair? (cadr c))
+						 (not (hash-table-ref syntaces (caadr c)))
+						 (equal? (cdadr first-clause) (cdadr c))))
+					  (cdddr form)))
+		    ;; (case x ((a) (f y z)) (else (g y z))) -> ((if (eq? x 'a) f g) y z)
+		    (lint-format "perhaps ~A" caller      ; all results share trailing args
+				 (lists->string form
+						(if (and (= len 2)
+							 (symbol? (caar first-clause))
+							 (null? (cdar first-clause)))
+						    `((if (eq? ,(cadr form) ',(caar first-clause))
+							  ,(caadr first-clause)
+							  ,(caadr else-clause))
+						      ,@(cdadr first-clause))
+						    `((case ,(cadr form)
+							,@(map (lambda (c)
+								 (list (car c) (caadr c)))
+							       (cddr form)))
+						      ,@(cdadr first-clause))))))))
+
+	      (lambda (caller form env)
+		;; here the keys are not evaluated, so we might have a list like (letrec define ...)
+		;; also unlike cond, only 'else marks a default branch (not #t)
+
+		(if (or (< (length form) 3)
+			(not (just-pairs? (cddr form))))    ; (case 3)
+		    (lint-format "case is messed up: ~A" caller (truncated-list->string form))
+		    ;; perhaps also (lint-every? (lambda (c) (or (pair? c) (eq? c 'else))) (car clause)) above
+		    (let ((suggest made-suggestion))
+
+		      ;; if regular case + else, focus case on diff
+		      (let ((len (- (length form) 2))) ; number of clauses
+			(when (and (> len 1)                 ; (case x (else ...)) is handled elsewhere
+				   (len>1? (cdr form))
+				   (not (lint-tree-set-memq '(unquote list-values #_list-values) form)))
+			  (case->case+args caller form len)
+			  (case->header+case+trailer caller form len env)))
+		      (case->symbol->value caller form)
+
+		      (let ((selector (cadr form)))
+			(when (= suggest made-suggestion)
+			  (simplify-case caller form selector env))
+
+			(if (and (not (pair? selector))
+				 (constant? selector))                ; (case 3 ((0) #t))
+			    (lint-format "case selector is a constant: ~A" caller (truncated-list->string form))
+			    (if (symbol? selector)
+				(set-ref selector caller form env)
+				(lint-walk caller selector env)))
+
+			(let ((sel-type (and (pair? selector)
+					     (symbol? (car selector))
+					     (return-type (car selector) env))))
+			  (if (and (symbol? sel-type)                ; (case (list 1) ((0) #t))
+				   (not (memq sel-type selector-types)))
+			      (lint-format "case selector may not work with eqv: ~A" caller (truncated-list->string selector)))
+			  (check-keys caller form selector sel-type env))))) ; calls lint-walk-open-body on each result
+		env)))
+	  (hash-walker 'case case-walker))
+
+
+	;; ---------------- do ----------------
+	(let ()
+	  (define (car-subst sym new-sym tree)
+	    (cond ((not (unquoted-pair? tree))
+		   tree)
+		  ((not (and (symbol? (car tree))
+			     (len=1? (cdr tree))
+			     (eq? sym (cadr tree))))
+		   (cons (car-subst sym new-sym (car tree))
+			 (car-subst sym new-sym (cdr tree))))
+
+		   ((hash-table-ref cxars (car tree)) => (lambda (f) (if (symbol? f) (list f new-sym) new-sym)))
+		   (else tree)))
+
+	  (define (cadr-subst sym new-sym tree)
+	    (cond ((not (unquoted-pair? tree))
+		   tree)
+		  ((and (memq (car tree) '(vector-ref string-ref list-ref))
+			(len=3? tree)
+			(equal? sym (cadr tree)))
+		   new-sym)
+		  (else
+		   (cons (cadr-subst sym new-sym (car tree))
+			 (cadr-subst sym new-sym (cdr tree))))))
+
+	  (define (var-step v) ((cdr v) 'step))
+
+	  ;; -------- pointless-do --------
+	  (define (pointless-do caller form)
+	    ;; called only if no side-effects in form
+	    ;; a much more permissive check here (allowing sets of locals etc) got only a half-dozen hits
+	    (let ((end+result (caddr form)))
+	      (if (pair? end+result)
+		  (if (null? (cdr end+result))                ; (do ((i 0 (+ i 1))) ((= i 1)))
+		      (if (not (car end+result))
+			  (lint-format "infinite loop: ~A" caller form)
+			  (lint-format "this do-loop could probably be replaced by the end test in a let: ~A" caller (truncated-list->string form)))
+		      (if (and (null? (cddr end+result))
+			       (code-constant? (cadr end+result))) ; (begin (z 1) (do ((i 0 (+ i 1))) ((= i n) 32))): 32
+			  (lint-format "this do-loop could be replaced by ~A: ~A" caller (cadr end+result) (truncated-list->string form))))
+		  (if (and (null? end+result)          ; (do () ()) -- need more of these
+			   (null? (cadr form)))
+		      (lint-format "infinite loop: ~A" caller form)))))
+
+	  ;; -------- walk-do-inits --------
+	  (define (walk-do-inits caller form env)
+	    ;; walk the init forms before adding the step vars to env
+	    (do ((vars ())
+		 (bindings (cadr form) (cdr bindings)))
+		((not (pair? bindings))
+		 (if (not (null? bindings))
+		     (lint-format "do variable list is not a proper list? ~S" caller (cadr form)))
+		 vars)
+	      (when (binding-ok? caller 'do (car bindings) env #f)
+		(for-each (lambda (v)
+			    (if (not (or (eq? (var-initial-value v) (var-name v))
+					 (not (lint-tree-memq (var-name v) (cadar bindings)))
+					 (hash-table-ref built-in-functions (var-name v))
+					 (lint-tree-set-memq binders (cadar bindings))))
+				(if (not (var-member (var-name v) env))
+				    ;; (let ((xx 0)) (do ((x 1 (+ x 1)) (y x (- y 1))) ((= x 3) xx) (display y)): x
+				    (lint-format "~A in ~A does not appear to be defined in the calling environment" caller
+						 (var-name v) (car bindings))
+				    ;; (let ((x 0)) (do ((x 1 (+ x 1)) (y x (- y 1))) ((= x 3)) (display y))): y
+				    (lint-format "~A in ~A refers to the caller's ~A, not the do-loop variable" caller
+						 (var-name v) (car bindings) (var-name v)))))
+			  vars)
+		(lint-walk caller (cadar bindings) env)
+		(let ((new-var (let ((v (make-lint-var (caar bindings) (cadar bindings) 'do)))
+				 (let ((stepper (and (pair? (cddar bindings)) (caddar bindings))))
+				   (varlet (cdr v) :step stepper)
+				   (when stepper
+				     (set! (var-history v) (cons (list 'set! (caar bindings) stepper) (var-history v)))
+				     (set! (var-refenv v) env)))
+				 v)))
+		  (set! vars (cons new-var vars))))))
+
+	  ;; -------- walk-do-steps --------
+	  (define (walk-do-steps caller form vars inner-env env)
+	    ;; walk the step exprs
+	    (let ((baddies ()) ; these are step vars (with step exprs) used within other step vars step expressions
+		  (step-vars (cadr form)))
+	      (for-each (lambda (stepper)
+			  (when (and (binding-ok? caller 'do stepper env #t)
+				     (pair? (cddr stepper)))
+			    (let ((data (var-member (car stepper) vars)))
+			      (let ((old-ref (var-ref data)))
+				(lint-walk caller (caddr stepper) inner-env)
+				(set! (var-ref data) old-ref))
+			      (if (eq? (car stepper) (caddr stepper))
+				  (lint-format "perhaps ~A" caller (lists->string stepper (list (car stepper) (cadr stepper)))))
+			      (set! (var-set data) (+ (var-set data) 1)))
+			    (when (and (pair? (caddr stepper))
+				       (not (eq? (car stepper) (cadr stepper)))
+				       (eq? (caaddr stepper) 'cdr)
+				       (eq? (cadr stepper) (cadr (caddr stepper))))
+			      (lint-format "this looks suspicious: ~A" caller stepper))
+			    (let ((step-name (car stepper))
+				  (step-step (caddr stepper)))
+			      (for-each (lambda (v)
+					  (if (and ;(var-step v)  ; a toss-up
+						   (not (eq? (var-name v) step-name))
+						   (or (eq? (var-name v) step-step)
+						       (and (pair? step-step)
+							    (lint-tree-memq (var-name v) step-step))))
+					      (set! baddies (cons step-name baddies))))
+					vars))))
+			step-vars)
+
+	      (check-unordered-exprs caller form (map var-initial-value vars) env)
+
+	      (when (pair? baddies)
+		;; (do ((i 0 j) (j ...))...) is unreadable -- which (binding of) j is i set to?
+		;;    but this is tricky if there is more than one such variable -- if cross links, we'll need named let
+		;;    and if no step expr, there's no confusion.
+		;;    (do ((i 0 j) (j 1 i) (k 0 (+ k 1))) ((= k 4)) (format *stderr* "~A ~A~%" i j))
+		;;    (let <1> ((i 0) (j 1) (k 0)) (if (= k 4) () (begin (format *stderr* "~A ~A~%" i j) (<1> j i (+ k 1)))))
+		(let ((new-steppers (map (lambda (stepper)
+					   (if (memq (car stepper) baddies)
+					       (list (car stepper) (cadr stepper))
+					       stepper))
+					 step-vars))
+		      (new-sets (map (lambda (stepper)
+				       (if (memq (car stepper) baddies)
+					   (list 'set! (car stepper) (caddr stepper))
+					   (values)))
+				     step-vars)))
+		  (if (or (null? (cdr baddies))
+			  (let ((trails new-sets))
+			    (not (lint-any? (lambda (v)     ; for each baddy, is it used in any following lint-set!?
+					      (and (pair? (cdr trails))
+						   (set! trails (cdr trails))
+						   (lint-tree-memq v trails)))
+					    (reverse baddies)))))
+		      (lint-format "perhaps ~A" caller
+				   (lists->string form
+						  `(do ,new-steppers
+						       ,(caddr form)
+						     ,@(cdddr form)
+						     ,@new-sets)))
+		      ;; (do ((i 0 (+ i j)) (j 0 (+ k 1)) (k 1)) ((= i 10)) (display (+ i j k))) ->
+		      ;;    (do ((i 0) (j 0 (+ k 1)) (k 1)) ((= i 10)) (display (+ i j k)) (set! i (+ i j)))
+		      (let* ((loop (find-unique-name form))
+			     (new-body (let ((let-loop (cons loop (map (lambda (s)
+									 ((if (pair? (cddr s)) caddr car) s))
+								       step-vars))))
+					 (if (pair? (cdddr form))
+					     `(begin ,@(cdddr form) ,let-loop)
+					     let-loop))))
+			(let ((test (if (pair? (caddr form))
+					(caaddr form)
+					()))
+			      (result (if (not (len>1? (caddr form)))
+					  ()
+					  (if (null? (cdr (cdaddr form)))
+					      (car (cdaddr form))
+					      (cons 'begin (cdaddr form))))))
+			  ;; (do ((i 0 j) (j 1 i) (k 0 (+ k 1))) ((= k 5) (set! x k) (+ k 1)) (display (+ i j)) -> use named let
+			  (lint-format "this do loop is unreadable; perhaps ~A" caller
+				       (lists->string form
+						      `(let ,loop ,(map (lambda (s)
+									  (list (car s) (cadr s)))
+									step-vars)
+							    (if ,test ,result ,new-body)))))))))))
+
+	  ;; -------- walk-do-end+result --------
+	  (define (walk-do-end+result caller form vars inner-env env)
+	    ;; walk the body and end stuff (it's too tricky to find infinite do loops)
+	    (when (and (pair? (caddr form))
+		       (or (null? (cadr form))
+			   (and (proper-list? (cadr form))
+				(pair? (caadr form)))))
+	      (let ((end+result (caddr form)))
+		(when (pair? end+result)
+		  (let ((end (car end+result)))
+		    (lint-walk caller end inner-env) ; this will call simplify-boolean
+		    (when (pair? (cdr end+result))
+		      (check-results caller 'do-result end+result (cdr end+result) inner-env)
+		      (if (null? (cddr end+result))
+			  (let ((end (car end+result))
+				(result (cadr end+result)))
+			    (if (or (equal? end result)
+				    (and (eq? result #t)
+					 (pair? end)
+					 (let ((sig (arg-signature (car end) env)))
+					   (and (pair? sig)
+						(eq? (car sig) 'boolean?)))))
+				;; (do ((i 0 (+ i 1))) ((= i 3) ()) (display i))
+				(lint-format "return value is redundant: ~A" caller end+result)
+				(if (and (len=2? result)
+					 (equal? end (cadr result)))
+				    (lint-format "perhaps use => here: ~A" caller
+						 (lists->string end+result
+								(list end '=> (car result)))))))))
+
+		    (if (memq end '(= > < >= <= null? not))
+			;; (do ((i 0 (+ i 1))) (= i 10) (display i))
+			(lint-format "perhaps missing parens: ~A" caller end+result))
+
+		    (cond ((never-false end)
+			   ;; (do ((i 0 (+ i 1))) ((+ i 10) i))
+			   (lint-format "end test is never false: ~A" caller end))
+
+			  (end ; it's not #f
+			   (if (never-true end)
+			       (lint-format "end test is never true: ~A" caller end)
+			       (begin
+
+				 ;; (do ((i 0 (+ i 1))) ((= i 0)) ...)
+				 (when (and (not (lint-tree-memq 'eof-object? end))
+					    (lint-every? (lambda (stepper)
+							   (and (pair? stepper)         ; (do ((i 0) ())...)
+								(pair? (cdr stepper))   ; (do ((i))...)
+								(not (and (symbol? (cadr stepper))
+									  (lint-tree-memq (car stepper) end)))))
+							 (cadr form))
+					    (let walk ((tree end))
+					      (if (pair? tree)
+						  (and (walk (car tree))
+						       (walk (cdr tree)))
+						  (or (constant? tree)
+						      (hash-table-ref no-side-effect-functions tree)
+						      (and (symbol? tree)
+							   (var-member tree vars))))))
+				   (let* ((new-end `(let (,@(map (lambda (stepper) ; -> (let ((i 0)) (= i 0)) using the example above
+								   (if (lint-tree-memq (car stepper) end)
+								       (list (car stepper) (cadr stepper))
+								       (values)))
+								 (cadr form)))
+						      ,end))
+					  (val (and (not (lint-tree-set-memq '(read-char read-line read-string read) new-end))
+						    ;; if new-end has (for example) read-char, eval here will hang waiting on *stdin*
+						    ;; TODO: here and below, protect against any attempt at IO
+						    (catch #t
+						      (lambda ()
+							(car (list (eval new-end (inlet))))) ; catch multiple-values, if any
+						      (lambda args
+							:eval-error)))))
+				     (if (and val (not (eq? val :eval-error)))
+					 (lint-format "do is a no-op because ~A is true at the start: ~A" caller end form)
+					 (let* ((step-end `(let (,@(map (lambda (stepper)   ; -> (let ((i (+ 0 1))) (= i 0)) as above
+									  (if (lint-tree-memq (car stepper) end)
+									      (if (pair? (cddr stepper))
+										  (list (car stepper)
+											(tree-subst (cadr stepper) (car stepper) (caddr stepper))) ; new old tree
+										  stepper) ; was (cadr stepper) which can't be right
+									      (values)))
+									(cadr form)))
+							     ,end))
+						(val (and (not (lint-tree-set-memq '(read-char read-line read-string read) step-end))
+							  (catch #t
+							    (lambda ()
+							      (car (list (eval step-end (inlet))))) ; catch multiple-values, if any
+							    (lambda args
+							      :eval-error)))))
+					   (if (and val (not (eq? val :eval-error)))
+					       (lint-format "do is unnecessary: ~A" caller (truncated-list->string form)))))))
+
+				 ;; if found, v is the var info
+				 (let ((v (and (len>1? end)
+					       (memq (car end) '(< > <= >=))
+					       (symbol? (cadr end))
+					       (var-member (cadr end) vars))))
+				   (when (pair? v)
+				     (let ((step (var-step v)))
+				       (when (pair? step)
+					 (let ((inc (and (memq (car step) '(+ -))
+							 (len>1? (cdr step))
+							 (or (and (real? (cadr step)) (cadr step))
+							     (and (real? (caddr step)) (caddr step))))))
+					   (when (and (real? inc)
+						      (case (car step)
+							((+) (and (positive? inc)
+								  (memq (car end) '(< <=))))
+							((-) (and (positive? inc)
+								  (memq (car end) '(> >=))))
+							(else #f)))
+					     ;; (do ((i 0 (+ i 1))) ((< i len)) (display i)
+					     ;; (do ((i 0 (- i 1))) ((> i len)) (display i))
+					     (lint-format "do step looks like it doesn't match end test: ~A" caller
+							  (lists->string step end)))))))))))
+			  ((pair? (cdr end+result))
+			   ;; (do ((i 0 (+ i 1))) (#f i))
+			   (lint-format "result is unreachable: ~A" caller end+result)))
+
+		    (if (and (symbol? end)
+			     (not (var-member end env))
+			     (procedure? (symbol->value end *e*)))
+			;; (do ((i 0 (+ i 1))) (abs i) (display i))
+			(lint-format "strange do end-test: ~A in ~A is a procedure" caller end end+result)))))))
+
+	  ;; -------- walk-do-body --------
+	  (define (walk-do-body caller form vars inner-env env)
+	    (lint-walk-body caller 'do (cdddr form) (cons (make-lint-var :do form 'do)
+							  inner-env))
+
+	    (when (and *report-constant-expressions-in-do*
+		       (pair? (cdr form)))
+	      (let ((local-vars (let ((lv ()))
+				  (for-each (lambda (p)
+					      (if (pair? p) ; s7test (messed-up do)
+						  (set! lv (cons (car p) lv))))
+					    (cadr form))
+				  lv)))
+		(call-with-exit
+		 (lambda (quit)
+		   (let walker ((code (cdddr form))) ; get anything that changes in the loop
+		     (when (pair? code)
+		       (if (memq (car code) binders)
+			   (cond ((and (memq (car code) '(define* define-macro define-macro* define-bacro define-bacro* define-expansion))
+				       (pair? (cdr code))             ; lg hits this
+				       (pair? (cadr code)))
+				  (set! local-vars (cons (caadr code) local-vars)))
+
+				 ((memq (car code) '(load eval eval-string require provide quote))
+				  (quit))
+
+				 ((and (memq (car code) '(define define-constant))
+				       (pair? (cdr code)))    ; lg
+				  (set! local-vars (cons ((if (pair? (cadr code)) caadr cadr) code) local-vars))))
+
+			   (if (and (memq (car code) '(set! vector-set! list-set! hash-table-set! float-vector-set! int-vector-set!
+						       string-set! let-set! fill! string-fill! list-fill! vector-fill!
+						       reverse! sort! set-car! set-cdr!))
+				    (pair? (cdr code)))            ; lg again
+			       (set! local-vars (cons (cadr code) local-vars))
+			       (begin
+				 (walker (car code))
+				 (walker (cdr code)))))))
+		   (let walker ((code (cdddr form)))  ; look for exprs (or portions thereof) that don't change
+		     (unless (or (not (pair? code))
+				 (and (null? (cdr code)) (symbol? (car code))) ; symbol in arg list etc, (do vars end (func eqv?))
+				 (memq (car code) binders)
+				 (memq (car code) '(quote #_quote case))
+				 (hash-table-ref makers (car code)))
+		       (when (hash-table-ref no-side-effect-functions (car code))
+			 (if (memq (car code) '(* + - /))
+			     (when (> (length code) 3) ; counting '* etc
+			       (let ((cs 0))
+				 (for-each (lambda (p)
+					     (if (or (code-constant? p)
+						     (and (symbol? p)
+							  (not (memq p local-vars)))
+						     (and (pair? p)
+							  (not (lint-tree-set-memq local-vars p))
+							  (not (side-effect? p env))
+							  (not (eq? 'random (car p)))))
+						 (set! cs (+ cs 1))))
+					   (cdr code))
+				 (when (> cs 1)
+				   (let ((new-code
+					  (let ((expr (if (memq (car code) '(+ *))
+							  (list (car code))
+							  (if (not (or (memq (cadr code) local-vars)
+								       (and (pair? (cadr code))
+									    (or (lint-tree-set-memq local-vars (cadr code))
+										(side-effect? (cadr code) env)))))
+							      (list (car code))
+							      (list (if (eq? (car code) '-) '+ '*))))))
+					    (do ((p (cdr code) (cdr p)))
+						((null? p)
+						 (reverse! expr))
+					      (unless (or (memq (car p) local-vars)
+							  (and (pair? (car p))
+							       (or (lint-tree-set-memq local-vars (car p))
+								   (side-effect? (car p) env))))
+						(set! expr (cons (car p) expr)))))))
+				     (if (equal? new-code code)
+					 (lint-format "~S is constant in the do loop" caller code)
+					 (lint-format "~S in ~S is constant in the do loop" caller new-code code))))))
+#|
+			     ;; this messes up all the time
+			     (when (and (not (memq (car code) local-vars)) ; also need (not (dilambda (symbol->value (car code)))) here I think
+					(not (memq (car code) '(quote #_quote)))
+					(lint-every? (lambda (v)
+						       (or (code-constant? v)
+							   (and (symbol? v)
+								(not (memq v local-vars)))))
+						     (cdr code)))
+			       (lint-format "~S could be moved out of the do loop" caller code))
+|#
+			     ))
+		       (walker (car code))
+		       (walker (cdr code))))))))
+
+	    ;; before report-usage, check for unused variables, and don't complain about them if
+	    ;;   they are referenced in an earlier step expr.
+	    (do ((v vars (cdr v)))
+		((null? v))
+	      (let ((var (car v)))
+		(when (zero? (var-ref var))
+		  ;; var was not seen in the end+result/body or any subsequent step exprs
+		  ;;   vars is reversed order, so we need only scan var-step of the rest
+		  (if (side-effect? (var-step var) env)
+		      (set! (var-ref var) (+ (var-ref var) 1))
+		      (for-each
+		       (lambda (nv)
+			 (if (or (eq? (var-name var) (var-step nv))
+				 (and (pair? (var-step nv))
+				      (lint-tree-memq (var-name var) (var-step nv))))
+			     (set! (var-ref var) (+ (var-ref var) 1))))
+		       (cdr v))))))
+
+	    ;; try to catch step-var sets at the body end and move to the step expr
+	    ;;   (do ((i 0 (+ i 1)) (j 1)) ((= i 3)) (display (+ i j)) (set! j (+ j 1))), move (+ j 1)
+	    (let ((last-expr (last-ref (cdddr form))))
+	      (when (and (len=3? last-expr)
+			 (eq? (car last-expr) 'set!))
+		(let ((var (cadr last-expr))
+		      (val (caddr last-expr)))
+		  (cond ((var-member var vars)
+			 => (lambda (v)
+			      (if (and (var-step v)
+				       (not (lint-tree-memq (var-name v) (var-step v))))
+				  (if (side-effect? val env)
+				      (lint-format "this set! is pointless: ~A; perhaps replace it with ~A" caller
+						   (truncated-list->string last-expr)
+						   (truncated-list->string val))
+				      (lint-format "this set! is pointless: ~A" caller
+						   (truncated-list->string last-expr)))
+				  (if (and (or (not (var-step v))
+					       (= (lint-tree-count (var-name v) (var-step v) 2) 1))
+					   ;; don't move if val contains ref to other step vars
+					   (not (lint-tree-set-memq (remove-one (var-name v) (map var-name vars)) val))
+					   ;; don't move if var is referred to in any other step expr
+					   (not (lint-any? (lambda (binding)
+							     (and (not (eq? (car binding) var))
+								  (pair? (cddr binding))
+								  (lint-tree-memq var (caddr binding))))
+							   (cadr form))))
+				      (lint-format "perhaps move ~A to ~A's step expression: ~A" caller
+						   (truncated-list->string last-expr)
+						   (var-name v)
+						   (list (var-name v)
+							 (var-initial-value v)
+							 (if (not (var-step v))
+							     val
+							     (let ((expr (tree-subst val (var-name v) (var-step v))))
+							       (cond ((not (pair? expr))
+								      expr)
+
+								     ((hash-table-ref numeric-ops (car expr))
+								      (simplify-numerics expr env))
+
+								     ((memq (car expr) '(and or not))
+								      (simplify-boolean expr () () env))
+
+								     (else expr))))))))))))))
+	    (report-usage caller 'do vars inner-env))
+
+	  ;; -------- simplify-do --------
+	  (define (simplify-do caller form vars env)
+	    (let ((body (cdddr form)))
+	      (when (and (len=1? body)
+			 (pair? (car body)))
+		;; do+let
+		;;   no hits for define here
+		;;   this is tricky: make-index.scm (do () ((>= i len)) (let ((c (string-ref scheme-name i))) ...)) can't move the let upwards
+		(if (and (eq? (caar body) 'let)
+			 (len>1? (cdar body))         ; body not ((let))!
+			 (not (symbol? (cadar body))) ; not named let
+			 (or (null? (cadar body))
+			     (not (lint-tree-set-memq definers (cddar body)))) ; no let capture
+			 (let ((varset (map car vars))
+			       (endset (if (and (pair? (caddr form))
+						(pair? (caaddr form)))
+					   (map (lambda (x)
+						  (if (symbol? x) x (values))) ; overkill obviously
+						(caaddr form))
+					   ())))
+			   (lint-every? (lambda (c)
+					  (and (len>1? c)
+					       (not (memq (car c) varset)) ; no shadowing
+					       (or (code-constant? (cadr c))
+						   (not (or (side-effect? (cadr c) env) ; might change end-test calc?
+							    (lint-tree-set-memq varset (cadr c))
+							    (lint-tree-set-memq endset (cadr c)))))))
+					(cadar body))))
+		    ;; (do ((i 0 (+ i 1))) ((= i 3)) (let ((a 12)) (set! a (+ a i)) (display a))) ->
+		    ;;    (do ((i 0 (+ i 1)) (a 12 12)) ((= i 3)) (set! a (+ a i)) ...)
+		    ;; maybe a better suggestion: declare in do vars, then use set! in the body
+		    (lint-format "perhaps ~A" caller
+				 (lists->string form
+						`(do (,@(cadr form)
+						      ,@(map (lambda (c)
+							       (list (car c) (cadr c) (cadr c)))
+							     (cadar body)))
+						     ,(caddr form)
+						   ,@(one-call-and-dots (cddar body))))))
+		;; do+lambda in body with stepper as free var never happens
+		(let ((v (var-member (caar body) env)))
+		  (when (and v
+			     (memq (var-ftype v) '(define lambda)))
+		    (let* ((vfunc (var-initial-value v))
+			   (vbody (cddr vfunc)))
+		      ;; we already detect a do body with no side-effects (walk-body)
+		      (when (and (proper-list? ((if (eq? (var-ftype v) 'define) cdadr cadr) vfunc))
+				 (null? (cdr vbody))
+				 (< (lint-tree-leaves vbody) 16))
+			(do ((pp (var-arglist v) (cdr pp)))
+			    ((or (null? pp)
+				 (> (tree-count (car pp) vbody 3) 1))
+			     (when (null? pp)
+			       (let ((new-body (copy vbody)))
+				 (for-each (lambda (par arg)
+					     (if (not (eq? par arg))
+						 (set! new-body (tree-subst arg par new-body))))
+					   (var-arglist v)
+					   (cdar body))
+				 ;; (do ((i 0 (+ i 1))) ((= i 10)) (f i)) -> (do ((i 0 (+ i 1))) ((= i 10)) (abs (* 2 i)))
+				 (lint-format "perhaps ~A" caller
+					      (lists->string form
+							     `(do ,(cadr form)
+								  ,(caddr form)
+								,@new-body))))))))))))))
+	  ;; -------- do->for-each --------
+	  (define (do->for-each caller form env)
+	    (let ((step-vars (cadr form)))
+	      (when (len=1? step-vars)
+		(let ((var (car step-vars)))
+		  (when (and (len>2? var)
+			     (len>1? (caddr var))
+			     (len=1? (caddr form))
+			     (pair? (caaddr form))
+			     (eq? (car var) (cadr (caddr var))))
+		    (let ((vname (car var))
+			  (end (caaddr form)))
+		      (case (caaddr var)
+			((cdr)
+			 (when (and (case (car end)
+				      ((null?)
+				       (eq? (cadr end) vname))
+				      ((not)
+				       (and (pair? (cadr end))
+					    (eq? (caadr end) 'pair?)
+					    (eq? (cadadr end) vname)))
+				      (else #f))
+				    (not (let walker ((tree (cdddr form))) ; since only (cxar sym) is accepted, surely sym can't be shadowed?
+					   (or (eq? tree vname)
+					       (and (pair? tree)
+						    (or (and (match-cxr 'cdr (car tree))
+							     (pair? (cdr tree))
+							     (eq? vname (cadr tree)))
+							(and (not (hash-table-ref cxars (car tree)))
+							     (or (walker (car tree))
+								 (walker (cdr tree))))))))))
+			   ;; this assumes slightly more than the do-loop if (not (pair? var)) is the end-test
+			   ;;   for-each wants a sequence, but the do loop checks that in advance.
+			   ;; (do ((p lst (cdr p))) ((null? p)) (display (car p))) -> (for-each (lambda ([p]) (display [p])) lst)
+			   (lint-format "perhaps ~A" caller
+					(lists->string form
+						       (let ((new-sym (symbol "[" (symbol->string vname) "]")))
+							 `(for-each (lambda (,new-sym)
+								      ,@(car-subst vname new-sym (cdddr form)))
+								    ,(cadr var)))))))
+			((+)
+			 (when (and (eqv? (cadr var) 0)
+				    (len=1? (cddr (caddr var)))
+				    (eqv? (caddr (caddr var)) 1)
+				    (len=3? end))
+			   (let ((end-var ((if (eq? vname (cadr end)) caddr cadr) end)))
+			     (if (and (pair? end-var)
+				      (memq (car end-var) '(length string-length vector-length)))
+				 (set! end-var (cadr end-var))
+				 (let ((v (var-member end-var env)))
+				   (if (and v
+					    (pair? (var-initial-value v))
+					    (memq (car (var-initial-value v)) '(length string-length vector-length)))
+				       (set! end-var (cadr (var-initial-value v))))))
+			     (when (and (memq (car end) '(= >=))
+					(memq vname end)
+					(lint-tree-memq vname (cdddr form))
+					(not (let walker ((tree (cdddr form)))
+					       (if (and (pair? tree)
+							(memq vname tree)
+							(memq (car tree) '(string-ref list-ref vector-ref))
+							(eq? (caddr tree) vname))
+						   (not (equal? (cadr tree) end-var))
+						   (or (eq? tree vname)
+						       (and (pair? tree)
+							    (if (memq vname tree)
+								(not (and (memq (car tree) '(string-ref list-ref vector-ref))
+									  (len>1? (cdr tree))
+									  (eq? (caddr tree) vname)))
+								(or (walker (car tree))
+								    (walker (cdr tree))))))))))
+			       ;; (do ((i 0 (+ i 1))) ((= i (vector-length x))) (find (vector-ref x i))) ->
+			       ;;    (for-each (lambda ([x]) (find [x])) x)
+			       (lint-format "perhaps ~A" caller
+					    (lists->string form
+							   (let ((new-sym (symbol "[" (symbol->string (if (symbol? end-var) end-var (car end-var))) "]")))
+							     `(for-each (lambda (,new-sym)
+									  ,@(cadr-subst end-var new-sym (cdddr form)))
+									,end-var)))))))))))))))
+	  ;; -------- do->copy --------
+	  (define (do->copy caller form vars)
+	    ;; check for do-loop as copy/fill! stand-in and other similar cases
+	    (if (len=1? vars)
+		(let ((step-vars (cadr form)))
+		  (let ((end-test (and (pair? (caddr form)) (caaddr form)))
+			(first-var (car step-vars))
+			(body (cdddr form))
+			(setv #f))
+		    (when (and (pair? end-test)
+			       (len=1? body)
+			       (pair? (car body))
+			       (memq (car end-test) '(>= = < negative?)))
+		      (set! body (car body))
+		      (when (memq (car body) '(vector-set! float-vector-set! int-vector-set! list-set! string-set!))
+			(let ((vname (car first-var))
+			      (start (cadr first-var))
+			      (step (and (pair? (cddr first-var))
+					 (caddr first-var)))
+			      (end (if (eq? (car end-test) 'negative?) 0 (caddr end-test))))
+			  (when (and (eq? (caddr body) vname)
+				     (pair? step)
+				     (case (car step)
+				       ((+)
+					(and (memq vname step)
+					     (memv 1 step)
+					     (null? (cdddr step))           ; (+ v 1) or (+ 1 v)
+					     (memq (car end-test) '(>= =)))) ; (= ...) or (>= ...)
+				       ((-)
+					(and (eq? (cadr step) vname)
+					     (eqv? (caddr step) 1)          ; (- v 1)
+					     (case (car end-test)
+					       ((< = <=)                    ; (< ...) or (negative? ...)
+						(null? (cdddr end-test)))
+					       ((negative?)
+						(null? (cddr end-test)))
+					       (else #f))))
+				       (else #f))
+				     (or (eq? (cadr end-test) vname)
+					 (and (eq? (car end-test) '=)
+					      (eq? (caddr end-test) vname)
+					      (set! end (cadr end-test)))))
+			    ;; we have (do ((v start (+ v 1)|(+ 1 v))) ((= v end)|(= end v)|(>= v end)) one-statement)
+			    ;;      or (do ((v start (- v 1)))         ((= v end)|(= end v)|(negative? v)|(< v end)) one-statement)
+			    ;; write-char is the only other common case here -> write-string in a few cases
+			    ;; integer type check here isn't needed because we're using this as an index below
+			    ;;   the type error will be seen in report-usage if not earlier
+			    (let ((val (cadddr body)))
+			      (set! setv val)
+
+			      (when (eq? (car step) '-)
+				(let ((tmp start))
+				  (set! start end)
+				  (set! end tmp))
+				(if (and (len=3? end)
+					 (eq? (car end) '-)
+					 (eqv? (caddr end) 1))
+				    (set! end (cadr end))
+				    (set! end `(+ ,end 1))))
+
+			      (when (or (code-constant? val)  ; fill!
+					(and (pair? val)      ; copy
+					     (memq (car val) '(vector-ref float-vector-ref int-vector-ref list-ref string-ref))
+					     (eq? (caddr val) vname)))
+				;; (do ((i 2 (+ i 1))) ((= i len)) (string-set! s i #\a)) -> (fill! s #\a 2 len)
+				(lint-format "perhaps ~A" caller
+					     (lists->string form
+							    (if (code-constant? setv)
+								(list 'fill! (cadr body) (cadddr body) start end)
+								;; (do ((i 0 (+ i 1))) ((= i (length str)) s) (string-set! s i (string-ref str i))) -> (copy str s)
+								;; it is a bother to squeeze string-up|downcase into this block, and I doubt it would ever be hit
+								(if (and (eqv? start 0)
+									 (pair? end)
+									 (memq (car end) '(length vector-length string-length))
+									 (eq? (cadr end) (cadr setv)))
+								    (list 'copy (cadr setv) (cadr body))
+								    (list 'copy (cadr setv) (cadr body) start end)))))))))))))
+		(when (and (len=2? vars)
+			   (null? (cdddr form))) ; no body
+		  ;; (do ((i 0 (+ i 1)) (lst () (cons 1 lst))) ((= i 10) lst)) -> (make-list 10 1)
+		  (let ((var1 (caadr form)))
+		    (if (and (len=2? (cdr var1))
+			     (pair? (caddr var1))
+			     (eq? (caaddr var1) 'cons))
+			(do->make-list caller form form (cadadr form) var1)
+			(let ((var2 (cadadr form)))
+			  (if (and (len=2? (cdr var2))
+				   (pair? (caddr var2))
+				   (eq? (caaddr var2) 'cons))
+			      (do->make-list caller form form var1 var2))))))))
+
+	  ;; -------- do-walker --------
+	  (define (do-walker caller form env)
+	    (if (not (and (>= (length form) 3)
+			  (proper-list? (cadr form))
+			  (proper-list? (caddr form))))
+		(lint-format "do is messed up: ~A" caller (truncated-list->string form))
+		(begin
+		  (unless (side-effect? form env)
+		    (pointless-do caller form))
+		  ;; pointless-var equivalent here gets about 4 hits
+
+		  (let* ((vars (walk-do-inits caller form env))
+			 (inner-env (append vars env)))
+		    (walk-do-steps caller form vars inner-env env)
+		    (walk-do-end+result caller form vars inner-env env)
+		    (walk-do-body caller form vars inner-env env)
+		    (simplify-do caller form vars env)
+		    (do->for-each caller form env)
+		    (do->copy caller form vars))))
+	    env)
+
+	  (hash-walker 'do do-walker))
+
+
+	;; ---------------- let, let*, letrec ----------------
+	(let ()
+	  (define (unsafe-definer? form)
+	    (lint-tree-set-memq
+	     '(define define* define-constant
+		curlet require load eval eval-string
+		define-macro define-macro* define-bacro define-bacro* define-expansion
+		definstrument define-animal define-envelope defgenerator
+		define-values define-module define-method
+		define-syntax define-public define-inlinable define-integrable define^
+		call/cc call-with-current-continuation)
+	     form))
+
+	  ;; -------- walk-letx-body --------
+	  (define (walk-letx-body caller form body vars env)
+	    (let* ((cur-env (cons (make-lint-var :let form 'let)
+				  (append vars env)))
+		   (e (lint-walk-body caller (car form) body cur-env)))
+
+	      (when (pair? vars)
+		(case (car form)
+		  ((let)
+		   (for-each (lambda (v)
+			       (if (null? (var-env v))
+				   (set! (var-env v) cur-env)))
+			     vars))
+		  ((let*)                                  ; could also scan vars (stored backwards here) for any not ref'd later in vals
+		   (set! (var-env (car vars)) cur-env))))  ;   but this only gets 3 hits
+
+	      (let ((nvars (and (not (eq? e cur-env))
+				(env-difference caller e cur-env ()))))
+		(if (pair? nvars)
+		    (if (memq (var-name (car nvars)) '(:lambda :dilambda))
+			(begin
+			  (set! env (cons (car nvars) env))
+			  (set! nvars (cdr nvars)))
+			(set! vars (append nvars vars)))))
+	      (report-usage caller (car form) vars e)
+	      (cons vars env)))
+
+	  ;; --------declare-named-let --------
+	  (define (declare-named-let form env)	    ; used in let-walker and let*-walker
+	    (let ((named-let (and (symbol? (cadr form)) (cadr form))))
+	      (if (or (not named-let)
+		      (keyword? named-let)
+		      (not (or (null? (caddr form))
+			       (and (proper-list? (caddr form))
+				    (just-pairs? (caddr form))))))
+		  ()
+		  (let ((vars (map car (caddr form))))
+		    (if (memq named-let vars)
+			(lint-format "perhaps ~S -> ~S" 'let form (cons 'let (cddr form))))
+		    (list (make-fvar named-let (car form) vars form env))))))
+
+
+	  ;; -------- remove-null-let --------
+	  (define (remove-null-let caller form env)
+	    (if (and (null? (cadr form)) ; this can be fooled by macros that define things
+		     (not (lint-tree-set-memq open-definers (cddr form)))) ; somewhat too restrictive but hard to improve
+		;; (begin (let () (display x)) y)
+		(if (or (eq? form lint-current-form) ; i.e. we're in a body?
+			(null? (cdddr form)))
+		    (lint-format "pointless let: ~A" caller (truncated-list->string form))
+		    (if (lint-every? (lambda (p)
+				       (or (not (pair? p))
+					   (hash-table-ref built-in-functions (car p))
+					   (hash-table-ref syntaces (car p))
+					   (not (side-effect? p env))))
+				     (cddr form))
+			(lint-format "let could be begin: ~A" caller
+				     (truncated-lists->string form (cons 'begin (cddr form))))))
+		(let ((body (cddr form)))
+		  (when (and (null? (cdr body))
+			     (len>1? (car body)))
+		    (if (memq (caar body) '(let let*))
+			(if (null? (cadr form))
+			    ;; (let () (let ((a x)) (+ a 1)))
+			    (lint-format "pointless let: ~A" caller (lists->string form (car body)))
+			    (if (null? (cadar body))
+				;; (let ((a x)) (let () (+ a 1)))
+				(lint-format "pointless let: ~A" caller (lists->string form (cons 'let (cons (cadr form) (cddar body)))))))
+			(if (and (memq (caar body) '(lambda lambda*)) ; or any definer?
+				 (null? (cadr form)))
+			    ;; (let () (lambda (a b) (if (positive? a) (+ a b) b))) -> (lambda (a b) (if (positive? a) (+ a b) b))
+			    (lint-format "pointless let: ~A" caller (lists->string form (car body)))))))))
+
+	  ;; -------- walk-let-vars --------
+	  (define (walk-let-vars caller form varlist vars env)
+	    (let ((named-let (and (symbol? (cadr form)) (cadr form))))
+	      (do ((bindings varlist (cdr bindings)))
+		  ((null? bindings))
+		(when (binding-ok? caller 'let (car bindings) env #f)
+		  (let ((val (cadar bindings)))
+		    (if (and (pair? val)
+			     (eq? 'lambda (car val))
+			     (tree-car-member (caar bindings) val)
+			     (not (var-member (caar bindings) env))) ; (let ((x (lambda (a) (x 1)))) x)
+			(lint-format "let variable ~A is called in its binding?  Perhaps let should be letrec: ~A"
+				     caller (caar bindings)
+				     (truncated-list->string bindings))
+			(unless named-let
+			  (for-each (lambda (v)
+				      (if (and (lint-tree-memq (var-name v) (cadar bindings))
+					       (not (hash-table-ref built-in-functions (var-name v)))
+					       (not (lint-tree-set-memq binders (cadar bindings))))
+					  (if (not (var-member (var-name v) env))
+					      ;; (let ((x 1) (y x)) (+ x y)): x in (y x)
+					      (lint-format "~A in ~A does not appear to be defined in the calling environment" caller
+							   (var-name v) (car bindings))
+					      ;; (let ((x 3)) (+ x (let ((x 1) (y x)) (+ x y)))): x in (y x)
+					      (lint-format "~A in ~A refers to the caller's ~A, not the let variable" caller
+							   (var-name v) (car bindings) (var-name v)))))
+				    vars)))
+		    ;; escape as value got no hits
+		    (let ((e (if (symbol? val)
+				 (set-ref val caller form env)
+				 (lint-walk caller val env))))
+		      (if (and (pair? e)
+			       (not (eq? e env))
+			       (memq (var-name (car e)) '(:lambda :dilambda)))
+			  (let ((ldata (cdar e)))
+			    (set! (var-name (car e)) (caar bindings))
+			    (let-set! ldata 'initial-value val)
+			    (set! vars (cons (car e) vars)))
+			  (set! vars (cons (make-lint-var (caar bindings) val (if named-let 'named-let 'let))
+					   vars)))))))
+
+	      (check-unordered-exprs caller form
+				     (map (if (not named-let)
+					      var-initial-value
+					      (lambda (v)
+						(if (eq? (var-name v) named-let)
+						    (values)
+						    (var-initial-value v))))
+					  vars)
+				     env)
+	      vars))
+
+	  ;; -------- move-let-into-if --------
+	  (define (move-let-into-if caller form env)
+	    ;; move let in:
+	    ;;   (let ((a (car x))) (if b (+ a (f a)) (display c))) -> (if b (let ((a (car x))) (+ a (f a))) (display c))
+	    ;;   let* version gets only 3 hits
+	    (unless (lint-any? (lambda (c)
+				 (not (and (len>1? c)
+					   (symbol? (car c))
+					   (not (side-effect? (cadr c) env)))))
+			       (cadr form))
+	      (let ((first-expr (caddr form)))
+		(case (car first-expr)
+		  ((if)
+		   (when (pair? (cddr first-expr))
+		     (let ((test (cadr first-expr))
+			   (true (caddr first-expr))
+			   (false (and (pair? (cdddr first-expr)) (cadddr first-expr)))
+			   (vars (map car (cadr form)))
+			   (false-let #f))
+		       (when (and (not (memq test vars))
+				  (not (lint-tree-set-memq vars test))
+				  (or (and (not (memq true vars))
+					   (not (lint-tree-set-memq vars true))
+					   (set! false-let #t))
+				      (not false)
+				      (not (or (memq false vars)
+					       (lint-tree-set-memq vars false))))
+				  (lint-tree-set-memq vars (cddr form))) ; otherwise we'll complain elsewhere about unused variables
+			 (lint-format "perhaps move the let to the ~A branch: ~A" caller
+				      (if false-let "false" "true")
+				      (lists->string form
+						     (let ((true-dots (if (> (lint-tree-leaves true) 30) '... true))
+							   (false-dots (if (and (pair? false) (> (lint-tree-leaves false) 30)) '... false)))
+						       (if false-let
+							   `(if ,test ,true-dots (let ,(cadr form) ,@(unbegin false-dots)))
+							   (if (pair? (cdddr (caddr form)))
+							       `(if ,test (let ,(cadr form) ,@(unbegin true-dots)) ,false-dots)
+							       `(if ,test (let ,(cadr form) ,@(unbegin true-dots))))))))))))
+		  ((cond)
+		   ;; happens about a dozen times
+		   (let ((vars (map car (cadr form))))
+		     (when (lint-tree-set-memq vars (cdr first-expr))
+		       (call-with-exit
+			(lambda (quit)
+			  (let ((branch-let #f))
+			    (for-each (lambda (c)
+					(if (and (not branch-let)
+						 (pair? c)
+						 (side-effect? (car c) env))
+					    (quit))
+					(when (and (pair? c)
+						   (lint-tree-set-memq vars c))
+					  (if branch-let (quit))
+					  (set! branch-let c)))
+				      (cdr first-expr))
+			    (when (and branch-let
+				       (not (memq (car branch-let) vars))
+				       (not (lint-tree-set-memq vars (car branch-let))))
+			      (lint-format "perhaps move the let into the '~A branch: ~A" caller
+					   (truncated-list->string branch-let)
+					   (lists->string form
+							  (if (eq? '=> (cadr branch-let))
+							      (if (eq? branch-let (cadr first-expr))
+								  `(cond (,(car branch-let) => (let ,(cadr form) ,@(cddr branch-let))) ...)
+								  `(cond ... (,(car branch-let) => (let ,(cadr form) ,@(cddr branch-let))) ...))
+							      (if (eq? branch-let (cadr first-expr))
+								  `(cond (,(car branch-let) (let ,(cadr form) ,@(cdr branch-let))) ...)
+								  `(cond ... (,(car branch-let) (let ,(cadr form) ,@(cdr branch-let))) ...))))))))))))
+		  ((case)
+		   (let ((vars (map car (cadr form)))
+			 (test (cadr first-expr)))
+		     (when (and (not (memq test vars))
+				(not (lint-tree-set-memq vars test))
+				(lint-tree-set-memq vars (cddr first-expr)))
+		       (call-with-exit
+			(lambda (quit)
+			  (let ((branch-let #f))
+			    (for-each (lambda (c)
+					(when (and (pair? c)
+						   (lint-tree-set-memq vars (cdr c)))
+					  (if branch-let (quit))
+					  (set! branch-let c)))
+				      (cddr first-expr))
+			    (when (proper-list? branch-let)
+			      (lint-format "perhaps move the let into the '~A branch: ~A" caller
+					   (truncated-list->string branch-let)
+					   (lists->string form
+							  (if (eq? '=> (cadr branch-let))
+							      (if (eq? branch-let (caddr first-expr))
+								  `(case ,test (,(car branch-let) => (let ,(cadr form) ,@(cddr branch-let))) ...)
+								  `(case ,test ... (,(car branch-let) => (let ,(cadr form) ,@(cddr branch-let))) ...))
+							      (if (eq? branch-let (caddr first-expr))
+								  `(case ,test (,(car branch-let) (let ,(cadr form) ,@(cdr branch-let))) ...)
+								  `(case ,test ... (,(car branch-let) (let ,(cadr form) ,@(cdr branch-let))) ...))))))))))))
+		  ((when unless) ; no hits -- maybe someday?
+		   (let ((test (cadr first-expr))
+			 (vars (map car (cadr form))))
+		     (unless (or (memq test vars)
+				 (lint-tree-set-memq vars test)
+				 (side-effect? test env)
+				 (not (proper-list? (cddr first-expr))))
+		       (lint-format "perhaps move the let inside the ~A: ~A" caller
+				    (car first-expr)
+				    (truncated-lists->string form `(,(car first-expr) ,test (let ,(cadr form) ,@(cddr first-expr))))))))))))
+
+	  ;; -------- let-body->value --------
+	  (define (let-body->value caller form vars env)
+	    (let ((named-let (and (symbol? (cadr form)) (cadr form))))
+	      (let ((body ((if named-let cdddr cddr) form))
+		    (varlist ((if named-let  caddr cadr) form)))
+		(case (caar body)
+		  ((set!)
+		   (let ((settee (cadar body))
+			 (setval (caddar body))
+			 (vals-ok #f))
+		     (if (and (not named-let)           ; (let ((x 0)...) (set! x 1)...) -> (let ((x 1)...)...)
+			      (not (lint-tree-memq 'curlet setval))
+			      (cond ((assq settee vars)
+				     => (lambda (v)
+					  (or (set! vals-ok (and (code-constant? (var-initial-value v))
+								 (code-constant? setval)))
+					      (and (<= (lint-tree-count settee setval 3) 1)
+						   (not (lint-any? (lambda (v1)
+								     (or (lint-tree-memq settee (cadr v1))
+									 (and (not (eq? (car v1) settee))
+									      (or (lint-tree-memq (car v1) setval)
+										  (side-effect? (cadr v1) env)))))
+								   varlist))))))
+				    (else #f)))
+			 (begin
+			   (if (not vals-ok)
+			       (set! setval (let replace ((tree setval))
+					      (if (eq? tree settee)
+						  (var-initial-value (assq settee vars))
+						  (if (not (pair? tree))
+						      tree
+						      (cons (replace (car tree))
+							    (replace (cdr tree))))))))
+			   (lint-format "perhaps ~A" caller  ;  (let ((a 1)) (set! a 2)) -> 2
+					(lists->string form
+						       (if (null? (cdr body)) ; this only happens in test suites...
+							   (if (null? (cdr varlist))
+							       setval
+							       (list 'let (map (lambda (v) (if (eq? (car v) settee) (values) v)) varlist)
+								     setval))
+							   (cons 'let
+								 (cons (map (lambda (v)
+									      (if (eq? (car v) settee)  ; (let ((x 0)) (set! x 1)...) -> (let ((x 1)) ...)
+										  (list (car v) setval) ; replace initial with set! value
+										  v))
+									    varlist)
+								       (if (null? (cddr body))
+									   (cdr body)
+									   (list (cadr body) '...))))))))
+			 ;; repetition for the moment
+			 (when (and (pair? varlist)
+				    (assq settee vars)           ; settee is a local var
+				    (not (eq? settee named-let)) ; (let loop () (set! loop 3))!
+				    (or (null? (cdr body))
+					(and (null? (cddr body))
+					     (eq? settee (cadr body))))) ; (let... (set! local val) local)
+			   (lint-format "perhaps ~A" caller
+					(lists->string form
+						       (if (or (lint-tree-memq settee setval)
+							       (side-effect? (cadr (assq settee varlist)) env))
+							   (list 'let varlist setval)
+							   (if (null? (cdr varlist))
+							       setval
+							       (list 'let (remove-if (lambda (v)
+										       (eq? (car v) settee))
+										     varlist)
+								     setval)))))))))
+
+		  ((define)
+		   (unless named-let
+		     (let ((f (cdar body)))
+		       (when (and (len=2? f)
+				  (symbol? (car f))
+				  (not (assq (car f) varlist))           ; this (let ((x ...)) (set! x ...)) is handled elsewhere
+				  (or (code-constant? (cadr f))
+				      (not (or (lint-tree-memq 'lambda (cadr f))  ; else we have to scan forward for pending refs
+					       (and (pair? varlist)
+						    (or (side-effect? (cadr f) env)   ; might be depending on the let var calcs
+							(lint-tree-set-memq (map car varlist) (cadr f))))))))
+			 (lint-format "perhaps ~A" caller
+				      (lists->string form
+						     `(let (,@varlist
+							    ,f)
+							...)))))))
+
+		  ;; display et al here happen a lot, but only a few are rewritable or collapsible
+		  ;; *-set! happen a couple dozen times, but not in ways we can rewrite
+
+		  ((fill! string-fill! vector-fill!) ; (let ((x (make-vector 3))) (fill! x 1) ...) -> (let ((x (make-vector 3 1))) ...)
+		   (cond ((assq (cadar body) vars) =>
+			  (lambda (v)
+			    (let ((new-init (let ((init (var-initial-value v)))
+					      (if (and (code-constant? init)
+						       (code-constant? (caddar body))
+						       (sequence? init))
+						  (let ((i1 (copy init)))  ; (fill! #(0 1 2) 3)??
+						    (catch #t
+						      (lambda ()
+							(fill! i1 (caddar body))
+							i1)
+						      (lambda args :none)))
+						  (if (and (pair? init)
+							   (memq (car init) '(make-string make-list make-vector
+											  make-int-vector make-float-vector make-byte-vector))
+							   (let ((ninit (caddar body))
+								 (local-vars (map car vars)))
+							     ;; watch out for (let ((g (make-oscil)) (v (make-vector 3))) (fill! v g) ...)
+							     (not (or (lint-tree-set-memq local-vars ninit)
+								      (memq ninit local-vars)))))
+						      (list (car init) (cadr init) (caddar body))
+						      :none)))))
+			      (if (not (eq? new-init :none))
+				  (lint-format "perhaps ~A" caller
+					       (lists->string form
+							      (if (null? (cdr body))
+								  (list 'let (map (lambda (v)
+										    (if (eq? (car v) (cadar body))
+											(values)
+											v))
+										  varlist)
+									(caddar body))
+								  (cons 'let
+									(cons (map (lambda (v)
+										     (if (eq? (car v) (cadar body))
+											 (list (car v) new-init)
+											 v))
+										   varlist)
+									      (if (null? (cddr body))
+										  (cdr body)
+										  (list (cadr body) '...)))))))))))))))))
+
+	  ;; -------- normal-let->do --------
+	  (define (normal-let->do caller form env)
+	    (let ((varlist (cadr form))
+		  (body (cddr form)))
+	      (when (lint-every? len=2? varlist)
+		(when (and (null? (cdr body))  ; removing this restriction gets only 3 hits
+			   (pair? (cdar body))
+			   (pair? (cadar body))
+			   (just-len>1? (cadar body)))
+		  (let ((inits (map cadr (cadar body))))
+		    (when (lint-every? (lambda (v)
+					 (and (= (tree-count (car v) (car body) 2) 1)
+					      (lint-tree-memq (car v) inits)))
+				       varlist)
+		      (let ((new-cadr (copy (cadar body))))
+			(for-each (lambda (v)
+				    (set! new-cadr (tree-subst (cadr v) (car v) new-cadr)))
+				  varlist)
+			;; (let ((a 1)) (do ((i a (+ i 1))) ((= i 3)) (display i))) -> (do ((i 1 (+ i 1))) ...)
+			(lint-format "perhaps ~A" caller
+				     (lists->string form (list 'do new-cadr '...)))))))
+
+		;; let->do -- sometimes a bad idea, set *report-combinable-lets* to #f to disable this.
+		;;   (the main objection is that the s7/clm optimizer can't handle it, and
+		;;   instruments using it look kinda dumb -- the power of habit or something)
+		(when (and *report-combinable-lets*
+			   (not (len>1? (cdr body)))
+			   ;; moving more than one expr here is usually ugly -- the only exception I've
+			   ;;   seen is where the do body is enormous and the end stuff very short, and
+			   ;;   it (the end stuff) refers to the let/do variables -- in the unedited case,
+			   ;;   the result is hard to see.
+			   (<= (lint-tree-leaves (cdr body)) *max-cdr-len*))
+		  (let ((inits (if (and (pair? (cdar body))
+					(pair? (cadar body))
+					(just-len>1? (cadar body)))
+				   (map cadr (cadar body))
+				   ()))
+			(locals (if (and (pair? (cdar body))
+					 (pair? (cadar body))
+					 (just-pairs? (cadar body)))
+				    (map car (cadar body))
+				    ())))
+		    (unless (and (pair? inits)
+				 (lint-any? (lambda (v)
+					      (or (memq (car v) locals) ; shadowing
+						  (lint-tree-memq (car v) inits)
+						  (side-effect? (cadr v) env))) ; let var opens *stdin*, do stepper reads it at init
+					    varlist))
+		      ;; (let ((xx 0)) (do ((x 1 (+ x 1)) (y x (- y 1))) ((= x 3) xx) (display y))) ->
+		      ;;    (do ((xx 0) (x 1 (+ x 1)) (y x (- y 1))) ...)
+		      (let ((do-form (cdar body)))
+			(if (pair? do-form)
+			    (lint-format "perhaps ~A" caller
+					 (lists->string form
+							(if (null? (cdr body))    ; do is only expr in let
+							    (list 'do (append varlist (car do-form))
+								  '...)
+							    `(do ,(append varlist (car do-form))
+								 (,(and (pair? (cadr do-form)) (caadr do-form))
+								  ,@(if (side-effect? (cdadr do-form) env) (cdadr do-form) ())
+								  ,@(cdr body))   ; include rest of let as do return value
+							       ...))))))))))))
+
+	  ;; -------- split-let --------
+	  (define (split-let caller form body vars env)
+	    ;; look for splittable lets and let-temporarily possibilities
+	    (for-each
+	     (lambda (local-var)
+	       (let ((vname (var-name local-var)))
+
+		 ;; ideally we'd collect vars that fit into one let etc
+		 (when (> (length body) (* 5 (var-set local-var)) 0)
+		   (do ((i 0 (+ i 1))
+			(preref #f)
+			(p body (cdr p)))
+		       ((or (not (pair? (cdr p)))
+			    (and (pair? (car p))
+				 (eq? (caar p) 'set!)
+				 (eq? (cadar p) vname)
+				 (> i 5)
+				 (begin
+				   (if (or preref
+					   (side-effect? (var-initial-value local-var) env))
+				       ;; (let ((x 32)) (display x) (set! y (f x)) (g (+ x 1) y) (a y) (f y) (g y) (h y) (i y) (set! x 3) (display x) (h y x))
+				       ;;     (let ... (let ((x 3)) ...))
+				       (lint-format "perhaps add a new binding for ~A to replace ~A: ~A" caller
+						    vname
+						    (truncated-list->string (car p))
+						    (lists->string form
+								   `(let ...
+								      (let ((,vname ,(caddar p)))
+									...))))
+				       ;; (let ((x 32)) (set! y (f 1)) (a y) (f y) (g y) (h y) (i y) (set! x (+ x... -> (let () ... (let ((x (+ 32 1))) ...))
+				       (lint-format "perhaps move the ~A binding to replace ~A: ~A" caller
+						    vname
+						    (truncated-list->string (car p))
+						    (let ((new-value (if (lint-tree-memq vname (caddar p))
+									 (tree-subst (var-initial-value local-var) vname (copy (caddar p)))
+									 (caddar p))))
+						      (lists->string form
+								     `(let ,(let rewrite ((lst (cadr form)))
+									      (cond ((null? lst) ())
+										    ((and (pair? (car lst))
+											  (eq? (caar lst) vname))
+										     (rewrite (cdr lst)))
+										    (else (cons (if (< (lint-tree-leaves (cadar lst)) 30)
+												    (car lst)
+												    (list (caar lst) '...))
+												(rewrite (cdr lst))))))
+									...
+									(let ((,vname ,new-value))
+									  ...))))))
+				   #t))))
+		     (if (lint-tree-memq vname (car p))
+			 (set! preref i))))
+
+		 (when (and (zero? (var-set local-var))
+			    (= (var-ref local-var) 2)) ; initial value and set!'s value
+		   (do ((saved-name (var-initial-value local-var))
+			(p body (cdr p))
+			(last-pos #f)
+			(first-pos #f))
+		       ((not (pair? p))
+			(when (and (pair? last-pos)
+				   (not (eq? first-pos last-pos))
+				   (not (tree-equal-member saved-name (cdr last-pos))))
+			  ;; (let ((old-x x)) (set! x 12) (display (log x)) (set! x 1) (set! x old-x)) ->
+			  ;;    (let-temporarily ((x 12)) (display (log x)) (set! x 1))
+			  ;; the pattern (set! x y) ... (set! y x) happens a few times (say 5 to 10)
+			  (lint-format "perhaps use let-temporarily here: ~A" caller
+				       (lists->string form
+						      (let ((new-let (cons 'let-temporarily
+									   (cons (list (list saved-name
+											     (if (pair? first-pos)
+												 (caddar first-pos)
+												 saved-name)))
+										 (map (lambda (expr)
+											(if (or (and (pair? first-pos)
+												     (eq? expr (car first-pos)))
+												(eq? expr (car last-pos)))
+											    (values)
+											    expr))
+										      body)))))
+							(if (null? (cdr vars)) ; we know vars is a pair, want len=1
+							    new-let
+							    (list 'let (map (lambda (v)
+									      (if (eq? (car v) vname)
+										  (values)
+										  v))
+									    (cadr form))
+								  new-let)))))))
+		     ;; someday maybe look for additional saved vars, but this happens only in snd-test
+		     ;;   also the let-temp could be reduced to the set locations (so the tree-equal-member
+		     ;;   check above would be unneeded).
+		     (let ((expr (car p)))
+		       (when (and (len>2? expr)
+				  (eq? (car expr) 'set!)
+				  (equal? (cadr expr) saved-name))
+			 (if (not first-pos)
+			     (set! first-pos p))
+			 (if (eq? (caddr expr) vname)
+			     (set! last-pos p))))))))
+	     vars))
+
+	  ;; -------- let-var->body --------
+	  (define (let-var->body caller form body varlist)
+	    (when (len=1? varlist)
+	      (if (and (len=1? body)                ; (let ((x y)) x) -> y, named let is possible here
+		       (eq? (car body) (caar varlist))
+		       (pair? (cdar varlist)))     ; (let ((a))...)
+		  (lint-format "perhaps ~A" caller (lists->string form (cadar varlist))))
+	      ;; also (let ((x ...)) (let ((y x)...))) happens but it looks like automatically generated code or test suite junk
+
+	      ;; copied from letrec below -- happens about a dozen times
+	      (when (and (list? (cadr form)) ; not named let
+			 (len=1? (cddr form))
+			 (pair? (caddr form)))
+		(let ((body (caddr form))
+		      (sym (caar varlist))
+		      (lform (and (pair? (caadr form))
+				  (pair? (cdaadr form))
+				  (cadar (cadr form)))))
+		  (if (and (len>1? lform)
+			   (eq? (car lform) 'lambda)
+			   (proper-list? (cadr lform)))
+		      ;; unlike in letrec, here there can't be recursion (ref to same name is ref to outer env)
+		      (if (eq? sym (car body))
+			  (if (not (lint-tree-memq sym (cdr body)))
+			      ;; (let ((x (lambda (y) (+ y (x (- y 1)))))) (x 2)) -> (let ((y 2)) (+ y (x (- y 1))))
+			      (lint-format "perhaps ~A" caller
+					   (lists->string form
+							  (cons 'let
+								(cons (map list (cadr lform) (cdr body))
+								      (cddr lform))))))
+			  (if (= (tree-count sym body 2) 1)
+			      (let ((call (find-call sym body)))
+				(when (pair? call)
+				  (let ((new-call (cons 'let
+							(cons (map list (cadr lform) (cdr call))
+							      (cddr lform)))))
+				    ;; (let ((f60 (lambda (x) (* 2 x)))) (+ 1 (f60 y))) -> (+ 1 (let ((x y)) (* 2 x)))
+				    (lint-format "perhaps ~A" caller
+						 (lists->string form (tree-subst new-call call body)))))))))))))
+
+	  ;; -------- combine-lets --------
+	  (define combine-lets
+	    (let ()
+	      (define (letstar env . lets)
+		(let loop ((vars (list 'curlet)) (forms lets))
+		  (and (pair? forms)
+		       (or (and (pair? (car forms))
+				(or (lint-tree-set-memq vars (car forms))
+				    (lint-any? (lambda (a)
+						 (or (not (pair? a))
+						     (not (pair? (cdr a)))
+						     (side-effect? (cadr a) env)))
+					       (car forms))))
+			   (loop (append (map car (car forms)) vars)
+				 (cdr forms))))))
+
+	      (lambda (caller form varlist env)
+		(when (and (pair? (cadr form))
+			   (len=1? (cddr form))
+			   (pair? (caddr form)))
+		  (let ((inner (caddr form))  ; the inner let
+			(outer-vars (cadr form)))
+
+		    (when (len>1? (cdr inner))
+		      (let ((inner-vars (cadr inner)))
+			(when (and (eq? (car inner) 'let)
+				   (symbol? inner-vars))
+			  (let ((named-body (cdddr inner))
+				(named-args (caddr inner)))
+			    (unless (lint-any? (lambda (v)
+						 (or (not (= (lint-tree-count (car v) named-args 2) 1))
+						     (lint-tree-memq (car v) named-body)))
+					       varlist)
+			      (let ((new-args (copy named-args)))
+				(for-each (lambda (v)
+					    (set! new-args (tree-subst (cadr v) (car v) new-args)))
+					  varlist)
+				;; (let ((x 1) (y (f g 2))) (let loop ((a (+ x 1)) (b y)) (loop a b))) -> (let loop ((a (+ 1 1)) (b (f g 2))) (loop a b))
+				(lint-format "perhaps ~A" caller
+					     (lists->string form
+							    (cons 'let
+								  (cons inner-vars
+									(cons new-args named-body)))))))))
+
+			;; maybe more code than this is worth -- combine lets
+			(when (and (memq (car inner) '(let let*))
+				   (pair? inner-vars))
+
+			  (cond ((and (null? (cdadr form))   ; let(1) + let* -> let*
+				      (eq? (car inner) 'let*)
+				      (not (symbol? inner-vars))) ; not named let*
+				 ;; (let ((a 1)) (let* ((b (+ a 1)) (c (* b 2))) (display (+ a b c)))) -> (let* ((a 1) (b (+ a 1)) (c (* b 2))) (display (+ a b c)))
+				 (lint-format "perhaps ~A" caller
+					      (lists->string form
+							     (cons 'let*
+								   (cons (append outer-vars inner-vars)
+									 (one-call-and-dots (cddr inner)))))))
+				((and (len=1? (cddr inner))
+				      (len>1? (caddr inner))
+				      (eq? (caaddr inner) 'let)
+				      (pair? (cadr (caddr inner))))
+				 (let* ((inner1 (cdaddr inner))
+					(inner1-vars (car inner1)))
+				   (if (and (len=1? (cdr inner1))
+					    (len>1? (cadr inner1))
+					    (eq? (caadr inner1) 'let)
+					    (pair? (cadadr inner1)))
+				       (let* ((inner2 (cdadr inner1))
+					      (inner2-vars (car inner2)))
+					 (if (not (letstar env outer-vars
+							   inner-vars
+							   inner1-vars
+							   inner2-vars))
+					     ;; (let ((a 1)) (let ((b 2)) (let ((c 3)) (let ((d 4)) (+ a b c d))))) -> (let ((a 1) (b 2) (c 3) (d 4)) (+ a b c d))
+					     (lint-format "perhaps ~A" caller
+							  (lists->string form
+									 (cons 'let
+									       (cons (append outer-vars inner-vars inner1-vars inner2-vars)
+										     (one-call-and-dots (cdr inner2))))))))
+				       (if (not (letstar env outer-vars
+							 inner-vars
+							 inner1-vars))
+					   ;; (let ((b 2)) (let ((c 3)) (let ((d 4)) (+ a b c d)))) -> (let ((b 2) (c 3) (d 4)) (+ a b c d))
+					   (lint-format "perhaps ~A" caller
+							(lists->string form
+								       (cons 'let
+									     (cons (append outer-vars inner-vars inner1-vars)
+										   (one-call-and-dots (cdr inner1))))))))))
+				((not (letstar env outer-vars
+					       inner-vars))
+				 ;; (let ((c 3)) (let ((d 4)) (+ a b c d))) -> (let ((c 3) (d 4)) (+ a b c d))
+				 (lint-format "perhaps ~A" caller
+					      (lists->string form
+							     (cons 'let
+								   (cons (append outer-vars inner-vars)
+									 (one-call-and-dots (cddr inner)))))))
+
+				((and (null? (cdadr form))   ; 1 outer var
+				      (pair? inner-vars)
+				      (null? (cdadr inner))) ; 1 inner var, dependent on outer
+				 ;; (let ((x 0)) (let ((y (g 0))) (+ x y))) -> (let* ((x 0) (y (g 0))) (+ x y))
+				 (lint-format "perhaps ~A" caller
+					      (lists->string form
+							     (cons 'let*
+								   (cons (append outer-vars inner-vars)
+									 (one-call-and-dots (cddr inner))))))))))))))))
+
+	  ;; -------- tighten-let --------
+	  (define (tighten-let caller form vars env)
+	    (let ((body (cddr form))
+		  (varlist (cadr form)))
+	      (when (and (> (length body) 3)  ; setting this to 1 did not catch anything new
+			 (not (lint-tree-set-memq open-definers body)))
+		;; define et al are like a continuation of the let bindings, so we can't restrict them by accident
+		;;   (let ((x 1)) (define y x) ...)
+		(let ((last-refs (map (lambda (v)
+					(vector (var-name v) #f 0 v))
+				      vars))
+		      (got-lambdas (tree-set-car-member '(lambda lambda*) body)))
+		  ;; (let ((x #f) (y #t)) (set! x (lambda () y)) (set! y 5) (x))
+		  (do ((p body (cdr p))
+		       (i 0 (+ i 1)))
+		      ((null? p)
+		       (let ((end 0))
+			 (for-each (lambda (v)
+				     (set! end (max end (v 2))))
+				   last-refs)
+			 (if (and (< end (/ i lint-let-reduction-factor))
+				  (eq? form lint-current-form)
+				  (< (lint-tree-leaves (car body)) 100))
+			     (let ((old-start (let ((old-pp (lint-pp-funclet '*pretty-print-left-margin*)))
+						(set! (lint-pp-funclet '*pretty-print-left-margin*) (+ lint-left-margin 4))
+						(let ((res (lint-pp (cons 'let
+									  (cons (cadr form)
+										(copy body (make-list (+ end 1))))))))
+						  (set! (lint-pp-funclet '*pretty-print-left-margin*) old-pp)
+						  res))))
+			       (lint-format "this let could be tightened:~%~NC~A ->~%~NC~A~%~NC~A ..." caller
+					    (+ lint-left-margin 4) #\space
+					    (truncated-list->string form)
+					    (+ lint-left-margin 4) #\space
+					    old-start
+					    (+ lint-left-margin 4) #\space
+					    (lint-pp (list-ref body (+ end 1)))))
+			     (begin
+			       ;; look for bindings that can be severely localized
+			       (let ((locals (map (lambda (v)
+						    (if (and (integer? (v 1))
+							     (< (- (v 2) (v 1)) 2)
+							     (code-constant? (var-initial-value (v 3))))
+							v
+							(values)))
+						  last-refs)))
+				 ;; should this omit cases where most of the let is in one or two lines?
+				 (when (pair? locals)
+				   (set! locals (sort! locals (lambda (a b)
+								(or (< (a 1) (b 1))
+								    (< (a 2) (b 2))))))
+				   (do ((lv locals (cdr lv)))
+				       ((null? lv))
+				     (let* ((v (car lv))
+					    (cur-line (v 1)))
+				       (let gather ((pv lv) (cur-vars ()) (max-line (v 2)))
+					 (if (or (null? (cdr pv))
+						 (not (= cur-line ((cadr pv) 1))))
+					     (begin
+					       (set! cur-vars (reverse (cons (car pv) cur-vars)))
+					       (set! max-line (max max-line ((car pv) 2)))
+					       (set! lv pv)
+					       (lint-format "~{~A~^, ~} ~A only used in expression~A (of ~A),~%~NC~A~A of~%~NC~A" caller
+							    (map (lambda (v) (v 0)) cur-vars)
+							    (if (null? (cdr cur-vars)) "is" "are")
+							    (format #f (if (= cur-line max-line)
+									   (values " ~D" (+ cur-line 1))
+									   (values "s ~D and ~D" (+ cur-line 1) (+ max-line 1))))
+							    (length body)
+							    (+ lint-left-margin 6) #\space
+							    (truncated-list->string (list-ref body cur-line))
+							    (if (= cur-line max-line)
+								""
+								(format #f "~%~NC~A"
+									(+ lint-left-margin 6) #\space
+									(truncated-list->string (list-ref body max-line))))
+							    (+ lint-left-margin 4) #\space
+							    (truncated-list->string form)))
+					     (gather (cdr pv)
+						     (cons (car pv) cur-vars)
+						     (max max-line ((car pv) 2)))))))))
+			       (let ((mnv ())
+				     (cur-end i))
+				 (for-each (lambda (v)
+					     (when (and (or (null? mnv)
+							    (<= (v 2) cur-end))
+							(positive? (var-ref (v 3)))
+							(let ((expr (var-initial-value (v 3))))
+							  (not (lint-any? (lambda (ov) ; watch out for shadowed vars
+									    (lint-tree-memq (car ov) expr))
+									  varlist))))
+					       (set! mnv (cons v (if (= (v 2) cur-end) mnv ())))
+					       (set! cur-end (v 2))))
+					   last-refs)
+
+				 ;; look for vars used only at the start of the let
+				 (when (and (pair? mnv)
+					    (< cur-end (/ i lint-let-reduction-factor))
+					    (> (- i cur-end) 3))
+				   ;; mnv is in the right order because last-refs is reversed
+				   (lint-format "the scope of ~{~A~^, ~} could be reduced: ~A" caller
+						(map (lambda (v) (v 0)) mnv)
+						(lists->string form
+							       `(let ,(map (lambda (v)
+									     (if (member (car v) mnv (lambda (a b) (eq? a (b 0))))
+										 (values)
+										 v))
+									   varlist)
+								  (let ,(map (lambda (v)
+									       (list (v 0) (var-initial-value (v 3))))
+									     mnv)
+								    ,@(copy body (make-list (+ cur-end 1))))
+								  ,(list-ref body (+ cur-end 1))
+								  ...)))))))))
+
+		    ;; body of do loop above
+		    (if (and (not got-lambdas)
+			     (pair? (car p))
+			     (pair? (cdr p))
+			     (eq? (caar p) 'set!)
+			     (var-member (cadar p) vars)
+			     (not (lint-tree-memq (cadar p) (cdr p))))
+			(if (not (side-effect? (caddar p) env))     ;  (set! v0 (channel->vct 1000 100)) -> (channel->vct 1000 100)
+			    (lint-format "~A in ~A could be omitted" caller (car p) (truncated-list->string form))
+			    (lint-format "perhaps ~A" caller (lists->string (car p) (caddar p)))))
+		    ;; 1 use in cadr and none thereafter happens a few times, but looks like set-as-documentation mostly
+
+		    (for-each (lambda (v)
+				(when (lint-tree-memq (v 0) (car p))
+				  (set! (v 2) i)
+				  (if (not (v 1)) (set! (v 1) i))))
+			      last-refs))))))
+
+	  ;; -------- let-ends-in-set --------
+	  (define (let-ends-in-set caller form)
+	    (let ((body (cddr form))
+		  (varlist (cadr form)))
+	      ;; if last is (set! local-var...) and no complications, complain
+	      (let ((last (last-ref body)))
+		(when (and (len>2? last)
+			   (eq? (car last) 'set!)
+			   (symbol? (cadr last))
+			   (assq (cadr last) varlist)       ; (let ((a 1) (b (display 2))) (set! a 2))
+			   ;; this is overly restrictive:
+			   (not (lint-tree-set-memq '(call/cc call-with-current-continuation curlet lambda lambda*) form)))
+		  (lint-format "set! is pointless in ~A: use ~A" caller
+			       last (caddr last))))))      ; could add definers here, especially define
+
+	  ;; -------- embed-let --------
+	  (define (embed-let caller form env)
+	    (let ((varlist (cadr form))
+		  (body (cddr form)))
+	      ;; (let ((x 1) (y 2)) (+ x y)) -> (+ 1 2)
+	      ;; this happens a lot, but it often looks like a form of documentation
+	      (when (and (< (length varlist) 8)
+			 (not (or (memq (caar body) '(lambda lambda* define define* define-macro))
+				  (and (eq? (caar body) 'set!)
+				       (lint-any? (lambda (v) (eq? (car v) (cadar body))) varlist))
+				  (any-macro? (caar body) env)
+				  (lint-any? (lambda (p)
+					       (and (unquoted-pair? p)
+						    (or (not (hash-table-ref no-side-effect-functions (car p)))
+							(any-pairs? (cdr p)))))
+					     (cdar body))))
+			 (lint-every? (lambda (v)
+					(and (len>1? v)
+					     (< (lint-tree-leaves (cadr v)) 8)
+					     (= (lint-tree-count (car v) body 2) 1)))
+				      varlist))
+
+		(let ((new-body (copy (car body)))
+		      (bool-arg? #f))
+		  (for-each (lambda (v)
+			      (if (not bool-arg?)
+				  (let tree-walk ((tree body))
+				    (if (pair? tree)
+					(if (and (memq (car tree) '(or and))
+						 (memq (car v) (cdr tree)))
+					    (set! bool-arg? #t)
+					    (begin
+					      (tree-walk (car tree))
+					      (tree-walk (cdr tree)))))))
+			      (set! new-body (tree-subst (cadr v) (car v) new-body)))
+			    varlist)
+		  (lint-format (if bool-arg?
+				   "perhaps, ignoring short-circuit issues, ~A"
+				   "perhaps ~A")
+			       caller (lists->string form new-body))))))
+
+
+	  ;; -------- useless-let --------
+	  (define (useless-let caller form env)
+	    (when (and (pair? (cadr form))         ; (let ((x x)) (+ x 1)) -> (+ x 1), (let ((x x))...) does not copy x if x is a sequence
+		       (lint-every? (lambda (c)
+				      (and (len>1? c)  ; the usual... (let binding might be messed up)
+					   (eq? (car c) (cadr c))))
+				    (cadr form)))
+	      (let ((vs (map car (cadr form))))
+		(unless (lint-any? (lambda (p)
+				     (and (pair? p)
+					  (memq (cadr p) vs)
+					  (or (eq? (car p) 'set!)
+					      (lint-set!? p env))))
+				   (cddr form))
+		  (lint-format "perhaps omit this useless let: ~A" caller
+			       (truncated-lists->string form
+							(if (null? (cdddr form))
+							    (caddr form)
+							    (cons 'begin (cddr form)))))))))
+
+	  ;; -------- let->cond --------
+	  (define let->cond                                ; not named-let here
+	    ;; (let ((x (A))) (if x (f x) B)) -> (cond ((A) => f) (else B)
+	    (let ((wrap-new-form
+		   (lambda (header new-form trailer)
+		     (if (pair? trailer)
+			 `(let ,header ,new-form ,@(if (< (lint-tree-leaves trailer) 20) trailer '(...)))
+			 (if (pair? header)
+			     `(let ,header ,new-form)
+			     new-form)))))
+	      (lambda (caller form env)
+		(let ((body (cddr form)))
+		  (let ((p (car body))
+			(trailer (cdr body))
+			(vname #f)
+			(vvalue #f)
+			(header ()))
+		    (when (let ((varlist (cadr form)))
+			    (lint-any? (lambda (v)
+					 (and (len=2? v)
+					      (< 0 (lint-tree-count (car v) p 5) 4)
+					      (not (lint-tree-memq (car v) trailer))
+					      (begin
+						(set! vname (car v))
+						(set! vvalue (cadr v))
+						(set! header (map (lambda (p)
+								    (if (eq? v p)
+									(values)
+									p))
+								  varlist)))))
+				       varlist))
+		      (let ((suggest made-suggestion)
+			    (pargs (cdr p))
+			    (first-arg (cadr p))
+			    (next-args (cddr p)))
+
+			;; (let ((x (assq a y))) (set! z (if x (cadr x) 0))) -> (set! z (cond ((assq a y) => cadr) (else 0)))
+			(when (and (not (memq (car p) '(if cond))) ; handled separately below
+				   (= (tree-count vname p 3) 2))
+			  (do ((i 0 (+ i 1))
+			       (bp pargs (cdr bp)))
+			      ((or (not (pair? bp))
+				   (let ((b (car bp)))
+				     (and (len>2? b)
+					  (eq? (car b) 'if)
+					  (= (tree-count vname b 3) 2)
+					  (eq? vname (cadr b))
+					  (len=2? (caddr b))
+					  (eq? vname (cadr (caddr b))))))
+			       (if (pair? bp)
+				   (let ((else-clause (if (pair? (cdddar bp)) (list (cons 'else (cdddar bp))) ())))
+				     (lint-format "perhaps ~A" caller
+						  (lists->string form
+								 (wrap-new-form
+								  header
+								  `(,@(copy p (make-list (+ i 1)))
+								    (cond (,vvalue => ,(caaddr (car bp))) ,@else-clause)
+								    ,@(cdr bp))
+								  trailer))))))))
+
+			(when (and (eq? (car p) 'cond) ; (let ((x (f y))) (cond (x (g x)) ...)) -> (cond ((f y) => g) ...)
+				   (len=2? first-arg)
+				   (eq? (car first-arg) vname)
+				   (or (and (len=2? (cadr first-arg))  ; one arg to func
+					    (eq? vname (cadadr first-arg)))
+				       (eq? vname (cadr first-arg)))
+				   (or (null? next-args)
+				       (not (lint-tree-memq vname next-args))))
+			  (lint-format "perhaps ~A" caller
+				       (lists->string form
+						      (wrap-new-form
+						       header
+						       (if (eq? vname (cadr first-arg))
+							   (list 'or vvalue
+								 (if (and (pair? next-args)
+									  (len>1? (car next-args))
+									  (memq (caar next-args) '(else #t t)))
+								     (if (null? (cddar next-args))
+									 (cadar next-args)
+									 (cons 'begin (cdar next-args)))
+								     (cons 'cond next-args)))
+							   (cons 'cond
+								 (cons (list vvalue '=> (caadr first-arg))
+								       next-args)))
+						       trailer))))
+
+			(when (and (null? next-args)         ; (let ((x (+ y 1))) (abs x)) -> (abs (+ y 1))
+				   (eq? vname first-arg))      ;   not tree-subst or trailing (pair) args: the let might be forcing evaluation order
+
+			  (if (or (hash-table-ref built-in-functions (car p))
+				  (let ((v (var-member (car p) env)))
+				    (and v (memq (var-ftype v) '(define define* lambda lambda*))))) ; was definer??
+			      (lint-format "perhaps ~A" caller (lists->string form
+									      (wrap-new-form header (list (car p) vvalue) trailer)))
+			      (if (not (or (any-macro? vname env)
+					   (tree-unquoted-member vname (car p))))
+				  (lint-format "perhaps, assuming ~A is not a macro, ~A" caller (car p)
+					       (lists->string form
+							      (wrap-new-form header (list (car p) vvalue) trailer))))))
+			(when (pair? next-args)
+			  (when (and (eq? (car p) 'if)
+				     (pair? (cdr next-args)))
+			    (let ((if-true (car next-args))
+				  (if-false (cadr next-args)))
+
+			      (when (and (eq? first-arg vname) ; (let ((x (g y))) (if x #t #f)) -> (g y)
+					 (boolean? if-true)
+					 (boolean? if-false)
+					 (not (eq? if-true if-false)))
+				(lint-format "perhaps ~A" caller
+					     (lists->string form
+							    (wrap-new-form header (if if-true vvalue (list 'not vvalue)) trailer))))
+
+			      (when (and (len>1? first-arg) ; (let ((x (f y))) (if (not x) B (g x))) -> (cond ((f y) => g) (else B))
+					 (eq? (car first-arg) 'not)
+					 (eq? (cadr first-arg) vname)
+					 (len=2? if-false)
+					 (eq? vname (cadr if-false)))
+				(let ((else-clause (if (eq? if-true vname)
+						       (list (list 'else #f))
+						       (if (and (pair? if-true)
+								(lint-tree-memq vname if-true))
+							   :oops! ; if the let var appears in the else portion, we can't do anything with =>
+							   (list (list 'else if-true))))))
+				  (unless (eq? else-clause :oops!)
+				    (lint-format "perhaps ~A" caller
+						 (lists->string form
+								(wrap-new-form
+								 header
+								 (cons 'cond (cons (list vvalue '=> (car if-false)) else-clause))
+								 trailer))))))))
+			  (let ((crf #f))
+			    ;; all this stuff still misses (cond ((not x)...)) and (set! y (if x (cdr x)...)) i.e. need embedding in this case
+			    (when (and (or (and (memq (car p) '(if and))          ; (let ((x (f y))) (and x (g x))) -> (cond ((f y) => g) (else #f))
+						(eq? first-arg vname))
+					   (and (eq? (car p) 'or)
+						(equal? first-arg (list 'not vname)))
+					   (and (pair? vvalue)
+						(memq (car vvalue) '(assoc assv assq member memv memq))
+						(len>1? first-arg)                 ; (let ((x (memq z y))) (if (pair? x) (g x))) -> (cond ((memq z y) => g))
+						(or (eq? (car first-arg) 'pair?)
+						    (and (eq? (car first-arg) 'list?)
+							 (lint-format "in ~A, ~A can't be null so pair? might be better" caller p vname)
+							 #t)
+						    (and (eq? (car first-arg) 'null?)   ; (let ((x (assoc y z))) (if (null? x) (g x)))
+							 (lint-format "in ~A, ~A can't be null because ~A in ~A only returns #f or a pair"
+								      caller p vname (car vvalue) (truncated-list->string (list vname vvalue)))
+							 #f))
+						(eq? (cadr first-arg) vname))
+					   (and (pair? vvalue)
+						(memq (car vvalue) '(char-position string-position string->number length arity)) ; length|arity only in s7
+						(or (eq? first-arg vname)
+						    (and (len>1? first-arg)
+							 (or (memq (car first-arg) '(number? complex?))
+							     (and (not (eq? (car vvalue) 'string->number))
+								  (eq? (car first-arg) 'integer?)))
+							 (eq? (cadr first-arg) vname)))))
+
+				       (or (and (len=2? (car next-args))   ; one func arg
+						(or (eq? vname (cadar next-args))
+						    (and (hash-table-ref combinable-cxrs (caar next-args))
+							 ((lambda* (cr arg) ; lambda* not lambda because combine-cxrs might return just #f
+							    (and cr
+								 (< (length cr) 5)
+								 (eq? vname arg)
+								 (set! crf (symbol "c" cr "r"))))
+							  (combine-cxrs (car next-args))))))
+					   (and (eq? (car p) 'if)
+						(eq? (car next-args) vname)
+						(not (tree-unquoted-member vname (cdr next-args))) ; (let ((x (g y))) (if x x (g z))) -> (or (g y) (g z))
+						(lint-format "perhaps ~A" caller
+							     (lists->string form
+									    (wrap-new-form
+									     header
+									     (if (null? (cdr next-args))
+										 vvalue
+										 (list 'or vvalue (cadr next-args)))
+									     trailer)))
+						#f))
+				       (pair? (car next-args))
+				       (or (eq? (car p) 'if)
+					   (null? (cdr next-args))))
+			      (let ((else-clause (if (pair? (cdr next-args))
+						     (if (eq? (cadr next-args) vname)
+							 (list (list 'else #f)) ; this stands in for the local var
+							 (if (and (pair? (cadr next-args))
+								  (lint-tree-memq vname (cadr next-args)))
+							     :oops!   ; if the let var appears in the else portion, we can't do anything with =>
+							     (list (list 'else (cadr next-args)))))
+						     (case (car p)
+						       ((and) '((else #f)))
+						       ((or)  '((else #t)))
+						       (else  ())))))
+				(unless (eq? else-clause :oops!)     ; (let ((x (assoc y z))) (if x (cdr x))) -> (cond ((assoc y z) => cdr))
+				  (lint-format "perhaps ~A" caller
+					       (lists->string form
+							      (wrap-new-form
+							       header
+							       (cons 'cond
+								     (cons (list vvalue '=> (or crf (caar next-args)))
+									   else-clause))
+							       trailer))))))))
+			(when (and (= suggest made-suggestion)
+				   (< (lint-tree-leaves vvalue) 20))
+			  ;; also need to be sure let is not blocking defines or keep (let ()...)? -- never happens I think
+			  (case (car p)
+			    ((cond)
+			     (when (and (pair? pargs)
+					(pair? first-arg)
+					(eq? vname (car first-arg))
+					(= (tree-count vname body 2) 1))
+			       (lint-format "perhaps ~A" caller
+					    (lists->string form
+							   (wrap-new-form header `(cond (,vvalue ,@(cdr first-arg)) ,@next-args) trailer)))))
+			    ((when unless)
+			     (if (and (eq? first-arg vname)
+				      (= (tree-count vname body 2) 1)) ; 2 if we can use cond => (remember cdr)
+				 (lint-format "perhaps ~A" caller
+					      (lists->string form
+							     (wrap-new-form header (tree-subst vvalue vname p) trailer)))))
+			    ((if)
+			     (when (len=3? p)
+			       (if (eq? first-arg vname)
+				   (let ((calls (lint-tree-count vname body 3)))
+				     (if (= calls 1)
+					 (lint-format "perhaps ~A" caller
+						      (lists->string form
+								     (wrap-new-form header (tree-subst vvalue vname p) trailer)))
+					 (let ((true (and (pair? next-args) (car next-args))))
+					   (if (and (= calls 2)
+						    (len=2? true)
+						    (eq? first-arg (cadr true)))
+					       (lint-format "perhaps ~A" caller
+							    (lists->string form
+									   (wrap-new-form header (list 'cond (list vvalue '=> (car true))) trailer)))))))
+				   (if (and (len=2? first-arg)
+					    (eq? (car first-arg) 'not)
+					    (eq? (cadr first-arg) vname)
+					    (= (lint-tree-count vname body 2) 1))
+				       (lint-format "perhaps ~A" caller
+						    (lists->string form
+								   (wrap-new-form header (tree-subst vvalue vname p) trailer))))))))))))))))
+
+	  ;; -------- let->for-each --------
+	  (define (let->for-each caller form varlist body)
+	    (when (and (len>2? body)
+		       (null? (cdr varlist)) ; allowing extra vars gets no additional hits
+		       (pair? (car varlist))
+		       (pair? (cdar varlist))
+		       (pair? (cadar varlist)))
+	      (let ((name (caar varlist))
+		    (value (cadar varlist)))
+		(when (and (eq? (car value) 'lambda)
+			   (pair? (cadr value))
+			   (< 0 (length (cadr value)) 3))
+		  (do ((arg1 ())
+		       (arg2 ())
+		       (p body (cdr p))
+		       (i 0 (+ i 1)))
+		      ((or (null? p)
+			   (not (and (pair? (car p))
+				     (eq? name (caar p)))))
+		       (if (and (>= i 3)
+				(not (lint-tree-memq name p))) ; we could split the body into for-each sections, but that would repeat the lambda
+			   (lint-format "perhaps ~A" caller
+					(lists->string form
+						       (let ((fe (let ((a1 (if (just-code-constants? arg1)
+									       (list #_quote (map unquoted (reverse arg1)))
+									       (cons 'list (reverse arg1))))
+								       (a2 (if (not (pair? arg2))
+									       ()
+									       (if (just-code-constants? arg2)
+										   (list #_quote (map unquoted (reverse arg2)))
+										   (cons 'list (reverse arg2))))))
+								   (if (pair? arg2)
+								       `(for-each ,value ,a1 ,a2)
+								       `(for-each ,value ,a1)))))
+							 (if (null? p)
+							     fe
+							     `(let () ,fe ...)))))))
+		    (set! arg1 (cons (cadar p) arg1))
+		    (if (pair? (cddar p))
+			(set! arg2 (cons (caddar p) arg2))))))))
+
+	  ;; -------- combine set+one-use --------
+	  (define (combine-set+one-use caller body varlist env)
+	    (do ((hits ())
+		 (prev ())
+		 (p body (cdr p))) ; or start at (cdr body)??
+		((not (pair? p))
+		 (for-each (lambda (h)
+			     (lint-format "perhaps combine these two lines:~%~NC~A~%~NC~A" caller
+					  (+ lint-left-margin 4) #\space
+					  (truncated-list->string (car h))
+					  (+ lint-left-margin 4) #\space
+					  (truncated-list->string (caadr h))))
+			   hits))
+	      (let ((call (car p)))
+		(if (not (pair? call))
+		    (set! prev ())
+		    (if (and (eq? (car call) 'set!)
+			     (assq (cadr call) varlist))
+			(set! prev call)
+			(begin
+			  (if (and (pair? prev)
+				   (= (lint-tree-count (cadr prev) call 2) 1)
+				   (not (or (lint-tree-memq (cadr prev) (cdr p))
+					    (hash-table-ref definers-table (car call))
+					    (side-effect? (caddr prev) env) ; this is needed -- let* in effect
+					    (any-macro? (car call) env)
+					    (memq (car call) '(map for-each list-values #_list-values))
+					    (and (eq? (car call) 'let)
+						 (symbol? (cadr call))))) ; i.e. not named-let
+				   (or (not (eq? (car call) 'do))
+				       (and (pair? (caddr call))
+					    (lint-tree-memq (cadr prev) (caddr call)))  ; in the end+result section
+				       (and (pair? (cadr call))
+					    (member (cadr prev) (cadr call) (lambda (a b) (eq? a (cadr b))))))) ; initial value
+			      (set! hits (cons (list prev p) hits)))
+			  (set! prev ())))))))
+
+	  ;; --------- rewrite-funcs --------
+	  (define (rewrite-funcs f)
+	    (let ((def (cdr f)))
+	      (if (symbol? (cadr def))
+		  (cdr def)
+		  (list (caadr def)
+			(cons (if (eq? (car def) 'define*)
+				  'lambda*
+				  'lambda)
+			      (cons (cdadr def)
+				    (if (< (lint-tree-leaves (cddr def)) local-function-context)
+					(cddr def)
+					'(...))))))))
+
+	  ;; -------- let-local-funcs->closure --------
+	  (define (let-local-funcs->closure caller form body largs)
+	    (let ((named-let (symbol? (cadr form))))
+	      (if named-let (set! largs (cons (cadr form) largs)))
+	      (let ((ok-funcs (local-movable-funcs body largs)))
+		(if (eq? body last-lambda-let)       ; remove funcs already moved to the enclosing function's closure
+		    (set! ok-funcs (map (lambda (f)
+					  (if (assq (car f) last-lambda-let-funcs)
+					      (values)
+					      f))
+					ok-funcs)))
+		(when (pair? ok-funcs)
+		  (let* ((func-names (map car ok-funcs))
+			 (letrec? (lint-any? (lambda (f)
+					       (lint-tree-set-memq func-names (cdddr f)))
+					     ok-funcs))
+			 (old-vars (if (< (lint-tree-leaves (cadr form)) local-function-context)
+				       (cadr form)
+				       (list (if (< (lint-tree-leaves (caadr form)) local-function-context)
+						 (caadr form)
+						 (list (caaadr form) '...))
+					     '...))))
+
+		    ;; the letrec has to be added (we can't combine let+letrec) because
+		    ;;   (let ((x 1)) (letrec ((x (+ x 1))) x)) is an error ("+ argument 1, #<undefined>...")
+		    ;;   so the original (let ((x (+ x 1))) (define ...)...) has to be
+		    ;;   (let ((x (+ x 1))) (letrec ...) ...) or the reverse: (let ((x 1)) (letrec (...) (let ((x (+ x 1))) x)))
+		    ;;   there's no straightforward way to say "these entities are independent" if one is a recursive function
+		    ;;     and another shadows but depends on the outer environment!  Also, it's not impossible that letrec here should
+		    ;;     be letrec* in r7rs -- the example below may be incorrect in r7rs.
+		    ;;   I think I'll put the functions on the outside.
+		    ;; (letrec ((f1 () (lambda () (f2 1))) (f2 (lambda () (f1 2))))...) is happy in s7.
+
+		    (lint-format "the inner function~A ~{~A~^, ~} could be moved ~A: ~A" caller
+				 (if (null? (cdr ok-funcs)) "" "s")
+				 func-names
+				 (if named-let
+				     (format #f "out to ~A's closure" (cadr form))
+				     (if letrec?
+					 "to an outer letrec"
+					 "into the let"))
+				 (lists->string form
+						(if named-let
+						    `(,(if letrec? 'letrec 'let) ,(map rewrite-funcs ok-funcs)
+						      (let ,old-vars ...))
+						    (if letrec?
+							`(letrec ,(map rewrite-funcs ok-funcs)
+							   (let ,old-vars ...))
+							`(let (,@old-vars
+							       ,@(map rewrite-funcs ok-funcs))
+							   ...))))))))))
+
+	  ;; -------- let->case-else --------
+	  (define (let->case-else caller form var selector body) ; (let ((q (caddr x))) (if (eq? q 'a) b q)) -> (case (caddr x) ((a) b) (else))
+	    (let ((expr (car body))                             ;   this function also called by let*-walker
+		  (test #f)
+		  (true #f)
+		  (false #f))
+	      ;; scan of multiple vars for useful one got no hits
+	      (when (case (car expr)
+		      ((if) (and (= (length expr) 4)
+				 (pair? (cadr expr))))
+		      ((cond) (and (= (length expr) 3)
+				   (len=2? (cadr expr))
+				   (len=2? (caddr expr))
+				   (pair? (caadr expr))
+				   (eq? (caaddr expr) 'else)))
+		      (else #f))
+		(if (eq? (car expr) 'if)
+		    (begin
+		      (set! test (cadr expr))
+		      (set! true (caddr expr))
+		      (set! false (cadddr expr)))
+		    (begin
+		      (set! test (caadr expr))
+		      (set! true (cadadr expr))
+		      (set! false (cadr (caddr expr)))))
+		  (when (and (memq var test)
+			     (or (and (len=2? test)
+				      (memq (car test) '(null? not eof-object?)))   ; memx/charx got no hits
+				 (and (len=2? (cdr test))
+				      (memq (car test) '(eq? eqv? =))
+				      (lint-any? code-constant? test)))
+			     (or (and (or (eq? false var)
+					  (and (len=2? false)
+					       (eq? var (cadr false))))
+				      (not (lint-tree-memq var true)))  ; shadowing happens very rarely
+				 (and (or (eq? true var)
+					  (and (len=2? true)
+					       (eq? var (cadr true))))
+				      (not (lint-tree-memq var false)))))
+		    (set! last-let->case-line-number line-number)
+		    (lint-format "perhaps use case: ~A" caller
+				 (let ((new-form (let ((key #f))
+						   (if (memq (car test) '(null? not eof-object?))
+						       (set! key (case (car test) ((not) #f) ((eof-object?) #<eof>) (else ())))
+						       (begin
+							 (set! key ((if (eq? (cadr test) var) caddr cadr) test))
+							 (if (pair? key) (set! key (cadr key)))))
+						   (if (or (eq? false var)
+							   (and (len=2? false)
+								(eq? var (cadr false))))
+						       `(case ,selector
+							  ((,key) ,true)
+							  (else ,@(if (eq? false var) () (list '=> (car false)))))
+						       `(case ,selector
+							  ((,key) ,@(if (eq? true var) () (list '=> (car true))))
+							  (else ,false))))))
+				   (lists->string form
+						  (if (or (eq? (car form) 'let)
+							  (null? (cdadr form)))
+						      new-form
+						      (if (null? (cddadr form))
+							  `(let (,(caadr form))
+							     ,new-form)
+							  `(let* ,(copy (cadr form) (make-list (- (length (cadr form)) 1)))
+							     ,new-form))))))))))
+
+	  ;; -------- let-walker --------
+
+	  (define let-walker
+	    (let ((input-side-effect-functions '(;set-current-input-port close-input-port open-input-file open-input-string
+						 read-char peek-char read-byte read-line read-string read))
+		  (output-side-effect-functions '(;set-current-output-port close-output-port flush-output-port open-output-file open-output-string
+						  ;get-output-string call-with-output-string call-with-output-file with-output-to-file
+						  newline write-char write-string display write write-byte format)))
+
+	      ;; need port extractors for each of these
+	      (define (extract-port init)
+		(if (pair? (cdr init))
+		    (cadr init)
+		    ()))
+
+	      (lambda (caller form env)
+		(if (or (< (length form) 3)             ; (let ((a 1) (set! a 2)))
+			(not (or (symbol? (cadr form))
+				 (list? (cadr form)))))
+		    (lint-format "let is messed up: ~A" caller (truncated-list->string form))
+
+		    (let ((named-let (and (symbol? (cadr form)) (cadr form))))
+		      (if (keyword? named-let)          ; (let :x ((i y)) (x i))
+			  (lint-format "bad let name: ~A" caller named-let))
+
+		      (if named-let
+			  (if *report-shadowed-variables*
+			      (report-shadower caller 'let 'named-let-function-name named-let named-let env))
+			  (remove-null-let caller form env))
+
+		      (let ((vars (declare-named-let form env))
+			    (varlist ((if named-let caddr cadr) form))
+			    (body ((if named-let cdddr cddr) form)))
+
+			(if (not (and (proper-list? varlist)
+				      (just-pairs? varlist)))
+			    (lint-format "let is messed up: ~A" caller (truncated-list->string form))
+			    (begin
+			      (if (and (null? varlist)
+				       (len=1? body)
+				       (not (side-effect? (car body) env))) ; (let xx () z)
+				  (lint-format "perhaps ~A" caller (lists->string form (car body))))
+
+			      (set! vars (walk-let-vars caller form varlist vars env))
+
+			      (when (and (pair? body)
+					 (pair? vars)
+					 (func-definer? (car body)))
+				(let-local-funcs->closure caller form body (map var-name vars)))
+			      ;; here we could check '+signature+ and others, but it is tricky to tell that
+			      ;;   var-initial-value is messed up
+
+			      (let ((suggest made-suggestion))
+				(unless named-let
+				  (when (and (pair? varlist)
+					     (pair? body)
+					     (len>1? (car body)))
+				    (let->cond caller form env)
+				    (when (null? (cdr body))
+				      (if (and ;(= suggest made-suggestion)
+					   (null? (cdr varlist))
+					   (pair? (cdar varlist)))
+					  (let->case-else caller form (caar varlist) (cadar varlist) body))
+				      (move-let-into-if caller form env)
+				      (when (= suggest made-suggestion)
+					(embed-let caller form env))))
+				  (when (= suggest made-suggestion)
+				    (useless-let caller form env)))
+
+				;; let ((x <init1>) (y <init2)) -> varlist: '((x <init1>) (y <init2>))
+				;;   if init1 and init2 have side-effect contention, suggest let*
+				;;   (let ((x (read-char)) (y (peek-char)) ...) -> (let* ...)
+				;; see also check-unordered-exprs above (sigh) -- I missed it when I wrote this code
+				(when (and (pair? varlist)
+					   (pair? (cdr varlist)))
+				  (let ((hits (map (lambda (var)
+						     (if (and (pair? (cdr var))
+							      (pair? (cadr var)))
+							 (if (memq (caadr var) input-side-effect-functions)
+							     (list :input var)
+							     (if (memq (caadr var) output-side-effect-functions)
+								 (list :output var)
+								 (values)))
+							 (values)))
+						   varlist)))
+				    (when (and (pair? hits)
+					       (pair? (cdr hits)))
+				      (let loop1 ((cur-var (car hits)) (rest (cdr hits)))
+					(let* ((cur-init (cadadr cur-var))
+					       (cur-port (extract-port cur-init)) ; can be #f
+					       (got-hit #f))
+					  (let loop2 ((rst-var rest))
+					    (when (pair? rst-var)
+					      (if (and (eq? (car cur-var) (caar rst-var))
+						       cur-port ; not #f
+						       (equal? cur-port (extract-port (cadr (cadar rst-var)))))
+						  ;; or equal? one to () and the other to current-input|output-port
+						  (begin
+						    (lint-format "in ~S, let should be let*" caller (truncated-list->string form))
+						    (set! got-hit #t))
+						  (loop2 (cdr rst-var)))))
+					  (unless (or got-hit (null? rest))
+					    (loop1 (car rest) (cdr rest))))))))
+
+				(let ((es (walk-letx-body caller form body vars env)))
+				  (set! vars (car es))
+				  (set! env (cdr es)))
+
+				(when (pair? vars)
+				  (unless (or named-let
+					      (not *report-combinable-lets*))
+				    (evert-function-locals form vars env))
+				  (when (and (pair? (cadr form))
+					     (pair? (caadr form)))
+				    (split-let caller form body vars env)))
+
+				(let-var->body caller form body varlist)
+
+				(when (pair? body)
+				  (when (len>2? (car body))
+				    (let-body->value caller form vars env))
+				  (when (and (pair? varlist)
+					     (not named-let))
+				    (let->for-each caller form varlist body)
+				    (let-ends-in-set caller form)
+				    (when (and (pair? (car body))
+					       (eq? (caar body) 'do))
+				      (normal-let->do caller form env))
+				    (tighten-let caller form vars env)
+				    (if (= suggest made-suggestion)
+					(combine-set+one-use caller body varlist env)))))
+
+			      (combine-lets caller form varlist env))))))
+		env)))
+	  (hash-walker 'let let-walker)
+
+
+	  ;; -------- let*->let+do --------
+	  (define (let*->let+do caller form env)
+	    (let ((body (cddr form))
+		  (varlist (cadr form)))
+	      ;; let*->do (could go further down)
+	      (when (and *report-combinable-lets*
+			 (pair? body)
+			 (pair? (car body))
+			 (eq? (caar body) 'do)
+			 (len>2? (car body))
+			 (just-len>1? (cadar body))
+			 (< (lint-tree-leaves (cdr body)) *max-cdr-len*))
+		(let ((inits (if (pair? (cadar body))
+				 (map cadr (cadar body))
+				 ()))
+		      (locals (if (pair? (cadar body))
+				  (map car (cadar body))
+				  ()))
+		      (lv (list-ref varlist (- (length varlist) 1))))
+		  (unless (and (pair? inits)
+			       (or (memq (car lv) locals) ; shadowing
+				   (lint-tree-memq (car lv) inits)
+				   (not (pair? (cdr lv)))
+				   (side-effect? (cadr lv) env)))
+		    ;; (let* ((x (log z))) (do ((i 0 (+ x z))) ((= i 3)) (display x))) -> (do ((x (log z)) (i 0 (+ x z))) ...)
+		    (lint-format "perhaps ~A" caller
+				 (lists->string form
+						(let ((new-do (let ((do-form (cdar body)))
+								(if (null? (cdr body))
+								    (list 'do (cons lv (car do-form))
+									  '...)
+								    `(do ,(cons lv (car do-form))
+									 (,(and (pair? (cadr do-form)) (caadr do-form))
+									  ,@(if (side-effect? (cdadr do-form) env) (cdadr do-form) ())
+									  ,@(cdr body))   ; include rest of let as do return value
+								       ...)))))
+						  (case (length varlist)
+						    ((1) new-do)
+						    ((2) (list 'let (list (car varlist)) new-do))
+						    (else (list 'let* (copy varlist (make-list (- (length varlist) 1)))
+								new-do)))))))))))
+
+	  ;; -------- walk-let*-vars --------
+	  (define (walk-let*-vars caller form vars env)
+	    (let* ((named-let (and (symbol? (cadr form)) (cadr form)))
+		   (varlist ((if named-let caddr cadr) form)))
+	      (do ((side-effects #f)
+		   (bindings varlist (cdr bindings)))
+		  ((null? bindings)
+		   (if (or (null? varlist)
+			   (len=1? varlist)                  ; (let* ((x (log y))) x)
+			   (not (or side-effects             ; (let* ((x (log y)) (z 32))...)
+				    (lint-any? (lambda (v) (positive? (var-ref v))) vars))))
+		       (lint-format "let* could be let: ~A" caller (truncated-list->string form))))
+		;; in s7, let evaluates var values top down, so this message is correct
+		;;   even in cases like (let ((ind (open-sound...)) (mx (maxamp))) ...)
+		;; in r7rs, the order is not specified (section 4.2.2 of the spec), so
+		;;   here we would restrict this message to cases where there is only
+		;;   one variable, or where subsequent values are known to be independent.
+		;; if each function could tell us what globals it depends on or affects,
+		;;   we could make this work in all cases.
+
+		(when (binding-ok? caller 'let* (car bindings) env #f)
+		  (let ((expr (cadar bindings))
+			(side (side-effect? (cadar bindings) env)))
+		    (if (not (or (eq? bindings varlist)
+				 ;; first var side-effect is innocuous (especially if it's the only one!)
+				 ;;    does this need to protect against a side-effect that the next var accesses?
+				 ;;    I think we're ok -- the accessed var must be exterior, and we go down in order
+				 side-effects))
+			(set! side-effects side))
+		    (let ((e (lint-walk caller expr (append vars env))))
+		      (if (and (pair? e)
+			       (not (eq? e env))
+			       (memq (var-name (car e)) '(:lambda :dilambda)))
+			  (let ((ldata (cdar e)))
+			    (set! (var-name (car e)) (caar bindings))
+			    (let-set! ldata 'initial-value expr)
+			    (set! vars (cons (car e) vars)))
+			  (set! vars (cons (make-lint-var (caar bindings) expr (if named-let 'named-let* 'let*))
+					   vars))))
+
+		    ;; look for duplicate values
+		    ;;   someday protect against any shadows if included in any expr
+		    (unless (or side
+				(not (pair? expr))
+				(code-constant? expr)
+				(maker? expr))
+		      (let ((name (caar bindings)))
+			(let dup-check ((vs (cdr vars)))
+			  (if (and (pair? vs)
+				   (pair? (car vs))
+				   (not (eq? name (caar vs)))
+				   (not (lint-tree-memq (caar vs) expr)))
+			      ;; perhaps also not side-effect of car vs initial-value (char-ready? + read + char-ready? again)
+			      (if (equal? expr (var-initial-value (car vs)))
+				  ;; (let* ((x (log y 2)) (y (log y 2)) (z (f x))) (+ x y z z))
+				  (lint-format "~A's value ~S could be ~S" caller
+					       name expr (caar vs))
+				  (dup-check (cdr vs))))))))))
+	      vars))
+
+	  ;; -------- let*->let+let --------
+	  (define (let*->let+let caller form vars env)
+	    ;; if var is not used except in other var bindings, it can be moved out of this let*
+	    ;;   collect vars not in body, used in only one binding, gather these cases, and rewrite the let*
+	    ;;   repeated names are possible here
+	    ;;   also cascading dependencies: (let* ((z 1) (y (+ z 2)) (x (< y 3))) (if x (f x)))
+	    ;;                                (let ((x (let ((y (let ((z 1))) (+ z 2))) (< y 3)))) ...) ??
+	    ;;                      new-vars: ((z y) (y x))
+	    (let ((body (cddr form))
+		  (new-vars ())
+		  (vs-pos vars)
+		  (no-repeats (do ((p vars (cdr p)))
+				  ((or (null? p)
+				       (var-member (var-name (car p)) (cdr p)))
+				   (null? p)))))
+	      (for-each (lambda (v)
+			  (let ((vname (var-name v))
+				(vvalue #f))
+			    (if (not (lint-tree-memq vname body))
+				(let walker ((vs vars))
+				  (if (not (pair? vs))
+				      (if (and vvalue
+					       (or (not (side-effect? (var-initial-value v) env))
+						   (eq? vvalue (var-name (car vs-pos)))))
+					  (set! new-vars (cons (list vvalue vname (var-initial-value v)) new-vars)))
+				      (let ((b (car vs)))
+					(if (or (eq? (var-name b) vname)
+						(not (lint-tree-memq vname (var-initial-value b)))) ; tree-memq matches the bare symbol (tree-member doesn't)
+					    (walker (cdr vs))
+					    (unless vvalue
+					      (set! vvalue (var-name b))
+					      (walker (cdr vs))))))))
+			    (set! vs-pos (cdr vs-pos))))
+			(cdr vars)) ; vars is reversed from code order, new-vars is in code order
+
+	      (when (pair? new-vars)
+		(define (gather-dependencies var val env)
+		  (let ((deps ()))
+		    (for-each (lambda (nv)
+				(if (and (eq? (car nv) var)
+					 (or no-repeats
+					     (lint-tree-memq (cadr nv) val)))
+				    (set! deps (cons (list (cadr nv)
+							   (gather-dependencies (cadr nv) (caddr nv) env))
+						     deps))))
+			      new-vars)
+		    (if (> (lint-tree-leaves val) 30)
+			(set! val '...))
+		    (if (pair? deps)
+			(list (if (null? (cdr deps)) 'let 'let*) deps val)
+			val)))
+
+		(let ((new-let-binds (map (lambda (v)
+					    (if (member (var-name v) new-vars (lambda (name lst) (eq? name (cadr lst))))
+						(values)
+						(list (var-name v)
+						      (gather-dependencies (var-name v) (var-initial-value v) env))))
+					  (reverse vars))))
+		  ;; (let* ((a 1) (b 2) (c (+ a 1))) (* c 2)) -> (let* ((b 2) (c (let ((a 1)) (+ a 1)))) ...)
+		  (lint-format "perhaps restrict ~{~A~^, ~} which ~A not used in the let* body ~A" caller
+			       (map cadr new-vars)
+			       (if (null? (cdr new-vars)) "is" "are")
+			       (lists->string form
+					      (list (if (null? (cdr new-let-binds)) 'let 'let*)
+						    new-let-binds
+						    '...)))))
+
+	      (when (and no-repeats
+			 *report-splittable-lets*
+			 (len>2? vars))
+		(let ((outer-vars ())
+		      (inner-vars ())
+		      (let-vars ())
+		      (cur-vars ())
+		      (varlist ((if (symbol? (cadr form)) caddr cadr) form)))
+		  (do ((vs (reverse vars) (cdr vs)))
+		      ((null? vs))
+
+		    (let* ((v (car vs))
+			   (vname (var-name v))
+			   (value (var-initial-value v)))
+
+		      (if (or (side-effect? value env)
+			      (lint-any? (lambda (trailing-var)
+					   ;; vname is possible inner let var if it is not mentioned in any trailing initial value
+					   ;;   (repeated name can't happen here)
+					   (lint-tree-memq vname (var-initial-value trailing-var)))
+					 (cdr vs)))
+			  (set! outer-vars (cons vname outer-vars))
+			  (set! inner-vars (cons vname inner-vars)))
+
+		      (if (and (not (and (pair? value)
+					 (memq (car value) cur-vars)))
+			       (constant-expression? value env)
+			       (do ((oldv varlist (cdr oldv)))
+				   ((or (null? oldv)
+					(lint-tree-memq vname (car oldv)))
+				    (and (pair? oldv)
+					 (pair? (car oldv))
+					 (eq? vname (caar oldv))))))
+			  (set! let-vars (cons vname let-vars)))
+		      (set! cur-vars (cons vname cur-vars))))
+
+		  (when (and (pair? outer-vars)
+			     (or (len>1? let-vars)
+				 (len>1? inner-vars)))
+		    (let ((lv ())
+			  (ov ())
+			  (iv ())
+			  (truncate-value
+			   (lambda (v)
+			     (list v (let ((val (var-initial-value (var-member v vars))))
+				       (if (and (pair? val)
+						(> (lint-tree-leaves val) 20))
+					   (list (car val) '...)
+					   val))))))
+		    (when (len>1? let-vars)
+		      (set! outer-vars (remq-set let-vars outer-vars))
+		      (set! inner-vars (remq-set let-vars inner-vars))
+		      (set! lv (map truncate-value let-vars)))
+
+		    (if (pair? outer-vars)
+			(set! ov (map truncate-value outer-vars)))
+
+		    (if (len>1? inner-vars)
+			(set! iv (map truncate-value inner-vars))
+			(if (pair? inner-vars)
+			    (set! ov (cons (truncate-value (car inner-vars)) ov))))
+
+		    (set! ov (if (null? ov)
+				 (list 'let (reverse iv) '...)
+				 (list (if (pair? (cdr ov)) 'let* 'let)
+				       (reverse ov)
+				       (if (pair? iv)
+					   (list 'let (reverse iv) '...)
+					   '...))))
+		    (set! lv (if (pair? lv)
+				 (list 'let (reverse lv) ov)
+				 ov))
+
+		    (lint-format "perhaps split this let*: ~A" caller
+				 (lists->string form lv))))))))
+
+
+	  ;; -------- let*+let*->let*
+	  (define (let*+let*->let* caller form)
+	    (let ((varlist (cadr form))
+		  (body (cddr form)))
+	      ;; successive let*'s combined into one
+	      (when (and (len>1? (car body))
+			 (or (eq? (caar body) 'let*)      ; let*+let* -> let*
+			     (and (eq? (caar body) 'let)  ; let*+let(1) -> let*
+				  (or (null? (cadar body))
+				      (and (pair? (cadar body))
+					   (null? (cdadar body))))))
+			 (null? (cdr body))
+			 (not (symbol? (cadar body))))
+		;; (let* ((a 1) (b (+ a 2))) (let* ((c (+ b 3)) (d (+ c 4))) (display a) (+ a... ->
+		;;    (let* ((a 1) (b (+ a 2)) (c (+ b 3)) (d (+ c 4))) (display a) ...)
+		(lint-format "perhaps ~A" caller
+			     (lists->string form
+					    (cons 'let*
+						  (cons (append varlist (cadar body))
+							(one-call-and-dots (cddar body)))))))))
+
+	  ;; -------- remove-unneeded-let*-vars --------
+	  (define (remove-unneeded-let*-vars caller form env)
+	    (do ((body (cddr form))
+		 (changes ())
+		 (vs (cadr form) (cdr vs)))
+		((null? vs)
+		 (if (pair? changes)
+		     (let ((new-form (copy form)))
+		       (for-each
+			(lambda (v)
+			  (list-set! new-form 1 (remove-if (lambda (p) (equal? p v)) (cadr new-form)))
+			  (set! new-form (tree-subst (cadr v) (car v) new-form)))
+			changes)
+		       ;; (let* ((x y) (a (* 2 x))) (+ (f a (+ a 1)) (* 3 x))) -> (let ((a (* 2 y))) (+ (f a (+ a 1)) (* 3 y)))
+		       (lint-format "assuming we see all set!s, the binding~A ~{~A~^, ~} ~A pointless: perhaps ~A" caller
+				    (if (pair? (cdr changes)) "s" "")
+				    changes
+				    (if (pair? (cdr changes)) "are" "is")
+				    (lists->string form
+						   (let ((header (if (len>1? (cadr new-form)) 'let* 'let)))
+						     (cons header
+							   (if (< (lint-tree-leaves new-form) 200)
+							       (cdr new-form)
+							       (cons (cadr new-form)
+								     (one-call-and-dots (cddr new-form)))))))))))
+	      (let ((v (car vs)))
+		(if (and (len=2? v)
+			 (symbol? (cadr v))
+			 (not (assq (cadr v) (cadr form))) ; value is not a local var
+			 (not (set-target (car v) body env))
+			 (not (set-target (cadr v) body env)))
+		    (let ((data (var-member (cadr v) env)))
+		      (if (and (or (not data)
+				   (and (not (eq? (var-definer data) 'parameter))
+					(or (null? (var-setters data))
+					    (not (lint-tree-set-memq (var-setters data) body)))))
+			       (not (lint-any? (lambda (p)
+						 (and (len>1? p)
+						      (or (set-target (cadr v) (cdr p) env)
+							  (set-target (car v) (cdr p) env)
+							  (and data
+							       (pair? (var-setters data))
+							       (lint-tree-set-memq (var-setters data) body)))))
+					       (cdr vs))))
+			  (set! changes (cons v changes))))))))
+
+	  ;; -------- combine-let*-vars --------
+	  (define (combine-let*-vars caller form vars env)
+	    ;; successive vars, first used in second but nowhere else -- combine if (very!) simple-looking
+	    (let ((varlist (cadr form))
+		  (body (cddr form)))
+	      (do ((gone-vars ())
+		   (v varlist (cdr v)))
+		  ((or (null? v)
+		       (null? (cdr v)))
+
+		   (when (pair? gone-vars)
+		     (let ((waiter #f)
+			   (new-vars ())
+			   (save-vars ()))
+		       (set! gone-vars (reverse gone-vars))
+		       (set! new-vars (map (lambda (v)
+					     (if (and (pair? gone-vars)
+						      (eq? v (car gone-vars)))
+						 (begin
+						   (set! waiter v)
+						   (set! gone-vars (cdr gone-vars))
+						   (values))
+						 (if (not waiter)
+						     v
+						     (let ((new-v (tree-subst (cadr waiter) (car waiter) v)))
+						       (set! save-vars (cons (list (car waiter) (car v)) save-vars))
+						       (set! waiter #f)
+						       new-v))))
+					   varlist))
+		       ;; (let* ((y 3) (x (log y))) x) -> (let ((x (log 3))) ...)
+		       (lint-format "perhaps substitute ~{~{~A into ~A~}~^, ~}: ~A" caller
+				    (reverse save-vars)
+				    (lists->string form
+						   (list (if (null? (cdr new-vars)) 'let 'let*)
+							 new-vars
+							 '...))))))
+		(let ((cur-var (car v))
+		      (nxt-var (cadr v)))
+		  (when (and (len>1? cur-var)
+			     (let ((v (var-member (car cur-var) vars)))
+			       (and v
+				    (zero? (var-set v))))
+			     (len>1? nxt-var)
+			     (< (lint-tree-leaves (cadr cur-var)) 8)
+			     (not (and (len>1? (cadr nxt-var))
+				       (eq? (caadr nxt-var) 'let) ; if named-let, forget it
+				       (symbol? (cadadr nxt-var))))
+			     (or (not (pair? (cadr nxt-var)))
+				 (not (side-effect? (cadr cur-var) env))
+				 (lint-every? (lambda (a)
+						(or (code-constant? a)
+						    (assq a varlist)))
+					      (cdadr nxt-var)))
+			     (and (pair? (cadr nxt-var))
+				  (= (tree-count (car cur-var) (cadr nxt-var) 2) 1))
+			     (not (lint-tree-memq (car cur-var) (cddr v)))
+			     (not (lint-tree-memq (car cur-var) body)))
+		    (set! gone-vars (cons cur-var gone-vars))
+		    (set! v (cdr v)))))))
+
+	  ;; -------- combine-let*-last-var --------
+	  (define (combine-let*-last-var caller form last-var env)
+	    ;; if last var only occurs once in body, and timing can't be an issue, substitute its value
+	    ;;   this largely copied from the let case above (but only one substitution)
+	    ;;   in both cases, we're assuming that the possible last-var value's side-effect won't
+	    ;;      affect other vars (in let* the local, in let something outside that might be used locally)
+	    ;;      perhaps add (not (side-effect (cadr last-var) env))?
+	    (let ((body (cddr form))
+		  (varlist (cadr form)))
+	      (let ((varlist-len (length varlist)))
+		(when (and (pair? (cdr last-var))  ; varlist-len can be 1 here
+			   (< (lint-tree-leaves (cadr last-var)) 12)
+			   (= (lint-tree-count (car last-var) body 2) 1)
+			   (pair? (car body))
+			   (null? (cdr body))
+			   (not (memq (caar body) '(lambda lambda* define define* define-macro)))
+			   (not (and (eq? (caar body) 'set!)
+				     (eq? (car last-var) (cadar body))))
+			   (not (any-macro? (caar body) env))
+			   (not (lint-any? (lambda (p)
+					     (and (unquoted-pair? p)
+						  (or (not (hash-table-ref no-side-effect-functions (car p)))
+						      (any-pairs? (cdr p)))))
+					   (cdar body))))
+		  ;; (let* ((a 1) (b 2) (c (+ a 1))) (* c 2)) -> (let* ((a 1) (b 2)) (* (+ a 1) 2))
+		  (lint-format "perhaps ~A" caller
+			       (lists->string form (cons (if (<= varlist-len 2) 'let 'let*)
+							 (cons (copy varlist (make-list (- varlist-len 1)))
+							       (tree-subst (cadr last-var) (car last-var) body))))))
+
+		(when (null? (cdr body)) ; (let* (...(x A)) (if x (f A) B)) -> (let(*) (...) (cond (A => f) (else B)))
+		  (when (pair? (cdr last-var))
+		    (let ((p (car body)))
+		      (when (and (len>2? p)
+				 (case (car p)
+				   ((if and) (eq? (cadr p) (car last-var)))
+				   ((or)     (equal? (cadr p) (list 'not (car last-var))))
+				   (else #f))
+				 (len=2? (caddr p))
+				 (or (eq? (car p) 'if)
+				     (null? (cdddr p)))
+				 (not (eq? (caaddr p) (car last-var))) ; ! (let* (...(x A)) (if x (x x)))
+				 (eq? (car last-var) (cadr (caddr p))))
+
+			(let ((else-clause (if (pair? (cdddr p)) ; only if 'if (see above)
+					       (if (eq? (cadddr p) (car last-var))
+						   `((else #f)) ; this stands in for the local var
+						   (if (and (pair? (cadddr p))
+							    (lint-tree-memq (car last-var) (cadddr p)))
+						       :oops! ; if the let var appears in the else portion, we can't do anything with =>
+						       (list (list 'else (cadddr p)))))
+					       (case (car p)
+						 ((and) '((else #f)))
+						 ((or)  '((else #t)))
+						 (else  ())))))
+			  (unless (eq? else-clause :oops!)
+			    ;; (let* ((x (f y))) (and x (g x))) -> (cond ((f y) => g) (else #f)
+			    (lint-format "perhaps ~A" caller
+					 (case varlist-len
+					   ((1) (lists->string form
+							       (cons 'cond
+								     (cons (list (cadr last-var) '=> (caaddr p))
+									   else-clause))))
+					   ((2) (lists->string form
+							       `(let (,(car varlist))
+								  (cond (,(cadr last-var) => ,(caaddr p)) ,@else-clause))))
+					   (else (lists->string form
+								`(let* ,(copy varlist (make-list (- varlist-len 1)))
+								   (cond (,(cadr last-var) => ,(caaddr p)) ,@else-clause)))))))))))
+
+		  (unless (pair? (car body))
+		    (if (and (eq? (car body) (caar varlist))
+			     (null? (cdr varlist))
+			     (pair? (cdar varlist)))       ; (let* ((a...)) a)
+			;; (let* ((x (log y))) x) -> (log y)
+			(lint-format "perhaps ~A" caller (lists->string form (cadar varlist)))
+			(if (and (> varlist-len 1)         ; (let* (... (x y)) x) -> (let(*)(...) y)
+				 (len=2? last-var)
+				 (eq? (car body) (car last-var)))
+			    ;; (let* ((y 3) (x (log y))) x) -> (let ((y 3)) (log y))
+			    (lint-format "perhaps ~A" caller
+					 (lists->string form (list (if (= varlist-len 2) 'let 'let*)
+								   (copy varlist (make-list (- varlist-len 1)))
+								   (cadr last-var)))))))))))
+
+	  ;; -------- reduce-let*-scope
+	  (define (reduce-let*-scope caller form vars)
+	    (let ((lastref (vector (var-name (car vars)) #f 0 (car vars))) ; this is the last of the let* vars I think
+		  (body (cddr form))
+		  (varlist (cadr form)))
+	      (do ((p body (cdr p))
+		   (i 0 (+ i 1)))
+		  ((null? p)
+		   (let ((cur-line (lastref 1))
+			 (max-line (lastref 2))
+			 (vname (lastref 0)))
+		     (if (and (< max-line (/ i lint-let-reduction-factor))
+			      (> (- i max-line) 3))
+			 (lint-format "the scope of ~A could be reduced: ~A" caller
+				      vname
+				      (lists->string form
+						     `(,(if (> (length vars) 2) 'let* 'let)
+						       ,(copy varlist (make-list (- (length vars) 1)))
+						       (let (,(list vname (var-initial-value (lastref 3))))
+							 ,@(copy body (make-list (+ max-line 1))))
+						       ,(list-ref body (+ max-line 1))
+						       ...)))
+			 (when (and (integer? cur-line)
+				    (< (- max-line cur-line) 2)
+				    (code-constant? (var-initial-value (lastref 3))))
+			   (lint-format "~A is only used in expression~A (of ~A),~%~NC~A~A of~%~NC~A" caller
+					vname
+					(format #f (if (= cur-line max-line)
+						       (values " ~D" (+ cur-line 1))
+						       (values "s ~D and ~D" (+ cur-line 1) (+ max-line 1))))
+					(length body)
+					(+ lint-left-margin 6) #\space
+					(truncated-list->string (list-ref body cur-line))
+					(if (= cur-line max-line)
+					    ""
+					    (format #f "~%~NC~A"
+						    (+ lint-left-margin 6) #\space
+						    (truncated-list->string (list-ref body max-line))))
+					(+ lint-left-margin 4) #\space
+					(truncated-list->string form))))) )
+		(when (lint-tree-memq (lastref 0) (car p))
+		  (set! (lastref 2) i)
+		  (if (not (lastref 1)) (set! (lastref 1) i))))))
+
+	  ;; -------- let*-local-funcs->closure --------
+	  (define (let*-local-funcs->closure caller form body largs)
+	    (let ((ok-funcs (local-movable-funcs body largs)))
+	      (when (pair? ok-funcs)
+		(let* ((func-names (map car ok-funcs))
+		       (letrec? (lint-any? (lambda (f)
+					     (lint-tree-set-memq func-names (cdddr f)))
+					   ok-funcs)))
+		  (lint-format "the inner function~A ~{~A~^, ~} could be moved out of the let*: ~A" caller
+			       (if (null? (cdr ok-funcs)) "" "s")
+			       func-names
+			       (lists->string form
+					      `(,(if letrec? 'letrec 'let) ,(map rewrite-funcs ok-funcs)
+						 (let* ,(if (> (lint-tree-leaves (cadr form)) local-function-context)
+							    (list (caadr form) '...)
+							    (cadr form))
+						   ...))))))))
+
+	  ;; -------- let*-walker --------
+	  (define (let*-walker caller form env)
+	    (if (< (length form) 3)
+		(lint-format "let* is messed up: ~A" caller (truncated-list->string form))
+		(let ((named-let (and (symbol? (cadr form)) (cadr form))))
+		  (let ((vars (declare-named-let form env))
+			(varlist ((if named-let caddr cadr) form))
+			(body ((if named-let cdddr cddr) form)))
+
+		    (if (and named-let
+			     *report-shadowed-variables*)
+			(report-shadower caller 'let* 'named-let*-function-name named-let named-let env))
+
+		    (if (not (and (proper-list? varlist)
+				  (just-pairs? varlist)))
+			(lint-format "let* is messed up: ~A" caller (truncated-list->string form))
+			(begin
+			  (when (and (pair? body)
+				     (pair? varlist)
+				     (func-definer? (car body)))
+			    (let*-local-funcs->closure caller form body
+						       (if named-let
+							   (cons (cadr form) (map car varlist))
+							   (map car varlist))))
+
+			  (let ((es (walk-letx-body caller form body
+						    (walk-let*-vars caller form vars env)
+						    env)))
+			    (set! vars (car es))
+			    (set! env (cdr es)))
+
+			  (when (and (not named-let)
+				     (pair? body)
+				     (proper-pair? varlist))
+			    (when (pair? vars)
+			      (let*->let+let caller form vars env))
+			    (let*+let*->let* caller form)
+			    (let*->let+do caller form env)
+			    ;; (define...) as first in body rarely happens in rewritable contexts
+
+			    (unless (unsafe-definer? body)
+			      (remove-unneeded-let*-vars caller form env))
+			    (combine-let*-vars caller form vars env)
+
+			    (let ((last-var (last-ref varlist)))
+			      (combine-let*-last-var caller form last-var env)
+			      (if (and (null? (cdr body))
+				       (len>1? (car body))
+				       (len=2? last-var))
+				  (let->case-else caller form (car last-var) (cadr last-var) body)))
+			    ;; last var -> if/cond in car(body) as in let only happens a few times (leaving aside stuff caught above)
+
+			    (when (and (> (length body) 3)
+				       (> (length vars) 1)
+				       (not (tree-set-car-member '(define define* define-macro define-macro*
+								    define-bacro define-bacro* define-constant define-expansion)
+								 body)))
+			      (reduce-let*-scope caller form vars))))))))
+
+	    env)
+	  (hash-walker 'let* let*-walker)
+
+
+	  ;; -------- letrec->let --------
+	  (define (letrec->let caller form vars env)
+	    (let ((head (car form)))
+	      (do ((bindings (cadr form) (cdr bindings)) ; if none of the local vars occurs in any of the values, no need for the "rec"
+		   (vs (map var-name vars)))
+		  ((or (not (and (pair? bindings)
+				 (pair? (car bindings))
+				 (pair? (cdar bindings))))
+		       (memq (cadar bindings) vs)
+		       (lint-tree-set-memq vs (cadar bindings)))
+		   (when (null? bindings)
+		     (let ((letx (if (or (eq? head 'letrec)
+					 (do ((p (map cadr (cadr form)) (cdr p))
+					      (q (map car (cadr form)) (cdr q)))
+					     ((or (null? p)
+						  (side-effect? (car p) env)
+						  (memq (car q) (cdr q)))
+					      (null? p))))
+				     'let 'let*)))
+		       ;; (letrec ((f1 (lambda (a) a))) 32)
+		       (lint-format "~A could be ~A: ~A" caller
+				    head letx
+				    (truncated-list->string form))))))
+
+	      (when (and (eq? (car form) 'letrec*)
+			 (len>1? (cadr form)) ; len=1 case handle elsewhere
+			 (lint-every? (lambda (p)
+					(and (len=2? p)
+					     (pair? (cadr p))
+					     (eq? (caadr p) 'lambda)))
+				      (cadr form)))
+		;; this happens only in psyntax-pp.scm (Guile)
+		(lint-format "letrec* could be letrec: ~A" caller (truncated-list->string form)))
+
+	      (when (and (null? (cdr vars))
+			 (pair? (cadr form))
+			 (len>1? (caadr form))
+			 (len=1? (cddr form))
+			 (pair? (caddr form)))
+		(let ((body (caddr form))
+		      (sym (var-name (car vars)))
+		      (lform (cadar (cadr form))))           ; the letrec var's lambda
+		  (when (and (len>1? lform)
+			     (eq? (car lform) 'lambda)
+			     (proper-list? (cadr lform)))    ; includes ()
+		    (if (eq? sym (car body))                 ; (letrec ((x (lambda ...))) (x...)) -> (let x (...)...)
+			(if (and (not (lint-tree-memq sym (cdr body)))
+				 (< (lint-tree-leaves body) 100))
+			    ;; the limit on tree-leaves is for cases where the args are long lists of data --
+			    ;;   more like for-each than let, and easier to read if the code is first, I think.
+			    (lint-format "perhaps ~A" caller
+					 (lists->string
+					  form `(let ,sym
+						  ,(map list (cadr lform) (cdr body))
+						  ,@(cddr lform)))))
+			(if (and (not (eq? caller 'define))
+				 (= (tree-count sym body 2) 1))
+			    (let ((call (find-call sym body)))
+			      (when (pair? call)
+				(let ((new-call `(let ,sym
+						   ,(map list (cadr lform) (cdr call))
+						   ,@(cddr lform))))
+				  (lint-format "perhaps ~A" caller
+					       (lists->string form (tree-subst new-call call body)))))))))))))
+
+	  ;; maybe (let () ...) here because (letrec ((x (lambda (y) (+ y 1)))) (x (define z 32))) needs to block z?
+	  ;;   currently we get (let x ((y (define z 32))) (+ y 1))
+	  ;;   and even that should be (let () (define z 32) (+ z 1)) or something similar
+	  ;; lambda here is handled under define??
+
+	  ;; -------- walk-letrec-vars --------
+	  (define (walk-letrec-vars caller form env)
+	    (let ((head (car form))
+		  (vars ()))
+	      (do ((warned (or (eq? head 'letrec*)
+			       (not (pair? (cadr form)))
+			       (negative? (length (cadr form))))) ; malformed letrec
+		   (baddy #f)
+		   (bindings (cadr form) (cdr bindings)))
+		  ((not (pair? bindings))
+		   (if (not (null? bindings)) ; (letrec* letrec)!
+		       (lint-format "~A variable list is not a proper list? ~S" caller head (cadr form))))
+
+		(when (and (not warned)              ; letrec -> letrec*
+			   (len>1? (car bindings))
+			   ;; type of current var is not important -- if used in non-function elsewhere,
+			   ;;   it has to be letrec*
+			   (lint-any? (lambda (b)
+					(and (len>1? b)
+					     (or (and (not (pair? (cadr b)))
+						      (eq? (caar bindings) (cadr b)))
+						 (lint-tree-memq (caar bindings) (cadr b)))
+					     (not (lint-tree-set-memq '(lambda lambda* define define* case-lambda) (cadr b)))
+					     (set! baddy b)))
+				      (cdr bindings)))
+		  (set! warned #t)
+		  ;; (letrec ((x 32) (f1 (let ((y 1)) (lambda (z) (+ x y z)))) (f2 (f1 x))) (+ x f2))
+		  (lint-format "in ~A,~%~NCletrec should be letrec* because ~A is used in ~A's value (not a function): ~A" caller
+			       (truncated-list->string form)
+			       (+ lint-left-margin 4) #\space
+			       (caar bindings)
+			       (car baddy)
+			       (cadr baddy)))
+
+		(when (binding-ok? caller head (car bindings) env #f)
+		  (let ((init (if (and (eq? (caar bindings) (cadar bindings))
+				       (or (eq? head 'letrec)
+					   (not (var-member (caar bindings) vars))))
+				  (begin ; (letrec ((x x)) x)
+				    (lint-format "~A is the same as (~A #<undefined>) in ~A" caller
+						 (car bindings) (caar bindings) head)
+				    ;; in letrec* ((x 12) (x x)) is an error
+				    #<undefined>)
+				  (cadar bindings))))
+		    (set! vars (cons (make-lint-var (caar bindings) init head)
+				     vars)))))
+	      vars))
+
+	  ;; -------- letrec+lambda->lambda+let --------
+	  (define (letrec+lambda->lambda+let caller form)
+	    (when (and (len=1? (cadr form))
+		       (null? (cdddr form))
+		       (pair? (caddr form))
+		       (eq? (caaddr form) 'lambda)
+		       (pair? (caadr form))
+		       (tree-car-member (caaadr form) (cddr form))
+		       (= (tree-count (caaadr form) (cddr form) 2) 1)) ; this alone can give (caaadr form) passed as a function arg
+	      (let ((lr-lambda (cadr (caadr form))))
+		(when (and (pair? lr-lambda)
+			   (eq? 'lambda (car lr-lambda)))
+		  (let ((pars (cadr lr-lambda)))
+		    (when (proper-list? pars)
+		      (let* ((lr-name (caaadr form))
+			     (lr-args (let search ((tree (caddr form)))
+					(and (pair? tree)
+					     (if (eq? (car tree) lr-name)
+						 (cdr tree)
+						 (or (search (car tree))
+						     (search (cdr tree))))))))
+			(call-with-exit
+			 (lambda (quit)
+			   (let ((vs (car (out-vars lr-name pars (cddr lr-lambda)))))
+			     (when (pair? vs)
+			       (for-each (lambda (v)
+					   (if (shadowed? v (caddr form)) ; this never happens
+					       (quit)))
+					 vs)))                            ; set (cadr) appears to include args which leads to false positives here
+			   (lint-format "perhaps ~A" caller
+					(lists->string form
+						       (tree-subst `(let ,lr-name ,(map list pars lr-args)
+									 ,@(one-call-and-dots (cddr lr-lambda)))
+								   (cons lr-name lr-args)
+								   (caddr form)))))))))))))
+
+	  ;; -------- letrec-walker --------
+	  (define (letrec-walker caller form env)
+	    (if (not (and (>= (length form) 3)                 ;  (letrec () . 1)
+			  (proper-list? (cadr form))
+			  (just-pairs? (cadr form))))
+		(begin
+		  (lint-format "~A is messed up: ~A" caller (car form) (truncated-list->string form))
+		  env)
+		(let ((head (car form)))
+
+		  (cond ((null? (cadr form))        ;  (letrec () 1)
+			 (lint-format "~A could be let: ~A" caller head (truncated-list->string form)))
+
+			((and (null? (cdadr form))
+			      (eq? head 'letrec*))  ;  (letrec* ((a (lambda b (a 1)))) a)
+			 (lint-format "letrec* could be letrec: ~A" caller (truncated-list->string form))))
+
+		  (let ((vars (walk-letrec-vars caller form env)))
+		    ;; no hits for func-definer as car of body
+
+		    (when (eq? head 'letrec)
+		      (check-unordered-exprs caller form (map var-initial-value vars) env)
+		      (letrec+lambda->lambda+let caller form))
+
+		    ;; define backwards propagation check got no hits: (letrec ((f1 (lambda () f2))) (define f2 1) (f1))
+
+		    (when (pair? vars)
+		      (letrec->let caller form vars env))
+
+		    (when (pair? (cadr form))
+		      (let ((new-env (append vars env)))
+			(for-each (lambda (binding)
+				    (if (binding-ok? caller head binding env #t)
+					(lint-walk caller (cadr binding) new-env)))
+				  (cadr form))))
+
+		   (cdr (walk-letx-body caller form (cddr form) vars env))))))
+
+	  (hash-walker 'letrec letrec-walker)
+	  (hash-walker 'letrec* letrec-walker))
+
+
+	;; ---------------- begin ----------------
+	(let ()
+	  (define (begin-walker caller form env)
+
+	    (if (not (proper-list? form))
+		(begin                           ;  (begin . 1)
+		  (lint-format "stray dot in begin? ~A" caller (truncated-list->string form))
+		  env)
+		(begin
+		  (when (pair? (cdr form))
+		    (if (null? (cddr form))      ;  (begin (f y))
+			(lint-format "begin could be omitted: ~A" caller (truncated-list->string form))
+
+			;; these two are questionable -- simpler, but scope enlarged
+			(when (and (pair? (cadr form))
+				   (len=1? (cddr form)))
+
+			  ;; begin+do+return -> do+return
+			  (if (and (eq? (caadr form) 'do)
+				   (< (lint-tree-leaves (caddr form)) 24) ; or maybe (< ... (min 24 (lint-tree-leaves do-form)))?
+				   (not (lint-tree-set-memq (map car (cadadr form)) (caddr form))))
+			      ;;  (begin (do ((i 0 (+ i 1))) ((= i 3)) (display i)) 32) -> (do ((i 0 (+ i 1))) ((= i 3) 32) (display i))
+			      ;; the do loop has to end normally to go on? That is, moving the following expr into the do end section is safe?
+			      (lint-format "perhaps ~A" caller
+					   (lists->string form
+							  (let ((do-form (cdadr form)))
+							    (let ((do-test (and (pair? (cadr do-form))
+										(caadr do-form)))
+								  (new-end (if (len>1? (cadr do-form))
+									       (append (cdadr do-form) (cddr form))
+									       (cddr form))))
+							      `(do ,(car do-form)
+								   (,do-test ,@new-end)
+								 ,@(cddr do-form))))))
+
+			      ;; begin+letx+return -> letx+return
+			      (if (and (memq (caadr form) '(let let* letrec letrec*)) ; same for begin + let + expr -- not sure about this...
+				       (not (symbol? (cadadr form)))
+				       (< (lint-tree-leaves (caddr form)) 24)
+				       (not (lint-tree-set-memq (map car (cadadr form)) (caddr form))))
+				  (lint-format "perhaps ~A" caller
+					       (lists->string form
+							      (let ((let-form (cadr form)))
+								`(,(car let-form) ,(cadr let-form)
+								  ,@(if (< (lint-tree-leaves (cddr let-form)) 60)
+									(cddr let-form)
+									(one-call-and-dots (cddr let-form)))
+								  ,(caddr form))))))))))
+		  (lint-walk-open-body caller 'begin (cdr form) env))))
+	  (hash-walker 'begin begin-walker))
+
+
+	;; ---------------- with-baffle ----------------
+	(let ()
+	  (define (with-baffle-walker caller form env)
+	    ;; with-baffle introduces a new frame, so we need to handle it here
+	    (lint-walk-body caller 'with-baffle (cdr form)
+			    (cons (make-lint-var :with-baffle form 'with-baffle)
+				  env))
+	    env)
+	  (hash-walker 'with-baffle with-baffle-walker))
+
+
+	;; ---------------- let-temporarily ----------------
+	(let ()
+	  (define (let-temporarily-walker caller form env)
+	    (if (< (length form) 2)  ; empty body is ok here
+		(lint-format "let-temporarily is messed up: ~A" caller (truncated-list->string form))
+		(let ((new-env (cons (make-lint-var :let form 'let-temporarily) env)))
+		  (if (null? (cadr form))
+		      (lint-format "let-temporarily with no vars? ~A" caller (truncated-list->string form))
+		      (lint-walk caller (cadr form) new-env))
+		  (let ((e (lint-walk-body caller 'let-temporarily (cddr form) new-env)))
+		    (report-usage caller 'let-temporarily
+				  (if (eq? e new-env)
+				      ()
+				      (env-difference caller e new-env ()))
+				  new-env))))
+	    env)
+	  (hash-walker 'let-temporarily let-temporarily-walker))
+
+
+	;; -------- with-let --------
+	(let ()
+	  (define (with-let-walker caller form env)
+	    (if (< (length form) 3)
+		(lint-format "with-let is messed up: ~A" caller (truncated-list->string form))
+		(let ((e (cadr form)))
+		  (if (or (and (code-constant? e)
+			       (not (let? e))
+			       (not (eq? e '*s7*))) ; (with-let *s7* ... )
+			  (and (pair? e)
+			       (let ((op (return-type (car e) env)))
+				 (and op
+				      (not (return-type-ok? 'let? op))))))  ;  (with-let 123 123)
+		      (lint-format "~A: first argument should be an environment: ~A" 'with-let caller (truncated-list->string form)))
+
+		  (if (symbol? e)
+		      (set-ref e caller form env)
+		      (when (pair? e)
+			(if (and (null? (cdr e))
+				 (eq? (car e) 'curlet))                 ;  (with-let (curlet) x)
+			    (lint-format "~A is not needed here: ~A" 'with-let caller (truncated-list->string form)))
+			(lint-walk caller e (cons (make-lint-var :let form 'with-let)
+						  env))))
+		  (let ((lib #f)
+			(new-env (cons (make-lint-var :with-let form 'with-let) env))
+			(ignore-usage (memq e '(*motif* *gl* *libc* *libm* *libgdbm* *libgsl*))))
+		    (if (or ignore-usage
+			    (and (len>1? e)
+				 (eq? (car e) 'sublet)
+				 (memq (cadr e) '(*motif* *gl* *libc* *libm* *libgdbm* *libgsl*))
+				 (set! e (cadr e))))
+			(set! lib (if (defined? e)
+				       (symbol->value e)
+				       (let ((file (*autoload* e)))
+					 (and (string? file)
+					      (load file))))))
+		    (let-temporarily ((*e* (if (let? lib) lib *e*))
+				      (lint-in-with-let #t))
+		      (let ((e (lint-walk-open-body caller 'with-let (cddr form) new-env)))
+			(if (not (or ignore-usage
+				     (lint-tree-memq 'curlet (cddr form))))
+			    (report-usage caller 'with-let
+					  (if (eq? e new-env)
+					      ()
+					      (env-difference caller e new-env ()))
+					  new-env)))))))
+	    env)
+	  (hash-walker 'with-let with-let-walker))
+
+
+	;; ---------------- load ----------------
+	(let ()
+	  (define (load-walker caller form env)
+	    (check-call caller 'load form env)
+	    (if (and (pair? (cdr form))
+		     (equal? (cadr form) ""))
+		(lint-format "load needs a real file name, not the empty string: ~A" caller form))
+	    (lint-walk caller (cdr form) env)
+	    (if (and *report-loaded-files*
+		     (string? (cadr form)))
+		(catch #t
+		  (lambda ()
+		    (lint-file (cadr form) env))
+		  (lambda args
+		    env))
+		env))
+	  (hash-walker 'load load-walker))
+
+
+	;; ---------------- require ----------------
+	(let ()
+	  (define (require-walker caller form env)
+	    (if (not (pair? (cdr form)))                   ; (require)
+		(lint-format "~A is pointless" caller form)
+		(if (lint-any? string? (cdr form))              ; (require "repl.scm")
+		    (lint-format "require's arguments should be symbols: ~A" caller (truncated-list->string form))))
+	    (if (not *report-loaded-files*)
+		env
+		(let ((vars env))
+		  (for-each
+		   (lambda (f)
+		     (let ((file (*autoload* f)))
+		       (if (string? file)
+			   (catch #t
+			     (lambda ()
+			       (set! vars (lint-file file vars)))
+			     (lambda args
+			       #f)))))
+		   (cdr form))
+		  vars)))
+	  (hash-walker 'require require-walker))
+
+
+	;; ---------------- call-with-input-file etc ----------------
+	(let ()
+	  (define (call-with-io-walker caller form env)
+	    (check-call caller (car form) form env)
+	    (let ((len (if (eq? (car form) 'call-with-output-string) 2 3))) ; call-with-output-string func is the first arg, not second
+	      (when (= (length form) len)
+
+		;; call-with-output-string -> object->string
+		(when (and (eq? (car form) 'call-with-output-string)
+			   (= (length form) 2)
+			   (len>1? (cadr form))
+			   (eq? (caadr form) 'lambda)
+			   (pair? (cadadr form)))
+		  (let ((body (cddadr form)))
+		    (when (and (pair? body)
+			       (len>2? (car body))
+			       (memq (caar body) '(write display))
+			       (eq? (caddar body) (car (cadadr form))))
+		      (if (null? (cdr body))
+			  (lint-format "perhaps ~A" caller
+				       (lists->string form (cons 'object->string
+								 (cons (cadar body)
+								       (if (eq? (caar body) 'display) '(#f) ())))))
+			  (if (and (len=1? (cdr body))
+				   (len=1? (cadr body))
+				   (eq? (caadr body) 'newline))
+			      (lint-format "perhaps ~A" caller
+					   (lists->string form
+							  (list 'format #f (if (eq? (caar body) 'display) "~A~%" "~S~%") (cadar body)))))))))
+
+		(let ((func (list-ref form (- len 1))))
+		  (if (= len 3)
+		      (lint-walk caller (cadr form) env))
+		  (if (not (and (len>1? func)
+				(eq? (car func) 'lambda)))
+		      (let ((f (and (symbol? func)
+				    (symbol->value func *e*))))
+			(if (and (procedure? f)
+				 (not (aritable? f 1)))
+			    (lint-format "~A argument should be a function of one argument: ~A" caller (car form) func))
+			(lint-walk caller func env))
+		      (let ((args (cadr func)))
+			(let ((body (cddr func))
+			      (port (and (pair? args) (car args)))
+			      (head (car form)))
+
+			  (when *report-shadowed-variables*
+			    (report-shadower caller head 'port port func env))
+
+			  (if (or (not port)
+				  (pair? (cdr args)))
+			      ;; (lambda () (write args) (newline))
+			      (lint-format "~A argument should be a function of one argument: ~A" caller head func)
+			      (begin
+				(if (and (len=1? body)
+					 (len=2? (car body))
+					 (eq? (cadar body) port))
+				    ;; (call-with-input-file "file" (lambda (p) (read-char p))) -> (call-with-input-file "file" read-char)
+				    (lint-format "perhaps ~A" caller
+						 (lists->string form
+								(list head (if (= len 2)
+									       (caar body)
+									       (values (cadr form) (caar body)))))))
+				(let ((cc (make-lint-var port
+							 (list (case head
+								 ((call-with-input-string)  'open-input-string)
+								 ((call-with-output-string) 'open-output-string)
+								 ((call-with-input-file)    'open-input-file)
+								 ((call-with-output-file)   'open-output-file)
+								 (else 'error)))
+							 head)))
+				  (lint-walk-body caller head body (cons cc
+									 (cons (make-lint-var :let form head)
+									       env)))
+				  (report-usage caller head (list cc) env))))))))))
+	    env)
+	  (for-each (lambda (op)
+		      (hash-walker op call-with-io-walker))
+		    '(call-with-input-string call-with-input-file call-with-output-file call-with-output-string)))
+
+
+	;; ---------------- catch ----------------
+	(let ()
+	  (define (catch-walker caller form env)
+	    ;; catch tag is tricky -- it is evaluated, then eq? matches at error time, so we need
+	    ;;   to catch constants that can't be eq?
+	    (if (not (= (length form) 4))
+		(begin
+		  (lint-format "catch takes 3 arguments (tag body error-handler): ~A" caller (truncated-list->string form))
+		  (lint-walk caller (cdr form) env))
+		(let ((tag (cadr form)))
+		  (if (or (and (not (pair? tag))
+			       (or (number? tag) (char? tag) (length tag)))
+			  (and (pair? tag)
+			       (memq (car tag) '(quote #_quote))
+			       (or (not (pair? (cdr tag)))
+				   (length (cadr tag)))))
+		      ;; (catch #(0) (lambda () #f) (lambda a a))
+		      (lint-format "catch tag ~S is unreliable (catch uses eq? to match tags)" caller tag)
+		      (if (not tag) ; (catch #f ...)
+			  (lint-format "catch tag #f makes this catch a no-op" caller)))
+		  (let ((body (caddr form))
+			(error-handler (cadddr form)))
+		    ;; empty catch+catch apparently never happens
+		    (lint-walk caller body (cons (make-lint-var :let form 'catch)
+						 (cons (make-lint-var :catch form 'catch)
+						       env)))
+		    (lint-walk caller error-handler env))))
+	    env)
+	  (hash-walker 'catch catch-walker))
+
+
+	;; ---------------- call-with-exit etc ----------------
+	(let ()
+	  (define (call-with-exit-walker caller form env)
+	    (check-call caller (car form) form env)
+	    (let ((continuation (and (pair? (cdr form))
+				     (len>2? (cadr form))
+				     (eq? (caadr form) 'lambda)
+				     (pair? (cadadr form))
+				     (car (cadadr form)))))
+
+	      (if (not (symbol? continuation))
+		  (lint-walk caller (cdr form) env)
+		  (let ((body (cddadr form))
+			(head (car form)))
+
+		    (when *report-shadowed-variables*
+		      (report-shadower caller head
+				       (if (eq? head 'call-with-exit) 'exit-function 'continuation)
+				       continuation form env))
+
+		    (if (not (or (eq? head 'call-with-exit)    ;   (call/cc (lambda (p) (+ x (p 1))))
+				 (eq? continuation (car body)) ; and (null? (cdr) I think (call/cc (lambda (k) k)) is intended
+				 (tree-sym-set-member continuation '(lambda lambda* define define* curlet apply error) body)))
+			;; this checks for continuation as arg (of anything), and any of set as car
+			;;   for define and define* it would be tighter to check that they aren't returned or used as an arg
+			(lint-format "perhaps ~A could be call-with-exit:~%~NC~A" caller
+				     head
+				     (+ lint-left-margin 4) #\space
+				     (truncated-list->string form)))
+
+		    (if (not (tree-unquoted-member continuation body))    ; (call-with-exit (lambda (p) (+ x 1)))
+			(lint-format "~A ~A ~A appears to be unused: ~A" caller head
+				     (if (eq? head 'call-with-exit) "exit function" "continuation")
+				     continuation
+				     (truncated-list->string form))
+			(let ((last (and (proper-list? body)
+					 (last-ref body))))
+			  (if (and (pair? last)
+				   (eq? (car last) continuation))
+			      ;; (call-with-exit (lambda (return) (display x) (return (+ x y))))
+			      (lint-format "~A is redundant here: ~A" caller continuation (truncated-list->string last)))))
+
+		    (let ((cc (make-lint-var continuation (if (eq? head 'call-with-exit) :call/exit :call/cc) head)))
+		      (lint-walk-body caller head body (cons cc env))
+		      (report-usage caller head (list cc) env)))))
+	    env)
+	  (for-each (lambda (op)
+		      (hash-walker op call-with-exit-walker))
+		    '(call/cc call-with-current-continuation call-with-exit)))
+
+
+	;; ---------------- import etc ----------------
+	(let ()
+	  (define (get-repeats caller lst)
+	    (do ((repeats ())
+		 (p lst (cdr p)))
+		((null? p)
+		 (if (pair? repeats)
+		     (lint-format "repeated entr~@P: ~{~A~^, ~}" caller (length repeats) (reverse repeats))))
+	      (if (and (memq (car p) (cdr p))
+		       (not (memq (car p) repeats)))
+		  (set! repeats (cons (car p) repeats)))))
+
+	  (define (walk-import caller form env)   ; report repeated entries in import and export lists -- this does not apply to s7
+	    (if (and (> (length form) 12)
+		     (just-symbols? (cdr form)))
+		(get-repeats caller (cdr form)))
+	    env)
+
+	  (hash-walker 'import walk-import)
+	  (hash-walker 'export walk-import)
+	  (hash-walker 'define-module (lambda (caller form env)
+					(let loop ((lst (cdr form)))
+					  (if (pair? lst)
+					      (if (eq? (car lst) :export)
+						  (get-repeats caller (cadr lst))
+						  (loop (cdr lst)))))
+					env)))
+
+	(hash-walker 'provide
+		     (lambda (caller form env)
+		       (if (not (= (length form) 2))	                     ; (provide a b c)
+			   (lint-format "provide takes one argument: ~A" caller (truncated-list->string form))
+			   (unless (symbol? (cadr form))
+			     (let ((op (->lint-type (cadr form))))
+			       (if (not (memq op '(symbol? #f #t values)))   ; (provide "test")
+				   (lint-format "provide's argument should be a symbol: ~S" caller form)))))
+		       env))
+
+	(hash-walker 'module        ; module apparently has different syntax and expectations in various schemes
+		     (lambda (caller form env)
+		       (if (len>1? (cdr form))
+			   (lint-walk 'module (cddr form) env))
+		       env))
+
+	(hash-walker 'define-syntax
+		     (lambda (caller form env)
+		       ;; we need to put the macro name in env with ftype=define-syntax
+		       (if (and (pair? (cdr form))
+				(symbol? (cadr form))
+				(not (keyword? (cadr form)))) ; !! this thing is a disaster from the very start
+			   (cons (make-fvar (cadr form) 'define-syntax #f #f #f) env)
+			   env)))
+
+	(hash-walker 'define-method   ; guile and mit-scheme have different syntaxes here
+		     (lambda (caller form env)
+		       (let ((cdr-form (cdr form)))
+			 (if (not (len>1? cdr-form))
+			     env
+			     (if (symbol? (car cdr-form))
+				 (if (keyword? (car cdr-form))
+				     (lint-walk-body caller 'define-method (cddr cdr-form) env)
+				     (let ((new-env (if (var-member (car cdr-form) env)
+							env
+							(cons (make-fvar (car cdr-form) 'define-method #f #f #f) env))))
+				       (lint-walk-body caller (car cdr-form) (cddr cdr-form) new-env)))
+				 (let ((new-env (if (var-member (caar cdr-form) env)
+						    env
+						    (cons (make-fvar (caar cdr-form) 'define-method #f #f #f) env))))
+				   (lint-walk-body caller (caar cdr-form) (cdr cdr-form) new-env)))))))
+
+	(hash-walker 'let-syntax (lambda (caller form env)
+				   (lint-walk-body caller 'define-method (cddr form) env)
+				   env))
+
+	(hash-walker 'letrec-syntax (lambda (caller form env)
+				      (lint-walk-body caller 'define-method (cddr form) env)
+				      env))
+
+
+	;; ---------------- case-lambda ----------------
+	(let ()
+	  (define (case-lambda-walker caller form env)
+	    (when (pair? (cdr form))
+	      (let ((lens ())
+		    (body ((if (string? (cadr form)) cddr cdr) form)) ; might have a doc string before the clauses
+		    (doc-string (and (string? (cadr form)) (cadr form))))
+
+		(for-each
+		 (lambda (choice)
+		   (if (pair? choice)
+		       (let ((len (length (car choice))))
+			 (if (member len lens)
+			     ;; (case-lambda (() 0) ((x y) x) ((x y) (+ x y)) ((x y z) (+ x y z)) (args (apply + args))
+			     (lint-format "repeated parameter list? ~A in ~A" caller (car choice) form))
+			 (set! lens (cons len lens))
+			 (lint-walk 'case-lambda (cons 'lambda choice) env))))
+		 body)
+
+		(case (length lens)
+		  ((1)
+		   ;; (case-lambda (() (if #f #f))) -> (lambda () (if #f #f))
+		   (lint-format "perhaps ~A" caller
+				(lists->string form
+					       (if doc-string
+						   (list 'let (list (list '+documentation+ doc-string))
+							 (cons 'lambda (car body)))
+						   (cons 'lambda (car body))))))
+		  ((2)
+		   (when (let arglists-equal? ((args1 (caar body))
+					       (args2 (caadr body)))
+			   (if (null? args1)
+			       (len=1? args2)
+			       (and (pair? args1)
+				    (if (null? args2)
+					(null? (cdr args1))
+					(and (pair? args2)
+					     (eq? (car args1) (car args2))
+					     (arglists-equal? (cdr args1) (cdr args2)))))))
+		     (let* ((clause1 (car body))
+			    (body1 (cdr clause1))
+			    (clause2 (cadr body))
+			    (body2 (cdr clause2))
+			    (arglist (let ((arg1 (car clause1))
+					   (arg2 (car clause2)))
+				       (if (> (car lens) (cadr lens)) arg2 arg1))) ; lens is reversed
+			    (arg-name (last-ref arglist))
+			    (diffs (let arg->defaults ((arg arg-name)
+						       (b1 body1)
+						       (b2 body2)
+						       (defaults ()))
+				     (and defaults
+					  (cond ((null? b1) (and (null? b2) defaults))
+						((null? b2) (and (null? b1) defaults))
+						((eq? arg b1) (cons b2 defaults))
+						((eq? arg b2) (cons b1 defaults))
+						((pair? b1)
+						 (and (pair? b2)
+						      (arg->defaults arg (car b1) (car b2) (arg->defaults arg (cdr b1) (cdr b2) defaults))))
+						(else (and (equal? b1 b2) defaults)))))))
+		       (when (and (len=1? diffs)
+				  (code-constant? (car diffs)))
+			 (let ((new-body (if (> (car lens) (cadr lens)) body2 body1))
+			       (new-arglist (if (not (car diffs))
+						arglist
+						(if (null? (cdr arglist))
+						    (list (list arg-name (car diffs)))
+						    (list (car arglist) (list arg-name (car diffs)))))))
+			   ;; (case-lambda (() (display x #f)) ((y) (display x y))) -> (lambda* (y) (display x y))
+			   (lint-format "perhaps ~A" caller
+					(lists->string form
+						       (if doc-string
+							   `(let ((+documentation+ ,doc-string))
+							      (lambda* ,new-arglist ,@new-body))
+							   (cons 'lambda* (cons new-arglist new-body)))))))))))))
+	    env)
+	  (hash-walker 'case-lambda case-lambda-walker))
+	walker-table))
+
+    ;; end walker-functions
+    ;; ----------------------------------------
+
+    (define (hash-fragment reduced-form leaves env func orig-form line outer-vars)
+      ;; func here is either #f or an env-style entry (cons name let) as produced by make-fvar,
+      ;;   the let entries accessed are initial-value, history, arglist
+      (let ((old (hash-table-ref (or (vector-ref fragments leaves) (vector-set! fragments leaves (make-hash-table))) reduced-form)))
+	(set! fragmin (min leaves fragmin))
+	(set! fragmax (min *fragment-max-size* (max leaves fragmax)))
+	(if (not (vector? old))
+	    (hash-table-set! (vector-ref fragments leaves) reduced-form (vector 1 (list line) (and func (list func)) orig-form #f outer-vars))
+	    ;; key = reduced-form
+	    ;; value = #(list uses line-numbers fvar original-form)
+	    (begin
+	      (vector-set! old 0 (+ (vector-ref old 0) 1))
+	      (vector-set! old 1 (cons line (vector-ref old 1)))
+	      (when func
+		(if (not (vector-ref old 2))
+		    (vector-set! old 2 (list func))
+		    (let ((caller (if (keyword? (var-name func)) 'define (var-name func)))
+			  (func-name (var-name func)))
+		      (let search ((vs (vector-ref old 2)))
+			(when (pair? vs)
+			  (let* ((v (car vs))
+				 (vname (var-name v)))
+			    (cond ((not (eqv? (length (var-arglist v)) (length (var-arglist func))))
+				   (search (cdr vs)))
+
+				  ((eq? (var-history v) :built-in)
+				   (lint-format "~A is the same as the built-in ~A ~A" caller
+						func-name
+						(if (eq? (car (var-initial-value v)) 'define-macro) 'macro 'function)
+						vname))
+
+				  ((not (var-member vname env))
+				   (lint-format "~A is the same as ~A" caller
+						func-name
+						(if (and (pair-line-number (var-initial-value v))
+							 (> (pair-line-number (var-initial-value v)) 0))
+						    (format #f "~A (line ~D)" vname (pair-line-number (var-initial-value v)))
+						    (if (eq? func-name vname)
+							(format #f "previous ~A" vname)
+							vname))))
+
+				  ((eq? vname func-name)
+				   (lint-format "~A definition repeated: ~A" caller
+						func-name (truncated-list->string (var-initial-value func))))
+
+				  (else
+				   (lint-format "~A could be (define ~A ~A)" caller
+						func-name func-name vname))))))
+		      (vector-set! old 2 (cons func (vector-ref old 2))))))))))
+
+
+
+    (denote reduce-tree
+      (let ((quit #f)
+	    (outer-vars ())
+	    (local-ctr 0)
+	    (line 0)
+	    (reduced-form ())
+	    (fuvar #f))
+
+	(denote (set-outer ovars tree)
+	  (if (null? ovars)
+	      (quit)
+	      (if (null? (caar ovars))
+		  (begin
+		    (set-car! (car ovars) tree)
+		    (cadar ovars))
+		  (set-outer (cdr ovars) tree))))
+
+	(denote (reduce-v v)
+	  ;; this might be the first appearance of (car v)
+	  (when (null? (cadr v))
+	    (list-set! v 1 (symbol "<L" (number->string local-ctr) ">"))
+	    (list-set! v 2 local-ctr)
+	    (set! local-ctr (+ local-ctr 1)))
+	  (cadr v))
+
+	(denote (reduce-walker tree vars)
+	  (cond ((pair? tree)
+		 (case (car tree)
+		   ((quote #_quote)
+		    tree)
+
+		   ((let let*)
+		    ;; in let we need to sort locals by order of appearance in the body
+		    (if (<= (length tree) 2)
+			(quit))
+		    (let ((locals ())
+			  (body ())
+			  (named-let (symbol? (cadr tree)))
+			  (lvars ()))
+		      (if named-let
+			  (begin
+			    (set! lvars (cons (list (cadr tree) (symbol "<NL" (number->string local-ctr) ">") -1) lvars))
+			    (set! local-ctr (+ local-ctr 1))
+			    (set! locals (caddr tree))
+			    (set! body (cdddr tree)))
+			  (begin
+			    (set! locals (cadr tree))
+			    (set! body (cddr tree))))
+		      (if (not (list? locals)) (quit))
+
+		      (let ((func (if (eq? (car tree) 'let)
+				      (lambda (local)
+					(if (not (len>1? local)) (quit))
+					(set! lvars (cons (list (car local) () 0 (reduce-walker (cadr local) vars)) lvars)))
+				      (lambda (local)
+					(if (not (len>1? local)) (quit))
+					(set! lvars (cons (list (car local)
+								(symbol "<L" (number->string local-ctr) ">")
+								local-ctr
+								(reduce-walker (cadr local) (append lvars vars)))
+							  lvars))
+					(set! local-ctr (+ local-ctr 1))))))
+			(for-each func locals))
+
+		      ;; now walk the body, setting the reduced local name by order of encounter (in let, not let*)
+		      (let ((new-body (reduce-walker body (append lvars vars))))
+			(unless (pair? new-body) (set! new-body (list new-body)))
+			(when (and (eq? (car tree) 'let)
+				   ;; fill-in unused-var dummy names etc
+				   (pair? lvars))
+			  (for-each (lambda (v)
+				      (when (null? (cadr v))
+					(list-set! v 1 (symbol "<L" (number->string local-ctr) ">"))
+					(list-set! v 2 local-ctr)
+					(set! local-ctr (+ local-ctr 1))))
+				    lvars))
+			(set! lvars (sort! lvars (lambda (a b) (< (caddr a) (caddr b)))))
+
+			(if named-let
+			    `(,(car tree) ,(cadr (assq (cadr tree) lvars))
+			      ,(map (lambda (v) (list (cadr v) (cadddr v))) (cdr lvars))
+			      ,@new-body)
+			    `(,(car tree)
+			      ,(map (lambda (v) (list (cadr v) (cadddr v))) lvars)
+			      ,@new-body)))))
+
+		   ((if)
+		    (if (not (and (len>1? (cdr tree))
+				  (list? (cdddr tree))))
+			(quit))
+		    (let ((expr (reduce-walker (cadr tree) vars))
+			  (true (reduce-walker (caddr tree) vars)))
+		      (if (null? (cdddr tree))
+			  (if (and (len>1? expr)
+				   (eq? (car expr) 'not))
+			      (cons 'unless (cons (cadr expr) (unbegin true)))
+			      (cons 'when (cons expr (unbegin true))))
+			  (list 'if expr true (reduce-walker (cadddr tree) vars)))))
+
+		   ((when unless)
+		    (if (not (len>1? (cdr tree)))
+			(quit))
+		    (cons (car tree)
+			  (cons (reduce-walker (cadr tree) vars)
+				(map (lambda (p) (reduce-walker p vars)) (cddr tree)))))
+
+		   ((set!)
+		    (if (not (len>1? (cdr tree))) (quit))
+		    (if (symbol? (cadr tree))
+			(let ((v (assq (cadr tree) vars)))
+			  (if (or (not v)  ; if not a var, it's about to be an outer-var
+				  (and (not fuvar)
+				       (memq (cadr v) '(<1> <2> <3> <4>))))
+			      (quit))
+			  (when (null? (cadr v))  ; must be a previously unencountered local
+			    (list-set! v 1 (symbol "<L" (number->string local-ctr) ">"))
+			    (list-set! v 2 local-ctr)
+			    (set! local-ctr (+ local-ctr 1)))
+			  (list 'set! (cadr v) (reduce-walker (caddr tree) vars)))
+			(list 'set! (reduce-walker (cadr tree) vars) (reduce-walker (caddr tree) vars))))
+
+		   ((do)
+		    (if (not (and (len>1? (cdr tree))
+				  (list? (cadr tree))
+				  (list? (cdddr tree))))
+			(quit))
+		    (let ((locals (cadr tree))
+			  (end+result (caddr tree))
+			  (body (cdddr tree))
+			  (lvars ()))
+		      (if (not (and (list? end+result)
+				    (proper-list? body)))
+			  (quit))
+		      (for-each (lambda (local)
+				  (if (not (len>1? local))
+				      (quit))
+				  (set! lvars (cons (list (car local)
+							  () 0
+							  (reduce-walker (cadr local) vars)
+							  (if (pair? (cddr local))
+							      (caddr local)
+							      :unset))
+						    lvars)))
+				locals)
+		      (let ((new-env (append lvars vars)))
+			(let ((new-end (reduce-walker end+result new-env))
+			      (new-body (reduce-walker body new-env)))
+			  (unless (pair? new-body)
+			    (set! new-body (list new-body)))
+			  (when (pair? lvars)
+			    (for-each (lambda (lv)
+					(if (not (eq? (lv 4) :unset))
+					    (list-set! lv 4 (reduce-walker (lv 4) new-env))))
+				      lvars)
+			    (for-each (lambda (v)
+					(when (null? (cadr v))
+					  (list-set! v 1 (symbol "<L" (number->string local-ctr) ">"))
+					  (list-set! v 2 local-ctr)
+					  (set! local-ctr (+ local-ctr 1))))
+				      lvars)
+			    (set! lvars (sort! lvars (lambda (a b) (< (caddr a) (caddr b))))))
+
+			  `(do ,(map (lambda (v)
+				       (map v (if (eq? (v 4) :unset) '(1 3) '(1 3 4))))
+				     lvars)
+			       ,new-end
+			     ,@new-body)))))
+
+		   ((lambda)
+		    (if (not (proper-pair? (cdr tree)))
+			(quit))
+		    (let* ((lvars (map (lambda (a)
+					 (let ((res (list a (symbol "<A" (number->string local-ctr) ">") local-ctr)))
+					   (set! local-ctr (+ local-ctr 1))
+					   res))
+				       (let ((args (args->proper-list (cadr tree))))
+					 (if (pair? args) args (quit)))))
+			   (new-body (let ((new-vars (append lvars vars)))
+				       (map (lambda (p) (reduce-walker p new-vars)) (cddr tree))))
+			   (new-args (if (symbol? (cadr tree))
+					 (cadar lvars)
+					 (if (proper-list? (cadr tree))
+					     (map cadr lvars)
+					     (let ((lst (map cadr lvars)))
+					       (append (copy lst (make-list (- (length lst) 1)))
+						       (last-ref lst)))))))
+		      (cons 'lambda (cons new-args new-body))))
+
+		   ((case)
+		    (if (not (and (len>1? (cdr tree))
+				  (pair? (caddr tree))))
+			(quit))
+		    (list 'case
+			  (reduce-walker (cadr tree) vars)
+			  (map (lambda (c)
+				 (if (not (len>1? c))
+				     (quit))
+				 (cons (car c)
+				       (map (lambda (p) (reduce-walker p vars)) (cdr c))))
+			       (cddr tree))))
+
+		   ((letrec letrec*)
+		    (if (not (pair? (cdr tree))) (quit))
+		    (let ((locals (cadr tree))
+			  (body (cddr tree))
+			  (lvars ()))
+		      (if (not (and (list? locals) (pair? body))) (quit))
+		      (for-each (lambda (local)
+				  (if (not (len>1? local))
+				      (quit))
+				  (set! lvars (cons (list (car local)
+							  (symbol "<L" (number->string local-ctr) ">")
+							  local-ctr ())
+						    lvars))
+				  (set! local-ctr (+ local-ctr 1)))
+				locals)
+		      (for-each (lambda (local lv)
+				  (list-set! lv 3 (reduce-walker (cadr local) lvars)))
+				locals lvars)
+		      (cons (car tree)
+			    (cons (map (lambda (v) (list (cadr v) (cadddr v))) lvars)
+				  (reduce-walker body (append lvars vars))))))
+
+		   ((lambda*)
+		    (if (not (and (proper-pair? (cdr tree))
+				  (or (symbol? (cadr tree))
+				      (proper-list? (cadr tree)))))
+			(quit))
+		    (let ((old-args (args->proper-list (cadr tree))))
+		      (if (or (not (pair? old-args))
+			      (just-keywords? old-args))  ; (:allow-other-keys)
+			  (quit))
+		      (let* ((lvars (map (lambda (a)
+					   (if (memq a '(:rest :allow-other-keys))
+					       (values)
+					       (let ((res (list (if (pair? a) (car a) a)
+								(symbol "<A" (number->string local-ctr) ">") local-ctr)))
+						 (set! local-ctr (+ local-ctr 1))
+						 res)))
+					 old-args))
+			     (new-body (let ((new-vars (append lvars vars)))
+					 (map (lambda (p) (reduce-walker p new-vars)) (cddr tree))))
+			     (new-args (if (symbol? (cadr tree))
+					   (cadar lvars)
+					   (map (lambda (a)
+						  (cond ((keyword? a) a)
+							((symbol? a) (cadr (assq a lvars)))
+							((len>1? a)
+							 (list (assq a lvars) (cadr a)))
+							(else (quit))))
+						(cadr tree)))))
+			(cons 'lambda* (cons new-args new-body)))))
+
+		   (else ; still (pair? tree) but (car tree) not hit above
+		    (cons (cond ((pair? (car tree))
+				 (reduce-walker (car tree) vars))
+				((assq (car tree) vars) => reduce-v)
+				(else (car tree)))
+			  (if (pair? (cdr tree))
+			      (map (lambda (p)
+				     (reduce-walker p vars))
+				   (cdr tree))
+			      (cdr tree))))))
+
+		;; (pair? tree) far far above
+
+		((or (not (symbol? tree))
+		     (keyword? tree))
+		 tree)
+
+		((assq tree vars) => reduce-v) ; replace in-tree symbol with its reduction (this includes any outer-var once set below)
+
+		(fuvar (quit))
+
+		(else
+		 (set-outer outer-vars tree))))
+
+	(lambda (new-form leaves env fvar orig-form)
+	  (unless (lint-tree-set-memq '(define define*
+				    ;; these propagate backwards and we're not returning the new env in this loop,
+				    ;; lvars can be null, so splicing a new local into vars is a mess,
+				    ;; but if the defined name is not reduced, it can occur later as itself (not via car),
+				    ;; so without lots of effort (a dummy var if null lvars, etc), we can only handle
+				    ;; functions within a function (fvar not #f).
+				    ;; but adding that possibility got no hits
+				    list-values #_list-values apply-values #_apply-values append quasiquote unquote
+				    define-constant define-macro define-macro* define-expansion
+				    define-syntax let-syntax letrec-syntax match syntax-rules
+				    require import module cond-expand reader-cond while case-lambda
+				    call-with-values let-values define-values let*-values multiple-value-bind)
+				 new-form)
+	    (call-with-exit
+	     (lambda (q)
+	       (set! quit q)
+	       (set! fuvar fvar)
+	       (set! outer-vars (if fvar
+				    (do ((e (list (list (var-name fvar) '<F> 0 ())))
+					 (i 1 (+ i 1))
+					 (args (args->proper-list (var-arglist fvar)) (cdr args)))
+					((not (pair? args)) e)
+				      (set! e (cons (list (car args) (symbol "<" (number->string i) ">") i ()) e)))
+				    (list (list () '<1>) (list () '<2>) (list () '<3>) (list () '<4>)))) ; avoid cyclic-tree check in copy+:readable
+	       (set! local-ctr 0)
+	       (set! line (pair-line-number orig-form))
+	       (set! reduced-form (reduce-walker new-form outer-vars))
+	       (unless line
+		 (set! line (let search ((tree orig-form))
+			      (and (pair? tree)
+				   (or (pair-line-number tree)
+				       (search (car tree))
+				       (search (cdr tree))))))
+		 (if (not line) (set! line 0)))
+
+	       (set! leaves (lint-tree-leaves reduced-form))        ; if->when, for example, so tree length might change
+	       (if (and (<= *fragment-min-size* leaves)
+			(< leaves *fragment-max-size*))
+		   (hash-fragment reduced-form leaves env fvar orig-form line outer-vars))
+	       (when fvar (quit))
+
+	       (unless (and (pair? lint-function-body)
+			    (equal? new-form (car lint-function-body)))
+		 (let ((fvars (let ((fcase (and (< leaves *fragment-max-size*)
+						(vector-ref fragments leaves)
+						(hash-table-ref (vector-ref fragments leaves) (list reduced-form)))))
+				(and (vector? fcase)
+				     (vector-ref fcase 2)))))
+		   (when (pair? fvars)
+		     (call-with-exit
+		      (lambda (ok)
+			(for-each (lambda (fv)
+				    (when (var-member (var-name fv) env)
+				      (out-format outport "~NCperhaps ~A -> (~A~{ ~A~})~%" lint-left-margin #\space
+					      (truncated-list->string new-form)
+					      (var-name fv)
+					      (map (lambda (a) (case (car a) ((()) (values)) (else))) outer-vars))
+				      (ok)))
+				  fvars)
+			(out-format outport "~NCif '~A were in scope, perhaps ~A -> (~A~{ ~A~})~%" lint-left-margin #\space
+				(var-name (car fvars))
+				(truncated-list->string new-form)
+				(var-name (car fvars))
+				(map (lambda (a) (case (car a) ((()) (values)) (else))) outer-vars)))))))))))))
+
+    (define (lint-fragment form env)
+      (let ((leaves (lint-tree-leaves form)))
+	(when (< *fragment-min-size* leaves *fragment-max-size*)
+	  (reduce-tree form leaves env #f form))))
+
+    (define (reduce-function-tree fvar env)
+      (let ((definition (cond ((var-initial-value fvar) => cddr))))
+	(when (pair? definition)
+	  (let* ((form (if (and (string? (car definition))
+				(pair? (cdr definition)))
+			   (cdr definition)
+			   definition))
+		 (leaves (lint-tree-leaves form)))
+	    (when (< *fragment-min-size* leaves *fragment-max-size*)
+	      (reduce-tree form leaves env (and (not (keyword? (var-name fvar))) fvar) form))))))
+    ;; ----------------------------------------
+
+
+    (denote lint-walk-pair
+      (let ()
+	(denote (walk-rest caller form env)
+	  (let ((vars env))
+	    (for-each
+	     (lambda (f)
+	       (set! vars (lint-walk caller f vars)))
+	     form))
+	  env)
+
+	;; -------- walk head=symbol --------
+	(denote walk-symbol
+	  (letrec ((unsafe-makers '(sublet inlet copy cons list append subvector vector hash-table
+				    make-hash-table make-hook list-values #_list-values append gentemp or and not))
+
+		   (equal-ignoring-constants?
+		    (lambda (a b)
+		      (or (equivalent? a b)
+			  (and (symbol? a)
+			       (constant? a)
+			       (equivalent? (symbol->value a) b))
+			  (and (symbol? b)
+			       (constant? b)
+			       (equivalent? (symbol->value b) a))
+			  (and (pair? a)
+			       (pair? b)
+			       (equal-ignoring-constants? (car a) (car b))
+			       (equal-ignoring-constants? (cdr a) (cdr b))))))
+		   (constable? (lambda (cp)
+				 (and (len>1? cp)
+				      (memq (car cp) '(list vector int-vector float-vector byte-vector))
+				      (lint-every? (lambda (inp)
+						     (and (or (not (symbol? inp)) ; leave (list pi *stderr*) unrewritten
+							      (keyword? inp))
+							  (or (code-constant? inp)
+							      (constable? inp))))
+						   (cdr cp))))))
+	    (lambda (caller head form env)
+	      (let ((v (var-member head env)))
+		(when (and v (not (memq form (var-history v))))
+		  (set! (var-history v) (cons form (var-history v)))
+		  (set! (var-refenv v) env))
+		(check-call caller head form env)
+
+		;; look for one huge argument leaving lonely trailing arguments somewhere off the screen
+		;;   (it needs to be one arg, not a call on values)
+		(let ((branches (length form)))
+
+		  (when (and (= branches 2)
+			     (any-procedure? head v)
+			     (not (eq? head 'unquote)))
+		    (let ((arg (cadr form)))
+		      ;; begin=(car arg) happens very rarely
+		      (when (len>2? arg)
+			(when (and (memq (car arg) '(let let*))
+				   (list? (cadr arg))
+				   (not (or (null? (cddr arg))
+					    (and (pair? (cddr arg))
+						 (pair? (caddr arg))
+						 (eq? 'lambda (caaddr arg)))
+					    (assq head (cadr arg)))))
+			  (let* ((body (cddr arg))
+				 (len (- (length body) 1)))
+			    (when (>= len 0)
+			      ;; (string->symbol (let ((s (copy vstr))) (set! (s (+ pos 1)) #\s) s)) ->
+			      ;;    (let ((s (copy vstr))) (set! (s (+ pos 1)) #\s) (string->symbol s))")
+			      (lint-format "perhaps~%~NC~A ->~%~NC~A" caller
+					   (+ lint-left-margin 4) #\space
+					   (truncated-list->string form)
+					   (+ lint-left-margin 4) #\space
+					   (let ((str (object->string `(,(car arg) ,(cadr arg)
+									,@(copy body (make-list len))
+									(,head ,(list-ref body len))))))
+					     (if (<= (length str) target-line-length)
+						 str
+						 (format #f "(~A ... (~A ~A))"
+							 (car arg) head
+							 (truncated-list->string (list-ref body len)))))))))
+			(when (and (eq? (car arg) 'or)
+				   (proper-list? arg))
+			  (let ((else-clause (let ((last-clause (last-ref arg)))
+					       (if (and (pair? last-clause)
+							(memq (car last-clause) '(error throw)))
+						   last-clause
+						   (if (or (not (code-constant? last-clause))
+							   (side-effect? (list head last-clause) env))
+						       :checked-eval-error
+						       (let ((res (checked-eval (list head last-clause))))
+							 (if (or (and (symbol? res)
+								      (not (eq? res :checked-eval-error)))
+								 (pair? res))
+							     (list #_quote res)
+							     res)))))))
+			    (unless (eq? else-clause :checked-eval-error)
+			      (set! last-rewritten-internal-define form)
+			      ;; (string->number (or (f x) "4")) -> (cond ((f x) => string->number) (else 4))
+			      (lint-format "perhaps ~A" caller
+					   (lists->string form
+							  `(cond (,(if (or (null? (cddr arg))
+									   (null? (cdddr arg)))
+								       (cadr arg)
+								       (copy arg (make-list (- (length arg) 1))))
+								  => ,head)
+								 (else ,else-clause))))))))))
+		  (unless (or (<= branches 2)
+			      (any-macro? head env)
+			      (memq head '(for-each map list-values #_list-values * + - /)))
+		    (let ((leaves (lint-tree-leaves form)))
+		      (when (> leaves (max *report-bloated-arg* (* branches 3)))
+			(do ((p (cdr form) (cdr p))
+			     (i 1 (+ i 1)))
+			    ((or (not (pair? p)) ; end of arg list
+				 (null? (cdr p))
+				 (and (pair? (car p))
+				      (symbol? (caar p))
+				      (not (memq (caar p) '(lambda quote #_quote call/cc list vector match-lambda values)))
+				      (> (lint-tree-leaves (car p)) (- leaves (* branches 2)))
+				      (or (not (memq head '(or and)))
+					  (= i 1))
+				      (not (lint-tree-memq 'values (car p)))
+				      (let ((header (copy form (make-list i)))
+					    (trailer (copy form (make-list (- branches i 1)) (+ i 1)))
+					    (disclaimer (if (or (any-procedure? head v)
+								(hash-table-ref no-side-effect-functions head))
+							    ""
+							    (format #f ", assuming ~A is not a macro," head))))
+					;; begin=(caar p) here is almost entirely as macro arg
+					;; (apply env-channel (make-env ...) args) -> (let ((<1> (make-env ...))) (apply env-channel <1> args))
+					(lint-format "perhaps~A~%~NC~A ->~%~NC~A" caller
+						     disclaimer
+						     (+ lint-left-margin 4) #\space
+						     (lint-pp (append header (cons (one-call-and-dots (car p)) trailer)))
+						     (+ lint-left-margin 4) #\space
+						     (if (and (memq (caar p) '(let let*))
+							      (list? (cadar p))
+							      (not (assq head (cadar p)))) ; actually not intersection header+trailer (map car cadr)
+							 (let ((last (last-ref (cddar p))))
+							   (if (< (lint-tree-leaves last) 12)
+							       (format #f "(~A ... ~A)"
+								       (caar p)
+								       (lint-pp (append header (cons last trailer))))
+							       (lint-pp `(let ((<1> ,(one-call-and-dots (car p))))
+									   (,@header <1> ,@trailer)))))
+							 (lint-pp `(let ((<1> ,(one-call-and-dots (car p))))
+								     (,@header <1> ,@trailer)))))
+					#t)))))))))
+
+		(when (pair? form)
+		  ;; save any references to vars in their var-history (type checked later)
+		  ;;   this can be fooled by macros, as everywhere else
+		  (for-each (lambda (arg)
+			      (when (symbol? arg)
+				(let ((v (var-member arg env)))
+				  (when (and v (not (memq form (var-history v))))
+				    (set! (var-history v) (cons form (var-history v)))
+				    (set! (var-refenv v) env)))))
+			    form)
+
+		  (if (lint-set!? form env)
+		      (set-set (cadr form) caller form env)))
+
+		(if (var? v)
+		    (if (memq (var-ftype v) '(define lambda define* lambda*))
+			(update-scope v caller env))
+		    (begin
+		      (cond ((hash-table-ref special-case-functions head)
+			     => (lambda (f)
+				  (f caller head form env))))
+
+		      ;; change (list ...) to '(...) if it's safe as a constant list
+		      ;;   and (vector ...) -> #(...)
+		      (if (and (pair? (cdr form))
+			       (hash-table-ref no-side-effect-functions head)
+			       (not (memq head unsafe-makers)))
+			  (for-each (lambda (p)
+				      (when (constable? p)
+					(let ((pval (eval/error caller p)))
+					  (if (not (eq? pval :error))
+					      (lint-format "perhaps ~A -> ~A~A" caller
+							   (truncated-list->string p)
+							   (if (eq? (car p) 'list) "'" "")
+							   (object->string pval))))))
+				    (cdr form)))
+
+		      (when (and (not (= line-number last-simplify-numeric-line-number))
+				 (hash-table-ref numeric-ops head)
+				 (< (lint-tree-leaves form) 100)
+				 (proper-tree? form))
+			;; head always is (car form) here
+			(let ((val (simplify-numerics form env)))
+			  (unless (equal-ignoring-constants? form val)
+			    (set! last-simplify-numeric-line-number line-number)
+			    ;; (+ 1 2) -> 3, and many others
+			    (lint-format "perhaps ~A" caller (lists->string form val)))))
+
+		      ;; if a var is used before it is defined, the var history and ref/set
+		      ;;   info needs to be saved until the definition, so other-identifiers collects it
+		      (unless (defined? head (rootlet))
+			(hash-table-set! other-identifiers head
+					 (cons form (or (hash-table-ref other-identifiers head) ()))))))
+
+		;; (f ... (if A B C) (if A D E) ...) -> (f ... (if A (values B D) (values C E)) ...)
+		;;    these happen up to almost any number of clauses
+		;;    need true+false in every case, and need to be contiguous
+		;;    case/cond happen here, but very rarely in a way we can combine via values
+
+		(unless (any-macro? head env) ; actually most macros are safe here...
+		  (do ((p (cdr form) (cdr p)))
+		      ((or (not (pair? p))
+			   (and (len>2? (car p))
+				(eq? (caar p) 'if)
+				(pair? (cdddar p))))
+		       (when (pair? p)
+			 (do ((test (cadar p))
+			      (q (cdr p) (cdr q)))
+			     ((not (and (pair? q)
+					(let ((x (car q)))
+					  (and (len>2? x)
+					       (eq? (car x) 'if)
+					       (equal? (cadr x) test)
+					       (pair? (cdddr x))))))
+			      (unless (eq? q (cdr p))
+				(let ((header (do ((i 1 (+ i 1))
+						   (r (cdr form) (cdr r)))
+						  ((eq? r p)
+						   (copy form (make-list i)))))
+				      (middle (do ((r p (cdr r))
+						   (trues ())
+						   (falses ()))
+						  ((eq? r q)
+						   (list 'if test
+							 (cons 'values (reverse trues))
+							 (cons 'values (reverse falses))))
+						(set! trues (cons (caddar r) trues))
+						(set! falses (cons (car (cdddar r)) falses)))))
+				  ;; (+ (if A B C) (if A C D) y) -> (+ (if A (values B C) (values C D)) y)
+				  (lint-format "perhaps~A ~A" caller
+					       (if (side-effect? test env)
+						   (format #f " (ignoring ~S's possible side-effects)" test)
+						   "")
+					       (lists->string form (append header (cons middle q)))))))))))))
+	      (walk-rest caller form env))))
+
+	;; -------- walk head=pair --------
+	(denote (walk-pair caller head form env)
+	  (cond ((eq? (car head) 'list)
+		 (lint-format "perhaps use vector here: ~A" caller (truncated-list->string form)))
+
+		((eq? (car head) 'if)
+		 (let ((if-len (length head)))
+		   (if (= if-len 3)                     ; ((if y +) 3 4)
+		       (lint-format "~S better not be #f here: ~A" caller (cadr head) (truncated-list->string form))
+
+		       (if (= if-len 4)                 ; ((if y + -) 2 3), if-len might be anything
+			   (let ((true (caddr head))
+				 (false (cadddr head))
+				 (num-args (length (cdr form))))
+
+			     (if (and (symbol? true)
+				      (symbol? false))
+				 (when (and (defined? true)
+					    (defined? false))
+				   (let ((op1 (symbol->value true))
+					 (op2 (symbol->value false)))
+
+				     (unless (aritable? op1 num-args)
+				       (lint-format "~S in ~S can't be called with ~D argument~P: ~A"
+						    caller true head num-args num-args (truncated-list->string form)))
+				     (unless (aritable? op2 num-args)
+				       (lint-format "~S in ~S can't be called with ~D argument~P: ~A"
+						    caller false head num-args num-args (truncated-list->string form)))
+
+				     (let ((sig1 (signature op1))
+					   (sig2 (signature op2))
+					   (data (var-member head env)))
+				       (when (pair? sig1)
+					 (check-args caller form data form (cdr sig1) env num-args))
+				       (when (pair? sig2)
+					 (check-args caller form data form (cdr sig2) env num-args)))))
+
+				 (unless (or (pair? true) (pair? false))
+
+				   (unless (aritable? true num-args)
+				     (lint-format "~S in ~S can't be called with ~D argument~P: ~A"
+						  caller true head num-args num-args (truncated-list->string form)))
+				   (unless (aritable? false num-args)
+				     (lint-format "~S in ~S can't be called with ~D argument~P: ~A"
+						  caller false head num-args num-args (truncated-list->string form))))))))))
+
+		((not (and (pair? (cdr head))
+			   (memq (car head) '(lambda lambda*)))))
+		;; just ((lambda|lambda* ...)...) from here down
+
+		((and (identity? head)
+		      (pair? (cdr form))) ; identity needs an argument
+		 ;; ((lambda (x) x) 32) -> 32
+		 (lint-format "perhaps ~A" caller (truncated-lists->string form (cadr form))))
+
+		((and (symbol? (cadr head)) ; ((lambda x x) 1 2 3) -> (list 1 2 3)
+		      (len=1? (cddr head))
+		      (eq? (cadr head) (caddr head)))
+		 (lint-format "perhaps ~A" caller
+			      (lists->string form (cons 'list (cdr form)))))
+
+		((and (null? (cadr head))
+		      (pair? (cddr head)))
+		 ;; ((lambda () 32) 0) -> 32
+		 (lint-format "perhaps ~A" caller
+			      (truncated-lists->string
+			       form
+			       (if (and (null? (cdddr head))
+					(not (and (pair? (caddr head))
+						  (memq (caaddr head) '(define define* define-constant define-macro define-macro*)))))
+				   (caddr head)
+				   (cons 'let (cons () (cddr head)))))))
+
+		((and (proper-pair? (cddr head)) ; ((lambda (...) ...) ...) -> (let ...) -- lambda here is ugly and slow
+		      (not (lint-any? (lambda (a) (mv-range a env)) (cdr form))))
+		 (call-with-exit
+		  (lambda (quit)          ; uncountably many things can go wrong with the lambda form
+		    (let ((vars ())
+			  (vals ()))
+		      (do ((v (cadr head) (cdr v))
+			   (a (cdr form) (cdr a)))
+			  ((not (and (pair? a)
+				     (pair? v)))
+			   (cond ((symbol? v)
+				  (set! vars (cons v vars))
+				  (set! vals (cons (cons 'list a) vals)))
+
+				 ((or (not (list? v))
+				      (and (null? a)
+					   (pair? v)
+					   (eq? (car head) 'lambda))) ; too many args
+				  (quit))
+
+				 (else
+				  (for-each (lambda (p)
+					      (if (pair? p)
+						  (begin
+						    (if (not (pair? (cdr p))) (quit))
+						    (set! vars (cons (car p) vars))
+						    (set! vals (cons (cadr p) vals)))
+						  (begin
+						    (set! vars (cons p vars))
+						    (set! vals (cons #f vals)))))
+					    v))))
+			(set! vars (cons ((if (pair? (car v)) caar car) v) vars))
+			(let ((val (car a)))
+			  (when (and (pair? val)
+				     (symbol? (car val)))
+			    (let ((sig (arg-signature (car val) env)))
+			      (when (and (pair? sig)
+					 (eq? (car sig) 'values)) ; don't try to rewrite as let if values in play
+				(quit))))
+			  (set! vals (cons val vals))))
+		      ;; ((lambda* (a b) (+ a b)) 1) -> (let ((a 1) (b #f)) (+ a b))
+		      (lint-format "perhaps ~A" caller
+				   (lists->string form
+						  (cons (if (or (eq? (car head) 'lambda)
+								(not (pair? (cadr head)))
+								(null? (cdadr head)))
+							    'let 'let*)
+							(cons (map list (reverse vars) (reverse vals))
+							      (cddr head))))))))))
+	  (walk-rest caller form env))
+
+	;; -------- walk head=quasiquote (aimed at ,@x primarily) --------
+	(denote walk-qq
+	  (let ((qq-form #f))
+
+	    (define (safe-av? p)
+	      (and (pair? p)
+		   (memq (car p) '(apply-values #_apply-values))
+		   (not (lint-tree-set-memq '(apply-values #_apply-values list-values #_list-values append unquote) (cdr p)))))
+
+	    (lambda (caller head form env)
+	      (for-each (lambda (p)
+			  (let ((sym (and (symbol? p) p)))
+			    (cond ((not sym)
+				   #f)
+				  ((var-member sym env)
+				   (set-ref sym caller form env))
+				  ((not (defined? sym (rootlet)))
+				   (hash-table-set! other-identifiers sym
+						    (cons form (or (hash-table-ref other-identifiers sym) ())))))))
+			(cdr form))
+
+	      (let ((old-current-form lint-current-form))
+		;; maybe put these on a switch -- some days I think they're good, and others...
+		(unless (and qq-form
+			     (eq? lint-current-form qq-form))
+		  (if (not lint-current-form) (set! lint-current-form form))
+		  (set! qq-form lint-current-form) ; only interested in simplest cases here
+		  (if (eq? head 'append)                   ; `(f . g) -> (cons f g) ignoring quotes etc
+		      (if (and (= (length form) 3)          ; `(f . (g . h)) -> (cons f (cons g h))
+			       (pair? (cadr form))
+			       (memq (caadr form) '(list-values #_list-values))
+			       (not (lint-tree-set-memq '(apply-values #_apply-values append unquote) (cdr form))))
+			  (let ((lst (unlist-values (cadr form)))
+				(rest (caddr form)))
+			    (if (pair? rest) (set! rest (unlist-values rest)))
+			    (let ((lst-len (length lst)))
+			      (case lst-len
+				((2) (lint-format "perhaps ~A" caller (lists->string form `(cons ,(cadr lst) ,rest))))
+				((3) (lint-format "perhaps ~A" caller
+						  (lists->string form
+								 `(cons ,(cadr lst)
+									(cons ,(caddr lst) ,rest)))))))))
+
+		      (when (memq head '(list-values #_list-values))
+			(case (length form)
+			  ((1) #f)  ; this never happens
+			  ((2)
+			   (let ((arg1 (cadr form)))
+			     (cond ((and (pair? arg1)
+					 (memq (car arg1) '(apply-values #_apply-values)))  ; `(,@x) -> (copy x)
+				    (if (not (pair? (cdr arg1)))
+					(lint-format "apply-values needs an argument: ~A" caller form)
+					(if (not (qq-tree? (cadr arg1)))
+					    (lint-format "perhaps ~A" caller
+							 (lists->string form
+									(unlist-values (if (pair? (cadr arg1))
+											   (cadr arg1)
+											   (list 'copy (cadr arg1)))))))))
+				   ((or (symbol? arg1)
+					(quoted-symbol? arg1))
+				    (lint-format "perhaps ~A" caller      ; `(,x) -> (list x)
+						 (lists->string form (list 'list arg1))))
+
+				   ((and (pair? arg1)                     ; `((a ,b)) -> (list (list 'a b))
+					 (not (lint-tree-set-memq '(apply-values #_apply-values unquote) arg1)))
+				    (lint-format "perhaps ~A" caller
+						 ((if (< (lint-tree-leaves form) 50) lists->string truncated-lists->string)
+						  form
+						  (unlist-values form)))))))
+
+			  ((3)
+			   (let ((arg1 (cadr form))
+				 (arg2 (caddr form)))
+
+			     (if (and (len=2? arg1)           ; `(begin (abs ,x)) -> `(abs ,x), this is a separate issue from the rewrites below
+				      (memq (car arg1) '(quote #_quote))
+				      (eq? (cadr arg1) 'begin)
+				      (not (and (pair? arg2)
+						(memq (car arg2) '(apply-values #_apply-values))))) ; no other way to splice here, I hope
+				 (lint-format "pointless begin: ~A" caller
+					      (lists->string form (caddr form))))
+
+			     (cond ((and (len=1? arg2)
+					 (memq (car arg2) '(apply-values #_apply-values)))
+				    (lint-format "apply-values takes one argument: ~A" caller form))
+
+				   ((not (or (and (pair? arg1)
+						  (lint-tree-set-memq '(apply-values #_apply-values append unquote) arg1))
+					     (and (pair? arg2)
+						  (or (lint-tree-set-memq '(append unquote) arg2)
+						      (lint-tree-set-memq '(list-values #_list-values apply-values #_apply-values) (cdr arg2))))))
+				    (lint-format "perhaps ~A" caller        ; `(f ,(map g x)) -> (list 'f (map g x))
+						 (lists->string form        ; `(f ,@(map g x)) -> (cons 'f (map g x))
+								(if (pair? arg2)
+								    (case (car arg2)
+								      ((apply-values #_apply-values)
+								       (list 'cons (unlist-values arg1) (cadr arg2)))
+								      ((list-values #_list-values)
+								       (list 'list (unlist-values arg1) (cons 'list (cdr arg2))))
+								      (else
+								       (list 'list (unlist-values arg1) arg2)))
+								    (list 'list (unlist-values arg1) arg2)))))
+				   ((and (len=2? arg1)
+					 (memq (car arg1) '(apply-values #_apply-values))
+					 (not (qq-tree? (cadr arg1))))
+				    (if (and (len=2? arg2)
+					     (not (qq-tree? (cadr arg2)))
+					     (memq (car arg2) '(apply-values #_apply-values)))  ; `(,@x ,@y) -> (append x y)
+					(lint-format "perhaps ~A" caller
+						     (lists->string form
+								    (list 'append
+									  (unlist-values (cadr arg1))
+									  (unlist-values (cadr arg2)))))
+					(if (not (and (pair? arg2)
+						      (lint-tree-set-memq '(apply-values #_apply-values append unquote) arg2)))
+					    (lint-format "perhaps ~A" caller     ; `(,@x ,y) -> (append x (list y))
+							 (lists->string form
+									(list 'append
+									      (unlist-values (cadr arg1))
+									      (list 'list (unlist-values arg2))))))))
+
+				   ((and (len=3? arg1)                        ; `((a . b) (c . d)) -> (list (cons a b) (cons c d))
+					 (eq? (car arg1) 'append)            ; `((a . (b . c))...) -> (list (cons a (cons b c)) ...)
+					 (pair? (cadr arg1))
+					 (memq (caadr arg1) '(list-values #_list-values)) ; was memq+list
+					 (len=3? arg2)
+					 (eq? (car arg2) 'append)
+					 (pair? (cadr arg2))
+					 (memq (caadr arg2) '(list-values #_list-values))) ; same
+				    (let ((ca1 (cadr arg1))
+					  (ca2 (cadr arg2)))
+				      (let ((len1 (length ca1))
+					    (len2 (length ca2)))
+					(let ((pa1 (case len1
+						     ((2) (list 'cons (cadr ca1) (caddr arg1)))
+						     ((3) (list 'cons (cadr ca1) (list 'cons (caddr ca1) (caddr arg1))))
+						     (else 'error)))
+					      (pa2 (case len2
+						     ((2) (list 'cons (cadr ca2) (caddr arg2)))
+						     ((3) (list 'cons (cadr ca2) (list 'cons (caddr ca2) (caddr arg2))))
+						     (else 'error))))
+					  (if (and (pair? pa1)
+						   (pair? pa2))
+					      (lint-format "perhaps ~A" caller
+							   (lists->string form (list 'list pa1 pa2))))))))
+
+				   ((not (lint-tree-set-memq '(apply-values #_apply-values unquote) (cdr form)))
+				    (lint-format "perhaps ~A" caller
+						 ((if (< (lint-tree-leaves form) 100) lists->string truncated-lists->string)
+						  form
+						  (unlist-values form)))))))
+
+			  (else                  ; checked already that form is a proper-list, so the length here is > 3
+			   (let ((args (cdr form)))      ; car is list-values
+			     (cond ((lint-every? (lambda (p)              ; `((f . ,a) (g . ,b)...) -> (list (cons f a) (cons g b) ...)
+						   (and (pair? p)         ;     from (append (list x) y) -> (cons x y)
+							(eq? (car p) 'append)
+							(len=2? (cdr p))
+							(len=2? (cadr p))
+							(memq (caadr p) '(list-values #_list-values))))
+						 args)
+				    (lint-format "perhaps ~A" caller
+						 (truncated-lists->string form
+									  `(list (cons ,(cadadr (car args)) ,(caddar args))
+										 (cons ,(cadadr (cadr args)) ,(caddr (cadr args)))
+										 ...))))
+
+				   ((lint-any? (lambda (p)
+						 (and (len=1? p)
+						      (memq (car p) '(apply-values #_apply-values))))
+					       args)
+				    (lint-format "apply-values needs an argument: ~A" caller form))
+
+				   ((not (lint-every? safe-av? (cddr args)))
+				    (if (and (len=3? args)
+					     (safe-av? (car args))   ; `(,@x ,@y ,z) -> (append x y (list z)) etc
+					     (safe-av? (cadr args))
+					     (not (and (pair? (caddr args))
+						       (memq (caaddr args) '(apply-values #_apply-values append unquote)))))
+					(lint-format "perhaps ~A" caller
+						     (lists->string form
+								    (list 'append (cadar args) (cadadr args)
+									  (list 'list (unlist-values (caddr args))))))))
+
+				   ;; `(+ ,y ,@(map f x)) -> (cons '+ (cons y (map f x)))
+				   ;; `(+ ,y ,@x ,@z etc) -> (cons '+ (cons y (append x z ...)))
+				   ;; `(f ,@x ,@y etc) -> (cons 'f (append x y ...))
+				   ;; `(,@x ,@y etc) -> (append x y ...)
+				   ((safe-av? (cadr args))
+				    (if (safe-av? (car args))
+					(lint-format "perhaps ~A" caller
+						     (lists->string form
+								    (cons 'append (map cadr args))))
+					(if (not (lint-tree-set-memq '(apply-values #_apply-values append unquote) (car args)))
+					    (lint-format "perhaps ~A" caller
+							 (lists->string form
+									`(cons ,(unlist-values (car args)) (append ,@(map cadr (cdr args)))))))))
+
+				   ((not (or (lint-tree-set-memq '(apply-values #_apply-values append unquote) (car args))
+					     (lint-tree-set-memq '(apply-values #_apply-values append unquote) (cadr args))))
+				    (lint-format "perhaps ~A" caller
+						 (lists->string form
+								`(cons ,(unlist-values (car args))
+								       (cons ,(unlist-values (cadr args))
+									     ,(if (null? (cdddr args))
+										  (cadr (caddr args))
+										  (cons 'append (map cadr (cddr args)))))))))
+				   ((and (len=3? args)
+					 (safe-av? (car args))   ; `(,@x ,y ,@z) -> (append x (cons y z))
+					 (not (lint-tree-set-memq '(apply-values #_apply-values append unquote) (cadr args))))
+				    (lint-format "perhaps ~A" caller
+						 (lists->string form
+								(list 'append (cadar args)
+								      (list 'cons (unlist-values (cadr args)) (cadr (caddr args))))))))))))))
+
+		(let ((e (walk-rest caller form env)))
+		  (set! lint-current-form old-current-form)
+		  e)))))
+
+	;; -------- lint-walk-pair --------
+	(lambda (caller form env)
+	  (let ((head (car form)))
+	    (set! line-number (or (pair-line-number form) (max line-number 0)))
+
+	    (if *report-repeated-code-fragments*
+		(lint-fragment form env))
+
+	    ;; (error...) as arg happens very rarely (a half-dozen hits, one: (values (error...))!
+
+	    (cond
+	     ((hash-table-ref walker-functions head)
+	      => (lambda (walker)
+		   (walker caller form env)))
+
+	     ((not (proper-list? form))
+	      ;; these appear to be primarily macro/match arguments or stuff like (+ . 1)
+	      ;;   other cases (not list) have already been dealt with above
+	      (if (and (pair? form)
+		       (symbol? head)
+		       (or (procedure? (symbol->value head *e*))
+			   (memq head '(or and))))
+		  (lint-format "unexpected dot: ~A" caller (truncated-list->string form)))
+	      env)
+
+	     ((and *report-quasiquote-rewrites*
+		   (memq head '(list-values #_list-values apply-values #_apply-values)))
+	      (walk-qq caller head form env))
+
+	     ((symbol? head)
+	      (walk-symbol caller head form env))
+
+	     ((pair? head)
+	      (walk-pair caller head form env))
+
+	     (else (walk-rest caller form env)))))))
+
+    ;; -------- lint-walk --------
+    (denote (lint-walk caller form env)
+      (cond ((symbol? form)
+	     ;(set-ref form caller #f env) ; returns env
+	     ;         name caller form env)
+	     (let ((data (var-member form env)))
+	       (if data
+		   (begin
+		     (set! (var-ref data) (+ (var-ref data) 1))
+		     (update-scope data caller env))
+		   (if (not (defined? form (rootlet)))
+		       (let ((old (hash-table-ref other-identifiers form)))
+			 (check-for-bad-variable-name caller form)
+#|
+			 (when *report-undefined-identifiers*
+			   ;; this is easily fooled by macros (including ,form = gensym), defines by a different name (denote),
+			   ;;   and functions from elsewhere that lint can't see
+			   (cond ((assq form recent-names) =>
+				  (lambda (data)
+				    (lint-format "~S might be undefined, but it was defined recently (via a ~S broadly speaking) to be ~S"
+						 caller form (cadr data) (caddr data))))))
+|#
+			 (hash-table-set! other-identifiers form (cons #f (or old ()))))))
+	       env))
+
+	    ((pair? form)
+	     (lint-walk-pair caller form env))
+
+	    ((string? form)
+	     (let ((len (length form)))
+	       (when (and (> len 8)               ; "*****************************" -> (format #f "~NC" 29 #\*)
+			  (string=? form (make-string len (string-ref form 0))))
+		 (lint-format "perhaps ~S -> ~A" caller form `(format #f "~NC" ,len ,(string-ref form 0)))))
+	     env)
+
+	    ((vector? form)
+	     (unless (or (int-vector? form)
+			 (byte-vector? form)
+			 (float-vector? form))
+	       (let ((len (length form)))
+		 (when (positive? len)
+		   (if (integer? (form 0))
+		       (do ((i 1 (+ i 1)))
+			   ((or (= i len)
+				(not (integer? (vector-ref form i))))
+			    (if (= i len)
+				(lint-format "~A could be ~A" caller
+					     (let-temporarily (((*s7* 'print-length) 8))
+					       (values (object->string form)
+						       (object->string (copy form (make-int-vector len)))))))))
+		       (if (float? (form 0))
+			   (do ((i 1 (+ i 1)))
+			       ((or (= i len)
+				    (not (float? (vector-ref form i))))
+				(if (= i len)
+				    (lint-format "~A could be ~A" caller
+						 (let-temporarily (((*s7* 'print-length) 8))
+						   (values (object->string form)
+							   (object->string (copy form (make-float-vector len)))))))))))
+		   (let ((happy #t))
+		     (for-each
+		      (lambda (x)
+			(when (and (pair? x)
+				   (eq? (car x) 'unquote))
+			  (lint-walk caller (cadr x) env) ; register refs
+			  (set! happy #f)))
+		      form)
+		     ;; (begin (define x 1) `#(,x))
+		     (if (not happy)
+			 (lint-format "quasiquoted vectors are not supported: ~A~%~NCperhaps use `(vector ...) rather than `#(...)" caller
+				      (truncated-list->string form)
+				      (+ lint-left-margin 4) #\space))))))
+	           ;; `(x #(,x)) for example will not work in s7, but `(,x ,(vector x)) will
+	     env)
+
+	    (else
+	     env)))
+
+
+    ;; -------- lint-file --------
+    (define *report-input* #t)
+    ;; lint-file is called via load etc above and it's a pain to thread this variable all the way down the call chain
+
+    (define (lint-file-1 file env)
+      (set! linted-files (cons file linted-files))
+      (let ((fp (if (input-port? file)
+		    file
+		    (begin
+		      (set! *current-file* file)
+		      (catch #t
+			(lambda ()
+			  (let ((p (open-input-file file)))
+			    (when *report-input*
+			      (out-format outport
+				      (if (and (output-port? outport)
+					       (not (member outport (list *stderr* *stdout*))))
+					  (values "~%~NC~%;~A~%" (+ lint-left-margin 16) #\-)
+					  ";~A~%")
+				      file))
+			    p))
+			(lambda (type info)
+			  (out-format outport "~NCcan't open ~S: ~A~%" lint-left-margin #\space file (apply format #f info))
+			  #f))))))
+
+	(if (not (input-port? fp))
+	    env
+	    (do ((vars env)
+		 (line 0)
+		 (last-form #f)
+		 (last-line-number -1)
+		 (form (read fp) (read fp)))
+		((eof-object? form)
+
+		 (if (not (input-port? file))
+		     (close-input-port fp))
+
+		 (when (and *report-repeated-code-fragments*
+			    (or (not *report-loaded-files*)
+				(= lint-left-margin 1)))
+		   (let ((reportables ())
+			 (size-cutoff (+ *fragment-min-size* 6))
+			 (score-cutoff (if (integer? *report-repeated-code-fragments*) *report-repeated-code-fragments* 130)))
+		     (do ((i fragmin (+ i 1)))
+			 ((> i fragmax))
+		       (when (and (vector-ref fragments i)
+				  (> (hash-table-entries (vector-ref fragments i)) 0))
+			 (for-each (lambda (kv)
+				     (let ((vals (cdr kv)))
+				       (when (> (vals 0) 1) ; more than 1 use of fragment
+					 (let ((score (* i (vals 0) (vals 0))))
+					   (when (and (> score score-cutoff)
+						      (or (> i size-cutoff)
+							  (let ((count 0))
+							    (let counter ((tree (car kv)))
+							      (if (pair? tree)
+								  (begin
+								    (counter (car tree))
+								    (counter (cdr tree)))
+								  (if (memq tree '(<1> <2> <3> <4>))
+								      (set! count (+ count 1)))))
+							    (> (- i count) *fragment-min-size*))))
+					     (vector-set! vals 1 (map (lambda (b) ; line numbers of use points
+									(if (< 0 b 100000)
+									    b
+									    (values)))
+								      (reverse (vector-ref vals 1))))
+					     (set! reportables (cons (list score i kv) reportables)))))))
+				   (vector-ref fragments i))))
+		     (let ((reported-lines ())
+			   (reported #f)
+			   (reports 0))
+		       (for-each (lambda (rp)
+				   (let ((size (cadr rp))
+					 (keyval (caddr rp)))
+				     (let ((val (cdr keyval)))
+				       (unless (or (>= reports 20)
+						   (and (pair? (val 1))
+						    (memv (car (val 1)) reported-lines)))
+					 (if (pair? (val 1))
+					     (set! reported-lines (cons (car (val 1)) reported-lines)))
+					 (unless reported
+					   (set! reported #t)
+					   (out-format outport "~%~NCrepeated code fragments:~%" lint-left-margin #\space))
+					 (set! reports (+ reports 1))
+					 (out-format outport
+						 (if (equal? (val 3) (car keyval))
+						     (values "~NCsize: ~A, uses: ~A, lines: '~A:~%~NCexpression: ~A~%"
+							     lint-left-margin #\space
+							     size (val 0) (val 1)
+							     (+ lint-left-margin 2) #\space
+							     (let-temporarily ((target-line-length 120))
+							       (truncated-list->string (car keyval))))
+						     (values "~NCsize: ~A, uses: ~A, lines: '~A:~%~NCpattern: ~A~%~NCexample: ~A~A~%"
+							     lint-left-margin #\space
+							     size (val 0) (val 1)
+							     (+ lint-left-margin 2) #\space
+							     (let-temporarily ((target-line-length 120))
+							       (truncated-list->string (car keyval)))
+							     (+ lint-left-margin 2) #\space
+							     (let-temporarily ((target-line-length 120))
+							       (truncated-list->string (val 3)))
+							     (if (not (and (> size 10)
+									   (val 5)))
+								 ""
+								 (let ((vars (map (lambda (v) (case (car v) ((()) (values)) (else))) (val 5))))
+								   (if (pair? vars)
+								       (format #f "~%~NCwith var~P: ~{~A ~}"
+									       (+ lint-left-margin 4) #\space (length vars) vars)
+								       ""))))))))))
+				 (sort! reportables                              ; the sort needs to be stable across calls so diff works on the output
+					(lambda (kv1 kv2)
+					  (or (> (car kv1) (car kv2))            ; first sort by (size * uses * uses)
+					      (and (= (car kv1) (car kv2))
+						   (let ((a (cdaddr kv1))
+							 (b (cdaddr kv2)))
+						     (or (> (a 0) (b 0))         ; then sort by size
+							 (and (= (a 0) (b 0))    ; then length of (example) original form as a string
+							      (or (string<? (or (a 4) (set! (a 4) (object->string (a 3))))
+									    (or (b 4) (set! (b 4) (object->string (b 3)))))
+								  (and (string=? (a 4) (b 4)) ; finally by reduced form as a string
+								       (string<? (object->string (car kv1))
+										 (object->string (car kv2))))))))))))))))
+		 vars) ; lint-file-1 should return the environment
+
+	      (if (pair? form)
+		  (set! line (max line (or (pair-line-number form) 0))))
+	      ;(format *stderr* "~S~%" form)
+
+	      (if (not (or (= last-line-number -1)
+			   (side-effect? last-form vars)))
+		  (out-format outport "~NCtop-level (line ~D): this has no effect: ~A~%"
+			  lint-left-margin #\space last-line-number
+			  (truncated-list->string last-form)))
+	      (set! last-form form)
+	      (set! last-line-number line)
+
+	      (if (and (len>1? form)
+		       (hash-table-ref definers-table (car form))    ; set! case is handled elsewhere
+		       (not (memq (car form) '(eval eval-string load require)))  ; (eval-string|load (string-append...)) (eval (string->symbol...))
+		       (or (pair? (cadr form))
+			   (symbol? (cadr form))))
+		  (let ((f ((if (pair? (cadr form)) caadr cadr) form)))
+		    (if (and (symbol? f)
+			     (hash-table-ref built-in-functions f))
+			(out-format outport "~NCtop-level ~Aredefinition of built-in function ~A: ~A~%"
+				lint-left-margin #\space
+				(if (and (pair-line-number form)
+					 (> (pair-line-number form) 0))
+				    (format #f "(line ~D) " (pair-line-number form))
+				    "")
+				f (truncated-list->string form)))))
+
+	      (set! vars (lint-walk (if (symbol? form)
+					form
+					(and (pair? form)
+					     (car form)))
+				    form
+				    vars))))))
+
+
+    (define (lint-file file env)
+      ;; (if (string? file) (format *stderr* "lint ~S~%" file))
+
+      (if (member file linted-files)
+	  env
+	  (let ((old-current-file *current-file*)
+		(old-pp-left-margin pp-left-margin)
+		(old-lint-left-margin lint-left-margin)
+		(old-load-path *load-path*))
+
+	    (dynamic-wind
+		(lambda ()
+		  (set! pp-left-margin (+ pp-left-margin 4))
+		  (set! lint-left-margin (+ lint-left-margin 4))
+		  (when (and (string? file)
+			     (char=? (file 0) #\/))
+		    (let ((last-pos 0))
+		      (do ((pos (char-position #\/ file (+ last-pos 1)) (char-position #\/ file (+ last-pos 1))))
+			  ((not pos)
+			   (if (> last-pos 0)
+			       (set! *load-path* (cons (substring file 0 last-pos) *load-path*))))
+			(set! last-pos pos)))))
+
+		(lambda ()
+		  (lint-file-1 file env))
+
+		(lambda ()
+		  (set! pp-left-margin old-pp-left-margin)
+		  (set! lint-left-margin old-lint-left-margin)
+		  (set! *current-file* old-current-file)
+		  (set! *load-path* old-load-path)
+		  (if (positive? (length *current-file*))
+		      (newline outport)))))))
+
+
+    ;;; --------------------------------------------------------------------------------'
+    ;;; lint itself
+    ;;;
+    (let ((+documentation+ "(lint file port) looks for infelicities in file's scheme code")
+	  (+signature+ '(#t (string? input-port?) (output-port? null? not) boolean?)) ; not list! we want a list of symbols
+	  (readers
+	   (list (cons #\e (lambda (str)
+			     (unless (string=? str "e")
+			       (let ((num (string->number (substring str 1))))
+				 (cond ((not num))
+				       ((rational? num)
+					(out-format outport "~NCthis #e is dumb, #~A -> ~A~%" lint-left-margin #\space str (substring str 1)))
+				       ((not (real? num))
+					(out-format outport "~NC#e can't handle complex numbers, #~A -> ~A~%" lint-left-margin #\space str num))
+				       ((= num (floor num))
+					(out-format outport "~NCperhaps #~A -> ~A~%" lint-left-margin #\space str (floor num))))))
+			     #f))
+		 (cons #\i (lambda (str)
+			     (unless (string=? str "i")
+			       (let ((num (string->number (substring str 1))))
+				 (when num
+				   (out-format outport
+					   (if (not (rational? num))
+					       (values "~NCthis #i is dumb, #~A -> ~A~%" lint-left-margin #\space str (substring str 1))
+					       (values "~NCperhaps #~A -> ~A~%" lint-left-margin #\space str (* 1.0 num)))))))
+			     #f))
+		 (cons #\d (lambda (str)
+			     (if (and (not (string=? str "d"))
+				      (string->number (substring str 1)))
+				 (out-format outport "~NC#d is pointless, #~A -> ~A~%" lint-left-margin #\space str (substring str 1)))
+			     #f))
+
+		 (cons #\' (lambda (str)                      ; for Guile (and syntax-rules, I think)
+			     (list 'syntax (if (string=? str "'") (read) (string->symbol (substring str 1))))))
+
+		 (cons #\` (lambda (str)                      ; for Guile (sigh)
+			     (list 'quasisyntax (if (string=? str "`") (read) (string->symbol (substring str 1))))))
+
+		 (cons #\, (lambda (str)                      ; the same, the last is #,@ -> unsyntax-splicing -- right.
+			     (list 'unsyntax (if (string=? str ",") (read) (string->symbol (substring str 1))))))
+
+		 (cons #\& (lambda (str)                      ; ancient Guile code
+			     (and (> (length str) 1)
+				  (string->keyword (substring str 1)))))
+
+		 (cons #\\ (lambda (str)
+			     (cond ((assoc str '(("\\x0"        . #\null)
+						 ("\\x7"        . #\alarm)
+						 ("\\x8"        . #\backspace)
+						 ("\\x9"        . #\tab)
+						 ("\\xd"        . #\return)
+						 ("\\xa"        . #\newline)
+						 ("\\1b"        . #\escape)
+						 ("\\x20"       . #\space)
+						 ("\\x7f"       . #\delete)))
+				    => (lambda (c)
+					 (out-format outport "~NC#\\~A is ~W~%" lint-left-margin #\space (substring str 1) (cdr c)))))
+			     #f))
+
+		 (cons #\! (lambda (str)
+			     (if (member str '("!optional" "!default" "!rest" "!key" "!aux" "!false" "!true" "!r6rs") string-ci=?) ; for MIT-scheme
+				 (string->keyword (substring str 1))
+				 (if (string=? str "!eof") ; Bigloo? or Chicken? Guile writes it as #<eof> but can't read it
+				     (begin
+				       (out-format outport "~NC#!eof should probably be #<eof>~%" lint-left-margin #\space)
+				       #<eof>)
+				     (let ((lc (str 0)))   ; s7 should handle this, but...
+				       (do ((c (read-char) (read-char)))
+					   ((or (and (eof-object? c)
+						     (or (out-format outport "~NCunclosed block comment~%" lint-left-margin #\space)
+							 #t))
+						(and (char=? lc #\!)
+						     (char=? c #\#)))
+					    #f)
+					 (set! lc c)))))))))
+	  (read-hooks
+	   ;; try to get past all the # and \ stuff in other Schemes
+	   ;;   main remaining problem: [] used as parentheses (Gauche and Chicken for example)
+	   (list (lambda (h)
+		   (let ((data (h 'data))
+			 (line (port-line-number)))
+		     (if (not (h 'type))
+			 (begin
+			   (out-format outport "~NCreader~A: unknown \\ usage: \\~C~%" lint-left-margin #\space (if (zero? line) "" (format #f "[~A]" line)) data)
+			   (set! (h 'result) data))
+			 (begin
+			   (out-format outport "~NCreader~A: unknown # object: #~A~%" lint-left-margin #\space (if (zero? line) "" (format #f "[~A]" line)) data)
+			   (set! (h 'result)
+				 (catch #t
+				   (lambda ()
+				     (case (data 0)
+				       ((#\;) (read) (values))
+
+				       ((#\T)
+					(and (string=? data "T")
+					     (out-format outport "#T should be #t~%")
+					     #t))
+
+				       ((#\F)
+					(and (string=? data "F")
+					     (out-format outport "#F should be #f~%")
+					     ''#f))
+
+				       ((#\X #\B #\O #\D)
+					(let ((num (string->number (substring data 1) (case (data 0) ((#\X) 16) ((#\O) 8) ((#\B) 2) ((#\D) 10)))))
+					  (if (number? num)
+					      (begin
+						(out-format outport "~NCuse #~A~A not #~A~%"
+							lint-left-margin #\space
+							(char-downcase (data 0)) (substring data 1) data)
+						num)
+					      (string->symbol data))))
+
+				       ((#\i)
+					(out-format outport "#i is used for int-vectors, not numbers.~%")
+					(cond ((string->number (substring data 1)) => exact->inexact) (else #f)))
+
+				       ((#\r)
+					(out-format outport "#r is used for float-vectors, not numbers.~%")
+					#f)
+
+				       ((#\l #\z)
+					(let ((num (string->number (substring data 1)))) ; Bigloo (also has #ex #lx #z and on and on)
+					  (if (number? num)
+					      (begin
+						(out-format outport "~NCjust omit this silly #~C!~%" lint-left-margin #\space (data 0))
+						num)
+					      (string->symbol data))))
+
+				       ((#\u) ; for Bigloo
+					(if (string=? data "unspecified")
+					    (out-format outport "~NCuse #<unspecified>, not #unspecified~%" lint-left-margin #\space))
+					;; #<unspecified> seems to hit the no-values check?
+					(string->symbol data))
+				       ;; Bigloo also seems to use #" for here-doc concatenation??
+
+				       ((#\v) ; r6rs byte-vectors?
+					(if (string=? data "vu8")
+					    (out-format outport "~NCuse #u, not #vu8~%" lint-left-margin #\space))
+					(string->symbol data))
+
+				       ((#\>) ; for Chicken, apparently #>...<# encloses in-place C code
+					(do ((last #\#)
+					     (c (read-char) (read-char)))
+					    ((and (char=? last #\<)
+						  (char=? c #\#))
+					     (values))
+					  (if (char=? c #\newline)
+					      (set! (port-line-number) (+ (port-line-number) 1)))
+					  (set! last c)))
+
+				       ((#\<) ; Chicken also, #<<EOF -> EOF
+					(if (string=? data "<undef>") ; #<undef> chibi et al
+					    #<undefined>
+					    (if (and (char=? (data 1) #\<)
+						     (> (length data) 2))
+						(do ((end (substring data 2))
+						     (c (read-line) (read-line)))
+						    ((string-position end c)
+						     (values)))
+						(string->symbol data))))
+
+				       ((#\\)
+					(cond ((assoc data '(("\\newline"   . #\newline)
+							     ("\\return"    . #\return)
+							     ("\\space"     . #\space)
+							     ("\\tab"       . #\tab)
+							     ("\\null"      . #\null)
+							     ("\\nul"       . #\null)
+							     ("\\linefeed"  . #\linefeed)
+							     ("\\alarm"     . #\alarm)
+							     ("\\esc"       . #\escape)
+							     ("\\escape"    . #\escape)
+							     ("\\rubout"    . #\delete)
+							     ("\\delete"    . #\delete)
+							     ("\\backspace" . #\backspace)
+							     ("\\page"      . #\xc)
+							     ("\\altmode"   . #\escape)
+							     ("\\bel"       . #\alarm) ; #\x07
+							     ("\\sub"       . #\x1a)
+							     ("\\soh"       . #\x01)
+
+							     ;; these are for Guile
+							     ("\\vt"        . #\xb)
+							     ("\\bs"        . #\backspace)
+							     ("\\cr"        . #\newline)
+							     ("\\sp"        . #\space)
+							     ("\\lf"        . #\linefeed)
+							     ("\\nl"        . #\null)
+							     ("\\ht"        . #\tab)
+							     ("\\ff"        . #\xc)
+							     ("\\np"        . #\xc))
+						      string-ci=?)
+					       => (lambda (c)
+						    (out-format outport "~NCperhaps use ~W instead~%" (+ lint-left-margin 4) #\space (cdr c))
+						    (cdr c)))
+					      (else
+					       (string->symbol (substring data 1)))))
+				       (else
+					(string->symbol data))))
+				   (lambda args #f))))))))))
+
+      (lambda* (file (outp *output-port*) (report-input #t))
+	(if (null? outp)
+	    (set! outp (current-output-port))
+	    (if (and outp (not (output-port? outp)))
+		(error 'wrong-type-arg (format #f "~S should be an output port" outp))))
+	(set! outport outp)
+	(set! other-identifiers (make-hash-table))
+	(set! linted-files ())
+	(fill! other-names-counts 0)
+
+	(set! fragmax (min fragmax (- *fragment-max-size* 1)))
+	(fill! fragments #f)
+
+	(set! last-simplify-boolean-line-number -1)
+	(set! last-simplify-numeric-line-number -1)
+	(set! last-simplify-cxr-line-number -1)
+	(set! last-checker-line-number -1)
+	(set! last-cons-line-number -1)
+	(set! last-if-line-number -1)
+	(set! last-if->case-line-number -1)
+	(set! last-let->case-line-number -1)
+	(set! last-rewritten-internal-define #f)
+	(set! last-lambda-let #f)
+	(set! last-lambda-let-funcs #f)
+	(set! line-number -1)
+	(set! quote-warnings 0)
+	(set! pp-left-margin 0)
+	(set! lint-left-margin -3) ; lint-file above adds 4
+	(set! big-constants (make-hash-table))
+	(set! fragmin *fragment-max-size*)
+	(set! fragmax 0)
+
+	(set! *report-input* report-input)
+	(set! *report-nested-if* (if (integer? *report-nested-if*) (max 3 *report-nested-if*) 4))
+	(set! *report-short-branch* (if (integer? *report-short-branch*) (max 0 *report-short-branch*) 12))
+	(set! *#readers* readers)
+	(unless (defined? 'lint-no-read-error)
+	  (set! (hook-functions *read-error-hook*) read-hooks))
+
+	;; preset list-tail and list-ref
+	(vector-set! fragments 10 (make-hash-table))
+	(hash-table-set! (vector-ref fragments 10) '((if (zero? <2>) <1> (<F> (cdr <1>) (- <2> 1))))
+			 (vector 0 ()
+				 (list (cons 'list-tail
+					     (inlet 'initial-value '(define (list-tail x k) (if (zero? k) x (list-tail (cdr x) (- k 1))))
+						    'arglist '(x k)
+						    'history :built-in)))
+				 '(define (list-tail x k) (if (zero? k) x (list-tail (cdr x) (- k 1))))
+				 #f))
+	(vector-set! fragments 12 (make-hash-table))
+	(hash-table-set! (vector-ref fragments 12) '((if (= <2> 0) (car <1>) (<F> (cdr <1>) (- <2> 1))))
+			 (vector 0 ()
+				 (list (cons 'list-ref (inlet 'initial-value '(define (list-ref items n) (if (= n 0) (car items) (list-ref (cdr items) (- n 1))))
+							      'arglist '(items n)
+							      'history :built-in)))
+				 '(define (list-ref items n) (if (= n 0) (car items) (list-ref (cdr items) (- n 1))))
+				 #f))
+
+
+	;; -------- call lint --------
+
+	(let ((vars (let-temporarily (((*s7* 'expansions?) #f)
+				      ((lint-pp-funclet '*pretty-print-cycles*) #f))
+		      (lint-file file ()))))
+	  (set! lint-left-margin (max lint-left-margin 1))
+
+	  (when (pair? vars)
+	    (if *report-multiply-defined-top-level-functions*
+		(for-each
+		 (lambda (var)
+		   (let ((var-file (hash-table-ref *top-level-objects* (car var))))
+		     (if (not var-file)
+			 (hash-table-set! *top-level-objects* (car var) *current-file*)
+			 (if (and (string? *current-file*)
+				  (not (string=? var-file *current-file*)))
+			     (out-format outport "~NC~S is defined at the top level in ~S and ~S~%"
+				     lint-left-margin #\space
+				     (car var) var-file *current-file*)))))
+		 vars))
+
+	    (if (string? file)
+		(report-usage top-level: "" vars vars))))
+
+	(for-each
+	 (lambda (p)
+	   (if (> (cdr p) 3)
+	       (out-format outport "'~A occurs ~D times~%"
+		       (truncated-list->string (car p)) (cdr p))))
+	 big-constants)
+
+	;(format *stderr* "~W~%" other-identifiers)
+	(if (and *report-undefined-identifiers*
+		 (positive? (hash-table-entries other-identifiers)))
+	    (let ((lst (sort! (map car other-identifiers)
+			      (lambda (a b)
+				(string<? (symbol->string a) (symbol->string b))))))
+	      (out-format outport "~NCth~A identifier~A not defined~A: ~{~S~^ ~}~%"
+		      lint-left-margin #\space
+		      (if (= (hash-table-entries other-identifiers) 1)
+			  (values "is" " was")
+			  (values "e following" "s were"))
+		      (if (string? file) (format #f " in ~A" file) "")
+		      lst)
+	      (fill! other-identifiers #f)))))))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; this reads an HTML file, finds likely-looking scheme code, and runs lint over it.
+;;;    called on all snd files in hg.scm
+
+(define html-lint
+  (letrec ((remove-markups
+	    (lambda (str)
+	      (let ((tpos (string-position "<b>" str)))
+		(if tpos
+		    (let ((epos (string-position "</b>" str)))
+		      (remove-markups (string-append (substring str 0 tpos)
+						     (substring str (+ tpos 3) epos)
+						     (substring str (+ epos 4)))))
+		    (let ((apos (string-position "<a " str))
+			  (epos (string-position "<em " str)))
+		      (if (not (or apos epos))
+			  str
+			  (let* ((pos ((if (and apos epos) min or) apos epos))
+				 (bpos (+ (char-position #\> str (+ pos 1)) 1))
+				 (epos (string-position (if (and apos (= pos apos)) "</a>" "</em>") str bpos)))
+			    (string-append (substring str 0 pos)
+					   (substring str bpos epos)
+					   (remove-markups (substring str (+ epos (if (and apos (= apos pos)) 4 5))))))))))))
+	   (fixup-html
+	    (lambda (str)
+	      (let ((pos (char-position #\& str)))
+		(if (not pos)
+		    str
+		    (string-append (substring str 0 pos)
+				   (let* ((epos (char-position #\; str pos))
+					  (substr (substring str (+ pos 1) epos)))
+				     (string-append (cond ((assoc substr '(("gt"    . ">")
+									   ("lt"    . "<")
+									   ("mdash" . "-")
+									   ("amp"   . "&"))
+								  string=?) => cdr)
+							  (else (format #t "unknown: ~A~%" substr)))
+						    (fixup-html (substring str (+ epos 1)))))))))))
+    (lambda (file)
+      (call-with-input-file file
+	(lambda (f)
+	  (do ((line-num 0 (+ line-num 1))
+	       (line (read-line f #t) (read-line f #t)))
+	      ((eof-object? line))
+
+	    ;; look for <pre , gather everything until </pre>
+	    ;;   decide if it is scheme code (first char is #\()
+	    ;;   if so, clean out html markup stuff, call lint on that
+
+	    (when (string-position "<pre" line)
+	      (let ((code (substring line (+ (char-position #\> line) 1))))
+		(do ((cline (read-line f #t) (read-line f #t))
+		     (rline 1 (+ rline 1)))
+		    ((string-position "</pre>" cline)
+		     (set! line-num (+ line-num rline)))
+		  (set! code (string-append code cline)))
+
+		;; is first non-whitespace char #\(? ignoring comments
+		(do ((len (length code))
+		     (i 0 (+ i 1)))
+		    ((>= i len))
+		  (let ((c (string-ref code i)))
+		    (unless (char-whitespace? c)
+		      (if (char=? c #\;)
+			  (set! i (char-position #\newline code i))
+			  (begin
+			    (set! i (+ len 1))
+			    (when (char=? c #\()
+			      (catch #t
+				(lambda ()
+				  (let ((outstr (call-with-output-string
+						 (lambda (op)
+						   (call-with-input-string
+						       (object->string (with-input-from-string
+									   (fixup-html (remove-markups code))
+									 read)
+								       #t) ; write, not display
+						     (lambda (ip)
+						       (let-temporarily ((*report-shadowed-variables* #t))
+							 (lint ip op #f))))))))
+				    (if (> (length outstr) 1)               ; possible newline at end
+					(format () ";~A ~D: ~A~%" file line-num outstr))))
+				(lambda args
+				  (format () ";~A ~D, error in read: ~A ~A~%" file line-num args
+					  (fixup-html (remove-markups code)))))))))))))))))))
+
+
+;;; --------------------------------------------------------------------------------
+;;; and this reads C code looking for s7_eval_c_string. No attempt here to
+;;;   handle weird cases.
+
+(define (C-lint file)
+  (call-with-input-file file
+    (lambda (f)
+      (do ((line-num 0 (+ line-num 1))
+	   (line (read-line f #t) (read-line f #t)))
+	  ((eof-object? line))
+
+	;; look for s7_eval_c_string, get string arg without backslashes, call lint
+	(let ((pos (string-position "s7_eval_c_string(sc, \"(" line)))
+	  (when pos
+	    (let ((code (substring line (+ pos 22)))) ; (length "s7_eval_c_string(sc, \"")
+	      (if (not (string-position "\");" code))
+		  (do ((cline (read-line f #t) (read-line f #t))
+		       (rline 1 (+ rline 1)))
+		      ((string-position "\");" cline)
+		       (set! code (string-append code cline))
+		       (set! line-num (+ line-num rline)))
+		    (set! code (string-append code cline))))
+
+	      (let ((len (string-position "\");" code)))
+		(set! code (substring code 0 len))
+
+		;; clean out backslashes
+		(do ((i 0 (+ i 1)))
+		    ((>= i (- len 3)))
+		  (cond ((not (char=? (code i) #\\)))
+
+			((char=? (code (+ i 1)) #\n)
+			 (set! (code i) #\space)
+			 (set! (code (+ i 1)) #\space))
+
+			((memv (code (+ i 1)) '(#\newline #\"))
+			 (set! (code i) #\space))
+
+			((and (char=? (code (+ i 1)) #\\)
+			      (char=? (code (- i 1)) #\#))
+			 (set! (code (- i 1)) #\space)
+			 (set! (code i) #\#)))))
+	      (catch #t
+		(lambda ()
+		  (let ((outstr (call-with-output-string
+				 (lambda (op)
+				   (call-with-input-string code
+				     (lambda (ip)
+				       (let-temporarily ((*report-shadowed-variables* #t))
+					 (lint ip op #f))))))))
+		    (if (> (length outstr) 1) ; possible newline at end
+			(format () ";~A ~D: ~A~%" file line-num outstr))))
+		(lambda args
+		  (format () ";~A ~D, error in read: ~A ~A~%" file line-num args code))))))))))
+
+
+;;; --------------------------------------------------------------------------------
+#|
+;;; external use of lint contents (see also snd-lint.scm):
+(for-each (lambda (f)
+            (if (not (hash-table-ref (*lint* 'no-side-effect-functions) (car f)))
+                (format *stderr* "~A " (car f))))
+          (*lint* 'built-in-functions))
+
+;;; get rid of []'s! (using Snd)
+(define (edit file)
+  (let* ((str (file->string file))
+	 (len (length str)))
+    (do ((i 0 (+ i 1)))
+	((= i len))
+      (case (str i)
+	((#\]) (set! (str i) #\)))
+	((#\[) (set! (str i) #\())))
+    (call-with-output-file file
+      (lambda (p)
+	(display str p)))
+    #f))
+|#
+
+;;; 54 896368, 53 874874, 52 871075, 54 889347
diff --git a/s7/loop.scm b/s7/loop.scm
new file mode 100644
index 0000000..b7c7656
--- /dev/null
+++ b/s7/loop.scm
@@ -0,0 +1,1091 @@
+;;; **********************************************************************
+;;; 
+;;; Copyright (C) 2002 Heinrich Taube (taube@uiuc.edu) 
+;;; 
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;; 
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;; 
+;;; **********************************************************************
+
+;;; $Name:  $
+;;; $Revision: 1.6 $
+;;; $Date: 2005/11/17 13:29:37 $
+
+;;;
+;;; Implementation of the CLTL2 loop macro. The following 
+;;; non Rev 5 definitions need to be in effect before the file
+;;; is loaded:
+;;;
+;;; (define-macro (name . args) ...)
+;;; (error string)
+;;; (gensym string)
+;;;
+
+(define-macro (loop . args)
+  (scheme-loop args))
+
+(define-macro (push val sym)
+  `(begin (set! ,sym (cons ,val ,sym)) ,sym))
+
+(define-macro (pop sym)
+  (let ((v (gensym "v")))
+    `(let ((,v (car ,sym)))
+       (set! ,sym (cdr ,sym))
+       ,v)))
+
+;;; this next one is a no-op but i need it as a marker for my cltl2
+;;; translator.
+
+(define-macro (function sym) sym)     
+
+;;; getters and setters for the loop-clause "struct"
+
+(define (loop-operator c)          (vector-ref  c 0))
+(define (loop-operator-set! c x)   (vector-set! c 0 x))
+(define (loop-bindings c)          (vector-ref  c 1))
+(define (loop-bindings-set! c x)   (vector-set! c 1 x))
+(define (loop-collectors c)        (vector-ref  c 2))
+(define (loop-collectors-set! c x) (vector-set! c 2 x))
+(define (loop-initially c)         (vector-ref  c 3))
+(define (loop-initially-set! c x)  (vector-set! c 3 x))
+(define (loop-end-tests c)         (vector-ref  c 4))
+(define (loop-end-tests-set! c x)  (vector-set! c 4 x))
+(define (loop-looping c)           (vector-ref  c 5))
+(define (loop-looping-set! c x)    (vector-set! c 5 x))
+(define (loop-stepping c)          (vector-ref  c 6))
+(define (loop-stepping-set! c x)   (vector-set! c 6 x))
+(define (loop-finally c)           (vector-ref  c 7))
+(define (loop-finally-set! c x)    (vector-set! c 7 x))
+(define (loop-returning c)         (vector-ref  c 8))
+(define (loop-returning-set! c x)  (vector-set! c 8 x))
+
+(define (make-loop-clause . args)
+  (let ((v (vector #f '() '() '() '() '() '() '() '())))
+    (if (null? args) v
+	(do ((a args (cddr a)))
+	    ((null? a) v)
+	  (case (car a)
+	    ((operator) (loop-operator-set! v (cadr a)))
+	    ((bindings) (loop-bindings-set! v (cadr a)))
+	    ((collectors) (loop-collectors-set! v (cadr a)))
+	    ((initially) (loop-initially-set! v (cadr a)))
+	    ((end-tests) (loop-end-tests-set! v (cadr a)))
+	    ((looping) (loop-looping-set! v (cadr a)))
+	    ((stepping) (loop-stepping-set! v (cadr a)))
+	    ((finally) (loop-finally-set! v (cadr a)))
+	    ((returning) (loop-returning-set! v (cadr a))))))))
+
+(define (gather-clauses caller clauses)
+  ;; nconc all clausal expressions into one structure
+  (let ((gather-clause 
+	 (lambda (clauses accessor)
+	   ;; append data from clauses
+	   (do ((l '()))
+	       ((null? clauses) l)
+	     (set! l (append l (accessor (car clauses))))
+	     (set! clauses (cdr clauses))))))
+    (make-loop-clause 'operator caller
+		      'bindings
+                      (gather-clause clauses 
+                                     (function loop-bindings))
+		      'collectors
+                      (gather-clause clauses 
+                                     (function loop-collectors))
+		      'initially 
+                      (gather-clause clauses 
+                                     (function loop-initially))
+		      'end-tests 
+                      (gather-clause clauses 
+                                     (function loop-end-tests))
+		      'looping 
+                      (gather-clause clauses 
+                                     (function loop-looping))
+		      'stepping 
+                      (gather-clause clauses 
+                                     (function loop-stepping))
+		      'finally 
+                      (gather-clause clauses
+                                     (function loop-finally))
+		      'returning 
+                      (gather-clause clauses
+                                     (function loop-returning)))))
+
+(define (loop-op? x ops)
+  (assoc x ops))
+
+(define (loop-variable? x)
+  (symbol? x))
+
+(define (make-binding var val)
+  (list var val))
+
+(define (loop-error ops forms . args)
+  ;; all error messages include error context.
+  (let ((loop-context
+	 (lambda (lst ops)
+	   ;; return tail of expr up to next op in cdr of tail
+	   (do ((h lst)
+		(l '()))
+	       ((or (null? lst)
+		    ;; ignore op if in front.
+		    (and (not (eq? h lst))
+			 (loop-op? (car lst) ops)))
+		(reverse l))
+	     (set! l (cons (car lst) l))
+	     (set! lst (cdr lst))))))
+    (let ((forms (loop-context forms ops)))
+      (newline)
+      (display "LOOP ERROR: ")
+      (do ((tail args (cdr tail)))
+	  ((null? tail) #f)
+	(display (car tail)))
+      (newline)
+      (display "clause context: ")
+      (if (null? forms) 
+	(display "()")
+	(do ((tail forms (cdr tail)))
+	    ((null? tail) #f)
+	  (if (eq? tail forms) (display "'"))
+	  (display (car tail))
+	  (display (if (null? (cdr tail)) "'" " "))))
+      (newline)
+      (error "illegal loop syntax"))))
+
+(define (parse-for forms clauses ops)
+  ;; forms is (FOR ...)
+  (let ((op (loop-op? (car forms) ops)))
+    (if (null? (cdr forms))
+      (loop-error ops forms "Variable expected but source code ran out." )
+      (let ((var (cadr forms)))
+        (if (loop-variable? var)
+          (if (null? (cddr forms))
+            (loop-error ops forms
+                     "'for' clause expected but source code ran out.")
+            ;; find the iteration path in the op
+            (let ((path (assoc (caddr forms) (cdddr op))))
+              ;; path is (<pathop> <parser>)
+              (if (not path)
+                (loop-error ops forms "'" (caddr forms) "'"
+			    " is not valid with 'for'.")
+                ( (cadr path) forms clauses ops))))
+          (loop-error ops forms "Found '" (cadr forms)
+		      "' where a variable expected."))))))
+
+(define (parse-numerical-for forms clauses ops)
+  ;; forms is (FOR <var> <OP> ...)
+  ;; where <OP> is guaranteed to be one of: FROM TO BELOW ABOVE DOWNTO
+  clauses
+  (let ((var (cadr forms))
+        (tail (cddr forms))
+        (bind '())
+        (from #f)
+        (head #f)
+        (last #f)
+        (stop #f)
+        (step #f)
+        (test #f)
+        (incr #f))
+    
+    (do ((next #f))
+        ((or (null? tail) (loop-op? (car tail) ops)))
+      (set! next (pop tail))
+      (if (null? tail)
+        (loop-error ops forms
+		    "Expected expression but source code ran out."))
+      (case next
+        ((from downfrom)
+         (if head (loop-error ops forms "Found '" next "' when '"
+			      head "' in effect."))
+         (set! head next)
+         (set! from (pop tail)))
+        ((below)
+         (if last (loop-error ops forms "Found '" next "' when '"
+			      last "' in effect."))
+         (set! stop (pop tail))
+         (set! last next))
+        ((to)
+         (if last (loop-error ops forms "Found '" next "' when '"
+			      last "' in effect."))
+         (set! stop (pop tail) )
+         (set! last next))
+        ((above )
+         (if last (loop-error ops forms "Found '" next "' when '"
+			      last "' in effect."))
+         (set! stop (pop tail))
+         (set! last next))
+        ((downto )
+         (if last (loop-error ops forms "Found '" next "' when '"
+			      last "' in effect."))
+         (set! stop (pop tail))
+         (set! last next))
+        ((by)
+         (if step (loop-error ops forms "Found duplicate 'by'."))
+         (set! step (pop tail)))
+        (else
+         (loop-error ops forms 
+		     "'" next "' is not valid with 'for'."))))
+    (if (not head)
+      (set! head 'from))
+    (if (or (eq? head 'downfrom)
+            (eq? last 'downto)
+            (eq? last 'above))
+      (begin
+       (set! incr '-)
+       (if (eq? last 'above)
+         (set! test '<=)
+         (set! test '<)))   ; allow to for downto
+      (begin
+       (set! incr '+)
+       (if (eq? last 'below)
+         (set! test '>=)
+         (set! test '>))))
+    
+    ;; add binding for initial value
+    (push (make-binding var (or from 0)) bind)
+    ;; add binding for non-constant stepping values.
+    (if (not step)
+      (set! step 1)
+      (if (not (number? step))
+        (let ((var (gensym "v")))
+          (push (make-binding var step) bind)
+          (set! step var))))
+    (set! step `(set! ,var (,incr ,var ,step)))
+    (if stop
+      (let ((end (gensym "v")))
+        (push (make-binding end stop) bind)
+        (set! stop (list test var end))))
+    (values (make-loop-clause 'operator 'for
+			      'bindings (reverse bind)
+			      'stepping (list step)
+			      'end-tests (if (not stop)
+					   '() (list stop)))
+            tail)))
+
+(define (parse-repeat forms clauses ops)
+  ;; forms is (REPEAT <FORM> ...)
+  (if (null? (cdr forms))
+    (loop-error ops forms 
+		"'repeat' clause expected but source code ran out." )
+    (call-with-values (lambda ()
+			(parse-numerical-for 
+			 (list 'for (gensym "v") 'below (cadr forms))
+			 clauses ops))
+		      (lambda (clause ignore)
+                        ignore
+			(values clause (cddr forms))))))
+
+(define (parse-sequence-iteration forms clauses ops)
+  ;; tail is (FOR <var> <OP> ...)
+  ;; <OP> is guaranteed to be one of: IN ON ACROSS
+  clauses
+  (let ((head forms)
+        (var (cadr forms))
+        (seq (gensym "v"))
+        (tail (cddr forms))
+        (bind '())
+        (data #f) 
+        (init '()) 
+        (loop '()) 
+        (incr #f)
+        (stop '()) 
+        (step '()) 
+        (type #f))
+    
+    (do ((next #f))
+        ((or (null? tail) (loop-op? (car tail) ops)))
+      (set! next (pop tail))
+      (when (null? tail)
+        (loop-error ops head
+		    "Expression expected but source code ran out." ))
+      (case next
+        ((in on across)
+         (if type (loop-error ops head 
+			      "Extraneous '" next "' when '"
+			      type "' in effect."))
+         (set! type next)
+         (set! data (pop tail)))
+        ((by )
+         (if incr 
+           (loop-error ops head "Duplicate 'by'." )
+           (if (eq? type 'across)
+             (loop-error ops head "'by' is invalid with 'across'." )
+             (set! incr (pop tail)))))
+        (else
+         (loop-error ops head "'" next "' is not valid with 'for'."))))
+    ; add bindings for stepping var and source
+    (push (make-binding var #f) bind)
+    (push (make-binding seq data) bind)
+    (if (eq? type 'across)
+      (let ((pos (gensym "v"))
+            (max (gensym "v")))
+        (push (make-binding pos 0) bind)
+        (push (make-binding max #f) bind)
+        (push `(set! ,max (vector-length ,seq)) init)
+        (push `(set! ,pos (+ 1 ,pos)) step)
+        (push `(set! ,var (vector-ref ,seq ,pos)) loop)
+        (push `(>= ,pos ,max) stop))
+      (begin
+       (if incr
+         (if (and (list? incr) (eq? (car incr) 'quote))
+           (push `(set! ,seq (,(cadr incr) ,seq)) step)
+           (push `(set! ,seq (,incr ,seq)) step))
+         (push `(set! ,seq (cdr ,seq)) step))
+       (push (if (eq? type 'in)
+                `(set! ,var (car ,seq))
+                `(set! ,var ,seq))
+              loop)
+       (push `(null? ,seq) stop)))
+    
+    (values (make-loop-clause 'operator 'for
+			      'bindings (reverse bind)
+			      'end-tests stop
+			      'initially init
+			      'looping loop
+			      'stepping step)
+            tail)))
+
+(define (parse-general-iteration forms clauses ops)
+  ;; forms is (FOR <var> = ...)
+  clauses
+  (let ((head forms)
+        (var (cadr forms))
+        (tail (cddr forms))
+        (init #f)
+        (type #f)
+        (loop #f)
+        (step #f))
+    (do ((next #f))
+        ((or (null? tail) (loop-op? (car tail) ops)))
+      (set! next (pop tail))
+      (if (null? tail)
+        (loop-error ops head 
+		    "Expression expected but source code ran out."))
+      (case next
+        ((= )
+         (if type (loop-error ops head "Duplicate '='."))
+         (set! loop `(set! ,var ,(pop tail)))
+         (set! type next))
+        ((then )
+         (if init (loop-error ops head "Duplicate 'then'."))
+         (set! init loop)
+         (set! loop #f)
+         (set! step `(set! ,var ,(pop tail)))
+         (set! type next))
+        (else
+         (loop-error ops head "'" next "' is not valid with 'for'."))))
+    
+    (values (make-loop-clause 'operator 'for
+			      'bindings (list (make-binding var #f))
+			      'initially (if init (list init) '())
+			      'looping (if loop (list loop) '())
+			      'stepping (if step (list step) '()))
+            tail)))
+
+(define (parse-with forms clauses ops)
+  ;; forms is (WITH <var> = ...)
+  clauses
+  (let ((head forms)
+        (tail (cdr forms))
+        (var #f)
+        (expr #f)
+        (and? #f)
+        (bind '())
+        (init '()))
+    (do ((need #t) 
+         (next #f))
+        ((or (null? tail) (loop-op? (car tail) ops)))
+      (set! next (pop tail))
+      (cond ((and (loop-variable? next) need)
+             (if var
+               (loop-error ops head
+			   "Found '" next "' where 'and' expected."))
+             (if expr
+               (loop-error ops head
+			   "Found '" next "' where 'and' expected."))
+             (set! var next)
+             (set! expr #f)
+             (set! and? #f)
+             (set! need #f))
+            ((eq? next 'and)
+             (if and?
+               (loop-error ops head "Duplicate 'and'.")
+               (if var 
+                 (if expr
+                   (begin
+                    (push (make-binding var #f) bind)
+                    (push `(set! ,var ,expr) init))
+                   (push (make-binding var #f) bind))
+                 (loop-error ops head "Extraneous 'and'.")))
+             (set! var #f)
+             (set! expr #f)
+             (set! and? #t)
+             (set! need #t))
+            ((eq? next '=)
+             (if expr
+               (loop-error ops head 
+			   "Found '=' where 'and' expected.")
+               (set! expr (pop tail))))
+            (else
+             (if need
+               (loop-error ops head
+			   "Found '" next "' where variable expected.")
+               (loop-error ops head "Found '" next
+			   "' where '=' or 'and' expected.")))))
+    (if and? 
+      (loop-error ops head "Extraneous 'and'.")
+      (if var 
+        (if expr
+          (begin (push (make-binding var #f) bind)
+                 (push `(set! ,var ,expr) init))
+          (push (make-binding var #f) bind))))
+    
+    (values (make-loop-clause 'operator 'with
+			      'bindings (reverse bind)
+			      'initially (reverse init))
+            tail)))
+
+(define (parse-do forms clauses ops)
+  clauses
+  (let ((head forms)
+        (oper (pop forms))
+        (body '()))
+    (do ()
+        ((or (null? forms)
+             (loop-op? (car forms) ops))
+         (if (null? body)
+           (loop-error ops head "Missing '" oper "' expression.")
+           (set! body (reverse body))))
+      (push (car forms) body)
+      (set! forms (cdr forms)))
+    (values
+     (make-loop-clause 'operator oper 'looping body)
+     forms)))
+
+(define (parse-finally forms clauses ops)
+  clauses
+  (let ((oper (pop forms))
+        (expr #f))
+    (if (null? forms)
+      (loop-error ops forms "Missing '" oper "' expression."))
+    (set! expr (pop forms))
+    (values (make-loop-clause 'operator oper 'finally (list expr))
+            forms)))
+
+(define (parse-initially forms clauses ops)
+  clauses
+  (let ((oper (pop forms))
+        (expr #f))
+    (if (null? forms)
+      (loop-error ops forms "Missing '" oper "' expression."))
+    (set! expr (pop forms))
+    (values (make-loop-clause 'operator oper 'initially (list expr))
+            forms)))
+
+(define (lookup-collector var clauses)
+  ;; collector is list: (<var> <type> <acc> <head>)
+  ;; returns the clause where the collect variable VAR is
+  ;; actually bound or nil if var hasn't already been bound
+  ;; if var is nil only the single system allocated collecter
+  ;; is possibly returned.
+  (let ((checkthem (lambda (var lis)
+                     (do ((a #f)) 
+                         ((or (null? lis) a) a)
+                       (if (eq? var (car (car lis))) ;collector-var
+                         (set! a (car lis)))
+                       (set! lis (cdr lis))))))
+    (do ((c #f))
+        ((or (null? clauses) c) c)
+      (set! c (checkthem var (loop-collectors (car clauses))))
+      (set! clauses (cdr clauses)))))
+
+(define (compatible-accumulation? typ1 typ2)
+  (let ((l1 '(collect append nconc))
+        (l2 '(never always))
+        (l3 '(minimize maximize)))
+    (or (eq? typ1 typ2)
+        (and (member typ1 l1) (member typ2 l1))
+        (and (member typ1 l2) (member typ2 l2))
+        (and (member typ1 l3) (member typ2 l3)))))
+
+(define (parse-accumulation forms clauses ops)
+  ;; forms is (<op> form ...)
+  ;; where <op> is collect append nconc
+  (let ((save forms)
+        (oper (pop forms))
+	(make-collector (lambda (var type acc head)
+			  (list var type acc head)))
+        ;; removed because noop
+	;;(collector-var (lambda (col) (car col)))
+	(collector-type (lambda (col) (cadr col)))
+	(collector-acc (lambda (col) (caddr col)))
+	(collector-head (lambda (col) (cadddr col)))
+        (expr #f)
+        (coll #f)
+        (new? #f)
+        (into #f)
+        (loop '())
+        (bind '())
+        (init '())
+        (tests '())
+        (return '()))
+    
+    (if (null? forms)
+      (loop-error ops forms "Missing '" oper "' expression."))
+    (set! expr (pop forms))
+    (if (not (null? forms))
+      (if (eq? (car forms) 'into)
+        (begin
+          (if (null? (cdr forms))
+            (loop-error ops save "Missing 'into' variable."))
+          (if (loop-variable? (cadr forms))
+            (begin (set! into (cadr forms))
+                   (set! forms (cddr forms)))
+            (loop-error ops save "Found '" (car forms)
+                 "' where 'into' variable expected.")))))
+    
+    ;; search for a clause that already binds either the user specified
+    ;; accumulator (into) or a system allocated one if no into.
+    ;; system collectors
+    ;;   o only one  allowed, all accumuations must be compatible
+    ;;   o returns value
+    ;;   value collector: (nil <op> <#:acc>)
+    ;;   list collector:  (nil <op> <#:tail> <#:head>)
+    ;; into collectors
+    ;;   o any number allowed
+    ;;   o returns nothing.
+    ;;   value collector: (<into> <op> <into> )
+    ;;   list collector:  (<into> <op> <#:tail> <#:head>)
+    (set! coll (lookup-collector into clauses))
+    (if (not coll)
+      (set! new? #t)
+      ;; accumulator already established by earlier clause
+      ;; check to make sure clauses are compatible.
+      (if (not (compatible-accumulation? oper (collector-type coll)))
+        (loop-error ops save "'" (collector-type coll)
+		    "' and '" oper "' are incompatible accumulators.")))
+    (case oper 
+      ((sum count)
+       (let ((acc #f))
+         (if new?
+           (begin 
+            (set! acc (or into (gensym "v")))
+            (push (make-binding acc 0) bind)
+            ;; coll= (nil <op> <#:acc>) or (<into> <op> <into>)
+            (set! coll (make-collector into oper acc #f))
+            ;; only add a return value if new collector isnt into
+            (if (not into) (push acc return)))
+           (set! acc (collector-acc coll)))
+         (if (eq? oper 'sum)
+           (push `(set! ,acc (+ ,acc ,expr)) loop)
+           (push `(if ,expr (set! ,acc (+ ,acc 1))) loop))))
+      ((minimize maximize)
+       (let ((var (gensym "v"))
+             (opr (if (eq? oper 'minimize) '< '>))
+             (acc #f))
+         (if new?
+           (begin
+            (set! acc (or into (gensym "v")))
+            (push (make-binding acc #f) bind)
+            ;; coll= (nil <op> <#:acc>) or (<into> <op> <into>)
+            (set! coll (make-collector into oper acc #f))
+            ;; only add a return value if new collector isnt into
+            (if (not into) (push `(or ,acc 0) return)))
+           (set! acc (collector-acc coll)))
+         (push (make-binding var #f) bind)
+         (push `(begin (set! ,var ,expr)
+                        (if (or (not ,acc) 
+                                (,opr ,var ,acc))
+                          (set! ,acc ,var)))
+                loop)))
+      ((append collect nconc)
+       ;; for list accumulation a pointer to the tail of the list
+       ;; is updated and the head of the list is returned. any
+       ;; into variable is set to the head inside the loop.
+       (let ((head #f)
+             (tail #f))
+         (if (not new?)
+           (begin (set! tail (collector-acc coll))
+                  (set! head (collector-head coll)))
+           (begin
+            (if into (push (make-binding into '(list)) bind))
+            (set! tail (gensym "v"))
+            ;; allocate a pointer to the head of list
+            (set! head (gensym "v"))
+            (push (make-binding head '(list #f)) bind)
+            (push (make-binding tail #f) bind)
+            ;; initialize tail to head
+            (push `(set! ,tail ,head) init)
+            (set! coll (make-collector into oper tail head))
+            ;; only add a return value if new collector isnt into
+            (if (not into)
+              (push `(cdr ,head) return))))
+         ;; add loop accumulation forms
+         (if (eq? oper 'append)
+           (begin
+            (push `(set-cdr! ,tail (append ,expr (list))) loop)
+            (push `(set! ,tail (last-pair ,tail)) loop))
+           (if (eq? oper 'collect)
+             (begin
+              (push `(set-cdr! ,tail (list ,expr)) loop)
+              (push `(set! ,tail (cdr ,tail)) loop))
+             (begin 
+              (push `(set-cdr! ,tail ,expr) loop)
+              (push `(set! ,tail (last-pair ,tail)) loop))))
+         ;; update user into variable inside the main loop
+         ;; regardless of whether its a new collector or not
+         (if into
+           (push `(set! ,into (cdr ,head)) loop)))))
+    
+    (values (make-loop-clause 'operator oper
+			      'bindings (reverse bind)
+			      'initially (reverse init)
+			      'looping (reverse loop)
+			      'returning (reverse return)
+			      'collectors (if new? (list coll) '())
+			      'end-tests (reverse tests))
+            forms)))
+
+;(define (loop-stop expr)
+;  `(%done% ,expr))
+
+(define (loop-return expr)
+  `(return ,expr))
+
+(define (parse-while-until forms clauses ops)
+  clauses
+  (let ((head forms)
+        (oper (pop forms))
+        (test #f)
+        (stop '(go #t))) ; :done
+    (if (null? forms)
+      (loop-error ops head "Missing '" oper "' expression."))
+    
+    (case oper
+      ((until ) (set! test (pop forms)))
+      ((while ) (set! test `(not ,(pop forms)))))
+    ;; calls the DONE continuation.
+    (values (make-loop-clause 'operator oper
+			      'looping (list `(if ,test ,stop)))
+            forms)))
+
+(define (parse-thereis forms clauses ops)
+  clauses
+  (let ((oper (car forms))
+        (expr #f)
+        (bool #f)
+        (func #f))
+    (if (null? (cdr forms))
+      (loop-error ops forms "Missing '" (car forms) "' expression." ))
+    (set! expr (cadr forms))
+    ;; fourth element of operator definition must be
+    ;; a function that returns the stop expression.
+    (set! func (cadddr (loop-op? oper ops) ))
+    
+    (case oper
+      ((thereis ) 
+       ;; return true as soon as expr is true or false at end
+       (set! bool #f))
+      ((always )
+       ;; return false as soon as expr is false, or true at end
+       (set! expr `(not ,expr))
+       (set! bool #t))
+      ((never )
+       ;; return false as soon as expr is true, or true at end
+       (set! bool #t)))
+    (set! forms (cddr forms))
+    ;; this calls the RETURN continuation
+    (values (make-loop-clause 'operator 'thereis
+			      'looping 
+                              (list `(if ,expr ,(func (not bool))))
+			      'returning 
+                              (list bool))
+            forms)))
+
+(define (parse-return forms clauses ops)
+  clauses
+  (let ((oper (car forms))
+        (expr #f)
+        (func #f))
+    (if (null? (cdr forms))
+      (loop-error ops forms "Missing '" (car forms) "' expression."))
+    (set! expr (cadr forms))
+    (set! forms (cddr forms))
+    ;; fourth element of operator definition must be
+    ;; a function that returns the stop expression.
+    (set! func (cadddr (loop-op? oper ops) ))
+    ;; this calls the RETURN continuation
+    (values (make-loop-clause 'operator 'return
+			      'looping `(,(func expr)))
+            forms)))
+
+(define (legal-in-conditional? x ops)
+  ;; FIXED (member (loop-operator...))
+  (let ((op (loop-op? x ops)))
+    (if (and op 
+	     (not (null? (cddr op)))
+	     (eq? (caddr op) 'task)
+             (not (member (car op) '(thereis never always))))
+      op #f)))
+
+(define (parse-then-else-dependents forms clauses ops)
+  (let ((previous forms)
+        (stop? #f)
+        (parsed '()))
+    
+    (do ((op #f)
+         (clause #f)
+         (remains #f))
+        ((or (null? forms) stop?))
+      (set! op (legal-in-conditional? (car forms) ops))
+      (if (not op)
+        (loop-error ops previous "'" (car forms)
+		    "' is not conditional operator."))
+      ;(multiple-value-setq 
+      ; (clause remains)
+      ; ( (cadr op) forms (append clauses parsed) ops))
+      (call-with-values
+       (lambda () ( (cadr op) forms (append clauses parsed) ops))
+       (lambda (a b) (set! clause a) (set! remains b)))
+
+  ;(format #t "~%after call clause=~s forms=~S" clause forms)      
+
+      (set! parsed (append parsed (list clause)))
+      (set! previous forms)
+      (set! forms remains)
+
+      (if (not (null? forms))
+        (if (eq? (car forms) 'and)
+          (begin
+           (set! forms (cdr forms))
+           (if (null? forms)
+             (loop-error ops previous "Missing 'and' clause.")))
+          (if (eq? (car forms) 'else)
+            (set! stop? #t)
+            (if (loop-op? (car forms) ops)
+              (set! stop? #t))))))
+    (values parsed forms)))
+
+(define (parse-conditional forms clauses ops)
+  (let ((ops (cons '(else ) ops))
+	(save forms)
+        (oper (car forms))
+        (loop (list))  ; avoid '() because of acl bug
+        (expr (list))
+        (then (list))
+        (else (list)))
+    (if (null? (cdr forms))
+      (loop-error ops save "Missing '" oper "' expression."))
+    (set! forms (cdr forms))
+    (set! expr (pop forms))
+    (if (null? forms)
+      (loop-error ops forms "Missing conditional clause."))
+    (if (eq? oper 'unless)
+      (set! expr (list 'not expr)))
+    (call-with-values
+     (lambda () (parse-then-else-dependents forms clauses ops))
+     (lambda (a b)
+       (set! then a)
+       (set! forms b)))
+
+    ;; combine dependant clauses if more than one
+    (if (not (null? (cdr then)))
+      (set! then (gather-clauses (list) then))
+      (set! then (car then)))
+    (loop-operator-set! then 'if)
+
+    ;; this (if ...) is hacked so that it is a newly
+    ;; allocated list. otherwise acl and clisp have a
+    ;; nasty structure sharing problem.
+    (set! loop (list 'if expr 
+                     (append `(begin ,@(loop-looping then)) (list))
+                     #f))
+    (if (and (not (null? forms))
+             (eq? (car forms) 'else))
+      (begin
+       (set! forms (cdr forms))
+       (when (null? forms)
+         (loop-error ops save "Missing 'else' clause."))
+       (call-with-values 
+        (lambda ()
+          (parse-then-else-dependents 
+           forms (append clauses (list then))
+           ops))
+        (lambda (a b) (set! else a) (set! forms b)))
+       (if (not (null? (cdr else)))
+         (set! else (gather-clauses '() else))
+         (set! else (car else)))
+       (set-car! (cdddr loop) `(begin ,@(loop-looping else)))
+       ;; flush loop forms so we dont gather actions.
+       (loop-looping-set! then '())
+       (loop-looping-set! else '())
+       (set! then (gather-clauses 'if (list then else)))))
+    (loop-looping-set! then (list loop))
+    (values then forms)))
+
+(define (parse-clauses forms cond? ops)
+  (if (or (null? forms)
+	  (not (symbol? (car forms))))
+    (list (make-loop-clause 'operator 'do 'looping forms))
+    (let ((op-type? (lambda (op type)
+                      (and (not (null? (cddr op)))
+                           (eq? (caddr op) type)))))
+      (let ((previous forms)
+            (clauses '()))
+        (do ((op #f)
+             (clause #f)
+             (remains '())
+             (body '()) )
+            ((null? forms))
+          (if (and cond? (eq? (car forms) 'and))
+            (pop forms))
+          (set! op (loop-op? (car forms) ops))
+          (if (not op)
+            (loop-error ops previous "Found '" (car forms)
+			"' where operator expected."))
+          ;(multiple-value-setq (clause remains)
+          ;                     ((cadr op) forms clauses ops))
+	  (call-with-values
+	   (lambda () ( (cadr op) forms clauses ops))
+	   (lambda (a b)
+	     (set! clause a)
+	     (set! remains b)))
+          (if (op-type? op 'task)
+            (set! body op)
+            (if (op-type? op 'iter)
+              (if (not (null? body))
+                (loop-error ops previous "'" (car op)
+			    "' clause cannot follow '"
+			    (car body) "'."))))
+          (set! previous forms)
+          (set! forms remains)
+          (set! clauses (append clauses (list clause))))
+        clauses))))
+
+(define (parse-iteration caller forms ops)
+  (gather-clauses caller (parse-clauses forms '() ops)))
+
+;;;
+;;; loop implementation
+;;;
+
+(define *loop-operators*
+  ;; each clause is (<op> <parser> <tag> . <whatever>)
+  (list (list 'with (function parse-with) #f)
+        (list 'initially (function parse-initially) #f)
+        (list 'repeat (function parse-repeat) 'iter)
+        (list 'for (function parse-for) 'iter
+              (list 'from (function parse-numerical-for))
+              (list 'downfrom (function parse-numerical-for))
+              (list 'below (function parse-numerical-for))
+              (list 'to (function parse-numerical-for))
+              (list 'above (function parse-numerical-for))
+              (list 'downto (function parse-numerical-for))
+              (list 'in (function parse-sequence-iteration))
+              (list 'on (function parse-sequence-iteration))
+              (list 'across (function parse-sequence-iteration))
+              (list '= (function parse-general-iteration)))
+        (list 'as (function parse-for) 'iter)
+        (list 'do (function parse-do) 'task)
+        (list 'collect (function parse-accumulation) 'task)
+        (list 'append (function parse-accumulation) 'task)
+        (list 'nconc (function parse-accumulation) 'task)
+        (list 'sum (function parse-accumulation) 'task)
+        (list 'count (function parse-accumulation) 'task)
+        (list 'minimize (function parse-accumulation) 'task)
+        (list 'maximize (function parse-accumulation) 'task)
+        (list 'thereis (function parse-thereis) 'task
+              (function loop-return))
+        (list 'always (function parse-thereis) 'task
+              (function loop-return))
+        (list 'never (function parse-thereis) 'task 
+              (function loop-return))
+        (list 'return (function parse-return) 'task 
+              (function loop-return))
+        (list 'while (function parse-while-until) #f )
+        (list 'until (function parse-while-until) #f )
+        (list 'when (function parse-conditional) 'task)
+        (list 'unless (function parse-conditional) 'task)
+        (list 'if (function parse-conditional) 'task)
+        (list 'finally (function parse-finally) #f)))
+
+;;;
+;;; loop expansions for scheme and cltl2
+;;;
+
+(define (scheme-loop forms)
+  (let ((name (gensym "v"))
+        (parsed (parse-iteration 'loop forms *loop-operators*))
+        (end-test '())
+        (done '(go #t))  ; :done
+        (return #f))
+    ;(write (list :parsed-> parsed))
+    ;; cltl2's loop needs a way to stop iteration from with the run
+    ;; block (the done form) and/or immediately return a value
+    ;; (the return form).  scheme doesnt have a block return or a
+    ;; go/tagbody mechanism these conditions are implemented using
+    ;; continuations.  The forms that done and return expand to are
+    ;; not hardwired into the code because this utility is also used
+    ;; by CM's 'process' macro. Instead, the done and return forms
+    ;; are returned by functions assocated with the relevant operator
+    ;; data. For example, the function that returns the return form
+    ;; is stored as the fourth element in the return operator data.
+    ;; and the done function is stored in the while and until op data.
+    
+    ;; the cadddr of the RETURN operator is a function that
+    ;; provides the form for immediately returning a value
+    ;; from the iteration.
+
+    (let ((returnfn (cadddr (assoc 'return *loop-operators*))))
+      (set! return (returnfn
+                    (if (null? (loop-returning parsed))
+                      #f
+                      (car (loop-returning parsed))))))
+            
+    ;; combine any end-tests into a single IF expression
+    ;; that calls the (done) continuation if true. multiple
+    ;; tests are OR'ed togther
+
+    (set! end-test
+          (let ((ends (loop-end-tests parsed)))
+            (if (null? ends)
+              '()
+              (list
+               `(if ,(if (null? (cdr ends))
+                       (car ends)
+                       (cons 'or ends))
+                  ;;  calls the done continuation
+                  ,done 
+                  #f)))))
+    `(let (,@ (loop-bindings parsed))
+       ,@(loop-initially parsed)
+       (call-with-current-continuation 
+        (lambda (return)     ; <- (return) returns from this lambda
+          (call-with-current-continuation
+           (lambda (go)  ; <- (go #t) returns from this lambda
+             ;; a named let provides the actual looping mechanism.
+             ;; the various tests and actions may exit via the
+             ;; (done) or (return) continuations.
+             (let ,name () 
+                  ,@end-test
+                  ,@(loop-looping parsed)
+                  ,@(loop-stepping parsed)
+                  (,name))))
+          ;; this is the lexical point for (go #t) continuation.
+          ,@(loop-finally parsed)
+          ;; invoke the RETURN continuation with loop value or #f
+          ,return)))))
+
+;;;
+;;; these two function are never called in scheme but they are
+;;; translated to the cltl sources.
+;;;
+
+(define-macro (iter . args)
+  (cltl2-loop args))
+
+(define (cltl2-loop forms)
+  (let* ((iter (parse-iteration 'iter forms *loop-operators*))
+         ;; the cadddr of RETURN operator is a function that
+         ;; returns the form for returning from iteration.
+         (retn (apply (cadddr (assoc 'return *loop-operators*))
+                      (list (car (loop-returning iter))))))
+    `(, 'let ,(loop-bindings iter)
+             ,@(loop-initially iter)
+             (block nil
+               (tagbody 
+                 :loop
+                 ,@ (let ((tests (loop-end-tests iter)))
+                      (if tests
+                        (list `(if ,(if (cdr tests)
+                                      (cons 'or tests)
+                                      (car tests))
+                                 (go t))) ; :done
+                        (list)))
+                    ,@(loop-looping iter)
+                    ,@(loop-stepping iter)
+                    (go :loop)
+                    t ; :done
+                    ,@(loop-finally iter)
+                    ,retn)))))
+
+;;;
+;;; loop tests.
+;;;
+
+;(loop for i below 10 collect i)
+; => (0 1 2 3 4 5 6 7 8 9)
+;(loop for i to 10 sum i)
+; => 55
+;(loop for i downto -10 count (even? i))
+; => 6
+;(loop for x in '(0 1 2 3 4 5 6 7 8 9) thereis (= x 4))
+; => #t
+;(loop for x in '(0 1 2 3 4 5 6 7 8 9) by 'cddr collect x)
+; => (0 2 4 6 8)
+;(loop for x on '(0 1 2 3 4 5 6 7 8 9) by 'cddr collect x)
+; => ((0 1 2 ...) (2 3 4 ...) ...)
+;(loop for x in '(0 1 2 3 4 5 6 7 8 9) thereis (= x 4))
+; => 4
+;(loop for x in '(0 1 2 3 4 5 6 7 8 9) never (= x 4))
+; => #f
+;(loop for x in '(0 1 2 3 4 5 6 7 8 9) never (= x 40))
+; => #t
+;(loop for x in '(0 2 3 4 5 6 7 8 9) always (< x 40))
+; => #t
+;(loop repeat 10 with x = 0 collect x do (set! x (+ x 1)))
+; => (0 1 2 3 4 5 6 7 8 9)
+;(loop repeat 10 for x = #t then (not x) collect x)
+; => (#t #f #t #f #t #f #t #f #t #f)
+;(loop repeat 10 count #t)
+; => 10
+;(loop repeat 10 count #f)
+; => 0
+;(loop for i to 10 collect i collect (* 2 i))
+; => (0 0 1 2 2 4 3 6 4 8 5 10 6 12 7 14 8 16 9 18 10 20)
+;(loop for i from -10 to 10 by 2 nconc (list i (- i)))
+; => (-10 10 -8 8 -6 6 -4 4 -2 2 0 0 2 -2 4 -4 6 -6 8 -8 10 -10)
+;(loop for i from -10 downto 10 by -1 collect i)
+; => ()
+;(loop for i downfrom 10 downto -10 by 2 collect i)
+; => (10 8 6 4 2 0 -2 -4 -6 -8 -10)
+;(loop for i from 10 to -10 by 1 collect i)
+; => ()
+;(loop for i to 10 for j downfrom 10 collect i collect j)
+; => (0 10 1 9 2 8 3 7 4 6 5 5 6 4 7 3 8 2 9 1 10 0)
+;(loop for i below 0 collect i into foo finally (return foo))
+; => ()
+;(loop for i below 0 sum i into foo finally (return foo))
+; => 0
+;(loop for i below 0 maximize i into foo finally (return foo))
+; => #f
+;(loop with a and b = 'x and c = 2 repeat 10 for x = 1 then 'fred collect (list x a b c))
+; => ((1 #f x 2) (fred #f x 2) (fred #f x 2) (fred #f x 2) (fred #f x 2) (fred #f x 2) (fred #f x 2) (fred #f x 2) (fred #f x 2) (fred #f x 2))
+;(loop for i across #(0 1 2 3) append (list i (expt 2 i)))
+; => (0 1 1 2 2 4 3 8)
+;(loop repeat 10 for x = (random 100) minimize x into a maximize x into b finally (return (cons a b)))
+; => (36 . 98)
+;(loop with a = 0 and b = -1 while (< a 10) sum a into foo do (set! a (+ a 1)) finally (return (list foo b)))
+; => (45 -1)
+;(loop for i to 10 for j = (random 10) if (even? j) collect j else collect (- j) and do (format #t "odd: ~s~%" j))
+; => (-5 -9 8 -9 -7 0 0 4 -7 -1 -1)
+;(loop for i from 0 until (> i 9) collect i)
+;=> (0 1 2 3 4 5 6 7 8 9)
+;(loop for i from 0 while (< i 9) when (even? i) collect i)
+;=> (0 2 4 6 8)
+;(loop for x = (random 10) for y = -1 then (- x 10) when (> x 6) return (list 'hiho x y))
+;=> (hiho 7 -4)
+;(loop repeat 10 for i = (random 100) collect i)
+; => (31 32 98 7 70 14 73 15 14 44)
+;(loop repeat 10 for i = (random 3) for j = (list i 1) collect j)
+; => ((2 1) (0 1) (2 1) (1 1) (0 1) (2 1) (1 1) (2 1) (0 1) (0 1))
+
+;; errors:
+;(loop with l = (list 0) for s in spec for k = s then (+ k s) do (push k l) finally (return l))
+;(loop with l = (list (encode-interval 'p 1)) for s in spec for k = (interval s) then (transpose k (interval s)) do (push k l) finally (return l))
diff --git a/s7/mockery.scm b/s7/mockery.scm
new file mode 100644
index 0000000..9f7cfb5
--- /dev/null
+++ b/s7/mockery.scm
@@ -0,0 +1,1191 @@
+;;; mockery.scm
+;;;
+;;;  s7.html says that this file implements "openlets masquerading as various data
+;;;  types".  The original idea was to test the generic function support in s7 by
+;;;  creating objects that act as if they were (say) vectors or strings.  Each such
+;;;  object is a let (openlet) inheriting its methods (functions like vector-length)
+;;;  from the outer let (mock-vector-class etc), and within the object itself there
+;;;  are a 'value field and a 'mock-type field.  Each class (a let) has an associated
+;;;  make function (make-mock-vector or mock-vector etc). The class functions give
+;;;  you an object that acts everywhere in scheme like (say) a vector, but you can
+;;;  specialize it by either adding more functions, or changing the ones given, or
+;;;  adding other fields to carry around arbitrary information with the object.
+;;;  
+;;;  To make a mock-vector call (*mock-vector* 'make-mock-vector) or 
+;;;  (*mock-vector* 'mock-vector):
+;;;  
+;;;    ((*mock-vector* 'mock-vector) 1 2 3) -> #(1 2 3)
+;;;  
+;;;  This prints as #(1 2 3) but it's actually one of these mock objects:
+;;;  
+;;;    (let? ((*mock-vector* 'mock-vector) 1 2 3)) -> #t
+;;;  
+;;;  There are examples scattered around this file, and a lot more
+;;;  in s7test.scm.
+;;;
+;;; currently it is possible to (set! ((*mock-vector* 'mock-vector-class) 'write) hash-table-set!) [or (set! (v 'write) hash-table-set!) I think]
+;;;   should we call the s7.html vars-immutable (and immutable!) on this internal let?
+;;; to create an immutable mock datum, call immutable! on its value:
+;;;   (define-constant L (let ((tmp ((*mock-pair* 'mock-pair) 1 2))) (immutable! (tmp 'value)) tmp))
+;;;
+;;; also we omit a variety of built-in functions that can work on the underlying value.
+;;;   given (define v #(0 1)) and (define mv ((*mock-vector* 'mock-vector) 0 1))
+;;;     (arity v): '(1 . 536870912), (arity mv): '(1 . 1)
+;;;     (signature v): '(#t vector? . #1=(integer? . #1#)), (signature mv): '(#t let? . #1=(symbol? . #1#))
+;;;     object->let but this needs to be omitted for debugging
+;;;     and many where the error message is different (should pretty-print know about these?)
+
+(provide 'mockery.scm)
+
+;;; the exported mock data classes
+(define *mock-vector* #f)
+(define *mock-pair* #f)
+(define *mock-string* #f)
+(define *mock-hash-table* #f)
+(define *mock-symbol* #f)
+(define *mock-c-pointer* #f)
+(define *mock-random-state* #f)
+(define *mock-char* #f)
+(define *mock-number* #f)
+(define *mock-iterator* #f)
+(define *mock-port* #f)
+
+
+(let () ; rest of file is in this let
+
+  (define (->value obj)
+    (if (and (let? obj)
+	     (symbol? (obj 'mock-type)))
+	(obj 'value)
+	obj))
+
+  (define (mock? obj)
+    (and (let? obj)
+	 (symbol? (obj 'mock-type))))
+
+  (define (with-mock-wrapper func)
+    (lambda (obj)
+      (cond ((mock? obj)
+	     (let-temporarily (((*s7* 'openlets) #f))
+	       (func (let-ref obj 'value))))
+
+	    ((not (openlet? obj))
+	     (func obj))
+
+	    ((procedure? obj) ; TODO: and c-pointer? c-object?
+	     (let-temporarily (((*s7* 'openlets) #f))
+	       (func obj)))
+
+	    (else
+	     (let ((func-name (string->symbol (object->string func))))
+	       (if (procedure? (obj func-name))
+		   ((obj func-name) obj)
+		   (func obj)))))))
+
+  (define (with-mock-wrapper* func)
+    (lambda args
+      ;(format *stderr* "with-mock-wrapper ~S~%" args)
+      (let ((unknown-openlets #f)
+	    (new-args ())
+	    (got-mock #f))
+	(for-each (lambda (arg) ; not map here because (values) should not be ignored: (+ (mock-number 4/3) (values))
+		    (set! new-args
+			  (cons (if (mock? arg)
+				    (begin
+				      (set! got-mock #t)
+				      (arg 'value))
+				    (begin
+				      (if (and (openlet? arg)
+					       (not (procedure? arg))
+					       (not (macro? arg))
+					       (not (c-pointer? arg)))
+					  (set! unknown-openlets #t))
+				      arg))
+				new-args)))
+		  args)
+	(if (and unknown-openlets got-mock)
+	    (apply func (reverse! new-args))
+	    (let-temporarily (((*s7* 'openlets) #f)) 
+	      (apply func (reverse! new-args)))))))
+
+
+  (define (append-wrapper . args)
+    ;;  append is odd -- if 0 args -> (), 1 arg -> arg, 2 args and first is (), return arg2(etc), else (apply #_append args-via-values)?
+    ;;    we can get here with 0 args via: (with-let (*mock-vector* 'mock-vector-class) (append)) !
+    (if (null? args)
+	()
+	(if (null? (cdr args)) 
+	    (car args) ; presumably a mock object
+	    (if (and (null? (car args))  ; etc...
+		     (null? (cddr args)))
+		(cadr args)
+		(apply (with-mock-wrapper* #_append) args)))))
+
+  ;; one tricky thing here is that a mock object can be the let of with-let: (with-let (mock-port ...) ...)
+  ;;   so a mock object's method can be called even when no argument is a mock object.  Even trickier
+  ;;   (display (openlet (with-let (mock-c-pointer 0) (lambda () 1))))
+  ;; --------------------------------------------------------------------------------
+
+  (set! *mock-vector*
+	(let* ((mock-vector? #f)
+	       (mock-vector-class
+		(inlet 'local-set!         (lambda (obj i val)          ; reactive-vector uses this as a hook into vector-set!
+					     (if (mock-vector? i)
+						 (error 'wrong-type-arg "stray mock-vector? ~S" i))
+					     (#_vector-set! (->value obj) i val))
+		       
+		       'vector-set!        (lambda (obj i val) ((let-ref obj 'local-set!) obj i val) val)
+		       
+		       'let-set-fallback   (lambda (obj i val) 
+					     (if (and (integer? i)
+						      (defined? 'value obj))
+						 (begin
+						   ((let-ref obj 'local-set!) obj i val) 
+						   val)
+						 (error 'out-of-range "unknown field: ~S" i)))
+		       
+		       'let-ref-fallback   (lambda (obj i) 
+					     (if (and (integer? i)
+						      (defined? 'value obj))
+						 (#_vector-ref (obj 'value) i)   ; the implicit case
+						 (error 'out-of-range "unknown field: ~S" i)))
+		       
+		       'equivalent?        (with-mock-wrapper* #_equivalent?)
+		       'vector-ref         (with-mock-wrapper* #_vector-ref)
+		       'vector-length      (if (provided? 'pure-s7)
+					       (lambda (vect)
+						 (if (vector? vect)
+						     (length vect)
+						     (error 'wrong-type-arg "vector-length argument should be a vector: ~A" vect)))
+					       (with-mock-wrapper #_vector-length))
+		       'reverse            (with-mock-wrapper #_reverse)
+		       'sort!              (with-mock-wrapper* #_sort!)
+		       'make-iterator      (with-mock-wrapper #_make-iterator)
+		       'arity              (with-mock-wrapper #_arity)
+		       'object->string     (with-mock-wrapper* #_object->string)
+		       'format             (with-mock-wrapper* #_format)
+		       'write              (with-mock-wrapper* #_write)
+		       'display            (with-mock-wrapper* #_display)
+		       'vector-dimension   (with-mock-wrapper #_vector-dimension)
+		       'vector-dimensions  (with-mock-wrapper #_vector-dimensions)
+		       'vector-rank        (with-mock-wrapper #_vector-rank)
+		       'fill!              (with-mock-wrapper* #_fill!)
+		       'vector-fill!       (with-mock-wrapper* #_vector-fill!)
+		       'vector->list       (with-mock-wrapper* #_vector->list)
+		       'subvector          (with-mock-wrapper* #_subvector)
+		       'copy               (with-mock-wrapper* #_copy)
+		       'vector?            (with-mock-wrapper #_vector?)
+		       'int-vector?        (with-mock-wrapper #_int-vector?)
+		       'byte-vector?       (with-mock-wrapper #_byte-vector?)
+		       'float-vector?      (with-mock-wrapper #_float-vector?)
+		       'length             (with-mock-wrapper #_length)
+		       'vector-append      (if (provided? 'pure-s7)
+					       (lambda args
+						 (if (null? args) 
+						     #() 
+						     (if (vector? (car args))
+							 (apply append args)
+							 (error 'wrong-type-arg "vector-append arguments should be vectors: ~A" args))))
+					       (with-mock-wrapper* #_vector-append))
+		       'append             append-wrapper ;(with-mock-vector #_append)
+		       'vector-typer       (with-mock-wrapper #_vector-typer)
+		       'class-name         '*mock-vector*)))
+	  
+	  (define (make-mock-vector len . rest)
+	    (openlet 
+	     (sublet mock-vector-class 
+	       'value (apply #_make-vector len rest)
+	       'mock-type 'mock-vector?)))
+	  
+	  (define (mock-vector . args)
+	    (openlet
+	     (sublet mock-vector-class 
+	       'value (apply #_vector args)
+	       'mock-type 'mock-vector?)))
+	  
+	  (set! mock-vector? (lambda (obj) 
+			       (and (let? obj)
+				    (defined? 'mock-type obj #t)
+				    (eq? (obj 'mock-type) 'mock-vector?))))
+	  
+	  (curlet)))
+
+;;; perhaps mock-float-vector etc?
+
+#|
+  ;; vector that grows to accommodate vector-set!
+  (define (stretchable-vector)
+    (let ((local-ref (lambda (obj index)
+		       (if (>= index (length (obj 'value)))
+			   (obj 'initial-element)
+			   (#_vector-ref (obj 'value) index))))
+	  (local-set! (lambda (obj index val)
+			(if (>= index (length (obj 'value)))
+			    (set! (obj 'value) (copy (obj 'value) (make-vector (+ index 8) (obj 'initial-element)))))
+			(#_vector-set! (obj 'value) index val))))
+      (openlet
+       (sublet (*mock-vector* 'mock-vector-class)
+	 'value (vector)
+	 'mock-type 'mock-vector?
+	 'initial-element #f
+	 'vector-ref local-ref
+	 'let-ref-fallback local-ref
+	 'vector-set! local-set!
+	 'let-set-fallback local-set!))))
+
+  ;; vector with data (mimicking Clojure):
+  (define (meta-vector v data)
+    (openlet
+     (sublet (*mock-vector* 'mock-vector-class)
+       'value v
+       'mock-type 'mock-vector?
+       'meta-data data)))
+  
+  (define v (meta-vector #(0 1 2) "hiho"))
+  (v 1): 1
+  (v 'meta-data): "hiho"
+  v: #(0 1 2)
+  (vector? v): #t
+|#
+
+
+  ;; --------------------------------------------------------------------------------
+  
+  (set! *mock-hash-table*
+	(let* ((mock-hash-table? #f)
+	       (mock-hash-table-class
+		(inlet 'let-ref-fallback   (lambda (obj key)
+					     (if (defined? 'value obj)
+						 (#_hash-table-ref (obj 'value) key)))
+		       
+		       'let-set-fallback  (lambda (obj key val)  
+					    (if (defined? 'value obj)
+						(#_hash-table-set! (obj 'value) key val)))
+		       
+		       ;; the fallbacks are needed because hash-tables and lets use exactly the same syntax in implicit indexing:
+		       ;;   (x 'y) but s7 can't tell that in this one case, we actually want the 'y to be a key not a field.
+		       ;;   So, to avoid infinite recursion in let-ref (implicit index), if let-ref can't find the let field,
+		       ;;   and the let has 'let-ref|set!-fallback, let-ref|set! passes the argument to that function rather than
+		       ;;   return #<undefined>.
+		       ;;
+		       ;; (round (openlet (inlet 'round (lambda (obj) (#_round (obj 'value))) 'let-ref-fallback (lambda args 3)))) -> 3
+		       
+		       'hash-table-ref     (with-mock-wrapper* #_hash-table-ref)
+		       'hash-table-set!    (with-mock-wrapper* #_hash-table-set!)
+		       'equivalent?        (with-mock-wrapper* #_equivalent?)
+		       'hash-table-entries (with-mock-wrapper #_hash-table-entries)
+		       'make-iterator      (with-mock-wrapper #_make-iterator)
+		       'fill!              (with-mock-wrapper* #_fill!)
+		       'object->string     (with-mock-wrapper* #_object->string)
+		       'format             (with-mock-wrapper* #_format)
+		       'write              (with-mock-wrapper* #_write)
+		       'display            (with-mock-wrapper* #_display)
+		       'reverse            (with-mock-wrapper #_reverse)
+		       'arity              (with-mock-wrapper #_arity)
+		       'copy               (with-mock-wrapper* #_copy)
+		       'hash-table?        (with-mock-wrapper #_hash-table?)
+		       'length             (with-mock-wrapper #_length)
+		       'append             append-wrapper ;(with-mock-wrapper* #_append)
+		       'hash-table-key-typer (with-mock-wrapper #_hash-table-key-typer)
+		       'hash-table-value-typer (with-mock-wrapper #_hash-table-value-typer)
+		       'class-name         '*mock-hash-table*)))
+	  
+	  (define (make-mock-hash-table . rest)
+	    (openlet 
+	     (sublet mock-hash-table-class 
+	       'value (apply #_make-hash-table rest)
+	       'mock-type 'mock-hash-table?)))
+	  
+	  (define (mock-hash-table . args)
+	    (openlet 
+	     (sublet mock-hash-table-class 
+	       'value (apply #_hash-table args)
+	       'mock-type 'mock-hash-table?)))
+	  
+	  (set! mock-hash-table? (lambda (obj)
+				   (and (let? obj)
+					(defined? 'mock-type obj #t)
+					(eq? (obj 'mock-type) 'mock-hash-table?))))
+	  
+	  (curlet)))
+  
+  
+#|
+  ;; hash-table that returns a special identifier when key is not in the table
+  
+  (define (gloomy-hash-table)
+    (openlet
+     (sublet (*mock-hash-table* 'mock-hash-table-class) ; ideally this would be a separate (not copied) gloomy-hash-table-class 
+       'value #f
+       'mock-type 'mock-hash-table?
+       'false (gensym)
+       'not-a-key #f
+       'hash-table-ref (lambda (obj key)
+			 (let ((val (#_hash-table-ref (obj 'value) key)))
+			   (if (eq? val (obj 'false))
+			       #f
+			       (or val (obj 'not-a-key)))))
+       'hash-table-key? (lambda (obj key)
+			  (#_hash-table-ref (obj 'value) key)))))
+  
+  (define (hash-table-key? obj key) 
+    ((let-ref obj 'hash-table-key?) obj key))
+  
+  (define* (make-gloomy-hash-table (len 511) not-a-key)
+    (let ((ht (gloomy-hash-table)))
+      (set! (ht 'value) (make-hash-table len))
+      (set! (ht 'not-a-key) not-a-key)
+      ht))
+|#
+  
+  
+  ;; --------------------------------------------------------------------------------
+  
+  (set! *mock-string*
+	(let* ((mock-string? #f)
+	       (mock-string-class
+		(inlet 'equivalent?            (with-mock-wrapper* #_equivalent?)
+		       'reverse                (with-mock-wrapper #_reverse)
+		       'arity                  (with-mock-wrapper #_arity)
+		       'make-iterator          (with-mock-wrapper* #_make-iterator)
+		       
+		       'let-ref-fallback       (lambda (obj i) 
+						 (if (and (integer? i)
+							  (defined? 'value obj))
+						     (#_string-ref (obj 'value) i)           ; these are the implicit cases
+						     (error 'out-of-range "unknown field: ~S" i)))
+		       
+		       'let-set-fallback       (lambda (obj i val) 
+						 (if (and (integer? i)
+							  (defined? 'value obj))
+						     (#_string-set! (obj 'value) i val)
+						     (error 'out-of-range "unknown field: ~S" i)))
+		       
+		       'string-length          (if (provided? 'pure-s7)
+						   (lambda (str)
+						     (if (string? str)
+							 (length str)
+							 (error 'wrong-type-arg "string-length argument should be a string: ~A" str)))
+						   (with-mock-wrapper #_length))
+
+		       'string-append          (with-mock-wrapper* #_string-append)
+		       'string-copy            (with-mock-wrapper* #_string-copy)
+		       
+		       'string=?               (with-mock-wrapper* #_string=?)
+		       'string<?               (with-mock-wrapper* #_string<?)
+		       'string>?               (with-mock-wrapper* #_string>?)
+		       'string<=?              (with-mock-wrapper* #_string<=?)
+		       'string>=?              (with-mock-wrapper* #_string>=?)
+		       
+		       'string-downcase        (with-mock-wrapper #_string-downcase)
+		       'string-upcase          (with-mock-wrapper #_string-upcase)
+		       'string->symbol         (with-mock-wrapper #_string->symbol)
+		       'symbol                 (with-mock-wrapper* #_symbol)
+		       'string->keyword        (with-mock-wrapper #_string->keyword)
+		       'open-input-string      (with-mock-wrapper #_open-input-string)
+		       'directory?             (with-mock-wrapper #_directory?)
+		       'file-exists?           (with-mock-wrapper #_file-exists?)
+		       'getenv                 (with-mock-wrapper #_getenv)
+		       'delete-file            (with-mock-wrapper #_delete-file)
+		       'string->byte-vector    (with-mock-wrapper #_string->byte-vector)
+		       'object->string         (with-mock-wrapper* #_object->string)
+		       'format                 (with-mock-wrapper* #_format)
+		       'write                  (with-mock-wrapper* #_write)
+		       'display                (with-mock-wrapper* #_display)
+		       'char-position          (with-mock-wrapper* #_char-position)
+		       'string-fill!           (with-mock-wrapper* #_string-fill!)
+		       'gensym                 (with-mock-wrapper* #_gensym)
+		       'call-with-input-string (with-mock-wrapper* #_call-with-input-string)
+		       'with-input-from-string (with-mock-wrapper* #_with-input-from-string)
+		       'system                 (with-mock-wrapper* #_system)
+		       'load                   (with-mock-wrapper* #_load)
+		       'eval-string            (with-mock-wrapper* #_eval-string)
+		       'string->list           (with-mock-wrapper* #_string->list)
+		       'bignum                 (with-mock-wrapper* #_bignum)
+		       'fill!                  (with-mock-wrapper* #_fill!)
+		       'write-string           (with-mock-wrapper* #_write-string)
+		       'copy                   (with-mock-wrapper* #_copy)
+		       'substring              (with-mock-wrapper* #_substring)
+		       'string->number         (with-mock-wrapper* #_string->number)
+		       'string-position        (with-mock-wrapper* #_string-position)
+		       'string-ref             (with-mock-wrapper* #_string-ref)
+		       'string-set!            (with-mock-wrapper* #_string-set!)
+		       'string-ci=?            (with-mock-wrapper* #_string-ci=?)
+		       'string-ci<?            (with-mock-wrapper* #_string-ci<?)
+		       'string-ci>?            (with-mock-wrapper* #_string-ci>?)
+		       'string-ci<=?           (with-mock-wrapper* #_string-ci<=?)
+		       'string-ci>=?           (with-mock-wrapper* #_string-ci>=?)
+		       'string?                (with-mock-wrapper #_string?)
+		       'length                 (with-mock-wrapper (if (provided? 'pure-s7) #_length #_string-length))
+		       'append                 append-wrapper ;(with-mock-wrapper* #_append)
+		       'class-name             '*mock-string*)))
+	  
+	  (define* (make-mock-string len (init #\null))
+	    (openlet 
+	     (sublet mock-string-class 
+	       'value (#_make-string len init)
+	       'mock-type 'mock-string?)))
+	  
+	  (define (mock-string . args)
+	    (let ((v (make-mock-string 0)))
+	      (set! (v 'value) 
+		    (if (string? (car args))
+			(car args)
+			(apply #_string args)))
+	      v))
+	  
+	  (set! mock-string? (lambda (obj)
+			       (and (let? obj)
+				    (defined? 'mock-type obj #t)
+				    (eq? (obj 'mock-type) 'mock-string?))))
+	  
+	  (curlet)))
+  
+#|
+  ;; string that is always the current time of day
+  (require libc.scm)
+  
+  (define time-string
+    (let ((daytime (lambda args
+		     (with-let (sublet *libc*)
+		       (let ((timestr (make-string 64))) 
+			 (let ((len (strftime timestr 64 "%a %d-%b-%Y %H:%M %Z"
+					      (localtime 
+					       (time.make (time (c-pointer 0)))))))
+			   (substring timestr 0 len)))))))
+      (openlet
+       (sublet (*mock-string* 'mock-string-class) ; the mock-string isn't really needed here
+	 'let-ref-fallback daytime
+	 'object->string daytime))))
+  
+  ;; similarly ("JIT data"):
+  (define ? (openlet 
+	     (inlet 'object->string (lambda (obj . args) 
+				      (apply #_object->string (owlet) args)))))
+|#  
+  
+
+  ;; --------------------------------------------------------------------------------
+  
+  (set! *mock-char*
+	(let* ((mock-char? #f)
+	       (mock-char-class
+		(inlet 'equivalent?        (with-mock-wrapper* #_equivalent?)
+		       'char-upcase        (with-mock-wrapper #_char-upcase)
+		       'char-downcase      (with-mock-wrapper #_char-downcase)
+		       'char->integer      (with-mock-wrapper #_char->integer)
+		       'char-upper-case?   (with-mock-wrapper #_char-upper-case?)
+		       'char-lower-case?   (with-mock-wrapper #_char-lower-case?)
+		       'char-alphabetic?   (with-mock-wrapper #_char-alphabetic?)
+		       'char-numeric?      (with-mock-wrapper #_char-numeric?)
+		       'char-whitespace?   (with-mock-wrapper #_char-whitespace?)
+		       'char=?             (with-mock-wrapper* #_char=?)
+		       'char<?             (with-mock-wrapper* #_char<?)
+		       'char>?             (with-mock-wrapper* #_char>?)
+		       'char<=?            (with-mock-wrapper* #_char<=?)
+		       'char>=?            (with-mock-wrapper* #_char>=?)
+		       'char-ci=?          (with-mock-wrapper* #_char-ci=?)
+		       'char-ci<?          (with-mock-wrapper* #_char-ci<?)
+		       'char-ci>?          (with-mock-wrapper* #_char-ci>?)
+		       'char-ci<=?         (with-mock-wrapper* #_char-ci<=?)
+		       'char-ci>=?         (with-mock-wrapper* #_char-ci>=?)
+		       'string             (with-mock-wrapper* #_string)
+		       'string-fill!       (with-mock-wrapper* #_string-fill!)
+		       'fill!              (with-mock-wrapper* #_fill!)
+		       'object->string     (with-mock-wrapper* #_object->string)
+		       'format             (with-mock-wrapper* #_format)
+		       'write              (with-mock-wrapper* #_write)
+		       'display            (with-mock-wrapper* #_display)
+		       'arity              (with-mock-wrapper #_arity)
+		       'make-string        (with-mock-wrapper* #_make-string)
+		       'char-position      (with-mock-wrapper* #_char-position)
+		       'write-char         (with-mock-wrapper* #_write-char)
+		       'string-set!        (with-mock-wrapper* #_string-set!)
+		       'copy               (with-mock-wrapper* #_copy)
+		       'char?              (with-mock-wrapper #_char?)
+		       'class-name         '*mock-char*
+		       'length             (lambda (obj) #f))))
+	  
+	  (define (mock-char c) 
+	    (if (and (char? c)
+		     (not (let? c)))
+		(immutable!
+		 (openlet
+		  (sublet (*mock-char* 'mock-char-class)
+		    'value c
+		    'mock-type 'mock-char?)))
+		(error 'wrong-type-arg "mock-char argument ~S is not a char" c)))
+	  
+	  (set! mock-char? (lambda (obj)
+			     (and (let? obj)
+				  (defined? 'mock-type obj #t)
+				  (eq? (obj 'mock-type) 'mock-char?))))
+	  
+	  (curlet)))
+  
+  ;; eventually I'll conjure up unichars like (define lambda (byte-vector #xce #xbb)) via mock-char,
+  ;;   then combine those into unistring via mock-string
+  ;;
+  ;; (string-length obj)->g_utf8_strlen etc 
+  ;;   (g_unichar_isalpha (g_utf8_get_char (byte-vector #xce #xbb))) -> #t
+  ;;   (g_utf8_strlen (byte-vector #xce #xbb #xce #xba) 10) -> 2
+  ;;   (g_utf8_normalize (byte-vector #xce #xbb #xce #xba) 4 G_NORMALIZE_DEFAULT)
+  ;;   but the ones that return gunichar (toupper) currently don't return a byte-vector or a string
+  ;;   maybe gunichar->byte-vector?
+  ;;   need glib.scm, or unicode.scm to load the stuff
+
+
+
+  ;; --------------------------------------------------------------------------------
+  
+  (set! *mock-number*
+	(let* ((mock-number? #f)
+	       (mock-number-class
+		(inlet 
+		 'equivalent?      (with-mock-wrapper* #_equivalent?)
+		 'arity            (with-mock-wrapper #_arity)
+		 'real-part        (with-mock-wrapper #_real-part)
+		 'imag-part        (with-mock-wrapper #_imag-part)
+		 'numerator        (with-mock-wrapper #_numerator)
+		 'denominator      (with-mock-wrapper #_denominator)
+		 'even?            (with-mock-wrapper #_even?)
+		 'odd?             (with-mock-wrapper #_odd?)
+		 'zero?            (with-mock-wrapper #_zero?)
+		 'positive?        (with-mock-wrapper #_positive?)
+		 'negative?        (with-mock-wrapper #_negative?)
+		 'infinite?        (with-mock-wrapper #_infinite?)
+		 'nan?             (with-mock-wrapper #_nan?)
+		 ;'append          append-wrapper ; (with-mock-wrapper* #_append) ;?? (append ... 3 ...) is an error
+		 'magnitude        (with-mock-wrapper #_magnitude)
+		 'angle            (with-mock-wrapper #_angle)
+		 'rationalize      (with-mock-wrapper* #_rationalize)
+		 'abs              (with-mock-wrapper #_abs)
+		 'exp              (with-mock-wrapper #_exp)
+		 'log              (with-mock-wrapper* #_log)
+		 'sin              (with-mock-wrapper #_sin)
+		 'cos              (with-mock-wrapper #_cos)
+		 'tan              (with-mock-wrapper #_tan)
+		 'asin             (with-mock-wrapper #_asin)
+		 'acos             (with-mock-wrapper #_acos)
+		 'atan             (with-mock-wrapper* #_atan)
+		 'sinh             (with-mock-wrapper #_sinh)
+		 'cosh             (with-mock-wrapper #_cosh)
+		 'tanh             (with-mock-wrapper #_tanh)
+		 'asinh            (with-mock-wrapper #_asinh)
+		 'acosh            (with-mock-wrapper #_acosh)
+		 'atanh            (with-mock-wrapper #_atanh)
+		 'sqrt             (with-mock-wrapper #_sqrt)
+		 'expt             (with-mock-wrapper* #_expt)
+		 'floor            (with-mock-wrapper #_floor)
+		 'ceiling          (with-mock-wrapper #_ceiling)
+		 'truncate         (with-mock-wrapper #_truncate)
+		 'round            (with-mock-wrapper #_round)
+		 'integer->char    (with-mock-wrapper #_integer->char)
+		 'inexact->exact   (with-mock-wrapper #_inexact->exact)
+		 'exact->inexact   (with-mock-wrapper #_exact->inexact)
+		 'integer-length   (with-mock-wrapper #_integer-length)
+		 'integer-decode-float (with-mock-wrapper #_integer-decode-float)
+		 'number?          (with-mock-wrapper #_number?)
+		 'integer?         (with-mock-wrapper #_integer?)
+		 'real?            (with-mock-wrapper #_real?)
+		 'complex?         (with-mock-wrapper #_complex?)
+		 'rational?        (with-mock-wrapper #_rational?)
+		 'byte?            (with-mock-wrapper #_byte?)
+		 'float?           (with-mock-wrapper #_float?)
+		 'exact?           (with-mock-wrapper #_exact?)
+		 'inexact?         (with-mock-wrapper #_inexact?)
+		 'lognot           (with-mock-wrapper #_lognot)
+		 'logior           (with-mock-wrapper* #_logior)
+		 'logxor           (with-mock-wrapper* #_logxor)
+		 'logand           (with-mock-wrapper* #_logand)
+		 'number->string   (with-mock-wrapper* #_number->string)
+		 'lcm              (with-mock-wrapper* #_lcm)
+		 'gcd              (with-mock-wrapper* #_gcd)
+		 '+                (with-mock-wrapper* #_+)
+		 '-                (with-mock-wrapper* #_-)
+		 '*                (with-mock-wrapper* #_*)
+		 '/                (with-mock-wrapper* #_/)
+		 'max              (with-mock-wrapper* #_max)
+		 'min              (with-mock-wrapper* #_min)
+		 '=                (with-mock-wrapper* #_=)
+		 '<                (with-mock-wrapper* #_<)
+		 '>                (with-mock-wrapper* #_>)
+		 '<=               (with-mock-wrapper* #_<=)
+		 '>=               (with-mock-wrapper* #_>=)
+		 
+ 		 'make-polar       (if (provided? 'pure-s7)
+ 				       (lambda (mag ang) (#_complex (* mag (cos ang)) (* mag (sin ang))))
+ 				       (lambda (mag ang) (#_make-polar (->value mag) (->value arg))))
+
+		 'make-rectangular (with-mock-wrapper* #_complex)
+		 'complex          (with-mock-wrapper* #_complex)
+		 'bignum           (with-mock-wrapper* #_bignum)
+		 'random-state     (with-mock-wrapper* #_random-state)
+		 'ash              (with-mock-wrapper* #_ash)
+		 'logbit?          (with-mock-wrapper* #_logbit?)
+		 'quotient         (with-mock-wrapper* #_quotient)
+		 'remainder        (with-mock-wrapper* #_remainder)
+		 'modulo           (with-mock-wrapper* #_modulo)
+		 'random           (with-mock-wrapper* #_random)
+		 'write-byte       (with-mock-wrapper* #_write-byte)
+		 'make-list        (with-mock-wrapper* #_make-list)
+		 'make-vector      (with-mock-wrapper* #_make-vector)
+		 'make-float-vector (with-mock-wrapper* #_make-float-vector)
+		 'make-int-vector  (with-mock-wrapper* #_make-int-vector)
+		 'make-byte-vector  (with-mock-wrapper* #_make-byte-vector)
+		 'make-hash-table  (with-mock-wrapper* #_make-hash-table)
+		 'object->string   (with-mock-wrapper* #_object->string)
+		 'format           (with-mock-wrapper* #_format)
+		 'write            (with-mock-wrapper* #_write)
+		 'display          (with-mock-wrapper* #_display)
+		 'string-fill!     (with-mock-wrapper* #_string-fill!)
+		 'copy             (with-mock-wrapper* #_copy)
+		 'vector->list     (with-mock-wrapper* #_vector->list)
+		 'string->list     (with-mock-wrapper* #_string->list)
+		 'substring        (with-mock-wrapper* #_substring)
+		 'vector-fill!     (with-mock-wrapper* #_vector-fill!)
+		 'fill!            (with-mock-wrapper* #_fill!)
+		 'make-string      (with-mock-wrapper* #_make-string)
+		 'string-ref       (with-mock-wrapper* #_string-ref)
+		 'string-set!      (with-mock-wrapper* #_string-set!)
+		 'string->number   (with-mock-wrapper* #_string->number)
+		 'list-ref         (with-mock-wrapper* #_list-ref)
+		 'list-set!        (with-mock-wrapper* #_list-set!)
+		 'list-tail        (with-mock-wrapper* #_list-tail)
+		 'vector-ref       (with-mock-wrapper* #_vector-ref)
+		 'float-vector-ref (with-mock-wrapper* #_float-vector-ref)
+		 'int-vector-ref   (with-mock-wrapper* #_int-vector-ref)
+		 'byte-vector-ref  (with-mock-wrapper* #_byte-vector-ref)
+		 'vector-set!      (with-mock-wrapper* #_vector-set!)
+		 'float-vector-set! (with-mock-wrapper* #_float-vector-set!)
+		 'int-vector-set!  (with-mock-wrapper* #_int-vector-set!)
+		 'byte-vector-set! (with-mock-wrapper* #_byte-vector-set!)
+		 'float-vector     (with-mock-wrapper* #_float-vector)
+		 'int-vector       (with-mock-wrapper* #_int-vector)
+		 'byte-vector      (with-mock-wrapper* #_byte-vector)
+		 'subvector        (with-mock-wrapper* #_subvector)
+		 'read-string      (with-mock-wrapper* #_read-string)
+		 'length           (with-mock-wrapper #_length)
+		 'c-pointer        (with-mock-wrapper #_c-pointer)
+		 'class-name       '*mock-number*)))
+	  
+	  (define (mock-number x)
+	    (if (and (number? x)
+		     (not (let? x)))
+		(immutable!
+		 (openlet
+		  (sublet (*mock-number* 'mock-number-class)
+		    'value x
+		    'mock-type 'mock-number?)))
+		(error 'wrong-type-arg "mock-number ~S is not a number" x)))
+	  
+	  (set! mock-number? (lambda (obj)
+			       (and (let? obj)
+				    (defined? 'mock-type obj #t)
+				    (eq? (obj 'mock-type) 'mock-number?))))
+	  (curlet)))
+
+#|
+;; fuzzy number
+  
+  (define fuzzy-number
+    (let ((fuzz (lambda (fx)
+		  (#_* fx (#_- 1.05 (#_random .1))))))
+      (lambda (fx)
+	(openlet 
+	 (sublet 
+	     (*mock-number* 'mock-number-class)
+	   'let-ref-fallback (lambda (obj sym) (fuzz fx))
+	   'object->string (lambda (obj . args) (#_number->string (fuzz fx))))))))
+  
+  
+  ;; interval arithmetic 
+  ;; 
+  ;; from Wikipedia:
+  ;; x + y =	[a+c, b+d]
+  ;; x - y =	[a-d, b-c]
+  ;; x / y =	[min(a/c, a/d, b/c, b/d), max(a/c, a/d, b/c, b/d)]
+  
+  (define *interval*
+    (let* ((make-interval #f)
+	   (low (lambda (z) (z 'low)))
+	   (high (lambda (z) (z 'high)))
+	   (interval-class 
+	    (openlet (sublet (*mock-number* 'mock-number-class)
+		       
+		       '+ (lambda args
+			    (let ((lo 0)
+				  (hi 0))
+			      (for-each
+			       (lambda (z)
+				 (if (let? z)
+				     (begin
+				       (set! lo (+ lo (low z)))
+				       (set! hi (+ hi (high z))))
+				     (begin
+				       (set! lo (+ lo z))
+				       (set! hi (+ hi z)))))
+			       args)
+			      (make-interval lo hi)))
+		       
+		       '* (lambda args
+			    (let ((lo 1)
+				  (hi 1))
+			      (for-each
+			       (lambda (z)
+				 (let ((zlo (if (let? z) (low z) z))
+				       (zhi (if (let? z) (high z) z)))
+				   (let ((ac (* lo zlo))
+					 (ad (* lo zhi))
+					 (bc (* hi zlo))
+					 (bd (* hi zhi)))
+				     (set! lo (min ac ad bc bd))
+				     (set! hi (max ac ad bc bd)))))
+			       args)
+			      (make-interval lo hi)))
+		       
+		       '- (lambda args
+			    (let ((z (car args)))
+			      (if (null? (cdr args)) ; negate (must be let? else how did we get here?)
+				  (make-interval (- (high z)) (- (low z)))
+				  (let ((lo (low z))
+					(hi (high z)))
+				    (for-each
+				     (lambda (z)
+				       (if (let? z)
+					   (begin
+					     (set! lo (- lo (high z)))
+					     (set! hi (- hi (low z))))
+					   (begin
+					     (set! lo (- lo z))
+					     (set! hi (- hi z)))))
+				     (cdr args))
+				    (make-interval lo hi)))))
+		       
+		       '/ (lambda args
+			    (let ((z (car args)))
+			      (if (null? (cdr args)) ; invert
+				  (make-interval (/ (high z)) (/ (low z)))
+				  (let ((lo (low z))
+					(hi (high z)))
+				    (for-each
+				     (lambda (z)
+				       (let ((zlo (if (let? z) (low z) z))
+					     (zhi (if (let? z) (high z) z)))
+					 (let ((ac (/ lo zlo))
+					       (ad (/ lo zhi))
+					       (bc (/ hi zlo))
+					       (bd (/ hi zhi)))
+					   (set! lo (min ac ad bc bd))
+					   (set! hi (max ac ad bc bd)))))
+				     (cdr args))
+				    (make-interval lo hi)))))
+		       
+		       'abs (lambda (z)
+			      (if (positive? (low z))
+				  (make-interval (low z) (high z))
+				  (if (negative? (high z))
+				      (make-interval (abs (high z)) (abs (low z)))
+				      (make-interval 0 (max (abs (low z)) (abs (high z)))))))
+		       
+		       'object->string (lambda (obj . args) 
+					 (format #f "#<interval: ~S ~S>" (low obj) (high obj)))
+		       ))))
+      
+      (set! make-interval (lambda (low high)
+			    (if (> low high) (format *stderr* "~A ~A~%" low high))
+			    (openlet (sublet interval-class 'low low 'high high))))
+      
+      (curlet)))
+  
+  (define x ((*interval* 'make-interval) 3.0 4.0))
+|#
+
+
+
+  ;; --------------------------------------------------------------------------------
+  
+  (set! *mock-pair*
+	(let* ((mock-pair? #f)
+	       (mock-pair-class
+		(inlet 'equivalent?      (with-mock-wrapper* #_equivalent?)
+		       'pair-line-number (with-mock-wrapper #_pair-line-number)
+		       'list->string     (with-mock-wrapper #_list->string)
+		       'object->string   (with-mock-wrapper* #_object->string)
+		       'format           (with-mock-wrapper* #_format)
+		       'write            (with-mock-wrapper* #_write)
+		       'display          (with-mock-wrapper* #_display)
+		       'list?            (with-mock-wrapper #_list?)
+		       'car              (with-mock-wrapper #_car)
+		       'cdr              (with-mock-wrapper #_cdr)
+		       'set-car!         (with-mock-wrapper* #_set-car!)
+		       'set-cdr!         (with-mock-wrapper* #_set-cdr!)
+		       'caar             (with-mock-wrapper #_caar)
+		       'cadr             (with-mock-wrapper #_cadr)
+		       'cdar             (with-mock-wrapper #_cdar)
+		       'cddr             (with-mock-wrapper #_cddr)
+		       'caaar            (with-mock-wrapper #_caaar)
+		       'caadr            (with-mock-wrapper #_caadr)
+		       'cadar            (with-mock-wrapper #_cadar)
+		       'cdaar            (with-mock-wrapper #_cdaar)
+		       'caddr            (with-mock-wrapper #_caddr)
+		       'cdddr            (with-mock-wrapper #_cdddr)
+		       'cdadr            (with-mock-wrapper #_cdadr)
+		       'cddar            (with-mock-wrapper #_cddar)
+		       'caaaar           (with-mock-wrapper #_caaaar)
+		       'caaadr           (with-mock-wrapper #_caaadr)
+		       'caadar           (with-mock-wrapper #_caadar)
+		       'cadaar           (with-mock-wrapper #_cadaar)
+		       'caaddr           (with-mock-wrapper #_caaddr)
+		       'cadddr           (with-mock-wrapper #_cadddr)
+		       'cadadr           (with-mock-wrapper #_cadadr)
+		       'caddar           (with-mock-wrapper #_caddar)
+		       'cdaaar           (with-mock-wrapper #_cdaaar)
+		       'cdaadr           (with-mock-wrapper #_cdaadr)
+		       'cdadar           (with-mock-wrapper #_cdadar)
+		       'cddaar           (with-mock-wrapper #_cddaar)
+		       'cdaddr           (with-mock-wrapper #_cdaddr)
+		       'cddddr           (with-mock-wrapper #_cddddr)
+		       'cddadr           (with-mock-wrapper #_cddadr)
+		       'cdddar           (with-mock-wrapper #_cdddar)
+		       'assoc            (with-mock-wrapper* #_assoc)
+		       'assq             (with-mock-wrapper* #_assq)
+		       'assv             (with-mock-wrapper* #_assv)
+		       'member           (with-mock-wrapper* #_member)
+		       'memq             (with-mock-wrapper* #_memq)
+		       'memv             (with-mock-wrapper* #_memv)
+		       
+		       'let-ref-fallback (lambda (obj ind) 
+					   (if (eq? ind 'value)
+					       #<undefined>
+					       (if (integer? ind)
+						   (let ((val (begin 
+								(coverlet obj)
+								(#_list-ref (obj 'value) ind))))
+						     (openlet obj) 
+						     val)
+						   (error 'wrong-type-arg "let-ref mock-pair index is not an integer: ~S" ind))))
+		       'let-set-fallback (lambda (obj ind val) 
+					   (if (eq? ind 'value)
+					       #<undefined>
+					       (if (integer? ind)
+						   (let ((val (begin 
+								(coverlet obj)
+								(#_list-set! (obj 'value) ind val))))
+						     (openlet obj)
+						     val)
+						   (error 'wrong-type-arg "let-set! mock-pair index is not an integer: ~S" ind))))
+		       
+		       'reverse!         (lambda (obj) 
+					   (if (mock-pair? obj)
+					       (set! (obj 'value) (#_reverse (obj 'value)))
+					       (#_reverse! obj)))
+		       
+		       'list-tail        (with-mock-wrapper* #_list-tail)
+		       'sort!            (with-mock-wrapper* #_sort!)
+		       'reverse          (with-mock-wrapper #_reverse)
+		       'arity            (with-mock-wrapper #_arity)
+		       'make-iterator    (with-mock-wrapper #_make-iterator)
+		       'eval             (with-mock-wrapper #_eval)
+		       'list->vector     (with-mock-wrapper #_list->vector)
+		       'fill!            (with-mock-wrapper* #_fill!)
+		       'copy             (with-mock-wrapper* #_copy)
+		       'subvector        (with-mock-wrapper* #_subvector)
+		       'make-vector      (with-mock-wrapper* #_make-vector)
+		       'list-ref         (with-mock-wrapper* #_list-ref)
+		       'list-set!        (with-mock-wrapper* #_list-set!)
+		       'pair?            (with-mock-wrapper #_pair?)
+		       'length           (with-mock-wrapper #_length)
+		       'append           append-wrapper ;(with-mock-wrapper* #_append)
+		       'class-name       '*mock-pair*)))
+	  
+	  (define (mock-pair . args)
+	    (openlet
+	     (sublet (*mock-pair* 'mock-pair-class)
+	       'value (copy args) ; i.e. like list not cons
+	       'mock-type 'mock-pair?)))
+	  
+	  (set! mock-pair? (lambda (obj)
+			     (and (let? obj)
+				  (defined? 'mock-type obj #t)
+				  (eq? (obj 'mock-type) 'mock-pair?))))
+	  
+	  (curlet)))
+
+#|  
+  (let ((immutable-list-class 
+	 (sublet (*mock-pair* 'mock-pair-class)
+	   'let-set-fallback (lambda (obj i val) 
+			       (set! (obj 'value) (append (copy (obj 'value) (make-list (+ i 1))) (list-tail (obj 'value) (+ i 1))))
+			       (list-set! (obj 'value) i val))
+	   'list-set!        (lambda (obj i val) 
+			       (set! (obj 'value) (append (copy (obj 'value) (make-list (+ i 1))) (list-tail (obj 'value) (+ i 1))))
+			       (list-set! (obj 'value) i val))
+	   'set-car!         (lambda (obj val) 
+			       (set! (obj 'value) (cons val (cdr (obj 'value)))))
+	   'set-cdr!         (lambda (obj val) 
+			       (set! (obj 'value) (cons (car (obj 'value)) val)))
+	   'fill!            (lambda (obj val) 
+			       (set! (obj 'value) (fill! (copy (obj 'value)) val)))
+	   'reverse!         (lambda (obj) 
+			       (set! (obj 'value) (reverse (obj 'value))))
+	   'sort!            (lambda (obj func) 
+			       (set! (obj 'value) (sort! (copy (obj 'value)) func))))))
+    
+    (define (immutable-list lst)
+      (openlet 
+       (sublet immutable-list-class
+	 'value lst
+	 'mock-type 'mock-pair?)))
+|#
+
+;; since a mock-pair prints itself as if a list, you can get some strange printout results:
+;;    (cons 'a ((*mock-pair* 'mock-pair) 'b 'c)) -> '(a . (b c))
+
+
+  
+  ;; --------------------------------------------------------------------------------
+  
+  (set! *mock-symbol*
+	(let* ((mock-symbol? #f)
+	       (mock-symbol-class
+		(inlet 'equivalent?           (with-mock-wrapper* #_equivalent?)
+		       'gensym?               (with-mock-wrapper #_gensym?)
+		       ;'append               (with-mock-wrapper* #_append) ;? (append ... 'a ...) is an error
+		       'fill!                 (with-mock-wrapper* #_fill!)
+		       'symbol->string        (with-mock-wrapper #_symbol->string)
+		       'symbol->value         (with-mock-wrapper* #_symbol->value)
+		       'symbol->dynamic-value (with-mock-wrapper #_symbol->dynamic-value)
+		       'setter                (with-mock-wrapper* #_setter)
+		       'provided?             (with-mock-wrapper #_provided?)
+		       'provide               (with-mock-wrapper #_provide)
+		       'defined?              (with-mock-wrapper* #_defined?)
+		       'symbol->keyword       (with-mock-wrapper #_symbol->keyword)
+		       'keyword?              (with-mock-wrapper #_keyword?)
+		       'keyword->symbol       (with-mock-wrapper #_keyword->symbol)
+		       'object->string        (with-mock-wrapper* #_object->string)
+		       'format                (with-mock-wrapper* #_format)
+		       'write                 (with-mock-wrapper* #_write)
+		       'display               (with-mock-wrapper* #_display)
+		       'symbol?               (with-mock-wrapper #_symbol?)
+		       'class-name            '*mock-symbol*
+		       )))
+	  
+	  (define (mock-symbol s)
+	    (if (symbol? s)
+		(immutable!
+		 (openlet
+		  (sublet (*mock-symbol* 'mock-symbol-class)
+		    'value s
+		    'mock-type 'mock-symbol?)))
+		(error 'wrong-type-arg "mock-symbol ~S is not a symbol" s)))
+	  
+	  (set! mock-symbol? (lambda (obj)
+			       (and (let? obj)
+				    (defined? 'mock-type obj #t)
+				    (eq? (obj 'mock-type) 'mock-symbol?))))
+	  
+	  (curlet)))
+  
+  
+  ;; --------------------------------------------------------------------------------
+  
+  (set! *mock-c-pointer*
+	(let* ((mock-c-pointer? #f)
+	       (mock-c-pointer-class
+		(inlet 'c-pointer?      (with-mock-wrapper #_c-pointer?)
+		       'c-pointer-type  (with-mock-wrapper #_c-pointer-type)
+		       'c-pointer-info  (with-mock-wrapper #_c-pointer-info)
+		       'c-pointer-weak1 (with-mock-wrapper #_c-pointer-weak1)
+		       'c-pointer-weak2 (with-mock-wrapper #_c-pointer-weak2)
+		       'c-pointer->list (with-mock-wrapper #_c-pointer->list)
+		       'object->string  (with-mock-wrapper* #_object->string)
+		       'format          (with-mock-wrapper* #_format)
+		       'write           (with-mock-wrapper* #_write)
+		       'display         (with-mock-wrapper* #_display)
+		       'fill!           (with-mock-wrapper* #_fill!)
+		       'class-name      '*mock-c-pointer*
+		       )))
+	  
+	  (define* (mock-c-pointer (int 0) type info weak1 weak2)
+	    (immutable!
+	     (openlet 
+	      (sublet (*mock-c-pointer* 'mock-c-pointer-class)
+		'value (#_c-pointer (->value int) (->value type) (->value info) (->value weak1) (->value weak2))
+		'mock-type 'mock-c-pointer?))))
+	  
+	  (set! mock-c-pointer? 
+		(lambda (obj)
+		  (and (let? obj)
+		       (defined? 'mock-type obj #t)
+		       (eq? (obj 'mock-type) 'mock-c-pointer?))))
+	  
+	  (curlet)))
+  
+  
+  ;; --------------------------------------------------------------------------------
+  
+  (set! *mock-random-state*
+	(let* ((mock-random-state? #f)
+	       (mock-random-state-class
+		(inlet 'random-state?      (with-mock-wrapper #_random-state?)
+		       'random-state->list (with-mock-wrapper #_random-state->list)
+		       'random             (with-mock-wrapper* #_random)
+		       'object->string     (with-mock-wrapper* #_object->string)
+		       'format             (with-mock-wrapper* #_format)
+		       'write              (with-mock-wrapper* #_write)
+		       'display            (with-mock-wrapper* #_display)
+		       'class-name         '*mock-random-state*
+		       )))
+	  
+	  (define* (mock-random-state seed (carry 1675393560))
+	    (immutable!
+	     (openlet 
+	      (sublet (*mock-random-state* 'mock-random-state-class)
+		'value (if (provided? 'gmp) (#_random-state seed) (#_random-state seed carry))
+		'mock-type 'mock-random-state?))))
+	  
+	  (set! mock-random-state? 
+		(lambda (obj)
+		  (and (let? obj)
+		       (defined? 'mock-type obj #t)
+		       (eq? (obj 'mock-type) 'mock-random-state?))))
+	  
+	  (curlet)))
+  
+  
+  ;; --------------------------------------------------------------------------------
+  
+  (set! *mock-iterator*
+	(let* ((mock-iterator? #f)
+	       (mock-iterator-class
+		(inlet 'iterator?         (with-mock-wrapper #_iterator?)
+		       'iterate           (with-mock-wrapper #_iterate)
+		       'iterator-at-end?  (with-mock-wrapper #_iterator-at-end?)
+		       'iterator-sequence (with-mock-wrapper #_iterator-sequence)
+		       'object->string    (with-mock-wrapper* #_object->string)
+		       'format            (with-mock-wrapper* #_format)
+		       'write             (with-mock-wrapper* #_write)
+		       'display           (with-mock-wrapper* #_display)
+		       'class-name        '*mock-iterator*
+		       )))
+	  
+	  (define (make-mock-iterator . args)
+	    (immutable!
+	     (openlet 
+	      (sublet (*mock-iterator* 'mock-iterator-class)
+		'value (apply #_make-iterator args)
+		'mock-type 'mock-iterator?))))
+	  
+	  (set! mock-iterator? 
+		(lambda (obj)
+		  (and (let? obj)
+		       (defined? 'mock-type obj #t)
+		       (eq? (obj 'mock-type) 'mock-iterator?))))
+	  
+	  (curlet)))
+  
+  
+  ;; --------------------------------------------------------------------------------
+  
+  (set! *mock-port*
+	(let* ((mock-port? #f)
+	       (mock-port-class
+		(inlet 'input-port?         (with-mock-wrapper #_input-port?)
+		       'output-port?        (with-mock-wrapper #_output-port?)
+		       'port-closed?        (with-mock-wrapper #_port-closed?)
+		       'equivalent?         (with-mock-wrapper* #_equivalent?)
+		       ;'append              (with-mock-wrapper* #_append) ; ?? (append (open-input-string "asdf") ...) is an error
+		       'set-current-output-port (with-mock-wrapper #_set-current-output-port)
+		       'set-current-input-port  (with-mock-wrapper #_set-current-input-port)
+		       'set-current-error-port  (with-mock-wrapper #_set-current-error-port)
+		       'close-input-port    (with-mock-wrapper #_close-input-port)
+		       'close-output-port   (with-mock-wrapper #_close-output-port)
+		       'flush-output-port   (with-mock-wrapper* #_flush-output-port)
+		       'get-output-string   (with-mock-wrapper* #_get-output-string)
+		       'newline             (with-mock-wrapper* #_newline)
+		       'read-char           (with-mock-wrapper* #_read-char)
+		       'peek-char           (with-mock-wrapper* #_peek-char)
+		       'read-byte           (with-mock-wrapper* #_read-byte)
+		       'read-line           (with-mock-wrapper* #_read-line)
+		       'read                (with-mock-wrapper* #_read)
+		       'char-ready?         (with-mock-wrapper* #_char-ready?)
+		       'port-line-number    (with-mock-wrapper* #_port-line-number)
+		       'port-filename       (with-mock-wrapper* #_port-filename)
+		       'object->string      (with-mock-wrapper* #_object->string)
+		       'display             (with-mock-wrapper* #_display)
+		       'write               (with-mock-wrapper* #_write)
+		       'format              (with-mock-wrapper* #_format)
+		       'write-char          (with-mock-wrapper* #_write-char)
+		       'write-string        (with-mock-wrapper* #_write-string)
+		       'write-byte          (with-mock-wrapper* #_write-byte)
+		       'read-string         (with-mock-wrapper* #_read-string)
+		       'class-name          '*mock-port*
+		       )))
+	    
+	  (define (mock-port port)
+	    (if (and (or (input-port? port)
+			 (output-port? port))
+		     (not (let? port)))
+		(openlet
+		 (sublet (*mock-port* 'mock-port-class)
+		   'value port
+		   'mock-type 'mock-port?))
+		(error 'wrong-type-arg "mock-port ~S is not a port" port)))
+	  
+	  (set! mock-port? (lambda (obj)
+			     (and (let? obj)
+				  (defined? 'mock-type obj #t)
+				  (eq? (obj 'mock-type) 'mock-port?))))
+	  
+	  (curlet)))
+  
+  ;; sublet of any of these needs to include the value field or a let-ref-fallback
+
+#|  
+  (require libc.scm)
+  
+  (define *input-file*
+    (let ((file-write-date (lambda (file)
+			     (with-let (sublet *libc* :file file)
+			       (let ((buf (stat.make)))
+				 (stat file buf)
+				 (let ((date (stat.st_mtime buf)))
+				   (free buf)
+				   date)))))
+	  (file-size (lambda (file)
+		       (with-let (sublet *libc* :file file)
+			 (let ((buf (stat.make)))
+			   (stat file buf)
+			   (let ((size (stat.st_size buf)))
+			     (free buf)
+			     size)))))
+	  (file-owner (lambda (file)
+			(with-let (sublet *libc* :file file)
+			  (let ((buf (stat.make)))
+			    (stat file buf)
+			    (let ((uid (stat.st_uid buf)))
+			      (free buf)
+			      (let ((pwd (getpwuid uid)))
+				(passwd.pw_name pwd))))))))
+      (openlet
+       (sublet (*mock-port* 'mock-port-class)
+	 'value      #f
+	 'mock-type 'mock-port?
+	 'length     (lambda (obj) (file-size (obj 'file-name)))
+	 'owner      (lambda (obj) (file-owner (obj 'file-name)))
+	 'write-date (lambda (obj) (file-write-date (obj 'file-name)))))))
+  
+  (define (open-a-file file)
+    (let ((p (openlet
+	      (sublet *input-file* 
+		'file-name file))))
+      (set! (p 'value) (open-input-file file))
+      p))
+  
+  (define p (open-a-file "oboe.snd"))
+  (length p) -> 101684
+  ((p 'owner) p) -> "bil"
+|#
+
+  #f) ; end of outer let
diff --git a/s7/notcurses_s7.c b/s7/notcurses_s7.c
new file mode 100644
index 0000000..b454fad
--- /dev/null
+++ b/s7/notcurses_s7.c
@@ -0,0 +1,4111 @@
+/* s7 FFI for the notcurses library
+ *
+ *   requires notcurses 3.0.0 or later
+ *   Fedora: notcurses notcurses-devel notcurses-utils
+ *   tested in fedora 32/33/34, Ubuntu 20.10/21.04
+ */
+
+#include <locale.h>
+
+#include <notcurses/notcurses.h>
+#include <notcurses/direct.h>
+#include <notcurses/version.h>
+
+#define NC_VERSION(Major, Minor, Patch) NOTCURSES_VERSION_COMPARABLE(Major, Minor, Patch)
+#define NC_CURRENT_VERSION (NC_VERSION(NOTCURSES_VERNUM_MAJOR, NOTCURSES_VERNUM_MINOR, NOTCURSES_VERNUM_PATCH))
+
+#include "s7.h"
+
+static s7_int s7_integer_checked(s7_scheme *sc, s7_pointer val)
+{
+  if (!s7_is_integer(val))
+    s7_wrong_type_arg_error(sc, __func__, 0, val, "an integer");
+  return(s7_integer(val));
+}
+
+static s7_double s7_real_checked(s7_scheme *sc, s7_pointer val)
+{
+  if (!s7_is_real(val))
+    s7_wrong_type_arg_error(sc, __func__, 0, val, "a real");
+  return(s7_real(val));
+}
+
+static const char *s7_string_checked(s7_scheme *sc, s7_pointer val)
+{
+  if (!s7_is_string(val))
+    s7_wrong_type_arg_error(sc, __func__, 0, val, "a string");
+  return(s7_string(val));
+}
+
+static s7_pointer g_notcurses_version(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_string(sc, notcurses_version()));
+}
+
+static s7_pointer g_notcurses_version_components(s7_scheme *sc, s7_pointer args)
+{
+  int major, minor, patch, tweak;
+  notcurses_version_components(&major, &minor, &patch, &tweak);
+  return(s7_list(sc, 4, s7_make_integer(sc, major), s7_make_integer(sc, minor), s7_make_integer(sc, patch), s7_make_integer(sc, tweak)));
+}
+
+
+static s7_pointer ncdirect_symbol, ncplane_symbol, nccell_symbol, ncinput_symbol, ncmenu_symbol, notcurses_symbol, notcurses_options_symbol, 
+  ncplane_options_symbol, ncuplot_symbol, ncdplot_symbol, ncplot_options_symbol, ncreel_symbol, ncreel_options_symbol, ncreader_symbol, ncreader_options_symbol,
+  ncvisual_symbol, ncvisual_options_symbol ,ncselector_symbol, ncselector_options_symbol, ncmultiselector_symbol, ncmultiselector_options_symbol,
+  nctablet_symbol, ncfdplane_options_symbol, ncsubproc_options_symbol, ncmenu_options_symbol, void_symbol, ncmselector_item_symbol, ncselector_item_symbol,
+  ncfdplane_symbol, ncsubproc_symbol, ncstats_symbol, char_symbol, ncmenu_item_symbol, ncmenu_section_symbol, timespec_symbol, sigset_t_symbol;
+
+static void init_symbols(s7_scheme *sc)
+{
+  ncdirect_symbol = s7_make_symbol(sc, "ncdirect*");
+  ncplane_symbol = s7_make_symbol(sc, "ncplane*");
+  nccell_symbol = s7_make_symbol(sc, "nccell*");
+  ncinput_symbol = s7_make_symbol(sc, "ncinput*");
+  ncmenu_symbol = s7_make_symbol(sc, "ncmenu*");
+  ncmenu_options_symbol = s7_make_symbol(sc, "ncmenu_options*");
+  notcurses_symbol = s7_make_symbol(sc, "notcurses*");
+  notcurses_options_symbol = s7_make_symbol(sc, "notcurses_options*");
+  ncplane_options_symbol = s7_make_symbol(sc, "ncplane_options*");
+  ncuplot_symbol = s7_make_symbol(sc, "ncuplot*");
+  ncdplot_symbol = s7_make_symbol(sc, "ncdplot*");
+  ncplot_options_symbol = s7_make_symbol(sc, "ncplot_options*");
+  ncreel_symbol = s7_make_symbol(sc, "ncreel*");
+  ncreel_options_symbol = s7_make_symbol(sc, "ncreel_options*");
+  ncreader_symbol = s7_make_symbol(sc, "ncreader*");
+  ncreader_options_symbol = s7_make_symbol(sc, "ncreader_options*");
+  ncvisual_symbol = s7_make_symbol(sc, "ncvisual*");
+  ncvisual_options_symbol = s7_make_symbol(sc, "ncvisual_options*");
+  ncselector_symbol = s7_make_symbol(sc, "ncselector*");
+  ncselector_options_symbol = s7_make_symbol(sc, "ncselector_options*");
+  ncmultiselector_symbol = s7_make_symbol(sc, "ncmultiselector*");
+  ncmultiselector_options_symbol = s7_make_symbol(sc, "ncmultiselector_options*");
+  nctablet_symbol = s7_make_symbol(sc, "nctablet*");
+  ncfdplane_symbol = s7_make_symbol(sc, "ncfdplane*");
+  ncfdplane_options_symbol = s7_make_symbol(sc, "ncfdplane_options*");
+  ncsubproc_symbol = s7_make_symbol(sc, "ncsubproc*");
+  ncsubproc_options_symbol = s7_make_symbol(sc, "ncsubproc_options*");
+  void_symbol = s7_make_symbol(sc, "void*");
+  char_symbol = s7_make_symbol(sc, "char**");
+  ncselector_item_symbol = s7_make_symbol(sc, "ncselector_item*");
+  ncmselector_item_symbol = s7_make_symbol(sc, "ncmselector_item*");
+  ncstats_symbol = s7_make_symbol(sc, "ncstats*");
+  ncmenu_item_symbol = s7_make_symbol(sc, "ncmenu_item*");
+  ncmenu_section_symbol = s7_make_symbol(sc, "ncmenu_section*");
+  timespec_symbol = s7_make_symbol(sc, "timespec*");
+  sigset_t_symbol = s7_make_symbol(sc, "sigset_t*");
+}
+
+
+static s7_pointer g_ncstrwidth(s7_scheme *sc, s7_pointer args)
+{
+  int bytes = 0, width = 0;
+  s7_pointer res;
+  res = s7_make_integer(sc, ncstrwidth((const char *)s7_string_checked(sc, s7_car(args)), &bytes, &width));
+  return(s7_list(sc, 3, res, s7_make_integer(sc, bytes), s7_make_integer(sc, width)));
+}
+
+/* -------- notcurses_options* -------- */
+#if 0
+/*
+  (load "notcurses_s7.so" (inlet 'init_func 'notcurses_s7_init))
+  (define noptions (notcurses_options_make))
+  (set! (notcurses_options_flags noptions) NCOPTION_SUPPRESS_BANNERS)
+  (define nc (notcurses_core_init noptions))
+  (notcurses_render nc)
+  (define stats (ncstats_make))
+  (notcurses_stats nc stats)
+  (notcurses_stop nc)
+  (exit)
+*/
+#endif
+
+static s7_pointer g_notcurses_options_termtype(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_string(sc, ((notcurses_options *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_options_symbol, __func__, 1))->termtype));
+}
+
+static s7_pointer g_notcurses_options_loglevel(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((notcurses_options *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_options_symbol, __func__, 1))->loglevel));
+}
+
+static s7_pointer g_notcurses_options_margin_t(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((notcurses_options *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_options_symbol, __func__, 1))->margin_t));
+}
+
+static s7_pointer g_notcurses_options_margin_r(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((notcurses_options *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_options_symbol, __func__, 1))->margin_r));
+}
+
+static s7_pointer g_notcurses_options_margin_b(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((notcurses_options *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_options_symbol, __func__, 1))->margin_b));
+}
+
+static s7_pointer g_notcurses_options_margin_l(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((notcurses_options *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_options_symbol, __func__, 1))->margin_l));
+}
+
+static s7_pointer g_notcurses_options_flags(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((notcurses_options *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_options_symbol, __func__, 1))->flags));
+}
+
+
+static s7_pointer g_set_notcurses_options_margin_t(s7_scheme *sc, s7_pointer args)
+{
+  notcurses_options *no;
+  no = (notcurses_options *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_options_symbol, __func__, 1);
+  no->margin_t = (int)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_notcurses_options_margin_r(s7_scheme *sc, s7_pointer args)
+{
+  notcurses_options *no;
+  no = (notcurses_options *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_options_symbol, __func__, 1);
+  no->margin_r = (int)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_notcurses_options_margin_b(s7_scheme *sc, s7_pointer args)
+{
+  notcurses_options *no;
+  no = (notcurses_options *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_options_symbol, __func__, 1);
+  no->margin_b = (int)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_notcurses_options_margin_l(s7_scheme *sc, s7_pointer args)
+{
+  notcurses_options *no;
+  no = (notcurses_options *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_options_symbol, __func__, 1);
+  no->margin_l = (int)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_notcurses_options_flags(s7_scheme *sc, s7_pointer args)
+{
+  notcurses_options *no;
+  no = (notcurses_options *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_options_symbol, __func__, 1);
+  no->flags = (uint64_t)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_notcurses_options_loglevel(s7_scheme *sc, s7_pointer args)
+{
+  notcurses_options *no;
+  no = (notcurses_options *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_options_symbol, __func__, 1);
+  no->loglevel = (uint64_t)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_notcurses_options_make(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(notcurses_options)), notcurses_options_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_notcurses_options_free(s7_scheme *sc, s7_pointer args)
+{
+  free((void *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_options_symbol, __func__, 0));
+  return(s7_f(sc));
+}
+
+
+/* -------- notcurses* -------- */
+
+static s7_pointer g_notcurses_core_init(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer noptions, fp;
+  notcurses_options *no = NULL;
+  FILE *f = NULL;
+  setlocale(LC_ALL, "");
+  if (s7_is_pair(args))
+    {
+      noptions = s7_car(args);
+      if (noptions == s7_f(sc))
+	no = NULL;
+      else no = (notcurses_options *)s7_c_pointer_with_type(sc, noptions, notcurses_options_symbol, __func__, 1);
+      if (s7_is_pair(s7_cdr(args)))
+	{
+	  fp = s7_cadr(args);
+	  if (fp == s7_f(sc))
+	    f = NULL;
+	  else f = (FILE *)s7_c_pointer_with_type(sc, fp, s7_make_symbol(sc, "FILE*"), __func__, 2);
+	}
+    }
+  return(s7_make_c_pointer_with_type(sc, notcurses_core_init(no, f), notcurses_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_notcurses_stop(s7_scheme *sc, s7_pointer args)
+{
+  notcurses_stop((struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_notcurses_render(s7_scheme *sc, s7_pointer args)
+{
+  notcurses_render((struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_notcurses_inputready_fd(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, notcurses_inputready_fd((struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1))));
+}
+
+static s7_pointer g_notcurses_mice_enable(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, notcurses_mice_enable((struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1), 
+                                                   (unsigned)s7_integer(s7_cadr(args)))));
+}
+
+static s7_pointer g_notcurses_mice_disable(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, notcurses_mice_disable((struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1))));
+}
+
+static s7_pointer g_notcurses_cursor_enable(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, notcurses_cursor_enable((struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1),
+						     s7_integer_checked(sc, s7_cadr(args)), s7_integer_checked(sc, s7_caddr(args)))));
+}
+
+static s7_pointer g_notcurses_cursor_disable(s7_scheme *sc, s7_pointer args)
+{
+  notcurses_cursor_disable((struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_notcurses_supported_styles(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, (s7_int)notcurses_supported_styles((struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1))));
+}
+
+static s7_pointer g_notcurses_top(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, notcurses_top((struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1)), 
+				     ncplane_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_notcurses_bottom(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, notcurses_bottom((struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1)), 
+				     ncplane_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_notcurses_stdplane(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, notcurses_stdplane((struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1)), 
+				     ncplane_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_notcurses_stdplane_const(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)notcurses_stdplane_const((const struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), 
+															   notcurses_symbol, __func__, 1)), 
+				     ncplane_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_notcurses_drop_planes(s7_scheme *sc, s7_pointer args)
+{
+  notcurses_drop_planes((struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1));
+  return(s7_f(sc));
+}
+
+#if 0
+static s7_pointer g_notcurses_render_to_buffer(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, notcurses_render_to_buffer((struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1),
+							(char **)s7_c_pointer(s7_cadr(args)),
+							(size_t *)s7_c_pointer(s7_caddr(args)))));
+}
+#endif
+
+static s7_pointer g_notcurses_stats_reset(s7_scheme *sc, s7_pointer args)
+{
+  notcurses_stats_reset((struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1), 
+			(ncstats *)s7_c_pointer_with_type(sc, s7_cadr(args), ncstats_symbol, __func__, 2));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_notcurses_stats_alloc(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, notcurses_stats_alloc((const struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1)),
+				     ncstats_symbol, s7_f(sc)));
+}
+
+/* remove current ncstats_make */
+
+static s7_pointer g_ncstats_writeout_ns(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncstats *)s7_c_pointer_with_type(sc, s7_car(args), ncstats_symbol, __func__, 1))->writeout_ns));
+}
+
+static s7_pointer g_ncstats_writeout_max_ns(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncstats *)s7_c_pointer_with_type(sc, s7_car(args), ncstats_symbol, __func__, 1))->writeout_max_ns));
+}
+
+static s7_pointer g_ncstats_writeout_min_ns(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncstats *)s7_c_pointer_with_type(sc, s7_car(args), ncstats_symbol, __func__, 1))->writeout_min_ns));
+}
+
+static s7_pointer g_ncmenu_item_set_status(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ncmenu_item_set_status((struct ncmenu *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_symbol, __func__, 1),
+						    (const char *)s7_string(s7_cadr(args)),
+						    (const char *)s7_string(s7_caddr(args)),
+						    s7_boolean(sc, s7_cadddr(args)))));
+}
+
+#if 0
+typedef struct ncpalette {uint32_t chans[NCPALETTESIZE];} ncpalette;
+
+static s7_pointer g_ncpalette_new(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncpalette_new((struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1)), 
+				     s7_make_symbol(sc, "ncpalette*"), s7_f(sc)));
+}
+
+static s7_pointer g_ncpalette_free(s7_scheme *sc, s7_pointer args)
+{
+  ncpalette_free((ncpalette *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, "ncpalette*"), __func__, 1));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncpalette_use(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncpalette_use((struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1), 
+					    (const ncpalette *)s7_c_pointer_with_type(sc, s7_cadr(args), s7_make_symbol(sc, "ncpalette*"), __func__, 2))));
+}
+#endif
+
+static s7_pointer g_notcurses_palette_size(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, notcurses_palette_size((struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1))));
+}
+
+static s7_pointer g_notcurses_canfade(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_boolean(sc, notcurses_canfade((const struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1))));
+}
+
+static s7_pointer g_notcurses_canchangecolor(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_boolean(sc, notcurses_canchangecolor((const struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1))));
+}
+
+static s7_pointer g_notcurses_canopen_images(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_boolean(sc, notcurses_canopen_images((const struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1))));
+}
+
+static s7_pointer g_notcurses_canopen_videos(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_boolean(sc, notcurses_canopen_videos((const struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1))));
+}
+
+static s7_pointer g_notcurses_canutf8(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_boolean(sc, notcurses_canutf8((const struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1))));
+}
+
+static s7_pointer g_notcurses_get(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, notcurses_get((struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1),
+					      (const struct timespec *)s7_c_pointer_with_type(sc, s7_cadr(args), timespec_symbol, __func__, 2), 
+					      (ncinput *)s7_c_pointer_with_type(sc, s7_caddr(args), ncinput_symbol, __func__, 3))));
+}
+
+static s7_pointer g_notcurses_refresh(s7_scheme *sc, s7_pointer args)
+{
+#if (NC_CURRENT_VERSION >= NC_VERSION(3, 0, 4))
+  unsigned int x = 0, y = 0;
+  int z;
+#else
+  int x = 0, y = 0, z;
+#endif
+  z = notcurses_refresh((struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1), &x, &y); /* by reference? */
+  return(s7_list(sc, 3, s7_make_integer(sc, z), s7_make_integer(sc, x), s7_make_integer(sc, y)));
+}
+
+static s7_pointer g_notcurses_at_yx(s7_scheme *sc, s7_pointer args)
+{
+  uint16_t stylemask = 0;
+  uint64_t channels = 0;
+  char *c;
+  c = notcurses_at_yx((struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1),
+		      (int)s7_integer_checked(sc, s7_cadr(args)), (int)s7_integer_checked(sc, s7_caddr(args)),
+		      &stylemask, &channels);
+  return(s7_list(sc, 3, s7_make_string(sc, c), s7_make_integer(sc, stylemask), s7_make_integer(sc, channels)));
+}
+
+static s7_pointer g_notcurses_lex_margins(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, notcurses_lex_margins((const char *)s7_string_checked(sc, s7_car(args)), 
+						   (notcurses_options *)s7_c_pointer_with_type(sc, s7_cadr(args), notcurses_options_symbol, __func__, 2))));
+}
+
+static s7_pointer g_notcurses_lex_scalemode(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_boolean(sc, notcurses_lex_scalemode((const char *)s7_string_checked(sc, s7_car(args)), 
+						     (ncscale_e *)s7_c_pointer_with_type(sc, s7_cadr(args), s7_make_symbol(sc, "ncscale_e*"), __func__, 2))));
+}
+
+#if 0
+static s7_pointer g_notcurses_render_to_file(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, notcurses_render_to_file((struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1),
+						      (FILE *)s7_c_pointer_with_type(sc, s7_cadr(args), s7_make_symbol(sc, "FILE*"), __func__, 2))));
+}
+#endif
+
+/* TODO: notcurses_ucs32_to_utf8 
+ */
+
+
+/* -------- ncinput* -------- */
+#if 0
+/*
+  (load "notcurses_s7.so" (inlet 'init_func 'notcurses_s7_init))
+  (define noptions (notcurses_options_make))
+  (set! (notcurses_options_flags noptions) NCOPTION_SUPPRESS_BANNERS)
+  (define nc (notcurses_core_init noptions))
+  (notcurses_cursor_enable nc 0 0)
+  (define ncp (ncplane_new nc 20 20 0 0 (c-pointer 0)))
+  (ncplane_putstr_yx ncp 0 0 "> ")
+  (notcurses_render nc)
+  (let ((ni (ncinput_make)))
+    (do ((c (notcurses_getc nc (c-pointer 0) (c-pointer 0) ni)
+  	    (notcurses_getc nc (c-pointer 0) (c-pointer 0) ni))
+         (i 2 (+ i 1)))
+        ((and (= c (integer->char #\Q)) ; C-Q to exit
+  	      (ncinput_ctrl ni)))
+      (if (< c 256) (ncplane_putstr_yx ncp 0 i (string c)))
+      (notcurses_render nc)))
+  (notcurses_stop nc)
+  (exit)
+*/
+#endif
+
+#if 0
+typedef struct ncinput {
+  char32_t id; 
+  int y;       
+  int x;       
+  bool alt;    
+  bool shift;  
+  bool ctrl;   
+  enum evtype added later in place of NCKEY_RELEASE (PRESS|REPEAT|UNKNOWN)
+} ncinput;
+#endif
+
+static s7_pointer g_ncinput_make(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(ncinput)), ncinput_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncinput_free(s7_scheme *sc, s7_pointer args)
+{
+  free((void *)s7_c_pointer_with_type(sc, s7_car(args), void_symbol, __func__, 1));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncinput_id(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncinput *)s7_c_pointer_with_type(sc, s7_car(args), ncinput_symbol, __func__, 1))->id));
+}
+
+static s7_pointer g_ncinput_y(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncinput *)s7_c_pointer_with_type(sc, s7_car(args), ncinput_symbol, __func__, 1))->y));
+}
+
+static s7_pointer g_ncinput_x(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncinput *)s7_c_pointer_with_type(sc, s7_car(args), ncinput_symbol, __func__, 1))->x));
+}
+
+static s7_pointer g_ncinput_alt(s7_scheme *sc, s7_pointer args) 
+{
+#if (NC_CURRENT_VERSION >= NC_VERSION(3, 0, 4))
+  return(s7_make_boolean(sc, ncinput_alt_p((const ncinput *)s7_c_pointer_with_type(sc, s7_car(args), ncinput_symbol, __func__, 1))));
+#else
+  return(s7_make_boolean(sc, ((ncinput *)s7_c_pointer_with_type(sc, s7_car(args), ncinput_symbol, __func__, 1))->alt));
+#endif
+}
+
+static s7_pointer g_ncinput_shift(s7_scheme *sc, s7_pointer args) 
+{
+#if (NC_CURRENT_VERSION >= NC_VERSION(3, 0, 4))
+  return(s7_make_boolean(sc, ncinput_shift_p((const ncinput *)s7_c_pointer_with_type(sc, s7_car(args), ncinput_symbol, __func__, 1))));
+#else
+  return(s7_make_boolean(sc, ((ncinput *)s7_c_pointer_with_type(sc, s7_car(args), ncinput_symbol, __func__, 1))->shift));
+#endif
+}
+
+static s7_pointer g_ncinput_ctrl(s7_scheme *sc, s7_pointer args) 
+{
+#if (NC_CURRENT_VERSION >= NC_VERSION(3, 0, 4))
+  return(s7_make_boolean(sc, ncinput_ctrl_p((const ncinput *)s7_c_pointer_with_type(sc, s7_car(args), ncinput_symbol, __func__, 1))));
+#else
+  return(s7_make_boolean(sc, ((ncinput *)s7_c_pointer_with_type(sc, s7_car(args), ncinput_symbol, __func__, 1))->ctrl));
+#endif
+}
+
+#if (NC_CURRENT_VERSION >= NC_VERSION(3, 0, 4))
+static s7_pointer g_ncinput_meta(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_boolean(sc, ncinput_meta_p((const ncinput *)s7_c_pointer_with_type(sc, s7_car(args), ncinput_symbol, __func__, 1))));
+}
+#endif
+
+static s7_pointer g_ncinput_evtype(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, (s7_int)((ncinput *)s7_c_pointer_with_type(sc, s7_car(args), ncinput_symbol, __func__, 1))->evtype));
+}
+
+
+
+/* -------- ncstats* -------- */
+
+static s7_pointer g_ncstats_renders(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncstats *)s7_c_pointer_with_type(sc, s7_car(args), ncstats_symbol, __func__, 1))->renders));
+}
+
+static s7_pointer g_ncstats_failed_renders(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncstats *)s7_c_pointer_with_type(sc, s7_car(args), ncstats_symbol, __func__, 1))->failed_renders));
+}
+
+static s7_pointer g_ncstats_render_ns(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncstats *)s7_c_pointer_with_type(sc, s7_car(args), ncstats_symbol, __func__, 1))->render_ns));
+}
+
+static s7_pointer g_ncstats_render_max_ns(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncstats *)s7_c_pointer_with_type(sc, s7_car(args), ncstats_symbol, __func__, 1))->render_max_ns));
+}
+
+static s7_pointer g_ncstats_render_min_ns(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncstats *)s7_c_pointer_with_type(sc, s7_car(args), ncstats_symbol, __func__, 1))->render_min_ns));
+}
+
+static s7_pointer g_ncstats_cellelisions(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncstats *)s7_c_pointer_with_type(sc, s7_car(args), ncstats_symbol, __func__, 1))->cellelisions));
+}
+
+static s7_pointer g_ncstats_cellemissions(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncstats *)s7_c_pointer_with_type(sc, s7_car(args), ncstats_symbol, __func__, 1))->cellemissions));
+}
+
+static s7_pointer g_ncstats_fgelisions(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncstats *)s7_c_pointer_with_type(sc, s7_car(args), ncstats_symbol, __func__, 1))->fgelisions));
+}
+
+static s7_pointer g_ncstats_fgemissions(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncstats *)s7_c_pointer_with_type(sc, s7_car(args), ncstats_symbol, __func__, 1))->fgemissions));
+}
+
+static s7_pointer g_ncstats_bgelisions(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncstats *)s7_c_pointer_with_type(sc, s7_car(args), ncstats_symbol, __func__, 1))->bgelisions));
+}
+
+static s7_pointer g_ncstats_bgemissions(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncstats *)s7_c_pointer_with_type(sc, s7_car(args), ncstats_symbol, __func__, 1))->bgemissions));
+}
+
+static s7_pointer g_ncstats_defaultelisions(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncstats *)s7_c_pointer_with_type(sc, s7_car(args), ncstats_symbol, __func__, 1))->defaultelisions));
+}
+
+static s7_pointer g_ncstats_defaultemissions(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncstats *)s7_c_pointer_with_type(sc, s7_car(args), ncstats_symbol, __func__, 1))->defaultemissions));
+}
+
+static s7_pointer g_ncstats_fbbytes(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncstats *)s7_c_pointer_with_type(sc, s7_car(args), ncstats_symbol, __func__, 1))->fbbytes));
+}
+
+static s7_pointer g_ncstats_planes(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncstats *)s7_c_pointer_with_type(sc, s7_car(args), ncstats_symbol, __func__, 1))->planes));
+}
+
+
+static s7_pointer g_ncstats_make(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (ncstats *)calloc(1, sizeof(ncstats)), ncstats_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncstats_free(s7_scheme *sc, s7_pointer args)
+{
+  free((void *)s7_c_pointer_with_type(sc, s7_car(args), ncstats_symbol, __func__, 0));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_notcurses_stats(s7_scheme *sc, s7_pointer args)
+{
+  notcurses_stats((struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1), 
+		  (ncstats *)s7_c_pointer_with_type(sc, s7_cadr(args), ncstats_symbol, __func__, 2));
+  return(s7_cadr(args));
+}
+
+
+/* -------- ncplane_options -------- */
+
+#if 0
+typedef struct ncplane_options {
+  int y;  
+  int x;
+  int rows; 
+  int cols; 
+  void* userptr;
+  const char* name;
+  int (*resizecb)(struct ncplane*);
+  uint64_t flags;
+} ncplane_options;
+#endif
+
+static s7_pointer g_ncplane_options_make(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(ncplane_options)), ncplane_options_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncplane_options_free(s7_scheme *sc, s7_pointer args)
+{
+  free((void *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_options_symbol, __func__, 0));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncplane_options_y(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncplane_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_options_symbol, __func__, 1))->y));
+}
+
+static s7_pointer g_set_ncplane_options_y(s7_scheme *sc, s7_pointer args) 
+{
+  ((ncplane_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_options_symbol, __func__, 1))->y = s7_integer_checked(sc, s7_car(args));
+  return(s7_car(args));
+}
+
+static s7_pointer g_ncplane_options_rows(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncplane_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_options_symbol, __func__, 1))->rows));
+}
+
+static s7_pointer g_set_ncplane_options_rows(s7_scheme *sc, s7_pointer args) 
+{
+  ((ncplane_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_options_symbol, __func__, 1))->rows = s7_integer_checked(sc, s7_car(args));
+  return(s7_car(args));
+}
+
+static s7_pointer g_ncplane_options_cols(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncplane_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_options_symbol, __func__, 1))->cols));
+}
+
+static s7_pointer g_set_ncplane_options_cols(s7_scheme *sc, s7_pointer args) 
+{
+  ((ncplane_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_options_symbol, __func__, 1))->cols = s7_integer_checked(sc, s7_car(args));
+  return(s7_car(args));
+}
+
+static s7_pointer g_ncplane_options_x(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncplane_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_options_symbol, __func__, 1))->x));
+}
+
+static s7_pointer g_set_ncplane_options_x(s7_scheme *sc, s7_pointer args) 
+{
+  ((ncplane_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_options_symbol, __func__, 1))->x = s7_integer_checked(sc, s7_car(args));
+  return(s7_car(args));
+}
+
+static s7_pointer g_ncplane_options_userptr(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_c_pointer(sc, ((ncplane_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_options_symbol, __func__, 1))->userptr));
+}
+
+static s7_pointer g_set_ncplane_options_userptr(s7_scheme *sc, s7_pointer args) 
+{
+  ((ncplane_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_options_symbol, __func__, 1))->userptr = s7_c_pointer(s7_car(args));
+  return(s7_car(args));
+}
+
+static s7_pointer g_ncplane_options_name(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_string(sc, ((ncplane_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_options_symbol, __func__, 1))->name));
+}
+
+static s7_pointer g_set_ncplane_options_name(s7_scheme *sc, s7_pointer args) 
+{
+  ((ncplane_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_options_symbol, __func__, 1))->name = (const char *)s7_string_checked(sc, s7_car(args));
+  return(s7_car(args));
+}
+
+static s7_pointer g_ncplane_options_flags(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncplane_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_options_symbol, __func__, 1))->flags));
+}
+
+static s7_pointer g_set_ncplane_options_flags(s7_scheme *sc, s7_pointer args) 
+{
+  ((ncplane_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_options_symbol, __func__, 1))->flags = (uint64_t)s7_integer_checked(sc, s7_car(args));
+  return(s7_car(args));
+}
+
+static s7_pointer g_ncplane_create(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncplane_create((struct ncplane *)s7_c_pointer(s7_car(args)),
+							(const ncplane_options *)s7_c_pointer(s7_cadr(args))),
+				     ncplane_symbol, s7_f(sc)));
+}
+
+
+/* -------- ncplane* -------- */
+
+static s7_pointer g_ncplane_notcurses(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncplane_notcurses((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1)), 
+				     notcurses_symbol, s7_f(sc)));
+}
+
+/* also const struct notcurses* ncplane_notcurses_const(const struct ncplane* n) */
+
+static s7_pointer g_ncplane_destroy(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_destroy((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncplane_move_top(s7_scheme *sc, s7_pointer args)
+{
+  ncplane_move_top((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncplane_move_bottom(s7_scheme *sc, s7_pointer args)
+{
+  ncplane_move_bottom((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncplane_rotate_cw(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_rotate_cw((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncplane_rotate_ccw(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_rotate_ccw((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncplane_userptr(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncplane_userptr((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1)), 
+				     void_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncplane_home(s7_scheme *sc, s7_pointer args)
+{
+  ncplane_home((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncplane_below(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncplane_below((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1)), 
+				     ncplane_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncplane_channels(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_channels((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncplane_erase(s7_scheme *sc, s7_pointer args)
+{
+  ncplane_erase((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncplane_set_fg_default(s7_scheme *sc, s7_pointer args)
+{
+  ncplane_set_fg_default((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncplane_set_bg_default(s7_scheme *sc, s7_pointer args)
+{
+  ncplane_set_bg_default((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncplane_styles(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_styles((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncfadectx_setup(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncfadectx_setup((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1)), 
+				     s7_make_symbol(sc, "ncfadectx*"), s7_f(sc)));
+}
+
+static s7_pointer g_ncfadectx_free(s7_scheme *sc, s7_pointer args)
+{
+  ncfadectx_free((struct ncfadectx *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, "ncfadectx*"), __func__, 1));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncfadectx_iterations(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncfadectx_iterations((const struct ncfadectx *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, "ncfadectx*"), __func__, 1))));
+}
+
+static s7_pointer g_ncplane_set_fg_rgb(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_set_fg_rgb((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1),
+					    (unsigned)s7_integer_checked(sc, s7_cadr(args)))));
+}
+
+static s7_pointer g_ncplane_set_bg_rgb(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_set_bg_rgb((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1),
+					    (unsigned)s7_integer_checked(sc, s7_cadr(args)))));
+}
+
+static s7_pointer g_ncplane_set_styles(s7_scheme *sc, s7_pointer args)
+{
+  ncplane_set_styles((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1),
+		     (unsigned)s7_integer_checked(sc, s7_cadr(args)));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncplane_on_styles(s7_scheme *sc, s7_pointer args)
+{
+  ncplane_on_styles((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+		    (unsigned)s7_integer_checked(sc, s7_cadr(args)));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncplane_off_styles(s7_scheme *sc, s7_pointer args)
+{
+  ncplane_off_styles((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+		     (unsigned)s7_integer_checked(sc, s7_cadr(args)));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncplane_set_fg_palindex(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_set_fg_palindex((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+(int)s7_integer_checked(sc, s7_cadr(args)))));
+}
+
+static s7_pointer g_ncplane_set_bg_palindex(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_set_bg_palindex((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1),
+						     (int)s7_integer_checked(sc, s7_cadr(args)))));
+}
+
+static s7_pointer g_ncplane_set_fg_alpha(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_set_fg_alpha((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+						  (int)s7_integer_checked(sc, s7_cadr(args)))));
+}
+
+static s7_pointer g_ncplane_set_bg_alpha(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_set_bg_alpha((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+						  (int)s7_integer_checked(sc, s7_cadr(args)))));
+}
+
+static s7_pointer g_ncplane_set_channels(s7_scheme *sc, s7_pointer args)
+{
+  ncplane_set_channels((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), (uint64_t)s7_integer_checked(sc, s7_cadr(args)));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncplane_dim_yx(s7_scheme *sc, s7_pointer args)
+{
+#if (NC_CURRENT_VERSION >= NC_VERSION(3, 0, 4))
+  unsigned int x = 0, y = 0;
+#else
+  int x = 0, y = 0;
+#endif
+  ncplane_dim_yx((const struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), &y, &x);
+  return(s7_list(sc, 2, s7_make_integer(sc, y), s7_make_integer(sc, x)));
+}
+
+static s7_pointer g_nccell_load(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, nccell_load((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+				       (nccell *)s7_c_pointer_with_type(sc, s7_cadr(args), nccell_symbol, __func__, 2),
+				       (const char *)s7_string_checked(sc, s7_caddr(args)))));
+}
+
+static s7_pointer g_nccell_release(s7_scheme *sc, s7_pointer args)
+{
+  nccell_release((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+	       (nccell *)s7_c_pointer_with_type(sc, s7_cadr(args), nccell_symbol, __func__, 2));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_nccell_make(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(nccell)), nccell_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_nccell_extended_gcluster(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_string(sc, nccell_extended_gcluster((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+						   (const nccell *)s7_c_pointer_with_type(sc, s7_cadr(args), nccell_symbol, __func__, 2))));
+}
+
+#if 0
+/*
+;;; fill ncplane with red? on white bg
+(let ((c1 (cell_make))
+      (ncp (((*nrepl* 'top-level-let) 'nc-let) 'ncp))
+      (nc (*nrepl* 'nc)))
+  (set! (cell_gcluster c1) (char->integer #\?))
+  (set! (cell_channels c1) (logior CELL_FGDEFAULT_MASK CELL_BGDEFAULT_MASK #x00ff000000ffffff)) ; red on white
+  (set! (cell_stylemask c1) NCSTYLE_UNDERLINE) ; 0 = no funny business
+  (ncplane_set_base_cell ncp c1)
+  (notcurses_render nc)
+  (nccell_release c1))
+*/
+#endif
+
+static s7_pointer g_ncplane_set_base_cell(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_set_base_cell((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+						   (const nccell *)s7_c_pointer_with_type(sc, s7_cadr(args), nccell_symbol, __func__, 2))));
+}
+
+static s7_pointer g_ncplane_base(s7_scheme *sc, s7_pointer args)
+{
+  nccell *c;
+  int res;
+  c = (nccell *)calloc(1, sizeof(nccell));
+  res = ncplane_base((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), c);
+  return(s7_list(sc, 2, s7_make_integer(sc, res), s7_make_c_pointer_with_type(sc, c, nccell_symbol, s7_f(sc))));
+}
+
+static s7_pointer g_ncplane_polyfill_yx(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_polyfill_yx((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+						 (int)s7_integer_checked(sc, s7_cadr(args)), (int)s7_integer_checked(sc, s7_caddr(args)), 
+						 (const nccell *)s7_c_pointer_with_type(sc, s7_cadddr(args), nccell_symbol, __func__, 4))));
+}
+
+static s7_pointer g_ncplane_putc_yx(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_putc_yx((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+					     (int)s7_integer_checked(sc, s7_cadr(args)), (int)s7_integer_checked(sc, s7_caddr(args)), 
+					     (const nccell *)s7_c_pointer_with_type(sc, s7_cadddr(args), nccell_symbol, __func__, 4))));
+}
+
+#if 0
+/*
+(let ((c1 (cell_make))
+      (ncp (((*nrepl* 'top-level-let) 'nc-let) 'ncp))
+      (nc (*nrepl* 'nc)))
+  (set! (cell_gcluster c1) (char->integer #\_)) ; how to use Unicode here?
+  (set! (cell_channels c1) (logior CELL_FGDEFAULT_MASK #x00ff000000000000)) ; red line
+  (set! (cell_stylemask c1) NCSTYLE_BOLD)
+  (ncplane_cursor_move_yx ncp 20 0)
+  (ncplane_hline_interp ncp c1 40 (cell_channels c1) (cell_channels c1))
+  (notcurses_render nc))
+*/
+#endif
+
+static s7_pointer g_ncplane_hline_interp(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_hline_interp((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+						  (const nccell *)s7_c_pointer_with_type(sc, s7_cadr(args), nccell_symbol, __func__, 2),
+						  (int)s7_integer_checked(sc, s7_caddr(args)), 
+						  (uint64_t)s7_integer_checked(sc, s7_cadddr(args)), 
+						  (uint64_t)s7_integer_checked(sc, s7_car(s7_cdddr(args))))));
+}
+
+static s7_pointer g_ncplane_vline_interp(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_vline_interp((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+						  (const nccell *)s7_c_pointer_with_type(sc, s7_cadr(args), nccell_symbol, __func__, 2),
+						  (int)s7_integer_checked(sc, s7_caddr(args)), 
+						  (uint64_t)s7_integer_checked(sc, s7_cadddr(args)), 
+						  (uint64_t)s7_integer_checked(sc, s7_car(s7_cdddr(args))))));
+}
+
+static s7_pointer g_ncplane_box(s7_scheme *sc, s7_pointer args)
+{
+  const nccell *ul, *ur, *ll, *lr, *hline, *vline;
+  int ystop, xstop;
+  unsigned int ctlword;
+  s7_pointer arg;
+  arg = s7_cdr(args);
+  ul = (const nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); arg = s7_cdr(arg);
+  ur = (const nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); arg = s7_cdr(arg);
+  ll = (const nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); arg = s7_cdr(arg);
+  lr = (const nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); arg = s7_cdr(arg);
+  hline = (const nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); arg = s7_cdr(arg);
+  vline = (const nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); arg = s7_cdr(arg);
+  ystop = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  xstop = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  ctlword = (unsigned int)s7_integer_checked(sc, s7_car(arg));
+  return(s7_make_integer(sc, ncplane_box((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+					 ul, ur, ll, lr, hline, vline, ystop, xstop, ctlword)));
+}
+
+#if 0
+/*
+(let ((br 0)
+      (c1 (cell_make))
+      (c2 (cell_make))
+      (c3 (cell_make))
+      (c4 (cell_make))
+      (c5 (cell_make))
+      (c6 (cell_make)))
+  (cells_load_box (ncp-let 'ncp) br 0 c1 c2 c3 c4 c5 c6 "/\\\\/-|")
+  (ncplane_cursor_move_yx (ncp-let 'ncp) 0 0)
+  (ncplane_box (ncp-let 'ncp) c1 c2 c3 c4 c5 c6 10 30 0))
+
+(let ((br 0)
+      (c1 (cell_make))
+      (c2 (cell_make))
+      (c3 (cell_make))
+      (c4 (cell_make))
+      (c5 (cell_make))
+      (c6 (cell_make)))
+  (cells_rounded_box ncp br 0 c1 c2 c3 c4 c5 c6)
+  (ncplane_cursor_move_yx ncp 0 0)
+  (ncplane_box ncp c1 c2 c3 c4 c5 c6 20 20 0))
+  PERHAPS: add ncplane_rounded_box et al
+*/
+#endif
+
+static s7_pointer ncp_move_hook;
+
+static s7_pointer g_ncplane_move_yx(s7_scheme *sc, s7_pointer args)
+{
+  if (s7_is_pair(s7_hook_functions(sc, ncp_move_hook)))
+    s7_apply_function(sc, ncp_move_hook, args);
+
+  return(s7_make_integer(sc, ncplane_move_yx((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+					     (int)s7_integer_checked(sc, s7_cadr(args)), (int)s7_integer_checked(sc, s7_caddr(args)))));
+}
+
+static s7_pointer g_ncplane_cursor_move_yx(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_cursor_move_yx((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+						    (int)s7_integer_checked(sc, s7_cadr(args)), (int)s7_integer_checked(sc, s7_caddr(args)))));
+
+}
+
+static s7_pointer g_ncplane_set_fg_rgb8(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_set_fg_rgb8((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+						 (int)s7_integer_checked(sc, s7_cadr(args)), 
+						 (int)s7_integer_checked(sc, s7_caddr(args)), 
+						 (int)s7_integer_checked(sc, s7_cadddr(args)))));
+
+}
+
+static s7_pointer g_ncplane_set_bg_rgb8(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_set_bg_rgb8((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+						 (int)s7_integer_checked(sc, s7_cadr(args)), 
+						 (int)s7_integer_checked(sc, s7_caddr(args)), 
+						 (int)s7_integer_checked(sc, s7_cadddr(args)))));
+
+}
+
+static s7_pointer g_ncplane_set_fg_rgb8_clipped(s7_scheme *sc, s7_pointer args)
+{
+  ncplane_set_fg_rgb8_clipped((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+			     (int)s7_integer_checked(sc, s7_cadr(args)), (int)s7_integer_checked(sc, s7_caddr(args)), (int)s7_integer_checked(sc, s7_cadddr(args)));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncplane_set_bg_rgb8_clipped(s7_scheme *sc, s7_pointer args)
+{
+  ncplane_set_bg_rgb8_clipped((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+			     (int)s7_integer_checked(sc, s7_cadr(args)), (int)s7_integer_checked(sc, s7_caddr(args)), (int)s7_integer_checked(sc, s7_cadddr(args)));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncplane_format(s7_scheme *sc, s7_pointer args)
+{
+  int y, x;
+  unsigned ylen, xlen;
+  uint16_t stylemask;
+  s7_pointer arg;
+  arg = s7_cdr(args);
+  y = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  x = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  ylen = (unsigned)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  xlen = (unsigned)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  stylemask = (uint16_t)s7_integer_checked(sc, s7_car(arg));
+  return(s7_make_integer(sc, ncplane_format((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+					    y, x, ylen, xlen, stylemask)));
+}
+
+static s7_pointer g_ncplane_dup(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncplane_dup((const struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+						     (void *)s7_c_pointer_with_type(sc, s7_cadr(args), void_symbol, __func__, 2)), 
+				     ncplane_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncplane_set_userptr(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncplane_set_userptr((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+							     (void *)s7_c_pointer_with_type(sc, s7_cadr(args), void_symbol, __func__, 2)),
+				     void_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncplane_set_scrolling(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_boolean(sc, ncplane_set_scrolling((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+						   s7_boolean(sc, s7_cadr(args)))));
+}
+
+static s7_pointer g_ncplane_move_above(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_move_above((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+						(struct ncplane *)s7_c_pointer_with_type(sc, s7_cadr(args), ncplane_symbol, __func__, 2))));
+}
+
+static s7_pointer g_ncplane_move_below(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_move_below((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+						(struct ncplane *)s7_c_pointer_with_type(sc, s7_cadr(args), ncplane_symbol, __func__, 2))));
+}
+
+static s7_pointer g_ncplane_reparent(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncplane_reparent((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+							  (struct ncplane *)s7_c_pointer_with_type(sc, s7_cadr(args), ncplane_symbol, __func__, 2)),
+				     ncplane_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncplane_mergedown_simple(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_mergedown_simple((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+						      (struct ncplane *)s7_c_pointer_with_type(sc, s7_cadr(args), ncplane_symbol, __func__, 2))));
+}
+
+static s7_pointer g_ncplane_mergedown(s7_scheme *sc, s7_pointer args)
+{
+  int begsrcy, begsrcx, leny, lenx, dsty, dstx;
+  s7_pointer arg;
+  arg = s7_cdr(args);
+  begsrcy = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  begsrcx = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  leny = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  lenx = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  dsty = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  dstx = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  return(s7_make_integer(sc, ncplane_mergedown((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+					       (struct ncplane *)s7_c_pointer_with_type(sc, s7_cadr(args), ncplane_symbol, __func__, 2),
+					       begsrcy, begsrcx, leny, lenx, dsty, dstx)));
+}
+
+static s7_pointer g_ncplane_translate_abs(s7_scheme *sc, s7_pointer args)
+{
+  int x = 0, y = 0;
+  bool res;
+  res = ncplane_translate_abs((const struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), &y, &x);
+  return(s7_list(sc, 3, s7_make_boolean(sc, res), s7_make_integer(sc, y), s7_make_integer(sc, x)));
+}
+
+static s7_pointer g_ncplane_yx(s7_scheme *sc, s7_pointer args)
+{
+  int x = 0, y = 0;
+  ncplane_yx((const struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), &y, &x);
+  return(s7_list(sc, 2, s7_make_integer(sc, y), s7_make_integer(sc, x)));
+}
+
+static s7_pointer g_ncplane_cursor_yx(s7_scheme *sc, s7_pointer args)
+{
+#if (NC_CURRENT_VERSION >= NC_VERSION(3, 0, 4))
+  unsigned int x = 0, y = 0;
+#else
+  int x = 0, y = 0;
+#endif
+  ncplane_cursor_yx((const struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), &y, &x);
+  return(s7_list(sc, 2, s7_make_integer(sc, y), s7_make_integer(sc, x)));
+}
+
+static s7_pointer g_ncplane_center_abs(s7_scheme *sc, s7_pointer args)
+{
+  int x = 0, y = 0;
+  ncplane_center_abs((const struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), &y, &x);
+  return(s7_list(sc, 2, s7_make_integer(sc, y), s7_make_integer(sc, x)));
+}
+
+static s7_pointer g_ncplane_at_cursor(s7_scheme *sc, s7_pointer args)
+{
+  uint16_t stylemask = 0;
+  uint64_t channels = 0;
+  ncplane_at_cursor((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), &stylemask, &channels);
+  return(s7_list(sc, 2, s7_make_integer(sc, stylemask), s7_make_integer(sc, channels)));
+}
+
+static s7_pointer g_ncplane_putegc_stained(s7_scheme *sc, s7_pointer args)
+{
+  int res;
+  size_t sbytes = 0;
+  res = ncplane_putegc_stained((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+				 (const char *)s7_string_checked(sc, s7_cadr(args)), &sbytes);
+  return(s7_list(sc, 2, s7_make_integer(sc, res), s7_make_integer(sc, sbytes)));
+}
+
+static s7_pointer g_ncplane_putwegc_stained(s7_scheme *sc, s7_pointer args)
+{
+  int res;
+  size_t sbytes = 0;
+  res = ncplane_putwegc_stained((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+				  (const wchar_t *)s7_string_checked(sc, s7_cadr(args)), &sbytes);
+  return(s7_list(sc, 2, s7_make_integer(sc, res), s7_make_integer(sc, sbytes)));
+}
+
+/* fadecb is a function:
+ * typedef int (*fadecb)(struct notcurses* nc, struct ncplane* ncp, const struct timespec*, void* curry);
+ * int ncplane_fadeout(struct ncplane* n, const struct timespec* ts, fadecb fader, void* curry);
+ * int ncplane_fadein(struct ncplane* n, const struct timespec* ts, fadecb fader, void* curry);
+ * int ncplane_fadeout_iteration(struct ncplane* n, struct ncfadectx* nctx, int iter, fadecb fader, void* curry);
+ * int ncplane_fadein_iteration(struct ncplane* n, struct ncfadectx* nctx, int iter, fadecb fader, void* curry);
+ * int ncplane_pulse(struct ncplane* n, const struct timespec* ts, fadecb fader, void* curry);
+ */
+
+static s7_pointer g_ncplane_putegc_yx(s7_scheme *sc, s7_pointer args)
+{
+  int res;
+  size_t sbytes = 0;
+  res = ncplane_putegc_yx((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+			  (int)s7_integer_checked(sc, s7_cadr(args)), (int)s7_integer_checked(sc, s7_caddr(args)),
+			  (const char *)s7_string_checked(sc, s7_cadddr(args)), &sbytes);
+  return(s7_list(sc, 2, s7_make_integer(sc, res), s7_make_integer(sc, sbytes)));
+}
+
+static s7_pointer g_ncplane_putstr_yx(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_putstr_yx((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+					       (int)s7_integer_checked(sc, s7_cadr(args)), (int)s7_integer_checked(sc, s7_caddr(args)),
+					       (const char *)s7_string_checked(sc, s7_cadddr(args)))));
+}
+
+static s7_pointer g_ncplane_putnstr_aligned(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_putnstr_aligned((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+						     (int)s7_integer_checked(sc, s7_cadr(args)), 
+						     (ncalign_e)s7_integer_checked(sc, s7_caddr(args)),
+						     (size_t)s7_integer_checked(sc, s7_cadddr(args)), 
+						     (const char *)s7_string_checked(sc, s7_cadr(s7_cdddr(args))))));
+}
+
+static s7_pointer g_ncpile_render(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncpile_render((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncpile_rasterize(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncpile_rasterize((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncpile_create(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncpile_create((struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1),
+						       (const ncplane_options *)s7_c_pointer(s7_cadr(args))),
+				     ncplane_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncplane_reparent_family(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncplane_reparent_family((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1),
+						       (struct ncplane *)s7_c_pointer_with_type(sc, s7_cadr(args), ncplane_symbol, __func__, 1)),
+				     ncplane_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncplane_putnstr_yx(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_putnstr_yx((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+						(int)s7_integer_checked(sc, s7_cadr(args)), 
+						(int)s7_integer_checked(sc, s7_caddr(args)),
+						(size_t)s7_integer_checked(sc, s7_cadddr(args)), 
+						(const char *)s7_string_checked(sc, s7_cadr(s7_cdddr(args))))));
+}
+
+static s7_pointer g_ncplane_putchar_stained(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_putchar_stained((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+						       s7_character(s7_cadr(args)))));
+}
+
+static s7_pointer g_ncplane_new(s7_scheme *sc, s7_pointer args)
+{
+  int rows, cols, xoff, yoff;
+  void *opaque;
+  s7_pointer arg;
+  struct notcurses *nc;
+  arg = s7_cdr(args);
+  rows = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  cols = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  yoff = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  xoff = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  opaque = (void *)s7_c_pointer_with_type(sc, s7_car(arg), void_symbol, __func__, 1);
+  /* built-in "backwards compatible" ncplane_new is not backwards compatible! */
+  nc = (struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1);
+  {
+   ncplane_options nopts = {
+     .y = yoff,
+     .x = xoff,
+     .rows = rows,
+     .cols = cols,
+     .userptr = opaque,
+     .name = NULL,
+     .resizecb = NULL,
+     .flags = 0,
+   };
+   return(s7_make_c_pointer_with_type(sc, (void *)ncplane_create(notcurses_stdplane(nc), &nopts),
+				      ncplane_symbol, s7_f(sc)));
+  }
+}
+
+static s7_pointer g_ncplane_resize_realign(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_resize_realign((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1))));
+}
+
+/* int ncplane_vprintf_aligned(struct ncplane* n, int y, ncalign_e align, const char* format, va_list ap); */
+
+
+static s7_pointer g_ncplane_y(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_y((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncplane_x(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_x((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncplane_above(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncplane_above((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1)),
+				     ncplane_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncplane_parent(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncplane_parent((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1)), 
+				     ncplane_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncplane_translate(s7_scheme *sc, s7_pointer args)
+{
+  int y = 0, x = 0;
+  ncplane_translate((const struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+		    (const struct ncplane *)s7_c_pointer_with_type(sc, s7_cadr(args), ncplane_symbol, __func__, 2), &y, &x);
+  return(s7_list(sc, 2, s7_make_integer(sc, y), s7_make_integer(sc, x)));
+}
+
+static s7_pointer ncp_resize_hook;
+
+static s7_pointer g_ncplane_resize(s7_scheme *sc, s7_pointer args)
+{
+  int keepy, keepx, keepleny, keeplenx, yoff, xoff, ylen, xlen;
+  s7_pointer arg;
+
+  arg = s7_cdr(args);
+  keepy = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  keepx = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  keepleny = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  keeplenx = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  yoff = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  xoff = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+
+  if (s7_is_pair(s7_hook_functions(sc, ncp_resize_hook)))
+    s7_apply_function(sc, ncp_resize_hook, arg);
+
+  ylen = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  xlen = (int)s7_integer_checked(sc, s7_car(arg));
+  return(s7_make_integer(sc, ncplane_resize((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1),
+					    keepy, keepx, keepleny, keeplenx,
+					    yoff, xoff, ylen, xlen)));
+}
+
+static s7_pointer g_ncplane_set_base(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_set_base((struct ncplane *)s7_car(args),
+					      (const char *)s7_string_checked(sc, s7_cadr(args)),
+					      (uint32_t)s7_integer_checked(sc, s7_caddr(args)), (uint64_t)s7_integer_checked(sc, s7_cadddr(args)))));
+}
+
+static s7_pointer g_ncplane_at_yx(s7_scheme *sc, s7_pointer args)
+{
+  char *res;
+  uint16_t stylemask = 0;
+  uint64_t channels = 0;
+  res = ncplane_at_yx((const struct ncplane *)s7_car(args),
+		      (int)s7_integer_checked(sc, s7_cadr(args)), (int)s7_integer_checked(sc, s7_caddr(args)),
+		      &stylemask, &channels);
+  return(s7_list(sc, 3, s7_make_string(sc, res), s7_make_integer(sc, stylemask), s7_make_integer(sc, channels)));
+}
+
+static s7_pointer g_ncplane_contents(s7_scheme *sc, s7_pointer args)
+{
+  int begy, begx, leny, lenx;
+  s7_pointer arg;
+  arg = s7_cdr(args);
+  begy = s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  begx = s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  leny = s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  lenx = s7_integer_checked(sc, s7_car(arg)); 
+  return(s7_make_string(sc, ncplane_contents((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+					     begy, begx, leny, lenx)));
+}
+
+/* int ncplane_vprintf_yx(struct ncplane* n, int y, int x, const char* format, va_list ap); */
+
+static s7_pointer g_ncplane_putstr_aligned(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_putstr_aligned((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1),
+						    (int)s7_integer_checked(sc, s7_cadr(args)), (ncalign_e)s7_integer_checked(sc, s7_caddr(args)),
+						    (const char *)s7_string_checked(sc, s7_cadddr(args)))));
+}
+
+static s7_pointer g_ncplane_putstr_stained(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncplane_putstr_stained((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1),
+						      (const char *)s7_string_checked(sc, s7_cadr(args)))));
+}
+
+/* int ncplane_vprintf_stained(struct ncplane* n, const char* format, va_list ap); */
+
+static s7_pointer g_ncplane_puttext(s7_scheme *sc, s7_pointer args)
+{
+  size_t bytes = 0;
+  int res;
+  res = ncplane_puttext((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+			(int)s7_integer_checked(sc, s7_cadr(args)), (ncalign_e)s7_integer_checked(sc, s7_caddr(args)),
+			(const char *)s7_string_checked(sc, s7_cadddr(args)), &bytes);
+  return(s7_list(sc, 2, s7_make_integer(sc, res), s7_make_integer(sc, bytes)));
+}
+
+static s7_pointer g_ncplane_stain(s7_scheme *sc, s7_pointer args)
+{
+  int y, x;
+  unsigned ylen, xlen;
+  uint64_t ul, ur, ll, lr;
+  s7_pointer arg;
+  arg = s7_cdr(args);
+  y = s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  x = s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  ylen = (unsigned)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  xlen = (unsigned)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  ul = s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  ur = s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  ll = s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  lr = s7_integer_checked(sc, s7_car(arg));
+  return(s7_make_integer(sc, ncplane_stain((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+					   y, x, ylen, xlen, ul, ur, ll, lr)));
+}
+
+static s7_pointer g_ncplane_gradient2x1(s7_scheme *sc, s7_pointer args)
+{
+  int y, x;
+  unsigned ylen, xlen;
+  uint32_t ul, ur, ll, lr;
+  s7_pointer arg;
+  arg = s7_cdr(args);
+  y = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  x = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  ylen = (unsigned)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  xlen = (unsigned)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  ul = (uint32_t)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  ur = (uint32_t)s7_integer_checked(sc, s7_car(arg));
+  ll = (uint32_t)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  lr = (uint32_t)s7_integer_checked(sc, s7_car(arg));
+  return(s7_make_integer(sc, ncplane_gradient2x1((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+						  y, x, ylen, xlen, ul, ur, ll, lr)));
+}
+
+static s7_pointer g_ncplane_gradient(s7_scheme *sc, s7_pointer args)
+{
+  int y, x;
+  unsigned ylen, xlen;
+  uint32_t ul, ur, ll, lr;
+  const char *egc;
+  uint16_t styles;
+  s7_pointer arg;
+  arg = s7_cdr(args);
+  y = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  x = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  ylen = (unsigned)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  xlen = (unsigned)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  egc = (const char *)s7_string_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  styles = (uint16_t)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  ul = (uint32_t)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  ur = (uint32_t)s7_integer_checked(sc, s7_car(arg));
+  ll = (uint32_t)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  lr = (uint32_t)s7_integer_checked(sc, s7_car(arg));
+  return(s7_make_integer(sc, ncplane_gradient((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+						  y, x, ylen, xlen, egc, styles, ul, ur, ll, lr)));
+}
+
+static s7_pointer g_ncplane_greyscale(s7_scheme *sc, s7_pointer args)
+{
+  ncplane_greyscale((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1));
+  return(s7_f(sc));
+}
+
+
+
+/* -------- cell -------- */
+#if 0
+typedef struct cell {
+  uint32_t gcluster;
+  uint16_t stylemask;
+  uint64_t channels;
+} cell;
+#endif 
+
+static s7_pointer g_nccell_gcluster(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((nccell *)s7_c_pointer_with_type(sc, s7_car(args), nccell_symbol, __func__, 1))->gcluster));
+}
+
+static s7_pointer g_nccell_stylemask(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((nccell *)s7_c_pointer_with_type(sc, s7_car(args), nccell_symbol, __func__, 1))->stylemask));
+}
+
+static s7_pointer g_nccell_channels(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((nccell *)s7_c_pointer_with_type(sc, s7_car(args), nccell_symbol, __func__, 1))->channels));
+}
+
+
+static s7_pointer g_set_nccell_gcluster(s7_scheme *sc, s7_pointer args) 
+{
+  ((nccell *)s7_c_pointer_with_type(sc, s7_car(args), nccell_symbol, __func__, 1))->gcluster = (uint32_t)s7_integer_checked(sc, s7_cadr(args)); return(s7_cadr(args));
+}
+
+static s7_pointer g_set_nccell_stylemask(s7_scheme *sc, s7_pointer args) 
+{
+  ((nccell *)s7_c_pointer_with_type(sc, s7_car(args), nccell_symbol, __func__, 1))->stylemask = (uint16_t)s7_integer_checked(sc, s7_cadr(args)); return(s7_cadr(args));
+}
+
+static s7_pointer g_set_nccell_channels(s7_scheme *sc, s7_pointer args) 
+{
+  ((nccell *)s7_c_pointer_with_type(sc, s7_car(args), nccell_symbol, __func__, 1))->channels = (uint64_t)s7_integer_checked(sc, s7_cadr(args)); return(s7_cadr(args));
+}
+
+
+static s7_pointer g_nccells_double_box(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer arg;
+  nccell *ul, *ur, *ll, *lr, *hl, *vl;
+  uint32_t attr;
+  uint64_t channels;
+
+  arg = s7_cdr(args);
+  attr = (uint32_t)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  channels = (uint64_t)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  ul = (nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); arg = s7_cdr(arg);
+  ur = (nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); arg = s7_cdr(arg);
+  ll = (nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); arg = s7_cdr(arg);
+  lr = (nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); arg = s7_cdr(arg);
+  hl = (nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); arg = s7_cdr(arg);
+  vl = (nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); 
+  return(s7_make_integer(sc, nccells_double_box((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+					      attr, channels, ul, ur, ll, lr, hl, vl)));
+}
+
+static s7_pointer g_nccells_rounded_box(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer arg;
+  nccell *ul, *ur, *ll, *lr, *hl, *vl;
+  uint32_t attr;
+  uint64_t channels;
+
+  arg = s7_cdr(args);
+  attr = (uint32_t)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  channels = (uint64_t)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  ul = (nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); arg = s7_cdr(arg);
+  ur = (nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); arg = s7_cdr(arg);
+  ll = (nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); arg = s7_cdr(arg);
+  lr = (nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); arg = s7_cdr(arg);
+  hl = (nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); arg = s7_cdr(arg);
+  vl = (nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); 
+  return(s7_make_integer(sc, nccells_rounded_box((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+					       attr, channels, ul, ur, ll, lr, hl, vl)));
+}
+
+static s7_pointer g_nccells_load_box(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer arg;
+  nccell *ul, *ur, *ll, *lr, *hl, *vl;
+  uint32_t attr;
+  uint64_t channels;
+  const char *gclusters;
+
+  arg = s7_cdr(args);
+  attr = (uint32_t)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  channels = (uint64_t)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  ul = (nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); arg = s7_cdr(arg);
+  ur = (nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); arg = s7_cdr(arg);
+  ll = (nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); arg = s7_cdr(arg);
+  lr = (nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); arg = s7_cdr(arg);
+  hl = (nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); arg = s7_cdr(arg);
+  vl = (nccell *)s7_c_pointer_with_type(sc, s7_car(arg), nccell_symbol, __func__, 1); arg = s7_cdr(arg);
+  gclusters = s7_string_checked(sc, s7_car(arg));
+  return(s7_make_integer(sc, nccells_load_box((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+					    attr, channels, ul, ur, ll, lr, hl, vl, gclusters)));
+}
+
+
+/* -------- ncselector_options -------- */
+#if 0
+struct ncselector_item {
+  char* option;
+  char* desc;
+  size_t opcolumns;
+  size_t desccolumns;
+};
+
+typedef struct ncselector_options {
+  char* title;
+  char* secondary;
+  char* footer;
+  struct ncselector_item* items;
+  /* unsigned itemcount; */
+  unsigned defidx;
+  unsigned maxdisplay;
+  uint64_t opchannels;
+  uint64_t descchannels;
+  uint64_t titlechannels;
+  uint64_t footchannels;
+  uint64_t boxchannels;
+  uint64_t flags;
+} ncselector_options;
+#endif
+
+static s7_pointer g_ncselector_item_make(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(struct ncselector_item)), ncselector_item_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncselector_item_free(s7_scheme *sc, s7_pointer args)
+{
+  free((void *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_item_symbol, __func__, 0));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncselector_item_option(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_string(sc, ((struct ncselector_item *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_item_symbol, __func__, 1))->option));
+}
+
+static s7_pointer g_ncselector_item_desc(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_string(sc, ((struct ncselector_item *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_item_symbol, __func__, 1))->desc));
+}
+
+static s7_pointer g_set_ncselector_item_option(s7_scheme *sc, s7_pointer args)
+{
+  struct ncselector_item *no;
+  s7_pointer str;
+  no = (struct ncselector_item *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_item_symbol, __func__, 1);
+  str = s7_cadr(args);
+  if (s7_string_length(str) == 0)
+    no->option = NULL;
+  else
+    {
+      no->option = (char *)malloc(s7_string_length(str));
+      strcpy((char *)(no->option), s7_string_checked(sc, str));
+    }
+  return(str);
+}
+
+static s7_pointer g_set_ncselector_item_desc(s7_scheme *sc, s7_pointer args)
+{
+  struct ncselector_item *no;
+  s7_pointer str;
+  no = (struct ncselector_item *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_item_symbol, __func__, 1);
+  str = s7_cadr(args);
+  if (s7_string_length(str) == 0)
+    no->desc = NULL;
+  else
+    {
+      no->desc = (char *)malloc(s7_string_length(str));
+      strcpy((char *)(no->desc), s7_string_checked(sc, str));
+    }
+  return(str);
+}
+
+
+static s7_pointer g_ncselector_options_make(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(ncselector_options)), ncselector_options_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncselector_options_free(s7_scheme *sc, s7_pointer args)
+{
+  free((void *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_options_symbol, __func__, 0));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncselector_options_title(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_string(sc, ((ncselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_options_symbol, __func__, 1))->title));
+}
+
+static s7_pointer g_ncselector_options_secondary(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_string(sc, ((ncselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_options_symbol, __func__, 1))->secondary));
+}
+
+static s7_pointer g_ncselector_options_footer(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_string(sc, ((ncselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_options_symbol, __func__, 1))->footer));
+}
+
+static s7_pointer g_ncselector_options_items(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)(((ncselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_options_symbol, __func__, 1))->items), 
+				     ncselector_item_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncselector_options_defidx(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_options_symbol, __func__, 1))->defidx));
+}
+
+static s7_pointer g_ncselector_options_maxdisplay(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_options_symbol, __func__, 1))->maxdisplay));
+}
+
+static s7_pointer g_ncselector_options_opchannels(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_options_symbol, __func__, 1))->opchannels));
+}
+
+static s7_pointer g_ncselector_options_descchannels(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_options_symbol, __func__, 1))->descchannels));
+}
+
+static s7_pointer g_ncselector_options_titlechannels(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_options_symbol, __func__, 1))->titlechannels));
+}
+
+static s7_pointer g_ncselector_options_footchannels(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_options_symbol, __func__, 1))->footchannels));
+}
+
+static s7_pointer g_ncselector_options_boxchannels(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_options_symbol, __func__, 1))->boxchannels));
+}
+
+static s7_pointer g_ncselector_options_flags(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_options_symbol, __func__, 1))->flags));
+}
+
+
+static s7_pointer g_set_ncselector_options_title(s7_scheme *sc, s7_pointer args)
+{
+  ncselector_options *no;
+  s7_pointer str;
+  no = (ncselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_options_symbol, __func__, 1);
+  str = s7_cadr(args);
+  if (s7_string_length(str) == 0)
+    no->title = NULL;
+  else
+    {
+      no->title = (char *)calloc(1, s7_string_length(str) + 1);
+      strcpy((char *)(no->title), s7_string_checked(sc, str));
+    }
+  return(str);
+}
+
+static s7_pointer g_set_ncselector_options_secondary(s7_scheme *sc, s7_pointer args)
+{
+  ncselector_options *no;
+  s7_pointer str;
+  no = (ncselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_options_symbol, __func__, 1);
+  str = s7_cadr(args);
+  if (s7_string_length(str) == 0)
+    no->secondary = NULL;
+  else
+    {
+      no->secondary = (char *)calloc(1, s7_string_length(str) + 1);
+      strcpy((char *)(no->secondary), s7_string_checked(sc, str));
+    }
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncselector_options_footer(s7_scheme *sc, s7_pointer args)
+{
+  ncselector_options *no;
+  s7_pointer str;
+  no = (ncselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_options_symbol, __func__, 1);
+  str = s7_cadr(args);
+  if (s7_string_length(str) == 0)
+    no->footer = NULL;
+  else
+    {
+      no->footer = (char *)calloc(1, s7_string_length(str) + 1);
+      strcpy((char *)(no->footer), s7_string_checked(sc, str));
+    }
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncselector_options_items(s7_scheme *sc, s7_pointer args)
+{
+  ncselector_options *no;
+  no = (ncselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_options_symbol, __func__, 1);
+  no->items = (struct ncselector_item *)s7_c_pointer_with_type(sc, s7_cadr(args), ncselector_item_symbol, __func__, 2);
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncselector_options_maxdisplay(s7_scheme *sc, s7_pointer args)
+{
+  ncselector_options *no;
+  no = (ncselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_options_symbol, __func__, 1);
+  no->maxdisplay = (unsigned int)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+
+/* -------- ncselector -------- */
+
+static s7_pointer g_ncselector_create(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)ncselector_create((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1),
+								   (const ncselector_options *)s7_c_pointer_with_type(sc, s7_cadddr(args), 
+														      ncselector_options_symbol, __func__, 4)),
+				     ncselector_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncselector_plane(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)ncselector_plane((struct ncselector *)s7_c_pointer_with_type(sc, s7_car(args), 
+													      ncselector_symbol, __func__, 1)), 
+				     ncplane_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncselector_previtem(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_string(sc, ncselector_previtem((struct ncselector *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncselector_nextitem(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_string(sc, ncselector_nextitem((struct ncselector *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncselector_selected(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_string(sc, ncselector_selected((const struct ncselector *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncselector_additem(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncselector_additem((struct ncselector *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_symbol, __func__, 1),
+						(const struct ncselector_item *)s7_c_pointer_with_type(sc, s7_cadr(args), 
+												       ncselector_item_symbol, __func__, 2))));
+}
+
+static s7_pointer g_ncselector_delitem(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncselector_delitem((struct ncselector *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_symbol, __func__, 1), 
+						(const char *)s7_string_checked(sc, s7_cadr(args)))));
+}
+
+static s7_pointer g_ncselector_offer_input(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_boolean(sc, ncselector_offer_input((struct ncselector *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_symbol, __func__, 1),
+						    (const struct ncinput *)s7_c_pointer_with_type(sc, s7_cadr(args), ncinput_symbol, __func__, 2))));
+}
+
+static s7_pointer g_ncselector_destroy(s7_scheme *sc, s7_pointer args)
+{
+  ncselector_destroy((struct ncselector *)s7_c_pointer_with_type(sc, s7_car(args), ncselector_symbol, __func__, 1), 
+		     (char **)s7_c_pointer_with_type(sc, s7_cadr(args), char_symbol, __func__, 2));
+  return(s7_f(sc));
+}
+
+
+/* -------- ncmultiselector_options -------- */
+#if 0
+typedef struct ncmultiselector_options {
+  char* title;
+  char* secondary;
+  char* footer;
+  struct ncmselector_item* items;
+  /* unsigned itemcount; */
+  unsigned maxdisplay;
+  uint64_t opchannels;
+  uint64_t descchannels;
+  uint64_t titlechannels;
+  uint64_t footchannels;
+  uint64_t boxchannels;
+  uint64_t flags;
+} ncmultiselector_options;
+
+struct ncmselector_item {
+  char* option;
+  char* desc;
+  bool selected;
+};
+#endif
+
+static s7_pointer g_ncmselector_item_make(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(struct ncmselector_item)), ncmselector_item_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncmselector_item_free(s7_scheme *sc, s7_pointer args)
+{
+  free((void *)s7_c_pointer_with_type(sc, s7_car(args), ncmselector_item_symbol, __func__, 0));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncmselector_item_option(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_string(sc, ((struct ncmselector_item *)s7_c_pointer_with_type(sc, s7_car(args), ncmselector_item_symbol, __func__, 1))->option));
+}
+
+static s7_pointer g_ncmselector_item_desc(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_string(sc, ((struct ncmselector_item *)s7_c_pointer_with_type(sc, s7_car(args), ncmselector_item_symbol, __func__, 1))->desc));
+}
+
+static s7_pointer g_set_ncmselector_item_option(s7_scheme *sc, s7_pointer args)
+{
+  struct ncmselector_item *no;
+  s7_pointer str;
+  no = (struct ncmselector_item *)s7_c_pointer_with_type(sc, s7_car(args), ncmselector_item_symbol, __func__, 1);
+  str = s7_cadr(args);
+  if (s7_string_length(str) == 0)
+    no->option = NULL;
+  else
+    {
+      no->option = (char *)malloc(s7_string_length(str));
+      strcpy((char *)(no->option), s7_string_checked(sc, str));
+    }
+  return(str);
+}
+
+static s7_pointer g_set_ncmselector_item_desc(s7_scheme *sc, s7_pointer args)
+{
+  struct ncmselector_item *no;
+  s7_pointer str;
+  no = (struct ncmselector_item *)s7_c_pointer_with_type(sc, s7_car(args), ncmselector_item_symbol, __func__, 1);
+  str = s7_cadr(args);
+  if (s7_string_length(str) == 0)
+    no->desc = NULL;
+  else
+    {
+      no->desc = (char *)malloc(s7_string_length(str));
+      strcpy((char *)(no->desc), s7_string_checked(sc, str));
+    }
+  return(str);
+}
+
+
+static s7_pointer g_ncmultiselector_options_make(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(ncmultiselector_options)), ncmultiselector_options_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncmultiselector_options_free(s7_scheme *sc, s7_pointer args)
+{
+  free((void *)s7_c_pointer_with_type(sc, s7_car(args), ncmultiselector_options_symbol, __func__, 0));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncmultiselector_options_title(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_string(sc, ((ncmultiselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmultiselector_options_symbol, __func__, 1))->title));
+}
+
+static s7_pointer g_ncmultiselector_options_secondary(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_string(sc, ((ncmultiselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmultiselector_options_symbol, __func__, 1))->secondary));
+}
+
+static s7_pointer g_ncmultiselector_options_footer(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_string(sc, ((ncmultiselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmultiselector_options_symbol, __func__, 1))->footer));
+}
+
+static s7_pointer g_ncmultiselector_options_items(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)(((ncmultiselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmultiselector_options_symbol, __func__, 1))->items), s7_make_symbol(sc, "ncmselector_items*"), s7_f(sc)));
+}
+
+static s7_pointer g_ncmultiselector_options_maxdisplay(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncmultiselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmultiselector_options_symbol, __func__, 1))->maxdisplay));
+}
+
+static s7_pointer g_ncmultiselector_options_opchannels(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncmultiselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmultiselector_options_symbol, __func__, 1))->opchannels));
+}
+
+static s7_pointer g_ncmultiselector_options_descchannels(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncmultiselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmultiselector_options_symbol, __func__, 1))->descchannels));
+}
+
+static s7_pointer g_ncmultiselector_options_titlechannels(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncmultiselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmultiselector_options_symbol, __func__, 1))->titlechannels));
+}
+
+static s7_pointer g_ncmultiselector_options_footchannels(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncmultiselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmultiselector_options_symbol, __func__, 1))->footchannels));
+}
+
+static s7_pointer g_ncmultiselector_options_boxchannels(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncmultiselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmultiselector_options_symbol, __func__, 1))->boxchannels));
+}
+
+static s7_pointer g_ncmultiselector_options_flags(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncmultiselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmultiselector_options_symbol, __func__, 1))->flags));
+}
+
+
+static s7_pointer g_set_ncmultiselector_options_title(s7_scheme *sc, s7_pointer args)
+{
+  ncmultiselector_options *no;
+  s7_pointer str;
+  no = (ncmultiselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmultiselector_options_symbol, __func__, 1);
+  str = s7_cadr(args);
+  if (s7_string_length(str) == 0)
+    no->title = NULL;
+  else
+    {
+      no->title = (char *)calloc(1, s7_string_length(str) + 1);
+      strcpy((char *)(no->title), s7_string_checked(sc, str));
+    }
+  return(str);
+}
+
+static s7_pointer g_set_ncmultiselector_options_secondary(s7_scheme *sc, s7_pointer args)
+{
+  ncmultiselector_options *no;
+  s7_pointer str;
+  no = (ncmultiselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmultiselector_options_symbol, __func__, 1);
+  str = s7_cadr(args);
+  if (s7_string_length(str) == 0)
+    no->secondary = NULL;
+  else
+    {
+      no->secondary = (char *)calloc(1, s7_string_length(str) + 1);
+      strcpy((char*)(no->secondary), s7_string_checked(sc, str));
+    }
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncmultiselector_options_footer(s7_scheme *sc, s7_pointer args)
+{
+  ncmultiselector_options *no;
+  s7_pointer str;
+  no = (ncmultiselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmultiselector_options_symbol, __func__, 1);
+  str = s7_cadr(args);
+  if (s7_string_length(str) == 0)
+    no->footer = NULL;
+  else
+    {
+      no->footer = (char *)calloc(1, s7_string_length(str) + 1);
+      strcpy((char *)no->footer, s7_string_checked(sc, str));
+    }
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncmultiselector_options_items(s7_scheme *sc, s7_pointer args)
+{
+  ncmultiselector_options *no;
+  no = (ncmultiselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmultiselector_options_symbol, __func__, 1);
+  no->items = (struct ncmselector_item *)s7_c_pointer_with_type(sc, s7_cadr(args), ncmselector_item_symbol, __func__, 2);
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncmultiselector_options_maxdisplay(s7_scheme *sc, s7_pointer args)
+{
+  ncmultiselector_options *no;
+  no = (ncmultiselector_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmultiselector_options_symbol, __func__, 1);
+  no->maxdisplay = (unsigned int)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+
+/* -------- ncmultiselector -------- */
+
+static s7_pointer g_ncmultiselector_create(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)ncmultiselector_create((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1),
+									(const ncmultiselector_options *)s7_c_pointer_with_type(sc, s7_cadddr(args), ncmultiselector_options_symbol, __func__, 4)),
+				     ncmultiselector_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncmultiselector_plane(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)ncmultiselector_plane((struct ncmultiselector *)s7_c_pointer_with_type(sc, s7_car(args), ncmultiselector_symbol, __func__, 1)),
+				     ncplane_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncmultiselector_selected(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncmultiselector_selected((struct ncmultiselector *)s7_c_pointer_with_type(sc, s7_car(args), ncmultiselector_symbol, __func__, 1),
+						      (bool *)s7_c_pointer_with_type(sc, s7_cadr(args), s7_make_symbol(sc, "bool*"), __func__, 2),
+						      (unsigned)s7_integer_checked(sc, s7_caddr(args)))));
+}
+
+static s7_pointer g_ncmultiselector_offer_input(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_boolean(sc, ncmultiselector_offer_input((struct ncmultiselector *)s7_c_pointer_with_type(sc, s7_car(args), ncmultiselector_symbol, __func__, 1),
+							 (const struct ncinput *)s7_c_pointer_with_type(sc, s7_cadr(args), ncinput_symbol, __func__, 2))));
+}
+
+static s7_pointer g_ncmultiselector_destroy(s7_scheme *sc, s7_pointer args)
+{
+  ncmultiselector_destroy((struct ncmultiselector *)s7_c_pointer_with_type(sc, s7_car(args), ncmultiselector_symbol, __func__, 1));
+  return(s7_f(sc));
+}
+
+
+
+/* -------- ncmenu_item -------- */
+#if 0
+struct ncmenu_item {
+  char* desc;
+  ncinput shortcut;
+};
+
+struct ncmenu_section {
+  char* name;
+  int itemcount;
+  struct ncmenu_item* items; 
+  ncinput shortcut;
+};
+#endif
+
+
+/* section_items is an array? (yes)  also options_sections below, need examples -- see src/demo/hud.c or tests/menu.cpp
+ *   here, I guess we'll take a list of list of items and return an array of arrays or whatever
+ *
+ * so ncmenu_item desc is straightforward, shortcut is the struct itself?!?
+ *    ncmenu_section name, itemcount
+ *        items = list -> array in C + pointer to array
+ * then in options below, sections=list, same handling
+ */
+
+static s7_pointer g_ncmenu_item_make(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(struct ncmenu_item)), ncmenu_item_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncmenu_item_free(s7_scheme *sc, s7_pointer args)
+{
+  free((void *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_item_symbol, __func__, 0));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncmenu_item_desc(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_string(sc, ((struct ncmenu_item *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_item_symbol, __func__, 1))->desc));
+}
+
+static s7_pointer g_ncmenu_item_shortcut(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_c_pointer(sc, &(((struct ncmenu_item *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_item_symbol, __func__, 1))->shortcut)));
+}
+
+static s7_pointer g_set_ncmenu_item_desc(s7_scheme *sc, s7_pointer args) 
+{
+  ((struct ncmenu_item *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_item_symbol, __func__, 1))->desc = (char *)s7_string_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncmenu_item_shortcut(s7_scheme *sc, s7_pointer args) 
+{
+  ((struct ncmenu_item *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_item_symbol, __func__, 1))->shortcut = *((ncinput *)(s7_c_pointer(s7_cadr(args))));
+  return(s7_cadr(args));
+}
+
+
+
+static s7_pointer g_ncmenu_section_make(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(struct ncmenu_section)), ncmenu_section_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncmenu_section_free(s7_scheme *sc, s7_pointer args)
+{
+  free((void *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_section_symbol, __func__, 0));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncmenu_section_itemcount(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((struct ncmenu_section *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_section_symbol, __func__, 1))->itemcount));
+}
+
+static s7_pointer g_ncmenu_section_items(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_c_pointer_with_type(sc, ((struct ncmenu_section *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_section_symbol, __func__, 1))->items,
+				     ncmenu_item_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncmenu_items_to_list(s7_scheme *sc, s7_pointer args)
+{
+  /* car = c_pointer holding ncmenu_item* */
+  int32_t i, len;
+  s7_pointer lst, items;
+  struct ncmenu_item *p;
+  p = ((struct ncmenu_section *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_section_symbol, __func__, 1))->items;
+  lst = s7_make_list(sc, len = ((struct ncmenu_section *)s7_c_pointer(s7_car(args)))->itemcount, s7_f(sc));
+  for (i = 0, items = lst; i < len; i++, p++, items = s7_cdr(items))
+    s7_set_car(items, s7_make_c_pointer(sc, p));
+  return(lst);
+}
+
+static s7_pointer g_list_to_ncmenu_items(s7_scheme *sc, s7_pointer args)
+{
+  /* car = list of items (c_pointers) */
+  int32_t i, len;
+  s7_pointer lst;
+  struct ncmenu_item *p;
+
+  lst = s7_car(args);
+  len = s7_list_length(sc, lst);
+  p = (struct ncmenu_item *)calloc(len, sizeof(struct ncmenu_item));
+  for (i = 0; i < len; i++, lst = s7_cdr(lst), p++)
+    {
+      struct ncmenu_item *ip;
+      ip = (struct ncmenu_item *)s7_c_pointer_with_type(sc, s7_car(lst), ncmenu_item_symbol, __func__, 1);
+      p->desc = ip->desc;
+      p->shortcut = ip->shortcut;
+    }
+  return(s7_make_c_pointer_with_type(sc, p, ncmenu_item_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncmenu_section_name(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_string(sc, ((struct ncmenu_section *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_section_symbol, __func__, 1))->name));
+}
+
+static s7_pointer g_ncmenu_section_shortcut(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_c_pointer(sc, &(((struct ncmenu_section *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_section_symbol, __func__, 1))->shortcut)));
+}
+
+static s7_pointer g_set_ncmenu_section_itemcount(s7_scheme *sc, s7_pointer args) 
+{
+  ((struct ncmenu_section *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_section_symbol, __func__, 1))->itemcount = s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncmenu_section_items(s7_scheme *sc, s7_pointer args) 
+{
+  ((struct ncmenu_section *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_section_symbol, __func__, 1))->items = (struct ncmenu_item *)s7_c_pointer(s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncmenu_section_name(s7_scheme *sc, s7_pointer args) 
+{
+  ((struct ncmenu_section *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_section_symbol, __func__, 1))->name = (char *)s7_string_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncmenu_section_shortcut(s7_scheme *sc, s7_pointer args) 
+{
+  ((struct ncmenu_section *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_section_symbol, __func__, 1))->shortcut = *(ncinput *)(s7_c_pointer(s7_cadr(args)));
+  return(s7_cadr(args));
+}
+
+
+
+/* -------- ncmenu_options -------- */
+#if 0
+typedef struct ncmenu_options {
+  struct ncmenu_section* sections;
+  int sectioncount;
+  uint64_t headerchannels;
+  uint64_t sectionchannels;
+  uint64_t flags;
+} ncmenu_options;
+#endif
+
+static s7_pointer g_ncmenu_options_make(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(ncmenu_options)), ncmenu_options_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncmenu_options_free(s7_scheme *sc, s7_pointer args)
+{
+  free((void *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_options_symbol, __func__, 0));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncmenu_options_sections(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_c_pointer_with_type(sc, ((ncmenu_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_options_symbol, __func__, 1))->sections, 
+				     ncmenu_section_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncmenu_options_sectioncount(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncmenu_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_options_symbol, __func__, 1))->sectioncount));
+}
+
+static s7_pointer g_ncmenu_options_headerchannels(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncmenu_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_options_symbol, __func__, 1))->headerchannels));
+}
+
+static s7_pointer g_ncmenu_options_sectionchannels(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncmenu_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_options_symbol, __func__, 1))->sectionchannels));
+}
+
+static s7_pointer g_ncmenu_options_flags(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncmenu_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_options_symbol, __func__, 1))->flags));
+}
+
+
+static s7_pointer g_set_ncmenu_options_sections(s7_scheme *sc, s7_pointer args) 
+{
+  ((ncmenu_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_options_symbol, __func__, 1))->sections = (struct ncmenu_section *)s7_c_pointer_with_type(sc, s7_cadr(args), ncmenu_section_symbol, __func__, 2);
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_ncmenu_sections_to_list(s7_scheme *sc, s7_pointer args)
+{
+  /* car = c_pointer holding ncmenu_section* */
+  int32_t i, len;
+  s7_pointer lst, items;
+  struct ncmenu_section *p;
+  p = ((ncmenu_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_options_symbol, __func__, 1))->sections;
+  lst = s7_make_list(sc, len = ((struct ncmenu_options *)s7_c_pointer(s7_car(args)))->sectioncount, s7_f(sc));
+  for (i = 0, items = lst; i < len; i++, p++, items = s7_cdr(items))
+    s7_set_car(items, s7_make_c_pointer(sc, p));
+  return(lst);
+}
+
+static s7_pointer g_list_to_ncmenu_sections(s7_scheme *sc, s7_pointer args)
+{
+  /* car = list of sections (c_pointers) */
+  int32_t i, len;
+  s7_pointer lst;
+  struct ncmenu_section *p;
+
+  lst = s7_car(args);
+  len = s7_list_length(sc, lst);
+  p = (struct ncmenu_section *)calloc(len, sizeof(struct ncmenu_section));
+  for (i = 0; i < len; i++, lst = s7_cdr(lst), p++)
+    {
+      struct ncmenu_section *ip;
+      ip = (struct ncmenu_section *)s7_c_pointer_with_type(sc, s7_car(lst), ncmenu_section_symbol, __func__, 1);
+      p->name = ip->name;
+      p->itemcount = ip->itemcount;
+      p->items = ip->items;
+      p->shortcut = ip->shortcut;
+    }
+  return(s7_make_c_pointer_with_type(sc, p, ncmenu_section_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_set_ncmenu_options_sectioncount(s7_scheme *sc, s7_pointer args) 
+{
+  ((ncmenu_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_options_symbol, __func__, 1))->sectioncount = (int)s7_integer_checked(sc, s7_cadr(args)); 
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncmenu_options_headerchannels(s7_scheme *sc, s7_pointer args) 
+{
+  ((ncmenu_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_options_symbol, __func__, 1))->headerchannels = (uint64_t)s7_integer_checked(sc, s7_cadr(args)); 
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncmenu_options_sectionchannels(s7_scheme *sc, s7_pointer args) 
+{
+  ((ncmenu_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_options_symbol, __func__, 1))->sectionchannels = (uint64_t)s7_integer_checked(sc, s7_cadr(args)); 
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncmenu_options_flags(s7_scheme *sc, s7_pointer args) 
+{
+  ((ncmenu_options *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_options_symbol, __func__, 1))->flags = (uint64_t)s7_integer_checked(sc, s7_cadr(args)); 
+  return(s7_cadr(args));
+}
+
+
+/* -------- ncmenu -------- */
+
+static s7_pointer g_ncmenu_create(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncmenu_create((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+						       (const ncmenu_options *)s7_c_pointer_with_type(sc, s7_cadr(args), ncmenu_options_symbol, __func__, 2)),
+				     ncmenu_symbol, s7_f(sc)));
+}
+
+/* this doesn't work, but it doesn't crash either -- returns NULL */
+#if 0
+/*
+(define (make-menu nc ncp)
+  (let ((menu-options (ncmenu_options_make)))
+    (set! (ncmenu_options_sectioncount menu-options) 2)
+    (set! (ncmenu_options_sections menu-options)
+	  (let ((menu-section1 (ncmenu_section_make))
+		(menu-section2 (ncmenu_section_make))
+		(menu-item1 (ncmenu_item_make))
+		(menu-item2 (ncmenu_item_make)))
+	    (set! (ncmenu_item_desc menu-item1) "item1")
+	    (set! (ncmenu_item_desc menu-item2) "item2")
+	    (set! (ncmenu_item_shortcut menu-item1) (ncinput_make))
+	    (set! (ncmenu_item_shortcut menu-item2) (ncinput_make))
+	    (set! (ncmenu_section_name menu-section1) "section1")
+	    (set! (ncmenu_section_name menu-section2) "section2")
+	    (set! (ncmenu_section_shortcut menu-section1) (ncinput_make))
+	    (set! (ncmenu_section_shortcut menu-section2) (ncinput_make))
+	    (set! (ncmenu_section_itemcount menu-section1) 1)
+	    (set! (ncmenu_section_itemcount menu-section2) 1)
+	    (set! (ncmenu_section_items menu-section1) (list_to_ncmenu_items (list menu-item1)))
+	    (set! (ncmenu_section_items menu-section2) (list_to_ncmenu_items (list menu-item2)))
+	    (list_to_ncmenu_sections (list menu-section1 menu-section2))))
+    (let ((res (ncmenu_create ncp menu-options)))
+      (notcurses_render nc)
+      res)))
+*/
+#endif
+
+static s7_pointer g_ncmenu_unroll(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncmenu_unroll((struct ncmenu *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_symbol, __func__, 1), 
+					   (int)s7_integer_checked(sc, s7_cadr(args)))));
+}
+
+static s7_pointer g_ncmenu_rollup(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncmenu_rollup((struct ncmenu *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncmenu_nextsection(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncmenu_nextsection((struct ncmenu *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncmenu_prevsection(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncmenu_prevsection((struct ncmenu *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncmenu_nextitem(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncmenu_nextitem((struct ncmenu *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncmenu_previtem(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncmenu_previtem((struct ncmenu *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncmenu_plane(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncmenu_plane((struct ncmenu *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_symbol, __func__, 1)), 
+				     ncplane_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncmenu_destroy(s7_scheme *sc, s7_pointer args)
+{
+  ncmenu_destroy((struct ncmenu *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_symbol, __func__, 1));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncmenu_selected(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_string(sc, ncmenu_selected((const struct ncmenu *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_symbol, __func__, 1), 
+					    (struct ncinput *)s7_c_pointer_with_type(sc, s7_cadr(args), ncinput_symbol, __func__, 2))));
+}
+ 
+static s7_pointer g_ncmenu_offer_input(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_boolean(sc, ncmenu_offer_input((struct ncmenu *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_symbol, __func__, 1), 
+						(const struct ncinput *)s7_c_pointer_with_type(sc, s7_cadr(args), ncinput_symbol, __func__, 2))));
+}
+
+static s7_pointer g_ncmenu_mouse_selected(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_boolean(sc, ncmenu_mouse_selected((const struct ncmenu *)s7_c_pointer_with_type(sc, s7_car(args), ncmenu_symbol, __func__, 1), 
+						   (const struct ncinput *)s7_c_pointer_with_type(sc, s7_cadr(args), ncinput_symbol, __func__, 2),
+						   (struct ncinput *)s7_c_pointer_with_type(sc, s7_caddr(args), ncinput_symbol, __func__, 3))));
+}
+
+
+/* -------- ncplot_options -------- */
+#if 0
+typedef struct ncplot_options {
+  uint64_t maxchannels;
+  uint64_t minchannels;
+  uint16_t legendstyle;
+  ncblitter_e gridtype;
+  int rangex;
+  uint64_t flags;
+} ncplot_options;
+#endif
+
+static s7_pointer g_ncplot_options_make(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(ncplot_options)), ncplot_options_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncplot_options_free(s7_scheme *sc, s7_pointer args)
+{
+  free((void *)s7_c_pointer_with_type(sc, s7_car(args), ncplot_options_symbol, __func__, 0));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncplot_options_maxchannels(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncplot_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplot_options_symbol, __func__, 1))->maxchannels));
+}
+
+static s7_pointer g_ncplot_options_minchannels(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncplot_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplot_options_symbol, __func__, 1))->minchannels));
+}
+
+static s7_pointer g_ncplot_options_legendstyle(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncplot_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplot_options_symbol, __func__, 1))->legendstyle));
+}
+
+static s7_pointer g_ncplot_options_gridtype(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncplot_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplot_options_symbol, __func__, 1))->gridtype));
+}
+
+static s7_pointer g_ncplot_options_rangex(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncplot_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplot_options_symbol, __func__, 1))->rangex));
+}
+
+static s7_pointer g_ncplot_options_flags(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((ncplot_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplot_options_symbol, __func__, 1))->flags));
+}
+
+static s7_pointer g_set_ncplot_options_maxchannels(s7_scheme *sc, s7_pointer args) 
+{
+  ((ncplot_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplot_options_symbol, __func__, 1))->maxchannels = (uint64_t)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncplot_options_minchannels(s7_scheme *sc, s7_pointer args) 
+{
+  ((ncplot_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplot_options_symbol, __func__, 1))->minchannels = (uint64_t)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncplot_options_legendstyle(s7_scheme *sc, s7_pointer args) 
+{
+  ((ncplot_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplot_options_symbol, __func__, 1))->legendstyle = (uint16_t)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncplot_options_gridtype(s7_scheme *sc, s7_pointer args) 
+{
+  ((ncplot_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplot_options_symbol, __func__, 1))->gridtype = (ncblitter_e)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncplot_options_rangex(s7_scheme *sc, s7_pointer args) 
+{
+  ((ncplot_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplot_options_symbol, __func__, 1))->rangex = (int)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncplot_options_flags(s7_scheme *sc, s7_pointer args) 
+{
+  ((ncplot_options *)s7_c_pointer_with_type(sc, s7_car(args), ncplot_options_symbol, __func__, 1))->flags = (uint64_t)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+
+/* -------- ncplot -------- */
+
+static s7_pointer g_ncuplot_create(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncuplot_create((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1),
+							(const ncplot_options *)s7_c_pointer_with_type(sc, s7_cadr(args), ncplot_options_symbol, __func__, 2),
+							(uint64_t)s7_integer_checked(sc, s7_caddr(args)),
+							(uint64_t)s7_integer_checked(sc, s7_cadddr(args))),
+				     ncuplot_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncdplot_create(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncdplot_create((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1),
+							(const ncplot_options *)s7_c_pointer_with_type(sc, s7_cadr(args), ncplot_options_symbol, __func__, 2),
+							(double)s7_real_checked(sc, s7_caddr(args)),
+							(double)s7_real_checked(sc, s7_cadddr(args))),
+				     ncdplot_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncuplot_plane(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncuplot_plane((struct ncuplot *)s7_c_pointer_with_type(sc, s7_car(args), ncuplot_symbol, __func__, 1)), 
+				     ncplane_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncdplot_plane(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncdplot_plane((struct ncdplot *)s7_c_pointer_with_type(sc, s7_car(args), ncdplot_symbol, __func__, 1)), 
+				     ncplane_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncuplot_destroy(s7_scheme *sc, s7_pointer args)
+{
+  ncuplot_destroy((struct ncuplot *)s7_c_pointer_with_type(sc, s7_car(args), ncuplot_symbol, __func__, 1));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncdplot_destroy(s7_scheme *sc, s7_pointer args)
+{
+  ncdplot_destroy((struct ncdplot *)s7_c_pointer_with_type(sc, s7_car(args), ncdplot_symbol, __func__, 1));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncuplot_add_sample(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncuplot_add_sample((struct ncuplot *)s7_c_pointer_with_type(sc, s7_car(args), ncuplot_symbol, __func__, 1), 
+						(uint64_t)s7_integer_checked(sc, s7_cadr(args)), 
+						(uint64_t)s7_integer_checked(sc, s7_caddr(args)))));
+}
+
+static s7_pointer g_ncdplot_add_sample(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncdplot_add_sample((struct ncdplot *)s7_c_pointer_with_type(sc, s7_car(args), ncdplot_symbol, __func__, 1), 
+						(uint64_t)s7_integer_checked(sc, s7_cadr(args)), 
+						(double)s7_real_checked(sc, s7_caddr(args)))));
+}
+
+static s7_pointer g_ncuplot_set_sample(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncuplot_set_sample((struct ncuplot *)s7_c_pointer_with_type(sc, s7_car(args), ncuplot_symbol, __func__, 1), 
+						(uint64_t)s7_integer_checked(sc, s7_cadr(args)), 
+						(uint64_t)s7_integer_checked(sc, s7_caddr(args)))));
+}
+
+static s7_pointer g_ncdplot_set_sample(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncdplot_set_sample((struct ncdplot *)s7_c_pointer_with_type(sc, s7_car(args), ncdplot_symbol, __func__, 1), 
+						(uint64_t)s7_integer_checked(sc, s7_cadr(args)), 
+						(double)s7_real_checked(sc, s7_caddr(args)))));
+}
+
+static s7_pointer g_ncuplot_sample(s7_scheme *sc, s7_pointer args)
+{
+  int res;
+  uint64_t y;
+  res = ncuplot_sample((struct ncuplot *)s7_c_pointer_with_type(sc, s7_car(args), ncuplot_symbol, __func__, 1), (uint64_t)s7_integer_checked(sc, s7_cadr(args)), &y);
+  return(s7_list(sc, 2, s7_make_integer(sc, res), s7_make_integer(sc, y)));
+}
+
+static s7_pointer g_ncdplot_sample(s7_scheme *sc, s7_pointer args)
+{
+  int res;
+  double y;
+  res = ncdplot_sample((struct ncdplot *)s7_c_pointer_with_type(sc, s7_car(args), ncdplot_symbol, __func__, 1), (uint64_t)s7_integer_checked(sc, s7_cadr(args)), &y);
+  return(s7_list(sc, 2, s7_make_integer(sc, res), s7_make_real(sc, y)));
+}
+
+
+/* -------- ncreel_options -------- */
+#if 0
+typedef struct ncreel_options {
+  unsigned bordermask;
+  uint64_t borderchan;
+  unsigned tabletmask;
+  uint64_t tabletchan;
+  uint64_t focusedchan;
+  uint64_t flags;
+} ncreel_options;
+#endif
+
+static s7_pointer g_ncreel_options_make(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(ncreel_options)), ncreel_options_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncreel_options_free(s7_scheme *sc, s7_pointer args)
+{
+  free((void *)s7_c_pointer_with_type(sc, s7_car(args), ncreel_options_symbol, __func__, 0));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncreel_options_bordermask(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ((struct ncreel_options *)s7_c_pointer_with_type(sc, s7_car(args), ncreel_options_symbol, __func__, 1))->bordermask));
+}
+
+static s7_pointer g_ncreel_options_borderchan(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ((struct ncreel_options *)s7_c_pointer_with_type(sc, s7_car(args), ncreel_options_symbol, __func__, 1))->borderchan));
+}
+
+static s7_pointer g_ncreel_options_tabletmask(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ((struct ncreel_options *)s7_c_pointer_with_type(sc, s7_car(args), ncreel_options_symbol, __func__, 1))->tabletmask));
+}
+
+static s7_pointer g_ncreel_options_tabletchan(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ((struct ncreel_options *)s7_c_pointer_with_type(sc, s7_car(args), ncreel_options_symbol, __func__, 1))->tabletchan));
+}
+
+static s7_pointer g_ncreel_options_focusedchan(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ((struct ncreel_options *)s7_c_pointer_with_type(sc, s7_car(args), ncreel_options_symbol, __func__, 1))->focusedchan));
+}
+
+static s7_pointer g_ncreel_options_flags(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ((struct ncreel_options *)s7_c_pointer_with_type(sc, s7_car(args), ncreel_options_symbol, __func__, 1))->flags));
+}
+
+
+static s7_pointer g_set_ncreel_options_bordermask(s7_scheme *sc, s7_pointer args)
+{
+  ((struct ncreel_options *)s7_c_pointer_with_type(sc, s7_car(args), ncreel_options_symbol, __func__, 1))->bordermask = (unsigned)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncreel_options_borderchan(s7_scheme *sc, s7_pointer args)
+{
+  ((struct ncreel_options *)s7_c_pointer_with_type(sc, s7_car(args), ncreel_options_symbol, __func__, 1))->borderchan = (uint64_t)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncreel_options_tabletmask(s7_scheme *sc, s7_pointer args)
+{
+  ((struct ncreel_options *)s7_c_pointer_with_type(sc, s7_car(args), ncreel_options_symbol, __func__, 1))->tabletmask = (unsigned)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncreel_options_tabletchan(s7_scheme *sc, s7_pointer args)
+{
+  ((struct ncreel_options *)s7_c_pointer_with_type(sc, s7_car(args), ncreel_options_symbol, __func__, 1))->tabletchan = (uint64_t)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncreel_options_focusedchan(s7_scheme *sc, s7_pointer args)
+{
+  ((struct ncreel_options *)s7_c_pointer_with_type(sc, s7_car(args), ncreel_options_symbol, __func__, 1))->focusedchan = (uint64_t)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncreel_options_flags(s7_scheme *sc, s7_pointer args)
+{
+  ((struct ncreel_options *)s7_c_pointer_with_type(sc, s7_car(args), ncreel_options_symbol, __func__, 1))->flags = (uint64_t)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+
+
+/* -------- ncreel -------- */
+
+static s7_pointer g_ncreel_create(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncreel_create((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), 
+						       (const ncreel_options *)s7_c_pointer_with_type(sc, s7_cadr(args), ncreel_options_symbol, __func__, 2)),
+				     ncreel_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncreel_plane(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncreel_plane((struct ncreel *)s7_c_pointer_with_type(sc, s7_car(args), ncreel_symbol, __func__, 1)), 
+				     ncplane_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncreel_tabletcount(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncreel_tabletcount((const struct ncreel *)s7_c_pointer_with_type(sc, s7_car(args), ncreel_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncreel_redraw(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncreel_redraw((struct ncreel *)s7_c_pointer_with_type(sc, s7_car(args), ncreel_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncreel_focused(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncreel_focused((struct ncreel *)s7_c_pointer_with_type(sc, s7_car(args), ncreel_symbol, __func__, 1)), 
+				     nctablet_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncreel_next(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncreel_next((struct ncreel *)s7_c_pointer_with_type(sc, s7_car(args), ncreel_symbol, __func__, 1)), 
+				     nctablet_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncreel_prev(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncreel_prev((struct ncreel *)s7_c_pointer_with_type(sc, s7_car(args), ncreel_symbol, __func__, 1)), 
+				     nctablet_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncreel_offer_input(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_boolean(sc, ncreel_offer_input((struct ncreel *)s7_c_pointer_with_type(sc, s7_car(args), ncreel_symbol, __func__, 1), 
+						(const struct ncinput *)s7_c_pointer_with_type(sc, s7_cadr(args), ncinput_symbol, __func__, 2))));
+}
+
+static s7_pointer g_ncreel_destroy(s7_scheme *sc, s7_pointer args)
+{
+  ncreel_destroy((struct ncreel *)s7_c_pointer_with_type(sc, s7_car(args), ncreel_symbol, __func__, 1));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncreel_del(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncreel_del((struct ncreel *)s7_c_pointer_with_type(sc, s7_car(args), ncreel_symbol, __func__, 1), 
+					(struct nctablet *)s7_c_pointer_with_type(sc, s7_cadr(args), nctablet_symbol, __func__, 2))));
+}
+
+static s7_pointer g_nctablet_userptr(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, nctablet_userptr((struct nctablet *)s7_c_pointer_with_type(sc, s7_car(args), nctablet_symbol, __func__, 1)), 
+				     void_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_nctablet_plane(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, nctablet_plane((struct nctablet *)s7_c_pointer_with_type(sc, s7_car(args), nctablet_symbol, __func__, 1)), 
+				     ncplane_symbol, s7_f(sc)));
+}
+
+#if 0
+/* typedef int (*tabletcb)(struct nctablet* t, int begx, int begy, int maxx, int maxy, bool cliptop);
+ * struct nctablet* ncreel_add(struct ncreel* pr, struct nctablet* after, struct nctablet* before, tabletcb cb, void* opaque);
+ */
+#endif
+
+
+/* -------- ncreader_options -------- */
+#if 0
+typedef struct ncreader_options {
+  uint64_t tchannels;
+  uint32_t tattrword;
+
+echannels
+eattrword;
+egc;
+physrows;
+physcols;
+
+
+  uint64_t flags;
+} ncreader_options;
+#endif
+
+static s7_pointer g_ncreader_options_make(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(ncreader_options)), ncreader_options_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncreader_options_free(s7_scheme *sc, s7_pointer args)
+{
+  free((void *)s7_c_pointer_with_type(sc, s7_car(args), ncreader_options_symbol, __func__, 0));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncreader_options_tchannels(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((struct ncreader_options *)s7_c_pointer_with_type(sc, s7_car(args), ncreader_options_symbol, __func__, 1))->tchannels));
+}
+
+static s7_pointer g_ncreader_options_tattrword(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((struct ncreader_options *)s7_c_pointer_with_type(sc, s7_car(args), ncreader_options_symbol, __func__, 1))->tattrword));
+}
+
+
+static s7_pointer g_ncreader_options_flags(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((struct ncreader_options *)s7_c_pointer_with_type(sc, s7_car(args), ncreader_options_symbol, __func__, 1))->flags));
+}
+
+static s7_pointer g_set_ncreader_options_tchannels(s7_scheme *sc, s7_pointer args) 
+{
+  ((struct ncreader_options *)s7_c_pointer_with_type(sc, s7_car(args), ncreader_options_symbol, __func__, 1))->tchannels = (uint64_t)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncreader_options_tattrword(s7_scheme *sc, s7_pointer args) 
+{
+  ((struct ncreader_options *)s7_c_pointer_with_type(sc, s7_car(args), ncreader_options_symbol, __func__, 1))->tattrword = (uint64_t)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+
+static s7_pointer g_set_ncreader_options_flags(s7_scheme *sc, s7_pointer args) 
+{
+  ((struct ncreader_options *)s7_c_pointer_with_type(sc, s7_car(args), ncreader_options_symbol, __func__, 1))->flags = (uint64_t)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+
+/* -------- ncreader -------- */
+
+static s7_pointer g_ncreader_create(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncreader_create((struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1),
+							 (const ncreader_options *)s7_c_pointer_with_type(sc, s7_cadddr(args), 
+													  ncreader_options_symbol, __func__, 4)),
+				     ncreader_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncreader_clear(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncreader_clear((struct ncreader *)s7_c_pointer_with_type(sc, s7_car(args), ncreader_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncreader_plane(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncreader_plane((struct ncreader *)s7_c_pointer_with_type(sc, s7_car(args), ncreader_symbol, __func__, 1)), 
+				     ncplane_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncreader_contents(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_string(sc, ncreader_contents((const struct ncreader *)s7_c_pointer_with_type(sc, s7_car(args), ncreader_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncreader_offer_input(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_boolean(sc, ncreader_offer_input((struct ncreader *)s7_c_pointer_with_type(sc, s7_car(args), ncreader_symbol, __func__, 1),
+						  (const struct ncinput *)s7_c_pointer_with_type(sc, s7_cadr(args), ncinput_symbol, __func__, 2))));
+}
+
+static s7_pointer g_ncreader_destroy(s7_scheme *sc, s7_pointer args)
+{
+  ncreader_destroy((struct ncreader *)s7_c_pointer_with_type(sc, s7_car(args), ncreader_symbol, __func__, 1), 
+		   (char **)s7_c_pointer_with_type(sc, s7_cadr(args), char_symbol, __func__, 2));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncreader_move_left(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncreader_move_left((struct ncreader *)s7_c_pointer_with_type(sc, s7_car(args), ncreader_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncreader_move_right(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncreader_move_right((struct ncreader *)s7_c_pointer_with_type(sc, s7_car(args), ncreader_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncreader_move_up(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncreader_move_up((struct ncreader *)s7_c_pointer_with_type(sc, s7_car(args), ncreader_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncreader_move_down(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncreader_move_down((struct ncreader *)s7_c_pointer_with_type(sc, s7_car(args), ncreader_symbol, __func__, 1))));
+}
+
+
+/* -------- ncvisual_options -------- */
+#if 0
+struct ncvisual_options {
+  struct ncplane* n;
+  ncscale_e scaling;
+  int y, x;
+  int begy, begx;
+  int leny, lenx;
+  ncblitter_e blitter;
+  uint64_t flags;
+};
+#endif
+
+static s7_pointer g_ncvisual_options_make(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(struct ncvisual_options)), ncvisual_options_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncvisual_options_free(s7_scheme *sc, s7_pointer args)
+{
+  free((void *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_options_symbol, __func__, 0));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncvisual_options_n(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_c_pointer_with_type(sc, ((struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_options_symbol, __func__, 1))->n, 
+				     ncplane_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncvisual_options_scaling(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_options_symbol, __func__, 1))->scaling));
+}
+
+static s7_pointer g_ncvisual_options_y(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_options_symbol, __func__, 1))->y));
+}
+
+static s7_pointer g_ncvisual_options_x(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_options_symbol, __func__, 1))->x));
+}
+
+static s7_pointer g_ncvisual_options_begy(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_options_symbol, __func__, 1))->begy));
+}
+
+static s7_pointer g_ncvisual_options_begx(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_options_symbol, __func__, 1))->begx));
+}
+
+static s7_pointer g_ncvisual_options_leny(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_options_symbol, __func__, 1))->leny));
+}
+
+static s7_pointer g_ncvisual_options_lenx(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_options_symbol, __func__, 1))->lenx));
+}
+
+static s7_pointer g_ncvisual_options_blitter(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_options_symbol, __func__, 1))->blitter));
+}
+
+static s7_pointer g_ncvisual_options_flags(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, ((struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_options_symbol, __func__, 1))->flags));
+}
+
+
+static s7_pointer g_set_ncvisual_options_n(s7_scheme *sc, s7_pointer args)  /* ?? */
+{
+  ((struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_options_symbol, __func__, 1))->n = (struct ncplane *)s7_c_pointer_with_type(sc, s7_cadr(args), ncplane_symbol, __func__, 2);
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncvisual_options_scaling(s7_scheme *sc, s7_pointer args) 
+{
+  ((struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_options_symbol, __func__, 1))->scaling = (ncscale_e)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncvisual_options_y(s7_scheme *sc, s7_pointer args) 
+{
+  ((struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_options_symbol, __func__, 1))->y = (int)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncvisual_options_x(s7_scheme *sc, s7_pointer args) 
+{
+  ((struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_options_symbol, __func__, 1))->x = (int)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncvisual_options_begy(s7_scheme *sc, s7_pointer args) 
+{
+  ((struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_options_symbol, __func__, 1))->begy = (int)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncvisual_options_begx(s7_scheme *sc, s7_pointer args) 
+{
+  ((struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_options_symbol, __func__, 1))->begx = (int)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncvisual_options_leny(s7_scheme *sc, s7_pointer args) 
+{
+  ((struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_options_symbol, __func__, 1))->leny = (int)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncvisual_options_lenx(s7_scheme *sc, s7_pointer args) 
+{
+  ((struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_options_symbol, __func__, 1))->lenx = (int)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncvisual_options_blitter(s7_scheme *sc, s7_pointer args) 
+{
+  ((struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_options_symbol, __func__, 1))->blitter = (ncblitter_e)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncvisual_options_flags(s7_scheme *sc, s7_pointer args) 
+{
+  ((struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_options_symbol, __func__, 1))->flags = (uint64_t)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+
+/* -------- ncvisual -------- */
+
+static s7_pointer g_ncvisual_from_file(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncvisual_from_file((const char *)s7_string_checked(sc, s7_car(args))), ncvisual_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncvisual_from_rgba(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncvisual_from_rgba((const void *)s7_c_pointer_with_type(sc, s7_car(args), void_symbol, __func__, 1),  /* TODO: rgba* */
+							    (int)s7_integer_checked(sc, s7_cadr(args)),
+							    (int)s7_integer_checked(sc, s7_caddr(args)),
+							    (int)s7_integer_checked(sc, s7_cadddr(args))),
+				     ncvisual_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncvisual_from_bgra(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncvisual_from_bgra((const void *)s7_c_pointer_with_type(sc, s7_car(args), void_symbol, __func__, 1),  /* TODO: bgra* */
+							    (int)s7_integer_checked(sc, s7_cadr(args)),
+							    (int)s7_integer_checked(sc, s7_caddr(args)),
+							    (int)s7_integer_checked(sc, s7_cadddr(args))),
+				     ncvisual_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncvisual_from_plane(s7_scheme *sc, s7_pointer args)
+{
+  int begy, begx, leny, lenx;
+  s7_pointer arg;
+  arg = s7_cddr(args);
+  begy = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  begx = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  leny = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  lenx = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  return(s7_make_c_pointer_with_type(sc, ncvisual_from_plane((const struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1),
+							     (ncblitter_e)s7_integer_checked(sc, s7_cadr(args)),
+							     begy, begx, leny, lenx),
+				     ncvisual_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncvisual_destroy(s7_scheme *sc, s7_pointer args)
+{
+  ncvisual_destroy((struct ncvisual *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_symbol, __func__, 1));
+  return(s7_f(sc));
+}
+ 
+static s7_pointer g_ncvisual_decode(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncvisual_decode((struct ncvisual *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncvisual_rotate(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncvisual_rotate((struct ncvisual *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_symbol, __func__, 1), 
+					     (double)s7_real_checked(sc, s7_cadr(args)))));
+}
+
+static s7_pointer g_ncvisual_resize(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncvisual_resize((struct ncvisual *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_symbol, __func__, 1), 
+					     (int)s7_integer_checked(sc, s7_cadr(args)),
+					     (int)s7_integer_checked(sc, s7_caddr(args)))));
+}
+
+static s7_pointer g_ncvisual_polyfill_yx(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncvisual_polyfill_yx((struct ncvisual *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_symbol, __func__, 1), 
+						  (int)s7_integer_checked(sc, s7_cadr(args)),
+						  (int)s7_integer_checked(sc, s7_caddr(args)),
+						  (uint32_t)s7_integer_checked(sc, s7_cadddr(args)))));
+}
+
+static s7_pointer g_ncvisual_set_yx(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncvisual_set_yx((const struct ncvisual *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_symbol, __func__, 1), 
+					     (int)s7_integer_checked(sc, s7_cadr(args)),
+					     (int)s7_integer_checked(sc, s7_caddr(args)),
+					     (uint32_t)s7_integer_checked(sc, s7_cadddr(args)))));
+}
+
+static s7_pointer g_ncvisual_at_yx(s7_scheme *sc, s7_pointer args)
+{
+  uint32_t pix;
+  s7_pointer res;
+  res = s7_make_integer(sc, ncvisual_at_yx((const struct ncvisual *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_symbol, __func__, 1), 
+					   (int)s7_integer_checked(sc, s7_cadr(args)),
+					   (int)s7_integer_checked(sc, s7_caddr(args)),
+					   &pix));
+  return(s7_list(sc, 2, res, s7_make_integer(sc, pix)));
+}
+
+static s7_pointer g_ncvisual_simple_streamer(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncvisual_simple_streamer((struct ncvisual *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_symbol, __func__, 1),
+						      (struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_cadr(args), ncvisual_options_symbol, __func__, 2),
+						      (const struct timespec *)s7_c_pointer_with_type(sc, s7_caddr(args), s7_make_symbol(sc, "timespec*"), __func__, 3),
+						      (void *)s7_c_pointer_with_type(sc, s7_cadddr(args),void_symbol, __func__, 4))));
+}
+
+static s7_pointer g_ncblit_rgba(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncblit_rgba((const void *)s7_c_pointer_with_type(sc, s7_car(args), void_symbol, __func__, 1),
+					 (int)s7_integer_checked(sc, s7_cadr(args)),
+					 (const struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_caddr(args), ncvisual_options_symbol, __func__, 3))));
+}
+
+static s7_pointer g_ncblit_bgrx(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncblit_bgrx((const void *)s7_c_pointer_with_type(sc, s7_car(args), void_symbol, __func__, 1),
+					 (int)s7_integer_checked(sc, s7_cadr(args)),
+					 (const struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_caddr(args), ncvisual_options_symbol, __func__, 3))));
+}
+
+#if 0
+static s7_pointer g_ncplane_rgba(s7_scheme *sc, s7_pointer args)
+{
+  int begy, begx, leny, lenx;
+  s7_pointer arg;
+  arg = s7_cddr(args);
+  begy = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  begx = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  leny = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  lenx = (int)s7_integer_checked(sc, s7_car(arg)); arg = s7_cdr(arg);
+  return(s7_make_c_pointer_with_type(sc, ncplane_rgba((const struct ncplane *)s7_c_pointer_with_type(sc, s7_car(args), ncplane_symbol, __func__, 1), /* TODO: returns uint32_t* */
+						      (ncblitter_e)s7_integer_checked(sc, s7_cadr(args)),
+						      begy, begx, leny, lenx),
+				     s7_make_symbol(sc, "uint32_t*"), s7_f(sc)));
+}
+
+static s7_pointer g_ncvisual_geom(s7_scheme *sc, s7_pointer args)
+{
+  int y, x, toy, tox;
+  s7_pointer res;
+  res = s7_make_integer(sc, ncvisual_geom((const struct notcurses *)s7_c_pointer_with_type(sc, s7_car(args), notcurses_symbol, __func__, 1),
+					  (const struct ncvisual *)s7_c_pointer_with_type(sc, s7_cadr(args), ncvisual_symbol, __func__, 2),
+					  (const struct ncvisual_options *)s7_c_pointer_with_type(sc, s7_caddr(args), ncvisual_options_symbol, __func__, 3),
+					  &y, &x, &toy, &tox));
+  return(s7_list(sc, 5, res, s7_make_integer(sc, y), s7_make_integer(sc, x), s7_make_integer(sc, toy), s7_make_integer(sc, tox)));
+}
+#endif
+
+static s7_pointer g_ncvisual_decode_loop(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncvisual_decode_loop((struct ncvisual *)s7_c_pointer_with_type(sc, s7_car(args), ncvisual_symbol, __func__, 1))));
+}
+
+/* typedef int (*streamcb)(struct ncvisual*, struct ncvisual_options*, const struct timespec*, void*);
+ * int ncvisual_stream(struct notcurses* nc, struct ncvisual* ncv, nc_err_e* ncerr, float timescale, streamcb streamer, const struct ncvisual_options* vopts, void* curry);
+ */
+
+
+/* -------- ncfdplane/ncsubproc -------- */
+#if 0
+typedef struct ncfdplane_options {
+  void* curry;
+  bool follow;
+  uint64_t flags;
+} ncfdplane_options;
+
+typedef struct ncsubproc_options {
+  void* curry;
+  uint64_t restart_period;
+  uint64_t flags;
+} ncsubproc_options;
+#endif
+
+static s7_pointer g_ncfdplane_options_make(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(struct ncfdplane_options)), ncfdplane_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncfdplane_options_free(s7_scheme *sc, s7_pointer args)
+{
+  free((void *)s7_c_pointer_with_type(sc, s7_car(args), ncfdplane_symbol, __func__, 0));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncfdplane_options_curry(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ((struct ncfdplane_options *)s7_c_pointer_with_type(sc, s7_car(args), ncfdplane_symbol, __func__, 1))->curry, void_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncfdplane_options_follow(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_boolean(sc, ((struct ncfdplane_options *)s7_c_pointer_with_type(sc, s7_car(args), ncfdplane_symbol, __func__, 1))->follow));
+}
+
+static s7_pointer g_ncfdplane_options_flags(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ((struct ncfdplane_options *)s7_c_pointer_with_type(sc, s7_car(args), ncfdplane_symbol, __func__, 1))->flags));
+}
+
+static s7_pointer g_set_ncfdplane_options_curry(s7_scheme *sc, s7_pointer args)
+{
+  ((struct ncfdplane_options *)s7_c_pointer_with_type(sc, s7_car(args), ncfdplane_symbol, __func__, 1))->curry = (void *)s7_c_pointer_with_type(sc, s7_cadr(args), void_symbol, __func__, 2);
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncfdplane_options_follow(s7_scheme *sc, s7_pointer args)
+{
+  ((struct ncfdplane_options *)s7_c_pointer_with_type(sc, s7_car(args), ncfdplane_symbol, __func__, 1))->follow = (bool)s7_boolean(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer g_set_ncfdplane_options_flags(s7_scheme *sc, s7_pointer args)
+{
+  ((struct ncfdplane_options *)s7_c_pointer_with_type(sc, s7_car(args), ncfdplane_symbol, __func__, 1))->flags = (uint64_t)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+
+static s7_pointer g_ncsubproc_options_make(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(struct ncsubproc_options)), ncsubproc_options_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncsubproc_options_free(s7_scheme *sc, s7_pointer args)
+{
+  free((void *)s7_c_pointer_with_type(sc, s7_car(args), ncsubproc_options_symbol, __func__, 0));
+  return(s7_f(sc));
+}
+
+static s7_pointer g_ncsubproc_options_curry(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ((struct ncsubproc_options *)s7_c_pointer_with_type(sc, s7_car(args), ncsubproc_options_symbol, __func__, 1))->curry, void_symbol, s7_f(sc)));
+}
+ 
+static s7_pointer g_ncsubproc_options_restart_period(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ((struct ncsubproc_options *)s7_c_pointer_with_type(sc, s7_car(args), ncsubproc_options_symbol, __func__, 1))->restart_period));
+}
+ 
+static s7_pointer g_ncsubproc_options_flags(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ((struct ncsubproc_options *)s7_c_pointer_with_type(sc, s7_car(args), ncsubproc_options_symbol, __func__, 1))->flags));
+}
+
+static s7_pointer g_set_ncsubproc_options_curry(s7_scheme *sc, s7_pointer args)
+{
+  ((struct ncsubproc_options *)s7_c_pointer_with_type(sc, s7_car(args), ncsubproc_options_symbol, __func__, 1))->curry = (void *)s7_c_pointer_with_type(sc, s7_cadr(args), void_symbol, __func__, 2);
+  return(s7_cadr(args));
+}
+ 
+static s7_pointer g_set_ncsubproc_options_restart_period(s7_scheme *sc, s7_pointer args)
+{
+  ((struct ncsubproc_options *)s7_c_pointer_with_type(sc, s7_car(args), ncsubproc_options_symbol, __func__, 1))->restart_period = (uint64_t)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+ 
+static s7_pointer g_set_ncsubproc_options_flags(s7_scheme *sc, s7_pointer args)
+{
+  ((struct ncsubproc_options *)s7_c_pointer_with_type(sc, s7_car(args), ncsubproc_options_symbol, __func__, 1))->flags = (uint64_t)s7_integer_checked(sc, s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+
+static s7_pointer g_ncfdplane_plane(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncfdplane_plane((struct ncfdplane *)s7_c_pointer_with_type(sc, s7_car(args), ncfdplane_symbol, __func__, 1)), 
+				     ncplane_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncfdplane_destroy(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncfdplane_destroy((struct ncfdplane *)s7_c_pointer_with_type(sc, s7_car(args), ncfdplane_symbol, __func__, 1))));
+}
+
+static s7_pointer g_ncsubproc_plane(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, ncsubproc_plane((struct ncsubproc *)s7_c_pointer_with_type(sc, s7_car(args), ncsubproc_symbol, __func__, 1)), 
+				     ncplane_symbol, s7_f(sc)));
+}
+
+static s7_pointer g_ncsubproc_destroy(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, ncsubproc_destroy((struct ncsubproc *)s7_c_pointer_with_type(sc, s7_car(args), ncsubproc_symbol, __func__, 1))));
+}
+
+
+#if 0
+int ncplane_qrcode(struct ncplane* n, ncblitter_e blitter, int* ymax, int* xmax, const void* data, size_t len);
+
+#define NCMETRICFWIDTH(x, cols) ((int)(strlen(x) - mbswidth(x) + (cols)))
+#define PREFIXFMT(x) NCMETRICFWIDTH((x), PREFIXCOLUMNS), (x)
+#define IPREFIXFMT(x) NCMETRIXFWIDTH((x), IPREFIXCOLUMNS), (x)
+#define BPREFIXFMT(x) NCMETRICFWIDTH((x), BPREFIXCOLUMNS), (x)
+
+const char* ncmetric(uintmax_t val, uintmax_t decimal, char* buf, int omitdec, uintmax_t mult, int uprefix);
+#endif
+
+/* typedef int(*ncfdplane_callback)(struct ncfdplane* n, const void* buf, size_t s, void* curry);
+ * typedef int(*ncfdplane_done_cb)(struct ncfdplane* n, int fderrno, void* curry);
+ * struct ncfdplane* ncfdplane_create(struct ncplane* n, const ncfdplane_options* opts, int fd, ncfdplane_callback cbfxn, ncfdplane_done_cb donecbfxn);
+ * struct ncsubproc* ncsubproc_createv(struct ncplane* n, const ncsubproc_options* opts, const char* bin,  char* const arg[], ncfdplane_callback cbfxn, ncfdplane_done_cb donecbfxn);
+ * struct ncsubproc* ncsubproc_createvp(struct ncplane* n, const ncsubproc_options* opts, const char* bin,  char* const arg[], ncfdplane_callback cbfxn, ncfdplane_done_cb donecbfxn);
+ * struct ncsubproc* ncsubproc_createvpe(struct ncplane* n, const ncsubproc_options* opts, const char* bin,  char* const arg[], char* const env[], ncfdplane_callback cbfxn, ncfdplane_done_cb donecbfxn);
+ */
+
+
+
+
+/* ---------------- initialization ---------------- */
+
+void notcurses_s7_init(s7_scheme *sc);
+void notcurses_s7_init(s7_scheme *sc)
+{
+  s7_pointer notcurses_let, old_shadow;
+  s7_define_constant(sc, "*notcurses*", notcurses_let = s7_inlet(sc, s7_nil(sc)));
+  old_shadow = s7_set_shadow_rootlet(sc, notcurses_let);
+
+  init_symbols(sc);
+
+  #define nc_int(Name) s7_define(sc, notcurses_let, s7_make_symbol(sc, #Name), s7_make_integer(sc, (s7_int)Name))
+
+  nc_int(NCOPTION_INHIBIT_SETLOCALE);
+  nc_int(NCOPTION_NO_WINCH_SIGHANDLER);
+  nc_int(NCOPTION_NO_QUIT_SIGHANDLERS);
+  nc_int(NCOPTION_SUPPRESS_BANNERS);
+  nc_int(NCOPTION_NO_ALTERNATE_SCREEN);
+  nc_int(NCOPTION_NO_FONT_CHANGES);
+  nc_int(NCOPTION_PRESERVE_CURSOR);
+  nc_int(NCPLANE_OPTION_FIXED);
+
+  nc_int(NC_BGDEFAULT_MASK);
+  nc_int(NC_BG_RGB_MASK);
+  nc_int(NC_BG_PALETTE);
+  nc_int(NC_BG_ALPHA_MASK);
+#if 0
+  nc_int(NC_FGDEFAULT_MASK);
+  nc_int(NC_FG_RGB_MASK);
+  nc_int(NC_FG_PALETTE);
+  nc_int(NC_FG_ALPHA_MASK);
+#endif
+
+  nc_int(NCALPHA_HIGHCONTRAST);
+  nc_int(NCALPHA_TRANSPARENT);
+  nc_int(NCALPHA_BLEND);
+  nc_int(NCALPHA_OPAQUE);
+  nc_int(NCPLANE_OPTION_HORALIGNED);
+
+  nc_int(NCSTYLE_MASK);
+  nc_int(NCSTYLE_UNDERLINE);
+  nc_int(NCSTYLE_BOLD);
+  nc_int(NCSTYLE_ITALIC);
+  nc_int(NCSTYLE_STRUCK);
+  nc_int(NCSTYLE_NONE);
+
+  nc_int(WCHAR_MAX_UTF8BYTES);
+
+  nc_int(NCBOXMASK_TOP);
+  nc_int(NCBOXMASK_RIGHT);
+  nc_int(NCBOXMASK_BOTTOM);
+  nc_int(NCBOXMASK_LEFT);
+  nc_int(NCBOXGRAD_TOP);
+  nc_int(NCBOXGRAD_RIGHT);
+  nc_int(NCBOXGRAD_BOTTOM);
+  nc_int(NCBOXGRAD_LEFT);
+  nc_int(NCBOXCORNER_MASK);
+  nc_int(NCBOXCORNER_SHIFT);
+
+  nc_int(NCPALETTESIZE);
+
+  nc_int(NCVISUAL_OPTION_NODEGRADE);
+  nc_int(NCVISUAL_OPTION_BLEND);
+
+  nc_int(NCREEL_OPTION_INFINITESCROLL);
+  nc_int(NCREEL_OPTION_CIRCULAR);
+
+  nc_int(NCPREFIXCOLUMNS);
+  nc_int(NCIPREFIXCOLUMNS);
+  nc_int(NCBPREFIXCOLUMNS);
+  nc_int(NCPREFIXSTRLEN);
+  nc_int(NCIPREFIXSTRLEN);
+  nc_int(NCBPREFIXSTRLEN);
+
+  nc_int(NCREADER_OPTION_HORSCROLL);
+  nc_int(NCREADER_OPTION_VERSCROLL);
+  nc_int(NCREADER_OPTION_NOCMDKEYS);
+  nc_int(NCREADER_OPTION_CURSOR);
+
+  nc_int(NCPLOT_OPTION_LABELTICKSD);
+  nc_int(NCPLOT_OPTION_EXPONENTIALD);
+  nc_int(NCPLOT_OPTION_VERTICALI);
+  nc_int(NCPLOT_OPTION_NODEGRADE);
+  nc_int(NCPLOT_OPTION_DETECTMAXONLY);
+
+  nc_int(NCMENU_OPTION_BOTTOM);
+  nc_int(NCMENU_OPTION_HIDING);
+
+  nc_int(NCLOGLEVEL_SILENT);
+  nc_int(NCLOGLEVEL_PANIC);
+  nc_int(NCLOGLEVEL_FATAL);
+  nc_int(NCLOGLEVEL_ERROR);
+  nc_int(NCLOGLEVEL_WARNING);
+  nc_int(NCLOGLEVEL_INFO);
+  nc_int(NCLOGLEVEL_VERBOSE);
+  nc_int(NCLOGLEVEL_DEBUG);
+  nc_int(NCLOGLEVEL_TRACE);
+
+  nc_int(NCSCALE_NONE);
+  nc_int(NCSCALE_SCALE);
+  nc_int(NCSCALE_STRETCH);
+
+  nc_int(NCALIGN_LEFT);
+  nc_int(NCALIGN_CENTER);
+  nc_int(NCALIGN_RIGHT);
+
+  nc_int(NCBLIT_DEFAULT);
+  nc_int(NCBLIT_1x1);
+  nc_int(NCBLIT_2x1);
+  nc_int(NCBLIT_2x2);
+  nc_int(NCBLIT_3x2);
+  nc_int(NCBLIT_4x1);
+  nc_int(NCBLIT_BRAILLE);
+  nc_int(NCBLIT_8x1);
+
+  /* notcurses/nckeys.h */
+  nc_int(NCKEY_INVALID);
+  nc_int(NCKEY_RESIZE);
+  nc_int(NCKEY_UP);
+  nc_int(NCKEY_RIGHT);
+  nc_int(NCKEY_DOWN);
+  nc_int(NCKEY_LEFT);
+  nc_int(NCKEY_INS);
+  nc_int(NCKEY_DEL);
+  nc_int(NCKEY_BACKSPACE);
+  nc_int(NCKEY_PGDOWN);
+  nc_int(NCKEY_PGUP);
+  nc_int(NCKEY_HOME);
+  nc_int(NCKEY_END);
+  nc_int(NCKEY_F00);
+  nc_int(NCKEY_F01);
+  nc_int(NCKEY_F02);
+  nc_int(NCKEY_F03);
+  nc_int(NCKEY_F04);
+  nc_int(NCKEY_F05);
+  nc_int(NCKEY_F06);
+  nc_int(NCKEY_F07);
+  nc_int(NCKEY_F08);
+  nc_int(NCKEY_F09);
+  nc_int(NCKEY_F10);
+  nc_int(NCKEY_ENTER);
+  nc_int(NCKEY_CLS);
+  nc_int(NCKEY_DLEFT);
+  nc_int(NCKEY_DRIGHT);
+  nc_int(NCKEY_ULEFT);
+  nc_int(NCKEY_URIGHT);
+  nc_int(NCKEY_CENTER);
+  nc_int(NCKEY_BEGIN);
+  nc_int(NCKEY_CANCEL);
+  nc_int(NCKEY_CLOSE);
+  nc_int(NCKEY_COMMAND);
+  nc_int(NCKEY_COPY);
+  nc_int(NCKEY_EXIT);
+  nc_int(NCKEY_PRINT);
+  nc_int(NCKEY_REFRESH);
+  nc_int(NCKEY_BUTTON1);
+  nc_int(NCKEY_BUTTON2);
+  nc_int(NCKEY_BUTTON3);
+  nc_int(NCKEY_BUTTON4);
+  nc_int(NCKEY_BUTTON5);
+  nc_int(NCKEY_BUTTON6);
+  nc_int(NCKEY_BUTTON7);
+  nc_int(NCKEY_BUTTON8);
+  nc_int(NCKEY_BUTTON9);
+  nc_int(NCKEY_BUTTON10);
+  nc_int(NCKEY_BUTTON11);
+  nc_int(NCKEY_SCROLL_UP);
+  nc_int(NCKEY_SCROLL_DOWN);
+  nc_int(NCKEY_RETURN);
+  nc_int(NCTYPE_UNKNOWN);
+  nc_int(NCTYPE_PRESS);
+  nc_int(NCTYPE_REPEAT);
+  nc_int(NCTYPE_RELEASE);
+
+  nc_int(NCMICE_NO_EVENTS);
+  nc_int(NCMICE_MOVE_EVENT);
+  nc_int(NCMICE_BUTTON_EVENT);
+  nc_int(NCMICE_DRAG_EVENT);
+  nc_int(NCMICE_ALL_EVENTS);
+
+  #define nc_func(Name, Req, Opt, Rst) s7_define(sc, notcurses_let, \
+                                          s7_make_symbol(sc, #Name), \
+                                          s7_make_function(sc, #Name, g_ ## Name, Req, Opt, Rst, NULL))
+
+  nc_func(ncstrwidth, 1, 0, false);
+    
+  nc_func(notcurses_version, 0, 0, false);
+  nc_func(notcurses_version_components, 0, 0, false);
+  nc_func(notcurses_options_make, 0, 0, false);
+  nc_func(notcurses_options_free, 1, 0, false);
+
+  nc_func(notcurses_options_termtype, 1, 0, false);
+
+  #define nc_func2(Name) s7_dilambda_with_environment(sc, notcurses_let, #Name, g_ ## Name, 1, 0, g_set_ ## Name, 2, 0, NULL)
+  #define nc_func3(NcName, Name) \
+    do {s7_dilambda_with_environment(sc, notcurses_let, #NcName, g_ ## Name, 1, 0, g_set_ ## Name, 2, 0, NULL); \
+        s7_dilambda_with_environment(sc, notcurses_let, #Name, g_ ## Name, 1, 0, g_set_ ## Name, 2, 0, NULL);} while (0)
+  /* this is becoming ridiculous */
+  
+  nc_func2(notcurses_options_margin_t);
+  nc_func2(notcurses_options_margin_r);
+  nc_func2(notcurses_options_margin_b);
+  nc_func2(notcurses_options_margin_l);
+  nc_func2(notcurses_options_flags);
+  nc_func2(notcurses_options_loglevel);
+
+  nc_func(notcurses_core_init, 0, 2, false);
+  nc_func(notcurses_stop, 1, 0, false);
+  nc_func(notcurses_render, 1, 0, false);
+  nc_func(notcurses_inputready_fd, 1, 0, false);
+
+  nc_func(notcurses_mice_enable, 2, 0, false);
+  nc_func(notcurses_mice_disable, 1, 0, false);
+
+  nc_func(notcurses_supported_styles, 1, 0, false);
+  nc_func(notcurses_palette_size, 1, 0, false);
+  nc_func(notcurses_canfade, 1, 0, false);
+  nc_func(notcurses_canchangecolor, 1, 0, false);
+  nc_func(notcurses_canopen_images, 1, 0, false);
+  nc_func(notcurses_canopen_videos, 1, 0, false);
+  nc_func(notcurses_canutf8, 1, 0, false);
+  nc_func(notcurses_top, 1, 0, false);
+  nc_func(notcurses_drop_planes, 1, 0, false);
+  nc_func(notcurses_stdplane, 1, 0, false);
+  nc_func(notcurses_stdplane_const, 1, 0, false);
+  nc_func(notcurses_cursor_enable, 3, 0, false);
+  nc_func(notcurses_cursor_disable, 1, 0, false);
+  nc_func(notcurses_get, 3, 0, false);
+  nc_func(notcurses_refresh, 1, 0, false);
+  nc_func(notcurses_at_yx, 5, 0, false);
+  nc_func(notcurses_lex_margins, 2, 0, false);
+  nc_func(notcurses_lex_scalemode, 2, 0, false);
+  /* nc_func(notcurses_render_to_file, 2, 0, false); */ /* now ncpile_render_to file? */
+  nc_func(notcurses_bottom, 1, 0, false);
+#if 0
+  nc_func(ncpalette_new, 1, 0, false);
+  nc_func(ncpalette_free, 1, 0, false);
+  nc_func(ncpalette_use, 2, 0, false);
+#endif
+  nc_func(ncinput_id, 1, 0, false);
+  nc_func(ncinput_y, 1, 0, false);
+  nc_func(ncinput_x, 1, 0, false);
+  nc_func(ncinput_alt, 1, 0, false);
+  nc_func(ncinput_shift, 1, 0, false);
+  nc_func(ncinput_ctrl, 1, 0, false);
+#if (NC_CURRENT_VERSION >= NC_VERSION(3, 0, 4))
+  nc_func(ncinput_meta, 1, 0, false);
+#endif
+  nc_func(ncinput_evtype, 1, 0, false);
+  nc_func(ncinput_make, 0, 0, false);
+  nc_func(ncinput_free, 1, 0, false);
+
+  nc_func(ncstats_make, 0, 0, false);
+  nc_func(ncstats_free, 1, 0, false);
+  nc_func(notcurses_stats, 2, 0, false);
+  nc_func(ncstats_renders, 1, 0, false);
+  nc_func(ncstats_failed_renders, 1, 0, false);
+  nc_func(ncstats_render_ns, 1, 0, false);
+  nc_func(ncstats_render_max_ns, 1, 0, false);
+  nc_func(ncstats_render_min_ns, 1, 0, false);
+  nc_func(ncstats_cellelisions, 1, 0, false);
+  nc_func(ncstats_cellemissions, 1, 0, false);
+  nc_func(ncstats_fgelisions, 1, 0, false);
+  nc_func(ncstats_fgemissions, 1, 0, false);
+  nc_func(ncstats_bgelisions, 1, 0, false);
+  nc_func(ncstats_bgemissions, 1, 0, false);
+  nc_func(ncstats_defaultelisions, 1, 0, false);
+  nc_func(ncstats_defaultemissions, 1, 0, false);
+  nc_func(ncstats_fbbytes, 1, 0, false);
+  nc_func(ncstats_planes, 1, 0, false);
+
+  nc_func(ncplane_options_make, 0, 0, false);
+  nc_func(ncplane_options_free, 1, 0, false);
+  nc_func2(ncplane_options_y);
+  nc_func2(ncplane_options_x);
+  nc_func2(ncplane_options_rows);
+  nc_func2(ncplane_options_cols);
+  nc_func2(ncplane_options_flags);
+  nc_func2(ncplane_options_name);
+  nc_func2(ncplane_options_userptr);
+  nc_func(ncplane_create, 2, 0, false);
+
+  nc_func(ncplane_notcurses, 1, 0, false);
+  nc_func(ncplane_destroy, 1, 0, false);
+  nc_func(ncplane_move_top, 1, 0, false);
+  nc_func(ncplane_move_bottom, 1, 0, false);
+  nc_func(ncplane_rotate_cw, 1, 0, false);
+  nc_func(ncplane_rotate_ccw, 1, 0, false);
+  nc_func(ncplane_userptr, 1, 0, false);
+  nc_func(ncplane_home, 1, 0, false);
+  nc_func(ncplane_below, 1, 0, false);
+  nc_func(ncplane_channels, 1, 0, false);
+  nc_func(ncplane_erase, 1, 0, false);
+  nc_func(ncplane_set_fg_default, 1, 0, false);
+  nc_func(ncplane_set_bg_default, 1, 0, false);
+  nc_func(ncplane_styles, 1, 0, false);
+
+  nc_func(ncplane_set_fg_rgb, 2, 0, false);
+  nc_func(ncplane_set_bg_rgb, 2, 0, false);
+  nc_func(ncplane_set_fg_palindex, 2, 0, false);
+  nc_func(ncplane_set_bg_palindex, 2, 0, false);
+  nc_func(ncplane_set_fg_alpha, 2, 0, false);
+  nc_func(ncplane_set_bg_alpha, 2, 0, false);
+  nc_func(ncplane_set_channels, 2, 0, false);
+  nc_func(ncplane_dim_yx, 1, 0, false);
+
+  nc_func(ncplane_set_base_cell, 2, 0, false);
+  nc_func(ncplane_base, 1, 0, false);
+  nc_func(ncplane_polyfill_yx, 4, 0, false);
+  nc_func(ncplane_putc_yx, 4, 0, false);
+  nc_func(ncplane_hline_interp, 5, 0, false);
+  nc_func(ncplane_vline_interp, 5, 0, false);
+  nc_func(ncplane_box, 10, 0, false);
+
+  nc_func(ncplane_move_yx, 3, 0, false);
+  nc_func(ncplane_cursor_move_yx, 3, 0, false);
+  nc_func(ncplane_set_fg_rgb8, 4, 0, false);
+  nc_func(ncplane_set_bg_rgb8, 4, 0, false);
+  nc_func(ncplane_set_bg_rgb8_clipped, 4, 0, false);
+  nc_func(ncplane_set_fg_rgb8_clipped, 4, 0, false);
+  nc_func(ncplane_putchar_stained, 2, 0, false);
+  nc_func(ncplane_format, 6, 0, false);
+
+  nc_func(ncplane_dup, 2, 0, false);
+  nc_func(ncplane_set_scrolling, 2, 0, false);
+  nc_func(ncplane_move_above, 2, 0, false);
+  nc_func(ncplane_move_below, 2, 0, false);
+  nc_func(ncplane_set_userptr, 2, 0, false);
+  nc_func(ncplane_reparent, 2, 0, false);
+  nc_func(ncplane_mergedown_simple, 2, 0, false);
+  nc_func(ncplane_mergedown, 8, 0, false);
+
+  nc_func(ncplane_translate_abs, 1, 0, false);
+  nc_func(ncplane_yx, 1, 0, false);
+  nc_func(ncplane_center_abs, 1, 0, false);
+  nc_func(ncplane_cursor_yx, 1, 0, false);
+  nc_func(ncplane_at_cursor, 1, 0, false);
+
+  nc_func(ncplane_putegc_stained, 2, 0, false);
+  nc_func(ncplane_putwegc_stained, 2, 0, false);
+  nc_func(ncplane_putegc_yx, 4, 0, false);
+  nc_func(ncplane_putstr_yx, 4, 0, false);
+  nc_func(ncplane_putnstr_yx, 5, 0, false);
+
+  nc_func(ncplane_new, 6, 0, false);
+  nc_func(ncplane_resize_realign, 1, 0, false);
+  nc_func(ncplane_translate, 2, 0, false);
+  nc_func(ncplane_resize, 9, 0, false);
+  nc_func(ncplane_set_base, 4, 0, false);
+  nc_func(ncplane_at_yx, 3, 0, false);
+  nc_func(ncplane_contents, 5, 0, false);
+  nc_func(ncplane_putstr_aligned, 4, 0, false);
+  nc_func(ncplane_putstr_stained, 2, 0, false);
+  nc_func(ncplane_puttext, 4, 0, false);
+  nc_func(ncplane_stain, 9, 0, false);
+  nc_func(ncplane_gradient2x1, 9, 0, false);
+  nc_func(ncplane_gradient, 11, 0, false);
+  nc_func(ncplane_greyscale, 1, 0, false);
+  nc_func(ncplane_y, 1, 0, false);
+  nc_func(ncplane_x, 1, 0, false);
+  nc_func(ncplane_above, 1, 0, false);
+  nc_func(ncplane_parent, 1, 0, false);
+
+  nc_func(ncpile_render, 1, 0, false);
+  nc_func(ncpile_rasterize, 1, 0, false);
+  nc_func(ncpile_create, 2, 0, false);
+  nc_func(ncplane_reparent_family, 2, 0, false);
+
+  nc_func(nccell_make, 0, 0, false);
+  nc_func(nccell_load, 3, 0, false);
+  s7_define(sc, notcurses_let, s7_make_symbol(sc, "nccell_make"), s7_make_function(sc, "nccell_make", g_nccell_make, 0, 0, false, NULL));
+  nc_func(nccell_release, 2, 0, false);
+  nc_func(nccell_extended_gcluster, 2, 0, false);
+  nc_func(nccells_double_box, 9, 0, false);
+  nc_func(nccells_rounded_box, 9, 0, false);
+  nc_func(nccells_load_box, 10, 0, false);
+  nc_func3(nccell_gcluster, nccell_gcluster);
+  nc_func3(nccell_stylemask, nccell_stylemask);
+  nc_func3(nccell_channels, nccell_channels);
+
+  nc_func(ncfadectx_setup, 1, 0, false);
+  nc_func(ncfadectx_free, 1, 0, false);
+  nc_func(ncfadectx_iterations, 1, 0, false);
+
+  nc_func(ncselector_item_make, 0, 0, false);
+  nc_func(ncselector_item_free, 1, 0, false);
+  nc_func2(ncselector_item_option);
+  nc_func2(ncselector_item_desc);
+
+  nc_func(ncselector_options_make, 0, 0, false);
+  nc_func(ncselector_options_free, 1, 0, false);
+  nc_func2(ncselector_options_title);
+  nc_func2(ncselector_options_secondary);
+  nc_func2(ncselector_options_footer);
+  nc_func2(ncselector_options_items);
+  nc_func(ncselector_options_defidx, 1, 0, false);
+  nc_func2(ncselector_options_maxdisplay);
+  nc_func(ncselector_options_opchannels, 1, 0, false);
+  nc_func(ncselector_options_descchannels, 1, 0, false);
+  nc_func(ncselector_options_titlechannels, 1, 0, false);
+  nc_func(ncselector_options_footchannels, 1, 0, false);
+  nc_func(ncselector_options_boxchannels, 1, 0, false);
+  nc_func(ncselector_options_flags, 1, 0, false);
+
+  nc_func(ncselector_create, 2, 0, false);
+  nc_func(ncselector_offer_input, 2, 0, false);
+  nc_func(ncselector_destroy, 2, 0, false);
+  nc_func(ncselector_additem, 2, 0, false);
+  nc_func(ncselector_delitem, 2, 0, false);
+  nc_func(ncselector_plane, 1, 0, false);
+  nc_func(ncselector_previtem, 1, 0, false);
+  nc_func(ncselector_nextitem, 1, 0, false);
+  nc_func(ncselector_selected, 1, 0, false);
+
+  nc_func(ncmselector_item_make, 0, 0, false);
+  nc_func(ncmselector_item_free, 1, 0, false);
+  nc_func2(ncmselector_item_option);
+  nc_func2(ncmselector_item_desc);
+
+  nc_func(ncmultiselector_options_make, 0, 0, false);
+  nc_func(ncmultiselector_options_free, 1, 0, false);
+  nc_func2(ncmultiselector_options_title);
+  nc_func2(ncmultiselector_options_secondary);
+  nc_func2(ncmultiselector_options_footer);
+  nc_func2(ncmultiselector_options_items);
+  nc_func2(ncmultiselector_options_maxdisplay);
+  nc_func(ncmultiselector_options_opchannels, 1, 0, false);
+  nc_func(ncmultiselector_options_descchannels, 1, 0, false);
+  nc_func(ncmultiselector_options_titlechannels, 1, 0, false);
+  nc_func(ncmultiselector_options_footchannels, 1, 0, false);
+  nc_func(ncmultiselector_options_boxchannels, 1, 0, false);
+  nc_func(ncmultiselector_options_flags, 1, 0, false);
+
+  nc_func(ncmultiselector_create, 2, 0, false);
+  nc_func(ncmultiselector_offer_input, 2, 0, false);
+  nc_func(ncmultiselector_destroy, 1, 0, false);
+  nc_func(ncmultiselector_plane, 1, 0, false);
+  nc_func(ncmultiselector_selected, 1, 0, false);
+
+  nc_func(ncmenu_options_make, 0, 0, false);
+  nc_func(ncmenu_options_free, 1, 0, false);
+  nc_func2(ncmenu_options_sections);
+  nc_func2(ncmenu_options_sectioncount);
+  nc_func2(ncmenu_options_headerchannels);
+  nc_func2(ncmenu_options_sectionchannels);
+  nc_func2(ncmenu_options_flags);
+
+  nc_func(ncmenu_item_make, 0, 0, false);
+  nc_func(ncmenu_item_free, 1, 0, false);
+  nc_func(ncmenu_section_make, 0, 0, false);
+  nc_func(ncmenu_section_free, 1, 0, false);
+
+  nc_func2(ncmenu_item_desc);
+  nc_func2(ncmenu_item_shortcut);
+  nc_func2(ncmenu_section_name);
+  nc_func2(ncmenu_section_itemcount);
+  nc_func2(ncmenu_section_items);
+  nc_func2(ncmenu_section_shortcut);
+
+  nc_func(ncmenu_create, 2, 0, false);
+  nc_func(ncmenu_unroll, 2, 0, false);
+  nc_func(ncmenu_rollup, 1, 0, false);
+  nc_func(ncmenu_nextsection, 1, 0, false);
+  nc_func(ncmenu_prevsection, 1, 0, false);
+  nc_func(ncmenu_nextitem, 1, 0, false);
+  nc_func(ncmenu_previtem, 1, 0, false);
+  nc_func(ncmenu_plane, 1, 0, false);
+  nc_func(ncmenu_destroy, 1, 0, false);
+  nc_func(ncmenu_selected, 2, 0, false);
+  nc_func(ncmenu_offer_input, 2, 0, false);
+  nc_func(list_to_ncmenu_items, 1, 0, false);
+  nc_func(ncmenu_items_to_list, 1, 0, false);
+  nc_func(list_to_ncmenu_sections, 1, 0, false);
+  nc_func(ncmenu_sections_to_list, 1, 0, false);
+
+  nc_func(ncplot_options_make, 0, 0, false);
+  nc_func(ncplot_options_free, 1, 0, false);
+  nc_func2(ncplot_options_maxchannels);
+  nc_func2(ncplot_options_minchannels);
+  nc_func2(ncplot_options_legendstyle);
+  nc_func2(ncplot_options_gridtype);
+  nc_func2(ncplot_options_rangex);
+  nc_func2(ncplot_options_flags);
+
+  nc_func(ncuplot_create, 4, 0, false);
+  nc_func(ncdplot_create, 4, 0, false);
+  nc_func(ncuplot_plane, 1, 0, false);
+  nc_func(ncdplot_plane, 1, 0, false);
+  nc_func(ncuplot_destroy, 1, 0, false);
+  nc_func(ncdplot_destroy, 1, 0, false);
+  nc_func(ncuplot_add_sample, 3, 0, false);
+  nc_func(ncdplot_add_sample, 3, 0, false);
+  nc_func(ncuplot_set_sample, 3, 0, false);
+  nc_func(ncdplot_set_sample, 3, 0, false);
+  nc_func(ncuplot_sample, 2, 0, false);
+  nc_func(ncdplot_sample, 2, 0, false);
+
+  nc_func(ncreader_options_make, 0, 0, false);
+  nc_func(ncreader_options_free, 1, 0, false);
+  nc_func2(ncreader_options_tchannels);
+  nc_func2(ncreader_options_tattrword);
+  nc_func2(ncreader_options_flags);
+
+  nc_func(ncreader_create, 2, 0, false);
+  nc_func(ncreader_clear, 1, 0, false);
+  nc_func(ncreader_plane, 1, 0, false);
+  nc_func(ncreader_contents, 1, 0, false);
+  nc_func(ncreader_offer_input, 2, 0, false);
+  nc_func(ncreader_destroy, 2, 0, false);
+  nc_func(ncreader_move_left, 1, 0, false);
+  nc_func(ncreader_move_right, 1, 0, false);
+  nc_func(ncreader_move_up, 1, 0, false);
+  nc_func(ncreader_move_down, 1, 0, false);
+
+  nc_func(ncreel_options_make, 0, 0, false);
+  nc_func(ncreel_options_free, 1, 0, false);
+  nc_func2(ncreel_options_bordermask);
+  nc_func2(ncreel_options_borderchan);
+  nc_func2(ncreel_options_tabletmask);
+  nc_func2(ncreel_options_tabletchan);
+  nc_func2(ncreel_options_focusedchan);
+  nc_func2(ncreel_options_flags);
+
+  nc_func(ncreel_create, 3, 0, false);
+  nc_func(ncreel_plane, 1, 0, false);
+  nc_func(ncreel_tabletcount, 1, 0, false);
+  nc_func(ncreel_focused, 1, 0, false);
+  nc_func(ncreel_redraw, 1, 0, false);
+  nc_func(ncreel_next, 1, 0, false);
+  nc_func(ncreel_prev, 1, 0, false);
+  nc_func(ncreel_destroy, 1, 0, false);
+  nc_func(ncreel_del, 2, 0, false);
+  nc_func(ncreel_offer_input, 2, 0, false);
+  nc_func(nctablet_userptr, 1, 0, false);
+
+  nc_func(ncvisual_options_make, 0, 0, false);
+  nc_func(ncvisual_options_free, 1, 0, false);
+  nc_func2(ncvisual_options_n);
+  nc_func2(ncvisual_options_scaling);
+  nc_func2(ncvisual_options_y);
+  nc_func2(ncvisual_options_x);
+  nc_func2(ncvisual_options_begy);
+  nc_func2(ncvisual_options_begx);
+  nc_func2(ncvisual_options_leny);
+  nc_func2(ncvisual_options_lenx);
+  nc_func2(ncvisual_options_blitter);
+  nc_func2(ncvisual_options_flags);
+
+  nc_func(ncvisual_from_file, 1, 0, false);
+  nc_func(ncvisual_from_rgba, 4, 0, false);
+  nc_func(ncvisual_from_bgra, 4, 0, false);
+  nc_func(ncvisual_from_plane, 6, 0, false);
+  nc_func(ncvisual_destroy, 1, 0, false);
+  nc_func(ncvisual_decode, 1, 0, false);
+  nc_func(ncvisual_rotate, 2, 0, false);
+  nc_func(ncvisual_resize, 3, 0, false);
+  nc_func(ncvisual_polyfill_yx, 4, 0, false);
+  nc_func(ncvisual_set_yx, 4, 0, false);
+  nc_func(ncvisual_at_yx, 3, 0, false);
+  nc_func(ncvisual_simple_streamer, 4, 0, false);
+  nc_func(ncvisual_decode_loop, 1, 0, false);
+
+  nc_func(ncblit_rgba, 3, 0, false);
+  nc_func(ncblit_bgrx, 3, 0, false);
+
+  nc_func2(ncfdplane_options_curry);
+  nc_func2(ncfdplane_options_follow);
+  nc_func2(ncfdplane_options_flags);
+  nc_func2(ncsubproc_options_curry);
+  nc_func2(ncsubproc_options_restart_period);
+  nc_func2(ncsubproc_options_flags);
+
+  nc_func(ncfdplane_options_make, 0, 0, false);
+  nc_func(ncfdplane_options_free, 1, 0, false);
+  nc_func(ncsubproc_options_make, 0, 0, false);
+  nc_func(ncsubproc_options_free, 1, 0, false);
+  nc_func(ncfdplane_plane, 1, 0, false);
+  nc_func(ncfdplane_destroy, 1, 0, false);
+  nc_func(ncsubproc_plane, 1, 0, false);
+  nc_func(ncsubproc_destroy, 1, 0, false);
+
+  nc_func(ncstats_writeout_ns, 1, 0, false);
+  nc_func(ncstats_writeout_max_ns, 1, 0, false);
+  nc_func(ncstats_writeout_min_ns, 1, 0, false);
+  nc_func(ncmenu_item_set_status, 4, 0, false);
+  nc_func(ncmenu_mouse_selected, 3, 0, false);
+  nc_func(nctablet_plane, 1, 0, false);
+
+  nc_func(ncplane_set_styles, 2, 0, false);
+  nc_func(ncplane_on_styles, 2, 0, false);
+  nc_func(ncplane_off_styles, 2, 0, false);
+  nc_func(notcurses_stats_reset, 2, 0, false);
+  nc_func(notcurses_stats_alloc, 1, 0, false);
+  nc_func(ncplane_putnstr_aligned, 5, 0, false);
+
+  nc_int(NOTCURSES_VERNUM_MAJOR);
+  nc_int(NOTCURSES_VERNUM_MINOR);
+  nc_int(NOTCURSES_VERNUM_PATCH); /* tweak version "number" can be empty! */
+  nc_int(NOTCURSES_VERNUM_ORDERED);
+
+  ncp_move_hook = s7_eval_c_string(sc, "(make-hook 'plane 'y 'x)");
+  s7_define_constant_with_environment(sc, notcurses_let, "*ncp-move-hook*", ncp_move_hook);
+  ncp_resize_hook = s7_eval_c_string(sc, "(make-hook 'rows 'cols)");
+  s7_define_constant_with_environment(sc, notcurses_let, "*ncp-resize-hook*", ncp_resize_hook);
+
+  s7_set_shadow_rootlet(sc, old_shadow);
+}
+
+#if 0
+/* gcc -fPIC -c notcurses_s7.c
+ * gcc notcurses_s7.o -shared -o notcurses_s7.so -lnotcurses-core
+ * repl
+ *   > (load "notcurses_s7.so" (inlet 'init_func 'notcurses_s7_init))
+ *   > (notcurses_version)
+ * repl make-nrepl-bits.scm
+ */
+#endif
+
diff --git a/s7/nrepl-bits.h b/s7/nrepl-bits.h
new file mode 100644
index 0000000..58fcacc
--- /dev/null
+++ b/s7/nrepl-bits.h
@@ -0,0 +1,1753 @@
+/* created by make-nrepl-bits.scm reading nrepl.scm */
+unsigned char nrepl_scm[] = {
+  0x3b, 0x3b, 0x3b, 0x20, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x2e, 0x73, 0x63, 0x6d, 0x20, 0x2d, 0x2d, 0x20, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x2d, 0x62, 0x61, 0x73, 0x65, 0x64, 0x20, 0x72, 0x65, 0x70, 0x6c, 0xa, 
+  0xa, 
+  0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x2a, 0x73, 0x37, 0x2a, 0x20, 0x27, 0x68, 0x69, 0x73, 0x74, 0x6f, 0x72, 0x79, 0x2d, 0x65, 0x6e, 0x61, 0x62, 0x6c, 0x65, 0x64, 0x29, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x28, 0x70, 0x72, 0x6f, 0x76, 0x69, 0x64, 0x65, 0x20, 0x27, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x2e, 0x73, 0x63, 0x6d, 0x29, 0xa, 
+  0xa, 
+  0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x6c, 0x69, 0x62, 0x63, 0x2d, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x64, 0x3f, 0x20, 0x27, 0x2a, 0x6e, 0x6c, 0x69, 0x62, 0x63, 0x2a, 0x29, 0x20, 0x3b, 0x20, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x2e, 0x63, 0x20, 0x68, 0x61, 0x73, 0x20, 0x74, 0x68, 0x65, 0x20, 0x70, 0x61, 0x72, 0x74, 0x73, 0x20, 0x6f, 0x66, 0x20, 0x2a, 0x6c, 0x69, 0x62, 0x63, 0x2a, 0x20, 0x77, 0x65, 0x20, 0x6e, 0x65, 0x65, 0x64, 0x20, 0x75, 0x6e, 0x64, 0x65, 0x72, 0x20, 0x74, 0x68, 0x65, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x2a, 0x6e, 0x6c, 0x69, 0x62, 0x63, 0x2a, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x2a, 0x6e, 0x6c, 0x69, 0x62, 0x63, 0x2a, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x62, 0x65, 0x67, 0x69, 0x6e, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x72, 0x65, 0x71, 0x75, 0x69, 0x72, 0x65, 0x20, 0x6c, 0x69, 0x62, 0x63, 0x2e, 0x73, 0x63, 0x6d, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x2a, 0x6c, 0x69, 0x62, 0x63, 0x2a, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x28, 0x75, 0x6e, 0x6c, 0x65, 0x73, 0x73, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x64, 0x3f, 0x20, 0x27, 0x2a, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x2a, 0x29, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x2e, 0x63, 0x20, 0x68, 0x61, 0x73, 0x20, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x73, 0x37, 0x2e, 0x63, 0x20, 0x28, 0x74, 0x68, 0x75, 0x73, 0x20, 0x2a, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x2a, 0x29, 0x20, 0x62, 0x75, 0x69, 0x6c, 0x74, 0x2d, 0x69, 0x6e, 0xa, 
+  0x20, 0x20, 0x28, 0x6c, 0x6f, 0x61, 0x64, 0x20, 0x22, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x73, 0x37, 0x2e, 0x73, 0x6f, 0x22, 0x20, 0x28, 0x69, 0x6e, 0x6c, 0x65, 0x74, 0x20, 0x27, 0x69, 0x6e, 0x69, 0x74, 0x5f, 0x66, 0x75, 0x6e, 0x63, 0x20, 0x27, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x73, 0x37, 0x5f, 0x69, 0x6e, 0x69, 0x74, 0x29, 0x29, 0x29, 0xa, 
+  0x28, 0x75, 0x6e, 0x6c, 0x65, 0x73, 0x73, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x64, 0x3f, 0x20, 0x27, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x67, 0x65, 0x74, 0x63, 0x29, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x67, 0x65, 0x74, 0x63, 0x20, 0x61, 0x20, 0x62, 0x20, 0x63, 0x20, 0x64, 0x29, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x67, 0x65, 0x74, 0x20, 0x61, 0x20, 0x62, 0x20, 0x64, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x64, 0x72, 0x6f, 0x70, 0x2d, 0x69, 0x6e, 0x74, 0x6f, 0x2d, 0x72, 0x65, 0x70, 0x6c, 0x20, 0x63, 0x61, 0x6c, 0x6c, 0x20, 0x65, 0x29, 0xa, 
+  0x20, 0x20, 0x28, 0x28, 0x2a, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x2a, 0x20, 0x27, 0x72, 0x75, 0x6e, 0x29, 0x20, 0x22, 0x62, 0x72, 0x65, 0x61, 0x6b, 0x3e, 0x22, 0x20, 0x28, 0x6f, 0x62, 0x6a, 0x65, 0x63, 0x74, 0x2d, 0x3e, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x63, 0x61, 0x6c, 0x6c, 0x29, 0x20, 0x65, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x64, 0x65, 0x62, 0x75, 0x67, 0x2d, 0x69, 0x6e, 0x66, 0x6f, 0x20, 0x63, 0x69, 0x6e, 0x74, 0x29, 0x20, 0x23, 0x66, 0x29, 0x20, 0x3b, 0x20, 0x72, 0x65, 0x70, 0x6c, 0x61, 0x63, 0x65, 0x64, 0x20, 0x6c, 0x61, 0x74, 0x65, 0x72, 0xa, 
+  0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x72, 0x65, 0x6d, 0x6f, 0x76, 0x65, 0x2d, 0x77, 0x61, 0x74, 0x63, 0x68, 0x65, 0x72, 0x20, 0x76, 0x61, 0x72, 0x29, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x2d, 0x6c, 0x6f, 0x6f, 0x6b, 0x75, 0x70, 0x20, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x29, 0x20, 0x28, 0x28, 0x28, 0x2a, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x2a, 0x20, 0x27, 0x74, 0x6f, 0x70, 0x2d, 0x6c, 0x65, 0x76, 0x65, 0x6c, 0x2d, 0x6c, 0x65, 0x74, 0x29, 0x20, 0x27, 0x72, 0x75, 0x6e, 0x2d, 0x6c, 0x65, 0x74, 0x29, 0x20, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x64, 0x65, 0x62, 0x75, 0x67, 0x2e, 0x73, 0x63, 0x6d, 0x2d, 0x69, 0x6e, 0x69, 0x74, 0x29, 0xa, 
+  0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x64, 0x65, 0x62, 0x75, 0x67, 0x2d, 0x72, 0x65, 0x70, 0x6c, 0x29, 0xa, 
+  0x9, 0x64, 0x72, 0x6f, 0x70, 0x2d, 0x69, 0x6e, 0x74, 0x6f, 0x2d, 0x72, 0x65, 0x70, 0x6c, 0x29, 0xa, 
+  0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x64, 0x65, 0x62, 0x75, 0x67, 0x2d, 0x70, 0x6f, 0x72, 0x74, 0x29, 0xa, 
+  0x9, 0x28, 0x6f, 0x70, 0x65, 0x6e, 0x2d, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0x2d, 0x66, 0x75, 0x6e, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x64, 0x65, 0x62, 0x75, 0x67, 0x2d, 0x69, 0x6e, 0x66, 0x6f, 0x29, 0x29, 0xa, 
+  0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x68, 0x6f, 0x6f, 0x6b, 0x2d, 0x66, 0x75, 0x6e, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x73, 0x20, 0x28, 0x28, 0x66, 0x75, 0x6e, 0x63, 0x6c, 0x65, 0x74, 0x20, 0x74, 0x72, 0x61, 0x63, 0x65, 0x2d, 0x69, 0x6e, 0x29, 0x20, 0x27, 0x2a, 0x64, 0x65, 0x62, 0x75, 0x67, 0x2d, 0x75, 0x6e, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x68, 0x6f, 0x6f, 0x6b, 0x2a, 0x29, 0x29, 0xa, 
+  0x9, 0x28, 0x6c, 0x69, 0x73, 0x74, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x68, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x72, 0x65, 0x6d, 0x6f, 0x76, 0x65, 0x2d, 0x77, 0x61, 0x74, 0x63, 0x68, 0x65, 0x72, 0x20, 0x28, 0x68, 0x20, 0x27, 0x76, 0x61, 0x72, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x6f, 0x6c, 0x64, 0x2d, 0x64, 0x65, 0x62, 0x75, 0x67, 0x20, 0x28, 0x2a, 0x73, 0x37, 0x2a, 0x20, 0x27, 0x64, 0x65, 0x62, 0x75, 0x67, 0x29, 0x29, 0xa, 
+  0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x2a, 0x73, 0x37, 0x2a, 0x20, 0x27, 0x64, 0x65, 0x62, 0x75, 0x67, 0x29, 0x20, 0x30, 0x29, 0xa, 
+  0xa, 
+  0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x73, 0x74, 0x61, 0x72, 0x74, 0x75, 0x70, 0x2d, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x63, 0x6f, 0x70, 0x79, 0x20, 0x28, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x2d, 0x74, 0x61, 0x62, 0x6c, 0x65, 0x29, 0x29, 0x29, 0xa, 
+  0x3b, 0x28, 0x61, 0x75, 0x74, 0x6f, 0x6c, 0x6f, 0x61, 0x64, 0x20, 0x27, 0x6c, 0x69, 0x6e, 0x74, 0x20, 0x22, 0x6c, 0x69, 0x6e, 0x74, 0x2e, 0x73, 0x63, 0x6d, 0x22, 0x29, 0xa, 
+  0x28, 0x72, 0x65, 0x71, 0x75, 0x69, 0x72, 0x65, 0x20, 0x6c, 0x69, 0x6e, 0x74, 0x2e, 0x73, 0x63, 0x6d, 0x29, 0xa, 
+  0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x77, 0x69, 0x74, 0x68, 0x2d, 0x6c, 0x69, 0x6e, 0x74, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x64, 0x3f, 0x20, 0x27, 0x2a, 0x6c, 0x69, 0x6e, 0x74, 0x2a, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x6d, 0x61, 0x79, 0x62, 0x65, 0x20, 0x72, 0x65, 0x71, 0x75, 0x69, 0x72, 0x65, 0x20, 0x73, 0x68, 0x6f, 0x75, 0x6c, 0x64, 0x20, 0x72, 0x65, 0x74, 0x75, 0x72, 0x6e, 0x20, 0x23, 0x66, 0x20, 0x69, 0x66, 0x20, 0x6e, 0x6f, 0x20, 0x6c, 0x75, 0x63, 0x6b, 0x3f, 0x20, 0x28, 0x6f, 0x72, 0x20, 0x61, 0x20, 0x6c, 0x69, 0x73, 0x74, 0x20, 0x73, 0x69, 0x6e, 0x63, 0x65, 0x20, 0x69, 0x74, 0x20, 0x74, 0x61, 0x6b, 0x65, 0x73, 0x20, 0x61, 0x6e, 0x79, 0x20, 0x6e, 0x75, 0x6d, 0x62, 0x65, 0x72, 0x20, 0x6f, 0x66, 0x20, 0x61, 0x72, 0x67, 0x73, 0x29, 0x2c, 0x20, 0x6f, 0x72, 0x20, 0x61, 0x6e, 0x20, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x3f, 0x3f, 0xa, 
+  0xa, 
+  0x28, 0x61, 0x75, 0x74, 0x6f, 0x6c, 0x6f, 0x61, 0x64, 0x20, 0x27, 0x70, 0x72, 0x65, 0x74, 0x74, 0x79, 0x2d, 0x70, 0x72, 0x69, 0x6e, 0x74, 0x20, 0x22, 0x77, 0x72, 0x69, 0x74, 0x65, 0x2e, 0x73, 0x63, 0x6d, 0x22, 0x29, 0xa, 
+  0x28, 0x61, 0x75, 0x74, 0x6f, 0x6c, 0x6f, 0x61, 0x64, 0x20, 0x27, 0x70, 0x70, 0x20, 0x22, 0x77, 0x72, 0x69, 0x74, 0x65, 0x2e, 0x73, 0x63, 0x6d, 0x22, 0x29, 0xa, 
+  0x28, 0x61, 0x75, 0x74, 0x6f, 0x6c, 0x6f, 0x61, 0x64, 0x20, 0x27, 0x2a, 0x6c, 0x69, 0x62, 0x63, 0x2a, 0x20, 0x22, 0x6c, 0x69, 0x62, 0x63, 0x2e, 0x73, 0x63, 0x6d, 0x22, 0x29, 0xa, 
+  0x28, 0x61, 0x75, 0x74, 0x6f, 0x6c, 0x6f, 0x61, 0x64, 0x20, 0x27, 0x2a, 0x6c, 0x69, 0x62, 0x6d, 0x2a, 0x20, 0x22, 0x6c, 0x69, 0x62, 0x6d, 0x2e, 0x73, 0x63, 0x6d, 0x22, 0x29, 0xa, 
+  0x28, 0x61, 0x75, 0x74, 0x6f, 0x6c, 0x6f, 0x61, 0x64, 0x20, 0x27, 0x2a, 0x6c, 0x69, 0x62, 0x67, 0x73, 0x6c, 0x2a, 0x20, 0x22, 0x6c, 0x69, 0x62, 0x67, 0x73, 0x6c, 0x2e, 0x73, 0x63, 0x6d, 0x22, 0x29, 0xa, 
+  0x28, 0x61, 0x75, 0x74, 0x6f, 0x6c, 0x6f, 0x61, 0x64, 0x20, 0x27, 0x74, 0x72, 0x61, 0x63, 0x65, 0x20, 0x22, 0x64, 0x65, 0x62, 0x75, 0x67, 0x2e, 0x73, 0x63, 0x6d, 0x22, 0x29, 0xa, 
+  0x28, 0x61, 0x75, 0x74, 0x6f, 0x6c, 0x6f, 0x61, 0x64, 0x20, 0x27, 0x75, 0x6e, 0x74, 0x72, 0x61, 0x63, 0x65, 0x20, 0x22, 0x64, 0x65, 0x62, 0x75, 0x67, 0x2e, 0x73, 0x63, 0x6d, 0x22, 0x29, 0xa, 
+  0x28, 0x61, 0x75, 0x74, 0x6f, 0x6c, 0x6f, 0x61, 0x64, 0x20, 0x27, 0x62, 0x72, 0x65, 0x61, 0x6b, 0x20, 0x22, 0x64, 0x65, 0x62, 0x75, 0x67, 0x2e, 0x73, 0x63, 0x6d, 0x22, 0x29, 0xa, 
+  0x28, 0x61, 0x75, 0x74, 0x6f, 0x6c, 0x6f, 0x61, 0x64, 0x20, 0x27, 0x75, 0x6e, 0x62, 0x72, 0x65, 0x61, 0x6b, 0x20, 0x22, 0x64, 0x65, 0x62, 0x75, 0x67, 0x2e, 0x73, 0x63, 0x6d, 0x22, 0x29, 0xa, 
+  0x28, 0x61, 0x75, 0x74, 0x6f, 0x6c, 0x6f, 0x61, 0x64, 0x20, 0x27, 0x77, 0x61, 0x74, 0x63, 0x68, 0x20, 0x22, 0x64, 0x65, 0x62, 0x75, 0x67, 0x2e, 0x73, 0x63, 0x6d, 0x22, 0x29, 0xa, 
+  0x28, 0x61, 0x75, 0x74, 0x6f, 0x6c, 0x6f, 0x61, 0x64, 0x20, 0x27, 0x75, 0x6e, 0x77, 0x61, 0x74, 0x63, 0x68, 0x20, 0x22, 0x64, 0x65, 0x62, 0x75, 0x67, 0x2e, 0x73, 0x63, 0x6d, 0x22, 0x29, 0xa, 
+  0x28, 0x61, 0x75, 0x74, 0x6f, 0x6c, 0x6f, 0x61, 0x64, 0x20, 0x27, 0x6f, 0x77, 0x21, 0x20, 0x22, 0x73, 0x74, 0x75, 0x66, 0x66, 0x2e, 0x73, 0x63, 0x6d, 0x22, 0x29, 0xa, 
+  0x28, 0x61, 0x75, 0x74, 0x6f, 0x6c, 0x6f, 0x61, 0x64, 0x20, 0x27, 0x73, 0x68, 0x6f, 0x77, 0x2d, 0x70, 0x72, 0x6f, 0x66, 0x69, 0x6c, 0x65, 0x20, 0x22, 0x70, 0x72, 0x6f, 0x66, 0x69, 0x6c, 0x65, 0x2e, 0x73, 0x63, 0x6d, 0x22, 0x29, 0xa, 
+  0x28, 0x61, 0x75, 0x74, 0x6f, 0x6c, 0x6f, 0x61, 0x64, 0x20, 0x27, 0x70, 0x72, 0x6f, 0x66, 0x69, 0x6c, 0x65, 0x2d, 0x70, 0x6f, 0x72, 0x74, 0x20, 0x22, 0x70, 0x72, 0x6f, 0x66, 0x69, 0x6c, 0x65, 0x2e, 0x73, 0x63, 0x6d, 0x22, 0x29, 0xa, 
+  0xa, 
+  0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x66, 0x69, 0x6c, 0x65, 0x2d, 0x65, 0x78, 0x69, 0x73, 0x74, 0x73, 0x3f, 0x20, 0x22, 0x2e, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x22, 0x29, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x6c, 0x6f, 0x63, 0x61, 0x6c, 0x20, 0x28, 0x73, 0x63, 0x68, 0x65, 0x6d, 0x65, 0x29, 0x20, 0x69, 0x6e, 0x69, 0x74, 0x69, 0x61, 0x6c, 0x69, 0x7a, 0x61, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x66, 0x69, 0x6c, 0x65, 0x20, 0x66, 0x6f, 0x72, 0x20, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0xa, 
+  0x20, 0x20, 0x28, 0x6c, 0x6f, 0x61, 0x64, 0x20, 0x22, 0x2e, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x22, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x3b, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x64, 0x62, 0x73, 0x74, 0x72, 0x20, 0x22, 0x22, 0x29, 0xa, 
+  0xa, 
+  0x28, 0x75, 0x6e, 0x6c, 0x65, 0x73, 0x73, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x64, 0x3f, 0x20, 0x27, 0x2a, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x2a, 0x29, 0xa, 
+  0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x2a, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x2a, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x2a, 0x20, 0x28, 0x28, 0x6e, 0x63, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x28, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x33, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x28, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x28, 0x76, 0x65, 0x63, 0x74, 0x6f, 0x72, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x28, 0x73, 0x74, 0x61, 0x74, 0x70, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x28, 0x73, 0x74, 0x61, 0x74, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x28, 0x72, 0x65, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x28, 0x74, 0x6f, 0x70, 0x2d, 0x6c, 0x65, 0x76, 0x65, 0x6c, 0x2d, 0x6c, 0x65, 0x74, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x75, 0x62, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x72, 0x6f, 0x6f, 0x74, 0x6c, 0x65, 0x74, 0x29, 0x20, 0x3b, 0x20, 0x65, 0x6e, 0x76, 0x69, 0x72, 0x6f, 0x6e, 0x6d, 0x65, 0x6e, 0x74, 0x20, 0x69, 0x6e, 0x20, 0x77, 0x68, 0x69, 0x63, 0x68, 0x20, 0x65, 0x76, 0x61, 0x6c, 0x75, 0x61, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x74, 0x61, 0x6b, 0x65, 0x73, 0x20, 0x70, 0x6c, 0x61, 0x63, 0x65, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3a, 0x68, 0x69, 0x73, 0x74, 0x6f, 0x72, 0x79, 0x20, 0x23, 0x66, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x73, 0x65, 0x74, 0x20, 0x62, 0x65, 0x6c, 0x6f, 0x77, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3a, 0x6e, 0x63, 0x70, 0x2d, 0x6c, 0x65, 0x74, 0x20, 0x23, 0x66, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3a, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x20, 0x23, 0x66, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3a, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x74, 0x65, 0x78, 0x74, 0x20, 0x22, 0x22, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3a, 0x72, 0x75, 0x6e, 0x2d, 0x6c, 0x65, 0x74, 0x20, 0x23, 0x66, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3a, 0x73, 0x37, 0x2d, 0x76, 0x65, 0x72, 0x73, 0x69, 0x6f, 0x6e, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x29, 0x20, 0x28, 0x2a, 0x73, 0x37, 0x2a, 0x20, 0x27, 0x76, 0x65, 0x72, 0x73, 0x69, 0x6f, 0x6e, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3a, 0x65, 0x78, 0x69, 0x74, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x2b, 0x64, 0x6f, 0x63, 0x75, 0x6d, 0x65, 0x6e, 0x74, 0x61, 0x74, 0x69, 0x6f, 0x6e, 0x2b, 0x20, 0x22, 0x28, 0x65, 0x78, 0x69, 0x74, 0x29, 0x20, 0x73, 0x74, 0x6f, 0x70, 0x73, 0x20, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x20, 0x61, 0x6e, 0x64, 0x20, 0x74, 0x68, 0x65, 0x6e, 0x20, 0x63, 0x61, 0x6c, 0x6c, 0x73, 0x20, 0x23, 0x5f, 0x65, 0x78, 0x69, 0x74, 0x22, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x2d, 0x74, 0x65, 0x6d, 0x70, 0x6f, 0x72, 0x61, 0x72, 0x69, 0x6c, 0x79, 0x20, 0x28, 0x28, 0x28, 0x2a, 0x73, 0x37, 0x2a, 0x20, 0x27, 0x64, 0x65, 0x62, 0x75, 0x67, 0x29, 0x20, 0x30, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x73, 0x74, 0x6f, 0x70, 0x20, 0x28, 0x2a, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x2a, 0x20, 0x27, 0x6e, 0x63, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x23, 0x5f, 0x65, 0x78, 0x69, 0x74, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3a, 0x74, 0x69, 0x6d, 0x65, 0x20, 0x28, 0x6d, 0x61, 0x63, 0x72, 0x6f, 0x20, 0x28, 0x65, 0x78, 0x70, 0x72, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x60, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x73, 0x74, 0x61, 0x72, 0x74, 0x20, 0x28, 0x2a, 0x73, 0x37, 0x2a, 0x20, 0x27, 0x63, 0x70, 0x75, 0x2d, 0x74, 0x69, 0x6d, 0x65, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x2c, 0x65, 0x78, 0x70, 0x72, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x2a, 0x73, 0x37, 0x2a, 0x20, 0x27, 0x63, 0x70, 0x75, 0x2d, 0x74, 0x69, 0x6d, 0x65, 0x29, 0x20, 0x73, 0x74, 0x61, 0x72, 0x74, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3a, 0x77, 0x69, 0x74, 0x68, 0x2d, 0x70, 0x72, 0x6f, 0x66, 0x69, 0x6c, 0x65, 0x20, 0x28, 0x6d, 0x61, 0x63, 0x72, 0x6f, 0x20, 0x62, 0x6f, 0x64, 0x79, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x60, 0x28, 0x6c, 0x65, 0x74, 0x2d, 0x74, 0x65, 0x6d, 0x70, 0x6f, 0x72, 0x61, 0x72, 0x69, 0x6c, 0x79, 0x20, 0x28, 0x28, 0x28, 0x2a, 0x73, 0x37, 0x2a, 0x20, 0x27, 0x70, 0x72, 0x6f, 0x66, 0x69, 0x6c, 0x65, 0x29, 0x20, 0x31, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x28, 0x70, 0x72, 0x6f, 0x66, 0x69, 0x6c, 0x65, 0x2d, 0x70, 0x6f, 0x72, 0x74, 0x29, 0x20, 0x28, 0x6f, 0x70, 0x65, 0x6e, 0x2d, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x2c, 0x40, 0x62, 0x6f, 0x64, 0x79, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x73, 0x68, 0x6f, 0x77, 0x2d, 0x70, 0x72, 0x6f, 0x66, 0x69, 0x6c, 0x65, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x63, 0x6c, 0x65, 0x61, 0x72, 0x2d, 0x70, 0x72, 0x6f, 0x66, 0x69, 0x6c, 0x65, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x67, 0x65, 0x74, 0x2d, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x70, 0x72, 0x6f, 0x66, 0x69, 0x6c, 0x65, 0x2d, 0x70, 0x6f, 0x72, 0x74, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x74, 0x68, 0x65, 0x20, 0x70, 0x72, 0x6f, 0x66, 0x69, 0x6c, 0x65, 0x72, 0x20, 0x68, 0x61, 0x73, 0x20, 0x74, 0x6f, 0x20, 0x62, 0x65, 0x20, 0x6f, 0x6e, 0x20, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x74, 0x68, 0x65, 0x20, 0x74, 0x6f, 0x2d, 0x62, 0x65, 0x2d, 0x70, 0x72, 0x6f, 0x66, 0x69, 0x6c, 0x65, 0x64, 0x20, 0x66, 0x75, 0x6e, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x73, 0x20, 0x61, 0x72, 0x65, 0x20, 0x6c, 0x6f, 0x61, 0x64, 0x65, 0x64, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3a, 0x61, 0x70, 0x72, 0x6f, 0x70, 0x6f, 0x73, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x6c, 0x65, 0x76, 0x65, 0x6e, 0x73, 0x68, 0x74, 0x65, 0x69, 0x6e, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x73, 0x31, 0x20, 0x73, 0x32, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x4c, 0x31, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x73, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x4c, 0x32, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x73, 0x32, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x28, 0x63, 0x6f, 0x6e, 0x64, 0x20, 0x28, 0x28, 0x7a, 0x65, 0x72, 0x6f, 0x3f, 0x20, 0x4c, 0x31, 0x29, 0x20, 0x4c, 0x32, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x7a, 0x65, 0x72, 0x6f, 0x3f, 0x20, 0x4c, 0x32, 0x29, 0x20, 0x4c, 0x31, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x65, 0x6c, 0x73, 0x65, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x64, 0x69, 0x73, 0x74, 0x61, 0x6e, 0x63, 0x65, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x76, 0x65, 0x63, 0x74, 0x6f, 0x72, 0x20, 0x28, 0x6c, 0x69, 0x73, 0x74, 0x20, 0x28, 0x2b, 0x20, 0x4c, 0x32, 0x20, 0x31, 0x29, 0x20, 0x28, 0x2b, 0x20, 0x4c, 0x31, 0x20, 0x31, 0x29, 0x29, 0x20, 0x30, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x69, 0x20, 0x30, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x28, 0x3e, 0x20, 0x69, 0x20, 0x4c, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x64, 0x69, 0x73, 0x74, 0x61, 0x6e, 0x63, 0x65, 0x20, 0x30, 0x20, 0x69, 0x29, 0x20, 0x69, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x69, 0x20, 0x30, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x28, 0x3e, 0x20, 0x69, 0x20, 0x4c, 0x32, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x64, 0x69, 0x73, 0x74, 0x61, 0x6e, 0x63, 0x65, 0x20, 0x69, 0x20, 0x30, 0x29, 0x20, 0x69, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x69, 0x20, 0x31, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x28, 0x3e, 0x20, 0x69, 0x20, 0x4c, 0x32, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x6a, 0x20, 0x31, 0x20, 0x28, 0x2b, 0x20, 0x6a, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x3e, 0x20, 0x6a, 0x20, 0x4c, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x63, 0x31, 0x20, 0x28, 0x2b, 0x20, 0x28, 0x64, 0x69, 0x73, 0x74, 0x61, 0x6e, 0x63, 0x65, 0x20, 0x69, 0x20, 0x28, 0x2d, 0x20, 0x6a, 0x20, 0x31, 0x29, 0x29, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x63, 0x32, 0x20, 0x28, 0x2b, 0x20, 0x28, 0x64, 0x69, 0x73, 0x74, 0x61, 0x6e, 0x63, 0x65, 0x20, 0x28, 0x2d, 0x20, 0x69, 0x20, 0x31, 0x29, 0x20, 0x6a, 0x29, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x63, 0x33, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x3d, 0x3f, 0x20, 0x28, 0x73, 0x32, 0x20, 0x28, 0x2d, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x20, 0x28, 0x73, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x6a, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x64, 0x69, 0x73, 0x74, 0x61, 0x6e, 0x63, 0x65, 0x20, 0x28, 0x2d, 0x20, 0x69, 0x20, 0x31, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x6a, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x2b, 0x20, 0x28, 0x64, 0x69, 0x73, 0x74, 0x61, 0x6e, 0x63, 0x65, 0x20, 0x28, 0x2d, 0x20, 0x69, 0x20, 0x31, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x6a, 0x20, 0x31, 0x29, 0x29, 0x20, 0x31, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x64, 0x69, 0x73, 0x74, 0x61, 0x6e, 0x63, 0x65, 0x20, 0x69, 0x20, 0x6a, 0x29, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x63, 0x31, 0x20, 0x63, 0x32, 0x20, 0x63, 0x33, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x69, 0x73, 0x74, 0x61, 0x6e, 0x63, 0x65, 0x20, 0x4c, 0x32, 0x20, 0x4c, 0x31, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x66, 0x75, 0x6c, 0x6c, 0x2d, 0x6c, 0x65, 0x74, 0x2d, 0x69, 0x74, 0x65, 0x72, 0x61, 0x74, 0x6f, 0x72, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x77, 0x61, 0x6c, 0x6b, 0x20, 0x74, 0x68, 0x65, 0x20, 0x65, 0x6e, 0x74, 0x69, 0x72, 0x65, 0x20, 0x6c, 0x65, 0x74, 0x20, 0x63, 0x68, 0x61, 0x69, 0x6e, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x2a, 0x20, 0x28, 0x6c, 0x74, 0x20, 0x28, 0x73, 0x74, 0x6f, 0x70, 0x20, 0x28, 0x72, 0x6f, 0x6f, 0x74, 0x6c, 0x65, 0x74, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x65, 0x71, 0x3f, 0x20, 0x73, 0x74, 0x6f, 0x70, 0x20, 0x6c, 0x74, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x69, 0x74, 0x65, 0x72, 0x61, 0x74, 0x6f, 0x72, 0x20, 0x6c, 0x74, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x72, 0x65, 0x63, 0x20, 0x28, 0x28, 0x69, 0x74, 0x65, 0x72, 0x6c, 0x6f, 0x6f, 0x70, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x69, 0x74, 0x65, 0x72, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x69, 0x74, 0x65, 0x72, 0x61, 0x74, 0x6f, 0x72, 0x20, 0x6c, 0x74, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x2b, 0x69, 0x74, 0x65, 0x72, 0x61, 0x74, 0x6f, 0x72, 0x2b, 0x20, 0x23, 0x74, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x72, 0x65, 0x73, 0x75, 0x6c, 0x74, 0x20, 0x28, 0x69, 0x74, 0x65, 0x72, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x65, 0x6f, 0x66, 0x2d, 0x6f, 0x62, 0x6a, 0x65, 0x63, 0x74, 0x3f, 0x20, 0x72, 0x65, 0x73, 0x75, 0x6c, 0x74, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x74, 0x65, 0x72, 0x61, 0x74, 0x6f, 0x72, 0x2d, 0x61, 0x74, 0x2d, 0x65, 0x6e, 0x64, 0x3f, 0x20, 0x69, 0x74, 0x65, 0x72, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x28, 0x65, 0x71, 0x3f, 0x20, 0x73, 0x74, 0x6f, 0x70, 0x20, 0x28, 0x69, 0x74, 0x65, 0x72, 0x61, 0x74, 0x6f, 0x72, 0x2d, 0x73, 0x65, 0x71, 0x75, 0x65, 0x6e, 0x63, 0x65, 0x20, 0x69, 0x74, 0x65, 0x72, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x62, 0x65, 0x67, 0x69, 0x6e, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x69, 0x74, 0x65, 0x72, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x69, 0x74, 0x65, 0x72, 0x61, 0x74, 0x6f, 0x72, 0x20, 0x28, 0x6f, 0x75, 0x74, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x69, 0x74, 0x65, 0x72, 0x61, 0x74, 0x6f, 0x72, 0x2d, 0x73, 0x65, 0x71, 0x75, 0x65, 0x6e, 0x63, 0x65, 0x20, 0x69, 0x74, 0x65, 0x72, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x69, 0x74, 0x65, 0x72, 0x6c, 0x6f, 0x6f, 0x70, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x72, 0x65, 0x73, 0x75, 0x6c, 0x74, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x69, 0x74, 0x65, 0x72, 0x61, 0x74, 0x6f, 0x72, 0x20, 0x69, 0x74, 0x65, 0x72, 0x6c, 0x6f, 0x6f, 0x70, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x2a, 0x20, 0x28, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x28, 0x65, 0x20, 0x28, 0x73, 0x75, 0x62, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x2a, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x2a, 0x20, 0x27, 0x74, 0x6f, 0x70, 0x2d, 0x6c, 0x65, 0x76, 0x65, 0x6c, 0x2d, 0x6c, 0x65, 0x74, 0x29, 0x20, 0x2a, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x2a, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x61, 0x70, 0x2d, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x3f, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x29, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x3f, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x2d, 0x3e, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x20, 0x27, 0x77, 0x72, 0x6f, 0x6e, 0x67, 0x2d, 0x74, 0x79, 0x70, 0x65, 0x2d, 0x61, 0x72, 0x67, 0x20, 0x22, 0x61, 0x70, 0x72, 0x6f, 0x70, 0x6f, 0x73, 0x20, 0x61, 0x72, 0x67, 0x75, 0x6d, 0x65, 0x6e, 0x74, 0x20, 0x31, 0x20, 0x73, 0x68, 0x6f, 0x75, 0x6c, 0x64, 0x20, 0x62, 0x65, 0x20, 0x61, 0x20, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x6f, 0x72, 0x20, 0x61, 0x20, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x22, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x61, 0x70, 0x2d, 0x65, 0x6e, 0x76, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x3f, 0x20, 0x65, 0x29, 0x20, 0x65, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x20, 0x27, 0x77, 0x72, 0x6f, 0x6e, 0x67, 0x2d, 0x74, 0x79, 0x70, 0x65, 0x2d, 0x61, 0x72, 0x67, 0x20, 0x22, 0x61, 0x70, 0x72, 0x6f, 0x70, 0x6f, 0x73, 0x20, 0x61, 0x72, 0x67, 0x75, 0x6d, 0x65, 0x6e, 0x74, 0x20, 0x32, 0x20, 0x73, 0x68, 0x6f, 0x75, 0x6c, 0x64, 0x20, 0x62, 0x65, 0x20, 0x61, 0x6e, 0x20, 0x65, 0x6e, 0x76, 0x69, 0x72, 0x6f, 0x6e, 0x6d, 0x65, 0x6e, 0x74, 0x22, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x73, 0x74, 0x72, 0x73, 0x20, 0x28, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x32, 0x20, 0x28, 0x66, 0x6c, 0x6f, 0x6f, 0x72, 0x20, 0x28, 0x6c, 0x6f, 0x67, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x61, 0x70, 0x2d, 0x6e, 0x61, 0x6d, 0x65, 0x29, 0x20, 0x32, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x2d, 0x65, 0x61, 0x63, 0x68, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x62, 0x69, 0x6e, 0x64, 0x69, 0x6e, 0x67, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x70, 0x61, 0x69, 0x72, 0x3f, 0x20, 0x62, 0x69, 0x6e, 0x64, 0x69, 0x6e, 0x67, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x2d, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x28, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x2d, 0x3e, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x62, 0x69, 0x6e, 0x64, 0x69, 0x6e, 0x67, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x2d, 0x70, 0x6f, 0x73, 0x69, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x61, 0x70, 0x2d, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x2d, 0x6e, 0x61, 0x6d, 0x65, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x73, 0x74, 0x72, 0x73, 0x20, 0x28, 0x63, 0x6f, 0x6e, 0x73, 0x20, 0x28, 0x63, 0x6f, 0x6e, 0x73, 0x20, 0x62, 0x69, 0x6e, 0x64, 0x69, 0x6e, 0x67, 0x20, 0x30, 0x29, 0x20, 0x73, 0x74, 0x72, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x64, 0x69, 0x73, 0x74, 0x61, 0x6e, 0x63, 0x65, 0x20, 0x28, 0x6c, 0x65, 0x76, 0x65, 0x6e, 0x73, 0x68, 0x74, 0x65, 0x69, 0x6e, 0x20, 0x61, 0x70, 0x2d, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x2d, 0x6e, 0x61, 0x6d, 0x65, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3c, 0x20, 0x64, 0x69, 0x73, 0x74, 0x61, 0x6e, 0x63, 0x65, 0x20, 0x6d, 0x69, 0x6e, 0x32, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x73, 0x74, 0x72, 0x73, 0x20, 0x28, 0x63, 0x6f, 0x6e, 0x73, 0x20, 0x28, 0x63, 0x6f, 0x6e, 0x73, 0x20, 0x62, 0x69, 0x6e, 0x64, 0x69, 0x6e, 0x67, 0x20, 0x64, 0x69, 0x73, 0x74, 0x61, 0x6e, 0x63, 0x65, 0x29, 0x20, 0x73, 0x74, 0x72, 0x73, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x66, 0x75, 0x6c, 0x6c, 0x2d, 0x6c, 0x65, 0x74, 0x2d, 0x69, 0x74, 0x65, 0x72, 0x61, 0x74, 0x6f, 0x72, 0x20, 0x61, 0x70, 0x2d, 0x65, 0x6e, 0x76, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x28, 0x70, 0x61, 0x69, 0x72, 0x3f, 0x20, 0x73, 0x74, 0x72, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x27, 0x6e, 0x6f, 0x2d, 0x6d, 0x61, 0x74, 0x63, 0x68, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x64, 0x61, 0x74, 0x61, 0x20, 0x22, 0x22, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x6e, 0x61, 0x6d, 0x65, 0x2d, 0x6c, 0x65, 0x6e, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x2d, 0x65, 0x61, 0x63, 0x68, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x62, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x64, 0x61, 0x74, 0x61, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x2d, 0x61, 0x70, 0x70, 0x65, 0x6e, 0x64, 0x20, 0x64, 0x61, 0x74, 0x61, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3e, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x64, 0x61, 0x74, 0x61, 0x29, 0x20, 0x30, 0x29, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x23, 0x5c, 0x6e, 0x65, 0x77, 0x6c, 0x69, 0x6e, 0x65, 0x29, 0x20, 0x22, 0x22, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x70, 0x72, 0x6f, 0x63, 0x65, 0x64, 0x75, 0x72, 0x65, 0x3f, 0x20, 0x28, 0x63, 0x64, 0x61, 0x72, 0x20, 0x62, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x64, 0x6f, 0x63, 0x20, 0x28, 0x64, 0x6f, 0x63, 0x75, 0x6d, 0x65, 0x6e, 0x74, 0x61, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x28, 0x63, 0x64, 0x61, 0x72, 0x20, 0x62, 0x29, 0x29, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x72, 0x65, 0x74, 0x75, 0x72, 0x6e, 0x73, 0x20, 0x22, 0x22, 0x20, 0x69, 0x66, 0x20, 0x6e, 0x6f, 0x20, 0x64, 0x6f, 0x63, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x69, 0x66, 0x20, 0x28, 0x70, 0x6f, 0x73, 0x69, 0x74, 0x69, 0x76, 0x65, 0x3f, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x64, 0x6f, 0x63, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x64, 0x6f, 0x63, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6f, 0x62, 0x6a, 0x65, 0x63, 0x74, 0x2d, 0x3e, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x63, 0x61, 0x61, 0x72, 0x20, 0x62, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6f, 0x62, 0x6a, 0x65, 0x63, 0x74, 0x2d, 0x3e, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x63, 0x61, 0x61, 0x72, 0x20, 0x62, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x6f, 0x72, 0x74, 0x21, 0x20, 0x73, 0x74, 0x72, 0x73, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x61, 0x20, 0x62, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x3c, 0x20, 0x28, 0x63, 0x64, 0x72, 0x20, 0x61, 0x29, 0x20, 0x28, 0x63, 0x64, 0x72, 0x20, 0x62, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x3d, 0x20, 0x28, 0x63, 0x64, 0x72, 0x20, 0x61, 0x29, 0x20, 0x28, 0x63, 0x64, 0x72, 0x20, 0x62, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x3c, 0x20, 0x28, 0x61, 0x62, 0x73, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x28, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x2d, 0x3e, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x63, 0x61, 0x61, 0x72, 0x20, 0x61, 0x29, 0x29, 0x29, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x2d, 0x6c, 0x65, 0x6e, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x61, 0x62, 0x73, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x28, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x2d, 0x3e, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x63, 0x61, 0x61, 0x72, 0x20, 0x62, 0x29, 0x29, 0x29, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x2d, 0x6c, 0x65, 0x6e, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x64, 0x61, 0x74, 0x61, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x74, 0x6f, 0x20, 0x63, 0x61, 0x6c, 0x6c, 0x20, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x20, 0x66, 0x75, 0x6e, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x73, 0x20, 0x69, 0x6e, 0x20, 0x74, 0x68, 0x65, 0x20, 0x72, 0x65, 0x70, 0x6c, 0x2c, 0x20, 0x75, 0x73, 0x65, 0x20, 0x2a, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x2a, 0x20, 0x6f, 0x72, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6c, 0x65, 0x74, 0x3a, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x72, 0x65, 0x66, 0x72, 0x65, 0x73, 0x68, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x2d, 0x6c, 0x65, 0x74, 0x20, 0x27, 0x6e, 0x63, 0x29, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x74, 0x6f, 0x20, 0x63, 0x61, 0x6c, 0x6c, 0x20, 0x72, 0x75, 0x6e, 0x20, 0x77, 0x69, 0x74, 0x68, 0x69, 0x6e, 0x20, 0x72, 0x75, 0x6e, 0x3a, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x20, 0x20, 0x28, 0x28, 0x2a, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x2a, 0x20, 0x27, 0x72, 0x75, 0x6e, 0x29, 0x20, 0x22, 0x6e, 0x65, 0x77, 0x2d, 0x70, 0x72, 0x6f, 0x6d, 0x70, 0x74, 0x3e, 0x22, 0x20, 0x22, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x20, 0x69, 0x6e, 0x66, 0x6f, 0x22, 0x29, 0xa, 
+  0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x20, 0x63, 0x6f, 0x6d, 0x70, 0x6c, 0x65, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x2d, 0x63, 0x6f, 0x6d, 0x70, 0x6c, 0x65, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x74, 0x65, 0x78, 0x74, 0x29, 0xa, 
+  0x9, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x74, 0x65, 0x78, 0x74, 0x2d, 0x6c, 0x65, 0x6e, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x74, 0x65, 0x78, 0x74, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x20, 0x23, 0x66, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x28, 0x63, 0x61, 0x6c, 0x6c, 0x2d, 0x77, 0x69, 0x74, 0x68, 0x2d, 0x65, 0x78, 0x69, 0x74, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x72, 0x65, 0x74, 0x75, 0x72, 0x6e, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x2d, 0x65, 0x61, 0x63, 0x68, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x6c, 0x73, 0x74, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x66, 0x6f, 0x72, 0x2d, 0x65, 0x61, 0x63, 0x68, 0xa, 
+  0x9, 0x9, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x70, 0x61, 0x72, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x2a, 0x20, 0x28, 0x28, 0x73, 0x79, 0x6d, 0x20, 0x28, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x2d, 0x3e, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x70, 0x61, 0x72, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x79, 0x6d, 0x2d, 0x6c, 0x65, 0x6e, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x73, 0x79, 0x6d, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x3e, 0x3d, 0x20, 0x73, 0x79, 0x6d, 0x2d, 0x6c, 0x65, 0x6e, 0x20, 0x74, 0x65, 0x78, 0x74, 0x2d, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x3d, 0x3f, 0x20, 0x74, 0x65, 0x78, 0x74, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x73, 0x79, 0x6d, 0x20, 0x30, 0x20, 0x74, 0x65, 0x78, 0x74, 0x2d, 0x6c, 0x65, 0x6e, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x6d, 0x61, 0x74, 0x63, 0x68, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x6d, 0x6f, 0x72, 0x65, 0x20, 0x74, 0x68, 0x61, 0x6e, 0x20, 0x6f, 0x6e, 0x65, 0x20, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x2c, 0x20, 0x73, 0x61, 0x76, 0x65, 0x20, 0x74, 0x68, 0x65, 0x20, 0x6c, 0x6f, 0x6e, 0x67, 0x65, 0x73, 0x74, 0x20, 0x74, 0x65, 0x78, 0x74, 0x20, 0x74, 0x68, 0x61, 0x74, 0x20, 0x61, 0x6c, 0x6c, 0x20, 0x73, 0x79, 0x6d, 0x73, 0x20, 0x6d, 0x61, 0x74, 0x63, 0x68, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x6d, 0x69, 0x6e, 0x2d, 0x6c, 0x65, 0x6e, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x2d, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x29, 0x20, 0x73, 0x79, 0x6d, 0x2d, 0x6c, 0x65, 0x6e, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x69, 0x20, 0x74, 0x65, 0x78, 0x74, 0x2d, 0x6c, 0x65, 0x6e, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x3d, 0x20, 0x69, 0x20, 0x6d, 0x69, 0x6e, 0x2d, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x3d, 0x3f, 0x20, 0x28, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x20, 0x69, 0x29, 0x20, 0x28, 0x73, 0x79, 0x6d, 0x20, 0x69, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3d, 0x20, 0x6d, 0x69, 0x6e, 0x2d, 0x6c, 0x65, 0x6e, 0x20, 0x74, 0x65, 0x78, 0x74, 0x2d, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x72, 0x65, 0x74, 0x75, 0x72, 0x6e, 0x20, 0x74, 0x65, 0x78, 0x74, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x20, 0x30, 0x20, 0x69, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x20, 0x73, 0x79, 0x6d, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x6c, 0x73, 0x74, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x69, 0x73, 0x74, 0x20, 0x73, 0x74, 0x61, 0x72, 0x74, 0x75, 0x70, 0x2d, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x6d, 0x61, 0x70, 0x20, 0x63, 0x61, 0x72, 0x20, 0x74, 0x6f, 0x70, 0x2d, 0x6c, 0x65, 0x76, 0x65, 0x6c, 0x2d, 0x6c, 0x65, 0x74, 0x29, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x28, 0x75, 0x73, 0x69, 0x6e, 0x67, 0x20, 0x73, 0x74, 0x61, 0x72, 0x74, 0x75, 0x70, 0x2d, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x74, 0x6f, 0x20, 0x61, 0x76, 0x6f, 0x69, 0x64, 0x20, 0x61, 0x6c, 0x6c, 0x20, 0x74, 0x68, 0x65, 0x20, 0x6c, 0x69, 0x6e, 0x74, 0x20, 0x6a, 0x75, 0x6e, 0x6b, 0x29, 0x2c, 0x20, 0x61, 0x6e, 0x79, 0x20, 0x6f, 0x74, 0x68, 0x65, 0x72, 0x73, 0x3f, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x66, 0x69, 0x6c, 0x65, 0x6e, 0x61, 0x6d, 0x65, 0x2d, 0x63, 0x6f, 0x6d, 0x70, 0x6c, 0x65, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x74, 0x65, 0x78, 0x74, 0x29, 0xa, 
+  0x9, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x3e, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x74, 0x65, 0x78, 0x74, 0x29, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x69, 0x74, 0x68, 0x2d, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x73, 0x75, 0x62, 0x6c, 0x65, 0x74, 0x20, 0x6c, 0x69, 0x62, 0x63, 0x2d, 0x6c, 0x65, 0x74, 0x20, 0x3a, 0x74, 0x65, 0x78, 0x74, 0x20, 0x74, 0x65, 0x78, 0x74, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x67, 0x20, 0x28, 0x67, 0x6c, 0x6f, 0x62, 0x2e, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x28, 0x67, 0x6c, 0x6f, 0x62, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x2d, 0x61, 0x70, 0x70, 0x65, 0x6e, 0x64, 0x20, 0x74, 0x65, 0x78, 0x74, 0x20, 0x22, 0x2a, 0x22, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x6f, 0x67, 0x69, 0x6f, 0x72, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x64, 0x3f, 0x20, 0x27, 0x47, 0x4c, 0x4f, 0x42, 0x5f, 0x54, 0x49, 0x4c, 0x44, 0x45, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x63, 0x68, 0x61, 0x72, 0x3d, 0x3f, 0x20, 0x28, 0x74, 0x65, 0x78, 0x74, 0x20, 0x30, 0x29, 0x20, 0x23, 0x5c, 0x7e, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x47, 0x4c, 0x4f, 0x42, 0x5f, 0x54, 0x49, 0x4c, 0x44, 0x45, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x47, 0x4c, 0x4f, 0x42, 0x5f, 0x4d, 0x41, 0x52, 0x4b, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x67, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x66, 0x69, 0x6c, 0x65, 0x73, 0x20, 0x28, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x66, 0x29, 0x20, 0x3b, 0x20, 0x67, 0x65, 0x74, 0x20, 0x72, 0x69, 0x64, 0x20, 0x6f, 0x66, 0x20, 0x65, 0x6d, 0x61, 0x63, 0x73, 0x27, 0x20, 0x2a, 0x7e, 0x20, 0x66, 0x69, 0x6c, 0x65, 0x73, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x3e, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x66, 0x29, 0x20, 0x31, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x3d, 0x3f, 0x20, 0x23, 0x5c, 0x7e, 0x20, 0x28, 0x66, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x66, 0x29, 0x20, 0x31, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x76, 0x61, 0x6c, 0x75, 0x65, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x66, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x67, 0x6c, 0x6f, 0x62, 0x2e, 0x67, 0x6c, 0x5f, 0x70, 0x61, 0x74, 0x68, 0x76, 0x20, 0x67, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x67, 0x6c, 0x6f, 0x62, 0x66, 0x72, 0x65, 0x65, 0x20, 0x67, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x28, 0x6e, 0x75, 0x6c, 0x6c, 0x3f, 0x20, 0x66, 0x69, 0x6c, 0x65, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6e, 0x75, 0x6c, 0x6c, 0x3f, 0x20, 0x28, 0x63, 0x64, 0x72, 0x20, 0x66, 0x69, 0x6c, 0x65, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x63, 0x61, 0x72, 0x20, 0x66, 0x69, 0x6c, 0x65, 0x73, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x20, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x20, 0x61, 0x72, 0x65, 0x61, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0xa, 
+  0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x61, 0x72, 0x65, 0x61, 0x29, 0xa, 
+  0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x79, 0x78, 0x20, 0x73, 0x74, 0x61, 0x74, 0x70, 0x20, 0x30, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x62, 0x6f, 0x78, 0x20, 0x73, 0x74, 0x61, 0x74, 0x70, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x30, 0x29, 0x20, 0x28, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x31, 0x29, 0x20, 0x28, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x32, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x33, 0x29, 0x20, 0x28, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x34, 0x29, 0x20, 0x28, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x35, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x32, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x31, 0x29, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x79, 0x78, 0x20, 0x73, 0x74, 0x61, 0x74, 0x70, 0x20, 0x73, 0x74, 0x61, 0x74, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x72, 0x65, 0x6e, 0x64, 0x65, 0x72, 0x20, 0x6e, 0x63, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x73, 0x74, 0x61, 0x74, 0x70, 0x2d, 0x73, 0x65, 0x74, 0x2d, 0x62, 0x67, 0x2d, 0x63, 0x6f, 0x6c, 0x6f, 0x72, 0x20, 0x72, 0x20, 0x67, 0x20, 0x62, 0x29, 0xa, 
+  0x9, 0x3b, 0x3b, 0x20, 0x28, 0x73, 0x74, 0x61, 0x74, 0x70, 0x2d, 0x62, 0x67, 0x2d, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x6f, 0x72, 0x20, 0x30, 0x2e, 0x38, 0x35, 0x20, 0x30, 0x2e, 0x38, 0x35, 0x20, 0x30, 0x2e, 0x38, 0x35, 0x29, 0x3a, 0x20, 0x6c, 0x69, 0x67, 0x68, 0x74, 0x20, 0x67, 0x72, 0x61, 0x79, 0x20, 0x62, 0x61, 0x63, 0x6b, 0x67, 0x72, 0x6f, 0x75, 0x6e, 0x64, 0xa, 
+  0x9, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x63, 0x31, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x63, 0x6f, 0x6c, 0x6f, 0x72, 0x20, 0x28, 0x6c, 0x6f, 0x67, 0x69, 0x6f, 0x72, 0x20, 0x28, 0x61, 0x73, 0x68, 0x20, 0x28, 0x66, 0x6c, 0x6f, 0x6f, 0x72, 0x20, 0x28, 0x2a, 0x20, 0x72, 0x20, 0x32, 0x35, 0x36, 0x29, 0x29, 0x20, 0x31, 0x36, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x61, 0x73, 0x68, 0x20, 0x28, 0x66, 0x6c, 0x6f, 0x6f, 0x72, 0x20, 0x28, 0x2a, 0x20, 0x67, 0x20, 0x32, 0x35, 0x36, 0x29, 0x29, 0x20, 0x38, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x66, 0x6c, 0x6f, 0x6f, 0x72, 0x20, 0x28, 0x2a, 0x20, 0x62, 0x20, 0x32, 0x35, 0x36, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x67, 0x63, 0x6c, 0x75, 0x73, 0x74, 0x65, 0x72, 0x20, 0x63, 0x31, 0x29, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x63, 0x68, 0x61, 0x6e, 0x6e, 0x65, 0x6c, 0x73, 0x20, 0x63, 0x31, 0x29, 0x20, 0x28, 0x6c, 0x6f, 0x67, 0x69, 0x6f, 0x72, 0x20, 0x28, 0x61, 0x73, 0x68, 0x20, 0x4e, 0x43, 0x5f, 0x42, 0x47, 0x44, 0x45, 0x46, 0x41, 0x55, 0x4c, 0x54, 0x5f, 0x4d, 0x41, 0x53, 0x4b, 0x20, 0x33, 0x32, 0x29, 0x20, 0x4e, 0x43, 0x5f, 0x42, 0x47, 0x44, 0x45, 0x46, 0x41, 0x55, 0x4c, 0x54, 0x5f, 0x4d, 0x41, 0x53, 0x4b, 0x20, 0x63, 0x6f, 0x6c, 0x6f, 0x72, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x73, 0x74, 0x79, 0x6c, 0x65, 0x6d, 0x61, 0x73, 0x6b, 0x20, 0x63, 0x31, 0x29, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x73, 0x65, 0x74, 0x5f, 0x62, 0x61, 0x73, 0x65, 0x5f, 0x63, 0x65, 0x6c, 0x6c, 0x20, 0x73, 0x74, 0x61, 0x74, 0x70, 0x20, 0x63, 0x31, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x72, 0x65, 0x6e, 0x64, 0x65, 0x72, 0x20, 0x6e, 0x63, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x63, 0x31, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x63, 0x6c, 0x65, 0x61, 0x72, 0x2d, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x29, 0xa, 
+  0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x73, 0x74, 0x61, 0x74, 0x70, 0x20, 0x31, 0x20, 0x31, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x32, 0x29, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x20, 0x73, 0x74, 0x72, 0x29, 0xa, 
+  0x9, 0x28, 0x63, 0x6c, 0x65, 0x61, 0x72, 0x2d, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x29, 0xa, 
+  0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x73, 0x74, 0x61, 0x74, 0x70, 0x20, 0x31, 0x20, 0x32, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x73, 0x74, 0x72, 0x20, 0x30, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x73, 0x74, 0x72, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x33, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x72, 0x65, 0x6e, 0x64, 0x65, 0x72, 0x20, 0x6e, 0x63, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x74, 0x6f, 0x70, 0x2d, 0x6c, 0x65, 0x76, 0x65, 0x6c, 0x2d, 0x6c, 0x65, 0x74, 0x20, 0x27, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x29, 0x20, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x29, 0xa, 
+  0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x66, 0x69, 0x72, 0x73, 0x74, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x74, 0x65, 0x78, 0x74, 0x29, 0xa, 
+  0x9, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x70, 0x6f, 0x73, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x70, 0x6f, 0x73, 0x69, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x23, 0x5c, 0x6e, 0x65, 0x77, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x74, 0x65, 0x78, 0x74, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x70, 0x6f, 0x73, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x74, 0x65, 0x78, 0x74, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x74, 0x65, 0x78, 0x74, 0x20, 0x30, 0x20, 0x70, 0x6f, 0x73, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x20, 0x72, 0x65, 0x64, 0x20, 0x74, 0x65, 0x78, 0x74, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x72, 0x65, 0x64, 0x20, 0x63, 0x29, 0xa, 
+  0x9, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x63, 0x31, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x67, 0x63, 0x6c, 0x75, 0x73, 0x74, 0x65, 0x72, 0x20, 0x63, 0x31, 0x29, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x63, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x63, 0x68, 0x61, 0x6e, 0x6e, 0x65, 0x6c, 0x73, 0x20, 0x63, 0x31, 0x29, 0x20, 0x20, 0x28, 0x6c, 0x6f, 0x67, 0x69, 0x6f, 0x72, 0x20, 0x28, 0x61, 0x73, 0x68, 0x20, 0x4e, 0x43, 0x5f, 0x42, 0x47, 0x44, 0x45, 0x46, 0x41, 0x55, 0x4c, 0x54, 0x5f, 0x4d, 0x41, 0x53, 0x4b, 0x20, 0x33, 0x32, 0x29, 0x20, 0x23, 0x78, 0x66, 0x66, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x73, 0x74, 0x79, 0x6c, 0x65, 0x6d, 0x61, 0x73, 0x6b, 0x20, 0x63, 0x31, 0x29, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x63, 0x31, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x6e, 0x6f, 0x72, 0x6d, 0x61, 0x6c, 0x20, 0x63, 0x29, 0xa, 
+  0x9, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x63, 0x31, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x67, 0x63, 0x6c, 0x75, 0x73, 0x74, 0x65, 0x72, 0x20, 0x63, 0x31, 0x29, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x63, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x63, 0x68, 0x61, 0x6e, 0x6e, 0x65, 0x6c, 0x73, 0x20, 0x63, 0x31, 0x29, 0x20, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x73, 0x74, 0x79, 0x6c, 0x65, 0x6d, 0x61, 0x73, 0x6b, 0x20, 0x63, 0x31, 0x29, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x63, 0x31, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x72, 0x65, 0x64, 0x2d, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x76, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x76, 0x65, 0x63, 0x74, 0x6f, 0x72, 0x20, 0x35, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x76, 0x20, 0x30, 0x29, 0x20, 0x28, 0x72, 0x65, 0x64, 0x20, 0x23, 0x5c, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x76, 0x20, 0x31, 0x29, 0x20, 0x28, 0x72, 0x65, 0x64, 0x20, 0x23, 0x5c, 0x72, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x76, 0x20, 0x32, 0x29, 0x20, 0x28, 0x76, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x76, 0x20, 0x33, 0x29, 0x20, 0x28, 0x72, 0x65, 0x64, 0x20, 0x23, 0x5c, 0x6f, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x76, 0x20, 0x34, 0x29, 0x20, 0x28, 0x76, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x76, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x72, 0x65, 0x64, 0x2d, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x20, 0x28, 0x72, 0x65, 0x64, 0x20, 0x23, 0x5c, 0x28, 0x29, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x6e, 0x6f, 0x72, 0x6d, 0x61, 0x6c, 0x2d, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x20, 0x28, 0x6e, 0x6f, 0x72, 0x6d, 0x61, 0x6c, 0x20, 0x23, 0x5c, 0x28, 0x29, 0x29, 0xa, 
+  0xa, 
+  0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x20, 0x72, 0x75, 0x6e, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x2a, 0x20, 0x28, 0x72, 0x75, 0x6e, 0x20, 0x28, 0x70, 0x72, 0x6f, 0x6d, 0x70, 0x74, 0x20, 0x22, 0x3e, 0x22, 0x29, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x20, 0x28, 0x65, 0x6e, 0x76, 0x69, 0x72, 0x20, 0x28, 0x2a, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x2a, 0x20, 0x27, 0x74, 0x6f, 0x70, 0x2d, 0x6c, 0x65, 0x76, 0x65, 0x6c, 0x2d, 0x6c, 0x65, 0x74, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x30, 0x29, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x74, 0x6f, 0x70, 0x2d, 0x6c, 0x65, 0x66, 0x74, 0x20, 0x69, 0x6e, 0x20, 0x6e, 0x63, 0x70, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x31, 0x30, 0x30, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x31, 0x30, 0x30, 0x20, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x6f, 0x6c, 0x20, 0x30, 0x29, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x2d, 0x72, 0x65, 0x6c, 0x61, 0x74, 0x69, 0x76, 0x65, 0x20, 0x72, 0x6f, 0x77, 0x2f, 0x63, 0x6f, 0x6c, 0x75, 0x6d, 0x6e, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x72, 0x6f, 0x77, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x70, 0x72, 0x65, 0x76, 0x2d, 0x70, 0x61, 0x72, 0x73, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x68, 0x61, 0x73, 0x68, 0x2d, 0x74, 0x61, 0x62, 0x6c, 0x65, 0x20, 0x35, 0x31, 0x32, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6f, 0x6c, 0x64, 0x2d, 0x68, 0x69, 0x73, 0x74, 0x6f, 0x72, 0x79, 0x20, 0x28, 0x74, 0x6f, 0x70, 0x2d, 0x6c, 0x65, 0x76, 0x65, 0x6c, 0x2d, 0x6c, 0x65, 0x74, 0x20, 0x27, 0x68, 0x69, 0x73, 0x74, 0x6f, 0x72, 0x79, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x73, 0x65, 0x65, 0x20, 0x62, 0x65, 0x6c, 0x6f, 0x77, 0x2c, 0x20, 0x6f, 0x6c, 0x64, 0x20, 0x72, 0x65, 0x73, 0x74, 0x6f, 0x72, 0x65, 0x64, 0x20, 0x75, 0x70, 0x6f, 0x6e, 0x20, 0x65, 0x78, 0x69, 0x74, 0x20, 0x66, 0x72, 0x6f, 0x6d, 0x20, 0x74, 0x68, 0x69, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x68, 0x63, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x73, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x33, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x61, 0x74, 0x63, 0x68, 0x65, 0x72, 0x73, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x68, 0x61, 0x73, 0x68, 0x2d, 0x74, 0x61, 0x62, 0x6c, 0x65, 0x20, 0x38, 0x20, 0x65, 0x71, 0x3f, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x63, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x23, 0x66, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x6d, 0x6f, 0x76, 0x65, 0x2d, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x20, 0x79, 0x20, 0x78, 0x29, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x74, 0x68, 0x69, 0x73, 0x20, 0x77, 0x61, 0x73, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x2a, 0x73, 0x74, 0x64, 0x65, 0x72, 0x72, 0x2a, 0x20, 0x22, 0x7e, 0x43, 0x5b, 0x7e, 0x44, 0x3b, 0x7e, 0x44, 0x48, 0x22, 0x20, 0x23, 0x5c, 0x65, 0x73, 0x63, 0x61, 0x70, 0x65, 0x20, 0x79, 0x20, 0x78, 0x29, 0x20, 0x69, 0x6e, 0x20, 0x72, 0x65, 0x70, 0x6c, 0x2e, 0x73, 0x63, 0x6d, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x72, 0x65, 0x66, 0x72, 0x65, 0x73, 0x68, 0x20, 0x6e, 0x63, 0x29, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x6e, 0x65, 0x65, 0x64, 0x65, 0x64, 0x20, 0x69, 0x6e, 0x20, 0x31, 0x2e, 0x37, 0x2e, 0x31, 0x2c, 0x20, 0x6e, 0x6f, 0x74, 0x20, 0x69, 0x6e, 0x20, 0x31, 0x2e, 0x36, 0x2e, 0x31, 0x31, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x5f, 0x65, 0x6e, 0x61, 0x62, 0x6c, 0x65, 0x20, 0x6e, 0x63, 0x20, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2b, 0x20, 0x79, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x77, 0x63, 0x20, 0x28, 0x3d, 0x20, 0x79, 0x20, 0x28, 0x2b, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x28, 0x2d, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x29, 0x20, 0x28, 0x2b, 0x20, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x2b, 0x20, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x74, 0x6f, 0x70, 0x2d, 0x6c, 0x65, 0x76, 0x65, 0x6c, 0x2d, 0x6c, 0x65, 0x74, 0x20, 0x3a, 0x72, 0x75, 0x6e, 0x2d, 0x6c, 0x65, 0x74, 0x29, 0x20, 0x28, 0x63, 0x75, 0x72, 0x6c, 0x65, 0x74, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x28, 0x76, 0x65, 0x63, 0x74, 0x6f, 0x72, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x6e, 0x65, 0x77, 0x6c, 0x69, 0x6e, 0x65, 0x2d, 0x70, 0x6f, 0x73, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x70, 0x6f, 0x73, 0x69, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x23, 0x5c, 0x6e, 0x65, 0x77, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x6e, 0x65, 0x77, 0x6c, 0x69, 0x6e, 0x65, 0x2d, 0x70, 0x6f, 0x73, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x6c, 0x6f, 0x6f, 0x70, 0x20, 0x28, 0x28, 0x73, 0x74, 0x72, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x20, 0x28, 0x2b, 0x20, 0x6e, 0x65, 0x77, 0x6c, 0x69, 0x6e, 0x65, 0x2d, 0x70, 0x6f, 0x73, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x65, 0x77, 0x6c, 0x69, 0x6e, 0x65, 0x73, 0x20, 0x28, 0x6c, 0x69, 0x73, 0x74, 0x20, 0x28, 0x2b, 0x20, 0x6e, 0x65, 0x77, 0x6c, 0x69, 0x6e, 0x65, 0x2d, 0x70, 0x6f, 0x73, 0x20, 0x31, 0x29, 0x20, 0x30, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x70, 0x6f, 0x73, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x70, 0x6f, 0x73, 0x69, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x23, 0x5c, 0x6e, 0x65, 0x77, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x73, 0x74, 0x72, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x70, 0x6f, 0x73, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6c, 0x6f, 0x6f, 0x70, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x73, 0x74, 0x72, 0x20, 0x28, 0x2b, 0x20, 0x70, 0x6f, 0x73, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x63, 0x6f, 0x6e, 0x73, 0x20, 0x28, 0x2b, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x6e, 0x65, 0x77, 0x6c, 0x69, 0x6e, 0x65, 0x73, 0x29, 0x20, 0x70, 0x6f, 0x73, 0x20, 0x31, 0x29, 0x20, 0x6e, 0x65, 0x77, 0x6c, 0x69, 0x6e, 0x65, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x6e, 0x70, 0x6f, 0x73, 0x20, 0x28, 0x72, 0x65, 0x76, 0x65, 0x72, 0x73, 0x65, 0x20, 0x6e, 0x65, 0x77, 0x6c, 0x69, 0x6e, 0x65, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x6e, 0x6c, 0x65, 0x6e, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x6e, 0x65, 0x77, 0x6c, 0x69, 0x6e, 0x65, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x68, 0x63, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x6e, 0x65, 0x77, 0x20, 0x6e, 0x63, 0x20, 0x28, 0x2b, 0x20, 0x33, 0x20, 0x6e, 0x6c, 0x65, 0x6e, 0x29, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x30, 0x20, 0x30, 0x20, 0x28, 0x63, 0x2d, 0x70, 0x6f, 0x69, 0x6e, 0x74, 0x65, 0x72, 0x20, 0x30, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x79, 0x78, 0x20, 0x68, 0x63, 0x20, 0x30, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x5f, 0x64, 0x6f, 0x75, 0x62, 0x6c, 0x65, 0x5f, 0x62, 0x6f, 0x78, 0x20, 0x68, 0x63, 0x20, 0x30, 0x20, 0x30, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x30, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x31, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x32, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x33, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x34, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x35, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x62, 0x6f, 0x78, 0x20, 0x68, 0x63, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x30, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x31, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x32, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x33, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x34, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x35, 0x29, 0x20, 0x28, 0x2b, 0x20, 0x31, 0x20, 0x6e, 0x6c, 0x65, 0x6e, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x31, 0x29, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x73, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x76, 0x65, 0x63, 0x74, 0x6f, 0x72, 0x20, 0x6e, 0x6c, 0x65, 0x6e, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x69, 0x20, 0x30, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x68, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x20, 0x28, 0x2b, 0x20, 0x68, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x70, 0x6f, 0x73, 0x6c, 0x20, 0x6e, 0x70, 0x6f, 0x73, 0x20, 0x28, 0x63, 0x64, 0x72, 0x20, 0x70, 0x6f, 0x73, 0x6c, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x28, 0x3d, 0x20, 0x68, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x68, 0x63, 0x20, 0x68, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x35, 0x29, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x73, 0x20, 0x69, 0x29, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x70, 0x6f, 0x73, 0x6c, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x68, 0x63, 0x20, 0x68, 0x72, 0x6f, 0x77, 0x20, 0x32, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x73, 0x20, 0x69, 0x29, 0x20, 0x30, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x28, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x73, 0x20, 0x69, 0x29, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x33, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2b, 0x20, 0x33, 0x20, 0x6e, 0x6c, 0x65, 0x6e, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x68, 0x63, 0x20, 0x68, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x35, 0x29, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x73, 0x20, 0x69, 0x29, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x70, 0x6f, 0x73, 0x6c, 0x29, 0x20, 0x28, 0x63, 0x61, 0x64, 0x72, 0x20, 0x70, 0x6f, 0x73, 0x6c, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x68, 0x63, 0x20, 0x68, 0x72, 0x6f, 0x77, 0x20, 0x32, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x73, 0x20, 0x69, 0x29, 0x20, 0x30, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x28, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x73, 0x20, 0x69, 0x29, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x33, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x62, 0x65, 0x67, 0x69, 0x6e, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x68, 0x63, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x6e, 0x65, 0x77, 0x20, 0x6e, 0x63, 0x20, 0x33, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x30, 0x20, 0x30, 0x20, 0x28, 0x63, 0x2d, 0x70, 0x6f, 0x69, 0x6e, 0x74, 0x65, 0x72, 0x20, 0x30, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x79, 0x78, 0x20, 0x68, 0x63, 0x20, 0x30, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x5f, 0x64, 0x6f, 0x75, 0x62, 0x6c, 0x65, 0x5f, 0x62, 0x6f, 0x78, 0x20, 0x68, 0x63, 0x20, 0x30, 0x20, 0x30, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x30, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x31, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x32, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x33, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x34, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x35, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x62, 0x6f, 0x78, 0x20, 0x68, 0x63, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x30, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x31, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x32, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x33, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x34, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x35, 0x29, 0x20, 0x32, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x31, 0x29, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x68, 0x63, 0x20, 0x31, 0x20, 0x31, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x35, 0x29, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x73, 0x20, 0x28, 0x76, 0x65, 0x63, 0x74, 0x6f, 0x72, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x68, 0x63, 0x20, 0x31, 0x20, 0x32, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x73, 0x20, 0x30, 0x29, 0x20, 0x30, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x33, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x33, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x6e, 0x65, 0x77, 0x20, 0x6e, 0x63, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x30, 0x20, 0x30, 0x20, 0x28, 0x63, 0x2d, 0x70, 0x6f, 0x69, 0x6e, 0x74, 0x65, 0x72, 0x20, 0x30, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x69, 0x6e, 0x74, 0x2d, 0x76, 0x65, 0x63, 0x74, 0x6f, 0x72, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x30, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x69, 0x6e, 0x74, 0x2d, 0x76, 0x65, 0x63, 0x74, 0x6f, 0x72, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x30, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x62, 0x65, 0x6c, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x73, 0x74, 0x61, 0x74, 0x70, 0x29, 0x20, 0x3b, 0x20, 0x73, 0x74, 0x61, 0x74, 0x70, 0x20, 0x61, 0x6c, 0x77, 0x61, 0x79, 0x73, 0x20, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x65, 0x64, 0x20, 0x77, 0x69, 0x74, 0x68, 0x20, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x73, 0x20, 0x73, 0x6c, 0x69, 0x64, 0x69, 0x6e, 0x67, 0x20, 0x75, 0x6e, 0x64, 0x65, 0x72, 0x6e, 0x65, 0x61, 0x74, 0x68, 0x20, 0x63, 0x6f, 0x6e, 0x63, 0x65, 0x70, 0x74, 0x75, 0x61, 0x6c, 0x6c, 0x79, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x6f, 0x70, 0x61, 0x71, 0x75, 0x65, 0x20, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x63, 0x31, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x67, 0x63, 0x6c, 0x75, 0x73, 0x74, 0x65, 0x72, 0x20, 0x63, 0x31, 0x29, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x63, 0x68, 0x61, 0x6e, 0x6e, 0x65, 0x6c, 0x73, 0x20, 0x63, 0x31, 0x29, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x73, 0x74, 0x79, 0x6c, 0x65, 0x6d, 0x61, 0x73, 0x6b, 0x20, 0x63, 0x31, 0x29, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x73, 0x65, 0x74, 0x5f, 0x62, 0x61, 0x73, 0x65, 0x5f, 0x63, 0x65, 0x6c, 0x6c, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x63, 0x31, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x75, 0x6e, 0x6c, 0x65, 0x73, 0x73, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x20, 0x3b, 0x20, 0x61, 0x76, 0x6f, 0x69, 0x64, 0x20, 0x66, 0x69, 0x72, 0x73, 0x74, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x2d, 0x2d, 0x20, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0x20, 0x69, 0x73, 0x20, 0x6d, 0x65, 0x65, 0x73, 0x65, 0x64, 0x20, 0x75, 0x70, 0x20, 0x62, 0x79, 0x20, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x72, 0x65, 0x6e, 0x64, 0x65, 0x72, 0x20, 0x6e, 0x63, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x6c, 0x61, 0x73, 0x74, 0x2d, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x22, 0x22, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x68, 0x6f, 0x6f, 0x6b, 0x2d, 0x66, 0x75, 0x6e, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x73, 0x20, 0x2a, 0x6c, 0x6f, 0x61, 0x64, 0x2d, 0x68, 0x6f, 0x6f, 0x6b, 0x2a, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x6f, 0x6e, 0x73, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x68, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x75, 0x6e, 0x6c, 0x65, 0x73, 0x73, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x3d, 0x3f, 0x20, 0x28, 0x68, 0x20, 0x27, 0x6e, 0x61, 0x6d, 0x65, 0x29, 0x20, 0x6c, 0x61, 0x73, 0x74, 0x2d, 0x6e, 0x61, 0x6d, 0x65, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6c, 0x61, 0x73, 0x74, 0x2d, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x28, 0x68, 0x20, 0x27, 0x6e, 0x61, 0x6d, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x23, 0x66, 0x20, 0x22, 0x6c, 0x6f, 0x61, 0x64, 0x69, 0x6e, 0x67, 0x20, 0x7e, 0x53, 0x22, 0x20, 0x28, 0x68, 0x20, 0x27, 0x6e, 0x61, 0x6d, 0x65, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x68, 0x6f, 0x6f, 0x6b, 0x2d, 0x66, 0x75, 0x6e, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x73, 0x20, 0x2a, 0x6c, 0x6f, 0x61, 0x64, 0x2d, 0x68, 0x6f, 0x6f, 0x6b, 0x2a, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x68, 0x6f, 0x6f, 0x6b, 0x2d, 0x66, 0x75, 0x6e, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x73, 0x20, 0x2a, 0x61, 0x75, 0x74, 0x6f, 0x6c, 0x6f, 0x61, 0x64, 0x2d, 0x68, 0x6f, 0x6f, 0x6b, 0x2a, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x6f, 0x6e, 0x73, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x68, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6c, 0x61, 0x73, 0x74, 0x2d, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x28, 0x68, 0x20, 0x27, 0x66, 0x69, 0x6c, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x23, 0x66, 0x20, 0x22, 0x61, 0x75, 0x74, 0x6f, 0x6c, 0x6f, 0x61, 0x64, 0x69, 0x6e, 0x67, 0x20, 0x7e, 0x53, 0x20, 0x66, 0x72, 0x6f, 0x6d, 0x20, 0x7e, 0x53, 0x22, 0x20, 0x28, 0x68, 0x20, 0x27, 0x6e, 0x61, 0x6d, 0x65, 0x29, 0x20, 0x28, 0x68, 0x20, 0x27, 0x66, 0x69, 0x6c, 0x65, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x68, 0x6f, 0x6f, 0x6b, 0x2d, 0x66, 0x75, 0x6e, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x73, 0x20, 0x2a, 0x61, 0x75, 0x74, 0x6f, 0x6c, 0x6f, 0x61, 0x64, 0x2d, 0x68, 0x6f, 0x6f, 0x6b, 0x2a, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x20, 0x73, 0x63, 0x72, 0x6f, 0x6c, 0x6c, 0x69, 0x6e, 0x67, 0x20, 0x61, 0x6e, 0x64, 0x20, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x69, 0x6e, 0x67, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x61, 0x6e, 0x64, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x61, 0x72, 0x65, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x65, 0x6c, 0x61, 0x74, 0x69, 0x76, 0x65, 0x2c, 0x20, 0x69, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x7c, 0x63, 0x6f, 0x6c, 0x20, 0x61, 0x72, 0x65, 0x20, 0x74, 0x68, 0x65, 0x20, 0x6c, 0x6f, 0x63, 0x61, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x6f, 0x66, 0x20, 0x69, 0x74, 0x73, 0x20, 0x74, 0x6f, 0x70, 0x20, 0x6c, 0x65, 0x66, 0x74, 0x20, 0x63, 0x6f, 0x72, 0x6e, 0x65, 0x72, 0x20, 0x28, 0x30, 0x2c, 0x30, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x20, 0x20, 0x69, 0x6e, 0x20, 0x74, 0x68, 0x65, 0x20, 0x74, 0x65, 0x72, 0x6d, 0x69, 0x6e, 0x61, 0x6c, 0x20, 0x77, 0x69, 0x6e, 0x64, 0x6f, 0x77, 0x2e, 0x20, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x7c, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x61, 0x72, 0x65, 0x20, 0x69, 0x74, 0x73, 0x20, 0x73, 0x69, 0x7a, 0x65, 0x2e, 0x20, 0x20, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x7c, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x69, 0x73, 0x20, 0x74, 0x68, 0x65, 0x20, 0x74, 0x65, 0x72, 0x6d, 0x69, 0x6e, 0x61, 0x6c, 0x20, 0x73, 0x69, 0x7a, 0x65, 0x2e, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x20, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x3d, 0x20, 0x2d, 0x35, 0x20, 0x6d, 0x65, 0x61, 0x6e, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x69, 0x73, 0x20, 0x73, 0x68, 0x69, 0x66, 0x74, 0x65, 0x64, 0x20, 0x6c, 0x65, 0x66, 0x74, 0x20, 0x28, 0x74, 0x6f, 0x20, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x74, 0x68, 0x65, 0x20, 0x72, 0x69, 0x67, 0x68, 0x74, 0x77, 0x61, 0x72, 0x64, 0x20, 0x70, 0x6f, 0x72, 0x74, 0x69, 0x6f, 0x6e, 0x29, 0x2c, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x20, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x3d, 0x20, 0x35, 0x20, 0x6d, 0x65, 0x61, 0x6e, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x69, 0x73, 0x20, 0x73, 0x68, 0x69, 0x66, 0x74, 0x65, 0x64, 0x20, 0x72, 0x69, 0x67, 0x68, 0x74, 0x20, 0x28, 0x6d, 0x6f, 0x76, 0x69, 0x6e, 0x67, 0x20, 0x69, 0x74, 0x73, 0x20, 0x74, 0x6f, 0x70, 0x2d, 0x6c, 0x65, 0x66, 0x74, 0x20, 0x63, 0x6f, 0x72, 0x6e, 0x65, 0x72, 0x20, 0x74, 0x6f, 0x20, 0x28, 0x35, 0x2c, 0x30, 0x29, 0x20, 0x69, 0x6e, 0x20, 0x74, 0x68, 0x65, 0x20, 0x74, 0x65, 0x72, 0x6d, 0x69, 0x6e, 0x61, 0x6c, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x20, 0x20, 0x28, 0x75, 0x73, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x72, 0x6f, 0x77, 0x2c, 0x63, 0x6f, 0x6c, 0x29, 0x20, 0x74, 0x68, 0x72, 0x6f, 0x75, 0x67, 0x68, 0x6f, 0x75, 0x74, 0x29, 0x2e, 0x20, 0x20, 0x54, 0x68, 0x69, 0x73, 0x20, 0x77, 0x6f, 0x6e, 0x27, 0x74, 0x20, 0x68, 0x61, 0x70, 0x70, 0x65, 0x6e, 0x20, 0x69, 0x6e, 0x20, 0x6e, 0x6f, 0x72, 0x6d, 0x61, 0x6c, 0x20, 0x65, 0x64, 0x69, 0x74, 0x69, 0x6e, 0x67, 0x2c, 0x20, 0x62, 0x75, 0x74, 0x20, 0x74, 0x68, 0x65, 0x20, 0x75, 0x73, 0x65, 0x72, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x20, 0x20, 0x63, 0x61, 0x6e, 0x20, 0x65, 0x61, 0x73, 0x69, 0x6c, 0x79, 0x20, 0x6d, 0x6f, 0x76, 0x65, 0x20, 0x6e, 0x63, 0x70, 0x3a, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x79, 0x78, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x2d, 0x6c, 0x65, 0x74, 0x20, 0x27, 0x6e, 0x63, 0x70, 0x29, 0x20, 0x35, 0x20, 0x30, 0x29, 0x2e, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x48, 0x65, 0x72, 0x65, 0x20, 0x74, 0x68, 0x65, 0x20, 0x61, 0x73, 0x73, 0x75, 0x6d, 0x70, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x69, 0x73, 0x20, 0x77, 0x65, 0x20, 0x77, 0x61, 0x6e, 0x74, 0x20, 0x76, 0x61, 0x6c, 0x20, 0x74, 0x6f, 0x20, 0x62, 0x65, 0x20, 0x76, 0x69, 0x73, 0x69, 0x62, 0x6c, 0x65, 0x20, 0x61, 0x6e, 0x64, 0x20, 0x74, 0x68, 0x65, 0x20, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x69, 0x73, 0x20, 0x61, 0x6c, 0x72, 0x65, 0x61, 0x64, 0x79, 0x20, 0x76, 0x69, 0x73, 0x69, 0x62, 0x6c, 0x65, 0x2e, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x20, 0x20, 0x54, 0x68, 0x65, 0x20, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x6c, 0x79, 0x20, 0x76, 0x69, 0x73, 0x69, 0x62, 0x6c, 0x65, 0x20, 0x70, 0x6f, 0x72, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x6f, 0x66, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x69, 0x73, 0x20, 0x66, 0x72, 0x6f, 0x6d, 0x20, 0x28, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x30, 0x20, 0x2d, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x2c, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x30, 0x20, 0x2d, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x20, 0x74, 0x6f, 0x20, 0x28, 0x62, 0x6f, 0x74, 0x74, 0x6f, 0x6d, 0x20, 0x72, 0x69, 0x67, 0x68, 0x74, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x20, 0x20, 0x28, 0x28, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x2d, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x2c, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x2d, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x20, 0x28, 0x61, 0x73, 0x73, 0x75, 0x6d, 0x69, 0x6e, 0x67, 0x20, 0x77, 0x65, 0x27, 0x72, 0x65, 0x20, 0x6e, 0x6f, 0x74, 0x20, 0x63, 0x6f, 0x6d, 0x70, 0x6c, 0x65, 0x74, 0x65, 0x6c, 0x79, 0x20, 0x6f, 0x66, 0x66, 0x20, 0x73, 0x63, 0x72, 0x65, 0x65, 0x6e, 0x29, 0x2e, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x76, 0x61, 0x6c, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x70, 0x72, 0x65, 0x76, 0x2d, 0x70, 0x61, 0x72, 0x73, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x70, 0x72, 0x65, 0x76, 0x2d, 0x70, 0x61, 0x72, 0x73, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x72, 0x65, 0x66, 0x72, 0x65, 0x73, 0x68, 0x20, 0x6e, 0x63, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x76, 0x61, 0x6c, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x76, 0x61, 0x6c, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x70, 0x72, 0x65, 0x76, 0x2d, 0x70, 0x61, 0x72, 0x73, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x70, 0x72, 0x65, 0x76, 0x2d, 0x70, 0x61, 0x72, 0x73, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x72, 0x65, 0x66, 0x72, 0x65, 0x73, 0x68, 0x20, 0x6e, 0x63, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x76, 0x61, 0x6c, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x65, 0x2d, 0x77, 0x61, 0x74, 0x63, 0x68, 0x65, 0x72, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x77, 0x63, 0xa, 
+  0x9, 0x9, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x6f, 0x6c, 0x64, 0x2d, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6f, 0x6c, 0x64, 0x2d, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x28, 0x2b, 0x20, 0x28, 0x68, 0x61, 0x73, 0x68, 0x2d, 0x74, 0x61, 0x62, 0x6c, 0x65, 0x2d, 0x65, 0x6e, 0x74, 0x72, 0x69, 0x65, 0x73, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x65, 0x72, 0x73, 0x29, 0x20, 0x32, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x66, 0x6c, 0x6f, 0x6f, 0x72, 0x20, 0x28, 0x2a, 0x20, 0x30, 0x2e, 0x36, 0x31, 0x38, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x65, 0x20, 0x77, 0x63, 0x20, 0x30, 0x20, 0x30, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x6f, 0x6c, 0x64, 0x2d, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x6f, 0x6c, 0x64, 0x2d, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x30, 0x20, 0x30, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x79, 0x78, 0x20, 0x77, 0x63, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x79, 0x78, 0x20, 0x77, 0x63, 0x20, 0x30, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x62, 0x6f, 0x78, 0x20, 0x77, 0x63, 0x20, 0x28, 0x77, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x30, 0x29, 0x20, 0x28, 0x77, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x31, 0x29, 0x20, 0x28, 0x77, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x32, 0x29, 0x20, 0x28, 0x77, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x33, 0x29, 0x20, 0x28, 0x77, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x34, 0x29, 0x20, 0x28, 0x77, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x35, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x31, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x31, 0x29, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x2d, 0x65, 0x61, 0x63, 0x68, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x2d, 0x72, 0x6f, 0x77, 0x26, 0x73, 0x74, 0x72, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x77, 0x63, 0x20, 0x28, 0x63, 0x61, 0x64, 0x72, 0x20, 0x6b, 0x65, 0x79, 0x2d, 0x72, 0x6f, 0x77, 0x26, 0x73, 0x74, 0x72, 0x29, 0x20, 0x31, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x2d, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x32, 0x29, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x77, 0x63, 0x20, 0x28, 0x63, 0x61, 0x64, 0x72, 0x20, 0x6b, 0x65, 0x79, 0x2d, 0x72, 0x6f, 0x77, 0x26, 0x73, 0x74, 0x72, 0x29, 0x20, 0x32, 0x20, 0x28, 0x63, 0x64, 0x64, 0x72, 0x20, 0x6b, 0x65, 0x79, 0x2d, 0x72, 0x6f, 0x77, 0x26, 0x73, 0x74, 0x72, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x65, 0x72, 0x73, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x65, 0x20, 0x6e, 0x65, 0x77, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x6e, 0x65, 0x77, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x6f, 0x6c, 0x64, 0x2d, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x6e, 0x65, 0x77, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x6e, 0x65, 0x77, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x3b, 0x3b, 0x20, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x65, 0x20, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x20, 0x61, 0x72, 0x65, 0x61, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x73, 0x74, 0x61, 0x74, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x73, 0x74, 0x61, 0x74, 0x70, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x6f, 0x6c, 0x64, 0x2d, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x31, 0x29, 0x20, 0x22, 0x20, 0x22, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x65, 0x20, 0x73, 0x74, 0x61, 0x74, 0x70, 0x20, 0x30, 0x20, 0x30, 0x20, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x6f, 0x6c, 0x64, 0x2d, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0x20, 0x30, 0x20, 0x30, 0x20, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x3b, 0x3b, 0x20, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x65, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0xa, 
+  0x9, 0x9, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x68, 0x63, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x65, 0x20, 0x68, 0x63, 0x20, 0x30, 0x20, 0x30, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x6f, 0x6c, 0x64, 0x2d, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0x20, 0x30, 0x20, 0x30, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x79, 0x78, 0x20, 0x68, 0x63, 0x20, 0x30, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x62, 0x6f, 0x78, 0x20, 0x68, 0x63, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x30, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x31, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x32, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x33, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x34, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x35, 0x29, 0x20, 0x28, 0x2b, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x73, 0x29, 0x20, 0x31, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x31, 0x29, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x69, 0x20, 0x30, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x68, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x20, 0x28, 0x2b, 0x20, 0x68, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x3d, 0x20, 0x69, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x68, 0x63, 0x20, 0x68, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x6f, 0x6c, 0x64, 0x2d, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x31, 0x29, 0x20, 0x22, 0x20, 0x22, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x72, 0x65, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x74, 0x68, 0x65, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x20, 0x66, 0x72, 0x6f, 0x6d, 0x20, 0x74, 0x68, 0x65, 0x20, 0x6f, 0x72, 0x69, 0x67, 0x69, 0x6e, 0x61, 0x6c, 0x20, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x73, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x69, 0x20, 0x30, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x68, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x20, 0x28, 0x2b, 0x20, 0x68, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x3d, 0x20, 0x69, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x68, 0x63, 0x20, 0x68, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x35, 0x29, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x68, 0x63, 0x20, 0x68, 0x72, 0x6f, 0x77, 0x20, 0x32, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x73, 0x20, 0x69, 0x29, 0x20, 0x30, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x28, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x73, 0x20, 0x69, 0x29, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x33, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x28, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x65, 0x2d, 0x77, 0x61, 0x74, 0x63, 0x68, 0x65, 0x72, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x3b, 0x3b, 0x20, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x65, 0x20, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x20, 0x70, 0x61, 0x6e, 0x65, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x3c, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x3c, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x65, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x30, 0x20, 0x30, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x30, 0x20, 0x30, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3e, 0x20, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x63, 0x6f, 0x70, 0x79, 0x20, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x69, 0x6e, 0x74, 0x2d, 0x76, 0x65, 0x63, 0x74, 0x6f, 0x72, 0x20, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x63, 0x6f, 0x70, 0x79, 0x20, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x69, 0x6e, 0x74, 0x2d, 0x76, 0x65, 0x63, 0x74, 0x6f, 0x72, 0x20, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x76, 0x69, 0x73, 0x69, 0x62, 0x6c, 0x65, 0x3f, 0x20, 0x72, 0x20, 0x63, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x3c, 0x20, 0x72, 0x20, 0x28, 0x2d, 0x20, 0x73, 0x74, 0x61, 0x74, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x3e, 0x3d, 0x20, 0x72, 0x20, 0x28, 0x2d, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x3c, 0x20, 0x63, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x3e, 0x3d, 0x20, 0x63, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x76, 0x61, 0x6c, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x76, 0x61, 0x6c, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3e, 0x3d, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x65, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x30, 0x20, 0x30, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x30, 0x20, 0x30, 0x20, 0x28, 0x2b, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x34, 0x30, 0x29, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x28, 0x2b, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x34, 0x30, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x63, 0x6f, 0x70, 0x79, 0x20, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x69, 0x6e, 0x74, 0x2d, 0x76, 0x65, 0x63, 0x74, 0x6f, 0x72, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x63, 0x6f, 0x70, 0x79, 0x20, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x69, 0x6e, 0x74, 0x2d, 0x76, 0x65, 0x63, 0x74, 0x6f, 0x72, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x6f, 0x6e, 0x64, 0x20, 0x28, 0x28, 0x3e, 0x3d, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x73, 0x74, 0x61, 0x74, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x69, 0x73, 0x20, 0x6f, 0x75, 0x74, 0x73, 0x69, 0x64, 0x65, 0x20, 0x28, 0x62, 0x65, 0x6c, 0x6f, 0x77, 0x29, 0x20, 0x74, 0x68, 0x65, 0x20, 0x74, 0x65, 0x72, 0x6d, 0x69, 0x6e, 0x61, 0x6c, 0x20, 0x77, 0x69, 0x6e, 0x64, 0x6f, 0x77, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x30, 0x20, 0x28, 0x2d, 0x20, 0x73, 0x74, 0x61, 0x74, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x32, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x79, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6d, 0x6f, 0x76, 0x65, 0x2d, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x3c, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x69, 0x73, 0x20, 0x6f, 0x75, 0x74, 0x73, 0x69, 0x64, 0x65, 0x20, 0x28, 0x61, 0x62, 0x6f, 0x76, 0x65, 0x29, 0x20, 0x74, 0x68, 0x65, 0x20, 0x74, 0x65, 0x72, 0x6d, 0x69, 0x6e, 0x61, 0x6c, 0x20, 0x77, 0x69, 0x6e, 0x64, 0x6f, 0x77, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x79, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x76, 0x61, 0x6c, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x76, 0x61, 0x6c, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3e, 0x3d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x65, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x30, 0x20, 0x30, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x30, 0x20, 0x30, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x30, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x30, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x6f, 0x6e, 0x64, 0x20, 0x28, 0x28, 0x3e, 0x3d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x20, 0x20, 0x3b, 0x20, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x20, 0x63, 0x6f, 0x6c, 0x75, 0x6d, 0x6e, 0x20, 0x69, 0x73, 0x20, 0x6f, 0x75, 0x74, 0x73, 0x69, 0x64, 0x65, 0x20, 0x28, 0x74, 0x6f, 0x20, 0x74, 0x68, 0x65, 0x20, 0x72, 0x69, 0x67, 0x68, 0x74, 0x20, 0x6f, 0x66, 0x29, 0x20, 0x74, 0x68, 0x65, 0x20, 0x74, 0x65, 0x72, 0x6d, 0x69, 0x6e, 0x61, 0x6c, 0x20, 0x77, 0x69, 0x6e, 0x64, 0x6f, 0x77, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x30, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x32, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x79, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x3c, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x20, 0x63, 0x6f, 0x6c, 0x75, 0x6d, 0x6e, 0x20, 0x69, 0x73, 0x20, 0x6f, 0x75, 0x74, 0x73, 0x69, 0x64, 0x65, 0x20, 0x28, 0x74, 0x6f, 0x20, 0x74, 0x68, 0x65, 0x20, 0x6c, 0x65, 0x66, 0x74, 0x20, 0x6f, 0x66, 0x29, 0x20, 0x74, 0x68, 0x65, 0x20, 0x74, 0x65, 0x72, 0x6d, 0x69, 0x6e, 0x61, 0x6c, 0x20, 0x77, 0x69, 0x6e, 0x64, 0x6f, 0x77, 0x2c, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x3c, 0x20, 0x30, 0x20, 0x6d, 0x65, 0x61, 0x6e, 0x73, 0x20, 0x74, 0x68, 0x65, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x20, 0x69, 0x73, 0x20, 0x73, 0x68, 0x69, 0x66, 0x74, 0x65, 0x64, 0x20, 0x6c, 0x65, 0x66, 0x74, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x79, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x3d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x73, 0x70, 0x65, 0x63, 0x69, 0x61, 0x6c, 0x20, 0x63, 0x61, 0x73, 0x65, 0x3a, 0x20, 0x77, 0x65, 0x27, 0x72, 0x65, 0x20, 0x73, 0x74, 0x75, 0x63, 0x6b, 0x20, 0x61, 0x67, 0x61, 0x69, 0x6e, 0x73, 0x74, 0x20, 0x74, 0x68, 0x65, 0x20, 0x70, 0x72, 0x6f, 0x6d, 0x70, 0x74, 0x2c, 0x20, 0x62, 0x75, 0x74, 0x20, 0x77, 0x61, 0x6e, 0x74, 0x20, 0x6d, 0x6f, 0x76, 0x65, 0x20, 0x69, 0x74, 0x20, 0x69, 0x6e, 0x74, 0x6f, 0x20, 0x76, 0x69, 0x65, 0x77, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x3c, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x30, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x79, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x69, 0x6e, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x69, 0x6e, 0x63, 0x72, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2b, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x69, 0x6e, 0x63, 0x72, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x28, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x23, 0x66, 0x20, 0x22, 0x69, 0x6e, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x20, 0x2d, 0x3e, 0x20, 0x7e, 0x44, 0x7e, 0x25, 0x22, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3e, 0x3d, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x65, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x30, 0x20, 0x30, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x30, 0x20, 0x30, 0x20, 0x28, 0x2b, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x34, 0x30, 0x29, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x28, 0x2b, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x34, 0x30, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x63, 0x6f, 0x70, 0x79, 0x20, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x69, 0x6e, 0x74, 0x2d, 0x76, 0x65, 0x63, 0x74, 0x6f, 0x72, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x63, 0x6f, 0x70, 0x79, 0x20, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x69, 0x6e, 0x74, 0x2d, 0x76, 0x65, 0x63, 0x74, 0x6f, 0x72, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3e, 0x3d, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x73, 0x74, 0x61, 0x74, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x30, 0x20, 0x28, 0x2d, 0x20, 0x73, 0x74, 0x61, 0x74, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x74, 0x68, 0x69, 0x73, 0x20, 0x6d, 0x6f, 0x76, 0x65, 0x73, 0x20, 0x74, 0x6f, 0x20, 0x62, 0x6f, 0x74, 0x74, 0x6f, 0x6d, 0x2c, 0x20, 0x28, 0x2d, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x74, 0x6f, 0x20, 0x74, 0x6f, 0x70, 0x3f, 0x3f, 0xa, 
+  0x9, 0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x79, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x6d, 0x6f, 0x76, 0x65, 0x2d, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x69, 0x6e, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x69, 0x6e, 0x63, 0x72, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x69, 0x6e, 0x63, 0x72, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3e, 0x3d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x65, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x30, 0x20, 0x30, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x30, 0x20, 0x30, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x30, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x30, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3e, 0x3d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x2b, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x30, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x32, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x79, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x64, 0x65, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x69, 0x6e, 0x63, 0x72, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x69, 0x6e, 0x63, 0x72, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3c, 0x3d, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x69, 0x73, 0x20, 0x6f, 0x75, 0x74, 0x73, 0x69, 0x64, 0x65, 0x20, 0x28, 0x61, 0x62, 0x6f, 0x76, 0x65, 0x29, 0x20, 0x74, 0x68, 0x65, 0x20, 0x74, 0x65, 0x72, 0x6d, 0x69, 0x6e, 0x61, 0x6c, 0x20, 0x77, 0x69, 0x6e, 0x64, 0x6f, 0x77, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x79, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x64, 0x65, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x69, 0x6e, 0x63, 0x72, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x69, 0x6e, 0x63, 0x72, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3c, 0x3d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x20, 0x63, 0x6f, 0x6c, 0x75, 0x6d, 0x6e, 0x20, 0x69, 0x73, 0x20, 0x6f, 0x75, 0x74, 0x73, 0x69, 0x64, 0x65, 0x20, 0x28, 0x74, 0x6f, 0x20, 0x74, 0x68, 0x65, 0x20, 0x6c, 0x65, 0x66, 0x74, 0x20, 0x6f, 0x66, 0x29, 0x20, 0x74, 0x68, 0x65, 0x20, 0x74, 0x65, 0x72, 0x6d, 0x69, 0x6e, 0x61, 0x6c, 0x20, 0x77, 0x69, 0x6e, 0x64, 0x6f, 0x77, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x79, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x6d, 0x75, 0x6c, 0x74, 0x69, 0x6c, 0x69, 0x6e, 0x65, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x73, 0x74, 0x72, 0x29, 0x20, 0x3b, 0x20, 0x69, 0x6e, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x62, 0x65, 0x6c, 0x6f, 0x77, 0x20, 0x77, 0x69, 0x6c, 0x6c, 0x20, 0x6d, 0x61, 0x6b, 0x65, 0x20, 0x73, 0x70, 0x61, 0x63, 0x65, 0x20, 0x69, 0x66, 0x20, 0x6e, 0x65, 0x65, 0x64, 0x65, 0x64, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x6c, 0x65, 0x6e, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x73, 0x74, 0x72, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x69, 0x66, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x70, 0x6f, 0x73, 0x69, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x23, 0x5c, 0x6e, 0x65, 0x77, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x73, 0x74, 0x72, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x62, 0x65, 0x67, 0x69, 0x6e, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x30, 0x20, 0x73, 0x74, 0x72, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x73, 0x74, 0x61, 0x72, 0x74, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x28, 0x69, 0x20, 0x30, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x28, 0x3d, 0x20, 0x69, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x30, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x73, 0x74, 0x72, 0x20, 0x73, 0x74, 0x61, 0x72, 0x74, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x6c, 0x65, 0x6e, 0x20, 0x73, 0x74, 0x61, 0x72, 0x74, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x3d, 0x3f, 0x20, 0x23, 0x5c, 0x6e, 0x65, 0x77, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x73, 0x74, 0x72, 0x20, 0x69, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x62, 0x65, 0x67, 0x69, 0x6e, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x30, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x73, 0x74, 0x72, 0x20, 0x73, 0x74, 0x61, 0x72, 0x74, 0x20, 0x69, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x69, 0x20, 0x73, 0x74, 0x61, 0x72, 0x74, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x6e, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x73, 0x74, 0x61, 0x72, 0x74, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x20, 0x6c, 0x69, 0x6e, 0x74, 0x20, 0x28, 0x72, 0x65, 0x64, 0x69, 0x72, 0x65, 0x63, 0x74, 0x20, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0x29, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x77, 0x65, 0x20, 0x6c, 0x6f, 0x61, 0x64, 0x20, 0x6c, 0x69, 0x6e, 0x74, 0x20, 0x61, 0x62, 0x6f, 0x76, 0x65, 0x2c, 0x20, 0x61, 0x74, 0x20, 0x77, 0x68, 0x69, 0x63, 0x68, 0x20, 0x74, 0x69, 0x6d, 0x65, 0x20, 0x69, 0x74, 0x20, 0x73, 0x65, 0x74, 0x73, 0x20, 0x69, 0x74, 0x73, 0x20, 0x2a, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0x2d, 0x70, 0x6f, 0x72, 0x74, 0x2a, 0x20, 0x74, 0x6f, 0x20, 0x2a, 0x73, 0x74, 0x64, 0x65, 0x72, 0x72, 0x2a, 0x20, 0x28, 0x74, 0x68, 0x65, 0x20, 0x67, 0x6c, 0x6f, 0x62, 0x61, 0x6c, 0x20, 0x62, 0x75, 0x69, 0x6c, 0x74, 0x2d, 0x69, 0x6e, 0x20, 0x70, 0x6f, 0x72, 0x74, 0x29, 0x2c, 0x20, 0x62, 0x75, 0x74, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x20, 0x20, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x63, 0x61, 0x6c, 0x6c, 0x65, 0x64, 0x20, 0x69, 0x6e, 0x20, 0x74, 0x68, 0x65, 0x20, 0x72, 0x65, 0x70, 0x6c, 0x2c, 0x20, 0x77, 0x65, 0x20, 0x68, 0x61, 0x76, 0x65, 0x20, 0x6f, 0x76, 0x65, 0x72, 0x2d, 0x72, 0x69, 0x64, 0x64, 0x65, 0x6e, 0x20, 0x2a, 0x73, 0x74, 0x64, 0x65, 0x72, 0x72, 0x2a, 0x20, 0x74, 0x6f, 0x20, 0x70, 0x6c, 0x61, 0x63, 0x65, 0x20, 0x74, 0x68, 0x61, 0x74, 0x20, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0x20, 0x69, 0x6e, 0x20, 0x74, 0x68, 0x65, 0x20, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x20, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2c, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x20, 0x20, 0x73, 0x6f, 0x20, 0x77, 0x65, 0x20, 0x6e, 0x65, 0x65, 0x64, 0x20, 0x74, 0x6f, 0x20, 0x72, 0x65, 0x64, 0x69, 0x72, 0x65, 0x63, 0x74, 0x20, 0x6c, 0x69, 0x6e, 0x74, 0x27, 0x73, 0x20, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0x20, 0x62, 0x79, 0x20, 0x68, 0x61, 0x6e, 0x64, 0x2e, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x77, 0x69, 0x74, 0x68, 0x2d, 0x6c, 0x69, 0x6e, 0x74, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6c, 0x69, 0x6e, 0x74, 0x20, 0x3b, 0x20, 0x66, 0x6f, 0x72, 0x63, 0x65, 0x20, 0x74, 0x6f, 0x70, 0x2d, 0x6c, 0x65, 0x76, 0x65, 0x6c, 0x20, 0x63, 0x68, 0x61, 0x6e, 0x67, 0x65, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x6f, 0x6c, 0x64, 0x2d, 0x6c, 0x69, 0x6e, 0x74, 0x20, 0x6c, 0x69, 0x6e, 0x74, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x2a, 0x20, 0x28, 0x66, 0x69, 0x6c, 0x65, 0x20, 0x28, 0x6f, 0x75, 0x74, 0x70, 0x20, 0x3a, 0x75, 0x6e, 0x73, 0x65, 0x74, 0x29, 0x20, 0x28, 0x72, 0x65, 0x70, 0x6f, 0x72, 0x74, 0x2d, 0x69, 0x6e, 0x70, 0x75, 0x74, 0x20, 0x3a, 0x75, 0x6e, 0x73, 0x65, 0x74, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x69, 0x66, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x65, 0x71, 0x3f, 0x20, 0x6f, 0x75, 0x74, 0x70, 0x20, 0x3a, 0x75, 0x6e, 0x73, 0x65, 0x74, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x65, 0x71, 0x3f, 0x20, 0x72, 0x65, 0x70, 0x6f, 0x72, 0x74, 0x2d, 0x69, 0x6e, 0x70, 0x75, 0x74, 0x20, 0x3a, 0x75, 0x6e, 0x73, 0x65, 0x74, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x6d, 0x75, 0x6c, 0x74, 0x69, 0x6c, 0x69, 0x6e, 0x65, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x61, 0x6c, 0x6c, 0x2d, 0x77, 0x69, 0x74, 0x68, 0x2d, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x70, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x6f, 0x6c, 0x64, 0x2d, 0x6c, 0x69, 0x6e, 0x74, 0x20, 0x66, 0x69, 0x6c, 0x65, 0x20, 0x70, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6f, 0x6c, 0x64, 0x2d, 0x6c, 0x69, 0x6e, 0x74, 0x20, 0x66, 0x69, 0x6c, 0x65, 0x20, 0x6f, 0x75, 0x74, 0x70, 0x20, 0x72, 0x65, 0x70, 0x6f, 0x72, 0x74, 0x2d, 0x69, 0x6e, 0x70, 0x75, 0x74, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x20, 0x74, 0x6f, 0x70, 0x2d, 0x6c, 0x65, 0x76, 0x65, 0x6c, 0x2d, 0x6c, 0x65, 0x74, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x74, 0x6f, 0x70, 0x2d, 0x6c, 0x65, 0x76, 0x65, 0x6c, 0x2d, 0x6c, 0x65, 0x74, 0x20, 0x27, 0x68, 0x69, 0x73, 0x74, 0x6f, 0x72, 0x79, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x66, 0x69, 0x6c, 0x65, 0x6e, 0x61, 0x6d, 0x65, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x61, 0x6c, 0x6c, 0x2d, 0x77, 0x69, 0x74, 0x68, 0x2d, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0x2d, 0x66, 0x69, 0x6c, 0x65, 0x20, 0x66, 0x69, 0x6c, 0x65, 0x6e, 0x61, 0x6d, 0x65, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x70, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x74, 0x69, 0x6d, 0x65, 0x73, 0x74, 0x61, 0x6d, 0x70, 0x20, 0x28, 0x77, 0x69, 0x74, 0x68, 0x2d, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x73, 0x75, 0x62, 0x6c, 0x65, 0x74, 0x20, 0x6c, 0x69, 0x62, 0x63, 0x2d, 0x6c, 0x65, 0x74, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x74, 0x69, 0x6d, 0x65, 0x73, 0x74, 0x72, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x31, 0x32, 0x38, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x74, 0x72, 0x66, 0x74, 0x69, 0x6d, 0x65, 0x20, 0x74, 0x69, 0x6d, 0x65, 0x73, 0x74, 0x72, 0x20, 0x31, 0x32, 0x38, 0x20, 0x22, 0x25, 0x61, 0x20, 0x25, 0x64, 0x2d, 0x25, 0x62, 0x2d, 0x25, 0x59, 0x20, 0x25, 0x48, 0x3a, 0x25, 0x4d, 0x3a, 0x25, 0x53, 0x20, 0x25, 0x5a, 0x22, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x6f, 0x63, 0x61, 0x6c, 0x74, 0x69, 0x6d, 0x65, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x74, 0x69, 0x6d, 0x65, 0x2e, 0x6d, 0x61, 0x6b, 0x65, 0x20, 0x28, 0x74, 0x69, 0x6d, 0x65, 0x20, 0x28, 0x63, 0x2d, 0x70, 0x6f, 0x69, 0x6e, 0x74, 0x65, 0x72, 0x20, 0x30, 0x20, 0x27, 0x74, 0x69, 0x6d, 0x65, 0x5f, 0x74, 0x2a, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x74, 0x69, 0x6d, 0x65, 0x73, 0x74, 0x72, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x70, 0x20, 0x22, 0x3b, 0x3b, 0x3b, 0x20, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x3a, 0x20, 0x7e, 0x41, 0x7e, 0x25, 0x7e, 0x25, 0x22, 0x20, 0x74, 0x69, 0x6d, 0x65, 0x73, 0x74, 0x61, 0x6d, 0x70, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x69, 0x20, 0x30, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x3d, 0x20, 0x69, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3e, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x69, 0x29, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x70, 0x20, 0x22, 0x7e, 0x41, 0x20, 0x7e, 0x41, 0x7e, 0x25, 0x22, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x69, 0x20, 0x30, 0x20, 0x31, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x69, 0x29, 0x29, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x69, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x69, 0x29, 0x20, 0x31, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x69, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x70, 0x20, 0x22, 0x7e, 0x41, 0x7e, 0x25, 0x22, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x69, 0x20, 0x30, 0x20, 0x31, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x69, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x63, 0x6c, 0x65, 0x61, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x72, 0x6f, 0x77, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x38, 0x30, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x20, 0x63, 0x20, 0x73, 0x74, 0x72, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x6c, 0x65, 0x6e, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x73, 0x74, 0x72, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3e, 0x3d, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x65, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x30, 0x20, 0x30, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x30, 0x20, 0x30, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x20, 0x6c, 0x65, 0x6e, 0x20, 0x31, 0x30, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x20, 0x6c, 0x65, 0x6e, 0x20, 0x31, 0x30, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x20, 0x63, 0x20, 0x73, 0x74, 0x72, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3d, 0x20, 0x63, 0x20, 0x30, 0x29, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x29, 0x20, 0x30, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x72, 0x65, 0x70, 0x72, 0x6f, 0x6d, 0x70, 0x74, 0x20, 0x79, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x79, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x79, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x28, 0x63, 0x6c, 0x65, 0x61, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x79, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x79, 0x20, 0x30, 0x20, 0x70, 0x72, 0x6f, 0x6d, 0x70, 0x74, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x72, 0x65, 0x6e, 0x64, 0x65, 0x72, 0x20, 0x6e, 0x63, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x70, 0x72, 0x6f, 0x6d, 0x70, 0x74, 0x2d, 0x6c, 0x65, 0x6e, 0x20, 0x28, 0x2b, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x70, 0x72, 0x6f, 0x6d, 0x70, 0x74, 0x29, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x7a, 0x65, 0x72, 0x6f, 0x3f, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x6d, 0x69, 0x67, 0x68, 0x74, 0x20, 0x62, 0x65, 0x20, 0x69, 0x6e, 0x20, 0x70, 0x72, 0x65, 0x2d, 0x65, 0x78, 0x69, 0x73, 0x74, 0x69, 0x6e, 0x67, 0x20, 0x73, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x77, 0x68, 0x65, 0x72, 0x65, 0x20, 0x77, 0x65, 0x27, 0x72, 0x65, 0x20, 0x6a, 0x75, 0x73, 0x74, 0x20, 0x72, 0x65, 0x2d, 0x65, 0x73, 0x74, 0x61, 0x62, 0x6c, 0x69, 0x73, 0x68, 0x69, 0x6e, 0x67, 0x20, 0x61, 0x6e, 0x20, 0x65, 0x78, 0x69, 0x73, 0x74, 0x69, 0x6e, 0x67, 0x20, 0x70, 0x72, 0x6f, 0x6d, 0x70, 0x74, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x70, 0x72, 0x6f, 0x6d, 0x70, 0x74, 0x2d, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x70, 0x72, 0x6f, 0x6d, 0x70, 0x74, 0x2d, 0x6c, 0x65, 0x6e, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x70, 0x72, 0x6f, 0x6d, 0x70, 0x74, 0x2d, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x79, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x72, 0x65, 0x66, 0x72, 0x65, 0x73, 0x68, 0x20, 0x6e, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x6d, 0x6f, 0x76, 0x65, 0x2d, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x20, 0x79, 0x20, 0x70, 0x72, 0x6f, 0x6d, 0x70, 0x74, 0x2d, 0x6c, 0x65, 0x6e, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x69, 0x6e, 0x66, 0x6f, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x69, 0x20, 0x30, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x28, 0x3d, 0x20, 0x69, 0x20, 0x35, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x63, 0x5f, 0x79, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x69, 0x20, 0x28, 0x72, 0x65, 0x64, 0x2d, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x20, 0x69, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x72, 0x65, 0x6e, 0x64, 0x65, 0x72, 0x20, 0x6e, 0x63, 0x29, 0x20, 0x3b, 0x20, 0x65, 0x6c, 0x73, 0x65, 0x20, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x20, 0x6a, 0x75, 0x6d, 0x70, 0x73, 0x20, 0x62, 0x61, 0x63, 0x6b, 0x21, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x35, 0x20, 0x22, 0x3a, 0x20, 0x22, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x37, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x70, 0x61, 0x69, 0x72, 0x3f, 0x20, 0x69, 0x6e, 0x66, 0x6f, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x3f, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x69, 0x6e, 0x66, 0x6f, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x65, 0x72, 0x72, 0x20, 0x28, 0x61, 0x70, 0x70, 0x6c, 0x79, 0x20, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x23, 0x66, 0x20, 0x69, 0x6e, 0x66, 0x6f, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x37, 0x20, 0x65, 0x72, 0x72, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2b, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x65, 0x72, 0x72, 0x29, 0x20, 0x37, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x28, 0x6e, 0x75, 0x6c, 0x6c, 0x3f, 0x20, 0x69, 0x6e, 0x66, 0x6f, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x65, 0x72, 0x72, 0x20, 0x28, 0x6f, 0x62, 0x6a, 0x65, 0x63, 0x74, 0x2d, 0x3e, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x69, 0x6e, 0x66, 0x6f, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x20, 0x65, 0x72, 0x72, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2b, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x65, 0x72, 0x72, 0x29, 0x20, 0x37, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x72, 0x6f, 0x77, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x65, 0x72, 0x73, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x6c, 0x6f, 0x63, 0x61, 0x6c, 0x2d, 0x64, 0x65, 0x62, 0x75, 0x67, 0x2d, 0x69, 0x6e, 0x66, 0x6f, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x73, 0x74, 0x72, 0x20, 0x22, 0x22, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x69, 0x6e, 0x74, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3d, 0x20, 0x69, 0x6e, 0x74, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x6e, 0x65, 0x77, 0x6c, 0x69, 0x6e, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x62, 0x65, 0x67, 0x69, 0x6e, 0x20, 0x3b, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x20, 0x73, 0x74, 0x72, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x69, 0x66, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x2d, 0x70, 0x6f, 0x73, 0x69, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x22, 0x73, 0x65, 0x74, 0x21, 0x20, 0x74, 0x6f, 0x20, 0x22, 0x20, 0x73, 0x74, 0x72, 0x29, 0x20, 0x3b, 0x20, 0x69, 0x74, 0x27, 0x73, 0x20, 0x61, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x65, 0x72, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x2a, 0x20, 0x28, 0x28, 0x70, 0x6f, 0x73, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x70, 0x6f, 0x73, 0x69, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x20, 0x73, 0x74, 0x72, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x76, 0x61, 0x72, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x2d, 0x3e, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x73, 0x74, 0x72, 0x20, 0x30, 0x20, 0x70, 0x6f, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x76, 0x61, 0x72, 0x2d, 0x64, 0x61, 0x74, 0x61, 0x20, 0x28, 0x77, 0x61, 0x74, 0x63, 0x68, 0x65, 0x72, 0x73, 0x20, 0x76, 0x61, 0x72, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x76, 0x61, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x70, 0x61, 0x69, 0x72, 0x3f, 0x20, 0x76, 0x61, 0x72, 0x2d, 0x64, 0x61, 0x74, 0x61, 0x29, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x76, 0x61, 0x72, 0x2d, 0x64, 0x61, 0x74, 0x61, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x76, 0x61, 0x72, 0x2d, 0x73, 0x74, 0x72, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x23, 0x66, 0x20, 0x22, 0x7e, 0x41, 0x3a, 0x20, 0x7e, 0x41, 0x22, 0x20, 0x76, 0x61, 0x72, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x73, 0x74, 0x72, 0x20, 0x28, 0x2b, 0x20, 0x70, 0x6f, 0x73, 0x20, 0x39, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x75, 0x6e, 0x6c, 0x65, 0x73, 0x73, 0x20, 0x77, 0x63, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x77, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x28, 0x76, 0x65, 0x63, 0x74, 0x6f, 0x72, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x66, 0x6c, 0x6f, 0x6f, 0x72, 0x20, 0x28, 0x2a, 0x20, 0x30, 0x2e, 0x36, 0x31, 0x38, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x61, 0x68, 0x20, 0x74, 0x68, 0x65, 0x20, 0x67, 0x6f, 0x6f, 0x64, 0x20, 0x6f, 0x6c, 0x64, 0x20, 0x64, 0x61, 0x79, 0x73, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x77, 0x63, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x6e, 0x65, 0x77, 0x20, 0x6e, 0x63, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x63, 0x2d, 0x70, 0x6f, 0x69, 0x6e, 0x74, 0x65, 0x72, 0x20, 0x30, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x5f, 0x64, 0x6f, 0x75, 0x62, 0x6c, 0x65, 0x5f, 0x62, 0x6f, 0x78, 0x20, 0x77, 0x63, 0x20, 0x30, 0x20, 0x30, 0x20, 0x28, 0x77, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x30, 0x29, 0x20, 0x28, 0x77, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x31, 0x29, 0x20, 0x28, 0x77, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x32, 0x29, 0x20, 0x28, 0x77, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x33, 0x29, 0x20, 0x28, 0x77, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x34, 0x29, 0x20, 0x28, 0x77, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x35, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x62, 0x6f, 0x78, 0x20, 0x77, 0x63, 0x20, 0x28, 0x77, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x30, 0x29, 0x20, 0x28, 0x77, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x31, 0x29, 0x20, 0x28, 0x77, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x32, 0x29, 0x20, 0x28, 0x77, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x33, 0x29, 0x20, 0x28, 0x77, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x34, 0x29, 0x20, 0x28, 0x77, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x35, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x31, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x31, 0x29, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x63, 0x31, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x67, 0x63, 0x6c, 0x75, 0x73, 0x74, 0x65, 0x72, 0x20, 0x63, 0x31, 0x29, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x63, 0x68, 0x61, 0x6e, 0x6e, 0x65, 0x6c, 0x73, 0x20, 0x63, 0x31, 0x29, 0x20, 0x30, 0x29, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x6f, 0x70, 0x61, 0x71, 0x75, 0x65, 0x20, 0x61, 0x70, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x74, 0x6c, 0x79, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x5f, 0x73, 0x74, 0x79, 0x6c, 0x65, 0x6d, 0x61, 0x73, 0x6b, 0x20, 0x63, 0x31, 0x29, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x73, 0x65, 0x74, 0x5f, 0x62, 0x61, 0x73, 0x65, 0x5f, 0x63, 0x65, 0x6c, 0x6c, 0x20, 0x77, 0x63, 0x20, 0x63, 0x31, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x72, 0x65, 0x6e, 0x64, 0x65, 0x72, 0x20, 0x6e, 0x63, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x76, 0x61, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x64, 0x72, 0x21, 0x20, 0x76, 0x61, 0x72, 0x2d, 0x64, 0x61, 0x74, 0x61, 0x20, 0x76, 0x61, 0x72, 0x2d, 0x73, 0x74, 0x72, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x62, 0x65, 0x67, 0x69, 0x6e, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x76, 0x61, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2b, 0x20, 0x31, 0x20, 0x28, 0x68, 0x61, 0x73, 0x68, 0x2d, 0x74, 0x61, 0x62, 0x6c, 0x65, 0x2d, 0x65, 0x6e, 0x74, 0x72, 0x69, 0x65, 0x73, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x65, 0x72, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x76, 0x61, 0x72, 0x2d, 0x64, 0x61, 0x74, 0x61, 0x20, 0x28, 0x63, 0x6f, 0x6e, 0x73, 0x20, 0x76, 0x61, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x76, 0x61, 0x72, 0x2d, 0x73, 0x74, 0x72, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x68, 0x61, 0x73, 0x68, 0x2d, 0x74, 0x61, 0x62, 0x6c, 0x65, 0x2d, 0x73, 0x65, 0x74, 0x21, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x65, 0x72, 0x73, 0x20, 0x76, 0x61, 0x72, 0x20, 0x76, 0x61, 0x72, 0x2d, 0x64, 0x61, 0x74, 0x61, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x65, 0x2d, 0x77, 0x61, 0x74, 0x63, 0x68, 0x65, 0x72, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x77, 0x63, 0x20, 0x76, 0x61, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x2d, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x32, 0x29, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x77, 0x63, 0x20, 0x76, 0x61, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x32, 0x20, 0x28, 0x63, 0x64, 0x72, 0x20, 0x76, 0x61, 0x72, 0x2d, 0x64, 0x61, 0x74, 0x61, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x72, 0x65, 0x6e, 0x64, 0x65, 0x72, 0x20, 0x6e, 0x63, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x62, 0x65, 0x67, 0x69, 0x6e, 0x20, 0x3b, 0x20, 0x74, 0x72, 0x61, 0x63, 0x65, 0x20, 0x65, 0x74, 0x63, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x30, 0x20, 0x73, 0x74, 0x72, 0x29, 0x20, 0x3b, 0x20, 0x74, 0x68, 0x69, 0x73, 0x20, 0x69, 0x73, 0x20, 0x62, 0x72, 0x65, 0x61, 0x6b, 0x20, 0x69, 0x6e, 0x20, 0x64, 0x65, 0x62, 0x75, 0x67, 0x2e, 0x73, 0x63, 0x6d, 0x20, 0x72, 0x65, 0x70, 0x6f, 0x72, 0x74, 0x69, 0x6e, 0x67, 0x20, 0x74, 0x68, 0x65, 0x20, 0x72, 0x65, 0x73, 0x75, 0x6c, 0x74, 0x20, 0x22, 0x20, 0x20, 0x2d, 0x3e, 0x20, 0x31, 0x22, 0x20, 0x62, 0x75, 0x74, 0x20, 0x77, 0x65, 0x20, 0x68, 0x61, 0x76, 0x65, 0x20, 0x61, 0x6c, 0x72, 0x65, 0x61, 0x64, 0x79, 0x20, 0x64, 0x6f, 0x6e, 0x65, 0x20, 0x74, 0x68, 0x61, 0x74, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x73, 0x74, 0x72, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x6e, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x73, 0x74, 0x72, 0x20, 0x22, 0x22, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x73, 0x74, 0x72, 0x20, 0x28, 0x61, 0x70, 0x70, 0x65, 0x6e, 0x64, 0x20, 0x73, 0x74, 0x72, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x2d, 0x3e, 0x63, 0x68, 0x61, 0x72, 0x20, 0x69, 0x6e, 0x74, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x6c, 0x6f, 0x63, 0x61, 0x6c, 0x2d, 0x72, 0x65, 0x6d, 0x6f, 0x76, 0x65, 0x2d, 0x77, 0x61, 0x74, 0x63, 0x68, 0x65, 0x72, 0x20, 0x76, 0x61, 0x72, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x68, 0x61, 0x73, 0x68, 0x2d, 0x74, 0x61, 0x62, 0x6c, 0x65, 0x2d, 0x73, 0x65, 0x74, 0x21, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x65, 0x72, 0x73, 0x20, 0x76, 0x61, 0x72, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x77, 0x63, 0x20, 0x28, 0x7a, 0x65, 0x72, 0x6f, 0x3f, 0x20, 0x28, 0x68, 0x61, 0x73, 0x68, 0x2d, 0x74, 0x61, 0x62, 0x6c, 0x65, 0x2d, 0x65, 0x6e, 0x74, 0x72, 0x69, 0x65, 0x73, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x65, 0x72, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x62, 0x65, 0x67, 0x69, 0x6e, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x64, 0x65, 0x73, 0x74, 0x72, 0x6f, 0x79, 0x20, 0x77, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x77, 0x63, 0x20, 0x23, 0x66, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x72, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x65, 0x2d, 0x77, 0x61, 0x74, 0x63, 0x68, 0x65, 0x72, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x2d, 0x65, 0x61, 0x63, 0x68, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x76, 0x61, 0x72, 0x26, 0x72, 0x6f, 0x77, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x68, 0x61, 0x73, 0x68, 0x2d, 0x74, 0x61, 0x62, 0x6c, 0x65, 0x2d, 0x73, 0x65, 0x74, 0x21, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x65, 0x72, 0x73, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x76, 0x61, 0x72, 0x26, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x63, 0x6f, 0x6e, 0x73, 0x20, 0x72, 0x20, 0x28, 0x63, 0x64, 0x64, 0x72, 0x20, 0x76, 0x61, 0x72, 0x26, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x77, 0x63, 0x20, 0x72, 0x20, 0x31, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x30, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x33, 0x29, 0x29, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x77, 0x63, 0x20, 0x72, 0x20, 0x32, 0x20, 0x28, 0x63, 0x64, 0x64, 0x72, 0x20, 0x76, 0x61, 0x72, 0x26, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x72, 0x20, 0x28, 0x2b, 0x20, 0x72, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x65, 0x72, 0x73, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x77, 0x63, 0x20, 0x72, 0x20, 0x32, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x30, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x30, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x77, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x33, 0x29, 0x29, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x20, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x20, 0x63, 0x6c, 0x6f, 0x73, 0x65, 0x20, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6c, 0x6f, 0x73, 0x65, 0x2d, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x69, 0x6e, 0x64, 0x65, 0x6e, 0x74, 0x69, 0x6e, 0x67, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x69, 0x66, 0x20, 0x72, 0x6f, 0x77, 0x2f, 0x63, 0x6f, 0x6c, 0x20, 0x69, 0x73, 0x20, 0x6a, 0x75, 0x73, 0x74, 0x20, 0x61, 0x66, 0x74, 0x65, 0x72, 0x20, 0x23, 0x7c, 0x29, 0x2c, 0x20, 0x67, 0x65, 0x74, 0x20, 0x73, 0x74, 0x61, 0x72, 0x74, 0x20, 0x6f, 0x66, 0x20, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x20, 0x65, 0x78, 0x70, 0x72, 0x2c, 0x20, 0x73, 0x63, 0x61, 0x6e, 0x20, 0x75, 0x6e, 0x74, 0x69, 0x6c, 0x20, 0x72, 0x6f, 0x77, 0x2f, 0x63, 0x6f, 0x6c, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x20, 0x20, 0x72, 0x65, 0x74, 0x75, 0x72, 0x6e, 0x20, 0x65, 0x69, 0x74, 0x68, 0x65, 0x72, 0x20, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x69, 0x6e, 0x67, 0x20, 0x72, 0x6f, 0x77, 0x2f, 0x63, 0x6f, 0x6c, 0x20, 0x6f, 0x72, 0x20, 0x23, 0x66, 0x20, 0x69, 0x66, 0x20, 0x6e, 0x6f, 0x6e, 0x65, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x61, 0x6c, 0x6c, 0x2d, 0x77, 0x69, 0x74, 0x68, 0x2d, 0x65, 0x78, 0x69, 0x74, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x72, 0x65, 0x74, 0x75, 0x72, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x72, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x72, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x3e, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x29, 0x20, 0x30, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x72, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x6f, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x73, 0x20, 0x28, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x28, 0x3e, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x72, 0x6f, 0x77, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x28, 0x28, 0x74, 0x6f, 0x70, 0x2d, 0x6c, 0x65, 0x76, 0x65, 0x6c, 0x2d, 0x6c, 0x65, 0x74, 0x20, 0x27, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x29, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x23, 0x66, 0x20, 0x22, 0x7e, 0x53, 0x20, 0x7e, 0x53, 0x20, 0x7e, 0x53, 0x22, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6f, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x70, 0x61, 0x69, 0x72, 0x3f, 0x20, 0x6f, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x6f, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x73, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x65, 0x74, 0x2a, 0x20, 0x28, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x3d, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x72, 0x6f, 0x77, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x69, 0x6e, 0x64, 0x65, 0x6e, 0x74, 0x69, 0x6e, 0x67, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x31, 0x29, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x69, 0x20, 0x30, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x3e, 0x3d, 0x20, 0x69, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x61, 0x73, 0x65, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x69, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x23, 0x5c, 0x28, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6f, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x73, 0x20, 0x28, 0x63, 0x6f, 0x6e, 0x73, 0x20, 0x28, 0x6c, 0x69, 0x73, 0x74, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x20, 0x30, 0x20, 0x23, 0x66, 0x29, 0x20, 0x6f, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x23, 0x5c, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x70, 0x61, 0x69, 0x72, 0x3f, 0x20, 0x6f, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6f, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x73, 0x20, 0x28, 0x63, 0x64, 0x72, 0x20, 0x6f, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x69, 0x6e, 0x64, 0x65, 0x6e, 0x74, 0x69, 0x6e, 0x67, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x70, 0x61, 0x69, 0x72, 0x3f, 0x20, 0x6f, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x74, 0x6f, 0x70, 0x20, 0x28, 0x63, 0x64, 0x64, 0x61, 0x72, 0x20, 0x6f, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x61, 0x72, 0x21, 0x20, 0x74, 0x6f, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x74, 0x6f, 0x70, 0x29, 0x20, 0x31, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x23, 0x5c, 0x3b, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x69, 0x20, 0x28, 0x2b, 0x20, 0x6c, 0x65, 0x6e, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x23, 0x5c, 0x22, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x66, 0x6f, 0x75, 0x6e, 0x64, 0x2d, 0x63, 0x6c, 0x6f, 0x73, 0x65, 0x2d, 0x71, 0x75, 0x6f, 0x74, 0x65, 0x20, 0x23, 0x66, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x66, 0x6f, 0x75, 0x6e, 0x64, 0x2d, 0x63, 0x6c, 0x6f, 0x73, 0x65, 0x2d, 0x71, 0x75, 0x6f, 0x74, 0x65, 0x29, 0x20, 0x3b, 0x20, 0x6e, 0x65, 0x65, 0x64, 0x20, 0x74, 0x6f, 0x20, 0x6c, 0x6f, 0x6f, 0x6b, 0x20, 0x70, 0x6f, 0x73, 0x73, 0x69, 0x62, 0x6c, 0x79, 0x20, 0x61, 0x63, 0x72, 0x6f, 0x73, 0x73, 0x20, 0x73, 0x65, 0x76, 0x65, 0x72, 0x61, 0x6c, 0x20, 0x72, 0x6f, 0x77, 0x73, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x6b, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x20, 0x28, 0x2b, 0x20, 0x6b, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x3e, 0x3d, 0x20, 0x6b, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x3d, 0x3f, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x6b, 0x29, 0x20, 0x23, 0x5c, 0x22, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x3d, 0x3f, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x2d, 0x20, 0x6b, 0x20, 0x31, 0x29, 0x29, 0x20, 0x23, 0x5c, 0x5c, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x28, 0x28, 0x74, 0x6f, 0x70, 0x2d, 0x6c, 0x65, 0x76, 0x65, 0x6c, 0x2d, 0x6c, 0x65, 0x74, 0x20, 0x27, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x29, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x23, 0x66, 0x20, 0x22, 0x7e, 0x53, 0x20, 0x7e, 0x53, 0x20, 0x7e, 0x53, 0x20, 0x7e, 0x53, 0x22, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x6b, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3e, 0x3d, 0x20, 0x6b, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0x20, 0x20, 0x3b, 0x20, 0x6e, 0x6f, 0x20, 0x63, 0x6c, 0x6f, 0x73, 0x65, 0x20, 0x71, 0x75, 0x6f, 0x74, 0x65, 0x73, 0x20, 0x62, 0x79, 0x20, 0x65, 0x6f, 0x6c, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3d, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x72, 0x6f, 0x77, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x72, 0x65, 0x74, 0x75, 0x72, 0x6e, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x62, 0x65, 0x67, 0x69, 0x6e, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x69, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6c, 0x65, 0x6e, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x3d, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x72, 0x6f, 0x77, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x69, 0x6e, 0x64, 0x65, 0x6e, 0x74, 0x69, 0x6e, 0x67, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x31, 0x29, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x62, 0x65, 0x67, 0x69, 0x6e, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x66, 0x6f, 0x75, 0x6e, 0x64, 0x2d, 0x63, 0x6c, 0x6f, 0x73, 0x65, 0x2d, 0x71, 0x75, 0x6f, 0x74, 0x65, 0x20, 0x23, 0x74, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x69, 0x20, 0x6b, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x23, 0x5c, 0x23, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x3c, 0x20, 0x69, 0x20, 0x28, 0x2d, 0x20, 0x6c, 0x65, 0x6e, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x3d, 0x3f, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x20, 0x23, 0x5c, 0x7c, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x66, 0x6f, 0x75, 0x6e, 0x64, 0x2d, 0x63, 0x6c, 0x6f, 0x73, 0x65, 0x2d, 0x63, 0x6f, 0x6d, 0x6d, 0x65, 0x6e, 0x74, 0x20, 0x23, 0x66, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x66, 0x6f, 0x75, 0x6e, 0x64, 0x2d, 0x63, 0x6c, 0x6f, 0x73, 0x65, 0x2d, 0x63, 0x6f, 0x6d, 0x6d, 0x65, 0x6e, 0x74, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x6b, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x20, 0x28, 0x2b, 0x20, 0x6b, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x3e, 0x3d, 0x20, 0x6b, 0x20, 0x28, 0x2d, 0x20, 0x6c, 0x65, 0x6e, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x3d, 0x3f, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x6b, 0x29, 0x20, 0x23, 0x5c, 0x7c, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x3d, 0x3f, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x2b, 0x20, 0x6b, 0x20, 0x31, 0x29, 0x29, 0x20, 0x23, 0x5c, 0x23, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3e, 0x3d, 0x20, 0x6b, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3d, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x72, 0x6f, 0x77, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x72, 0x65, 0x74, 0x75, 0x72, 0x6e, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x62, 0x65, 0x67, 0x69, 0x6e, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x69, 0x20, 0x2d, 0x31, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6c, 0x65, 0x6e, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x3d, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x72, 0x6f, 0x77, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x69, 0x6e, 0x64, 0x65, 0x6e, 0x74, 0x69, 0x6e, 0x67, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x31, 0x29, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x62, 0x65, 0x67, 0x69, 0x6e, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x66, 0x6f, 0x75, 0x6e, 0x64, 0x2d, 0x63, 0x6c, 0x6f, 0x73, 0x65, 0x2d, 0x63, 0x6f, 0x6d, 0x6d, 0x65, 0x6e, 0x74, 0x20, 0x23, 0x74, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x69, 0x20, 0x28, 0x2b, 0x20, 0x6b, 0x20, 0x31, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x20, 0x23, 0x5c, 0x6e, 0x65, 0x77, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x23, 0x5c, 0x74, 0x61, 0x62, 0x20, 0x23, 0x5c, 0x72, 0x65, 0x74, 0x75, 0x72, 0x6e, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x65, 0x6c, 0x73, 0x65, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x69, 0x6e, 0x64, 0x65, 0x6e, 0x74, 0x69, 0x6e, 0x67, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x70, 0x61, 0x69, 0x72, 0x3f, 0x20, 0x6f, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x74, 0x6f, 0x70, 0x20, 0x28, 0x63, 0x64, 0x64, 0x64, 0x61, 0x72, 0x20, 0x6f, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x70, 0x61, 0x69, 0x72, 0x3f, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x74, 0x6f, 0x70, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x61, 0x72, 0x21, 0x20, 0x28, 0x63, 0x64, 0x61, 0x72, 0x20, 0x74, 0x6f, 0x70, 0x29, 0x20, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x74, 0x6f, 0x70, 0x29, 0x20, 0x28, 0x6c, 0x69, 0x73, 0x74, 0x20, 0x63, 0x20, 0x63, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x20, 0x69, 0x6e, 0x64, 0x65, 0x6e, 0x74, 0x61, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x69, 0x6e, 0x64, 0x65, 0x6e, 0x74, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x77, 0x68, 0x69, 0x74, 0x65, 0x2d, 0x73, 0x70, 0x61, 0x63, 0x65, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x23, 0x5c, 0x6e, 0x65, 0x77, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x20, 0x23, 0x5c, 0x72, 0x65, 0x74, 0x75, 0x72, 0x6e, 0x20, 0x23, 0x5c, 0x74, 0x61, 0x62, 0x20, 0x23, 0x5c, 0x6c, 0x69, 0x6e, 0x65, 0x66, 0x65, 0x65, 0x64, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x28, 0x7a, 0x65, 0x72, 0x6f, 0x3f, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x63, 0x6f, 0x6c, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x70, 0x61, 0x72, 0x73, 0x20, 0x28, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6c, 0x6f, 0x73, 0x65, 0x2d, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x28, 0x2d, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x2d, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x29, 0x20, 0x23, 0x74, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x69, 0x66, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x70, 0x61, 0x72, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x75, 0x6e, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x65, 0x64, 0x2d, 0x70, 0x61, 0x72, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x70, 0x61, 0x72, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x20, 0x20, 0x20, 0x20, 0x2d, 0x3e, 0x20, 0x28, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x2d, 0x6f, 0x66, 0x2d, 0x28, 0x20, 0x76, 0x69, 0x73, 0x69, 0x74, 0x73, 0x20, 0x23, 0x66, 0x2d, 0x6f, 0x72, 0x2d, 0x28, 0x6e, 0x61, 0x6d, 0x65, 0x2d, 0x73, 0x74, 0x61, 0x72, 0x74, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x2d, 0x65, 0x6e, 0x64, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x20, 0x72, 0x6f, 0x77, 0x2f, 0x63, 0x6f, 0x6c, 0x20, 0x61, 0x72, 0x67, 0x73, 0x20, 0x3d, 0x20, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x20, 0x70, 0x6f, 0x73, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x6f, 0x70, 0x65, 0x6e, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x75, 0x6e, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x65, 0x64, 0x2d, 0x70, 0x61, 0x72, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6f, 0x70, 0x65, 0x6e, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x63, 0x61, 0x64, 0x72, 0x20, 0x75, 0x6e, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x65, 0x64, 0x2d, 0x70, 0x61, 0x72, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x76, 0x69, 0x73, 0x69, 0x74, 0x73, 0x20, 0x28, 0x63, 0x61, 0x64, 0x64, 0x72, 0x20, 0x75, 0x6e, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x65, 0x64, 0x2d, 0x70, 0x61, 0x72, 0x29, 0x29, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x68, 0x6f, 0x77, 0x20, 0x6d, 0x61, 0x6e, 0x79, 0x20, 0x63, 0x6f, 0x6d, 0x70, 0x6c, 0x65, 0x74, 0x65, 0x20, 0x6c, 0x69, 0x73, 0x74, 0x73, 0x20, 0x66, 0x6f, 0x6c, 0x6c, 0x6f, 0x77, 0x20, 0x74, 0x68, 0x69, 0x73, 0x20, 0x28, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x61, 0x6d, 0x65, 0x2d, 0x62, 0x6f, 0x75, 0x6e, 0x64, 0x73, 0x20, 0x28, 0x63, 0x61, 0x64, 0x64, 0x64, 0x72, 0x20, 0x75, 0x6e, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x65, 0x64, 0x2d, 0x70, 0x61, 0x72, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x62, 0x6f, 0x75, 0x6e, 0x64, 0x73, 0x20, 0x6f, 0x66, 0x20, 0x6e, 0x6f, 0x6e, 0x2d, 0x77, 0x68, 0x69, 0x74, 0x65, 0x2d, 0x73, 0x70, 0x61, 0x63, 0x65, 0x20, 0x61, 0x66, 0x74, 0x65, 0x72, 0x20, 0x28, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x65, 0x72, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x30, 0x20, 0x31, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x6c, 0x69, 0x63, 0x65, 0x20, 0x30, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x74, 0x6c, 0x65, 0x6e, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x65, 0x72, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x70, 0x6f, 0x73, 0x69, 0x74, 0x69, 0x76, 0x65, 0x3f, 0x20, 0x74, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x69, 0x20, 0x30, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x3d, 0x20, 0x69, 0x20, 0x74, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x77, 0x68, 0x69, 0x74, 0x65, 0x73, 0x70, 0x61, 0x63, 0x65, 0x3f, 0x20, 0x28, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x65, 0x72, 0x20, 0x69, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x73, 0x6c, 0x69, 0x63, 0x65, 0x20, 0x69, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x65, 0x72, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x65, 0x72, 0x20, 0x69, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x69, 0x66, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x28, 0x70, 0x61, 0x69, 0x72, 0x3f, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x2d, 0x62, 0x6f, 0x75, 0x6e, 0x64, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x69, 0x6e, 0x63, 0x72, 0x20, 0x32, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x75, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x70, 0x61, 0x69, 0x72, 0x3f, 0x20, 0x28, 0x63, 0x64, 0x72, 0x20, 0x70, 0x61, 0x72, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x6c, 0x65, 0x74, 0x2a, 0x20, 0x28, 0x28, 0x75, 0x70, 0x61, 0x72, 0x20, 0x28, 0x63, 0x61, 0x64, 0x72, 0x20, 0x70, 0x61, 0x72, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x75, 0x6f, 0x70, 0x65, 0x6e, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x75, 0x70, 0x61, 0x72, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x75, 0x6e, 0x61, 0x6d, 0x65, 0x2d, 0x62, 0x6f, 0x75, 0x6e, 0x64, 0x73, 0x20, 0x28, 0x63, 0x61, 0x64, 0x64, 0x64, 0x72, 0x20, 0x75, 0x70, 0x61, 0x72, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x75, 0x6e, 0x61, 0x6d, 0x65, 0x2b, 0x61, 0x72, 0x67, 0x73, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x75, 0x6f, 0x70, 0x65, 0x6e, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x75, 0x6e, 0x61, 0x6d, 0x65, 0x2d, 0x62, 0x6f, 0x75, 0x6e, 0x64, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x31, 0x20, 0x28, 0x2b, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x63, 0x61, 0x64, 0x72, 0x20, 0x75, 0x6e, 0x61, 0x6d, 0x65, 0x2d, 0x62, 0x6f, 0x75, 0x6e, 0x64, 0x73, 0x29, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x75, 0x6e, 0x61, 0x6d, 0x65, 0x2d, 0x62, 0x6f, 0x75, 0x6e, 0x64, 0x73, 0x29, 0x29, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x75, 0x77, 0x70, 0x6f, 0x73, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x70, 0x6f, 0x73, 0x69, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x77, 0x68, 0x69, 0x74, 0x65, 0x2d, 0x73, 0x70, 0x61, 0x63, 0x65, 0x20, 0x75, 0x6e, 0x61, 0x6d, 0x65, 0x2b, 0x61, 0x72, 0x67, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x3f, 0x20, 0x75, 0x77, 0x70, 0x6f, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x75, 0x6e, 0x61, 0x6d, 0x65, 0x2b, 0x61, 0x72, 0x67, 0x73, 0x20, 0x30, 0x20, 0x75, 0x77, 0x70, 0x6f, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x75, 0x6e, 0x61, 0x6d, 0x65, 0x2b, 0x61, 0x72, 0x67, 0x73, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x69, 0x66, 0x20, 0x28, 0x6d, 0x65, 0x6d, 0x62, 0x65, 0x72, 0x20, 0x75, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x27, 0x28, 0x22, 0x64, 0x6f, 0x22, 0x20, 0x22, 0x6c, 0x65, 0x74, 0x22, 0x20, 0x22, 0x6c, 0x65, 0x74, 0x2a, 0x22, 0x20, 0x22, 0x6c, 0x65, 0x74, 0x72, 0x65, 0x63, 0x22, 0x20, 0x22, 0x6c, 0x65, 0x74, 0x72, 0x65, 0x63, 0x2a, 0x22, 0x20, 0x22, 0x6c, 0x65, 0x74, 0x2d, 0x74, 0x65, 0x6d, 0x70, 0x6f, 0x72, 0x61, 0x72, 0x69, 0x6c, 0x79, 0x22, 0x29, 0x20, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x3d, 0x3f, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x69, 0x6e, 0x63, 0x72, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x6e, 0x6f, 0x74, 0x68, 0x69, 0x6e, 0x67, 0x20, 0x61, 0x66, 0x74, 0x65, 0x72, 0x20, 0x74, 0x68, 0x65, 0x20, 0x28, 0x20, 0x6f, 0x6e, 0x20, 0x69, 0x74, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x2c, 0x20, 0x6d, 0x69, 0x67, 0x68, 0x74, 0x20, 0x62, 0x65, 0x20, 0x6d, 0x6f, 0x76, 0x69, 0x6e, 0x67, 0x20, 0x62, 0x61, 0x63, 0x6b, 0x2c, 0x20, 0x73, 0x6f, 0x20, 0x77, 0x65, 0x20, 0x6e, 0x65, 0x65, 0x64, 0x20, 0x74, 0x6f, 0x20, 0x65, 0x72, 0x61, 0x73, 0x65, 0x20, 0x74, 0x68, 0x65, 0x20, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x20, 0x6c, 0x69, 0x6e, 0x65, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x6c, 0x65, 0x61, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x72, 0x6f, 0x77, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x30, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x23, 0x66, 0x20, 0x22, 0x7e, 0x4e, 0x43, 0x7e, 0x41, 0x22, 0x20, 0x28, 0x2b, 0x20, 0x6f, 0x70, 0x65, 0x6e, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x69, 0x6e, 0x63, 0x72, 0x29, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x20, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x65, 0x72, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2b, 0x20, 0x6f, 0x70, 0x65, 0x6e, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x69, 0x6e, 0x63, 0x72, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x65, 0x72, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x28, 0x2b, 0x20, 0x6f, 0x70, 0x65, 0x6e, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x69, 0x6e, 0x63, 0x72, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x73, 0x6c, 0x69, 0x63, 0x65, 0x29, 0x29, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x6b, 0x65, 0x65, 0x70, 0x20, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x20, 0x69, 0x6e, 0x20, 0x69, 0x74, 0x73, 0x20, 0x72, 0x65, 0x6c, 0x61, 0x74, 0x69, 0x76, 0x65, 0x2d, 0x74, 0x6f, 0x2d, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x65, 0x72, 0x20, 0x70, 0x6f, 0x73, 0x69, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x69, 0x66, 0x20, 0x70, 0x6f, 0x73, 0x73, 0x69, 0x62, 0x6c, 0x65, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x2a, 0x20, 0x28, 0x28, 0x6e, 0x61, 0x6d, 0x65, 0x2b, 0x61, 0x72, 0x67, 0x73, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x6f, 0x70, 0x65, 0x6e, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x2d, 0x62, 0x6f, 0x75, 0x6e, 0x64, 0x73, 0x29, 0x20, 0x31, 0x20, 0x28, 0x2b, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x63, 0x61, 0x64, 0x72, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x2d, 0x62, 0x6f, 0x75, 0x6e, 0x64, 0x73, 0x29, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x2d, 0x62, 0x6f, 0x75, 0x6e, 0x64, 0x73, 0x29, 0x29, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x77, 0x70, 0x6f, 0x73, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x70, 0x6f, 0x73, 0x69, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x77, 0x68, 0x69, 0x74, 0x65, 0x2d, 0x73, 0x70, 0x61, 0x63, 0x65, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x2b, 0x61, 0x72, 0x67, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x3f, 0x20, 0x77, 0x70, 0x6f, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x2b, 0x61, 0x72, 0x67, 0x73, 0x20, 0x30, 0x20, 0x77, 0x70, 0x6f, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x2b, 0x61, 0x72, 0x67, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x69, 0x6e, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x6f, 0x6e, 0x64, 0x20, 0x28, 0x28, 0x6d, 0x65, 0x6d, 0x62, 0x65, 0x72, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x27, 0x28, 0x22, 0x63, 0x6f, 0x6e, 0x64, 0x22, 0x20, 0x22, 0x77, 0x68, 0x65, 0x6e, 0x22, 0x20, 0x22, 0x75, 0x6e, 0x6c, 0x65, 0x73, 0x73, 0x22, 0x20, 0x22, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x22, 0x20, 0x22, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x2a, 0x22, 0x20, 0x22, 0x62, 0x65, 0x67, 0x69, 0x6e, 0x22, 0x20, 0x22, 0x63, 0x61, 0x73, 0x65, 0x22, 0x20, 0x22, 0x77, 0x69, 0x74, 0x68, 0x2d, 0x6c, 0x65, 0x74, 0x22, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x22, 0x6c, 0x65, 0x74, 0x22, 0x20, 0x22, 0x6c, 0x65, 0x74, 0x2a, 0x22, 0x20, 0x22, 0x6c, 0x65, 0x74, 0x72, 0x65, 0x63, 0x22, 0x20, 0x22, 0x6c, 0x65, 0x74, 0x72, 0x65, 0x63, 0x2a, 0x22, 0x20, 0x22, 0x6c, 0x65, 0x74, 0x2d, 0x74, 0x65, 0x6d, 0x70, 0x6f, 0x72, 0x61, 0x72, 0x69, 0x6c, 0x79, 0x22, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x22, 0x63, 0x61, 0x6c, 0x6c, 0x2d, 0x77, 0x69, 0x74, 0x68, 0x2d, 0x65, 0x78, 0x69, 0x74, 0x22, 0x20, 0x22, 0x63, 0x61, 0x6c, 0x6c, 0x2f, 0x63, 0x63, 0x22, 0x20, 0x22, 0x63, 0x61, 0x6c, 0x6c, 0x2d, 0x77, 0x69, 0x74, 0x68, 0x2d, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x2d, 0x63, 0x6f, 0x6e, 0x74, 0x69, 0x6e, 0x75, 0x61, 0x74, 0x69, 0x6f, 0x6e, 0x22, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x22, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x22, 0x20, 0x22, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x2a, 0x22, 0x20, 0x22, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x2d, 0x6d, 0x61, 0x63, 0x72, 0x6f, 0x22, 0x20, 0x22, 0x63, 0x61, 0x74, 0x63, 0x68, 0x22, 0x20, 0x22, 0x73, 0x75, 0x62, 0x6c, 0x65, 0x74, 0x22, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x3d, 0x3f, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x32, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x3d, 0x3f, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x22, 0x64, 0x6f, 0x22, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3d, 0x20, 0x76, 0x69, 0x73, 0x69, 0x74, 0x73, 0x20, 0x31, 0x29, 0x20, 0x34, 0x20, 0x32, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x28, 0x6d, 0x65, 0x6d, 0x62, 0x65, 0x72, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x27, 0x28, 0x22, 0x63, 0x61, 0x6c, 0x6c, 0x2d, 0x77, 0x69, 0x74, 0x68, 0x2d, 0x69, 0x6e, 0x70, 0x75, 0x74, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x22, 0x20, 0x22, 0x63, 0x61, 0x6c, 0x6c, 0x2d, 0x77, 0x69, 0x74, 0x68, 0x2d, 0x69, 0x6e, 0x70, 0x75, 0x74, 0x2d, 0x66, 0x69, 0x6c, 0x65, 0x22, 0x29, 0x20, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x3d, 0x3f, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3d, 0x20, 0x6f, 0x70, 0x65, 0x6e, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x29, 0x20, 0x34, 0x20, 0x32, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x65, 0x6c, 0x73, 0x65, 0x20, 0x28, 0x2b, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x29, 0x20, 0x32, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x6d, 0x69, 0x67, 0x68, 0x74, 0x20, 0x62, 0x65, 0x20, 0x6d, 0x6f, 0x76, 0x69, 0x6e, 0x67, 0x20, 0x62, 0x61, 0x63, 0x6b, 0x2c, 0x20, 0x73, 0x6f, 0x20, 0x77, 0x65, 0x20, 0x6e, 0x65, 0x65, 0x64, 0x20, 0x74, 0x6f, 0x20, 0x65, 0x72, 0x61, 0x73, 0x65, 0x20, 0x74, 0x68, 0x65, 0x20, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x20, 0x6c, 0x69, 0x6e, 0x65, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x6c, 0x65, 0x61, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x72, 0x6f, 0x77, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x30, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x23, 0x66, 0x20, 0x22, 0x7e, 0x4e, 0x43, 0x7e, 0x41, 0x22, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x6e, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x20, 0x6f, 0x70, 0x65, 0x6e, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x20, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x65, 0x72, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2b, 0x20, 0x6f, 0x70, 0x65, 0x6e, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x69, 0x6e, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x65, 0x72, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x30, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x28, 0x2b, 0x20, 0x6f, 0x70, 0x65, 0x6e, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x69, 0x6e, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x73, 0x6c, 0x69, 0x63, 0x65, 0x29, 0x29, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x6b, 0x65, 0x65, 0x70, 0x20, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x20, 0x69, 0x6e, 0x20, 0x69, 0x74, 0x73, 0x20, 0x72, 0x65, 0x6c, 0x61, 0x74, 0x69, 0x76, 0x65, 0x2d, 0x74, 0x6f, 0x2d, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x65, 0x72, 0x20, 0x70, 0x6f, 0x73, 0x69, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x69, 0x66, 0x20, 0x70, 0x6f, 0x73, 0x73, 0x69, 0x62, 0x6c, 0x65, 0x2c, 0x20, 0x62, 0x75, 0x74, 0x20, 0x73, 0x71, 0x75, 0x65, 0x65, 0x7a, 0x65, 0x20, 0x73, 0x6c, 0x69, 0x63, 0x65, 0x20, 0x28, 0x73, 0x70, 0x61, 0x63, 0x65, 0x29, 0x20, 0x69, 0x66, 0x20, 0x6e, 0x6f, 0x74, 0x20, 0x65, 0x6e, 0x6f, 0x75, 0x67, 0x68, 0x20, 0x72, 0x6f, 0x6f, 0x6d, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x20, 0x74, 0x61, 0x62, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x74, 0x61, 0x62, 0x20, 0x63, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3c, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x69, 0x6e, 0x64, 0x65, 0x6e, 0x74, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x73, 0x74, 0x61, 0x72, 0x74, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x65, 0x6e, 0x64, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3d, 0x20, 0x65, 0x6e, 0x64, 0x20, 0x73, 0x74, 0x61, 0x72, 0x74, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x62, 0x65, 0x67, 0x69, 0x6e, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x65, 0x6e, 0x64, 0x20, 0x22, 0x20, 0x20, 0x20, 0x20, 0x22, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2b, 0x20, 0x65, 0x6e, 0x64, 0x20, 0x34, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x69, 0x6e, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x34, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x6c, 0x6f, 0x6f, 0x70, 0x20, 0x28, 0x28, 0x69, 0x20, 0x30, 0x29, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x3c, 0x20, 0x69, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x77, 0x68, 0x69, 0x74, 0x65, 0x73, 0x70, 0x61, 0x63, 0x65, 0x3f, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x69, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x6f, 0x6f, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x69, 0x6e, 0x64, 0x65, 0x6e, 0x74, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x6c, 0x6f, 0x63, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x69, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x29, 0x20, 0x31, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x3c, 0x20, 0x69, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x77, 0x68, 0x69, 0x74, 0x65, 0x73, 0x70, 0x61, 0x63, 0x65, 0x3f, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x69, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6d, 0x65, 0x6d, 0x76, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x69, 0x29, 0x20, 0x27, 0x28, 0x23, 0x5c, 0x28, 0x20, 0x23, 0x5c, 0x27, 0x20, 0x23, 0x5c, 0x22, 0x20, 0x23, 0x5c, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x69, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3d, 0x20, 0x28, 0x2b, 0x20, 0x6c, 0x6f, 0x63, 0x20, 0x31, 0x29, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x69, 0x6e, 0x64, 0x65, 0x6e, 0x74, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x63, 0x6f, 0x6d, 0x70, 0x6c, 0x65, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3c, 0x20, 0x6c, 0x6f, 0x63, 0x20, 0x30, 0x29, 0x20, 0x3b, 0x20, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x20, 0x77, 0x68, 0x6f, 0x6c, 0x65, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x2d, 0x63, 0x6f, 0x6d, 0x70, 0x6c, 0x65, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x28, 0x69, 0x66, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x3d, 0x3f, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x6c, 0x6f, 0x63, 0x29, 0x20, 0x23, 0x5c, 0x22, 0x29, 0x20, 0x66, 0x69, 0x6c, 0x65, 0x6e, 0x61, 0x6d, 0x65, 0x2d, 0x63, 0x6f, 0x6d, 0x70, 0x6c, 0x65, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x2d, 0x63, 0x6f, 0x6d, 0x70, 0x6c, 0x65, 0x74, 0x69, 0x6f, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x2b, 0x20, 0x6c, 0x6f, 0x63, 0x20, 0x31, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x63, 0x6f, 0x6d, 0x70, 0x6c, 0x65, 0x74, 0x69, 0x6f, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x28, 0x69, 0x6e, 0x64, 0x65, 0x6e, 0x74, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x75, 0x6e, 0x6c, 0x65, 0x73, 0x73, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x3d, 0x3f, 0x20, 0x63, 0x6f, 0x6d, 0x70, 0x6c, 0x65, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3e, 0x3d, 0x20, 0x6c, 0x6f, 0x63, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x63, 0x6f, 0x6d, 0x70, 0x6c, 0x65, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x2d, 0x61, 0x70, 0x70, 0x65, 0x6e, 0x64, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x30, 0x20, 0x28, 0x2b, 0x20, 0x6c, 0x6f, 0x63, 0x20, 0x31, 0x29, 0x29, 0x20, 0x63, 0x6f, 0x6d, 0x70, 0x6c, 0x65, 0x74, 0x69, 0x6f, 0x6e, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x3d, 0x3f, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x6c, 0x6f, 0x63, 0x29, 0x20, 0x23, 0x5c, 0x22, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x63, 0x6f, 0x6d, 0x70, 0x6c, 0x65, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x2d, 0x61, 0x70, 0x70, 0x65, 0x6e, 0x64, 0x20, 0x63, 0x6f, 0x6d, 0x70, 0x6c, 0x65, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x22, 0x5c, 0x22, 0x22, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6d, 0x70, 0x6c, 0x65, 0x74, 0x69, 0x6f, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x2b, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x63, 0x6f, 0x6d, 0x70, 0x6c, 0x65, 0x74, 0x69, 0x6f, 0x6e, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x20, 0x72, 0x75, 0x6e, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x72, 0x65, 0x70, 0x72, 0x6f, 0x6d, 0x70, 0x74, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x61, 0x74, 0x63, 0x68, 0x20, 0x23, 0x74, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x6e, 0x69, 0x20, 0x28, 0x6e, 0x63, 0x69, 0x6e, 0x70, 0x75, 0x74, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6d, 0x6f, 0x75, 0x73, 0x65, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6d, 0x6f, 0x75, 0x73, 0x65, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x72, 0x65, 0x70, 0x6c, 0x2d, 0x64, 0x6f, 0x6e, 0x65, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x22, 0x22, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x70, 0x72, 0x65, 0x76, 0x69, 0x6f, 0x75, 0x73, 0x6c, 0x79, 0x2d, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x65, 0x64, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6a, 0x75, 0x73, 0x74, 0x2d, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x65, 0x64, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x6f, 0x6e, 0x74, 0x72, 0x6f, 0x6c, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x61, 0x73, 0x68, 0x20, 0x31, 0x20, 0x33, 0x33, 0x29, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6d, 0x65, 0x74, 0x61, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x61, 0x73, 0x68, 0x20, 0x31, 0x20, 0x33, 0x34, 0x29, 0x29, 0x29, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x20, 0x67, 0x65, 0x74, 0x20, 0x72, 0x65, 0x74, 0x75, 0x72, 0x6e, 0x73, 0x20, 0x33, 0x32, 0x20, 0x62, 0x69, 0x74, 0x73, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x74, 0x6f, 0x70, 0x2d, 0x6c, 0x65, 0x76, 0x65, 0x6c, 0x2d, 0x6c, 0x65, 0x74, 0x20, 0x27, 0x6e, 0x63, 0x70, 0x2d, 0x6c, 0x65, 0x74, 0x29, 0x20, 0x28, 0x63, 0x75, 0x72, 0x6c, 0x65, 0x74, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x64, 0x65, 0x62, 0x75, 0x67, 0x2d, 0x69, 0x6e, 0x66, 0x6f, 0x20, 0x6c, 0x6f, 0x63, 0x61, 0x6c, 0x2d, 0x64, 0x65, 0x62, 0x75, 0x67, 0x2d, 0x69, 0x6e, 0x66, 0x6f, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x72, 0x65, 0x6d, 0x6f, 0x76, 0x65, 0x2d, 0x77, 0x61, 0x74, 0x63, 0x68, 0x65, 0x72, 0x20, 0x6c, 0x6f, 0x63, 0x61, 0x6c, 0x2d, 0x72, 0x65, 0x6d, 0x6f, 0x76, 0x65, 0x2d, 0x77, 0x61, 0x74, 0x63, 0x68, 0x65, 0x72, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x20, 0x65, 0x6e, 0x74, 0x65, 0x72, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x65, 0x6e, 0x74, 0x65, 0x72, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x65, 0x69, 0x74, 0x68, 0x65, 0x72, 0x20, 0x65, 0x76, 0x61, 0x6c, 0x2f, 0x70, 0x72, 0x69, 0x6e, 0x74, 0x20, 0x6f, 0x72, 0x20, 0x69, 0x6e, 0x73, 0x65, 0x72, 0x74, 0x20, 0x6e, 0x65, 0x77, 0x6c, 0x69, 0x6e, 0x65, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x73, 0x74, 0x64, 0x69, 0x6e, 0x2d, 0x77, 0x72, 0x61, 0x70, 0x70, 0x65, 0x72, 0x20, 0x28, 0x6f, 0x70, 0x65, 0x6e, 0x2d, 0x69, 0x6e, 0x70, 0x75, 0x74, 0x2d, 0x66, 0x75, 0x6e, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x3b, 0x20, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x2d, 0x69, 0x6e, 0x70, 0x75, 0x74, 0x2d, 0x70, 0x6f, 0x72, 0x74, 0x20, 0x66, 0x6f, 0x72, 0x20, 0x73, 0x63, 0x68, 0x65, 0x6d, 0x65, 0x20, 0x69, 0x6e, 0x70, 0x75, 0x74, 0x20, 0x69, 0x6e, 0x20, 0x72, 0x65, 0x70, 0x6c, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x68, 0x6f, 0x69, 0x63, 0x65, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x61, 0x73, 0x65, 0x20, 0x63, 0x68, 0x6f, 0x69, 0x63, 0x65, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x28, 0x72, 0x65, 0x61, 0x64, 0x20, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x72, 0x65, 0x61, 0x64, 0x79, 0x3f, 0x20, 0x70, 0x65, 0x65, 0x6b, 0x2d, 0x63, 0x68, 0x61, 0x72, 0x29, 0x20, 0x22, 0x3f, 0x22, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x28, 0x72, 0x65, 0x61, 0x64, 0x2d, 0x63, 0x68, 0x61, 0x72, 0x29, 0x20, 0x28, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x2d, 0x3e, 0x63, 0x68, 0x61, 0x72, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x67, 0x65, 0x74, 0x63, 0x20, 0x6e, 0x63, 0x20, 0x28, 0x63, 0x2d, 0x70, 0x6f, 0x69, 0x6e, 0x74, 0x65, 0x72, 0x20, 0x30, 0x29, 0x20, 0x28, 0x63, 0x2d, 0x70, 0x6f, 0x69, 0x6e, 0x74, 0x65, 0x72, 0x20, 0x30, 0x29, 0x20, 0x6e, 0x69, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x28, 0x72, 0x65, 0x61, 0x64, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x6c, 0x6f, 0x6f, 0x70, 0x20, 0x28, 0x28, 0x73, 0x74, 0x72, 0x20, 0x22, 0x22, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x63, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x67, 0x65, 0x74, 0x63, 0x20, 0x6e, 0x63, 0x20, 0x28, 0x63, 0x2d, 0x70, 0x6f, 0x69, 0x6e, 0x74, 0x65, 0x72, 0x20, 0x30, 0x29, 0x20, 0x28, 0x63, 0x2d, 0x70, 0x6f, 0x69, 0x6e, 0x74, 0x65, 0x72, 0x20, 0x30, 0x29, 0x20, 0x6e, 0x69, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x3d, 0x20, 0x63, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x6e, 0x65, 0x77, 0x6c, 0x69, 0x6e, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x3e, 0x20, 0x63, 0x20, 0x32, 0x35, 0x35, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x73, 0x74, 0x72, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6c, 0x6f, 0x6f, 0x70, 0x20, 0x28, 0x61, 0x70, 0x70, 0x65, 0x6e, 0x64, 0x20, 0x73, 0x74, 0x72, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x2d, 0x3e, 0x63, 0x68, 0x61, 0x72, 0x20, 0x63, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x20, 0x65, 0x76, 0x61, 0x6c, 0x75, 0x61, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x62, 0x61, 0x64, 0x65, 0x78, 0x70, 0x72, 0x20, 0x68, 0x29, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x2a, 0x6d, 0x69, 0x73, 0x73, 0x69, 0x6e, 0x67, 0x2d, 0x63, 0x6c, 0x6f, 0x73, 0x65, 0x2d, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x2d, 0x68, 0x6f, 0x6f, 0x6b, 0x2a, 0x20, 0x66, 0x75, 0x6e, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x66, 0x6f, 0x72, 0x20, 0x45, 0x6e, 0x74, 0x65, 0x72, 0x20, 0x63, 0x6f, 0x6d, 0x6d, 0x61, 0x6e, 0x64, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x6f, 0x77, 0x20, 0x28, 0x6f, 0x77, 0x6c, 0x65, 0x74, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x6f, 0x77, 0x20, 0x27, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x2d, 0x66, 0x69, 0x6c, 0x65, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x28, 0x65, 0x71, 0x75, 0x61, 0x6c, 0x3f, 0x20, 0x28, 0x6f, 0x77, 0x20, 0x27, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x2d, 0x66, 0x69, 0x6c, 0x65, 0x29, 0x20, 0x22, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x2e, 0x73, 0x63, 0x6d, 0x22, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x20, 0x27, 0x73, 0x79, 0x6e, 0x74, 0x61, 0x78, 0x2d, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x20, 0x22, 0x6d, 0x69, 0x73, 0x73, 0x69, 0x6e, 0x67, 0x20, 0x63, 0x6c, 0x6f, 0x73, 0x65, 0x20, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x20, 0x69, 0x6e, 0x20, 0x7e, 0x53, 0x22, 0x20, 0x28, 0x6f, 0x77, 0x20, 0x27, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x2d, 0x66, 0x69, 0x6c, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x68, 0x20, 0x27, 0x72, 0x65, 0x73, 0x75, 0x6c, 0x74, 0x29, 0x20, 0x27, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x2d, 0x72, 0x65, 0x61, 0x64, 0x2d, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x73, 0x68, 0x65, 0x6c, 0x6c, 0x3f, 0x20, 0x68, 0x29, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x2a, 0x75, 0x6e, 0x62, 0x6f, 0x75, 0x6e, 0x64, 0x2d, 0x76, 0x61, 0x72, 0x69, 0x61, 0x62, 0x6c, 0x65, 0x2d, 0x68, 0x6f, 0x6f, 0x6b, 0x2a, 0x20, 0x66, 0x75, 0x6e, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x2c, 0x20, 0x61, 0x6c, 0x73, 0x6f, 0x20, 0x66, 0x6f, 0x72, 0x20, 0x45, 0x6e, 0x74, 0x65, 0x72, 0xa, 
+  0x9, 0x9, 0x9, 0x3b, 0x3b, 0x20, 0x65, 0x78, 0x61, 0x6d, 0x69, 0x6e, 0x65, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x2d, 0x2d, 0x20, 0x6f, 0x6e, 0x6c, 0x79, 0x20, 0x63, 0x61, 0x6c, 0x6c, 0x20, 0x73, 0x79, 0x73, 0x74, 0x65, 0x6d, 0x20, 0x69, 0x66, 0x20, 0x74, 0x68, 0x65, 0x20, 0x75, 0x6e, 0x62, 0x6f, 0x75, 0x6e, 0x64, 0x20, 0x76, 0x61, 0x72, 0x69, 0x61, 0x62, 0x6c, 0x65, 0x20, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x65, 0x73, 0x20, 0x74, 0x68, 0x65, 0x20, 0x66, 0x69, 0x72, 0x73, 0x74, 0x20, 0x6e, 0x6f, 0x6e, 0x2d, 0x77, 0x68, 0x69, 0x74, 0x65, 0x73, 0x70, 0x61, 0x63, 0x65, 0x20, 0x63, 0x68, 0x61, 0x72, 0x73, 0xa, 
+  0x9, 0x9, 0x9, 0x3b, 0x3b, 0x20, 0x20, 0x20, 0x6f, 0x66, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x2c, 0x20, 0x61, 0x6e, 0x64, 0x20, 0x63, 0x6f, 0x6d, 0x6d, 0x61, 0x6e, 0x64, 0x20, 0x2d, 0x76, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x72, 0x65, 0x74, 0x75, 0x72, 0x6e, 0x73, 0x20, 0x30, 0x20, 0x28, 0x69, 0x6e, 0x64, 0x69, 0x63, 0x61, 0x74, 0x69, 0x6e, 0x67, 0x20, 0x74, 0x68, 0x65, 0x20, 0x73, 0x68, 0x65, 0x6c, 0x6c, 0x20, 0x74, 0x68, 0x69, 0x6e, 0x6b, 0x73, 0x20, 0x69, 0x74, 0x20, 0x69, 0x73, 0x20, 0x61, 0x6e, 0x20, 0x65, 0x78, 0x65, 0x63, 0x75, 0x74, 0x61, 0x62, 0x6c, 0x65, 0x20, 0x63, 0x6f, 0x6d, 0x6d, 0x61, 0x6e, 0x64, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x28, 0x2d, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x2d, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x29, 0x20, 0x31, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x61, 0x74, 0x20, 0x74, 0x68, 0x69, 0x73, 0x20, 0x70, 0x6f, 0x69, 0x6e, 0x74, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x68, 0x61, 0x73, 0x20, 0x6e, 0x6f, 0x74, 0x20, 0x62, 0x65, 0x65, 0x6e, 0x20, 0x73, 0x65, 0x74, 0x2c, 0x20, 0x73, 0x6f, 0x20, 0x75, 0x73, 0x65, 0x20, 0x63, 0x6f, 0x6c, 0x3f, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x69, 0x20, 0x30, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x3d, 0x20, 0x69, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x77, 0x68, 0x69, 0x74, 0x65, 0x73, 0x70, 0x61, 0x63, 0x65, 0x3f, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x69, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x76, 0x61, 0x72, 0x2d, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x28, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x2d, 0x3e, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x68, 0x20, 0x27, 0x76, 0x61, 0x72, 0x69, 0x61, 0x62, 0x6c, 0x65, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x3e, 0x3d, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x29, 0x20, 0x69, 0x29, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x76, 0x61, 0x72, 0x2d, 0x6e, 0x61, 0x6d, 0x65, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x76, 0x61, 0x72, 0x2d, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x6d, 0x69, 0x67, 0x68, 0x74, 0x20, 0x62, 0x65, 0x20, 0x75, 0x6e, 0x72, 0x65, 0x6c, 0x61, 0x74, 0x65, 0x64, 0x20, 0x74, 0x6f, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x3d, 0x3f, 0x20, 0x76, 0x61, 0x72, 0x2d, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x69, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x76, 0x61, 0x72, 0x2d, 0x6e, 0x61, 0x6d, 0x65, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x7a, 0x65, 0x72, 0x6f, 0x3f, 0x20, 0x28, 0x73, 0x79, 0x73, 0x74, 0x65, 0x6d, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x2d, 0x61, 0x70, 0x70, 0x65, 0x6e, 0x64, 0x20, 0x22, 0x63, 0x6f, 0x6d, 0x6d, 0x61, 0x6e, 0x64, 0x20, 0x2d, 0x76, 0x20, 0x22, 0x20, 0x76, 0x61, 0x72, 0x2d, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x22, 0x20, 0x3e, 0x2f, 0x64, 0x65, 0x76, 0x2f, 0x6e, 0x75, 0x6c, 0x6c, 0x22, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x68, 0x20, 0x27, 0x72, 0x65, 0x73, 0x75, 0x6c, 0x74, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x70, 0x72, 0x6f, 0x63, 0x65, 0x64, 0x75, 0x72, 0x65, 0x3f, 0x20, 0x28, 0x28, 0x72, 0x6f, 0x6f, 0x74, 0x6c, 0x65, 0x74, 0x29, 0x20, 0x27, 0x73, 0x79, 0x73, 0x74, 0x65, 0x6d, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x28, 0x72, 0x6f, 0x6f, 0x74, 0x6c, 0x65, 0x74, 0x29, 0x20, 0x27, 0x73, 0x79, 0x73, 0x74, 0x65, 0x6d, 0x29, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x23, 0x74, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x6e, 0x65, 0x77, 0x2d, 0x65, 0x76, 0x61, 0x6c, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x2b, 0x64, 0x6f, 0x63, 0x75, 0x6d, 0x65, 0x6e, 0x74, 0x61, 0x74, 0x69, 0x6f, 0x6e, 0x2b, 0x20, 0x22, 0x74, 0x68, 0x69, 0x73, 0x20, 0x69, 0x73, 0x20, 0x74, 0x68, 0x65, 0x20, 0x72, 0x65, 0x70, 0x6c, 0x27, 0x73, 0x20, 0x65, 0x76, 0x61, 0x6c, 0x20, 0x72, 0x65, 0x70, 0x6c, 0x61, 0x63, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x3b, 0x20, 0x69, 0x74, 0x73, 0x20, 0x64, 0x65, 0x66, 0x61, 0x75, 0x6c, 0x74, 0x20, 0x69, 0x73, 0x20, 0x74, 0x6f, 0x20, 0x75, 0x73, 0x65, 0x20, 0x74, 0x68, 0x65, 0x20, 0x72, 0x65, 0x70, 0x6c, 0x27, 0x73, 0x20, 0x74, 0x6f, 0x70, 0x2d, 0x6c, 0x65, 0x76, 0x65, 0x6c, 0x2d, 0x6c, 0x65, 0x74, 0x2e, 0x22, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x2b, 0x73, 0x69, 0x67, 0x6e, 0x61, 0x74, 0x75, 0x72, 0x65, 0x2b, 0x20, 0x27, 0x28, 0x76, 0x61, 0x6c, 0x75, 0x65, 0x73, 0x20, 0x23, 0x74, 0x20, 0x6c, 0x65, 0x74, 0x3f, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x20, 0x2e, 0x20, 0x72, 0x65, 0x73, 0x74, 0x29, 0x20, 0x3b, 0x20, 0x75, 0x73, 0x65, 0x20, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x2a, 0x29, 0x20, 0x73, 0x6f, 0x20, 0x77, 0x65, 0x20, 0x63, 0x61, 0x6e, 0x20, 0x68, 0x61, 0x6e, 0x64, 0x6c, 0x65, 0x20, 0x66, 0x6f, 0x72, 0x6d, 0x73, 0x20, 0x6c, 0x69, 0x6b, 0x65, 0x20, 0x3a, 0x6b, 0x65, 0x79, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x65, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x70, 0x61, 0x69, 0x72, 0x3f, 0x20, 0x72, 0x65, 0x73, 0x74, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x72, 0x65, 0x73, 0x74, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x2a, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x2a, 0x20, 0x27, 0x74, 0x6f, 0x70, 0x2d, 0x6c, 0x65, 0x76, 0x65, 0x6c, 0x2d, 0x6c, 0x65, 0x74, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x2d, 0x74, 0x65, 0x6d, 0x70, 0x6f, 0x72, 0x61, 0x72, 0x69, 0x6c, 0x79, 0x20, 0x28, 0x28, 0x28, 0x68, 0x6f, 0x6f, 0x6b, 0x2d, 0x66, 0x75, 0x6e, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x73, 0x20, 0x2a, 0x75, 0x6e, 0x62, 0x6f, 0x75, 0x6e, 0x64, 0x2d, 0x76, 0x61, 0x72, 0x69, 0x61, 0x62, 0x6c, 0x65, 0x2d, 0x68, 0x6f, 0x6f, 0x6b, 0x2a, 0x29, 0x20, 0x28, 0x6c, 0x69, 0x73, 0x74, 0x20, 0x73, 0x68, 0x65, 0x6c, 0x6c, 0x3f, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x73, 0x6f, 0x20, 0x70, 0x77, 0x64, 0x20, 0x65, 0x74, 0x20, 0x61, 0x6c, 0x20, 0x77, 0x69, 0x6c, 0x6c, 0x20, 0x77, 0x6f, 0x72, 0x6b, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x28, 0x2a, 0x73, 0x37, 0x2a, 0x20, 0x27, 0x68, 0x69, 0x73, 0x74, 0x6f, 0x72, 0x79, 0x2d, 0x65, 0x6e, 0x61, 0x62, 0x6c, 0x65, 0x64, 0x29, 0x20, 0x23, 0x74, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x65, 0x76, 0x61, 0x6c, 0x20, 0x66, 0x6f, 0x72, 0x6d, 0x20, 0x65, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x2d, 0x65, 0x78, 0x70, 0x72, 0x65, 0x73, 0x73, 0x69, 0x6f, 0x6e, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3e, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x69, 0x20, 0x28, 0x2d, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x28, 0x7a, 0x65, 0x72, 0x6f, 0x3f, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x69, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x65, 0x78, 0x70, 0x72, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x69, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x69, 0x29, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x69, 0x29, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x69, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x6e, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x20, 0x28, 0x2b, 0x20, 0x6e, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x3e, 0x20, 0x6e, 0x72, 0x6f, 0x77, 0x20, 0x72, 0x6f, 0x77, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x65, 0x78, 0x70, 0x72, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x65, 0x78, 0x70, 0x72, 0x20, 0x28, 0x61, 0x70, 0x70, 0x65, 0x6e, 0x64, 0x20, 0x65, 0x78, 0x70, 0x72, 0x20, 0x22, 0x5c, 0x6e, 0x22, 0x20, 0x3b, 0x20, 0x6e, 0x65, 0x65, 0x64, 0x20, 0x6e, 0x65, 0x77, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x74, 0x6f, 0x20, 0x74, 0x65, 0x72, 0x6d, 0x69, 0x6e, 0x61, 0x74, 0x65, 0x20, 0x63, 0x6f, 0x6d, 0x6d, 0x65, 0x6e, 0x74, 0x73, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x6e, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x6e, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x6e, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x6e, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x2d, 0x65, 0x78, 0x70, 0x72, 0x65, 0x73, 0x73, 0x69, 0x6f, 0x6e, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x69, 0x6e, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3e, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x6c, 0x65, 0x61, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x63, 0x61, 0x6c, 0x6c, 0x2d, 0x77, 0x69, 0x74, 0x68, 0x2d, 0x65, 0x78, 0x69, 0x74, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x72, 0x65, 0x74, 0x75, 0x72, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x6c, 0x65, 0x6e, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x69, 0x20, 0x30, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x63, 0x68, 0x65, 0x63, 0x6b, 0x20, 0x66, 0x6f, 0x72, 0x20, 0x6a, 0x75, 0x73, 0x74, 0x20, 0x77, 0x68, 0x69, 0x74, 0x65, 0x73, 0x70, 0x61, 0x63, 0x65, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x3d, 0x20, 0x69, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x77, 0x68, 0x69, 0x74, 0x65, 0x73, 0x70, 0x61, 0x63, 0x65, 0x3f, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x69, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3d, 0x20, 0x69, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x72, 0x65, 0x74, 0x75, 0x72, 0x6e, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x61, 0x74, 0x63, 0x68, 0x20, 0x23, 0x74, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x63, 0x61, 0x74, 0x63, 0x68, 0x20, 0x27, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x2d, 0x72, 0x65, 0x61, 0x64, 0x2d, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x20, 0x3b, 0x20, 0x74, 0x68, 0x69, 0x73, 0x20, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x65, 0x73, 0x20, 0x28, 0x74, 0x68, 0x72, 0x6f, 0x77, 0x20, 0x23, 0x74, 0x20, 0x35, 0x29, 0x20, 0x2d, 0x2d, 0x20, 0x69, 0x73, 0x20, 0x74, 0x68, 0x69, 0x73, 0x20, 0x63, 0x6f, 0x72, 0x72, 0x65, 0x63, 0x74, 0x3f, 0x20, 0x2a, 0x6d, 0x69, 0x73, 0x73, 0x69, 0x6e, 0x67, 0x2d, 0x63, 0x6c, 0x6f, 0x73, 0x65, 0x2d, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x2d, 0x68, 0x6f, 0x6f, 0x6b, 0x2a, 0x20, 0x72, 0x65, 0x74, 0x75, 0x72, 0x6e, 0x73, 0x20, 0x27, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x2d, 0x72, 0x65, 0x61, 0x64, 0x2d, 0x65, 0x72, 0x72, 0x6f, 0x72, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x2d, 0x74, 0x65, 0x6d, 0x70, 0x6f, 0x72, 0x61, 0x72, 0x69, 0x6c, 0x79, 0x20, 0x28, 0x28, 0x28, 0x68, 0x6f, 0x6f, 0x6b, 0x2d, 0x66, 0x75, 0x6e, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x73, 0x20, 0x2a, 0x6d, 0x69, 0x73, 0x73, 0x69, 0x6e, 0x67, 0x2d, 0x63, 0x6c, 0x6f, 0x73, 0x65, 0x2d, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x2d, 0x68, 0x6f, 0x6f, 0x6b, 0x2a, 0x29, 0x20, 0x28, 0x6c, 0x69, 0x73, 0x74, 0x20, 0x62, 0x61, 0x64, 0x65, 0x78, 0x70, 0x72, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x68, 0x6f, 0x6f, 0x6b, 0x2d, 0x66, 0x75, 0x6e, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x73, 0x20, 0x2a, 0x72, 0x65, 0x61, 0x64, 0x2d, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x2d, 0x68, 0x6f, 0x6f, 0x6b, 0x2a, 0x29, 0x20, 0x28, 0x29, 0x29, 0x29, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x6c, 0x69, 0x6e, 0x74, 0x20, 0x73, 0x65, 0x74, 0x73, 0x20, 0x74, 0x68, 0x69, 0x73, 0x20, 0x61, 0x6e, 0x64, 0x20, 0x6d, 0x65, 0x73, 0x73, 0x65, 0x73, 0x20, 0x75, 0x70, 0x20, 0x6f, 0x75, 0x72, 0x20, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x20, 0x72, 0x65, 0x70, 0x6f, 0x72, 0x74, 0x69, 0x6e, 0x67, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x63, 0x61, 0x74, 0x63, 0x68, 0x20, 0x61, 0x6e, 0x64, 0x20, 0x72, 0x65, 0x70, 0x6f, 0x72, 0x74, 0x20, 0x72, 0x65, 0x61, 0x64, 0x65, 0x72, 0x20, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x73, 0x20, 0x61, 0x73, 0x20, 0x77, 0x65, 0x6c, 0x6c, 0x20, 0x61, 0x73, 0x20, 0x65, 0x76, 0x61, 0x6c, 0x20, 0x74, 0x72, 0x6f, 0x75, 0x62, 0x6c, 0x65, 0x73, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x2d, 0x74, 0x65, 0x6d, 0x70, 0x6f, 0x72, 0x61, 0x72, 0x69, 0x6c, 0x79, 0x20, 0x28, 0x28, 0x2a, 0x73, 0x74, 0x64, 0x65, 0x72, 0x72, 0x2a, 0x20, 0x28, 0x6f, 0x70, 0x65, 0x6e, 0x2d, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x29, 0x29, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x63, 0x61, 0x70, 0x74, 0x75, 0x72, 0x65, 0x20, 0x2a, 0x73, 0x74, 0x64, 0x65, 0x72, 0x72, 0x2a, 0x20, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x2a, 0x73, 0x74, 0x64, 0x6f, 0x75, 0x74, 0x2a, 0x20, 0x28, 0x6f, 0x70, 0x65, 0x6e, 0x2d, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x28, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x2d, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0x2d, 0x70, 0x6f, 0x72, 0x74, 0x29, 0x20, 0x28, 0x6f, 0x70, 0x65, 0x6e, 0x2d, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x28, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x2d, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x2d, 0x70, 0x6f, 0x72, 0x74, 0x29, 0x20, 0x28, 0x6f, 0x70, 0x65, 0x6e, 0x2d, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x28, 0x2a, 0x73, 0x37, 0x2a, 0x20, 0x27, 0x75, 0x6e, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x64, 0x2d, 0x63, 0x6f, 0x6e, 0x73, 0x74, 0x61, 0x6e, 0x74, 0x2d, 0x77, 0x61, 0x72, 0x6e, 0x69, 0x6e, 0x67, 0x73, 0x29, 0x20, 0x23, 0x74, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x3f, 0x3f, 0x3f, 0x20, 0x77, 0x68, 0x61, 0x74, 0x20, 0x61, 0x62, 0x6f, 0x75, 0x74, 0x20, 0x63, 0x61, 0x73, 0x65, 0x2a, 0x3f, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x20, 0x28, 0x77, 0x69, 0x74, 0x68, 0x2d, 0x69, 0x6e, 0x70, 0x75, 0x74, 0x2d, 0x66, 0x72, 0x6f, 0x6d, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x23, 0x5f, 0x72, 0x65, 0x61, 0x64, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x76, 0x61, 0x6c, 0x20, 0x23, 0x66, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x2d, 0x74, 0x65, 0x6d, 0x70, 0x6f, 0x72, 0x61, 0x72, 0x69, 0x6c, 0x79, 0x20, 0x28, 0x28, 0x28, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x2d, 0x69, 0x6e, 0x70, 0x75, 0x74, 0x2d, 0x70, 0x6f, 0x72, 0x74, 0x29, 0x20, 0x73, 0x74, 0x64, 0x69, 0x6e, 0x2d, 0x77, 0x72, 0x61, 0x70, 0x70, 0x65, 0x72, 0x29, 0x20, 0x20, 0x3b, 0x20, 0x66, 0x6f, 0x72, 0x20, 0x73, 0x63, 0x68, 0x65, 0x6d, 0x65, 0x20, 0x73, 0x69, 0x64, 0x65, 0x20, 0x69, 0x6e, 0x70, 0x75, 0x74, 0x20, 0x28, 0x72, 0x65, 0x61, 0x64, 0x2d, 0x63, 0x68, 0x61, 0x72, 0x20, 0x65, 0x74, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x68, 0x6f, 0x6f, 0x6b, 0x2d, 0x66, 0x75, 0x6e, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x73, 0x20, 0x2a, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x6f, 0x76, 0x65, 0x2d, 0x68, 0x6f, 0x6f, 0x6b, 0x2a, 0x29, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x73, 0x63, 0x68, 0x65, 0x6d, 0x65, 0x20, 0x63, 0x6f, 0x64, 0x65, 0x20, 0x63, 0x61, 0x6c, 0x6c, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x79, 0x78, 0x3f, 0x3f, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x69, 0x73, 0x74, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x68, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x65, 0x71, 0x3f, 0x20, 0x28, 0x68, 0x20, 0x27, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x29, 0x20, 0x6e, 0x63, 0x70, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x68, 0x20, 0x27, 0x79, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x68, 0x20, 0x27, 0x78, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x73, 0x69, 0x67, 0x69, 0x6e, 0x74, 0x2d, 0x68, 0x61, 0x6e, 0x64, 0x6c, 0x65, 0x72, 0x29, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x63, 0x61, 0x74, 0x63, 0x68, 0x20, 0x43, 0x2d, 0x43, 0x20, 0x74, 0x6f, 0x20, 0x69, 0x6e, 0x74, 0x65, 0x72, 0x72, 0x75, 0x70, 0x74, 0x20, 0x63, 0x6f, 0x6d, 0x70, 0x75, 0x74, 0x61, 0x74, 0x69, 0x6f, 0x6e, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x73, 0x74, 0x72, 0x20, 0x28, 0x77, 0x69, 0x74, 0x68, 0x2d, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0x2d, 0x74, 0x6f, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x66, 0x6f, 0x72, 0x20, 0x73, 0x63, 0x68, 0x65, 0x6d, 0x65, 0x20, 0x73, 0x69, 0x64, 0x65, 0x20, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x76, 0x61, 0x6c, 0x20, 0x28, 0x6c, 0x69, 0x73, 0x74, 0x20, 0x28, 0x6e, 0x65, 0x77, 0x2d, 0x65, 0x76, 0x61, 0x6c, 0x20, 0x66, 0x6f, 0x72, 0x6d, 0x20, 0x65, 0x6e, 0x76, 0x69, 0x72, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x6c, 0x69, 0x73, 0x74, 0x2c, 0x20, 0x6e, 0x6f, 0x74, 0x20, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x2d, 0x2d, 0x20, 0x63, 0x6f, 0x6e, 0x66, 0x75, 0x73, 0x65, 0x73, 0x20, 0x74, 0x72, 0x61, 0x63, 0x65, 0x21, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x28, 0x75, 0x6e, 0x73, 0x65, 0x74, 0x2d, 0x73, 0x69, 0x67, 0x69, 0x6e, 0x74, 0x2d, 0x68, 0x61, 0x6e, 0x64, 0x6c, 0x65, 0x72, 0x20, 0x6e, 0x63, 0x29, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x63, 0x61, 0x74, 0x63, 0x68, 0x20, 0x43, 0x2d, 0x43, 0x20, 0x74, 0x6f, 0x20, 0x65, 0x78, 0x69, 0x74, 0x20, 0x63, 0x6c, 0x65, 0x61, 0x6e, 0x6c, 0x79, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x2d, 0x65, 0x61, 0x63, 0x68, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3e, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x73, 0x29, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x6d, 0x75, 0x6c, 0x74, 0x69, 0x6c, 0x69, 0x6e, 0x65, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x6e, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x6c, 0x69, 0x73, 0x74, 0x20, 0x73, 0x74, 0x72, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x67, 0x65, 0x74, 0x2d, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x2a, 0x73, 0x74, 0x64, 0x65, 0x72, 0x72, 0x2a, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x67, 0x65, 0x74, 0x2d, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x2a, 0x73, 0x74, 0x64, 0x6f, 0x75, 0x74, 0x2a, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x67, 0x65, 0x74, 0x2d, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x2d, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x2d, 0x70, 0x6f, 0x72, 0x74, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x67, 0x65, 0x74, 0x2d, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x2d, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0x2d, 0x70, 0x6f, 0x72, 0x74, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x76, 0x61, 0x6c, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x6e, 0x75, 0x6c, 0x6c, 0x3f, 0x20, 0x76, 0x61, 0x6c, 0x29, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x74, 0x72, 0x79, 0x20, 0x74, 0x6f, 0x20, 0x74, 0x72, 0x61, 0x70, 0x20, 0x28, 0x76, 0x61, 0x6c, 0x75, 0x65, 0x73, 0x29, 0x20, 0x2d, 0x3e, 0x20, 0x23, 0x3c, 0x75, 0x6e, 0x73, 0x70, 0x65, 0x63, 0x69, 0x66, 0x69, 0x65, 0x64, 0x3e, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x75, 0x6e, 0x73, 0x70, 0x65, 0x63, 0x69, 0x66, 0x69, 0x65, 0x64, 0x3f, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x76, 0x61, 0x6c, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x75, 0x6c, 0x6c, 0x3f, 0x20, 0x28, 0x63, 0x64, 0x72, 0x20, 0x76, 0x61, 0x6c, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x23, 0x3c, 0x75, 0x6e, 0x73, 0x70, 0x65, 0x63, 0x69, 0x66, 0x69, 0x65, 0x64, 0x3e, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x70, 0x61, 0x69, 0x72, 0x3f, 0x20, 0x28, 0x63, 0x64, 0x72, 0x20, 0x76, 0x61, 0x6c, 0x29, 0x29, 0x20, 0x20, 0x3b, 0x20, 0x76, 0x61, 0x6c, 0x20, 0x69, 0x73, 0x20, 0x61, 0x20, 0x6c, 0x69, 0x73, 0x74, 0x2c, 0x20, 0x69, 0x74, 0x20, 0x6d, 0x75, 0x73, 0x74, 0x20, 0x68, 0x61, 0x76, 0x65, 0x20, 0x63, 0x61, 0x75, 0x67, 0x68, 0x74, 0x20, 0x6d, 0x75, 0x6c, 0x74, 0x69, 0x70, 0x6c, 0x65, 0x20, 0x76, 0x61, 0x6c, 0x75, 0x65, 0x73, 0x20, 0x69, 0x66, 0x20, 0x63, 0x64, 0x72, 0x20, 0x69, 0x73, 0x20, 0x61, 0x20, 0x70, 0x61, 0x69, 0x72, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x6f, 0x6e, 0x73, 0x20, 0x27, 0x76, 0x61, 0x6c, 0x75, 0x65, 0x73, 0x20, 0x76, 0x61, 0x6c, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x76, 0x61, 0x6c, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x6d, 0x75, 0x6c, 0x74, 0x69, 0x6c, 0x69, 0x6e, 0x65, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x28, 0x6f, 0x62, 0x6a, 0x65, 0x63, 0x74, 0x2d, 0x3e, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x76, 0x61, 0x6c, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x74, 0x79, 0x70, 0x65, 0x20, 0x69, 0x6e, 0x66, 0x6f, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x28, 0x75, 0x6e, 0x73, 0x65, 0x74, 0x2d, 0x73, 0x69, 0x67, 0x69, 0x6e, 0x74, 0x2d, 0x68, 0x61, 0x6e, 0x64, 0x6c, 0x65, 0x72, 0x20, 0x6e, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x65, 0x71, 0x3f, 0x20, 0x74, 0x79, 0x70, 0x65, 0x20, 0x27, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x2d, 0x72, 0x65, 0x61, 0x64, 0x2d, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x62, 0x65, 0x67, 0x69, 0x6e, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x6d, 0x69, 0x73, 0x73, 0x69, 0x6e, 0x67, 0x20, 0x63, 0x6c, 0x6f, 0x73, 0x65, 0x20, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x2c, 0x20, 0x6e, 0x65, 0x77, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x61, 0x6c, 0x72, 0x65, 0x61, 0x64, 0x79, 0x20, 0x61, 0x64, 0x64, 0x65, 0x64, 0x2c, 0x20, 0x73, 0x70, 0x61, 0x63, 0x65, 0x73, 0x20, 0x68, 0x65, 0x72, 0x65, 0x20, 0x61, 0x72, 0x65, 0x20, 0x6e, 0x6f, 0x74, 0x20, 0x6f, 0x70, 0x74, 0x69, 0x6f, 0x6e, 0x61, 0x6c, 0x21, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x30, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x72, 0x65, 0x74, 0x75, 0x72, 0x6e, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x61, 0x70, 0x70, 0x6c, 0x79, 0x20, 0x74, 0x68, 0x72, 0x6f, 0x77, 0x20, 0x74, 0x79, 0x70, 0x65, 0x20, 0x69, 0x6e, 0x66, 0x6f, 0x29, 0x29, 0x29, 0x29, 0x29, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x72, 0x65, 0x2d, 0x72, 0x61, 0x69, 0x73, 0x65, 0x20, 0x65, 0x72, 0x72, 0x6f, 0x72, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x74, 0x79, 0x70, 0x65, 0x20, 0x69, 0x6e, 0x66, 0x6f, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x3b, 0x28, 0x75, 0x6e, 0x73, 0x65, 0x74, 0x2d, 0x73, 0x69, 0x67, 0x69, 0x6e, 0x74, 0x2d, 0x68, 0x61, 0x6e, 0x64, 0x6c, 0x65, 0x72, 0x20, 0x6e, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x65, 0x71, 0x3f, 0x20, 0x74, 0x79, 0x70, 0x65, 0x20, 0x27, 0x72, 0x65, 0x61, 0x64, 0x2d, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x29, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x6d, 0x61, 0x79, 0x62, 0x65, 0x20, 0x77, 0x65, 0x20, 0x68, 0x69, 0x74, 0x20, 0x3c, 0x65, 0x6e, 0x74, 0x65, 0x72, 0x3e, 0x20, 0x69, 0x6e, 0x20, 0x61, 0x20, 0x62, 0x6c, 0x6f, 0x63, 0x6b, 0x20, 0x63, 0x6f, 0x6d, 0x6d, 0x65, 0x6e, 0x74, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x65, 0x71, 0x75, 0x61, 0x6c, 0x3f, 0x20, 0x69, 0x6e, 0x66, 0x6f, 0x20, 0x27, 0x28, 0x22, 0x75, 0x6e, 0x65, 0x78, 0x70, 0x65, 0x63, 0x74, 0x65, 0x64, 0x20, 0x65, 0x6e, 0x64, 0x20, 0x6f, 0x66, 0x20, 0x69, 0x6e, 0x70, 0x75, 0x74, 0x20, 0x77, 0x68, 0x69, 0x6c, 0x65, 0x20, 0x72, 0x65, 0x61, 0x64, 0x69, 0x6e, 0x67, 0x20, 0x23, 0x7c, 0x22, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x62, 0x65, 0x67, 0x69, 0x6e, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x30, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x72, 0x65, 0x74, 0x75, 0x72, 0x6e, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x69, 0x6e, 0x66, 0x6f, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x6e, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x72, 0x65, 0x70, 0x72, 0x6f, 0x6d, 0x70, 0x74, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x20, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x6e, 0x6f, 0x72, 0x6d, 0x61, 0x6c, 0x2d, 0x63, 0x68, 0x61, 0x72, 0x20, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x3e, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x2d, 0x31, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x2d, 0x3e, 0x63, 0x68, 0x61, 0x72, 0x20, 0x63, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x3e, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x69, 0x6e, 0x67, 0x29, 0x20, 0x30, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x29, 0x20, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x69, 0x6e, 0x67, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x3d, 0x3f, 0x20, 0x28, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x2d, 0x3e, 0x63, 0x68, 0x61, 0x72, 0x20, 0x63, 0x29, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x3d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x6d, 0x61, 0x79, 0x62, 0x65, 0x20, 0x28, 0x6d, 0x65, 0x6d, 0x76, 0x20, 0x28, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x2d, 0x3e, 0x63, 0x68, 0x61, 0x72, 0x20, 0x63, 0x29, 0x20, 0x27, 0x28, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x20, 0x23, 0x5c, 0x28, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x72, 0x65, 0x66, 0x72, 0x65, 0x73, 0x68, 0x20, 0x6e, 0x63, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x6e, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x29, 0x20, 0x3b, 0x20, 0x6d, 0x69, 0x67, 0x68, 0x74, 0x20, 0x62, 0x65, 0x20, 0x6d, 0x69, 0x64, 0x6c, 0x69, 0x6e, 0x65, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2b, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x31, 0x29, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x69, 0x6e, 0x20, 0x61, 0x6e, 0x79, 0x20, 0x63, 0x61, 0x73, 0x65, 0x20, 0x77, 0x65, 0x27, 0x76, 0x65, 0x20, 0x61, 0x64, 0x64, 0x65, 0x64, 0x20, 0x61, 0x20, 0x63, 0x68, 0x61, 0x72, 0x61, 0x63, 0x74, 0x65, 0x72, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x69, 0x20, 0x30, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x3d, 0x20, 0x69, 0x20, 0x32, 0x35, 0x36, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x69, 0x29, 0x20, 0x6e, 0x6f, 0x72, 0x6d, 0x61, 0x6c, 0x2d, 0x63, 0x68, 0x61, 0x72, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x70, 0x72, 0x65, 0x70, 0x65, 0x6e, 0x64, 0x2d, 0x74, 0x6f, 0x2d, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x6e, 0x65, 0x77, 0x2d, 0x74, 0x65, 0x78, 0x74, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x75, 0x6e, 0x6c, 0x65, 0x73, 0x73, 0x20, 0x28, 0x7a, 0x65, 0x72, 0x6f, 0x3f, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x6e, 0x65, 0x77, 0x2d, 0x74, 0x65, 0x78, 0x74, 0x29, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x28, 0x69, 0x66, 0x20, 0x70, 0x72, 0x65, 0x76, 0x69, 0x6f, 0x75, 0x73, 0x6c, 0x79, 0x2d, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x65, 0x64, 0x20, 0x28, 0x61, 0x70, 0x70, 0x65, 0x6e, 0x64, 0x20, 0x6e, 0x65, 0x77, 0x2d, 0x74, 0x65, 0x78, 0x74, 0x20, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x6e, 0x65, 0x77, 0x2d, 0x74, 0x65, 0x78, 0x74, 0x29, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6a, 0x75, 0x73, 0x74, 0x2d, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x65, 0x64, 0x20, 0x23, 0x74, 0x29, 0x29, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x61, 0x70, 0x70, 0x65, 0x6e, 0x64, 0x2d, 0x74, 0x6f, 0x2d, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x6e, 0x65, 0x77, 0x2d, 0x74, 0x65, 0x78, 0x74, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x75, 0x6e, 0x6c, 0x65, 0x73, 0x73, 0x20, 0x28, 0x7a, 0x65, 0x72, 0x6f, 0x3f, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x6e, 0x65, 0x77, 0x2d, 0x74, 0x65, 0x78, 0x74, 0x29, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x28, 0x69, 0x66, 0x20, 0x70, 0x72, 0x65, 0x76, 0x69, 0x6f, 0x75, 0x73, 0x6c, 0x79, 0x2d, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x65, 0x64, 0x20, 0x28, 0x61, 0x70, 0x70, 0x65, 0x6e, 0x64, 0x20, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x6e, 0x65, 0x77, 0x2d, 0x74, 0x65, 0x78, 0x74, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x6e, 0x65, 0x77, 0x2d, 0x74, 0x65, 0x78, 0x74, 0x29, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6a, 0x75, 0x73, 0x74, 0x2d, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x65, 0x64, 0x20, 0x23, 0x74, 0x29, 0x29, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x73, 0x65, 0x70, 0x61, 0x72, 0x61, 0x74, 0x6f, 0x72, 0x3f, 0x20, 0x63, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x70, 0x6f, 0x73, 0x69, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x63, 0x20, 0x22, 0x20, 0x28, 0x29, 0x60, 0x27, 0x2c, 0x5c, 0x22, 0x23, 0x22, 0x29, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x77, 0x6f, 0x72, 0x64, 0x2d, 0x62, 0x61, 0x63, 0x6b, 0x2d, 0x78, 0x29, 0x20, 0x3b, 0x3b, 0x20, 0x73, 0x6f, 0x6d, 0x65, 0x20, 0x6f, 0x66, 0x20, 0x74, 0x68, 0x65, 0x73, 0x65, 0x20, 0x61, 0x72, 0x65, 0x20, 0x63, 0x6f, 0x75, 0x72, 0x74, 0x65, 0x73, 0x79, 0x20, 0x6f, 0x66, 0x20, 0x45, 0x6c, 0x69, 0x6a, 0x61, 0x68, 0x20, 0x53, 0x74, 0x6f, 0x6e, 0x65, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x6c, 0x6f, 0x6f, 0x70, 0x20, 0x28, 0x28, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x63, 0x6f, 0x6c, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x73, 0x65, 0x70, 0x61, 0x72, 0x61, 0x74, 0x6f, 0x72, 0x3f, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x6f, 0x6f, 0x70, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x6c, 0x6f, 0x6f, 0x70, 0x20, 0x28, 0x28, 0x63, 0x6f, 0x6c, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x69, 0x66, 0x20, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x3d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x73, 0x65, 0x70, 0x61, 0x72, 0x61, 0x74, 0x6f, 0x72, 0x3f, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x29, 0x20, 0x31, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x63, 0x6f, 0x6c, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x6f, 0x6f, 0x70, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x77, 0x6f, 0x72, 0x64, 0x2d, 0x66, 0x6f, 0x72, 0x77, 0x61, 0x72, 0x64, 0x2d, 0x78, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x6c, 0x6f, 0x6f, 0x70, 0x20, 0x28, 0x28, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x63, 0x6f, 0x6c, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x73, 0x65, 0x70, 0x61, 0x72, 0x61, 0x74, 0x6f, 0x72, 0x3f, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x6f, 0x6f, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x6c, 0x6f, 0x6f, 0x70, 0x20, 0x28, 0x28, 0x63, 0x6f, 0x6c, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x69, 0x66, 0x20, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x3d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x73, 0x65, 0x70, 0x61, 0x72, 0x61, 0x74, 0x6f, 0x72, 0x3f, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x63, 0x6f, 0x6c, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x6f, 0x6f, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x6d, 0x65, 0x74, 0x61, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x42, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x6d, 0x65, 0x74, 0x61, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x62, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x77, 0x6f, 0x72, 0x64, 0x2d, 0x62, 0x61, 0x63, 0x6b, 0x2d, 0x78, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x6d, 0x65, 0x74, 0x61, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x43, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x6d, 0x65, 0x74, 0x61, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x63, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x6c, 0x65, 0x6e, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x20, 0x30, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x3d, 0x20, 0x69, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x61, 0x6c, 0x70, 0x68, 0x61, 0x62, 0x65, 0x74, 0x69, 0x63, 0x3f, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x69, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3c, 0x20, 0x69, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x69, 0x29, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x75, 0x70, 0x63, 0x61, 0x73, 0x65, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x69, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x72, 0x65, 0x66, 0x72, 0x65, 0x73, 0x68, 0x20, 0x6e, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x6b, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x20, 0x28, 0x2b, 0x20, 0x6b, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x3e, 0x3d, 0x20, 0x6b, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x61, 0x6c, 0x70, 0x68, 0x61, 0x62, 0x65, 0x74, 0x69, 0x63, 0x3f, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x6b, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x6e, 0x75, 0x6d, 0x65, 0x72, 0x69, 0x63, 0x3f, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x6b, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x6b, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x6d, 0x65, 0x74, 0x61, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x44, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x6d, 0x65, 0x74, 0x61, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x64, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x6e, 0x65, 0x77, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x77, 0x6f, 0x72, 0x64, 0x2d, 0x66, 0x6f, 0x72, 0x77, 0x61, 0x72, 0x64, 0x2d, 0x78, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x61, 0x70, 0x70, 0x65, 0x6e, 0x64, 0x2d, 0x74, 0x6f, 0x2d, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x65, 0x77, 0x63, 0x6f, 0x6c, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x65, 0x77, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x6e, 0x65, 0x77, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x65, 0x77, 0x63, 0x6f, 0x6c, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x65, 0x77, 0x63, 0x6f, 0x6c, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x65, 0x77, 0x63, 0x6f, 0x6c, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x6d, 0x65, 0x74, 0x61, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x46, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x6d, 0x65, 0x74, 0x61, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x66, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x77, 0x6f, 0x72, 0x64, 0x2d, 0x66, 0x6f, 0x72, 0x77, 0x61, 0x72, 0x64, 0x2d, 0x78, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x6d, 0x65, 0x74, 0x61, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x4c, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x6d, 0x65, 0x74, 0x61, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x6c, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x6c, 0x65, 0x6e, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x20, 0x30, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x3d, 0x20, 0x69, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x61, 0x6c, 0x70, 0x68, 0x61, 0x62, 0x65, 0x74, 0x69, 0x63, 0x3f, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x69, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3c, 0x20, 0x69, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x6b, 0x20, 0x69, 0x20, 0x28, 0x2b, 0x20, 0x6b, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x3d, 0x20, 0x6b, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x61, 0x6c, 0x70, 0x68, 0x61, 0x62, 0x65, 0x74, 0x69, 0x63, 0x3f, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x6b, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x72, 0x65, 0x66, 0x72, 0x65, 0x73, 0x68, 0x20, 0x6e, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x6b, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x6b, 0x29, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x64, 0x6f, 0x77, 0x6e, 0x63, 0x61, 0x73, 0x65, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x6b, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x6d, 0x65, 0x74, 0x61, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x55, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x6d, 0x65, 0x74, 0x61, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x75, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x6c, 0x65, 0x6e, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x20, 0x30, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x3d, 0x20, 0x69, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x61, 0x6c, 0x70, 0x68, 0x61, 0x62, 0x65, 0x74, 0x69, 0x63, 0x3f, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x69, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3c, 0x20, 0x69, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x6b, 0x20, 0x69, 0x20, 0x28, 0x2b, 0x20, 0x6b, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x3d, 0x20, 0x6b, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x61, 0x6c, 0x70, 0x68, 0x61, 0x62, 0x65, 0x74, 0x69, 0x63, 0x3f, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x6b, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x72, 0x65, 0x66, 0x72, 0x65, 0x73, 0x68, 0x20, 0x6e, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x6b, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x6b, 0x29, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x75, 0x70, 0x63, 0x61, 0x73, 0x65, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x6b, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x6d, 0x65, 0x74, 0x61, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x3c, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x30, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x6d, 0x65, 0x74, 0x61, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x3e, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x74, 0x61, 0x62, 0x29, 0x29, 0x20, 0x74, 0x61, 0x62, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x72, 0x6f, 0x6c, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x41, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x75, 0x6e, 0x6c, 0x65, 0x73, 0x73, 0x20, 0x28, 0x3e, 0x3d, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x79, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x72, 0x6f, 0x6c, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x42, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x3d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x3e, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x30, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x6f, 0x6c, 0x64, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x64, 0x65, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3c, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x6f, 0x6c, 0x64, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x72, 0x6f, 0x6c, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x43, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x72, 0x65, 0x70, 0x6c, 0x2d, 0x64, 0x6f, 0x6e, 0x65, 0x20, 0x23, 0x74, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x72, 0x6f, 0x6c, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x44, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x3c, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x73, 0x68, 0x6f, 0x75, 0x6c, 0x64, 0x20, 0x74, 0x68, 0x69, 0x73, 0x20, 0x64, 0x65, 0x6c, 0x65, 0x74, 0x65, 0x20, 0x74, 0x68, 0x65, 0x20, 0x6e, 0x65, 0x77, 0x6c, 0x69, 0x6e, 0x65, 0x3f, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x3e, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x29, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x2d, 0x31, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x69, 0x6e, 0x67, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x69, 0x6e, 0x67, 0x29, 0x29, 0x20, 0x22, 0x20, 0x22, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x31, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x72, 0x6f, 0x6c, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x45, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x72, 0x6f, 0x6c, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x46, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x3d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x3c, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x62, 0x65, 0x67, 0x69, 0x6e, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x69, 0x6e, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x72, 0x6f, 0x6c, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x47, 0x29, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x67, 0x65, 0x74, 0x20, 0x61, 0x20, 0x70, 0x72, 0x6f, 0x6d, 0x70, 0x74, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x69, 0x6e, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x79, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x72, 0x65, 0x70, 0x72, 0x6f, 0x6d, 0x70, 0x74, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x72, 0x6f, 0x6c, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x4b, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x61, 0x70, 0x70, 0x65, 0x6e, 0x64, 0x2d, 0x74, 0x6f, 0x2d, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x72, 0x6f, 0x6c, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x4c, 0x29, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x6e, 0x6f, 0x74, 0x20, 0x74, 0x68, 0x65, 0x20, 0x73, 0x61, 0x6d, 0x65, 0x20, 0x61, 0x73, 0x20, 0x65, 0x6d, 0x61, 0x63, 0x73, 0x27, 0x73, 0x20, 0x43, 0x2d, 0x6c, 0x20, 0x28, 0x6d, 0x6f, 0x76, 0x65, 0x73, 0x20, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x74, 0x6f, 0x20, 0x74, 0x6f, 0x70, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x75, 0x6e, 0x6c, 0x65, 0x73, 0x73, 0x20, 0x28, 0x3d, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x79, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x72, 0x6f, 0x6c, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x4e, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3c, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x6e, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x72, 0x6f, 0x6c, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x4f, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x65, 0x72, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x6f, 0x6c, 0x64, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3e, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x72, 0x6f, 0x77, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3e, 0x3d, 0x20, 0x28, 0x2b, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x65, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x30, 0x20, 0x30, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x30, 0x20, 0x30, 0x20, 0x28, 0x2b, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x34, 0x30, 0x29, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x28, 0x2b, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x34, 0x30, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x63, 0x6f, 0x70, 0x79, 0x20, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x69, 0x6e, 0x74, 0x2d, 0x76, 0x65, 0x63, 0x74, 0x6f, 0x72, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x63, 0x6f, 0x70, 0x79, 0x20, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x69, 0x6e, 0x74, 0x2d, 0x76, 0x65, 0x63, 0x74, 0x6f, 0x72, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x69, 0x20, 0x28, 0x2b, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x28, 0x3d, 0x20, 0x69, 0x20, 0x28, 0x2b, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2b, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x28, 0x2d, 0x20, 0x69, 0x20, 0x31, 0x29, 0x20, 0x30, 0x20, 0x31, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x2d, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x63, 0x6c, 0x65, 0x61, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x69, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x69, 0x20, 0x30, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x73, 0x68, 0x6f, 0x75, 0x6c, 0x64, 0x20, 0x74, 0x68, 0x69, 0x73, 0x20, 0x62, 0x65, 0x20, 0x69, 0x6e, 0x64, 0x65, 0x6e, 0x74, 0x65, 0x64, 0x3f, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x69, 0x29, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x2d, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x69, 0x29, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x2d, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x6e, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x6c, 0x65, 0x61, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x72, 0x6f, 0x77, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x30, 0x20, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x65, 0x72, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x65, 0x72, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6f, 0x6c, 0x64, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x72, 0x6f, 0x6c, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x50, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x72, 0x6f, 0x6c, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x51, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x72, 0x65, 0x70, 0x6c, 0x2d, 0x64, 0x6f, 0x6e, 0x65, 0x20, 0x23, 0x74, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x74, 0x6f, 0x70, 0x2d, 0x6c, 0x65, 0x76, 0x65, 0x6c, 0x2d, 0x6c, 0x65, 0x74, 0x20, 0x27, 0x68, 0x69, 0x73, 0x74, 0x6f, 0x72, 0x79, 0x29, 0x20, 0x6f, 0x6c, 0x64, 0x2d, 0x68, 0x69, 0x73, 0x74, 0x6f, 0x72, 0x79, 0x29, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x66, 0x69, 0x78, 0x20, 0x75, 0x70, 0x20, 0x74, 0x68, 0x65, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x70, 0x6f, 0x69, 0x6e, 0x74, 0x65, 0x72, 0x20, 0x49, 0x20, 0x74, 0x68, 0x69, 0x6e, 0x6b, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x72, 0x6f, 0x6c, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x54, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3e, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x63, 0x75, 0x72, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3e, 0x3d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x30, 0x20, 0x31, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x74, 0x6d, 0x70, 0x2d, 0x63, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x75, 0x72, 0x20, 0x31, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x75, 0x72, 0x20, 0x31, 0x29, 0x29, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x63, 0x75, 0x72, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x63, 0x75, 0x72, 0x29, 0x20, 0x74, 0x6d, 0x70, 0x2d, 0x63, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x63, 0x75, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x69, 0x66, 0x20, 0x63, 0x3d, 0x30, 0x20, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x73, 0x65, 0x74, 0x73, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x74, 0x6f, 0x20, 0x30, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3c, 0x20, 0x63, 0x75, 0x72, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x75, 0x72, 0x20, 0x31, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x72, 0x6f, 0x6c, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x55, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x70, 0x72, 0x65, 0x70, 0x65, 0x6e, 0x64, 0x2d, 0x74, 0x6f, 0x2d, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x72, 0x6f, 0x6c, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x57, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x6e, 0x65, 0x77, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x77, 0x6f, 0x72, 0x64, 0x2d, 0x62, 0x61, 0x63, 0x6b, 0x2d, 0x78, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x70, 0x72, 0x65, 0x70, 0x65, 0x6e, 0x64, 0x2d, 0x74, 0x6f, 0x2d, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x65, 0x77, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x6e, 0x65, 0x77, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x65, 0x77, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x6e, 0x65, 0x77, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x6e, 0x65, 0x77, 0x63, 0x6f, 0x6c, 0x29, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x6e, 0x65, 0x77, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x6e, 0x65, 0x77, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x72, 0x6f, 0x6c, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x59, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x3f, 0x20, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x3e, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x2d, 0x31, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x3d, 0x3f, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x20, 0x28, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x29, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x72, 0x65, 0x66, 0x72, 0x65, 0x73, 0x68, 0x20, 0x6e, 0x63, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x69, 0x6e, 0x67, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x3e, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x69, 0x6e, 0x67, 0x29, 0x20, 0x30, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x29, 0x29, 0x20, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x69, 0x6e, 0x67, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2b, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x4e, 0x43, 0x4b, 0x45, 0x59, 0x5f, 0x4c, 0x45, 0x46, 0x54, 0x29, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x61, 0x72, 0x72, 0x6f, 0x77, 0x20, 0x6b, 0x65, 0x79, 0x73, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x4e, 0x43, 0x4b, 0x45, 0x59, 0x5f, 0x52, 0x49, 0x47, 0x48, 0x54, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x4e, 0x43, 0x4b, 0x45, 0x59, 0x5f, 0x55, 0x50, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x4e, 0x43, 0x4b, 0x45, 0x59, 0x5f, 0x44, 0x4f, 0x57, 0x4e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3c, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x6e, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x4e, 0x43, 0x4b, 0x45, 0x59, 0x5f, 0x48, 0x4f, 0x4d, 0x45, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x30, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x4e, 0x43, 0x4b, 0x45, 0x59, 0x5f, 0x45, 0x4e, 0x44, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x4e, 0x43, 0x4b, 0x45, 0x59, 0x5f, 0x50, 0x47, 0x55, 0x50, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x30, 0x20, 0x28, 0x2d, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x4e, 0x43, 0x4b, 0x45, 0x59, 0x5f, 0x50, 0x47, 0x44, 0x4f, 0x57, 0x4e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x30, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2b, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x4e, 0x43, 0x4b, 0x45, 0x59, 0x5f, 0x52, 0x45, 0x53, 0x49, 0x5a, 0x45, 0x29, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x74, 0x65, 0x72, 0x6d, 0x69, 0x6e, 0x61, 0x6c, 0x20, 0x77, 0x69, 0x6e, 0x64, 0x6f, 0x77, 0x20, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x65, 0x64, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x61, 0x20, 0x6b, 0x65, 0x79, 0x20, 0x65, 0x76, 0x65, 0x6e, 0x74, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x61, 0x70, 0x70, 0x6c, 0x79, 0x20, 0x6e, 0x63, 0x2d, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x65, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x64, 0x69, 0x6d, 0x5f, 0x79, 0x78, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x73, 0x74, 0x64, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x20, 0x6e, 0x63, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x4e, 0x43, 0x4b, 0x45, 0x59, 0x5f, 0x42, 0x41, 0x43, 0x4b, 0x53, 0x50, 0x41, 0x43, 0x45, 0x29, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x62, 0x61, 0x63, 0x6b, 0x73, 0x70, 0x61, 0x63, 0x65, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3e, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x3e, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x2d, 0x31, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x69, 0x6e, 0x67, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x62, 0x65, 0x67, 0x69, 0x6e, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x29, 0x20, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x69, 0x6e, 0x67, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2b, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x74, 0x72, 0x61, 0x69, 0x6c, 0x69, 0x6e, 0x67, 0x29, 0x20, 0x31, 0x29, 0x29, 0x20, 0x22, 0x20, 0x22, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x2d, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x29, 0x20, 0x22, 0x20, 0x22, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x63, 0x68, 0x65, 0x63, 0x6b, 0x20, 0x74, 0x68, 0x69, 0x73, 0x3a, 0x20, 0x69, 0x66, 0x20, 0x77, 0x65, 0x20, 0x62, 0x61, 0x63, 0x6b, 0x73, 0x70, 0x61, 0x63, 0x65, 0x64, 0x20, 0x70, 0x61, 0x73, 0x74, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x2c, 0x20, 0x73, 0x63, 0x72, 0x6f, 0x6c, 0x6c, 0x2d, 0x6c, 0x65, 0x66, 0x74, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x4e, 0x43, 0x4b, 0x45, 0x59, 0x5f, 0x42, 0x55, 0x54, 0x54, 0x4f, 0x4e, 0x31, 0x29, 0x20, 0x3b, 0x20, 0x6d, 0x6f, 0x75, 0x73, 0x65, 0x20, 0x63, 0x6c, 0x69, 0x63, 0x6b, 0x2c, 0x20, 0x64, 0x6f, 0x65, 0x73, 0x6e, 0x27, 0x74, 0x20, 0x77, 0x6f, 0x72, 0x6b, 0x20, 0x69, 0x6e, 0x20, 0x72, 0x78, 0x76, 0x74, 0x20, 0x61, 0x70, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x74, 0x6c, 0x79, 0x2c, 0x20, 0x72, 0x69, 0x67, 0x68, 0x74, 0x20, 0x62, 0x75, 0x74, 0x74, 0x6f, 0x6e, 0x20, 0x3d, 0x20, 0x62, 0x75, 0x74, 0x74, 0x6f, 0x6e, 0x32, 0x3f, 0x20, 0x63, 0x6c, 0x69, 0x63, 0x6b, 0x20, 0x73, 0x63, 0x72, 0x6f, 0x6c, 0x6c, 0x3f, 0x3f, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x6e, 0x63, 0x69, 0x6e, 0x70, 0x75, 0x74, 0x20, 0x67, 0x69, 0x76, 0x65, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x7c, 0x63, 0x6f, 0x6c, 0x20, 0x69, 0x6e, 0x20, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x20, 0x76, 0x69, 0x65, 0x77, 0x2c, 0x20, 0x73, 0x6f, 0x20, 0x77, 0x65, 0x20, 0x6e, 0x65, 0x65, 0x64, 0x20, 0x74, 0x6f, 0x20, 0x6d, 0x61, 0x70, 0x20, 0x74, 0x68, 0x61, 0x74, 0x20, 0x74, 0x6f, 0x20, 0x74, 0x68, 0x65, 0x20, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x20, 0x72, 0x6f, 0x77, 0x7c, 0x63, 0x6f, 0x6c, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x3b, 0x28, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x23, 0x66, 0x20, 0x22, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x3a, 0x20, 0x7e, 0x53, 0x2c, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x3a, 0x20, 0x7e, 0x53, 0x2c, 0x20, 0x69, 0x6e, 0x70, 0x75, 0x74, 0x3a, 0x20, 0x7e, 0x53, 0x22, 0x20, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x6e, 0x63, 0x69, 0x6e, 0x70, 0x75, 0x74, 0x5f, 0x79, 0x20, 0x6e, 0x69, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3d, 0x20, 0x28, 0x6e, 0x63, 0x69, 0x6e, 0x70, 0x75, 0x74, 0x5f, 0x65, 0x76, 0x74, 0x79, 0x70, 0x65, 0x20, 0x6e, 0x69, 0x29, 0x20, 0x4e, 0x43, 0x54, 0x59, 0x50, 0x45, 0x5f, 0x52, 0x45, 0x4c, 0x45, 0x41, 0x53, 0x45, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x62, 0x65, 0x67, 0x69, 0x6e, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x6e, 0x75, 0x6d, 0x62, 0x65, 0x72, 0x3f, 0x20, 0x6d, 0x6f, 0x75, 0x73, 0x65, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x28, 0x3d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x6d, 0x6f, 0x75, 0x73, 0x65, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x6d, 0x6f, 0x75, 0x73, 0x65, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x6d, 0x6f, 0x75, 0x73, 0x65, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x20, 0x31, 0x20, 0x28, 0x61, 0x62, 0x73, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x6d, 0x6f, 0x75, 0x73, 0x65, 0x2d, 0x63, 0x6f, 0x6c, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6d, 0x6f, 0x75, 0x73, 0x65, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x23, 0x66, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x62, 0x65, 0x67, 0x69, 0x6e, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x6d, 0x61, 0x78, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x6e, 0x63, 0x69, 0x6e, 0x70, 0x75, 0x74, 0x5f, 0x79, 0x20, 0x6e, 0x69, 0x29, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x28, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x28, 0x6e, 0x63, 0x69, 0x6e, 0x70, 0x75, 0x74, 0x5f, 0x78, 0x20, 0x6e, 0x69, 0x29, 0x29, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x75, 0x6e, 0x6c, 0x65, 0x73, 0x73, 0x20, 0x6d, 0x6f, 0x75, 0x73, 0x65, 0x2d, 0x63, 0x6f, 0x6c, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6d, 0x6f, 0x75, 0x73, 0x65, 0x2d, 0x63, 0x6f, 0x6c, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6d, 0x6f, 0x75, 0x73, 0x65, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x4e, 0x43, 0x4b, 0x45, 0x59, 0x5f, 0x45, 0x4e, 0x54, 0x45, 0x52, 0x29, 0x20, 0x65, 0x6e, 0x74, 0x65, 0x72, 0x29, 0xa, 
+  0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x20, 0x72, 0x65, 0x61, 0x64, 0x2f, 0x65, 0x76, 0x61, 0x6c, 0x2f, 0x70, 0x72, 0x69, 0x6e, 0x74, 0x20, 0x6c, 0x6f, 0x6f, 0x70, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x72, 0x65, 0x63, 0x6f, 0x76, 0x65, 0x72, 0x2d, 0x70, 0x72, 0x65, 0x76, 0x69, 0x6f, 0x75, 0x73, 0x2d, 0x6c, 0x61, 0x79, 0x6f, 0x75, 0x74, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x64, 0x65, 0x62, 0x75, 0x67, 0x2d, 0x69, 0x6e, 0x66, 0x6f, 0x20, 0x6c, 0x6f, 0x63, 0x61, 0x6c, 0x2d, 0x64, 0x65, 0x62, 0x75, 0x67, 0x2d, 0x69, 0x6e, 0x66, 0x6f, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x72, 0x65, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x72, 0x65, 0x6e, 0x64, 0x65, 0x72, 0x20, 0x6e, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6d, 0x6f, 0x76, 0x65, 0x2d, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x70, 0x65, 0x72, 0x68, 0x61, 0x70, 0x73, 0x20, 0x61, 0x20, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x65, 0x20, 0x68, 0x61, 0x70, 0x70, 0x65, 0x6e, 0x65, 0x64, 0x20, 0x77, 0x68, 0x69, 0x6c, 0x65, 0x20, 0x77, 0x65, 0x20, 0x77, 0x65, 0x72, 0x65, 0x20, 0x61, 0x77, 0x61, 0x79, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x68, 0x63, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x28, 0x3d, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x65, 0x20, 0x68, 0x63, 0x20, 0x30, 0x20, 0x30, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x6f, 0x6c, 0x64, 0x2d, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0x20, 0x30, 0x20, 0x30, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x5f, 0x6d, 0x6f, 0x76, 0x65, 0x5f, 0x79, 0x78, 0x20, 0x68, 0x63, 0x20, 0x30, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x62, 0x6f, 0x78, 0x20, 0x68, 0x63, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x30, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x31, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x32, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x33, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x34, 0x29, 0x20, 0x28, 0x68, 0x63, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x35, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x31, 0x29, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x69, 0x20, 0x31, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x28, 0x3d, 0x20, 0x69, 0x20, 0x28, 0x2d, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x68, 0x63, 0x20, 0x69, 0x20, 0x28, 0x2d, 0x20, 0x6f, 0x6c, 0x64, 0x2d, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x31, 0x29, 0x20, 0x22, 0x20, 0x22, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x3c, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x3c, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x72, 0x65, 0x73, 0x69, 0x7a, 0x65, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x30, 0x20, 0x30, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x30, 0x20, 0x30, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3e, 0x20, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x63, 0x6f, 0x70, 0x79, 0x20, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x69, 0x6e, 0x74, 0x2d, 0x76, 0x65, 0x63, 0x74, 0x6f, 0x72, 0x20, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x63, 0x6f, 0x70, 0x79, 0x20, 0x65, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x69, 0x6e, 0x74, 0x2d, 0x76, 0x65, 0x63, 0x74, 0x6f, 0x72, 0x20, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x6d, 0x61, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x72, 0x65, 0x70, 0x6c, 0x2d, 0x6c, 0x6f, 0x6f, 0x70, 0x20, 0x28, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x61, 0x72, 0x65, 0x61, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x72, 0x65, 0x70, 0x6c, 0x2d, 0x64, 0x6f, 0x6e, 0x65, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x62, 0x65, 0x67, 0x69, 0x6e, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x64, 0x65, 0x73, 0x74, 0x72, 0x6f, 0x79, 0x20, 0x6e, 0x63, 0x70, 0x29, 0x20, 0x3b, 0x20, 0x64, 0x6f, 0x65, 0x73, 0x20, 0x74, 0x68, 0x69, 0x73, 0x20, 0x66, 0x72, 0x65, 0x65, 0x20, 0x6e, 0x63, 0x70, 0x3f, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x68, 0x63, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x64, 0x65, 0x73, 0x74, 0x72, 0x6f, 0x79, 0x20, 0x68, 0x63, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x66, 0x72, 0x65, 0x65, 0x20, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x3f, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x77, 0x63, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x64, 0x65, 0x73, 0x74, 0x72, 0x6f, 0x79, 0x20, 0x77, 0x63, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x23, 0x66, 0x29, 0x20, 0x3b, 0x20, 0x75, 0x6e, 0x6e, 0x65, 0x63, 0x65, 0x73, 0x73, 0x61, 0x72, 0x79, 0x3f, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x68, 0x63, 0x20, 0x23, 0x66, 0x29, 0x20, 0x3b, 0x20, 0x6f, 0x6c, 0x64, 0x20, 0x68, 0x65, 0x61, 0x64, 0x65, 0x72, 0x20, 0x69, 0x66, 0x20, 0x6e, 0x65, 0x73, 0x74, 0x65, 0x64, 0x3f, 0x3f, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x77, 0x63, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x72, 0x65, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x20, 0x23, 0x74, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x28, 0x62, 0x65, 0x67, 0x69, 0x6e, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x72, 0x65, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x72, 0x65, 0x63, 0x6f, 0x76, 0x65, 0x72, 0x2d, 0x70, 0x72, 0x65, 0x76, 0x69, 0x6f, 0x75, 0x73, 0x2d, 0x6c, 0x61, 0x79, 0x6f, 0x75, 0x74, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x70, 0x72, 0x65, 0x76, 0x69, 0x6f, 0x75, 0x73, 0x6c, 0x79, 0x2d, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x65, 0x64, 0x20, 0x6a, 0x75, 0x73, 0x74, 0x2d, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x65, 0x64, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6a, 0x75, 0x73, 0x74, 0x2d, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x65, 0x64, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x2a, 0x20, 0x28, 0x28, 0x63, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x67, 0x65, 0x74, 0x63, 0x20, 0x6e, 0x63, 0x20, 0x28, 0x63, 0x2d, 0x70, 0x6f, 0x69, 0x6e, 0x74, 0x65, 0x72, 0x20, 0x30, 0x29, 0x20, 0x28, 0x63, 0x2d, 0x70, 0x6f, 0x69, 0x6e, 0x74, 0x65, 0x72, 0x20, 0x30, 0x29, 0x20, 0x6e, 0x69, 0x29, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x3d, 0x20, 0x63, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x3e, 0x69, 0x6e, 0x74, 0x65, 0x67, 0x65, 0x72, 0x20, 0x23, 0x5c, 0x65, 0x73, 0x63, 0x61, 0x70, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x6c, 0x6f, 0x67, 0x69, 0x6f, 0x72, 0x20, 0x6d, 0x65, 0x74, 0x61, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x67, 0x65, 0x74, 0x63, 0x20, 0x6e, 0x63, 0x20, 0x28, 0x63, 0x2d, 0x70, 0x6f, 0x69, 0x6e, 0x74, 0x65, 0x72, 0x20, 0x30, 0x29, 0x20, 0x28, 0x63, 0x2d, 0x70, 0x6f, 0x69, 0x6e, 0x74, 0x65, 0x72, 0x20, 0x30, 0x29, 0x20, 0x6e, 0x69, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x63, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x66, 0x75, 0x6e, 0x63, 0x20, 0x28, 0x68, 0x61, 0x73, 0x68, 0x2d, 0x74, 0x61, 0x62, 0x6c, 0x65, 0x2d, 0x72, 0x65, 0x66, 0x20, 0x6b, 0x65, 0x79, 0x6d, 0x61, 0x70, 0x20, 0x28, 0x6c, 0x6f, 0x67, 0x69, 0x6f, 0x72, 0x20, 0x63, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x6e, 0x63, 0x69, 0x6e, 0x70, 0x75, 0x74, 0x5f, 0x63, 0x74, 0x72, 0x6c, 0x20, 0x6e, 0x69, 0x29, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x72, 0x6f, 0x6c, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x6e, 0x63, 0x69, 0x6e, 0x70, 0x75, 0x74, 0x5f, 0x61, 0x6c, 0x74, 0x20, 0x6e, 0x69, 0x29, 0x20, 0x6d, 0x65, 0x74, 0x61, 0x2d, 0x6b, 0x65, 0x79, 0x20, 0x30, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x70, 0x72, 0x6f, 0x63, 0x65, 0x64, 0x75, 0x72, 0x65, 0x3f, 0x20, 0x66, 0x75, 0x6e, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x63, 0x61, 0x74, 0x63, 0x68, 0x20, 0x23, 0x74, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x66, 0x75, 0x6e, 0x63, 0x20, 0x63, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x74, 0x79, 0x70, 0x65, 0x20, 0x69, 0x6e, 0x66, 0x6f, 0x29, 0x20, 0x3b, 0x20, 0x74, 0x68, 0x69, 0x73, 0x20, 0x69, 0x73, 0x20, 0x75, 0x73, 0x75, 0x61, 0x6c, 0x6c, 0x79, 0x20, 0x61, 0x6e, 0x20, 0x69, 0x6e, 0x74, 0x65, 0x72, 0x6e, 0x61, 0x6c, 0x20, 0x28, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x29, 0x20, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x2c, 0x20, 0x6f, 0x72, 0x20, 0x73, 0x6f, 0x6d, 0x65, 0x74, 0x69, 0x6d, 0x65, 0x73, 0x20, 0x61, 0x20, 0x72, 0x65, 0x61, 0x64, 0x20, 0x65, 0x72, 0x72, 0x6f, 0x72, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x69, 0x6e, 0x66, 0x6f, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x6e, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x31, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x72, 0x65, 0x70, 0x72, 0x6f, 0x6d, 0x70, 0x74, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x3b, 0x28, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x23, 0x66, 0x20, 0x22, 0x75, 0x6e, 0x68, 0x61, 0x6e, 0x64, 0x6c, 0x65, 0x64, 0x20, 0x7e, 0x44, 0x22, 0x20, 0x63, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x72, 0x65, 0x6e, 0x64, 0x65, 0x72, 0x20, 0x6e, 0x63, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x69, 0x66, 0x20, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x20, 0x69, 0x73, 0x20, 0x61, 0x66, 0x74, 0x65, 0x72, 0x20, 0x29, 0x2c, 0x20, 0x6c, 0x6f, 0x6f, 0x6b, 0x20, 0x66, 0x6f, 0x72, 0x20, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x69, 0x6e, 0x67, 0x20, 0x6f, 0x70, 0x65, 0x6e, 0x2c, 0x20, 0x68, 0x69, 0x67, 0x68, 0x6c, 0x69, 0x67, 0x68, 0x74, 0x20, 0x69, 0x66, 0x20, 0x66, 0x6f, 0x75, 0x6e, 0x64, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x70, 0x61, 0x69, 0x72, 0x3f, 0x20, 0x70, 0x72, 0x65, 0x76, 0x2d, 0x70, 0x61, 0x72, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x76, 0x69, 0x73, 0x69, 0x62, 0x6c, 0x65, 0x3f, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x70, 0x72, 0x65, 0x76, 0x2d, 0x70, 0x61, 0x72, 0x73, 0x29, 0x20, 0x28, 0x63, 0x61, 0x64, 0x72, 0x20, 0x70, 0x72, 0x65, 0x76, 0x2d, 0x70, 0x61, 0x72, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x63, 0x5f, 0x79, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x70, 0x72, 0x65, 0x76, 0x2d, 0x70, 0x61, 0x72, 0x73, 0x29, 0x20, 0x28, 0x63, 0x61, 0x64, 0x72, 0x20, 0x70, 0x72, 0x65, 0x76, 0x2d, 0x70, 0x61, 0x72, 0x73, 0x29, 0x20, 0x6e, 0x6f, 0x72, 0x6d, 0x61, 0x6c, 0x2d, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x72, 0x65, 0x6e, 0x64, 0x65, 0x72, 0x20, 0x6e, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x70, 0x72, 0x65, 0x76, 0x2d, 0x70, 0x61, 0x72, 0x73, 0x20, 0x23, 0x66, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x69, 0x66, 0x20, 0x77, 0x65, 0x20, 0x68, 0x61, 0x76, 0x65, 0x20, 0x22, 0x28, 0x6e, 0x61, 0x6d, 0x65, 0x22, 0x20, 0x61, 0x6e, 0x64, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x69, 0x73, 0x20, 0x61, 0x20, 0x66, 0x75, 0x6e, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x2f, 0x6d, 0x61, 0x63, 0x72, 0x6f, 0x2c, 0x20, 0x61, 0x6e, 0x64, 0x20, 0x69, 0x74, 0x20, 0x68, 0x61, 0x73, 0x20, 0x65, 0x69, 0x74, 0x68, 0x65, 0x72, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x20, 0x20, 0x61, 0x20, 0x73, 0x69, 0x67, 0x6e, 0x61, 0x74, 0x75, 0x72, 0x65, 0x20, 0x6f, 0x72, 0x20, 0x64, 0x6f, 0x63, 0x75, 0x6d, 0x65, 0x6e, 0x74, 0x61, 0x74, 0x69, 0x6f, 0x6e, 0x2c, 0x20, 0x70, 0x6f, 0x73, 0x74, 0x20, 0x69, 0x74, 0x20, 0x69, 0x6e, 0x20, 0x74, 0x68, 0x65, 0x20, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x20, 0x61, 0x72, 0x65, 0x61, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x69, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x29, 0x20, 0x31, 0x29, 0x20, 0x28, 0x2d, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x3c, 0x20, 0x69, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x77, 0x68, 0x69, 0x74, 0x65, 0x73, 0x70, 0x61, 0x63, 0x65, 0x3f, 0x20, 0x28, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x69, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6d, 0x65, 0x6d, 0x76, 0x20, 0x28, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x69, 0x29, 0x20, 0x27, 0x28, 0x23, 0x5c, 0x28, 0x20, 0x23, 0x5c, 0x29, 0x20, 0x23, 0x5c, 0x23, 0x20, 0x23, 0x5c, 0x3b, 0x20, 0x23, 0x5c, 0x22, 0x20, 0x23, 0x5c, 0x27, 0x20, 0x23, 0x5c, 0x60, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x3e, 0x3d, 0x20, 0x69, 0x20, 0x30, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x3d, 0x3f, 0x20, 0x28, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x69, 0x29, 0x20, 0x23, 0x5c, 0x28, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x20, 0x31, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x70, 0x6f, 0x73, 0x69, 0x74, 0x69, 0x76, 0x65, 0x3f, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x76, 0x61, 0x6c, 0x75, 0x65, 0x20, 0x28, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x2d, 0x3e, 0x76, 0x61, 0x6c, 0x75, 0x65, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x2d, 0x3e, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x29, 0x20, 0x74, 0x6f, 0x70, 0x2d, 0x6c, 0x65, 0x76, 0x65, 0x6c, 0x2d, 0x6c, 0x65, 0x74, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x70, 0x72, 0x6f, 0x63, 0x65, 0x64, 0x75, 0x72, 0x65, 0x3f, 0x20, 0x76, 0x61, 0x6c, 0x75, 0x65, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x6d, 0x61, 0x63, 0x72, 0x6f, 0x3f, 0x20, 0x76, 0x61, 0x6c, 0x75, 0x65, 0x29, 0x29, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x73, 0x79, 0x6e, 0x74, 0x61, 0x78, 0x20, 0x68, 0x65, 0x72, 0x65, 0x20, 0x69, 0x73, 0x20, 0x6a, 0x75, 0x73, 0x74, 0x20, 0x6e, 0x6f, 0x69, 0x73, 0x65, 0x20, 0x2d, 0x2d, 0x20, 0x65, 0x76, 0x65, 0x72, 0x79, 0x6f, 0x6e, 0x65, 0x20, 0x6b, 0x6e, 0x6f, 0x77, 0x73, 0x20, 0x61, 0x62, 0x6f, 0x75, 0x74, 0x20, 0x22, 0x69, 0x66, 0x22, 0x21, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x73, 0x69, 0x67, 0x20, 0x28, 0x73, 0x69, 0x67, 0x6e, 0x61, 0x74, 0x75, 0x72, 0x65, 0x20, 0x76, 0x61, 0x6c, 0x75, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x61, 0x72, 0x67, 0x73, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x73, 0x6f, 0x75, 0x72, 0x63, 0x65, 0x20, 0x28, 0x70, 0x72, 0x6f, 0x63, 0x65, 0x64, 0x75, 0x72, 0x65, 0x2d, 0x73, 0x6f, 0x75, 0x72, 0x63, 0x65, 0x20, 0x76, 0x61, 0x6c, 0x75, 0x65, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x70, 0x61, 0x69, 0x72, 0x3f, 0x20, 0x73, 0x6f, 0x75, 0x72, 0x63, 0x65, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x70, 0x61, 0x69, 0x72, 0x3f, 0x20, 0x28, 0x63, 0x64, 0x72, 0x20, 0x73, 0x6f, 0x75, 0x72, 0x63, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x61, 0x64, 0x72, 0x20, 0x73, 0x6f, 0x75, 0x72, 0x63, 0x65, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x63, 0x20, 0x28, 0x64, 0x6f, 0x63, 0x75, 0x6d, 0x65, 0x6e, 0x74, 0x61, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x76, 0x61, 0x6c, 0x75, 0x65, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x73, 0x74, 0x72, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x23, 0x66, 0x20, 0x22, 0x7e, 0x41, 0x7e, 0x41, 0x7e, 0x41, 0x22, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x70, 0x61, 0x69, 0x72, 0x3f, 0x20, 0x73, 0x69, 0x67, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x23, 0x66, 0x20, 0x22, 0x73, 0x69, 0x67, 0x3a, 0x20, 0x7e, 0x53, 0x22, 0x20, 0x73, 0x69, 0x67, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x22, 0x22, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x61, 0x72, 0x67, 0x73, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x23, 0x66, 0x20, 0x22, 0x7e, 0x41, 0x61, 0x72, 0x67, 0x73, 0x3a, 0x20, 0x7e, 0x53, 0x22, 0x20, 0x28, 0x69, 0x66, 0x20, 0x73, 0x69, 0x67, 0x20, 0x22, 0x2c, 0x20, 0x22, 0x20, 0x22, 0x22, 0x29, 0x20, 0x61, 0x72, 0x67, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x22, 0x22, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x3f, 0x20, 0x64, 0x6f, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x3e, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x64, 0x6f, 0x63, 0x29, 0x20, 0x30, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x23, 0x66, 0x20, 0x22, 0x7e, 0x41, 0x64, 0x6f, 0x63, 0x3a, 0x20, 0x7e, 0x53, 0x22, 0x20, 0x28, 0x69, 0x66, 0x20, 0x28, 0x6f, 0x72, 0x20, 0x61, 0x72, 0x67, 0x73, 0x20, 0x73, 0x69, 0x67, 0x29, 0x20, 0x22, 0x2c, 0x20, 0x22, 0x20, 0x22, 0x22, 0x29, 0x20, 0x64, 0x6f, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x22, 0x22, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x74, 0x6f, 0x70, 0x2d, 0x6c, 0x65, 0x76, 0x65, 0x6c, 0x2d, 0x6c, 0x65, 0x74, 0x20, 0x27, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x74, 0x65, 0x78, 0x74, 0x29, 0x20, 0x73, 0x74, 0x72, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x20, 0x28, 0x66, 0x69, 0x72, 0x73, 0x74, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x73, 0x74, 0x72, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x73, 0x68, 0x6f, 0x77, 0x20, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x69, 0x6e, 0x67, 0x20, 0x6f, 0x70, 0x65, 0x6e, 0x20, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x2c, 0x20, 0x69, 0x66, 0x20, 0x69, 0x74, 0x27, 0x73, 0x20, 0x61, 0x20, 0x63, 0x6f, 0x6d, 0x70, 0x6c, 0x65, 0x74, 0x65, 0x20, 0x65, 0x78, 0x70, 0x72, 0x65, 0x73, 0x73, 0x69, 0x6f, 0x6e, 0x2c, 0x20, 0x61, 0x73, 0x6b, 0x20, 0x6c, 0x69, 0x6e, 0x74, 0x20, 0x61, 0x62, 0x6f, 0x75, 0x74, 0x20, 0x69, 0x74, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x75, 0x6e, 0x6c, 0x65, 0x73, 0x73, 0x20, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x3c, 0x3d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x2b, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x31, 0x29, 0x29, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x67, 0x6f, 0x74, 0x20, 0x74, 0x6f, 0x20, 0x62, 0x65, 0x20, 0x72, 0x6f, 0x6f, 0x6d, 0x20, 0x66, 0x6f, 0x72, 0x20, 0x23, 0x5c, 0x28, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x3d, 0x3f, 0x20, 0x22, 0x29, 0x22, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x31, 0x29, 0x20, 0x31, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x3e, 0x3d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x2b, 0x20, 0x28, 0x62, 0x6f, 0x6c, 0x73, 0x20, 0x72, 0x6f, 0x77, 0x29, 0x20, 0x33, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x3d, 0x3f, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x33, 0x29, 0x20, 0x31, 0x20, 0x33, 0x29, 0x20, 0x22, 0x23, 0x5c, 0x5c, 0x29, 0x22, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x70, 0x61, 0x72, 0x73, 0x20, 0x28, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x2d, 0x63, 0x6c, 0x6f, 0x73, 0x65, 0x2d, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x23, 0x66, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x28, 0x70, 0x61, 0x69, 0x72, 0x3f, 0x20, 0x70, 0x61, 0x72, 0x73, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x76, 0x69, 0x73, 0x69, 0x62, 0x6c, 0x65, 0x3f, 0x20, 0x28, 0x63, 0x61, 0x61, 0x72, 0x20, 0x70, 0x61, 0x72, 0x73, 0x29, 0x20, 0x28, 0x63, 0x61, 0x64, 0x61, 0x72, 0x20, 0x70, 0x61, 0x72, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x63, 0x5f, 0x79, 0x78, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x28, 0x63, 0x61, 0x61, 0x72, 0x20, 0x70, 0x61, 0x72, 0x73, 0x29, 0x20, 0x28, 0x63, 0x61, 0x64, 0x61, 0x72, 0x20, 0x70, 0x61, 0x72, 0x73, 0x29, 0x20, 0x72, 0x65, 0x64, 0x2d, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x70, 0x72, 0x65, 0x76, 0x2d, 0x70, 0x61, 0x72, 0x73, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x70, 0x61, 0x72, 0x73, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x72, 0x65, 0x6e, 0x64, 0x65, 0x72, 0x20, 0x6e, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x61, 0x6e, 0x64, 0x20, 0x77, 0x69, 0x74, 0x68, 0x2d, 0x6c, 0x69, 0x6e, 0x74, 0x20, 0x28, 0x3d, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x63, 0x61, 0x61, 0x72, 0x20, 0x70, 0x61, 0x72, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x65, 0x78, 0x70, 0x72, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x63, 0x61, 0x64, 0x61, 0x72, 0x20, 0x70, 0x61, 0x72, 0x73, 0x29, 0x20, 0x31, 0x20, 0x28, 0x2d, 0x20, 0x63, 0x6f, 0x6c, 0x20, 0x28, 0x63, 0x61, 0x64, 0x61, 0x72, 0x20, 0x70, 0x61, 0x72, 0x73, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x61, 0x74, 0x63, 0x68, 0x20, 0x23, 0x74, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x72, 0x65, 0x73, 0x75, 0x6c, 0x74, 0x20, 0x28, 0x63, 0x61, 0x6c, 0x6c, 0x2d, 0x77, 0x69, 0x74, 0x68, 0x2d, 0x6f, 0x75, 0x74, 0x70, 0x75, 0x74, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x6f, 0x70, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x63, 0x61, 0x6c, 0x6c, 0x2d, 0x77, 0x69, 0x74, 0x68, 0x2d, 0x69, 0x6e, 0x70, 0x75, 0x74, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x65, 0x78, 0x70, 0x72, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x69, 0x70, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x2d, 0x74, 0x65, 0x6d, 0x70, 0x6f, 0x72, 0x61, 0x72, 0x69, 0x6c, 0x79, 0x20, 0x28, 0x28, 0x2a, 0x72, 0x65, 0x70, 0x6f, 0x72, 0x74, 0x2d, 0x6c, 0x61, 0x63, 0x6f, 0x6e, 0x69, 0x63, 0x61, 0x6c, 0x6c, 0x79, 0x2a, 0x20, 0x23, 0x74, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x2a, 0x72, 0x65, 0x70, 0x6f, 0x72, 0x74, 0x2d, 0x63, 0x6f, 0x6d, 0x62, 0x69, 0x6e, 0x61, 0x62, 0x6c, 0x65, 0x2d, 0x6c, 0x65, 0x74, 0x73, 0x2a, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x2a, 0x72, 0x65, 0x70, 0x6f, 0x72, 0x74, 0x2d, 0x62, 0x6f, 0x6f, 0x6c, 0x65, 0x61, 0x6e, 0x2d, 0x66, 0x75, 0x6e, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x73, 0x2d, 0x6d, 0x69, 0x73, 0x62, 0x65, 0x68, 0x61, 0x76, 0x69, 0x6e, 0x67, 0x2a, 0x20, 0x23, 0x66, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x2a, 0x72, 0x65, 0x70, 0x6f, 0x72, 0x74, 0x2d, 0x71, 0x75, 0x61, 0x73, 0x69, 0x71, 0x75, 0x6f, 0x74, 0x65, 0x2d, 0x72, 0x65, 0x77, 0x72, 0x69, 0x74, 0x65, 0x73, 0x2a, 0x20, 0x23, 0x66, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x69, 0x6e, 0x74, 0x20, 0x69, 0x70, 0x20, 0x6f, 0x70, 0x20, 0x23, 0x66, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x75, 0x6e, 0x6c, 0x65, 0x73, 0x73, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x3d, 0x3f, 0x20, 0x72, 0x65, 0x73, 0x75, 0x6c, 0x74, 0x20, 0x65, 0x78, 0x70, 0x72, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x74, 0x6f, 0x70, 0x2d, 0x6c, 0x65, 0x76, 0x65, 0x6c, 0x2d, 0x6c, 0x65, 0x74, 0x20, 0x27, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x74, 0x65, 0x78, 0x74, 0x29, 0x20, 0x72, 0x65, 0x73, 0x75, 0x6c, 0x74, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x20, 0x28, 0x66, 0x69, 0x72, 0x73, 0x74, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x72, 0x65, 0x73, 0x75, 0x6c, 0x74, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x74, 0x79, 0x70, 0x65, 0x20, 0x69, 0x6e, 0x66, 0x6f, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x9, 0x23, 0x66, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x6d, 0x6f, 0x76, 0x65, 0x2d, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x63, 0x6f, 0x6c, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x28, 0x72, 0x65, 0x70, 0x6c, 0x2d, 0x6c, 0x6f, 0x6f, 0x70, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x74, 0x79, 0x70, 0x65, 0x20, 0x69, 0x6e, 0x66, 0x6f, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x2d, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x20, 0x6e, 0x63, 0x70, 0x20, 0x72, 0x6f, 0x77, 0x20, 0x69, 0x6e, 0x66, 0x6f, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x73, 0x74, 0x6f, 0x70, 0x20, 0x6e, 0x63, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x61, 0x70, 0x70, 0x6c, 0x79, 0x20, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x2a, 0x73, 0x74, 0x64, 0x65, 0x72, 0x72, 0x2a, 0x20, 0x69, 0x6e, 0x66, 0x6f, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x2a, 0x73, 0x74, 0x64, 0x65, 0x72, 0x72, 0x2a, 0x20, 0x22, 0x7e, 0x25, 0x6c, 0x69, 0x6e, 0x65, 0x20, 0x7e, 0x41, 0x3a, 0x20, 0x7e, 0x41, 0x7e, 0x25, 0x22, 0x20, 0x28, 0x28, 0x6f, 0x77, 0x6c, 0x65, 0x74, 0x29, 0x20, 0x27, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x2d, 0x6c, 0x69, 0x6e, 0x65, 0x29, 0x20, 0x28, 0x28, 0x6f, 0x77, 0x6c, 0x65, 0x74, 0x29, 0x20, 0x27, 0x65, 0x72, 0x72, 0x6f, 0x72, 0x2d, 0x63, 0x6f, 0x64, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x23, 0x5f, 0x65, 0x78, 0x69, 0x74, 0x29, 0xa, 
+  0x9, 0x9, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x29, 0x29, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x72, 0x75, 0x6e, 0xa, 
+  0xa, 
+  0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x73, 0x74, 0x6f, 0x70, 0x29, 0xa, 
+  0x9, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x73, 0x74, 0x6f, 0x70, 0x20, 0x6e, 0x63, 0x29, 0xa, 
+  0x9, 0x28, 0x23, 0x5f, 0x65, 0x78, 0x69, 0x74, 0x29, 0x29, 0xa, 
+  0xa, 
+  0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x3b, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x20, 0x65, 0x6d, 0x61, 0x63, 0x73, 0x20, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0x2d, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x65, 0x6d, 0x61, 0x63, 0x73, 0x2d, 0x72, 0x65, 0x70, 0x6c, 0x29, 0xa, 
+  0x9, 0x3b, 0x3b, 0x20, 0x61, 0x6c, 0x73, 0x6f, 0x20, 0x74, 0x68, 0x69, 0x73, 0x20, 0x64, 0x6f, 0x65, 0x73, 0x20, 0x6e, 0x6f, 0x74, 0x20, 0x72, 0x65, 0x73, 0x65, 0x6e, 0x64, 0x20, 0x74, 0x68, 0x65, 0x20, 0x65, 0x6e, 0x74, 0x69, 0x72, 0x65, 0x20, 0x65, 0x78, 0x70, 0x72, 0x65, 0x73, 0x73, 0x69, 0x6f, 0x6e, 0x20, 0x61, 0x66, 0x74, 0x65, 0x72, 0x20, 0x65, 0x64, 0x69, 0x74, 0x69, 0x6e, 0x67, 0xa, 
+  0x9, 0x3b, 0x3b, 0x20, 0x20, 0x20, 0x61, 0x6e, 0x64, 0x20, 0x64, 0x6f, 0x65, 0x73, 0x20, 0x6e, 0x6f, 0x74, 0x20, 0x6e, 0x6f, 0x74, 0x69, 0x63, 0x65, 0x20, 0x69, 0x6e, 0x2d, 0x70, 0x6c, 0x61, 0x63, 0x65, 0x20, 0x65, 0x64, 0x69, 0x74, 0x73, 0xa, 
+  0x9, 0x3b, 0x3b, 0x20, 0x20, 0x20, 0x63, 0x61, 0x6e, 0x20, 0x3c, 0x63, 0x72, 0x3e, 0x20, 0x67, 0x65, 0x74, 0x20, 0x65, 0x6e, 0x74, 0x69, 0x72, 0x65, 0x20, 0x65, 0x78, 0x70, 0x72, 0x3f, 0xa, 
+  0x9, 0x28, 0x77, 0x69, 0x74, 0x68, 0x2d, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x73, 0x75, 0x62, 0x6c, 0x65, 0x74, 0x20, 0x6c, 0x69, 0x62, 0x63, 0x2d, 0x6c, 0x65, 0x74, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x62, 0x75, 0x66, 0x20, 0x28, 0x63, 0x2d, 0x70, 0x6f, 0x69, 0x6e, 0x74, 0x65, 0x72, 0x2d, 0x3e, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x63, 0x61, 0x6c, 0x6c, 0x6f, 0x63, 0x20, 0x35, 0x31, 0x32, 0x20, 0x31, 0x29, 0x20, 0x35, 0x31, 0x32, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x2a, 0x73, 0x74, 0x64, 0x65, 0x72, 0x72, 0x2a, 0x20, 0x22, 0x3e, 0x20, 0x22, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x62, 0x20, 0x28, 0x66, 0x67, 0x65, 0x74, 0x73, 0x20, 0x62, 0x75, 0x66, 0x20, 0x35, 0x31, 0x32, 0x20, 0x73, 0x74, 0x64, 0x69, 0x6e, 0x29, 0x20, 0x28, 0x66, 0x67, 0x65, 0x74, 0x73, 0x20, 0x62, 0x75, 0x66, 0x20, 0x35, 0x31, 0x32, 0x20, 0x73, 0x74, 0x64, 0x69, 0x6e, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x28, 0x7a, 0x65, 0x72, 0x6f, 0x3f, 0x20, 0x28, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x62, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x28, 0x23, 0x5f, 0x65, 0x78, 0x69, 0x74, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x6c, 0x65, 0x6e, 0x20, 0x28, 0x73, 0x74, 0x72, 0x6c, 0x65, 0x6e, 0x20, 0x62, 0x75, 0x66, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x70, 0x6f, 0x73, 0x69, 0x74, 0x69, 0x76, 0x65, 0x3f, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x28, 0x69, 0x20, 0x30, 0x20, 0x28, 0x2b, 0x20, 0x69, 0x20, 0x31, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x20, 0x28, 0x63, 0x68, 0x61, 0x72, 0x2d, 0x77, 0x68, 0x69, 0x74, 0x65, 0x73, 0x70, 0x61, 0x63, 0x65, 0x3f, 0x20, 0x28, 0x62, 0x75, 0x66, 0x20, 0x69, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x3d, 0x20, 0x69, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x3c, 0x20, 0x69, 0x20, 0x6c, 0x65, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x73, 0x74, 0x72, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x62, 0x75, 0x66, 0x20, 0x30, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x73, 0x74, 0x72, 0x6c, 0x65, 0x6e, 0x20, 0x62, 0x75, 0x66, 0x29, 0x20, 0x31, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x63, 0x61, 0x74, 0x63, 0x68, 0x20, 0x23, 0x74, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x6f, 0x20, 0x28, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x28, 0x3d, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x2d, 0x6c, 0x65, 0x6e, 0x67, 0x74, 0x68, 0x20, 0x73, 0x74, 0x72, 0x29, 0x20, 0x30, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x28, 0x63, 0x61, 0x74, 0x63, 0x68, 0x20, 0x27, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x2d, 0x72, 0x65, 0x61, 0x64, 0x2d, 0x65, 0x72, 0x72, 0x6f, 0x72, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x2a, 0x73, 0x74, 0x64, 0x65, 0x72, 0x72, 0x2a, 0x20, 0x22, 0x7e, 0x53, 0x7e, 0x25, 0x3e, 0x20, 0x22, 0x20, 0x28, 0x65, 0x76, 0x61, 0x6c, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x73, 0x74, 0x72, 0x20, 0x28, 0x2a, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x2a, 0x20, 0x27, 0x74, 0x6f, 0x70, 0x2d, 0x6c, 0x65, 0x76, 0x65, 0x6c, 0x2d, 0x6c, 0x65, 0x74, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x73, 0x74, 0x72, 0x20, 0x22, 0x22, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x74, 0x79, 0x70, 0x65, 0x20, 0x69, 0x6e, 0x66, 0x6f, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x66, 0x67, 0x65, 0x74, 0x73, 0x20, 0x62, 0x75, 0x66, 0x20, 0x35, 0x31, 0x32, 0x20, 0x73, 0x74, 0x64, 0x69, 0x6e, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x73, 0x74, 0x72, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x2d, 0x61, 0x70, 0x70, 0x65, 0x6e, 0x64, 0x20, 0x73, 0x74, 0x72, 0x20, 0x22, 0x20, 0x22, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x62, 0x75, 0x66, 0x20, 0x30, 0x20, 0x28, 0x2d, 0x20, 0x28, 0x73, 0x74, 0x72, 0x6c, 0x65, 0x6e, 0x20, 0x62, 0x75, 0x66, 0x29, 0x20, 0x31, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x61, 0x6d, 0x62, 0x64, 0x61, 0x20, 0x28, 0x74, 0x79, 0x70, 0x65, 0x20, 0x69, 0x6e, 0x66, 0x6f, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x73, 0x74, 0x72, 0x20, 0x22, 0x22, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x61, 0x70, 0x70, 0x6c, 0x79, 0x20, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x2a, 0x73, 0x74, 0x64, 0x65, 0x72, 0x72, 0x2a, 0x20, 0x69, 0x6e, 0x66, 0x6f, 0x29, 0xa, 
+  0x9, 0x9, 0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x6d, 0x61, 0x74, 0x20, 0x2a, 0x73, 0x74, 0x64, 0x65, 0x72, 0x72, 0x2a, 0x20, 0x22, 0x7e, 0x25, 0x3e, 0x20, 0x22, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x28, 0x73, 0x74, 0x61, 0x72, 0x74, 0x29, 0xa, 
+  0x9, 0x28, 0x69, 0x66, 0x20, 0x28, 0x77, 0x69, 0x74, 0x68, 0x2d, 0x6c, 0x65, 0x74, 0x20, 0x6c, 0x69, 0x62, 0x63, 0x2d, 0x6c, 0x65, 0x74, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6f, 0x72, 0x20, 0x28, 0x7a, 0x65, 0x72, 0x6f, 0x3f, 0x20, 0x28, 0x69, 0x73, 0x61, 0x74, 0x74, 0x79, 0x20, 0x28, 0x66, 0x69, 0x6c, 0x65, 0x6e, 0x6f, 0x20, 0x73, 0x74, 0x64, 0x69, 0x6e, 0x29, 0x29, 0x29, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3b, 0x20, 0x6e, 0x6f, 0x74, 0x20, 0x61, 0x20, 0x74, 0x65, 0x72, 0x6d, 0x69, 0x6e, 0x61, 0x6c, 0x20, 0x2d, 0x2d, 0x20, 0x69, 0x6e, 0x70, 0x75, 0x74, 0x20, 0x66, 0x72, 0x6f, 0x6d, 0x20, 0x70, 0x69, 0x70, 0x65, 0x20, 0x70, 0x72, 0x6f, 0x62, 0x61, 0x62, 0x6c, 0x79, 0xa, 
+  0x9, 0x9, 0x20, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x3d, 0x3f, 0x20, 0x28, 0x67, 0x65, 0x74, 0x65, 0x6e, 0x76, 0x20, 0x22, 0x54, 0x45, 0x52, 0x4d, 0x22, 0x29, 0x20, 0x22, 0x64, 0x75, 0x6d, 0x62, 0x22, 0x29, 0x29, 0x29, 0x20, 0x20, 0x3b, 0x20, 0x6e, 0x6f, 0x20, 0x76, 0x74, 0x31, 0x30, 0x30, 0x20, 0x63, 0x6f, 0x64, 0x65, 0x73, 0x20, 0x2d, 0x2d, 0x20, 0x65, 0x6d, 0x61, 0x63, 0x73, 0x20, 0x73, 0x75, 0x62, 0x6a, 0x6f, 0x62, 0x20, 0x66, 0x6f, 0x72, 0x20, 0x65, 0x78, 0x61, 0x6d, 0x70, 0x6c, 0x65, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x65, 0x6d, 0x61, 0x63, 0x73, 0x2d, 0x72, 0x65, 0x70, 0x6c, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x28, 0x62, 0x65, 0x67, 0x69, 0x6e, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x6e, 0x6f, 0x70, 0x74, 0x69, 0x6f, 0x6e, 0x73, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x6f, 0x70, 0x74, 0x69, 0x6f, 0x6e, 0x73, 0x5f, 0x6d, 0x61, 0x6b, 0x65, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x6f, 0x70, 0x74, 0x69, 0x6f, 0x6e, 0x73, 0x5f, 0x66, 0x6c, 0x61, 0x67, 0x73, 0x20, 0x6e, 0x6f, 0x70, 0x74, 0x69, 0x6f, 0x6e, 0x73, 0x29, 0x20, 0x4e, 0x43, 0x4f, 0x50, 0x54, 0x49, 0x4f, 0x4e, 0x5f, 0x53, 0x55, 0x50, 0x50, 0x52, 0x45, 0x53, 0x53, 0x5f, 0x42, 0x41, 0x4e, 0x4e, 0x45, 0x52, 0x53, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x63, 0x6f, 0x72, 0x65, 0x5f, 0x69, 0x6e, 0x69, 0x74, 0x20, 0x6e, 0x6f, 0x70, 0x74, 0x69, 0x6f, 0x6e, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x5f, 0x65, 0x6e, 0x61, 0x62, 0x6c, 0x65, 0x20, 0x6e, 0x63, 0x20, 0x30, 0x20, 0x32, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x75, 0x6e, 0x6c, 0x65, 0x73, 0x73, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x2d, 0x70, 0x6f, 0x73, 0x69, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x22, 0x72, 0x78, 0x76, 0x74, 0x22, 0x20, 0x28, 0x28, 0x6c, 0x69, 0x62, 0x63, 0x2d, 0x6c, 0x65, 0x74, 0x20, 0x27, 0x67, 0x65, 0x74, 0x65, 0x6e, 0x76, 0x29, 0x20, 0x22, 0x54, 0x45, 0x52, 0x4d, 0x22, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x6d, 0x69, 0x63, 0x65, 0x5f, 0x65, 0x6e, 0x61, 0x62, 0x6c, 0x65, 0x20, 0x6e, 0x63, 0x20, 0x4e, 0x43, 0x4d, 0x49, 0x43, 0x45, 0x5f, 0x41, 0x4c, 0x4c, 0x5f, 0x45, 0x56, 0x45, 0x4e, 0x54, 0x53, 0x29, 0x29, 0x20, 0x3b, 0x20, 0x30, 0x20, 0x69, 0x66, 0x20, 0x6f, 0x6b, 0x2c, 0x20, 0x2d, 0x31, 0x20, 0x69, 0x66, 0x20, 0x66, 0x61, 0x69, 0x6c, 0x75, 0x72, 0x65, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6c, 0x65, 0x74, 0x20, 0x28, 0x28, 0x73, 0x69, 0x7a, 0x65, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x64, 0x69, 0x6d, 0x5f, 0x79, 0x78, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x73, 0x74, 0x64, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x20, 0x6e, 0x63, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x28, 0x63, 0x61, 0x64, 0x72, 0x20, 0x73, 0x69, 0x7a, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x28, 0x63, 0x61, 0x72, 0x20, 0x73, 0x69, 0x7a, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x73, 0x74, 0x61, 0x74, 0x70, 0x2d, 0x72, 0x6f, 0x77, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x73, 0x74, 0x61, 0x74, 0x70, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x6e, 0x65, 0x77, 0x20, 0x6e, 0x63, 0x20, 0x6e, 0x63, 0x2d, 0x72, 0x6f, 0x77, 0x73, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x30, 0x20, 0x30, 0x20, 0x28, 0x63, 0x2d, 0x70, 0x6f, 0x69, 0x6e, 0x74, 0x65, 0x72, 0x20, 0x30, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x5f, 0x64, 0x6f, 0x75, 0x62, 0x6c, 0x65, 0x5f, 0x62, 0x6f, 0x78, 0x20, 0x73, 0x74, 0x61, 0x74, 0x70, 0x20, 0x30, 0x20, 0x30, 0x20, 0x28, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x30, 0x29, 0x20, 0x28, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x31, 0x29, 0x20, 0x28, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x32, 0x29, 0x20, 0x28, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x33, 0x29, 0x20, 0x28, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x34, 0x29, 0x20, 0x28, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x2d, 0x63, 0x65, 0x6c, 0x6c, 0x73, 0x20, 0x35, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x73, 0x74, 0x61, 0x74, 0x70, 0x20, 0x31, 0x20, 0x31, 0x20, 0x28, 0x6d, 0x61, 0x6b, 0x65, 0x2d, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x35, 0x29, 0x20, 0x23, 0x5c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x29, 0x29, 0xa, 
+  0x9, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x77, 0x68, 0x65, 0x6e, 0x20, 0x28, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x2d, 0x70, 0x6f, 0x73, 0x69, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x22, 0x72, 0x78, 0x76, 0x74, 0x22, 0x20, 0x28, 0x67, 0x65, 0x74, 0x65, 0x6e, 0x76, 0x20, 0x22, 0x54, 0x45, 0x52, 0x4d, 0x22, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x70, 0x75, 0x74, 0x73, 0x74, 0x72, 0x5f, 0x79, 0x78, 0x20, 0x73, 0x74, 0x61, 0x74, 0x70, 0x20, 0x31, 0x20, 0x32, 0x20, 0x28, 0x73, 0x75, 0x62, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x22, 0x72, 0x78, 0x76, 0x74, 0x20, 0x64, 0x6f, 0x65, 0x73, 0x6e, 0x27, 0x74, 0x20, 0x73, 0x75, 0x70, 0x70, 0x6f, 0x72, 0x74, 0x20, 0x74, 0x68, 0x65, 0x20, 0x6d, 0x6f, 0x75, 0x73, 0x65, 0x22, 0x20, 0x30, 0x20, 0x28, 0x6d, 0x69, 0x6e, 0x20, 0x33, 0x30, 0x20, 0x28, 0x2d, 0x20, 0x6e, 0x63, 0x2d, 0x63, 0x6f, 0x6c, 0x73, 0x20, 0x33, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x9, 0x9, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x72, 0x65, 0x6e, 0x64, 0x65, 0x72, 0x20, 0x6e, 0x63, 0x29, 0x29, 0x29, 0x29, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x63, 0x75, 0x72, 0x6c, 0x65, 0x74, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x20, 0x20, 0x28, 0x77, 0x69, 0x74, 0x68, 0x2d, 0x6c, 0x65, 0x74, 0x20, 0x2a, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x2a, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x74, 0x61, 0x72, 0x74, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x28, 0x72, 0x75, 0x6e, 0x29, 0xa, 
+  0x20, 0x20, 0x20, 0x20, 0x28, 0x73, 0x74, 0x6f, 0x70, 0x29, 0x29, 0x29, 0xa, 
+  0xa, 
+  0x3b, 0x3b, 0x20, 0x73, 0x65, 0x6c, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x28, 0x62, 0x6f, 0x74, 0x68, 0x20, 0x77, 0x61, 0x79, 0x73, 0x29, 0x3a, 0xa, 
+  0x3b, 0x3b, 0x20, 0x20, 0x20, 0x28, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x6c, 0x79, 0x20, 0x77, 0x6f, 0x72, 0x6b, 0x73, 0x20, 0x62, 0x79, 0x20, 0x64, 0x72, 0x61, 0x67, 0x67, 0x69, 0x6e, 0x67, 0x20, 0x6d, 0x6f, 0x75, 0x73, 0x65, 0x20, 0x61, 0x6e, 0x64, 0x20, 0x75, 0x73, 0x69, 0x6e, 0x67, 0x20, 0x43, 0x2d, 0x79, 0x2c, 0x20, 0x62, 0x75, 0x74, 0x20, 0x74, 0x65, 0x78, 0x74, 0x20, 0x69, 0x73, 0x20, 0x6e, 0x6f, 0x74, 0x20, 0x68, 0x69, 0x67, 0x68, 0x6c, 0x69, 0x67, 0x68, 0x74, 0x65, 0x64, 0x29, 0xa, 
+  0x3b, 0x3b, 0x20, 0x20, 0x20, 0x78, 0x63, 0x6c, 0x69, 0x70, 0x20, 0x74, 0x6f, 0x20, 0x61, 0x63, 0x63, 0x65, 0x73, 0x73, 0x20, 0x74, 0x68, 0x65, 0x20, 0x63, 0x6c, 0x69, 0x70, 0x62, 0x6f, 0x61, 0x72, 0x64, 0x3f, 0x3f, 0x20, 0x28, 0x73, 0x79, 0x73, 0x74, 0x65, 0x6d, 0x20, 0x22, 0x78, 0x63, 0x6c, 0x69, 0x70, 0x20, 0x2d, 0x6f, 0x22, 0x29, 0x3d, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x2c, 0x20, 0x28, 0x73, 0x79, 0x73, 0x74, 0x65, 0x6d, 0x20, 0x22, 0x65, 0x63, 0x68, 0x6f, 0x20, 0x2e, 0x2e, 0x2e, 0x20, 0x7c, 0x20, 0x78, 0x63, 0x6c, 0x69, 0x70, 0x22, 0x29, 0x3d, 0x73, 0x65, 0x74, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0xa, 
+  0x3b, 0x3b, 0x20, 0x20, 0x20, 0x73, 0x6f, 0x20, 0x69, 0x66, 0x20, 0x6d, 0x6f, 0x75, 0x73, 0x65, 0x28, 0x32, 0x29, 0x3d, 0x67, 0x65, 0x74, 0x20, 0x66, 0x72, 0x6f, 0x6d, 0x20, 0x78, 0x63, 0x6c, 0x69, 0x70, 0x20, 0x69, 0x66, 0x20, 0x69, 0x74, 0x20, 0x65, 0x78, 0x69, 0x73, 0x74, 0x73, 0x20, 0x65, 0x74, 0x63, 0x2c, 0x20, 0x6f, 0x72, 0x20, 0x6d, 0x61, 0x79, 0x62, 0x65, 0x20, 0x61, 0x64, 0x64, 0x20, 0x65, 0x78, 0x61, 0x6d, 0x70, 0x6c, 0x65, 0x20, 0x66, 0x75, 0x6e, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x2c, 0x20, 0x6f, 0x72, 0x20, 0x63, 0x61, 0x6e, 0x20, 0x77, 0x65, 0x20, 0x64, 0x6f, 0x20, 0x74, 0x68, 0x69, 0x73, 0x20, 0x69, 0x6e, 0x20, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x2e, 0x63, 0x3f, 0xa, 
+  0x3b, 0x3b, 0x20, 0x20, 0x20, 0x20, 0x20, 0x72, 0x69, 0x67, 0x68, 0x74, 0x20, 0x62, 0x75, 0x74, 0x74, 0x6f, 0x6e, 0x20, 0x69, 0x73, 0x20, 0x6e, 0x63, 0x6b, 0x65, 0x79, 0x5f, 0x62, 0x75, 0x74, 0x74, 0x6f, 0x6e, 0x32, 0x2c, 0x20, 0x73, 0x63, 0x72, 0x6f, 0x6c, 0x6c, 0x3d, 0x6e, 0x63, 0x6b, 0x65, 0x79, 0x5f, 0x62, 0x75, 0x74, 0x74, 0x6f, 0x6e, 0x33, 0x20, 0x28, 0x6c, 0x78, 0x74, 0x65, 0x72, 0x6d, 0x69, 0x6e, 0x61, 0x6c, 0x20, 0x2d, 0x2d, 0x20, 0x6e, 0x6f, 0x74, 0x20, 0x72, 0x78, 0x76, 0x74, 0x29, 0xa, 
+  0x3b, 0x3b, 0x20, 0x20, 0x20, 0x43, 0x5f, 0x3c, 0x73, 0x70, 0x61, 0x63, 0x65, 0x3e, 0x2b, 0x6d, 0x6f, 0x76, 0x65, 0x20, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x20, 0x2d, 0x2d, 0x20, 0x6e, 0x65, 0x65, 0x64, 0x20, 0x68, 0x69, 0x67, 0x68, 0x6c, 0x69, 0x67, 0x68, 0x74, 0x69, 0x6e, 0x67, 0x20, 0x74, 0x6f, 0x6f, 0xa, 
+  0x3b, 0x3b, 0xa, 
+  0x3b, 0x3b, 0x20, 0x73, 0x6f, 0x6d, 0x65, 0x20, 0x74, 0x65, 0x72, 0x6d, 0x69, 0x6e, 0x61, 0x6c, 0x73, 0x20, 0x68, 0x61, 0x76, 0x65, 0x20, 0x22, 0x7a, 0x6f, 0x6f, 0x6d, 0x22, 0x20, 0x2d, 0x2d, 0x20, 0x63, 0x61, 0x6e, 0x20, 0x77, 0x65, 0x20, 0x74, 0x65, 0x6c, 0x6c, 0x20, 0x74, 0x68, 0x69, 0x73, 0x20, 0x68, 0x61, 0x73, 0x20, 0x68, 0x61, 0x70, 0x70, 0x65, 0x6e, 0x65, 0x64, 0x3f, 0x20, 0x61, 0x70, 0x70, 0x61, 0x72, 0x65, 0x6e, 0x74, 0x6c, 0x79, 0x20, 0x6e, 0x6f, 0x74, 0xa, 
+  0x3b, 0x3b, 0x20, 0x20, 0x20, 0x20, 0x20, 0x28, 0x6e, 0x63, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x5f, 0x64, 0x69, 0x6d, 0x5f, 0x79, 0x78, 0x20, 0x28, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0x5f, 0x73, 0x74, 0x64, 0x70, 0x6c, 0x61, 0x6e, 0x65, 0x20, 0x28, 0x2a, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x2a, 0x20, 0x27, 0x6e, 0x63, 0x29, 0x29, 0x29, 0x20, 0x64, 0x6f, 0x65, 0x73, 0x6e, 0x27, 0x74, 0x20, 0x63, 0x68, 0x61, 0x6e, 0x67, 0x65, 0x2c, 0x20, 0x62, 0x75, 0x74, 0x20, 0x63, 0x75, 0x72, 0x73, 0x6f, 0x72, 0x20, 0x6d, 0x6f, 0x76, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x20, 0x69, 0x73, 0x20, 0x63, 0x6f, 0x6e, 0x66, 0x75, 0x73, 0x65, 0x64, 0x20, 0x61, 0x6e, 0x64, 0x20, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x20, 0x61, 0x72, 0x65, 0x61, 0x20, 0x67, 0x65, 0x74, 0x73, 0x20, 0x6c, 0x6f, 0x73, 0x74, 0xa, 
+  0x3b, 0x3b, 0x20, 0x61, 0x64, 0x64, 0x20, 0x73, 0x69, 0x67, 0x6e, 0x61, 0x74, 0x75, 0x72, 0x65, 0x73, 0x20, 0x61, 0x6e, 0x64, 0x20, 0x68, 0x65, 0x6c, 0x70, 0x20, 0x66, 0x6f, 0x72, 0x20, 0x6e, 0x6f, 0x74, 0x63, 0x75, 0x72, 0x73, 0x65, 0x73, 0xa, 
+  0x3b, 0x3b, 0x20, 0x43, 0x2d, 0x73, 0x7c, 0x72, 0x3f, 0x20, 0x5b, 0x6e, 0x65, 0x65, 0x64, 0x20, 0x70, 0x6f, 0x73, 0x69, 0x74, 0x69, 0x6f, 0x6e, 0x73, 0x20, 0x61, 0x73, 0x20, 0x61, 0x64, 0x64, 0x69, 0x6e, 0x67, 0x20, 0x63, 0x68, 0x61, 0x72, 0x73, 0x2c, 0x20, 0x62, 0x61, 0x63, 0x6b, 0x73, 0x70, 0x61, 0x63, 0x65, 0x3d, 0x72, 0x65, 0x6d, 0x6f, 0x76, 0x65, 0x20, 0x61, 0x6e, 0x64, 0x20, 0x62, 0x61, 0x63, 0x6b, 0x75, 0x70, 0x20, 0x65, 0x74, 0x63, 0x2c, 0x20, 0x64, 0x69, 0x73, 0x70, 0x6c, 0x61, 0x79, 0x20, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x20, 0x73, 0x65, 0x61, 0x72, 0x63, 0x68, 0x20, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x20, 0x69, 0x6e, 0x20, 0x73, 0x74, 0x61, 0x74, 0x75, 0x73, 0x5d, 0xa, 
+  0x3b, 0x3b, 0x20, 0x20, 0x20, 0x73, 0x74, 0x61, 0x72, 0x74, 0x20, 0x61, 0x74, 0x20, 0x72, 0x6f, 0x77, 0x2f, 0x63, 0x6f, 0x6c, 0x2c, 0x20, 0x67, 0x65, 0x74, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x65, 0x6e, 0x74, 0x73, 0x2c, 0x20, 0x67, 0x6f, 0x20, 0x74, 0x6f, 0x20, 0x63, 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x20, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x20, 0x65, 0x6c, 0x73, 0x65, 0x20, 0x69, 0x6e, 0x63, 0x72, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x2c, 0x20, 0x73, 0x61, 0x76, 0x65, 0x20, 0x72, 0x6f, 0x77, 0x2f, 0x63, 0x6f, 0x6c, 0x20, 0x6f, 0x66, 0x20, 0x6d, 0x61, 0x74, 0x63, 0x68, 0xa, 
+  0x3b, 0x3b, 0x20, 0x62, 0x65, 0x67, 0x69, 0x6e, 0x5f, 0x68, 0x6f, 0x6f, 0x6b, 0x20, 0x66, 0x6f, 0x72, 0x20, 0x73, 0x74, 0x65, 0x70, 0x70, 0x65, 0x72, 0x3a, 0x20, 0x61, 0x74, 0x20, 0x65, 0x61, 0x63, 0x68, 0x20, 0x63, 0x61, 0x6c, 0x6c, 0x2c, 0x20, 0x64, 0x72, 0x6f, 0x70, 0x20, 0x62, 0x61, 0x63, 0x6b, 0x20, 0x69, 0x6e, 0x74, 0x6f, 0x20, 0x74, 0x68, 0x65, 0x20, 0x64, 0x65, 0x62, 0x75, 0x67, 0x67, 0x65, 0x72, 0x20, 0x77, 0x69, 0x74, 0x68, 0x20, 0x63, 0x75, 0x72, 0x6c, 0x65, 0x74, 0x20, 0x2d, 0x2d, 0x20, 0x68, 0x6f, 0x77, 0x20, 0x74, 0x6f, 0x20, 0x6b, 0x65, 0x65, 0x70, 0x20, 0x6f, 0x75, 0x72, 0x20, 0x70, 0x6c, 0x61, 0x63, 0x65, 0x3f, 0x20, 0x28, 0x73, 0x74, 0x65, 0x70, 0x3d, 0x63, 0x6f, 0x6e, 0x74, 0x69, 0x6e, 0x75, 0x65, 0x2b, 0x62, 0x72, 0x65, 0x61, 0x6b, 0x20, 0x2d, 0x2d, 0x20, 0x61, 0x6d, 0x62, 0x69, 0x67, 0x75, 0x6f, 0x75, 0x73, 0x29, 0xa, 
+  0x3b, 0x3b, 0x20, 0x63, 0x6f, 0x6c, 0x6f, 0x72, 0x69, 0x7a, 0x65, 0x2c, 0x20, 0x70, 0x65, 0x72, 0x68, 0x61, 0x70, 0x73, 0x20, 0x6d, 0x61, 0x6b, 0x65, 0x20, 0x61, 0x20, 0x76, 0x65, 0x63, 0x74, 0x6f, 0x72, 0x20, 0x66, 0x6f, 0x72, 0x20, 0x65, 0x61, 0x63, 0x68, 0x20, 0x63, 0x6f, 0x6c, 0x6f, 0x72, 0x20, 0x69, 0x6e, 0x64, 0x65, 0x78, 0x65, 0x64, 0x20, 0x62, 0x79, 0x20, 0x63, 0x68, 0x61, 0x72, 0x3b, 0x20, 0x66, 0x6f, 0x72, 0x20, 0x63, 0x6f, 0x6c, 0x6f, 0x72, 0x69, 0x7a, 0x65, 0x64, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x2c, 0x20, 0x66, 0x6f, 0x72, 0x20, 0x65, 0x61, 0x63, 0x68, 0x20, 0x63, 0x68, 0x61, 0x72, 0x20, 0x67, 0x65, 0x74, 0x20, 0x63, 0x65, 0x6c, 0x6c, 0x20, 0x66, 0x72, 0x6f, 0x6d, 0x20, 0x76, 0x65, 0x63, 0x74, 0x6f, 0x72, 0x20, 0x28, 0x6f, 0x72, 0x20, 0x6d, 0x61, 0x6b, 0x65, 0x20, 0x69, 0x74, 0x20, 0x69, 0x66, 0x20, 0x6e, 0x65, 0x65, 0x64, 0x65, 0x64, 0x29, 0xa, 
+  0xa, 
+  0x28, 0x73, 0x65, 0x74, 0x21, 0x20, 0x28, 0x2a, 0x73, 0x37, 0x2a, 0x20, 0x27, 0x64, 0x65, 0x62, 0x75, 0x67, 0x29, 0x20, 0x6f, 0x6c, 0x64, 0x2d, 0x64, 0x65, 0x62, 0x75, 0x67, 0x29, 0xa, 
+  0x2a, 0x6e, 0x72, 0x65, 0x70, 0x6c, 0x2a, 0xa, 
+  0};
+unsigned int nrepl_scm_len = 65816;
diff --git a/s7/nrepl.c b/s7/nrepl.c
new file mode 100644
index 0000000..d3bba3f
--- /dev/null
+++ b/s7/nrepl.c
@@ -0,0 +1,408 @@
+/* nrepl, notcurses-based repl
+ *
+ * gcc -o nrepl nrepl.c s7.o -Wl,-export-dynamic -lnotcurses-core -lm -I. -ldl
+ *   (s7.o: gcc -c s7.c -o s7.o -I. -O2 -g)
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#ifndef _MSC_VER
+  #include <errno.h>
+  #include <unistd.h>
+#endif
+
+#include "s7.h"
+
+#include "notcurses_s7.c"
+
+/* libc stuff used in nrepl.scm (this is extracted from libc_s7.c created by cload.scm from libc.scm) */
+
+#include <time.h>
+#include <sys/time.h>
+#include <glob.h>
+
+static s7_pointer s7__getenv(s7_scheme *sc, s7_pointer arg)
+{
+  char* s7__getenv_0;
+  if (s7_is_string(s7_car(arg)))
+    s7__getenv_0 = (char*)s7_string(s7_car(arg));
+  else return(s7_wrong_type_arg_error(sc, __func__, 0, s7_car(arg), "string"));
+  return(s7_make_string(sc, (char*)getenv(s7__getenv_0)));
+}
+
+static s7_pointer s7__time(s7_scheme *sc, s7_pointer arg)
+{
+  time_t* s7__time_0;
+    s7__time_0 = (time_t*)s7_c_pointer_with_type(sc, s7_car(arg), s7_make_symbol(sc, "time_t*"), __func__, 0);
+  return(s7_make_integer(sc, (s7_int)time(s7__time_0)));
+}
+
+static s7_pointer s7__localtime(s7_scheme *sc, s7_pointer arg)
+{
+  time_t* s7__localtime_0;
+    s7__localtime_0 = (time_t*)s7_c_pointer_with_type(sc, s7_car(arg), s7_make_symbol(sc, "time_t*"), __func__, 0);
+  return(s7_make_c_pointer_with_type(sc, (void*)localtime(s7__localtime_0), s7_make_symbol(sc, "tm*"), s7_f(sc)));
+}
+
+static s7_pointer g_time_make(s7_scheme *sc, s7_pointer args) 
+{
+  time_t *tm;
+  tm = (time_t *)calloc(1, sizeof(time_t));
+  (*tm) = (time_t)s7_integer(s7_car(args));
+  return(s7_make_c_pointer_with_type(sc, (void *)tm, s7_make_symbol(sc, "time_t*"), s7_f(sc)));
+}
+
+static s7_pointer g_strftime(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, (s7_int)strftime((char *)s7_string(s7_car(args)), 
+					      (size_t)s7_integer(s7_cadr(args)), 
+					      s7_string(s7_caddr(args)), 
+					      (const struct tm *)s7_c_pointer(s7_cadddr(args)))));
+}
+
+static s7_pointer s7__isatty(s7_scheme *sc, s7_pointer arg)
+{
+  int s7__isatty_0;
+  if (s7_is_integer(s7_car(arg)))
+    s7__isatty_0 = (int)s7_integer(s7_car(arg));
+  else return(s7_wrong_type_arg_error(sc, __func__, 0, s7_car(arg), "integer"));
+  return(s7_make_integer(sc, (s7_int)isatty(s7__isatty_0)));
+}
+
+static s7_pointer s7__fileno(s7_scheme *sc, s7_pointer arg)
+{
+  FILE* s7__fileno_0;
+    s7__fileno_0 = (FILE*)s7_c_pointer_with_type(sc, s7_car(arg), s7_make_symbol(sc, "FILE*"), __func__, 0);
+  return(s7_make_integer(sc, (s7_int)fileno(s7__fileno_0)));
+}
+
+static s7_pointer s7__fgets(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer arg;
+  char* s7__fgets_0;
+  int s7__fgets_1;
+  FILE* s7__fgets_2;
+  arg = args;
+  if (s7_is_string(s7_car(arg)))
+    s7__fgets_0 = (char*)s7_string(s7_car(arg));
+  else return(s7_wrong_type_arg_error(sc, __func__, 1, s7_car(arg), "string"));
+  arg = s7_cdr(arg);
+  if (s7_is_integer(s7_car(arg)))
+    s7__fgets_1 = (int)s7_integer(s7_car(arg));
+  else return(s7_wrong_type_arg_error(sc, __func__, 2, s7_car(arg), "integer"));
+  arg = s7_cdr(arg);
+    s7__fgets_2 = (FILE*)s7_c_pointer_with_type(sc, s7_car(arg), s7_make_symbol(sc, "FILE*"), __func__, 3);
+  return(s7_make_string(sc, (char*)fgets(s7__fgets_0, s7__fgets_1, s7__fgets_2)));
+}
+
+static s7_pointer s7__strlen(s7_scheme *sc, s7_pointer arg)
+{
+  char* s7__strlen_0;
+  if (s7_is_string(s7_car(arg)))
+    s7__strlen_0 = (char*)s7_string(s7_car(arg));
+  else return(s7_wrong_type_arg_error(sc, __func__, 0, s7_car(arg), "string"));
+  return(s7_make_integer(sc, (s7_int)strlen(s7__strlen_0)));
+}
+
+static s7_pointer g_c_pointer_to_string(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_string_with_length(sc, (const char *)s7_c_pointer(s7_car(args)), s7_integer(s7_cadr(args))));
+}
+
+static s7_pointer s7__calloc(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer arg;
+  size_t s7__calloc_0;
+  size_t s7__calloc_1;
+  arg = args;
+  if (s7_is_integer(s7_car(arg)))
+    s7__calloc_0 = (size_t)s7_integer(s7_car(arg));
+  else return(s7_wrong_type_arg_error(sc, __func__, 1, s7_car(arg), "integer"));
+  arg = s7_cdr(arg);
+  if (s7_is_integer(s7_car(arg)))
+    s7__calloc_1 = (size_t)s7_integer(s7_car(arg));
+  else return(s7_wrong_type_arg_error(sc, __func__, 2, s7_car(arg), "integer"));
+  return(s7_make_c_pointer_with_type(sc, (void*)calloc(s7__calloc_0, s7__calloc_1), s7_make_symbol(sc, "void*"), s7_f(sc)));
+}
+
+static s7_pointer s7__globfree(s7_scheme *sc, s7_pointer arg)
+{
+  glob_t* s7__globfree_0;
+  s7__globfree_0 = (glob_t*)s7_c_pointer_with_type(sc, s7_car(arg), s7_make_symbol(sc, "glob_t*"), __func__, 0);
+  globfree(s7__globfree_0);
+  return(s7_unspecified(sc));
+}
+
+static s7_pointer g_glob_make(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(glob_t)), s7_make_symbol(sc, "glob_t*"), s7_f(sc)));
+}
+
+static s7_pointer g_glob(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, glob(s7_string(s7_car(args)), s7_integer(s7_cadr(args)), NULL, (glob_t *)s7_c_pointer(s7_caddr(args)))));
+}
+
+static s7_pointer g_glob_gl_pathv(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer p;
+  int i;
+  glob_t *g;
+  g = (glob_t *)s7_c_pointer(s7_car(args));
+  p = s7_nil(sc);
+  for (i = 0; i < g->gl_pathc; i++)
+    p = s7_cons(sc, s7_make_string(sc, g->gl_pathv[i]), p);
+  return(p);
+}
+
+/* catch sigint */
+#include <signal.h>
+
+static struct sigaction new_action, old_action;
+#if (!USE_SND)
+  static s7_scheme *s7;
+#endif
+static struct notcurses *nc;
+
+void eval_sigint_handler(int signum)
+{
+  s7_error(s7, s7_t(s7), s7_list(s7, 1, s7_make_string(s7, "interrupted")));
+}
+
+static s7_pointer set_sigint_handler(s7_scheme *sc, s7_pointer args)
+{
+  s7 = sc;
+  new_action.sa_handler = eval_sigint_handler;
+  sigemptyset(&new_action.sa_mask);
+  new_action.sa_flags = SA_RESTART;
+  sigaction(SIGINT, &new_action, NULL);
+  return(s7_f(sc));
+}
+
+void exit_sigint_handler(int signum)
+{
+  s7_quit(s7);
+  notcurses_stop(nc); /* using the actual old_action ("fatal_handler") does not clean up completely -- mouse chatter */
+  exit(0);
+}
+
+static s7_pointer unset_sigint_handler(s7_scheme *sc, s7_pointer args)
+{
+  s7 = sc;
+  nc = (struct notcurses *)s7_c_pointer(s7_car(args));
+  old_action.sa_handler = exit_sigint_handler;
+  sigemptyset(&old_action.sa_mask);
+  old_action.sa_flags = SA_RESTART;
+  sigaction(SIGINT, &old_action, NULL);
+  return(s7_f(sc));
+}
+
+
+static void init_nlibc(s7_scheme *sc)
+{
+  s7_pointer cur_env, pl_tx, pcl_s, pl_ix, pcl_x, pcl_i, pl_ssix, pl_is, pcl_xi;
+  s7_int gc_loc;
+
+  cur_env = s7_inlet(sc, s7_nil(sc));
+  gc_loc = s7_gc_protect(sc, cur_env);
+
+  {
+    s7_pointer t, x, s, i;
+    t = s7_t(sc);
+    x = s7_make_symbol(sc, "c-pointer?");
+    s = s7_make_symbol(sc, "string?");
+    i = s7_make_symbol(sc, "integer?");
+
+    pcl_xi = s7_make_circular_signature(sc, 1, 2, x, i);
+    pl_tx = s7_make_signature(sc, 2, t, x);
+    pl_ix = s7_make_signature(sc, 2, i, x);
+    pcl_s = s7_make_circular_signature(sc, 0, 1, s);
+    pcl_x = s7_make_circular_signature(sc, 0, 1, x);
+    pcl_i = s7_make_circular_signature(sc, 0, 1, i);
+    pl_ssix = s7_make_signature(sc, 4, s, s, i, x);
+    pl_is = s7_make_signature(sc, 2, i, s);
+  }
+
+  s7_define(sc, cur_env,
+            s7_make_symbol(sc, "getenv"),
+            s7_make_typed_function(sc, "getenv", s7__getenv, 1, 0, false, "char* getenv(char*)", pcl_s));
+
+  s7_define(sc, cur_env,
+            s7_make_symbol(sc, "time"),
+            s7_make_typed_function(sc, "time", s7__time, 1, 0, false, "int time(time_t*)", pl_ix));
+
+  s7_define(sc, cur_env,
+            s7_make_symbol(sc, "time.make"),
+            s7_make_typed_function(sc, "time.make", g_time_make, 1, 0, false, "time.make", NULL));
+
+  s7_define(sc, cur_env,
+            s7_make_symbol(sc, "localtime"),
+            s7_make_typed_function(sc, "localtime", s7__localtime, 1, 0, false, "tm* localtime(time_t*)", pcl_x));
+
+  s7_define(sc, cur_env,
+            s7_make_symbol(sc, "strftime"),
+            s7_make_typed_function(sc, "strftime", g_strftime, 4, 0, false, "strftime", NULL));
+
+  s7_define(sc, cur_env,
+            s7_make_symbol(sc, "isatty"),
+            s7_make_typed_function(sc, "isatty", s7__isatty, 1, 0, false, "int isatty(int)", pcl_i));
+
+  s7_define(sc, cur_env,
+            s7_make_symbol(sc, "fileno"),
+            s7_make_typed_function(sc, "fileno", s7__fileno, 1, 0, false, "int fileno(FILE*)", pl_ix));
+
+  s7_define(sc, cur_env, s7_make_symbol(sc, "stdin"), s7_make_c_pointer_with_type(sc, (void*)stdin, s7_make_symbol(sc, "FILE*"), s7_f(sc)));
+
+  s7_define(sc, cur_env,
+            s7_make_symbol(sc, "fgets"),
+            s7_make_typed_function(sc, "fgets", s7__fgets, 3, 0, false, "char* fgets(char* int FILE*)", pl_ssix));
+
+  s7_define(sc, cur_env,
+            s7_make_symbol(sc, "strlen"),
+            s7_make_typed_function(sc, "strlen", s7__strlen, 1, 0, false, "size_t strlen(char*)", pl_is));
+
+  s7_define(sc, cur_env,
+            s7_make_symbol(sc, "c-pointer->string"),
+            s7_make_typed_function(sc, "c-pointer->string", g_c_pointer_to_string, 2, 0, false, "c-pointer->string", NULL));
+
+  s7_define(sc, cur_env,
+            s7_make_symbol(sc, "calloc"),
+            s7_make_typed_function(sc, "calloc", s7__calloc, 2, 0, false, "void* calloc(size_t size_t)", pcl_xi));
+
+  s7_define(sc, cur_env, s7_make_symbol(sc, "GLOB_MARK"), s7_make_integer(sc, (s7_int)GLOB_MARK));
+  s7_define(sc, cur_env, s7_make_symbol(sc, "GLOB_TILDE"), s7_make_integer(sc, (s7_int)GLOB_TILDE));
+
+  s7_define(sc, cur_env,
+            s7_make_symbol(sc, "glob.make"),
+            s7_make_typed_function(sc, "glob.make", g_glob_make, 0, 0, false, "glob.make", NULL));
+
+  s7_define(sc, cur_env,
+            s7_make_symbol(sc, "globfree"),
+            s7_make_typed_function(sc, "globfree", s7__globfree, 1, 0, false, "void globfree(glob_t*)", pl_tx));
+
+  s7_define(sc, cur_env,
+            s7_make_symbol(sc, "glob"),
+            s7_make_typed_function(sc, "glob", g_glob, 3, 0, false, "glob", NULL));
+
+  s7_define(sc, cur_env,
+            s7_make_symbol(sc, "glob.gl_pathv"),
+            s7_make_typed_function(sc, "glob.gl_pathv", g_glob_gl_pathv, 1, 0, false, "glob.gl_pathv", NULL));
+  
+  s7_define_constant(sc, "*nlibc*", cur_env);
+  s7_gc_unprotect_at(sc, gc_loc);
+}
+
+#ifndef NREPL_DEBUGGING
+  #define NREPL_DEBUGGING USE_SND
+#endif
+
+#if (!USE_SND)
+int main(int argc, char **argv)
+{
+  s7_scheme *sc;
+  sc = s7_init();
+#else
+static int nrepl(s7_scheme *sc)
+{
+#endif
+  init_nlibc(sc);
+
+  s7_define_function(sc, "set-sigint-handler", set_sigint_handler, 0, 0, false, "");
+  s7_define_function(sc, "unset-sigint-handler", unset_sigint_handler, 1, 0, false, "");
+
+  notcurses_s7_init(sc);
+
+#if (!USE_SND)
+  if (argc >= 2)
+    {
+      if (strcmp(argv[1], "-e") == 0)
+	{
+	  s7_pointer x;
+	  x = s7_eval_c_string(sc, argv[2]);
+	  fprintf(stdout, "%s\n", s7_object_to_c_string(sc, x));
+	  return(0);
+	}
+      fprintf(stderr, "load %s\n", argv[1]);
+      errno = 0;
+      if (!s7_load(sc, argv[1]))
+	{
+	  fprintf(stderr, "%s: %s\n", strerror(errno), argv[1]);
+	  return(2);
+	}
+    }
+  else
+#endif
+    {
+#ifdef _MSC_VER
+  while (true)
+    {
+      char buffer[512];
+      fprintf(stdout, "\n> ");
+      if (!fgets(buffer, 512, stdin)) break;  /* error or ctrl-D */
+      if (((buffer[0] != '\n') || (strlen(buffer) > 1)))
+	{
+	  char response[1024];
+	  snprintf(response, 1024, "(write %s)", buffer);
+	  s7_eval_c_string(sc, response);
+	}
+    }
+  fprintf(stdout, "\n");
+  if (ferror(stdin))
+    fprintf(stderr, "read error on stdin\n");
+#else
+#ifdef S7_LOAD_PATH
+      s7_add_to_load_path(sc, S7_LOAD_PATH);
+#endif
+#if (!NREPL_DEBUGGING)
+      s7_add_to_load_path(sc, "/usr/local/share/s7");
+      #include "nrepl-bits.h"
+      s7_load_c_string(sc, (const char *)nrepl_scm, nrepl_scm_len);
+#else
+      if (!s7_load(sc, "nrepl.scm"))
+	return(1);
+#endif
+#endif
+    }
+  return(0);
+}
+
+#if 0
+/*
+  gcc -c s7.c -O2 -I. -Wl,-export-dynamic -lm -ldl
+  gcc -o nrepl nrepl.c s7.o -lnotcurses-core -lm -I. -ldl
+
+  To build s7 to nrepl in one line:
+    gcc -o nrepl s7.c -O2 -I. -Wl,-export-dynamic -lm -ldl -DWITH_MAIN -DWITH_NOTCURSES -lnotcurses-core
+
+  nrepl-bits.h is generated from (make-nrepl-bits.scm):
+
+(call-with-output-file "nrepl-bits.h"
+  (lambda (op)
+    (call-with-input-file "nrepl.scm"
+      (lambda (ip)
+	(format op "unsigned char nrepl_scm[] = {~%  ")
+	(do ((c (read-char ip) (read-char ip))
+	     (i 0 (+ i 1)))
+	    ((eof-object? c)
+	     (format op "0};~%unsigned int nrepl_scm_len = ~D;~%" i)) ; the C string length, not the array length
+	  (format op "0x~X, " (char->integer c))
+	  (if (char=? c #\newline)
+	      (format op "~%  ")))))))
+
+  xxd can create the array, but you need to tack on the trailing 0
+  Christos Vagias suggests:
+
+    xxd -i < scheme_file.scm > scheme_file.xxd; echo ", 0x00" >>  scheme_file.xxd
+    and scheme_file.xxd will look like
+      0x01, 0x02, 0xAA,.....
+      , 0x00
+    And then in code
+      const char main_scm[] = {
+      #include "./resources/main_scm.xxd"
+      };
+
+C23 now has #embed to handle this case
+
+*/
+#endif
diff --git a/s7/nrepl.scm b/s7/nrepl.scm
new file mode 100644
index 0000000..e4fd1bf
--- /dev/null
+++ b/s7/nrepl.scm
@@ -0,0 +1,1749 @@
+;;; nrepl.scm -- notcurses-based repl
+
+(set! (*s7* 'history-enabled) #f)
+(provide 'nrepl.scm)
+
+(define libc-let (if (defined? '*nlibc*) ; nrepl.c has the parts of *libc* we need under the name *nlibc*
+		     *nlibc*
+		     (begin
+		       (require libc.scm)
+		       *libc*)))
+
+(unless (defined? '*notcurses*)          ; nrepl.c has notcurses_s7.c (thus *notcurses*) built-in
+  (load "notcurses_s7.so" (inlet 'init_func 'notcurses_s7_init)))
+(unless (defined? 'notcurses_getc) (define (notcurses_getc a b c d) (notcurses_get a b d)))
+
+(define (drop-into-repl call e)
+  ((*nrepl* 'run) "break>" (object->string call) e))
+
+(define (display-debug-info cint) #f) ; replaced later
+(define (remove-watcher var) #f)
+(define (nrepl-lookup symbol) (((*nrepl* 'top-level-let) 'run-let) symbol))
+
+(define (debug.scm-init)
+  (set! (debug-repl)
+	drop-into-repl)
+  (set! (debug-port)
+	(open-output-function display-debug-info))
+  (set! (hook-functions ((funclet trace-in) '*debug-unwatch-hook*))
+	(list (lambda (h)
+		(remove-watcher (h 'var))))))
+
+(define old-debug (*s7* 'debug))
+(set! (*s7* 'debug) 0)
+
+(define startup-symbols (copy (symbol-table)))
+;(autoload 'lint "lint.scm")
+(require lint.scm)
+(define with-lint (defined? '*lint*)) ; maybe require should return #f if no luck? (or a list since it takes any number of args), or an error??
+
+(autoload 'pretty-print "write.scm")
+(autoload 'pp "write.scm")
+(autoload '*libc* "libc.scm")
+(autoload '*libm* "libm.scm")
+(autoload '*libgsl* "libgsl.scm")
+(autoload 'trace "debug.scm")
+(autoload 'untrace "debug.scm")
+(autoload 'break "debug.scm")
+(autoload 'unbreak "debug.scm")
+(autoload 'watch "debug.scm")
+(autoload 'unwatch "debug.scm")
+(autoload 'ow! "stuff.scm")
+(autoload 'show-profile "profile.scm")
+(autoload 'profile-port "profile.scm")
+
+(when (file-exists? ".nrepl")         ; local (scheme) initialization file for nrepl
+  (load ".nrepl"))
+
+;(define dbstr "")
+
+(unless (defined? '*nrepl*)
+  (define *nrepl*
+    (let* ((nc #f)
+	   (nc-cols 0)
+	   (nc-rows 0)
+	   (status-rows 3)
+	   (status-cells (vector (nccell_make) (nccell_make) (nccell_make) (nccell_make) (nccell_make) (nccell_make)))
+	   (statp #f)
+	   (statp-row 0)
+	   (recursor #f)
+
+	   (top-level-let
+	    (sublet (rootlet) ; environment in which evaluation takes place
+	      :history #f        ; set below
+	      :ncp-let #f
+	      :display-status #f
+	      :status-text ""
+	      :run-let #f
+
+	      :s7-version (lambda () (*s7* 'version))
+
+	      :exit (let ((+documentation+ "(exit) stops notcurses and then calls #_exit"))
+		      (let-temporarily (((*s7* 'debug) 0))
+			(lambda ()
+			  (notcurses_stop (*nrepl* 'nc))
+			  (#_exit))))
+
+	      :time (macro (expr)
+		      `(let ((start (*s7* 'cpu-time)))
+			 ,expr
+			 (- (*s7* 'cpu-time) start)))
+
+	      :with-profile (macro body
+	                      `(let-temporarily (((*s7* 'profile) 1)
+						 ((profile-port) (open-output-string)))
+				 ,@body
+				 (show-profile)
+				 (clear-profile)
+                                 (get-output-string (profile-port))))
+	      ;; the profiler has to be on when the to-be-profiled functions are loaded
+
+	      :apropos
+	      (let ((levenshtein
+		     (lambda (s1 s2)
+		       (let ((L1 (length s1))
+			     (L2 (length s2)))
+			 (cond ((zero? L1) L2)
+			       ((zero? L2) L1)
+			       (else (let ((distance (make-vector (list (+ L2 1) (+ L1 1)) 0)))
+				       (do ((i 0 (+ i 1)))
+					   ((> i L1))
+					 (set! (distance 0 i) i))
+				       (do ((i 0 (+ i 1)))
+					   ((> i L2))
+					 (set! (distance i 0) i))
+				       (do ((i 1 (+ i 1)))
+					   ((> i L2))
+					 (do ((j 1 (+ j 1)))
+					     ((> j L1))
+					   (let ((c1 (+ (distance i (- j 1)) 1))
+						 (c2 (+ (distance (- i 1) j) 1))
+						 (c3 (if (char=? (s2 (- i 1)) (s1 (- j 1)))
+							 (distance (- i 1) (- j 1))
+							 (+ (distance (- i 1) (- j 1)) 1))))
+					     (set! (distance i j) (min c1 c2 c3)))))
+				       (distance L2 L1)))))))
+
+		    (make-full-let-iterator             ; walk the entire let chain
+		     (lambda* (lt (stop (rootlet)))
+		       (if (eq? stop lt)
+			   (make-iterator lt)
+			   (letrec ((iterloop
+				     (let ((iter (make-iterator lt))
+					   (+iterator+ #t))
+				       (lambda ()
+					 (let ((result (iter)))
+					   (if (and (eof-object? result)
+						    (iterator-at-end? iter)
+						    (not (eq? stop (iterator-sequence iter))))
+					       (begin
+						 (set! iter (make-iterator (outlet (iterator-sequence iter))))
+						 (iterloop))
+					       result))))))
+			     (make-iterator iterloop))))))
+
+		(lambda* (name (e (sublet (*nrepl* 'top-level-let) *notcurses*)))
+		  (let ((ap-name (if (string? name) name
+				     (if (symbol? name)
+					 (symbol->string name)
+					 (error 'wrong-type-arg "apropos argument 1 should be a string or a symbol"))))
+			(ap-env (if (let? e) e
+				    (error 'wrong-type-arg "apropos argument 2 should be an environment"))))
+		    (let ((strs ())
+			  (min2 (floor (log (length ap-name) 2))))
+		      (for-each
+		       (lambda (binding)
+			 (if (pair? binding)
+			     (let ((symbol-name (symbol->string (car binding))))
+			       (if (string-position ap-name symbol-name)
+				   (set! strs (cons (cons binding 0) strs))
+				   (let ((distance (levenshtein ap-name symbol-name)))
+				     (if (< distance min2)
+					 (set! strs (cons (cons binding distance) strs))))))))
+		       (make-full-let-iterator ap-env))
+
+		      (if (not (pair? strs))
+			  'no-match
+			  (let ((data "")
+				(name-len (length name)))
+			    (for-each (lambda (b)
+					(set! data (string-append data
+								  (if (> (length data) 0) (string #\newline) "")
+								  (if (procedure? (cdar b))
+								      (let ((doc (documentation (cdar b)))) ; returns "" if no doc
+									(if (positive? (length doc))
+									    doc
+									    (object->string (caar b))))
+								      (object->string (caar b))))))
+				      (sort! strs (lambda (a b)
+						    (or (< (cdr a) (cdr b))
+							(and (= (cdr a) (cdr b))
+							     (< (abs (- (length (symbol->string (caar a))) name-len))
+								(abs (- (length (symbol->string (caar b))) name-len))))))))
+			    data))))))
+	      )))
+
+
+      ;; to call notcurses functions in the repl, use *nrepl* or ncp-let:
+      ;;   (notcurses_refresh (ncp-let 'nc))
+      ;; to call run within run:
+      ;;   ((*nrepl* 'run) "new-prompt>" "header info")
+
+      ;; -------- completion --------
+      (define (symbol-completion text)
+	(let ((text-len (length text))
+	      (match #f))
+	  (call-with-exit
+	   (lambda (return)
+	     (for-each
+	      (lambda (lst)
+		(for-each
+		 (lambda (par)
+		   (let* ((sym (symbol->string par))
+			  (sym-len (length sym)))
+		     (when (and (>= sym-len text-len)
+				(string=? text (substring sym 0 text-len)))
+		       (if match
+			   ;; more than one match, save the longest text that all syms match
+			   (do ((min-len (min (string-length match) sym-len))
+				(i text-len (+ i 1)))
+			       ((or (= i min-len)
+				    (not (char=? (match i) (sym i))))
+				(if (= min-len text-len)
+				    (return text)
+				    (set! match (substring match 0 i)))))
+			   (set! match sym)))))
+		 lst))
+	      (list startup-symbols (map car top-level-let))) ; (using startup-symbols to avoid all the lint junk), any others?
+	     match))))
+
+      (define (filename-completion text)
+	(and (> (length text) 0)
+	     (with-let (sublet libc-let :text text)
+	       (let ((g (glob.make)))
+		 (glob (string-append text "*")
+		       (logior (if (and (defined? 'GLOB_TILDE)
+					(char=? (text 0) #\~))
+				   GLOB_TILDE
+				   0)
+			       GLOB_MARK)
+		       g)
+		 (let ((files (map (lambda (f) ; get rid of emacs' *~ files
+				     (if (and (> (length f) 1)
+					      (char=? #\~ (f (- (length f) 1))))
+					 (values)
+					 f))
+				   (glob.gl_pathv g))))
+		   (globfree g)
+		   (and (not (null? files))
+			(null? (cdr files))
+			(car files)))))))
+
+
+      ;; -------- status area --------
+
+      (define (display-status-area)
+	(ncplane_cursor_move_yx statp 0 0)
+	(ncplane_box statp
+		     (status-cells 0) (status-cells 1) (status-cells 2)
+		     (status-cells 3) (status-cells 4) (status-cells 5)
+		     2 (- nc-cols 1) 0)
+	(ncplane_move_yx statp statp-row 0)
+	(notcurses_render nc))
+
+      (define (statp-set-bg-color r g b)
+	;; (statp-bg-set-color 0.85 0.85 0.85): light gray background
+	(let ((c1 (nccell_make)))
+	  (let ((color (logior (ash (floor (* r 256)) 16)
+			       (ash (floor (* g 256)) 8)
+			       (floor (* b 256)))))
+	    (set! (nccell_gcluster c1) (char->integer #\space))
+	    (set! (nccell_channels c1) (logior (ash NC_BGDEFAULT_MASK 32) NC_BGDEFAULT_MASK color)))
+	  (set! (nccell_stylemask c1) 0)
+	  (ncplane_set_base_cell statp c1)
+	  (notcurses_render nc)
+	  c1))
+
+      (define (clear-status)
+	(ncplane_putstr_yx statp 1 1 (make-string (- nc-cols 2) #\space)))
+
+      (define (display-status str)
+	(clear-status)
+	(ncplane_putstr_yx statp 1 2 (substring str 0 (min (length str) (- nc-cols 3))))
+	(notcurses_render nc))
+
+      (set! (top-level-let 'display-status) display-status)
+
+      (define (first-line text)
+	(let ((pos (char-position #\newline text)))
+	  (if (not pos)
+	      text
+	      (substring text 0 pos))))
+
+
+      ;; -------- red text --------
+      (define (red c)
+	(let ((c1 (nccell_make)))
+	  (set! (nccell_gcluster c1) (char->integer c))
+	  (set! (nccell_channels c1)  (logior (ash NC_BGDEFAULT_MASK 32) #xff000000000000))
+	  (set! (nccell_stylemask c1) 0)
+	  c1))
+
+      (define (normal c)
+	(let ((c1 (nccell_make)))
+	  (set! (nccell_gcluster c1) (char->integer c))
+	  (set! (nccell_channels c1)  0)
+	  (set! (nccell_stylemask c1) 0)
+	  c1))
+
+      (define red-error (let ((v (make-vector 5)))
+			  (set! (v 0) (red #\e))
+			  (set! (v 1) (red #\r))
+			  (set! (v 2) (v 1))
+			  (set! (v 3) (red #\o))
+			  (set! (v 4) (v 1))
+			  v))
+
+      (define red-paren (red #\())
+      (define normal-paren (normal #\())
+
+
+      ;; -------- run --------
+      (define* (run (prompt ">") header (envir (*nrepl* 'top-level-let)))
+
+	(let ((ncp-col 0)                  ; top-left in ncp
+	      (ncp-row 0)
+	      (ncp-cols (max 100 nc-cols))
+	      (ncp-rows (max 100 nc-rows))
+	      (ncp-max-row 0)
+	      (ncp #f)
+	      (col 0)                      ; ncplane-relative row/column
+	      (row 0)
+	      (header-row 0)
+	      (prev-pars #f)
+	      (keymap (make-hash-table 512))
+	      (old-history (top-level-let 'history)) ; see below, old restored upon exit from this ncplane
+	      (hc #f)
+	      (hc-cells #f)
+	      (header-cols 0)
+	      (header-strings #f)
+	      (watch-row 0)
+	      (watch-rows 3)
+	      (watch-col 0)
+	      (watch-cols 0)
+	      (watchers (make-hash-table 8 eq?))
+	      (wc #f)
+	      (wc-cells #f))
+
+	  (define (move-cursor y x)   ; this was (format *stderr* "~C[~D;~DH" #\escape y x) in repl.scm
+	    (notcurses_refresh nc)    ; needed in 1.7.1, not in 1.6.11
+	    (notcurses_cursor_enable nc 
+				     (max header-row (+ y ncp-row))
+				     (if (and wc (= y (+ watch-row 1)))
+					 (min (- watch-col 1) (+ x ncp-col))
+					 (+ x ncp-col))))
+	  (set! (top-level-let :run-let) (curlet))
+	  (when header
+	    (set! hc-cells (vector (nccell_make) (nccell_make) (nccell_make) (nccell_make) (nccell_make) (nccell_make)))
+	    (let ((newline-pos (char-position #\newline header)))
+	      (if newline-pos
+		  (let loop ((str (substring header (+ newline-pos 1)))
+			     (newlines (list (+ newline-pos 1) 0)))
+		    (let ((pos (char-position #\newline str)))
+		      (if pos
+			  (loop (substring str (+ pos 1))
+				(cons (+ (car newlines) pos 1) newlines))
+			  (let ((npos (reverse newlines))
+				(nlen (length newlines)))
+			    (set! hc (ncplane_new nc (+ 3 nlen) ncp-cols 0 0 (c-pointer 0)))
+			    (ncplane_cursor_move_yx hc 0 0)
+			    (nccells_double_box hc 0 0 (hc-cells 0) (hc-cells 1) (hc-cells 2) (hc-cells 3) (hc-cells 4) (hc-cells 5))
+			    (ncplane_box hc (hc-cells 0) (hc-cells 1) (hc-cells 2) (hc-cells 3) (hc-cells 4) (hc-cells 5) (+ 1 nlen) (- nc-cols 1) 0)
+			    (set! header-strings (make-vector nlen))
+			    (do ((i 0 (+ i 1))
+				 (hrow 1 (+ hrow 1))
+				 (posl npos (cdr posl)))
+				((= hrow nlen)
+				 (ncplane_putstr_yx hc hrow 1 (make-string (- nc-cols 5) #\space))
+				 (set! (header-strings i) (substring header (car posl)))
+				 (ncplane_putstr_yx hc hrow 2 (substring (header-strings i) 0 (min (length (header-strings i)) (- nc-cols 3))))
+				 (set! header-row (+ 3 nlen))
+				 (set! row header-row))
+			      (ncplane_putstr_yx hc hrow 1 (make-string (- nc-cols 5) #\space))
+			      (set! (header-strings i) (substring header (car posl) (cadr posl)))
+			      (ncplane_putstr_yx hc hrow 2 (substring (header-strings i) 0 (min (length (header-strings i)) (- nc-cols 3)))))))))
+		  (begin
+		    (set! hc (ncplane_new nc 3 ncp-cols 0 0 (c-pointer 0)))
+		    (ncplane_cursor_move_yx hc 0 0)
+		    (nccells_double_box hc 0 0 (hc-cells 0) (hc-cells 1) (hc-cells 2) (hc-cells 3) (hc-cells 4) (hc-cells 5))
+		    (ncplane_box hc (hc-cells 0) (hc-cells 1) (hc-cells 2) (hc-cells 3) (hc-cells 4) (hc-cells 5) 2 (- nc-cols 1) 0)
+		    (ncplane_putstr_yx hc 1 1 (make-string (- nc-cols 5) #\space))
+		    (set! header-strings (vector header))
+		    (ncplane_putstr_yx hc 1 2 (substring (header-strings 0) 0 (min (length header) (- nc-cols 3))))
+		    (set! header-row 3)
+		    (set! row header-row))))
+	    (set! header-cols nc-cols))
+
+	  (set! ncp (ncplane_new nc ncp-rows ncp-cols 0 0 (c-pointer 0)))
+	  (let ((eols (make-int-vector ncp-rows 0))
+		(bols (make-int-vector ncp-rows 0)))
+
+	    (ncplane_move_below ncp statp) ; statp always displayed with ncplanes sliding underneath conceptually
+
+	    ;; opaque plane
+	    (let ((c1 (nccell_make)))
+	      (set! (nccell_gcluster c1) (char->integer #\space))
+	      (set! (nccell_channels c1) 0)
+	      (set! (nccell_stylemask c1) 0)
+	      (ncplane_set_base_cell ncp c1)
+
+	      (unless header
+		(set! header-row 1) ; avoid first row -- output is meesed up by notcurses
+		(set! row 1)
+		(set! header-cols nc-cols))
+
+	      (notcurses_render nc))
+
+	    (let ((last-name ""))
+	      (set! (hook-functions *load-hook*)
+		    (cons (lambda (h)
+			    (unless (string=? (h 'name) last-name)
+			      (set! last-name (h 'name))
+			      (display-status (format #f "loading ~S" (h 'name)))))
+			  (hook-functions *load-hook*)))
+
+	      (set! (hook-functions *autoload-hook*)
+		    (cons (lambda (h)
+			    (set! last-name (h 'file))
+			    (display-status (format #f "autoloading ~S from ~S" (h 'name) (h 'file))))
+			  (hook-functions *autoload-hook*))))
+
+
+	    ;; -------- scrolling and resizing --------
+	    ;;
+	    ;; row and col are ncp-relative, its ncp-row|col are the location of its top left corner (0,0)
+	    ;;   in the terminal window.  ncp-rows|cols are its size.  nc-rows|cols is the terminal size.
+	    ;;   ncp-col = -5 means ncp is shifted left (to display the rightward portion),
+	    ;;   ncp-col = 5 means ncp is shifted right (moving its top-left corner to (5,0) in the terminal
+	    ;;   (using (row,col) throughout).  This won't happen in normal editing, but the user
+	    ;;   can easily move ncp: (ncplane_move_yx (ncp-let 'ncp) 5 0).
+	    ;; Here the assumption is we want val to be visible and the current row is already visible.
+	    ;;   The currently visible portion of ncp is from ((max 0 -ncp-row), (max 0 -ncp-col)) to (bottom right)
+	    ;;   ((nc-rows - ncp-row), (nc-cols - ncp-col)) (assuming we're not completely off screen).
+
+	    (define (set-ncp-row val)
+	      (when prev-pars
+		(set! prev-pars #f)
+		(notcurses_refresh nc))
+	      (set! ncp-row val))
+
+	    (define (set-ncp-col val)
+	      (when prev-pars
+		(set! prev-pars #f)
+		(notcurses_refresh nc))
+	      (set! ncp-col val))
+
+	    (define (resize-watcher)
+	      (when wc
+		(let ((old-watch-cols watch-cols)
+		      (old-watch-rows watch-rows))
+		  (set! watch-rows (+ (hash-table-entries watchers) 2))
+		  (set! watch-col (floor (* 0.618 nc-cols)))
+		  (set! watch-cols (- nc-cols watch-col))
+		  (ncplane_resize wc 0 0
+				  (min old-watch-rows watch-rows)
+				  (min old-watch-cols watch-cols)
+				  0 0
+				  watch-rows watch-cols)
+		  (ncplane_move_yx wc header-row watch-col)
+		  (ncplane_cursor_move_yx wc 0 0)
+		  (ncplane_box wc (wc-cells 0) (wc-cells 1) (wc-cells 2) (wc-cells 3) (wc-cells 4) (wc-cells 5) (- watch-rows 1) (- watch-cols 1) 0)
+		  (for-each (lambda (key-row&str)
+			      (ncplane_putstr_yx wc (cadr key-row&str) 1 (make-string (- watch-cols 2) #\space))
+			      (ncplane_putstr_yx wc (cadr key-row&str) 2 (cddr key-row&str)))
+			    watchers))))
+
+	    (define (nc-resize new-rows new-cols)
+	      (let ((old-nc-cols nc-cols))
+		(set! nc-cols new-cols)
+		(set! nc-rows new-rows)
+
+		;; resize status area
+		(set! statp-row (- nc-rows status-rows))
+		(ncplane_putstr_yx statp 1 (- old-nc-cols 1) " ")
+		(ncplane_resize statp 0 0 status-rows (min old-nc-cols nc-cols) 0 0 status-rows nc-cols)
+
+		;; resize header
+		(when hc
+		  (ncplane_resize hc 0 0 header-row (min old-nc-cols nc-cols) 0 0 header-row nc-cols)
+		  (ncplane_cursor_move_yx hc 0 0)
+		  (ncplane_box hc (hc-cells 0) (hc-cells 1) (hc-cells 2) (hc-cells 3) (hc-cells 4) (hc-cells 5) (+ (length header-strings) 1) (- nc-cols 1) 0)
+		  (do ((i 0 (+ i 1))
+		       (hrow 1 (+ hrow 1)))
+		      ((= i (length header-strings)))
+		    (ncplane_putstr_yx hc hrow (- old-nc-cols 1) " "))
+		  (set! header-cols nc-cols)
+		  ;; redisplay the header from the original strings
+
+		  (do ((i 0 (+ i 1))
+		       (hrow 1 (+ hrow 1)))
+		      ((= i (length header-strings)))
+		    (ncplane_putstr_yx hc hrow 1 (make-string (- nc-cols 5) #\space))
+		    (ncplane_putstr_yx hc hrow 2 (substring (header-strings i) 0 (min (length (header-strings i)) (- nc-cols 3))))))
+
+		(resize-watcher)
+
+		;; resize current pane (ncp)
+		(when (or (< ncp-rows nc-rows)
+			  (< ncp-cols nc-cols))
+		  (ncplane_resize ncp 0 0 ncp-rows ncp-cols 0 0 (max ncp-rows nc-rows) (max ncp-cols nc-cols))
+		  (when (> nc-rows ncp-rows)
+		    (set! bols (copy bols (make-int-vector nc-rows)))
+		    (set! eols (copy eols (make-int-vector nc-rows)))
+		    (set! ncp-rows nc-rows))
+		  (set! ncp-cols (max ncp-cols nc-cols)))))
+
+	    (define (visible? r c)
+	      (and (< r (- statp-row ncp-row))
+		   (>= r (- header-row ncp-row))
+		   (< c (- nc-cols ncp-col))
+		   (>= c (- ncp-col))))
+
+	    (define (set-row val)
+	      (set! row (max header-row val))
+	      (when (>= row ncp-rows)
+		(ncplane_resize ncp 0 0 ncp-rows ncp-cols 0 0 (+ row 40) ncp-cols)
+		(set! ncp-rows (+ row 40))
+		(set! bols (copy bols (make-int-vector ncp-rows)))
+		(set! eols (copy eols (make-int-vector ncp-rows))))
+	      (cond ((>= row (- statp-row ncp-row))             ; current row is outside (below) the terminal window
+		     (set-ncp-row (min 0 (- statp-row row 2)))
+		     (ncplane_move_yx ncp ncp-row ncp-col)
+		     (move-cursor row col))
+		    ((< row (- header-row ncp-row))             ; current row is outside (above) the terminal window
+		     (set-ncp-row (- header-row row))
+		     (ncplane_move_yx ncp ncp-row ncp-col))))
+
+	    (define (set-col val)
+	      (set! col val)
+	      (when (>= col ncp-cols)
+		(ncplane_resize ncp 0 0 ncp-rows ncp-cols 0 0 ncp-rows (+ col 10))
+		(set! ncp-cols (+ col 10)))
+	      (cond ((>= col (- nc-cols ncp-col))  ; current column is outside (to the right of) the terminal window
+		     (set-ncp-col (min 0 (- nc-cols col 2)))
+		     (ncplane_move_yx ncp ncp-row ncp-col))
+		    ((< col (- ncp-col))           ; current column is outside (to the left of) the terminal window, ncp-col < 0 means the ncp plane is shifted left
+		     (set-ncp-col (- col))
+		     (ncplane_move_yx ncp ncp-row ncp-col))
+		    ((and (= col (bols row))       ; special case: we're stuck against the prompt, but want move it into view
+			  (< ncp-col 0))
+		     (set-ncp-col 0)
+		     (ncplane_move_yx ncp ncp-row ncp-col))))
+
+
+	    (define (increment-row incr)
+	      (set! row (+ row incr))
+	      ;; (display-status (format #f "increment -> ~D~%" row))
+	      (when (>= row ncp-rows)
+		(ncplane_resize ncp 0 0 ncp-rows ncp-cols 0 0 (+ row 40) ncp-cols)
+		(set! ncp-rows (+ row 40))
+		(set! bols (copy bols (make-int-vector ncp-rows)))
+		(set! eols (copy eols (make-int-vector ncp-rows))))
+	      (when (>= row (- statp-row ncp-row))
+		(set-ncp-row (min 0 (- statp-row row 1))) ; this moves to bottom, (- row) to top??
+		(ncplane_move_yx ncp ncp-row ncp-col)
+		(move-cursor row col)))
+
+	    (define (increment-col incr)
+	      (set! col (+ col incr))
+	      (when (>= col ncp-cols)
+		(ncplane_resize ncp 0 0 ncp-rows ncp-cols 0 0 ncp-rows (+ col 10))
+		(set! ncp-cols (+ col 10)))
+	      (when (>= col (+ ncp-col nc-cols))
+		(set-ncp-col (min 0 (- nc-cols col 2)))
+		(ncplane_move_yx ncp ncp-row ncp-col)))
+
+
+	    (define (decrement-row incr)
+	      (set! row (max header-row (- row incr)))
+	      (when (<= row (- header-row ncp-row)) ; current row is outside (above) the terminal window
+		(set-ncp-row (- header-row row))
+		(ncplane_move_yx ncp ncp-row ncp-col)))
+
+	    (define (decrement-col incr)
+	      (set! col (- col incr))
+	      (when (<= col (- ncp-col)) ; current column is outside (to the left of) the terminal window
+		(set-ncp-col (- col))
+		(ncplane_move_yx ncp ncp-row ncp-col)))
+
+
+	    (define (nc-multiline-display str) ; increment-row below will make space if needed
+	      (let ((len (length str)))
+		(if (not (char-position #\newline str))
+		    (begin
+		      (nc-display row 0 str)
+		      (set! (eols row) len))
+		    (do ((start 0)
+			 (i 0 (+ i 1)))
+			((= i len)
+			 (nc-display row 0 (substring str start len))
+			 (set! (eols row) (- len start)))
+		      (if (char=? #\newline (str i))
+			  (begin
+			    (nc-display row 0 (substring str start i))
+			    (set! (eols row) (- i start))
+			    (increment-row 1)
+			    (set! ncp-max-row (max ncp-max-row row))
+			    (set! start (+ i 1))))))))
+
+
+	    ;; -------- lint (redirect output) --------
+	    ;; 
+	    ;; we load lint above, at which time it sets its *output-port* to *stderr* (the global built-in port), but
+	    ;;   when called in the repl, we have over-ridden *stderr* to place that output in the notcurses display,
+	    ;;   so we need to redirect lint's output by hand.
+	    (when with-lint
+	      (set! lint ; force top-level change
+		    (let ((old-lint lint))
+		      (lambda* (file (outp :unset) (report-input :unset))
+			(if (and (eq? outp :unset)
+				 (eq? report-input :unset))
+			    (nc-multiline-display
+			     (call-with-output-string
+			      (lambda (p)
+				(old-lint file p))))
+			    (old-lint file outp report-input))))))
+
+
+	    ;; -------- top-level-let --------
+	    (set! (top-level-let 'history)
+		  (lambda (filename)
+		    (call-with-output-file filename
+		      (lambda (p)
+			(let ((timestamp (with-let (sublet libc-let)
+					   (let ((timestr (make-string 128)))
+					     (strftime timestr 128 "%a %d-%b-%Y %H:%M:%S %Z"
+						       (localtime
+							(time.make (time (c-pointer 0 'time_t*)))))
+					     timestr))))
+			  (format p ";;; nrepl: ~A~%~%" timestamp))
+			(do ((i 0 (+ i 1)))
+			    ((= i ncp-max-row))
+			  (if (> (bols i) 0)
+			      (format p "~A ~A~%" (ncplane_contents ncp i 0 1 (bols i)) (ncplane_contents ncp i (bols i) 1 (eols i)))
+			      (format p "~A~%" (ncplane_contents ncp i 0 1 (eols i)))))))))
+
+
+	    ;; --------display --------
+	    (define (clear-line row)
+	      (ncplane_putstr_yx ncp row (bols row) (make-string (max 80 (- (eols row) (bols row))) #\space)))
+
+	    (define (nc-display r c str)
+	      (let ((len (length str)))
+		(when (>= (+ c len) ncp-cols)
+		  (ncplane_resize ncp 0 0 ncp-rows ncp-cols 0 0 ncp-rows (+ c len 10))
+		  (set! ncp-cols (+ c len 10)))
+		(ncplane_putstr_yx ncp r c str)
+		(if (= c 0) (set! (bols r) 0))))
+
+	    (define (reprompt y)
+	      (ncplane_cursor_move_yx ncp y 0)
+	      ;(clear-line y)
+	      (ncplane_putstr_yx ncp y 0 prompt)
+	      (notcurses_render nc)
+	      (let ((prompt-len (+ (length prompt) 1)))
+		(when (zero? (bols row)) ; might be in pre-existing section where we're just re-establishing an existing prompt
+		  (set! (bols row) prompt-len)
+		  (set! (eols row) prompt-len))
+		(set! col prompt-len)
+		(set-row y)
+		(notcurses_refresh nc)
+		(move-cursor y prompt-len)))
+
+	    (define (display-error ncp row info)
+	      (do ((i 0 (+ i 1)))
+		  ((= i 5))
+		(ncplane_putc_yx ncp row i (red-error i)))
+	      (notcurses_render nc) ; else cursor jumps back!
+	      (ncplane_putstr_yx ncp row 5 ": ")
+	      (set! (eols row) 7)
+	      (if (and (pair? info)
+		       (string? (car info)))
+		  (let ((err (apply format #f info)))
+		    (nc-display row 7 err)
+		    (set! (eols row) (+ (length err) 7)))
+		  (if (not (null? info))
+		      (let ((err (object->string info)))
+			(nc-display row 1 err)
+			(set! (eols row) (+ (length err) 7)))))
+	      row)
+
+	    ;; -------- watchers --------
+	    (define local-debug-info
+	      (let ((str ""))
+		(lambda (int)
+		  (if (= int (char->integer #\newline))
+		      (begin ; watch
+			(display-status str)
+
+			(if (string-position "set! to " str) ; it's a watcher
+			    (let* ((pos (char-position #\space str))
+				   (var (string->symbol (substring str 0 pos)))
+				   (var-data (watchers var))
+				   (var-row (and (pair? var-data) (car var-data)))
+				   (var-str (format #f "~A: ~A" var (substring str (+ pos 9)))))
+
+			      (unless wc
+				(set! wc-cells (vector (nccell_make) (nccell_make) (nccell_make) (nccell_make) (nccell_make) (nccell_make)))
+				(set! watch-row header-row)
+				(set! watch-col (floor (* 0.618 nc-cols))) ; ah the good old days
+				(set! watch-cols (- nc-cols watch-col))
+				(set! wc (ncplane_new nc watch-rows watch-cols watch-row watch-col (c-pointer 0)))
+				(nccells_double_box wc 0 0 (wc-cells 0) (wc-cells 1) (wc-cells 2) (wc-cells 3) (wc-cells 4) (wc-cells 5))
+				(ncplane_box wc (wc-cells 0) (wc-cells 1) (wc-cells 2) (wc-cells 3) (wc-cells 4) (wc-cells 5) (- watch-rows 1) (- watch-cols 1) 0)
+				(let ((c1 (nccell_make)))
+				  (set! (nccell_gcluster c1) (char->integer #\space))
+				  (set! (nccell_channels c1) 0)   ; opaque apparently
+				  (set! (nccell_stylemask c1) 0)
+				  (ncplane_set_base_cell wc c1)
+				  (notcurses_render nc)))
+
+			      (if var-row
+				  (set-cdr! var-data var-str)
+				  (begin
+				    (set! var-row (+ 1 (hash-table-entries watchers)))
+				    (set! var-data (cons var-row var-str))
+				    (hash-table-set! watchers var var-data)
+				    (resize-watcher)))
+
+			      (ncplane_putstr_yx wc var-row 1 (make-string (- watch-cols 2) #\space))
+			      (ncplane_putstr_yx wc var-row 2 (cdr var-data))
+			      (notcurses_render nc))
+
+			    (begin ; trace etc
+			      ;(nc-display row 0 str) ; this is break in debug.scm reporting the result "  -> 1" but we have already done that
+			      (set! (eols row) (length str))
+			      (increment-row 1)))
+			(set! str ""))
+		      (set! str (append str (string (integer->char int))))))))
+
+	    (define (local-remove-watcher var)
+	      (hash-table-set! watchers var #f)
+	      (if (and wc (zero? (hash-table-entries watchers)))
+		  (begin
+		    (ncplane_destroy wc)
+		    (set! wc #f))
+		  (let ((r 1))
+		    (resize-watcher)
+
+		    (for-each (lambda (var&row)
+				(hash-table-set! watchers (car var&row) (cons r (cddr var&row)))
+				(ncplane_putstr_yx wc r 1 (make-string (max 0 (- nc-cols watch-col 3)) #\space))
+				(ncplane_putstr_yx wc r 2 (cddr var&row))
+				(set! r (+ r 1)))
+			      watchers)
+
+		    ;(ncplane_putstr_yx wc r 2 (make-string (max 0 (max 0 (- nc-cols watch-col 3)) #\space)))
+		    )))
+
+
+	    ;; -------- match close paren --------
+	    (define (match-close-paren ncp row col indenting)
+	      ;; if row/col is just after #|), get start of current expr, scan until row/col
+	      ;;   return either matching row/col or #f if none
+	      (call-with-exit
+	       (lambda (return)
+		 (do ((r row (- r 1)))
+		     ((> (bols r) 0)
+
+		      (do ((cur-row r (+ cur-row 1))
+			   (oparens ()))
+			  ((> cur-row row)
+			   ;; ((top-level-let 'display-status) (format #f "~S ~S ~S" row cur-row oparens))
+			   (and (pair? oparens)
+				oparens))
+
+			(let* ((cur-line (ncplane_contents ncp cur-row (bols cur-row) 1 (- (eols cur-row) (bols cur-row))))
+			       (len (if (and (= cur-row row)
+					     (not indenting))
+					(min (- col (bols row) 1) (length cur-line))
+					(length cur-line))))
+
+			  (do ((i 0 (+ i 1)))
+			      ((>= i len))
+			    (case (cur-line i)
+			      ((#\()
+			       (set! oparens (cons (list cur-row (+ i (bols cur-row)) 0 #f) oparens)))
+
+			      ((#\))
+			       (when (pair? oparens)
+				 (set! oparens (cdr oparens))
+				 (when (and indenting
+					    (pair? oparens))
+				   (let ((top (cddar oparens)))
+				     (set-car! top (+ (car top) 1))))))
+
+			      ((#\;)
+			       (set! i (+ len 1)))
+
+			      ((#\")
+			       (do ((found-close-quote #f))
+				   (found-close-quote) ; need to look possibly across several rows
+				 (do ((k (+ i 1) (+ k 1)))
+				     ((or (>= k len)
+					  (and (char=? (cur-line k) #\")
+					       (not (char=? (cur-line (- k 1)) #\\))))
+				      ;; ((top-level-let 'display-status) (format #f "~S ~S ~S ~S" cur-row row k len))
+				      (if (>= k len)  ; no close quotes by eol
+					  (if (= cur-row row)
+					      (return #f)
+					      (begin
+						(set! cur-row (+ cur-row 1))
+						(set! i 0)
+						(set! cur-line (ncplane_contents ncp cur-row (bols cur-row) 1 (- (eols cur-row) (bols cur-row))))
+						(set! len (if (and (= cur-row row)
+								   (not indenting))
+							      (min (- col (bols row) 1) (length cur-line))
+							      (length cur-line)))))
+					  (begin
+					    (set! found-close-quote #t)
+					    (set! i k)))))))
+
+			      ((#\#)
+			       (when (and (< i (- len 1))
+					  (char=? (cur-line (+ i 1)) #\|))
+				 (do ((found-close-comment #f))
+				     (found-close-comment)
+				   (do ((k (+ i 1) (+ k 1)))
+				       ((or (>= k (- len 1))
+					    (and (char=? (cur-line k) #\|)
+						 (char=? (cur-line (+ k 1)) #\#)))
+					(if (>= k len)
+					    (if (= cur-row row)
+						(return #f)
+						(begin
+						  (set! cur-row (+ cur-row 1))
+						  (set! i -1)
+						  (set! cur-line (ncplane_contents ncp cur-row (bols cur-row) 1 (- (eols cur-row) (bols cur-row))))
+						  (set! len (if (and (= cur-row row)
+								     (not indenting))
+								(min (- col (bols row) 1) (length cur-line))
+								(length cur-line)))))
+					    (begin
+					      (set! found-close-comment #t)
+					      (set! i (+ k 1)))))))))
+
+			      ((#\space #\newline #\tab #\return))
+
+			      (else
+			       (when (and indenting
+					  (pair? oparens))
+				 (let ((top (cdddar oparens))
+				       (c (+ i (bols cur-row))))
+				   (if (pair? (car top))
+				       (set-car! (cdar top) c)
+				       (set! (car top) (list c c)))))))))))))))
+
+
+	    ;; -------- indentation --------
+	    (define indent
+	      (let ((white-space (string #\newline #\space #\return #\tab #\linefeed)))
+		(lambda (ncp row col)
+		  (if (not (zero? (bols row)))
+		      col
+		      (let ((pars (match-close-paren ncp (- row 1) (eols (- row 1)) #t)))
+			(if (not pars)
+			    (set! (eols row) 0)
+			    (let ((unmatched-par (car pars)))
+			      ;;     -> (row col-of-( visits #f-or-(name-start name-end)
+			      ;;  row/col args = cursor pos
+			      (let ((open-row (car unmatched-par))
+				    (open-col (cadr unmatched-par))
+				    (visits (caddr unmatched-par))       ; how many complete lists follow this (
+				    (name-bounds (cadddr unmatched-par)) ; bounds of non-white-space after (
+				    (trailer (ncplane_contents ncp row 0 1 (eols row)))
+				    (slice 0))
+
+				(let ((tlen (length trailer)))
+				  (when (positive? tlen)
+				    (do ((i 0 (+ i 1)))
+					((or (= i tlen)
+					     (not (char-whitespace? (trailer i))))
+					 (set! slice i)
+					 (set! trailer (substring trailer i))))))
+
+				(if (not (pair? name-bounds))
+				    (let ((incr 2))
+				      (let ((uname (and (pair? (cdr pars))
+							(let* ((upar (cadr pars))
+							       (uopen-row (car upar))
+							       (uname-bounds (cadddr upar))
+							       (uname+args (ncplane_contents ncp
+											     uopen-row (car uname-bounds)
+											     1 (+ (- (cadr uname-bounds) (car uname-bounds)) 1)))
+							       (uwpos (char-position white-space uname+args)))
+							  (if (integer? uwpos)
+							      (substring uname+args 0 uwpos)
+							      uname+args)))))
+					(if (member uname '("do" "let" "let*" "letrec" "letrec*" "let-temporarily") string=?)
+					    (set! incr 1)))
+
+				      ;; nothing after the ( on its row, might be moving back, so we need to erase the current line
+				      (clear-line row)
+				      (nc-display row 0 (format #f "~NC~A" (+ open-col incr) #\space trailer))
+				      (set! (eols row) (+ open-col incr (length trailer)))
+				      (min (+ open-col incr (- col slice)) (eols row))) ; keep cursor in its relative-to-trailer position if possible
+
+				    (let* ((name+args (ncplane_contents ncp open-row (car name-bounds) 1 (+ (- (cadr name-bounds) (car name-bounds)) 1)))
+					   (wpos (char-position white-space name+args))
+					   (name (if (integer? wpos)
+						     (substring name+args 0 wpos)
+						     name+args))
+					   (increment
+					    (cond ((member name '("cond" "when" "unless" "lambda" "lambda*" "begin" "case" "with-let"
+								  "let" "let*" "letrec" "letrec*" "let-temporarily"
+								  "call-with-exit" "call/cc" "call-with-current-continuation"
+								  "define" "define*" "define-macro" "catch" "sublet")
+							   string=?)
+						   2)
+
+						  ((string=? name "do")
+						   (if (= visits 1) 4 2))
+
+						  ((member name '("call-with-input-string" "call-with-input-file") string=?)
+						   (if (= open-row (- row 1)) 4 2))
+
+						  (else (+ (length name) 2)))))
+
+				      ;; might be moving back, so we need to erase the current line
+				      (clear-line row)
+				      (nc-display row 0 (format #f "~NC~A" (+ increment open-col) #\space trailer))
+				      (set! (eols row) (+ open-col increment (length trailer)))
+				      (max 0 (min (+ open-col increment (- col slice)) (eols row))))
+				    ;; keep cursor in its relative-to-trailer position if possible, but squeeze slice (space) if not enough room
+				    )))))))))
+
+	    ;;-------- tab --------
+	    (define (tab c)
+	      (if (< col (eols row))
+		  (set-col (indent ncp row col))
+
+		  (let ((start (bols row))
+			(end (eols row)))
+		    (if (= end start)
+			(begin
+			  (nc-display row end "    ")
+			  (set! (eols row) (+ end 4))
+			  (increment-col 4))
+
+			(let ((cur-line (ncplane_contents ncp row (bols row) 1 (- (eols row) (bols row)))))
+
+			  (if (not (let loop ((i 0) (len (length cur-line)))
+				     (and (< i len)
+					  (or (not (char-whitespace? (cur-line i)))
+					      (loop (+ i 1) len)))))
+			      (set-col (indent ncp row col))
+			      (let ((loc (do ((i (- (length cur-line) 1) (- i 1)))
+					     ((or (< i 0)
+						  (char-whitespace? (cur-line i))
+						  (memv (cur-line i) '(#\( #\' #\" #\))))
+					      i))))
+
+				(if (= (+ loc 1) (eols row))
+				    (set-col (indent ncp row col))
+				    (let ((completion (if (< loc 0) ; match whole cur-line
+							  (symbol-completion cur-line)
+							  ((if (char=? (cur-line loc) #\") filename-completion symbol-completion)
+							   (substring cur-line (+ loc 1))))))
+				      (if (not completion)
+					  (set-col (min (indent ncp row col) (eols row)))
+					  (unless (string=? completion cur-line)
+
+					    (when (>= loc 0)
+					      (set! completion (string-append (substring cur-line 0 (+ loc 1)) completion))
+					      (if (char=? (cur-line loc) #\")
+						  (set! completion (string-append completion "\""))))
+
+					    (nc-display row (bols row) completion)
+					    (set-col (+ (bols row) (length completion)))
+					    (set! (eols row) col))))))))))))
+
+
+	    ;; -------- run ---------
+	    (reprompt header-row)
+
+	    (catch #t
+	      (lambda ()
+		(let ((ni (ncinput_make))
+		      (mouse-col #f)
+		      (mouse-row #f)
+		      (repl-done #f)
+		      (selection "")
+                      (previously-selected #f)
+                      (just-selected #f)
+		      (control-key (ash 1 33))
+                      (meta-key (ash 1 34)))    ; notcurses get returns 32 bits
+
+		  (set! (top-level-let 'ncp-let) (curlet))
+		  (set! display-debug-info local-debug-info)
+		  (set! remove-watcher local-remove-watcher)
+
+		  ;; -------- enter --------
+		  (define enter                      ; either eval/print or insert newline
+		    (let ()
+		      (define stdin-wrapper (open-input-function ; current-input-port for scheme input in repl
+					     (lambda (choice)
+					       (case choice
+						 ((read char-ready? peek-char) "?")
+						 ((read-char) (integer->char (notcurses_getc nc (c-pointer 0) (c-pointer 0) ni)))
+						 ((read-line)
+						  (let loop ((str ""))
+						    (let ((c (notcurses_getc nc (c-pointer 0) (c-pointer 0) ni)))
+						      (if (or (= c (char->integer #\newline))
+							      (> c 255))
+							  str
+							  (loop (append str (string (integer->char c))))))))))))
+
+		      ;; -------- evaluation ---------
+		      (define (badexpr h)            ; *missing-close-paren-hook* function for Enter command
+			(let ((ow (owlet)))
+			  (if (and (ow 'error-file)
+				   (not (equal? (ow 'error-file) "nrepl.scm")))
+			      (error 'syntax-error "missing close paren in ~S" (ow 'error-file))
+			      (set! (h 'result) 'string-read-error))))
+
+		      (define (shell? h)             ; *unbound-variable-hook* function, also for Enter
+			;; examine cur-line -- only call system if the unbound variable matches the first non-whitespace chars
+			;;   of cur-line, and command -v name returns 0 (indicating the shell thinks it is an executable command)
+			(let ((cur-line (ncplane_contents ncp (- row 1) (bols (- row 1)) 1 col)))
+			  ;; at this point (eols row) has not been set, so use col?
+			  (do ((i 0 (+ i 1)))
+			      ((or (= i (length cur-line))
+				   (not (char-whitespace? (cur-line i))))
+			       (let ((var-name (symbol->string (h 'variable))))
+				 (when (and (>= (- (length cur-line) i) (length var-name)) ; var-name might be unrelated to cur-line
+					    (string=? var-name (substring cur-line i (+ i (length var-name))))
+					    (zero? (system (string-append "command -v " var-name " >/dev/null"))))
+				   (set! (h 'result)
+					 (and (procedure? ((rootlet) 'system))
+					      (((rootlet) 'system) cur-line #t)))))))))
+
+		      (define new-eval
+			(let ((+documentation+ "this is the repl's eval replacement; its default is to use the repl's top-level-let.")
+			      (+signature+ '(values #t let?)))
+			  (lambda (form . rest) ; use lambda (not lambda*) so we can handle forms like :key
+			    (let ((e (if (pair? rest)
+					 (car rest)
+					 (*nrepl* 'top-level-let))))
+			      (let-temporarily (((hook-functions *unbound-variable-hook*) (list shell?)) ; so pwd et al will work
+						((*s7* 'history-enabled) #t))
+				(eval form e))))))
+
+		      (define (current-expression ncp row)
+			(if (> (bols row) 0)
+			    (ncplane_contents ncp row (bols row) 1 (- (eols row) (bols row)))
+			    (do ((i (- row 1) (- i 1)))
+				((not (zero? (bols i)))
+				 (let ((expr (ncplane_contents ncp i (bols i) 1 (- (eols i) (bols i)))))
+				   (do ((nrow (+ i 1) (+ nrow 1)))
+				       ((> nrow row)
+					expr)
+				     (set! expr (append expr "\n" ; need newline to terminate comments
+							(ncplane_contents ncp nrow (bols nrow) 1 (- (eols nrow) (bols nrow)))))))))))
+		      (lambda (c)
+			(let ((cur-line (current-expression ncp row)))
+			  (increment-row 1)
+			  (set! ncp-max-row (max ncp-max-row row))
+
+			  (if (> (eols row) 0)
+			      (clear-line row))
+
+			  (call-with-exit
+			   (lambda (return)
+			     (do ((len (length cur-line))
+				  (i 0 (+ i 1)))               ; check for just whitespace
+				 ((or (= i len)
+				      (not (char-whitespace? (cur-line i))))
+				  (when (= i len)
+				    (set! (eols row) col)
+				    (return))))
+
+			     (catch #t
+			       (lambda ()
+
+				 (catch 'string-read-error ; this matches (throw #t 5) -- is this correct? *missing-close-paren-hook* returns 'string-read-error
+				   (lambda ()
+
+				     (let-temporarily (((hook-functions *missing-close-paren-hook*) (list badexpr))
+						       ((hook-functions *read-error-hook*) ()))    ; lint sets this and messes up our error reporting
+
+				       ;; catch and report reader errors as well as eval troubles
+				       (let-temporarily ((*stderr* (open-output-string))           ; capture *stderr* output
+							 (*stdout* (open-output-string))
+							 ((current-output-port) (open-output-string))
+							 ((current-error-port) (open-output-string))
+							 ((*s7* 'undefined-constant-warnings) #t)) ; ??? what about case*?
+
+					 (let ((form (with-input-from-string cur-line #_read))
+					       (val #f))
+					   (let-temporarily (((current-input-port) stdin-wrapper)  ; for scheme side input (read-char etc)
+							     ((hook-functions *ncp-move-hook*)     ; scheme code calls ncplane_move_yx??
+							      (list (lambda (h)
+								      (when (eq? (h 'plane) ncp)
+									(set! ncp-row (h 'y))
+									(set! ncp-col (h 'x)))))))
+					     ;(set-sigint-handler)                                 ; catch C-C to interrupt computation -- this no longer works in notcurses
+					     (let ((str (with-output-to-string                     ; for scheme side output
+							  (lambda ()
+							    (set! val (list (new-eval form envir))))))) ; list, not lambda -- confuses trace!
+					       ;(unset-sigint-handler nc)                           ; catch C-C to exit cleanly
+
+					       (for-each
+						(lambda (s)
+						  (when (> (length s) 0)
+						    (set-col 0)
+						    (nc-multiline-display s)
+						    (increment-row 1)))
+						(list str
+						      (get-output-string *stderr*)
+						      (get-output-string *stdout*)
+						      (get-output-string (current-error-port))
+						      (get-output-string (current-output-port))))))
+
+					   (set! val (if (or (null? val)   ; try to trap (values) -> #<unspecified>
+							     (and (unspecified? (car val))
+								  (null? (cdr val))))
+							 #<unspecified>
+							 (if (pair? (cdr val))  ; val is a list, it must have caught multiple values if cdr is a pair
+							     (cons 'values val)
+							     (car val))))
+
+					   (nc-multiline-display (object->string val))))))
+
+				   (lambda (type info)
+				     ;(unset-sigint-handler nc)
+				     (if (eq? type 'string-read-error)
+					 (begin
+					   ;; missing close paren, newline already added, spaces here are not optional!
+					   (nc-display row 0 (make-string col #\space))
+					   (set! (eols row) col)
+					   (return))
+					 (apply throw type info)))))   ; re-raise error
+
+			       (lambda (type info)
+				 ;(unset-sigint-handler nc)
+				 (if (and (eq? type 'read-error)       ; maybe we hit <enter> in a block comment
+					  (equal? info '("unexpected end of input while reading #|")))
+				     (begin
+				       (nc-display row 0 (make-string col #\space))
+				       (set! (eols row) col)
+				       (return)))
+				 (display-error ncp row info)))
+
+			     (increment-row 1)
+			     (set! ncp-max-row (max ncp-max-row row))
+			     (reprompt row)))))))
+
+
+		  ;; -------- keymap --------
+		  (define (normal-char c)
+		    (let ((trailing (and (> (eols row) col)
+					 (ncplane_contents ncp row col 1 (- (eols row) col -1)))))
+		      (nc-display row col (string (integer->char c)))
+		      (if (and trailing (> (length trailing) 0))
+			  (nc-display row (+ col 1) trailing)))
+
+		    (if (or (char=? (integer->char c) #\space)
+			    (= col (bols row)))         ; maybe (memv (integer->char c) '(#\space #\())
+			(notcurses_refresh nc))
+		    (increment-col 1) ; might be midline
+		    (set! (eols row) (+ (eols row) 1))) ; in any case we've added a character
+
+		  (do ((i 0 (+ i 1)))
+		      ((= i 256))
+		    (set! (keymap i) normal-char))
+
+                  (define (prepend-to-selection new-text)
+                    (unless (zero? (length new-text))
+                      (set! selection (if previously-selected (append new-text selection)
+					  new-text))
+                      (set! just-selected #t)))
+                  (define (append-to-selection new-text)
+                    (unless (zero? (length new-text))
+                      (set! selection (if previously-selected (append selection new-text)
+					  new-text))
+                      (set! just-selected #t)))
+                  (define (char-separator? c)
+                    (char-position c " ()`',\"#"))
+                  (define (word-back-x) ;; some of these are courtesy of Elijah Stone
+                    (let loop ((col (max (bols row) (- col 1))))
+                      (if (= col (bols row))
+			  col
+			  (if (char-separator? (ncplane_contents ncp row col 1 1))
+			      (loop (- col 1))
+			      (let loop ((col col))
+				(if (or (= col (bols row))
+					(char-separator? (ncplane_contents ncp row (- col 1) 1 1)))
+				    col
+				    (loop (- col 1))))))))
+                  (define (word-forward-x)
+                    (let loop ((col (min (eols row) (+ col 1))))
+                      (if (= col (eols row))
+			  col
+			  (if (char-separator? (ncplane_contents ncp row col 1 1))
+			      (loop (+ col 1))
+			      (let loop ((col col))
+				(if (or (= col (eols row))
+					(char-separator? (ncplane_contents ncp row col 1 1)))
+				    col
+				    (loop (+ col 1))))))))
+		  
+                  (set! (keymap (+ meta-key (char->integer #\B)))
+			(set! (keymap (+ meta-key (char->integer #\b)))
+			      (lambda (c)
+				(set! col (word-back-x)))))
+		  
+                  (set! (keymap (+ meta-key (char->integer #\C)))
+			(set! (keymap (+ meta-key (char->integer #\c)))
+			      (lambda (c)
+				(do ((len (- (eols row) col))
+				     (cur-line (ncplane_contents ncp row col 1 (- (eols row) col)))
+				     (i 0 (+ i 1)))
+				    ((or (= i len)
+					 (char-alphabetic? (cur-line i)))
+				     (when (< i len)
+				       (set! (cur-line i) (char-upcase (cur-line i)))
+				       (nc-display row col cur-line)
+				       (notcurses_refresh nc)
+				       (do ((k (+ i 1) (+ k 1)))
+					   ((or (>= k len)
+						(not (or (char-alphabetic? (cur-line k))
+							 (char-numeric? (cur-line k)))))
+					    (set! col (min (eols row) (+ col k)))))))))))
+		  
+                  (set! (keymap (+ meta-key (char->integer #\D)))
+			(set! (keymap (+ meta-key (char->integer #\d)))
+			      (lambda (c)
+				(let ((newcol (word-forward-x)))
+				  (append-to-selection (ncplane_contents ncp row col 1 (- newcol col)))
+				  (nc-display row col (ncplane_contents ncp row newcol 1 (- (eols row) newcol)))
+				  (nc-display row (- (eols row) (- newcol col)) (make-string (- newcol col) #\space))
+				  (set! (eols row) (- (eols row) (- newcol col)))))))
+		  
+                  (set! (keymap (+ meta-key (char->integer #\F)))
+			(set! (keymap (+ meta-key (char->integer #\f)))
+			      (lambda (c)
+				(set! col (word-forward-x)))))
+		  
+                  (set! (keymap (+ meta-key (char->integer #\L)))
+			(set! (keymap (+ meta-key (char->integer #\l)))
+			      (lambda (c)
+				(do ((len (- (eols row) col))
+				     (cur-line (ncplane_contents ncp row col 1 (- (eols row) col)))
+				     (i 0 (+ i 1)))
+				    ((or (= i len)
+					 (char-alphabetic? (cur-line i)))
+				     (when (< i len)
+				       (do ((k i (+ k 1)))
+					   ((or (= k len)
+						(not (char-alphabetic? (cur-line k))))
+					    (nc-display row col cur-line)
+					    (notcurses_refresh nc)
+					    (set! col (+ col k)))
+					 (set! (cur-line k) (char-downcase (cur-line k))))))))))
+		  
+                  (set! (keymap (+ meta-key (char->integer #\U)))
+			(set! (keymap (+ meta-key (char->integer #\u)))
+			      (lambda (c)
+				(do ((len (- (eols row) col))
+				     (cur-line (ncplane_contents ncp row col 1 (- (eols row) col)))
+				     (i 0 (+ i 1)))
+				    ((or (= i len)
+					 (char-alphabetic? (cur-line i)))
+				     (when (< i len)
+				       (do ((k i (+ k 1)))
+					   ((or (= k len)
+						(not (char-alphabetic? (cur-line k))))
+					    (nc-display row col cur-line)
+					    (notcurses_refresh nc)
+					    (set! col (+ col k)))
+					 (set! (cur-line k) (char-upcase (cur-line k))))))))))
+		  
+                  (set! (keymap (+ meta-key (char->integer #\<)))
+			(lambda (c)
+			  (set-row 0)
+			  (set-col (bols 0))))
+		  
+                  (set! (keymap (+ meta-key (char->integer #\>)))
+			(lambda (c)
+			  (set-row ncp-max-row)
+			  (set-col (bols ncp-max-row))))
+
+		  (set! (keymap (char->integer #\tab)) tab)
+
+		  (set! (keymap (+ control-key (char->integer #\A)))
+			(lambda (c)
+			  (unless (>= ncp-col 0)
+			    (set-ncp-col 0)
+			    (ncplane_move_yx ncp ncp-row ncp-col))
+			  (set-col (bols row))))
+
+		  (set! (keymap (+ control-key (char->integer #\B)))
+			(lambda (c)
+			  (if (and (= col (bols row))
+				   (> row 0))
+			      (let ((old-row row))
+				(decrement-row 1)
+				(if (< row old-row)
+				    (set-col (eols row))))
+			      (set-col (max (bols row) (- col 1))))))
+
+		  (set! (keymap (+ control-key (char->integer #\C)))
+			(lambda (c)
+			  (set! repl-done #t)))
+
+		  (set! (keymap (+ control-key (char->integer #\D)))
+			(lambda (c)
+			  (when (and (< col (eols row)) ; should this delete the newline?
+				     (> (eols row) (bols row)))
+			    (let ((trailing (ncplane_contents ncp row (+ col 1) 1 (- (eols row) col -1))))
+			      (nc-display row col trailing)
+			      (nc-display row (+ col (length trailing)) " "))
+			    (set! (eols row) (- (eols row) 1)))))
+
+		  (set! (keymap (+ control-key (char->integer #\E)))
+			(lambda (c)
+			  (set-col (eols row))))
+
+		  (set! (keymap (+ control-key (char->integer #\F)))
+			(lambda (c)
+			  (if (and (= col (eols row))
+				   (< row ncp-max-row))
+			      (begin
+				(increment-row 1)
+				(set! ncp-max-row (max ncp-max-row row))
+				(set-col (bols row)))
+			      (set-col (min (eols row) (+ col 1))))))
+
+		  (set! (keymap (+ control-key (char->integer #\G))) ; get a prompt
+			(lambda (c)
+			  (increment-row 1)
+			  (set-ncp-col 0)
+			  (ncplane_move_yx ncp ncp-row ncp-col)
+			  (reprompt row)))
+
+                  (set! (keymap (+ control-key (char->integer #\K)))
+			(lambda (c)
+			  (append-to-selection (ncplane_contents ncp row col 1 (- (eols row) col)))
+			  (nc-display row col (make-string (- (eols row) col) #\space))
+			  (set! (eols row) col)))
+
+		  (set! (keymap (+ control-key (char->integer #\L))) ; not the same as emacs's C-l (moves current row to top)
+			(lambda (c)
+			  (unless (= row (- ncp-row))
+			    (set-ncp-row (- row))
+			    (ncplane_move_yx ncp ncp-row ncp-col))))
+
+		  (set! (keymap (+ control-key (char->integer #\N)))
+			(lambda (c)
+			  (when (< row ncp-max-row)
+			    (increment-row 1)
+			    (set-col (min (max col (bols row)) (eols row))))))
+
+		  (set! (keymap (+ control-key (char->integer #\O)))
+			(lambda (c)
+			  (let ((trailer (ncplane_contents ncp row col 1 (- (eols row) col)))
+				(old-row row))
+			    (when (> ncp-max-row row)
+
+			      (when (>= (+ ncp-max-row 1) ncp-rows)
+				(ncplane_resize ncp 0 0 ncp-rows ncp-cols 0 0 (+ ncp-rows 40) ncp-cols)
+				(set! ncp-rows (+ ncp-rows 40))
+				(set! bols (copy bols (make-int-vector ncp-rows)))
+				(set! eols (copy eols (make-int-vector ncp-rows))))
+
+			      (do ((i (+ ncp-max-row 1) (- i 1)))
+				  ((= i (+ row 1))
+				   (set! ncp-max-row (+ ncp-max-row 1)))
+				(let ((contents (ncplane_contents ncp (- i 1) 0 1 (eols (- i 1)))))
+				  (clear-line i)
+				  (nc-display i 0 contents)) ; should this be indented?
+				(set! (eols i) (eols (- i 1)))
+				(set! (bols i) (bols (- i 1)))))
+
+			    (nc-display row col (make-string (- (eols row) col) #\space))
+			    (set! (eols row) col)
+			    (increment-row 1)
+			    (set! ncp-max-row (max ncp-max-row row))
+			    (clear-line row)
+			    (nc-display row 0 trailer)
+			    (set! (bols row) 0)
+			    (set! (eols row) (length trailer))
+			    (set-row old-row))))
+
+		  (set! (keymap (+ control-key (char->integer #\P)))
+			(lambda (c)
+			  (set-row (- row 1))
+			  (set-col (min (max col (bols row)) (eols row)))))
+
+		  (set! (keymap (+ control-key (char->integer #\Q)))
+			(lambda (c)
+			  (set! repl-done #t)
+			  (set! (top-level-let 'history) old-history))) ; fix up the ncp pointer I think
+
+		  (set! (keymap (+ control-key (char->integer #\T)))
+			(lambda (c)
+			  (when (> col (bols row))
+			    (let ((cur (if (>= col (eols row))
+					   (- col 1)
+					   col))
+				  (cur-line (ncplane_contents ncp row 0 1 (eols row))))
+			      (let ((tmp-c (cur-line (- cur 1))))
+				(set! (cur-line (- cur 1)) (cur-line cur))
+				(set! (cur-line cur) tmp-c))
+			      (nc-display row (bols row) (substring cur-line (bols row))) ; if c=0 nc-display sets (bols row) to 0
+			      (if (< cur (eols row))
+				  (set-col (+ cur 1)))))))
+
+                  (set! (keymap (+ control-key (char->integer #\U)))
+			(lambda (c)
+			  (prepend-to-selection (ncplane_contents ncp row (bols row) 1 (- col (bols row))))
+			  (nc-display row (bols row) (ncplane_contents ncp row col 1 (- (eols row) col)))
+			  (nc-display row (- (eols row) (- col (bols row))) (make-string (- col (bols row)) #\space))
+			  (set! (eols row) (- (eols row) (- col (bols row))))
+			  (set! col (bols row))))
+		  
+                  (set! (keymap (+ control-key (char->integer #\W)))
+			(lambda (c)
+			  (let ((newcol (word-back-x)))
+			    (prepend-to-selection (ncplane_contents ncp row newcol 1 (- col newcol)))
+			    (nc-display row newcol (ncplane_contents ncp row col 1 (- (eols row) col)))
+			    (nc-display row (- (eols row) (- col newcol)) (make-string (- col newcol) #\space))
+			    (set! (eols row) (- (eols row) (- col newcol)))
+			    (set! col newcol))))
+		  
+		  (set! (keymap (+ control-key (char->integer #\Y)))
+			(lambda (c)
+			  (when (string? selection)
+			    (let ((trailing (and (> (eols row) col)
+						 (ncplane_contents ncp row col 1 (- (eols row) col -1)))))
+			      (nc-display row col selection)
+			      (if (char=? #\space (selection (- (length selection) 1)))
+				  (notcurses_refresh nc))
+			      (if (and trailing
+				       (> (length trailing) 0))
+				  (nc-display row (+ col (length selection)) trailing)))
+			    (set! (eols row) (+ (eols row) (length selection)))
+			    (set-col (+ col (length selection))))))
+
+		  (set! (keymap NCKEY_LEFT)       ; arrow keys
+			(lambda (c)
+			  (set-col (max (bols row) (- col 1)))))
+
+		  (set! (keymap NCKEY_RIGHT)
+			(lambda (c)
+			  (set-col (min (eols row) (+ col 1)))))
+
+		  (set! (keymap NCKEY_UP)
+			(lambda (c)
+			  (set-row (- row 1))
+			  (set-col (min (max col (bols row)) (eols row)))))
+
+		  (set! (keymap NCKEY_DOWN)
+			(lambda (c)
+			  (when (< row ncp-max-row)
+			    (increment-row 1)
+			    (set-col (min (max col (bols row)) (eols row))))))
+
+		  (set! (keymap NCKEY_HOME)
+			(lambda (c)
+			  (set-row 0)
+			  (set-col (bols 0))))
+
+		  (set! (keymap NCKEY_END)
+			(lambda (c)
+			  (set-row ncp-max-row)
+			  (set-col (bols ncp-max-row))))
+
+		  (set! (keymap NCKEY_PGUP)
+			(lambda (c)
+			  (set-row (max 0 (- row (- nc-rows status-rows))))))
+
+		  (set! (keymap NCKEY_PGDOWN)
+			(lambda (c)
+			  (set-row (max 0 (min ncp-max-row (+ row (- nc-rows status-rows)))))))
+
+		  (set! (keymap NCKEY_RESIZE)      ; terminal window resized (not a key event)
+			(lambda (c)
+			  (apply nc-resize (ncplane_dim_yx (notcurses_stdplane nc)))))
+
+		  (set! (keymap NCKEY_BACKSPACE)   ; backspace
+			(lambda (c)
+			  (when (> col (bols row))
+			    (let ((trailing (and (> (eols row) col)
+						 (ncplane_contents ncp row col 1 (- (eols row) col -1)))))
+			      (if trailing
+				  (begin
+				    (nc-display row (- col 1) trailing)
+				    (nc-display row (+ col (- (length trailing) 1)) " "))
+				  (nc-display row (- col 1) " "))
+
+			      (set! (eols row) (- (eols row) 1))
+			      (decrement-col 1)))))
+		  ;; check this: if we backspaced past ncp-col, scroll-left
+
+		  (set! (keymap NCKEY_BUTTON1) ; mouse click, doesn't work in rxvt apparently, right button = button2? click scroll??
+			(lambda (c)
+			  ;; ncinput gives row|col in current view, so we need to map that to the ncplane row|col
+			  ;(display-status (format #f "nc-rows: ~S, ncp-row: ~S, input: ~S" nc-rows ncp-row (ncinput_y ni)))
+			  (if (= (ncinput_evtype ni) NCTYPE_RELEASE)
+			      (begin
+				(when (and (number? mouse-col)
+					   (not (= col mouse-col)))
+				  (set! selection (ncplane_contents ncp mouse-row (min col mouse-col) 1 (abs (- col mouse-col)))))
+				(set! mouse-col #f))
+			      (begin
+				(set-row (min ncp-max-row (- (ncinput_y ni) ncp-row)))
+				(set-col (max (min (eols row) (ncinput_x ni)) (bols row)))
+				(unless mouse-col
+				  (set! mouse-col col)
+				  (set! mouse-row row))))))
+
+		  (set! (keymap NCKEY_ENTER) enter)
+
+
+		  ;; -------- read/eval/print loop --------
+
+		  (define (recover-previous-layout)
+		    (set! display-debug-info local-debug-info)
+		    (set! recursor #f)
+		    (notcurses_render nc)
+		    (move-cursor row col)
+
+		    ;; perhaps a resize happened while we were away
+		    (when (and hc
+			       (not (= header-cols nc-cols)))
+		      (ncplane_resize hc 0 0 header-row (min old-nc-cols nc-cols) 0 0 header-row nc-cols)
+		      (ncplane_cursor_move_yx hc 0 0)
+		      (ncplane_box hc (hc-cells 0) (hc-cells 1) (hc-cells 2) (hc-cells 3) (hc-cells 4) (hc-cells 5) (- header-row 1) (- nc-cols 1) 0)
+		      (do ((i 1 (+ i 1)))
+			  ((= i (- header-row 1)))
+			(ncplane_putstr_yx hc i (- old-nc-cols 1) " "))
+		      (set! header-cols nc-cols))
+
+		    (when (or (< ncp-rows nc-rows)
+			      (< ncp-cols nc-cols))
+		      (ncplane_resize ncp 0 0 ncp-rows ncp-cols 0 0 (max ncp-rows nc-rows) (max ncp-cols nc-cols))
+		      (when (> nc-rows ncp-rows)
+			(set! bols (copy bols (make-int-vector nc-rows)))
+			(set! eols (copy eols (make-int-vector nc-rows)))
+			(set! ncp-rows nc-rows))
+		      (set! ncp-cols (max ncp-cols nc-cols))))
+
+		  (let repl-loop ()
+		    (display-status-area)
+
+		    (if repl-done
+			(begin
+			  (ncplane_destroy ncp) ; does this free ncp?
+			  (if hc (ncplane_destroy hc)) ; free cells?
+			  (if wc (ncplane_destroy wc))
+			  (set! ncp #f) ; unnecessary?
+			  (set! hc #f) ; old header if nested??
+			  (set! wc #f)
+			  (set! recursor #t))
+			(begin
+			  (when recursor
+			    (recover-previous-layout))
+
+                          (set! previously-selected just-selected)
+                          (set! just-selected #f)
+			  
+			  (let* ((c (notcurses_getc nc (c-pointer 0) (c-pointer 0) ni))
+                                 (c (if (= c (char->integer #\escape))
+					(logior meta-key (notcurses_getc nc (c-pointer 0) (c-pointer 0) ni))
+					c))
+				 (func (hash-table-ref keymap (logior c (if (ncinput_ctrl ni) control-key 0)
+								      (if (ncinput_alt ni) meta-key 0)))))
+
+			    (if (procedure? func)
+				(catch #t
+				  (lambda ()
+				    (func c))
+				  (lambda (type info) ; this is usually an internal (nrepl) error, or sometimes a read error
+				    (display-error ncp row info)
+				    (increment-row 1)
+				    (reprompt row)))
+				;(display-status (format #f "unhandled ~D" c))
+				))
+
+			  (notcurses_render nc)
+
+			  ;; if cursor is after ), look for matching open, highlight if found
+			  (when (and (pair? prev-pars)
+				     (visible? (car prev-pars) (cadr prev-pars)))
+			    (ncplane_putc_yx ncp (car prev-pars) (cadr prev-pars) normal-paren)
+			    (notcurses_render nc)
+			    (set! prev-pars #f))
+
+			  ;; if we have "(name" and name is a function/macro, and it has either
+			  ;;   a signature or documentation, post it in the status area
+			  (let ((name (ncplane_contents ncp row (bols row) 1 (- col (bols row)))))
+			    (do ((i (- (length name) 1) (- i 1)))
+				((or (< i 0)
+				     (char-whitespace? (name i))
+				     (memv (name i) '(#\( #\) #\# #\; #\" #\' #\`)))
+				 (when (and (>= i 0)
+					    (char=? (name i) #\())
+				   (set! name (substring name 1))
+				   (when (positive? (length name))
+				     (let ((value (symbol->value (string->symbol name) top-level-let)))
+				       (when (or (procedure? value)
+						 (macro? value))   ; syntax here is just noise -- everyone knows about "if"!
+					 (let ((sig (signature value))
+					       (args (let ((source (procedure-source value)))
+						       (and (pair? source)
+							    (pair? (cdr source))
+							    (cadr source))))
+					       (doc (documentation value)))
+					   (let ((str (format #f "~A~A~A"
+							      (if (pair? sig)
+								  (format #f "sig: ~S" sig)
+								  "")
+							      (if args
+								  (format #f "~Aargs: ~S" (if sig ", " "") args)
+								  "")
+							      (if (and (string? doc)
+								       (> (length doc) 0))
+								  (format #f "~Adoc: ~S" (if (or args sig) ", " "") doc)
+								  ""))))
+					     (set! (top-level-let 'status-text) str)
+					     (display-status (first-line str)))))))))))
+
+			  ;; show matching open paren, if it's a complete expression, ask lint about it
+			  (unless (or (<= col (+ (bols row) 1))              ; got to be room for #\(
+				      (not (string=? ")" (ncplane_contents ncp row (- col 1) 1 1)))
+				      (and (>= col (+ (bols row) 3))
+					   (string=? (ncplane_contents ncp row (- col 3) 1 3) "#\\)")))
+			    (let ((pars (match-close-paren ncp row col #f)))
+			      (when (and (pair? pars)
+					 (visible? (caar pars) (cadar pars)))
+				(ncplane_putc_yx ncp (caar pars) (cadar pars) red-paren)
+				(set! prev-pars (car pars))
+				(notcurses_render nc)
+				(when (and with-lint (= row (caar pars)))
+				  (let ((expr (ncplane_contents ncp row (cadar pars) 1 (- col (cadar pars)))))
+				    (catch #t
+				      (lambda ()
+					(let ((result (call-with-output-string
+						       (lambda (op)
+							 (call-with-input-string expr
+							   (lambda (ip)
+							     (let-temporarily ((*report-laconically* #t)
+									       (*report-combinable-lets* #f)
+									       (*report-boolean-functions-misbehaving* #f)
+									       (*report-quasiquote-rewrites* #f))
+							       (lint ip op #f))))))))
+					  (unless (string=? result expr)
+					    (set! (top-level-let 'status-text) result)
+					    (display-status (first-line result)))))
+				      (lambda (type info)
+					#f)))))))
+			  (move-cursor row col)
+			  (repl-loop))))))
+
+	      (lambda (type info)
+		(display-error ncp row info)
+		(notcurses_stop nc)
+		(apply format *stderr* info)
+		(format *stderr* "~%line ~A: ~A~%" ((owlet) 'error-line) ((owlet) 'error-code))
+		(#_exit)
+		)
+	    )))) ; run
+
+
+      (define (stop)
+	(notcurses_stop nc)
+	(#_exit))
+
+
+      ;; -------- emacs --------
+      (define (emacs-repl)
+	;; also this does not resend the entire expression after editing
+	;;   and does not notice in-place edits
+	;;   can <cr> get entire expr?
+	(with-let (sublet libc-let)
+	  (let ((buf (c-pointer->string (calloc 512 1) 512)))
+	    (format *stderr* "> ")
+	    (do ((b (fgets buf 512 stdin) (fgets buf 512 stdin)))
+		((zero? (length b))
+		 (#_exit))
+	      (let ((len (strlen buf)))
+		(when (positive? len)
+		  (do ((i 0 (+ i 1)))
+		      ((or (not (char-whitespace? (buf i)))
+			   (= i len))
+		       (when (< i len)
+			 (let ((str (substring buf 0 (- (strlen buf) 1))))
+			   (catch #t
+			     (lambda ()
+			       (do ()
+				   ((= (string-length str) 0))
+				 (catch 'string-read-error
+				   (lambda ()
+				     (format *stderr* "~S~%> " (eval-string str (*nrepl* 'top-level-let)))
+				     (set! str ""))
+				   (lambda (type info)
+				     (fgets buf 512 stdin)
+				     (set! str (string-append str " " (substring buf 0 (- (strlen buf) 1))))))))
+			     (lambda (type info)
+			       (set! str "")
+			       (apply format *stderr* info)
+			       (format *stderr* "~%> ")))))))))))))
+
+      (define (start)
+	(if (with-let libc-let
+	      (or (zero? (isatty (fileno stdin)))      ; not a terminal -- input from pipe probably
+		  (string=? (getenv "TERM") "dumb")))  ; no vt100 codes -- emacs subjob for example
+	    (emacs-repl)
+	    (begin
+	      (let ((noptions (notcurses_options_make)))
+		(set! (notcurses_options_flags noptions) NCOPTION_SUPPRESS_BANNERS)
+		(set! nc (notcurses_core_init noptions)))
+	      (notcurses_cursor_enable nc 0 2)
+	      (unless (string-position "rxvt" ((libc-let 'getenv) "TERM"))
+		(notcurses_mice_enable nc NCMICE_ALL_EVENTS)) ; 0 if ok, -1 if failure
+	      (let ((size (ncplane_dim_yx (notcurses_stdplane nc))))
+		(set! nc-cols (cadr size))
+		(set! nc-rows (car size))
+		(set! statp-row (- nc-rows status-rows)))
+	      (set! statp (ncplane_new nc nc-rows nc-cols 0 0 (c-pointer 0)))
+	      (nccells_double_box statp 0 0 (status-cells 0) (status-cells 1) (status-cells 2) (status-cells 3) (status-cells 4) (status-cells 5))
+	      (ncplane_putstr_yx statp 1 1 (make-string (- nc-cols 5) #\space))
+	      (when (string-position "rxvt" (getenv "TERM"))
+		(ncplane_putstr_yx statp 1 2 (substring "rxvt doesn't support the mouse" 0 (min 30 (- nc-cols 3))))
+		(notcurses_render nc)))))
+      (curlet)))
+
+  (with-let *nrepl*
+    (start)
+    (run)
+    (stop)))
+
+;; selection (both ways):
+;;   (currently works by dragging mouse and using C-y, but text is not highlighted)
+;;   xclip to access the clipboard?? (system "xclip -o")=current contents, (system "echo ... | xclip")=set contents
+;;   so if mouse(2)=get from xclip if it exists etc, or maybe add example function, or can we do this in nrepl.c?
+;;     right button is nckey_button2, scroll=nckey_button3 (lxterminal -- not rxvt)
+;;   C_<space>+move cursor -- need highlighting too
+;;
+;; some terminals have "zoom" -- can we tell this has happened? apparently not
+;;     (ncplane_dim_yx (notcurses_stdplane (*nrepl* 'nc))) doesn't change, but cursor movement is confused and status area gets lost
+;; add signatures and help for notcurses
+;; C-s|r? [need positions as adding chars, backspace=remove and backup etc, display current search string in status]
+;;   start at row/col, get contents, go to current match else increment, save row/col of match
+;; begin_hook for stepper: at each call, drop back into the debugger with curlet -- how to keep our place? (step=continue+break -- ambiguous)
+;; colorize, perhaps make a vector for each color indexed by char; for colorized name, for each char get cell from vector (or make it if needed)
+
+(set! (*s7* 'debug) old-debug)
+*nrepl*
diff --git a/s7/profile.scm b/s7/profile.scm
new file mode 100644
index 0000000..c63fe9f
--- /dev/null
+++ b/s7/profile.scm
@@ -0,0 +1,119 @@
+(provide 'profile.scm)
+
+(let-temporarily (((*s7* 'profile) 0))
+
+  (define show-profile 
+    (let ((*profile-port* *stderr*))
+
+      (set! (setter '*profile-port*)
+	    (lambda (s v)
+	      (if (or (output-port? v) (not v))
+		  v
+		  (error 'wrong-type-arg "~S can't be set! to ~S" s v))))
+
+      (lambda* ((n 100))
+	(let ((info (*s7* 'profile-info))) 
+	  ;; a list: '(vector-of-function-names int-vector-of-profile-data ticks-per-second let-names file-names line-numbers ambiguous-names)
+	  (if (not info)
+	      (format *profile-port* "no profiling data!~%")
+	      
+	      (let* ((funcs (car info))
+		     ;; function names (symbols)
+
+		     (data (cadr info))
+		     ;; each entry in the data vector is a block of 5 integers: 
+		     ;;   calls <ignore> <ignore> inclusive-time exclusive-time
+
+		     (ticks/sec (* 1.0 (caddr info)))
+		     ;;   divide by ticks/sec to turn the times into seconds
+
+		     (let-names (list-ref info 3))
+		     ;; symbols, the value of (*s7* 'profile-prefix) at the function, #f if none
+
+		     (file-names (list-ref info 4))
+		     ;; strings, #f if none (includes line-numbers)
+
+		     (line-numbers (list-ref info 5))
+		     (ambiguous-names (list-ref info 6)) ; function names that occur more than once
+
+		     (entries (length funcs))
+		     (vect (make-vector entries)))
+		(do ((i 0 (+ i 1)))
+		    ((= i entries))
+		  (vector-set! vect i (list (/ (data (+ (* i 5) 3)) ticks/sec)    ; inclusive timing
+					    (funcs i)                             ; function name
+					    (data (* i 5))                        ; calls
+					    (/ (data (+ (* i 5) 4)) ticks/sec)    ; exclusive timing
+					    (let-names i) 
+					    (file-names i) 
+					    (line-numbers i))))
+		(set! vect (sort! vect (lambda (a b)               ; sort by inclusive time, to sort by calls use caddr
+					 (> (car a) (car b)))))
+					 ;(> (caddr a) (caddr b)))))
+		(let ((name-len 0)                                 ; decide the data column
+		      (name-max 0)
+		      (end (min n entries))
+		      (call-max 0))
+		  (do ((i 0 (+ i 1)))
+		      ((= i end))
+		    (let ((entry (vector-ref vect i)))
+		      (when (symbol? (cadr entry))
+			(let ((len (if (list-ref entry 4)          ; there is a let-name
+				       (+ 1 (length (symbol->string (cadr entry))) (length (symbol->string (list-ref entry 4))))
+				       (length (symbol->string (cadr entry))))))
+			  (set! name-len (+ name-len len))
+			  (set! name-max (max name-max len)))))
+		    (set! call-max (max call-max (caddr (vector-ref vect i)))))
+		  (set! name-max (max (round (/ name-len entries)) (floor (* .9 name-max))))
+		  (set! call-max (+ 1 (ceiling (log call-max 10))))
+
+		  (format *profile-port* "info:\n")
+		  (do ((i 0 (+ i 1))
+		       (fs 0)
+		       (excl 0.0))
+		      ((= i end)
+
+		       (format *profile-port* "  ")
+		       (when (< end fs)
+			 (format *profile-port* "the rest (~D entries): ~,4F, "
+				 (- fs end) 
+				 (max 0.0 (- (car (vector-ref vect 0)) excl))))
+
+		       (let ((gc-info (*s7* 'gc-info)))
+			 (format *profile-port* "cells allocated: ~A, GC calls: ~D, GC time: ~,3F seconds~%" 
+				 (let ((num (with-let *s7* 
+					      (+ (- heap-size free-heap-size) gc-total-freed))))
+				   (cond ((< num 1000) (format #f "~D" num))
+					 ((< num 1000000) (format #f "~,1Fk" (/ num 1000.0)))
+					 ((< num 1000000000) (format #f "~,1FM" (/ num 1000000.0)))
+					 (else (format #f "~,1FG" (/ num 1000000000.0)))))
+				 (car gc-info)
+				 (* 1.0 (/ (cadr gc-info) (caddr gc-info))))))
+
+		    (let ((entry (vector-ref vect i)))
+		      (when (symbol? (cadr entry))
+			(format *profile-port* "  ~A:~NTcalls ~S, ~NTtime ~,4F ~NT~,4F" 
+				(if (list-ref entry 4)
+				    (string-append (symbol->string (list-ref entry 4)) "/" (symbol->string (cadr entry)))
+				    (cadr entry))
+				(+ name-max 5)
+				(caddr entry)
+				(+ name-max 5 6 call-max)
+				(car entry)
+				(+ name-max 5 6 call-max 8 6)
+				(max 0.0 (cadddr entry)))
+			(when (and (memq (cadr entry) ambiguous-names)
+				   (string? (list-ref entry 5)))
+			  (format *profile-port* ", ~A[~D]" (list-ref entry 5) (list-ref entry 6)))
+			(newline *profile-port*)
+			(set! fs (+ fs 1))
+			(set! excl (+ excl (cadddr entry)))))))))))))
+	      
+  (define (clear-profile)
+    (set! (*s7* 'profile-info) #f))
+
+  (define profile-port (dilambda
+			(lambda ()
+			  ((funclet show-profile) '*profile-port*))
+			(lambda (new-port)
+			  (set! ((funclet show-profile) '*profile-port*) new-port)))))
diff --git a/s7/r7rs.scm b/s7/r7rs.scm
new file mode 100644
index 0000000..f0186ac
--- /dev/null
+++ b/s7/r7rs.scm
@@ -0,0 +1,644 @@
+;;; r7rs compatibility
+
+(require libc.scm)
+(provide 'r7rs.scm)
+
+
+(define (vector-map p . args) (apply vector (apply map p args)))
+(define (string-map p . args) (apply string (apply map p args)))
+(define vector-for-each for-each) 
+(define string-for-each for-each)
+
+(define* (vector->string v (start 0) end) 
+  (let ((stop (or end (length v)))) 
+    (copy v (make-string (- stop start)) start stop)))
+
+(define* (string->vector s (start 0) end)
+  (let ((stop (or end (length s)))) 
+    (copy s (make-vector (- stop start)) start stop)))
+
+(define list-copy copy)
+(define vector-copy string->vector)
+(define r7rs-string-copy vector->string) ; the latter doesn't know its not a vector
+(define r7rs-vector-fill! fill!) ; or do these return the sequence, not the filler?
+(define r7rs-string-fill! fill!)
+
+(define* (vector-copy! dest at src (start 0) end) ; end is exclusive
+  (if (not at)
+      (copy dest)
+      (if (not src)
+	  (copy (subvector dest at))
+	  (if (integer? src) ; good lord, who dreamed up this nonsense?
+	      (copy (subvector dest at src))
+	      (let ((len (or end (length src))))
+		(if (or (not (eq? dest src))
+			(<= at start))
+		    (do ((i at (+ i 1))
+			 (k start (+ k 1)))
+			((= k len) dest)
+		      (set! (dest i) (src k)))
+		    (do ((i (- (+ at len) start 1) (- i 1))
+			 (k (- len 1) (- k 1)))
+			((< k start) dest)
+		      (set! (dest i) (src k)))))))))
+
+(define (r7rs-make-hash-table . args)
+  (if (null? args)
+      (#_make-hash-table)
+      (if (procedure? (car args))
+	  (#_make-hash-table (if (null? (cdr args)) (*s7* 'default-hash-table-length) (cadr args)) (car args))
+	  (apply #_make-hash-table args))))
+
+(define bytevector byte-vector)
+(define bytevector? byte-vector?)
+(define make-bytevector make-byte-vector)
+(define bytevector-ref byte-vector-ref)
+(define bytevector-set! byte-vector-set!)
+(define bytevector-copy! vector-copy!)
+(define (bytevector->list bv) (copy bv (make-list (length bv))))
+(define string-copy! vector-copy!)
+
+(define (boolean=? . args)
+  (or (null? args)
+      (and (boolean? (car args))
+	   (let loop ((obj (car args)) (lst (cdr args)))
+	     (or (null? lst)
+		 (and (eq? obj (car lst))
+		      (loop obj (cdr lst))))))))
+
+(define (symbol=? . args) 
+  (or (null? args)
+      (and (symbol? (car args))
+	   (let loop ((obj (car args)) (lst (cdr args)))
+	     (or (null? lst)
+		 (and (eq? obj (car lst))
+		      (loop obj (cdr lst))))))))
+
+(define char-foldcase char-downcase) 
+(define string-foldcase string-downcase)
+;;; these and the string functions in s7 are not unicode-aware.  To get true unicode
+;;;   handling of the bytes, use libutf8proc.scm, the glib functions in libxg or use cload (see xgdata.scm).
+(define (digit-value c) (and (char-numeric? c) (- (char->integer c) (char->integer #\0))))
+
+
+(define (finite? n) (and (number? n) (not (nan? n)) (not (infinite? n))))
+(define exact-integer? integer?)	
+(define (exact-integer-sqrt i) (let ((sq (floor (sqrt i)))) (values sq (- i (* sq sq)))))
+(define inexact exact->inexact)
+(define exact inexact->exact)
+(define (square x) (* x x))
+(define truncate-quotient quotient)
+(define truncate-remainder remainder)
+(define floor-remainder modulo)
+(define (floor-quotient x y) (floor (/ x y)))
+
+
+(define (input-port-open? p) (not (port-closed? p))) 
+(define (output-port-open? p) (not (port-closed? p))) 
+(define (port? p) (or (input-port? p) (output-port? p)))
+(define binary-port? port?)
+(define textual-port? port?)
+(define (close-port p) (if (input-port? p) (close-input-port p) (close-output-port p)))
+(define open-binary-input-file open-input-file)
+(define open-binary-output-file open-output-file)
+(define (call-with-port port proc) (let ((res (proc port))) (if res (close-port port)) res))
+
+(define bytevector-u8-ref byte-vector-ref)
+(define bytevector-u8-set! byte-vector-set!)
+(define bytevector-u8 (dilambda (lambda (b k) (b k)) (lambda (b k c) (set! (b k) c))))
+(define bytevector-length length)
+(define bytevector-copy vector-copy!)
+(define bytevector-append append)
+
+(define* (write-bytevector bv port start end)
+  (if (not port)
+      (write bv)
+      (if (not start)
+	  (write bv port)
+	  (write (subvector bv start (or end (length bv)))))))
+
+(define* (read-bytevector! bv port (start 0) end)
+  (let ((lim (or end (length bv)))
+	(pt (or port (current-input-port))))
+    (do ((i start (+ i 1))
+	 (c (read-byte pt) (read-byte pt)))
+	((or (>= i lim)
+	     (eof-object? c))
+	 (if (= i start) #<eof> (- i start))) ; or i?
+      (set! (bv i) c))))
+
+(define* (read-bytevector k port)
+  (let* ((buf (make-byte-vector k))
+	 (bytes (read-bytevector! buf port)))
+    (if (eof-object? bytes)
+	bytes
+	(if (= k bytes)
+	    buf
+	    (subvector buf 0 bytes)))))
+
+(define (get-output-bytevector port) (string->byte-vector (get-output-string port)))
+(define (open-input-bytevector bv) (open-input-string (copy bv (make-string (length bv)))))
+(define open-output-bytevector open-output-string)
+(define read-u8 read-byte)
+(define write-u8 write-byte) 
+(define u8-ready? char-ready?) 
+(define peek-u8 peek-char)
+
+(define* (utf8->string v (start 0) end) 
+  (if (string? v)
+      (substring v start (or end (length v)))
+      (substring (byte-vector->string v) start (or end (length v)))))
+
+(define* (string->utf8 s (start 0) end) 
+  (if (byte-vector? s)
+      (copy (subvector s start (or end (length s))))
+      (string->byte-vector (utf8->string s start end))))
+(define write-simple write)
+
+(define (eof-object) #<eof>)
+(define-macro (features) '*features*) ; needs to be the local *features*
+
+
+(define (with-exception-handler handler thunk) 
+  (catch #t thunk 
+	 (lambda args
+	   (if (aritable? handler (length args))
+	       (apply handler args)
+	       (handler (cadr args))))))
+
+(define raise error)
+(define raise-continuable error) ; this should return the handler value? So with-exception-handler is supposed to add it to a local env??
+(define (error-object? obj) #f)
+(define (error-object-message . args) #f)
+(define (error-object-irritants . args) #f)
+
+(define-macro (guard results . body)
+  `(let ((,(car results) (catch #t (lambda () ,@body) (lambda args (car args)))))
+     (cond ,@(cdr results))))
+
+#|
+;;; maybe these are closer to what r7rs intends?
+(define (raise . args)
+  (apply throw #t args))
+
+(define-macro (guard results . body)
+  `(let ((,(car results) 
+	  (catch #t 
+	    (lambda () 
+	      ,@body) 
+	    (lambda (type info)
+	      (if (pair? (*s7* 'catches))
+		  (lambda () (apply throw type info))
+		  (car info))))))
+     (cond ,@(cdr results)
+	   (else 
+	    (if (procedure? ,(car results)) 
+		(,(car results))
+		,(car results))))))
+|#
+
+(define (read-error? obj) (eq? (car obj) 'read-error))
+(define (file-error? obj) (eq? (car obj) 'io-error))
+(define (error-message obj) (apply format #f (cadr obj)))
+(define error-irritants cdadr)
+(define write-shared write)
+(define write-simple write)
+
+(define interaction-environment curlet)
+;; for null-environment see stuff.scm
+
+(define-macro (include . files) 
+  `(begin
+     ,@(map (lambda (file)
+	      `(load ,file (outlet (curlet))))
+	    files)))
+;; according to someone, this should insert the text from the included files directly into the loader input stream, perhaps:
+;; (let ((old-string (port-string (current-input-port))) ; do we need to start at port-position?
+;;       (new-string (let ((f (open-input-file file)))
+;;                     (let ((str (port-string f))) ; since it's actually a string port?
+;;                       (close-input-port f)
+;;                       str))))
+;;   (set! (port-string (current-input-file)) (string-append new-string old-string)))
+;; but this is alien to lisp, and even in C it's a horrible kludge -- why did the r7rs committee accept such crap?
+
+(set! *#readers* (cons (cons #\; (lambda (s) (read) (values))) *#readers*))
+;; I prefer (define-expansion (comment . stuff) (values))
+;;   or (format #f "~^ this is a comment ")
+
+
+(define-macro (define-values vars expression)
+  `(if (not (null? ',vars))
+       (varlet (curlet) ((lambda ,vars (curlet)) ,expression))))
+
+#|
+(define-macro (define*-values vars expression) ; same but allows defaults for the vars
+  `(if (not (null? ',vars))
+       (varlet (curlet) ((lambda* ,vars (curlet)) ,expression))))
+
+(define-macro (define-values vars . body) ; but the spec says "<expression>" here
+  `(apply begin (map (lambda (var val) `(define ,var ,val)) ',vars (list (begin ,@body)))))
+|#
+
+(define-macro (let-values vars . body)
+  (if (and (pair? vars)
+	   (pair? (car vars))
+	   (null? (cdar vars)))
+      `((lambda ,(caar vars)
+	  ,@body)
+	,(cadar vars))
+      `(with-let (apply sublet (curlet)
+			(list ,@(map (lambda (v)
+				       `((lambda ,(car v)
+					   (values ,@(map (lambda (name)
+							    (values (symbol->keyword name) name))
+							  (let args->proper-list ((args (car v)))
+							    (cond ((symbol? args)	
+								   (list args))
+								  ((not (pair? args))	
+								   args)
+								  ((pair? (car args))	
+								   (cons (caar args) (args->proper-list (cdr args))))
+								  (else                 
+								   (cons (car args) (args->proper-list (cdr args)))))))))
+					 ,(cadr v)))
+				     vars)))
+	 ,@body)))
+
+(define-macro (let*-values vals . body)
+  (let ((args ())
+	(exprs ()))
+    (for-each
+     (lambda (arg+expr)
+       (set! args (cons (car arg+expr) args))
+       (set! exprs (cons (cadr arg+expr) exprs)))
+     vals)
+    (let ((form `((lambda ,(car args) ,@body) ,(car exprs))))
+      (if (not (null? (cdr args)))
+	  (for-each
+	   (lambda (arg expr)
+	     (set! form (list (list 'lambda arg form) expr)))
+	   (cdr args)
+	   (cdr exprs)))
+      form)))
+
+
+;; case-lambda       
+(define-macro (case-lambda . choices)
+  `(lambda args
+     (case (length args)
+       ,@(map (lambda (choice)
+		(if (or (symbol? (car choice))
+			(negative? (length (car choice))))
+		    `(else (apply (lambda ,(car choice) ,@(cdr choice)) args))
+		    `((,(length (car choice))) 
+		      (apply (lambda ,(car choice) ,@(cdr choice)) args))))
+	      choices))))
+
+
+;; parameters
+;;   s7 has no built-in parameter objects
+(define* (make-parameter init converter)
+  (let* ((convert (or converter (lambda (x) x)))
+	 (old-values ()) ; see below -- this is part of the funclet
+	 (value (convert init)))
+    (lambda () value)))
+
+(define-macro (parameterize vars . body)
+  `(dynamic-wind
+       (lambda ()
+	 ,@(map (lambda (var)
+		  `(with-let (funclet ,(car var))
+		     (set! old-values (cons value old-values))
+		     (set! value (convert ,(cadr var)))))
+		vars))
+       (lambda () 
+         ,@body)
+       (lambda ()
+	 ,@(map (lambda (var)
+		  `(with-let (funclet ,(car var))
+		     (set! value (car old-values))
+		     (set! old-values (cdr old-values))))
+		vars))))
+
+
+;; libraries?
+(apply define (symbol (object->string '(scheme base))) (inlet) ()) ; ignore (scheme base)
+(apply define (symbol (object->string '(scheme r5rs))) (inlet) ()) ; ignore (scheme r5rs)
+(apply define (symbol (object->string '(scheme read))) (inlet) ()) ; and so on... what a pile of baloney
+(apply define (symbol (object->string '(scheme write))) (inlet) ()) 
+(apply define (symbol (object->string '(scheme time))) (inlet) ()) 
+(apply define (symbol (object->string '(scheme file))) (inlet) ()) 
+(apply define (symbol (object->string '(scheme cxr))) (inlet) ()) 
+(apply define (symbol (object->string '(scheme inexact))) (inlet) ()) 
+(apply define (symbol (object->string '(scheme char))) (inlet) ()) 
+(apply define (symbol (object->string '(scheme complex))) (inlet) ()) 
+(apply define (symbol (object->string '(scheme eval))) (inlet) ()) 
+(apply define (symbol (object->string '(scheme process-context))) (inlet) ()) 
+(apply define (symbol (object->string '(scheme case-lambda))) (inlet) ()) 
+(apply define (symbol (object->string '(scheme lazy))) (inlet) ()) 
+(apply define (symbol (object->string '(scheme load))) (inlet) ()) 
+(apply define (symbol (object->string '(scheme repl))) (inlet) ()) 
+
+(define-macro (define-library libname . body) ; |(lib name)| -> environment
+  `(define ,(symbol (object->string libname))
+     (with-let (sublet (unlet) 
+			 (cons 'import import)
+			 (cons '*export* ())
+			 (cons 'export (define-macro (,(gensym) . names) 
+					 `(set! *export* (append ',names *export*)))))
+       ,@body
+       (apply inlet
+	      (map (lambda (entry)
+		     (if (or (member (car entry) '(*export* export import))
+			     (and (pair? *export*)
+				  (not (member (car entry) *export*))))
+			 (values)
+			 entry))
+		   (curlet))))))
+
+(unless (defined? 'r7rs-import-library-filename)
+  (define (r7rs-import-library-filename libs)    ; this turns (A B) into "A/B.scm", then loads it if needed
+    (when (pair? libs)
+      (unless (eq? (caar libs) 'scheme)
+        (let ((lib-filename (let loop ((lib (if (memq (caar libs) '(only except prefix rename))
+						(cadar libs)
+						(car libs)))
+				       (name ""))
+			      (set! name (string-append name (symbol->string (car lib))))
+			      (if (null? (cdr lib))
+				  (string-append name ".scm")
+				  (begin
+				    (set! name (string-append name "/")) ; this follows Guile, Chibi, and Racket
+				    (loop (cdr lib) name))))))
+	  (unless (member lib-filename (*s7* 'file-names))
+	    (load lib-filename))))
+      (r7rs-import-library-filename (cdr libs)))))
+  
+(define-macro (import . libs)
+  `(begin
+     (r7rs-import-library-filename ',libs)
+     (varlet (curlet)
+       ,@(map (lambda (lib)
+		(case (car lib)
+		  ((only) 
+		   `((lambda (e names)
+		       (apply inlet
+			      (map (lambda (name)
+				     (cons name (e name)))
+				   names)))
+		     (symbol->value (symbol (object->string (cadr ',lib))))
+		     (cddr ',lib)))
+		  
+		  ((except)
+		   `((lambda (e names)
+		       (apply inlet
+			      (map (lambda (entry)
+				     (if (member (car entry) names)
+					 (values)
+					 entry))
+				   e)))
+		     (symbol->value (symbol (object->string (cadr ',lib))))
+		     (cddr ',lib)))
+		  
+		  ((prefix)
+		   `((lambda (e prefx)
+		       (apply inlet
+			      (map (lambda (entry)
+				     (cons (string->symbol 
+					    (string-append (symbol->string prefx) 
+							   (symbol->string (car entry)))) 
+					   (cdr entry)))
+				   e)))
+		     (symbol->value (symbol (object->string (cadr ',lib))))
+		     (caddr ',lib)))
+		  
+		  ((rename)
+		   `((lambda (e names)
+		       (apply inlet
+			      (map (lambda (entry)
+				     (let ((info (assoc (car entry) names)))
+				       (if info
+					   (cons (cadr info) (cdr entry))
+					   entry))) ; I assume the un-renamed ones are included
+				   e)))
+		     (symbol->value (symbol (object->string (cadr ',lib))))
+		     (cddr ',lib)))
+
+		  (else
+		   `(let ((sym (symbol (object->string ',lib))))
+		      (if (not (defined? sym))
+			  (format () "~A not loaded~%" sym)
+			  (symbol->value sym))))))
+	      libs))))
+
+
+;; delay and force: ugh
+;;   this implementation is based on the r7rs spec
+(define-macro (delay-force expr) 
+  `(make-promise #f (lambda () ,expr)))
+(define-macro (r7rs-delay expr) ; "delay" is taken damn it
+  (list 'delay-force (list 'make-promise #t (list 'lambda () expr))))
+(define (make-promise done? proc) 
+  (list (cons done? proc)))
+(define (force promise)
+  (if (caar promise)
+      ((cdar promise))
+      (let ((promise* ((cdar promise))))
+        (if (not (caar promise))
+            (begin
+              (set-car! (car promise) (caar promise*))
+              (set-cdr! (car promise) (cdar promise*))))
+        (force promise))))
+
+
+;; floor/ and truncate/ can't work as intended: they assume that multiple values 
+;;   are not spliced.  The "division library" is a trivial, pointless micro-optimization.
+;; and why no euclidean-rationalize or exact-integer-expt?
+;;   (imagine what will happen when r8rs stumbles on the zoo of continued fraction algorithms!)
+
+(define (jiffies-per-second) 1000000000)
+(define (current-jiffy)
+  (with-let *libc*
+    (let ((res (clock_gettime CLOCK_REALTIME)))
+      (+ (* 1000000000 (cadr res)) (caddr res)))))
+(define (current-second) (* 1.0 ((*libc* 'time) (c-pointer 0 'time_t*))))
+
+(define get-environment-variable getenv)
+(define get-environment-variables (*libc* 'getenvs))
+(define (r7rs-file-exists? arg) (= ((*libc* 'access) arg (*libc* 'F_OK)) 0))
+(define r7rs-delete-file (*libc* 'unlink))
+
+(define (os-type) (car ((*libc* 'uname))))
+(define (cpu-architecture) (cadr ((*libc* 'uname))))
+(define (machine-name) (caddr ((*libc* 'uname))))
+(define (os-version) (string-append (list-ref ((*libc* 'uname)) 3) " " (list-ref ((*libc* 'uname)) 4))) ; or perhaps use /etc/os-release
+(define (implementation-name) (copy "s7"))
+(define (implementation-version) (substring (*s7* 'version) 3 7))
+
+(unless (defined? 'null-environment)
+  (define (null-environment . args) (rootlet)))
+(define (environment . args) (rootlet))
+
+;; command-line is problematic: s7 has no access to the caller's "main" function, and
+;;   outside Windows, there's no reasonable way to get these arguments.
+;;   in Linux, you might win with:
+
+(define (command-line)
+  (let ((lst ()))
+    (with-input-from-file "/proc/self/cmdline"
+      (lambda ()
+	(do ((c (read-char) (read-char))
+	     (s ""))
+	    ((eof-object? c)
+	     (reverse lst))
+	  (if (char=? c #\null)
+	      (begin
+		(set! lst (cons s lst))
+		(set! s ""))
+	      (set! s (string-append s (string c)))))))))
+
+
+;; other minor differences: 
+;;  in s7, single-quote can occur in a name
+
+
+;; records
+(define-macro (define-record-type type make ? . fields)
+  (let ((obj (gensym))
+	(typ (gensym)) ; this means each call on this macro makes a new type
+	(args (map (lambda (field)
+		     (values (list 'quote (car field))
+			     (let ((par (memq (car field) (cdr make))))
+			       (and (pair? par) (car par)))))
+		   fields)))
+    `(begin
+       (define (,? ,obj)
+	 (and (let? ,obj)
+	      (eq? (let-ref ,obj ',typ) ',type)))
+       
+       (define ,make 
+         (inlet ',typ ',type ,@args))
+
+       ,@(map
+	  (lambda (field)
+	    (when (pair? field)
+	      (if (null? (cdr field))
+		  (values)
+		  (if (null? (cddr field))
+		      `(define (,(cadr field) ,obj)
+			 (let-ref ,obj ',(car field)))
+		      `(begin
+			 (define (,(cadr field) ,obj)
+			   (let-ref ,obj ',(car field)))
+			 (define (,(caddr field) ,obj val)
+			   (let-set! ,obj ',(car field) val)))))))
+	  fields)
+       ',type)))
+
+;;; srfi 111:
+(define-record-type box-type (box value) box? (value unbox set-box!))
+
+;;; as per the comment above,
+;;; <1> (load "r7rs.scm")
+;;;   box-type
+;;; <2> (define b1 (box 32))
+;;;   (inlet '{gensym}-1 box-type 'value 32)
+;;; <3> (define-record-type box-type (box value) box? (value unbox set-box!))
+;;;   box-type
+;;; <4> (define b2 (box 32))
+;;;   (inlet '{gensym}-3 box-type 'value 32)
+;;; <5> (box? b1)
+;;;   #f
+;;; <6> (box? b2)
+;;;   #t
+;;; but, of course:
+;;; <7> (define b3 (box 32))
+;;;  (inlet '{gensym}-3 box-type 'value 32)
+;;; <8> (equal? b2 b3)
+;;;  #t
+;;; <9> (box? b3)
+;;;  #t
+
+
+#|
+;(require stuff.scm)
+
+;;; more than r7rs desires I think:
+(define-macro (define-record-type type make ? . fields)
+  (let ((new-type (if (pair? type) (car type) type))
+	(inherited (if (pair? type) (cdr type) ()))
+	(obj (gensym))
+	(new-obj (gensym)))
+    `(begin
+       (define-class ,new-type ,inherited   ; from stuff.scm
+         (map (lambda (f) (if (pair? f) (car f) f)) ',fields))
+       
+       (define ,?    ; perhaps the define-class type predicate should use this 
+	 (let ()
+	   (define (search-inherited ,obj type)
+	     (define (search-inheritors objs type)
+	       (and (pair? objs)
+		    (or (search-inherited (car objs) type)
+			(search-inheritors (cdr objs) type))))
+	     (or (eq? (let-ref ,obj 'class-name) type)
+		 (search-inheritors (let-ref ,obj 'inherited) type)))
+	   (lambda (,obj)
+	     (and (let? ,obj)
+		  (search-inherited ,obj ',new-type)))))
+       
+       (define ,make 
+         (let ((,new-obj (copy ,new-type)))
+	   ,@(map (lambda (slot)
+		    `(let-set! ,new-obj ',slot ,slot))
+		  (cdr make))
+	   ,new-obj))
+       
+       ,@(map
+	  (lambda (field)
+	    (when (pair? field)
+	      (if (null? (cdr field))
+		  (values)
+		  (if (null? (cddr field))
+		      `(define (,(cadr field) ,obj)
+			 (let-ref ,obj ',(car field)))
+		      `(begin
+			 (define (,(cadr field) ,obj)
+			   (let-ref ,obj ',(car field)))
+			 (define (,(caddr field) ,obj val)
+			   (let-set! ,obj ',(car field) val)))))))
+	  fields)
+       ',new-type)))
+
+;;; vector form is slower:
+(define-macro (define-record-type type make ? . fields)
+  (let* ((obj (gensym))
+	 (args (map (lambda (field)
+		      (let ((par (memq (car field) (cdr make))))
+			(if (pair? par) (car par) #f)))
+		    fields)))
+    `(begin
+       (define (,? obj) 
+	 (and (vector? obj) 
+	      (eq? (vector-ref obj 0) ',type)))
+       
+       (define ,make 
+	 (vector ',type ,@args))
+       
+       ,@(map
+	  (let ((pos 0))
+	    (lambda (field)
+	      (set! pos (+ pos 1))
+	      (when (pair? field)
+		(if (null? (cdr field))
+		    (values)
+		    (if (null? (cddr field))
+			`(define (,(cadr field) ,obj)
+			   (vector-ref ,obj ,pos))
+			`(begin
+			   (define (,(cadr field) ,obj)
+			     (vector-ref ,obj ,pos))
+			   (define (,(caddr field) ,obj val)
+			     (vector-set! ,obj ,pos val))))))))
+	  fields)
+       ',type)))
+|#
diff --git a/s7/reactive.scm b/s7/reactive.scm
new file mode 100644
index 0000000..94d66c0
--- /dev/null
+++ b/s7/reactive.scm
@@ -0,0 +1,340 @@
+;;; reactive.scm
+
+(provide 'reactive.scm)
+;(set! (*s7* 'gc-stats) #t)
+
+(define (symbol->let symbol env)
+  ;(format *stderr* "symbol->let ~S~%" symbol)
+  ;; return let in which symbol lives (not necessarily curlet)
+  (if (defined? symbol env #t)
+      env	
+      (if (eq? env (rootlet))
+	  #<undefined>
+	  (symbol->let symbol (outlet env)))))
+
+(define (gather-symbols expr ce lst ignore)
+  ;; collect settable variables in expr
+  (cond ((symbol? expr)
+	 (if (or (memq expr lst)
+		 (memq expr ignore)
+		 (procedure? (symbol->value expr ce))
+		 (eq? (symbol->let expr ce) (rootlet)))
+	     lst
+	     (cons expr lst)))
+
+	((not (pair? expr)) lst)
+
+	((not (and (pair? (cdr expr)) (pair? (cddr expr))))
+	 (gather-symbols (cdr expr) ce (gather-symbols (car expr) ce lst ignore) ignore))
+
+	((pair? (cadr expr))
+	 (gather-symbols (case (car expr)
+			   ((let let* letrec letrec* do)
+			    (values (cddr expr) ce lst (append ignore (map car (cadr expr)))))
+			   ((lambda) 
+			    (values (cddr expr) ce lst (append ignore (cadr expr))))
+			   ((lambda*)
+			    (values (cddr expr) ce lst (append ignore (map (lambda (a) (if (pair? a) (car a) a)) (cadr expr)))))
+			   (else
+			    (values (cdr expr) ce (gather-symbols (car expr) ce lst ignore) ignore)))))
+
+	((and (eq? (car expr) 'lambda)
+	      (symbol? (cadr expr)))
+	 (gather-symbols (cddr expr) ce lst (append ignore (list (cadr expr)))))
+
+	(else 
+	 (gather-symbols (cdr expr) ce (gather-symbols (car expr) ce lst ignore) ignore))))
+
+;;; c-pointer used to hold symbol+let info so that the lets can be a "weak references"
+(define slot-symbol c-pointer-type)
+(define slot-expr c-pointer-info)
+(define slot-env c-pointer-weak1)
+(define slot-expr-env c-pointer-weak2)
+(define (slot symbol expr env expr-env) (c-pointer 0 symbol expr env expr-env))
+
+(define (setter-update cp)            ; cp: (slot var expr env expr-env)
+  ;; when var set, all other vars dependent on it need to be set also, watching out for GC'd followers
+  (when (and (let? (slot-env cp))
+	     (let? (slot-expr-env cp)))     ; when slot-env is GC'd, the c-pointer field is set to #f (by the GC)
+    (let ((val (eval (slot-expr cp) (slot-expr-env cp))))
+      (when (let? (slot-env cp))      ; same as above, but eval may trigger gc
+	(let-set! (slot-env cp)
+		  (slot-symbol cp)
+		  val)))))
+
+
+(define (slot-equal? cp1 cp2)
+  (and (eq? (slot-symbol cp1) (slot-symbol cp2))
+       (eq? (slot-env cp1) (slot-env cp2))))
+
+(define (setter-remove cp lst)
+  ;; if reactive-set! called again on a variable, its old setters need to remove the now obsolete set of that variable
+  (map (lambda (c)
+	 (if (slot-equal? cp c)
+	     (values)
+	     c))
+       lst))
+
+
+(define* (make-setter var env (followers ()) (setters ()) (expr ()) expr-env)
+  ;; return a new setter with closure containing the followers and setters of var, and the c-pointer holding its name, environment, and expression
+  (let ((followers followers)
+	(setters setters)
+	(cp (slot var expr env expr-env))) ; sets slot-expr etc
+    (lambda (sym val)
+      ;(format *stderr* "make-setter ~S ~S~%" sym val)
+      (let-temporarily (((setter (slot-symbol cp) (slot-env cp)) #f))
+			 ;(setter (c-pointer-type cp) (c-pointer-weak1 cp)) #f))
+	(let-set! (slot-env cp) (slot-symbol cp) val) ; set new value without retriggering the setter
+	(for-each setter-update followers)            ; set any variables dependent on var
+	val))))
+
+(define (update-setters setters cp e)
+  ;; add the slot to the followers setter list of each variable in expr
+  (for-each (lambda (s)
+	      (unless (and (setter s e)
+			   (defined? 'followers (funclet (setter s e))))
+		(set! (setter s e) (make-setter s e)))
+	      (let ((setter-followers (let-ref (funclet (setter s e)) 'followers)))
+		(unless (member cp setter-followers slot-equal?)
+		  (let-set! (funclet (setter s e))
+			    'followers
+			    (cons cp setter-followers)))))
+	    setters))
+
+(define (clean-up-setter old-setter old-followers lt place e)
+  ;; if previous set expr, remove it from setters' followers lists
+  (when (and old-setter
+	     (defined? 'followers (funclet old-setter))
+	     (defined? 'setters (funclet old-setter)))
+    (set! old-followers ((funclet old-setter) 'followers))
+    (for-each (lambda (s)
+		(when (and (setter s e)
+			   (defined? 'followers (funclet (setter s e))))
+		  (let ((setter-followers (let-ref (funclet (setter s e)) 'followers)))
+		    (let-set! (funclet (setter s e))
+			      'followers 
+			      (setter-remove (slot place 0 lt e) setter-followers)))))
+	      (let-ref (funclet old-setter) 'setters)))
+  old-followers)
+
+(define-bacro (reactive-set! place value)
+  (with-let (inlet 'place place                       ; with-let here gives us control over the names
+		   'value value 
+		   'e (outlet (curlet)))              ; the run-time (calling) environment
+    `(let ((old-followers ())
+	   (old-setter (setter ',place))
+	   (lt (symbol->let ',place ,e)))
+       (set! old-followers (clean-up-setter old-setter old-followers lt ',place ,e))
+       ;; set up new setter
+       (let ((setters (gather-symbols ',value ,e () ())))
+	 (when (pair? setters)
+	   (let ((expr (if (pair? ',value) (copy ',value :readable) ',value)))
+	     (let ((cp (slot ',place expr lt ,e)))
+	       (set! (setter ',place lt)
+		     (make-setter ',place lt old-followers setters expr ,e))
+	       (update-setters setters cp ,e)))))
+       (set! ,place ,value))))
+
+
+
+;; --------------------------------------------------------------------------------
+#|
+(let ()
+(define a 2)
+(define b 1)
+(define x 0)
+(reactive-set! x (+ a b))
+
+(set! a 3)
+(format *stderr* "x: ~A~%" x)
+(set! b 4)
+(format *stderr* "x: ~A~%" x)
+
+(format *stderr* "x setter: ~S ~S~%" (setter 'x) (funclet (setter 'x)))
+(format *stderr* "a setter: ~S ~S~%" (setter 'a) (funclet (setter 'a)))
+;; x setter: #<lambda (sym val)> (inlet 'followers () 'setters (b a) 'cp #<x (nil)>)
+;; a setter: #<lambda (sym val)> (inlet 'followers (#<x (nil)>) 'setters () 'cp #<a (nil)>)
+
+(reactive-set! a (* b 2))
+(set! b 5)
+(format *stderr* "x: ~A, a: ~A, b: ~A~%" x a b)
+;; x: 15, a: 10, b: 5
+)
+
+(let ((x 0))
+  (do ((i 0 (+ i 1)))
+      ((= i 100))
+    (let ((a 1))
+      (reactive-set! x (* 2 a)))
+    (let ((a 3))
+      (set! a 2))
+    (if (zero? (modulo i 10))
+	(gc))))
+
+(define-macro (test a b)
+  ;(display a) (newline)
+  `(if (not (equal? ,a ,b))
+       (format *stderr* "~S -> ~S?~%" ',a ,b)))
+
+
+(test (let ((a 1) (b 2) (c 3)) (reactive-set! a (+ b c)) (set! b 4) (set! c 5) a) 9)
+(test (let ((a 1) (b 2) (c 3)) (reactive-set! b (+ c 4)) (reactive-set! a (+ b c)) (set! c 5) a) 14)
+(test (let ((expr 21) (symbol 1)) (reactive-set! expr (* symbol 2)) (set! symbol 3) expr) 6)
+(test (let ((a 21) (b 1)) (reactive-set! a (* b 2)) (set! b 3) a) 6)
+(test (let ((s 21) (v 1)) (reactive-set! s (* v 2)) (set! v 3) s) 6)
+(test (let ((a 21) (v 1)) (reactive-set! a (* v 2)) (set! v 3) a) 6)
+(test (let ((symbol 21) (nv 1)) (reactive-set! symbol (* nv 2)) (set! nv 3) symbol) 6)
+(test (let ((outer 0)) (let ((nv 21) (sym 1)) (let ((inner 1)) (reactive-set! nv (* sym 2)) (set! sym 3) nv))) 6)
+(test (let ((a 1) (b 2)) (reactive-set! b (+ a 4)) (let ((a 10)) (set! a (+ b 5)) (list a b))) '(10 5))
+(test (let ((a 1) (b 2)) (reactive-set! b (+ a 4)) (list (let ((b 10)) (set! a (+ b 5)) a) b)) '(15 19))
+
+(test (let ((a 1) (b 2) (c 3)) (reactive-set! b (+ c 4)) (let ((a 0)) (reactive-set! a (+ b c)) (set! c 5) a)) 14)
+(test (let ((a 1) (b 2) (c 3)) (reactive-set! a (reactive-set! b (+ c 4))) (list a b c)) '(7 7 3))
+(test (let ((a 1) (b 2) (c 3)) (reactive-set! a (+ 1 (reactive-set! b (+ c 4)))) (list a b c)) '(8 7 3))
+
+(test (let ((a 1) (x 0)) (reactive-set! x (* a 2)) (reactive-set! a (* x 2)) (set! x 2) a) 4)
+(test (let ((a 1)) (let ((b 0) (c 0)) (reactive-set! b (* a 2)) (reactive-set! c (* a 3)) (let ((x 0)) (reactive-set! x (+ a b c)) (set! a 2) x))) 12)
+(test (let ((x 0)) (let ((a 1)) (reactive-set! x (* 2 a)) (set! a 2)) x) 4)
+
+(test (let ((x 0) (a 1)) (reactive-set! x (+ a 1)) (reactive-set! a (+ x 2)) (set! a 3) (set! x 4) (list x a)) (list 4 6))
+(test (let ((x 0) (a 1) (b 0)) (reactive-set! x (+ a 2)) (let ((x 2)) (reactive-set! x (+ a 1)) (set! a 4) (set! b x)) (list x a b)) (list 6 4 5))
+(test (let ((x 0)) (reactive-set! x (* 3 2)) x) 6)
+(test (let ((x 0)) (reactive-set! x (* pi 2)) x) (* pi 2))
+(test (let ((x 0)) (let ((a 1)) (reactive-set! x a) (set! a 2)) x) 2)
+
+;;; (define-macro (with-setters vars . body) `(let-temporarily (,(map (lambda (var) `((setter ',var) #f)) vars)) ,@body))
+
+(let ((x 0))
+  (do ((i 0 (+ i 1)))
+      ((= i 100))
+    (let ((a 1))
+      (reactive-set! a (* 2 x))
+      (set! x 2)
+      (if (zero? (modulo i 10))
+	  (gc)))))
+
+(let ((x 0))
+  (do ((i 0 (+ i 1)))
+      ((= i 100))
+    (let ((a 1))
+      (reactive-set! x (* 2 a))
+      (set! a 2))))
+
+(test (let ((a 21) (b 1)) (set! (setter 'b) (lambda (x y) (* 2 y))) (reactive-set! a (* b 2)) (set! b 3) a) 6) ; old setter ignored
+(test (let ((a 21) (b 1)) (set! (setter 'b) (lambda (x y) (* 2 y))) (let ((b 2)) (reactive-set! a (* b 2)) (set! b 3) a)) 6)
+
+;; also place as generalized set: (reactive-set! (v 0) (* a 2)) -- does v get the setter?
+|#
+;;; --------------------------------------------------------------------------------
+
+(define-bacro (reactive-let vars/inits . body)
+  (with-let (inlet 'vars/inits vars/inits 
+		   'body body
+		   'e (outlet (curlet)))
+    (let ((vars (map car vars/inits))
+	  (inits (map cadr vars/inits)))
+      (let ((reacts (map (lambda (var init)
+			   `(let ((setters (gather-symbols ',init ,e () ())))
+			      (when (pair? setters)
+				(let ((expr (if (pair? ',init) (copy ',init :readable) ',init))
+				      (lt (curlet)))
+				  (let ((cp (slot ',var expr lt ,e)))
+				    (set! (setter ',var lt)
+					  (make-setter ',var lt () setters expr ,e))
+				    (for-each (lambda (s)
+						(unless (and (setter s)
+							     (defined? 'followers (funclet (setter s))))
+						  (set! (setter s) (make-setter s lt)))
+						(let ((setter-followers (let-ref (funclet (setter s)) 'followers)))
+						  (unless (member cp setter-followers slot-equal?)
+						    (let-set! (funclet (setter s))
+							      'followers
+							      (cons cp setter-followers)))))
+					      setters))))))
+			 vars inits)))
+	(cons 'let (cons vars/inits (append reacts body)))))))
+
+
+;;; --------------------------------------------------------------------------------
+#|
+  (test (reactive-let () 3) 3)
+  (test (let ((a 1)) (reactive-let ((b (+ a 1))) b)) 2)
+  (test (let ((a 1)) (+ (reactive-let ((b (+ a 1))) (set! a 3) b) a)) 7)
+  (test (let ((a 1)) (+ (reactive-let ((b (+ a 1)) (a 0)) (set! a 3) b) a)) 3)
+  (test (let ((a 1)) (reactive-let ((a 2) (b (* a 3))) (set! a 3) b)) 3)
+  (test (let ((a 1) (b 2)) (reactive-let ((a (* b 2)) (b (* a 3))) (set! a 3) b)) 3)
+  (test (let ((a 1) (b 2)) (reactive-let ((a (* b 2)) (b (* a 3))) (set! b 3) a)) 4)
+  (test (let ((a 1) (b 2)) (reactive-let ((a (* b 2))) (set! b 3) a)) 6)
+  (test (let ((a 1)) (reactive-let ((b (+ a 1))) (set! a 3) b)) 4)
+  (test (let ((a 1)) (reactive-let ((b (+ a 1)) (c (* a 2))) (set! a 3) (+ c b))) 10)
+  (test (let ((a 1) (d 2)) (reactive-let ((b (+ a d)) (c (* a d)) (d 0)) (set! a 3) (+ b c))) 11)
+  (test (let ((a 1) (d 2)) (reactive-let ((b (+ a d)) (c (* a d)) (d 0)) (set! a 3)) (setter 'a)) #f)
+  (test (let ((a 1) (d 2)) (reactive-let ((b (+ a d)) (c (* a d)) (d 0)) (set! a 3) (set! d 12) (+ b c))) 11)
+  (test (let ((a 1) (b 2)) (+ (reactive-let ((b (+ a 1)) (c (* b 2))) (set! a 3) (+ b c)) a b)) 13)  ;c=4 because it watches the outer b
+  (test (let ((a 1)) (reactive-let ((b (* a 2))) (reactive-let ((c (* a 3))) (set! a 2) (+ b c)))) 10)
+  (test (let ((a 1)) (reactive-let ((b (* a 2))) (let ((d (reactive-let ((c (* a 3))) c))) (set! a 2) (+ b d)))) 7)
+  (test (let ((a 1)) (reactive-let ((b (* a 2))) (+ (reactive-let ((c (* a 3))) c) (set! a 2) b))) 9) ; a=2 is added to b=4 and c=3
+  (test (let ((a 1)) (reactive-let ((b (+ a 1))) (reactive-let ((c (* b 2))) (begin (set! a 3) (+ c b))))) 12)
+  (test (reactive-let ((a (lambda (b) b))) (a 1)) 1)
+  (test (reactive-let ((a (let ((b 1) (c 2)) (+ b c)))) a) 3)
+  (test (let ((b 1)) (reactive-let ((a (let ((b 1) (c 2)) (+ b c))) (c (* b 2))) (set! b 43) c)) 86)
+  (test (let ((x 0.0)) (reactive-let ((y (sin x))) (set! x 1.0) y)) (sin 1.0))
+  (test (let ((a 1)) (reactive-let ((b a) (c a)) (set! a 3) (list b c))) '(3 3))
+  (test (let ((a 1)) (reactive-let ((b a)) (reactive-let ((c (* b a))) (set! a 3) (list b c)))) '(3 9))
+  (test (let ((a 1) (b 2)) (reactive-let ((c a) (d (* b a))) (set! a 3) (list a b c d))) '(3 2 3 6))
+  (test (let ((a 1)) (reactive-let ((b (* a 2)) (c (* a 3)) (d (* a 4))) (set! a 2) (list a b c d))) '(2 4 6 8))
+  (test (let ((b 2)) (reactive-let ((a (* b 2))) (+ (reactive-let ((a (* b 3))) (set! b 3) a) a))) 15)
+|#
+;;; --------------------------------------------------------------------------------
+
+(define-macro (reactive-let* vars . body)
+  (let add-let ((v vars))
+    (if (pair? v)
+	`(reactive-let ((,(caar v) ,(cadar v)))
+	   ,(add-let (cdr v)))
+	(cons 'begin body))))
+
+
+;;; --------------------------------------------------------------------------------
+#|
+  (test (let ((a 1)) (reactive-let* ((b a) (c (* b a))) (set! a 3) (list b c))) '(3 9))
+  (test (let ((a 1)) (reactive-let* ((b a) (x (+ a b))) (set! a 3) (list b x))) '(3 6))
+  (test (let ((x 0.0)) (reactive-let* ((y x) (z (* y (cos x)))) (set! x 1.0) z)) (cos 1.0))
+|#
+;;; --------------------------------------------------------------------------------
+
+#|
+(let ()
+  (define xyzzy (let ((x 0)) 
+		  (dilambda 
+		   (lambda () 
+		     x) 
+		   (lambda (val)
+		     (set! x val)))))
+  (let ((a 1)) 
+    (reactive-set! (xyzzy) (+ a 1))
+    (set! a 2)
+    (xyzzy))
+
+  (let ((a 1))
+    (reactive-set! a (+ (xyzzy) 1))
+    (set! (xyzzy) 2)
+    a)
+
+  (reactive-let ((a (+ (xyzzy) 1)))
+    (set! (xyzzy) 2)
+    a))
+
+;;; not different?:
+
+(let ((v (vector 1 2 3)))
+  (let ((a 1))
+    (reactive-set! (v 0) (+ a 1))
+    (set! a 2)
+    (v 0)))
+
+;;; but where to place the setter in either case -- on 'a and save the location, but then how to erase if reset?
+;;;   and how to ignore if xyzzy arg not the same?
+;;; insist that (f) f be a thunk/dilambda, and in the (set! (f)...) case, put the setter on the setter? (set! (setter (setter f)) ...)
+|#
diff --git a/s7/repl.c b/s7/repl.c
new file mode 100644
index 0000000..124a3d7
--- /dev/null
+++ b/s7/repl.c
@@ -0,0 +1,112 @@
+/* gcc -o repl repl.c s7.o -Wl,-export-dynamic -lm -I. -ldl */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#ifndef _MSC_VER
+  #include <errno.h>
+  #include <unistd.h>
+#endif
+
+#include "s7.h"
+
+#ifndef _MSC_VER
+static char *realdir(s7_scheme *sc, const char *filename)
+{
+  char *path;
+  char *p;
+
+  if (!strchr(filename, '/'))
+    {
+      if (access("libc_s7.so", F_OK) != 0)
+	{
+	  if ((access("libc.scm", F_OK) == 0) &&
+	      (access("cload.scm", F_OK) == 0))
+	    {
+	      s7_load(sc, "cload.scm");
+	      s7_load(sc, "libc.scm");
+	      return(NULL);
+	    }
+	  fprintf(stderr, "%s needs libc_s7.so (give the explicit repl pathname or build it by running: repl libc.scm)\n", filename); /* env PATH=/home/bil/cl repl */
+	  exit(2);
+	}
+      return(NULL);  /* we're in the libc_s7.so directory, I hope (user could start a version of s7 that does not match the local libc_s7.so...) */
+    }
+  if (!(path = realpath(filename, NULL)))
+    {
+      fprintf(stderr, "%s: %s\n", strerror(errno), filename);
+      exit(2);
+    }
+  if (!(p = strrchr(path, '/')))
+    {
+      free(path);
+      fprintf(stderr, "please provide the full pathname for %s\n", filename);
+      exit(2);
+    }
+  if (p > path) *p = '\0'; else p[1] = 0;
+  return(path);
+}
+#endif
+
+int main(int argc, char **argv)
+{
+  s7_scheme *sc;
+
+  sc = s7_init();
+  if (argc >= 2)
+    {
+      if (strcmp(argv[1], "-e") == 0)         /* repl -e '(+ 1 2)' */
+	{
+	  s7_pointer x;
+	  x = s7_eval_c_string(sc, argv[2]);
+	  fprintf(stdout, "%s\n", s7_object_to_c_string(sc, x));
+	  return(0);
+	}
+      if (strcmp(argv[1], "--version") == 0)
+	{
+	  fprintf(stdout, "s7: %s, %s\n", S7_VERSION, S7_DATE);
+	  return(0);
+	}
+      fprintf(stderr, "load %s\n", argv[1]);  /* repl test.scm */
+      errno = 0;
+      if (!s7_load(sc, argv[1]))
+	{
+	  fprintf(stderr, "%s: %s\n", strerror(errno), argv[1]);
+	  return(2);
+	}
+    }
+  else
+    {
+#ifdef _MSC_VER
+  while (true)
+    {
+      char buffer[512];
+      fprintf(stdout, "\n> ");
+      if (!fgets(buffer, 512, stdin)) break;  /* error or ctrl-D */
+      if (((buffer[0] != '\n') || (strlen(buffer) > 1)))
+	{
+	  char response[1024];
+	  snprintf(response, 1024, "(write %s)", buffer);
+	  s7_eval_c_string(sc, response);
+	}
+    }
+  fprintf(stdout, "\n");
+  if (ferror(stdin))
+    fprintf(stderr, "read error on stdin\n");
+#else
+#ifdef S7_LOAD_PATH
+      s7_add_to_load_path(sc, S7_LOAD_PATH);
+#else
+      char *dir; 
+      dir = realdir(sc, argv[0]);
+      if (dir)
+	{
+	  s7_add_to_load_path(sc, dir);
+	  free(dir);
+	}
+#endif
+      s7_repl(sc);
+#endif
+    }
+  return(0);
+}
diff --git a/s7/repl.scm b/s7/repl.scm
new file mode 100644
index 0000000..e9684f6
--- /dev/null
+++ b/s7/repl.scm
@@ -0,0 +1,1610 @@
+;;; a repl
+;;;
+;;; (load "repl.scm") ((*repl* 'run))
+
+(provide 'repl.scm)
+
+(when (= (*s7* 'print-length) 12)    ; old default value
+  (set! (*s7* 'print-length) 32))
+
+(when (file-exists? ".repl")         ; local (scheme) initialization file for repl
+  (load ".repl"))
+
+(set! (*s7* 'history-enabled) #f)
+
+(unless (defined? 'stderr-buffered)
+  (define stderr-buffered #f))
+
+(define (fformat port . args)
+  (apply format port args)
+  (when (and stderr-buffered
+	     (eq? port *stderr*))
+    (flush-output-port *stderr*)))
+
+(require libc.scm)
+
+(define old-debug (*s7* 'debug))
+(set! (*s7* 'debug) 0)
+
+(unless (defined? '*repl*)
+  (define *repl*                    ; environment that holds the REPL functions
+    (let ((prompt #f)               ; function to get/set prompt
+	  (keymap #f)               ; function to get/set keymap entries
+	  (history #f)              ; function to get/set history buffer entries
+	  (history-size #f)         ; function to get/set history buffer size
+	  (save-history #f)         ; function to save the current history buffer entries in a file
+	  (restore-history #f)      ; function to restore history buffer entries from a file
+	  (helpers ())              ; list of functions displaying help strings 
+	  (run #f)                  ; function that fires up a REPL
+	  (top-level-let (sublet (rootlet))) ; environment in which evaluation takes place
+	  (repl-let                 ; environment for keymap functions to access all the REPL innards (cursor-position etc)
+	   
+      (with-let (sublet *libc*)
+
+	;; -------- completion --------
+	(define (symbol-completion text)
+	  (let ((st (symbol-table))
+		(text-len (length text))
+		(match #f))
+	    (call-with-exit
+	     (lambda (return)
+	       (for-each
+		(lambda (par)
+		  (let* ((sym (symbol->string par))
+			 (sym-len (length sym)))
+		    (when (and (>= sym-len text-len)
+			       (string=? text (substring sym 0 text-len)))
+		      (if match
+			  ;; more than one match, save the longest text that all syms match
+			  (do ((min-len (min (string-length match) sym-len))
+			       (i text-len (+ i 1)))
+			      ((or (= i min-len)
+				   (not (char=? (match i) (sym i))))
+			       (if (= min-len text-len)
+				   (return text)
+				   (set! match (substring match 0 i)))))
+			  (set! match sym)))))
+		st)
+	       (or match text)))))
+	
+	(define (filename-completion text)
+	  (let ((g (glob.make)))
+	    (glob (string-append text "*")
+		  (logior (if (and (defined? 'GLOB_TILDE)
+				   (char=? (text 0) #\~))
+			      GLOB_TILDE
+			      0)
+			  GLOB_MARK)
+		  g)
+	    (let ((files (map (lambda (f) ; get rid of emacs' *~ files
+				(if (and (> (length f) 1)
+					 (char=? #\~ (f (- (length f) 1))))
+				    (values)
+				    f))
+			      (glob.gl_pathv g))))
+	      (globfree g) 
+	      (if (or (null? files)
+		      (not (null? (cdr files))))
+		  text
+		  (car files)))))
+	
+	
+	;; -------- history --------
+	(let ((histbuf (make-vector 100 ""))
+	      (histsize 100)
+	      (histpos 0)
+	      (m-p-pos 0)
+	      (histtop ()))
+
+	  (define push-line 
+	    (let ((histtail ()))
+	      (lambda (line)
+		(if (null? histtop)
+		    (begin
+		      (set! histtop (list (copy line)))
+		      (set! histtail histtop))
+		    (begin
+		      (set-cdr! histtail (list line))
+		      (set! histtail (cdr histtail)))))))
+
+	  (define (history-member line)
+	    (do ((i 0 (+ i 1)))
+		((or (= i histsize)
+		     (string=? (vector-ref histbuf i) line))
+		 (and (< i histsize) i))))
+	  
+	  (define history-size 
+	    (dilambda
+	     (lambda ()
+	       histsize)
+	     (lambda (new-size)
+	       (unless (= new-size histsize)
+		 (if (<= new-size 0)
+		     (error 'out-of-range "new history buffer size must be positive")
+		     (let ((new-hist (make-vector new-size ""))
+			   (new-end (min (- new-size 1) histpos)))
+		       (let loop ((oldpos histpos)
+				  (newpos new-end))
+			 (set! (new-hist newpos) (histbuf oldpos))
+			 (set! newpos (- (if (zero? newpos) new-size newpos) 1))
+			 (unless (= newpos new-end)
+			   (set! oldpos (- (if (zero? oldpos) histsize oldpos) 1))
+			   (unless (= oldpos histpos)
+			     (loop oldpos newpos))))
+		       (set! histsize new-size)
+		       (set! histpos new-end)
+		       (set! histbuf new-hist)
+		       new-size))))))
+	  
+	  (define (history back)
+	    (let ((i (+ histpos back)))
+	      (copy (histbuf (if (< i 0)
+				 (+ histsize i)
+				 (if (>= i histsize)
+				     (- i histsize)
+				     i))))))
+
+	  (define (set-history! new-line)
+	    (let ((pos (history-member new-line)))
+	      (when (integer? pos)                   ; remove the earlier case, circularly compress the buffer
+		(when (>= pos histpos)
+		  (do ((i pos (+ i 1)))
+		      ((>= i (- histsize 1)))
+		    (set! (histbuf i) (histbuf (+ i 1))))
+		  (set! (histbuf (- histsize 1)) (histbuf 0))
+		  (set! pos 0))
+		(do ((i pos (+ i 1)))
+		    ((>= i (- histpos 1)))
+		  (set! (histbuf i) (histbuf (+ i 1))))
+		(set! histpos (- histpos 1))))
+	    
+	    (set! (histbuf histpos) (copy new-line))
+	    (set! histpos (+ histpos 1))
+	    (if (= histpos histsize)
+		(set! histpos 0)))
+	  
+	  (define (history-help)
+	    (set! (*repl* 'helpers)
+		  (list
+		   (lambda (c) 
+		     (format #f "size: ~A, pos: ~A" histsize histpos))
+		   (lambda (c)
+		     (format #f "buf: ~A ~A ~A" (history -1) (history -2) (history -3)))
+		   (lambda (c)
+		     (format #f "line: ~A" histtop)))))
+	  
+	  (define (pop-history)            ; throw away most recent addition
+	    (set! histpos (- histpos 1))
+	    (if (negative? histpos)
+		(set! histpos (- histsize 1))))
+	  
+	  (define* (write-history port (spaces 0))
+	    (format port "~NC(set! histpos ~D)~%" spaces #\space histpos)
+	    (format port "~NC(set! histsize ~D)~%" spaces #\space histsize)
+	    (let-temporarily (((*s7* 'print-length) (* 2 histsize)))
+	      (format port "~NC(set! histbuf ~A)" spaces #\space histbuf)))
+	  
+	  (define* (save-history (file "repl-history.scm"))
+	    (call-with-output-file file
+	      write-history))
+	  
+	  (define* (restore-history (file "repl-history.scm"))
+	    (load file (curlet)))
+	  
+	  
+	  (let ((prompt-string "<1> ")     ; this doesn't look very good, but I can't find anything better
+		(prompt-length 4)          ;    perhaps the line number could go in the terminal's right margin?
+		(cur-line "")              ; current expression (can contain newlines)
+		(prev-line ())             ; for undo via C-_
+		(selection #f)             ; for C-y
+		(cursor-pos 0)             ; cursor-pos is the logical position (index into cur-line)
+		(cur-row 0)                ; catch window scrolling
+		(red-par-pos #f)           ; paren match position (index into cur-line)
+		(prompt-row 0)             ; need to tie everything to prompt position (it can move in media res if window scrolls)
+		(prompt-col 0)
+		(last-row 0)               ; these hold the window bounds when we start
+		(last-col 0)
+		(input-fd (fileno stdin))  ; source of chars, either tty input or file input
+		(terminal-fd (fileno stdin))
+		(tab-as-space (make-string 6 #\space))
+		(next-char #f)
+		(chars 0)                  ; (sigh) a kludge to try to distinguish tab-as-space from tab-as-completion/indentation
+		(unbound-case #f)
+		(all-done #f))             ; if #t, repl returns to its caller, if any
+	    
+	    
+	    ;; -------- evaluation ---------
+	    (define (badexpr h)            ; *missing-close-paren-hook* function for Enter command
+	      (let ((ow (owlet)))
+		(if (and (ow 'error-file)
+			 (not (equal? (ow 'error-file) "repl.scm")))
+		    (error 'syntax-error "missing close paren in ~S" (ow 'error-file))
+		    (set! (h 'result) 'string-read-error))))
+	    
+	    (define (shell? h)             ; *unbound-variable-hook* function, also for Enter
+	      ;; examine cur-line -- only call system if the unbound variable matches the first non-whitespace chars
+	      ;;   of cur-line, and command -v name returns 0 (indicating the shell thinks it is an executable command)
+	      (do ((i 0 (+ i 1)))
+		  ((or (= i (length cur-line))
+		       (not (char-whitespace? (cur-line i))))
+		   (let ((var-name (symbol->string (h 'variable))))
+		     (when (and (>= (- (length cur-line) i) (length var-name)) ; var-name might be unrelated to cur-line
+				(string=? var-name (substring cur-line i (+ i (length var-name))))
+				(zero? (system (string-append "command -v " var-name " >/dev/null"))))
+		       (set! unbound-case #t)
+		       (if (procedure? ((rootlet) 'system))
+			   (set! (h 'result) (((rootlet) 'system) cur-line #f))
+			   (set! (h 'result) #f)))))))
+	    
+	    (define new-eval 
+	      (let ((+documentation+ "this is the repl's eval replacement; its default is to use the repl's top-level-let.")
+		    (+signature+ '(values #t let?)))
+		(lambda (form . rest) ; use lambda (not lambda*) so we can handle forms like :key
+		  (let ((e (if (pair? rest) 
+			       (car rest)
+			       (*repl* 'top-level-let))))
+		    (let-temporarily (((hook-functions *unbound-variable-hook*) (list shell?)) ; so pwd et al will work
+				      ((*s7* 'history-enabled) #t))
+		      (eval form e))))))
+	    
+	    ;; -------- match parens --------
+	    (define check-parens
+	      (let ((char-constant? 
+		     (lambda (pos)
+		       (and (> pos 2)
+			    (char=? (cur-line (- pos 1)) #\\)
+			    (char=? (cur-line (- pos 2)) #\#)))))
+		(lambda ()
+		  (let ((endpos (- cursor-pos 1)))
+		    (if (or (<= cursor-pos 1)
+			    (not (char=? (cur-line endpos) #\)))      ; ")" on left of cursor
+			    (char-constant? endpos))                  ; it's not "#\)"
+			(if (number? red-par-pos)
+			    (set! red-par-pos #f))
+			(let ((oparens ())
+			      (new-red-pos #f))
+			  (do ((i 0 (+ i 1)))
+			      ((>= i endpos))
+			    (case (cur-line i)
+			      ((#\()
+			       (set! oparens (cons i oparens)))
+			      
+			      ((#\))
+			       (if (pair? oparens)
+				   (set! oparens (cdr oparens))))
+			      
+			      ((#\;)
+			       (do ((k (+ i 1) (+ k 1)))
+				   ((or (>= k endpos)
+					(char=? (cur-line k) #\newline))
+				    (set! i k)
+				    (if (>= i endpos)                   ; (f1 "(+ 1 3) should not show first paren as a match (similarly below)
+					(set! oparens ())))))
+			      
+			      ((#\")
+			       (do ((k (+ i 1) (+ k 1)))
+				   ((or (>= k endpos)
+					(and (char=? (cur-line k) #\")
+					     (not (char=? (cur-line (- k 1)) #\\))))
+				    (set! i k)
+				    (if (>= i endpos)
+					(set! oparens ())))))
+			      
+			      ((#\#)
+			       (if (char=? (cur-line (+ i 1)) #\|)
+				   (do ((k (+ i 1) (+ k 1)))
+				       ((or (>= k endpos)
+					    (and (char=? (cur-line k) #\|)
+						 (char=? (cur-line (+ k 1)) #\#)))
+					(set! i (+ k 1))
+					(if (>= i endpos)
+					    (set! oparens ()))))))))
+			  (if (pair? oparens)
+			      (set! new-red-pos (car oparens)))
+			  (unless (equal? new-red-pos red-par-pos)
+			    (set! red-par-pos (and (number? new-red-pos) new-red-pos)))))))))
+	    
+	    
+	    ;; -------- indentation --------
+	    (define (indent pos)
+	      (let ((old-red red-par-pos)
+		    (old-line (copy cur-line))
+		    (old-cursor cursor-pos))
+		(set! cur-line (string-append (substring cur-line 0 cursor-pos) ")"))
+		(set! cursor-pos (length cur-line))
+		(check-parens)
+		(set! cur-line old-line)
+		(set! cursor-pos old-cursor)
+		(when red-par-pos
+		(let ((new-red red-par-pos))
+		  (set! red-par-pos old-red)
+		  (let ((col 0))
+		    (do ((i 0 (+ i 1)))
+			((= i new-red))
+		      (set! col (if (char=? (cur-line i) #\newline) 0 (+ col 1))))
+		    (let ((spaces (let ((sym (do ((i (+ new-red 1) (+ i 1)))
+						 ((not (char-alphabetic? (cur-line i)))
+						  (substring cur-line (+ new-red 1) i)))))
+				    (+ col (if (member sym '("or" "and" "cond" "if"))
+					       (+ (length sym) 2)
+					       2)))))
+		      (if (= cursor-pos (length cur-line))
+			  (begin
+			    (set! cur-line (format #f "~A~NC" cur-line spaces #\space))
+			    (set! cursor-pos (length cur-line)))
+			  (begin
+			    (set! cur-line (format #f "~A~NC~A" 
+						   (substring cur-line 0 cursor-pos)
+						   spaces #\space
+						   (substring cur-line (+ cursor-pos 1))))
+			    (set! cursor-pos (+ cursor-pos spaces))))))))))
+	    
+	    
+	    ;; -------- prompt --------
+	    (define (original-prompt num)
+	      (set! prompt-string (format #f "<~D> " num))
+	      (set! prompt-length (length prompt-string)))
+	    
+	    
+	    ;; -------- vt100 --------
+	    (define (red text) (format #f "~C[31m~A~C[0m" #\escape text #\escape))  ; black=30, green=32, yellow=33, blue=34
+	    
+	    (define* (rgb text (r 0) (g 0) (b 0) all-colors)
+	      (format #f (if all-colors
+			     (values "~C[38;5;~Dm~A~C[0m" #\escape (+ 16 (* 36 (round (* r 5))) (* 6 (round (* g 5))) (round (* b 5))))
+			     (values "~C[~Dm~A~C[0m" #\escape (+ 30 (ash (round b) 2) (ash (round g) 1) (round r))))
+		      text #\escape))
+	    
+	    (define (move-cursor y x)
+	      (fformat *stderr* "~C[~D;~DH" #\escape y x))
+
+	    (define (cursor-coords)
+	      (let* ((c (string #\null #\null))
+		     (cc (string->c-pointer c))
+		     (terminal-fd (fileno stdin)))
+		(fformat *stderr* "~C[6n" #\escape)
+		(do ((b (read terminal-fd cc 1) (read terminal-fd cc 1)))
+		    ((char=? (string-ref c 0) #\escape)))
+		(read terminal-fd cc 1) 
+		(and (char=? (string-ref c 0) #\[)
+		     (let ((y 0)
+			   (x 0))
+		       (do ((b (read terminal-fd cc 1) (read terminal-fd cc 1)))
+			   ((not (char-numeric? (string-ref c 0))))
+			 (set! y (- (+ (* 10 y) (char->integer (string-ref c 0))) (char->integer #\0))))
+		       (and (char=? (string-ref c 0) #\;)
+			    (do ((b (read terminal-fd cc 1) (read terminal-fd cc 1)))
+				((not (char-numeric? (string-ref c 0)))
+				 (and (char=? (string-ref c 0) #\R)
+				      (cons x y)))
+			      (set! x (- (+ (* 10 x) (char->integer (string-ref c 0))) (char->integer #\0)))))))))
+	    
+	    (define (cursor-bounds)
+	      (let ((coords (cursor-coords)))
+		(set! prompt-col (car coords))
+		(set! prompt-row (cdr coords))
+		(move-cursor 4000 4000)
+		(let ((bounds (cursor-coords)))
+		  (move-cursor (cdr coords) (car coords))
+		  (set! last-col (car bounds))
+		  (set! last-row (cdr bounds)))))
+	    
+	    ;; to enable mouse click coords (in xterm anyway), (fformat *stderr* "~C[?9h" #\escape)
+	    ;;    disable: (fformat *stderr* "~C[?9l" #\escape)
+	    ;;    this is X10_MOUSE -- probably better to use SET_ANY_EVENT_MOUSE 1003
+	    ;; while enabled, mouse selection instead sends coords to repl (so it's annoying)
+	    ;;    also it's sticky!  exit repl does not clear this flag so mouse is effectively dead
+	    ;; upon click, we get ESC [ M b x y (b = button info, x/y are coords starting at 32=0 -- 6 chars received)
+	    ;; to trap C-C (define (sigcatch no) (tty-reset) (#_exit)) (if (equal? (signal SIGINT sigcatch) SIG_ERR) (#_exit))
+	    ;; to see click, add a meta-key for M
+	    ;; all this apparently only works in xterm, so I hesitate to build on it here.
+	    
+	    ;; -------- display --------
+	    (define (display-prompt)
+	      (fformat *stderr* "~A" prompt-string))
+	    
+	    (define (new-prompt)
+	      (set! cur-line "")
+	      (set! cursor-pos 0)
+	      (set! cur-row 0)
+	      (set! prev-line ())
+	      ((*repl* 'prompt) (+ (length histtop) 1))
+	      (display-prompt)
+	      (cursor-bounds))
+	    
+	    (define display-line 
+	      (let ((bold (lambda (text) 
+			    (format #f "~C[1m~A~C[0m" #\escape text #\escape))))
+		(lambda (start end)
+		  ;; if a line wraps, it will confuse the redisplay/cursor positioning code. so truncate the display
+		  (let ((line-len (- (+ end prompt-length 1) start)))
+		    (if (>= line-len last-col)
+			(set! end (- (+ start last-col) prompt-length 1))))
+		  
+		  (if (and (integer? red-par-pos)
+			   (<= start red-par-pos)
+			   (< red-par-pos end))
+		      (let-temporarily (((*s7* 'print-length) 10000))
+			(string-append
+			 (format #f (if (zero? start)
+					(values "~A" prompt-string)
+					(values "~NC" prompt-length #\space)))
+			 (format #f (if (= start red-par-pos)
+					(values "~A~A"
+						(bold (red "(")) 
+						(substring cur-line (+ start 1) end))
+					(values "~A~A~A"
+						(substring cur-line start red-par-pos) 
+						(bold (red "(")) 
+						(substring cur-line (+ red-par-pos 1) end))))))
+		      (format #f (if (zero? start)
+				     (values "~A~A" prompt-string (substring cur-line 0 end))
+				     (values "~NC~A" prompt-length #\space (substring cur-line start end))))))))
+	    
+	    (define (display-cursor)
+	      (do ((row 0)
+		   (start 0)
+		   (len (length cur-line))
+		   (i 0 (+ i 1)))
+		  ((or (= i len)
+		       (= i cursor-pos))
+		   (move-cursor (+ prompt-row row) (- (+ prompt-col cursor-pos) start)))
+		(when (char=? (cur-line i) #\newline)
+		  (set! row (+ row 1))
+		  (set! start (+ i 1)))))
+	    
+	    (define (display-lines)
+	      (move-cursor prompt-row 0)
+	      (fformat *stderr* "~C[J" #\escape)
+	      (let ((len (length cur-line))
+		    (new-line ""))
+		(do ((line-end 0)
+		     (i 0 (+ line-end 2)))
+		    ((> i len))
+		  (set! line-end (end-of-line i))
+		  (set! new-line (string-append new-line (display-line i (min (+ line-end 2) len)))))
+		(fformat *stderr* "~A" new-line)
+		(display-cursor)))
+	    
+	    ;; -------- keymap(s) --------
+	    (define meta-keymap-functions (make-vector 256))
+	    (define keymap-functions (make-vector 256 #f))
+	    
+	    (define keymap (dilambda
+			    (lambda (c)
+			      (cond ((char? c) 
+				     (vector-ref keymap-functions (char->integer c)))
+				    ((integer? c) 
+				     (vector-ref keymap-functions c))
+				    ((not (string? c))
+				     (error 'wrong-type-arg "keymap takes a character or string argument"))
+				    ((= (length c) 1) 
+				     (vector-ref keymap-functions (char->integer (c 0))))
+				    ((and (= (length c) 2)
+					  (char=? (c 0) #\escape))
+				     (vector-ref meta-keymap-functions (char->integer (c 1))))
+				    (else (lambda (c) #t))))
+			    (lambda (c f)
+			      (cond ((char? c) 
+				     (vector-set! keymap-functions (char->integer c) f))
+				    ((integer? c) 
+				     (vector-set! keymap-functions c f))
+				    ((not (string? c))
+				     (error 'wrong-type-arg "set! keymap takes a character or string first argument"))
+				    ((= (length c) 1)
+				     (vector-set! keymap-functions (char->integer (c 0)) f))
+				    ((and (= (length c) 2)
+					  (char=? (c 0) #\escape))
+				     (vector-set! meta-keymap-functions (char->integer (c 1)) f))))))
+	    
+	    (define C-a 1)     ; #\x01 etc
+	    (define C-b 2)
+	    (define C-d 4)
+	    (define C-e 5)
+	    (define C-f 6)
+	    (define C-h 8)
+	    (define C-k 11)
+	    (define C-l 12)
+					;(define C-m 13)    ; #\return -- Enter handles this case (crlf?)
+	    (define C-n 14)
+	    (define C-o 15)
+	    (define C-p 16)
+					;(define C-r 18)
+	    (define C-t 20)
+	    (define C-y 25)
+	    (define C-_ 31)
+	    (define Tab 9)
+	    (define Enter 10)           ; #\linefeed
+	    (define Backspace 127)
+	    (define Escape 27)          ; #\escape
+	    
+	    (define (end-of-line pos)             ; prompt or #\newline mark the line boundary
+	      (let ((len (length cur-line)))
+		(do ((i (max 0 (min pos len)) (+ i 1)))
+		    ((or (>= i len)
+			 (char=? (cur-line i) #\newline))
+		     (if (>= i len) len (max 0 (- i 1)))))))
+	    
+	    (define (start-of-line pos)
+	      (if (<= pos 0)
+		  0
+		  (do ((i (min pos (- (length cur-line) 1)) (- i 1)))
+		      ((or (zero? i)
+			   (char=? (cur-line i) #\newline))
+		       (if (zero? i) 0 (+ i 1))))))
+	    
+	    (define (append-newline)
+	      (set! cur-line (string-append cur-line (string #\space #\newline)))
+	      (set! cursor-pos (length cur-line))
+	      (when (= last-row (+ prompt-row cur-row))
+		(fformat *stderr* "~%")
+		(set! prompt-row (- prompt-row 1)))
+	      (set! cur-row (+ cur-row 1)))
+	    
+	    (define (word-break pos)                 ; assume we're at the start of a word
+	      (do ((len (length cur-line))
+		   (i pos (+ i 1)))
+		  ((or (>= i len) 
+		       (not (or (char-alphabetic? (cur-line i)) 
+				(char-numeric? (cur-line i)))))
+		   i)))
+	    
+	    (define (save-line)
+	      (set! prev-line (cons (cons cursor-pos (copy cur-line)) prev-line)))
+	    
+	    (let ((main-keyfunc (lambda (c)
+				  (if (<= chars 1) (save-line))
+				  (set! cur-line (if (= cursor-pos (length cur-line))
+						     (string-append cur-line (string c))
+						     (if (= cursor-pos 0)
+							 (string-append (string c) cur-line)
+							 (string-append 
+							  (substring cur-line 0 cursor-pos) 
+							  (string c) 
+							  (substring cur-line cursor-pos)))))
+				  (set! cursor-pos (+ cursor-pos 1))
+				  (set! m-p-pos 0)))
+		  (no-op-keyfunc (lambda (c) #t)))
+	      
+	      (do ((i 0 (+ i 1)))
+		  ((= i 32))
+		(vector-set! keymap-functions i no-op-keyfunc))
+	      
+	      (do ((i 32 (+ i 1)))
+		  ((= i 256))
+		(vector-set! keymap-functions i main-keyfunc))
+	      
+	      (do ((i 0 (+ i 1)))
+		  ((= i 256))
+		(vector-set! meta-keymap-functions i no-op-keyfunc)))
+	    
+	    
+	    ;; -------- cursor movement 
+	    (set! (keymap-functions C-a) 
+		  (lambda (c)
+		    (set! cursor-pos (start-of-line cursor-pos))
+		    'just-cursor))
+	    
+	    (set! (keymap-functions C-e) 
+		  (lambda (c)
+		    (set! cursor-pos (end-of-line cursor-pos))
+		    'just-cursor))
+	    
+	    (set! (keymap-functions C-b) 
+		  (lambda (c)
+		    (when (> cursor-pos 0)
+		      (set! cursor-pos (- cursor-pos 1))
+		      (if (char=? (cur-line cursor-pos) #\newline)
+			  (set! cursor-pos (- cursor-pos 1))))
+		    'just-cursor))
+	    
+	    (set! (keymap-functions C-f) 
+		  (lambda (c)
+		    (let ((len (length cur-line)))
+		      (when (< cursor-pos len)
+			(set! cursor-pos (+ cursor-pos 1))
+			(if (and (< cursor-pos len)
+				 (char=? (cur-line cursor-pos) #\newline))
+			    (set! cursor-pos (+ cursor-pos 1)))))
+		    'just-cursor))
+	    
+	    (set! (keymap-functions C-p) 
+		  (lambda (c)
+		    ;; try to find corresponding column in previous line
+		    (let ((start (start-of-line cursor-pos)))
+		      (when (positive? start)
+			(let ((upstart (start-of-line (- start 2)))
+			      (upend (end-of-line (- start 2)))
+			      (line-pos (- cursor-pos start)))
+			  (set! cursor-pos (min (+ upstart line-pos) upend)))))
+		    'just-cursor))
+	    
+	    (set! (keymap-functions C-n) 
+		  (lambda (c)
+		    ;; try to find corresponding column in next line
+		    (let ((start (start-of-line cursor-pos))
+			  (len (length cur-line))
+			  (next-start (+ (end-of-line cursor-pos) 1)))      ; should be at #\newline (if any)
+		      (if (> len next-start)                                ; not already at last line
+			  (let ((next-end (end-of-line (+ next-start 1)))
+				(line-pos (- cursor-pos start)))
+			    (set! cursor-pos (min (+ next-start 1 line-pos) next-end)))))
+		    'just-cursor))
+	    
+	    (set! (keymap-functions C-l) 
+		  (lambda (c)
+		    (fformat *stderr* "~C[H~C[J" #\escape #\escape)
+		    (new-prompt)))
+	    
+	    ;; -------- deletion
+	    (set! (keymap-functions C-d) 
+		  (lambda (c)
+		    (let ((len (length cur-line)))
+		      (when (< cursor-pos len)
+			(save-line)
+			(do ((i cursor-pos (+ i 1)))
+			    ((>= i (- len 1)))
+			  (set! (cur-line i) (cur-line (+ i 1))))
+			(set! cur-line (substring cur-line 0 (- len 1)))))))
+	    
+	    (set! (keymap-functions C-h) 
+		  (lambda (c)
+		    (when (positive? cursor-pos)
+		      (save-line)
+		      (let ((len (length cur-line)))
+			(set! cursor-pos (- cursor-pos 1))
+			(do ((i cursor-pos (+ i 1)))
+			    ((>= i (- len 1)))
+			  (set! (cur-line i) (cur-line (+ i 1))))
+			(set! cur-line (substring cur-line 0 (- len 1)))))))
+	    
+	    (set! (keymap-functions Backspace) 
+		  (keymap-functions C-h))
+	    
+	    (set! (keymap-functions C-k) 
+		  (lambda (c)
+		    (let ((len (length cur-line)))
+		      (when (< cursor-pos len)
+			(save-line)
+			(let ((end (end-of-line cursor-pos)))
+			  (if (= end len)
+			      (begin
+				(set! selection (substring cur-line cursor-pos))
+				(set! cur-line (substring cur-line 0 cursor-pos)))
+			      (if (or (= cursor-pos end)                            ; delete following newline
+				      (char=? (cur-line cursor-pos) #\newline))
+				  (set! cur-line (string-append (substring cur-line 0 cursor-pos)
+								(substring cur-line (+ cursor-pos 1))))
+				  (begin
+				    (set! selection (substring cur-line cursor-pos (+ end 1)))
+				    (set! cur-line (string-append (substring cur-line 0 cursor-pos)
+								  (substring cur-line (+ end 1))))
+				    ))))))))
+	    
+	    ;; -------- undo/selection
+	    (set! (keymap-functions C-y) 
+		  (lambda (c)
+		    (when selection
+		      (save-line)
+		      (set! cur-line (if (zero? cursor-pos)
+					 (string-append selection cur-line)
+					 (if (>= cursor-pos (length cur-line))
+					     (string-append cur-line selection)
+					     (string-append (substring cur-line 0 cursor-pos)
+							    selection
+							    (substring cur-line cursor-pos)))))
+		      (set! cursor-pos (+ cursor-pos (length selection))))))
+	    
+	    (set! (keymap-functions C-_) 
+		  (lambda (c)
+		    (when (pair? prev-line)
+		      (set! cur-line (cdar prev-line))
+		      (set! cursor-pos (caar prev-line))
+		      (set! prev-line (cdr prev-line)))))
+	    
+	    ;; -------- add newline
+	    (set! (keymap-functions C-o)
+		  (lambda (c)
+		    (set! cur-line (string-append (cond ((= cursor-pos 0) 
+							 (values (string #\space #\newline) 
+								 cur-line))
+
+							((>= cursor-pos (length cur-line)) 
+							 (values cur-line 
+								 (string #\space #\newline)))
+
+							((char=? (cur-line (- cursor-pos 1)) #\newline)
+							 (values (substring cur-line 0 cursor-pos)
+								 (string #\space #\newline)
+								 (substring cur-line cursor-pos)))
+
+							(else
+							 (values (substring cur-line 0 cursor-pos)
+								 (if (char=? (cur-line (+ cursor-pos 1)) #\newline)
+								     (string #\space #\newline #\space)
+								     (string #\space #\newline))
+								 (substring cur-line (+ cursor-pos 1)))))))
+		    (when (= last-row (+ prompt-row cur-row))
+		      (set! prompt-row (- prompt-row 1))
+		      (display-lines))))
+	    
+	    ;; -------- transpose
+	    (set! (keymap-functions C-t) 
+		  (lambda (c)
+		    (let ((end (end-of-line cursor-pos)))
+		      (save-line)
+		      (let ((cur (if (>= cursor-pos end)
+				     (- cursor-pos 1)
+				     cursor-pos)))
+			(if (positive? cur)
+			    (let ((tmp-c (cur-line (- cur 1))))
+			      (set! (cur-line (- cur 1)) (cur-line cur))
+			      (set! (cur-line cur) tmp-c)
+			      (set! cursor-pos (+ cur 1))))))))
+	    
+	    ;; -------- indentation/completion
+	    (set! (keymap-functions Tab) 
+		  (lambda (c)
+		    ;; if user pastes in a selection, it may have embedded tabs which are just spacing, 
+		    ;;   not requests for filename completion!  We'll try to catch this case by assuming
+		    ;;   that a selection will not be the single character #\tab
+		    (if (> chars 1)
+			(begin
+			  (set! cur-line (string-append cur-line "    "))
+			  (set! cursor-pos (+ cursor-pos 4)))
+			(let ((start (start-of-line cursor-pos))
+			      (end (end-of-line cursor-pos))
+			      (completion #f))
+			  (if (and (positive? start)
+				   (= end start))
+			      (indent start)
+			      (when (= cursor-pos end)
+				(let ((loc (do ((i (- end 1) (- i 1)))
+					       ((or (< i 0)
+						    (char-whitespace? (cur-line i))
+						    (memv (cur-line i) '(#\( #\' #\" #\))))
+						i))))
+				  (set! completion (if (< loc 0)
+						       (symbol-completion cur-line)
+						       ((if (char=? (cur-line loc) #\") filename-completion symbol-completion)
+							(substring cur-line (+ loc 1)))))
+				  (when (and completion
+					     (> (length completion) (- end loc 1)))
+				    (save-line)
+				    (set! cur-line (if (= end (length cur-line))
+						       (string-append (substring cur-line 0 (+ loc 1)) completion)
+						       (string-append (substring cur-line 0 (+ loc 1)) 
+								      completion
+								      (substring cur-line (+ end 1)))))
+				    (set! cursor-pos (end-of-line cursor-pos))))))))))
+	    
+	    ;; -------- evaluation/multiline
+	    (set! (keymap-functions Enter) 
+		  (lambda (c)
+		    
+		    (call-with-exit
+		     (lambda (return)
+		       (let ((len (length cur-line)))
+			 
+			 (do ((i 0 (+ i 1)))               ; check for just whitespace
+			     ((or (= i len)
+				  (not (char-whitespace? (cur-line i))))
+			      (when (= i len)
+				(append-newline)
+				(return))))
+			 
+			 (set! red-par-pos #f)
+			 (if (or (= chars 1) 
+				 (not (= input-fd terminal-fd)))
+			     (display-lines))
+			 
+			 (catch #t
+			   (lambda ()
+			     
+			     ;; we want to add cur-line (copied) to the history buffer
+			     ;;   unless it is an on-going edit (missing close paren)
+			     (catch 'string-read-error ; this matches (throw #t 5) -- is this correct?
+			       
+			       (lambda ()
+				 (set! cursor-pos len)
+				 (if (or (= chars 1)
+					 (not (= input-fd terminal-fd)))
+				     (display-lines))
+				 (set-history! cur-line)
+				 (set! m-p-pos 0)
+				 
+				 ;; get the newline out if the expression does not involve a read error
+				 (let-temporarily (((hook-functions *missing-close-paren-hook*) (list badexpr)))
+				   (let ((form (with-input-from-string cur-line #_read)))    ; not libc's read
+				     (newline *stderr*)
+				     (let ((val (list (new-eval form (*repl* 'top-level-let))))) ; list, not lambda -- confuses trace!
+				       (if (or (null? val)   ; try to trap (values) -> #<unspecified>
+					       (and (unspecified? (car val))
+						    (null? (cdr val))))
+					   (set! val #<unspecified>)
+					   (set! val (if (pair? (cdr val))
+							 (cons 'values val)
+							 (car val))))
+						 
+				       (if unbound-case
+					   (set! unbound-case #f)
+					   (fformat *stderr* "~S~%" val))
+				       (eval `(define ,(string->symbol (format #f "<~D>" (+ (length histtop) 1))) ',val) (rootlet))))))
+			       
+			       (lambda (type info)
+				 (if (eq? type 'string-read-error)
+				     (begin
+				       (pop-history)               ; remove last history entry
+				       (append-newline)
+				       (return))
+				     (apply throw type info)))))   ; re-raise error
+			   
+			   (lambda (type info)
+			     (with-let (unlet)
+			       (fformat *stderr* "~A:" (red "error"))
+			       (let ((op (*s7* 'print-length)))
+				 (if (< op 32) (set! (*s7* 'print-length) 32))
+				 (if (and (pair? info)
+					  (string? (car info)))
+				     (fformat *stderr* " ~A" (apply format #f info))
+				     (if (not (null? info))
+					 (fformat *stderr* " ~A" info)))
+				 (if (< op 32) (set! (*s7* 'print-length) op)))
+			       (eval `(define ,(string->symbol (format #f "<~D>" (+ (length histtop) 1))) 'error) (rootlet))
+			       (newline *stderr*))))
+			 
+			 (push-line (copy cur-line))
+			 (new-prompt))))))
+
+	    
+	    ;; -------- escaped (Meta/Alt/arrow) keys
+	    (set! (keymap-functions Escape) 
+		  (lambda (esc)
+		    (let ((chr (next-char)))
+		      ((meta-keymap-functions (char->integer chr)) chr))))
+	    
+	    (set! (meta-keymap-functions (char->integer #\[))
+		  (lambda (c)
+		    (let ((chr (next-char)))
+		      (case chr
+			((#\A) ((keymap-functions C-p) C-p))  ; arrow keys
+			((#\B) ((keymap-functions C-n) C-n))
+			((#\C) ((keymap-functions C-f) C-f))
+			((#\D) ((keymap-functions C-b) C-b))))))
+	    
+	    (let ()
+	      ;; Meta key is a problem on the Mac, so I'll package these for easier disposal
+
+	      (define fixup-new-line
+		(let ((count-newlines 
+		       (lambda (line)
+			 (do ((len (length line))
+			      (newlines 0)
+			      (i 0 (+ i 1)))
+			     ((= i len) newlines)
+			   (if (char=? (cur-line i) #\newline)
+			       (set! newlines (+ newlines 1)))))))
+		  (lambda ()
+		    (set! cursor-pos (length cur-line))
+		    (let ((newlines (count-newlines cur-line)))
+		      (when (< last-row (+ prompt-row newlines))
+			(fformat *stderr* "~NC" (- (+ prompt-row newlines) last-row) #\newline)
+			(set! prompt-row (- prompt-row newlines)))
+		      (set! cur-row newlines)))))
+
+	      (define (get-previous-line c)         ; get earlier line indexed by numeric arg
+		(let* ((len (length histtop))
+		       (pos (or (string->number cur-line) len)))
+		  (set! pos (min len (max pos 1)))
+		  (set! cur-line (copy (histtop (- pos 1))))
+		  (fixup-new-line)))
+	      
+	      (define (move-forward-in-history c)
+		(set! m-p-pos (min 0 (+ m-p-pos 1)))
+		(when (positive? (length (history m-p-pos)))
+		  (set! cur-line (history m-p-pos))
+		  (fixup-new-line)))
+	      
+	      (define (move-backward-in-history c)
+		(let ((old-index m-p-pos))
+		  (when (and (zero? m-p-pos) 
+			     (> (length cur-line) 0))
+		    (set-history! cur-line)
+		    (set! m-p-pos -1))
+		  (set! m-p-pos (max (- m-p-pos 1) (- histsize)))
+		  (if (positive? (length (history m-p-pos)))
+		      (begin
+			(set! cur-line (history m-p-pos))
+			(fixup-new-line))
+		      (set! m-p-pos old-index))))
+	      
+	      (define (go-to-start c)
+		(set! cursor-pos 0)
+		'just-cursor)
+	      
+	      (define (go-to-end c)
+		(set! cursor-pos (length cur-line))
+		'just-cursor)
+	      
+	      (define (capitalize c)
+		(let ((len (length cur-line)))
+		  (let loop ((i cursor-pos))
+		    (if (< i len)
+			(if (char-alphabetic? (cur-line i))
+			    (begin
+			      (save-line)
+			      (set! (cur-line i) (char-upcase (cur-line i)))
+			      (set! cursor-pos (word-break i)))
+			    (loop (+ i 1)))))))
+	      
+	      (define (upper-case c)
+		(do ((len (length cur-line))
+		     (i cursor-pos (+ i 1)))
+		    ((or (= i len)
+			 (char-alphabetic? (cur-line i)))
+		     (when (< i len)
+		       (save-line)
+		       (do ((k i (+ k 1)))
+			   ((or (= k len)
+				(not (char-alphabetic? (cur-line k))))
+			    (set! cursor-pos k))
+			 (set! (cur-line k) (char-upcase (cur-line k))))))))
+	      
+	      (define (lower-case c)
+		(do ((len (length cur-line))
+		     (i cursor-pos (+ i 1)))
+		    ((or (= i len)
+			 (char-alphabetic? (cur-line i)))
+		     (when (< i len)
+		       (save-line)
+		       (do ((k i (+ k 1)))
+			   ((or (= k len)
+				(not (char-alphabetic? (cur-line k))))
+			    (set! cursor-pos k))
+			 (set! (cur-line k) (char-downcase (cur-line k))))))))
+	      
+	      (set! (meta-keymap-functions (char->integer #\p)) move-backward-in-history)
+	      (set! (meta-keymap-functions (char->integer #\n)) move-forward-in-history)
+	      (set! (meta-keymap-functions (char->integer #\.)) get-previous-line)
+	      (set! (meta-keymap-functions (char->integer #\<)) go-to-start)
+	      (set! (meta-keymap-functions (char->integer #\>)) go-to-end)
+	      (set! (meta-keymap-functions (char->integer #\c)) capitalize)
+	      (set! (meta-keymap-functions (char->integer #\u)) upper-case)
+	      (set! (meta-keymap-functions (char->integer #\l)) lower-case))
+	    
+	    ;; -------- emacs --------
+	    (define (emacs-repl)
+	      ;; someday maybe use the language server protocol? (not our own rpc stuff or epc), for json, see json.scm 
+	      ;;   probably will need an argument/function for repl to open the channel or whatever
+	      ;; also this does not resend the entire expression after editing
+	      ;;   and does not notice in-place edits
+	      ;;   can <cr> get entire expr?
+	      (let ((buf (c-pointer->string (calloc 512 1) 512)))
+		(fformat *stderr* "> ")
+		(do ((b (fgets buf 512 stdin) (fgets buf 512 stdin)))
+		    ((zero? (length b))
+		     (#_exit))
+		  (let ((len (strlen buf)))
+		    (when (positive? len)
+		      (do ((i 0 (+ i 1)))
+			  ((or (not (char-whitespace? (buf i)))
+			       (= i len))
+			   (when (< i len)
+			     (let ((str (substring buf 0 (- (strlen buf) 1))))
+			       ;(fformat *stderr* "str: ~S~%" str)
+			       (catch #t
+				 (lambda ()
+				   (do ()
+				       ((= (string-length str) 0))
+				     (catch 'string-read-error
+				       (lambda ()
+					 (fformat *stderr* "~S~%> " (eval-string str (*repl* 'top-level-let)))
+					 (set! str ""))
+				       (lambda (type info)
+					 (fgets buf 512 stdin)
+					 (set! str (string-append str " " (substring buf 0 (- (strlen buf) 1))))))))
+				 (lambda (type info)
+				   (set! str "")
+				   (apply format *stderr* info)
+				   (fformat *stderr* "~%> "))))))))))))
+
+	    ;; -------- rxvt et al --------
+	    (define (terminal-repl file)		
+	      (let ((saved #f))
+		
+		;; we're in libc here, so exit is libc's exit!
+		(define (tty-reset)
+		  (tcsetattr terminal-fd TCSAFLUSH saved)
+		  (if (not (equal? input-fd terminal-fd)) (close input-fd))
+		  (#_exit))
+		
+		(varlet (*repl* 'top-level-let) 
+		  :exit (let ((+documentation+ "(exit) resets the repl tty and exits the repl"))
+			  (let-temporarily (((*s7* 'debug) 0))
+			    (lambda ()
+			      (newline *stderr*)
+			      (tty-reset)))))
+		
+		;; a "normal" terminal -- hopefully it accepts vt100 codes
+		(let ((buf (termios.make)))
+		  (let ((read-size 128))
+		    (set! next-char                                     ; this indirection is needed if user pastes the selection into the repl
+			  (let* ((c (make-string read-size #\null)) 
+				 (cc (string->c-pointer c))
+				 (ctr 0))
+			    (let-temporarily (((*s7* 'debug) 0))
+			    (lambda ()
+			      (call-with-exit
+			       (lambda (return)
+				 
+				 ;; if (< ctr chars), just send the next char in the buffer (90 lines down after (return #\null))
+				 ;;   otherwise call read again
+				 (when (>= ctr chars)
+				   (set! ctr 0)
+				   (set! chars (read input-fd cc read-size))
+				   (if (= chars 0)
+				       (tty-reset))
+				   
+				   (when (> chars (- last-col prompt-length 12))
+				     (let ((str (substring c 0 chars)))
+				       
+				       (when (= chars read-size)
+					 ;; concatenate buffers until we get the entire selection
+					 (let reading ((num (read input-fd cc read-size)))
+					   (set! str (string-append str (substring c 0 num)))
+					   (set! chars (+ chars num))
+					   (if (= num read-size)
+					       (reading (read input-fd cc read-size)))))
+				       
+				       ;; look for simple cut/paste -- no control chars etc
+				       (when (= input-fd terminal-fd)
+					 (do ((bcksp #\delete)
+					      (ok-chars (list #\newline #\linefeed #\return #\tab))
+					      (i 0 (+ i 1)))
+					     ((or (= i chars)
+						  (char>=? (str i) bcksp)
+						  (and (char<? (str i) #\space)
+						       (not (memv (str i) ok-chars))))
+					      
+					      (when (= i chars)
+						(let ((search-chars (string #\tab #\return #\newline))
+						      (old-pos 0)
+						      (start 0)
+						      (max-cols 0))
+						  (do ((pos (char-position search-chars str 0) (char-position search-chars str (+ pos 1))))
+						      ((not pos))
+						    (set! cur-line (string-append cur-line 
+										  (substring str old-pos pos)
+										  (if (char=? (str pos) #\tab) 
+										      tab-as-space 
+										      (string #\space #\newline))))
+						    (set! old-pos (+ pos 1))
+						    (unless (char=? (str pos) #\tab)
+						      (set! max-cols (max max-cols (- pos start)))
+						      (set! start pos)))
+						  (when (< (+ old-pos 1) (length str))
+						    (set! cur-line (if (zero? old-pos)
+								       (copy str)
+								       (string-append cur-line (substring str (+ old-pos 1))))))
+						  
+						  ;; if the line is too long, the cursor gets confused, so try to reformat long strings
+						  ;;    this still messes up sometimes
+						  (when (> max-cols (- last-col prompt-length))
+						    (let-temporarily ((((funclet pretty-print) '*pretty-print-length*) (- last-col prompt-length 12)))
+						      (set! ((funclet pretty-print) '*pretty-print-length*) (- last-col prompt-length 12))
+						      (set! cur-line (with-output-to-string
+								       (lambda ()
+									 (pretty-print (with-input-from-string cur-line #_read))))))))
+						;; this is still bad if the code has a long string -- need to tell pretty print to break it as well
+						
+						(set! cursor-pos (length cur-line))
+						(set! chars 0)
+						(set! ctr 1)
+						(display-lines)
+						(return #\newline)))))
+				       ;; now the pasted-in line has inserted newlines, we hope
+				       
+				       (set! c str)
+				       (set! cc (string->c-pointer c))
+				       
+				       ;; avoid time-consuming redisplays.  We need to use a recursive call on next-char here
+				       ;;   since we might have multi-char commands (embedded #\escape -> meta, etc)
+				       ;; actually, the time is not the repl's fault -- xterm seems to be waiting
+				       ;;   for the window manager or someone to poke it -- if I move the mouse,
+				       ;;   I get immediate output.  I also get immediate output in any case in OSX.
+				       ;;   valgrind and ps say we're not computing, we're just sitting there.
+				       
+				       (catch #t
+					 (lambda ()
+					   (do ((ch (next-char) (next-char)))
+					       ((= ctr (- chars 1)) 
+						(set! chars 0)
+						(display-lines)
+						(return ch))
+					     ((keymap-functions (char->integer ch)) ch)))
+					 
+					 (lambda (type info)
+					   (set! chars 0)
+					   ;(move-cursor prompt-row prompt-col)
+					   (fformat *stderr* "internal error: ")
+					   (apply format *stderr* info)
+					   (fformat *stderr* "~%line ~A: ~A~%" ((owlet) 'error-line) ((owlet) 'error-code))
+					   (set! chars 0)
+					   (set! ctr 0)
+					   (new-prompt)
+					   (return #\null))))))
+				 
+				 ;; send out the next char
+				 (let ((result (c ctr)))
+				   (set! ctr (+ ctr 1))
+				   result)))))))
+
+		  (set! input-fd (if (not file) 
+				     terminal-fd
+				     (open file O_RDONLY 0)))
+		  
+		  (set! saved (termios.make))
+		  (tcgetattr terminal-fd saved) 
+		  
+		  (tcgetattr terminal-fd buf)
+		  (termios.set_c_lflag buf (logand (termios.c_lflag buf) (lognot (logior ECHO ICANON))))
+		  (termios.set_c_cc buf VMIN 1)
+		  (termios.set_c_cc buf VTIME 0)
+		  (when (negative? (tcsetattr terminal-fd TCSAFLUSH buf))
+		    (tty-reset))
+		  
+		  (display-prompt)
+		  (cursor-bounds)
+		  ;; (debug-help)
+		  ;; (history-help)
+		  
+		  (do () 
+		      (all-done
+		       (set! all-done #f))       ; clear for next call
+		    (catch #t
+		      (lambda ()
+			(let ((chr (next-char)))
+			  (let ((res ((keymap-functions (char->integer chr)) chr))
+				(last-pos red-par-pos))
+			    (check-parens)
+			    (if (or last-pos red-par-pos 
+				    (not (eq? res 'just-cursor)))
+				(display-lines)
+				(display-cursor)))
+			  (help chr)))
+		      
+		      (lambda (type info)
+			;(move-cursor prompt-row prompt-col)
+			(fformat *stderr* "internal error: ")
+			(apply format *stderr* info)
+			(fformat *stderr* "~%line ~A: ~A~%" ((owlet) 'error-line) ((owlet) 'error-code))
+			(set! chars 0)
+			(new-prompt))))))))
+
+	    (define* (run file)
+	      ;(when (*s7* 'history-enabled) (fill! (*s7* 'history) ()))
+	      (let-temporarily (((*s7* 'history-enabled) #f))
+		;; check for dumb terminal
+		(if (or (zero? (isatty terminal-fd))        ; not a terminal -- input from pipe probably
+			(string=? (getenv "TERM") "dumb"))  ; no vt100 codes -- emacs subjob for example
+		    (emacs-repl)                            ; TODO: restore support for the pipe case
+		    (terminal-repl file))))
+
+	    (curlet))))))
+      
+      (define* (save-repl (file "save.repl"))
+	;; ((*repl* 'save-repl))
+	(call-with-output-file file
+	  (lambda (p) 
+	    (format p ";;; save-repl ~A~%~%" 
+		    (with-let (sublet *libc*)
+		      (let ((timestr (make-string 128))) 
+			(let ((len (strftime timestr 128 "%a %d-%b-%Y %H:%M:%S %Z"
+					     (localtime 
+					      (time.make (time (c-pointer 0 'time_t*)))))))
+			  (substring timestr 0 len)))))
+	    (format p "(for-each~%~NC~
+                         (lambda (f)~%~NC~
+                           (if (not (provided? f))~%~NC~
+                               (let ((autofile (*autoload* f)))~%~NC~
+                                 (if (and autofile (file-exists? autofile))~%~NC(load autofile)))))~%~NC~W)~%~%" 
+		    2 #\space 4 #\space 8 #\space 10 #\space 14 #\space 2 #\space
+		    *features*)
+	    (format p "(with-let (*repl* 'repl-let)~%")
+	    (((*repl* 'repl-let) 'write-history) p 2)
+	    (format p ")~%~%")
+	    (for-each (lambda (var)
+			(unless (eq? (car var) 'exit)
+			  (format p "(define ~S ~W)~%" (car var) (cdr var))))
+		      (*repl* 'top-level-let)))))
+      
+      (define* (restore-repl (file "save.repl"))
+	(set! (*repl* 'top-level-let) (sublet (rootlet)))
+	(load file))
+      ;; I think this could be a merge rather than a reset by using (with-let top-level-let (load ...))
+      
+      (set! keymap (repl-let 'keymap))
+      (set! history (repl-let 'history))
+      (set! history-size (repl-let 'history-size))
+      (set! save-history (repl-let 'save-history))
+      (set! restore-history (repl-let 'restore-history))
+      (set! prompt (repl-let 'original-prompt))
+      (set! run (repl-let 'run))
+      
+      (curlet))))
+
+;; ((*repl* 'run))
+(set! (*s7* 'debug) old-debug)
+
+
+;;; --------------------------------------------------------------------------------
+
+(define drop-into-repl
+  (let ((depth 0))
+    (lambda (call e)
+      (let ((C-q (integer->char 17)))      ; C-q to exit repl
+	(let-temporarily ((((*repl* 'keymap) C-q) (let-temporarily (((*s7* 'debug) 0)) 
+						    (lambda (c)
+						      (set! depth (- depth 1))
+						      (set! ((*repl* 'repl-let) 'all-done) #t))))
+			  ((*repl* 'top-level-let) e)
+			  ((*repl* 'prompt) (let-temporarily (((*s7* 'debug) 0)) 
+					      (lambda (num) 
+						(with-let (sublet (*repl* 'repl-let) :depth depth)
+						  (set! prompt-string (format #f "break~NC " depth #\>))
+						  (set! prompt-length (length prompt-string)))))))
+	  (set! depth (+ depth 1))
+	  (with-let (sublet (*repl* 'repl-let) :depth depth)
+	    (set! cur-line "")
+	    (set! red-par-pos #f)
+	    (set! cursor-pos 0)
+	    (set! prompt-string (format #f "break~NC " depth #\>))
+	    (set! prompt-length (length prompt-string)))
+	  (fformat *stderr* "break: ~A, C-q to exit break~%" call)
+	  ((*repl* 'run)))))))
+
+(define (debug.scm-init)
+  (set! ((funclet trace-in) '*debug-repl*) drop-into-repl))
+
+#|
+(define (open-file-with-catch filename)
+  (catch 'io-error ; is this correct?
+    (lambda ()
+      (open-input-file filename))
+    (lambda (type info)
+      (let ((new-filename #f)
+	    (err ((*libc* 'errno)))) ; get libc error indication (might be disk full or no write permission etc)
+	(drop-into-repl (format #f "can't open ~S, ~S" filename ((*libc* 'strerror) err)) (curlet))
+	(and new-filename
+	     (open-file-with-catch new-filename))))))
+|#
+
+(autoload 'lint "lint.scm")
+(autoload 'pretty-print "write.scm")
+(autoload '*libm* "libm.scm")
+(autoload '*libgsl* "libgsl.scm")
+(autoload 'trace "debug.scm")
+(autoload 'untrace "debug.scm")
+(autoload 'break "debug.scm")
+(autoload 'unbreak "debug.scm")
+(autoload 'watch "debug.scm")
+(autoload 'unwatch "debug.scm")
+(autoload 'ow! "stuff.scm")
+
+#|
+(define pwd
+  (let ((pd (lambda args
+	      ((*libc* 'getcwd) 
+	       (make-string 256 #\null) 256))))
+    (openlet (inlet 'object->string pd          ; pwd (repl calls object->string)
+		    'let-ref-fallback pd))))    ; (pwd) (repl calls let-ref-fallback method)
+;; > pwd
+;; /home/bil/cl
+
+(define date
+  (let ((pd (lambda args
+	      (with-let (sublet *libc*)
+		(let ((timestr (make-string 128))) 
+		  (let ((len (strftime timestr 128 "%a %d-%b-%Y %H:%M:%S %Z"
+				       (localtime 
+					(time.make (time (c-pointer 0 'time_t*)))))))
+		    (substring timestr 0 len)))))))
+    (openlet (inlet 'object->string pd 'let-ref-fallback pd))))
+|#
+
+;; cd needs to be implemented
+(define cd
+  (openlet (inlet 'object->string (lambda args
+				    (let ((line ((*repl* 'repl-let) 'cur-line)))
+				      ((*libc* 'chdir)
+				       (do ((i 3 (+ i 1)))
+					   ((or (not (char-whitespace? (line i)))
+						(= i (length line)))
+					    (substring ((*repl* 'repl-let) 'cur-line) i))))
+				      ((*libc* 'getcwd) (make-string 256 #\null) 256)))
+		  'let-ref-fallback (lambda (obj str)  ; let-ref-fallback's first arg will be cd: (cd "..")
+				      ((*libc* 'chdir) str)
+				      ((*libc* 'getcwd) (make-string 256 #\null) 256)))))
+;; > cd ..
+;; /home/bil
+;; > cd cl
+;; /home/bil/cl
+
+#|
+(define-macro (make-command name)
+  `(define ,name
+     (openlet 
+      (inlet 'object->string (lambda args
+			       (system ((*repl* 'repl-let) 'cur-line) #t))))))
+;; (make-command ls)
+
+(define-macro (time expr)
+  (let ((start (gensym)))
+    `(let ((,start ((*libc* 'gettimeofday))))
+       ,expr
+       (let ((end ((*libc* 'gettimeofday))))
+	 (+ (- (car end) (car ,start)) ; seconds
+	    (* 0.000001 (- (cadr end) (cadr ,start))))))))
+|#
+
+(define-macro (time expr) 
+  `(let ((start (*s7* 'cpu-time)))
+     ,expr 
+     (- (*s7* 'cpu-time) start)))
+
+(define apropos ; this misses syntax names (they aren't in rootlet)
+  (let ((levenshtein 
+	 (lambda (s1 s2)
+	   (let ((L1 (length s1))
+		 (L2 (length s2)))
+	     (cond ((zero? L1) L2)
+		   ((zero? L2) L1)
+		   (else (let ((distance (make-vector (list (+ L2 1) (+ L1 1)) 0)))
+			   (do ((i 0 (+ i 1)))
+			       ((> i L1))
+			     (set! (distance 0 i) i))
+			   (do ((i 0 (+ i 1)))
+			       ((> i L2))
+			     (set! (distance i 0) i))
+			   (do ((i 1 (+ i 1)))
+			       ((> i L2))
+			     (do ((j 1 (+ j 1)))
+				 ((> j L1))
+			       (let ((c1 (+ (distance i (- j 1)) 1))
+				     (c2 (+ (distance (- i 1) j) 1))
+				     (c3 (if (char=? (s2 (- i 1)) (s1 (- j 1)))
+					     (distance (- i 1) (- j 1))
+					     (+ (distance (- i 1) (- j 1)) 1))))
+				 (set! (distance i j) (min c1 c2 c3)))))
+			   (distance L2 L1)))))))
+	
+	(make-full-let-iterator             ; walk the entire let chain
+	 (lambda* (lt (stop (rootlet))) 
+	   (if (eq? stop lt)
+	       (make-iterator lt)
+	       (letrec ((iterloop 
+			 (let ((iter (make-iterator lt))
+			       (+iterator+ #t))
+			   (lambda ()
+			     (let ((result (iter)))
+			       (if (and (eof-object? result)
+					(iterator-at-end? iter)
+					(not (eq? stop (iterator-sequence iter))))
+				   (begin 
+				     (set! iter (make-iterator (outlet (iterator-sequence iter))))
+				     (iterloop))
+				   result))))))
+		 (make-iterator iterloop))))))
+    
+    (lambda* (name (e (*repl* 'top-level-let)))
+      (let ((ap-name (if (string? name) name 
+			 (if (symbol? name) 
+			     (symbol->string name)
+			     (error 'wrong-type-arg "apropos argument 1 should be a string or a symbol"))))
+	    (ap-env (if (let? e) e 
+			(error 'wrong-type-arg "apropos argument 2 should be an environment"))))
+	(let ((strs ())
+	      (min2 (floor (log (length ap-name) 2)))
+	      (have-orange (string=? ((*libc* 'getenv) "TERM") "xterm-256color")))
+	  (for-each
+	   (lambda (binding)
+	     (if (pair? binding)
+		 (let ((symbol-name (symbol->string (car binding))))
+		   (if (string-position ap-name symbol-name)
+		       (set! strs (cons (cons binding 0) strs))
+		       (let ((distance (levenshtein ap-name symbol-name)))
+			 (if (< distance min2)
+			     (set! strs (cons (cons binding distance) strs))))))))
+	   (make-full-let-iterator ap-env))
+	  
+	  (if (not (pair? strs))
+	      'no-match
+	      (begin
+		(for-each (lambda (b)
+			    (fformat *stderr*
+				    (if (zero? (cdr b)) "~C[1m~A~C[0m: ~S~%"                           ; black if exact match somewhere
+					(if (or (< (cdr b) 2) (not have-orange)) "~C[31m~A~C[0m: ~S~%" ; red for near miss
+					    "~C[38;5;208m~A~C[0m: ~S~%"))                              ; orange for less likely choices
+				    #\escape (caar b) #\escape
+				    (if (procedure? (cdar b))
+					(let ((doc (documentation (cdar b)))) ; returns "" if no doc
+					  (if (positive? (length doc))
+					      doc
+					      'procedure))
+					(cdar b))))
+			  (sort! strs (lambda (a b)
+					(string<? (symbol->string (caar a)) (symbol->string (caar b))))))
+		'----)))))))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; just a first stab at this -- where to put this code?
+;;;
+
+(define-expansion (repl-debug)
+  `(with-let (inlet :orig (curlet) :line ,(port-line-number) :func (*function*))
+     (format () "line ~D: ~A~{~^ ~A~}~%" 
+	     line (if (pair? func) (car func) func)
+	     (reverse
+	      (map (lambda (slot)
+		     (format #f "~%    ~S: ~A" 
+			     (car slot) 
+			     (let ((val (object->string (cdr slot) #f)))
+			       (if (> (length val) 60)
+				   (string-append (substring val 0 60) "...")
+				   val))))
+		   orig)))
+
+     (let ((C-q (integer->char 17)))
+       (let ((old-C-q ((*repl* 'keymap) C-q))
+	     (old-top-level (*repl* 'top-level-let))
+	     (old-prompt-string ((*repl* 'repl-let) 'prompt-string))
+	     (old-prompt (*repl* 'prompt)))
+
+	 (dynamic-wind
+	     (lambda ()
+	       (set! (*repl* 'top-level-let) orig)
+	       (with-let (*repl* 'repl-let)
+		 (set! cur-line "")
+		 (set! red-par-pos #f)
+		 (set! cursor-pos 0)
+		 (set! prompt-string (format #f "<debug ~D> " (+ (length histtop) 1)))
+		 (set! prompt-length (length prompt-string)))
+	       (with-let *repl*
+		 (set! prompt (lambda (num) 
+				(with-let (sublet repl-let :num num)
+				  (set! prompt-string (format #f "<debug ~D> " num))
+				  (set! prompt-length (length prompt-string)))))
+		 (set! (keymap (integer->char 17))
+		       (lambda (c)
+			 (set! (repl-let 'all-done) #t)))))
+
+	     (lambda ()
+	       ((*repl* 'run)))
+
+	     (lambda ()
+	       (set! (*repl* 'top-level-let) old-top-level)
+	       (set! ((*repl* 'repl-let) 'prompt-string) old-prompt)
+	       (set! ((*repl* 'repl-let) 'prompt-length) (length old-prompt))
+	       (set! (*repl* 'prompt) old-prompt)
+	       (set! ((*repl* 'keymap) C-q) old-C-q)))))))
+
+
+;;; to display a variable's value as s7 runs using the repl help window:
+;;;    (define xyz 1) ; some variable...
+;;;    (set! (setter 'xyz) (lambda (sym val) (set! (*repl* 'helpers) (list (lambda (c) (format #f "xyz: ~S" val)))) val))
+
+
+;;; --------------------------------------------------------------------------------
+#|
+to work in a particular environment:
+    (set! (*repl* 'top-level-let) (sublet (rootlet))) ; or any other like *libc*
+now (define g 43) puts g in the new top-level-let, so ((rootlet) 'g) -> #<undefined>, and ((*repl* 'top-level-let) 'g) -> 43 (= g in repl of course)
+to start with a fresh top-level, just set top-level-let to (sublet (rootlet)) again.
+
+to add/change keymap entry (using sublet here to protect against inadvertent changes to the repl).
+    (set! ((*repl* 'keymap) (integer->char 17)) ; C-q to quit and return to caller
+          (lambda (c)
+	    (set! ((*repl* 'repl-let) 'all-done) #t)))
+
+(set! ((*repl* 'keymap) (integer->char 12)) ; C-l will expand to "(lambda " at the cursor
+      (lambda (c)
+	(with-let (sublet (*repl* 'repl-let))
+	  (if (zero? cursor-pos)
+	      (set! cur-line (string-append "(lambda " cur-line))
+	      (if (>= cursor-pos (length cur-line))
+		  (set! cur-line (string-append cur-line "(lambda "))
+		  (set! cur-line (string-append (substring cur-line 0 cursor-pos)
+						"(lambda "
+						(substring cur-line cursor-pos)))))
+	  (set! cursor-pos (+ cursor-pos (length "(lambda "))))))
+
+change the prompt:
+(set! (*repl* 'prompt) (lambda (num) 
+			 (with-let (*repl* 'repl-let)
+			   (set! prompt-string "scheme> ") 
+			   (set! prompt-length (length prompt-string)))))
+
+red lambda prompt: 
+(set! (*repl* 'prompt)
+      (lambda (num)
+	(with-let (*repl* 'repl-let)
+	  (set! prompt-string (bold (red (string #\xce #\xbb #\> #\space))))
+	  (set! prompt-length 3)))) ; until we get unicode length calc
+
+
+to post a help string (kinda tedious, but the helper list is aimed more at posting variable values):
+(set! (*repl* 'helpers)
+      (list (lambda (c)
+	      (let ((sym (with-let (sublet (*repl* 'repl-let))
+			   (let ((len (length cur-line)))
+			     (let loop ((i (min (- len 1) cursor-pos)))
+			       (and (not (negative? i))
+				    (if (char=? (cur-line i) #\()
+					(let loop1 ((k (+ i 1)))
+					  (and (< k len)
+					       (if (not (char-alphabetic? (cur-line k)))
+						   (and (> k (+ i 1))
+							(string->symbol (substring cur-line (+ i 1) k)))
+						   (loop1 (+ k 1)))))
+					(loop (- i 1)))))))))
+		(if sym
+		    (let ((str (help sym)))
+		      (if str
+			  (substring (help sym) 0 (min (length str) 40))
+			  ""))
+		    "")))))
+
+;; function keys:
+(set! ((*repl* 'keymap) (string #\escape #\[))
+      (lambda (c)
+	(with-let (sublet (*repl* 'repl-let))
+	  (let ((next (next-char)))
+	    (case next
+	      ((#\A) ((keymap-functions C-p) C-p))
+	      ((#\B) ((keymap-functions C-n) C-n))
+	      ((#\C) ((keymap-functions C-f) C-f))
+	      ((#\D) ((keymap-functions C-b) C-b))
+	      ((#\1) ; on my system F1 is esc [ 1 1 ~, F2 esc [ 1 2 ~, etc (but they skip F6?)
+	       (let ((n (- (char->integer (next-char)) (char->integer #\0))))
+		 (next-char) ; throw away the tilde
+		 (set! cur-line (string-append cur-line (format #f "--F~D!--" n))))))))))
+
+;; this actually works but doesn't echo the filename correctly and the cursor is off during the filename processing
+(set! ((*repl* 'keymap) (integer->char 24)) ; C-x
+      (lambda (c)
+	(with-let (sublet (*repl* 'repl-let))
+	  (let ((next (next-char)))
+	    (when (char=? next (integer->char 6)) ; C-f
+	      (fformat *stderr* "~%load: ")
+	      ;; now recursive call: prompt="load: "
+	      (let ((old-prompt (*repl* 'prompt))
+		    (old-cur-line cur-line)
+		    (old-cursor-pos cursor-pos)
+		    (old-enter-func (keymap-functions 10))
+		    (filename #f))
+		(set! (*repl* 'prompt) (lambda (num) 
+					 (with-let (*repl* 'repl-let)
+					   (set! prompt-string "load: ")
+					   (set! prompt-length 6))))
+		(set! cur-line "")
+		(set! cursor-pos 0)
+		(set! (keymap-functions 10) (lambda (c)
+					      (set! filename cur-line)
+					      (set! (*repl* 'prompt) old-prompt)
+					      (set! cur-line old-cur-line)
+					      (set! cursor-pos old-cursor-pos)
+					      (set! (keymap-functions 10) old-enter-func)))
+		(do ((c (next-char) (next-char)))
+		    ((string? filename))
+		  ((keymap-functions (char->integer c)) c)
+		  (display-lines))
+		(load filename)))))))
+
+|#
+
+;; unicode someday: I think all we need is unicode_string_length and index into unicode string (set/ref)
+;; scroll past top line?
+
+*repl*
diff --git a/s7/s7.c b/s7/s7.c
new file mode 100644
index 0000000..861b8c6
--- /dev/null
+++ b/s7/s7.c
@@ -0,0 +1,98766 @@
+/* s7, a Scheme interpreter
+ *
+ *   derived from TinyScheme 1.39, but not a single byte of that code remains
+ *   SPDX-License-Identifier: 0BSD
+ *
+ * Bill Schottstaedt, bil@ccrma.stanford.edu
+ *
+ * Mike Scholz provided the FreeBSD support (complex trig funcs, etc)
+ * Rick Taube, Andrew Burnson, Donny Ward, Greg Santucci, and Christos Vagias provided the MS Visual C++ support
+ * Kjetil Matheussen provided the mingw support
+ *
+ * Documentation is in s7.h and s7.html.
+ * s7test.scm is a regression test.
+ * repl.scm is a vt100-based listener.
+ * nrepl.scm is a notcurses-based listener.
+ * cload.scm and lib*.scm tie in various C libraries.
+ * lint.scm checks Scheme code for infelicities.
+ * r7rs.scm implements some of r7rs (small).
+ * write.scm currrently has pretty-print.
+ * mockery.scm has the mock-data definitions.
+ * reactive.scm has reactive-set and friends.
+ * stuff.scm has some stuff.
+ * profile.scm has code to display profile data.
+ * debug.scm has debugging aids.
+ * case.scm has case*, an extension of case to pattern matching.
+ * timing tests are in the s7 tools directory
+ *
+ * s7.c is organized as follows:
+ *    structs and type flags
+ *    internal debugging stuff
+ *    constants
+ *    GC
+ *    stacks
+ *    symbols and keywords
+ *    lets
+ *    continuations
+ *    numbers
+ *    characters
+ *    strings
+ *    ports
+ *    format
+ *    lists
+ *    vectors
+ *    hash-tables
+ *    c-objects
+ *    functions
+ *    equal?
+ *    generic length, copy, reverse, fill!, append
+ *    error handlers
+ *    sundry leftovers
+ *    the optimizers
+ *    multiple-values, quasiquote
+ *    eval
+ *    *s7*
+ *    initialization and free
+ *    repl
+ *
+ * naming conventions: s7_* usually are C accessible (s7.h), g_* are scheme accessible,
+ *   H_* are documentation strings, Q_* are procedure signatures, scheme "?" corresponds to C "is_", scheme "->" to C "_to_",
+ *   *_1 are ancillary functions, big_* refer to gmp, *_nr means no return, inline_* means always-inline.
+ *
+ * ---------------- compile time switches ----------------
+ */
+
+#if defined __has_include
+#  if __has_include ("mus-config.h")
+#    include "mus-config.h"
+#  endif
+#else
+  #include "mus-config.h"
+#endif
+
+/*
+ * Your config file goes here, or just replace that #include line with the defines you need.
+ * The compile-time switches involve booleans, complex numbers, and multiprecision arithmetic.
+ * Currently we assume we have setjmp.h (used by the error handlers).
+ *
+ * Complex number support, which is problematic in C++, Solaris, and netBSD
+ *   is on the HAVE_COMPLEX_NUMBERS switch. In OSX or Linux, if you're not using C++,
+ *
+ *   #define HAVE_COMPLEX_NUMBERS 1
+ *   #define HAVE_COMPLEX_TRIG 1
+ *
+ *   In C++ I use:
+ *
+ *   #define HAVE_COMPLEX_NUMBERS 1
+ *   #define HAVE_COMPLEX_TRIG 0
+ *
+ *   In Windows and tcc, both are 0.
+ *
+ *   Some systems (FreeBSD) have complex.h, but some random subset of the trig funcs, so
+ *   HAVE_COMPLEX_NUMBERS means we can find
+ *      cimag creal cabs csqrt carg conj
+ *   and HAVE_COMPLEX_TRIG means we have
+ *      cacos cacosh casin casinh catan catanh ccos ccosh cexp clog cpow csin csinh ctan ctanh
+ *
+ * When HAVE_COMPLEX_NUMBERS is 0, the complex functions are stubs that simply return their
+ *   argument -- this will be very confusing for the s7 user because, for example, (sqrt -2)
+ *   will return something bogus (it might not signal an error).
+ *
+ * so the incoming (non-s7-specific) compile-time switches are
+ *     HAVE_COMPLEX_NUMBERS, HAVE_COMPLEX_TRIG, SIZEOF_VOID_P
+ * if SIZEOF_VOID_P is not defined, we look for __SIZEOF_POINTER__ instead,
+ *   the default is to assume that we're running on a 64-bit machine.
+ *
+ * To get multiprecision arithmetic, set WITH_GMP to 1.
+ *   You'll also need libgmp, libmpfr, and libmpc (version 0.8.0 or later)
+ *
+ * and we use these predefined macros: __cplusplus, _MSC_VER, __GNUC__, __clang__, __ANDROID__
+ *
+ * if WITH_SYSTEM_EXTRAS is 1 (default is 1 unless _MSC_VER), various OS and file related functions are included.
+ * if you want this file to compile into a stand-alone interpreter, define WITH_MAIN,
+ *   to use nrepl also define WITH_NOTCURSES
+ *
+ * -O3 is often slower than -O2 (at least according to callgrind)
+ * -march=native seems to improve tree-vectorization which is important in Snd
+ * -ffast-math makes a mess of NaNs, and does not appear to be faster
+ *   -fno-math-errno -fno-signed-zeros appear to be slightly faster, and I don't see any errors
+ *   I also tried -fno-signaling-nans -fno-trapping-math -fassociative-math, but at least one of them is much slower
+ * this code doesn't compile anymore in gcc 4.3
+ */
+
+#if (defined(__GNUC__) || defined(__clang__) || defined(__TINYC__)) /* s7 uses PRId64 so (for example) g++ 4.4 is too old */
+  #define WITH_GCC 1
+#else
+  #define WITH_GCC 0
+#endif
+
+
+/* ---------------- initial sizes ---------------- */
+
+#ifndef INITIAL_HEAP_SIZE
+  #define INITIAL_HEAP_SIZE 64000         /* 29-Jul-21 -- seems faster */
+#endif
+/* the heap grows as needed, this is its initial size. If the initial heap is small, s7 can run in about 2.5 Mbytes of memory.
+ * There are many cases where a bigger heap is faster (but harware cache size probably matters more).
+ * The heap size must be a multiple of 32.  Each object takes 48 bytes.
+ */
+
+#ifndef SYMBOL_TABLE_SIZE
+  #define SYMBOL_TABLE_SIZE 32749
+#endif
+/* names are hashed into the symbol table (a vector) and collisions are chained as lists */
+/* 16381: thash +80 [string_to_symbol_p_p] +40 if 24001, tlet +80 [symbol_p_p], +32 24001 */
+
+#ifndef INITIAL_STACK_SIZE
+  #define INITIAL_STACK_SIZE 4096  /* was 2048 17-Mar-21 */
+#endif
+/* the stack grows as needed, each frame takes 4 entries, this is its initial size. (*s7* 'stack-top) divides size by 4 */
+
+#define STACK_RESIZE_TRIGGER 256   /* was INITIAL_STACK_SIZE/2 which seems excessive */
+
+#ifndef INITIAL_PROTECTED_OBJECTS_SIZE
+  #define INITIAL_PROTECTED_OBJECTS_SIZE 16
+#endif
+/* a vector of objects that are (semi-permanently) protected from the GC, grows as needed */
+
+#ifndef GC_TEMPS_SIZE
+  #define GC_TEMPS_SIZE 256
+#endif
+/* the number of recent objects that are temporarily gc-protected; 8 works for s7test and snd-test.
+ *    For the FFI, this sets the lag between a call on s7_cons and the first moment when its result
+ *    might be vulnerable to the GC.
+ */
+
+
+/* ---------------- scheme choices ---------------- */
+
+#ifndef WITH_GMP
+  #define WITH_GMP 0
+  /* this includes multiprecision arithmetic for all numeric types and functions, using gmp, mpfr, and mpc
+   * WITH_GMP adds the following functions: bignum and bignum?, and (*s7* 'bignum-precision)
+   */
+#endif
+
+#ifndef DEFAULT_BIGNUM_PRECISION
+  #define DEFAULT_BIGNUM_PRECISION 128 /* (*s7* 'bignum-precision) initial value, must be >= 2 */
+#endif
+
+#ifndef WITH_PURE_S7
+  #define WITH_PURE_S7 0
+#endif
+#if WITH_PURE_S7
+  #define WITH_EXTRA_EXPONENT_MARKERS 0
+  #define WITH_IMMUTABLE_UNQUOTE 1
+  /* also omitted: *-ci* functions, char-ready?, cond-expand, multiple-values-bind|set!, call-with-values
+   *   and a lot more (inexact/exact, integer-length, etc) -- see s7.html.
+   */
+#endif
+
+#ifndef WITH_EXTRA_EXPONENT_MARKERS
+  #define WITH_EXTRA_EXPONENT_MARKERS 0
+#endif
+/* if 1, s7 recognizes "d", "f", "l", and "s" as exponent markers, in addition to "e" (also "D", "F", "L", "S") */
+
+#ifndef WITH_SYSTEM_EXTRAS
+  #define WITH_SYSTEM_EXTRAS (!_MSC_VER)
+  /* this adds several functions that access file info, directories, times, etc */
+#endif
+
+#ifndef WITH_IMMUTABLE_UNQUOTE
+  #define WITH_IMMUTABLE_UNQUOTE 0  /* this removes the name "unquote" */
+#endif
+
+#ifndef WITH_C_LOADER
+  #if WITH_GCC && (!__MINGW32__) && (!__CYGWIN__)
+    #define WITH_C_LOADER 1
+  /* (load file.so [e]) looks for ([e] 'init_func) and if found, calls it as the shared object init function.
+   * If WITH_SYSTEM_EXTRAS is 0, the caller needs to supply system and delete-file so that cload.scm works.
+   */
+  #else
+    #define WITH_C_LOADER 0
+    /* I think dlopen et al are available in MS C, but I have no way to test them; see load_shared_object below */
+  #endif
+#endif
+
+#ifndef WITH_HISTORY
+  #define WITH_HISTORY 0
+  /* this includes a circular buffer of previous evaluations for debugging, ((owlet) 'error-history) and (*s7* 'history-size) */
+#endif
+
+#ifndef DEFAULT_HISTORY_SIZE
+  #define DEFAULT_HISTORY_SIZE 8
+  /* this is the default length of the eval history buffer */
+#endif
+#if WITH_HISTORY
+  #define MAX_HISTORY_SIZE 1048576
+#endif
+
+#ifndef DEFAULT_PRINT_LENGTH
+  #define DEFAULT_PRINT_LENGTH 40 /* (*s7* 'print-length) initial value, was 32 but that's too small 26-May-24 */
+#endif
+
+#ifndef WITH_NUMBER_SEPARATOR
+  #define WITH_NUMBER_SEPARATOR 0
+#endif
+
+/* in case mus-config.h forgets these */
+#ifdef _MSC_VER
+  #ifndef HAVE_COMPLEX_NUMBERS
+    #define HAVE_COMPLEX_NUMBERS 0
+  #endif
+  #ifndef HAVE_COMPLEX_TRIG
+    #define HAVE_COMPLEX_TRIG 0
+  #endif
+#else
+  #ifndef HAVE_COMPLEX_NUMBERS
+    #if __TINYC__
+      #define HAVE_COMPLEX_NUMBERS 0
+    #else
+      #define HAVE_COMPLEX_NUMBERS 1
+    #endif
+  #endif
+  #if __cplusplus || __TINYC__
+    #ifndef HAVE_COMPLEX_TRIG
+      #define HAVE_COMPLEX_TRIG 0
+    #endif
+  #else
+    #ifndef HAVE_COMPLEX_TRIG
+      #define HAVE_COMPLEX_TRIG 1
+    #endif
+  #endif
+#endif
+
+#ifndef WITH_MULTITHREAD_CHECKS
+  #define WITH_MULTITHREAD_CHECKS 0
+  /* debugging aid if using s7 in a multithreaded program -- this code courtesy of Kjetil Matheussen */
+#endif
+
+#ifndef WITH_WARNINGS
+  #define WITH_WARNINGS 0
+  /* int+int overflows to real, etc: this adds warnings which are expensive even though they are never called (procedure overhead) */
+#endif
+
+#ifndef S7_DEBUGGING
+  #define S7_DEBUGGING 0
+#endif
+
+#undef DEBUGGING
+#define DEBUGGING typo!
+#define HAVE_GMP typo!
+
+#define SHOW_EVAL_OPS 0
+
+#ifndef _GNU_SOURCE
+  #define _GNU_SOURCE  /* for qsort_r, grumble... */
+#endif
+
+#ifndef _MSC_VER
+  #include <unistd.h>
+  #include <sys/param.h>
+  #include <strings.h>
+  #include <errno.h>
+  #include <locale.h>
+#else
+  /* in Snd these are in mus-config.h */
+  #ifndef MUS_CONFIG_H_LOADED
+    #if _MSC_VER < 1900
+      #define snprintf _snprintf
+    #endif
+    #if _MSC_VER >= 1900
+      #define popen _popen
+      #define pclose _pclose
+    #endif
+    #if _MSC_VER > 1200
+      #define _CRT_SECURE_NO_DEPRECATE 1
+      #define _CRT_NONSTDC_NO_DEPRECATE 1
+      #define _CRT_SECURE_CPP_OVERLOAD_STANDARD_NAMES 1
+    #endif
+  #endif
+  #include <io.h>
+  #pragma warning(disable: 4244) /* conversion might cause loss of data warning */
+#endif
+
+#if WITH_GCC && (!S7_DEBUGGING)
+  #define Inline inline __attribute__((__always_inline__))
+#else
+  #ifdef _MSC_VER
+    #define Inline __forceinline
+  #else
+    #define Inline inline
+  #endif
+#endif
+
+#ifndef WITH_VECTORIZE
+  #define WITH_VECTORIZE 1
+#endif
+
+#if (WITH_VECTORIZE) && (defined(__GNUC__) && __GNUC__ >= 5) /* is this included -in -O2 now? */
+  #define Vectorized __attribute__((optimize("tree-vectorize")))
+#else
+  #define Vectorized
+#endif
+
+#if WITH_GCC
+  #define Sentinel __attribute__((sentinel))
+#else
+  #define Sentinel
+#endif
+
+#ifdef _MSC_VER
+  #define noreturn _Noreturn /* deprecated in C23 */
+#else
+  #define noreturn __attribute__((noreturn))
+  /* this is ok in gcc/g++/clang and tcc; pure attribute is rarely applicable here, and does not seem to be helpful (maybe safe_strlen) */
+#endif
+
+#ifndef S7_ALIGNED
+  #define S7_ALIGNED 0
+  /* memclr and local_memset */
+#endif
+
+#include <stdio.h>
+#include <limits.h>
+#include <ctype.h>
+#include <string.h>
+#include <stdlib.h>
+#include <sys/types.h>
+#include <time.h>
+#include <stdarg.h>
+#include <stddef.h>
+#include <stdint.h>
+#include <inttypes.h>
+#include <setjmp.h>
+
+#ifdef _MSC_VER
+  #define MS_WINDOWS 1
+#else
+  #define MS_WINDOWS 0
+#endif
+
+#if defined(_MSC_VER) || defined(__MINGW32__)
+  #define Jmp_Buf       jmp_buf
+  #define SetJmp(A, B)  setjmp(A)
+  #define LongJmp(A, B) longjmp(A, B)
+#else
+  #define Jmp_Buf       sigjmp_buf
+  #define SetJmp(A, B)  sigsetjmp(A, B)
+  #define LongJmp(A, B) siglongjmp(A, B)
+  /* we need sigsetjmp, not setjmp for nrepl's interrupt (something to do with signal masks??)
+   *   unfortunately sigsetjmp is noticeably slower than setjmp, especially when s7_optimize_1 is called a lot.
+   *   In one case, the sigsetjmp version runs in 24 seconds, but the setjmp version takes 10 seconds, and
+   *   yet callgrind says there is almost no difference? I removed setjmp from s7_optimize.
+   */
+#endif
+
+#if (!MS_WINDOWS)
+  #include <pthread.h>
+#endif
+
+#if __cplusplus
+  #include <cmath>
+#else
+  #include <math.h>
+#endif
+
+/* there is also apparently __STDC_NO_COMPLEX__ */
+#if HAVE_COMPLEX_NUMBERS
+  #if __cplusplus
+    #include <complex>
+  #else
+    #include <complex.h>
+    #if defined(__sun) && defined(__SVR4)
+      #undef _Complex_I
+      #define _Complex_I 1.0i
+    #endif
+  #endif
+
+  #ifndef CMPLX
+    #if (!(defined(__cplusplus))) && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 7)) && !defined(__INTEL_COMPILER)
+      #define CMPLX(x, y) __builtin_complex ((double) (x), (double) (y))
+    #else
+      #define CMPLX(r, i) ((r) + ((i) * (s7_complex)_Complex_I))
+    #endif
+  #endif
+#endif
+
+#if (defined(__GNUC__))
+  #define s7_complex_i 1.0i
+#else
+  #define s7_complex_i (s7_complex)_Complex_I /* a float, but we want a double */
+#endif
+
+#include "s7.h"
+
+#ifndef M_PI
+  #define M_PI 3.1415926535897932384626433832795029L
+#endif
+
+#ifndef INFINITY
+  #ifndef HUGE_VAL
+    #define INFINITY (1.0/0.0) /* -log(0.0) is triggering dumb complaints from cppcheck */
+    /* there is sometimes a function, infinity(), MSC apparently uses HUGE_VALF, gcc has __builtin_huge_val() */
+  #else
+    #define INFINITY HUGE_VAL
+  #endif
+#endif
+
+#ifndef NAN
+  #define NAN (INFINITY / INFINITY) /* apparently ieee754 suggests 0.0/0.0 */
+#endif
+
+#if ((!__NetBSD__) && ((_MSC_VER) || (!defined(__STC__)) || (defined(__STDC_VERSION__) && (__STDC_VERSION__ < 199901L))))
+  #define __func__ __FUNCTION__
+#endif
+
+#if (((defined(SIZEOF_VOID_P)) && (SIZEOF_VOID_P == 4)) || ((defined(__SIZEOF_POINTER__)) && (__SIZEOF_POINTER__ == 4)) || (!defined(__LP64__)))
+  #define NUMBER_NAME_SIZE 2 /* pointless */
+  #define POINTER_32 true
+#else
+  #define NUMBER_NAME_SIZE 22 /* leave 1 for uint8_t name len (byte 0), 1 for terminating nul */
+  #define POINTER_32 false
+#endif
+
+#define WRITE_REAL_PRECISION 16
+#ifdef __TINYC__
+  typedef double long_double; /* (- .1 1) -> 0.9! and others similarly: (- double long_double) is broken */
+#else
+  typedef long double long_double;
+#endif
+
+#define ld64 PRId64
+#define p64 PRIdPTR
+
+#define MAX_FLOAT_FORMAT_PRECISION 128
+
+/* types */
+enum {T_FREE = 0,
+      T_PAIR, T_NIL, T_UNUSED, T_UNDEFINED, T_UNSPECIFIED, T_EOF, T_BOOLEAN, T_CHARACTER, T_SYNTAX, T_SYMBOL,
+      T_INTEGER, T_RATIO, T_REAL, T_COMPLEX, T_BIG_INTEGER, T_BIG_RATIO, T_BIG_REAL, T_BIG_COMPLEX,
+      T_STRING, T_C_OBJECT, T_VECTOR, T_INT_VECTOR, T_FLOAT_VECTOR, T_BYTE_VECTOR,
+      T_CATCH, T_DYNAMIC_WIND, T_HASH_TABLE, T_LET, T_ITERATOR,
+      T_STACK, T_COUNTER, T_SLOT, T_C_POINTER, T_OUTPUT_PORT, T_INPUT_PORT, T_RANDOM_STATE, T_CONTINUATION, T_GOTO,
+      T_CLOSURE, T_CLOSURE_STAR, T_MACRO, T_MACRO_STAR, T_BACRO, T_BACRO_STAR,
+      T_C_MACRO, T_C_FUNCTION_STAR, T_C_FUNCTION, T_C_RST_NO_REQ_FUNCTION,
+      NUM_TYPES};
+/* T_UNUSED, T_STACK, T_SLOT, T_DYNAMIC_WIND, T_CATCH, and T_COUNTER are internal */
+
+static const char *s7_type_names[] =
+  {"free", "pair", "nil", "unused", "undefined", "unspecified", "eof_object", "boolean", "character", "syntax", "symbol",
+   "integer", "ratio", "real", "complex", "big_integer", "big_ratio", "big_real", "big_complex",
+   "string", "c_object", "vector", "int_vector", "float_vector", "byte_vector",
+   "catch", "dynamic_wind", "hash_table", "let", "iterator",
+   "stack", "counter", "slot", "c_pointer", "output_port", "input_port", "random_state", "continuation", "goto",
+   "closure", "closure*", "macro", "macro*", "bacro", "bacro*",
+   "c_macro", "c_function*", "c_function", "c_rst_no_req_function",
+   };
+
+/* 1:t_pair, 2:t_nil, 3:t_unused, 4:t_undefined, 5:t_unspecified, 6:t_eof, 7:t_boolean, 8:t_character, 9:t_syntax, 10:t_symbol,
+   11:t_integer, 12:t_ratio, 13:t_real, 14:t_complex, 15:t_big_integer, 16:t_big_ratio, 17:t_big_real, 18:t_big_complex,
+   19:t_string, 20:t_c_object, 21:t_vector, 22:t_int_vector, 23:t_float_vector, 24:t_byte_vector,
+   25:t_catch, 26:t_dynamic_wind, 27:t_hash_table, 28:t_let, 29:t_iterator,
+   30:t_stack, 31:t_counter, 32:t_slot, 33:t_c_pointer, 34:t_output_port, 35:t_input_port, 36:t_random_state, 37:t_continuation, 38:t_goto,
+   39:t_closure, 40:t_closure_star, 41:t_macro, 42:t_macro_star, 43:t_bacro, 44:t_bacro_star,
+   45:t_c_macro, 46:t_c_function_star, 47:t_c_function, 48:t_c_rst_no_req_function,
+   49:num_types
+*/
+
+typedef struct block_t {
+  union {
+    void *data;
+    s7_pointer d_ptr;
+    s7_int *i_ptr;
+  } dx;
+  int32_t index;
+  union {
+    bool needs_free;
+    uint32_t tag;
+  } ln;
+  s7_int size;
+  union {
+    struct block_t *next;
+    char *documentation;
+    s7_pointer ksym;
+    s7_int nx_int;
+    s7_int *ix_ptr;
+    struct {
+      uint32_t i1, i2;
+    } ix;
+  } nx;
+  union {
+    s7_pointer ex_ptr;
+    void *ex_info;
+    s7_int ckey;
+  } ex;
+} block_t;
+
+#define NUM_BLOCK_LISTS 18
+#define TOP_BLOCK_LIST 17
+#define BLOCK_LIST 0
+
+#define block_data(p)                    p->dx.data
+#define block_index(p)                   p->index
+#define block_set_index(p, Index)        p->index = Index
+#define block_size(p)                    p->size
+#define block_set_size(p, Size)          p->size = Size
+#define block_next(p)                    p->nx.next
+#define block_info(p)                    p->ex.ex_info
+
+typedef block_t hash_entry_t; /* I think this means we waste 8 bytes per entry but can use the mallocate functions */
+#define hash_entry_key(p)                p->dx.d_ptr
+#define hash_entry_value(p)              (p)->ex.ex_ptr
+#define hash_entry_set_value(p, Val)     p->ex.ex_ptr = Val
+#define hash_entry_next(p)               block_next(p)
+#define hash_entry_raw_hash(p)           block_size(p)
+#define hash_entry_set_raw_hash(p, Hash) block_set_size(p, Hash)
+
+typedef block_t vdims_t;
+#define vdims_rank(p)                    p->size
+#define vector_elements_should_be_freed(p) p->ln.needs_free
+#define vdims_dims(p)                    p->dx.i_ptr
+#define vdims_offsets(p)                 p->nx.ix_ptr
+#define vdims_original(p)                p->ex.ex_ptr
+
+
+typedef enum {TOKEN_EOF, TOKEN_LEFT_PAREN, TOKEN_RIGHT_PAREN, TOKEN_DOT, TOKEN_ATOM, TOKEN_QUOTE, TOKEN_DOUBLE_QUOTE, TOKEN_BACK_QUOTE,
+	      TOKEN_COMMA, TOKEN_AT_MARK, TOKEN_SHARP_CONST, TOKEN_VECTOR, TOKEN_BYTE_VECTOR, TOKEN_INT_VECTOR, TOKEN_FLOAT_VECTOR} token_t;
+
+typedef enum {NO_ARTICLE, INDEFINITE_ARTICLE} article_t;
+typedef enum {DWIND_INIT, DWIND_BODY, DWIND_FINISH} dwind_t;
+enum {NO_SAFETY = 0, IMMUTABLE_VECTOR_SAFETY, MORE_SAFETY_WARNINGS};  /* (*s7* 'safety) settings */
+
+typedef enum {FILE_PORT, STRING_PORT, FUNCTION_PORT} port_type_t;
+
+typedef struct {
+  int32_t (*read_character)(s7_scheme *sc, s7_pointer port);             /* function to read a character, int32_t for EOF */
+  void (*write_character)(s7_scheme *sc, uint8_t c, s7_pointer port);    /* function to write a character */
+  void (*write_string)(s7_scheme *sc, const char *str, s7_int len, s7_pointer port); /* function to write a string of known length */
+  token_t (*read_semicolon)(s7_scheme *sc, s7_pointer port);             /* internal skip-to-semicolon reader */
+  int32_t (*read_white_space)(s7_scheme *sc, s7_pointer port);           /* internal skip white space reader */
+  s7_pointer (*read_name)(s7_scheme *sc, s7_pointer pt);                 /* internal get-next-name reader */
+  s7_pointer (*read_sharp)(s7_scheme *sc, s7_pointer pt);                /* internal get-next-sharp-constant reader */
+  s7_pointer (*read_line)(s7_scheme *sc, s7_pointer pt, bool eol_case);  /* function to read a string up to \n */
+  void (*displayer)(s7_scheme *sc, const char *s, s7_pointer pt);
+  void (*close_port)(s7_scheme *sc, s7_pointer p);                       /* close-in|output-port */
+} port_functions_t;
+
+typedef struct {
+  bool needs_free, is_closed;
+  port_type_t ptype;
+  FILE *file;
+  char *filename;
+  block_t *filename_block;
+  uint32_t line_number, file_number;
+  s7_int filename_length;
+  block_t *block;
+  s7_pointer orig_str;    /* GC protection for string port string or function port function */
+  const port_functions_t *pf;
+  s7_pointer (*input_function)(s7_scheme *sc, s7_read_t read_choice, s7_pointer port);
+  void (*output_function)(s7_scheme *sc, uint8_t c, s7_pointer port);
+} port_t;
+
+typedef enum {o_d_v, o_d_vd, o_d_vdd, o_d_vid, o_d_id, o_d_7pi, o_d_7pii, o_d_7piid, o_d_7piii, o_d_7piiid,
+	      o_d_ip, o_d_pd, o_d_7pid, o_d, o_d_d, o_d_dd, o_d_7dd, o_d_ddd, o_d_dddd,
+	      o_i_i, o_i_7i, o_i_ii, o_i_7ii, o_i_iii, o_i_7pi, o_i_7pii, o_i_7piii, o_d_p,
+	      o_b_p, o_b_7p, o_b_pp, o_b_7pp, o_b_pp_unchecked, o_b_pi, o_b_ii, o_b_7ii, o_b_dd,
+	      o_p, o_p_p, o_p_ii, o_p_d, o_p_dd, o_i_7d, o_i_7p, o_d_7d, o_p_pp, o_p_ppp, o_p_pi, o_p_pi_unchecked,
+	      o_p_ppi, o_p_i, o_p_pii, o_p_pip, o_p_pip_unchecked, o_p_piip, o_b_i, o_b_d} opt_func_t;
+
+typedef struct opt_funcs_t {
+  opt_func_t typ;
+  void *func;
+  struct opt_funcs_t *next;
+} opt_funcs_t;
+
+typedef struct {
+  const char *name;
+  int32_t name_length;
+  uint32_t id;
+  const char *doc;
+  opt_funcs_t *opt_data; /* vunion-functions (see below) */
+  s7_pointer generic_ff, setter, signature, pars;
+  s7_pointer (*chooser)(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr);
+  /* arg_defaults|names call_args only T_C_FUNCTION_STAR -- call args for GC protection */
+  union {
+    s7_pointer *arg_defaults;
+    s7_pointer bool_setter;
+  } dam;
+  union {
+    s7_pointer *arg_names;
+    s7_pointer c_sym;
+  } sam;
+  union {
+    s7_pointer call_args;
+    void (*marker)(s7_pointer p, s7_int len);
+  } cam;
+} c_proc_t;
+
+
+typedef struct {
+  s7_int type, outer_type;
+  s7_pointer scheme_name, getter, setter;
+  void (*mark)(void *val);
+  void (*free)(void *value);           /* this will go away someday (use gc_free) */
+  bool (*eql)(void *val1, void *val2); /* this will go away someday (use equal) */
+#if (!DISABLE_DEPRECATED)
+  char *(*print)(s7_scheme *sc, void *value);
+#endif
+  s7_pointer (*equal)      (s7_scheme *sc, s7_pointer args);
+  s7_pointer (*equivalent) (s7_scheme *sc, s7_pointer args);
+  s7_pointer (*ref)        (s7_scheme *sc, s7_pointer args);
+  s7_pointer (*set)        (s7_scheme *sc, s7_pointer args);
+  s7_pointer (*length)     (s7_scheme *sc, s7_pointer args);
+  s7_pointer (*reverse)    (s7_scheme *sc, s7_pointer args);
+  s7_pointer (*copy)       (s7_scheme *sc, s7_pointer args);
+  s7_pointer (*fill)       (s7_scheme *sc, s7_pointer args);
+  s7_pointer (*to_list)    (s7_scheme *sc, s7_pointer args);
+  s7_pointer (*to_string)  (s7_scheme *sc, s7_pointer args);
+  s7_pointer (*gc_mark)    (s7_scheme *sc, s7_pointer args);
+  s7_pointer (*gc_free)    (s7_scheme *sc, s7_pointer args);
+} c_object_t;
+
+
+typedef s7_int (*hash_map_t)(s7_scheme *sc, s7_pointer table, s7_pointer key);          /* hash-table object->location mapper */
+typedef hash_entry_t *(*hash_check_t)(s7_scheme *sc, s7_pointer table, s7_pointer key); /* hash-table object equality function */
+static hash_map_t default_hash_map[NUM_TYPES];
+
+typedef s7_int (*s7_i_7pi_t)(s7_scheme *sc, s7_pointer p, s7_int i1);
+typedef s7_int (*s7_i_7pii_t)(s7_scheme *sc, s7_pointer p, s7_int i1, s7_int i2);
+typedef s7_int (*s7_i_7piii_t)(s7_scheme *sc, s7_pointer p, s7_int i1, s7_int i2, s7_int i3);
+typedef s7_int (*s7_i_iii_t)(s7_int i1, s7_int i2, s7_int i3);
+typedef s7_int (*s7_i_7i_t)(s7_scheme *sc, s7_int i1);
+typedef s7_int (*s7_i_7ii_t)(s7_scheme *sc, s7_int i1, s7_int i2);
+typedef bool (*s7_b_pp_t)(s7_pointer p1, s7_pointer p2);
+typedef bool (*s7_b_7pp_t)(s7_scheme *sc, s7_pointer p1, s7_pointer p2);
+typedef bool (*s7_b_7p_t)(s7_scheme *sc, s7_pointer p1);
+typedef bool (*s7_b_pi_t)(s7_scheme *sc, s7_pointer p1, s7_int i2);
+typedef bool (*s7_b_d_t)(s7_double p1);
+typedef bool (*s7_b_i_t)(s7_int p1);
+typedef bool (*s7_b_ii_t)(s7_int p1, s7_int p2);
+typedef bool (*s7_b_7ii_t)(s7_scheme *sc, s7_int p1, s7_int p2);
+typedef bool (*s7_b_dd_t)(s7_double p1, s7_double p2);
+typedef s7_pointer (*s7_p_t)(s7_scheme *sc);
+typedef s7_pointer (*s7_p_ppi_t)(s7_scheme *sc, s7_pointer p1, s7_pointer p2, s7_int i1);
+typedef s7_pointer (*s7_p_pi_t)(s7_scheme *sc, s7_pointer p1, s7_int i1);
+typedef s7_pointer (*s7_p_pii_t)(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_int i2);
+typedef s7_pointer (*s7_p_pip_t)(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_pointer p2);
+typedef s7_pointer (*s7_p_piip_t)(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_int i2, s7_pointer p3);
+typedef s7_pointer (*s7_p_i_t)(s7_scheme *sc, s7_int i);
+typedef s7_pointer (*s7_p_ii_t)(s7_scheme *sc, s7_int i1, s7_int i2);
+typedef s7_pointer (*s7_p_dd_t)(s7_scheme *sc, s7_double x1, s7_double x2);
+typedef s7_double (*s7_d_7d_t)(s7_scheme *sc, s7_double p1);
+typedef s7_double (*s7_d_7dd_t)(s7_scheme *sc, s7_double p1, s7_double p2);
+typedef s7_double (*s7_d_7pii_t)(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_int i2);
+typedef s7_double (*s7_d_7piid_t)(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_int i2, s7_double x1);
+typedef s7_double (*s7_d_7piii_t)(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_int i2, s7_int i3);
+typedef s7_double (*s7_d_7piiid_t)(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_int i2, s7_int i3, s7_double x1);
+
+typedef struct opt_info opt_info;
+
+typedef union {
+  s7_int i;
+  s7_double x;
+  s7_pointer p;
+  void *obj;
+  opt_info *o1;
+  s7_function call;
+  s7_double (*d_f)(void);
+  s7_double (*d_d_f)(s7_double x);
+  s7_double (*d_7d_f)(s7_scheme *sc, s7_double x);
+  s7_double (*d_dd_f)(s7_double x1, s7_double x2);
+  s7_double (*d_7dd_f)(s7_scheme *sc, s7_double x1, s7_double x2);
+  s7_double (*d_ddd_f)(s7_double x1, s7_double x2, s7_double x3);
+  s7_double (*d_dddd_f)(s7_double x1, s7_double x2, s7_double x3, s7_double x4);
+  s7_double (*d_v_f)(void *obj);
+  s7_double (*d_vd_f)(void *obj, s7_double fm);
+  s7_double (*d_vdd_f)(void *obj, s7_double x1, s7_double x2);
+  s7_double (*d_vid_f)(void *obj, s7_int i, s7_double fm);
+  s7_double (*d_id_f)(s7_int i, s7_double fm);
+  s7_double (*d_7pi_f)(s7_scheme *sc, s7_pointer obj, s7_int i1);
+  s7_double (*d_7pid_f)(s7_scheme *sc, s7_pointer obj, s7_int i1, s7_double x);
+  s7_double (*d_7pii_f)(s7_scheme *sc, s7_pointer obj, s7_int i1, s7_int i2);
+  s7_double (*d_7piid_f)(s7_scheme *sc, s7_pointer obj, s7_int i1, s7_int i2, s7_double x);
+  s7_double (*d_7piii_f)(s7_scheme *sc, s7_pointer obj, s7_int i1, s7_int i2, s7_int i3);
+  s7_double (*d_7piiid_f)(s7_scheme *sc, s7_pointer obj, s7_int i1, s7_int i2, s7_int i3, s7_double x);
+  s7_double (*d_ip_f)(s7_int i1, s7_pointer p);
+  s7_double (*d_pd_f)(s7_pointer obj, s7_double x);
+  s7_double (*d_p_f)(s7_pointer p);
+  s7_int (*i_7d_f)(s7_scheme *sc, s7_double i1);
+  s7_int (*i_7p_f)(s7_scheme *sc, s7_pointer i1);
+  s7_int (*i_i_f)(s7_int i1);
+  s7_int (*i_7i_f)(s7_scheme *sc, s7_int i1);
+  s7_int (*i_ii_f)(s7_int i1, s7_int i2);
+  s7_int (*i_7ii_f)(s7_scheme *sc, s7_int i1, s7_int i2);
+  s7_int (*i_iii_f)(s7_int i1, s7_int i2, s7_int i3);
+  s7_int (*i_7pi_f)(s7_scheme *sc, s7_pointer p, s7_int i1);
+  s7_int (*i_7pii_f)(s7_scheme *sc, s7_pointer p, s7_int i1, s7_int i2);
+  s7_int (*i_7piii_f)(s7_scheme *sc, s7_pointer p, s7_int i1, s7_int i2, s7_int i3);
+  bool (*b_i_f)(s7_int p);
+  bool (*b_d_f)(s7_double p);
+  bool (*b_p_f)(s7_pointer p);
+  bool (*b_pp_f)(s7_pointer p1, s7_pointer p2);
+  bool (*b_7pp_f)(s7_scheme *sc, s7_pointer p1, s7_pointer p2);
+  bool (*b_7p_f)(s7_scheme *sc, s7_pointer p1);
+  bool (*b_pi_f)(s7_scheme *sc, s7_pointer p1, s7_int i2);
+  bool (*b_ii_f)(s7_int i1, s7_int i2);
+  bool (*b_7ii_f)(s7_scheme *sc, s7_int i1, s7_int i2);
+  bool (*b_dd_f)(s7_double x1, s7_double x2);
+  s7_pointer (*p_f)(s7_scheme *sc);
+  s7_pointer (*p_p_f)(s7_scheme *sc, s7_pointer p);
+  s7_pointer (*p_pp_f)(s7_scheme *sc, s7_pointer p1, s7_pointer p2);
+  s7_pointer (*p_ppp_f)(s7_scheme *sc, s7_pointer p, s7_pointer p2, s7_pointer p3);
+  s7_pointer (*p_pi_f)(s7_scheme *sc, s7_pointer p1, s7_int i1);
+  s7_pointer (*p_pii_f)(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_int i2);
+  s7_pointer (*p_ppi_f)(s7_scheme *sc, s7_pointer p1, s7_pointer p2, s7_int i1);
+  s7_pointer (*p_pip_f)(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_pointer p2);
+  s7_pointer (*p_piip_f)(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_int i2, s7_pointer p3);
+  s7_pointer (*p_i_f)(s7_scheme *sc, s7_int i);
+  s7_pointer (*p_ii_f)(s7_scheme *sc, s7_int x1, s7_int x2);
+  s7_pointer (*p_d_f)(s7_scheme *sc, s7_double x);
+  s7_pointer (*p_dd_f)(s7_scheme *sc, s7_double x1, s7_double x2);
+  s7_double (*fd)(opt_info *o);
+  s7_int (*fi)(opt_info *o);
+  bool (*fb)(opt_info *o);
+  s7_pointer (*fp)(opt_info *o);
+} vunion;
+/* libgsl 15 d_i */
+
+#define NUM_VUNIONS 15
+struct opt_info {
+  vunion v[NUM_VUNIONS];
+  s7_scheme *sc;
+};
+
+#define O_WRAP (NUM_VUNIONS - 1)
+
+#if WITH_GMP
+typedef struct bigint {mpz_t n; struct bigint *nxt;} bigint;
+typedef struct bigrat {mpq_t q; struct bigrat *nxt;} bigrat;
+typedef struct bigflt {mpfr_t x; struct bigflt *nxt;} bigflt;
+typedef struct bigcmp {mpc_t z; struct bigcmp *nxt;} bigcmp;
+
+typedef struct {
+  mpfr_t error, ux, x0, x1;
+  mpz_t i, i0, i1, n;
+  mpz_t p0, q0, r, r1, p1, q1, old_p1, old_q1;
+  mpfr_t val, e0, e1, e0p, e1p, old_e0, old_e1, old_e0p;
+  mpq_t q;
+} rat_locals_t;
+#endif
+
+typedef intptr_t opcode_t;
+
+typedef struct unlet_entry_t {
+  s7_pointer symbol;
+  struct unlet_entry_t *next;
+} unlet_entry_t;
+
+
+/* -------------------------------- cell structure -------------------------------- */
+
+typedef struct s7_cell {
+  union {
+    uint64_t u64_type;            /* type info */
+    int64_t s64_type;
+    uint8_t type_field;
+    struct {
+      uint16_t low_bits;          /* 8 bits for type (type_field above, pair?/string? etc, 6 bits in use), 8 flag bits */
+      uint16_t mid_bits;          /* 16 more flag bits */
+      uint16_t opt_bits;          /* 16 bits for opcode_t (eval choice), 10 in use) */
+      uint16_t high_bits;         /* 16 more flag bits */
+    } bits;
+  } tf;
+  union {
+
+    union {                       /* integers, floats */
+      s7_int integer_value;
+      s7_double real_value;
+
+      struct {                    /* ratios */
+	s7_int numerator;
+	s7_int denominator;
+      } fraction_value;
+
+      struct {                    /* complex numbers */
+	s7_double rl;
+	s7_double im;
+      } complex_value;
+
+#if WITH_GMP
+      bigint *bgi;                /* bignums */
+      bigrat *bgr;
+      bigflt *bgf;
+      bigcmp *bgc;
+#endif
+    } number;
+
+    struct {
+      s7_int unused1, unused2;    /* always int64_t so this is 16 bytes */
+      uint8_t name[24];
+    } number_name;
+
+    struct {                      /* ports */
+      port_t *port;
+      uint8_t *data;
+      s7_int size, point;
+      block_t *block;
+    } prt;
+
+    struct{                       /* characters */
+      uint8_t c, up_c;
+      int32_t length;
+      bool alpha_c, digit_c, space_c, upper_c, lower_c;
+      char c_name[12];
+    } chr;
+
+    struct {                      /* c-pointers */
+      void *c_pointer;
+      s7_pointer c_type, info, weak1, weak2;
+    } cptr;
+
+    struct {                      /* vectors */
+      s7_int length;
+      union {
+	s7_pointer *objects;
+	s7_int *ints;
+	s7_double *floats;
+	uint8_t *bytes;
+      } elements;
+      block_t *block;
+      s7_pointer (*vget)(s7_scheme *sc, s7_pointer vec, s7_int loc);
+      union {
+	s7_pointer (*vset)(s7_scheme *sc, s7_pointer vec, s7_int loc, s7_pointer val);
+	s7_pointer fset;
+      } setv;
+    } vector;
+
+    struct {                        /* stacks (internal) struct must match vector above for length/objects */
+      s7_int length;
+      s7_pointer *objects;
+      block_t *block;
+      int64_t top, flags;
+    } stk;
+
+    struct {                        /* hash-tables */
+      s7_int mask;
+      hash_entry_t **elements;      /* a pointer into block below: takes up a field in object.hasher but is faster (50 in thash) */
+      hash_check_t hash_func;
+      hash_map_t *loc;
+      block_t *block;
+    } hasher;
+
+    struct {                        /* iterators */
+      s7_pointer obj, cur;
+      union {
+	s7_int loc;
+	s7_pointer lcur;
+      } lc;
+      union {
+	s7_int len;
+	s7_pointer slow;
+	hash_entry_t *hcur;
+      } lw;
+      s7_pointer (*next)(s7_scheme *sc, s7_pointer iterator);
+    } iter;
+
+    struct {
+      c_proc_t *c_proc;              /* C functions, macros */
+      s7_function ff;
+      s7_int required_args, optional_args, all_args; /* these could be uint32_t */
+    } fnc;
+
+    struct {                         /* pairs */
+      s7_pointer car, cdr, opt1;
+      union
+      {
+	s7_pointer opt2;
+	s7_int n;
+      } o2;
+      union {
+	s7_pointer opt3;
+	s7_int n;
+	uint8_t opt_type;
+      } o3;
+    } cons;
+
+    struct {                         /* special purpose pairs (symbol-table etc) */
+      s7_pointer unused_car, unused_cdr;
+      uint64_t hash;
+      const char *fstr;
+      uint64_t location;            /* line/file/position, also used in symbol_table as raw_len */
+    } sym_cons;
+
+    struct {                        /* scheme functions */
+      s7_pointer args, body, env, setter; /* args can be a symbol, as well as a list, setter can be #f as well as a procedure/closure */
+      int32_t arity;
+    } func;
+
+    struct {                        /* strings */
+      s7_int length;
+      char *svalue;
+      uint64_t hash;                /* string hash-index */
+      block_t *block;
+      block_t *gensym_block;
+    } string;
+
+    struct {                       /* symbols */
+      s7_pointer name, global_slot, local_slot;
+      int64_t id;                  /* which let last bound the symbol -- for faster symbol lookup */
+      uint32_t ctr;                /* how many times has symbol been bound */
+      uint32_t tag;                /* symbol as member of a set (tree-set-memq etc), high 32 bits are in symbol_info (the string block) */
+    } sym;
+
+    struct {                       /* syntax */
+      s7_pointer symbol;
+      opcode_t op;
+      int32_t min_args, max_args;
+      const char *documentation;
+    } syn;
+
+    struct {                       /* slots (bindings) */
+      s7_pointer sym, val, nxt, pending_value, expr;  /* pending_value is also the setter field which works by a whisker */
+    } slt;
+
+    struct {                       /* lets (environments) */
+      s7_pointer slots, nxt;
+      int64_t id;                  /* id of rootlet is -1 */
+      union {
+	struct {
+	  s7_pointer function;     /* *function* (symbol) if this is a funclet */
+	  uint32_t line, file;     /* *function* location if it is known */
+	} efnc;
+	struct {
+	  s7_pointer dox1, dox2;   /* do loop variables */
+	} dox;
+	s7_int key;                /* sc->baffle_ctr type */
+      } edat;
+    } envr;
+
+    struct {                        /* special stuff like #<unspecified> */
+      s7_pointer car, cdr;          /* unique_car|cdr, for sc->nil these are sc->unspecified for faster assoc etc */
+      int64_t unused_let_id;        /* let_id(sc->nil) is -1, so this needs to align with envr.id above, only used by sc->nil, so free elsewhere */
+      const char *name;
+      s7_int len;
+    } unq;
+
+    struct {                        /* #<...> */
+      char *name;                   /* not const because the GC frees it */
+      s7_int len;
+    } undef;
+
+    struct {                        /* #<eof> */
+      const char *name;
+      s7_int len;
+    } eof;
+
+    struct {                        /* counter (internal) */
+      s7_pointer result, list, env, slots; /* env = counter_let (curlet after map/for-each let created) */
+      uint64_t cap;                 /* sc->capture_let_counter for let reuse */
+    } ctr;
+
+    struct {                        /* random-state */
+#if WITH_GMP
+      gmp_randstate_t state;
+#else
+      uint64_t seed, carry;
+      /* for 64-bit floats we probably need 4 state fields */
+#endif
+    } rng;
+
+    struct {                        /* additional object types (C) */
+      s7_int type;
+      void *value;                  /* the value the caller associates with the c_object */
+      s7_pointer e;                 /* the method list, if any (openlet) */
+      s7_scheme *sc;
+    } c_obj;
+
+    struct {                        /* continuations */
+      block_t *block;
+      s7_pointer stack, op_stack;
+      s7_pointer *stack_start, *stack_end;
+    } cwcc;
+
+    struct {                        /* call-with-exit */
+      uint64_t goto_loc, op_stack_loc;
+      bool active;
+      s7_pointer name;
+    } rexit;
+
+    struct {                        /* catch */
+      uint64_t goto_loc, op_stack_loc;
+      s7_pointer tag;
+      s7_pointer handler;
+      Jmp_Buf *cstack;
+    } rcatch; /* C++ reserves "catch" I guess */
+
+    struct {                        /* dynamic-wind */
+      s7_pointer in, out, body;
+      dwind_t state;
+    } winder;
+  } object;
+
+#if S7_DEBUGGING
+  int32_t alloc_line, uses, explicit_free_line, gc_line, holders;
+  int64_t alloc_type, debugger_bits;
+  const char *alloc_func, *gc_func, *root;
+  s7_pointer holder;
+#endif
+} s7_cell;
+
+
+typedef struct s7_big_cell {
+  s7_cell cell;
+  int64_t big_hloc;
+} s7_big_cell;
+typedef struct s7_big_cell *s7_big_pointer;
+
+typedef struct heap_block_t {
+  intptr_t start, end;
+  int64_t offset;
+  struct heap_block_t *next;
+} heap_block_t;
+
+typedef struct {
+  s7_pointer *objs;
+  int32_t size, top, ref, size2;
+  bool has_hits;
+  int32_t *refs;
+  s7_pointer cycle_port, init_port;
+  s7_int cycle_loc, init_loc, ctr;
+  bool *defined;
+} shared_info_t;
+
+typedef struct {
+  s7_int loc, curly_len, ctr;
+  char *curly_str;
+  s7_pointer args, orig_str, curly_arg, port, strport;
+} format_data_t;
+
+typedef struct gc_obj_t {
+  s7_pointer p;
+  struct gc_obj_t *nxt;
+} gc_obj_t;
+
+typedef struct {
+  s7_pointer *list;
+  s7_int size, loc;
+} gc_list_t;
+
+typedef struct {
+  s7_int size, top, excl_size, excl_top;
+  s7_pointer *funcs, *let_names, *files;
+  s7_int *timing_data, *excl, *lines;
+} profile_data_t;
+
+typedef enum {NO_JUMP, CALL_WITH_EXIT_JUMP, THROW_JUMP, CATCH_JUMP, ERROR_JUMP, ERROR_QUIT_JUMP} jump_loc_t;
+typedef enum {NO_SET_JUMP, READ_SET_JUMP, LOAD_SET_JUMP, DYNAMIC_WIND_SET_JUMP, S7_CALL_SET_JUMP, EVAL_SET_JUMP} setjmp_loc_t;
+static const char *jump_string[6] = {"no_jump", "call_with_exit_jump", "throw_jump", "catch_jump", "error_jump", "error_quit_jump"};
+
+
+/* -------------------------------- s7_scheme struct -------------------------------- */
+struct s7_scheme {
+  s7_pointer code;    /* layout of first 4 entries should match stack frame layout */
+  s7_pointer curlet;
+  s7_pointer args;
+  opcode_t cur_op;
+  s7_pointer value, cur_code;
+  token_t tok;
+
+  s7_pointer stack;                   /* stack is a vector */
+  uint32_t stack_size;
+  s7_pointer *stack_start, *stack_end, *stack_resize_trigger;
+
+  s7_pointer *op_stack, *op_stack_now, *op_stack_end;
+  uint32_t op_stack_size, max_stack_size;
+
+  s7_cell **heap, **free_heap, **free_heap_top, **free_heap_trigger, **previous_free_heap_top;
+  int64_t heap_size, gc_freed, gc_total_freed, max_heap_size, gc_temps_size;
+  s7_double gc_resize_heap_fraction, gc_resize_heap_by_4_fraction;
+  s7_int gc_calls, gc_total_time, gc_start, gc_end;
+  heap_block_t *heap_blocks;
+
+#if WITH_HISTORY
+  s7_pointer eval_history1, eval_history2, error_history, history_sink, history_pairs, old_cur_code;
+  bool using_history1;
+#endif
+
+#if WITH_MULTITHREAD_CHECKS
+  int32_t lock_count;
+  pthread_mutex_t lock;
+#endif
+
+  gc_obj_t *semipermanent_objects, *semipermanent_lets;
+  s7_pointer protected_objects, protected_setters, protected_setter_symbols;  /* vectors of gc-protected objects */
+  s7_int *protected_objects_free_list;    /* to avoid a linear search for a place to store an object in sc->protected_objects */
+  s7_int protected_objects_size, protected_setters_size, protected_setters_loc;
+  s7_int protected_objects_free_list_loc;
+
+  s7_pointer nil;                     /* empty list */
+  s7_pointer T;                       /* #t */
+  s7_pointer F;                       /* #f */
+  s7_pointer undefined;               /* #<undefined> */
+  s7_pointer unspecified;             /* #<unspecified> */
+  s7_pointer no_value;                /* the (values) value */
+  s7_pointer unused;                  /* a marker for an unoccupied slot in sc->protected_objects (and other similar stuff) */
+
+  s7_pointer symbol_table;
+  s7_pointer rootlet, rootlet_slots, shadow_rootlet;
+  unlet_entry_t *unlet_entries;         /* original bindings of predefined functions */
+
+  s7_pointer input_port;              /* current-input-port */
+  s7_pointer *input_port_stack;       /*   input port stack (load and read internally) */
+  uint32_t input_port_stack_size, input_port_stack_loc;
+
+  s7_pointer output_port;             /* current-output-port */
+  s7_pointer error_port;              /* current-error-port */
+  s7_pointer owlet;                   /* owlet */
+  s7_pointer error_type, error_data, error_code, error_line, error_file, error_position; /* owlet slots */
+  s7_pointer standard_input, standard_output, standard_error;
+
+  s7_pointer sharp_readers;           /* the binding pair for the global *#readers* list */
+  s7_pointer load_hook;               /* *load-hook* hook object */
+  s7_pointer autoload_hook;           /* *autoload-hook* hook object */
+  s7_pointer unbound_variable_hook;   /* *unbound-variable-hook* hook object */
+  s7_pointer missing_close_paren_hook, rootlet_redefinition_hook;
+  s7_pointer error_hook, read_error_hook; /* *error-hook* hook object, and *read-error-hook* */
+  bool gc_off, gc_in_progress;        /* gc_off: if true, the GC won't run */
+  uint32_t gc_stats, gensym_counter, f_class, add_class, multiply_class, subtract_class, num_eq_class;
+  int32_t format_column, error_argnum;
+  uint64_t capture_let_counter;
+  bool short_print, is_autoloading, in_with_let, object_out_locked, has_openlets, is_expanding, accept_all_keyword_arguments, muffle_warnings, symbol_quote;
+  bool got_tc, got_rec, not_tc;
+  s7_int rec_tc_args, continuation_counter;
+  int64_t let_number;
+  unsigned char number_separator;
+  s7_double default_rationalize_error, equivalent_float_epsilon, hash_table_float_epsilon;
+  s7_int default_hash_table_length, initial_string_port_length, print_length, objstr_max_len, history_size, true_history_size, output_file_port_data_size;
+  s7_int max_vector_length, max_string_length, max_list_length, max_vector_dimensions, max_format_length, max_port_data_size, rec_loc, rec_len, show_stack_limit;
+  s7_pointer stacktrace_defaults, symbol_printer;
+
+  s7_pointer rec_stack, rec_testp, rec_f1p, rec_f2p, rec_f3p, rec_f4p, rec_f5p, rec_f6p, rec_f7p, rec_f8p, rec_f9p;
+  s7_pointer rec_resp, rec_slot1, rec_slot2, rec_slot3, rec_p1, rec_p2;
+  s7_pointer *rec_els;
+  s7_function rec_testf, rec_f1f, rec_f2f, rec_f3f, rec_f4f, rec_f5f, rec_f6f, rec_f7f, rec_f8f, rec_f9f, rec_resf, rec_fn;
+  s7_int (*rec_fi1)(opt_info *o);
+  s7_int (*rec_fi2)(opt_info *o);
+  s7_int (*rec_fi3)(opt_info *o);
+  s7_int (*rec_fi4)(opt_info *o);
+  s7_int (*rec_fi5)(opt_info *o);
+  s7_int (*rec_fi6)(opt_info *o);
+  bool (*rec_fb1)(opt_info *o);
+  bool (*rec_fb2)(opt_info *o);
+
+  opt_info *rec_test_o, *rec_result_o, *rec_a1_o, *rec_a2_o, *rec_a3_o, *rec_a4_o, *rec_a5_o, *rec_a6_o;
+  s7_i_ii_t rec_i_ii_f;
+  s7_d_dd_t rec_d_dd_f;
+  s7_pointer rec_val1, rec_val2;
+
+  int32_t float_format_precision;
+  vdims_t *wrap_only;
+
+  char *typnam;
+  int32_t typnam_len, print_width;
+  s7_pointer *singletons;
+  block_t *unentry;                   /* hash-table lookup failure indicator */
+
+  #define INITIAL_FILE_NAMES_SIZE 8
+  s7_pointer *file_names;
+  int32_t file_names_size, file_names_top;
+
+  #define INITIAL_STRBUF_SIZE 1024
+  s7_int strbuf_size;
+  char *strbuf;
+
+  char *read_line_buf;
+  s7_int read_line_buf_size;
+
+  s7_pointer w, x, y, z;
+  s7_pointer temp1, temp2, temp3, temp4, temp5, temp6, temp7, temp8, temp9, temp10;
+  s7_pointer t1_1, t2_1, t2_2, t3_1, t3_2, t3_3, t4_1, u1_1;
+  s7_pointer elist_1, elist_2, elist_3, elist_4, elist_5, elist_6, elist_7;
+  s7_pointer plist_1, plist_2, plist_2_2, plist_3, plist_4;
+  s7_pointer qlist_2, qlist_3, clist_1, clist_2, dlist_1, mlist_1, mlist_2; /* dlist|clist and ulist can't overlap */
+
+  Jmp_Buf *goto_start;
+  bool longjmp_ok;
+  setjmp_loc_t setjmp_loc;
+
+  void (*begin_hook)(s7_scheme *sc, bool *val);
+  opcode_t begin_op;
+
+  bool debug_or_profile, profiling_gensyms;
+  s7_int current_line, s7_call_line, debug, profile, profile_position;
+  s7_pointer profile_prefix;
+  profile_data_t *profile_data;
+  const char *current_file, *s7_call_file, *s7_call_name;
+
+  shared_info_t *circle_info;
+  format_data_t **fdats;
+  int32_t num_fdats, safety;
+  gc_list_t *strings, *vectors, *input_ports, *output_ports, *input_string_ports, *continuations, *c_objects, *hash_tables;
+  gc_list_t *gensyms, *undefineds, *multivectors, *weak_refs, *weak_hash_iterators, *opt1_funcs;
+#if (WITH_GMP)
+  gc_list_t *big_integers, *big_ratios, *big_reals, *big_complexes, *big_random_states;
+  mpz_t mpz_1, mpz_2, mpz_3, mpz_4;
+  mpq_t mpq_1, mpq_2, mpq_3;
+  mpfr_t mpfr_1, mpfr_2, mpfr_3;
+  mpc_t mpc_1, mpc_2;
+  rat_locals_t *ratloc;
+  bigint *bigints;
+  bigrat *bigrats;
+  bigflt *bigflts;
+  bigcmp *bigcmps;
+#endif
+  s7_pointer *setters;
+  s7_int setters_size, setters_loc;
+  s7_pointer *tree_pointers;
+  int32_t tree_pointers_size, tree_pointers_top, semipermanent_cells, num_to_str_size;
+  s7_pointer format_ports;
+  uint32_t alloc_pointer_k, alloc_function_k, alloc_symbol_k;
+  s7_cell *alloc_pointer_cells;
+  c_proc_t *alloc_function_cells;
+  uint32_t alloc_big_pointer_k;
+  s7_big_cell *alloc_big_pointer_cells;
+  s7_pointer string_wrappers, integer_wrappers, real_wrappers, c_pointer_wrappers;
+  uint8_t *alloc_symbol_cells;
+  char *num_to_str;
+
+  block_t *block_lists[NUM_BLOCK_LISTS];
+  size_t alloc_string_k;
+  char *alloc_string_cells;
+#if S7_DEBUGGING
+  int64_t blocks_borrowed[NUM_BLOCK_LISTS], blocks_freed[NUM_BLOCK_LISTS], blocks_mallocated[NUM_BLOCK_LISTS];
+#endif
+
+  c_object_t **c_object_types;
+  int32_t c_object_types_size, num_c_object_types;
+  s7_pointer type_to_typers[NUM_TYPES];
+
+  uint32_t syms_tag, syms_tag2;
+  int32_t bignum_precision;
+  s7_int baffle_ctr, map_call_ctr;
+  s7_pointer default_random_state;
+
+  s7_pointer sort_body, sort_begin, sort_v1, sort_v2;
+  opcode_t sort_op;
+  s7_int sort_body_len;
+  s7_b_7pp_t sort_f;
+  opt_info *sort_o;
+  bool (*sort_fb)(opt_info *o);
+
+  #define INT_TO_STR_SIZE 32
+  char int_to_str1[INT_TO_STR_SIZE], int_to_str2[INT_TO_STR_SIZE], int_to_str3[INT_TO_STR_SIZE], int_to_str4[INT_TO_STR_SIZE], int_to_str5[INT_TO_STR_SIZE];
+
+  s7_pointer abs_symbol, acos_symbol, acosh_symbol, add_symbol, angle_symbol, append_symbol, apply_symbol, apply_values_symbol, arity_symbol,
+             ash_symbol, asin_symbol, asinh_symbol, assoc_symbol, assq_symbol, assv_symbol, atan_symbol, atanh_symbol, autoload_symbol, autoloader_symbol,
+             bacro_symbol, bacro_star_symbol, bignum_symbol, byte_vector_symbol, byte_vector_ref_symbol, byte_vector_set_symbol, byte_vector_to_string_symbol,
+             c_pointer_symbol, c_pointer_info_symbol, c_pointer_to_list_symbol, c_pointer_type_symbol, c_pointer_weak1_symbol, c_pointer_weak2_symbol,
+             caaaar_symbol, caaadr_symbol, caaar_symbol, caadar_symbol, caaddr_symbol, caadr_symbol,
+             caar_symbol, cadaar_symbol, cadadr_symbol, cadar_symbol, caddar_symbol, cadddr_symbol, caddr_symbol, cadr_symbol,
+             call_cc_symbol, call_with_current_continuation_symbol, call_with_exit_symbol, call_with_input_file_symbol,
+             call_with_input_string_symbol, call_with_output_file_symbol, call_with_output_string_symbol, car_symbol,
+             catch_symbol, cdaaar_symbol, cdaadr_symbol, cdaar_symbol, cdadar_symbol, cdaddr_symbol, cdadr_symbol, cdar_symbol,
+             cddaar_symbol, cddadr_symbol, cddar_symbol, cdddar_symbol, cddddr_symbol, cdddr_symbol, cddr_symbol, cdr_symbol,
+             ceiling_symbol, char_downcase_symbol, char_eq_symbol, char_geq_symbol, char_gt_symbol, char_leq_symbol, char_lt_symbol,
+             char_position_symbol, char_to_integer_symbol, char_upcase_symbol, cload_directory_symbol, close_input_port_symbol,
+             close_output_port_symbol, complex_symbol, cons_symbol, copy_symbol, cos_symbol, cosh_symbol, coverlet_symbol,
+             curlet_symbol, current_error_port_symbol, current_input_port_symbol, current_output_port_symbol, cutlet_symbol, cyclic_sequences_symbol,
+             denominator_symbol, dilambda_symbol, display_symbol, divide_symbol, documentation_symbol, dynamic_wind_symbol, dynamic_unwind_symbol,
+             num_eq_symbol, error_symbol, eval_string_symbol, eval_symbol, exact_to_inexact_symbol, exit_symbol, exp_symbol, expt_symbol,
+             features_symbol, file__symbol, fill_symbol, float_vector_ref_symbol, float_vector_set_symbol, float_vector_symbol, floor_symbol,
+             flush_output_port_symbol, for_each_symbol, format_symbol, funclet_symbol, _function__symbol, procedure_arglist_symbol,
+             gc_symbol, gcd_symbol, gensym_symbol, geq_symbol, get_output_string_symbol, gt_symbol,
+             hash_table_entries_symbol, hash_table_key_typer_symbol, hash_table_ref_symbol, hash_table_set_symbol, hash_table_symbol,
+             hash_table_value_typer_symbol, help_symbol,
+             imag_part_symbol, immutable_symbol, inexact_to_exact_symbol, inlet_symbol, int_vector_ref_symbol, int_vector_set_symbol, int_vector_symbol,
+             integer_decode_float_symbol, integer_to_char_symbol,
+             is_aritable_symbol, is_bignum_symbol, is_boolean_symbol, is_byte_symbol, is_byte_vector_symbol,
+             is_c_object_symbol, c_object_type_symbol, is_c_pointer_symbol, is_char_alphabetic_symbol, is_char_lower_case_symbol, is_char_numeric_symbol,
+             is_char_symbol, is_char_upper_case_symbol, is_char_whitespace_symbol, is_complex_symbol, is_constant_symbol,
+             is_continuation_symbol, is_defined_symbol, is_dilambda_symbol, is_eof_object_symbol, is_eq_symbol, is_equal_symbol,
+             is_eqv_symbol, is_even_symbol, is_exact_symbol, is_float_vector_symbol, is_funclet_symbol,
+             is_gensym_symbol, is_goto_symbol, is_hash_table_symbol, is_immutable_symbol,
+             is_inexact_symbol, is_infinite_symbol, is_input_port_symbol, is_int_vector_symbol, is_integer_symbol, is_iterator_symbol,
+             is_keyword_symbol, is_let_symbol, is_list_symbol, is_macro_symbol, is_equivalent_symbol, is_nan_symbol, is_negative_symbol,
+             is_null_symbol, is_number_symbol, is_odd_symbol, is_openlet_symbol, is_output_port_symbol, is_pair_symbol,
+             is_port_closed_symbol, is_positive_symbol, is_procedure_symbol, is_proper_list_symbol, is_provided_symbol,
+             is_random_state_symbol, is_rational_symbol, is_real_symbol, is_sequence_symbol, is_string_symbol, is_subvector_symbol,
+             is_symbol_symbol, is_syntax_symbol, is_vector_symbol, is_weak_hash_table_symbol, is_zero_symbol,
+             is_float_symbol, is_integer_or_real_at_end_symbol, is_integer_or_any_at_end_symbol, is_unspecified_symbol, is_undefined_symbol,
+             iterate_symbol, iterator_is_at_end_symbol, iterator_sequence_symbol,
+             keyword_to_symbol_symbol,
+             lcm_symbol, length_symbol, leq_symbol, let_ref_fallback_symbol, let_ref_symbol, let_set_fallback_symbol,
+             let_set_symbol, let_temporarily_symbol, libraries_symbol, list_ref_symbol, list_set_symbol, list_symbol, list_tail_symbol, list_values_symbol,
+             load_path_symbol, load_symbol, log_symbol, logand_symbol, logbit_symbol, logior_symbol, lognot_symbol, logxor_symbol, lt_symbol,
+             macro_symbol, macro_star_symbol, magnitude_symbol, make_byte_vector_symbol, make_float_vector_symbol, make_hash_table_symbol,
+             make_weak_hash_table_symbol, make_int_vector_symbol, make_iterator_symbol, string_to_keyword_symbol, make_list_symbol, make_string_symbol,
+             make_vector_symbol, map_symbol, max_symbol, member_symbol, memq_symbol, memv_symbol, min_symbol, modulo_symbol, multiply_symbol,
+             name_symbol, nan_symbol, nan_payload_symbol, newline_symbol, not_symbol, number_to_string_symbol, numerator_symbol,
+             object_to_string_symbol, object_to_let_symbol, open_input_file_symbol, open_input_function_symbol, open_input_string_symbol,
+             open_output_file_symbol, open_output_function_symbol, open_output_string_symbol, openlet_symbol, outlet_symbol, owlet_symbol,
+             pair_filename_symbol, pair_line_number_symbol, peek_char_symbol, pi_symbol, port_filename_symbol, port_line_number_symbol,
+             port_file_symbol, port_position_symbol, port_string_symbol, procedure_source_symbol, provide_symbol,
+             qq_append_symbol, quotient_symbol,
+             random_state_symbol, random_state_to_list_symbol, random_symbol, rationalize_symbol, read_byte_symbol,
+             read_char_symbol, read_line_symbol, read_string_symbol, read_symbol, real_part_symbol, remainder_symbol,
+             require_symbol, reverse_symbol, reverseb_symbol, rootlet_symbol, round_symbol,
+             setter_symbol, set_car_symbol, set_cdr_symbol,
+             set_current_error_port_symbol, set_current_input_port_symbol, set_current_output_port_symbol,
+             signature_symbol, sin_symbol, sinh_symbol, sort_symbol, sqrt_symbol,
+             stacktrace_symbol, string_append_symbol, string_copy_symbol, string_downcase_symbol, string_eq_symbol, string_fill_symbol,
+             string_geq_symbol, string_gt_symbol, string_leq_symbol, string_lt_symbol, string_position_symbol, string_ref_symbol,
+             string_set_symbol, string_symbol, string_to_number_symbol, string_to_symbol_symbol, string_upcase_symbol,
+             sublet_symbol, substring_symbol, substring_uncopied_symbol, subtract_symbol, subvector_symbol, subvector_position_symbol, subvector_vector_symbol,
+             symbol_symbol, symbol_to_dynamic_value_symbol, symbol_initial_value_symbol,
+             symbol_to_keyword_symbol, symbol_to_string_symbol, symbol_to_value_symbol,
+             tan_symbol, tanh_symbol, throw_symbol, string_to_byte_vector_symbol,
+             tree_count_symbol, tree_leaves_symbol, tree_memq_symbol, tree_set_memq_symbol, tree_is_cyclic_symbol, truncate_symbol, type_of_symbol,
+             unlet_symbol,
+             values_symbol, varlet_symbol, vector_append_symbol, vector_dimension_symbol, vector_dimensions_symbol, vector_fill_symbol,
+             vector_rank_symbol, vector_ref_symbol, vector_set_symbol, vector_symbol, vector_typer_symbol,
+             weak_hash_table_symbol, with_input_from_file_symbol, with_input_from_string_symbol, with_output_to_file_symbol, with_output_to_string_symbol,
+             write_byte_symbol, write_char_symbol, write_string_symbol, write_symbol,
+             local_documentation_symbol, local_signature_symbol, local_setter_symbol, local_iterator_symbol;
+  s7_pointer hash_code_symbol, dummy_equal_hash_table, features_setter;
+#if (!WITH_PURE_S7)
+  s7_pointer is_char_ready_symbol, char_ci_leq_symbol, char_ci_lt_symbol, char_ci_eq_symbol, char_ci_geq_symbol, char_ci_gt_symbol,
+             let_to_list_symbol, integer_length_symbol, string_ci_leq_symbol, string_ci_lt_symbol, string_ci_eq_symbol,
+             string_ci_geq_symbol, string_ci_gt_symbol, string_to_list_symbol, vector_to_list_symbol, string_length_symbol,
+             list_to_string_symbol, list_to_vector_symbol, vector_length_symbol;
+#endif
+
+  /* syntax symbols et al */
+  s7_pointer else_symbol, lambda_symbol, lambda_star_symbol, let_symbol, quote_symbol, quasiquote_symbol, unquote_symbol, macroexpand_symbol,
+             define_expansion_symbol, define_expansion_star_symbol, with_let_symbol, if_symbol, autoload_error_symbol,
+             when_symbol, unless_symbol, begin_symbol, cond_symbol, case_symbol, and_symbol, or_symbol, do_symbol, number_to_real_symbol,
+             define_symbol, define_star_symbol, define_constant_symbol, with_baffle_symbol, define_macro_symbol, no_setter_symbol,
+             define_macro_star_symbol, define_bacro_symbol, define_bacro_star_symbol, letrec_symbol, letrec_star_symbol, let_star_symbol,
+             rest_keyword, allow_other_keys_keyword, readable_keyword, display_keyword, write_keyword, value_symbol, type_symbol,
+             baffled_symbol, set_symbol, body_symbol, class_name_symbol, feed_to_symbol, format_error_symbol, immutable_error_symbol,
+             wrong_number_of_args_symbol, read_error_symbol, string_read_error_symbol, syntax_error_symbol, division_by_zero_symbol, bad_result_symbol,
+             io_error_symbol, invalid_exit_function_symbol, wrong_type_arg_symbol, out_of_range_symbol, out_of_memory_symbol,
+             missing_method_symbol, unbound_variable_symbol, if_keyword, symbol_table_symbol, profile_in_symbol, trace_in_symbol,
+             quote_function, quasiquote_function;
+
+  /* signatures of sequences used as applicable objects: ("hi" 1) */
+  s7_pointer string_signature, vector_signature, float_vector_signature, int_vector_signature, byte_vector_signature,
+             c_object_signature, let_signature, hash_table_signature, pair_signature;
+  /* common signatures */
+  s7_pointer pcl_bc, pcl_bs, pcl_bt, pcl_c, pcl_e, pcl_f, pcl_i, pcl_n, pcl_r, pcl_s, pcl_v, pl_bc, pl_bn, pl_bt, pl_p, pl_sf, pl_tl, pl_nn;
+
+  /* optimizer s7_functions */
+  s7_pointer add_2, add_3, add_1x, add_x1, subtract_1, subtract_2, subtract_3, subtract_x1, subtract_2f, subtract_f2, simple_char_eq,
+             char_equal_2, char_greater_2, char_less_2, char_position_csi, string_equal_2, substring_uncopied, display_2, display_f,
+             string_greater_2, string_less_2, symbol_to_string_uncopied, get_output_string_uncopied, string_equal_2c, string_c1, string_append_2,
+             vector_ref_2, vector_ref_3, vector_set_3, vector_set_4, read_char_1, dynamic_wind_unchecked, dynamic_wind_body, dynamic_wind_init, append_2,
+             fv_ref_2, fv_ref_3, fv_set_3, fv_set_unchecked, iv_ref_2, iv_ref_3, iv_set_3, bv_ref_2, bv_ref_3, bv_set_3, vector_2, vector_3,
+             list_0, list_1, list_2, list_3, list_4, list_set_i, hash_table_ref_2, hash_table_2, list_ref_at_0, list_ref_at_1, list_ref_at_2,
+             format_f, format_no_column, format_just_control_string, format_as_objstr, values_uncopied, int_log2, unlet_disabled, unlet_ref, outlet_unlet,
+             memq_2, memq_3, memq_4, memq_any, tree_set_memq_syms, simple_inlet, sublet_curlet, profile_out, simple_list_values,
+             simple_let_ref, simple_let_set, sv_unlet_ref, unlet_set, rootlet_ref, geq_2, add_i_random, is_defined_in_rootlet, is_defined_in_unlet;
+
+  s7_pointer multiply_2, invert_1, invert_x, divide_2, divide_by_2, max_2, min_2, max_3, min_3,
+             num_eq_2, num_eq_xi, num_eq_ix, less_xi, less_xf, less_x0, less_2, greater_xi, greater_xf, greater_2,
+             leq_xi, leq_2, leq_ixx, geq_xi, geq_xf, random_i, random_f, random_1,
+             mul_2_ff, mul_2_ii, mul_2_if, mul_2_fi, mul_2_xi, mul_2_ix, mul_2_fx, mul_2_xf,
+             add_2_ff, add_2_ii, add_2_if, add_2_fi, add_2_xi, add_2_ix, add_2_fx, add_2_xf;
+  s7_pointer seed_symbol, carry_symbol;
+
+  /* object->let symbols */
+  s7_pointer active_symbol, data_symbol, weak_symbol, dimensions_symbol, info_symbol, c_type_symbol, source_symbol, c_object_ref_symbol,
+             at_end_symbol, sequence_symbol, position_symbol, entries_symbol, function_symbol, open_symbol, alias_symbol, port_type_symbol,
+             file_symbol, file_info_symbol, line_symbol, c_object_let_symbol, class_symbol, current_value_symbol, closed_symbol,
+             is_mutable_symbol, size_symbol, original_vector_symbol, pointer_symbol;
+
+#if WITH_SYSTEM_EXTRAS
+  s7_pointer is_directory_symbol, file_exists_symbol, delete_file_symbol, getenv_symbol, system_symbol, directory_to_list_symbol, file_mtime_symbol;
+#endif
+  s7_pointer open_input_function_choices[S7_NUM_READ_CHOICES];
+  s7_pointer closed_input_function, closed_output_function;
+  s7_pointer vector_set_function, string_set_function, list_set_function, hash_table_set_function, let_set_function, c_object_set_function, last_function;
+  s7_pointer wrong_type_arg_info, out_of_range_info, sole_arg_wrong_type_info, sole_arg_out_of_range_info;
+
+  #define NUM_SAFE_PRELISTS 8
+  #define NUM_SAFE_LISTS 32               /* 36 is the biggest normally (lint.scm), 49 in s7test, 57 in snd-test, > 16 doesn't happen much */
+  s7_pointer safe_lists[NUM_SAFE_LISTS];
+  int32_t current_safe_list;
+#if S7_DEBUGGING
+  s7_int safe_list_uses[NUM_SAFE_LISTS];
+#endif
+
+  s7_pointer autoload_table, s7_starlet, s7_starlet_symbol, let_temp_hook;
+  const char ***autoload_names;
+  s7_int *autoload_names_sizes;
+  bool **autoloaded_already;
+  s7_int autoload_names_loc, autoload_names_top;
+  int32_t format_depth;
+  bool undefined_identifier_warnings, undefined_constant_warnings, stop_at_error;
+
+  opt_funcs_t *alloc_opt_func_cells;
+  int32_t alloc_opt_func_k;
+
+  int32_t pc;
+  #define OPTS_SIZE 256          /* pqw-vox needs 178 */
+  opt_info *opts[OPTS_SIZE + 1]; /* this form is a lot faster than opt_info**! */
+
+  #define INITIAL_SAVED_POINTERS_SIZE 256
+  void **saved_pointers;
+  s7_int saved_pointers_loc, saved_pointers_size;
+
+  s7_pointer type_names[NUM_TYPES];
+
+#if S7_DEBUGGING
+  int32_t *tc_rec_calls;
+  bool printing_gc_info;
+  s7_int blocks_allocated, format_ports_allocated;
+#endif
+};
+
+
+static noreturn void error_nr(s7_scheme *sc, s7_pointer type, s7_pointer info);
+static s7_pointer wrap_string(s7_scheme *sc, const char *str, s7_int len);
+
+#if S7_DEBUGGING
+  static void gdb_break(void) {};
+#endif
+
+#ifndef DISABLE_FILE_OUTPUT
+  #define DISABLE_FILE_OUTPUT 0
+#endif
+
+static s7_scheme *cur_sc = NULL; /* intended for gdb (see gdbinit), but also used elsewhere unfortunately */
+static s7_pointer set_elist_1(s7_scheme *sc, s7_pointer x1);
+
+#if DISABLE_FILE_OUTPUT
+static FILE *old_fopen(const char *pathname, const char *mode) {return(fopen(pathname, mode));}
+
+#define fwrite local_fwrite
+#define fopen local_fopen   /* open only used for file_probe (O_RDONLY), creat and write not used */
+
+static size_t local_fwrite(const void *ptr, size_t size, size_t nmemb, FILE *stream)
+{
+  error_nr(cur_sc, cur_sc->io_error_symbol,
+	   set_elist_1(cur_sc, wrap_string(cur_sc, "writing a file is not allowed in this version of s7", 51)));
+}
+
+static FILE *local_fopen(const char *pathname, const char *mode)
+{
+  if ((mode[0] == 'w') || (mode[0] == 'a'))
+    error_nr(cur_sc, cur_sc->io_error_symbol,
+	     set_elist_1(cur_sc, wrap_string(cur_sc, "opening a file is not allowed in this version of s7", 51)));
+  return(old_fopen(pathname, mode));
+}
+#endif
+
+
+#if POINTER_32
+static void *Malloc(size_t bytes)
+{
+  void *p = malloc(bytes);
+  if (!p) error_nr(cur_sc, cur_sc->out_of_memory_symbol, set_elist_1(cur_sc, wrap_string(cur_sc, "malloc failed", 13)));
+  return(p);
+}
+
+static void *Calloc(size_t nmemb, size_t size)
+{
+  void *p = calloc(nmemb, size);
+  if (!p) error_nr(cur_sc, cur_sc->out_of_memory_symbol, set_elist_1(cur_sc, wrap_string(cur_sc, "calloc failed", 13)));
+  return(p);
+}
+
+static void *Realloc(void *ptr, size_t size)
+{
+  void *p = realloc(ptr, size);
+  if (!p) error_nr(cur_sc, cur_sc->out_of_memory_symbol, set_elist_1(cur_sc, wrap_string(cur_sc, "realloc failed", 14)));
+  return(p);
+}
+#else
+#define Malloc malloc
+#define Calloc calloc
+#define Realloc realloc
+#endif
+
+
+/* -------------------------------- mallocate -------------------------------- */
+static void add_saved_pointer(s7_scheme *sc, void *p)
+{
+  if (sc->saved_pointers_loc == sc->saved_pointers_size)
+    {
+      sc->saved_pointers_size *= 2;
+      sc->saved_pointers = (void **)Realloc(sc->saved_pointers, sc->saved_pointers_size * sizeof(void *));
+    }
+  sc->saved_pointers[sc->saved_pointers_loc++] = p;
+}
+
+static const int32_t intlen_bits[256] =
+  {0, 1, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
+   6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
+   7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+   7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+   8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
+   8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
+   8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
+   8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8};
+
+static void memclr(void *s, size_t n)
+{
+  uint8_t *s2;
+#if S7_ALIGNED
+  s2 = (uint8_t *)s;
+#else
+#if (defined(__x86_64__) || defined(__i386__))
+  if (n >= 8)
+    {
+      int64_t *s1 = (int64_t *)s;
+      size_t n8 = n >> 3;
+      do {*s1++ = 0;} while (--n8 > 0); /* LOOP_4 here is slower */
+      n &= 7;
+      s2 = (uint8_t *)s1;
+    }
+  else s2 = (uint8_t *)s;
+#else
+  s2 = (uint8_t *)s;
+#endif
+#endif
+  while (n > 0)
+    {
+      *s2++ = 0;
+      n--;
+    }
+}
+
+#define LOOP_4(Code) do {Code; Code; Code; Code;} while (0)
+#define LOOP_8(Code) do {Code; Code; Code; Code; Code; Code; Code; Code;} while (0)
+#define STEP_8(Var) (((Var) & 0x7) == 0)
+#define STEP_64(Var) (((Var) & 0x3f) == 0)
+
+#if POINTER_32
+#define memclr64 memclr
+#else
+static Vectorized void memclr64(void *p, size_t bytes)
+{
+  size_t n = bytes >> 3;
+  int64_t *vals = (int64_t *)p;
+  for (size_t i = 0; i < n; )
+    LOOP_8(vals[i++] = 0);
+}
+#endif
+
+static void init_block_lists(s7_scheme *sc)
+{
+  for (int32_t i = 0; i < NUM_BLOCK_LISTS; i++)
+    sc->block_lists[i] = NULL;
+#if S7_DEBUGGING
+  sc->blocks_allocated = 0;
+  for (int32_t i = 0; i < NUM_BLOCK_LISTS; i++)
+    sc->blocks_borrowed[i] = 0;
+#endif
+}
+
+static inline void liberate(s7_scheme *sc, block_t *p)
+{
+#if S7_DEBUGGING
+  sc->blocks_freed[block_index(p)]++;
+#endif
+  if (block_index(p) != TOP_BLOCK_LIST)
+    {
+      block_next(p) = (struct block_t *)sc->block_lists[block_index(p)];
+      sc->block_lists[block_index(p)] = p;
+    }
+  else /* biggest blocks (allocated according to each particular size) are freed and placed on the 0-th list */
+    {
+      if (block_data(p))
+	{
+	  free(block_data(p));
+	  block_data(p) = NULL;
+	}
+      block_next(p) = (struct block_t *)sc->block_lists[BLOCK_LIST];
+      sc->block_lists[BLOCK_LIST] = p;
+    }
+}
+
+static inline void liberate_block(s7_scheme *sc, block_t *p)
+{
+#if S7_DEBUGGING
+  sc->blocks_freed[BLOCK_LIST]++;
+#endif
+  block_next(p) = (struct block_t *)sc->block_lists[BLOCK_LIST]; /* BLOCK_LIST==0 */
+  sc->block_lists[BLOCK_LIST] = p;
+}
+
+static void fill_block_list(s7_scheme *sc)
+{
+  #define BLOCK_MALLOC_SIZE 256
+  block_t *b = (block_t *)Malloc(BLOCK_MALLOC_SIZE * sizeof(block_t)); /* batch alloc means blocks in this batch can't be freed, only returned to the list */
+#if S7_DEBUGGING
+  sc->blocks_allocated += BLOCK_MALLOC_SIZE;
+#endif
+  add_saved_pointer(sc, b);
+  sc->block_lists[BLOCK_LIST] = b;
+  for (int32_t i = 0; i < BLOCK_MALLOC_SIZE - 1; b++, i++)
+    block_next(b) = (block_t *)(b + 1);
+  block_next(b) = NULL;
+}
+
+static inline block_t *mallocate_block(s7_scheme *sc)
+{
+  block_t *p;
+  if (!sc->block_lists[BLOCK_LIST])
+    fill_block_list(sc);                /* this is much faster than allocating blocks as needed */
+  p = sc->block_lists[BLOCK_LIST];
+  sc->block_lists[BLOCK_LIST] = (block_t *)(block_next(p));
+  block_set_index(p, BLOCK_LIST);
+  return(p);
+}
+
+static inline char *permalloc(s7_scheme *sc, size_t len)
+{
+  #define ALLOC_STRING_SIZE (65536 * 8) /* going up to 16 made no difference in timings */
+  #define ALLOC_MAX_STRING (512 * 8)    /* was 256 -- sets max size of block space lost at the end, but smaller = more direct malloc calls */
+  char *result;
+  size_t next_k;
+
+  len = (len + 7) & (~7);            /* 8-byte aligned -- more than half the time, len is already 8-byte aligned */
+  next_k = sc->alloc_string_k + len;
+  if (next_k > ALLOC_STRING_SIZE)
+    {
+      if (len >= ALLOC_MAX_STRING)
+	{
+	  result = (char *)Malloc(len);
+	  add_saved_pointer(sc, result);
+	  return(result);
+	}
+      sc->alloc_string_cells = (char *)Malloc(ALLOC_STRING_SIZE); /* get a new block */
+      add_saved_pointer(sc, sc->alloc_string_cells);
+      sc->alloc_string_k = 0;
+      next_k = len;
+    }
+  result = &(sc->alloc_string_cells[sc->alloc_string_k]);
+  sc->alloc_string_k = next_k;
+  return(result);
+}
+
+static Inline block_t *inline_mallocate(s7_scheme *sc, size_t bytes)
+{
+  block_t *p;
+  if (bytes > 0)
+    {
+      int32_t index;
+      if (bytes <= 8) /* presetting a version of intlen_bits with 3's gave only a small speed-up */
+	index = 3;
+      else
+	{
+	  if (bytes <= 256)
+	    index = intlen_bits[bytes - 1];
+	  else index = (bytes <= 65536) ? (8 + intlen_bits[(bytes - 1) >> 8]) : TOP_BLOCK_LIST;   /* expansion to (1 << 17) made no difference */
+	}
+      p = sc->block_lists[index];
+      if (p)
+	{
+#if (S7_DEBUGGING)
+	  sc->blocks_mallocated[index]++;
+#endif
+	  sc->block_lists[index] = (block_t *)block_next(p);
+	}
+      else
+	{
+	  if (index < (TOP_BLOCK_LIST - 1))
+	    {
+	      p = sc->block_lists[index + 1];
+	      if (p)
+		{
+		  /* we are "borrowing" a block from the next larger bin -- this saves space but costs a bit of time.
+		   *   in a tauto run repeating every call 1000 times, the old form ends up at 129M and 31.1 secs,
+		   *   whereas the borrowing form ends at 116M and 31.5 secs, but most of my tests show a slight
+		   *   speed-up, probably because grabbing a block here is faster than making a new one.
+		   *   Worst case is tlet: 8 slower in callgrind.
+		   */
+#if S7_DEBUGGING
+		  sc->blocks_mallocated[index + 1]++;
+		  sc->blocks_borrowed[index + 1]++;
+#endif
+		  sc->block_lists[index + 1] = (block_t *)block_next(p);
+		  block_set_size(p, bytes);
+		  return(p);
+		}}
+	  p = mallocate_block(sc);
+	  block_data(p) = (index < TOP_BLOCK_LIST) ? (void *)permalloc(sc, (size_t)(1 << index)) : Malloc(bytes);
+	  block_set_index(p, index);
+#if S7_DEBUGGING
+	  sc->blocks_mallocated[index]++;
+#endif
+	}}
+  else
+    {
+#if S7_DEBUGGING
+      sc->blocks_mallocated[BLOCK_LIST]++;
+#endif
+      p = mallocate_block(sc);
+    }
+  block_set_size(p, bytes);
+  return(p);
+}
+
+static block_t *mallocate(s7_scheme *sc, size_t bytes) {return(inline_mallocate(sc, bytes));}
+
+static block_t *callocate(s7_scheme *sc, size_t bytes)
+{
+  block_t *p = inline_mallocate(sc, bytes);
+  if ((block_data(p)) && (block_index(p) != BLOCK_LIST))
+    {
+      if ((bytes & (~0x3f)) > 0)
+	memclr64((void *)block_data(p), bytes & (~0x3f));
+      if ((bytes & 0x3f) > 0)
+	memclr((void *)((uint8_t *)block_data(p) + (bytes & (~0x3f))), bytes & 0x3f);
+    }
+  return(p);
+}
+
+static block_t *reallocate(s7_scheme *sc, block_t *op, size_t bytes)
+{
+  block_t *np = inline_mallocate(sc, bytes);
+  if ((S7_DEBUGGING) && (bytes < (size_t)block_size(op))) fprintf(stderr, "reallocate to smaller block?\n");
+  if (block_data(op))  /* presumably block_data(np) is not null */
+    memcpy((uint8_t *)(block_data(np)), (uint8_t *)(block_data(op)), block_size(op));
+  liberate(sc, op);
+  return(np);
+}
+
+/* we can't export mallocate et al without also exporting block_t or accessors for it
+ *   that is, the block_t* pointer returned can't be used as if it were the void* pointer returned by malloc
+ * ideally we'd have a way to release excessive mallocate bins, but they are permalloc'd individually
+ */
+
+
+/* -------------------------------------------------------------------------------- */
+typedef enum {P_DISPLAY, P_WRITE, P_READABLE, P_KEY, P_CODE} use_write_t;
+
+static s7_pointer too_many_arguments_string, not_enough_arguments_string, cant_bind_immutable_string,
+  a_boolean_string, a_byte_vector_string, a_format_port_string, a_let_string, a_list_string, a_non_constant_symbol_string,
+  a_non_negative_integer_string, a_normal_procedure_string, a_normal_real_string, a_number_string, a_procedure_string, a_procedure_or_a_macro_string,
+  a_proper_list_string, a_random_state_object_string, a_rational_string, a_sequence_string, a_symbol_string, a_thunk_string, a_valid_radix_string,
+  an_association_list_string, an_eq_func_string, an_input_file_port_string, an_input_port_string, an_input_string_port_string, an_open_input_port_string,
+  an_open_output_port_string, an_output_port_or_f_string, an_output_file_port_string, an_output_port_string, an_output_string_port_string,
+  an_unsigned_byte_string, caaar_a_list_string, caadr_a_list_string, caar_a_list_string, cadar_a_list_string, caddr_a_list_string,
+  cadr_a_list_string, car_a_list_string, cdaar_a_list_string, cdadr_a_list_string, cdar_a_list_string, cddar_a_list_string,
+  cdddr_a_list_string, cddr_a_list_string, cdr_a_list_string, immutable_error_string, it_is_infinite_string, it_is_nan_string,
+  it_is_negative_string, it_is_too_large_string, it_is_too_small_string, parameter_set_twice_string, result_is_too_large_string,
+  something_applicable_string, too_many_indices_string, intermediate_too_large_string,
+  format_string_1, format_string_2, format_string_3, format_string_4, keyword_value_missing_string;
+
+static bool t_number_p[NUM_TYPES], t_small_real_p[NUM_TYPES], t_rational_p[NUM_TYPES], t_real_p[NUM_TYPES], t_big_number_p[NUM_TYPES];
+static bool t_simple_p[NUM_TYPES], t_structure_p[NUM_TYPES], t_immutable_p[NUM_TYPES];
+static bool t_any_macro_p[NUM_TYPES], t_any_closure_p[NUM_TYPES], t_has_closure_let[NUM_TYPES];
+static bool t_mappable_p[NUM_TYPES], t_sequence_p[NUM_TYPES], t_vector_p[NUM_TYPES];
+static bool t_procedure_p[NUM_TYPES], t_applicable_p[NUM_TYPES], t_macro_setter_p[NUM_TYPES];
+#if S7_DEBUGGING
+static bool t_freeze_p[NUM_TYPES]; /* free_cell sanity check */
+static bool t_ext_p[NUM_TYPES], t_exs_p[NUM_TYPES];    /* make sure internal types don't leak out */
+#endif
+
+static void init_types(void)
+{
+  for (int32_t i = 0; i < NUM_TYPES; i++)
+    {
+      t_number_p[i] = false;
+      t_small_real_p[i] = false;
+      t_real_p[i] = false;
+      t_rational_p[i] = false;
+      t_simple_p[i] = false;
+      t_structure_p[i] = false;
+      t_any_macro_p[i] = false;
+      t_any_closure_p[i] = false;
+      t_has_closure_let[i] = false;
+      t_sequence_p[i] = false;
+      t_mappable_p[i] = false;
+      t_vector_p[i] = false;
+      t_applicable_p[i] = false;
+      t_procedure_p[i] = false;
+      t_macro_setter_p[i] = false;
+      t_immutable_p[i] = true;
+#if S7_DEBUGGING
+      t_freeze_p[i] = false;
+      t_ext_p[i] = false;
+      t_exs_p[i] = false;
+#endif
+    }
+  t_number_p[T_INTEGER] = true; t_number_p[T_RATIO] = true; t_number_p[T_REAL] = true; t_number_p[T_COMPLEX] = true;
+  t_number_p[T_BIG_INTEGER] = true; t_number_p[T_BIG_RATIO] = true; t_number_p[T_BIG_REAL] = true; t_number_p[T_BIG_COMPLEX] = true;
+
+  t_rational_p[T_INTEGER] = true; t_rational_p[T_RATIO] = true;
+  t_rational_p[T_BIG_INTEGER] = true; t_rational_p[T_BIG_RATIO] = true;
+
+  t_small_real_p[T_INTEGER] = true; t_small_real_p[T_RATIO] = true; t_small_real_p[T_REAL] = true;
+
+  t_real_p[T_INTEGER] = true; t_real_p[T_RATIO] = true; t_real_p[T_REAL] = true;
+  t_real_p[T_BIG_INTEGER] = true; t_real_p[T_BIG_RATIO] = true; t_real_p[T_BIG_REAL] = true;
+
+  t_big_number_p[T_BIG_INTEGER] = true; t_big_number_p[T_BIG_RATIO] = true; t_big_number_p[T_BIG_REAL] = true; t_big_number_p[T_BIG_COMPLEX] = true;
+
+  t_structure_p[T_PAIR] = true;
+  t_structure_p[T_VECTOR] = true;
+  t_structure_p[T_HASH_TABLE] = true;
+  t_structure_p[T_SLOT] = true;
+  t_structure_p[T_LET] = true;
+  t_structure_p[T_ITERATOR] = true;
+  t_structure_p[T_C_OBJECT] = true; t_structure_p[T_C_POINTER] = true;
+
+  t_sequence_p[T_NIL] = true; t_sequence_p[T_PAIR] = true;
+  t_sequence_p[T_STRING] = true;
+  t_sequence_p[T_VECTOR] = true; t_sequence_p[T_INT_VECTOR] = true; t_sequence_p[T_FLOAT_VECTOR] = true; t_sequence_p[T_BYTE_VECTOR] = true;
+  t_sequence_p[T_HASH_TABLE] = true;
+  t_sequence_p[T_LET] = true;
+  t_sequence_p[T_C_OBJECT] = true; /* this assumes the object has a length method? */
+
+  t_mappable_p[T_PAIR] = true;
+  t_mappable_p[T_STRING] = true;
+  t_mappable_p[T_VECTOR] = true; t_mappable_p[T_INT_VECTOR] = true; t_mappable_p[T_FLOAT_VECTOR] = true; t_mappable_p[T_BYTE_VECTOR] = true;
+  t_mappable_p[T_HASH_TABLE] = true;
+  t_mappable_p[T_LET] = true;
+  t_mappable_p[T_C_OBJECT] = true;
+  t_mappable_p[T_ITERATOR] = true;
+  t_mappable_p[T_C_MACRO] = true;
+  t_mappable_p[T_MACRO] = true; t_mappable_p[T_MACRO_STAR] = true;
+  t_mappable_p[T_BACRO] = true; t_mappable_p[T_BACRO_STAR] = true;
+  t_mappable_p[T_CLOSURE] = true; t_mappable_p[T_CLOSURE_STAR] = true;
+
+  t_vector_p[T_VECTOR] = true; t_vector_p[T_INT_VECTOR] = true; t_vector_p[T_FLOAT_VECTOR] = true; t_vector_p[T_BYTE_VECTOR] = true;
+
+  t_applicable_p[T_PAIR] = true;
+  t_applicable_p[T_STRING] = true;
+  t_applicable_p[T_VECTOR] = true; t_applicable_p[T_INT_VECTOR] = true; t_applicable_p[T_FLOAT_VECTOR] = true; t_applicable_p[T_BYTE_VECTOR] = true;
+  t_applicable_p[T_HASH_TABLE] = true;
+  t_applicable_p[T_ITERATOR] = true;
+  t_applicable_p[T_LET] = true;
+  t_applicable_p[T_C_OBJECT] = true;
+  t_applicable_p[T_C_MACRO] = true;
+  t_applicable_p[T_MACRO] = true; t_applicable_p[T_MACRO_STAR] = true;
+  t_applicable_p[T_BACRO] = true; t_applicable_p[T_BACRO_STAR] = true;
+  t_applicable_p[T_SYNTAX] = true;
+  t_applicable_p[T_C_FUNCTION] = true; t_applicable_p[T_C_FUNCTION_STAR] = true; t_applicable_p[T_C_RST_NO_REQ_FUNCTION] = true;
+  t_applicable_p[T_CLOSURE] = true; t_applicable_p[T_CLOSURE_STAR] = true;
+  t_applicable_p[T_GOTO] = true; t_applicable_p[T_CONTINUATION] = true;
+
+  /* t_procedure_p[T_C_OBJECT] = true; */
+  t_procedure_p[T_C_FUNCTION] = true; t_procedure_p[T_C_FUNCTION_STAR] = true; t_procedure_p[T_C_RST_NO_REQ_FUNCTION] = true;
+  t_procedure_p[T_CLOSURE] = true; t_procedure_p[T_CLOSURE_STAR] = true;
+  t_procedure_p[T_GOTO] = true; t_procedure_p[T_CONTINUATION] = true;
+
+  for (int32_t i = T_CLOSURE; i < NUM_TYPES; i++) t_macro_setter_p[i] = true;
+  t_macro_setter_p[T_SYMBOL] = true; /* (slot setter); apparently T_LET and T_C_OBJECT are not possible here */
+
+  t_any_macro_p[T_C_MACRO] = true;
+  t_any_macro_p[T_MACRO] = true; t_any_macro_p[T_MACRO_STAR] = true;
+  t_any_macro_p[T_BACRO] = true; t_any_macro_p[T_BACRO_STAR] = true;
+
+  t_any_closure_p[T_CLOSURE] = true; t_any_closure_p[T_CLOSURE_STAR] = true;
+
+  t_has_closure_let[T_MACRO] = true; t_has_closure_let[T_MACRO_STAR] = true;
+  t_has_closure_let[T_BACRO] = true; t_has_closure_let[T_BACRO_STAR] = true;
+  t_has_closure_let[T_CLOSURE] = true; t_has_closure_let[T_CLOSURE_STAR] = true;
+
+  t_simple_p[T_NIL] = true;
+  /* t_simple_p[T_UNDEFINED] = true; */ /* only #<undefined> itself will work with eq? */
+  t_simple_p[T_EOF] = true;
+  t_simple_p[T_BOOLEAN] = true;
+  t_simple_p[T_CHARACTER] = true;
+  t_simple_p[T_SYMBOL] = true;
+  t_simple_p[T_SYNTAX] = true;
+  t_simple_p[T_C_MACRO] = true;
+  t_simple_p[T_C_FUNCTION] = true; t_simple_p[T_C_FUNCTION_STAR] = true; t_simple_p[T_C_RST_NO_REQ_FUNCTION] = true;
+  /* not completely sure about the next ones */
+  /* t_simple_p[T_LET] = true; */ /* this needs let_equal in member et al, 29-Nov-22 */
+  t_simple_p[T_INPUT_PORT] = true; t_simple_p[T_OUTPUT_PORT] = true;
+
+  t_immutable_p[T_PAIR] = false;
+  t_immutable_p[T_UNDEFINED] = false;
+  t_immutable_p[T_SYMBOL] = false;
+  t_immutable_p[T_STRING] = false;
+  t_immutable_p[T_C_OBJECT] = false; t_immutable_p[T_C_POINTER] = false;
+  t_immutable_p[T_VECTOR] = false; t_immutable_p[T_FLOAT_VECTOR] = false; t_immutable_p[T_INT_VECTOR] = false; t_immutable_p[T_BYTE_VECTOR] = false;
+  t_immutable_p[T_HASH_TABLE] = false;
+  t_immutable_p[T_LET] = false;
+  /* t_immutable_p[T_ITERATOR] = false; t_immutable_p[T_INPUT_PORT] = false; t_immutable_p[T_OUTPUT_PORT] = false; */ /* ?? */
+  t_immutable_p[T_SLOT] = false;
+  t_immutable_p[T_RANDOM_STATE] = false;
+
+#if S7_DEBUGGING
+  t_freeze_p[T_STRING] = true;
+  t_freeze_p[T_VECTOR] = true; t_freeze_p[T_FLOAT_VECTOR] = true; t_freeze_p[T_INT_VECTOR] = true; t_freeze_p[T_BYTE_VECTOR] = true;
+  t_freeze_p[T_UNDEFINED] = true;
+  t_freeze_p[T_C_OBJECT] = true;
+  t_freeze_p[T_HASH_TABLE] = true;
+  t_freeze_p[T_C_FUNCTION] = true; t_freeze_p[T_C_FUNCTION_STAR] = true; t_freeze_p[T_C_RST_NO_REQ_FUNCTION] = true;
+  t_freeze_p[T_CONTINUATION] = true;
+  t_freeze_p[T_INPUT_PORT] = true; t_freeze_p[T_OUTPUT_PORT] = true;
+#if WITH_GMP
+  t_freeze_p[T_BIG_INTEGER] = true; t_freeze_p[T_BIG_RATIO] = true; t_freeze_p[T_BIG_REAL] = true; t_freeze_p[T_BIG_COMPLEX] = true;
+  t_freeze_p[T_RANDOM_STATE] = true;
+#endif
+
+  t_ext_p[T_UNUSED] = true;
+  t_ext_p[T_STACK] = true;
+  t_ext_p[T_SLOT] = true;
+  t_ext_p[T_DYNAMIC_WIND] = true;
+  t_ext_p[T_CATCH] = true;
+  t_ext_p[T_COUNTER] = true;
+#if (!WITH_GMP)
+  t_ext_p[T_BIG_INTEGER] = true; t_ext_p[T_BIG_RATIO] = true; t_ext_p[T_BIG_REAL] = true; t_ext_p[T_BIG_COMPLEX] = true;
+#endif
+  t_exs_p[T_STACK] = true;
+  t_exs_p[T_DYNAMIC_WIND] = true;
+  t_exs_p[T_CATCH] = true;
+  t_exs_p[T_COUNTER] = true;
+#endif
+}
+
+#if WITH_HISTORY
+#define current_code(Sc)               car(Sc->cur_code)
+#define set_current_code(Sc, Code)     do {Sc->cur_code = cdr(Sc->cur_code); set_car(Sc->cur_code, T_Ext(Code));} while (0)
+#define replace_current_code(Sc, Code) set_car(Sc->cur_code, T_Ext(Code))
+#define mark_current_code(Sc)          do {int32_t _i_; s7_pointer _p_; for (_p_ = Sc->cur_code, _i_ = 0; _i_ < Sc->history_size; _i_++, _p_ = cdr(_p_)) gc_mark(car(_p_));} while (0)
+#else
+#define current_code(Sc)               Sc->cur_code
+#define set_current_code(Sc, Code)     Sc->cur_code = T_Ext(Code)
+#define replace_current_code(Sc, Code) Sc->cur_code = T_Ext(Code)
+#define mark_current_code(Sc)          gc_mark(Sc->cur_code)
+#endif
+
+#define full_type(p)  ((p)->tf.u64_type)
+#define low_type_bits(p) ((p)->tf.bits.low_bits)
+#define TYPE_MASK    0xff
+
+#if S7_DEBUGGING
+  static void print_gc_info(s7_scheme *sc, s7_pointer obj, const char *func, int32_t line);
+  static s7_pointer check_ref_one(s7_pointer p, uint8_t expected_type, const char *func, int32_t line, const char *func1, const char *func2);
+  static s7_pointer check_ref_num(s7_pointer p, const char *func, int32_t line);
+  static s7_pointer check_ref_app(s7_pointer p, const char *func, int32_t line);
+  static s7_pointer check_ref_ext(s7_pointer p, const char *func, int32_t line);
+  static s7_pointer check_ref_exs(s7_pointer p, const char *func, int32_t line);
+  static s7_pointer check_ref_out(s7_pointer p, const char *func, int32_t line);
+  static s7_pointer check_ref_sln(s7_pointer p, const char *func, int32_t line);
+  static s7_pointer check_nref(s7_pointer p, const char *func, int32_t line);
+  static s7_pointer check_opcode(s7_pointer p, const char *func, int32_t line);
+  static s7_pointer check_let_ref(s7_pointer p, uint64_t role, const char *func, int32_t line);
+  #define unchecked_type(p) ((p)->tf.type_field)
+#if WITH_GCC
+  #define type(p) ({uint8_t _t_; _t_ = (p)->tf.type_field; if ((!cur_sc->printing_gc_info) && ((_t_ == T_FREE) || (_t_ >= NUM_TYPES))) print_gc_info(cur_sc, p, __func__, __LINE__); _t_;})
+#else
+  #define type(p) (p)->tf.type_field
+#endif
+
+  #define set_full_type(p, f) set_type_1(p, f, __func__, __LINE__)
+  /* these check most s7_cell field references (and many type bits) for consistency */
+  #define T_App(P) check_ref_app(P,                      __func__, __LINE__)                /* applicable or #f */
+  #define T_Arg(P) check_ref_arg(P,                      __func__, __LINE__)                /* closure arg (list, symbol) */
+  #define T_BVc(P) check_ref_one(P, T_BYTE_VECTOR,       __func__, __LINE__, "sweep", NULL)
+  #define T_Bgf(P) check_ref_one(P, T_BIG_RATIO,         __func__, __LINE__, "sweep", NULL)
+  #define T_Bgi(P) check_ref_one(P, T_BIG_INTEGER,       __func__, __LINE__, "sweep", NULL)
+  #define T_Bgr(P) check_ref_one(P, T_BIG_REAL,          __func__, __LINE__, "sweep", NULL)
+  #define T_Bgz(P) check_ref_one(P, T_BIG_COMPLEX,       __func__, __LINE__, "sweep", NULL)
+  #define T_CMac(P) check_ref_one(P, T_C_MACRO,          __func__, __LINE__, NULL, NULL)
+  #define T_Cat(P) check_ref_one(P, T_CATCH,             __func__, __LINE__, NULL, NULL)
+  #define T_Chr(P) check_ref_one(P, T_CHARACTER,         __func__, __LINE__, NULL, NULL)
+  #define T_Clo(P) check_ref_clo(P,                      __func__, __LINE__)                /* has closure let */
+  #define T_Cmp(P) check_ref_one(P, T_COMPLEX,           __func__, __LINE__, NULL, NULL)
+  #define T_Con(P) check_ref_one(P, T_CONTINUATION,      __func__, __LINE__, "sweep", "process_continuation")
+  #define T_Ctr(P) check_ref_one(P, T_COUNTER,           __func__, __LINE__, NULL, NULL)
+  #define T_Dyn(P) check_ref_one(P, T_DYNAMIC_WIND,      __func__, __LINE__, NULL, NULL)
+  #define T_Eof(P) check_ref_one(P, T_EOF,               __func__, __LINE__, "sweep", NULL)
+  #define T_Exs(P) check_ref_exs(P,                      __func__, __LINE__)                /* not an internal type, but #<unused> and slot are ok */
+  #define T_Ext(P) check_ref_ext(P,                      __func__, __LINE__)                /* not an internal type */
+  #define T_Fnc(P) check_ref_fnc(P,                      __func__, __LINE__)                /* any c_function|c_macro */
+  #define T_Frc(P) check_ref_two(P, T_RATIO, T_INTEGER,  __func__, __LINE__, NULL, NULL)
+  #define T_Fst(P) check_ref_one(P, T_C_FUNCTION_STAR,   __func__, __LINE__, NULL, NULL)
+  #define T_Fvc(P) check_ref_one(P, T_FLOAT_VECTOR,      __func__, __LINE__, "sweep", NULL)
+  #define T_Got(P) check_ref_one(P, T_GOTO,              __func__, __LINE__, NULL, NULL)
+  #define T_Hsh(P) check_ref_one(P, T_HASH_TABLE,        __func__, __LINE__, "sweep", "free_hash_table")
+  #define T_Int(P) check_ref_one(P, T_INTEGER,           __func__, __LINE__, NULL, NULL)
+  #define T_Itr(P) check_ref_one(P, T_ITERATOR,          __func__, __LINE__, "sweep", "process_iterator")
+  #define T_Ivc(P) check_ref_one(P, T_INT_VECTOR,        __func__, __LINE__, "sweep", NULL)
+  #define T_Key(P) check_ref_key(P,                      __func__, __LINE__)                /* keyword */
+  #define T_Let(P) check_ref_one(P, T_LET,               __func__, __LINE__, NULL, NULL)    /* let+rootlet but not nil */
+  #define T_Lst(P) check_ref_two(P, T_PAIR, T_NIL,       __func__, __LINE__, "gc", NULL)
+  #define T_Mac(P) check_ref_mac(P,                      __func__, __LINE__)                /* a non-C macro */
+  #define T_Met(P) check_ref_met(P,                      __func__, __LINE__)                /* anything that might contain a method */
+  #define T_Nmv(P) check_ref_nmv(P,                      __func__, __LINE__)                /* not multiple-value, not free, only affects slot values */
+  #define T_Num(P) check_ref_num(P,                      __func__, __LINE__)                /* any number (not bignums) */
+  #define T_Nvc(P) check_ref_one(P, T_VECTOR,            __func__, __LINE__, "sweep", NULL)
+  #define T_Obj(P) check_ref_one(P, T_C_OBJECT,          __func__, __LINE__, "sweep", "s7_c_object_value")
+  #define T_Op(P)  check_opcode(P,                       __func__, __LINE__)
+  #define T_Out(P) check_ref_out(P,                      __func__, __LINE__)                /* let or NULL */
+  #define T_Pair(P) check_ref_one(P, T_PAIR,             __func__, __LINE__, NULL, NULL)
+  #define T_Pcs(P) check_ref_two(P, T_PAIR, T_CLOSURE_STAR, __func__, __LINE__, NULL, NULL)
+  #define T_Pos(P) check_nref(P,                         __func__, __LINE__)                /* not free */
+  #define T_Prc(P) check_ref_prc(P,                      __func__, __LINE__)                /* any procedure (3-arg setters) or #f|#t */
+  #define T_Pri(P) check_ref_pri(P,                      __func__, __LINE__)                /* input_port or #f */
+  #define T_Pro(P) check_ref_pro(P,                      __func__, __LINE__)                /* output_port or #f */
+  #define T_Prt(P) check_ref_prt(P,                      __func__, __LINE__)                /* input|output_port */
+  #define T_Ptr(P) check_ref_one(P, T_C_POINTER,         __func__, __LINE__, NULL, NULL)
+  #define T_Ran(P) check_ref_one(P, T_RANDOM_STATE,      __func__, __LINE__, NULL, NULL)
+  #define T_Rel(P) check_ref_one(P, T_REAL,              __func__, __LINE__, NULL, NULL)
+  #define T_Seq(P) check_ref_seq(P,                      __func__, __LINE__)                /* any sequence or structure */
+  #define T_Sld(P) check_ref_two(P, T_SLOT, T_UNDEFINED, __func__, __LINE__, NULL, NULL)
+  #define T_Sln(P) check_ref_sln(P,                      __func__, __LINE__)                /* slot or nil or NULL */
+  #define T_Slt(P) check_ref_one(P, T_SLOT,              __func__, __LINE__, NULL, NULL)
+  #define T_Stk(P) check_ref_one(P, T_STACK,             __func__, __LINE__, NULL, NULL)
+  #define T_Str(P) check_ref_one(P, T_STRING,            __func__, __LINE__, "sweep", NULL)
+  #define T_SVec(P) check_ref_svec(P,                    __func__, __LINE__)                /* subvector */
+  #define T_Sym(P) check_ref_one(P, T_SYMBOL,            __func__, __LINE__, "sweep", "remove_gensym_from_symbol_table")
+  #define T_Syn(P) check_ref_one(P, T_SYNTAX,            __func__, __LINE__, NULL, NULL)
+  #define T_Undf(P) check_ref_one(P, T_UNDEFINED,        __func__, __LINE__, "sweep", NULL)
+  #define T_Vec(P) check_ref_vec(P,                      __func__, __LINE__)                /* any vector */
+#else
+  /* if not debugging, all those checks go away */
+  #define T_App(P)  P
+  #define T_Arg(P)  P
+  #define T_BVc(P)  P
+  #define T_Bgf(P)  P
+  #define T_Bgi(P)  P
+  #define T_Bgr(P)  P
+  #define T_Bgz(P)  P
+  #define T_CMac(P) P
+  #define T_Cat(P)  P
+  #define T_Chr(P)  P
+  #define T_Clo(P)  P
+  #define T_Cmp(P)  P
+  #define T_Con(P)  P
+  #define T_Ctr(P)  P
+  #define T_Dyn(P)  P
+  #define T_Eof(P)  P
+  #define T_Exs(P)  P
+  #define T_Ext(P)  P
+  #define T_Fnc(P)  P
+  #define T_Frc(P)  P
+  #define T_Fst(P)  P
+  #define T_Fvc(P)  P
+  #define T_Got(P)  P
+  #define T_Hsh(P)  P
+  #define T_Int(P)  P
+  #define T_Itr(P)  P
+  #define T_Ivc(P)  P
+  #define T_Key(P)  P
+  #define T_Let(P)  P
+  #define T_Lst(P)  P
+  #define T_Mac(P)  P
+  #define T_Met(P)  P
+  #define T_Nmv(P)  P
+  #define T_Num(P)  P
+  #define T_Nvc(P)  P
+  #define T_Obj(P)  P
+  #define T_Op(P)   P
+  #define T_Out(P)  P
+  #define T_Pair(P) P
+  #define T_Pcs(P)  P
+  #define T_Pos(P)  P
+  #define T_Prc(P)  P
+  #define T_Pri(P)  P
+  #define T_Pro(P)  P
+  #define T_Prt(P)  P
+  #define T_Ptr(P)  P
+  #define T_Ran(P)  P
+  #define T_Rel(P)  P
+  #define T_Seq(P)  P
+  #define T_Sld(P)  P
+  #define T_Sln(P)  P
+  #define T_Slt(P)  P
+  #define T_Stk(P)  P
+  #define T_Str(P)  P
+  #define T_SVec(P) P
+  #define T_Sym(P)  P
+  #define T_Syn(P)  P
+  #define T_Undf(P) P
+  #define T_Vec(P)  P
+
+  #define unchecked_type(p)            ((p)->tf.type_field)
+  #define type(p)                      ((p)->tf.type_field)
+  #define set_full_type(p, f)          full_type(p) = f
+#endif
+#define signed_type(p)                 (p)->tf.s64_type
+#define clear_type(p)                  full_type(p) = T_FREE
+
+#define is_number(P)                   t_number_p[type(P)]
+#define is_small_real(P)               t_small_real_p[type(P)]
+#define is_real(P)                     t_real_p[type(P)]
+#define is_rational(P)                 t_rational_p[type(P)]
+#define is_big_number(p)               t_big_number_p[type(p)]
+#define is_t_integer(p)                (type(p) == T_INTEGER)
+#define is_t_ratio(p)                  (type(p) == T_RATIO)
+#define is_t_real(p)                   (type(p) == T_REAL)
+#define is_t_complex(p)                (type(p) == T_COMPLEX)
+#define is_t_big_integer(p)            (type(p) == T_BIG_INTEGER)
+#define is_t_big_ratio(p)              (type(p) == T_BIG_RATIO)
+#define is_t_big_real(p)               (type(p) == T_BIG_REAL)
+#define is_t_big_complex(p)            (type(p) == T_BIG_COMPLEX)
+
+#define is_boolean(p)                  (type(p) == T_BOOLEAN)
+
+#define is_free(p)                     (type(p) == T_FREE)
+#define is_free_and_clear(p)           (full_type(p) == T_FREE) /* protect against new_cell in-between states? */
+#define is_simple(P)                   t_simple_p[type(P)]  /* eq? */
+#define has_structure(P)               ((t_structure_p[type(P)]) && ((!is_t_vector(P)) || (!has_simple_elements(P))))
+
+#define is_any_macro(P)                t_any_macro_p[type(P)]
+#define is_any_closure(P)              t_any_closure_p[type(P)]
+#define is_any_procedure(P)            (type(P) >= T_CLOSURE)
+#define has_closure_let(P)             t_has_closure_let[type(P)]
+
+#define is_simple_sequence(P)          (t_sequence_p[type(P)])
+#define is_sequence(P)                 ((t_sequence_p[type(P)]) || (has_methods(P)))
+#define is_mutable_sequence(P)         (((t_sequence_p[type(P)]) || (has_methods(P))) && (!is_immutable(P)))
+#define is_sequence_or_iterator(P)     ((t_sequence_p[type(P)]) || (is_iterator(P)))
+#define is_mappable(P)                 (t_mappable_p[type(P)])
+#define is_applicable(P)               (t_applicable_p[type(P)])
+/* this misses #() which is not applicable to anything, and "", and inapplicable c-objects like random-state */
+#define is_procedure(p)                ((t_procedure_p[type(p)]) || ((is_c_object(p)) && (is_safe_procedure(p))))
+#define is_t_procedure(p)              (t_procedure_p[type(p)])
+
+/* the layout of these bits does matter in several cases -- don't shadow SYNTACTIC_PAIR and OPTIMIZED_PAIR */
+
+#define set_type_bit(p, b)             full_type(p) |= (b)
+#define clear_type_bit(p, b)           full_type(p) &= (~(b))
+#define has_type_bit(p, b)             ((full_type(p) & (b)) != 0)
+
+#define set_low_type_bit(p, b)         low_type_bits(p) |= (b)
+#define clear_low_type_bit(p, b)       low_type_bits(p) &= (~(b))
+#define has_low_type_bit(p, b)         ((low_type_bits(p) & (b)) != 0)
+
+#define set_mid_type_bit(p, b)         (p)->tf.bits.mid_bits |= (b)
+#define clear_mid_type_bit(p, b)       (p)->tf.bits.mid_bits &= (~(b))
+#define has_mid_type_bit(p, b)         (((p)->tf.bits.mid_bits & (b)) != 0)
+
+#define set_high_type_bit(p, b)        (p)->tf.bits.high_bits |= (b)
+#define clear_high_type_bit(p, b)      (p)->tf.bits.high_bits &= (~(b))
+#define has_high_type_bit(p, b)        (((p)->tf.bits.high_bits & (b)) != 0)
+
+/* -------- low type bits -------- */
+#define T_SYNTACTIC                    (1 << (8 + 1))
+#define is_symbol_and_syntactic(p)     (low_type_bits(T_Ext(p)) == (uint16_t)(T_SYMBOL | T_SYNTACTIC))
+#define is_syntactic_symbol(p)         has_low_type_bit(T_Sym(p), T_SYNTACTIC)
+#define is_syntactic_pair(p)           has_low_type_bit(T_Pair(p), T_SYNTACTIC)
+#define clear_syntactic(p)             clear_low_type_bit(T_Pair(p), T_SYNTACTIC)
+#define set_syntactic_pair(p)          full_type(T_Pair(p)) = (T_PAIR | T_SYNTACTIC | (full_type(p) & (0xffffffffffff0000 & ~T_OPTIMIZED))) /* used only in pair_set_syntax_op */
+/* this marks symbols that represent syntax objects, it should be in the second byte */
+
+#define T_SIMPLE_ARG_DEFAULTS          (1 << (8 + 2))
+#define lambda_has_simple_defaults(p)  has_low_type_bit(T_Pair(closure_body(p)), T_SIMPLE_ARG_DEFAULTS)
+#define lambda_set_simple_defaults(p)  set_low_type_bit(T_Pair(p), T_SIMPLE_ARG_DEFAULTS)
+/* are all lambda* default values simple? This is set on closure_body, so it doesn't mess up closure_is_ok_1 */
+
+#define T_LIST_IN_USE                  T_SIMPLE_ARG_DEFAULTS
+#define list_is_in_use(p)              has_low_type_bit(T_Pair(p), T_LIST_IN_USE)
+#define set_list_in_use(p)             set_low_type_bit(T_Pair(p), T_LIST_IN_USE)
+#define clear_list_in_use(p)           do {clear_low_type_bit(T_Pair(p), T_LIST_IN_USE); sc->current_safe_list = 0;} while (0)
+
+#define T_ONE_FORM                     T_SIMPLE_ARG_DEFAULTS
+#define set_closure_has_one_form(p)    set_low_type_bit(T_Clo(p), T_ONE_FORM)
+#define T_MULTIFORM                    (1 << (8 + 0))
+#define set_closure_has_multiform(p)   set_low_type_bit(T_Clo(p), T_MULTIFORM)
+#define T_ONE_FORM_FX_ARG              (T_ONE_FORM | T_MULTIFORM)
+#define set_closure_one_form_fx_arg(p) set_low_type_bit(T_Clo(p), T_ONE_FORM_FX_ARG)
+/* can't use T_HAS_FX here because closure_is_ok wants to examine low_type_bits */
+
+#define T_OPTIMIZED                    (1 << (8 + 3))
+#define set_optimized(p)               set_low_type_bit(T_Pair(p), T_OPTIMIZED)
+#define clear_optimized(p)             clear_low_type_bit(T_Pair(p), T_OPTIMIZED | T_SYNTACTIC | T_HAS_FX | T_HAS_FN)
+#define is_optimized(p)                (low_type_bits(T_Ext(p)) == (uint16_t)(T_PAIR | T_OPTIMIZED))
+/* optimizer flag for an expression that has optimization info, it should be in the second byte */
+
+#define T_SCOPE_SAFE                   T_OPTIMIZED
+#define is_scope_safe(p)               has_low_type_bit(T_Fnc(p), T_SCOPE_SAFE)
+#define set_scope_safe(p)              set_low_type_bit(T_Fnc(p), T_SCOPE_SAFE)
+
+#define T_SAFE_CLOSURE                 (1 << (8 + 4))
+#define is_safe_closure(p)             has_low_type_bit(T_Clo(p), T_SAFE_CLOSURE)
+#define set_safe_closure(p)            set_low_type_bit(T_Clo(p), T_SAFE_CLOSURE)
+#define is_safe_closure_body(p)        has_low_type_bit(T_Pair(p), T_SAFE_CLOSURE)
+#define set_safe_closure_body(p)       set_low_type_bit(T_Pair(p), T_SAFE_CLOSURE)
+#define clear_safe_closure_body(p)     clear_low_type_bit(T_Pair(p), T_SAFE_CLOSURE)
+
+/* optimizer flag for a closure body that is completely simple (every expression is safe)
+ *   set_safe_closure happens in define_funchcecked letrec_setup_closures etc, clear only in procedure_source, bits only here
+ *   this has to be separate from T_SAFE_PROCEDURE, and should be in the second byte (closure_is_ok_1 checks low_type_bits).
+ * define -> optimize_lambda sets safe -> define_funchecked -> make_funclet for the let
+ *   similarly, named let -> optimize_lambda, then let creates the let if safe
+ *   thereafter, optimizer uses OP_SAFE_CLOSURE* which calls update_let*
+ */
+
+#define T_DONT_EVAL_ARGS               (1 << (8 + 5))
+#define dont_eval_args(p)              has_low_type_bit(T_Ext(p), T_DONT_EVAL_ARGS)
+/* this marks things that don't evaluate their arguments */
+
+#define T_EXPANSION                    (1 << (8 + 6))
+#define is_expansion(p)                has_low_type_bit(T_Ext(p), T_EXPANSION)
+#define clear_expansion(p)             clear_low_type_bit(T_Sym(p), T_EXPANSION)
+/* this marks the symbol and its run-time macro value, distinguishing it from an ordinary macro */
+
+#define T_MULTIPLE_VALUE               (1 << (8 + 7))
+#define is_multiple_value(p)           has_low_type_bit(T_Exs(p), T_MULTIPLE_VALUE) /* not T_Ext -- can be a slot */
+#if S7_DEBUGGING
+#define set_multiple_value(p)          do {if (!in_heap(p)) {fprintf(stderr, "%s[%d] (from set_multiple_value): arg not in heap\n", __func__, __LINE__); abort();} set_low_type_bit(T_Pair(p), T_MULTIPLE_VALUE);} while (0)
+#else
+#define set_multiple_value(p)          set_low_type_bit(T_Pair(p), T_MULTIPLE_VALUE)
+#endif
+#define clear_multiple_value(p)        clear_low_type_bit(T_Pair(p), T_MULTIPLE_VALUE)
+#define multiple_value(p)              p
+/* this bit marks a list (from "values") that is waiting for a chance to be spliced into its caller's argument list */
+
+#define T_MATCHED                      T_MULTIPLE_VALUE
+#define is_matched_pair(p)             has_low_type_bit(T_Pair(p), T_MATCHED)
+#define clear_match_pair(p)            clear_low_type_bit(T_Pair(p), T_MATCHED)
+#define set_match_pair(p)              set_low_type_bit(T_Pair(p), T_MATCHED)
+#define set_match_symbol(p)            set_low_type_bit(T_Sym(p), T_MATCHED)
+#define is_matched_symbol(p)           has_low_type_bit(T_Sym(p), T_MATCHED)
+#define clear_match_symbol(p)          clear_low_type_bit(T_Sym(p), T_MATCHED)
+
+/* -------- mid type bits -------- */
+
+#define T_UNSAFE_DO                    (1 << (16 + 0))
+#define T_MID_UNSAFE_DO                (1 << 0)
+#define is_unsafe_do(p)                has_mid_type_bit(T_Pair(p), T_MID_UNSAFE_DO)
+#define set_unsafe_do(p)               set_mid_type_bit(T_Pair(p), T_MID_UNSAFE_DO)
+/* marks do-loops that resist optimization */
+
+#define T_MID_DOX_SLOT1                T_MID_UNSAFE_DO
+#define has_dox_slot1(p)               has_mid_type_bit(T_Let(p), T_MID_DOX_SLOT1)
+#define set_has_dox_slot1(p)           set_mid_type_bit(T_Let(p), T_MID_DOX_SLOT1)
+/* marks a let that includes the dox_slot1 */
+
+#define T_COLLECTED                    (1 << (16 + 1))
+#define T_MID_COLLECTED                (1 << 1)
+#define is_collected(p)                has_mid_type_bit(T_Seq(p), T_MID_COLLECTED)
+#define is_collected_unchecked(p)      has_mid_type_bit(p, T_MID_COLLECTED)
+#define set_collected(p)               set_mid_type_bit(T_Seq(p), T_MID_COLLECTED)
+/* #define clear_collected(p)          clear_mid_type_bit(T_Seq(p), T_MID_COLLECTED) */
+/* this is a transient flag used by the printer to catch cycles.  It affects only objects that have structure.
+ *   We can't use a low bit (bit 7 for example), because collect_shared_info inspects the object's type.
+ */
+
+#define T_LOCATION                     (1 << (16 + 2))
+#define T_MID_LOCATION                 (1 << 2)
+#define has_location(p)                has_mid_type_bit(T_Pair(p), T_MID_LOCATION)
+#define set_has_location(p)            set_mid_type_bit(T_Pair(p), T_MID_LOCATION)
+/* pair in question has line/file/position info added during read, or the environment has function placement info
+ *   this bit should not be in the first byte -- SYNTACTIC_PAIR ignores it.
+ */
+
+#define T_LOADER_PORT                  T_MID_LOCATION
+#define is_loader_port(p)              has_mid_type_bit(T_Pri(p), T_LOADER_PORT)
+#define set_loader_port(p)             set_mid_type_bit(T_Pri(p), T_LOADER_PORT)
+#define clear_loader_port(p)           clear_mid_type_bit(T_Pri(p), T_LOADER_PORT)
+/* this bit marks a port used by the loader so that random load-time reads do not screw up the load process */
+
+#define T_HAS_SETTER                   T_MID_LOCATION
+#define slot_has_setter(p)             has_mid_type_bit(T_Slt(p), T_HAS_SETTER)
+#define slot_set_has_setter(p)         set_mid_type_bit(T_Slt(p), T_HAS_SETTER)
+/* marks a slot that has a setter or symbol that might have a setter */
+
+#define T_WITH_LET_LET                 T_MID_LOCATION
+#define is_with_let_let(p)             has_mid_type_bit(T_Let(p), T_WITH_LET_LET)
+#define set_with_let_let(p)            set_mid_type_bit(T_Let(p), T_WITH_LET_LET)
+/* marks a let that is the argument to with-let (but not rootlet in its uses) */
+
+#define T_SIMPLE_DEFAULTS              T_MID_LOCATION
+#define c_func_has_simple_defaults(p)  has_mid_type_bit(T_Fst(p), T_SIMPLE_DEFAULTS)
+#define c_func_set_simple_defaults(p)  set_mid_type_bit(T_Fst(p), T_SIMPLE_DEFAULTS)
+#define c_func_clear_simple_defaults(p) clear_mid_type_bit(T_Fst(p), T_SIMPLE_DEFAULTS)
+/* flag c_func_star arg defaults that need GC protection */
+
+#define T_NO_SETTER                    T_MID_LOCATION
+#define closure_no_setter(p)           has_mid_type_bit(T_Clo(p), T_NO_SETTER)
+#define closure_set_no_setter(p)       set_mid_type_bit(T_Clo(p), T_NO_SETTER)
+
+#define T_SHARED                       (1 << (16 + 3))
+#define T_MID_SHARED                   (1 << 3)
+#define is_shared(p)                   has_mid_type_bit(T_Seq(p), T_MID_SHARED)
+#define set_shared(p)                  set_mid_type_bit(T_Seq(p), T_MID_SHARED)
+#define is_collected_or_shared(p)      has_mid_type_bit(p, T_MID_COLLECTED | T_MID_SHARED)
+#define clear_collected_and_shared(p)  clear_mid_type_bit(p, T_MID_COLLECTED | T_MID_SHARED) /* this can clear free cells = calloc */
+
+#define T_LOW_COUNT                    (1 << (16 + 4))
+#define T_MID_LOW_COUNT                (1 << 4)
+#define has_low_count(p)               has_mid_type_bit(T_Pair(p), T_LOW_COUNT)
+#define set_has_low_count(p)           set_mid_type_bit(T_Pair(p), T_LOW_COUNT)
+
+#define T_TC                           T_MID_LOW_COUNT
+#define has_tc(p)                      has_mid_type_bit(T_Pair(p), T_TC)
+#define set_has_tc(p)                  set_mid_type_bit(T_Pair(p), T_TC)
+
+#define T_SAFE_PROCEDURE               (1 << (16 + 5))
+#define T_MID_SAFE_PROCEDURE           (1 << 5)
+#define is_safe_procedure(p)           has_mid_type_bit(T_App(p), T_MID_SAFE_PROCEDURE)
+#define is_safe_or_scope_safe_procedure(p) ((full_type(T_Fnc(p)) & (T_SCOPE_SAFE | T_SAFE_PROCEDURE)) != 0) /* T_SCOPE_SAFE is a low_type bit */
+/* applicable objects that do not return or modify their arg list directly (no :rest arg in particular),
+ *    and that can't call themselves either directly or via s7_call, and that don't mess with the stack.
+ */
+
+#define T_CHECKED                      (1 << (16 + 6))
+#define T_MID_CHECKED                  (1 << 6)
+#define set_checked(p)                 set_mid_type_bit(T_Pair(p), T_MID_CHECKED)
+#define is_checked(p)                  has_mid_type_bit(T_Pair(p), T_MID_CHECKED)
+#define clear_checked(p)               clear_mid_type_bit(T_Pair(p), T_MID_CHECKED)
+#define set_checked_slot(p)            set_mid_type_bit(T_Slt(p), T_MID_CHECKED)
+#define is_checked_slot(p)             has_mid_type_bit(T_Slt(p), T_MID_CHECKED)
+#define clear_checked_slot(p)          clear_mid_type_bit(T_Slt(p), T_MID_CHECKED)
+
+#define T_ALL_INTEGER                  T_MID_CHECKED
+#define is_all_integer(p)              has_mid_type_bit(T_Sym(p), T_ALL_INTEGER)
+#define set_all_integer(p)             set_mid_type_bit(T_Sym(p), T_ALL_INTEGER)
+
+#define T_UNSAFE                       (1 << (16 + 7))
+#define T_MID_UNSAFE                   (1 << 7)
+#define set_unsafe(p)                  set_mid_type_bit(T_Pair(p), T_MID_UNSAFE)
+#define set_unsafely_optimized(p)      full_type(T_Pair(p)) = (full_type(p) | T_UNSAFE | T_OPTIMIZED) /* T_OPTIMIZED is a low_type bit */
+#define is_unsafe(p)                   has_mid_type_bit(T_Pair(p), T_MID_UNSAFE)
+#define clear_unsafe(p)                clear_mid_type_bit(T_Pair(p), T_MID_UNSAFE)
+#define is_safely_optimized(p)         ((full_type(T_Pair(p)) & (T_OPTIMIZED | T_UNSAFE)) == T_OPTIMIZED)
+/* optimizer flag saying "this expression is not completely self-contained.  It might involve the stack, etc" */
+
+#define T_CLEAN_SYMBOL                 T_MID_UNSAFE
+#define is_clean_symbol(p)             has_mid_type_bit(T_Sym(p), T_CLEAN_SYMBOL)
+#define set_clean_symbol(p)            set_mid_type_bit(T_Sym(p), T_CLEAN_SYMBOL)
+/* set if we know the symbol name can be printed without quotes (slashification) */
+
+#define T_HAS_STEPPER                  T_MID_UNSAFE
+#define has_stepper(p)                 has_mid_type_bit(T_Slt(p), T_HAS_STEPPER)
+#define set_has_stepper(p)             set_mid_type_bit(T_Slt(p), T_HAS_STEPPER)
+
+#define T_DOX_SLOT2                    T_MID_UNSAFE
+#define has_dox_slot2(p)               has_mid_type_bit(T_Let(p), T_DOX_SLOT2)
+#define set_has_dox_slot2(p)           set_mid_type_bit(T_Let(p), T_DOX_SLOT2)
+/* marks a let that includes the dox_slot2 */
+
+#define T_IMMUTABLE                    (1 << (16 + 8))
+#define T_MID_IMMUTABLE                (1 << 8)
+#define is_immutable(p)                has_mid_type_bit(T_Exs(p), T_MID_IMMUTABLE)
+#define set_immutable(p)               set_mid_type_bit(T_Exs(p), T_MID_IMMUTABLE) /* can be a slot, so not T_Ext */
+#define set_immutable_let(p)           set_mid_type_bit(T_Let(p), T_MID_IMMUTABLE)
+#define set_immutable_slot(p)          set_mid_type_bit(T_Slt(p), T_MID_IMMUTABLE)
+#define is_immutable_port(p)           has_mid_type_bit(T_Prt(p), T_MID_IMMUTABLE)
+#define is_immutable_symbol(p)         has_mid_type_bit(T_Sym(p), T_MID_IMMUTABLE)
+#define is_immutable_slot(p)           has_mid_type_bit(T_Slt(p), T_MID_IMMUTABLE)
+#define is_immutable_pair(p)           has_mid_type_bit(T_Pair(p), T_MID_IMMUTABLE)
+#define is_immutable_vector(p)         has_mid_type_bit(T_Vec(p), T_MID_IMMUTABLE)
+#define is_immutable_string(p)         has_mid_type_bit(T_Str(p), T_MID_IMMUTABLE)
+#define is_immutable_hash_table(p)     has_mid_type_bit(T_Hsh(p), T_MID_IMMUTABLE)
+#define is_immutable_let(p)            has_mid_type_bit(T_Let(p), T_MID_IMMUTABLE)
+/* T_IMMUTABLE is compatible with T_MUTABLE -- the latter is an internal bit for locally mutable numbers */
+
+#define T_SETTER                       (1 << (16 + 9))
+#define T_MID_SETTER                   (1 << 9)
+#define set_is_setter(p)               set_mid_type_bit(T_Sym(p), T_MID_SETTER)
+#define is_setter(p)                   has_mid_type_bit(T_Sym(p), T_MID_SETTER)
+/* optimizer flag for a procedure that sets some variable (set-car! for example) */
+
+#define T_ALLOW_OTHER_KEYS             T_MID_SETTER
+#define set_allow_other_keys(p)        set_mid_type_bit(T_Pair(p), T_ALLOW_OTHER_KEYS)
+#define allows_other_keys(p)           has_mid_type_bit(T_Pair(p), T_ALLOW_OTHER_KEYS)
+#define c_function_set_allow_other_keys(p) set_mid_type_bit(T_Fst(p), T_ALLOW_OTHER_KEYS)
+#define c_function_allows_other_keys(p)    has_mid_type_bit(T_Fst(p), T_ALLOW_OTHER_KEYS)
+/* marks arglist (or c_function*) that allows keyword args other than those in the parameter list;
+ *   we can't allow (define* (f :allow-other-keys)...) because there's only one nil, and besides, it does say "other".
+ */
+
+#define T_LET_REMOVED                  T_MID_SETTER
+#define let_set_removed(p)             set_mid_type_bit(T_Let(p), T_LET_REMOVED)
+#define let_removed(p)                 has_mid_type_bit(T_Let(p), T_LET_REMOVED)
+/* mark lets that have been removed from the heap or checked for that possibility */
+
+#define T_HAS_EXPRESSION               T_MID_SETTER
+#define slot_set_has_expression(p)     set_mid_type_bit(T_Slt(p), T_HAS_EXPRESSION)
+#define slot_has_expression(p)         has_mid_type_bit(T_Slt(p), T_HAS_EXPRESSION)
+
+#define T_MUTABLE                      (1 << (16 + 10))
+#define T_MID_MUTABLE                  (1 << 10)
+#define is_mutable_number(p)           has_mid_type_bit(p, T_MID_MUTABLE)
+#define is_mutable_integer(p)          has_mid_type_bit(T_Int(p), T_MID_MUTABLE)
+#define clear_mutable_number(p)        clear_mid_type_bit(p, T_MID_MUTABLE)
+#define clear_mutable_integer(p)       clear_mid_type_bit(T_Int(p), T_MID_MUTABLE)
+/* used for mutable numbers, can occur with T_IMMUTABLE (outside view vs inside) */
+
+#define T_HAS_KEYWORD                  T_MID_MUTABLE
+#define has_keyword(p)                 has_mid_type_bit(T_Sym(p), T_HAS_KEYWORD)
+#define set_has_keyword(p)             set_mid_type_bit(T_Sym(p), T_HAS_KEYWORD)
+
+#define T_MARK_SEQ                     T_MID_MUTABLE
+#define is_mark_seq(p)                 has_mid_type_bit(T_Itr(p), T_MARK_SEQ)
+#define set_mark_seq(p)                set_mid_type_bit(T_Itr(p), T_MARK_SEQ)
+/* used in iterators for GC mark of sequence */
+
+#define T_HAS_LOOP_END                 T_MID_MUTABLE
+#define has_loop_end(p)                has_mid_type_bit(T_Slt(p), T_HAS_LOOP_END)
+#define loop_end_fits(Slot, Len)       ((has_loop_end(Slot)) && (denominator(slot_value(Slot)) <= Len))
+#define set_has_loop_end(p)            set_mid_type_bit(T_Slt(p), T_HAS_LOOP_END)
+/* marks a slot that holds a do-loop's step-or-end variable, numerator=current, denominator=end */
+
+#define T_NO_CELL_OPT                  T_MID_MUTABLE
+#define set_no_cell_opt(p)             set_mid_type_bit(T_Pair(p), T_NO_CELL_OPT)
+#define no_cell_opt(p)                 has_mid_type_bit(T_Pair(p), T_NO_CELL_OPT)
+
+#define T_IS_ELIST                     T_MUTABLE
+#define T_MID_IS_ELIST                 T_MID_MUTABLE
+#define set_is_elist(p)                set_mid_type_bit(T_Lst(p), T_MID_IS_ELIST)
+#define is_elist(p)                    has_mid_type_bit(T_Lst(p), T_MID_IS_ELIST)
+
+#define T_NO_INT_OPT                   T_MID_SETTER
+#define set_no_int_opt(p)              set_mid_type_bit(T_Pair(p), T_NO_INT_OPT)
+#define no_int_opt(p)                  has_mid_type_bit(T_Pair(p), T_NO_INT_OPT)
+
+#define T_NO_FLOAT_OPT                 T_MID_UNSAFE
+#define set_no_float_opt(p)            set_mid_type_bit(T_Pair(p), T_NO_FLOAT_OPT)
+#define no_float_opt(p)                has_mid_type_bit(T_Pair(p), T_NO_FLOAT_OPT)
+
+#define T_INTEGER_KEYS                 T_MID_SETTER
+#define set_has_integer_keys(p)        set_mid_type_bit(T_Pair(p), T_INTEGER_KEYS)
+#define has_integer_keys(p)            has_mid_type_bit(T_Pair(p), T_INTEGER_KEYS)
+
+#define T_SAFE_STEPPER                 (1 << (16 + 11))
+#define T_MID_SAFE_STEPPER             (1 << 11)
+#define is_safe_stepper(p)             has_mid_type_bit(T_Slt(p), T_MID_SAFE_STEPPER)
+#define set_safe_stepper(p)            set_mid_type_bit(T_Slt(p), T_MID_SAFE_STEPPER)
+#define clear_safe_stepper(p)          clear_mid_type_bit(T_Slt(p), T_MID_SAFE_STEPPER)
+#define is_safe_stepper_expr(p)        has_mid_type_bit(T_Pair(p), T_MID_SAFE_STEPPER)
+#define set_safe_stepper_expr(p)       set_mid_type_bit(T_Pair(p), T_MID_SAFE_STEPPER)
+
+#define T_NO_BOOL_OPT                  T_MID_SAFE_STEPPER
+#define set_no_bool_opt(p)             set_mid_type_bit(T_Pair(p), T_NO_BOOL_OPT)
+#define no_bool_opt(p)                 has_mid_type_bit(T_Pair(p), T_NO_BOOL_OPT)
+
+#define T_NUMBER_NAME                  T_MID_SAFE_STEPPER
+#define has_number_name(p)             has_mid_type_bit(T_Num(p), T_NUMBER_NAME)
+#define set_has_number_name(p)         set_mid_type_bit(T_Num(p), T_NUMBER_NAME)
+/* marks numbers that have a saved version of their string representation; this only matters in teq.scm, maybe tread.scm */
+
+#define T_MAYBE_SAFE                   T_MID_SAFE_STEPPER
+#define is_maybe_safe(p)               has_mid_type_bit(T_Fnc(p), T_MAYBE_SAFE)
+#define set_maybe_safe(p)              set_mid_type_bit(T_Fnc(p), T_MAYBE_SAFE)
+
+#define T_PAIR_MACRO                   T_MID_SAFE_STEPPER
+#define has_pair_macro(p)              has_mid_type_bit(T_Mac(p), T_PAIR_MACRO)
+#define set_has_pair_macro(p)          set_mid_type_bit(T_Mac(p), T_PAIR_MACRO)
+
+#define T_WEAK_HASH                    T_MID_SAFE_STEPPER
+#define set_weak_hash_table(p)         set_mid_type_bit(T_Hsh(p), T_WEAK_HASH)
+#define is_weak_hash_table(p)          has_mid_type_bit(T_Hsh(p), T_WEAK_HASH)
+
+#define T_ALL_FLOAT                    T_MID_SAFE_STEPPER
+#define is_all_float(p)                has_mid_type_bit(T_Sym(p), T_ALL_FLOAT)
+#define set_all_float(p)               set_mid_type_bit(T_Sym(p), T_ALL_FLOAT)
+#define set_all_integer_and_float(p)   set_mid_type_bit(T_Sym(p), (T_ALL_INTEGER | T_ALL_FLOAT))
+
+#define T_COPY_ARGS                    (1 << (16 + 12))
+#define T_MID_COPY_ARGS                (1 << 12)
+#define needs_copied_args(p)           has_mid_type_bit(T_Ext(p), T_MID_COPY_ARGS) /* set via explicit T_COPY_ARGS, on T_Pos see s7_apply_function */
+#define set_needs_copied_args(p)       set_mid_type_bit(T_Pair(p), T_MID_COPY_ARGS)
+#define clear_needs_copied_args(p)     clear_mid_type_bit(T_Pair(p), T_MID_COPY_ARGS)
+/* this marks something that might mess with its argument list, it should not be in the second byte */
+
+#define T_GENSYM                       (1 << (16 + 13))
+#define T_MID_GENSYM                   (1 << 13)
+#define is_gensym(p)                   has_mid_type_bit(T_Sym(p), T_MID_GENSYM)
+/* symbol is from gensym (GC-able etc) */
+
+#define T_FUNCLET                      T_GENSYM
+#define T_MID_FUNCLET                  T_MID_GENSYM
+#define is_funclet(p)                  has_mid_type_bit(T_Let(p), T_MID_FUNCLET)
+#define set_funclet(p)                 set_mid_type_bit(T_Let(p), T_MID_FUNCLET)
+/* this marks a funclet */
+
+#define T_HASH_CHOSEN                  T_MID_GENSYM
+#define hash_chosen(p)                 has_mid_type_bit(T_Hsh(p), T_HASH_CHOSEN)
+#define hash_set_chosen(p)             set_mid_type_bit(T_Hsh(p), T_HASH_CHOSEN)
+#define hash_clear_chosen(p)           clear_mid_type_bit(T_Hsh(p), T_HASH_CHOSEN)
+
+#define T_DOCUMENTED                   T_MID_GENSYM
+#define is_documented(p)               has_mid_type_bit(T_Str(p), T_DOCUMENTED)
+#define set_documented(p)              set_mid_type_bit(T_Str(p), T_DOCUMENTED)
+/* this marks a symbol that has documentation (bit is set on name cell) */
+
+#define T_FX_TREED                     T_MID_GENSYM
+#define is_fx_treed(p)                 has_mid_type_bit(T_Pair(p), T_FX_TREED)
+#define set_fx_treed(p)                set_mid_type_bit(T_Pair(p), T_FX_TREED)
+
+#define T_SUBVECTOR                    T_GENSYM
+#define T_MID_SUBVECTOR                T_MID_GENSYM
+#define is_subvector(p)                has_mid_type_bit(T_Vec(p), T_MID_SUBVECTOR)
+
+#define T_HAS_PENDING_VALUE            T_MID_GENSYM
+#define slot_set_has_pending_value(p)  set_mid_type_bit(T_Slt(p), T_HAS_PENDING_VALUE)
+#define slot_has_pending_value(p)      has_mid_type_bit(T_Slt(p), T_HAS_PENDING_VALUE)
+#define slot_clear_has_pending_value(p) do {clear_mid_type_bit(T_Slt(p), T_HAS_PENDING_VALUE); slot_set_pending_value(p, sc->F);} while (0)
+#define slot_has_setter_or_pending_value(p) has_mid_type_bit(p, T_HAS_SETTER | T_HAS_PENDING_VALUE)
+
+#define T_HAS_METHODS                  (1 << (16 + 14))
+#define T_MID_HAS_METHODS              (1 << 14)
+#define has_methods(p)                 has_mid_type_bit(T_Exs(p), T_MID_HAS_METHODS) /* display slot hits T_Ext here */
+#define is_openlet(p)                  has_mid_type_bit(T_Let(p), T_MID_HAS_METHODS)
+#define has_active_methods(sc, p)      ((has_mid_type_bit(T_Ext(p), T_MID_HAS_METHODS)) && (sc->has_openlets)) /* g_char #<eof> */
+#define set_has_methods(p)             set_mid_type_bit(T_Met(p), T_MID_HAS_METHODS)
+#define clear_has_methods(p)           clear_mid_type_bit(T_Met(p), T_MID_HAS_METHODS)
+/* this marks an environment or closure that is "open" for generic functions etc, don't reuse this bit */
+
+/* T_HAS_METHODS: pair (and other types like symbol) are available here */
+
+#define mid_type(p)                    (p)->tf.bits.mid_bits
+#define T_HAS_LET_SET_FALLBACK         T_SAFE_STEPPER
+#define T_MID_HAS_LET_SET_FALLBACK     T_MID_SAFE_STEPPER
+#define T_HAS_LET_REF_FALLBACK         T_MUTABLE
+#define T_MID_HAS_LET_REF_FALLBACK     T_MID_MUTABLE
+#define has_let_ref_fallback(p)        ((mid_type(T_Let(p)) & (T_MID_HAS_LET_REF_FALLBACK | T_MID_HAS_METHODS)) == (T_MID_HAS_LET_REF_FALLBACK | T_MID_HAS_METHODS))
+#define has_let_set_fallback(p)        ((mid_type(T_Let(p)) & (T_MID_HAS_LET_SET_FALLBACK | T_MID_HAS_METHODS)) == (T_MID_HAS_LET_SET_FALLBACK | T_MID_HAS_METHODS))
+#define set_has_let_ref_fallback(p)    set_mid_type_bit(T_Let(p), T_MID_HAS_LET_REF_FALLBACK)
+#define set_has_let_set_fallback(p)    set_mid_type_bit(T_Let(p), T_MID_HAS_LET_SET_FALLBACK)
+#define has_let_fallback(p)            has_mid_type_bit(T_Let(p), (T_MID_HAS_LET_REF_FALLBACK | T_MID_HAS_LET_SET_FALLBACK))
+#define set_all_methods(p, e)          mid_type(T_Let(p)) |= (mid_type(e) & (T_MID_HAS_METHODS | T_MID_HAS_LET_REF_FALLBACK | T_MID_HAS_LET_SET_FALLBACK))
+
+#define T_ITER_OK                      (1LL << (16 + 15))
+#define T_MID_ITER_OK                  (1 << 15)
+#define iter_ok(p)                     has_mid_type_bit(T_Itr(p), T_MID_ITER_OK)
+#define clear_iter_ok(p)               clear_mid_type_bit(T_Itr(p), T_MID_ITER_OK)
+
+#define T_LOOP_END_POSSIBLE            T_MID_ITER_OK
+#define loop_end_possible(p)           has_mid_type_bit(T_Pair(p), T_LOOP_END_POSSIBLE)
+#define set_loop_end_possible(p)       set_mid_type_bit(T_Pair(p), T_LOOP_END_POSSIBLE)
+
+#define T_IN_ROOTLET                   T_MID_ITER_OK
+#define in_rootlet(p)                  has_mid_type_bit(T_Slt(p), T_IN_ROOTLET)
+#define set_in_rootlet(p)              set_mid_type_bit(T_Slt(p), T_IN_ROOTLET)
+
+#define T_BOOL_FUNCTION                T_MID_ITER_OK
+#define is_bool_function(p)            has_mid_type_bit(T_Prc(p), T_BOOL_FUNCTION)
+#define set_is_bool_function(p)        set_mid_type_bit(T_Fnc(p), T_BOOL_FUNCTION)
+
+#define T_SYMBOL_FROM_SYMBOL           T_MID_ITER_OK
+#define is_symbol_from_symbol(p)       has_mid_type_bit(T_Sym(p), T_SYMBOL_FROM_SYMBOL)
+#define set_is_symbol_from_symbol(p)   set_mid_type_bit(T_Sym(p), T_SYMBOL_FROM_SYMBOL)
+#define clear_symbol_from_symbol(p)    clear_mid_type_bit(T_Sym(p), T_SYMBOL_FROM_SYMBOL) /* was high_type?? 20-Dec-23 */
+
+
+/* -------- high type bits -------- */
+/* it's faster here to use the high_bits bits rather than typeflag bits */
+#define T_FULL_SYMCONS                 (1LL << (48 + 0))
+#define T_SYMCONS                      (1 << 0)
+#define is_possibly_constant(p)        has_high_type_bit(T_Sym(p), T_SYMCONS)
+#define set_possibly_constant(p)       set_high_type_bit(T_Sym(p), T_SYMCONS)
+#define is_probably_constant(p)        has_type_bit(T_Sym(p), (T_FULL_SYMCONS | T_IMMUTABLE))
+
+#define T_HAS_LET_ARG                  T_SYMCONS
+#define has_let_arg(p)                 has_high_type_bit(T_Prc(p), T_HAS_LET_ARG)
+#define set_has_let_arg(p)             set_high_type_bit(T_Prc(p), T_HAS_LET_ARG)
+/* p is a setter procedure, "let arg" refers to the setter's optional third (let) argument */
+
+#define T_HASH_VALUE_TYPE              T_SYMCONS
+#define has_hash_value_type(p)         has_high_type_bit(T_Hsh(p), T_HASH_VALUE_TYPE)
+#define set_has_hash_value_type(p)     set_high_type_bit(T_Hsh(p), T_HASH_VALUE_TYPE)
+
+#define T_INT_OPTABLE                  T_SYMCONS
+#define is_int_optable(p)              has_high_type_bit(T_Pair(p), T_INT_OPTABLE)
+#define set_is_int_optable(p)          set_high_type_bit(T_Pair(p), T_INT_OPTABLE)
+
+#define T_UNLET                        T_SYMCONS
+#define is_unlet(p)                    has_high_type_bit(T_Let(p), T_UNLET)
+#define set_is_unlet(p)                set_high_type_bit(T_Let(p), T_UNLET)
+
+#define T_SYMBOL_TABLE                 T_SYMCONS
+#define is_symbol_table(p)             has_high_type_bit(T_Nvc(p), T_SYMBOL_TABLE)
+#define set_is_symbol_table(p)         set_high_type_bit(T_Nvc(p), T_SYMBOL_TABLE)
+
+#define T_FULL_HAS_LET_FILE            (1LL << (48 + 1))
+#define T_HAS_LET_FILE                 (1 << 1)
+#define has_let_file(p)                has_high_type_bit(T_Let(p), T_HAS_LET_FILE)
+#define set_has_let_file(p)            set_high_type_bit(T_Let(p), T_HAS_LET_FILE)
+#define clear_has_let_file(p)          clear_high_type_bit(T_Let(p), T_HAS_LET_FILE)
+
+#define T_TYPED_VECTOR                 T_HAS_LET_FILE
+#define is_typed_vector(p)             has_high_type_bit(T_Nvc(p), T_TYPED_VECTOR)
+#define is_typed_t_vector(p)           ((is_t_vector(p)) && (is_typed_vector(p)))
+#define set_typed_vector(p)            set_high_type_bit(T_Nvc(p), T_TYPED_VECTOR)
+#define clear_typed_vector(p)          clear_high_type_bit(T_Nvc(p), T_TYPED_VECTOR)
+
+#define T_TYPED_HASH_TABLE             T_HAS_LET_FILE
+#define is_typed_hash_table(p)         has_high_type_bit(T_Hsh(p), T_TYPED_HASH_TABLE)
+#define set_is_typed_hash_table(p)     set_high_type_bit(T_Hsh(p), T_TYPED_HASH_TABLE)
+#define clear_is_typed_hash_table(p)   clear_high_type_bit(T_Hsh(p), T_TYPED_HASH_TABLE)
+
+#define T_BOOL_SETTER                  T_HAS_LET_FILE
+#define c_function_has_bool_setter(p)  has_high_type_bit(T_Fnc(p), T_BOOL_SETTER)
+#define c_function_set_has_bool_setter(p) set_high_type_bit(T_Fnc(p), T_BOOL_SETTER)
+
+#define T_REST_SLOT                    T_HAS_LET_FILE
+#define is_rest_slot(p)                has_high_type_bit(T_Slt(p), T_REST_SLOT)
+#define set_is_rest_slot(p)            set_high_type_bit(T_Slt(p), T_REST_SLOT)
+
+#define T_NO_DEFAULTS                  T_HAS_LET_FILE
+#define T_FULL_NO_DEFAULTS             T_FULL_HAS_LET_FILE
+#define has_no_defaults(p)             has_high_type_bit(T_Pcs(p), T_NO_DEFAULTS)
+#define set_has_no_defaults(p)         set_high_type_bit(T_Pcs(p), T_NO_DEFAULTS)
+/* pair=closure* body, transferred to closure* */
+
+#define T_FULL_DEFINER                 (1LL << (48 + 2))
+#define T_DEFINER                      (1 << 2)
+#define is_definer(p)                  has_high_type_bit(T_Sym(p), T_DEFINER)
+#define set_is_definer(p)              set_high_type_bit(T_Sym(p), T_DEFINER)
+#define is_func_definer(p)             has_high_type_bit(T_Fnc(p), T_DEFINER)
+#define set_func_is_definer(p)         do {set_high_type_bit(T_Fnc(initial_value(p)), T_DEFINER); set_high_type_bit(T_Sym(p), T_DEFINER);} while (0)
+#define is_syntax_definer(p)           has_high_type_bit(T_Syn(p), T_DEFINER)
+#define set_syntax_is_definer(p)       do {set_high_type_bit(T_Syn(initial_value(p)), T_DEFINER); set_high_type_bit(T_Sym(p), T_DEFINER);} while (0)
+/* this marks "definers" like define and define-macro */
+
+#define T_MACLET                       T_DEFINER
+#define is_maclet(p)                   has_high_type_bit(T_Let(p), T_MACLET)
+#define set_maclet(p)                  set_high_type_bit(T_Let(p), T_MACLET)
+/* this marks a maclet */
+
+#define T_HAS_FX                       T_DEFINER
+#define set_has_fx(p)                  set_high_type_bit(T_Pair(p), T_HAS_FX)
+#define has_fx(p)                      has_high_type_bit(T_Pair(p), T_HAS_FX)
+#define clear_has_fx(p)                clear_high_type_bit(T_Pair(p), T_HAS_FX)
+
+#define T_SLOT_DEFAULTS                T_DEFINER
+#define slot_defaults(p)               has_high_type_bit(T_Slt(p), T_SLOT_DEFAULTS)
+#define set_slot_defaults(p)           set_high_type_bit(T_Slt(p), T_SLOT_DEFAULTS)
+
+#define T_WEAK_HASH_ITERATOR           T_DEFINER
+#define is_weak_hash_iterator(p)       has_high_type_bit(T_Itr(p), T_WEAK_HASH_ITERATOR)
+#define set_weak_hash_iterator(p)      set_high_type_bit(T_Itr(p), T_WEAK_HASH_ITERATOR)
+#define clear_weak_hash_iterator(p)    clear_high_type_bit(T_Itr(p), T_WEAK_HASH_ITERATOR)
+
+#define T_HASH_KEY_TYPE                T_DEFINER
+#define has_hash_key_type(p)           has_high_type_bit(T_Hsh(p), T_HASH_KEY_TYPE)
+#define set_has_hash_key_type(p)       set_high_type_bit(T_Hsh(p), T_HASH_KEY_TYPE)
+
+#define T_FULL_BINDER                  (1LL << (48 + 3))
+#define T_BINDER                       (1 << 3)
+#define set_syntax_is_binder(p)        do {set_high_type_bit(T_Syn(initial_value(p)), T_BINDER); set_high_type_bit(T_Sym(p), T_BINDER);} while (0)
+#define is_definer_or_binder(p)        has_high_type_bit(T_Sym(p), T_DEFINER | T_BINDER)
+/* this marks "binders" like let */
+
+#define T_SEMISAFE                     T_BINDER
+#define is_semisafe(p)                 has_high_type_bit(T_Fnc(p), T_SEMISAFE)
+#define set_is_semisafe(p)             set_high_type_bit(T_Fnc(p), T_SEMISAFE)
+
+/* #define T_TREE_COLLECTED            T_FULL_BINDER */
+#define T_SHORT_TREE_COLLECTED         T_BINDER
+#define tree_is_collected(p)           has_high_type_bit(T_Pair(p), T_SHORT_TREE_COLLECTED)
+#define tree_set_collected(p)          set_high_type_bit(T_Pair(p), T_SHORT_TREE_COLLECTED)
+#define tree_clear_collected(p)        clear_high_type_bit(T_Pair(p), T_SHORT_TREE_COLLECTED)
+
+#define T_SIMPLE_VALUES                T_BINDER
+#define has_simple_values(p)           has_high_type_bit(T_Hsh(p), T_SIMPLE_VALUES)
+#define set_has_simple_values(p)       set_high_type_bit(T_Hsh(p), T_SIMPLE_VALUES)
+#define clear_has_simple_values(p)     clear_high_type_bit(T_Hsh(p), T_SIMPLE_VALUES)
+
+#define T_VERY_SAFE_CLOSURE            (1LL << (48 + 4))
+#define T_SHORT_VERY_SAFE_CLOSURE      (1 << 4)
+#define is_very_safe_closure(p)        has_high_type_bit(T_Clo(p), T_SHORT_VERY_SAFE_CLOSURE)
+#define set_very_safe_closure(p)       set_high_type_bit(T_Clo(p), T_SHORT_VERY_SAFE_CLOSURE)
+#define closure_bits(p)                (full_type(T_Pair(p)) & (T_SAFE_CLOSURE | T_VERY_SAFE_CLOSURE | T_FULL_NO_DEFAULTS))
+#define is_very_safe_closure_body(p)   has_high_type_bit(T_Pair(p), T_SHORT_VERY_SAFE_CLOSURE)
+#define set_very_safe_closure_body(p)  set_high_type_bit(T_Pair(p), T_SHORT_VERY_SAFE_CLOSURE)
+
+#define T_BAFFLE_LET                   T_SHORT_VERY_SAFE_CLOSURE
+#define is_baffle_let(p)               has_high_type_bit(T_Let(p), T_BAFFLE_LET)
+#define set_baffle_let(p)              set_high_type_bit(T_Let(p), T_BAFFLE_LET)
+
+#define T_CYCLIC                       (1LL << (48 + 5))
+#define T_SHORT_CYCLIC                 (1 << 5)
+#define is_cyclic(p)                   has_high_type_bit(T_Seq(p), T_SHORT_CYCLIC)
+#define set_cyclic(p)                  set_high_type_bit(T_Seq(p), T_SHORT_CYCLIC)
+
+#define T_CYCLIC_SET                   (1LL << (48 + 6))
+#define T_SHORT_CYCLIC_SET             (1 << 6)
+#define is_cyclic_set(p)               has_high_type_bit(T_Seq(p), T_SHORT_CYCLIC_SET)
+#define set_cyclic_set(p)              set_high_type_bit(T_Seq(p), T_SHORT_CYCLIC_SET)
+#define clear_cyclic_bits(p)           clear_type_bit(p, T_COLLECTED | T_SHARED | T_CYCLIC | T_CYCLIC_SET)
+
+#define T_KEYWORD                      (1LL << (48 + 7))
+#define T_SHORT_KEYWORD                (1 << 7)
+#define is_keyword(p)                  has_high_type_bit(T_Sym(p), T_SHORT_KEYWORD)
+#define is_symbol_and_keyword(p)       ((is_symbol(p)) && (is_keyword(p)))
+/* this bit distinguishes a symbol from a symbol that is also a keyword */
+
+#define T_FX_TREEABLE                  T_SHORT_KEYWORD
+#define is_fx_treeable(p)              has_high_type_bit(T_Pair(p), T_FX_TREEABLE)
+#define set_is_fx_treeable(p)          set_high_type_bit(T_Pair(p), T_FX_TREEABLE)
+
+#define T_FULL_SIMPLE_ELEMENTS         (1LL << (48 + 8))
+#define T_SIMPLE_ELEMENTS              (1 << 8)
+#define has_simple_elements(p)         has_high_type_bit(T_Nvc(p), T_SIMPLE_ELEMENTS)
+#define set_has_simple_elements(p)     set_high_type_bit(T_Nvc(p), T_SIMPLE_ELEMENTS)
+#define clear_has_simple_elements(p)   clear_high_type_bit(T_Nvc(p), T_SIMPLE_ELEMENTS)
+#define c_function_has_simple_elements(p)     has_high_type_bit(T_Fnc(p), T_SIMPLE_ELEMENTS)
+#define c_function_set_has_simple_elements(p) set_high_type_bit(T_Fnc(p), T_SIMPLE_ELEMENTS)
+/* c_func case here refers to boolean? et al -- structure element type declaration that ensures a simple object */
+
+#define T_SIMPLE_KEYS                  T_SIMPLE_ELEMENTS
+#define has_simple_keys(p)             has_high_type_bit(T_Hsh(p), T_SIMPLE_KEYS)
+#define set_has_simple_keys(p)         set_high_type_bit(T_Hsh(p), T_SIMPLE_KEYS)
+#define clear_has_simple_keys(p)       clear_high_type_bit(T_Hsh(p), T_SIMPLE_KEYS)
+
+#define T_SAFE_SETTER                  T_SIMPLE_ELEMENTS
+#define is_safe_setter(p)              has_high_type_bit(T_Sym(p), T_SAFE_SETTER)
+#define set_is_safe_setter(p)          set_high_type_bit(T_Sym(p), T_SAFE_SETTER)
+
+#define T_FLOAT_OPTABLE                T_SIMPLE_ELEMENTS
+#define is_float_optable(p)            has_high_type_bit(T_Pair(p), T_FLOAT_OPTABLE)
+#define set_is_float_optable(p)        set_high_type_bit(T_Pair(p), T_FLOAT_OPTABLE)
+
+#define T_FULL_CASE_KEY                (1LL << (48 + 9))
+#define T_CASE_KEY                     (1 << 9)
+#define is_case_key(p)                 has_high_type_bit(T_Ext(p), T_CASE_KEY)
+#define set_case_key(p)                set_high_type_bit(T_Sym(p), T_CASE_KEY)
+
+#define T_OPT1_FUNC_LISTED             T_CASE_KEY
+#define opt1_func_listed(p)            has_high_type_bit(T_Pair(p), T_OPT1_FUNC_LISTED)
+#define set_opt1_func_listed(p)        set_high_type_bit(T_Pair(p), T_OPT1_FUNC_LISTED)
+
+/* (1LL << (48 + 10)) was HAS_GX, is now free */
+
+#define T_FULL_UNKNOPT                 (1LL << (48 + 11))
+#define T_UNKNOPT                      (1 << 11)
+#define is_unknopt(p)                  has_high_type_bit(T_Pair(p), T_UNKNOPT)
+#define set_is_unknopt(p)              set_high_type_bit(T_Pair(p), T_UNKNOPT)
+
+#define T_MAC_OK                       T_UNKNOPT
+#define mac_is_ok(p)                   has_high_type_bit(T_Pair(p), T_MAC_OK)
+#define set_mac_is_ok(p)               set_high_type_bit(T_Pair(p), T_MAC_OK)
+/* marks a macro (via (macro...)) that has been checked -- easier (and slower) than making 4 or 5 more ops, op_macro_unchecked and so on */
+
+#define T_FULL_SAFETY_CHECKED          (1LL << (48 + 12))
+#define T_SAFETY_CHECKED               (1 << 12)
+#define is_safety_checked(p)           has_high_type_bit(T_Pair(p), T_SAFETY_CHECKED)
+#define set_safety_checked(p)          do {if (in_heap(p)) set_high_type_bit(T_Pair(p), T_SAFETY_CHECKED);} while (0)
+
+#define T_FULL_HAS_FN                  (1LL << (48 + 13))
+#define T_HAS_FN                       (1 << 13)
+#define set_has_fn(p)                  set_high_type_bit(T_Pair(p), T_HAS_FN)
+#define has_fn(p)                      has_high_type_bit(T_Pair(p), T_HAS_FN)
+
+#define T_GC_MARK                      0x8000000000000000
+#define is_marked(p)                   has_type_bit(p, T_GC_MARK)
+#define set_mark(p)                    set_type_bit(T_Pos(p), T_GC_MARK)
+#define clear_mark(p)                  clear_type_bit(p, T_GC_MARK)
+/* using the sign bit, bit 23 (or 55) == 31 (or 63) for this makes a big difference in the GC */
+
+#define T_UNHEAP                       0x4000000000000000
+#define T_SHORT_UNHEAP                 (1 << 14)
+#define in_heap(p)                     (((T_Pos(p))->tf.bits.high_bits & T_SHORT_UNHEAP) == 0) /* can be slot, make_s7_starlet let_set_slot */
+#define unheap(sc, p)                  set_high_type_bit(T_Ext(p), T_SHORT_UNHEAP)
+
+#define is_eof(p)                      ((T_Ext(p)) == eof_object)
+#define is_true(Sc, p)                 ((T_Ext(p)) != Sc->F)
+#define is_false(Sc, p)                ((T_Ext(p)) == Sc->F)
+
+#ifdef _MSC_VER
+  static s7_pointer make_boolean(s7_scheme *sc, bool val) {if (val) return(sc->T); return(sc->F);}
+#else
+  #define make_boolean(sc, Val)        ((Val) ? sc->T : sc->F)
+#endif
+
+#define is_pair(p)                     (type(p) == T_PAIR)
+#define is_mutable_pair(p)             ((is_pair(p)) && (!is_immutable(p))) /* same speed: ((full_type(p) & (TYPE_MASK | T_IMMUTABLE)) == T_PAIR) */
+#define is_null(p)                     ((T_Exs(p)) == sc->nil)  /* can be a slot */
+#define is_not_null(p)                 ((T_Exs(p)) != sc->nil)
+#define is_list(p)                     ((is_pair(p)) || (type(p) == T_NIL))
+#define is_quote(p)                    (((p) == sc->quote_symbol) || ((p) == sc->quote_function)) /* order here apparently does not matter */
+#define is_safe_quote(p)               ((((p) == sc->quote_symbol) && (is_global(sc->quote_symbol))) || ((p) == sc->quote_function))
+#define is_quoted_pair(p)              ((is_pair(p)) && (is_quote(car(p))))
+#define is_safe_quoted_pair(p)         ((is_pair(p)) && (is_safe_quote(car(p))))
+#define is_unquoted_pair(p)            ((is_pair(p)) && (!is_quote(car(p))))
+#define is_quoted_symbol(p)            ((is_quoted_pair(p)) && (is_symbol(cadr(p))))
+
+
+/* pair line/file/position */
+#define PAIR_LINE_BITS                 24
+#define PAIR_FILE_BITS                 12
+#define PAIR_POSITION_BITS             28
+#define PAIR_LINE_OFFSET               0
+#define PAIR_FILE_OFFSET               PAIR_LINE_BITS
+#define PAIR_POSITION_OFFSET           (PAIR_LINE_BITS + PAIR_FILE_BITS)
+#define PAIR_LINE_MASK                 ((1 << PAIR_LINE_BITS) - 1)
+#define PAIR_FILE_MASK                 ((1 << PAIR_FILE_BITS) - 1)
+#define PAIR_POSITION_MASK             ((1 << PAIR_POSITION_BITS) - 1)
+
+#define port_location(Pt)              (((port_line_number(Pt) & PAIR_LINE_MASK) << PAIR_LINE_OFFSET) | \
+                                        ((port_file_number(Pt) & PAIR_FILE_MASK) << PAIR_FILE_OFFSET) | \
+                                        ((port_position(Pt) & PAIR_POSITION_MASK) << PAIR_POSITION_OFFSET))
+
+#define location_to_line(Loc)          ((Loc >> PAIR_LINE_OFFSET) & PAIR_LINE_MASK)
+#define location_to_file(Loc)          ((Loc >> PAIR_FILE_OFFSET) & PAIR_FILE_MASK)
+#define location_to_position(Loc)      ((Loc >> PAIR_POSITION_OFFSET) & PAIR_POSITION_MASK)
+
+#define pair_line_number(p)            location_to_line(pair_location(p))
+#define pair_file_number(p)            location_to_file(pair_location(p))
+#define pair_position(p)               location_to_position(pair_location(p))
+
+#if (!S7_DEBUGGING)
+#define pair_location(p)               (p)->object.sym_cons.location
+#define pair_set_location(p, X)        (p)->object.sym_cons.location = X
+#define pair_raw_hash(p)               (p)->object.sym_cons.hash
+#define pair_set_raw_hash(p, X)        (p)->object.sym_cons.hash = X
+#define pair_raw_len(p)                (p)->object.sym_cons.location
+#define pair_set_raw_len(p, X)         (p)->object.sym_cons.location = X
+#define pair_raw_name(p)               (p)->object.sym_cons.fstr
+#define pair_set_raw_name(p, X)        (p)->object.sym_cons.fstr = X
+/* opt1 == raw_hash, opt2 == raw_name, opt3 == line|ctr + len, but hash/name/len only apply to the symbol table so there's no collision */
+
+#define opt1(p, r)                     ((p)->object.cons.opt1)
+#define set_opt1(p, x, r)              (p)->object.cons.opt1 = x
+#define opt2(p, r)                     ((p)->object.cons.o2.opt2)
+#define set_opt2(p, x, r)              (p)->object.cons.o2.opt2 = (s7_pointer)(x)
+#define opt2_n(p, r)                   ((p)->object.cons.o2.n)
+#define set_opt2_n(p, x, r)            (p)->object.cons.o2.n = x
+#define opt3(p, r)                     ((p)->object.cons.o3.opt3)
+#define set_opt3(p, x, r)              do {(p)->object.cons.o3.opt3 = x; clear_type_bit(p, T_LOCATION);} while (0)
+#define opt3_n(p, r)                   ((p)->object.cons.o3.n)
+#define set_opt3_n(p, x, r)            do {(p)->object.cons.o3.n = x; clear_type_bit(p, T_LOCATION);} while (0)
+
+#else
+
+/* the 3 opt fields hold most of the varigated optimizer info, so they are used in many conflicting ways.
+ * the bits and funcs here try to track each such use, and report any cross-talk or collisions.
+ * all of this machinery vanishes if debugging is turned off.
+ */
+#define OPT1_SET                       (1 << 0)
+#define OPT2_SET                       (1 << 1)
+#define OPT3_SET                       (1 << 2)
+
+#define OPT1_FAST                      (1 << 3)   /* fast list in member/assoc circular list check */
+#define OPT1_CFUNC                     (1 << 4)   /* c-function */
+#define OPT1_CLAUSE                    (1 << 5)   /* case clause */
+#define OPT1_LAMBDA                    (1 << 6)   /* lambda(*) */
+#define OPT1_SYM                       (1 << 7)   /* symbol */
+#define OPT1_PAIR                      (1 << 8)   /* pair */
+#define OPT1_CON                       (1 << 9)   /* constant from eval's point of view */ /* 10 was opt1_goto, unused */
+#define OPT1_ANY                       (1 << 11)  /* anything -- deliberate unchecked case */
+#define OPT1_HASH                      (1 << 12)  /* hash code used in the symbol table (pair_raw_hash) */
+#define OPT1_MASK                      (OPT1_FAST | OPT1_CFUNC | OPT1_CLAUSE | OPT1_LAMBDA | OPT1_SYM | OPT1_PAIR | OPT1_CON | OPT1_ANY | OPT1_HASH)
+
+#define opt1_is_set(p)                 (((T_Pair(p))->debugger_bits & OPT1_SET) != 0)
+#define set_opt1_is_set(p)             (T_Pair(p))->debugger_bits |= OPT1_SET
+#define opt1_role_matches(p, Role)     (((T_Pair(p))->debugger_bits & OPT1_MASK) == Role)
+#define set_opt1_role(p, Role)         (T_Pair(p))->debugger_bits = (Role | ((p)->debugger_bits & ~OPT1_MASK))
+#define opt1(p, Role)                  opt1_1(sc, T_Pair(p), Role, __func__, __LINE__)
+#define set_opt1(p, x, Role)           set_opt1_1(T_Pair(p), x, Role, __func__, __LINE__)
+
+#define OPT2_KEY                       (1 << 13)  /* case key */
+#define OPT2_SLOW                      (1 << 14)  /* slow list in member/assoc circular list check */
+#define OPT2_SYM                       (1 << 15)  /* symbol */
+#define OPT2_PAIR                      (1 << 16)  /* pair */
+#define OPT2_CON                       (1 << 17)  /* constant as above */
+#define OPT2_FX                        (1 << 18)  /* fx (fx_*) func (sc, form) */
+#define OPT2_FN                        (1 << 19)  /* fn (s7_function) func (sc, arglist) */
+#define OPT2_LAMBDA                    (1 << 20)  /* lambda form */
+#define OPT2_NAME                      (1 << 21)  /* named used by symbol table (pair_raw_name) */
+#define OPT2_DIRECT                    (1LL << 32)
+#define OPT2_INT                       (1LL << 33)
+#define OPT2_MASK                      (OPT2_KEY | OPT2_SLOW | OPT2_SYM | OPT2_PAIR | OPT2_CON | OPT2_FX | \
+                                        OPT2_FN | OPT2_LAMBDA | OPT2_DIRECT | OPT2_NAME | OPT2_INT)
+
+#define opt2_is_set(p)                 (((T_Pair(p))->debugger_bits & OPT2_SET) != 0)
+#define set_opt2_is_set(p)             (T_Pair(p))->debugger_bits |= OPT2_SET
+#define opt2_role_matches(p, Role)     (((T_Pair(p))->debugger_bits & OPT2_MASK) == Role)
+#define set_opt2_role(p, Role)         (T_Pair(p))->debugger_bits = (Role | ((p)->debugger_bits & ~OPT2_MASK))
+#define opt2(p, Role)                  opt2_1(sc, T_Pair(p), Role, __func__, __LINE__)
+#define set_opt2(p, x, Role)           set_opt2_1(sc, T_Pair(p), (s7_pointer)(x), Role, __func__, __LINE__)
+#define opt2_n(p, Role)                opt2_n_1(sc, T_Pair(p), Role, __func__, __LINE__)
+#define set_opt2_n(p, x, Role)         set_opt2_n_1(sc, T_Pair(p), x, Role, __func__, __LINE__)
+
+#define OPT3_ARGLEN                    (1 << 22)  /* arglist length */
+#define OPT3_SYM                       (1 << 23)  /* expression symbol access */
+#define OPT3_AND                       (1 << 24)  /* and second clause */
+#define OPT3_DIRECT                    (1 << 25)  /* direct call info */
+#define OPT3_ANY                       (1 << 26)
+#define OPT3_LET                       (1 << 27)  /* let or #f */
+#define OPT3_CON                       (1 << 28)
+#define OPT3_LOCATION                  (1 << 29)
+#define OPT3_LEN                       (1 << 30)
+#define OPT3_BYTE                      (1LL << 31)
+#define OPT3_INT                       (1LL << 34)
+#define OPT3_MASK                      (OPT3_ARGLEN | OPT3_SYM | OPT3_AND | OPT3_ANY | OPT3_LET | OPT3_BYTE | \
+                                        OPT3_LOCATION | OPT3_LEN | OPT3_DIRECT | OPT3_CON | OPT3_INT)
+
+#define opt3_is_set(p)                 (((T_Pair(p))->debugger_bits & OPT3_SET) != 0)
+#define set_opt3_is_set(p)             (T_Pair(p))->debugger_bits |= OPT3_SET
+#define opt3_role_matches(p, Role)     (((T_Pair(p))->debugger_bits & OPT3_MASK) == Role)
+#define set_opt3_role(p, Role)         (T_Pair(p))->debugger_bits = (Role | ((p)->debugger_bits & ~OPT3_MASK))
+#define opt3(p, Role)                  opt3_1(sc, T_Pair(p), Role, __func__, __LINE__)
+#define set_opt3(p, x, Role)           set_opt3_1(T_Pair(p), x, Role)
+#define opt3_n(p, Role)                opt3_n_1(sc, T_Pair(p), Role, __func__, __LINE__)
+#define set_opt3_n(p, x, Role)         set_opt3_n_1(T_Pair(p), x, Role)
+
+#define pair_location(p)               opt3_location_1(sc, T_Pair(p), __func__, __LINE__)
+#define pair_set_location(p, X)        set_opt3_location_1(T_Pair(p), X)
+#define pair_raw_hash(p)               opt1_hash_1(sc, T_Pair(p), __func__, __LINE__)
+#define pair_set_raw_hash(p, X)        set_opt1_hash_1(T_Pair(p), X)
+#define pair_raw_len(p)                opt3_len_1(sc, T_Pair(p), __func__, __LINE__)
+#define pair_set_raw_len(p, X)         set_opt3_len_1(T_Pair(p), X)
+#define pair_raw_name(p)               opt2_name_1(sc, T_Pair(p), __func__, __LINE__)
+#define pair_set_raw_name(p, X)        set_opt2_name_1(T_Pair(p), X)
+
+#define L_HIT                          (1LL << 40) /* "L_SET" is taken */
+#define L_FUNC                         (1LL << 41)
+#define L_DOX                          (1LL << 42)
+#define L_MASK                         (L_FUNC | L_DOX)
+#endif
+
+#define opt1_fast(P)                   T_Lst(opt1(P,                OPT1_FAST))
+#define set_opt1_fast(P, X)            set_opt1(P, T_Pair(X),       OPT1_FAST)
+#define opt1_cfunc(P)                  T_Exs(opt1(P,                OPT1_CFUNC))
+#define set_opt1_cfunc(P, X)           set_opt1(P, T_Fnc(X),       OPT1_CFUNC)
+#define opt1_lambda_unchecked(P)       opt1(P,                      OPT1_LAMBDA) /* can be free/null? from s7_call? */
+#define opt1_lambda(P)                 T_Clo(opt1(P,                OPT1_LAMBDA))
+#define set_opt1_lambda(P, X)          set_opt1(P, T_Clo(X),        OPT1_LAMBDA)
+#define set_opt1_lambda_add(P, X)      do {set_opt1(P, T_Clo(X),    OPT1_LAMBDA); add_opt1_func(sc, P);} while (0)
+#define opt1_clause(P)                 T_Exs(opt1(P,                OPT1_CLAUSE))
+#define set_opt1_clause(P, X)          set_opt1(P, T_Exs(X),        OPT1_CLAUSE)
+#define opt1_sym(P)                    T_Sym(opt1(P,                OPT1_SYM))
+#define set_opt1_sym(P, X)             set_opt1(P, T_Sym(X),        OPT1_SYM)
+#define opt1_pair(P)                   T_Lst(opt1(P,                OPT1_PAIR))
+#define set_opt1_pair(P, X)            set_opt1(P, T_Lst(X),        OPT1_PAIR)
+#define opt1_con(P)                    T_Exs(opt1(P,                OPT1_CON))
+#define set_opt1_con(P, X)             set_opt1(P, T_Exs(X),        OPT1_CON)    /* can be #<unused> */
+#define opt1_any(P)                    opt1(P,                      OPT1_ANY)    /* can be free in closure_is_ok */
+#define set_opt1_any(P, X)             set_opt1(P, X,               OPT1_ANY)
+
+#define opt2_any(P)                    opt2(P,                      OPT2_KEY)
+#define set_opt2_any(P, X)             set_opt2(P, X,               OPT2_KEY)
+#define opt2_int(P)                    opt2_n(P,                    OPT2_INT)
+#define set_opt2_int(P, X)             set_opt2_n(P, X,             OPT2_INT)
+#define opt2_slow(P)                   T_Lst(opt2(P,                OPT2_SLOW))
+#define set_opt2_slow(P, X)            set_opt2(P, T_Pair(X),       OPT2_SLOW)
+#define opt2_sym(P)                    T_Sym(opt2(P,                OPT2_SYM))
+#define set_opt2_sym(P, X)             set_opt2(P, T_Sym(X),        OPT2_SYM)
+#define opt2_pair(P)                   T_Lst(opt2(P,                OPT2_PAIR))
+#define set_opt2_pair(P, X)            set_opt2(P, T_Lst(X),        OPT2_PAIR)
+#define opt2_con(P)                    T_Exs(opt2(P,                OPT2_CON))
+#define set_opt2_con(P, X)             set_opt2(P, T_Exs(X),        OPT2_CON)
+#define opt2_lambda(P)                 T_Pair(opt2(P,               OPT2_LAMBDA))
+#define set_opt2_lambda(P, X)          set_opt2(P, T_Pair(X),       OPT2_LAMBDA)
+#define opt2_direct(P)                 opt2(P,                      OPT2_DIRECT)
+#define set_opt2_direct(P, X)          set_opt2(P, (s7_pointer)(X), OPT2_DIRECT)
+
+#define opt3_arglen(P)                 opt3_n(P,                    OPT3_ARGLEN)
+#define set_opt3_arglen(P, X)          set_opt3_n(P, X,             OPT3_ARGLEN)
+#define opt3_int(P)                    opt3_n(P,                    OPT3_INT)
+#define set_opt3_int(P, X)             set_opt3_n(P, X,             OPT3_INT)
+#define opt3_sym(P)                    T_Sym(opt3(P,                OPT3_SYM))
+#define set_opt3_sym(P, X)             set_opt3(P, T_Sym(X),        OPT3_SYM)
+#define opt3_con(P)                    T_Exs(opt3(P,                OPT3_CON))
+#define set_opt3_con(P, X)             set_opt3(P, T_Exs(X),        OPT3_CON)
+#define opt3_pair(P)                   T_Pair(opt3(P,               OPT3_AND))
+#define set_opt3_pair(P, X)            set_opt3(P, T_Pair(X),       OPT3_AND)
+#define opt3_any(P)                    opt3(P,                      OPT3_ANY)
+#define set_opt3_any(P, X)             set_opt3(P, X,               OPT3_ANY)
+#define opt3_let(P)                    T_Let(opt3(P,                OPT3_LET))
+#define set_opt3_let(P, X)             set_opt3(P, T_Let(X),        OPT3_LET)
+#define opt3_direct(P)                 opt3(P,                      OPT3_DIRECT)
+#define set_opt3_direct(P, X)          set_opt3(P, (s7_pointer)(X), OPT3_DIRECT)
+
+#if S7_DEBUGGING
+#define opt3_byte(p)                   opt3_byte_1(sc, T_Pair(p), OPT3_BYTE, __func__, __LINE__)
+#define set_opt3_byte(p, x)            set_opt3_byte_1(T_Pair(p), x, OPT3_BYTE, __func__, __LINE__)
+#else
+#define opt3_byte(P)                   T_Pair(P)->object.cons.o3.opt_type /* op_if_is_type, opt_type == opt3 in cons */
+#define set_opt3_byte(P, X)            do {T_Pair(P)->object.cons.o3.opt_type = X; clear_type_bit(P, T_LOCATION);} while (0)
+#endif
+
+#define pair_macro(P)                  opt2_sym(P)
+#define set_pair_macro(P, Name)        set_opt2_sym(P, Name)
+
+#define fn_proc(f)                     ((s7_function)(opt2(f, OPT2_FN)))
+#define fx_proc(f)                     ((s7_function)(opt2(f, OPT2_FX)))
+#define fn_proc_unchecked(f)           ((s7_function)(T_Pair(f)->object.cons.o2.opt2))
+
+#define set_fx(f, _X_)                 do {s7_pointer X; X = (s7_pointer)(_X_); set_opt2(f, X, OPT2_FX); if (X) set_has_fx(f); else clear_has_fx(f);} while (0)
+#define set_fx_direct(f, X)            do {set_opt2(f, (s7_pointer)(X), OPT2_FX); set_has_fx(f);} while (0)
+#define set_fn(f, _X_)                 do {s7_pointer X; X = (s7_pointer)(_X_); set_opt2(f, X, OPT2_FN); if (X) set_has_fn(f); else clear_has_fx(f);} while (0)
+#define set_fn_direct(f, X)            do {set_opt2(f, (s7_pointer)(X), OPT2_FN); set_has_fn(f);} while (0)
+
+#if WITH_GCC
+#define fx_call(Sc, F)                 ({s7_pointer _P_; _P_ = F; fx_proc(_P_)(Sc, car(_P_));})
+#define fn_call(Sc, F)                 ({s7_pointer _P_; _P_ = F; fn_proc(_P_)(Sc, cdr(_P_));})
+#else
+#define fx_call(Sc, F)                 fx_proc(F)(Sc, car(F))
+#define fn_call(Sc, F)                 fn_proc(F)(Sc, cdr(F))
+#endif
+/* fx_call can affect the stack and sc->value */
+
+#define car(p)                         (T_Pair(p))->object.cons.car
+#define unchecked_car(p)               (T_Pos(p))->object.cons.car
+#define set_car(p, Val)                car(p) = T_Pos(Val)      /* can be a slot or #<unused> or #<catch> etc */
+#define cdr(p)                         (T_Pair(p))->object.cons.cdr
+#if S7_DEBUGGING
+static void check_set_cdr(s7_pointer p, s7_pointer Val, const char *func, int32_t line);
+#define set_cdr(p, Val)                check_set_cdr(p, Val, __func__, __LINE__)
+#else
+#define set_cdr(p, Val)                cdr(p) = T_Ext(Val)
+#endif
+#define unchecked_set_cdr(p, Val)      cdr(p) = T_Exs(Val)      /* #<unused> in g_gc */
+#define unchecked_cdr(p)               (T_Exs(p))->object.cons.cdr
+
+#define caar(p)                        car(car(p))
+#define cadr(p)                        car(cdr(p))
+#define set_cadr(p, Val)               car(cdr(p)) = T_Exs(Val) /* #<unused> in g_gc */
+#define cdar(p)                        cdr(car(p))
+#define set_cdar(p, Val)               cdr(car(p)) = T_Ext(Val)
+#define cddr(p)                        cdr(cdr(p))
+
+#define caaar(p)                       car(car(car(p)))
+#define cadar(p)                       car(cdr(car(p)))
+#define cdadr(p)                       cdr(car(cdr(p)))
+#define caddr(p)                       car(cdr(cdr(p)))
+#define set_caddr(p, Val)              car(cdr(cdr(p))) = T_Ext(Val)
+#define caadr(p)                       car(car(cdr(p)))
+#define cdaar(p)                       cdr(car(car(p)))
+#define cdddr(p)                       cdr(cdr(cdr(p)))
+#define set_cdddr(p, Val)              cdr(cdr(cdr(p))) = T_Ext(Val)
+#define cddar(p)                       cdr(cdr(car(p)))
+
+#define caaadr(p)                      car(car(car(cdr(p))))
+#define caadar(p)                      car(car(cdr(car(p))))
+#define cadaar(p)                      car(cdr(car(car(p))))
+#define cadddr(p)                      car(cdr(cdr(cdr(p))))
+#define caaddr(p)                      car(car(cdr(cdr(p))))
+#define cddddr(p)                      cdr(cdr(cdr(cdr(p))))
+#define caddar(p)                      car(cdr(cdr(car(p))))
+#define cdadar(p)                      cdr(car(cdr(car(p))))
+#define cdaddr(p)                      cdr(car(cdr(cdr(p))))
+#define caaaar(p)                      car(car(car(car(p))))
+#define cadadr(p)                      car(cdr(car(cdr(p))))
+#define cdaadr(p)                      cdr(car(car(cdr(p))))
+#define cdaaar(p)                      cdr(car(car(car(p))))
+#define cdddar(p)                      cdr(cdr(cdr(car(p))))
+#define cddadr(p)                      cdr(cdr(car(cdr(p))))
+#define cddaar(p)                      cdr(cdr(car(car(p))))
+
+#define cadaddr(p)                     cadr(caddr(p))
+#define caddadr(p)                     caddr(cadr(p))
+#define caddaddr(p)                    caddr(caddr(p))
+
+#if WITH_GCC
+  /* slightly tricky because cons can be called recursively, macro here is faster than inline function */
+  #define cons(Sc, A, B)   ({s7_pointer _X_, _A_, _B_; _A_ = A; _B_ = B; new_cell(Sc, _X_, T_PAIR | T_SAFE_PROCEDURE); set_car(_X_, _A_); set_cdr(_X_, _B_); _X_;})
+#else
+  #define cons(Sc, A, B)               s7_cons(Sc, A, B)
+#endif
+
+#define list_1(Sc, A)                  cons(Sc, A, Sc->nil)
+#define list_1_unchecked(Sc, A)        cons_unchecked(Sc, A, Sc->nil)
+#define list_2(Sc, A, B)               cons_unchecked(Sc, A, cons(Sc, B, Sc->nil))
+#define list_2_unchecked(Sc, A, B)     cons_unchecked(Sc, A, cons_unchecked(Sc, B, Sc->nil))
+#define list_3(Sc, A, B, C)            cons_unchecked(Sc, A, cons_unchecked(Sc, B, cons(Sc, C, Sc->nil)))
+#define list_4(Sc, A, B, C, D)         cons_unchecked(Sc, A, cons_unchecked(Sc, B, cons_unchecked(Sc, C, cons(Sc, D, Sc->nil))))
+#define with_list_t1(A)                (set_car(sc->t1_1, A), sc->t1_1) /* this is slower than explicit code, esp t3, procedures are same as this */
+#define with_list_t2(A, B)             (set_car(sc->t2_1, A), set_car(sc->t2_2, B), sc->t2_1)
+#define with_list_t3(A, B, C)          (set_car(sc->t3_1, A), set_car(sc->t3_2, B), set_car(sc->t3_3, C), sc->t3_1)
+/* #define with_list_t4(A, B, C, D)       (set_car(sc->t4_1, A), set_car(sc->t3_1, B), set_car(sc->t3_2, C), set_car(sc->t3_3, D), sc->t4_1) */
+
+#define is_string(p)                   (type(p) == T_STRING)
+#define is_mutable_string(p)           ((full_type(T_Ext(p)) & (TYPE_MASK | T_IMMUTABLE)) == T_STRING)
+#define string_value(p)                (T_Str(p))->object.string.svalue
+#define string_length(p)               (T_Str(p))->object.string.length
+#define string_hash(p)                 (T_Str(p))->object.string.hash
+#define string_block(p)                (T_Str(p))->object.string.block
+#define unchecked_string_block(p)      p->object.string.block
+
+#define character(p)                   (T_Chr(p))->object.chr.c
+#define is_character(p)                (type(p) == T_CHARACTER)
+#define upper_character(p)             (T_Chr(p))->object.chr.up_c
+#define is_char_alphabetic(p)          (T_Chr(p))->object.chr.alpha_c
+#define is_char_numeric(p)             (T_Chr(p))->object.chr.digit_c
+#define is_char_whitespace(p)          (T_Chr(p))->object.chr.space_c
+#define is_char_uppercase(p)           (T_Chr(p))->object.chr.upper_c
+#define is_char_lowercase(p)           (T_Chr(p))->object.chr.lower_c
+#define character_name(p)              (T_Chr(p))->object.chr.c_name
+#define character_name_length(p)       (T_Chr(p))->object.chr.length
+
+#define optimize_op(P)                 (T_Ext(P))->tf.bits.opt_bits
+#define unchecked_optimize_op(P)       (P)->tf.bits.opt_bits
+#define set_optimize_op(P, Op)         (T_Ext(P))->tf.bits.opt_bits = (Op) /* not T_Pair -- needs legit cur_sc in init_chars|strings */
+#define OP_HOP_MASK                    0xfffe
+#define optimize_op_match(P, Q)        ((is_optimized(P)) && ((optimize_op(P) & OP_HOP_MASK) == (Q)))
+#define op_no_hop(P)                   (optimize_op(P) & OP_HOP_MASK)
+#define op_has_hop(P)                  ((optimize_op(P) & 1) != 0)
+#define clear_optimize_op(P)           set_optimize_op(P, OP_UNOPT)
+#define set_safe_optimize_op(P, Q)     do {set_optimized(P); set_optimize_op(P, Q);} while (0)
+#define set_unsafe_optimize_op(P, Q)   do {set_unsafely_optimized(P); set_optimize_op(P, Q);} while (0)
+
+#define is_symbol(p)                   (type(p) == T_SYMBOL)
+#define is_normal_symbol(p)            ((is_symbol(p)) && (!is_keyword(p)))
+#define is_safe_symbol(p)              ((is_symbol(p)) && (is_slot(s7_slot(sc, p))))
+#define symbol_name_cell(p)            T_Str((T_Sym(p))->object.sym.name)
+#define symbol_set_name_cell(p, S)     (T_Sym(p))->object.sym.name = T_Str(S)
+#define symbol_name(p)                 string_value(symbol_name_cell(p))
+#define symbol_name_length(p)          string_length(symbol_name_cell(p))
+#define gensym_block(p)                symbol_name_cell(p)->object.string.gensym_block
+#define pointer_map(p)                 (s7_int)((intptr_t)(p) >> 8)
+#define symbol_id(p)                   (T_Sym(p))->object.sym.id
+#define symbol_set_id_unchecked(p, X)  (T_Sym(p))->object.sym.id = X
+#if S7_DEBUGGING
+static void symbol_set_id(s7_pointer p, s7_int id)
+{
+  if (id < symbol_id(p))
+    {
+      fprintf(stderr, "%s[%d]: id mismatch: sym: %s %" ld64 ", let: %" ld64 "\n", __func__, __LINE__, symbol_name(p), symbol_id(p), id);
+      abort();
+    }
+  (T_Sym(p))->object.sym.id = id;
+}
+#else
+#define symbol_set_id(p, X)            (T_Sym(p))->object.sym.id = X
+#endif
+/* we need 64-bits here, since we don't want this thing to wrap around, and lets are created at a great rate
+ *    callgrind says this is faster than a uint32_t!
+ */
+#define symbol_info(p)                 (symbol_name_cell(p))->object.string.block
+#define symbol_type(p)                 (block_size(symbol_info(p)) & 0xff)                    /* boolean function bool type */
+#define symbol_set_type(p, Type)       block_size(symbol_info(p)) = ((block_size(symbol_info(p)) & ~0xff) | ((Type) & 0xff))
+#define symbol_clear_type(p)           block_size(symbol_info(p)) = 0
+#define s7_starlet_symbol_id(p)        ((uint8_t)((block_size(symbol_info(p)) >> 8) & 0xff))  /* *s7* id */
+#define s7_starlet_symbol_set(p, F)    block_size(symbol_info(p)) = ((block_size(symbol_info(p)) & ~0xff00) | (((F) & 0xff) << 8))
+
+#define REPORT_ROOTLET_REDEF 0
+#if REPORT_ROOTLET_REDEF
+  /* to find who is stomping on our symbols: */
+  static void set_local_1(s7_scheme *sc, s7_pointer symbol, const char *func, int32_t line);
+  #define set_local(Symbol)            set_local_1(sc, T_Sym(Symbol), __func__, __LINE__)
+#else
+  #define set_local(p)                 full_type(T_Sym(p)) &= ~(T_DONT_EVAL_ARGS | T_SYNTACTIC)
+#endif
+#define is_global(p)                   ((is_slot(global_slot(p))) && (symbol_id(p) == 0))
+/* or ((symbol_id(p) == 0) && (global_slot(p) != cur_sc->undefined)) but it's slower, both are slower than the T_GLOBAL bit from earlier */
+
+#define global_slot(p)                 T_Sld((T_Sym(p))->object.sym.global_slot)
+#define set_global_slot(p, Val)        (T_Sym(p))->object.sym.global_slot = T_Sld(Val)
+#define local_slot(p)                  T_Sln((T_Sym(p))->object.sym.local_slot)
+#define set_local_slot(p, Val)         (T_Sym(p))->object.sym.local_slot = T_Slt(Val)
+
+#define initial_value(p)               symbol_info(p)->ex.ex_ptr
+#define set_initial_value(p, Val)      initial_value(p) = T_Ext(Val)
+#define local_value(p)                 slot_value(local_slot(T_Sym(p)))
+#define unchecked_local_value(p)       local_slot(p)->object.slt.val
+#define global_value(p)                slot_value(global_slot(T_Sym(p)))
+
+#define keyword_symbol(p)              symbol_info(T_Key(p))->nx.ksym        /* keyword only, so does not collide with documentation */
+#define keyword_symbol_unchecked(p)    symbol_info(p)->nx.ksym
+#define keyword_set_symbol(p, Val)     symbol_info(T_Key(p))->nx.ksym = T_Sym(Val)
+#define symbol_help(p)                 symbol_info(p)->nx.documentation
+#define symbol_set_help(p, Doc)        symbol_info(p)->nx.documentation = Doc
+#define symbol_tag(p)                  (T_Sym(p))->object.sym.tag
+#define symbol_set_tag(p, Val)         (T_Sym(p))->object.sym.tag = Val
+#define symbol_ctr(p)                  (T_Sym(p))->object.sym.ctr            /* needs to be in the symbol object (not symbol_info) for speed */
+#define symbol_clear_ctr(p)            (T_Sym(p))->object.sym.ctr = 0
+#define symbol_increment_ctr(p)        (T_Sym(p))->object.sym.ctr++
+#define symbol_tag2(p)                 symbol_info(p)->ln.tag
+#define symbol_set_tag2(p, Val)        symbol_info(p)->ln.tag = Val
+#define symbol_has_help(p)             (is_documented(symbol_name_cell(p)))
+#define symbol_set_has_help(p)         set_documented(symbol_name_cell(p))
+/* symbol_info->dx is free */
+
+#define symbol_set_local_slot_unchecked(Symbol, Id, Slot) \
+  do {(Symbol)->object.sym.local_slot = T_Sln(Slot); symbol_set_id_unchecked(Symbol, Id); symbol_increment_ctr(Symbol);} while (0)
+#define symbol_set_local_slot_unchecked_and_unincremented(Symbol, Id, Slot) \
+  do {(Symbol)->object.sym.local_slot = T_Sln(Slot); symbol_set_id_unchecked(Symbol, Id);} while (0)
+#define symbol_set_local_slot(Symbol, Id, Slot) \
+  do {set_local_slot(Symbol, Slot); symbol_set_id(Symbol, Id); symbol_increment_ctr(Symbol);} while (0)
+#define symbol_set_local_slot_unincremented(Symbol, Id, Slot) \
+  do {set_local_slot(Symbol, Slot); symbol_set_id(Symbol, Id);} while (0)
+/* set slot before id in case Slot is an expression that tries to find the current Symbol slot (using its old Id obviously) */
+
+#define is_slot(p)                     (type(p) == T_SLOT)
+#define slot_symbol(p)                 T_Sym((T_Slt(p))->object.slt.sym)
+#define slot_set_symbol(p, Sym)        (T_Slt(p))->object.slt.sym = T_Sym(Sym)
+#define slot_value(p)                  T_Nmv((T_Slt(p))->object.slt.val)
+#if S7_DEBUGGING
+/* how to see an unheaped and un-GC-checked slot with a heap value?  Can't do it here because unheap=most rootlet slots */
+#define slot_set_value(slot, value) \
+  do { \
+       if (is_immutable_slot(slot)) {fprintf(stderr, "%s[%d]: setting immutable slot %s\n", __func__, __LINE__, symbol_name(slot_symbol(slot))); if (cur_sc->stop_at_error) abort();} \
+       (T_Slt(slot))->object.slt.val = T_Nmv(value); \
+     } while (0)
+#else
+#define slot_set_value(p, Val)         (T_Slt(p))->object.slt.val = T_Nmv(Val)
+#endif
+#define slot_set_symbol_and_value(Slot, Symbol, Value) do {slot_set_symbol(Slot, Symbol); slot_set_value(Slot, Value);} while (0)
+#define slot_set_value_with_hook(Slot, Value) \
+  do {if (hook_has_functions(sc->rootlet_redefinition_hook)) slot_set_value_with_hook_1(sc, Slot, T_Nmv(Value)); else slot_set_value(Slot, T_Nmv(Value));} while (0)
+#define next_slot(p)                   T_Sln((T_Slt(p))->object.slt.nxt)
+#define slot_set_next(p, Val)          (T_Slt(p))->object.slt.nxt = T_Sln(Val)
+#define slot_set_pending_value(p, Val) do {(T_Slt(p))->object.slt.pending_value = T_Nmv(Val); slot_set_has_pending_value(p);} while (0)
+#define slot_simply_set_pending_value(p, Val) (T_Slt(p))->object.slt.pending_value = T_Nmv(Val)
+#if S7_DEBUGGING
+static s7_pointer slot_pending_value(s7_pointer p) \
+  {if (slot_has_pending_value(p)) return(p->object.slt.pending_value); fprintf(stderr, "%s[%d]: slot: no pending value\n", __func__, __LINE__); abort(); return(NULL);}
+static s7_pointer slot_expression(s7_pointer p)    \
+  {if (slot_has_expression(p)) return(p->object.slt.expr); fprintf(stderr, "%s[%d]: slot: no expression\n", __func__, __LINE__); abort(); return(NULL);}
+#else
+#define slot_pending_value(p)          (T_Slt(p))->object.slt.pending_value
+#define slot_expression(p)             (T_Slt(p))->object.slt.expr
+#endif
+#define slot_pending_value_unchecked(p) (T_Slt(p))->object.slt.pending_value
+
+#define slot_set_expression(p, Val)    do {(T_Slt(p))->object.slt.expr = T_Ext(Val); slot_set_has_expression(p);} while (0)
+#define slot_just_set_expression(p, Val) (T_Slt(p))->object.slt.expr = T_Ext(Val)
+#define slot_setter(p)                 T_Prc((T_Slt(p)->object.slt.pending_value))
+#define slot_set_setter_1(p, Val)      (T_Slt(p))->object.slt.pending_value = T_Prc(Val)
+#if S7_DEBUGGING
+#define tis_slot(p) ((p) && (T_Slt(p)))
+#else
+#define tis_slot(p) (p) /* used for loop through let slots which end in null, not for general slot recognition */
+#endif
+#define slot_end NULL
+#define is_slot_end(p) (!(p))
+
+#define is_syntax(p)                   (type(p) == T_SYNTAX)
+#define syntax_symbol(p)               T_Sym((T_Syn(p))->object.syn.symbol)
+#define syntax_set_symbol(p, Sym)      (T_Syn(p))->object.syn.symbol = T_Sym(Sym)
+#define syntax_opcode(p)               (T_Syn(p))->object.syn.op
+#define syntax_min_args(p)             (T_Syn(p))->object.syn.min_args
+#define syntax_max_args(p)             (T_Syn(p))->object.syn.max_args
+#define syntax_documentation(p)        (T_Syn(p))->object.syn.documentation
+#define pair_set_syntax_op(p, X)       do {set_optimize_op(p, X); set_syntactic_pair(p);} while (0)
+#define symbol_syntax_op_checked(p)    ((is_syntactic_pair(p)) ? optimize_op(p) : symbol_syntax_op(car(p)))
+#define symbol_syntax_op(p)            syntax_opcode(global_value(p))
+#define is_syntax_or_qq(p)	       ((is_syntax(p)) || ((p) == sc->quasiquote_function)) /* qq is from s7_define_macro -> T_C_MACRO */
+
+#define let_id(p)                      (T_Let(p))->object.envr.id
+#define let_set_id(p, Id)              (T_Let(p))->object.envr.id = Id
+#define is_let(p)                      (type(p) == T_LET)
+#define is_let_unchecked(p)            (unchecked_type(p) == T_LET)
+#define let_slots(p)                   T_Sln((T_Let(p))->object.envr.slots)
+#define let_outlet(p)                  T_Out((T_Let(p))->object.envr.nxt)
+#define let_set_outlet(p, ol)          (T_Let(p))->object.envr.nxt = T_Out(ol)
+#if S7_DEBUGGING
+  #define let_set_slots(p, Slot)       check_let_set_slots(p, Slot, __func__, __LINE__)
+  #define C_Let(p, role)               check_let_ref(p, role, __func__, __LINE__)
+  #define S_Let(p, role)               check_let_set(p, role, __func__, __LINE__)
+#else
+  #define let_set_slots(p, Slot)       (T_Let(p))->object.envr.slots = T_Sln(Slot)
+  #define C_Let(p, role)               p
+  #define S_Let(p, role)               p
+#endif
+#define funclet_function(p)            T_Sym((C_Let(p, L_FUNC))->object.envr.edat.efnc.function)
+#define funclet_set_function(p, F)     (S_Let(p, L_FUNC))->object.envr.edat.efnc.function = T_Sym(F)
+#define set_curlet(Sc, P)              Sc->curlet = T_Let(P)
+
+#define let_baffle_key(p)              (T_Let(p))->object.envr.edat.key
+#define let_set_baffle_key(p, K)       (T_Let(p))->object.envr.edat.key = K
+
+#define let_line(p)                    (C_Let(p, L_FUNC))->object.envr.edat.efnc.line
+#define let_set_line(p, L)             (S_Let(p, L_FUNC))->object.envr.edat.efnc.line = L
+#define let_file(p)                    (C_Let(p, L_FUNC))->object.envr.edat.efnc.file
+#define let_set_file(p, F)             (S_Let(p, L_FUNC))->object.envr.edat.efnc.file = F
+
+#define let_dox_slot1(p)               T_Slt((C_Let(p, L_DOX))->object.envr.edat.dox.dox1)
+#define let_set_dox_slot1(p, S)        do {(S_Let(p, L_DOX))->object.envr.edat.dox.dox1 = T_Slt(S); set_has_dox_slot1(p);} while (0)
+#define let_dox_slot2(p)               T_Sld((C_Let(p, L_DOX))->object.envr.edat.dox.dox2)
+#define let_set_dox_slot2(p, S)        do {(S_Let(p, L_DOX))->object.envr.edat.dox.dox2 = T_Slt(S); set_has_dox_slot2(p);} while (0)
+#define let_dox_slot2_unchecked(p)     T_Sld(C_Let(p, L_DOX)->object.envr.edat.dox.dox2)
+#define let_set_dox_slot2_unchecked(p, S) do {S_Let(p, L_DOX)->object.envr.edat.dox.dox2 = T_Sld(S); set_has_dox_slot2(p);} while (0)
+#define let_dox1_value(p)              slot_value(let_dox_slot1(p))
+#define let_dox2_value(p)              slot_value(let_dox_slot2(p))
+
+#define unique_name(p)                 (p)->object.unq.name /* not T_Uniq(p) here -- see make_unique */
+#define unique_name_length(p)          (p)->object.unq.len
+#define is_unspecified(p)              (type(p) == T_UNSPECIFIED)
+#define unique_car(p)                  (p)->object.unq.car
+#define unique_cdr(p)                  (p)->object.unq.cdr
+
+#define is_undefined(p)                (type(p) == T_UNDEFINED)
+#define undefined_name(p)              (T_Undf(p))->object.undef.name
+#define undefined_name_length(p)       (T_Undf(p))->object.undef.len
+#define undefined_set_name_length(p, L) (T_Undf(p))->object.undef.len = L
+#define eof_name(p)                    (T_Eof(p))->object.eof.name
+#define eof_name_length(p)             (T_Eof(p))->object.eof.len
+
+#define is_any_vector(p)               t_vector_p[type(p)]
+#define is_t_vector(p)                 (type(p) == T_VECTOR)
+#define vector_length(p)               (p)->object.vector.length
+#define unchecked_vector_elements(p)   (p)->object.vector.elements.objects
+#define unchecked_vector_element(p, i) ((p)->object.vector.elements.objects[i])
+#define vector_element(p, i)           ((T_Nvc(p))->object.vector.elements.objects[i])
+#define vector_elements(p)             (T_Nvc(p))->object.vector.elements.objects
+#define any_vector_elements(p)         (T_Vec(p))->object.vector.elements.objects
+#define vector_getter(p)               (T_Vec(p))->object.vector.vget
+#define vector_setter(p)               (T_Vec(p))->object.vector.setv.vset
+#define vector_block(p)                (T_Vec(p))->object.vector.block
+#define unchecked_vector_block(p)      p->object.vector.block
+
+#define typed_vector_typer(p)          T_Prc((T_Nvc(p))->object.vector.setv.fset)
+#define typed_vector_set_typer(p, Fnc) (T_Nvc(p))->object.vector.setv.fset = T_Prc(Fnc)
+#define typed_vector_gc_mark(p)        ((is_c_function(typed_vector_typer(p))) ? c_function_marker(typed_vector_typer(p)) : mark_typed_vector_1)
+#define typed_vector_typer_call(sc, p, Args) \
+  ((is_c_function(typed_vector_typer(p))) ? c_function_call(typed_vector_typer(p))(sc, Args) : s7_apply_function(sc, typed_vector_typer(p), Args))
+
+#define is_int_vector(p)               (type(p) == T_INT_VECTOR)
+#define int_vector(p, i)               ((T_Ivc(p))->object.vector.elements.ints[i])
+#define int_vector_ints(p)             (T_Ivc(p))->object.vector.elements.ints
+
+#define is_float_vector(p)             (type(p) == T_FLOAT_VECTOR)
+#define float_vector(p, i)             ((T_Fvc(p))->object.vector.elements.floats[i])
+#define float_vector_floats(p)         (T_Fvc(p))->object.vector.elements.floats
+
+#define is_byte_vector(p)              (type(p) == T_BYTE_VECTOR)
+#define byte_vector_length(p)          (T_BVc(p))->object.vector.length
+#define byte_vector_bytes(p)           (T_BVc(p))->object.vector.elements.bytes
+#define byte_vector(p, i)              ((T_BVc(p))->object.vector.elements.bytes[i])
+#define is_string_or_byte_vector(p)    ((type(p) == T_STRING) || (type(p) == T_BYTE_VECTOR))
+
+#define vector_dimension_info(p)       ((vdims_t *)(T_Vec(p))->object.vector.block->ex.ex_info)
+#define vector_set_dimension_info(p, d) (T_Vec(p))->object.vector.block->ex.ex_info = (void  *)d
+#define vector_ndims(p)                vdims_rank(vector_dimension_info(p))
+#define vector_dimension(p, i)         vdims_dims(vector_dimension_info(p))[i]
+#define vector_dimensions(p)           vdims_dims(vector_dimension_info(p))
+#define vector_offset(p, i)            vdims_offsets(vector_dimension_info(p))[i]
+#define vector_offsets(p)              vdims_offsets(vector_dimension_info(p))
+#define vector_rank(p)                 ((vector_dimension_info(p)) ? vector_ndims(p) : 1)
+#define vector_has_dimension_info(p)   (vector_dimension_info(p))
+
+#define subvector_vector(p)            T_Vec(((vector_dimension_info(T_SVec(p))) ? vdims_original(vector_dimension_info(p)) : (p)->object.vector.block->nx.ksym))
+#define subvector_set_vector(p, vect)  (T_SVec(p))->object.vector.block->nx.ksym = T_Vec(vect)
+
+#define stack_element(p, i)            unchecked_vector_element(T_Stk(p), i)
+#define stack_elements(p)              unchecked_vector_elements(T_Stk(p))
+#define stack_block(p)                 unchecked_vector_block(T_Stk(p))
+#define stack_top(Sc)                  ((Sc)->stack_end - (Sc)->stack_start)
+#define temp_stack_top(p)              (T_Stk(p))->object.stk.top
+/* #define stack_flags(p)              (T_Stk(p))->object.stk.flags */
+#define stack_clear_flags(p)           (T_Stk(p))->object.stk.flags = 0
+#define stack_has_pairs(p)             (((T_Stk(p))->object.stk.flags & 1) != 0)
+#define stack_set_has_pairs(p)         (T_Stk(p))->object.stk.flags |= 1
+#define stack_has_counters(p)          (((T_Stk(p))->object.stk.flags & 2) != 0)
+#define stack_set_has_counters(p)      (T_Stk(p))->object.stk.flags |= 2
+
+#define is_hash_table(p)               (type(p) == T_HASH_TABLE)
+#define is_mutable_hash_table(p)       ((full_type(T_Ext(p)) & (TYPE_MASK | T_IMMUTABLE)) == T_HASH_TABLE)
+#define hash_table_mask(p)             (T_Hsh(p))->object.hasher.mask
+#define hash_table_size(p)             ((T_Hsh(p))->object.hasher.mask + 1)
+#define hash_table_block(p)            (T_Hsh(p))->object.hasher.block
+#define unchecked_hash_table_block(p)  p->object.hasher.block
+#define hash_table_set_block(p, b)     (T_Hsh(p))->object.hasher.block = b
+#define hash_table_element(p, i)       (T_Hsh(p))->object.hasher.elements[i]
+#define hash_table_elements(p)         (T_Hsh(p))->object.hasher.elements /* block data (dx) */
+#define hash_table_entries(p)          hash_table_block(p)->nx.nx_int
+#define hash_table_checker(p)          (T_Hsh(p))->object.hasher.hash_func
+#define hash_table_mapper(p)           (T_Hsh(p))->object.hasher.loc
+#define hash_table_procedures(p)       T_Lst(hash_table_block(p)->ex.ex_ptr)
+#define hash_table_set_procedures(p, Lst)       hash_table_block(p)->ex.ex_ptr = T_Lst(Lst)  /* both the checker/mapper: car/cdr, and the two typers (opt1/opt2) */
+#define hash_table_procedures_checker(p)        T_Prc(car(hash_table_procedures(p)))
+#define hash_table_procedures_mapper(p)         T_Prc(cdr(hash_table_procedures(p)))
+#define hash_table_set_procedures_checker(p, f) set_car(hash_table_procedures(p), T_Prc(f))
+#define hash_table_set_procedures_mapper(p, f)  set_cdr(hash_table_procedures(p), T_Prc(f))
+#define hash_table_key_typer(p)                 T_Prc(opt1_any(hash_table_procedures(p)))
+#define hash_table_key_typer_unchecked(p)       hash_table_block(p)->ex.ex_ptr->object.cons.opt1
+#define hash_table_set_key_typer(p, Fnc)        set_opt1_any(hash_table_procedures(T_Hsh(p)), T_Prc(Fnc))
+#define hash_table_value_typer(p)               T_Prc(opt2_any(hash_table_procedures(p)))
+#define hash_table_value_typer_unchecked(p)     hash_table_block(p)->ex.ex_ptr->object.cons.o2.opt2
+#define hash_table_set_value_typer(p, Fnc)      set_opt2_any(hash_table_procedures(T_Hsh(p)), T_Prc(Fnc))
+#define weak_hash_iters(p)                      hash_table_block(p)->ln.tag
+
+#if S7_DEBUGGING
+#define T_Itr_Pos(p)                   titr_pos(sc, T_Itr(p), __func__, __LINE__)
+#define T_Itr_Len(p)                   titr_len(sc, T_Itr(p), __func__, __LINE__)
+#define T_Itr_Hash(p)                  titr_hash(sc, T_Itr(p), __func__, __LINE__)
+#define T_Itr_Let(p)                   titr_let(sc, T_Itr(p), __func__, __LINE__)
+#define T_Itr_Pair(p)                  titr_pair(sc, T_Itr(p), __func__, __LINE__)
+#else
+#define T_Itr_Pos(p)                   p
+#define T_Itr_Len(p)                   p
+#define T_Itr_Hash(p)                  p
+#define T_Itr_Let(p)                   p
+#define T_Itr_Pair(p)                  p
+#endif
+
+#define is_iterator(p)                 (type(p) == T_ITERATOR)
+#define iterator_sequence(p)           (T_Itr(p))->object.iter.obj
+#define iterator_position(p)           (T_Itr_Pos(p))->object.iter.lc.loc
+#define iterator_length(p)             (T_Itr_Len(p))->object.iter.lw.len
+#define iterator_next(p)               (T_Itr(p))->object.iter.next
+#define iterator_is_at_end(p)          (!iter_ok(p))                /* ((full_type(T_Itr(p)) & T_ITER_OK) == 0) */
+#define iterator_slow(p)               T_Lst((T_Itr_Pair(p))->object.iter.lw.slow)
+#define iterator_set_slow(p, Val)      (T_Itr_Pair(p))->object.iter.lw.slow = T_Lst(Val)
+#define iterator_hash_current(p)       (T_Itr_Hash(p))->object.iter.lw.hcur
+#define iterator_current(p)            (T_Itr(p))->object.iter.cur
+#define iterator_current_slot(p)       T_Sln((T_Itr_Let(p))->object.iter.lc.lcur)
+#define iterator_set_current_slot(p, Val) (T_Itr_Let(p))->object.iter.lc.lcur = T_Sln(Val)
+#define iterator_let_cons(p)           (T_Itr_Let(p))->object.iter.cur
+
+#define ITERATOR_END                   eof_object
+#define ITERATOR_END_NAME              "#<eof>"
+
+#define is_input_port(p)               (type(p) == T_INPUT_PORT)
+#define is_output_port(p)              (type(p) == T_OUTPUT_PORT)
+#define port_port(p)                   (T_Prt(p))->object.prt.port
+#define is_string_port(p)              (port_type(p) == STRING_PORT)
+#define is_file_port(p)                (port_type(p) == FILE_PORT)
+#define is_function_port(p)            (port_type(p) == FUNCTION_PORT)
+#define port_filename_block(p)         port_port(p)->filename_block
+#define port_filename(p)               port_port(p)->filename
+#define port_filename_length(p)        port_port(p)->filename_length
+#define port_file(p)                   port_port(p)->file
+#define port_data_block(p)             port_port(p)->block
+#define unchecked_port_data_block(p)   p->object.prt.port->block
+#define port_line_number(p)            port_port(p)->line_number
+#define port_file_number(p)            port_port(p)->file_number
+#define port_data(p)                   (T_Prt(p))->object.prt.data
+#define port_data_size(p)              (T_Prt(p))->object.prt.size
+#define port_position(p)               (T_Prt(p))->object.prt.point
+#define port_block(p)                  (T_Prt(p))->object.prt.block
+#define port_type(p)                   port_port(p)->ptype
+#define port_is_closed(p)              port_port(p)->is_closed
+#define port_set_closed(p, Val)        port_port(p)->is_closed = Val
+#define port_needs_free(p)             port_port(p)->needs_free
+#define port_next(p)                   port_block(p)->nx.next
+#define port_output_function(p)        port_port(p)->output_function /* these two are for function ports */
+#define port_input_function(p)         port_port(p)->input_function
+#define port_string_or_function(p)     port_port(p)->orig_str
+#define port_set_string_or_function(p, S) port_port(p)->orig_str = S
+
+#define current_input_port(Sc)         T_Pri(Sc->input_port)
+#define set_current_input_port(Sc, P)  Sc->input_port = T_Pri(P)
+#define current_output_port(Sc)        T_Pro(Sc->output_port)
+#define set_current_output_port(Sc, P) Sc->output_port = T_Pro(P)
+#define current_error_port(Sc)         T_Pro(Sc->error_port)
+#define set_current_error_port(Sc, P)  Sc->error_port = T_Pro(P)
+
+#define port_read_character(p)         port_port(p)->pf->read_character
+#define port_read_line(p)              port_port(p)->pf->read_line
+#define port_display(p)                port_port(p)->pf->displayer
+#define port_write_character(p)        port_port(p)->pf->write_character
+#define port_write_string(p)           port_port(p)->pf->write_string
+#define port_read_semicolon(p)         port_port(p)->pf->read_semicolon
+#define port_read_white_space(p)       port_port(p)->pf->read_white_space
+#define port_read_name(p)              port_port(p)->pf->read_name
+#define port_read_sharp(p)             port_port(p)->pf->read_sharp
+#define port_close(p)                  port_port(p)->pf->close_port
+
+#define is_c_function(f)               (type(f) >= T_C_FUNCTION) /* does not include T_C_FUNCTION_STAR */
+#define is_c_function_star(f)          (type(f) == T_C_FUNCTION_STAR)
+#define is_any_c_function(f)           (type(f) >= T_C_FUNCTION_STAR)
+#define is_safe_c_function(f)          ((is_c_function(f)) && (is_safe_procedure(f)))
+#define c_function_data(f)             (T_Fnc(f))->object.fnc.c_proc
+#define c_function_call(f)             (T_Fnc(f))->object.fnc.ff
+#define c_function_min_args(f)         (T_Fnc(f))->object.fnc.required_args
+#define c_function_optional_args(f)    (T_Fnc(f))->object.fnc.optional_args
+#define c_function_max_args(f)         (T_Fnc(f))->object.fnc.all_args
+#define c_function_is_aritable(f, N)   ((c_function_min_args(f) <= N) && (c_function_max_args(f) >= N))
+#define c_function_name(f)             c_function_data(f)->name
+#define c_function_name_length(f)      c_function_data(f)->name_length
+#define c_function_documentation(f)    c_function_data(f)->doc
+#define c_function_signature(f)        c_function_data(f)->signature
+#define c_function_setter(f)           T_Prc(c_function_data(f)->setter)
+#define c_function_set_setter(f, Val)  c_function_data(f)->setter = T_Prc(Val)
+#define c_function_class(f)            c_function_data(f)->id
+#define c_function_chooser(f)          c_function_data(f)->chooser
+#define c_function_base(f)             T_Fnc(c_function_data(f)->generic_ff)
+#define c_function_set_base(f, Val)    c_function_data(f)->generic_ff = T_Fnc(Val)
+#define c_function_marker(f)           c_function_data(f)->cam.marker              /* the mark function for the vector (mark_vector_1 etc) */
+#define c_function_set_marker(f, Val)  c_function_data(f)->cam.marker = Val
+#define c_function_symbol(f)           c_function_data(f)->sam.c_sym
+
+#define c_function_bool_setter(f)      c_function_data(f)->dam.bool_setter
+#define c_function_set_bool_setter(f, Val) c_function_data(f)->dam.bool_setter = T_Fnc(Val)
+
+#define c_function_arg_defaults(f)     c_function_data(T_Fst(f))->dam.arg_defaults
+#define c_function_call_args(f)        c_function_data(T_Fst(f))->cam.call_args
+#define c_function_arg_names(f)        c_function_data(T_Fst(f))->sam.arg_names
+
+#define set_c_function(X, f)           do {set_opt1_cfunc(X, f); set_fn_direct(X, c_function_call(f));} while (0)
+#define c_function_opt_data(f)         c_function_data(f)->opt_data
+
+#define is_c_macro(p)                  (type(p) == T_C_MACRO)
+#define c_macro_data(f)                (T_CMac(f))->object.fnc.c_proc
+#define c_macro_call(f)                (T_CMac(f))->object.fnc.ff
+#define c_macro_name(f)                c_macro_data(f)->name
+#define c_macro_name_length(f)         c_macro_data(f)->name_length
+#define c_macro_min_args(f)            (T_CMac(f))->object.fnc.required_args
+#define c_macro_max_args(f)            (T_CMac(f))->object.fnc.all_args
+#define c_macro_setter(f)              T_Prc(c_macro_data(f)->setter)
+#define c_macro_set_setter(f, Val)     c_macro_data(f)->setter = T_Prc(Val)
+#define could_be_macro_setter(Obj)     t_macro_setter_p[type(Obj)]
+
+#define is_random_state(p)             (type(p) == T_RANDOM_STATE)
+#define random_gmp_state(p)            (p)->object.rng.state /* sweep sees free cell in big_random_state gc_list and needs to call gmprandclear on its value */
+#define random_seed(p)                 (T_Ran(p))->object.rng.seed
+#define random_carry(p)                (T_Ran(p))->object.rng.carry
+
+#define continuation_block(p)          (T_Con(p))->object.cwcc.block
+#define continuation_stack(p)          T_Stk(T_Con(p)->object.cwcc.stack)
+#define continuation_set_stack(p, Val) (T_Con(p))->object.cwcc.stack = T_Stk(Val)
+#define continuation_stack_end(p)      (T_Con(p))->object.cwcc.stack_end
+#define continuation_stack_start(p)    (T_Con(p))->object.cwcc.stack_start
+#define continuation_stack_top(p)      (continuation_stack_end(p) - continuation_stack_start(p))
+#define continuation_op_stack(p)       (T_Con(p))->object.cwcc.op_stack
+#define continuation_stack_size(p)     continuation_block(p)->nx.ix.i1
+#define continuation_op_loc(p)         continuation_block(p)->nx.ix.i2
+#define continuation_op_size(p)        continuation_block(p)->ln.tag
+#define continuation_key(p)            continuation_block(p)->ex.ckey
+/* this can overflow int32_t -- baffle_key is s7_int, so ckey should be also */
+#define continuation_name(p)           continuation_block(p)->dx.d_ptr
+
+#define call_exit_goto_loc(p)          (T_Got(p))->object.rexit.goto_loc
+#define call_exit_op_loc(p)            (T_Got(p))->object.rexit.op_stack_loc
+#define call_exit_active(p)            (T_Got(p))->object.rexit.active
+#define call_exit_name(p)              (T_Got(p))->object.rexit.name
+
+#define is_continuation(p)             (type(p) == T_CONTINUATION)
+#define is_goto(p)                     (type(p) == T_GOTO)
+#define is_macro(p)                    (type(p) == T_MACRO)
+#define is_macro_star(p)               (type(p) == T_MACRO_STAR)
+#define is_bacro(p)                    (type(p) == T_BACRO)
+#define is_bacro_star(p)               (type(p) == T_BACRO_STAR)
+#define is_either_macro(p)             ((is_macro(p)) || (is_macro_star(p)))
+#define is_either_bacro(p)             ((is_bacro(p)) || (is_bacro_star(p)))
+
+#define is_closure(p)                  (type(p) == T_CLOSURE)
+#define is_closure_star(p)             (type(p) == T_CLOSURE_STAR)
+#define closure_args(p)                T_Arg((T_Clo(p))->object.func.args)
+#define closure_set_args(p, Val)       (T_Clo(p))->object.func.args = T_Arg(Val)
+#define closure_body(p)                (T_Pair((T_Clo(p))->object.func.body))
+#define closure_set_body(p, Val)       (T_Clo(p))->object.func.body = T_Pair(Val)
+#define closure_let(p)                 T_Let((T_Clo(p))->object.func.env)
+#define closure_set_let(p, L)          (T_Clo(p))->object.func.env = T_Let(L)
+#define closure_arity(p)               (T_Clo(p))->object.func.arity
+#define closure_set_arity(p, A)        (T_Clo(p))->object.func.arity = A
+
+#define closure_setter(p)              (T_Prc((T_Clo(p))->object.func.setter))
+#define closure_set_setter(p, Val)     (T_Clo(p))->object.func.setter = T_Prc(Val)
+#define closure_map_list(p)            (T_Pair((T_Clo(p))->object.func.setter))
+#define closure_set_map_list(p, Val)   (T_Clo(p))->object.func.setter = T_Pair(Val)
+#define closure_setter_or_map_list(p)  (T_Clo(p)->object.func.setter)
+/* closure_map_list refers to a cyclic list detector in map; since in this case map makes a new closure for its own use,
+ *   closure_map_list doesn't collide with closure_setter.
+ */
+
+#define CLOSURE_ARITY_NOT_SET          0x40000000
+#define MAX_ARITY                      0x20000000
+#define closure_arity_unknown(p)       (closure_arity(p) == CLOSURE_ARITY_NOT_SET)
+#define is_thunk(Sc, Fnc)              ((type(Fnc) >= T_GOTO) && (s7_is_aritable(Sc, Fnc, 0)))
+
+#define hook_has_functions(p)          (is_pair(s7_hook_functions(sc, T_Clo(p))))
+
+#define catch_tag(p)                   (T_Cat(p))->object.rcatch.tag
+#define catch_goto_loc(p)              (T_Cat(p))->object.rcatch.goto_loc
+#define catch_op_loc(p)                (T_Cat(p))->object.rcatch.op_stack_loc
+#define catch_cstack(p)                (T_Cat(p))->object.rcatch.cstack
+#define catch_handler(p)               T_Ext((T_Cat(p))->object.rcatch.handler)
+#define catch_set_handler(p, val)      (T_Cat(p))->object.rcatch.handler = T_Ext(val)
+
+#define dynamic_wind_state(p)          (T_Dyn(p))->object.winder.state
+#define dynamic_wind_in(p)             (T_Dyn(p))->object.winder.in
+#define dynamic_wind_out(p)            (T_Dyn(p))->object.winder.out
+#define dynamic_wind_body(p)           (T_Dyn(p))->object.winder.body
+
+#define is_c_object(p)                 (type(p) == T_C_OBJECT)
+#define c_object_value(p)              (T_Obj(p))->object.c_obj.value
+#define c_object_type(p)               (T_Obj(p))->object.c_obj.type
+#define c_object_let(p)                T_Let((T_Obj(p))->object.c_obj.e)
+#define c_object_set_let(p, L)         (T_Obj(p))->object.c_obj.e = T_Let(L)
+#define c_object_s7(p)                 (T_Obj(p))->object.c_obj.sc
+
+#define c_object_info(Sc, p)           Sc->c_object_types[c_object_type(T_Obj(p))]
+#define c_object_free(Sc, p)           c_object_info(Sc, p)->free
+#define c_object_mark(Sc, p)           c_object_info(Sc, p)->mark
+#define c_object_gc_mark(Sc, p)        c_object_info(Sc, p)->gc_mark
+#define c_object_gc_free(Sc, p)        c_object_info(Sc, p)->gc_free
+#define c_object_ref(Sc, p)            c_object_info(Sc, p)->ref
+#define c_object_getf(Sc, p)           c_object_info(Sc, p)->getter
+#define c_object_set(Sc, p)            c_object_info(Sc, p)->set
+#define c_object_setf(Sc, p)           c_object_info(Sc, p)->setter
+#if (!DISABLE_DEPRECATED)
+  #define c_object_print(Sc, p)        c_object_info(Sc, p)->print
+#endif
+#define c_object_len(Sc, p)            c_object_info(Sc, p)->length
+#define c_object_eql(Sc, p)            c_object_info(Sc, p)->eql
+#define c_object_equal(Sc, p)          c_object_info(Sc, p)->equal
+#define c_object_equivalent(Sc, p)     c_object_info(Sc, p)->equivalent
+#define c_object_fill(Sc, p)           c_object_info(Sc, p)->fill
+#define c_object_copy(Sc, p)           c_object_info(Sc, p)->copy
+#define c_object_reverse(Sc, p)        c_object_info(Sc, p)->reverse
+#define c_object_to_list(Sc, p)        c_object_info(Sc, p)->to_list
+#define c_object_to_string(Sc, p)      c_object_info(Sc, p)->to_string
+#define c_object_scheme_name(Sc, p)    T_Str(c_object_info(Sc, p)->scheme_name)
+
+#define c_pointer(p)                   (T_Ptr(p))->object.cptr.c_pointer
+#define c_pointer_type(p)              (T_Ptr(p))->object.cptr.c_type
+#define c_pointer_info(p)              (T_Ptr(p))->object.cptr.info
+#define c_pointer_weak1(p)             (T_Ptr(p))->object.cptr.weak1
+#define c_pointer_weak2(p)             (T_Ptr(p))->object.cptr.weak2
+#define c_pointer_set_weak1(p, q)      (T_Ptr(p))->object.cptr.weak1 = T_Ext(q)
+#define c_pointer_set_weak2(p, q)      (T_Ptr(p))->object.cptr.weak2 = T_Ext(q)
+#define is_c_pointer(p)                (type(p) == T_C_POINTER)
+
+#define is_counter(p)                  (type(p) == T_COUNTER)
+#define counter_result(p)              (T_Ctr(p))->object.ctr.result
+#define counter_set_result(p, Val)     (T_Ctr(p))->object.ctr.result = T_Ext(Val)
+#define counter_list(p)                (T_Ctr(p))->object.ctr.list
+#define counter_set_list(p, Val)       (T_Ctr(p))->object.ctr.list = T_Ext(Val)
+#define counter_capture(p)             (T_Ctr(p))->object.ctr.cap
+#define counter_set_capture(p, Val)    (T_Ctr(p))->object.ctr.cap = Val
+#define counter_let(p)                 T_Let((T_Ctr(p))->object.ctr.env)
+#define counter_set_let(p, L)          (T_Ctr(p))->object.ctr.env = T_Let(L)
+#define counter_slots(p)               T_Sln(T_Ctr(p)->object.ctr.slots)
+#define counter_set_slots(p, Val)      (T_Ctr(p))->object.ctr.slots = T_Sln(Val)
+
+#if S7_DEBUGGING
+#define init_temp(p, Val)              do {if (p != sc->unused) fprintf(stderr, "%s[%d]: init_temp %s\n", __func__, __LINE__, display(p)); p = T_Ext(Val);} while (0)
+#else
+#define init_temp(p, Val)              p = Val
+#endif
+
+#if __cplusplus && HAVE_COMPLEX_NUMBERS
+  using namespace std;                /* the code has to work in C as well as C++, so we can't scatter std:: all over the place */
+  typedef complex<s7_double> s7_complex;
+  static s7_double Real(complex<s7_double> x) {return(real(x));} /* protect the C++ name */
+  static s7_double Imag(complex<s7_double> x) {return(imag(x));}
+#endif
+
+#define integer(p)                     (T_Int(p))->object.number.integer_value
+#define set_integer(p, x)              integer(p) = x
+#define real(p)                        (T_Rel(p))->object.number.real_value
+#define set_real(p, x)                 real(p) = x
+#define numerator(p)                   (T_Frc(p))->object.number.fraction_value.numerator
+#define set_numerator(p, x)            numerator(p) = x
+#define denominator(p)                 (T_Frc(p))->object.number.fraction_value.denominator
+#define set_denominator(p, x)          denominator(p) = x
+#define fraction(p)                    (((long_double)numerator(p)) / ((long_double)denominator(p)))
+#define inverted_fraction(p)           (((long_double)denominator(p)) / ((long_double)numerator(p)))
+#define real_part(p)                   (T_Cmp(p))->object.number.complex_value.rl
+#define set_real_part(p, x)            real_part(p) = x
+#define imag_part(p)                   (T_Cmp(p))->object.number.complex_value.im
+#define set_imag_part(p, x)            imag_part(p) = x
+#if HAVE_COMPLEX_NUMBERS
+  #define to_c_complex(p)              CMPLX(real_part(p), imag_part(p))
+#endif
+
+#if WITH_GMP
+#define big_integer(p)                 ((T_Bgi(p))->object.number.bgi->n)
+#define big_integer_nxt(p)             (p)->object.number.bgi->nxt
+#define big_integer_bgi(p)             (p)->object.number.bgi
+#define big_ratio(p)                   ((T_Bgf(p))->object.number.bgr->q)
+#define big_ratio_nxt(p)               (p)->object.number.bgr->nxt
+#define big_ratio_bgr(p)               (p)->object.number.bgr
+#define big_real(p)                    ((T_Bgr(p))->object.number.bgf->x)
+#define big_real_nxt(p)                (p)->object.number.bgf->nxt
+#define big_real_bgf(p)                (p)->object.number.bgf
+#define big_complex(p)                 ((T_Bgz(p))->object.number.bgc->z)
+#define big_complex_nxt(p)             (p)->object.number.bgc->nxt
+#define big_complex_bgc(p)             (p)->object.number.bgc
+#endif
+
+#if S7_DEBUGGING
+const char *display(s7_pointer obj);
+const char *display(s7_pointer obj)
+{
+  const char *res;
+  if (!has_methods(obj))
+    return(string_value(s7_object_to_string(cur_sc, obj, false)));
+  clear_type_bit(obj, T_HAS_METHODS); /* clear_has_methods calls T_Met -> check_ref_met */
+  res = string_value(s7_object_to_string(cur_sc, obj, false));
+  set_type_bit(obj, T_HAS_METHODS);   /* same for set_has_methods */
+  return(res);
+}
+#else
+#define display(Obj)    string_value(s7_object_to_string(cur_sc, Obj, false))
+#endif
+#define display_truncated(Obj) string_value(object_to_string_truncated(cur_sc, Obj))
+
+#if S7_DEBUGGING
+static void set_type_1(s7_pointer p, uint64_t f, const char *func, int32_t line)
+{
+  p->alloc_line = line;
+  p->alloc_func = func;
+  p->alloc_type = f;
+  p->explicit_free_line = 0;
+  p->uses++;
+  if (((f) & TYPE_MASK) == T_FREE)
+    fprintf(stderr, "%d: set free, %p type to %" PRIx64 "\n", __LINE__, p, (int64_t)(f));
+  else
+    if (((f) & TYPE_MASK) >= NUM_TYPES)
+      fprintf(stderr, "%d: set invalid type, %p type to %" PRIx64 "\n", __LINE__, p, (int64_t)(f));
+    else
+      {
+	if (((full_type(p) & T_IMMUTABLE) != 0) && ((full_type(p) != (uint64_t)(f))))
+	  {
+	    fprintf(stderr, "%s[%d]: set immutable %p type %d to %" ld64 "\n", __func__, __LINE__, p, unchecked_type(p), (int64_t)(f));
+	    abort();
+	  }
+	if (((full_type(p) & T_UNHEAP) != 0) && (((f) & T_UNHEAP) == 0))
+	  fprintf(stderr, "%s[%d]: clearing unheap in set type!\n", __func__, __LINE__);
+      }
+  full_type(p) = f;
+}
+#endif
+
+#define number_name(p)        (char *)((T_Num(p))->object.number_name.name + 1)
+#define number_name_length(p) (T_Num(p))->object.number_name.name[0]
+
+static void set_number_name(s7_pointer p, const char *name, int32_t len)
+{
+  /* if no number name: teq +110 tread +30 tform +90 */
+  if ((len >= 0) && (len < NUMBER_NAME_SIZE) && (!is_mutable_number(p)))
+    {
+      set_has_number_name(p);
+      number_name_length(p) = (uint8_t)len;
+      memcpy((void *)number_name(p), (const void *)name, len);
+      (number_name(p))[len] = 0;
+    }
+}
+
+static s7_int s7_int_min = 0;
+static int32_t s7_int_digits_by_radix[17];
+
+#define S7_INT_BITS 63
+
+#define S7_INT64_MAX 9223372036854775807LL
+#define S7_INT64_MIN (int64_t)(-S7_INT64_MAX - 1LL)
+
+#define S7_INT32_MAX 2147483647LL
+#define S7_INT32_MIN (-S7_INT32_MAX - 1LL)
+
+static void init_int_limits(void)
+{
+#if WITH_GMP
+  #define S7_LOG_INT64_MAX 36.736800
+#else
+  /* actually not safe = (log (- (expt 2 63) 1)) and (log (- (expt 2 31) 1)) (using 63 and 31 bits) */
+  #define S7_LOG_INT64_MAX 43.668274
+#endif
+  s7_int_min = S7_INT64_MIN; /* see comment in s7_make_ratio -- we're trying to hack around a gcc bug (9.2.1 Ubuntu) */
+  s7_int_digits_by_radix[0] = 0;
+  s7_int_digits_by_radix[1] = 0;
+  for (int32_t i = 2; i < 17; i++)
+    s7_int_digits_by_radix[i] = (int32_t)(floor(S7_LOG_INT64_MAX / log((double)i)));
+}
+
+static s7_pointer make_permanent_integer(s7_int i)
+{
+  s7_pointer p = (s7_pointer)Calloc(1, sizeof(s7_cell)); /* Calloc to clear name */
+  full_type(p) = T_IMMUTABLE | T_INTEGER | T_UNHEAP;
+  set_integer(p, i);
+  return(p);
+}
+
+#define NUM_CHARS 256
+#ifndef NUM_SMALL_INTS
+  #define NUM_SMALL_INTS 8192
+#else
+#if (NUM_SMALL_INTS < NUM_CHARS) /* g_char_to_integer assumes this is at least NUM_CHARS, as does the byte_vector stuff (256) */
+  #error NUM_SMALL_INTS is less than NUM_CHARS which will not work
+#endif
+#endif
+
+static bool t_number_separator_p[NUM_CHARS];
+static s7_pointer *small_ints = NULL;
+#define small_int(Val) small_ints[Val]
+#define is_small_int(n) ((n & ~(NUM_SMALL_INTS - 1)) == 0)   /* ((n >= 0) && (n < NUM_SMALL_INTS)) is slower */
+
+static s7_pointer real_zero, real_NaN, complex_NaN, real_pi, real_one, arity_not_set, max_arity, real_infinity, real_minus_infinity;
+static s7_pointer int_zero, int_one, int_two, int_three, minus_one, minus_two, mostfix, leastfix;
+
+static void init_small_ints(void)
+{
+  const char *ones[10] = {"0", "1", "2", "3", "4", "5", "6", "7", "8", "9"};
+  s7_cell *cells = (s7_cell *)Malloc(NUM_SMALL_INTS * sizeof(s7_cell)); /* was calloc 14-Apr-22 */
+  small_ints = (s7_pointer *)Malloc(NUM_SMALL_INTS * sizeof(s7_pointer));
+  for (int32_t i = 0; i < NUM_SMALL_INTS; i++)
+    {
+      s7_pointer p;
+      small_ints[i] = &cells[i];
+      p = small_ints[i];
+      full_type(p) = T_IMMUTABLE | T_INTEGER | T_UNHEAP;
+      set_integer(p, i);
+    }
+  for (int32_t i = 0; i < 10; i++)
+    set_number_name(small_ints[i], ones[i], 1);
+
+  /* setup a few other numbers while we're here */
+  #define EXTRA_NUMBERS 11
+  cells = (s7_cell *)Calloc(EXTRA_NUMBERS, sizeof(s7_cell));
+
+  #define init_integer(Ptr, Num, Name, Name_Len) \
+    do {set_full_type(Ptr, T_INTEGER | T_IMMUTABLE | T_UNHEAP); set_integer(Ptr, Num); set_number_name(Ptr, Name, Name_Len);} while (0)
+  #define init_integer_no_name(Ptr, Num) \
+    do {set_full_type(Ptr, T_INTEGER | T_IMMUTABLE | T_UNHEAP); set_integer(Ptr, Num);} while (0)
+  #define init_real(Ptr, Num, Name, Name_Len) \
+    do {set_full_type(Ptr, T_REAL | T_IMMUTABLE | T_UNHEAP); set_real(Ptr, Num); set_number_name(Ptr, Name, Name_Len);} while (0)
+  #define init_complex(Ptr, Real, Imag, Name, Name_Len) \
+    do {set_full_type(Ptr, T_COMPLEX | T_IMMUTABLE | T_UNHEAP); set_real_part(Ptr, Real); set_imag_part(Ptr, Imag); set_number_name(Ptr, Name, Name_Len);} while (0)
+
+  real_zero = &cells[0]; init_real(real_zero, 0.0, "0.0", 3);
+  real_one = &cells[1]; init_real(real_one, 1.0, "1.0", 3);
+  real_NaN = &cells[2]; init_real(real_NaN, NAN, "+nan.0", 6);
+  complex_NaN = &cells[10]; init_complex(complex_NaN, NAN, NAN, "+nan.0+nan.0i", 13);
+  real_infinity = &cells[3]; init_real(real_infinity, INFINITY, "+inf.0", 6);
+  real_minus_infinity = &cells[4]; init_real(real_minus_infinity, -INFINITY, "-inf.0", 6);
+  real_pi = &cells[5]; init_real(real_pi, 3.1415926535897932384626433832795029L, "pi", 2);
+
+  arity_not_set = &cells[6]; init_integer_no_name(arity_not_set, CLOSURE_ARITY_NOT_SET);
+  max_arity = &cells[7]; init_integer_no_name(max_arity, MAX_ARITY);
+  minus_one = &cells[8]; init_integer(minus_one, -1, "-1", 2);
+  minus_two = &cells[9]; init_integer(minus_two, -2, "-2", 2);
+  int_zero = small_ints[0];
+  int_one = small_ints[1];
+  int_two = small_ints[2];
+  int_three = small_ints[3];
+
+  mostfix = make_permanent_integer(S7_INT64_MAX);
+  leastfix = make_permanent_integer(s7_int_min);
+  set_number_name(mostfix, "9223372036854775807", 19);
+  set_number_name(leastfix, "-9223372036854775808", 20);
+
+  for (int32_t i = 0; i < NUM_CHARS; i++) t_number_separator_p[i] = true;
+  t_number_separator_p[(uint8_t)'i'] = false;
+  t_number_separator_p[(uint8_t)'+'] = false;
+  t_number_separator_p[(uint8_t)'-'] = false;
+  t_number_separator_p[(uint8_t)'/'] = false;
+  t_number_separator_p[(uint8_t)'@'] = false;
+  t_number_separator_p[(uint8_t)'.'] = false;
+  t_number_separator_p[(uint8_t)'e'] = false;
+  t_number_separator_p[(uint8_t)'E'] = false;
+}
+
+#define clamp_length(NLen, Len) (((NLen) < (Len)) ? (NLen) : (Len))
+
+
+/* -------------------------------------------------------------------------------- */
+#if (defined(__FreeBSD__)) || ((defined(__linux__)) && (__GLIBC__ >= 2) && (__GLIBC_MINOR__ > 17)) || (defined(__OpenBSD__)) || (defined(__NetBSD__))
+  static inline s7_int my_clock(void)
+  {
+    struct timespec ts;
+    clock_gettime(CLOCK_MONOTONIC, &ts);
+    /* coarse: 0.057u 0.007s, monotonic: 0.083u 0.007s, clock(): 0.624u 0.372s -- coarse since Linux 2.6.32, glibc > 2.17
+     *   FreeBSD has CLOCK_MONOTONIC_FAST in place of COARSE, OpenBSD and netBSD have neither
+     *   clock_getres places 1 in tv_nsec in linux, so I assume I divide billion/tv_nsec
+     *   MacOSX has clock_get_time, and after Sierra 10.12 has clock_gettime
+     *     apparently we include /usr/include/AvailabilityMacros.h, then #if MAC_OS_X_VERSION_MIN_REQUIRED >= MAC_OS_X_VERSION_10_12
+     *   Windows has QueryPerformanceCounter or something
+     * maybe just check for POSIX compatibility?
+     */
+    return(ts.tv_sec * 1000000000 + ts.tv_nsec); /* accumulated into s7_int so this should be ok: s7.h gives it 64 bits */
+  }
+
+  static s7_int ticks_per_second(void)
+  {
+    struct timespec ts;
+    clock_getres(CLOCK_MONOTONIC, &ts);
+    return((ts.tv_nsec == 0) ? 1000000000 : (1000000000 / ts.tv_nsec));
+  }
+#else
+  #define my_clock clock /* but this is cpu time? */
+  #define ticks_per_second() CLOCKS_PER_SEC
+#endif
+
+#ifndef GC_TRIGGER_SIZE
+  #define GC_TRIGGER_SIZE 64
+#endif
+
+#if S7_DEBUGGING
+static void try_to_call_gc_1(s7_scheme *sc, const char *func, int32_t line);
+#define try_to_call_gc(Sc) try_to_call_gc_1(Sc, __func__, __LINE__)
+#else
+static void try_to_call_gc(s7_scheme *sc);
+#endif
+
+#define GC_STATS 1
+#define HEAP_STATS 2
+#define STACK_STATS 4
+#define PROTECTED_OBJECTS_STATS 8
+
+#define show_gc_stats(Sc)                ((Sc->gc_stats & GC_STATS) != 0)
+#define show_stack_stats(Sc)             ((Sc->gc_stats & STACK_STATS) != 0)
+#define show_heap_stats(Sc)              ((Sc->gc_stats & HEAP_STATS) != 0)
+#define show_protected_objects_stats(Sc) ((Sc->gc_stats & PROTECTED_OBJECTS_STATS) != 0)
+
+
+/* new_cell has to include the new cell's type.  In the free list, it is 0 (T_FREE).  If we remove it here,
+ *   but then hit some error before setting the type, the GC sweep thinks it is a free cell already and
+ *   does not return it to the free list: a memory leak.
+ */
+#if (!S7_DEBUGGING)
+#define new_cell(Sc, Obj, Type)			\
+  do {						\
+    if (Sc->free_heap_top <= Sc->free_heap_trigger) try_to_call_gc(Sc); \
+    Obj = (*(--(Sc->free_heap_top))); \
+    set_full_type(Obj, Type);	      \
+    } while (0)
+
+#define new_cell_no_check(Sc, Obj, Type) do {Obj = (*(--(Sc->free_heap_top))); set_full_type(Obj, Type);} while (0)
+  /* since sc->free_heap_trigger is GC_TRIGGER_SIZE above the free heap base, we don't need
+   *   to check it repeatedly after the first such check.
+   */
+#else
+
+#define new_cell(Sc, Obj, Type)						\
+  do {									\
+    if (Sc->gc_in_progress) fprintf(stderr, "%s[%d]: new_cell during GC\n", __func__, __LINE__); \
+    if (Sc->free_heap_top <= Sc->free_heap_trigger) try_to_call_gc(Sc); \
+    Obj = (*(--(Sc->free_heap_top)));					\
+    Obj->debugger_bits = 0; Obj->gc_func = NULL; Obj->gc_line = 0;	\
+    set_full_type(Obj, Type);						\
+  } while (0)
+
+#define new_cell_no_check(Sc, Obj, Type)				\
+  do {									\
+    if (Sc->gc_in_progress) fprintf(stderr, "%s[%d]: new_cell_no_check during GC\n", __func__, __LINE__); \
+    Obj = (*(--(Sc->free_heap_top)));					\
+    if (Sc->free_heap_top < Sc->free_heap) {fprintf(stderr, "%s[%d]: free heap exhausted\n", __func__, __LINE__); abort();}\
+    Obj->debugger_bits = 0; Obj->gc_func = NULL; Obj->gc_line = 0;	\
+    set_full_type(Obj, Type);						\
+    } while (0)
+#endif
+
+/* #define gc_if_at_trigger(Sc) if (Sc->free_heap_top <= Sc->free_heap_trigger) try_to_call_gc(Sc) */
+
+#if WITH_GCC
+#define make_integer(Sc, N) \
+  ({ s7_int _N_; _N_ = (N); (is_small_int(_N_) ? small_int(_N_) : ({ s7_pointer _I_; new_cell(Sc, _I_, T_INTEGER); set_integer(_I_, _N_); _I_;}) ); })
+#define make_integer_unchecked(Sc, N) \
+  ({ s7_int _N_; _N_ = (N); (is_small_int(_N_) ? small_int(_N_) : ({ s7_pointer _I_; new_cell_no_check(Sc, _I_, T_INTEGER); set_integer(_I_, _N_); _I_;}) ); })
+
+#define make_real(Sc, X) ({ s7_pointer _R_; s7_double _N_ = (X); new_cell(Sc, _R_, T_REAL); set_real(_R_, _N_); _R_;})
+#define make_real_unchecked(Sc, X) ({ s7_pointer _R_; s7_double _N_ = (X); new_cell_no_check(Sc, _R_, T_REAL); set_real(_R_, _N_); _R_;})
+
+#if S7_DEBUGGING
+#define make_complex_not_0i(Sc, R, I) \
+  ({ s7_double _im_; _im_ = (I); if (_im_ == 0.0) fprintf(stderr, "%s[%d]: make_complex i: %f\n", __func__, __LINE__, _im_); \
+     ({ s7_pointer _C_; new_cell(Sc, _C_, T_COMPLEX); set_real_part(_C_, R); set_imag_part(_C_, _im_); _C_;}); })
+#else
+#define make_complex_not_0i(Sc, R, I) ({ s7_pointer _C_; new_cell(Sc, _C_, T_COMPLEX); set_real_part(_C_, R); set_imag_part(_C_, I); _C_;})
+#endif
+#define make_complex(Sc, R, I) \
+  ({ s7_double _im_; _im_ = (I); ((_im_ == 0.0) ? make_real(Sc, R) : \
+				  ({ s7_pointer _C_; new_cell(Sc, _C_, T_COMPLEX); set_real_part(_C_, R); set_imag_part(_C_, _im_); _C_;}) ); })
+
+#define real_to_double(Sc, X, Caller) ({ s7_pointer _x_; _x_ = (X); ((type(_x_) == T_REAL) ? real(_x_) : s7_number_to_real_with_caller(Sc, _x_, Caller)); })
+#define rational_to_double(Sc, X)     ({ s7_pointer _x_; _x_ = (X); ((type(_x_) == T_INTEGER) ? (s7_double)integer(_x_) : fraction(_x_)); })
+
+#else
+
+#define make_integer(Sc, N)           s7_make_integer(Sc, N)
+#define make_integer_unchecked(Sc, N) s7_make_integer(Sc, N)
+#define make_real(Sc, X)              s7_make_real(Sc, X)
+#define make_real_unchecked(Sc, X)    s7_make_real(Sc, X)
+#define make_complex(Sc, R, I)        s7_make_complex(Sc, R, I)
+#define make_complex_not_0i(Sc, R, I) s7_make_complex(Sc, R, I)
+#define real_to_double(Sc, X, Caller) s7_number_to_real_with_caller(Sc, X, Caller)
+#define rational_to_double(Sc, X)     s7_number_to_real(Sc, X)
+#endif
+
+#if S7_DEBUGGING
+  static char *describe_type_bits(s7_scheme *sc, s7_pointer obj);
+#endif
+
+static s7_pointer wrapped_integer(s7_scheme *sc) /* wrap_integer without small_int possibility -- usable as a mutable integer for example */
+{
+  s7_pointer p = car(sc->integer_wrappers);
+#if S7_DEBUGGING
+  if ((full_type(p) & (~T_GC_MARK)) != (T_INTEGER | T_IMMUTABLE | T_UNHEAP | T_MUTABLE)) fprintf(stderr, "%s\n", describe_type_bits(sc, p));
+#endif
+  sc->integer_wrappers = cdr(sc->integer_wrappers);
+  return(p);
+}
+
+static s7_pointer wrap_integer(s7_scheme *sc, s7_int x)
+{
+  s7_pointer p;
+  if (is_small_int(x)) return(small_int(x));
+  p = car(sc->integer_wrappers);
+#if S7_DEBUGGING
+  if ((full_type(p) & (~T_GC_MARK)) != (T_INTEGER | T_IMMUTABLE | T_UNHEAP | T_MUTABLE)) fprintf(stderr, "%s\n", describe_type_bits(sc, p));
+#endif
+  set_integer(p, x);
+  sc->integer_wrappers = cdr(sc->integer_wrappers);
+  return(p);
+}
+
+#define wrapped_real(Sc) wrap_real(Sc, 0.0) /* here (unlike above) we don't need to protect against getting a built-in real */
+
+static s7_pointer wrap_real(s7_scheme *sc, s7_double x)
+{
+  s7_pointer p = car(sc->real_wrappers);
+#if S7_DEBUGGING
+  if ((full_type(p) & (~T_GC_MARK)) != (T_REAL | T_IMMUTABLE | T_UNHEAP | T_MUTABLE)) fprintf(stderr, "%s\n", describe_type_bits(sc, p));
+#endif
+  set_real(p, x);
+  sc->real_wrappers = cdr(sc->real_wrappers);
+  return(p);
+}
+
+
+/* --------------------------------------------------------------------------------
+ * local versions of some standard C library functions
+ * timing tests involving these are very hard to interpret, local_memset is faster using int64_t than int32_t
+ */
+
+static void local_memset(void *s, uint8_t val, size_t n)
+{
+  uint8_t *s2;
+#if S7_ALIGNED
+  s2 = (uint8_t *)s;
+#else
+#if (defined(__x86_64__) || defined(__i386__))
+  if (n >= 8)
+    {
+      int64_t *s1 = (int64_t *)s;
+      size_t n8 = n >> 3;
+      int64_t ival = val | (val << 8) | (val << 16) | (((uint64_t)val) << 24); /* uint64_t casts make gcc/clang/fsanitize happy */
+      ival = (((uint64_t)ival) << 32) | ival;
+      if ((n8 & 0x3) == 0)
+	while (n8 > 0) {LOOP_4(*s1++ = ival); n8 -= 4;}
+      else do {*s1++ = ival;} while (--n8 > 0);
+      n &= 7;
+      s2 = (uint8_t *)s1;
+    }
+  else s2 = (uint8_t *)s;
+#else
+  s2 = (uint8_t *)s;
+#endif
+#endif
+  while (n > 0)
+    {
+      *s2++ = val;
+      n--;
+    }
+}
+
+static inline s7_int safe_strlen(const char *str) /* this is safer than strlen, and slightly faster */
+{
+  const char *tmp = str;
+  if ((!tmp) || (!(*tmp))) return(0);
+  for (; *tmp; ++tmp);
+  return(tmp - str);
+}
+
+static char *copy_string_with_length(const char *str, s7_int len)
+{
+  char *newstr;
+  if ((S7_DEBUGGING) && ((len <= 0) || (!str))) fprintf(stderr, "%s[%d]: len: %" ld64 ", str: %s\n", __func__, __LINE__, len, str);
+  if (len > (1LL << 48)) return(NULL); /* squelch an idiotic warning */
+  newstr = (char *)Malloc(len + 1);
+  memcpy((void *)newstr, (const void *)str, len); /* we check len != 0 above -- 24-Jan-22 */
+  newstr[len] = '\0';
+  return(newstr);
+}
+
+static char *copy_string(const char *str) {return(copy_string_with_length(str, safe_strlen(str)));}
+
+#define local_strcmp(S1, S2) (strcmp(S1, S2) == 0)
+#define c_strings_are_equal(Str1, Str2) (local_strcmp(Str1, Str2))  /* scheme strings can have embedded nulls */
+
+static bool safe_strcmp(const char *s1, const char *s2)
+{
+  if ((!s1) || (!s2)) return(s1 == s2);
+  return(local_strcmp(s1, s2));
+}
+
+static bool local_strncmp(const char *s1, const char *s2, size_t n) /* not strncmp because scheme strings can have embedded nulls */
+{
+#if ((!S7_ALIGNED) && (defined(__x86_64__) || defined(__i386__))) /* unaligned accesses are safe on i386 hardware, sez everyone */
+  if (n >= 8)
+    {
+      size_t n8 = n >> 3;
+      int64_t *is1 = (int64_t *)s1, *is2 = (int64_t *)s2;
+      do {if (*is1++ != *is2++) return(false);} while (--n8 > 0); /* in tbig LOOP_4 is slower? */
+      s1 = (const char *)is1;
+      s2 = (const char *)is2;
+      n &= 7;
+    }
+#endif
+  while (n > 0)
+    {
+      if (*s1++ != *s2++) return(false);
+      n--;
+    }
+  return(true);
+}
+
+#define strings_are_equal_with_length(Str1, Str2, Len) (local_strncmp(Str1, Str2, Len))
+
+static Sentinel size_t catstrs(char *dst, size_t len, ...) /* NULL-terminated arg list */
+{
+  const char *dend = (const char *)(dst + len - 1); /* -1 for null at end? */
+  char *d = dst;
+  va_list ap;
+  while ((*d) && (d < dend)) d++; /* stop at NULL or end-of-buffer */
+  va_start(ap, len);
+  for (const char *s = va_arg(ap, const char *); s != NULL; s = va_arg(ap, const char *))
+    while ((*s) && (d < dend)) {*d++ = *s++;}
+  *d = '\0';
+  va_end (ap);
+  return(d - dst);
+}
+
+static Sentinel size_t catstrs_direct(char *dst, const char *s1, ...)
+{ /* NULL-terminated arg list, dst is destination only (assumed empty), all args known to fit in dst */
+  char *d = dst;
+  va_list ap;
+  va_start(ap, s1);
+  for (const char *s = s1; s != NULL; s = va_arg(ap, const char *))
+    while (*s) {*d++ = *s++;}
+  *d = '\0';
+  va_end (ap);
+  return(d - dst);
+}
+
+static char *pos_int_to_str(s7_scheme *sc, s7_int num, s7_int *len, char endc)
+{
+  char *p = (char *)(sc->int_to_str3 + INT_TO_STR_SIZE - 1);
+  char *op = p;
+  *p-- = '\0';
+  if (endc != '\0') *p-- = endc;
+  do {*p-- = "0123456789"[num % 10]; num /= 10;} while (num);
+  (*len) = op - p;           /* this includes the trailing #\null */
+  return((char *)(p + 1));
+}
+
+static char *pos_int_to_str_direct(s7_scheme *sc, s7_int num)
+{
+  char *p = (char *)(sc->int_to_str4 + INT_TO_STR_SIZE - 1);
+  *p-- = '\0';
+  do {*p-- = "0123456789"[num % 10]; num /= 10;} while (num);
+  return((char *)(p + 1));
+}
+
+static char *pos_int_to_str_direct_1(s7_scheme *sc, s7_int num)
+{
+  char *p = (char *)(sc->int_to_str5 + INT_TO_STR_SIZE - 1);
+  *p-- = '\0';
+  do {*p-- = "0123456789"[num % 10]; num /= 10;} while (num);
+  return((char *)(p + 1));
+}
+
+#if WITH_GCC
+  #if S7_DEBUGGING
+    static s7_pointer lookup_1(s7_scheme *sc, const s7_pointer symbol);
+    #define lookup(Sc, Sym) check_null_sym(Sc, lookup_1(Sc, Sym), Sym, __LINE__, __func__)
+    static s7_pointer check_null_sym(s7_scheme *sc, s7_pointer p, s7_pointer sym, int32_t line, const char *func);
+    #define lookup_unexamined(Sc, Sym) lookup_1(Sc, Sym)
+    #define lookup_checked(Sc, Sym) ({s7_pointer _x_; _x_ = lookup_1(Sc, Sym); ((_x_) ? _x_ : unbound_variable(Sc, Sym));})
+  #else
+    static inline s7_pointer lookup(s7_scheme *sc, const s7_pointer symbol);
+    #define lookup_unexamined(Sc, Sym) lookup(Sc, Sym)
+    #define lookup_checked(Sc, Sym) ({s7_pointer _x_; _x_ = lookup(Sc, Sym); ((_x_) ? _x_ : unbound_variable(Sc, Sym));})
+  #endif
+#else
+  static inline s7_pointer lookup(s7_scheme *sc, const s7_pointer symbol);
+  #define lookup_unexamined(Sc, Sym) s7_symbol_value(Sc, Sym)  /* changed 3-Nov-22 -- we're using lookup_unexamined below to avoid the unbound_variable check */
+  #define lookup_checked(Sc, Sym) lookup(Sc, Sym)
+#endif
+static s7_pointer symbol_to_local_slot(s7_scheme *sc, s7_pointer symbol, s7_pointer e);
+
+
+/* ---------------- evaluator ops ---------------- */
+/* C=constant, S=symbol, A=fx-callable, Q=quote, N=any number of next >= 1, FX=list of A's, P=parlous?, O=one form, M=multiform */
+enum {OP_UNOPT, OP_GC_PROTECT, /* must be an even number of ops here, op_gc_protect used below as lower boundary marker */
+
+      OP_SAFE_C_NC, HOP_SAFE_C_NC, OP_SAFE_C_S, HOP_SAFE_C_S,
+      OP_SAFE_C_SS, HOP_SAFE_C_SS, OP_SAFE_C_SC, HOP_SAFE_C_SC, OP_SAFE_C_CS, HOP_SAFE_C_CS, OP_SAFE_C_CQ, HOP_SAFE_C_CQ,
+      OP_SAFE_C_SSS, HOP_SAFE_C_SSS, OP_SAFE_C_SCS, HOP_SAFE_C_SCS, OP_SAFE_C_SSC, HOP_SAFE_C_SSC, OP_SAFE_C_CSS, HOP_SAFE_C_CSS,
+      OP_SAFE_C_SCC, HOP_SAFE_C_SCC, OP_SAFE_C_CSC, HOP_SAFE_C_CSC, OP_SAFE_C_CCS, HOP_SAFE_C_CCS,
+      OP_SAFE_C_NS, HOP_SAFE_C_NS, OP_SAFE_C_opNCq, HOP_SAFE_C_opNCq, OP_SAFE_C_opSq, HOP_SAFE_C_opSq,
+      OP_SAFE_C_opSSq, HOP_SAFE_C_opSSq, OP_SAFE_C_opSCq, HOP_SAFE_C_opSCq,
+      OP_SAFE_C_opCSq, HOP_SAFE_C_opCSq, OP_SAFE_C_S_opSq, HOP_SAFE_C_S_opSq,
+      OP_SAFE_C_C_opSCq, HOP_SAFE_C_C_opSCq, OP_SAFE_C_S_opSCq, HOP_SAFE_C_S_opSCq, OP_SAFE_C_S_opCSq, HOP_SAFE_C_S_opCSq,
+      OP_SAFE_C_opSq_S, HOP_SAFE_C_opSq_S, OP_SAFE_C_opSq_C, HOP_SAFE_C_opSq_C,
+      OP_SAFE_C_opSq_opSq, HOP_SAFE_C_opSq_opSq, OP_SAFE_C_S_opSSq, HOP_SAFE_C_S_opSSq, OP_SAFE_C_C_opSq, HOP_SAFE_C_C_opSq,
+      OP_SAFE_C_opCSq_C, HOP_SAFE_C_opCSq_C, OP_SAFE_C_opSSq_C, HOP_SAFE_C_opSSq_C, OP_SAFE_C_C_opSSq, HOP_SAFE_C_C_opSSq,
+      OP_SAFE_C_opSSq_opSSq, HOP_SAFE_C_opSSq_opSSq, OP_SAFE_C_opSSq_opSq, HOP_SAFE_C_opSSq_opSq, OP_SAFE_C_opSq_opSSq, HOP_SAFE_C_opSq_opSSq,
+      OP_SAFE_C_opSSq_S, HOP_SAFE_C_opSSq_S, OP_SAFE_C_opCSq_S, HOP_SAFE_C_opCSq_S, OP_SAFE_C_opSCq_C, HOP_SAFE_C_opSCq_C,
+      OP_SAFE_C_op_opSSqq_S, HOP_SAFE_C_op_opSSqq_S, OP_SAFE_C_op_opSqq, HOP_SAFE_C_op_opSqq,
+      OP_SAFE_C_op_S_opSqq, HOP_SAFE_C_op_S_opSqq, OP_SAFE_C_op_opSq_Sq, HOP_SAFE_C_op_opSq_Sq, OP_SAFE_C_opSq_CS, HOP_SAFE_C_opSq_CS,
+
+      OP_SAFE_C_A, HOP_SAFE_C_A, OP_SAFE_C_AA, HOP_SAFE_C_AA, OP_SAFE_C_SA, HOP_SAFE_C_SA, OP_SAFE_C_AS, HOP_SAFE_C_AS,
+      OP_SAFE_C_CA, HOP_SAFE_C_CA, OP_SAFE_C_AC, HOP_SAFE_C_AC, OP_SAFE_C_AAA, HOP_SAFE_C_AAA, OP_SAFE_C_4A, HOP_SAFE_C_4A,
+      OP_SAFE_C_NA, HOP_SAFE_C_NA, OP_SAFE_C_ALL_CA, HOP_SAFE_C_ALL_CA,
+      OP_SAFE_C_SSA, HOP_SAFE_C_SSA, OP_SAFE_C_SAS, HOP_SAFE_C_SAS, OP_SAFE_C_SAA, HOP_SAFE_C_SAA,
+      OP_SAFE_C_CSA, HOP_SAFE_C_CSA, OP_SAFE_C_SCA, HOP_SAFE_C_SCA, OP_SAFE_C_ASS, HOP_SAFE_C_ASS,
+      OP_SAFE_C_CAC, HOP_SAFE_C_CAC, OP_SAFE_C_AGG, HOP_SAFE_C_AGG,
+      OP_SAFE_C_opAq, HOP_SAFE_C_opAq, OP_SAFE_C_opAAq, HOP_SAFE_C_opAAq, OP_SAFE_C_opAAAq, HOP_SAFE_C_opAAAq,
+      OP_SAFE_C_S_opAq, HOP_SAFE_C_S_opAq, OP_SAFE_C_opAq_S, HOP_SAFE_C_opAq_S, OP_SAFE_C_S_opAAq, HOP_SAFE_C_S_opAAq,
+      OP_SAFE_C_STAR, HOP_SAFE_C_STAR, OP_SAFE_C_STAR_A, HOP_SAFE_C_STAR_A,
+      OP_SAFE_C_STAR_AA, HOP_SAFE_C_STAR_AA, OP_SAFE_C_STAR_NA, HOP_SAFE_C_STAR_NA,
+
+      OP_SAFE_C_P, HOP_SAFE_C_P, OP_SAFE_C_PP, HOP_SAFE_C_PP, OP_SAFE_C_FF, HOP_SAFE_C_FF, OP_SAFE_C_SP, HOP_SAFE_C_SP,
+      OP_SAFE_C_CP, HOP_SAFE_C_CP, OP_SAFE_C_AP, HOP_SAFE_C_AP, OP_SAFE_C_PA, HOP_SAFE_C_PA, OP_SAFE_C_PS, HOP_SAFE_C_PS,
+      OP_SAFE_C_PC, HOP_SAFE_C_PC, OP_SAFE_C_SSP, HOP_SAFE_C_SSP, OP_ANY_C_NP, HOP_ANY_C_NP, OP_SAFE_C_3P, HOP_SAFE_C_3P,
+
+      OP_THUNK, HOP_THUNK, OP_THUNK_O, HOP_THUNK_O, OP_THUNK_ANY, HOP_THUNK_ANY,
+      OP_SAFE_THUNK, HOP_SAFE_THUNK, OP_SAFE_THUNK_A, HOP_SAFE_THUNK_A, OP_SAFE_THUNK_ANY, HOP_SAFE_THUNK_ANY,
+
+      OP_CLOSURE_S, HOP_CLOSURE_S, OP_CLOSURE_S_O, HOP_CLOSURE_S_O,
+      OP_CLOSURE_A, HOP_CLOSURE_A, OP_CLOSURE_A_O, HOP_CLOSURE_A_O, OP_CLOSURE_P, HOP_CLOSURE_P,
+      OP_CLOSURE_AP, HOP_CLOSURE_AP, OP_CLOSURE_PA, HOP_CLOSURE_PA, OP_CLOSURE_PP, HOP_CLOSURE_PP,
+      OP_CLOSURE_FA, HOP_CLOSURE_FA, OP_CLOSURE_SS, HOP_CLOSURE_SS, OP_CLOSURE_SS_O, HOP_CLOSURE_SS_O,
+      OP_CLOSURE_SC, HOP_CLOSURE_SC, OP_CLOSURE_SC_O, HOP_CLOSURE_SC_O,
+      OP_CLOSURE_3S, HOP_CLOSURE_3S, OP_CLOSURE_3S_O, HOP_CLOSURE_3S_O, OP_CLOSURE_4S, HOP_CLOSURE_4S, OP_CLOSURE_4S_O, HOP_CLOSURE_4S_O, OP_CLOSURE_5S, HOP_CLOSURE_5S,
+      OP_CLOSURE_AA, HOP_CLOSURE_AA, OP_CLOSURE_AA_O, HOP_CLOSURE_AA_O, OP_CLOSURE_3A, HOP_CLOSURE_3A, OP_CLOSURE_4A, HOP_CLOSURE_4A,
+      OP_CLOSURE_NA, HOP_CLOSURE_NA, OP_CLOSURE_ASS, HOP_CLOSURE_ASS, OP_CLOSURE_SAS, HOP_CLOSURE_SAS ,OP_CLOSURE_AAS, HOP_CLOSURE_AAS,
+      OP_CLOSURE_SAA, HOP_CLOSURE_SAA, OP_CLOSURE_ASA, HOP_CLOSURE_ASA, OP_CLOSURE_NS, HOP_CLOSURE_NS,
+
+      OP_SAFE_CLOSURE_S, HOP_SAFE_CLOSURE_S, OP_SAFE_CLOSURE_S_O, HOP_SAFE_CLOSURE_S_O,
+      OP_SAFE_CLOSURE_S_A, HOP_SAFE_CLOSURE_S_A, OP_SAFE_CLOSURE_S_TO_S, HOP_SAFE_CLOSURE_S_TO_S, OP_SAFE_CLOSURE_S_TO_SC, HOP_SAFE_CLOSURE_S_TO_SC,
+      OP_SAFE_CLOSURE_P, HOP_SAFE_CLOSURE_P, OP_SAFE_CLOSURE_P_A, HOP_SAFE_CLOSURE_P_A,
+      OP_SAFE_CLOSURE_AP, HOP_SAFE_CLOSURE_AP, OP_SAFE_CLOSURE_PA, HOP_SAFE_CLOSURE_PA, OP_SAFE_CLOSURE_PP, HOP_SAFE_CLOSURE_PP,
+      OP_SAFE_CLOSURE_A, HOP_SAFE_CLOSURE_A, OP_SAFE_CLOSURE_A_O, HOP_SAFE_CLOSURE_A_O, OP_SAFE_CLOSURE_A_A, HOP_SAFE_CLOSURE_A_A,
+      OP_SAFE_CLOSURE_A_TO_SC, HOP_SAFE_CLOSURE_A_TO_SC,
+      OP_SAFE_CLOSURE_SS, HOP_SAFE_CLOSURE_SS, OP_SAFE_CLOSURE_SS_O, HOP_SAFE_CLOSURE_SS_O, OP_SAFE_CLOSURE_SS_A, HOP_SAFE_CLOSURE_SS_A,
+      OP_SAFE_CLOSURE_SC, HOP_SAFE_CLOSURE_SC, OP_SAFE_CLOSURE_SC_O, HOP_SAFE_CLOSURE_SC_O,
+      OP_SAFE_CLOSURE_AA, HOP_SAFE_CLOSURE_AA, OP_SAFE_CLOSURE_AA_O, HOP_SAFE_CLOSURE_AA_O, OP_SAFE_CLOSURE_AA_A, HOP_SAFE_CLOSURE_AA_A,
+      OP_SAFE_CLOSURE_SAA, HOP_SAFE_CLOSURE_SAA, OP_SAFE_CLOSURE_SSA, HOP_SAFE_CLOSURE_SSA,
+      OP_SAFE_CLOSURE_AGG, HOP_SAFE_CLOSURE_AGG, OP_SAFE_CLOSURE_3A, HOP_SAFE_CLOSURE_3A, OP_SAFE_CLOSURE_NA, HOP_SAFE_CLOSURE_NA,
+      OP_SAFE_CLOSURE_3S, HOP_SAFE_CLOSURE_3S, OP_SAFE_CLOSURE_NS, HOP_SAFE_CLOSURE_NS, /* safe_closure_4s gained very little */
+      OP_SAFE_CLOSURE_3S_A, HOP_SAFE_CLOSURE_3S_A,
+      /* ssa|saa|ns|na|3s|agg|3a|sc|ap|pa|pp_a ? thunk_o? op_closure_ns?  */
+
+      OP_ANY_CLOSURE_3P, HOP_ANY_CLOSURE_3P, OP_ANY_CLOSURE_4P, HOP_ANY_CLOSURE_4P, OP_ANY_CLOSURE_NP, HOP_ANY_CLOSURE_NP,
+      OP_ANY_CLOSURE_SYM, HOP_ANY_CLOSURE_SYM, OP_ANY_CLOSURE_A_SYM, HOP_ANY_CLOSURE_A_SYM,
+
+      OP_CLOSURE_STAR_A, HOP_CLOSURE_STAR_A, OP_CLOSURE_STAR_NA, HOP_CLOSURE_STAR_NA,
+      OP_SAFE_CLOSURE_STAR_A, HOP_SAFE_CLOSURE_STAR_A, OP_SAFE_CLOSURE_STAR_AA, HOP_SAFE_CLOSURE_STAR_AA,
+      OP_SAFE_CLOSURE_STAR_AA_O, HOP_SAFE_CLOSURE_STAR_AA_O, OP_SAFE_CLOSURE_STAR_A1, HOP_SAFE_CLOSURE_STAR_A1,
+      OP_SAFE_CLOSURE_STAR_KA, HOP_SAFE_CLOSURE_STAR_KA, OP_CLOSURE_STAR_KA, HOP_CLOSURE_STAR_KA, OP_SAFE_CLOSURE_STAR_3A, HOP_SAFE_CLOSURE_STAR_3A,
+      OP_SAFE_CLOSURE_STAR_NA, HOP_SAFE_CLOSURE_STAR_NA, OP_SAFE_CLOSURE_STAR_NA_0, HOP_SAFE_CLOSURE_STAR_NA_0,
+      OP_SAFE_CLOSURE_STAR_NA_1, HOP_SAFE_CLOSURE_STAR_NA_1, OP_SAFE_CLOSURE_STAR_NA_2, HOP_SAFE_CLOSURE_STAR_NA_2,
+
+      OP_C_SS, HOP_C_SS, OP_C_S, HOP_C_S, OP_C_SC, HOP_C_SC, OP_READ_S, HOP_READ_S, OP_C_P, HOP_C_P, OP_C_AP, HOP_C_AP,
+      OP_C_A, HOP_C_A, OP_C_AA, HOP_C_AA, OP_C, HOP_C, OP_C_NC, HOP_C_NC, OP_C_NA, HOP_C_NA,
+
+      OP_CL_S, HOP_CL_S, OP_CL_SS, HOP_CL_SS, OP_CL_A, HOP_CL_A, OP_CL_AA, HOP_CL_AA,
+      OP_CL_NA, HOP_CL_NA, OP_CL_FA, HOP_CL_FA, OP_CL_SAS, HOP_CL_SAS,
+      /* end of h_opts */
+
+      OP_APPLY_SS, OP_APPLY_SA, OP_APPLY_SL, OP_MACRO_D, OP_MACRO_STAR_D,
+      OP_WITH_IO, OP_WITH_IO_1, OP_WITH_OUTPUT_TO_STRING, OP_WITH_IO_C, OP_CALL_WITH_OUTPUT_STRING,
+      OP_S, OP_S_G, OP_S_A, OP_S_AA, OP_A_A, OP_A_AA, OP_A_SC, OP_P_S, OP_P_S_1, OP_MAP_FOR_EACH_FA, OP_MAP_FOR_EACH_FAA,
+      OP_F, OP_F_A, OP_F_AA, OP_F_NP, OP_F_NP_1,
+
+      OP_IMPLICIT_GOTO, OP_IMPLICIT_GOTO_A, OP_IMPLICIT_CONTINUATION_A, OP_IMPLICIT_ITERATE,
+      OP_IMPLICIT_VECTOR_REF_A, OP_IMPLICIT_VECTOR_REF_AA, OP_IMPLICIT_VECTOR_SET_3, OP_IMPLICIT_VECTOR_SET_4,
+      OP_IMPLICIT_STRING_REF_A, OP_IMPLICIT_C_OBJECT_REF_A, OP_IMPLICIT_PAIR_REF_A, OP_IMPLICIT_PAIR_REF_AA,
+      OP_IMPLICIT_HASH_TABLE_REF_A, OP_IMPLICIT_HASH_TABLE_REF_AA,
+      OP_IMPLICIT_LET_REF_C, OP_IMPLICIT_LET_REF_A, OP_IMPLICIT_S7_STARLET_REF_S, OP_IMPLICIT_S7_STARLET_SET,
+      OP_UNKNOWN, OP_UNKNOWN_NS, OP_UNKNOWN_NA, OP_UNKNOWN_S, OP_UNKNOWN_GG, OP_UNKNOWN_A, OP_UNKNOWN_AA, OP_UNKNOWN_NP,
+
+      OP_SYMBOL, OP_CONSTANT, OP_PAIR_SYM, OP_PAIR_PAIR, OP_PAIR_ANY, HOP_HASH_TABLE_INCREMENT, OP_CLEAR_OPTS,
+
+      OP_READ_INTERNAL, OP_EVAL, OP_EVAL_ARGS, OP_EVAL_ARGS1, OP_EVAL_ARGS2, OP_EVAL_ARGS3, OP_EVAL_ARGS4, OP_EVAL_ARGS5,
+      OP_EVAL_SET1_NO_MV, OP_EVAL_SET2, OP_EVAL_SET2_MV, OP_EVAL_SET2_NO_MV, OP_EVAL_SET3, OP_EVAL_SET3_MV, OP_EVAL_SET3_NO_MV,
+      OP_APPLY, OP_EVAL_MACRO, OP_LAMBDA, OP_QUOTE, OP_QUOTE_UNCHECKED, OP_MACROEXPAND, OP_CALL_CC, OP_CALL_WITH_EXIT, OP_CALL_WITH_EXIT_O,
+      OP_C_CATCH, OP_C_CATCH_ALL, OP_C_CATCH_ALL_O, OP_C_CATCH_ALL_A,
+
+      OP_DEFINE, OP_DEFINE1, OP_BEGIN, OP_BEGIN_HOOK, OP_BEGIN_NO_HOOK, OP_BEGIN_UNCHECKED, OP_BEGIN_2_UNCHECKED, OP_BEGIN_NA, OP_BEGIN_AA,
+      OP_IF, OP_IF1, OP_WHEN, OP_UNLESS, OP_SET, OP_SET1, OP_SET2,
+      OP_LET, OP_LET1, OP_LET_STAR, OP_LET_STAR1, OP_LET_STAR2, OP_LET_STAR_SHADOWED,
+      OP_LETREC, OP_LETREC1, OP_LETREC_STAR, OP_LETREC_STAR1,
+      OP_LET_TEMPORARILY, OP_LET_TEMP_UNCHECKED, OP_LET_TEMP_INIT1, OP_LET_TEMP_INIT2, OP_LET_TEMP_DONE, OP_LET_TEMP_DONE1,
+      OP_LET_TEMP_S7, OP_LET_TEMP_NA, OP_LET_TEMP_A, OP_LET_TEMP_SETTER, OP_LET_TEMP_UNWIND, OP_LET_TEMP_S7_UNWIND, OP_LET_TEMP_SETTER_UNWIND,
+      OP_LET_TEMP_A_A, OP_LET_TEMP_S7_DIRECT, OP_LET_TEMP_S7_DIRECT_UNWIND,
+      OP_COND, OP_COND1, OP_FEED_TO_1, OP_COND_SIMPLE, OP_COND1_SIMPLE, OP_COND_SIMPLE_O, OP_COND1_SIMPLE_O,
+      OP_AND, OP_OR,
+      OP_DEFINE_MACRO, OP_DEFINE_MACRO_STAR, OP_DEFINE_EXPANSION, OP_DEFINE_EXPANSION_STAR, OP_MACRO, OP_MACRO_STAR,
+      OP_CASE,
+      OP_READ_LIST, OP_READ_NEXT, OP_READ_DOT, OP_READ_QUOTE,
+      OP_READ_QUASIQUOTE, OP_READ_UNQUOTE, OP_READ_APPLY_VALUES,
+      OP_READ_VECTOR, OP_READ_BYTE_VECTOR, OP_READ_INT_VECTOR, OP_READ_FLOAT_VECTOR, OP_READ_DONE,
+      OP_LOAD_RETURN_IF_EOF, OP_LOAD_CLOSE_AND_POP_IF_EOF, OP_EVAL_DONE, OP_SPLICE_VALUES, OP_NO_VALUES,
+      OP_CATCH, OP_DYNAMIC_WIND, OP_DYNAMIC_UNWIND, OP_DYNAMIC_UNWIND_PROFILE, OP_PROFILE_IN,
+      OP_DEFINE_CONSTANT, OP_DEFINE_CONSTANT1,
+      OP_DO, OP_DO_END, OP_DO_END1, OP_DO_STEP, OP_DO_STEP2, OP_DO_INIT,
+      OP_DEFINE_STAR, OP_LAMBDA_STAR, OP_LAMBDA_STAR_DEFAULT, OP_ERROR_QUIT, OP_UNWIND_INPUT, OP_UNWIND_OUTPUT, OP_ERROR_HOOK_QUIT,
+      OP_WITH_LET, OP_WITH_LET1, OP_WITH_LET_UNCHECKED, OP_WITH_LET_S,
+      OP_WITH_BAFFLE, OP_WITH_BAFFLE_UNCHECKED, OP_EXPANSION,
+      OP_FOR_EACH, OP_FOR_EACH_1, OP_FOR_EACH_2, OP_FOR_EACH_3,
+      OP_MAP, OP_MAP_1, OP_MAP_2, OP_MAP_GATHER, OP_MAP_GATHER_1, OP_MAP_GATHER_2, OP_MAP_GATHER_3, OP_MAP_UNWIND,
+      OP_BARRIER, OP_DEACTIVATE_GOTO,
+      OP_DEFINE_BACRO, OP_DEFINE_BACRO_STAR, OP_BACRO, OP_BACRO_STAR,
+      OP_GET_OUTPUT_STRING,
+      OP_SORT, OP_SORT1, OP_SORT2, OP_SORT3, OP_SORT_PAIR_END, OP_SORT_VECTOR_END, OP_SORT_STRING_END,
+      OP_EVAL_STRING,
+      OP_MEMBER_IF, OP_ASSOC_IF, OP_MEMBER_IF1, OP_ASSOC_IF1,
+      OP_LAMBDA_UNCHECKED, OP_LET_UNCHECKED, OP_CATCH_1, OP_CATCH_2, OP_CATCH_ALL,
+
+      OP_SET_UNCHECKED, OP_SET_S_C, OP_SET_S_S, OP_SET_S_P, OP_SET_S_A,
+      OP_SET_NORMAL, OP_SET_opSq_A, OP_SET_opSAq_A, OP_SET_opSAq_P, OP_SET_opSAq_P_1, OP_SET_opSAAq_A, OP_SET_opSAAq_P, OP_SET_opSAAq_P_1,
+      OP_SET_FROM_SETTER, OP_SET_FROM_LET_TEMP, OP_SET_SAFE,
+      OP_INCREMENT_BY_1, OP_DECREMENT_BY_1, OP_INCREMENT_SA, OP_INCREMENT_SAA, OP_SET_CONS,
+
+      OP_LETREC_UNCHECKED, OP_LETREC_STAR_UNCHECKED, OP_COND_UNCHECKED,
+      OP_LAMBDA_STAR_UNCHECKED, OP_DO_UNCHECKED, OP_DEFINE_UNCHECKED, OP_DEFINE_STAR_UNCHECKED, OP_DEFINE_FUNCHECKED, OP_DEFINE_CONSTANT_UNCHECKED,
+      OP_DEFINE_WITH_SETTER,
+
+      OP_LET_NO_VARS, OP_NAMED_LET, OP_NAMED_LET_NO_VARS, OP_NAMED_LET_A, OP_NAMED_LET_AA, OP_NAMED_LET_NA, OP_NAMED_LET_STAR,
+      OP_LET_NA_OLD, OP_LET_NA_NEW, OP_LET_2A_OLD, OP_LET_2A_NEW, OP_LET_3A_OLD, OP_LET_3A_NEW,
+      OP_LET_opaSSq_OLD, OP_LET_opaSSq_NEW, OP_LET_ONE_OLD, OP_LET_ONE_NEW, OP_LET_ONE_P_OLD, OP_LET_ONE_P_NEW,
+      OP_LET_ONE_OLD_1, OP_LET_ONE_NEW_1, OP_LET_ONE_P_OLD_1, OP_LET_ONE_P_NEW_1,
+      OP_LET_A_OLD, OP_LET_A_NEW, OP_LET_A_P_OLD, OP_LET_A_P_NEW,
+      OP_LET_A_A_OLD, OP_LET_A_A_NEW, OP_LET_A_NA_OLD, OP_LET_A_NA_NEW, OP_LET_A_OLD_2, OP_LET_A_NEW_2,
+      OP_LET_STAR_NA, OP_LET_STAR_NA_A,
+
+      OP_CASE_A_E_S, OP_CASE_A_I_S, OP_CASE_A_G_S, OP_CASE_A_E_G, OP_CASE_A_G_G, OP_CASE_A_S_G,
+      OP_CASE_P_E_S, OP_CASE_P_I_S, OP_CASE_P_G_S, OP_CASE_P_E_G, OP_CASE_P_G_G,
+      OP_CASE_E_S, OP_CASE_I_S, OP_CASE_G_S, OP_CASE_E_G, OP_CASE_G_G,
+      OP_CASE_A_I_S_A, OP_CASE_A_E_S_A, OP_CASE_A_G_S_A, OP_CASE_A_S_G_A,
+
+      OP_IF_UNCHECKED, OP_AND_P, OP_AND_P1, OP_AND_AP, OP_AND_PAIR_P,
+      OP_AND_SAFE_P1, OP_AND_SAFE_P2, OP_AND_SAFE_P3, OP_AND_SAFE_P_REST, OP_AND_2A, OP_AND_3A, OP_AND_N, OP_AND_S_2,
+      OP_OR_P, OP_OR_P1, OP_OR_AP, OP_OR_2A, OP_OR_3A, OP_OR_N, OP_OR_S_2, OP_OR_S_TYPE_2,
+      OP_WHEN_S, OP_WHEN_A, OP_WHEN_P, OP_WHEN_AND_AP, OP_WHEN_AND_2A, OP_WHEN_AND_3A, OP_UNLESS_S, OP_UNLESS_A, OP_UNLESS_P,
+
+      OP_IF_A_C_C, OP_IF_A_A, OP_IF_A_A_A, OP_IF_S_A_A, OP_IF_AND2_S_A, OP_IF_NOT_A_A, OP_IF_NOT_A_A_A,
+      OP_IF_B_A, OP_IF_B_P, OP_IF_B_R, OP_IF_B_A_P, OP_IF_B_P_A, OP_IF_B_P_P, OP_IF_B_N_N,
+      OP_IF_A_A_P, OP_IF_A_P_A, OP_IF_S_P_A, OP_IF_S_A_P, OP_IF_S_P, OP_IF_S_P_P, OP_IF_S_R, OP_IF_S_N, OP_IF_S_N_N,
+      OP_IF_opSq_P, OP_IF_opSq_P_P, OP_IF_opSq_R, OP_IF_opSq_N, OP_IF_opSq_N_N,
+      OP_IF_IS_TYPE_S_P, OP_IF_IS_TYPE_S_P_P, OP_IF_IS_TYPE_S_R, OP_IF_IS_TYPE_S_N, OP_IF_IS_TYPE_S_N_N, OP_IF_IS_TYPE_S_P_A, OP_IF_IS_TYPE_S_A_A, OP_IF_IS_TYPE_S_A_P,
+      OP_IF_A_P, OP_IF_A_P_P, OP_IF_A_R, OP_IF_A_N, OP_IF_A_N_N,
+      OP_IF_AND2_P, OP_IF_AND2_P_P, OP_IF_AND2_R, OP_IF_AND2_N, OP_IF_AND2_N_N,
+      OP_IF_AND3_P, OP_IF_AND3_P_P, OP_IF_AND3_R, OP_IF_AND3_N, OP_IF_AND3_N_N,  /* or3 got few hits */
+      OP_IF_P_P, OP_IF_P_P_P, OP_IF_P_R, OP_IF_P_N, OP_IF_P_N_N,
+      OP_IF_ANDP_P, OP_IF_ANDP_P_P, OP_IF_ANDP_R, OP_IF_ANDP_N, OP_IF_ANDP_N_N,
+      OP_IF_ORP_P, OP_IF_ORP_P_P, OP_IF_ORP_R, OP_IF_ORP_N, OP_IF_ORP_N_N,
+      OP_IF_OR2_P, OP_IF_OR2_P_P, OP_IF_OR2_R, OP_IF_OR2_N, OP_IF_OR2_N_N,
+      OP_IF_PP, OP_IF_PPP, OP_IF_PN, OP_IF_PR, OP_IF_PRR, OP_WHEN_PP, OP_UNLESS_PP,
+
+      OP_COND_NA_NA, OP_COND_NA_NP, OP_COND_NA_NP_1, OP_COND_NA_2E, OP_COND_NA_3E, OP_COND_NA_NP_O,
+      OP_COND_FEED, OP_COND_FEED_1,
+
+      OP_SIMPLE_DO, OP_SIMPLE_DO_STEP, OP_SAFE_DOTIMES, OP_SAFE_DOTIMES_STEP, OP_SAFE_DOTIMES_STEP_O,
+      OP_SAFE_DO, OP_SAFE_DO_STEP, OP_DOX, OP_DOX_STEP, OP_DOX_STEP_O, OP_DOX_NO_BODY, OP_DOX_PENDING_NO_BODY, OP_DOX_INIT,
+      OP_DOTIMES_P, OP_DOTIMES_STEP_O,
+      OP_DO_NO_VARS, OP_DO_NO_VARS_NO_OPT, OP_DO_NO_VARS_NO_OPT_1,
+      OP_DO_NO_BODY_NA_VARS, OP_DO_NO_BODY_NA_VARS_STEP, OP_DO_NO_BODY_NA_VARS_STEP_1,
+
+      OP_SAFE_C_P_1, OP_SAFE_C_PP_1, OP_SAFE_C_PP_3_MV, OP_SAFE_C_PP_5,
+      OP_SAFE_C_3P_1, OP_SAFE_C_3P_2, OP_SAFE_C_3P_3, OP_SAFE_C_3P_1_MV, OP_SAFE_C_3P_2_MV, OP_SAFE_C_3P_3_MV,
+      OP_SAFE_C_SP_1, OP_SAFE_CONS_SP_1, OP_SAFE_ADD_SP_1, OP_SAFE_MULTIPLY_SP_1, OP_SAFE_C_PS_1, OP_SAFE_C_PC_1,
+      OP_EVAL_MACRO_MV, OP_MACROEXPAND_1, OP_APPLY_LAMBDA,
+      OP_ANY_C_NP_1, OP_ANY_C_NP_MV, OP_SAFE_C_SSP_1, OP_C_P_1, OP_C_AP_1, OP_ANY_C_NP_2, OP_SAFE_C_PA_1,
+      OP_SET_WITH_LET_1, OP_SET_WITH_LET_2,
+
+      OP_CLOSURE_AP_1, OP_CLOSURE_PA_1, OP_CLOSURE_PP_1, OP_CLOSURE_P_1,
+      OP_SAFE_CLOSURE_P_1, OP_SAFE_CLOSURE_P_A_1, OP_SAFE_CLOSURE_AP_1, OP_SAFE_CLOSURE_PA_1, OP_SAFE_CLOSURE_PP_1,
+      OP_ANY_CLOSURE_3P_1, OP_ANY_CLOSURE_3P_2, OP_ANY_CLOSURE_3P_3, OP_ANY_CLOSURE_NP_1,
+      OP_ANY_CLOSURE_4P_1, OP_ANY_CLOSURE_4P_2, OP_ANY_CLOSURE_4P_3, OP_ANY_CLOSURE_4P_4, OP_ANY_CLOSURE_NP_2,
+
+      OP_TC_AND_A_OR_A_LA, OP_TC_OR_A_AND_A_LA, OP_TC_AND_A_OR_A_LAA, OP_TC_OR_A_AND_A_LAA, OP_TC_AND_A_OR_A_L3A, OP_TC_OR_A_AND_A_L3A,
+      OP_TC_OR_A_A_AND_A_A_LA, OP_TC_OR_A_AND_A_A_L3A, OP_TC_AND_A_OR_A_A_LA, OP_TC_OR_A_AND_A_A_LA,
+      OP_TC_WHEN_LA, OP_TC_WHEN_LAA, OP_TC_WHEN_L3A, OP_TC_LET_WHEN_LAA, OP_TC_LET_UNLESS_LAA,
+      OP_TC_COND_A_Z_A_Z_LAA, OP_TC_COND_A_Z_A_LAA_Z, OP_TC_COND_A_Z_A_LAA_LAA, OP_TC_LET_COND,
+      OP_TC_IF_A_Z_LA, OP_TC_IF_A_Z_LAA, OP_TC_IF_A_Z_L3A, OP_TC_IF_A_L3A_Z, OP_TC_IF_A_LA_Z, OP_TC_IF_A_LAA_Z,
+      OP_TC_IF_A_Z_IF_A_Z_LA, OP_TC_IF_A_Z_IF_A_LA_Z, OP_TC_IF_A_Z_IF_A_Z_LAA, OP_TC_IF_A_Z_IF_A_LAA_Z, OP_TC_IF_A_Z_IF_A_L3A_L3A,
+      OP_TC_COND_A_Z_A_Z_LA, OP_TC_COND_A_Z_A_LA_Z, OP_TC_COND_A_Z_LA, OP_TC_COND_A_LA_Z, OP_TC_COND_A_Z_LAA, OP_TC_COND_A_LAA_Z,
+      OP_TC_LET_IF_A_Z_LA, OP_TC_LET_IF_A_Z_LAA, OP_TC_IF_A_Z_LET_IF_A_Z_LAA,
+      OP_TC_CASE_LA, OP_TC_AND_A_IF_A_Z_LA, OP_TC_AND_A_IF_A_LA_Z,
+
+      OP_RECUR_IF_A_A_opA_LAq, OP_RECUR_IF_A_opA_LAq_A, OP_RECUR_IF_A_A_opLA_Aq, OP_RECUR_IF_A_opLA_Aq_A,
+      OP_RECUR_IF_A_A_opLA_LAq, OP_RECUR_IF_A_opLA_LAq_A,
+      OP_RECUR_IF_A_A_opA_LA_LAq, OP_RECUR_IF_A_opA_LA_LAq_A,
+      OP_RECUR_IF_A_A_opLA_LA_LAq, OP_RECUR_IF_A_A_IF_A_A_opLA_LAq, OP_RECUR_IF_A_A_IF_A_A_opLAA_LAAq,
+      OP_RECUR_IF_A_A_opA_LAAq, OP_RECUR_IF_A_opA_LAAq_A, OP_RECUR_IF_A_A_opA_L3Aq,
+      OP_RECUR_IF_A_A_LopL3A_L3A_L3Aq, OP_RECUR_IF_A_A_AND_A_LAA_LAA,
+      OP_RECUR_IF_A_A_IF_A_LAA_opA_LAAq, /* same as cond case below */
+      OP_RECUR_COND_A_A_opA_LAq, OP_RECUR_COND_A_A_opA_LAAq,
+      OP_RECUR_COND_A_A_A_A_opLA_LAq, OP_RECUR_COND_A_A_A_A_opLAA_LAAq, OP_RECUR_COND_A_A_A_A_opA_LAAq,
+      OP_RECUR_COND_A_A_A_LAA_LopA_LAAq, OP_RECUR_COND_A_A_A_LAA_opA_LAAq,
+      OP_RECUR_AND_A_OR_A_LAA_LAA,
+
+      NUM_OPS};
+
+#define is_tc_op(Op) ((Op >= OP_TC_AND_A_OR_A_LA) && (Op <= OP_TC_CASE_LA))
+
+typedef enum{E_C_P, E_C_PP, E_C_CP, E_C_SP, E_C_PC, E_C_PS} combine_op_t;
+
+static const char* op_names[NUM_OPS] =
+     {
+      "unopt", "gc_protect",
+
+      "safe_c_nc", "h_safe_c_nc", "safe_c_s", "h_safe_c_s",
+      "safe_c_ss", "h_safe_c_ss", "safe_c_sc", "h_safe_c_sc", "safe_c_cs", "h_safe_c_cs", "safe_c_cq", "h_safe_c_cq",
+      "safe_c_sss", "h_safe_c_sss", "safe_c_scs", "h_safe_c_scs", "safe_c_ssc", "h_safe_c_ssc", "safe_c_css", "h_safe_c_css",
+      "safe_c_scc", "h_safe_c_scc", "safe_c_csc", "h_safe_c_csc", "safe_c_ccs", "h_safe_c_ccs",
+      "safe_c_ns", "h_safe_c_ns", "safe_c_opncq", "h_safe_c_opncq", "safe_c_opsq", "h_safe_c_opsq",
+      "safe_c_opssq", "h_safe_c_opssq", "safe_c_opscq", "h_safe_c_opscq",
+      "safe_c_opcsq", "h_safe_c_opcsq", "safe_c_s_opsq", "h_safe_c_s_opsq",
+      "safe_c_c_opscq", "h_safe_c_c_opscq", "safe_c_s_opscq", "h_safe_c_s_opscq", "safe_c_s_opcsq", "h_safe_c_s_opcsq",
+      "safe_c_opsq_s", "h_safe_c_opsq_s", "safe_c_opsq_c", "h_safe_c_opsq_c",
+      "safe_c_opsq_opsq", "h_safe_c_opsq_opsq", "safe_c_s_opssq", "h_safe_c_s_opssq", "safe_c_c_opsq", "h_safe_c_c_opsq",
+      "safe_c_opcsq_c", "h_safe_c_opcsq_c", "safe_c_opssq_c", "h_safe_c_opssq_c", "safe_c_c_opssq", "h_safe_c_c_opssq",
+      "safe_c_opssq_opssq", "h_safe_c_opssq_opssq", "safe_c_opssq_opsq", "h_safe_c_opssq_opsq", "safe_c_opsq_opssq", "h_safe_c_opsq_opssq",
+      "safe_c_opssq_s", "h_safe_c_opssq_s", "safe_c_opcsq_s", "h_safe_c_opcsq_s", "safe_c_opscq_c", "h_safe_c_opscq_c",
+      "safe_c_op_opssqq_s", "h_safe_c_op_opssqq_s", "safe_c_op_opsqq", "h_safe_c_op_opsqq",
+      "safe_c_op_s_opsqq", "h_safe_c_op_s_opsqq", "safe_c_op_opsq_sq", "h_safe_c_op_opsq_sq", "safe_c_opsq_cs", "h_safe_c_opsq_cs",
+
+      "safe_c_a", "h_safe_c_a", "safe_c_aa", "h_safe_c_aa", "safe_c_sa", "h_safe_c_sa", "safe_c_as", "h_safe_c_as",
+      "safe_c_ca", "h_safe_c_ca", "safe_c_ac", "h_safe_c_ac", "safe_c_aaa", "h_safe_c_aaa", "safe_c_4a", "h_safe_c_4a",
+      "safe_c_na", "h_safe_c_na", "safe_c_all_ca", "h_safe_c_all_ca",
+      "safe_c_ssa", "h_safe_c_ssa", "safe_c_sas", "h_safe_c_sas", "safe_c_saa", "h_safe_c_saa",
+      "safe_c_csa", "h_safe_c_csa", "safe_c_sca", "h_safe_c_sca", "safe_c_ass", "h_safe_c_ass",
+      "safe_c_cac", "h_safe_c_cac", "safe_c_agg", "h_safe_c_agg",
+      "safe_c_opaq", "h_safe_c_opaq", "safe_c_opaaq", "h_safe_c_opaaq", "safe_c_opaaaq", "h_safe_c_opaaaq",
+      "safe_c_s_opaq", "h_safe_c_s_opaq", "safe_c_opaq_s", "h_safe_c_opaq_s", "safe_c_s_opaaq", "h_safe_c_s_opaaq",
+      "safe_c*", "h_safe_c*", "safe_c*_a", "h_safe_c*_a", "safe_c*_aa", "h_safe_c*_aa", "safe_c*_na", "h_safe_c*_na",
+
+      "safe_c_p", "h_safe_c_p", "safe_c_pp", "h_safe_c_pp", "safe_c_ff", "h_safe_c_ff", "safe_c_sp", "h_safe_c_sp",
+      "safe_c_cp", "h_safe_c_cp", "safe_c_ap", "h_safe_c_ap", "safe_c_pa", "h_safe_c_pa", "safe_c_ps", "h_safe_c_ps",
+      "safe_c_pc", "h_safe_c_pc", "safe_c_ssp", "h_safe_c_ssp", "any_c_np", "h_any_c_np", "safe_c_3p", "h_safe_c_3p",
+
+      "thunk", "h_thunk", "thunk_o", "h_thunk_o", "thunk_any", "h_thunk_any",
+      "safe_thunk", "h_safe_thunk", "safe_thunk_a", "h_safe_thunk_a", "safe_thunk_any", "h_safe_thunk_any",
+
+      "closure_s", "h_closure_s", "closure_s_o", "h_closure_s_o",
+      "closure_a", "h_closure_a", "closure_a_o", "h_closure_a_o", "closure_p", "h_closure_p",
+      "closure_ap", "h_closure_ap", "closure_pa", "h_closure_pa", "closure_pp", "h_closure_pp",
+      "closure_fa", "h_closure_fa", "closure_ss", "h_closure_ss", "closure_ss_o", "h_closure_ss_o",
+      "closure_sc", "h_closure_sc", "closure_sc_o", "h_closure_sc_o",
+      "closure_3s", "h_closure_3s", "closure_3s_o", "h_closure_3s_o", "closure_4s", "h_closure_4s", "closure_4s_o", "h_closure_4s_o", "closure_5s", "h_closure_5s",
+      "closure_aa", "h_closure_aa", "closure_aa_o", "h_closure_aa_o", "closure_3a", "h_closure_3a", "closure_4a", "h_closure_4a",
+      "closure_na", "h_closure_na", "closure_ass", "h_closure_ass", "closure_sas", "h_closure_sas ","closure_aas", "h_closure_aas",
+      "closure_saa", "h_closure_saa", "closure_asa", "h_closure_asa", "closure_ns", "h_closure_ns",
+
+      "safe_closure_s", "h_safe_closure_s", "safe_closure_s_o", "h_safe_closure_s_o",
+      "safe_closure_s_a", "h_safe_closure_s_a", "safe_closure_s_to_s", "h_safe_closure_s_to_s", "safe_closure_s_to_sc", "h_safe_closure_s_to_sc",
+      "safe_closure_p", "h_safe_closure_p", "safe_closure_p_a", "h_safe_closure_p_a",
+      "safe_closure_ap", "h_safe_closure_ap", "safe_closure_pa", "h_safe_closure_pa", "safe_closure_pp", "h_safe_closure_pp",
+      "safe_closure_a", "h_safe_closure_a", "safe_closure_a_o", "h_safe_closure_a_o", "safe_closure_a_a", "h_safe_closure_a_a",
+      "safe_closure_a_to_sc", "h_safe_closure_a_to_sc",
+      "safe_closure_ss", "h_safe_closure_ss", "safe_closure_ss_o", "h_safe_closure_ss_o", "safe_closure_ss_a", "h_safe_closure_ss_a",
+      "safe_closure_sc", "h_safe_closure_sc", "safe_closure_sc_o", "h_safe_closure_sc_o",
+      "safe_closure_aa", "h_safe_closure_aa", "safe_closure_aa_o", "h_safe_closure_aa_o", "safe_closure_aa_a", "h_safe_closure_aa_a",
+      "safe_closure_saa", "h_safe_closure_saa", "safe_closure_ssa", "h_safe_closure_ssa",
+      "safe_closure_agg", "h_safe_closure_agg", "safe_closure_3a", "h_safe_closure_3a", "safe_closure_na", "h_safe_closure_na",
+      "safe_closure_3s", "h_safe_closure_3s", "safe_closure_ns", "h_safe_closure_ns",
+      "safe_closure_3s_a", "h_safe_closure_3s_a",
+
+      "any_closure_3p", "h_any_closure_3p", "any_closure_4p", "h_any_closure_4p", "any_closure_np", "h_any_closure_np",
+      "any_closure_sym", "h_any_closure_sym", "any_closure_a_sym", "h_any_closure_a_sym",
+
+      "closure*_a", "h_closure*_a", "closure*_na", "h_closure*_na",
+      "safe_closure*_a", "h_safe_closure*_a", "safe_closure*_aa", "h_safe_closure*_aa",
+      "safe_closure*_aa_o", "h_safe_closure*_aa_o", "safe_closure*_a1", "h_safe_closure*_a1",
+      "safe_closure*_ka", "h_safe_closure*_ka", "closure*_ka", "h_closure*_ka", "safe_closure*_3a", "h_safe_closure*_3a",
+      "safe_closure*_na", "h_safe_closure*_na", "safe_closure*_na_0", "h_safe_closure*_na_0",
+      "safe_closure*_na_1", "h_safe_closure*_na_1", "safe_closure*_na_2", "h_safe_closure*_na_2",
+
+      "c_ss", "h_c_ss", "c_s", "h_c_s", "c_sc", "h_c_sc", "read_s", "h_read_s", "c_p", "h_c_p", "c_ap", "h_c_ap",
+      "c_a", "h_c_a", "c_aa", "h_c_aa", "c", "h_c", "c_nc", "h_c_nc", "c_na", "h_c_na",
+
+      "cl_s", "h_cl_s", "cl_ss", "h_cl_ss", "cl_a", "h_cl_a", "cl_aa", "h_cl_aa",
+      "cl_na", "h_cl_na", "cl_fa", "h_cl_fa", "cl_sas", "h_cl_sas",
+
+      "apply_ss", "apply_sa", "apply_sl", "macro_d", "macro*_d",
+      "with_input_from_string", "with_input_from_string_1", "with_output_to_string", "with_input_from_string_c", "call_with_output_string",
+      "s", "s_g", "s_a", "s_aa", "a_a", "a_aa", "a_sc", "p_s", "p_s_1", "map_for_each_fa", "map_for_each_faa",
+      "f", "f_a", "f_aa", "f_np", "f_np_1",
+
+      "implicit_goto", "implicit_goto_a", "implicit_continuation_a","implicit_iterate",
+      "implicit_vector_ref_a", "implicit_vector_ref_aa", "implicit_vector_set_3", "implicit_vector_set_4",
+      "implicit_string_ref_a", "implicit_c_object_ref_a", "implicit_pair_ref_a", "implicit_pair_ref_aa",
+      "implicit_hash_table_ref_a", "implicit_hash_table_ref_aa",
+      "implicit_let_ref_c", "implicit_let_ref_a", "implicit_*s7*_ref_s", "implicit_*s7*_set",
+      "unknown_thunk", "unknown_ns", "unknown_na", "unknown_s", "unknown_gg", "unknown_a", "unknown_aa", "unknown_np",
+
+      "symbol", "constant", "pair_sym", "pair_pair", "pair_any", "h_hash_table_increment", "clear_opts",
+
+      "read_internal", "eval", "eval_args", "eval_args1", "eval_args2", "eval_args3", "eval_args4", "eval_args5",
+      "eval_set1_no_mv", "eval_set2", "eval_set2_mv", "eval_set2_no_mv", "eval_set3", "eval_set3_mv", "eval_set3_no_mv",
+      "apply", "eval_macro", "lambda", "quote", "quote_unchecked", "macroexpand", "call/cc", "call_with_exit", "call_with_exit_o",
+      "c_catch", "c_catch_all", "c_catch_all_o", "c_catch_all_a",
+
+      "define", "define1", "begin", "begin_hook", "begin_no_hook", "begin_unchecked", "begin_2_unchecked", "begin_na", "begin_aa",
+      "if", "if1", "when", "unless", "set", "set1", "set2",
+      "let", "let1", "let*", "let*1", "let*2", "let*-shadowed",
+      "letrec", "letrec1", "letrec*", "letrec*1",
+      "let_temporarily", "let_temp_unchecked", "let_temp_init1", "let_temp_init2", "let_temp_done", "let_temp_done1",
+      "let_temp_s7", "let_temp_na", "let_temp_a", "let_temp_setter", "let_temp_unwind", "let_temp_s7_unwind", "let_temp_setter_unwind",
+      "let_temp_a_a", "let_temp_s7_direct", "let_temp_s7_direct_unwind",
+      "cond", "cond1", "feed_to_1", "cond_simple", "cond1_simple", "cond_simple_o", "cond1_simple_o",
+      "and", "or",
+      "define_macro", "define_macro*", "define_expansion", "define_expansion*", "macro", "macro*",
+      "case", "read_list", "read_next", "read_dot", "read_quote",
+      "read_quasiquote", "read_unquote", "read_apply_values",
+      "read_vector", "read_byte_vector", "read_int_vector", "read_float_vector", "read_done",
+      "load_return_if_eof", "load_close_and_pop_if_eof", "eval_done", "splice_values", "no_values",
+      "catch", "dynamic_wind", "dynamic_unwind", "dynamic_unwind_profile", "profile_in",
+      "define_constant", "define_constant1",
+      "do", "do_end", "do_end1", "do_step", "do_step2", "do_init",
+      "define*", "lambda*", "lambda*_default", "error_quit", "unwind_input", "unwind_output", "error_hook_quit",
+      "with_let", "with_let1", "with_let_unchecked", "with_let_s",
+      "with_baffle", "with_baffle_unchecked", "expansion",
+      "for_each", "for_each_1", "for_each_2", "for_each_3",
+      "map", "map_1", "map_2", "map_gather", "map_gather_1", "map_gather_2", "map_gather_3", "map_unwind",
+      "barrier", "deactivate_goto",
+      "define_bacro", "define_bacro*", "bacro", "bacro*",
+      "get_output_string",
+      "sort", "sort1", "sort2", "sort3", "sort_pair_end", "sort_vector_end", "sort_string_end",
+      "eval_string",
+      "member_if", "assoc_if", "member_if1", "assoc_if1",
+      "lambda_unchecked", "let_unchecked", "catch_1", "catch_2", "catch_all",
+      "set_unchecked", "set_s_c", "set_s_s", "set_s_p", "set_a",
+      "set_normal", "set_opsq_a", "set_opsaq_a", "set_opsaq_p", "set_opsaq_p_1", "set_opsaaq_a", "set_opsaaq_p", "set_opsaaq_p_1",
+      "set_from_setter", "set_from_let_temp", "set_safe",
+      "increment_1", "decrement_1", "increment_sa", "increment_saa", "set_cons",
+      "letrec_unchecked", "letrec*_unchecked", "cond_unchecked",
+      "lambda*_unchecked", "do_unchecked", "define_unchecked", "define*_unchecked", "define_funchecked", "define_constant_unchecked",
+      "define_with_setter",
+
+      "let_no_vars", "named_let", "named_let_no_vars", "named_let_a", "named_let_aa", "named_let_na", "named_let*",
+      "let_na_old", "let_na_new", "let_2a_old", "let_2a_new", "let_3a_old", "let_3a_new",
+      "let_opassq_old", "let_opassq_new", "let_one_old", "let_one_new", "let_one_p_old", "let_one_p_new",
+      "let_one_old_1", "let_one_new_1", "let_one_p_old_1", "let_one_p_new_1",
+      "let_a_old", "let_a_new", "let_a_p_old", "let_a_p_new",
+      "let_a_a_old", "let_a_a_new", "let_a_na_old", "let_a_na_new", "let_a_old_2", "let_a_new_2",
+      "let*_na", "let*_na_a",
+
+      "case_a_e_s", "case_a_i_s", "case_a_g_s", "case_a_e_g", "case_a_g_g", "case_a_s_g",
+      "case_p_e_s", "case_p_i_s", "case_p_g_s", "case_p_e_g", "case_p_g_g",
+      "case_e_s", "case_i_s", "case_g_s", "case_e_g", "case_g_g",
+      "case_a_i_s_a", "case_a_e_s_a", "case_a_g_s_a", "case_a_s_g_a",
+
+      "if_unchecked", "and_p", "and_p1", "and_ap", "and_pair_p",
+      "and_safe_p1", "op_and_safe_p2", "and_safe_p3", "and_safe_p_rest", "and_2a", "and_3a", "and_n", "and_s_2",
+      "or_p", "or_p1", "or_ap", "or_2a", "or_3a", "or_n", "or_s_2", "or_s_type_2",
+      "when_s", "when_a", "when_p", "when_and_ap", "when_and_2a", "when_and_3a", "unless_s", "unless_a", "unless_p",
+
+      "if_a_c_c", "if_a_a", "if_a_a_a", "if_s_a_a", "if_and2_s_a", "if_not_a_a", "if_not_a_a_a",
+      "if_b_a", "if_b_p", "if_b_r",  "if_b_a_p", "if_b_p_a", "if_b_p_p", "if_b_n_n",
+      "if_a_a_p", "if_a_p_a", "if_s_p_a", "if_s_a_p", "if_s_p", "if_s_p_p", "if_s_r", "if_s_n", "if_s_n_n",
+      "if_opsq_p", "if_opsq_p_p", "if_opsq_r", "if_opsq_n", "if_opsq_n_n",
+      "if_is_type_s_p", "if_is_type_s_p_p", "if_is_type_s_r", "if_is_type_s_n", "if_is_type_s_n_n", "if_is_type_s_p_a", "if_is_type_s_a_a", "if_is_type_s_a_p",
+      "if_a_p", "if_a_p_p", "if_a_r", "if_a_n", "if_a_n_n",
+      "if_and2_p", "if_and2_p_p", "if_and2_r", "if_and2_n", "if_and2_n_n",
+      "if_and3_p", "if_and3_p_p", "if_and3_r", "if_and3_n", "if_and3_n_n",
+      "if_p_p", "if_p_p_p", "if_p_r", "if_p_n", "if_p_n_n",
+      "if_andp_p", "if_andp_p_p", "if_andp_r", "if_andp_n", "if_andp_n_n",
+      "if_orp_p", "if_orp_p_p", "if_orp_r", "if_orp_n", "if_orp_n_n",
+      "if_or2_p", "if_or2_p_p", "if_or2_r", "if_or2_n", "if_or2_n_n",
+      "if_pp", "if_ppp", "if_pn", "if_pr", "if_prr", "when_pp", "unless_pp",
+
+      "cond_na_na", "cond_na_np", "cond_na_np_1", "cond_na_2e", "cond_na_3e", "cond_na_np_o",
+      "cond_feed", "cond_feed_1",
+
+      "simple_do", "simple_do_step", "safe_dotimes", "safe_dotimes_step", "safe_dotimes_step_o",
+      "safe_do", "safe_do_step", "dox", "dox_step", "dox_step_o", "dox_no_body", "dox_pending_no_body", "dox_init",
+      "dotimes_p", "dotimes_step_o",
+      "do_no_vars", "do_no_vars_no_opt", "do_no_vars_no_opt_1",
+      "do_no_body_na_vars", "do_no_body_na_vars_step", "do_no_body_na_vars_step_1",
+
+      "safe_c_p_1", "safe_c_pp_1", "safe_c_pp_3_mv", "safe_c_pp_5",
+      "safe_c_3p_1", "safe_c_3p_2", "safe_c_3p_3", "safe_c_3p_1_mv", "safe_c_3p_2_mv", "safe_c_3p_3_mv",
+      "safe_c_sp_1", "safe_cons_sp_1", "safe_add_sp_1", "safe_multiply_sp_1", "safe_c_ps_1", "safe_c_pc_1",
+      "eval_macro_mv", "macroexpand_1", "apply_lambda",
+      "any_c_np_1", "any_c_np_mv", "safe_c_ssp_1", "c_p_1", "c_ap_1", "any_c_np_2", "safe_c_pa_1",
+      "set_with_let_1", "set_with_let_2",
+
+      "closure_ap_1", "closure_pa_1", "closure_pp_1", "closure_p_1",
+      "safe_closure_p_1", "safe_closure_p_a_1", "safe_closure_ap_1", "safe_closure_pa_1", "safe_closure_pp_1",
+      "any_closure_3p_1", "any_closure_3p_2", "any_closure_3p_3", "any_closure_np_1",
+      "any_closure_4p_1", "any_closure_4p_2", "any_closure_4p_3", "any_closure_4p_4", "any_closure_np_2",
+
+      "tc_and_a_or_a_la", "tc_or_a_and_a_la", "tc_and_a_or_a_laa", "tc_or_a_and_a_laa", "tc_and_a_or_a_l3a", "tc_or_a_and_a_l3a",
+      "tc_or_a_a_and_a_a_la", "tc_or_a_and_a_a_l3a", "tc_and_a_or_a_a_la", "tc_or_a_and_a_a_la",
+      "tc_when_la", "tc_when_laa", "tc_when_l3a", "tc_let_when_laa", "tc_let_unless_laa",
+      "tc_cond_a_z_a_z_laa", "tc_cond_a_z_a_laa_z", "tc_cond_a_z_a_laa_laa", "tc_let_cond",
+      "tc_if_a_z_la", "tc_if_a_z_laa", "tc_if_a_z_l3a", "tc_if_a_l3a_z", "tc_if_a_la_z", "tc_if_a_laa_z",
+      "tc_if_a_z_if_a_z_la", "tc_if_a_z_if_a_la_z", "tc_if_a_z_if_a_z_laa", "tc_if_a_z_if_a_laa_z", "tc_if_a_z_if_a_l3a_l3a",
+      "tc_cond_a_z_a_z_la", "tc_cond_a_z_a_la_z", "tc_cond_a_z_la", "tc_cond_a_la_z", "tc_cond_a_z_laa", "tc_cond_a_laa_z",
+      "tc_let_if_a_z_la", "tc_let_if_a_z_laa", "if_a_z_let_if_a_z_laa",
+      "tc_case_la", "tc_and_a_if_a_z_la", "tc_and_a_if_a_la_z",
+
+      "recur_if_a_a_opa_laq", "recur_if_a_opa_laq_a", "recur_if_a_a_opla_aq", "recur_if_a_opla_aq_a",
+      "recur_if_a_a_opla_laq", "recur_if_a_opla_laq_a",
+      "recur_if_a_a_opa_la_laq", "recur_if_a_opa_la_laq_a",
+      "recur_if_a_a_opla_la_laq", "recur_if_a_a_if_a_a_opla_laq", "recur_if_a_a_if_a_a_oplaa_laaq",
+      "recur_if_a_a_opa_laaq", "recur_if_a_opa_laaq_a", "recur_if_a_a_opa_l3aq",
+      "recur_if_a_a_lopl3a_l3a_l3aq", "recur_if_a_a_and_a_laa_laa",
+      "recur_if_a_a_if_a_laa_opa_laaq",
+      "recur_cond_a_a_op_a_laq", "recur_cond_a_a_op_a_laaq",
+      "recur_cond_a_a_a_a_opla_laq", "recur_cond_a_a_a_a_oplaa_laaq", "recur_cond_a_a_a_a_opa_laaq",
+      "recur_cond_a_a_a_laa_lopa_laaq", "recur_cond_a_a_a_laa_opa_laaq",
+      "recur_and_a_or_a_laa_laa",
+};
+
+#define is_safe_c_op(op)  ((op >= OP_SAFE_C_NC) && (op < OP_THUNK))
+#define is_unknown_op(op) ((op >= OP_UNKNOWN) && (op <= OP_UNKNOWN_NP))
+#define is_h_safe_c_nc(P) (optimize_op(P) == HOP_SAFE_C_NC)
+#define is_safe_c_s(P)    ((optimize_op(P) == OP_SAFE_C_S) || (optimize_op(P) == HOP_SAFE_C_S))
+#define is_h_safe_c_s(P)  (optimize_op(P) == HOP_SAFE_C_S)
+#define FIRST_UNHOPPABLE_OP OP_APPLY_SS
+
+static bool is_h_optimized(s7_pointer p)
+{
+  return((is_optimized(p)) &&
+	 (op_has_hop(p)) &&
+	 (optimize_op(p) < FIRST_UNHOPPABLE_OP) &&  /* was OP_S? */
+	 (optimize_op(p) > OP_GC_PROTECT));
+}
+
+/* if this changes, remember to change lint.scm */
+typedef enum {SL_NO_FIELD=0, SL_ACCEPT_ALL_KEYWORD_ARGUMENTS, SL_AUTOLOADING, SL_BIGNUM_PRECISION, SL_CATCHES, SL_CPU_TIME, SL_C_TYPES,
+	      SL_DEBUG, SL_DEFAULT_HASH_TABLE_LENGTH, SL_DEFAULT_RANDOM_STATE, SL_DEFAULT_RATIONALIZE_ERROR, SL_EQUIVALENT_FLOAT_EPSILON,
+	      SL_EXPANSIONS, SL_FILENAMES, SL_FILE_NAMES, SL_FLOAT_FORMAT_PRECISION, SL_FREE_HEAP_SIZE, SL_GC_FREED, SL_GC_INFO,
+	      SL_GC_PROTECTED_OBJECTS, SL_GC_RESIZE_HEAP_BY_4_FRACTION, SL_GC_RESIZE_HEAP_FRACTION, SL_GC_STATS, SL_GC_TEMPS_SIZE,
+	      SL_GC_TOTAL_FREED, SL_HASH_TABLE_FLOAT_EPSILON, SL_HEAP_SIZE, SL_HISTORY, SL_HISTORY_ENABLED, SL_HISTORY_SIZE,
+	      SL_INITIAL_STRING_PORT_LENGTH, SL_MAJOR_VERSION, SL_MAX_FORMAT_LENGTH, SL_MAX_HEAP_SIZE, SL_MAX_LIST_LENGTH,
+	      SL_MAX_PORT_DATA_SIZE, SL_MAX_STACK_SIZE, SL_MAX_STRING_LENGTH, SL_MAX_VECTOR_DIMENSIONS, SL_MAX_VECTOR_LENGTH,
+	      SL_MEMORY_USAGE, SL_MINOR_VERSION, SL_MOST_NEGATIVE_FIXNUM, SL_MOST_POSITIVE_FIXNUM, SL_MUFFLE_WARNINGS,
+	      SL_NUMBER_SEPARATOR, SL_OPENLETS, SL_OUTPUT_FILE_PORT_DATA_SIZE, SL_PRINT_LENGTH, SL_PROFILE, SL_PROFILE_INFO,
+	      SL_PROFILE_PREFIX, SL_ROOTLET_SIZE, SL_SAFETY, SL_STACK, SL_STACKTRACE_DEFAULTS, SL_STACK_SIZE, SL_STACK_TOP,
+	      SL_SYMBOL_QUOTE, SL_SYMBOL_PRINTER, SL_UNDEFINED_CONSTANT_WARNINGS, SL_UNDEFINED_IDENTIFIER_WARNINGS, SL_VERSION,
+	      SL_NUM_FIELDS} s7_starlet_t;
+
+static const char *s7_starlet_names[SL_NUM_FIELDS] =
+  {"no-field", "accept-all-keyword-arguments", "autoloading?", "bignum-precision", "catches", "cpu-time", "c-types",
+   "debug", "default-hash-table-length", "default-random-state", "default-rationalize-error", "equivalent-float-epsilon",
+   "expansions?", "filenames", "file-names", "float-format-precision", "free-heap-size", "gc-freed", "gc-info",
+   "gc-protected-objects", "gc-resize-heap-by-4-fraction", "gc-resize-heap-fraction", "gc-stats", "gc-temps-size",
+   "gc-total-freed", "hash-table-float-epsilon", "heap-size", "history", "history-enabled", "history-size",
+   "initial-string-port-length", "major-version", "max-format-length", "max-heap-size", "max-list-length",
+   "max-port-data-size", "max-stack-size", "max-string-length", "max-vector-dimensions", "max-vector-length",
+   "memory-usage", "minor-version", "most-negative-fixnum", "most-positive-fixnum", "muffle-warnings?",
+   "number-separator", "openlets", "output-port-data-size", "print-length", "profile", "profile-info",
+   "profile-prefix", "rootlet-size", "safety", "stack", "stacktrace-defaults", "stack-size", "stack-top",
+   "symbol-quote?", "symbol-printer", "undefined-constant-warnings", "undefined-identifier-warnings", "version"};
+
+static s7_pointer object_to_string_truncated(s7_scheme *sc, s7_pointer p);
+static const char *type_name(s7_scheme *sc, s7_pointer arg, article_t article);
+static s7_pointer cons_unchecked(s7_scheme *sc, s7_pointer a, s7_pointer b);
+static s7_pointer unbound_variable(s7_scheme *sc, s7_pointer sym);
+
+
+#define bold_text    "\033[1m"
+#define unbold_text  "\033[22m"
+#define red_text     "\033[31m"
+#define green_text   "\033[32m"
+#define blue_text    "\033[34m"
+#define uncolor_text "\033[0m" /* yellow=33 */
+
+
+/* -------------------------------- internal debugging apparatus -------------------------------- */
+static int64_t heap_location(s7_scheme *sc, s7_pointer p)
+{
+  for (heap_block_t *hp = sc->heap_blocks; hp; hp = hp->next)
+    if (((intptr_t)p >= hp->start) && ((intptr_t)p < hp->end))
+      return(hp->offset + (((intptr_t)p - hp->start) / sizeof(s7_cell)));
+  return(((s7_big_pointer)p)->big_hloc);
+}
+
+#if TRAP_SEGFAULT
+#include <signal.h>
+static Jmp_Buf senv; /* global here is not a problem -- it is used only to protect s7_is_valid */
+static volatile sig_atomic_t can_jump = 0;
+static void segv(int32_t unused) {if (can_jump) LongJmp(senv, 1);}
+#endif
+
+bool s7_is_valid(s7_scheme *sc, s7_pointer arg)
+{
+  bool result = false;
+  if (!arg) return(false);
+  {
+    s7_pointer heap0 = *(sc->heap);
+    const s7_pointer heap1 = (s7_pointer)(heap0 + sc->heap_size);
+    if ((arg >= heap0) && (arg < heap1)) return(true);
+  }
+#if TRAP_SEGFAULT
+  if (SetJmp(senv, 1) == 0)
+    {
+      void (*old_segv)(int32_t sig);
+      can_jump = 1;
+      old_segv = signal(SIGSEGV, segv);
+#endif
+      if ((unchecked_type(arg) > T_FREE) &&
+	  (unchecked_type(arg) < NUM_TYPES))
+	{
+	  if (!in_heap(arg))
+	    result = true;
+	  else
+	    {
+	      int64_t loc = heap_location(sc, arg);
+	      if ((loc >= 0) && (loc < sc->heap_size))
+		result = (sc->heap[loc] == arg);
+	    }}
+#if TRAP_SEGFAULT
+      signal(SIGSEGV, old_segv);
+    }
+  else result = false;
+  can_jump = 0;
+#endif
+  return(result);
+}
+
+#define safe_print(Code)	   \
+  do {				   \
+    bool old_open = sc->has_openlets, old_stop = sc->stop_at_error;  \
+    sc->has_openlets = false;      \
+    sc->stop_at_error = false;	   \
+    Code;			   \
+    sc->stop_at_error = old_stop;  \
+    sc->has_openlets = old_open;   \
+  } while (0)
+
+void s7_show_history(s7_scheme *sc);
+void s7_show_history(s7_scheme *sc)
+{
+#if WITH_HISTORY
+  if (sc->cur_code == sc->history_sink)
+    fprintf(stderr, "history diabled\n");
+  else
+    {
+      int32_t size = sc->history_size;
+      s7_pointer p = cdr(sc->cur_code);
+      fprintf(stderr, "history:\n");
+      for (int32_t i = 0; i < size; i++, p = cdr(p)) /* stepper "i" is not redundant */
+	safe_print(fprintf(stderr, "%d: %s\n", i, display_truncated(car(p))));
+      fprintf(stderr, "\n");
+    }
+#else
+  fprintf(stderr, "%s\n", display(sc->cur_code));
+#endif
+}
+
+#if S7_DEBUGGING
+#define UNUSED_BITS 0x400fc00000000c0 /* high 6 bits of optimizer code + high 2 bits of type + bit 58 (was gx) */
+
+static char *describe_type_bits(s7_scheme *sc, s7_pointer obj)
+{
+  uint64_t full_typ = full_type(obj);
+  uint8_t typ = unchecked_type(obj);
+  char *buf;
+  char str[900];
+
+  str[0] = '\0';
+  catstrs(str, 900,	  /* if debugging, all of these bits are being watched, so we need to access them directly */
+	  /* bit 8 (the first 8 bits (after the 8 type bits) are easy...) */
+	  ((full_typ & T_MULTIFORM) != 0) ?      ((is_any_closure(obj)) ?
+						  (((full_typ & T_ONE_FORM) != 0) ? " closure-one-form-has-fx" : " closure-multiform") :
+						  " ?0?") : "",
+	  /* bit 9 */
+	  ((full_typ & T_SYNTACTIC) != 0) ?      (((is_pair(obj)) || (is_syntax(obj)) || (is_normal_symbol(obj))) ?
+						  " syntactic" :
+						  " ?1?") : "",
+	  /* bit 10 */
+	  ((full_typ & T_SIMPLE_ARG_DEFAULTS) != 0) ? ((is_pair(obj)) ? " simple-args|in-use" :
+						       ((is_any_closure(obj)) ? " closure-one-form" :
+							" ?2?")) : "",
+	  /* bit 11 */
+	  ((full_typ & T_OPTIMIZED) != 0) ?      ((is_c_function(obj)) ? " scope-safe" :
+						  ((is_pair(obj)) ? " optimized" :
+						   " ?3?")) : "",
+	  /* bit 12 */
+	  ((full_typ & T_SAFE_CLOSURE) != 0) ?   (((has_closure_let(obj)) || (is_pair(obj))) ? " safe-closure" : " ?4?") : "",
+	  /* bit 13 */
+	  ((full_typ & T_DONT_EVAL_ARGS) != 0) ? (((is_any_macro(obj)) || (is_syntax(obj))) ? " dont-eval-args" : " ?5?") : "",
+	  /* bit 14 */
+	  ((full_typ & T_EXPANSION) != 0) ?      (((is_normal_symbol(obj)) || (is_either_macro(obj))) ? " expansion" : " ?6?") : "",
+	  /* bit 15 */
+	  ((full_typ & T_MULTIPLE_VALUE) != 0) ? ((is_symbol(obj)) ? " matched" :
+						  ((is_pair(obj)) ? " values|matched" :
+						   " ?7?")) : "",
+	  /* bit 16 */
+	  ((full_typ & T_UNSAFE_DO) != 0) ?      ((is_pair(obj)) ? " unsafe-do" :
+						  ((is_let(obj)) ? " dox_slot1" :
+						   " ?8?")) : "",
+	  /* bit 17 */
+	  ((full_typ & T_COLLECTED) != 0) ?      " collected" : "",
+	  /* bit 18 */
+	  ((full_typ & T_LOCATION) != 0) ?       ((is_pair(obj)) ? " line-number" :
+						  ((is_input_port(obj)) ? " loader-port" :
+						   ((is_let(obj)) ? " with-let" :
+						    ((is_any_procedure(obj)) ? " simple-defaults" :
+						     ((is_slot(obj)) ? " has-setter" :
+						      " ?10?"))))) : "",
+	  /* bit 19 */
+	  ((full_typ & T_SHARED) != 0) ?         ((is_sequence(obj)) ? " shared" : " ?11?") : "",
+	  /* bit 20 */
+	  ((full_typ & T_LOW_COUNT) != 0) ?      ((is_pair(obj)) ? " low-count" : " ?12?") : "",
+	  /* bit 21 */
+	  ((full_typ & T_SAFE_PROCEDURE) != 0) ? ((is_applicable(obj)) ? " safe-procedure" : " ?13?") : "",
+	  /* bit 22 */
+	  ((full_typ & T_CHECKED) != 0) ?        (((is_pair(obj)) || (is_slot(obj))) ? " checked" :
+						  ((is_symbol(obj)) ? " all-integer" :
+						   " ?14?")) : "",
+	  /* bit 23 */
+	  ((full_typ & T_UNSAFE) != 0) ?         ((is_symbol(obj)) ? " clean-symbol" :
+						  ((is_slot(obj)) ? " has-stepper" :
+						   ((is_pair(obj)) ? " unsafely-opt|no-float-opt" :
+						    ((is_let(obj)) ? " dox-slot2" :
+						     " ?15?")))) : "",
+	  /* bit 24 */
+	  ((full_typ & T_IMMUTABLE) != 0) ?      " immutable" : "",
+	  /* bit 25 */
+	  ((full_typ & T_SETTER) != 0) ?         ((is_normal_symbol(obj)) ? " setter" :
+						  ((is_pair(obj)) ? " allow-other-keys|no-int-opt" :
+						   ((is_slot(obj)) ? " has-expression" :
+						    ((is_c_function_star(obj)) ? " allow-other-keys" :
+						     ((is_let(obj)) ? " let-removed-from-heap" :
+						      " ?17?"))))) : "",
+	  /* bit 26 */
+	  ((full_typ & T_MUTABLE) != 0) ?        ((is_number(obj)) ? " mutable" :
+						  ((is_symbol(obj)) ? " has-keyword" :
+						   ((is_let(obj)) ? " ref-fallback" :
+						    ((is_iterator(obj)) ? " mark-sequence" :
+						     ((is_slot(obj)) ? " step-end" :
+						      ((is_pair(obj)) ? " no-opt" :
+						       " ?18?")))))) : "",
+	  /* bit 27 */
+	  ((full_typ & T_SAFE_STEPPER) != 0) ?   ((is_let(obj)) ? " set-fallback" :
+						  ((is_slot(obj)) ? " safe-stepper" :
+						   ((is_c_function(obj)) ? " maybe-safe" :
+						    ((is_number(obj)) ? " print-name" :
+						     ((is_pair(obj)) ? " direct-opt" :
+						      ((is_hash_table(obj)) ? " weak-hash" :
+						       ((is_any_macro(obj)) ? " pair-macro-set" :
+							((is_symbol(obj)) ? " all-float" :
+							 " ?19?")))))))) : "",
+	  /* bit 28, for c_function case see sc->apply */
+	  ((full_typ & T_COPY_ARGS) != 0) ?      (((is_pair(obj)) || (is_any_macro(obj)) || (is_syntax(obj)) ||
+						   (is_any_closure(obj)) || (is_c_function(obj))) ? " copy-args" :
+						  " ?20?") : "",
+	  /* bit 29 */
+	  ((full_typ & T_GENSYM) != 0) ?         ((is_let(obj)) ? " funclet" :
+						  ((is_normal_symbol(obj)) ? " gensym" :
+						   ((is_string(obj)) ? " documented-symbol" :
+						    ((is_hash_table(obj)) ? " hash-chosen" :
+						     ((is_pair(obj)) ? " fx-treed" :
+						      ((is_any_vector(obj)) ? " subvector" :
+						       ((is_slot(obj)) ? " has-pending-value" :
+							((is_any_closure(obj)) ? " unknopt" :
+							 " ?21?")))))))) : "",
+	  /* bit 30 [pair and symbol free here] */
+	  ((full_typ & T_HAS_METHODS) != 0) ?    (((is_let(obj)) || (is_c_object(obj)) || (is_any_closure(obj)) ||
+						   (is_any_macro(obj)) || (is_c_pointer(obj))) ? " has-methods" :
+						  " ?22?") : "",
+	  /* bit 31 */
+	  ((full_typ & T_ITER_OK) != 0) ?        ((is_iterator(obj)) ? " iter-ok" :
+						  ((is_pair(obj)) ? " loop-end-possible" :
+						   ((is_slot(obj)) ? " in-rootlet" :
+						    ((is_c_function(obj)) ? " bool-function" :
+						     ((is_symbol(obj)) ? " symbol-from-symbol" :
+						      " ?23?"))))) : "",
+	  /* bit 24+24 */
+	  ((full_typ & T_FULL_SYMCONS) != 0) ?   ((is_symbol(obj)) ? " possibly-constant" :
+						  ((is_any_procedure(obj)) ? " has-let-arg" :
+						   ((is_hash_table(obj)) ? " has-value-type" :
+						    ((is_pair(obj)) ? " int-optable" :
+						     ((is_let(obj)) ? " unlet" :
+						      ((is_t_vector(obj)) ? " symbol-table" :
+						       " ?24?")))))) : "",
+	  /* bit 25+24 */
+	  ((full_typ & T_FULL_HAS_LET_FILE) != 0) ? ((is_let(obj)) ? " has-let-file" :
+						     ((is_t_vector(obj)) ? " typed-vector" :
+						      ((is_hash_table(obj)) ? " typed-hash-table" :
+						       ((is_c_function(obj)) ? " has-bool-setter" :
+							((is_slot(obj)) ? " rest-slot" :
+							 (((is_pair(obj)) || (is_closure_star(obj))) ? " no-defaults" :
+							  " ?25?")))))) : "",
+	  /* bit 26+24 */
+	  ((full_typ & T_FULL_DEFINER) != 0) ?   ((is_normal_symbol(obj)) ? " definer" :
+						  ((is_pair(obj)) ? " has-fx" :
+						   ((is_slot(obj)) ? " slot-defaults" :
+						    ((is_iterator(obj)) ? " weak-hash-iterator" :
+						     ((is_hash_table(obj)) ? " has-key-type" :
+						      ((is_let(obj)) ? " maclet" :
+						       ((is_c_function(obj)) ? " func-definer" :
+							((is_syntax(obj)) ? " syntax-definer" :
+							 " ?26?")))))))) : "",
+	  /* bit 27+24 */
+	  ((full_typ & T_FULL_BINDER) != 0) ?    ((is_pair(obj)) ? " tree-collected" :
+						  ((is_hash_table(obj)) ? " simple-values" :
+						   ((is_normal_symbol(obj)) ? " binder" :
+						    ((is_c_function(obj)) ? " safe-args" :
+						     ((is_syntax(obj)) ?  " syntax-binder" :
+						      " ?27?"))))) : "",
+	  /* bit 28+24 */
+	  ((full_typ & T_VERY_SAFE_CLOSURE) != 0) ? (((is_pair(obj)) || (is_any_closure(obj))) ? " very-safe-closure" :
+						     ((is_let(obj)) ? " baffle-let" :
+						      " ?28?")) : "",
+	  /* bit 29+24 */
+	  ((full_typ & T_CYCLIC) != 0) ?         (((is_simple_sequence(obj)) || (t_structure_p[type(obj)]) ||
+						   (is_any_closure(obj))) ? " cyclic" : " ?29?") : "",
+	  /* bit 30+24 */
+	  ((full_typ & T_CYCLIC_SET) != 0) ?     (((is_simple_sequence(obj)) || (t_structure_p[type(obj)]) ||
+						   (is_any_closure(obj))) ? " cyclic-set" : " ?30?") : "",
+	  /* bit 31+24 */
+	  ((full_typ & T_KEYWORD) != 0) ?        ((is_symbol(obj)) ? " keyword" :
+						  ((is_pair(obj)) ? " fx-treeable" :
+						   " ?31?")) : "",
+	  /* bit 32+24 */
+	  ((full_typ & T_FULL_SIMPLE_ELEMENTS) != 0) ? ((is_t_vector(obj)) ? " simple-elements" :
+							((is_hash_table(obj)) ? " simple-keys" :
+							 ((is_normal_symbol(obj)) ? " safe-setter" :
+							  ((is_pair(obj)) ? " float-optable" :
+							   ((typ >= T_C_MACRO) ? " function-simple-elements" :
+							    " 32?"))))) : "",
+	  /* bit 33+24 */
+	  ((full_typ & T_FULL_CASE_KEY) != 0) ?  ((is_symbol(obj)) ? " case-key" :
+						  ((is_pair(obj)) ? " opt1-func-listed" :
+						   " ?33?")) : "",
+	  /* bit 34+24 free */
+	  /* bit 35+24 */
+	  ((full_typ & T_FULL_UNKNOPT) != 0) ?    ((is_pair(obj)) ? " unknopt" : " ?35?") : "",
+	  /* bit 36+24 */
+	  ((full_typ & T_FULL_SAFETY_CHECKED) != 0) ? ((is_pair(obj)) ? " safety-checked" : " ?36?") : "",
+	  /* bit 37+24 */
+	  ((full_typ & T_FULL_HAS_FN) != 0) ?    ((is_pair(obj)) ? " has-fn" : " ?37") : "",
+	  /* bit 62 */
+	  ((full_typ & T_UNHEAP) != 0) ?         " unheap" : "",
+	  /* bit 63 */
+	  ((full_typ & T_GC_MARK) != 0) ?        " gc-marked" : "",
+
+	  ((full_typ & UNUSED_BITS) != 0) ?      " unused bits set?" : "",
+	  ((is_symbol(obj)) && (((uint8_t)(symbol_type(obj) & 0xff) >= NUM_TYPES) || ((symbol_type(obj) & ~0xffff) != 0))) ? " bad-symbol-type" : "",
+	  NULL);
+
+  buf = (char *)Malloc(1024);
+  snprintf(buf, 1024, "type: %s? (%d), opt_op: %d %s, full_type: #x%" PRIx64 "%s",
+	   type_name(sc, obj, NO_ARTICLE), typ,
+	   unchecked_optimize_op(obj), (unchecked_optimize_op(obj) < NUM_OPS) ? op_names[unchecked_optimize_op(obj)] : "", full_typ,
+	   str);
+  return(buf);
+}
+
+/* snprintf returns the number of bytes that would have been written: (display (c-pointer 123123123 (symbol (make-string 130 #\a)))) */
+
+static bool never_unheaped[NUM_TYPES];
+static void init_never_unheaped(void)
+{
+  for (int i = 0; i < NUM_TYPES; i++) never_unheaped[i] = false;
+  never_unheaped[T_BACRO] = true;
+  never_unheaped[T_BACRO_STAR] = true;
+  never_unheaped[T_CATCH] = true;
+  never_unheaped[T_CLOSURE] = true;
+  never_unheaped[T_CLOSURE_STAR] = true;
+  never_unheaped[T_CONTINUATION] = true;
+  never_unheaped[T_COUNTER] = true;
+  never_unheaped[T_C_OBJECT] = true;
+  never_unheaped[T_C_POINTER] = true;
+  never_unheaped[T_DYNAMIC_WIND] = true;
+  never_unheaped[T_FREE] = true;
+  never_unheaped[T_GOTO] = true;
+  never_unheaped[T_HASH_TABLE] = true;
+  never_unheaped[T_ITERATOR] = true;
+  never_unheaped[T_MACRO] = true;
+  never_unheaped[T_MACRO_STAR] = true;
+  never_unheaped[T_RANDOM_STATE] = true;
+  never_unheaped[T_SLOT] = true;
+  never_unheaped[T_STACK] = true;
+  never_unheaped[T_UNUSED] = true;
+  never_unheaped[T_VECTOR] = true;
+}
+
+static bool has_odd_bits(s7_pointer obj)
+{
+  uint64_t full_typ = full_type(obj);
+  if ((full_typ & UNUSED_BITS) != 0) return(true);
+  if (((full_typ & T_MULTIFORM) != 0) && (!is_any_closure(obj))) return(true);
+  if (((full_typ & T_KEYWORD) != 0) && (!is_symbol(obj)) && (!is_pair(obj))) return(true);
+  if (((full_typ & T_SYNTACTIC) != 0) && (!is_syntax(obj)) && (!is_pair(obj)) && (!is_normal_symbol(obj))) return(true);
+  if (((full_typ & T_SIMPLE_ARG_DEFAULTS) != 0) && (!is_pair(obj)) && (!is_any_closure(obj))) return(true);
+  if (((full_typ & T_OPTIMIZED) != 0) && (!is_c_function(obj)) && (!is_pair(obj))) return(true);
+  if (((full_typ & T_SAFE_CLOSURE) != 0) && (!is_any_closure(obj)) && (!is_pair(obj))) return(true);
+  if (((full_typ & T_SAFE_PROCEDURE) != 0) && (!is_applicable(obj))) return(true);
+  if (((full_typ & T_EXPANSION) != 0) && (!is_normal_symbol(obj)) && (!is_either_macro(obj))) return(true);
+  if (((full_typ & T_MULTIPLE_VALUE) != 0) && (!is_symbol(obj)) && (!is_pair(obj))) return(true);
+  if (((full_typ & T_UNSAFE_DO) != 0) && (!is_pair(obj)) && (!is_let(obj))) return(true);
+  if (((full_typ & T_ITER_OK) != 0) && (!is_iterator(obj)) && (!is_pair(obj)) && (!is_slot(obj)) && (!is_c_function(obj)) && (!is_symbol(obj))) return(true);
+  if (((full_typ & T_LOW_COUNT) != 0) && (!is_pair(obj))) return(true);
+  if (((full_typ & T_UNSAFE) != 0) && (!is_symbol(obj)) && (!is_slot(obj)) && (!is_let(obj)) && (!is_pair(obj))) return(true);
+  if (((full_typ & T_VERY_SAFE_CLOSURE) != 0) && (!is_pair(obj)) && (!is_any_closure(obj)) && (!is_let(obj))) return(true);
+  if (((full_typ & T_FULL_CASE_KEY) != 0) && (!is_symbol(obj)) && (!is_pair(obj))) return(true);
+  if (((full_typ & T_FULL_UNKNOPT) != 0) && (!is_pair(obj))) return(true);
+  if (((full_typ & T_FULL_SAFETY_CHECKED) != 0) && (!is_pair(obj))) return(true);
+  if (((full_typ & T_DONT_EVAL_ARGS) != 0) && (!is_any_macro(obj)) && (!is_syntax(obj))) return(true);
+  if (((full_typ & T_CHECKED) != 0) && (!is_slot(obj)) && (!is_pair(obj)) && (!is_symbol(obj))) return(true);
+  if (((full_typ & T_SHARED) != 0) && (!t_sequence_p[type(obj)]) && (!t_structure_p[type(obj)]) && (!is_any_closure(obj))) return(true);
+  if (((full_typ & T_COPY_ARGS) != 0) && (!is_pair(obj)) &&
+      (!is_any_macro(obj)) && (!is_any_closure(obj)) && (!is_c_function(obj)) && (!is_syntax(obj)))
+    return(true);
+  if (((full_typ & T_FULL_SYMCONS) != 0) &&
+      (!is_symbol(obj)) && (!is_any_procedure(obj)) && (!is_hash_table(obj)) && (!is_pair(obj)) && (!is_let(obj)) && (!is_t_vector(obj)))
+    return(true);
+  if (((full_typ & T_FULL_BINDER) != 0) &&
+      (!is_pair(obj)) && (!is_hash_table(obj)) && (!is_normal_symbol(obj)) && (!is_c_function(obj)) && (!is_syntax(obj)))
+    return(true);
+  if (((full_typ & T_FULL_DEFINER) != 0) &&
+      (!is_normal_symbol(obj)) && (!is_c_function(obj)) && (!is_pair(obj)) && (!is_slot(obj)) && (!is_iterator(obj)) &&
+      (!is_hash_table(obj)) && (!is_let(obj)) && (!is_syntax(obj)))
+    return(true);
+  if (((full_typ & T_FULL_HAS_LET_FILE) != 0) &&
+      (!is_let(obj)) && (!is_t_vector(obj)) && (!is_hash_table(obj)) && (!is_c_function(obj)) &&
+      (!is_slot(obj)) && (!is_pair(obj)) && (!is_closure_star(obj)))
+    return(true);
+  if (((full_typ & T_SAFE_STEPPER) != 0) &&
+      (!is_let(obj)) && (!is_slot(obj)) && (!is_c_function(obj)) && (!is_number(obj)) &&
+      (!is_pair(obj)) && (!is_hash_table(obj)) && (!is_any_macro(obj)) && (!is_symbol(obj)))
+    return(true);
+  if (((full_typ & T_SETTER) != 0) &&
+      (!is_slot(obj)) && (!is_normal_symbol(obj)) && (!is_pair(obj)) && (!is_let(obj)) && (!is_c_function_star(obj)) && (!is_let(obj)))
+    return(true);
+  if (((full_typ & T_LOCATION) != 0) &&
+      (!is_pair(obj)) && (!is_input_port(obj)) && (!is_let(obj)) && (!is_any_procedure(obj)) && (!is_slot(obj)))
+    return(true);
+  if (((full_typ & T_MUTABLE) != 0) &&
+      (!is_number(obj)) && (!is_symbol(obj)) && (!is_let(obj)) && (!is_iterator(obj)) && (!is_slot(obj)) && (!is_let(obj)) && (!is_pair(obj)))
+    return(true);
+  if (((full_typ & T_GENSYM) != 0) && (!is_slot(obj)) && (!is_any_closure(obj)) &&
+      (!is_let(obj)) && (!is_symbol(obj)) && (!is_string(obj)) && (!is_hash_table(obj)) && (!is_pair(obj)) && (!is_any_vector(obj)))
+    return(true);
+  if (((full_typ & T_FULL_SIMPLE_ELEMENTS) != 0) &&
+      (!is_t_vector(obj)) && (!is_hash_table(obj)) && (!is_normal_symbol(obj)) && (!is_pair(obj)) && (unchecked_type(obj) < T_C_MACRO))
+    return(true);
+  if (((full_typ & T_HAS_METHODS) != 0) &&
+      (!is_let(obj)) && (!is_c_object(obj)) && (!is_any_closure(obj)) && (!is_any_macro(obj)) && (!is_c_pointer(obj)))
+    return(true);
+  if (((full_typ & T_CYCLIC) != 0) && (!is_simple_sequence(obj)) && (!t_structure_p[type(obj)]) && (!is_any_closure(obj))) return(true);
+  if (((full_typ & T_CYCLIC_SET) != 0) && (!is_simple_sequence(obj)) && (!t_structure_p[type(obj)]) && (!is_any_closure(obj))) return(true);
+  if (((full_typ & T_FULL_HAS_FN) != 0) && (!is_pair(obj))) return(true);
+  if (is_symbol(obj))
+    {
+      if ((uint8_t)(symbol_type(obj) & 0xff) >= NUM_TYPES)
+	return(true);
+      if ((symbol_type(obj) & ~0xffff) != 0) /* boolean function bool type and *s7*_let field id */
+	return(true);
+    }
+  if ((signed_type(obj) == 0) && ((full_typ & T_GC_MARK) != 0)) return(true);
+
+  if (!in_heap(obj))
+    {
+      uint8_t typ = unchecked_type(obj);
+      if (never_unheaped[typ]) {fprintf(stderr, "unheap %s?\n", s7_type_names[typ]); return(true);}
+    }
+  /* all the hash_table bits seem to be compatible, symbols? (all_float/all_integer only apply to sc->divide_symbol et al at init time) */
+  return(false);
+}
+
+void s7_show_let(s7_scheme *sc);
+void s7_show_let(s7_scheme *sc) /* debugging convenience */
+{
+  for (s7_pointer olet = sc->curlet; olet; olet = let_outlet(olet))
+    {
+      if (olet == sc->owlet)
+	fprintf(stderr, "(owlet): ");
+      else
+	if (olet == sc->rootlet)
+	  fprintf(stderr, "(rootlet): ");
+	else
+	  if (is_funclet(olet))
+	    fprintf(stderr, "(%s funclet): ", display(funclet_function(olet)));
+	  else
+	    if (olet == sc->shadow_rootlet)
+	      fprintf(stderr, "(shadow rootlet): ");
+      fprintf(stderr, "%s\n", display(olet));
+    }
+}
+
+static const char *checked_type_name(s7_scheme *sc, int32_t typ)
+{
+  if ((typ >= 0) && (typ < NUM_TYPES))
+    {
+      s7_pointer p = sc->type_names[typ];
+      if (is_string(p)) return(string_value(p));
+    }
+  return("unknown type!");
+}
+
+#if REPORT_ROOTLET_REDEF
+static void set_local_1(s7_scheme *sc, s7_pointer symbol, const char *func, int32_t line)
+{
+  if (is_global(symbol))
+    fprintf(stderr, "%s[%d]: %s%s%s in %s\n", func, line, bold_text, display(symbol), unbold_text, display_truncated(sc->cur_code));
+  full_type(symbol) = (full_type(symbol) & ~(T_DONT_EVAL_ARGS | T_SYNTACTIC));
+}
+#endif
+
+static char *object_raw_type_to_string(s7_pointer p)
+{
+  char *buf = (char *)Malloc(128);
+  snprintf(buf, 128, "type: %d", unchecked_type(p));
+  return(buf);
+}
+
+static void complain(const char* complaint, s7_pointer p, const char *func, int32_t line, uint8_t typ)
+{
+  fprintf(stderr, complaint, bold_text, func, line, checked_type_name(cur_sc, typ), object_raw_type_to_string(p), unbold_text);
+  if (cur_sc->stop_at_error) abort();
+}
+
+static char* show_debugger_bits(s7_pointer p)
+{
+  char *bits_str = (char *)Malloc(512);
+  int64_t bits = p->debugger_bits;
+  snprintf(bits_str, 512, " %s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s",
+	   ((bits & OPT1_SET) != 0) ? " opt1_set" : "",
+	   ((bits & OPT1_FAST) != 0) ? " opt1_fast" : "",
+	   ((bits & OPT1_CFUNC) != 0) ? " opt1_cfunc" : "",
+	   ((bits & OPT1_CLAUSE) != 0) ? " opt1_clause" : "",
+	   ((bits & OPT1_LAMBDA) != 0) ? " opt1_lambda" : "",
+	   ((bits & OPT1_SYM) != 0) ? " opt1_sym" : "",
+	   ((bits & OPT1_PAIR) != 0) ? " opt1_pair" : "",
+	   ((bits & OPT1_CON) != 0) ? " opt1_con" : "",
+	   ((bits & OPT1_ANY) != 0) ? " opt1_any" : "",
+	   ((bits & OPT1_HASH) != 0) ? " opt1_hash" : "",
+
+	   ((bits & OPT2_SET) != 0) ? " opt2_set" : "",
+	   ((bits & OPT2_KEY) != 0) ? " opt2_any" : "",
+	   ((bits & OPT2_SLOW) != 0) ? " opt2_slow" : "",
+	   ((bits & OPT2_SYM) != 0) ? " opt2_sym" : "",
+	   ((bits & OPT2_PAIR) != 0) ? " opt2_pair" : "",
+	   ((bits & OPT2_CON) != 0) ? " opt2_con" : "",
+	   ((bits & OPT2_FX) != 0) ? " opt2_fx" : "",
+	   ((bits & OPT2_FN) != 0) ? " opt2_fn" : "",
+	   ((bits & OPT2_LAMBDA) != 0) ? " opt2_lambda" : "",
+	   ((bits & OPT2_DIRECT) != 0) ? " opt2_direct" : "",
+	   ((bits & OPT2_NAME) != 0) ? " opt2_raw_name" : "",
+	   ((bits & OPT2_INT) != 0) ? " opt2_int" : "",
+
+	   ((bits & OPT3_SET) != 0) ? " opt3_set" : "",
+	   ((bits & OPT3_ARGLEN) != 0) ? " opt3_arglen" : "",
+	   ((bits & OPT3_SYM) != 0) ? " opt3_sym" : "",
+	   ((bits & OPT3_CON) != 0) ? " opt3_con" : "",
+	   ((bits & OPT3_AND) != 0) ? " opt3_pair " : "",
+	   ((bits & OPT3_ANY) != 0) ? " opt3_any " : "",
+	   ((bits & OPT3_LET) != 0) ? " opt3_let " : "",
+	   ((bits & OPT3_BYTE) != 0) ? " opt3_byte " : "",
+	   ((bits & OPT3_DIRECT) != 0) ? " opt3_direct" : "",
+	   ((bits & OPT3_LOCATION) != 0) ? " opt3_location" : "",
+	   ((bits & OPT3_LEN) != 0) ? " opt3_len" : "",
+	   ((bits & OPT3_INT) != 0) ? " opt3_int" : "",
+
+	   ((bits & L_HIT) != 0) ? " let_set" : "",
+	   ((bits & L_FUNC) != 0) ? " let_func" : "",
+	   ((bits & L_DOX) != 0) ? " let_dox" : "");
+  return(bits_str);
+}
+
+static s7_pointer check_ref_one(s7_pointer p, uint8_t expected_type, const char *func, int32_t line, const char *func1, const char *func2)
+{
+  if (!p)
+    {
+      fprintf(stderr, "%s%s[%d]: null pointer passed to check_ref_one%s\n", bold_text, func, line, unbold_text);
+      if (cur_sc->stop_at_error) abort();
+    }
+  else
+    {
+      uint8_t typ = unchecked_type(p);
+      if (typ != expected_type)
+	{
+	  if ((!func1) || (typ != T_FREE))
+	    {
+	      fprintf(stderr, "%s%s[%d]: not %s, but %s (%s)%s\n",
+		      bold_text,
+		      func, line, checked_type_name(cur_sc, expected_type), checked_type_name(cur_sc, typ), object_raw_type_to_string(p),
+		      unbold_text);
+	      if (cur_sc->stop_at_error) abort();
+	    }
+	  else
+	    if ((strcmp(func, func1) != 0) &&
+		((!func2) || (strcmp(func, func2) != 0)))
+	      {
+		fprintf(stderr, "%s%s[%d]: free cell, not %s%s\n", bold_text, func, line, checked_type_name(cur_sc, expected_type), unbold_text);
+		if (cur_sc->stop_at_error) abort();
+	      }}}
+  return(p);
+}
+
+static void check_let_set_slots(s7_pointer p, s7_pointer slot, const char *func, int32_t line)
+{
+  if ((!in_heap(p)) && (slot) && (in_heap(slot))) fprintf(stderr, "%s[%d]: let+slot mismatch\n", func, line);
+  if ((p == cur_sc->rootlet) && (slot != slot_end))
+    {
+      fprintf(stderr, "%s[%d]: setting rootlet slots!\n", func, line);
+      if (cur_sc->stop_at_error) abort();
+    }
+  T_Let(p)->object.envr.slots = T_Sln(slot);
+}
+
+static s7_pointer check_let_ref(s7_pointer p, uint64_t role, const char *func, int32_t line)
+{
+  check_ref_one(p, T_LET, func, line, NULL, NULL);
+  if ((p->debugger_bits & L_HIT) == 0) fprintf(stderr, "%s[%d]: let not set\n", func, line);
+  if ((p->debugger_bits & L_MASK) != role) fprintf(stderr, "%s[%d]: let bad role\n", func, line);
+  return(p);
+}
+
+static s7_pointer check_let_set(s7_pointer p, uint64_t role, const char *func, int32_t line)
+{
+  check_ref_one(p, T_LET, func, line, NULL, NULL);
+  p->debugger_bits &= (~L_MASK);
+  p->debugger_bits |= (L_HIT | role);
+  return(p);
+}
+
+static s7_pointer check_ref_two(s7_pointer p, uint8_t expected_type, int32_t other_type, const char *func, int32_t line, const char *func1, const char *func2)
+{
+  if (!p)
+    fprintf(stderr, "%s[%d]: null pointer passed to check_ref_two\n", func, line);
+  else
+    {
+      uint8_t typ = unchecked_type(p);
+      if ((typ != expected_type) && (typ != other_type))
+	return(check_ref_one(p, expected_type, func, line, func1, func2));
+    }
+  return(p);
+}
+
+static s7_pointer check_ref_prt(s7_pointer p, const char *func, int32_t line)
+{
+  uint8_t typ = unchecked_type(p);
+  if ((typ != T_INPUT_PORT) && (typ != T_OUTPUT_PORT) && (typ != T_FREE))
+    complain("%s%s[%d]: not a port, but %s (%s)%s\n", p, func, line, typ);
+  return(p);
+}
+
+static s7_pointer check_ref_pri(s7_pointer p, const char *func, int32_t line)
+{
+  uint8_t typ = unchecked_type(p);
+  if ((typ != T_INPUT_PORT) && (p != cur_sc->F))
+    complain("%s%s[%d]: not an input port, but %s (%s)%s\n", p, func, line, typ);
+  return(p);
+}
+
+static s7_pointer check_ref_pro(s7_pointer p, const char *func, int32_t line)
+{
+  uint8_t typ = unchecked_type(p);
+  if ((typ != T_OUTPUT_PORT) && (p != cur_sc->F))
+    complain("%s%s[%d]: not an output port, but %s (%s)%s\n", p, func, line, typ);
+  return(p);
+}
+
+static s7_pointer check_ref_vec(s7_pointer p, const char *func, int32_t line)
+{
+  if ((strcmp(func, "sweep") != 0) &&
+      (strcmp(func, "process_multivector") != 0))
+    {
+      uint8_t typ = unchecked_type(p);
+      if (!t_vector_p[typ]) complain("%s%s[%d]: not a vector, but %s (%s)%s\n", p, func, line, typ);
+    }
+  return(p);
+}
+
+static s7_pointer check_ref_clo(s7_pointer p, const char *func, int32_t line)
+{
+  uint8_t typ = unchecked_type(p);
+  if (!t_has_closure_let[typ]) complain("%s%s[%d]: not a closure, but %s (%s)%s\n", p, func, line, typ);
+  return(p);
+}
+
+static s7_pointer check_ref_fnc(s7_pointer p, const char *func, int32_t line)
+{
+  uint8_t typ = unchecked_type(p);
+  if (typ < T_C_MACRO) complain("%s%s[%d]: not a c function or macro (type < T_C_MACRO, from T_Fnc), but %s (%s)%s\n", p, func, line, typ);
+  return(p);
+}
+
+static s7_pointer check_ref_num(s7_pointer p, const char *func, int32_t line)
+{
+  uint8_t typ = unchecked_type(p);
+  if ((typ < T_INTEGER) || (typ > T_COMPLEX))
+    complain("%s%s[%d]: not a number, but %s (%s)%s\n", p, func, line, typ);
+  return(p);
+}
+
+static s7_pointer check_ref_seq(s7_pointer p, const char *func, int32_t line)
+{
+  uint8_t typ = unchecked_type(p);
+  if ((!t_sequence_p[typ]) && (!t_structure_p[typ]) && (!is_any_closure(p))) /* closure as iterator -- see s7test */
+    complain("%s%s[%d]: not a sequence or structure, but %s (%s)%s\n", p, func, line, typ);
+  return(p);
+}
+
+static s7_pointer check_ref_met(s7_pointer p, const char *func, int32_t line)
+{
+  uint8_t typ = unchecked_type(p);
+  if ((typ != T_LET) && (typ != T_C_OBJECT) && (!is_any_closure(p)) && (!is_any_macro(p)) && (typ != T_C_POINTER))
+    complain("%s%s[%d]: not a possible method holder, but %s (%s)%s\n", p, func, line, typ);
+  return(p);
+}
+
+static s7_pointer check_ref_arg(s7_pointer p, const char *func, int32_t line)
+{
+  uint8_t typ = unchecked_type(p);
+  if ((typ != T_PAIR) && (typ != T_NIL) && (typ != T_SYMBOL))
+    complain("%s%s[%d]: arglist is %s (%s)%s?\n", p, func, line, typ);
+  return(p);
+}
+
+static s7_pointer check_ref_app(s7_pointer p, const char *func, int32_t line)
+{
+  uint8_t typ = unchecked_type(p);
+  if ((!t_applicable_p[typ]) && (p != cur_sc->F))
+    complain("%s%s[%d]: applicable object is %s (%s)%s?\n", p, func, line, typ);
+  return(p);
+}
+
+static s7_pointer check_ref_sln(s7_pointer p, const char *func, int32_t line)
+{
+  uint8_t typ;
+  if (is_slot_end(p)) return(p);
+  typ = unchecked_type(p);
+  if ((typ != T_SLOT) && (typ != T_NIL)) /* unset slots are nil */
+    complain("%s%s[%d]: slot is %s (%s)%s?\n", p, func, line, typ);
+  return(p);
+}
+
+static s7_pointer check_ref_out(s7_pointer p, const char *func, int32_t line)
+{
+  uint8_t typ;
+  if (!p) return(NULL);
+  typ = unchecked_type(p);
+  if (typ != T_LET)
+    complain("%s%s[%d]: outlet is %s (%s)%s?\n", p, func, line, typ);
+  return(p);
+}
+
+static s7_pointer check_ref_svec(s7_pointer p, const char *func, int32_t line)
+{
+  if (!is_any_vector(p)) complain("%s%s[%d]: subvector is %s (%s)%s?\n", p, func, line, unchecked_type(p));
+  if (!is_subvector(p)) complain("%s%s[%d]: subvector is %s (%s), but not a subvector?%s\n", p, func, line, unchecked_type(p));
+  return(p);
+}
+
+static s7_pointer check_ref_prc(s7_pointer p, const char *func, int32_t line)
+{
+  if ((!is_any_procedure(p)) && (!is_boolean(p)))
+    complain("%s%s[%d]: setter is %s (%s)%s?\n", p, func, line, unchecked_type(p));
+  return(p);
+}
+
+static void print_gc_info(s7_scheme *sc, s7_pointer obj, const char *func, int32_t line)
+{
+  if (!obj)
+    fprintf(stderr, "[%d]: obj is %p\n", line, obj);
+  else
+    if (unchecked_type(obj) != T_FREE)
+      fprintf(stderr, "%s from %s[%d]: %p type is %d?\n", __func__, func, line, obj, unchecked_type(obj));
+    else
+      {
+	s7_int free_type = full_type(obj);
+	char *bits;
+	char fline[128];
+	full_type(obj) = obj->alloc_type; /* not set_full_type here!  it clobbers existing alloc/free info */
+	sc->printing_gc_info = true;
+	bits = describe_type_bits(sc, obj); /* this func called in type macro */
+	sc->printing_gc_info = false;
+	full_type(obj) = free_type;
+	if (obj->explicit_free_line > 0)
+	  snprintf(fline, 128, ", freed at %d, ", obj->explicit_free_line);
+	fprintf(stderr, "%s%p is free (%s[%d], alloc type: %s %" ld64 " #x%" PRIx64 " (%s)), alloc: %s[%d], %sgc: %s[%d], gc: %d%s",
+		bold_text, obj, func, line, s7_type_names[obj->alloc_type & 0xff], obj->alloc_type, obj->alloc_type,
+		bits, obj->alloc_func, obj->alloc_line,
+		(obj->explicit_free_line > 0) ? fline : "", obj->gc_func, obj->gc_line,	obj->uses, unbold_text);
+	fprintf(stderr, "\n");
+	free(bits);
+      }
+  if (sc->stop_at_error) abort();
+}
+
+static s7_pointer check_nref(s7_pointer p, const char *func, int32_t line)
+{
+  if (!p)
+    {
+      fprintf(stderr, "%s%s[%d]: null pointer!%s\n", bold_text, func, line, unbold_text);
+      if (cur_sc->stop_at_error) abort();
+    }
+  else
+    if (unchecked_type(p) >= NUM_TYPES)
+      {
+	fprintf(stderr, "%s%s[%d]: attempt to use messed up cell (type: %d)%s\n", bold_text, func, line, unchecked_type(p), unbold_text);
+	if (cur_sc->stop_at_error) abort();
+      }
+  if (unchecked_type(p) == T_FREE)
+    {
+      fprintf(stderr, "%s%s[%d]: attempt to use free cell%s\n", bold_text, func, line, unbold_text);
+      print_gc_info(cur_sc, p, func, line);
+      if (cur_sc->stop_at_error) abort();
+    }
+  return(p);
+}
+
+static s7_pointer check_ref_nmv(s7_pointer p, const char *func, int32_t line)
+{
+  uint8_t typ = unchecked_type(p);
+  check_nref(p, func, line);
+  if ((is_multiple_value(p)) &&
+      (!safe_strcmp(func, "mark_slot"))) /* match == multiple-values which causes false error messages */
+    complain("%s%s[%d]: slot value is a multiple-value, %s (%s)%s?\n", p, func, line, typ);
+  if (has_odd_bits(p))
+    {char *s; fprintf(stderr, "odd bits: %s\n", s = describe_type_bits(cur_sc, p)); free(s);}
+  if (t_exs_p[typ])
+    {
+      fprintf(stderr, "%s[%d]: slot_value is %s?\n", func, line, s7_type_names[typ]);
+      if (cur_sc->stop_at_error) abort();
+    }
+  return(p);
+}
+
+static s7_pointer check_ref_mac(s7_pointer p, const char *func, int32_t line)
+{
+  if ((!is_any_macro(p)) || (is_c_macro(p))) complain("%s%s[%d]: macro is %s (%s)%s?\n", p, func, line, unchecked_type(p));
+  return(p);
+}
+
+static s7_pointer check_ref_key(s7_pointer p, const char *func, int32_t line)
+{
+  if (!is_symbol_and_keyword(p)) complain("%s%s[%d]: not a keyword: %s (%s)%s?\n", p, func, line, unchecked_type(p));
+  if (strcmp(func, "new_symbol") != 0)
+    {
+      if (global_value(p) != p)
+	{
+	  fprintf(stderr, "%s%s[%d]: keyword %s value is not itself (type: %s)%s\n",
+		  bold_text, func, line, display(p), s7_type_names[unchecked_type(global_value(p))], unbold_text);
+	  if (cur_sc->stop_at_error) abort();
+	}
+      if (in_heap(keyword_symbol_unchecked(p)))
+	fprintf(stderr, "%s%s[%d]: keyword %s symbol is in the heap%s\n", bold_text, func, line, display(p), unbold_text);
+      if (has_odd_bits(p))
+	{char *s; fprintf(stderr, "odd bits: %s\n", s = describe_type_bits(cur_sc, p)); free(s);}
+    }
+  return(p);
+}
+
+static s7_pointer check_ref_ext(s7_pointer p, const char *func, int32_t line)
+{
+  uint8_t typ = unchecked_type(p);
+  check_nref(p, func, line);
+  if (t_ext_p[typ])
+    {
+      fprintf(stderr, "%s%s[%d]: attempt to use (internal) %s cell%s\n", bold_text, func, line, s7_type_names[typ], unbold_text);
+      if (cur_sc->stop_at_error) abort();
+    }
+  return(p);
+}
+
+static s7_pointer check_ref_exs(s7_pointer p, const char *func, int32_t line)
+{
+  uint8_t typ = unchecked_type(p);
+  check_nref(p, func, line);
+  if (t_exs_p[typ])
+    {
+      fprintf(stderr, "%s%s[%d]: attempt to use (internal) %s cell%s\n", bold_text, func, line, s7_type_names[typ], unbold_text);
+      if (cur_sc->stop_at_error) abort();
+    }
+  return(p);
+}
+
+static s7_pointer check_opcode(s7_pointer p, const char *func, int32_t line)
+{
+  s7_int op = (s7_int)(intptr_t)p;
+  if ((op < 0) || (op >= NUM_OPS))
+    {
+      fprintf(stderr, "%s%s[%d]: opcode_t: %" ld64 " == %p?%s\n", bold_text, func, line, op, p, unbold_text);
+      if (cur_sc->stop_at_error) abort();
+    }
+  return(p);
+}
+
+static void check_set_cdr(s7_pointer p, s7_pointer Val, const char *func, int32_t line)
+{
+  if ((is_immutable(p)) && (!in_heap(p)))
+    fprintf(stderr, "%s[%d]: set_cdr target is immutable and not in the heap, %p\n", func, line, p);
+  if ((!in_heap(p)) && (in_heap(Val)))
+    fprintf(stderr, "%s[%d]: set_cdr target is not in the heap, but the new value is, %p %p\n", func, line, p, Val);
+  cdr(p) = Val;
+}
+
+static const char *opt1_role_name(uint64_t role)
+{
+  if (role == OPT1_FAST) return("opt1_fast");
+  if (role == OPT1_CFUNC) return("opt1_cfunc");
+  if (role == OPT1_LAMBDA) return("opt1_lambda");
+  if (role == OPT1_CLAUSE) return("opt1_clause");
+  if (role == OPT1_SYM) return("opt1_sym");
+  if (role == OPT1_PAIR) return("opt1_pair");
+  if (role == OPT1_CON) return("opt1_con");
+  if (role == OPT1_ANY) return("opt1_any");
+  return((role == OPT1_HASH) ? "opt1_hash" : "opt1_unknown");
+}
+
+static const char *opt2_role_name(uint64_t role)
+{
+  if (role == OPT2_FX) return("opt2_fx");
+  if (role == OPT2_FN) return("opt2_fn");
+  if (role == OPT2_KEY) return("opt2_any");
+  if (role == OPT2_SLOW) return("opt2_slow");
+  if (role == OPT2_SYM) return("opt2_sym");
+  if (role == OPT2_PAIR) return("opt2_pair");
+  if (role == OPT2_CON) return("opt2_con");
+  if (role == OPT2_LAMBDA) return("opt2_lambda");
+  if (role == OPT2_DIRECT) return("opt2_direct");
+  if (role == OPT2_INT) return("opt2_int");
+  return((role == OPT2_NAME) ? "opt2_raw_name" : "opt2_unknown");
+}
+
+static const char *opt3_role_name(uint64_t role)
+{
+  if (role == OPT3_ARGLEN) return("opt3_arglen");
+  if (role == OPT3_SYM) return("opt3_sym");
+  if (role == OPT3_CON) return("opt3_con");
+  if (role == OPT3_AND) return("opt3_pair");
+  if (role == OPT3_ANY) return("opt3_any");
+  if (role == OPT3_LET) return("opt3_let");
+  if (role == OPT3_BYTE) return("opt3_byte");
+  if (role == OPT3_DIRECT) return("direct_opt3");
+  if (role == OPT3_LEN) return("opt3_len");
+  if (role == OPT3_INT) return("opt3_int");
+  return((role == OPT3_LOCATION) ? "opt3_location" : "opt3_unknown");
+}
+
+static void show_opt1_bits(s7_pointer p, const char *func, int32_t line, uint64_t role)
+{
+  char *bits = show_debugger_bits(p);
+  fprintf(stderr, "%s%s[%d]%s: opt1: %p->%p wants %s, debugger bits are %" PRIx64 "%s but expects %" ld64,
+	  bold_text, func, line, unbold_text,
+	  p, p->object.cons.opt1, opt1_role_name(role), p->debugger_bits, bits, (s7_int)role);
+  free(bits);
+}
+
+static s7_pointer opt1_1(s7_scheme *sc, s7_pointer p, uint64_t role, const char *func, int32_t line)
+{
+  if ((!opt1_is_set(p)) ||
+      ((!opt1_role_matches(p, role)) &&
+       (role != OPT1_ANY)))
+    {
+      show_opt1_bits(p, func, line, role);
+      if (sc->stop_at_error) abort();
+    }
+  return(p->object.cons.opt1);
+}
+
+static void base_opt1(s7_pointer p, uint64_t role)
+{
+  set_opt1_role(p, role);
+  set_opt1_is_set(p);
+}
+
+static s7_pointer set_opt1_1(s7_pointer p, s7_pointer x, uint64_t role, const char *func, int32_t line)
+{
+  if (((p->debugger_bits & OPT1_MASK) != role) &&
+      ((p->debugger_bits & OPT1_MASK) == OPT1_LAMBDA) &&
+      (role != OPT1_CFUNC))
+    fprintf(stderr, "%s[%d]: opt1_lambda -> %s, op: %s, x: %s,\n    %s\n",
+	    func, line, opt1_role_name(role),
+	    (is_optimized(x)) ? op_names[optimize_op(x)] : "unopt",
+	    display(x), display(p));
+  p->object.cons.opt1 = x;
+  base_opt1(p, role);
+  return(x);
+}
+
+static uint64_t opt1_hash_1(s7_scheme *sc, s7_pointer p, const char *func, int32_t line)
+{
+  if ((!opt1_is_set(p)) || (!opt1_role_matches(p, OPT1_HASH)))
+    {
+      show_opt1_bits(p, func, line, (uint64_t)OPT1_HASH);
+      if (sc->stop_at_error) abort();
+    }
+  return(p->object.sym_cons.hash);
+}
+
+static void set_opt1_hash_1(s7_pointer p, uint64_t x)
+{
+  p->object.sym_cons.hash = x;
+  base_opt1(p, OPT1_HASH);
+}
+
+static void show_opt2_bits(s7_pointer p, const char *func, int32_t line, uint64_t role)
+{
+  char *bits = show_debugger_bits(p);
+  fprintf(stderr, "%s%s[%d]%s: %s opt2: %p->%p wants %s, debugger bits are %" PRIx64 "%s but expects %" ld64 " %s",
+	  bold_text, func, line, unbold_text,
+	  display(p), p, p->object.cons.o2.opt2, opt2_role_name(role), p->debugger_bits, bits, (s7_int)role, opt2_role_name(role));
+  free(bits);
+}
+
+static bool f_call_func_mismatch(const char *func)
+{
+  return((!safe_strcmp(func, "check_and")) &&  /* these reflect set_fx|unchecked where the destination checks for null fx_proc */
+	 (!safe_strcmp(func, "check_or")) &&
+	 (!safe_strcmp(func, "eval")) &&
+	 (!safe_strcmp(func, "set_any_c_np")) &&
+	 (!safe_strcmp(func, "set_any_closure_np")) &&
+	 (!safe_strcmp(func, "optimize_func_two_args")) &&
+	 (!safe_strcmp(func, "optimize_func_many_args")) &&
+	 (!safe_strcmp(func, "optimize_func_three_args")) &&
+	 (!safe_strcmp(func, "fx_c_ff")) &&
+	 (!safe_strcmp(func, "op_map_for_each_fa")) &&
+	 (!safe_strcmp(func, "op_map_for_each_faa")));
+}
+
+static void check_opt2_bits(s7_scheme *sc, s7_pointer p, uint64_t role, const char *func, int32_t line)
+{
+  if (!p)
+    {
+      fprintf(stderr, "%s%s[%d]: opt2 null!\n%s", bold_text, func, line, unbold_text);
+      if (sc->stop_at_error) abort();
+    }
+  if ((!opt2_is_set(p)) ||
+      (!opt2_role_matches(p, role)))
+    {
+      show_opt2_bits(p, func, line, role);
+      if (sc->stop_at_error) abort();
+    }
+}
+
+static s7_pointer opt2_1(s7_scheme *sc, s7_pointer p, uint64_t role, const char *func, int32_t line)
+{
+  check_opt2_bits(sc, p, role, func, line);
+  return(p->object.cons.o2.opt2);
+}
+
+static s7_int opt2_n_1(s7_scheme *sc, s7_pointer p, uint64_t role, const char *func, int32_t line)
+{
+  check_opt2_bits(sc, p, role, func, line);
+  return(p->object.cons.o2.n);
+}
+
+static void base_opt2(s7_pointer p, uint64_t role)
+{
+  set_opt2_role(p, role);
+  set_opt2_is_set(p);
+}
+
+static void set_opt2_1(s7_scheme *sc, s7_pointer p, s7_pointer x, uint64_t role, const char *func, int32_t line)
+{
+  if ((role == OPT2_FX) &&
+      (x == NULL) &&
+      (f_call_func_mismatch(func)))
+    fprintf(stderr, "%s[%d]: set fx_proc for %s to null (%s%s%s)\n", func, line,
+	    string_value(object_to_string_truncated(sc, p)),
+	    ((is_h_optimized(car(p))) && (is_safe_c_op(optimize_op(car(p))))) ? bold_text : "",
+	    op_names[optimize_op(car(p))],
+	    ((is_h_optimized(car(p))) && (is_safe_c_op(optimize_op(car(p))))) ? unbold_text : "");
+  if ((role != OPT2_FX) && (role != OPT2_DIRECT) && (has_fx(p))) /* sometimes opt2_direct just specializes fx */
+    {
+      fprintf(stderr, "%s[%d]: overwrite has_fx: %s %s\n", func, line, opt2_role_name(role), display_truncated(p));
+      if (sc->stop_at_error) abort();
+    }
+  p->object.cons.o2.opt2 = x;
+  base_opt2(p, role);
+}
+
+static void set_opt2_n_1(s7_scheme *unused_sc, s7_pointer p, s7_int x, uint64_t role, const char *unused_func, int32_t unused_line)
+{
+  p->object.cons.o2.n = x;
+  base_opt2(p, role);
+}
+
+static const char *opt2_name_1(s7_scheme *sc, s7_pointer p, const char *func, int32_t line)
+{
+  if ((!opt2_is_set(p)) ||
+      (!opt2_role_matches(p, OPT2_NAME)))
+    {
+      show_opt2_bits(p, func, line, (uint64_t)OPT2_NAME);
+      if (sc->stop_at_error) abort();
+    }
+  return(p->object.sym_cons.fstr);
+}
+
+static void set_opt2_name_1(s7_pointer p, const char *str)
+{
+  p->object.sym_cons.fstr = str;
+  base_opt2(p, OPT2_NAME);
+}
+
+static void show_opt3_bits(s7_pointer p, const char *func, int32_t line, uint64_t role)
+{
+  char *bits = show_debugger_bits(p);
+  fprintf(stderr, "%s%s[%d]%s: opt3: %s %" PRIx64 "%s", bold_text, func, line, unbold_text, opt3_role_name(role), p->debugger_bits, bits);
+  free(bits);
+}
+
+static void check_opt3_bits(s7_scheme *sc, s7_pointer p, uint64_t role, const char *func, int32_t line)
+{
+  if (!p)
+    {
+      fprintf(stderr, "%s%s[%d]: opt3 null!\n%s", bold_text, func, line, unbold_text);
+      if (sc->stop_at_error) abort();
+    }
+  if ((!opt3_is_set(p)) ||
+      (!opt3_role_matches(p, role)))
+    {
+      show_opt3_bits(p, func, line, role);
+      if (sc->stop_at_error) abort();
+    }
+}
+
+static s7_pointer opt3_1(s7_scheme *sc, s7_pointer p, uint64_t role, const char *func, int32_t line)
+{
+  check_opt3_bits(sc, p, role, func, line);
+  return(p->object.cons.o3.opt3);
+}
+
+static s7_int opt3_n_1(s7_scheme *sc, s7_pointer p, uint64_t role, const char *func, int32_t line)
+{
+  check_opt3_bits(sc, p, role, func, line);
+  return(p->object.cons.o3.n);
+}
+
+static void base_opt3(s7_pointer p, uint64_t role)
+{
+  set_opt3_role(p, role);
+  set_opt3_is_set(p);
+}
+
+static void set_opt3_1(s7_pointer p, s7_pointer x, uint64_t role)
+{
+  clear_type_bit(p, T_LOCATION);
+  p->object.cons.o3.opt3 = x;
+  base_opt3(p, role);
+}
+
+static void set_opt3_n_1(s7_pointer p, s7_int x, uint64_t role)
+{
+  clear_type_bit(p, T_LOCATION);
+  p->object.cons.o3.n = x;
+  base_opt3(p, role);
+}
+
+static uint8_t opt3_byte_1(s7_scheme *sc, s7_pointer p, uint64_t role, const char *func, int32_t line)
+{
+  check_opt3_bits(sc, p, role, func, line);
+  return(p->object.cons.o3.opt_type);
+}
+
+static void set_opt3_byte_1(s7_pointer p, uint8_t x, uint64_t role, const char *unused_func, int32_t unused_line)
+{
+  clear_type_bit(p, T_LOCATION);
+  p->object.cons.o3.opt_type = x;
+  base_opt3(p, role);
+}
+
+static uint64_t opt3_location_1(s7_scheme *sc, s7_pointer p, const char *func, int32_t line)
+{
+  if ((!opt3_is_set(p)) ||
+      ((p->debugger_bits & OPT3_LOCATION) == 0) ||
+      (!has_location(p)))
+    {
+      show_opt3_bits(p, func, line, (uint64_t)OPT3_LOCATION);
+      if (sc->stop_at_error) abort();
+    }
+  return(p->object.sym_cons.location); /* don't use pair_location macro here or below (infinite recursion if S7_DEBUGGING via opt3_location_1) */
+}
+
+static void set_opt3_location_1(s7_pointer p, uint64_t x)
+{
+  p->object.sym_cons.location = x;
+  (p)->debugger_bits = (OPT3_LOCATION | (p->debugger_bits & ~OPT3_LEN)); /* turn on line, cancel len */
+  set_opt3_is_set(p);
+}
+
+static uint64_t opt3_len_1(s7_scheme *sc, s7_pointer p, const char *func, int32_t line)
+{
+  if ((!opt3_is_set(p)) ||
+      ((p->debugger_bits & OPT3_LEN) == 0) ||
+      (has_location(p)))
+    {
+      show_opt3_bits(p, func, line, (uint64_t)OPT3_LEN);
+      if (sc->stop_at_error) abort();
+    }
+  return(p->object.sym_cons.location);
+}
+
+static void set_opt3_len_1(s7_pointer p, uint64_t x)
+{
+  clear_type_bit(p, T_LOCATION);
+  p->object.sym_cons.location = x;
+  (p)->debugger_bits = (OPT3_LEN | (p->debugger_bits & ~(OPT3_LOCATION)));
+  set_opt3_is_set(p);
+}
+
+static void print_debugging_state(s7_scheme *sc, s7_pointer obj, s7_pointer port)
+{
+  /* show current state, current allocated state */
+  char *allocated_bits, *str;
+  int64_t save_full_type = full_type(obj);
+  s7_int len, nlen;
+  const char *excl_name = (is_free(obj)) ? "free cell!" : "unknown object!";
+  block_t *b;
+  char *current_bits = describe_type_bits(sc, obj);
+
+  set_full_type(obj, obj->alloc_type);
+  allocated_bits = describe_type_bits(sc, obj);
+  set_full_type(obj, save_full_type);
+
+  len = safe_strlen(excl_name) + safe_strlen(current_bits) + safe_strlen(allocated_bits) + safe_strlen(obj->alloc_func) + 512;
+  b = mallocate(sc, len);
+  str = (char *)block_data(b);
+  nlen = snprintf(str, len,
+		  "\n<%s %s,\n  alloc: %s[%d] %s, %d uses>", excl_name, current_bits,
+		  obj->alloc_func, obj->alloc_line, allocated_bits, obj->uses);
+  free(current_bits);
+  free(allocated_bits);
+  if (is_null(port))
+    fprintf(stderr, "%p: %s\n", obj, str);
+  else port_write_string(port)(sc, str, clamp_length(nlen, len), port);
+  liberate(sc, b);
+}
+
+static s7_pointer check_null_sym(s7_scheme *sc, s7_pointer p, s7_pointer sym, int32_t line, const char *func)
+{
+  if (!p)
+    {
+      s7_pointer slot = symbol_to_local_slot(sc, sym, sc->curlet);
+      char *s = describe_type_bits(sc, sym);
+      fprintf(stderr, "%s%s[%d]: %s unbound%s\n", bold_text, func, line, symbol_name(sym), unbold_text);
+      fprintf(stderr, "  symbol_id: %" ld64 ", let_id: %" ld64 ", bits: %s", symbol_id(sym), let_id(sc->curlet), s);
+      free(s);
+      if (is_slot(slot)) fprintf(stderr, ", slot: %s", display(slot));
+      fprintf(stderr, "\n");
+      if (sc->stop_at_error) abort();
+    }
+  return(p);
+}
+#endif /* S7_DEBUGGING */
+/* -------------------------------- end internal debugging apparatus -------------------------------- */
+
+
+static s7_pointer set_elist_1(s7_scheme *sc, s7_pointer x1)
+{
+  set_car(sc->elist_1, x1);
+  return(sc->elist_1);
+}
+
+static s7_pointer set_elist_2(s7_scheme *sc, s7_pointer x1, s7_pointer x2)
+{
+  set_car(sc->elist_2, x1);
+  set_cadr(sc->elist_2, x2);
+  return(sc->elist_2);
+}
+
+static s7_pointer set_elist_3(s7_scheme *sc, s7_pointer x1, s7_pointer x2, s7_pointer x3)
+{
+  s7_pointer p = sc->elist_3;
+  set_car(p, x1); p = cdr(p);
+  set_car(p, x2); p = cdr(p);
+  set_car(p, x3);
+  return(sc->elist_3);
+}
+
+static s7_pointer set_elist_4(s7_scheme *sc, s7_pointer x1, s7_pointer x2, s7_pointer x3, s7_pointer x4)
+{
+  s7_pointer p = sc->elist_4;
+  set_car(p, x1); p = cdr(p);
+  set_car(p, x2); p = cdr(p);
+  set_car(p, x3); p = cdr(p);
+  set_car(p, x4);
+  return(sc->elist_4);
+}
+
+static s7_pointer set_elist_5(s7_scheme *sc, s7_pointer x1, s7_pointer x2, s7_pointer x3, s7_pointer x4, s7_pointer x5)
+{
+  set_car(sc->elist_5, x1);
+  set_elist_4(sc, x2, x3, x4, x5);
+  return(sc->elist_5);
+}
+
+static s7_pointer set_elist_6(s7_scheme *sc, s7_pointer x1, s7_pointer x2, s7_pointer x3, s7_pointer x4, s7_pointer x5, s7_pointer x6)
+{
+  set_car(sc->elist_6, x1);
+  set_elist_5(sc, x2, x3, x4, x5, x6);
+  return(sc->elist_6);
+}
+
+static s7_pointer set_elist_7(s7_scheme *sc, s7_pointer x1, s7_pointer x2, s7_pointer x3, s7_pointer x4, s7_pointer x5, s7_pointer x6, s7_pointer x7)
+{
+  set_car(sc->elist_7, x1);
+  set_elist_6(sc, x2, x3, x4, x5, x6, x7);
+  return(sc->elist_7);
+}
+
+static s7_pointer set_wlist_3(s7_pointer lst, s7_pointer x1, s7_pointer x2, s7_pointer x3)
+{
+  s7_pointer p = lst;
+  set_car(p, x1); p = cdr(p);
+  set_car(p, x2); p = cdr(p);
+  set_car(p, x3);
+  return(lst);
+}
+
+static s7_pointer set_wlist_4(s7_pointer lst, s7_pointer x1, s7_pointer x2, s7_pointer x3, s7_pointer x4)
+{
+  s7_pointer p = lst;
+  set_car(p, x1); p = cdr(p);
+  set_car(p, x2); p = cdr(p);
+  set_car(p, x3); p = cdr(p);
+  set_car(p, x4);
+  return(lst);
+}
+
+static s7_pointer set_mlist_1(s7_scheme *sc, s7_pointer x1)
+{
+  set_car(sc->mlist_1, x1);
+  return(sc->mlist_1);
+}
+
+static s7_pointer set_mlist_2(s7_scheme *sc, s7_pointer x1, s7_pointer x2) /* mlist_3 saves 3 in tmock -- see ~/old/s7-mlist_3.c */
+{
+  set_car(sc->mlist_2, x1);
+  set_cadr(sc->mlist_2, x2);
+  return(sc->mlist_2);
+}
+
+static s7_pointer set_plist_1(s7_scheme *sc, s7_pointer x1)
+{
+  set_car(sc->plist_1, x1);
+  return(sc->plist_1);
+}
+
+static s7_pointer set_plist_2(s7_scheme *sc, s7_pointer x1, s7_pointer x2)
+{
+  set_car(sc->plist_2, x1);
+  set_car(sc->plist_2_2, x2);
+  return(sc->plist_2);
+}
+
+static s7_pointer set_plist_3(s7_scheme *sc, s7_pointer x1, s7_pointer x2, s7_pointer x3)
+{
+  return(set_wlist_3(sc->plist_3, x1, x2, x3));
+}
+
+static s7_pointer set_plist_4(s7_scheme *sc, s7_pointer x1, s7_pointer x2, s7_pointer x3, s7_pointer x4)
+{
+  return(set_wlist_4(sc->plist_4, x1, x2, x3, x4));
+}
+
+static s7_pointer set_qlist_2(s7_scheme *sc, s7_pointer x1, s7_pointer x2) /* let_ref_fallback */
+{
+  set_car(sc->qlist_2, x1);
+  set_cadr(sc->qlist_2, x2);
+  return(sc->qlist_2);
+}
+
+static s7_pointer set_qlist_3(s7_scheme *sc, s7_pointer x1, s7_pointer x2, s7_pointer x3) /* let_set_fallback */
+{
+  return(set_wlist_3(sc->qlist_3, x1, x2, x3));
+}
+
+static s7_pointer set_clist_1(s7_scheme *sc, s7_pointer x1) /* for c_object length method etc, a "weak" list */
+{
+  set_car(sc->clist_1, x1);
+  return(sc->clist_1);
+}
+
+static s7_pointer set_clist_2(s7_scheme *sc, s7_pointer x1, s7_pointer x2) /* for c_object equal method etc, a "weak" list */
+{
+  set_car(sc->clist_2, x1);
+  set_cadr(sc->clist_2, x2);
+  return(sc->clist_2);
+}
+
+static s7_pointer set_dlist_1(s7_scheme *sc, s7_pointer x1) /* another like clist: temp usage, "weak" (not gc_marked), but semipermanent list */
+{
+  set_car(sc->dlist_1, x1);
+  return(sc->dlist_1);
+}
+
+static s7_pointer set_ulist_1(s7_scheme *sc, s7_pointer x1, s7_pointer x2)
+{
+  set_car(sc->u1_1, x1);
+  unchecked_set_cdr(sc->u1_1, x2);
+  return(sc->u1_1);
+}
+
+
+/* ---------------- error handlers ---------------- */
+static const char *make_type_name(s7_scheme *sc, const char *name, article_t article)
+{
+  s7_int i, slen = safe_strlen(name);
+  s7_int len = slen + 8;
+  if (len > sc->typnam_len)
+    {
+      if (sc->typnam) free(sc->typnam);
+      sc->typnam = (char *)Malloc(len);
+      sc->typnam_len = len;
+    }
+  if (article == INDEFINITE_ARTICLE)
+    {
+      i = 1;
+      sc->typnam[0] = 'a';
+      if ((name[0] == 'a') || (name[0] == 'e') || (name[0] == 'i') || (name[0] == 'o') || (name[0] == 'u'))
+	sc->typnam[i++] = 'n';
+      sc->typnam[i++] = ' ';
+    }
+  else i = 0;
+  memcpy((void *)(sc->typnam + i), (const void *)name, slen);
+  sc->typnam[i + slen] = '\0';
+  return(sc->typnam);
+}
+
+static const char *type_name_from_type(int32_t typ, article_t article)
+{
+  /* if the type enum never changed, this could just be an array lookup, but it doesn't matter -- this function isn't called much */
+  switch (typ)
+    {
+    case T_FREE:            return((article == NO_ARTICLE) ? "free-cell"         : "a free cell");
+    case T_NIL:             return("nil");
+    case T_UNUSED:          return((article == NO_ARTICLE) ? "#<unused>"         : "the unused object");
+    case T_EOF:             return((article == NO_ARTICLE) ? "#<eof>"            : "the end-of-file object");
+    case T_UNSPECIFIED:     return((article == NO_ARTICLE) ? "#<unspecified>"    : "the unspecified object");
+    case T_UNDEFINED:       return((article == NO_ARTICLE) ? "undefined"         : "an undefined object");
+    case T_BOOLEAN:         return("boolean");
+    case T_STRING:          return((article == NO_ARTICLE) ? "string"            : "a string");
+    case T_BYTE_VECTOR:     return((article == NO_ARTICLE) ? "byte-vector"       : "a byte-vector");
+    case T_SYMBOL:          return((article == NO_ARTICLE) ? "symbol"            : "a symbol");
+    case T_SYNTAX:          return((article == NO_ARTICLE) ? "syntax"            : "syntactic");
+    case T_PAIR:            return((article == NO_ARTICLE) ? "pair"              : "a pair");
+    case T_GOTO:            return((article == NO_ARTICLE) ? "goto"              : "a goto (from call-with-exit)");
+    case T_CONTINUATION:    return((article == NO_ARTICLE) ? "continuation"      : "a continuation");
+    case T_C_RST_NO_REQ_FUNCTION:
+    case T_C_FUNCTION:      return((article == NO_ARTICLE) ? "c-function"        : "a c-function");
+    case T_C_FUNCTION_STAR: return((article == NO_ARTICLE) ? "c-function*"       : "a c-function*");
+    case T_CLOSURE:         return((article == NO_ARTICLE) ? "function"          : "a function");
+    case T_CLOSURE_STAR:    return((article == NO_ARTICLE) ? "function*"         : "a function*");
+    case T_C_MACRO:         return((article == NO_ARTICLE) ? "c-macro"           : "a c-macro");
+    case T_C_POINTER:       return((article == NO_ARTICLE) ? "c-pointer"         : "a c-pointer");
+    case T_CHARACTER:       return((article == NO_ARTICLE) ? "character"         : "a character");
+    case T_VECTOR:          return((article == NO_ARTICLE) ? "vector"            : "a vector");
+    case T_INT_VECTOR:      return((article == NO_ARTICLE) ? "int-vector"        : "an int-vector");
+    case T_FLOAT_VECTOR:    return((article == NO_ARTICLE) ? "float-vector"      : "a float-vector");
+    case T_MACRO_STAR:      return((article == NO_ARTICLE) ? "macro*"            : "a macro*");
+    case T_MACRO:           return((article == NO_ARTICLE) ? "macro"             : "a macro");
+    case T_BACRO_STAR:      return((article == NO_ARTICLE) ? "bacro*"            : "a bacro*");
+    case T_BACRO:           return((article == NO_ARTICLE) ? "bacro"             : "a bacro");
+    case T_CATCH:           return((article == NO_ARTICLE) ? "catch"             : "a catch");
+    case T_STACK:           return((article == NO_ARTICLE) ? "stack"             : "a stack");
+    case T_DYNAMIC_WIND:    return((article == NO_ARTICLE) ? "dynamic-wind"      : "a dynamic-wind");
+    case T_HASH_TABLE:      return((article == NO_ARTICLE) ? "hash-table"        : "a hash-table");
+    case T_ITERATOR:        return((article == NO_ARTICLE) ? "iterator"          : "an iterator");
+    case T_LET:             return((article == NO_ARTICLE) ? "let"               : "a let");
+    case T_COUNTER:         return((article == NO_ARTICLE) ? "internal-counter"  : "an internal counter");
+    case T_RANDOM_STATE:    return((article == NO_ARTICLE) ? "random-state"      : "a random-state");
+    case T_SLOT:            return((article == NO_ARTICLE) ? "slot"              : "a slot (variable binding)");
+    case T_INTEGER:         return((article == NO_ARTICLE) ? "integer"           : "an integer");
+    case T_RATIO:           return((article == NO_ARTICLE) ? "ratio"             : "a ratio");
+    case T_REAL:            return((article == NO_ARTICLE) ? "real"              : "a real");
+    case T_COMPLEX:         return((article == NO_ARTICLE) ? "complex-number"    : "a complex number");
+    case T_BIG_INTEGER:     return((article == NO_ARTICLE) ? "big-integer"       : "a big integer");
+    case T_BIG_RATIO:       return((article == NO_ARTICLE) ? "big-ratio"         : "a big ratio");
+    case T_BIG_REAL:        return((article == NO_ARTICLE) ? "big-real"          : "a big real");
+    case T_BIG_COMPLEX:     return((article == NO_ARTICLE) ? "big-complex-number": "a big complex number");
+    case T_INPUT_PORT:      return((article == NO_ARTICLE) ? "input-port"        : "an input port");
+    case T_OUTPUT_PORT:     return((article == NO_ARTICLE) ? "output-port"       : "an output port");
+    case T_C_OBJECT:        return((article == NO_ARTICLE) ? "c-object"          : "a c_object");
+    }
+  return(NULL);
+}
+
+static s7_pointer find_let(s7_scheme *sc, s7_pointer obj)
+{
+  if (is_let(obj)) return(obj);
+  if (has_closure_let(obj)) return(closure_let(obj));
+  switch (type(obj))
+    {
+    case T_C_OBJECT:
+      return(c_object_let(obj));
+    case T_C_POINTER:
+      if ((is_let(c_pointer_info(obj))) &&
+	  (c_pointer_info(obj) != sc->rootlet))
+	return(c_pointer_info(obj));
+    case T_CONTINUATION: case T_GOTO:
+    case T_C_MACRO: case T_C_FUNCTION_STAR: case T_C_FUNCTION: case T_C_RST_NO_REQ_FUNCTION:
+      return(sc->rootlet);
+      /* what about cload into local? there's no way for a c-func to get its definition env? (s7_define sets global from local_slot if env==shadow_rootlet)
+       *   (*libc* 'memcpy): memcpy, ((rootlet) 'memcpy): #<undefined>, (with-let (rootlet) memcpy): error (undefined), (with-let *libc* memcpy): memcpy
+       *   but how to get *libc* from (funclet (*libc* 'memcpy))
+       *   currently (*libc* 'sqrt) is #_sqrt (i.e. s7's) whereas (*libm* 'sqrt) is libm's (i.e. s7__sqrt in libm_s7.c) -- confusing
+       *   perhaps add a funclet field to c_proc_t?
+       */
+    }
+  return(sc->nil);
+}
+
+static inline s7_pointer lookup_slot_from(s7_pointer symbol, s7_pointer e);
+
+static s7_pointer find_method(s7_scheme *sc, s7_pointer let, s7_pointer symbol)
+{
+  s7_pointer slot;
+  if (symbol_id(symbol) == 0) /* this means the symbol has never been used locally, so how can it be a method? */
+    return(sc->undefined);
+  slot = lookup_slot_from(symbol, let);
+  if (slot != global_slot(symbol))
+    return(slot_value(slot));
+  return(sc->undefined);
+}
+
+static s7_pointer find_method_with_let(s7_scheme *sc, s7_pointer let, s7_pointer symbol)
+{
+  return(find_method(sc, find_let(sc, let), symbol));
+}
+
+static const char *type_name(s7_scheme *sc, s7_pointer arg, article_t article)
+{
+  switch (unchecked_type(arg))
+    {
+    case T_C_OBJECT:    return(make_type_name(sc, string_value(c_object_scheme_name(sc, arg)), article));
+    case T_INPUT_PORT:  return(make_type_name(sc, (is_file_port(arg)) ? "input file port" : ((is_string_port(arg)) ? "input string port" : "input port"), article));
+    case T_OUTPUT_PORT: return(make_type_name(sc, (is_file_port(arg)) ? "output file port" : ((is_string_port(arg)) ? "output string port" : "output port"), article));
+    case T_LET:
+      if (has_active_methods(sc, arg))
+	{
+	  s7_pointer class_name = find_method(sc, arg, sc->class_name_symbol);
+	  if (is_symbol(class_name))
+	    return(make_type_name(sc, symbol_name(class_name), article));
+	}
+    default:
+      {
+	const char *str = type_name_from_type(unchecked_type(arg), article);
+	if (str) return(str);
+      }}
+  return("messed up object");
+}
+
+static s7_pointer object_type_name(s7_scheme *sc, s7_pointer x)
+{
+  uint8_t typ;
+  if (has_active_methods(sc, x))
+    {
+      s7_pointer p = find_method_with_let(sc, x, sc->class_name_symbol);
+      if (is_symbol(p))	return(symbol_name_cell(p));
+    }
+  typ = type(x);
+  if (typ < NUM_TYPES)
+    {
+      if (typ == T_C_OBJECT) return(c_object_scheme_name(sc, x));
+      return(sc->type_names[typ]);
+    }
+  return(wrap_string(sc, "unknown type!", 13));
+}
+
+static s7_pointer type_name_string(s7_scheme *sc, s7_pointer arg)
+{
+  if (type(arg) < NUM_TYPES)
+    {
+      s7_pointer p = sc->type_names[type(arg)]; /* these use INDEFINITE_ARTICLE */
+      if (is_string(p)) return(p);
+    }
+  return(s7_make_string_wrapper(sc, type_name(sc, arg, INDEFINITE_ARTICLE)));
+}
+
+
+static noreturn void sole_arg_wrong_type_error_nr(s7_scheme *sc, s7_pointer caller, s7_pointer arg, s7_pointer typ)
+{
+  set_wlist_4(cdr(sc->sole_arg_wrong_type_info), caller, arg, object_type_name(sc, arg), typ);
+  error_nr(sc, sc->wrong_type_arg_symbol, sc->sole_arg_wrong_type_info);
+}
+
+static /* Inline */ noreturn void wrong_type_error_nr(s7_scheme *sc, s7_pointer caller, s7_int arg_num, s7_pointer arg, s7_pointer typ)
+{
+  s7_pointer p = cdr(sc->wrong_type_arg_info);  /* info list is '(format_string caller arg_n arg type_name descr) */
+  set_car(p, caller);                    p = cdr(p);
+  set_car(p, (is_small_int(arg_num)) ? small_int(arg_num) : wrap_integer(sc, arg_num)); p = cdr(p);
+  set_car(p, arg);                       p = cdr(p);
+  set_car(p, object_type_name(sc, arg)); p = cdr(p);
+  set_car(p, typ);
+  error_nr(sc, sc->wrong_type_arg_symbol, sc->wrong_type_arg_info);
+}
+
+s7_pointer s7_wrong_type_arg_error(s7_scheme *sc, const char *caller, s7_int arg_n, s7_pointer arg, const char *descr)
+{
+  if (arg_n > 0)
+    wrong_type_error_nr(sc, wrap_string(sc, caller, safe_strlen(caller)), arg_n, arg, wrap_string(sc, descr, safe_strlen(descr)));
+  sole_arg_wrong_type_error_nr(sc, wrap_string(sc, caller, safe_strlen(caller)), arg, wrap_string(sc, descr, safe_strlen(descr)));
+  return(sc->wrong_type_arg_symbol);
+}
+
+s7_pointer s7_wrong_type_error(s7_scheme *sc, s7_pointer caller, s7_int arg_n, s7_pointer arg, s7_pointer descr)
+{
+  if (arg_n > 0) wrong_type_error_nr(sc, caller, arg_n, arg, descr);
+  sole_arg_wrong_type_error_nr(sc, caller, arg, descr);
+  return(sc->wrong_type_arg_symbol); /* never happens */
+}
+
+static noreturn void sole_arg_out_of_range_error_nr(s7_scheme *sc, s7_pointer caller, s7_pointer arg, s7_pointer descr)
+{
+  set_wlist_3(cdr(sc->sole_arg_out_of_range_info), caller, arg, descr);
+  error_nr(sc, sc->out_of_range_symbol, sc->sole_arg_out_of_range_info);
+}
+
+static noreturn void out_of_range_error_nr(s7_scheme *sc, s7_pointer caller, s7_pointer arg_n, s7_pointer arg, s7_pointer descr)
+{
+  set_wlist_4(cdr(sc->out_of_range_info), caller, arg_n, arg, descr);
+  error_nr(sc, sc->out_of_range_symbol, sc->out_of_range_info);
+}
+
+s7_pointer s7_out_of_range_error(s7_scheme *sc, const char *caller, s7_int arg_n, s7_pointer arg, const char *descr)
+{
+  if (arg_n > 0)
+    {
+      set_wlist_4(cdr(sc->out_of_range_info), wrap_string(sc, caller, safe_strlen(caller)),
+		  wrap_integer(sc, arg_n), arg, wrap_string(sc, descr, safe_strlen(descr)));
+      error_nr(sc, sc->out_of_range_symbol, sc->out_of_range_info);
+    }
+  set_wlist_3(cdr(sc->sole_arg_out_of_range_info), wrap_string(sc, caller, safe_strlen(caller)),
+	      arg, wrap_string(sc, descr, safe_strlen(descr)));
+  error_nr(sc, sc->out_of_range_symbol, sc->sole_arg_out_of_range_info);
+  return(sc->out_of_range_symbol);
+}
+
+static noreturn void wrong_number_of_arguments_error_nr(s7_scheme *sc, const char *errmsg, s7_int len, s7_pointer args)
+{
+  error_nr(sc, sc->wrong_number_of_args_symbol, set_elist_2(sc, wrap_string(sc, errmsg, len), args));
+}
+
+s7_pointer s7_wrong_number_of_args_error(s7_scheme *sc, const char *caller, s7_pointer args)
+{
+  error_nr(sc, sc->wrong_number_of_args_symbol,
+	   set_elist_2(sc, wrap_string(sc, caller, safe_strlen(caller)), args)); /* "caller" includes the format directives */
+  return(sc->wrong_number_of_args_symbol);
+}
+
+
+static noreturn void syntax_error_nr(s7_scheme *sc, const char *errmsg, s7_int len, s7_pointer obj)
+{
+  error_nr(sc, sc->syntax_error_symbol, set_elist_2(sc, wrap_string(sc, errmsg, len), obj));
+}
+
+static noreturn void syntax_error_with_caller_nr(s7_scheme *sc, const char *errmsg, s7_int len, s7_pointer caller, s7_pointer obj)
+{
+  error_nr(sc, sc->syntax_error_symbol, set_elist_3(sc, wrap_string(sc, errmsg, len), caller, obj));
+}
+
+static noreturn void syntax_error_with_caller2_nr(s7_scheme *sc, const char *errmsg, s7_int len, s7_pointer caller, s7_pointer name, s7_pointer obj)
+{
+  error_nr(sc, sc->syntax_error_symbol, set_elist_4(sc, wrap_string(sc, errmsg, len), caller, name, obj));
+}
+
+static s7_pointer make_symbol(s7_scheme *sc, const char *name, s7_int len); /* calls new_symbol */
+#define make_symbol_with_strlen(Sc, Name) make_symbol(Sc, Name, safe_strlen(Name))
+
+static s7_pointer missing_method_class_name(s7_scheme *sc, s7_pointer obj)
+{
+  s7_pointer class_name = find_method(sc, obj, sc->class_name_symbol);
+  if (is_symbol(class_name)) return(class_name);
+  return(sc->is_openlet_symbol);
+}
+
+static noreturn void missing_method_error_nr(s7_scheme *sc, s7_pointer method, s7_pointer obj)
+{
+  error_nr(sc, sc->missing_method_symbol,
+	   set_elist_4(sc, wrap_string(sc, "~S method is not defined in ~A ~A", 33), method,
+		       (is_c_object(obj)) ? c_object_scheme_name(sc, obj) :
+                         (((is_let(obj)) && (is_openlet(obj))) ? missing_method_class_name(sc, obj) :
+                          s7_make_string_wrapper(sc, type_name(sc, obj, NO_ARTICLE))),
+		       object_to_string_truncated(sc, obj)));
+}
+
+static noreturn void immutable_object_error_nr(s7_scheme *sc, s7_pointer info) {error_nr(sc, sc->immutable_error_symbol, info);}
+
+
+/* -------- method handlers -------- */
+s7_pointer s7_method(s7_scheme *sc, s7_pointer obj, s7_pointer method)
+{
+  if (has_active_methods(sc, obj)) return(find_method_with_let(sc, obj, method));
+  return(sc->undefined);
+}
+
+/* if a method is shadowing a built-in like abs, it should expect the same args as abs and behave the same -- no multiple values etc */
+#define check_method(Sc, Obj, Method, Args)		\
+  {							\
+    s7_pointer func;					\
+    if ((has_active_methods(Sc, Obj)) &&				\
+	((func = find_method_with_let(Sc, Obj, Method)) != Sc->undefined)) \
+      return(s7_apply_function(Sc, func, Args)); \
+  }
+
+static s7_pointer apply_boolean_method(s7_scheme *sc, s7_pointer obj, s7_pointer method)
+{
+  s7_pointer func = find_method_with_let(sc, obj, method);
+  if (func == sc->undefined) return(sc->F);
+  return(s7_apply_function(sc, func, set_mlist_1(sc, obj))); /* plist here and below will probably not work (_pp case known bad) */
+}
+
+/* this is a macro mainly to simplify the Checker handling */
+#define check_boolean_method(Sc, Checker, Method, Args)	       \
+  {							       \
+    s7_pointer p = car(Args);				       \
+    if (Checker(p)) return(Sc->T);			       \
+    if (!has_active_methods(Sc, p)) return(Sc->F);	       \
+    return(apply_boolean_method(Sc, p, Method));	       \
+  }
+
+static s7_pointer apply_method_closure(s7_scheme *sc, s7_pointer func, s7_pointer args);
+
+static s7_pointer find_and_apply_method(s7_scheme *sc, s7_pointer obj, s7_pointer sym, s7_pointer args) /* slower if inline */
+{
+  s7_pointer func = find_method_with_let(sc, obj, sym);
+  if (is_closure(func)) return(apply_method_closure(sc, func, args));
+  if (func == sc->undefined) missing_method_error_nr(sc, sym, obj);
+  if ((S7_DEBUGGING) && (func == global_value(sym))) fprintf(stderr, "loop in %s?\n", __func__);
+  return(s7_apply_function(sc, func, args));
+}
+
+static s7_pointer method_or_bust(s7_scheme *sc, s7_pointer obj, s7_pointer method, s7_pointer args, s7_pointer typ, int32_t num)
+{
+  if (!has_active_methods(sc, obj)) wrong_type_error_nr(sc, method, num, obj, typ);
+  return(find_and_apply_method(sc, obj, method, args));
+}
+
+static s7_pointer mutable_method_or_bust(s7_scheme *sc, s7_pointer obj, s7_pointer method, s7_pointer args, s7_pointer typ, int32_t num)
+{
+  if (has_active_methods(sc, obj)) return(find_and_apply_method(sc, obj, method, args));
+  if (sc->type_names[type(obj)] != typ) wrong_type_error_nr(sc, method, num, obj, typ);
+  if (!is_immutable(obj)) wrong_type_error_nr(sc, method, num, obj, typ);
+  immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, method, obj));
+  return(NULL);
+}
+
+static s7_pointer mutable_method_or_bust_ppp(s7_scheme *sc, s7_pointer obj, s7_pointer method,
+					     s7_pointer x1, s7_pointer x2, s7_pointer x3, s7_pointer typ, int32_t num)
+{
+  return(mutable_method_or_bust(sc, obj, method, set_qlist_3(sc, x1, x2, x3), typ, num)); /* was list_3, plist_3 not safe */
+}
+
+static s7_pointer method_or_bust_p(s7_scheme *sc, s7_pointer obj, s7_pointer method, s7_pointer typ)
+{
+  if (!has_active_methods(sc, obj)) sole_arg_wrong_type_error_nr(sc, method, obj, typ);
+  return(find_and_apply_method(sc, obj, method, set_mlist_1(sc, obj)));
+}
+
+static s7_pointer method_or_bust_pp(s7_scheme *sc, s7_pointer obj, s7_pointer method, s7_pointer x1, s7_pointer x2, s7_pointer typ, int32_t num)
+{
+  if (!has_active_methods(sc, obj)) wrong_type_error_nr(sc, method, num, obj, typ);
+  return(find_and_apply_method(sc, obj, method, set_mlist_2(sc, x1, x2)));
+}
+
+static s7_pointer method_or_bust_ppp(s7_scheme *sc, s7_pointer obj, s7_pointer method,
+				     s7_pointer x1, s7_pointer x2, s7_pointer x3, s7_pointer typ, int32_t num)
+{
+  if (!has_active_methods(sc, obj)) wrong_type_error_nr(sc, method, num, obj, typ);
+  return(find_and_apply_method(sc, obj, method, set_qlist_3(sc, x1, x2, x3))); /* was list_3, plist not safe */
+}
+
+static s7_pointer method_or_bust_with_type_and_loc_pp(s7_scheme *sc, s7_pointer obj, s7_pointer method,
+						      s7_pointer x1, s7_pointer x2, s7_pointer typ, int32_t num)
+{
+  int32_t loc = sc->error_argnum + num;
+  sc->error_argnum = 0;
+  if (!has_active_methods(sc, obj)) wrong_type_error_nr(sc, method, loc, obj, typ);
+  return(find_and_apply_method(sc, obj, method, set_mlist_2(sc, x1, x2)));
+}
+
+static s7_pointer method_or_bust_with_type_pi(s7_scheme *sc, s7_pointer obj, s7_pointer method,
+					      s7_pointer x1, s7_int x2, s7_pointer typ, int32_t num)
+{
+  if (!has_active_methods(sc, obj)) wrong_type_error_nr(sc, method, num, obj, typ);
+  return(find_and_apply_method(sc, obj, method, set_mlist_2(sc, x1, make_integer(sc, x2))));
+}
+
+static s7_pointer method_or_bust_with_type_pf(s7_scheme *sc, s7_pointer obj, s7_pointer method,
+					      s7_pointer x1, s7_double x2, s7_pointer typ, int32_t num)
+{
+  if (!has_active_methods(sc, obj)) wrong_type_error_nr(sc, method, num, obj, typ);
+  return(find_and_apply_method(sc, obj, method, set_mlist_2(sc, x1, make_real(sc, x2))));
+}
+
+static s7_pointer sole_arg_method_or_bust(s7_scheme *sc, s7_pointer obj, s7_pointer method, s7_pointer args, s7_pointer typ)
+{
+  if (!has_active_methods(sc, obj))  sole_arg_wrong_type_error_nr(sc, method, obj, typ);
+  return(find_and_apply_method(sc, obj, method, args));
+}
+
+
+/* -------------------------------- constants -------------------------------- */
+/* #f and #t */
+s7_pointer s7_f(s7_scheme *sc) {return(sc->F);}
+s7_pointer s7_t(s7_scheme *sc) {return(sc->T);}
+
+
+/* () */
+s7_pointer s7_nil(s7_scheme *sc) {return(sc->nil);}     /* should this be "s7_null" ? */
+bool s7_is_null(s7_scheme *sc, s7_pointer p) {return(is_null(p));}
+static bool is_null_b_p(s7_pointer p) {return(type(p) == T_NIL);} /* faster than b_7p because opt_b_p is faster */
+
+static s7_pointer g_is_null(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_null "(null? obj) returns #t if obj is the empty list"
+  #define Q_is_null sc->pl_bt
+  check_boolean_method(sc, is_null, sc->is_null_symbol, args);
+}
+
+
+/* #<undefined> and #<unspecified> */
+s7_pointer s7_undefined(s7_scheme *sc)       {return(sc->undefined);}
+s7_pointer s7_unspecified(s7_scheme *sc)     {return(sc->unspecified);}
+
+bool s7_is_unspecified(s7_scheme *sc, s7_pointer val) {return(is_unspecified(val));}
+
+static s7_pointer g_is_undefined(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_undefined "(undefined? val) returns #t if val is #<undefined> or some other #... value that s7 does not recognize; (undefined? #asdf): #t.\
+This is not the same as (not (defined? val)) which refers to whether a symbol has a binding: (undefined? 'asdf): #f, but (not (defined? 'asdf)): #t"
+  #define Q_is_undefined sc->pl_bt
+  check_boolean_method(sc, is_undefined, sc->is_undefined_symbol, args);
+}
+
+static s7_pointer g_is_unspecified(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_unspecified "(unspecified? val) returns #t if val is #<unspecified>"
+  #define Q_is_unspecified sc->pl_bt
+  check_boolean_method(sc, is_unspecified, sc->is_unspecified_symbol, args);
+}
+
+
+/* -------------------------------- eof-object? -------------------------------- */
+s7_pointer eof_object = NULL;          /* #<eof> is an entry in the chars array, so it's not a part of sc */
+
+s7_pointer s7_eof_object(s7_scheme *sc) {return(eof_object);}
+
+static s7_pointer g_is_eof_object(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_eof_object "(eof-object? val) returns #t if val is the end-of-file object, #<eof>.  It is the same as (eq? val #<eof>)"
+  #define Q_is_eof_object sc->pl_bt
+  check_boolean_method(sc, is_eof, sc->is_eof_object_symbol, args);
+}
+
+static bool is_eof_object_b_p(s7_pointer p) {return(p == eof_object);}
+
+
+/* -------------------------------- not -------------------------------- */
+static bool not_b_7p(s7_scheme *sc, s7_pointer p) {return(p == sc->F);}
+
+static s7_pointer g_not(s7_scheme *sc, s7_pointer args)
+{
+  #define H_not "(not obj) returns #t if obj is #f, otherwise #f: (not ()) -> #f"
+  #define Q_not sc->pl_bt
+  return((car(args) == sc->F) ? sc->T : sc->F);
+}
+
+
+/* -------------------------------- boolean? -------------------------------- */
+bool s7_boolean(s7_scheme *sc, s7_pointer x)      {return(x != sc->F);}
+s7_pointer s7_make_boolean(s7_scheme *sc, bool x) {return(make_boolean(sc, x));}
+
+bool s7_is_boolean(s7_pointer x) {return(type(x) == T_BOOLEAN);}
+
+static s7_pointer g_is_boolean(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_boolean "(boolean? obj) returns #t if obj is #f or #t: (boolean? ()) -> #f"
+  #define Q_is_boolean sc->pl_bt
+  check_boolean_method(sc, is_boolean, sc->is_boolean_symbol, args);
+}
+
+
+/* -------------------------------- constant? -------------------------------- */
+static inline bool is_constant_symbol(s7_scheme *sc, s7_pointer sym) /* inline: 7 in cb, 5 in tgen */
+{
+  if (is_immutable_symbol(sym))    /* for keywords */
+    return(true);
+  if (is_possibly_constant(sym))
+    {
+      s7_pointer slot = s7_slot(sc, sym);
+      return((is_slot(slot)) && (is_immutable_slot(slot)));
+    }
+  return(false);
+}
+
+#define is_constant(sc, p) ((type(p) != T_SYMBOL) || (is_constant_symbol(sc, p)))
+
+static s7_pointer g_is_constant(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_constant "(constant? obj) returns #t if obj either evaluates to itself, or is a symbol whose binding is constant"
+  #define Q_is_constant sc->pl_bt
+  return(make_boolean(sc, is_constant(sc, car(args))));
+}
+
+static bool is_constant_b_7p(s7_scheme *sc, s7_pointer p) {return(is_constant(sc, p));}
+static s7_pointer is_constant_p_p(s7_scheme *sc, s7_pointer p) {return(make_boolean(sc, is_constant(sc, p)));}
+
+
+/* -------------------------------- immutable? -------------------------------- */
+
+bool s7_is_immutable(s7_pointer p) {return(is_immutable(p));}
+
+static s7_pointer g_is_immutable(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_immutable "(immutable? obj (env (curlet))) returns #t if obj (or obj in the environment env) is immutable"
+  #define Q_is_immutable s7_make_signature(sc, 3, sc->is_boolean_symbol, sc->T, sc->is_let_symbol)
+  s7_pointer p = car(args), slot;
+  if (is_symbol(p))
+    {
+      if (is_keyword(p)) return(sc->T);
+      if (is_pair(cdr(args)))
+	{
+	  s7_pointer e = cadr(args);
+	  if (!is_let(e))
+	    wrong_type_error_nr(sc, sc->is_immutable_symbol, 2, e, a_let_string);
+	  if (e == sc->rootlet)
+	    slot = global_slot(p);
+	  else slot = lookup_slot_from((is_keyword(p)) ? keyword_symbol(p) : p, e);
+	}
+      else slot = s7_slot(sc, p);
+      if (is_slot(slot)) /* might be #<undefined> */
+	return(make_boolean(sc, is_immutable_slot(slot)));
+    }
+  else
+    if ((is_pair(cdr(args))) && (!is_let(cadr(args)))) /* (immutable? 1 2) */
+      wrong_type_error_nr(sc, sc->is_immutable_symbol, 2, cadr(args), a_let_string);
+  return(make_boolean(sc, (is_immutable(p)) || (t_immutable_p[type(p)]) || ((is_any_vector(p)) && (vector_length(p) == 0))));
+}
+
+
+/* -------------------------------- immutable! -------------------------------- */
+s7_pointer s7_immutable(s7_pointer p)
+{
+  if (is_symbol(p)) /* trying to mimic g_immutable */
+    {
+      s7_pointer slot;
+      if (is_keyword(p)) return(p);
+      slot = s7_slot(cur_sc, p);  /* ouch! we need the s7_scheme* argument */
+      if (is_slot(slot))
+	set_immutable_slot(slot);
+      /* symbol is not set immutable (as below) */
+    }
+  else set_immutable(p);
+  return(p);
+}
+
+static s7_pointer g_immutable(s7_scheme *sc, s7_pointer args)
+{
+  #define H_immutable "(immutable! obj (env (curlet))) declares that the object obj (or obj in the environment env) can't be changed. obj is returned."
+  #define Q_immutable s7_make_signature(sc, 3, sc->T, sc->T, sc->is_let_symbol)
+  s7_pointer p = car(args), slot;
+  if (is_symbol(p))
+    {
+      if (is_pair(cdr(args)))
+	{
+	  s7_pointer e = cadr(args);
+	  if (!is_let(e))
+	    wrong_type_error_nr(sc, sc->immutable_symbol, 2, e, a_let_string);
+	  slot = symbol_to_local_slot(sc, (is_keyword(p)) ? keyword_symbol(p) : p, e); /* different from immutable? */
+	}
+      else
+	{
+	  if (is_keyword(p)) return(p);
+	  slot = s7_slot(sc, p);
+	}
+      if (is_slot(slot))
+	set_immutable_slot(slot);
+      return(p);  /* symbol is not set immutable ? */
+    }
+  if ((is_pair(cdr(args))) && (!is_let(cadr(args)))) /* (immutable! 1 2) */
+    wrong_type_error_nr(sc, sc->immutable_symbol, 2, cadr(args), a_let_string);
+  /* perhaps if safety on and p already immutable, warn about useless call?  This for (immutable! sum) where caller meant (immutable! 'sum) */
+  set_immutable(p);   /* could set_immutable save the current file/line? Then the immutable error checks for define-constant and this setting */
+                      /*   T_LOCATION -> T_IMMUTABLE_LOCATION but can't do this for a pair */
+  return(p);
+}
+
+/* there's no way to make a slot setter (as setter) immutable (t_multiform as bit) */
+
+
+/* -------------------------------- GC -------------------------------- */
+/* in most code, pairs, lets, and slots dominate the heap -- each about 25% to 40% of the
+ *   total cell allocations.  In snd-test, reals are 50%. slots need not be in the heap,
+ *   but moving them out to their own free list was slower because we need (in that
+ *   case) to manage them in the sweep process by tracking lets.
+ */
+
+#if S7_DEBUGGING
+static s7_int gc_protect_2(s7_scheme *sc, s7_pointer x, int32_t line)
+{
+  static bool already_warned = false;
+  s7_int loc = s7_gc_protect(sc, x);
+  if ((sc->safety > NO_SAFETY) && (!already_warned) && (loc > 8192))
+    {
+      already_warned = true;
+      fprintf(stderr, "s7_gc_protect has protected more than 8192 values? (line: %d, code: %s, loc: %" ld64 ")\n",
+	      line, string_value(s7_object_to_string(sc, current_code(sc), false)), loc);
+      if ((S7_DEBUGGING) && (sc->stop_at_error)) abort();
+    }
+  return(loc);
+}
+#define gc_protect_1(Sc, X) gc_protect_2(Sc, X, __LINE__)
+#else
+#define gc_protect_1(Sc, X) s7_gc_protect(Sc, X)
+#endif
+
+static void resize_gc_protect(s7_scheme *sc)
+{
+  s7_int size = sc->protected_objects_size;
+  block_t *ob = vector_block(sc->protected_objects);
+  s7_int new_size = 2 * size;
+  block_t *nb = reallocate(sc, ob, new_size * sizeof(s7_pointer));
+  block_info(nb) = NULL;
+  vector_block(sc->protected_objects) = nb;
+  vector_elements(sc->protected_objects) = (s7_pointer *)block_data(nb);
+  vector_length(sc->protected_objects) = new_size;
+  sc->protected_objects_size = new_size;
+  sc->protected_objects_free_list = (s7_int *)Realloc(sc->protected_objects_free_list, new_size * sizeof(s7_int));
+  for (s7_int i = size; i < new_size; i++)
+    {
+      vector_element(sc->protected_objects, i) = sc->unused;
+      sc->protected_objects_free_list[++sc->protected_objects_free_list_loc] = i;
+    }
+}
+
+s7_int s7_gc_protect(s7_scheme *sc, s7_pointer x)
+{
+  s7_int loc;
+  if (sc->protected_objects_free_list_loc < 0)
+    resize_gc_protect(sc);
+  loc = sc->protected_objects_free_list[sc->protected_objects_free_list_loc--];
+  vector_element(sc->protected_objects, loc) = x;
+  return(loc);
+}
+
+void s7_gc_unprotect_at(s7_scheme *sc, s7_int loc)
+{
+  if (loc < sc->protected_objects_size)
+    {
+      if (vector_element(sc->protected_objects, loc) != sc->unused)
+	sc->protected_objects_free_list[++sc->protected_objects_free_list_loc] = loc;
+      else if (S7_DEBUGGING) fprintf(stderr, "redundant gc_unprotect_at location %" ld64 "\n", loc);
+      vector_element(sc->protected_objects, loc) = sc->unused;
+    }
+}
+
+s7_pointer s7_gc_protected_at(s7_scheme *sc, s7_int loc)
+{
+  s7_pointer obj = sc->unspecified;
+  if (loc < sc->protected_objects_size)
+    obj = vector_element(sc->protected_objects, loc);
+  if (obj == sc->unused)
+    return(sc->unspecified);
+  return(obj);
+}
+
+#define gc_protected_at(Sc, Loc) vector_element(Sc->protected_objects, Loc)
+
+s7_pointer s7_gc_protect_via_location(s7_scheme *sc, s7_pointer x, s7_int loc)
+{
+  vector_element(sc->protected_objects, loc) = x;
+  return(x);
+}
+
+s7_pointer s7_gc_unprotect_via_location(s7_scheme *sc, s7_int loc)
+{
+  vector_element(sc->protected_objects, loc) = sc->F;
+  return(sc->F);
+}
+
+
+/* these 3 are needed by sweep */
+static void (*mark_function[NUM_TYPES])(s7_pointer p);
+void s7_mark(s7_pointer p) {if (!is_marked(p)) (*mark_function[unchecked_type(p)])(p);}
+static void mark_noop(s7_pointer unused_p) {}
+
+static void process_iterator(s7_scheme *unused_sc, s7_pointer s1)
+{
+  if (is_weak_hash_iterator(s1))
+    {
+      s7_pointer h = iterator_sequence(s1);
+      clear_weak_hash_iterator(s1);
+      if (unchecked_type(h) == T_HASH_TABLE)
+	weak_hash_iters(h)--;
+    }
+}
+
+static void process_multivector(s7_scheme *sc, s7_pointer s1)
+{
+  vdims_t *info = vector_dimension_info(s1);  /* a multidimensional empty vector can have dimension info, wrapped vectors always have dimension info */
+  if ((info) &&
+      (info != sc->wrap_only))
+    {
+      if (vector_elements_should_be_freed(info)) /* a kludge for foreign code convenience */
+	{
+	  free(any_vector_elements(s1));
+	  vector_elements_should_be_freed(info) = false;
+	}
+      liberate(sc, info);
+      vector_set_dimension_info(s1, NULL);
+    }
+  liberate(sc, vector_block(s1));
+}
+
+static void process_input_string_port(s7_scheme *sc, s7_pointer s1)
+{
+#if S7_DEBUGGING
+  /* this set of ports is a subset of the ports that respond true to is_string_port --
+   *   the latter include file ports fully read into local memory; see read_file which uses add_input_port, not add_input_string_port
+   */
+  if (port_filename(s1))
+    fprintf(stderr, "string input port has a filename: %s\n", port_filename(s1));
+  if (port_needs_free(s1))
+    fprintf(stderr, "string input port needs data release\n");
+#endif
+  liberate(sc, port_block(s1));
+}
+
+static void free_port_data(s7_scheme *sc, s7_pointer s1)
+{
+  if (port_data(s1))
+    {
+      liberate(sc, port_data_block(s1));
+      port_data_block(s1) = NULL;
+      port_data(s1) = NULL;
+      port_data_size(s1) = 0;
+    }
+  port_needs_free(s1) = false;
+}
+
+static void close_input_function(s7_scheme *sc, s7_pointer p);
+
+static void process_input_port(s7_scheme *sc, s7_pointer s1)
+{
+  if (!port_is_closed(s1))
+    {
+      if (is_file_port(s1))
+	{
+	  if (port_file(s1))
+	    {
+	      fclose(port_file(s1));
+	      port_file(s1) = NULL;
+	    }}
+      else
+	if (is_function_port(s1))
+	  close_input_function(sc, s1);
+    }
+  if (port_needs_free(s1))
+    free_port_data(sc, s1);
+
+  if (port_filename(s1))
+    {
+      liberate(sc, port_filename_block(s1));
+      port_filename(s1) = NULL;
+    }
+  liberate(sc, port_block(s1));
+}
+
+static void close_output_port(s7_scheme *sc, s7_pointer p);
+
+static void process_output_port(s7_scheme *sc, s7_pointer s1)
+{
+  close_output_port(sc, s1); /* needed for free filename, etc */
+  liberate(sc, port_block(s1));
+  if (port_needs_free(s1))
+    {
+      port_needs_free(s1) = false;
+      if (port_data_block(s1))
+	{
+	  liberate(sc, port_data_block(s1));
+	  port_data_block(s1) = NULL;
+	}}
+}
+
+static void process_continuation(s7_scheme *sc, s7_pointer s1)
+{
+  continuation_op_stack(s1) = NULL;
+  liberate_block(sc, continuation_block(s1)); /* from mallocate_block (s7_make_continuation) */
+}
+
+
+#if WITH_GMP
+#if ((__GNU_MP_VERSION < 6) || ((__GNU_MP_VERSION == 6) && (__GNU_MP_VERSION_MINOR == 0)))
+static int32_t mpq_cmp_z(const mpq_t op1, const mpz_t op2)
+{
+  mpq_t z1;
+  int32_t result;
+  mpq_init(z1);
+  mpq_set_z(z1, op2);
+  result = mpq_cmp(op1, z1);
+  mpq_clear(z1);
+  return(result);
+}
+#endif
+
+static s7_int big_integer_to_s7_int(s7_scheme *sc, mpz_t n);
+
+static s7_int s7_integer_clamped_if_gmp(s7_scheme *sc, s7_pointer p)
+{
+  if (is_t_integer(p))
+    return(integer(p));
+  if (is_t_big_integer(p))
+    return(big_integer_to_s7_int(sc, big_integer(p)));
+  return(0);
+}
+
+static void free_big_integer(s7_scheme *sc, s7_pointer p)
+{
+  big_integer_nxt(p) = sc->bigints;
+  sc->bigints = big_integer_bgi(p);
+  big_integer_bgi(p) = NULL;
+}
+
+static void free_big_ratio(s7_scheme *sc, s7_pointer p)
+{
+  big_ratio_nxt(p) = sc->bigrats;
+  sc->bigrats = big_ratio_bgr(p);
+  big_ratio_bgr(p) = NULL;
+}
+
+static void free_big_real(s7_scheme *sc, s7_pointer p)
+{
+  big_real_nxt(p) = sc->bigflts;
+  sc->bigflts = big_real_bgf(p);
+  big_real_bgf(p) = NULL;
+}
+
+static void free_big_complex(s7_scheme *sc, s7_pointer p)
+{
+  big_complex_nxt(p) = sc->bigcmps;
+  sc->bigcmps = big_complex_bgc(p);
+  big_complex_bgc(p) = NULL;
+}
+#else
+#define s7_integer_clamped_if_gmp(Sc, P) integer(P)
+#endif
+
+
+static void free_hash_table(s7_scheme *sc, s7_pointer table);
+static void remove_gensym_from_symbol_table(s7_scheme *sc, s7_pointer sym);
+static void cull_weak_hash_table(s7_scheme *sc, s7_pointer table);
+
+static void sweep(s7_scheme *sc)
+{
+  s7_int i, j;
+  gc_list_t *gp;
+
+  #define process_gc_list(Code)				\
+    if (gp->loc > 0)					\
+      {							\
+        for (i = 0, j = 0; i < gp->loc; i++)		\
+          {						\
+            s7_pointer s1 = gp->list[i];		\
+            if (is_free_and_clear(s1))			\
+              {						\
+                Code;					\
+              }						\
+            else if (in_heap(s1)) gp->list[j++] = s1;	\
+          }						\
+        gp->loc = j;					\
+      }							\
+
+  gp = sc->strings;
+  process_gc_list(liberate(sc, string_block(s1)));
+#if 0
+  fprintf(stderr, "--------------------------------------------------------------------------------\n");
+  for (s7_int i = 0; i < gp->loc; i++)
+    fprintf(stderr, "%s\n", string_value(gp->list[i]));
+#endif
+  gp = sc->gensyms;
+  process_gc_list(remove_gensym_from_symbol_table(sc, s1); liberate(sc, gensym_block(s1)));
+  if (gp->loc == 0) mark_function[T_SYMBOL] = mark_noop;
+
+  gp = sc->undefineds;
+  process_gc_list(free(undefined_name(s1)));
+
+  gp = sc->c_objects;
+  process_gc_list((c_object_gc_free(sc, s1)) ? (void)(*(c_object_gc_free(sc, s1)))(sc, s1) : (void)(*(c_object_free(sc, s1)))(c_object_value(s1)))
+
+  gp = sc->vectors;
+  process_gc_list(liberate(sc, vector_block(s1)));
+
+  gp = sc->multivectors;
+  process_gc_list(process_multivector(sc, s1));
+
+  gp = sc->hash_tables;
+  if (gp->loc > 0)
+    {
+      for (i = 0, j = 0; i < gp->loc; i++)
+	{
+	  s7_pointer s1 = gp->list[i];
+	  if (is_free_and_clear(s1))
+	    free_hash_table(sc, s1);
+	  else
+	    {
+	      if ((is_weak_hash_table(s1)) &&
+		  (weak_hash_iters(s1) == 0) &&
+		  (hash_table_entries(s1) > 0))
+		cull_weak_hash_table(sc, s1);
+	      gp->list[j++] = s1;
+	    }}
+      gp->loc = j;
+    }
+
+  gp = sc->weak_hash_iterators;
+  process_gc_list(process_iterator(sc, s1));
+
+  gp = sc->opt1_funcs;
+  if (gp->loc > 0)
+    {
+      for (i = 0, j = 0; i < gp->loc; i++)
+	{
+	  s7_pointer s1 = gp->list[i];
+	  if (!is_free_and_clear(s1))
+	    gp->list[j++] = s1;
+	}
+      gp->loc = j;
+    }
+
+  gp = sc->input_ports;
+  process_gc_list(process_input_port(sc, s1));
+
+  gp = sc->input_string_ports;
+  process_gc_list(process_input_string_port(sc, s1));
+
+  gp = sc->output_ports;
+  process_gc_list(process_output_port(sc, s1));
+
+  gp = sc->continuations;
+  process_gc_list(process_continuation(sc, s1));
+
+  gp = sc->weak_refs;
+  if (gp->loc > 0)
+    {
+      for (i = 0, j = 0; i < gp->loc; i++)
+	{
+	  s7_pointer s1 = gp->list[i];
+	  if (!is_free_and_clear(s1))
+	    {
+	      if (is_free_and_clear(c_pointer_weak1(s1)))
+		c_pointer_weak1(s1) = sc->F;
+	      if (is_free_and_clear(c_pointer_weak2(s1)))
+		c_pointer_weak2(s1) = sc->F;
+	      if ((c_pointer_weak1(s1) != sc->F) ||
+		  (c_pointer_weak2(s1) != sc->F))
+		gp->list[j++] = s1;
+	    }}
+      gp->loc = j;
+    }
+
+#if WITH_GMP
+  gp = sc->big_integers;
+  process_gc_list(free_big_integer(sc, s1))
+
+  gp = sc->big_ratios;
+  process_gc_list(free_big_ratio(sc ,s1))
+
+  gp = sc->big_reals;
+  process_gc_list(free_big_real(sc, s1))
+
+  gp = sc->big_complexes;
+  process_gc_list(free_big_complex(sc, s1))
+
+  gp = sc->big_random_states;
+  process_gc_list(gmp_randclear(random_gmp_state(s1)))
+#endif
+}
+
+static /* inline */ void add_to_gc_list(gc_list_t *gp, s7_pointer p)
+{
+#if S7_DEBUGGING
+  if ((!in_heap(p)) && (gp != cur_sc->opt1_funcs))
+    {
+      char *s = describe_type_bits(cur_sc, p);
+      fprintf(stderr, "%s[%d]: %s not in heap, %s\n", __func__, __LINE__, display(p), s);
+      free(s);
+      if (cur_sc->stop_at_error) abort();
+    }
+#endif
+  if (gp->loc == gp->size)
+    {
+      gp->size *= 2;
+      gp->list = (s7_pointer *)Realloc(gp->list, gp->size * sizeof(s7_pointer));
+    }
+  gp->list[gp->loc++] = p;
+}
+
+static gc_list_t *make_gc_list(void)
+{
+  gc_list_t *gp = (gc_list_t *)Malloc(sizeof(gc_list_t));
+  #define INIT_GC_CACHE_SIZE 4
+  gp->size = INIT_GC_CACHE_SIZE;
+  gp->loc = 0;
+  gp->list = (s7_pointer *)Malloc(gp->size * sizeof(s7_pointer));
+  return(gp);
+}
+
+static void just_mark(s7_pointer p) {set_mark(p);}
+
+static void add_gensym(s7_scheme *sc, s7_pointer p)
+{
+  add_to_gc_list(sc->gensyms, p);
+  mark_function[T_SYMBOL] = just_mark;
+}
+
+#define add_c_object(sc, p)          add_to_gc_list(sc->c_objects, p)
+#define add_hash_table(sc, p)        add_to_gc_list(sc->hash_tables, p)
+#define add_string(sc, p)            add_to_gc_list(sc->strings, p)
+#define add_input_port(sc, p)        add_to_gc_list(sc->input_ports, p)
+#define add_input_string_port(sc, p) add_to_gc_list(sc->input_string_ports, p)
+#define add_output_port(sc, p)       add_to_gc_list(sc->output_ports, p)
+#define add_continuation(sc, p)      add_to_gc_list(sc->continuations, p)
+#define add_undefined(sc, p)         add_to_gc_list(sc->undefineds, p)
+#define add_vector(sc, p)            add_to_gc_list(sc->vectors, p)
+#define add_multivector(sc, p)       add_to_gc_list(sc->multivectors, p)
+#define add_weak_ref(sc, p)          add_to_gc_list(sc->weak_refs, p)
+#define add_weak_hash_iterator(sc, p) add_to_gc_list(sc->weak_hash_iterators, p)
+#define add_opt1_func(sc, p) do {if (!opt1_func_listed(p)) add_to_gc_list(sc->opt1_funcs, p); set_opt1_func_listed(p);} while (0) /* called by set_opt1_lambda_add */
+
+#if WITH_GMP
+#define add_big_integer(sc, p)       add_to_gc_list(sc->big_integers, p)
+#define add_big_ratio(sc, p)         add_to_gc_list(sc->big_ratios, p)
+#define add_big_real(sc, p)          add_to_gc_list(sc->big_reals, p)
+#define add_big_complex(sc, p)       add_to_gc_list(sc->big_complexes, p)
+#define add_big_random_state(sc, p)  add_to_gc_list(sc->big_random_states, p)
+#endif
+
+static void init_gc_caches(s7_scheme *sc)
+{
+  sc->strings = make_gc_list();
+  sc->gensyms = make_gc_list();
+  sc->undefineds = make_gc_list();
+  sc->vectors = make_gc_list();
+  sc->multivectors = make_gc_list();
+  sc->hash_tables = make_gc_list();
+  sc->input_ports = make_gc_list();
+  sc->input_string_ports = make_gc_list();
+  sc->output_ports = make_gc_list();
+  sc->continuations = make_gc_list();
+  sc->c_objects = make_gc_list();
+  sc->weak_refs = make_gc_list();
+  sc->weak_hash_iterators = make_gc_list();
+  sc->opt1_funcs = make_gc_list();
+#if WITH_GMP
+  sc->big_integers = make_gc_list();
+  sc->big_ratios = make_gc_list();
+  sc->big_reals = make_gc_list();
+  sc->big_complexes = make_gc_list();
+  sc->big_random_states = make_gc_list();
+  sc->ratloc = NULL;
+#endif
+  /* slightly unrelated... */
+  sc->setters_size = 4;
+  sc->setters_loc = 0;
+  sc->setters = (s7_pointer *)Malloc(sc->setters_size * sizeof(s7_pointer));
+}
+
+static s7_pointer semipermanent_cons(s7_scheme *sc, s7_pointer a, s7_pointer b, uint64_t type);
+
+static void add_setter(s7_scheme *sc, s7_pointer p, s7_pointer setter)
+{
+  /* setters GC-protected. The c_function_setter field can't be used because the built-in functions
+   *   are often removed from the heap and never thereafter marked.  Only closures and macros are protected here.
+   */
+  for (s7_int i = 0; i < sc->setters_loc; i++)
+    {
+      s7_pointer x = sc->setters[i];
+      if (car(x) == p)
+	{
+	  unchecked_set_cdr(x, setter);
+	  return;
+ 	}}
+  if (sc->setters_loc == sc->setters_size)
+    {
+      sc->setters_size *= 2;
+      sc->setters = (s7_pointer *)Realloc(sc->setters, sc->setters_size * sizeof(s7_pointer));
+    }
+  sc->setters[sc->setters_loc++] = semipermanent_cons(sc, p, setter, T_PAIR | T_IMMUTABLE);
+}
+
+
+static inline void gc_mark(s7_pointer p) {if (!is_marked(p)) (*mark_function[unchecked_type(p)])(p);}
+
+static void mark_symbol_vector(s7_pointer p, s7_int len)
+{
+  set_mark(p);
+  if (mark_function[T_SYMBOL] != mark_noop) /* else no gensyms */
+    {
+      s7_pointer *e = vector_elements(p);
+      for (s7_int i = 0; i < len; i++)
+	if ((is_symbol(e[i])) && (is_gensym(e[i]))) /* need is_symbol: make-vector + set! vector-typer symbol? where init is not a symbol */
+	  set_mark(e[i]);
+    }
+}
+
+static void mark_simple_vector(s7_pointer p, s7_int len)
+{
+  s7_pointer *e = vector_elements(p);
+  set_mark(p);
+  for (s7_int i = 0; i < len; i++)
+    set_mark(e[i]);
+}
+
+static void just_mark_vector(s7_pointer p, s7_int unused_len) {set_mark(p);}
+
+static void mark_vector_1(s7_pointer p, s7_int top)
+{
+  s7_pointer *tp = (s7_pointer *)(vector_elements(p));
+  s7_pointer *tend, *tend4;
+  set_mark(p);
+  if (!tp) return;
+  tend = (s7_pointer *)(tp + top);
+  tend4 = (s7_pointer *)(tend - 16);
+  while (tp <= tend4) {LOOP_8(gc_mark(*tp++)); LOOP_8(gc_mark(*tp++));} /* faster if large vectors in use, maybe slower otherwise? */
+  while (tp < tend)
+    gc_mark(*tp++);
+}
+
+static void mark_typed_vector_1(s7_pointer p, s7_int top) /* for typed vectors with closure setters */
+{
+  gc_mark(typed_vector_typer(p));
+  mark_vector_1(p, top);
+}
+
+static inline void mark_slot(s7_pointer p)
+{
+  set_mark(T_Slt(p));
+  gc_mark(slot_value(p));
+  if (slot_has_setter_or_pending_value(p))
+    gc_mark(slot_pending_value_unchecked(p)); /* setter field == pending_value */
+  set_mark(slot_symbol(p));
+}
+
+static void mark_let(s7_pointer let)
+{
+  for (s7_pointer x = let; (x) && (!is_marked(x)); x = let_outlet(x))
+    {
+      set_mark(x);
+      if (has_dox_slot1(x)) mark_slot(let_dox_slot1(x));
+      if ((has_dox_slot2(x)) && (is_slot(let_dox_slot2(x)))) mark_slot(let_dox_slot2(x));
+      /* it can happen (call/cc related) that let_dox_slot2 is a slot but invalid, but in that case has_dox_slot2 will not be set(?) */
+      for (s7_pointer y = let_slots(x); tis_slot(y); y = next_slot(y))
+	if (!is_marked(y)) /* slot value might be the enclosing let */
+	  mark_slot(y);
+    }
+}
+
+#if WITH_HISTORY
+static void gc_owlet_mark(s7_pointer tp)
+{
+  /* gc_mark but if tp is a pair ignore the marked bit on unheaped entries */
+  if (is_pair(tp))
+    {
+      s7_pointer p = tp;
+      do {
+	set_mark(p);
+	gc_mark(car(p)); /* does this need to be gc_owlet_mark? I can't find a case */
+	p = cdr(p);
+      } while ((is_pair(p)) && (p != tp) && ((!in_heap(p)) || (!is_marked(p)))); /* ((full_type(p) & (TYPE_MASK | T_GC_MARK)) == T_PAIR) is much slower */
+      gc_mark(p);
+    }
+  else
+    if (!is_marked(tp))
+      (*mark_function[unchecked_type(tp)])(tp);
+}
+#endif
+
+static void mark_owlet(s7_scheme *sc)
+{
+#if WITH_HISTORY
+  {
+    for (s7_pointer p1 = sc->eval_history1, p2 = sc->eval_history2, p3 = sc->history_pairs; ; p2 = cdr(p2), p3 = cdr(p3))
+      {
+	gc_owlet_mark(car(p1));
+	gc_owlet_mark(car(p2));
+	gc_owlet_mark(car(p3));
+	p1 = cdr(p1);
+	if (p1 == sc->eval_history1) break; /* these are circular lists */
+      }}
+#endif
+  /* sc->error_type and friends are slots in owlet */
+  mark_slot(sc->error_type);
+  slot_set_value(sc->error_data, sc->F); /* or maybe mark_tree(slot_value(sc->error_data)) ? */
+  mark_slot(sc->error_data);
+  mark_slot(sc->error_code);
+  mark_slot(sc->error_line);
+  mark_slot(sc->error_file);
+  mark_slot(sc->error_position);
+#if WITH_HISTORY
+  mark_slot(sc->error_history);
+#endif
+  set_mark(sc->owlet);
+  mark_let(let_outlet(sc->owlet));
+}
+
+static void mark_c_pointer(s7_pointer p)
+{
+  set_mark(p);
+  gc_mark(c_pointer_type(p));
+  gc_mark(c_pointer_info(p));
+}
+
+static void mark_c_proc_star(s7_pointer p)
+{
+  set_mark(p);
+  if ((!c_func_has_simple_defaults(p)) &&
+      (c_function_call_args(p))) /* NULL if not a safe function */
+    for (s7_pointer arg = c_function_call_args(p); is_pair(arg); arg = cdr(arg))
+      gc_mark(car(arg));
+}
+
+static void mark_pair(s7_pointer p)
+{
+  do {
+    set_mark(p);
+    gc_mark(car(p)); /* expanding this to avoid recursion is slower */
+    p = cdr(p);
+  } while ((is_pair(p)) && (!is_marked(p))); /* ((full_type(p) & (TYPE_MASK | T_GC_MARK)) == T_PAIR) is much slower */
+  gc_mark(p);
+}
+
+static void mark_counter(s7_pointer p)
+{
+  set_mark(p);
+  gc_mark(counter_result(p));
+  gc_mark(counter_list(p));
+  gc_mark(counter_let(p));
+}
+
+static void mark_closure(s7_pointer p)
+{
+  set_mark(p);
+  gc_mark(closure_args(p));
+  gc_mark(closure_body(p));
+  mark_let(closure_let(p));
+  gc_mark(closure_setter_or_map_list(p));
+}
+
+static void mark_stack_1(s7_pointer p, s7_int top)
+{
+  s7_pointer *tp = (s7_pointer *)(stack_elements(p)), *tend;
+  set_mark(p);
+  if (!tp) return;
+  tend = (s7_pointer *)(tp + top);
+  while (tp < tend)
+    {
+      gc_mark(*tp++); /* sc->code */
+      gc_mark(*tp++); /* sc->curlet */
+      gc_mark(*tp++); /* sc->args */
+      tp++;           /* sc->cur_op */
+    }
+}
+
+static void mark_stack(s7_pointer p)
+{
+  /* we can have a bare stack waiting for a continuation to hold it if the new_cell for the continuation triggers the GC!  But we need a top-of-stack?? */
+  mark_stack_1(p, temp_stack_top(p));
+}
+
+static void mark_continuation(s7_pointer p)
+{
+  set_mark(p);
+  if (!is_marked(continuation_stack(p))) /* can these be cyclic? */
+    mark_stack_1(continuation_stack(p), continuation_stack_top(p));
+  gc_mark(continuation_op_stack(p));
+}
+
+static void mark_vector(s7_pointer p)
+{
+  if (is_typed_vector(p))
+    typed_vector_gc_mark(p)(p, vector_length(p));
+  else mark_vector_1(p, vector_length(p));
+}
+
+static void mark_vector_possibly_shared(s7_pointer p)
+{
+  /* If a subvector (an inner dimension) of a vector is the only remaining reference
+   *    to the main vector, we want to make sure the main vector is not GC'd until
+   *    the subvector is also GC-able.  The subvector field either points to the
+   *    parent vector, or it is sc->F, so we need to check for a vector parent if
+   *    the current is multidimensional (this will include 1-dim slices).  We need
+   *    to keep the parent case separate (i.e. sc->F means the current is the original)
+   *    so that we only free once (or remove_from_heap once).
+   *
+   * If we have a subvector of a subvector, and the middle and original are not otherwise
+   *   in use, we mark the middle one, but (since it itself is not in use anywhere else)
+   *   we don't mark the original!  So we need to follow the share-vector chain marking every one.
+   *
+   * To remove a cell from the heap, we need its current heap location so that we can replace it.
+   *   The heap is allocated as needed in monolithic blocks of (say) 1/2M s7_cells. When a cell
+   *   is replaced, the new cell (at heap[x] say) is no longer from the original block. Since the
+   *   GC clears all type bits when it frees a cell, we can't use a type bit to distinguish the
+   *   replacements from the originals, but we need that info because in the base case, we use
+   *   the distance of the cell from the base cell to get "x", its location.  In the replacement
+   *   case, we add the location at the end of the s7_cell (s7_big_cell).  We track the current
+   *   heap blocks via the sc->heap_blocks list.  To get the location of "p" above, we run through
+   *   that list looking for a block it fits in.  If none is found, we assume it is an s7_big_cell
+   *   and use the saved location.
+   */
+  if (is_subvector(p))
+    mark_vector_possibly_shared(subvector_vector(p));
+
+  /* mark_vector_1 does not check the marked bit, so if subvector below is in a cycle involving
+   *   the calling vector, we get infinite recursion unless we check the mark bit here.
+   */
+  if (!is_marked(p))
+    mark_vector_1(p, vector_length(p));
+}
+
+static void mark_int_or_float_vector(s7_pointer p) {set_mark(p);}
+
+static void mark_int_or_float_vector_possibly_shared(s7_pointer p)
+{
+  if (is_subvector(p))
+    mark_int_or_float_vector_possibly_shared(subvector_vector(p));
+  set_mark(p);
+}
+
+static void mark_c_object(s7_pointer p)
+{
+  set_mark(p);
+  if (c_object_gc_mark(c_object_s7(p), p))
+    (*(c_object_gc_mark(c_object_s7(p), p)))(c_object_s7(p), p);
+  else (*(c_object_mark(c_object_s7(p), p)))(c_object_value(p));
+}
+
+static void mark_catch(s7_pointer p)
+{
+  set_mark(p);
+  gc_mark(catch_tag(p));
+  gc_mark(catch_handler(p));
+}
+
+static void mark_dynamic_wind(s7_pointer p)
+{
+  set_mark(p);
+  gc_mark(dynamic_wind_in(p));
+  gc_mark(dynamic_wind_out(p));
+  gc_mark(dynamic_wind_body(p));
+}
+
+static void mark_hash_table(s7_pointer p)
+{
+  set_mark(p);
+  gc_mark(hash_table_procedures(p));
+  if (is_pair(hash_table_procedures(p)))
+    {
+      gc_mark(hash_table_key_typer_unchecked(p));  /* unchecked to avoid s7-debugger's reference to sc */
+      gc_mark(hash_table_value_typer_unchecked(p));
+    }
+  if (hash_table_entries(p) > 0)
+    {
+      s7_int len = hash_table_size(p);
+      hash_entry_t **entries = hash_table_elements(p);
+      hash_entry_t **last = (hash_entry_t **)(entries + len);
+
+      if ((is_weak_hash_table(p)) &&
+	  (weak_hash_iters(p) == 0))
+	while (entries < last)
+	  {
+	    hash_entry_t *xp;
+	    for (xp = *entries++; xp; xp = hash_entry_next(xp))
+	      gc_mark(hash_entry_value(xp));
+	    for (xp = *entries++; xp; xp = hash_entry_next(xp))
+	      gc_mark(hash_entry_value(xp));
+	  }
+      else
+	while (entries < last) /* counting entries here was slightly faster */
+	  {
+	    hash_entry_t *xp;
+	    for (xp = *entries++; xp; xp = hash_entry_next(xp))
+	      {
+		gc_mark(hash_entry_key(xp));
+		gc_mark(hash_entry_value(xp));
+	      }
+	    for (xp = *entries++; xp; xp = hash_entry_next(xp))
+	      {
+		gc_mark(hash_entry_key(xp));
+		gc_mark(hash_entry_value(xp));
+	      }}}
+}
+
+static void mark_iterator(s7_pointer p)
+{
+  set_mark(p);
+  gc_mark(iterator_sequence(p));
+  if (is_mark_seq(p))
+    gc_mark(iterator_current(p));
+}
+
+static void mark_input_port(s7_pointer p)
+{
+  set_mark(p);
+  gc_mark(port_string_or_function(p));
+}
+
+static void mark_output_port(s7_pointer p)
+{
+  set_mark(p);
+  if (is_function_port(p))
+    gc_mark(port_string_or_function(p));
+}
+
+static void mark_free(s7_pointer p)
+{
+#if S7_DEBUGGING
+  /* this can happen in make_room_for_cc_stack */
+  /* fprintf(stderr, "%smark free: %p%s\n", bold_text, p, unbold_text); */
+  /* if (cur_sc->stop_at_error) abort(); */
+#endif
+}
+
+
+static void init_mark_functions(void)
+{
+  mark_function[T_FREE]                = mark_free;
+  mark_function[T_UNDEFINED]           = just_mark;
+  mark_function[T_EOF]                 = mark_noop;
+  mark_function[T_UNSPECIFIED]         = mark_noop;
+  mark_function[T_NIL]                 = mark_noop;
+  mark_function[T_UNUSED]              = mark_noop;
+  mark_function[T_BOOLEAN]             = mark_noop;
+  mark_function[T_SYNTAX]              = mark_noop;
+  mark_function[T_CHARACTER]           = mark_noop;
+  mark_function[T_SYMBOL]              = mark_noop; /* this changes to just_mark when gensyms are in the heap */
+  mark_function[T_STRING]              = just_mark;
+  mark_function[T_INTEGER]             = just_mark;
+  mark_function[T_RATIO]               = just_mark;
+  mark_function[T_REAL]                = just_mark;
+  mark_function[T_COMPLEX]             = just_mark;
+  mark_function[T_BIG_INTEGER]         = just_mark;
+  mark_function[T_BIG_RATIO]           = just_mark;
+  mark_function[T_BIG_REAL]            = just_mark;
+  mark_function[T_BIG_COMPLEX]         = just_mark;
+  mark_function[T_RANDOM_STATE]        = just_mark;
+  mark_function[T_GOTO]                = just_mark;
+  mark_function[T_OUTPUT_PORT]         = just_mark; /* changed to mark_output_port if output function ports are active */
+  mark_function[T_C_MACRO]             = just_mark;
+  mark_function[T_C_POINTER]           = mark_c_pointer;
+  mark_function[T_C_FUNCTION]          = just_mark;
+  mark_function[T_C_FUNCTION_STAR]     = just_mark; /* changes to mark_c_proc_star if defaults involve an expression */
+  mark_function[T_C_RST_NO_REQ_FUNCTION] = just_mark;
+  mark_function[T_PAIR]                = mark_pair;
+  mark_function[T_CLOSURE]             = mark_closure;
+  mark_function[T_CLOSURE_STAR]        = mark_closure;
+  mark_function[T_CONTINUATION]        = mark_continuation;
+  mark_function[T_INPUT_PORT]          = mark_input_port;
+  mark_function[T_VECTOR]              = mark_vector; /* this changes if subvector created (similarly below) */
+  mark_function[T_INT_VECTOR]          = mark_int_or_float_vector;
+  mark_function[T_FLOAT_VECTOR]        = mark_int_or_float_vector;
+  mark_function[T_BYTE_VECTOR]         = just_mark;
+  mark_function[T_MACRO]               = mark_closure;
+  mark_function[T_BACRO]               = mark_closure;
+  mark_function[T_MACRO_STAR]          = mark_closure;
+  mark_function[T_BACRO_STAR]          = mark_closure;
+  mark_function[T_C_OBJECT]            = mark_c_object;
+  mark_function[T_CATCH]               = mark_catch;
+  mark_function[T_DYNAMIC_WIND]        = mark_dynamic_wind;
+  mark_function[T_HASH_TABLE]          = mark_hash_table;
+  mark_function[T_ITERATOR]            = mark_iterator;
+  mark_function[T_LET]                 = mark_let;
+  mark_function[T_STACK]               = mark_stack;
+  mark_function[T_COUNTER]             = mark_counter;
+  mark_function[T_SLOT]                = mark_slot;
+}
+
+static void mark_op_stack(s7_scheme *sc)
+{
+  s7_pointer *p = sc->op_stack;
+  s7_pointer *tp = sc->op_stack_now;
+  while (p < tp)
+    gc_mark(*p++);
+}
+
+static void mark_input_port_stack(s7_scheme *sc)
+{
+  s7_pointer *tp = (s7_pointer *)(sc->input_port_stack + sc->input_port_stack_loc);
+  for (s7_pointer *p = sc->input_port_stack; p < tp; p++)
+    gc_mark(*p);
+}
+
+static void mark_rootlet(s7_scheme *sc)
+{
+  for (s7_pointer y = sc->rootlet_slots; tis_slot(y); y = next_slot(y))
+    gc_mark(slot_value(y)); /* slot is semipermanent? does this assume slot_value is not rootlet? or that rootlet is marked? */
+  /* slot_setter is handled below with an explicit list -- more code than its worth probably */
+  /* we're not marking slot_symbol above which makes me worry that a top-level gensym won't be protected
+   *   (apply define (gensym) '(32)), then try to get the GC to clobber {gensym}-0,
+   *   but I can't get it to break, so they must be protected somehow; apparently they are
+   *   removed from the heap!  At least: (define-macro (defit) (let ((n (gensym))) `(define (,n) (format #t "fun")))) (defit)
+   *   removes the function from the heap (protecting the gensym).
+   */
+}
+
+/* mark_closure calls mark_let on closure_let(func) which marks slot values.
+ *   if we move rootlet to end, unmarked closures at that point could mark let/slot but not slot value?
+ *   or save safe-closure lets to handle all at end?  or a gc_list of safe closure lets and only mark let if not safe?
+ */
+
+static void mark_semipermanent_objects(s7_scheme *sc)
+{
+  for (gc_obj_t *g = sc->semipermanent_objects; g; g = (gc_obj_t *)(g->nxt))
+    gc_mark(g->p);
+  /* semipermanent_objects also has lets (removed from heap) -- should they be handled like semipermanent_lets?
+   *    if unmarked should either be removed from the list and perhaps placed on a free list?
+   *    if outlet is free can the let potentially be in use?
+   *    there are many more semipermanent_lets(slots) than semipermanent objects
+   */
+}
+/* do we mark funclet slot values from the function as root?  Maybe treat them like semipermanent_lets here? */
+
+static void unmark_semipermanent_objects(s7_scheme *sc)
+{
+  gc_obj_t *g;
+  for (g = sc->semipermanent_objects; g; g = (gc_obj_t *)(g->nxt))
+    clear_mark(g->p);
+  for (g = sc->semipermanent_lets; g; g = (gc_obj_t *)(g->nxt)) /* there are lets and slots in this list */
+    clear_mark(g->p);
+}
+
+#if (!MS_WINDOWS)
+  #include <time.h>
+  #include <sys/time.h>
+#endif
+
+#if WITH_GCC
+static __attribute__ ((format (printf, 3, 4))) void s7_warn(s7_scheme *sc, s7_int len, const char *ctrl, ...);
+#else
+static void s7_warn(s7_scheme *sc, s7_int len, const char *ctrl, ...);
+#endif
+
+#if S7_DEBUGGING
+static int64_t gc(s7_scheme *sc, const char *func, int32_t line)
+#else
+static int64_t gc(s7_scheme *sc)
+#endif
+{
+  s7_cell **old_free_heap_top;
+  s7_int i;
+
+  if (sc->gc_in_progress)
+    error_nr(sc, sc->error_symbol, set_elist_1(sc, wrap_string(sc, "GC called recursively", 21)));
+  sc->gc_in_progress = true;
+  sc->gc_start = my_clock();
+  sc->gc_calls++;
+  sc->continuation_counter = 0;
+
+  mark_rootlet(sc);
+  mark_owlet(sc);
+
+  gc_mark(sc->code);
+  if ((S7_DEBUGGING) && (!(sc->args))) {fprintf(stderr, "%d: sc->args is NULL\n", __LINE__); if (sc->stop_at_error) abort();}
+  /* if (sc->args) */ gc_mark(sc->args);
+  gc_mark(sc->curlet);   /* not mark_let because op_any_closure_3p uses sc->curlet as a temp!! */
+  mark_current_code(sc); /* probably redundant if with_history */
+  gc_mark(sc->value);
+
+  mark_stack_1(sc->stack, stack_top(sc));
+  set_mark(current_input_port(sc));
+  mark_input_port_stack(sc);
+  set_mark(current_output_port(sc));
+  set_mark(current_error_port(sc));
+  mark_pair(sc->stacktrace_defaults);
+  gc_mark(sc->autoload_table);        /* () or a hash-table */
+  set_mark(sc->default_random_state); /* always a random_state object */
+  if ((S7_DEBUGGING) && (!(sc->let_temp_hook))) {fprintf(stderr, "%d: sc->let_temp_hook is NULL\n", __LINE__); if (sc->stop_at_error) abort();}
+  /* if (sc->let_temp_hook) */ gc_mark(sc->let_temp_hook);
+
+  gc_mark(sc->w);
+  gc_mark(sc->x);
+  gc_mark(sc->y);
+  gc_mark(sc->z);
+  gc_mark(sc->temp1);
+  gc_mark(sc->temp2);
+  gc_mark(sc->temp3);
+  gc_mark(sc->temp4);
+  gc_mark(sc->temp5);
+  gc_mark(sc->temp6);
+  gc_mark(sc->temp7);
+  gc_mark(sc->temp8);
+  gc_mark(sc->temp9);
+  gc_mark(sc->temp10);
+
+  gc_mark(car(sc->t1_1));
+  gc_mark(car(sc->t2_1)); gc_mark(car(sc->t2_2));
+  gc_mark(car(sc->t3_1)); gc_mark(car(sc->t3_2)); gc_mark(car(sc->t3_3));
+  gc_mark(car(sc->t4_1));
+  gc_mark(car(sc->mlist_1));
+  gc_mark(car(sc->mlist_2)); gc_mark(cadr(sc->mlist_2));
+  gc_mark(car(sc->plist_1));
+  gc_mark(car(sc->plist_2)); gc_mark(car(sc->plist_2_2));
+  gc_mark(car(sc->plist_3)); gc_mark(cadr(sc->plist_3)); gc_mark(caddr(sc->plist_3)); gc_mark(car(sc->plist_4));
+  gc_mark(car(sc->qlist_2)); gc_mark(cadr(sc->qlist_2));
+  gc_mark(car(sc->qlist_3));
+  gc_mark(car(sc->u1_1));
+
+  gc_mark(sc->rec_p1);
+  gc_mark(sc->rec_p2);
+
+  /* these do need to be marked, at least protecting "info" for the duration of the error handler procedure */
+  for (s7_pointer p = cdr(sc->wrong_type_arg_info); is_pair(p); p = cdr(p)) gc_mark(car(p));
+  for (s7_pointer p = cdr(sc->sole_arg_wrong_type_info); is_pair(p); p = cdr(p)) gc_mark(car(p));
+  for (s7_pointer p = cdr(sc->out_of_range_info); is_pair(p); p = cdr(p)) gc_mark(car(p));
+  for (s7_pointer p = cdr(sc->sole_arg_out_of_range_info); is_pair(p); p = cdr(p)) gc_mark(car(p));
+
+  gc_mark(car(sc->elist_1));
+  gc_mark(car(sc->elist_2)); gc_mark(cadr(sc->elist_2));
+  gc_mark(car(sc->elist_3)); gc_mark(cadr(sc->elist_3)); gc_mark(caddr(sc->elist_3));
+  gc_mark(car(sc->elist_4));
+  gc_mark(car(sc->elist_5));
+  gc_mark(car(sc->elist_6));
+  gc_mark(car(sc->elist_7));
+
+  for (i = 1; i < NUM_SAFE_LISTS; i++) /* see tgen.scm -- we can't just check sc->current_safe_list */
+    if ((is_pair(sc->safe_lists[i])) &&
+	(list_is_in_use(sc->safe_lists[i]))) /* safe_lists are semipermanent, so we have to mark contents by hand */
+      for (s7_pointer p = sc->safe_lists[i]; is_pair(p); p = cdr(p))
+	gc_mark(car(p));
+
+  for (i = 0; i < sc->setters_loc; i++)
+    gc_mark(cdr(sc->setters[i]));
+
+  for (i = 0; i <= sc->format_depth; i++) /* sc->num_fdats is size of array */
+    if (sc->fdats[i])
+      gc_mark(sc->fdats[i]->curly_arg);
+
+  if (sc->rec_stack)
+    {
+      set_mark(sc->rec_stack);
+      for (i = 0; i < sc->rec_loc; i++)
+	gc_mark(sc->rec_els[i]);
+    }
+  mark_vector(sc->protected_objects);
+  mark_vector(sc->protected_setters);
+  set_mark(sc->protected_setter_symbols);
+  if ((is_symbol(sc->profile_prefix)) && (is_gensym(sc->profile_prefix))) set_mark(sc->profile_prefix);
+  gc_mark(sc->symbol_printer);
+
+  /* protect recent allocations using the free_heap cells above the current free_heap_top (if any).
+   * cells above sc->free_heap_top might be malloc'd garbage (after heap reallocation), so we keep track of
+   *   where the last actually freed cells were after the previous GC call.  We're trying to
+   *   GC protect the previous GC_TEMPS_SIZE allocated pointers so that the caller doesn't have
+   *   to gc-protect every temporary cell.
+   */
+  {
+    s7_pointer *tmps = sc->free_heap_top;
+    s7_pointer *tmps_top = tmps + sc->gc_temps_size;
+    if (tmps_top > sc->previous_free_heap_top)
+      tmps_top = sc->previous_free_heap_top;
+    while (tmps < tmps_top)
+      gc_mark(*tmps++);
+  }
+  mark_op_stack(sc);
+  mark_semipermanent_objects(sc);
+
+  if (sc->profiling_gensyms)
+    {
+      profile_data_t *pd = sc->profile_data;
+      for (i = 0; i < pd->top; i++)
+	if ((pd->funcs[i]) && (is_gensym(pd->funcs[i])))
+	  set_mark(pd->funcs[i]);
+    }
+
+  {
+    gc_list_t *gp = sc->opt1_funcs;
+    for (i = 0; i < gp->loc; i++)
+      {
+	s7_pointer s1 = T_Pair(gp->list[i]);
+	if ((is_marked(s1)) && (!is_marked(opt1_any(s1)))) /* opt1_lambda, but op_unknown* can change to opt1_cfunc etc */
+	  gc_mark(opt1_any(s1));                           /* not set_mark -- need to protect let/body/args as well */
+      }}
+
+  /* free up all unmarked objects */
+  old_free_heap_top = sc->free_heap_top;
+  {
+    s7_pointer *fp = sc->free_heap_top;
+    s7_pointer *tp = sc->heap;
+    s7_pointer *heap_top = (s7_pointer *)(sc->heap + sc->heap_size);
+
+#if S7_DEBUGGING
+  #define gc_object(Tp)							\
+    p = (*Tp++);							\
+    if (signed_type(p) > 0)						\
+      {								        \
+        p->debugger_bits = 0; p->gc_func = func; p->gc_line = line;	\
+        if (has_odd_bits(p)) {char *s; fprintf(stderr, "odd bits: %s\n", s = describe_type_bits(sc, p)); free(s);} \
+	if (!in_heap(p)) {char *s; fprintf(stderr, "not in heap: %s\n", s = describe_type_bits(sc, p)); free(s);} \
+        clear_type(p);							\
+        (*fp++) = p;							\
+      }									\
+    else if (signed_type(p) < 0) clear_mark(p);
+#else
+  #define gc_object(Tp) p = (*Tp++); if (signed_type(p) > 0) {clear_type(p); (*fp++) = p;} else if (signed_type(p) < 0) clear_mark(p);
+  /* this appears to be about 10% faster than the previous form
+   *   if the sign bit is on, but no other bits, this version will take no action (it thinks the cell is on the free list), but
+   *   it means we've marked a free cell as in-use: since types are set as soon as removed from the free list, this has to be a bug
+   *   (this case is caught by has_odd_bits).  If ignored, the type will be set, and later the bit cleared, so no problem?
+   *   An alternate form that simply calls clear_mark (no check for < 0) appears to be the same speed even in cases with lots
+   *   of long-lived objects.
+   */
+#endif
+    while (tp < heap_top)          /* != here or ^ makes no difference, and going to 64 (from 32) doesn't matter */
+      {
+	s7_pointer p;
+	LOOP_8(gc_object(tp));
+	LOOP_8(gc_object(tp));
+	LOOP_8(gc_object(tp));
+	LOOP_8(gc_object(tp));
+      }
+    /* I tried using pthreads here, since there is no need for a lock in this loop, but the *fp++ part needs to
+     *   be local to each thread, then merged at the end.  In my timing tests, the current version was faster.
+     *   If NUM_THREADS=2, and all thread variables are local, surely there's no "false sharing"?
+     */
+    sc->free_heap_top = fp;
+    sweep(sc);
+  }
+
+  unmark_semipermanent_objects(sc);
+  sc->gc_freed = (int64_t)(sc->free_heap_top - old_free_heap_top);
+  sc->gc_total_freed += sc->gc_freed;
+  sc->gc_end = my_clock();
+  sc->gc_total_time += (sc->gc_end - sc->gc_start);
+
+  if (show_gc_stats(sc))
+    {
+#if (!MS_WINDOWS)
+#if S7_DEBUGGING
+      s7_warn(sc, 512, "%s[%d]: gc freed %" ld64 "/%" ld64 " (free: %" p64 "), time: %f\n", func, line,
+	      sc->gc_freed, sc->heap_size, (intptr_t)(sc->free_heap_top - sc->free_heap), (double)(sc->gc_end - sc->gc_start) / ticks_per_second());
+#else
+      s7_warn(sc, 256, "gc freed %" ld64 "/%" ld64 " (free: %" p64 "), time: %f\n",
+	      sc->gc_freed, sc->heap_size, (intptr_t)(sc->free_heap_top - sc->free_heap), (double)(sc->gc_end - sc->gc_start) / ticks_per_second());
+#endif
+#else
+      s7_warn(sc, 256, "gc freed %" ld64 "/%" ld64 "\n", sc->gc_freed, sc->heap_size);
+#endif
+    }
+  if (show_protected_objects_stats(sc))
+    {
+      s7_int num, len = vector_length(sc->protected_objects); /* allocated at startup */
+      for (i = 0, num = 0; i < len; i++)
+	if (vector_element(sc->protected_objects, i) != sc->unused)
+	  num++;
+      s7_warn(sc, 256, "gc-protected-objects: %" ld64 " in use of %" ld64 "\n", num, len);
+    }
+  sc->previous_free_heap_top = sc->free_heap_top;
+  sc->gc_in_progress = false;
+  return(sc->gc_freed);
+}
+
+
+#ifndef GC_RESIZE_HEAP_FRACTION
+  #define GC_RESIZE_HEAP_FRACTION 0.8
+/* 1/2 is ok, 3/4 speeds up some GC benchmarks, 7/8 is a bit faster, 95/100 comes to a halt (giant heap)
+ *    in my tests, only tvect.scm ends up larger if 3/4 used
+ */
+#endif
+
+#define GC_RESIZE_HEAP_BY_4_FRACTION 0.67
+/*   .5+.1: test -3?, dup +86, tmap +45, tsort -3, thash +305.  .85+.7: dup -5 */
+
+#if S7_DEBUGGING
+#define resize_heap_to(Sc, Size) resize_heap_to_1(Sc, Size, __func__, __LINE__)
+static void resize_heap_to_1(s7_scheme *sc, int64_t size, const char *func, int line)
+#else
+static void resize_heap_to(s7_scheme *sc, int64_t size)
+#endif
+{
+  int64_t old_size = sc->heap_size;
+  int64_t old_free = sc->free_heap_top - sc->free_heap;
+  s7_cell *cells;
+  s7_cell **cp;
+  heap_block_t *hp;
+
+#if (S7_DEBUGGING) && (!MS_WINDOWS)
+  if (show_gc_stats(sc))
+    s7_warn(sc, 512, "%s from %s[%d]: old: %" ld64 " / %" ld64 ", new: %" ld64 ", fraction: %.3f -> %" ld64 "\n",
+	    __func__, func, line, old_free, old_size, size, sc->gc_resize_heap_fraction, (int64_t)(floor(sc->heap_size * sc->gc_resize_heap_fraction)));
+#endif
+
+  if (size == 0)
+    {
+      if ((old_free < old_size * sc->gc_resize_heap_by_4_fraction) &&
+	  (sc->max_heap_size > (sc->heap_size * 4)))
+	sc->heap_size *= 4;          /* *8 if < 1M (or whatever) doesn't make much difference */
+      else sc->heap_size *= 2;
+      if (sc->gc_resize_heap_fraction > .4)
+	sc->gc_resize_heap_fraction *= .95;
+    }
+  else
+    if (size > sc->heap_size)
+      while (sc->heap_size < size) sc->heap_size *= 2;
+    else return;
+  /* do not call new_cell here! */
+#if POINTER_32
+  if (((2 * sc->heap_size * sizeof(s7_cell *)) + ((sc->heap_size - old_size) * sizeof(s7_cell))) >= SIZE_MAX)
+    { /* can this happen in 64-bit land?  SIZE_MAX is unsigned int in 32-bit, unsigned long in 64 bit = UINTPTR_MAX = 18446744073709551615UL */
+      s7_warn(sc, 256, "heap size requested, %" ld64 " => %" ld64 " bytes, is greater than size_t: %u\n",
+	      sc->heap_size,
+	      (2 * sc->heap_size * sizeof(s7_cell *)) + ((sc->heap_size - old_size) * sizeof(s7_cell)),
+	      SIZE_MAX);
+      sc->heap_size = old_size + 64000;
+    }
+#endif
+  cp = (s7_cell **)Realloc(sc->heap, sc->heap_size * sizeof(s7_cell *));
+  if (cp)
+    sc->heap = cp;
+  else /* can this happen? */
+    {
+      s7_warn(sc, 256, "heap reallocation failed! tried to get %" ld64 " bytes (will retry with a smaller amount)\n",
+	      (int64_t)(sc->heap_size * sizeof(s7_cell *)));
+      sc->heap_size = old_size + 64000;
+      sc->heap = (s7_cell **)Realloc(sc->heap, sc->heap_size * sizeof(s7_cell *));
+    }
+  sc->free_heap = (s7_cell **)Realloc(sc->free_heap, sc->heap_size * sizeof(s7_cell *));
+  sc->free_heap_trigger = (s7_cell **)(sc->free_heap + GC_TRIGGER_SIZE);
+  sc->free_heap_top = sc->free_heap + old_free; /* incremented below, added old_free 21-Aug-12?!? */
+
+  cells = (s7_cell *)Calloc(sc->heap_size - old_size, sizeof(s7_cell)); /* Malloc + clear_type below is much slower?! */
+  add_saved_pointer(sc, (void *)cells);
+  {
+    s7_pointer p = cells;
+    for (int64_t k = old_size; k < sc->heap_size;)
+      {
+	LOOP_8(sc->heap[k++] = p; (*sc->free_heap_top++) = p++);
+	LOOP_8(sc->heap[k++] = p; (*sc->free_heap_top++) = p++);
+	LOOP_8(sc->heap[k++] = p; (*sc->free_heap_top++) = p++);
+	LOOP_8(sc->heap[k++] = p; (*sc->free_heap_top++) = p++);
+      }}
+  hp = (heap_block_t *)Malloc(sizeof(heap_block_t));
+  hp->start = (intptr_t)cells;
+  hp->end = (intptr_t)cells + ((sc->heap_size - old_size) * sizeof(s7_cell));
+  hp->offset = old_size;
+  hp->next = sc->heap_blocks;
+  sc->heap_blocks = hp;
+  sc->previous_free_heap_top = sc->free_heap_top;
+
+  if (show_heap_stats(sc))
+    {
+      if (size != 0)
+	s7_warn(sc, 512, "heap grows to %" ld64 " (old free/size: %" ld64 "/%" ld64 ", requested %" ld64 ")\n",
+		sc->heap_size, old_free, old_size, size);
+      else s7_warn(sc, 512, "heap grows to %" ld64 " (old free/size: %" ld64 "/%" ld64 ", %.3f)\n",
+		   sc->heap_size, old_free, old_size, sc->gc_resize_heap_fraction);
+    }
+  if (sc->heap_size >= sc->max_heap_size)
+    error_nr(sc, make_symbol(sc, "heap-too-big", 12),
+	     set_elist_3(sc, wrap_string(sc, "heap has grown past (*s7* 'max-heap-size): ~D > ~D", 50),
+			 wrap_integer(sc, sc->max_heap_size),
+			 wrap_integer(sc, sc->heap_size)));
+}
+
+
+#define resize_heap(Sc) resize_heap_to(Sc, 0)
+
+#if S7_DEBUGGING
+#define call_gc(Sc) gc(Sc, __func__, __LINE__)
+static void try_to_call_gc_1(s7_scheme *sc, const char *func, int32_t line)
+#else
+#define call_gc(Sc) gc(Sc)
+static void try_to_call_gc(s7_scheme *sc)
+#endif
+{
+  /* called only from new_cell */
+  if (sc->gc_off)     /* we can't just return here!  Someone needs a new cell, and once the heap free list is exhausted, segfault */
+    resize_heap(sc);
+  else
+    {
+      if ((sc->gc_resize_heap_fraction > 0.5) && (sc->heap_size >= 4194304))
+	  sc->gc_resize_heap_fraction = 0.5;
+#if S7_DEBUGGING
+      gc(sc, func, line); /* not call_gc! */
+#else
+      gc(sc);
+#endif
+      if ((int64_t)(sc->free_heap_top - sc->free_heap) < (sc->heap_size * sc->gc_resize_heap_fraction)) /* changed 21-Jul-22 */
+	resize_heap(sc);
+    }
+}
+  /* originally I tried to mark each temporary value until I was done with it, but that way madness lies... By delaying
+   *   GC of _every_ %$^#%@ pointer, I can dispense with hundreds of individual protections.  So the free_heap's last
+   *   GC_TEMPS_SIZE allocated pointers are protected during the mark sweep.
+   */
+
+static s7_pointer g_gc(s7_scheme *sc, s7_pointer args)
+{
+  #define H_gc "(gc (on #t)) runs the garbage collector.  If 'on' (a boolean) is supplied, it turns the GC on or off. \
+Evaluation produces a surprising amount of garbage, so don't leave the GC off for very long!"
+  #define Q_gc s7_make_signature(sc, 2, sc->T, sc->is_boolean_symbol)
+
+  /* g_gc can't be called in a situation where these lists matter -- oops, gc called in scheme can be using these! and maybe elist... */
+#if 0
+  set_mlist_1(sc, sc->unused);
+  set_mlist_2(sc, sc->unused, sc->unused);
+  set_plist_1(sc, sc->unused);
+  set_plist_2(sc, sc->unused, sc->unused);
+  set_plist_3(sc, sc->unused, sc->unused, sc->unused);
+  set_car(sc->plist_4, sc->unused);
+  set_qlist_2(sc, sc->unused, sc->unused);
+  set_car(sc->qlist_3, sc->unused);
+  set_ulist_1(sc, sc->unused, sc->unused);
+#endif
+  set_elist_1(sc, sc->unused);
+  set_elist_2(sc, sc->unused, sc->unused);
+  set_elist_3(sc, sc->unused, sc->unused, sc->unused);
+  set_car(sc->elist_4, sc->unused);
+  set_car(sc->elist_5, sc->unused);
+  set_car(sc->elist_6, sc->unused);
+  set_car(sc->elist_7, sc->unused); /* clist and dlist are weak references */
+  if (is_not_null(args))
+    {
+      if (!is_boolean(car(args)))
+	return(sole_arg_method_or_bust(sc, car(args), sc->gc_symbol, args, sc->type_names[T_BOOLEAN]));
+      sc->gc_off = (car(args) == sc->F);
+      if (sc->gc_off)
+	return(sc->F);
+    }
+  call_gc(sc);
+  return(sc->unspecified);
+}
+
+s7_pointer s7_gc_on(s7_scheme *sc, bool on)
+{
+  sc->gc_off = !on;
+  return(make_boolean(sc, on));
+}
+
+#if S7_DEBUGGING
+static void check_free_heap_size_1(s7_scheme *sc, s7_int size, const char *func, int32_t line)
+#define check_free_heap_size(Sc, Size) check_free_heap_size_1(Sc, Size, __func__, __LINE__)
+#else
+static void check_free_heap_size(s7_scheme *sc, s7_int size)
+#endif
+{
+  s7_int free_cells = sc->free_heap_top - sc->free_heap;
+  if (free_cells < size)
+    {
+#if S7_DEBUGGING
+      gc(sc, func, line);
+#else
+      gc(sc);
+#endif
+      while ((sc->free_heap_top - sc->free_heap) < (s7_int)(size * 1.5))
+	resize_heap(sc);
+    }
+}
+
+#define ALLOC_POINTER_SIZE 256
+static s7_cell *alloc_pointer(s7_scheme *sc)
+{
+  if (sc->alloc_pointer_k == ALLOC_POINTER_SIZE)     /* if either no current block or the block is used up, make a new block */
+    {
+      sc->semipermanent_cells += ALLOC_POINTER_SIZE;
+      sc->alloc_pointer_cells = (s7_cell *)Calloc(ALLOC_POINTER_SIZE, sizeof(s7_cell)); /* not Malloc here or below (maybe set full type to 0 if Malloc) */
+      add_saved_pointer(sc, sc->alloc_pointer_cells);
+      sc->alloc_pointer_k = 0;
+    }
+  return(&(sc->alloc_pointer_cells[sc->alloc_pointer_k++]));
+}
+
+#define ALLOC_BIG_POINTER_SIZE 256
+static s7_big_cell *alloc_big_pointer(s7_scheme *sc, int64_t loc)
+{
+  s7_big_pointer p;
+  if (sc->alloc_big_pointer_k == ALLOC_BIG_POINTER_SIZE)
+    {
+      sc->semipermanent_cells += ALLOC_BIG_POINTER_SIZE;
+      sc->alloc_big_pointer_cells = (s7_big_cell *)Calloc(ALLOC_BIG_POINTER_SIZE, sizeof(s7_big_cell));
+      add_saved_pointer(sc, sc->alloc_big_pointer_cells);
+      sc->alloc_big_pointer_k = 0;
+    }
+  p = (&(sc->alloc_big_pointer_cells[sc->alloc_big_pointer_k++]));
+  p->big_hloc = loc;
+  /* needed if this new pointer is itself petrified later -- it's not from one of the heap blocks,
+   *   but it's in the heap, and we'll need to know where it is in the heap to replace it
+   */
+  return(p);
+}
+
+static void add_semipermanent_object(s7_scheme *sc, s7_pointer obj) /* called by remove_from_heap */
+{
+  gc_obj_t *g = (gc_obj_t *)Malloc(sizeof(gc_obj_t));
+  g->p = obj;
+  g->nxt = sc->semipermanent_objects;
+  sc->semipermanent_objects = g;
+}
+
+static void add_semipermanent_let_or_slot(s7_scheme *sc, s7_pointer obj)
+{
+  gc_obj_t *g = (gc_obj_t *)Malloc(sizeof(gc_obj_t));
+  g->p = obj;
+  g->nxt = sc->semipermanent_lets;
+  sc->semipermanent_lets = g;
+}
+
+#if S7_DEBUGGING
+static const char *type_name_from_type(int32_t typ, article_t article);
+
+#define free_cell(Sc, P) free_cell_1(Sc, P, __LINE__)
+static void free_cell_1(s7_scheme *sc, s7_pointer p, int32_t line)
+#else
+static void free_cell(s7_scheme *sc, s7_pointer p)
+#endif
+{ /* this can make a big difference: 474 in snd-test! */
+#if S7_DEBUGGING
+  /* anything that needs gc_list attention should not be freed here */
+  uint8_t typ = unchecked_type(p);
+  gc_list_t *gp = sc->opt1_funcs;
+
+  if ((t_freeze_p[typ]) || ((typ == T_SYMBOL) && (is_gensym(p))))
+    fprintf(stderr, "free_cell of %s?\n", type_name_from_type(typ, NO_ARTICLE));
+  if ((t_any_closure_p[typ]) && (gp->loc > 0))
+    for (s7_int i = 0; i < gp->loc; i++)
+      if (gp->list[i] == p)
+	fprintf(stderr, "opt1_funcs free_cell of %s?\n", type_name_from_type(typ, NO_ARTICLE));
+  gp = sc->weak_refs;
+  if (gp->loc > 0)
+    for (s7_int i = 0; i < gp->loc; i++)
+      if (gp->list[i] == p)
+	fprintf(stderr, "weak refs free_cell of %s?\n", type_name_from_type(typ, NO_ARTICLE));
+
+  p->debugger_bits = 0;
+  p->explicit_free_line = line;
+#endif
+  clear_type(p);
+  (*(sc->free_heap_top++)) = p;
+}
+
+static inline s7_pointer petrify(s7_scheme *sc, s7_pointer x)
+{
+  int64_t loc = heap_location(sc, x);
+  s7_pointer p = (s7_pointer)alloc_big_pointer(sc, loc);
+  sc->heap[loc] = p;
+  free_cell(sc, p);
+  unheap(sc, x);        /* set_immutable(x); */ /* if there are GC troubles, this might catch them? */
+  return(x);
+}
+
+#if S7_DEBUGGING
+#define remove_gensym_from_heap(Sc, Gensym) remove_gensym_from_heap_1(Sc, Gensym, __func__, __LINE__)
+static void remove_gensym_from_heap_1(s7_scheme *sc, s7_pointer x, const char *func, int line)
+#else
+static void remove_gensym_from_heap(s7_scheme *sc, s7_pointer x) /* x known to be a symbol and in the heap */
+#endif
+{
+  int64_t loc = heap_location(sc, x);
+  sc->heap[loc] = (s7_pointer)alloc_big_pointer(sc, loc);
+  free_cell(sc, sc->heap[loc]);
+#if S7_DEBUGGING
+  x->gc_func = func; /* main culprit in s7test/t725 is (essentially) (symbol->keyword (gensym)) */
+  x->gc_line = line;
+#endif
+  unheap(sc, x); /* set UNHEAP bit in type(x) */
+  {
+    gc_list_t *gp = sc->gensyms;
+    for (s7_int i = 0; i < gp->loc; i++) /* sc->gensyms reaches size 512 during s7test, but this search is called 3 times and costs nothing */
+      if (gp->list[i] == x)
+	{
+	  for (s7_int j = i + 1; i < gp->loc - 1; i++, j++)
+	    gp->list[i] = gp->list[j];
+	  gp->list[i] = NULL;
+	  gp->loc--;
+	  if (gp->loc == 0) mark_function[T_SYMBOL] = mark_noop;
+	  break;
+	}}
+}
+
+static inline void remove_from_heap(s7_scheme *sc, s7_pointer x)
+{
+  /* global functions are very rarely redefined, so we can remove the function body from the heap when it is defined */
+  if (!in_heap(x)) return;
+  if (is_pair(x))   /* all the compute time is here, might be faster to go down a level explicitly */
+    {
+      s7_pointer p = x;
+      do {
+	petrify(sc, p);
+	remove_from_heap(sc, car(p));
+	p = cdr(p);
+      } while (is_pair(p) && (in_heap(p)));
+      if (in_heap(p)) petrify(sc, p);
+      return;
+    }
+  switch (type(x))
+    {
+    case T_LET: /* very rare */
+      if (is_funclet(x)) set_immutable_let(x);
+    case T_HASH_TABLE:
+    case T_VECTOR:
+      /* not int|float_vector or string because none of their elements are GC-able (so unheap below is ok)
+       *   but hash-table and let seem like they need protection? And let does happen via define-class.
+       */
+      add_semipermanent_object(sc, x);
+      return;
+    case T_SYMBOL:
+      if (is_gensym(x))
+	remove_gensym_from_heap(sc, x);
+      return;
+    case T_CLOSURE: case T_CLOSURE_STAR:
+    case T_MACRO:   case T_MACRO_STAR:
+    case T_BACRO:   case T_BACRO_STAR:
+      /* these need to be GC-protected! */
+      add_semipermanent_object(sc, x);
+      return;
+    default: break;
+    }
+  petrify(sc, x);
+}
+
+
+/* -------------------------------- stacks -------------------------------- */
+
+/* -------- op stack -------- */
+#define OP_STACK_INITIAL_SIZE 64
+
+#define op_stack_entry(Sc) (*(Sc->op_stack_now - 1))
+
+#if S7_DEBUGGING
+static void push_op_stack(s7_scheme *sc, s7_pointer op)
+{
+  (*sc->op_stack_now++) = T_Ext(op); /* not T_App etc -- args can be pushed */
+  if (sc->op_stack_now > (sc->op_stack + sc->op_stack_size))
+    {
+      fprintf(stderr, "%sop_stack overflow%s\n", bold_text, unbold_text);
+      if (sc->stop_at_error) abort();
+    }
+}
+
+static s7_pointer pop_op_stack(s7_scheme *sc)
+{
+  s7_pointer op = T_Ext(*(--(sc->op_stack_now)));
+  if (sc->op_stack_now < sc->op_stack)
+    {
+      fprintf(stderr, "%sop_stack underflow%s\n", bold_text, unbold_text);
+      if (sc->stop_at_error) abort();
+    }
+  return(T_Ext(op));
+}
+#else
+#define push_op_stack(Sc, Op) (*Sc->op_stack_now++) = Op
+#define pop_op_stack(Sc)      (*(--(Sc->op_stack_now)))
+#endif
+
+static void initialize_op_stack(s7_scheme *sc)
+{
+  sc->op_stack = (s7_pointer *)Malloc(OP_STACK_INITIAL_SIZE * sizeof(s7_pointer));
+  sc->op_stack_size = OP_STACK_INITIAL_SIZE;
+  sc->op_stack_now = sc->op_stack;
+  sc->op_stack_end = (s7_pointer *)(sc->op_stack + sc->op_stack_size);
+  for (int32_t i = 0; i < OP_STACK_INITIAL_SIZE; i++) sc->op_stack[i] = sc->unused;
+}
+
+static void resize_op_stack(s7_scheme *sc)
+{
+  int32_t new_size = sc->op_stack_size * 2;
+  int32_t loc = (int32_t)(sc->op_stack_now - sc->op_stack);
+  sc->op_stack = (s7_pointer *)Realloc((void *)(sc->op_stack), new_size * sizeof(s7_pointer));
+  for (int32_t i = sc->op_stack_size; i < new_size; i++) sc->op_stack[i] = sc->unused;
+  sc->op_stack_size = (uint32_t)new_size;
+  sc->op_stack_now = (s7_pointer *)(sc->op_stack + loc);
+  sc->op_stack_end = (s7_pointer *)(sc->op_stack + sc->op_stack_size);
+}
+
+
+/* -------- main stack -------- */
+/* stack_top_code changes.  If a function has a tail-call, the stack_top_code that form sees
+ *   if stack_top_op==op-begin1 can change from call to call -- the begin actually refers
+ *   to the caller, which is dependent on where the current function was called, so we can't hard-wire
+ *   any optimizations based on that sequence.
+ */
+
+#define stack_op(Stack, Loc)         ((opcode_t)T_Op(stack_element(Stack, Loc)))
+#define stack_args(Stack, Loc)       stack_element(Stack, Loc - 1)
+#define stack_let(Stack, Loc)        stack_element(Stack, Loc - 2)
+#define stack_code(Stack, Loc)       stack_element(Stack, Loc - 3)
+#define set_stack_op(Stack, Loc, Op) stack_element(Stack, Loc) = (s7_pointer)(opcode_t)(Op)
+
+#define stack_top_op(Sc)             ((opcode_t)T_Op(Sc->stack_end[-1]))
+#define unchecked_stack_top_op(Sc)   ((opcode_t)(Sc->stack_end[-1]))
+#define stack_top_args(Sc)           (Sc->stack_end[-2])
+#define stack_top_let(Sc)            (Sc->stack_end[-3])
+#define stack_top_code(Sc)           (Sc->stack_end[-4])
+#define set_stack_top_op(Sc, Op)     Sc->stack_end[-1] = (s7_pointer)(opcode_t)(Op)
+#define set_stack_top_args(Sc, Args) Sc->stack_end[-2] = Args
+#define set_stack_top_code(Sc, Code) Sc->stack_end[-4] = Code
+
+#define stack_end_code(Sc) Sc->stack_end[0]
+#define stack_end_let(Sc)  Sc->stack_end[1]
+#define stack_end_args(Sc) Sc->stack_end[2]
+#define stack_end_op(Sc)   Sc->stack_end[3]
+
+void s7_show_stack(s7_scheme *sc);
+
+#if S7_DEBUGGING
+#define pop_stack(Sc) pop_stack_1(Sc, __func__, __LINE__)
+static void pop_stack_1(s7_scheme *sc, const char *func, int32_t line)
+{
+  /* if (S7_DEBUGGING) fprintf(stderr, "%s[%d]: pop_stack %s\n", func, line, op_names[(opcode_t)stack_top_op(sc)]); */
+  sc->stack_end -= 4;
+  if (sc->stack_end < sc->stack_start)
+    {
+      fprintf(stderr, "%s%s[%d]: stack underflow%s\n", bold_text, func, line, unbold_text);
+      if (sc->stop_at_error) abort();
+    }
+  /* here and in push_stack, both code and args might be non-free only because they've been retyped
+   *   inline (as in named let) -- they actually don't make sense in these cases, but are ignored,
+   *   and are carried around as GC protection in other cases.
+   */
+  sc->code = T_Pos(stack_end_code(sc));
+  sc->curlet = stack_end_let(sc);  /* not T_Let|Pos, see op_any_closure_3p_end et al (stack used to pass args, not curlet) */
+  sc->args = stack_end_args(sc);
+  sc->cur_op = (opcode_t)T_Op(stack_end_op(sc));
+  if ((sc->cur_op != OP_GC_PROTECT) &&
+      (!is_let(stack_end_let(sc))) && (!is_null(stack_end_let(sc))) &&
+      (sc->cur_op != OP_ANY_CLOSURE_3P_3)) /* used as third GC protection field */
+    fprintf(stderr, "%s[%d]: curlet not a let: %s\n", func, line, op_names[sc->cur_op]);
+}
+
+#define pop_stack_no_op(Sc) pop_stack_no_op_1(Sc, __func__, __LINE__)
+static void pop_stack_no_op_1(s7_scheme *sc, const char *func, int32_t line)
+{
+  /* if (S7_DEBUGGING) fprintf(stderr, "%s[%d]: pop_stack_no_op %s\n", func, line, op_names[(opcode_t)stack_top_op(sc)]); */
+  sc->stack_end -= 4;
+  if (sc->stack_end < sc->stack_start)
+    {
+      fprintf(stderr, "%s%s[%d]: stack underflow%s\n", bold_text, func, line, unbold_text);
+      if (sc->stop_at_error) abort();
+    }
+  sc->code = T_Pos(stack_end_code(sc));
+  if ((sc->cur_op != OP_GC_PROTECT) && (!is_let(stack_end_let(sc))))
+    fprintf(stderr, "%s[%d]: curlet not a let\n", func, line);
+  sc->curlet = stack_end_let(sc); /* not T_Let|Pos: gc_protect can set this directly (not through push_stack) to anything */
+  sc->args = stack_end_args(sc);
+}
+
+static void push_stack_1(s7_scheme *sc, opcode_t op, s7_pointer args, s7_pointer code, s7_pointer *end, const char *func, int32_t line)
+{
+  /* if (S7_DEBUGGING) fprintf(stderr, "%s[%d]: %u push_stack %s\n", func, line, (uint32_t)((intptr_t)(sc->stack_end - sc->stack_start)), op_names[op]); */
+  if ((SHOW_EVAL_OPS) && (op == OP_EVAL_DONE)) fprintf(stderr, "  %s[%d]: push eval_done\n", func, line);
+  if (sc->stack_end >= sc->stack_start + sc->stack_size)
+    {
+      fprintf(stderr, "%s%s[%d]: stack overflow, %u > %u, trigger: %u %s\n",
+	      bold_text, func, line,
+	      (uint32_t)((intptr_t)(sc->stack_end - sc->stack_start)), sc->stack_size,
+	      (uint32_t)((intptr_t)(sc->stack_resize_trigger - sc->stack_start)),
+	      unbold_text);
+      s7_show_stack(sc);
+      if (sc->stop_at_error) abort();
+    }
+  if (sc->stack_end >= sc->stack_resize_trigger)
+    fprintf(stderr, "%s%s[%d] from %s: stack resize skipped, stack at %u of %u %s%s\n",
+	    bold_text, func, line, op_names[op],
+	    (uint32_t)((intptr_t)(sc->stack_end - sc->stack_start)),
+	    sc->stack_size, display_truncated(code), unbold_text);
+  if (sc->stack_end != end)
+    fprintf(stderr, "%s[%d]: stack changed in push_stack\n", func, line);
+  if (op >= NUM_OPS)
+    {
+      fprintf(stderr, "%s%s[%d]: push_stack invalid opcode: %" p64 " %s\n", bold_text, func, line, sc->cur_op, unbold_text);
+      if (sc->stop_at_error) abort();
+    }
+  if (code) stack_end_code(sc) = T_Pos(code);
+  stack_end_let(sc) = T_Let(sc->curlet);
+  if ((args) && (unchecked_type(args) != T_FREE)) stack_end_args(sc) = T_Pos(args);
+  stack_end_op(sc) = (s7_pointer)op;
+  sc->stack_end += 4;
+}
+
+#define push_stack(Sc, Op, Args, Code)	\
+  do {s7_pointer *_end_; _end_ = Sc->stack_end; push_stack_1(Sc, Op, Args, Code, _end_, __func__, __LINE__);} while (0)
+
+#define push_stack_no_code(Sc, Op, Args)        push_stack(Sc, Op, Args, Sc->unused)
+#define push_stack_no_let_no_code(Sc, Op, Args) push_stack(Sc, Op, Args, Sc->unused)
+#define push_stack_no_args(Sc, Op, Code)        push_stack(Sc, Op, Sc->unused, Code)
+#define push_stack_no_let(Sc, Op, Args, Code)   push_stack(Sc, Op, Args, Code)
+#define push_stack_op(Sc, Op)                   push_stack(Sc, Op, Sc->unused, Sc->unused)
+#define push_stack_op_let(Sc, Op)               push_stack(Sc, Op, Sc->unused, Sc->unused)
+#define push_stack_direct(Sc, Op)               push_stack(Sc, Op, Sc->args, Sc->code)
+#define push_stack_no_args_direct(Sc, Op)       push_stack(Sc, Op, Sc->unused, Sc->code)
+/* in the non-debugging case, the sc->unused's here are not set, so we can (later) pop free cells */
+
+#else
+
+#define pop_stack(Sc)       do {Sc->stack_end -= 4; memcpy((void *)Sc, (void *)(Sc->stack_end), 4 * sizeof(s7_pointer));} while (0)
+#define pop_stack_no_op(Sc) do {Sc->stack_end -= 4; memcpy((void *)Sc, (void *)(Sc->stack_end), 3 * sizeof(s7_pointer));} while (0)
+
+#define push_stack(Sc, Op, Args, Code) \
+  do { \
+      stack_end_code(sc) = Code; \
+      stack_end_let(sc) = Sc->curlet; \
+      stack_end_args(sc) = Args; \
+      stack_end_op(sc) = (s7_pointer)(opcode_t)(Op); \
+      Sc->stack_end += 4; \
+  } while (0)
+
+#define push_stack_direct(Sc, Op) \
+  do { \
+      Sc->cur_op = Op; \
+      memcpy((void *)(Sc->stack_end), (void *)Sc, 4 * sizeof(s7_pointer)); \
+      /* stack_end_op(sc) = (s7_pointer)(opcode_t)(Op); */ \
+      Sc->stack_end += 4; \
+  } while (0)
+/* is this faster with cur_op because of the cast to s7_pointer, or is callgrind messing up memcpy stats?
+ *   time's output is all over the map.  I think the cur_op form should be slower, but callgrind disagrees.
+ */
+
+#define push_stack_no_code(Sc, Op, Args) \
+  do { \
+      stack_end_let(sc) = Sc->curlet; \
+      stack_end_args(sc) = Args; \
+      stack_end_op(sc) = (s7_pointer)(opcode_t)(Op); \
+      Sc->stack_end += 4; \
+  } while (0)
+
+#define push_stack_no_let_no_code(Sc, Op, Args) \
+  do { \
+      stack_end_args(sc) = Args; \
+      stack_end_op(sc) = (s7_pointer)(opcode_t)(Op); \
+      Sc->stack_end += 4; \
+  } while (0)
+
+#define push_stack_no_args(Sc, Op, Code) \
+  do { \
+      stack_end_code(sc) = Code; \
+      stack_end_let(sc) = Sc->curlet; \
+      stack_end_op(sc) = (s7_pointer)(opcode_t)(Op); \
+      Sc->stack_end += 4; \
+  } while (0)
+
+#define push_stack_no_args_direct(Sc, Op) \
+  do { \
+      memcpy((void *)(Sc->stack_end), (void *)Sc, 2 * sizeof(s7_pointer));	\
+      stack_end_op(sc) = (s7_pointer)(opcode_t)(Op); \
+      Sc->stack_end += 4; \
+  } while (0)
+
+#define push_stack_no_let(Sc, Op, Args, Code) \
+  do { \
+      stack_end_code(sc) = Code; \
+      stack_end_args(sc) = Args; \
+      stack_end_op(sc) = (s7_pointer)(opcode_t)(Op); \
+      Sc->stack_end += 4; \
+  } while (0)
+
+#define push_stack_op(Sc, Op) \
+  do { \
+      stack_end_op(sc) = (s7_pointer)(opcode_t)(Op); \
+      Sc->stack_end += 4; \
+  } while (0)
+
+#define push_stack_op_let(Sc, Op) \
+  do { \
+      stack_end_let(sc) = Sc->curlet; \
+      stack_end_op(sc) = (s7_pointer)(opcode_t)(Op); \
+      Sc->stack_end += 4; \
+  } while (0)
+#endif
+/* since we don't GC mark the stack past the stack_top, push_stack_no_args and friends can cause pop_stack to set
+ *   sc->code and sc->args to currently free objects.
+ */
+
+#if S7_DEBUGGING
+#define unstack_with(Sc, Op) unstack_1(Sc, Op, __func__, __LINE__)
+static void unstack_1(s7_scheme *sc, opcode_t op, const char *func, int32_t line)
+{
+  sc->stack_end -= 4;
+  if ((opcode_t)T_Op(stack_end_op(sc)) != op)
+    {
+      fprintf(stderr, "%s%s[%d]: popped %s? (expected %s)%s\n", bold_text, func, line, op_names[(opcode_t)T_Op(stack_end_op(sc))], op_names[op], unbold_text);
+      /* "popped apply" means we called something that went to eval+apply when we thought it was a safe function */
+      fprintf(stderr, "    code: %s\n    args: %s\n", display(sc->code), display(sc->args));
+      fprintf(stderr, "    cur_code: %s\n    estr: %s\n", display(current_code(sc)), display(s7_name_to_value(sc, "estr")));
+      s7_show_stack(sc);
+      if (sc->stop_at_error) abort();
+    }
+}
+#define unstack_gc_protect(Sc) unstack_with(Sc, OP_GC_PROTECT)
+#else
+#define unstack_gc_protect(Sc) Sc->stack_end -= 4
+#define unstack_with(Sc, op) Sc->stack_end -= 4
+#endif
+
+static void stack_reset(s7_scheme *sc)
+{
+  sc->stack_end = sc->stack_start;
+  push_stack_op(sc, OP_EVAL_DONE);
+}
+
+static uint32_t resize_stack_unchecked(s7_scheme *sc)
+{
+  uint64_t loc = stack_top(sc);
+  uint32_t new_size = sc->stack_size * 2;
+  block_t *ob = stack_block(sc->stack);
+  block_t *nb = reallocate(sc, ob, new_size * sizeof(s7_pointer));
+  block_info(nb) = NULL;
+  stack_block(sc->stack) = nb;
+  /* if (block_index(nb) == TOP_BLOCK_LIST) fprintf(stderr, "top %u\n", new_size); */
+  stack_elements(sc->stack) = (s7_pointer *)block_data(nb);
+  {
+    s7_pointer *orig = stack_elements(sc->stack);
+    s7_int i = sc->stack_size;
+    s7_int left = new_size - i - 8;
+    while (i <= left)
+      LOOP_8(orig[i++] = sc->unused);
+    for (; i < new_size; i++)
+      orig[i] = sc->unused;
+  }
+  vector_length(sc->stack) = new_size;
+  sc->stack_size = new_size;
+  sc->stack_start = stack_elements(sc->stack);
+  sc->stack_end = (s7_pointer *)(sc->stack_start + loc);
+  sc->stack_resize_trigger = (s7_pointer *)(sc->stack_start + (new_size - STACK_RESIZE_TRIGGER));
+  return(new_size);
+}
+
+void s7_show_stack(s7_scheme *sc)
+{
+  if (sc->stack_end >= sc->stack_resize_trigger)
+    resize_stack_unchecked(sc);
+  fprintf(stderr, "stack:\n");
+  for (s7_int i = stack_top(sc) - 1, j = 0; (i >= 3) && (j < sc->show_stack_limit); i -= 4, j++) /* s7_int (or uint64_t?) is correct -- not uint32_t */
+    fprintf(stderr, "  %s\n", op_names[stack_op(sc->stack, i)]);
+}
+
+#if S7_DEBUGGING
+#define resize_stack(Sc) resize_stack_1(Sc, __func__, __LINE__)
+static void resize_stack_1(s7_scheme *sc, const char *func, int line)
+{
+  if ((sc->stack_size * 2) > sc->max_stack_size)
+    {
+      fprintf(stderr, "%s%s[%d]: stack will be too big after resize, %u > %u, trigger: %" ld64 "%s\n",
+	      bold_text, func, line, sc->stack_size * 2, sc->max_stack_size,
+	      (s7_int)((intptr_t)(sc->stack_resize_trigger - sc->stack_start)),
+	      unbold_text);
+      s7_show_stack(sc);
+      if (sc->stop_at_error) abort();
+    }
+  resize_stack_unchecked(sc);
+}
+#else
+static void resize_stack(s7_scheme *sc)
+{
+  uint32_t new_size = resize_stack_unchecked(sc);
+  if (show_stack_stats(sc))
+    s7_warn(sc, 128, "stack grows to %u\n", new_size);
+  if (new_size > sc->max_stack_size)
+    error_nr(sc, make_symbol(sc, "stack-too-big", 13),
+	     set_elist_1(sc, wrap_string(sc, "stack has grown past (*s7* 'max-stack-size)", 43)));
+  /* error needs to follow realloc, else error -> catchers in error_nr -> let_temp* -> eval_done -> stack_resize -> infinite loop */
+}
+#endif
+
+#define check_stack_size(Sc) do {if (Sc->stack_end >= Sc->stack_resize_trigger) resize_stack(Sc);} while (0)
+
+s7_pointer s7_gc_protect_via_stack(s7_scheme *sc, s7_pointer x)
+{
+  check_stack_size(sc); /* this can be called externally, so we need to be careful about this */
+  push_stack_no_code(sc, OP_GC_PROTECT, x);
+  return(x);
+}
+
+s7_pointer s7_gc_protect_2_via_stack(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  check_stack_size(sc);
+  push_stack(sc, OP_GC_PROTECT, x, y);
+  return(x);
+}
+
+s7_pointer s7_gc_unprotect_via_stack(s7_scheme *sc, s7_pointer x)
+{
+  unstack_gc_protect(sc); /* this might not be related to 'x' -- something got unprotected */
+  return(x);
+}
+
+#if S7_DEBUGGING
+  static s7_pointer stack_protected1_1(s7_scheme *sc, opcode_t op, const char *func, int line)
+  {
+    if (stack_top_op(sc) != op)
+      {
+	fprintf(stderr, "%s[%d]: stack_protected1 %s\n", func, line, op_names[stack_top_op(sc)]);
+	if (sc->stop_at_error) abort();
+      }
+    return(stack_top_args(sc));
+  }
+
+  static s7_pointer stack_protected2_1(s7_scheme *sc, opcode_t op, const char *func, int line)
+  {
+    if (stack_top_op(sc) != op)
+      {
+	fprintf(stderr, "%s[%d]: stack_protected2 %s\n", func, line, op_names[stack_top_op(sc)]);
+	if (sc->stop_at_error) abort();
+      }
+    return(stack_top_code(sc));
+  }
+
+  static s7_pointer stack_protected3_1(s7_scheme *sc, opcode_t op, const char *func, int line)
+  {
+    if (stack_top_op(sc) != op)
+      {
+	fprintf(stderr, "%s[%d]: stack_protected3 %s\n", func, line, op_names[stack_top_op(sc)]);
+	if (sc->stop_at_error) abort();
+      }
+    return(stack_top_let(sc));
+  }
+
+  #define stack_protected1(Sc, Op) stack_protected1_1(Sc, Op, __func__, __LINE__)
+  #define stack_protected2(Sc, Op) stack_protected2_1(Sc, Op, __func__, __LINE__)
+  #define stack_protected3(Sc, Op) stack_protected3_1(Sc, Op, __func__, __LINE__)
+
+  #define set_stack_protected1(Sc, Val, Op) do {if (stack_top_op(Sc) != Op) fprintf(stderr, "%s[%d]: set_stack_protected1 %s\n", __func__, __LINE__, op_names[stack_top_op(Sc)]); stack_top_args(Sc) = Val;} while (0)
+  #define set_stack_protected2(Sc, Val, Op) do {if (stack_top_op(Sc) != Op) fprintf(stderr, "%s[%d]: set_stack_protected2 %s\n", __func__, __LINE__, op_names[stack_top_op(Sc)]); stack_top_code(Sc) = Val;} while (0)
+  #define set_stack_protected3(Sc, Val, Op) do {if (stack_top_op(Sc) != Op) fprintf(stderr, "%s[%d]: set_stack_protected3 %s\n", __func__, __LINE__, op_names[stack_top_op(Sc)]); stack_top_let(Sc) = Val;} while (0)
+
+#else
+
+  #define stack_protected1(Sc, Op) stack_top_args(Sc)
+  #define stack_protected2(Sc, Op) stack_top_code(Sc)
+  #define stack_protected3(Sc, Op) stack_top_let(Sc)
+
+  #define set_stack_protected1(Sc, Val, Op) stack_top_args(Sc) = Val
+  #define set_stack_protected2(Sc, Val, Op) stack_top_code(Sc) = Val
+  #define set_stack_protected3(Sc, Val, Op) stack_top_let(Sc) = Val
+#endif
+
+#define gc_protected1(Sc) stack_protected1(Sc, OP_GC_PROTECT)
+#define gc_protected2(Sc) stack_protected2(Sc, OP_GC_PROTECT)
+#define gc_protected3(Sc) stack_protected3(Sc, OP_GC_PROTECT)
+
+#define set_gc_protected1(Sc, Val) set_stack_protected1(Sc, Val, OP_GC_PROTECT)
+#define set_gc_protected2(Sc, Val) set_stack_protected2(Sc, Val, OP_GC_PROTECT)
+#define set_gc_protected3(Sc, Val) set_stack_protected3(Sc, Val, OP_GC_PROTECT)
+
+#define map_iterator(Sc)             stack_protected2(Sc, OP_MAP_UNWIND)
+#define set_map_iterator(Sc, Val)    set_stack_protected2(Sc, Val, OP_MAP_UNWIND)
+#define map_unwind_list(Sc)          stack_protected3(Sc, OP_MAP_UNWIND)
+#define set_map_unwind_list(Sc, Val) set_stack_protected3(Sc, Val, OP_MAP_UNWIND)
+
+#define gc_protect_via_stack(Sc, Obj) push_stack_no_code(Sc, OP_GC_PROTECT, Obj)
+#define gc_protect_via_stack_no_let(Sc, Obj) push_stack_no_let_no_code(Sc, OP_GC_PROTECT, Obj)
+#define gc_protect_2_via_stack(Sc, X, Y) do {gc_protect_via_stack(Sc, X); set_gc_protected2(Sc, Y);} while (0)
+  /* often X and Y are fx_calls, so push X, then set Y */
+#define gc_protect_2_via_stack_no_let(Sc, X, Y) do {push_stack_no_let_no_code(Sc, OP_GC_PROTECT, X); set_gc_protected2(Sc, Y);} while (0)
+
+
+/* -------------------------------- symbols -------------------------------- */
+static inline uint64_t raw_string_hash(const uint8_t *key, s7_int len) /* used in symbols, hash-tables */
+{
+  if (len <= 8)
+    {
+      uint64_t xs[1] = {0};
+      memcpy((void *)xs, (const void *)key, len);
+      return(xs[0]);
+    }
+  else
+    {
+      uint64_t xs[2] = {0, 0};
+      memcpy((void *)xs, (const void *)key, (len > 16) ? 16 : len);  /* compiler complaint here is bogus */
+      return(xs[0] + xs[1]);
+    }
+}
+
+static uint8_t *alloc_symbol(s7_scheme *sc)
+{
+  #define SYMBOL_SIZE (3 * sizeof(s7_cell) + sizeof(block_t))
+  #define ALLOC_SYMBOL_SIZE (64 * SYMBOL_SIZE)
+  uint8_t *result;
+  if (sc->alloc_symbol_k == ALLOC_SYMBOL_SIZE)
+    {
+      sc->alloc_symbol_cells = (uint8_t *)Malloc(ALLOC_SYMBOL_SIZE);
+      add_saved_pointer(sc, sc->alloc_symbol_cells);
+      sc->alloc_symbol_k = 0;
+    }
+  result = &(sc->alloc_symbol_cells[sc->alloc_symbol_k]);
+  sc->alloc_symbol_k += SYMBOL_SIZE;
+  return(result);
+}
+
+static s7_pointer make_semipermanent_slot(s7_scheme *sc, s7_pointer symbol, s7_pointer value)
+{
+  s7_pointer slot = alloc_pointer(sc);
+  set_full_type(slot, T_SLOT | T_UNHEAP);
+  slot_set_symbol_and_value(slot, symbol, value);
+  return(slot);
+}
+
+static /* inline */ s7_pointer new_symbol(s7_scheme *sc, const char *name, s7_int len, uint64_t hash, uint32_t location) /* inline useless here 20-Oct-22 */
+{
+  /* name might not be null-terminated, these are semipermanent symbols even in s7_gensym; g_gensym handles everything separately */
+  uint8_t *base = alloc_symbol(sc);
+  s7_pointer x = (s7_pointer)base;
+  s7_pointer str = (s7_pointer)(base + sizeof(s7_cell));
+  s7_pointer p = (s7_pointer)(base + 2 * sizeof(s7_cell));
+  uint8_t *val = (uint8_t *)permalloc(sc, len + 1);
+  memcpy((void *)val, (const void *)name, len);
+  val[len] = '\0';
+
+  full_type(str) = T_STRING | T_IMMUTABLE | T_UNHEAP;       /* avoid debugging confusion involving set_type (also below) */
+  string_length(str) = len;
+  string_value(str) = (char *)val;
+  string_hash(str) = hash;
+
+  full_type(x) = T_SYMBOL | T_UNHEAP;
+  symbol_set_name_cell(x, str);
+  set_global_slot(x, sc->undefined);                       /* was sc->nil */
+  symbol_info(x) = (block_t *)(base + 3 * sizeof(s7_cell));
+  set_initial_value(x, sc->undefined);
+  symbol_set_local_slot_unchecked_and_unincremented(x, 0LL, sc->nil);
+  symbol_set_tag(x, 0);
+  symbol_set_tag2(x, 0);
+  symbol_clear_ctr(x); /* alloc_symbol uses malloc */
+  symbol_clear_type(x);
+
+  if ((len > 1) &&                                    /* not 0, otherwise : is a keyword */
+      ((name[0] == ':') || (name[len - 1] == ':')))   /* see s7test under keyword? for troubles if both colons are present */
+    {
+      s7_pointer slot, ksym;
+      set_type_bit(x, T_IMMUTABLE | T_KEYWORD);
+      set_optimize_op(str, OP_CONSTANT);
+      ksym = make_symbol(sc, (name[0] == ':') ? (const char *)(name + 1) : name, len - 1);
+      keyword_set_symbol(x, ksym);
+      set_has_keyword(ksym);
+      /* the keyword symbol needs to be semipermanent (not a gensym) else we have to laboriously gc-protect it */
+      if ((is_gensym(ksym)) &&
+	  (in_heap(ksym)))
+	remove_gensym_from_heap(sc, ksym);
+      slot = make_semipermanent_slot(sc, x, x);
+      set_global_slot(x, slot);
+      set_local_slot(x, slot);
+      set_immutable_slot(slot);
+    }
+  full_type(p) = T_PAIR | T_IMMUTABLE | T_UNHEAP;  /* add x to the symbol table */
+  set_car(p, x);
+  unchecked_set_cdr(p, vector_element(sc->symbol_table, location));
+  vector_element(sc->symbol_table, location) = p;
+  pair_set_raw_hash(p, hash);
+  pair_set_raw_len(p, (uint64_t)len); /* symbol name length, so it ought to fit! */
+  pair_set_raw_name(p, string_value(str));
+  return(x);
+}
+
+static Inline s7_pointer inline_make_symbol(s7_scheme *sc, const char *name, s7_int len) /* inline out: ca 40=2% in tload */
+{ /* name here might not be null-terminated */
+  uint64_t hash = raw_string_hash((const uint8_t *)name, len);
+  uint32_t location = hash % SYMBOL_TABLE_SIZE;
+
+  if (len <= 8)
+    {
+      for (s7_pointer x = vector_element(sc->symbol_table, location); is_pair(x); x = cdr(x))
+	if ((hash == pair_raw_hash(x)) &&
+	    ((uint64_t)len == pair_raw_len(x)))
+	  return(car(x));
+    }
+  else /* checking name[len=='\0' and using strcmp if so was not a big win */
+    for (s7_pointer x = vector_element(sc->symbol_table, location); is_pair(x); x = cdr(x))
+      if ((hash == pair_raw_hash(x)) &&
+	  ((uint64_t)len == pair_raw_len(x)) &&
+	  (strings_are_equal_with_length(name, pair_raw_name(x), len))) /* length here because name might not be null-terminated */
+	return(car(x));
+  return(new_symbol(sc, name, len, hash, location));
+}
+
+static s7_pointer make_symbol(s7_scheme *sc, const char *name, s7_int len) {return(inline_make_symbol(sc, name, len));}
+
+s7_pointer s7_make_symbol(s7_scheme *sc, const char *name) {return(inline_make_symbol(sc, name, safe_strlen(name)));}
+
+static s7_pointer symbol_table_find_by_name(s7_scheme *sc, const char *name, uint64_t hash, uint32_t location, s7_int len)
+{
+  for (s7_pointer x = vector_element(sc->symbol_table, location); is_not_null(x); x = cdr(x))
+    if ((hash == pair_raw_hash(x)) &&
+	(strings_are_equal_with_length(name, pair_raw_name(x), len)))
+      return(car(x));
+  return(sc->nil);
+}
+
+s7_pointer s7_symbol_table_find_name(s7_scheme *sc, const char *name)
+{
+  s7_int len = safe_strlen(name);
+  uint64_t hash = raw_string_hash((const uint8_t *)name, len);
+  s7_pointer result = symbol_table_find_by_name(sc, name, hash, hash % SYMBOL_TABLE_SIZE, len);
+  return((is_null(result)) ? NULL : result);
+}
+
+
+/* -------------------------------- symbol-table -------------------------------- */
+static inline s7_pointer make_simple_vector(s7_scheme *sc, s7_int len);
+
+static s7_pointer g_symbol_table(s7_scheme *sc, s7_pointer unused_args)
+{
+  #define H_symbol_table "(symbol-table) returns a vector containing the current contents (symbols) of s7's symbol-table"
+  #define Q_symbol_table s7_make_signature(sc, 1, sc->is_vector_symbol)
+
+  s7_pointer *els, *entries = vector_elements(sc->symbol_table);
+  int32_t syms = 0;
+  s7_pointer vec;
+  /* this can't be optimized by returning the actual symbol-table (a vector of lists), because
+   *    gensyms can cause the table's lists and symbols to change at any time.  This wreaks havoc
+   *    on traversals like for-each.  So, symbol-table returns a snap-shot of the table contents
+   *    at the time it is called.
+   *    (define (for-each-symbol func num) (for-each (lambda (sym) (if (> num 0) (for-each-symbol func (- num 1)) (func sym))) (symbol-table)))
+   *    (for-each-symbol (lambda (sym) (gensym) 1))
+   * can be called in gdb: p display(s7_eval_c_string(sc, "(for-each (lambda (x) (when (gensym? x) (format *stderr* \"~A \" x))) (symbol-table))"))
+   */
+  for (int32_t i = 0; i < SYMBOL_TABLE_SIZE; i++)
+    for (s7_pointer x = entries[i]; is_not_null(x); x = cdr(x))
+      syms++;
+  if (syms > sc->max_vector_length)
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_3(sc, wrap_string(sc, "symbol-table size, ~D, is greater than (*s7* 'max-vector-length), ~D", 68),
+			 wrap_integer(sc, syms), wrap_integer(sc, sc->max_vector_length)));
+  sc->w = make_simple_vector(sc, syms);
+  set_is_symbol_table(sc->w);
+  els = vector_elements(sc->w);
+  for (int32_t i = 0, j = 0; i < SYMBOL_TABLE_SIZE; i++)
+    for (s7_pointer x = entries[i]; is_not_null(x); x = cdr(x))
+      els[j++] = car(x);
+  vec = sc->w;
+  sc->w = sc->unused;
+  return(vec);
+}
+
+bool s7_for_each_symbol_name(s7_scheme *sc, bool (*symbol_func)(const char *symbol_name, void *data), void *data)
+{
+  /* this includes the special constants #<unspecified> and so on for simplicity -- are there any others? */
+  for (int32_t i = 0; i < SYMBOL_TABLE_SIZE; i++)
+    for (s7_pointer x = vector_element(sc->symbol_table, i); is_not_null(x); x = cdr(x))
+      if (symbol_func(symbol_name(car(x)), data))
+	return(true);
+  return((symbol_func("#t", data))             || (symbol_func("#f", data))             ||
+	 (symbol_func("#<unspecified>", data)) || (symbol_func("#<undefined>", data))   ||
+	 (symbol_func("#<eof>", data))         ||
+	 (symbol_func("#true", data))          || (symbol_func("#false", data)));
+}
+
+bool s7_for_each_symbol(s7_scheme *sc, bool (*symbol_func)(const char *symbol_name, void *data), void *data)
+{
+  for (int32_t i = 0; i < SYMBOL_TABLE_SIZE; i++)
+    for (s7_pointer x = vector_element(sc->symbol_table, i); is_not_null(x); x = cdr(x))
+      if (symbol_func(symbol_name(car(x)), data))
+	return(true);
+  return(false);
+}
+
+
+/* -------------------------------- gensym -------------------------------- */
+static void remove_gensym_from_symbol_table(s7_scheme *sc, s7_pointer sym)
+{
+  /* sym is a free cell at this point (we're called after the GC), but the name_cell is still intact */
+  s7_pointer name = symbol_name_cell(sym);
+  uint32_t location = string_hash(name) % SYMBOL_TABLE_SIZE;
+  s7_pointer x = vector_element(sc->symbol_table, location);
+  if (car(x) == sym)
+    vector_element(sc->symbol_table, location) = cdr(x);
+  else
+    for (s7_pointer y = x, z = cdr(x); is_pair(z); y = z, z = cdr(z))
+      if (car(z) == sym)
+	{
+	  unchecked_set_cdr(y, cdr(z));
+	  return;
+	}
+}
+
+s7_pointer s7_gensym(s7_scheme *sc, const char *prefix)
+{
+  s7_int len = safe_strlen(prefix) + 32;
+  block_t *b = mallocate(sc, len);
+  char *name = (char *)block_data(b);
+  /* there's no point in heroic efforts here to avoid name collisions -- the user can screw up no matter what we do */
+  name[0] = '\0';
+  {
+    s7_int slen = catstrs(name, len, "{", (prefix) ? prefix : "", "}-", pos_int_to_str_direct(sc, sc->gensym_counter++), (char *)NULL);
+    uint64_t hash = raw_string_hash((const uint8_t *)name, slen);
+    int32_t location = hash % SYMBOL_TABLE_SIZE;
+    s7_pointer x = new_symbol(sc, name, slen, hash, location);  /* not T_GENSYM -- might be called from outside -- what?? (2-Oct-23) */
+    liberate(sc, b);
+    return(x);
+  }
+}
+
+static bool is_gensym_b_p(s7_pointer g) {return((is_symbol(g)) && (is_gensym(g)));}
+
+static s7_pointer g_is_gensym(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_gensym "(gensym? sym) returns #t if sym is a gensym"
+  #define Q_is_gensym sc->pl_bt
+  check_boolean_method(sc, is_gensym_b_p, sc->is_gensym_symbol, args);
+}
+
+static s7_pointer g_gensym(s7_scheme *sc, s7_pointer args)
+{
+  #define H_gensym "(gensym (prefix \"gensym\")) returns a new, unused symbol"
+  #define Q_gensym s7_make_signature(sc, 2, sc->is_gensym_symbol, sc->is_string_symbol)
+
+  const char *prefix;
+  char *name, *base;
+  s7_int len, plen, nlen;
+  uint32_t location;
+  uint64_t hash;
+  s7_pointer x, str, stc;
+  block_t *b, *ib;
+
+  /* get symbol name */
+  if (is_not_null(args))
+    {
+      s7_pointer gname = car(args);
+      if (!is_string(gname))
+	return(sole_arg_method_or_bust(sc, gname, sc->gensym_symbol, args, sc->type_names[T_STRING]));
+      prefix = string_value(gname);
+      plen = string_length(gname); /* was safe_strlen(prefix): were we stopping at #\null deliberately? */
+    }
+  else
+    {
+      prefix = "gensym";
+      plen = 6;
+    }
+  len = plen + 32; /* why 32 -- we need room for the gensym_counter integer, but (length "9223372036854775807") = 19, see gensym name collision loop below */
+
+  b = mallocate(sc, len + sizeof(block_t) + 2 * sizeof(s7_cell));
+  base = (char *)block_data(b);
+  str = (s7_cell *)base;
+  stc = (s7_cell *)(base + sizeof(s7_cell));
+  ib = (block_t *)(base + 2 * sizeof(s7_cell));
+  name = (char *)(base + sizeof(block_t) + 2 * sizeof(s7_cell));
+
+  name[0] = '{';
+  memcpy((void *)(name + 1), prefix, plen); /* memcpy is ok with plen==0, I think */
+  name[plen + 1] = '}';
+  name[plen + 2] = '-'; /* {gensym}-nnn */
+
+  while (true)
+    {
+      char *p = pos_int_to_str(sc, sc->gensym_counter++, &len, '\0');
+      memcpy((void *)(name + plen + 3), (void *)p, len);
+      nlen = len + plen + 2;
+      name[nlen] = '\0';
+      hash = raw_string_hash((const uint8_t *)name, nlen);
+      location = hash % SYMBOL_TABLE_SIZE;
+      if (is_null(symbol_table_find_by_name(sc, name, hash, location, nlen))) break;
+      if (sc->safety > NO_SAFETY)
+	s7_warn(sc, nlen + 25, "%s collides with gensym?\n", name);
+    }
+
+  /* make-string for symbol name */
+  if (S7_DEBUGGING) full_type(str) = 0; /* here and below, this is needed to avoid set_type check errors (mallocate above) */
+  set_full_type(str, T_STRING | T_IMMUTABLE | T_UNHEAP);
+  string_length(str) = nlen;
+  string_value(str) = name;
+  string_hash(str) = hash;
+
+  /* allocate the symbol in the heap so GC'd when inaccessible */
+  new_cell(sc, x, T_SYMBOL | T_GENSYM);
+  symbol_set_name_cell(x, str);
+  symbol_info(x) = ib;
+  set_global_slot(x, sc->undefined);
+  set_initial_value(x, sc->undefined);
+  symbol_set_local_slot_unchecked(x, 0LL, sc->nil);
+  symbol_clear_ctr(x);
+  symbol_set_tag(x, 0);
+  symbol_set_tag2(x, 0);
+  symbol_clear_type(x);
+  gensym_block(x) = b;
+
+  /* place new symbol in symbol-table */
+  if (S7_DEBUGGING) full_type(stc) = 0;
+  set_full_type(stc, T_PAIR | T_IMMUTABLE | T_UNHEAP);
+  set_car(stc, x);
+  unchecked_set_cdr(stc, vector_element(sc->symbol_table, location));
+  vector_element(sc->symbol_table, location) = stc;
+  pair_set_raw_hash(stc, hash);
+  pair_set_raw_len(stc, (uint64_t)string_length(str));
+  pair_set_raw_name(stc, string_value(str));
+
+  add_gensym(sc, x);
+  return(x);
+}
+
+
+/* -------------------------------- syntax? -------------------------------- */
+bool s7_is_syntax(s7_pointer p) {return(is_syntax(p));}
+
+static s7_pointer g_is_syntax(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_syntax "(syntax? obj) returns #t if obj is a syntactic value (e.g. lambda)"
+  #define Q_is_syntax sc->pl_bt
+  check_boolean_method(sc, is_syntax, sc->is_syntax_symbol, args);
+}
+
+
+/* -------------------------------- symbol? -------------------------------- */
+bool s7_is_symbol(s7_pointer p) {return(is_symbol(p));}
+
+static s7_pointer g_is_symbol(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_symbol "(symbol? obj) returns #t if obj is a symbol"
+  #define Q_is_symbol sc->pl_bt
+  check_boolean_method(sc, is_symbol, sc->is_symbol_symbol, args);
+}
+
+const char *s7_symbol_name(s7_pointer p) {return(symbol_name(p));}
+
+s7_pointer s7_name_to_value(s7_scheme *sc, const char *name) {return(s7_symbol_value(sc, make_symbol_with_strlen(sc, name)));}
+/* should this also handle non-symbols such as "+nan.0"? */
+
+
+/* -------------------------------- symbol->string -------------------------------- */
+static s7_pointer nil_string; /* permanent "" */
+
+static Inline s7_pointer inline_make_string_with_length(s7_scheme *sc, const char *str, s7_int len)
+{
+  s7_pointer x;
+  new_cell(sc, x, T_STRING | T_SAFE_PROCEDURE);
+  string_block(x) = inline_mallocate(sc, len + 1);
+  string_value(x) = (char *)block_data(string_block(x));
+  memcpy((void *)string_value(x), (const void *)str, len);
+  string_value(x)[len] = 0;
+  string_length(x) = len;
+  string_hash(x) = 0;
+  add_string(sc, x);
+  return(x);
+}
+
+static s7_pointer make_string_with_length(s7_scheme *sc, const char *str, s7_int len)
+{
+  return(inline_make_string_with_length(sc, str, len)); /* packaged to avoid inlining everywhere */
+}
+
+static s7_pointer g_symbol_to_string(s7_scheme *sc, s7_pointer args)
+{
+  #define H_symbol_to_string "(symbol->string sym) returns the symbol sym converted to a string"
+  #define Q_symbol_to_string s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_symbol_symbol)
+
+  s7_pointer sym = car(args);
+  if (!is_symbol(sym))
+    return(sole_arg_method_or_bust(sc, sym, sc->symbol_to_string_symbol, args, sc->type_names[T_SYMBOL]));
+  /* s7_make_string uses strlen which stops at an embedded null */
+  if (symbol_name_length(sym) > sc->max_string_length)
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_3(sc, wrap_string(sc, "symbol->string symbol name is too large: (> ~D ~D) (*s7* 'max-string-length)", 76),
+			 wrap_integer(sc, symbol_name_length(sym)), wrap_integer(sc, sc->max_string_length)));
+  return(inline_make_string_with_length(sc, symbol_name(sym), symbol_name_length(sym)));    /* return a copy */
+}
+
+static s7_pointer g_symbol_to_string_uncopied(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer sym = car(args);
+  if (!is_symbol(sym))
+    return(sole_arg_method_or_bust(sc, sym, sc->symbol_to_string_symbol, args, sc->type_names[T_SYMBOL]));
+  if (is_gensym(sym))
+    return(make_string_with_length(sc, symbol_name(sym), symbol_name_length(sym)));    /* return a copy of gensym name (which will be freed) */
+  return(symbol_name_cell(sym));
+}
+
+static s7_pointer symbol_to_string_p_p(s7_scheme *sc, s7_pointer sym)
+{
+  if (!is_symbol(sym))
+    return(sole_arg_method_or_bust(sc, sym, sc->symbol_to_string_symbol, set_plist_1(sc, sym), sc->type_names[T_SYMBOL]));
+  return(inline_make_string_with_length(sc, symbol_name(sym), symbol_name_length(sym)));
+}
+
+static s7_pointer symbol_to_string_uncopied_p(s7_scheme *sc, s7_pointer sym)
+{
+  if (!is_symbol(sym))
+    return(sole_arg_method_or_bust(sc, sym, sc->symbol_to_string_symbol, set_plist_1(sc, sym), sc->type_names[T_SYMBOL]));
+  if (is_gensym(sym))
+    return(make_string_with_length(sc, symbol_name(sym), symbol_name_length(sym)));
+  return(symbol_name_cell(sym));
+}
+
+
+/* -------------------------------- string->symbol -------------------------------- */
+static inline s7_pointer g_string_to_symbol_1(s7_scheme *sc, s7_pointer str, s7_pointer caller)
+{
+  if (!is_string(str))
+    return(method_or_bust_p(sc, str, caller, sc->type_names[T_STRING]));
+  if (string_length(str) <= 0)
+    sole_arg_wrong_type_error_nr(sc, caller, str, wrap_string(sc, "a non-null string", 17));
+  return(make_symbol(sc, string_value(str), string_length(str)));
+}
+
+static s7_pointer g_string_to_symbol(s7_scheme *sc, s7_pointer args)
+{
+  #define H_string_to_symbol "(string->symbol str) returns the string str converted to a symbol"
+  #define Q_string_to_symbol s7_make_signature(sc, 2, sc->is_symbol_symbol, sc->is_string_symbol)
+  return(g_string_to_symbol_1(sc, car(args), sc->string_to_symbol_symbol));
+}
+
+static s7_pointer string_to_symbol_p_p(s7_scheme *sc, s7_pointer p) {return(g_string_to_symbol_1(sc, p, sc->string_to_symbol_symbol));}
+
+
+/* -------------------------------- symbol -------------------------------- */
+static s7_pointer g_string_append_1(s7_scheme *sc, s7_pointer args, s7_pointer caller);
+
+static s7_pointer mark_as_symbol_from_symbol(s7_pointer sym)
+{
+  set_is_symbol_from_symbol(sym);
+  return(sym);
+}
+
+static s7_pointer g_symbol(s7_scheme *sc, s7_pointer args)
+{
+  #define H_symbol "(symbol str ...) returns its string arguments concatenated and converted to a symbol"
+  #define Q_symbol s7_make_circular_signature(sc, 1, 2, sc->is_symbol_symbol, sc->is_string_symbol)
+
+  /* (let ((x 0)) (set! (symbol "x") 12)) ;symbol (a c-function) does not have a setter: (set! (symbol "x") 12)
+   *   (let (((symbol "x") 3)) x) ; bad variable ((symbol "x")
+   *   (let ((x 2)) (+ (symbol "x") 1)) ;+ first argument, x, is a symbol but should be a number
+   *   maybe document this: (symbol...) just returns the symbol
+   *   (let ((x 3)) (+ (symbol->value (symbol "x")) 1)) -> 4, (let ((x 0)) (apply set! (symbol "x") (list 32)) x) -> 32
+   */
+
+  s7_int len = 0, cur_len;
+  s7_pointer p, sym;
+  block_t *b;
+  char *name;
+
+  for (p = args; is_pair(p); p = cdr(p))
+    if (is_string(car(p)))
+      len += string_length(car(p));
+    else break;
+  if (is_pair(p))
+    {
+      if (is_null(cdr(args)))
+	return(mark_as_symbol_from_symbol(g_string_to_symbol_1(sc, car(args), sc->symbol_symbol)));
+      return(mark_as_symbol_from_symbol(g_string_to_symbol_1(sc, g_string_append_1(sc, args, sc->symbol_symbol), sc->symbol_symbol)));
+    }
+  if (len == 0)
+    sole_arg_wrong_type_error_nr(sc, sc->symbol_symbol, car(args), wrap_string(sc, "a non-null string", 17));
+
+  b = mallocate(sc, len + 1);
+  name = (char *)block_data(b);
+  /* can't use catstrs_direct here because it stops at embedded null */
+  for (cur_len = 0, p = args; is_pair(p); p = cdr(p))
+    {
+      s7_pointer str = car(p);
+      if (string_length(str) > 0)
+	{
+	  memcpy((void *)(name + cur_len), (void *)string_value(str), string_length(str));
+	  cur_len += string_length(str);
+	}}
+  name[len] = '\0';
+  sym = mark_as_symbol_from_symbol(inline_make_symbol(sc, name, len));
+  liberate(sc, b);
+  return(sym);
+}
+
+static s7_pointer symbol_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  char buf[256];
+  s7_int len;
+  if ((!is_string(p1)) || (!is_string(p2))) return(g_symbol(sc, set_plist_2(sc, p1, p2)));
+  len = string_length(p1) + string_length(p2);
+  if ((len == 0) || (len >= 256)) return(g_symbol(sc, set_plist_2(sc, p1, p2)));
+  memcpy((void *)buf, (void *)string_value(p1), string_length(p1));
+  memcpy((void *)(buf + string_length(p1)), (void *)string_value(p2), string_length(p2));
+  return(mark_as_symbol_from_symbol(inline_make_symbol(sc, buf, len)));
+}
+
+/* -------- symbol-initial-value -------- */
+static s7_pointer g_symbol_initial_value(s7_scheme *sc, s7_pointer args)
+{
+  #define H_symbol_initial_value "(symbol-initial-value sym) returns the initial binding of the symbol sym"
+  #define Q_symbol_initial_value s7_make_signature(sc, 2, sc->T, sc->is_symbol_symbol)
+
+  s7_pointer symbol = car(args);
+  if (!is_symbol(symbol)) /* or is_normal_symbol? now (symbol-initial-value :hi) -> #<undefined> */
+    return(sole_arg_method_or_bust(sc, symbol, sc->symbol_initial_value_symbol, set_plist_1(sc, symbol), sc->type_names[T_SYMBOL]));
+  return(initial_value(symbol));
+}
+
+static s7_pointer g_symbol_set_initial_value(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer symbol = car(args), value = cadr(args);
+  if (!is_symbol(symbol))
+    wrong_type_error_nr(sc, wrap_string(sc, "set! symbol-initial-value", 25), 1, symbol, sc->type_names[T_SYMBOL]);
+  if (initial_value(symbol) != sc->undefined)
+    immutable_object_error_nr(sc, set_elist_2(sc, wrap_string(sc, "can't set! (symbol-initial-value '~S); it is immutable", 54), symbol));
+  set_initial_value(symbol, value);
+  /* should this tie into unlet? */
+  return(value);
+}
+
+s7_pointer s7_symbol_initial_value(s7_pointer symbol) {return(initial_value(symbol));}
+
+s7_pointer s7_symbol_set_initial_value(s7_scheme *sc, s7_pointer symbol, s7_pointer value)
+{
+  if (initial_value(symbol) == sc->undefined)
+    set_initial_value(symbol, value);
+  return(initial_value(symbol));
+}
+
+
+/* -------- symbol sets -------- */
+static inline s7_pointer add_symbol_to_list(s7_scheme *sc, s7_pointer sym)
+{
+  symbol_set_tag(sym, sc->syms_tag);
+  symbol_set_tag2(sym, sc->syms_tag2);
+  return(sym);
+}
+
+static inline void clear_symbol_list(s7_scheme *sc)
+{
+  sc->syms_tag++;
+  if (sc->syms_tag == 0)
+    {
+      sc->syms_tag = 1; /* we're assuming (in let_equal) that this tag is not 0 */
+      sc->syms_tag2++;
+    }
+}
+
+#define symbol_is_in_list(Sc, Sym) ((symbol_tag(Sym) == Sc->syms_tag) && (symbol_tag2(Sym) == Sc->syms_tag2))
+
+
+/* -------------------------------- lets/slots -------------------------------- */
+static Inline s7_pointer inline_make_let(s7_scheme *sc, s7_pointer old_let)
+{
+  s7_pointer x;
+  new_cell(sc, x, T_LET | T_SAFE_PROCEDURE);
+  let_set_id(x, ++sc->let_number);
+  let_set_slots(x, slot_end);
+  let_set_outlet(x, old_let);
+  return(x);
+}
+
+static inline s7_pointer make_let(s7_scheme *sc, s7_pointer old_let) {return(inline_make_let(sc, old_let));}
+
+static Inline s7_pointer inline_make_let_with_slot(s7_scheme *sc, s7_pointer old_let, s7_pointer symbol, s7_pointer value)
+{
+  s7_pointer new_let, slot;
+  sc->value = value;
+  new_cell(sc, new_let, T_LET | T_SAFE_PROCEDURE);
+  let_set_id(new_let, ++sc->let_number);
+  let_set_outlet(new_let, old_let);
+  new_cell_no_check(sc, slot, T_SLOT);
+  slot_set_symbol_and_value(slot, symbol, value);
+  symbol_set_local_slot(symbol, sc->let_number, slot);
+  slot_set_next(slot, slot_end);
+  let_set_slots(new_let, slot);
+  return(new_let);
+}
+
+static s7_pointer make_let_with_slot(s7_scheme *sc, s7_pointer old_let, s7_pointer symbol, s7_pointer value)
+{
+  return(inline_make_let_with_slot(sc, old_let, symbol, value));
+}
+
+static Inline s7_pointer inline_make_let_with_two_slots(s7_scheme *sc, s7_pointer old_let,
+							s7_pointer symbol1, s7_pointer value1, s7_pointer symbol2, s7_pointer value2)
+{
+  /* we leave value1/value2 computation order to the C compiler here -- in the old macro, it was explicitly value1 then value2
+   *   this means any let in old scheme code that actually depends on the order may break -- it should be let*.
+   */
+  s7_pointer new_let, slot1, slot2;
+  new_cell(sc, new_let, T_LET | T_SAFE_PROCEDURE);
+  let_set_id(new_let, ++sc->let_number);
+  let_set_outlet(new_let, old_let);
+
+  new_cell_no_check(sc, slot1, T_SLOT);
+  slot_set_symbol_and_value(slot1, symbol1, value1);
+  symbol_set_local_slot(symbol1, sc->let_number, slot1);
+  let_set_slots(new_let, slot1);
+
+  new_cell_no_check(sc, slot2, T_SLOT);
+  slot_set_symbol_and_value(slot2, symbol2, value2);
+  symbol_set_local_slot(symbol2, sc->let_number, slot2);
+  slot_set_next(slot2, slot_end);
+  slot_set_next(slot1, slot2);
+  return(new_let);
+}
+
+static s7_pointer make_let_with_two_slots(s7_scheme *sc, s7_pointer old_let, s7_pointer symbol1, s7_pointer value1, s7_pointer symbol2, s7_pointer value2)
+{
+  return(inline_make_let_with_two_slots(sc, old_let, symbol1, value1, symbol2, value2));
+}
+
+/* in all these functions, symbol_set_local_slot should follow slot_set_value so that we can evaluate the slot's value in its old state */
+static inline void add_slot_unchecked(s7_scheme *sc, s7_pointer let, s7_pointer symbol, s7_pointer value, uint64_t id)
+{
+  s7_pointer slot;
+  new_cell_no_check(sc, slot, T_SLOT);
+  slot_set_symbol_and_value(slot, symbol, value);
+  slot_set_next(slot, let_slots(let));
+  let_set_slots(let, slot);
+  set_local(symbol);
+  symbol_set_local_slot(symbol, id, slot);
+}
+
+static s7_pointer add_slot_unchecked_no_local_slot(s7_scheme *sc, s7_pointer let, s7_pointer symbol, s7_pointer value)
+{
+  s7_pointer slot;
+  new_cell_no_check(sc, slot, T_SLOT);
+  slot_set_symbol_and_value(slot, symbol, value);
+  slot_set_next(slot, let_slots(let));
+  let_set_slots(let, slot);
+  set_local(symbol);
+  return(slot);
+}
+
+#define add_slot(Sc, Let, Symbol, Value) add_slot_unchecked(Sc, Let, Symbol, Value, let_id(Let))
+
+static inline s7_pointer add_slot_checked(s7_scheme *sc, s7_pointer let, s7_pointer symbol, s7_pointer value)
+{
+  s7_pointer slot;
+  new_cell(sc, slot, T_SLOT);
+  slot_set_symbol_and_value(slot, symbol, value);
+  symbol_set_local_slot(symbol, let_id(let), slot);
+  slot_set_next(slot, let_slots(let));
+  let_set_slots(let, slot);
+  return(slot);
+}
+
+static inline s7_pointer add_slot_checked_with_id(s7_scheme *sc, s7_pointer let, s7_pointer symbol, s7_pointer value)
+{
+  s7_pointer slot;
+  new_cell(sc, slot, T_SLOT);
+  slot_set_symbol_and_value(slot, symbol, value);
+  set_local(symbol);
+  if (let_id(let) >= symbol_id(symbol))
+    symbol_set_local_slot(symbol, let_id(let), slot);
+  slot_set_next(slot, let_slots(let));
+  let_set_slots(let, slot);
+  return(slot);
+}
+
+static inline s7_pointer add_slot_no_local(s7_scheme *sc, s7_pointer let, s7_pointer symbol, s7_pointer value) /* no symbol_set_local_slot, no set_local */
+{
+  s7_pointer slot;
+  new_cell(sc, slot, T_SLOT);
+  slot_set_symbol_and_value(slot, symbol, value);
+  slot_set_next(slot, let_slots(let));
+  let_set_slots(let, slot);
+  return(slot);
+}
+
+static s7_pointer add_slot_unchecked_with_id(s7_scheme *sc, s7_pointer let, s7_pointer symbol, s7_pointer value)
+{
+  s7_pointer slot;
+  new_cell_no_check(sc, slot, T_SLOT);
+  slot_set_symbol_and_value(slot, symbol, value);
+  set_local(symbol);
+  if (let_id(let) >= symbol_id(symbol))
+    symbol_set_local_slot(symbol, let_id(let), slot);
+  slot_set_next(slot, let_slots(let));
+  let_set_slots(let, slot);
+  return(slot);
+}
+
+static Inline s7_pointer inline_add_slot_at_end(s7_scheme *sc, uint64_t id, s7_pointer last_slot, s7_pointer symbol, s7_pointer value)
+{
+  s7_pointer slot;
+  new_cell_no_check(sc, slot, T_SLOT);
+  slot_set_symbol_and_value(slot, symbol, value);
+  slot_set_next(slot, slot_end);
+  symbol_set_local_slot(symbol, id, slot);
+  slot_set_next(last_slot, slot);
+  return(slot);
+}
+
+static s7_pointer add_slot_at_end(s7_scheme *sc, uint64_t id, s7_pointer last_slot, s7_pointer symbol, s7_pointer value)
+{
+  return(inline_add_slot_at_end(sc, id, last_slot, symbol, value));
+}
+
+static s7_pointer add_slot_at_end_no_local(s7_scheme *sc, s7_pointer last_slot, s7_pointer symbol, s7_pointer value)
+{
+  s7_pointer slot;
+  new_cell_no_check(sc, slot, T_SLOT);
+  slot_set_symbol_and_value(slot, symbol, value);
+  slot_set_next(slot, slot_end);
+  slot_set_next(last_slot, slot);
+  return(slot);
+}
+
+static inline void make_let_with_three_slots(s7_scheme *sc, s7_pointer func, s7_pointer val1, s7_pointer val2, s7_pointer val3)
+{
+  s7_pointer last_slot, cargs = closure_args(func);
+  set_curlet(sc, inline_make_let_with_two_slots(sc, closure_let(func), car(cargs), val1, cadr(cargs), val2));
+  last_slot = next_slot(let_slots(sc->curlet));
+  inline_add_slot_at_end(sc, let_id(sc->curlet), last_slot, caddr(cargs), val3);
+}
+
+static inline void make_let_with_four_slots(s7_scheme *sc, s7_pointer func, s7_pointer val1, s7_pointer val2, s7_pointer val3, s7_pointer val4)
+{
+  s7_pointer last_slot, cargs = closure_args(func);
+  set_curlet(sc, inline_make_let_with_two_slots(sc, closure_let(func), car(cargs), val1, cadr(cargs), val2));
+  cargs = cddr(cargs);
+  last_slot = next_slot(let_slots(sc->curlet));
+  last_slot = inline_add_slot_at_end(sc, let_id(sc->curlet), last_slot, car(cargs), val3);
+  inline_add_slot_at_end(sc, let_id(sc->curlet), last_slot, cadr(cargs), val4);
+}
+
+static inline void make_let_with_five_slots(s7_scheme *sc, s7_pointer func, s7_pointer val1, s7_pointer val2, s7_pointer val3, s7_pointer val4, s7_pointer val5)
+{
+  s7_pointer last_slot, cargs = closure_args(func);
+  set_curlet(sc, inline_make_let_with_two_slots(sc, closure_let(func), car(cargs), val1, cadr(cargs), val2));
+  cargs = cddr(cargs);
+  last_slot = next_slot(let_slots(sc->curlet));
+  last_slot = inline_add_slot_at_end(sc, let_id(sc->curlet), last_slot, car(cargs), val3);
+  cargs = cdr(cargs);
+  last_slot = inline_add_slot_at_end(sc, let_id(sc->curlet), last_slot, car(cargs), val4);
+  inline_add_slot_at_end(sc, let_id(sc->curlet), last_slot, cadr(cargs), val5);
+}
+
+#define update_slot(Slot, Val, Id) do {s7_pointer sym; slot_set_value(Slot, Val); sym = slot_symbol(Slot); symbol_set_local_slot_unincremented(sym, Id, Slot);} while (0)
+
+static s7_pointer update_let_with_slot(s7_scheme *sc, s7_pointer let, s7_pointer val)
+{
+  s7_pointer slot = let_slots(let);
+  uint64_t id = ++sc->let_number;
+  let_set_id(let, id);
+  update_slot(slot, val, id);
+  return(let);
+}
+
+static s7_pointer update_let_with_two_slots(s7_scheme *sc, s7_pointer let, s7_pointer val1, s7_pointer val2)
+{
+  s7_pointer slot = let_slots(let);
+  uint64_t id = ++sc->let_number;
+  let_set_id(let, id);
+  update_slot(slot, val1, id); slot = next_slot(slot);
+  update_slot(slot, val2, id);
+  return(let);
+}
+
+static s7_pointer update_let_with_three_slots(s7_scheme *sc, s7_pointer let, s7_pointer val1, s7_pointer val2, s7_pointer val3)
+{
+  s7_pointer slot = let_slots(let);
+  uint64_t id = ++sc->let_number;
+  let_set_id(let, id);
+  update_slot(slot, val1, id); slot = next_slot(slot);
+  update_slot(slot, val2, id); slot = next_slot(slot);
+  update_slot(slot, val3, id);
+  return(let);
+}
+
+static s7_pointer update_let_with_four_slots(s7_scheme *sc, s7_pointer let, s7_pointer val1, s7_pointer val2, s7_pointer val3, s7_pointer val4)
+{
+  s7_pointer slot = let_slots(let);
+  uint64_t id = ++sc->let_number;
+  let_set_id(let, id);
+  update_slot(slot, val1, id); slot = next_slot(slot);
+  update_slot(slot, val2, id); slot = next_slot(slot);
+  update_slot(slot, val3, id); slot = next_slot(slot);
+  update_slot(slot, val4, id);
+  return(let);
+}
+
+static s7_pointer make_semipermanent_let(s7_scheme *sc, s7_pointer vars)
+{
+  s7_pointer slot, let = alloc_pointer(sc);
+  set_full_type(let, T_LET | T_SAFE_PROCEDURE | T_UNHEAP);
+  let_set_id(let, ++sc->let_number);
+  let_set_outlet(let, sc->curlet);
+  slot = make_semipermanent_slot(sc, caar(vars), sc->F);
+  add_semipermanent_let_or_slot(sc, slot);
+  symbol_set_local_slot(caar(vars), sc->let_number, slot);
+  let_set_slots(let, slot);
+  for (s7_pointer var = cdr(vars); is_pair(var); var = cdr(var))
+    {
+      s7_pointer last_slot = slot;
+      slot = make_semipermanent_slot(sc, caar(var), sc->F);
+      add_semipermanent_let_or_slot(sc, slot);
+      symbol_set_local_slot(caar(var), sc->let_number, slot);
+      slot_set_next(last_slot, slot);
+    }
+  slot_set_next(slot, slot_end);
+  add_semipermanent_let_or_slot(sc, let); /* need to mark outlet and maybe slot values */
+  return(let);
+}
+
+static s7_pointer call_setter(s7_scheme *sc, s7_pointer slot, s7_pointer old_value);
+
+static inline s7_pointer checked_slot_set_value(s7_scheme *sc, s7_pointer y, s7_pointer value)
+{
+  if (slot_has_setter(y))
+    slot_set_value(y, call_setter(sc, y, value));
+  else
+    {
+      if (is_immutable_slot(y))
+	immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->let_set_symbol, slot_symbol(y)));
+      slot_set_value(y, value);
+    }
+  return(slot_value(y));
+}
+
+static s7_pointer let_fill(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer e = car(args), val;
+  if (e == sc->rootlet)
+    out_of_range_error_nr(sc, sc->fill_symbol, int_one, e, wrap_string(sc, "can't fill! rootlet", 19));
+  if (e == sc->s7_starlet)
+    out_of_range_error_nr(sc, sc->fill_symbol, int_one, e, wrap_string(sc, "can't fill! *s7*", 16));
+  if (e == sc->owlet)                 /* (owlet) copies sc->owlet, so this probably can't happen */
+    out_of_range_error_nr(sc, sc->fill_symbol, int_one, e, wrap_string(sc, "can't fill! owlet", 17));
+  if (is_funclet(e))
+    out_of_range_error_nr(sc, sc->fill_symbol, int_one, e, wrap_string(sc, "can't fill! a funclet", 21));
+  val = cadr(args);
+  for (s7_pointer p = let_slots(e); tis_slot(p); p = next_slot(p))
+    checked_slot_set_value(sc, p, val);
+  return(val);
+}
+
+static s7_int s7_starlet_length(void);
+
+static s7_int let_length(s7_scheme *sc, s7_pointer e)
+{
+  /* used by length, applicable_length, copy, and some length optimizations */
+  s7_int i;
+  s7_pointer p;
+
+  if (e == sc->rootlet)
+    {
+      for (i = 0, p = sc->rootlet_slots; tis_slot(p); i++, p = next_slot(p));
+      return(i);
+    }
+  if (e == sc->s7_starlet)
+    return(s7_starlet_length());
+  if (has_active_methods(sc, e))
+    {
+      s7_pointer length_func = find_method(sc, e, sc->length_symbol);
+      if (length_func != sc->undefined)
+	{
+	  p = s7_apply_function(sc, length_func, set_plist_1(sc, e));
+	  return((s7_is_integer(p)) ? s7_integer(p) : -1); /* ?? */
+	}}
+  for (i = 0, p = let_slots(e); tis_slot(p); i++, p = next_slot(p));
+  return(i);
+}
+
+static void slot_set_setter(s7_pointer p, s7_pointer val)
+{
+  if ((type(val) == T_C_FUNCTION) &&
+      (c_function_has_bool_setter(val)))
+    slot_set_setter_1(p, c_function_bool_setter(val));
+  else slot_set_setter_1(p, val);
+}
+
+static void slot_set_value_with_hook_1(s7_scheme *sc, s7_pointer slot, s7_pointer value)
+{
+  /* (set! (hook-functions *rootlet-redefinition-hook*) (list (lambda (hook) (format *stderr* "~A ~A~%" (hook 'name) (hook 'value))))) */
+  s7_pointer symbol = slot_symbol(slot);
+  if ((global_slot(symbol) == slot) &&
+      (value != slot_value(slot)))
+    s7_call(sc, sc->rootlet_redefinition_hook, set_plist_2(sc, symbol, value));
+  slot_set_value(slot, value);
+}
+
+static void remove_function_from_heap(s7_scheme *sc, s7_pointer value); /* calls remove_let_from_heap */
+
+static void remove_let_from_heap(s7_scheme *sc, s7_pointer lt)
+{
+  for (s7_pointer p = let_slots(lt); tis_slot(p); p = next_slot(p))
+    {
+      s7_pointer val = slot_value(p);
+      if ((has_closure_let(val)) &&
+	  (in_heap(closure_args(val))))
+	remove_function_from_heap(sc, val);
+    }
+  let_set_removed(lt);
+}
+
+static void remove_function_from_heap(s7_scheme *sc, s7_pointer value)
+{
+  s7_pointer lt;
+  remove_from_heap(sc, closure_args(value));
+  remove_from_heap(sc, closure_body(value));
+  /* remove closure if it's local to current func (meaning (define f (let ...) (lambda ...)) removes the enclosing let) */
+  lt = closure_let(value);
+  if ((is_let(lt)) && (!let_removed(lt)) && (lt != sc->shadow_rootlet))
+    {
+      lt = let_outlet(lt);
+      if ((is_let(lt)) && (!let_removed(lt)) && (lt != sc->shadow_rootlet))
+	{
+	  remove_let_from_heap(sc, lt);
+	  lt = let_outlet(lt);
+	  if ((is_let(lt)) && (!let_removed(lt)) && (lt != sc->shadow_rootlet))
+	    remove_let_from_heap(sc, lt);
+	}}
+}
+
+static void add_slot_to_rootlet(s7_scheme *sc, s7_pointer slot)
+{
+  set_in_rootlet(slot);
+  slot_set_next(slot, sc->rootlet_slots);
+  sc->rootlet_slots = slot;
+}
+
+static void add_to_unlet(s7_scheme *sc, s7_pointer symbol)
+{
+  unlet_entry_t *new_entry = (unlet_entry_t *)permalloc(sc, sizeof(s7_pointer) + sizeof(unlet_entry_t *));
+  new_entry->symbol = symbol;
+  new_entry->next = sc->unlet_entries;
+  sc->unlet_entries = new_entry;
+}
+
+s7_pointer s7_make_slot(s7_scheme *sc, s7_pointer let, s7_pointer symbol, s7_pointer value)
+{
+  if ((!is_let(let)) ||
+      (let == sc->rootlet))
+    {
+      s7_pointer slot;
+      if (is_immutable(sc->rootlet))
+	immutable_object_error_nr(sc, set_elist_2(sc, wrap_string(sc, "can't define '~S; rootlet is immutable", 38), symbol));
+      if ((sc->safety <= NO_SAFETY) &&
+	  (has_closure_let(value)))
+	remove_function_from_heap(sc, value); /* optimization of access pointers happens later so presumably this is safe */
+
+      /* first look for existing slot -- this is not always checked before calling s7_make_slot */
+      if (is_slot(global_slot(symbol)))
+	{
+	  slot = global_slot(symbol);
+	  if (is_immutable_slot(slot))     /* 2-Oct-23: (immutable! 'abs) (set! abs 3) */
+	    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->set_symbol, symbol));
+	  symbol_increment_ctr(symbol);
+	  slot_set_value_with_hook(slot, value);
+	  return(slot);
+	}
+
+      slot = make_semipermanent_slot(sc, symbol, value);
+      add_slot_to_rootlet(sc, slot);
+      set_global_slot(symbol, slot);
+      if (symbol_id(symbol) == 0)         /* never defined locally (symbol_id tracks let_id) */
+	{
+	  if ((!is_gensym(symbol)) &&
+	      (initial_value(symbol) == sc->undefined) &&
+	      (!in_heap(value)) &&         /* else initial_value can be GC'd if symbol set! (initial != global, initial unprotected) */
+	       ((!sc->string_signature) || /* from init_signatures -- maybe need a boolean for this */
+	       (is_c_function(value))))    /* || (is_syntax(value)) -- we need 'else as a special case? */
+	    /* the string_signature business means only the initial rootlet c_functions take part in unlet.  It would be neat if any
+	     *   cload library's c_functions could be there as well, but then (unlet) needs to know which envs are in the chain.
+	     *   The current shadow_rootlet could be saved in each initial_value, these could be marked in some way, then the chain
+	     *   searched in (unlet) to get the currently active envs -- maybe too complex?  We could also provide a way to overrule
+	     *   the string_signature check, but then symbol collisions would probably be resolved as the last loaded (which might not
+	     *   be in the active chain).
+	     * Also, the c_function check is overly paranoid -- all we need is that the value is semipermanent (T_UNHEAP?).
+	     * But I don't see any interesting omissions.
+	     */
+	    {
+	      set_initial_value(symbol, value);
+	      if ((!sc->string_signature) && ((is_c_function(value)) || (is_syntax(value)))) /* syntax probably can't happen here (handled explicitly in syntax procedure) */
+		/* non-c_functions that are not set! (and therefore initial_value GC) protected by default: make-hook hook-functions
+		 *   if these initial_values are added to unlet, they need explicit GC protection.
+		 */
+		add_to_unlet(sc, symbol);
+	    }
+	  set_local_slot(symbol, slot);
+	}
+      symbol_increment_ctr(symbol);
+      if (is_gensym(symbol))
+	remove_gensym_from_heap(sc, symbol);
+      return(slot);
+    }
+  return(add_slot_checked_with_id(sc, let, symbol, value));
+  /* there are about as many lets as local variables -- this strikes me as surprising, but it holds up across a lot of code */
+}
+
+static s7_pointer make_slot(s7_scheme *sc, s7_pointer variable, s7_pointer value)
+{
+  s7_pointer y;
+  new_cell(sc, y, T_SLOT);
+  slot_set_symbol_and_value(y, variable, value);
+  return(y);
+}
+
+
+/* -------------------------------- let? -------------------------------- */
+bool s7_is_let(s7_pointer e) {return(is_let(e));}
+
+static s7_pointer g_is_let(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_let "(let? obj) returns #t if obj is a let."
+  #define Q_is_let sc->pl_bt
+  check_boolean_method(sc, is_let, sc->is_let_symbol, args);
+}
+
+
+/* -------------------------------- funclet? -------------------------------- */
+static s7_pointer g_is_funclet(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_funclet "(funclet? obj) returns #t if obj is a funclet (a function's environment)."
+  #define Q_is_funclet sc->pl_bt
+
+  s7_pointer lt = car(args);
+  if (lt == sc->rootlet) return(sc->F);
+  if ((is_let(lt)) && ((is_funclet(lt)) || (is_maclet(lt))))
+    return(sc->T);
+  if (!has_active_methods(sc, lt))
+    return(sc->F);
+  return(apply_boolean_method(sc, lt, sc->is_funclet_symbol));
+}
+
+
+/* -------------------------------- unlet -------------------------------- */
+static s7_pointer g_unlet(s7_scheme *sc, s7_pointer unused_args)
+{
+  /* add sc->unlet bindings to the current environment */
+  #define H_unlet "(unlet) returns a let that establishes the original bindings of all the predefined functions"
+  #define Q_unlet s7_make_signature(sc, 1, sc->is_let_symbol)
+
+  s7_pointer res;
+  sc->w = make_let(sc, sc->curlet);
+  set_is_unlet(sc->w);
+  if (global_value(sc->else_symbol) != sc->else_symbol)
+    add_slot_checked_with_id(sc, sc->w, sc->else_symbol, initial_value(sc->else_symbol));
+  for (unlet_entry_t *p = sc->unlet_entries; p; p = p->next)
+    {
+      s7_pointer sym = p->symbol;
+      s7_pointer x = initial_value(sym);
+      if ((x != global_value(sym)) ||  /* it has been changed globally */
+	  ((!is_global(sym)) &&        /* it might be shadowed locally */
+	   (s7_symbol_local_value(sc, sym, sc->curlet) != global_value(sym))))
+	add_slot_checked_with_id(sc, sc->w, sym, x);
+    }
+  res = sc->w;
+  sc->w = sc->unused;
+  return(res);
+}
+
+
+/* -------------------------------- openlet? -------------------------------- */
+bool s7_is_openlet(s7_pointer e) {return(has_methods(e));}
+
+static s7_pointer g_is_openlet(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_openlet "(openlet? obj) returns #t is 'obj' has methods."
+  #define Q_is_openlet sc->pl_bt
+
+  s7_pointer e = car(args);  /* if e is not a let, should this raise an error? -- no, easier to use this way in cond */
+  check_method(sc, e, sc->is_openlet_symbol, args);
+  return(make_boolean(sc, has_methods(e)));
+}
+
+
+/* -------------------------------- openlet -------------------------------- */
+s7_pointer s7_openlet(s7_scheme *sc, s7_pointer e)
+{
+  set_has_methods(e);
+  return(e);
+}
+
+static s7_pointer g_openlet(s7_scheme *sc, s7_pointer args)
+{
+  #define H_openlet "(openlet e) tells the built-in functions that the let 'e might have an over-riding method."
+  #define Q_openlet sc->pcl_e
+
+  s7_pointer e = car(args), elet, func;
+  if (e == sc->nil)
+    error_nr(sc, sc->out_of_range_symbol, set_elist_1(sc, wrap_string(sc, "can't openlet nil", 17)));
+  elet = find_let(sc, e); /* returns nil if no let found, so has to follow error check above */
+  if (!is_let(elet))
+    sole_arg_wrong_type_error_nr(sc, sc->openlet_symbol, e, a_let_string);
+  if (elet == sc->rootlet)
+    error_nr(sc, sc->out_of_range_symbol, set_elist_1(sc, wrap_string(sc, "can't openlet rootlet", 21)));
+  if (is_unlet(elet)) /* protect against infinite loop: (let () (define + -) (with-let (unlet) (+ (openlet (unlet)) 2))) */
+    error_nr(sc, sc->out_of_range_symbol, set_elist_1(sc, wrap_string(sc, "can't openlet unlet", 19)));
+  if ((has_active_methods(sc, e)) &&
+      ((func = find_method(sc, elet, sc->openlet_symbol)) != sc->undefined))
+    return(s7_apply_function(sc, func, args));
+  set_has_methods(e);
+  return(e);
+}
+
+/* -------------------------------- coverlet -------------------------------- */
+static s7_pointer g_coverlet(s7_scheme *sc, s7_pointer args)
+{
+  #define H_coverlet "(coverlet e) undoes an earlier openlet."
+  #define Q_coverlet sc->pcl_e
+
+  s7_pointer e = car(args);
+  check_method(sc, e, sc->coverlet_symbol, set_plist_1(sc, e));
+  if ((e == sc->rootlet) || (e == sc->s7_starlet))
+    error_nr(sc, sc->out_of_range_symbol, set_elist_2(sc, wrap_string(sc, "can't coverlet ~S", 17), e));
+  if ((is_let(e)) && (is_unlet(e)))
+    error_nr(sc, sc->out_of_range_symbol, set_elist_1(sc, wrap_string(sc, "can't coverlet unlet", 20)));
+  if ((is_let(e)) || (has_closure_let(e)) ||
+      ((is_c_object(e)) && (c_object_let(e) != sc->nil)) ||
+      ((is_c_pointer(e)) && (is_let(c_pointer_info(e)))))
+    {
+      clear_has_methods(e);
+      return(e);
+    }
+  sole_arg_wrong_type_error_nr(sc, sc->coverlet_symbol, e, a_let_string);
+  return(NULL);
+}
+
+
+/* -------------------------------- varlet -------------------------------- */
+static void check_let_fallback(s7_scheme *sc, const s7_pointer symbol, s7_pointer let)
+{
+  if (symbol == sc->let_ref_fallback_symbol)
+    set_has_let_ref_fallback(let);
+  else
+    if (symbol == sc->let_set_fallback_symbol)
+      set_has_let_set_fallback(let);
+}
+
+static void append_let(s7_scheme *sc, s7_pointer new_e, s7_pointer old_e)
+{
+  if (new_e == sc->rootlet)
+    for (s7_pointer x = let_slots(old_e); tis_slot(x); x = next_slot(x))
+      {
+	s7_pointer sym = slot_symbol(x), val = slot_value(x);
+	if (is_slot(global_slot(sym)))
+	  slot_set_value(global_slot(sym), val);
+	else s7_make_slot(sc, sc->rootlet, sym, val);
+      }
+  else
+    if (old_e == sc->s7_starlet)
+      {
+	s7_pointer iter = s7_make_iterator(sc, sc->s7_starlet);
+	s7_int gc_loc = gc_protect_1(sc, iter);
+	iterator_current(iter) = cons_unchecked(sc, sc->F, sc->F);
+	set_mark_seq(iter); /* so carrier is GC protected by mark_iterator */
+	while (true)
+	  {
+	    s7_pointer y = s7_iterate(sc, iter);
+	    if (iterator_is_at_end(iter)) break;
+	    add_slot_checked_with_id(sc, new_e, car(y), cdr(y));
+	  }
+	s7_gc_unprotect_at(sc, gc_loc);
+      }
+    else
+      for (s7_pointer x = let_slots(old_e); tis_slot(x); x = next_slot(x))
+	add_slot_checked_with_id(sc, new_e, slot_symbol(x), slot_value(x)); /* not add_slot here because we might run off the free heap end */
+}
+
+static s7_pointer check_c_object_let(s7_scheme *sc, s7_pointer old_e, s7_pointer caller)
+{
+  if (is_c_object(old_e))
+    old_e = c_object_let(old_e);
+  if (!is_let(old_e))
+    sole_arg_wrong_type_error_nr(sc, caller, old_e, a_let_string);
+  return(old_e);
+}
+
+s7_pointer s7_varlet(s7_scheme *sc, s7_pointer let, s7_pointer symbol, s7_pointer value)
+{
+  if (!is_let(let))
+    wrong_type_error_nr(sc, sc->varlet_symbol, 1, let, a_let_string);
+  if (!is_symbol(symbol))
+    wrong_type_error_nr(sc, sc->varlet_symbol, 2, symbol, a_symbol_string);
+
+  if ((is_slot(global_slot(symbol))) &&
+      (is_syntax(global_value(symbol))))
+    wrong_type_error_nr(sc, sc->varlet_symbol, 2, symbol, wrap_string(sc, "a non-syntactic symbol", 22));
+
+  if (let == sc->rootlet)
+    {
+      if (is_slot(global_slot(symbol)))
+	slot_set_value(global_slot(symbol), value);
+      else s7_make_slot(sc, sc->rootlet, symbol, value);
+    }
+  else
+    {
+      add_slot_checked_with_id(sc, let, symbol, value);
+      check_let_fallback(sc, symbol, let);
+    }
+  return(value);
+}
+
+static int32_t position_of(const s7_pointer p, s7_pointer args)
+{
+  int32_t i;
+  for (i = 1; p != args; i++, args = cdr(args));
+  return(i);
+}
+
+static s7_pointer g_varlet(s7_scheme *sc, s7_pointer args)   /* varlet = with-let + define */
+{
+  #define H_varlet "(varlet target-let ...) adds its arguments (a let, a cons: symbol . value, or two arguments, the symbol and its value) \
+to the let target-let, and returns target-let.  (varlet (curlet) 'a 1) adds 'a to the current environment with the value 1."
+  #define Q_varlet s7_make_circular_signature(sc, 2, 4, sc->is_let_symbol, \
+                     s7_make_signature(sc, 2, sc->is_let_symbol, sc->is_null_symbol), \
+                       s7_make_signature(sc, 3, sc->is_pair_symbol, sc->is_symbol_symbol, sc->is_let_symbol), \
+                         sc->T)
+
+  s7_pointer e = car(args);
+  if (is_null(e)) /* PERHAPS: this is a leftover from the days when () -> rootlet -- remove? */
+    e = sc->rootlet;
+  else
+    {
+      check_method(sc, e, sc->varlet_symbol, args);
+      if (!is_let(e))
+	wrong_type_error_nr(sc, sc->varlet_symbol, 1, e, a_let_string);
+      if ((is_immutable_let(e)) || (e == sc->s7_starlet))
+	immutable_object_error_nr(sc, set_elist_3(sc, wrap_string(sc, "can't (varlet ~{~S~^ ~}), ~S is immutable", 41), args, e));
+    }
+  for (s7_pointer x = cdr(args); is_pair(x); x = cdr(x))
+    {
+      s7_pointer sym, val, p = car(x);
+      switch (type(p))
+	{
+	case T_SYMBOL:
+	  sym = (is_keyword(p)) ? keyword_symbol(p) : p;
+	  if (!is_pair(cdr(x)))
+	    error_nr(sc, sc->syntax_error_symbol,
+		     set_elist_3(sc, wrap_string(sc, "varlet: symbol ~S, but no value: ~S", 35), p, args));
+	  if (is_constant_symbol(sc, sym))
+	    wrong_type_error_nr(sc, sc->varlet_symbol, position_of(x, args), sym, a_non_constant_symbol_string);
+	  x = cdr(x);
+	  val = car(x);
+	  break;
+
+	case T_PAIR:
+	  sym = car(p);
+	  if (!is_symbol(sym))
+	    wrong_type_error_nr(sc, sc->varlet_symbol, position_of(x, args), p, a_symbol_string);
+	  if (is_constant_symbol(sc, sym))
+	    wrong_type_error_nr(sc, sc->varlet_symbol, position_of(x, args), sym, a_non_constant_symbol_string);
+	  val = cdr(p);
+	  break;
+
+	case T_LET: /* (varlet (inlet 'a 1) (rootlet)) is trouble */
+	  if ((p == sc->rootlet) || (e == sc->s7_starlet)) continue;
+	  append_let(sc, e, check_c_object_let(sc, p, sc->varlet_symbol));
+	  if (has_let_set_fallback(p)) set_has_let_set_fallback(e);
+	  if (has_let_ref_fallback(p)) set_has_let_ref_fallback(e);
+	  continue;
+
+	default:
+	  wrong_type_error_nr(sc, sc->varlet_symbol, position_of(x, args), p, a_symbol_string);
+	}
+      if (e == sc->rootlet)
+	{
+	  s7_pointer gslot = global_slot(sym);
+	  if (is_slot(gslot))
+	    {
+	      if (is_immutable(gslot)) /* (immutable! 'abs) (varlet (rootlet) 'abs 1) */
+		immutable_object_error_nr(sc, set_elist_5(sc, wrap_string(sc, "~S is immutable in (varlet ~S '~S ~S)", 37), sym, car(args), p, val));
+	      slot_set_value_with_hook(global_slot(sym), val);
+	    }
+	  else s7_make_slot(sc, sc->rootlet, sym, val);
+	}
+      else
+	{
+	  check_let_fallback(sc, sym, e);
+	  add_slot_checked_with_id(sc, e, sym, val);
+	}}
+      /* this used to check for sym already defined, and set its value, but that greatly slows down
+       *   the most common use (adding a slot), and makes it hard to shadow explicitly.  Don't use
+       *   varlet as a substitute for set!/let-set!.
+       */
+  return(e);
+}
+
+
+/* -------------------------------- cutlet -------------------------------- */
+static s7_pointer g_cutlet(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cutlet "(cutlet e symbol ...) removes symbols from the let e."
+  #define Q_cutlet s7_make_circular_signature(sc, 2, 3, sc->is_let_symbol, sc->is_let_symbol, sc->is_symbol_symbol)
+
+  s7_pointer e = car(args);
+  s7_int the_un_id;
+  if (is_null(e))
+    e = sc->rootlet; /* PERHAPS: this is a leftover from the days when () -> rootlet -- remove? */
+  else
+    {
+      check_method(sc, e, sc->cutlet_symbol, args);
+      if (!is_let(e))
+	wrong_type_error_nr(sc, sc->cutlet_symbol, 1, e, a_let_string);
+      if ((is_immutable_let(e)) || (e == sc->s7_starlet))
+	immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->cutlet_symbol, e));
+    }
+  /* besides removing the slot we have to make sure the symbol_id does not match else
+   *   let-ref and others will use the old slot!  What's the un-id?  Perhaps the next one?
+   *   (let ((b 1)) (let ((b 2)) (cutlet (curlet) 'b)) b)
+   */
+  the_un_id = ++sc->let_number;
+
+  for (s7_pointer syms = cdr(args); is_pair(syms); syms = cdr(syms))
+    {
+      s7_pointer sym = car(syms);
+
+      if (!is_symbol(sym))
+	wrong_type_error_nr(sc, sc->cutlet_symbol, position_of(syms, args), sym, a_symbol_string);
+      if (is_keyword(sym))
+	sym = keyword_symbol(sym);
+
+      if (e == sc->rootlet)
+	{
+	  if (!is_slot(global_slot(sym)))
+	    error_nr(sc, sc->out_of_range_symbol, set_elist_2(sc, wrap_string(sc, "cutlet can't remove ~S", 22), sym));
+	  if (is_immutable(global_slot(sym)))
+	    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->cutlet_symbol, sym));
+	  symbol_set_id(sym, the_un_id);
+	  slot_set_value(global_slot(sym), sc->undefined);
+	  /* here we need to at least clear bits: syntactic binder clean-symbol(?) etc, maybe also locally */
+	}
+      else
+	{
+	  s7_pointer slot;
+	  if ((has_let_fallback(e)) &&
+	      ((sym == sc->let_ref_fallback_symbol) || (sym == sc->let_set_fallback_symbol)))
+	    error_nr(sc, sc->out_of_range_symbol, set_elist_2(sc, wrap_string(sc, "cutlet can't remove ~S", 22), sym));
+
+	  slot = let_slots(e);
+	  if (tis_slot(slot))
+	    {
+	      if (slot_symbol(slot) == sym)
+		{
+		  if (is_immutable_slot(slot))
+		    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->cutlet_symbol, sym));
+		  let_set_slots(e, next_slot(let_slots(e)));
+		  symbol_set_id(sym, the_un_id);
+		}
+	      else
+		{
+		  s7_pointer last_slot = slot;
+		  for (slot = next_slot(let_slots(e)); tis_slot(slot); last_slot = slot, slot = next_slot(slot))
+		    if (slot_symbol(slot) == sym)
+		      {
+			if (is_immutable_slot(slot))
+			  immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->cutlet_symbol, sym));
+			symbol_set_id(sym, the_un_id);
+			slot_set_next(last_slot, next_slot(slot));
+			break;
+		      }}}}}
+  return(e);
+}
+
+
+/* -------------------------------- sublet -------------------------------- */
+static s7_pointer sublet_1(s7_scheme *sc, s7_pointer e, s7_pointer bindings, s7_pointer caller)
+{
+  s7_pointer new_e;
+  if (e == sc->nil) e = sc->rootlet; /* PERHAPS: this is a leftover from the days when () -> rootlet -- remove? */
+  new_e = make_let(sc, e);
+  set_all_methods(new_e, e);
+
+  if (!is_null(bindings))
+    {
+      s7_pointer sp = NULL;
+      sc->temp3 = new_e;
+      for (s7_pointer x = bindings; is_pair(x); x = cdr(x))
+	{
+	  s7_pointer p = car(x), sym, val;
+
+	  switch (type(p))
+	    {
+	    case T_SYMBOL:
+	      sym = (is_keyword(p)) ? keyword_symbol(p) : p;
+	      if (!is_pair(cdr(x)))
+		error_nr(sc, sc->syntax_error_symbol,
+			 set_elist_4(sc, wrap_string(sc, "~A: entry ~S, but no value: ~S", 30), caller, p, bindings));
+	      x = cdr(x);
+	      val = car(x);
+	      break;
+
+	    case T_PAIR:
+	      sym = car(p);
+	      if (!is_symbol(sym))
+		wrong_type_error_nr(sc, caller, 1 + position_of(x, bindings), p, a_symbol_string);
+	      if (is_keyword(sym))
+		sym = keyword_symbol(sym);
+	      val = cdr(p);
+	      break;
+
+	    case T_LET:
+	      if ((p == sc->rootlet) || (new_e == sc->s7_starlet)) continue;
+	      append_let(sc, new_e, check_c_object_let(sc, p, caller));
+	      if (tis_slot(let_slots(new_e))) /* make sure the end slot (sp) is correct */
+		for (sp = let_slots(new_e); tis_slot(next_slot(sp)); sp = next_slot(sp));
+	      continue;
+
+	    default:
+	      wrong_type_error_nr(sc, caller, 1 + position_of(x, bindings), p, a_symbol_string);
+	    }
+
+	  if (is_constant_symbol(sc, sym))
+	    wrong_type_error_nr(sc, caller, 1 + position_of(x, bindings), sym, a_non_constant_symbol_string);
+#if 0
+	  if ((is_slot(global_slot(sym))) &&
+	      (is_syntax_or_qq(global_value(sym))))
+	    wrong_type_error_nr(sc, caller, 2, sym, wrap_string(sc, "a non-syntactic symbol", 22));
+	  /* this is a local redefinition which we accept elsewhere: (let ((if 3)) if) -> 3 */
+#endif
+	  /* here we know new_e is a let and is not rootlet */
+	  if (!sp)
+	    sp = add_slot_checked_with_id(sc, new_e, sym, val);
+	  else
+	    {
+	      if (sc->free_heap_top <= sc->free_heap_trigger) try_to_call_gc(sc); /* or maybe add add_slot_at_end_checked? */
+	      sp = inline_add_slot_at_end(sc, let_id(new_e), sp, sym, val);
+	      set_local(sym); /* ? */
+	    }
+	  check_let_fallback(sc, sym, new_e);
+	}
+      sc->temp3 = sc->unused;
+    }
+  return(new_e);
+}
+
+s7_pointer s7_sublet(s7_scheme *sc, s7_pointer e, s7_pointer bindings) {return(sublet_1(sc, e, bindings, sc->sublet_symbol));}
+
+static s7_pointer g_sublet(s7_scheme *sc, s7_pointer args)
+{
+  #define H_sublet "(sublet lt ...) makes a new let (environment) within the environment 'lt', initializing it with the bindings"
+  #define Q_sublet Q_varlet
+
+  s7_pointer e = car(args);
+  if (is_null(e))    /* is this a good idea anymore?  () no longer stands for rootlet elsewhere(?) */
+    e = sc->rootlet; /* PERHAPS: this is a leftover from the days when () -> rootlet -- remove? */
+  else
+    if (e != sc->rootlet)
+      {
+	check_method(sc, e, sc->sublet_symbol, args);
+	if (!is_let(e))
+	  wrong_type_error_nr(sc, sc->sublet_symbol, 1, e, a_let_string);
+      }
+  return(sublet_1(sc, e, cdr(args), sc->sublet_symbol));
+}
+
+static s7_pointer g_sublet_curlet(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer sym = cadr(args), new_e;
+  check_method(sc, sc->curlet, sc->sublet_symbol, args);
+  new_e = inline_make_let_with_slot(sc, sc->curlet, sym, caddr(args));
+  set_all_methods(new_e, sc->curlet);
+  check_let_fallback(sc, sym, new_e);
+  return(new_e);
+}
+
+static s7_pointer sublet_chooser(s7_scheme *sc, s7_pointer f, int32_t num_args, s7_pointer expr)
+{
+  if (num_args == 3)
+    {
+      s7_pointer args = cdr(expr);
+      if ((is_pair(car(args))) && (caar(args) == sc->curlet_symbol) && (is_null(cdar(args))) &&
+	  (is_quoted_symbol(cadr(args))))
+	return(sc->sublet_curlet);
+    }
+  return(f);
+}
+
+
+/* -------------------------------- inlet -------------------------------- */
+s7_pointer s7_inlet(s7_scheme *sc, s7_pointer args)
+{
+  #define H_inlet "(inlet ...) adds its arguments, each a let, a cons: '(symbol . value), or a symbol/value pair, \
+to a new let, and returns the new let. (inlet :a 1 :b 2) or (inlet 'a 1 'b 2)"
+  #define Q_inlet s7_make_circular_signature(sc, 1, 2, sc->is_let_symbol, sc->T)
+  return(sublet_1(sc, sc->rootlet, args, sc->inlet_symbol));
+}
+
+#define g_inlet s7_inlet
+
+static s7_pointer g_simple_inlet(s7_scheme *sc, s7_pointer args)
+{
+  /* here all args are paired with normal symbol/value, no fallbacks, no immutable symbols, no syntax, etc */
+  s7_pointer new_e = make_let(sc, sc->rootlet);
+  int64_t id = let_id(new_e);
+  s7_pointer sp = NULL;
+
+  sc->temp3 = new_e;
+  for (s7_pointer x = args; is_pair(x); x = cddr(x))
+    {
+      s7_pointer symbol = car(x);
+      if (is_keyword(symbol))                 /* (inlet ':allow-other-keys 3) */
+	symbol = keyword_symbol(symbol);
+      if (is_constant_symbol(sc, symbol))     /* (inlet 'pi 1) */
+	wrong_type_error_nr(sc, sc->inlet_symbol, 1, symbol, a_non_constant_symbol_string);
+      if (!sp)
+	{
+	  add_slot_unchecked(sc, new_e, symbol, cadr(x), id);
+	  sp = let_slots(new_e);
+	}
+      else sp = inline_add_slot_at_end(sc, id, sp, symbol, cadr(x));
+    }
+  sc->temp3 = sc->unused;
+  return(new_e);
+}
+
+static s7_pointer inlet_p_pp(s7_scheme *sc, s7_pointer symbol, s7_pointer value)
+{
+  s7_pointer x;
+
+  if (!is_symbol(symbol))
+    return(sublet_1(sc, sc->rootlet, set_plist_2(sc, symbol, value), sc->inlet_symbol));
+  if (is_keyword(symbol))
+    symbol = keyword_symbol(symbol);
+  if (is_constant_symbol(sc, symbol))
+    wrong_type_error_nr(sc, sc->inlet_symbol, 1, symbol, a_non_constant_symbol_string);
+  if ((is_global(symbol)) &&
+      (is_syntax_or_qq(global_value(symbol))))
+    wrong_type_error_nr(sc, sc->inlet_symbol, 1, symbol, wrap_string(sc, "a non-syntactic symbol", 22));
+
+  new_cell(sc, x, T_LET | T_SAFE_PROCEDURE);
+  sc->temp3 = x;
+  let_set_id(x, ++sc->let_number);
+  let_set_outlet(x, sc->rootlet);
+  let_set_slots(x, slot_end);
+  add_slot_unchecked(sc, x, symbol, value, let_id(x));
+  sc->temp3 = sc->unused;
+  return(x);
+}
+
+static s7_pointer internal_inlet(s7_scheme *sc, s7_int num_args, ...)
+{
+  va_list ap;
+  s7_pointer new_e = make_let(sc, sc->rootlet);
+  int64_t id = let_id(new_e);
+  s7_pointer sp = NULL;
+
+  sc->temp3 = new_e;
+  va_start(ap, num_args);
+  for (s7_int i = 0; i < num_args; i += 2)
+    {
+      s7_pointer symbol = va_arg(ap, s7_pointer);
+      s7_pointer value = va_arg(ap, s7_pointer);
+      if (!sp)
+	{
+	  add_slot_unchecked(sc, new_e, symbol, value, id);
+	  sp = let_slots(new_e);
+	}
+      else sp = inline_add_slot_at_end(sc, id, sp, symbol, value);
+    }
+  va_end(ap);
+  sc->temp3 = sc->unused;
+  return(new_e);
+}
+
+static bool is_proper_quote(s7_scheme *sc, s7_pointer p)
+{
+  return((is_safe_quoted_pair(p)) &&
+	 (is_pair(cdr(p))) &&
+	 (is_null(cddr(p))));
+}
+
+static s7_pointer inlet_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  if ((args > 0) &&
+      ((args % 2) == 0))
+    {
+      for (s7_pointer p = cdr(expr); is_pair(p); p = cddr(p))
+	{
+	  s7_pointer sym;
+	  if (is_symbol_and_keyword(car(p)))                  /* (inlet :if ...) */
+	    sym = keyword_symbol(car(p));
+	  else
+	    {
+	      if (!is_proper_quote(sc, car(p))) return(f);    /* (inlet abs ...) */
+	      sym = cadar(p);                                 /* looking for (inlet 'a ...) */
+	      if (!is_symbol(sym)) return(f);                 /* (inlet '(a . 3) ...) */
+	      if (is_keyword(sym)) sym = keyword_symbol(sym); /* (inlet ':abs ...) */
+	    }
+	  if ((is_possibly_constant(sym)) ||                  /* (inlet 'define-constant ...) or (inlet 'pi ...) */
+	      (is_syntactic_symbol(sym))  ||                  /* (inlet 'if 3) */
+	      ((is_slot(global_slot(sym))) &&
+	       (is_syntax_or_qq(global_value(sym)))) ||       /* (inlet 'quasiquote 1) */
+	      (sym == sc->let_ref_fallback_symbol) ||
+	      (sym == sc->let_set_fallback_symbol))
+	    return(f);
+	}
+      return(sc->simple_inlet);
+    }
+  return(f);
+}
+
+
+/* -------------------------------- let->list -------------------------------- */
+static s7_pointer proper_list_reverse_in_place(s7_scheme *sc, s7_pointer list);
+
+static s7_pointer abbreviate_let(s7_scheme *sc, s7_pointer val)
+{
+  if (is_let(val))
+    return(make_symbol(sc, "<inlet...>", 11));
+  return(val);
+}
+
+s7_pointer s7_let_to_list(s7_scheme *sc, s7_pointer let)
+{
+  s7_pointer x;
+  sc->temp3 = sc->w;
+  sc->w = sc->nil;
+
+  if (let == sc->rootlet)
+    {
+      for (s7_pointer lib = global_value(sc->libraries_symbol); is_pair(lib); lib = cdr(lib))
+	sc->w = cons(sc, caar(lib), sc->w);
+      sc->w = cons(sc, cons(sc, sc->libraries_symbol, sc->w), sc->nil);
+      for (s7_pointer y = sc->rootlet_slots; tis_slot(y); y = next_slot(y))
+	if (slot_symbol(y) != sc->libraries_symbol)
+	  sc->w = cons_unchecked(sc, cons(sc, slot_symbol(y), abbreviate_let(sc, slot_value(y))), sc->w);
+      sc->w = proper_list_reverse_in_place(sc, sc->w);
+    }
+  else
+    {
+      s7_pointer iter, func;
+      s7_int gc_loc = -1;
+      /* need to check make-iterator method before dropping into let->list */
+
+      if ((has_active_methods(sc, let)) &&
+	  ((func = find_method(sc, let, sc->make_iterator_symbol)) != sc->undefined))
+	iter = s7_apply_function(sc, func, set_plist_1(sc, let));
+      else
+	if (let == sc->s7_starlet) /* (let->list *s7*) via s7_starlet_make_iterator */
+	  {
+	    iter = s7_make_iterator(sc, let);
+	    gc_loc = gc_protect_1(sc, iter);
+	  }
+	else iter = sc->nil;
+
+      if (is_null(iter))
+	for (x = let_slots(let); tis_slot(x); x = next_slot(x))
+	  sc->w = cons_unchecked(sc, cons(sc, slot_symbol(x), slot_value(x)), sc->w);
+      else
+	/* (begin (load "mockery.scm") (let ((lt ((*mock-pair* 'mock-pair) 1 2 3))) (format *stderr* "~{~A ~}" lt))) */
+	while (true)
+	  {
+	    x = s7_iterate(sc, iter);
+	    if (iterator_is_at_end(iter)) break;
+	    sc->w = cons(sc, x, sc->w);
+	  }
+      sc->w = proper_list_reverse_in_place(sc, sc->w);
+      if (gc_loc != -1)
+	s7_gc_unprotect_at(sc, gc_loc);
+    }
+  x = sc->w;
+  sc->w = sc->temp3;
+  sc->temp3 = sc->unused;
+  return(x);
+}
+
+#if (!WITH_PURE_S7)
+static s7_pointer g_let_to_list(s7_scheme *sc, s7_pointer args)
+{
+  #define H_let_to_list "(let->list let) returns let's bindings as a list of cons's: '(symbol . value)."
+  #define Q_let_to_list s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_let_symbol)
+
+  s7_pointer let = car(args);
+  check_method(sc, let, sc->let_to_list_symbol, args);
+  if (!is_let(let))
+    {
+      if (is_c_object(let))
+	let = c_object_let(let);
+      else
+	if (is_c_pointer(let))
+	  let = c_pointer_info(let);
+      if (let == sc->rootlet) /* don't laboriously expand this! */
+	return(cons(sc, let, sc->nil));
+      if (!is_let(let))
+        sole_arg_wrong_type_error_nr(sc, sc->let_to_list_symbol, let, a_let_string);
+    }
+  return(s7_let_to_list(sc, let));
+}
+#endif
+
+
+/* -------------------------------- let-ref -------------------------------- */
+static s7_pointer call_let_ref_fallback(s7_scheme *sc, s7_pointer let, s7_pointer symbol)
+{
+  s7_pointer p;
+  push_stack_no_let(sc, OP_GC_PROTECT, sc->value, sc->code);
+  /* (let ((x #f)) (let begin ((x 1234)) (begin 1) 2)) -> stack overflow eventually, but should we try to catch it? */
+  p = s7_apply_function(sc, find_method(sc, let, sc->let_ref_fallback_symbol), set_qlist_2(sc, let, symbol));
+  unstack_gc_protect(sc);
+  sc->code = T_Pos(stack_end_code(sc)); /* can be #<unused> */
+  sc->value = T_Ext(stack_end_args(sc));
+  return(p);
+}
+
+static s7_pointer call_let_set_fallback(s7_scheme *sc, s7_pointer let, s7_pointer symbol, s7_pointer value)
+{
+  s7_pointer p;
+  push_stack_no_let(sc, OP_GC_PROTECT, sc->value, sc->code);
+  p = s7_apply_function(sc, find_method(sc, let, sc->let_set_fallback_symbol), set_qlist_3(sc, let, symbol, value));
+  unstack_gc_protect(sc);
+  sc->code = T_Pos(stack_end_code(sc));
+  sc->value = T_Ext(stack_end_args(sc));
+  return(p);
+}
+
+static /* inline */ s7_pointer let_ref(s7_scheme *sc, s7_pointer let, s7_pointer symbol)
+{
+  /* (let ((a 1)) ((curlet) 'a)) or ((rootlet) 'abs) */
+  if (!is_let(let))
+    {
+      let = find_let(sc, let);
+      if (!is_let(let))
+	wrong_type_error_nr(sc, sc->let_ref_symbol, 1, let, a_let_string);
+    }
+  if (!is_symbol(symbol))
+    {
+      if ((let != sc->rootlet) && (has_let_ref_fallback(let))) /* let-ref|set-fallback refer to (explicit) let-ref in various forms, not the method lookup process */
+	return(call_let_ref_fallback(sc, let, symbol));
+      wrong_type_error_nr(sc, sc->let_ref_symbol, 2, symbol, a_symbol_string);
+    }
+  /* a let-ref method is almost impossible to write without creating an infinite loop:
+   *   any reference to the let will probably call let-ref somewhere, calling us again, and looping.
+   *   This is not a problem in c-objects and funclets because c-object-ref and funclet-ref don't exist.
+   *   After much wasted debugging, I decided to make let-ref and let-set! immutable.
+   */
+
+  if (let_id(let) == symbol_id(symbol))
+    return(local_value(symbol)); /* this has to follow the rootlet check(?) */
+
+  if (is_keyword(symbol))
+    symbol = keyword_symbol(symbol);
+  if (let == sc->rootlet)
+    return((is_slot(global_slot(symbol))) ? global_value(symbol) : sc->undefined);
+
+  for (s7_pointer x = let; x; x = let_outlet(x))
+    for (s7_pointer y = let_slots(x); tis_slot(y); y = next_slot(y))
+      if (slot_symbol(y) == symbol)
+	return(slot_value(y));
+
+  if (is_openlet(let))
+    {
+      /* If a let is a mock-hash-table (for example), implicit indexing of the hash-table collides with the same thing for the let (field names
+       *   versus keys), and we can't just try again here because that makes it too easy to get into infinite recursion.  So, 'let-ref-fallback...
+       */
+      if (has_let_ref_fallback(let))
+	return(call_let_ref_fallback(sc, let, symbol));
+    }
+  return((is_slot(global_slot(symbol))) ? global_value(symbol) : sc->undefined); /* (let () ((curlet) 'pi)) */
+}
+
+s7_pointer s7_let_ref(s7_scheme *sc, s7_pointer let, s7_pointer symbol) {return(let_ref(sc, let, symbol));}
+
+static s7_pointer g_let_ref(s7_scheme *sc, s7_pointer args)
+{
+  #define H_let_ref "(let-ref let sym) returns the value of the symbol sym in the let"
+  #define Q_let_ref s7_make_signature(sc, 3, sc->T, sc->is_let_symbol, sc->is_symbol_symbol)
+  if (!is_pair(cdr(args)))
+    error_nr(sc, sc->syntax_error_symbol,
+	     set_elist_2(sc, wrap_string(sc, "let-ref: symbol missing: ~S", 27), set_ulist_1(sc, sc->let_ref_symbol, args)));
+  return(let_ref(sc, car(args), cadr(args)));
+}
+
+static s7_pointer slot_in_let(s7_scheme *sc, s7_pointer e, const s7_pointer sym)
+{
+  for (s7_pointer y = let_slots(e); tis_slot(y); y = next_slot(y))
+    if (slot_symbol(y) == sym)
+      return(y);
+  return(sc->undefined);
+}
+
+static s7_pointer let_ref_p_pp(s7_scheme *sc, s7_pointer lt, s7_pointer sym)
+{
+  if (let_id(lt) == symbol_id(sym))
+    return(local_value(sym)); /* see add in tlet! */
+  if (lt == sc->rootlet) /* op_implicit_let_ref_c can pass rootlet */
+    return((is_slot(global_slot(sym))) ? global_value(sym) : sc->undefined);
+  for (s7_pointer x = lt; x; x = let_outlet(x))
+    for (s7_pointer y = let_slots(x); tis_slot(y); y = next_slot(y))
+      if (slot_symbol(y) == sym)
+	return(slot_value(y));
+  if ((lt != sc->nil) && (has_let_ref_fallback(lt)))
+    return(call_let_ref_fallback(sc, lt, sym));
+  return((is_slot(global_slot(sym))) ? global_value(sym) : sc->undefined);
+}
+
+static inline s7_pointer g_simple_let_ref(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer lt = car(args), sym = cadr(args);
+  if (!is_let(lt))
+    wrong_type_error_nr(sc, sc->let_ref_symbol, 1, lt, a_let_string);
+  if (let_id(lt) == symbol_id(sym))
+    return(local_value(sym));
+  if (lt == sc->rootlet)
+    return((is_slot(global_slot(sym))) ? global_value(sym) : sc->undefined);
+  for (s7_pointer y = let_slots(lt); tis_slot(y); y = next_slot(y))
+    if (slot_symbol(y) == sym)
+      return(slot_value(y));
+  return(let_ref_p_pp(sc, let_outlet(lt), sym));
+}
+
+static s7_pointer g_rootlet_ref(s7_scheme *sc, s7_pointer args) {return(global_value(cadr(args)));}
+static s7_pointer g_unlet_ref(s7_scheme *sc, s7_pointer args) {return(initial_value(cadr(args)));}
+
+static s7_pointer let_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t unused_args, s7_pointer expr)
+{
+  s7_pointer arg1 = cadr(expr), arg2 = caddr(expr);
+  if ((is_pair(arg1)) && (is_quoted_symbol(arg2)) && (!is_keyword(cadr(arg2))))
+    {
+      if ((optimize_op(expr) == HOP_SAFE_C_opSq_C) && (car(arg1) == sc->cdr_symbol))
+	{
+	  set_opt3_sym(cdr(expr), cadr(arg2));
+	  return(sc->simple_let_ref);
+	}
+      if (car(arg1) == sc->rootlet_symbol) return(sc->rootlet_ref);
+      if (car(arg1) == sc->unlet_symbol)
+	{
+	  set_c_function(arg1, sc->unlet_disabled);
+	  return(sc->unlet_ref);
+	}
+    }
+  return(f);
+}
+
+static bool op_implicit_let_ref_c(s7_scheme *sc)
+{
+  s7_pointer let = lookup_checked(sc, car(sc->code));
+  if (!is_let(let)) {sc->last_function = let; return(false);}
+  sc->value = let_ref_p_pp(sc, let, opt3_con(sc->code));
+  return(true);
+}
+
+static bool op_implicit_let_ref_a(s7_scheme *sc)
+{
+  s7_pointer sym, let = lookup_checked(sc, car(sc->code));
+  if (!is_let(let)) {sc->last_function = let; return(false);}
+  sym = fx_call(sc, cdr(sc->code));
+  if (is_symbol(sym))
+    sc->value = let_ref_p_pp(sc, let, (is_keyword(sym)) ? keyword_symbol(sym) : sym);
+  else sc->value = let_ref(sc, let, sym);
+  return(true);
+}
+
+static s7_pointer fx_implicit_let_ref_c(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer let = lookup_checked(sc, car(arg)); /* the let */
+  if (!is_let(let))
+    return(s7_apply_function(sc, let, list_1(sc, opt3_con(arg))));
+  return(let_ref_p_pp(sc, let, opt3_con(arg)));
+}
+
+
+/* -------------------------------- let-set! -------------------------------- */
+static s7_pointer let_set_1(s7_scheme *sc, s7_pointer let, s7_pointer symbol, s7_pointer value)
+{
+  if (is_keyword(symbol))
+    symbol = keyword_symbol(symbol);
+
+  if (let == sc->rootlet)
+    {
+      s7_pointer slot;
+      if (is_constant_symbol(sc, symbol))  /* (let-set! (rootlet) 'pi #f) */
+	wrong_type_error_nr(sc, sc->let_set_symbol, 2, symbol, a_non_constant_symbol_string);
+      /* it would be nice if safety>0 to add an error check for bad arity if a built-in method is set (set! (lt 'write) hash-table-set!),
+       *   built_in being (initial_value(sym) != sc->undefined), but this function is called a ton, and this error can't easily be
+       *   checked by the optimizer (we see the names, but not the values, so bad arity check requires assumptions about those values).
+       */
+      slot = global_slot(symbol);
+      if (!is_slot(slot))
+	error_nr(sc, sc->wrong_type_arg_symbol,
+		 set_elist_3(sc, wrap_string(sc, "let-set!: ~A is not defined in ~A", 33), symbol, let));
+      if (is_syntax(slot_value(slot)))
+	wrong_type_error_nr(sc, sc->let_set_symbol, 2, symbol, wrap_string(sc, "a non-syntactic symbol", 22));
+      if (is_immutable(slot))
+	immutable_object_error_nr(sc, set_elist_2(sc, wrap_string(sc, "~S is immutable in (rootlet)", 28), symbol)); /* also (set! (with-let...)...) */
+      symbol_increment_ctr(symbol);
+      slot_set_value(slot, (slot_has_setter(slot)) ? call_setter(sc, slot, value) : value);
+      return(slot_value(slot));
+    }
+  if (is_unlet(let))
+    immutable_object_error_nr(sc, set_elist_2(sc, wrap_string(sc, "~S is immutable in (unlet)", 26), symbol));
+  if (let_id(let) == symbol_id(symbol))
+   {
+     s7_pointer slot = local_slot(symbol);
+     if (is_slot(slot))
+       {
+	 symbol_increment_ctr(symbol);
+	 return(checked_slot_set_value(sc, slot, value));
+       }}
+  for (s7_pointer x = let; x; x = let_outlet(x))
+    for (s7_pointer y = let_slots(x); tis_slot(y); y = next_slot(y))
+      if (slot_symbol(y) == symbol)
+	{
+	  symbol_increment_ctr(symbol);
+	  return(checked_slot_set_value(sc, y, value));
+	}
+
+  if (!has_let_set_fallback(let))
+    error_nr(sc, sc->wrong_type_arg_symbol,
+	     set_elist_3(sc, wrap_string(sc, "let-set!: ~A is not defined in ~A", 33), symbol, let));
+  /* not sure about this -- what's the most useful choice? */
+  return(call_let_set_fallback(sc, let, symbol, value));
+}
+
+static s7_pointer let_set_2(s7_scheme *sc, s7_pointer let, s7_pointer symbol, s7_pointer value)
+{
+  if (!is_let(let))
+    wrong_type_error_nr(sc, sc->let_set_symbol, 1, let, a_let_string);
+  if (!is_symbol(symbol))
+    {
+      if ((let != sc->rootlet) && (has_let_set_fallback(let)))
+	return(call_let_set_fallback(sc, let, symbol, value));
+      wrong_type_error_nr(sc, sc->let_set_symbol, 2, symbol, a_symbol_string);
+    }
+  /* currently let-set! is immutable, so we don't have to check for a let-set! method (so let_set! is always global) */
+  return(let_set_1(sc, let, symbol, value));
+}
+
+s7_pointer s7_let_set(s7_scheme *sc, s7_pointer let, s7_pointer symbol, s7_pointer value) {return(let_set_2(sc, let, symbol, value));}
+
+static s7_pointer g_let_set(s7_scheme *sc, s7_pointer args)
+{
+  /* (let ((a 1)) (set! ((curlet) 'a) 32) a) */
+  #define H_let_set "(let-set! let sym val) sets the symbol sym's value in the let to val"
+  #define Q_let_set s7_make_signature(sc, 4, sc->T, sc->is_let_symbol, sc->is_symbol_symbol, sc->T)
+
+  if (!is_pair(cdr(args))) /* (let ((a 123.0)) (define (f) (set! (let-ref) a)) (catch #t f (lambda args #f)) (f)) */
+    error_nr(sc, sc->wrong_number_of_args_symbol,
+	     set_elist_3(sc, wrap_string(sc, "~S: not enough arguments: ~S", 28), sc->let_set_symbol, sc->code));
+
+  return(let_set_2(sc, car(args), cadr(args), caddr(args)));
+}
+
+static s7_pointer let_set_p_ppp_2(s7_scheme *sc, s7_pointer p1, s7_pointer p2, s7_pointer p3)
+{
+  if (!is_symbol(p2))
+    wrong_type_error_nr(sc, sc->let_set_symbol, 2, p2, a_symbol_string);
+  return(let_set_1(sc, p1, p2, p3));
+}
+
+static s7_pointer g_simple_let_set(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer y, lt = car(args), sym = cadr(args), val = caddr(args);
+
+  if (!is_let(lt))
+    wrong_type_error_nr(sc, sc->let_set_symbol, 1, lt, a_let_string);
+  if (lt != sc->rootlet)
+    {
+      for (s7_pointer x = lt; x; x = let_outlet(x))
+	for (y = let_slots(x); tis_slot(y); y = next_slot(y))
+	  if (slot_symbol(y) == sym)
+	    {
+	      slot_set_value(y, (slot_has_setter(y)) ? call_setter(sc, y, val) : val);
+	      return(slot_value(y));
+	    }
+      if ((lt != sc->rootlet) && (has_let_set_fallback(lt)))
+	return(call_let_set_fallback(sc, lt, sym, val));
+    }
+  y = global_slot(sym);
+  if (!is_slot(y))
+    error_nr(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, wrap_string(sc, "let-set!: ~A is not defined in ~A", 33), sym, lt));
+  slot_set_value(y, (slot_has_setter(y)) ? call_setter(sc, y, val) : val);
+  return(slot_value(y));
+}
+
+static s7_pointer g_unlet_set(s7_scheme *sc, s7_pointer args)
+{
+  immutable_object_error_nr(sc, set_elist_2(sc, wrap_string(sc, "~S is immutable in (unlet)", 26), cadr(args)));
+  return(sc->F);
+}
+
+static s7_pointer let_set_chooser(s7_scheme *sc, s7_pointer f, int32_t unused_args, s7_pointer expr)
+{
+  if (optimize_op(expr) == HOP_SAFE_C_opSq_CS)
+    {
+      s7_pointer arg1 = cadr(expr), arg2 = caddr(expr), arg3 = cadddr(expr);
+      if ((car(arg1) == sc->cdr_symbol) &&
+	  (is_quoted_pair(arg2)) &&
+	  (!is_possibly_constant(cadr(arg2))) &&
+	  (!is_possibly_constant(arg3)))
+	return(sc->simple_let_set);
+      if (car(arg1) == sc->unlet_symbol)
+	{
+	  set_c_function(arg1, sc->unlet_disabled);
+	  return(sc->unlet_set);
+	}
+    }
+  return(f);
+}
+
+
+static s7_pointer reverse_slots(s7_pointer list)
+{
+  s7_pointer p = list, result = slot_end;
+  while (tis_slot(p))
+    {
+      s7_pointer q = next_slot(p);
+      slot_set_next(p, result);
+      result = p;
+      p = q;
+    }
+  return(result);
+}
+
+static s7_pointer let_copy(s7_scheme *sc, s7_pointer let)
+{
+  s7_pointer new_e;
+
+  if (T_Let(let) == sc->rootlet)   /* (copy (rootlet)) or (copy (funclet abs)) etc */
+    return(sc->rootlet);
+  /* we can't make copy handle lets-as-objects specially because the make-object function in define-class uses copy to make a new object!
+   *   So if it is present, we get it here, and then there's almost surely trouble.
+   */
+  new_e = make_let(sc, let_outlet(let));
+  set_all_methods(new_e, let);
+  sc->temp3 = new_e;
+  if (tis_slot(let_slots(let)))
+    {
+      s7_int id = let_id(new_e);
+      s7_pointer y = NULL;
+      for (s7_pointer x = let_slots(let); tis_slot(x); x = next_slot(x))
+	{
+	  s7_pointer z;
+	  new_cell(sc, z, T_SLOT);
+	  slot_set_symbol_and_value(z, slot_symbol(x), slot_value(x));
+	  if (symbol_id(slot_symbol(z)) != id) /* keep shadowing intact */
+	    symbol_set_local_slot(slot_symbol(x), id, z);
+	  if (slot_has_setter(x))
+	    {
+	      slot_set_setter(z, slot_setter(x));
+	      slot_set_has_setter(z);
+	    }
+	  if (y)
+	    slot_set_next(y, z);
+	  else let_set_slots(new_e, z);
+	  slot_set_next(z, slot_end);          /* in case GC runs during this loop */
+	  y = z;
+	}}
+  /* We can't do a (normal) loop here then reverse the slots later because the symbol's local_slot has to
+   *    match the unshadowed slot, not the last in the list:
+   *    (let ((e1 (inlet 'a 1 'a 2))) (let ((e2 (copy e1))) (list (equal? e1 e2) (equal? (e1 'a) (e2 'a)))))
+   */
+  sc->temp3 = sc->unused;
+  return(new_e);
+}
+
+
+/* -------------------------------- rootlet -------------------------------- */
+static s7_pointer g_rootlet(s7_scheme *sc, s7_pointer unused)
+{
+  #define H_rootlet "(rootlet) returns the current top-level definitions (symbol bindings)."
+  #define Q_rootlet s7_make_signature(sc, 1, sc->is_let_symbol)
+  return(sc->rootlet);
+}
+/* as with the symbol-table, this function can lead to disaster -- user could
+ *   clobber the let etc.  But we want it to be editable and augmentable,
+ *   so I guess I'll leave it alone.  (See curlet|funclet as well).
+ */
+
+s7_pointer s7_rootlet(s7_scheme *sc) {return(sc->rootlet);}
+
+/* shadow_rootlet is a convenience for foreign function writers -- the C code can act as if it were loading everything into rootlet,
+ *   but when actually loaded, everything can be shunted into a separate namespace (*motif* for example).
+ */
+s7_pointer s7_shadow_rootlet(s7_scheme *sc) {return(sc->shadow_rootlet);}
+
+s7_pointer s7_set_shadow_rootlet(s7_scheme *sc, s7_pointer let)
+{
+  s7_pointer old_let = sc->shadow_rootlet;
+  sc->shadow_rootlet = let;
+  return(old_let); /* like s7_set_curlet below */
+}
+
+
+/* -------------------------------- curlet -------------------------------- */
+s7_pointer s7_curlet(s7_scheme *sc) /* see also fx_curlet */
+{
+  sc->capture_let_counter++;
+  return(sc->curlet);
+}
+
+static s7_pointer g_curlet(s7_scheme *sc, s7_pointer unused_args)
+{
+  #define H_curlet "(curlet) returns the current definitions (symbol bindings)"
+  #define Q_curlet s7_make_signature(sc, 1, sc->is_let_symbol)
+  sc->capture_let_counter++;
+  return(sc->curlet);
+}
+
+static void update_symbol_ids(s7_scheme *sc, s7_pointer e)
+{
+  for (s7_pointer p = let_slots(e); tis_slot(p); p = next_slot(p))
+    {
+      s7_pointer sym = slot_symbol(p);
+      if (symbol_id(sym) != sc->let_number)
+	symbol_set_local_slot_unincremented(sym, sc->let_number, p);
+    }
+}
+
+s7_pointer s7_set_curlet(s7_scheme *sc, s7_pointer e)
+{
+  s7_pointer old_e = sc->curlet;
+  set_curlet(sc, e);
+  if ((is_let(e)) && (let_id(e) > 0))
+    {
+      let_set_id(e, ++sc->let_number);
+      update_symbol_ids(sc, e);
+    }
+  return(old_e);
+}
+
+
+/* -------------------------------- outlet -------------------------------- */
+s7_pointer s7_outlet(s7_scheme *sc, s7_pointer let) {return(let_outlet(let));}
+
+static s7_pointer outlet_p_p(s7_scheme *sc, s7_pointer let)
+{
+  if (!is_let(let))
+    sole_arg_wrong_type_error_nr(sc, sc->outlet_symbol, let, a_let_string); /* not a method call here! */
+  return((let == sc->rootlet) ? sc->rootlet : let_outlet(let)); /* rootlet check is needed(!) */
+}
+
+static s7_pointer g_unlet_disabled(s7_scheme *sc, s7_pointer args) {return(sc->F);}
+static s7_pointer g_outlet_unlet(s7_scheme *sc, s7_pointer args) {return(sc->curlet);}
+
+static s7_pointer g_outlet(s7_scheme *sc, s7_pointer args)
+{
+  #define H_outlet "(outlet let) is the environment that contains let."
+  #define Q_outlet s7_make_signature(sc, 2, sc->is_let_symbol, sc->is_let_symbol)
+  return(outlet_p_p(sc, car(args)));
+}
+
+static s7_pointer outlet_chooser(s7_scheme *sc, s7_pointer f, int32_t num_args, s7_pointer expr)
+{
+  if ((num_args == 1) && (is_pair(cadr(expr))) && (caadr(expr) == sc->unlet_symbol))
+    {
+      set_c_function(cadr(expr), sc->unlet_disabled);
+      return(sc->outlet_unlet);
+    }
+  return(f);
+}
+
+static s7_pointer g_set_outlet(s7_scheme *sc, s7_pointer args)
+{
+  /* (let ((a 1)) (let ((b 2)) (set! (outlet (curlet)) (rootlet)) ((curlet) 'a))) */
+  s7_pointer let = car(args), new_outer;
+
+  if (!is_let(let))
+    wrong_type_error_nr(sc, wrap_string(sc, "set! outlet", 11), 1, let, sc->type_names[T_LET]);
+  if (let == sc->s7_starlet)
+    error_nr(sc, sc->out_of_range_symbol, set_elist_1(sc, wrap_string(sc, "can't set! (outlet *s7*)", 24)));
+  if (is_immutable_let(let))
+    immutable_object_error_nr(sc, set_elist_4(sc, wrap_string(sc, "can't (set! (outlet ~S) ~S), ~S is immutable", 44), let, cadr(args), let));
+  new_outer = cadr(args);
+  if (!is_let(new_outer))
+    wrong_type_error_nr(sc, wrap_string(sc, "set! outlet", 11), 2, new_outer, sc->type_names[T_LET]);
+  if (let != sc->rootlet)
+    {
+      /* here it's possible to get cyclic let chains; maybe do this check only if safety>0 */
+      for (s7_pointer lt = new_outer; lt; lt = let_outlet(lt))
+	if (let == lt)
+	  error_nr(sc, make_symbol(sc, "cyclic-let", 10),
+		   set_elist_2(sc, wrap_string(sc, "set! (outlet ~A) creates a cyclic let chain", 43), let));
+      let_set_outlet(let, new_outer);
+    }
+  return(new_outer);
+}
+
+/* -------------------------------- symbol lookup -------------------------------- */
+static Inline s7_pointer inline_lookup_from(s7_scheme *sc, const s7_pointer symbol, s7_pointer e)
+{ /* splitting out the no-sc WITH_GCC case made no difference in speed, same if using s7_int id = symbol_id(symbol) */
+  if (let_id(e) == symbol_id(symbol))
+    return(local_value(symbol));
+  if (let_id(e) > symbol_id(symbol)) /* let is newer so look back in the outlet chain */
+    {
+      do {e = let_outlet(e);} while (let_id(e) > symbol_id(symbol));
+      if (let_id(e) == symbol_id(symbol))
+	return(local_value(symbol));
+    }
+  for (; e; e = let_outlet(e))
+    for (s7_pointer y = let_slots(e); tis_slot(y); y = next_slot(y))
+      if (slot_symbol(y) == symbol)
+	return(slot_value(y));
+
+  if (is_slot(global_slot(symbol)))
+    return(global_value(symbol));
+#if WITH_GCC
+  return(NULL); /* much faster than various alternatives */
+#else
+  return(unbound_variable(sc, symbol)); /* only use of sc */
+#endif
+}
+
+#if WITH_GCC && S7_DEBUGGING
+static s7_pointer lookup_1(s7_scheme *sc, const s7_pointer symbol)
+#else
+static inline s7_pointer lookup(s7_scheme *sc, const s7_pointer symbol) /* lookup_checked includes the unbound_variable call */
+#endif
+{
+  return(inline_lookup_from(sc, symbol, sc->curlet));
+}
+
+static inline s7_pointer lookup_slot_from(s7_pointer symbol, s7_pointer e)
+{
+  if (let_id(e) == symbol_id(symbol))
+    return(local_slot(symbol));
+  if (let_id(e) > symbol_id(symbol))
+    {
+      do {e = let_outlet(e);} while (let_id(e) > symbol_id(symbol));
+      if (let_id(e) == symbol_id(symbol))
+	return(local_slot(symbol));
+    }
+  for (; e; e = let_outlet(e))
+    for (s7_pointer y = let_slots(e); tis_slot(y); y = next_slot(y))
+      if (slot_symbol(y) == symbol)
+	return(y);
+  return(global_slot(symbol));
+}
+
+s7_pointer s7_slot(s7_scheme *sc, s7_pointer symbol) {return(lookup_slot_from(symbol, sc->curlet));}
+static s7_pointer lookup_slot_with_let(s7_scheme *sc, s7_pointer symbol, s7_pointer let) {return(lookup_slot_from(symbol, let));}
+
+s7_pointer s7_slot_value(s7_pointer slot) {return(slot_value(slot));}
+
+s7_pointer s7_slot_set_value(s7_scheme *sc, s7_pointer slot, s7_pointer value) {slot_set_value(slot, value); return(value);}
+
+void s7_slot_set_real_value(s7_scheme *sc, s7_pointer slot, s7_double value) {set_real(slot_value(slot), value);}
+
+static s7_pointer symbol_to_local_slot(s7_scheme *sc, s7_pointer symbol, s7_pointer e)
+{
+  if ((!is_let(e)) || (e == sc->rootlet)) /* e is () if from s7_define */
+    return(global_slot(symbol));
+  if (symbol_id(symbol) != 0)
+    for (s7_pointer y = let_slots(e); tis_slot(y); y = next_slot(y))
+      if (slot_symbol(y) == symbol)
+	return(y);
+  return(sc->undefined);
+}
+
+s7_pointer s7_symbol_value(s7_scheme *sc, s7_pointer sym)
+{
+  s7_pointer x = s7_slot(sc, sym);
+  return((is_slot(x)) ? slot_value(x) : sc->undefined);
+}
+
+s7_pointer s7_symbol_local_value(s7_scheme *sc, s7_pointer sym, s7_pointer let)
+{
+  if (let_id(let) == symbol_id(sym))
+    return(local_value(sym));
+  if (let_id(let) > symbol_id(sym))
+    {
+      do {let = let_outlet(let);} while (let_id(let) > symbol_id(sym));
+      if (let_id(let) == symbol_id(sym))
+	return(local_value(sym));
+    }
+  for (; let; let = let_outlet(let))
+    for (s7_pointer y = let_slots(let); tis_slot(y); y = next_slot(y))
+      if (slot_symbol(y) == sym)
+	return(slot_value(y));
+
+  /* maybe let is local but sym is global but previously shadowed */
+  if (is_slot(global_slot(sym)))
+    return(global_value(sym));
+
+  /* (let ((e (curlet))) (let ((a 1)) (symbol->value 'a e))) -> #<undefined> not 1 */
+  return(sc->undefined); /* 29-Nov-17 */
+}
+
+
+/* -------------------------------- symbol->value -------------------------------- */
+#define lookup_global(Sc, Sym) ((is_global(Sym)) ? global_value(Sym) : lookup_checked(Sc, Sym))
+
+static s7_pointer s7_starlet(s7_scheme *sc, s7_int choice);
+
+static s7_pointer g_symbol_to_value(s7_scheme *sc, s7_pointer args)
+{
+  #define H_symbol_to_value "(symbol->value sym (let (curlet))) returns the binding of (the value associated with) the \
+symbol sym in the given let: (let ((x 32)) (symbol->value 'x)) -> 32"
+  #define Q_symbol_to_value s7_make_signature(sc, 3, sc->T, sc->is_symbol_symbol, \
+            s7_make_signature(sc, 6, sc->is_let_symbol, sc->is_procedure_symbol, sc->is_c_pointer_symbol, \
+                                     sc->is_continuation_symbol, sc->is_goto_symbol, sc->is_macro_symbol)) /* kinda ridiculous */
+  /* (symbol->value 'x e) => (e 'x).  But let? in sig is not quite right -- we accept closure -> closure-let etc */
+
+  s7_pointer sym = car(args);
+  if (!is_symbol(sym))
+    return(method_or_bust(sc, sym, sc->symbol_to_value_symbol, args, sc->type_names[T_SYMBOL], 1));
+  if (is_keyword(sym))
+    {
+      if ((is_pair(cdr(args))) && (!is_let(cadr(args))) && (!is_let(find_let(sc, cadr(args)))))
+	wrong_type_error_nr(sc, sc->symbol_to_value_symbol, 2, cadr(args), sc->type_names[T_LET]);
+      return(sym);
+    }
+  if (is_not_null(cdr(args)))
+    {
+      s7_pointer local_let = cadr(args);
+      if (!is_let(local_let))
+	{
+	  local_let = find_let(sc, local_let);
+	  if (!is_let(local_let))
+	    return(method_or_bust(sc, cadr(args), sc->symbol_to_value_symbol, args, a_let_string, 2)); /* not local_let */
+	}
+      if (local_let == sc->rootlet) return((is_slot(global_slot(sym))) ? global_value(sym) : sc->undefined);
+      if (is_unlet(local_let)) return(initial_value(sym));
+      if (local_let == sc->s7_starlet) return(s7_starlet(sc, s7_starlet_symbol_id(sym)));
+      return(s7_symbol_local_value(sc, sym, local_let));
+    }
+  if (is_global(sym))
+    return(global_value(sym));
+  return(s7_symbol_value(sc, sym));
+}
+
+s7_pointer s7_symbol_set_value(s7_scheme *sc, s7_pointer sym, s7_pointer val)
+{
+  s7_pointer x = s7_slot(sc, sym);   /* if immutable should this return an error? */
+  if (is_slot(x))
+    slot_set_value(x, val); /* with_hook? */
+  return(val);
+}
+
+static s7_pointer g_sv_unlet_ref(s7_scheme *sc, s7_pointer args) {return(initial_value(car(args)));}
+
+static s7_pointer symbol_to_value_chooser(s7_scheme *sc, s7_pointer f, int32_t unused_args, s7_pointer expr)
+{
+  s7_pointer arg1 = cadr(expr), arg2 = (is_pair(cddr(expr))) ? caddr(expr) : sc->F;
+  if ((is_quoted_symbol(arg1)) && (!is_keyword(cadr(arg1))) && (is_pair(arg2)) && (car(arg2) == sc->unlet_symbol)) /* old-style (obsolete) unlet as third arg(!) */
+    {
+      set_c_function(arg2, sc->unlet_disabled);
+      return(sc->sv_unlet_ref);
+    }
+  return(f);
+}
+
+
+/* -------------------------------- symbol->dynamic-value -------------------------------- */
+static s7_pointer find_dynamic_value(s7_scheme *sc, s7_pointer x, s7_pointer sym, int64_t *id)
+{
+  for (; let_id(x) > symbol_id(sym); x = let_outlet(x));
+  if (let_id(x) == symbol_id(sym))
+    {
+      (*id) = let_id(x);
+      return(local_value(sym));
+    }
+  for (; (x) && (let_id(x) > (*id)); x = let_outlet(x))
+    for (s7_pointer y = let_slots(x); tis_slot(y); y = next_slot(y))
+      if (slot_symbol(y) == sym)
+	{
+	  (*id) = let_id(x);
+	  return(slot_value(y));
+	}
+  return(sc->unused);
+}
+
+static s7_pointer g_symbol_to_dynamic_value(s7_scheme *sc, s7_pointer args)
+{
+  #define H_symbol_to_dynamic_value "(symbol->dynamic-value sym) returns the dynamic binding of the symbol sym"
+  #define Q_symbol_to_dynamic_value s7_make_signature(sc, 2, sc->T, sc->is_symbol_symbol)
+
+  s7_pointer sym = car(args), val;
+  int64_t top_id = -1;
+
+  if (!is_symbol(sym))
+    return(method_or_bust(sc, sym, sc->symbol_to_dynamic_value_symbol, args, sc->type_names[T_SYMBOL], 1));
+
+  if (is_global(sym))
+    return(global_value(sym));
+
+  if (let_id(sc->curlet) == symbol_id(sym))
+    return(local_value(sym));
+
+  val = find_dynamic_value(sc, sc->curlet, sym, &top_id);
+  if (top_id == symbol_id(sym))
+    return(val);
+
+  for (int64_t i = stack_top(sc) - 1; i > 0; i -= 4)
+    if (is_let_unchecked(stack_let(sc->stack, i))) /* OP_GC_PROTECT let slot can be anything (even free) */
+      {
+	s7_pointer cur_val = find_dynamic_value(sc, stack_let(sc->stack, i), sym, &top_id);
+	if (cur_val != sc->unused)
+	  val = cur_val;
+	if (top_id == symbol_id(sym))
+	  return(val);
+      }
+  return((val == sc->unused) ? s7_symbol_value(sc, sym) : val);
+}
+
+static bool direct_memq(const s7_pointer symbol, s7_pointer symbols)
+{
+  for (s7_pointer x = symbols; is_pair(x); x = cdr(x))
+    if (car(x) == symbol)
+	return(true);
+  return(false);
+}
+
+static bool direct_assq(const s7_pointer symbol, s7_pointer symbols)
+{ /* used only below in do_symbol_is_safe */
+  for (s7_pointer x = symbols; is_pair(x); x = cdr(x))
+    if (caar(x) == symbol)
+      return(true);
+  return(false);
+}
+
+static bool do_symbol_is_safe(s7_scheme *sc, s7_pointer sym, s7_pointer e)
+{
+  return((is_slot(global_slot(sym))) ||
+	 (direct_assq(sym, e)) ||
+	 (is_slot(s7_slot(sc, sym))));
+}
+
+static bool let_symbol_is_safe(s7_scheme *sc, s7_pointer sym, s7_pointer e)
+{
+  if (is_slot(global_slot(sym)))
+    return(true);
+  if (e == sc->rootlet)
+    return(false);
+  return((!is_with_let_let(e)) && (is_slot(s7_slot(sc, sym))));
+}
+
+static bool let_symbol_is_safe_or_listed(s7_scheme *sc, s7_pointer sym, s7_pointer e)
+{
+  return((symbol_is_in_list(sc, sym)) ||
+	 (let_symbol_is_safe(sc, sym, e)));
+}
+
+static bool let_star_symbol_is_safe(s7_scheme *sc, s7_pointer sym, s7_pointer e)
+{
+  return((symbol_is_in_list(sc, sym)) ||
+	 (is_slot(global_slot(sym))) ||
+	 ((is_let(e)) && (!is_with_let_let(e)) && (is_slot(s7_slot(sc, sym)))));
+}
+
+static bool pair_symbol_is_safe(s7_scheme *unused_sc, s7_pointer sym, s7_pointer e)
+{
+  return((is_slot(global_slot(sym))) ||
+	 (direct_memq(sym, e)));
+}
+
+static s7_pointer collect_variables(s7_scheme *sc, s7_pointer lst, s7_pointer e)
+{
+  /* collect local variable names from let/do (pre-error-check), 20 overhead in tgen -> 14 if cons_unchecked below */
+  sc->w = e;
+  for (s7_pointer p = lst; is_pair(p); p = cdr(p))
+    sc->w = cons(sc, add_symbol_to_list(sc, caar(p)), sc->w);
+  return(sc->w);
+}
+
+static s7_pointer collect_parameters(s7_scheme *sc, s7_pointer lst, s7_pointer e)
+{
+  /* collect local variable names from lambda arglists (pre-error-check) */
+  s7_pointer p;
+  s7_int the_un_id = ++sc->let_number;
+  if (is_symbol(lst))
+    {
+      symbol_set_id(lst, the_un_id);
+      return(cons(sc, add_symbol_to_list(sc, lst), e));
+    }
+  sc->w = e;
+  for (p = lst; is_pair(p); p = cdr(p))
+    {
+      s7_pointer car_p = car(p);
+      if (is_pair(car_p))
+	car_p = car(car_p);
+      if (is_normal_symbol(car_p))
+	{
+	  symbol_set_id(car_p, the_un_id);
+	  sc->w = cons(sc, add_symbol_to_list(sc, car_p), sc->w);
+	}}
+  if (is_symbol(p)) /* rest arg */
+    {
+      symbol_set_id(p, the_un_id);
+      sc->w = cons(sc, add_symbol_to_list(sc, p), sc->w);
+    }
+  return(sc->w);
+}
+
+typedef enum {OPT_F, OPT_T, OPT_OOPS} opt_t;
+static opt_t optimize(s7_scheme *sc, s7_pointer code, int32_t hop, s7_pointer e);
+
+static void clear_all_optimizations(s7_scheme *sc, s7_pointer p)
+{
+  /* I believe that we would not have been optimized to begin with if the tree were circular,
+   *   and this tree is supposed to be a function call + args -- a circular list here is a bug.
+   */
+  if (is_pair(p))
+    {
+      if ((is_optimized(p)) &&
+ 	  (((optimize_op(p) >= FIRST_UNHOPPABLE_OP) ||  /* avoid clearing hop ops, fx_function and op_unknown* need to be cleared */
+	    (!op_has_hop(p)))))
+	{
+	  clear_optimized(p);     /* includes T_SYNTACTIC */
+	  clear_optimize_op(p);
+	}
+      clear_all_optimizations(sc, cdr(p));
+      clear_all_optimizations(sc, car(p));
+    }
+}
+
+static s7_pointer add_trace(s7_scheme *sc, s7_pointer code)
+{
+  if ((is_pair(car(code))) && (caar(code) == sc->trace_in_symbol))
+    return(code);
+  return(cons_unchecked(sc, list_2(sc, sc->trace_in_symbol, list_1(sc, sc->curlet_symbol)), code));
+}
+
+static s7_pointer add_profile(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer p;
+  if ((is_pair(car(code))) && (caar(code) == sc->profile_in_symbol))
+    return(code);
+  p = cons_unchecked(sc, list_3(sc, sc->profile_in_symbol, make_integer_unchecked(sc, sc->profile_position), list_1(sc, sc->curlet_symbol)), code);
+  sc->profile_position++;
+  set_unsafe_optimize_op(car(p), OP_PROFILE_IN);
+  return(p);
+}
+
+static bool tree_has_definers(s7_scheme *sc, s7_pointer tree)
+{
+  for (s7_pointer p = tree; is_pair(p); p = cdr(p))
+    if (tree_has_definers(sc, car(p)))
+      return(true);
+  return((is_symbol(tree)) && (is_definer(tree)));
+}
+
+static s7_pointer cur_op_to_caller(s7_scheme *sc, opcode_t op)
+{
+  switch (op)
+    {
+    case OP_DEFINE_MACRO:          return(sc->define_macro_symbol);
+    case OP_DEFINE_MACRO_STAR:     return(sc->define_macro_star_symbol);
+    case OP_DEFINE_BACRO:          return(sc->define_bacro_symbol);
+    case OP_DEFINE_BACRO_STAR:     return(sc->define_bacro_star_symbol);
+    case OP_DEFINE_EXPANSION:      return(sc->define_expansion_symbol);
+    case OP_DEFINE_EXPANSION_STAR: return(sc->define_expansion_star_symbol);
+    case OP_MACRO:                 return(sc->macro_symbol);
+    case OP_MACRO_STAR:            return(sc->macro_star_symbol);
+    case OP_BACRO:                 return(sc->bacro_symbol);
+    case OP_BACRO_STAR:            return(sc->bacro_star_symbol);
+    }
+  if (S7_DEBUGGING) fprintf(stderr, "%s[%d]: %s?\n", __func__, __LINE__, op_names[op]);
+  return(NULL);
+}
+
+static s7_pointer make_macro(s7_scheme *sc, opcode_t op, bool named)
+{
+  s7_pointer mac, body, mac_name = NULL;
+  uint64_t typ;
+  if (SHOW_EVAL_OPS) fprintf(stderr, "  %s[%d]: %s\n", __func__, __LINE__, display_truncated(sc->code));
+  switch (op)
+    {
+    case OP_DEFINE_MACRO:      case OP_MACRO:      typ = T_MACRO;      break;
+    case OP_DEFINE_MACRO_STAR: case OP_MACRO_STAR: typ = T_MACRO_STAR; break;
+    case OP_DEFINE_BACRO:      case OP_BACRO:      typ = T_BACRO;      break;
+    case OP_DEFINE_BACRO_STAR: case OP_BACRO_STAR: typ = T_BACRO_STAR; break;
+    case OP_DEFINE_EXPANSION:      typ = T_MACRO | ((sc->curlet != sc->rootlet) ? 0 : T_EXPANSION); break; /* local expansions are just normal macros */
+    case OP_DEFINE_EXPANSION_STAR: typ = T_MACRO_STAR | ((sc->curlet != sc->rootlet) ? 0 : T_EXPANSION); break;
+    default:
+      if (S7_DEBUGGING) fprintf(stderr, "%s[%d]: got %s\n", __func__, __LINE__, op_names[op]);
+      typ = T_MACRO;
+      break;
+    }
+  new_cell(sc, mac, typ | T_DONT_EVAL_ARGS);
+  closure_set_args(mac, (named) ? cdar(sc->code) : car(sc->code));
+  body = cdr(sc->code);
+  closure_set_body(mac, body);
+  closure_set_setter(mac, sc->F);
+  closure_set_let(mac, sc->curlet);
+  closure_set_arity(mac, CLOSURE_ARITY_NOT_SET);
+  sc->capture_let_counter++;
+  gc_protect_via_stack(sc, mac);
+
+  if (named)
+    {
+      s7_pointer mac_slot;
+      mac_name = caar(sc->code);
+      if (((op == OP_DEFINE_EXPANSION) || (op == OP_DEFINE_EXPANSION_STAR)) &&
+	  (sc->curlet == sc->rootlet))
+	set_full_type(mac_name, T_EXPANSION | T_SYMBOL | (full_type(mac_name) & T_UNHEAP));
+
+      /* symbol? macro name has already been checked, find name in let, and define it */
+      mac_slot = symbol_to_local_slot(sc, mac_name, sc->curlet); /* returns global_slot(symbol) if sc->curlet == nil */
+
+      if (is_slot(mac_slot))
+	{
+	  if (is_immutable_slot(mac_slot))
+	    immutable_object_error_nr(sc, set_elist_3(sc, wrap_string(sc, "can't ~S ~S; it is immutable", 28), cur_op_to_caller(sc, op), mac_name));
+
+	  if ((sc->curlet == sc->nil) && (!in_rootlet(mac_slot)))
+	    add_slot_to_rootlet(sc, mac_slot);
+	  slot_set_value_with_hook(mac_slot, mac);
+	}
+      else s7_make_slot(sc, sc->curlet, mac_name, mac); /* was current but we've checked immutable already */
+      if (tree_has_definers(sc, body))
+	set_is_definer(mac_name);                       /* (list-values 'define ...) aux-13 */
+    }
+
+  if ((!is_either_bacro(mac)) &&
+      (optimize(sc, body, 1, collect_parameters(sc, closure_args(mac), sc->nil)) == OPT_OOPS))
+    clear_all_optimizations(sc, body);
+
+  if (sc->debug > 1) /* no profile here */
+    closure_set_body(mac, add_trace(sc, body));
+
+  unstack_gc_protect(sc);
+  if (named)
+    {
+      set_pair_macro(closure_body(mac), mac_name);
+      set_has_pair_macro(mac);
+      if (has_location(car(sc->code)))
+	{
+	  pair_set_location(closure_body(mac), pair_location(car(sc->code)));
+	  set_has_location(closure_body(mac));
+	}}
+  /* passed to maclet in apply_macro et al, copied in copy_closure */
+  return(mac);
+}
+
+static s7_pointer make_closure_unchecked(s7_scheme *sc, s7_pointer args, s7_pointer code, uint64_t type, int32_t arity)
+{
+  s7_pointer x;
+  new_cell_no_check(sc, x, (type | closure_bits(code)));
+  closure_set_args(x, args);
+  closure_set_let(x, sc->curlet);
+  closure_set_setter(x, sc->F);
+  closure_set_arity(x, arity);
+  closure_set_body(x, code);
+  if (is_pair(cdr(code))) set_closure_has_multiform(x); else set_closure_has_one_form(x);
+  sc->capture_let_counter++;
+  return(x);
+}
+
+static inline s7_pointer make_closure_gc_checked(s7_scheme *sc, s7_pointer args, s7_pointer code, uint64_t type, int32_t arity) /* inline 100=1% tgc, 35=2% texit */
+{
+  s7_pointer x;
+  new_cell(sc, x, (type | closure_bits(code)));
+  closure_set_args(x, args);
+  closure_set_let(x, sc->curlet);
+  closure_set_setter(x, sc->F);
+  closure_set_arity(x, arity);
+  closure_set_body(x, code);
+  if (is_pair(cdr(code))) set_closure_has_multiform(x); else set_closure_has_one_form(x);
+  sc->capture_let_counter++;
+  return(x);
+}
+
+static s7_pointer make_closure(s7_scheme *sc, s7_pointer args, s7_pointer code, uint64_t type, int32_t arity)
+{
+  /* this is called (almost?) every time a lambda form is evaluated, or during letrec, etc */
+  s7_pointer x;
+  new_cell(sc, x, (type | closure_bits(code)));
+  closure_set_args(x, args);
+  closure_set_let(x, sc->curlet);
+  closure_set_setter(x, sc->F);
+  closure_set_arity(x, arity);
+  closure_set_body(x, code);           /* in case add_trace triggers GC, new func (x) needs some legit body for mark_closure */
+  if (sc->debug_or_profile)
+    {
+      gc_protect_via_stack(sc, x);     /* GC protect func during add_trace */
+      closure_set_body(x, (sc->debug > 1) ? add_trace(sc, code) : add_profile(sc, code));
+      set_closure_has_multiform(x);
+      unstack_gc_protect(sc);
+    }
+  else
+    if (is_pair(cdr(code)))
+      set_closure_has_multiform(x);
+    else set_closure_has_one_form(x);
+  sc->capture_let_counter++;
+  return(x);
+}
+
+static int32_t closure_length(s7_scheme *sc, s7_pointer e)
+{
+  /* we can't use let_length(sc, closure_let(e)) because the closure_let(closure)
+   *   changes.  So the open bit is not always on.  Besides, the fallbacks need to be for closures, not lets.
+   */
+  s7_pointer length_func = find_method(sc, closure_let(e), sc->length_symbol);
+  if (length_func != sc->undefined)
+    return((int32_t)s7_integer(s7_apply_function(sc, length_func, set_plist_1(sc, e))));
+  /* there are cases where this should raise a wrong-type-arg error, but for now... */
+  return(-1);
+}
+
+static s7_pointer cons_unchecked_with_type(s7_scheme *sc, s7_pointer p, s7_pointer a, s7_pointer b) /* (used only in copy_tree_with_type) */
+{
+  s7_pointer x;
+  new_cell_no_check(sc, x, full_type(p) & (TYPE_MASK | T_IMMUTABLE | T_SAFE_PROCEDURE));
+  set_car(x, a);
+  set_cdr(x, b);
+  return(x);
+}
+
+static s7_pointer copy_tree_with_type(s7_scheme *sc, s7_pointer tree)
+{
+  /* if sc->safety > NO_SAFETY, '(1 2) is set immutable by the reader, but eval (in that safety case) calls
+   *   copy_body on the incoming tree, so we have to preserve T_IMMUTABLE in that case.
+   * if tree is something like (+ 1 (car '#1=(2 . #1#))), we have to see the quoted list and not copy it.
+   * Before getting here, we have checked that there is room for the entire tree (in copy_body), or 8192 cells (in list_values) in the free heap.
+   */
+#if WITH_GCC
+  #define COPY_TREE_WITH_TYPE(P) ({s7_pointer _p; _p = P; \
+                                   cons_unchecked_with_type(sc, _p, (is_unquoted_pair(car(_p))) ? copy_tree_with_type(sc, car(_p)) : car(_p), \
+                                                                    (is_unquoted_pair(cdr(_p))) ? copy_tree_with_type(sc, cdr(_p)) : cdr(_p));})
+#else
+  #define COPY_TREE_WITH_TYPE(P) copy_tree_with_type(sc, P)
+#endif
+  return(cons_unchecked_with_type(sc, tree,
+				  (is_unquoted_pair(car(tree))) ? COPY_TREE_WITH_TYPE(car(tree)) : car(tree),
+				  (is_unquoted_pair(cdr(tree))) ? COPY_TREE_WITH_TYPE(cdr(tree)) : cdr(tree)));
+}
+
+static inline s7_pointer copy_tree(s7_scheme *sc, s7_pointer tree)
+{
+#if WITH_GCC
+  #define COPY_TREE(P) ({s7_pointer _p; _p = P; \
+                         cons_unchecked(sc, (is_unquoted_pair(car(_p))) ? copy_tree(sc, car(_p)) : car(_p), \
+                                            (is_pair(cdr(_p))) ? copy_tree(sc, cdr(_p)) : cdr(_p));})
+#else
+  #define COPY_TREE(P) copy_tree(sc, P)
+#endif
+  return(cons_unchecked(sc,
+			(is_unquoted_pair(car(tree))) ? COPY_TREE(car(tree)) : car(tree),
+			(is_pair(cdr(tree))) ? COPY_TREE(cdr(tree)) : cdr(tree)));
+}
+
+
+/* -------------------------------- tree-cyclic? -------------------------------- */
+#define TREE_NOT_CYCLIC 0
+#define TREE_CYCLIC 1
+#define TREE_HAS_PAIRS 2
+
+static int32_t tree_is_cyclic_or_has_pairs(s7_scheme *sc, s7_pointer tree)
+{
+  s7_pointer fast = tree, slow = tree; /* we assume tree is a pair */
+  bool has_pairs = false;
+  while (true)
+    {
+      if (tree_is_collected(fast)) return(TREE_CYCLIC);
+      if ((!has_pairs) && (is_unquoted_pair(car(fast))))
+	has_pairs = true;
+      fast = cdr(fast);
+      if (!is_pair(fast))
+	{
+	  if (!has_pairs) return(TREE_NOT_CYCLIC);
+	  break;
+	}
+      if (tree_is_collected(fast)) return(TREE_CYCLIC);
+      if ((!has_pairs) && (is_unquoted_pair(car(fast))))
+	has_pairs = true;
+      fast = cdr(fast);
+      if (!is_pair(fast))
+	{
+	  if (!has_pairs) return(TREE_NOT_CYCLIC);
+	  break;
+	}
+      slow = cdr(slow);
+      if (fast == slow) return(TREE_CYCLIC);
+    }
+  return(TREE_HAS_PAIRS);
+}
+
+/* we can't use shared_info here because tree_is_cyclic may be called in the midst of output that depends on sc->circle_info */
+
+static bool tree_is_cyclic_1(s7_scheme *sc, s7_pointer tree)
+{
+  for (s7_pointer p = tree; is_pair(p); p = cdr(p))
+    {
+      tree_set_collected(p);
+      if (sc->tree_pointers_top == sc->tree_pointers_size)
+	{
+	  if (sc->tree_pointers_size == 0)
+	    {
+	      sc->tree_pointers_size = 8;
+	      sc->tree_pointers = (s7_pointer *)Malloc(sc->tree_pointers_size * sizeof(s7_pointer));
+	    }
+	  else
+	    {
+	      sc->tree_pointers_size *= 2;
+	      sc->tree_pointers = (s7_pointer *)Realloc(sc->tree_pointers, sc->tree_pointers_size * sizeof(s7_pointer));
+	    }}
+      sc->tree_pointers[sc->tree_pointers_top++] = p;
+      if (is_unquoted_pair(car(p)))
+	{
+	  int32_t old_top = sc->tree_pointers_top, result;
+	  result = tree_is_cyclic_or_has_pairs(sc, car(p));
+	  if ((result == TREE_CYCLIC) ||
+	      (tree_is_cyclic_1(sc, car(p))))
+	    return(true);
+	  for (int32_t i = old_top; i < sc->tree_pointers_top; i++)
+	    tree_clear_collected(sc->tree_pointers[i]);
+	  sc->tree_pointers_top = old_top;
+	}}
+  return(false);
+}
+
+static bool tree_is_cyclic(s7_scheme *sc, s7_pointer tree)
+{
+  int32_t result;
+  if (!is_pair(tree)) return(false);
+  result = tree_is_cyclic_or_has_pairs(sc, tree);
+  if (result == TREE_NOT_CYCLIC) return(false);
+  if (result == TREE_CYCLIC) return(true);
+  result = tree_is_cyclic_1(sc, tree);
+  for (int32_t i = 0; i < sc->tree_pointers_top; i++)
+    tree_clear_collected(sc->tree_pointers[i]);
+  sc->tree_pointers_top = 0;
+  return(result);
+}
+
+static s7_pointer g_tree_is_cyclic(s7_scheme *sc, s7_pointer args)
+{
+  #define H_tree_is_cyclic "(tree-cyclic? tree) returns #t if the tree has a cycle."
+  #define Q_tree_is_cyclic sc->pl_bt
+  return(make_boolean(sc, tree_is_cyclic(sc, car(args))));
+}
+
+static inline s7_int tree_len(s7_scheme *sc, s7_pointer p);
+
+static s7_pointer copy_body(s7_scheme *sc, s7_pointer p)
+{
+  sc->w = p;
+  if (tree_is_cyclic(sc, p)) /* don't wrap this in is_safety_checked */
+    error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "copy: tree is cyclic: ~S", 24), p));
+  check_free_heap_size(sc, tree_len(sc, p) * 2);
+  return((sc->safety > NO_SAFETY) ? copy_tree_with_type(sc, p) : copy_tree(sc, p));
+}
+
+static s7_pointer copy_closure(s7_scheme *sc, s7_pointer fnc)
+{
+  /* copy the source tree annotating (for eventual optimization), return a thing of the same type as fnc */
+  s7_pointer x, body = copy_body(sc, closure_body(fnc));
+  if ((is_any_macro(fnc)) && (has_pair_macro(fnc)))
+    {
+      set_pair_macro(body, pair_macro(closure_body(fnc)));
+      set_has_pair_macro(fnc);
+    }
+  new_cell(sc, x, full_type(fnc) & (~T_COLLECTED)); /* I'm paranoid about that is_collected bit */
+  closure_set_args(x, closure_args(fnc));
+  closure_set_body(x, body);
+  closure_set_setter(x, closure_setter(fnc));
+  closure_set_arity(x, closure_arity(fnc));
+  closure_set_let(x, closure_let(fnc));
+  return(x);
+}
+
+
+/* -------------------------------- defined? -------------------------------- */
+static s7_pointer g_is_defined(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_defined "(defined? symbol (let (curlet)) ignore-globals) returns #t if symbol has a binding (a value) in the let. \
+Only the let is searched if ignore-globals is not #f."
+  #define Q_is_defined s7_make_signature(sc, 4, sc->is_boolean_symbol, sc->is_symbol_symbol, \
+                       s7_make_signature(sc, 5, sc->is_let_symbol, sc->is_procedure_symbol, sc->is_macro_symbol, \
+                                                sc->is_c_object_symbol, sc->is_c_pointer_symbol), sc->is_boolean_symbol)
+  /* if the symbol has a global slot and e is unset or rootlet, this returns #t */
+  s7_pointer sym = car(args);
+  if (!is_symbol(sym))
+    return(method_or_bust(sc, sym, sc->is_defined_symbol, args, sc->type_names[T_SYMBOL], 1));
+
+  if (is_pair(cdr(args)))
+    {
+      s7_pointer e = cadr(args), b, x;
+      if (!is_let(e))
+	{
+	  e = find_let(sc, e);  /* returns () if none */
+	  if (!is_let(e))
+	    wrong_type_error_nr(sc, sc->is_defined_symbol, 2, cadr(args), a_let_string); /* not e */
+	}
+      if (is_keyword(sym))                       /* if no "e", is global -> #t */
+	{                                        /* we're treating :x as 'x outside rootlet, but consider all keywords defined (as themselves) in rootlet? */
+	  if (e == sc->rootlet) return(sc->T);   /* (defined? x (rootlet)) where x value is a keyword */
+	  sym = keyword_symbol(sym);             /* (defined? :print-length *s7*) */
+	}
+      if (e == sc->s7_starlet)
+	return(make_boolean(sc, s7_starlet_symbol_id(sym) != SL_NO_FIELD));
+      if (is_pair(cddr(args)))
+	{
+	  b = caddr(args);
+	  if (!is_boolean(b))
+	    return(method_or_bust(sc, b, sc->is_defined_symbol, args, a_boolean_string, 3));
+	}
+      else b = sc->F;
+      if (e == sc->rootlet) /* we checked (let? e) above */
+	{
+	  if (b == sc->F)
+	    return(make_boolean(sc, is_slot(global_slot(sym)))); /* new_symbol and gensym initialize global_slot to #<undefined> */
+	  return(sc->F);
+	}
+      x = symbol_to_local_slot(sc, sym, e);
+      if (is_slot(x))
+	return(sc->T);
+      return((b == sc->T) ? sc->F : make_boolean(sc, is_slot(global_slot(sym))));
+    }
+  return((is_global(sym)) ? sc->T : make_boolean(sc, is_slot(s7_slot(sc, sym))));
+}
+
+static s7_pointer g_is_defined_in_unlet(s7_scheme *sc, s7_pointer args) {return(make_boolean(sc, initial_value(car(args)) != sc->undefined));}
+
+static s7_pointer g_is_defined_in_rootlet(s7_scheme *sc, s7_pointer args) /* aimed at lint.scm */
+{
+  /* called because is_defined_chooser below noticed arg2=(rootlet) and no arg3 and arg1 is a normal symbol (not a keyword).
+   *   since the chooser sets this up to be called via safe_c_nc, the args are unevalled when we get here.
+   *   This is aimed at lint.scm which has stuff like (defined? head (rootlet)) a lot.
+   */
+  s7_pointer sym = lookup_checked(sc, car(args)); /* ok because we know car(args) is an unquoted symbol, lookup_checked for (defined? ... (rootlet)) */
+  if (!is_symbol(sym))                            /* if sym is openlet with defined? perhaps it makes sense to call it, but we need to include the rootlet arg */
+    return(method_or_bust_pp(sc, sym, sc->is_defined_symbol, sym, sc->rootlet, sc->type_names[T_SYMBOL], 1));
+  return(make_boolean(sc, (is_keyword(sym)) || (is_slot(global_slot(sym)))));
+}
+
+static s7_pointer is_defined_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  if (args == 2)
+    {
+      s7_pointer e = caddr(expr);
+      if ((is_pair(e)) && (is_null(cdr(e))))
+	{
+	  if ((car(e) == sc->rootlet_symbol) && (is_normal_symbol(cadr(expr)))) /* i.e. not a keyword */
+	    {
+	      set_safe_optimize_op(expr, HOP_SAFE_C_NC);
+	      return(sc->is_defined_in_rootlet);
+	    }
+	  if (car(e) == sc->unlet_symbol)
+	    {
+	      set_c_function(e, sc->unlet_disabled);
+	      return(sc->is_defined_in_unlet);
+	    }
+	}}
+  return(f);
+}
+
+bool s7_is_defined(s7_scheme *sc, const char *name)
+{
+  s7_pointer x = s7_symbol_table_find_name(sc, name);
+  if (!x) return(false);
+  return(is_slot(s7_slot(sc, x)));
+}
+
+static bool is_defined_b_7p(s7_scheme *sc, s7_pointer p)
+{
+  if (!is_symbol(p)) return(method_or_bust(sc, p, sc->is_defined_symbol, set_plist_1(sc, p), sc->type_names[T_SYMBOL], 1) != sc->F);
+  return(is_slot(s7_slot(sc, p)));
+}
+
+static bool is_defined_b_7pp(s7_scheme *sc, s7_pointer p, s7_pointer e) {return(g_is_defined(sc, set_plist_2(sc, p, e)) != sc->F);}
+
+
+void s7_define(s7_scheme *sc, s7_pointer let, s7_pointer symbol, s7_pointer value)
+{
+  s7_pointer x;
+  if (let == sc->rootlet) let = sc->shadow_rootlet;
+  x = symbol_to_local_slot(sc, symbol, let); /* x can be #<undefined> */
+  if (is_slot(x))
+    slot_set_value_with_hook(x, value);
+  else
+    {
+      s7_make_slot(sc, let, symbol, value); /* I think this means C code can override "constant" defs */
+      /* if let is rootlet, s7_make_slot makes a semipermanent_slot */
+      if ((let == sc->shadow_rootlet) &&
+	  (!is_slot(global_slot(symbol))))
+	set_global_slot(symbol, local_slot(symbol));
+    }
+}
+
+s7_pointer s7_define_variable(s7_scheme *sc, const char *name, s7_pointer value)
+{
+  s7_pointer sym = make_symbol_with_strlen(sc, name);
+  s7_define(sc, sc->rootlet, sym, value);
+  return(sym);
+}
+
+s7_pointer s7_define_variable_with_documentation(s7_scheme *sc, const char *name, s7_pointer value, const char *help)
+{
+  s7_pointer sym = s7_define_variable(sc, name, value);
+  symbol_set_has_help(sym);
+  symbol_set_help(sym, copy_string(help));
+  add_saved_pointer(sc, symbol_help(sym));
+  return(sym);
+}
+
+s7_pointer s7_define_constant_with_environment(s7_scheme *sc, s7_pointer envir, const char *name, s7_pointer value)
+{
+  s7_pointer sym = make_symbol_with_strlen(sc, name);
+  s7_define(sc, envir, sym, value);
+  set_immutable(sym);
+  set_possibly_constant(sym);
+  set_immutable(global_slot(sym));
+  set_immutable(local_slot(sym));
+  return(sym);
+}
+
+s7_pointer s7_define_constant(s7_scheme *sc, const char *name, s7_pointer value)
+{
+  return(s7_define_constant_with_environment(sc, sc->nil, name, value));
+}
+
+/* (define (func a) (let ((cvar (+ a 1))) cvar)) (define-constant cvar 23) (func 1) -> ;can't bind an immutable object: cvar
+ * (let ((aaa 1)) (define-constant aaa 32) (set! aaa 3)) -> set!: can't alter immutable object: aaa
+ */
+
+s7_pointer s7_define_constant_with_documentation(s7_scheme *sc, const char *name, s7_pointer value, const char *help)
+{
+  s7_pointer sym = s7_define_constant(sc, name, value);
+  symbol_set_has_help(sym);
+  symbol_set_help(sym, copy_string(help));
+  add_saved_pointer(sc, symbol_help(sym));
+  return(value); /* inconsistent with variable above, but consistent with define_function? */
+}
+
+
+/* -------------------------------- keyword? -------------------------------- */
+bool s7_is_keyword(s7_pointer obj) {return(is_symbol_and_keyword(obj));}
+
+static s7_pointer g_is_keyword(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_keyword "(keyword? obj) returns #t if obj is a keyword, (keyword? :rest) -> #t"
+  #define Q_is_keyword sc->pl_bt
+  check_boolean_method(sc, is_symbol_and_keyword, sc->is_keyword_symbol, args);
+}
+
+
+/* -------------------------------- string->keyword -------------------------------- */
+s7_pointer s7_make_keyword(s7_scheme *sc, const char *key)
+{
+  s7_pointer sym;
+  size_t slen = (size_t)safe_strlen(key);
+  block_t *b = inline_mallocate(sc, slen + 2);
+  char *name = (char *)block_data(b);
+  name[0] = ':';
+  memcpy((void *)(name + 1), (const void *)key, slen);
+  name[slen + 1] = '\0';
+  sym = inline_make_symbol(sc, name, slen + 1); /* keyword slot etc taken care of here (in new_symbol actually) */
+  liberate(sc, b);
+  return(sym);
+}
+
+static s7_pointer g_string_to_keyword(s7_scheme *sc, s7_pointer args)
+{
+  #define H_string_to_keyword "(string->keyword str) prepends ':' to str and defines that as a keyword"
+  #define Q_string_to_keyword s7_make_signature(sc, 2, sc->is_keyword_symbol, sc->is_string_symbol)
+
+  s7_pointer str = car(args);
+  if (!is_string(str))
+    return(sole_arg_method_or_bust(sc, str, sc->string_to_keyword_symbol, args, sc->type_names[T_STRING]));
+  if ((string_length(str) == 0) ||
+      (string_value(str)[0] == '\0'))
+    error_nr(sc, sc->out_of_range_symbol, set_elist_2(sc, wrap_string(sc, "string->keyword wants a non-null string: ~S", 43), str));
+  return(s7_make_keyword(sc, string_value(str)));
+}
+
+
+/* -------------------------------- keyword->symbol -------------------------------- */
+static s7_pointer g_keyword_to_symbol(s7_scheme *sc, s7_pointer args)
+{
+  #define H_keyword_to_symbol "(keyword->symbol key) returns a symbol with the same name as key but no prepended colon"
+  #define Q_keyword_to_symbol s7_make_signature(sc, 2, sc->is_symbol_symbol, sc->is_keyword_symbol)
+
+  s7_pointer sym = car(args);
+  if (!is_symbol_and_keyword(sym))
+    return(method_or_bust_p(sc, sym, sc->keyword_to_symbol_symbol, wrap_string(sc, "a keyword", 9)));
+  return(keyword_symbol(sym));
+}
+
+s7_pointer s7_keyword_to_symbol(s7_scheme *sc, s7_pointer key) {return(keyword_symbol(key));}
+
+
+/* -------------------------------- symbol->keyword -------------------------------- */
+#define symbol_to_keyword(Sc, Sym) s7_make_keyword(Sc, symbol_name(Sym))
+
+static s7_pointer g_symbol_to_keyword(s7_scheme *sc, s7_pointer args)
+{
+  #define H_symbol_to_keyword "(symbol->keyword sym) returns a keyword with the same name as sym, but with a colon prepended"
+  #define Q_symbol_to_keyword s7_make_signature(sc, 2, sc->is_keyword_symbol, sc->is_symbol_symbol)
+
+  if (!is_symbol(car(args)))
+    return(sole_arg_method_or_bust(sc, car(args), sc->symbol_to_keyword_symbol, args, sc->type_names[T_SYMBOL]));
+  return(symbol_to_keyword(sc, car(args)));
+}
+
+
+/* -------------------------------- c-pointer? -------------------------------- */
+bool s7_is_c_pointer(s7_pointer arg) {return(is_c_pointer(arg));}
+
+bool s7_is_c_pointer_of_type(s7_pointer arg, s7_pointer type) {return((is_c_pointer(arg)) && (c_pointer_type(arg) == type));}
+
+static s7_pointer g_is_c_pointer(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_c_pointer "(c-pointer? obj type) returns #t if obj is a C pointer being held in s7.  \
+If type is given, the c_pointer's type is also checked."
+  #define Q_is_c_pointer s7_make_signature(sc, 3, sc->is_boolean_symbol, sc->T, sc->T)
+
+  s7_pointer p = car(args);
+  if (is_c_pointer(p))
+    return((is_pair(cdr(args))) ? make_boolean(sc, c_pointer_type(p) == cadr(args)) : sc->T);
+  if (!has_active_methods(sc, p)) return(sc->F);
+  return(apply_boolean_method(sc, p, sc->is_c_pointer_symbol));
+}
+
+
+/* -------------------------------- c-pointer -------------------------------- */
+void *s7_c_pointer(s7_pointer p) {return(c_pointer(p));}
+
+void *s7_c_pointer_with_type(s7_scheme *sc, s7_pointer p, s7_pointer expected_type, const char *caller, s7_int argnum)
+{
+  if (!is_c_pointer(p))
+    wrong_type_error_nr(sc, wrap_string(sc, caller, safe_strlen(caller)), argnum, p, sc->type_names[T_C_POINTER]);
+  if ((c_pointer(p) != NULL) &&
+      (c_pointer_type(p) != expected_type))
+    error_nr(sc, sc->wrong_type_arg_symbol,
+	     (argnum == 0) ?
+	     set_elist_4(sc, wrap_string(sc, "~S argument is a pointer of type ~S, but expected ~S", 52),
+			 wrap_string(sc, caller, safe_strlen(caller)), c_pointer_type(p), expected_type) :
+	     set_elist_5(sc, wrap_string(sc, "~S ~:D argument got a pointer of type ~S, but expected ~S", 57),
+			 wrap_string(sc, caller, safe_strlen(caller)),
+			 wrap_integer(sc, argnum), c_pointer_type(p), expected_type));
+  return(c_pointer(p));
+}
+
+s7_pointer s7_make_c_pointer_with_type(s7_scheme *sc, void *ptr, s7_pointer type, s7_pointer info)
+{
+  s7_pointer x;
+  new_cell(sc, x, T_C_POINTER);
+  c_pointer(x) = ptr;
+  c_pointer_type(x) = type;
+  c_pointer_info(x) = info;
+  c_pointer_weak1(x) = sc->F;
+  c_pointer_weak2(x) = sc->F;
+  return(x);
+}
+
+s7_pointer s7_make_c_pointer(s7_scheme *sc, void *ptr) {return(s7_make_c_pointer_with_type(sc, ptr, sc->F, sc->F));}
+
+#define NUM_C_POINTER_WRAPPERS 16 /* need at least 9 for gsl */
+
+s7_pointer s7_make_c_pointer_wrapper_with_type(s7_scheme *sc, void *ptr, s7_pointer type, s7_pointer info)
+{
+  s7_pointer x = car(sc->c_pointer_wrappers);
+#if S7_DEBUGGING
+  if ((full_type(x) & (~T_GC_MARK)) != (T_C_POINTER | T_IMMUTABLE | T_UNHEAP)) fprintf(stderr, "%s\n", describe_type_bits(sc, x));
+#endif
+  sc->c_pointer_wrappers = cdr(sc->c_pointer_wrappers);
+  c_pointer(x) = ptr;
+  c_pointer_type(x) = type;
+  c_pointer_info(x) = info;
+  c_pointer_weak1(x) = sc->F;
+  c_pointer_weak2(x) = sc->F;
+  return(x);
+}
+
+static s7_pointer g_c_pointer(s7_scheme *sc, s7_pointer args)
+{
+  #define H_c_pointer "(c-pointer int type info weak1 weak2) returns a c-pointer object. The type and info args are optional, defaulting to #f."
+  #define Q_c_pointer s7_make_circular_signature(sc, 2, 3, sc->is_c_pointer_symbol, sc->is_integer_symbol, sc->T)
+
+  s7_pointer arg = car(args), type = sc->F, info = sc->F, weak1 = sc->F, weak2 = sc->F, cp;
+  intptr_t p;
+
+  if (!s7_is_integer(arg))
+    return(method_or_bust(sc, arg, sc->c_pointer_symbol, args, sc->type_names[T_INTEGER], 1));
+  p = (intptr_t)s7_integer_clamped_if_gmp(sc, arg);     /* (c-pointer (bignum "1234")) */
+  args = cdr(args);
+  if (is_pair(args))
+    {
+      type = car(args);
+      args = cdr(args);
+      if (is_pair(args))
+	{
+	  info = car(args);
+	  args = cdr(args);
+	  if (is_pair(args))
+	    {
+	      weak1 = car(args);
+	      args = cdr(args);
+	      if (is_pair(args))
+		weak2 = car(args);
+	    }}}
+  cp = s7_make_c_pointer_with_type(sc, (void *)p, type, info);
+  c_pointer_set_weak1(cp, weak1);
+  c_pointer_set_weak2(cp, weak2);
+  if ((weak1 != sc->F) || (weak2 != sc->F))
+    add_weak_ref(sc, cp);
+  return(cp);
+}
+
+
+/* -------------------------------- c-pointer-info -------------------------------- */
+static s7_pointer c_pointer_info_p_p(s7_scheme *sc, s7_pointer p)
+{
+  if (!is_c_pointer(p))
+    return(method_or_bust_p(sc, p, sc->c_pointer_info_symbol, sc->type_names[T_C_POINTER]));
+  return(c_pointer_info(p));
+}
+
+static s7_pointer g_c_pointer_info(s7_scheme *sc, s7_pointer args)
+{
+  #define H_c_pointer_info "(c-pointer-info obj) returns the c-pointer info field"
+  #define Q_c_pointer_info s7_make_signature(sc, 2, sc->T, sc->is_c_pointer_symbol)
+  return(c_pointer_info_p_p(sc, car(args)));
+}
+
+
+/* -------------------------------- c-pointer-type -------------------------------- */
+static s7_pointer method_or_bust_lp(s7_scheme *sc, s7_pointer obj, s7_pointer method, uint8_t typ)
+{ /* weird -- overhead goes berserk in callgrind if using the simpler method_or_bust_p! */
+  if (!has_active_methods(sc, obj))
+    wrong_type_error_nr(sc, method, 1, obj, sc->type_names[typ]);
+  return(find_and_apply_method(sc, obj, method, set_plist_1(sc, obj)));
+}
+
+s7_pointer s7_c_pointer_type(s7_pointer p) {return((is_c_pointer(p)) ? c_pointer_type(p) : NULL);}
+
+static s7_pointer c_pointer_type_p_p(s7_scheme *sc, s7_pointer p)
+{
+  return((is_c_pointer(p)) ? c_pointer_type(p) : method_or_bust_lp(sc, p, sc->c_pointer_type_symbol, T_C_POINTER));
+}
+
+static s7_pointer g_c_pointer_type(s7_scheme *sc, s7_pointer args)
+{
+  #define H_c_pointer_type "(c-pointer-type obj) returns the c-pointer type field"
+  #define Q_c_pointer_type s7_make_signature(sc, 2, sc->T, sc->is_c_pointer_symbol)
+  return(c_pointer_type_p_p(sc, car(args)));
+}
+
+
+/* -------------------------------- c-pointer-weak1/2 -------------------------------- */
+static s7_pointer c_pointer_weak1_p_p(s7_scheme *sc, s7_pointer p)
+{
+  return((is_c_pointer(p)) ? c_pointer_weak1(p) : method_or_bust_lp(sc, p, sc->c_pointer_weak1_symbol, T_C_POINTER));
+}
+
+static s7_pointer g_c_pointer_weak1(s7_scheme *sc, s7_pointer args)
+{
+  #define H_c_pointer_weak1 "(c-pointer-weak1 obj) returns the c-pointer weak1 field"
+  #define Q_c_pointer_weak1 s7_make_signature(sc, 2, sc->T, sc->is_c_pointer_symbol)
+  return(c_pointer_weak1_p_p(sc, car(args)));
+}
+
+static s7_pointer c_pointer_weak2_p_p(s7_scheme *sc, s7_pointer p)
+{
+  return((is_c_pointer(p)) ? c_pointer_weak2(p) : method_or_bust_lp(sc, p, sc->c_pointer_weak2_symbol, T_C_POINTER));
+}
+
+static s7_pointer g_c_pointer_weak2(s7_scheme *sc, s7_pointer args)
+{
+  #define H_c_pointer_weak2 "(c-pointer-weak2 obj) returns the c-pointer weak2 field"
+  #define Q_c_pointer_weak2 s7_make_signature(sc, 2, sc->T, sc->is_c_pointer_symbol)
+  return(c_pointer_weak2_p_p(sc, car(args)));
+}
+
+
+/* -------------------------------- c-pointer->list -------------------------------- */
+static s7_pointer g_c_pointer_to_list(s7_scheme *sc, s7_pointer args)
+{
+  #define H_c_pointer_to_list "(c-pointer->list obj) returns the c-pointer data as (list pointer-as-int type info)"
+  #define Q_c_pointer_to_list s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_c_pointer_symbol)
+
+  s7_pointer p = car(args);
+  if (!is_c_pointer(p))
+    return(method_or_bust(sc, p, sc->c_pointer_to_list_symbol, args, sc->type_names[T_C_POINTER], 1));
+  return(list_3(sc, make_integer(sc, (s7_int)((intptr_t)c_pointer(p))), c_pointer_type(p), c_pointer_info(p)));
+}
+
+
+/* -------------------------------- continuations and gotos -------------------------------- */
+
+/* ----------------------- continuation? -------------------------------- */
+static s7_pointer g_is_continuation(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_continuation "(continuation? obj) returns #t if obj is a continuation"
+  #define Q_is_continuation sc->pl_bt
+  check_boolean_method(sc, is_continuation, sc->is_continuation_symbol, args);
+  /* is this the right thing?  It returns #f for call-with-exit ("goto") because
+   *   that form of continuation can't continue (via a jump back to its context).
+   */
+}
+
+static bool is_continuation_b_p(s7_pointer p) {return(is_continuation(p));}
+
+#if S7_DEBUGGING
+static s7_pointer check_wrap_return(s7_pointer lst)
+{
+  for (s7_pointer fast = lst, slow = lst; is_pair(fast); slow = cdr(slow), fast = cdr(fast))
+    {
+      if (is_matched_pair(fast)) fprintf(stderr, "matched_pair not cleared\n");
+      fast = cdr(fast);
+      if (!is_pair(fast)) return(lst);
+      if (fast == slow) return(lst);
+      if (is_matched_pair(fast)) fprintf(stderr, "matched_pair not cleared\n");
+    }
+  return(lst);
+}
+#endif
+
+static s7_pointer copy_any_list(s7_scheme *sc, s7_pointer a)
+{
+  s7_pointer slow = cdr(a);
+  s7_pointer fast = slow;
+  s7_pointer p;
+#if S7_DEBUGGING
+  #define wrap_return(W) do {fast = W; W = sc->unused; sc->y = sc->unused; return(check_wrap_return(fast));} while (0)
+#else
+  #define wrap_return(W) do {fast = W; W = sc->unused; sc->y = sc->unused; return(fast);} while (0)
+#endif
+  init_temp(sc->y, a); /* gc_protect_via_stack doesn't work here because we're called in copy_stack, I think (trouble is in call/cc stuff) */
+  sc->w = list_1(sc, car(a));
+  p = sc->w;
+  while (true)
+    {
+      if (!is_pair(fast))
+	{
+	  if (is_null(fast))
+	    wrap_return(sc->w);
+	  set_cdr(p, fast);
+	  wrap_return(sc->w);
+	}
+
+      set_cdr(p, list_1(sc, car(fast)));
+      p = cdr(p);
+      fast = cdr(fast);
+      if (!is_pair(fast))
+	{
+	  if (is_null(fast))
+	    wrap_return(sc->w);
+	  set_cdr(p, fast);
+	  wrap_return(sc->w);
+	}
+      /* if unrolled further, it's a lot slower? */
+      set_cdr(p, list_1_unchecked(sc, car(fast)));
+      p = cdr(p);
+      fast = cdr(fast);
+      slow = cdr(slow);
+      if (fast == slow)
+	{
+	  /* try to preserve the original cyclic structure */
+	  s7_pointer p1, f1, p2, f2;
+	  set_match_pair(a);
+	  for (p1 = sc->w, f1 = a; !(is_matched_pair(cdr(f1))); f1 = cdr(f1), p1 = cdr(p1))
+	    set_match_pair(f1);
+	  for (p2 = sc->w, f2 = a; cdr(f1) != f2; f2 = cdr(f2), p2 = cdr(p2))
+	    clear_match_pair(f2);
+	  for (f1 = f2; is_pair(f1); f1 = cdr(f1), f2 = cdr(f2))
+	    {
+	      clear_match_pair(f1);
+	      f1 = cdr(f1);
+	      clear_match_pair(f1);
+	      if (f1 == f2) break;
+	    }
+	  clear_match_pair(a);
+	  if (is_null(p1))
+	    set_cdr(p2, p2);
+	  else set_cdr(p1, p2);
+	  wrap_return(sc->w);
+	}}
+  wrap_return(sc->w);
+}
+
+static s7_pointer copy_counter(s7_scheme *sc, s7_pointer obj)
+{
+  s7_pointer nobj;
+  new_cell(sc, nobj, T_COUNTER);
+  counter_set_result(nobj, counter_result(obj));
+  counter_set_list(nobj, counter_list(obj));
+  counter_set_capture(nobj, counter_capture(obj));
+  counter_set_let(nobj, counter_let(obj));
+  counter_set_slots(nobj, counter_slots(obj));
+  return(nobj);
+}
+
+static void copy_stack_list_set_immutable(s7_pointer pold, s7_pointer pnew)
+{
+  for (s7_pointer p1 = pold, p2 = pnew, slow = pold; is_pair(p2); p1 = cdr(p1), p2 = cdr(p2))
+    {
+      if (is_immutable(p1)) set_immutable(p2);
+      if (is_pair(cdr(p1)))
+	{
+	  p1 = cdr(p1);
+	  p2 = cdr(p2);
+	  if (is_immutable(p1)) set_immutable(p2);
+	  if (p1 == slow) break;
+	  slow = cdr(slow);
+	}}
+}
+
+static s7_pointer copy_stack(s7_scheme *sc, s7_pointer new_v, s7_pointer old_v, int64_t top)
+{
+  bool has_pairs = false;
+  s7_pointer *nv = stack_elements(new_v);
+  s7_pointer *ov = stack_elements(old_v);
+  memcpy((void *)nv, (void *)ov, top * sizeof(s7_pointer));
+  stack_clear_flags(new_v);
+
+  s7_gc_on(sc, false);
+  if (stack_has_counters(old_v))
+    {
+      for (int64_t i = 2; i < top; i += 4)
+	{
+	  s7_pointer p = ov[i];                               /* args */
+	  /* if op_gc_protect, any ov[i] (except op) can be a list, but it isn't the arglist, so it seems to be safe */
+	  if (is_pair(p))                          /* args need not be a list (it can be a port or #f, etc) */
+	    {
+	      has_pairs = true;
+	      if (is_null(cdr(p)))
+		nv[i] = cons_unchecked(sc, car(p), sc->nil); /* GC is off -- could uncheck list_2 et al also */
+	      else
+		if ((is_pair(cdr(p))) && (is_null(cddr(p))))
+		  nv[i] = list_2_unchecked(sc, car(p), cadr(p));
+		else nv[i] = copy_any_list(sc, p);  /* args (copy is needed -- see s7test.scm) */
+	      /* if op=eval_args4 for example, this has to be a proper list, and in many cases it doesn't need to be copied */
+	      copy_stack_list_set_immutable(p, nv[i]);
+	    }
+	  /* lst can be dotted or circular here.  The circular list only happens in a case like:
+	   *    (dynamic-wind (lambda () (eq? (let ((lst (cons 1 2))) (set-cdr! lst lst) lst) (call/cc (lambda (k) k)))) (lambda () #f) (lambda () #f))
+	   *    proper_list_reverse_in_place(sc->args) is one reason we need to copy
+	   */
+	  else
+	    if (is_counter(p))                  /* these can only occur in this context (not in a list etc) */
+	      {
+		stack_set_has_counters(new_v);
+		nv[i] = copy_counter(sc, p);
+	      }}}
+  else
+    for (int64_t i = 2; i < top; i += 4)
+      if (is_pair(ov[i]))
+	{
+	  s7_pointer p = ov[i];
+	  has_pairs = true;
+	  if (is_null(cdr(p)))
+	    nv[i] = cons_unchecked(sc, car(p), sc->nil);
+	  else
+	    if ((is_pair(cdr(p))) && (is_null(cddr(p))))
+	      nv[i] = list_2_unchecked(sc, car(p), cadr(p));
+	    else nv[i] = copy_any_list(sc, p);  /* args (copy is needed -- see s7test.scm) */
+	  copy_stack_list_set_immutable(p, nv[i]);
+	}
+  if (has_pairs) stack_set_has_pairs(new_v);
+  s7_gc_on(sc, true);
+  return(new_v);
+}
+
+static s7_pointer copy_op_stack(s7_scheme *sc)
+{
+  int32_t len = (int32_t)(sc->op_stack_now - sc->op_stack);
+  s7_pointer nv = make_simple_vector(sc, len); /* not sc->op_stack_size */
+  if (len > 0)
+    {
+      s7_pointer *src = sc->op_stack;
+      s7_pointer *dst = (s7_pointer *)vector_elements(nv);
+      for (int32_t i = len; i > 0; i--) *dst++ = *src++;
+    }
+  return(nv);
+}
+
+/* -------------------------------- with-baffle -------------------------------- */
+/* (with-baffle . body) calls body guaranteeing that there can be no jumps into the
+ *    middle of it from outside -- no outer evaluation of a continuation can jump across this
+ *    barrier:  The flip-side of call-with-exit.
+ */
+
+static bool find_baffle(s7_scheme *sc, s7_int key)
+{
+  /* search backwards through sc->curlet for baffle_let with (continuation_)key as its baffle_key value */
+  if (sc->baffle_ctr > 0)
+    for (s7_pointer x = sc->curlet; x; x = let_outlet(x))
+      if ((is_baffle_let(x)) &&
+	  (let_baffle_key(x) == key))
+	return(true);
+  return(false);
+}
+
+#define NOT_BAFFLED -1
+
+static s7_int find_any_baffle(s7_scheme *sc)
+{
+  /* search backwards through sc->curlet for any sc->baffle_symbol -- called by s7_make_continuation to set continuation_key */
+  if (sc->baffle_ctr > 0)
+    for (s7_pointer x = sc->curlet; x; x = let_outlet(x))
+      if (is_baffle_let(x))
+	return(let_baffle_key(x));
+  return(NOT_BAFFLED);
+}
+
+static void check_with_baffle(s7_scheme *sc)
+{
+  if (!s7_is_proper_list(sc, sc->code))
+    syntax_error_nr(sc, "with-baffle: unexpected dot? ~A", 31, sc->code);
+  pair_set_syntax_op(sc->code, OP_WITH_BAFFLE_UNCHECKED);
+}
+
+static bool op_with_baffle_unchecked(s7_scheme *sc)
+{
+  sc->code = cdr(sc->code);
+  if (is_null(sc->code))
+    {
+      sc->value = sc->nil;
+      return(true);
+    }
+  set_curlet(sc, make_let(sc, sc->curlet));
+  set_baffle_let(sc->curlet);
+  let_set_baffle_key(sc->curlet, sc->baffle_ctr++);
+  return(false);
+}
+
+
+/* -------------------------------- call/cc -------------------------------- */
+static void make_room_for_cc_stack(s7_scheme *sc)
+{
+  if ((int64_t)(sc->free_heap_top - sc->free_heap) < (int64_t)(sc->heap_size / 32)) /* we probably never need this much space (8 becomes enormous, 512 seems ok) */
+    {                                                                               /*  but this doesn't seem to make much difference in timings */
+      /* fprintf(stderr, "%" ld64 " < %" ld64 "\n", (int64_t)(sc->free_heap_top - sc->free_heap), (int64_t)(sc->heap_size / 32)); */
+      call_gc(sc);
+      if ((int64_t)(sc->free_heap_top - sc->free_heap) < (int64_t)(sc->heap_size / 32))
+	resize_heap(sc);
+    }
+}
+
+s7_pointer s7_make_continuation(s7_scheme *sc)
+{
+  s7_pointer x, stack;
+  int64_t loc;
+  block_t *block;
+
+  sc->continuation_counter++;
+  make_room_for_cc_stack(sc);
+  if (sc->continuation_counter > 2000) call_gc(sc); /* call_gc zeros cc counter, gc time up, but run time down -- try big cache */
+
+  loc = stack_top(sc);
+  stack = make_simple_vector(sc, loc);
+  set_full_type(stack, T_STACK);
+  temp_stack_top(stack) = loc;
+  sc->temp7 = stack;
+  copy_stack(sc, stack, sc->stack, loc);
+
+  new_cell(sc, x, T_CONTINUATION);
+  block = mallocate_block(sc);
+#if S7_DEBUGGING
+  sc->blocks_mallocated[BLOCK_LIST]++;
+#endif
+  continuation_block(x) = block;
+  continuation_set_stack(x, stack);
+  continuation_stack_size(x) = vector_length(continuation_stack(x));
+  continuation_stack_start(x) = stack_elements(continuation_stack(x));
+  continuation_stack_end(x) = (s7_pointer *)(continuation_stack_start(x) + loc);
+  continuation_op_stack(x) = copy_op_stack(sc);
+  continuation_op_loc(x) = (int32_t)(sc->op_stack_now - sc->op_stack);
+  continuation_op_size(x) = sc->op_stack_size;
+  continuation_key(x) = find_any_baffle(sc);
+  continuation_name(x) = sc->F;
+  sc->temp7 = sc->unused;
+
+  add_continuation(sc, x);
+  return(x);
+}
+
+static void let_temp_done(s7_scheme *sc, s7_pointer args, s7_pointer let);
+static void let_temp_unwind(s7_scheme *sc, s7_pointer slot, s7_pointer new_value);
+static s7_pointer s7_starlet_set_1(s7_scheme *sc, s7_pointer sym, s7_pointer val);
+
+static bool check_for_dynamic_winds(s7_scheme *sc, s7_pointer c)
+{
+  /* called only from call_with_current_continuation.
+   *   if call/cc jumps into a dynamic-wind, the init/finish funcs are wrapped in with-baffle
+   *   so they'll complain.  Otherwise we're supposed to re-run the init func before diving
+   *   into the body.  Similarly for let-temporarily.  If a call/cc jumps out of a dynamic-wind
+   *   body-func, we're supposed to call the finish-func.  The continuation is called at
+   *   stack_top(sc); the continuation form is at continuation_stack_top(c).
+   *
+   * check sc->stack for dynamic-winds we're jumping out of
+   *    we need to check from the current stack top down to where the continuation stack matches the current stack??
+   *    this was (i > 0), but that goes too far back; perhaps s7 should save the position of the call/cc invocation.
+   *    also the two stacks can be different sizes (either can be larger)
+   */
+  int64_t top1 = stack_top(sc), top2 = continuation_stack_top(c);
+  for (int64_t i = top1 - 1; (i > 0) && ((i >= top2) || (stack_code(sc->stack, i) != stack_code(continuation_stack(c), i))); i -= 4)
+    {
+      opcode_t op = stack_op(sc->stack, i);
+      switch (op)
+	{
+	case OP_DYNAMIC_WIND:
+	case OP_LET_TEMP_DONE:
+	  {
+	    s7_pointer x = stack_code(sc->stack, i);
+	    int64_t s_base = 0;
+	    for (int64_t j = 3; j < top2; j += 4)
+	      if (((stack_op(continuation_stack(c), j) == OP_DYNAMIC_WIND) ||
+		   (stack_op(continuation_stack(c), j) == OP_LET_TEMP_DONE)) &&
+		  (x == stack_code(continuation_stack(c), j)))
+		{
+		  s_base = i;
+		  break;
+		}
+	    if (s_base == 0)
+	      {
+		if (op == OP_DYNAMIC_WIND)
+		  {
+		    if (dynamic_wind_state(x) == DWIND_BODY)
+		      {
+			dynamic_wind_state(x) = DWIND_FINISH;
+			if (dynamic_wind_out(x) != sc->F)
+			  sc->value = s7_call(sc, dynamic_wind_out(x), sc->nil);
+			/* free_cell is unsafe here and below */
+		      }}
+		else let_temp_done(sc, stack_args(sc->stack, i), T_Let(stack_let(sc->stack, i)));
+	      }}
+	  break;
+
+	case OP_DYNAMIC_UNWIND:
+	case OP_DYNAMIC_UNWIND_PROFILE:
+	  set_stack_op(sc->stack, i, OP_GC_PROTECT);
+	  break;
+
+	case OP_LET_TEMP_UNWIND:
+	  let_temp_unwind(sc, stack_code(sc->stack, i), stack_args(sc->stack, i));
+	  break;
+
+	case OP_LET_TEMP_S7_UNWIND:
+	  s7_starlet_set_1(sc, T_Sym(stack_code(sc->stack, i)), stack_args(sc->stack, i));
+	  break;
+
+	case OP_LET_TEMP_S7_DIRECT_UNWIND:
+	  sc->has_openlets = (stack_args(sc->stack, i) != sc->F);
+	  break;
+
+	case OP_BARRIER:
+	  if (i > top2)                       /* otherwise it's some unproblematic outer eval-string? */
+	    return(false);                    /*    but what if we've already evaluated a dynamic-wind closer? */
+	  break;
+
+	case OP_DEACTIVATE_GOTO:              /* here we're jumping out of an unrelated call-with-exit block */
+	  if (i > top2)
+	    call_exit_active(stack_args(sc->stack, i)) = false;
+	  break;
+
+	case OP_UNWIND_INPUT:
+	  if (stack_args(sc->stack, i) != sc->unused)
+	    set_current_input_port(sc, stack_args(sc->stack, i));         /* "args" = port that we shadowed */
+	  break;
+
+	case OP_UNWIND_OUTPUT:
+	  if (stack_args(sc->stack, i) != sc->unused)
+	    set_current_output_port(sc, stack_args(sc->stack, i));        /* "args" = port that we shadowed */
+	  break;
+
+	default:
+	  if ((S7_DEBUGGING) && (op == OP_MAP_UNWIND)) fprintf(stderr, "%s[%d]: unwind %" ld64 "\n", __func__, __LINE__, sc->map_call_ctr);
+	  break;
+	}}
+
+  /* check continuation-stack for dynamic-winds we're jumping into */
+  for (int64_t i = stack_top(sc) - 1; i < top2; i += 4)
+    {
+      opcode_t op = stack_op(continuation_stack(c), i);
+      if (op == OP_DYNAMIC_WIND)
+	{
+	  s7_pointer x = T_Dyn(stack_code(continuation_stack(c), i));
+	  if (dynamic_wind_in(x) != sc->F)
+	    sc->value = s7_call(sc, dynamic_wind_in(x), sc->nil);
+	  dynamic_wind_state(x) = DWIND_BODY;
+	}
+      else
+	if (op == OP_DEACTIVATE_GOTO)
+	  call_exit_active(stack_args(continuation_stack(c), i)) = true;
+      /* not let_temp_done here! */
+      /* if op == OP_LET_TEMP_DONE, we're jumping back into a let-temporarily.  MIT and Chez scheme say they remember the
+       *   let-temp vars (fluid-let or parameters in their terminology) at the point of the call/cc, and restore them
+       *   on re-entry; that strikes me as incoherently complex -- they've wrapped a hidden dynamic-wind around the
+       *   call/cc to restore all let-temp vars!  I think let-temp here should be the same as let -- if you jump back
+       *   in, nothing hidden happens. So,
+       *     (let ((x #f) (cc #f))
+       *       (let-temporarily ((x 1))
+       *         (set! x 2) (call/cc (lambda (r) (set! cc r))) (display x) (unless (= x 2) (newline) (exit)) (set! x 3) (cc)))
+       *   behaves the same (in this regard) if let-temp is replaced with let.
+       */
+    }
+  return(true);
+}
+
+static s7_pointer splice_in_values(s7_scheme *sc, s7_pointer args);
+
+static void call_with_current_continuation(s7_scheme *sc)
+{
+  s7_pointer c = sc->code;  /* sc->args are the returned values */
+
+  /* check for (baffle ...) blocking the current attempt to continue */
+  if ((continuation_key(c) != NOT_BAFFLED) &&
+      (!(find_baffle(sc, continuation_key(c)))))
+    error_nr(sc, sc->baffled_symbol,
+	     (is_symbol(continuation_name(sc->code))) ?
+	     set_elist_2(sc, wrap_string(sc, "continuation ~S can't jump into with-baffle", 43), continuation_name(sc->code)) :
+	     set_elist_1(sc, wrap_string(sc, "continuation can't jump into with-baffle", 40)));
+
+  if (check_for_dynamic_winds(sc, c))
+    {
+      /* make_room_for_cc_stack(sc); */ /* 28-May-21 */
+      /* we push_stack sc->code before calling an embedded eval above, so sc->code should still be c here, etc */
+      if ((stack_has_pairs(continuation_stack(c))) ||
+	  (stack_has_counters(continuation_stack(c))))
+	{
+	  make_room_for_cc_stack(sc);
+	  copy_stack(sc, sc->stack, continuation_stack(c), continuation_stack_top(c));
+	}
+      else
+	{
+	  s7_pointer *nv = stack_elements(sc->stack);
+	  s7_pointer *ov = stack_elements(continuation_stack(c));
+	  memcpy((void *)nv, (void *)ov, continuation_stack_top(c) * sizeof(s7_pointer));
+	}
+      /* copy_stack(sc, sc->stack, continuation_stack(c), continuation_stack_top(c)); */
+      sc->stack_end = (s7_pointer *)(sc->stack_start + continuation_stack_top(c));
+
+      {
+	int32_t top = continuation_op_loc(c);
+	s7_pointer *src, *dst;
+	sc->op_stack_now = (s7_pointer *)(sc->op_stack + top);
+	sc->op_stack_size = continuation_op_size(c);
+	sc->op_stack_end = (s7_pointer *)(sc->op_stack + sc->op_stack_size);
+	src = (s7_pointer *)vector_elements(continuation_op_stack(c));
+	dst = sc->op_stack;
+	for (int32_t i = 0; i < top; i++) dst[i] = src[i];
+      }
+      sc->value = (is_null(sc->args)) ? sc->nil : ((is_null(cdr(sc->args))) ? car(sc->args) : splice_in_values(sc, sc->args));
+    }
+}
+
+static s7_pointer g_call_cc(s7_scheme *sc, s7_pointer args)
+{
+  #define H_call_cc "(call-with-current-continuation (lambda (continuer)...)) is always a mistake!"
+  #define Q_call_cc s7_make_signature(sc, 2, sc->T, sc->is_procedure_symbol)
+
+  s7_pointer p = car(args);                  /* this is the procedure passed to call/cc */
+  if (!is_t_procedure(p))                    /* this includes continuations */
+    {
+      check_method(sc, p, sc->call_cc_symbol, args);
+      check_method(sc, p, sc->call_with_current_continuation_symbol, args);
+      sole_arg_wrong_type_error_nr(sc, sc->call_cc_symbol, p, a_procedure_string);
+    }
+  if (((!is_closure(p)) ||
+       (closure_arity(p) != 1)) &&
+      (!s7_is_aritable(sc, p, 1)))
+    error_nr(sc, sc->wrong_type_arg_symbol,
+	     set_elist_2(sc, wrap_string(sc, "call/cc procedure, ~A, should take one argument", 47), p));
+
+  sc->w = s7_make_continuation(sc);
+  if ((is_any_closure(p)) && (is_pair(closure_args(p))) && (is_symbol(car(closure_args(p)))))
+    continuation_name(sc->w) = car(closure_args(p));
+  push_stack(sc, OP_APPLY, list_1_unchecked(sc, sc->w), p); /* apply function p to continuation sc->w */
+  sc->w = sc->unused;
+  return(sc->nil);
+}
+
+/* we can't naively optimize call/cc to call-with-exit if the continuation is only
+ *   used as a function in the call/cc body because it might (for example) be wrapped
+ *   in a lambda form that is being exported.  See b-func in s7test for an example.
+ */
+
+static void op_call_cc(s7_scheme *sc)
+{
+  sc->w = s7_make_continuation(sc);
+  continuation_name(sc->w) = caar(opt2_pair(sc->code)); /* caadadr(sc->code) */
+  set_curlet(sc, inline_make_let_with_slot(sc, sc->curlet, continuation_name(sc->w), sc->w));
+  sc->w = sc->unused;
+  sc->code = cdr(opt2_pair(sc->code)); /* cddadr(sc->code) */
+}
+
+static bool op_implicit_continuation_a(s7_scheme *sc)
+{
+  s7_pointer code = sc->code; /* dumb-looking code, but it's faster than the pretty version, according to callgrind */
+  s7_pointer s = lookup_checked(sc, car(code));
+  if (!is_continuation(s)) {sc->last_function = s; return(false);}
+  sc->code = s;
+  sc->args = set_plist_1(sc, fx_call(sc, cdr(code)));
+  call_with_current_continuation(sc);
+  return(true);
+}
+
+
+/* -------------------------------- call-with-exit -------------------------------- */
+static void pop_input_port(s7_scheme *sc);
+static s7_pointer dynamic_unwind(s7_scheme *sc, s7_pointer func, s7_pointer e);
+
+static void call_with_exit(s7_scheme *sc)
+{
+  int64_t i, new_stack_top, quit = 0;
+
+  if (!call_exit_active(sc->code))
+    error_nr(sc, sc->invalid_exit_function_symbol,
+	     set_elist_1(sc, wrap_string(sc, "call-with-exit exit procedure called outside its block", 56)));
+
+  call_exit_active(sc->code) = false;
+  new_stack_top = call_exit_goto_loc(sc->code);
+  sc->op_stack_now = (s7_pointer *)(sc->op_stack + call_exit_op_loc(sc->code));
+
+  /* look for dynamic-wind in the stack section that we are jumping out of */
+  i = stack_top(sc) - 1;
+  do {
+    switch (stack_op(sc->stack, i)) /* avoidable if we group these ops at the end and use op< */
+      {
+      case OP_DYNAMIC_WIND:
+	{
+	  s7_pointer lx = T_Dyn(stack_code(sc->stack, i));
+	  if (dynamic_wind_state(lx) == DWIND_BODY)
+	    {
+	      dynamic_wind_state(lx) = DWIND_FINISH;
+	      if (dynamic_wind_out(lx) != sc->F)
+		{
+		  s7_pointer arg = (sc->args == sc->plist_1) ? car(sc->plist_1) : sc->unused;  /* might also need GC protection here */
+		  /* protect the sc->args value across this call if it is sc->plist_1 -- I can't find a broken case */
+		  sc->value = s7_call(sc, dynamic_wind_out(lx), sc->nil);
+		  if (arg != sc->unused) set_plist_1(sc, arg);
+		}}}
+	break;
+
+      case OP_DYNAMIC_UNWIND:
+      case OP_DYNAMIC_UNWIND_PROFILE:
+	set_stack_op(sc->stack, i, OP_GC_PROTECT);
+	dynamic_unwind(sc, stack_code(sc->stack, i), stack_args(sc->stack, i));
+	break;
+
+      case OP_EVAL_STRING:
+	s7_close_input_port(sc, current_input_port(sc));
+	pop_input_port(sc);
+	break;
+
+      case OP_BARRIER:                /* oops -- we almost certainly went too far */
+	goto SET_VALUE;
+
+      case OP_DEACTIVATE_GOTO:        /* here we're jumping into an unrelated call-with-exit block */
+	call_exit_active(stack_args(sc->stack, i)) = false;
+	break;
+
+      case OP_LET_TEMP_DONE:
+	{
+	  s7_pointer old_args = sc->args;
+	  let_temp_done(sc, stack_args(sc->stack, i), T_Let(stack_let(sc->stack, i)));
+	  sc->args = old_args;
+	}
+	break;
+
+      case OP_LET_TEMP_UNWIND:
+	let_temp_unwind(sc, stack_code(sc->stack, i), stack_args(sc->stack, i));
+	break;
+
+      case OP_LET_TEMP_S7_UNWIND:
+	s7_starlet_set_1(sc, T_Sym(stack_code(sc->stack, i)), stack_args(sc->stack, i));
+	break;
+
+      case OP_LET_TEMP_S7_DIRECT_UNWIND:
+	sc->has_openlets = (stack_args(sc->stack, i) != sc->F);
+	break;
+
+	/* call/cc does not close files, but I think call-with-exit should */
+      case OP_GET_OUTPUT_STRING:
+      case OP_UNWIND_OUTPUT:
+	{
+	  s7_pointer x = T_Pro(stack_code(sc->stack, i));  /* "code" = port that we opened */
+	  s7_close_output_port(sc, x);
+	  x = stack_args(sc->stack, i);                    /* "args" = port that we shadowed, if not #<unused> */
+	  if (x != sc->unused)
+	    set_current_output_port(sc, x);
+	}
+	break;
+
+      case OP_UNWIND_INPUT:
+	s7_close_input_port(sc, T_Pri(stack_code(sc->stack, i))); /* "code" = port that we opened */
+	if (stack_args(sc->stack, i) != sc->unused)
+	  set_current_input_port(sc, stack_args(sc->stack, i));   /* "args" = port that we shadowed */
+	break;
+
+      case OP_EVAL_DONE: /* goto called in a method -- put off the inner eval return(s) until we clean up the stack */
+	quit++;
+	break;
+
+      default:
+	if ((S7_DEBUGGING) && (stack_op(sc->stack, i) == OP_MAP_UNWIND)) fprintf(stderr, "%s[%d]: unwind %" ld64 "\n", __func__, __LINE__, sc->map_call_ctr);
+	break;
+      }
+    i -= 4;
+  } while (i > new_stack_top);
+
+ SET_VALUE:
+  sc->stack_end = (s7_pointer *)(sc->stack_start + new_stack_top);
+
+  /* the return value should have an implicit values call, just as in call/cc */
+  sc->value = (is_null(sc->args)) ? sc->nil : ((is_null(cdr(sc->args))) ? car(sc->args) : splice_in_values(sc, sc->args));
+  if (quit > 0)
+    {
+      if (sc->longjmp_ok)
+	{
+	  pop_stack(sc);
+	  LongJmp(*(sc->goto_start), CALL_WITH_EXIT_JUMP);
+	}
+      for (i = 0; i < quit; i++)
+	push_stack_op_let(sc, OP_EVAL_DONE);
+    }
+}
+
+static s7_pointer g_is_goto(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_goto "(goto? obj) returns #t if obj is a call-with-exit exit function"
+  #define Q_is_goto sc->pl_bt
+  return(make_boolean(sc, is_goto(car(args))));
+}
+
+static inline s7_pointer make_goto(s7_scheme *sc, s7_pointer name) /* inline for 73=1% in tgc */
+{
+  s7_pointer x;
+  new_cell(sc, x, T_GOTO);
+  call_exit_goto_loc(x) = stack_top(sc);
+  call_exit_op_loc(x) = (int32_t)(sc->op_stack_now - sc->op_stack);
+  call_exit_active(x) = true;
+  call_exit_name(x) = name;
+  return(x);
+}
+
+static s7_pointer g_call_with_exit(s7_scheme *sc, s7_pointer args)   /* (call-with-exit (lambda (return) ...)) */
+{
+  #define H_call_with_exit "(call-with-exit (lambda (exiter) ...)) is call/cc without the ability to jump back into a previous computation."
+  #define Q_call_with_exit s7_make_signature(sc, 2, sc->values_symbol, sc->is_procedure_symbol)
+
+  s7_pointer p = car(args), x;
+  if (is_any_closure(p)) /* lambda or lambda* */
+    {
+      x = make_goto(sc, ((is_pair(closure_args(p))) && (is_symbol(car(closure_args(p))))) ? car(closure_args(p)) : sc->F);
+      push_stack(sc, OP_DEACTIVATE_GOTO, x, p); /* this means call-with-exit is not tail-recursive */
+      push_stack(sc, OP_APPLY, cons_unchecked(sc, x, sc->nil), p);
+      return(sc->nil);
+    }
+  /* maybe just return an error here -- these gotos as args are stupid; also an error above if closure not aritable 1 */
+  if (!is_t_procedure(p))
+    return(method_or_bust_p(sc, p, sc->call_with_exit_symbol, a_procedure_string));
+  if (!s7_is_aritable(sc, p, 1))
+    error_nr(sc, sc->wrong_type_arg_symbol,
+	     set_elist_2(sc, wrap_string(sc, "call-with-exit argument should be a function of one argument: ~S", 64), p));
+  if (is_continuation(p)) /* (call/cc call-with-exit) ! */
+    error_nr(sc, sc->wrong_type_arg_symbol,
+	     set_elist_2(sc, wrap_string(sc, "call-with-exit argument should be a normal function (not a continuation: ~S)", 76), p));
+  x = make_goto(sc, sc->F);
+  call_exit_active(x) = false;
+  return((is_c_function(p)) ? c_function_call(p)(sc, set_plist_1(sc, x)) : s7_apply_function_star(sc, p, set_plist_1(sc, x)));
+}
+
+static inline void op_call_with_exit(s7_scheme *sc)
+{
+  s7_pointer args = opt2_pair(sc->code);
+  s7_pointer go = make_goto(sc, caar(args));
+  push_stack_no_let_no_code(sc, OP_DEACTIVATE_GOTO, go); /* was also pushing code */
+  set_curlet(sc, inline_make_let_with_slot(sc, sc->curlet, caar(args), go));
+  sc->code = T_Pair(cdr(args));
+}
+
+static void op_call_with_exit_o(s7_scheme *sc)
+{
+  op_call_with_exit(sc);
+  sc->code = car(sc->code);
+}
+
+static bool op_implicit_goto(s7_scheme *sc)
+{
+  s7_pointer g = lookup_checked(sc, car(sc->code));
+  if (!is_goto(g)) {sc->last_function = g; return(false);}
+  sc->args = sc->nil;
+  sc->code = g;
+  call_with_exit(sc);
+  return(true);
+}
+
+static bool op_implicit_goto_a(s7_scheme *sc)
+{
+  s7_pointer g = lookup_checked(sc, car(sc->code));
+  if (!is_goto(g)) {sc->last_function = g; return(false);}
+  sc->args = set_plist_1(sc, fx_call(sc, cdr(sc->code)));
+  sc->code = g;
+  call_with_exit(sc);
+  return(true);
+}
+
+
+/* -------------------------------- numbers -------------------------------- */
+static block_t *string_to_block(s7_scheme *sc, const char *p, s7_int len)
+{
+  block_t *b = inline_mallocate(sc, len + 1);
+  char *bp = (char *)block_data(b);
+  memcpy((void *)bp, (const void *)p, len);
+  bp[len] = '\0';
+  return(b);
+}
+
+static Inline s7_pointer inline_block_to_string(s7_scheme *sc, block_t *block, s7_int len)
+{
+  s7_pointer x;
+  new_cell(sc, x, T_STRING | T_SAFE_PROCEDURE);
+  string_block(x) = block;
+  string_value(x) = (char *)block_data(block);
+  string_length(x) = len;
+  string_value(x)[len] = '\0';
+  string_hash(x) = 0;
+  add_string(sc, x);
+  return(x);
+}
+
+static s7_pointer block_to_string(s7_scheme *sc, block_t *block, s7_int len) {return(inline_block_to_string(sc, block, len));}
+
+static inline s7_pointer make_simple_ratio(s7_scheme *sc, s7_int num, s7_int den)
+{
+  s7_pointer x;
+  if (den == 1)
+    return(make_integer(sc, num));
+  if (den == -1)
+    return(make_integer(sc, -num));
+  if ((den == S7_INT64_MIN) && ((num & 1) != 0))
+    return(make_real(sc, (long_double)num / (long_double)den));
+  new_cell(sc, x, T_RATIO);
+  if (den < 0) /* this is noticeably faster in callgrind than using (den < 0) ? ... twice */
+    {
+      set_numerator(x, -num);
+      set_denominator(x, -den);
+    }
+  else
+    {
+      set_numerator(x, num);
+      set_denominator(x, den);
+    }
+  return(x);
+}
+
+static bool is_zero(s7_pointer x);
+static bool is_positive(s7_scheme *sc, s7_pointer x);
+static bool is_negative(s7_scheme *sc, s7_pointer x);
+static s7_pointer make_ratio(s7_scheme *sc, s7_int a, s7_int b);
+
+static bool is_NaN(s7_double x) {return(x != x);}
+/* callgrind says this is faster than isnan, I think (very confusing data...) */
+
+#if defined(__sun) && defined(__SVR4)
+  static bool is_inf(s7_double x) {return((x == x) && (is_NaN(x - x)));} /* there's no isinf in Solaris */
+#else
+#if (!MS_WINDOWS)
+  #if __cplusplus
+    #define is_inf(x) std::isinf(x)
+  #else
+    #define is_inf(x) isinf(x)
+  #endif
+#else
+  static bool is_inf(s7_double x) {return((x == x) && (is_NaN(x - x)));}  /* Another possibility: (x * 0) != 0 */
+
+#if (_MSC_VER < 1700)
+  /* in MS C, we need to provide inverse hyperbolic trig funcs and cbrt */
+  static double asinh(double x) {return(log(x + sqrt(1.0 + x * x)));}
+  static double acosh(double x) {return(log(x + sqrt(x * x - 1.0)));}
+  /* perhaps less prone to numerical troubles (untested): 2.0 * log(sqrt(0.5 * (x + 1.0)) + sqrt(0.5 * (x - 1.0))) */
+  static double atanh(double x) {return(log((1.0 + x) / (1.0 - x)) / 2.0);}
+  static double cbrt(double x) {if (x >= 0.0) return(pow(x, 1.0 / 3.0)); return(-pow(-x, 1.0 / 3.0));}
+#endif
+#endif /* windows */
+#endif /* not sun */
+
+
+/* -------------------------------- NaN payloads -------------------------------- */
+typedef union {int64_t ix; double fx;} decode_float_t;
+
+static double nan_with_payload(int64_t payload)
+{
+  decode_float_t num;
+  if (payload <= 0) return(NAN);
+  num.fx = NAN;
+  num.ix = num.ix | payload;
+  return(num.fx);
+}
+
+static s7_pointer make_nan_with_payload(s7_scheme *sc, s7_int payload)
+{
+  s7_pointer x = make_real(sc, nan_with_payload(payload));
+  char buf[32];
+  s7_int nlen = 0;
+  nlen = snprintf(buf, 32, "+nan.%" ld64, payload);
+  set_number_name(x, buf, nlen);
+  return(x);
+}
+
+static s7_pointer g_nan(s7_scheme *sc, s7_pointer args)
+{
+  #define H_nan "(nan int) returns a NaN with payload int"
+  #define Q_nan s7_make_signature(sc, 2, sc->is_real_symbol, sc->is_integer_symbol)
+  #define NAN_PAYLOAD_LIMIT (1LL << 51LL) /* 53 is probably ok, (nan (- (ash 1 53) 1)): +nan.9007199254740991 -- 52 bits available? */
+  s7_pointer x;
+  if (is_null(args)) return(real_NaN);
+  x = car(args);
+  if (!is_t_integer(x))
+    sole_arg_wrong_type_error_nr(sc, sc->nan_symbol, x, sc->type_names[T_INTEGER]);
+  if (integer(x) < 0)
+    sole_arg_out_of_range_error_nr(sc, sc->nan_symbol, set_elist_1(sc, x), it_is_negative_string);
+  if (integer(x) >= NAN_PAYLOAD_LIMIT)
+    sole_arg_out_of_range_error_nr(sc, sc->nan_symbol, set_elist_1(sc, x), it_is_too_large_string);
+  return(make_nan_with_payload(sc, integer(x)));
+}
+
+static s7_int nan_payload(double x)
+{
+  decode_float_t num;
+  num.fx = x;
+  return(num.ix & 0xffffffffffff);
+}
+
+static s7_pointer g_nan_payload(s7_scheme *sc, s7_pointer args)
+{
+  #define H_nan_payload "(nan-payload x) returns the payload associated with the NaN x"
+  #define Q_nan_payload s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_real_symbol)
+  s7_pointer x = car(args);
+  if ((!is_t_real(x)) || (!is_NaN(real(x)))) /* for complex case, use real-part etc (see s7test.scm) */
+    sole_arg_wrong_type_error_nr(sc, sc->nan_payload_symbol, x, wrap_string(sc, "a NaN", 5));
+  return(make_integer(sc, nan_payload(real(x))));
+}
+
+/* no similar support for +inf.0 because inf is just a single bit pattern in ieee754 */
+
+
+/* -------- gmp stuff -------- */
+#if WITH_GMP
+static mp_prec_t mpc_precision = DEFAULT_BIGNUM_PRECISION;
+static mp_prec_t mpc_set_default_precision(mp_prec_t prec) {mpc_precision = prec; return(prec);}
+#define mpc_init(Z) mpc_init2(Z, mpc_precision)
+
+static bigint *alloc_bigint(s7_scheme *sc)
+{
+  bigint *p;
+  if (sc->bigints)
+    {
+      p = sc->bigints;
+      sc->bigints = p->nxt;
+    }
+  else
+    {
+      p = (bigint *)Malloc(sizeof(bigint));
+      /* not permalloc here: gmp must be playing tricky games with realloc or something.  permalloc can lead
+       *   to mpz_set_si overwriting adjacent memory (valgrind does not catch this), clobbering at least the
+       *   bigint nxt field.  Someday I need to look at the source.
+       */
+      mpz_init(p->n);
+    }
+  return(p);
+}
+
+static bigrat *alloc_bigrat(s7_scheme *sc)
+{
+  bigrat *p;
+  if (sc->bigrats)
+    {
+      p = sc->bigrats;
+      sc->bigrats = p->nxt;
+    }
+  else
+    {
+      p = (bigrat *)Malloc(sizeof(bigrat));
+      mpq_init(p->q);
+    }
+  return(p);
+}
+
+static bigflt *alloc_bigflt(s7_scheme *sc)
+{
+  bigflt *p;
+  if (sc->bigflts)
+    {
+      p = sc->bigflts;
+      sc->bigflts = p->nxt;
+      mpfr_set_prec(p->x, sc->bignum_precision);
+    }
+  else
+    {
+      p = (bigflt *)Malloc(sizeof(bigflt));
+      mpfr_init2(p->x, sc->bignum_precision);
+    }
+  return(p);
+}
+
+static bigcmp *alloc_bigcmp(s7_scheme *sc)
+{
+  bigcmp *p;
+  if (sc->bigcmps)
+    {
+      p = sc->bigcmps;
+      sc->bigcmps = p->nxt;
+      mpc_set_prec(p->z, sc->bignum_precision);
+    }
+  else
+    {
+      p = (bigcmp *)Malloc(sizeof(bigcmp));
+      mpc_init(p->z);
+    }
+  return(p);
+}
+
+static s7_pointer mpz_to_big_integer(s7_scheme *sc, mpz_t val)
+{
+  s7_pointer x;
+  new_cell(sc, x, T_BIG_INTEGER);
+  big_integer_bgi(x) = alloc_bigint(sc);
+  mpz_set(big_integer(x), val);
+  add_big_integer(sc, x);
+  return(x);
+}
+
+static s7_pointer mpz_to_integer(s7_scheme *sc, mpz_t val)
+{
+  if (mpz_fits_slong_p(val))
+    return(make_integer(sc, mpz_get_si(val)));
+  return(mpz_to_big_integer(sc, val));
+}
+
+#if (!WITH_PURE_S7)
+static s7_pointer mpz_to_big_real(s7_scheme *sc, mpz_t val)
+{
+  s7_pointer x;
+  new_cell(sc, x, T_BIG_REAL);
+  big_real_bgf(x) = alloc_bigflt(sc);
+  add_big_real(sc, x);
+  mpfr_set_z(big_real(x), val, MPFR_RNDN);
+  return(x);
+}
+#endif
+
+static s7_pointer mpq_to_big_ratio(s7_scheme *sc, mpq_t val)
+{
+  s7_pointer x;
+  new_cell(sc, x, T_BIG_RATIO);
+  big_ratio_bgr(x) = alloc_bigrat(sc);
+  add_big_ratio(sc, x);
+  mpq_set(big_ratio(x), val);
+  return(x);
+}
+
+static s7_pointer mpq_to_rational(s7_scheme *sc, mpq_t val)
+{
+  if (mpz_cmp_ui(mpq_denref(val), 1) == 0)
+    return(mpz_to_integer(sc, mpq_numref(val)));
+#if S7_DEBUGGING
+  mpq_canonicalize(val);
+  if (mpz_cmp_ui(mpq_denref(val), 1) == 0)
+    {
+      fprintf(stderr, "mpq_to_rational: missing canonicalize\n");
+      return(mpz_to_integer(sc, mpq_numref(val)));
+    }
+#endif
+ if ((mpz_fits_slong_p(mpq_numref(val))) && (mpz_fits_slong_p(mpq_denref(val))))
+    return(make_simple_ratio(sc, mpz_get_si(mpq_numref(val)), mpz_get_si(mpq_denref(val))));
+  return(mpq_to_big_ratio(sc, val));
+}
+
+static s7_pointer mpq_to_canonicalized_rational(s7_scheme *sc, mpq_t mpq)
+{
+  mpq_canonicalize(mpq);
+  return(mpq_to_rational(sc, mpq));
+}
+
+static s7_pointer mpz_to_rational(s7_scheme *sc, mpz_t n, mpz_t d) /* mpz_3 and mpz_4 */
+{
+  if (mpz_cmp_ui(d, 1) == 0)
+    return(mpz_to_integer(sc, n));
+  mpq_set_num(sc->mpq_1, n);
+  mpq_set_den(sc->mpq_1, d);
+  return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+}
+
+#if (!WITH_PURE_S7)
+static s7_pointer mpq_to_big_real(s7_scheme *sc, mpq_t val)
+{
+  s7_pointer x;
+  new_cell(sc, x, T_BIG_REAL);
+  big_real_bgf(x) = alloc_bigflt(sc);
+  add_big_real(sc, x);
+  mpfr_set_q(big_real(x), val, MPFR_RNDN);
+  return(x);
+}
+#endif
+
+static s7_pointer any_rational_to_mpq(s7_scheme *sc, s7_pointer z, mpq_t bigq)
+{
+  switch (type(z))
+    {
+    case T_INTEGER:     mpq_set_si(bigq, integer(z), 1);                break;
+    case T_BIG_INTEGER: mpq_set_z(bigq, big_integer(z));                break;
+    case T_RATIO:       mpq_set_si(bigq, numerator(z), denominator(z)); break;
+    case T_BIG_RATIO:   mpq_set(bigq, big_ratio(z));                    break;
+    }
+  return(z);
+}
+
+static s7_pointer mpfr_to_integer(s7_scheme *sc, mpfr_t val)
+{
+  mpfr_get_z(sc->mpz_4, val, MPFR_RNDN);
+  return(mpz_to_integer(sc, sc->mpz_4));
+}
+
+static s7_pointer mpfr_to_big_real(s7_scheme *sc, mpfr_t val)
+{
+  s7_pointer x;
+  new_cell(sc, x, T_BIG_REAL);
+  add_big_real(sc, x);
+  big_real_bgf(x) = alloc_bigflt(sc);
+  mpfr_set(big_real(x), val, MPFR_RNDN);
+  return(x);
+}
+
+static s7_pointer mpc_to_number(s7_scheme *sc, mpc_t val)
+{
+  s7_pointer x;
+  if (mpfr_zero_p(mpc_imagref(val)))
+    return(mpfr_to_big_real(sc, mpc_realref(val)));
+  new_cell(sc, x, T_BIG_COMPLEX);
+  big_complex_bgc(x) = alloc_bigcmp(sc);
+  add_big_complex(sc, x);
+  mpc_set(big_complex(x), val, MPC_RNDNN);
+  return(x);
+}
+
+/* s7.h */
+mpz_t  *s7_big_integer(s7_pointer x) {return(&big_integer(x));}
+mpq_t  *s7_big_ratio(s7_pointer x)   {return(&big_ratio(x));}
+mpfr_t *s7_big_real(s7_pointer x)    {return(&big_real(x));}
+mpc_t  *s7_big_complex(s7_pointer x) {return(&big_complex(x));}
+
+bool s7_is_big_integer(s7_pointer x) {return(is_t_big_integer(x));}
+bool s7_is_big_ratio(s7_pointer x)   {return(is_t_big_ratio(x));}
+bool s7_is_big_real(s7_pointer x)    {return(is_t_big_real(x));}
+bool s7_is_big_complex(s7_pointer x) {return(is_t_big_complex(x));}
+
+s7_pointer s7_make_big_integer(s7_scheme *sc, mpz_t *val) {return(mpz_to_integer(sc, *val));}
+s7_pointer s7_make_big_ratio(s7_scheme *sc, mpq_t *val)   {return(mpq_to_rational(sc, *val));}
+s7_pointer s7_make_big_real(s7_scheme *sc, mpfr_t *val)   {return(mpfr_to_big_real(sc, *val));}
+s7_pointer s7_make_big_complex(s7_scheme *sc, mpc_t *val) {return(mpc_to_number(sc, *val));}
+
+#if (!WITH_PURE_S7)
+static s7_pointer big_integer_to_big_real(s7_scheme *sc, s7_pointer x) {return(mpz_to_big_real(sc, big_integer(x)));}
+static s7_pointer big_ratio_to_big_real(s7_scheme *sc, s7_pointer x)   {return(mpq_to_big_real(sc, big_ratio(x)));}
+#endif
+
+static s7_pointer s7_int_to_big_integer(s7_scheme *sc, s7_int val)
+{
+  s7_pointer x;
+  new_cell(sc, x, T_BIG_INTEGER);
+  big_integer_bgi(x) = alloc_bigint(sc);
+  mpz_set_si(big_integer(x), val);
+  add_big_integer(sc, x);
+  return(x);
+}
+
+static s7_pointer s7_int_to_big_ratio(s7_scheme *sc, s7_int num, s7_int den)
+{
+  /* (called only in g_bignum), den here always comes from denominator(x) or some positive constant so it is not negative */
+  s7_pointer x;
+  new_cell(sc, x, T_BIG_RATIO);
+  big_ratio_bgr(x) = alloc_bigrat(sc);
+  add_big_ratio(sc, x);
+  mpq_set_si(big_ratio(x), num, den);
+  return(x);
+}
+
+static s7_pointer s7_double_to_big_real(s7_scheme *sc, s7_double rl)
+{
+  s7_pointer x;
+  new_cell(sc, x, T_BIG_REAL);
+  big_real_bgf(x) = alloc_bigflt(sc);
+  add_big_real(sc, x);
+  mpfr_set_d(big_real(x), rl, MPFR_RNDN);
+  return(x);
+}
+
+static s7_pointer s7_double_to_big_complex(s7_scheme *sc, s7_double rl, s7_double im)
+{
+  s7_pointer x;
+  new_cell(sc, x, T_BIG_COMPLEX);
+  add_big_complex(sc, x);
+  big_complex_bgc(x) = alloc_bigcmp(sc);
+  mpc_set_d_d(big_complex(x), rl, im, MPC_RNDNN);
+  return(x);
+}
+
+static s7_pointer big_pi(s7_scheme *sc)
+{
+  s7_pointer x;
+  new_cell(sc, x, T_BIG_REAL | T_IMMUTABLE);
+  big_real_bgf(x) = alloc_bigflt(sc);
+  add_big_real(sc, x);
+  mpfr_const_pi(big_real(x), MPFR_RNDN);
+  return(x);
+}
+
+static bool is_integer_via_method(s7_scheme *sc, s7_pointer p)
+{
+  if (s7_is_integer(p))
+    return(true);
+  if (has_active_methods(sc, p))
+    {
+      s7_pointer f = find_method_with_let(sc, p, sc->is_integer_symbol);
+      if (f != sc->undefined)
+	return(is_true(sc, s7_apply_function(sc, f, set_plist_1(sc, p))));
+    }
+  return(false);
+}
+
+#if (!WITH_PURE_S7)
+static s7_pointer s7_number_to_big_real(s7_scheme *sc, s7_pointer p)
+{
+  s7_pointer x;
+  new_cell(sc, x, T_BIG_REAL);
+  big_real_bgf(x) = alloc_bigflt(sc);
+  add_big_real(sc, x);
+
+  switch (type(p))
+    {
+    case T_INTEGER:
+      mpfr_set_si(big_real(x), integer(p), MPFR_RNDN);
+      break;
+    case T_RATIO:
+      /* here we can't use fraction(number(p)) even though that uses long_double division because
+       *   there are lots of int64_t ratios that will still look the same.
+       *   We have to do the actual bignum divide by hand.
+       */
+      mpq_set_si(sc->mpq_1, numerator(p), denominator(p));
+      mpfr_set_q(big_real(x), sc->mpq_1, MPFR_RNDN);
+      break;
+    default:
+      mpfr_set_d(big_real(x), s7_real(p), MPFR_RNDN);
+      break;
+    }
+  return(x);
+}
+#endif
+
+static s7_pointer s7_number_to_big_complex(s7_scheme *sc, s7_pointer p)
+{
+  s7_pointer x;
+  new_cell(sc, x, T_BIG_COMPLEX);
+  big_complex_bgc(x) = alloc_bigcmp(sc);
+  add_big_complex(sc, x);
+
+  switch (type(p))
+    {
+    case T_INTEGER:
+      mpc_set_si(big_complex(x), integer(p), MPC_RNDNN);
+      break;
+    case T_RATIO:
+      /* can't use fraction here */
+      mpq_set_si(sc->mpq_1, numerator(p), denominator(p));
+      mpfr_set_q(sc->mpfr_1, sc->mpq_1, MPFR_RNDN);
+      mpc_set_fr(big_complex(x), sc->mpfr_1, MPC_RNDNN);
+      break;
+    case T_REAL:
+      mpc_set_d(big_complex(x), s7_real(p), MPC_RNDNN);
+      break;
+    default:
+      mpc_set_d_d(big_complex(x), real_part(p), imag_part(p), MPC_RNDNN);
+      break;
+    }
+  return(x);
+}
+
+static s7_pointer any_real_to_mpfr(s7_scheme *sc, s7_pointer p, mpfr_t bigx)
+{
+  switch (type(p))
+    {
+    case T_INTEGER:
+      mpfr_set_si(bigx, integer(p), MPFR_RNDN);
+      break;
+    case T_RATIO:
+      mpq_set_si(sc->mpq_1, numerator(p), denominator(p));
+      mpfr_set_q(bigx, sc->mpq_1, MPFR_RNDN);
+      break;
+    case T_REAL:
+      mpfr_set_d(bigx, real(p), MPFR_RNDN);
+      if (is_NaN(real(p))) return(real_NaN);
+      if (is_inf(real(p))) return(real_infinity);
+      break;
+    case T_BIG_INTEGER:
+      mpfr_set_z(bigx, big_integer(p), MPFR_RNDN);
+      break;
+    case T_BIG_RATIO:
+      mpfr_set_q(bigx, big_ratio(p), MPFR_RNDN);
+      break;
+    case T_BIG_REAL:
+      mpfr_set(bigx, big_real(p), MPFR_RNDN);
+      if (mpfr_nan_p(big_real(p))) return(real_NaN);
+      if (mpfr_inf_p(big_real(p))) return(real_infinity);
+      break;
+    }
+  return(NULL);
+}
+
+#define mpc_zero_p(z) ((mpfr_zero_p(mpc_realref(z))) && (mpfr_zero_p(mpc_imagref(z))))
+
+static s7_pointer any_number_to_mpc(s7_scheme *sc, s7_pointer p, mpc_t bigz)
+{
+  switch (type(p))
+    {
+    case T_INTEGER:
+      mpc_set_si(bigz, integer(p), MPC_RNDNN);
+      break;
+    case T_RATIO:
+      mpq_set_si(sc->mpq_1, numerator(p), denominator(p));
+      mpc_set_q(bigz, sc->mpq_1, MPC_RNDNN);
+      break;
+    case T_REAL:
+      if (is_NaN(real(p))) return(real_NaN);
+      if (is_inf(real(p))) return(real_infinity);
+      mpc_set_d(bigz, real(p), MPC_RNDNN);
+      break;
+    case T_COMPLEX:
+      if (is_NaN(imag_part(p))) return(complex_NaN);
+      if (is_NaN(real_part(p))) return(real_NaN);
+     mpc_set_d_d(bigz, real_part(p), imag_part(p), MPC_RNDNN);
+      break;
+    case T_BIG_INTEGER:
+      mpc_set_z(bigz, big_integer(p), MPC_RNDNN);
+      break;
+    case T_BIG_RATIO:
+      mpc_set_q(bigz, big_ratio(p), MPC_RNDNN);
+      break;
+    case T_BIG_REAL:
+      mpc_set_fr(bigz, big_real(p), MPC_RNDNN);
+      if (mpfr_nan_p(big_real(p))) return(real_NaN);
+      if (mpfr_inf_p(big_real(p))) return(real_infinity);
+      break;
+    case T_BIG_COMPLEX:
+      if (mpfr_nan_p(mpc_imagref(big_complex(p)))) return(complex_NaN);
+      if (mpfr_nan_p(mpc_realref(big_complex(p)))) return(real_NaN);
+      mpc_set(bigz, big_complex(p), MPC_RNDNN);
+      break;
+    }
+  return(NULL);
+}
+
+static s7_pointer make_big_complex(s7_scheme *sc, mpfr_t rl, mpfr_t im)
+{
+  /* there is no mpc_get_str equivalent, so we need to split up str, use make_big_real to get the 2 halves, then mpc_init, then mpc_set_fr_fr */
+  s7_pointer x;
+  new_cell(sc, x, T_BIG_COMPLEX);
+  big_complex_bgc(x) = alloc_bigcmp(sc);
+  add_big_complex(sc, x);
+  mpc_set_fr_fr(big_complex(x), rl ,im, MPC_RNDNN);
+  return(x);
+}
+
+static block_t *mpfr_to_string(s7_scheme *sc, mpfr_t val, int32_t radix)
+{
+  char *str;
+  mp_exp_t expptr;
+  int32_t ep;
+  s7_int i, len;
+  block_t *b, *btmp;
+
+  if (mpfr_zero_p(val))
+    return(string_to_block(sc, "0.0", 3));
+  if (mpfr_nan_p(val))
+    return(string_to_block(sc, "+nan.0", 6));
+  if (mpfr_inf_p(val))
+    return((mpfr_signbit(val) == 0) ? string_to_block(sc, "+inf.0", 6) : string_to_block(sc, "-inf.0", 6));
+
+  b = callocate(sc, sc->bignum_precision + 32);
+  str = mpfr_get_str((char *)block_data(b), &expptr, radix, 0, val, MPFR_RNDN);
+  ep = (int32_t)expptr;
+  len = safe_strlen(str);
+
+  /* remove trailing 0's */
+  for (i = len - 1; i > 3; i--)
+    if (str[i] != '0')
+      break;
+  if (i < len - 1)
+    str[i + 1] = '\0';
+
+  btmp = mallocate(sc, len + 64);
+  if (str[0] == '-')
+    snprintf((char *)block_data(btmp), len + 64, "-%c.%s%c%d", str[1], (char *)(str + 2), (radix <= 10) ? 'E' : '@', ep - 1);
+  else snprintf((char *)block_data(btmp), len + 64, "%c.%s%c%d", str[0], (char *)(str + 1), (radix <= 10) ? 'E' : '@', ep - 1);
+
+  liberate(sc, b);
+  return(btmp);
+}
+
+static block_t *mpc_to_string(s7_scheme *sc, mpc_t val, int32_t radix, use_write_t use_write)
+{
+  block_t *rl, *im, *tmp;
+  s7_int len;
+
+  mpc_real(sc->mpfr_1, val, MPFR_RNDN);
+  rl = mpfr_to_string(sc, sc->mpfr_1, radix);
+  mpc_imag(sc->mpfr_2, val, MPFR_RNDN);
+  im = mpfr_to_string(sc, sc->mpfr_2, radix);
+
+  len = safe_strlen((char *)block_data(rl)) + safe_strlen((char *)block_data(im)) + 128;
+  tmp = mallocate(sc, len);
+  snprintf((char *)block_data(tmp), len, "%s%s%si",
+	   (char *)block_data(rl),
+	   ((((char *)block_data(im))[0] == '-') || (((char *)block_data(im))[0] == '+')) ? "" : "+", (char *)block_data(im));
+
+  liberate(sc, rl);
+  liberate(sc, im);
+  return(tmp);
+}
+
+static block_t *big_number_to_string_with_radix(s7_scheme *sc, s7_pointer p, int32_t radix, s7_int width, s7_int *nlen, use_write_t use_write)
+{
+  block_t *str;
+  switch (type(p))
+    {
+    case T_BIG_INTEGER:
+      str = callocate(sc, mpz_sizeinbase(big_integer(p), radix) + 64);
+      mpz_get_str((char *)block_data(str), radix, big_integer(p));
+      break;
+    case T_BIG_RATIO:
+      mpz_set(sc->mpz_1, mpq_numref(big_ratio(p)));
+      mpz_set(sc->mpz_2, mpq_denref(big_ratio(p)));
+      str = callocate(sc, mpz_sizeinbase(sc->mpz_1, radix) + mpz_sizeinbase(sc->mpz_2, radix) + 64);
+      mpq_get_str((char *)block_data(str), radix, big_ratio(p));
+      break;
+    case T_BIG_REAL:
+      str = mpfr_to_string(sc, big_real(p), radix);
+      break;
+    default:
+      str = mpc_to_string(sc, big_complex(p), radix, use_write);
+      break;
+    }
+  if (width > 0)
+    {
+      s7_int len = safe_strlen((char *)block_data(str));
+      if (width > len)
+	{
+	  int32_t spaces = width - len;
+	  block_t *tmp = (block_t *)mallocate(sc, width + 1);
+	  ((char *)block_data(tmp))[width] = '\0';
+	  memmove((void *)((char *)block_data(tmp) + spaces), (void *)block_data(str), len);
+	  local_memset((void *)block_data(tmp), (int)' ', spaces);
+	  (*nlen) = width;
+	  liberate(sc, str);
+	  return(tmp);
+	}
+      (*nlen) = len;
+    }
+  else (*nlen) = safe_strlen((char *)block_data(str));
+  return(str);
+}
+
+static s7_pointer string_to_big_integer(s7_scheme *sc, const char *str, int32_t radix)
+{
+  mpz_set_str(sc->mpz_4, (str[0] == '+') ? (const char *)(str + 1) : str, radix);
+  return(mpz_to_integer(sc, sc->mpz_4));
+}
+
+static s7_pointer string_to_big_ratio(s7_scheme *sc, const char *str, int32_t radix)
+{
+  s7_pointer x;
+  mpq_set_str(sc->mpq_1, str, radix);
+  mpq_canonicalize(sc->mpq_1);
+  if (mpz_cmp_ui(mpq_denref(sc->mpq_1), 1) == 0)
+    return(mpz_to_integer(sc, mpq_numref(sc->mpq_1)));
+  new_cell(sc, x, T_BIG_RATIO);
+  big_ratio_bgr(x) = alloc_bigrat(sc);
+  add_big_ratio(sc, x);
+  mpq_set(big_ratio(x), sc->mpq_1);
+  return(x);
+}
+
+static s7_pointer string_to_big_real(s7_scheme *sc, const char *str, int32_t radix)
+{
+  s7_pointer x;
+  new_cell(sc, x, T_BIG_REAL);
+  big_real_bgf(x) = alloc_bigflt(sc);
+  add_big_real(sc, x);
+  mpfr_set_str(big_real(x), str, radix, MPFR_RNDN);
+  return(x);
+}
+
+static s7_int string_to_integer(const char *str, int32_t radix, bool *overflow);
+
+static s7_pointer string_to_either_integer(s7_scheme *sc, const char *str, int32_t radix)
+{
+  bool overflow = false;
+  s7_int val = string_to_integer(str, radix, &overflow);
+  if (!overflow)
+    return(make_integer(sc, val));
+  return(string_to_big_integer(sc, str, radix));
+}
+
+static s7_pointer string_to_either_ratio(s7_scheme *sc, const char *nstr, const char *dstr, int32_t radix)
+{
+  bool overflow = false;
+  /* gmp segfaults if passed a bignum/0 so this needs to check first that the denominator is not 0 before letting gmp screw up.
+   *   Also, if the first character is '+', gmp returns 0!
+   */
+  s7_int d = string_to_integer(dstr, radix, &overflow);
+  if (!overflow)
+    {
+      s7_int n;
+      if (d == 0) return(real_NaN);
+      n = string_to_integer(nstr, radix, &overflow);
+      if (!overflow)
+	return(make_ratio(sc, n, d));
+    }
+  if (nstr[0] == '+')
+    return(string_to_big_ratio(sc, (const char *)(nstr + 1), radix));
+  return(string_to_big_ratio(sc, nstr, radix));
+}
+
+static s7_double string_to_double_with_radix(const char *ur_str, int32_t radix, bool *overflow);
+
+static s7_pointer string_to_either_real(s7_scheme *sc, const char *str, int32_t radix)
+{
+  bool overflow = false;
+  s7_double val = string_to_double_with_radix((char *)str, radix, &overflow);
+  if (!overflow) return(make_real(sc, val));
+  return(string_to_big_real(sc, str, radix));
+}
+
+static s7_pointer string_to_either_complex_1(s7_scheme *sc, char *q, char *slash1, char *ex1, bool has_dec_point1, int32_t radix, s7_double *d_rl)
+{
+  bool overflow = false;
+  /* there's a real problem here -- we don't want to promote s7_double .1 to a bignum because
+   *    its low order digits are garbage, causing (rationalize .1 0) to return 3602879701896397/36028797018963968
+   *    no matter what the bignum-precision.  But we can't just fallback on gmp's reader because (for example)
+   *    it reads 1/2+i or 1+0/0i as 1.0.  Also format gets screwed up.  And string->number signals an error
+   *    where it should return #f.  I wonder what to do.
+   */
+  if ((has_dec_point1) ||
+      (ex1))
+    {
+      (*d_rl) = string_to_double_with_radix(q, radix, &overflow);
+      if (overflow) return(string_to_big_real(sc, q, radix));
+    }
+  else
+    {
+      if (slash1)
+	{
+	  s7_int d, n = string_to_integer(q, radix, &overflow);  /* q can include the slash and denominator */
+	  if (overflow) return(string_to_big_ratio(sc, q, radix));
+	  d = string_to_integer(slash1, radix, &overflow);
+	  if (overflow) return(string_to_big_ratio(sc, q, radix));
+	  (*d_rl) = (s7_double)n / (s7_double)d;
+	}
+      else
+	{
+	  s7_int val = string_to_integer(q, radix, &overflow);
+	  if (overflow) return(string_to_big_integer(sc, q, radix));
+	  (*d_rl) = (s7_double)val;
+	}}
+  if ((*d_rl) == -0.0) (*d_rl) = 0.0;
+  return(NULL);
+}
+
+static s7_pointer string_to_either_complex(s7_scheme *sc, char *q, char *slash1, char *ex1, bool has_dec_point1,
+					   char *plus, char *slash2, char *ex2, bool has_dec_point2,
+					   int32_t radix, int32_t has_plus_or_minus)
+{
+  /* this can be just about anything involving 2 real/ratio/int portions, +/- in between and 'i' at the end */
+  double d_rl = 0.0, d_im = 0.0;
+  s7_pointer p_rl = string_to_either_complex_1(sc, q, slash1, ex1, has_dec_point1, radix, &d_rl);
+  s7_pointer p_im = string_to_either_complex_1(sc, plus, slash2, ex2, has_dec_point2, radix, &d_im);
+
+  if ((d_im == 0.0) &&                     /* 1.0+0.0000000000000000000000000000i */
+      ((!p_im) || (is_zero(p_im))))
+    return((p_rl) ? p_rl : make_real(sc, d_rl));
+
+  if ((!p_rl) && (!p_im))
+    return(make_complex_not_0i(sc, d_rl, (has_plus_or_minus == -1) ? (-d_im) : d_im));
+
+  if (p_rl)
+    any_real_to_mpfr(sc, p_rl, sc->mpfr_1);
+  else mpfr_set_d(sc->mpfr_1, d_rl, MPFR_RNDN);
+
+  if (p_im)
+    any_real_to_mpfr(sc, p_im, sc->mpfr_2);
+  else mpfr_set_d(sc->mpfr_2, d_im, MPFR_RNDN);
+
+  if (has_plus_or_minus == -1)
+    mpfr_neg(sc->mpfr_2, sc->mpfr_2, MPFR_RNDN);
+  return(make_big_complex(sc, sc->mpfr_1, sc->mpfr_2));
+}
+
+static bool big_numbers_are_eqv(s7_scheme *sc, s7_pointer a, s7_pointer b)
+{
+  /* either or both can be big here, but not neither, and types might not match at all */
+  switch (type(a))
+    {
+    case T_INTEGER:
+      return((is_t_big_integer(b)) && (mpz_cmp_si(big_integer(b), integer(a)) == 0));
+    case T_BIG_INTEGER:
+      if (is_t_big_integer(b)) return(mpz_cmp(big_integer(a), big_integer(b)) == 0);
+      return((is_t_integer(b)) && (mpz_cmp_si(big_integer(a), integer(b)) == 0));
+    case T_RATIO:
+      if (!is_t_big_ratio(b)) return(false);
+      mpq_set_si(sc->mpq_1, numerator(a), denominator(a));
+      return(mpq_equal(sc->mpq_1, big_ratio(b)));
+    case T_BIG_RATIO:
+      if (is_t_big_ratio(b)) return(mpq_equal(big_ratio(a), big_ratio(b)));
+      if (!is_t_ratio(b)) return(false);
+      mpq_set_si(sc->mpq_1, numerator(b), denominator(b));
+      return(mpq_equal(sc->mpq_1, big_ratio(a)));
+    case T_REAL:
+      if (is_NaN(real(a))) return(false);
+      return((is_t_big_real(b)) && (!mpfr_nan_p(big_real(b))) && (mpfr_cmp_d(big_real(b), real(a)) == 0));
+    case T_BIG_REAL:
+      if (mpfr_nan_p(big_real(a))) return(false);
+      if (is_t_big_real(b)) return((!mpfr_nan_p(big_real(b))) && (mpfr_equal_p(big_real(a), big_real(b))));
+      return((is_t_real(b)) && (!is_NaN(real(b))) && (mpfr_cmp_d(big_real(a), real(b)) == 0));
+    case T_COMPLEX:
+      if ((is_NaN(real_part(a))) || (is_NaN(imag_part(a)))) return(false);
+      if (!is_t_big_complex(b)) return(false);
+      if ((mpfr_nan_p(mpc_realref(big_complex(b)))) || (mpfr_nan_p(mpc_imagref(big_complex(b)))))
+	return(false);
+      mpc_set_d_d(sc->mpc_1, real_part(a), imag_part(a), MPC_RNDNN);
+      return(mpc_cmp(sc->mpc_1, big_complex(b)) == 0);
+    case T_BIG_COMPLEX:
+      if ((mpfr_nan_p(mpc_realref(big_complex(a)))) || (mpfr_nan_p(mpc_imagref(big_complex(a)))))
+	return(false);
+      if (is_t_big_complex(b))
+	{
+	  if ((mpfr_nan_p(mpc_realref(big_complex(b)))) || (mpfr_nan_p(mpc_imagref(big_complex(b)))))
+	    return(false);
+	  return(mpc_cmp(big_complex(a), big_complex(b)) == 0);
+	}
+      if (is_t_complex(b))
+	{
+	  if ((is_NaN(real_part(b))) || (is_NaN(imag_part(b)))) return(false);
+	  mpc_set_d_d(sc->mpc_2, real_part(b), imag_part(b), MPC_RNDNN);
+	  return(mpc_cmp(big_complex(a), sc->mpc_1) == 0);
+	}}
+  return(false);
+}
+
+static s7_int big_integer_to_s7_int(s7_scheme *sc, mpz_t n)
+{
+  if (!mpz_fits_slong_p(n))
+    error_nr(sc, sc->out_of_range_symbol, set_elist_2(sc, wrap_string(sc, "bigint does not fit in s7_int: ~S", 33), mpz_to_big_integer(sc, n)));
+  return(mpz_get_si(n));
+}
+#endif
+
+#ifndef HAVE_OVERFLOW_CHECKS
+  #if ((defined(__clang__) && (!POINTER_32) && ((__clang_major__ > 3) || (__clang_major__ == 3 && __clang_minor__ >= 4))) || (defined(__GNUC__) && __GNUC__ >= 5))
+    #define HAVE_OVERFLOW_CHECKS 1
+  #else
+    #define HAVE_OVERFLOW_CHECKS 0
+    #pragma message("no arithmetic overflow checks in this version of s7")
+    /* these are untested */
+    static bool add_overflow(s7_int A, s7_int B, s7_int *C) {*C = A + B; return(false);}        /* #define add_overflow(A, B, C) 0 */
+    static bool subtract_overflow(s7_int A, s7_int B, s7_int *C) {*C = A - B; return(false);}   /* #define subtract_overflow(A, B, C) 0 */
+    static bool multiply_overflow(s7_int A, s7_int B, s7_int *C) {*C = A * B; return(false);}   /* #define multiply_overflow(A, B, C) 0 */
+  #endif
+#endif
+
+#if (defined(__clang__) && (!POINTER_32) && ((__clang_major__ > 3) || (__clang_major__ == 3 && __clang_minor__ >= 4)))
+  #define subtract_overflow(A, B, C)       __builtin_ssubll_overflow((long long)A, (long long)B, (long long *)C)
+  #define add_overflow(A, B, C)            __builtin_saddll_overflow((long long)A, (long long)B, (long long *)C)
+  #define multiply_overflow(A, B, C)       __builtin_smulll_overflow((long long)A, (long long)B, (long long *)C)
+  #define int32_add_overflow(A, B, C)      __builtin_sadd_overflow(A, B, C)
+  #define int32_multiply_overflow(A, B, C) __builtin_smul_overflow(A, B, C)
+#else
+#if (defined(__GNUC__) && __GNUC__ >= 5)
+  #define subtract_overflow(A, B, C)       __builtin_sub_overflow(A, B, C)
+  #define add_overflow(A, B, C)            __builtin_add_overflow(A, B, C)
+  #define multiply_overflow(A, B, C)       __builtin_mul_overflow(A, B, C)
+  #define int32_add_overflow(A, B, C)      __builtin_add_overflow(A, B, C)
+  #define int32_multiply_overflow(A, B, C) __builtin_mul_overflow(A, B, C)
+#endif
+#endif
+
+#if WITH_GCC
+#define s7_int_abs(x) ({s7_int _X_; _X_ = x; _X_ >= 0 ? _X_ : -_X_;})
+#else
+#define s7_int_abs(x) ((x) >= 0 ? (x) : -(x))
+#endif
+/* can't use abs even in gcc -- it doesn't work with int64_ts! */
+
+#if (!__NetBSD__)
+  #define s7_fabsl(X) fabsl(X)
+#else
+  static double s7_fabsl(long_double x) {return((signbit(x)) ? -x : x);}
+#endif
+
+/* for g_log, we also need round. this version is from stackoverflow, see also r5rs_round below */
+static double s7_round(double number) {return((number < 0.0) ? ceil(number - 0.5) : floor(number + 0.5));}
+
+#if HAVE_COMPLEX_NUMBERS
+#if __cplusplus
+  #define _Complex_I (complex<s7_double>(0.0, 1.0))
+  #define creal(x) Real(x)
+  #define cimag(x) Imag(x)
+  #define carg(x) arg(x)
+  #define cabs(x) abs(x)
+  #define csqrt(x) sqrt(x)
+  #define cpow(x, y) pow(x, y)
+  #define clog(x) log(x)
+  #define cexp(x) exp(x)
+  #define csin(x) sin(x)
+  #define ccos(x) cos(x)
+  #define ctan(x) tan(x)
+  #define csinh(x) sinh(x)
+  #define ccosh(x) cosh(x)
+  #define ctanh(x) tanh(x)
+  #define casin(x) asin(x)
+  #define cacos(x) acos(x)
+  #define catan(x) atan(x)
+  #define casinh(x) asinh(x)
+  #define cacosh(x) acosh(x)
+  #define catanh(x) atanh(x)
+#else
+  typedef double complex s7_complex;
+#endif
+
+
+#if (!HAVE_COMPLEX_TRIG)
+#if (__cplusplus)
+
+  static s7_complex ctan(s7_complex z)   {return(csin(z) / ccos(z));}
+  static s7_complex ctanh(s7_complex z)  {return(csinh(z) / ccosh(z));}
+  static s7_complex casin(s7_complex z)  {return(-s7_complex_i * clog(s7_complex_i * z + csqrt(1.0 - z * z)));}
+  static s7_complex cacos(s7_complex z)  {return(-s7_complex_i * clog(z + s7_complex_i * csqrt(1.0 - z * z)));}
+  static s7_complex catan(s7_complex z)  {return(s7_complex_i * clog((s7_complex_i + z) / (s7_complex_i - z)) / 2.0);}
+  static s7_complex casinh(s7_complex z) {return(clog(z + csqrt(1.0 + z * z)));}
+  static s7_complex cacosh(s7_complex z) {return(clog(z + csqrt(z * z - 1.0)));}
+  static s7_complex catanh(s7_complex z) {return(clog((1.0 + z) / (1.0 - z)) / 2.0);}
+#else
+
+#if (!defined(__FreeBSD__)) || (__FreeBSD__ < 12)
+static s7_complex clog(s7_complex z) {return(log(fabs(cabs(z))) + carg(z) * s7_complex_i);}
+static s7_complex cpow(s7_complex x, s7_complex y)
+{
+  s7_double r = cabs(x);
+  s7_double theta = carg(x);
+  s7_double yre = creal(y);
+  s7_double yim = cimag(y);
+  s7_double nr = exp(yre * log(r) - yim * theta);
+  s7_double ntheta = yre * theta + yim * log(r);
+  return(nr * cos(ntheta) + (nr * sin(ntheta)) * s7_complex_i);
+}
+#endif
+#if (!defined(__FreeBSD__)) || (__FreeBSD__ < 9) /* untested -- this orignally looked at __FreeBSD_version which apparently no longer exists */
+  static s7_complex cexp(s7_complex z) {return(exp(creal(z)) * cos(cimag(z)) + (exp(creal(z)) * sin(cimag(z))) * s7_complex_i);}
+#endif
+
+#if (!defined(__FreeBSD__)) || (__FreeBSD__ < 10)
+  static s7_complex csin(s7_complex z)   {return(sin(creal(z)) * cosh(cimag(z)) + (cos(creal(z)) * sinh(cimag(z))) * s7_complex_i);}
+  static s7_complex ccos(s7_complex z)   {return(cos(creal(z)) * cosh(cimag(z)) + (-sin(creal(z)) * sinh(cimag(z))) * s7_complex_i);}
+  static s7_complex csinh(s7_complex z)  {return(sinh(creal(z)) * cos(cimag(z)) + (cosh(creal(z)) * sin(cimag(z))) * s7_complex_i);}
+  static s7_complex ccosh(s7_complex z)  {return(cosh(creal(z)) * cos(cimag(z)) + (sinh(creal(z)) * sin(cimag(z))) * s7_complex_i);}
+  static s7_complex ctan(s7_complex z)   {return(csin(z) / ccos(z));}
+  static s7_complex ctanh(s7_complex z)  {return(csinh(z) / ccosh(z));}
+  static s7_complex casin(s7_complex z)  {return(-s7_complex_i * clog(s7_complex_i * z + csqrt(1.0 - z * z)));}
+  static s7_complex cacos(s7_complex z)  {return(-s7_complex_i * clog(z + s7_complex_i * csqrt(1.0 - z * z)));}
+  static s7_complex catan(s7_complex z)  {return(s7_complex_i * clog((s7_complex_i + z) / (s7_complex_i - z)) / 2.0);}
+  static s7_complex catanh(s7_complex z) {return(clog((1.0 + z) / (1.0 - z)) / 2.0);}
+  static s7_complex casinh(s7_complex z) {return(clog(z + csqrt(1.0 + z * z)));}
+  static s7_complex cacosh(s7_complex z) {return(clog(z + csqrt(z * z - 1.0)));}
+#endif /* not FreeBSD 10 */
+#endif /* not c++ */
+#endif /* not HAVE_COMPLEX_TRIG */
+
+#else  /* not HAVE_COMPLEX_NUMBERS */
+  typedef double s7_complex;
+  #define _Complex_I 1.0
+  #define creal(x) x
+  #define cimag(x) x
+  #define csin(x) sin(x)
+  #define casin(x) x
+  #define ccos(x) cos(x)
+  #define cacos(x) x
+  #define ctan(x) x
+  #define catan(x) x
+  #define csinh(x) x
+  #define casinh(x) x
+  #define ccosh(x) x
+  #define cacosh(x) x
+  #define ctanh(x) x
+  #define catanh(x) x
+  #define cexp(x) exp(x)
+  #define cpow(x, y) pow(x, y)
+  #define clog(x) log(x)
+  #define csqrt(x) sqrt(x)
+  #define conj(x) x
+#endif
+
+#ifdef __OpenBSD__
+  /* openbsd's builtin versions of these functions are not usable */
+  static s7_complex catanh_1(s7_complex z) {return(clog((1.0 + z) / (1.0 - z)) / 2.0);}
+  static s7_complex casinh_1(s7_complex z) {return(clog(z + csqrt(1.0 + z * z)));}
+  static s7_complex cacosh_1(s7_complex z) {return(clog(z + csqrt(z * z - 1.0)));}
+#endif
+#ifdef __NetBSD__
+  static s7_complex catanh_1(s7_complex z) {return(clog((1.0 + z) / (1.0 - z)) / 2.0);}
+  static s7_complex casinh_1(s7_complex z) {return(clog(z + csqrt(1.0 + z * z)));}
+#endif
+
+
+bool s7_is_number(s7_pointer p)   {return(is_number(p));}
+bool s7_is_complex(s7_pointer p)  {return(is_number(p));}
+bool s7_is_real(s7_pointer p)     {return(is_real(p));}
+bool s7_is_rational(s7_pointer p) {return(is_rational(p));}
+
+bool s7_is_integer(s7_pointer p)
+{
+#if WITH_GMP
+  return((is_t_integer(p)) || (is_t_big_integer(p)));
+#else
+  return(is_t_integer(p));
+#endif
+}
+
+bool s7_is_ratio(s7_pointer p)
+{
+#if WITH_GMP
+  return((is_t_ratio(p)) || (is_t_big_ratio(p)));
+#else
+  return(is_t_ratio(p));
+#endif
+}
+
+static s7_int c_gcd(s7_int u, s7_int v)
+{
+  /* #if __cplusplus\n return std::gcd(u, v);\n #else... but this requires #include <algorithm> (else gcd is not defined in std::)
+   *   and C++'s gcd returns negative results sometimes -- isn't gcd defined to be positive?  std::gcd is ca 25% faster than the code below.
+   */
+  s7_int a, b;
+  if ((u == s7_int_min) || (v == s7_int_min))
+    {
+      /* can't take abs of these (below) so do it by hand */
+      s7_int divisor = 1;
+      if (u == v) return(u);
+      while (((u & 1) == 0) && ((v & 1) == 0))
+	{
+	  u /= 2;
+	  v /= 2;
+	  divisor *= 2;
+	}
+      return(divisor);
+    }
+  a = s7_int_abs(u);
+  b = s7_int_abs(v);
+  /* there are faster gcd algorithms but does it ever matter? */
+  while (b != 0)
+    {
+      s7_int temp = a % b;
+      a = b;
+      b = temp;
+    }
+  return(a);
+}
+
+#define RATIONALIZE_LIMIT 1.0e12
+
+static bool c_rationalize(s7_double ux, s7_double error, s7_int *numer, s7_int *denom)
+{
+  /* from CL code in Canny, Donald, Ressler, "A Rational Rotation Method for Robust Geometric Algorithms" */
+  double x0, x1;
+  s7_int i, p0, q0 = 1, p1, q1 = 1;
+  double e0, e1, e0p, e1p;
+  int32_t tries = 0;
+  /* don't use long_double: the loop below will hang */
+
+  /* #e1e19 is a killer -- it's bigger than most-positive-fixnum, but if we ceil(ux) below
+   *   it turns into most-negative-fixnum.  1e19 is trouble in many places.
+   */
+  if (fabs(ux) > RATIONALIZE_LIMIT)
+    {
+      /* (rationalize most-positive-fixnum) should not return most-negative-fixnum
+       *   but any number > 1e14 here is so inaccurate that rationalize is useless
+       *   for example,
+       *     default: (rationalize (/ (*s7* 'most-positive-fixnum) 31111.0)) -> 1185866354261165/4
+       *     gmp:     (rationalize (/ (*s7* 'most-positive-fixnum) 31111.0)) -> 9223372036854775807/31111
+       * can't return false here because that confuses some of the callers!
+       */
+      (*numer) = (s7_int)ux;
+      (*denom) = 1;
+      return(true);
+    }
+
+  if (error < 0.0) error = -error;
+  x0 = ux - error;
+  x1 = ux + error;
+  i = (s7_int)ceil(x0);
+
+  if (error >= 1.0) /* aw good grief! */
+    {
+      if (x0 < 0.0)
+	(*numer) = (x1 < 0.0) ? (s7_int)floor(x1) : 0;
+      else (*numer) = i;
+      (*denom) = 1;
+      return(true);
+    }
+  if (x1 >= i)
+    {
+      (*numer) = (i >= 0) ? i : (s7_int)floor(x1);
+      (*denom) = 1;
+      return(true);
+    }
+
+  p0 = (s7_int)floor(x0);
+  p1 = (s7_int)ceil(x1);
+  e0 = p1 - x0;
+  e1 = x0 - p0;
+  e0p = p1 - x1;
+  e1p = x1 - p0;
+  while (true)
+    {
+      s7_int old_p1, old_q1;
+      double old_e0, old_e1, old_e0p, r, r1;
+      double val = (double)p0 / (double)q0;
+
+      if (((x0 <= val) && (val <= x1)) || (e1 == 0.0) || (e1p == 0.0) || (tries > 100))
+	{
+	  if ((q0 == s7_int_min) && (p0 == 1)) /* (rationalize 1.000000004297917e-12) when error is 1e-12 */
+	    {
+	      (*numer) = 0;
+	      (*denom) = 1;
+	    }
+	  else
+	    {
+	      (*numer) = p0;
+	      (*denom) = q0;
+	      if ((S7_DEBUGGING) && (q0 == 0)) fprintf(stderr, "%f %" ld64 "/0\n", ux, p0);
+	    }
+	  return(true);
+	}
+      tries++;
+      r = (s7_int)floor(e0 / e1);
+      r1 = (s7_int)ceil(e0p / e1p);
+      if (r1 < r) r = r1;
+      /* do handles all step vars in parallel */
+      old_p1 = p1;
+      p1 = p0;
+      old_q1 = q1;
+      q1 = q0;
+      old_e0 = e0;
+      e0 = e1p;
+      old_e0p = e0p;
+      e0p = e1;
+      old_e1 = e1;
+      p0 = old_p1 + r * p0;
+      q0 = old_q1 + r * q0;
+      e1 = old_e0p - r * e1p;  /* if the error is set too low, we can get e1 = 0 here: (rationalize (/ pi) 1e-17) */
+      e1p = old_e0 - r * old_e1;
+    }
+  return(false);
+}
+
+s7_pointer s7_rationalize(s7_scheme *sc, s7_double x, s7_double error)
+{
+  s7_int numer = 0, denom = 1;
+  if (c_rationalize(x, error, &numer, &denom))
+    return(make_ratio(sc, numer, denom));
+  return(make_real(sc, x));
+}
+
+s7_pointer s7_make_integer(s7_scheme *sc, s7_int n)
+{
+  s7_pointer x;
+  if (is_small_int(n))
+    return(small_int(n));
+  new_cell(sc, x, T_INTEGER);
+  set_integer(x, n);
+  return(x);
+}
+
+static s7_pointer make_mutable_integer(s7_scheme *sc, s7_int n)
+{
+  s7_pointer x;
+  new_cell(sc, x, T_INTEGER | T_MUTABLE | T_IMMUTABLE);
+  set_integer(x, n);
+  return(x);
+}
+
+s7_pointer s7_make_real(s7_scheme *sc, s7_double n)
+{
+  s7_pointer x;
+  new_cell(sc, x, T_REAL);
+  set_real(x, n);
+  return(x);
+}
+
+s7_pointer s7_make_mutable_real(s7_scheme *sc, s7_double n)
+{
+  s7_pointer x;
+  new_cell(sc, x, T_REAL | T_MUTABLE | T_IMMUTABLE);
+  set_real(x, n);
+  return(x);
+}
+
+#define make_mutable_real(Sc, X) s7_make_mutable_real(Sc, X)
+
+s7_pointer s7_make_complex(s7_scheme *sc, s7_double a, s7_double b)
+{
+  s7_pointer x;
+  if (b == 0.0)
+    {
+      new_cell(sc, x, T_REAL);
+      set_real(x, a);
+    }
+  else
+    {
+      new_cell(sc, x, T_COMPLEX);
+      set_real_part(x, a);
+      set_imag_part(x, b);
+    }
+  return(x);
+}
+
+static s7_complex s7_to_c_complex(s7_pointer p)
+{
+#if HAVE_COMPLEX_NUMBERS
+  return(CMPLX(s7_real_part(p), s7_imag_part(p)));
+#else
+  return(0.0);
+#endif
+}
+
+static inline s7_pointer c_complex_to_s7(s7_scheme *sc, s7_complex z) {return(make_complex(sc, creal(z), cimag(z)));}
+
+static noreturn void division_by_zero_error_1_nr(s7_scheme *sc, s7_pointer caller, s7_pointer x)
+{
+  error_nr(sc, sc->division_by_zero_symbol,
+	   set_elist_4(sc, wrap_string(sc, "~A: division by zero, (~A ~S)", 29), caller, caller, x));
+}
+
+static noreturn void division_by_zero_error_2_nr(s7_scheme *sc, s7_pointer caller, s7_pointer x, s7_pointer y)
+{
+  error_nr(sc, sc->division_by_zero_symbol,
+	   set_elist_5(sc, wrap_string(sc, "~A: division by zero, (~A ~S ~S)", 32), caller, caller, x, y));
+}
+
+static s7_pointer make_ratio(s7_scheme *sc, s7_int a, s7_int b)
+{
+  s7_pointer x;
+  if (b == s7_int_min)
+    {
+      /* This should not trigger an error during reading -- we might have the
+       *   ratio on a switch with-bignums or whatever, so its mere occurrence is just an annoyance.
+       */
+      if (a & 1)
+	return(make_real(sc, (long_double)a / (long_double)b));
+      a /= 2;
+      b /= 2;
+    }
+  if (b < 0)
+    {
+      a = -a;
+      b = -b;
+    }
+  if (a == s7_int_min)
+    {
+      while (((a & 1) == 0) && ((b & 1) == 0))
+	{
+	  a /= 2;
+	  b /= 2;
+	}}
+  else
+    {
+      s7_int b1 = b, divisor = s7_int_abs(a);
+      do {
+	s7_int temp = divisor % b1;
+	divisor = b1;
+	b1 = temp;
+      } while (b1 != 0);
+      if (divisor != 1)
+	{
+	  a /= divisor;
+	  b /= divisor;
+	}}
+  if (b == 1)
+    return(make_integer(sc, a));
+
+  new_cell(sc, x, T_RATIO);
+  set_numerator(x, a);
+  set_denominator(x, b);
+  return(x);
+}
+
+/* using "make-ratio" here is a desperate kludge trying to maintain backwards compatibility; internally we use make_ratio_with_div_check below */
+s7_pointer s7_make_ratio(s7_scheme *sc, s7_int a, s7_int b)
+{
+  if (b == 0)
+    division_by_zero_error_2_nr(sc, wrap_string(sc, "make-ratio", 10), wrap_integer(sc, a), int_zero);
+  return(make_ratio(sc, a, b));
+}
+
+static s7_pointer make_ratio_with_div_check(s7_scheme *sc, s7_pointer caller, s7_int a, s7_int b)
+{
+  if (b == 0)
+    division_by_zero_error_2_nr(sc, caller, wrap_integer(sc, a), int_zero);
+  return(make_ratio(sc, a, b));
+}
+
+
+#define WITH_OVERFLOW_ERROR true
+#define WITHOUT_OVERFLOW_ERROR false
+
+#define INT64_TO_DOUBLE_LIMIT (1LL << 53)
+#define DOUBLE_TO_INT64_LIMIT (1LL << 53)
+
+/* 9007199254740991LL is where a truncated double starts to skip integers (expt 2 53) = ca 1e16
+ *   (ceiling (+ 1e16 1)) -> 10000000000000000
+ *   (> 9007199254740993.0 9007199254740992.0) -> #f ; in non-gmp 64-bit doubles
+ * but we can't fix this except in the gmp case because:
+ *   (integer-decode-float (+ (expt 2.0 62) 100)) -> (4503599627370496 10 1)
+ *   (integer-decode-float (+ (expt 2.0 62) 500)) -> (4503599627370496 10 1)
+ *   (> (+ (expt 2.0 62) 500) (+ (expt 2.0 62) 100)) -> #f ; non-gmp again
+ * i.e. the bits are identical.  We can't even detect when it has happened (without tedious effort), so should
+ *   we just give an error for any floor (or whatever) of an arg>1e16?  (sin has a similar problem)?
+ *   I think in the non-gmp case I'll throw an error in these cases because the results are bogus:
+ *   (floor (+ (expt 2.0 62) 512)) -> 4611686018427387904
+ *   (floor (+ (expt 2.0 62) 513)) -> 4611686018427388928
+ * another case at the edge: (round 9007199254740992.51) -> 9007199254740992
+ * This spells trouble for normal arithmetic in this range.  If no gmp,
+ *    (- (+ (expt 2.0 62) 512) (+ (expt 2.0 62) 513)) = -1024.0 (should be -1.0)
+ *    but we don't currently give an error in this case -- not sure what the right thing is.
+ */
+
+s7_double s7_number_to_real_with_caller(s7_scheme *sc, s7_pointer x, const char *caller)
+{
+  if (is_t_real(x)) return(real(x));
+  switch (type(x))
+    {
+    case T_INTEGER:     return((s7_double)integer(x));
+    case T_RATIO:       return(fraction(x));
+#if WITH_GMP
+    case T_BIG_INTEGER: return((s7_double)big_integer_to_s7_int(sc, big_integer(x)));
+    case T_BIG_RATIO:   return((s7_double)((long_double)big_integer_to_s7_int(sc, mpq_numref(big_ratio(x))) /
+					   (long_double)big_integer_to_s7_int(sc, mpq_denref(big_ratio(x)))));
+    case T_BIG_REAL:    return((s7_double)mpfr_get_d(big_real(x), MPFR_RNDN));
+#endif
+    default:
+      sole_arg_wrong_type_error_nr(sc, wrap_string(sc, caller, safe_strlen(caller)), x, sc->type_names[T_REAL]);
+    }
+  return(0.0);
+}
+
+s7_double s7_number_to_real_with_location(s7_scheme *sc, s7_pointer x, s7_pointer caller)
+{
+  if (is_t_real(x)) return(real(x));
+  switch (type(x))
+    {
+    case T_INTEGER:     return((s7_double)integer(x));
+    case T_RATIO:       return(fraction(x));
+#if WITH_GMP
+    case T_BIG_INTEGER: return((s7_double)big_integer_to_s7_int(sc, big_integer(x)));
+    case T_BIG_RATIO:   return((s7_double)((long_double)big_integer_to_s7_int(sc, mpq_numref(big_ratio(x))) /
+					   (long_double)big_integer_to_s7_int(sc, mpq_denref(big_ratio(x)))));
+    case T_BIG_REAL:    return((s7_double)mpfr_get_d(big_real(x), MPFR_RNDN));
+#endif
+    default:
+      sole_arg_wrong_type_error_nr(sc, caller, x, sc->type_names[T_REAL]);
+    }
+  return(0.0);
+}
+
+s7_double s7_number_to_real(s7_scheme *sc, s7_pointer x) {return(s7_number_to_real_with_location(sc, x, sc->number_to_real_symbol));}
+
+s7_int s7_number_to_integer_with_caller(s7_scheme *sc, s7_pointer x, const char *caller)
+{
+  if (is_t_integer(x)) return(integer(x));
+#if WITH_GMP
+  if (is_t_big_integer(x)) return(big_integer_to_s7_int(sc, big_integer(x)));
+#endif
+  sole_arg_wrong_type_error_nr(sc, wrap_string(sc, caller, safe_strlen(caller)), x, sc->type_names[T_INTEGER]);
+  return(0);
+}
+
+s7_int s7_number_to_integer(s7_scheme *sc, s7_pointer x) {return(s7_number_to_integer_with_caller(sc, x, "s7_number_to_integer"));}
+
+s7_int s7_numerator(s7_pointer x)
+{
+  switch (type(x))
+    {
+    case T_INTEGER:     return(integer(x));
+    case T_RATIO:       return(numerator(x));
+#if WITH_GMP
+    case T_BIG_INTEGER: return(mpz_get_si(big_integer(x))); /* big_integer_to_s7_int but no sc -- no error if out of range */
+    case T_BIG_RATIO:   return(mpz_get_si(mpq_numref(big_ratio(x))));
+#endif
+    }
+  return(0);
+}
+
+s7_int s7_denominator(s7_pointer x)
+{
+  if (is_t_ratio(x)) return(denominator(x));
+#if WITH_GMP
+  if (is_t_big_ratio(x)) return(mpz_get_si(mpq_denref(big_ratio(x))));
+#endif
+  return(1);
+}
+
+s7_int s7_integer(s7_pointer p)
+{
+  if (is_t_integer(p)) return(integer(p));
+#if WITH_GMP
+  if (is_t_big_integer(p)) return(mpz_get_si(big_integer(p)));
+#endif
+  return(0);
+}
+
+s7_double s7_real(s7_pointer x)
+{
+  if (is_t_real(x)) return(real(x));
+  switch (type(x))
+    {
+    case T_RATIO:       return(fraction(x));
+    case T_INTEGER:     return((s7_double)integer(x));
+#if WITH_GMP
+    case T_BIG_INTEGER: return((s7_double)mpz_get_si(big_integer(x)));
+    case T_BIG_REAL:    return((s7_double)mpfr_get_d(big_real(x), MPFR_RNDN));
+    case T_BIG_RATIO:
+      {
+	s7_double result;
+	mpfr_t bx;
+	mpfr_init2(bx, DEFAULT_BIGNUM_PRECISION);
+	mpfr_set_q(bx, big_ratio(x), MPFR_RNDN);
+	result = mpfr_get_d(bx, MPFR_RNDN);
+	mpfr_clear(bx);
+	return(result);
+      }
+#endif
+    }
+  return(0.0);
+}
+
+static bool is_one(s7_pointer x)
+{
+  return(((is_t_integer(x)) && (integer(x) == 1)) ||
+	 ((is_t_real(x)) && (real(x) == 1.0)));
+}
+
+
+/* -------- optimize exponents -------- */
+
+#define MAX_POW 64
+static double **pepow = NULL; /* [17][MAX_POW * 2]; */
+
+static void init_pows(void)
+{
+  pepow = (double **)Malloc(17 * sizeof(double *));
+  pepow[0] = NULL;
+  pepow[1] = NULL;
+  for (int32_t i = 2; i < 17; i++) pepow[i] = (double *)Malloc((MAX_POW * 2) * sizeof(double));
+  for (int32_t i = 2; i < 17; i++)        /* radix between 2 and 16 */
+    for (int32_t j = -MAX_POW; j < MAX_POW; j++) /* saved exponent between 0 and +/- MAX_POW */
+      pepow[i][j + MAX_POW] = pow((double)i, (double)j);
+}
+
+static inline double dpow(int32_t x, int32_t y)
+{
+  if ((y >= MAX_POW) || (y < -MAX_POW)) /* this can happen (once in a blue moon) */
+    return(pow((double)x, (double)y));
+  return(pepow[x][y + MAX_POW]);
+}
+
+
+/* -------------------------------- number->string -------------------------------- */
+#ifndef WITH_DTOA
+  #define WITH_DTOA 1
+#endif
+/* there was a time when libc was so slow that this code was all but mandatory, but now (Aug-2023) the difference is smaller (ca. factor of 2) */
+
+#if WITH_DTOA
+/* fpconv, revised to fit the local coding style
+
+   The MIT License
+
+Copyright (c) 2013 Andreas Samoljuk
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+*/
+
+#define dtoa_npowers     87
+#define dtoa_steppowers  8
+#define dtoa_firstpower -348 /* 10 ^ -348 */
+#define dtoa_expmax     -32
+#define dtoa_expmin     -60
+
+typedef struct dtoa_np {uint64_t frac; int32_t exp;} dtoa_np;
+
+static const dtoa_np dtoa_powers_ten[] = {
+    { 18054884314459144840U, -1220 }, { 13451937075301367670U, -1193 }, { 10022474136428063862U, -1166 }, { 14934650266808366570U, -1140 },
+    { 11127181549972568877U, -1113 }, { 16580792590934885855U, -1087 }, { 12353653155963782858U, -1060 }, { 18408377700990114895U, -1034 },
+    { 13715310171984221708U, -1007 }, { 10218702384817765436U, -980 }, { 15227053142812498563U, -954 },  { 11345038669416679861U, -927 },
+    { 16905424996341287883U, -901 },  { 12595523146049147757U, -874 }, { 9384396036005875287U,  -847 },  { 13983839803942852151U, -821 },
+    { 10418772551374772303U, -794 },  { 15525180923007089351U, -768 }, { 11567161174868858868U, -741 },  { 17236413322193710309U, -715 },
+    { 12842128665889583758U, -688 },  { 9568131466127621947U,  -661 }, { 14257626930069360058U, -635 },  { 10622759856335341974U, -608 },
+    { 15829145694278690180U, -582 },  { 11793632577567316726U, -555 }, { 17573882009934360870U, -529 },  { 13093562431584567480U, -502 },
+    { 9755464219737475723U,  -475 },  { 14536774485912137811U, -449 }, { 10830740992659433045U, -422 },  { 16139061738043178685U, -396 },
+    { 12024538023802026127U, -369 },  { 17917957937422433684U, -343 }, { 13349918974505688015U, -316 },  { 9946464728195732843U,  -289 },
+    { 14821387422376473014U, -263 },  { 11042794154864902060U, -236 }, { 16455045573212060422U, -210 },  { 12259964326927110867U, -183 },
+    { 18268770466636286478U, -157 },  { 13611294676837538539U, -130 }, { 10141204801825835212U, -103 },  { 15111572745182864684U, -77 },
+    { 11258999068426240000U, -50 },   { 16777216000000000000U, -24 }, { 12500000000000000000U,   3 },   { 9313225746154785156U,   30 },
+    { 13877787807814456755U,  56 },   { 10339757656912845936U,  83 }, { 15407439555097886824U, 109 },   { 11479437019748901445U, 136 },
+    { 17105694144590052135U, 162 },   { 12744735289059618216U, 189 }, { 9495567745759798747U,  216 },   { 14149498560666738074U, 242 },
+    { 10542197943230523224U, 269 },   { 15709099088952724970U, 295 }, { 11704190886730495818U, 322 },   { 17440603504673385349U, 348 },
+    { 12994262207056124023U, 375 },   { 9681479787123295682U,  402 }, { 14426529090290212157U, 428 },   { 10748601772107342003U, 455 },
+    { 16016664761464807395U, 481 },   { 11933345169920330789U, 508 }, { 17782069995880619868U, 534 },   { 13248674568444952270U, 561 },
+    { 9871031767461413346U,  588 },   { 14708983551653345445U, 614 }, { 10959046745042015199U, 641 },   { 16330252207878254650U, 667 },
+    { 12166986024289022870U, 694 },   { 18130221999122236476U, 720 }, { 13508068024458167312U, 747 },   { 10064294952495520794U, 774 },
+    { 14996968138956309548U, 800 },   { 11173611982879273257U, 827 }, { 16649979327439178909U, 853 },   { 12405201291620119593U, 880 },
+    { 9242595204427927429U,  907 },   { 13772540099066387757U, 933 }, { 10261342003245940623U, 960 },   { 15290591125556738113U, 986 },
+    { 11392378155556871081U, 1013 },  { 16975966327722178521U, 1039 },
+    { 12648080533535911531U, 1066 }};
+
+static dtoa_np dtoa_find_cachedpow10(int exp, int* k)
+{
+  const double one_log_ten = 0.30102999566398114;
+  int32_t approx = -(exp + dtoa_npowers) * one_log_ten;
+  int32_t idx = (approx - dtoa_firstpower) / dtoa_steppowers;
+  while (true)
+    {
+      int32_t current = exp + dtoa_powers_ten[idx].exp + 64;
+      if (current < dtoa_expmin)
+	{
+	  idx++;
+	  continue;
+        }
+      if (current > dtoa_expmax)
+	{
+	  idx--;
+	  continue;
+        }
+      *k = (dtoa_firstpower + idx * dtoa_steppowers);
+      return(dtoa_powers_ten[idx]);
+    }
+}
+
+#define dtoa_fracmask  0x000FFFFFFFFFFFFFU
+#define dtoa_expmask   0x7FF0000000000000U
+#define dtoa_hiddenbit 0x0010000000000000U
+#define dtoa_signmask  0x8000000000000000U
+#define dtoa_expbias   (1023 + 52)
+#define dtoa_absv(n)   ((n) < 0 ? -(n) : (n))
+#define dtoa_minv(a, b) ((a) < (b) ? (a) : (b))
+
+static uint64_t dtoa_tens[] =
+  { 10000000000000000000U, 1000000000000000000U, 100000000000000000U,
+    10000000000000000U, 1000000000000000U, 100000000000000U,
+    10000000000000U, 1000000000000U, 100000000000U,
+    10000000000U, 1000000000U, 100000000U,
+    10000000U, 1000000U, 100000U,
+    10000U, 1000U, 100U,
+    10U, 1U};
+
+static uint64_t dtoa_get_dbits(double d)
+{
+  union {double dbl; uint64_t i;} dbl_bits = {d};
+  return(dbl_bits.i);
+}
+
+static dtoa_np dtoa_build_np(double d)
+{
+  uint64_t bits = dtoa_get_dbits(d);
+  dtoa_np fp;
+  fp.frac = bits & dtoa_fracmask;
+  fp.exp = (bits & dtoa_expmask) >> 52;
+  if (fp.exp)
+    {
+      fp.frac += dtoa_hiddenbit;
+      fp.exp -= dtoa_expbias;
+    }
+  else fp.exp = -dtoa_expbias + 1;
+  return(fp);
+}
+
+static void dtoa_normalize(dtoa_np* fp)
+{
+  int32_t shift = 64 - 52 - 1;
+  while ((fp->frac & dtoa_hiddenbit) == 0)
+    {
+      fp->frac <<= 1;
+      fp->exp--;
+    }
+  fp->frac <<= shift;
+  fp->exp -= shift;
+}
+
+static void dtoa_get_normalized_boundaries(const dtoa_np* fp, dtoa_np* lower, dtoa_np* upper)
+{
+  int32_t u_shift, l_shift;
+  upper->frac = (fp->frac << 1) + 1;
+  upper->exp  = fp->exp - 1;
+  while ((upper->frac & (dtoa_hiddenbit << 1)) == 0)
+    {
+      upper->frac <<= 1;
+      upper->exp--;
+    }
+  u_shift = 64 - 52 - 2;
+  upper->frac <<= u_shift;
+  upper->exp = upper->exp - u_shift;
+  l_shift = fp->frac == dtoa_hiddenbit ? 2 : 1;
+  lower->frac = (fp->frac << l_shift) - 1;
+  lower->exp = fp->exp - l_shift;
+  lower->frac <<= lower->exp - upper->exp;
+  lower->exp = upper->exp;
+}
+
+static dtoa_np dtoa_multiply(dtoa_np* a, dtoa_np* b)
+{
+  dtoa_np fp;
+  const uint64_t lomask = 0x00000000FFFFFFFF;
+  uint64_t ah_bl = (a->frac >> 32)    * (b->frac & lomask);
+  uint64_t al_bh = (a->frac & lomask) * (b->frac >> 32);
+  uint64_t al_bl = (a->frac & lomask) * (b->frac & lomask);
+  uint64_t ah_bh = (a->frac >> 32)    * (b->frac >> 32);
+  uint64_t tmp = (ah_bl & lomask) + (al_bh & lomask) + (al_bl >> 32);
+  /* round up */
+  tmp += 1U << 31;
+  fp.frac = ah_bh + (ah_bl >> 32) + (al_bh >> 32) + (tmp >> 32);
+  fp.exp = a->exp + b->exp + 64;
+  return(fp);
+}
+
+static void dtoa_round_digit(char* digits, int32_t ndigits, uint64_t delta, uint64_t rem, uint64_t kappa, uint64_t frac)
+{
+  while ((rem < frac) && (delta - rem >= kappa) &&
+	 ((rem + kappa < frac) || (frac - rem > rem + kappa - frac)))
+    {
+      digits[ndigits - 1]--;
+      rem += kappa;
+    }
+}
+
+static int32_t dtoa_generate_digits(dtoa_np* fp, dtoa_np* upper, dtoa_np* lower, char* digits, int* K)
+{
+  uint64_t part1, part2, wfrac = upper->frac - fp->frac, delta = upper->frac - lower->frac;
+  uint64_t *unit;
+  int32_t idx = 0, kappa = 10;
+  dtoa_np one;
+
+  one.frac = 1ULL << -upper->exp;
+  one.exp  = upper->exp;
+  part1 = upper->frac >> -one.exp;
+  part2 = upper->frac & (one.frac - 1);
+
+  /* 1000000000 */
+  for (uint64_t *divp = dtoa_tens + 10; kappa > 0; divp++)
+    {
+      uint64_t tmp, div = *divp;
+      unsigned digit = part1 / div;
+      if (digit || idx)
+	digits[idx++] = digit + '0';
+      part1 -= digit * div;
+      kappa--;
+      tmp = (part1 << -one.exp) + part2;
+      if (tmp <= delta)
+	{
+	  *K += kappa;
+	  dtoa_round_digit(digits, idx, delta, tmp, div << -one.exp, wfrac);
+	  return(idx);
+        }}
+
+  /* 10 */
+  unit = dtoa_tens + 18;
+  while(true)
+    {
+      unsigned digit;
+      part2 *= 10;
+      delta *= 10;
+      kappa--;
+      digit = part2 >> -one.exp;
+      if (digit || idx)
+	digits[idx++] = digit + '0';
+      part2 &= one.frac - 1;
+      if (part2 < delta)
+	{
+	  *K += kappa;
+	  dtoa_round_digit(digits, idx, delta, part2, one.frac, wfrac * *unit);
+	  return(idx);
+	}
+      unit--;
+    }
+}
+
+static int32_t dtoa_grisu2(double d, char* digits, int* K)
+{
+  int32_t k;
+  dtoa_np cp, lower, upper;
+  dtoa_np w = dtoa_build_np(d);
+  dtoa_get_normalized_boundaries(&w, &lower, &upper);
+  dtoa_normalize(&w);
+  cp = dtoa_find_cachedpow10(upper.exp, &k);
+  w = dtoa_multiply(&w, &cp);
+  upper = dtoa_multiply(&upper, &cp);
+  lower = dtoa_multiply(&lower, &cp);
+  lower.frac++;
+  upper.frac--;
+  *K = -k;
+  return(dtoa_generate_digits(&w, &upper, &lower, digits, K));
+}
+
+static int32_t dtoa_emit_digits(char* digits, int32_t ndigits, char* dest, int32_t K, bool neg)
+{
+  int32_t idx, cent;
+  char sign;
+  int32_t exp = dtoa_absv(K + ndigits - 1);
+
+  /* write plain integer */
+  if ((K >= 0) && (exp < (ndigits + 7)))
+    {
+      memcpy(dest, digits, ndigits);
+      local_memset(dest + ndigits, '0', K);
+      dest[ndigits + K] = '.';
+      dest[ndigits + K + 1] = '0';
+      return(ndigits + K + 2);
+    }
+
+  /* write decimal w/o scientific notation */
+  if ((K < 0) && (K > -7 || exp < 4))
+    {
+      int32_t offset = ndigits - dtoa_absv(K);
+      /* fp < 1.0 -> write leading zero */
+      if (offset <= 0)
+	{
+	  offset = -offset;
+	  dest[0] = '0';
+	  dest[1] = '.';
+	  local_memset(dest + 2, '0', offset);
+	  memcpy(dest + offset + 2, digits, ndigits);
+	  return(ndigits + 2 + offset);
+	  /* fp > 1.0 */
+	}
+      else
+	{
+	  memcpy(dest, digits, offset);
+	  dest[offset] = '.';
+	  memcpy(dest + offset + 1, digits + offset, ndigits - offset);
+	  return(ndigits + 1);
+	}}
+
+  /* write decimal w/ scientific notation */
+  ndigits = dtoa_minv(ndigits, 18 - neg);
+  idx = 0;
+  dest[idx++] = digits[0];
+  if (ndigits > 1)
+    {
+      dest[idx++] = '.';
+      memcpy(dest + idx, digits + 1, ndigits - 1);
+      idx += ndigits - 1;
+    }
+  dest[idx++] = 'e';
+  sign = K + ndigits - 1 < 0 ? '-' : '+';
+  dest[idx++] = sign;
+  cent = 0;
+  if (exp > 99)
+    {
+      cent = exp / 100;
+      dest[idx++] = cent + '0';
+      exp -= cent * 100;
+    }
+  if (exp > 9)
+    {
+      int32_t dec = exp / 10;
+      dest[idx++] = dec + '0';
+      exp -= dec * 10;
+    }
+  else
+    if (cent)
+      dest[idx++] = '0';
+
+  dest[idx++] = exp % 10 + '0';
+  return(idx);
+}
+
+static int32_t dtoa_filter_special(double fp, char* dest, bool neg)
+{
+  uint64_t bits;
+  bool nan;
+  if (fp == 0.0)
+    {
+      dest[0] = '0'; dest[1] = '.'; dest[2] = '0';
+      return(3);
+    }
+  bits = dtoa_get_dbits(fp);
+  nan = (bits & dtoa_expmask) == dtoa_expmask;
+  if (!nan) return(0);
+
+  if (!neg)
+    {
+      dest[0] = '+'; /* else 1.0-nan...? */
+      dest++;
+    }
+  if (bits & dtoa_fracmask)
+    {
+      s7_int payload = nan_payload(fp);
+      int32_t len;
+      len = (int32_t)snprintf(dest, 22, "nan.%" ld64, payload);
+      return((neg) ? len : len + 1);
+    }
+  dest[0] = 'i'; dest[1] = 'n'; dest[2] = 'f'; dest[3] = '.'; dest[4] = '0';
+  return((neg) ? 5 : 6);
+}
+
+static inline int32_t fpconv_dtoa(double d, char dest[24])
+{
+  char digit[23];
+  int32_t str_len = 0, spec, K, ndigits;
+  bool neg = false;
+
+  if (dtoa_get_dbits(d) & dtoa_signmask)
+    {
+      dest[0] = '-';
+      str_len++;
+      neg = true;
+    }
+  spec = dtoa_filter_special(d, dest + str_len, neg);
+  if (spec) return(str_len + spec);
+  K = 0;
+  ndigits = dtoa_grisu2(d, digit, &K);
+  str_len += dtoa_emit_digits(digit, ndigits, dest + str_len, K, neg);
+  return(str_len);
+}
+#endif
+
+
+/* -------------------------------- number->string -------------------------------- */
+static const char dignum[] = "0123456789abcdef";
+
+static size_t integer_to_string_any_base(char *p, s7_int n, int32_t radix)  /* called by number_to_string_with_radix */
+{
+  s7_int i, len, end;
+  bool sign;
+  s7_int pown;
+
+  if ((radix < 2) || (radix > 16))
+    return(0);
+
+  if (n == S7_INT64_MIN) /* can't negate this, so do it by hand */
+    {
+      static const char *mnfs[17] = {"","",
+	"-1000000000000000000000000000000000000000000000000000000000000000", "-2021110011022210012102010021220101220222",
+	"-20000000000000000000000000000000", "-1104332401304422434310311213", "-1540241003031030222122212",
+	"-22341010611245052052301", "-1000000000000000000000", "-67404283172107811828",	"-9223372036854775808",
+	"-1728002635214590698",	"-41a792678515120368", "-10b269549075433c38", "-4340724c6c71dc7a8", "-160e2ad3246366808", "-8000000000000000"};
+
+      len = safe_strlen(mnfs[radix]);
+      memcpy((void *)p, (const void *)mnfs[radix], len);
+      p[len] = '\0';
+      return(len);
+    }
+
+  sign = (n < 0);
+  if (sign) n = -n;
+
+  /* the previous version that counted up to n, rather than dividing down below n, as here,
+   *   could be confused by large ints on 64 bit machines
+   */
+  pown = n;
+  for (i = 1; i < 100; i++)
+    {
+      if (pown < radix)
+	break;
+      pown /= (s7_int)radix;
+    }
+  len = i - 1;
+  if (sign) len++;
+  end = 0;
+  if (sign)
+    {
+      p[0] = '-';
+      end++;
+    }
+  for (i = len; i >= end; i--)
+    {
+      p[i] = dignum[n % radix];
+      n /= radix;
+    }
+  p[len + 1] = '\0';
+  return(len + 1);
+}
+
+static const char *integer_to_string(s7_scheme *sc, s7_int num, s7_int *nlen) /* do not free the returned string */
+{
+  char *p, *op;
+  bool sign;
+
+  if (num == S7_INT64_MIN)
+    {
+      (*nlen) = 20;
+      return((const char *)"-9223372036854775808");
+    }
+  p = (char *)(sc->int_to_str1 + INT_TO_STR_SIZE - 1);
+  op = p;
+  *p-- = '\0';
+
+  sign = (num < 0);
+  if (sign) num = -num;  /* we need a positive index below */
+  do {*p-- = "0123456789"[num % 10]; num /= 10;} while (num);
+  if (sign)
+    {
+      *p = '-';
+      (*nlen) = op - p;
+      return(p);
+    }
+  (*nlen) = op - p - 1;
+  return(++p);
+}
+
+static char *integer_to_string_no_length(s7_scheme *sc, s7_int num) /* do not free the returned string */
+{
+  char *p;
+  bool sign;
+
+  if (num == S7_INT64_MIN)
+    return(number_name(leastfix)); /* "-9223372036854775808" but avoids a compiler complaint */
+  p = (char *)(sc->int_to_str2 + INT_TO_STR_SIZE - 1);
+  *p-- = '\0';
+  sign = (num < 0);
+  if (sign) num = -num;
+  do {*p-- = "0123456789"[num % 10]; num /= 10;} while (num);
+  if (sign)
+    {
+      *p = '-';
+      return(p);
+    }
+  return(++p);
+}
+
+static char *floatify(char *str, s7_int *nlen)
+{
+  if ((!strchr(str, '.')) && (!strchr(str, 'e'))) /* faster than (strcspn(str, ".e") >= (size_t)(*nlen)) */
+    {
+      s7_int len = *nlen;
+      /* snprintf returns "nan" and "inf" but we (stupidly) want "+nan.0" and "+inf.0"; "-nan" and "-inf" will be handled by the normal case */
+      if (len == 3)
+	{
+	  if (str[0] == 'n')
+	    {
+	      str[0] = '+'; str[1] = 'n'; str[2] = 'a'; str[3] = 'n';
+	      len = 4;
+	    }
+	  if (str[0] == 'i')
+	    {
+	      str[0] = '+'; str[1] = 'i'; str[2] = 'n'; str[3] = 'f';
+	      len = 4;
+	    }}
+      str[len]='.';
+      str[len + 1]='0';
+      str[len + 2]='\0';
+      (*nlen) = len + 2;
+    }
+  return(str);
+}
+
+static void insert_spaces(s7_scheme *sc, const char *src, s7_int width, s7_int len)
+{
+  s7_int spaces = width - len;
+  if (width >= sc->num_to_str_size)
+    {
+      sc->num_to_str_size = width + 1;
+      sc->num_to_str = (char *)Realloc(sc->num_to_str, sc->num_to_str_size);
+    }
+  sc->num_to_str[width] = '\0';
+  memmove((void *)(sc->num_to_str + spaces), (const void *)src, len);
+  local_memset((void *)(sc->num_to_str), (int)' ', spaces);
+}
+
+static char *number_to_string_base_10(s7_scheme *sc, s7_pointer obj, s7_int width, s7_int precision,
+				      char float_choice, s7_int *nlen, use_write_t choice) /* don't free result */
+{
+  /* called by number_to_string_with_radix g_number_to_string, number_to_string_p_p number_to_port format_number */
+  /* the rest of s7 assumes nlen is set to the correct length
+   *   a tricky case: (format #f "~f" 1e308) -- tries to print 308 digits! so 256 as default len is too small.
+   *   but then even worse: (format #f "~F" 1e308+1e308i)!
+   */
+  s7_int len = width + precision;
+  len = (len > 512) ? (512 + 2 * len) : 1024;
+  if (len > sc->num_to_str_size)
+    {
+      sc->num_to_str = (sc->num_to_str) ? (char *)Realloc(sc->num_to_str, len) : (char *)Malloc(len);
+      sc->num_to_str_size = len;
+    }
+
+  /* bignums can't happen here */
+  if (is_t_integer(obj))
+    {
+      const char *p;
+      if (width == 0)
+	{
+	  if (has_number_name(obj))
+	    {
+	      (*nlen) = number_name_length(obj);
+	      return((char *)number_name(obj));
+	    }
+	  return((char *)integer_to_string(sc, integer(obj), nlen));
+	}
+      p = integer_to_string(sc, integer(obj), &len);
+      if (width > len)
+	{
+	  insert_spaces(sc, p, width, len); /* writes sc->num_to_str */
+	  (*nlen) = width;
+	  return(sc->num_to_str);
+	}
+      (*nlen) = len;
+      return((char *)p);
+    }
+
+  if (is_t_real(obj))
+    {
+      if (width == 0)
+	{
+#if WITH_DTOA
+	  if ((float_choice == 'g') &&
+	      (precision == WRITE_REAL_PRECISION))
+	    {
+	      /* (number->string 0.0000001) is sensitive to (*s7* 'float-format-precision) and inconsistent: either 1e-7 or 0.0000001
+	       *    because fpconv_dtoa has some complicated decision about 'g' vs 'f' -- not sure if this is a bug.
+	       */
+	      len = fpconv_dtoa(real(obj), sc->num_to_str);
+	      sc->num_to_str[len] = '\0';
+	      (*nlen) = len;
+	      return(sc->num_to_str);
+	    }
+#endif
+	  len = snprintf(sc->num_to_str, sc->num_to_str_size - 4,
+			 (float_choice == 'g') ? "%.*g" : ((float_choice == 'f') ? "%.*f" : "%.*e"),
+			 (int32_t)precision, real(obj)); /* -4 for floatify */
+	}
+      else len = snprintf(sc->num_to_str, sc->num_to_str_size - 4,
+			  (float_choice == 'g') ? "%*.*g" : ((float_choice == 'f') ? "%*.*f" : "%*.*e"),
+			  (int32_t)width, (int32_t)precision, real(obj)); /* -4 for floatify */
+      (*nlen) = len;
+      floatify(sc->num_to_str, nlen);
+      return(sc->num_to_str);
+    }
+
+  if (is_t_complex(obj))
+    {
+      char *imag;
+      sc->num_to_str[0] = '\0';
+      imag = copy_string(number_to_string_base_10(sc, wrap_real(sc, imag_part(obj)), 0, precision, float_choice, &len, choice));
+
+      sc->num_to_str[0] = '\0';
+      number_to_string_base_10(sc, wrap_real(sc, real_part(obj)), 0, precision, float_choice, &len, choice);
+
+      sc->num_to_str[len] = '\0';
+      len = catstrs(sc->num_to_str, sc->num_to_str_size, ((imag[0] == '+') || (imag[0] == '-')) ? "" : "+", imag, "i", (char *)NULL);
+      free(imag);
+
+      if (width > len)  /* (format #f "~20g" 1+i) */
+	{
+	  insert_spaces(sc, sc->num_to_str, width, len); /* this checks sc->num_to_str_size */
+	  (*nlen) = width;
+	}
+      else (*nlen) = len;
+      return(sc->num_to_str);
+    }
+
+  /* ratio */
+  len = catstrs_direct(sc->num_to_str, integer_to_string_no_length(sc, numerator(obj)), "/", pos_int_to_str_direct(sc, denominator(obj)), (const char *)NULL);
+  if (width > len)
+    {
+      insert_spaces(sc, sc->num_to_str, width, len);
+      (*nlen) = width;
+    }
+  else (*nlen) = len;
+  return(sc->num_to_str);
+}
+
+static block_t *number_to_string_with_radix(s7_scheme *sc, s7_pointer obj, int32_t radix, s7_int width, s7_int precision, char float_choice, s7_int *nlen)
+{
+  /* called by s7_number_to_string (char*), g_number_to_string (strp), number_to_string_p_pp (strp), format_number (strp basically) */
+  /* the rest of s7 assumes nlen is set to the correct length */
+  block_t *b;
+  char *p;
+  s7_int len, str_len;
+
+#if WITH_GMP
+  if (s7_is_bignum(obj))
+    return(big_number_to_string_with_radix(sc, obj, radix, width, nlen, P_WRITE));
+  /* this ignores precision because it's way too hard to get the mpfr string to look like
+   *   C's output -- we either have to call mpfr_get_str twice (the first time just to
+   *   find out what the exponent is and how long the string actually is), or we have
+   *   to do messy string manipulations.  So (format #f "",3F" pi) ignores the "3" and
+   *   prints the full string.  And don't even think about mpfr_snprintf!
+   */
+#endif
+  if (radix == 10)
+    {
+      p = number_to_string_base_10(sc, obj, width, precision, float_choice, nlen, P_WRITE);
+      return(string_to_block(sc, p, *nlen));
+    }
+
+  switch (type(obj))
+    {
+    case T_INTEGER:
+      {
+	size_t len1;
+	b = inline_mallocate(sc, (128 + width));
+	p = (char *)block_data(b);
+	len1 = integer_to_string_any_base(p, integer(obj), radix);
+	if ((size_t)width > len1)
+	  {
+	    size_t start = width - len1;
+	    memmove((void *)(p + start), (void *)p, len1);
+	    local_memset((void *)p, (int)' ', start);
+	    p[width] = '\0';
+	    *nlen = width;
+	  }
+	else *nlen = len1;
+	return(b);
+      }
+
+    case T_RATIO:
+      {
+	size_t len1, len2;
+	str_len = 256 + width;
+	b = inline_mallocate(sc, str_len);
+	p = (char *)block_data(b);
+	len1 = integer_to_string_any_base(p, numerator(obj), radix);
+	p[len1] = '/';
+	len2 = integer_to_string_any_base((char *)(p + len1 + 1), denominator(obj), radix);
+        len = len1 + 1 + len2;
+        p[len] = '\0';
+      }
+      break;
+
+    case T_REAL:
+      {
+	int32_t i;
+	s7_int int_part, nsize;
+	s7_double x = real(obj), frac_part, min_frac, base;
+	bool sign = false;
+	char n[128], d[256];
+
+	if (is_NaN(x))
+	  return(string_to_block(sc, "+nan.0", *nlen = 6));
+	if (is_inf(x))
+	  {
+	    if (x < 0.0)
+	      return(string_to_block(sc, "-inf.0", *nlen = 6));
+	    return(string_to_block(sc, "+inf.0", *nlen = 6));
+	  }
+	if (x < 0.0)
+	  {
+	    sign = true;
+	    x = -x;
+	  }
+	if (x > 1.0e18) /* i.e. close to or greater than most-positive-fixnum (9.22e18), so the code below is unlikely to work, (format #f "~X" 1e19) */
+	  {
+	    int32_t ep = (int32_t)floor(log(x) / log((double)radix));
+	    block_t *b1;
+	    len = 0;
+	    b = number_to_string_with_radix(sc, wrap_real(sc, x / pow((double)radix, (double)ep)), /* divide it down to one digit, then the fractional part */
+					    radix, width, precision, float_choice, &len);
+	    b1 = inline_mallocate(sc, len + 8);
+	    p = (char *)block_data(b1);
+	    p[0] = '\0';
+	    (*nlen) = catstrs(p, len + 8, (sign) ? "-" : "", (char *)block_data(b), (radix == 16) ? "@" : "e", integer_to_string_no_length(sc, ep), (char *)NULL);
+	    liberate(sc, b);
+	    return(b1);
+	  }
+
+	int_part = (s7_int)floor(x);
+	frac_part = x - int_part;
+	nsize = integer_to_string_any_base(n, int_part, radix);
+	min_frac = dpow(radix, -precision);
+
+	/* doesn't this assume precision < 128/256 and that we can fit in 256 digits (1e308)? */
+	for (i = 0, base = radix; (i < precision) && (frac_part > min_frac); i++, base *= radix)
+	  {
+	    s7_int ipart = (s7_int)(frac_part * base);
+	    if (ipart >= radix)         /* rounding confusion */
+	      ipart = radix - 1;
+	    frac_part -= (ipart / base);
+	    /* d[i] = ((const char *)"0123456789abcdef")[ipart]; */
+	    d[i] = dignum[ipart];
+	  }
+	if (i == 0)
+	  d[i++] = '0';
+	d[i] = '\0';
+	b = inline_mallocate(sc, 256);
+        p = (char *)block_data(b);
+	/* much faster than catstrs because we know the string lengths */
+	{
+	  char *pt = p;
+	  if (sign) {pt[0] = '-'; pt++;}
+	  memcpy(pt, n, nsize);
+	  pt += nsize;
+	  pt[0] = '.';
+	  pt++;
+	  memcpy(pt, d, i);
+	  pt[i] = '\0';
+	  /* len = ((sign) ? 1 : 0) + 1 + nsize + i; */
+	  len = pt + i - p;
+	}
+	str_len = 256;
+      }
+      break;
+
+    default:
+      {
+	char *pt;
+	s7_int real_len = 0, imag_len = 0;
+	block_t *n = number_to_string_with_radix(sc, wrap_real(sc, real_part(obj)), radix, 0, precision, float_choice, &real_len); /* include floatify */
+	block_t *d = number_to_string_with_radix(sc, wrap_real(sc, imag_part(obj)), radix, 0, precision, float_choice, &imag_len);
+	char *dp = (char *)block_data(d);
+	b = inline_mallocate(sc, 512);
+	p = (char *)block_data(b);
+	pt = p;
+	memcpy(pt, (void *)block_data(n), real_len);
+	pt += real_len;
+	if ((dp[0] != '+') && (dp[0] != '-')) {pt[0] = '+'; pt++;}
+	memcpy(pt, dp, imag_len);
+	pt[imag_len] = 'i';
+	pt[imag_len + 1] = '\0';
+	len = pt + imag_len + 1 - p;
+	str_len = 512;
+	liberate(sc, n);
+	liberate(sc, d);
+      }
+      break;
+    }
+
+  if (width > len)
+    {
+      s7_int spaces;
+      if (width >= str_len)
+	{
+	  str_len = width + 1;
+	  b = reallocate(sc, b, str_len);
+	  p = (char *)block_data(b);
+	}
+      spaces = width - len;
+      p[width] = '\0';
+      memmove((void *)(p + spaces), (void *)p, len);
+      local_memset((void *)p, (int)' ', spaces);
+      (*nlen) = width;
+    }
+  else (*nlen) = len;
+  return(b);
+}
+
+char *s7_number_to_string(s7_scheme *sc, s7_pointer obj, s7_int radix)
+{
+  s7_int nlen = 0;
+  block_t *b = number_to_string_with_radix(sc, obj, radix, 0, 20, 'g', &nlen);  /* (log top 10) so we get all the digits in base 10 (??) */
+  char *str = copy_string_with_length((char *)block_data(b), nlen);
+  liberate(sc, b);
+  return(str);
+}
+
+static s7_pointer g_number_to_string(s7_scheme *sc, s7_pointer args)
+{
+  #define H_number_to_string "(number->string num (radix 10)) converts the number num into a string."
+  #define Q_number_to_string s7_make_signature(sc, 3, sc->is_string_symbol, sc->is_number_symbol, sc->is_integer_symbol)
+
+  s7_int nlen = 0, radix; /* ignore cppcheck complaint about radix! */
+  const char *res;
+  s7_pointer x = car(args);
+
+  if (!is_number(x))
+    return(method_or_bust(sc, x, sc->number_to_string_symbol, args, a_number_string, 1));
+
+  if (is_pair(cdr(args)))
+    {
+      s7_pointer y = cadr(args);
+      if (s7_is_integer(y))
+	radix = s7_integer_clamped_if_gmp(sc, y);
+      else return(method_or_bust(sc, y, sc->number_to_string_symbol, args, sc->type_names[T_INTEGER], 2));
+      if ((radix < 2) || (radix > 16))
+	out_of_range_error_nr(sc, sc->number_to_string_symbol, int_two, y, a_valid_radix_string);
+#if (WITH_GMP)
+      if (!s7_is_bignum(x))
+#endif
+	{
+	  block_t *b = number_to_string_with_radix(sc, x, radix, 0, sc->float_format_precision, 'g', &nlen);
+	  return(block_to_string(sc, b, nlen));
+	}}
+#if WITH_GMP
+  else radix = 10;
+  if (s7_is_bignum(x))
+    {
+      block_t *b = big_number_to_string_with_radix(sc, x, radix, 0, &nlen, P_WRITE);
+      return(block_to_string(sc, b, nlen));
+    }
+  res = number_to_string_base_10(sc, x, 0, sc->float_format_precision, 'g', &nlen, P_WRITE);
+#else
+  if (is_t_integer(x))
+    {
+      if (has_number_name(x))
+	{
+	  nlen = number_name_length(x);
+	  res = (const char *)number_name(x);
+	}
+      else res = integer_to_string(sc, integer(x), &nlen);
+    }
+  else res = number_to_string_base_10(sc, x, 0, sc->float_format_precision, 'g', &nlen, P_WRITE);
+#endif
+  return(inline_make_string_with_length(sc, res, nlen));
+}
+
+static s7_pointer number_to_string_p_p(s7_scheme *sc, s7_pointer p)
+{
+#if WITH_GMP
+  return(g_number_to_string(sc, set_plist_1(sc, p)));
+#else
+  s7_int nlen = 0;
+  char *res;
+  if (!is_number(p))
+    return(method_or_bust_p(sc, p, sc->number_to_string_symbol, a_number_string));
+  res = number_to_string_base_10(sc, p, 0, sc->float_format_precision, 'g', &nlen, P_WRITE);
+  return(inline_make_string_with_length(sc, res, nlen));
+#endif
+}
+
+static s7_pointer number_to_string_p_i(s7_scheme *sc, s7_int p)
+{
+  s7_int nlen = 0;
+  const char *res = integer_to_string(sc, p, &nlen);
+  return(inline_make_string_with_length(sc, res, nlen));
+}
+/* not number_to_string_p_d! */
+
+static s7_pointer number_to_string_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+#if WITH_GMP
+  return(g_number_to_string(sc, set_plist_2(sc, p1, p2)));
+#else
+  s7_int nlen = 0, radix;
+  block_t *b;
+
+  if (!is_number(p1))
+    wrong_type_error_nr(sc, sc->number_to_string_symbol, 1, p1, a_number_string);
+  if (!is_t_integer(p2))
+    wrong_type_error_nr(sc, sc->number_to_string_symbol, 2, p2, sc->type_names[T_INTEGER]);
+  radix = integer(p2);
+  if ((radix < 2) || (radix > 16))
+    out_of_range_error_nr(sc, sc->number_to_string_symbol, int_two, p2, a_valid_radix_string);
+
+  b = number_to_string_with_radix(sc, p1, radix, 0, sc->float_format_precision, 'g', &nlen);
+  return(block_to_string(sc, b, nlen));
+#endif
+}
+
+
+/* -------------------------------------------------------------------------------- */
+#define CTABLE_SIZE 256
+static bool *exponent_table, *slashify_table, *char_ok_in_a_name, *white_space, *number_table, *symbol_slashify_table;
+static int32_t *digits;
+
+static void init_ctables(void)
+{
+  exponent_table = (bool *)Calloc(CTABLE_SIZE, sizeof(bool));
+  slashify_table = (bool *)Calloc(CTABLE_SIZE, sizeof(bool));
+  symbol_slashify_table = (bool *)Calloc(CTABLE_SIZE, sizeof(bool));
+  char_ok_in_a_name = (bool *)Calloc(CTABLE_SIZE, sizeof(bool));
+  white_space = (bool *)Calloc(CTABLE_SIZE + 1, sizeof(bool));
+  white_space++;      /* leave white_space[-1] false for white_space[EOF] */
+  number_table = (bool *)Calloc(CTABLE_SIZE, sizeof(bool));
+  digits = (int32_t *)Calloc(CTABLE_SIZE, sizeof(int32_t));
+
+  for (int32_t i = 0; i < CTABLE_SIZE; i++)
+    {
+      char_ok_in_a_name[i] = true;
+      white_space[i] = false;
+      digits[i] = 256;
+      number_table[i] = false;
+    }
+
+  char_ok_in_a_name[0] = false;
+  char_ok_in_a_name[(uint8_t)'('] = false;  /* cast for C++ */
+  char_ok_in_a_name[(uint8_t)')'] = false;
+  char_ok_in_a_name[(uint8_t)';'] = false;
+  char_ok_in_a_name[(uint8_t)'\t'] = false;
+  char_ok_in_a_name[(uint8_t)'\n'] = false;
+  char_ok_in_a_name[(uint8_t)'\r'] = false;
+  char_ok_in_a_name[(uint8_t)' '] = false;
+  char_ok_in_a_name[(uint8_t)'"'] = false;
+
+  white_space[(uint8_t)'\t'] = true;
+  white_space[(uint8_t)'\n'] = true;
+  white_space[(uint8_t)'\r'] = true;
+  white_space[(uint8_t)'\f'] = true;
+  white_space[(uint8_t)'\v'] = true;
+  white_space[(uint8_t)' '] = true;
+  white_space[(uint8_t)'\205'] = true; /* 133 */
+  white_space[(uint8_t)'\240'] = true; /* 160 */
+
+  /* surely only 'e' is needed... */
+  exponent_table[(uint8_t)'e'] = true; exponent_table[(uint8_t)'E'] = true;
+  exponent_table[(uint8_t)'@'] = true;
+#if WITH_EXTRA_EXPONENT_MARKERS
+  exponent_table[(uint8_t)'s'] = true; exponent_table[(uint8_t)'S'] = true;
+  exponent_table[(uint8_t)'f'] = true; exponent_table[(uint8_t)'F'] = true;
+  exponent_table[(uint8_t)'d'] = true; exponent_table[(uint8_t)'D'] = true;
+  exponent_table[(uint8_t)'l'] = true; exponent_table[(uint8_t)'L'] = true;
+#endif
+  for (int32_t i = 0; i < 32; i++) slashify_table[i] = true;
+  /* for (int32_t i = 127; i < 160; i++) slashify_table[i] = true; */ /* 6-Apr-24 for utf-8, but this has no effect on s7test?? */
+  slashify_table[(uint8_t)'\\'] = true;
+  slashify_table[(uint8_t)'"'] = true;
+  slashify_table[(uint8_t)'\n'] = false;
+
+  for (int32_t i = 0; i < CTABLE_SIZE; i++)
+    symbol_slashify_table[i] = ((slashify_table[i]) || (!char_ok_in_a_name[i])); /* force use of (symbol ...) for cases like '(ab) as symbol */
+
+  digits[(uint8_t)'0'] = 0; digits[(uint8_t)'1'] = 1; digits[(uint8_t)'2'] = 2; digits[(uint8_t)'3'] = 3; digits[(uint8_t)'4'] = 4;
+  digits[(uint8_t)'5'] = 5; digits[(uint8_t)'6'] = 6; digits[(uint8_t)'7'] = 7; digits[(uint8_t)'8'] = 8; digits[(uint8_t)'9'] = 9;
+  digits[(uint8_t)'a'] = 10; digits[(uint8_t)'A'] = 10;
+  digits[(uint8_t)'b'] = 11; digits[(uint8_t)'B'] = 11;
+  digits[(uint8_t)'c'] = 12; digits[(uint8_t)'C'] = 12;
+  digits[(uint8_t)'d'] = 13; digits[(uint8_t)'D'] = 13;
+  digits[(uint8_t)'e'] = 14; digits[(uint8_t)'E'] = 14;
+  digits[(uint8_t)'f'] = 15; digits[(uint8_t)'F'] = 15;
+
+  number_table[(uint8_t)'0'] = true; number_table[(uint8_t)'1'] = true; number_table[(uint8_t)'2'] = true; number_table[(uint8_t)'3'] = true;
+  number_table[(uint8_t)'4'] = true; number_table[(uint8_t)'5'] = true; number_table[(uint8_t)'6'] = true; number_table[(uint8_t)'7'] = true;
+  number_table[(uint8_t)'8'] = true; number_table[(uint8_t)'9'] = true; number_table[(uint8_t)'.'] = true;
+  number_table[(uint8_t)'+'] = true;
+  number_table[(uint8_t)'-'] = true;
+  number_table[(uint8_t)'#'] = true;
+}
+
+#define is_white_space(C) white_space[C]
+  /* this is much faster than C's isspace, and does not depend on the current locale.
+   * if c == EOF (-1), it indexes into the empty (0) slot we preallocated below white_space
+   */
+
+/* -------------------------------- *#readers* -------------------------------- */
+static s7_pointer check_sharp_readers(s7_scheme *sc, const char *name)
+{
+  s7_pointer value = sc->F, args = sc->F;
+  bool need_loader_port = is_loader_port(current_input_port(sc));
+
+  /* *#reader* is assumed to be an alist of (char . proc)
+   *    where each proc takes one argument, the string from just beyond the "#" to the next delimiter.
+   *    The procedure can call read-char to read ahead in the current-input-port.
+   *    If it returns anything other than #f, that is the value of the sharp expression.
+   *    Since #f means "nothing found", it is tricky to handle #F:
+   *       (cons #\F (lambda (str) (and (string=? str "F") (list 'not #t)))) ; or ''#f used in lint.scm
+   * This search happens after #|, #t, and #f (and #nD for multivectors?). #! has a fallback.  Added #_ later)
+   */
+  if (need_loader_port)
+    clear_loader_port(current_input_port(sc));
+
+  /* normally read* can't read from current_input_port(sc) if it is in use by the loader, but here we are deliberately making that possible */
+  for (s7_pointer reader = slot_value(sc->sharp_readers); is_not_null(reader); reader = cdr(reader))
+    if (name[0] == s7_character(caar(reader)))
+      {
+	if (args == sc->F)
+	  args = set_plist_1(sc, wrap_string(sc, name, safe_strlen(name)));
+	/* args is GC protected by s7_apply_function?? (placed on the stack) */
+	value = s7_apply_function(sc, cdar(reader), args); /* this is much less error-safe than s7_call */
+	if (value != sc->F)
+	  break;
+      }
+  if (need_loader_port)
+    set_loader_port(current_input_port(sc));
+  return(value);
+}
+
+static s7_pointer g_sharp_readers_set(s7_scheme *sc, s7_pointer args)
+{
+  /* new value must be either () or a proper list of conses (char . func) */
+  s7_pointer x;
+  if (is_null(cadr(args))) return(cadr(args));
+  if (!is_pair(cadr(args)))
+    error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "can't set *#readers* to ~S", 26), cadr(args)));
+  for (x = cadr(args); is_pair(x); x = cdr(x))
+    if ((!is_pair(car(x))) ||
+	(!is_character(caar(x))) ||
+	(!is_procedure(cdar(x))))
+      error_nr(sc, sc->wrong_type_arg_symbol,
+	       set_elist_2(sc, wrap_string(sc, "can't set *#readers* to ~S", 26), cadr(args)));
+  if (!is_null(x))
+    error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "can't set *#readers* to ~S", 26), cadr(args)));
+  return(cadr(args));
+}
+
+static s7_pointer make_undefined(s7_scheme *sc, const char* name)
+{
+  s7_int len = safe_strlen(name);
+  char *newstr = (char *)Malloc(len + 2);
+  s7_pointer p;
+  new_cell(sc, p, T_UNDEFINED | T_IMMUTABLE);
+  newstr[0] = '#';
+  memcpy((void *)(newstr + 1), (const void *)name, len);
+  newstr[len + 1] = '\0';
+  if (sc->undefined_constant_warnings) s7_warn(sc, len + 32, "%s is undefined\n", newstr);
+  undefined_set_name_length(p, len + 1);
+  undefined_name(p) = newstr;
+  add_undefined(sc, p);
+  return(p);
+}
+
+static int32_t inchar(s7_pointer pt)
+{
+  int32_t c;
+  if (is_file_port(pt))
+    c = fgetc(port_file(pt)); /* not uint8_t! -- could be EOF */
+  else
+    {
+      if (port_data_size(pt) <= port_position(pt))
+	return(EOF);
+      c = (uint8_t)port_data(pt)[port_position(pt)++];
+    }
+  if (c == '\n')
+    port_line_number(pt)++;
+  return(c);
+}
+
+static void backchar(char c, s7_pointer pt)
+{
+  if (c == '\n')
+    port_line_number(pt)--;
+
+  if (is_file_port(pt))
+    ungetc(c, port_file(pt));
+  else
+    if (port_position(pt) > 0)
+      port_position(pt)--;
+}
+
+static void resize_strbuf(s7_scheme *sc, s7_int needed_size)
+{
+  s7_int old_size = sc->strbuf_size;
+  while (sc->strbuf_size <= needed_size) sc->strbuf_size *= 2;
+  sc->strbuf = (char *)Realloc(sc->strbuf, sc->strbuf_size);
+  for (s7_int i = old_size; i < sc->strbuf_size; i++) sc->strbuf[i] = '\0';
+}
+
+static s7_pointer *chars;
+
+static s7_pointer unknown_sharp_constant(s7_scheme *sc, const char *name, s7_pointer pt)
+{
+  /* if name[len - 1] != '>' there's no > delimiter at the end */
+
+  if (hook_has_functions(sc->read_error_hook))  /* check *read-error-hook* */
+    {
+      bool old_history_enabled = s7_set_history_enabled(sc, false); /* see sc->error_hook for a more robust way to handle this */
+      s7_pointer result = s7_call(sc, sc->read_error_hook, set_plist_2(sc, sc->T, wrap_string(sc, name, safe_strlen(name))));
+      s7_set_history_enabled(sc, old_history_enabled);
+      if (result != sc->unspecified)
+	return(result);
+    }
+  if (pt) /* #<"..."> which gets here as name="#<" */
+    {
+      s7_int len = safe_strlen(name);
+      if ((name[len - 1] != '>') &&
+	  (is_input_port(pt)) &&
+	  (pt != sc->standard_input))
+	{
+	  if (s7_peek_char(sc, pt) != chars[(uint8_t)'"']) /* if not #<"...">, just return it */
+	    return(make_undefined(sc, name));
+	  /* PERHAPS: strchr port-data '>'?? it might be #<x y> etc -- what would this break? maybe extend section below */
+
+	  if (is_string_port(pt)) /* probably unnecessary (see below) */
+	    {
+	      s7_int c = inchar(pt);
+	      const char *pstart = (const char *)(port_data(pt) + port_position(pt));
+	      const char *p = strchr(pstart, (int)'"');
+	      s7_int added_len;
+	      char *buf;
+	      s7_pointer res;
+
+	      if (!p)
+		{
+		  backchar(c, pt);
+		  return(make_undefined(sc, name));
+		}
+	      p++;
+	      while (char_ok_in_a_name[(uint8_t)(*p)]) {p++;}
+	      added_len = (s7_int)(p - pstart);                 /* p is one past '>' presumably */
+	      /* we can't use strbuf here -- it might be the source of the "name" argument! */
+	      buf = (char *)Malloc(len + added_len + 2);
+	      memcpy((void *)buf, (const void *)name, len);
+	      buf[len] = '"';                                   /* from inchar */
+	      memcpy((void *)(buf + len + 1), (const void *)pstart, added_len);
+	      buf[len + added_len + 1] = 0;
+	      port_position(pt) += added_len;
+	      res = make_undefined(sc, (const char *)buf);
+	      free(buf);
+	      return(res);
+	    }}}
+  return(make_undefined(sc, name));
+}
+
+static s7_pointer make_atom(s7_scheme *sc, char *q, int32_t radix, bool want_symbol, bool with_error);
+#define SYMBOL_OK true
+#define NO_SYMBOLS false
+
+static s7_pointer make_sharp_constant(s7_scheme *sc, const char *name, bool with_error, s7_pointer pt, bool error_if_bad_number)
+{
+  /* name is the stuff after the '#', return sc->nil if not a recognized #... entity */
+  if ((!name) || (!*name)) /* (string->number "#") for example */
+    return(make_undefined(sc, name));
+
+  /* stupid r7rs special cases */
+  if ((name[0] == 't') &&
+      ((name[1] == '\0') || (c_strings_are_equal(name, "true"))))
+    return(sc->T);
+
+  if ((name[0] == 'f') &&
+      ((name[1] == '\0') || (c_strings_are_equal(name, "false"))))
+    return(sc->F);
+
+  if (name[0] == '_')
+    {
+      /* this needs to be unsettable via *#readers*:
+       *    (set! *#readers* (list (cons #\_ (lambda (str) (string->symbol (substring str 1))))))
+       *    (let ((+ -)) (#_+ 1 2)): -1
+       */
+      s7_pointer sym = make_symbol_with_strlen(sc, (const char *)(name + 1));
+      if ((!is_gensym(sym)) && (initial_value(sym) != sc->undefined))
+	return(initial_value(sym));
+      /* here we should not necessarily raise an error that *_... is undefined.  reader-cond, for example, needs to
+       *    read undefined #_ vals that it will eventually discard.
+       */
+      return(make_undefined(sc, name));    /* (define x (with-input-from-string "(#_asdf 1 2)" read)) (type-of (car x)) -> undefined? */
+    }
+
+  if (is_not_null(slot_value(sc->sharp_readers)))
+    {
+      s7_pointer x = check_sharp_readers(sc, name);
+      if (x != sc->F)
+	return(x);
+    }
+
+  if ((name[0] == '\0') || name[1] == '\0')
+    return(unknown_sharp_constant(sc, name, pt)); /* pt here because #<"..."> comes here as "<" so name[1] is '\0'! */
+
+  switch (name[0])
+    {
+      /* -------- #< ... > -------- */
+    case '<':
+      if (c_strings_are_equal(name, "<unspecified>")) return(sc->unspecified);
+      if (c_strings_are_equal(name, "<undefined>"))   return(sc->undefined);
+      if (c_strings_are_equal(name, "<eof>"))         return(eof_object);
+      return(unknown_sharp_constant(sc, name, pt));
+
+      /* -------- #o #x #b -------- */
+    case 'o':   /* #o (octal) */
+    case 'x':   /* #x (hex) */
+    case 'b':   /* #b (binary) */
+      {
+	s7_pointer res = make_atom(sc, (char *)(name + 1), (name[0] == 'o') ? 8 : ((name[0] == 'x') ? 16 : 2), NO_SYMBOLS, with_error);
+	if ((error_if_bad_number) && (res == sc->F)) /* #b32 etc but not if called from string->number */
+	  error_nr(sc, sc->read_error_symbol, set_elist_2(sc, wrap_string(sc, "#~A is not a number", 19), wrap_string(sc, name, safe_strlen(name))));
+	return(res);
+      }
+
+      /* -------- #\... -------- */
+    case '\\':
+      if (name[2] == 0)                             /* the most common case: #\a */
+	return(chars[(uint8_t)(name[1])]);
+      /* not uint32_t here!  (uint32_t)255 (as a char) returns -1!! */
+      switch (name[1])
+	{
+	case 'n':
+	  if ((c_strings_are_equal(name + 1, "null")) ||
+	      (c_strings_are_equal(name + 1, "nul")))
+	    return(chars[0]);
+
+	  if (c_strings_are_equal(name + 1, "newline"))
+	    return(chars[(uint8_t)'\n']);
+	  break;
+
+	case 's': if (c_strings_are_equal(name + 1, "space"))     return(chars[(uint8_t)' ']);  break;
+	case 'r': if (c_strings_are_equal(name + 1, "return"))    return(chars[(uint8_t)'\r']); break;
+	case 'l': if (c_strings_are_equal(name + 1, "linefeed"))  return(chars[(uint8_t)'\n']); break;
+	case 't': if (c_strings_are_equal(name + 1, "tab"))       return(chars[(uint8_t)'\t']); break;
+	case 'a': if (c_strings_are_equal(name + 1, "alarm"))     return(chars[7]);             break;
+	case 'b': if (c_strings_are_equal(name + 1, "backspace")) return(chars[8]);             break;
+	case 'e': if (c_strings_are_equal(name + 1, "escape"))    return(chars[0x1b]);          break;
+	case 'd': if (c_strings_are_equal(name + 1, "delete"))    return(chars[0x7f]);          break;
+
+	case 'x':
+	  /* #\x is just x, but apparently #\x<num> is int->char? #\x65 -> #\e, and #\xcebb is lambda? */
+	  {
+	    /* sscanf here misses errors like #\x1.4, but make_atom misses #\x6/3,
+	     *   #\x#b0, #\x#e0.0, #\x-0, #\x#e0e100 etc, so we have to do it at an even lower level.
+	     * another problem: #\xbdca2cbec overflows so lval is -593310740 -> segfault unless caught
+	     */
+	    bool happy = true;
+	    const char *tmp = (const char *)(name + 2);
+	    int32_t lval = 0;
+
+	    while ((*tmp) && (happy) && (lval >= 0) && (lval < 256))
+	      {
+		int32_t dig = digits[(int32_t)(*tmp++)];
+		if (dig < 16)
+		  lval = dig + (lval * 16);
+		else happy = false;
+	      }
+	    if ((happy) &&
+		(lval < 256) &&
+		(lval >= 0))
+	      return(chars[lval]);
+	  }
+	  break;
+	}}
+  return(unknown_sharp_constant(sc, name, NULL));
+}
+
+static s7_int string_to_integer(const char *str, int32_t radix, bool *overflow)
+{
+  bool negative = false;
+  s7_int lval = 0;
+  int32_t dig;
+  const char *tmp = (const char *)str;
+#if WITH_GMP
+  const char *tmp1;
+#endif
+  if (str[0] == '+')
+    tmp++;
+  else
+    if (str[0] == '-')
+      {
+	negative = true;
+	tmp++;
+      }
+  while (*tmp == '0') {tmp++;};
+#if WITH_GMP
+  tmp1 = tmp;
+#endif
+ if (radix == 10)
+    {
+      while (true)
+	{
+	  dig = digits[(uint8_t)(*tmp++)];
+	  if (dig > 9) break;
+#if HAVE_OVERFLOW_CHECKS
+	  if ((multiply_overflow(lval, (s7_int)10, &lval)) ||
+	      (add_overflow(lval, (s7_int)dig, &lval)))
+	    {
+	      if ((radix == 10) &&
+		  (strncmp(str, "-9223372036854775808", 20) == 0) &&
+		  (digits[(uint8_t)(*tmp++)] > 9)) /* i.e. next thing is not a digit -- "/" for example */
+		return(S7_INT64_MIN);
+	      *overflow = true;
+	      return((negative) ? S7_INT64_MIN : S7_INT64_MAX);
+	    }
+#else
+	  lval = dig + (lval * 10);
+	  dig = digits[(uint8_t)(*tmp++)];
+	  if (dig > 9) break;
+	  lval = dig + (lval * 10);
+#endif
+	}}
+  else
+    while (true)
+      {
+	dig = digits[(uint8_t)(*tmp++)];
+	if (dig >= radix) break;
+#if HAVE_OVERFLOW_CHECKS && (!WITH_GMP)
+	{
+	  s7_int oval = 0;
+	  if (multiply_overflow(lval, (s7_int)radix, &oval))
+	    {
+	      /* maybe a bad idea!  #xffffffffffffffff -> -1??? this is needed for 64-bit number hacks (see s7test.scm bit-reverse) */
+	      if ((radix == 16) &&
+		  (digits[(uint8_t)(*tmp)] >= radix))
+		{
+		  lval -= 576460752303423488LL; /* turn off sign bit */
+		  lval *= radix;
+		  lval += dig;
+		  lval -= 9223372036854775807LL;
+		  return(lval - 1);
+		}
+	      lval = oval; /* old case */
+	      if ((lval == S7_INT64_MIN)  && (digits[(uint8_t)(*tmp++)] > 9))
+		return(lval);
+	      *overflow = true;
+	      break;
+	    }
+	  else lval = oval;
+	  if (add_overflow(lval, (s7_int)dig, &lval))
+	    {
+	      if (lval == S7_INT64_MIN) return(lval);
+	      *overflow = true;
+	      break;
+	    }}
+#else
+	lval = dig + (lval * radix);
+	dig = digits[(uint8_t)(*tmp++)];
+	if (dig >= radix) break;
+	lval = dig + (lval * radix);
+#endif
+      }
+
+#if WITH_GMP
+ if (!(*overflow))
+   (*overflow) = ((lval > S7_INT32_MAX) ||
+		  ((tmp - tmp1) > s7_int_digits_by_radix[radix]));
+  /* this tells the string->number readers to create a bignum.  We need to be very conservative here to catch contexts such as (/ 1/524288 19073486328125) */
+#endif
+  return((negative) ? -lval : lval);
+}
+
+/*  9223372036854775807                9223372036854775807
+ * -9223372036854775808               -9223372036854775808
+ * 0000000000000000000000000001.0     1.0
+ * 1.0000000000000000000000000000     1.0
+ * 1000000000000000000000000000.0e-40 1.0e-12
+ * 0.0000000000000000000000000001e40  1.0e12
+ * 1.0e00000000000000000001           10.0
+ */
+
+#if WITH_GMP
+static s7_double string_to_double_with_radix(const char *ur_str, int32_t radix, bool *overflow)
+#else
+#define string_to_double_with_radix(Str, Rad, Over) string_to_double_with_radix_1(Str, Rad)
+static s7_double string_to_double_with_radix_1(const char *ur_str, int32_t radix)
+#endif
+{
+  /* strtod follows LANG which is not what we want (only "." is decimal point in Scheme).
+   *   To overcome LANG in strtod would require screwing around with setlocale which never works.
+   *   So we use our own code -- according to valgrind, this function is much faster than strtod.
+   * comma as decimal point causes ambiguities: `(+ ,1 2) etc
+   */
+  int32_t i, sign = 1, frac_len, int_len, dig, exponent = 0;
+  int32_t max_len = s7_int_digits_by_radix[radix];
+  int64_t int_part = 0, frac_part = 0;
+  const char *str = ur_str;
+  const char *ipart, *fpart;
+  s7_double dval = 0.0;
+
+  /* there's an ambiguity in number notation here if we allow "1e1" or "1.e1" in base 16 (or 15) -- is e a digit or an exponent marker?
+   *   but 1e+1, for example disambiguates it -- kind of messy! -- the scheme spec says "e" can only occur in base 10.
+   * '@' can now be used as the exponent marker (26-Mar-12).
+   * Another slight ambiguity: 1+1/2i is parsed as 1 + 0.5i, not 1+1/(2i), or (1+1)/(2i) or (1+1/2)i etc
+   */
+  if (*str == '-')
+    {
+      str++;
+      sign = -1;
+    }
+  else
+    if (*str == '+')
+      str++;
+  while (*str == '0') {str++;};
+
+  ipart = str;
+  while (digits[(int32_t)(*str)] < radix) str++;
+  int_len = str - ipart;
+
+  if (*str == '.') str++;
+  fpart = str;
+  while (digits[(int32_t)(*str)] < radix) str++;
+  frac_len = str - fpart;
+
+  if ((*str) && (exponent_table[(uint8_t)(*str)]))
+    {
+      bool exp_negative = false;
+      str++;
+      if (*str == '+')
+	str++;
+      else
+	if (*str == '-')
+	  {
+	    str++;
+	    exp_negative = true;
+	  }
+      while ((dig = digits[(int32_t)(*str++)]) < 10) /* exponent itself is always base 10 */
+	{
+#if HAVE_OVERFLOW_CHECKS
+	  if ((int32_multiply_overflow(exponent, 10, &exponent)) ||
+	      (int32_add_overflow(exponent, dig, &exponent)))
+	    {
+	      exponent = 1000000; /* see below */
+	      break;
+	    }
+#else
+	  exponent = dig + (exponent * 10);
+#endif
+	}
+#if (!defined(__GNUC__)) || ((__GNUC__ < 5) && (!defined(__clang__)))
+      if (exponent < 0)         /* we overflowed, so make sure we notice it below (need to check for 0.0e... first) (Brian Damgaard) */
+	exponent = 1000000;     /*   see below for examples -- this number needs to be very big but not too big for add */
+#endif
+      if (exp_negative)
+	exponent = -exponent;
+
+      /*           2e12341234123123123123213123123123 -> 0.0
+       * but exp len is not the decider: 2e00000000000000000000000000000000000000001 -> 20.0
+       * first zero: 2e123412341231231231231
+       * then:     2e12341234123123123123123123 -> inf
+       * then:     2e123412341231231231231231231231231231 -> 0.0
+       *           2e-123412341231231231231 -> inf
+       * but:      0e123412341231231231231231231231231231
+       */
+    }
+
+#if WITH_GMP
+  /* 9007199254740995.0 */
+  if (int_len + frac_len >= max_len)
+    {
+      (*overflow) = true;
+      return(0.0);
+    }
+#endif
+  str = ipart;
+  if ((int_len + exponent) > max_len)
+    {
+      /*  12341234.56789e12                   12341234567889999872.0              1.234123456789e+19
+       * -1234567890123456789.0              -1234567890123456768.0              -1.2345678901235e+18
+       *  12345678901234567890.0              12345678901234567168.0              1.2345678901235e+19
+       *  123.456e30                          123456000000000012741097792995328.0 1.23456e+32
+       *  12345678901234567890.0e12           12345678901234569054409354903552.0  1.2345678901235e+31
+       *  1.234567890123456789012e30          1234567890123456849145940148224.0   1.2345678901235e+30
+       *  1e20                                100000000000000000000.0             1e+20
+       *  1234567890123456789.0               1234567890123456768.0               1.2345678901235e+18
+       *  123.456e16                          1234560000000000000.0               1.23456e+18
+       *  98765432101234567890987654321.0e-5  987654321012345728401408.0          9.8765432101235e+23
+       *  98765432101234567890987654321.0e-10 9876543210123456512.0               9.8765432101235e+18
+       *  0.00000000000000001234e20           1234.0
+       *  0.000000000000000000000000001234e30 1234.0
+       *  0.0000000000000000000000000000000000001234e40 1234.0
+       *  0.000000000012345678909876543210e15 12345.678909877
+       *  0e1000                              0.0
+       */
+
+      for (i = 0; i < max_len; i++)
+	{
+	  dig = digits[(int32_t)(*str++)];
+	  if (dig < radix)
+	    int_part = dig + (int_part * radix);
+	  else break;
+	}
+
+      /* if the exponent is huge, check for 0 int_part and frac_part before complaining (0e1000 or 0.0e1000)
+       */
+      if ((int_part == 0) &&
+	  (exponent > max_len))
+	{
+	  /* if frac_part is also 0, return 0.0 */
+	  if (frac_len == 0) return(0.0);
+	  str = fpart;
+	  while ((dig = digits[(int32_t)(*str++)]) < radix)
+	    frac_part = dig + (frac_part * radix);
+	  if (frac_part == 0) return(0.0);
+#if WITH_GMP
+	  (*overflow) = true;
+#endif
+	}
+#if WITH_GMP
+      (*overflow) = ((int_part > 0) || (exponent > 20));    /* .1e310 is a tricky case */
+#endif
+      if (int_part != 0) /* 0.<310 zeros here>1e310 for example -- pow (via dpow) thinks it has to be too big, returns Nan,
+			  *   then Nan * 0 -> Nan and the NaN propagates
+			  */
+	{
+	  if (int_len <= max_len)
+	    dval = int_part * dpow(radix, exponent);
+	  else dval = int_part * dpow(radix, exponent + int_len - max_len);
+	}
+      else dval = 0.0;
+
+      /* shift by exponent, but if int_len > max_len then we assumed (see below) int_len - max_len 0's on the left */
+      /*   using int_to_int or table lookups here instead of pow did not make any difference in speed */
+
+      if (int_len < max_len)
+	{
+	  str = fpart;
+	  for (int32_t k = 0; (frac_len > 0) && (k < exponent); k += max_len)
+	    {
+	      int32_t flen = (frac_len > max_len) ? max_len : frac_len; /* ? */
+	      frac_len -= max_len;
+	      frac_part = 0;
+	      for (i = 0; i < flen; i++)
+		frac_part = digits[(int32_t)(*str++)] + (frac_part * radix);
+	      if (frac_part != 0)                                /* same pow->NaN problem as above can occur here */
+		dval += frac_part * dpow(radix, exponent - flen - k);
+	    }}
+      else
+	/* some of the fraction is in the integer part before the negative exponent shifts it over */
+	if (int_len > max_len)
+	  {
+	    int32_t ilen = int_len - max_len;                          /* we read these above */
+	    /* str should be at the last digit we read */
+	    if (ilen > max_len)
+	      ilen = max_len;
+	    for (i = 0; i < ilen; i++)
+	      frac_part = digits[(int32_t)(*str++)] + (frac_part * radix);
+	    dval += frac_part * dpow(radix, exponent - ilen);
+	  }
+      return(sign * dval);
+    }
+
+  /* int_len + exponent <= max_len */
+  if (int_len <= max_len)
+    {
+      int32_t int_exponent = exponent;
+      /* a better algorithm (since the inaccuracies are in the radix^exponent portion):
+       *   strip off leading zeros and possible sign,
+       *   strip off digits beyond max_len, then remove any trailing zeros.
+       *     (maybe fiddle with the lowest order digit here for rounding, but I doubt it matters)
+       *   read digits until end of number or max_len reached, ignoring the decimal point
+       *   get exponent and use it and decimal point location to position the current result integer
+       * this always combines the same integer and the same exponent no matter how the number is expressed.
+       */
+      if (int_len > 0)
+	{
+	  const char *iend = (const char *)(str + int_len - 1);
+	  while ((*iend == '0') && (iend != str)) {iend--; int_exponent++;}
+	  while (str <= iend)
+	    int_part = digits[(int32_t)(*str++)] + (int_part * radix);
+	}
+      dval = (int_exponent == 0) ? (s7_double)int_part : int_part * dpow(radix, int_exponent);
+    }
+  else
+    {
+      int32_t flen, len = int_len + exponent;
+      int64_t frpart = 0;
+
+      /* 98765432101234567890987654321.0e-20    987654321.012346
+       * 98765432101234567890987654321.0e-29    0.98765432101235
+       * 98765432101234567890987654321.0e-30    0.098765432101235
+       * 98765432101234567890987654321.0e-28    9.8765432101235
+       */
+      for (i = 0; i < len; i++)
+	int_part = digits[(int32_t)(*str++)] + (int_part * radix);
+      flen = -exponent;
+      if (flen > max_len)
+	flen = max_len;
+      for (i = 0; i < flen; i++)
+	frpart = digits[(int32_t)(*str++)] + (frpart * radix);
+      if (len <= 0)
+	dval = int_part + frpart * dpow(radix, len - flen);
+      else dval = int_part + frpart * dpow(radix, -flen);
+    }
+
+  if (frac_len > 0)
+    {
+      str = fpart;
+      if (frac_len <= max_len)
+	{
+	  /* splitting out base 10 case saves very little here */
+	  /* this ignores trailing zeros, so that 0.3 equals 0.300 */
+	  const char *fend = (const char *)(str + frac_len - 1);
+
+	  while ((*fend == '0') && (fend != str)) {fend--; frac_len--;} /* (= .6 0.6000) */
+	  if ((frac_len & 1) == 0)
+	    {
+	      while (str <= fend)
+		{
+		  frac_part = digits[(int32_t)(*str++)] + (frac_part * radix);
+		  frac_part = digits[(int32_t)(*str++)] + (frac_part * radix);
+		}}
+	  else
+	    while (str <= fend)
+	      frac_part = digits[(int32_t)(*str++)] + (frac_part * radix);
+
+	  dval += frac_part * dpow(radix, exponent - frac_len);
+
+	  /* 0.6:    frac:    6, exp: 0.10000000000000000555, val: 0.60000000000000008882
+	   * 0.60:   frac:   60, exp: 0.01000000000000000021, val: 0.59999999999999997780
+	   * 0.6000: frac: 6000, exp: 0.00010000000000000000, val: 0.59999999999999997780
+	   * (= 0.6 0.60): #f
+	   * (= #i3/5 0.6): #f
+	   * so (string->number (number->string num)) == num only if both num's are the same text (or you get lucky)
+	   * (= 0.6 6e-1): #t ; but not 60e-2
+	   * to fix the 0.60 case, we need to ignore trailing post-dot zeros.
+	   */
+	}
+      else
+	{
+	  if (exponent <= 0)
+	    {
+	      for (i = 0; i < max_len; i++)
+		frac_part = digits[(int32_t)(*str++)] + (frac_part * radix);
+
+	      dval += frac_part * dpow(radix, exponent - max_len);
+	    }
+	  else
+	    {
+	      /* 1.0123456789876543210e1         10.12345678987654373771
+	       * 1.0123456789876543210e10        10123456789.87654304504394531250
+	       * 0.000000010000000000000000e10   100.0
+	       * 0.000000010000000000000000000000000000000000000e10 100.0
+	       * 0.000000012222222222222222222222222222222222222e10 122.22222222222222
+	       * 0.000000012222222222222222222222222222222222222e17 1222222222.222222
+	       */
+	      int_part = 0;
+	      for (i = 0; i < exponent; i++)
+		int_part = digits[(int32_t)(*str++)] + (int_part * radix);
+	      frac_len -= exponent;
+	      if (frac_len > max_len)
+		frac_len = max_len;
+	      for (i = 0; i < frac_len; i++)
+		frac_part = digits[(int32_t)(*str++)] + (frac_part * radix);
+	      dval += int_part + frac_part * dpow(radix, -frac_len);
+	    }}}
+#if WITH_GMP
+  if ((int_part == 0) &&
+      (frac_part == 0))
+    return(0.0);
+  (*overflow) = ((frac_len - exponent) > max_len);
+#endif
+  return(sign * dval);
+}
+
+#if (!WITH_GMP)
+static s7_pointer make_undefined_bignum(s7_scheme *sc, const char *name)
+{
+  s7_int len = safe_strlen(name) + 16;
+  block_t *b = mallocate(sc, len);
+  char *buf = (char *)block_data(b);
+  s7_pointer res;
+  snprintf(buf, len, "<bignum: %s>", name);
+  res = make_undefined(sc, (const char *)buf); /* 123123123123123123123123123123 -> +inf.0 originally, but now #<bignum: 123123...> */
+  liberate(sc, b);
+  return(res);
+}
+#endif
+
+static s7_pointer nan1_or_bust(s7_scheme *sc, s7_double x, const char *p, const char *q, int32_t radix, bool want_symbol, int32_t offset)
+{
+  s7_int len = safe_strlen(p);
+  if (p[len - 1] == 'i')       /* +nan.0[+/-]...i */
+    {
+      if (len == (offset + 2))            /* +nan.0+i */
+	return(make_complex_not_0i(sc, x, (p[offset] == '+') ? 1.0 : -1.0));
+      if ((len > (offset + 1)) && (len < 1024)) /* make compiler happy */
+	{
+	  char *ip = copy_string_with_length((const char *)(p + offset), len - offset - 1);
+	  s7_pointer imag = make_atom(sc, ip, radix, NO_SYMBOLS, WITHOUT_OVERFLOW_ERROR);
+	  free(ip);
+	  if (is_real(imag))
+	    return(make_complex(sc, x, real_to_double(sc, imag, __func__))); /* +nan.0+2/3i etc */
+	}}
+  return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+}
+
+static s7_pointer nan2_or_bust(s7_scheme *sc, s7_double x, const char *q, int32_t radix, bool want_symbol, int64_t rl_len)
+{
+  s7_int len = safe_strlen(q);
+  if ((len > rl_len) && (len < 1024)) /* make compiler happy */
+    {
+      char *ip = copy_string_with_length(q, rl_len);
+      s7_pointer rl = make_atom(sc, ip, radix, NO_SYMBOLS, WITHOUT_OVERFLOW_ERROR);
+      free(ip);
+      if (is_real(rl))
+	return(make_complex(sc, real_to_double(sc, rl, __func__), x));
+    }
+  return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+}
+
+#if WITH_NUMBER_SEPARATOR
+static s7_pointer string_to_number(s7_scheme *sc, char *str, int32_t radix);
+
+static s7_pointer make_symbol_or_number(s7_scheme *sc, const char *name, int32_t radix, bool want_symbol)
+{
+  block_t *b;
+  char *new_name;
+  char sep = sc->number_separator;
+  s7_int len, i, j;
+  s7_pointer res;
+
+  if (name[0] == sep)
+    return((want_symbol) ? make_symbol_with_strlen(sc, name) : sc->F);
+  len = safe_strlen(name);
+  b = mallocate(sc, len + 1);
+  new_name = (char *)block_data(b);
+  memcpy((void *)new_name, (const void *)name, len);
+  new_name[len] = 0;
+
+  for (i = 0, j = 0; i < len; i++)
+    if (name[i] != sep)
+      {
+	if ((digits[(uint8_t)(name[i])] < radix) || (!t_number_separator_p[(uint8_t)name[i]]))
+	  new_name[j++] = name[i];
+	else
+	  {
+	    liberate(sc, b);
+	    return((want_symbol) ? make_symbol_with_strlen(sc, name) : sc->F);
+	  }}
+    else  /* sep has to be between two digits */
+      if ((digits[(uint8_t)(name[i - 1])] >= radix) || (digits[(uint8_t)(name[i + 1])] >= radix))
+	{
+	  liberate(sc, b);
+	  return((want_symbol) ? make_symbol_with_strlen(sc, name) : sc->F);
+	}
+
+  new_name[j] = '\0';
+  res = string_to_number(sc, new_name, radix);
+  liberate(sc, b);
+  return(res);
+}
+#endif
+
+static s7_pointer make_atom(s7_scheme *sc, char *q, int32_t radix, bool want_symbol, bool with_error)
+{
+  /* make symbol or number from string, a number starts with + - . or digit, but so does 1+ for example */
+#if WITH_NUMBER_SEPARATOR
+  #define is_digit(Chr, Rad) ((digits[(uint8_t)Chr] < Rad) || ((Chr == sc->number_separator) && (sc->number_separator != '\0')))
+#else
+  #define is_digit(Chr, Rad) (digits[(uint8_t)Chr] < Rad)
+#endif
+  char c, *p = q;
+  bool has_dec_point1 = false;
+
+  c = *p++;
+  switch (c)
+    {
+    case '#':
+      /* from string->number, (string->number #xc) */
+      return(make_sharp_constant(sc, p, with_error, NULL, false)); /* make_sharp_constant expects the '#' to be removed */
+
+    case '+':
+    case '-':
+      c = *p++;
+      if (c == '.')
+	{
+	  has_dec_point1 = true;
+	  c = *p++;
+	}
+      if (!c)
+	return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+      if (!is_digit(c, radix))
+	{
+	  if (has_dec_point1)
+	    return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+	  if (c == 'n')
+	    {
+	      if (local_strcmp(p, "an.0"))            /* +nan.0, even if we read -nan.0 -- what's the point of a negative NaN? */
+		return(real_NaN);
+	      if ((local_strncmp(p, "an.0", 4)) &&    /* +nan.0[+/-]...i */
+		  ((p[4] == '+') || (p[4] == '-')))
+		return(nan1_or_bust(sc, NAN, p, q, radix, want_symbol, 4));
+	      /* read +/-nan.<int> or +/-nan.<int>+/-...i */
+	      if (local_strncmp(p, "an.", 3))         /* +nan.<int> */
+		{
+		  bool overflow = false;
+		  int32_t i;
+		  for (i = 3; is_digit(p[i], 10); i++);
+		  if ((p[i] == '+') || (p[i] == '-')) /* complex case */
+		    {
+		      int64_t payload = string_to_integer((char *)(p + 3), 10, &overflow);
+		      return(nan1_or_bust(sc, nan_with_payload(payload), p, q, radix, want_symbol, i));
+		    }
+		  if ((p[i] != '\0') && (!white_space[(uint8_t)(p[i])])) /* check for +nan.0i etc, '\0' is not white_space apparently */
+		    return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+		  return(make_nan_with_payload(sc, string_to_integer((char *)(p + 3), 10, &overflow)));
+		}}
+	  if (c == 'i')
+	    {
+	      if (local_strcmp(p, "nf.0"))  /* +inf.0 */
+		return((q[0] == '+') ? real_infinity : real_minus_infinity);
+	      if ((local_strncmp(p, "nf.0", 4)) &&
+		  ((p[4] == '+') || (p[4] == '-')))
+		return(nan1_or_bust(sc, (q[0] == '-') ? -INFINITY : INFINITY, p, q, radix, want_symbol, 4));
+	    }
+	  return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+	}
+      break;
+
+    case '.':
+      has_dec_point1 = true;
+      c = *p++;
+      if ((!c) || (!is_digit(c, radix)))
+	return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+      break;
+
+    case 'n':
+      return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+
+    case 'i':
+      return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+
+    case '0':        /* these two are always digits */
+    case '1':
+      break;
+
+    default:
+      if (!is_digit(c, radix))
+	return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+      break;
+    }
+
+  /* now it's possibly a number -- the first character(s) could be part of a number in the current radix */
+  {
+    char *slash1 = NULL, *slash2 = NULL, *plus = NULL, *ex1 = NULL, *ex2 = NULL;
+    bool has_i = false, has_dec_point2 = false;
+    int32_t has_plus_or_minus = 0, current_radix;
+#if (!WITH_GMP)
+    bool overflow = false; /* for string_to_integer */
+#endif
+    current_radix = radix;  /* current_radix is 10 for the exponent portions, but radix for all the rest */
+
+    for ( ; (c = *p) != 0; ++p)
+      {
+	/* what about embedded null? (string->number (string #\1 (integer->char 0) #\0))
+	 *   currently we stop and return 1, but Guile returns #f.
+	 *   this also means we can't use substring_uncopied if (string->number (substring...))
+	 */
+	if (!is_digit(c, current_radix))         /* moving this inside the switch statement was much slower */
+	  {
+	    current_radix = radix;
+
+	    switch (c)
+	      {
+		/* -------- decimal point -------- */
+	      case '.':
+		if ((!is_digit(p[1], current_radix)) &&
+		    (!is_digit(p[-1], current_radix)))
+		  return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+
+		if (has_plus_or_minus == 0)
+		  {
+		    if ((has_dec_point1) || (slash1))
+		      return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+		    has_dec_point1 = true;
+		  }
+		else
+		  {
+		    if ((has_dec_point2) || (slash2))
+		      return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+		    has_dec_point2 = true;
+		  }
+		continue;
+
+		/* -------- exponent marker -------- */
+#if WITH_EXTRA_EXPONENT_MARKERS
+		/* 1st 3d-perspective 0.0f 128.0f 3d 1s -- in 2 million lines of public scheme code, not one actual use! */
+	      case 's': case 'S':
+	      case 'd': case 'D':
+	      case 'f': case 'F':
+	      case 'l': case 'L':
+#endif
+	      case 'e': case 'E':
+		if (current_radix > 10) /* see above */
+		  return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+		/* fall through -- if '@' used, radices>10 are ok */
+
+	      case '@':
+		current_radix = 10;
+
+		if (((ex1) ||
+		     (slash1)) &&
+		    (has_plus_or_minus == 0)) /* ee */
+		  return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+
+		if (((ex2) ||
+		     (slash2)) &&
+		    (has_plus_or_minus != 0)) /* 1+1.0ee */
+		  return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+
+		if ((!is_digit(p[-1], radix)) && /* was current_radix but that's always 10! */
+		    (p[-1] != '.'))
+		  return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+
+		if (has_plus_or_minus == 0)
+		  {
+		    ex1 = p;
+		    has_dec_point1 = true; /* decimal point illegal from now on */
+		  }
+		else
+		  {
+		    ex2 = p;
+		    has_dec_point2 = true;
+		  }
+		p++;
+		if ((*p == '-') || (*p == '+')) p++;
+		if (is_digit(*p, current_radix))
+		  continue;
+		break;
+
+		/* -------- internal + or - -------- */
+	      case '+':
+	      case '-':
+		if (has_plus_or_minus != 0) /* already have the separator */
+		  return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+
+		has_plus_or_minus = (c == '+') ? 1 : -1;
+		plus = (char *)(p + 1);
+		/* now check for nan/inf as imaginary part */
+
+		if ((plus[0] == 'n') &&
+		    (local_strncmp(plus, "nan.", 4)))
+		  {
+		    bool overflow1 = false;
+		    int64_t payload = string_to_integer((char *)(p + 5), 10, &overflow1);
+		    return(nan2_or_bust(sc, nan_with_payload(payload), q, radix, want_symbol, (intptr_t)(p - q)));
+		  }
+		if ((plus[0] == 'i') &&
+		    (local_strcmp(plus, "inf.0i")))
+		  return(nan2_or_bust(sc, (c == '+') ? INFINITY : -INFINITY, q, radix, want_symbol, (intptr_t)(p - q)));
+		continue;
+
+		/* ratio marker */
+	      case '/':
+		if ((has_plus_or_minus == 0) &&
+		    ((ex1) ||
+		     (slash1) ||
+		     (has_dec_point1)))
+		  return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+
+		if ((has_plus_or_minus != 0) &&
+		    ((ex2) ||
+		     (slash2) ||
+		     (has_dec_point2)))
+		  return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+
+		if (has_plus_or_minus == 0)
+		  slash1 = (char *)(p + 1);
+		else slash2 = (char *)(p + 1);
+
+		if ((!is_digit(p[1], current_radix)) ||
+		    (!is_digit(p[-1], current_radix)))
+		  return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+
+		continue;
+
+		/* -------- i for the imaginary part -------- */
+	      case 'i':
+		if ((has_plus_or_minus != 0) &&
+		    (!has_i))
+		  {
+		    has_i = true;
+		    continue;
+		  }
+		break;
+
+	      default: break;
+	      }
+	    return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+	  }}
+
+    if ((has_plus_or_minus != 0) &&        /* that is, we have an internal + or - */
+	(!has_i))                          /*   but no i for the imaginary part */
+      return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+
+#if WITH_NUMBER_SEPARATOR
+    if ((sc->number_separator != '\0') && (strchr(q, (int)(sc->number_separator))))
+      return(make_symbol_or_number(sc, q, radix, want_symbol));
+#endif
+
+    if (has_i)
+      {
+#if (!WITH_GMP)
+	s7_double rl = 0.0, im = 0.0;
+#else
+	char e1 = 0, e2 = 0;
+#endif
+	s7_pointer result;
+	s7_int len = safe_strlen(q);
+	char ql1, pl1;
+
+	if (q[len - 1] != 'i')
+	  return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+
+	/* save original string */
+	ql1 = q[len - 1];
+	pl1 = (*(plus - 1));
+#if WITH_GMP
+	if (ex1) {e1 = *ex1; (*ex1) = '@';} /* for mpfr */
+	if (ex2) {e2 = *ex2; (*ex2) = '@';}
+#endif
+	/* look for cases like 1+i */
+	q[len - 1] = ((q[len - 2] == '+') || (q[len - 2] == '-')) ? '1' : '\0'; /* remove 'i' */
+
+	(*((char *)(plus - 1))) = '\0';
+
+#if (!WITH_GMP)
+	if ((has_dec_point1) ||
+	    (ex1))  /* (string->number "1100.1+0.11i" 2) -- need to split into 2 honest reals before passing to non-base-10 str->dbl */
+	  rl = string_to_double_with_radix(q, radix, ignored);
+	else /* no decimal point, no exponent, a ratio (1/2+i for example, but 1+2/3i is handled below) */
+	  {
+	    if (slash1)
+	      {
+		/* here the overflow could be innocuous if it's in the denominator and the numerator is 0: 0/100000000000000000000000000000000000000 */
+		s7_int den, num = string_to_integer(q, radix, &overflow);
+		if (overflow) return(make_undefined_bignum(sc, q));
+		den = string_to_integer(slash1, radix, &overflow);
+		if (den == 0)
+		  rl = NAN;        /* real_part if complex */
+		else
+		  {
+		    if (num == 0)
+		      {
+			rl = 0.0;
+			overflow = false;
+		      }
+		    else
+		      {
+			if (overflow) return(make_undefined_bignum(sc, q)); /* denominator overflow */
+			rl = (long_double)num / (long_double)den; /* no gmp, so we do what we can */
+		      }}}
+	    else
+	      {
+		rl = (s7_double)string_to_integer(q, radix, &overflow);
+		if (overflow) return(make_undefined_bignum(sc, q));
+	      }}
+	if (rl == -0.0) rl = 0.0;
+
+	if ((has_dec_point2) ||
+	    (ex2))
+	  im = string_to_double_with_radix(plus, radix, ignored);
+	else
+	  {
+	    if (slash2) /* complex part I think */
+	      {
+		/* same as above: 0-0/100000000000000000000000000000000000000i */
+		s7_int den, num = string_to_integer(plus, radix, &overflow);
+		if (overflow) return(make_undefined_bignum(sc, q));
+		den = string_to_integer(slash2, radix, &overflow);
+		if (den == 0)
+		  im = NAN;
+		else
+		  {
+		    if (num == 0)
+		      {
+			im = 0.0;
+			overflow = false;
+		      }
+		    else
+		      {
+			if (overflow) return(make_undefined_bignum(sc, q)); /* denominator overflow */
+			im = (long_double)num / (long_double)den;
+		      }}}
+	    else
+	      {
+		im = (s7_double)string_to_integer(plus, radix, &overflow);
+		if (overflow) return(make_undefined_bignum(sc, q));
+	      }}
+	if ((has_plus_or_minus == -1) &&
+	    (im != 0.0))
+	  im = -im;
+	result = make_complex(sc, rl, im);
+#else
+	result = string_to_either_complex(sc, q, slash1, ex1, has_dec_point1, plus, slash2, ex2, has_dec_point2, radix, has_plus_or_minus);
+#endif
+	/* restore original string */
+	q[len - 1] = ql1;
+	(*((char *)(plus - 1))) = pl1;
+#if WITH_GMP
+	if (ex1) (*ex1) = e1;
+	if (ex2) (*ex2) = e2;
+#endif
+	return(result);
+      }
+
+    /* not complex */
+    if ((has_dec_point1) ||
+	(ex1))
+      {
+	s7_pointer result;
+	if (slash1)  /* not complex, so slash and "." is not a number */
+	  return((want_symbol) ? make_symbol_with_strlen(sc, q) : sc->F);
+
+#if (!WITH_GMP)
+	result = make_real(sc, string_to_double_with_radix(q, radix, ignored));
+#else
+	{
+	  char old_e = 0;
+	  if (ex1)
+	    {
+	      old_e = (*ex1);
+	      (*ex1) = '@';
+	    }
+	  result = string_to_either_real(sc, q, radix);
+	  if (ex1)
+	    (*ex1) = old_e;
+	}
+#endif
+	return(result);
+      }
+
+    /* rational */
+    if (slash1)
+#if (!WITH_GMP)
+      {
+	s7_int d, n = string_to_integer(q, radix, &overflow);
+	if (overflow) return(make_undefined_bignum(sc, q));
+	d = string_to_integer(slash1, radix, &overflow);
+
+	if ((n == 0) && (d != 0))                        /* 0/100000000000000000000000000000000000000 */
+	  return(int_zero);
+	if (d == 0) return(real_NaN);
+	if (overflow) return(make_undefined_bignum(sc, q));
+	/* it would be neat to return 1 from 10000000000000000000000000000/10000000000000000000000000000
+	 *   but q is the entire number ('/' included) and slash1 is the stuff after the '/', and every
+	 *   big number comes through here, so there's no clean and safe way to check that q == slash1.
+	 */
+	return(make_ratio(sc, n, d));
+      }
+#else
+    return(string_to_either_ratio(sc, q, slash1, radix));
+#endif
+    /* integer */
+#if (!WITH_GMP)
+    {
+      s7_int x = string_to_integer(q, radix, &overflow);
+      if (overflow) return(make_undefined_bignum(sc, q));
+      return(make_integer(sc, x));
+    }
+#else
+    return(string_to_either_integer(sc, q, radix));
+#endif
+  }
+}
+
+
+/* -------------------------------- string->number -------------------------------- */
+static s7_pointer string_to_number(s7_scheme *sc, char *str, int32_t radix)
+{
+  s7_pointer x = make_atom(sc, str, radix, NO_SYMBOLS, WITHOUT_OVERFLOW_ERROR);
+  return((is_number(x)) ? x : sc->F);  /* only needed because str might start with '#' and not be a number (#t for example) */
+}
+
+static s7_pointer string_to_number_p_p(s7_scheme *sc, s7_pointer str1)
+{
+  char *str;
+  if (!is_string(str1))
+    wrong_type_error_nr(sc, sc->string_to_number_symbol, 1, str1, sc->type_names[T_STRING]);
+  str = (char *)string_value(str1);
+  return(((!str) || (!(*str))) ? sc->F : string_to_number(sc, str, 10));
+}
+
+static s7_pointer string_to_number_p_pp(s7_scheme *sc, s7_pointer str1, s7_pointer radix1)
+{
+  s7_int radix;
+  char *str;
+  if (!is_string(str1))
+    wrong_type_error_nr(sc, sc->string_to_number_symbol, 1, str1, sc->type_names[T_STRING]);
+
+  if (!is_t_integer(radix1))
+    wrong_type_error_nr(sc, sc->string_to_number_symbol, 2, radix1, sc->type_names[T_INTEGER]);
+  radix = integer(radix1);
+  if ((radix < 2) || (radix > 16))
+    out_of_range_error_nr(sc, sc->string_to_number_symbol, int_two, radix1, a_valid_radix_string);
+
+  str = (char *)string_value(str1);
+  if ((!str) || (!(*str)))
+    return(sc->F);
+  return(string_to_number(sc, str, radix));
+}
+
+static s7_pointer g_string_to_number_1(s7_scheme *sc, s7_pointer args, s7_pointer caller)
+{
+  s7_int radix;
+  char *str;
+  if (!is_string(car(args)))
+    return(method_or_bust(sc, car(args), caller, args, sc->type_names[T_STRING], 1));
+
+  if (is_pair(cdr(args)))
+    {
+      s7_pointer rad = cadr(args);
+      if (!s7_is_integer(rad))
+	return(method_or_bust(sc, rad, caller, args, sc->type_names[T_INTEGER], 2));
+      radix = s7_integer_clamped_if_gmp(sc, rad);
+      if ((radix < 2) || (radix > 16))
+	out_of_range_error_nr(sc, caller, int_two, rad, a_valid_radix_string);
+    }
+  else radix = 10;
+  str = (char *)string_value(car(args));
+  if ((!str) || (!(*str)))
+    return(sc->F);
+  return(string_to_number(sc, str, radix));
+}
+
+static s7_pointer g_string_to_number(s7_scheme *sc, s7_pointer args)
+{
+  #define H_string_to_number "(string->number str (radix 10)) converts str into a number. \
+If str does not represent a number, string->number returns #f.  If 'str' has an embedded radix, \
+the optional 'radix' argument is ignored: (string->number \"#x11\" 2) -> 17 not 3."
+  #define Q_string_to_number s7_make_signature(sc, 3, \
+                               s7_make_signature(sc, 2, sc->is_number_symbol, sc->not_symbol), \
+                               sc->is_string_symbol, sc->is_integer_symbol)
+  return(g_string_to_number_1(sc, args, sc->string_to_number_symbol));
+}
+
+
+/* -------------------------------- abs -------------------------------- */
+static inline s7_pointer abs_p_p(s7_scheme *sc, s7_pointer x)
+{
+#if (!WITH_GMP)
+  if (is_t_integer(x))
+    {
+      if (integer(x) >= 0) return(x);
+      if (integer(x) > S7_INT64_MIN) return(make_integer(sc, -integer(x)));
+    }
+  if (is_t_real(x))
+    {
+      if (is_NaN(real(x)))
+	return((nan_payload(real(x)) > 0) ? x : real_NaN);         /* (abs -nan.0) -> +nan.0?? */
+      return((signbit(real(x))) ? make_real(sc, -real(x)) : x);
+    }
+#endif
+  switch (type(x))
+    {
+    case T_INTEGER:
+      if (integer(x) >= 0) return(x);
+#if WITH_GMP
+      if (integer(x) == S7_INT64_MIN)
+	{
+	  x = s7_int_to_big_integer(sc, integer(x));
+	  mpz_neg(big_integer(x), big_integer(x));
+	  return(x);
+	}
+#else
+      if (integer(x) == S7_INT64_MIN)
+	sole_arg_out_of_range_error_nr(sc, sc->abs_symbol, set_elist_1(sc, x), result_is_too_large_string);
+#endif
+      return(make_integer(sc, -integer(x)));
+
+    case T_RATIO:
+      if (numerator(x) >= 0) return(x);
+#if WITH_GMP && (!POINTER_32)
+      if (numerator(x) == S7_INT64_MIN)
+	{
+	  s7_pointer p;
+	  mpz_set_si(sc->mpz_1, S7_INT64_MIN);
+	  mpz_neg(sc->mpz_1, sc->mpz_1);
+	  mpz_set_si(sc->mpz_2, denominator(x));
+	  new_cell(sc, p, T_BIG_RATIO);
+	  big_ratio_bgr(p) = alloc_bigrat(sc);
+	  add_big_ratio(sc, p);
+	  mpq_set_num(big_ratio(p), sc->mpz_1);
+	  mpq_set_den(big_ratio(p), sc->mpz_2);
+	  return(p);
+	}
+#else
+      if (numerator(x) == S7_INT64_MIN)
+	return(make_ratio(sc, S7_INT64_MAX, denominator(x)));
+#endif
+      return(make_simple_ratio(sc, -numerator(x), denominator(x)));
+
+    case T_REAL:
+      if (is_NaN(real(x)))                  /* (abs -nan.0) -> +nan.0, not -nan.0 */
+	return((nan_payload(real(x)) > 0) ? x : real_NaN);
+      return((signbit(real(x))) ? make_real(sc, -real(x)) : x); /* (abs -0.0) returns -0.0 -- Shiro Kawai */
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpz_abs(sc->mpz_1, big_integer(x));
+      return(mpz_to_integer(sc, sc->mpz_1));
+    case T_BIG_RATIO:
+      mpq_abs(sc->mpq_1, big_ratio(x));
+      return(mpq_to_rational(sc, sc->mpq_1));
+    case T_BIG_REAL:
+      mpfr_abs(sc->mpfr_1, big_real(x), MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+#endif
+    default:
+      return(method_or_bust_p(sc, x, sc->abs_symbol, sc->type_names[T_REAL]));
+    }
+}
+
+static s7_pointer g_abs(s7_scheme *sc, s7_pointer args)
+{
+  #define H_abs "(abs x) returns the absolute value of the real number x"
+  #define Q_abs s7_make_signature(sc, 2, sc->is_real_symbol, sc->is_real_symbol)
+  return(abs_p_p(sc, car(args)));
+}
+
+static s7_double abs_d_d(s7_double x) {return((signbit(x)) ? (-x) : x);}
+static s7_int abs_i_i(s7_int x) {return((x < 0) ? (-x) : x);}
+
+
+/* -------------------------------- magnitude -------------------------------- */
+static double my_hypot(double x, double y)
+{
+  /* according to callgrind, this is much faster than libc's hypot */
+  if (x == 0.0) return(fabs(y));
+  if (y == 0.0) return(fabs(x));
+  if (x == y) return(1.414213562373095 * fabs(x));
+  if (is_NaN(x)) return(x);
+  if (is_NaN(y)) return(y);
+  return(sqrt(x * x + y * y));
+}
+
+static s7_pointer magnitude_p_p(s7_scheme *sc, s7_pointer x)
+{
+  if (is_t_complex(x))
+    return(make_real(sc, my_hypot(real_part(x), imag_part(x)))); /* was reversed? 8-Nov-22 */
+
+  switch (type(x))
+    {
+    case T_INTEGER:
+      if (integer(x) == S7_INT64_MIN) return(mostfix);
+      /* (magnitude -9223372036854775808) -> -9223372036854775808
+       *   same thing happens in abs, lcm and gcd: (gcd -9223372036854775808) -> -9223372036854775808
+       */
+      return((integer(x) < 0) ? make_integer(sc, -integer(x)) : x);
+    case T_RATIO:
+      return((numerator(x) < 0) ? make_simple_ratio(sc, -numerator(x), denominator(x)) : x);
+    case T_REAL:
+      if (is_NaN(real(x)))                 /* (magnitude -nan.0) -> +nan.0, not -nan.0 */
+	return((nan_payload(real(x)) > 0) ? x : real_NaN);
+      return((signbit(real(x))) ? make_real(sc, -real(x)) : x);
+#if WITH_GMP
+    case T_BIG_INTEGER:
+    case T_BIG_RATIO:
+    case T_BIG_REAL:
+      return(abs_p_p(sc, x));
+    case T_BIG_COMPLEX:
+      mpc_abs(sc->mpfr_1, big_complex(x), MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+#endif
+    default:
+      return(method_or_bust_p(sc, x, sc->magnitude_symbol, a_number_string));
+    }
+}
+
+static s7_pointer g_magnitude(s7_scheme *sc, s7_pointer args)
+{
+  #define H_magnitude "(magnitude z) returns the magnitude of z"
+  #define Q_magnitude s7_make_signature(sc, 2, sc->is_real_symbol, sc->is_number_symbol)
+  return(magnitude_p_p(sc, car(args)));
+}
+
+static s7_int magnitude_i_i(s7_int x) {return((x < 0) ? (-x) : x);}
+static s7_double magnitude_d_d(s7_double x) {return((signbit(x)) ? (-x) : x);}
+
+
+/* -------------------------------- rationalize -------------------------------- */
+#if WITH_GMP
+
+static rat_locals_t *init_rat_locals_t(s7_scheme *sc)
+{
+  rat_locals_t *r = (rat_locals_t *)Malloc(sizeof(rat_locals_t));
+  sc->ratloc = r;
+  mpz_inits(r->i, r->i0, r->i1, r->n, r->p0, r->q0, r->r, r->r1, r->p1, r->q1, r->old_p1, r->old_q1, NULL);
+  mpq_init(r->q);
+  mpfr_inits2(sc->bignum_precision, r->error, r->ux, r->x0, r->x1, r->val, r->e0, r->e1, r->e0p, r->e1p, r->old_e0, r->old_e1, r->old_e0p, NULL);
+  return(r);
+}
+
+static void free_rat_locals(s7_scheme *sc)
+{
+  rat_locals_t *r = sc->ratloc;
+  mpz_clears(r->i, r->i0, r->i1, r->n, r->p0, r->q0, r->r, r->r1, r->p1, r->q1, r->old_p1, r->old_q1, NULL);
+  mpq_clear(r->q);
+  mpfr_clears(r->error, r->ux, r->x0, r->x1, r->val, r->e0, r->e1, r->e0p, r->e1p, r->old_e0, r->old_e1, r->old_e0p, NULL);
+  free(r);
+}
+
+static s7_pointer big_rationalize(s7_scheme *sc, s7_pointer args)
+{
+  /* can return be non-rational? */
+  /* currently (rationalize 1/0 1e18) -> 0
+   * remember to pad with many trailing zeros:
+   *    (rationalize 0.1 0)                -> 3602879701896397/36028797018963968
+   *    (rationalize 0.1000000000000000 0) -> 1/10
+   * perhaps gmp number reader used if gmp -- could this be the trailing zeros problem?  (why is the non-gmp case ok?)
+   *         also the bignum function is faking it.
+   *         (rationalize (real-part (bignum "0.1+i")) 0) -> 3602879701896397/36028797018963968
+   * a confusing case:
+   *   (rationalize 5925563891587147521650777143.74135805596e05) should be 148139097289678688041269428593533951399/250000
+   * but that requires more than 128 bits of bignum-precision.
+   */
+
+  s7_pointer pp0 = car(args);
+  rat_locals_t *r = (sc->ratloc) ? sc->ratloc : init_rat_locals_t(sc);
+
+  switch (type(pp0))
+    {
+    case T_INTEGER:
+      mpfr_set_si(r->ux, integer(pp0), MPFR_RNDN);
+      break;
+    case T_RATIO:
+      mpq_set_si(sc->mpq_1, numerator(pp0), denominator(pp0));
+      mpfr_set_q(r->ux, sc->mpq_1, MPFR_RNDN);
+      break;
+    case T_REAL:
+      if (is_NaN(real(pp0)))
+	out_of_range_error_nr(sc, sc->rationalize_symbol, int_one, pp0, it_is_nan_string);
+      if (is_inf(real(pp0)))
+	out_of_range_error_nr(sc, sc->rationalize_symbol, int_one, pp0, it_is_infinite_string);
+      mpfr_set_d(r->ux, real(pp0), MPFR_RNDN);
+      break;
+    case T_BIG_INTEGER:
+      mpfr_set_z(r->ux, big_integer(pp0), MPFR_RNDN);
+      break;
+    case T_BIG_RATIO:
+      mpfr_set_q(r->ux, big_ratio(pp0), MPFR_RNDN);
+      break;
+    case T_BIG_REAL:
+      if (mpfr_nan_p(big_real(pp0)))
+	out_of_range_error_nr(sc, sc->rationalize_symbol, int_one, pp0, it_is_nan_string);
+      if (mpfr_inf_p(big_real(pp0)))
+	out_of_range_error_nr(sc, sc->rationalize_symbol, int_one, pp0, it_is_infinite_string);
+      mpfr_set(r->ux, big_real(pp0), MPFR_RNDN);
+      break;
+    case T_COMPLEX:
+    case T_BIG_COMPLEX:
+      wrong_type_error_nr(sc, sc->rationalize_symbol, 1, pp0, sc->type_names[T_REAL]);
+    default:
+      return(method_or_bust(sc, pp0, sc->rationalize_symbol, args, sc->type_names[T_REAL], 1));
+    }
+
+  if (is_null(cdr(args)))
+    mpfr_set_d(r->error, sc->default_rationalize_error, MPFR_RNDN);
+  else
+    {
+      s7_pointer pp1 = cadr(args);
+      switch (type(pp1))
+	{
+	case T_INTEGER:
+	  mpfr_set_si(r->error, integer(pp1), MPFR_RNDN);
+	  break;
+	case T_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(pp1), denominator(pp1));
+	  mpfr_set_q(r->error, sc->mpq_1, MPFR_RNDN);
+	  break;
+	case T_REAL:
+	  if (is_NaN(real(pp1)))
+	    out_of_range_error_nr(sc, sc->rationalize_symbol, int_two, pp1, it_is_nan_string);
+	  if (is_inf(real(pp1)))
+	    return(int_zero);
+	  mpfr_set_d(r->error, real(pp1), MPFR_RNDN);
+	  break;
+	case T_BIG_INTEGER:
+	  mpfr_set_z(r->error, big_integer(pp1), MPFR_RNDN);
+	  break;
+	case T_BIG_RATIO:
+	  mpfr_set_q(r->error, big_ratio(pp1), MPFR_RNDN);
+	  break;
+	case T_BIG_REAL:
+	  if (mpfr_nan_p(big_real(pp1)))
+	    out_of_range_error_nr(sc, sc->rationalize_symbol, int_two, pp1, it_is_nan_string);
+	  if (mpfr_inf_p(big_real(pp1)))
+	    return(int_zero);
+	  mpfr_set(r->error, big_real(pp1), MPFR_RNDN);
+	  break;
+	case T_COMPLEX:
+	case T_BIG_COMPLEX:
+	  wrong_type_error_nr(sc, sc->rationalize_symbol, 2, pp1, sc->type_names[T_REAL]);
+	default:
+	  return(method_or_bust(sc, pp1, sc->rationalize_symbol, args, sc->type_names[T_REAL], 2));
+	}
+      mpfr_abs(r->error, r->error, MPFR_RNDN);
+    }
+
+  mpfr_set(r->x0, r->ux, MPFR_RNDN);            /* x0 = ux - error */
+  mpfr_sub(r->x0, r->x0, r->error, MPFR_RNDN);
+  mpfr_set(r->x1, r->ux, MPFR_RNDN);            /* x1 = ux + error */
+  mpfr_add(r->x1, r->x1, r->error, MPFR_RNDN);
+  mpfr_get_z(r->i, r->x0, MPFR_RNDU);           /* i = ceil(x0) */
+
+  if (mpfr_cmp_ui(r->error, 1) >= 0)            /* if (error >= 1.0) */
+    {
+      if (mpfr_cmp_ui(r->x0, 0) < 0)            /* if (x0 < 0) */
+	{
+	  if (mpfr_cmp_ui(r->x1, 0) < 0)        /*   if (x1 < 0) */
+	    mpfr_get_z(r->n, r->x1, MPFR_RNDD); /*     num = floor(x1) */
+	  else mpz_set_ui(r->n, 0);             /*   else num = 0 */
+	}
+      else mpz_set(r->n, r->i);                 /* else num = i */
+      return(mpz_to_integer(sc, r->n));
+    }
+
+  if (mpfr_cmp_z(r->x1, r->i) >= 0)             /* if (x1 >= i) */
+    {
+      if (mpz_cmp_ui(r->i, 0) >= 0)             /* if (i >= 0) */
+	mpz_set(r->n, r->i);                    /*   num = i */
+      else mpfr_get_z(r->n, r->x1, MPFR_RNDD);  /* else num = floor(x1) */
+      return(mpz_to_integer(sc, r->n));
+    }
+
+  mpfr_get_z(r->i0, r->x0, MPFR_RNDD);          /* i0 = floor(x0) */
+  mpfr_get_z(r->i1, r->x1, MPFR_RNDU);          /* i1 = ceil(x1) */
+
+  mpz_set(r->p0, r->i0);                        /* p0 = i0 */
+  mpz_set_ui(r->q0, 1);                         /* q0 = 1 */
+  mpz_set(r->p1, r->i1);                        /* p1 = i1 */
+  mpz_set_ui(r->q1, 1);                         /* q1 = 1 */
+  mpfr_sub_z(r->e0, r->x0, r->i1, MPFR_RNDN);   /* e0 = i1 - x0 */
+  mpfr_neg(r->e0, r->e0, MPFR_RNDN);
+  mpfr_sub_z(r->e1, r->x0, r->i0, MPFR_RNDN);   /* e1 = x0 - i0 */
+  mpfr_sub_z(r->e0p, r->x1, r->i1, MPFR_RNDN);  /* e0p = i1 - x1 */
+  mpfr_neg(r->e0p, r->e0p, MPFR_RNDN);
+  mpfr_sub_z(r->e1p, r->x1, r->i0, MPFR_RNDN);  /* e1p = x1 - i0 */
+
+  while (true)
+    {
+      mpfr_set_z(r->val, r->p0, MPFR_RNDN);
+      mpfr_div_z(r->val, r->val, r->q0, MPFR_RNDN);  /* val = p0/q0 */
+
+      if (((mpfr_lessequal_p(r->x0, r->val)) &&        /* if ((x0 <= val) && (val <= x1)) */
+	   (mpfr_lessequal_p(r->val, r->x1))) ||
+	  (mpfr_cmp_ui(r->e1, 0) == 0) ||
+	  (mpfr_cmp_ui(r->e1p, 0) == 0))
+	/* these last 2 are probably not needed -- they protect against running out of bits in the non-gmp case above */
+	{
+	  mpq_set_num(r->q, r->p0);                /* return(p0/q0) */
+	  mpq_set_den(r->q, r->q0);
+	  return(mpq_to_rational(sc, r->q));
+	}
+
+      mpfr_div(r->val, r->e0, r->e1, MPFR_RNDN);
+      mpfr_get_z(r->r, r->val, MPFR_RNDD);           /* r = floor(e0/e1) */
+      mpfr_div(r->val, r->e0p, r->e1p, MPFR_RNDN);
+      mpfr_get_z(r->r1, r->val, MPFR_RNDU);          /* r1 = ceil(e0p/e1p) */
+      if (mpz_cmp(r->r1, r->r) < 0)                 /* if (r1 < r) */
+	mpz_set(r->r, r->r1);                       /*   r = r1 */
+
+      mpz_set(r->old_p1, r->p1);                    /* old_p1 = p1 */
+      mpz_set(r->p1, r->p0);                        /* p1 = p0 */
+      mpz_set(r->old_q1, r->q1);                    /* old_q1 = q1 */
+      mpz_set(r->q1, r->q0);                        /* q1 = q0 */
+
+      mpfr_set(r->old_e0, r->e0, MPFR_RNDN);         /* old_e0 = e0 */
+      mpfr_set(r->e0, r->e1p, MPFR_RNDN);            /* e0 = e1p */
+      mpfr_set(r->old_e0p, r->e0p, MPFR_RNDN);       /* old_e0p = e0p */
+      mpfr_set(r->e0p, r->e1, MPFR_RNDN);            /* e0p = e1 */
+      mpfr_set(r->old_e1, r->e1, MPFR_RNDN);         /* old_e1 = e1 */
+
+      mpz_mul(r->p0, r->p0, r->r);                  /* p0 = old_p1 + r * p0 */
+      mpz_add(r->p0, r->p0, r->old_p1);
+
+      mpz_mul(r->q0, r->q0, r->r);                  /* q0 = old_q1 + r * q0 */
+      mpz_add(r->q0, r->q0, r->old_q1);
+
+      mpfr_mul_z(r->e1, r->e1p, r->r, MPFR_RNDN);    /* e1 = old_e0p - r * e1p */
+      mpfr_sub(r->e1, r->old_e0p, r->e1, MPFR_RNDN);
+
+      mpfr_mul_z(r->e1p, r->old_e1, r->r, MPFR_RNDN);/* e1p = old_e0 - r * old_e1 */
+      mpfr_sub(r->e1p, r->old_e0, r->e1p, MPFR_RNDN);
+    }
+}
+#endif
+
+static s7_pointer g_rationalize(s7_scheme *sc, s7_pointer args)
+{
+  #define H_rationalize "(rationalize x err) returns the ratio with smallest denominator within err of x"
+  #define Q_rationalize s7_make_signature(sc, 3, sc->is_rational_symbol, sc->is_real_symbol, sc->is_real_symbol)
+  /* I can't find a case where this returns a non-rational result */
+
+  s7_double err;
+  s7_pointer x = car(args);
+
+#if WITH_GMP
+  if (is_big_number(x))
+    return(big_rationalize(sc, args));
+#endif
+  if (!is_real(x))
+    return(method_or_bust(sc, x, sc->rationalize_symbol, args, sc->type_names[T_REAL], 1));
+
+  if (is_null(cdr(args)))
+    err = sc->default_rationalize_error;
+  else
+    {
+      s7_pointer ex = cadr(args);
+#if WITH_GMP
+      if (is_big_number(ex))
+	return(big_rationalize(sc, args));
+#endif
+      if (!is_real(ex))
+	return(method_or_bust(sc, ex, sc->rationalize_symbol, args, sc->type_names[T_REAL], 2));
+      err = real_to_double(sc, ex, "rationalize");
+      if (is_NaN(err))
+	out_of_range_error_nr(sc, sc->rationalize_symbol, int_two, ex, it_is_nan_string);
+      if (err < 0.0) err = -err;
+    }
+
+  switch (type(x))
+    {
+    case T_INTEGER:
+      {
+	s7_int a, b, pa;
+	if (err < 1.0) return(x);
+	a = integer(x);
+	pa = (a < 0) ? -a : a;
+	if (err >= pa) return(int_zero);
+	b = (s7_int)err;
+	pa -= b;
+	return(make_integer(sc, (a < 0) ? -pa : pa));
+      }
+
+    case T_RATIO:
+      if (err == 0.0)
+	return(x);
+
+    case T_REAL:
+      {
+	s7_double rat = s7_real(x); /* possible fall through from above */
+	s7_int numer = 0, denom = 1;
+
+	if ((is_NaN(rat)) || (is_inf(rat)))
+	  out_of_range_error_nr(sc, sc->rationalize_symbol, int_one, x, a_normal_real_string);
+
+	if (err >= fabs(rat))
+	  return(int_zero);
+
+#if WITH_GMP
+	if (fabs(rat) > RATIONALIZE_LIMIT)
+	  return(big_rationalize(sc, set_plist_2(sc, x, wrap_real(sc, err))));
+#else
+	if (fabs(rat) > RATIONALIZE_LIMIT)
+	  out_of_range_error_nr(sc, sc->rationalize_symbol, int_one, x, it_is_too_large_string);
+#endif
+	if ((fabs(rat) + fabs(err)) < 1.0e-18)
+	  err = 1.0e-18;
+	/* (/ 1.0 most-positive-fixnum) is 1.0842021e-19, so if we let err be less than that,
+	 * (rationalize 1e-19 1e-20) hangs, but this only affects the initial ceiling, I believe.
+	 */
+
+	if (fabs(rat) < fabs(err))
+	  return(int_zero);
+
+	return((c_rationalize(rat, err, &numer, &denom)) ? make_ratio(sc, numer, denom) : sc->F);
+      }}
+  return(sc->F); /* make compiler happy */
+}
+
+static s7_int rationalize_i_i(s7_int x) {return(x);}
+static s7_pointer rationalize_p_i(s7_scheme *sc, s7_int x) {return(make_integer(sc, x));}
+static s7_pointer rationalize_p_d(s7_scheme *sc, s7_double x)
+{
+  if ((is_NaN(x)) || (is_inf(x)))
+    out_of_range_error_nr(sc, sc->rationalize_symbol, int_one, wrap_real(sc, x), a_normal_real_string); /* was make_real, also below */
+  if (fabs(x) > RATIONALIZE_LIMIT)
+#if WITH_GMP
+    return(big_rationalize(sc, set_plist_1(sc, wrap_real(sc, x))));
+#else
+    out_of_range_error_nr(sc, sc->rationalize_symbol, int_one, wrap_real(sc, x), it_is_too_large_string);
+#endif
+  return(s7_rationalize(sc, x, sc->default_rationalize_error));
+}
+
+
+/* -------------------------------- angle -------------------------------- */
+static s7_pointer g_angle(s7_scheme *sc, s7_pointer args)
+{
+  #define H_angle "(angle z) returns the angle of z"
+  #define Q_angle s7_make_signature(sc, 2, sc->is_real_symbol, sc->is_number_symbol)
+
+  s7_pointer x = car(args);  /* (angle inf+infi) -> 0.78539816339745 ? I think this should be -pi < ang <= pi */
+  switch (type(x))
+    {
+    case T_INTEGER: return((integer(x) < 0) ? real_pi : int_zero);
+    case T_RATIO:   return((numerator(x) < 0) ? real_pi : int_zero);
+    case T_COMPLEX: return(make_real(sc, atan2(imag_part(x), real_part(x))));
+
+    case T_REAL:
+      if (is_NaN(real(x))) return(x);
+      return((real(x) < 0.0) ? real_pi : real_zero);
+#if WITH_GMP
+    case T_BIG_INTEGER: return((mpz_cmp_ui(big_integer(x), 0) >= 0) ? int_zero : big_pi(sc));
+    case T_BIG_RATIO:   return((mpq_cmp_ui(big_ratio(x), 0, 1) >= 0) ? int_zero : big_pi(sc));
+    case T_BIG_REAL:
+      if (mpfr_nan_p(big_real(x))) return(x);
+      return((mpfr_cmp_d(big_real(x), 0.0) >= 0) ? real_zero : big_pi(sc));
+    case T_BIG_COMPLEX:
+      {
+	s7_pointer z;
+	new_cell(sc, z, T_BIG_REAL);
+	big_real_bgf(z) = alloc_bigflt(sc);
+	add_big_real(sc, z);
+	mpc_arg(big_real(z), big_complex(x), MPFR_RNDN);
+	return(z);
+      }
+#endif
+    default:
+      return(method_or_bust_p(sc, x, sc->angle_symbol, a_number_string));
+    }
+}
+
+static s7_double angle_d_d(s7_double x) {return((is_NaN(x)) ? x : ((x < 0.0) ? M_PI : 0.0));}
+
+
+/* -------------------------------- complex -------------------------------- */
+
+static s7_pointer complex_p_pp(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+#if WITH_GMP
+  if ((is_big_number(x)) || (is_big_number(y)))
+    {
+      s7_pointer p0 = x, p1 = y, p = NULL;
+
+      if (!is_real(p0))
+	return(method_or_bust(sc, p0, sc->complex_symbol, set_plist_2(sc, x, y), sc->type_names[T_REAL], 1));
+      if (!is_real(p1))
+	return(method_or_bust(sc, p1, sc->complex_symbol, set_plist_2(sc, x, y), sc->type_names[T_REAL], 2));
+
+      switch (type(p1))
+	{
+	case T_INTEGER: case T_RATIO: case T_REAL:
+	  {
+	    s7_double iz = s7_real(p1);
+	    if (iz == 0.0)                      /* imag-part is 0.0 */
+	      return(p0);
+	    new_cell(sc, p, T_BIG_COMPLEX);
+	    big_complex_bgc(p) = alloc_bigcmp(sc);
+	    mpfr_set_d(mpc_imagref(big_complex(p)), iz, MPFR_RNDN);
+	  }
+	  break;
+	case T_BIG_REAL:
+	  if (mpfr_zero_p(big_real(p1))) return(p0);
+	  new_cell(sc, p, T_BIG_COMPLEX);
+	  big_complex_bgc(p) = alloc_bigcmp(sc);
+	  mpfr_set(mpc_imagref(big_complex(p)), big_real(p1), MPFR_RNDN);
+	  break;
+	case T_BIG_RATIO:
+	  new_cell(sc, p, T_BIG_COMPLEX);
+	  big_complex_bgc(p) = alloc_bigcmp(sc);
+	  mpfr_set_q(mpc_imagref(big_complex(p)), big_ratio(p1), MPFR_RNDN);
+	  break;
+	case T_BIG_INTEGER:
+	  if (mpz_cmp_ui(big_integer(p1), 0) == 0) return(p0);
+	  new_cell(sc, p, T_BIG_COMPLEX);
+	  big_complex_bgc(p) = alloc_bigcmp(sc);
+	  mpfr_set_z(mpc_imagref(big_complex(p)), big_integer(p1), MPFR_RNDN);
+	  break;
+	}
+      switch (type(p0))
+	{
+	case T_INTEGER: case T_RATIO: case T_REAL:
+	  mpfr_set_d(mpc_realref(big_complex(p)), s7_real(p0), MPFR_RNDN);
+	  break;
+	case T_BIG_REAL:
+	  mpfr_set(mpc_realref(big_complex(p)), big_real(p0), MPFR_RNDN);
+	  break;
+	case T_BIG_RATIO:
+	  mpfr_set_q(mpc_realref(big_complex(p)), big_ratio(p0), MPFR_RNDN);
+	  break;
+	case T_BIG_INTEGER:
+	  mpfr_set_z(mpc_realref(big_complex(p)), big_integer(p0), MPFR_RNDN);
+	  break;
+	}
+      add_big_complex(sc, p);
+      return(p);
+    }
+#endif
+  if ((is_t_real(x)) && (is_t_real(y))) return((real(y) == 0.0) ? x : make_complex_not_0i(sc, real(x), real(y)));
+  switch (type(y))
+    {
+    case T_INTEGER:
+      switch (type(x))
+	{
+	case T_INTEGER: return((integer(y) == 0) ? x : make_complex_not_0i(sc, (s7_double)integer(x), (s7_double)integer(y)));
+	  /* these int->dbl's are problematic:
+	   *   (complex 9223372036854775807 9007199254740995): 9223372036854776000.0+9007199254740996.0i
+	   * should we raise an error?
+	   */
+	case T_RATIO:  return((integer(y) == 0) ? x : make_complex_not_0i(sc, (s7_double)fraction(x), (s7_double)integer(y)));
+	case T_REAL:   return((integer(y) == 0) ? x : make_complex_not_0i(sc, real(x), (s7_double)integer(y)));
+	default:       return(method_or_bust(sc, x, sc->complex_symbol, set_plist_2(sc, x, y), sc->type_names[T_REAL], 1));
+	}
+    case T_RATIO:
+      switch (type(x))
+	{
+	case T_INTEGER: return(make_complex(sc, (s7_double)integer(x), (s7_double)fraction(y))); /* can fraction be 0.0? */
+	case T_RATIO:   return(make_complex(sc, (s7_double)fraction(x), (s7_double)fraction(y)));
+	case T_REAL:    return(make_complex(sc, real(x), (s7_double)fraction(y)));
+	default:	return(method_or_bust(sc, x, sc->complex_symbol, set_plist_2(sc, x, y), sc->type_names[T_REAL], 1));
+	}
+    case T_REAL:
+      switch (type(x))
+	{
+	case T_INTEGER: return((real(y) == 0.0) ? x : make_complex_not_0i(sc, (s7_double)integer(x), real(y)));
+	case T_RATIO:	return((real(y) == 0.0) ? x : make_complex_not_0i(sc, (s7_double)fraction(x), real(y)));
+	case T_REAL:    return((real(y) == 0.0) ? x : make_complex_not_0i(sc, real(x), real(y)));
+	default:	return(method_or_bust(sc, x, sc->complex_symbol, set_plist_2(sc, x, y), sc->type_names[T_REAL], 1));
+	}
+    default:
+      return(method_or_bust(sc, (is_let(x)) ? x : y, sc->complex_symbol, set_plist_2(sc, x, y), sc->type_names[T_REAL], 2));
+    }
+}
+
+static s7_pointer g_complex(s7_scheme *sc, s7_pointer args)
+{
+  #define H_complex "(complex x1 x2) returns a complex number with real-part x1 and imaginary-part x2"
+  #define Q_complex s7_make_signature(sc, 3, sc->is_number_symbol, sc->is_real_symbol, sc->is_real_symbol)
+  return(complex_p_pp(sc, car(args), cadr(args)));
+}
+
+static s7_pointer complex_p_ii(s7_scheme *sc, s7_int x, s7_int y)
+{
+  return((y == 0.0) ? make_integer(sc, x) : make_complex_not_0i(sc, (s7_double)x, (s7_double)y));
+}
+
+static s7_pointer complex_p_dd(s7_scheme *sc, s7_double x, s7_double y)
+{
+  return((y == 0.0) ? make_real(sc, x) : make_complex_not_0i(sc, x, y));
+}
+
+
+/* -------------------------------- bignum -------------------------------- */
+static s7_pointer g_bignum(s7_scheme *sc, s7_pointer args)
+{
+  #define H_bignum "(bignum val (radix 10)) returns a multiprecision version of the string 'val'. If the argument is a number \
+bignum returns that number as a bignum"
+#if WITH_GMP
+  #define Q_bignum s7_make_signature(sc, 3, sc->is_bignum_symbol, s7_make_signature(sc, 2, sc->is_number_symbol, sc->is_string_symbol), sc->is_integer_symbol)
+#else
+  #define Q_bignum s7_make_signature(sc, 3, \
+                     s7_make_signature(sc, 2, sc->is_number_symbol, sc->not_symbol), \
+                     s7_make_signature(sc, 2, sc->is_number_symbol, sc->is_string_symbol), \
+                     sc->is_integer_symbol)
+#endif
+
+  s7_pointer p = car(args);
+  if (is_number(p))
+    {
+      if (!is_null(cdr(args)))
+	error_nr(sc, make_symbol(sc, "bignum-error", 12),
+		 set_elist_2(sc, wrap_string(sc, "bignum of a number takes only one argument: ~S", 46), args));
+#if WITH_GMP
+      switch (type(p))
+	{
+	case T_INTEGER: return(s7_int_to_big_integer(sc, integer(p)));
+	case T_RATIO:   return(s7_int_to_big_ratio(sc, numerator(p), denominator(p)));
+	case T_REAL:    return(s7_double_to_big_real(sc, real(p)));
+	case T_COMPLEX: return(s7_double_to_big_complex(sc, real_part(p), imag_part(p)));
+	default:        return(p);
+	}
+#else
+      return(p);
+#endif
+    }
+  p = g_string_to_number_1(sc, args, sc->bignum_symbol);
+  if (is_false(sc, p))                                       /* (bignum "1/3.0") */
+    error_nr(sc, make_symbol(sc, "bignum-error", 12),
+	     set_elist_2(sc, wrap_string(sc, "bignum string argument does not represent a number: ~S", 54), car(args)));
+#if WITH_GMP
+  switch (type(p))
+    {
+    case T_INTEGER:   return(s7_int_to_big_integer(sc, integer(p)));
+    case T_RATIO:     return(s7_int_to_big_ratio(sc, numerator(p), denominator(p)));
+    case T_COMPLEX:   return(s7_number_to_big_complex(sc, p));
+    case T_REAL:
+      if (is_NaN(real(p))) return(p);
+      return(s7_double_to_big_real(sc, real(p)));
+      /* 9Sep21: this was return(string_to_big_real(sc, string_value(car(args)), (is_pair(cdr(args))) ? s7_integer_clamped_if_gmp(sc, cadr(args)) : 10)); */
+    default:
+      return(p);
+    }
+#else
+  return(p);
+#endif
+}
+
+
+/* -------------------------------- exp -------------------------------- */
+#if (!HAVE_COMPLEX_NUMBERS)
+  static s7_pointer no_complex_numbers_string;
+#endif
+
+#define EXP_LIMIT 100.0
+
+#if WITH_GMP
+static s7_pointer exp_1(s7_scheme *sc, s7_double x)
+{
+  mpfr_set_d(sc->mpfr_1, x, MPFR_RNDN);
+  mpfr_exp(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+  return(mpfr_to_big_real(sc, sc->mpfr_1));
+}
+
+static s7_pointer exp_2(s7_scheme *sc, s7_double x, s7_double y)
+{
+  mpc_set_d_d(sc->mpc_1, x, y, MPC_RNDNN);
+  mpc_exp(sc->mpc_1, sc->mpc_1, MPC_RNDNN);
+  return(mpc_to_number(sc, sc->mpc_1));
+}
+#endif
+
+static s7_pointer exp_p_p(s7_scheme *sc, s7_pointer x)
+{
+  s7_double z;
+  switch (type(x))
+    {
+    case T_INTEGER:
+      if (integer(x) == 0) return(int_one);                       /* (exp 0) -> 1 */
+      z = (s7_double)integer(x);
+#if WITH_GMP
+      if (fabs(z) > EXP_LIMIT)
+	return(exp_1(sc, z));
+#endif
+      return(make_real(sc, exp(z)));
+
+    case T_RATIO:
+      z = (s7_double)fraction(x);
+#if WITH_GMP
+      if (fabs(z) > EXP_LIMIT)
+	return(exp_1(sc, z));
+#endif
+      return(make_real(sc, exp(z)));
+
+    case T_REAL:
+#if WITH_GMP
+      if (fabs(real(x)) > EXP_LIMIT)
+	return(exp_1(sc, real(x)));
+#endif
+      return(make_real(sc, exp(real(x))));
+
+    case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+#if WITH_GMP
+      if ((fabs(real_part(x)) > EXP_LIMIT) ||
+	  (fabs(imag_part(x)) > EXP_LIMIT))
+	return(exp_2(sc, real_part(x), imag_part(x)));
+#endif
+      return(c_complex_to_s7(sc, cexp(to_c_complex(x))));
+      /* this is inaccurate for large arguments:
+       *   (exp 0+1e20i) -> -0.66491178990701-0.74692189125949i, not 7.639704044417283004001468027378811228331E-1-6.45251285265780844205811711312523007406E-1i
+       */
+#else
+      out_of_range_error_nr(sc, sc->exp_symbol, int_one, x, no_complex_numbers_string);
+#endif
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpfr_set_z(sc->mpfr_1, big_integer(x), MPFR_RNDN);
+      mpfr_exp(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_RATIO:
+      mpfr_set_q(sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+      mpfr_exp(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_REAL:
+      mpfr_exp(sc->mpfr_1, big_real(x), MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_COMPLEX:
+      mpc_exp(sc->mpc_1, big_complex(x), MPC_RNDNN);
+      if (mpfr_zero_p(mpc_imagref(sc->mpc_1)))
+	return(mpfr_to_big_real(sc, mpc_realref(sc->mpc_1)));
+      return(mpc_to_number(sc, sc->mpc_1));
+#endif
+    default:
+      return(method_or_bust_p(sc, x, sc->exp_symbol, a_number_string));
+    }
+}
+
+static s7_pointer g_exp(s7_scheme *sc, s7_pointer args)
+{
+  #define H_exp "(exp z) returns e^z, (exp 1) is 2.718281828459"
+  #define Q_exp sc->pl_nn
+  return(exp_p_p(sc, car(args)));
+}
+
+static s7_double exp_d_d(s7_double x) {return(exp(x));}
+static s7_pointer exp_p_d(s7_scheme *sc, s7_double x) {return(make_real(sc, exp(x)));}
+
+
+/* -------------------------------- log -------------------------------- */
+#if __cplusplus
+#define LOG_2 1.4426950408889634074
+#else
+#define LOG_2 1.4426950408889634073599246810018921L /* (/ (log 2.0)) */
+#endif
+
+#if WITH_GMP
+static s7_pointer big_log(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer p0 = car(args), p1 = NULL, res;
+
+  if (!is_number(p0))
+    return(method_or_bust(sc, p0, sc->log_symbol, args, a_number_string, 1));
+
+  if (is_pair(cdr(args)))
+    {
+      p1 = cadr(args);
+      if (!is_number(p1))
+	return(method_or_bust(sc, p1, sc->log_symbol, args, a_number_string, 2));
+    }
+
+  if (is_real(p0))
+    {
+      res = any_real_to_mpfr(sc, p0, sc->mpfr_1);
+      if (res == real_NaN) return(res);
+      if ((is_positive(sc, p0)) &&
+	  ((!p1) ||
+	   ((is_real(p1)) && (is_positive(sc, p1)))))
+	{
+	  if (res) return(res);
+	  mpfr_log(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+	  if (p1)
+	    {
+	      res = any_real_to_mpfr(sc, p1, sc->mpfr_2);
+	      if (res)
+		return((res == real_infinity) ? real_zero : res);
+	      if (mpfr_zero_p(sc->mpfr_2))
+		out_of_range_error_nr(sc, sc->log_symbol, int_two, p1, wrap_string(sc, "can't be zero", 13));
+	      mpfr_log(sc->mpfr_2, sc->mpfr_2, MPFR_RNDN);
+	      mpfr_div(sc->mpfr_1, sc->mpfr_1, sc->mpfr_2, MPFR_RNDN);
+	    }
+	  if ((mpfr_integer_p(sc->mpfr_1)) && ((is_rational(p0)) && ((!p1) || (is_rational(p1)))))
+	    return(mpfr_to_integer(sc, sc->mpfr_1));
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	}}
+  if (p1)
+    {
+      res = any_number_to_mpc(sc, p1, sc->mpc_2);
+      if (res)
+	return((res == real_infinity) ? real_zero : complex_NaN);
+      if (mpc_zero_p(sc->mpc_2))
+	out_of_range_error_nr(sc, sc->log_symbol, int_two, p1, wrap_string(sc, "can't be zero", 13));
+    }
+  res = any_number_to_mpc(sc, p0, sc->mpc_1);
+  if (res)
+    {
+      if ((res == real_infinity) && (p1) && ((is_negative(sc, p0))))
+	return(make_complex_not_0i(sc, INFINITY, -NAN));
+      return((res == real_NaN) ? complex_NaN : res);
+    }
+  mpc_log(sc->mpc_1, sc->mpc_1, MPC_RNDNN);
+  if (p1)
+    {
+      mpc_log(sc->mpc_2, sc->mpc_2, MPC_RNDNN);
+      mpc_div(sc->mpc_1, sc->mpc_1, sc->mpc_2, MPC_RNDNN);
+    }
+  if (mpfr_zero_p(mpc_imagref(sc->mpc_1)))
+    return(mpfr_to_big_real(sc, mpc_realref(sc->mpc_1)));
+  return(mpc_to_number(sc, sc->mpc_1));
+}
+#endif
+
+static s7_pointer g_int_log2(s7_scheme *sc, s7_pointer args)
+{
+  s7_int ix = integer(car(args));
+  s7_double fx = log2((double)ix);
+  return(((ix & (ix - 1)) == 0) ? make_integer(sc, (s7_int)s7_round(fx)) : make_real(sc, fx));
+}
+
+static s7_pointer g_log(s7_scheme *sc, s7_pointer args)
+{
+  #define H_log "(log z1 (z2 e)) returns log(z1) / log(z2) where z2 (the base) defaults to e: (log 8 2) = 3"
+  #define Q_log sc->pcl_n
+
+  s7_pointer x = car(args);
+
+#if WITH_GMP
+  if (is_big_number(x)) return(big_log(sc, args));
+#endif
+
+  if (!is_number(x))
+    return(method_or_bust(sc, x, sc->log_symbol, args, a_number_string, 1));
+
+  if (is_pair(cdr(args)))
+    {
+      s7_pointer y = cadr(args);
+      if (!(is_number(y)))
+	return(method_or_bust(sc, y, sc->log_symbol, args, a_number_string, 2));
+
+#if WITH_GMP
+      if (is_big_number(y)) return(big_log(sc, args));
+#endif
+      if ((is_t_integer(y)) && (integer(y) == 2))
+	{
+	  /* (define (2^n? x) (and (not (zero? x)) (zero? (logand x (- x 1))))) */
+	  if (is_t_integer(x))
+	    {
+	      s7_int ix = integer(x);
+	      if (ix > 0)
+		{
+		  s7_double fx;
+#if (__ANDROID__) || (MS_WINDOWS) || (((__GNUC__) && ((__GNUC__ < 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ <= 4)))) && (!defined(__clang__)))
+		  /* just a guess -- log2 gets a warning in gcc 4.3.2, but not in 4.4.4 */
+		  fx = log((double)ix) * LOG_2;
+#else
+		  fx = log2((double)ix);
+#endif
+		  /* (s7_int)fx rounds (log 8 2) to 2 in FreeBSD! */
+#if (((__GNUC__) && ((__GNUC__ < 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ < 4)))) && (!defined(__clang__)))
+		  return(make_real(sc, fx));
+#else
+		  return(((ix & (ix - 1)) == 0) ? make_integer(sc, (s7_int)s7_round(fx)) : make_real(sc, fx));
+#endif
+		}}
+	  if ((is_real(x)) &&
+	      (is_positive(sc, x)))
+	    return(make_real(sc, log(s7_real(x)) * LOG_2));
+	  return(c_complex_to_s7(sc, clog(s7_to_c_complex(x)) * LOG_2));
+	}
+
+      if ((is_t_integer(x)) && (integer(x) == 1) && (is_t_integer(y)) && (integer(y) == 1))  /* (log 1 1) -> 0 (this is NaN in the bignum case) */
+	return(int_zero);
+
+      /* (log 1 0) must be 0 since everyone says (expt 0 0) is 1 */
+      if (is_zero(y))
+	{
+	  if ((is_t_integer(y)) && (is_t_integer(x)) && (integer(x) == 1))
+	    return(y);
+	  out_of_range_error_nr(sc, sc->log_symbol, int_two, y, wrap_string(sc, "can't be zero", 13));
+	}
+
+      if ((is_t_real(x)) && (is_NaN(real(x))))
+	return(x);
+      if (is_one(y))                                     /* this used to raise an error, but the bignum case is simpler if we return inf */
+	return((is_one(x)) ? real_zero : real_infinity); /* but (log 1.0 1.0) -> 0.0, currently (log 1/0 1) is inf? */
+
+      if ((is_real(x)) &&
+	  (is_real(y)) &&
+	  (is_positive(sc, x)) &&
+	  (is_positive(sc, y)))
+	{
+	  if ((is_rational(x)) &&
+	      (is_rational(y)))
+	    {
+	      s7_double res = log(rational_to_double(sc, x)) / log(rational_to_double(sc, y));
+	      s7_int ires = (s7_int)res;
+	      if (res - ires == 0.0)
+		return(make_integer(sc, ires));   /* (log 8 2) -> 3 or (log 1/8 2) -> -3 */
+	      /* since x and y are rational here, it seems reasonable to try to rationalize the result, but not go overboard?
+	       *   what about (expt 16 3/2) -> 64?  also 2 as base is handled above and always returns a float.
+	       */
+	      if (fabs(res) < RATIONALIZE_LIMIT)
+		{
+		  s7_int num, den;
+		  if ((c_rationalize(res, sc->default_rationalize_error, &num, &den)) &&
+		      (s7_int_abs(num) < 100) && (s7_int_abs(den) < 100))
+		    return(make_simple_ratio(sc, num, den));
+		}
+	      return(make_real(sc, res));
+	    }
+	  return(make_real(sc, log(s7_real(x)) / log(s7_real(y))));
+	}
+      if ((is_t_real(x)) && (is_NaN(real(x))))
+	return(x);
+      if ((is_t_complex(y)) && ((is_NaN(real_part(y))) || (is_NaN(imag_part(y)))))
+	return(y);
+      return(c_complex_to_s7(sc, clog(s7_to_c_complex(x)) / clog(s7_to_c_complex(y))));
+    }
+
+  if (!is_real(x))
+    return(c_complex_to_s7(sc, clog(s7_to_c_complex(x))));
+  if (is_positive(sc, x))
+    return(make_real(sc, log(s7_real(x))));
+  return(make_complex_not_0i(sc, log(-s7_real(x)), M_PI));
+}
+
+static s7_pointer log_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+#if (!WITH_GMP)
+  if (args == 2)
+    {
+      s7_pointer x = cadr(expr), y = caddr(expr);
+      if ((is_t_integer(y)) && (integer(y) == 2) && (is_t_integer(x)) && (integer(x) > 0))
+	return(sc->int_log2);
+    }
+#endif
+  return(f);
+}
+
+/* -------------------------------- sin -------------------------------- */
+#define SIN_LIMIT 1.0e16
+#define SINH_LIMIT 20.0
+/* (- (sinh (bignum 30.0)) (sinh 30.0)): -3.718172657214174140191915872003397016115E-4
+ * (- (sinh (bignum 20.0)) (sinh 20.0)): -7.865629467297586346406367346575835463792E-10, slightly worse (e-8) if imag-part
+ */
+
+static s7_pointer sin_p_p(s7_scheme *sc, s7_pointer x)
+{
+#if (!WITH_GMP)
+  if (is_t_real(x)) return(make_real(sc, sin(real(x)))); /* range check in gmp case */
+#endif
+  switch (type(x))
+    {
+    case T_INTEGER:
+      if (integer(x) == 0) return(int_zero);           /* (sin 0) -> 0 */
+#if WITH_GMP
+      if (integer(x) > SIN_LIMIT)
+	{
+	  mpz_set_si(sc->mpz_1, integer(x));
+	  mpfr_set_z(sc->mpfr_1, sc->mpz_1, MPFR_RNDN);
+	  mpfr_sin(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	}
+#endif
+      return(make_real(sc, sin((s7_double)(integer(x))))); /* bogus for very large integers, but so is the equivalent real (see SIN_LIMIT) */
+
+    case T_RATIO:
+      return(make_real(sc, sin((s7_double)(fraction(x)))));
+
+    case T_REAL:
+      {
+	s7_double y = real(x);
+#if WITH_GMP
+	if (fabs(y) > SIN_LIMIT)
+	  {
+	    mpfr_set_d(sc->mpfr_1, y, MPFR_RNDN);
+	    mpfr_sin(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+	    return(mpfr_to_big_real(sc, sc->mpfr_1));
+	  }
+#endif
+	return(make_real(sc, sin(y)));
+      }
+
+    case T_COMPLEX:
+#if WITH_GMP
+      if ((fabs(real_part(x)) > SIN_LIMIT) || (fabs(imag_part(x)) > SINH_LIMIT))
+	{
+	  mpc_set_d_d(sc->mpc_1, real_part(x), imag_part(x), MPC_RNDNN);
+	  mpc_sin(sc->mpc_1, sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	}
+#endif
+#if HAVE_COMPLEX_NUMBERS
+      return(c_complex_to_s7(sc, csin(to_c_complex(x))));
+#else
+      out_of_range_error_nr(sc, sc->sin_symbol, int_one, x, no_complex_numbers_string);
+#endif
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpfr_set_z(sc->mpfr_1, big_integer(x), MPFR_RNDN);
+      mpfr_sin(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_RATIO:
+      mpfr_set_q(sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+      mpfr_sin(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_REAL:
+      mpfr_sin(sc->mpfr_1, big_real(x), MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_COMPLEX:
+      mpc_sin(sc->mpc_1, big_complex(x), MPC_RNDNN);
+      if (mpfr_zero_p(mpc_imagref(sc->mpc_1)))
+	return(mpfr_to_big_real(sc, mpc_realref(sc->mpc_1)));
+      return(mpc_to_number(sc, sc->mpc_1));
+#endif
+    default:
+      return(method_or_bust_p(sc, x, sc->sin_symbol, a_number_string));
+    }
+  /* sin is inaccurate over about 1e30.  There's a way to get true results, but it involves fancy "range reduction" techniques.
+   * (sin 1e32): 0.5852334864823946
+   *   but it should be 3.901970254333630491697613212893425767786E-1
+   * (remainder 1e22 (* 2 pi)) -> 1.0057952155665e+22 !! (it's now a range error)
+   *   it should be 5.263007914620499494429139986095833592117E0
+   * before comparing imag-part to 0, we need to look for NaN and inf, else:
+   *    (sinh 0+0/0i) -> 0.0 and (sinh (log 0.0)) -> inf.0
+   */
+}
+
+static s7_pointer g_sin(s7_scheme *sc, s7_pointer args)
+{
+  #define H_sin "(sin z) returns sin(z)"
+  #define Q_sin sc->pl_nn
+  return(sin_p_p(sc, car(args)));
+}
+
+#if WITH_GMP
+static s7_pointer sin_p_d(s7_scheme *sc, s7_double x)
+{
+  if (fabs(x) <= SIN_LIMIT)
+    return(make_real(sc, sin(x)));
+  mpfr_set_d(sc->mpfr_1, x, MPFR_RNDN);
+  mpfr_sin(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+  return(mpfr_to_big_real(sc, sc->mpfr_1));
+}
+#else
+static s7_pointer sin_p_d(s7_scheme *sc, s7_double x) {return(make_real(sc, sin(x)));}
+#endif
+
+static s7_double sin_d_d(s7_double x) {return(sin(x));}
+
+
+/* -------------------------------- cos -------------------------------- */
+static s7_pointer cos_p_p(s7_scheme *sc, s7_pointer x)
+{
+#if (!WITH_GMP)
+  if (is_t_real(x)) return(make_real(sc, cos(real(x)))); /* range check in gmp case */
+#endif
+  switch (type(x))
+    {
+    case T_INTEGER:
+      if (integer(x) == 0) return(int_one);             /* (cos 0) -> 1 */
+#if WITH_GMP
+      if (integer(x) > SIN_LIMIT)
+	{
+	  mpz_set_si(sc->mpz_1, integer(x));
+	  mpfr_set_z(sc->mpfr_1, sc->mpz_1, MPFR_RNDN);
+	  mpfr_cos(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	}
+#endif
+      return(make_real(sc, cos((s7_double)(integer(x)))));
+
+    case T_RATIO:
+      return(make_real(sc, cos((s7_double)(fraction(x)))));
+
+    case T_REAL: /* if with_gmp */
+      {
+	s7_double y = real(x);
+#if WITH_GMP
+	if (fabs(y) > SIN_LIMIT)
+	  {
+	    mpfr_set_d(sc->mpfr_1, y, MPFR_RNDN);
+	    mpfr_cos(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+	    return(mpfr_to_big_real(sc, sc->mpfr_1));
+	  }
+#endif
+	return(make_real(sc, cos(y)));
+      }
+
+    case T_COMPLEX:
+#if WITH_GMP
+      if ((fabs(real_part(x)) > SIN_LIMIT) || (fabs(imag_part(x)) > SINH_LIMIT))
+	{
+	  mpc_set_d_d(sc->mpc_1, real_part(x), imag_part(x), MPC_RNDNN);
+	  mpc_cos(sc->mpc_1, sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	}
+#endif
+#if HAVE_COMPLEX_NUMBERS
+      return(c_complex_to_s7(sc, ccos(to_c_complex(x))));
+#else
+      out_of_range_error_nr(sc, sc->cos_symbol, int_one, x, no_complex_numbers_string);
+#endif
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpfr_set_z(sc->mpfr_1, big_integer(x), MPFR_RNDN);
+      mpfr_cos(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_RATIO:
+      mpfr_set_q(sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+      mpfr_cos(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_REAL:
+      mpfr_cos(sc->mpfr_1, big_real(x), MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_COMPLEX:
+      mpc_cos(sc->mpc_1, big_complex(x), MPC_RNDNN);
+      if (mpfr_zero_p(mpc_imagref(sc->mpc_1)))
+	return(mpfr_to_big_real(sc, mpc_realref(sc->mpc_1)));
+      return(mpc_to_number(sc, sc->mpc_1));
+#endif
+    default:
+      return(method_or_bust_p(sc, x, sc->cos_symbol, a_number_string));
+    }
+}
+
+static s7_pointer g_cos(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cos "(cos z) returns cos(z)"
+  #define Q_cos sc->pl_nn
+  return(cos_p_p(sc, car(args)));
+}
+
+#if WITH_GMP
+static s7_pointer cos_p_d(s7_scheme *sc, s7_double x)
+{
+  if (fabs(x) <= SIN_LIMIT)
+    return(make_real(sc, cos(x)));
+  mpfr_set_d(sc->mpfr_1, x, MPFR_RNDN);
+  mpfr_cos(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+  return(mpfr_to_big_real(sc, sc->mpfr_1));
+}
+#else
+static s7_pointer cos_p_d(s7_scheme *sc, s7_double x) {return(make_real(sc, cos(x)));}
+#endif
+
+static s7_double cos_d_d(s7_double x) {return(cos(x));}
+
+
+/* -------------------------------- tan -------------------------------- */
+#define TAN_LIMIT 1.0e18
+
+static s7_pointer tan_p_p(s7_scheme *sc, s7_pointer x)
+{
+#if (!WITH_GMP)
+  if (is_t_real(x)) return(make_real(sc, tan(real(x))));
+#endif
+  switch (type(x))
+    {
+    case T_INTEGER:
+      if (integer(x) == 0) return(int_zero);                      /* (tan 0) -> 0 */
+#if WITH_GMP
+      if (integer(x) > TAN_LIMIT)
+	{
+	  mpz_set_si(sc->mpz_1, integer(x));
+	  mpfr_set_z(sc->mpfr_1, sc->mpz_1, MPFR_RNDN);
+	  mpfr_tan(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	}
+#endif
+      return(make_real(sc, tan((s7_double)(integer(x)))));
+
+    case T_RATIO:
+      return(make_real(sc, tan((s7_double)(fraction(x)))));
+
+#if WITH_GMP
+    case T_REAL:
+      if (fabs(real(x)) > TAN_LIMIT)
+	{
+	  mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	  mpfr_tan(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	}
+#endif
+      return(make_real(sc, tan(real(x))));
+
+    case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+      if (imag_part(x) > 350.0)
+	return(make_complex_not_0i(sc, 0.0, 1.0));
+      return((imag_part(x) < -350.0) ? make_complex_not_0i(sc, 0.0, -1.0) : c_complex_to_s7(sc, ctan(to_c_complex(x))));
+#else
+      out_of_range_error_nr(sc, sc->tan_symbol, int_one, x, no_complex_numbers_string);
+#endif
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpfr_set_z(sc->mpfr_1, big_integer(x), MPFR_RNDN);
+      mpfr_tan(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_RATIO:
+      mpfr_set_q(sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+      mpfr_tan(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_REAL:
+      mpfr_tan(sc->mpfr_1, big_real(x), MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_COMPLEX:
+      if ((MPC_INEX_IM(mpc_cmp_si_si(big_complex(x), 1, 350))) > 0)
+	return(make_complex_not_0i(sc, 0.0, 1.0));
+      if ((MPC_INEX_IM(mpc_cmp_si_si(big_complex(x), 1, -350))) < 0)
+	return(make_complex_not_0i(sc, 0.0, -1.0));
+      mpc_tan(sc->mpc_1, big_complex(x), MPC_RNDNN);
+      if (mpfr_zero_p(mpc_imagref(sc->mpc_1)))
+	return(mpfr_to_big_real(sc, mpc_realref(sc->mpc_1)));
+      return(mpc_to_number(sc, sc->mpc_1));
+#endif
+    default:
+      return(method_or_bust_p(sc, x, sc->tan_symbol, a_number_string));
+    }
+}
+
+static s7_pointer g_tan(s7_scheme *sc, s7_pointer args)
+{
+  #define H_tan "(tan z) returns tan(z)"
+  #define Q_tan sc->pl_nn
+  return(tan_p_p(sc, car(args)));
+}
+
+static s7_double tan_d_d(s7_double x) {return(tan(x));}
+
+
+/* -------------------------------- asin -------------------------------- */
+static s7_pointer c_asin(s7_scheme *sc, s7_double x)
+{
+  s7_double absx = fabs(x), recip;
+  s7_complex result;
+
+  if (absx <= 1.0) return(make_real(sc, asin(x)));
+
+  /* otherwise use maxima code: */
+  recip = 1.0 / absx;
+  result = (M_PI / 2.0) - (s7_complex_i * clog(absx * (1.0 + (sqrt(1.0 + recip) * csqrt(1.0 - recip)))));
+  return((x < 0.0) ? c_complex_to_s7(sc, -result) : c_complex_to_s7(sc, result));
+}
+
+static s7_pointer asin_p_p(s7_scheme *sc, s7_pointer p)
+{
+  if (is_t_real(p)) return(c_asin(sc, real(p)));
+  switch (type(p))
+    {
+    case T_INTEGER:
+      if (integer(p) == 0) return(int_zero);                    /* (asin 0) -> 0 */
+      /* in netBSD, (asin 2) returns 0.25383842987008+0.25383842987008i according to Peter Bex */
+      return(c_asin(sc, (s7_double)integer(p)));
+
+    case T_RATIO:
+      return(c_asin(sc, fraction(p)));
+
+    case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+      /* if either real or imag part is very large, use explicit formula, not casin */
+      /*   this code taken from sbcl's src/code/irrat.lisp; break is around x+70000000i */
+      if ((fabs(real_part(p)) > 1.0e7) ||
+	  (fabs(imag_part(p)) > 1.0e7))
+	{
+	  s7_complex sq1mz, sq1pz, z = to_c_complex(p);
+	  sq1mz = csqrt(1.0 - z);
+	  sq1pz = csqrt(1.0 + z);
+	  return(make_complex(sc, atan(real_part(p) / creal(sq1mz * sq1pz)), asinh(cimag(sq1pz * conj(sq1mz)))));
+	}
+      return(c_complex_to_s7(sc, casin(to_c_complex(p))));
+#else
+      out_of_range_error_nr(sc, sc->asin_symbol, int_one, p, no_complex_numbers_string);
+#endif
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpfr_set_z(sc->mpfr_1, big_integer(p), MPFR_RNDN);
+      goto ASIN_BIG_REAL;
+    case T_BIG_RATIO:
+      mpfr_set_q(sc->mpfr_1, big_ratio(p), MPFR_RNDN);
+      goto ASIN_BIG_REAL;
+    case T_BIG_REAL:
+      if (mpfr_inf_p(big_real(p)))
+	{
+	  if (mpfr_cmp_ui(big_real(p), 0) < 0)
+	    return(make_complex_not_0i(sc, NAN, INFINITY)); /* match non-bignum choice */
+	  return(make_complex_not_0i(sc, NAN, -INFINITY));
+	}
+      mpfr_set(sc->mpfr_1, big_real(p), MPFR_RNDN);
+    ASIN_BIG_REAL:
+      mpfr_set_ui(sc->mpfr_2, 1, MPFR_RNDN);
+      if (mpfr_cmpabs(sc->mpfr_1, sc->mpfr_2) <= 0)
+	{
+	  mpfr_asin(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	}
+      mpc_set_fr(sc->mpc_1, sc->mpfr_1, MPC_RNDNN);
+      mpc_asin(sc->mpc_1, sc->mpc_1, MPC_RNDNN);
+      return(mpc_to_number(sc, sc->mpc_1));
+    case T_BIG_COMPLEX:
+      mpc_asin(sc->mpc_1, big_complex(p), MPC_RNDNN);
+      return(mpc_to_number(sc, sc->mpc_1));
+#endif
+    default:
+      return(method_or_bust_p(sc, p, sc->asin_symbol, a_number_string));
+    }
+}
+
+static s7_pointer g_asin(s7_scheme *sc, s7_pointer args)
+{
+  #define H_asin "(asin z) returns asin(z); (sin (asin x)) = x"
+  #define Q_asin sc->pl_nn
+  return(asin_p_p(sc, car(args)));
+}
+
+
+/* -------------------------------- acos -------------------------------- */
+static s7_pointer c_acos(s7_scheme *sc, s7_double x)
+{
+  s7_double absx = fabs(x), recip;
+  s7_complex result;
+
+  if (absx <= 1.0)
+    return(make_real(sc, acos(x)));
+
+  /* else follow maxima again: */
+  recip = 1.0 / absx;
+  if (x > 0.0)
+    result = s7_complex_i * clog(absx * (1.0 + (sqrt(1.0 + recip) * csqrt(1.0 - recip))));
+  else result = M_PI - s7_complex_i * clog(absx * (1.0 + (sqrt(1.0 + recip) * csqrt(1.0 - recip))));
+  return(c_complex_to_s7(sc, result));
+}
+
+static s7_pointer acos_p_p(s7_scheme *sc, s7_pointer p)
+{
+  if (is_t_real(p)) return(c_acos(sc, real(p)));
+  switch (type(p))
+    {
+    case T_INTEGER:
+      return((integer(p) == 1) ? int_zero : c_acos(sc, (s7_double)integer(p)));
+
+    case T_RATIO:
+      return(c_acos(sc, fraction(p)));
+
+    case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+      /* if either real or imag part is very large, use explicit formula, not cacos */
+      /*   this code taken from sbcl's src/code/irrat.lisp */
+
+      if ((fabs(real_part(p)) > 1.0e7) ||
+	  (fabs(imag_part(p)) > 1.0e7))
+	{
+	  s7_complex sq1mz, sq1pz, z = to_c_complex(p);
+	  sq1mz = csqrt(1.0 - z);
+	  sq1pz = csqrt(1.0 + z);	  /* creal(sq1pz) can be 0.0 */
+	  if (creal(sq1pz) == 0.0)        /* so the atan arg will be inf, so the real part will be pi/2(?) */
+	    return(make_complex(sc, M_PI / 2.0, asinh(cimag(sq1mz * conj(sq1pz)))));
+	  return(make_complex(sc, 2.0 * atan(creal(sq1mz) / creal(sq1pz)), asinh(cimag(sq1mz * conj(sq1pz)))));
+	}
+      return(c_complex_to_s7(sc, cacos(s7_to_c_complex(p))));
+#else
+      out_of_range_error_nr(sc, sc->acos_symbol, int_one, p, no_complex_numbers_string);
+#endif
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpfr_set_z(sc->mpfr_1, big_integer(p), MPFR_RNDN);
+      goto ACOS_BIG_REAL;
+    case T_BIG_RATIO:
+      mpfr_set_q(sc->mpfr_1, big_ratio(p), MPFR_RNDN);
+      goto ACOS_BIG_REAL;
+    case T_BIG_REAL:
+      if (mpfr_inf_p(big_real(p)))
+	{
+	  if (mpfr_cmp_ui(big_real(p), 0) < 0)
+	    return(make_complex_not_0i(sc, -NAN, -INFINITY)); /* match non-bignum choice */
+	  return(make_complex_not_0i(sc, -NAN, INFINITY));
+	}
+      mpfr_set(sc->mpfr_1, big_real(p), MPFR_RNDN);
+    ACOS_BIG_REAL:
+      mpfr_set_ui(sc->mpfr_2, 1, MPFR_RNDN);
+      if (mpfr_cmpabs(sc->mpfr_1, sc->mpfr_2) <= 0)
+	{
+	  mpfr_acos(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	}
+      mpc_set_fr(sc->mpc_1, sc->mpfr_1, MPC_RNDNN);
+      mpc_acos(sc->mpc_1, sc->mpc_1, MPC_RNDNN);
+      return(mpc_to_number(sc, sc->mpc_1));
+    case T_BIG_COMPLEX:
+      mpc_acos(sc->mpc_1, big_complex(p), MPC_RNDNN);
+      return(mpc_to_number(sc, sc->mpc_1));
+#endif
+    default:
+      return(method_or_bust_p(sc, p, sc->acos_symbol, a_number_string));
+    }
+}
+
+static s7_pointer g_acos(s7_scheme *sc, s7_pointer args)
+{
+  #define H_acos "(acos z) returns acos(z); (cos (acos 1)) = 1"
+  #define Q_acos sc->pl_nn
+  return(acos_p_p(sc, car(args)));
+}
+
+
+/* -------------------------------- atan -------------------------------- */
+static s7_pointer g_atan(s7_scheme *sc, s7_pointer args)
+{
+  #define H_atan "(atan z) returns atan(z), (atan y x) returns atan(y/x)"
+  #define Q_atan s7_make_signature(sc, 3, sc->is_number_symbol, sc->is_number_symbol, sc->is_real_symbol)
+  /* actually if there are two args, both should be real, but how to express that in the signature? */
+
+  s7_pointer x = car(args), y;
+  /* currently (atan inf.0 inf.0) -> 0.78539816339745, and (atan inf.0 -inf.0) -> 2.3561944901923 (etc) */
+
+  if (!is_pair(cdr(args)))
+    {
+      switch (type(x))
+	{
+	case T_INTEGER:  return((integer(x) == 0) ? int_zero : make_real(sc, atan((double)integer(x))));
+	case T_RATIO:    return(make_real(sc, atan(fraction(x))));
+	case T_REAL:     return(make_real(sc, atan(real(x))));
+
+	case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+	  return(c_complex_to_s7(sc, catan(to_c_complex(x))));
+#else
+	  out_of_range_error_nr(sc, sc->atan_symbol, int_one, x, no_complex_numbers_string);
+#endif
+
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  mpfr_set_z(sc->mpfr_1, big_integer(x), MPFR_RNDN);
+	  mpfr_atan(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_RATIO:
+	  mpfr_set_q(sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+	  mpfr_atan(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_REAL:
+	  mpfr_atan(sc->mpfr_1, big_real(x), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  mpc_atan(sc->mpc_1, big_complex(x), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+#endif
+	default:
+	  return(method_or_bust_p(sc, x, sc->atan_symbol, a_number_string));
+	}}
+
+  y = cadr(args);
+  /* this is one place where s7 notices -0.0 != 0.0 -- this is apparently built into atan2, so I guess I'll leave it, but:
+   *   (atan 0.0 0.0): 0.0, (atan 0.0 -0.0): pi, (atan 0 -0.0): pi, (atan 0 -0) 0.0, (atan 0 -0.0): pi.
+   *   so you can sneak up on 0.0 from the left, but you can't fool 0??
+   */
+  switch (type(x))
+    {
+    case T_INTEGER: case T_RATIO: case T_REAL:
+      if (is_small_real(y))
+	return(make_real(sc, atan2(s7_real(x), s7_real(y))));
+#if WITH_GMP
+      if (!is_real(y))
+	return(method_or_bust(sc, y, sc->atan_symbol, args, sc->type_names[T_REAL], 2));
+      mpfr_set_d(sc->mpfr_1, s7_real(x), MPFR_RNDN);
+      goto ATAN2_BIG_REAL;
+    case T_BIG_INTEGER:
+      mpfr_set_z(sc->mpfr_1, big_integer(x), MPFR_RNDN);
+      goto ATAN2_BIG_REAL;
+    case T_BIG_RATIO:
+      mpfr_set_q(sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+      goto ATAN2_BIG_REAL;
+    case T_BIG_REAL:
+      mpfr_set(sc->mpfr_1, big_real(x), MPFR_RNDN);
+      goto ATAN2_BIG_REAL;
+#endif
+    default:
+      return(method_or_bust(sc, x, sc->atan_symbol, args, sc->type_names[T_REAL], 1));
+    }
+#if WITH_GMP
+ ATAN2_BIG_REAL:
+  if (is_small_real(y))
+    mpfr_set_d(sc->mpfr_2, s7_real(y), MPFR_RNDN);
+  else
+    if (is_t_big_real(y))
+      mpfr_set(sc->mpfr_2, big_real(y), MPFR_RNDN);
+    else
+      if (is_t_big_integer(y))
+	mpfr_set_z(sc->mpfr_2, big_integer(y), MPFR_RNDN);
+      else
+	if (is_t_big_ratio(y))
+	  mpfr_set_q(sc->mpfr_2, big_ratio(y), MPFR_RNDN);
+	else return(method_or_bust(sc, y, sc->atan_symbol, args, sc->type_names[T_REAL], 2));
+  mpfr_atan2(sc->mpfr_1, sc->mpfr_1, sc->mpfr_2, MPFR_RNDN);
+  return(mpfr_to_big_real(sc, sc->mpfr_1));
+#endif
+}
+
+static s7_double atan_d_d(s7_double x) {return(atan(x));}
+static s7_double atan_d_dd(s7_double x, s7_double y) {return(atan2(x, y));}
+
+
+/* -------------------------------- sinh -------------------------------- */
+static s7_pointer sinh_p_p(s7_scheme *sc, s7_pointer x)
+{
+  switch (type(x))
+    {
+    case T_INTEGER:
+      if (integer(x) == 0) return(int_zero);                    /* (sinh 0) -> 0 */
+
+    case T_REAL:
+    case T_RATIO:
+      {
+	s7_double y = s7_real(x);
+#if WITH_GMP
+	if (fabs(y) > SINH_LIMIT)
+	  {
+	    mpfr_set_d(sc->mpfr_1, y, MPFR_RNDN);
+	    mpfr_sinh(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+	    return(mpfr_to_big_real(sc, sc->mpfr_1));
+	  }
+#endif
+	return(make_real(sc, sinh(y)));
+      }
+
+    case T_COMPLEX:
+#if WITH_GMP
+      if ((fabs(real_part(x)) > SINH_LIMIT) || (fabs(imag_part(x)) > SINH_LIMIT))
+	{
+	  mpc_set_d_d(sc->mpc_1, real_part(x), imag_part(x), MPC_RNDNN);
+	  mpc_sinh(sc->mpc_1, sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	}
+#endif
+#if HAVE_COMPLEX_NUMBERS
+      return(c_complex_to_s7(sc, csinh(to_c_complex(x))));
+#else
+      out_of_range_error_nr(sc, sc->sinh_symbol, int_one, x, no_complex_numbers_string);
+#endif
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpfr_set_z(sc->mpfr_1, big_integer(x), MPFR_RNDN);
+      mpfr_sinh(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_RATIO:
+      mpfr_set_q(sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+      mpfr_sinh(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_REAL:
+      mpfr_sinh(sc->mpfr_1, big_real(x), MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_COMPLEX:
+      mpc_sinh(sc->mpc_1, big_complex(x), MPC_RNDNN);
+      if (mpfr_zero_p(mpc_imagref(sc->mpc_1)))
+	return(mpfr_to_big_real(sc, mpc_realref(sc->mpc_1)));
+      return(mpc_to_number(sc, sc->mpc_1));
+#endif
+    default:
+      return(method_or_bust_p(sc, x, sc->sinh_symbol, a_number_string));
+    }
+}
+
+static s7_pointer g_sinh(s7_scheme *sc, s7_pointer args)
+{
+  #define H_sinh "(sinh z) returns sinh(z)"
+  #define Q_sinh sc->pl_nn
+  return(sinh_p_p(sc, car(args)));
+}
+
+static s7_double sinh_d_d(s7_double x) {return(sinh(x));}
+static s7_pointer sinh_p_d(s7_scheme *sc, s7_double x) {return(make_real(sc, sinh(x)));}
+  /* so sinh in a do-loop with 0 arg may return 0.0 because sinh_p_d does not check if x=0 */
+
+
+/* -------------------------------- cosh -------------------------------- */
+static s7_pointer cosh_p_p(s7_scheme *sc, s7_pointer x)
+{
+  switch (type(x))
+    {
+    case T_INTEGER:
+      if (integer(x) == 0) return(int_one);                   /* (cosh 0) -> 1 */
+
+    case T_REAL:
+    case T_RATIO:
+      {
+	s7_double y = s7_real(x);
+#if WITH_GMP
+	if (fabs(y) > SINH_LIMIT)
+	  {
+	    mpfr_set_d(sc->mpfr_1, y, MPFR_RNDN);
+	    mpfr_cosh(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+	    return(mpfr_to_big_real(sc, sc->mpfr_1));
+	  }
+#endif
+	return(make_real(sc, cosh(y)));
+      }
+
+    case T_COMPLEX:
+#if WITH_GMP
+      if ((fabs(real_part(x)) > SINH_LIMIT) || (fabs(imag_part(x)) > SINH_LIMIT))
+	{
+	  mpc_set_d_d(sc->mpc_1, real_part(x), imag_part(x), MPC_RNDNN);
+	  mpc_cosh(sc->mpc_1, sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	}
+#endif
+#if HAVE_COMPLEX_NUMBERS
+      return(c_complex_to_s7(sc, ccosh(to_c_complex(x))));
+#else
+      out_of_range_error_nr(sc, sc->cosh_symbol, int_one, x, no_complex_numbers_string);
+#endif
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpfr_set_z(sc->mpfr_1, big_integer(x), MPFR_RNDN);
+      mpfr_cosh(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_RATIO:
+      mpfr_set_q(sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+      mpfr_cosh(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_REAL:
+      mpfr_cosh(sc->mpfr_1, big_real(x), MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_COMPLEX:
+      mpc_cosh(sc->mpc_1, big_complex(x), MPC_RNDNN);
+      if (mpfr_zero_p(mpc_imagref(sc->mpc_1)))
+	return(mpfr_to_big_real(sc, mpc_realref(sc->mpc_1)));
+      return(mpc_to_number(sc, sc->mpc_1));
+#endif
+    default:
+      return(method_or_bust_p(sc, x, sc->cosh_symbol, a_number_string));
+    }
+}
+
+static s7_pointer g_cosh(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cosh "(cosh z) returns cosh(z)"
+  #define Q_cosh sc->pl_nn
+  return(cosh_p_p(sc, car(args)));
+}
+
+static s7_double cosh_d_d(s7_double x) {return(cosh(x));}
+static s7_pointer cosh_p_d(s7_scheme *sc, s7_double x) {return(make_real(sc, cosh(x)));}
+
+
+/* -------------------------------- tanh -------------------------------- */
+#define TANH_LIMIT 350.0
+static s7_pointer tanh_p_p(s7_scheme *sc, s7_pointer x)
+{
+  switch (type(x))
+    {
+    case T_INTEGER: return((integer(x) == 0) ? int_zero : make_real(sc, tanh((s7_double)integer(x))));
+    case T_RATIO:   return(make_real(sc, tanh(fraction(x))));
+    case T_REAL:    return(make_real(sc, tanh(real(x))));
+
+    case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+      if (real_part(x) > TANH_LIMIT)
+	return(real_one);                         /* closer than 0.0 which is what ctanh is about to return! */
+      if (real_part(x) < -TANH_LIMIT)
+	return(make_real(sc, -1.0));              /* closer than ctanh's -0.0 */
+      return(c_complex_to_s7(sc, ctanh(to_c_complex(x))));
+#else
+      out_of_range_error_nr(sc, sc->tanh_symbol, int_one, x, no_complex_numbers_string);
+#endif
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpfr_set_z(sc->mpfr_1, big_integer(x), MPFR_RNDN);
+      goto BIG_REAL_TANH;
+    case T_BIG_RATIO:
+      mpfr_set_q(sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+      goto BIG_REAL_TANH;
+    case T_BIG_REAL:
+      if (mpfr_nan_p(big_real(x))) return(x);
+      mpfr_set(sc->mpfr_1, big_real(x), MPFR_RNDN);
+    BIG_REAL_TANH:
+      if (mpfr_cmp_d(sc->mpfr_1, TANH_LIMIT) > 0) return(real_one);
+      if (mpfr_cmp_d(sc->mpfr_1, -TANH_LIMIT) < 0) return(make_real(sc, -1.0));
+      mpfr_tanh(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_COMPLEX:
+      if ((MPC_INEX_RE(mpc_cmp_si_si(big_complex(x), TANH_LIMIT, 1))) > 0)
+	return(real_one);
+      if ((MPC_INEX_RE(mpc_cmp_si_si(big_complex(x), -TANH_LIMIT, 1))) < 0)
+	return(make_real(sc, -1.0));
+      if ((mpfr_nan_p(mpc_imagref(big_complex(x)))) ||
+	  (mpfr_inf_p(mpc_imagref(big_complex(x)))))
+	{
+	  if (mpfr_cmp_ui(mpc_realref(big_complex(x)), 0) == 0)
+	    return(make_complex_not_0i(sc, 0.0, NAN)); /* match non-bignum choice */
+	  return(complex_NaN);
+	}
+      mpc_tanh(sc->mpc_1, big_complex(x), MPC_RNDNN);
+      if (mpfr_zero_p(mpc_imagref(sc->mpc_1)))
+	return(mpfr_to_big_real(sc, mpc_realref(sc->mpc_1)));
+      return(mpc_to_number(sc, sc->mpc_1));
+#endif
+    default:
+      return(method_or_bust_p(sc, x, sc->tanh_symbol, a_number_string));
+    }
+}
+
+static s7_pointer g_tanh(s7_scheme *sc, s7_pointer args)
+{
+  #define H_tanh "(tanh z) returns tanh(z)"
+  #define Q_tanh sc->pl_nn
+  return(tanh_p_p(sc, car(args)));
+}
+
+static s7_double tanh_d_d(s7_double x) {return(tanh(x));}
+
+
+/* -------------------------------- asinh -------------------------------- */
+static s7_pointer asinh_p_p(s7_scheme *sc, s7_pointer x)
+{
+  switch (type(x))
+    {
+    case T_INTEGER: return((integer(x) == 0) ? int_zero : make_real(sc, asinh((s7_double)integer(x))));
+    case T_RATIO:   return(make_real(sc, asinh(fraction(x))));
+    case T_REAL:    return(make_real(sc, asinh(real(x))));
+    case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+  #if (defined(__OpenBSD__)) || (defined(__NetBSD__))
+      return(c_complex_to_s7(sc, casinh_1(to_c_complex(x))));
+  #else
+      return(c_complex_to_s7(sc, casinh(to_c_complex(x))));
+  #endif
+#else
+      out_of_range_error_nr(sc, sc->asinh_symbol, int_one, x, no_complex_numbers_string);
+#endif
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpfr_set_z(sc->mpfr_1, big_integer(x), MPFR_RNDN);
+      mpfr_asinh(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_RATIO:
+      mpfr_set_q(sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+      mpfr_asinh(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_REAL:
+      mpfr_asinh(sc->mpfr_1, big_real(x), MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_COMPLEX:
+      mpc_asinh(sc->mpc_1, big_complex(x), MPC_RNDNN);
+      return(mpc_to_number(sc, sc->mpc_1));
+#endif
+    default:
+      return(method_or_bust_p(sc, x, sc->asinh_symbol, a_number_string));
+    }
+}
+
+static s7_pointer g_asinh(s7_scheme *sc, s7_pointer args)
+{
+  #define H_asinh "(asinh z) returns asinh(z)"
+  #define Q_asinh sc->pl_nn
+  return(asinh_p_p(sc, car(args)));
+}
+
+
+/* -------------------------------- acosh -------------------------------- */
+static s7_pointer acosh_p_p(s7_scheme *sc, s7_pointer x)
+{
+  switch (type(x))
+    {
+    case T_INTEGER:
+      if (integer(x) == 1) return(int_zero);
+    case T_REAL:
+    case T_RATIO:
+      {
+	s7_double x1 = s7_real(x);
+	if (x1 >= 1.0)
+	  return(make_real(sc, acosh(x1)));
+      }
+    case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+  #ifdef __OpenBSD__
+      return(c_complex_to_s7(sc, cacosh_1(s7_to_c_complex(x))));
+  #else
+      return(c_complex_to_s7(sc, cacosh(s7_to_c_complex(x)))); /* not to_c_complex because x might not be complex */
+  #endif
+#else
+      /* since we can fall through to this branch, we need a better error message than "must be a number, not 0.0" */
+      out_of_range_error_nr(sc, sc->acosh_symbol, int_one, x, no_complex_numbers_string);
+#endif
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpc_set_z(sc->mpc_1, big_integer(x), MPC_RNDNN);
+      mpc_acosh(sc->mpc_1, sc->mpc_1, MPC_RNDNN);
+      return(mpc_to_number(sc, sc->mpc_1));
+    case T_BIG_RATIO:
+      mpc_set_q(sc->mpc_1, big_ratio(x), MPC_RNDNN);
+      mpc_acosh(sc->mpc_1, sc->mpc_1, MPC_RNDNN);
+      return(mpc_to_number(sc, sc->mpc_1));
+    case T_BIG_REAL:
+      mpc_set_fr(sc->mpc_1, big_real(x), MPC_RNDNN);
+      mpc_acosh(sc->mpc_1, sc->mpc_1, MPC_RNDNN);
+      return(mpc_to_number(sc, sc->mpc_1));
+    case T_BIG_COMPLEX:
+      mpc_acosh(sc->mpc_1, big_complex(x), MPC_RNDNN);
+      return(mpc_to_number(sc, sc->mpc_1));
+#endif
+    default:
+      return(method_or_bust_p(sc, x, sc->acosh_symbol, a_number_string));
+    }
+}
+
+static s7_pointer g_acosh(s7_scheme *sc, s7_pointer args)
+{
+  #define H_acosh "(acosh z) returns acosh(z)"
+  #define Q_acosh sc->pl_nn
+  return(acosh_p_p(sc, car(args)));
+}
+
+
+/* -------------------------------- atanh -------------------------------- */
+static s7_pointer atanh_p_p(s7_scheme *sc, s7_pointer x)
+{
+  switch (type(x))
+    {
+    case T_INTEGER:
+      if (integer(x) == 0) return(int_zero);                    /* (atanh 0) -> 0 */
+    case T_REAL:
+    case T_RATIO:
+      {
+	s7_double x1 = s7_real(x);
+	if (fabs(x1) < 1.0)
+	  return(make_real(sc, atanh(x1)));
+      }
+      /* if we can't distinguish x from 1.0 even with long_doubles, we'll get inf.0:
+       *    (atanh 9223372036854775/9223372036854776) -> 18.714973875119
+       *    (atanh 92233720368547758/92233720368547757) -> inf.0
+       *    (atanh (bignum 92233720368547758/92233720368547757)) -> 1.987812468492420421418925013176932317086E1+1.570796326794896619231321691639751442098E0i
+       *    but the imaginary part is unnecessary
+       */
+    case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+  #if (defined(__OpenBSD__)) || (defined(__NetBSD__))
+      return(c_complex_to_s7(sc, catanh_1(s7_to_c_complex(x))));
+  #else
+      return(c_complex_to_s7(sc, catanh(s7_to_c_complex(x))));
+  #endif
+#else
+      out_of_range_error_nr(sc, sc->atanh_symbol, int_one, x, no_complex_numbers_string);
+#endif
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpfr_set_z(sc->mpfr_2, big_integer(x), MPFR_RNDN);
+      goto ATANH_BIG_REAL;
+    case T_BIG_RATIO:
+      mpfr_set_q(sc->mpfr_2, big_ratio(x), MPFR_RNDN);
+      goto ATANH_BIG_REAL;
+    case T_BIG_REAL:
+      mpfr_set(sc->mpfr_2, big_real(x), MPFR_RNDN);
+    ATANH_BIG_REAL:
+      mpfr_set_ui(sc->mpfr_1, 1, MPFR_RNDN);
+      if (mpfr_cmpabs(sc->mpfr_2, sc->mpfr_1) < 0)
+	{
+	  mpfr_atanh(sc->mpfr_2, sc->mpfr_2, MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_2));
+	}
+      mpc_set_fr(sc->mpc_1, sc->mpfr_2, MPC_RNDNN);
+      mpc_atanh(sc->mpc_1, sc->mpc_1, MPC_RNDNN);
+      return(mpc_to_number(sc, sc->mpc_1));
+    case T_BIG_COMPLEX:
+      mpc_atanh(sc->mpc_1, big_complex(x), MPC_RNDNN);
+      return(mpc_to_number(sc, sc->mpc_1));
+#endif
+    default:
+      return(method_or_bust_p(sc, x, sc->atanh_symbol, a_number_string));
+    }
+}
+
+static s7_pointer g_atanh(s7_scheme *sc, s7_pointer args)
+{
+  #define H_atanh "(atanh z) returns atanh(z)"
+  #define Q_atanh sc->pl_nn
+  return(atanh_p_p(sc, car(args)));
+}
+
+
+/* -------------------------------- sqrt -------------------------------- */
+static s7_pointer sqrt_p_p(s7_scheme *sc, s7_pointer p)
+{
+  switch (type(p))
+    {
+    case T_INTEGER:
+      {
+	s7_double sqx;
+	if (integer(p) >= 0)
+	  {
+	    s7_int ix;
+#if WITH_GMP
+	    mpz_set_si(sc->mpz_1, integer(p));
+	    mpz_sqrtrem(sc->mpz_1, sc->mpz_2, sc->mpz_1);
+	    if (mpz_cmp_ui(sc->mpz_2, 0) == 0)
+	      return(make_integer(sc, mpz_get_si(sc->mpz_1)));
+	    mpfr_set_si(sc->mpfr_1, integer(p), MPFR_RNDN);
+	    mpfr_sqrt(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+	    return(mpfr_to_big_real(sc, sc->mpfr_1));
+#endif
+	    sqx = sqrt((s7_double)integer(p));
+	    ix = (s7_int)sqx;
+	    return(((ix * ix) == integer(p)) ? make_integer(sc, ix) : make_real(sc, sqx));
+	    /* Mark Weaver notes that (zero? (- (sqrt 9007199136250226) 94906265.0)) -> #t
+	     * but (* 94906265 94906265) -> 9007199136250225 -- oops
+	     * if we use bigfloats, we're ok:
+	     *    (* (sqrt 9007199136250226.0) (sqrt 9007199136250226.0)) -> 9.007199136250226000000000000000000000026E15
+	     * at least we return a real here, not an incorrect integer and (sqrt 9007199136250225) -> 94906265
+	     */
+	  }
+#if HAVE_COMPLEX_NUMBERS
+#if WITH_GMP
+	mpc_set_si(sc->mpc_1, integer(p), MPC_RNDNN);
+	mpc_sqrt(sc->mpc_1, sc->mpc_1, MPC_RNDNN);
+	return(mpc_to_number(sc, sc->mpc_1));
+#endif
+	sqx = (s7_double)integer(p); /* we're trying to protect against (sqrt -9223372036854775808) where we can't negate the integer argument */
+	return(make_complex_not_0i(sc, 0.0, sqrt((s7_double)(-sqx))));
+#else
+	out_of_range_error_nr(sc, sc->sqrt_symbol, int_one, p, no_complex_numbers_string);
+#endif
+      }
+
+    case T_RATIO:
+      if (numerator(p) > 0) /* else it's complex, so it can't be a ratio */
+	{
+	  s7_int nm = (s7_int)sqrt(numerator(p));
+	  if (nm * nm == numerator(p))
+	    {
+	      s7_int dn = (s7_int)sqrt(denominator(p));
+	      if (dn * dn == denominator(p))
+		return(make_ratio(sc, nm, dn));
+	    }
+	  return(make_real(sc, sqrt((s7_double)fraction(p))));
+	}
+#if HAVE_COMPLEX_NUMBERS
+      return(make_complex(sc, 0.0, sqrt((s7_double)(-fraction(p)))));
+#else
+      out_of_range_error_nr(sc, sc->sqrt_symbol, int_one, p, no_complex_numbers_string);
+#endif
+
+    case T_REAL:
+      if (is_NaN(real(p))) return(p);
+      if (real(p) >= 0.0)
+	return(make_real(sc, sqrt(real(p))));
+      return(make_complex_not_0i(sc, 0.0, sqrt(-real(p))));
+
+    case T_COMPLEX:    /* (* inf.0 (sqrt -1)) -> -nan+infi, but (sqrt -inf.0) -> 0+infi */
+#if HAVE_COMPLEX_NUMBERS
+      return(c_complex_to_s7(sc, csqrt(to_c_complex(p)))); /* sqrt(+inf.0+1.0i) -> +inf.0 */
+#else
+      out_of_range_error_nr(sc, sc->sqrt_symbol, int_one, p, no_complex_numbers_string);
+#endif
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      if (mpz_cmp_ui(big_integer(p), 0) >= 0)
+	{
+	  mpz_sqrtrem(sc->mpz_1, sc->mpz_2, big_integer(p));
+	  if (mpz_cmp_ui(sc->mpz_2, 0) == 0)
+	    return(mpz_to_integer(sc, sc->mpz_1));
+	  mpfr_set_z(sc->mpfr_1, big_integer(p), MPFR_RNDN);
+	  mpfr_sqrt(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	}
+      mpc_set_z(sc->mpc_1, big_integer(p), MPC_RNDNN);
+      mpc_sqrt(sc->mpc_1, sc->mpc_1, MPC_RNDNN);
+      return(mpc_to_number(sc, sc->mpc_1));
+
+    case T_BIG_RATIO: /* if big ratio, check both num and den for squares */
+      if (mpq_cmp_ui(big_ratio(p), 0, 1) < 0)
+	{
+	  mpc_set_q(sc->mpc_1, big_ratio(p), MPC_RNDNN);
+	  mpc_sqrt(sc->mpc_1, sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	}
+      mpz_sqrtrem(sc->mpz_1, sc->mpz_2, mpq_numref(big_ratio(p)));
+      if (mpz_cmp_ui(sc->mpz_2, 0) == 0)
+	{
+	  mpz_sqrtrem(sc->mpz_3, sc->mpz_2, mpq_denref(big_ratio(p)));
+	  if (mpz_cmp_ui(sc->mpz_2, 0) == 0)
+	    {
+	      mpq_set_num(sc->mpq_1, sc->mpz_1);
+	      mpq_set_den(sc->mpq_1, sc->mpz_3);
+	      return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+	    }}
+      mpfr_set_q(sc->mpfr_1, big_ratio(p), MPFR_RNDN);
+      mpfr_sqrt(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+
+    case T_BIG_REAL:
+      if (mpfr_cmp_ui(big_real(p), 0) < 0)
+	{
+	  mpc_set_fr(sc->mpc_1, big_real(p), MPC_RNDNN);
+	  mpc_sqrt(sc->mpc_1, sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	}
+      mpfr_sqrt(sc->mpfr_1, big_real(p), MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+
+    case T_BIG_COMPLEX:
+      mpc_sqrt(sc->mpc_1, big_complex(p), MPC_RNDNN);
+      return(mpc_to_number(sc, sc->mpc_1));
+#endif
+    default:
+      return(method_or_bust_p(sc, p, sc->sqrt_symbol, a_number_string));
+    }
+}
+
+static s7_pointer g_sqrt(s7_scheme *sc, s7_pointer args)
+{
+  #define H_sqrt "(sqrt z) returns the square root of z"
+  #define Q_sqrt sc->pl_nn
+  return(sqrt_p_p(sc, car(args)));
+}
+
+
+/* -------------------------------- expt -------------------------------- */
+static s7_int int_to_int(s7_int x, s7_int n)
+{
+  /* from GSL */
+  s7_int value = 1;
+  do {
+    if (n & 1) value *= x;
+    n >>= 1;
+#if HAVE_OVERFLOW_CHECKS
+    if (multiply_overflow(x, x, &x))
+      break;
+#else
+    x *= x;
+#endif
+  } while (n);
+  return(value);
+}
+
+static const int64_t nth_roots[63] = {
+  S7_INT64_MAX, S7_INT64_MAX, 3037000499LL, 2097151, 55108, 6208, 1448, 511, 234, 127, 78, 52, 38, 28, 22,
+  18, 15, 13, 11, 9, 8, 7, 7, 6, 6, 5, 5, 5, 4, 4, 4, 4, 3, 3, 3, 3, 3, 3, 3, 3, 2, 2, 2, 2, 2, 2,
+  2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2};
+
+static bool int_pow_ok(s7_int x, s7_int y)
+{
+  return((y < S7_INT_BITS) && (nth_roots[y] >= s7_int_abs(x)));
+}
+
+#if WITH_GMP
+static s7_pointer real_part_p_p(s7_scheme *sc, s7_pointer p);
+static bool lt_b_pi(s7_scheme *sc, s7_pointer p1, s7_int p2);
+
+static s7_pointer big_expt(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer x = car(args), y = cadr(args), res;
+  if (!is_number(x))
+    return(method_or_bust(sc, x, sc->expt_symbol, args, a_number_string, 1));
+  if (!is_number(y))
+    return(method_or_bust(sc, y, sc->expt_symbol, args, a_number_string, 2));
+
+  if (is_zero(x))
+    {
+      if ((s7_is_integer(x)) && (s7_is_integer(y)) && (is_zero(y)))
+	return(int_one);
+
+      if (is_real(y))
+	{
+	  if (is_negative(sc, y))
+	    division_by_zero_error_2_nr(sc, sc->expt_symbol, x, y);
+	}
+      else
+	if (s7_real_part(y) < 0.0)
+	  division_by_zero_error_2_nr(sc, sc->expt_symbol, x, y);
+
+      if ((is_rational(x)) && (is_rational(y)))
+	return(int_zero);
+      return(real_zero);
+    }
+
+  if (s7_is_integer(y))
+    {
+      s7_int yval = s7_integer_clamped_if_gmp(sc, y);
+      if (yval == 0)
+	return((is_rational(x)) ? int_one : real_one);
+
+      if (yval == 1)
+	return(x);
+
+      if ((!is_big_number(x)) &&
+	  ((is_one(x)) || (is_zero(x))))
+	return(x);
+
+      if ((yval < S7_INT32_MAX) &&
+	  (yval > S7_INT32_MIN))
+	{
+	  /* (protect against gmp exception if for example (expt 1/9223372036854775807 -9223372036854775807) */
+	  if (s7_is_integer(x))
+	    {
+	      if (is_t_big_integer(x))
+		mpz_set(sc->mpz_2, big_integer(x));
+	      else mpz_set_si(sc->mpz_2, integer(x));
+	      if (yval >= 0)
+		{
+		  mpz_pow_ui(sc->mpz_2, sc->mpz_2, (uint32_t)yval);
+		  return(mpz_to_integer(sc, sc->mpz_2));
+		}
+	      mpz_pow_ui(sc->mpz_2, sc->mpz_2, (uint32_t)(-yval));
+	      mpq_set_z(sc->mpq_1, sc->mpz_2);
+	      mpq_inv(sc->mpq_1, sc->mpq_1);
+	      if (mpz_cmp_ui(mpq_denref(sc->mpq_1), 1) == 0)
+		return(mpz_to_integer(sc, mpq_numref(sc->mpq_1)));
+	      return(mpq_to_big_ratio(sc, sc->mpq_1));
+	    }
+
+	  if (s7_is_ratio(x)) /* here y is an integer */
+	    {
+	      if (is_t_big_ratio(x))
+		{
+		  mpz_set(sc->mpz_1, mpq_numref(big_ratio(x)));
+		  mpz_set(sc->mpz_2, mpq_denref(big_ratio(x)));
+		}
+	      else
+		{
+		  mpz_set_si(sc->mpz_1, numerator(x));
+		  mpz_set_si(sc->mpz_2, denominator(x));
+		}
+	      if (yval >= 0)
+		{
+		  mpz_pow_ui(sc->mpz_1, sc->mpz_1, (uint32_t)yval);
+		  mpz_pow_ui(sc->mpz_2, sc->mpz_2, (uint32_t)yval);
+		  mpq_set_num(sc->mpq_1, sc->mpz_1);
+		  mpq_set_den(sc->mpq_1, sc->mpz_2);
+		}
+	      else
+		{
+		  yval = -yval;
+		  mpz_pow_ui(sc->mpz_1, sc->mpz_1, (uint32_t)yval);
+		  mpz_pow_ui(sc->mpz_2, sc->mpz_2, (uint32_t)yval);
+		  mpq_set_num(sc->mpq_1, sc->mpz_2);
+		  mpq_set_den(sc->mpq_1, sc->mpz_1);
+		  mpq_canonicalize(sc->mpq_1);
+		}
+	      if (mpz_cmp_ui(mpq_denref(sc->mpq_1), 1) == 0)
+		return(mpz_to_integer(sc, mpq_numref(sc->mpq_1)));
+	      return(mpq_to_big_ratio(sc, sc->mpq_1));
+	    }
+
+	  if (is_real(x))
+	    {
+	      if (is_t_big_real(x))
+		mpfr_set(sc->mpfr_1, big_real(x), MPFR_RNDN);
+	      else mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	      mpfr_pow_si(sc->mpfr_1, sc->mpfr_1, yval, MPFR_RNDN);
+	      return(mpfr_to_big_real(sc, sc->mpfr_1));
+	    }}}
+
+  if ((is_t_ratio(y)) &&              /* not s7_is_ratio which accepts bignums */
+      (numerator(y) == 1))
+    {
+      if (denominator(y) == 2)
+	return(sqrt_p_p(sc, x));
+
+      if ((is_real(x)) &&
+	  (denominator(y) == 3))
+	{
+	  any_real_to_mpfr(sc, x, sc->mpfr_1);
+	  mpfr_cbrt(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	}}
+
+  res = any_number_to_mpc(sc, y, sc->mpc_2);
+  if (res == real_infinity)
+    {
+      if (is_one(x)) return(int_one);
+      if (!is_real(x)) return((is_negative(sc, y)) ? real_zero : complex_NaN);
+      if (is_zero(x))
+	{
+	  if (is_negative(sc, y)) division_by_zero_error_2_nr(sc, sc->expt_symbol, x, y);
+	  return(real_zero);
+	}
+      if (lt_b_pi(sc, x, 0))
+	{
+	  if (lt_b_pi(sc, x, -1))
+	    return((is_positive(sc, y)) ? real_infinity : real_zero);
+	  return((is_positive(sc, y)) ? real_zero : real_infinity);
+	}
+      if (lt_b_pi(sc, x, 1))
+	return((is_positive(sc, y)) ? real_zero : real_infinity);
+      return((is_positive(sc, y)) ? real_infinity : real_zero);
+    }
+  if (res) return(complex_NaN);
+
+  if ((is_real(x)) &&
+      (is_real(y)) &&
+      (is_positive(sc, x)))
+    {
+      res = any_real_to_mpfr(sc, x, sc->mpfr_1);
+      if (res)
+	{
+	  if (res == real_infinity)
+	    {
+	      if (is_negative(sc, y)) return(real_zero);
+	      return((is_zero(y)) ? real_one : real_infinity);
+	    }
+	  return(complex_NaN);
+	}
+      mpfr_pow(sc->mpfr_1, sc->mpfr_1, mpc_realref(sc->mpc_2), MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    }
+
+  res = any_number_to_mpc(sc, x, sc->mpc_1);
+  if (res)
+    {
+      if ((res == real_infinity) && (is_real(y)))
+	{
+	  if (is_negative(sc, y)) return(real_zero);
+	  return((is_zero(y)) ? real_one : real_infinity);
+	}
+      return(complex_NaN);
+    }
+  if (mpc_cmp_si_si(sc->mpc_1, 0, 0) == 0)
+    return(int_zero);
+  if (mpc_cmp_si_si(sc->mpc_1, 1, 0) == 0)
+    return(int_one);
+
+  mpc_pow(sc->mpc_1, sc->mpc_1, sc->mpc_2, MPC_RNDNN);
+
+  if ((!mpfr_nan_p(mpc_imagref(sc->mpc_1))) && (mpfr_cmp_ui(mpc_imagref(sc->mpc_1), 0) == 0)) /* (expt -inf.0 1/3) -> +inf.0+nan.0i in mpc */
+    {
+      if ((is_rational(car(args))) &&
+	  (is_rational(cadr(args))) &&
+	  (mpfr_integer_p(mpc_realref(sc->mpc_1)) != 0))
+	{
+	  /* mpfr_integer_p can be confused: (expt 2718/1000 (bignum 617/5)) returns an int32_t if precision=128, float if 512 */
+	  /*   so first make sure we're within (say) 31 bits */
+	  mpfr_set_ui(sc->mpfr_1, S7_INT32_MAX, MPFR_RNDN);
+	  if (mpfr_cmpabs(mpc_realref(sc->mpc_1), sc->mpfr_1) < 0)
+	    {
+	      mpfr_get_z(sc->mpz_1, mpc_realref(sc->mpc_1), MPFR_RNDN);
+	      return(mpz_to_integer(sc, sc->mpz_1));
+	    }}
+      mpfr_set(sc->mpfr_1, mpc_realref(sc->mpc_1), MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    }
+  return(mpc_to_number(sc, sc->mpc_1));
+}
+#endif
+
+static s7_pointer expt_p_pp(s7_scheme *sc, s7_pointer n, s7_pointer pw)
+{
+  if (!is_number(n))
+    return(method_or_bust_pp(sc, n, sc->expt_symbol, n, pw, a_number_string, 1));
+  if (!is_number(pw))
+    return(method_or_bust_pp(sc, pw, sc->expt_symbol, n, pw, a_number_string, 2));
+
+  if (is_zero(n))
+    {
+      if (is_zero(pw))
+	{
+	  if ((s7_is_integer(n)) && (s7_is_integer(pw)))       /* (expt 0 0) -> 1 */
+	    return(int_one);
+	  return(real_zero);                                   /* (expt 0.0 0) -> 0.0 */
+	}
+      if (is_real(pw))
+	{
+	  if (is_negative(sc, pw))                              /* (expt 0 -1) */
+	    division_by_zero_error_2_nr(sc, sc->expt_symbol, n, pw);
+	  /* (Clisp gives divide-by-zero error here, Guile returns inf.0) */
+
+	  if (is_NaN(s7_real(pw)))                             /* (expt 0 +nan.0) */
+	    return(pw);
+	}
+      else
+	{                                                      /* (expt 0 a+bi) */
+	  if (real_part(pw) < 0.0)                             /* (expt 0 -1+i) */
+	    division_by_zero_error_2_nr(sc, sc->expt_symbol, n, pw);
+	  if ((is_NaN(real_part(pw))) ||                       /* (expt 0 0+1/0i) */
+	      (is_NaN(imag_part(pw))))
+	    return(pw);
+	}
+      if ((s7_is_integer(n)) && (s7_is_integer(pw)))           /* pw != 0, (expt 0 2312) */
+	return(int_zero);
+      return(real_zero);                                       /* (expt 0.0 123123) */
+    }
+
+  if (is_one(pw))
+    {
+      if (s7_is_integer(pw))                                   /* (expt x 1) */
+	return(n);
+      if (is_rational(n))                                      /* (expt ratio 1.0) */
+	return(make_real(sc, rational_to_double(sc, n)));
+      return(n);
+    }
+  if (is_t_integer(pw))
+    {
+      s7_int y = integer(pw);
+      if (y == 0)
+	{
+	  if (is_rational(n))                                 /* (expt 3 0) */
+	    return(int_one);
+	  if ((is_NaN(s7_real_part(n))) ||                    /* (expt 1/0 0) -> NaN */
+	      (is_NaN(s7_imag_part(n))))                      /* (expt (complex 0 1/0) 0) -> NaN */
+	    return(n);
+	  return(real_one);                                   /* (expt 3.0 0) */
+	}
+      switch (type(n))
+	{
+	case T_INTEGER:
+	  {
+	    s7_int x = integer(n);
+	    if (x == 1)                                       /* (expt 1 y) */
+	      return(n);
+
+	    if (x == -1)
+	      {
+		if (y == S7_INT64_MIN)                        /* (expt -1 most-negative-fixnum) */
+		  return(int_one);
+		if (s7_int_abs(y) & 1)                        /* (expt -1 odd-int) */
+		  return(n);
+		return(int_one);                              /* (expt -1 even-int) */
+	      }
+
+	    if (y == S7_INT64_MIN)                            /* (expt x most-negative-fixnum) */
+	      return(int_zero);
+	    if (x == S7_INT64_MIN)                            /* (expt most-negative-fixnum y) */
+	      return(make_real(sc, pow((double)x, (double)y)));
+
+	    if (int_pow_ok(x, s7_int_abs(y)))
+	      {
+		if (y > 0)
+		  return(make_integer(sc, int_to_int(x, y)));
+		return(make_ratio(sc, 1, int_to_int(x, -y)));
+	      }}
+	  break;
+
+	case T_RATIO:
+	  {
+	    s7_int nm = numerator(n), dn = denominator(n);
+	    if (y == S7_INT64_MIN)
+	      {
+		if (s7_int_abs(nm) > dn)
+		  return(int_zero);                  /* (expt 4/3 most-negative-fixnum) -> 0? */
+		return(real_infinity);               /* (expt 3/4 most-negative-fixnum) -> inf? */
+	      }
+	    if ((int_pow_ok(nm, s7_int_abs(y))) &&
+		(int_pow_ok(dn, s7_int_abs(y))))
+	      {
+		if (y > 0)
+		  return(make_ratio(sc, int_to_int(nm, y), int_to_int(dn, y)));
+		return(make_ratio_with_div_check(sc, sc->expt_symbol, int_to_int(dn, -y), int_to_int(nm, -y)));
+	      }}
+	  break;
+	  /* occasionally int^rat can be int32_t but it happens so infrequently it's probably not worth checking
+	   *  one possibly easy case: (expt 1 1/2) -> 1 (-1?) etc
+	   */
+
+	case T_REAL:
+	  /* (expt -1.0 most-positive-fixnum) should be -1.0
+	   * (expt -1.0 (+ (expt 2 53) 1)) -> -1.0
+	   * (expt -1.0 (- 1 (expt 2 54))) -> -1.0
+	   */
+	  if (real(n) == -1.0)
+	    {
+	      if (y == S7_INT64_MIN)
+		return(real_one);
+	      return((s7_int_abs(y) & 1) ? n : real_one);
+	    }
+	  break;
+
+	case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+	  if ((s7_real_part(n) == 0.0) &&
+	      ((s7_imag_part(n) == 1.0) ||
+	       (s7_imag_part(n) == -1.0)))
+	    {
+	      bool yp = (y > 0), np = (s7_imag_part(n) > 0.0);
+	      switch (s7_int_abs(y) % 4)
+		{
+		case 0: return(real_one);
+		case 1: return(make_complex_not_0i(sc, 0.0, (yp == np) ? 1.0 : -1.0));
+		case 2: return(make_real(sc, -1.0));
+		case 3: return(make_complex_not_0i(sc, 0.0, (yp == np) ? -1.0 : 1.0));
+		}}
+#else
+	  out_of_range_error_nr(sc, sc->expt_symbol, int_two, n, no_complex_numbers_string);
+#endif
+	  break;
+	}}
+
+  if ((is_real(n)) &&
+      (is_real(pw)))
+    {
+      s7_double x, y;
+
+      if ((is_t_ratio(pw)) &&
+	  (numerator(pw) == 1))
+	{
+	  if (denominator(pw) == 2)
+	    return(sqrt_p_p(sc, n));
+	  if (denominator(pw) == 3)
+	    return(make_real(sc, cbrt(s7_real(n)))); /* (expt 27 1/3) should be 3, not 3.0... */
+	  /* but: (expt 512/729 1/3) -> 0.88888888888889, and 4 -> sqrt(sqrt...) etc? */
+	}
+
+      x = s7_real(n);
+      y = s7_real(pw);
+      if (is_NaN(x)) return(n);
+      if (is_NaN(y)) return(pw);
+      if (y == 0.0) return(real_one);
+      /* I think pow(rl, inf) is ok */
+      if (x > 0.0)
+	return(make_real(sc, pow(x, y)));      /* tricky cases abound here: (expt -1 1/9223372036854775807) */
+    }
+
+  /* (expt 0+i 1e+16) = 0.98156860153485-0.19111012657867i ?
+   * (expt 0+i 1+1/0i) = 0.0 ??
+   */
+  return(c_complex_to_s7(sc, cpow(s7_to_c_complex(n), s7_to_c_complex(pw))));
+}
+
+static s7_pointer g_expt(s7_scheme *sc, s7_pointer args)
+{
+  #define H_expt "(expt z1 z2) returns z1^z2"
+  #define Q_expt sc->pcl_n
+#if WITH_GMP
+  return(big_expt(sc, args));
+  /* big_expt sometimes chooses a different value: g_expt (expt -1 1/3) is -1, but big_expt (expt -1 (bignum 1/3)) is (complex 1/2 (/ (sqrt 3) 2)) */
+#endif
+  return(expt_p_pp(sc, car(args), cadr(args)));
+}
+
+
+/* -------------------------------- lcm -------------------------------- */
+#if WITH_GMP
+static s7_pointer big_lcm(s7_scheme *sc, s7_int num, s7_int den, s7_pointer args)
+{
+  mpz_set_si(sc->mpz_3, num);
+  mpz_set_si(sc->mpz_4, den);
+
+  for (s7_pointer x = args; is_pair(x); x = cdr(x))
+    {
+      s7_pointer rat = car(x);
+      switch (type(rat))
+	{
+	case T_INTEGER:
+	  mpz_set_si(sc->mpz_1, integer(rat));
+	  mpz_lcm(sc->mpz_3, sc->mpz_3, sc->mpz_1);
+	  mpz_set_si(sc->mpz_4, 1);
+	  break;
+	case T_RATIO:
+	  mpz_set_si(sc->mpz_1, numerator(rat));
+	  mpz_set_si(sc->mpz_2, denominator(rat));
+	  mpz_lcm(sc->mpz_3, sc->mpz_3, sc->mpz_1);
+	  mpz_gcd(sc->mpz_4, sc->mpz_4, sc->mpz_2);
+	  break;
+	case T_BIG_INTEGER:
+	  mpz_lcm(sc->mpz_3, sc->mpz_3, big_integer(rat));
+	  mpz_set_si(sc->mpz_4, 1);
+	  break;
+	case T_BIG_RATIO:
+	  mpz_lcm(sc->mpz_3, sc->mpz_3, mpq_numref(big_ratio(rat)));
+	  mpz_gcd(sc->mpz_4, sc->mpz_4, mpq_denref(big_ratio(rat)));
+	  break;
+	case T_REAL: case T_BIG_REAL: case T_COMPLEX: case T_BIG_COMPLEX:
+	  wrong_type_error_nr(sc, sc->lcm_symbol, position_of(x, args), rat, a_rational_string);
+	default:
+	  return(method_or_bust(sc, rat, sc->lcm_symbol,
+				set_ulist_1(sc, mpz_to_rational(sc, sc->mpz_3, sc->mpz_4), x),
+				a_rational_string, position_of(x, args)));
+	}}
+  return(mpz_to_rational(sc, sc->mpz_3, sc->mpz_4));
+}
+#endif
+
+static s7_pointer g_lcm(s7_scheme *sc, s7_pointer args)
+{
+  /* (/ (* m n) (gcd m n)), (lcm a b c) -> (lcm a (lcm b c)) */
+  #define H_lcm "(lcm ...) returns the least common multiple of its rational arguments"
+  #define Q_lcm sc->pcl_f
+
+  s7_int n = 1, d = 0;
+
+  if (!is_pair(args))
+    return(int_one);
+
+  if (!is_pair(cdr(args)))
+    {
+      if (!is_rational(car(args)))
+	return(method_or_bust(sc, car(args), sc->lcm_symbol, args, a_rational_string, 1));
+      return(g_abs(sc, args));
+    }
+
+  for (s7_pointer p = args; is_pair(p); p = cdr(p))
+    {
+      s7_pointer x = car(p);
+      s7_int b;
+#if HAVE_OVERFLOW_CHECKS
+      s7_int n1;
+#endif
+      switch (type(x))
+	{
+	case T_INTEGER:
+	  d = 1;
+	  if (integer(x) == 0) /* return 0 unless there's a wrong-type-arg (geez what a mess) */
+	    {
+	      for (p = cdr(p); is_pair(p); p = cdr(p))
+		{
+		  s7_pointer x1 = car(p);
+		  if (is_number(x1))
+		    {
+		      if (!is_rational(x1))
+			wrong_type_error_nr(sc, sc->lcm_symbol, position_of(p, args), x1, a_rational_string);
+		    }
+		  else
+		    if (has_active_methods(sc, x1))
+		      {
+			s7_pointer f = find_method_with_let(sc, x1, sc->is_rational_symbol);
+			if ((f == sc->undefined) ||
+			    (is_false(sc, s7_apply_function(sc, f, set_plist_1(sc, x1)))))
+			  wrong_type_error_nr(sc, sc->lcm_symbol, position_of(p, args), x1, a_rational_string);
+		      }
+		    else wrong_type_error_nr(sc, sc->lcm_symbol, position_of(p, args), x1, a_rational_string);
+		}
+	      return(int_zero);
+	    }
+	  b = integer(x);
+	  if (b < 0)
+	    {
+	      if (b == S7_INT64_MIN)
+#if WITH_GMP
+		return(big_lcm(sc, n, d, p));
+#else
+		sole_arg_out_of_range_error_nr(sc, sc->lcm_symbol, args, it_is_too_large_string);
+#endif
+	      b = -b;
+	    }
+#if HAVE_OVERFLOW_CHECKS
+	  if (multiply_overflow(n / c_gcd(n, b), b, &n1))
+#if WITH_GMP
+	    return(big_lcm(sc, n, d, p));
+#else
+	    sole_arg_out_of_range_error_nr(sc, sc->lcm_symbol, args, result_is_too_large_string);
+#endif
+	  n = n1;
+#else
+	  n = (n / c_gcd(n, b)) * b;
+#endif
+	  break;
+
+	case T_RATIO:
+	  b = numerator(x);
+	  if (b < 0)
+	    {
+	      if (b == S7_INT64_MIN)
+#if WITH_GMP
+		return(big_lcm(sc, n, d, p));
+#else
+		sole_arg_out_of_range_error_nr(sc, sc->lcm_symbol, args, it_is_too_large_string);
+#endif
+	      b = -b;
+	    }
+#if HAVE_OVERFLOW_CHECKS
+	  if (multiply_overflow(n / c_gcd(n, b), b, &n1))  /* (lcm 92233720368547758/3 3005/2) */
+#if WITH_GMP
+	    return(big_lcm(sc, n, d, p));
+#else
+	    sole_arg_out_of_range_error_nr(sc, sc->lcm_symbol, args, intermediate_too_large_string);
+#endif
+          n = n1;
+#else
+	  n = (n / c_gcd(n, b)) * b;
+#endif
+	  if (d == 0)
+	    d = (p == args) ? denominator(x) : 1;
+	  else d = c_gcd(d, denominator(x));
+	  break;
+
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  d = 1;
+	case T_BIG_RATIO:
+	  return(big_lcm(sc, n, d, p));
+#endif
+	case T_REAL: case T_BIG_REAL: case T_COMPLEX: case T_BIG_COMPLEX:
+	  wrong_type_error_nr(sc, sc->lcm_symbol, position_of(p, args), x, a_rational_string);
+
+	default:
+	  return(method_or_bust(sc, x, sc->lcm_symbol,
+				set_ulist_1(sc, (d <= 1) ? make_integer(sc, n) : make_ratio_with_div_check(sc, sc->lcm_symbol, n, d), p),
+				a_rational_string, position_of(p, args)));
+	}}
+  return((d <= 1) ? make_integer(sc, n) : make_simple_ratio(sc, n, d));
+}
+
+
+/* -------------------------------- gcd -------------------------------- */
+#if WITH_GMP
+static s7_pointer big_gcd(s7_scheme *sc, s7_int num, s7_int den, s7_pointer args)
+{
+  mpz_set_si(sc->mpz_3, num);
+  mpz_set_si(sc->mpz_4, den);
+
+  for (s7_pointer x = args; is_pair(x); x = cdr(x))
+    {
+      s7_pointer rat = car(x);
+      switch (type(rat))
+	{
+	case T_INTEGER:
+	  mpz_set_si(sc->mpz_1, integer(rat));
+	  mpz_gcd(sc->mpz_3, sc->mpz_3, sc->mpz_1);
+	  break;
+	case T_RATIO:
+	  mpz_set_si(sc->mpz_1, numerator(rat));
+	  mpz_set_si(sc->mpz_2, denominator(rat));
+	  mpz_gcd(sc->mpz_3, sc->mpz_3, sc->mpz_1);
+	  mpz_lcm(sc->mpz_4, sc->mpz_4, sc->mpz_2);
+	  break;
+	case T_BIG_INTEGER:
+	  mpz_gcd(sc->mpz_3, sc->mpz_3, big_integer(rat));
+	  break;
+	case T_BIG_RATIO:
+	  mpz_gcd(sc->mpz_3, sc->mpz_3, mpq_numref(big_ratio(rat)));
+	  mpz_lcm(sc->mpz_4, sc->mpz_4, mpq_denref(big_ratio(rat)));
+	  break;
+	case T_REAL: case T_BIG_REAL: case T_COMPLEX: case T_BIG_COMPLEX:
+	  wrong_type_error_nr(sc, sc->gcd_symbol, position_of(x, args), rat, a_rational_string);
+	default:
+	  return(method_or_bust(sc, rat, sc->gcd_symbol,
+				set_ulist_1(sc, mpz_to_rational(sc, sc->mpz_3, sc->mpz_4), x),
+				a_rational_string, position_of(x, args)));
+	}}
+  return(mpz_to_rational(sc, sc->mpz_3, sc->mpz_4));
+}
+#endif
+
+static s7_pointer g_gcd(s7_scheme *sc, s7_pointer args)
+{
+  #define H_gcd "(gcd ...) returns the greatest common divisor of its rational arguments"
+  #define Q_gcd sc->pcl_f
+
+  s7_int n = 0, d = 1;
+
+  if (!is_pair(args))       /* (gcd) */
+    return(int_zero);
+
+  if (!is_pair(cdr(args)))  /* (gcd 3/4) */
+    {
+      if (!is_rational(car(args)))
+	return(method_or_bust(sc, car(args), sc->gcd_symbol, args, a_rational_string, 1));
+      return(abs_p_p(sc, car(args)));
+    }
+
+  for (s7_pointer p = args; is_pair(p); p = cdr(p))
+    {
+      s7_pointer x = car(p);
+      switch (type(x))
+	{
+	case T_INTEGER:
+	  if (integer(x) == S7_INT64_MIN)
+#if WITH_GMP
+	    return(big_gcd(sc, n, d, p));
+#else
+	    sole_arg_out_of_range_error_nr(sc, sc->lcm_symbol, args, it_is_too_large_string);
+#endif
+	  n = c_gcd(n, integer(x));
+	  break;
+
+	case T_RATIO:
+	  {
+#if HAVE_OVERFLOW_CHECKS
+	    s7_int dn;
+#endif
+	    n = c_gcd(n, numerator(x));
+	    if (d == 1)
+	      d = denominator(x);
+	    else
+	      {
+		s7_int b = denominator(x);
+#if HAVE_OVERFLOW_CHECKS
+		if (multiply_overflow(d / c_gcd(d, b), b, &dn)) /* (gcd 1/92233720368547758 1/3005) */
+#if WITH_GMP
+		  return(big_gcd(sc, n, d, x));
+#else
+		  sole_arg_out_of_range_error_nr(sc, sc->gcd_symbol, args, intermediate_too_large_string);
+#endif
+		d = dn;
+#else
+		d = (d / c_gcd(d, b)) * b;
+#endif
+	      }}
+	  break;
+
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	case T_BIG_RATIO:
+	  return(big_gcd(sc, n, d, p));
+#endif
+
+	case T_REAL: case T_BIG_REAL: case T_COMPLEX: case T_BIG_COMPLEX:
+	  wrong_type_error_nr(sc, sc->gcd_symbol, position_of(p, args), x, a_rational_string);
+
+	default:
+	  return(method_or_bust(sc, x, sc->gcd_symbol,
+				set_ulist_1(sc, (d <= 1) ? make_integer(sc, n) : make_ratio_with_div_check(sc, sc->gcd_symbol, n, d), p),
+				a_rational_string, position_of(p, args)));
+	}}
+  return((d <= 1) ? make_integer(sc, n) : make_simple_ratio(sc, n, d));
+}
+
+
+/* -------------------------------- floor -------------------------------- */
+static s7_pointer floor_p_p(s7_scheme *sc, s7_pointer x)
+{
+  switch (type(x))
+    {
+    case T_INTEGER:
+      return(x);
+    case T_RATIO:
+      {
+	s7_int val = numerator(x) / denominator(x);
+	/* C "/" truncates? -- C spec says "truncation toward 0" */
+	/* we're avoiding "floor" here because the int->double conversion introduces inaccuracies for big numbers
+	 *   but it's used by opt_i_d_c (via s7_number_to_real) so floor_i_7d below can return different results:
+	 *   (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (display (floor 3441313796169221281/1720656898084610641)) (newline))) (func)): 1
+	 *   (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (display (/ (floor 3441313796169221281/1720656898084610641))) (newline))) (func)): 1/2
+	 */
+	return(make_integer(sc, (numerator(x) < 0) ? (val - 1) : val)); /* not "val" because it might be truncated to 0 */
+      }
+    case T_REAL:
+      {
+	s7_double z = real(x);
+	if (is_NaN(z))
+	  sole_arg_out_of_range_error_nr(sc, sc->floor_symbol, x, it_is_nan_string);
+	if (is_inf(z))
+	  sole_arg_out_of_range_error_nr(sc, sc->floor_symbol, x, it_is_infinite_string);
+#if WITH_GMP
+	if (fabs(z) > DOUBLE_TO_INT64_LIMIT)
+	  {
+	    mpfr_set_d(sc->mpfr_1, z, MPFR_RNDN);
+	    mpfr_get_z(sc->mpz_1, sc->mpfr_1, MPFR_RNDD);
+	    return(mpz_to_integer(sc, sc->mpz_1));
+	  }
+#else
+	if (fabs(z) > DOUBLE_TO_INT64_LIMIT)
+	  sole_arg_out_of_range_error_nr(sc, sc->floor_symbol, x, it_is_too_large_string);
+#endif
+	return(make_integer(sc, (s7_int)floor(z)));
+	/* floor here rounds down, whereas a straight int<=real coercion apparently rounds towards 0 */
+      }
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      return(x);
+    case T_BIG_RATIO:
+      mpz_fdiv_q(sc->mpz_1, mpq_numref(big_ratio(x)), mpq_denref(big_ratio(x)));
+      return(mpz_to_integer(sc, sc->mpz_1));
+    case T_BIG_REAL:
+      if (mpfr_nan_p(big_real(x)))
+	sole_arg_out_of_range_error_nr(sc, sc->floor_symbol, x, it_is_nan_string);
+      if (mpfr_inf_p(big_real(x)))
+	sole_arg_out_of_range_error_nr(sc, sc->floor_symbol, x, it_is_infinite_string);
+      mpfr_get_z(sc->mpz_1, big_real(x), MPFR_RNDD);
+      return(mpz_to_integer(sc, sc->mpz_1));
+    case T_BIG_COMPLEX:
+#endif
+    case T_COMPLEX:
+      sole_arg_wrong_type_error_nr(sc, sc->floor_symbol, x, sc->type_names[T_REAL]);
+    default:
+      return(method_or_bust_p(sc, x, sc->floor_symbol, sc->type_names[T_REAL]));
+    }
+}
+
+static s7_pointer g_floor(s7_scheme *sc, s7_pointer args)
+{
+  #define H_floor "(floor x) returns the integer closest to x toward -inf"
+  #define Q_floor s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_real_symbol)
+  return(floor_p_p(sc, car(args)));
+}
+
+static s7_int floor_i_i(s7_int i) {return(i);}
+
+#if (!WITH_GMP)
+static s7_int floor_i_7d(s7_scheme *sc, s7_double x)
+{
+  if (is_NaN(x))
+    sole_arg_out_of_range_error_nr(sc, sc->floor_symbol, real_NaN, it_is_nan_string);
+  if (fabs(x) > DOUBLE_TO_INT64_LIMIT)
+    sole_arg_out_of_range_error_nr(sc, sc->floor_symbol, wrap_real(sc, x), it_is_too_large_string);
+  return((s7_int)floor(x));
+}
+
+static s7_int floor_i_7p(s7_scheme *sc, s7_pointer p)
+{
+  if (is_t_integer(p)) return(integer(p));
+  if (is_t_real(p)) return(floor_i_7d(sc, real(p)));
+  if (is_t_ratio(p)) /* for consistency with floor_p_p, don't use floor(fraction(p)) */
+    {
+      s7_int val = numerator(p) / denominator(p);
+      return((numerator(p) < 0) ? val - 1 : val);
+    }
+  return(s7_integer(method_or_bust_p(sc, p, sc->floor_symbol, sc->type_names[T_REAL])));
+}
+
+static s7_pointer floor_p_d(s7_scheme *sc, s7_double x) {return(make_integer(sc,floor_i_7d(sc, x)));}
+#endif
+
+
+/* -------------------------------- ceiling -------------------------------- */
+static s7_pointer ceiling_p_p(s7_scheme *sc, s7_pointer x)
+{
+  switch (type(x))
+    {
+    case T_INTEGER:
+      return(x);
+    case T_RATIO:
+      {
+	s7_int val = numerator(x) / denominator(x);
+	return(make_integer(sc, (numerator(x) < 0) ? val : (val + 1)));
+      }
+    case T_REAL:
+      {
+	s7_double z = real(x);
+	if (is_NaN(z))
+	  sole_arg_out_of_range_error_nr(sc, sc->ceiling_symbol, x, it_is_nan_string);
+	if (is_inf(z))
+	  sole_arg_out_of_range_error_nr(sc, sc->ceiling_symbol, x, it_is_infinite_string);
+#if WITH_GMP
+	if (fabs(z) > DOUBLE_TO_INT64_LIMIT)
+	  {
+	    mpfr_set_d(sc->mpfr_1, z, MPFR_RNDN);
+	    mpfr_get_z(sc->mpz_1, sc->mpfr_1, MPFR_RNDU);
+	    return(mpz_to_integer(sc, sc->mpz_1));
+	  }
+#else
+	if (fabs(z) > DOUBLE_TO_INT64_LIMIT)
+	  sole_arg_out_of_range_error_nr(sc, sc->ceiling_symbol, x, it_is_too_large_string);
+#endif
+	return(make_integer(sc, (s7_int)ceil(real(x))));
+      }
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      return(x);
+    case T_BIG_RATIO:
+      mpz_cdiv_q(sc->mpz_1, mpq_numref(big_ratio(x)), mpq_denref(big_ratio(x)));
+      return(mpz_to_integer(sc, sc->mpz_1));
+    case T_BIG_REAL:
+      if (mpfr_nan_p(big_real(x)))
+	sole_arg_out_of_range_error_nr(sc, sc->ceiling_symbol, x, it_is_nan_string);
+      if (mpfr_inf_p(big_real(x)))
+	sole_arg_out_of_range_error_nr(sc, sc->ceiling_symbol, x, it_is_infinite_string);
+      mpfr_get_z(sc->mpz_1, big_real(x), MPFR_RNDU);
+      return(mpz_to_integer(sc, sc->mpz_1));
+    case T_BIG_COMPLEX:
+#endif
+    case T_COMPLEX:
+      sole_arg_wrong_type_error_nr(sc, sc->ceiling_symbol, x, sc->type_names[T_REAL]);
+    default:
+      return(method_or_bust_p(sc, x, sc->ceiling_symbol, sc->type_names[T_REAL]));
+    }
+}
+
+static s7_pointer g_ceiling(s7_scheme *sc, s7_pointer args)
+{
+  #define H_ceiling "(ceiling x) returns the integer closest to x toward inf"
+  #define Q_ceiling s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_real_symbol)
+  return(ceiling_p_p(sc, car(args)));
+}
+
+static s7_int ceiling_i_i(s7_int i) {return(i);}
+
+#if (!WITH_GMP)
+static s7_int ceiling_i_7d(s7_scheme *sc, s7_double x)
+{
+  if (is_NaN(x))
+    sole_arg_out_of_range_error_nr(sc, sc->ceiling_symbol, real_NaN, it_is_nan_string);
+  if ((is_inf(x)) ||
+      (x > DOUBLE_TO_INT64_LIMIT) || (x < -DOUBLE_TO_INT64_LIMIT))
+    sole_arg_out_of_range_error_nr(sc, sc->ceiling_symbol, wrap_real(sc, x), it_is_too_large_string);
+  return((s7_int)ceil(x));
+}
+
+static s7_int ceiling_i_7p(s7_scheme *sc, s7_pointer p)
+{
+  if (is_t_integer(p)) return(integer(p));
+  if (is_t_real(p)) return(ceiling_i_7d(sc, real(p)));
+  if (is_t_ratio(p)) return((s7_int)(ceil(fraction(p))));
+  return(s7_integer(method_or_bust_p(sc, p, sc->ceiling_symbol, sc->type_names[T_REAL])));
+}
+
+static s7_pointer ceiling_p_d(s7_scheme *sc, s7_double x) {return(make_integer(sc, ceiling_i_7d(sc, x)));}
+#endif
+
+
+/* -------------------------------- truncate -------------------------------- */
+static s7_pointer truncate_p_p(s7_scheme *sc, s7_pointer x)
+{
+  switch (type(x))
+    {
+    case T_INTEGER:
+      return(x);
+    case T_RATIO:
+      return(make_integer(sc, (s7_int)(numerator(x) / denominator(x)))); /* C "/" already truncates (but this divide is not accurate over e13) */
+    case T_REAL:
+      {
+	s7_double z = real(x);
+	if (is_NaN(z))
+	  sole_arg_out_of_range_error_nr(sc, sc->truncate_symbol, x, it_is_nan_string);
+	if (is_inf(z))
+	  sole_arg_out_of_range_error_nr(sc, sc->truncate_symbol, x, it_is_infinite_string);
+#if WITH_GMP
+	if (fabs(z) > DOUBLE_TO_INT64_LIMIT)
+	  {
+	    mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	    mpfr_get_z(sc->mpz_1, sc->mpfr_1, MPFR_RNDZ);
+	    return(mpz_to_integer(sc, sc->mpz_1));
+	  }
+#else
+	if (fabs(z) > DOUBLE_TO_INT64_LIMIT)
+	  sole_arg_out_of_range_error_nr(sc, sc->truncate_symbol, x, it_is_too_large_string);
+#endif
+	return(make_integer(sc, (z > 0.0) ? (s7_int)floor(z) : (s7_int)ceil(z)));
+      }
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      return(x);
+    case T_BIG_RATIO:
+      mpz_tdiv_q(sc->mpz_1, mpq_numref(big_ratio(x)), mpq_denref(big_ratio(x)));
+      return(mpz_to_integer(sc, sc->mpz_1));
+    case T_BIG_REAL:
+      if (mpfr_nan_p(big_real(x)))
+	sole_arg_out_of_range_error_nr(sc, sc->truncate_symbol, x, it_is_nan_string);
+      if (mpfr_inf_p(big_real(x)))
+	sole_arg_out_of_range_error_nr(sc, sc->truncate_symbol, x, it_is_infinite_string);
+      mpfr_get_z(sc->mpz_1, big_real(x), MPFR_RNDZ);
+      return(mpz_to_integer(sc, sc->mpz_1));
+    case T_BIG_COMPLEX:
+#endif
+    case T_COMPLEX:
+      sole_arg_wrong_type_error_nr(sc, sc->truncate_symbol, x, sc->type_names[T_REAL]);
+    default:
+      return(method_or_bust_p(sc, x, sc->truncate_symbol, sc->type_names[T_REAL]));
+    }
+}
+
+static s7_pointer g_truncate(s7_scheme *sc, s7_pointer args)
+{
+  #define H_truncate "(truncate x) returns the integer closest to x toward 0"
+  #define Q_truncate s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_real_symbol)
+  return(truncate_p_p(sc, car(args)));
+}
+
+static s7_int truncate_i_i(s7_int i) {return(i);}
+
+#if (!WITH_GMP)
+static s7_int truncate_i_7d(s7_scheme *sc, s7_double x)
+{
+  if (is_NaN(x))
+    sole_arg_out_of_range_error_nr(sc, sc->truncate_symbol, real_NaN, it_is_nan_string);
+  if (is_inf(x))
+    sole_arg_out_of_range_error_nr(sc, sc->truncate_symbol, wrap_real(sc, x), it_is_infinite_string);
+  if (fabs(x) > DOUBLE_TO_INT64_LIMIT)
+    sole_arg_out_of_range_error_nr(sc, sc->truncate_symbol, wrap_real(sc, x), it_is_too_large_string);
+  return((x > 0.0) ? (s7_int)floor(x) : (s7_int)ceil(x));
+}
+
+static s7_pointer truncate_p_d(s7_scheme *sc, s7_double x) {return(make_integer(sc, truncate_i_7d(sc, x)));}
+#endif
+
+
+/* -------------------------------- round -------------------------------- */
+static s7_double r5rs_round(s7_double x)
+{
+  s7_double fl = floor(x), ce = ceil(x);
+  s7_double dfl = x - fl;
+  s7_double dce = ce - x;
+  if (dfl > dce) return(ce);
+  if (dfl < dce) return(fl);
+  return((fmod(fl, 2.0) == 0.0) ? fl : ce);
+}
+
+static s7_pointer round_p_p(s7_scheme *sc, s7_pointer x)
+{
+  switch (type(x))
+    {
+    case T_INTEGER:
+      return(x);
+    case T_RATIO:
+      {
+	s7_int truncated = numerator(x) / denominator(x), remains = numerator(x) % denominator(x);
+	long_double frac = s7_fabsl((long_double)remains / (long_double)denominator(x));
+	if ((frac > 0.5) ||
+	    ((frac == 0.5) &&
+	     (truncated % 2 != 0)))
+	  return(make_integer(sc, (numerator(x) < 0) ? (truncated - 1) : (truncated + 1)));
+	return(make_integer(sc, truncated));
+      }
+    case T_REAL:
+      {
+	s7_double z = real(x);
+	if (is_NaN(z))
+	  sole_arg_out_of_range_error_nr(sc, sc->round_symbol, x, it_is_nan_string);
+	if (is_inf(z))
+	  sole_arg_out_of_range_error_nr(sc, sc->round_symbol, x, it_is_infinite_string);
+#if WITH_GMP
+	if (fabs(z) > DOUBLE_TO_INT64_LIMIT)
+	  {
+	    mpfr_set_d(sc->mpfr_1, z, MPFR_RNDN);
+	    mpfr_rint(sc->mpfr_2, sc->mpfr_1, MPFR_RNDN); /* mpfr_roundeven in mpfr 4.0.0 */
+	    mpfr_get_z(sc->mpz_3, sc->mpfr_2, MPFR_RNDN);
+	    return(mpz_to_integer(sc, sc->mpz_3));
+	  }
+#else
+	if (fabs(z) > DOUBLE_TO_INT64_LIMIT)
+	  sole_arg_out_of_range_error_nr(sc, sc->round_symbol, x, it_is_too_large_string);
+#endif
+	return(make_integer(sc, (s7_int)r5rs_round(z)));
+      }
+#if WITH_GMP
+      case T_BIG_INTEGER:
+	return(x);
+    case T_BIG_RATIO:
+      {
+	int32_t rnd;
+	mpz_fdiv_qr(sc->mpz_1, sc->mpz_2, mpq_numref(big_ratio(x)), mpq_denref(big_ratio(x)));
+	mpz_mul_ui(sc->mpz_2, sc->mpz_2, 2);
+	rnd = mpz_cmpabs(sc->mpz_2, mpq_denref(big_ratio(x)));
+	mpz_fdiv_q(sc->mpz_2, sc->mpz_2, mpq_denref(big_ratio(x)));
+	if (rnd > 0)
+	  mpz_add(sc->mpz_1, sc->mpz_1, sc->mpz_2);
+	else
+	  if ((rnd == 0) &&
+	      (mpz_odd_p(sc->mpz_1)))
+	    mpz_add_ui(sc->mpz_1, sc->mpz_1, 1);
+	return(mpz_to_integer(sc, sc->mpz_1));
+      }
+    case T_BIG_REAL:
+      if (mpfr_nan_p(big_real(x)))
+	sole_arg_out_of_range_error_nr(sc, sc->round_symbol, x, it_is_nan_string);
+      if (mpfr_inf_p(big_real(x)))
+	sole_arg_out_of_range_error_nr(sc, sc->round_symbol, x, it_is_infinite_string);
+      mpfr_set(sc->mpfr_1, big_real(x), MPFR_RNDN);
+      mpfr_rint(sc->mpfr_2, sc->mpfr_1, MPFR_RNDN);
+      mpfr_get_z(sc->mpz_3, sc->mpfr_2, MPFR_RNDN);
+      return(mpz_to_integer(sc, sc->mpz_3));
+    case T_BIG_COMPLEX:
+#endif
+    case T_COMPLEX:
+      sole_arg_wrong_type_error_nr(sc, sc->round_symbol, x, sc->type_names[T_REAL]);
+    default:
+      return(method_or_bust_p(sc, x, sc->round_symbol, sc->type_names[T_REAL]));
+    }
+}
+
+static s7_pointer g_round(s7_scheme *sc, s7_pointer args)
+{
+  #define H_round "(round x) returns the integer closest to x"
+  #define Q_round s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_real_symbol)
+  return(round_p_p(sc, car(args)));
+}
+
+static s7_int round_i_i(s7_int i) {return(i);}
+
+#if (!WITH_GMP)
+static s7_int round_i_7d(s7_scheme *sc, s7_double z)
+{
+  if (is_NaN(z))
+    sole_arg_out_of_range_error_nr(sc, sc->round_symbol, real_NaN, it_is_nan_string);
+  if ((is_inf(z)) ||
+      (z > DOUBLE_TO_INT64_LIMIT) || (z < -DOUBLE_TO_INT64_LIMIT))
+    sole_arg_out_of_range_error_nr(sc, sc->round_symbol, wrap_real(sc, z), it_is_too_large_string);
+  return((s7_int)r5rs_round(z));
+}
+
+static s7_pointer round_p_d(s7_scheme *sc, s7_double x) {return(make_integer(sc,round_i_7d(sc, x)));}
+#endif
+
+
+/* ---------------------------------------- add ---------------------------------------- */
+static inline s7_pointer add_if_overflow_to_real_or_big_integer(s7_scheme *sc, s7_int x, s7_int y)
+{
+#if HAVE_OVERFLOW_CHECKS
+  s7_int val;
+  if (add_overflow(x, y, &val))
+#if WITH_GMP
+    {
+      mpz_set_si(sc->mpz_1, x);
+      mpz_set_si(sc->mpz_2, y);
+      mpz_add(sc->mpz_1, sc->mpz_1, sc->mpz_2);
+      return(mpz_to_big_integer(sc, sc->mpz_1));
+    }
+#else
+    {
+      if (WITH_WARNINGS) s7_warn(sc, 128, "integer add overflow: (+ %" ld64 " %" ld64 ")\n", x, y);
+      return(make_real(sc, (long_double)x + (long_double)y));
+    }
+#endif
+  return(make_integer(sc, val));
+#else
+  return(make_integer(sc, x + y));
+#endif
+}
+
+static s7_pointer integer_ratio_add_if_overflow_to_real_or_rational(s7_scheme *sc, s7_pointer x, s7_pointer y) /* x: int, y:ratio */
+{
+#if HAVE_OVERFLOW_CHECKS
+  s7_int z;
+  if ((multiply_overflow(integer(x), denominator(y), &z)) ||
+      (add_overflow(z, numerator(y), &z)))
+#if WITH_GMP
+    {
+      mpz_set_si(sc->mpz_1, integer(x));
+      mpz_mul_si(sc->mpz_1, sc->mpz_1, denominator(y));
+      mpz_set_si(sc->mpz_2, numerator(y));
+      mpz_add(mpq_numref(sc->mpq_1), sc->mpz_2, sc->mpz_1);
+      mpz_set_si(mpq_denref(sc->mpq_1), denominator(y));
+      return(mpq_to_rational(sc, sc->mpq_1));
+    }
+#else
+    {
+      if (WITH_WARNINGS) s7_warn(sc, 128, "integer + ratio overflow: (+ %" ld64 " %" ld64 "/%" ld64 ")\n", integer(x), numerator(y), denominator(y));
+      return(make_real(sc, (long_double)integer(x) + fraction(y)));
+    }
+#endif
+    return(make_ratio(sc, z, denominator(y)));
+#else
+  return(make_ratio(sc, integer(x) * denominator(y) + numerator(y), denominator(y)));
+#endif
+}
+
+#define parcel_out_fractions(X, Y) do {d1 = denominator(x); n1 = numerator(x); d2 = denominator(y); n2 = numerator(y);} while (0)
+/* add_out_x|y here (as in lt_out_x|y) gives a small speed-up, say 3-7 callgrind units, about 2% */
+
+static s7_pointer add_p_pp(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  /* an experiment: try to avoid the switch statement */
+  /* this wins in most s7 cases, not so much elsewhere? parallel subtract/multiply code is slower */
+  if (is_t_integer(x))
+    {
+      if (is_t_integer(y))
+	return(add_if_overflow_to_real_or_big_integer(sc, integer(x), integer(y)));
+    }
+  else
+    if (is_t_real(x))
+      {
+	if (is_t_real(y))
+	  return(make_real(sc, real(x) + real(y)));
+      }
+    else
+      if ((is_t_complex(x)) && (is_t_complex(y)))
+	return(make_complex(sc, real_part(x) + real_part(y), imag_part(x) + imag_part(y)));
+
+  switch (type(x))
+    {
+    case T_INTEGER:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(add_if_overflow_to_real_or_big_integer(sc, integer(x), integer(y)));
+	case T_RATIO:
+	  return(integer_ratio_add_if_overflow_to_real_or_rational(sc, x, y));
+	case T_REAL:
+#if WITH_GMP
+	  if (s7_int_abs(integer(x)) >= INT64_TO_DOUBLE_LIMIT) /* (+ 9223372036854775807 .1), >= needed for (+ 9007199254740992 1.0) */
+	    {
+	      mpfr_set_si(sc->mpfr_1, integer(x), MPFR_RNDN);
+	      mpfr_add_d(sc->mpfr_1, sc->mpfr_1, real(y), MPFR_RNDN);
+	      return(mpfr_to_big_real(sc, sc->mpfr_1));
+	    }
+#endif
+	  return(make_real(sc, (long_double)integer(x) + real(y)));
+	case T_COMPLEX:
+	  return(make_complex_not_0i(sc, (long_double)integer(x) + (long_double)real_part(y), imag_part(y)));
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  mpz_set_si(sc->mpz_1, integer(x));
+	  mpz_add(sc->mpz_1, sc->mpz_1, big_integer(y));
+	  return(mpz_to_integer(sc, sc->mpz_1));
+	case T_BIG_RATIO:
+	  mpq_set_si(sc->mpq_1, integer(x), 1);
+	  mpq_add(sc->mpq_1, sc->mpq_1, big_ratio(y));
+	  return(mpq_to_rational(sc, sc->mpq_1));
+	case T_BIG_REAL:
+	  mpfr_add_si(sc->mpfr_1, big_real(y), integer(x), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  mpc_set_si(sc->mpc_1, integer(x), MPC_RNDNN);
+	  mpc_add(sc->mpc_1, sc->mpc_1, big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+#endif
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->add_symbol, x, y, a_number_string, 2));
+	}
+
+    case T_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(integer_ratio_add_if_overflow_to_real_or_rational(sc, y, x));
+	case T_RATIO:
+	  {
+	    s7_int d1, d2, n1, n2;
+	    parcel_out_fractions(x, y);
+	    if (d1 == d2)
+	      {
+#if HAVE_OVERFLOW_CHECKS
+		s7_int q;
+		if (add_overflow(n1, n2, &q))
+#if WITH_GMP
+		  {
+		    mpq_set_si(sc->mpq_1, n1, d1);
+		    mpq_set_si(sc->mpq_2, n2, d2);
+		    mpq_add(sc->mpq_1, sc->mpq_1, sc->mpq_2);
+		    return(mpq_to_rational(sc, sc->mpq_1));
+		  }
+#else
+		  {
+ 		    if (WITH_WARNINGS) s7_warn(sc, 128, "ratio + ratio overflow: (/ (+ %" ld64 " %" ld64 ") %" ld64 ")\n", n1, n2, d1);
+		    return(make_real(sc, ((long_double)n1 + (long_double)n2) / (long_double)d1));
+		  }
+#endif
+	        return(make_ratio_with_div_check(sc, sc->add_symbol, q, d1));
+#else
+		return(make_ratio_with_div_check(sc, sc->add_symbol, n1 + n2, d1));
+#endif
+	      }
+
+#if HAVE_OVERFLOW_CHECKS
+	    {
+	      s7_int n1d2, n2d1, d1d2, q;
+	      if ((multiply_overflow(d1, d2, &d1d2)) ||
+		  (multiply_overflow(n1, d2, &n1d2)) ||
+		  (multiply_overflow(n2, d1, &n2d1)) ||
+		  (add_overflow(n1d2, n2d1, &q)))
+#if WITH_GMP
+		{
+		  mpq_set_si(sc->mpq_1, n1, d1);
+		  mpq_set_si(sc->mpq_2, n2, d2);
+		  mpq_add(sc->mpq_1, sc->mpq_1, sc->mpq_2);
+		  return(mpq_to_rational(sc, sc->mpq_1));
+		}
+#else
+	        {
+ 		  if (WITH_WARNINGS) s7_warn(sc, 128, "ratio + ratio overflow: (+ %" ld64 "/%" ld64 " %" ld64 "/%" ld64 ")\n", n1, d1, n2, d2);
+	          return(make_real(sc, ((long_double)n1 / (long_double)d1) + ((long_double)n2 / (long_double)d2)));
+		}
+#endif
+	      return(make_ratio_with_div_check(sc, sc->add_symbol, q, d1d2));
+	    }
+#else
+	    return(make_ratio_with_div_check(sc, sc->add_symbol, n1 * d2 + n2 * d1, d1 * d2));
+#endif
+	  }
+	case T_REAL:
+	  return(make_real(sc, fraction(x) + real(y)));
+	case T_COMPLEX:
+	  return(make_complex_not_0i(sc, fraction(x) + real_part(y), imag_part(y)));
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  mpq_set_z(sc->mpq_2, big_integer(y));
+	  mpq_add(sc->mpq_1, sc->mpq_1, sc->mpq_2);
+	  return(mpq_to_rational(sc, sc->mpq_1));
+	case T_BIG_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  mpq_add(sc->mpq_1, sc->mpq_1, big_ratio(y));
+	  return(mpq_to_rational(sc, sc->mpq_1));
+	case T_BIG_REAL:
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  mpfr_add_q(sc->mpfr_1, big_real(y), sc->mpq_1, MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  mpc_set_q(sc->mpc_1, sc->mpq_1, MPC_RNDNN);
+	  mpc_add(sc->mpc_1, sc->mpc_1, big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+#endif
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->add_symbol, x, y, a_number_string, 2));
+	}
+
+    case T_REAL:
+      switch (type(y))
+	{
+	case T_INTEGER:
+#if WITH_GMP
+	  if (s7_int_abs(integer(y)) >= INT64_TO_DOUBLE_LIMIT) /* (+ .1 9223372036854775807) */
+	    {
+	      mpfr_set_si(sc->mpfr_1, integer(y), MPFR_RNDN);
+	      mpfr_add_d(sc->mpfr_1, sc->mpfr_1, real(x), MPFR_RNDN);
+	      return(mpfr_to_big_real(sc, sc->mpfr_1));
+	    }
+#endif
+	  return(make_real(sc, real(x) + (long_double)integer(y)));
+	case T_RATIO:
+	  return(make_real(sc, real(x) + fraction(y)));
+	case T_REAL:
+	  return(make_real(sc, real(x) + real(y)));
+	case T_COMPLEX:
+	  return(make_complex_not_0i(sc, real(x) + real_part(y), imag_part(y)));
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	  mpfr_add_z(sc->mpfr_1, sc->mpfr_1, big_integer(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_RATIO:
+	  mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	  mpfr_add_q(sc->mpfr_1, sc->mpfr_1, big_ratio(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_REAL:
+	  mpfr_add_d(sc->mpfr_1, big_real(y), real(x), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  mpc_set_d_d(sc->mpc_1, real(x), 0.0, MPC_RNDNN);
+	  mpc_add(sc->mpc_1, sc->mpc_1, big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+#endif
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->add_symbol, x, y, a_number_string, 2));
+	}
+
+    case T_COMPLEX:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(make_complex_not_0i(sc, real_part(x) + integer(y), imag_part(x)));
+	case T_RATIO:
+	  return(make_complex_not_0i(sc, real_part(x) + fraction(y), imag_part(x)));
+	case T_REAL:
+	  return(make_complex_not_0i(sc, real_part(x) + real(y), imag_part(x)));
+	case T_COMPLEX:
+	  return(make_complex(sc, real_part(x) + real_part(y), imag_part(x) + imag_part(y)));
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  mpc_set_d_d(sc->mpc_1, real_part(x), imag_part(x), MPC_RNDNN);
+	  mpc_set_z(sc->mpc_2, big_integer(y), MPC_RNDNN);
+	  mpc_add(sc->mpc_1, sc->mpc_1, sc->mpc_2, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_RATIO:
+	  mpc_set_d_d(sc->mpc_1, real_part(x), imag_part(x), MPC_RNDNN);
+	  mpc_set_q(sc->mpc_2, big_ratio(y), MPC_RNDNN);
+	  mpc_add(sc->mpc_1, sc->mpc_1, sc->mpc_2, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_REAL:
+	  mpc_set_d_d(sc->mpc_1, real_part(x), imag_part(x), MPC_RNDNN);
+	  mpc_add_fr(sc->mpc_1, sc->mpc_1, big_real(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_COMPLEX:
+	  mpc_set_d_d(sc->mpc_1, real_part(x), imag_part(x), MPC_RNDNN);
+	  mpc_add(sc->mpc_1, sc->mpc_1, big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+#endif
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->add_symbol, x, y, a_number_string, 2));
+	}
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  mpz_set_si(sc->mpz_1, integer(y));
+	  mpz_add(sc->mpz_1, big_integer(x), sc->mpz_1);
+	  return(mpz_to_integer(sc, sc->mpz_1));
+	case T_RATIO:
+	  mpq_set_z(sc->mpq_2, big_integer(x));
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  mpq_add(sc->mpq_1, sc->mpq_2, sc->mpq_1);
+	  return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+	case T_REAL:
+	  if (is_NaN(real(y))) return(y);
+	  mpfr_set_d(sc->mpfr_1, real(y), MPFR_RNDN);
+	  mpfr_add_z(sc->mpfr_1, sc->mpfr_1, big_integer(x), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_COMPLEX:
+	  mpc_set_d_d(sc->mpc_1, real_part(y), imag_part(y), MPC_RNDNN);
+	  mpc_set_z(sc->mpc_2, big_integer(x), MPC_RNDNN);
+	  mpc_add(sc->mpc_1, sc->mpc_2, sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_INTEGER:
+	  mpz_add(sc->mpz_1, big_integer(x), big_integer(y));
+	  return(mpz_to_integer(sc, sc->mpz_1));
+	case T_BIG_RATIO:
+	  mpq_set_z(sc->mpq_1, big_integer(x));
+	  mpq_add(sc->mpq_1, sc->mpq_1, big_ratio(y));
+	  return(mpq_to_rational(sc, sc->mpq_1));
+	case T_BIG_REAL:
+	  mpfr_add_z(sc->mpfr_1, big_real(y), big_integer(x), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  mpc_set_z(sc->mpc_1, big_integer(x), MPC_RNDNN);
+	  mpc_add(sc->mpc_1, sc->mpc_1, big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->add_symbol, x, y, a_number_string, 2));
+	}
+
+    case T_BIG_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  mpq_set_si(sc->mpq_1, integer(y), 1);
+	  mpq_add(sc->mpq_1, big_ratio(x), sc->mpq_1);
+	  return(mpq_to_rational(sc, sc->mpq_1));
+	case T_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  mpq_add(sc->mpq_1, big_ratio(x), sc->mpq_1);
+	  return(mpq_to_rational(sc, sc->mpq_1));
+	case T_REAL:
+	  if (is_NaN(real(y))) return(y);
+	  mpfr_set_d(sc->mpfr_1, real(y), MPFR_RNDN);
+	  mpfr_add_q(sc->mpfr_1, sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_COMPLEX:
+	  mpc_set_q(sc->mpc_1, big_ratio(x), MPC_RNDNN);
+	  mpc_set_d_d(sc->mpc_2, real_part(y), imag_part(y), MPC_RNDNN);
+	  mpc_add(sc->mpc_1, sc->mpc_1, sc->mpc_2, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_INTEGER:
+	  mpq_set_z(sc->mpq_1, big_integer(y));
+	  mpq_add(sc->mpq_1, big_ratio(x), sc->mpq_1);
+	  return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+	case T_BIG_RATIO:
+	  mpq_add(sc->mpq_1, big_ratio(x), big_ratio(y));
+	  return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+	case T_BIG_REAL:
+	  mpfr_add_q(sc->mpfr_1, big_real(y), big_ratio(x), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  mpc_set_q(sc->mpc_1, big_ratio(x), MPC_RNDNN);
+	  mpc_add(sc->mpc_1, sc->mpc_1, big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->add_symbol, x, y, a_number_string, 2));
+	}
+
+    case T_BIG_REAL:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  mpfr_add_si(sc->mpfr_1, big_real(x), integer(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  mpfr_add_q(sc->mpfr_1, big_real(x), sc->mpq_1, MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_REAL:
+	  if (is_NaN(real(y))) return(y);
+	  mpfr_add_d(sc->mpfr_1, big_real(x), real(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_COMPLEX:
+	  mpc_set_d_d(sc->mpc_1, real_part(y), imag_part(y), MPC_RNDNN);
+	  mpc_add_fr(sc->mpc_1, sc->mpc_1, big_real(x), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_INTEGER:
+	  mpfr_add_z(sc->mpfr_1, big_real(x), big_integer(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_RATIO:
+	  mpfr_add_q(sc->mpfr_1, big_real(x), big_ratio(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_REAL:
+	  mpfr_add(sc->mpfr_1, big_real(x), big_real(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  mpc_add_fr(sc->mpc_1, big_complex(y), big_real(x), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->add_symbol, x, y, a_number_string, 2));
+	}
+    case T_BIG_COMPLEX:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  mpc_set_si(sc->mpc_1, integer(y), MPC_RNDNN);
+	  mpc_add(sc->mpc_1, big_complex(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  mpc_set_q(sc->mpc_1, sc->mpq_1, MPC_RNDNN);
+	  mpc_add(sc->mpc_1, big_complex(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_REAL:
+	  /* if (is_NaN(real(y))) return(y); */
+	  mpc_set_d_d(sc->mpc_1, real(y), 0.0, MPC_RNDNN);
+	  mpc_add(sc->mpc_1, big_complex(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_COMPLEX:
+	  mpc_set_d_d(sc->mpc_1, real_part(y), imag_part(y), MPC_RNDNN);
+	  mpc_add(sc->mpc_1, big_complex(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_INTEGER:
+	  mpc_set_z(sc->mpc_1, big_integer(y), MPC_RNDNN);
+	  mpc_add(sc->mpc_1, big_complex(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_RATIO:
+	  mpc_set_q(sc->mpc_1, big_ratio(y), MPC_RNDNN);
+	  mpc_add(sc->mpc_1, big_complex(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_REAL:
+	  mpc_add_fr(sc->mpc_1, big_complex(x), big_real(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_COMPLEX:
+	  mpc_add(sc->mpc_1, big_complex(x), big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->add_symbol, x, y, a_number_string, 2));
+	}
+#endif
+      default:
+	return(method_or_bust_pp(sc, x, sc->add_symbol, x, y, a_number_string, 1));
+    }
+}
+
+static s7_pointer add_p_ppp(s7_scheme *sc, s7_pointer p0, s7_pointer p1, s7_pointer p2)
+{
+  if ((is_t_integer(p0)) && (is_t_integer(p1)) && (is_t_integer(p2)))
+    {
+#if HAVE_OVERFLOW_CHECKS
+      s7_int val;
+      if ((!add_overflow(integer(p0), integer(p1), &val)) &&
+	  (!add_overflow(val, integer(p2), &val)))
+	return(make_integer(sc, val));
+#if WITH_GMP
+      mpz_set_si(sc->mpz_1, integer(p0));
+      mpz_set_si(sc->mpz_2, integer(p1));
+      mpz_add(sc->mpz_1, sc->mpz_1, sc->mpz_2);
+      mpz_set_si(sc->mpz_2, integer(p2));
+      mpz_add(sc->mpz_1, sc->mpz_1, sc->mpz_2);
+      return(mpz_to_integer(sc, sc->mpz_1));
+#else
+      if (WITH_WARNINGS) s7_warn(sc, 128, "integer add overflow: (+ %" ld64 " %" ld64 " %" ld64 ")\n", integer(p0), integer(p1), integer(p2));
+      return(make_real(sc, (long_double)integer(p0) + (long_double)integer(p1) + (long_double)integer(p2)));
+#endif
+#else
+      return(make_integer(sc, integer(p0) + integer(p1) + integer(p2)));
+#endif
+    }
+  if ((is_t_real(p0)) && (is_t_real(p1)) && (is_t_real(p2)))
+    return(make_real(sc, real(p0) + real(p1) + real(p2)));
+  {
+    s7_pointer p = add_p_pp(sc, p0, p1);
+    sc->error_argnum = 1;
+    p = add_p_pp(sc, p, p2);
+    sc->error_argnum = 0;
+    return(p);
+  }
+}
+
+static s7_pointer g_add(s7_scheme *sc, s7_pointer args)
+{
+  #define H_add "(+ ...) adds its arguments"
+  #define Q_add sc->pcl_n
+
+  s7_pointer x, p;
+  if (is_null(args))
+    return(int_zero);
+  x = car(args);
+  p = cdr(args);
+  if (is_null(p))
+    {
+      if (!is_number(x))
+	return(method_or_bust_p(sc, x, sc->add_symbol, a_number_string));
+      return(x);
+    }
+  if (is_null(cdr(p)))
+    return(add_p_pp(sc, x, car(p)));
+  for (sc->error_argnum = 0; is_pair(p); p = cdr(p), sc->error_argnum++)
+    x = add_p_pp(sc, x, car(p));
+  sc->error_argnum = 0;
+  return(x);
+}
+
+static s7_pointer g_add_2(s7_scheme *sc, s7_pointer args) {return(add_p_pp(sc, car(args), cadr(args)));}
+static s7_pointer g_add_3(s7_scheme *sc, s7_pointer args) {return(add_p_ppp(sc, car(args), cadr(args), caddr(args)));}
+
+static s7_pointer g_add_x1_1(s7_scheme *sc, s7_pointer x, int32_t pos)
+{
+  if (is_t_integer(x))
+    return(add_if_overflow_to_real_or_big_integer(sc, integer(x), 1));
+
+  switch (type(x))
+    {
+    case T_RATIO:   return(integer_ratio_add_if_overflow_to_real_or_rational(sc, int_one, x)); /* return(add_p_pp(sc, x, int_one)) */
+    case T_REAL:    return(make_real(sc, real(x) + 1.0));
+    case T_COMPLEX: return(make_complex_not_0i(sc, real_part(x) + 1.0, imag_part(x)));
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpz_set_si(sc->mpz_1, 1);
+      mpz_add(sc->mpz_1, big_integer(x), sc->mpz_1);
+      return(mpz_to_integer(sc, sc->mpz_1));
+    case T_BIG_RATIO:
+    case T_BIG_REAL:
+    case T_BIG_COMPLEX:
+      return(add_p_pp(sc, x, int_one));
+#endif
+    default:
+      return(method_or_bust(sc, x, sc->add_symbol,
+			    (pos == 1) ? set_plist_2(sc, x, int_one) : set_plist_2(sc, int_one, x),
+			    a_number_string, pos));
+    }
+  return(x);
+}
+
+#if WITH_GMP
+static s7_pointer g_add_x1(s7_scheme *sc, s7_pointer args) {return(g_add_x1_1(sc, car(args), 1));}
+#else
+static s7_pointer g_add_x1(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer x = car(args);
+  if (is_t_integer(x)) return(add_if_overflow_to_real_or_big_integer(sc, integer(x), 1)); /* return(make_integer(sc, integer(x) + 1)); */
+  if (is_t_real(x)) return(make_real(sc, real(x) + 1.0));
+  if (is_t_complex(x)) return(make_complex_not_0i(sc, real_part(x) + 1.0, imag_part(x)));
+  return(add_p_pp(sc, x, int_one));
+}
+#endif
+static s7_pointer g_add_1x(s7_scheme *sc, s7_pointer args) {return(g_add_x1_1(sc, cadr(args), 2));}
+
+static s7_pointer g_add_xi(s7_scheme *sc, s7_pointer x, s7_int y, int32_t loc)
+{
+  if (is_t_integer(x))
+    return(add_if_overflow_to_real_or_big_integer(sc, integer(x), y));
+
+  switch (type(x))
+    {
+    case T_RATIO:   return(add_p_pp(sc, x, wrap_integer(sc, y)));
+    case T_REAL:    return(make_real(sc, real(x) + y));
+    case T_COMPLEX: return(make_complex_not_0i(sc, real_part(x) + y, imag_part(x)));
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpz_set_si(sc->mpz_1, y);
+      mpz_add(sc->mpz_1, big_integer(x), sc->mpz_1);
+      return(mpz_to_integer(sc, sc->mpz_1));
+    case T_BIG_RATIO:
+    case T_BIG_REAL:
+    case T_BIG_COMPLEX:
+      return(add_p_pp(sc, x, wrap_integer(sc, y)));
+#endif
+    default: return(method_or_bust_with_type_pi(sc, x, sc->add_symbol, x, y, a_number_string, loc));
+    }
+  return(x);
+}
+
+static s7_pointer add_p_pi(s7_scheme *sc, s7_pointer p1, s7_int i1) {return(g_add_xi(sc, p1, i1, 1));}
+
+static s7_pointer g_add_xf(s7_scheme *sc, s7_pointer x, s7_double y, int32_t loc)
+{
+  if (is_t_real(x)) return(make_real(sc, real(x) + y));
+  switch (type(x))
+    {
+    case T_INTEGER: return(make_real(sc, integer(x) + y));
+    case T_RATIO:   return(make_real(sc, fraction(x) + y));
+    case T_COMPLEX: return(make_complex_not_0i(sc, real_part(x) + y, imag_part(x)));
+#if WITH_GMP
+    case T_BIG_INTEGER: case T_BIG_RATIO: case T_BIG_REAL: case T_BIG_COMPLEX:
+      return(add_p_pp(sc, x, wrap_real(sc, y)));
+#endif
+    default: return(method_or_bust_with_type_pf(sc, x, sc->add_symbol, x, y, a_number_string, loc));
+    }
+  return(x);
+}
+
+static s7_pointer g_add_2_ff(s7_scheme *sc, s7_pointer args)
+{
+#if WITH_GMP
+  if ((is_t_real(car(args))) && (is_t_real(cadr(args))))
+    return(make_real(sc, real(car(args)) + real(cadr(args))));
+  return(add_p_pp(sc, car(args), cadr(args)));
+#else
+  return(make_real(sc, real(car(args)) + real(cadr(args))));
+#endif
+}
+
+static s7_pointer g_add_2_ii(s7_scheme *sc, s7_pointer args)
+{
+#if WITH_GMP
+  if ((is_t_integer(car(args))) && (is_t_integer(cadr(args))))
+#endif
+    return(add_if_overflow_to_real_or_big_integer(sc, integer(car(args)), integer(cadr(args))));
+#if WITH_GMP
+  return(g_add(sc, args)); /* possibly bigint? */
+#endif
+}
+
+#if WITH_GMP
+static s7_pointer add_2_if(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  if ((is_t_integer(x)) && (is_t_real(y)))
+    {
+      if (s7_int_abs(integer(x)) >= INT64_TO_DOUBLE_LIMIT)
+	{
+	  mpfr_set_si(sc->mpfr_1, integer(x), MPFR_RNDN);
+	  mpfr_add_d(sc->mpfr_1, sc->mpfr_1, real(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	}
+      return(make_real(sc, integer(x) + real(y)));
+    }
+  return(add_p_pp(sc, x, y));
+}
+
+static s7_pointer g_add_2_if(s7_scheme *sc, s7_pointer args) {return(add_2_if(sc, car(args), cadr(args)));}
+static s7_pointer g_add_2_fi(s7_scheme *sc, s7_pointer args) {return(add_2_if(sc, cadr(args), car(args)));}
+
+static s7_pointer g_add_2_xi(s7_scheme *sc, s7_pointer args) {if (is_t_integer(cadr(args))) return(g_add_xi(sc, car(args), integer(cadr(args)), 1)); return(g_add(sc, args));}
+static s7_pointer g_add_2_ix(s7_scheme *sc, s7_pointer args) {if (is_t_integer(car(args))) return(g_add_xi(sc, cadr(args), integer(car(args)), 2)); return(g_add(sc, args));}
+static s7_pointer g_add_2_xf(s7_scheme *sc, s7_pointer args) {if (is_t_real(cadr(args))) return(g_add_xf(sc, car(args), real(cadr(args)), 1)); return(g_add(sc, args));}
+static s7_pointer g_add_2_fx(s7_scheme *sc, s7_pointer args) {if (is_t_real(car(args))) return(g_add_xf(sc, cadr(args), real(car(args)), 2)); return(g_add(sc, args));}
+
+#else
+
+static s7_pointer g_add_2_if(s7_scheme *sc, s7_pointer args) {return(make_real(sc, integer(car(args)) + real(cadr(args))));}
+static s7_pointer g_add_2_fi(s7_scheme *sc, s7_pointer args) {return(make_real(sc, real(car(args)) + integer(cadr(args))));}
+static s7_pointer g_add_2_xi(s7_scheme *sc, s7_pointer args) {return(g_add_xi(sc, car(args), integer(cadr(args)), 1));}
+static s7_pointer g_add_2_ix(s7_scheme *sc, s7_pointer args) {return(g_add_xi(sc, cadr(args), integer(car(args)), 2));}
+static s7_pointer g_add_2_xf(s7_scheme *sc, s7_pointer args) {return(g_add_xf(sc, car(args), real(cadr(args)), 1));}
+static s7_pointer g_add_2_fx(s7_scheme *sc, s7_pointer args) {return(g_add_xf(sc, cadr(args), real(car(args)), 2));}
+#endif
+
+static s7_pointer add_p_dd(s7_scheme *sc, s7_double x1, s7_double x2) {return(make_real(sc, x1 + x2));}
+static s7_pointer add_p_ii(s7_scheme *sc, s7_int x1, s7_int x2) {return(make_integer(sc, x1 + x2));}
+
+static s7_double add_d_d(s7_double x) {return(x);}
+static s7_double add_d_dd(s7_double x1, s7_double x2) {return(x1 + x2);}
+static s7_double add_d_id(s7_int x1, s7_double x2) {return(x1 + x2);}
+static s7_double add_d_ddd(s7_double x1, s7_double x2, s7_double x3) {return(x1 + x2 + x3);}
+static s7_double add_d_dddd(s7_double x1, s7_double x2, s7_double x3, s7_double x4) {return(x1 + x2 + x3 + x4);}
+
+static s7_int add_i_ii(s7_int i1, s7_int i2) {return(i1 + i2);}
+static s7_int add_i_iii(s7_int i1, s7_int i2, s7_int i3) {return(i1 + i2 + i3);}
+
+static s7_pointer argument_type(s7_scheme *sc, s7_pointer arg1)
+{
+  if (is_pair(arg1))
+    {
+      if (is_quote(car(arg1)))
+	return((is_pair(cdr(arg1))) ? s7_type_of(sc, cadr(arg1)) : NULL);    /* arg1 = (quote) */
+
+      if ((is_h_optimized(arg1)) &&
+	  (is_safe_c_op(optimize_op(arg1))) &&
+	  (is_c_function(opt1_cfunc(arg1))))
+	{
+	  s7_pointer sig = c_function_signature(opt1_cfunc(arg1));
+	  if ((sig) &&
+	      (is_pair(sig)) &&
+	      (is_symbol(car(sig))))
+	    return(car(sig));
+	}
+      /* perhaps add closure sig if we can depend on it (immutable func etc) */
+    }
+  else
+    if (!is_symbol(arg1))
+      return(s7_type_of(sc, arg1));
+  return(NULL);
+}
+
+static s7_pointer chooser_check_arg_types(s7_scheme *sc, s7_pointer arg1, s7_pointer arg2, s7_pointer fallback,
+					  s7_pointer f_2_ff, s7_pointer f_2_ii, s7_pointer f_2_if, s7_pointer f_2_fi,
+					  s7_pointer f_2_xi, s7_pointer f_2_ix, s7_pointer f_2_fx, s7_pointer f_2_xf)
+{
+  const s7_pointer arg1_type = argument_type(sc, arg1);
+  const s7_pointer arg2_type = argument_type(sc, arg2);
+  if ((arg1_type) || (arg2_type))
+    {
+      if (arg1_type == sc->is_float_symbol)
+	{
+	  if (arg2_type == sc->is_float_symbol)
+	    return(f_2_ff);
+	  return((arg2_type == sc->is_integer_symbol) ? f_2_fi : f_2_fx);
+	}
+      if (arg1_type == sc->is_integer_symbol)
+	{
+	  if (arg2_type == sc->is_float_symbol)
+	    return(f_2_if);
+	  return((arg2_type == sc->is_integer_symbol) ? f_2_ii : f_2_ix);
+	}
+      if (arg2_type == sc->is_float_symbol)
+	return(f_2_xf);
+      if (arg2_type == sc->is_integer_symbol)
+	return(f_2_xi);
+    }
+  return(fallback);
+}
+
+static s7_pointer g_random_i(s7_scheme *sc, s7_pointer args);
+
+static s7_pointer add_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  /* (+ s f) (+ (* s s) s) (+ s s) (+ s (* s s)) */
+  if (args != 2) return((args == 3) ? sc->add_3 : f);
+    {
+      s7_pointer arg1 = cadr(expr), arg2 = caddr(expr);
+      if (arg2 == int_one)                          /* (+ ... 1) */
+	return(sc->add_x1);
+      if ((is_t_integer(arg1)) && ((is_pair(arg2)) && (is_optimized(arg2)) && (is_h_safe_c_nc(arg2)) && (fn_proc(arg2) == g_random_i)))
+	{
+	  set_opt3_int(cdr(expr), integer(cadr(arg2)));
+	  set_safe_optimize_op(expr, HOP_SAFE_C_NC); /* op if r op? */
+	  return(sc->add_i_random);
+	}
+      if (arg1 == int_one)
+	return(sc->add_1x);
+      return(chooser_check_arg_types(sc, arg1, arg2, sc->add_2,
+				     sc->add_2_ff, sc->add_2_ii, sc->add_2_if, sc->add_2_fi,
+				     sc->add_2_xi, sc->add_2_ix, sc->add_2_fx, sc->add_2_xf));
+    }
+  return(sc->add_2);
+}
+
+/* ---------------------------------------- subtract ---------------------------------------- */
+static s7_pointer negate_p_p(s7_scheme *sc, s7_pointer p)     /* can't use "negate" because it confuses C++! */
+{
+  switch (type(p))
+    {
+    case T_INTEGER:
+      if (integer(p) == S7_INT64_MIN)
+#if WITH_GMP
+	{
+	  mpz_set_si(sc->mpz_1, S7_INT64_MIN);
+	  mpz_neg(sc->mpz_1, sc->mpz_1);
+	  return(mpz_to_big_integer(sc, sc->mpz_1));
+	}
+#else
+	sole_arg_out_of_range_error_nr(sc, sc->subtract_symbol, p, wrap_string(sc, "most-negative-fixnum can't be negated", 37));
+#endif
+      return(make_integer(sc, -integer(p)));
+
+    case T_RATIO:   return(make_simple_ratio(sc, -numerator(p), denominator(p)));
+    case T_REAL:    return(make_real(sc, -real(p)));
+    case T_COMPLEX: return(make_complex_not_0i(sc, -real_part(p), -imag_part(p)));
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpz_neg(sc->mpz_1, big_integer(p));
+      return(mpz_to_integer(sc, sc->mpz_1));
+    case T_BIG_RATIO:
+      mpq_neg(sc->mpq_1, big_ratio(p));
+      return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+    case T_BIG_REAL:
+      mpfr_neg(sc->mpfr_1, big_real(p), MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_COMPLEX:
+      mpc_neg(sc->mpc_1, big_complex(p), MPC_RNDNN);
+      return(mpc_to_number(sc, sc->mpc_1));
+#endif
+    default:
+      return(method_or_bust_p(sc, p, sc->subtract_symbol, a_number_string));
+    }
+}
+
+static inline s7_pointer subtract_if_overflow_to_real_or_big_integer(s7_scheme *sc, s7_int x, s7_int y)
+{
+#if HAVE_OVERFLOW_CHECKS
+  s7_int val;
+  if (subtract_overflow(x, y, &val))
+#if WITH_GMP
+    {
+      mpz_set_si(sc->mpz_1, x);
+      mpz_set_si(sc->mpz_2, y);
+      mpz_sub(sc->mpz_1, sc->mpz_1, sc->mpz_2);
+      return(mpz_to_big_integer(sc, sc->mpz_1));
+    }
+#else
+    {
+      if (WITH_WARNINGS) s7_warn(sc, 128, "integer subtract overflow: (- %" ld64 " %" ld64 ")\n", x, y);
+      return(make_real(sc, (long_double)x - (long_double)y));
+    }
+#endif
+  return(make_integer(sc, val));
+#else
+  return(make_integer(sc, x - y));
+#endif
+}
+
+static s7_pointer subtract_p_pp(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  switch (type(x))
+    {
+    case T_INTEGER:
+      if (integer(x) == 0)
+	return(negate_p_p(sc, y));
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(subtract_if_overflow_to_real_or_big_integer(sc, integer(x), integer(y)));
+
+	case T_RATIO:
+	  {
+#if HAVE_OVERFLOW_CHECKS
+	    s7_int z;
+	    if ((multiply_overflow(integer(x), denominator(y), &z)) ||
+		(subtract_overflow(z, numerator(y), &z)))
+#if WITH_GMP
+	      {
+		mpz_set_si(sc->mpz_1, integer(x));
+		mpz_mul_si(sc->mpz_1, sc->mpz_1, denominator(y));
+		mpz_set_si(sc->mpz_2, numerator(y));
+		mpz_sub(mpq_numref(sc->mpq_1), sc->mpz_1, sc->mpz_2);
+		mpz_set_si(mpq_denref(sc->mpq_1), denominator(y));
+		return(mpq_to_rational(sc, sc->mpq_1));
+	      }
+#else
+	      {
+		if (WITH_WARNINGS) s7_warn(sc, 128, "integer - ratio overflow: (- %" ld64 " %" ld64 "/%" ld64 ")\n", integer(x), numerator(y), denominator(y));
+		return(make_real(sc, (long_double)integer(x) - fraction(y)));
+	      }
+#endif
+	      return(make_ratio(sc, z, denominator(y)));
+#else
+	    return(make_ratio(sc, integer(x) * denominator(y) - numerator(y), denominator(y)));
+#endif
+	  }
+	case T_REAL:
+#if WITH_GMP
+	  if (s7_int_abs(integer(x)) >= INT64_TO_DOUBLE_LIMIT) /* (- 9223372036854775807 .1) */
+	    {
+	      mpfr_set_si(sc->mpfr_1, integer(x), MPFR_RNDN);
+	      mpfr_sub_d(sc->mpfr_1, sc->mpfr_1, real(y), MPFR_RNDN);
+	      return(mpfr_to_big_real(sc, sc->mpfr_1));
+	    }
+#endif
+	  return(make_real(sc, (long_double)integer(x) - real(y)));
+	case T_COMPLEX:
+	  return(make_complex_not_0i(sc, (long_double)integer(x) - real_part(y), -imag_part(y)));
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  mpz_set_si(sc->mpz_1, integer(x));
+	  mpz_sub(sc->mpz_1, sc->mpz_1, big_integer(y));
+	  return(mpz_to_integer(sc, sc->mpz_1));
+	case T_BIG_RATIO:
+	  mpq_set_si(sc->mpq_1, integer(x), 1);
+	  mpq_sub(sc->mpq_1, sc->mpq_1, big_ratio(y));
+	  return(mpq_to_rational(sc, sc->mpq_1));
+	case T_BIG_REAL:
+	  mpfr_si_sub(sc->mpfr_1, integer(x), big_real(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  mpc_set_si(sc->mpc_1, integer(x), MPC_RNDNN);
+	  mpc_sub(sc->mpc_1, sc->mpc_1, big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+#endif
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->subtract_symbol, x, y, a_number_string, 2));
+	}
+
+    case T_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  {
+#if HAVE_OVERFLOW_CHECKS
+	    s7_int z;
+	    if ((multiply_overflow(integer(y), denominator(x), &z)) ||
+		(subtract_overflow(numerator(x), z, &z)))
+#if WITH_GMP
+	      {
+		mpz_set_si(sc->mpz_1, integer(y));
+		mpz_mul_si(sc->mpz_1, sc->mpz_1, denominator(x));
+		mpz_set_si(sc->mpz_2, numerator(x));
+		mpz_sub(mpq_numref(sc->mpq_1), sc->mpz_2, sc->mpz_1);
+		mpz_set_si(mpq_denref(sc->mpq_1), denominator(x));
+		return(mpq_to_rational(sc, sc->mpq_1));
+	      }
+#else
+	      {
+		if (WITH_WARNINGS) s7_warn(sc, 128, "ratio - integer overflow: (- %" ld64 "/%" ld64 " %" ld64 ")\n", numerator(x), denominator(x), integer(y));
+		return(make_real(sc, fraction(x) - (long_double)integer(y)));
+	      }
+#endif
+	    return(make_ratio(sc, z, denominator(x)));
+#else
+	    return(make_ratio(sc, numerator(x) - (integer(y) * denominator(x)), denominator(x)));
+#endif
+	  }
+	case T_RATIO:
+	  {
+	    s7_int d1, d2, n1, n2;
+	    parcel_out_fractions(x, y);
+	    if (d1 == d2)
+	      {
+#if HAVE_OVERFLOW_CHECKS
+		s7_int q;
+		if (subtract_overflow(n1, n2, &q))
+#if WITH_GMP
+		  {
+		    mpq_set_si(sc->mpq_1, n1, d1);
+		    mpq_set_si(sc->mpq_2, n2, d2);
+		    mpq_sub(sc->mpq_1, sc->mpq_1, sc->mpq_2);
+		    return(mpq_to_rational(sc, sc->mpq_1));
+		  }
+#else
+		  {
+		    if (WITH_WARNINGS) s7_warn(sc, 128, "ratio - ratio overflow: (- %" ld64 "/%" ld64 " %" ld64 "/%" ld64 ")\n", n1, d1, n2, d2);
+		    return(make_real(sc, ((long_double)n1 - (long_double)n2) / (long_double)d1));
+		  }
+#endif
+	        return(make_ratio_with_div_check(sc, sc->subtract_symbol, q, d1));
+#else
+		return(make_ratio(sc, numerator(x) - numerator(y), denominator(x)));
+#endif
+	      }
+
+#if HAVE_OVERFLOW_CHECKS
+	    {
+	      s7_int n1d2, n2d1, d1d2, q;
+	      if ((multiply_overflow(d1, d2, &d1d2)) ||
+		  (multiply_overflow(n1, d2, &n1d2)) ||
+		  (multiply_overflow(n2, d1, &n2d1)) ||
+		  (subtract_overflow(n1d2, n2d1, &q)))
+#if WITH_GMP
+		{
+		  mpq_set_si(sc->mpq_1, n1, d1);
+		  mpq_set_si(sc->mpq_2, n2, d2);
+		  mpq_sub(sc->mpq_1, sc->mpq_1, sc->mpq_2);
+		  return(mpq_to_rational(sc, sc->mpq_1));
+		}
+#else
+	        {
+		  if (WITH_WARNINGS) s7_warn(sc, 128, "ratio - ratio overflow: (- %" ld64 "/%" ld64 " %" ld64 "/%" ld64 ")\n", n1, d1, n2, d2);
+		  return(make_real(sc, ((long_double)n1 / (long_double)d1) - ((long_double)n2 / (long_double)d2)));
+		}
+#endif
+	      return(make_ratio_with_div_check(sc, sc->subtract_symbol, q, d1d2));
+	    }
+#else
+	    return(make_ratio_with_div_check(sc, sc->subtract_symbol, n1 * d2 - n2 * d1, d1 * d2));
+#endif
+	  }
+	case T_REAL:
+	  return(make_real(sc, fraction(x) - real(y)));
+	case T_COMPLEX:
+	  return(make_complex_not_0i(sc, fraction(x) - real_part(y), -imag_part(y)));
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  mpq_set_z(sc->mpq_2, big_integer(y));
+	  mpq_sub(sc->mpq_1, sc->mpq_1, sc->mpq_2);
+	  return(mpq_to_rational(sc, sc->mpq_1));
+	case T_BIG_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  mpq_sub(sc->mpq_1, sc->mpq_1, big_ratio(y));
+	  return(mpq_to_rational(sc, sc->mpq_1));
+	case T_BIG_REAL:
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  mpfr_set_q(sc->mpfr_1, sc->mpq_1, MPFR_RNDN);
+	  mpfr_sub(sc->mpfr_1, sc->mpfr_1, big_real(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  mpc_set_q(sc->mpc_1, sc->mpq_1, MPC_RNDNN);
+	  mpc_sub(sc->mpc_1, sc->mpc_1, big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+#endif
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->subtract_symbol, x, y, a_number_string, 2));
+	}
+
+    case T_REAL:
+      switch (type(y))
+	{
+	case T_INTEGER:
+#if WITH_GMP
+	  if (s7_int_abs(integer(y)) >= INT64_TO_DOUBLE_LIMIT) /* (- .1 92233720368547758071) */
+	    {
+	      mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	      mpfr_sub_si(sc->mpfr_1, sc->mpfr_1, integer(y), MPFR_RNDN);
+	      return(mpfr_to_big_real(sc, sc->mpfr_1));
+	    }
+#endif
+	  return(make_real(sc, real(x) - (long_double)integer(y))); /* long_double saves (- 9007199254740996.0 9007199254740995): 1.0 */
+	case T_RATIO:
+	  return(make_real(sc, real(x) - fraction(y)));
+	case T_REAL:
+	  return(make_real(sc, real(x) - real(y)));
+	case T_COMPLEX:
+	  return(make_complex_not_0i(sc, real(x) - real_part(y), -imag_part(y)));
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	  mpfr_sub_z(sc->mpfr_1, sc->mpfr_1, big_integer(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_RATIO:
+	  mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	  mpfr_sub_q(sc->mpfr_1, sc->mpfr_1, big_ratio(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_REAL:
+	  mpfr_d_sub(sc->mpfr_1, real(x), big_real(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  mpc_set_d_d(sc->mpc_1, real(x), 0.0, MPC_RNDNN);
+	  mpc_sub(sc->mpc_1, sc->mpc_1, big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+#endif
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->subtract_symbol, x, y, a_number_string, 2));
+	}
+
+    case T_COMPLEX:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(make_complex_not_0i(sc, real_part(x) - integer(y), imag_part(x)));
+	case T_RATIO:
+	  return(make_complex_not_0i(sc, real_part(x) - fraction(y), imag_part(x)));
+	case T_REAL:
+	  return(make_complex_not_0i(sc, real_part(x) - real(y), imag_part(x)));
+	case T_COMPLEX:
+	  return(make_complex(sc, real_part(x) - real_part(y), imag_part(x) - imag_part(y)));
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  mpc_set_d_d(sc->mpc_1, real_part(x), imag_part(x), MPC_RNDNN);
+	  mpc_set_z(sc->mpc_2, big_integer(y), MPC_RNDNN);
+	  mpc_sub(sc->mpc_1, sc->mpc_1, sc->mpc_2, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_RATIO:
+	  mpc_set_d_d(sc->mpc_1, real_part(x), imag_part(x), MPC_RNDNN);
+	  mpc_set_q(sc->mpc_2, big_ratio(y), MPC_RNDNN);
+	  mpc_sub(sc->mpc_1, sc->mpc_1, sc->mpc_2, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_REAL:
+	  mpc_set_d_d(sc->mpc_1, real_part(x), imag_part(x), MPC_RNDNN);
+	  mpc_sub_fr(sc->mpc_1, sc->mpc_1, big_real(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_COMPLEX:
+	  mpc_set_d_d(sc->mpc_1, real_part(x), imag_part(x), MPC_RNDNN);
+	  mpc_sub(sc->mpc_1, sc->mpc_1, big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+#endif
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->subtract_symbol, x, y, a_number_string, 2));
+	}
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  mpz_set_si(sc->mpz_1, integer(y));
+	  mpz_sub(sc->mpz_1, big_integer(x), sc->mpz_1);
+	  return(mpz_to_integer(sc, sc->mpz_1));
+	case T_RATIO:
+	  mpq_set_z(sc->mpq_2, big_integer(x));
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  mpq_sub(sc->mpq_1, sc->mpq_2, sc->mpq_1);
+	  return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+	case T_REAL:
+	  if (is_NaN(real(y))) return(y);
+	  mpfr_set_z(sc->mpfr_1, big_integer(x), MPFR_RNDN);
+	  mpfr_sub_d(sc->mpfr_1, sc->mpfr_1, real(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_COMPLEX:
+	  mpc_set_d_d(sc->mpc_1, real_part(y), imag_part(y), MPC_RNDNN);
+	  mpc_set_z(sc->mpc_2, big_integer(x), MPC_RNDNN);
+	  mpc_sub(sc->mpc_1, sc->mpc_2, sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_INTEGER:
+	  mpz_sub(sc->mpz_1, big_integer(x), big_integer(y));
+	  return(mpz_to_integer(sc, sc->mpz_1));
+	case T_BIG_RATIO:
+	  mpq_set_z(sc->mpq_1, big_integer(x));
+	  mpq_sub(sc->mpq_1, sc->mpq_1, big_ratio(y));
+	  return(mpq_to_rational(sc, sc->mpq_1));
+	case T_BIG_REAL:
+	  mpfr_set_z(sc->mpfr_1, big_integer(x), MPFR_RNDN);
+	  mpfr_sub(sc->mpfr_1, sc->mpfr_1, big_real(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  mpc_set_z(sc->mpc_1, big_integer(x), MPC_RNDNN);
+	  mpc_sub(sc->mpc_1, sc->mpc_1, big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->subtract_symbol, x, y, a_number_string, 2));
+	}
+
+    case T_BIG_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  mpq_set_si(sc->mpq_1, integer(y), 1);
+	  mpq_sub(sc->mpq_1, big_ratio(x), sc->mpq_1);
+	  return(mpq_to_rational(sc, sc->mpq_1));
+	case T_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  mpq_sub(sc->mpq_1, big_ratio(x), sc->mpq_1);
+	  return(mpq_to_rational(sc, sc->mpq_1));
+	case T_REAL:
+	  if (is_NaN(real(y))) return(y);
+	  mpfr_set_q(sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+	  mpfr_sub_d(sc->mpfr_1, sc->mpfr_1, real(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_COMPLEX:
+	  mpc_set_q(sc->mpc_1, big_ratio(x), MPC_RNDNN);
+	  mpc_set_d_d(sc->mpc_2, real_part(y), imag_part(y), MPC_RNDNN);
+	  mpc_sub(sc->mpc_1, sc->mpc_1, sc->mpc_2, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_INTEGER:
+	  mpq_set_z(sc->mpq_1, big_integer(y));
+	  mpq_sub(sc->mpq_1, big_ratio(x), sc->mpq_1);
+	  return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+	case T_BIG_RATIO:
+	  mpq_sub(sc->mpq_1, big_ratio(x), big_ratio(y));
+	  return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+	case T_BIG_REAL:
+	  mpfr_set_q(sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+	  mpfr_sub(sc->mpfr_1, sc->mpfr_1, big_real(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  mpc_set_q(sc->mpc_1, big_ratio(x), MPC_RNDNN);
+	  mpc_sub(sc->mpc_1, sc->mpc_1, big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->subtract_symbol, x, y, a_number_string, 2));
+	}
+
+    case T_BIG_REAL:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  mpfr_sub_si(sc->mpfr_1, big_real(x), integer(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  mpfr_sub_q(sc->mpfr_1, big_real(x), sc->mpq_1, MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_REAL:
+	  if (is_NaN(real(y))) return(y);
+	  mpfr_sub_d(sc->mpfr_1, big_real(x), real(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_COMPLEX:
+	  mpc_set_d_d(sc->mpc_1, real_part(y), imag_part(y), MPC_RNDNN);
+	  mpc_fr_sub(sc->mpc_1, big_real(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_INTEGER:
+	  mpfr_sub_z(sc->mpfr_1, big_real(x), big_integer(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_RATIO:
+	  mpfr_sub_q(sc->mpfr_1, big_real(x), big_ratio(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_REAL:
+	  mpfr_sub(sc->mpfr_1, big_real(x), big_real(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  mpc_fr_sub(sc->mpc_1, big_real(x), big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->subtract_symbol, x, y, a_number_string, 2));
+	}
+    case T_BIG_COMPLEX:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  mpc_set_si(sc->mpc_2, integer(y), MPC_RNDNN);
+	  mpc_sub(sc->mpc_1, big_complex(x), sc->mpc_2, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  mpc_set_q(sc->mpc_1, sc->mpq_1, MPC_RNDNN);
+	  mpc_sub(sc->mpc_1, big_complex(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_REAL:
+	  /* if (is_NaN(real(y))) return(y); */
+	  mpc_set_d_d(sc->mpc_1, real(y), 0.0, MPC_RNDNN);
+	  mpc_sub(sc->mpc_1, big_complex(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_COMPLEX:
+	  mpc_set_d_d(sc->mpc_1, real_part(y), imag_part(y), MPC_RNDNN);
+	  mpc_sub(sc->mpc_1, big_complex(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_INTEGER:
+	  mpc_set_z(sc->mpc_1, big_integer(y), MPC_RNDNN);
+	  mpc_sub(sc->mpc_1, big_complex(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_RATIO:
+	  mpc_set_q(sc->mpc_1, big_ratio(y), MPC_RNDNN);
+	  mpc_sub(sc->mpc_1, big_complex(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_REAL:
+	  mpc_sub_fr(sc->mpc_1, big_complex(x), big_real(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_COMPLEX:
+	  mpc_sub(sc->mpc_1, big_complex(x), big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->subtract_symbol, x, y, a_number_string, 2));
+	}
+#endif
+      default:
+	return(method_or_bust_pp(sc, x, sc->subtract_symbol, x, y, a_number_string, 1));
+    }
+}
+
+static s7_pointer g_subtract(s7_scheme *sc, s7_pointer args)
+{
+  #define H_subtract "(- x1 ...) subtracts its trailing arguments from the first, or negates the first if only one it is given"
+  #define Q_subtract sc->pcl_n
+
+  s7_pointer x = car(args), p = cdr(args);
+  if (is_null(p))
+    return(negate_p_p(sc, x));
+  for (sc->error_argnum = 0; is_pair(p); p = cdr(p), sc->error_argnum++)
+    x = subtract_p_pp(sc, x, car(p));
+  sc->error_argnum = 0;
+  return(x);
+}
+
+static s7_pointer g_subtract_1(s7_scheme *sc, s7_pointer args) {return(negate_p_p(sc, car(args)));}
+static s7_pointer g_subtract_2(s7_scheme *sc, s7_pointer args) {return(subtract_p_pp(sc, car(args), cadr(args)));}
+
+static s7_pointer g_subtract_3(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer x = car(args);
+  x = subtract_p_pp(sc, x, cadr(args));
+  sc->error_argnum = 1;
+  x = subtract_p_pp(sc, x, caddr(args));
+  sc->error_argnum = 0;
+  return(x);
+}
+
+static s7_pointer minus_c1(s7_scheme *sc, s7_pointer x)
+{
+  switch (type(x))
+    {
+    case T_INTEGER: return(subtract_if_overflow_to_real_or_big_integer(sc, integer(x), 1));
+    case T_RATIO:   return(subtract_p_pp(sc, x, int_one));
+    case T_REAL:    return(make_real(sc, real(x) - 1.0));
+    case T_COMPLEX: return(make_complex_not_0i(sc, real_part(x) - 1.0, imag_part(x)));
+#if WITH_GMP
+    case T_BIG_INTEGER: case T_BIG_RATIO: case T_BIG_REAL: case T_BIG_COMPLEX:
+      return(subtract_p_pp(sc, x, int_one));
+#endif
+    default:
+      return(method_or_bust_pp(sc, x, sc->subtract_symbol, x, int_one, a_number_string, 1));
+    }
+  return(x);
+}
+
+static s7_pointer g_subtract_x1(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer p = car(args);
+#if WITH_GMP
+  return(subtract_p_pp(sc, p, int_one));
+#endif
+  /* return((is_t_integer(p)) ? make_integer(sc, integer(p) - 1) : minus_c1(sc, p)); */
+  return((is_t_integer(p)) ? subtract_if_overflow_to_real_or_big_integer(sc, integer(p), 1) : minus_c1(sc, p));
+}
+
+static s7_pointer g_subtract_2f(s7_scheme *sc, s7_pointer args) /* (- x f) */
+{
+  s7_pointer x = car(args);
+  s7_double n = real(cadr(args)); /* checked below is_t_real */
+  if (is_t_real(x)) return(make_real(sc, real(x) - n));
+  switch (type(x))
+    {
+    case T_INTEGER: return(make_real(sc, integer(x) - n));
+    case T_RATIO:   return(make_real(sc, fraction(x) - n));
+    case T_COMPLEX: return(make_complex_not_0i(sc, real_part(x) - n, imag_part(x)));
+#if WITH_GMP
+    case T_BIG_INTEGER: case T_BIG_RATIO: case T_BIG_REAL: case T_BIG_COMPLEX:
+      return(subtract_p_pp(sc, x, cadr(args)));
+#endif
+    default:
+      return(method_or_bust(sc, x, sc->subtract_symbol, args, a_number_string, 1));
+    }
+  return(x);
+}
+
+static s7_pointer g_subtract_f2(s7_scheme *sc, s7_pointer args) /* (- f x) */
+{
+  s7_pointer x = cadr(args);
+  s7_double n = real(car(args)); /* checked below is_t_real */
+
+  if (is_t_real(x)) return(make_real(sc, n - real(x)));
+  switch (type(x))
+    {
+    case T_INTEGER: return(make_real(sc, n - integer(x)));
+    case T_RATIO:   return(make_real(sc, n - fraction(x)));
+    case T_COMPLEX: return(make_complex_not_0i(sc, n - real_part(x), -imag_part(x)));
+#if WITH_GMP
+    case T_BIG_INTEGER: case T_BIG_RATIO: case T_BIG_REAL: case T_BIG_COMPLEX:
+      return(subtract_p_pp(sc, car(args), x));
+#endif
+    default:
+      return(method_or_bust(sc, x, sc->subtract_symbol, args, a_number_string, 1));
+    }
+  return(x);
+}
+
+static s7_int subtract_i_ii(s7_int i1, s7_int i2) {return(i1 - i2);}
+static s7_int subtract_i_i(s7_int x) {return(-x);}
+static s7_int subtract_i_iii(s7_int i1, s7_int i2, s7_int i3) {return(i1 - i2 - i3);}
+
+static s7_double subtract_d_d(s7_double x) {return(-x);}
+static s7_double subtract_d_dd(s7_double x1, s7_double x2) {return(x1 - x2);}
+static s7_double subtract_d_id(s7_int x1, s7_double x2) {return(x1 - x2);}
+static s7_double subtract_d_ddd(s7_double x1, s7_double x2, s7_double x3) {return(x1 - x2 - x3);}
+static s7_double subtract_d_dddd(s7_double x1, s7_double x2, s7_double x3, s7_double x4) {return(x1 - x2 - x3 - x4);}
+
+static s7_pointer subtract_p_dd(s7_scheme *sc, s7_double x1, s7_double x2) {return(make_real(sc, x1 - x2));}
+static s7_pointer subtract_p_ii(s7_scheme *sc, s7_int i1, s7_int i2) {return(make_integer(sc, i1 - i2));}
+
+static s7_pointer g_sub_xi(s7_scheme *sc, s7_pointer x, s7_int y)
+{
+  if (is_t_integer(x))
+    return(subtract_if_overflow_to_real_or_big_integer(sc, integer(x), y));
+
+  switch (type(x))
+    {
+    case T_RATIO:   return(make_ratio(sc, numerator(x) - (y * denominator(x)), denominator(x)));
+    case T_REAL:    return(make_real(sc, real(x) - y));
+    case T_COMPLEX: return(make_complex_not_0i(sc, real_part(x) - y, imag_part(x)));
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpz_set_si(sc->mpz_1, y);
+      mpz_sub(sc->mpz_1, big_integer(x), sc->mpz_1);
+      return(mpz_to_integer(sc, sc->mpz_1));
+    case T_BIG_RATIO:
+    case T_BIG_REAL:
+    case T_BIG_COMPLEX:
+      return(subtract_p_pp(sc, x, wrap_integer(sc, y)));
+#endif
+    default: return(method_or_bust_with_type_pi(sc, x, sc->subtract_symbol, x, y, a_number_string, 1));
+    }
+  return(x);
+}
+
+static s7_pointer subtract_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  s7_pointer arg1, arg2;
+  if (args == 1) return(sc->subtract_1);
+  if (args != 2) return((args == 3) ? sc->subtract_3 : f);
+  arg1 = cadr(expr);
+  arg2 = caddr(expr);
+  if (arg2 == int_one) return(sc->subtract_x1);
+  if (is_t_real(arg1)) return(sc->subtract_f2);
+  if (is_t_real(arg2)) return(sc->subtract_2f);
+  return(sc->subtract_2);
+}
+
+
+/* ---------------------------------------- multiply ---------------------------------------- */
+#define QUOTIENT_FLOAT_LIMIT 1e13
+#define QUOTIENT_INT_LIMIT 10000000000000
+/* fraction(x) is not accurate enough if it involves numbers over e18 even when done with long_doubles */
+
+static inline s7_pointer multiply_if_overflow_to_real_or_big_integer(s7_scheme *sc, s7_int x, s7_int y)
+{
+#if HAVE_OVERFLOW_CHECKS
+  s7_int val;
+  if (multiply_overflow(x, y, &val))
+#if WITH_GMP
+    {
+      mpz_set_si(sc->mpz_1, x);
+      mpz_mul_si(sc->mpz_1, sc->mpz_1, y);
+      return(mpz_to_big_integer(sc, sc->mpz_1));
+    }
+#else
+    {
+      if (WITH_WARNINGS) s7_warn(sc, 128, "integer multiply overflow: (* %" ld64 " %" ld64 ")\n", x, y);
+      return(make_real(sc, (s7_double)x * (s7_double)y));
+    }
+#endif
+    return(make_integer(sc, val));
+#else
+  return(make_integer(sc, x * y));
+#endif
+}
+
+static s7_pointer integer_ratio_multiply_if_overflow_to_real_or_ratio(s7_scheme *sc, s7_int x, s7_pointer y)
+{
+#if HAVE_OVERFLOW_CHECKS
+  s7_int z;
+  if (multiply_overflow(x, numerator(y), &z))
+#if WITH_GMP
+    {
+      mpz_set_si(sc->mpz_1, x);
+      mpz_mul_si(sc->mpz_1, sc->mpz_1, numerator(y));
+      mpq_set_si(sc->mpq_1, 1, denominator(y));
+      mpq_set_num(sc->mpq_1, sc->mpz_1);
+      return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+    }
+#else
+    {
+      if (WITH_WARNINGS) s7_warn(sc, 128, "integer * ratio overflow: (* %" ld64 " %" ld64 "/%" ld64 ")\n", x, numerator(y), denominator(y));
+      return(make_real(sc, (s7_double)x * fraction(y)));
+    }
+#endif
+    return(make_ratio(sc, z, denominator(y)));
+#else
+  return(make_ratio(sc, x * numerator(y), denominator(y)));
+#endif
+}
+
+static s7_pointer multiply_p_pp(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  switch (type(x))
+    {
+    case T_INTEGER:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(multiply_if_overflow_to_real_or_big_integer(sc, integer(x), integer(y)));
+	case T_RATIO:
+	  return(integer_ratio_multiply_if_overflow_to_real_or_ratio(sc, integer(x), y));
+	case T_REAL:
+#if WITH_GMP
+	  if (s7_int_abs(integer(x)) > QUOTIENT_INT_LIMIT)
+	    {
+	      mpfr_set_si(sc->mpfr_1, integer(x), MPFR_RNDN);
+	      mpfr_set_d(sc->mpfr_2, real(y), MPFR_RNDN);
+	      mpfr_mul(sc->mpfr_1, sc->mpfr_1, sc->mpfr_2, MPFR_RNDN);
+	      return(mpfr_to_big_real(sc, sc->mpfr_1));
+	    }
+#endif
+	  return(make_real(sc, (long_double)integer(x) * real(y)));
+	case T_COMPLEX:
+	  return(make_complex(sc, (long_double)integer(x) * real_part(y), (long_double)integer(x) * imag_part(y)));
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  mpz_mul_si(sc->mpz_1, big_integer(y), integer(x));
+	  return(mpz_to_integer(sc, sc->mpz_1));
+	case T_BIG_RATIO:
+	  mpq_set_si(sc->mpq_1, integer(x), 1);
+	  mpq_mul(sc->mpq_1, sc->mpq_1, big_ratio(y));
+	  return(mpq_to_rational(sc, sc->mpq_1));
+	case T_BIG_REAL:
+	  mpfr_mul_si(sc->mpfr_1, big_real(y), integer(x), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  mpc_mul_si(sc->mpc_1, big_complex(y), integer(x), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1)); /* x might be 0 */
+#endif
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->multiply_symbol, x, y, a_number_string, 2));
+	}
+
+    case T_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(integer_ratio_multiply_if_overflow_to_real_or_ratio(sc, integer(y), x));
+	case T_RATIO:
+	  {
+	    s7_int d1, d2, n1, n2;
+	    parcel_out_fractions(x, y);
+#if HAVE_OVERFLOW_CHECKS
+	    {
+	      s7_int n1n2, d1d2;
+	      if ((multiply_overflow(d1, d2, &d1d2)) ||
+		  (multiply_overflow(n1, n2, &n1n2)))
+#if WITH_GMP
+		{
+		  mpq_set_si(sc->mpq_1, n1, d1);
+		  mpq_set_si(sc->mpq_2, n2, d2);
+		  mpq_mul(sc->mpq_1, sc->mpq_1, sc->mpq_2);
+		  return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+		}
+#else
+	        {
+		  if (WITH_WARNINGS) s7_warn(sc, 128, "ratio * ratio overflow: (* %" ld64 "/%" ld64 " %" ld64 "/%" ld64 ")\n", n1, d1, n2, d2);
+		  return(make_real(sc, fraction(x) * fraction(y)));
+		}
+#endif
+	      return(make_ratio_with_div_check(sc, sc->multiply_symbol, n1n2, d1d2));
+	    }
+#else
+	    return(make_ratio_with_div_check(sc, sc->multiply_symbol, n1 * n2, d1 * d2));
+#endif
+	  }
+	case T_REAL:
+#if WITH_GMP
+	  if (numerator(x) > QUOTIENT_INT_LIMIT)
+	    {
+	      mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	      mpfr_set_q(sc->mpfr_1, sc->mpq_1, MPFR_RNDN);
+	      mpfr_mul_d(sc->mpfr_1, sc->mpfr_1, real(y), MPFR_RNDN);
+	      return(mpfr_to_big_real(sc, sc->mpfr_1));
+	    }
+#endif
+	  return(make_real(sc, fraction(x) * real(y)));
+	case T_COMPLEX:
+	  return(make_complex(sc, fraction(x) * real_part(y), fraction(x) * imag_part(y)));
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  mpq_set_z(sc->mpq_2, big_integer(y));
+	  mpq_mul(sc->mpq_1, sc->mpq_1, sc->mpq_2);
+	  return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+	case T_BIG_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  mpq_mul(sc->mpq_1, sc->mpq_1, big_ratio(y));
+	  return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+	case T_BIG_REAL:
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  mpfr_mul_q(sc->mpfr_1, big_real(y), sc->mpq_1, MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  mpc_set_q(sc->mpc_1, sc->mpq_1, MPC_RNDNN);
+	  mpc_mul(sc->mpc_1, sc->mpc_1, big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+#endif
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->multiply_symbol, x, y, a_number_string, 2));
+	}
+
+    case T_REAL:
+      switch (type(y))
+	{
+	case T_INTEGER:
+#if WITH_GMP
+	  if (s7_int_abs(integer(y)) > QUOTIENT_INT_LIMIT)
+	    {
+	      mpfr_set_si(sc->mpfr_1, integer(y), MPFR_RNDN);
+	      mpfr_set_d(sc->mpfr_2, real(x), MPFR_RNDN);
+	      mpfr_mul(sc->mpfr_1, sc->mpfr_1, sc->mpfr_2, MPFR_RNDN);
+	      return(mpfr_to_big_real(sc, sc->mpfr_1));
+	    }
+#endif
+	  return(make_real(sc, real(x) * (long_double)integer(y)));
+	case T_RATIO:
+#if WITH_GMP
+	  if (numerator(y) > QUOTIENT_INT_LIMIT)
+	    {
+	      mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	      mpfr_set_q(sc->mpfr_1, sc->mpq_1, MPFR_RNDN);
+	      mpfr_mul_d(sc->mpfr_1, sc->mpfr_1, real(x), MPFR_RNDN);
+	      return(mpfr_to_big_real(sc, sc->mpfr_1));
+	    }
+#endif
+	  return(make_real(sc, fraction(y) * real(x)));
+	case T_REAL:
+	  return(make_real(sc, real(x) * real(y)));
+	case T_COMPLEX:
+	  return(make_complex(sc, real(x) * real_part(y), real(x) * imag_part(y)));
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	  mpfr_mul_z(sc->mpfr_1, sc->mpfr_1, big_integer(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_RATIO:
+	  mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	  mpfr_mul_q(sc->mpfr_1, sc->mpfr_1, big_ratio(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_REAL:
+	  mpfr_mul_d(sc->mpfr_1, big_real(y), real(x), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  mpc_set_d_d(sc->mpc_1, real(x), 0.0, MPC_RNDNN);
+	  mpc_mul(sc->mpc_1, sc->mpc_1, big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1)); /* x might = 0.0 */
+#endif
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->multiply_symbol, x, y, a_number_string, 2));
+	}
+
+    case T_COMPLEX:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(make_complex(sc, real_part(x) * integer(y), imag_part(x) * integer(y)));
+	case T_RATIO:
+	  return(make_complex(sc, real_part(x) * fraction(y), imag_part(x) * fraction(y)));
+	case T_REAL:
+	  return(make_complex(sc, real_part(x) * real(y), imag_part(x) * real(y)));
+	case T_COMPLEX:
+	  {
+	    s7_double r1 = real_part(x), r2 = real_part(y), i1 = imag_part(x), i2 = imag_part(y);
+	    return(make_complex(sc, r1 * r2 - i1 * i2, r1 * i2 + r2 * i1));
+	  }
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  mpc_set_d_d(sc->mpc_1, real_part(x), imag_part(x), MPC_RNDNN);
+	  mpc_set_z(sc->mpc_2, big_integer(y), MPC_RNDNN);
+	  mpc_mul(sc->mpc_1, sc->mpc_1, sc->mpc_2, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_RATIO:
+	  mpc_set_d_d(sc->mpc_1, real_part(x), imag_part(x), MPC_RNDNN);
+	  mpc_set_q(sc->mpc_2, big_ratio(y), MPC_RNDNN);
+	  mpc_mul(sc->mpc_1, sc->mpc_1, sc->mpc_2, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_REAL:
+	  mpc_set_d_d(sc->mpc_1, real_part(x), imag_part(x), MPC_RNDNN);
+	  mpc_mul_fr(sc->mpc_1, sc->mpc_1, big_real(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_COMPLEX:
+	  mpc_set_d_d(sc->mpc_1, real_part(x), imag_part(x), MPC_RNDNN);
+	  mpc_mul(sc->mpc_1, sc->mpc_1, big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+#endif
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->multiply_symbol, x, y, a_number_string, 2));
+	}
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  mpz_mul_si(sc->mpz_1, big_integer(x), integer(y));
+	  return(mpz_to_integer(sc, sc->mpz_1));
+	case T_RATIO:
+	  mpq_set_z(sc->mpq_2, big_integer(x));
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  mpq_mul(sc->mpq_1, sc->mpq_2, sc->mpq_1);
+	  return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+	case T_REAL:
+	  if (is_NaN(real(y))) return(y);
+	  mpfr_set_d(sc->mpfr_1, real(y), MPFR_RNDN);
+	  mpfr_mul_z(sc->mpfr_1, sc->mpfr_1, big_integer(x), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_COMPLEX:
+	  mpc_set_d_d(sc->mpc_1, real_part(y), imag_part(y), MPC_RNDNN);
+	  mpc_set_z(sc->mpc_2, big_integer(x), MPC_RNDNN);
+	  mpc_mul(sc->mpc_1, sc->mpc_2, sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_INTEGER:
+	  mpz_mul(sc->mpz_1, big_integer(x), big_integer(y));
+	  return(mpz_to_integer(sc, sc->mpz_1));
+	case T_BIG_RATIO:
+	  mpq_set_z(sc->mpq_1, big_integer(x));
+	  mpq_mul(sc->mpq_1, sc->mpq_1, big_ratio(y));
+	  return(mpq_to_rational(sc, sc->mpq_1));
+	case T_BIG_REAL:
+	  mpfr_mul_z(sc->mpfr_1, big_real(y), big_integer(x), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  mpc_set_z(sc->mpc_1, big_integer(x), MPC_RNDNN);
+	  mpc_mul(sc->mpc_1, sc->mpc_1, big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->multiply_symbol, x, y, a_number_string, 2));
+	}
+
+    case T_BIG_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  mpq_set_si(sc->mpq_1, integer(y), 1);
+	  mpq_mul(sc->mpq_1, big_ratio(x), sc->mpq_1);
+	  return(mpq_to_rational(sc, sc->mpq_1));
+	case T_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  mpq_mul(sc->mpq_1, big_ratio(x), sc->mpq_1);
+	  return(mpq_to_rational(sc, sc->mpq_1));
+	case T_REAL:
+	  if (is_NaN(real(y))) return(y);
+	  mpfr_set_d(sc->mpfr_1, real(y), MPFR_RNDN);
+	  mpfr_mul_q(sc->mpfr_1, sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_COMPLEX:
+	  mpc_set_q(sc->mpc_1, big_ratio(x), MPC_RNDNN);
+	  mpc_set_d_d(sc->mpc_2, real_part(y), imag_part(y), MPC_RNDNN);
+	  mpc_mul(sc->mpc_1, sc->mpc_1, sc->mpc_2, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_INTEGER:
+	  mpq_set_z(sc->mpq_1, big_integer(y));
+	  mpq_mul(sc->mpq_1, big_ratio(x), sc->mpq_1);
+	  return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+	case T_BIG_RATIO:
+	  mpq_mul(sc->mpq_1, big_ratio(x), big_ratio(y));
+	  return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+	case T_BIG_REAL:
+	  mpfr_mul_q(sc->mpfr_1, big_real(y), big_ratio(x), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  mpc_set_q(sc->mpc_1, big_ratio(x), MPC_RNDNN);
+	  mpc_mul(sc->mpc_1, sc->mpc_1, big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->multiply_symbol, x, y, a_number_string, 2));
+	}
+
+    case T_BIG_REAL:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  mpfr_mul_si(sc->mpfr_1, big_real(x), integer(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  mpfr_mul_q(sc->mpfr_1, big_real(x), sc->mpq_1, MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_REAL:
+	  if (is_NaN(real(y))) return(y);
+	  mpfr_mul_d(sc->mpfr_1, big_real(x), real(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_COMPLEX:
+	  mpc_set_d_d(sc->mpc_1, real_part(y), imag_part(y), MPC_RNDNN);
+	  mpc_mul_fr(sc->mpc_1, sc->mpc_1, big_real(x), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_INTEGER:
+	  mpfr_mul_z(sc->mpfr_1, big_real(x), big_integer(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_RATIO:
+	  mpfr_mul_q(sc->mpfr_1, big_real(x), big_ratio(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_REAL:
+	  mpfr_mul(sc->mpfr_1, big_real(x), big_real(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  mpc_mul_fr(sc->mpc_1, big_complex(y), big_real(x), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1)); /* 0.0? */
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->multiply_symbol, x, y, a_number_string, 2));
+	}
+    case T_BIG_COMPLEX:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  mpc_mul_si(sc->mpc_1, big_complex(x), integer(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  mpc_set_q(sc->mpc_1, sc->mpq_1, MPC_RNDNN);
+	  mpc_mul(sc->mpc_1, big_complex(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_REAL:
+	  /* if (is_NaN(real(y))) return(y); */
+	  mpc_set_d_d(sc->mpc_1, real(y), 0.0, MPC_RNDNN);
+	  mpc_mul(sc->mpc_1, big_complex(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_COMPLEX:
+	  mpc_set_d_d(sc->mpc_1, real_part(y), imag_part(y), MPC_RNDNN);
+	  mpc_mul(sc->mpc_1, big_complex(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_INTEGER:
+	  mpc_set_z(sc->mpc_1, big_integer(y), MPC_RNDNN);
+	  mpc_mul(sc->mpc_1, big_complex(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_RATIO:
+	  mpc_set_q(sc->mpc_1, big_ratio(y), MPC_RNDNN);
+	  mpc_mul(sc->mpc_1, big_complex(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_REAL:
+	  mpc_mul_fr(sc->mpc_1, big_complex(x), big_real(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_COMPLEX:
+	  mpc_mul(sc->mpc_1, big_complex(x), big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->multiply_symbol, x, y, a_number_string, 2));
+	}
+#endif
+      default:
+	return(method_or_bust_pp(sc, x, sc->multiply_symbol, x, y, a_number_string, 1));
+    }
+}
+
+static s7_pointer multiply_p_ppp(s7_scheme *sc, s7_pointer x, s7_pointer y, s7_pointer z)
+{
+  /* no hits for reals in tnum */
+  /* if ((is_t_real(x)) && (is_t_real(y)) && (is_t_real(z))) return(make_real(sc, real(x) * real(y) * real(z))); */
+  x = multiply_p_pp(sc, x, y);
+  sc->error_argnum = 1;
+  x = multiply_p_pp(sc, x, z);
+  sc->error_argnum = 0;
+  return(x);
+}
+
+static s7_pointer multiply_method_or_bust(s7_scheme *sc, s7_pointer obj, s7_pointer args, s7_pointer typ, int32_t num)
+{
+  if (has_active_methods(sc, obj))
+    return(find_and_apply_method(sc, obj, sc->multiply_symbol, args));
+  if (num == 0)
+    sole_arg_wrong_type_error_nr(sc, sc->multiply_symbol, obj, typ);
+  wrong_type_error_nr(sc, sc->multiply_symbol, num, obj, typ);
+  return(NULL);
+}
+
+static s7_pointer g_multiply(s7_scheme *sc, s7_pointer args)
+{
+  #define H_multiply "(* ...) multiplies its arguments"
+  #define Q_multiply sc->pcl_n
+
+  s7_pointer x, p;
+  if (is_null(args))
+    return(int_one);
+  x = car(args);
+  p = cdr(args);
+  if (is_null(p))
+    {
+      if (!is_number(x))
+	return(multiply_method_or_bust(sc, x, args, a_number_string, 0));
+      return(x);
+    }
+  for (sc->error_argnum = 0; is_pair(p); p = cdr(p), sc->error_argnum++)
+    x = multiply_p_pp(sc, x, car(p));
+  sc->error_argnum = 0;
+  return(x);
+}
+
+static s7_pointer g_multiply_2(s7_scheme *sc, s7_pointer args) {return(multiply_p_pp(sc, car(args), cadr(args)));}
+
+static s7_pointer g_mul_xi(s7_scheme *sc, s7_pointer x, s7_int n, int32_t loc)
+{
+  switch (type(x))
+    {
+    case T_INTEGER: return(multiply_if_overflow_to_real_or_big_integer(sc, integer(x), n));
+    case T_RATIO:   return(integer_ratio_multiply_if_overflow_to_real_or_ratio(sc, n, x));
+    case T_REAL:    return(make_real(sc, real(x) * n));
+    case T_COMPLEX: return(make_complex(sc, real_part(x) * n, imag_part(x) * n));
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpz_mul_si(sc->mpz_1, big_integer(x), n);
+      return(mpz_to_integer(sc, sc->mpz_1));
+    case T_BIG_RATIO:
+    case T_BIG_REAL:
+    case T_BIG_COMPLEX:
+      return(multiply_p_pp(sc, x, wrap_integer(sc, n)));
+#endif
+    default:
+      /* we can get here from mul_2_xi for example so the non-integer argument might not be a symbol */
+      return(method_or_bust_with_type_pi(sc, x, sc->multiply_symbol, x, n, a_number_string, loc));
+    }
+  return(x);
+}
+
+static s7_pointer multiply_p_pi(s7_scheme *sc, s7_pointer p1, s7_int i1) {return(g_mul_xi(sc, p1, i1, 1));}
+
+static s7_pointer g_mul_xf(s7_scheme *sc, s7_pointer x, s7_double y, int32_t num)
+{
+  /* it's possible to return different argument NaNs depending on the expression or how it is wrapped:
+   *   (* (bignum +nan.0) +nan.123) -> nan.123
+   *   (let () (define (func) (* (bignum +nan.0) +nan.123)) (func) (func)) -> nan.0
+   * latter call is fx_c_aaa->fx_c_ac->g_mul_xf (if +nan.122 instead of +nan.0, we get +nan.122 so we always get one of the NaNs)
+   */
+  switch (type(x))
+    {
+    case T_INTEGER: return(make_real(sc, integer(x) * y));
+    case T_RATIO:   return(make_real(sc, numerator(x) * y / denominator(x)));
+    case T_REAL:    return(make_real(sc, real(x) * y));
+    case T_COMPLEX: return(make_complex(sc, real_part(x) * y, imag_part(x) * y));
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpfr_set_d(sc->mpfr_1, y, MPFR_RNDN);
+      mpfr_mul_z(sc->mpfr_1, sc->mpfr_1, big_integer(x), MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_RATIO:
+      mpfr_set_d(sc->mpfr_1, y, MPFR_RNDN);
+      mpfr_mul_q(sc->mpfr_1, sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_REAL:
+      mpfr_mul_d(sc->mpfr_1, big_real(x), y, MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_COMPLEX:
+      mpfr_set_d(sc->mpfr_1, y, MPFR_RNDN);
+      mpc_mul_fr(sc->mpc_1, big_complex(x), sc->mpfr_1, MPC_RNDNN);
+      return(mpc_to_number(sc, sc->mpc_1));
+#endif
+    default: return(method_or_bust_with_type_pf(sc, x, sc->multiply_symbol, x, y, a_number_string, num));
+    }
+  return(x);
+}
+
+#if WITH_GMP
+static s7_pointer g_mul_2_if(s7_scheme *sc, s7_pointer args) {
+  if ((is_t_integer(car(args))) && (is_t_real(cadr(args))))
+    return(make_real(sc, integer(car(args)) * real(cadr(args))));
+  return(multiply_p_pp(sc, car(args), cadr(args)));
+}
+
+static s7_pointer g_mul_2_fi(s7_scheme *sc, s7_pointer args)
+{
+  if ((is_t_integer(cadr(args))) && (is_t_real(car(args))))
+    return(make_real(sc, real(car(args)) * integer(cadr(args))));
+  return(multiply_p_pp(sc, car(args), cadr(args)));
+}
+
+static s7_pointer g_mul_2_xi(s7_scheme *sc, s7_pointer args) {if (is_t_integer(cadr(args))) return(g_mul_xi(sc, car(args), integer(cadr(args)), 1)); return(g_multiply(sc, args));}
+static s7_pointer g_mul_2_ix(s7_scheme *sc, s7_pointer args) {if (is_t_integer(car(args))) return(g_mul_xi(sc, cadr(args), integer(car(args)), 2)); return(g_multiply(sc, args));}
+static s7_pointer g_mul_2_xf(s7_scheme *sc, s7_pointer args) {if (is_t_real(cadr(args))) return(g_mul_xf(sc, car(args), real(cadr(args)), 1)); return(g_multiply(sc, args));}
+static s7_pointer g_mul_2_fx(s7_scheme *sc, s7_pointer args) {if (is_t_real(car(args))) return(g_mul_xf(sc, cadr(args), real(car(args)), 2)); return(g_multiply(sc, args));}
+static s7_pointer g_mul_2_ff(s7_scheme *sc, s7_pointer args) {return(multiply_p_pp(sc, car(args), cadr(args)));}
+static s7_pointer g_mul_2_ii(s7_scheme *sc, s7_pointer args) {return(multiply_p_pp(sc, car(args), cadr(args)));}
+#else
+static s7_pointer g_mul_2_if(s7_scheme *sc, s7_pointer args) {return(make_real(sc, integer(car(args)) * real(cadr(args))));}
+static s7_pointer g_mul_2_fi(s7_scheme *sc, s7_pointer args) {return(make_real(sc, real(car(args)) * integer(cadr(args))));}
+static s7_pointer g_mul_2_xi(s7_scheme *sc, s7_pointer args) {return(g_mul_xi(sc, car(args), integer(cadr(args)), 1));}
+static s7_pointer g_mul_2_ix(s7_scheme *sc, s7_pointer args) {return(g_mul_xi(sc, cadr(args), integer(car(args)), 2));}
+static s7_pointer g_mul_2_xf(s7_scheme *sc, s7_pointer args) {return(g_mul_xf(sc, car(args), real(cadr(args)), 1));} /* split out t_real is slower */
+static s7_pointer g_mul_2_fx(s7_scheme *sc, s7_pointer args) {return(g_mul_xf(sc, cadr(args), real(car(args)), 2));}
+static s7_pointer g_mul_2_ff(s7_scheme *sc, s7_pointer args) {return(make_real(sc, real(car(args)) * real(cadr(args))));}
+
+static s7_pointer g_mul_2_ii(s7_scheme *sc, s7_pointer args)
+{
+#if HAVE_OVERFLOW_CHECKS
+  s7_int val, x = integer(car(args)), y = integer(cadr(args));
+  if (multiply_overflow(x, y, &val))
+    {
+      if (WITH_WARNINGS) s7_warn(sc, 128, "integer multiply overflow: (* %" ld64 " %" ld64 ")\n", x, y);
+      return(make_real(sc, (s7_double)x * (s7_double)y));
+    }
+  return(make_integer(sc, val));
+#else
+  return(make_integer(sc, integer(car(args)) * integer(cadr(args))));
+#endif
+}
+#endif
+
+static s7_int multiply_i_ii(s7_int i1, s7_int i2)
+{
+#if HAVE_OVERFLOW_CHECKS
+  s7_int val;
+  if (multiply_overflow(i1, i2, &val))
+    {
+#if WITH_WARNINGS
+      s7_warn(cur_sc, 64, "integer multiply overflow: (* %" ld64 " %" ld64 ")\n", i1, i2);
+#endif
+      return(S7_INT64_MAX); /* this is inconsistent with other unopt cases where an overflow -> double result */
+    }
+  /* (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (even? (* (ash 1 43) (ash 1 43)))))) (define (hi) (func)) (hi)) */
+  return(val);
+#else
+  return(i1 * i2);
+#endif
+}
+
+static s7_int multiply_i_iii(s7_int i1, s7_int i2, s7_int i3)
+{
+#if HAVE_OVERFLOW_CHECKS
+  s7_int val1, val2;
+  if ((multiply_overflow(i1, i2, &val1)) ||
+      (multiply_overflow(val1, i3, &val2)))
+    {
+#if WITH_WARNINGS
+      s7_warn(cur_sc, 64, "integer multiply overflow: (* %" ld64 " %" ld64 " %" ld64 ")\n", i1, i2, i3);
+#endif
+      return(S7_INT64_MAX);
+    }
+  return(val2);
+#else
+  return(i1 * i2 * i3);
+#endif
+}
+
+static s7_double multiply_d_d(s7_double x) {return(x);}
+static s7_double multiply_d_dd(s7_double x1, s7_double x2) {return(x1 * x2);}
+static s7_double multiply_d_id(s7_int x1, s7_double x2) {return(x1 * x2);}
+static s7_double multiply_d_ddd(s7_double x1, s7_double x2, s7_double x3) {return(x1 * x2 * x3);}
+static s7_double multiply_d_dddd(s7_double x1, s7_double x2, s7_double x3, s7_double x4) {return(x1 * x2 * x3 * x4);}
+static s7_pointer mul_p_dd(s7_scheme *sc, s7_double x1, s7_double x2) {return(make_real(sc, x1 * x2));}
+
+static s7_pointer multiply_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  if (args != 2) return(f);
+  return(chooser_check_arg_types(sc, cadr(expr), caddr(expr), sc->multiply_2,
+				 sc->mul_2_ff, sc->mul_2_ii, sc->mul_2_if, sc->mul_2_fi,
+				 sc->mul_2_xi, sc->mul_2_ix, sc->mul_2_fx, sc->mul_2_xf));
+}
+
+
+/* ---------------------------------------- divide ---------------------------------------- */
+static s7_pointer complex_invert(s7_scheme *sc, s7_pointer p)
+{
+  s7_double r2 = real_part(p), i2 = imag_part(p);
+  s7_double den = (r2 * r2 + i2 * i2);
+  /* here if p is, for example, -inf.0+i, den is +inf.0 so -i2/den is -0.0 (in gcc anyway), so the imag part is 0.0 */
+  return(make_complex(sc, r2 / den, -i2 / den));
+}
+
+static s7_pointer invert_p_p(s7_scheme *sc, s7_pointer p)
+{
+#if WITH_GMP
+  s7_pointer x;
+#endif
+  switch (type(p))
+    {
+    case T_INTEGER:
+#if WITH_GMP && (!POINTER_32)
+      if (integer(p) == S7_INT64_MIN) /* (/ 1 (*s7* 'most-negative-fixnum)) -> -1/9223372036854775808 */
+	{
+	  new_cell(sc, x, T_BIG_RATIO);
+	  big_ratio_bgr(x) = alloc_bigrat(sc);
+	  add_big_ratio(sc, x);
+	  mpz_set_si(sc->mpz_1, S7_INT64_MAX);
+	  mpz_set_si(sc->mpz_2, 1);
+	  mpz_add(sc->mpz_1, sc->mpz_1, sc->mpz_2);
+	  mpq_set_si(big_ratio(x), -1, 1);
+	  mpq_set_den(big_ratio(x), sc->mpz_1); /* geez... */
+	  return(x);
+	}
+#endif
+      if (integer(p) == 0)
+	division_by_zero_error_1_nr(sc, sc->divide_symbol, p);
+      return(make_simple_ratio(sc, 1, integer(p)));  /* this checks for int */
+    case T_RATIO:
+      return(make_simple_ratio(sc, denominator(p), numerator(p)));
+    case T_REAL:
+      if (real(p) == 0.0)
+	division_by_zero_error_1_nr(sc, sc->divide_symbol, p);
+      return(make_real(sc, 1.0 / real(p)));
+    case T_COMPLEX:
+      return(complex_invert(sc, p));
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      if (mpz_cmp_ui(big_integer(p), 0) == 0)
+	division_by_zero_error_1_nr(sc, sc->divide_symbol, p);
+      if ((mpz_cmp_ui(big_integer(p), 1) == 0) || (mpz_cmp_si(big_integer(p), -1) == 0))
+	return(p);
+      new_cell(sc, x, T_BIG_RATIO);
+      big_ratio_bgr(x) = alloc_bigrat(sc);
+      add_big_ratio(sc, x);
+      mpq_set_si(big_ratio(x), 1, 1);
+      mpq_set_den(big_ratio(x), big_integer(p));
+      mpq_canonicalize(big_ratio(x));
+      return(x);
+
+    case T_BIG_RATIO:
+      if (mpz_cmp_ui(mpq_numref(big_ratio(p)), 1) == 0)
+	return(mpz_to_integer(sc, mpq_denref(big_ratio(p))));
+      if (mpz_cmp_si(mpq_numref(big_ratio(p)), -1) == 0)
+	{
+	  mpz_neg(sc->mpz_1, mpq_denref(big_ratio(p)));
+	  return(mpz_to_integer(sc, sc->mpz_1));
+	}
+      new_cell(sc, x, T_BIG_RATIO);
+      big_ratio_bgr(x) = alloc_bigrat(sc);
+      add_big_ratio(sc, x);
+      mpq_inv(big_ratio(x), big_ratio(p));
+      mpq_canonicalize(big_ratio(x));
+      return(x);
+
+    case T_BIG_REAL:
+      if (mpfr_zero_p(big_real(p)))
+	division_by_zero_error_1_nr(sc, sc->divide_symbol, p);
+      x = mpfr_to_big_real(sc, big_real(p));
+      mpfr_ui_div(big_real(x), 1, big_real(x), MPFR_RNDN);
+      return(x);
+
+    case T_BIG_COMPLEX:
+      if ((!mpfr_number_p(mpc_realref(big_complex(p)))) || (!mpfr_number_p(mpc_imagref(big_complex(p)))))
+	return(complex_NaN);
+      mpc_ui_div(sc->mpc_1, 1, big_complex(p), MPC_RNDNN);
+      return(mpc_to_number(sc, sc->mpc_1)); /* x might be 0+0i if real-part is inf? */
+#endif
+    default:
+      check_method(sc, p, sc->divide_symbol, set_plist_1(sc, p));
+      wrong_type_error_nr(sc, sc->divide_symbol, 1, p, a_number_string);
+    }
+  return(NULL);
+}
+
+static s7_pointer divide_p_pp(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  /* splitting out real/real here saves very little */
+  switch (type(x))
+    {
+    case T_INTEGER:
+      switch (type(y))
+	{
+	  /* -------- integer x -------- */
+	case T_INTEGER:
+	  if (integer(y) == 0)
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  if (integer(x) == 1)  /* mainly to handle (/ 1 -9223372036854775808) correctly! */
+	    return(invert_p_p(sc, y));
+	  return(make_ratio(sc, integer(x), integer(y)));
+
+	case T_RATIO:
+#if HAVE_OVERFLOW_CHECKS
+	  {
+	    s7_int dn;
+	    if (multiply_overflow(integer(x), denominator(y), &dn))
+#if WITH_GMP
+	      {
+		mpq_set_si(sc->mpq_1, integer(x), 1);
+		mpq_set_si(sc->mpq_2, numerator(y), denominator(y));
+		mpq_div(sc->mpq_1, sc->mpq_1, sc->mpq_2);
+		return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+	      }
+#else
+              {
+		if (WITH_WARNINGS) s7_warn(sc, 128, "integer / ratio overflow: (/ %" ld64 " %" ld64 "/%" ld64 ")\n", integer(x), numerator(y), denominator(y));
+  	        return(make_real(sc, integer(x) * inverted_fraction(y)));
+	      }
+#endif
+	    return(make_ratio_with_div_check(sc, sc->divide_symbol, dn, numerator(y)));
+	  }
+#else
+	  return(make_ratio_with_div_check(sc, sc->divide_symbol, integer(x) * denominator(y), numerator(y)));
+#endif
+
+	case T_REAL:
+	  if (is_NaN(real(y))) return(y);
+	  if (is_inf(real(y))) return(real_zero);
+	  if (real(y) == 0.0)
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+#if WITH_GMP
+	  if ((s7_int_abs(integer(x))) > QUOTIENT_INT_LIMIT)
+	    {
+	      mpfr_set_si(sc->mpfr_1, integer(x), MPFR_RNDN);
+	      mpfr_set_d(sc->mpfr_2, real(y), MPFR_RNDN);
+	      mpfr_div(sc->mpfr_1, sc->mpfr_1, sc->mpfr_2, MPFR_RNDN);
+	      return(mpfr_to_big_real(sc, sc->mpfr_1));
+	    }
+#endif
+	  return(make_real(sc, (s7_double)(integer(x)) / real(y)));
+
+	case T_COMPLEX:
+	  {
+	    s7_double den, r1 = (s7_double)integer(x), r2 = real_part(y), i2 = imag_part(y);
+	    den = 1.0 / (r2 * r2 + i2 * i2);
+	    /* we could avoid the squaring (see Knuth II p613 16), not a big deal: (/ 1.0e308+1.0e308i 2.0e308+2.0e308i) => nan, (gmp case is ok here) */
+	    return(make_complex(sc, r1 * r2 * den, -(r1 * i2 * den)));
+	  }
+
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  if (mpz_cmp_ui(big_integer(y), 0) == 0)
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpq_set_si(sc->mpq_1, integer(x), 1);
+	  mpq_set_den(sc->mpq_1, big_integer(y));
+	  return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+	case T_BIG_RATIO:
+	  mpq_set_si(sc->mpq_1, integer(x), 1);
+	  mpq_div(sc->mpq_1, sc->mpq_1, big_ratio(y));
+	  return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+	case T_BIG_REAL:
+	  if (mpfr_zero_p(big_real(y)))
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpfr_si_div(sc->mpfr_1, integer(x), big_real(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  if ((!mpfr_number_p(mpc_realref(big_complex(y)))) || (!mpfr_number_p(mpc_imagref(big_complex(y)))))
+	    return(complex_NaN);
+	  mpc_set_si(sc->mpc_1, integer(x), MPC_RNDNN);
+	  mpc_div(sc->mpc_1, sc->mpc_1, big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1)); /* x might be 0? */
+#endif
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->divide_symbol, x, y, a_number_string, 2));
+	}
+      break;
+
+      /* -------- ratio x -------- */
+    case T_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  if (integer(y) == 0)
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+#if HAVE_OVERFLOW_CHECKS
+	  {
+	    s7_int dn;
+	    if (multiply_overflow(denominator(x), integer(y), &dn))
+#if WITH_GMP
+	      {
+		mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+		mpq_set_si(sc->mpq_2, integer(y), 1);
+		mpq_div(sc->mpq_1, sc->mpq_1, sc->mpq_2);
+		return(mpq_to_rational(sc, sc->mpq_1));
+	      }
+#else
+              {
+		if (WITH_WARNINGS)
+		  s7_warn(sc, 128, "ratio / integer overflow: (/ %" ld64 "/%" ld64 " %" ld64 ")\n", numerator(x), denominator(x), integer(y));
+	        return(make_real(sc, (long_double)numerator(x) / ((long_double)denominator(x) * (long_double)integer(y))));
+	      }
+#endif
+	    return(make_ratio_with_div_check(sc, sc->divide_symbol, numerator(x), dn));
+	  }
+#else
+	  return(make_ratio_with_div_check(sc, sc->divide_symbol, numerator(x), denominator(x) * integer(y)));
+#endif
+
+	case T_RATIO:
+	  {
+	    s7_int d1, d2, n1, n2;
+	    parcel_out_fractions(x, y);
+	    if (d1 == d2)
+	      return(make_ratio_with_div_check(sc, sc->divide_symbol, n1, n2));
+#if HAVE_OVERFLOW_CHECKS
+	    if ((multiply_overflow(n1, d2, &n1)) ||
+		(multiply_overflow(n2, d1, &d1)))
+	      {
+#if WITH_GMP
+		mpq_set_si(sc->mpq_1, numerator(x), denominator(x)); /* not n1 and d1! they are garbage here */
+		mpq_set_si(sc->mpq_2, n2, d2);
+		mpq_div(sc->mpq_1, sc->mpq_1, sc->mpq_2);
+		return(mpq_to_rational(sc, sc->mpq_1));
+#else
+		s7_double r1, r2;
+		if (WITH_WARNINGS)
+		  s7_warn(sc, 128, "ratio / ratio overflow: (/ %" ld64 "/%" ld64 " %" ld64 "/%" ld64 ")\n", numerator(x), denominator(x), numerator(y), denominator(y));
+		r1 = fraction(x);
+		r2 = inverted_fraction(y);
+		return(make_real(sc, r1 * r2));
+#endif
+	      }
+	    return(make_ratio_with_div_check(sc, sc->divide_symbol, n1, d1));
+#else
+	    return(make_ratio_with_div_check(sc, sc->divide_symbol, n1 * d2, n2 * d1));
+#endif
+	  }
+
+	case T_REAL:
+	  if (real(y) == 0.0)
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  return(make_real(sc, fraction(x) / real(y)));
+
+	case T_COMPLEX:
+	  {
+	    s7_double rx = fraction(x), r2 = real_part(y), i2 = imag_part(y);
+	    s7_double den = 1.0 / (r2 * r2 + i2 * i2);
+	    return(make_complex(sc, rx * r2 * den, -rx * i2 * den)); /* not unchecked: (/ 3/4 -inf.0+i) */
+	  }
+
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  if (mpz_cmp_ui(big_integer(y), 0) == 0)
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpq_set_z(sc->mpq_1, big_integer(y));
+	  mpq_set_si(sc->mpq_2, numerator(x), denominator(x));
+	  mpq_div(sc->mpq_1, sc->mpq_2, sc->mpq_1);
+	  return(mpq_to_rational(sc, sc->mpq_1));
+	case T_BIG_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  mpq_div(sc->mpq_1, sc->mpq_1, big_ratio(y));
+	  return(mpq_to_rational(sc, sc->mpq_1));
+	case T_BIG_REAL:
+	  if (mpfr_zero_p(big_real(y)))
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  mpfr_set_q(sc->mpfr_1, sc->mpq_1, MPFR_RNDN);
+	  mpfr_div(sc->mpfr_1, sc->mpfr_1, big_real(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  if ((!mpfr_number_p(mpc_realref(big_complex(y)))) || (!mpfr_number_p(mpc_imagref(big_complex(y)))))
+	    return(complex_NaN);
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  mpc_set_q(sc->mpc_1, sc->mpq_1, MPC_RNDNN);
+	  mpc_div(sc->mpc_1, sc->mpc_1, big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+#endif
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->divide_symbol, x, y, a_number_string, 2));
+	}
+
+      /* -------- real x -------- */
+    case T_REAL:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  if (integer(y) == 0)
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  if (is_NaN(real(x))) return(x); /* what is (/ +nan.0 0)? */
+	  if (is_inf(real(x)))
+	    return((real(x) > 0.0) ? ((integer(y) > 0) ? real_infinity : real_minus_infinity) : ((integer(y) > 0) ? real_minus_infinity : real_infinity));
+	  return(make_real(sc, (long_double)real(x) / (long_double)integer(y)));
+
+	case T_RATIO:
+	  if (is_NaN(real(x))) return(x);
+	  if (is_inf(real(x)))
+	    return((real(x) > 0) ? ((numerator(y) > 0) ? real_infinity : real_minus_infinity) : ((numerator(y) > 0) ? real_minus_infinity : real_infinity));
+	  return(make_real(sc, real(x) * inverted_fraction(y)));
+
+	case T_REAL:
+	  if (is_NaN(real(y))) return(y);
+	  if (real(y) == 0.0)
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  if (is_NaN(real(x))) return(x);
+	  if (is_inf(real(y)))
+	    return((is_inf(real(x))) ? real_NaN : real_zero);
+	  return(make_real(sc, real(x) / real(y)));
+
+	case T_COMPLEX:
+	  {
+	    s7_double den, r2, i2;
+	    if (is_NaN(real(x))) return(complex_NaN);
+	    r2 = real_part(y);
+	    i2 = imag_part(y);
+	    if ((is_NaN(r2)) || (is_inf(r2))) return(complex_NaN);
+	    if ((is_NaN(i2)) || (is_inf(i2))) return(complex_NaN);
+	    den = 1.0 / (r2 * r2 + i2 * i2);
+	    return(make_complex(sc, real(x) * r2 * den, -real(x) * i2 * den));
+	  }
+
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  if (mpz_cmp_ui(big_integer(y), 0) == 0)
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpfr_set_z(sc->mpfr_1, big_integer(y), MPFR_RNDN);
+	  mpfr_d_div(sc->mpfr_1, real(x), sc->mpfr_1, MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_RATIO:
+	  mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	  mpfr_div_q(sc->mpfr_1, sc->mpfr_1, big_ratio(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_REAL:
+	  if (mpfr_zero_p(big_real(y)))
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpfr_d_div(sc->mpfr_1, real(x), big_real(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  if ((is_NaN(real(x))) || (!mpfr_number_p(mpc_realref(big_complex(y)))) || (!mpfr_number_p(mpc_imagref(big_complex(y)))))
+	    return(complex_NaN);
+	  mpc_set_d_d(sc->mpc_1, real(x), 0.0, MPC_RNDNN);
+	  mpc_div(sc->mpc_1, sc->mpc_1, big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+#endif
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->divide_symbol, x, y, a_number_string, 2));
+	}
+
+      /* -------- complex x -------- */
+    case T_COMPLEX:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  {
+	    s7_double r1;
+	    if (integer(y) == 0)
+	      division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	    r1 = (long_double)1.0 / (long_double)integer(y);
+	    return(make_complex(sc, real_part(x) * r1, imag_part(x) * r1));
+	  }
+
+	case T_RATIO:
+	  {
+	    s7_double frac = inverted_fraction(y);
+	    return(make_complex(sc, real_part(x) * frac, imag_part(x) * frac));
+	  }
+
+	case T_REAL:
+	  {
+	    s7_double r1;
+	    if (real(y) == 0.0)
+	      division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	    r1 = 1.0 / real(y);
+	    return(make_complex(sc, real_part(x) * r1, imag_part(x) * r1)); /* (/ 0.0+1.0i +inf.0) */
+	  }
+
+	case T_COMPLEX:
+	  {
+	    s7_double r1 = real_part(x), r2, i1, i2, den;
+	    if (is_NaN(r1)) return(x);
+	    i1 = imag_part(x);
+	    if (is_NaN(i1)) return(x);
+	    r2 = real_part(y);
+	    if (is_NaN(r2)) return(y);
+	    if (is_inf(r2)) return(complex_NaN);
+	    i2 = imag_part(y);
+	    if (is_NaN(i2)) return(y);
+	    den = 1.0 / (r2 * r2 + i2 * i2);
+	    return(make_complex(sc, (r1 * r2 + i1 * i2) * den, (r2 * i1 - r1 * i2) * den));
+	  }
+
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  if (mpz_cmp_ui(big_integer(y), 0) == 0)
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpc_set_d_d(sc->mpc_1, real_part(x), imag_part(x), MPC_RNDNN);
+	  mpc_set_z(sc->mpc_2, big_integer(y), MPC_RNDNN);
+	  mpc_div(sc->mpc_1, sc->mpc_1, sc->mpc_2, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_RATIO:
+	  mpc_set_d_d(sc->mpc_1, real_part(x), imag_part(x), MPC_RNDNN);
+	  mpc_set_q(sc->mpc_2, big_ratio(y), MPC_RNDNN);
+	  mpc_div(sc->mpc_1, sc->mpc_1, sc->mpc_2, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_REAL:
+	  if (mpfr_zero_p(big_real(y)))
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpc_set_d_d(sc->mpc_1, real_part(x), imag_part(x), MPC_RNDNN);
+	  mpc_div_fr(sc->mpc_1, sc->mpc_1, big_real(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_COMPLEX:
+	  if ((!mpfr_number_p(mpc_realref(big_complex(y)))) || (!mpfr_number_p(mpc_imagref(big_complex(y)))))
+	    return(complex_NaN);
+	  mpc_set_d_d(sc->mpc_1, real_part(x), imag_part(x), MPC_RNDNN);
+	  mpc_div(sc->mpc_1, sc->mpc_1, big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+#endif
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->divide_symbol, x, y, a_number_string, 2));
+	}
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  if (integer(y) == 0)
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpz_set_si(sc->mpz_1, integer(y));
+	  mpq_set_num(sc->mpq_1, big_integer(x));
+	  mpq_set_den(sc->mpq_1, sc->mpz_1);
+	  return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+	case T_RATIO:
+	  mpq_set_z(sc->mpq_2, big_integer(x));
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y)); /* can't invert here, mpq den=unsigned */
+	  mpq_div(sc->mpq_1, sc->mpq_2, sc->mpq_1);
+	  return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+	case T_REAL:
+	  if (is_NaN(real(y))) return(y);
+	  if (real(y) == 0.0)
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpfr_set_z(sc->mpfr_1, big_integer(x), MPFR_RNDN);
+	  mpfr_div_d(sc->mpfr_1, sc->mpfr_1, real(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_COMPLEX:
+	  if ((is_NaN(real_part(y))) || (is_NaN(imag_part(y))) ||
+	      (is_inf(real_part(y))) || (is_inf(imag_part(y))))
+	    return(complex_NaN);
+	  mpc_set_d_d(sc->mpc_1, real_part(y), imag_part(y), MPC_RNDNN);
+	  mpc_set_z(sc->mpc_2, big_integer(x), MPC_RNDNN);
+	  mpc_div(sc->mpc_1, sc->mpc_2, sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_INTEGER:
+	  if (mpz_cmp_ui(big_integer(y), 0) == 0)
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpq_set_num(sc->mpq_1, big_integer(x));
+	  mpq_set_den(sc->mpq_1, big_integer(y));
+	  return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+	case T_BIG_RATIO:
+	  mpq_set_si(sc->mpq_1, 0, 1);
+	  mpq_set_num(sc->mpq_1, big_integer(x));
+	  mpq_div(sc->mpq_1, sc->mpq_1, big_ratio(y));
+	  return(mpq_to_rational(sc, sc->mpq_1));
+	case T_BIG_REAL:
+	  if (mpfr_zero_p(big_real(y)))
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpfr_set_z(sc->mpfr_1, big_integer(x), MPFR_RNDN);
+	  mpfr_div(sc->mpfr_1, sc->mpfr_1, big_real(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  if ((!mpfr_number_p(mpc_realref(big_complex(y)))) || (!mpfr_number_p(mpc_imagref(big_complex(y)))))
+	    return(complex_NaN);
+	  mpc_set_z(sc->mpc_1, big_integer(x), MPC_RNDNN);
+	  mpc_div(sc->mpc_1, sc->mpc_1, big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->divide_symbol, x, y, a_number_string, 2));
+	}
+    case T_BIG_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  if (integer(y) == 0)
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpq_set_si(sc->mpq_1, integer(y), 1);
+	  mpq_div(sc->mpq_1, big_ratio(x), sc->mpq_1);
+	  return(mpq_to_rational(sc, sc->mpq_1));
+	case T_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  mpq_div(sc->mpq_1, big_ratio(x), sc->mpq_1);
+	  return(mpq_to_rational(sc, sc->mpq_1));
+	case T_REAL:
+	  if (is_NaN(real(y))) return(y);
+	  if (real(y) == 0.0)
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpfr_set_q(sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+	  mpfr_div_d(sc->mpfr_1, sc->mpfr_1, real(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_COMPLEX:
+	  if ((is_NaN(real_part(y))) || (is_NaN(imag_part(y))) ||
+	      (is_inf(real_part(y))) || (is_inf(imag_part(y))))
+	    return(complex_NaN);
+	  mpc_set_q(sc->mpc_1, big_ratio(x), MPC_RNDNN);
+	  mpc_set_d_d(sc->mpc_2, real_part(y), imag_part(y), MPC_RNDNN);
+	  mpc_div(sc->mpc_1, sc->mpc_1, sc->mpc_2, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_INTEGER:
+	  if (mpz_cmp_ui(big_integer(y), 0) == 0)
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpq_set_z(sc->mpq_1, big_integer(y));
+	  mpq_div(sc->mpq_1, big_ratio(x), sc->mpq_1);
+	  return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+	case T_BIG_RATIO:
+	  mpq_div(sc->mpq_1, big_ratio(x), big_ratio(y));
+	  return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+	case T_BIG_REAL:
+	  if (mpfr_zero_p(big_real(y)))
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpfr_set_q(sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+	  mpfr_div(sc->mpfr_1, sc->mpfr_1, big_real(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  if ((!mpfr_number_p(mpc_realref(big_complex(y)))) || (!mpfr_number_p(mpc_imagref(big_complex(y)))))
+	    return(complex_NaN);
+	  mpc_set_q(sc->mpc_1, big_ratio(x), MPC_RNDNN);
+	  mpc_div(sc->mpc_1, sc->mpc_1, big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->divide_symbol, x, y, a_number_string, 2));
+	}
+    case T_BIG_REAL:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  if (integer(y) == 0)
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpfr_div_si(sc->mpfr_1, big_real(x), integer(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  mpfr_div_q(sc->mpfr_1, big_real(x), sc->mpq_1, MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_REAL:
+	  if (is_NaN(real(y))) return(y);
+	  if (real(y) == 0.0)
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpfr_div_d(sc->mpfr_1, big_real(x), real(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_COMPLEX:
+	  if ((is_NaN(real_part(y))) || (is_NaN(imag_part(y))) ||
+	      (is_inf(real_part(y))) || (is_inf(imag_part(y))))
+	    return(complex_NaN);
+	  mpc_set_d_d(sc->mpc_1, real_part(y), imag_part(y), MPC_RNDNN);
+	  mpc_fr_div(sc->mpc_1, big_real(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_INTEGER:
+	  if (mpz_cmp_ui(big_integer(y), 0) == 0)
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpfr_div_z(sc->mpfr_1, big_real(x), big_integer(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_RATIO:
+	  mpfr_div_q(sc->mpfr_1, big_real(x), big_ratio(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_REAL:
+	  if (mpfr_zero_p(big_real(y)))
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpfr_div(sc->mpfr_1, big_real(x), big_real(y), MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	case T_BIG_COMPLEX:
+	  if ((!mpfr_number_p(mpc_realref(big_complex(y)))) || (!mpfr_number_p(mpc_imagref(big_complex(y)))))
+	    return(complex_NaN);
+	  mpc_fr_div(sc->mpc_1, big_real(x), big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->divide_symbol, x, y, a_number_string, 2));
+	}
+    case T_BIG_COMPLEX:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  if (integer(y) == 0)
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpc_set_si(sc->mpc_1, integer(y), MPC_RNDNN);
+	  mpc_div(sc->mpc_1, big_complex(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  mpc_set_q(sc->mpc_1, sc->mpq_1, MPC_RNDNN);
+	  mpc_div(sc->mpc_1, big_complex(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_REAL:
+	  /* if (is_NaN(real(y))) return(y); */
+	  if (real(y) == 0.0)
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpc_set_d_d(sc->mpc_1, real(y), 0.0, MPC_RNDNN);
+	  mpc_div(sc->mpc_1, big_complex(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_COMPLEX:
+	  if ((is_NaN(real_part(y))) || (is_NaN(imag_part(y))) ||
+	      (is_inf(real_part(y))) || (is_inf(imag_part(y))))
+	    return(complex_NaN);
+	  mpc_set_d_d(sc->mpc_1, real_part(y), imag_part(y), MPC_RNDNN);
+	  mpc_div(sc->mpc_1, big_complex(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_INTEGER:
+	  if (mpz_cmp_ui(big_integer(y), 0) == 0)
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpc_set_z(sc->mpc_1, big_integer(y), MPC_RNDNN);
+	  mpc_div(sc->mpc_1, big_complex(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_RATIO:
+	  mpc_set_q(sc->mpc_1, big_ratio(y), MPC_RNDNN);
+	  mpc_div(sc->mpc_1, big_complex(x), sc->mpc_1, MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_REAL:
+	  if (mpfr_zero_p(big_real(y)))
+	    division_by_zero_error_2_nr(sc, sc->divide_symbol, x, y);
+	  mpc_div_fr(sc->mpc_1, big_complex(x), big_real(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	case T_BIG_COMPLEX:
+	  if ((!mpfr_number_p(mpc_realref(big_complex(y)))) || (!mpfr_number_p(mpc_imagref(big_complex(y)))))
+	    return(complex_NaN);
+	  mpc_div(sc->mpc_1, big_complex(x), big_complex(y), MPC_RNDNN);
+	  return(mpc_to_number(sc, sc->mpc_1));
+	default:
+	  return(method_or_bust_with_type_and_loc_pp(sc, y, sc->divide_symbol, x, y, a_number_string, 2));
+	}
+#endif
+
+    default: /* x is not a built-in number */
+      return(method_or_bust_pp(sc, x, sc->divide_symbol, x, y, a_number_string, 1)); /* not args here! y = apply * to cdr(args) */
+    }
+  return(NULL); /* make the compiler happy */
+}
+
+static s7_pointer g_divide(s7_scheme *sc, s7_pointer args)
+{
+  #define H_divide "(/ x1 ...) divides its first argument by the rest, or inverts the first if there is only one argument"
+  #define Q_divide sc->pcl_n
+
+  s7_pointer x = car(args), p = cdr(args);
+  if (is_null(p))            /* (/ x) */
+    {
+      if (!is_number(x))
+	return(method_or_bust_p(sc, x, sc->divide_symbol, a_number_string));
+      return(invert_p_p(sc, x));
+    }
+  for (sc->error_argnum = 0; is_pair(p); p = cdr(p), sc->error_argnum++)
+    x = divide_p_pp(sc, x, car(p));
+  sc->error_argnum = 0;
+  return(x);
+}
+
+static s7_pointer g_invert_1(s7_scheme *sc, s7_pointer args) {return(invert_p_p(sc, car(args)));}
+static s7_pointer g_divide_2(s7_scheme *sc, s7_pointer args) {return(divide_p_pp(sc, car(args), cadr(args)));}
+
+static s7_pointer g_divide_by_2(s7_scheme *sc, s7_pointer args)
+{
+  /* (/ x 2) */
+  s7_pointer num = car(args);
+  if (is_t_integer(num))
+    {
+      s7_int i = integer(num);
+      if (i & 1)
+	{
+	  s7_pointer x;
+	  new_cell(sc, x, T_RATIO);
+	  set_numerator(x, i);
+	  set_denominator(x, 2);
+	  return(x);
+	}
+      return(make_integer(sc, i >> 1));
+    }
+  switch (type(num))
+    {
+    case T_RATIO:
+#if HAVE_OVERFLOW_CHECKS
+      {
+	s7_int dn;
+	if (multiply_overflow(denominator(num), 2, &dn))
+	  {
+	    if ((numerator(num) & 1) == 1)
+#if WITH_GMP
+	      {
+		mpq_set_si(sc->mpq_1, numerator(num), denominator(num));
+		mpq_set_si(sc->mpq_2, 1, 2);
+		mpq_mul(sc->mpq_1, sc->mpq_1, sc->mpq_2);
+		return(mpq_to_rational(sc, sc->mpq_1));
+	      }
+#else
+	      {
+		if (WITH_WARNINGS) s7_warn(sc, 128, "ratio / 2 overflow: (/ %" ld64 "/%" ld64 " 2)\n", numerator(num), denominator(num));
+	        return(make_real(sc, ((long_double)numerator(num) * 0.5) / (long_double)denominator(num)));
+	      }
+#endif
+	    return(make_ratio(sc, numerator(num) / 2, denominator(num)));
+	  }
+	return(make_ratio_with_div_check(sc, sc->divide_symbol, numerator(num), dn));
+      }
+#else
+      return(make_ratio(sc, numerator(num), denominator(num) * 2));
+#endif
+
+    case T_REAL:    return(make_real(sc, real(num) * 0.5));
+    case T_COMPLEX: return(make_complex_not_0i(sc, real_part(num) * 0.5, imag_part(num) * 0.5));
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpq_set_z(sc->mpq_1, big_integer(num));
+      mpz_mul_ui(mpq_denref(sc->mpq_1), mpq_denref(sc->mpq_1), 2);
+      return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+    case T_BIG_RATIO:
+      mpq_set_si(sc->mpq_1, 2, 1);
+      mpq_div(sc->mpq_1, big_ratio(num), sc->mpq_1);
+      return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+    case T_BIG_REAL:
+      mpfr_div_si(sc->mpfr_1, big_real(num), 2, MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_BIG_COMPLEX:
+      mpc_set_si(sc->mpc_1, 2, MPC_RNDNN);
+      mpc_div(sc->mpc_1, big_complex(num), sc->mpc_1, MPC_RNDNN);
+      return(mpc_to_number(sc, sc->mpc_1));
+#endif
+    default:
+      return(method_or_bust_pp(sc, num, sc->divide_symbol, num, int_two, a_number_string, 1));
+    }
+}
+
+static s7_pointer g_invert_x(s7_scheme *sc, s7_pointer args)
+{
+  /* (/ 1.0 x) */
+  s7_pointer x = cadr(args);
+  if (is_t_real(x))
+    {
+      s7_double rl = real(x);
+      if (rl == 0.0)
+	division_by_zero_error_2_nr(sc, sc->divide_symbol, car(args), x);
+      return((is_NaN(rl)) ? x : make_real(sc, 1.0 / rl));
+    }
+  return(g_divide(sc, args));
+}
+
+static s7_double divide_d_7d(s7_scheme *sc, s7_double x)
+{
+  if (x == 0.0) division_by_zero_error_1_nr(sc, sc->divide_symbol, real_zero);
+  return(1.0 / x);
+}
+
+static s7_double divide_d_7dd(s7_scheme *sc, s7_double x1, s7_double x2)
+{
+  if (x2 == 0.0) division_by_zero_error_1_nr(sc, sc->divide_symbol, real_zero);
+  return(x1 / x2);
+}
+
+static s7_pointer divide_p_ii(s7_scheme *sc, s7_int x, s7_int y) {return(make_ratio_with_div_check(sc, sc->divide_symbol, x, y));}
+static s7_pointer divide_p_i(s7_scheme *sc, s7_int x) {return(make_ratio_with_div_check(sc, sc->divide_symbol, 1, x));}
+
+static s7_pointer divide_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  if (args == 1)
+    return(sc->invert_1);
+  if (args == 2)
+    {
+      s7_pointer arg1 = cadr(expr);
+      if ((is_t_real(arg1)) && (real(arg1) == 1.0))
+	return(sc->invert_x);
+      return(((is_t_integer(caddr(expr))) && (integer(caddr(expr)) == 2)) ? sc->divide_by_2 : sc->divide_2);
+    }
+  return(f);
+}
+
+
+/* -------------------------------- quotient -------------------------------- */
+static inline s7_int quotient_i_7ii(s7_scheme *sc, s7_int x, s7_int y)
+{
+  if ((y > 0) || (y < -1)) return(x / y);
+  if (y == 0)
+    division_by_zero_error_2_nr(sc, sc->quotient_symbol, wrap_integer(sc, x), int_zero);
+  if (x == S7_INT64_MIN)   /* (quotient most-negative-fixnum -1) */
+    sole_arg_out_of_range_error_nr(sc, sc->quotient_symbol, set_elist_2(sc, leastfix, minus_one), it_is_too_large_string);
+  return(-x); /* (quotient x -1) */
+}
+
+#if (!WITH_GMP)
+static s7_pointer s7_truncate(s7_scheme *sc, s7_pointer caller, s7_double xf)   /* can't use "truncate" -- it's in unistd.h */
+{
+  if (fabs(xf) > QUOTIENT_FLOAT_LIMIT)
+    sole_arg_out_of_range_error_nr(sc, caller, wrap_real(sc, xf), it_is_too_large_string);
+  return(make_integer(sc, (xf > 0.0) ? (s7_int)floor(xf) : (s7_int)ceil(xf)));
+}
+
+static s7_int c_quo_dbl(s7_scheme *sc, s7_double x, s7_double y)
+{
+  s7_double xf;
+  if (y == 0.0)
+    division_by_zero_error_2_nr(sc, sc->quotient_symbol, wrap_real(sc, x), real_zero);
+  if ((is_inf(y)) || (is_NaN(y))) /* here we can't return NAN so I guess we should signal an error */
+    wrong_type_error_nr(sc, sc->quotient_symbol, 2, wrap_real(sc, y), a_normal_real_string);
+  xf = x / y;
+  if (fabs(xf) > QUOTIENT_FLOAT_LIMIT)
+    sole_arg_out_of_range_error_nr(sc, sc->quotient_symbol, wrap_real(sc, xf), it_is_too_large_string);
+  return((xf > 0.0) ? (s7_int)floor(xf) : (s7_int)ceil(xf));
+}
+#endif
+
+static s7_int quotient_i_ii_unchecked(s7_int i1, s7_int i2) {return(i1 / i2);} /* i2 > 0 */
+
+static s7_pointer quotient_p_pp(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+#if WITH_GMP
+  if ((is_real(x)) && (is_real(y)))
+    {
+      if (is_zero(y))
+	division_by_zero_error_2_nr(sc, sc->quotient_symbol, x, y);
+      if ((s7_is_integer(x)) && (s7_is_integer(y)))
+	{
+	  if (is_t_integer(x)) mpz_set_si(sc->mpz_1, integer(x)); else mpz_set(sc->mpz_1, big_integer(x));
+	  if (is_t_integer(y)) mpz_set_si(sc->mpz_2, integer(y)); else mpz_set(sc->mpz_2, big_integer(y));
+	  mpz_tdiv_q(sc->mpz_1, sc->mpz_1, sc->mpz_2);
+	}
+      else
+	if ((!is_rational(x)) || (!is_rational(y)))
+	  {
+	    if (any_real_to_mpfr(sc, x, sc->mpfr_1)) return(real_NaN);
+	    if (any_real_to_mpfr(sc, y, sc->mpfr_2)) return(real_NaN);
+	    mpfr_div(sc->mpfr_3, sc->mpfr_1, sc->mpfr_2, MPFR_RNDN);
+	    mpfr_get_z(sc->mpz_1, sc->mpfr_3, MPFR_RNDZ);
+	  }
+	else
+	  {
+	    any_rational_to_mpq(sc, x, sc->mpq_1);
+	    any_rational_to_mpq(sc, y, sc->mpq_2);
+	    mpq_div(sc->mpq_3, sc->mpq_1, sc->mpq_2);
+	    mpz_tdiv_q(sc->mpz_1, mpq_numref(sc->mpq_3), mpq_denref(sc->mpq_3));
+	  }
+      return(mpz_to_integer(sc, sc->mpz_1));
+    }
+  return(method_or_bust_pp(sc, (is_real(x)) ? y : x, sc->quotient_symbol, x, y, sc->type_names[T_REAL], (is_real(x)) ? 2 : 1));
+#else
+
+  s7_int d1, d2, n1, n2;
+  if ((is_t_integer(x)) && (is_t_integer(y)))
+    return(make_integer(sc, quotient_i_7ii(sc, integer(x), integer(y))));
+
+  switch (type(x))
+    {
+    case T_INTEGER:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(make_integer(sc, quotient_i_7ii(sc, integer(x), integer(y))));
+
+	case T_RATIO:
+	  n1 = integer(x);
+	  d1 = 1;
+	  n2 = numerator(y);
+	  d2 = denominator(y);
+	  /* (quotient -9223372036854775808 -1/9223372036854775807): arithmetic exception in the no-overflow-checks case */
+	  goto RATIO_QUO_RATIO;
+
+	case T_REAL:
+	  if (real(y) == 0.0)
+	    division_by_zero_error_2_nr(sc, sc->quotient_symbol, x, y);
+	  if (is_inf(real(y))) return(real_NaN);
+	  if (is_NaN(real(y))) return(y);
+	  return(s7_truncate(sc, sc->quotient_symbol, (s7_double)integer(x) / real(y))); /* s7_truncate returns an integer */
+
+	default:
+	  return(method_or_bust_pp(sc, y, sc->quotient_symbol, x, y, sc->type_names[T_REAL], 2));
+	}
+
+    case T_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  if (integer(y) == 0)
+	    division_by_zero_error_2_nr(sc, sc->quotient_symbol, x, y);
+	  n1 = numerator(x);
+	  d1 = denominator(x);
+	  n2 = integer(y);
+	  d2 = 1;
+	  goto RATIO_QUO_RATIO;
+	  /* this can lose:
+	   *   (quotient 1 2305843009213693952/4611686018427387903) -> 2, not 1
+	   *   (quotient 21053343141/6701487259 3587785776203/1142027682075) -> 1, not 0
+	   */
+
+	case T_RATIO:
+	  parcel_out_fractions(x, y);
+	RATIO_QUO_RATIO:
+	  if (d1 == d2)
+	    return(make_integer(sc, n1 / n2));              /* (quotient 3/9223372036854775807 1/9223372036854775807) */
+	  if (n1 == n2)
+	    return(make_integer(sc, d2 / d1));              /* (quotient 9223372036854775807/2 9223372036854775807/8) */
+#if HAVE_OVERFLOW_CHECKS
+	  {
+	    s7_int n1d2, n2d1;
+	    if ((multiply_overflow(n1, d2, &n1d2)) ||
+		(multiply_overflow(n2, d1, &n2d1)))
+	      return(s7_truncate(sc, sc->quotient_symbol, ((long_double)n1 / (long_double)n2) * ((long_double)d2 / (long_double)d1)));
+	    return(make_integer(sc, n1d2 / n2d1));
+	  }
+#else
+	  return(make_integer(sc, (n1 * d2) / (n2 * d1)));
+#endif
+
+	case T_REAL:
+	  if (real(y) == 0.0)
+	    division_by_zero_error_2_nr(sc, sc->quotient_symbol, x, y);
+	  if (is_inf(real(y))) return(real_NaN);
+	  if (is_NaN(real(y))) return(y);
+	  return(s7_truncate(sc, sc->quotient_symbol, (s7_double)fraction(x) / real(y)));
+
+	default:
+	  return(method_or_bust_pp(sc, y, sc->quotient_symbol, x, y, sc->type_names[T_REAL], 2));
+	}
+
+    case T_REAL:
+      if (((is_inf(real(x))) || (is_NaN(real(x)))) && (is_real(y)))
+	return(real_NaN);
+      /* if infs allowed we need to return infs/nans, else:
+       *    (quotient inf.0 1e-309) -> -9223372036854775808
+       *    (quotient inf.0 inf.0) -> -9223372036854775808
+       */
+
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  if (integer(y) == 0)
+	    division_by_zero_error_2_nr(sc, sc->quotient_symbol, x, y);
+	  return(s7_truncate(sc, sc->quotient_symbol, (long_double)real(x) / (long_double)integer(y)));
+
+	case T_RATIO: return(s7_truncate(sc, sc->quotient_symbol, real(x) / (s7_double)fraction(y)));
+	case T_REAL:  return(make_integer(sc, c_quo_dbl(sc, real(x), real(y)))); /* c_quo_dbl returns an integer */
+	default:      return(method_or_bust_pp(sc, y, sc->quotient_symbol, x, y, sc->type_names[T_REAL], 2));
+	}
+
+    default:
+      return(method_or_bust_pp(sc, x, sc->quotient_symbol, x, y, sc->type_names[T_REAL], 2));
+    }
+#endif
+}
+
+static s7_pointer quotient_p_pi(s7_scheme *sc, s7_pointer x, s7_int y)
+{
+  if ((is_t_integer(x)) && ((y > 0) || (y < -1))) return(make_integer(sc, integer(x) / y));
+  return(quotient_p_pp(sc, x, wrap_integer(sc, y)));
+}
+
+static s7_pointer g_quotient(s7_scheme *sc, s7_pointer args)
+{
+  #define H_quotient "(quotient x1 x2) returns the integer quotient of x1 and x2; (quotient 4 3) = 1"
+  #define Q_quotient sc->pcl_r
+  /* sig was '(integer? ...) but quotient can return NaN */
+  /* (define (quo x1 x2) (truncate (/ x1 x2))) ; slib */
+  return(quotient_p_pp(sc, car(args), cadr(args)));
+}
+
+
+/* -------------------------------- remainder -------------------------------- */
+#if WITH_GMP
+static s7_pointer big_mod_or_rem(s7_scheme *sc, s7_pointer x, s7_pointer y, bool use_floor)
+{
+  if ((is_real(x)) && (is_real(y)))
+    {
+      if ((s7_is_integer(x)) && (s7_is_integer(y)))
+	{
+	  if (is_t_integer(x)) mpz_set_si(sc->mpz_1, integer(x)); else mpz_set(sc->mpz_1, big_integer(x));
+	  if (is_t_integer(y)) mpz_set_si(sc->mpz_2, integer(y)); else mpz_set(sc->mpz_2, big_integer(y));
+	  if (use_floor)
+	    mpz_fdiv_q(sc->mpz_3, sc->mpz_1, sc->mpz_2);
+	  else mpz_tdiv_q(sc->mpz_3, sc->mpz_1, sc->mpz_2);
+	  mpz_mul(sc->mpz_3, sc->mpz_3, sc->mpz_2);
+	  mpz_sub(sc->mpz_1, sc->mpz_1, sc->mpz_3);
+	  return(mpz_to_integer(sc, sc->mpz_1));
+	}
+      if ((!is_rational(x)) || (!is_rational(y)))
+	{
+	  any_real_to_mpfr(sc, x, sc->mpfr_1);
+	  any_real_to_mpfr(sc, y, sc->mpfr_2);
+	  mpfr_div(sc->mpfr_3, sc->mpfr_1, sc->mpfr_2, MPFR_RNDN);
+	  if (use_floor)
+	    mpfr_get_z(sc->mpz_1, sc->mpfr_3, MPFR_RNDD);
+	  else mpfr_get_z(sc->mpz_1, sc->mpfr_3, MPFR_RNDZ);
+	  mpfr_mul_z(sc->mpfr_2, sc->mpfr_2, sc->mpz_1, MPFR_RNDN);
+	  mpfr_sub(sc->mpfr_1, sc->mpfr_1, sc->mpfr_2, MPFR_RNDN);
+	  return(mpfr_to_big_real(sc, sc->mpfr_1));
+	}
+      any_rational_to_mpq(sc, x, sc->mpq_1);
+      any_rational_to_mpq(sc, y, sc->mpq_2);
+      mpq_div(sc->mpq_3, sc->mpq_1, sc->mpq_2);
+      if (use_floor)
+	mpz_fdiv_q(sc->mpz_1, mpq_numref(sc->mpq_3), mpq_denref(sc->mpq_3));
+      else mpz_tdiv_q(sc->mpz_1, mpq_numref(sc->mpq_3), mpq_denref(sc->mpq_3));
+      mpz_mul(mpq_numref(sc->mpq_2), sc->mpz_1, mpq_numref(sc->mpq_2));
+      mpq_sub(sc->mpq_1, sc->mpq_1, sc->mpq_2);
+      return(mpq_to_canonicalized_rational(sc, sc->mpq_1));
+    }
+  return(method_or_bust_pp(sc, (is_real(x)) ? y : x, (use_floor) ? sc->modulo_symbol : sc->remainder_symbol, x, y, sc->type_names[T_REAL], (is_real(x)) ? 2 : 1));
+}
+#endif
+
+#define REMAINDER_FLOAT_LIMIT 1e13
+
+static inline s7_int remainder_i_7ii(s7_scheme *sc, s7_int x, s7_int y)
+{
+  if ((y > 1) || (y < -1)) return(x % y); /* avoid floating exception if (remainder -9223372036854775808 -1)! */
+  if (y == 0)
+    division_by_zero_error_2_nr(sc, sc->remainder_symbol, wrap_integer(sc, x), int_zero);
+  return(0);
+}
+
+static s7_double c_rem_dbl(s7_scheme *sc, s7_double x, s7_double y)
+{
+  s7_int quo;
+  s7_double pre_quo;
+  if ((is_inf(y)) || (is_NaN(y)))
+    return(NAN);
+  pre_quo = x / y;
+  if (fabs(pre_quo) > REMAINDER_FLOAT_LIMIT)
+    sole_arg_out_of_range_error_nr(sc, sc->remainder_symbol, set_elist_2(sc, wrap_real(sc, x), wrap_real(sc, y)), it_is_too_large_string);
+  quo = (pre_quo > 0.0) ? (s7_int)floor(pre_quo) : (s7_int)ceil(pre_quo);
+  return(x - (y * quo));
+}
+
+static s7_int remainder_i_ii_unchecked(s7_int i1, s7_int i2) {return(i1 % i2);} /* i2 > 1 */
+static s7_double remainder_d_7dd(s7_scheme *sc, s7_double x1, s7_double x2)
+{
+  if (x2 == 0.0)
+    division_by_zero_error_2_nr(sc, sc->remainder_symbol, wrap_real(sc, x1), real_zero);
+  if ((is_inf(x1)) || (is_NaN(x1))) /* match remainder_p_pp */
+    return(NAN);
+  return(c_rem_dbl(sc, x1, x2));
+}
+
+static s7_pointer remainder_p_pp(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+#if WITH_GMP
+  if (is_zero(y))
+    division_by_zero_error_2_nr(sc, sc->remainder_symbol, x, y);
+  return(big_mod_or_rem(sc, x, y, false));
+#else
+  s7_int quo, d1, d2, n1, n2;
+  s7_double pre_quo;
+
+  if ((is_t_integer(x)) && (is_t_integer(y)))
+    return(make_integer(sc, remainder_i_7ii(sc, integer(x), integer(y))));
+
+  switch (type(x))
+    {
+    case T_INTEGER:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(make_integer(sc, remainder_i_7ii(sc, integer(x), integer(y))));
+
+	case T_RATIO:
+	  n1 = integer(x);
+	  d1 = 1;
+	  n2 = numerator(y);
+	  d2 = denominator(y);
+	  goto RATIO_REM_RATIO;
+
+	case T_REAL:
+	  if (real(y) == 0.0)
+	    division_by_zero_error_2_nr(sc, sc->remainder_symbol, x, y);
+	  if (is_inf(real(y))) return(real_NaN);
+	  if (is_NaN(real(y))) return(y);
+	  pre_quo = (long_double)integer(x) / (long_double)real(y);
+	  if (fabs(pre_quo) > REMAINDER_FLOAT_LIMIT)
+	    sole_arg_out_of_range_error_nr(sc, sc->remainder_symbol, set_elist_2(sc, x, y), it_is_too_large_string);
+	  quo = (pre_quo > 0.0) ? (s7_int)floor(pre_quo) : (s7_int)ceil(pre_quo);
+	  return(make_real(sc, integer(x) - real(y) * quo));
+
+	default:
+	  return(method_or_bust_pp(sc, y, sc->remainder_symbol, x, y, sc->type_names[T_REAL], 2));
+	}
+
+    case T_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  n2 = integer(y);
+ 	  if (n2 == 0)
+ 	    division_by_zero_error_2_nr(sc, sc->remainder_symbol, x, y);
+	  n1 = numerator(x);
+	  d1 = denominator(x);
+	  d2 = 1;
+	  goto RATIO_REM_RATIO;
+
+	case T_RATIO:
+	  parcel_out_fractions(x, y);
+	RATIO_REM_RATIO:
+	  if (d1 == d2)
+	    quo = (s7_int)(n1 / n2);
+	  else
+	    {
+	      if (n1 == n2)
+		quo = (s7_int)(d2 / d1);
+	      else
+		{
+#if HAVE_OVERFLOW_CHECKS
+		  s7_int n1d2, n2d1;
+		  if ((multiply_overflow(n1, d2, &n1d2)) ||
+		      (multiply_overflow(n2, d1, &n2d1)))
+		    {
+		      pre_quo = ((long_double)n1 / (long_double)n2) * ((long_double)d2 / (long_double)d1);
+		      if (fabs(pre_quo) > REMAINDER_FLOAT_LIMIT)
+			sole_arg_out_of_range_error_nr(sc, sc->remainder_symbol, set_elist_2(sc, x, y), it_is_too_large_string);
+		      quo = (pre_quo > 0.0) ? (s7_int)floor(pre_quo) : (s7_int)ceil(pre_quo);
+		    }
+		  else quo = n1d2 / n2d1;
+#else
+		  quo = (n1 * d2) / (n2 * d1);
+#endif
+		}}
+	  if (quo == 0)
+	    return(x);
+
+#if HAVE_OVERFLOW_CHECKS
+	  {
+	    s7_int dn, nq;
+	    if (!multiply_overflow(n2, quo, &nq))
+	      {
+		if ((d1 == d2) &&
+		    (!subtract_overflow(n1, nq, &dn)))
+		  return(make_ratio_with_div_check(sc, sc->remainder_symbol, dn, d1));
+
+		if ((!multiply_overflow(n1, d2, &dn)) &&
+		    (!multiply_overflow(nq, d1, &nq)) &&
+		    (!subtract_overflow(dn, nq, &nq)) &&
+		    (!multiply_overflow(d1, d2, &d1)))
+		  return(make_ratio_with_div_check(sc, sc->remainder_symbol, nq, d1));
+	      }}
+#else
+	  if (d1 == d2)
+	    return(make_ratio_with_div_check(sc, sc->remainder_symbol, n1 - n2 * quo, d1));
+
+	  return(make_ratio_with_div_check(sc, sc->remainder_symbol, n1 * d2 - n2 * d1 * quo, d1 * d2));
+#endif
+	  sole_arg_out_of_range_error_nr(sc, sc->remainder_symbol, set_elist_2(sc, x, y), intermediate_too_large_string);
+
+	case T_REAL:
+	  {
+	    s7_double frac;
+	    if (real(y) == 0.0)
+	      division_by_zero_error_2_nr(sc, sc->remainder_symbol, x, y);
+	    if (is_inf(real(y))) return(real_NaN);
+	    if (is_NaN(real(y))) return(y);
+	    if (s7_int_abs(numerator(x)) > QUOTIENT_INT_LIMIT)
+	      return(subtract_p_pp(sc, x, multiply_p_pp(sc, y, quotient_p_pp(sc, x, y))));
+	    frac = (s7_double)fraction(x);
+	    pre_quo = frac / real(y);
+	    if (fabs(pre_quo) > REMAINDER_FLOAT_LIMIT)
+	      sole_arg_out_of_range_error_nr(sc, sc->remainder_symbol, set_elist_2(sc, x, y), it_is_too_large_string);
+	    quo = (pre_quo > 0.0) ? (s7_int)floor(pre_quo) : (s7_int)ceil(pre_quo);
+	    return(make_real(sc, frac - real(y) * quo));
+	  }
+
+	default:
+	  return(method_or_bust_pp(sc, y, sc->remainder_symbol, x, y, sc->type_names[T_REAL], 2));
+	}
+
+    case T_REAL:
+      if (((is_inf(real(x))) || (is_NaN(real(x)))) && (is_real(y)))
+	{
+	  if (is_zero(y))
+	    division_by_zero_error_2_nr(sc, sc->remainder_symbol, x, y);
+	  return(real_NaN);
+	}
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  if (integer(y) == 0)
+	    division_by_zero_error_2_nr(sc, sc->remainder_symbol, x, y);
+	  /* actually here (and elsewhere) if y > INT64_TO_DOUBLE_LIMIT, the result is probably wrong */
+	  pre_quo = (long_double)real(x) / (long_double)integer(y);
+	  if (fabs(pre_quo) > REMAINDER_FLOAT_LIMIT)
+	    sole_arg_out_of_range_error_nr(sc, sc->remainder_symbol, set_elist_2(sc, x, y), it_is_too_large_string);
+	  quo = (pre_quo > 0.0) ? (s7_int)floor(pre_quo) : (s7_int)ceil(pre_quo);
+	  return(make_real(sc, real(x) - integer(y) * quo));
+	  /* but... (remainder 1e+18 9223372036854775807) -> 1e+18 */
+
+	case T_RATIO:
+	  if (s7_int_abs(numerator(y)) > QUOTIENT_INT_LIMIT)
+	    return(subtract_p_pp(sc, x, multiply_p_pp(sc, y, quotient_p_pp(sc, x, y))));
+	  {
+	    s7_double frac = (s7_double)fraction(y);
+	    pre_quo = real(x) / frac;
+	    if (fabs(pre_quo) > REMAINDER_FLOAT_LIMIT)
+	      sole_arg_out_of_range_error_nr(sc, sc->remainder_symbol, set_elist_2(sc, x, y), it_is_too_large_string);
+	    quo = (pre_quo > 0.0) ? (s7_int)floor(pre_quo) : (s7_int)ceil(pre_quo);
+	    return(make_real(sc, real(x) - frac * quo));
+	  }
+
+	case T_REAL:
+	  if (real(y) == 0.0)
+	    division_by_zero_error_2_nr(sc, sc->remainder_symbol, x, y);
+	  return(make_real(sc, c_rem_dbl(sc, real(x), real(y))));
+	  /* see under sin -- this calculation is completely bogus if "a" is large
+	   * (quotient 1e22 (* 2 pi)) -> -9223372036854775808 but it should be 1591549430918953357688,
+	   * (remainder 1e22 (* 2 pi)) -> 1.0057952155665e+22 -- the "remainder" is greater than the original argument!
+	   * Clisp gives 0.0 here, as does sbcl, currently s7 throws an error (out-of-range).
+	   */
+
+	default:
+	  return(method_or_bust_pp(sc, y, sc->remainder_symbol, x, y, sc->type_names[T_REAL], 2));
+	}
+
+    default:
+      return(method_or_bust_pp(sc, x, sc->remainder_symbol, x, y, sc->type_names[T_REAL], 1));
+    }
+#endif
+}
+
+static s7_pointer remainder_p_pi(s7_scheme *sc, s7_pointer x, s7_int y)
+{
+  if ((is_t_integer(x)) && ((y > 1) || (y < -1))) return(make_integer(sc, integer(x) % y));
+  return(remainder_p_pp(sc, x, wrap_integer(sc, y)));
+}
+
+static s7_pointer g_remainder(s7_scheme *sc, s7_pointer args)
+{
+  #define H_remainder "(remainder x1 x2) returns the remainder of x1/x2; (remainder 10 3) = 1"
+  #define Q_remainder sc->pcl_r
+  /* (define (rem x1 x2) (- x1 (* x2 (quo x1 x2)))) ; slib, if x2 is an integer (- x1 (truncate x1 x2)), fractional part: (remainder x 1) */
+
+  s7_pointer x = car(args), y = cadr(args);
+  if ((is_t_integer(x)) && (is_t_integer(y)))
+    return(make_integer(sc, remainder_i_7ii(sc, integer(x), integer(y))));
+  return(remainder_p_pp(sc, x, y));
+}
+
+
+/* -------------------------------- modulo -------------------------------- */
+static s7_int modulo_i_ii(s7_int x, s7_int y)
+{
+  s7_int z;
+  if (y > 1)
+    {
+      z = x % y;
+      return((z >= 0) ? z : z + y);
+    }
+  if (y < -1)
+    {
+      z = x % y;
+      return((z > 0) ? z + y : z);
+    }
+  if (y == 0) return(x);     /* else arithmetic exception */
+  return(0);
+}
+
+static s7_int modulo_i_ii_unchecked(s7_int i1, s7_int i2) /* here we know i2 > 1 */
+{
+  s7_int z = i1 % i2;
+  return((z < 0) ? (z + i2) : z);
+}
+
+static s7_double modulo_d_7dd(s7_scheme *sc, s7_double x1, s7_double x2)
+{
+  s7_double c;
+  if ((is_NaN(x1)) || (is_NaN(x2)) || (is_inf(x1)) || (is_inf(x2))) return(NAN);
+  if (x2 == 0.0) return(x1);
+  if (fabs(x1) > 1e17)
+    out_of_range_error_nr(sc, sc->modulo_symbol, int_one, wrap_real(sc, x1), it_is_too_large_string);
+  c = x1 / x2;
+  if ((c > 1e19) || (c < -1e19))
+    sole_arg_out_of_range_error_nr(sc, sc->modulo_symbol,
+			set_elist_3(sc, sc->divide_symbol, wrap_real(sc, x1), wrap_real(sc, x2)),
+			intermediate_too_large_string);
+  return(x1 - x2 * (s7_int)floor(c));
+}
+
+static s7_pointer modulo_p_pp(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+#if WITH_GMP
+  /* as tricky as expt, so just use bignums; mpz_mod|_ui = mpz_fdiv_r_ui, but sign ignored -- probably not worth the code
+   *   originally   subtract_p_pp(sc, x, multiply_p_pp(sc, y, floor_p_p(sc, divide_p_pp(sc, x, y))))
+   *   quotient is                                            truncate_p_p(sc, divide_p_pp(sc, x, y))
+   *   remainder is subtract_p_pp(sc, x, multiply_p_pp(sc, y, quotient_p_pp(sc, x, y)))
+   */
+  if (!is_zero(y)) return(big_mod_or_rem(sc, x, y, true));
+  if (is_real(x)) return(x);
+  return(method_or_bust_pp(sc, x, sc->modulo_symbol, x, y, sc->type_names[T_REAL], 1));
+#else
+  s7_double a, b;
+  s7_int n1, n2, d1, d2;
+
+  switch (type(x))
+    {
+    case T_INTEGER:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(make_integer(sc, modulo_i_ii(integer(x), integer(y))));
+
+	case T_RATIO:
+	  n1 = integer(x);
+	  d1 = 1;
+	  n2 = numerator(y);
+	  d2 = denominator(y);
+	  if ((n1 == n2) && (d1 > d2)) return(x); /* signs match so this should be ok */
+	  goto RATIO_MOD_RATIO;
+
+	case T_REAL:
+	  if ((integer(x) == S7_INT64_MIN) || (s7_int_abs(integer(x)) > QUOTIENT_INT_LIMIT))
+	    out_of_range_error_nr(sc, sc->modulo_symbol, int_one, x, it_is_too_large_string);
+	  b = real(y);
+	  if (b == 0.0) return(x);
+	  if (is_NaN(b)) return(y);
+	  if (is_inf(b)) return(real_NaN);
+	  a = (s7_double)integer(x);
+	  goto REAL_MOD;
+
+	default:
+	  return(method_or_bust_pp(sc, y, sc->modulo_symbol, x, y, sc->type_names[T_REAL], 2));
+	}
+
+    case T_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  if (integer(y) == 0) return(x);
+	  n1 = numerator(x);
+	  d1 = denominator(x);
+	  n2 = integer(y);
+
+	  if ((n2 > 0) && (n1 > 0) && (n2 > n1)) return(x);
+	  if ((n2 < 0) && (n1 < 0) && (n2 < n1)) return(x);
+	  if (n2 == S7_INT64_MIN)
+	    sole_arg_out_of_range_error_nr(sc, sc->modulo_symbol,
+				       set_elist_3(sc, sc->divide_symbol, x, y),
+				       intermediate_too_large_string);
+	  /* the problem here is that (modulo 3/2 most-negative-fixnum)
+	   * will segfault with signal SIGFPE, Arithmetic exception, so try to trap it.
+	   */
+	  if ((n1 == n2) && (d1 > 1)) return(x);
+	  d2 = 1;
+	  goto RATIO_MOD_RATIO;
+
+	case T_RATIO:
+	  parcel_out_fractions(x, y);
+	  if (d1 == d2)
+	    return(make_ratio_with_div_check(sc, sc->modulo_symbol, modulo_i_ii(n1, n2), d1));
+	  if ((n1 == n2) && (d1 > d2)) return(x);
+
+	RATIO_MOD_RATIO:
+#if HAVE_OVERFLOW_CHECKS
+	  {
+	    s7_int n2d1, n1d2, d1d2, fl;
+	    if (!multiply_overflow(n2, d1, &n2d1))
+	      {
+		if ((n2d1 == 1) || (n2d1 == -1)) /* (modulo 100 -1/2) */
+		  return(int_zero);
+
+		if (!multiply_overflow(n1, d2, &n1d2))
+		  {
+		    fl = (s7_int)(n1d2 / n2d1);
+		    if (((n1 < 0) && (n2 > 0)) ||
+			((n1 > 0) && (n2 < 0)))
+		      fl -= 1;
+		    if (fl == 0)
+		      return(x);
+
+		    if ((!multiply_overflow(d1, d2, &d1d2)) &&
+			(!multiply_overflow(fl, n2d1, &fl)) &&
+			(!subtract_overflow(n1d2, fl, &fl)))
+		      return(make_ratio_with_div_check(sc, sc->modulo_symbol, fl, d1d2));
+		  }}}
+#else
+	  {
+	    s7_int fl;
+	    s7_int n1d2 = n1 * d2;
+	    s7_int n2d1 = n2 * d1;
+
+	    if (n2d1 == 1)
+	      return(int_zero);
+
+	    /* can't use "floor" here (float->int ruins everything) */
+	    fl = (s7_int)(n1d2 / n2d1);
+	    if (((n1 < 0) && (n2 > 0)) ||
+		((n1 > 0) && (n2 < 0)))
+	      fl -= 1;
+
+	    if (fl == 0)
+	      return(x);
+
+	    return(make_ratio_with_div_check(sc, sc->modulo_symbol, n1d2 - (n2d1 * fl), d1 * d2));
+	  }
+#endif
+	  sole_arg_out_of_range_error_nr(sc, sc->modulo_symbol,
+				     set_elist_3(sc, sc->divide_symbol, x, y),
+				     intermediate_too_large_string);
+	case T_REAL:
+	  b = real(y);
+	  if (is_inf(b)) return(real_NaN);
+	  if (fabs(b) > 1e17)
+	    out_of_range_error_nr(sc, sc->modulo_symbol, int_two, y, it_is_too_large_string);
+	  if (b == 0.0) return(x);
+	  if (is_NaN(b)) return(y);
+	  a = fraction(x);
+	  return(make_real(sc, a - b * (s7_int)floor(a / b)));
+
+	default:
+	  return(method_or_bust_pp(sc, y, sc->modulo_symbol, x, y, sc->type_names[T_REAL], 2));
+	}
+
+    case T_REAL:
+      {
+	s7_double c;
+	a = real(x);
+	if (!is_real(y))
+	  return(method_or_bust_pp(sc, y, sc->modulo_symbol, x, y, sc->type_names[T_REAL], 2));
+	if (is_NaN(a)) return(x);
+	if (is_inf(a)) return(real_NaN); /* not b */
+	if (fabs(a) > 1e17)
+	  out_of_range_error_nr(sc, sc->modulo_symbol, int_one, x, it_is_too_large_string);
+
+	switch (type(y))
+	  {
+	  case T_INTEGER:
+	    if (integer(y) == 0) return(x);
+	    if ((integer(y) == S7_INT64_MIN) || (s7_int_abs(integer(y)) > QUOTIENT_INT_LIMIT))
+	      out_of_range_error_nr(sc, sc->modulo_symbol, int_two, y, it_is_too_large_string);
+	    b = (s7_double)integer(y);
+	    goto REAL_MOD;
+
+	  case T_RATIO:
+	    b = fraction(y);
+	    goto REAL_MOD;
+
+	  case T_REAL:
+	    b = real(y);
+	    if (b == 0.0) return(x);
+	    if (is_NaN(b)) return(y);
+	    if (is_inf(b)) return(real_NaN);
+	  REAL_MOD:
+	    c = a / b;
+	    if (fabs(c) > 1e19)
+	      sole_arg_out_of_range_error_nr(sc, sc->modulo_symbol,
+					 set_elist_3(sc, sc->divide_symbol, x, y),
+					 intermediate_too_large_string);
+	    return(make_real(sc, a - b * (s7_int)floor(c)));
+
+	  default:
+	    return(method_or_bust_pp(sc, y, sc->modulo_symbol, x, y, sc->type_names[T_REAL], 2));
+	  }}
+
+    default:
+      return(method_or_bust_pp(sc, x, sc->modulo_symbol, x, y, sc->type_names[T_REAL], 1));
+    }
+#endif
+}
+
+static s7_pointer modulo_p_pi(s7_scheme *sc, s7_pointer x, s7_int y)
+{
+  if (is_t_integer(x)) return(make_integer(sc, modulo_i_ii(integer(x), y)));
+  return(modulo_p_pp(sc, x, wrap_integer(sc, y)));
+}
+
+static s7_pointer g_modulo(s7_scheme *sc, s7_pointer args)
+{
+  #define H_modulo "(modulo x1 x2) returns x1 mod x2; (modulo 4 3) = 1.  The arguments can be real numbers."
+  #define Q_modulo sc->pcl_r
+  /* (define (mod x1 x2) (- x1 (* x2 (floor (/ x1 x2))))) from slib
+   * (mod x 0) = x according to "Concrete Mathematics"
+   */
+  return(modulo_p_pp(sc, car(args), cadr(args)));
+}
+
+
+/* ---------------------------------------- max ---------------------------------------- */
+static bool is_real_via_method_1(s7_scheme *sc, s7_pointer p)
+{
+  s7_pointer f = find_method_with_let(sc, p, sc->is_real_symbol);
+  if (f != sc->undefined)
+    return(is_true(sc, s7_apply_function(sc, f, set_plist_1(sc, p))));
+  return(false);
+}
+
+#define is_real_via_method(sc, p) ((is_real(p)) || ((has_active_methods(sc, p)) && (is_real_via_method_1(sc, p))))
+
+#define max_out_x(Sc, X, Y) method_or_bust_pp(Sc, X, Sc->max_symbol, X, Y, sc->type_names[T_REAL], 1)
+#define max_out_y(Sc, X, Y) method_or_bust_pp(Sc, Y, Sc->max_symbol, X, Y, sc->type_names[T_REAL], 2)
+
+static s7_pointer max_p_pp(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  /* same basic code as lt_b_7_pp (or any relop) but max returns NaN if NaN encountered, and methods for < and max return
+   *    different results, so it seems simpler to repeat the other code.
+   */
+  if (type(x) == type(y))
+    {
+      if (is_t_integer(x))
+	return((integer(x) < integer(y)) ? y : x);
+      if (is_t_real(x))
+	/* return(((is_NaN(real(x))) || (real(x) >= real(y))) ? x : y); */
+	return(((real(x) >= real(y)) || (is_NaN(real(x)))) ? x : y);
+      if (is_t_ratio(x))
+	return((fraction(x) < fraction(y)) ? y : x);
+#if WITH_GMP
+      if (is_t_big_integer(x))
+	return((mpz_cmp(big_integer(x), big_integer(y)) < 0) ? y : x);
+      if (is_t_big_ratio(x))
+	return((mpq_cmp(big_ratio(x), big_ratio(y)) < 0) ? y : x);
+      if (is_t_big_real(x))
+	return(((mpfr_nan_p(big_real(x)) != 0) || (mpfr_greaterequal_p(big_real(x), big_real(y)))) ? x : y); /* ?? */
+#endif
+    }
+  switch (type(x))
+    {
+    case T_INTEGER:
+      switch (type(y))
+	{
+	case T_RATIO:
+	  return((integer(x) < fraction(y)) ? y : x);
+	case T_REAL:
+	  return(((integer(x) < real(y)) || (is_NaN(real(y)))) ? y : x);
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  return((mpz_cmp_si(big_integer(y), integer(x)) < 0) ? x : y);
+	case T_BIG_RATIO:
+	  return((mpq_cmp_si(big_ratio(y), integer(x), 1) < 0) ? x : y);
+	case T_BIG_REAL:
+	  if (mpfr_nan_p(big_real(y))) return(y);
+	  return((mpfr_cmp_si(big_real(y), integer(x)) < 0) ? x : y);
+#endif
+	default:
+	  return(max_out_y(sc, x, y));
+	}
+      break;
+
+    case T_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return((fraction(x) < integer(y)) ? y : x);
+	case T_REAL:
+	  return(((fraction(x) < real(y)) || (is_NaN(real(y)))) ? y : x);
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  return((mpq_cmp_z(sc->mpq_1, big_integer(y)) < 0) ? y : x);
+	case T_BIG_RATIO:
+	  return((mpq_cmp_si(big_ratio(y), numerator(x), denominator(x)) < 0) ? x : y);
+	case T_BIG_REAL:
+	  if (mpfr_nan_p(big_real(y))) return(y);
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  return((mpfr_cmp_q(big_real(y), sc->mpq_1) < 0) ? x : y);
+#endif
+	default:
+	  return(max_out_y(sc, x, y));
+	}
+
+    case T_REAL:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(((real(x) >= integer(y)) || (is_NaN(real(x)))) ? x : y);
+	case T_RATIO:
+	  return((real(x) < fraction(y)) ? y : x);
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  if (is_NaN(real(x))) return(x);
+	  mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	  return((mpfr_cmp_z(sc->mpfr_1, big_integer(y)) < 0) ? y : x);
+	case T_BIG_RATIO:
+	  if (is_NaN(real(x))) return(x);
+	  mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	  return((mpfr_cmp_q(sc->mpfr_1, big_ratio(y)) < 0) ? y : x);
+	case T_BIG_REAL:
+	  if (is_NaN(real(x))) return(x);
+	  if (mpfr_nan_p(big_real(y))) return(y);
+	  return((mpfr_cmp_d(big_real(y), real(x)) < 0) ? x : y);
+#endif
+	default:
+	  return(max_out_y(sc, x, y));
+	}
+      break;
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return((mpz_cmp_si(big_integer(x), integer(y)) < 0) ? y : x);
+	case T_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  return((mpq_cmp_z(sc->mpq_1, big_integer(x)) < 0) ? x : y);
+	case T_REAL:
+	  if (is_NaN(real(y))) return(y);
+	  mpfr_set_z(sc->mpfr_1, big_integer(x), MPFR_RNDN);
+	  return((mpfr_cmp_d(sc->mpfr_1, real(y)) < 0) ? y : x);
+	case T_BIG_RATIO:
+	  return((mpq_cmp_z(big_ratio(y), big_integer(x)) < 0) ? x : y);
+	case T_BIG_REAL:
+	  if (mpfr_nan_p(big_real(y))) return(y);
+	  return((mpfr_cmp_z(big_real(y), big_integer(x)) < 0) ? x : y);
+	default:
+	  return(max_out_y(sc, x, y));
+	}
+    case T_BIG_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return((mpq_cmp_si(big_ratio(x), integer(y), 1) < 0) ? y : x);
+	case T_RATIO:
+	  return((mpq_cmp_si(big_ratio(x), numerator(y), denominator(y)) < 0) ? y : x);
+	case T_REAL:
+	  if (is_NaN(real(y))) return(y);
+	  mpfr_set_q(sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+	  return((mpfr_cmp_d(sc->mpfr_1, real(y)) < 0) ? y : x);
+	case T_BIG_INTEGER:
+	  return((mpq_cmp_z(big_ratio(x), big_integer(y)) < 0) ? y : x);
+	case T_BIG_REAL:
+	  if (mpfr_nan_p(big_real(y))) return(y);
+	  return((mpfr_cmp_q(big_real(y), big_ratio(x)) < 0) ? x : y);
+	default:
+	  return(max_out_y(sc, x, y));
+	}
+
+    case T_BIG_REAL:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  if (mpfr_nan_p(big_real(x))) return(x);
+	  return((mpfr_cmp_si(big_real(x), integer(y)) < 0) ? y : x);
+	case T_RATIO:
+	  if (mpfr_nan_p(big_real(x))) return(x);
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  return((mpfr_cmp_q(big_real(x), sc->mpq_1) < 0) ? y : x);
+	case T_REAL:
+	  if (mpfr_nan_p(big_real(x))) return(x);
+	  if (is_NaN(real(y))) return(y);
+	  return((mpfr_cmp_d(big_real(x), real(y)) < 0) ? y : x);
+	case T_BIG_INTEGER:
+	  if (mpfr_nan_p(big_real(x))) return(x);
+	  return((mpfr_cmp_z(big_real(x), big_integer(y)) < 0) ? y : x);
+	case T_BIG_RATIO:
+	  if (mpfr_nan_p(big_real(x))) return(x);
+	  return((mpfr_cmp_q(big_real(x), big_ratio(y)) < 0) ? y : x);
+	default:
+	  return(max_out_y(sc, x, y));
+	}
+#endif
+    default:
+      return(max_out_x(sc, x, y));
+    }
+  return(x);
+}
+
+static s7_pointer g_max(s7_scheme *sc, s7_pointer args)
+{
+  #define H_max "(max ...) returns the maximum of its arguments"
+  #define Q_max sc->pcl_r
+
+  s7_pointer x = car(args);
+  if (is_null(cdr(args)))
+    {
+      if (is_real(x)) return(x);
+      return(method_or_bust_p(sc, x, sc->max_symbol, sc->type_names[T_REAL]));
+    }
+  for (s7_pointer p = cdr(args); is_pair(p); p = cdr(p))
+    x = max_p_pp(sc, x, car(p));
+  return(x);
+}
+
+static s7_pointer g_max_2(s7_scheme *sc, s7_pointer args) {return(max_p_pp(sc, car(args), cadr(args)));}
+static s7_pointer g_max_3(s7_scheme *sc, s7_pointer args) {return(max_p_pp(sc, max_p_pp(sc, car(args), cadr(args)), caddr(args)));}
+
+static s7_pointer max_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer unused_expr)
+{
+  return((args == 2) ? sc->max_2 : ((args == 3) ? sc->max_3 : f));
+}
+
+static s7_int max_i_ii(s7_int i1, s7_int i2) {return((i1 > i2) ? i1 : i2);}
+static s7_int max_i_iii(s7_int i1, s7_int i2, s7_int i3) {return((i1 > i2) ? ((i1 > i3) ? i1 : i3) : ((i2 > i3) ? i2 : i3));}
+static s7_double max_d_dd(s7_double x1, s7_double x2) {return(((x1 > x2) || (is_NaN(x1))) ? x1 : x2);}
+static s7_double max_d_ddd(s7_double x1, s7_double x2, s7_double x3) {return(max_d_dd(x1, max_d_dd(x2, x3)));}
+static s7_double max_d_dddd(s7_double x1, s7_double x2, s7_double x3, s7_double x4) {return(max_d_dd(x1, max_d_ddd(x2, x3, x4)));}
+
+
+/* ---------------------------------------- min ---------------------------------------- */
+#define min_out_x(Sc, X, Y) method_or_bust_pp(Sc, X, Sc->min_symbol, X, Y, sc->type_names[T_REAL], 1)
+#define min_out_y(Sc, X, Y) method_or_bust_pp(Sc, Y, Sc->min_symbol, X, Y, sc->type_names[T_REAL], 2)
+
+static s7_pointer min_p_pp(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  if (type(x) == type(y))
+    {
+      if (is_t_integer(x))
+	return((integer(x) > integer(y)) ? y : x);
+      if (is_t_real(x))
+	/* return(((is_NaN(real(x))) || (real(x) <= real(y))) ? x : y); */
+	return(((real(x) <= real(y)) || (is_NaN(real(x)))) ? x : y);
+      if (is_t_ratio(x))
+	return((fraction(x) > fraction(y)) ? y : x);
+#if WITH_GMP
+      if (is_t_big_integer(x))
+	return((mpz_cmp(big_integer(x), big_integer(y)) > 0) ? y : x);
+      if (is_t_big_ratio(x))
+	return((mpq_cmp(big_ratio(x), big_ratio(y)) > 0) ? y : x);
+      if (is_t_big_real(x))
+	return(((mpfr_nan_p(big_real(x)) != 0) || (mpfr_lessequal_p(big_real(x), big_real(y)))) ? x : y); /* ?? */
+#endif
+    }
+  switch (type(x))
+    {
+    case T_INTEGER:
+      switch (type(y))
+	{
+	case T_RATIO:       return((integer(x) > fraction(y)) ? y : x);
+	case T_REAL:
+	  return(((integer(x) > real(y)) || (is_NaN(real(y)))) ? y : x);
+#if WITH_GMP
+	case T_BIG_INTEGER: return((mpz_cmp_si(big_integer(y), integer(x)) > 0) ? x : y);
+	case T_BIG_RATIO:   return((mpq_cmp_si(big_ratio(y), integer(x), 1) > 0) ? x : y);
+	case T_BIG_REAL:
+	  if (mpfr_nan_p(big_real(y))) return(y);
+	  return((mpfr_cmp_si(big_real(y), integer(x)) > 0) ? x : y);
+#endif
+	default:
+	  return(min_out_y(sc, x, y));
+	}
+      break;
+
+    case T_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return((fraction(x) > integer(y)) ? y : x);
+	case T_REAL:
+	  return(((fraction(x) > real(y)) || (is_NaN(real(y)))) ? y : x);
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  return((mpq_cmp_z(sc->mpq_1, big_integer(y)) > 0) ? y : x);
+	case T_BIG_RATIO:
+	  return((mpq_cmp_si(big_ratio(y), numerator(x), denominator(x)) > 0) ? x : y);
+	case T_BIG_REAL:
+	  if (mpfr_nan_p(big_real(y))) return(y);
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  return((mpfr_cmp_q(big_real(y), sc->mpq_1) > 0) ? x : y);
+#endif
+	default:
+	  return(min_out_y(sc, x, y));
+	}
+
+    case T_REAL:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(((real(x) <= integer(y)) || (is_NaN(real(x)))) ? x : y);
+	case T_RATIO:
+	  return((real(x) > fraction(y)) ? y : x);
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  if (is_NaN(real(x))) return(x);
+	  mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	  return((mpfr_cmp_z(sc->mpfr_1, big_integer(y)) > 0) ? y : x);
+
+	case T_BIG_RATIO:
+	  if (is_NaN(real(x))) return(x);
+	  mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	  return((mpfr_cmp_q(sc->mpfr_1, big_ratio(y)) > 0) ? y : x);
+
+	case T_BIG_REAL:
+	  if (is_NaN(real(x))) return(x);
+	  if (mpfr_nan_p(big_real(y))) return(y);
+	  return((mpfr_cmp_d(big_real(y), real(x)) > 0) ? x : y);
+#endif
+	default:
+	  return(min_out_y(sc, x, y));
+	}
+      break;
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return((mpz_cmp_si(big_integer(x), integer(y)) > 0) ? y : x);
+	case T_RATIO:
+	  mpq_set_z(sc->mpq_1, big_integer(x));
+	  return((mpq_cmp_si(sc->mpq_1, numerator(y), denominator(y)) > 0) ? y : x);
+	case T_REAL:
+	  if (is_NaN(real(y))) return(y);
+	  mpfr_set_z(sc->mpfr_1, big_integer(x), MPFR_RNDN);
+	  return((mpfr_cmp_d(sc->mpfr_1, real(y)) > 0) ? y : x);
+	case T_BIG_RATIO:
+	  return((mpq_cmp_z(big_ratio(y), big_integer(x)) > 0) ? x : y);
+	case T_BIG_REAL:
+	  if (mpfr_nan_p(big_real(y))) return(y);
+	  return((mpfr_cmp_z(big_real(y), big_integer(x)) > 0) ? x : y);
+	default:
+	  return(min_out_y(sc, x, y));
+	}
+    case T_BIG_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return((mpq_cmp_si(big_ratio(x), integer(y), 1) > 0) ? y : x);
+	case T_RATIO:
+	  return((mpq_cmp_si(big_ratio(x), numerator(y), denominator(y)) > 0) ? y : x);
+	case T_REAL:
+	  if (is_NaN(real(y))) return(y);
+	  mpfr_set_q(sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+	  return((mpfr_cmp_d(sc->mpfr_1, real(y)) > 0) ? y : x);
+	case T_BIG_INTEGER:
+	  return((mpq_cmp_z(big_ratio(x), big_integer(y)) > 0) ? y : x);
+	case T_BIG_REAL:
+	  if (mpfr_nan_p(big_real(y))) return(y);
+	  return((mpfr_cmp_q(big_real(y), big_ratio(x)) > 0) ? x : y);
+	default:
+	  return(min_out_y(sc, x, y));
+	}
+
+    case T_BIG_REAL:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  if (mpfr_nan_p(big_real(x))) return(x);
+	  return((mpfr_cmp_si(big_real(x), integer(y)) > 0) ? y : x);
+	case T_RATIO:
+	  if (mpfr_nan_p(big_real(x))) return(x);
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  return((mpfr_cmp_q(big_real(x), sc->mpq_1) > 0) ? y : x);
+	case T_REAL:
+	  if (mpfr_nan_p(big_real(x))) return(x);
+	  if (is_NaN(real(y))) return(y);
+	  return((mpfr_cmp_d(big_real(x), real(y)) > 0) ? y : x);
+	case T_BIG_INTEGER:
+	  if (mpfr_nan_p(big_real(x))) return(x);
+	  return((mpfr_cmp_z(big_real(x), big_integer(y)) > 0) ? y : x);
+	case T_BIG_RATIO:
+	  if (mpfr_nan_p(big_real(x))) return(x);
+	  return((mpfr_cmp_q(big_real(x), big_ratio(y)) > 0) ? y : x);
+	default:
+	  return(min_out_y(sc, x, y));
+	}
+#endif
+    default:
+      return(min_out_x(sc, x, y));
+    }
+  return(x);
+}
+
+static s7_pointer g_min(s7_scheme *sc, s7_pointer args)
+{
+  #define H_min "(min ...) returns the minimum of its arguments"
+  #define Q_min sc->pcl_r
+
+  s7_pointer x = car(args);
+  if (is_null(cdr(args)))
+    {
+      if (is_real(x)) return(x);
+      return(method_or_bust_p(sc, x, sc->min_symbol, sc->type_names[T_REAL]));
+    }
+  for (s7_pointer p = cdr(args); is_pair(p); p = cdr(p))
+    x = min_p_pp(sc, x, car(p));
+  return(x);
+}
+
+static s7_pointer g_min_2(s7_scheme *sc, s7_pointer args) {return(min_p_pp(sc, car(args), cadr(args)));}
+static s7_pointer g_min_3(s7_scheme *sc, s7_pointer args) {return(min_p_pp(sc, min_p_pp(sc, car(args), cadr(args)), caddr(args)));}
+
+static s7_pointer min_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer unused_expr)
+{
+  return((args == 2) ? sc->min_2 : ((args == 3) ? sc->min_3 : f));
+}
+
+static s7_int min_i_ii(s7_int i1, s7_int i2) {return((i1 < i2) ? i1 : i2);}
+static s7_int min_i_iii(s7_int i1, s7_int i2, s7_int i3) {return((i1 < i2) ? ((i1 < i3) ? i1 : i3) : ((i2 < i3) ? i2 : i3));}
+static s7_double min_d_dd(s7_double x1, s7_double x2) {return(((x1 < x2) || (is_NaN(x1))) ? x1 : x2);}
+static s7_double min_d_ddd(s7_double x1, s7_double x2, s7_double x3) {return(min_d_dd(x1, min_d_dd(x2, x3)));}
+static s7_double min_d_dddd(s7_double x1, s7_double x2, s7_double x3, s7_double x4) {return(min_d_dd(x1, min_d_ddd(x2, x3, x4)));}
+
+
+/* ---------------------------------------- = ---------------------------------------- */
+static bool eq_out_x(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  if (has_active_methods(sc, x))
+    return(find_and_apply_method(sc, x, sc->num_eq_symbol, set_plist_2(sc, x, y)) != sc->F);
+  wrong_type_error_nr(sc, sc->num_eq_symbol, 1, x, a_number_string);
+  return(false);
+}
+
+static bool eq_out_y(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  if (has_active_methods(sc, y))
+    return(find_and_apply_method(sc, y, sc->num_eq_symbol, set_plist_2(sc, x, y)) != sc->F);
+  wrong_type_error_nr(sc, sc->num_eq_symbol, 2, y, a_number_string);
+  return(false);
+}
+
+static bool num_eq_b_7pp(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  if (type(x) == type(y))
+    {
+      if (is_t_integer(x))
+	return(integer(x) == integer(y));
+      if (is_t_real(x))
+	return(real(x) == real(y));
+      if (is_t_complex(x))
+	return((real_part(x) == real_part(y)) && (imag_part(x) == imag_part(y)));
+      if (is_t_ratio(x))
+	return((numerator(x) == numerator(y)) && (denominator(x) == denominator(y)));
+#if WITH_GMP
+      if (is_t_big_integer(x))
+	return(mpz_cmp(big_integer(x), big_integer(y)) == 0);
+      if (is_t_big_ratio(x))
+	return(mpq_equal(big_ratio(x), big_ratio(y)));
+      if (is_t_big_real(x))
+	return(mpfr_equal_p(big_real(x), big_real(y)));
+      if (is_t_big_complex(x)) /* mpc_cmp can't handle NaN */
+	{
+	  if ((mpfr_nan_p(mpc_realref(big_complex(x)))) || (mpfr_nan_p(mpc_imagref(big_complex(x)))) ||
+	      (mpfr_nan_p(mpc_realref(big_complex(y)))) || (mpfr_nan_p(mpc_imagref(big_complex(y)))))
+	    return(false);
+	  return(mpc_cmp(big_complex(x), big_complex(y)) == 0);
+	}
+#endif
+    }
+
+  switch (type(x))
+    {
+    case T_INTEGER:
+      switch (type(y))
+	{
+	case T_RATIO:
+	  return(false);
+	case T_REAL:
+#if WITH_GMP
+	  if (s7_int_abs(integer(x)) >= INT64_TO_DOUBLE_LIMIT)
+	    {
+	      if (is_NaN(real(y))) return(false);
+	      mpfr_set_d(sc->mpfr_1, real(y), MPFR_RNDN);
+	      return(mpfr_cmp_si(sc->mpfr_1, integer(x)) == 0);
+	    }
+#endif
+	  return(integer(x) == real(y));
+	case T_COMPLEX:
+	  return(false);
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  return((mpz_fits_slong_p(big_integer(y))) && (integer(x) == mpz_get_si(big_integer(y))));
+	case T_BIG_RATIO:
+	  return(false);
+	case T_BIG_REAL:
+	  return((!mpfr_nan_p(big_real(y))) && (mpfr_cmp_si(big_real(y), integer(x)) == 0));
+	case T_BIG_COMPLEX:
+	  return(false);
+#endif
+	default: return(eq_out_y(sc, x, y));
+	}
+      break;
+
+    case T_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER: return(false);
+	case T_REAL:    return(fraction(x) == real(y));
+	case T_COMPLEX: return(false);
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  return(false);
+	case T_BIG_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  return(mpq_equal(sc->mpq_1, big_ratio(y)));
+	case T_BIG_REAL:
+	  if (mpfr_nan_p(big_real(y))) return(false);
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  return(mpfr_cmp_q(big_real(y), sc->mpq_1) == 0);
+	case T_BIG_COMPLEX:
+	  return(false);
+#endif
+	default: return(eq_out_y(sc, x, y));
+	}
+      break;
+
+    case T_REAL:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(real(x) == integer(y));
+	case T_RATIO:
+	  return(real(x) == fraction(y));
+	case T_COMPLEX:
+	  return(false);
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  if (is_NaN(real(x))) return(false);
+	  mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	  return(mpfr_cmp_z(sc->mpfr_1, big_integer(y)) == 0);
+	case T_BIG_RATIO:
+	  if (is_NaN(real(x))) return(false);
+	  mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	  return(mpfr_cmp_q(sc->mpfr_1, big_ratio(y)) == 0);
+	case T_BIG_REAL:
+	  if (is_NaN(real(x))) return(false);
+	  return((!mpfr_nan_p(big_real(y))) && (mpfr_cmp_d(big_real(y), real(x)) == 0));
+	case T_BIG_COMPLEX:
+	  return(false);
+#endif
+	default: return(eq_out_y(sc, x, y));
+	}
+      break;
+
+    case T_COMPLEX:
+      if (is_real(y)) return(false);
+#if WITH_GMP
+      if (is_t_big_complex(y))
+	{
+	  if ((is_NaN(real_part(x))) || (is_NaN(imag_part(x))) ||
+	      (mpfr_nan_p(mpc_realref(big_complex(y)))) || (mpfr_nan_p(mpc_imagref(big_complex(y)))))
+	    return(false);
+	  mpc_set_d_d(sc->mpc_1, real_part(x), imag_part(x), MPC_RNDNN);
+	  return(mpc_cmp(big_complex(y), sc->mpc_1) == 0);
+	}
+#endif
+      return(eq_out_y(sc, x, y));
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return((mpz_fits_slong_p(big_integer(x))) && (integer(y) == mpz_get_si(big_integer(x))));
+	case T_REAL:
+	  if (is_NaN(real(y))) return(false);
+	  mpfr_set_d(sc->mpfr_1, real(y), MPFR_RNDN);
+	  return(mpfr_cmp_z(sc->mpfr_1, big_integer(x)) == 0);
+	case T_RATIO: case T_COMPLEX: case T_BIG_RATIO: case T_BIG_COMPLEX:
+	  return(false);
+	case T_BIG_REAL:
+	  return((!mpfr_nan_p(big_real(y))) && (mpfr_cmp_z(big_real(y), big_integer(x)) == 0));
+	default: return(eq_out_y(sc, x, y));
+	}
+    case T_BIG_RATIO:
+      switch (type(y))
+	{
+	case T_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  return(mpq_equal(sc->mpq_1, big_ratio(x)));
+	case T_REAL:
+	  if (is_NaN(real(y))) return(false);
+	  mpfr_set_d(sc->mpfr_1, real(y), MPFR_RNDN);
+	  return(mpfr_cmp_q(sc->mpfr_1, big_ratio(x)) == 0);
+	case T_INTEGER: case T_BIG_INTEGER: case T_COMPLEX: case T_BIG_COMPLEX:
+	  return(false);
+	case T_BIG_REAL:
+	  return((!mpfr_nan_p(big_real(y))) && (mpfr_cmp_q(big_real(y), big_ratio(x)) == 0));
+	default: return(eq_out_y(sc, x, y));
+	}
+
+    case T_BIG_REAL:
+      if ((is_number(y)) && (mpfr_nan_p(big_real(x)))) return(false);
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(mpfr_cmp_si(big_real(x), integer(y)) == 0);
+	case T_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  return(mpfr_cmp_q(big_real(x), sc->mpq_1) == 0);
+	case T_REAL:
+	  return((!is_NaN(real(y))) && (mpfr_cmp_d(big_real(x), real(y)) == 0));
+	case T_BIG_INTEGER:
+	  return(mpfr_cmp_z(big_real(x), big_integer(y)) == 0);
+	case T_BIG_RATIO:
+	  return(mpfr_cmp_q(big_real(x), big_ratio(y)) == 0);
+	case T_COMPLEX: case T_BIG_COMPLEX:
+	  return(false);
+	default: return(eq_out_y(sc, x, y));
+	}
+
+    case T_BIG_COMPLEX:
+      switch (type(y))
+	{
+	case T_RATIO: case T_REAL: case T_INTEGER: case T_BIG_INTEGER: case T_BIG_RATIO: case T_BIG_REAL:
+	  return(false);
+	case T_COMPLEX:
+	  if ((is_NaN(real_part(y))) || (is_NaN(imag_part(y))) ||
+	      (mpfr_nan_p(mpc_realref(big_complex(x)))) || (mpfr_nan_p(mpc_imagref(big_complex(x)))))
+	    return(false);
+	  mpc_set_d_d(sc->mpc_1, real_part(y), imag_part(y), MPC_RNDNN);
+	  return(mpc_cmp(big_complex(x), sc->mpc_1) == 0); /* NaN's not allowed! */
+	default: return(eq_out_y(sc, x, y));
+	}
+#endif
+    default: return(eq_out_x(sc, x, y));
+    }
+  return(false);
+}
+
+static bool is_number_via_method(s7_scheme *sc, s7_pointer p)
+{
+  if (is_number(p))
+    return(true);
+  if (has_active_methods(sc, p))
+    {
+      s7_pointer f = find_method_with_let(sc, p, sc->is_number_symbol);
+      if (f != sc->undefined)
+	return(is_true(sc, s7_apply_function(sc, f, set_plist_1(sc, p))));
+    }
+  return(false);
+}
+
+static s7_pointer g_num_eq(s7_scheme *sc, s7_pointer args)
+{
+  #define H_num_eq "(= z1 ...) returns #t if all its arguments are equal"
+  #define Q_num_eq s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_number_symbol)
+
+  s7_pointer x = car(args), p = cdr(args);
+  if (is_null(cdr(p)))
+    return(make_boolean(sc, num_eq_b_7pp(sc, x, car(p))));
+
+  for (; is_pair(p); p = cdr(p))
+    if (!num_eq_b_7pp(sc, x, car(p)))
+      {
+	for (p = cdr(p); is_pair(p); p = cdr(p))
+	  if (!is_number_via_method(sc, car(p)))
+	    wrong_type_error_nr(sc, sc->num_eq_symbol, position_of(p, args), car(p), a_number_string);
+	return(sc->F);
+      }
+  return(sc->T);
+}
+
+static bool num_eq_b_ii(s7_int i1, s7_int i2) {return(i1 == i2);}
+static bool num_eq_b_dd(s7_double i1, s7_double i2) {return(i1 == i2);}
+
+static s7_pointer num_eq_p_dd(s7_scheme *sc, s7_double x1, s7_double x2) {return(make_boolean(sc, x1 == x2));}
+static s7_pointer num_eq_p_ii(s7_scheme *sc, s7_int x1, s7_int x2)       {return(make_boolean(sc, x1 == x2));}
+static s7_pointer num_eq_p_pp(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(make_boolean(sc, num_eq_b_7pp(sc, x, y)));}
+
+static s7_pointer num_eq_p_pi(s7_scheme *sc, s7_pointer p1, s7_int p2)
+{
+  if (is_t_integer(p1))
+    return(make_boolean(sc, integer(p1) == p2));
+  if (is_t_real(p1))
+    return(make_boolean(sc, real(p1) == p2));
+#if WITH_GMP
+  if (is_t_big_integer(p1))
+    return(make_boolean(sc, (mpz_fits_slong_p(big_integer(p1))) && (p2 == mpz_get_si(big_integer(p1)))));
+  if (is_t_big_real(p1))
+    return(make_boolean(sc, mpfr_cmp_si(big_real(p1), p2) == 0));
+#endif
+  if (is_number(p1))
+    return(sc->F); /* complex/ratio can't == int */
+  if (has_active_methods(sc, p1))
+    return(find_and_apply_method(sc, p1, sc->num_eq_symbol, set_plist_2(sc, p1, make_integer(sc, p2))));
+  wrong_type_error_nr(sc, sc->num_eq_symbol, 1, p1, a_number_string);
+#ifdef __TINYC__
+  return(sc->F);
+#endif
+}
+
+static bool num_eq_b_pi(s7_scheme *sc, s7_pointer x, s7_int y)
+{
+  if (is_t_integer(x))
+    return(integer(x) == y);
+  if (is_t_real(x))
+    return(real(x) == y);
+#if WITH_GMP
+  if (is_t_big_integer(x))
+    return((mpz_fits_slong_p(big_integer(x))) && (y == mpz_get_si(big_integer(x))));
+  if (is_t_big_real(x))
+    return(mpfr_cmp_si(big_real(x), y) == 0);
+#endif
+  if (!is_number(x)) /* complex/ratio can't == int */
+    wrong_type_error_nr(sc, sc->num_eq_symbol, 1, x, a_number_string);
+  return(false);
+}
+
+static s7_pointer g_num_eq_2(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer x = car(args), y = cadr(args);
+  if ((is_t_integer(x)) && (is_t_integer(y))) /* this is by far the most common case (ratios aren't used much, and = with floats is frowned upon) */
+    return(make_boolean(sc, integer(x) == integer(y)));
+  return(make_boolean(sc, num_eq_b_7pp(sc, x, y)));
+}
+
+static inline s7_pointer num_eq_xx(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  if (is_t_integer(x))
+    return(make_boolean(sc, integer(x) == integer(y)));
+  if (is_t_real(x))
+    return(make_boolean(sc, real(x) == integer(y)));
+  if (!is_number(x))
+    return(make_boolean(sc, eq_out_x(sc, x, y)));
+#if WITH_GMP
+  if (is_t_big_integer(x))
+    return(make_boolean(sc, mpz_cmp_si(big_integer(x), integer(y)) == 0));
+  if (is_t_big_real(x))
+    {
+      if (mpfr_nan_p(big_real(x))) return(sc->F);
+      return(make_boolean(sc, mpfr_cmp_si(big_real(x), integer(y)) == 0));
+    }
+  if (is_t_big_ratio(x))
+    return(make_boolean(sc, mpq_cmp_si(big_ratio(x), integer(y), 1) == 0));
+#endif
+  return(sc->F);
+}
+
+static s7_pointer g_num_eq_xi(s7_scheme *sc, s7_pointer args) {return(num_eq_xx(sc, car(args), cadr(args)));}
+static s7_pointer g_num_eq_ix(s7_scheme *sc, s7_pointer args) {return(num_eq_xx(sc, cadr(args), car(args)));}
+
+static s7_pointer num_eq_chooser(s7_scheme *sc, s7_pointer ur_f, int32_t args, s7_pointer expr)
+{
+  if (args != 2) return(ur_f);
+  if (is_t_integer(caddr(expr)))
+    return(sc->num_eq_xi);
+  return((is_t_integer(cadr(expr))) ? sc->num_eq_ix : sc->num_eq_2);
+}
+
+
+/* ---------------------------------------- < ---------------------------------------- */
+static bool lt_out_x(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  if (has_active_methods(sc, x))
+    return(find_and_apply_method(sc, x, sc->lt_symbol, list_2(sc, x, y)) != sc->F); /* not plist */
+  wrong_type_error_nr(sc, sc->lt_symbol, 1, x, sc->type_names[T_REAL]);
+  return(false);
+}
+
+static bool lt_out_y(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  if (has_active_methods(sc, y))
+    return(find_and_apply_method(sc, y, sc->lt_symbol, list_2(sc, x, y)) != sc->F);
+  wrong_type_error_nr(sc, sc->lt_symbol, 2, y, sc->type_names[T_REAL]);
+  return(false);
+}
+
+static bool lt_b_7pp(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  if (type(x) == type(y))
+    {
+      if (is_t_integer(x))
+	return(integer(x) < integer(y));
+      if (is_t_real(x))
+	return(real(x) < real(y));
+      if (is_t_ratio(x))
+	return(fraction(x) < fraction(y));
+#if WITH_GMP
+      if (is_t_big_integer(x))
+	return(mpz_cmp(big_integer(x), big_integer(y)) < 0);
+      if (is_t_big_ratio(x))
+	return(mpq_cmp(big_ratio(x), big_ratio(y)) < 0);
+      if (is_t_big_real(x))
+	return(mpfr_less_p(big_real(x), big_real(y)));
+#endif
+    }
+  switch (type(x))
+    {
+    case T_INTEGER:
+      switch (type(y))
+	{
+	case T_RATIO:	return(integer(x) < fraction(y)); /* ?? */
+	case T_REAL:	return(integer(x) < real(y));
+#if WITH_GMP
+	case T_BIG_INTEGER: return(mpz_cmp_si(big_integer(y), integer(x)) > 0);
+	case T_BIG_RATIO:   return(mpq_cmp_si(big_ratio(y), integer(x), 1) > 0);
+	case T_BIG_REAL:    return(mpfr_cmp_si(big_real(y), integer(x)) > 0);
+#endif
+	default: return(lt_out_y(sc, x, y));
+	}
+      break;
+
+    case T_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER: return(fraction(x) < integer(y));
+	case T_REAL:    return(fraction(x) < real(y));
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  return(mpq_cmp_z(sc->mpq_1, big_integer(y)) < 0);
+	case T_BIG_RATIO:
+	  return(mpq_cmp_si(big_ratio(y), numerator(x), denominator(x)) > 0);
+	case T_BIG_REAL:
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  return(mpfr_cmp_q(big_real(y), sc->mpq_1) > 0);
+#endif
+	default: return(lt_out_y(sc, x, y));
+	}
+
+    case T_REAL:
+      switch (type(y))
+	{
+	case T_INTEGER: return(real(x) < integer(y));
+	case T_RATIO:	return(real(x) < fraction(y));
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  if (is_NaN(real(x))) return(false);
+	  mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	  return(mpfr_cmp_z(sc->mpfr_1, big_integer(y)) < 0);
+	case T_BIG_RATIO:
+	  mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	  return(mpfr_cmp_q(sc->mpfr_1, big_ratio(y)) < 0);
+	case T_BIG_REAL:
+	  return(mpfr_cmp_d(big_real(y), real(x)) > 0);
+#endif
+	default: return(lt_out_y(sc, x, y));
+	}
+      break;
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(mpz_cmp_si(big_integer(x), integer(y)) < 0);
+	case T_RATIO:
+	  mpq_set_z(sc->mpq_1, big_integer(x));
+	  return(mpq_cmp_si(sc->mpq_1, numerator(y), denominator(y)) < 0);
+	case T_REAL:
+	  if (is_NaN(real(y))) return(false);
+	  mpfr_set_z(sc->mpfr_1, big_integer(x), MPFR_RNDN);
+	  return(mpfr_cmp_d(sc->mpfr_1, real(y)) < 0);
+	case T_BIG_RATIO:
+	  return(mpq_cmp_z(big_ratio(y), big_integer(x)) > 0);
+	case T_BIG_REAL:
+	  return(mpfr_cmp_z(big_real(y), big_integer(x)) > 0);
+	default: return(lt_out_y(sc, x, y));
+	}
+    case T_BIG_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(mpq_cmp_si(big_ratio(x), integer(y), 1) < 0);
+	case T_RATIO:
+	  return(mpq_cmp_si(big_ratio(x), numerator(y), denominator(y)) < 0);
+	case T_REAL:
+	  if (is_NaN(real(y))) return(false);
+	  mpfr_set_q(sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+	  return(mpfr_cmp_d(sc->mpfr_1, real(y)) < 0);
+	case T_BIG_INTEGER:
+	  return(mpq_cmp_z(big_ratio(x), big_integer(y)) < 0);
+	case T_BIG_REAL:
+	  return(mpfr_cmp_q(big_real(y), big_ratio(x)) > 0);
+	default: return(lt_out_y(sc, x, y));
+	}
+
+    case T_BIG_REAL:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(mpfr_cmp_si(big_real(x), integer(y)) < 0);
+	case T_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  return(mpfr_cmp_q(big_real(x), sc->mpq_1) < 0);
+	case T_REAL:
+	  return(mpfr_cmp_d(big_real(x), real(y)) < 0);
+	case T_BIG_INTEGER:
+	  return(mpfr_cmp_z(big_real(x), big_integer(y)) < 0);
+	case T_BIG_RATIO:
+	  return(mpfr_cmp_q(big_real(x), big_ratio(y)) < 0);
+	default: return(lt_out_y(sc, x, y));
+	}
+#endif
+    default: return(lt_out_x(sc, x, y));
+    }
+  return(true);
+}
+
+static s7_pointer g_less(s7_scheme *sc, s7_pointer args)
+{
+  #define H_less "(< x1 ...) returns #t if its arguments are in increasing order"
+  #define Q_less s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_real_symbol)
+
+  s7_pointer x = car(args), p = cdr(args);
+  if (is_null(cdr(p)))
+    return(make_boolean(sc, lt_b_7pp(sc, x, car(p))));
+
+  for (; is_pair(p); p = cdr(p))
+    {
+      if (!lt_b_7pp(sc, x, car(p)))
+	{
+	  for (p = cdr(p); is_pair(p); p = cdr(p))
+	    if (!is_real_via_method(sc, car(p)))
+	      wrong_type_error_nr(sc, sc->lt_symbol, position_of(p, args), car(p), sc->type_names[T_REAL]);
+	  return(sc->F);
+	}
+      x = car(p);
+    }
+  return(sc->T);
+}
+
+static bool ratio_lt_pi(s7_pointer x, s7_int y)
+{
+  if ((y >= 0) && (numerator(x) < 0))
+    return(true);
+  if ((y <= 0) && (numerator(x) > 0))
+    return(false);
+  if (denominator(x) < S7_INT32_MAX)
+    return(numerator(x) < (y * denominator(x)));
+  return(fraction(x) < y);
+}
+
+static s7_pointer g_less_x0(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer x = car(args);
+  if (is_t_integer(x))
+    return(make_boolean(sc, integer(x) < 0));
+  if (is_small_real(x))
+    return(make_boolean(sc, is_negative(sc, x)));
+#if WITH_GMP
+  if (is_t_big_integer(x))
+    return(make_boolean(sc, mpz_cmp_si(big_integer(x), 0) < 0));
+  if (is_t_big_real(x))
+    return(make_boolean(sc, mpfr_cmp_si(big_real(x), 0) < 0));
+  if (is_t_big_ratio(x))
+    return(make_boolean(sc, mpq_cmp_si(big_ratio(x), 0, 1) < 0));
+#endif
+  return(method_or_bust(sc, x, sc->lt_symbol, args, sc->type_names[T_REAL], 1));
+}
+
+static s7_pointer g_less_xi(s7_scheme *sc, s7_pointer args)
+{
+  s7_int y = integer(cadr(args));
+  s7_pointer x = car(args);
+
+  if (is_t_integer(x))
+    return(make_boolean(sc, integer(x) < y));
+  if (is_t_real(x))
+    return(make_boolean(sc, real(x) < y));
+  if (is_t_ratio(x))
+    return(make_boolean(sc, ratio_lt_pi(x, y)));
+#if WITH_GMP
+  if (is_t_big_integer(x))
+    return(make_boolean(sc, mpz_cmp_si(big_integer(x), y) < 0));
+  if (is_t_big_real(x))
+    return(make_boolean(sc, mpfr_cmp_si(big_real(x), y) < 0));
+  if (is_t_big_ratio(x))
+    return(make_boolean(sc, mpq_cmp_si(big_ratio(x), y, 1) < 0));
+#endif
+  return(method_or_bust(sc, x, sc->lt_symbol, args, sc->type_names[T_REAL], 1));
+}
+
+static s7_pointer g_less_xf(s7_scheme *sc, s7_pointer args)
+{
+  s7_double y = real(cadr(args)); /* chooser below checks is_t_real(y) */
+  s7_pointer x = car(args);
+
+  if (is_t_real(x))
+    return(make_boolean(sc, real(x) < y));
+  if (is_t_integer(x))
+    return(make_boolean(sc, integer(x) < y));
+  if (is_t_ratio(x))
+    return(make_boolean(sc, fraction(x) < y));
+#if WITH_GMP
+  if (is_t_big_real(x))
+    return(make_boolean(sc, mpfr_cmp_d(big_real(x), y) < 0));
+  if (is_t_big_integer(x))
+    {
+      mpfr_set_d(sc->mpfr_1, y, MPFR_RNDN);
+      return(make_boolean(sc, mpfr_cmp_z(sc->mpfr_1, big_integer(x)) > 0));
+    }
+  if (is_t_big_ratio(x))
+    {
+      mpfr_set_d(sc->mpfr_1, y, MPFR_RNDN);
+      return(make_boolean(sc, mpfr_cmp_q(sc->mpfr_1, big_ratio(x)) > 0));
+    }
+#endif
+  return(method_or_bust(sc, x, sc->lt_symbol, args, sc->type_names[T_REAL], 1));
+}
+
+static inline s7_pointer lt_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) {return(make_boolean(sc, lt_b_7pp(sc, p1, p2)));}
+static bool lt_b_ii(s7_int i1, s7_int i2) {return(i1 < i2);}
+static bool lt_b_dd(s7_double i1, s7_double i2) {return(i1 < i2);}
+static s7_pointer lt_p_dd(s7_scheme *sc, s7_double x1, s7_double x2) {return(make_boolean(sc, x1 < x2));}
+static s7_pointer lt_p_ii(s7_scheme *sc, s7_int x1, s7_int x2) {return(make_boolean(sc, x1 < x2));}
+
+static bool lt_b_pi(s7_scheme *sc, s7_pointer p1, s7_int p2)
+{
+  if (is_t_integer(p1)) return(integer(p1) < p2);
+  if (is_t_real(p1))  return(real(p1) < p2);
+  if (is_t_ratio(p1)) return(ratio_lt_pi(p1, p2));
+#if WITH_GMP
+  if (is_t_big_integer(p1))
+    return(mpz_cmp_si(big_integer(p1), p2) < 0);
+  if (is_t_big_real(p1))
+    return(mpfr_cmp_si(big_real(p1), p2) < 0);
+  if (is_t_big_ratio(p1))
+    return(mpq_cmp_si(big_ratio(p1), p2, 1) < 0);
+#endif
+  return(lt_out_x(sc, p1, make_integer(sc, p2)));
+}
+
+static s7_pointer g_less_2(s7_scheme *sc, s7_pointer args) {return(lt_p_pp(sc, car(args), cadr(args)));}
+static s7_pointer lt_p_pi(s7_scheme *sc, s7_pointer p1, s7_int p2) {return(make_boolean(sc, lt_b_pi(sc, p1, p2)));}
+
+static s7_pointer less_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  s7_pointer arg2;
+  if (args != 2) return(f);
+  arg2 = caddr(expr);
+  if (is_t_integer(arg2))
+    {
+      if (integer(arg2) == 0)
+	return(sc->less_x0);
+      if ((integer(arg2) < S7_INT32_MAX) && (integer(arg2) > S7_INT32_MIN))
+	return(sc->less_xi);
+    }
+  if (is_t_real(arg2))
+    return(sc->less_xf);
+  return(sc->less_2);
+}
+
+
+/* ---------------------------------------- <= ---------------------------------------- */
+static bool leq_out_x(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  if (has_active_methods(sc, x))
+    return(find_and_apply_method(sc, x, sc->leq_symbol, list_2(sc, x, y)) != sc->F); /* not plist */
+  wrong_type_error_nr(sc, sc->leq_symbol, 1, x, sc->type_names[T_REAL]);
+  return(false);
+}
+
+static bool leq_out_y(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  if (has_active_methods(sc, y))
+    return(find_and_apply_method(sc, y, sc->leq_symbol, list_2(sc, x, y)) != sc->F);
+  wrong_type_error_nr(sc, sc->leq_symbol, 2, y, sc->type_names[T_REAL]);
+  return(false);
+}
+
+static bool leq_b_7pp(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  if (type(x) == type(y))
+    {
+      if (is_t_integer(x))
+	return(integer(x) <= integer(y));
+      if (is_t_real(x))
+	return(real(x) <= real(y));
+      if (is_t_ratio(x))
+	return(fraction(x) <= fraction(y));
+#if WITH_GMP
+      if (is_t_big_integer(x))
+	return(mpz_cmp(big_integer(x), big_integer(y)) <= 0);
+      if (is_t_big_ratio(x))
+	return(mpq_cmp(big_ratio(x), big_ratio(y)) <= 0);
+      if (is_t_big_real(x))
+	return(mpfr_lessequal_p(big_real(x), big_real(y)));
+#endif
+    }
+  switch (type(x))
+    {
+    case T_INTEGER:
+      switch (type(y))
+	{
+	case T_RATIO:	return(integer(x) <= fraction(y)); /* ?? */
+	case T_REAL:	return(integer(x) <= real(y));
+#if WITH_GMP
+	case T_BIG_INTEGER: return(mpz_cmp_si(big_integer(y), integer(x)) >= 0);
+	case T_BIG_RATIO:   return(mpq_cmp_si(big_ratio(y), integer(x), 1) >= 0);
+	case T_BIG_REAL:
+	  return((!mpfr_nan_p(big_real(y))) && (mpfr_cmp_si(big_real(y), integer(x)) >= 0));
+#endif
+	default: return(leq_out_y(sc, x, y));
+	}
+      break;
+
+    case T_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER: return(fraction(x) <= integer(y));
+	case T_REAL:    return(fraction(x) <= real(y));
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  return(mpq_cmp_z(sc->mpq_1, big_integer(y)) <= 0);
+	case T_BIG_RATIO:
+	  return(mpq_cmp_si(big_ratio(y), numerator(x), denominator(x)) >= 0);
+	case T_BIG_REAL:
+	  if (mpfr_nan_p(big_real(y))) return(false);
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  return(mpfr_cmp_q(big_real(y), sc->mpq_1) >= 0);
+#endif
+	default: return(leq_out_y(sc, x, y));
+	}
+
+    case T_REAL:
+      switch (type(y))
+	{
+	case T_INTEGER: return(real(x) <= integer(y));
+	case T_RATIO:	return(real(x) <= fraction(y));
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  if (is_NaN(real(x))) return(false);
+	  mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	  return(mpfr_cmp_z(sc->mpfr_1, big_integer(y)) <= 0);
+	case T_BIG_RATIO:
+	  if (is_NaN(real(x))) return(false);
+	  mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	  return(mpfr_cmp_q(sc->mpfr_1, big_ratio(y)) <= 0);
+	case T_BIG_REAL:
+	  if (is_NaN(real(x))) return(false);
+	  return((!mpfr_nan_p(big_real(y))) && (mpfr_cmp_d(big_real(y), real(x)) >= 0));
+#endif
+	default: return(leq_out_y(sc, x, y));
+	}
+      break;
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(mpz_cmp_si(big_integer(x), integer(y)) <= 0);
+	case T_RATIO:
+	  mpq_set_z(sc->mpq_1, big_integer(x));
+	  return(mpq_cmp_si(sc->mpq_1, numerator(y), denominator(y)) <= 0);
+	case T_REAL:
+	  if (is_NaN(real(y))) return(false);
+	  mpfr_set_z(sc->mpfr_1, big_integer(x), MPFR_RNDN);
+	  return(mpfr_cmp_d(sc->mpfr_1, real(y)) <= 0);
+	case T_BIG_RATIO:
+	  return(mpq_cmp_z(big_ratio(y), big_integer(x)) >= 0);
+	case T_BIG_REAL:
+	  return((!mpfr_nan_p(big_real(y))) && (mpfr_cmp_z(big_real(y), big_integer(x)) >= 0));
+	default: return(leq_out_y(sc, x, y));
+	}
+    case T_BIG_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(mpq_cmp_si(big_ratio(x), integer(y), 1) <= 0);
+	case T_RATIO:
+	  return(mpq_cmp_si(big_ratio(x), numerator(y), denominator(y)) <= 0);
+	case T_REAL:
+	  if (is_NaN(real(y))) return(false);
+	  mpfr_set_q(sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+	  return(mpfr_cmp_d(sc->mpfr_1, real(y)) <= 0);
+	case T_BIG_INTEGER:
+	  return(mpq_cmp_z(big_ratio(x), big_integer(y)) <= 0);
+	case T_BIG_REAL:
+	  return((!mpfr_nan_p(big_real(y))) && (mpfr_cmp_q(big_real(y), big_ratio(x)) >= 0));
+	default: return(leq_out_y(sc, x, y));
+	}
+
+    case T_BIG_REAL:
+      if ((is_real(y)) && (mpfr_nan_p(big_real(x)))) return(false);
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(mpfr_cmp_si(big_real(x), integer(y)) <= 0);
+	case T_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  return(mpfr_cmp_q(big_real(x), sc->mpq_1) <= 0);
+	case T_REAL:
+	  return((!is_NaN(real(y))) && (mpfr_cmp_d(big_real(x), real(y)) <= 0));
+	case T_BIG_INTEGER:
+	  return(mpfr_cmp_z(big_real(x), big_integer(y)) <= 0);
+	case T_BIG_RATIO:
+	  return(mpfr_cmp_q(big_real(x), big_ratio(y)) <= 0);
+	default: return(leq_out_y(sc, x, y));
+	}
+#endif
+    default: return(leq_out_x(sc, x, y));
+    }
+  return(true);
+}
+
+static s7_pointer g_less_or_equal(s7_scheme *sc, s7_pointer args)
+{
+  #define H_less_or_equal "(<= x1 ...) returns #t if its arguments are in non-decreasing order"
+  #define Q_less_or_equal s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_real_symbol)
+
+  s7_pointer x = car(args), p = cdr(args);
+
+  if (is_null(cdr(p)))
+    return(make_boolean(sc, leq_b_7pp(sc, x, car(p))));
+
+  for (; is_pair(p); x = car(p), p = cdr(p))
+    if (!leq_b_7pp(sc, x, car(p)))
+      {
+	for (p = cdr(p); is_pair(p); p = cdr(p))
+	  if (!is_real_via_method(sc, car(p)))
+	    wrong_type_error_nr(sc, sc->leq_symbol, position_of(p, args), car(p), sc->type_names[T_REAL]);
+	return(sc->F);
+      }
+  return(sc->T);
+}
+
+static inline s7_pointer leq_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) {return(make_boolean(sc, leq_b_7pp(sc, p1, p2)));}
+static bool leq_b_ii(s7_int i1, s7_int i2) {return(i1 <= i2);}
+static bool leq_b_dd(s7_double i1, s7_double i2) {return(i1 <= i2);}
+static s7_pointer leq_p_dd(s7_scheme *sc, s7_double x1, s7_double x2) {return(make_boolean(sc, x1 <= x2));}
+static s7_pointer leq_p_ii(s7_scheme *sc, s7_int x1, s7_int x2) {return(make_boolean(sc, x1 <= x2));}
+
+static bool ratio_leq_pi(s7_pointer x, s7_int y)
+{
+  if ((y >= 0) && (numerator(x) <= 0))
+    return(true);
+  if ((y <= 0) && (numerator(x) > 0))
+    return(false);
+  if (denominator(x) < S7_INT32_MAX)
+    return(numerator(x) <= (y * denominator(x)));
+  return(fraction(x) <= y);
+}
+
+static s7_pointer g_leq_xi(s7_scheme *sc, s7_pointer args)
+{
+  s7_int y = integer(cadr(args));
+  s7_pointer x = car(args);
+
+  if (is_t_integer(x))
+    return(make_boolean(sc, integer(x) <= y));
+  if (is_t_real(x))
+    return(make_boolean(sc, real(x) <= y));
+  if (is_t_ratio(x))
+    return(make_boolean(sc, ratio_leq_pi(x, y)));
+#if WITH_GMP
+  if (is_t_big_integer(x))
+    return(make_boolean(sc, mpz_cmp_si(big_integer(x), y) <= 0));
+  if (is_t_big_real(x))
+    {
+      if (mpfr_nan_p(big_real(x))) return(sc->F);
+      return(make_boolean(sc, mpfr_cmp_si(big_real(x), y) <= 0));
+    }
+  if (is_t_big_ratio(x))
+    return(make_boolean(sc, mpq_cmp_si(big_ratio(x), y, 1) <= 0));
+#endif
+  return(method_or_bust(sc, x, sc->leq_symbol, args, sc->type_names[T_REAL], 1));
+}
+
+static bool leq_b_pi(s7_scheme *sc, s7_pointer p1, s7_int p2)
+{
+  if (is_t_integer(p1)) return(integer(p1) <= p2);
+  if (is_t_real(p1))  return(real(p1) <= p2);
+  if (is_t_ratio(p1)) return(ratio_leq_pi(p1, p2));
+#if WITH_GMP
+  if (is_t_big_integer(p1))
+    return(mpz_cmp_si(big_integer(p1), p2) <= 0);
+  if (is_t_big_real(p1))
+    return(mpfr_cmp_si(big_real(p1), p2) <= 0);
+  if (is_t_big_ratio(p1))
+    return(mpq_cmp_si(big_ratio(p1), p2, 1) <= 0);
+#endif
+  if (has_active_methods(sc, p1))
+    return(find_and_apply_method(sc, p1, sc->leq_symbol, list_2(sc, p1, make_integer(sc, p2)))); /* not plist */
+  wrong_type_error_nr(sc, sc->leq_symbol, 1, p1, sc->type_names[T_REAL]);
+#ifdef __TINYC__
+  return(false);
+#endif
+}
+
+static s7_pointer leq_p_pi(s7_scheme *sc, s7_pointer p1, s7_int p2) {return(make_boolean(sc, leq_b_pi(sc, p1, p2)));}
+static s7_pointer g_leq_2(s7_scheme *sc, s7_pointer args) {return(make_boolean(sc, leq_b_7pp(sc, car(args), cadr(args))));}
+static s7_pointer g_leq_ixx(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer p = cdr(args);
+  if (is_t_integer(car(p)))
+    {
+      if (integer(car(args)) > integer(car(p)))
+	{
+	  if (!is_real_via_method(sc, cadr(p)))
+	    wrong_type_error_nr(sc, sc->leq_symbol, 3, cadr(p), sc->type_names[T_REAL]);
+	  return(sc->F);
+	}
+      if (is_t_integer(cadr(p)))
+	return((integer(car(p)) > integer(cadr(p))) ? sc->F : sc->T);
+    }
+  return(g_less_or_equal(sc, args));
+}
+
+static s7_pointer leq_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  s7_pointer arg2;
+  if (args == 2)
+    {
+      arg2 = caddr(expr);
+      if ((is_t_integer(arg2)) && (integer(arg2) < S7_INT32_MAX) && (integer(arg2) > S7_INT32_MIN))
+	return(sc->leq_xi);
+      return(sc->leq_2);
+    }
+  if ((args == 3) && (is_t_integer(cadr(expr))))
+    return(sc->leq_ixx);
+  return(f);
+}
+
+
+/* ---------------------------------------- > ---------------------------------------- */
+static bool gt_out_x(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  if (has_active_methods(sc, x))
+    return(find_and_apply_method(sc, x, sc->gt_symbol, list_2(sc, x, y)) != sc->F); /* not plist */
+  wrong_type_error_nr(sc, sc->gt_symbol, 1, x, sc->type_names[T_REAL]);
+  return(false);
+}
+
+static bool gt_out_y(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  if (has_active_methods(sc, y))
+    return(find_and_apply_method(sc, y, sc->gt_symbol, list_2(sc, x, y)) != sc->F);
+  wrong_type_error_nr(sc, sc->gt_symbol, 2, y, sc->type_names[T_REAL]);
+  return(false);
+}
+
+static bool gt_b_7pp(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  if (type(x) == type(y))
+    {
+      if (is_t_integer(x))
+	return(integer(x) > integer(y));
+      if (is_t_real(x))
+	return(real(x) > real(y));
+      if (is_t_ratio(x))
+	return(fraction(x) > fraction(y));
+#if WITH_GMP
+      if (is_t_big_integer(x))
+	return(mpz_cmp(big_integer(x), big_integer(y)) > 0);
+      if (is_t_big_ratio(x))
+	return(mpq_cmp(big_ratio(x), big_ratio(y)) > 0);
+      if (is_t_big_real(x))
+	return(mpfr_greater_p(big_real(x), big_real(y)));
+#endif
+    }
+  switch (type(x))
+    {
+    case T_INTEGER:
+      switch (type(y))
+	{
+	case T_RATIO:	return(integer(x) > fraction(y)); /* ?? */
+	case T_REAL:	return(integer(x) > real(y));
+#if WITH_GMP
+	case T_BIG_INTEGER: return(mpz_cmp_si(big_integer(y), integer(x)) < 0);
+	case T_BIG_RATIO:   return(mpq_cmp_si(big_ratio(y), integer(x), 1) < 0);
+	case T_BIG_REAL:    return(mpfr_cmp_si(big_real(y), integer(x)) < 0);
+#endif
+	default: return(gt_out_y(sc, x, y));
+	}
+      break;
+
+    case T_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER: return(fraction(x) > integer(y));
+	case T_REAL:    return(fraction(x) > real(y));
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  return(mpq_cmp_z(sc->mpq_1, big_integer(y)) > 0);
+	case T_BIG_RATIO:
+	  return(mpq_cmp_si(big_ratio(y), numerator(x), denominator(x)) < 0);
+	case T_BIG_REAL:
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  return(mpfr_cmp_q(big_real(y), sc->mpq_1) < 0);
+#endif
+	default: return(gt_out_y(sc, x, y));
+	}
+
+    case T_REAL:
+      switch (type(y))
+	{
+	case T_INTEGER: return(real(x) > integer(y));
+	case T_RATIO:	return(real(x) > fraction(y));
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  if (is_NaN(real(x))) return(false);
+	  mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	  return(mpfr_cmp_z(sc->mpfr_1, big_integer(y)) > 0);
+	case T_BIG_RATIO:
+	  mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	  return(mpfr_cmp_q(sc->mpfr_1, big_ratio(y)) > 0);
+	case T_BIG_REAL:
+	  return(mpfr_cmp_d(big_real(y), real(x)) < 0);
+#endif
+	default: return(gt_out_y(sc, x, y));
+	}
+      break;
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(mpz_cmp_si(big_integer(x), integer(y)) > 0);
+	case T_RATIO:
+	  mpq_set_z(sc->mpq_1, big_integer(x));
+	  return(mpq_cmp_si(sc->mpq_1, numerator(y), denominator(y)) > 0);
+	case T_REAL:
+	  if (is_NaN(real(y))) return(false);
+	  mpfr_set_z(sc->mpfr_1, big_integer(x), MPFR_RNDN);
+	  return(mpfr_cmp_d(sc->mpfr_1, real(y)) > 0);
+	case T_BIG_RATIO:
+	  return(mpq_cmp_z(big_ratio(y), big_integer(x)) < 0);
+	case T_BIG_REAL:
+	  return(mpfr_cmp_z(big_real(y), big_integer(x)) < 0);
+	default: return(gt_out_y(sc, x, y));
+	}
+    case T_BIG_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(mpq_cmp_si(big_ratio(x), integer(y), 1) > 0);
+	case T_RATIO:
+	  return(mpq_cmp_si(big_ratio(x), numerator(y), denominator(y)) > 0);
+	case T_REAL:
+	  if (is_NaN(real(y))) return(false);
+	  mpfr_set_q(sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+	  return(mpfr_cmp_d(sc->mpfr_1, real(y)) > 0);
+	case T_BIG_INTEGER:
+	  return(mpq_cmp_z(big_ratio(x), big_integer(y)) > 0);
+	case T_BIG_REAL:
+	  return(mpfr_cmp_q(big_real(y), big_ratio(x)) < 0);
+	default: return(gt_out_y(sc, x, y));
+	}
+    case T_BIG_REAL:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(mpfr_cmp_si(big_real(x), integer(y)) > 0);
+	case T_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  return(mpfr_cmp_q(big_real(x), sc->mpq_1) > 0);
+	case T_REAL:
+	  return(mpfr_cmp_d(big_real(x), real(y)) > 0);
+	case T_BIG_INTEGER:
+	  return(mpfr_cmp_z(big_real(x), big_integer(y)) > 0);
+	case T_BIG_RATIO:
+	  return(mpfr_cmp_q(big_real(x), big_ratio(y)) > 0);
+	default: return(gt_out_y(sc, x, y));
+	}
+#endif
+    default: return(gt_out_x(sc, x, y));
+    }
+  return(true);
+}
+
+static s7_pointer g_greater(s7_scheme *sc, s7_pointer args)
+{
+  #define H_greater "(> x1 ...) returns #t if its arguments are in decreasing order"
+  #define Q_greater s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_real_symbol)
+
+  s7_pointer x = car(args), p = cdr(args);
+
+  if (is_null(cdr(p)))
+    return(make_boolean(sc, gt_b_7pp(sc, x, car(p))));
+
+  for (; is_pair(p); x = car(p), p = cdr(p))
+    if (!gt_b_7pp(sc, x, car(p)))
+      {
+	for (p = cdr(p); is_pair(p); p = cdr(p))
+	  if (!is_real_via_method(sc, car(p)))
+	    wrong_type_error_nr(sc, sc->gt_symbol, position_of(p, args), car(p), sc->type_names[T_REAL]);
+	return(sc->F);
+      }
+  return(sc->T);
+}
+
+static s7_pointer g_greater_xi(s7_scheme *sc, s7_pointer args)
+{
+  s7_int y = integer(cadr(args));
+  s7_pointer x = car(args);
+
+  if (is_t_integer(x))
+    return(make_boolean(sc, integer(x) > y));
+  if (is_t_real(x))
+    return(make_boolean(sc, real(x) > y));
+  if (is_t_ratio(x))
+    return(make_boolean(sc, !ratio_leq_pi(x, y)));
+#if WITH_GMP
+  if (is_t_big_integer(x))
+    return(make_boolean(sc, mpz_cmp_si(big_integer(x), y) > 0));
+  if (is_t_big_real(x))
+    return(make_boolean(sc, mpfr_cmp_si(big_real(x), y) > 0));
+  if (is_t_big_ratio(x))
+    return(make_boolean(sc, mpq_cmp_si(big_ratio(x), y, 1) > 0));
+#endif
+  return(method_or_bust(sc, x, sc->gt_symbol, args, a_number_string, 1));
+}
+
+static s7_pointer g_greater_xf(s7_scheme *sc, s7_pointer args)
+{
+  s7_double y = real(cadr(args));
+  s7_pointer x = car(args);
+
+  if (is_t_real(x))
+    return(make_boolean(sc, real(x) > y));
+
+  switch (type(x))
+    {
+    case T_INTEGER: return(make_boolean(sc, integer(x) > y));
+
+    case T_RATIO:
+      /* (> 9223372036854775807/9223372036854775806 1.0) */
+      if (denominator(x) < S7_INT32_MAX) /* y range check was handled in greater_chooser */
+	return(make_boolean(sc, (numerator(x) > (y * denominator(x)))));
+      return(make_boolean(sc, fraction(x) > y));
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpfr_set_d(sc->mpfr_1, y, MPFR_RNDN);
+      return(make_boolean(sc, mpfr_cmp_z(sc->mpfr_1, big_integer(x)) < 0));
+    case T_BIG_RATIO:
+      mpfr_set_d(sc->mpfr_1, y, MPFR_RNDN);
+      return(make_boolean(sc, mpfr_cmp_q(sc->mpfr_1, big_ratio(x)) < 0));
+    case T_BIG_REAL:
+      return(make_boolean(sc, mpfr_cmp_d(big_real(x), y) > 0));
+#endif
+    default:
+      return(method_or_bust(sc, x, sc->gt_symbol, args, a_number_string, 1));
+    }
+  return(sc->T);
+}
+
+static inline s7_pointer gt_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) {return(make_boolean(sc, gt_b_7pp(sc, p1, p2)));}
+static bool gt_b_ii(s7_int i1, s7_int i2) {return(i1 > i2);}
+static bool gt_b_dd(s7_double i1, s7_double i2) {return(i1 > i2);}
+static s7_pointer gt_p_dd(s7_scheme *sc, s7_double x1, s7_double x2) {return(make_boolean(sc, x1 > x2));}
+static s7_pointer gt_p_ii(s7_scheme *sc, s7_int x1, s7_int x2) {return(make_boolean(sc, x1 > x2));}
+
+static bool gt_b_pi(s7_scheme *sc, s7_pointer p1, s7_int p2)
+{
+  if (is_t_integer(p1)) return(integer(p1) > p2);
+  if (is_t_real(p1))  return(real(p1) > p2);
+  if (is_t_ratio(p1)) return(!ratio_leq_pi(p1, p2));
+#if WITH_GMP
+  if (is_t_big_integer(p1))
+    return(mpz_cmp_si(big_integer(p1), p2) > 0);
+  if (is_t_big_real(p1))
+    return(mpfr_cmp_si(big_real(p1), p2) > 0);
+  if (is_t_big_ratio(p1))
+    return(mpq_cmp_si(big_ratio(p1), p2, 1) > 0);
+#endif
+  return(gt_out_x(sc, p1, make_integer(sc, p2)));
+}
+
+static s7_pointer gt_p_pi(s7_scheme *sc, s7_pointer p1, s7_int p2) {return(make_boolean(sc, gt_b_pi(sc, p1, p2)));}
+
+static s7_pointer g_greater_2(s7_scheme *sc, s7_pointer args)
+{
+  /* ridiculous repetition, but overheads are killing this poor thing */
+  s7_pointer x = car(args), y = cadr(args);
+  if (type(x) == type(y))
+    {
+      if (is_t_integer(x)) return(make_boolean(sc, integer(x) > integer(y)));
+      if (is_t_real(x))    return(make_boolean(sc, real(x) > real(y)));
+      if (is_t_ratio(x))   return(make_boolean(sc, fraction(x) > fraction(y)));
+    }
+  switch (type(x))
+    {
+    case T_INTEGER:
+      switch (type(y))
+	{
+	case T_RATIO:   return(gt_p_pp(sc, x, y));
+	case T_REAL:    return(make_boolean(sc, integer(x) > real(y)));
+#if WITH_GMP
+	case T_BIG_INTEGER: case T_BIG_RATIO: case T_BIG_REAL:
+	  return(gt_p_pp(sc, x, y));
+#endif
+	default:        return(make_boolean(sc, gt_out_y(sc, x, y)));
+	}
+      break;
+
+    case T_RATIO:       return(gt_p_pp(sc, x, y));
+
+    case T_REAL:
+      switch (type(y))
+	{
+	case T_INTEGER: return(make_boolean(sc, real(x) > integer(y)));
+	case T_RATIO:   return(make_boolean(sc, real(x) > fraction(y)));
+#if WITH_GMP
+	case T_BIG_INTEGER: case T_BIG_RATIO: case T_BIG_REAL:
+	  return(gt_p_pp(sc, x, y));
+#endif
+	default:        return(make_boolean(sc, gt_out_y(sc, x, y)));
+	}
+      break;
+#if WITH_GMP
+    case T_BIG_INTEGER: case T_BIG_RATIO: case T_BIG_REAL:
+      return(gt_p_pp(sc, x, y));
+#endif
+
+    default:            return(make_boolean(sc, gt_out_x(sc, x, y)));
+    }
+  return(sc->T);
+}
+
+static s7_pointer greater_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  s7_pointer arg2;
+  if (args != 2) return(f);
+  arg2 = caddr(expr);
+  if ((is_t_integer(arg2)) && (integer(arg2) < S7_INT32_MAX) && (integer(arg2) > S7_INT32_MIN))
+    return(sc->greater_xi);
+  if ((is_t_real(arg2)) && (real(arg2) < S7_INT32_MAX) && (real(arg2) > S7_INT32_MIN))
+    return(sc->greater_xf);
+  return(sc->greater_2);
+}
+
+
+/* ---------------------------------------- >= ---------------------------------------- */
+static bool geq_out_x(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  if (!has_active_methods(sc, x))
+    wrong_type_error_nr(sc, sc->geq_symbol, 1, x, sc->type_names[T_REAL]);
+  return(find_and_apply_method(sc, x, sc->geq_symbol, list_2(sc, x, y)) != sc->F);   /* not plist */
+}
+
+static bool geq_out_y(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  if (!has_active_methods(sc, y))
+    wrong_type_error_nr(sc, sc->geq_symbol, 2, y, sc->type_names[T_REAL]);
+  return(find_and_apply_method(sc, y, sc->geq_symbol, list_2(sc, x, y)) != sc->F);   /* not plist */
+}
+
+static bool geq_b_7pp(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  if (type(x) == type(y))
+    {
+      if (is_t_integer(x))
+	return(integer(x) >= integer(y));
+      if (is_t_real(x))
+	return(real(x) >= real(y));
+      if (is_t_ratio(x))
+	return(fraction(x) >= fraction(y));
+#if WITH_GMP
+      if (is_t_big_integer(x))
+	return(mpz_cmp(big_integer(x), big_integer(y)) >= 0);
+      if (is_t_big_ratio(x))
+	return(mpq_cmp(big_ratio(x), big_ratio(y)) >= 0);
+      if (is_t_big_real(x))
+	return(mpfr_greaterequal_p(big_real(x), big_real(y)));
+#endif
+    }
+  switch (type(x))
+    {
+    case T_INTEGER:
+      switch (type(y))
+	{
+	case T_RATIO:	return(integer(x) >= fraction(y)); /* ?? */
+	case T_REAL:	return(integer(x) >= real(y));
+#if WITH_GMP
+	case T_BIG_INTEGER: return(mpz_cmp_si(big_integer(y), integer(x)) <= 0);
+	case T_BIG_RATIO:   return(mpq_cmp_si(big_ratio(y), integer(x), 1) <= 0);
+	case T_BIG_REAL:
+	  return((!mpfr_nan_p(big_real(y))) && (mpfr_cmp_si(big_real(y), integer(x)) <= 0));
+#endif
+	default: return(geq_out_y(sc, x, y));
+	}
+      break;
+
+    case T_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER: return(fraction(x) >= integer(y));
+	case T_REAL:    return(fraction(x) >= real(y));
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  return(mpq_cmp_z(sc->mpq_1, big_integer(y)) >= 0);
+	case T_BIG_RATIO:
+	  return(mpq_cmp_si(big_ratio(y), numerator(x), denominator(x)) <= 0);
+	case T_BIG_REAL:
+	  if (mpfr_nan_p(big_real(y))) return(false);
+	  mpq_set_si(sc->mpq_1, numerator(x), denominator(x));
+	  return(mpfr_cmp_q(big_real(y), sc->mpq_1) <= 0);
+#endif
+	default: return(geq_out_y(sc, x, y));
+	}
+
+    case T_REAL:
+      switch (type(y))
+	{
+	case T_INTEGER: return(real(x) >= integer(y));
+	case T_RATIO:	return(real(x) >= fraction(y));
+#if WITH_GMP
+	case T_BIG_INTEGER:
+	  if (is_NaN(real(x))) return(false);
+	  mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	  return(mpfr_cmp_z(sc->mpfr_1, big_integer(y)) >= 0);
+	case T_BIG_RATIO:
+	  if (is_NaN(real(x))) return(false);
+	  mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+	  return(mpfr_cmp_q(sc->mpfr_1, big_ratio(y)) >= 0);
+	case T_BIG_REAL:
+	  if (is_NaN(real(x))) return(false);
+	  return((!mpfr_nan_p(big_real(y))) && (mpfr_cmp_d(big_real(y), real(x)) <= 0));
+#endif
+	default: return(geq_out_y(sc, x, y));
+	}
+      break;
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(mpz_cmp_si(big_integer(x), integer(y)) >= 0);
+	case T_RATIO:
+	  mpq_set_z(sc->mpq_1, big_integer(x));
+	  return(mpq_cmp_si(sc->mpq_1, numerator(y), denominator(y)) >= 0);
+	case T_REAL:
+	  if (is_NaN(real(y))) return(false);
+	  mpfr_set_z(sc->mpfr_1, big_integer(x), MPFR_RNDN);
+	  return(mpfr_cmp_d(sc->mpfr_1, real(y)) >= 0);
+	case T_BIG_RATIO:
+	  return(mpq_cmp_z(big_ratio(y), big_integer(x)) <= 0);
+	case T_BIG_REAL:
+	  return((!mpfr_nan_p(big_real(y))) && (mpfr_cmp_z(big_real(y), big_integer(x)) <= 0));
+	default: return(geq_out_y(sc, x, y));
+	}
+    case T_BIG_RATIO:
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(mpq_cmp_si(big_ratio(x), integer(y), 1) >= 0);
+	case T_RATIO:
+	  return(mpq_cmp_si(big_ratio(x), numerator(y), denominator(y)) >= 0);
+	case T_REAL:
+	  if (is_NaN(real(y))) return(false);
+	  mpfr_set_q(sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+	  return(mpfr_cmp_d(sc->mpfr_1, real(y)) >= 0);
+	case T_BIG_INTEGER:
+	  return(mpq_cmp_z(big_ratio(x), big_integer(y)) >= 0);
+	case T_BIG_REAL:
+	  return((!mpfr_nan_p(big_real(y))) && (mpfr_cmp_q(big_real(y), big_ratio(x)) <= 0));
+	default: return(geq_out_y(sc, x, y));
+	}
+
+    case T_BIG_REAL:
+      if ((is_real(y)) && (mpfr_nan_p(big_real(x)))) return(false);
+      switch (type(y))
+	{
+	case T_INTEGER:
+	  return(mpfr_cmp_si(big_real(x), integer(y)) >= 0);
+	case T_RATIO:
+	  mpq_set_si(sc->mpq_1, numerator(y), denominator(y));
+	  return(mpfr_cmp_q(big_real(x), sc->mpq_1) >= 0);
+	case T_REAL:
+	  return((!is_NaN(real(y))) && (mpfr_cmp_d(big_real(x), real(y)) >= 0));
+	case T_BIG_INTEGER:
+	  return(mpfr_cmp_z(big_real(x), big_integer(y)) >= 0);
+	case T_BIG_RATIO:
+	  return(mpfr_cmp_q(big_real(x), big_ratio(y)) >= 0);
+	default: return(geq_out_y(sc, x, y));
+	}
+#endif
+    default: return(geq_out_x(sc, x, y));
+    }
+  return(true);
+}
+
+static s7_pointer g_greater_or_equal(s7_scheme *sc, s7_pointer args)
+{
+  #define H_greater_or_equal "(>= x1 ...) returns #t if its arguments are in non-increasing order"
+  #define Q_greater_or_equal s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_real_symbol)
+
+  s7_pointer x = car(args), p = cdr(args);
+  if (is_null(cdr(p)))
+    return(make_boolean(sc, geq_b_7pp(sc, x, car(p))));
+
+  for (; is_pair(p); x = car(p), p = cdr(p))
+    if (!geq_b_7pp(sc, x, car(p)))
+      {
+	for (p = cdr(p); is_pair(p); p = cdr(p))
+	  if (!is_real_via_method(sc, car(p)))
+	    wrong_type_error_nr(sc, sc->geq_symbol, position_of(p, args), car(p), sc->type_names[T_REAL]);
+	return(sc->F);
+      }
+  return(sc->T);
+}
+
+static inline s7_pointer geq_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) {return(make_boolean(sc, geq_b_7pp(sc, p1, p2)));}
+static bool geq_b_ii(s7_int i1, s7_int i2) {return(i1 >= i2);}
+static bool geq_b_dd(s7_double i1, s7_double i2) {return(i1 >= i2);}
+static s7_pointer geq_p_dd(s7_scheme *sc, s7_double x1, s7_double x2) {return(make_boolean(sc, x1 >= x2));}
+static s7_pointer geq_p_ii(s7_scheme *sc, s7_int x1, s7_int x2) {return(make_boolean(sc, x1 >= x2));}
+
+static s7_pointer g_geq_2(s7_scheme *sc, s7_pointer args) {return(make_boolean(sc, geq_b_7pp(sc, car(args), cadr(args))));}
+
+static s7_pointer g_geq_xf(s7_scheme *sc, s7_pointer args)
+{
+  s7_double y = real(cadr(args));
+  s7_pointer x = car(args);
+  return(make_boolean(sc, ((is_t_real(x)) ? (real(x) >= y) : geq_b_7pp(sc, car(args), cadr(args)))));
+}
+
+static s7_pointer g_geq_xi(s7_scheme *sc, s7_pointer args)
+{
+  s7_int y = integer(cadr(args));
+  s7_pointer x = car(args);
+
+  if (is_t_integer(x))
+    return(make_boolean(sc, integer(x) >= y));
+  if (is_t_real(x))
+    return(make_boolean(sc, real(x) >= y));
+  if (is_t_ratio(x))
+    return(make_boolean(sc, !ratio_lt_pi(x, y)));
+#if WITH_GMP
+  if (is_t_big_integer(x))
+    return(make_boolean(sc, mpz_cmp_si(big_integer(x), y) >= 0));
+  if (is_t_big_real(x))
+    {
+      if (mpfr_nan_p(big_real(x))) return(sc->F);
+      return(make_boolean(sc, mpfr_cmp_si(big_real(x), y) >= 0));
+    }
+  if (is_t_big_ratio(x))
+    return(make_boolean(sc, mpq_cmp_si(big_ratio(x), y, 1) >= 0));
+#endif
+  return(method_or_bust(sc, x, sc->geq_symbol, args, sc->type_names[T_REAL], 1));
+}
+
+static bool geq_b_pi(s7_scheme *sc, s7_pointer p1, s7_int p2)
+{
+  if (is_t_integer(p1)) return(integer(p1) >= p2);
+  if (is_t_real(p1))  return(real(p1) >= p2);
+  if (is_t_ratio(p1)) return(!ratio_lt_pi(p1, p2));
+#if WITH_GMP
+  if (is_t_big_integer(p1))
+    return(mpz_cmp_si(big_integer(p1), p2) >= 0);
+  if (is_t_big_real(p1))
+    return((!mpfr_nan_p(big_real(p1))) && (mpfr_cmp_si(big_real(p1), p2) >= 0));
+  if (is_t_big_ratio(p1))
+    return(mpq_cmp_si(big_ratio(p1), p2, 1) >= 0);
+#endif
+  if (!has_active_methods(sc, p1))
+    wrong_type_error_nr(sc, sc->geq_symbol, 1, p1, sc->type_names[T_REAL]);
+  return(find_and_apply_method(sc, p1, sc->geq_symbol, list_2(sc, p1, make_integer(sc, p2))));   /* not plist */
+}
+
+static s7_pointer geq_p_pi(s7_scheme *sc, s7_pointer p1, s7_int p2) {return(make_boolean(sc, geq_b_pi(sc, p1, p2)));}
+
+static s7_pointer geq_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  s7_pointer arg2;
+  if (args != 2) return(f);
+  arg2 = caddr(expr);
+  if ((is_t_integer(arg2)) && (integer(arg2) < S7_INT32_MAX) && (integer(arg2) > S7_INT32_MIN))
+    return(sc->geq_xi);
+  if ((is_t_real(arg2)) && (real(arg2) < S7_INT32_MAX) && (real(arg2) > S7_INT32_MIN))
+    return(sc->geq_xf);
+  return(sc->geq_2);
+}
+
+
+/* ---------------------------------------- real-part ---------------------------------------- */
+s7_double s7_real_part(s7_pointer x)
+{
+  switch(type(x))
+    {
+    case T_INTEGER:     return((s7_double)integer(x));
+    case T_RATIO:       return(fraction(x));
+    case T_REAL:        return(real(x));
+    case T_COMPLEX:     return(real_part(x));
+#if WITH_GMP
+    case T_BIG_INTEGER: return((s7_double)mpz_get_si(big_integer(x)));
+    case T_BIG_RATIO:   return((s7_double)((long_double)mpz_get_si(mpq_numref(big_ratio(x))) /
+					   (long_double)mpz_get_si(mpq_denref(big_ratio(x)))));
+    case T_BIG_REAL:    return((s7_double)mpfr_get_d(big_real(x), MPFR_RNDN));
+    case T_BIG_COMPLEX: return((s7_double)mpfr_get_d(mpc_realref(big_complex(x)), MPFR_RNDN));
+#endif
+    }
+  return(0.0);
+}
+
+static s7_double real_part_d_p(s7_pointer x)
+{
+  if (is_number(x)) return(s7_real_part(x));
+  sole_arg_wrong_type_error_nr(cur_sc, cur_sc->real_part_symbol, x, a_number_string);
+#ifdef __TINYC__
+  return(0.0);
+#endif
+}
+
+static s7_pointer real_part_p_p(s7_scheme *sc, s7_pointer p)
+{
+  if (is_t_complex(p)) return(make_real(sc, real_part(p)));
+  switch (type(p))
+    {
+    case T_INTEGER: case T_RATIO: case T_REAL:
+      return(p);
+#if WITH_GMP
+    case T_BIG_INTEGER: case T_BIG_RATIO: case T_BIG_REAL:
+      return(p);
+    case T_BIG_COMPLEX:
+      {
+	s7_pointer x;
+	new_cell(sc, x, T_BIG_REAL);
+	big_real_bgf(x) = alloc_bigflt(sc);
+	add_big_real(sc, x);
+	mpc_real(big_real(x), big_complex(p), MPFR_RNDN);
+	return(x);
+      }
+#endif
+    default:
+      return(method_or_bust_p(sc, p, sc->real_part_symbol, a_number_string));
+    }
+}
+
+static s7_pointer g_real_part(s7_scheme *sc, s7_pointer args)
+{
+  #define H_real_part "(real-part num) returns the real part of num"
+  #define Q_real_part s7_make_signature(sc, 2, sc->is_real_symbol, sc->is_number_symbol)
+  return(real_part_p_p(sc, car(args)));
+}
+
+
+/* ---------------------------------------- imag-part ---------------------------------------- */
+s7_double s7_imag_part(s7_pointer x)
+{
+  if (is_t_complex(x))
+    return(imag_part(x));
+#if WITH_GMP
+  if (is_t_big_complex(x))
+    return((s7_double)mpfr_get_d(mpc_imagref(big_complex(x)), MPFR_RNDN));
+#endif
+  return(0.0);
+}
+
+static s7_double imag_part_d_p(s7_pointer x)
+{
+  if (is_number(x)) return(s7_imag_part(x));
+  sole_arg_wrong_type_error_nr(cur_sc, cur_sc->imag_part_symbol, x, a_number_string);
+#ifdef __TINYC__
+  return(0.0);
+#endif
+}
+
+static s7_pointer imag_part_p_p(s7_scheme *sc, s7_pointer p)
+{
+  if (is_t_complex(p)) return(make_real(sc, imag_part(p)));
+  switch (type(p))
+    {
+    case T_INTEGER: case T_RATIO:
+      return(int_zero);
+    case T_REAL:
+      return(real_zero);
+#if WITH_GMP
+    case T_BIG_INTEGER: case T_BIG_RATIO:
+      return(int_zero);
+    case T_BIG_REAL:
+      return(real_zero);
+    case T_BIG_COMPLEX:
+      {
+	s7_pointer x;
+	new_cell(sc, x, T_BIG_REAL);
+	big_real_bgf(x) = alloc_bigflt(sc);
+	add_big_real(sc, x);
+	mpc_imag(big_real(x), big_complex(p), MPFR_RNDN);
+	return(x);
+      }
+#endif
+    default:
+      return(method_or_bust_p(sc, p, sc->imag_part_symbol, a_number_string));
+    }
+}
+
+static s7_pointer g_imag_part(s7_scheme *sc, s7_pointer args)
+{
+  #define H_imag_part "(imag-part num) returns the imaginary part of num"
+  #define Q_imag_part s7_make_signature(sc, 2, sc->is_real_symbol, sc->is_number_symbol)
+  /* currently (imag-part +nan.0) -> 0.0 ? it's true but maybe confusing */
+  return(imag_part_p_p(sc, car(args)));
+}
+
+
+/* ---------------------------------------- numerator denominator ---------------------------------------- */
+static s7_int numerator_i_7p(s7_scheme *sc, s7_pointer p)
+{
+  if (is_t_ratio(p)) return(numerator(p));
+  if (is_t_integer(p)) return(integer(p));
+#if WITH_GMP
+  if (is_t_big_ratio(p)) return(mpz_get_si(mpq_numref(big_ratio(p))));
+  if (is_t_big_integer(p)) return(mpz_get_si(big_integer(p)));
+#endif
+  return(integer(method_or_bust_p(sc, p, sc->numerator_symbol, a_rational_string)));
+}
+
+static s7_pointer g_numerator(s7_scheme *sc, s7_pointer args)
+{
+  #define H_numerator "(numerator rat) returns the numerator of the rational number rat"
+  #define Q_numerator s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_rational_symbol)
+
+  s7_pointer x = car(args);
+  switch (type(x))
+    {
+    case T_RATIO:       return(make_integer(sc, numerator(x)));
+    case T_INTEGER:     return(x);
+#if WITH_GMP
+    case T_BIG_INTEGER: return(x);
+    case T_BIG_RATIO:   return(mpz_to_integer(sc, mpq_numref(big_ratio(x))));
+#endif
+    default:            return(method_or_bust_p(sc, x, sc->numerator_symbol, a_rational_string));
+    }
+}
+
+
+static s7_pointer g_denominator(s7_scheme *sc, s7_pointer args)
+{
+  #define H_denominator "(denominator rat) returns the denominator of the rational number rat"
+  #define Q_denominator s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_rational_symbol)
+
+  s7_pointer x = car(args);
+  switch (type(x))
+    {
+    case T_RATIO:       return(make_integer(sc, denominator(x)));
+    case T_INTEGER:     return(int_one);
+#if WITH_GMP
+    case T_BIG_INTEGER: return(int_one);
+    case T_BIG_RATIO:   return(mpz_to_integer(sc, mpq_denref(big_ratio(x))));
+#endif
+    default:            return(method_or_bust_p(sc, x, sc->denominator_symbol, a_rational_string));
+    }
+}
+
+static s7_int denominator_i_7p(s7_scheme *sc, s7_pointer p)
+{
+  if (is_t_ratio(p)) return(denominator(p));
+  if (is_t_integer(p)) return(1);
+#if WITH_GMP
+  if (is_t_big_ratio(p)) return(mpz_get_si(mpq_denref(big_ratio(p))));
+  if (is_t_big_integer(p)) return(1);
+#endif
+  return(integer(method_or_bust_p(sc, p, sc->denominator_symbol, a_rational_string)));
+}
+
+
+/* ---------------------------------------- number? bignum? complex? integer? byte? rational? real?  ---------------------------------------- */
+static s7_pointer g_is_number(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_number "(number? obj) returns #t if obj is a number"
+  #define Q_is_number sc->pl_bt
+  check_boolean_method(sc, is_number, sc->is_number_symbol, args);
+}
+
+bool s7_is_bignum(s7_pointer obj) {return(is_big_number(obj));}
+
+static s7_pointer g_is_bignum(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_bignum "(bignum? obj) returns #t if obj is a multiprecision number."
+  #define Q_is_bignum sc->pl_bt
+  return(make_boolean(sc, is_big_number(car(args))));
+}
+
+static s7_pointer g_is_integer(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_integer "(integer? obj) returns #t if obj is an integer"
+  #define Q_is_integer sc->pl_bt
+  check_boolean_method(sc, s7_is_integer, sc->is_integer_symbol, args);
+}
+
+static bool is_byte(s7_pointer p) {return((s7_is_integer(p)) && (s7_integer(p) >= 0) && (s7_integer(p) < 256));}
+static s7_pointer g_is_byte(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_byte "(byte? obj) returns #t if obj is a byte (an integer between 0 and 255)"
+  #define Q_is_byte sc->pl_bt
+  check_boolean_method(sc, is_byte, sc->is_byte_symbol, args);
+}
+
+static s7_pointer g_is_real(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_real "(real? obj) returns #t if obj is a real number"
+  #define Q_is_real sc->pl_bt
+  check_boolean_method(sc, is_real, sc->is_real_symbol, args);
+}
+
+static s7_pointer g_is_complex(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_complex "(complex? obj) returns #t if obj is a number"
+  #define Q_is_complex sc->pl_bt
+  check_boolean_method(sc, is_number, sc->is_complex_symbol, args);
+}
+
+static s7_pointer g_is_rational(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_rational "(rational? obj) returns #t if obj is a rational number (either an integer or a ratio)"
+  #define Q_is_rational sc->pl_bt
+  check_boolean_method(sc, is_rational, sc->is_rational_symbol, args);
+  /* in the non-gmp case, (rational? 455702434782048082459/86885567283849955830) -> #f, not #t, and similarly for exact? etc */
+}
+
+static s7_pointer g_is_float(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_float "(float? x) returns #t is x is real and not rational."
+  #define Q_is_float sc->pl_bt
+  s7_pointer p = car(args);
+#if WITH_GMP
+  return(make_boolean(sc, (is_t_real(p)) || (is_t_big_real(p)))); /* (float? pi) */
+#else
+  return(make_boolean(sc, is_t_real(p)));
+#endif
+}
+
+#if WITH_GMP
+static bool is_float_b(s7_pointer p) {return((is_t_real(p)) || (is_t_big_real(p)));}
+#else
+static bool is_float_b(s7_pointer p) {return(is_t_real(p));}
+#endif
+
+
+/* ---------------------------------------- nan? ---------------------------------------- */
+static bool is_nan_b_7p(s7_scheme *sc, s7_pointer x)
+{
+  if (is_t_real(x)) return(is_NaN(real(x)));
+  switch (type(x))
+    {
+    case T_INTEGER:
+    case T_RATIO:   return(false);
+    /* case T_REAL:    return(is_NaN(real(x))); */
+    case T_COMPLEX: return((is_NaN(real_part(x))) || (is_NaN(imag_part(x))));
+#if WITH_GMP
+    case T_BIG_INTEGER:
+    case T_BIG_RATIO:   return(false);
+    case T_BIG_REAL:    return(mpfr_nan_p(big_real(x)) != 0);
+    case T_BIG_COMPLEX: return((mpfr_nan_p(mpc_realref(big_complex(x))) != 0) || (mpfr_nan_p(mpc_imagref(big_complex(x))) != 0));
+#endif
+    default:
+      if (is_number(x))
+	return(method_or_bust_p(sc, x, sc->is_nan_symbol, a_number_string) != sc->F);
+    }
+  return(false);
+}
+
+static s7_pointer g_is_nan(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_nan "(nan? obj) returns #t if obj is a NaN"
+  #define Q_is_nan sc->pl_bt
+  return(make_boolean(sc, is_nan_b_7p(sc, car(args))));
+}
+
+
+/* ---------------------------------------- infinite? ---------------------------------------- */
+static bool is_infinite_b_7p(s7_scheme *sc, s7_pointer x)
+{
+  switch (type(x))
+    {
+    case T_INTEGER:
+    case T_RATIO:    return(false);
+    case T_REAL:     return(is_inf(real(x)));
+    case T_COMPLEX:  return((is_inf(real_part(x))) || (is_inf(imag_part(x))));
+#if WITH_GMP
+    case T_BIG_INTEGER:
+    case T_BIG_RATIO: return(false);
+    case T_BIG_REAL:  return(mpfr_inf_p(big_real(x)) != 0);
+    case T_BIG_COMPLEX:
+      return((mpfr_inf_p(mpc_realref(big_complex(x))) != 0) ||
+	     (mpfr_inf_p(mpc_imagref(big_complex(x))) != 0));
+#endif
+    default:
+      if (is_number(x))
+	return(method_or_bust_p(sc, x, sc->is_infinite_symbol, a_number_string) != sc->F);
+    }
+  return(false);
+}
+
+static s7_pointer g_is_infinite(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_infinite "(infinite? obj) returns #t if obj is an infinite real"
+  #define Q_is_infinite sc->pl_bt
+  return(make_boolean(sc, is_infinite_b_7p(sc, car(args))));
+}
+
+
+/* ---------------------------------------- even? odd?---------------------------------------- */
+static bool is_even_b_7p(s7_scheme *sc, s7_pointer p)
+{
+  if (is_t_integer(p))
+    return((integer(p) & 1) == 0);
+#if WITH_GMP
+  if (is_t_big_integer(p))
+    return(mpz_even_p(big_integer(p)));
+#endif
+  return(method_or_bust_p(sc, p, sc->is_even_symbol, sc->type_names[T_INTEGER]) != sc->F);
+}
+
+static s7_pointer is_even_p_p(s7_scheme *sc, s7_pointer x)
+{
+  if (is_t_integer(x))
+    return(make_boolean(sc, (integer(x) & 1) == 0));
+  return(make_boolean(sc, is_even_b_7p(sc, x)));
+}
+
+static bool is_even_i(s7_int i1) {return((i1 & 1) == 0);}
+
+static s7_pointer g_is_even(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_even "(even? int) returns #t if the integer int32_t is even"
+  #define Q_is_even s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_integer_symbol)
+  return(make_boolean(sc, is_even_b_7p(sc, car(args))));
+}
+
+
+static bool is_odd_b_7p(s7_scheme *sc, s7_pointer p)
+{
+  if (is_t_integer(p))
+    return((integer(p) & 1) == 1);
+#if WITH_GMP
+  if (is_t_big_integer(p))
+    return(mpz_odd_p(big_integer(p)));
+#endif
+  return(method_or_bust_p(sc, p, sc->is_odd_symbol, sc->type_names[T_INTEGER]) != sc->F);
+}
+
+static s7_pointer is_odd_p_p(s7_scheme *sc, s7_pointer x)
+{
+  if (is_t_integer(x))
+    return(make_boolean(sc, (integer(x) & 1) == 1));
+  return(make_boolean(sc, is_odd_b_7p(sc, x)));
+}
+
+static bool is_odd_i(s7_int i1) {return((i1 & 1) == 1);}
+
+static s7_pointer g_is_odd(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_odd "(odd? int) returns #t if the integer int32_t is odd"
+  #define Q_is_odd s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_integer_symbol)
+  return(make_boolean(sc, is_odd_b_7p(sc, car(args))));
+}
+
+
+/* ---------------------------------------- zero? ---------------------------------------- */
+static bool is_zero(s7_pointer x)
+{
+  switch (type(x))
+    {
+    case T_INTEGER:     return(integer(x) == 0);
+    case T_REAL:        return(real(x) == 0.0);
+#if WITH_GMP
+    case T_BIG_INTEGER: return(mpz_cmp_ui(big_integer(x), 0) == 0);
+    case T_BIG_REAL:    return(mpfr_zero_p(big_real(x)));
+#endif
+    default:
+      return(false); /* ratios and complex numbers here are already collapsed into integers and reals */
+    }
+}
+
+static bool is_zero_b_7p(s7_scheme *sc, s7_pointer p)
+{
+  if (is_t_integer(p)) return(integer(p) == 0);
+  if (is_t_real(p))    return(real(p) == 0.0);
+#if WITH_GMP
+  if (is_number(p))    return(is_zero(p));
+#else
+  if (is_number(p))    return(false);
+#endif
+  return(method_or_bust_p(sc, p, sc->is_zero_symbol, a_number_string) != sc->F);
+}
+
+static s7_pointer g_is_zero(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_zero "(zero? num) returns #t if the number num is zero"
+  #define Q_is_zero sc->pl_bn
+  return(make_boolean(sc, is_zero_b_7p(sc, car(args))));
+}
+
+static s7_pointer is_zero_p_p(s7_scheme *sc, s7_pointer p) {return(make_boolean(sc, is_zero_b_7p(sc, p)));}
+static bool is_zero_i(s7_int p) {return(p == 0);}
+static bool is_zero_d(s7_double p) {return(p == 0.0);}
+
+
+/* -------------------------------- positive? -------------------------------- */
+static bool is_positive(s7_scheme *sc, s7_pointer x)
+{
+  switch (type(x))
+    {
+    case T_INTEGER:     return(integer(x) > 0);
+    case T_RATIO:       return(numerator(x) > 0);
+    case T_REAL:        return(real(x) > 0.0);
+#if WITH_GMP
+    case T_BIG_INTEGER: return(mpz_cmp_ui(big_integer(x), 0) > 0);
+    case T_BIG_RATIO:   return(mpq_cmp_ui(big_ratio(x), 0, 1) > 0);
+    case T_BIG_REAL:    return(mpfr_cmp_ui(big_real(x), 0) > 0);
+#endif
+    default:
+      sole_arg_wrong_type_error_nr(sc, sc->is_positive_symbol, x, sc->type_names[T_REAL]);
+    }
+  return(false);
+}
+
+static bool is_positive_b_7p(s7_scheme *sc, s7_pointer p)
+{
+  if (is_t_integer(p)) return(integer(p) > 0);
+  if (is_t_real(p))    return(real(p) > 0.0);
+#if WITH_GMP
+  if (is_number(p))    return(is_positive(sc, p));
+#else
+  if (is_t_ratio(p))   return(numerator(p) > 0);
+#endif
+  return(method_or_bust_p(sc, p, sc->is_positive_symbol, sc->type_names[T_REAL]) != sc->F);
+}
+
+static s7_pointer g_is_positive(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_positive "(positive? num) returns #t if the real number num is positive (greater than 0)"
+  #define Q_is_positive s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_real_symbol)
+  return(make_boolean(sc, is_positive_b_7p(sc, car(args))));
+}
+
+static s7_pointer is_positive_p_p(s7_scheme *sc, s7_pointer p) {return(make_boolean(sc, is_positive_b_7p(sc, p)));}
+static bool is_positive_i(s7_int p) {return(p > 0);}
+static bool is_positive_d(s7_double p) {return(p > 0.0);}
+
+
+/* -------------------------------- negative? -------------------------------- */
+static bool is_negative(s7_scheme *sc, s7_pointer x)
+{
+  switch (type(x))
+    {
+    case T_INTEGER:     return(integer(x) < 0);
+    case T_RATIO:       return(numerator(x) < 0);
+    case T_REAL:        return(real(x) < 0.0);
+#if WITH_GMP
+    case T_BIG_INTEGER: return(mpz_cmp_ui(big_integer(x), 0) < 0);
+    case T_BIG_RATIO:   return(mpq_cmp_ui(big_ratio(x), 0, 1) < 0);
+    case T_BIG_REAL:    return(mpfr_cmp_ui(big_real(x), 0) < 0);
+#endif
+    default:
+      sole_arg_wrong_type_error_nr(sc, sc->is_negative_symbol, x, sc->type_names[T_REAL]);
+    }
+  return(false);
+}
+
+static bool is_negative_b_7p(s7_scheme *sc, s7_pointer p)
+{
+  if (is_t_integer(p)) return(integer(p) < 0);
+  if (is_t_real(p))    return(real(p) < 0.0);
+#if WITH_GMP
+  if (is_number(p))    return(is_negative(sc, p));
+#else
+  if (is_t_ratio(p))   return(numerator(p) < 0);
+#endif
+  return(method_or_bust_p(sc, p, sc->is_negative_symbol, sc->type_names[T_REAL]) != sc->F);
+}
+
+static s7_pointer g_is_negative(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_negative "(negative? num) returns #t if the real number num is negative (less than 0)"
+  #define Q_is_negative s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_real_symbol)
+  return(make_boolean(sc, is_negative_b_7p(sc, car(args))));
+}
+
+static s7_pointer is_negative_p_p(s7_scheme *sc, s7_pointer p) {return(make_boolean(sc, is_negative_b_7p(sc, p)));}
+static bool is_negative_i(s7_int p) {return(p < 0);}
+static bool is_negative_d(s7_double p) {return(p < 0.0);}
+
+
+#if (!WITH_PURE_S7)
+/* ---------------------------------------- exact<->inexact exact? inexact? ---------------------------------------- */
+static s7_pointer exact_to_inexact_p_p(s7_scheme *sc, s7_pointer x)
+{
+  switch (type(x))
+    {
+    case T_INTEGER:
+#if WITH_GMP
+      if ((integer(x) > INT64_TO_DOUBLE_LIMIT) || (integer(x) < -INT64_TO_DOUBLE_LIMIT))
+	return(s7_number_to_big_real(sc, x));
+#endif
+      return(make_real(sc, (s7_double)(integer(x))));
+
+    case T_RATIO:
+#if WITH_GMP
+      if ((numerator(x) > INT64_TO_DOUBLE_LIMIT) || (numerator(x) < -INT64_TO_DOUBLE_LIMIT) ||
+ 	  (denominator(x) > INT64_TO_DOUBLE_LIMIT))  /* just a guess */
+	return(s7_number_to_big_real(sc, x));
+#endif
+      return(make_real(sc, (s7_double)(fraction(x))));
+
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      return(big_integer_to_big_real(sc, x));
+    case T_BIG_RATIO:
+      return(big_ratio_to_big_real(sc, x));
+#endif
+    case T_REAL:    case T_BIG_REAL:
+    case T_COMPLEX: case T_BIG_COMPLEX:
+      return(x); /* apparently (exact->inexact 1+i) is not an error */
+    default:
+      return(method_or_bust_p(sc, x, sc->exact_to_inexact_symbol, a_number_string));
+    }
+}
+
+static s7_pointer g_exact_to_inexact(s7_scheme *sc, s7_pointer args)
+{
+  #define H_exact_to_inexact "(exact->inexact num) converts num to an inexact number; (exact->inexact 3/2) = 1.5"
+  #define Q_exact_to_inexact s7_make_signature(sc, 2, sc->is_number_symbol, sc->is_number_symbol)
+  /* arg can be complex -> itself! */
+  return(exact_to_inexact_p_p(sc, car(args)));
+}
+
+static s7_pointer inexact_to_exact_p_p(s7_scheme *sc, s7_pointer x)
+{
+  switch (type(x))
+    {
+    case T_INTEGER: case T_BIG_INTEGER:
+    case T_RATIO:   case T_BIG_RATIO:
+      return(x);
+
+#if WITH_GMP
+    case T_BIG_REAL:
+      return(big_rationalize(sc, set_plist_1(sc, x)));
+#endif
+
+    case T_REAL:
+      {
+	s7_int numer = 0, denom = 1;
+	s7_double val = real(x);
+	if ((is_inf(val)) || (is_NaN(val)))
+	  sole_arg_wrong_type_error_nr(sc, sc->inexact_to_exact_symbol, x, a_normal_real_string);
+
+	if ((val > DOUBLE_TO_INT64_LIMIT) || (val < -(DOUBLE_TO_INT64_LIMIT)))
+	  {
+#if WITH_GMP
+	    return(big_rationalize(sc, set_plist_1(sc, x))); /* this can handle t_real as well as t_big_real */
+#else
+	    sole_arg_out_of_range_error_nr(sc, sc->inexact_to_exact_symbol, x, it_is_too_large_string);
+#endif
+	  }
+	/* c_rationalize limit is RATIONALIZE_LIMIT=1e12 currently so this is a tighter limit than DOUBLE_TO_INT64_LIMIT */
+	if (c_rationalize(val, sc->default_rationalize_error, &numer, &denom))
+	  return(make_ratio(sc, numer, denom));
+      }
+
+    default:
+      return(method_or_bust_p(sc, x, sc->inexact_to_exact_symbol, sc->type_names[T_REAL]));
+    }
+  return(x);
+}
+
+static s7_pointer g_inexact_to_exact(s7_scheme *sc, s7_pointer args)
+{
+  #define H_inexact_to_exact "(inexact->exact num) converts num to an exact number; (inexact->exact 1.5) = 3/2"
+  #define Q_inexact_to_exact s7_make_signature(sc, 2, sc->is_real_symbol, sc->is_real_symbol)
+  return(inexact_to_exact_p_p(sc, car(args)));
+}
+
+static s7_pointer g_is_exact(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_exact "(exact? num) returns #t if num is exact (an integer or a ratio)"
+  #define Q_is_exact sc->pl_bn
+
+  s7_pointer x = car(args);
+  switch (type(x))
+    {
+    case T_INTEGER: case T_BIG_INTEGER:
+    case T_RATIO:   case T_BIG_RATIO:
+      return(sc->T);
+    case T_REAL:    case T_BIG_REAL:
+    case T_COMPLEX: case T_BIG_COMPLEX:
+      return(sc->F);
+    default:
+      return(method_or_bust_p(sc, x, sc->is_exact_symbol, a_number_string));
+    }
+}
+
+static bool is_exact_b_7p(s7_scheme *sc, s7_pointer p)
+{
+  if (!is_number(p))
+    return(method_or_bust_p(sc, p, sc->is_exact_symbol, a_number_string) != sc->F);
+  return(is_rational(p));
+}
+
+
+static s7_pointer g_is_inexact(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_inexact "(inexact? num) returns #t if num is inexact (neither an integer nor a ratio)"
+  #define Q_is_inexact sc->pl_bn
+
+  s7_pointer x = car(args);
+  switch (type(x))
+    {
+    case T_INTEGER:  case T_BIG_INTEGER:
+    case T_RATIO:    case T_BIG_RATIO:
+      return(sc->F);
+    case T_REAL:     case T_BIG_REAL:
+    case T_COMPLEX:  case T_BIG_COMPLEX:
+      return(sc->T);
+    default:
+      return(method_or_bust_p(sc, x, sc->is_inexact_symbol, a_number_string));
+    }
+}
+
+static bool is_inexact_b_7p(s7_scheme *sc, s7_pointer p)
+{
+  if (!is_number(p))
+    return(method_or_bust_p(sc, p, sc->is_inexact_symbol, a_number_string) != sc->F);
+  return(!is_rational(p));
+}
+
+
+/* ---------------------------------------- integer-length ---------------------------------------- */
+static int32_t integer_length(s7_int a)
+{
+  if (a < 0)
+    {
+      if (a == S7_INT64_MIN) return(63);
+      a = -a;
+    }
+  if (a < 256LL) return(intlen_bits[a]); /* in gmp, sbcl and clisp (integer-length 0) is 0 */
+  if (a < 65536LL) return(8 + intlen_bits[a >> 8]);
+  if (a < 16777216LL) return(16 + intlen_bits[a >> 16]);
+  if (a < 4294967296LL) return(24 + intlen_bits[a >> 24]);
+  if (a < 1099511627776LL) return(32 + intlen_bits[a >> 32]);
+  if (a < 281474976710656LL) return(40 + intlen_bits[a >> 40]);
+  if (a < 72057594037927936LL) return(48 + intlen_bits[a >> 48]);
+  return(56 + intlen_bits[a >> 56]);
+}
+
+static s7_pointer g_integer_length(s7_scheme *sc, s7_pointer args)
+{
+  #define H_integer_length "(integer-length arg) returns the number of bits required to represent the integer 'arg': \
+(ceiling (log (if (< arg 0) (- arg) (+ arg 1)) 2))"
+  #define Q_integer_length sc->pcl_i
+
+  s7_pointer p = car(args);
+  if (is_t_integer(p))
+    {
+      s7_int x = integer(p);
+      return((x < 0) ? small_int(integer_length(-(x + 1))) : small_int(integer_length(x)));
+    }
+#if WITH_GMP
+  if (is_t_big_integer(p))
+    return(make_integer(sc, mpz_sizeinbase(big_integer(p), 2)));
+#endif
+  return(sole_arg_method_or_bust(sc, p, sc->integer_length_symbol, args, sc->type_names[T_INTEGER]));
+}
+
+static s7_int integer_length_i_i(s7_int x) {return((x < 0) ? integer_length(-(x + 1)) : integer_length(x));}
+#endif /* !pure s7 */
+
+
+/* ---------------------------------------- integer-decode-float ---------------------------------------- */
+static s7_pointer g_integer_decode_float(s7_scheme *sc, s7_pointer args)
+{
+  #define H_integer_decode_float "(integer-decode-float x) returns a list containing the significand, exponent, and \
+sign of 'x' (1 = positive, -1 = negative).  (integer-decode-float 0.0): (0 0 1)"
+  #define Q_integer_decode_float s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_float_symbol)
+
+  decode_float_t num;
+  s7_pointer x = car(args);
+  if (is_t_real(x))
+    {
+      if (real(x) == 0.0)
+	return(list_3(sc, int_zero, int_zero, int_one));
+      num.fx = (double)real(x);
+      return(list_3(sc,
+		    make_integer_unchecked(sc, (s7_int)((num.ix & 0xfffffffffffffLL) | 0x10000000000000LL)),
+		    make_integer(sc, (s7_int)(((num.ix & 0x7fffffffffffffffLL) >> 52) - 1023 - 52)),
+		    ((num.ix & 0x8000000000000000LL) != 0) ? minus_one : int_one));
+    }
+#if WITH_GMP
+  if (is_t_big_real(x))
+    {
+      mp_exp_t exp_n;
+      bool neg;
+      exp_n = mpfr_get_z_exp(sc->mpz_1, big_real(x));
+      neg = (mpz_cmp_ui(sc->mpz_1, 0) < 0);
+      if (neg) mpz_abs(sc->mpz_1, sc->mpz_1);
+      return(list_3(sc, mpz_to_integer(sc, sc->mpz_1), make_integer(sc, exp_n), (neg) ? minus_one : int_one));
+      /* not gmp: (integer-decode-float +nan.0): (6755399441055744 972 1), gmp: (integer-decode-float (bignum +nan.0)): (0 -1073741823 1) */
+    }
+#endif
+  return(method_or_bust_p(sc, x, sc->integer_decode_float_symbol, wrap_string(sc, "a non-rational real", 19)));
+}
+
+
+/* -------------------------------- logior -------------------------------- */
+#if WITH_GMP
+static s7_pointer big_logior(s7_scheme *sc, s7_int start, s7_pointer args)
+{
+  mpz_set_si(sc->mpz_1, start);
+  for (s7_pointer x = args; is_not_null(x); x = cdr(x))
+    {
+      s7_pointer i = car(x);
+      switch (type(i))
+	{
+	case T_BIG_INTEGER:
+	  mpz_ior(sc->mpz_1, sc->mpz_1, big_integer(i));
+	  break;
+	case T_INTEGER:
+	  mpz_set_si(sc->mpz_2, integer(i));
+	  mpz_ior(sc->mpz_1, sc->mpz_1, sc->mpz_2);
+	  break;
+	default:
+	  if (!is_integer_via_method(sc, i))
+	    wrong_type_error_nr(sc, sc->logior_symbol, position_of(x, args), i, sc->type_names[T_INTEGER]);
+	  return(method_or_bust(sc, i, sc->logior_symbol,
+				set_ulist_1(sc, mpz_to_integer(sc, sc->mpz_1), x),
+				sc->type_names[T_INTEGER], position_of(x, args)));
+	}}
+  return(mpz_to_integer(sc, sc->mpz_1));
+}
+#endif
+
+static s7_pointer g_logior(s7_scheme *sc, s7_pointer args)
+{
+  #define H_logior "(logior int32_t ...) returns the OR of its integer arguments (the bits that are on in any of the arguments)"
+  #define Q_logior sc->pcl_i
+
+  s7_int result = 0;
+  for (s7_pointer x = args; is_not_null(x); x = cdr(x))
+    {
+#if WITH_GMP
+      if (is_t_big_integer(car(x)))
+	return(big_logior(sc, result, x));
+#endif
+      if (!is_t_integer(car(x)))
+	return(method_or_bust(sc, car(x), sc->logior_symbol,
+			      (result == 0) ? x : set_ulist_1(sc, make_integer(sc, result), x),
+			      sc->type_names[T_INTEGER], position_of(x, args)));
+      result |= integer(car(x));
+    }
+  return(make_integer(sc, result));
+}
+
+static s7_int logior_i_ii(s7_int i1, s7_int i2) {return(i1 | i2);}
+static s7_int logior_i_iii(s7_int i1, s7_int i2, s7_int i3) {return(i1 | i2 | i3);}
+
+
+/* -------------------------------- logxor -------------------------------- */
+#if WITH_GMP
+static s7_pointer big_logxor(s7_scheme *sc, s7_int start, s7_pointer args)
+{
+  mpz_set_si(sc->mpz_1, start);
+  for (s7_pointer x = args; is_not_null(x); x = cdr(x))
+    {
+      s7_pointer i = car(x);
+      switch (type(i))
+	{
+	case T_BIG_INTEGER:
+	  mpz_xor(sc->mpz_1, sc->mpz_1, big_integer(i));
+	  break;
+	case T_INTEGER:
+	  mpz_set_si(sc->mpz_2, integer(i));
+	  mpz_xor(sc->mpz_1, sc->mpz_1, sc->mpz_2);
+	  break;
+	default:
+	  if (!is_integer_via_method(sc, i))
+	    wrong_type_error_nr(sc, sc->logxor_symbol, position_of(x, args), i, sc->type_names[T_INTEGER]);
+	  return(method_or_bust(sc, i, sc->logxor_symbol,
+				set_ulist_1(sc, mpz_to_integer(sc, sc->mpz_1), x),
+				sc->type_names[T_INTEGER], position_of(x, args)));
+	}}
+  return(mpz_to_integer(sc, sc->mpz_1));
+}
+#endif
+
+static s7_pointer g_logxor(s7_scheme *sc, s7_pointer args)
+{
+  #define H_logxor "(logxor int32_t ...) returns the XOR of its integer arguments (the bits that are on in an odd number of the arguments)"
+  #define Q_logxor sc->pcl_i
+
+  s7_int result = 0;
+  for (s7_pointer x = args; is_not_null(x); x = cdr(x))
+    {
+#if WITH_GMP
+      if (is_t_big_integer(car(x)))
+	return(big_logxor(sc, result, x));
+#endif
+      if (!is_t_integer(car(x)))
+	return(method_or_bust(sc, car(x), sc->logxor_symbol,
+			      (result == 0) ? x : set_ulist_1(sc, make_integer(sc, result), x),
+			      sc->type_names[T_INTEGER], position_of(x, args)));
+      result ^= integer(car(x));
+    }
+  return(make_integer(sc, result));
+}
+
+static s7_int logxor_i_ii(s7_int i1, s7_int i2) {return(i1 ^ i2);}
+static s7_int logxor_i_iii(s7_int i1, s7_int i2, s7_int i3) {return(i1 ^ i2 ^ i3);}
+
+
+/* -------------------------------- logand -------------------------------- */
+#if WITH_GMP
+static s7_pointer big_logand(s7_scheme *sc, s7_int start, s7_pointer args)
+{
+  mpz_set_si(sc->mpz_1, start);
+  for (s7_pointer x = args; is_not_null(x); x = cdr(x))
+    {
+      s7_pointer i = car(x);
+      switch (type(i))
+	{
+	case T_BIG_INTEGER:
+	  mpz_and(sc->mpz_1, sc->mpz_1, big_integer(i));
+	  break;
+	case T_INTEGER:
+	  mpz_set_si(sc->mpz_2, integer(i));
+	  mpz_and(sc->mpz_1, sc->mpz_1, sc->mpz_2);
+	  break;
+	default:
+	  if (!is_integer_via_method(sc, i))
+	    wrong_type_error_nr(sc, sc->logand_symbol, position_of(x, args), i, sc->type_names[T_INTEGER]);
+	  return(method_or_bust(sc, i, sc->logand_symbol,
+				set_ulist_1(sc, mpz_to_integer(sc, sc->mpz_1), x),
+				sc->type_names[T_INTEGER], position_of(x, args)));
+	}}
+  return(mpz_to_integer(sc, sc->mpz_1));
+}
+#endif
+
+static s7_pointer g_logand(s7_scheme *sc, s7_pointer args)
+{
+  #define H_logand "(logand int32_t ...) returns the AND of its integer arguments (the bits that are on in every argument)"
+  #define Q_logand sc->pcl_i
+
+  s7_int result = -1;
+  for (s7_pointer x = args; is_not_null(x); x = cdr(x))
+    {
+#if WITH_GMP
+      if (is_t_big_integer(car(x)))
+	return(big_logand(sc, result, x));
+#endif
+      if (!is_t_integer(car(x)))
+	return(method_or_bust(sc, car(x), sc->logand_symbol,
+			      (result == -1) ? x : set_ulist_1(sc, make_integer(sc, result), x),
+			      sc->type_names[T_INTEGER], position_of(x, args)));
+      result &= integer(car(x));
+    }
+  return(make_integer(sc, result));
+}
+
+static s7_int logand_i_ii(s7_int i1, s7_int i2) {return(i1 & i2);}
+static s7_int logand_i_iii(s7_int i1, s7_int i2, s7_int i3) {return(i1 & i2 & i3);}
+
+
+/* -------------------------------- lognot -------------------------------- */
+static s7_pointer g_lognot(s7_scheme *sc, s7_pointer args)
+{
+  #define H_lognot "(lognot num) returns the negation of num (its complement, the bits that are not on): (lognot 0) -> -1"
+  #define Q_lognot sc->pcl_i
+
+  s7_pointer x = car(args);
+  if (is_t_integer(x))
+    return(make_integer(sc, ~integer(x)));
+
+#if WITH_GMP
+  if (is_t_big_integer(x))
+    {
+      mpz_com(sc->mpz_1, big_integer(x));
+      return(mpz_to_integer(sc, sc->mpz_1));
+    }
+#endif
+  return(sole_arg_method_or_bust(sc, x, sc->lognot_symbol, args, sc->type_names[T_INTEGER]));
+}
+
+static s7_int lognot_i_i(s7_int i1) {return(~i1);}
+
+
+/* -------------------------------- logbit? -------------------------------- */
+/* logbit?  CL is (logbitp index int) using 2^index, but that order strikes me as backwards
+ *   at least gmp got the arg order right!
+ */
+
+static s7_pointer g_logbit(s7_scheme *sc, s7_pointer args)
+{
+  #define H_logbit "(logbit? int index) returns #t if the index-th bit is on in int, otherwise #f. The argument \
+order here follows gmp, and is the opposite of the CL convention.  (logbit? int bit) is the same as (not (zero? (logand int (ash 1 bit))))."
+  #define Q_logbit s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_integer_symbol)
+
+  s7_pointer x = car(args), y = cadr(args);
+  s7_int index;      /* index in gmp is mp_bitcnt which is an unsigned long int */
+
+  if (!s7_is_integer(x))
+    return(method_or_bust(sc, x, sc->logbit_symbol, args, sc->type_names[T_INTEGER], 1));
+  if (!s7_is_integer(y))
+    return(method_or_bust(sc, y, sc->logbit_symbol, args, sc->type_names[T_INTEGER], 2));
+
+  index = s7_integer_clamped_if_gmp(sc, y);
+  if (index < 0)
+    out_of_range_error_nr(sc, sc->logbit_symbol, int_two, y, it_is_negative_string);
+
+#if WITH_GMP
+  if (is_t_big_integer(x))
+    return(make_boolean(sc, (mpz_tstbit(big_integer(x), index) != 0)));
+#endif
+
+  if (index >= S7_INT_BITS)           /* not sure about the >: (logbit? -1 64) ?? */
+    return(make_boolean(sc, integer(x) < 0));
+  /* (zero? (logand most-positive-fixnum (ash 1 63))) -> ash argument 2, 63, is out of range (shift is too large)
+   *   so logbit? has a wider range than the logand/ash shuffle above.
+   */
+
+  /* all these int64_ts are necessary, else C turns it into an int, gets confused about signs etc */
+  return(make_boolean(sc, ((((int64_t)(1LL << (int64_t)index)) & (int64_t)integer(x)) != 0)));
+}
+
+static bool logbit_b_7ii(s7_scheme *sc, s7_int i1, s7_int i2)
+{
+  if (i2 < 0)
+    {
+      out_of_range_error_nr(sc, sc->logbit_symbol, int_two, wrap_integer(sc, i1), it_is_negative_string);
+      return(false);
+    }
+  if (i2 >= S7_INT_BITS) return(i1 < 0);
+  return((((int64_t)(1LL << (int64_t)i2)) & (int64_t)i1) != 0);
+}
+
+static bool logbit_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  if (is_t_integer(p1))
+    {
+      if (is_t_integer(p2))
+	return(logbit_b_7ii(sc, integer(p1), integer(p2)));
+      return(method_or_bust(sc, p2, sc->logbit_symbol, set_plist_2(sc, p1, p2), sc->type_names[T_INTEGER], 2) != sc->F);
+    }
+#if WITH_GMP
+  return(g_logbit(sc, set_plist_2(sc, p1, p2)));
+#else
+  return(method_or_bust(sc, p1, sc->logbit_symbol, set_plist_2(sc, p1, p2), sc->type_names[T_INTEGER], 1) != sc->F);
+#endif
+}
+
+
+/* -------------------------------- ash -------------------------------- */
+static s7_int c_ash(s7_scheme *sc, s7_int arg1, s7_int arg2)
+{
+  if (arg1 == 0) return(0);
+  if (arg2 >= S7_INT_BITS)
+    {
+      if ((arg1 == -1) && (arg2 == 63))   /* (ash -1 63): most-negative-fixnum */
+	return(S7_INT64_MIN);
+      out_of_range_error_nr(sc, sc->ash_symbol, int_two, wrap_integer(sc, arg2), it_is_too_large_string);
+    }
+  if (arg2 < -S7_INT_BITS)
+    return((arg1 < 0) ? -1 : 0);        /* (ash -31 -100) */
+
+  /* I can't see any point in protecting this: (ash 9223372036854775807 1) -> -2, but anyone using ash must know something about bits */
+  if (arg2 < 0)
+    return(arg1 >> -arg2);
+  if (arg1 < 0)
+    {
+      uint64_t z = (uint64_t)arg1;
+      return((s7_int)(z << arg2));
+    }
+  return(arg1 << arg2);
+}
+
+static s7_pointer g_ash(s7_scheme *sc, s7_pointer args)
+{
+  #define H_ash "(ash i1 i2) returns i1 shifted right or left i2 times, i1 << i2, (ash 1 3) -> 8, (ash 8 -3) -> 1"
+  #define Q_ash sc->pcl_i
+
+#if WITH_GMP
+  /* here, as in expt, there are cases like (ash 1 63) which need to be handled as bignums */
+  s7_pointer p0 = car(args), p1 = cadr(args);
+
+  /* here, as in expt, there are cases like (ash 1 63) which need to be bignums so there's no easy way to tell when it's safe to drop into g_ash instead */
+  if ((s7_is_integer(p0)) && /* this includes bignum ints... */
+      (s7_is_integer(p1)))
+    {
+      s7_int shift;
+      bool p0_is_big = is_big_number(p0);
+      int32_t p0_compared_to_zero = 0;
+
+      if (p0_is_big)
+	p0_compared_to_zero = mpz_cmp_ui(big_integer(p0), 0);
+      else
+	if (integer(p0) > 0)
+	  p0_compared_to_zero = 1;
+	else p0_compared_to_zero = (integer(p0) < 0) ? -1 : 0;
+
+      if (p0_compared_to_zero == 0)
+	return(int_zero);
+
+      if (is_big_number(p1))
+	{
+	  if (!mpz_fits_sint_p(big_integer(p1)))
+	    {
+	      if (mpz_cmp_ui(big_integer(p1), 0) > 0)
+		out_of_range_error_nr(sc, sc->ash_symbol, int_two, p1, it_is_too_large_string);
+
+	      /* here if p0 is negative, we need to return -1 */
+	      return((p0_compared_to_zero == 1) ? int_zero : minus_one);
+	    }
+	  shift = mpz_get_si(big_integer(p1));
+	}
+      else
+	{
+	  shift = integer(p1);
+	  if (shift < S7_INT32_MIN)
+	    return((p0_compared_to_zero == 1) ? int_zero : minus_one);
+	}
+      if (shift > S7_INT32_MAX)
+	out_of_range_error_nr(sc, sc->ash_symbol, int_two, p1, it_is_too_large_string); /* gmp calls abort if overflow here */
+
+      if (is_t_big_integer(p0))
+	mpz_set(sc->mpz_1, big_integer(p0));
+      else mpz_set_si(sc->mpz_1, integer(p0));
+
+      if (shift > 0)     /* left */
+	mpz_mul_2exp(sc->mpz_1, sc->mpz_1, shift);
+      else
+	if (shift < 0) /* right */
+	  mpz_fdiv_q_2exp(sc->mpz_1, sc->mpz_1, (uint32_t)(-shift));
+
+      return(mpz_to_integer(sc, sc->mpz_1));
+    }
+  /* else fall through */
+#endif
+  s7_pointer x = car(args), y = cadr(args);
+
+  if (!s7_is_integer(x))
+    return(method_or_bust(sc, x, sc->ash_symbol, args, sc->type_names[T_INTEGER], 1));
+  if (!s7_is_integer(y))
+    return(method_or_bust(sc, y, sc->ash_symbol, args, sc->type_names[T_INTEGER], 2));
+  return(make_integer(sc, c_ash(sc, s7_integer_clamped_if_gmp(sc, x), s7_integer_clamped_if_gmp(sc, y))));
+}
+
+#if (!WITH_GMP)
+  static s7_int ash_i_7ii(s7_scheme *sc, s7_int i1, s7_int i2) {return(c_ash(sc, i1, i2));}
+#endif
+static s7_int lsh_i_ii_unchecked(s7_int i1, s7_int i2) {return(i1 << i2);} /* this may need gmp special handling, and out-of-range as in c_ash */
+static s7_int rsh_i_ii_unchecked(s7_int i1, s7_int i2) {return(i1 >> (-i2));}
+static s7_int rsh_i_i2_direct(s7_int i1, s7_int unused_i2) {return(i1 >> 1);}
+
+
+/* -------------------------------- random-state -------------------------------- */
+/* random numbers.  The simple version used in clm.c is probably adequate, but here I'll use Marsaglia's MWC algorithm.
+ *     (random num) -> a number (0..num), if num == 0 return 0, use global default state
+ *     (random num state) -> same but use this state
+ *     (random-state seed) -> make a new state
+ *   to save the current seed, use copy, to save it across load, random-state->list and list->random-state.
+ *   random-state? returns #t if its arg is one of these guys
+ */
+
+static s7_pointer random_state_copy(s7_scheme *sc, s7_pointer args)
+{
+#if WITH_GMP
+  return(sc->F); /* I can't find a way to copy a gmp random generator */
+#else
+  s7_pointer new_r, obj = car(args);
+  if (!is_random_state(obj)) return(sc->F);
+  new_cell(sc, new_r, T_RANDOM_STATE);
+  random_seed(new_r) = random_seed(obj);
+  random_carry(new_r) = random_carry(obj);
+  return(new_r);
+#endif
+}
+
+s7_pointer s7_random_state(s7_scheme *sc, s7_pointer args)
+{
+  #define H_random_state "(random-state seed (carry plausible-default)) returns a new random number state initialized with 'seed'. \
+Pass this as the second argument to 'random' to get a repeatable random number sequence:\n\
+    (let ((seed (random-state 1234))) (random 1.0 seed))"
+  #define Q_random_state s7_make_circular_signature(sc, 1, 2, sc->is_random_state_symbol, sc->is_integer_symbol)
+
+#if WITH_GMP
+  s7_pointer r, seed;
+  if (is_null(args))
+    return(sc->F); /* how to find current state, if any? */
+
+  seed = car(args);
+  if (!s7_is_integer(seed))
+    return(sole_arg_method_or_bust(sc, seed, sc->random_state_symbol, args, sc->type_names[T_INTEGER]));
+
+  if (is_t_integer(seed))
+    seed = s7_int_to_big_integer(sc, integer(seed));
+
+  new_cell(sc, r, T_RANDOM_STATE);
+  gmp_randinit_default(random_gmp_state(r));            /* Mersenne twister */
+  gmp_randseed(random_gmp_state(r), big_integer(seed)); /* this is ridiculously slow! */
+  add_big_random_state(sc, r);
+  return(r);
+#else
+  s7_pointer r1, r2, p;
+  s7_int i1, i2;
+  if (is_null(args))
+    return(sc->default_random_state);
+
+  r1 = car(args);
+  if (!s7_is_integer(r1))
+    return(method_or_bust(sc, r1, sc->random_state_symbol, args, sc->type_names[T_INTEGER], 1));
+  i1 = integer(r1);
+  if (i1 < 0)
+    out_of_range_error_nr(sc, sc->random_state_symbol, int_one, r1, it_is_negative_string);
+  if (is_null(cdr(args)))
+    {
+      new_cell(sc, p, T_RANDOM_STATE);
+      random_seed(p) = (uint64_t)i1;
+      random_carry(p) = 1675393560;                          /* should this be dependent on the seed? */
+      return(p);
+    }
+
+  r2 = cadr(args);
+  if (!s7_is_integer(r2))
+    return(method_or_bust(sc, r2, sc->random_state_symbol, args, sc->type_names[T_INTEGER], 2));
+  i2 = integer(r2);
+  if (i2 < 0)
+    out_of_range_error_nr(sc, sc->random_state_symbol, int_two, r2, it_is_negative_string);
+
+  new_cell(sc, p, T_RANDOM_STATE);
+  random_seed(p) = (uint64_t)i1;
+  random_carry(p) = (uint64_t)i2;
+  return(p);
+#endif
+}
+
+#define g_random_state s7_random_state
+
+static s7_pointer random_state_getter(s7_scheme *sc, s7_pointer r, s7_int loc)
+{
+#if (!WITH_GMP)
+  if (loc == 0) return(make_integer(sc, random_seed(r)));
+  if (loc == 1) return(make_integer(sc, random_carry(r)));
+#endif
+  return(sc->F);
+}
+
+static s7_pointer random_state_setter(s7_scheme *sc, s7_pointer r, s7_int loc, s7_pointer val)
+{
+#if (!WITH_GMP)
+  if (is_t_integer(val))
+    {
+      s7_int i = s7_integer_clamped_if_gmp(sc, val);
+      if (loc == 0) random_seed(r) = i;
+      if (loc == 1) random_carry(r) = i;
+    }
+#endif
+  return(sc->F);
+}
+
+
+/* -------------------------------- random-state? -------------------------------- */
+static s7_pointer g_is_random_state(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_random_state "(random-state? obj) returns #t if obj is a random-state object (from random-state)."
+  #define Q_is_random_state sc->pl_bt
+  check_boolean_method(sc, is_random_state, sc->is_random_state_symbol, args);
+}
+
+bool s7_is_random_state(s7_pointer p) {return(type(p) == T_RANDOM_STATE);}
+
+
+/* -------------------------------- random-state->list -------------------------------- */
+s7_pointer s7_random_state_to_list(s7_scheme *sc, s7_pointer args)
+{
+  #define H_random_state_to_list "(random-state->list r) returns the random state object as a list.\
+You can later apply random-state to this list to continue a random number sequence from any point."
+  #define Q_random_state_to_list s7_make_signature(sc, 2, (WITH_GMP) ? sc->is_list_symbol : sc->is_pair_symbol, sc->is_random_state_symbol)
+
+#if WITH_GMP
+  if ((is_pair(args)) &&
+      (!is_random_state(car(args))))
+    return(method_or_bust(sc, car(args), sc->random_state_to_list_symbol, args, a_random_state_object_string, 1));
+  return(sc->nil);
+#else
+  s7_pointer r = (is_null(args)) ? sc->default_random_state : car(args);
+  if (!is_random_state(r))
+    return(method_or_bust(sc, r, sc->random_state_to_list_symbol, args, a_random_state_object_string, 1));
+  return(list_2(sc, make_integer(sc, random_seed(r)), make_integer_unchecked(sc, random_carry(r))));
+#endif
+}
+
+#define g_random_state_to_list s7_random_state_to_list
+
+void s7_set_default_random_state(s7_scheme *sc, s7_int seed, s7_int carry)
+{
+#if (!WITH_GMP)
+  s7_pointer p;
+  new_cell(sc, p, T_RANDOM_STATE);
+  random_seed(p) = (uint64_t)seed;
+  random_carry(p) = (uint64_t)carry;
+  sc->default_random_state = p;
+#endif
+}
+
+
+/* -------------------------------- random -------------------------------- */
+#if WITH_GMP
+static double next_random(s7_scheme *sc)
+#else
+static double next_random(s7_pointer r)
+#endif
+{
+#if (!WITH_GMP)
+  /* The multiply-with-carry generator for 32-bit integers:
+   *        x(n)=a*x(n-1) + carry mod 2^32
+   * Choose multiplier a from this list:
+   *   1791398085 1929682203 1683268614 1965537969 1675393560 1967773755 1517746329 1447497129 1655692410 1606218150
+   *   2051013963 1075433238 1557985959 1781943330 1893513180 1631296680 2131995753 2083801278 1873196400 1554115554
+   * ( or any 'a' for which both a*2^32-1 and a*2^31-1 are prime)
+   */
+  #define RAN_MULT 2131995753UL
+
+  double result;
+  uint64_t temp = random_seed(r) * RAN_MULT + random_carry(r);
+  random_seed(r) = (temp & 0xffffffffUL);
+  random_carry(r) = (temp >> 32);
+  result = (double)((uint32_t)(random_seed(r))) / 4294967295.5;
+  /* divisor was 2^32-1 = 4294967295.0, but somehow this can round up once in a billion tries?
+   *   do we want the double just less than 2^32?
+   * can the multiply-add+logand above return 0? I'm getting 0's from (random (expt 2 62))
+   */
+
+  /* (let ((mx 0) (mn 1000)) (do ((i 0 (+ i 1))) ((= i 10000)) (let ((val (random 123))) (set! mx (max mx val)) (set! mn (min mn val)))) (list mn mx)) */
+  return(result);
+#else
+  mpfr_urandomb(sc->mpfr_1, random_gmp_state(sc->default_random_state));
+  return(mpfr_get_d(sc->mpfr_1, MPFR_RNDN));
+#endif
+}
+
+static s7_pointer g_random(s7_scheme *sc, s7_pointer args)
+{
+  #define H_random "(random num (state #f)) returns a random number of the same type as num between zero and num, equalling num only if num is zero"
+  #define Q_random s7_make_signature(sc, 3, sc->is_number_symbol, sc->is_number_symbol, sc->is_random_state_symbol)
+  s7_pointer r, num;
+
+  /* if we disallow (random 0) the programmer has to protect every call on random with (if (eqv? x 0) 0 (random x)).  If
+   *   we claim we're using a half-open interval, then we should also disallow (random 0.0); otherwise the following
+   *   must be true: (let* ((x 0.0) (y (random x))) (and (>= y 0.0) (< y x))).  The definition above is consistent
+   *   with (random 0) -> 0, simpler to use in practice, and certainly no worse than (/ 0 0) -> 1.
+   */
+  if (is_null(cdr(args)))
+    r = sc->default_random_state;
+  else
+    {
+      r = cadr(args);
+      if (!is_random_state(r))
+	return(method_or_bust(sc, r, sc->random_symbol, args, a_random_state_object_string, 2));
+    }
+  num = car(args);
+  switch (type(num))
+    {
+#if (!WITH_GMP)
+    case T_INTEGER:
+      return(make_integer(sc, (s7_int)(integer(num) * next_random(r))));
+    case T_RATIO:
+      {
+	s7_double x = fraction(num), error;
+	s7_int numer = 0, denom = 1;
+	/* the error here needs to take the size of the fraction into account.  Otherwise, if
+	 *    error is (say) 1e-6 and the fraction is (say) 9000000/9223372036854775807,
+	 *    c_rationalize will always return 0.  But even that isn't foolproof:
+	 *    (random 1/562949953421312) -> 1/376367230475000
+	 */
+	if ((x < 1.0e-10) && (x > -1.0e-10))
+	  {
+	    /* 1e-12 is not tight enough:
+	     *    (random 1/2251799813685248) -> 1/2250240579436280
+	     *    (random -1/4503599627370496) -> -1/4492889778435526
+	     *    (random 1/140737488355328) -> 1/140730223985746
+	     *    (random -1/35184372088832) -> -1/35183145492420
+	     *    (random -1/70368744177664) -> -1/70366866392738
+	     *    (random 1/4398046511104) -> 1/4398033095756
+	     *    (random 1/137438953472) -> 1/137438941127
+	     */
+	    if (numerator(num) < -10)
+	      numer = -(s7_int)(floor(-numerator(num) * next_random(r)));
+	    else
+	      if (numerator(num) > 10)
+		numer = (s7_int)floor(numerator(num) * next_random(r));
+	      else
+		{
+		  int64_t diff = S7_INT64_MAX - denominator(num);
+		  numer = numerator(num);
+		  if (diff < 100)
+		    return(make_ratio(sc, numer, denominator(num)));
+		  denom = denominator(num) + (s7_int)floor(diff * next_random(r));
+		  return(make_ratio_with_div_check(sc, sc->random_symbol, numer, denom));
+		}
+	    return(make_ratio(sc, numer, denominator(num)));
+	  }
+	error = ((x < 1e-6) && (x > -1e-6)) ? 1e-18 : 1e-12;
+	c_rationalize(x * next_random(r), error, &numer, &denom);
+	return(make_ratio(sc, numer, denom));
+      }
+    case T_REAL:
+      return(make_real(sc, real(num) * next_random(r)));
+    case T_COMPLEX:
+      return(make_complex(sc, real_part(num) * next_random(r), imag_part(num) * next_random(r)));
+#else
+    case T_INTEGER:
+      if (integer(num) == 0) return(int_zero);
+      mpz_set_si(sc->mpz_1, integer(num));
+      mpz_urandomm(sc->mpz_1, random_gmp_state(r), sc->mpz_1);
+      if (integer(num) < 0) mpz_neg(sc->mpz_1, sc->mpz_1);
+      return(make_integer(sc, mpz_get_si(sc->mpz_1)));
+    case T_BIG_INTEGER:
+      if (mpz_cmp_si(big_integer(num), 0) == 0) return(int_zero);
+      mpz_urandomm(sc->mpz_1, random_gmp_state(r), big_integer(num));
+      /* this does not work if num is a negative number -- you get positive results. so check num for sign, and negate result if necessary */
+      if (mpz_cmp_ui(big_integer(num), 0) < 0)
+	mpz_neg(sc->mpz_1, sc->mpz_1);
+      return(mpz_to_integer(sc, sc->mpz_1));
+    case T_RATIO:
+      mpfr_urandomb(sc->mpfr_1, random_gmp_state(r));
+      mpq_set_si(sc->mpq_1, numerator(num), denominator(num));
+      mpfr_mul_q(sc->mpfr_1, sc->mpfr_1, sc->mpq_1, MPFR_RNDN);
+      mpfr_mul_d(sc->mpfr_2, sc->mpfr_1, sc->default_rationalize_error, MPFR_RNDN);
+      return(big_rationalize(sc, set_plist_2(sc, mpfr_to_big_real(sc, sc->mpfr_1), mpfr_to_big_real(sc, sc->mpfr_2))));
+    case T_BIG_RATIO:
+      mpfr_urandomb(sc->mpfr_1, random_gmp_state(r));
+      mpfr_mul_q(sc->mpfr_1, sc->mpfr_1, big_ratio(num), MPFR_RNDN);
+      mpfr_mul_d(sc->mpfr_2, sc->mpfr_1, sc->default_rationalize_error, MPFR_RNDN);
+      return(big_rationalize(sc, set_plist_2(sc, mpfr_to_big_real(sc, sc->mpfr_1), mpfr_to_big_real(sc, sc->mpfr_2))));
+    case T_REAL:
+      mpfr_urandomb(sc->mpfr_1, random_gmp_state(r));
+      mpfr_mul_d(sc->mpfr_1, sc->mpfr_1, real(num), MPFR_RNDN);
+      return(make_real(sc, mpfr_get_d(sc->mpfr_1, MPFR_RNDN)));
+    case T_BIG_REAL:
+      mpfr_urandomb(sc->mpfr_1, random_gmp_state(r));
+      mpfr_mul(sc->mpfr_1, sc->mpfr_1, big_real(num), MPFR_RNDN);
+      return(mpfr_to_big_real(sc, sc->mpfr_1));
+    case T_COMPLEX:
+      mpc_urandom(sc->mpc_1, random_gmp_state(r));
+      mpfr_mul_d(mpc_realref(sc->mpc_1), mpc_realref(sc->mpc_1), real_part(num), MPFR_RNDN);
+      mpfr_mul_d(mpc_imagref(sc->mpc_1), mpc_imagref(sc->mpc_1), imag_part(num), MPFR_RNDN);
+      return(make_complex(sc, mpfr_get_d(mpc_realref(sc->mpc_1), MPFR_RNDN), mpfr_get_d(mpc_imagref(sc->mpc_1), MPFR_RNDN)));
+    case T_BIG_COMPLEX:
+      mpc_urandom(sc->mpc_1, random_gmp_state(r));
+      mpfr_mul(mpc_realref(sc->mpc_1), mpc_realref(sc->mpc_1), mpc_realref(big_complex(num)), MPFR_RNDN);
+      mpfr_mul(mpc_imagref(sc->mpc_1), mpc_imagref(sc->mpc_1), mpc_imagref(big_complex(num)), MPFR_RNDN);
+      return(mpc_to_number(sc, sc->mpc_1));
+#endif
+    default:
+      return(method_or_bust(sc, num, sc->random_symbol, args, a_number_string, 1));
+    }
+  return(sc->F);
+}
+
+s7_double s7_random(s7_scheme *sc, s7_pointer state)
+{
+#if WITH_GMP
+  mpfr_set_ui(sc->mpfr_1, 1, MPFR_RNDN);
+  mpfr_urandomb(sc->mpfr_1, random_gmp_state((state) ? state : sc->default_random_state));
+  return((s7_double)mpfr_get_d(sc->mpfr_1, MPFR_RNDN));
+#else
+  return(next_random((state) ? state : sc->default_random_state));
+#endif
+}
+
+static s7_double random_d_7d(s7_scheme *sc, s7_double x)
+{
+#if WITH_GMP
+  return(real(g_random(sc, set_plist_1(sc, wrap_real(sc, x)))));
+#else
+  return(x * next_random(sc->default_random_state));
+#endif
+}
+
+static s7_int random_i_7i(s7_scheme *sc, s7_int i)
+{
+#if WITH_GMP
+  return(integer(g_random(sc, set_plist_1(sc, wrap_integer(sc, i)))));
+#else
+  return((s7_int)(i * next_random(sc->default_random_state)));
+#endif
+}
+
+static s7_pointer g_random_i(s7_scheme *sc, s7_pointer args)
+{
+#if WITH_GMP
+  return(g_random(sc, args));
+#else
+  return(make_integer(sc, (s7_int)(integer(car(args)) * next_random(sc->default_random_state))));
+#endif
+}
+
+static s7_pointer g_random_f(s7_scheme *sc, s7_pointer args)
+{
+#if WITH_GMP
+  return(g_random(sc, args));
+#else
+  return(make_real(sc, real(car(args)) * next_random(sc->default_random_state)));
+#endif
+}
+
+static s7_pointer g_random_1(s7_scheme *sc, s7_pointer args)
+{
+#if (!WITH_GMP)
+  s7_pointer num = car(args), r = sc->default_random_state;
+  if (is_t_integer(num))
+    return(make_integer(sc, (s7_int)(integer(num) * next_random(r))));
+  if (is_t_real(num))
+    return(make_real(sc, real(num) * next_random(r)));
+#endif
+  return(g_random(sc, args));
+}
+
+static s7_pointer random_p_p(s7_scheme *sc, s7_pointer num)
+{
+#if (!WITH_GMP)
+  if (is_t_integer(num))
+    return(make_integer(sc, (s7_int)(integer(num) * next_random(sc->default_random_state))));
+  if (is_t_real(num))
+    return(make_real(sc, real(num) * next_random(sc->default_random_state)));
+#endif
+  return(g_random(sc, set_plist_1(sc, num)));
+}
+
+static s7_pointer random_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  if (args == 1)
+    {
+      s7_pointer arg1 = cadr(expr);
+      if (is_t_integer(arg1))
+	return(sc->random_i);
+      return((is_t_real(arg1)) ? sc->random_f : sc->random_1);
+    }
+  return(f);
+}
+
+static s7_pointer g_add_i_random(s7_scheme *sc, s7_pointer args)
+{
+#if WITH_GMP
+  return(add_p_pp(sc, car(args), random_p_p(sc, cadadr(args))));
+#else
+  s7_int x = integer(car(args)), y = opt3_int(args); /* cadadr */
+  return(make_integer(sc, x + (s7_int)(y * next_random(sc->default_random_state)))); /* (+ -1 (random 1)) -- placement of the (s7_int) cast matters! */
+#endif
+}
+
+
+/* -------------------------------- char<->integer -------------------------------- */
+static s7_pointer g_char_to_integer(s7_scheme *sc, s7_pointer args)
+{
+  #define H_char_to_integer "(char->integer c) converts the character c to an integer"
+  #define Q_char_to_integer s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_char_symbol)
+
+  if (!is_character(car(args)))
+    return(sole_arg_method_or_bust(sc, car(args), sc->char_to_integer_symbol, args, sc->type_names[T_CHARACTER]));
+  return(small_int(character(car(args))));
+}
+
+static s7_int char_to_integer_i_7p(s7_scheme *sc, s7_pointer p)
+{
+  if (!is_character(p))
+    return(integer(method_or_bust_p(sc, p, sc->char_to_integer_symbol, sc->type_names[T_CHARACTER])));
+  return(character(p));
+}
+
+static s7_pointer char_to_integer_p_p(s7_scheme *sc, s7_pointer p)
+{
+  if (!is_character(p))
+    return(method_or_bust_p(sc, p, sc->char_to_integer_symbol, sc->type_names[T_CHARACTER]));
+  return(make_integer(sc, character(p)));
+}
+
+static s7_pointer integer_to_char_p_p(s7_scheme *sc, s7_pointer x)
+{
+  s7_int ind;
+  if (!s7_is_integer(x))
+    return(method_or_bust_p(sc, x, sc->integer_to_char_symbol, sc->type_names[T_INTEGER]));
+  ind = s7_integer_clamped_if_gmp(sc, x);
+  if ((ind < 0) || (ind >= NUM_CHARS))
+    sole_arg_out_of_range_error_nr(sc, sc->integer_to_char_symbol, x, wrap_string(sc, "it doesn't fit in an unsigned byte", 34));
+  return(chars[(uint8_t)ind]);
+}
+
+static s7_pointer g_integer_to_char(s7_scheme *sc, s7_pointer args)
+{
+  #define H_integer_to_char "(integer->char i) converts the non-negative integer i to a character"
+  #define Q_integer_to_char s7_make_signature(sc, 2, sc->is_char_symbol, sc->is_integer_symbol)
+  return(integer_to_char_p_p(sc, car(args)));
+}
+
+static s7_pointer integer_to_char_p_i(s7_scheme *sc, s7_int ind)
+{
+  if ((ind < 0) || (ind >= NUM_CHARS))
+    sole_arg_out_of_range_error_nr(sc, sc->integer_to_char_symbol, wrap_integer(sc, ind),
+				   wrap_string(sc, "it doesn't fit in an unsigned byte", 34)); /* int2 s7_out... uses 1 */
+  return(chars[(uint8_t)ind]);
+}
+
+
+static uint8_t uppers[256], lowers[256];
+static void init_uppers(void)
+{
+  for (int32_t i = 0; i < 256; i++)
+    {
+      uppers[i] = (uint8_t)toupper(i);
+      lowers[i] = (uint8_t)tolower(i);
+    }
+}
+
+static void init_chars(void)
+{
+  s7_cell *cells = (s7_cell *)Calloc(NUM_CHARS + 1, sizeof(s7_cell));
+
+  chars = (s7_pointer *)Malloc((NUM_CHARS + 1) * sizeof(s7_pointer)); /* chars is declared far above */
+  chars[0] = &cells[0];
+  eof_object = chars[0];
+  set_full_type(eof_object, T_EOF | T_IMMUTABLE | T_UNHEAP);
+  eof_name_length(eof_object) = 6;
+  eof_name(eof_object) = "#<eof>";
+  chars++;                    /* now chars[EOF] == chars[-1] == #<eof> */
+  cells++;
+
+  for (int32_t i = 0; i < NUM_CHARS; i++)
+    {
+      s7_pointer cp = &cells[i];
+      uint8_t c = (uint8_t)i;
+
+      set_type_bit(cp, T_IMMUTABLE | T_CHARACTER | T_UNHEAP);
+      set_optimize_op(cp, OP_CONSTANT);
+      character(cp) = c;
+      upper_character(cp) = (uint8_t)toupper(i);
+      is_char_alphabetic(cp) = (bool)isalpha(i);
+      is_char_numeric(cp) = (bool)isdigit(i);
+      is_char_whitespace(cp) = white_space[i];
+      is_char_uppercase(cp) = (((bool)isupper(i)) || ((i >= 192) && (i < 208)));
+      is_char_lowercase(cp) = (bool)islower(i);
+      chars[i] = cp;
+
+      #define make_character_name(S) memcpy((void *)(&(character_name(cp))), (const void *)(S), character_name_length(cp) = (int32_t)strlen(S))
+      switch (c)
+	{
+	case ' ':	 make_character_name("#\\space");     break;
+	case '\n':       make_character_name("#\\newline");   break;
+	case '\r':       make_character_name("#\\return");    break;
+	case '\t':       make_character_name("#\\tab");       break;
+	case '\0':       make_character_name("#\\null");      break;
+	case (char)0x1b: make_character_name("#\\escape");    break;
+	case (char)0x7f: make_character_name("#\\delete");    break;
+	case (char)7:    make_character_name("#\\alarm");     break;
+	case (char)8:    make_character_name("#\\backspace"); break;
+	default:
+          #define P_SIZE 12
+	  character_name_length(cp) = snprintf((char *)(&(character_name(cp))), P_SIZE, ((c < 32) || (c >= 127)) ? "#\\x%x" : "#\\%c", c);
+	  break;
+	}}
+}
+
+
+/* -------------------------------- char-upcase, char-downcase ----------------------- */
+static s7_pointer char_upcase_p_p(s7_scheme *sc, s7_pointer c)
+{
+  if (!is_character(c))
+    return(method_or_bust_p(sc, c, sc->char_upcase_symbol, sc->type_names[T_CHARACTER]));
+  return(chars[upper_character(c)]);
+}
+
+static s7_pointer char_upcase_p_p_unchecked(s7_scheme *unused_sc, s7_pointer c) {return(chars[upper_character(c)]);}
+
+static s7_pointer g_char_upcase(s7_scheme *sc, s7_pointer args)
+{
+  #define H_char_upcase "(char-upcase c) converts the character c to upper case"
+  #define Q_char_upcase sc->pcl_c
+  return(char_upcase_p_p(sc, car(args)));
+}
+
+static s7_pointer g_char_downcase(s7_scheme *sc, s7_pointer args)
+{
+  #define H_char_downcase "(char-downcase c) converts the character c to lower case"
+  #define Q_char_downcase sc->pcl_c
+  if (!is_character(car(args)))
+    return(sole_arg_method_or_bust(sc, car(args), sc->char_downcase_symbol, args, sc->type_names[T_CHARACTER]));
+  return(chars[lowers[character(car(args))]]);
+}
+
+
+/* -------------------------------- char-alphabetic? char-numeric? char-whitespace? -------------------------------- */
+static s7_pointer g_is_char_alphabetic(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_char_alphabetic "(char-alphabetic? c) returns #t if the character c is alphabetic"
+  #define Q_is_char_alphabetic sc->pl_bc
+  if (!is_character(car(args)))
+    return(sole_arg_method_or_bust(sc, car(args), sc->is_char_alphabetic_symbol, args, sc->type_names[T_CHARACTER]));
+  return(make_boolean(sc, is_char_alphabetic(car(args))));
+  /* isalpha returns #t for (integer->char 226) and others in that range */
+}
+
+static bool is_char_alphabetic_b_7p(s7_scheme *sc, s7_pointer c)
+{
+  if (!is_character(c))
+    sole_arg_wrong_type_error_nr(sc, sc->is_char_alphabetic_symbol, c, sc->type_names[T_CHARACTER]);
+    /* return(sole_arg_method_or_bust(sc, c, sc->is_char_alphabetic_symbol, set_plist_1(sc, c), sc->type_names[T_CHARACTER]) != sc->F); */ /* slower? see tmisc */
+  return(is_char_alphabetic(c));
+}
+
+static s7_pointer is_char_alphabetic_p_p(s7_scheme *sc, s7_pointer c)
+{
+  if (!is_character(c))
+    return(sole_arg_method_or_bust(sc, c, sc->is_char_alphabetic_symbol, set_plist_1(sc, c), sc->type_names[T_CHARACTER]));
+  return(make_boolean(sc, is_char_alphabetic(c)));
+}
+
+static s7_pointer g_is_char_numeric(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_char_numeric "(char-numeric? c) returns #t if the character c is a digit"
+  #define Q_is_char_numeric sc->pl_bc
+
+  s7_pointer arg = car(args);
+  if (!is_character(arg))
+    return(sole_arg_method_or_bust(sc, arg, sc->is_char_numeric_symbol, args, sc->type_names[T_CHARACTER]));
+  return(make_boolean(sc, is_char_numeric(arg)));
+}
+
+static bool is_char_numeric_b_7p(s7_scheme *sc, s7_pointer c)
+{
+  if (!is_character(c))
+    sole_arg_wrong_type_error_nr(sc, sc->is_char_numeric_symbol, c, sc->type_names[T_CHARACTER]);
+  /* return(sole_arg_method_or_bust(sc, c, sc->is_char_numeric_symbol, set_plist_1(sc, c), sc->type_names[T_CHARACTER]) != sc->F); */ /* as above */
+  return(is_char_numeric(c));
+}
+
+static s7_pointer is_char_numeric_p_p(s7_scheme *sc, s7_pointer c)
+{
+  if (!is_character(c))
+    return(sole_arg_method_or_bust(sc, c, sc->is_char_numeric_symbol, set_plist_1(sc, c), sc->type_names[T_CHARACTER]));
+  return(make_boolean(sc, is_char_numeric(c)));
+}
+
+
+static s7_pointer g_is_char_whitespace(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_char_whitespace "(char-whitespace? c) returns #t if the character c is non-printing character"
+  #define Q_is_char_whitespace sc->pl_bc
+
+  s7_pointer arg = car(args);
+  if (!is_character(arg))
+    return(sole_arg_method_or_bust(sc, arg, sc->is_char_whitespace_symbol, args, sc->type_names[T_CHARACTER]));
+  return(make_boolean(sc, is_char_whitespace(arg)));
+}
+
+static bool is_char_whitespace_b_7p(s7_scheme *sc, s7_pointer c)
+{
+  if (!is_character(c))
+    sole_arg_wrong_type_error_nr(sc, sc->is_char_whitespace_symbol, c, sc->type_names[T_CHARACTER]);
+  return(is_char_whitespace(c));
+}
+
+static s7_pointer is_char_whitespace_p_p(s7_scheme *sc, s7_pointer c)
+{
+  if (!is_character(c))
+    return(sole_arg_method_or_bust(sc, c, sc->is_char_whitespace_symbol, set_plist_1(sc, c), sc->type_names[T_CHARACTER]));
+  return(make_boolean(sc, is_char_whitespace(c)));
+}
+
+static s7_pointer is_char_whitespace_p_p_unchecked(s7_scheme *sc, s7_pointer c) {return(make_boolean(sc, is_char_whitespace(c)));}
+
+
+/* -------------------------------- char-upper-case? char-lower-case? -------------------------------- */
+static s7_pointer g_is_char_upper_case(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_char_upper_case "(char-upper-case? c) returns #t if the character c is in upper case"
+  #define Q_is_char_upper_case sc->pl_bc
+
+  s7_pointer arg = car(args);
+  if (!is_character(arg))
+    return(sole_arg_method_or_bust(sc, arg, sc->is_char_upper_case_symbol, args, sc->type_names[T_CHARACTER]));
+  return(make_boolean(sc, is_char_uppercase(arg)));
+}
+
+static bool is_char_upper_case_b_7p(s7_scheme *sc, s7_pointer c)
+{
+  if (!is_character(c))
+    return(sole_arg_method_or_bust(sc, c, sc->is_char_upper_case_symbol, set_plist_1(sc, c), sc->type_names[T_CHARACTER]) != sc->F);
+  return(is_char_uppercase(c));
+}
+
+static s7_pointer g_is_char_lower_case(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_char_lower_case "(char-lower-case? c) returns #t if the character c is in lower case"
+  #define Q_is_char_lower_case sc->pl_bc
+
+  s7_pointer arg = car(args);
+  if (!is_character(arg))
+    return(sole_arg_method_or_bust(sc, arg, sc->is_char_lower_case_symbol, args, sc->type_names[T_CHARACTER]));
+  return(make_boolean(sc, is_char_lowercase(arg)));
+}
+
+static bool is_char_lower_case_b_7p(s7_scheme *sc, s7_pointer c)
+{
+  if (!is_character(c))
+    return(sole_arg_method_or_bust(sc, c, sc->is_char_lower_case_symbol, set_plist_1(sc, c), sc->type_names[T_CHARACTER]) != sc->F);
+  return(is_char_lowercase(c));
+}
+
+
+/* -------------------------------- char? -------------------------------- */
+static s7_pointer g_is_char(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_char "(char? obj) returns #t if obj is a character"
+  #define Q_is_char sc->pl_bt
+  check_boolean_method(sc, is_character, sc->is_char_symbol, args);
+}
+
+static s7_pointer is_char_p_p(s7_scheme *sc, s7_pointer p) {return((is_character(p)) ? sc->T : sc->F);}
+
+s7_pointer s7_make_character(s7_scheme *sc, uint8_t c) {return(chars[c]);}
+
+bool s7_is_character(s7_pointer p) {return(is_character(p));}
+
+uint8_t s7_character(s7_pointer p) {return(character(p));}
+
+
+/* -------------------------------- char<? char<=? char>? char>=? char=? -------------------------------- */
+static int32_t charcmp(uint8_t c1, uint8_t c2)
+{
+  return((c1 == c2) ? 0 : (c1 < c2) ? -1 : 1);
+  /* not tolower here -- the single case is apparently supposed to be upper case
+   *   this matters in a case like (char-ci<? #\_ #\e) which Guile and Gauche say is #f
+   *   although (char<? #\_ #\e) is #t -- the spec does not say how to interpret this!
+   */
+}
+
+static bool is_character_via_method(s7_scheme *sc, s7_pointer p)
+{
+  if (is_character(p))
+    return(true);
+  if (has_active_methods(sc, p))
+    {
+      s7_pointer f = find_method_with_let(sc, p, sc->is_char_symbol);
+      if (f != sc->undefined)
+	return(is_true(sc, s7_apply_function(sc, f, set_plist_1(sc, p))));
+    }
+  return(false);
+}
+
+static s7_pointer char_with_error_check(s7_scheme *sc, s7_pointer x, s7_pointer args, s7_pointer caller)
+{
+  for (s7_pointer y = cdr(x); is_pair(y); y = cdr(y)) /* before returning #f, check for bad trailing arguments */
+    if (!is_character_via_method(sc, car(y)))
+      wrong_type_error_nr(sc, caller, position_of(y, args), car(y), sc->type_names[T_CHARACTER]);
+  return(sc->F);
+}
+
+static s7_pointer g_char_cmp(s7_scheme *sc, s7_pointer args, int32_t val, s7_pointer sym)
+{
+  s7_pointer y = car(args);
+  if (!is_character(y))
+    return(method_or_bust(sc, y, sym, args, sc->type_names[T_CHARACTER], 1));
+  for (s7_pointer x = cdr(args); is_pair(x); y = car(x), x = cdr(x))
+    {
+      if (!is_character(car(x)))
+	return(method_or_bust(sc, car(x), sym, set_ulist_1(sc, y, x), sc->type_names[T_CHARACTER], position_of(x, args)));
+      if (charcmp(character(y), character(car(x))) != val)
+	return(char_with_error_check(sc, x, args, sym));
+    }
+  return(sc->T);
+}
+
+static s7_pointer g_char_cmp_not(s7_scheme *sc, s7_pointer args, int32_t val, s7_pointer sym)
+{
+  s7_pointer y = car(args);
+  if (!is_character(y))
+    return(method_or_bust(sc, y, sym, args, sc->type_names[T_CHARACTER], 1));
+  for (s7_pointer x = cdr(args); is_pair(x); y = car(x), x = cdr(x))
+    {
+      if (!is_character(car(x)))
+	return(method_or_bust(sc, car(x), sym, set_ulist_1(sc, y, x), sc->type_names[T_CHARACTER], position_of(x, args)));
+      if (charcmp(character(y), character(car(x))) == val)
+	return(char_with_error_check(sc, x, args, sym));
+    }
+  return(sc->T);
+}
+
+static s7_pointer g_chars_are_equal(s7_scheme *sc, s7_pointer args)
+{
+  #define H_chars_are_equal "(char=? char ...) returns #t if all the character arguments are equal"
+  #define Q_chars_are_equal sc->pcl_bc
+
+  s7_pointer y = car(args);
+  if (!is_character(y))
+    return(method_or_bust(sc, y, sc->char_eq_symbol, args, sc->type_names[T_CHARACTER], 1));
+  for (s7_pointer x = cdr(args); is_pair(x); x = cdr(x))
+    {
+      if (!is_character(car(x)))
+	return(method_or_bust(sc, car(x), sc->char_eq_symbol, set_ulist_1(sc, y, x), sc->type_names[T_CHARACTER], position_of(x, args)));
+      if (car(x) != y)
+	return(char_with_error_check(sc, x, args, sc->char_eq_symbol));
+    }
+  return(sc->T);
+}
+
+
+static s7_pointer g_chars_are_less(s7_scheme *sc, s7_pointer args)
+{
+  #define H_chars_are_less "(char<? char ...) returns #t if all the character arguments are increasing"
+  #define Q_chars_are_less sc->pcl_bc
+  return(g_char_cmp(sc, args, -1, sc->char_lt_symbol));
+}
+
+static s7_pointer g_chars_are_greater(s7_scheme *sc, s7_pointer args)
+{
+  #define H_chars_are_greater "(char>? char ...) returns #t if all the character arguments are decreasing"
+  #define Q_chars_are_greater sc->pcl_bc
+  return(g_char_cmp(sc, args, 1, sc->char_gt_symbol));
+}
+
+static s7_pointer g_chars_are_geq(s7_scheme *sc, s7_pointer args)
+{
+  #define H_chars_are_geq "(char>=? char ...) returns #t if all the character arguments are equal or decreasing"
+  #define Q_chars_are_geq sc->pcl_bc
+  return(g_char_cmp_not(sc, args, -1, sc->char_geq_symbol));
+}
+
+static s7_pointer g_chars_are_leq(s7_scheme *sc, s7_pointer args)
+{
+  #define H_chars_are_leq "(char<=? char ...) returns #t if all the character arguments are equal or increasing"
+  #define Q_chars_are_leq sc->pcl_bc
+  return(g_char_cmp_not(sc, args, 1, sc->char_leq_symbol));
+}
+
+static s7_pointer g_simple_char_eq(s7_scheme *sc, s7_pointer args) {return(make_boolean(sc, car(args) == cadr(args)));} /* chooser checks types */
+
+#define check_char2_args(Sc, Caller, P1, P2) \
+  do { \
+      if (!is_character(P1)) return(method_or_bust(Sc, P1, Caller, set_plist_2(Sc, P1, P2), sc->type_names[T_CHARACTER], 1) != sc->F); \
+      if (!is_character(P2)) return(method_or_bust(Sc, P2, Caller, set_plist_2(Sc, P1, P2), sc->type_names[T_CHARACTER], 2) != sc->F); \
+     } while (0)
+
+static bool char_lt_b_unchecked(s7_pointer p1, s7_pointer p2) {return(p1 < p2);}
+static bool char_lt_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  check_char2_args(sc, sc->char_lt_symbol, p1, p2);
+  return(p1 < p2);
+}
+
+static bool char_leq_b_unchecked(s7_pointer p1, s7_pointer p2) {return(p1 <= p2);}
+static bool char_leq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  check_char2_args(sc, sc->char_leq_symbol, p1, p2);
+  return(p1 <= p2);
+}
+
+static bool char_gt_b_unchecked(s7_pointer p1, s7_pointer p2) {return(p1 > p2);}
+static bool char_gt_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  check_char2_args(sc, sc->char_gt_symbol, p1, p2);
+  return(p1 > p2);
+}
+
+static bool char_geq_b_unchecked(s7_pointer p1, s7_pointer p2) {return(p1 >= p2);}
+static bool char_geq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  check_char2_args(sc, sc->char_geq_symbol, p1, p2);
+  return(p1 >= p2);
+}
+
+static bool char_eq_b_unchecked(s7_pointer p1, s7_pointer p2) {return(p1 == p2);}
+
+static bool char_eq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  if (!is_character(p1)) return(method_or_bust(sc, p1, sc->char_eq_symbol, set_plist_2(sc, p1, p2), sc->type_names[T_CHARACTER], 1) != sc->F);
+  if (p1 == p2) return(true);
+  if (!is_character(p2)) return(method_or_bust(sc, p2, sc->char_eq_symbol, set_plist_2(sc, p1, p2), sc->type_names[T_CHARACTER], 2) != sc->F);
+  return(false);
+}
+
+static s7_pointer char_eq_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  if (!is_character(p1)) return(method_or_bust(sc, p1, sc->char_eq_symbol, set_plist_2(sc, p1, p2), sc->type_names[T_CHARACTER], 1));
+  if (p1 == p2) return(sc->T);
+  if (!is_character(p2)) return(method_or_bust(sc, p2, sc->char_eq_symbol, set_plist_2(sc, p1, p2), sc->type_names[T_CHARACTER], 2));
+  return(sc->F);
+}
+
+static s7_pointer g_char_equal_2(s7_scheme *sc, s7_pointer args)
+{
+  if (!is_character(car(args))) return(method_or_bust(sc, car(args), sc->char_eq_symbol, args, sc->type_names[T_CHARACTER], 1));
+  if (car(args) == cadr(args))
+    return(sc->T);
+  if (!is_character(cadr(args))) return(method_or_bust(sc, cadr(args), sc->char_eq_symbol, args, sc->type_names[T_CHARACTER], 2));
+  return(sc->F);
+}
+
+static s7_pointer g_char_less_2(s7_scheme *sc, s7_pointer args)
+{
+  if (!is_character(car(args))) return(method_or_bust(sc, car(args), sc->char_lt_symbol, args, sc->type_names[T_CHARACTER], 1));
+  if (!is_character(cadr(args))) return(method_or_bust(sc, cadr(args), sc->char_lt_symbol, args, sc->type_names[T_CHARACTER], 2));
+  return(make_boolean(sc, character(car(args)) < character(cadr(args))));
+}
+
+static s7_pointer g_char_greater_2(s7_scheme *sc, s7_pointer args)
+{
+  if (!is_character(car(args))) return(method_or_bust(sc, car(args), sc->char_gt_symbol, args, sc->type_names[T_CHARACTER], 1));
+  if (!is_character(cadr(args))) return(method_or_bust(sc, cadr(args), sc->char_gt_symbol, args, sc->type_names[T_CHARACTER], 2));
+  return(make_boolean(sc, character(car(args)) > character(cadr(args))));
+}
+
+static bool returns_char(s7_scheme *sc, s7_pointer arg) {return(argument_type(sc, arg) == sc->is_char_symbol);}
+
+static s7_pointer char_equal_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  if (args != 2) return(f);
+    {
+      s7_pointer arg1 = cadr(expr), arg2 = caddr(expr);
+      if ((returns_char(sc, arg1)) && (returns_char(sc, arg2)))
+	return(sc->simple_char_eq);
+    }
+  return(sc->char_equal_2);
+}
+
+static s7_pointer char_less_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer unused_expr)
+{
+  return((args == 2) ? sc->char_less_2 : f);
+}
+
+static s7_pointer char_greater_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer unused_expr)
+{
+  return((args == 2) ? sc->char_greater_2 : f);
+}
+
+
+/* -------------------------------- char-ci<? char-ci<=? char-ci>? char-ci>=? char-ci=? -------------------------------- */
+#if (!WITH_PURE_S7)
+static s7_pointer g_char_cmp_ci(s7_scheme *sc, s7_pointer args, int32_t val, s7_pointer sym)
+{
+  s7_pointer y = car(args);
+  if (!is_character(y))
+    return(method_or_bust(sc, y, sym, args, sc->type_names[T_CHARACTER], 1));
+
+  for (s7_pointer x = cdr(args); is_pair(x); y = car(x), x = cdr(x))
+    {
+      if (!is_character(car(x)))
+	return(method_or_bust(sc, car(x), sym, set_ulist_1(sc, y, x), sc->type_names[T_CHARACTER], position_of(x, args)));
+      if (charcmp(upper_character(y), upper_character(car(x))) != val)
+	return(char_with_error_check(sc, x, args, sym));
+    }
+  return(sc->T);
+}
+
+static s7_pointer g_char_cmp_ci_not(s7_scheme *sc, s7_pointer args, int32_t val, s7_pointer sym)
+{
+  s7_pointer y = car(args);
+  if (!is_character(y))
+    return(method_or_bust(sc, y, sym, args, sc->type_names[T_CHARACTER], 1));
+  for (s7_pointer x = cdr(args); is_pair(x); y = car(x), x = cdr(x))
+    {
+      if (!is_character(car(x)))
+	return(method_or_bust(sc, car(x), sym, set_ulist_1(sc, y, x), sc->type_names[T_CHARACTER], position_of(x, args)));
+      if (charcmp(upper_character(y), upper_character(car(x))) == val)
+	return(char_with_error_check(sc, x, args, sym));
+    }
+  return(sc->T);
+}
+
+static s7_pointer g_chars_are_ci_equal(s7_scheme *sc, s7_pointer args)
+{
+  #define H_chars_are_ci_equal "(char-ci=? char ...) returns #t if all the character arguments are equal, ignoring case"
+  #define Q_chars_are_ci_equal sc->pcl_bc
+  return(g_char_cmp_ci(sc, args, 0, sc->char_ci_eq_symbol));
+}
+
+static s7_pointer g_chars_are_ci_less(s7_scheme *sc, s7_pointer args)
+{
+  #define H_chars_are_ci_less "(char-ci<? char ...) returns #t if all the character arguments are increasing, ignoring case"
+  #define Q_chars_are_ci_less sc->pcl_bc
+  return(g_char_cmp_ci(sc, args, -1, sc->char_ci_lt_symbol));
+}
+
+static s7_pointer g_chars_are_ci_greater(s7_scheme *sc, s7_pointer args)
+{
+  #define H_chars_are_ci_greater "(char-ci>? char ...) returns #t if all the character arguments are decreasing, ignoring case"
+  #define Q_chars_are_ci_greater sc->pcl_bc
+  return(g_char_cmp_ci(sc, args, 1, sc->char_ci_gt_symbol));
+}
+
+static s7_pointer g_chars_are_ci_geq(s7_scheme *sc, s7_pointer args)
+{
+  #define H_chars_are_ci_geq "(char-ci>=? char ...) returns #t if all the character arguments are equal or decreasing, ignoring case"
+  #define Q_chars_are_ci_geq sc->pcl_bc
+  return(g_char_cmp_ci_not(sc, args, -1, sc->char_ci_geq_symbol));
+}
+
+static s7_pointer g_chars_are_ci_leq(s7_scheme *sc, s7_pointer args)
+{
+  #define H_chars_are_ci_leq "(char-ci<=? char ...) returns #t if all the character arguments are equal or increasing, ignoring case"
+  #define Q_chars_are_ci_leq sc->pcl_bc
+  return(g_char_cmp_ci_not(sc, args, 1, sc->char_ci_leq_symbol));
+}
+
+
+static bool char_ci_lt_b_unchecked(s7_pointer p1, s7_pointer p2) {return(upper_character(p1) < upper_character(p2));}
+static bool char_ci_lt_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  check_char2_args(sc, sc->char_ci_lt_symbol, p1, p2);
+  return(upper_character(p1) < upper_character(p2));
+}
+
+static bool char_ci_leq_b_unchecked(s7_pointer p1, s7_pointer p2) {return(upper_character(p1) <= upper_character(p2));}
+static bool char_ci_leq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  check_char2_args(sc, sc->char_ci_leq_symbol, p1, p2);
+  return(upper_character(p1) <= upper_character(p2));
+}
+
+static bool char_ci_gt_b_unchecked(s7_pointer p1, s7_pointer p2) {return(upper_character(p1) > upper_character(p2));}
+static bool char_ci_gt_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  check_char2_args(sc, sc->char_ci_gt_symbol, p1, p2);
+  return(upper_character(p1) > upper_character(p2));
+}
+
+static bool char_ci_geq_b_unchecked(s7_pointer p1, s7_pointer p2) {return(upper_character(p1) >= upper_character(p2));}
+static bool char_ci_geq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  check_char2_args(sc, sc->char_ci_geq_symbol, p1, p2);
+  return(upper_character(p1) >= upper_character(p2));
+}
+
+static bool char_ci_eq_b_unchecked(s7_pointer p1, s7_pointer p2) {return(upper_character(p1) == upper_character(p2));}
+static bool char_ci_eq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  check_char2_args(sc, sc->char_ci_eq_symbol, p1, p2);
+  return(upper_character(p1) == upper_character(p2));
+}
+
+#endif /* not pure s7 */
+
+
+/* -------------------------------- char-position -------------------------------- */
+static s7_pointer g_char_position(s7_scheme *sc, s7_pointer args)
+{
+  #define H_char_position "(char-position char-or-str str (start 0)) returns the position of the first occurrence of char in str, or #f"
+  #define Q_char_position s7_make_signature(sc, 4, \
+                            s7_make_signature(sc, 2, sc->is_integer_symbol, sc->not_symbol), \
+                            s7_make_signature(sc, 2, sc->is_char_symbol, sc->is_string_symbol), \
+                            sc->is_string_symbol, sc->is_integer_symbol)
+  const char *porig, *pset;
+  s7_int start, pos, len; /* not "int" because start arg might be most-negative-fixnum */
+  s7_pointer arg1 = car(args), arg2;
+
+  if ((!is_character(arg1)) &&
+      (!is_string(arg1)))
+    return(method_or_bust(sc, arg1, sc->char_position_symbol, args, sc->type_names[T_CHARACTER], 1));
+
+  arg2 = cadr(args);
+  if (!is_string(arg2))
+    return(method_or_bust(sc, arg2, sc->char_position_symbol, args, sc->type_names[T_STRING], 2));
+
+  if (is_pair(cddr(args)))
+    {
+      s7_pointer arg3 = caddr(args);
+      if (!s7_is_integer(arg3))
+	return(method_or_bust(sc, arg3, sc->char_position_symbol, args, sc->type_names[T_INTEGER], 3));
+      start = s7_integer_clamped_if_gmp(sc, arg3);
+      if (start < 0)
+	wrong_type_error_nr(sc, sc->char_position_symbol, 3, arg3, a_non_negative_integer_string);
+    }
+  else start = 0;
+
+  porig = string_value(arg2);
+  len = string_length(arg2);
+  if (start >= len) return(sc->F);
+
+  if (is_character(arg1))
+    {
+      char c = character(arg1);
+      const char *p = strchr((const char *)(porig + start), (int)c); /* use strchrnul in Gnu C to catch embedded null case */
+      return((p) ? make_integer(sc, p - porig) : sc->F);
+    }
+  if (string_length(arg1) == 0)
+    return(sc->F);
+  pset = string_value(arg1);
+
+  pos = strcspn((const char *)(porig + start), (const char *)pset);
+  if ((pos + start) < len)
+    return(make_integer(sc, pos + start));
+
+  /* if the string has an embedded null, we can get erroneous results here --
+   *   perhaps check for null at pos+start?  What about a searched-for string that also has embedded nulls?
+   */
+  return(sc->F);
+}
+
+static s7_pointer char_position_p_ppi(s7_scheme *sc, s7_pointer p1, s7_pointer p2, s7_int start)
+{
+  /* p1 is char, p2 is string */
+  const char *porig, *p;
+  s7_int len;
+  char c;
+
+  if (!is_string(p2))
+    wrong_type_error_nr(sc, sc->char_position_symbol, 2, p2, sc->type_names[T_STRING]);
+  if (start < 0)
+    wrong_type_error_nr(sc, sc->char_position_symbol, 3, wrap_integer(sc, start), a_non_negative_integer_string);
+
+  c = character(p1);
+  len = string_length(p2);
+  porig = string_value(p2);
+  if (start >= len) return(sc->F);
+  p = strchr((const char *)(porig + start), (int)c);
+  if (p) return(make_integer(sc, p - porig));
+  return(sc->F);
+}
+
+static s7_pointer g_char_position_csi(s7_scheme *sc, s7_pointer args)
+{
+  /* assume char arg1, no end */
+  const char *porig, *p;
+  char c = character(car(args));
+  s7_pointer arg2 = cadr(args);
+  s7_int start, len;
+
+  if (!is_string(arg2))
+    return(g_char_position(sc, args));
+
+  len = string_length(arg2); /* can't return #f here if len==0 -- need start error check first */
+  porig = string_value(arg2);
+
+  if (is_pair(cddr(args)))
+    {
+      s7_pointer arg3 = caddr(args);
+      if (!s7_is_integer(arg3))
+	return(g_char_position(sc, args));
+      start = s7_integer_clamped_if_gmp(sc, arg3);
+      if (start < 0)
+	wrong_type_error_nr(sc, sc->char_position_symbol, 3, arg3, a_non_negative_integer_string);
+      if (start >= len) return(sc->F);
+    }
+  else start = 0;
+
+  if (len == 0) return(sc->F);
+  p = strchr((const char *)(porig + start), (int)c);
+  return((p) ? make_integer(sc, p - porig) : sc->F);
+}
+
+static s7_pointer char_position_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  if ((is_character(cadr(expr))) && ((args == 2) || (args == 3)))
+    return(sc->char_position_csi);
+  return(f);
+}
+
+
+/* -------------------------------- string-position -------------------------------- */
+static s7_pointer g_string_position(s7_scheme *sc, s7_pointer args)
+{
+  #define H_string_position "(string-position str1 str2 (start 0)) returns the starting position of str1 in str2 or #f"
+  #define Q_string_position s7_make_signature(sc, 4, \
+                              s7_make_signature(sc, 2, sc->is_integer_symbol, sc->not_symbol), \
+                              sc->is_string_symbol, sc->is_string_symbol, sc->is_integer_symbol)
+  const char *s1, *s2, *p2;
+  s7_int start = 0;
+  s7_pointer s1p = car(args), s2p = cadr(args);
+
+  if (!is_string(s1p))
+    return(method_or_bust(sc, s1p, sc->string_position_symbol, args, sc->type_names[T_STRING], 1));
+  if (!is_string(s2p))
+    return(method_or_bust(sc, s2p, sc->string_position_symbol, args, sc->type_names[T_STRING], 2));
+
+  if (is_pair(cddr(args)))
+    {
+      s7_pointer arg3 = caddr(args);
+      if (!s7_is_integer(arg3))
+	return(method_or_bust(sc, arg3, sc->string_position_symbol, args, sc->type_names[T_INTEGER], 3));
+      start = s7_integer_clamped_if_gmp(sc, arg3);
+      if (start < 0)
+	wrong_type_error_nr(sc, sc->string_position_symbol, 3, caddr(args), a_non_negative_integer_string);
+    }
+
+  if (string_length(s1p) == 0)
+    return(sc->F);
+  s1 = string_value(s1p);
+  s2 = string_value(s2p);
+  if (start >= string_length(s2p))
+    return(sc->F);
+
+  p2 = strstr((const char *)(s2 + start), s1);
+  return((p2) ? make_integer(sc, p2 - s2) : sc->F);
+}
+
+
+/* -------------------------------- strings -------------------------------- */
+bool s7_is_string(s7_pointer p) {return(is_string(p));}
+
+static s7_pointer g_is_string(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_string "(string? obj) returns #t if obj is a string"
+  #define Q_is_string sc->pl_bt
+  check_boolean_method(sc, is_string, sc->is_string_symbol, args);
+}
+
+
+s7_int s7_string_length(s7_pointer str) {return(string_length(str));}
+
+
+#define NUM_STRING_WRAPPERS 8
+
+static s7_pointer wrap_string(s7_scheme *sc, const char *str, s7_int len)
+{
+  s7_pointer x = car(sc->string_wrappers);
+#if S7_DEBUGGING
+  if ((full_type(x) & (~T_GC_MARK)) != (T_STRING | T_IMMUTABLE | T_UNHEAP | T_SAFE_PROCEDURE)) fprintf(stderr, "%s\n", describe_type_bits(sc, x));
+#endif
+  sc->string_wrappers = cdr(sc->string_wrappers);
+  string_value(x) = (char *)str;
+  string_length(x) = len;
+  return(x);
+}
+
+s7_pointer s7_make_string_wrapper(s7_scheme *sc, const char *str) {return(wrap_string(sc, str, safe_strlen(str)));}
+s7_pointer s7_make_string_wrapper_with_length(s7_scheme *sc, const char *str, s7_int len) {return(wrap_string(sc, str, len));}
+
+static Inline s7_pointer inline_make_empty_string(s7_scheme *sc, s7_int len, char fill)
+{
+  s7_pointer x;
+  block_t *b;
+  if (len == 0) return(nil_string);
+  new_cell(sc, x, T_STRING);
+  b = inline_mallocate(sc, len + 1);
+  string_block(x) = b;
+  string_value(x) = (char *)block_data(b);
+  if (fill != '\0')
+    local_memset((void *)(string_value(x)), fill, len);
+  string_value(x)[len] = 0;
+  string_hash(x) = 0;
+  string_length(x) = len;
+  add_string(sc, x);
+  return(x);
+}
+
+static s7_pointer make_empty_string(s7_scheme *sc, s7_int len, char fill) {return(inline_make_empty_string(sc, len, fill));}
+
+s7_pointer s7_make_string(s7_scheme *sc, const char *str)
+{
+  s7_int len = safe_strlen(str);
+  return((len > 0) ? make_string_with_length(sc, str, len) : nil_string);
+}
+
+static char *make_semipermanent_c_string(s7_scheme *sc, const char *str) /* strcpy but avoid malloc */
+{
+  s7_int len = safe_strlen(str);
+  char *x = (char *)permalloc(sc, len + 1);
+  memcpy((void *)x, (const void *)str, len);
+  x[len] = 0;
+  return(x);
+}
+
+s7_pointer s7_make_semipermanent_string(s7_scheme *sc, const char *str) /* for (s7) string permanent within one s7 instance (freed upon s7_free) */
+{
+  s7_pointer x;
+  s7_int len;
+  if (!str) return(nil_string);
+  x = alloc_pointer(sc);
+  set_full_type(x, T_STRING | T_IMMUTABLE | T_UNHEAP);
+  set_optimize_op(x, OP_CONSTANT);
+  len = safe_strlen(str);
+  string_length(x) = len;
+  string_block(x) = NULL;
+  string_value(x) = (char *)permalloc(sc, len + 1);
+  memcpy((void *)string_value(x), (const void *)str, len);
+  string_value(x)[len] = 0;
+  string_hash(x) = 0;
+  return(x);
+}
+
+static s7_pointer make_permanent_string(const char *str, s7_int len)     /* for (s7) strings outside all s7 GC's */
+{
+  s7_pointer x = (s7_pointer)Calloc(1, sizeof(s7_cell));
+  set_full_type(x, T_STRING | T_IMMUTABLE | T_UNHEAP);
+  set_optimize_op(x, OP_CONSTANT);
+  string_length(x) = len;
+  if ((S7_DEBUGGING) && (len != safe_strlen(str))) fprintf(stderr, "%s[%d]: strlen(%s) != %" ld64 "\n", __func__, __LINE__, str, safe_strlen(str));
+  string_block(x) = NULL;
+  string_value(x) = (char *)str;
+  string_hash(x) = 0;
+  return(x);
+}
+
+s7_pointer s7_make_permanent_string(s7_scheme *sc, const char *str) /* keep s7_scheme* arg for backwards compatibility */
+{
+  return(make_permanent_string(str, safe_strlen(str)));
+}
+
+static void init_strings(void)
+{
+  nil_string = make_permanent_string("", 0);
+  nil_string->tf.u64_type = T_STRING | T_UNHEAP; /* turn off T_IMMUTABLE? -- (copy str (make-string 0))! */
+  set_optimize_op(nil_string, OP_CONSTANT);
+
+  car_a_list_string = make_permanent_string("a pair whose car is also a pair", 31);
+  cdr_a_list_string = make_permanent_string("a pair whose cdr is also a pair", 31);
+
+  caar_a_list_string = make_permanent_string("a pair whose caar is also a pair", 32);
+  cadr_a_list_string = make_permanent_string("a pair whose cadr is also a pair", 32);
+  cdar_a_list_string = make_permanent_string("a pair whose cdar is also a pair", 32);
+  cddr_a_list_string = make_permanent_string("a pair whose cddr is also a pair", 32);
+
+  caaar_a_list_string = make_permanent_string("a pair whose caaar is also a pair", 33);
+  caadr_a_list_string = make_permanent_string("a pair whose caadr is also a pair", 33);
+  cadar_a_list_string = make_permanent_string("a pair whose cadar is also a pair", 33);
+  caddr_a_list_string = make_permanent_string("a pair whose caddr is also a pair", 33);
+  cdaar_a_list_string = make_permanent_string("a pair whose cdaar is also a pair", 33);
+  cdadr_a_list_string = make_permanent_string("a pair whose cdadr is also a pair", 33);
+  cddar_a_list_string = make_permanent_string("a pair whose cddar is also a pair", 33);
+  cdddr_a_list_string = make_permanent_string("a pair whose cdddr is also a pair", 33);
+
+  a_list_string =                 make_permanent_string("a list", 6);
+  an_eq_func_string =             make_permanent_string("a procedure that can take two arguments", 39);
+  an_association_list_string =    make_permanent_string("an association list", 19);
+  a_normal_real_string =          make_permanent_string("a normal real", 13);
+  a_rational_string =             make_permanent_string("an integer or a ratio", 21);
+  a_number_string =               make_permanent_string("a number", 8);
+  a_procedure_string =            make_permanent_string("a procedure", 11);
+  a_procedure_or_a_macro_string = make_permanent_string("a procedure or a macro", 22);
+  a_normal_procedure_string =     make_permanent_string("a normal procedure", 18);
+  a_let_string =                  make_permanent_string("a let (an environment)", 22);
+  a_proper_list_string =          make_permanent_string("a proper list", 13);
+  a_boolean_string =              make_permanent_string("a boolean", 9);
+  a_byte_vector_string =          make_permanent_string("a byte-vector", 13);
+  an_input_port_string =          make_permanent_string("an input port", 13);
+  an_open_input_port_string =     make_permanent_string("an open input port", 18);
+  an_open_output_port_string =    make_permanent_string("an open output port", 19);
+  an_output_port_string =         make_permanent_string("an output port", 14);
+  an_output_port_or_f_string =    make_permanent_string("an output port or #f", 20);
+  an_input_string_port_string =   make_permanent_string("an input string port", 20);
+  an_input_file_port_string =     make_permanent_string("an input file port", 18);
+  an_output_string_port_string =  make_permanent_string("an output string port", 21);
+  an_output_file_port_string =    make_permanent_string("an output file port", 19);
+  a_thunk_string =                make_permanent_string("a thunk", 7);
+  a_symbol_string =               make_permanent_string("a symbol", 8);
+  a_non_negative_integer_string = make_permanent_string("a non-negative integer", 22);
+  an_unsigned_byte_string =       make_permanent_string("an unsigned byte", 16);
+  something_applicable_string =   make_permanent_string("a procedure or something applicable", 35);
+  a_random_state_object_string =  make_permanent_string("a random-state object", 21);
+  a_format_port_string =          make_permanent_string("#f, #t, (), or an open output port", 34);
+  a_non_constant_symbol_string =  make_permanent_string("a non-constant symbol", 21);
+  a_sequence_string =             make_permanent_string("a sequence", 10);
+  a_valid_radix_string =          make_permanent_string("it should be between 2 and 16", 29);
+  result_is_too_large_string =    make_permanent_string("result is too large", 19);
+  it_is_too_large_string =        make_permanent_string("it is too large", 15);
+  it_is_too_small_string =        make_permanent_string("it is less than the start position", 34);
+  it_is_negative_string =         make_permanent_string("it is negative", 14);
+  it_is_nan_string =              make_permanent_string("NaN usually indicates a numerical error", 39);
+  it_is_infinite_string =         make_permanent_string("it is infinite", 14);
+  too_many_indices_string =       make_permanent_string("too many indices", 16);
+  parameter_set_twice_string =    make_permanent_string("parameter set twice, ~S in ~S", 29);
+  immutable_error_string =        make_permanent_string("can't ~S ~S (it is immutable)", 29);
+  cant_bind_immutable_string =    make_permanent_string("~A: can't bind an immutable object: ~S", 38);
+  intermediate_too_large_string = make_permanent_string("intermediate result is too large", 32);
+#if (!HAVE_COMPLEX_NUMBERS)
+  no_complex_numbers_string =     make_permanent_string("this version of s7 does not support complex numbers", 51);
+#endif
+  keyword_value_missing_string =  make_permanent_string("~A: keyword argument's value is missing: ~S in ~S", 49);
+
+  format_string_1 = make_permanent_string("format: ~S ~{~S~^ ~}: ~A", 24);
+  format_string_2 = make_permanent_string("format: ~S: ~A", 14);
+  format_string_3 = make_permanent_string("format: ~S ~{~S~^ ~}~&~NT^: ~A", 30);
+  format_string_4 = make_permanent_string("format: ~S~&~NT^: ~A", 20);
+
+  too_many_arguments_string = make_permanent_string("~S: too many arguments: ~A", 26);
+  not_enough_arguments_string = make_permanent_string("~S: not enough arguments: ~A", 28);
+}
+
+
+/* -------------------------------- make-string -------------------------------- */
+s7_pointer s7_make_string_with_length(s7_scheme *sc, const char *str, s7_int len) {return(make_string_with_length(sc, str, len));}
+
+static s7_pointer g_make_string(s7_scheme *sc, s7_pointer args)
+{
+  #define H_make_string "(make-string len (val #\\space)) makes a string of length len filled with the character val (default: space)"
+  #define Q_make_string s7_make_signature(sc, 3, sc->is_string_symbol, sc->is_integer_symbol, sc->is_char_symbol)
+
+  s7_pointer n = car(args);
+  s7_int len;
+  char fill;
+  if (!s7_is_integer(n))
+    {
+      check_method(sc, n, sc->make_string_symbol, args);
+      wrong_type_error_nr(sc, sc->make_string_symbol, 1, n, sc->type_names[T_INTEGER]);
+    }
+  if ((is_pair(cdr(args))) &&
+      (!is_character(cadr(args))))
+    return(method_or_bust(sc, cadr(args), sc->make_string_symbol, args, sc->type_names[T_CHARACTER], 2));
+
+  len = s7_integer_clamped_if_gmp(sc, n);
+  if (len == 0) return(nil_string);
+  if (len < 0)
+    out_of_range_error_nr(sc, sc->make_string_symbol, int_one, n, it_is_negative_string);
+  if (len > sc->max_string_length)
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_3(sc, wrap_string(sc, "make-string length argument ~D is greater than (*s7* 'max-string-length), ~D", 76),
+			 wrap_integer(sc, len), wrap_integer(sc, sc->max_string_length)));
+
+  if (is_null(cdr(args)))
+    return(make_empty_string(sc, len, '\0')); /* #\null here means "don't fill/clear" */
+  fill = s7_character(cadr(args));
+  n = make_empty_string(sc, len, fill);
+  if (fill == '\0')
+    memclr((void *)string_value(n), (size_t)len);
+  return(n);
+}
+
+static s7_pointer make_string_p_i(s7_scheme *sc, s7_int len)
+{
+  if (len == 0) return(nil_string);
+  if (len < 0)
+    out_of_range_error_nr(sc, sc->make_string_symbol, int_one, wrap_integer(sc, len), it_is_negative_string);
+  if (len > sc->max_string_length)
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_3(sc, wrap_string(sc, "make-string length argument ~D is greater than (*s7* 'max-string-length), ~D", 76),
+			 wrap_integer(sc, len), wrap_integer(sc, sc->max_string_length)));
+  return(make_empty_string(sc, len, '\0'));
+}
+
+
+#if (!WITH_PURE_S7)
+/* -------------------------------- string-length -------------------------------- */
+static s7_pointer g_string_length(s7_scheme *sc, s7_pointer args)
+{
+  #define H_string_length "(string-length str) returns the length of the string str"
+  #define Q_string_length s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_string_symbol)
+  s7_pointer p = car(args);
+  if (!is_string(p))
+    return(sole_arg_method_or_bust(sc, p, sc->string_length_symbol, args, sc->type_names[T_STRING]));
+  return(make_integer(sc, string_length(p)));
+}
+
+static s7_int string_length_i_7p(s7_scheme *sc, s7_pointer p)
+{
+  if (!is_string(p))
+    return(integer(method_or_bust_p(sc, p, sc->string_length_symbol, sc->type_names[T_STRING])));
+  return(string_length(p));
+}
+#endif
+
+
+/* -------------------------------- string-up|downcase -------------------------------- */
+static s7_pointer g_string_downcase(s7_scheme *sc, s7_pointer args)
+{
+  #define H_string_downcase "(string-downcase str) returns the lower case version of str."
+  #define Q_string_downcase sc->pcl_s
+
+  s7_pointer p = car(args), newstr;
+  s7_int i, len;
+  uint8_t *nstr;
+  const uint8_t *ostr;
+
+  if (!is_string(p))
+    return(method_or_bust_p(sc, p, sc->string_downcase_symbol, sc->type_names[T_STRING]));
+  len = string_length(p);
+  newstr = make_empty_string(sc, len, '\0');
+
+  ostr = (const uint8_t *)string_value(p);
+  nstr = (uint8_t *)string_value(newstr);
+  if (len >= 128)
+    {
+      i = len - 1;
+      while (i >= 8)
+	LOOP_8(nstr[i] = lowers[(uint8_t)ostr[i]]; i--);
+      while (i >= 0) {nstr[i] = lowers[(uint8_t)ostr[i]]; i--;}
+    }
+  else
+    for (i = 0; i < len; i++) nstr[i] = lowers[(uint8_t)ostr[i]];
+  return(newstr);
+}
+
+static s7_pointer g_string_upcase(s7_scheme *sc, s7_pointer args)
+{
+  #define H_string_upcase "(string-upcase str) returns the upper case version of str."
+  #define Q_string_upcase sc->pcl_s
+
+  s7_pointer p = car(args), newstr;
+  s7_int i, len;
+  uint8_t *nstr;
+  const uint8_t *ostr;
+
+  if (!is_string(p))
+    return(method_or_bust_p(sc, p, sc->string_upcase_symbol, sc->type_names[T_STRING]));
+  len = string_length(p);
+  newstr = make_empty_string(sc, len, '\0');
+
+  ostr = (const uint8_t *)string_value(p);
+  nstr = (uint8_t *)string_value(newstr);
+  if (len >= 128)
+    {
+      i = len - 1;
+      while (i >= 8)
+	LOOP_8(nstr[i] = uppers[(uint8_t)ostr[i]]; i--);
+      while (i >= 0) {nstr[i] = uppers[(uint8_t)ostr[i]]; i--;}
+    }
+  else
+    for (i = 0; i < len; i++) nstr[i] = uppers[(uint8_t)ostr[i]];
+  return(newstr);
+}
+
+
+/* -------------------------------- string-ref -------------------------------- */
+static s7_pointer string_ref_1(s7_scheme *sc, s7_pointer strng, s7_pointer index)
+{
+  char *str;
+  s7_int ind;
+
+  if (!s7_is_integer(index))
+    return(method_or_bust_pp(sc, index, sc->string_ref_symbol, strng, index, sc->type_names[T_INTEGER], 2));
+  ind = s7_integer_clamped_if_gmp(sc, index);
+  if (ind < 0)
+    out_of_range_error_nr(sc, sc->string_ref_symbol, int_two, index, it_is_negative_string);
+  if (ind >= string_length(strng))
+    out_of_range_error_nr(sc, sc->string_ref_symbol, int_two, index, it_is_too_large_string);
+
+  str = string_value(strng);
+  return(chars[((uint8_t *)str)[ind]]);
+}
+
+static s7_pointer g_string_ref(s7_scheme *sc, s7_pointer args)
+{
+  #define H_string_ref "(string-ref str index) returns the character at the index-th element of the string str"
+  #define Q_string_ref s7_make_signature(sc, 3, sc->is_char_symbol, sc->is_string_symbol, sc->is_integer_symbol)
+
+  s7_pointer strng = car(args);
+  if (!is_string(strng))
+    return(method_or_bust(sc, strng, sc->string_ref_symbol, args, sc->type_names[T_STRING], 1));
+  return(string_ref_1(sc, strng, cadr(args)));
+}
+
+static s7_pointer string_ref_p_pi(s7_scheme *sc, s7_pointer p1, s7_int i1)
+{
+  if (!is_string(p1))
+    return(method_or_bust(sc, p1, sc->string_ref_symbol, set_plist_2(sc, p1, make_integer(sc, i1)), sc->type_names[T_STRING], 1));
+  if ((i1 < 0) || (i1 >= string_length(p1)))
+    out_of_range_error_nr(sc, sc->string_ref_symbol, int_two, wrap_integer(sc, i1), (i1 < 0) ? it_is_negative_string : it_is_too_large_string);
+  return(chars[((uint8_t *)string_value(p1))[i1]]);
+}
+
+static s7_pointer string_ref_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer i1)
+{
+  if (!is_string(p1))
+    return(method_or_bust_pp(sc, p1, sc->string_ref_symbol, p1, i1, sc->type_names[T_STRING], 1));
+  return(string_ref_1(sc, p1, i1));
+}
+
+static s7_pointer string_ref_p_p0(s7_scheme *sc, s7_pointer p1, s7_pointer unused_i1)
+{
+  if (!is_string(p1))
+    return(method_or_bust_pp(sc, p1, sc->string_ref_symbol, p1, int_zero, sc->type_names[T_STRING], 1));
+  if (string_length(p1) <= 0)
+    out_of_range_error_nr(sc, sc->string_ref_symbol, int_two, int_zero, it_is_too_large_string);
+  return(chars[((uint8_t *)string_value(p1))[0]]);
+}
+
+static s7_pointer string_plast_via_method(s7_scheme *sc, s7_pointer p1) /* tmock */
+{
+  s7_pointer len = method_or_bust_p(sc, p1, sc->length_symbol, sc->type_names[T_STRING]);
+  return(method_or_bust_with_type_pi(sc, p1, sc->string_ref_symbol, p1, integer(len) - 1, sc->type_names[T_STRING], 1));
+}
+
+static s7_pointer string_ref_p_plast(s7_scheme *sc, s7_pointer p1, s7_pointer unused_i1)
+{
+  if (!is_string(p1))
+    return(string_plast_via_method(sc, p1));
+  if (string_length(p1) <= 0)
+    out_of_range_error_nr(sc, sc->string_ref_symbol, int_two, wrap_integer(sc, string_length(p1) - 1), it_is_too_large_string);
+  return(chars[((uint8_t *)string_value(p1))[string_length(p1) - 1]]);
+}
+
+static inline s7_pointer string_ref_p_pi_unchecked(s7_scheme *sc, s7_pointer p1, s7_int i1)
+{
+  if ((i1 < 0) || (i1 >= string_length(p1)))
+    out_of_range_error_nr(sc, sc->string_ref_symbol, int_two, wrap_integer(sc, i1), (i1 < 0) ? it_is_negative_string : it_is_too_large_string);
+  return(chars[((uint8_t *)string_value(p1))[i1]]);
+}
+
+static s7_pointer string_ref_p_pi_direct(s7_scheme *unused_sc, s7_pointer p1, s7_int i1) {return(chars[((uint8_t *)string_value(p1))[i1]]);}
+
+
+/* -------------------------------- string-set! -------------------------------- */
+static s7_pointer g_string_set(s7_scheme *sc, s7_pointer args)
+{
+  #define H_string_set "(string-set! str index chr) sets the index-th element of the string str to the character chr"
+  #define Q_string_set s7_make_signature(sc, 4, sc->is_char_symbol, sc->is_string_symbol, sc->is_integer_symbol, sc->is_char_symbol)
+
+  s7_pointer strng = car(args), c, index = cadr(args);
+  char *str;
+  s7_int ind;
+
+  if (!is_mutable_string(strng))
+    return(mutable_method_or_bust(sc, strng, sc->string_set_symbol, args, sc->type_names[T_STRING], 1));
+  if (!s7_is_integer(index))
+    return(method_or_bust(sc, index, sc->string_set_symbol, args, sc->type_names[T_INTEGER], 2));
+
+  ind = s7_integer_clamped_if_gmp(sc, index);
+  if (ind < 0)
+    out_of_range_error_nr(sc, sc->string_set_symbol, int_two, index, a_non_negative_integer_string);
+  if (ind >= string_length(strng))
+    out_of_range_error_nr(sc, sc->string_set_symbol, int_two, index, it_is_too_large_string);
+
+  str = string_value(strng);
+  c = caddr(args);
+  if (!is_character(c))
+    return(method_or_bust(sc, c, sc->string_set_symbol, args, sc->type_names[T_CHARACTER], 3));
+
+  str[ind] = (char)s7_character(c);
+  return(c);
+}
+
+static s7_pointer string_set_p_pip(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_pointer p2)
+{
+  if (!is_string(p1))
+    wrong_type_error_nr(sc, sc->string_set_symbol, 1, p1, sc->type_names[T_STRING]);
+  if (!is_character(p2))
+    wrong_type_error_nr(sc, sc->string_set_symbol, 2, p2, sc->type_names[T_CHARACTER]);
+  if ((i1 >= 0) && (i1 < string_length(p1)))
+    string_value(p1)[i1] = s7_character(p2);
+  else out_of_range_error_nr(sc, sc->string_set_symbol, int_two, wrap_integer(sc, i1), (i1 < 0) ? it_is_negative_string : it_is_too_large_string);
+  return(p2);
+}
+
+static s7_pointer string_set_p_pip_unchecked(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_pointer p2)
+{
+  if ((i1 >= 0) && (i1 < string_length(p1)))
+    string_value(p1)[i1] = s7_character(p2);
+  else out_of_range_error_nr(sc, sc->string_set_symbol, int_two, wrap_integer(sc, i1), (i1 < 0) ? it_is_negative_string : it_is_too_large_string);
+  return(p2);
+}
+
+static s7_pointer string_set_p_pip_direct(s7_scheme *unused_sc, s7_pointer p1, s7_int i1, s7_pointer p2) {string_value(p1)[i1] = s7_character(p2); return(p2);}
+
+
+/* -------------------------------- string-append -------------------------------- */
+static s7_pointer c_object_length(s7_scheme *sc, s7_pointer obj);
+
+static bool sequence_is_empty(s7_scheme *sc, s7_pointer obj) /* "is_empty" is some C++ struct?? */
+{
+  switch (type(obj))
+    {
+    case T_BYTE_VECTOR: case T_INT_VECTOR: case T_FLOAT_VECTOR:
+    case T_VECTOR:     return(vector_length(obj) == 0);
+    case T_NIL:        return(true);
+    case T_PAIR:       return(false);
+    case T_STRING:     return(string_length(obj) == 0);
+    case T_HASH_TABLE: return(hash_table_entries(obj) == 0);
+    case T_C_OBJECT:   return(s7_is_eqv(sc, c_object_length(sc, obj), int_zero));
+    case T_LET:        if (obj != sc->rootlet) return(!tis_slot(let_slots(obj))); /* (append (rootlet) #f) */
+    default:           return(false);
+    }
+}
+
+static s7_int sequence_length(s7_scheme *sc, s7_pointer lst)
+{
+  switch (type(lst))
+    {
+    case T_PAIR:
+      {
+	s7_int len = s7_list_length(sc, lst);
+	return((len == 0) ? -1 : len);
+      }
+    case T_NIL:         return(0);
+    case T_BYTE_VECTOR: case T_INT_VECTOR: case T_FLOAT_VECTOR:
+    case T_VECTOR:      return(vector_length(lst));
+    case T_STRING:      return(string_length(lst));
+    case T_HASH_TABLE:  return(hash_table_entries(lst));
+    case T_LET:         return(let_length(sc, lst));
+    case T_C_OBJECT:
+      {
+	s7_pointer x = c_object_length(sc, lst);
+	if (s7_is_integer(x))
+	  return(s7_integer_clamped_if_gmp(sc, x));
+      }}
+  return(-1);
+}
+
+static s7_pointer s7_copy_1(s7_scheme *sc, s7_pointer caller, s7_pointer args);
+
+static void string_append_2(s7_scheme *sc, s7_pointer newstr, s7_pointer args, const s7_pointer stop_arg, s7_pointer caller)
+{
+  s7_int len;
+  char *pos;
+  s7_pointer x;
+  for (pos = string_value(newstr), x = args; x != stop_arg; x = cdr(x))
+    if (is_string(car(x)))
+      {
+	len = string_length(car(x));
+	if (len > 0)
+	  {
+	    memcpy(pos, string_value(car(x)), len);
+	    pos += len;
+	  }}
+    else
+      if (!sequence_is_empty(sc, car(x)))
+	{
+	  char *old_str = string_value(newstr);
+	  string_value(newstr) = pos;
+	  len = sequence_length(sc, car(x));
+	  s7_copy_1(sc, caller, set_plist_2(sc, car(x), newstr));
+	  string_value(newstr) = old_str;
+	  pos += len;
+	}
+}
+
+static s7_pointer g_string_append_1(s7_scheme *sc, s7_pointer args, s7_pointer caller)
+{
+  #define H_string_append "(string-append str1 ...) appends all its string arguments into one string"
+  #define Q_string_append sc->pcl_s
+
+  s7_int len = 0;
+  s7_pointer x, newstr;
+  bool just_strings = true;
+
+  if (is_null(args))
+    return(nil_string);
+
+  gc_protect_via_stack(sc, args);
+  /* get length for new string */
+  for (x = args; is_not_null(x); x = cdr(x))
+    {
+      s7_pointer p = car(x);
+      if (is_string(p))
+	len += string_length(p);
+      else
+	{
+	  s7_int newlen;
+	  if (!is_sequence(p))
+	    {
+	      unstack_gc_protect(sc);
+	      wrong_type_error_nr(sc, caller, position_of(x, args), p, sc->type_names[T_STRING]);
+	    }
+	  if (has_active_methods(sc, p)) /* look for string-append and if found, cobble up a plausible intermediate call */
+	    {
+	      s7_pointer func = find_method_with_let(sc, p, caller);
+	      if (func != sc->undefined)
+		{
+		  if (len == 0)
+		    {
+		      unstack_gc_protect(sc);
+		      return(s7_apply_function(sc, func, x)); /* not args (string-append "" "" ...) */
+		    }
+		  newstr = make_empty_string(sc, len, '\0');
+		  string_append_2(sc, newstr, args, x, caller);
+		  unstack_gc_protect(sc);
+		  return(s7_apply_function(sc, func, set_ulist_1(sc, newstr, x)));
+		}}
+	  if ((caller == sc->string_append_symbol) || (caller == sc->symbol_symbol))
+	    {
+	      unstack_gc_protect(sc);
+	      wrong_type_error_nr(sc, caller, position_of(x, args), p, sc->type_names[T_STRING]);
+	    }
+	  newlen = sequence_length(sc, p);
+	  if (newlen < 0)
+	    {
+	      unstack_gc_protect(sc);
+	      wrong_type_error_nr(sc, caller, position_of(x, args), p, sc->type_names[T_STRING]);
+	    }
+	  just_strings = false;
+	  len += newlen;
+	}}
+  if (len == 0)
+    {
+      unstack_gc_protect(sc);
+      return(nil_string);
+    }
+  if (len > sc->max_string_length)
+    {
+      unstack_gc_protect(sc);
+      error_nr(sc, sc->out_of_range_symbol,
+	       set_elist_4(sc, wrap_string(sc, "~S new string length, ~D, is larger than (*s7* 'max-string-length): ~D", 70),
+			   caller, wrap_integer(sc, len), wrap_integer(sc, sc->max_string_length)));
+    }
+  newstr = inline_make_empty_string(sc, len, '\0');
+  if (just_strings)
+    {
+      x = args;
+      for (char *pos = string_value(newstr); is_not_null(x); x = cdr(x))
+	{
+	  len = string_length(car(x));
+	  if (len > 0)
+	    {
+	      memcpy(pos, string_value(car(x)), len);
+	      pos += len;
+	    }}}
+  else string_append_2(sc, newstr, args, sc->nil, caller);
+  unstack_gc_protect(sc);
+  return(newstr);
+}
+
+static s7_pointer g_string_append(s7_scheme *sc, s7_pointer args) {return(g_string_append_1(sc, args, sc->string_append_symbol));}
+
+static inline s7_pointer string_append_1(s7_scheme *sc, s7_pointer s1, s7_pointer s2)
+{
+  if ((is_string(s1)) && (is_string(s2)))
+    {
+      s7_int len, pos = string_length(s1);
+      s7_pointer newstr;
+      if (pos == 0) return(make_string_with_length(sc, string_value(s2), string_length(s2)));
+      len = pos + string_length(s2);
+      if (len == pos) return(make_string_with_length(sc, string_value(s1), string_length(s1)));
+      if (len > sc->max_string_length)
+	error_nr(sc, sc->out_of_range_symbol,
+		 set_elist_4(sc, wrap_string(sc, "~S new string length, ~D, is larger than (*s7* 'max-string-length): ~D", 70),
+			     sc->string_append_symbol, wrap_integer(sc, len), wrap_integer(sc, sc->max_string_length)));
+      newstr = make_empty_string(sc, len, '\0'); /* len+1 0-terminated */
+      memcpy(string_value(newstr), string_value(s1), pos);
+      memcpy((char *)(string_value(newstr) + pos), string_value(s2), string_length(s2));
+      return(newstr);
+    }
+  return(g_string_append_1(sc, list_2(sc, s1, s2), sc->string_append_symbol));
+}
+
+static s7_pointer string_append_p_pp(s7_scheme *sc, s7_pointer s1, s7_pointer s2) {return(string_append_1(sc, s1, s2));}
+
+static s7_pointer g_string_append_2(s7_scheme *sc, s7_pointer args) {return(string_append_1(sc, car(args), cadr(args)));}
+
+static void check_for_substring_temp(s7_scheme *sc, s7_pointer expr);
+
+static s7_pointer string_append_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  check_for_substring_temp(sc, expr);
+  return((args == 2) ? sc->string_append_2 : f);
+}
+
+
+/* -------------------------------- substring -------------------------------- */
+static s7_pointer start_and_end(s7_scheme *sc, s7_pointer caller, s7_pointer args, int32_t position, s7_pointer index_args, s7_int *start, s7_int *end)
+{
+  /* we assume that *start=0 and *end=length, that end is "exclusive", return true if the start/end points are not changed */
+  s7_pointer pstart = car(index_args);
+  s7_int index;
+
+  if (!s7_is_integer(pstart))
+    return(method_or_bust(sc, pstart, caller, args, sc->type_names[T_INTEGER], position));
+  index = s7_integer_clamped_if_gmp(sc, pstart);
+  if ((index < 0) ||
+      (index > *end)) /* *end == length here */
+    out_of_range_error_nr(sc, caller, small_int(position), pstart, (index < 0) ? it_is_negative_string : it_is_too_large_string);
+  *start = index;
+
+  if (is_pair(cdr(index_args)))
+    {
+      s7_pointer pend = cadr(index_args);
+      if (!s7_is_integer(pend))
+	return(method_or_bust(sc, pend, caller, args, sc->type_names[T_INTEGER], position + 1));
+      index = s7_integer_clamped_if_gmp(sc, pend);
+      if ((index < *start) ||
+	  (index > *end))
+	out_of_range_error_nr(sc, caller, small_int(position + 1), pend, (index < *start) ? it_is_too_small_string : it_is_too_large_string);
+      *end = index;
+    }
+  return(sc->unused);
+}
+
+static s7_pointer g_substring(s7_scheme *sc, s7_pointer args)
+{
+  #define H_substring "(substring str start (end (length str))) returns the portion of the string str between start and \
+end: (substring \"01234\" 1 2) -> \"1\""
+  #define Q_substring s7_make_signature(sc, 4, sc->is_string_symbol, sc->is_string_symbol, sc->is_integer_symbol, sc->is_integer_symbol)
+
+  s7_pointer x, str = car(args);
+  s7_int start = 0, end, len;
+  char *s;
+
+  if (!is_string(str))
+    return(method_or_bust(sc, str, sc->substring_symbol, args, sc->type_names[T_STRING], 1));
+  end = string_length(str);
+  if (!is_null(cdr(args)))
+    {
+      x = start_and_end(sc, sc->substring_symbol, args, 2, cdr(args), &start, &end);
+      if (x != sc->unused) return(x);
+    }
+  s = string_value(str);
+  len = end - start;
+  if (len == 0) return(nil_string);
+  x = inline_make_string_with_length(sc, (char *)(s + start), len);
+  string_value(x)[len] = 0;
+  return(x);
+}
+
+static s7_pointer g_substring_uncopied(s7_scheme *sc, s7_pointer args)
+{
+  #define H_substring_uncopied "(substring-uncopied str start (end (length str))) returns an immutable string sharing the portion of the string str between start and \
+end: (substring-uncopied \"01234\" 1 2) -> \"1\".  substring-uncopied does not GC protect the original string; it is intended for very brief uses."
+  #define Q_substring_uncopied s7_make_signature(sc, 4, sc->is_string_symbol, sc->is_string_symbol, sc->is_integer_symbol, sc->is_integer_symbol)
+
+  s7_pointer str = car(args);
+  s7_int start = 0, end;
+
+  if (!is_string(str))
+    return(method_or_bust(sc, str, sc->substring_symbol, args, sc->type_names[T_STRING], 1));
+  end = string_length(str);
+  if (!is_null(cdr(args)))
+    {
+      s7_pointer x = start_and_end(sc, sc->substring_symbol, args, 2, cdr(args), &start, &end);
+      if (x != sc->unused) return(x);
+    }
+  return(wrap_string(sc, (char *)(string_value(str) + start), end - start));
+}
+
+static s7_pointer substring_uncopied_p_pii(s7_scheme *sc, s7_pointer str, s7_int start, s7_int end)
+{
+  /* is_string arg1 checked in opt */
+  if ((end < start) || (end > string_length(str)))
+    out_of_range_error_nr(sc, sc->substring_symbol, int_three, wrap_integer(sc, end), (end < start) ? it_is_too_small_string : it_is_too_large_string);
+  if (start < 0)
+    out_of_range_error_nr(sc, sc->substring_symbol, int_two, wrap_integer(sc, start), it_is_negative_string);
+  return(wrap_string(sc, (char *)(string_value(str) + start), end - start));
+}
+
+static s7_pointer g_get_output_string(s7_scheme *sc, s7_pointer args);
+
+static void check_for_substring_temp(s7_scheme *sc, s7_pointer expr)
+{
+  int32_t substrs = 0;
+  /* don't use substring_uncopied for arg if arg is returned: (reverse! (write-string (substring x ...))) */
+  for (s7_pointer p = cdr(expr); is_pair(p); p = cdr(p))
+    {
+      s7_pointer arg = car(p);
+      if ((is_pair(arg)) &&
+	  (is_symbol(car(arg))) &&
+	  (is_safely_optimized(arg)) &&
+	  (has_fn(arg)))
+	{
+	  if (fn_proc(arg) == g_substring)
+	    {
+	      if (substrs < NUM_STRING_WRAPPERS)
+		set_c_function(arg, sc->substring_uncopied);
+	      substrs++;
+	    }
+	  else
+	    if (fn_proc(arg) == g_symbol_to_string)
+	      set_c_function(arg, sc->symbol_to_string_uncopied);
+	    else
+	      if ((fn_proc(arg) == g_get_output_string) && (is_null(cddr(arg))))
+		set_c_function(arg, sc->get_output_string_uncopied);
+	}}
+}
+
+static s7_pointer string_substring_chooser(s7_scheme *sc, s7_pointer f, int32_t unused_args, s7_pointer expr)
+{
+  /* used by several string functions */
+  check_for_substring_temp(sc, expr);
+  return(f);
+}
+
+
+/* -------------------------------- string-copy -------------------------------- */
+static s7_pointer g_string_copy(s7_scheme *sc, s7_pointer args)
+{
+  #define H_string_copy "(string-copy str dest-str (dest-start 0) dest-end) returns a copy of its string argument.  If dest-str is given, \
+    string-copy copies its first argument into the second, starting at dest-start in the second string and returns dest-str"
+  #define Q_string_copy s7_make_signature(sc, 5, sc->is_string_symbol, sc->is_string_symbol, sc->is_string_symbol, sc->is_integer_symbol, sc->is_integer_symbol)
+
+  s7_pointer source = car(args), p, dest;
+  s7_int start, end;
+
+  if (!is_string(source))
+    return(method_or_bust(sc, source, sc->string_copy_symbol, args, sc->type_names[T_STRING], 1));
+  if (is_null(cdr(args)))
+    {
+      if (string_length(source) == 0) return(nil_string);
+      return(make_string_with_length(sc, string_value(source), string_length(source)));
+    }
+  dest = cadr(args);
+  if (!is_string(dest))
+    wrong_type_error_nr(sc, sc->string_copy_symbol, 2, dest, sc->type_names[T_STRING]);
+  if (is_immutable_string(dest))
+    immutable_object_error_nr(sc, set_elist_2(sc, wrap_string(sc, "can't string-copy to ~S; it is immutable", 40), dest));
+
+  end = string_length(dest);
+  p = cddr(args);
+  if (is_null(p))
+    start = 0;
+  else
+    {
+      if (!s7_is_integer(car(p)))
+	wrong_type_error_nr(sc, sc->string_copy_symbol, 3, car(p), sc->type_names[T_INTEGER]);
+      start = s7_integer_clamped_if_gmp(sc, car(p));
+      if (start < 0) start = 0;
+      p = cdr(p);
+      if (is_null(p))
+	end = start + string_length(source);
+      else
+	{
+	  if (!s7_is_integer(car(p)))
+	    wrong_type_error_nr(sc, sc->string_copy_symbol, 4, car(p), sc->type_names[T_INTEGER]);
+	  end = s7_integer_clamped_if_gmp(sc, car(p));
+	  if (end < 0) end = start;
+	}}
+  if (end > string_length(dest)) end = string_length(dest);
+  if (end <= start) return(dest);
+  if ((end - start) > string_length(source)) end = start + string_length(source);
+  memmove((void *)(string_value(dest) + start), (void *)(string_value(source)), end - start);
+  /* although I haven't tracked down a case, libasan+auto-tester reported source<dest with overlap, so use memmove */
+  return(dest);
+}
+
+static s7_pointer string_copy_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  if (args == 1) check_for_substring_temp(sc, expr);
+  return(f);
+}
+
+
+/* -------------------------------- string comparisons -------------------------------- */
+static int32_t scheme_strcmp(s7_pointer s1, s7_pointer s2)
+{
+  /* tricky here because str[i] must be treated as unsigned: (string<? (string (integer->char #xf0)) (string (integer->char #x70)))
+   *   and null or lack thereof does not say anything about the string end
+   */
+  size_t len1 = (size_t)string_length(s1);
+  size_t len2 = (size_t)string_length(s2);
+  size_t len = (len1 > len2) ? len2 : len1;
+  char *str1 = string_value(s1);
+  char *str2 = string_value(s2);
+
+  if (len < sizeof(size_t))
+    for (size_t i = 0; i < len; i++)
+      {
+	if ((uint8_t)(str1[i]) < (uint8_t )(str2[i]))
+	  return(-1);
+	if ((uint8_t)(str1[i]) > (uint8_t)(str2[i]))
+	  return(1);
+      }
+  else
+    {
+      /* this algorithm from stackoverflow(?), with various changes (original did not work for large strings, etc) */
+      size_t i = 0, last = len / sizeof(size_t);
+      for (const size_t *ptr1 = (size_t *)str1, *ptr2 = (size_t *)str2; i < last; i++)
+	if (ptr1[i] != ptr2[i])
+	  break;
+      for (size_t pos = i * sizeof(size_t); pos < len; pos++)
+	{
+	  if ((uint8_t)str1[pos] < (uint8_t)str2[pos])
+	    return(-1);
+	  if ((uint8_t)str1[pos] > (uint8_t)str2[pos])
+	    return(1);
+	}}
+  if (len1 < len2)
+    return(-1);
+  return((len1 > len2) ? 1 : 0);
+}
+
+static bool is_string_via_method(s7_scheme *sc, s7_pointer p)
+{
+  if (s7_is_string(p))
+    return(true);
+  if (has_active_methods(sc, p))
+    {
+      s7_pointer f = find_method_with_let(sc, p, sc->is_string_symbol);
+      if (f != sc->undefined)
+	return(is_true(sc, s7_apply_function(sc, f, set_plist_1(sc, p))));
+    }
+  return(false);
+}
+
+static s7_pointer g_string_cmp(s7_scheme *sc, s7_pointer args, int32_t val, s7_pointer sym)
+{
+  s7_pointer y = car(args);
+  if (!is_string(y))
+    return(method_or_bust(sc, y, sym, args, sc->type_names[T_STRING], 1));
+  for (s7_pointer x = cdr(args); is_not_null(x); y = car(x), x = cdr(x))
+    {
+      if (!is_string(car(x)))
+	return(method_or_bust(sc, car(x), sym, set_ulist_1(sc, y, x), sc->type_names[T_STRING], position_of(x, args)));
+      if (scheme_strcmp(y, car(x)) != val)
+	{
+	  for (y = cdr(x); is_pair(y); y = cdr(y))
+	    if (!is_string_via_method(sc, car(y)))
+	      wrong_type_error_nr(sc, sym, position_of(y, args), car(y), sc->type_names[T_STRING]);
+	  return(sc->F);
+	}}
+  return(sc->T);
+}
+
+static s7_pointer g_string_cmp_not(s7_scheme *sc, s7_pointer args, int32_t val, s7_pointer sym)
+{
+  s7_pointer y = car(args);
+  if (!is_string(y))
+    return(method_or_bust(sc, y, sym, args, sc->type_names[T_STRING], 1));
+  for (s7_pointer x = cdr(args); is_not_null(x); y = car(x), x = cdr(x))
+    {
+      if (!is_string(car(x)))
+	return(method_or_bust(sc, car(x), sym, set_ulist_1(sc, y, x), sc->type_names[T_STRING], position_of(x, args)));
+      if (scheme_strcmp(y, car(x)) == val)
+	{
+	  for (y = cdr(x); is_pair(y); y = cdr(y))
+	    if (!is_string_via_method(sc, car(y)))
+	      wrong_type_error_nr(sc, sym, position_of(y, args), car(y), sc->type_names[T_STRING]);
+	  return(sc->F);
+	}}
+  return(sc->T);
+}
+
+static bool scheme_strings_are_equal(s7_pointer x, s7_pointer y)
+{
+  return((string_length(x) == string_length(y)) &&
+	 (strings_are_equal_with_length(string_value(x), string_value(y), string_length(x))));
+}
+
+static s7_pointer g_strings_are_equal(s7_scheme *sc, s7_pointer args)
+{
+  #define H_strings_are_equal "(string=? str ...) returns #t if all the string arguments are equal"
+  #define Q_strings_are_equal sc->pcl_bs
+
+  /* C-based check stops at null, but we can have embedded nulls.
+   *   (let ((s1 "1234") (s2 "1245")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string=? s1 s2))
+   */
+  s7_pointer y = car(args);
+  bool happy = true;
+
+  if (!is_string(y))
+    return(method_or_bust(sc, y, sc->string_eq_symbol, args, sc->type_names[T_STRING], 1));
+  for (s7_pointer x = cdr(args); is_pair(x); x = cdr(x))
+    {
+      s7_pointer p = car(x);
+      if (y != p)
+	{
+	  if (!is_string(p))
+	    return(method_or_bust(sc, p, sc->string_eq_symbol, set_ulist_1(sc, y, x), sc->type_names[T_STRING], position_of(x, args)));
+	  if (happy)
+	    happy = scheme_strings_are_equal(p, y);
+	}}
+  return((happy) ? sc->T : sc->F);
+}
+
+static s7_pointer g_strings_are_less(s7_scheme *sc, s7_pointer args)
+{
+  #define H_strings_are_less "(string<? str ...) returns #t if all the string arguments are increasing"
+  #define Q_strings_are_less sc->pcl_bs
+  return(g_string_cmp(sc, args, -1, sc->string_lt_symbol));
+}
+
+static s7_pointer g_strings_are_greater(s7_scheme *sc, s7_pointer args)
+{
+  #define H_strings_are_greater "(string>? str ...) returns #t if all the string arguments are decreasing"
+  #define Q_strings_are_greater sc->pcl_bs
+  return(g_string_cmp(sc, args, 1, sc->string_gt_symbol));
+}
+
+static s7_pointer g_strings_are_geq(s7_scheme *sc, s7_pointer args)
+{
+  #define H_strings_are_geq "(string>=? str ...) returns #t if all the string arguments are equal or decreasing"
+  #define Q_strings_are_geq sc->pcl_bs
+  return(g_string_cmp_not(sc, args, -1, sc->string_geq_symbol));
+}
+
+static s7_pointer g_strings_are_leq(s7_scheme *sc, s7_pointer args)
+{
+  #define H_strings_are_leq "(string<=? str ...) returns #t if all the string arguments are equal or increasing"
+  #define Q_strings_are_leq sc->pcl_bs
+  return(g_string_cmp_not(sc, args, 1, sc->string_leq_symbol));
+}
+
+static s7_pointer g_string_equal_2(s7_scheme *sc, s7_pointer args)
+{
+  if (!is_string(car(args)))
+    return(method_or_bust(sc, car(args), sc->string_eq_symbol, args, sc->type_names[T_STRING], 1));
+  if (!is_string(cadr(args)))
+    return(method_or_bust(sc, cadr(args), sc->string_eq_symbol, args, sc->type_names[T_STRING], 2));
+  return(make_boolean(sc, scheme_strings_are_equal(car(args), cadr(args))));
+}
+
+static s7_pointer g_string_equal_2c(s7_scheme *sc, s7_pointer args)
+{
+  if (!is_string(car(args)))
+    return(method_or_bust(sc, car(args), sc->string_eq_symbol, args, sc->type_names[T_STRING], 1));
+  return(make_boolean(sc, scheme_strings_are_equal(car(args), cadr(args))));
+}
+
+static s7_pointer string_eq_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  if (!is_string(p1))
+    return(method_or_bust(sc, p1, sc->string_eq_symbol, set_plist_2(sc, p1, p2), sc->type_names[T_STRING], 1));
+  if (!is_string(p2))
+    return(method_or_bust(sc, p2, sc->string_eq_symbol, set_plist_2(sc, p1, p2), sc->type_names[T_STRING], 2));
+  return(make_boolean(sc, scheme_strings_are_equal(p1, p2)));
+}
+
+static s7_pointer g_string_less_2(s7_scheme *sc, s7_pointer args)
+{
+  if (!is_string(car(args)))
+    return(method_or_bust(sc, car(args), sc->string_lt_symbol, args, sc->type_names[T_STRING], 1));
+  if (!is_string(cadr(args)))
+    return(method_or_bust(sc, cadr(args), sc->string_lt_symbol, args, sc->type_names[T_STRING], 2));
+  return(make_boolean(sc, scheme_strcmp(car(args), cadr(args)) == -1));
+}
+
+static s7_pointer string_lt_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  if (!is_string(p1))
+    return(method_or_bust(sc, p1, sc->string_lt_symbol, set_plist_2(sc, p1, p2), sc->type_names[T_STRING], 1));
+  if (!is_string(p2))
+    return(method_or_bust(sc, p2, sc->string_lt_symbol, set_plist_2(sc, p1, p2), sc->type_names[T_STRING], 2));
+  return(make_boolean(sc, scheme_strcmp(p1, p2) == -1));
+}
+
+static s7_pointer g_string_greater_2(s7_scheme *sc, s7_pointer args)
+{
+  if (!is_string(car(args)))
+    return(method_or_bust(sc, car(args), sc->string_gt_symbol, args, sc->type_names[T_STRING], 1));
+  if (!is_string(cadr(args)))
+    return(method_or_bust(sc, cadr(args), sc->string_gt_symbol, args, sc->type_names[T_STRING], 2));
+  return(make_boolean(sc, scheme_strcmp(car(args), cadr(args)) == 1));
+}
+
+static s7_pointer string_gt_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  if (!is_string(p1))
+    return(method_or_bust(sc, p1, sc->string_gt_symbol, set_plist_2(sc, p1, p2), sc->type_names[T_STRING], 1));
+  if (!is_string(p2))
+    return(method_or_bust(sc, p2, sc->string_gt_symbol, set_plist_2(sc, p1, p2), sc->type_names[T_STRING], 2));
+  return(make_boolean(sc, scheme_strcmp(p1, p2) == 1));
+}
+
+#define check_string2_args(Sc, Caller, P1, P2) \
+  do { \
+      if (!is_string(p1)) return(method_or_bust(sc, P1, Caller, set_plist_2(Sc, P1, P2), sc->type_names[T_STRING], 1) != Sc->F); \
+      if (!is_string(p2)) return(method_or_bust(sc, P2, Caller, set_plist_2(Sc, P1, P2), sc->type_names[T_STRING], 2) != Sc->F); \
+     } while (0)
+
+static bool string_lt_b_unchecked(s7_pointer p1, s7_pointer p2) {return(scheme_strcmp(p1, p2) == -1);}
+static bool string_lt_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  check_string2_args(sc, sc->string_lt_symbol, p1, p2);
+  return(scheme_strcmp(p1, p2) == -1);
+}
+
+static bool string_leq_b_unchecked(s7_pointer p1, s7_pointer p2) {return(scheme_strcmp(p1, p2) != 1);}
+static bool string_leq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  check_string2_args(sc, sc->string_leq_symbol, p1, p2);
+  return(scheme_strcmp(p1, p2) != 1);
+}
+
+static bool string_gt_b_unchecked(s7_pointer p1, s7_pointer p2) {return(scheme_strcmp(p1, p2) == 1);}
+static bool string_gt_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  check_string2_args(sc, sc->string_gt_symbol, p1, p2);
+  return(scheme_strcmp(p1, p2) == 1);
+}
+
+static bool string_geq_b_unchecked(s7_pointer p1, s7_pointer p2) {return(scheme_strcmp(p1, p2) != -1);}
+static bool string_geq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  check_string2_args(sc, sc->string_geq_symbol, p1, p2);
+  return(scheme_strcmp(p1, p2) != -1);
+}
+
+static bool string_eq_b_unchecked(s7_pointer p1, s7_pointer p2) {return(scheme_strings_are_equal(p1, p2));}
+static bool string_eq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  check_string2_args(sc, sc->string_eq_symbol, p1, p2);
+  return(scheme_strings_are_equal(p1, p2));
+}
+
+static s7_pointer string_equal_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  check_for_substring_temp(sc, expr);
+  return((args == 2) ? ((is_string(caddr(expr))) ? sc->string_equal_2c : sc->string_equal_2) : f);
+}
+
+static s7_pointer string_less_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  check_for_substring_temp(sc, expr);
+  return((args == 2) ? sc->string_less_2 : f);
+}
+
+static s7_pointer string_greater_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  check_for_substring_temp(sc, expr);
+  return((args == 2) ? sc->string_greater_2 : f);
+}
+
+
+#if (!WITH_PURE_S7)
+static int32_t scheme_strcasecmp(s7_pointer s1, s7_pointer s2)
+{
+  /* same as scheme_strcmp -- watch out for unwanted sign! and lack of trailing null (length sets string end).
+   */
+  s7_int len1 = string_length(s1);
+  s7_int len2 = string_length(s2);
+  s7_int len = (len1 > len2) ? len2 : len1;
+  const uint8_t *str1 = (const uint8_t *)string_value(s1);
+  const uint8_t *str2 = (const uint8_t *)string_value(s2);
+
+  for (s7_int i = 0; i < len; i++)
+    {
+      if (uppers[(int32_t)str1[i]] < uppers[(int32_t)str2[i]])
+	return(-1);
+      if (uppers[(int32_t)str1[i]] > uppers[(int32_t)str2[i]])
+	return(1);
+    }
+  if (len1 < len2)
+    return(-1);
+  return((len1 > len2) ? 1 : 0);
+}
+
+static bool scheme_strequal_ci(s7_pointer s1, s7_pointer s2)
+{
+  /* same as scheme_strcmp -- watch out for unwanted sign! */
+  s7_int len = string_length(s1);
+  s7_int len2 = string_length(s2);
+  const uint8_t *str1, *str2;
+
+  if (len != len2) return(false);
+  str1 = (const uint8_t *)string_value(s1);
+  str2 = (const uint8_t *)string_value(s2);
+  for (s7_int i = 0; i < len; i++)
+    if (uppers[(int32_t)str1[i]] != uppers[(int32_t)str2[i]])
+      return(false);
+  return(true);
+}
+
+static s7_pointer check_rest_are_strings(s7_scheme *sc, s7_pointer sym, s7_pointer x, s7_pointer args)
+{
+  for (s7_pointer y = x; is_pair(y); y = cdr(y))
+    if (!is_string_via_method(sc, car(y)))
+      wrong_type_error_nr(sc, sym, position_of(y, args), car(y), sc->type_names[T_STRING]);
+  return(sc->F);
+}
+
+static s7_pointer g_string_ci_cmp(s7_scheme *sc, s7_pointer args, int32_t val, s7_pointer sym)
+{
+  s7_pointer y = car(args);
+
+  if (!is_string(y))
+    return(method_or_bust(sc, y, sym, args, sc->type_names[T_STRING], 1));
+
+  for (s7_pointer x = cdr(args); is_not_null(x); y = car(x), x = cdr(x))
+    {
+      if (!is_string(car(x)))
+	return(method_or_bust(sc, car(x), sym, set_ulist_1(sc, y, x), sc->type_names[T_STRING], position_of(x, args)));
+      if (val == 0)
+	{
+	  if (!scheme_strequal_ci(y, car(x)))
+	    return(check_rest_are_strings(sc, sym, cdr(x), args));
+	}
+      else
+	if (scheme_strcasecmp(y, car(x)) != val)
+	  return(check_rest_are_strings(sc, sym, cdr(x), args));
+    }
+  return(sc->T);
+}
+
+static s7_pointer g_string_ci_cmp_not(s7_scheme *sc, s7_pointer args, int32_t val, s7_pointer sym)
+{
+  s7_pointer y = car(args);
+
+  if (!is_string(y))
+    return(method_or_bust(sc, y, sym, args, sc->type_names[T_STRING], 1));
+  for (s7_pointer x = cdr(args); is_not_null(x); y = car(x), x = cdr(x))
+    {
+      if (!is_string(car(x)))
+	return(method_or_bust(sc, car(x), sym, set_ulist_1(sc, y, x), sc->type_names[T_STRING], position_of(x, args)));
+      if (scheme_strcasecmp(y, car(x)) == val)
+	return(check_rest_are_strings(sc, sym, cdr(x), args));
+    }
+  return(sc->T);
+}
+
+static s7_pointer g_strings_are_ci_equal(s7_scheme *sc, s7_pointer args)
+{
+  #define H_strings_are_ci_equal "(string-ci=? str ...) returns #t if all the string arguments are equal, ignoring case"
+  #define Q_strings_are_ci_equal sc->pcl_bs
+  return(g_string_ci_cmp(sc, args, 0, sc->string_ci_eq_symbol));
+}
+
+static s7_pointer g_strings_are_ci_less(s7_scheme *sc, s7_pointer args)
+{
+  #define H_strings_are_ci_less "(string-ci<? str ...) returns #t if all the string arguments are increasing, ignoring case"
+  #define Q_strings_are_ci_less sc->pcl_bs
+  return(g_string_ci_cmp(sc, args, -1, sc->string_ci_lt_symbol));
+}
+
+static s7_pointer g_strings_are_ci_greater(s7_scheme *sc, s7_pointer args)
+{
+  #define H_strings_are_ci_greater "(string-ci>? str ...) returns #t if all the string arguments are decreasing, ignoring case"
+  #define Q_strings_are_ci_greater sc->pcl_bs
+  return(g_string_ci_cmp(sc, args, 1, sc->string_ci_gt_symbol));
+}
+
+static s7_pointer g_strings_are_ci_geq(s7_scheme *sc, s7_pointer args)
+{
+  #define H_strings_are_ci_geq "(string-ci>=? str ...) returns #t if all the string arguments are equal or decreasing, ignoring case"
+  #define Q_strings_are_ci_geq sc->pcl_bs
+  return(g_string_ci_cmp_not(sc, args, -1, sc->string_ci_geq_symbol));
+}
+
+static s7_pointer g_strings_are_ci_leq(s7_scheme *sc, s7_pointer args)
+{
+  #define H_strings_are_ci_leq "(string-ci<=? str ...) returns #t if all the string arguments are equal or increasing, ignoring case"
+  #define Q_strings_are_ci_leq sc->pcl_bs
+  return(g_string_ci_cmp_not(sc, args, 1, sc->string_ci_leq_symbol));
+}
+
+static bool string_ci_lt_b_unchecked(s7_pointer p1, s7_pointer p2) {return(scheme_strcasecmp(p1, p2) == -1);}
+static bool string_ci_lt_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  check_string2_args(sc, sc->string_ci_lt_symbol, p1, p2);
+  return(scheme_strcasecmp(p1, p2) == -1);
+}
+
+static bool string_ci_leq_b_unchecked(s7_pointer p1, s7_pointer p2) {return(scheme_strcasecmp(p1, p2) != 1);}
+static bool string_ci_leq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  check_string2_args(sc, sc->string_ci_leq_symbol, p1, p2);
+  return(scheme_strcasecmp(p1, p2) != 1);
+}
+
+static bool string_ci_gt_b_unchecked(s7_pointer p1, s7_pointer p2) {return(scheme_strcasecmp(p1, p2) == 1);}
+static bool string_ci_gt_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  check_string2_args(sc, sc->string_ci_gt_symbol, p1, p2);
+  return(scheme_strcasecmp(p1, p2) == 1);
+}
+
+static bool string_ci_geq_b_unchecked(s7_pointer p1, s7_pointer p2) {return(scheme_strcasecmp(p1, p2) != -1);}
+static bool string_ci_geq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  check_string2_args(sc, sc->string_ci_geq_symbol, p1, p2);
+  return(scheme_strcasecmp(p1, p2) != -1);
+}
+
+static bool string_ci_eq_b_unchecked(s7_pointer p1, s7_pointer p2) {return(scheme_strcasecmp(p1, p2) == 0);}
+static bool string_ci_eq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  check_string2_args(sc, sc->string_ci_eq_symbol, p1, p2);
+  return(scheme_strcasecmp(p1, p2) == 0);
+}
+#endif /* pure s7 */
+
+static s7_pointer g_string_fill_1(s7_scheme *sc, s7_pointer caller, s7_pointer args)
+{
+  s7_pointer x = car(args), chr;
+  s7_int start = 0, end;
+
+  if (!is_string(x))
+    return(method_or_bust(sc, x, caller, args, sc->type_names[T_STRING], 1)); /* not two methods here */
+  if (is_immutable_string(x))
+    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, caller, x));
+
+  chr = cadr(args);
+  if (!is_character(chr))
+    return(method_or_bust(sc, chr, caller, args, sc->type_names[T_CHARACTER], 2));
+
+  end = string_length(x);
+  if (!is_null(cddr(args)))
+    {
+      s7_pointer p = start_and_end(sc, caller, args, 3, cddr(args), &start, &end);
+      if (p != sc->unused)
+	return(p);
+      if (start == end) return(chr);
+    }
+  if (end == 0) return(chr);
+  local_memset((void *)(string_value(x) + start), (int32_t)character(chr), end - start); /* not memclr even if chr=#\null! */
+  return(chr);
+}
+
+
+/* -------------------------------- string-fill! -------------------------------- */
+#if (!WITH_PURE_S7)
+static s7_pointer g_string_fill(s7_scheme *sc, s7_pointer args)
+{
+  #define H_string_fill "(string-fill! str chr start end) fills the string str with the character chr"
+  #define Q_string_fill s7_make_signature(sc, 5, \
+                          s7_make_signature(sc, 2, sc->is_char_symbol, sc->is_integer_symbol), \
+                          sc->is_string_symbol, sc->is_char_symbol, sc->is_integer_symbol, sc->is_integer_symbol)
+  return(g_string_fill_1(sc, sc->string_fill_symbol, args));
+}
+#endif
+
+
+/* -------------------------------- string -------------------------------- */
+const char *s7_string(s7_pointer p) {return(string_value(p));}
+
+static s7_pointer g_string_1(s7_scheme *sc, s7_pointer args, s7_pointer sym)
+{
+  int32_t i, len;
+  s7_pointer x, newstr;
+  char *str;
+
+  /* get length for new string and check arg types */
+  for (len = 0, x = args; is_not_null(x); len++, x = cdr(x))
+    {
+      s7_pointer p = car(x);
+      if (!is_character(p))
+	{
+	  if (has_active_methods(sc, p))
+	    {
+	      s7_pointer func = find_method_with_let(sc, p, sym);
+	      if (func != sc->undefined)
+		{
+		  s7_pointer y;
+		  if (len == 0)
+		    return(s7_apply_function(sc, func, args));
+		  newstr = make_empty_string(sc, len, '\0');
+		  str = string_value(newstr);
+		  for (i = 0, y = args; y != x; i++, y = cdr(y))
+		    str[i] = character(car(y));
+		  return(g_string_append_1(sc, set_plist_2(sc, newstr, s7_apply_function(sc, func, x)), sym));
+		}}
+	  wrong_type_error_nr(sc, sym, len + 1, car(x), sc->type_names[T_CHARACTER]);
+	}}
+  if (len > sc->max_string_length)
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_4(sc, wrap_string(sc, "~S result string is too large (> ~D ~D) (*s7* 'max-string-length)", 65),
+			 sym, wrap_integer(sc, len), wrap_integer(sc, sc->max_string_length)));
+  newstr = inline_make_empty_string(sc, len, '\0');
+  str = string_value(newstr);
+  for (i = 0, x = args; is_not_null(x); i++, x = cdr(x))
+    str[i] = character(car(x));
+  return(newstr);
+}
+
+static s7_pointer g_string(s7_scheme *sc, s7_pointer args)
+{
+  #define H_string "(string chr...) appends all its character arguments into one string"
+  #define Q_string s7_make_circular_signature(sc, 1, 2, sc->is_string_symbol, sc->is_char_symbol)
+  return((is_null(args)) ? nil_string : g_string_1(sc, args, sc->string_symbol));
+}
+
+static s7_pointer g_string_c1(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer c = car(args), str;
+  /* no multiple values here because no pairs below */
+  if (!is_character(c))
+    return(method_or_bust(sc, c, sc->string_symbol, args, sc->type_names[T_CHARACTER], 1));
+  str = inline_make_empty_string(sc, 1, '\0'); /* can't put character(c) here because null is handled specially */
+  string_value(str)[0] = character(c);
+  return(str);
+}
+
+static s7_pointer string_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  return(((args == 1) && (!is_pair(cadr(expr)))) ? sc->string_c1 : f);
+}
+
+static s7_pointer string_p_p(s7_scheme *sc, s7_pointer p)
+{
+  s7_pointer str;
+  if (!is_character(p)) return(g_string_1(sc, set_plist_1(sc, p), sc->string_symbol));
+  str = inline_make_empty_string(sc, 1, '\0');
+  string_value(str)[0] = character(p);
+  return(str);
+}
+
+
+/* -------------------------------- list->string -------------------------------- */
+#if (!WITH_PURE_S7)
+static s7_pointer g_list_to_string(s7_scheme *sc, s7_pointer args)
+{
+  #define H_list_to_string "(list->string lst) appends all the list's characters into one string; (apply string lst)"
+  #define Q_list_to_string s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_proper_list_symbol)
+
+  if (is_null(car(args)))
+    return(nil_string);
+  if (!s7_is_proper_list(sc, car(args)))
+    return(method_or_bust_p(sc, car(args), sc->list_to_string_symbol,
+				     wrap_string(sc, "a (proper, non-circular) list of characters", 43)));
+  return(g_string_1(sc, car(args), sc->list_to_string_symbol));
+}
+#endif
+
+
+/* -------------------------------- string->list -------------------------------- */
+static s7_pointer string_to_list(s7_scheme *sc, const char *str, s7_int len)
+{
+  s7_pointer result;
+  if (len == 0)
+    return(sc->nil);
+  check_free_heap_size(sc, len);
+  init_temp(sc->y, sc->nil);
+  for (s7_int i = len - 1; i >= 0; i--)
+    sc->y = cons_unchecked(sc, chars[((uint8_t)str[i])], sc->y);
+  result = sc->y;
+  sc->y = sc->unused;
+  return(result);
+}
+
+#if (!WITH_PURE_S7)
+static s7_pointer g_string_to_list(s7_scheme *sc, s7_pointer args)
+{
+  #define H_string_to_list "(string->list str start end) returns the elements of the string str in a list; (map values str)"
+  #define Q_string_to_list s7_make_circular_signature(sc, 2, 3, sc->is_proper_list_symbol, sc->is_string_symbol, sc->is_integer_symbol)
+
+  s7_int start = 0, end;
+  s7_pointer p, str = car(args);
+
+  if (!is_string(str))
+    return(sole_arg_method_or_bust(sc, str, sc->string_to_list_symbol, args, sc->type_names[T_STRING]));
+  end = string_length(str);
+  if (!is_null(cdr(args)))
+    {
+      p = start_and_end(sc, sc->string_to_list_symbol, args, 2, cdr(args), &start, &end);
+      if (p != sc->unused) return(p);
+      if (start == end) return(sc->nil);
+    }
+  else
+    if (end == 0) return(sc->nil);
+  if ((end - start) > sc->max_list_length)
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_5(sc, wrap_string(sc, "string->list length ~D, (- ~D ~D), is greater than (*s7* 'max-list-length), ~D", 78),
+			 wrap_integer(sc, end - start), wrap_integer(sc, end), wrap_integer(sc, start),
+			 wrap_integer(sc, sc->max_list_length)));
+  sc->w = sc->nil;
+  check_free_heap_size(sc, end - start);
+  for (s7_int i = end - 1; i >= start; i--)
+    sc->w = cons_unchecked(sc, chars[((uint8_t)string_value(str)[i])], sc->w);
+  p = sc->w;
+  sc->w = sc->unused;
+  return(p);
+}
+
+static s7_pointer string_to_list_p_p(s7_scheme *sc, s7_pointer str)
+{
+  s7_int i, len;
+  s7_pointer p;
+  const uint8_t *val;
+  if (!is_string(str)) return(sole_arg_method_or_bust(sc, str, sc->string_to_list_symbol, set_plist_1(sc, str), sc->type_names[T_STRING]));
+  len = string_length(str);
+  if (len == 0) return(sc->nil);
+  check_free_heap_size(sc, len);
+  val = (const uint8_t *)string_value(str);
+  for (p = sc->nil, i = len - 1; i >= 0; i--) p = cons_unchecked(sc, chars[val[i]], p);
+  return(p);
+}
+#endif
+
+
+/* -------------------------------- port-closed? -------------------------------- */
+static s7_pointer g_is_port_closed(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_port_closed "(port-closed? p) returns #t if the port p is closed."
+  #define Q_is_port_closed s7_make_signature(sc, 2, sc->is_boolean_symbol, \
+                              s7_make_signature(sc, 3, sc->is_input_port_symbol, sc->is_output_port_symbol, sc->not_symbol))
+  s7_pointer x = car(args);
+  if ((is_input_port(x)) || (is_output_port(x)))
+    return(make_boolean(sc, port_is_closed(x)));
+  if ((x == current_output_port(sc)) && (x == sc->F))
+    return(sc->F);
+  return(method_or_bust_p(sc, x, sc->is_port_closed_symbol, wrap_string(sc, "a port", 6)));
+}
+
+static bool is_port_closed_b_7p(s7_scheme *sc, s7_pointer x)
+{
+  if ((is_input_port(x)) || (is_output_port(x)))
+    return(port_is_closed(x));
+  if ((x == current_output_port(sc)) && (x == sc->F))
+    return(false);
+  return(method_or_bust_p(sc, x, sc->is_port_closed_symbol, wrap_string(sc, "a port", 6)) != sc->F);
+}
+
+
+/* -------------------------------- port-string -------------------------------- */
+static s7_pointer g_port_string(s7_scheme *sc, s7_pointer args)
+{
+  #define H_port_string "(port-string port) returns the port data as a string"
+  #define Q_port_string s7_make_signature(sc, 2, sc->is_string_symbol, s7_make_signature(sc, 2, sc->is_input_port_symbol, sc->is_output_port_symbol))
+
+  s7_pointer port = car(args);
+  if ((!is_input_port(port)) && (!is_output_port(port)))
+    return(method_or_bust_p(sc, port, sc->port_string_symbol, wrap_string(sc, "a port", 6)));
+  if (!is_string_port(port))
+    wrong_type_error_nr(sc, wrap_string(sc, "port-string", 11), 1, port, wrap_string(sc, "a string port", 13));
+  if ((port_is_closed(port)) || (is_function_port(port)))
+    return(nil_string);
+  if (is_output_port(port))
+    return(s7_output_string(sc, port)); /* both here and below we copy the data, so the returned value can be mutated */
+  return(make_string_with_length(sc, (const char *)port_data(port), port_data_size(port))); /* max_string_length? */
+}
+
+static void resize_port_data_for_port_string(s7_scheme *sc, s7_pointer pt, s7_int new_size)
+{
+  s7_int loc = port_data_size(pt);
+  block_t *nb;
+
+  if (new_size < loc) return;
+  if (new_size > sc->max_port_data_size)
+    error_nr(sc, make_symbol(sc, "port-too-big", 12),
+	     set_elist_1(sc, wrap_string(sc, "port data size has grown past (*s7* 'max-port-data-size)", 56)));
+  liberate(sc, port_data_block(pt));  /* reallocate has an irrelevant memcpy */
+  nb = inline_mallocate(sc, new_size);
+  port_data_block(pt) = nb;
+  port_data(pt) = (uint8_t *)(block_data(nb));
+  port_data_size(pt) = new_size;
+}
+
+
+static s7_pointer set_input_port_string(s7_scheme *sc, s7_pointer port, s7_pointer str)
+{ /*assume port is an input string port */
+  s7_int str_len;
+  if ((S7_DEBUGGING) && ((!is_input_port(port)) || (!is_string_port(port))))
+    fprintf(stderr, "%s[%d]: %s should be an input string port\n", __func__, __LINE__, display(port));
+  if (port_is_closed(port))
+    wrong_type_error_nr(sc, wrap_string(sc, "set! port-string", 16), 1, port, wrap_string(sc, "an open port", 12));
+  str_len = string_length(str);
+  port_data(port) = (uint8_t *)string_value(str);
+  port_data(port)[str_len] = '\0';
+  port_data_size(port) = str_len;
+  port_position(port) = 0;
+  port_set_string_or_function(port, str);
+  return(str);
+}
+
+static s7_pointer set_output_port_string(s7_scheme *sc, s7_pointer port, s7_pointer str)
+{ /*assume port is an output string port */
+  s7_int str_len;
+  if ((S7_DEBUGGING) && ((!is_output_port(port)) || (!is_string_port(port))))
+    fprintf(stderr, "%s[%d]: %s should be an output string port\n", __func__, __LINE__, display(port));
+  if (port_is_closed(port))
+    wrong_type_error_nr(sc, wrap_string(sc, "set! port-string", 16), 1, port, wrap_string(sc, "an open port", 12));
+  str_len = string_length(str);
+  if (port_data_size(port) <= str_len)  /* sc->initial_string_port_length is 128 */
+    resize_port_data_for_port_string(sc, port, str_len * 2);
+  memcpy((void *)port_data(port), (const void *)string_value(str), str_len);
+  port_position(port) = str_len;
+  port_data(port)[str_len] = '\0';
+  return(str);
+}
+
+static s7_pointer g_set_port_string(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer port = car(args), str;
+  if ((!is_input_port(port)) && (!is_output_port(port)))
+    wrong_type_error_nr(sc, wrap_string(sc, "set! port-string", 16), 1, port, wrap_string(sc, "an input or output port", 23));
+  if (!is_string_port(port))
+    wrong_type_error_nr(sc, wrap_string(sc, "set! port-string", 16), 1, port, wrap_string(sc, "a string port", 13));
+  str = cadr(args);
+  if (!is_string(str))
+    wrong_type_error_nr(sc, wrap_string(sc, "set! port-string", 16), 2, str, sc->type_names[T_STRING]);
+  if (is_input_port(port))
+    set_input_port_string(sc, port, str);
+  else set_output_port_string(sc, port, str);
+  return(str);
+}
+
+
+/* -------------------------------- port-position -------------------------------- */
+static s7_pointer g_port_position(s7_scheme *sc, s7_pointer args)
+{
+  #define H_port_position "(port-position input-port) returns the current location (in bytes) \
+in the port's data where the next read will take place."
+  #define Q_port_position s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_input_port_symbol)
+
+  s7_pointer port = car(args);
+  if (!(is_input_port(port)))
+    sole_arg_wrong_type_error_nr(sc, sc->port_position_symbol, port, sc->type_names[T_INPUT_PORT]);
+  if (port_is_closed(port))
+    sole_arg_wrong_type_error_nr(sc, sc->port_position_symbol, port, an_open_input_port_string);
+  if (is_string_port(port))
+    return(make_integer(sc, port_position(port)));
+#if (!MS_WINDOWS)
+  if (is_file_port(port))
+    return(make_integer(sc, ftell(port_file(port))));
+#endif
+  return(int_zero);
+}
+
+static s7_pointer g_set_port_position(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer port = car(args), pos;
+  s7_int position;
+
+  if (!(is_input_port(port)))
+    wrong_type_error_nr(sc, wrap_string(sc, "set! port-position", 18), 1, port, an_input_port_string);
+  if (port_is_closed(port))
+    wrong_type_error_nr(sc, wrap_string(sc, "set! port-position", 18), 1, port, an_open_input_port_string);
+
+  pos = cadr(args);
+  if (!is_t_integer(pos))
+    wrong_type_error_nr(sc, wrap_string(sc, "set! port-position", 18), 2, pos, sc->type_names[T_INTEGER]);
+  position = s7_integer_clamped_if_gmp(sc, pos);
+  if (position < 0)
+    out_of_range_error_nr(sc, sc->port_position_symbol, int_two, pos, it_is_negative_string);
+  if (is_string_port(port))
+    port_position(port) = (position > port_data_size(port)) ? port_data_size(port) : position;
+#if (!MS_WINDOWS)
+  else
+    if (is_file_port(port))
+      {
+	rewind(port_file(port));
+	fseek(port_file(port), (long)position, SEEK_SET);
+      }
+#endif
+  return(pos);
+}
+
+
+/* -------------------------------- port-file -------------------------------- */
+static s7_pointer g_port_file(s7_scheme *sc, s7_pointer args)
+{
+  #define H_port_file "(port-file port) returns the FILE* pointer associated with the port, wrapped in a c-pointer object"
+  #define Q_port_file s7_make_signature(sc, 2, sc->is_c_pointer_symbol, s7_make_signature(sc, 2, sc->is_input_port_symbol, sc->is_output_port_symbol))
+
+  s7_pointer port = car(args);
+  if ((!is_input_port(port)) &&
+      (!is_output_port(port)))
+    sole_arg_wrong_type_error_nr(sc, sc->port_file_symbol, port, wrap_string(sc, "a port", 6));
+  if (port_is_closed(port))
+    sole_arg_wrong_type_error_nr(sc, sc->port_file_symbol, port, wrap_string(sc, "an open port", 12));
+#if (!MS_WINDOWS)
+  if (is_file_port(port))
+    return(s7_make_c_pointer_with_type(sc, (void *)(port_file(port)), sc->file__symbol, sc->F));
+#endif
+  return(s7_make_c_pointer(sc, NULL));
+}
+
+
+/* -------------------------------- port-line-number -------------------------------- */
+static s7_pointer port_line_number_p_p(s7_scheme *sc, s7_pointer x)
+{
+  if ((!(is_input_port(x))) ||
+      (port_is_closed(x)))
+    return(method_or_bust_p(sc, x, sc->port_line_number_symbol, an_input_port_string));
+  return(make_integer(sc, port_line_number(x)));
+}
+
+static s7_pointer g_port_line_number(s7_scheme *sc, s7_pointer args)
+{
+  #define H_port_line_number "(port-line-number input-file-port) returns the current read line number of port"
+  #define Q_port_line_number s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_input_port_symbol)
+  return(port_line_number_p_p(sc, (is_null(args)) ? current_input_port(sc) : car(args)));
+}
+
+s7_int s7_port_line_number(s7_scheme *sc, s7_pointer p)
+{
+  if (!(is_input_port(p)))
+    sole_arg_wrong_type_error_nr(sc, sc->port_line_number_symbol, p, sc->type_names[T_INPUT_PORT]);
+  return(port_line_number(p));
+}
+
+static s7_pointer g_set_port_line_number(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer p, line;
+  if ((is_null(car(args))) ||
+      ((is_null(cdr(args))) && (is_t_integer(car(args)))))
+    p = current_input_port(sc);
+  else
+    {
+      p = car(args);
+      if (!(is_input_port(p)))
+	wrong_type_error_nr(sc, wrap_string(sc, "set! port-line-number", 21), 1, p, an_input_port_string);
+    }
+  line = (is_null(cdr(args)) ? car(args) : cadr(args));
+  if (!is_t_integer(line))
+    wrong_type_error_nr(sc, wrap_string(sc, "set! port-line-number", 21), 2, line, sc->type_names[T_INTEGER]);
+  port_line_number(p) = integer(line);
+  return(line);
+}
+
+
+/* -------------------------------- port-filename -------------------------------- */
+const char *s7_port_filename(s7_scheme *sc, s7_pointer x)
+{
+  if (((is_input_port(x)) ||
+       (is_output_port(x))) &&
+      (!port_is_closed(x)))
+    return(port_filename(x));
+  return(NULL);
+}
+
+static s7_pointer port_filename_p_p(s7_scheme *sc, s7_pointer x)
+{
+  if (((is_input_port(x)) || (is_output_port(x))) &&
+      (!port_is_closed(x)))
+    {
+      if (port_filename(x))
+	{
+	  if (port_filename_length(x) > sc->max_string_length)
+	    error_nr(sc, sc->out_of_range_symbol,
+		     set_elist_3(sc, wrap_string(sc, "port-filename is too long (> ~D ~D) (*s7* 'max-string-length)", 61),
+				 wrap_integer(sc, port_filename_length(x)), wrap_integer(sc, sc->max_string_length)));
+	  return(make_string_with_length(sc, port_filename(x), port_filename_length(x))); /* not wrapper here! */
+	}
+      return(nil_string);
+      /* otherwise (eval-string (port-filename)) and (string->symbol (port-filename)) segfault */
+    }
+  return(method_or_bust_p(sc, x, sc->port_filename_symbol, wrap_string(sc, "an open port", 12)));
+}
+
+static s7_pointer g_port_filename(s7_scheme *sc, s7_pointer args)
+{
+  #define H_port_filename "(port-filename file-port) returns the filename associated with port"
+  #define Q_port_filename s7_make_signature(sc, 2, sc->is_string_symbol, s7_make_signature(sc, 2, sc->is_input_port_symbol, sc->is_output_port_symbol))
+  return(port_filename_p_p(sc, (is_null(args)) ? current_input_port(sc) : car(args)));
+}
+
+
+/* -------------------------------- pair-line-number -------------------------------- */
+static s7_pointer pair_line_number_p_p(s7_scheme *sc, s7_pointer p)
+{
+  if (!is_pair(p))
+    return(method_or_bust_p(sc, p, sc->pair_line_number_symbol, sc->type_names[T_PAIR]));
+  return((has_location(p)) ? make_integer(sc, pair_line_number(p)) : sc->F);
+}
+
+static s7_pointer g_pair_line_number(s7_scheme *sc, s7_pointer args)
+{
+  #define H_pair_line_number "(pair-line-number pair) returns the line number at which it read 'pair', or #f if no such number is available"
+  #define Q_pair_line_number s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_integer_symbol, sc->not_symbol), sc->is_pair_symbol)
+  return(pair_line_number_p_p(sc, car(args)));
+}
+
+
+/* -------------------------------- pair-filename -------------------------------- */
+static s7_pointer g_pair_filename(s7_scheme *sc, s7_pointer args)
+{
+  #define H_pair_filename "(pair-filename pair) returns the name of the file containing 'pair'"
+  #define Q_pair_filename s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_string_symbol, sc->not_symbol), sc->is_pair_symbol)
+
+  s7_pointer p = car(args);
+  if (is_pair(p))
+    return((has_location(p)) ? sc->file_names[pair_file_number(p)] : sc->F); /* maybe also pair_file_number(p) > 0 */
+  check_method(sc, p, sc->pair_filename_symbol, args);
+  sole_arg_wrong_type_error_nr(sc, sc->pair_filename_symbol, p, sc->type_names[T_PAIR]);
+  return(NULL);
+}
+
+
+/* -------------------------------- input-port? -------------------------------- */
+bool s7_is_input_port(s7_scheme *sc, s7_pointer p) {return(is_input_port(p));}
+static bool is_input_port_b(s7_pointer p)          {return(is_input_port(p));}
+
+static s7_pointer g_is_input_port(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_input_port "(input-port? p) returns #t if p is an input port"
+  #define Q_is_input_port sc->pl_bt
+  check_boolean_method(sc, is_input_port, sc->is_input_port_symbol, args);
+}
+
+
+/* -------------------------------- output-port? -------------------------------- */
+bool s7_is_output_port(s7_scheme *sc, s7_pointer p) {return(is_output_port(p));}
+static bool is_output_port_b(s7_pointer p)          {return(is_output_port(p));}
+
+static s7_pointer g_is_output_port(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_output_port "(output-port? p) returns #t if p is an output port"
+  #define Q_is_output_port sc->pl_bt
+  check_boolean_method(sc, is_output_port, sc->is_output_port_symbol, args);
+}
+
+
+/* -------------------------------- current-input-port -------------------------------- */
+s7_pointer s7_current_input_port(s7_scheme *sc) {return(current_input_port(sc));}
+
+static s7_pointer g_current_input_port(s7_scheme *sc, s7_pointer unused_args)
+{
+  #define H_current_input_port "(current-input-port) returns the current input port"
+  #define Q_current_input_port s7_make_signature(sc, 1, sc->is_input_port_symbol)
+  return(current_input_port(sc));
+}
+
+static s7_pointer g_set_current_input_port(s7_scheme *sc, s7_pointer args)
+{
+  #define H_set_current_input_port "(set-current-input-port port) sets the current-input port to port and returns the previous value of the input port"
+  #define Q_set_current_input_port s7_make_signature(sc, 2, sc->is_input_port_symbol, sc->is_input_port_symbol)
+
+  s7_pointer port = car(args), old_port = current_input_port(sc);
+  if ((is_input_port(port)) &&
+      (!port_is_closed(port)))
+    set_current_input_port(sc, port);
+  else
+    {
+      check_method(sc, port, sc->set_current_input_port_symbol, args);
+      sole_arg_wrong_type_error_nr(sc, sc->set_current_input_port_symbol, port, an_open_input_port_string);
+    }
+  return(old_port);
+}
+
+s7_pointer s7_set_current_input_port(s7_scheme *sc, s7_pointer port)
+{
+  s7_pointer old_port = current_input_port(sc);
+  set_current_input_port(sc, port);
+  return(old_port);
+}
+
+
+/* -------------------------------- current-output-port -------------------------------- */
+s7_pointer s7_current_output_port(s7_scheme *sc) {return(current_output_port(sc));}
+
+s7_pointer s7_set_current_output_port(s7_scheme *sc, s7_pointer port)
+{
+  s7_pointer old_port = current_output_port(sc);
+  set_current_output_port(sc, port);
+  return(old_port);
+}
+
+static s7_pointer g_current_output_port(s7_scheme *sc, s7_pointer unused_args)
+{
+  #define H_current_output_port "(current-output-port) returns the current output port"
+  #define Q_current_output_port s7_make_signature(sc, 1, s7_make_signature(sc, 2, sc->is_output_port_symbol, sc->not_symbol))
+  return(current_output_port(sc));
+}
+
+static s7_pointer g_set_current_output_port(s7_scheme *sc, s7_pointer args)
+{
+  #define H_set_current_output_port "(set-current-output-port port) sets the current-output port to port and returns the previous value of the output port"
+  #define Q_set_current_output_port s7_make_signature(sc, 2, \
+                                      s7_make_signature(sc, 2, sc->is_output_port_symbol, sc->not_symbol), \
+                                      s7_make_signature(sc, 2, sc->is_output_port_symbol, sc->not_symbol))
+  s7_pointer port = car(args);
+  s7_pointer old_port = current_output_port(sc);
+  if (((is_output_port(port)) &&
+       (!port_is_closed(port))) || (port == sc->F))
+    set_current_output_port(sc, port);
+  else
+    {
+      check_method(sc, port, sc->set_current_output_port_symbol, args);
+      sole_arg_wrong_type_error_nr(sc, sc->set_current_output_port_symbol, port, an_output_port_or_f_string);
+    }
+  return(old_port);
+}
+
+
+/* -------------------------------- current-error-port -------------------------------- */
+s7_pointer s7_current_error_port(s7_scheme *sc) {return(current_error_port(sc));}
+
+s7_pointer s7_set_current_error_port(s7_scheme *sc, s7_pointer port)
+{
+  s7_pointer old_port = current_error_port(sc);
+  set_current_error_port(sc, port);
+  return(old_port);
+}
+
+static s7_pointer g_current_error_port(s7_scheme *sc, s7_pointer unused_args)
+{
+  #define H_current_error_port "(current-error-port) returns the current error port"
+  #define Q_current_error_port s7_make_signature(sc, 1, s7_make_signature(sc, 2, sc->is_output_port_symbol, sc->not_symbol))
+  return(current_error_port(sc));
+}
+
+static s7_pointer g_set_current_error_port(s7_scheme *sc, s7_pointer args)
+{
+  #define H_set_current_error_port "(set-current-error-port port) sets the current-error port to port and returns the previous value of the error port"
+  #define Q_set_current_error_port s7_make_signature(sc, 2, \
+                                     s7_make_signature(sc, 2, sc->is_output_port_symbol, sc->not_symbol), \
+                                     s7_make_signature(sc, 2, sc->is_output_port_symbol, sc->not_symbol))
+  s7_pointer port = car(args);
+  s7_pointer old_port = current_error_port(sc);
+  if (((is_output_port(port)) &&
+       (!port_is_closed(port))) || (port == sc->F))
+    set_current_error_port(sc, port);
+  else
+    {
+      check_method(sc, port, sc->set_current_error_port_symbol, args);
+      sole_arg_wrong_type_error_nr(sc, sc->set_current_error_port_symbol, port, an_output_port_or_f_string);
+    }
+  return(old_port);
+}
+
+
+/* -------------------------------- char-ready? -------------------------------- */
+#if (!WITH_PURE_S7)
+static s7_pointer g_is_char_ready(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_char_ready "(char-ready? (port (current-input-port))) returns #t if a character is ready for input on the given port"
+  #define Q_is_char_ready s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_input_port_symbol)
+  s7_pointer pt, res;
+
+  if (is_null(args))
+    return(make_boolean(sc, (is_input_port(current_input_port(sc))) && (is_string_port(current_input_port(sc)))));
+
+  pt = car(args);
+  if (!is_input_port(pt))
+    return(method_or_bust_p(sc, pt, sc->is_char_ready_symbol, an_input_port_string));
+  if (port_is_closed(pt))
+    sole_arg_wrong_type_error_nr(sc, sc->is_char_ready_symbol, pt, an_open_input_port_string);
+  if (!is_function_port(pt))
+    return(make_boolean(sc, is_string_port(pt)));
+
+  res = (*(port_input_function(pt)))(sc, S7_IS_CHAR_READY, pt);
+  if (is_multiple_value(res))  /* can only happen if more than one value in res */
+    {
+      clear_multiple_value(res);
+      error_nr(sc, sc->bad_result_symbol, set_elist_2(sc, wrap_string(sc, "input-function-port char-ready? returned: ~S", 44), res));
+    }
+  return(make_boolean(sc, (res != sc->F))); /* char-ready? returns a boolean */
+}
+#endif
+
+/* -------- ports -------- */
+static int32_t closed_port_read_char(s7_scheme *sc, s7_pointer port);
+static s7_pointer closed_port_read_line(s7_scheme *sc, s7_pointer port, bool with_eol);
+static void closed_port_write_char(s7_scheme *sc, uint8_t c, s7_pointer port);
+static void closed_port_write_string(s7_scheme *sc, const char *str, s7_int len, s7_pointer port);
+static void closed_port_display(s7_scheme *sc, const char *s, s7_pointer port);
+
+static void close_closed_port(s7_scheme *sc, s7_pointer port) {return;}
+
+static port_functions_t closed_port_functions =
+  {closed_port_read_char, closed_port_write_char, closed_port_write_string, NULL, NULL, NULL, NULL,
+   closed_port_read_line, closed_port_display, close_closed_port};
+
+
+static void close_input_file(s7_scheme *sc, s7_pointer p)
+{
+  if (port_filename(p)) /* for string ports, this is the original input file name */
+    {
+      liberate(sc, port_filename_block(p));
+      port_filename(p) = NULL;
+    }
+  if (port_file(p))
+    {
+      fclose(port_file(p));
+      port_file(p) = NULL;
+    }
+  if (port_needs_free(p))
+    free_port_data(sc, p);
+
+  port_port(p)->pf = &closed_port_functions;
+  port_set_closed(p, true);
+  port_position(p) = 0;
+}
+
+static void close_input_string(s7_scheme *sc, s7_pointer p)
+{
+  if (port_filename(p)) /* for string ports, this is the original input file name */
+    {
+      liberate(sc, port_filename_block(p));
+      port_filename(p) = NULL;
+    }
+  if (port_needs_free(p))
+    free_port_data(sc, p);
+
+  port_port(p)->pf = &closed_port_functions;
+  port_set_closed(p, true);
+  port_position(p) = 0;
+}
+
+static void close_simple_input_string(s7_scheme *sc, s7_pointer p)
+{
+#if S7_DEBUGGING
+  if (port_filename(p)) fprintf(stderr, "%s: port has a filename\n", __func__);
+  if (port_needs_free(p)) fprintf(stderr, "%s: port needs free\n", __func__);
+#endif
+  port_port(p)->pf = &closed_port_functions;
+  port_set_closed(p, true);
+  port_position(p) = 0;
+}
+
+void s7_close_input_port(s7_scheme *sc, s7_pointer p) {port_close(p)(sc, p);}
+
+
+/* -------------------------------- close-input-port -------------------------------- */
+static s7_pointer g_close_input_port(s7_scheme *sc, s7_pointer args)
+{
+  #define H_close_input_port "(close-input-port port) closes the port"
+  #define Q_close_input_port s7_make_signature(sc, 2, sc->is_unspecified_symbol, sc->is_input_port_symbol)
+
+  s7_pointer pt = car(args);
+  if (!is_input_port(pt))
+    return(method_or_bust_p(sc, pt, sc->close_input_port_symbol, an_input_port_string));
+  if ((!is_immutable_port(pt)) &&  /* (close-input-port *stdin*) */
+      (!is_loader_port(pt)))       /* top-level unmatched (close-input-port (current-input-port)) should not clobber the loader's input port */
+    s7_close_input_port(sc, pt);
+  return(sc->unspecified);
+}
+
+
+/* -------------------------------- flush-output-port -------------------------------- */
+static noreturn void file_error_nr(s7_scheme *sc, const char *caller, const char *descr, const char *name)
+{
+  error_nr(sc, sc->io_error_symbol,
+	   set_elist_4(sc, wrap_string(sc, "~A: ~A ~S", 9),
+		       s7_make_string_wrapper(sc, caller),
+		       s7_make_string_wrapper(sc, descr),
+		       s7_make_string_wrapper(sc, name)));
+}
+
+bool s7_flush_output_port(s7_scheme *sc, s7_pointer p)
+{
+  bool result = true;
+  if ((is_output_port(p)) && /* type=T_OUTPUT_PORT, so this excludes #f */
+      (is_file_port(p)) &&
+      (!port_is_closed(p)) &&
+      (port_file(p)))
+    {
+      if (port_position(p) > 0)
+	{
+	  result = (fwrite((void *)(port_data(p)), 1, port_position(p), port_file(p)) == (size_t)port_position(p));
+	  port_position(p) = 0;
+	}
+      if (fflush(port_file(p)) == -1)
+	file_error_nr(sc, "flush-output-port", strerror(errno), port_filename(p));
+    }
+  return(result);
+}
+
+static s7_pointer g_flush_output_port(s7_scheme *sc, s7_pointer args)
+{
+  #define H_flush_output_port "(flush-output-port port) flushes the file port (that is, it writes any accumulated output to the output file)"
+  #define Q_flush_output_port s7_make_signature(sc, 2, sc->T, s7_make_signature(sc, 2, sc->is_output_port_symbol, sc->not_symbol))
+
+  s7_pointer pt = (is_null(args)) ? current_output_port(sc) : car(args);
+  if (!is_output_port(pt))
+    {
+      if (pt == sc->F) return(pt);
+      check_method(sc, pt, sc->flush_output_port_symbol, args);
+      sole_arg_wrong_type_error_nr(sc, sc->flush_output_port_symbol, pt, an_output_port_or_f_string);
+    }
+  if (!s7_flush_output_port(sc, pt))
+    error_nr(sc, sc->io_error_symbol, set_elist_2(sc, wrap_string(sc, "flush-output-port ~S failed", 27), pt));
+  return(pt);
+}
+
+
+/* -------------------------------- close-output-port -------------------------------- */
+static void close_output_file(s7_scheme *sc, s7_pointer p)
+{
+  if (port_filename(p)) /* only a file output port has a filename(?) */
+    {
+      liberate(sc, port_filename_block(p));
+      port_filename(p) = NULL;
+      port_filename_length(p) = 0;
+    }
+  if (port_file(p))
+    {
+#if (WITH_WARNINGS)
+      if ((port_position(p) > 0) &&
+	  (fwrite((void *)(port_data(p)), 1, port_position(p), port_file(p)) != (size_t)port_position(p)))
+	s7_warn(sc, 64, "fwrite trouble in close-output-port\n");
+#else
+      if (port_position(p) > 0)
+	fwrite((void *)(port_data(p)), 1, port_position(p), port_file(p));
+#endif
+      if (fflush(port_file(p)) == -1)
+	s7_warn(sc, 64, "fflush in close-output-port: %s\n", strerror(errno));
+      fclose(port_file(p));
+      port_file(p) = NULL;
+    }
+  port_port(p)->pf = &closed_port_functions;
+  port_set_closed(p, true);
+  port_position(p) = 0;
+}
+
+static void close_output_string(s7_scheme *sc, s7_pointer p)
+{
+  if (port_data(p))
+    {
+      port_data(p) = NULL;
+      port_data_size(p) = 0;
+    }
+  port_port(p)->pf = &closed_port_functions;
+  port_set_closed(p, true);
+  port_position(p) = 0;
+}
+
+static void close_output_port(s7_scheme *sc, s7_pointer p) {port_close(p)(sc, p);}
+
+void s7_close_output_port(s7_scheme *sc, s7_pointer p)
+{
+  if ((p == sc->F) || (is_immutable_port(p))) return; /* can these happen? */
+  close_output_port(sc, p);
+}
+
+static s7_pointer g_close_output_port(s7_scheme *sc, s7_pointer args)
+{
+  #define H_close_output_port "(close-output-port port) closes the port"
+  #define Q_close_output_port s7_make_signature(sc, 2, sc->is_unspecified_symbol, s7_make_signature(sc, 2, sc->is_output_port_symbol, sc->not_symbol))
+
+  s7_pointer pt = car(args);
+  if (!is_output_port(pt))
+    {
+      if (pt == sc->F) return(sc->unspecified);
+      check_method(sc, pt, sc->close_output_port_symbol, args);
+      sole_arg_wrong_type_error_nr(sc, sc->close_output_port_symbol, pt, an_output_port_or_f_string);
+    }
+  s7_close_output_port(sc, pt);
+  return(sc->unspecified);
+}
+
+
+/* -------- read character functions -------- */
+
+static int32_t file_read_char(s7_scheme *sc, s7_pointer port) {return(fgetc(port_file(port)));}
+
+static int32_t function_read_char(s7_scheme *sc, s7_pointer port)
+{
+  s7_pointer res = (*(port_input_function(port)))(sc, S7_READ_CHAR, port);
+  if (is_eof(res)) return(EOF);
+  if (!is_character(res))          /* port_input_function might return some non-character */
+    {
+      if (is_multiple_value(res))
+	{
+	  clear_multiple_value(res);
+	  error_nr(sc, sc->bad_result_symbol, set_elist_2(sc, wrap_string(sc, "input-function-port read-char returned: ~S", 42), res));
+	}
+      error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "input-function-port read-char returned: ~S", 42), res));
+    }
+  return((int32_t)character(res));    /* kinda nutty -- we return chars[this] in g_read_char! */
+}
+
+static int32_t string_read_char(s7_scheme *sc, s7_pointer port)
+{
+  return((port_data_size(port) <= port_position(port)) ? EOF : (uint8_t)port_data(port)[port_position(port)++]); /* port_string_length is 0 if no port string */
+}
+
+static int32_t output_read_char(s7_scheme *sc, s7_pointer port)
+{
+  sole_arg_wrong_type_error_nr(sc, sc->read_char_symbol, port, an_input_port_string);
+  return(0);
+}
+
+static int32_t closed_port_read_char(s7_scheme *sc, s7_pointer port)
+{
+  sole_arg_wrong_type_error_nr(sc, sc->read_char_symbol, port, an_open_input_port_string);
+  return(0);
+}
+
+
+/* -------- read line functions -------- */
+
+static s7_pointer output_read_line(s7_scheme *sc, s7_pointer port, bool with_eol)
+{
+  sole_arg_wrong_type_error_nr(sc, sc->read_line_symbol, port, an_input_port_string);
+  return(NULL);
+}
+
+static s7_pointer closed_port_read_line(s7_scheme *sc, s7_pointer port, bool with_eol)
+{
+  sole_arg_wrong_type_error_nr(sc, sc->read_line_symbol, port, an_open_input_port_string);
+  return(NULL);
+}
+
+static s7_pointer function_read_line(s7_scheme *sc, s7_pointer port, bool with_eol)
+{
+  s7_pointer res = (*(port_input_function(port)))(sc, S7_READ_LINE, port);
+  if (is_multiple_value(res))
+    {
+      clear_multiple_value(res);
+      error_nr(sc, sc->bad_result_symbol, set_elist_2(sc, wrap_string(sc, "input-function-port read-line returned: ~S", 42), res));
+    }
+  return(res);
+}
+
+static s7_pointer stdin_read_line(s7_scheme *sc, s7_pointer port, bool with_eol)
+{
+  if (!sc->read_line_buf)
+    {
+      sc->read_line_buf_size = 1024;
+      sc->read_line_buf = (char *)Malloc(sc->read_line_buf_size);
+    }
+  if (fgets(sc->read_line_buf, sc->read_line_buf_size, stdin))
+    return(s7_make_string(sc, sc->read_line_buf)); /* fgets adds the trailing '\0' */
+  return(nil_string);
+}
+
+static s7_pointer file_read_line(s7_scheme *sc, s7_pointer port, bool with_eol)
+{
+  /* read into read_line_buf concatenating reads until newline found.  string is read_line_buf to pos-of-newline.
+   *   reset file position to reflect newline pos.
+   */
+  int32_t reads = 0;
+  char *str;
+  s7_int read_size;
+  if (!sc->read_line_buf)
+    {
+      sc->read_line_buf_size = 1024;
+      sc->read_line_buf = (char *)Malloc(sc->read_line_buf_size);
+    }
+  read_size = sc->read_line_buf_size;
+  str = fgets(sc->read_line_buf, read_size, port_file(port)); /* reads size-1 at most, EOF and newline also terminate read */
+  if (!str) return(eof_object);                               /* EOF or error with no char read */
+
+  while (true)
+    {
+      s7_int cur_size;
+      char *buf;
+      const char *snew = strchr(sc->read_line_buf, (int)'\n'); /* or maybe just strlen + end-of-string=newline */
+      if (snew)
+	{
+	  s7_int pos = (s7_int)(snew - sc->read_line_buf);
+	  port_line_number(port)++;
+	  return(inline_make_string_with_length(sc, sc->read_line_buf, (with_eol) ? (pos + 1) : pos));
+	}
+      reads++;
+      cur_size = strlen(sc->read_line_buf);
+      if ((cur_size + reads) < read_size) /* end of data, no newline */
+	return(make_string_with_length(sc, sc->read_line_buf, cur_size));
+
+      /* need more data */
+      sc->read_line_buf_size *= 2;
+      sc->read_line_buf = (char *)Realloc(sc->read_line_buf, sc->read_line_buf_size);
+      buf = (char *)(sc->read_line_buf + cur_size);
+      str = fgets(buf, read_size, port_file(port));
+      if (!str) return(eof_object);
+      read_size = sc->read_line_buf_size;
+    }
+  return(eof_object);
+}
+
+static s7_pointer string_read_line(s7_scheme *sc, s7_pointer port, bool with_eol)
+{
+  s7_int i;
+  const char *port_str = (const char *)port_data(port);
+  s7_int port_start = port_position(port);
+  const char *start = port_str + port_start;
+  const char *cur = (const char *)strchr(start, (int)'\n'); /* this can run off the end making valgrind unhappy, but I think it's innocuous */
+  if (cur)
+    {
+      s7_int len;
+      port_line_number(port)++;
+      i = cur - port_str;
+      port_position(port) = i + 1;
+      len = ((with_eol) ? i + 1 : i) - port_start;
+      if (len == 0) return(nil_string);
+      return(inline_make_string_with_length(sc, start, len));
+    }
+  i = port_data_size(port);
+  port_position(port) = i;
+  if (i <= port_start)         /* the < part can happen -- if not caught we try to create a string of length - 1 -> segfault */
+    return(eof_object);
+  return(make_string_with_length(sc, start, i - port_start));
+}
+
+
+/* -------- write character functions -------- */
+
+static void resize_port_data(s7_scheme *sc, s7_pointer pt, s7_int new_size)
+{
+  s7_int loc = port_data_size(pt);
+  block_t *nb;
+
+  if (new_size < loc) return;
+  if (new_size > sc->max_port_data_size)
+    error_nr(sc, make_symbol(sc, "port-too-big", 12),
+	     set_elist_1(sc, wrap_string(sc, "port data size has grown past (*s7* 'max-port-data-size)", 56)));
+  nb = reallocate(sc, port_data_block(pt), new_size);
+  port_data_block(pt) = nb;
+  port_data(pt) = (uint8_t *)(block_data(nb));
+  port_data_size(pt) = new_size;
+}
+
+static void string_write_char_resized(s7_scheme *sc, uint8_t c, s7_pointer pt)
+{
+  /* this division looks repetitive, but it is much faster */
+  resize_port_data(sc, pt, port_data_size(pt) * 2);
+  port_data(pt)[port_position(pt)++] = c;
+}
+
+static void string_write_char(s7_scheme *sc, uint8_t c, s7_pointer pt)
+{
+  if (port_position(pt) < port_data_size(pt))
+    port_data(pt)[port_position(pt)++] = c;
+  else string_write_char_resized(sc, c, pt);
+}
+
+static void stdout_write_char(s7_scheme *sc, uint8_t c, s7_pointer port) {fputc(c, stdout);}
+static void stderr_write_char(s7_scheme *sc, uint8_t c, s7_pointer port) {fputc(c, stderr);}
+
+static void function_write_char(s7_scheme *sc, uint8_t c, s7_pointer port)
+{
+  push_stack_direct(sc, OP_NO_VALUES);
+  /* sc->args = sc->nil; */
+  (*(port_output_function(port)))(sc, c, port);
+  unstack_with(sc, OP_NO_VALUES);
+#if 1
+  memcpy((void *)sc, (void *)(sc->stack_end), 3 * sizeof(s7_pointer)); /* code/let/args */
+#else
+  sc->code = stack_end_code(sc);
+  sc->args = stack_end_args(sc);
+#endif
+}
+
+static Inline void inline_file_write_char(s7_scheme *sc, uint8_t c, s7_pointer port)
+{
+  if (port_position(port) == sc->output_file_port_data_size)
+    {
+      fwrite((void *)(port_data(port)), 1, sc->output_file_port_data_size, port_file(port));
+      port_position(port) = 0;
+    }
+  port_data(port)[port_position(port)++] = c;
+}
+
+static void file_write_char(s7_scheme *sc, uint8_t c, s7_pointer port) {inline_file_write_char(sc, c, port);}
+
+static void input_write_char(s7_scheme *sc, uint8_t c, s7_pointer port)
+{
+  sole_arg_wrong_type_error_nr(sc, sc->write_char_symbol, port, an_output_port_string);
+}
+
+static void closed_port_write_char(s7_scheme *sc, uint8_t c, s7_pointer port)
+{
+  sole_arg_wrong_type_error_nr(sc, sc->write_char_symbol, port, an_open_output_port_string);
+}
+
+
+/* -------- write string functions -------- */
+
+static void input_write_string(s7_scheme *sc, const char *str, s7_int len, s7_pointer port)
+{
+  sole_arg_wrong_type_error_nr(sc, sc->write_symbol, port, an_output_port_string);
+}
+
+static void closed_port_write_string(s7_scheme *sc, const char *str, s7_int len, s7_pointer port)
+{
+  sole_arg_wrong_type_error_nr(sc, sc->write_symbol, port, an_open_output_port_string);
+}
+
+static void input_display(s7_scheme *sc, const char *s, s7_pointer port)
+{
+  sole_arg_wrong_type_error_nr(sc, sc->display_symbol, port, an_output_port_string);
+}
+
+static void closed_port_display(s7_scheme *sc, const char *s, s7_pointer port)
+{
+  sole_arg_wrong_type_error_nr(sc, sc->display_symbol, port, an_open_output_port_string);
+}
+
+static void stdout_write_string(s7_scheme *sc, const char *str, s7_int len, s7_pointer port)
+{
+  if (str[len] == '\0')
+    fputs(str, stdout);
+  else
+    for (s7_int i = 0; i < len; i++)
+      fputc(str[i], stdout);
+}
+
+static void stderr_write_string(s7_scheme *sc, const char *str, s7_int len, s7_pointer port)
+{
+  if (str[len] == '\0')
+    fputs(str, stderr);
+  else
+    for (s7_int i = 0; i < len; i++)
+      fputc(str[i], stderr);
+}
+
+static void string_write_string_resized(s7_scheme *sc, const char *str, s7_int len, s7_pointer pt)
+{
+  s7_int new_len = port_position(pt) + len;      /* len is known to be non-zero, str might not be 0-terminated */
+  resize_port_data(sc, pt, new_len * 2);
+  memcpy((void *)(port_data(pt) + port_position(pt)), (const void *)str, len);
+  port_position(pt) = new_len;
+}
+
+static void string_write_string(s7_scheme *sc, const char *str, s7_int len, s7_pointer pt)
+{
+  if ((S7_DEBUGGING) && (len == 0)) {fprintf(stderr, "string_write_string len == 0\n"); abort();}
+  if (port_position(pt) + len < port_data_size(pt))
+    {
+      memcpy((void *)(port_data(pt) + port_position(pt)), (const void *)str, len);
+      /* memcpy is much faster than the equivalent while loop, and faster than using the 4-bytes-at-a-time shuffle */
+      port_position(pt) += len;
+    }
+  else string_write_string_resized(sc, str, len, pt);
+}
+
+static void file_write_string(s7_scheme *sc, const char *str, s7_int len, s7_pointer pt)
+{
+  s7_int new_len = port_position(pt) + len;
+  if (new_len >= sc->output_file_port_data_size)
+    {
+      if (port_position(pt) > 0)
+	{
+#if (WITH_WARNINGS)
+	  if (fwrite((void *)(port_data(pt)), 1, port_position(pt), port_file(pt)) != (size_t)port_position(pt))
+	    s7_warn(sc, 64, "fwrite trouble in write-string\n");
+#else
+	  fwrite((void *)(port_data(pt)), 1, port_position(pt), port_file(pt));
+#endif
+	  port_position(pt) = 0;
+	}
+      fwrite((const void *)str, 1, len, port_file(pt));
+    }
+  else
+    {
+      memcpy((void *)(port_data(pt) + port_position(pt)), (const void *)str, len);
+      port_position(pt) = new_len;
+    }
+}
+
+static void string_display(s7_scheme *sc, const char *s, s7_pointer port)
+{
+  if (s) string_write_string(sc, s, safe_strlen(s), port);
+}
+
+static void file_display(s7_scheme *sc, const char *s, s7_pointer port)
+{
+  if (s)
+    {
+      if (port_position(port) > 0)
+	{
+#if (WITH_WARNINGS)
+	  if (fwrite((void *)(port_data(port)), 1, port_position(port), port_file(port)) != (size_t)port_position(port))
+	    s7_warn(sc, 64, "fwrite trouble in display\n");
+#else
+	  fwrite((void *)(port_data(port)), 1, port_position(port), port_file(port));
+#endif
+	  port_position(port) = 0;
+	}
+#if (WITH_WARNINGS)
+      if (fputs(s, port_file(port)) == EOF)
+	s7_warn(sc, 64, "write to %s: %s\n", port_filename(port), strerror(errno));
+#else
+      fputs(s, port_file(port));
+#endif
+    }
+}
+
+static void function_display(s7_scheme *sc, const char *s, s7_pointer port)
+{
+  if (!s) return;
+  push_stack_direct(sc, OP_NO_VALUES);
+  /* sc->args = sc->nil; */ /* is this needed? */
+  for (; *s; s++)
+    (*(port_output_function(port)))(sc, *s, port);
+  unstack_with(sc, OP_NO_VALUES);
+#if 1
+  memcpy((void *)sc, (void *)(sc->stack_end), 3 * sizeof(s7_pointer)); /* code/let/args */
+#else
+  sc->code = stack_end_code(sc); /* sc->curlet = stack_end_let(sc) */
+  sc->args = stack_end_args(sc);
+#endif
+}
+
+static void function_write_string(s7_scheme *sc, const char *str, s7_int len, s7_pointer pt)
+{
+  push_stack_direct(sc, OP_NO_VALUES);
+  /* sc->args = sc->nil; */ /* is this needed? */
+  for (s7_int i = 0; i < len; i++)
+    (*(port_output_function(pt)))(sc, str[i], pt);
+  unstack_with(sc, OP_NO_VALUES);
+#if 1
+  memcpy((void *)sc, (void *)(sc->stack_end), 3 * sizeof(s7_pointer)); /* code/let/args */
+#else
+  sc->code = stack_end_code(sc);
+  sc->args = stack_end_args(sc);
+#endif
+}
+
+static void stdout_display(s7_scheme *sc, const char *s, s7_pointer port) {if (s) fputs(s, stdout);}
+static void stderr_display(s7_scheme *sc, const char *s, s7_pointer port) {if (s) fputs(s, stderr);}
+
+
+/* -------------------------------- write-string -------------------------------- */
+static s7_pointer g_write_string(s7_scheme *sc, s7_pointer args)
+{
+  #define H_write_string "(write-string str port start end) writes str to port."
+  #define Q_write_string s7_make_circular_signature(sc, 3, 4, \
+                           sc->is_string_symbol, sc->is_string_symbol, \
+                           s7_make_signature(sc, 2, sc->is_output_port_symbol, sc->not_symbol),\
+                           sc->is_integer_symbol)
+  s7_pointer str = car(args), port;
+  s7_int start = 0, end;
+  if (!is_string(str))
+    return(method_or_bust(sc, str, sc->write_string_symbol, args, sc->type_names[T_STRING], 1));
+
+  end = string_length(str);
+  if (!is_null(cdr(args)))
+    {
+      s7_pointer inds = cddr(args);
+      port = cadr(args);
+      if (!is_null(inds))
+	{
+	  s7_pointer p = start_and_end(sc, sc->write_string_symbol, args, 3, inds, &start, &end);
+	  if (p != sc->unused) return(p);
+	}}
+  else port = current_output_port(sc);
+  if (!is_output_port(port))
+    {
+      if (port == sc->F)
+	{
+	  s7_int len;
+	  if ((start == 0) && (end == string_length(str)))
+	    return(str);
+	  len = (s7_int)(end - start);
+	  return(make_string_with_length(sc, (char *)(string_value(str) + start), len));
+	}
+      check_method(sc, port, sc->write_string_symbol, args);
+      wrong_type_error_nr(sc, sc->write_string_symbol, 2, port, an_output_port_or_f_string);
+    }
+  if (port_is_closed(port)) wrong_type_error_nr(sc, sc->write_string_symbol, 2, port, an_open_output_port_string);
+  if (start == end) return(str);
+  port_write_string(port)(sc, (char *)(string_value(str) + start), (end - start), port);
+  return(str);
+}
+
+static s7_pointer write_string_p_pp(s7_scheme *sc, s7_pointer str, s7_pointer port)
+{
+  if (!is_string(str))
+    return(method_or_bust_pp(sc, str, sc->write_string_symbol, str, port, sc->type_names[T_STRING], 1));
+  if (!is_output_port(port))
+    {
+      if (port == sc->F) return(str);
+      return(method_or_bust_pp(sc, port, sc->write_string_symbol, str, port, an_output_port_string, 2));
+    }
+  if (string_length(str) > 0)
+    port_write_string(port)(sc, string_value(str), string_length(str), port);
+  return(str);
+}
+
+
+/* -------- skip to newline readers -------- */
+static token_t token(s7_scheme *sc);
+
+static token_t file_read_semicolon(s7_scheme *sc, s7_pointer pt)
+{
+  int32_t c;
+  do (c = fgetc(port_file(pt))); while ((c != '\n') && (c != EOF));
+  port_line_number(pt)++;
+  return((c == EOF) ? TOKEN_EOF : token(sc));
+}
+
+static token_t string_read_semicolon(s7_scheme *sc, s7_pointer pt)
+{
+  const char *str = (const char *)(port_data(pt) + port_position(pt));
+  const char *orig_str = strchr(str, (int)'\n');
+  if (!orig_str)
+    {
+      port_position(pt) = port_data_size(pt);
+      return(TOKEN_EOF);
+    }
+  port_position(pt) += (orig_str - str + 1); /* + 1 because strchr leaves orig_str pointing at the newline */
+  port_line_number(pt)++;
+  return(token(sc));
+}
+
+
+/* -------- white space readers -------- */
+
+static int32_t file_read_white_space(s7_scheme *sc, s7_pointer port)
+{
+  int32_t c;
+  while (is_white_space(c = fgetc(port_file(port))))
+    if (c == '\n')
+      port_line_number(port)++;
+  return(c);
+}
+
+static int32_t terminated_string_read_white_space(s7_scheme *sc, s7_pointer pt)
+{
+  const uint8_t *str = (const uint8_t *)(port_data(pt) + port_position(pt));
+  uint8_t c;
+  /* here we know we have null termination and white_space[#\null] is false */
+  while (white_space[c = *str++]) /* 255 is not -1 = EOF */
+    if (c == '\n')
+      port_line_number(pt)++;
+  port_position(pt) = (c) ? str - port_data(pt) : port_data_size(pt);
+  return((int32_t)c);
+}
+
+
+/* -------- name readers -------- */
+#define BASE_10 10
+
+static s7_pointer file_read_name_or_sharp(s7_scheme *sc, s7_pointer pt, bool atom_case)
+{
+  int32_t c;
+  s7_int i = 1;  /* sc->strbuf[0] has the first char of the string we're reading */
+  do {
+    c = fgetc(port_file(pt)); /* might return EOF */
+    if (c == '\n')
+      port_line_number(pt)++;
+
+    sc->strbuf[i++] = (unsigned char)c;
+    if (i >= sc->strbuf_size)
+      resize_strbuf(sc, i);
+  } while ((c != EOF) && (char_ok_in_a_name[c]));
+
+  if ((i == 2) &&
+      (sc->strbuf[0] == '\\'))
+    sc->strbuf[2] = '\0';
+  else
+    {
+      if (c != EOF)
+	{
+	  if (c == '\n')
+	    port_line_number(pt)--;
+	  ungetc(c, port_file(pt));
+	}
+      sc->strbuf[i - 1] = '\0';
+    }
+  if (atom_case)
+    return(make_atom(sc, sc->strbuf, BASE_10, SYMBOL_OK, WITH_OVERFLOW_ERROR));
+  return(make_sharp_constant(sc, sc->strbuf, WITH_OVERFLOW_ERROR, pt, true));
+}
+
+static s7_pointer file_read_name(s7_scheme *sc, s7_pointer pt)  {return(file_read_name_or_sharp(sc, pt, true));}
+static s7_pointer file_read_sharp(s7_scheme *sc, s7_pointer pt) {return(file_read_name_or_sharp(sc, pt, false));}
+
+static s7_pointer string_read_name_no_free(s7_scheme *sc, s7_pointer pt)
+{
+  /* sc->strbuf[0] has the first char of the string we're reading */
+  s7_pointer result;
+  uint8_t *str = (uint8_t *)(port_data(pt) + port_position(pt));
+
+  if (char_ok_in_a_name[*str])
+    {
+      s7_int k;
+      uint8_t *orig_str = str - 1;
+      str++;
+      while (char_ok_in_a_name[*str]) str++;
+      k = str - orig_str;
+      if (*str != 0)
+	port_position(pt) += (k - 1);
+      else port_position(pt) = port_data_size(pt);
+      /* this is equivalent to:
+       *    str = strpbrk(str, "(); \"\t\r\n");
+       *    if (!str) {k = strlen(orig_str); str = (char *)(orig_str + k);} else k = str - orig_str;
+       * but slightly faster.
+       */
+      if (!number_table[*orig_str])
+	return(inline_make_symbol(sc, (const char *)orig_str, k));
+
+      /* eval_c_string string is a constant so we can't set and unset the token's end char */
+      if ((k + 1) >= sc->strbuf_size)
+	resize_strbuf(sc, k + 1);
+
+      memcpy((void *)(sc->strbuf), (void *)orig_str, k);
+      sc->strbuf[k] = '\0';
+      return(make_atom(sc, sc->strbuf, BASE_10, SYMBOL_OK, WITH_OVERFLOW_ERROR));
+    }
+  result = sc->singletons[(uint8_t)(sc->strbuf[0])];
+  if (!result)
+    {
+      sc->strbuf[1] = '\0';
+      result = make_symbol(sc, sc->strbuf, 1);
+      sc->singletons[(uint8_t)(sc->strbuf[0])] = result;
+    }
+  return(result);
+}
+
+static s7_pointer string_read_sharp(s7_scheme *sc, s7_pointer pt)
+{
+  /* sc->strbuf[0] has the first char of the string we're reading.
+   *   since a *#readers* function might want to get further input, we can't mess with the input even when it is otherwise safe
+   */
+  char *str = (char *)(port_data(pt) + port_position(pt));
+  if (char_ok_in_a_name[(uint8_t)*str])
+    {
+      s7_int k;
+      char *orig_str = (char *)(str - 1);
+      str++;
+      while (char_ok_in_a_name[(uint8_t)(*str)]) {str++;}
+      k = str - orig_str;
+      port_position(pt) += (k - 1);
+      if ((k + 1) >= sc->strbuf_size)
+	resize_strbuf(sc, k + 1);
+      memcpy((void *)(sc->strbuf), (void *)orig_str, k);
+      sc->strbuf[k] = '\0';
+      return(make_sharp_constant(sc, sc->strbuf, WITH_OVERFLOW_ERROR, pt, true));
+    }
+  if (sc->strbuf[0] == 'f')
+    return(sc->F);
+  if (sc->strbuf[0] == 't')
+    return(sc->T);
+  if (sc->strbuf[0] == '\\')
+    {
+      /* must be from #\( and friends -- a character that happens to be not ok-in-a-name */
+      sc->strbuf[1] = str[0];
+      sc->strbuf[2] = '\0';
+      port_position(pt)++;
+    }
+  else sc->strbuf[1] = '\0';
+  return(make_sharp_constant(sc, sc->strbuf, WITH_OVERFLOW_ERROR, pt, true));
+}
+
+static s7_pointer string_read_name(s7_scheme *sc, s7_pointer pt)
+{
+  /* port_string was allocated (and read from a file) so we can mess with it directly */
+  s7_pointer result;
+  uint8_t *str = (uint8_t *)(port_data(pt) + port_position(pt));
+  if (char_ok_in_a_name[*str])
+    {
+      s7_int k;
+      uint8_t endc;
+      uint8_t *orig_str = str - 1;
+      str++;
+      while (char_ok_in_a_name[*str]) str++;
+      k = str - orig_str;
+      port_position(pt) += (k - 1);
+      if (!number_table[*orig_str])
+	return(inline_make_symbol(sc, (const char *)orig_str, k));
+      endc = *str;
+      *str = 0;
+      result = make_atom(sc, (char *)orig_str, BASE_10, SYMBOL_OK, WITH_OVERFLOW_ERROR);
+      *str = endc;
+      return(result);
+    }
+  result = sc->singletons[(uint8_t)(sc->strbuf[0])];
+  if (!result)
+    {
+      sc->strbuf[1] = '\0';
+      result = make_symbol(sc, sc->strbuf, 1);
+      sc->singletons[(uint8_t)(sc->strbuf[0])] = result;
+    }
+  return(result);
+}
+
+static void port_set_filename(s7_scheme *sc, s7_pointer p, const char *name, size_t len)
+{
+  block_t *b = inline_mallocate(sc, len + 1);
+  port_filename_block(p) = b;
+  port_filename(p) = (char *)block_data(b);
+  memcpy((void *)block_data(b), (const void *)name, len);
+  port_filename(p)[len] = '\0';
+}
+
+static block_t *mallocate_port(s7_scheme *sc)
+{
+  #define PORT_LIST 8 /* sizeof(port_t): 160 */
+  block_t *p = sc->block_lists[PORT_LIST];
+  if (p)
+    sc->block_lists[PORT_LIST] = (block_t *)block_next(p);
+  else
+    { /* this is mallocate without the index calc */
+      p = mallocate_block(sc);
+      block_data(p) = (void *)permalloc(sc, (size_t)(1 << PORT_LIST));
+      block_set_index(p, PORT_LIST);
+    }
+  block_set_size(p, sizeof(port_t));
+#if (S7_DEBUGGING)
+  sc->blocks_mallocated[PORT_LIST]++;
+#endif
+  return(p);
+}
+
+static port_functions_t input_file_functions =
+  {file_read_char, input_write_char, input_write_string, file_read_semicolon, file_read_white_space,
+   file_read_name, file_read_sharp, file_read_line, input_display, close_input_file};
+
+static port_functions_t input_string_functions_1 =
+  {string_read_char, input_write_char, input_write_string, string_read_semicolon, terminated_string_read_white_space,
+   string_read_name, string_read_sharp, string_read_line, input_display, close_input_string};
+
+static s7_pointer read_file(s7_scheme *sc, FILE *fp, const char *name, s7_int max_size, const char *caller)
+{
+  s7_pointer port;
+#if (!MS_WINDOWS)
+  s7_int size;
+#endif
+  block_t *b = mallocate_port(sc);
+  new_cell(sc, port, T_INPUT_PORT);
+  gc_protect_via_stack(sc, port);
+  port_block(port) = b;
+  port_port(port) = (port_t *)block_data(b);
+  port_set_closed(port, false);
+  port_set_string_or_function(port, sc->nil);
+  /* if we're constantly opening files, and each open saves the file name in permanent memory, we gradually core-up */
+  port_filename_length(port) = safe_strlen(name);
+  port_set_filename(sc, port, name, port_filename_length(port));
+  port_line_number(port) = 1;  /* first line is numbered 1 */
+  port_file_number(port) = 0;
+  add_input_port(sc, port);
+
+#if (!MS_WINDOWS)
+  /* this doesn't work in MS C */
+  fseek(fp, 0, SEEK_END);
+  size = ftell(fp);
+  rewind(fp);
+
+  /* pseudo files (under /proc for example) have size=0, but we can read them, so don't assume a 0 length file is empty */
+
+  if ((size > 0) &&   /* if (size != 0) we get (open-input-file "/dev/tty") -> (open "/dev/tty") read 0 bytes of an expected -1? */
+      ((max_size < 0) || (size < max_size))) /* load uses max_size = -1 */
+    {
+      block_t *block = mallocate(sc, size + 2);
+      uint8_t *content = (uint8_t *)(block_data(block));
+      size_t bytes = fread(content, sizeof(uint8_t), size, fp);
+      if (bytes != (size_t)size)
+	{
+	  if (current_output_port(sc) != sc->F)
+	    {
+	      char tmp[256];
+	      int32_t len = snprintf(tmp, 256, "(%s \"%s\") read %ld bytes of an expected %" ld64 "?", caller, name, (long)bytes, size);
+	      port_write_string(current_output_port(sc))(sc, tmp, clamp_length(len, 256), current_output_port(sc));
+	    }
+	  size = bytes;
+	}
+      content[size] = '\0';
+      content[size + 1] = '\0';
+      fclose(fp);
+
+      port_file(port) = NULL; /* make valgrind happy */
+      port_type(port) = STRING_PORT;
+      port_data(port) = content;
+      port_data_block(port) = block;
+      port_data_size(port) = size;
+      port_position(port) = 0;
+      port_needs_free(port) = true;
+      port_port(port)->pf = &input_string_functions_1;
+    }
+  else
+    {
+      port_file(port) = fp;
+      port_type(port) = FILE_PORT;
+      port_data(port) = NULL;
+      port_data_block(port) = NULL;
+      port_data_size(port) = 0;
+      port_position(port) = 0;
+      port_needs_free(port) = false;
+      port_port(port)->pf = &input_file_functions;
+    }
+#else
+  /* _stat64 is no better than the fseek/ftell route, and
+   *    GetFileSizeEx and friends requires Windows.h which makes hash of everything else.
+   *    fread until done takes too long on big files, so use a file port
+   */
+  port_file(port) = fp;
+  port_type(port) = FILE_PORT;
+  port_needs_free(port) = false;
+  port_data(port) = NULL;
+  port_data_block(port) = NULL;
+  port_data_size(port) = 0;
+  port_position(port) = 0;
+  port_port(port)->pf = &input_file_functions;
+#endif
+  unstack_gc_protect(sc);
+  return(port);
+}
+
+
+/* -------------------------------- open-input-file -------------------------------- */
+static int32_t remember_file_name(s7_scheme *sc, const char *file)
+{
+  for (int32_t i = 0; i <= sc->file_names_top; i++)
+    if (safe_strcmp(file, string_value(sc->file_names[i])))
+      return(i);
+
+  sc->file_names_top++;
+  if (sc->file_names_top >= sc->file_names_size)
+    {
+      int32_t old_size = 0;
+      /* what if file_names_size is greater than file_bits in pair|profile_file? */
+      if (sc->file_names_size == 0)
+	{
+	  sc->file_names_size = INITIAL_FILE_NAMES_SIZE;
+	  sc->file_names = (s7_pointer *)Malloc(sc->file_names_size * sizeof(s7_pointer));
+	}
+      else
+	{
+	  old_size = sc->file_names_size;
+	  sc->file_names_size *= 2;
+	  sc->file_names = (s7_pointer *)Realloc(sc->file_names, sc->file_names_size * sizeof(s7_pointer));
+	}
+      for (int32_t i = old_size; i < sc->file_names_size; i++)
+	sc->file_names[i] = sc->F;
+    }
+  sc->file_names[sc->file_names_top] = s7_make_semipermanent_string(sc, file);
+  return(sc->file_names_top);
+}
+
+
+#ifndef MAX_SIZE_FOR_STRING_PORT
+  #define MAX_SIZE_FOR_STRING_PORT 10000000
+#endif
+
+static s7_pointer make_input_file(s7_scheme *sc, const char *name, FILE *fp)
+{
+  return(read_file(sc, fp, name, MAX_SIZE_FOR_STRING_PORT, "open"));
+}
+
+
+#if (!MS_WINDOWS)
+#include <sys/stat.h>
+#endif
+
+static bool is_directory(const char *filename)
+{
+#if (!MS_WINDOWS)
+  #ifdef S_ISDIR
+    struct stat statbuf;
+    return((stat(filename, &statbuf) >= 0) &&
+	   (S_ISDIR(statbuf.st_mode)));
+  #endif
+#endif
+  return(false);
+}
+
+static block_t *expand_filename(s7_scheme *sc, const char *name)
+{
+#if WITH_GCC
+  if ((name[0] == '~') && (name[1] == '/'))    /* catch one special case, "~/..." */
+    {
+      char *home = getenv("HOME");
+      if (home)
+	{
+	  s7_int len = safe_strlen(name) + safe_strlen(home) + 1;
+	  block_t *b = mallocate(sc, len);
+	  char *filename = (char *)block_data(b);
+	  filename[0] = '\0';
+	  catstrs(filename, len, home, (const char *)(name + 1), (char *)NULL);
+	  return(b);
+	}}
+#endif
+  return(NULL);
+}
+
+static s7_pointer open_input_file_1(s7_scheme *sc, const char *name, const char *mode, const char *caller)
+{
+  FILE *fp;
+#if WITH_GCC
+  block_t *b;
+#endif
+  /* see if we can open this file before allocating a port */
+  if (is_directory(name))
+    file_error_nr(sc, caller, "file is a directory:", name);
+  errno = 0;
+  fp = fopen(name, mode);
+  if (fp)
+    return(make_input_file(sc, name, fp));
+
+#if (!MS_WINDOWS)
+  if (errno == EINVAL)
+    file_error_nr(sc, caller, "invalid mode", mode);
+#if WITH_GCC
+  if ((!name) || (!*name))
+    file_error_nr(sc, caller, strerror(errno), name);
+  b = expand_filename(sc, name);
+  if (b)
+    {
+      char *new_name = (char *)block_data(b);
+      fp = fopen(new_name, mode);
+      liberate(sc, b);
+      if (fp)
+	return(make_input_file(sc, name, fp));
+    }
+#endif
+#endif
+  file_error_nr(sc, caller, strerror(errno), name);
+  return(sc->io_error_symbol);
+}
+
+s7_pointer s7_open_input_file(s7_scheme *sc, const char *name, const char *mode)
+{
+  return(open_input_file_1(sc, name, mode, "open-input-file"));
+}
+
+static s7_pointer g_open_input_file(s7_scheme *sc, s7_pointer args)
+{
+  #define H_open_input_file "(open-input-file filename (mode \"r\")) opens filename for reading"
+  #define Q_open_input_file s7_make_signature(sc, 3, sc->is_input_port_symbol, sc->is_string_symbol, sc->is_string_symbol)
+
+  s7_pointer mode, name = car(args);
+  /* open-input-file can create a new output file if the file to be opened does not exist, and the "a" mode is given */
+
+  if (!is_string(name))
+    return(method_or_bust(sc, name, sc->open_input_file_symbol, args, sc->type_names[T_STRING], 1));
+  if (!is_pair(cdr(args)))
+    return(open_input_file_1(sc, string_value(name), "r", "open-input-file"));
+
+  mode = cadr(args);
+  if (!is_string(mode))
+    return(method_or_bust(sc, mode, sc->open_input_file_symbol, args, wrap_string(sc, "a string (a mode such as \"r\")", 29), 2));
+  /* since scheme allows embedded nulls, dumb stuff is accepted here: (open-input-file file "a\x00b") -- should this be an error? */
+  return(open_input_file_1(sc, string_value(name), string_value(mode), "open-input-file"));
+}
+
+static void close_stdin(s7_scheme *sc, s7_pointer port) {return;}
+static void close_stdout(s7_scheme *sc, s7_pointer port) {return;}
+static void close_stderr(s7_scheme *sc, s7_pointer port) {return;}
+
+static const port_functions_t stdin_functions =
+  {file_read_char, input_write_char, input_write_string, file_read_semicolon, file_read_white_space,
+   file_read_name, file_read_sharp, stdin_read_line, input_display, close_stdin};
+
+static const port_functions_t stdout_functions =
+  {output_read_char, stdout_write_char, stdout_write_string, NULL, NULL, NULL, NULL, output_read_line, stdout_display, close_stdout};
+
+static const port_functions_t stderr_functions =
+  {output_read_char, stderr_write_char, stderr_write_string, NULL, NULL, NULL, NULL, output_read_line, stderr_display, close_stderr};
+
+static void init_standard_ports(s7_scheme *sc)
+{
+  s7_pointer x;
+
+  /* standard output */
+  x = alloc_pointer(sc);
+  set_full_type(x, T_OUTPUT_PORT | T_IMMUTABLE | T_UNHEAP);
+  port_port(x) = (port_t *)Calloc(1, sizeof(port_t));
+  port_type(x) = FILE_PORT;
+  port_data(x) = NULL;
+  port_data_block(x) = NULL;
+  port_set_closed(x, false);
+  port_filename_length(x) = 8;
+  port_set_filename(sc, x, "*stdout*", 8);
+  port_file_number(x) = remember_file_name(sc, port_filename(x)); /* these numbers need to be correct for the evaluator (*function* data) */
+  port_line_number(x) = 0;
+  port_file(x) = stdout;
+  port_needs_free(x) = false;
+  port_port(x)->pf = &stdout_functions;
+  sc->standard_output = x;
+
+  /* standard error */
+  x = alloc_pointer(sc);
+  set_full_type(x, T_OUTPUT_PORT | T_IMMUTABLE | T_UNHEAP);
+  port_port(x) = (port_t *)Calloc(1, sizeof(port_t));
+  port_type(x) = FILE_PORT;
+  port_data(x) = NULL;
+  port_data_block(x) = NULL;
+  port_set_closed(x, false);
+  port_filename_length(x) = 8;
+  port_set_filename(sc, x, "*stderr*", 8);
+  port_file_number(x) = remember_file_name(sc, port_filename(x));
+  port_line_number(x) = 0;
+  port_file(x) = stderr;
+  port_needs_free(x) = false;
+  port_port(x)->pf = &stderr_functions;
+  sc->standard_error = x;
+
+  /* standard input */
+  x = alloc_pointer(sc);
+  set_full_type(x, T_INPUT_PORT | T_IMMUTABLE | T_UNHEAP);
+  port_port(x) = (port_t *)Calloc(1, sizeof(port_t));
+  port_type(x) = FILE_PORT;
+  port_set_closed(x, false);
+  port_set_string_or_function(x, sc->nil);
+  port_filename_length(x) = 7;
+  port_set_filename(sc, x, "*stdin*", 7);
+  port_file_number(x) = remember_file_name(sc, port_filename(x));
+  port_line_number(x) = 0;
+  port_file(x) = stdin;
+  port_data_block(x) = NULL;
+  port_needs_free(x) = false;
+  port_port(x)->pf = &stdin_functions;
+  sc->standard_input = x;
+
+  s7_define_variable_with_documentation(sc, "*stdin*", sc->standard_input, "*stdin* is the built-in input port, C's stdin");
+  s7_define_variable_with_documentation(sc, "*stdout*", sc->standard_output, "*stdout* is the built-in buffered output port, C's stdout");
+  s7_define_variable_with_documentation(sc, "*stderr*", sc->standard_error, "*stderr* is the built-in unbuffered output port, C's stderr");
+
+  set_current_input_port(sc, sc->standard_input);
+  set_current_output_port(sc, sc->standard_output);
+  set_current_error_port(sc, sc->standard_error);
+  sc->current_file = NULL;
+  sc->current_line = -1;
+}
+
+
+/* -------------------------------- open-output-file -------------------------------- */
+static const port_functions_t output_file_functions =
+  {output_read_char, file_write_char, file_write_string, NULL, NULL, NULL, NULL, output_read_line, file_display, close_output_file};
+
+s7_pointer s7_open_output_file(s7_scheme *sc, const char *name, const char *mode)
+{
+  FILE *fp;
+  s7_pointer x;
+  block_t *block, *b;
+  /* see if we can open this file before allocating a port */
+
+  errno = 0;
+  fp = fopen(name, mode);
+  if (!fp)
+    {
+#if (!MS_WINDOWS)
+      if (errno == EINVAL)
+	file_error_nr(sc, "open-output-file", "invalid mode", mode);
+#endif
+      file_error_nr(sc, "open-output-file", strerror(errno), name);
+    }
+  new_cell(sc, x, T_OUTPUT_PORT);
+  b = mallocate_port(sc);
+  port_block(x) = b;
+  port_port(x) = (port_t *)block_data(b);
+  port_type(x) = FILE_PORT;
+  port_set_closed(x, false);
+  port_filename_length(x) = safe_strlen(name);
+  port_set_filename(sc, x, name, port_filename_length(x));
+  port_line_number(x) = 1;
+  port_file_number(x) = 0;
+  port_file(x) = fp;
+  port_needs_free(x) = true;  /* hmm -- I think these are freed via s7_close_output_port -> close_output_port */
+  port_position(x) = 0;
+  port_data_size(x) = sc->output_file_port_data_size;
+  block = mallocate(sc, sc->output_file_port_data_size);
+  port_data_block(x) = block;
+  port_data(x) = (uint8_t *)(block_data(block));
+  port_port(x)->pf = &output_file_functions;
+  add_output_port(sc, x);
+  return(x);
+}
+
+static s7_pointer g_open_output_file(s7_scheme *sc, s7_pointer args)
+{
+  #define H_open_output_file "(open-output-file filename (mode \"w\")) opens filename for writing"
+  #define Q_open_output_file s7_make_signature(sc, 3, sc->is_output_port_symbol, sc->is_string_symbol, sc->is_string_symbol)
+
+  s7_pointer name = car(args);
+  if (!is_string(name))
+    return(method_or_bust(sc, name, sc->open_output_file_symbol, args, sc->type_names[T_STRING], 1));
+  if (!is_pair(cdr(args)))
+    return(s7_open_output_file(sc, string_value(name), "w"));
+  if (!is_string(cadr(args)))
+    return(method_or_bust(sc, cadr(args), sc->open_output_file_symbol, args, wrap_string(sc, "a string (a mode such as \"w\")", 29), 2));
+  return(s7_open_output_file(sc, string_value(name), string_value(cadr(args))));
+}
+
+
+/* -------------------------------- open-input-string -------------------------------- */
+
+/* a version of string ports using a pointer to the current location and a pointer to the end
+ *   (rather than an integer for both, indexing from the base string) was not faster.
+ */
+
+static const port_functions_t input_string_functions =
+  {string_read_char, input_write_char, input_write_string, string_read_semicolon, terminated_string_read_white_space,
+   string_read_name_no_free, string_read_sharp,	string_read_line, input_display, close_simple_input_string};
+
+static s7_pointer open_input_string(s7_scheme *sc, const char *input_string, s7_int len)
+{
+  s7_pointer x;
+  /* we could look for free entry in sc->input_string_ports and reuse it, but that takes longer than it saves,
+   *   mainly because ports are marked free by the GC, so free entries happen once-in-a-long-while (while the list grows),
+   *   and free_cell can't be used (freeze_t protecting the block). Perhaps free_frozen_cell (just sets type=T_FREE +(?) clears T_GC_MARKED),
+   *   but how to recognize such cases (see tio.scm).  Maybe a way in scheme to reuse such a port? (set! (port-string p) "asdf")?
+   */
+  block_t *b = mallocate_port(sc);
+  new_cell(sc, x, T_INPUT_PORT);
+  port_block(x) = b;
+  port_port(x) = (port_t *)block_data(b);
+  port_type(x) = STRING_PORT;
+  port_set_closed(x, false);
+  port_set_string_or_function(x, sc->nil);
+  port_data(x) = (uint8_t *)input_string;
+  port_data_block(x) = NULL;
+  port_data_size(x) = len;
+  port_position(x) = 0;
+  port_filename_block(x) = NULL;
+  port_filename_length(x) = 0;
+  port_filename(x) = NULL;
+  port_file_number(x) = 0;
+  port_line_number(x) = 0;
+  port_file(x) = NULL;
+  port_needs_free(x) = false;
+#if S7_DEBUGGING
+  if ((len > 0) && (input_string[len] != '\0'))
+    {
+      fprintf(stderr, "%s%s[%d]: input_string is not terminated: len: %" ld64 ", at end: %c%c, str: %s%s\n",
+	      bold_text, __func__, __LINE__, len, input_string[len - 1], input_string[len], input_string, unbold_text);
+      if (sc->stop_at_error) abort();
+    }
+#endif
+  port_port(x)->pf = &input_string_functions;
+  add_input_string_port(sc, x);
+  return(x);
+}
+
+static /* inline */ s7_pointer open_and_protect_input_string(s7_scheme *sc, s7_pointer str)
+{
+  s7_pointer p = open_input_string(sc, string_value(str), string_length(str));
+  port_set_string_or_function(p, str);
+  return(p);
+}
+
+s7_pointer s7_open_input_string(s7_scheme *sc, const char *input_string)
+{
+  return(open_input_string(sc, input_string, safe_strlen(input_string)));
+}
+
+static s7_pointer g_open_input_string(s7_scheme *sc, s7_pointer args)
+{
+  #define H_open_input_string "(open-input-string str) opens an input port reading str"
+  #define Q_open_input_string s7_make_signature(sc, 2, sc->is_input_port_symbol, sc->is_string_symbol)
+
+  s7_pointer input_string = car(args);
+  if (!is_string(input_string))
+    return(sole_arg_method_or_bust(sc, input_string, sc->open_input_string_symbol, args, sc->type_names[T_STRING]));
+  return(open_and_protect_input_string(sc, input_string));
+}
+
+
+/* -------------------------------- open-output-string -------------------------------- */
+#define FORMAT_PORT_LENGTH 128
+/* the large majority (> 99% in my tests) of the output strings have less than 128 chars when the port is finally closed
+ *   256 is slightly slower (the calloc time below dominates the realloc time in string_write_string)
+ *   64 is much slower (realloc dominates)
+ */
+
+static const port_functions_t output_string_functions =
+  {output_read_char, string_write_char, string_write_string, NULL, NULL, NULL, NULL, output_read_line, string_display, close_output_string};
+
+s7_pointer s7_open_output_string(s7_scheme *sc)
+{
+  s7_pointer x;
+  block_t *b = mallocate_port(sc);
+  block_t *block = inline_mallocate(sc, sc->initial_string_port_length);
+  new_cell(sc, x, T_OUTPUT_PORT);
+  port_block(x) = b;
+  port_port(x) = (port_t *)block_data(b);
+  port_type(x) = STRING_PORT;
+  port_set_closed(x, false);
+  port_data_size(x) = sc->initial_string_port_length;
+  port_data_block(x) = block;
+  port_data(x) = (uint8_t *)(block_data(block));
+  port_data(x)[0] = '\0';        /* in case s7_get_output_string before any output */
+  port_position(x) = 0;
+  port_needs_free(x) = true;
+  port_filename_block(x) = NULL;
+  port_filename_length(x) = 0;   /* protect against (port-filename (open-output-string)) */
+  port_filename(x) = NULL;
+  port_port(x)->pf = &output_string_functions;
+  add_output_port(sc, x);
+  return(x);
+}
+
+static s7_pointer g_open_output_string(s7_scheme *sc, s7_pointer unused_args)
+{
+  #define H_open_output_string "(open-output-string) opens an output string port"
+  #define Q_open_output_string s7_make_signature(sc, 1, sc->is_output_port_symbol)
+  return(s7_open_output_string(sc));
+}
+
+
+/* -------------------------------- get-output-string -------------------------------- */
+const char *s7_get_output_string(s7_scheme *sc, s7_pointer p)
+{
+  port_data(p)[port_position(p)] = '\0';
+  return((const char *)port_data(p));
+}
+
+s7_pointer s7_output_string(s7_scheme *sc, s7_pointer p)
+{
+  port_data(p)[port_position(p)] = '\0';
+  if (port_position(p) == 0) return(nil_string);
+  return(make_string_with_length(sc, (const char *)port_data(p), port_position(p)));
+}
+
+static inline void check_get_output_string_port(s7_scheme *sc, s7_pointer p)
+{
+  if (port_is_closed(p))
+    wrong_type_error_nr(sc, sc->get_output_string_symbol, 1, p, wrap_string(sc, "an active (open) string port", 28));
+  if (port_position(p) > sc->max_string_length)
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_3(sc, wrap_string(sc, "get-output-string port-position ~D is greater than (*s7* 'max-string-length), ~D", 80),
+			 wrap_integer(sc, port_position(p)), wrap_integer(sc, sc->max_string_length)));
+}
+/* if pos>max and clear, where should the clear be?  Not here because we might want to see output in error handler.
+ *   similarly below if pos>size how can we call make_string (out-of-bounds) and ignore error?
+ *   if pos>size shouldn't we raise an error somewhere?
+ */
+
+static s7_pointer g_get_output_string(s7_scheme *sc, s7_pointer args)
+{
+  #define H_get_output_string "(get-output-string port (clear-port #f)) returns the output accumulated in port.  \
+If the optional 'clear-port' is #t, the current string is flushed."
+  #define Q_get_output_string s7_make_signature(sc, 3, sc->is_string_symbol, \
+                                 s7_make_signature(sc, 2, sc->is_output_port_symbol, sc->not_symbol), sc->is_boolean_symbol)
+  s7_pointer p;
+  bool clear_port = false;
+
+  if (is_pair(cdr(args)))
+    {
+      p = cadr(args);
+      if (!is_boolean(p))
+	wrong_type_error_nr(sc, sc->get_output_string_symbol, 2, p, sc->type_names[T_BOOLEAN]);
+      clear_port = (p == sc->T);
+    }
+  p = car(args);
+  if ((!is_output_port(p)) || (!is_string_port(p)))
+    {
+      if (p == sc->F) return(nil_string);
+      check_method(sc, p, sc->get_output_string_symbol, args);
+      wrong_type_error_nr(sc, sc->get_output_string_symbol, 1, p, wrap_string(sc, "an open string output port or #f", 32));
+    }
+  check_get_output_string_port(sc, p);
+
+  if ((clear_port) &&
+      (port_position(p) < port_data_size(p)))
+    {
+      block_t *block;
+      s7_pointer result = block_to_string(sc, port_data_block(p), port_position(p));
+      /* this is slightly faster than make_string_with_length(sc, (char *)(port_data(p)), port_position(p)): we're trading a mallocate for a memcpy */
+      port_data_size(p) = sc->initial_string_port_length;
+      block = inline_mallocate(sc, port_data_size(p));
+      port_data_block(p) = block;
+      port_data(p) = (uint8_t *)(block_data(block));
+      port_position(p) = 0;
+      port_data(p)[0] = '\0';
+      return(result);
+    }
+  if (port_position(p) == 0) return(nil_string);
+  return(make_string_with_length(sc, (const char *)port_data(p), port_position(p)));
+}
+
+static void op_get_output_string(s7_scheme *sc)
+{
+  s7_pointer port = sc->code;
+  if (!is_output_port(port))
+    wrong_type_error_nr(sc, sc->with_output_to_string_symbol, 1, port, wrap_string(sc, "an open string output port", 26));
+  check_get_output_string_port(sc, port);
+
+  /* nil_string here is tricky (need liberate etc) */
+  if (port_position(port) >= port_data_size(port)) /* can the > part happen? */
+    sc->value = block_to_string(sc, reallocate(sc, port_data_block(port), port_position(port) + 1), port_position(port));
+  else sc->value = block_to_string(sc, port_data_block(port), port_position(port));
+  /* block_to_string attaches the port's data_block to the string for later free */
+  port_data(port) = NULL;
+  port_data_size(port) = 0;
+  port_data_block(port) = NULL;
+  port_needs_free(port) = false;
+}
+
+static s7_pointer g_get_output_string_uncopied(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer p = car(args);
+  if ((!is_output_port(p)) || (!is_string_port(p)))
+    {
+      if (p == sc->F) return(nil_string);
+      return(method_or_bust_p(sc, p, sc->get_output_string_symbol, wrap_string(sc, "an output string port", 21)));
+    }
+  check_get_output_string_port(sc, p);
+  port_data(p)[port_position(p)] = '\0'; /* wrap_string can't do this, and (for example) open_input_string wants terminated strings */
+  if (port_position(p) == 0) return(nil_string);
+  return(wrap_string(sc, (const char *)port_data(p), port_position(p)));
+}
+
+
+/* -------------------------------- open-input-function -------------------------------- */
+static s7_pointer g_closed_input_function_port(s7_scheme *sc, s7_pointer unused_args)
+{
+  error_nr(sc, sc->wrong_type_arg_symbol,
+	   set_elist_1(sc, wrap_string(sc, "attempt to read from a closed input-function port", 49)));
+  return(NULL);
+}
+
+static void close_input_function(s7_scheme *sc, s7_pointer p)
+{
+  port_port(p)->pf = &closed_port_functions;
+  port_set_string_or_function(p, sc->closed_input_function); /* from s7_make_function so it is GC-protected */
+  port_set_closed(p, true);
+}
+
+static const port_functions_t input_function_functions =
+  {function_read_char, input_write_char, input_write_string, NULL, NULL, NULL, NULL, function_read_line, input_display, close_input_function};
+
+static void function_port_set_defaults(s7_pointer x)
+{
+  port_type(x) = FUNCTION_PORT;
+  port_data(x) = NULL;
+  port_data_block(x) = NULL;
+  port_set_closed(x, false);
+  port_needs_free(x) = false;
+  port_filename_block(x) = NULL; /* next three protect against port-filename misunderstandings */
+  port_filename(x) = NULL;
+  port_filename_length(x) = 0;
+  port_file_number(x) = 0;
+  port_line_number(x) = 0;
+  port_file(x) = NULL;
+}
+
+s7_pointer s7_open_input_function(s7_scheme *sc, s7_pointer (*function)(s7_scheme *sc, s7_read_t read_choice, s7_pointer port))
+{
+  s7_pointer x;
+  block_t *b = mallocate_port(sc);
+  new_cell(sc, x, T_INPUT_PORT);
+  port_block(x) = b;
+  port_port(x) = (port_t *)block_data(b);
+  function_port_set_defaults(x);
+  port_set_string_or_function(x, sc->nil);
+  port_input_function(x) = function;
+  port_port(x)->pf = &input_function_functions;
+  add_input_port(sc, x);
+  return(x);
+}
+
+static void init_open_input_function_choices(s7_scheme *sc)
+{
+  sc->open_input_function_choices[S7_READ] = sc->read_symbol;
+  sc->open_input_function_choices[S7_READ_CHAR] = sc->read_char_symbol;
+  sc->open_input_function_choices[S7_READ_LINE] = sc->read_line_symbol;
+  sc->open_input_function_choices[S7_PEEK_CHAR] = sc->peek_char_symbol;
+#if (!WITH_PURE_S7)
+  sc->open_input_function_choices[S7_IS_CHAR_READY] = sc->is_char_ready_symbol;
+#endif
+}
+
+static s7_pointer input_scheme_function_wrapper(s7_scheme *sc, s7_read_t read_choice, s7_pointer port)
+{
+  return(s7_apply_function(sc, port_string_or_function(port), set_plist_1(sc, sc->open_input_function_choices[(int)read_choice])));
+}
+
+static s7_pointer g_open_input_function(s7_scheme *sc, s7_pointer args)
+{
+  #define H_open_input_function "(open-input-function func) opens an input function port"
+  #define Q_open_input_function s7_make_signature(sc, 2, sc->is_input_port_symbol, s7_make_signature(sc, 2, sc->is_procedure_symbol, sc->is_macro_symbol))
+
+  s7_pointer port, func = car(args);
+
+  if (!is_any_procedure(func)) /* is_procedure is too lenient: we need to flag (open-input-function (block)) for example */
+    sole_arg_wrong_type_error_nr(sc, sc->open_input_function_symbol, func, a_procedure_string);
+  if (!s7_is_aritable(sc, func, 1))
+    error_nr(sc, sc->wrong_type_arg_symbol,
+	     set_elist_2(sc, wrap_string(sc, "input-function-port function, ~A, should take one argument", 58), func));
+
+  port = s7_open_input_function(sc, input_scheme_function_wrapper);
+  port_set_string_or_function(port, func);
+  return(port);
+}
+
+
+/* -------------------------------- open-output-function -------------------------------- */
+static s7_pointer g_closed_output_function_port(s7_scheme *sc, s7_pointer unused_args)
+{
+  error_nr(sc, sc->wrong_type_arg_symbol, set_elist_1(sc, wrap_string(sc, "attempt to write to a closed output-function port", 49)));
+  return(NULL);
+}
+
+static void close_output_function(s7_scheme *sc, s7_pointer p)
+{
+  port_port(p)->pf = &closed_port_functions;
+  port_set_string_or_function(p, sc->closed_output_function);
+  port_set_closed(p, true);
+}
+
+static const port_functions_t output_function_functions =
+  {output_read_char, function_write_char, function_write_string, NULL, NULL, NULL, NULL, output_read_line, function_display, close_output_function};
+
+s7_pointer s7_open_output_function(s7_scheme *sc, void (*function)(s7_scheme *sc, uint8_t c, s7_pointer port))
+{
+  s7_pointer x;
+  block_t *b = mallocate_port(sc);
+  new_cell(sc, x, T_OUTPUT_PORT);
+  port_block(x) = b;
+  port_port(x) = (port_t *)block_data(b);
+  function_port_set_defaults(x);
+  port_output_function(x) = function;
+  port_set_string_or_function(x, sc->nil);
+  port_port(x)->pf = &output_function_functions;
+  add_output_port(sc, x);
+  return(x);
+}
+
+static void output_scheme_function_wrapper(s7_scheme *sc, uint8_t c, s7_pointer port)
+{
+  s7_apply_function(sc, port_string_or_function(port), set_plist_1(sc, make_integer(sc, c)));
+}
+
+static s7_pointer g_open_output_function(s7_scheme *sc, s7_pointer args)
+{
+  #define H_open_output_function "(open-output-function func) opens an output function port"
+  #define Q_open_output_function s7_make_signature(sc, 2, sc->is_output_port_symbol, s7_make_signature(sc, 2, sc->is_procedure_symbol, sc->is_macro_symbol))
+
+  s7_pointer port, func = car(args);
+
+  if (!is_any_procedure(func))
+    sole_arg_wrong_type_error_nr(sc, sc->open_output_function_symbol, func, a_procedure_string);
+  if (!s7_is_aritable(sc, func, 1))
+    error_nr(sc, sc->wrong_type_arg_symbol,
+	     set_elist_2(sc, wrap_string(sc, "output-function-port function, ~A, should take one argument", 59), func));
+
+  port = s7_open_output_function(sc, output_scheme_function_wrapper);
+  port_set_string_or_function(port, func);
+  mark_function[T_OUTPUT_PORT] = mark_output_port;
+  return(port);
+}
+
+
+/* -------- current-input-port stack -------- */
+#define INPUT_PORT_STACK_INITIAL_SIZE 4
+
+static inline void push_input_port(s7_scheme *sc, s7_pointer new_port)
+{
+  if (sc->input_port_stack_loc >= sc->input_port_stack_size)
+    {
+      sc->input_port_stack_size *= 2;
+      sc->input_port_stack = (s7_pointer *)Realloc(sc->input_port_stack, sc->input_port_stack_size * sizeof(s7_pointer));
+    }
+  sc->input_port_stack[sc->input_port_stack_loc++] = current_input_port(sc);
+  set_current_input_port(sc, new_port);
+}
+
+static void pop_input_port(s7_scheme *sc)
+{
+  set_current_input_port(sc, (sc->input_port_stack_loc > 0) ? sc->input_port_stack[--(sc->input_port_stack_loc)] : sc->standard_input);
+}
+
+static s7_pointer input_port_if_not_loading(s7_scheme *sc)
+{
+  s7_pointer port = current_input_port(sc);
+  int32_t c;
+  if (!is_loader_port(port)) /* this flag is turned off by the reader macros, so we aren't in that context */
+    return(port);
+  c = port_read_white_space(port)(sc, port);
+  if (c > 0)            /* we can get either EOF or NULL at the end */
+    {
+      backchar(c, port);
+      return(NULL);
+    }
+  return(sc->standard_input);
+}
+
+
+/* -------------------------------- read-char -------------------------------- */
+s7_pointer s7_read_char(s7_scheme *sc, s7_pointer port)
+{
+  int32_t c = port_read_character(port)(sc, port);
+  return((c == EOF) ? eof_object : chars[c]);
+}
+
+static s7_pointer g_read_char(s7_scheme *sc, s7_pointer args)
+{
+  #define H_read_char "(read-char (port (current-input-port))) returns the next character in the input port"
+  #define Q_read_char s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_char_symbol, sc->is_eof_object_symbol), sc->is_input_port_symbol)
+
+  s7_pointer port;
+  if (is_not_null(args))
+    port = car(args);
+  else
+    {
+      port = input_port_if_not_loading(sc);
+      if (!port) return(eof_object);
+    }
+  if (!is_input_port(port))
+    return(method_or_bust_p(sc, port, sc->read_char_symbol, an_input_port_string));
+  return(chars[port_read_character(port)(sc, port)]);
+}
+
+static s7_pointer read_char_p_p(s7_scheme *sc, s7_pointer port)
+{
+  if (!is_input_port(port))
+    return(method_or_bust_p(sc, port, sc->read_char_symbol, an_input_port_string));
+  return(chars[port_read_character(port)(sc, port)]);
+}
+
+static s7_pointer g_read_char_1(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer port = car(args);
+  if (!is_input_port(port))
+    return(method_or_bust_p(sc, port, sc->read_char_symbol, an_input_port_string));
+  return(chars[port_read_character(port)(sc, port)]);
+}
+
+static s7_pointer read_char_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer unused_expr)
+{
+  return((args == 1) ? sc->read_char_1 : f);
+}
+
+
+/* -------------------------------- write-char -------------------------------- */
+s7_pointer s7_write_char(s7_scheme *sc, s7_pointer c, s7_pointer pt)
+{
+  if (pt != sc->F)
+    port_write_character(pt)(sc, s7_character(c), pt);
+  return(c);
+}
+
+static s7_pointer write_char_p_pp(s7_scheme *sc, s7_pointer c, s7_pointer port)
+{
+  if (!is_character(c))
+    return(method_or_bust_pp(sc, c, sc->write_char_symbol, c, port, sc->type_names[T_CHARACTER], 1));
+  if (!is_output_port(port))
+    {
+      if (port == sc->F) return(c);
+      check_method(sc, port, sc->write_char_symbol, set_mlist_2(sc, c, port));
+      wrong_type_error_nr(sc, sc->write_char_symbol, 2, port, an_output_port_or_f_string);
+    }
+  port_write_character(port)(sc, s7_character(c), port);
+  return(c);
+}
+
+static s7_pointer g_write_char(s7_scheme *sc, s7_pointer args)
+{
+  #define H_write_char "(write-char char (port (current-output-port))) writes char to the output port"
+  #define Q_write_char s7_make_signature(sc, 3, sc->is_char_symbol, sc->is_char_symbol, s7_make_signature(sc, 2, sc->is_output_port_symbol, sc->not_symbol))
+  return(write_char_p_pp(sc, car(args), (is_pair(cdr(args))) ? cadr(args) : current_output_port(sc)));
+}
+
+static s7_pointer write_char_p_p(s7_scheme *sc, s7_pointer c)
+{
+  if (!is_character(c))
+    return(method_or_bust_p(sc, c, sc->write_char_symbol, sc->type_names[T_CHARACTER]));
+  if (current_output_port(sc) == sc->F) return(c);
+  port_write_character(current_output_port(sc))(sc, s7_character(c), current_output_port(sc));
+  return(c);
+}
+
+/* (with-output-to-string (lambda () (write-char #\space))) -> " "
+ * (with-output-to-string (lambda () (write #\space))) -> "#\\space"
+ * (with-output-to-string (lambda () (display #\space))) -> " "
+ * is this correct?  It's what Guile does.  write-char is actually display-char.
+ */
+
+
+/* -------------------------------- peek-char -------------------------------- */
+s7_pointer s7_peek_char(s7_scheme *sc, s7_pointer port)
+{
+  int32_t c;              /* needs to be an int32_t so EOF=-1, but not 255 */
+  if (is_string_port(port))
+    return((port_data_size(port) <= port_position(port)) ? chars[EOF] : chars[(uint8_t)port_data(port)[port_position(port)]]);
+  c = port_read_character(port)(sc, port);
+  if (c == EOF) return(eof_object);
+  backchar(c, port);
+  return(chars[c]);
+}
+
+static s7_pointer g_peek_char(s7_scheme *sc, s7_pointer args)
+{
+  #define H_peek_char "(peek-char (port (current-input-port))) returns the next character in the input port, but does not remove it from the input stream"
+  #define Q_peek_char s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_char_symbol, sc->is_eof_object_symbol), sc->is_input_port_symbol)
+
+  s7_pointer res, port = (is_not_null(args)) ? car(args) : current_input_port(sc);
+  if (!is_input_port(port))
+    return(method_or_bust_p(sc, port, sc->peek_char_symbol, an_input_port_string));
+  if (port_is_closed(port))
+    sole_arg_wrong_type_error_nr(sc, sc->peek_char_symbol, port, an_open_input_port_string);
+  if (!is_function_port(port))
+    return(s7_peek_char(sc, port));
+
+  res = (*(port_input_function(port)))(sc, S7_PEEK_CHAR, port);
+  if (is_multiple_value(res))
+    {
+      clear_multiple_value(res);
+      error_nr(sc, sc->bad_result_symbol,
+	       set_elist_2(sc, wrap_string(sc, "input-function-port peek-char returned multiple values: ~S", 58), res));
+    }
+  if (!is_character(res))
+    error_nr(sc, sc->wrong_type_arg_symbol,
+	     set_elist_2(sc, wrap_string(sc, "input-function-port peek-char returned: ~S", 42), res));
+  return(res);
+}
+
+
+/* -------------------------------- read-byte -------------------------------- */
+static s7_pointer g_read_byte(s7_scheme *sc, s7_pointer args)
+{
+  #define H_read_byte "(read-byte (port (current-input-port))): reads a byte from the input port"
+  #define Q_read_byte s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_byte_symbol, sc->is_eof_object_symbol), sc->is_input_port_symbol)
+
+  s7_pointer port;
+  int32_t c;
+
+  if (is_not_null(args))
+    port = car(args);
+  else
+    {
+      port = input_port_if_not_loading(sc);
+      if (!port) return(eof_object);
+    }
+  if (!is_input_port(port))
+    return(method_or_bust_p(sc, port, sc->read_byte_symbol, an_input_port_string));
+  if (port_is_closed(port))          /* avoid reporting caller here as read-char */
+    sole_arg_wrong_type_error_nr(sc, sc->read_byte_symbol, port, an_open_input_port_string);
+  c = port_read_character(port)(sc, port);
+  return((c == EOF) ? eof_object : small_int(c));
+}
+
+
+/* -------------------------------- write-byte -------------------------------- */
+static s7_pointer g_write_byte(s7_scheme *sc, s7_pointer args)
+{
+  #define H_write_byte "(write-byte byte (port (current-output-port))): writes byte to the output port"
+  #define Q_write_byte s7_make_signature(sc, 3, sc->is_byte_symbol, sc->is_byte_symbol, s7_make_signature(sc, 2, sc->is_output_port_symbol, sc->not_symbol))
+
+  s7_pointer port, b = car(args);
+  s7_int val;
+  if (!s7_is_integer(b))
+    return(method_or_bust(sc, b, sc->write_byte_symbol, args, sc->type_names[T_INTEGER], 1));
+
+  val = s7_integer_clamped_if_gmp(sc, b);
+  if ((val < 0) || (val > 255)) /* need to check this before port==#f, else (write-byte most-positive-fixnum #f) is not an error */
+    wrong_type_error_nr(sc, sc->write_byte_symbol, 1, b, an_unsigned_byte_string);
+
+  port = (is_pair(cdr(args))) ? cadr(args) : current_output_port(sc);
+  if (!is_output_port(port))
+    {
+      if (port == sc->F) return(b);
+      check_method(sc, port, sc->write_byte_symbol, args);
+      wrong_type_error_nr(sc, sc->write_byte_symbol, 2, port, an_output_port_or_f_string);
+    }
+  if (port_is_closed(port))          /* avoid reporting caller here as write-char */
+    wrong_type_error_nr(sc, sc->write_byte_symbol, 2, port, an_open_output_port_string);
+
+  port_write_character(port)(sc, (uint8_t)val, port);
+  return(b);
+}
+
+
+/* -------------------------------- read-line -------------------------------- */
+static s7_pointer g_read_line(s7_scheme *sc, s7_pointer args)
+{
+  #define H_read_line "(read-line port (with-eol #f)) returns the next line from port, or #<eof>. \
+If 'with-eol' is not #f, read-line includes the trailing end-of-line character."
+  #define Q_read_line s7_make_signature(sc, 3, \
+                        s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_eof_object_symbol), \
+                        sc->is_input_port_symbol, sc->is_boolean_symbol)
+  s7_pointer port;
+  bool with_eol = false;
+  if (is_not_null(args))
+    {
+      port = car(args);
+      if (!is_input_port(port))
+	return(method_or_bust(sc, port, sc->read_line_symbol, args, an_input_port_string, 1));
+
+      if (is_not_null(cdr(args)))
+	with_eol = (cadr(args) != sc->F); /* perhaps this should insist on #t: (read-line port (c-pointer 0)) */
+    }
+  else
+    {
+      port = input_port_if_not_loading(sc);
+      if (!port) return(eof_object);
+    }
+  return(port_read_line(port)(sc, port, with_eol));
+}
+
+static s7_pointer read_line_p_pp(s7_scheme *sc, s7_pointer port, s7_pointer with_eol)
+{
+  if (!is_input_port(port))
+    return(method_or_bust_pp(sc, port, sc->read_line_symbol, port, with_eol, an_input_port_string, 1));
+  return(port_read_line(port)(sc, port, with_eol != sc->F));
+}
+
+static s7_pointer read_line_p_p(s7_scheme *sc, s7_pointer port)
+{
+  if (!is_input_port(port))
+    return(method_or_bust_p(sc, port, sc->read_line_symbol, an_input_port_string));
+  return(port_read_line(port)(sc, port, false)); /* with_eol default is #f */
+}
+
+
+/* -------------------------------- read-string -------------------------------- */
+static s7_pointer g_read_string(s7_scheme *sc, s7_pointer args)
+{
+  /* read-chars would be a better name -- read-string could mean CL-style read-from-string (like eval-string)
+   *   similarly read-bytes could return a byte-vector (rather than r7rs's read-bytevector)
+   *   and write-string -> write-chars, write-bytevector -> write-bytes
+   */
+  #define H_read_string "(read-string k port) reads k characters from port into a new string and returns it."
+  #define Q_read_string s7_make_signature(sc, 3, \
+                          s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_eof_object_symbol), \
+                          sc->is_integer_symbol, sc->is_input_port_symbol)
+  s7_pointer k = car(args), port, s;
+  s7_int nchars;
+  uint8_t *str;
+
+  if (!s7_is_integer(k))
+    return(method_or_bust(sc, k, sc->read_string_symbol, args, sc->type_names[T_INTEGER], 1));
+  nchars = s7_integer_clamped_if_gmp(sc, k);
+  if (nchars < 0)
+    out_of_range_error_nr(sc, sc->read_string_symbol, int_one, k, it_is_negative_string);
+  if (nchars > sc->max_string_length)
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_3(sc, wrap_string(sc, "read-string first argument ~D is greater than (*s7* 'max-string-length), ~D", 75),
+			 wrap_integer(sc, nchars), wrap_integer(sc, sc->max_string_length)));
+
+  if (!is_null(cdr(args)))
+    port = cadr(args);
+  else
+    {
+      port = input_port_if_not_loading(sc);
+      if (!port) return(eof_object);
+    }
+  if (!is_input_port(port))
+    return(method_or_bust_pp(sc, port, sc->read_string_symbol, k, port, an_input_port_string, 2));
+  if (port_is_closed(port))
+    wrong_type_error_nr(sc, sc->read_string_symbol, 2, port, an_open_input_port_string);
+
+  s = make_empty_string(sc, nchars, '\0');
+  if (nchars == 0) return(s);
+  str = (uint8_t *)string_value(s);
+  if (is_string_port(port))
+    {
+      s7_int pos = port_position(port);
+      s7_int end = port_data_size(port);
+      s7_int len = end - pos;
+      if (len > nchars) len = nchars;
+      if (len <= 0) return(eof_object);
+      memcpy((void *)str, (void *)(port_data(port) + pos), len);
+      string_length(s) = len;
+      str[len] = '\0';
+      port_position(port) += len;
+      return(s);
+    }
+  if (is_file_port(port))
+    {
+      size_t len = fread((void *)str, 1, nchars, port_file(port));
+      str[len] = '\0';
+      string_length(s) = len;
+      return(s);
+    }
+  for (s7_int i = 0; i < nchars; i++)
+    {
+      int32_t c = port_read_character(port)(sc, port);
+      if (c == EOF)
+	{
+	  if (i == 0)
+	    return(eof_object);
+	  string_length(s) = i;
+	  return(s);
+	}
+      str[i] = (uint8_t)c;
+    }
+  return(s);
+}
+
+
+/* -------------------------------- read -------------------------------- */
+#define declare_jump_info() bool old_longjmp; setjmp_loc_t old_jump_loc; jump_loc_t jump_loc; Jmp_Buf *old_goto_start; Jmp_Buf new_goto_start
+
+#define store_jump_info(Sc)			\
+  do {						\
+      old_longjmp = Sc->longjmp_ok;		\
+      old_jump_loc = Sc->setjmp_loc;		\
+      old_goto_start = Sc->goto_start;		\
+  } while (0)
+
+#define restore_jump_info(Sc)			\
+  do {						\
+    Sc->longjmp_ok = old_longjmp;		\
+    Sc->setjmp_loc = old_jump_loc;		\
+    Sc->goto_start = old_goto_start;		\
+    if ((jump_loc == ERROR_JUMP) &&		\
+	(Sc->longjmp_ok))			\
+      LongJmp(*(Sc->goto_start), ERROR_JUMP);	\
+  } while (0)
+
+#define set_jump_info(Sc, Tag)			\
+  do {						\
+    Sc->longjmp_ok = true;			\
+    Sc->setjmp_loc = Tag;			\
+    jump_loc = (jump_loc_t)SetJmp(new_goto_start, 1);	\
+    Sc->goto_start = &new_goto_start;		\
+  } while (0)
+
+static s7_pointer eval(s7_scheme *sc, opcode_t first_op);
+
+s7_pointer s7_read(s7_scheme *sc, s7_pointer port)
+{
+  if (is_input_port(port))
+    {
+      s7_pointer old_let = sc->curlet;
+      declare_jump_info();
+      set_curlet(sc, sc->rootlet);
+      push_input_port(sc, port);
+      store_jump_info(sc);
+      set_jump_info(sc, READ_SET_JUMP);
+      if (jump_loc != NO_JUMP)
+	{
+	  if (jump_loc != ERROR_JUMP)
+	    eval(sc, sc->cur_op);
+	}
+      else
+	{
+	  push_stack_no_let_no_code(sc, OP_BARRIER, port);
+	  push_stack_direct(sc, OP_EVAL_DONE);
+	  eval(sc, OP_READ_INTERNAL);
+	  if (sc->tok == TOKEN_EOF)
+	    sc->value = eof_object;
+	  if ((sc->cur_op == OP_EVAL_DONE) && /* pushed above */
+	      (stack_top_op(sc) == OP_BARRIER))
+	    pop_stack(sc);
+	}
+      pop_input_port(sc);
+      set_curlet(sc, old_let);
+      restore_jump_info(sc);
+      return(sc->value);
+    }
+  sole_arg_wrong_type_error_nr(sc, sc->read_symbol, port, an_input_port_string);
+  return(NULL);
+}
+
+static s7_pointer g_read(s7_scheme *sc, s7_pointer args)
+{
+  #define H_read "(read (port (current-input-port))) returns the next object in the input port, or #<eof> at the end"
+  #define Q_read s7_make_signature(sc, 2, sc->T, sc->is_input_port_symbol)
+
+  s7_pointer port;
+  if (is_not_null(args))
+    port = car(args);
+  else
+    {
+      port = input_port_if_not_loading(sc);
+      if (!port) return(eof_object);
+    }
+  if (!is_input_port(port))
+    return(method_or_bust_p(sc, port, sc->read_symbol, an_input_port_string));
+
+  if (is_function_port(port))
+    {
+      s7_pointer res = (*(port_input_function(port)))(sc, S7_READ, port);
+      if (is_multiple_value(res))
+	{
+	  clear_multiple_value(res);
+	  error_nr(sc, sc->bad_result_symbol, set_elist_2(sc, wrap_string(sc, "input-function-port read returned: ~S", 37), res));
+	}
+      return(res);
+    }
+  if ((is_string_port(port)) &&
+      (port_data_size(port) <= port_position(port)))
+    return(eof_object);
+
+  push_input_port(sc, port);
+  push_stack_op_let(sc, OP_READ_DONE); /* this stops the internal read process so we only get one form */
+  push_stack_op_let(sc, OP_READ_INTERNAL);
+  return(port);
+}
+
+
+/* -------------------------------- load -------------------------------- */
+#if WITH_MULTITHREAD_CHECKS
+typedef struct {
+  s7_scheme* sc;
+  const int32_t lock_count; /* Remember lock count in case we have skipped calls to leave_track_scope by longjmp-ing */
+} lock_scope_t;
+
+static lock_scope_t enter_lock_scope(s7_scheme *sc)
+{
+  int32_t result = pthread_mutex_trylock(&sc->lock);
+  if (result != 0)
+    {
+      fprintf(stderr, "pthread_mutex_trylock failed: %d (EBUSY: %d)", result, EBUSY);
+      abort();
+    }
+  sc->lock_count++;
+  {
+    lock_scope_t st = {.sc = sc, .lock_count = sc->lock_count};
+    return(st);
+  }
+}
+
+static void leave_lock_scope(lock_scope_t *st)
+{
+  while (st->sc->lock_count > st->lock_count)
+    {
+      st->sc->lock_count--;
+      pthread_mutex_unlock(&st->sc->lock);
+    }
+}
+
+#define TRACK(Sc) lock_scope_t lock_scope __attribute__ ((__cleanup__(leave_lock_scope))) = enter_lock_scope(Sc)
+#else
+#define TRACK(Sc)
+#endif
+
+/* various changes in this section courtesy of Woody Douglass 12-Jul-19 */
+
+static block_t *search_load_path(s7_scheme *sc, const char *name)
+{
+  s7_pointer lst = s7_load_path(sc);
+  if (is_pair(lst))
+    {
+#if MS_WINDOWS || defined(__linux__)
+      #define S7_FILENAME_MAX 4096 /* so we can handle 4095 chars (need trailing null) -- this limit could be added to *s7* */
+#else
+      #define S7_FILENAME_MAX 1024
+#endif
+      /* linux: PATH_MAX: 4096, windows: MAX_PATH: unlimited?, Mac: 1016?, BSD: MAX_PATH_LENGTH: 1024 */
+      block_t *b = mallocate(sc, S7_FILENAME_MAX);
+      char *filename = (char *)block_data(b);
+      s7_int name_len = safe_strlen(name);
+      for (s7_pointer dir_names = lst; is_pair(dir_names); dir_names = cdr(dir_names))
+	{
+	  const char *new_dir = string_value(car(dir_names));
+	  if (new_dir)
+	    {
+	      if ((WITH_WARNINGS) && (string_length(car(dir_names)) + name_len >= S7_FILENAME_MAX))
+		s7_warn(sc, 256, "load: file + directory name too long: %" ld64 " + %" ld64 " > %d\n",
+			name_len, string_length(car(dir_names)), S7_FILENAME_MAX);
+	      filename[0] = '\0';
+	      if (new_dir[strlen(new_dir) - 1] == '/')
+		catstrs(filename, S7_FILENAME_MAX, new_dir, name, (char *)NULL);
+	      else catstrs(filename, S7_FILENAME_MAX, new_dir, "/", name, (char *)NULL);
+#ifdef _MSC_VER
+	      if (_access(filename, 0) != -1)
+		return(b);
+#else
+	      if (access(filename, F_OK) == 0)
+		return(b);
+#endif
+	    }}
+      liberate(sc, b);
+    }
+  return(NULL);
+}
+
+#if WITH_C_LOADER
+#include <dlfcn.h>
+
+static block_t *full_filename(s7_scheme *sc, const char *filename)
+{
+  char *rtn;
+  block_t *block;
+  if ((S7_DEBUGGING) && ((!filename) || (!*filename))) fprintf(stderr, "%s[%d]: filename is %s\n", __func__, __LINE__, filename);
+  if (filename[0] == '/')
+    {
+      s7_int len = safe_strlen(filename);
+      block = mallocate(sc, len + 1);
+      rtn = (char *)block_data(block);
+      memcpy((void *)rtn, (const void *)filename, len);
+      rtn[len] = '\0';
+    }
+  else
+    {
+      char *pwd = getcwd(NULL, 0); /* docs say this means it will return a new string of the right size */
+      size_t pwd_len = safe_strlen(pwd);
+      size_t filename_len = safe_strlen(filename);
+      s7_int len = pwd_len + filename_len + 2; /* not 1! we need room for the '/' and the terminating 0 */
+      block = mallocate(sc, len);
+      rtn = (char *)block_data(block);
+      if (pwd)
+	{
+	  memcpy((void *)rtn, (void *)pwd, pwd_len);
+	  rtn[pwd_len] = '/';
+	  memcpy((void *)(rtn + pwd_len + 1), (const void *)filename, filename_len);
+	  rtn[pwd_len + filename_len + 1] = '\0';
+          free(pwd);
+	}
+      else /* isn't this an error? -- perhaps warn about getcwd, strerror(errno) */
+	{
+          memcpy((void *)rtn, (const void *)filename, filename_len);
+          rtn[filename_len] = '\0';
+	}}
+  return(block);
+}
+
+static s7_pointer load_shared_object(s7_scheme *sc, const char *fname, s7_pointer let)
+{
+  /* if fname ends in .so|.dylib, try loading it as a C shared object: (load "/home/bil/cl/m_j0.so" (inlet 'init_func 'init_m_j0)) */
+  s7_int fname_len = safe_strlen(fname);
+  if (((fname_len > 3) &&
+       (local_strcmp((const char *)(fname + (fname_len - 3)), ".so"))) ||   /* linux */
+      ((fname_len > 6) &&
+       (local_strcmp((const char *)(fname + (fname_len - 3)), ".dylib"))))  /* mac */
+    {
+      void *library;
+      char *pwd_name = NULL;
+      block_t *pname = NULL;
+
+      if ((access(fname, F_OK) == 0) || (fname[0] == '/'))
+	{
+	  pname = full_filename(sc, fname);
+	  pwd_name = (char *)block_data(pname);
+	}
+      else
+	{
+	  block_t *searched = search_load_path(sc, fname); /* returns NULL if *load-path* is nil, or if nothing matches */
+	  if (searched)
+	    {
+	      if (((const char *)block_data(searched))[0] == '/')
+		pname = searched;
+	      else
+		{ /* this is necessary, at least in Linux -- we can't blithely dlopen whatever is passed to us */
+		  pname = full_filename(sc, (const char *)block_data(searched));
+		  liberate(sc, searched);
+		}
+	      pwd_name = (char *)block_data(pname);
+	    }
+	  else /* perhaps no *load-path* entries */
+	    {
+	      pname = full_filename(sc, fname);
+	      pwd_name = (char *)block_data(pname);
+	    }}
+      if ((S7_DEBUGGING) && (!pname)) fprintf(stderr, "pname is null\n");
+      library = dlopen((pname) ? pwd_name : fname, RTLD_NOW);
+      if (!library)
+	s7_warn(sc, 512, "load %s failed: %s\n", (pname) ? pwd_name : fname, dlerror());
+      else
+	if (let) /* look for 'init_func in let -- let has been checked by caller that it actually is a let */
+	  {
+	    s7_pointer init = let_ref_p_pp(sc, let, make_symbol(sc, "init_func", 9));
+	    /* init is a symbol (surely not a gensym?), so it should not need to be protected */
+	    if (!is_symbol(init))
+	      s7_warn(sc, 512, "can't load %s: no init function\n", fname);
+	    else
+	      {
+		const char *init_name;
+		void *init_func;
+
+		if (hook_has_functions(sc->load_hook))
+		  s7_apply_function(sc, sc->load_hook, set_plist_1(sc, s7_make_string(sc, (pname) ? (const char *)pwd_name : fname)));
+
+		init_name = symbol_name(init);
+		init_func = dlsym(library, init_name);
+		if (init_func)
+		  {
+		    typedef void (*dl_func)(s7_scheme *sc);
+		    typedef s7_pointer (*dl_func_with_args)(s7_scheme *sc, s7_pointer args);
+		    s7_pointer init_args = let_ref_p_pp(sc, let, make_symbol(sc, "init_args", 9));
+		    s7_pointer p;
+		    gc_protect_via_stack(sc, init_args);
+		    if (is_pair(init_args))
+		      {
+			p = ((dl_func_with_args)init_func)(sc, init_args);
+			set_gc_protected2(sc, p);
+		      }
+		    /* if caller includes init_args, but init_func is actually a dl_func, it seems to be ok,
+		     *   but the returned value is whatever was last computed in the init_func.
+		     */
+		    else
+		      {
+			/* if the init_func is expecting args, but caller forgets init_args, this gives a segfault when
+			 *   init_func accesses the forgotten args. s7_is_valid can't catch this currently --
+			 *   we need a better way to tell that a random value can't be a cell pointer (scan permallocs and use heap_location?)
+			 */
+			((dl_func)init_func)(sc);
+			p = sc->F;
+		      }
+		    unstack_gc_protect(sc);
+		    if (pname) liberate(sc, pname);
+		    return(p);
+		  }
+		s7_warn(sc, 512, "loaded %s, but can't find init_func %s, dlerror: %s, let: %s\n",
+			fname, init_name, dlerror(), display(let));
+		dlclose(library);
+	      }
+	    if (S7_DEBUGGING) fprintf(stderr, "init_func trouble in %s, %s\n", fname, display(init));
+	    if (pname) liberate(sc, pname);
+	    return(sc->undefined);
+	  }
+      if (pname) liberate(sc, pname);
+    }
+  return(NULL);
+}
+#endif
+
+static s7_pointer load_file_1(s7_scheme *sc, const char *filename)
+{
+  char *local_file_name = NULL;
+  FILE* fp = fopen(filename, "r");
+#if WITH_GCC
+  if (!fp) /* catch one special case, "~/..." since it causes 99.9% of the "can't load ..." errors */
+    {
+      block_t *b = expand_filename(sc, filename);
+      if (b)
+	{
+	  fp = fopen((char *)block_data(b), "r");
+	  if (fp) local_file_name = copy_string((char *)block_data(b));
+	  liberate(sc, b);
+	}}
+#endif
+  if (!fp)
+    {
+      const char *fname;
+      block_t *b = search_load_path(sc, filename);
+      if (!b) return(NULL);
+      fname = (const char *)block_data(b);
+      fp = fopen(fname, "r");
+      if (fp) local_file_name = copy_string_with_length(fname, safe_strlen(fname));
+      liberate(sc, b);
+    }
+  if (fp)
+    {
+      s7_pointer port;
+      if (hook_has_functions(sc->load_hook))
+	s7_apply_function(sc, sc->load_hook, set_plist_1(sc, s7_make_string(sc, (local_file_name) ? local_file_name : filename)));
+      port = read_file(sc, fp, (local_file_name) ? local_file_name : filename, -1, "load"); /* -1 = read entire file into string, this is currently not tweakable */
+      port_file_number(port) = remember_file_name(sc, (local_file_name) ? local_file_name : filename);
+      if (local_file_name) free(local_file_name);
+      set_loader_port(port);
+      push_input_port(sc, port);
+      return(port);
+    }
+  return(NULL);
+}
+
+s7_pointer s7_load_with_environment(s7_scheme *sc, const char *filename, s7_pointer e)
+{
+  /* returns either the value of the load or NULL if filename not found */
+  s7_pointer port;
+  declare_jump_info();
+  TRACK(sc);
+  if (e == sc->s7_starlet) return(NULL);
+  if (e == sc->nil) e = sc->rootlet; /* PERHAPS: this is a leftover from the days when () -> rootlet -- remove? */
+  if (!is_let(e)) s7_warn(sc, 128, "third argument (the let) to s7_load_with_environment is not a let");
+#if WITH_C_LOADER
+  port = load_shared_object(sc, filename, e);
+  if (port) return(port);
+#endif
+
+  if (is_directory(filename)) return(NULL);
+  port = load_file_1(sc, filename);
+  if (!port) return(NULL);
+
+  set_curlet(sc, e);
+  push_stack(sc, OP_LOAD_RETURN_IF_EOF, port, sc->code);
+
+  store_jump_info(sc);
+  set_jump_info(sc, LOAD_SET_JUMP);
+  if (jump_loc == NO_JUMP)
+    eval(sc, OP_READ_INTERNAL);
+  else
+    if (jump_loc != ERROR_JUMP)
+      eval(sc, sc->cur_op);
+  pop_input_port(sc);
+  if (is_input_port(port))
+    s7_close_input_port(sc, port);
+  restore_jump_info(sc);
+
+  if (is_multiple_value(sc->value))
+    sc->value = splice_in_values(sc, multiple_value(sc->value));
+  return(sc->value);
+}
+
+s7_pointer s7_load(s7_scheme *sc, const char *filename) {return(s7_load_with_environment(sc, filename, sc->rootlet));}
+
+s7_pointer s7_load_c_string_with_environment(s7_scheme *sc, const char *content, s7_int bytes, s7_pointer e)
+{
+  s7_pointer port;
+  s7_int port_loc;
+  declare_jump_info();
+  TRACK(sc);
+
+  if (e == sc->nil) e = sc->rootlet; /* PERHAPS: this is a leftover from the days when () -> rootlet -- remove? */
+  if (content[bytes] != 0)
+    error_nr(sc, make_symbol(sc, "bad-data", 8), set_elist_1(sc, wrap_string(sc, "s7_load_c_string content is not terminated", 42)));
+  port = open_input_string(sc, content, bytes);
+  port_loc = gc_protect_1(sc, port);
+  set_loader_port(port);
+  push_input_port(sc, port);
+  set_curlet(sc, e);
+  push_stack(sc, OP_LOAD_RETURN_IF_EOF, port, sc->code);
+  s7_gc_unprotect_at(sc, port_loc);
+
+  store_jump_info(sc);
+  set_jump_info(sc, LOAD_SET_JUMP);
+  if (jump_loc == NO_JUMP)
+    eval(sc, OP_READ_INTERNAL);
+  else
+    if (jump_loc != ERROR_JUMP)
+      eval(sc, sc->cur_op);
+  pop_input_port(sc);
+  if (is_input_port(port))
+    s7_close_input_port(sc, port);
+  restore_jump_info(sc);
+
+  if (is_multiple_value(sc->value))
+    sc->value = splice_in_values(sc, multiple_value(sc->value));
+  return(sc->value);
+}
+
+s7_pointer s7_load_c_string(s7_scheme *sc, const char *content, s7_int bytes)
+{
+  return(s7_load_c_string_with_environment(sc, content, bytes, sc->nil));
+}
+
+static s7_pointer g_load(s7_scheme *sc, s7_pointer args)
+{
+  #define H_load "(load file (let (rootlet))) loads the scheme file 'file'. The 'let' argument \
+defaults to the rootlet.  To load into the current environment instead, pass (curlet)."
+  #define Q_load s7_make_signature(sc, 3, sc->values_symbol, sc->is_string_symbol, sc->is_let_symbol)
+
+  s7_pointer name = car(args);
+  const char *fname;
+
+  if (!is_string(name))
+    return(method_or_bust(sc, name, sc->load_symbol, args, sc->type_names[T_STRING], 1));
+
+  if (is_pair(cdr(args)))
+    {
+      s7_pointer e = cadr(args);
+      if (!is_let(e))
+	wrong_type_error_nr(sc, sc->load_symbol, 2, e, a_let_string);
+      if (e == sc->s7_starlet)
+	error_nr(sc, sc->wrong_type_arg_symbol,
+		 set_elist_2(sc, wrap_string(sc, "can't load ~S into *s7*", 23), name));
+      set_curlet(sc, e);
+    }
+  else set_curlet(sc, sc->rootlet);
+
+  fname = string_value(name);
+  if ((!fname) || (!(*fname)))   /* fopen("", "r") returns a file pointer?? */
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_2(sc, wrap_string(sc, "load's first argument, ~S, should be a filename", 47), name));
+
+  if (is_directory(fname))
+    error_nr(sc, sc->io_error_symbol,
+	     set_elist_2(sc, wrap_string(sc, "load: ~S is a directory", 23), wrap_string(sc, fname, safe_strlen(fname))));
+#if WITH_C_LOADER
+  {
+    s7_pointer p = load_shared_object(sc, fname, sc->curlet);
+    if (p) return(p);
+  }
+#endif
+  errno = 0;
+  if (!load_file_1(sc, fname))
+    file_error_nr(sc, "load", strerror(errno), fname);
+
+  push_stack_op_let(sc, OP_LOAD_CLOSE_AND_POP_IF_EOF);  /* was pushing args and code, but I don't think they're used later */
+  push_stack_op_let(sc, OP_READ_INTERNAL);
+  return(sc->unspecified);
+}
+
+
+/* -------- *load-path* -------- */
+s7_pointer s7_load_path(s7_scheme *sc) {return(s7_symbol_local_value(sc, sc->load_path_symbol, sc->curlet));}
+
+s7_pointer s7_add_to_load_path(s7_scheme *sc, const char *dir)
+{
+  s7_pointer slot = lookup_slot_from(sc->load_path_symbol, sc->curlet); /* rootlet possible here */
+  s7_pointer path = cons(sc, s7_make_string(sc, dir), slot_value(slot));
+  slot_set_value(slot, path);
+  return(path);
+}
+
+static s7_pointer g_load_path_set(s7_scheme *sc, s7_pointer args)
+{
+  /* new value must be either () or a proper list of strings */
+  s7_pointer x;
+  if (is_null(cadr(args))) return(cadr(args));
+  if (!is_pair(cadr(args)))
+    error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "can't set *load-path* to ~S", 27), cadr(args)));
+  for (x = cadr(args); is_pair(x); x = cdr(x))
+    if (!is_string(car(x)))
+      error_nr(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, wrap_string(sc, "can't set *load-path* to ~S, ~S is not a string", 47), cadr(args), car(x)));
+  if (!is_null(x))
+    error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "can't set *load-path* to ~S, it is not a proper list", 52), cadr(args)));
+  return(cadr(args));
+}
+
+/* -------- *cload-directory* -------- */
+static s7_pointer g_cload_directory_set(s7_scheme *sc, s7_pointer args)
+{
+  /* this sets the directory for cload.scm's output */
+  s7_pointer cl_dir = cadr(args);
+  if (!is_string(cl_dir))
+    error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "can't set *cload-directory* to ~S", 33), cadr(args)));
+  s7_symbol_set_value(sc, sc->cload_directory_symbol, cl_dir);
+  if (string_length(cl_dir) > 0) /* was strlen(string_value)? */
+    s7_add_to_load_path(sc, (const char *)(string_value(cl_dir)));
+  /* should this remove the previous *cload-directory* name first? or not affect *load-path* at all? */
+  return(cl_dir);
+}
+
+
+/* ---------------- autoload ---------------- */
+#define INITIAL_AUTOLOAD_NAMES_SIZE 4
+
+void s7_autoload_set_names(s7_scheme *sc, const char **names, s7_int size)
+{
+  /* names should be sorted alphabetically by the symbol name (the even indexes in the names array)
+   *   size is the number of symbol names (half the size of the names array(
+   * the idea here is that by sticking to string constants we can handle 90% of the work at compile-time,
+   *   with less start-up memory.  Then eventually we'll add C libraries and every name in those libraries
+   *   will come as an import once dlopen has picked up the library.
+   */
+  if (sc->safety > IMMUTABLE_VECTOR_SAFETY)
+    for (int32_t i = 0, k = 2; k < (size * 2); i += 2, k += 2)
+      if ((names[i]) && (names[k]) && (strcmp(names[i], names[k]) > 0))
+	{
+	  s7_warn(sc, 256, "%s: names[%d]: %s is out of order\n", __func__, k, names[k]);
+	  break;
+	}
+  if (!sc->autoload_names)
+    {
+      sc->autoload_names = (const char ***)Calloc(INITIAL_AUTOLOAD_NAMES_SIZE, sizeof(const char **));
+      sc->autoload_names_sizes = (s7_int *)Calloc(INITIAL_AUTOLOAD_NAMES_SIZE, sizeof(s7_int));
+      sc->autoloaded_already = (bool **)Calloc(INITIAL_AUTOLOAD_NAMES_SIZE, sizeof(bool *));
+      sc->autoload_names_top = INITIAL_AUTOLOAD_NAMES_SIZE;
+      sc->autoload_names_loc = 0;
+    }
+  else
+    if (sc->autoload_names_loc >= sc->autoload_names_top)
+      {
+	sc->autoload_names_top *= 2;
+	sc->autoload_names = (const char ***)Realloc(sc->autoload_names, sc->autoload_names_top * sizeof(const char **));
+	sc->autoload_names_sizes = (s7_int *)Realloc(sc->autoload_names_sizes, sc->autoload_names_top * sizeof(s7_int));
+	sc->autoloaded_already = (bool **)Realloc(sc->autoloaded_already, sc->autoload_names_top * sizeof(bool *));
+	for (s7_int i = sc->autoload_names_loc; i < sc->autoload_names_top; i++)
+	  {
+	    sc->autoload_names[i] = NULL;
+	    sc->autoload_names_sizes[i] = 0;
+	    sc->autoloaded_already[i] = NULL;
+	  }}
+  sc->autoload_names[sc->autoload_names_loc] = names;
+  sc->autoload_names_sizes[sc->autoload_names_loc] = size;
+  sc->autoloaded_already[sc->autoload_names_loc] = (bool *)Calloc(size, sizeof(bool));
+  sc->autoload_names_loc++;
+}
+
+static const char *find_autoload_name(s7_scheme *sc, s7_pointer symbol, bool *already_loaded, bool loading)
+{
+  s7_int l = 0, libs = sc->autoload_names_loc;
+  const char *name = symbol_name(symbol);
+  for (s7_int lib = 0; lib < libs; lib++)
+    {
+      s7_int u = sc->autoload_names_sizes[lib] - 1;
+      const char **names = sc->autoload_names[lib];
+      while (true)
+	{
+	  s7_int comp, pos;
+	  const char *this_name;
+	  if (u < l) break;
+	  pos = (l + u) / 2;
+	  this_name = names[pos * 2];
+	  comp = strcmp(this_name, name);
+	  if (comp == 0)
+	    {
+	      *already_loaded = sc->autoloaded_already[lib][pos];
+	      if (loading) sc->autoloaded_already[lib][pos] = true;
+	      return(names[pos * 2 + 1]);             /* file name given func name */
+	    }
+	  if (comp < 0)
+	    l = pos + 1;
+	  else u = pos - 1;
+	}}
+  return(NULL);
+}
+
+s7_pointer s7_autoload(s7_scheme *sc, s7_pointer symbol, s7_pointer file_or_function)
+{
+  /* add '(symbol . file) to s7's autoload table */
+  if (is_null(sc->autoload_table))
+    sc->autoload_table = s7_make_hash_table(sc, 32); /* add_hash_table here, perhaps sc->hash_tables->loc-- */
+  if (sc->safety >= MORE_SAFETY_WARNINGS)
+    {
+      const s7_pointer p = s7_hash_table_ref(sc, sc->autoload_table, symbol);
+      if ((p != sc->F) && (p != file_or_function))
+	s7_warn(sc, 256, "'%s autoload value changed\n", symbol_name(symbol));
+    }
+  s7_hash_table_set(sc, sc->autoload_table, symbol, file_or_function);
+  return(file_or_function);
+}
+
+static s7_pointer g_autoload(s7_scheme *sc, s7_pointer args)
+{
+  #define H_autoload "(autoload symbol file-or-function) adds the symbol to its table of autoloadable symbols. \
+If that symbol is encountered as an unbound variable, s7 either loads the file (following *load-path*), or calls \
+the function.  The function takes one argument, the calling environment.  Presumably the symbol is defined \
+in the file, or by the function."
+  #define Q_autoload s7_make_signature(sc, 3, sc->T, sc->is_symbol_symbol, sc->T)
+
+  s7_pointer sym = car(args), value;
+  if (is_string(sym))
+    {
+      if (string_length(sym) == 0)                   /* (autoload "" ...) */
+	wrong_type_error_nr(sc, sc->autoload_symbol, 1, sym, wrap_string(sc, "a symbol-name or a symbol", 25));
+      sym = make_symbol(sc, string_value(sym), string_length(sym));
+    }
+  if (!is_symbol(sym))
+    {
+      check_method(sc, sym, sc->autoload_symbol, args);
+      wrong_type_error_nr(sc, sc->autoload_symbol, 1, sym, wrap_string(sc, "a string (symbol-name) or a symbol", 34));
+    }
+  if (is_keyword(sym))
+    wrong_type_error_nr(sc, sc->autoload_symbol, 1, sym, wrap_string(sc, "a normal symbol (a keyword is never unbound)", 44));
+
+  value = cadr(args);
+  if (is_string(value))
+    return(s7_autoload(sc, sym, s7_immutable(make_string_with_length(sc, string_value(value), string_length(value)))));
+  if (((is_closure(value)) || (is_closure_star(value))) &&
+      (s7_is_aritable(sc, value, 1)))
+    return(s7_autoload(sc, sym, value));
+
+  check_method(sc, value, sc->autoload_symbol, args);
+  wrong_type_error_nr(sc, sc->autoload_symbol, 2, value, wrap_string(sc, "a string (file-name) or a thunk", 31));
+  return(NULL); /* make tcc happy */
+}
+
+
+/* -------------------------------- *autoload* -------------------------------- */
+static s7_pointer g_autoloader(s7_scheme *sc, s7_pointer args) /* the *autoload* function */
+{
+  #define H_autoloader "(*autoload* sym) returns the autoload info for the symbol sym, or #f."
+  #define Q_autoloader s7_make_signature(sc, 2, sc->T, sc->is_symbol_symbol)
+
+  s7_pointer sym = car(args);
+  if (!is_symbol(sym))
+    {
+      check_method(sc, sym, sc->autoloader_symbol, set_plist_1(sc, sym));
+      wrong_type_error_nr(sc, wrap_string(sc, "*autoload*", 10), 1, sym, sc->type_names[T_SYMBOL]);
+    }
+  if (sc->autoload_names)
+    {
+      bool loaded = false;
+      const char *file = find_autoload_name(sc, sym, &loaded, false);
+      if (file)
+	return(s7_make_string(sc, file));
+    }
+  if (is_hash_table(sc->autoload_table))
+    return(s7_hash_table_ref(sc, sc->autoload_table, sym));
+  return(sc->F);
+}
+
+
+/* ---------------- require ---------------- */
+static bool is_a_feature(const s7_pointer sym, s7_pointer lst) /* used only with *features* which (sigh) can be circular: (set-cdr! *features* *features*) */
+{
+  s7_pointer x = lst, slow = lst;
+  while (true)
+    {
+      if (!is_pair(x)) return(false);
+      if (sym == car(x)) return(true);
+      x = cdr(x);
+      if (!is_pair(x)) return(false);
+      if (sym == car(x)) return(true);
+      x = cdr(x);
+      slow = cdr(slow);
+      if (x == slow) return(false);
+    }
+  return(false);
+}
+
+static s7_pointer g_require(s7_scheme *sc, s7_pointer args)
+{
+  #define H_require "(require symbol . symbols) loads each file associated with each symbol if it has not been loaded already.\
+The symbols refer to the argument to \"provide\".  (require lint.scm)"
+  /* #define Q_require s7_make_circular_signature(sc, 1, 2, sc->T, sc->is_symbol_symbol) */
+
+  gc_protect_via_stack(sc, args);
+  for (s7_pointer p = args; is_pair(p); p = cdr(p))
+    {
+      s7_pointer sym;
+      if (is_symbol(car(p)))
+	sym = car(p);
+      else
+	if ((is_proper_quote(sc, car(p))) &&
+	    (is_symbol(cadar(p))))
+	  sym = cadar(p);
+	else
+	  {
+	    unstack_gc_protect(sc);
+	    error_nr(sc, sc->wrong_type_arg_symbol,
+		     set_elist_2(sc, wrap_string(sc, "require: ~S is not a symbol", 27), car(p)));
+	  }
+      if ((!is_a_feature(sym, s7_symbol_value(sc, sc->features_symbol))) &&
+	  (sc->is_autoloading))
+	{
+	  s7_pointer f = g_autoloader(sc, set_plist_1(sc, sym));
+	  if (is_false(sc, f))
+	    {
+	      unstack_gc_protect(sc);
+	      error_nr(sc, sc->autoload_error_symbol,
+		       set_elist_2(sc, wrap_string(sc, "require: no autoload info for ~S", 32), sym));
+	    }
+	  if (hook_has_functions(sc->autoload_hook))
+	    s7_apply_function(sc, sc->autoload_hook, set_plist_2(sc, sym, f));
+	  if (is_string(f))
+	    s7_load_with_environment(sc, string_value(f), sc->curlet);
+	  else
+	    if (is_closure(f))   /* f should be a function of one argument, the current (calling) environment */
+	      s7_call(sc, f, set_ulist_1(sc, sc->curlet, sc->nil));
+	}}
+  if (stack_top_op(sc) == OP_GC_PROTECT) unstack_gc_protect(sc); /* op_error_quit if load failed in scheme in Snd */
+  return(sc->T);
+}
+
+
+/* ---------------- provided? ---------------- */
+static s7_pointer g_is_provided(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_provided "(provided? symbol) returns #t if symbol is a member of the *features* list"
+  #define Q_is_provided s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_symbol_symbol)
+
+  s7_pointer sym = car(args), topf, x;
+  if (!is_symbol(sym))
+    return(method_or_bust_p(sc, sym, sc->is_provided_symbol, sc->type_names[T_SYMBOL]));
+
+  /* here the *features* list is spread out (or can be anyway) along the curlet chain,
+   *   so we need to travel back all the way to the top level checking each *features* list in turn.
+   *   Since *features* grows via cons (newest first), we can stop the scan if we hit the shared
+   *   top-level at least.
+   */
+  topf = global_value(sc->features_symbol);
+  if (is_a_feature(sym, topf))
+    return(sc->T);
+
+  if (is_global(sc->features_symbol))
+    return(sc->F);
+  for (x = sc->curlet; let_id(x) > symbol_id(sc->features_symbol); x = let_outlet(x));
+  for (; x; x = let_outlet(x))
+    for (s7_pointer y = let_slots(x); tis_slot(y); y = next_slot(y))
+      if ((slot_symbol(y) == sc->features_symbol) &&
+	  (slot_value(y) != topf) &&
+	  (is_a_feature(sym, slot_value(y))))
+	return(sc->T);
+  return(sc->F);
+}
+
+bool s7_is_provided(s7_scheme *sc, const char *feature)
+{
+  return(is_a_feature(make_symbol_with_strlen(sc, feature), s7_symbol_value(sc, sc->features_symbol))); /* this goes from local outward */
+}
+
+static bool is_provided_b_7p(s7_scheme *sc, s7_pointer sym)
+{
+  if (!is_symbol(sym))
+    return(method_or_bust_p(sc, sym, sc->is_provided_symbol, sc->type_names[T_SYMBOL]) != sc->F);
+  return(is_a_feature(sym, s7_symbol_value(sc, sc->features_symbol)));
+}
+
+
+/* ---------------- provide ---------------- */
+static s7_pointer c_provide(s7_scheme *sc, s7_pointer sym)
+{
+  /* this has to be relative to the curlet: (load file env)
+   *   the things loaded are only present in env, and go away with it, so should not be in the global *features* list
+   */
+  s7_pointer p;
+  if (!is_symbol(sym))
+    return(method_or_bust_p(sc, sym, sc->provide_symbol, sc->type_names[T_SYMBOL]));
+  if ((sc->curlet == sc->rootlet) || (sc->curlet == sc->shadow_rootlet)) /* sc->curlet can also be (for example) the repl top-level */
+    p = global_slot(sc->features_symbol);
+  else p = symbol_to_local_slot(sc, sc->features_symbol, sc->curlet); /* if sc->curlet is nil, this returns the global slot, else local slot */
+  if ((is_slot(p)) && (is_immutable_slot(p)))
+    s7_warn(sc, 256, "provide: *features* is immutable!\n");
+  else
+    {
+      s7_pointer lst = slot_value(s7_slot(sc, sc->features_symbol)); /* in either case, we want the current *features* list */
+      if (p == sc->undefined)
+	{
+	  /* (setter symbol) follows local lets, so we need to make sure this one is set */
+	  s7_pointer slot = add_slot_checked_with_id(sc, sc->curlet, sc->features_symbol, cons(sc, sym, lst));
+	  slot_set_setter(slot, sc->features_setter);
+	  slot_set_has_setter(slot);
+	}
+      else
+	if ((!is_a_feature(sym, lst)) && (!is_a_feature(sym, slot_value(p))))
+	  slot_set_value(p, cons(sc, sym, slot_value(p)));
+    }
+  return(sym);
+}
+
+static s7_pointer g_provide(s7_scheme *sc, s7_pointer args)
+{
+  #define H_provide "(provide symbol) adds symbol to the *features* list"
+  #define Q_provide s7_make_signature(sc, 2, sc->is_symbol_symbol, sc->is_symbol_symbol)
+
+  if ((is_immutable(sc->curlet)) &&
+      (sc->curlet != sc->nil))
+    immutable_object_error_nr(sc, set_elist_2(sc, wrap_string(sc, "can't provide '~S (current environment is immutable)", 52), car(args)));
+  return(c_provide(sc, car(args)));
+}
+
+void s7_provide(s7_scheme *sc, const char *feature) {c_provide(sc, make_symbol_with_strlen(sc, feature));}
+
+
+static s7_pointer g_features_set(s7_scheme *sc, s7_pointer args) /* *features* setter */
+{
+  s7_pointer nf = cadr(args);
+  if (is_null(nf))
+    return(sc->nil);
+  if (!is_pair(nf))
+    error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "can't set *features* to ~S (*features* must be a list)", 54), nf));
+  if (s7_list_length(sc, nf) <= 0)
+    error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "can't set *features* to an improper or circular list ~S", 55), nf));
+  for (s7_pointer p = nf; is_pair(p); p = cdr(p))
+    if (!is_symbol(car(p)))
+      sole_arg_wrong_type_error_nr(sc, sc->features_symbol, car(p), sc->type_names[T_SYMBOL]);
+  return(nf);
+}
+
+static s7_pointer g_libraries_set(s7_scheme *sc, s7_pointer args) /* *libraries* setter */
+{
+  s7_pointer nf = cadr(args);
+  if (is_null(nf)) return(nf);
+  if ((!is_pair(nf)) ||
+      (s7_list_length(sc, nf) <= 0))
+    error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "can't set *libraries* to ~S", 27), nf));
+  for (s7_pointer p = nf; is_pair(p); p = cdr(p))
+    if ((!is_pair(car(p))) ||
+	(!is_string(caar(p))) ||
+	(!is_let(cdar(p))))
+      sole_arg_wrong_type_error_nr(sc, sc->libraries_symbol, car(p), wrap_string(sc, "a list of conses of the form (string . let)", 43));
+  return(nf);
+}
+
+
+/* -------------------------------- eval-string -------------------------------- */
+s7_pointer s7_eval_c_string_with_environment(s7_scheme *sc, const char *str, s7_pointer e)
+{
+  s7_pointer code, port, result;
+  TRACK(sc);
+  push_stack_direct(sc, OP_GC_PROTECT); /* not gc protection here, but restoration of original context */
+  port = s7_open_input_string(sc, str);
+  code = s7_read(sc, port);
+  s7_close_input_port(sc, port);
+  result = s7_eval(sc, T_Ext(code), e);
+  if (unchecked_stack_top_op(sc) == OP_GC_PROTECT) unstack_gc_protect(sc); /* pop_stack(sc); */
+  return(result);
+}
+
+s7_pointer s7_eval_c_string(s7_scheme *sc, const char *str) {return(s7_eval_c_string_with_environment(sc, str, sc->nil));}
+
+static s7_pointer g_eval_string(s7_scheme *sc, s7_pointer args)
+{
+  #define H_eval_string "(eval-string str (let (curlet))) returns the result of evaluating the string str as Scheme code"
+  #define Q_eval_string s7_make_signature(sc, 3, sc->values_symbol, sc->is_string_symbol, sc->is_let_symbol)
+
+  s7_pointer port, str = car(args);
+  if (!is_string(str))
+    return(method_or_bust(sc, str, sc->eval_string_symbol, args, sc->type_names[T_STRING], 1));
+  if (string_length(str) == 0)
+    return(sc->F);  /* (eval-string "") -> #f */
+  if (is_not_null(cdr(args)))
+    {
+      s7_pointer e = cadr(args);
+      if (!is_let(e))
+ 	wrong_type_error_nr(sc, sc->eval_string_symbol, 2, e, a_let_string);
+      set_curlet(sc, e);
+    }
+  sc->temp3 = sc->args; /* see t101-17.scm */
+  push_stack(sc, OP_EVAL_STRING, args, sc->code);
+  port = open_and_protect_input_string(sc, str);
+  push_input_port(sc, port);
+  push_stack_op_let(sc, OP_READ_INTERNAL);
+  return(sc->F);  /* I think this means that sc->value defaults to #f in op_eval_string below, so (eval-string "") mimics (eval) -> #f */
+}
+
+static s7_pointer op_eval_string(s7_scheme *sc)
+{
+  while (s7_peek_char(sc, current_input_port(sc)) != eof_object) /* (eval-string "(+ 1 2) this is a mistake") */
+    {
+      int32_t tk = token(sc);      /* (eval-string "(+ 1 2) ; a comment (not a mistake)") */
+      if (tk != TOKEN_EOF)
+	{
+	  s7_pointer trail_data;
+	  s7_int trail_len = port_data_size(current_input_port(sc)) - port_position(current_input_port(sc)) + 1;
+	  if (trail_len > 32) trail_len = 32;
+	  trail_data = wrap_string(sc, (const char *)(port_data(current_input_port(sc)) + port_position(current_input_port(sc)) - 1), trail_len);
+	  s7_close_input_port(sc, current_input_port(sc));
+	  pop_input_port(sc);
+	  error_nr(sc, sc->read_error_symbol, set_elist_2(sc, wrap_string(sc, "eval-string trailing junk: ~S", 29), trail_data));
+	}}
+  s7_close_input_port(sc, current_input_port(sc));
+  pop_input_port(sc);
+  sc->code = sc->value;
+  set_current_code(sc, sc->code);
+  return(NULL);
+}
+
+
+/* -------------------------------- call-with-input-string -------------------------------- */
+static s7_pointer call_with_input(s7_scheme *sc, s7_pointer port, s7_pointer args)
+{
+  s7_pointer p = cadr(args);
+  port_set_string_or_function(port, car(args));
+  push_stack(sc, OP_UNWIND_INPUT, sc->unused, port); /* #<unused> here is a marker (needed) */
+  push_stack(sc, OP_APPLY, list_1(sc, port), p);
+  return(sc->F);
+}
+
+static s7_pointer g_call_with_input_string(s7_scheme *sc, s7_pointer args)
+{
+  #define H_call_with_input_string "(call-with-input-string str proc) opens a string port for str and applies proc to it"
+  #define Q_call_with_input_string sc->pl_sf
+  /* (call-with-input-string "44" (lambda (p) (+ 1 (read p)))) -> 45 */
+
+  s7_pointer str = car(args), proc = cadr(args);
+  if (!is_string(str))
+    return(method_or_bust(sc, str, sc->call_with_input_string_symbol, args, sc->type_names[T_STRING], 1));
+
+  if (is_let(proc))
+    check_method(sc, proc, sc->call_with_input_string_symbol, args);
+
+  if (!s7_is_aritable(sc, proc, 1))
+    wrong_type_error_nr(sc, sc->call_with_input_string_symbol, 2, proc,
+					 wrap_string(sc, "a procedure of one argument (the port)", 38));
+  if ((is_continuation(proc)) || (is_goto(proc)))
+    wrong_type_error_nr(sc, sc->call_with_input_string_symbol, 2, proc, a_normal_procedure_string);
+  return(call_with_input(sc, open_and_protect_input_string(sc, str), args));
+}
+
+
+/* -------------------------------- call-with-input-file -------------------------------- */
+static s7_pointer g_call_with_input_file(s7_scheme *sc, s7_pointer args)
+{
+  #define H_call_with_input_file "(call-with-input-file filename proc) opens filename and calls proc with the input port as its argument"
+  #define Q_call_with_input_file sc->pl_sf
+
+  s7_pointer str = car(args), proc = cadr(args);
+  if (!is_string(str))
+    return(method_or_bust(sc, str, sc->call_with_input_file_symbol, args, sc->type_names[T_STRING], 1));
+
+  if (!s7_is_aritable(sc, proc, 1))
+    wrong_type_error_nr(sc, sc->call_with_input_file_symbol, 2, proc,
+					 wrap_string(sc, "a procedure of one argument (the port)", 38));
+  if ((is_continuation(proc)) || (is_goto(proc)))
+    wrong_type_error_nr(sc, sc->call_with_input_file_symbol, 2, proc, a_normal_procedure_string);
+  return(call_with_input(sc, open_input_file_1(sc, string_value(str), "r", "call-with-input-file"), args));
+}
+
+
+/* -------------------------------- with-input-from-string -------------------------------- */
+static s7_pointer with_input(s7_scheme *sc, s7_pointer port, s7_pointer args)
+{
+  s7_pointer old_input_port = current_input_port(sc);
+  set_current_input_port(sc, port);
+  port_set_string_or_function(port, car(args));
+  push_stack(sc, OP_UNWIND_INPUT, old_input_port, port);
+  push_stack(sc, OP_APPLY, sc->nil, cadr(args));
+  return(sc->F);
+}
+
+static s7_int procedure_required_args(s7_scheme *sc, s7_pointer x)
+{
+  switch (type(x))
+    {
+    case T_C_FUNCTION: return(c_function_min_args(x));
+    case T_C_MACRO:    return(c_macro_min_args(x));
+    case T_CLOSURE: case T_MACRO: case T_BACRO:
+      if (closure_arity_unknown(x))
+	closure_set_arity(x, s7_list_length(sc, closure_args(x)));
+      return(s7_int_abs(closure_arity(x)));
+    }
+  return(0);
+}
+
+static s7_pointer g_with_input_from_string(s7_scheme *sc, s7_pointer args)
+{
+  #define H_with_input_from_string "(with-input-from-string str thunk) opens str as the temporary current-input-port and calls thunk"
+  #define Q_with_input_from_string sc->pl_sf
+
+  s7_pointer str = car(args), proc = cadr(args);
+  if (!is_string(str))
+    return(method_or_bust(sc, str, sc->with_input_from_string_symbol, args, sc->type_names[T_STRING], 1));
+  if (proc == global_value(sc->read_symbol))
+    {
+      if (string_length(str) == 0)
+	return(eof_object);
+      push_input_port(sc, current_input_port(sc));
+      set_current_input_port(sc, open_and_protect_input_string(sc, str));
+      port_set_string_or_function(current_input_port(sc), str);
+      push_stack(sc, OP_UNWIND_INPUT, sc->unused, current_input_port(sc));
+      push_stack_op_let(sc, OP_READ_DONE);
+      push_stack_op_let(sc, OP_READ_INTERNAL);
+      return(current_input_port(sc));
+    }
+  if (!is_thunk(sc, proc))
+    {
+      if (is_any_procedure(proc))        /* i.e. c_function, lambda, macro, etc */
+	{
+	  s7_pointer req_args = wrap_integer(sc, procedure_required_args(sc, proc));
+	  error_nr(sc, sc->wrong_type_arg_symbol,
+		   set_elist_4(sc, wrap_string(sc, "~A requires ~D argument~P, but with-input-from-string's second argument should be a thunk", 89),
+			       proc, req_args, req_args));
+	}
+      else return(method_or_bust(sc, proc, sc->with_input_from_string_symbol, args, a_thunk_string, 2));
+    }
+  /* since the arguments are evaluated before we get here, we can get some confusing situations:
+   *   (with-input-from-string "#x2.1" (read))
+   *     (read) -> whatever it can get from the current input port!
+   *     ";with-input-from-string argument 2, #<eof>, is untyped but should be a thunk"
+   *   (with-input-from-string "" (read-line)) -> hangs awaiting stdin input
+   * also this can't be split into wifs and wifs_read because we need the runtime value of 'read
+   */
+  return(with_input(sc, open_and_protect_input_string(sc, str), args));
+}
+
+
+/* -------------------------------- with-input-from-file -------------------------------- */
+static s7_pointer g_with_input_from_file(s7_scheme *sc, s7_pointer args)
+{
+  #define H_with_input_from_file "(with-input-from-file filename thunk) opens filename as the temporary current-input-port and calls thunk"
+  #define Q_with_input_from_file sc->pl_sf
+
+  s7_pointer str = car(args), proc = cadr(args);
+  if (!is_string(str))
+    return(method_or_bust(sc, str, sc->with_input_from_file_symbol, args, sc->type_names[T_STRING], 1));
+  if (!is_thunk(sc, proc))
+    {
+      if (is_any_procedure(proc))        /* i.e. c_function, lambda, macro, etc */
+	{
+	  s7_pointer req_args = wrap_integer(sc, procedure_required_args(sc, proc));
+	  error_nr(sc, sc->wrong_type_arg_symbol,
+		   set_elist_4(sc, wrap_string(sc, "~A requires ~D argument~P, but with-input-from-file's second argument should be a thunk", 87),
+			       proc, req_args, req_args));
+	}
+      else return(method_or_bust(sc, proc, sc->with_input_from_file_symbol, args, a_thunk_string, 2));
+    }
+  return(with_input(sc, open_input_file_1(sc, string_value(str), "r", "with-input-from-file"), args));
+}
+
+static s7_pointer with_string_in(s7_scheme *sc, s7_pointer unused_args)
+{
+  s7_pointer old_port = current_input_port(sc);
+  set_current_input_port(sc, open_and_protect_input_string(sc, sc->value));
+  push_stack(sc, OP_UNWIND_INPUT, old_port, current_input_port(sc));
+  set_curlet(sc, inline_make_let(sc, sc->curlet));
+  return(opt2_pair(sc->code));
+}
+
+static s7_pointer with_file_in(s7_scheme *sc, s7_pointer unused_args)
+{
+  s7_pointer old_port = current_input_port(sc);
+  set_current_input_port(sc, open_input_file_1(sc, string_value(sc->value), "r", "with-input-from-file"));
+  push_stack(sc, OP_UNWIND_INPUT, old_port, current_input_port(sc));
+  set_curlet(sc, inline_make_let(sc, sc->curlet));
+  return(opt2_pair(sc->code));
+}
+
+static s7_pointer with_file_out(s7_scheme *sc, s7_pointer unused_args)
+{
+  s7_pointer old_port = current_output_port(sc);
+  set_current_output_port(sc, s7_open_output_file(sc, string_value(sc->value), "w"));
+  push_stack(sc, OP_UNWIND_OUTPUT, old_port, current_output_port(sc));
+  set_curlet(sc, make_let(sc, sc->curlet));
+  return(opt2_pair(sc->code));
+}
+
+static s7_pointer call_string_in(s7_scheme *sc, s7_pointer unused_args)
+{
+  s7_pointer port = open_and_protect_input_string(sc, sc->value);
+  push_stack(sc, OP_UNWIND_INPUT, sc->unused, port);
+  set_curlet(sc, inline_make_let_with_slot(sc, sc->curlet, opt3_sym(sc->code), port));
+  return(opt2_pair(sc->code));
+}
+
+static s7_pointer call_file_in(s7_scheme *sc, s7_pointer unused_args)
+{
+  s7_pointer port = open_input_file_1(sc, string_value(sc->value), "r", "with-input-from-file");
+  push_stack(sc, OP_UNWIND_INPUT, sc->unused, port);
+  set_curlet(sc, inline_make_let_with_slot(sc, sc->curlet, opt3_sym(sc->code), port));
+  return(opt2_pair(sc->code));
+}
+
+static s7_pointer call_file_out(s7_scheme *sc, s7_pointer unused_args)
+{
+  s7_pointer port = s7_open_output_file(sc, string_value(sc->value), "w");
+  push_stack(sc, OP_UNWIND_OUTPUT, sc->unused, port);
+  set_curlet(sc, make_let_with_slot(sc, sc->curlet, opt3_sym(sc->code), port));
+  return(opt2_pair(sc->code));
+}
+
+static s7_pointer c_function_name_to_symbol(s7_scheme *sc, s7_pointer f)
+{
+  if (!is_c_function(f))  /* c_function* uses c_sym slot for arg_names */
+    return(make_symbol(sc, c_function_name(f), c_function_name_length(f)));
+  if (!c_function_symbol(f))
+    c_function_symbol(f) = make_symbol(sc, c_function_name(f), c_function_name_length(f));
+  return(c_function_symbol(f));
+}
+
+#define op_with_io_1(Sc) (((s7_function)(opt1(Sc->code, OPT1_ANY)))(Sc, Sc->nil))
+static s7_pointer op_lambda(s7_scheme *sc, s7_pointer code);
+
+static void op_with_io_1_method(s7_scheme *sc)
+{
+  s7_pointer lt = sc->value;
+  if (has_active_methods(sc, lt))
+    {
+      s7_pointer method = car(sc->code);
+      if (is_c_function(method))            /* #_call-with-input-string et al */
+	method = c_function_name_to_symbol(sc, method);
+      push_stack(sc, OP_GC_PROTECT, lt, sc->code);
+      sc->code = caddr(sc->code);
+      sc->value = op_lambda(sc, sc->code);  /* don't unstack */
+      sc->value = find_and_apply_method(sc, lt, method, list_2(sc, lt, sc->value));
+    }
+  else
+    if (is_symbol(car(sc->code)))           /* might be e.g. #_call-with-input-string so use c_function_name */
+      wrong_type_error_nr(sc, car(sc->code), 1, lt, sc->type_names[T_STRING]);
+    else wrong_type_error_nr(sc, wrap_string(sc, c_function_name(car(sc->code)), c_function_name_length(car(sc->code))), 1, lt, sc->type_names[T_STRING]);
+}
+
+static bool op_with_io_op(s7_scheme *sc)
+{
+  sc->value = cadr(sc->code);
+  if (is_string(sc->value))
+    {
+      sc->code = op_with_io_1(sc);
+      return(false);
+    }
+  push_stack_no_args_direct(sc, OP_WITH_IO_1);
+  sc->code = sc->value;
+  return(true);
+}
+
+static void op_with_output_to_string(s7_scheme *sc)
+{
+  s7_pointer old_port = current_output_port(sc);
+  set_current_output_port(sc, s7_open_output_string(sc));
+  push_stack(sc, OP_UNWIND_OUTPUT, old_port, current_output_port(sc));
+  set_curlet(sc, inline_make_let(sc, sc->curlet));
+  push_stack(sc, OP_GET_OUTPUT_STRING, old_port, current_output_port(sc));
+  sc->code = opt2_pair(sc->code);
+}
+
+static void op_call_with_output_string(s7_scheme *sc)
+{
+  s7_pointer port = s7_open_output_string(sc);
+  push_stack(sc, OP_UNWIND_OUTPUT, sc->unused, port);
+  set_curlet(sc, inline_make_let_with_slot(sc, sc->curlet, opt3_sym(sc->code), port));
+  push_stack(sc, OP_GET_OUTPUT_STRING, sc->unused, port);
+  sc->code = opt2_pair(sc->code);
+}
+
+
+/* -------------------------------- iterators -------------------------------- */
+#if S7_DEBUGGING
+static s7_pointer titr_let(s7_scheme *sc, s7_pointer p, const char *func, int32_t line)
+{
+  if (!is_let(iterator_sequence(p)))
+    {
+      fprintf(stderr, "%s%s[%d]: let iterator sequence is %s%s\n",
+	      bold_text, func, line, checked_type_name(sc, unchecked_type(iterator_sequence(p))), unbold_text);
+      if (sc->stop_at_error) abort();
+    }
+  return(p);
+}
+
+static s7_pointer titr_pair(s7_scheme *sc, s7_pointer p, const char *func, int32_t line)
+{
+  if (!is_pair(iterator_sequence(p)))
+    {
+      fprintf(stderr, "%s%s[%d]: pair iterator sequence is %s%s\n",
+	      bold_text, func, line, checked_type_name(sc, unchecked_type(iterator_sequence(p))), unbold_text);
+      if (sc->stop_at_error) abort();
+    }
+  return(p);
+}
+
+static s7_pointer titr_hash(s7_scheme *sc, s7_pointer p, const char *func, int32_t line)
+{
+  if (!is_hash_table(iterator_sequence(p)))
+    {
+      fprintf(stderr, "%s%s[%d]: hash iterator sequence is %s%s\n",
+	      bold_text, func, line, checked_type_name(sc, unchecked_type(iterator_sequence(p))), unbold_text);
+      if (sc->stop_at_error) abort();
+    }
+  return(p);
+}
+
+static s7_pointer titr_len(s7_scheme *sc, s7_pointer p, const char *func, int32_t line)
+{
+  if ((is_hash_table(iterator_sequence(p))) || (is_pair(iterator_sequence(p))))
+    {
+      fprintf(stderr, "%s%s[%d]: iterator length sequence is %s%s\n",
+	      bold_text, func, line, checked_type_name(sc, unchecked_type(iterator_sequence(p))), unbold_text);
+      if (sc->stop_at_error) abort();
+    }
+  return(p);
+}
+
+static s7_pointer titr_pos(s7_scheme *sc, s7_pointer p, const char *func, int32_t line)
+{
+  if (((is_let(iterator_sequence(p))) && (iterator_sequence(p) != sc->rootlet) && (iterator_sequence(p) != sc->s7_starlet)) ||
+      (is_pair(iterator_sequence(p))))
+    {
+      fprintf(stderr, "%s%s[%d]: iterator-position sequence is %s%s\n",
+	      bold_text, func, line, checked_type_name(sc, unchecked_type(iterator_sequence(p))), unbold_text);
+      if (sc->stop_at_error) abort();
+    }
+  return(p);
+}
+#endif
+
+
+/* -------------------------------- iterator? -------------------------------- */
+static s7_pointer g_is_iterator(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_iterator "(iterator? obj) returns #t if obj is an iterator."
+  #define Q_is_iterator sc->pl_bt
+
+  s7_pointer x = car(args);
+  if (is_iterator(x)) return(sc->T);
+  /* closure itself is not an iterator: (let ((c1 (let ((+iterator+ #t) (a 0)) (lambda () (set! a (+ a 1)))))) (iterate c1)): error (a function not an iterator) */
+  check_boolean_method(sc, is_iterator, sc->is_iterator_symbol, args);
+  return(sc->F);
+}
+
+bool s7_is_iterator(s7_pointer obj) {return(is_iterator(obj));}
+
+static bool is_iterator_b_7p(s7_scheme *sc, s7_pointer obj) {return(g_is_iterator(sc, set_plist_1(sc, obj)) != sc->F);}
+
+
+static s7_pointer iterator_copy(s7_scheme *sc, s7_pointer p)
+{
+  /* fields are obj cur [loc|lcur] [len|slow|hcur] next, but untangling them in debugging case is a pain */
+  s7_pointer iter;
+  new_cell(sc, iter, T_ITERATOR | T_SAFE_PROCEDURE);
+  memcpy((void *)iter, (void *)p, sizeof(s7_cell)); /* picks up ITER_OK I hope */
+  return(iter);
+}
+
+static s7_pointer iterator_finished(s7_scheme *sc, s7_pointer iterator) {return(ITERATOR_END);}
+
+static s7_pointer iterator_quit(s7_pointer iterator)
+{
+  iterator_next(iterator) = iterator_finished;
+  clear_iter_ok(iterator);
+  return(ITERATOR_END);
+}
+
+static s7_pointer let_iterate(s7_scheme *sc, s7_pointer iterator)
+{
+  s7_pointer p, slot = iterator_current_slot(iterator);
+  if (!tis_slot(slot))
+    return(iterator_quit(iterator));
+  iterator_set_current_slot(iterator, next_slot(slot));
+  p = iterator_let_cons(iterator);
+  if (!p)
+    return(cons(sc, slot_symbol(slot), slot_value(slot)));
+  set_car(p, slot_symbol(slot));
+  set_cdr(p, slot_value(slot));
+  return(p);
+}
+
+static s7_pointer hash_entry_to_cons(s7_scheme *sc, hash_entry_t *entry, s7_pointer p)
+{
+  if (!p)
+    return(cons(sc, hash_entry_key(entry), hash_entry_value(entry)));
+  set_car(p, hash_entry_key(entry));
+  set_cdr(p, hash_entry_value(entry));
+  return(p);
+}
+
+static s7_pointer hash_table_iterate(s7_scheme *sc, s7_pointer iterator)
+{
+  s7_pointer table;
+  s7_int len;
+  hash_entry_t **elements;
+  hash_entry_t *lst = iterator_hash_current(iterator);
+
+  if (lst)
+    {
+      iterator_hash_current(iterator) = hash_entry_next(lst);
+      return(hash_entry_to_cons(sc, lst, iterator_current(iterator)));
+    }
+  table = iterator_sequence(iterator); /* using iterator_length and hash_table_entries here was slightly slower */
+  len = hash_table_size(table);
+  elements = hash_table_elements(table);
+
+  for (s7_int loc = iterator_position(iterator) + 1; loc < len;  loc++)
+    {
+      hash_entry_t *x = elements[loc];
+      if (x)
+	{
+	  iterator_position(iterator) = loc;
+	  iterator_hash_current(iterator) = hash_entry_next(x);
+	  return(hash_entry_to_cons(sc, x, iterator_current(iterator)));
+	}}
+  if (is_weak_hash_table(table))
+    {
+      clear_weak_hash_iterator(iterator);
+      weak_hash_iters(table)--;
+    }
+  return(iterator_quit(iterator));
+}
+
+static s7_pointer string_iterate(s7_scheme *sc, s7_pointer obj)
+{
+  if (iterator_position(obj) < iterator_length(obj))
+    return(chars[(uint8_t)(string_value(iterator_sequence(obj))[iterator_position(obj)++])]);
+  return(iterator_quit(obj));
+}
+
+static s7_pointer byte_vector_iterate(s7_scheme *sc, s7_pointer obj)
+{
+  if (iterator_position(obj) < iterator_length(obj))
+    return(small_int(byte_vector(iterator_sequence(obj), iterator_position(obj)++)));
+  return(iterator_quit(obj));
+}
+
+static s7_pointer float_vector_iterate(s7_scheme *sc, s7_pointer obj)
+{
+  if (iterator_position(obj) < iterator_length(obj))
+    return(make_real(sc, float_vector(iterator_sequence(obj), iterator_position(obj)++)));
+  return(iterator_quit(obj));
+}
+
+static s7_pointer int_vector_iterate(s7_scheme *sc, s7_pointer obj)
+{
+  if (iterator_position(obj) < iterator_length(obj))
+    return(make_integer(sc, int_vector(iterator_sequence(obj), iterator_position(obj)++)));
+  return(iterator_quit(obj));
+}
+
+static s7_pointer vector_iterate(s7_scheme *sc, s7_pointer obj)
+{
+  if (iterator_position(obj) < iterator_length(obj))
+    return(vector_element(iterator_sequence(obj), iterator_position(obj)++));
+  return(iterator_quit(obj));
+}
+
+static s7_pointer closure_iterate(s7_scheme *sc, s7_pointer obj)
+{
+  /* this can be confusing: below a hash-table is the "function", and a function is the "iterator" only because with-let exports +iterator+=#t -> infinite loop!
+       (with-let
+         (let ((+iterator+ #t))
+           (lambda () #<eof>))    ; this works because a function has an associated let??  with-let first arg should be a let.
+         (for-each
+          (make-hash-table)       ; (hash-table) -- ((hash-table) ()) is #f (not an error)
+             ;(vector 1)          ; error: vector-ref second argument, (), is nil but should be an integer
+             ;(vector)            ; error: for-each first argument #() called with 1 argument?
+             ;(list)              ; for-each first argument, (), is nil but should be a procedure or something applicable
+          (lambda args args)      ; function as iterator because local +iterator+ above is #t, never returns #<eof> (always () because iterator func takes no args)
+             ;(lambda (asd) ())   ; error: make-iterator argument, #<lambda (asd)>, is a function but should be a thunk
+          ))
+   * similarly:
+       (with-let
+         (let ((+documentation+ "hiho")) (curlet))
+         (define (f) 1)                         ; (define (f) "a string" 1) would return doc as "a string"
+         (display (documentation f)) (newline)) ; "hiho" -- should we block +documentation+ in with-let?
+   */
+  s7_pointer result = s7_call(sc, iterator_sequence(obj), sc->nil);
+  /* this can't use s7_apply_function -- we need to catch the error handler's longjmp here */
+  if (result == ITERATOR_END)
+    {
+      iterator_next(obj) = iterator_finished;
+      clear_iter_ok(obj);
+    }
+  return(result);
+}
+
+static s7_pointer c_object_iterate(s7_scheme *sc, s7_pointer obj)
+{
+  s7_pointer result, p, cur;
+  if (iterator_position(obj) >= iterator_length(obj))
+    return(iterator_quit(obj));
+  p = iterator_sequence(obj);
+  cur = iterator_current(obj);
+  set_car(cur, p);
+  set_car(cdr(cur), make_integer(sc, iterator_position(obj))); /* perhaps wrap_integer, c_object_ref->c_object_getter is c_function in scheme? */
+  result = (*(c_object_ref(sc, p)))(sc, cur); /* used to save/restore sc->x|z here */
+  iterator_position(obj)++;
+  if (result == ITERATOR_END)
+    {
+      iterator_next(obj) = iterator_finished;
+      clear_iter_ok(obj);
+    }
+  return(result);
+}
+
+static s7_pointer pair_iterate_1(s7_scheme *sc, s7_pointer obj);
+static s7_pointer pair_iterate(s7_scheme *sc, s7_pointer obj)
+{
+  s7_pointer result;
+  if (!is_pair(iterator_current(obj)))
+    return(iterator_quit(obj));
+  result = car(iterator_current(obj));
+  iterator_current(obj) = cdr(iterator_current(obj));
+  if (iterator_current(obj) == iterator_slow(obj))
+    iterator_current(obj) = sc->nil;
+  iterator_next(obj) = pair_iterate_1;
+  return(result);
+}
+
+static s7_pointer pair_iterate_1(s7_scheme *sc, s7_pointer obj)
+{
+  s7_pointer result;
+  if (!is_pair(iterator_current(obj)))
+    return(iterator_quit(obj));
+  result = car(iterator_current(obj));
+  iterator_current(obj) = cdr(iterator_current(obj));
+  if (iterator_current(obj) == iterator_slow(obj))
+    iterator_current(obj) = sc->nil;
+  else iterator_set_slow(obj, cdr(iterator_slow(obj)));
+  iterator_next(obj) = pair_iterate;
+  return(result);
+}
+
+static s7_pointer find_make_iterator_method(s7_scheme *sc, s7_pointer e, s7_pointer iter)
+{
+  s7_pointer func;
+  if ((has_active_methods(sc, e)) &&
+      ((func = find_method_with_let(sc, e, sc->make_iterator_symbol)) != sc->undefined))
+    {
+      s7_pointer it;
+      gc_protect_via_stack(sc, iter);
+      it = s7_apply_function(sc, func, set_plist_1(sc, e));
+      unstack_gc_protect(sc);
+      if (!is_iterator(it))
+	error_nr(sc, sc->wrong_type_arg_symbol,
+		 set_elist_2(sc, wrap_string(sc, "make-iterator method must return an iterator: ~S", 48), it));
+      return(it);
+    }
+  return(NULL);
+}
+
+
+/* -------------------------------- make-iterator -------------------------------- */
+static s7_pointer funclet_entry(s7_scheme *sc, s7_pointer x, s7_pointer sym)
+{
+  if ((has_closure_let(x)) && (is_let(closure_let(x))) && (closure_let(x) != sc->rootlet))
+    {
+      s7_pointer val = symbol_to_local_slot(sc, sym, closure_let(x));
+      if ((!is_slot(val)) && (let_outlet(closure_let(x)) != sc->rootlet))
+	val = symbol_to_local_slot(sc, sym, let_outlet(closure_let(x)));
+      if (is_slot(val))
+	return(slot_value(val));
+    }
+  return(NULL);
+}
+
+static bool is_iterable_closure(s7_scheme *sc, s7_pointer x)
+{
+  s7_pointer iter;
+  if (!is_thunk(sc, x))
+    sole_arg_wrong_type_error_nr(sc, sc->make_iterator_symbol, x, a_thunk_string);
+  iter = funclet_entry(sc, x, sc->local_iterator_symbol);
+  return((iter) && (iter != sc->F));
+}
+
+static s7_pointer s7_starlet_make_iterator(s7_scheme *sc, s7_pointer iter);
+static s7_int c_object_length_to_int(s7_scheme *sc, s7_pointer obj);
+
+s7_pointer s7_make_iterator(s7_scheme *sc, s7_pointer e)
+{
+  s7_pointer iter, p;
+  new_cell(sc, iter, T_ITERATOR | T_SAFE_PROCEDURE | T_ITER_OK);
+  iterator_sequence(iter) = e;
+
+  if (is_pair(e)) /* by far the most common case */
+    {
+      iterator_current(iter) = e;
+      iterator_next(iter) = pair_iterate;
+      iterator_set_slow(iter, e);
+      return(iter);
+    }
+  if (!is_let(e))
+    iterator_position(iter) = 0;
+
+  switch (type(e))
+    {
+    case T_LET:
+      if (e == sc->rootlet)
+	{
+	  iterator_set_current_slot(iter, sc->rootlet_slots);
+	  iterator_next(iter) = let_iterate;
+	  iterator_let_cons(iter) = NULL;
+	  return(iter);
+	}
+      if (e == sc->s7_starlet)
+	return(s7_starlet_make_iterator(sc, iter));
+      p = find_make_iterator_method(sc, e, iter);
+      if (p) {free_cell(sc, iter); return(p);}
+      iterator_set_current_slot(iter, let_slots(e));
+      iterator_next(iter) = let_iterate;
+      iterator_let_cons(iter) = NULL;
+      break;
+
+    case T_HASH_TABLE:
+      iterator_hash_current(iter) = NULL;
+      iterator_current(iter) = NULL;
+      iterator_position(iter) = -1;
+      iterator_next(iter) = hash_table_iterate;
+      if (is_weak_hash_table(e))
+	{
+	  set_weak_hash_iterator(iter);
+	  weak_hash_iters(e)++;
+	  add_weak_hash_iterator(sc, iter);
+	}
+      break;
+
+    case T_STRING:
+      iterator_length(iter) = string_length(e);
+      iterator_next(iter) = string_iterate;
+      break;
+
+    case T_BYTE_VECTOR:
+      iterator_length(iter) = byte_vector_length(e);
+      iterator_next(iter) = byte_vector_iterate;
+      break;
+
+    case T_VECTOR:
+      iterator_length(iter) = vector_length(e);
+      iterator_next(iter) = vector_iterate;
+      break;
+
+    case T_INT_VECTOR:
+      iterator_length(iter) = vector_length(e);
+      iterator_next(iter) = int_vector_iterate;
+      break;
+
+    case T_FLOAT_VECTOR:
+      iterator_length(iter) = vector_length(e);
+      iterator_next(iter) = float_vector_iterate;
+      break;
+
+    case T_NIL: /* (make-iterator #()) -> #<iterator: vector>, so I guess () should also work */
+      iterator_length(iter) = 0;
+      iterator_next(iter) = iterator_finished;
+      clear_iter_ok(iter);
+      break;
+
+    case T_MACRO:   case T_MACRO_STAR:
+    case T_BACRO:   case T_BACRO_STAR:
+    case T_CLOSURE: case T_CLOSURE_STAR:
+      if (is_iterable_closure(sc, e))
+	{
+	  p = list_1_unchecked(sc, int_zero);
+	  iterator_current(iter) = p;
+	  set_mark_seq(iter);
+	  iterator_next(iter) = closure_iterate;
+	  iterator_length(iter) = (has_active_methods(sc, e)) ? closure_length(sc, e) : S7_INT64_MAX;
+	}
+      else
+	{
+	  free_cell(sc, iter);
+	  sole_arg_wrong_type_error_nr(sc, sc->make_iterator_symbol, e,
+				       wrap_string(sc, "a function or macro with a '+iterator+ local that is not #f", 59));
+	}
+      break;
+
+    case T_C_OBJECT:
+      iterator_length(iter) = c_object_length_to_int(sc, e);
+      p = find_make_iterator_method(sc, e, iter);
+      if (p) {free_cell(sc, iter); return(p);}
+      iterator_current(iter) = list_2_unchecked(sc, e, int_zero); /* if not unchecked, gc protect iter */
+      set_mark_seq(iter);
+      iterator_next(iter) = c_object_iterate;
+      break;
+
+    default:
+      free_cell(sc, iter);  /* 19-Mar-22 */
+      sole_arg_wrong_type_error_nr(sc, sc->make_iterator_symbol, e, a_sequence_string);
+    }
+  return(iter);
+}
+
+static s7_pointer g_make_iterator(s7_scheme *sc, s7_pointer args)
+{
+  #define H_make_iterator "(make-iterator sequence carrier) returns an iterator object that returns the next value \
+in the sequence each time it is called.  When it reaches the end, it returns " ITERATOR_END_NAME "."
+  #define Q_make_iterator s7_make_signature(sc, 3, sc->is_iterator_symbol, sc->is_sequence_symbol, sc->is_pair_symbol)
+
+  /* we need to call s7_make_iterator before fixing up the optional second arg in case let->method */
+  s7_pointer seq = car(args);
+  s7_pointer carrier = (is_pair(cdr(args))) ? cadr(args) : NULL;
+  s7_pointer iter = s7_make_iterator(sc, seq);
+
+  if (carrier)
+    {
+      if (!is_pair(carrier))
+	sole_arg_wrong_type_error_nr(sc, sc->make_iterator_symbol, carrier, sc->type_names[T_PAIR]);
+      if (is_immutable_pair(carrier))
+	immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->make_iterator_symbol, carrier));
+
+      if (is_hash_table(iterator_sequence(iter)))
+	{
+	  iterator_current(iter) = carrier;
+	  set_mark_seq(iter);
+	}
+      else
+	if ((is_let(iterator_sequence(iter))) &&
+	    (iterator_sequence(iter) != sc->rootlet))
+	  {
+	    iterator_let_cons(iter) = carrier;
+	    set_mark_seq(iter);
+	  }}
+  return(iter);
+}
+
+
+/* -------------------------------- iterate -------------------------------- */
+static s7_pointer g_iterate(s7_scheme *sc, s7_pointer args)
+{
+  #define H_iterate "(iterate obj) returns the next element from the iterator obj, or " ITERATOR_END_NAME "."
+  #define Q_iterate s7_make_signature(sc, 2, sc->T, sc->is_iterator_symbol)
+  s7_pointer iter = car(args);
+  if (!is_iterator(iter))
+    return(sole_arg_method_or_bust(sc, iter, sc->iterate_symbol, args, sc->type_names[T_ITERATOR]));
+  return((iterator_next(iter))(sc, iter));
+}
+
+static s7_pointer iterate_p_p(s7_scheme *sc, s7_pointer iter)
+{
+  if (!is_iterator(iter))
+    return(method_or_bust_p(sc, iter, sc->iterate_symbol, sc->type_names[T_ITERATOR]));
+  return((iterator_next(iter))(sc, iter));
+}
+
+s7_pointer s7_iterate(s7_scheme *sc, s7_pointer obj) {return((iterator_next(obj))(sc, obj));}
+
+bool s7_iterator_is_at_end(s7_scheme *sc, s7_pointer obj)
+{
+  if (!is_iterator(obj))
+    sole_arg_wrong_type_error_nr(sc, sc->iterator_is_at_end_symbol, obj, sc->type_names[T_ITERATOR]);
+  return(!iter_ok(obj));
+}
+
+static bool op_implicit_iterate(s7_scheme *sc)
+{
+  s7_pointer s = lookup_checked(sc, car(sc->code));
+  if (!is_iterator(s)) {sc->last_function = s; return(false);}
+  sc->value = (iterator_next(s))(sc, s);
+  return(true);
+}
+
+
+/* -------------------------------- iterator-at-end? -------------------------------- */
+static bool iterator_is_at_end_b_7p(s7_scheme *sc, s7_pointer obj)
+{
+  if (!is_iterator(obj))
+    sole_arg_wrong_type_error_nr(sc, sc->iterator_is_at_end_symbol, obj, sc->type_names[T_ITERATOR]);
+  return(!iter_ok(obj));
+}
+
+static s7_pointer g_iterator_is_at_end(s7_scheme *sc, s7_pointer args)
+{
+  #define H_iterator_is_at_end "(iterator-at-end? iter) returns #t if the iterator has reached the end of its sequence."
+  #define Q_iterator_is_at_end s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_iterator_symbol)
+  s7_pointer iter = car(args);
+  if (!is_iterator(iter))
+    return(sole_arg_method_or_bust(sc, iter, sc->iterator_is_at_end_symbol, args, sc->type_names[T_ITERATOR]));
+  return(make_boolean(sc, !iter_ok(iter)));
+}
+
+
+/* -------------------------------- iterator-sequence -------------------------------- */
+static s7_pointer g_iterator_sequence(s7_scheme *sc, s7_pointer args)
+{
+  #define H_iterator_sequence "(iterator-sequence iterator) returns the sequence that iterator is traversing."
+  #define Q_iterator_sequence s7_make_signature(sc, 2, sc->is_sequence_symbol, sc->is_iterator_symbol)
+  s7_pointer iter = car(args);
+  if (!is_iterator(iter))
+    return(sole_arg_method_or_bust(sc, iter, sc->iterator_sequence_symbol, args, sc->type_names[T_ITERATOR]));
+  return(iterator_sequence(iter));
+}
+
+/* iterator-length and iterator-position run up against the function iterator */
+
+
+/* -------- cycles -------- */
+
+#define INITIAL_SHARED_INFO_SIZE 8
+
+static int32_t shared_ref(shared_info_t *ci, const s7_pointer p)
+{
+  /* from print after collecting refs, not called by equality check, only called in object_to_port_with_circle_check_1 */
+  s7_pointer *objs = ci->objs;
+  for (int32_t i = 0; i < ci->top; i++)
+    if (objs[i] == p)
+      {
+	int32_t val = ci->refs[i];
+	if (val > 0)
+	  ci->refs[i] = -ci->refs[i];
+	return(val);
+      }
+  return(0);
+}
+
+static void flip_ref(shared_info_t *ci, const s7_pointer p)
+{
+  s7_pointer *objs = ci->objs;
+  for (int32_t i = 0; i < ci->top; i++)
+    if (objs[i] == p)
+      {
+	ci->refs[i] = -ci->refs[i];
+	break;
+      }
+}
+
+static int32_t peek_shared_ref_1(shared_info_t *ci, const s7_pointer p)
+{
+  /* returns 0 if not found, otherwise the ref value for p */
+  s7_pointer *objs = ci->objs;
+  for (int32_t i = 0; i < ci->top; i++)
+    if (objs[i] == p)
+      return(ci->refs[i]);
+  return(0);
+}
+
+static int32_t peek_shared_ref(shared_info_t *ci, s7_pointer p)
+{
+  /* returns 0 if not found, otherwise the ref value for p */
+  return((is_collected_unchecked(p)) ? peek_shared_ref_1(ci, p) : 0);
+}
+
+static void enlarge_shared_info(shared_info_t *ci)
+{
+  ci->size *= 2;
+  ci->size2 = ci->size - 2;
+  ci->objs = (s7_pointer *)Realloc(ci->objs, ci->size * sizeof(s7_pointer));
+  ci->refs = (int32_t *)Realloc(ci->refs, ci->size * sizeof(int32_t));
+  ci->defined = (bool *)Realloc(ci->defined, ci->size * sizeof(bool));
+  /* this clearing is needed, memclr is not faster */
+  for (int32_t i = ci->top; i < ci->size; i++)
+    {
+      ci->refs[i] = 0;
+      ci->objs[i] = NULL;
+    }
+}
+
+static bool check_collected(s7_pointer top, shared_info_t *ci)
+{
+  s7_pointer *objs_end = (s7_pointer *)(ci->objs + ci->top);
+  for (s7_pointer *p = ci->objs; p < objs_end; p++)
+    if ((*p) == top)
+      {
+	int32_t i = (int32_t)(p - ci->objs);
+	if (ci->refs[i] == 0)
+	  {
+	    ci->has_hits = true;
+	    ci->refs[i] = ++ci->ref;  /* if found, set the ref number */
+	  }
+	break;
+      }
+  set_cyclic(top);
+  return(true);
+}
+
+static bool collect_shared_info(s7_scheme *sc, shared_info_t *ci, s7_pointer top, bool stop_at_print_length);
+static bool hash_keys_not_cyclic(s7_scheme *sc, s7_pointer hash);
+
+static bool collect_vector_info(s7_scheme *sc, shared_info_t *ci, s7_pointer top, bool stop_at_print_length)
+{
+  s7_int plen;
+  bool cyclic = false;
+
+  if (stop_at_print_length)
+    {
+      plen = sc->print_length;
+      if (plen > vector_length(top))
+	plen = vector_length(top);
+    }
+  else plen = vector_length(top);
+
+  for (s7_int i = 0; i < plen; i++)
+    {
+      s7_pointer vel = unchecked_vector_element(top, i);   /* "unchecked" because top might be rootlet, I think */
+      if ((has_structure(vel)) &&
+	  (collect_shared_info(sc, ci, vel, stop_at_print_length)))
+	{
+	  set_cyclic(vel);
+	  cyclic = true;
+	  if ((is_c_pointer(vel)) ||
+	      (is_iterator(vel)) ||
+	      (is_c_object(vel)))
+	    check_collected(top, ci);
+	}}
+  if (cyclic) set_cyclic(top);
+  return(cyclic);
+}
+
+static bool collect_shared_info(s7_scheme *sc, shared_info_t *ci, s7_pointer top, bool stop_at_print_length)
+{
+  /* look for top in current list.
+   * As we collect objects (guaranteed to have structure) we set the collected bit.  If we ever
+   *   encounter an object with that bit on, we've seen it before so we have a possible cycle.
+   *   Once the collection pass is done, we run through our list, and clear all these bits.
+   */
+  bool top_cyclic;
+
+  if (is_collected_or_shared(top))
+    return((!is_shared(top)) && (check_collected(top, ci)));
+
+  /* top not seen before -- add it to the list */
+  set_collected(top);
+
+  if (ci->top == ci->size)
+    enlarge_shared_info(ci);
+  ci->objs[ci->top++] = top;
+
+  top_cyclic = false;
+  /* now search the rest of this structure */
+  if (is_pair(top))
+    {
+      s7_pointer p;
+      if ((has_structure(car(top))) &&
+	  (collect_shared_info(sc, ci, car(top), stop_at_print_length)))
+	top_cyclic = true;
+
+      for (p = cdr(top); is_pair(p); p = cdr(p))
+	{
+	  if (is_collected_or_shared(p))
+	    {
+	      set_cyclic(top);
+	      set_cyclic(p);
+	      if (!is_shared(p))
+		return(check_collected(p, ci));
+	      if (!top_cyclic)
+		for (s7_pointer cp = top; cp != p; cp = cdr(cp)) set_shared(cp);
+	      return(top_cyclic);
+	    }
+ 	  set_collected(p);
+	  if (ci->top == ci->size)
+	    enlarge_shared_info(ci);
+	  ci->objs[ci->top++] = p;
+	  if ((has_structure(car(p))) &&
+	      (collect_shared_info(sc, ci, car(p), stop_at_print_length)))
+	    top_cyclic = true;
+	}
+      if ((has_structure(p)) &&
+	  (collect_shared_info(sc, ci, p, stop_at_print_length)))
+	{
+	  set_cyclic(top);
+	  return(true);
+	}
+      if (!top_cyclic)
+	for (s7_pointer cp = top; is_pair(cp); cp = cdr(cp)) set_shared(cp);
+      else set_cyclic(top);
+      return(top_cyclic);
+    }
+
+  switch (type(top))
+    {
+    case T_VECTOR:
+      if (collect_vector_info(sc, ci, top, stop_at_print_length))
+	top_cyclic = true;
+      break;
+
+    case T_ITERATOR:
+      if ((is_sequence(iterator_sequence(top))) && /* might be a function with +iterator+ local */
+	  (collect_shared_info(sc, ci, iterator_sequence(top), stop_at_print_length)))
+	{
+	  if (peek_shared_ref(ci, iterator_sequence(top)) == 0)
+	    check_collected(iterator_sequence(top), ci);
+	  top_cyclic = true;
+	}
+      break;
+
+    case T_HASH_TABLE:
+      if (hash_table_entries(top) > 0)
+	{
+	  s7_int len = hash_table_size(top);
+	  hash_entry_t **entries = hash_table_elements(top);
+	  bool keys_safe = hash_keys_not_cyclic(sc, top);
+	  for (s7_int i = 0; i < len; i++)
+	    for (hash_entry_t *p = entries[i]; p; p = hash_entry_next(p))
+	      {
+		if ((!keys_safe) &&
+		    (has_structure(hash_entry_key(p))) &&
+		    (collect_shared_info(sc, ci, hash_entry_key(p), stop_at_print_length)))
+		  top_cyclic = true;
+		if ((has_structure(hash_entry_value(p))) &&
+		    (collect_shared_info(sc, ci, hash_entry_value(p), stop_at_print_length)))
+		  {
+		    if ((is_c_pointer(hash_entry_value(p))) ||
+			(is_iterator(hash_entry_value(p))) ||
+			(is_c_object(hash_entry_value(p))))
+		      check_collected(top, ci);
+		    top_cyclic = true;
+		  }}}
+      break;
+
+    case T_SLOT: /* this can be hit if we somehow collect_shared_info on sc->rootlet via collect_vector_info (see the let case below) */
+      if ((has_structure(slot_value(top))) &&
+	  (collect_shared_info(sc, ci, slot_value(top), stop_at_print_length)))
+	top_cyclic = true;
+      break;
+
+    case T_LET:
+      if (top == sc->rootlet)
+	{
+	  if (collect_vector_info(sc, ci, top, stop_at_print_length))
+	    top_cyclic = true;
+	}
+      else
+	for (s7_pointer q = top; q; q = let_outlet(q))
+	  for (s7_pointer p = let_slots(q); tis_slot(p); p = next_slot(p))
+	    if ((has_structure(slot_value(p))) &&
+		(collect_shared_info(sc, ci, slot_value(p), stop_at_print_length)))
+	      {
+		top_cyclic = true;
+		if ((is_c_pointer(slot_value(p))) ||
+		    (is_iterator(slot_value(p))) ||
+		    (is_c_object(slot_value(p))))
+		  check_collected(top, ci);
+	      }
+      break;
+
+    case T_CLOSURE:
+    case T_CLOSURE_STAR:
+      if (collect_shared_info(sc, ci, closure_body(top), stop_at_print_length))
+	{
+	  if (peek_shared_ref(ci, top) == 0)
+	    check_collected(top, ci);
+	  top_cyclic = true;
+	}
+      break;
+
+    case T_C_POINTER:
+      if ((has_structure(c_pointer_type(top))) &&
+	  (collect_shared_info(sc, ci, c_pointer_type(top), stop_at_print_length)))
+	{
+	  if (peek_shared_ref(ci, c_pointer_type(top)) == 0)
+	    check_collected(c_pointer_type(top), ci);
+	  top_cyclic = true;
+	}
+      if ((has_structure(c_pointer_info(top))) &&
+	  (collect_shared_info(sc, ci, c_pointer_info(top), stop_at_print_length)))
+	{
+	  if (peek_shared_ref(ci, c_pointer_info(top)) == 0)
+	    check_collected(c_pointer_info(top), ci);
+	  top_cyclic = true;
+	}
+      break;
+
+    case T_C_OBJECT:
+      if ((c_object_to_list(sc, top)) &&
+	  (c_object_set(sc, top)) &&
+	  (collect_shared_info(sc, ci, (*(c_object_to_list(sc, top)))(sc, set_plist_1(sc, top)), stop_at_print_length)))
+	{
+	  if (peek_shared_ref(ci, top) == 0)
+	    check_collected(top, ci);
+	  top_cyclic = true;
+	}
+      break;
+    }
+  if (!top_cyclic)
+    set_shared(top);
+  else set_cyclic(top);
+  return(top_cyclic);
+}
+
+static shared_info_t *make_shared_info(s7_scheme *sc)
+{
+  shared_info_t *ci = (shared_info_t *)Calloc(1, sizeof(shared_info_t));
+  ci->size = INITIAL_SHARED_INFO_SIZE;
+  ci->size2 = ci->size - 2;
+  ci->objs = (s7_pointer *)Malloc(ci->size * sizeof(s7_pointer));
+  ci->refs = (int32_t *)Calloc(ci->size, sizeof(int32_t));   /* finder expects 0 = unseen previously */
+  ci->defined = (bool *)Calloc(ci->size, sizeof(bool));
+  ci->cycle_port = sc->F;
+  ci->init_port = sc->F;
+  return(ci);
+}
+
+static void free_shared_info(shared_info_t *ci)
+{
+  if (ci)
+    {
+      free(ci->objs);
+      free(ci->refs);
+      free(ci->defined);
+      free(ci);
+    }
+}
+
+static inline shared_info_t *clear_shared_info(shared_info_t *ci)
+{
+  if (ci->top > 0)
+    {
+      memclr((void *)(ci->refs), ci->top * sizeof(int32_t));
+      memclr((void *)(ci->defined), ci->top * sizeof(bool));
+      for (int32_t i = 0; i < ci->top; i++)
+	clear_cyclic_bits(ci->objs[i]); /* LOOP_4 is not faster */
+      ci->top = 0;
+    }
+  ci->ref = 0;
+  ci->has_hits = false;
+  ci->ctr = 0;
+  return(ci);
+}
+
+static shared_info_t *load_shared_info(s7_scheme *sc, s7_pointer top, bool stop_at_print_length, shared_info_t *ci)
+{
+  /* for the printer, here only if is_structure(top) and top is not sc->rootlet */
+  bool no_problem = true;
+  s7_int k, stop_len;
+
+  /* check for simple cases first */
+  if (is_pair(top))
+    {
+      s7_pointer x = top;
+      if (stop_at_print_length)
+	{
+	  s7_pointer slow = top;
+	  stop_len = sc->print_length;
+	  for (k = 0; k < stop_len; k += 2)
+	    {
+	      if (!is_pair(x)) break;
+	      if (has_structure(car(x))) {no_problem = false; break;}
+	      x = cdr(x);
+	      if (!is_pair(x)) break;
+	      if (has_structure(car(x))) {no_problem = false; break;}
+	      x = cdr(x);
+	      slow = cdr(slow);
+	      if (x == slow) {no_problem = false; break;}
+	    }}
+      else
+	if (s7_list_length(sc, top) == 0) /* it is circular at the top level (following cdr) */
+	  no_problem = false;
+	else
+	  for (; is_pair(x); x = cdr(x))
+	    if (has_structure(car(x))) {no_problem = false; break;} /* perhaps (and (length > 0)) or vector typer etc */
+      if ((no_problem) &&
+	  (!is_null(x)) && (has_structure(x)))
+	no_problem = false;
+      if (no_problem) return(NULL);
+    }
+  else
+    if (is_t_vector(top)) /* any other vector can't happen */
+      {
+	stop_len = vector_length(top);
+	if ((stop_at_print_length) &&
+	    (stop_len > sc->print_length))
+	  stop_len = sc->print_length;
+	for (k = 0; k < stop_len; k++)
+	  if (has_structure(vector_element(top, k))) {no_problem = false; break;}
+	if (no_problem) return(NULL);
+      }
+
+  else /* added these 19-Oct-22 -- helps in tgc, but not much elsewhere */
+    if ((is_let(top)) && (top != sc->rootlet))
+      {
+	for (s7_pointer lp = top; (no_problem) && (lp); lp = let_outlet(lp))
+	  for (s7_pointer p = let_slots(lp); tis_slot(p); p = next_slot(p))
+	    if (has_structure(slot_value(p))) /* slot_symbol need not be checked? */
+	      {no_problem = false; break;}
+	if (no_problem) return(NULL);
+      }
+    else
+      if (is_hash_table(top))
+	{
+	  s7_int len = hash_table_size(top);
+	  hash_entry_t **entries = hash_table_elements(top);
+	  bool keys_safe = hash_keys_not_cyclic(sc, top);
+	  if (hash_table_entries(top) == 0) return(NULL);
+	  for (s7_int i = 0; i < len; i++)
+	    for (hash_entry_t *p = entries[i]; p; p = hash_entry_next(p))
+	      if (((!keys_safe) && (has_structure(hash_entry_key(p)))) || (has_structure(hash_entry_value(p))))
+		{no_problem = false; break;}
+	  if (no_problem) return(NULL);
+	}
+
+  if ((S7_DEBUGGING) && (is_any_vector(top)) && (!is_t_vector(top))) fprintf(stderr, "%s[%d]: got abnormal vector\n", __func__, __LINE__);
+  clear_shared_info(ci);
+  {
+    /* collect all pointers associated with top */
+    bool cyclic = collect_shared_info(sc, ci, top, stop_at_print_length);
+    s7_pointer *ci_objs = ci->objs;
+    int32_t *ci_refs = ci->refs;
+    int32_t refs = 0;
+
+    for (int32_t i = 0; i < ci->top; i++)
+      clear_collected_and_shared(ci_objs[i]);
+
+    if (!cyclic)
+      return(NULL);
+    if (!(ci->has_hits))
+      return(NULL);
+
+    /* find if any were referenced twice (once for just being there, so twice=shared)
+     *   we know there's at least one such reference because has_hits is true.
+     */
+    for (int32_t i = 0; i < ci->top; i++)
+      if (ci_refs[i] > 0)
+	{
+	  set_collected(ci_objs[i]);
+	  if (i == refs)
+	    refs++;
+	  else
+	    {
+	      ci_objs[refs] = ci_objs[i];
+	      ci_refs[refs++] = ci_refs[i];
+	      ci_refs[i] = 0;
+	      ci_objs[i] = NULL;
+	    }}
+    ci->top = refs;
+    return(ci);
+  }
+}
+
+
+/* -------------------------------- cyclic-sequences -------------------------------- */
+static s7_pointer cyclic_sequences_p_p(s7_scheme *sc, s7_pointer obj)
+{
+  if (has_structure(obj))
+    {
+      shared_info_t *ci = (sc->object_out_locked) ? sc->circle_info : load_shared_info(sc, obj, false, sc->circle_info); /* false=don't stop at print length (vectors etc) */
+      if (ci)
+	{
+	  s7_pointer lst;
+	  sc->w = sc->nil;
+	  check_free_heap_size(sc, ci->top);
+	  for (int32_t i = 0; i < ci->top; i++)
+	    sc->w = cons_unchecked(sc, ci->objs[i], sc->w);
+	  lst = sc->w;
+	  sc->w = sc->unused;
+	  return(lst);
+	}}
+  return(sc->nil);
+}
+
+static s7_pointer g_cyclic_sequences(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cyclic_sequences "(cyclic-sequences obj) returns a list of elements that are cyclic."
+  #define Q_cyclic_sequences s7_make_signature(sc, 2, sc->is_proper_list_symbol, sc->T)
+  return(cyclic_sequences_p_p(sc, car(args)));
+}
+
+
+/* -------------------------------- object->port (display format etc) -------------------------------- */
+static int32_t circular_list_entries(s7_pointer lst)
+{
+  int32_t i = 1;
+  for (s7_pointer x = cdr(lst); ; i++, x = cdr(x))
+    {
+      int32_t j = 0;
+      for (s7_pointer y = lst; j < i; y = cdr(y), j++)
+	if (x == y)
+	  return(i);
+    }
+}
+
+static void object_to_port_with_circle_check_1(s7_scheme *sc, s7_pointer vr, s7_pointer port, use_write_t use_write, shared_info_t *ci);
+#define object_to_port_with_circle_check(Sc, Vr, Port, Use_Write, Ci) \
+  do {								      \
+    s7_pointer _V_ = Vr;						\
+    if ((Ci) && (has_structure(_V_)))					\
+      object_to_port_with_circle_check_1(Sc, _V_, Port, Use_Write, Ci); \
+    else object_to_port(Sc, _V_, Port, Use_Write, Ci);			\
+  } while (0)
+
+static void (*display_functions[256])(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info_t *ci);
+#define object_to_port(Sc, Obj, Port, Use_Write, Ci) (*display_functions[unchecked_type(Obj)])(Sc, Obj, Port, Use_Write, Ci)
+
+static bool string_needs_slashification(const uint8_t *str, s7_int len)
+{
+  /* we have to go by len (str len) not *s==0 because s7 strings can have embedded nulls */
+  const uint8_t *pend = (const uint8_t *)(str + len);
+  for (const uint8_t *p = str; p < pend; p++)
+    if (slashify_table[*p])
+      return(true);
+  return(false);
+}
+
+#define IN_QUOTES true
+#define NOT_IN_QUOTES false
+
+static void slashify_string_to_port(s7_scheme *sc, s7_pointer port, const char *p, s7_int len, bool quoted)
+{
+  const uint8_t *pcur, *pend, *pstart = NULL;
+  if (len == 0)
+    {
+      if (quoted)
+	port_write_string(port)(sc, "\"\"", 2, port);
+      return;
+    }
+  pend = (const uint8_t *)(p + len);
+
+  /* what about the trailing nulls? Guile writes them out (as does s7 currently)
+   *    but that is not ideal.  I'd like to use ~S for error messages, so that
+   *    strings are clearly identified via the double-quotes, but this way of
+   *    writing them is ugly:
+   *      (let ((str (make-string 8 #\null))) (set! (str 0) #\a) str) -> "a\x00\x00\x00\x00\x00\x00\x00"
+   *    but it would be misleading to omit them because:
+   *      (let ((str (make-string 8 #\null))) (set! (str 0) #\a) (string-append str "bc")) -> "a\x00\x00\x00\x00\x00\x00\x00bc"
+   * also it is problematic to use sc->print_length here (rather than a separate string-print-length) because
+   *    it is normally (say) 12 which truncates just about every string.  In CL, *print-length*
+   *    does not affect strings, symbols, or bit-vectors.  But if the string is enormous,
+   *    this function can bring us to a complete halt.  string-print-length (as a *s7* field) is
+   *    also problematic -- it does not behave as expected in many cases if it is limited to this
+   *    function and string_to_port below, and if set too low, disables the repl.
+   */
+  if (quoted) port_write_character(port)(sc, '"', port);
+  for (pcur = (const uint8_t *)p; pcur < pend; pcur++)
+    if (slashify_table[*pcur])
+      {
+	if (pstart) pstart++; else pstart = (const uint8_t *)p;
+	if (pstart != pcur)
+	  {
+	    port_write_string(port)(sc, (const char *)pstart, pcur - pstart, port);
+	    pstart = pcur;
+	  }
+	port_write_character(port)(sc, '\\', port);
+	switch (*pcur)
+	  {
+	  case '"':   port_write_character(port)(sc, '"', port);   break;
+	  case '\\':  port_write_character(port)(sc, '\\', port);  break;
+	  case '\'':  port_write_character(port)(sc, '\'', port);  break;
+	  case '\t':  port_write_character(port)(sc, 't', port);   break;
+	  case '\r':  port_write_character(port)(sc, 'r', port);   break;
+	  case '\b':  port_write_character(port)(sc, 'b', port);   break;
+	  case '\f':  port_write_character(port)(sc, 'f', port);   break;
+	  case '\?':  port_write_character(port)(sc, '?', port);   break;
+	  case 'x':   port_write_character(port)(sc, 'x', port);   break;
+	  default:
+	    {
+	      char buf[5];
+	      s7_int n = (s7_int)(*pcur);
+	      buf[0] = 'x';
+	      buf[1] = (n < 16) ? '0' : dignum[(n / 16) % 16];
+	      buf[2] = dignum[n % 16];
+	      buf[3] = ';';
+	      buf[4] = '\0';
+	      port_write_string(port)(sc, buf, 4, port);
+	    }
+	    break;
+	  }}
+  if (!pstart)
+    port_write_string(port)(sc, (const char *)p, len, port);
+  else
+    {
+      pstart++;
+      if (pstart != pcur)
+	port_write_string(port)(sc, (const char *)pstart, pcur - pstart, port);
+    }
+  if (quoted) port_write_character(port)(sc, '"', port);
+}
+
+static void output_port_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info_t *unused_ci)
+{
+  if ((obj == sc->standard_output) ||
+      (obj == sc->standard_error))
+    port_write_string(port)(sc, port_filename(obj), port_filename_length(obj), port);
+  else
+    if (use_write == P_READABLE)
+      {
+	if (port_is_closed(obj))
+	  port_write_string(port)(sc, "(let ((p (open-output-string))) (close-output-port p) p)", 56, port);
+	else
+	  if (is_string_port(obj))
+	    {
+	      port_write_string(port)(sc, "(let ((p (open-output-string)))", 31, port);
+	      if (port_position(obj) > 0)
+		{
+		  port_write_string(port)(sc, " (display ", 10, port);
+		  slashify_string_to_port(sc, port, (const char *)port_data(obj), port_position(obj), IN_QUOTES);
+		  port_write_string(port)(sc, " p)", 3, port);
+		}
+	      port_write_string(port)(sc, " p)", 3, port);
+	    }
+	  else
+	    if (is_file_port(obj))
+	      {
+		char str[256];
+		int32_t nlen;
+		str[0] = '\0';
+		nlen = (int32_t)catstrs(str, 256, "(open-output-file \"", port_filename(obj), "\" \"a\")", (char *)NULL);
+		port_write_string(port)(sc, str, nlen, port);
+	      }
+	    else port_write_string(port)(sc, "#<output-function-port>", 23, port);
+      }
+    else
+      {
+	if (is_string_port(obj))
+	  port_write_string(port)(sc, "#<output-string-port", 20, port);
+	else
+	  if (is_file_port(obj))
+	    port_write_string(port)(sc, "#<output-file-port", 18, port);
+	  else port_write_string(port)(sc, "#<output-function-port", 22, port);
+	if (port_is_closed(obj))
+	  port_write_string(port)(sc, ":closed>", 8, port);
+	else port_write_character(port)(sc, '>', port);
+      }
+}
+
+static void input_port_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info_t *unused_ci)
+{
+  if (obj == sc->standard_input)
+    port_write_string(port)(sc, port_filename(obj), port_filename_length(obj), port);
+  else
+    if (use_write == P_READABLE)
+      {
+	if (port_is_closed(obj))
+	  port_write_string(port)(sc, "(call-with-input-string \"\" (lambda (p) p))", 42, port);
+	else
+	  if (is_function_port(obj))
+	    port_write_string(port)(sc, "#<input-function-port>", 22, port);
+	  else
+	    if (is_file_port(obj))
+	      {
+		char str[256];
+		int32_t nlen;
+		str[0] = '\0';
+		nlen = (int32_t)catstrs(str, 256, "(open-input-file \"", port_filename(obj), "\")", (char *)NULL);
+		port_write_string(port)(sc, str, nlen, port);
+	      }
+	    else
+	      {
+		s7_int data_len = port_data_size(obj) - port_position(obj);
+		if (data_len > 100)
+		  {
+		    const char *filename = (const char *)s7_port_filename(sc, obj);
+		    if (filename)
+		      {
+                        #define DO_STR_LEN 1024
+			char do_str[DO_STR_LEN];
+			int32_t len;
+			do_str[0] = '\0';
+			if (port_position(obj) > 0)
+			  {
+			    len = (int32_t)catstrs(do_str, DO_STR_LEN, "(let ((port (open-input-file \"", filename, "\")))", (char *)NULL);
+			    port_write_string(port)(sc, do_str, len, port);
+			    do_str[0] = '\0';
+			    len = (int32_t)catstrs(do_str, DO_STR_LEN, " (do ((i 0 (+ i 1)) (c (read-char port) (read-char port))) ((= i ",
+						   pos_int_to_str_direct(sc, port_position(obj) - 1),
+						   ") port)))", (char *)NULL);
+			  }
+			else len = (int32_t)catstrs(do_str, DO_STR_LEN, "(open-input-file \"", filename, "\")", (char *)NULL);
+			port_write_string(port)(sc, do_str, len, port);
+			return;
+		      }}
+		port_write_string(port)(sc, "(open-input-string ", 19, port);
+		/* not port_write_string here because there might be embedded double-quotes */
+		slashify_string_to_port(sc, port, (const char *)(port_data(obj) + port_position(obj)), port_data_size(obj) - port_position(obj), IN_QUOTES);
+		port_write_character(port)(sc, ')', port);
+	      }}
+    else
+      {
+	if (is_string_port(obj))
+	  port_write_string(port)(sc, "#<input-string-port", 19, port);
+	else
+	  if (is_file_port(obj))
+	    port_write_string(port)(sc, "#<input-file-port", 17, port);
+	  else port_write_string(port)(sc, "#<input-function-port", 21, port);
+	if (port_filename(obj))
+	  {
+	    port_write_character(port)(sc, ' ', port);
+	    port_write_string(port)(sc, port_filename(obj), port_filename_length(obj), port);
+	  }
+	if (port_is_closed(obj))
+	  port_write_string(port)(sc, " :closed>", 9, port);
+	else port_write_character(port)(sc, '>', port);
+      }
+}
+
+static bool symbol_needs_slashification(s7_scheme *sc, s7_pointer obj)
+{
+  uint8_t *pend;
+  char *str = symbol_name(obj);
+  s7_int len;
+
+  if ((str[0] == '#') || (str[0] == '\'') || (str[0] == ','))
+    return(true);
+  if (is_number(make_atom(sc, str, 10, NO_SYMBOLS, WITHOUT_OVERFLOW_ERROR)))
+    return(true);
+
+  len = symbol_name_length(obj);
+  pend = (uint8_t *)(str + len);
+  for (uint8_t *p = (uint8_t *)str; p < pend; p++)
+    if (symbol_slashify_table[*p])
+      return(true);
+  set_clean_symbol(obj);
+  return(false);
+}
+
+static /* inline */ void symbol_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info_t *unused_ci)
+{
+  /* I think this is the only place we print a symbol's name */
+  if ((!is_clean_symbol(obj)) &&
+      (symbol_needs_slashification(sc, obj)))
+    {
+      /* this can't work in general if use_write == P_READABLE:
+       *    (define f (apply lambda (list () (list 'let (list (list (symbol "a b") 3)) (symbol "a b"))))) ; (f) -> 3
+       *  prints "readably" as "(lambda () (let (((symbol \"a b\") 3)) (symbol \"a b\")))"
+       *  so, 30-May-24 added (*s7* 'symbol-printer).
+       */
+      if (is_any_procedure(sc->symbol_printer)) /* we see P_WRITE here */
+	{
+	  s7_pointer res = s7_call(sc, sc->symbol_printer, set_plist_1(sc, obj)); /* res should be a string */
+	  if (!is_string(res))
+	    error_nr(sc, sc->wrong_type_arg_symbol,
+		     set_elist_2(sc, wrap_string(sc, "(*s7* 'symbol-printer) should return a string: ~S", 49), res));
+	  port_write_string(port)(sc, string_value(res), string_length(res), port);
+	}
+      else
+	{
+	  port_write_string(port)(sc, "(symbol \"", 9, port);
+	  slashify_string_to_port(sc, port, symbol_name(obj), symbol_name_length(obj), NOT_IN_QUOTES);
+	  port_write_string(port)(sc, "\")", 2, port);
+	}}
+  else
+    {
+      char c = '\0';
+      if ((use_write == P_READABLE) || (use_write == P_CODE))
+	{
+	  if (!is_keyword(obj)) c = '\'';
+	}
+      else if ((use_write == P_KEY) && (!is_keyword(obj))) c = ':';
+      if (is_string_port(port))
+	{
+	  s7_int new_len = port_position(port) + symbol_name_length(obj) + ((c) ? 1 : 0);
+	  if (new_len >= port_data_size(port))
+	    resize_port_data(sc, port, new_len * 2);
+	  if (c) port_data(port)[port_position(port)++] = c;
+	  memcpy((void *)(port_data(port) + port_position(port)), (void *)symbol_name(obj), symbol_name_length(obj));
+	  port_position(port) = new_len;
+	}
+      else
+	{
+	  if (c) port_write_character(port)(sc, c, port);
+	  port_write_string(port)(sc, symbol_name(obj), symbol_name_length(obj), port);
+	}}
+}
+
+static char *multivector_indices_to_string(s7_scheme *sc, s7_int index, s7_pointer vect, char *str, int32_t str_len, int32_t cur_dim)
+{
+  s7_int size = vector_dimension(vect, cur_dim);
+  s7_int ind = index % size;
+  if (cur_dim > 0)
+    multivector_indices_to_string(sc, (index - ind) / size, vect, str, str_len, cur_dim - 1);
+  catstrs(str, str_len, " ", pos_int_to_str_direct(sc, ind), (char *)NULL);
+  return(str);
+}
+
+#define not_p_display(Choice) ((Choice == P_DISPLAY) ? P_WRITE : Choice)
+
+static int32_t multivector_to_port_1(s7_scheme *sc, s7_pointer vec, s7_pointer port,
+				     int32_t out_len, int32_t flat_ref, int32_t dimension, int32_t dimensions, bool *last,
+				     use_write_t use_write, shared_info_t *ci)
+{
+  if (use_write != P_READABLE)
+    {
+      if (*last)
+	port_write_string(port)(sc, " (", 2, port);
+      else port_write_character(port)(sc, '(', port);
+      (*last) = false;
+    }
+  for (int32_t i = 0; i < vector_dimension(vec, dimension); i++)
+    if (dimension == (dimensions - 1))
+      {
+	if (flat_ref < out_len)
+	  {
+	    object_to_port_with_circle_check(sc, vector_getter(vec)(sc, vec, flat_ref), port, not_p_display(use_write), ci);
+
+	    if (use_write == P_READABLE)
+	      port_write_string(port)(sc, ") ", 2, port);
+	    flat_ref++;
+	  }
+	else
+	  {
+	    port_write_string(port)(sc, "...)", 4, port);
+	    return(flat_ref);
+	  }
+	if ((use_write != P_READABLE) &&
+	    (i < (vector_dimension(vec, dimension) - 1)))
+	  port_write_character(port)(sc, ' ', port);
+      }
+    else
+      if (flat_ref < out_len)
+	flat_ref = multivector_to_port_1(sc, vec, port, out_len, flat_ref, dimension + 1, dimensions, last, not_p_display(use_write), ci);
+      else
+	{
+	  port_write_string(port)(sc, "...)", 4, port);
+	  return(flat_ref);
+	}
+  if (use_write != P_READABLE)
+    port_write_character(port)(sc, ')', port);
+  (*last) = true;
+  return(flat_ref);
+}
+
+static int32_t multivector_to_port(s7_scheme *sc, s7_pointer vec, s7_pointer port,
+				   int32_t out_len, int32_t flat_ref, int32_t dimension, int32_t dimensions,
+				   use_write_t use_write, shared_info_t *ci)
+{
+  bool last = false;
+  return(multivector_to_port_1(sc, vec, port, out_len, flat_ref, dimension, dimensions, &last, use_write, ci));
+}
+
+static void make_vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port)
+{
+  s7_int vlen;
+  int32_t plen;
+  char buf[128];
+  const char* vtyp = "";
+
+  if (is_float_vector(vect))
+    vtyp = "float-";
+  else
+    if (is_int_vector(vect))
+      vtyp = "int-";
+    else
+      if (is_byte_vector(vect))
+	vtyp = "byte-";
+  vlen = vector_length(vect);
+
+  if (vector_rank(vect) == 1)
+    {
+      plen = (int32_t)catstrs_direct(buf, "(make-", vtyp, "vector ", integer_to_string_no_length(sc, vlen), " ", (const char *)NULL);
+      port_write_string(port)(sc, buf, plen, port);
+    }
+  else
+    {
+      s7_int dim;
+      plen = (int32_t)catstrs_direct(buf, "(make-", vtyp, "vector '(", (const char *)NULL);
+      port_write_string(port)(sc, buf, plen, port);
+      for (dim = 0; dim < vector_ndims(vect) - 1; dim++)
+	{
+	  plen = (int32_t)catstrs_direct(buf, integer_to_string_no_length(sc, vector_dimension(vect, dim)), " ", (const char *)NULL);
+	  port_write_string(port)(sc, buf, plen, port);
+	}
+      plen = (int32_t)catstrs_direct(buf, integer_to_string_no_length(sc, vector_dimension(vect, dim)), ") ", (const char *)NULL);
+      port_write_string(port)(sc, buf, plen, port);
+    }
+}
+
+static void write_vector_dimensions(s7_scheme *sc, s7_pointer vect, s7_pointer port)
+{
+  char buf[128];
+  s7_int dim, plen;
+  port_write_string(port)(sc, " '(", 3, port);
+  for (dim = 0; dim < vector_ndims(vect) - 1; dim++)
+    {
+      plen = catstrs_direct(buf, integer_to_string_no_length(sc, vector_dimension(vect, dim)), " ", (const char *)NULL);
+      port_write_string(port)(sc, buf, plen, port);
+    }
+  plen = catstrs_direct(buf, integer_to_string_no_length(sc, vector_dimension(vect, dim)), "))", (const char *)NULL);
+  port_write_string(port)(sc, buf, plen, port);
+}
+
+static void port_write_vector_typer(s7_scheme *sc, s7_pointer vect, s7_pointer port);
+
+static void vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, use_write_t use_write, shared_info_t *ci)
+{
+  s7_int i, len = vector_length(vect), plen;
+  bool too_long = false;
+  char buf[2048]; /* 128 is too small -- this is the list of indices with a few minor flourishes */
+
+  if (len == 0)
+    {
+      if (vector_rank(vect) > 1)
+	{
+	  plen = catstrs_direct(buf, "#", pos_int_to_str_direct(sc, vector_ndims(vect)), "d()", (const char *)NULL);
+	  port_write_string(port)(sc, buf, plen, port);
+	}
+      else port_write_string(port)(sc, "#()", 3, port);
+      return;
+    }
+  if (use_write != P_READABLE)
+    {
+      if (sc->print_length == 0)
+	{
+	  if (vector_rank(vect) > 1)
+	    {
+	      plen = catstrs_direct(buf, "#", pos_int_to_str_direct(sc, vector_ndims(vect)), "d(...)", (const char *)NULL);
+	      port_write_string(port)(sc, buf, plen, port);
+	    }
+	  else port_write_string(port)(sc, "#(...)", 6, port);
+	  return;
+	}
+      if (len > sc->print_length)
+	{
+	  too_long = true;
+	  len = sc->print_length;
+	}}
+  if ((!ci) &&
+      (len > 1000))
+    {
+      s7_int vlen = vector_length(vect);
+      s7_pointer *els = vector_elements(vect);
+      s7_pointer p0 = els[0];
+      for (i = 1; i < vlen; i++)
+	if (els[i] != p0)
+	  break;
+      if (i == vlen)
+	{
+	  make_vector_to_port(sc, vect, port);
+	  object_to_port(sc, p0, port, use_write, NULL);
+	  if (is_typed_vector(vect))
+	    {
+	      port_write_character(port)(sc, ' ', port);
+	      port_write_vector_typer(sc, vect, port);
+	    }
+	  port_write_character(port)(sc, ')', port);
+	  return;
+	}}
+
+  check_stack_size(sc);
+  gc_protect_via_stack(sc, vect);
+  if (use_write == P_READABLE)
+    {
+      int32_t vref;
+      if ((ci) &&
+	  (is_cyclic(vect)) &&
+	  ((vref = peek_shared_ref(ci, vect)) != 0))
+	{
+	  s7_pointer *els = vector_elements(vect);
+	  if (vref < 0) vref = -vref;
+	  if ((ci->defined[vref]) || (port == ci->cycle_port))
+	    {
+	      plen = catstrs_direct(buf, "<", pos_int_to_str_direct(sc, vref), ">", (const char *)NULL);
+	      port_write_string(port)(sc, buf, plen, port);
+	      unstack_gc_protect(sc);
+	      return;
+	    }
+
+	  if (is_typed_vector(vect))
+	    port_write_string(port)(sc, "(let ((<v> ", 11, port);
+
+	  if (vector_rank(vect) > 1)
+	    port_write_string(port)(sc, "(subvector ", 11, port);
+
+	  port_write_string(port)(sc, "(vector", 7, port); /* top level let */
+	  for (i = 0; i < len; i++)
+	    if (has_structure(els[i]))
+	      {
+		int32_t eref = peek_shared_ref(ci, els[i]);
+		port_write_string(port)(sc, " #f", 3, port);
+		if (eref != 0)
+		  {
+		    if (eref < 0) eref = -eref;
+		    if (vector_rank(vect) > 1)
+		      {
+			s7_int dimension = vector_rank(vect) - 1;
+			int32_t str_len = (dimension < 8) ? 128 : ((dimension + 1) * 16);
+			block_t *b = callocate(sc, str_len);
+			char *indices = (char *)block_data(b);
+			multivector_indices_to_string(sc, i, vect, indices, str_len, dimension); /* calls pos_int_to_str_direct, writes to indices */
+			plen = catstrs_direct(buf, "  (set! (<", pos_int_to_str_direct(sc, vref), ">",
+					      indices, ") <", pos_int_to_str_direct_1(sc, eref), ">) ", (const char *)NULL);
+			port_write_string(ci->cycle_port)(sc, buf, plen, ci->cycle_port);
+			liberate(sc, b);
+		      }
+		    else
+		      {
+			size_t len1 = catstrs_direct(buf, "  (set! (<", pos_int_to_str_direct(sc, vref), "> ", integer_to_string(sc, i, &plen), ") <",
+						     pos_int_to_str_direct_1(sc, eref), ">) ", (const char *)NULL);
+			port_write_string(ci->cycle_port)(sc, buf, len1, ci->cycle_port);
+		      }}
+		else
+		  {
+		    if (vector_rank(vect) > 1)
+		      {
+			s7_int dimension = vector_rank(vect) - 1;
+			int32_t str_len = (dimension < 8) ? 128 : ((dimension + 1) * 16);
+			block_t *b = callocate(sc, str_len);
+			char *indices = (char *)block_data(b);
+			buf[0] = '\0';
+			multivector_indices_to_string(sc, i, vect, indices, str_len, dimension); /* writes to indices */
+			plen = catstrs(buf, 2048, "  (set! (<", pos_int_to_str_direct(sc, vref), ">", indices, ") ", (char *)NULL);
+			port_write_string(ci->cycle_port)(sc, buf, plen, ci->cycle_port);
+			liberate(sc, b);
+		      }
+		    else
+		      {
+			size_t len1 = catstrs_direct(buf, "  (set! (<", pos_int_to_str_direct(sc, vref), "> ", integer_to_string_no_length(sc, i), ") ", (const char *)NULL);
+			port_write_string(ci->cycle_port)(sc, buf, len1, ci->cycle_port);
+		      }
+		    object_to_port_with_circle_check(sc, els[i], ci->cycle_port, P_READABLE, ci);
+		    port_write_string(ci->cycle_port)(sc, ") ", 2, ci->cycle_port);
+		  }}
+	    else
+	      {
+		port_write_character(port)(sc, ' ', port);
+		object_to_port_with_circle_check(sc, els[i], port, P_READABLE, ci);
+	      }
+	  port_write_character(port)(sc, ')', port);
+	  if (vector_rank(vect) > 1)
+	    {
+	      plen = catstrs_direct(buf, " 0 ", pos_int_to_str_direct(sc, len), (const char *)NULL);
+	      port_write_string(port)(sc, buf, plen, port);
+	      write_vector_dimensions(sc, vect, port);
+	    }
+	  if (is_typed_vector(vect))
+	    {
+	      port_write_string(port)(sc, ")) (set! (vector-typer <v>) ", 28, port);
+	      port_write_vector_typer(sc, vect, port);
+	      port_write_string(port)(sc, ") <v>)", 6, port);
+	    }}
+      else
+	{
+	  if (is_typed_vector(vect))
+	    port_write_string(port)(sc, "(let ((<v> ", 11, port);
+	  /* (let ((v (make-vector 3 'a symbol?))) (object->string v :readable)): "(let ((<v> (vector 'a 'a 'a))) (set! (vector-typer <v>) symbol?) <v>)" */
+
+	  if (vector_rank(vect) > 1)
+	    port_write_string(port)(sc, "(subvector ", 11, port);
+
+	  if (is_immutable_vector(vect))
+	    port_write_string(port)(sc, "(immutable! ", 12, port);
+
+	  port_write_string(port)(sc, "(vector", 7, port);
+	  for (i = 0; i < len; i++)
+	    {
+	      port_write_character(port)(sc, ' ', port);
+	      object_to_port_with_circle_check(sc, vector_element(vect, i), port, P_READABLE, ci);
+	    }
+
+	  if (is_immutable_vector(vect))
+	    port_write_string(port)(sc, "))", 2, port);
+	  else port_write_character(port)(sc, ')', port);
+
+	  if (vector_rank(vect) > 1)          /* subvector above */
+	    {
+	      plen = catstrs_direct(buf, " 0 ", pos_int_to_str_direct(sc, len), (const char *)NULL);
+	      port_write_string(port)(sc, buf, plen, port);
+	      write_vector_dimensions(sc, vect, port);
+	    }
+	  if (is_typed_vector(vect))
+	    {
+	      port_write_string(port)(sc, ")) (set! (vector-typer <v>) ", 28, port);
+	      port_write_vector_typer(sc, vect, port);
+	      port_write_string(port)(sc, ") <v>)", 6, port);
+	    }}}
+  else /* not readable write */
+    {
+      if (vector_rank(vect) > 1)
+	{
+	  if (vector_ndims(vect) > 1)
+	    {
+	      plen = catstrs_direct(buf, "#", pos_int_to_str_direct(sc, vector_ndims(vect)), "d", (const char *)NULL);
+	      port_write_string(port)(sc, buf, plen, port);
+	    }
+	  else port_write_character(port)(sc, '#', port);
+	  multivector_to_port(sc, vect, port, len, 0, 0, vector_ndims(vect), use_write, ci);
+	}
+      else
+	{
+	  port_write_string(port)(sc, "#(", 2, port);
+	  for (i = 0; i < len - 1; i++)
+	    {
+	      object_to_port_with_circle_check(sc, vector_element(vect, i), port, not_p_display(use_write), ci);
+	      port_write_character(port)(sc, ' ', port);
+	    }
+	  object_to_port_with_circle_check(sc, vector_element(vect, i), port, not_p_display(use_write), ci);
+
+	  if (too_long)
+	    port_write_string(port)(sc, " ...)", 5, port);
+	  else port_write_character(port)(sc, ')', port);
+	}}
+  unstack_gc_protect(sc);
+}
+
+static int32_t print_vector_length(s7_scheme *sc, s7_pointer vect, s7_pointer port, use_write_t use_write)
+{
+  int32_t plen, len = vector_length(vect);
+  char buf[128];
+  const char *vtype = "r";
+
+  if (is_int_vector(vect)) vtype = "i";
+  else if (is_byte_vector(vect)) vtype = "u";
+  if (len == 0)
+    {
+      if (vector_rank(vect) > 1)
+	plen = (int32_t)catstrs_direct(buf, "#", vtype, pos_int_to_str_direct(sc, vector_ndims(vect)), "d()", (const char *)(const char *)NULL);
+      else plen = (int32_t)catstrs_direct(buf, "#", vtype, "()", (const char *)NULL);
+      port_write_string(port)(sc, buf, plen, port);
+      return(-1);
+    }
+  if (use_write == P_READABLE)
+    return(len);
+  if (sc->print_length != 0)
+    return((len > sc->print_length) ? sc->print_length : len);
+
+  if (vector_rank(vect) > 1)
+    {
+      plen = (int32_t)catstrs_direct(buf, "#", vtype, pos_int_to_str_direct(sc, vector_ndims(vect)), "d(...)", (const char *)NULL);
+      port_write_string(port)(sc, buf, plen, port);
+    }
+  else
+    if (is_int_vector(vect))
+      port_write_string(port)(sc, "#i(...)", 7, port);
+    else
+      if (is_float_vector(vect))
+	port_write_string(port)(sc, "#r(...)", 7, port);
+      else port_write_string(port)(sc, "#u(...)", 7, port);
+  return(-1);
+}
+
+static void int_vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, use_write_t use_write, shared_info_t *unused_ci)
+{
+  s7_int plen;
+  bool too_long;
+  char buf[128];
+  const char *p;
+  s7_int len = print_vector_length(sc, vect, port, use_write);
+  if (len < 0) return;
+  too_long = (len < vector_length(vect));
+
+  if ((use_write == P_READABLE) &&
+      (is_immutable_vector(vect)))
+    port_write_string(port)(sc, "(immutable! ", 12, port);
+
+  if (len > 1000)
+    {
+      s7_int i, vlen = vector_length(vect);
+      const s7_int *els = int_vector_ints(vect);
+      s7_int first = els[0];
+      for (i = 1; i < vlen; i++)
+	if (els[i] != first)
+	  break;
+      if (i == vlen)
+	{
+	  make_vector_to_port(sc, vect, port);
+	  p = integer_to_string(sc, int_vector(vect, 0), &plen);
+	  port_write_string(port)(sc, p, plen, port);
+	  if ((use_write == P_READABLE) &&
+	      (is_immutable_vector(vect)))
+	    port_write_string(port)(sc, "))", 2, port);
+	  else port_write_character(port)(sc, ')', port);
+	  return;
+	}}
+  if (vector_rank(vect) == 1)
+    {
+      port_write_string(port)(sc, "#i(", 3, port);
+      if (!is_string_port(port))
+	{
+	  p = integer_to_string(sc, int_vector(vect, 0), &plen);
+	  port_write_string(port)(sc, p, plen, port);
+	  for (s7_int i = 1; i < len; i++)
+	    {
+	      plen = catstrs_direct(buf, " ", integer_to_string_no_length(sc, int_vector(vect, i)), (const char *)NULL);
+	      port_write_string(port)(sc, buf, plen, port);
+	    }}
+      else
+	{
+	  s7_int new_len = port_position(port);
+	  s7_int next_len = port_data_size(port) - 128;
+	  uint8_t *dbuf = port_data(port);
+	  if (new_len >= next_len)
+	    {
+	      resize_port_data(sc, port, port_data_size(port) * 2);
+	      next_len = port_data_size(port) - 128;
+	      dbuf = port_data(port);
+	    }
+	  p = integer_to_string(sc, int_vector(vect, 0), &plen);
+	  memcpy((void *)(dbuf + new_len), (const void *)p, plen);
+	  new_len += plen;
+	  for (s7_int i = 1; i < len; i++)
+	    {
+	      if (new_len >= next_len)
+		{
+		  resize_port_data(sc, port, port_data_size(port) * 2);
+		  next_len = port_data_size(port) - 128;
+		  dbuf = port_data(port);
+		}
+	      plen = catstrs_direct((char *)(dbuf + new_len), " ", integer_to_string_no_length(sc, int_vector(vect, i)), (const char *)NULL);
+	      new_len += plen;
+	    }
+	  port_position(port) = new_len;
+	}
+      if (too_long)
+	port_write_string(port)(sc, " ...)", 5, port);
+      else port_write_character(port)(sc, ')', port);
+    }
+  else
+    {
+      plen = catstrs_direct(buf, "#i", pos_int_to_str_direct(sc, vector_ndims(vect)), "d", (const char *)NULL);
+      port_write_string(port)(sc, buf, plen, port);
+      gc_protect_via_stack(sc, vect);
+      multivector_to_port(sc, vect, port, len, 0, 0, vector_ndims(vect), P_DISPLAY, NULL);
+      unstack_gc_protect(sc);
+    }
+  if ((use_write == P_READABLE) &&
+      (is_immutable_vector(vect)))
+    port_write_character(port)(sc, ')', port);
+}
+
+static void float_vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, use_write_t use_write, shared_info_t *unused_ci)
+{
+  #define FV_BUFSIZE 512 /* some floats can take around 312 bytes */
+  char buf[FV_BUFSIZE];
+  s7_int i, plen;
+  bool too_long;
+  const s7_double *els = float_vector_floats(vect);
+  s7_int len = print_vector_length(sc, vect, port, use_write);
+  if (len < 0) return;  /* vector-length=0 etc */
+  too_long = (len < vector_length(vect));
+
+  if ((use_write == P_READABLE) &&
+      (is_immutable_vector(vect)))
+    port_write_string(port)(sc, "(immutable! ", 12, port);
+
+  if (len > 1000)
+    {
+      s7_int vlen = vector_length(vect);
+      s7_double first = els[0];
+      for (i = 1; i < vlen; i++)
+	if (els[i] != first)
+	  break;
+      if (i == vlen)
+	{
+	  make_vector_to_port(sc, vect, port);
+	  plen = snprintf(buf, FV_BUFSIZE, "%.*g)", sc->float_format_precision, first);
+	  port_write_string(port)(sc, buf, clamp_length(plen, FV_BUFSIZE), port);
+	  if ((use_write == P_READABLE) &&
+	      (is_immutable_vector(vect)))
+	    port_write_character(port)(sc, ')', port);
+	  return;
+	}}
+
+  if (vector_rank(vect) == 1)
+    {
+      port_write_string(port)(sc, "#r(", 3, port);
+      plen = snprintf(buf, FV_BUFSIZE - 4, "%.*g", sc->float_format_precision, els[0]); /* -4 so floatify has room */
+      floatify(buf, &plen);
+      port_write_string(port)(sc, buf, clamp_length(plen, FV_BUFSIZE), port);
+      for (i = 1; i < len; i++)
+	{
+	  plen = snprintf(buf, FV_BUFSIZE - 4, " %.*g", sc->float_format_precision, els[i]);
+	  plen--; /* fixup for the initial #\space */
+	  floatify((char *)(buf + 1), &plen);
+	  port_write_string(port)(sc, buf, clamp_length(plen + 1, FV_BUFSIZE), port);
+	}
+      if (too_long)
+	port_write_string(port)(sc, " ...)", 5, port);
+      else port_write_character(port)(sc, ')', port);
+    }
+  else
+    {
+      plen = catstrs_direct(buf, "#r", pos_int_to_str_direct(sc, vector_ndims(vect)), "d", (const char *)NULL);
+      port_write_string(port)(sc, buf, plen, port);
+      gc_protect_via_stack(sc, vect);
+      multivector_to_port(sc, vect, port, len, 0, 0, vector_ndims(vect), P_DISPLAY, NULL);
+      unstack_gc_protect(sc);
+    }
+  if ((use_write == P_READABLE) &&
+      (is_immutable_vector(vect)))
+    port_write_character(port)(sc, ')', port);
+}
+
+static void byte_vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, use_write_t use_write, shared_info_t *unused_ci)
+{
+  s7_int i, plen;
+  bool too_long;
+  char buf[128];
+  const char *p;
+  s7_int len = print_vector_length(sc, vect, port, use_write);
+  if (len < 0) return;
+  too_long = (len < vector_length(vect));
+
+  if ((use_write == P_READABLE) &&
+      (is_immutable_vector(vect)))
+    port_write_string(port)(sc, "(immutable! ", 12, port);
+
+  if (len > 1000)
+    {
+      s7_int vlen = vector_length(vect);
+      const uint8_t *els = byte_vector_bytes(vect);
+      uint8_t first = els[0];
+      for (i = 1; i < vlen; i++)
+	if (els[i] != first)
+	  break;
+      if (i == vlen)
+	{
+	  make_vector_to_port(sc, vect, port);
+	  p = integer_to_string(sc, byte_vector(vect, 0), &plen); /* only 0..10 start out with names: init_small_ints */
+	  port_write_string(port)(sc, p, plen, port);
+	  if ((use_write == P_READABLE) &&
+	      (is_immutable_vector(vect)))
+	    port_write_string(port)(sc, "))", 2, port);
+	  else port_write_character(port)(sc, ')', port);
+	  return;
+	}}
+
+  if (vector_rank(vect) == 1)
+    {
+      port_write_string(port)(sc, "#u(", 3, port);
+      p = integer_to_string(sc, byte_vector(vect, 0), &plen);
+      port_write_string(port)(sc, p, plen, port);
+      for (i = 1; i < len; i++)
+	{
+	  plen = catstrs_direct(buf, " ", integer_to_string_no_length(sc, byte_vector(vect, i)), (const char *)NULL);
+	  port_write_string(port)(sc, buf, plen, port);
+	}
+      if (too_long)
+	port_write_string(port)(sc, " ...)", 5, port);
+      else port_write_character(port)(sc, ')', port);
+    }
+  else
+    {
+      plen = catstrs_direct(buf, "#u", pos_int_to_str_direct(sc, vector_ndims(vect)), "d", (const char *)NULL);
+      port_write_string(port)(sc, buf, plen, port);
+      multivector_to_port(sc, vect, port, len, 0, 0, vector_ndims(vect), P_DISPLAY, NULL);
+    }
+  if ((use_write == P_READABLE) &&
+      (is_immutable_vector(vect)))
+    port_write_character(port)(sc, ')', port);
+}
+
+static void string_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info_t *unused_ci)
+{
+  bool immutable = ((use_write == P_READABLE) &&
+		    (is_immutable_string(obj)) &&
+		    (string_length(obj) > 0));  /* (immutable "") looks dumb */
+  if (immutable)
+    port_write_string(port)(sc, "(immutable! ", 12, port);
+
+  if (string_length(obj) > 0)
+    {
+      /* since string_length is a scheme length, not C, this write can embed nulls from C's point of view */
+      if (string_length(obj) > 1000) /* was 10000 28-Feb-18 */
+	{
+	  size_t size;
+	  char buf[128];
+	  buf[0] = string_value(obj)[0];
+	  buf[1] = '\0';
+	  size = strspn((const char *)(string_value(obj) + 1), buf); /* if all #\null, this won't work */
+	  if (size == (size_t)(string_length(obj) - 1))
+	    {
+	      s7_pointer c = chars[(int32_t)((uint8_t)(buf[0]))];
+	      int32_t nlen = (int32_t)catstrs_direct(buf, "(make-string ", pos_int_to_str_direct(sc, string_length(obj)), " ", (const char *)NULL);
+	      port_write_string(port)(sc, buf, nlen, port);
+	      port_write_string(port)(sc, character_name(c), character_name_length(c), port);
+	      if (immutable)
+		port_write_string(port)(sc, "))", 2, port);
+	      else port_write_character(port)(sc, ')', port);
+	      return;
+	    }}
+      if (use_write == P_DISPLAY)
+	port_write_string(port)(sc, string_value(obj), string_length(obj), port);
+      else
+	if (!string_needs_slashification((const uint8_t *)string_value(obj), string_length(obj)))
+	  {
+	    port_write_character(port)(sc, '"', port);
+	    port_write_string(port)(sc, string_value(obj), string_length(obj), port);
+	    port_write_character(port)(sc, '"', port);
+	  }
+	else slashify_string_to_port(sc, port, string_value(obj), string_length(obj), IN_QUOTES);
+    }
+  else
+    if (use_write != P_DISPLAY)
+      port_write_string(port)(sc, "\"\"", 2, port);
+
+  if (immutable)
+    port_write_character(port)(sc, ')', port);
+}
+
+static s7_int list_length_with_immutable_check(s7_scheme *sc, s7_pointer a, bool *immutable)
+{
+  s7_pointer slow = a, fast = a;
+  for (s7_int i = 0; ; i += 2)
+    {
+      if (!is_pair(fast)) return((is_null(fast)) ? i : -i);
+      if (is_immutable_pair(fast)) *immutable = true;
+      fast = cdr(fast);
+      if (!is_pair(fast)) return((is_null(fast)) ? (i + 1) : (-i - 1));
+      if (is_immutable_pair(fast)) *immutable = true;
+      fast = cdr(fast);
+      slow = cdr(slow);
+      if (fast == slow) return(0);
+    }
+  return(0);
+}
+
+static void simple_list_readable_display(s7_scheme *sc, s7_pointer lst, s7_int true_len, s7_int len, s7_pointer port, shared_info_t *ci, bool immutable)
+{
+  /* the easier cases: no circles or shared refs to patch up */
+  s7_pointer x;
+
+  if ((true_len > 0) && (!immutable))
+    {
+      port_write_string(port)(sc, "list", 4, port);
+      for (x = lst; is_pair(x); x = cdr(x))
+	{
+	  port_write_character(port)(sc, ' ', port);
+	  object_to_port_with_circle_check(sc, car(x), port, P_READABLE, ci);
+	}
+      port_write_character(port)(sc, ')', port);
+    }
+  else
+    {
+      s7_int immutable_ctr = 0;
+      if (is_immutable_pair(lst))
+	{
+	  port_write_string(port)(sc, "immutable! (cons ", 17, port);
+	  immutable_ctr++;
+	}
+      else port_write_string(port)(sc, "cons ", 5, port);
+      object_to_port_with_circle_check(sc, car(lst), port, P_READABLE, ci);
+
+      for (x = cdr(lst); is_pair(x); x = cdr(x))
+	{
+	  if (is_immutable_pair(x))
+	    {
+	      port_write_string(port)(sc, " (immutable! (cons ", 19, port);
+	      immutable_ctr++;
+	    }
+	  else port_write_string(port)(sc, " (cons ", 7, port);
+	  object_to_port_with_circle_check(sc, car(x), port, P_READABLE, ci);
+	}
+      if (is_null(x))
+	port_write_string(port)(sc, " ()", 3, port);
+      else
+	{
+	  port_write_character(port)(sc, ' ', port);
+	  object_to_port_with_circle_check(sc, x, port, P_READABLE, ci);
+	}
+      for (s7_int i = (true_len <= 0) ? 1 : 0; i < len; i++)
+	port_write_character(port)(sc, ')', port);
+      for (s7_int i = 0; i < immutable_ctr; i++)
+	port_write_character(port)(sc, ')', port);
+    }
+}
+
+static void pair_to_port(s7_scheme *sc, s7_pointer lst, s7_pointer port, use_write_t use_write, shared_info_t *ci)
+{
+  s7_pointer x;
+  s7_int i, len;
+  bool immutable = false;
+  s7_int true_len = list_length_with_immutable_check(sc, lst, &immutable);
+
+  if (true_len < 0)                    /* a dotted list -- handle cars, then final cdr */
+    len = (-true_len + 1);
+  else len = (true_len == 0) ? circular_list_entries(lst) : true_len; /* circular list (nil is handled by unique_to_port) */
+
+  if ((use_write == P_READABLE) && (ci))
+    {
+      int32_t href = peek_shared_ref(ci, lst);
+      if (href != 0)
+	{
+	  if (href < 0) href = -href;
+	  if ((ci->defined[href]) || (port == ci->cycle_port))
+	    {
+	      char buf[128];
+	      int32_t plen = (int32_t)catstrs_direct(buf, "<", pos_int_to_str_direct(sc, href), ">", (const char *)NULL);
+	      port_write_string(port)(sc, buf, plen, port);
+	      return;
+	    }}}
+  if ((use_write != P_READABLE) &&
+      ((car(lst) == sc->quote_function) || (car(lst) == sc->quote_symbol)) &&
+      (true_len == 2))
+    {
+      bool need_new_ci = ((!ci) && (is_pair(cadr(lst))));
+      shared_info_t *new_ci = NULL, *temp_ci = NULL;
+      bool old_locked = sc->object_out_locked;
+      /* true_len == 2 is important, otherwise (list 'quote 1 2) -> '1 2 which looks weird
+       *   or (object->string (apply . `''1)) -> "'quote 1"
+       * so (quote x) = 'x but (quote x y z) should be left alone (if evaluated, it's an error)
+       * :readable is tricky because the list might be something like (list 'quote (lambda () #f)) which needs to be evalable back to its original
+       */
+      if (car(lst) == sc->quote_symbol)
+	port_write_string(port)(sc, "(quote ", 7, port);
+      else port_write_character(port)(sc, '\'', port);
+      if (need_new_ci)
+	{
+	  new_ci = make_shared_info(sc);
+	  /* clear_shared_info(new_ci); */
+	  temp_ci = load_shared_info(sc, cadr(lst), false, new_ci); /* temp_ci can be NULL! */
+	}
+      else temp_ci = ci;
+      if (need_new_ci) sc->object_out_locked = true;
+      object_to_port_with_circle_check(sc, cadr(lst), port, P_WRITE, temp_ci);
+      if (need_new_ci)
+	{
+	  sc->object_out_locked = old_locked;
+	  free_shared_info(new_ci);
+	}
+      if (car(lst) == sc->quote_symbol)
+	port_write_character(port)(sc, ')', port);
+      return;
+    }
+#if WITH_IMMUTABLE_UNQUOTE
+  if ((car(lst) == sc->unquote_symbol) && (true_len == 2))
+    {
+      port_write_character(port)(sc, ',', port);
+      object_to_port_with_circle_check(sc, cadr(lst), port, P_WRITE, ci);
+      return;
+    }
+#endif
+
+  if (is_multiple_value(lst))
+    port_write_string(port)(sc, "(values ", 8, port);
+  else port_write_character(port)(sc, '(', port);
+
+  if (use_write == P_READABLE)
+    {
+      if (!is_cyclic(lst))
+	{
+	  /* here (and in the cyclic case) we need to handle immutable pairs -- this requires using cons rather than list etc */
+	  simple_list_readable_display(sc, lst, true_len, len, port, ci, immutable);
+	  return;
+	}
+      if (ci)
+	{
+	  int32_t plen;
+	  s7_pointer local_port;
+	  char buf[128], lst_name[128];
+	  bool lst_local = false;
+	  int32_t lst_ref = peek_shared_ref(ci, lst);
+	  if (lst_ref == 0)
+	    {
+	      s7_pointer p;
+	      for (p = lst; is_pair(p); p = cdr(p))
+		if ((has_structure(car(p))) ||
+		    ((is_pair(cdr(p))) &&
+		     (peek_shared_ref(ci, cdr(p)) != 0)))
+		  {
+		    lst_name[0] = '<'; lst_name[1] = 'L'; lst_name[2] = '>'; lst_name[3] = '\0';
+		    lst_local = true;
+		    port_write_string(port)(sc, "let ((<L> (list", 15, port); /* '(' above */
+		    break;
+		  }
+	      if (!lst_local)
+		{
+		  if (has_structure(p))
+		    {
+		      lst_name[0] = '<'; lst_name[1] = 'L'; lst_name[2] = '>'; lst_name[3] = '\0';
+		      lst_local = true;
+		      port_write_string(port)(sc, "let ((<L> (list", 15, port); /* '(' above */
+		    }
+		  else
+		    {
+		      simple_list_readable_display(sc, lst, true_len, len, port, ci, immutable);
+		      return;
+		    }}}
+	  else
+	    {
+	      if (lst_ref < 0) lst_ref = -lst_ref;
+	      catstrs_direct(lst_name, "<", pos_int_to_str_direct(sc, lst_ref), ">", (const char *)NULL);
+	      port_write_string(port)(sc, "list", 4, port); /* '(' above */
+	    }
+
+	  for (i = 0, x = lst; (i < len) && (is_pair(x)); x = cdr(x), i++)
+	    {
+	      if ((has_structure(car(x))) &&
+		  (is_cyclic(car(x))))
+		port_write_string(port)(sc, " #f", 3, port);
+	      else
+		{
+		  port_write_character(port)(sc, ' ', port);
+		  object_to_port_with_circle_check(sc, car(x), port, use_write, ci);
+		}
+	      if ((is_pair(cdr(x))) &&
+		  (peek_shared_ref(ci, cdr(x)) != 0))
+		break;
+	    }
+
+	  if (lst_local)
+	    port_write_string(port)(sc, "))) ", 4, port);
+	  else port_write_character(port)(sc, ')', port);
+
+	  /* fill in the cyclic entries */
+	  local_port = ((lst_local) || (ci->cycle_port == sc->F)) ? port : ci->cycle_port; /* (object->string (list-values `(x . 1) (signature (int-vector))) :readable) */
+	  for (x = lst, i = 0; (i < len) && (is_pair(x)); x = cdr(x), i++)
+	    {
+	      int32_t lref;
+	      if ((has_structure(car(x))) &&
+		  (is_cyclic(car(x))))
+		{
+		  if (i == 0)
+		    plen = (int32_t)catstrs_direct(buf, "  (set-car! ", lst_name, " ", (const char *)NULL);
+		  else plen = (int32_t)catstrs_direct(buf, "  (set! (", lst_name, " ", pos_int_to_str_direct(sc, i), ") ", (const char *)NULL);
+		  port_write_string(local_port)(sc, buf, plen, local_port);
+		  lref = peek_shared_ref(ci, car(x));
+		  if (lref == 0)
+		    object_to_port_with_circle_check(sc, car(x), local_port, use_write, ci);
+		  else
+		    {
+		      if (lref < 0) lref = -lref;
+		      plen = (int32_t)catstrs_direct(buf, "<", pos_int_to_str_direct(sc, lref), ">", (const char *)NULL);
+		      port_write_string(local_port)(sc, buf, plen, local_port);
+		    }
+		  port_write_string(local_port)(sc, ") ", 2, local_port);
+		}
+	      if ((is_pair(cdr(x))) &&
+		  ((lref = peek_shared_ref(ci, cdr(x))) != 0))
+		{
+		  if (lref < 0) lref = -lref;
+		  if (i == 0)
+		    plen = (int32_t)catstrs_direct(buf, (lst_local) ? "    " : "  ",
+						   "(set-cdr! ", lst_name, " <", pos_int_to_str_direct(sc, lref), ">) ", (const char *)NULL);
+		  else
+		    if (i == 1)
+		      plen = (int32_t)catstrs_direct(buf, (lst_local) ? "    " : "  ",
+						     "(set-cdr! (cdr ", lst_name, ") <", pos_int_to_str_direct(sc, lref), ">) ", (const char *)NULL);
+		    else plen = (int32_t)catstrs_direct(buf, (lst_local) ? "    " : "  ",
+							"(set-cdr! (list-tail ", lst_name, " ", pos_int_to_str_direct_1(sc, i),
+							") <", pos_int_to_str_direct(sc, lref), ">) ", (const char *)NULL);
+		  port_write_string(local_port)(sc, buf, plen, local_port);
+		  break;
+		}}
+	  if (true_len < 0) /* dotted list */
+	    {
+	      s7_pointer end_x;
+	      for (end_x = lst; is_pair(end_x); end_x = cdr(end_x)); /* or maybe faster, start at x? */
+	      /* we can't depend on the loops above to set x to the last element because they sometimes break out */
+	      if (true_len == -1) /* cons cell */
+		plen = (int32_t)catstrs_direct(buf, (lst_local) ? "    " : "  ", "(set-cdr! ", lst_name, " ", (const char *)NULL);
+	      else
+		if (true_len == -2)
+		  plen = (int32_t)catstrs_direct(buf, (lst_local) ? "    " : "  ", "(set-cdr! (cdr ", lst_name, ") ", (const char *)NULL);
+		else plen = (int32_t)catstrs_direct(buf, "(set-cdr! (list-tail ", lst_name, " ", pos_int_to_str_direct(sc, len - 2), ") ", (const char *)NULL);
+	      port_write_string(local_port)(sc, buf, plen, local_port);
+	      object_to_port_with_circle_check(sc, end_x, local_port, use_write, ci);
+	      port_write_string(local_port)(sc, ") ", 2, local_port);
+	    }
+	  if (lst_local)
+	    port_write_string(local_port)(sc, "    <L>)", 8, local_port);
+	}
+      else simple_list_readable_display(sc, lst, true_len, len, port, ci, immutable);
+    }
+  else /* not :readable */
+    {
+      s7_int plen = (len > sc->print_length) ? sc->print_length : len;
+      if (plen <= 0)
+	{
+	  port_write_string(port)(sc, "(...))", 6, port); /* open paren above about 150 lines, "list" here is wrong if it's a cons */
+	  return;
+	}
+      if (ci)
+	{
+	  for (x = lst, i = 0; (is_pair(x)) && (i < plen) && ((i == 0) || (peek_shared_ref(ci, x) == 0)); i++, x = cdr(x))
+	    {
+	      ci->ctr++;
+	      if (ci->ctr > sc->print_length)
+		{
+		  port_write_string(port)(sc, " ...)", 5, port);
+		  return;
+		}
+	      object_to_port_with_circle_check(sc, car(x), port, not_p_display(use_write), ci);
+	      if (i < (len - 1))
+		port_write_character(port)(sc, ' ', port);
+	    }
+	  if (is_not_null(x))
+	    {
+	      if (plen < len)
+		port_write_string(port)(sc, " ...", 4, port);
+	      else
+		{
+		  if ((true_len == 0) &&
+		      (i == len))
+		    port_write_string(port)(sc, " . ", 3, port);
+		  else port_write_string(port)(sc, ". ", 2, port);
+		  object_to_port_with_circle_check(sc, x, port, not_p_display(use_write), ci);
+		}}
+	  port_write_character(port)(sc, ')', port);
+	}
+      else
+	{
+	  s7_int len1 = plen - 1;
+	  if (is_string_port(port))
+	    {
+	      for (x = lst, i = 0; (is_pair(x)) && (i < len1); i++, x = cdr(x))
+		{
+		  object_to_port(sc, car(x), port, not_p_display(use_write), ci);
+		  if (port_position(port) >= sc->objstr_max_len)
+		    return;
+		  if (port_position(port) >= port_data_size(port))
+		    resize_port_data(sc, port, port_data_size(port) * 2);
+		  port_data(port)[port_position(port)++] = (uint8_t)' ';
+		}}
+	  else
+	    for (x = lst, i = 0; (is_pair(x)) && (i < len1); i++, x = cdr(x))
+	      {
+		object_to_port(sc, car(x), port, not_p_display(use_write), ci);  /* lst free here if unprotected */
+		port_write_character(port)(sc, ' ', port);
+	      }
+	  if (is_pair(x))
+	    {
+	      object_to_port(sc, car(x), port, not_p_display(use_write), ci);
+	      x = cdr(x);
+	    }
+	  if (is_not_null(x))
+	    {
+	      if (plen < len)
+		port_write_string(port)(sc, " ...", 4, port);
+	      else
+		{
+		  port_write_string(port)(sc, ". ", 2, port);
+		  object_to_port(sc, x, port, not_p_display(use_write), ci);
+		}}
+	  port_write_character(port)(sc, ')', port);
+	}}
+}
+
+static s7_pointer find_closure(s7_scheme *sc, s7_pointer closure, s7_pointer current_let);
+static const char *hash_table_checker_name(s7_scheme *sc, s7_pointer ht);
+
+static const char *hash_table_typer_name(s7_scheme *sc, s7_pointer typer)
+{
+  s7_pointer sym;
+  if (is_c_function(typer)) return(c_function_name(typer));
+  if (is_boolean(typer)) return("#t");
+  if (typer == sc->unused) return("#<unused>"); /* mapper can be sc->unused briefly */
+  sym = find_closure(sc, typer, closure_let(typer));
+  if (is_null(sym)) return(NULL);
+  return(symbol_name(sym));
+}
+
+static void hash_typers_to_port(s7_scheme *sc, s7_pointer hash, s7_pointer port)
+{
+  if (((is_typed_hash_table(hash)) || (is_pair(hash_table_procedures(hash)))) &&
+      ((!is_boolean(hash_table_key_typer(hash))) || (!is_boolean(hash_table_value_typer(hash)))))
+    {
+      const char *typer = hash_table_typer_name(sc, hash_table_key_typer(hash));
+      port_write_string(port)(sc, " (cons ", 7, port);
+      port_write_string(port)(sc, typer, safe_strlen(typer), port);
+      port_write_character(port)(sc, ' ', port);
+      typer = hash_table_typer_name(sc, hash_table_value_typer(hash));
+      port_write_string(port)(sc, typer, safe_strlen(typer), port);
+      port_write_string(port)(sc, "))", 2, port);
+    }
+  else port_write_character(port)(sc, ')', port);
+}
+
+static void hash_table_procedures_to_port(s7_scheme *sc, s7_pointer hash, s7_pointer port, bool closed, shared_info_t *ci)
+{
+  const char *typer = hash_table_checker_name(sc, hash);
+  if ((closed) && (is_immutable_hash_table(hash)))
+    port_write_string(port)(sc, "(immutable! ", 12, port);
+
+  if (typer[0] == '#') /* #f */
+    {
+      if (is_pair(hash_table_procedures(hash)))
+	{
+	  s7_int nlen = 0;
+	  const char *str = (const char *)integer_to_string(sc, hash_table_size(hash), &nlen);
+	  const char *checker = hash_table_typer_name(sc, hash_table_procedures_checker(hash));
+	  const char *mapper = hash_table_typer_name(sc, hash_table_procedures_mapper(hash));
+	  if (is_weak_hash_table(hash))
+	    port_write_string(port)(sc, "(make-weak-hash-table ", 22, port);
+	  else port_write_string(port)(sc, "(make-hash-table ", 17, port);
+	  port_write_string(port)(sc, str, nlen, port);
+	  if ((checker) && (mapper))
+	    {
+	      if ((is_boolean(hash_table_procedures_checker(hash))) && (is_boolean(hash_table_procedures_mapper(hash))))
+		port_write_string(port)(sc, " #f", 3, port); /* no checker/mapper set? */
+	      else
+		{
+		  port_write_string(port)(sc, " (cons ", 7, port);
+		  port_write_string(port)(sc, checker, safe_strlen(checker), port);
+		  port_write_character(port)(sc, ' ', port);
+		  port_write_string(port)(sc, mapper, safe_strlen(mapper), port);
+		  port_write_character(port)(sc, ')', port);
+		}}
+	  else
+	    if ((is_any_closure(hash_table_procedures_checker(hash))) ||
+		(is_any_closure(hash_table_procedures_mapper(hash))))
+	      {
+		port_write_string(port)(sc, " (cons ", 7, port);
+		if (is_any_closure(hash_table_procedures_checker(hash)))
+		  object_to_port_with_circle_check(sc, hash_table_procedures_checker(hash), port, P_READABLE, ci);
+		else port_write_string(port)(sc, checker, safe_strlen(checker), port);
+		port_write_character(port)(sc, ' ', port);
+		if (is_any_closure(hash_table_procedures_mapper(hash)))
+		  object_to_port_with_circle_check(sc, hash_table_procedures_mapper(hash), port, P_READABLE, ci);
+		else port_write_string(port)(sc, mapper, safe_strlen(mapper), port);
+		port_write_character(port)(sc, ')', port);
+	      }
+	    else port_write_string(port)(sc, " #f", 3, port); /* no checker/mapper set? */
+	  hash_typers_to_port(sc, hash, port);
+	}
+      else
+	if (is_weak_hash_table(hash))
+	  port_write_string(port)(sc, "(weak-hash-table)", 17, port);
+	else port_write_string(port)(sc, "(hash-table)", 12, port);
+    }
+  else
+    {
+      s7_int nlen = 0;
+      const char *str = integer_to_string(sc, hash_table_size(hash), &nlen);
+      if (is_weak_hash_table(hash))
+	port_write_string(port)(sc, "(make-weak-hash-table ", 22, port);
+      else port_write_string(port)(sc, "(make-hash-table ", 17, port);
+      port_write_string(port)(sc, str, nlen, port);
+      port_write_character(port)(sc, ' ', port);
+      port_write_string(port)(sc, typer, safe_strlen(typer), port);
+      hash_typers_to_port(sc, hash, port);
+    }
+  if (is_immutable_hash_table(hash))
+    port_write_character(port)(sc, ')', port);
+}
+
+static void hash_table_to_port(s7_scheme *sc, s7_pointer hash, s7_pointer port, use_write_t use_write, shared_info_t *ci)
+{
+  s7_int gc_iter, len = hash_table_entries(hash);
+  bool too_long = false, hash_cyclic = false, copied = false, immut = false, letd = false;
+  s7_pointer iterator, p;
+  int32_t href = -1;
+
+  if (len == 0)
+    {
+      if (use_write == P_READABLE)
+	hash_table_procedures_to_port(sc, hash, port, true, ci);
+      else
+	{
+	  if (is_weak_hash_table(hash))
+	    port_write_string(port)(sc, "(weak-hash-table)", 17, port);
+	  else port_write_string(port)(sc, "(hash-table)", 12, port);
+	}
+      return;
+    }
+
+  if (use_write != P_READABLE)
+    {
+      s7_int plen = sc->print_length;
+      if (plen <= 0)
+	{
+	  port_write_string(port)(sc, "(hash-table ...)", 16, port);
+	  return;
+	}
+      if (len > plen)
+	{
+	  too_long = true;
+	  len = plen;
+	}}
+
+  if ((use_write == P_READABLE) &&
+      (ci))
+    {
+      href = peek_shared_ref(ci, hash);
+      if (href != 0)
+	{
+	  if (href < 0) href = -href;
+	  if ((ci->defined[href]) || (port == ci->cycle_port))
+	    {
+	      char buf[128];
+	      int32_t plen = catstrs_direct(buf, "<", pos_int_to_str_direct(sc, href), ">", (const char *)NULL);
+	      port_write_string(port)(sc, buf, plen, port);
+	      return;
+	    }}}
+
+  iterator = s7_make_iterator(sc, hash);
+  gc_iter = gc_protect_1(sc, iterator);
+  p = cons_unchecked(sc, sc->F, sc->F);
+  iterator_current(iterator) = p;
+  set_mark_seq(iterator);
+  hash_cyclic = ((ci) && (is_cyclic(hash)) && ((href = peek_shared_ref(ci, hash)) != 0));
+
+  if (use_write == P_READABLE)
+    {
+      if ((is_typed_hash_table(hash)) || (is_pair(hash_table_procedures(hash))) || (hash_chosen(hash)))
+	{
+	  port_write_string(port)(sc, "(let ((<h> ", 11, port);
+	  letd = true;
+	}
+      else
+	if ((is_immutable_hash_table(hash)) && (!hash_cyclic))
+	  {
+	    port_write_string(port)(sc, "(immutable! ", 12, port);
+	    immut = true;
+	  }}
+
+  if ((use_write == P_READABLE) &&
+      (hash_cyclic))
+    {
+      if (href < 0) href = -href;
+      if ((!is_typed_hash_table(hash)) && (!is_pair(hash_table_procedures(hash))) && (!hash_chosen(hash)))
+	{
+	  if (is_weak_hash_table(hash))
+	    port_write_string(port)(sc, "(weak-hash-table", 16, port);
+	  else port_write_string(port)(sc, "(hash-table", 11, port); /* top level let */
+	}
+      else
+	{
+	  hash_table_procedures_to_port(sc, hash, port, true, ci);
+	  port_write_character(port)(sc, ')', port);
+	}
+
+      /* output here is deferred via ci->cycle_port until later in cyclic_out */
+      for (s7_int i = 0; i < len; i++)
+	{
+	  s7_pointer key_val = hash_table_iterate(sc, iterator);
+	  if (key_val == eof_object) break;             /* key_val can be #<eof> if hash is a weak-hash-table, and a GC happens during this loop */
+	  {
+	    s7_pointer key = car(key_val);
+	    s7_pointer val = cdr(key_val);
+	    char buf[128];
+	    int32_t eref = peek_shared_ref(ci, val);
+	    int32_t kref = peek_shared_ref(ci, key);
+	    int32_t plen = catstrs_direct(buf, "  (set! (<", pos_int_to_str_direct(sc, href), "> ", (const char *)NULL);
+	    port_write_string(ci->cycle_port)(sc, buf, plen, ci->cycle_port);
+	    if (kref != 0)
+	      {
+		if (kref < 0) kref = -kref;
+		plen = catstrs_direct(buf, "<", pos_int_to_str_direct(sc, kref), ">", (const char *)NULL);
+		port_write_string(ci->cycle_port)(sc, buf, plen, ci->cycle_port);
+	      }
+	    else object_to_port(sc, key, ci->cycle_port, P_READABLE, ci);
+	    if (eref != 0)
+	      {
+		if (eref < 0) eref = -eref;
+		plen = catstrs_direct(buf, ") <", pos_int_to_str_direct(sc, eref), ">) ", (const char *)NULL);
+		port_write_string(ci->cycle_port)(sc, buf, plen, ci->cycle_port);
+	      }
+	    else
+	      {
+		port_write_string(ci->cycle_port)(sc, ") ", 2, ci->cycle_port);
+		object_to_port_with_circle_check(sc, val, ci->cycle_port, P_READABLE, ci);
+		port_write_string(ci->cycle_port)(sc, ") ", 2, ci->cycle_port);
+	      }}}}
+  else
+    {
+      if (((!is_typed_hash_table(hash)) && (!is_pair(hash_table_procedures(hash))) && (!hash_chosen(hash))) || (use_write != P_READABLE))
+	{
+	  if (is_weak_hash_table(hash))
+	    port_write_string(port)(sc, "(weak-hash-table", 16, port);
+	  else port_write_string(port)(sc, "(hash-table", 11, port);
+	}
+      else
+	{
+	  hash_table_procedures_to_port(sc, hash, port, true, ci);
+	  port_write_character(port)(sc, ')', port);
+	  port_write_string(port)(sc, ") (copy (hash-table", 19, port);
+	  copied = true;
+	}
+      for (s7_int i = 0; i < len; i++)
+	{
+	  s7_pointer key_val = hash_table_iterate(sc, iterator);
+	  if (key_val == eof_object) break;             /* key_val can be #<eof> if hash is a weak-hash-table, and a GC happens during this loop */
+	  port_write_character(port)(sc, ' ', port);
+	  if ((use_write != P_READABLE) && (use_write != P_CODE) && (is_normal_symbol(car(key_val))))
+	    port_write_character(port)(sc, '\'', port);
+	  object_to_port_with_circle_check(sc, car(key_val), port, not_p_display(use_write), ci);
+	  port_write_character(port)(sc, ' ', port);
+	  object_to_port_with_circle_check(sc, cdr(key_val), port, not_p_display(use_write), ci);
+	}
+      if (use_write != P_READABLE)
+	{
+	  if (too_long)
+	    port_write_string(port)(sc, " ...)", 5, port);
+	  else port_write_character(port)(sc, ')', port);
+	}}
+
+  if (use_write == P_READABLE)
+    {
+      if (copied)
+	{
+	  if (!letd)
+	    {
+	      char buf[128];
+	      int32_t plen = catstrs_direct(buf, ") <", pos_int_to_str_direct(sc, href), ">", (const char *)NULL);
+	      port_write_string(port)(sc, buf, plen, port);
+	    }
+	  else port_write_string(port)(sc, ") <h>))", 7, port);
+	}
+      else
+	if (letd)
+	  port_write_string(port)(sc, ") <h>)", 6, port);
+	else port_write_character(port)(sc, ')', port);
+
+      if ((is_immutable_hash_table(hash)) && (!hash_cyclic) && (!is_typed_hash_table(hash)))
+	port_write_character(port)(sc, ')', port);
+
+      if ((!immut) && (is_immutable_hash_table(hash)) && (!hash_cyclic))
+	port_write_string(port)(sc, ") (immutable! <h>))", 19, port);
+    }
+  s7_gc_unprotect_at(sc, gc_iter);
+  iterator_current(iterator) = sc->nil;
+  free_cell(sc, p);  /* free_cell(sc, iterator); */ /* 18-Dec-18 removed */
+}
+
+static void slot_list_to_port(s7_scheme *sc, s7_pointer slot, s7_pointer port, shared_info_t *ci, bool bindings) /* bindings=let/inlet choice */
+{
+  bool first_time = true;
+  for (; tis_slot(slot); slot = next_slot(slot))
+    {
+      if (bindings)
+	{
+	  if (first_time)
+	    {
+	      port_write_character(port)(sc, '(', port);
+	      first_time = false;
+	    }
+	  else port_write_string(port)(sc, " (", 2, port);
+	}
+      else port_write_character(port)(sc, ' ', port);
+      symbol_to_port(sc, slot_symbol(slot), port, (bindings) ? P_DISPLAY : P_KEY, NULL);  /* (object->string (inlet (symbol "(\")") 1) :readable) */
+      port_write_character(port)(sc, ' ', port);
+      object_to_port_with_circle_check(sc, slot_value(slot), port, P_READABLE, ci);
+      if (bindings) port_write_character(port)(sc, ')', port);
+    }
+}
+
+static void slot_list_to_port_with_cycle(s7_scheme *sc, s7_pointer obj, s7_pointer slot, s7_pointer port, shared_info_t *ci, bool bindings)
+{
+  bool first_time = true;
+  for (; tis_slot(slot); slot = next_slot(slot))
+    {
+      s7_pointer sym = slot_symbol(slot), val = slot_value(slot);
+      if (bindings)
+	{
+	  if (first_time)
+	    {
+	      port_write_character(port)(sc, '(', port);
+	      first_time = false;
+	    }
+	  else port_write_string(port)(sc, " (", 2, port);
+	}
+      else port_write_character(port)(sc, ' ', port);
+      symbol_to_port(sc, sym, port, (bindings) ? P_DISPLAY : P_KEY, NULL);
+      if (has_structure(val))
+	{
+	  char buf[128];
+	  int32_t symref;
+	  int32_t len = catstrs_direct(buf, "  (set! (<", pos_int_to_str_direct(sc, -peek_shared_ref(ci, obj)), "> ", (const char *)NULL);
+	  port_write_string(port)(sc, " #f", 3, port);
+	  port_write_string(ci->cycle_port)(sc, buf, len, ci->cycle_port);
+	  symbol_to_port(sc, sym, ci->cycle_port, P_KEY, NULL);
+
+	  symref = peek_shared_ref(ci, val);
+	  if (symref != 0)
+	    {
+	      if (symref < 0) symref = -symref;
+	      len = catstrs_direct(buf, ") <", pos_int_to_str_direct(sc, symref), ">) ", (const char *)NULL);
+	      port_write_string(ci->cycle_port)(sc, buf, len, ci->cycle_port);
+	    }
+	  else
+	    {
+	      port_write_string(ci->cycle_port)(sc, ") ", 2, ci->cycle_port);
+	      object_to_port_with_circle_check(sc, val, ci->cycle_port, P_READABLE, ci);
+	      port_write_string(ci->cycle_port)(sc, ") ", 2, ci->cycle_port);
+	    }}
+      else
+	{
+	  port_write_character(port)(sc, ' ', port);
+	  object_to_port_with_circle_check(sc, val, port, P_READABLE, ci);
+	}
+      if (bindings) port_write_character(port)(sc, ')', port);
+      if (is_immutable(obj))
+	{
+	  char buf[128];
+	  int32_t len = catstrs_direct(buf, "  (immutable! <", pos_int_to_str_direct(sc, -peek_shared_ref(ci, obj)), ">) ", (const char *)NULL);
+	  port_write_string(ci->cycle_port)(sc, buf, len, ci->cycle_port);
+	}}
+}
+
+static bool let_has_setter(s7_pointer obj)
+{
+  for (s7_pointer slot = let_slots(obj); tis_slot(slot); slot = next_slot(slot))
+    if ((slot_has_setter(slot)) || (is_immutable_slot(slot)))
+      return(true);
+  return(false);
+}
+
+static bool slot_setters_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, shared_info_t *ci)
+{
+  bool spaced_out = false;
+  for (s7_pointer slot = let_slots(obj); tis_slot(slot); slot = next_slot(slot))
+    if (slot_has_setter(slot))
+      {
+	if (spaced_out) port_write_character(port)(sc, ' ', port); else spaced_out = true;
+	port_write_string(port)(sc, "(set! (setter '", 15, port);
+	symbol_to_port(sc, slot_symbol(slot), port, P_DISPLAY, NULL);
+	port_write_string(port)(sc, ") ", 2, port);
+	object_to_port_with_circle_check(sc, slot_setter(slot), port, P_READABLE, ci);
+	port_write_character(port)(sc, ')', port);
+      }
+  return(spaced_out);
+}
+
+static void immutable_slots_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, bool spaced_out)
+{
+  for (s7_pointer slot = let_slots(obj); tis_slot(slot); slot = next_slot(slot))
+    if (is_immutable_slot(slot))
+      {
+	if (spaced_out) port_write_character(port)(sc, ' ', port); else spaced_out = true;
+	port_write_string(port)(sc, "(immutable! '", 13, port);
+	symbol_to_port(sc, slot_symbol(slot), port, P_DISPLAY, NULL);
+	port_write_character(port)(sc, ')', port);
+      }
+}
+
+static void slot_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info_t *ci)
+{
+  /* the slot symbol might need (symbol...) in which case we don't want the preceding quote */
+  symbol_to_port(sc, slot_symbol(obj), port, P_READABLE, NULL);
+  port_write_character(port)(sc, ' ', port);
+  object_to_port_with_circle_check(sc, slot_value(obj), port, use_write, ci);
+}
+
+static void internal_slot_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info_t *ci)
+{
+  /* here we're displaying a slot in the debugger -- T_SLOT objects are not directly accessible in scheme */
+  port_write_string(port)(sc, "#<slot: ", 8, port);
+  symbol_to_port(sc, slot_symbol(obj), port, P_DISPLAY, NULL);
+  port_write_character(port)(sc, ' ', port);
+  object_to_port_with_circle_check(sc, slot_value(obj), port, use_write, ci);
+  port_write_character(port)(sc, '>', port);
+}
+
+static void let_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info_t *ci)
+{
+  /* if outer env points to (say) method list, the object needs to specialize object->string itself */
+  if (has_active_methods(sc, obj))
+    {
+      s7_pointer print_func = find_method(sc, obj, sc->object_to_string_symbol);
+      if (print_func != sc->undefined)
+	{
+	  s7_pointer p;
+	  /* what needs to be protected here? for one, the function might not return a string! */
+
+	  clear_has_methods(obj);
+	  if ((use_write == P_WRITE) || (use_write == P_CODE))
+	    p = s7_apply_function(sc, print_func, set_plist_1(sc, obj));
+	  else p = s7_apply_function(sc, print_func, set_plist_2(sc, obj, (use_write == P_DISPLAY) ? sc->F : sc->readable_keyword));
+	  set_has_methods(obj);
+
+	  if ((is_string(p)) &&
+	      (string_length(p) > 0))
+	    port_write_string(port)(sc, string_value(p), string_length(p), port);
+	  return;
+	}}
+  if (obj == sc->rootlet)    {port_write_string(port)(sc, "(rootlet)", 9, port); return;}
+  if (obj == sc->s7_starlet) {port_write_string(port)(sc, "*s7*", 4, port);      return;}
+  if (is_unlet(obj))         {port_write_string(port)(sc, "(unlet)", 7, port);   return;}
+  if (sc->short_print)       {port_write_string(port)(sc, "#<let>", 6, port);    return;}
+
+  /* circles can happen here:
+   *    (let () (let ((b (curlet))) (curlet))):    #<let 'b #<let>>
+   * or (let ((b #f)) (set! b (curlet)) (curlet)): #1=#<let 'b #1#>
+   */
+  if (use_write == P_READABLE)
+    {
+      int32_t lref;
+      if ((ci) &&
+	  (is_cyclic(obj)) &&
+	  ((lref = peek_shared_ref(ci, obj)) != 0))
+	{
+	  if (lref < 0) lref = -lref;
+	  if ((ci->defined[lref]) || (port == ci->cycle_port))
+	    {
+	      char buf[128];
+	      int32_t len = (int32_t)catstrs_direct(buf, "<", pos_int_to_str_direct(sc, lref), ">", (const char *)NULL);
+	      port_write_string(ci->cycle_port)(sc, buf, len, ci->cycle_port);
+	      return;
+	    }
+	  if (let_outlet(obj) != sc->rootlet)
+	    {
+	      char buf[128];
+	      int32_t len = (int32_t)catstrs_direct(buf, "  (set! (outlet <", pos_int_to_str_direct(sc, lref), ">) ", (const char *)NULL);
+	      port_write_string(ci->cycle_port)(sc, buf, len, ci->cycle_port);
+	      let_to_port(sc, let_outlet(obj), ci->cycle_port, use_write, ci);
+	      port_write_string(ci->cycle_port)(sc, ") ", 2, ci->cycle_port);
+	    }
+	  if (is_openlet(obj))
+	    port_write_string(port)(sc, "(openlet ", 9, port);
+	  /* not immutable here because we'll need to set the let fields below, then declare it immutable */
+	  if (let_has_setter(obj))           /* both explicit setters and immutable slots */
+	    {
+	      port_write_string(port)(sc, "(let (", 6, port);
+	      slot_list_to_port_with_cycle(sc, obj, let_slots(obj), port, ci, true);
+	      port_write_string(port)(sc, ") ", 2, port);
+	      immutable_slots_to_port(sc, obj, port, slot_setters_to_port(sc, obj, port, ci));
+	      port_write_string(port)(sc, " (curlet))", 10, port);
+	    }
+	  else
+	    {
+	      port_write_string(port)(sc, "(inlet", 6, port);
+	      slot_list_to_port_with_cycle(sc, obj, let_slots(obj), port, ci, false);
+	      port_write_character(port)(sc, ')', port);
+	    }
+	  if (is_openlet(obj))
+	    port_write_character(port)(sc, ')', port);
+	}
+      else
+	{
+	  if (is_openlet(obj))
+	    port_write_string(port)(sc, "(openlet ", 9, port);
+	  if (is_immutable_let(obj))
+	    port_write_string(port)(sc, "(immutable! ", 12, port);
+
+	  /* this ignores outlet -- but is that a problem? */
+	  /* (object->string (let ((i 0)) (set! (setter 'i) integer?) (curlet)) :readable) -> "(let ((i 0)) (set! (setter 'i) #_integer?) (curlet))" */
+	  if (let_has_setter(obj))
+	    {
+	      port_write_string(port)(sc, "(let (", 6, port);
+	      slot_list_to_port(sc, let_slots(obj), port, ci, true);
+	      port_write_string(port)(sc, ") ", 2, port);
+	      immutable_slots_to_port(sc, obj, port, slot_setters_to_port(sc, obj, port, ci));
+	      /* perhaps set outlet here?? */
+	      port_write_string(port)(sc, " (curlet))", 10, port);
+	    }
+	  else
+	    {
+	      if (let_outlet(obj) != sc->rootlet)
+		{
+		  int32_t ref;
+		  port_write_string(port)(sc, "(sublet ", 8, port);
+		  if ((ci) && ((ref = peek_shared_ref(ci, let_outlet(obj))) < 0))
+		    {
+		      char buf[128];
+		      int32_t len = (int32_t)catstrs_direct(buf, "<", pos_int_to_str_direct(sc, -ref), ">", (const char *)NULL);
+		      port_write_string(port)(sc, buf, len, port);
+		    }
+		  else
+		    {
+		      s7_pointer name = let_ref_p_pp(sc, obj, sc->class_name_symbol);
+		      if (is_symbol(name))
+			symbol_to_port(sc, name, port, P_DISPLAY, NULL);
+		      else let_to_port(sc, let_outlet(obj), port, use_write, ci);
+		    }}
+	      else port_write_string(port)(sc, "(inlet", 6, port);
+	      slot_list_to_port(sc, let_slots(obj), port, ci, false);
+	      port_write_character(port)(sc, ')', port);
+	    }
+	  if (is_immutable_let(obj))
+	    port_write_character(port)(sc, ')', port);
+	  if (is_openlet(obj))
+	    port_write_character(port)(sc, ')', port);
+	}}
+  else /* not readable write */
+    {
+      s7_pointer slot = let_slots(obj);
+      port_write_string(port)(sc, "(inlet", 6, port);
+      for (int32_t i = 1; tis_slot(slot); i++, slot = next_slot(slot))
+	{
+	  port_write_character(port)(sc, ' ', port);
+	  slot_to_port(sc, slot, port, use_write, ci);
+	  if ((tis_slot(next_slot(slot))) && (i == sc->print_length))
+	    {
+	      port_write_string(port)(sc, " ...", 4, port);
+	      break;
+	    }}
+      port_write_character(port)(sc, ')', port);
+    }
+}
+
+static void write_macro_readably(s7_scheme *sc, s7_pointer obj, s7_pointer port)
+{
+  s7_pointer expr, body = closure_body(obj), arglist = closure_args(obj);
+  /* this doesn't handle recursive macros well -- we need letrec or the equivalent as in write_closure_readably */
+  /*   (letrec ((m2 (macro (x) `(if (> ,x 0) (m2 (- ,x 1)) 32)))) (object->string m2 :readable)) */
+
+  port_write_string(port)(sc, (is_either_macro(obj)) ? "(macro" : "(bacro", 6, port);
+  if ((is_macro_star(obj)) || (is_bacro_star(obj)))
+    port_write_character(port)(sc, '*', port);
+  if (is_symbol(arglist))
+    {
+      port_write_character(port)(sc, ' ', port);
+      port_write_string(port)(sc, symbol_name(arglist), symbol_name_length(arglist), port);
+      port_write_character(port)(sc, ' ', port);
+    }
+  else
+    if (is_pair(arglist))
+      {
+	port_write_string(port)(sc, " (", 2, port);
+	for (expr = arglist; is_pair(expr); expr = cdr(expr))
+	  {
+	    object_to_port(sc, car(expr), port, P_WRITE, NULL);
+	    if (is_pair(cdr(expr)))
+	      port_write_character(port)(sc, ' ', port);
+	  }
+	if (!is_null(expr))
+	  {
+	    port_write_string(port)(sc, " . ", 3, port);
+	    object_to_port(sc, expr, port, P_WRITE, NULL);
+	  }
+	port_write_string(port)(sc, ") ", 2, port);
+      }
+    else port_write_string(port)(sc, " () ", 4, port);
+
+  for (expr = body; is_pair(expr); expr = cdr(expr))
+    object_to_port(sc, car(expr), port, P_WRITE, NULL);
+  port_write_character(port)(sc, ')', port);
+}
+
+
+static s7_pointer match_symbol(const s7_pointer symbol, s7_pointer e)
+{
+  for (s7_pointer le = e; le; le = let_outlet(le))
+    for (s7_pointer y = let_slots(le); tis_slot(y); y = next_slot(y))
+      if (slot_symbol(y) == symbol)
+	return(y);
+  return(NULL);
+}
+
+static bool slot_memq(const s7_pointer symbol, s7_pointer symbols)
+{
+  for (s7_pointer x = symbols; is_pair(x); x = cdr(x))
+    if (slot_symbol(car(x)) == symbol)
+      return(true);
+  return(false);
+}
+
+static bool arg_memq(const s7_pointer symbol, s7_pointer args)
+{
+  for (s7_pointer x = args; is_pair(x); x = cdr(x))
+    if ((car(x) == symbol) ||
+	((is_pair(car(x))) &&
+	 (caar(x) == symbol)))
+      return(true);
+  return(false);
+}
+
+static void collect_symbol(s7_scheme *sc, s7_pointer sym, s7_pointer e, s7_pointer args, s7_int gc_loc)
+{
+  if ((!arg_memq(T_Sym(sym), args)) &&
+      (!slot_memq(sym, gc_protected_at(sc, gc_loc))))
+    {
+      s7_pointer slot = match_symbol(sym, e);
+      if (slot)
+	gc_protected_at(sc, gc_loc) = cons(sc, slot, gc_protected_at(sc, gc_loc));
+    }
+}
+
+static void collect_locals(s7_scheme *sc, s7_pointer body, s7_pointer e, s7_pointer args, s7_int gc_loc) /* currently called only in write_closure_readably */
+{
+  if (is_unquoted_pair(body))
+    {
+      collect_locals(sc, car(body), e, args, gc_loc);
+      collect_locals(sc, cdr(body), e, args, gc_loc);
+    }
+  else
+    if (is_symbol(body))
+      collect_symbol(sc, body, e, args, gc_loc);
+}
+
+static void collect_specials(s7_scheme *sc, s7_pointer e, s7_pointer args, s7_int gc_loc)
+{
+  collect_symbol(sc, sc->local_signature_symbol, e, args, gc_loc);
+  collect_symbol(sc, sc->local_setter_symbol, e, args, gc_loc);
+  collect_symbol(sc, sc->local_documentation_symbol, e, args, gc_loc);
+  collect_symbol(sc, sc->local_iterator_symbol, e, args, gc_loc);
+}
+
+static s7_pointer find_closure(s7_scheme *sc, s7_pointer closure, s7_pointer current_let)
+{
+  for (s7_pointer e = current_let; e; e = let_outlet(e))
+    {
+      if ((is_funclet(e)) || (is_maclet(e)))
+	{
+	  s7_pointer sym = funclet_function(e);
+	  const s7_pointer f = s7_symbol_local_value(sc, sym, e);
+	  if (f == closure)
+	    return(sym);
+	}
+      for (s7_pointer y = let_slots(e); tis_slot(y); y = next_slot(y))
+	if (slot_value(y) == closure)
+	  return(slot_symbol(y));
+    }
+  if ((is_any_macro(closure)) && /* can't be a c_macro here */
+      (has_pair_macro(closure))) /* maybe macro never called, so no maclet exists */
+    return(pair_macro(closure_body(closure)));
+  return(sc->nil);
+}
+
+static void write_closure_name(s7_scheme *sc, s7_pointer closure, s7_pointer port)
+{
+  s7_pointer x = find_closure(sc, closure, closure_let(closure));
+  if (is_symbol(x))
+    {
+      port_write_string(port)(sc, symbol_name(x), symbol_name_length(x), port);
+      return;
+    }
+  switch (type(closure))
+    {
+    case T_CLOSURE:      port_write_string(port)(sc, "#<lambda ", 9, port);   break;
+    case T_CLOSURE_STAR: port_write_string(port)(sc, "#<lambda* ", 10, port); break;
+    case T_BACRO:        port_write_string(port)(sc, "#<bacro ", 8, port);    break;
+    case T_BACRO_STAR:   port_write_string(port)(sc, "#<bacro* ", 9, port);   break;
+
+    case T_MACRO:
+      if (is_expansion(closure))
+	port_write_string(port)(sc, "#<expansion ", 12, port);
+      else port_write_string(port)(sc, "#<macro ", 8, port);
+      break;
+
+    case T_MACRO_STAR:
+      if (is_expansion(closure))
+	port_write_string(port)(sc, "#<expansion* ", 13, port);
+      else port_write_string(port)(sc, "#<macro* ", 9, port);
+      break;
+    }
+
+  if (is_null(closure_args(closure)))
+    port_write_string(port)(sc, "()>", 3, port);
+  else
+    {
+      s7_pointer args = closure_args(closure);
+      if (is_symbol(args))
+	{
+	  port_write_string(port)(sc, symbol_name(args), symbol_name_length(args), port);
+	  port_write_character(port)(sc, '>', port);    /* (lambda a a) -> #<lambda a> */
+	}
+      else
+	{
+	  port_write_character(port)(sc, '(', port);
+	  x = car(args);
+	  if (is_pair(x)) x = car(x);
+	  port_write_string(port)(sc, symbol_name(x), symbol_name_length(x), port);
+	  if (!is_null(cdr(args)))
+	    {
+	      s7_pointer y;
+	      port_write_character(port)(sc, ' ', port);
+	      if (is_pair(cdr(args)))
+		{
+		  y = cadr(args);
+		  if (is_pair(y))
+		    y = car(y);
+		  else
+		    if (y == sc->rest_keyword)
+		      {
+			port_write_string(port)(sc, ":rest ", 6, port);
+			args = cdr(args);
+			y = cadr(args);
+			if (is_pair(y)) y = car(y);
+		      }}
+	      else
+		{
+		  port_write_string(port)(sc, ". ", 2, port);
+		  y = cdr(args);
+		}
+	      port_write_string(port)(sc, symbol_name(y), symbol_name_length(y), port);
+	      if ((is_pair(cdr(args))) &&
+		  (!is_null(cddr(args))))
+		port_write_string(port)(sc, " ...", 4, port);
+	    }
+	  port_write_string(port)(sc, ")>", 2, port);
+	}}
+}
+
+static s7_pointer closure_name(s7_scheme *sc, s7_pointer closure)
+{
+  /* this is used by the error handlers to get the current function name */
+  s7_pointer x = find_closure(sc, closure, sc->curlet);
+  if (is_symbol(x))
+    return(x);
+  if (is_pair(current_code(sc)))
+    return(current_code(sc));
+  return(closure); /* desperation -- the parameter list (caar here) will cause endless confusion in OP_APPLY errors! */
+}
+
+static s7_pointer pair_append(s7_scheme *sc, s7_pointer a, s7_pointer b)
+{
+  s7_pointer p = cdr(a), tp;
+  gc_protect_via_stack(sc, b);
+  if (is_null(p))
+    tp = cons(sc, car(a), b);
+  else
+    {
+      s7_pointer np;
+      tp = list_1(sc, car(a));
+      set_gc_protected2(sc, tp);
+      for (np = tp; is_pair(p); p = cdr(p), np = cdr(np))
+	set_cdr(np, list_1(sc, car(p)));
+      set_cdr(np, b);
+    }
+  unstack_gc_protect(sc);
+  return(tp);
+}
+
+static void write_closure_readably_1(s7_scheme *sc, s7_pointer obj, s7_pointer arglist, s7_pointer body, s7_pointer port)
+{
+  s7_int old_print_length = sc->print_length;
+
+  if (type(obj) == T_CLOSURE_STAR)
+    port_write_string(port)(sc, "(lambda* ", 9, port);
+  else port_write_string(port)(sc, "(lambda ", 8, port);
+
+  if ((is_pair(arglist)) &&
+      (allows_other_keys(arglist)))
+    {
+      sc->temp9 = (is_null(cdr(arglist))) ? set_plist_2(sc, car(arglist), sc->allow_other_keys_keyword) :
+	          ((is_null(cddr(arglist))) ? set_plist_3(sc, car(arglist), cadr(arglist), sc->allow_other_keys_keyword) :
+	                                      pair_append(sc, arglist, list_1(sc, sc->allow_other_keys_keyword)));
+      object_to_port(sc, sc->temp9, port, P_WRITE, NULL);
+      sc->temp9 = sc->unused;
+    }
+  else object_to_port(sc, arglist, port, P_WRITE, NULL); /* here we just want the straight output (a b) not (list 'a 'b) */
+
+  sc->print_length = 1048576;
+  for (s7_pointer p = body; is_pair(p); p = cdr(p))
+    {
+      port_write_character(port)(sc, ' ', port);
+      object_to_port(sc, car(p), port, P_WRITE, NULL);
+    }
+  port_write_character(port)(sc, ')', port);
+  sc->print_length = old_print_length;
+}
+
+static void write_closure_readably(s7_scheme *sc, s7_pointer obj, s7_pointer port, shared_info_t *ci)
+{
+  s7_pointer body = closure_body(obj);
+  s7_pointer arglist = closure_args(obj);
+  s7_pointer pe, local_slots, setter = NULL, obj_slot = NULL;
+  s7_int gc_loc;
+  bool sent_let = false, sent_letrec = false;
+
+  if (sc->safety > NO_SAFETY)
+    {
+      if (tree_is_cyclic(sc, body))
+	{
+	  port_write_string(port)(sc, "#<write_closure_readably: body is cyclic>", 41, port); /* not s7_error here! */
+	  return;
+	}
+      if ((!ci) && (is_pair(arglist)))
+	{ /* (format #f "~W" (make-hook (let ((cp (list 1))) (set-cdr! cp cp) (list 'quote cp)))) */
+	  shared_info_t *new_ci = make_shared_info(sc);
+	  clear_shared_info(new_ci);
+	  if (collect_shared_info(sc, new_ci, arglist, false))
+	    {
+	      free_shared_info(new_ci);
+	      port_write_string(port)(sc, "#<write_closure_readably: arglist is cyclic>", 44, port); /* not s7_error here! */
+	      return;
+	    }
+	  free_shared_info(new_ci);
+	}}
+  if (is_symbol(arglist)) arglist = set_dlist_1(sc, arglist);
+  pe = closure_let(obj);
+
+  gc_loc = gc_protect_1(sc, sc->nil);
+  collect_locals(sc, body, pe, arglist, gc_loc);   /* collect locals used only here (and below) */
+  collect_specials(sc, pe, arglist, gc_loc);
+
+  if (s7_is_dilambda(obj))
+    {
+      setter = closure_setter(obj);
+      if (has_closure_let(setter))                 /* collect args etc so need the arglist */
+	{
+	  arglist = closure_args(setter);
+	  if (is_symbol(arglist)) arglist = set_dlist_1(sc, arglist);
+	  collect_locals(sc, closure_body(setter), pe, arglist, gc_loc);
+	}}
+
+  local_slots = T_Lst(gc_protected_at(sc, gc_loc)); /* possibly a list of slots */
+  if (!is_null(local_slots))
+    {
+      /* if (let|letrec ((f (lambda () f))) (object->string f :readable)), local_slots: ('f f) */
+      /* but we can't handle it below because that leads to an infinite loop */
+      for (s7_pointer x = local_slots; is_pair(x); x = cdr(x))
+	{
+	  s7_pointer slot = car(x);
+	  if ((!is_any_closure(slot_value(slot))) &&    /* mutually referencing closures? ./snd -l snd-test 24 hits this in the effects dialogs */
+	      ((!has_structure(slot_value(slot))) ||    /* see s7test example, vector has closure that refers to vector */
+	       (slot_symbol(slot) == sc->local_signature_symbol)))
+	    {
+	      if (!sent_let)
+		{
+		  port_write_string(port)(sc, "(let (", 6, port);
+		  sent_let = true;
+		}
+	      port_write_character(port)(sc, '(', port);
+	      port_write_string(port)(sc, symbol_name(slot_symbol(slot)), symbol_name_length(slot_symbol(slot)), port);
+	      port_write_character(port)(sc, ' ', port);
+	      /* (object->string (list (let ((local 1)) (lambda (x) (+ x local)))) :readable) */
+	      object_to_port(sc, slot_value(slot), port, P_READABLE, NULL);
+	      if (is_null(cdr(x)))
+		port_write_character(port)(sc, ')', port);
+	      else port_write_string(port)(sc, ") ", 2, port);
+	    }}
+      if (sent_let) port_write_string(port)(sc, ") ", 2, port);
+    }
+
+  /* now we need to know if obj is in the closure_let via letrec, and if so, send out letrec+obj name+def below, then close it with obj-name??
+   *  the two cases are: (let ((f (lambda () f)))...) which is ok now, and (letrec ((f (lambda () f)))...) which needs the letrec
+   */
+  if (!is_null(local_slots))
+    for (s7_pointer x = local_slots; is_pair(x); x = cdr(x))
+      {
+	s7_pointer slot = car(x);
+	if ((is_any_closure(slot_value(slot))) &&
+	    (slot_value(slot) == obj))
+	  {
+	    port_write_string(port)(sc, "(letrec ((", 10, port); /* (letrec ((f (lambda () f))) f) */
+	    sent_letrec = true;
+	    port_write_string(port)(sc, symbol_name(slot_symbol(slot)), symbol_name_length(slot_symbol(slot)), port);
+	    port_write_character(port)(sc, ' ', port);
+	    obj_slot = slot;
+	    break;
+	  }}
+
+  if (setter)
+    port_write_string(port)(sc, "(dilambda ", 10, port);
+
+  write_closure_readably_1(sc, obj, closure_args(obj), body, port);
+
+  if (setter)
+    {
+      port_write_character(port)(sc, ' ', port);
+      if (has_closure_let(setter))
+	write_closure_readably_1(sc, setter, closure_args(setter), closure_body(setter), port);
+      else object_to_port_with_circle_check(sc, setter, port, P_READABLE, ci);
+      port_write_character(port)(sc, ')', port);
+    }
+  if (sent_letrec)
+    {
+      port_write_string(port)(sc, ")) ", 3, port);
+      port_write_string(port)(sc, symbol_name(slot_symbol(obj_slot)), symbol_name_length(slot_symbol(obj_slot)), port);
+      port_write_character(port)(sc, ')', port);
+    }
+
+  if (sent_let)
+    port_write_character(port)(sc, ')', port);
+
+  s7_gc_unprotect_at(sc, gc_loc);
+}
+
+static void iterator_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info_t *ci)
+{
+  if (use_write == P_READABLE)
+    {
+      if (iterator_is_at_end(obj))
+	{
+	  switch (type(iterator_sequence(obj)))
+	    {
+	    case T_NIL:
+	    case T_PAIR:         port_write_string(port)(sc, "(make-iterator ())", 18, port);	        break;
+	    case T_STRING:       port_write_string(port)(sc, "(make-iterator \"\")", 18, port);	        break;
+	    case T_BYTE_VECTOR:  port_write_string(port)(sc, "(make-iterator #u())", 20, port);	        break;
+	    case T_VECTOR:       port_write_string(port)(sc, "(make-iterator #())", 19, port);	        break;
+	    case T_INT_VECTOR:	 port_write_string(port)(sc, "(make-iterator #i())", 20, port);	        break;
+	    case T_FLOAT_VECTOR: port_write_string(port)(sc, "(make-iterator #r())", 20, port);	        break;
+	    case T_LET:	         port_write_string(port)(sc, "(make-iterator (inlet))", 23, port);      break;
+
+	    case T_HASH_TABLE:
+	      if (is_weak_hash_table(iterator_sequence(obj)))
+		port_write_string(port)(sc, "(make-iterator (weak-hash-table))", 33, port);
+	      else port_write_string(port)(sc, "(make-iterator (hash-table))", 28, port);
+	      break;
+
+	    default:
+	      port_write_string(port)(sc, "(make-iterator ())", 18, port);	        break; /* c-object?? function? */
+	    }}
+      else
+	{
+	  s7_pointer seq = iterator_sequence(obj);
+	  int32_t iter_ref;
+	  if ((ci) &&
+	      (is_cyclic(obj)) &&
+	      ((iter_ref = peek_shared_ref(ci, obj)) != 0))
+	    {
+	      /* basically the same as c_pointer_to_port */
+	      if (!is_cyclic_set(obj))
+		{
+		  int32_t nlen;
+		  char buf[128];
+		  if (iter_ref < 0) iter_ref = -iter_ref;
+
+		  if (ci->init_port == sc->F)
+		    {
+		      ci->init_port = s7_open_output_string(sc);
+		      ci->init_loc = gc_protect_1(sc, ci->init_port);
+		    }
+		  port_write_string(port)(sc, "#f", 2, port);
+		  nlen = (int32_t)catstrs_direct(buf, "  (set! <", pos_int_to_str_direct(sc, iter_ref), "> (make-iterator ", (const char *)NULL);
+		  port_write_string(ci->init_port)(sc, buf, nlen, ci->init_port);
+
+		  flip_ref(ci, seq);
+		  object_to_port_with_circle_check(sc, seq, ci->init_port, use_write, ci);
+		  flip_ref(ci, seq);
+
+		  port_write_string(ci->init_port)(sc, "))\n", 3, ci->init_port);
+		  set_cyclic_set(obj);
+		  return;
+		}}
+
+	  if (is_string(seq))
+	    {
+	      s7_int len = string_length(seq) - iterator_position(obj);
+	      if (len == 0)
+		port_write_string(port)(sc, "(make-iterator \"\")", 18, port);
+	      else
+		{
+		  const char *iter_str = (const char *)(string_value(seq) + iterator_position(obj));
+		  port_write_string(port)(sc, "(make-iterator \"", 16, port);
+		  if (!string_needs_slashification((const uint8_t *)iter_str, len))
+		    port_write_string(port)(sc, iter_str, len, port);
+		  else slashify_string_to_port(sc, port, iter_str, len, NOT_IN_QUOTES);
+		  port_write_string(port)(sc, "\")", 2, port);
+		}}
+	  else
+	    {
+	      if (is_pair(seq))
+		{
+		  port_write_string(port)(sc, "(make-iterator ", 15, port);
+		  object_to_port_with_circle_check(sc, iterator_current(obj), port, use_write, ci);
+		  port_write_character(port)(sc, ')', port);
+		}
+	      else
+		{
+		  if ((is_let(seq)) && (seq != sc->rootlet) && (seq != sc->s7_starlet))
+		    {
+		      port_write_string(port)(sc, "(let ((iter (make-iterator ", 27, port);
+		      object_to_port_with_circle_check(sc, seq, port, use_write, ci);
+		      port_write_string(port)(sc, "))) ", 4, port);
+		      for (s7_pointer slot = let_slots(seq); slot != iterator_current_slot(obj); slot = next_slot(slot))
+			port_write_string(port)(sc, "(iter) ", 7, port);
+		      port_write_string(port)(sc, "iter)", 5, port);
+		    }
+		  else
+		    {
+		      if (iterator_position(obj) > 0)
+			port_write_string(port)(sc, "(let ((iter (make-iterator ", 27, port);
+		      else port_write_string(port)(sc, "(make-iterator ", 15, port);
+		      object_to_port_with_circle_check(sc, seq, port, use_write, ci);
+		      if (iterator_position(obj) > 0)
+			{
+			  if (iterator_position(obj) == 1)
+			    port_write_string(port)(sc, "))) (iter) iter)", 16, port);
+			  else
+			    {
+			      char str[128];
+			      int32_t nlen = (int32_t)catstrs_direct(str, "))) (do ((i 0 (+ i 1))) ((= i ",
+								     pos_int_to_str_direct(sc, iterator_position(obj)),
+								     ") iter) (iter)))", (const char *)NULL);
+			      port_write_string(port)(sc, str, nlen, port);
+			    }}
+		      else port_write_character(port)(sc, ')', port);
+		    }}}}}
+  else
+    {
+      const char *str;
+      if ((is_hash_table(iterator_sequence(obj))) && (is_weak_hash_table(iterator_sequence(obj))))
+	str = "weak-hash-table";
+      else str = type_name(sc, iterator_sequence(obj), NO_ARTICLE);
+      port_write_string(port)(sc, "#<iterator: ", 12, port);
+      port_write_string(port)(sc, str, safe_strlen(str), port);
+      port_write_character(port)(sc, '>', port);
+    }
+}
+
+static void c_pointer_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info_t *ci)
+{
+  #define CP_BUFSIZE 128
+  char buf[CP_BUFSIZE];
+  int32_t nlen;
+  /* c-pointer is special because we can't set the type or info fields from scheme except via the c-pointer function */
+
+  if (use_write == P_READABLE)
+    {
+      int32_t ref;
+      if ((ci) &&
+	  (is_cyclic(obj)) &&
+	  ((ref = peek_shared_ref(ci, obj)) != 0))
+	{
+	  port_write_string(port)(sc, "#f", 2, port);
+	  if (!is_cyclic_set(obj))
+	    {
+	      if (ci->init_port == sc->F)
+		{
+		  ci->init_port = s7_open_output_string(sc);
+		  ci->init_loc = gc_protect_1(sc, ci->init_port);
+		}
+	      nlen = snprintf(buf, CP_BUFSIZE, "  (set! <%d> (c-pointer %" p64, -ref, (intptr_t)c_pointer(obj));
+	      port_write_string(ci->init_port)(sc, buf, nlen, ci->init_port);
+
+	      if ((c_pointer_type(obj) != sc->F) ||
+		  (c_pointer_info(obj) != sc->F))
+		{
+		  flip_ref(ci, c_pointer_type(obj));
+
+		  port_write_character(ci->init_port)(sc, ' ', ci->init_port);
+		  object_to_port_with_circle_check(sc, c_pointer_type(obj), ci->init_port, use_write, ci);
+
+		  flip_ref(ci, c_pointer_type(obj));
+		  flip_ref(ci, c_pointer_info(obj));
+
+		  port_write_character(ci->init_port)(sc, ' ', ci->init_port);
+		  object_to_port_with_circle_check(sc, c_pointer_info(obj), ci->init_port, use_write, ci);
+
+		  flip_ref(ci, c_pointer_info(obj));
+		}
+	      port_write_string(ci->init_port)(sc, "))\n", 3, ci->init_port);
+	      set_cyclic_set(obj);
+	    }}
+      else
+	{
+	  nlen = snprintf(buf, CP_BUFSIZE, "(c-pointer %" p64, (intptr_t)c_pointer(obj));
+	  port_write_string(port)(sc, buf, clamp_length(nlen, CP_BUFSIZE), port);
+	  if ((c_pointer_type(obj) != sc->F) ||
+	      (c_pointer_info(obj) != sc->F))
+	    {
+	      port_write_character(port)(sc, ' ', port);
+	      object_to_port_with_circle_check(sc, c_pointer_type(obj), port, use_write, ci);
+	      port_write_character(port)(sc, ' ', port);
+	      object_to_port_with_circle_check(sc, c_pointer_info(obj), port, use_write, ci);
+	    }
+	  port_write_character(port)(sc, ')', port);
+	}}
+  else
+    {
+      if ((is_symbol(c_pointer_type(obj))) &&
+	  (symbol_name_length(c_pointer_type(obj)) < (CP_BUFSIZE / 2)))
+	nlen = snprintf(buf, CP_BUFSIZE, "#<%s %p>", symbol_name(c_pointer_type(obj)), c_pointer(obj));
+      else nlen = snprintf(buf, CP_BUFSIZE, "#<c_pointer %p>", c_pointer(obj));
+      port_write_string(port)(sc, buf, clamp_length(nlen, CP_BUFSIZE), port);
+    }
+}
+
+static void random_state_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info_t *unused_ci)
+{
+  #define B_BUFSIZE 128
+  char buf[B_BUFSIZE];
+  int32_t nlen;
+#if WITH_GMP
+  if (use_write == P_READABLE)
+    nlen = snprintf(buf, B_BUFSIZE, "#<bignum random-state>");
+  else nlen = snprintf(buf, B_BUFSIZE, "#<random-state %p>", obj);
+#else
+  if (use_write == P_READABLE)
+    nlen = snprintf(buf, B_BUFSIZE, "(random-state %" PRIu64 " %" PRIu64 ")", random_seed(obj), random_carry(obj));
+  else nlen = snprintf(buf, B_BUFSIZE, "#<random-state %" PRIu64 " %" PRIu64 ">", random_seed(obj), random_carry(obj));
+#endif
+  port_write_string(port)(sc, buf, clamp_length(nlen, B_BUFSIZE), port);
+}
+
+static void display_fallback(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t unused_use_write, shared_info_t *unused_ci)
+{
+#if S7_DEBUGGING
+  print_debugging_state(sc, obj, port);
+#else
+  if (is_free(obj))
+    port_write_string(port)(sc, "<free cell!>", 12, port);
+  else port_write_string(port)(sc, "<unknown object!>", 17, port);
+#endif
+}
+
+static void unique_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t unused_use_write, shared_info_t *unused_ci)
+{
+  port_write_string(port)(sc, unique_name(obj), unique_name_length(obj), port);
+}
+
+static void undefined_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info_t *unused_ci)
+{
+  if ((obj != sc->undefined) &&
+      (use_write == P_READABLE))
+    {
+      port_write_string(port)(sc, "(with-input-from-string \"", 25, port);
+      port_write_string(port)(sc, undefined_name(obj), undefined_name_length(obj), port);
+      port_write_string(port)(sc, "\" read)", 7, port);
+    }
+  else port_write_string(port)(sc, undefined_name(obj), undefined_name_length(obj), port);
+}
+
+static void eof_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info_t *unused_ci)
+{
+  if (use_write == P_READABLE)
+    port_write_string(port)(sc, "(begin #<eof>)", 14, port);
+  else port_write_string(port)(sc, eof_name(obj), eof_name_length(obj), port);
+}
+
+static void counter_to_port(s7_scheme *sc, s7_pointer unused_obj, s7_pointer port, use_write_t unused_use_write, shared_info_t *unused_ci)
+{
+  port_write_string(port)(sc, "#<counter>", 10, port);
+}
+
+static void integer_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t unused_use_write, shared_info_t *unused_ci)
+{
+  if (has_number_name(obj))
+    {
+      if (is_string_port(port))
+	{
+	  if (port_position(port) + number_name_length(obj) < port_data_size(port))
+	    {
+	      memcpy((void *)(port_data(port) + port_position(port)), (void *)number_name(obj), number_name_length(obj));
+	      port_position(port) += number_name_length(obj);
+	    }
+	  else string_write_string_resized(sc, number_name(obj), number_name_length(obj), port);
+	}
+      else port_write_string(port)(sc, number_name(obj), number_name_length(obj), port);
+    }
+  else
+    {
+      s7_int nlen = 0;
+      const char *str = integer_to_string(sc, integer(obj), &nlen);
+      set_number_name(obj, str, nlen);
+      port_write_string(port)(sc, str, nlen, port);
+    }
+}
+
+static void number_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info_t *unused_ci)
+{
+  if (has_number_name(obj))
+    port_write_string(port)(sc, number_name(obj), number_name_length(obj), port);
+  else
+    {
+      s7_int nlen = 0;
+      char *str = number_to_string_base_10(sc, obj, 0, sc->float_format_precision, 'g', &nlen, use_write); /* was 14 */
+      if ((nlen < NUMBER_NAME_SIZE) &&
+	  (str[0] != 'n') && (str[0] != 'i') &&
+	  ((!(is_t_complex(obj))) ||
+	   ((!is_NaN(imag_part(obj))) && (!is_inf(imag_part(obj))))))
+	set_number_name(obj, str, nlen);
+      port_write_string(port)(sc, str, nlen, port);
+    }
+}
+
+#if WITH_GMP
+static void big_number_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info_t *unused_ci)
+{
+  s7_int nlen = 0;
+  block_t *str = big_number_to_string_with_radix(sc, obj, BASE_10, 0, &nlen, use_write);
+  port_write_string(port)(sc, (char *)block_data(str), nlen, port);
+  liberate(sc, str);
+}
+#endif
+
+static void syntax_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t unused_use_write, shared_info_t *unused_ci)
+{
+  port_write_string(port)(sc, "#_", 2, port);
+  port_display(port)(sc, symbol_name(syntax_symbol(obj)), port);
+}
+
+static void character_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info_t *unused_ci)
+{
+  if (use_write == P_DISPLAY)
+    port_write_character(port)(sc, character(obj), port);
+  else port_write_string(port)(sc, character_name(obj), character_name_length(obj), port);
+}
+
+static void closure_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info_t *ci)
+{
+  if (has_active_methods(sc, obj))
+    {
+      /* look for object->string method else fallback on ordinary case.
+       * can't use recursion on closure_let here because then the fallback name is #<let>.
+       * this is tricky!: (display (openlet (with-let (mock-c-pointer 0) (lambda () 1))))
+       *   calls object->string on the closure whose closure_let is the mock-c-pointer;
+       *   it has an object->string method that clears mock-c-pointers and tries again...
+       *   so, display methods need to use coverlet/openlet.
+       */
+      s7_pointer print_func = find_method(sc, closure_let(obj), sc->object_to_string_symbol);
+      if (print_func != sc->undefined)
+	{
+	  s7_pointer p = s7_apply_function(sc, print_func, set_plist_1(sc, obj));
+	  if (string_length(p) > 0)
+	    port_write_string(port)(sc, string_value(p), string_length(p), port);
+	  return;
+	}}
+  if (use_write == P_READABLE)
+    write_closure_readably(sc, obj, port, ci);
+  else write_closure_name(sc, obj, port);
+}
+
+static void macro_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info_t *unused_ci)
+{
+  if (has_active_methods(sc, obj))
+    {
+      s7_pointer print_func = find_method(sc, closure_let(obj), sc->object_to_string_symbol);
+      if (print_func != sc->undefined)
+	{
+	  s7_pointer p = s7_apply_function(sc, print_func, set_plist_1(sc, obj));
+	  if (string_length(p) > 0)
+	    port_write_string(port)(sc, string_value(p), string_length(p), port);
+	  return;
+	}}
+  if (use_write == P_READABLE)
+    write_macro_readably(sc, obj, port);
+  else write_closure_name(sc, obj, port);
+}
+
+static void c_function_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info_t *unused_ci)
+{
+  s7_pointer sym = c_function_name_to_symbol(sc, obj);
+  s7_pointer local_val = lookup_unexamined(sc, sym); /* lookup here really needs the env where sym is defined */
+  s7_int len = c_function_name_length(obj);
+
+  if ((!is_global(sym)) &&
+      (initial_value(sym) != sc->undefined) &&
+      ((use_write == P_READABLE) || ((local_val) && (local_val != initial_value(sym)))))
+    {
+      /* this is not ideal, but normally the initial_value == global_value (so we can't set a bit there), and the slot
+       *   is not accessible here, so we can't tell that the #_ value was used (and probably needed) in the original code.
+       */
+      port_write_string(port)(sc, "#_", 2, port);
+      port_write_string(port)(sc, c_function_name(obj), len, port);
+      return;
+    }
+  if (is_string_port(port)) /* expand port_write_string -> string_write_string, 15 in tauto */
+    {
+      if (len > 0)
+	{
+	  if (port_position(port) + len < port_data_size(port))
+	    {
+	      memcpy((void *)(port_data(port) + port_position(port)), (const void *)c_function_name(obj), len);
+	      port_position(port) += len;
+	    }
+	  else string_write_string_resized(sc, c_function_name(obj), len, port);
+	}
+      else port_write_string(port)(sc, "#<c-function>", 13, port);
+    }
+  else
+    if (len > 0)
+      port_write_string(port)(sc, c_function_name(obj), len, port);
+    else port_write_string(port)(sc, "#<c-function>", 13, port);
+}
+
+static void c_macro_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t unused_use_write, shared_info_t *unused_ci)
+{
+  /* should this check initial_value and so on as in c_function_to_port above? */
+  if (c_macro_name_length(obj) > 0)
+    {
+      port_write_string(port)(sc, "#_", 2, port);
+      port_write_string(port)(sc, c_macro_name(obj), c_macro_name_length(obj), port);
+    }
+  else port_write_string(port)(sc, "#<c-macro>", 10, port);
+}
+
+static void continuation_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t unused_use_write, shared_info_t *unused_ci)
+{
+  if (is_symbol(continuation_name(obj)))
+    {
+      port_write_string(port)(sc, "#<continuation ", 15, port);
+      symbol_to_port(sc, continuation_name(obj), port, P_DISPLAY, NULL);
+      port_write_character(port)(sc, '>', port);
+    }
+  else port_write_string(port)(sc, "#<continuation>", 15, port);
+}
+
+static void goto_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t unused_use_write, shared_info_t *unused_ci)
+{
+  if (is_symbol(call_exit_name(obj)))
+    {
+      port_write_string(port)(sc, "#<goto ", 7, port);
+      symbol_to_port(sc, call_exit_name(obj), port, P_DISPLAY, NULL);
+      port_write_character(port)(sc, '>', port);
+    }
+  else port_write_string(port)(sc, "#<goto>", 7, port);
+}
+
+static void catch_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info_t *ci)
+{
+  port_write_string(port)(sc, "#<catch: ", 9, port);
+  object_to_port(sc, catch_tag(obj), port, use_write, ci);
+  port_write_character(port)(sc, '>', port);
+}
+
+static void dynamic_wind_to_port(s7_scheme *sc, s7_pointer unused_obj, s7_pointer port, use_write_t unused_use_write, shared_info_t *unused_ci)
+{
+  /* this can happen because (*s7* 'stack) can involve dynamic-wind markers */
+  port_write_string(port)(sc, "#<dynamic-wind>", 15, port);
+}
+
+static void c_object_name_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port)
+{
+  port_write_string(port)(sc, string_value(c_object_scheme_name(sc, obj)), string_length(c_object_scheme_name(sc, obj)), port);
+}
+
+static void c_object_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info_t *ci)
+{
+#if (!DISABLE_DEPRECATED)
+  if (c_object_print(sc, obj))
+    {
+      char *str = ((*(c_object_print(sc, obj)))(sc, c_object_value(obj)));
+      port_display(port)(sc, str, port);
+      free(str);
+      return;
+    }
+#endif
+  if (c_object_to_string(sc, obj)) /* plist here and below can clobber args if SHOW_EVAL_ARGS */
+    port_display(port)(sc, s7_string((*(c_object_to_string(sc, obj)))(sc, set_mlist_2(sc, obj, (use_write == P_READABLE) ? sc->readable_keyword : sc->T))), port);
+  else
+    {
+      if ((use_write == P_READABLE) &&
+	  (c_object_to_list(sc, obj)) &&  /* to_list and (implicit) set are needed to reconstruct a cyclic c-object, as well as the maker (via type name) */
+	  (c_object_set(sc, obj)))
+	{
+	  int32_t href;
+	  s7_pointer old_w = sc->w;
+	  s7_pointer obj_list = ((*(c_object_to_list(sc, obj)))(sc, set_mlist_1(sc, obj)));
+	  s7_pointer p = obj_list;
+	  sc->w = obj_list;
+	  if ((ci) &&
+	      (is_cyclic(obj)) &&
+	      ((href = peek_shared_ref(ci, obj)) != 0))
+	    {
+	      if (href < 0) href = -href;
+	      if ((ci->defined[href]) || (port == ci->cycle_port))
+		{
+		  char buf[128];
+		  int32_t nlen = catstrs_direct(buf, "<", pos_int_to_str_direct(sc, href), ">", (const char *)NULL);
+		  port_write_string(port)(sc, buf, nlen, port);
+		  return;
+		}
+	      port_write_character(port)(sc, '(', port);
+	      c_object_name_to_port(sc, obj, port);
+	      for (int32_t i = 0; is_pair(p); i++, p = cdr(p))
+		{
+		  s7_pointer val = car(p);
+		  if (has_structure(val))
+		    {
+		      char buf[128];
+		      int32_t symref;
+		      int32_t len = (int32_t)catstrs_direct(buf, "  (set! (<", pos_int_to_str_direct(sc, href), "> ", pos_int_to_str_direct_1(sc, i), ") ", (const char *)NULL);
+		      port_write_string(port)(sc, " #f", 3, port);
+		      port_write_string(ci->cycle_port)(sc, buf, len, ci->cycle_port);
+
+		      symref = peek_shared_ref(ci, val);
+		      if (symref != 0)
+			{
+			  if (symref < 0) symref = -symref;
+			  len = (int32_t)catstrs_direct(buf, "<", pos_int_to_str_direct(sc, symref), ">)\n", (const char *)NULL);
+			  port_write_string(ci->cycle_port)(sc, buf, len, ci->cycle_port);
+			}
+		      else
+			{
+			  object_to_port_with_circle_check(sc, val, ci->cycle_port, P_READABLE, ci);
+			  port_write_string(ci->cycle_port)(sc, ")\n", 2, ci->cycle_port);
+			}}
+		  else
+		    {
+		      port_write_character(port)(sc, ' ', port);
+		      object_to_port_with_circle_check(sc, val, port, P_READABLE, ci);
+		    }}}
+	  else
+	    {
+	      port_write_character(port)(sc, '(', port);
+	      c_object_name_to_port(sc, obj, port);
+	      for (p = obj_list; is_pair(p); p = cdr(p))
+		{
+		  s7_pointer val = car(p);
+		  port_write_character(port)(sc, ' ', port);
+		  object_to_port_with_circle_check(sc, val, port, P_READABLE, ci);
+		}}
+	  port_write_character(port)(sc, ')', port);
+	  sc->w = old_w;
+	}
+      else
+	{
+	  char buf[128];
+	  int32_t nlen;
+	  port_write_string(port)(sc, "#<", 2, port);
+	  c_object_name_to_port(sc, obj, port);
+	  nlen = snprintf(buf, 128, " %p>", obj);
+	  port_write_string(port)(sc, buf, clamp_length(nlen, 128), port);
+	}}
+}
+
+static void stack_to_port(s7_scheme *sc, const s7_pointer obj, s7_pointer port, use_write_t unused_use_write, shared_info_t *unused_ci)
+{
+  if (obj == sc->stack)
+    port_write_string(port)(sc, "#<current stack>", 16, port);
+  else port_write_string(port)(sc, "#<stack>", 8, port);
+}
+
+static void init_display_functions(void)
+{
+  for (int32_t i = 0; i < 256; i++) display_functions[i] = display_fallback;
+  display_functions[T_FLOAT_VECTOR] = float_vector_to_port;
+  display_functions[T_INT_VECTOR] =   int_vector_to_port;
+  display_functions[T_BYTE_VECTOR] =  byte_vector_to_port;
+  display_functions[T_VECTOR] =       vector_to_port;
+  display_functions[T_PAIR] =         pair_to_port;
+  display_functions[T_HASH_TABLE] =   hash_table_to_port;
+  display_functions[T_ITERATOR] =     iterator_to_port;
+  display_functions[T_LET] =          let_to_port;
+  display_functions[T_BOOLEAN] =      unique_to_port;
+  display_functions[T_NIL] =          unique_to_port;
+  display_functions[T_UNUSED] =       unique_to_port;
+  display_functions[T_UNSPECIFIED] =  unique_to_port;
+  display_functions[T_UNDEFINED] =    undefined_to_port;
+  display_functions[T_EOF] =          eof_to_port;
+  display_functions[T_INPUT_PORT] =   input_port_to_port;
+  display_functions[T_OUTPUT_PORT] =  output_port_to_port;
+  display_functions[T_COUNTER] =      counter_to_port;
+  display_functions[T_STACK] =        stack_to_port;
+  display_functions[T_INTEGER] =      integer_to_port;
+  display_functions[T_RATIO] =        number_to_port;
+  display_functions[T_REAL] =         number_to_port;
+  display_functions[T_COMPLEX] =      number_to_port;
+#if WITH_GMP
+  display_functions[T_BIG_INTEGER] =  big_number_to_port;
+  display_functions[T_BIG_RATIO] =    big_number_to_port;
+  display_functions[T_BIG_REAL] =     big_number_to_port;
+  display_functions[T_BIG_COMPLEX] =  big_number_to_port;
+#endif
+  display_functions[T_SYMBOL] =       symbol_to_port;
+  display_functions[T_SYNTAX] =       syntax_to_port;
+  display_functions[T_STRING] =       string_to_port;
+  display_functions[T_CHARACTER] =    character_to_port;
+  display_functions[T_CLOSURE] =      closure_to_port;
+  display_functions[T_CLOSURE_STAR] = closure_to_port;
+  display_functions[T_MACRO] =        macro_to_port;
+  display_functions[T_MACRO_STAR] =   macro_to_port;
+  display_functions[T_BACRO] =        macro_to_port;
+  display_functions[T_BACRO_STAR] =   macro_to_port;
+  display_functions[T_C_RST_NO_REQ_FUNCTION] = c_function_to_port;
+  display_functions[T_C_FUNCTION] =   c_function_to_port;
+  display_functions[T_C_FUNCTION_STAR] = c_function_to_port;
+  display_functions[T_C_MACRO] =      c_macro_to_port;
+  display_functions[T_C_POINTER] =    c_pointer_to_port;
+  display_functions[T_RANDOM_STATE] = random_state_to_port;
+  display_functions[T_CONTINUATION] = continuation_to_port;
+  display_functions[T_GOTO] =         goto_to_port;
+  display_functions[T_CATCH] =        catch_to_port;
+  display_functions[T_DYNAMIC_WIND] = dynamic_wind_to_port;
+  display_functions[T_C_OBJECT] =     c_object_to_port;
+  display_functions[T_SLOT] =         internal_slot_to_port;
+}
+
+static void object_to_port_with_circle_check_1(s7_scheme *sc, s7_pointer vr, s7_pointer port, use_write_t use_write, shared_info_t *ci)
+{
+  int32_t ref = (is_collected(vr)) ? shared_ref(ci, vr) : 0;
+  if (ref == 0)
+    object_to_port(sc, vr, port, use_write, ci);
+  else
+    {
+      char buf[32];
+      int32_t nlen;
+      if (ref > 0)
+	{
+	  if (use_write == P_READABLE)
+	    {
+	      if (ci->defined[ref])
+		{
+		  flip_ref(ci, vr);
+		  nlen = (int32_t)catstrs_direct(buf, "<", pos_int_to_str_direct(sc, ref), ">", (const char *)NULL);
+		  port_write_string(port)(sc, buf, nlen, port);
+		  return;
+		}
+	      object_to_port(sc, vr, port, P_READABLE, ci);
+	    }
+	  else
+	    { /* "normal" printout involving #n= and #n# */
+	      s7_int len = 0;
+	      char *p = pos_int_to_str(sc, (s7_int)ref, &len, '=');
+	      *--p = '#';
+	      port_write_string(port)(sc, p, len, port);
+	      object_to_port(sc, vr, port, not_p_display(use_write), ci);
+	    }}
+      else
+	if (use_write == P_READABLE)
+	  {
+	    nlen = (int32_t)catstrs_direct(buf, "<", pos_int_to_str_direct(sc, -ref), ">", (const char *)NULL);
+	    port_write_string(port)(sc, buf, nlen, port);
+	  }
+	else
+	  {
+	    s7_int len = 0;
+	    char *p = pos_int_to_str(sc, (s7_int)(-ref), &len, '#');
+	    *--p = '#';
+	    port_write_string(port)(sc, p, len, port);
+	  }}
+}
+
+static s7_pointer cyclic_out(s7_scheme *sc, s7_pointer obj, s7_pointer port, shared_info_t *ci)
+{
+  int32_t ref, len;
+  char buf[128];
+
+  ci->cycle_port = s7_open_output_string(sc);
+  ci->cycle_loc = gc_protect_1(sc, ci->cycle_port);
+
+  port_write_string(port)(sc, "(let (", 6, port);
+  for (int32_t i = 0; i < ci->top; i++)
+    {
+      ref = peek_shared_ref(ci, ci->objs[i]); /* refs may be in any order */
+      if (ref < 0) {ref = -ref; flip_ref(ci, ci->objs[i]);}
+      len = (int32_t)catstrs_direct(buf, (i == 0) ? "(<" : "\n      (<", pos_int_to_str_direct(sc, ref), "> ", (const char *)NULL);
+      port_write_string(port)(sc, buf, len, port);
+      ci->defined[ref] = false;
+      object_to_port_with_circle_check(sc, ci->objs[i], port, P_READABLE, ci);
+      port_write_character(port)(sc, ')', port);
+      ci->defined[ref] = true;
+      if (peek_shared_ref(ci, ci->objs[i]) > 0) flip_ref(ci, ci->objs[i]); /* ref < 0 -> use <%d> in object_to_port */
+    }
+  port_write_string(port)(sc, ")\n", 2, port);
+
+  if (ci->init_port != sc->F)
+    {
+      port_write_string(port)(sc, (const char *)(port_data(ci->init_port)), port_position(ci->init_port), port);
+      s7_close_output_port(sc, ci->init_port);
+      s7_gc_unprotect_at(sc, ci->init_loc);
+      ci->init_port = sc->F;
+    }
+
+  if (port_position(ci->cycle_port) > 0)     /* 0 if e.g. (object->string (object->let (rootlet)) :readable) */
+    port_write_string(port)(sc, (const char *)(port_data(ci->cycle_port)), port_position(ci->cycle_port), port);
+  s7_close_output_port(sc, ci->cycle_port);
+  s7_gc_unprotect_at(sc, ci->cycle_loc);
+  ci->cycle_port = sc->F;
+
+  if ((is_immutable(obj)) && (!is_let(obj)))
+    port_write_string(port)(sc, "  (immutable! ", 14, port);
+  else port_write_string(port)(sc, "  ", 2, port);
+
+  ref = peek_shared_ref(ci, obj);
+  if (ref == 0)
+    object_to_port_with_circle_check(sc, obj, port, P_READABLE, ci);
+  else
+    {
+      len = (int32_t)catstrs_direct(buf, "<", pos_int_to_str_direct(sc, (ref < 0) ? -ref : ref), ">", (const char *)NULL);
+      port_write_string(port)(sc, buf, len, port);
+    }
+
+  if ((is_immutable(obj)) && (!is_let(obj)))
+    port_write_string(port)(sc, "))\n", 3, port);
+  else port_write_string(port)(sc, ")\n", 2, port);
+  return(obj);
+}
+
+static void object_out_1(s7_scheme *sc, s7_pointer obj, s7_pointer strport, use_write_t choice)
+{
+  if (sc->object_out_locked)
+    object_to_port_with_circle_check(sc, T_Pos(obj), strport, choice, sc->circle_info);
+  else
+    {
+      shared_info_t *ci = load_shared_info(sc, T_Pos(obj), choice != P_READABLE, sc->circle_info);
+      if (ci)
+	{
+	  sc->object_out_locked = true;
+	  if (choice == P_READABLE)
+	    cyclic_out(sc, obj, strport, ci);
+	  else object_to_port_with_circle_check(sc, T_Pos(obj), strport, choice, ci);
+	  sc->object_out_locked = false;
+	}
+      else object_to_port(sc, obj, strport, choice, NULL);
+    }
+}
+
+static inline s7_pointer object_out(s7_scheme *sc, s7_pointer obj, s7_pointer strport, use_write_t choice)
+{
+  if ((has_structure(obj)) && (obj != sc->rootlet))
+    object_out_1(sc, obj, strport, choice);
+  else object_to_port(sc, obj, strport, choice, NULL);
+  return(obj);
+}
+
+static s7_pointer new_format_port(s7_scheme *sc)
+{
+  s7_pointer x = alloc_pointer(sc);
+  s7_int len = FORMAT_PORT_LENGTH;
+  block_t *block, *b;
+  set_full_type(x, T_OUTPUT_PORT);
+  b = mallocate_port(sc);
+  port_block(x) = b;
+  port_port(x) = (port_t *)block_data(b);
+  port_type(x) = STRING_PORT;
+  port_set_closed(x, false);
+  port_data_size(x) = len;
+  port_next(x) = NULL;
+  block = mallocate(sc, len);
+  port_data(x) = (uint8_t *)(block_data(block));
+  port_data_block(x) = block;
+  port_data(x)[0] = '\0';
+  port_position(x) = 0;
+  port_needs_free(x) = false;
+  port_port(x)->pf = &output_string_functions;
+#if S7_DEBUGGING
+  sc->format_ports_allocated++;
+#endif
+  return(x);
+}
+
+static inline s7_pointer open_format_port(s7_scheme *sc)
+{
+  s7_pointer x = sc->format_ports;
+  if (!x) return(new_format_port(sc));
+  sc->format_ports = (s7_pointer)(port_next(x));
+  port_position(x) = 0;
+  port_data(x)[0] = '\0';
+  return(x);
+}
+
+static void close_format_port(s7_scheme *sc, s7_pointer port)
+{
+  port_next(port) = (struct block_t *)(sc->format_ports);
+  sc->format_ports = port;
+}
+
+char *s7_object_to_c_string(s7_scheme *sc, s7_pointer obj)
+{
+  char *str;
+  s7_pointer strport;
+  s7_int len;
+
+  TRACK(sc);
+  if ((sc->safety > NO_SAFETY) &&
+      (!s7_is_valid(sc, obj)))
+    s7_warn(sc, 256, "the second argument to %s (the object): %p, is not an s7 object\n", __func__, obj);
+
+  strport = open_format_port(sc);
+  object_out(sc, T_Pos(obj), strport, P_WRITE);
+  len = port_position(strport);
+  if ((S7_DEBUGGING) && (len == 0)) fprintf(stderr, "%s[%d]: len == 0\n", __func__, __LINE__);
+  /* if (len == 0) {close_format_port(sc, strport); return(NULL);} */ /* probably never happens */
+  str = (char *)Malloc(len + 1);
+  memcpy((void *)str, (void *)port_data(strport), len);
+  str[len] = '\0';
+  close_format_port(sc, strport);
+  return(str);
+}
+
+static inline void restore_format_port(s7_scheme *sc, s7_pointer strport)
+{
+  block_t *block = inline_mallocate(sc, FORMAT_PORT_LENGTH);
+  port_data(strport) = (uint8_t *)(block_data(block));
+  port_data_block(strport) = block;
+  port_data(strport)[0] = '\0';
+  port_position(strport) = 0;
+  port_data_size(strport) = FORMAT_PORT_LENGTH;
+  port_needs_free(strport) = false;
+  close_format_port(sc, strport);
+}
+
+
+/* -------------------------------- object->string -------------------------------- */
+s7_pointer s7_object_to_string(s7_scheme *sc, s7_pointer obj, bool use_write) /* unavoidable backwards compatibility rigidity here */
+{
+  s7_pointer strport, res;
+
+  if ((sc->safety > NO_SAFETY) &&
+      (!s7_is_valid(sc, obj)))
+    s7_warn(sc, 256, "the second argument to %s (the object): %p, is not an s7 object\n", __func__, obj);
+
+  strport = open_format_port(sc);
+  object_out(sc, obj, strport, (use_write) ? P_WRITE : P_DISPLAY);
+
+  if (port_position(strport) >= port_data_size(strport))
+    res = block_to_string(sc, reallocate(sc, port_data_block(strport), port_position(strport) + 1), port_position(strport));
+  else res = block_to_string(sc, port_data_block(strport), port_position(strport));
+  restore_format_port(sc, strport);
+  return(res);
+}
+
+static s7_pointer g_object_to_string(s7_scheme *sc, s7_pointer args)
+{
+  #define H_object_to_string "(object->string obj (write #t) (max-len (*s7* 'most-positive-fixnum))) returns a string representation of obj."
+  #define Q_object_to_string s7_make_signature(sc, 4, \
+                               sc->is_string_symbol, sc->T, \
+                               s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_keyword_symbol), sc->is_integer_symbol)
+  use_write_t choice;
+  s7_pointer obj = car(args), strport, res;
+  s7_int out_len, pending_max = S7_INT64_MAX;
+  bool old_openlets = sc->has_openlets;
+
+  if (is_not_null(cdr(args)))
+    {
+      s7_pointer arg = cadr(args);
+      if (arg == sc->F) choice = P_DISPLAY;
+      else {if (arg == sc->T) choice = P_WRITE;
+	else {if (arg == sc->readable_keyword) choice = P_READABLE;
+	  else {if (arg == sc->display_keyword) choice = P_DISPLAY;
+	    else {if (arg == sc->write_keyword) choice = P_WRITE;
+	      else wrong_type_error_nr(sc, sc->object_to_string_symbol, 2, arg, wrap_string(sc, "a boolean or :readable", 22));}}}}
+
+      if (is_not_null(cddr(args)))
+	{
+	  arg = caddr(args);
+	  if (!s7_is_integer(arg))
+	    {
+	      if (choice == P_READABLE) /* (object->string #r(1 2 3) :readable "hi") */
+		wrong_type_error_nr(sc, sc->object_to_string_symbol, 3, arg, sc->type_names[T_INTEGER]);
+	      return(method_or_bust(sc, arg, sc->object_to_string_symbol, args, sc->type_names[T_INTEGER], 3));
+	    }
+	  if (s7_integer_clamped_if_gmp(sc, arg) < 0)
+	    out_of_range_error_nr(sc, sc->object_to_string_symbol, int_three, arg, a_non_negative_integer_string);
+	  pending_max = s7_integer_clamped_if_gmp(sc, arg);
+	}}
+  else choice = P_WRITE;
+  /* can't use s7_object_to_string here anymore because it assumes use_write arg is a boolean */
+
+  if (choice == P_READABLE)
+    sc->has_openlets = false; /* so (object->string obj :readable) ignores obj's object->string method -- is this a good idea? */
+  else check_method(sc, obj, sc->object_to_string_symbol, args);
+
+  strport = open_format_port(sc);
+  sc->objstr_max_len = pending_max;
+  object_out(sc, obj, strport, choice);
+  sc->objstr_max_len = S7_INT64_MAX;
+  out_len = port_position(strport);
+
+  if ((pending_max >= 0) &&
+      (out_len > pending_max))
+    {
+      if (choice == P_READABLE)  /* (object->string #r(1 2 3) :readable 4) */
+	{
+	  close_format_port(sc, strport);
+	  sc->has_openlets = old_openlets;
+	  out_of_range_error_nr(sc, sc->object_to_string_symbol, int_three, wrap_integer(sc, out_len), wrap_string(sc, "the readable string is too long", 31));
+	}
+      out_len = pending_max;
+      if (out_len < 3)
+	{
+	  close_format_port(sc, strport);
+	  sc->has_openlets = old_openlets;
+	  return(make_string_with_length(sc, "...", 3));
+	}
+      for (s7_int i = out_len - 3; i < out_len; i++)
+	port_data(strport)[i] = (uint8_t)'.';
+    }
+  if (out_len >= port_data_size(strport)) /* this can happen (but only == I think) */
+    res = block_to_string(sc, reallocate(sc, port_data_block(strport), out_len + 1), out_len);
+  else res = block_to_string(sc, port_data_block(strport), out_len);
+  restore_format_port(sc, strport);
+  sc->has_openlets = old_openlets;
+  return(res);
+}
+
+#if S7_DEBUGGING
+const char *s7_object_to_c_string_x(s7_scheme *sc, s7_pointer obj, s7_pointer urchoice);
+const char *s7_object_to_c_string_x(s7_scheme *sc, s7_pointer obj, s7_pointer urchoice) {return(string_value(g_object_to_string(sc, list_2(sc, obj, urchoice))));}
+#endif
+
+
+/* -------------------------------- newline -------------------------------- */
+void s7_newline(s7_scheme *sc, s7_pointer port)
+{
+  if (port != sc->F)
+    port_write_character(port)(sc, (uint8_t)'\n', port);
+}
+
+#define newline_char chars[(uint8_t)'\n']
+
+static s7_pointer g_newline(s7_scheme *sc, s7_pointer args)
+{
+  #define H_newline "(newline (port (current-output-port))) writes a carriage return to the port"
+  #define Q_newline s7_make_signature(sc, 2, sc->is_char_symbol, s7_make_signature(sc, 2, sc->is_output_port_symbol, sc->not_symbol))
+
+  s7_pointer port = (is_not_null(args)) ? car(args) : current_output_port(sc);
+  if (!is_output_port(port))
+    {
+      if (port == sc->F) return(newline_char);
+      check_method(sc, port, sc->newline_symbol, args);
+      sole_arg_wrong_type_error_nr(sc, sc->newline_symbol, port, an_output_port_or_f_string); /* 0 -> "zeroth" */
+    }
+  if (port_is_closed(port))
+    sole_arg_wrong_type_error_nr(sc, sc->newline_symbol, port, an_open_output_port_string);
+  s7_newline(sc, port);
+  return(newline_char);  /* return(sc->unspecified) until 28-Sep-17, but for example (display c) returns c */
+}
+
+static s7_pointer newline_p(s7_scheme *sc)
+{
+  s7_newline(sc, current_output_port(sc));
+  return(newline_char);
+}
+
+static s7_pointer newline_p_p(s7_scheme *sc, s7_pointer port)
+{
+  if (!is_output_port(port))
+    {
+      if (port == sc->F) return(newline_char);
+      return(method_or_bust_p(sc, port, sc->newline_symbol, an_output_port_string));
+    }
+  s7_newline(sc, port);
+  return(newline_char);
+}
+
+
+/* -------------------------------- write -------------------------------- */
+s7_pointer s7_write(s7_scheme *sc, s7_pointer obj, s7_pointer port)
+{
+  if (port != sc->F)
+    {
+      if (port_is_closed(port))
+	wrong_type_error_nr(sc, sc->write_symbol, 2, port, an_open_output_port_string);
+      object_out(sc, obj, port, P_WRITE);
+    }
+  return(obj);
+}
+
+static s7_pointer write_p_pp(s7_scheme *sc, s7_pointer x, s7_pointer port)
+{
+  if (!is_output_port(port))
+    {
+      if (port == sc->F) return(x);
+      check_method(sc, port, sc->write_symbol, set_mlist_2(sc, x, port));
+      wrong_type_error_nr(sc, sc->write_symbol, 2, port, an_output_port_or_f_string);
+    }
+  if (port_is_closed(port))
+    wrong_type_error_nr(sc, sc->write_symbol, 2, port, an_open_output_port_string);
+  return(object_out(sc, x, port, P_WRITE));
+}
+
+static s7_pointer g_write(s7_scheme *sc, s7_pointer args)
+{
+  #define H_write "(write obj (port (current-output-port))) writes (object->string obj) to the output port"
+  #define Q_write s7_make_signature(sc, 3, sc->T, sc->T, s7_make_signature(sc, 2, sc->is_output_port_symbol, sc->not_symbol))
+  check_method(sc, car(args), sc->write_symbol, args);
+  return(write_p_pp(sc, car(args), (is_pair(cdr(args))) ? cadr(args) : current_output_port(sc)));
+}
+
+static s7_pointer write_p_p(s7_scheme *sc, s7_pointer x)
+{
+  return((current_output_port(sc) == sc->F) ? x : object_out(sc, x, current_output_port(sc), P_WRITE));
+}
+
+
+/* -------------------------------- display -------------------------------- */
+s7_pointer s7_display(s7_scheme *sc, s7_pointer obj, s7_pointer port)
+{
+  if (port != sc->F)
+    {
+      if (port_is_closed(port))
+	wrong_type_error_nr(sc, sc->display_symbol, 2, port, an_open_output_port_string);
+      object_out(sc, obj, port, P_DISPLAY);
+    }
+  return(obj);
+}
+
+static s7_pointer display_p_pp(s7_scheme *sc, s7_pointer x, s7_pointer port)
+{
+  if (!is_output_port(port))
+    {
+      if (port == sc->F) return(x);
+      check_method(sc, port, sc->display_symbol, set_mlist_2(sc, x, port));
+      wrong_type_error_nr(sc, sc->display_symbol, 2, port, an_output_port_or_f_string);
+    }
+  if (port_is_closed(port))
+    wrong_type_error_nr(sc, sc->display_symbol, 2, port, an_open_output_port_string);
+  check_method(sc, x, sc->display_symbol, set_plist_2(sc, x, port));
+  return(object_out(sc, x, port, P_DISPLAY));
+}
+
+static s7_pointer g_display(s7_scheme *sc, s7_pointer args)
+{
+  #define H_display "(display obj (port (current-output-port))) prints obj"
+  #define Q_display s7_make_signature(sc, 3, sc->T, sc->T, s7_make_signature(sc, 2, sc->is_output_port_symbol, sc->not_symbol))
+  return(display_p_pp(sc, car(args), (is_pair(cdr(args))) ? cadr(args) : current_output_port(sc)));
+}
+
+static s7_pointer g_display_2(s7_scheme *sc, s7_pointer args) {return(display_p_pp(sc, car(args), cadr(args)));}
+
+static s7_pointer g_display_f(s7_scheme *unused_sc, s7_pointer args) {return(car(args));}
+
+static s7_pointer display_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  if (args == 2) /* not check_for_substring_temp(sc, expr) here -- display returns arg so can be immutable if substring_uncopied */
+    return((caddr(expr) == sc->F) ? sc->display_f : sc->display_2);
+  return(f);
+}
+
+static s7_pointer display_p_p(s7_scheme *sc, s7_pointer x)
+{
+  if (current_output_port(sc) == sc->F) return(x);
+  check_method(sc, x, sc->display_symbol, set_plist_1(sc, x));
+  return(object_out(sc, x, current_output_port(sc), P_DISPLAY));
+}
+
+/* display may not be following the spec: (display '("a" #\b)): ("a" #\b), whereas Guile says (a b) */
+
+
+/* -------------------------------- call-with-output-string -------------------------------- */
+static s7_pointer g_call_with_output_string(s7_scheme *sc, s7_pointer args)
+{
+  #define H_call_with_output_string "(call-with-output-string proc) opens a string port applies proc to it, then returns the collected output"
+  #define Q_call_with_output_string s7_make_signature(sc, 2, sc->is_string_symbol, s7_make_signature(sc, 2, sc->is_procedure_symbol, sc->is_macro_symbol))
+
+  s7_pointer port, proc = car(args);
+  if (is_let(proc))
+    check_method(sc, proc, sc->call_with_output_string_symbol, args);
+  if ((!is_any_procedure(proc)) ||        /* this disallows goto/continuation */
+      (!s7_is_aritable(sc, proc, 1)))
+    return(method_or_bust(sc, proc, sc->call_with_output_string_symbol, args, wrap_string(sc, "a procedure of one argument (the port)", 38), 1));
+
+  port = s7_open_output_string(sc);
+  push_stack(sc, OP_UNWIND_OUTPUT, sc->unused, port);     /* #<unused> here is a marker (needed) */
+  push_stack(sc, OP_GET_OUTPUT_STRING, sc->unused, port); /* args checked in call_with_exit */
+  push_stack(sc, OP_APPLY, list_1_unchecked(sc, port), proc);
+  return(sc->F);
+}
+
+
+/* -------------------------------- call-with-output-file -------------------------------- */
+static s7_pointer g_call_with_output_file(s7_scheme *sc, s7_pointer args)
+{
+  #define H_call_with_output_file "(call-with-output-file filename proc) opens filename and calls proc with the output port as its argument"
+  #define Q_call_with_output_file sc->pl_sf
+
+  s7_pointer port, file = car(args), proc = cadr(args);
+  if (!is_string(file))
+    return(method_or_bust(sc, file, sc->call_with_output_file_symbol, args, sc->type_names[T_STRING], 1));
+  if ((!is_any_procedure(proc)) ||
+      (!s7_is_aritable(sc, proc, 1)))
+    return(method_or_bust(sc, proc, sc->call_with_output_file_symbol, args, wrap_string(sc, "a procedure of one argument (the port)", 38), 2));
+
+  port = s7_open_output_file(sc, string_value(file), "w");
+  push_stack(sc, OP_UNWIND_OUTPUT, sc->unused, port); /* #<unused> here is a marker (needed) */
+  push_stack(sc, OP_APPLY, list_1_unchecked(sc, port), proc);
+  return(sc->F);
+}
+
+
+/* -------------------------------- with-output-to-string -------------------------------- */
+static s7_pointer g_with_output_to_string(s7_scheme *sc, s7_pointer args)
+{
+  #define H_with_output_to_string "(with-output-to-string thunk) opens a string as a temporary current-output-port, \
+calls thunk, then returns the collected output"
+  #define Q_with_output_to_string s7_make_signature(sc, 2, sc->is_string_symbol, s7_make_signature(sc, 2, sc->is_procedure_symbol, sc->is_macro_symbol))
+
+  s7_pointer old_output_port, proc = car(args);
+  if (!is_thunk(sc, proc))
+    {
+      if (is_any_procedure(proc))        /* i.e. c_function, lambda, macro, etc */
+	{
+	  s7_pointer req_args = wrap_integer(sc, procedure_required_args(sc, proc));
+	  error_nr(sc, sc->wrong_type_arg_symbol,
+		   set_elist_4(sc, wrap_string(sc, "~A requires ~D argument~P, but with-output-to-string's first argument should be a thunk", 87),
+			       proc, req_args, req_args));
+	}
+      else return(method_or_bust(sc, proc, sc->with_output_to_string_symbol, args, a_thunk_string, 1));
+    }
+  if ((is_continuation(proc)) || (is_goto(proc)))
+    wrong_type_error_nr(sc, sc->with_output_to_string_symbol, 1, proc, a_normal_procedure_string);
+
+  old_output_port = current_output_port(sc);
+  set_current_output_port(sc, s7_open_output_string(sc));
+  push_stack(sc, OP_UNWIND_OUTPUT, old_output_port, current_output_port(sc));
+  push_stack(sc, OP_GET_OUTPUT_STRING, old_output_port, current_output_port(sc));
+  push_stack(sc, OP_APPLY, sc->nil, proc);
+  return(sc->F);
+}
+
+
+/* -------------------------------- with-output-to-file -------------------------------- */
+static s7_pointer g_with_output_to_file(s7_scheme *sc, s7_pointer args)
+{
+  #define H_with_output_to_file "(with-output-to-file filename thunk) opens filename as the temporary current-output-port and calls thunk"
+  #define Q_with_output_to_file sc->pl_sf
+
+  s7_pointer old_output_port, file = car(args), proc = cadr(args);
+  if (!is_string(file))
+    return(method_or_bust(sc, file, sc->with_output_to_file_symbol, args, sc->type_names[T_STRING], 1));
+  if (!is_thunk(sc, proc))
+    {
+      if (is_any_procedure(proc))        /* i.e. c_function, lambda, macro, etc */
+	{
+	  s7_pointer req_args = wrap_integer(sc, procedure_required_args(sc, proc));
+	  error_nr(sc, sc->wrong_type_arg_symbol,
+		   set_elist_4(sc, wrap_string(sc, "~A requires ~D argument~P, but with-output-to-file's second argument should be a thunk", 86),
+			       proc, req_args, req_args));
+	}
+      else return(method_or_bust(sc, proc, sc->with_output_to_file_symbol, args, a_thunk_string, 2));
+    }
+  if ((is_continuation(proc)) || (is_goto(proc)))
+    wrong_type_error_nr(sc, sc->with_output_to_file_symbol, 1, proc, a_normal_procedure_string);
+
+  old_output_port = current_output_port(sc);
+  set_current_output_port(sc, s7_open_output_file(sc, string_value(file), "w"));
+  push_stack(sc, OP_UNWIND_OUTPUT, old_output_port, current_output_port(sc));
+  push_stack(sc, OP_APPLY, sc->nil, proc);
+  return(sc->F);
+}
+
+
+/* -------------------------------- format -------------------------------- */
+static /* inline */ s7_pointer copy_proper_list(s7_scheme *sc, s7_pointer lst);
+
+static noreturn void format_error_nr(s7_scheme *sc, const char *ur_msg, s7_int msg_len, const char *str, s7_pointer ur_args, format_data_t *fdat)
+{
+  s7_pointer x = NULL;
+  s7_pointer ctrl_str = (fdat->orig_str) ? fdat->orig_str : wrap_string(sc, str, safe_strlen(str));
+  s7_pointer args = (is_elist(ur_args)) ? copy_proper_list(sc, ur_args) : ur_args;
+  s7_pointer msg = wrap_string(sc, ur_msg, msg_len);
+  if (fdat->loc == 0)
+    {
+      if (is_pair(args))
+	x = set_elist_4(sc, format_string_1, ctrl_str, args, msg);                                 /* "~S ~{~S~^ ~}: ~A" */
+      else x = set_elist_3(sc, format_string_2, ctrl_str, msg);                                    /* "~S: ~A" */
+    }
+  else
+    if (is_pair(args))
+      x = set_elist_5(sc, format_string_3, ctrl_str, args, wrap_integer(sc, fdat->loc + 20), msg); /* "~S ~{~S~^ ~}~&~NT^: ~A" */
+    else x = set_elist_4(sc, format_string_4, ctrl_str, wrap_integer(sc, fdat->loc + 20), msg);    /* "~S~&~NT^: ~A" */
+  if (fdat->port)
+    {
+      close_format_port(sc, fdat->port);
+      fdat->port = NULL;
+    }
+  error_nr(sc, sc->format_error_symbol, x);
+}
+
+static void format_append_char(s7_scheme *sc, char c, s7_pointer port)
+{
+  port_write_character(port)(sc, c, port);
+  sc->format_column++;
+}
+
+static void format_append_newline(s7_scheme *sc, s7_pointer port)
+{
+  port_write_character(port)(sc, '\n', port);
+  sc->format_column = 0;
+}
+
+static void format_append_string(s7_scheme *sc, format_data_t *fdat, const char *str, s7_int len, s7_pointer port)
+{
+  port_write_string(port)(sc, str, len, port);
+  fdat->loc += len;
+  sc->format_column += len;
+}
+
+static void format_append_chars(s7_scheme *sc, format_data_t *fdat, char pad, s7_int chrs, s7_pointer port)
+{
+  if (is_string_port(port))
+    {
+      if ((port_position(port) + chrs) < port_data_size(port))
+	{
+	  local_memset((char *)port_data(port) + port_position(port), pad, chrs);
+	  port_position(port) += chrs;
+	}
+      else
+	{
+	  s7_int new_len = port_position(port) + chrs;
+	  resize_port_data(sc, port, new_len * 2);
+	  local_memset((char *)port_data(port) + port_position(port), pad, chrs);
+	  port_position(port) = new_len;
+	}
+      fdat->loc += chrs;
+      sc->format_column += chrs;
+    }
+  else
+    {
+      block_t *b = mallocate(sc, chrs + 1);
+      char *str = (char *)block_data(b);
+      local_memset((void *)str, pad, chrs);
+      str[chrs] = '\0';
+      format_append_string(sc, fdat, str, chrs, port);
+      liberate(sc, b);
+    }
+}
+
+static s7_int format_read_integer(s7_int *cur_i, s7_int str_len, const char *str)
+{
+  /* we know that str[*cur_i] is a digit */
+  s7_int i, lval = 0;
+  for (i = *cur_i; i < str_len - 1; i++)
+    {
+      int32_t dig = digits[(uint8_t)str[i]];
+      if (dig < 10)
+	{
+#if HAVE_OVERFLOW_CHECKS
+	  if ((multiply_overflow(lval, 10, &lval)) ||
+	      (add_overflow(lval, dig, &lval)))
+	    break;
+#else
+	  lval = dig + (lval * 10);
+#endif
+	}
+      else break;
+    }
+  *cur_i = i;
+  return(lval);
+}
+
+static void format_number(s7_scheme *sc, format_data_t *fdat, int32_t radix, s7_int width, s7_int precision, char float_choice, char pad, s7_pointer port)
+{
+  char *tmp;
+  block_t *b = NULL;
+  s7_int nlen = 0;
+  if (width < 0) width = 0;
+
+  /* precision choice depends on float_choice if it's -1 */
+  if (precision < 0)
+    {
+      if ((float_choice == 'e') ||
+	  (float_choice == 'f') ||
+	  (float_choice == 'g'))
+	precision = 6;
+      else
+	{
+	  int32_t typ = type(car(fdat->args)); /* in the "int" cases, precision depends on the arg type */
+	  precision = ((typ == T_INTEGER) || (typ == T_RATIO)) ? 0 : 6;
+	}}
+  /* should (format #f "~F" 1/3) return "1/3"?? in CL it's "0.33333334" */
+
+  if (pad != ' ')
+    {
+      char *padtmp;
+#if (!WITH_GMP)
+      if (radix == 10)
+	tmp = number_to_string_base_10(sc, car(fdat->args), width, precision, float_choice, &nlen, P_WRITE);
+      else
+#endif
+	{
+	  b = number_to_string_with_radix(sc, car(fdat->args), radix, width, precision, float_choice, &nlen);
+	  tmp = (char *)block_data(b);
+	}
+      padtmp = tmp;
+      while (*padtmp == ' ') (*(padtmp++)) = pad;
+      format_append_string(sc, fdat, tmp, nlen, port);
+      if ((WITH_GMP) || (radix != 10)) liberate(sc, b);
+    }
+  else
+    {
+#if (!WITH_GMP)
+      if (radix == 10)
+	tmp = number_to_string_base_10(sc, car(fdat->args), width, precision, float_choice, &nlen, P_WRITE);
+      else
+#endif
+	{
+	  b = number_to_string_with_radix(sc, car(fdat->args), radix, width, precision, float_choice, &nlen);
+	  tmp = (char *)block_data(b);
+	}
+      format_append_string(sc, fdat, tmp, nlen, port);
+      if ((WITH_GMP) || (radix != 10)) liberate(sc, b);
+    }
+  fdat->args = cdr(fdat->args);
+  fdat->ctr++;
+}
+
+static const char *ordinal[11] = {"zeroth", "first", "second", "third", "fourth", "fifth", "sixth", "seventh", "eighth", "ninth", "tenth"};
+static const s7_int ordinal_length[11] = {6, 5, 6, 5, 6, 5, 5, 7, 6, 5, 5};
+
+static void format_ordinal_number(s7_scheme *sc, format_data_t *fdat, s7_pointer port)
+{
+  s7_int num = s7_integer_clamped_if_gmp(sc, car(fdat->args));
+  if (num < 11)
+    format_append_string(sc, fdat, ordinal[num], ordinal_length[num], port);
+  else
+    {
+      s7_int nlen = 0;
+      const char *tmp = integer_to_string(sc, num, &nlen);
+      format_append_string(sc, fdat, tmp, nlen, port);
+      num = num % 100;
+      if ((num >= 11) && (num <= 13))
+	format_append_string(sc, fdat, "th", 2, port);
+      else
+	{
+	  num = num % 10;
+	  if (num == 1) format_append_string(sc, fdat, "st", 2, port);
+	  else
+	    if (num == 2) format_append_string(sc, fdat, "nd", 2, port);
+	    else
+	      if (num == 3) format_append_string(sc, fdat, "rd", 2, port);
+	      else format_append_string(sc, fdat, "th", 2, port);
+	}}
+  fdat->args = cdr(fdat->args);
+  fdat->ctr++;
+}
+
+static s7_int format_nesting(const char *str, char opener, char closer, s7_int start, s7_int end) /* start=i, end=str_len-1 */
+{
+  s7_int nesting = 1;
+  for (s7_int k = start + 2; k < end; k++)
+    if (str[k] == '~')
+      {
+	if (str[k + 1] == closer)
+	  {
+	    nesting--;
+	    if (nesting == 0)
+	      return(k - start - 1);
+	  }
+	else
+	  if (str[k + 1] == opener)
+	    nesting++;
+      }
+  return(-1);
+}
+
+static bool format_method(s7_scheme *sc, const char *str, format_data_t *fdat, s7_pointer port)
+{
+  s7_pointer func, obj = car(fdat->args);
+  char ctrl_str[3];
+
+  if ((!has_active_methods(sc, obj)) ||
+      ((func = find_method_with_let(sc, obj, sc->format_symbol)) == sc->undefined))
+    return(false);
+
+  ctrl_str[0] = '~';
+  ctrl_str[1] = str[0];
+  ctrl_str[2] = '\0';
+
+  if (port == obj)    /* a problem! we need the openlet port for format, but that's an infinite loop when it calls format again as obj */
+    s7_apply_function(sc, func, set_plist_3(sc, port, wrap_string(sc, ctrl_str, 2), wrap_string(sc, "#<format port>", 14)));
+  else s7_apply_function(sc, func, set_plist_3(sc, port, wrap_string(sc, ctrl_str, 2), obj));
+
+  fdat->args = cdr(fdat->args);
+  fdat->ctr++;
+  return(true);
+}
+
+static s7_int format_n_arg(s7_scheme *sc, const char *str, format_data_t *fdat, s7_pointer args)
+{
+  s7_int n;
+
+  if (is_null(fdat->args))          /* (format #f "~nT") */
+    format_error_nr(sc, "~~N: missing argument", 21, str, args, fdat);
+  if (!s7_is_integer(car(fdat->args)))
+    format_error_nr(sc, "~~N: integer argument required", 30, str, args, fdat);
+  n = s7_integer_clamped_if_gmp(sc, car(fdat->args));
+
+  if (n < 0)
+    format_error_nr(sc, "~~N value is negative?", 22, str, args, fdat);
+  if (n > sc->max_format_length)
+    format_error_nr(sc, "~~N value is too big", 20, str, args, fdat);
+
+  fdat->args = cdr(fdat->args);    /* I don't think fdat->ctr should be incremented here -- it's for (*s7* 'print-length) etc */
+  return(n);
+}
+
+static s7_int format_numeric_arg(s7_scheme *sc, const char *str, s7_int str_len, format_data_t *fdat, s7_int *i)
+{
+  s7_int old_i = *i;
+  s7_int width = format_read_integer(i, str_len, str);
+  if (width < 0)
+    {
+      if (str[old_i - 1] != ',') /* need branches here, not if-expr because format_error creates the permanent string */
+	format_error_nr(sc, "width is negative?", 18, str, fdat->args, fdat);
+      format_error_nr(sc, "precision is negative?", 22, str, fdat->args, fdat);
+    }
+  if (width > sc->max_format_length)
+    {
+      if (str[old_i - 1] != ',')
+	format_error_nr(sc, "width is too big", 16, str, fdat->args, fdat);
+      format_error_nr(sc, "precision is too big", 20, str, fdat->args, fdat);
+    }
+  return(width);
+}
+
+static format_data_t *open_format_data(s7_scheme *sc)
+{
+  format_data_t *fdat;
+  sc->format_depth++;
+  if (sc->format_depth >= sc->num_fdats)
+    {
+      int32_t new_num_fdats = sc->format_depth * 2;
+      sc->fdats = (format_data_t **)Realloc(sc->fdats, sizeof(format_data_t *) * new_num_fdats);
+      for (int32_t k = sc->num_fdats; k < new_num_fdats; k++) sc->fdats[k] = NULL;
+      sc->num_fdats = new_num_fdats;
+    }
+  fdat = sc->fdats[sc->format_depth];
+  if (!fdat)
+    {
+      fdat = (format_data_t *)Malloc(sizeof(format_data_t));
+      sc->fdats[sc->format_depth] = fdat;
+      fdat->curly_len = 0;
+      fdat->curly_str = NULL;
+      fdat->ctr = 0;
+    }
+  else
+    {
+      if (fdat->port)
+	close_format_port(sc, fdat->port);
+      if (fdat->strport)
+	close_format_port(sc, fdat->strport);
+    }
+  fdat->port = NULL;
+  fdat->strport = NULL;
+  fdat->loc = 0;
+  fdat->curly_arg = sc->nil;
+  return(fdat);
+}
+
+#if WITH_GMP
+static bool is_one_or_big_one(s7_scheme *sc, s7_pointer p)
+{
+  if (!is_big_number(p)) return(is_one(p));
+  if (is_t_big_integer(p)) return(mpz_cmp_ui(big_integer(p), 1) == 0);
+  if (is_t_big_real(p)) return(mpfr_cmp_d(big_real(p), 1.0) == 0);
+  return(false);
+}
+#else
+#define is_one_or_big_one(Sc, Num) is_one(Num)
+#endif
+
+static s7_pointer object_to_list(s7_scheme *sc, s7_pointer obj);
+
+static s7_pointer format_to_port_1(s7_scheme *sc, s7_pointer port, const char *str, s7_pointer args,
+				   s7_pointer *next_arg, bool with_result, bool columnized, s7_int len, s7_pointer orig_str)
+{
+  s7_int i, str_len;
+  format_data_t *fdat;
+  s7_pointer deferred_port;
+
+  if (len <= 0)
+    {
+      str_len = safe_strlen(str);
+      if (str_len == 0)
+	{
+	  if (is_not_null(args))
+	    error_nr(sc, sc->format_error_symbol,
+		     set_elist_2(sc, wrap_string(sc, "format control string is null, but there are arguments: ~S", 58), args));
+	  return(nil_string);
+	}}
+  else str_len = len;
+
+  fdat = open_format_data(sc);
+  fdat->args = args;
+  fdat->orig_str = orig_str;
+
+  if (with_result)
+    {
+      deferred_port = port;
+      port = open_format_port(sc);
+      fdat->port = port;
+    }
+  else deferred_port = sc->F;
+
+  for (i = 0; i < str_len - 1; i++)
+    {
+      if ((uint8_t)(str[i]) == (uint8_t)'~')
+	{
+	  use_write_t use_write;
+	  switch (str[i + 1])
+	    {
+	    case '%':                           /* -------- newline -------- */
+	      /* sbcl apparently accepts numeric args here (including 0) */
+	      if ((port_data(port)) &&
+		  (port_position(port) < port_data_size(port)))
+		{
+		  port_data(port)[port_position(port)++] = '\n';
+		  sc->format_column = 0;
+		}
+	      else format_append_newline(sc, port);
+	      i++;
+	      break;
+
+	    case '&':                           /* -------- conditional newline -------- */
+	      /* this only works if all output goes through format -- display/write for example do not update format_column */
+	      if (sc->format_column > 0)
+		format_append_newline(sc, port);
+	      i++;
+	      break;
+
+	    case '~':                           /* -------- tilde -------- */
+	      format_append_char(sc, '~', port);
+	      i++;
+	      break;
+
+	    case '\n':                          /* -------- trim white-space --------  so (format #f "hiho~\n") -> "hiho"! */
+	      for (i = i + 2; i <str_len - 1; i++)
+		if (!(white_space[(uint8_t)(str[i])]))
+		  {
+		    i--;
+		    break;
+		  }
+	      break;
+
+	    case '*':                           /* -------- ignore arg -------- */
+	      i++;
+	      if (is_null(fdat->args))          /* (format #f "~*~A") */
+		format_error_nr(sc, "can't skip argument!", 20, str, args, fdat);
+	      fdat->args = cdr(fdat->args);
+	      break;
+
+	    case '|':                           /* -------- exit if args nil or ctr > (*s7* 'print-length) -------- */
+	      if ((is_pair(fdat->args)) &&
+		  (fdat->ctr >= sc->print_length))
+		{
+		  format_append_string(sc, fdat, " ...", 4, port);
+		  fdat->args = sc->nil;
+		}
+	      /* fall through */
+
+	    case '^':                           /* -------- exit -------- */
+	      if (is_null(fdat->args))
+		{
+		  i = str_len;
+		  goto ALL_DONE;
+		}
+	      i++;
+	      break;
+
+	    case '@':                           /* -------- plural, 'y' or 'ies' -------- */
+	      i += 2;
+	      if ((str[i] != 'P') && (str[i] != 'p'))
+		format_error_nr(sc, "unknown '@' directive", 21, str, args, fdat);
+	      if (!is_pair(fdat->args))
+		format_error_nr(sc, "'@' directive argument missing", 30, str, args, fdat);
+	      if (!is_real(car(fdat->args)))        /* CL accepts non numbers here */
+		format_error_nr(sc, "'@P' directive argument is not a real number", 44, str, args, fdat);
+
+	      if (!is_one_or_big_one(sc, car(fdat->args)))
+		format_append_string(sc, fdat, "ies", 3, port);
+	      else format_append_char(sc, 'y', port);
+
+	      fdat->args = cdr(fdat->args);
+	      break;
+
+	    case 'P': case 'p':                 /* -------- plural in 's' -------- */
+	      if (!is_pair(fdat->args))
+		format_error_nr(sc, "'P' directive argument missing", 30, str, args, fdat);
+	      if (!is_real(car(fdat->args)))
+		format_error_nr(sc, "'P' directive argument is not a real number", 43, str, args, fdat);
+	      if (!is_one_or_big_one(sc, car(fdat->args)))
+		format_append_char(sc, 's', port);
+	      i++;
+	      fdat->args = cdr(fdat->args);
+	      break;
+
+	    case '{':                           /* -------- iteration -------- */
+	      {
+		s7_int curly_len;
+
+		if (is_null(fdat->args))
+		  format_error_nr(sc, "missing argument", 16, str, args, fdat);
+
+		if ((is_pair(car(fdat->args))) &&               /* any sequence is possible here */
+		    (s7_list_length(sc, car(fdat->args)) < 0))  /* (format #f "~{~a~e~}" (cons 1 2)) */
+		  format_error_nr(sc, "~{ argument is a dotted list", 28, str, args, fdat);
+
+		curly_len = format_nesting(str, '{', '}', i, str_len - 1);
+
+		if (curly_len == -1)
+		  format_error_nr(sc, "'{' directive, but no matching '}'", 34, str, args, fdat);
+		if (curly_len == 1)
+		  format_error_nr(sc, "~{~}' doesn't consume any arguments!", 36, str, args, fdat);
+
+		/* what about cons's here?  I can't see any way to specify the car or cdr of a cons within the format string */
+		if (is_not_null(car(fdat->args)))               /* (format #f "~{~A ~}" ()) -> "" */
+		  {
+		    s7_pointer curly_arg = object_to_list(sc, car(fdat->args)); /* if a pair (or non-sequence), this simply returns the original */
+		    /* perhaps use an iterator here -- rootlet->list is expensive! */
+		    if (is_pair(curly_arg))                    /* (format #f "~{~A ~}" #()) -> "" */
+		      {
+			char *curly_str = NULL;                /* this is the local (nested) format control string */
+			s7_pointer cycle_arg;
+
+			fdat->curly_arg = curly_arg;
+			if (curly_len > fdat->curly_len)
+			  {
+			    if (fdat->curly_str) free(fdat->curly_str);
+			    fdat->curly_len = curly_len;
+			    fdat->curly_str = (char *)Malloc(curly_len);
+			  }
+			curly_str = fdat->curly_str;
+			memcpy((void *)curly_str, (const void *)(str + i + 2), curly_len - 1);
+			curly_str[curly_len - 1] = '\0';
+
+			if ((sc->format_depth < sc->num_fdats - 1) &&
+			    (sc->fdats[sc->format_depth + 1]))
+			  sc->fdats[sc->format_depth + 1]->ctr = 0;
+
+			/* it's not easy to use an iterator here instead of a list (so object->list isn't needed above),
+			 *   because the curly brackets may enclose multiple arguments -- we would need to use
+			 *   iterators throughout this function.
+			 */
+			cycle_arg = curly_arg;
+			while (is_pair(curly_arg))
+			  {
+			    s7_pointer new_arg = sc->nil;
+			    format_to_port_1(sc, port, curly_str, curly_arg, &new_arg, false, columnized, curly_len - 1, NULL);
+			    if (curly_arg == new_arg)
+			      {
+				if (cdr(curly_arg) == curly_arg) break;
+				fdat->curly_arg = sc->nil;
+				format_error_nr(sc, "'{...}' doesn't consume any arguments!", 38, str, args, fdat);
+			      }
+			    curly_arg = new_arg;
+			    if ((!is_pair(curly_arg)) || (curly_arg == cycle_arg))
+			      break;
+			    cycle_arg = cdr(cycle_arg);
+			    format_to_port_1(sc, port, curly_str, curly_arg, &new_arg, false, columnized, curly_len - 1, NULL);
+			    curly_arg = new_arg;
+			  }
+			fdat->curly_arg = sc->nil;
+		      }
+		    else
+		      if (!is_null(curly_arg))
+			format_error_nr(sc, "'{' directive argument should be a list or something we can turn into a list", 76, str, args, fdat);
+		  }
+		i += (curly_len + 2); /* jump past the ending '}' too */
+		fdat->args = cdr(fdat->args);
+		fdat->ctr++;
+	      }
+	      break;
+
+	    case '}':
+	      format_error_nr(sc, "unmatched '}'", 13, str, args, fdat);
+
+	    case '$':
+	      use_write = P_CODE; /* affects when symbols but not keywords are quoted (symbol_to_port and hash_table_to_port) */
+	      goto OBJSTR;
+
+	    case 'W': case 'w':
+	      use_write = P_READABLE;
+	      goto OBJSTR;
+
+	    case 'S': case 's':
+	      use_write = P_WRITE;
+	      goto OBJSTR;
+
+	    case 'A': case 'a':
+	      use_write = P_DISPLAY;
+	    OBJSTR:                        /* object->string */
+	      {
+		s7_pointer obj, strport;
+		if (is_null(fdat->args))
+		  format_error_nr(sc, "missing argument", 16, str, args, fdat);
+		i++;
+		obj = car(fdat->args);
+		if ((use_write == P_READABLE) ||
+		    (!has_active_methods(sc, obj)) ||
+		    (!format_method(sc, (const char *)(str + i), fdat, port)))
+		  {
+		    bool old_openlets = sc->has_openlets;
+		    /* for the column check, we need to know the length of the object->string output */
+		    if (columnized)
+		      {
+			strport = open_format_port(sc);
+			fdat->strport = strport;
+		      }
+		    else strport = port;
+		    if (use_write == P_READABLE)
+		      sc->has_openlets = false;
+		    object_out(sc, obj, strport, use_write);
+		    if (use_write == P_READABLE)
+		      sc->has_openlets = old_openlets;
+		    if (columnized)
+		      {
+			if (port_position(strport) >= port_data_size(strport))
+			  resize_port_data(sc, strport, port_data_size(strport) * 2);
+			port_data(strport)[port_position(strport)] = '\0';
+			if (port_position(strport) > 0)
+			  format_append_string(sc, fdat, (const char *)port_data(strport), port_position(strport), port);
+			close_format_port(sc, strport);
+			fdat->strport = NULL;
+		      }
+		    fdat->args = cdr(fdat->args);
+		    fdat->ctr++;
+		  }}
+	      break;
+
+	      /* -------- numeric args -------- */
+	    case ':':
+	      i += 2;
+	      if ((str[i] != 'D') && (str[i] != 'd'))
+		format_error_nr(sc, "unknown ':' directive", 21, str, args, fdat);
+	      if (!is_pair(fdat->args))
+		format_error_nr(sc, "':D' directive argument missing", 31, str, args, fdat);
+	      if (!s7_is_integer(car(fdat->args)))
+		format_error_nr(sc, "':D' directive argument is not an integer", 41, str, args, fdat);
+	      if (s7_integer_clamped_if_gmp(sc, car(fdat->args)) < 0)
+		format_error_nr(sc, "':D' directive argument can't be negative", 41, str, args, fdat);
+	      format_ordinal_number(sc, fdat, port);
+	      break;
+
+	    case '0': case '1': case '2': case '3': case '4': case '5':
+	    case '6': case '7': case '8': case '9': case ',':
+	    case 'N': case 'n':
+
+	    case 'B': case 'b':
+	    case 'D': case 'd':
+	    case 'E': case 'e':
+	    case 'F': case 'f':
+	    case 'G': case 'g':
+	    case 'O': case 'o':
+	    case 'X': case 'x':
+
+	    case 'T': case 't':
+	    case 'C': case 'c':
+	      {
+		s7_int width = -1, precision = -1;
+		char pad = ' ';
+		i++;                                      /* str[i] == '~' */
+
+		if (isdigit((int32_t)(str[i])))
+		  width = format_numeric_arg(sc, str, str_len, fdat, &i);
+		else
+		  if ((str[i] == 'N') || (str[i] == 'n'))
+		    {
+		      i++;
+		      width = format_n_arg(sc, str, fdat, args);
+		    }
+		if (str[i] == ',')
+		  {
+		    i++;                                  /* is (format #f "~12,12D" 1) an error?  The precision (or is it the width?) has no use here */
+		    if (isdigit((int32_t)(str[i])))
+		      precision = format_numeric_arg(sc, str, str_len, fdat, &i);
+		    else
+		      if ((str[i] == 'N') || (str[i] == 'n'))
+			{
+			  i++;
+			  precision = format_n_arg(sc, str, fdat, args);
+			}
+		      else
+			if (str[i] == '\'')              /* (format #f "~12,'xD" 1) -> "xxxxxxxxxxx1" */
+			  {
+			    pad = str[i + 1];
+			    i += 2;
+			    if (i >= str_len)            /* (format #f "~,'") */
+			      format_error_nr(sc, "incomplete numeric argument", 27, str, args, fdat);
+			  }}  /* is (let ((str "~12,'xD")) (set! (str 5) #\null) (format #f str 1)) an error? */
+
+		switch (str[i])
+		  {
+		    /* -------- pad to column --------
+		     *   are columns numbered from 1 or 0?  there seems to be disagreement about this directive, does "space over to" mean including?
+		     */
+		  case 'T': case 't':
+		    if (width == -1) width = 0;
+		    if (precision == -1) precision = 0;
+		    if ((width > 0) || (precision > 0))         /* (format #f "a~8Tb") */
+		      {
+			/* (length (substring (format #f "~%~10T.") 1)) == (length (format #f "~10T."))
+			 * (length (substring (format #f "~%-~10T.~%") 1)) == (length (format #f "-~10T.~%"))
+			 */
+			if (precision > 0)
+			  {
+			    int32_t mult = (int32_t)(ceil((s7_double)(sc->format_column + 1 - width) / (s7_double)precision)); /* CLtL2 ("least positive int") */
+			    if (mult < 1) mult = 1;
+			    width += (precision * mult);
+			  }
+			width -= (sc->format_column + 1);
+			if (width > 0)
+			  format_append_chars(sc, fdat, pad, width, port);
+		      }
+		    break;
+
+		  case 'C': case 'c':
+		    {
+		      s7_pointer obj;
+
+		      if (is_null(fdat->args))
+			format_error_nr(sc, "~~C: missing argument", 21, str, args, fdat);
+		      /* the "~~" here and below protects against "~C" being treated as a directive */
+		      obj = car(fdat->args);
+		      if (!is_character(obj))
+			{
+			  if (!format_method(sc, (const char *)(str + i), fdat, port)) /* i stepped forward above */
+			    format_error_nr(sc, "'C' directive requires a character argument", 43, str, args, fdat);
+			}
+		      else
+			{
+			  /* here use_write is false, so we just add the char, not its name */
+			  if (width == -1)
+			    format_append_char(sc, character(obj), port);
+			  else
+			    if (width > 0)
+			      format_append_chars(sc, fdat, character(obj), width, port);
+
+			  fdat->args = cdr(fdat->args);
+			  fdat->ctr++;
+			}}
+		    break;
+
+		    /* -------- numbers -------- */
+		  case 'F': case 'f':
+		    if (is_null(fdat->args))
+		      format_error_nr(sc, "~~F: missing argument", 21, str, args, fdat);
+		    if (!(is_number(car(fdat->args))))
+		      {
+			if (!format_method(sc, (const char *)(str + i), fdat, port))
+			  format_error_nr(sc, "~~F: numeric argument required", 30, str, args, fdat);
+		      }
+		    else format_number(sc, fdat, 10, width, precision, 'f', pad, port);
+		    break;
+
+		  case 'G': case 'g':
+		    if (is_null(fdat->args))
+		      format_error_nr(sc, "~~G: missing argument", 21, str, args, fdat);
+		    if (!(is_number(car(fdat->args))))
+		      {
+			if (!format_method(sc, (const char *)(str + i), fdat, port))
+			  format_error_nr(sc, "~~G: numeric argument required", 30, str, args, fdat);
+		      }
+		    else format_number(sc, fdat, 10, width, precision, 'g', pad, port);
+		    break;
+
+		  case 'E': case 'e':
+		    if (is_null(fdat->args))
+		      format_error_nr(sc, "~~E: missing argument", 21, str, args, fdat);
+		    if (!(is_number(car(fdat->args))))
+		      {
+			if (!format_method(sc, (const char *)(str + i), fdat, port))
+			  format_error_nr(sc, "~~E: numeric argument required", 30, str, args, fdat);
+		      }
+		    else format_number(sc, fdat, 10, width, precision, 'e', pad, port);
+		    break;
+
+		    /* how to handle non-integer arguments in the next 4 cases?  clisp just returns
+		     *   the argument: (format nil "~X" 1.25) -> "1.25" which is perverse (ClTl2 p 581:
+		     *   "if arg is not an integer, it is printed in ~A format and decimal base")!!
+		     *   I think I'll use the type of the number to choose the output format.
+		     */
+		  case 'D': case 'd':
+		    if (is_null(fdat->args))
+		      format_error_nr(sc, "~~D: missing argument", 21, str, args, fdat);
+		    if (!(is_number(car(fdat->args))))
+		      {
+			/* (let () (require mockery.scm) (format #f "~D" ((*mock-number* 'mock-number) 123)))
+			 *    port here is a string-port, str has the width/precision data if the caller wants it,
+			 *    args is the current arg.  But format_number handles fdat->args and so on, so
+			 *    I think I'll pass the format method the current control string (str), the
+			 *    current object (car(fdat->args)), and the arglist (args), and assume it will
+			 *    return a (scheme) string.
+			 */
+			if (!format_method(sc, (const char *)(str + i), fdat, port))
+			  format_error_nr(sc, "~~D: numeric argument required", 30, str, args, fdat);
+		      }
+		    else format_number(sc, fdat, 10, width, precision, 'd', pad, port);
+		    break;
+
+		  case 'O': case 'o':
+		    if (is_null(fdat->args))
+		      format_error_nr(sc, "~~O: missing argument", 21, str, args, fdat);
+		    if (!(is_number(car(fdat->args))))
+		      {
+			if (!format_method(sc, (const char *)(str + i), fdat, port))
+			  format_error_nr(sc, "~~O: numeric argument required", 30, str, args, fdat);
+		      }
+		    else format_number(sc, fdat, 8, width, precision, 'o', pad, port);
+		    break;
+
+		  case 'X': case 'x':
+		    if (is_null(fdat->args))
+		      format_error_nr(sc, "~~X: missing argument", 21, str, args, fdat);
+		    if (!(is_number(car(fdat->args))))
+		      {
+			if (!format_method(sc, (const char *)(str + i), fdat, port))
+			  format_error_nr(sc, "~~X: numeric argument required", 30, str, args, fdat);
+		      }
+		    else format_number(sc, fdat, 16, width, precision, 'x', pad, port);
+		    break;
+
+		  case 'B': case 'b':
+		    if (is_null(fdat->args))
+		      format_error_nr(sc, "~~B: missing argument", 21, str, args, fdat);
+		    if (!(is_number(car(fdat->args))))
+		      {
+			if (!format_method(sc, (const char *)(str + i), fdat, port))
+			  format_error_nr(sc, "~~B: numeric argument required", 30, str, args, fdat);
+		      }
+		    else format_number(sc, fdat, 2, width, precision, 'b', pad, port);
+		    break;
+
+		  default:
+		    if (width > 0)
+		      format_error_nr(sc, "unused numeric argument", 23, str, args, fdat);
+		    format_error_nr(sc, "unimplemented format directive", 30, str, args, fdat);
+		  }}
+	      break;
+
+	    default:
+	      format_error_nr(sc, "unimplemented format directive", 30, str, args, fdat);
+	    }}
+      else /* str[i] is not #\~ */
+	{
+	  const char *p = (char *)strchr((const char *)(str + i + 1), (int)'~');
+	  s7_int j = (p) ? p - str : str_len;
+	  s7_int new_len = j - i;
+
+	  if ((port_data(port)) &&
+	      ((port_position(port) + new_len) < port_data_size(port)))
+	    {
+	      memcpy((void *)(port_data(port) + port_position(port)), (const void *)(str + i), new_len);
+	      port_position(port) += new_len;
+	    }
+	  else port_write_string(port)(sc, (const char *)(str + i), new_len, port);
+	  fdat->loc += new_len;
+	  sc->format_column += new_len;
+	  i = j - 1;
+	}}
+
+ ALL_DONE:
+  if (next_arg)
+    (*next_arg) = fdat->args;
+  else
+    if (is_not_null(fdat->args))
+      format_error_nr(sc, "too many arguments", 18, str, args, fdat);
+
+  if (i < str_len)
+    {
+      if (str[i] == '~')
+	format_error_nr(sc, "control string ends in tilde", 28, str, args, fdat);
+      format_append_char(sc, str[i], port);
+    }
+  sc->format_depth--;
+  if (with_result)
+    {
+      s7_pointer result;
+      if ((is_output_port(deferred_port)) &&
+	  (port_position(port) > 0))
+	{
+	  if (port_position(port) < port_data_size(port))
+	    port_data(port)[port_position(port)] = '\0';
+	  port_write_string(deferred_port)(sc, (const char *)port_data(port), port_position(port), deferred_port);
+	}
+      if (port_position(port) < port_data_size(port))
+	{
+	  if (port_position(port) == 0)
+	    result = nil_string;
+	  else
+	    {
+	      block_t *block = inline_mallocate(sc, FORMAT_PORT_LENGTH); /* for format port after turning current format block into a string */
+	      result = inline_block_to_string(sc, port_data_block(port), port_position(port));
+	      port_data_size(port) = FORMAT_PORT_LENGTH;
+	      port_data_block(port) = block;
+	      port_data(port) = (uint8_t *)(block_data(block));
+	      port_data(port)[0] = '\0';
+	      port_position(port) = 0;
+	    }}
+      else result = make_string_with_length(sc, (char *)port_data(port), port_position(port)); /* this can happen (s7test, pos/size=128) */
+      close_format_port(sc, port); /* i.e. return it to the fdat free list */
+      fdat->port = NULL;
+      return(result);
+    }
+  return(nil_string);
+}
+
+static bool is_columnizing(const char *str)  /* look for ~t ~,<int>T ~<int>,<int>t */
+{
+  for (const char *p = (const char *)str; (*p);)
+    if (*p++ == '~') /* this is faster than strchr */
+      {
+	char c = *p++;
+	if ((c == 't') || (c == 'T')) return(true);
+	if (!c) return(false);
+	if ((c == ',') || ((c >= '0') && (c <= '9')) || (c == 'n') || (c == 'N'))
+	  {
+	    while (((c >= '0') && (c <= '9')) || (c == 'n') || (c == 'N')) c = *p++;
+	    if ((c == 't') || (c == 'T')) return(true);
+	    if (!c) return(false);                       /* ~,1 for example */
+	    if (c == ',')
+	      {
+		c = *p++;
+		while (((c >= '0') && (c <= '9')) || (c == 'n') || (c == 'N')) c = *p++;
+		if ((c == 't') || (c == 'T')) return(true);
+		if (!c) return(false);
+	      }}}
+  return(false);
+}
+
+static s7_pointer g_format(s7_scheme *sc, s7_pointer args)
+{
+  #define H_format "(format out str . args) substitutes args into str sending the result to out. Most of \
+s7's format directives are taken from CL: ~% = newline, ~& = newline if the preceding output character was \
+no a newline, ~~ = ~, ~<newline> trims white space, ~* skips an argument, ~^ exits {} iteration if the arg list is exhausted, \
+~nT spaces over to column n, ~A prints a representation of any object, ~S is the same, but puts strings in double quotes, \
+~C prints a character, numbers are handled by ~F, ~E, ~G, ~B, ~O, ~D, and ~X with preceding numbers giving \
+spacing (and spacing character) and precision.  ~{ starts an embedded format directive which is ended by ~}: \n\
+\n\
+  >(format #f \"dashed: ~{~A~^-~}\" '(1 2 3))\n\
+  \"dashed: 1-2-3\"\n\
+\n\
+~P inserts \"s\" if the current it is not 1 or 1.0 (use ~@P for \"ies\" or \"y\").\n\
+~B is number->string in base 2, ~O in base 8, ~D base 10, ~X base 16,\n\
+~E: (format #f \"~E\" 100.1) -&gt; \"1.001000e+02\" (%e in C)\n\
+~F: (format #f \"~F\" 100.1) -&gt; \"100.100000\"   (%f in C)\n\
+~G: (format #f \"~G\" 100.1) -&gt; \"100.1\"        (%g in C)\n\
+\n\
+If the 'out' argument is not an output port (i.e. #f, #t, or ()), the resultant string is returned.  If it \
+is #t, the string is also sent to the current-output-port."
+
+  #define Q_format s7_make_circular_signature(sc, 2, 3, \
+                     sc->is_string_symbol, s7_make_signature(sc, 3, sc->is_output_port_symbol, sc->is_boolean_symbol, sc->is_null_symbol), sc->T)
+
+  s7_pointer pt = car(args), str;
+  if (is_null(pt))
+    {
+      pt = current_output_port(sc);          /* () -> (current-output-port) */
+      if (pt == sc->F)                       /*   otherwise () -> #f so we get a returned string, which is confusing */
+	return(nil_string);                  /*   was #f 18-Mar-24 */
+    }
+  sc->format_column = 0;
+  if (!((is_boolean(pt)) ||                  /* #f or #t */
+	((is_output_port(pt)) &&             /* (current-output-port) or call-with-open-file arg, etc */
+	 (!port_is_closed(pt)))))
+    return(method_or_bust(sc, pt, sc->format_symbol, args, an_output_port_string, 1));
+
+  str = cadr(args);
+  if (!is_string(str))
+    return(method_or_bust(sc, str, sc->format_symbol, args, sc->type_names[T_STRING], 2));
+  return(format_to_port_1(sc, (pt == sc->T) ? current_output_port(sc) : pt,
+			  string_value(str), cddr(args), NULL, !is_output_port(pt), true, string_length(str), str));
+}
+
+const char *s7_format(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer result = g_format(sc, args);
+  return((is_string(result)) ? string_value(result) : NULL);
+}
+
+static s7_pointer g_format_f(s7_scheme *sc, s7_pointer args)  /* port == #f, there are other args */
+{
+  s7_pointer str = cadr(args);
+  sc->format_column = 0;
+  if (!is_string(str))
+    return(method_or_bust(sc, str, sc->format_symbol, args, sc->type_names[T_STRING], 2));
+  return(format_to_port_1(sc, sc->F, string_value(str), cddr(args), NULL, true, true, string_length(str), str));
+}
+
+static s7_pointer g_format_just_control_string(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer pt = car(args);
+  s7_pointer str = cadr(args);
+  if (pt == sc->F)
+    return(str);
+
+  if (is_null(pt))
+    {
+      pt = current_output_port(sc);
+      if (pt == sc->F)
+	return(nil_string);
+    }
+  if (pt == sc->T)
+    {
+      if ((current_output_port(sc) != sc->F) && (string_length(str) != 0))
+	port_write_string(current_output_port(sc))(sc, string_value(str), string_length(str), current_output_port(sc));
+      return(str);
+    }
+  if ((!is_output_port(pt)) ||
+      (port_is_closed(pt)))
+    return(method_or_bust(sc, pt, sc->format_symbol, args, a_format_port_string, 1));
+
+  if (string_length(str) == 0)
+    return(nil_string);
+
+  port_write_string(pt)(sc, string_value(str), string_length(str), pt);
+  return(nil_string);
+}
+
+static s7_pointer g_format_as_objstr(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer func, obj = caddr(args);
+  if ((!has_active_methods(sc, obj)) ||
+      ((func = find_method_with_let(sc, obj, sc->format_symbol)) == sc->undefined))
+    return(s7_object_to_string(sc, obj, false));
+  return(s7_apply_function(sc, func, set_plist_3(sc, sc->F, cadr(args), obj)));
+}
+
+static s7_pointer g_format_no_column(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer pt = car(args), str;
+  if (is_null(pt))
+    {
+      pt = current_output_port(sc);
+      if (pt == sc->F)
+	return(nil_string);
+    }
+  if (!((is_boolean(pt)) ||
+	((is_output_port(pt)) &&             /* (current-output-port) or call-with-open-file arg, etc */
+	 (!port_is_closed(pt)))))
+    return(method_or_bust(sc, pt, sc->format_symbol, args, a_format_port_string, 1));
+
+  str = cadr(args);
+  sc->format_column = 0;
+  return(format_to_port_1(sc, (pt == sc->T) ? current_output_port(sc) : pt,
+			  string_value(str), cddr(args), NULL,
+			  !is_output_port(pt),   /* i.e. is boolean port so we're returning a string */
+			  false,                 /* we checked in advance that it is not columnized */
+			  string_length(str), str));
+}
+
+static s7_pointer format_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  if (args > 1)
+    {
+      const s7_pointer port = cadr(expr);
+      s7_pointer str_arg = caddr(expr);
+      if (is_string(str_arg))
+	{
+	  if ((args == 2) || (args == 3))
+	    {
+	      s7_int len;
+	      char *orig = string_value(str_arg);
+	      const char *p = strchr((const char *)orig, (int)'~');
+	      if (!p)
+		return((args == 2) ? sc->format_just_control_string : f);
+
+	      len = string_length(str_arg);
+	      if ((args == 2) &&
+		  (len > 1) &&
+		  (orig[len - 1] == '%') &&
+		  ((p - orig) == len - 2))
+		{
+		  orig[len - 2] = '\n';
+		  orig[len - 1] = '\0';
+		  string_length(str_arg) = len - 1;
+		  return(sc->format_just_control_string);
+		}
+	      if ((args == 3) &&
+		  (len == 2) &&
+		  (port == sc->F) &&
+		  (orig[0] == '~') &&
+		  ((orig[1] == 'A') || (orig[1] == 'a')))
+		return(sc->format_as_objstr);
+	    }
+	  /* this used to worry about optimized expr and particular cases -- why? I can't find a broken case */
+	  if (!is_columnizing(string_value(str_arg)))
+	    return(sc->format_no_column);
+	}
+      if (port == sc->F)
+	return(sc->format_f);
+    }
+  return(f);
+}
+
+
+#if WITH_SYSTEM_EXTRAS
+#include <fcntl.h>
+
+/* -------------------------------- directory? -------------------------------- */
+static bool is_directory_b_7p(s7_scheme *sc, s7_pointer p)
+{
+  if (!is_string(p))
+    sole_arg_wrong_type_error_nr(sc, sc->is_directory_symbol, p, sc->type_names[T_STRING]);
+  if (string_length(p) >= 2)
+    {
+      block_t *b = expand_filename(sc, string_value(p));
+      if (b)
+	{
+	  bool result = is_directory((char *)block_data(b));
+	  liberate(sc, b);
+	  return(result);
+	}}
+  return(is_directory(string_value(p)));
+}
+
+static s7_pointer g_is_directory(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_directory "(directory? str) returns #t if str is the name of a directory"
+  #define Q_is_directory s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_string_symbol)
+  return(make_boolean(sc, is_directory_b_7p(sc, car(args))));
+}
+
+/* -------------------------------- file-exists? -------------------------------- */
+static bool file_probe(const char *arg)
+{
+#if (!MS_WINDOWS)
+  return(access(arg, F_OK) == 0);
+#else
+  int32_t fd = open(arg, O_RDONLY, 0);
+  if (fd == -1) return(false);
+  close(fd);
+  return(true);
+#endif
+}
+
+static bool file_exists_b_7p(s7_scheme *sc, s7_pointer p)
+{
+  if (!is_string(p))
+    sole_arg_wrong_type_error_nr(sc, sc->file_exists_symbol, p, sc->type_names[T_STRING]);
+  if (string_length(p) >= 2)
+    {
+      block_t *b = expand_filename(sc, string_value(p));
+      if (b)
+	{
+	  bool result = file_probe((char *)block_data(b));
+	  liberate(sc, b);
+	  return(result);
+	}}
+  return(file_probe(string_value(p)));
+}
+
+static s7_pointer g_file_exists(s7_scheme *sc, s7_pointer args)
+{
+  #define H_file_exists "(file-exists? filename) returns #t if the file exists"
+  #define Q_file_exists s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_string_symbol)
+  return(make_boolean(sc, file_exists_b_7p(sc, car(args))));
+}
+
+/* -------------------------------- delete-file -------------------------------- */
+static s7_pointer g_delete_file(s7_scheme *sc, s7_pointer args)
+{
+  #define H_delete_file "(delete-file filename) deletes the file filename."
+  #define Q_delete_file s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_string_symbol)
+
+  s7_pointer name = car(args);
+  if (!is_string(name))
+    return(sole_arg_method_or_bust(sc, name, sc->delete_file_symbol, args, sc->type_names[T_STRING]));
+  if (string_length(name) > 2)
+    {
+      block_t *b = expand_filename(sc, string_value(name));
+      if (b)
+	{
+	  s7_int result = unlink((char *)block_data(b));
+	  liberate(sc, b);
+	  return(make_integer(sc, result));
+	}}
+  return(make_integer(sc, unlink(string_value(name))));
+}
+
+/* -------------------------------- getenv -------------------------------- */
+static s7_pointer g_getenv(s7_scheme *sc, s7_pointer args) /* r7rs says #f if no such variable. this used to return "" in that case, 6-May-22 */
+{
+  #define H_getenv "(getenv var) returns the value of an environment variable, or #f if none is found"
+  #define Q_getenv s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_string_symbol, sc->not_symbol), sc->is_string_symbol)
+
+  char *result;
+  s7_pointer name = car(args);
+  if (!is_string(name))
+    return(sole_arg_method_or_bust(sc, name, sc->getenv_symbol, args, sc->type_names[T_STRING]));
+  result = getenv(string_value(name));
+  return((result) ? s7_make_string(sc, result) : sc->F);
+}
+
+/* -------------------------------- system -------------------------------- */
+static s7_pointer g_system(s7_scheme *sc, s7_pointer args)
+{
+  #define H_system "(system command) executes the command.  If the optional second argument is #t, \
+system captures the output as a string and returns it."
+  #define Q_system s7_make_signature(sc, 3, s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_string_symbol), sc->is_string_symbol, sc->is_boolean_symbol)
+
+#ifdef __EMSCRIPTEN__
+  return s7_nil(sc);
+#else
+  s7_pointer name = car(args);
+
+  if (!is_string(name))
+    return(sole_arg_method_or_bust(sc, name, sc->system_symbol, args, sc->type_names[T_STRING]));
+
+  if ((is_pair(cdr(args))) &&
+      (cadr(args) == sc->T))
+    {
+      #define BUF_SIZE 256
+      char buf[BUF_SIZE];
+      char *str = NULL;
+      int32_t cur_len = 0, full_len = 0;
+      FILE *fd = popen(string_value(name), "r");
+      while (fgets(buf, BUF_SIZE, fd))
+	{
+	  s7_int buf_len = safe_strlen(buf);
+	  if (cur_len + buf_len >= full_len)
+	    {
+	      full_len += BUF_SIZE * 2;
+	      str = (str) ? (char *)Realloc(str, full_len) : (char *)Malloc(full_len);
+	    }
+	  memcpy((void *)(str + cur_len), (void *)buf, buf_len);
+	  cur_len += buf_len;
+ 	}
+      pclose(fd);
+      if (str)
+	{
+	  block_t *b = mallocate_block(sc);
+	  block_data(b) = (void *)str;
+	  block_set_index(b, TOP_BLOCK_LIST);
+#if S7_DEBUGGING
+	  sc->blocks_mallocated[TOP_BLOCK_LIST]++;
+#endif
+	  return(block_to_string(sc, b, cur_len));
+	}
+      return(nil_string);
+    }
+  return(make_integer(sc, system(string_value(name))));
+#endif
+}
+
+#if (MS_WINDOWS)
+
+#define WIN32_LEAN_AND_MEAN
+#define NOMINMAX
+#include <Windows.h>
+
+static s7_pointer c_directory_to_list(s7_scheme *sc, s7_pointer name)
+{
+  s7_pointer result;
+
+  if (!is_string(name))
+    method_or_bust(sc, name, sc->directory_to_list_symbol, list_1(sc, name), T_STRING, 0);
+
+  sc->w = sc->nil;
+  const char* dir = string_value(name);
+  WIN32_FIND_DATA findData;
+
+  //TODO: utf-8 support
+  HANDLE hand = FindFirstFileA(dir, &findData);
+  bool more = hand != INVALID_HANDLE_VALUE;
+
+  while(more)
+    {
+      sc->w = cons(sc, s7_make_string(sc, findData.cFileName), sc->w);
+      more = FindNextFileA(hand, &findData);
+    }
+
+  FindClose(hand);
+
+  result = sc->w;
+  sc->w = sc->nil;
+  return(result);
+}
+
+static s7_pointer g_directory_to_list(s7_scheme *sc, s7_pointer args)
+{
+  #define H_directory_to_list "(directory->list directory) returns the contents of the directory as a list of strings (filenames)."
+  #define Q_directory_to_list s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_string_symbol)
+  return(c_directory_to_list(sc, car(args)));
+}
+
+PF_TO_PF(directory_to_list, c_directory_to_list)
+
+#else
+#include <dirent.h>
+
+/* -------------------------------- directory->list -------------------------------- */
+static s7_pointer directory_to_list_1(s7_scheme *sc, const char *dir_name)
+{
+  s7_pointer result;
+  DIR *dpos;
+  sc->w = sc->nil;
+  if ((dpos = opendir(dir_name)))
+    {
+      struct dirent *dirp;
+      while ((dirp = readdir(dpos)))
+	sc->w = cons_unchecked(sc, s7_make_string(sc, dirp->d_name), sc->w);
+      closedir(dpos);
+    }
+  result = sc->w;
+  sc->w = sc->unused;
+  return(result);
+}
+
+static s7_pointer g_directory_to_list(s7_scheme *sc, s7_pointer args)
+{
+  #define H_directory_to_list "(directory->list directory) returns the contents of the directory as a list of strings (filenames)."
+  #define Q_directory_to_list s7_make_signature(sc, 2, sc->is_list_symbol, sc->is_string_symbol)   /* can return nil */
+
+  s7_pointer name = car(args);
+  if (!is_string(name))
+    return(method_or_bust_p(sc, name, sc->directory_to_list_symbol, sc->type_names[T_STRING]));
+  if (string_length(name) >= 2)
+    {
+      block_t *b = expand_filename(sc, string_value(name));
+      if (b)
+	{
+	  s7_pointer result = directory_to_list_1(sc, (char *)block_data(b));
+	  liberate(sc, b);
+	  return(result);
+	}}
+  return(directory_to_list_1(sc, string_value(name)));
+}
+
+/* -------------------------------- file-mtime -------------------------------- */
+static s7_pointer g_file_mtime(s7_scheme *sc, s7_pointer args)
+{
+  #define H_file_mtime "(file-mtime file): return the write date of file"
+  #define Q_file_mtime s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_string_symbol)
+
+  struct stat statbuf;
+  int32_t err;
+  s7_pointer name = car(args);
+
+  if (!is_string(name))
+    return(sole_arg_method_or_bust(sc, name, sc->file_mtime_symbol, args, sc->type_names[T_STRING]));
+  if (string_length(name) >= 2)
+    {
+      block_t *b = expand_filename(sc, string_value(name));
+      if (b)
+	{
+	  err = stat((char *)block_data(b), &statbuf);
+	  liberate(sc, b);
+	  if (err < 0)
+	    file_error_nr(sc, "file-mtime", strerror(errno), string_value(name));
+	  return(make_integer(sc, (s7_int)(statbuf.st_mtime)));
+	}}
+  err = stat(string_value(name), &statbuf);
+  if (err < 0)
+    file_error_nr(sc, "file-mtime", strerror(errno), string_value(name));
+  return(make_integer(sc, (s7_int)(statbuf.st_mtime)));
+}
+#endif
+#endif /* with_system_extras */
+
+
+/* -------------------------------- lists -------------------------------- */
+s7_pointer s7_cons(s7_scheme *sc, s7_pointer a, s7_pointer b)
+{
+  s7_pointer x;
+  new_cell(sc, x, T_PAIR | T_SAFE_PROCEDURE);
+  set_car(x, a);
+  set_cdr(x, b);
+  return(x);
+}
+
+static s7_pointer cons_unchecked(s7_scheme *sc, s7_pointer a, s7_pointer b)
+{
+  /* apparently slightly faster as a function? */
+  s7_pointer x;
+  new_cell_no_check(sc, x, T_PAIR | T_SAFE_PROCEDURE);
+  set_car(x, a);
+  set_cdr(x, b);
+  return(x);
+}
+
+static s7_pointer semipermanent_cons(s7_scheme *sc, s7_pointer a, s7_pointer b, uint64_t type)
+{
+  s7_pointer x = alloc_pointer(sc);
+  set_full_type(x, type | T_UNHEAP);
+  set_car(x, a);
+  unchecked_set_cdr(x, b);
+  return(x);
+}
+
+static s7_pointer semipermanent_list(s7_scheme *sc, s7_int len)
+{
+  s7_pointer p = sc->nil;
+  for (s7_int j = 0; j < len; j++)
+    p = semipermanent_cons(sc, sc->unused, p, T_PAIR | T_IMMUTABLE);
+  return(p);
+}
+
+s7_pointer s7_make_signature(s7_scheme *sc, s7_int len, ...)
+{
+  va_list ap;
+  s7_int i;
+  s7_pointer res = sc->nil;
+
+  for (i = 0; i < len; i++)
+    res = semipermanent_cons(sc, sc->unused, res, T_PAIR | T_IMMUTABLE);
+  va_start(ap, len);
+  i = 0;
+  for (s7_pointer p = res; is_pair(p); p = cdr(p), i++)
+    {
+      set_car(p, va_arg(ap, s7_pointer));
+      if ((!is_normal_symbol(car(p))) && (!is_boolean(car(p))) && (!is_pair(car(p))))
+	s7_warn(sc, 512, "s7_make_signature got an invalid entry %s at position %" ld64, display(car(p)), i);
+    }
+  va_end(ap);
+  return((s7_pointer)res);
+}
+
+s7_pointer s7_make_circular_signature(s7_scheme *sc, s7_int cycle_point, s7_int len, ...)
+{
+  va_list ap;
+  s7_int i;
+  s7_pointer p, res = sc->nil, back = NULL, end = NULL;
+
+  for (i = 0; i < len; i++)
+    res = semipermanent_cons(sc, sc->nil, res, T_PAIR | T_IMMUTABLE);
+  va_start(ap, len);
+  for (p = res, i = 0; is_pair(p); p = cdr(p), i++)
+    {
+      set_car(p, va_arg(ap, s7_pointer));
+      if ((!is_normal_symbol(car(p))) && (!is_boolean(car(p))) && (!is_pair(car(p))))
+	s7_warn(sc, 512, "s7_make_circular_signature got an invalid entry %s at position %" ld64, display(car(p)), i);
+      if (i == cycle_point) back = p;
+      if (i == (len - 1)) end = p;
+    }
+  va_end(ap);
+  if (end) unchecked_set_cdr(end, back);
+  if (i < len)
+    s7_warn(sc, 256, "s7_make_circular_signature got too few entries: %s\n", display(res));
+  return((s7_pointer)res);
+}
+
+
+bool s7_is_pair(s7_pointer p) {return(is_pair(p));}
+static s7_pointer is_pair_p_p(s7_scheme *sc, s7_pointer p) {return((is_pair(p)) ? sc->T : sc->F);}
+
+s7_pointer s7_car(s7_pointer p) {return(car(p));}
+s7_pointer s7_cdr(s7_pointer p) {return(cdr(p));}
+
+s7_pointer s7_cadr(s7_pointer p) {return(cadr(p));}
+s7_pointer s7_cddr(s7_pointer p) {return(cddr(p));}
+s7_pointer s7_cdar(s7_pointer p) {return(cdar(p));}
+s7_pointer s7_caar(s7_pointer p) {return(caar(p));}
+
+s7_pointer s7_caadr(s7_pointer p) {return(caadr(p));}
+s7_pointer s7_caddr(s7_pointer p) {return(caddr(p));}
+s7_pointer s7_cadar(s7_pointer p) {return(cadar(p));}
+s7_pointer s7_caaar(s7_pointer p) {return(caaar(p));}
+s7_pointer s7_cdadr(s7_pointer p) {return(cdadr(p));}
+s7_pointer s7_cdddr(s7_pointer p) {return(cdddr(p));}
+s7_pointer s7_cddar(s7_pointer p) {return(cddar(p));}
+s7_pointer s7_cdaar(s7_pointer p) {return(cdaar(p));}
+
+s7_pointer s7_caaadr(s7_pointer p) {return(caaadr(p));}
+s7_pointer s7_caaddr(s7_pointer p) {return(caaddr(p));}
+s7_pointer s7_caadar(s7_pointer p) {return(caadar(p));}
+s7_pointer s7_caaaar(s7_pointer p) {return(caaaar(p));}
+s7_pointer s7_cadadr(s7_pointer p) {return(cadadr(p));}
+s7_pointer s7_cadddr(s7_pointer p) {return(cadddr(p));}
+s7_pointer s7_caddar(s7_pointer p) {return(caddar(p));}
+s7_pointer s7_cadaar(s7_pointer p) {return(cadaar(p));}
+
+s7_pointer s7_cdaadr(s7_pointer p) {return(cdaadr(p));}
+s7_pointer s7_cdaddr(s7_pointer p) {return(cdaddr(p));}
+s7_pointer s7_cdadar(s7_pointer p) {return(cdadar(p));}
+s7_pointer s7_cdaaar(s7_pointer p) {return(cdaaar(p));}
+s7_pointer s7_cddadr(s7_pointer p) {return(cddadr(p));}
+s7_pointer s7_cddddr(s7_pointer p) {return(cddddr(p));}
+s7_pointer s7_cdddar(s7_pointer p) {return(cdddar(p));}
+s7_pointer s7_cddaar(s7_pointer p) {return(cddaar(p));}
+
+s7_pointer s7_set_car(s7_pointer p, s7_pointer q) {set_car(p, q); return(q);}
+s7_pointer s7_set_cdr(s7_pointer p, s7_pointer q) {set_cdr(p, q); return(q);}
+
+
+/* -------------------------------------------------------------------------------- */
+void s7_list_to_array(s7_scheme *sc, s7_pointer list, s7_pointer *array, int32_t len)
+{
+  int32_t i = 0;
+  for (s7_pointer p = list; is_pair(p); p = cdr(p), i++) array[i] = car(p);
+  for (; i < len; i++) array[i] = sc->undefined;
+}
+
+
+/* ---------------- tree-leaves ---------------- */
+static inline s7_int tree_len_1(s7_scheme *sc, s7_pointer p)
+{
+  s7_int sum;
+  if ((S7_DEBUGGING) && (tree_is_cyclic(sc, p))) {fprintf(stderr, "%s[%d]: tree is cyclic\n", __func__, __LINE__); abort();}
+  for (sum = 0; is_pair(p); p = cdr(p))
+    {
+      s7_pointer cp = car(p);
+      if ((!is_pair(cp)) ||
+	  (is_quote(car(cp))))
+	sum++;
+      else
+	{
+	  do {
+	    s7_pointer ccp = car(cp);
+	    if ((!is_pair(ccp)) ||
+		(is_quote(car(ccp))))
+	      sum++;
+	    else
+	      {
+		do {
+		  s7_pointer cccp = car(ccp);
+		  if ((!is_pair(cccp)) ||
+		      (is_quote(car(cccp))))
+		    sum++;
+		  else sum += tree_len_1(sc, cccp);
+		  ccp = cdr(ccp);
+		} while (is_pair(ccp));
+		if (!is_null(ccp)) sum++;
+	      }
+	    cp = cdr(cp);
+	    } while (is_pair(cp));
+	  if (!is_null(cp)) sum++;
+	}}
+  return((is_null(p)) ? sum : sum + 1);
+}
+
+static inline s7_int tree_len(s7_scheme *sc, s7_pointer p)
+{
+  if (is_null(p))
+    return(0);
+  if ((!is_pair(p)) ||
+      (is_quote(car(p))))
+    return(1);
+  return(tree_len_1(sc, p));
+}
+
+static s7_int tree_leaves_i_7p(s7_scheme *sc, s7_pointer p)
+{
+  if (!is_list(p))
+    sole_arg_wrong_type_error_nr(sc, sc->tree_leaves_symbol, p, a_list_string);
+  if ((sc->safety > NO_SAFETY) &&
+      (tree_is_cyclic(sc, p)))
+    error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "tree-leaves: tree is cyclic: ~S", 31), p));
+  return(tree_len(sc, p));
+}
+
+static s7_pointer tree_leaves_p_p(s7_scheme *sc, s7_pointer tree)
+{
+  return(make_integer(sc, tree_leaves_i_7p(sc, tree)));
+}
+
+static s7_pointer g_tree_leaves(s7_scheme *sc, s7_pointer args)
+{
+  #define H_tree_leaves "(tree-leaves tree) returns the number of leaves in the tree"
+  #define Q_tree_leaves s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_list_symbol)
+  return(tree_leaves_p_p(sc, car(args)));
+}
+
+
+/* ---------------- tree-memq ---------------- */
+static inline bool tree_memq_1(s7_scheme *sc, s7_pointer sym, s7_pointer tree)    /* sym need not be a symbol */
+{
+  if (is_quote(car(tree)))
+    return((!is_symbol(sym)) && (!is_pair(sym)) && (is_pair(cdr(tree))) && (sym == cadr(tree)));
+  do {
+    if (sym == car(tree))
+      return(true);
+
+    if (is_pair(car(tree)))
+      {
+	s7_pointer cp = car(tree);
+	if (is_quote(car(cp)))
+	  {
+	    if ((!is_symbol(sym)) && (!is_pair(sym)) && (is_pair(cdr(cp))) && (sym == cadr(cp)))
+	      return(true);
+	  }
+	else
+	  do {
+	      if (sym == car(cp))
+		return(true);
+	      if ((is_pair(car(cp))) && (tree_memq_1(sc, sym, car(cp))))
+		return(true);
+	      cp = cdr(cp);
+	      if (sym == cp)
+		return(true);
+	    } while (is_pair(cp));
+      }
+    tree = cdr(tree);
+    if (sym == tree)
+      return(true);
+  } while (is_pair(tree));
+  return(false);
+}
+
+bool s7_tree_memq(s7_scheme *sc, s7_pointer sym, s7_pointer tree)
+{
+  if (sym == tree) return(true);
+  if (!is_pair(tree)) return(false);
+  if ((sc->safety > NO_SAFETY) &&
+      (tree_is_cyclic(sc, tree)))
+    error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "tree-memq: tree is cyclic: ~S", 29), tree));
+  return(tree_memq_1(sc, sym, tree));
+}
+
+static s7_pointer g_tree_memq(s7_scheme *sc, s7_pointer args)
+{
+  #define H_tree_memq "(tree-memq obj tree) is a tree-oriented version of memq, but returning #t if the object is in the tree."
+  #define Q_tree_memq s7_make_signature(sc, 3, sc->is_boolean_symbol, sc->T, sc->is_list_symbol)
+  s7_pointer tree = cadr(args);
+  if (!is_list(tree))
+    wrong_type_error_nr(sc, sc->tree_memq_symbol, 2, tree, a_list_string);
+  return(make_boolean(sc, s7_tree_memq(sc, car(args), tree)));
+}
+
+
+/* ---------------- tree-set-memq ---------------- */
+static inline bool pair_set_memq(s7_scheme *sc, s7_pointer tree)
+{
+  while (true)
+    {
+      s7_pointer p = car(tree);
+      if (is_symbol(p))
+	{
+	  if (symbol_is_in_list(sc, p))
+	    return(true);
+	}
+      else
+	if ((is_unquoted_pair(p)) &&
+	    (pair_set_memq(sc, p)))
+	  return(true);
+      tree = cdr(tree);
+      if (!is_pair(tree)) break;
+    }
+  return((is_symbol(tree)) && (symbol_is_in_list(sc, tree)));
+}
+
+static bool tree_set_memq_b_7pp(s7_scheme *sc, s7_pointer syms, s7_pointer tree)
+{
+  bool non_symbols = false;
+  if (!is_list(syms))
+    wrong_type_error_nr(sc, sc->tree_set_memq_symbol, 1, syms, a_list_string);
+  if (is_null(syms)) return(false);
+  if (!is_list(tree))
+    wrong_type_error_nr(sc, sc->tree_set_memq_symbol, 2, tree, a_list_string);
+  if (is_null(tree)) return(false);
+  if (sc->safety > NO_SAFETY)
+    {
+      if (tree_is_cyclic(sc, syms))
+	error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "tree-set-memq: symbol list is cyclic: ~S", 40), syms));
+      if (tree_is_cyclic(sc, tree))
+	error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "tree-set-memq: tree is cyclic: ~S", 33), tree));
+    }
+  clear_symbol_list(sc);
+  for (s7_pointer p = syms; is_pair(p); p = cdr(p))
+    if (is_symbol(car(p)))
+      add_symbol_to_list(sc, car(p));
+    else non_symbols = true;
+
+  if /* ((!is_quote(car(tree))) && */ (pair_set_memq(sc, tree)) return(true);
+
+  if (non_symbols)
+    for (s7_pointer p = syms; is_pair(p); p = cdr(p))
+      if ((!is_symbol(car(p))) &&
+	  (s7_tree_memq(sc, car(p), tree)))
+	return(true);
+  return(false);
+}
+
+static s7_pointer tree_set_memq_p_pp(s7_scheme *sc, s7_pointer syms, s7_pointer tree)
+{
+  return(make_boolean(sc, tree_set_memq_b_7pp(sc, syms, tree)));
+}
+
+static s7_pointer g_tree_set_memq(s7_scheme *sc, s7_pointer args)
+{
+  #define H_tree_set_memq "(tree-set-memq symbols tree) returns #t if any of the list of symbols is in the tree"
+  #define Q_tree_set_memq s7_make_signature(sc, 3, sc->is_boolean_symbol, sc->is_list_symbol, sc->is_list_symbol)
+  return(make_boolean(sc, tree_set_memq_b_7pp(sc, car(args), cadr(args))));
+}
+
+static s7_pointer tree_set_memq_syms_direct(s7_scheme *sc, s7_pointer syms, s7_pointer tree)
+{
+  if (!is_list(tree))
+    wrong_type_error_nr(sc, sc->tree_set_memq_symbol, 2, tree, a_list_string);
+  if (is_null(tree)) return(sc->F);
+  if (is_quote(car(tree))) return(sc->F);
+  if ((sc->safety > NO_SAFETY) &&
+      (tree_is_cyclic(sc, tree)))
+    error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "tree-set-memq: tree is cyclic: ~S", 33), tree));
+  clear_symbol_list(sc);
+  for (s7_pointer p = syms; is_pair(p); p = cdr(p))
+    add_symbol_to_list(sc, car(p));
+  return(make_boolean(sc, pair_set_memq(sc, tree)));
+}
+
+static s7_pointer g_tree_set_memq_syms(s7_scheme *sc, s7_pointer args)
+{
+  return(tree_set_memq_syms_direct(sc, car(args), cadr(args))); /* need other form for pp */
+}
+
+static s7_pointer tree_set_memq_chooser(s7_scheme *sc, s7_pointer f, int32_t unused_args, s7_pointer expr)
+{
+  if ((is_proper_quote(sc, cadr(expr))) &&   /* not (tree-set-memq (quote) ...) */
+      (is_pair(cadadr(expr))))               /*  (tree-set-memq '(...)...) */
+    {
+      for (s7_pointer p = cadadr(expr); is_pair(p); p = cdr(p))
+	if (!is_symbol(car(p)))
+	  return(f);
+      return(sc->tree_set_memq_syms);
+    }
+  return(f);
+}
+
+
+/* ---------------- tree-count ---------------- */
+static s7_int tree_count(s7_scheme *sc, s7_pointer x, s7_pointer p, s7_int count)
+{
+  if (p == x) return(count + 1);
+  if ((!is_pair(p)) || (is_quote(car(p)))) return(count);
+  return(tree_count(sc, x, cdr(p), tree_count(sc, x, car(p), count)));
+}
+
+static inline s7_int tree_count_at_least(s7_scheme *sc, s7_pointer x, s7_pointer p, s7_int count, s7_int top)
+{
+  if (p == x) return(count + 1);
+  if ((!is_pair(p)) || (is_quote(car(p)))) return(count);
+  do {
+    count = tree_count_at_least(sc, x, car(p), count, top);
+    if (count >= top) return(count);
+    p = cdr(p);
+    if (p == x) return(count + 1);
+  } while (is_pair(p));
+  return(count);
+}
+
+static s7_pointer g_tree_count(s7_scheme *sc, s7_pointer args)
+{
+  #define H_tree_count "(tree-count obj tree max-count) returns how many times obj is in tree (using eq?), stopping at max-count (if specified)"
+  #define Q_tree_count s7_make_signature(sc, 4, sc->is_integer_symbol, sc->T, sc->is_list_symbol, sc->is_integer_symbol)
+  s7_pointer obj = car(args);
+  s7_pointer tree = cadr(args), count;
+
+  if (!is_pair(tree))
+    {
+      if ((is_pair(cddr(args))) &&
+	  (!s7_is_integer(caddr(args))))
+	wrong_type_error_nr(sc, sc->tree_count_symbol, 3, caddr(args), sc->type_names[T_INTEGER]);
+      if (is_null(tree)) return(int_zero);
+      wrong_type_error_nr(sc, sc->tree_count_symbol, 2, tree, a_list_string);
+    }
+  if ((sc->safety > NO_SAFETY) &&
+      (tree_is_cyclic(sc, tree)))
+    error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "tree-count: tree is cyclic: ~S", 30), tree));
+  if (is_null(cddr(args)))
+    return(make_integer(sc, tree_count(sc, obj, tree, 0)));
+  count = caddr(args);
+  if (!s7_is_integer(count))
+    wrong_type_error_nr(sc, sc->tree_count_symbol, 3, count, sc->type_names[T_INTEGER]);
+  return(make_integer(sc, tree_count_at_least(sc, obj, tree, 0, s7_integer_clamped_if_gmp(sc, count))));
+}
+
+
+/* -------------------------------- pair? -------------------------------- */
+static s7_pointer g_is_pair(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_pair "(pair? obj) returns #t if obj is a pair (a non-empty list)"
+  #define Q_is_pair sc->pl_bt
+  check_boolean_method(sc, is_pair, sc->is_pair_symbol, args);
+}
+
+
+/* -------------------------------- list? -------------------------------- */
+bool s7_is_list(s7_scheme *sc, s7_pointer p) {return(is_list(p));}
+
+static bool is_list_b(s7_pointer p) {return((is_pair(p)) || (type(p) == T_NIL));}
+
+static s7_pointer g_is_list(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_list "(list? obj) returns #t if obj is a pair or null"
+  #define Q_is_list sc->pl_bt
+  #define is_a_list(p) s7_is_list(sc, p)
+  check_boolean_method(sc, is_a_list, sc->is_list_symbol, args);
+}
+
+static s7_int proper_list_length(s7_pointer a)
+{
+  s7_int i = 0;
+  for (s7_pointer b = a; is_pair(b); i++, b = cdr(b)) {};
+  return(i);
+}
+
+static s7_int proper_list_length_with_end(s7_pointer a, s7_pointer *c)
+{
+  s7_int i = 0;
+  s7_pointer b;
+  for (b = a; is_pair(b); i++, b = cdr(b)) {};
+  *c = b;
+  return(i);
+}
+
+s7_int s7_list_length(s7_scheme *sc, s7_pointer a) /* returns -len if list is dotted, 0 if it's (directly) circular */
+{
+  s7_pointer slow = a, fast = a;
+  for (s7_int i = 0; ; i += 2)
+    {
+      if (!is_pair(fast)) return((is_null(fast)) ? i : -i);
+      fast = cdr(fast);
+      if (!is_pair(fast)) return((is_null(fast)) ? (i + 1) : (-i - 1)); /* if unrolled further, it's a lot slower? */
+      fast = cdr(fast);
+      slow = cdr(slow);
+      if (fast == slow)	return(0);
+    }
+  return(0);
+}
+
+
+/* -------------------------------- proper-list? -------------------------------- */
+static /* inline */ s7_pointer copy_proper_list(s7_scheme *sc, s7_pointer lst)
+{
+  s7_pointer tp;
+  if (!is_pair(lst)) return(sc->nil);
+  sc->temp5 = lst;
+  tp = list_1(sc, car(lst));
+  sc->temp8 = tp;
+  for (s7_pointer p = cdr(lst), np = tp; is_pair(p); p = cdr(p), np = cdr(np))
+    {
+      set_cdr(np, list_1_unchecked(sc, car(p)));
+      p = cdr(p);
+      if (is_pair(p)) {np = cdr(np); set_cdr(np, list_1_unchecked(sc, car(p)));} else break;
+      p = cdr(p);
+      if (is_pair(p)) {np = cdr(np); set_cdr(np, list_1(sc, car(p)));} else break;
+    }
+  sc->temp8 = sc->unused;
+  sc->temp5 = sc->unused;
+  return(tp);
+}
+
+bool s7_is_proper_list(s7_scheme *sc, s7_pointer lst)
+{
+  /* #t if () or undotted/non-circular pair */
+  s7_pointer slow = lst, fast = lst;
+  while (true)
+    {
+      if (!is_pair(fast))
+	return(is_null(fast)); /* else it's an improper list */
+      LOOP_4(fast = cdr(fast); if (!is_pair(fast)) return(is_null(fast)));
+      fast = cdr(fast);
+      slow = cdr(slow);
+      if (fast == slow) return(false);
+    }
+  return(true);
+}
+
+static s7_pointer g_is_proper_list(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_proper_list "(proper-list? x) returns #t is x is a list that is neither circular nor dotted."
+  #define Q_is_proper_list sc->pl_bt
+  return(make_boolean(sc, s7_is_proper_list(sc, car(args))));
+}
+
+static s7_pointer is_proper_list_p_p(s7_scheme *sc, s7_pointer arg) {return(make_boolean(sc, s7_is_proper_list(sc, arg)));}
+
+static bool is_proper_list_1(s7_scheme *sc, s7_pointer p) {return((is_pair(p)) && (is_null(cdr(p))));}
+static bool is_proper_list_2(s7_scheme *sc, s7_pointer p) {return((is_pair(p)) && (is_pair(cdr(p))) && (is_null(cddr(p))));}
+static bool is_proper_list_3(s7_scheme *sc, s7_pointer p) {return((is_pair(p)) && (is_pair(cdr(p))) && (is_pair(cddr(p))) && (is_null(cdddr(p))));}
+static bool is_proper_list_4(s7_scheme *unused_sc, s7_pointer p) {return(proper_list_length(p) == 4);}
+
+
+/* -------------------------------- make-list -------------------------------- */
+static s7_pointer make_big_list(s7_scheme *sc, s7_int len, s7_pointer init)
+{
+  s7_pointer res;                    /* expanding and using free_heap pointers as a block here is 10% faster */
+  check_free_heap_size(sc, len + 1); /* using cons_unchecked below, +1 in case we are on the trigger at the end */
+  sc->temp6 = sc->nil;               /* sc->temp6 used only here currently */
+  for (s7_int i = 0; i < len; i++) sc->temp6 = cons_unchecked(sc, init, sc->temp6);
+  res = sc->temp6;
+  sc->temp6 = sc->unused;
+  return(res);
+}
+
+static inline s7_pointer make_list(s7_scheme *sc, s7_int len, s7_pointer init)
+{
+  switch (len)
+    {
+    case 0: return(sc->nil);
+    case 1: return(T_Pair(cons(sc, init, sc->nil)));
+    case 2: return(T_Pair(cons_unchecked(sc, init, cons(sc, init, sc->nil))));
+    case 3: return(T_Pair(cons_unchecked(sc, init, cons_unchecked(sc, init, cons(sc, init, sc->nil)))));
+    case 4: return(T_Pair(cons_unchecked(sc, init, cons_unchecked(sc, init, cons_unchecked(sc, init, cons(sc, init, sc->nil))))));
+    case 5: return(T_Pair(cons_unchecked(sc, init, cons_unchecked(sc, init, cons_unchecked(sc, init, cons_unchecked(sc, init, cons(sc, init, sc->nil)))))));
+    case 6: return(T_Pair(cons_unchecked(sc, init, cons_unchecked(sc, init, cons_unchecked(sc, init,
+                    cons_unchecked(sc, init, cons_unchecked(sc, init, cons(sc, init, sc->nil))))))));
+    case 7: return(T_Pair(cons_unchecked(sc, init, cons_unchecked(sc, init, cons_unchecked(sc, init,
+		    cons_unchecked(sc, init, cons_unchecked(sc, init, cons_unchecked(sc, init, cons(sc, init, sc->nil)))))))));
+    default:
+      return(make_big_list(sc, len, init));
+    }
+  return(sc->nil); /* never happens, I hope */
+}
+
+s7_pointer s7_make_list(s7_scheme *sc, s7_int len, s7_pointer init) {return(make_list(sc, len, init));}
+
+static s7_pointer make_list_p_pp(s7_scheme *sc, s7_pointer n, s7_pointer init)
+{
+  s7_int len;
+  if (!s7_is_integer(n))
+    return(method_or_bust(sc, n, sc->make_list_symbol, set_plist_2(sc, n, init), sc->type_names[T_INTEGER], 1));
+
+  len = s7_integer_clamped_if_gmp(sc, n);
+#if WITH_GMP
+  if ((len == 0) && (!is_zero(n)))
+    out_of_range_error_nr(sc, sc->make_list_symbol, int_one, n, wrap_string(sc, "big integer is too big for s7_int", 33));
+#endif
+  if (len == 0) return(sc->nil);          /* what about (make-list 0 123)? */
+  if (len < 0)
+    out_of_range_error_nr(sc, sc->make_list_symbol, int_one, n, it_is_negative_string);
+  if (len > sc->max_list_length)
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_3(sc, wrap_string(sc, "make-list length argument ~D is greater than (*s7* 'max-list-length), ~D", 72),
+			 wrap_integer(sc, len), wrap_integer(sc, sc->max_list_length)));
+
+  return(make_list(sc, len, init));
+}
+
+static s7_pointer g_make_list(s7_scheme *sc, s7_pointer args)
+{
+  #define H_make_list "(make-list length (initial-element #f)) returns a list of 'length' elements whose value is 'initial-element'."
+  #define Q_make_list s7_make_signature(sc, 3, sc->is_proper_list_symbol, sc->is_integer_symbol, sc->T)
+  return(make_list_p_pp(sc, car(args), (is_pair(cdr(args))) ? cadr(args) : sc->F));
+}
+
+
+/* -------------------------------- list-ref -------------------------------- */
+s7_pointer s7_list_ref(s7_scheme *sc, s7_pointer lst, s7_int num)
+{
+  s7_int i;
+  s7_pointer x;
+  for (x = lst, i = 0; (i < num) && (is_pair(x)); i++, x = cdr(x)) {}
+  if ((i == num) && (is_pair(x)))
+    return(car(x));
+  return(sc->nil);
+}
+
+static s7_pointer list_ref_1(s7_scheme *sc, s7_pointer lst, s7_pointer ind)
+{
+  s7_int index;
+  s7_pointer p = lst;
+
+  if (!s7_is_integer(ind))
+    return(method_or_bust_pp(sc, ind, sc->list_ref_symbol, lst, ind, sc->type_names[T_INTEGER], 2));
+  index = s7_integer_clamped_if_gmp(sc, ind);
+  if ((index < 0) || (index > sc->max_list_length)) /* max-list-length check for circular list-ref? */
+    out_of_range_error_nr(sc, sc->list_ref_symbol, int_two, ind, (index < 0) ? it_is_negative_string : it_is_too_large_string);
+  for (s7_int i = 0; (i < index) && is_pair(p); i++, p = cdr(p)) {}
+  if (is_pair(p)) return(car(p));
+  if (is_null(p))
+    out_of_range_error_nr(sc, sc->list_ref_symbol, int_two, ind, it_is_too_large_string);
+  wrong_type_error_nr(sc, sc->list_ref_symbol, 1, lst, a_proper_list_string);
+  return(NULL);
+}
+
+static s7_pointer implicit_index(s7_scheme *sc, s7_pointer obj, s7_pointer indices);
+
+static s7_pointer ref_index_checked(s7_scheme *sc, s7_pointer caller, s7_pointer in_obj, s7_pointer args)
+{
+  if (!is_applicable(in_obj)) /* let implicit_index shuffle syntax and closures */
+    error_nr(sc, sc->syntax_error_symbol,
+	     set_elist_4(sc, wrap_string(sc, "~$ becomes ~$, but ~S can't take arguments", 42),
+			 cons(sc, caller, args), cons(sc, in_obj, cddr(args)), in_obj));
+  /* perhaps first $s -> "(~S ~{~$~^ ~})..." and we can pass the symbol rather than the global value as "caller" */
+  return(implicit_index(sc, in_obj, cddr(args)));
+}
+
+static s7_pointer g_list_ref(s7_scheme *sc, s7_pointer args)
+{
+  #define H_list_ref "(list-ref lst i ...) returns the i-th element (0-based) of the list"
+  #define Q_list_ref s7_make_circular_signature(sc, 2, 3, sc->T, sc->is_pair_symbol, sc->is_integer_symbol)
+  /* (let ((L '((1 2 3) (4 5 6)))) (list-ref L 1 2)) */
+
+  s7_pointer lst = car(args);
+  if (!is_pair(lst))
+    return(method_or_bust(sc, lst, sc->list_ref_symbol, args, sc->type_names[T_PAIR], 1));
+
+  lst = list_ref_1(sc, lst, cadr(args));
+  if (is_pair(cddr(args)))
+    return(ref_index_checked(sc, global_value(sc->list_ref_symbol), lst, args));
+  return(lst);
+}
+
+static bool op_implicit_pair_ref_a(s7_scheme *sc)
+{
+  s7_pointer s = lookup_checked(sc, car(sc->code));
+  if (!is_pair(s)) {sc->last_function = s; return(false);}
+  sc->value = list_ref_1(sc, s, fx_call(sc, cdr(sc->code)));
+  return(true);
+}
+
+static s7_pointer fx_implicit_pair_ref_a(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer s = lookup_checked(sc, car(arg));
+  if (!is_pair(s))
+    return(s7_apply_function(sc, s, list_1(sc, fx_call(sc, cdr(arg)))));
+  return(list_ref_1(sc, s, fx_call(sc, cdr(arg))));
+}
+
+static s7_pointer implicit_pair_index_checked(s7_scheme *sc, s7_pointer obj, s7_pointer in_obj, s7_pointer indices)
+{
+  if (!is_applicable(in_obj))
+    {
+      s7_pointer safe_indices = copy_proper_list(sc, indices);
+      error_nr(sc, sc->syntax_error_symbol,
+	       set_elist_4(sc, wrap_string(sc, "~$ becomes ~$, but ~S can't take arguments", 42),
+			   cons(sc, obj, safe_indices), cons(sc, in_obj, cdr(safe_indices)), in_obj));
+    }
+  return(implicit_index(sc, in_obj, cdr(indices)));
+}
+
+static bool op_implicit_pair_ref_aa(s7_scheme *sc)
+{
+  s7_pointer i1;
+  s7_pointer s = lookup_checked(sc, car(sc->code));
+  if (!is_pair(s)) {sc->last_function = s; return(false);}
+  sc->args = fx_call(sc, cddr(sc->code));
+  i1 = fx_call(sc, cdr(sc->code));
+  sc->value = implicit_pair_index_checked(sc, s, list_ref_1(sc, s, i1), set_plist_2(sc, i1, sc->args));
+  return(true);
+}
+
+static s7_pointer list_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  if (args == 2)
+    {
+      s7_pointer index = caddr(expr);
+      if (is_t_integer(index))
+	{
+	  if (integer(index) == 0) return(sc->list_ref_at_0);
+	  if (integer(index) == 1) return(sc->list_ref_at_1);
+	  if (integer(index) == 2) return(sc->list_ref_at_2);
+	}}
+  return(f);
+}
+
+static inline s7_pointer list_ref_p_pi_unchecked(s7_scheme *sc, s7_pointer p1, s7_int i1)
+{
+  s7_pointer p = p1;
+  if ((i1 < 0) || (i1 > sc->max_list_length))
+    out_of_range_error_nr(sc, sc->list_ref_symbol, int_two, wrap_integer(sc, i1), (i1 < 0) ? it_is_negative_string : it_is_too_large_string);
+  for (s7_int i = 0; ((is_pair(p)) && (i < i1)); i++, p = cdr(p));
+  if (!is_pair(p))
+    {
+      if (is_null(p))
+	out_of_range_error_nr(sc, sc->list_ref_symbol, int_two, wrap_integer(sc, i1), it_is_too_large_string);
+      wrong_type_error_nr(sc, sc->list_ref_symbol, 1, p1, a_proper_list_string);
+    }
+  return(car(p));
+}
+
+static s7_pointer list_ref_p_pi(s7_scheme *sc, s7_pointer p1, s7_int i1)
+{
+  if (!is_pair(p1))
+    wrong_type_error_nr(sc, sc->list_ref_symbol, 1, p1, sc->type_names[T_PAIR]);
+  return(list_ref_p_pi_unchecked(sc, p1, i1));
+}
+
+static s7_pointer list_ref_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  if (!is_pair(p1))
+    return(g_list_ref(sc, set_plist_2(sc, p1, p2)));
+  if (!s7_is_integer(p2))
+    wrong_type_error_nr(sc, sc->list_ref_symbol, 1, p2, sc->type_names[T_INTEGER]);
+  return(list_ref_p_pi_unchecked(sc, p1, s7_integer_clamped_if_gmp(sc, p2)));
+}
+
+
+/* -------------------------------- list-set! -------------------------------- */
+s7_pointer s7_list_set(s7_scheme *sc, s7_pointer lst, s7_int num, s7_pointer val)
+{
+  s7_int i;
+  s7_pointer x;
+  for (x = lst, i = 0; (i < num) && (is_pair(x)); i++, x = cdr(x)) {}
+  if ((i == num) &&
+      (is_pair(x)))
+    set_car(x, T_Ext(val));
+  return(val);
+}
+
+static s7_pointer g_list_set_1(s7_scheme *sc, s7_pointer lst, s7_pointer args, int32_t arg_num)
+{
+  #define H_list_set "(list-set! lst i ... val) sets the i-th element (0-based) of the list to val"
+  #define Q_list_set s7_make_circular_signature(sc, 3, 4, sc->T, sc->is_pair_symbol, sc->is_integer_symbol, sc->is_integer_or_any_at_end_symbol)
+
+  s7_int index;
+  s7_pointer p = lst, ind;
+  /* (let ((L '((1 2 3) (4 5 6)))) (list-set! L 1 2 32) L) */
+
+  if (!is_mutable_pair(lst))
+    return(mutable_method_or_bust(sc, lst, sc->list_set_symbol, set_ulist_1(sc, lst, args), sc->type_names[T_PAIR], 1));
+  ind = car(args);
+  if ((arg_num > 2) && (is_null(cdr(args))))
+    {
+      set_car(lst, ind);
+      return(ind);
+    }
+  if (!s7_is_integer(ind))
+    return(method_or_bust(sc, ind, sc->list_set_symbol, set_ulist_1(sc, lst, args), sc->type_names[T_INTEGER], 2));
+  index = s7_integer_clamped_if_gmp(sc, ind);
+  if ((index < 0) || (index > sc->max_list_length))
+    out_of_range_error_nr(sc, sc->list_set_symbol, wrap_integer(sc, arg_num), ind, (index < 0) ? it_is_negative_string : it_is_too_large_string);
+
+  for (s7_int i = 0; (i < index) && is_pair(p); i++, p = cdr(p)) {}
+  if (!is_pair(p))
+    {
+      if (is_null(p))
+	out_of_range_error_nr(sc, sc->list_set_symbol, wrap_integer(sc, arg_num), ind, it_is_too_large_string);
+      wrong_type_error_nr(sc, sc->list_set_symbol, 1, lst, a_proper_list_string);
+    }
+  if (is_null(cddr(args)))
+    set_car(p, cadr(args));
+  else
+    {
+      if (!s7_is_pair(car(p)))
+	wrong_number_of_arguments_error_nr(sc, "too many arguments for list-set!: ~S", 36, args);
+      return(g_list_set_1(sc, car(p), cdr(args), arg_num + 1));
+    }
+  return(cadr(args));
+}
+
+static s7_pointer g_list_set(s7_scheme *sc, s7_pointer args) {return(g_list_set_1(sc, car(args), cdr(args), 2));}
+
+static inline s7_pointer list_set_p_pip_unchecked(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_pointer p2)
+{
+  s7_pointer p = p1;
+  if ((i1 < 0) || (i1 > sc->max_list_length))
+    out_of_range_error_nr(sc, sc->list_set_symbol, int_two, wrap_integer(sc, i1), (i1 < 0) ? it_is_negative_string : it_is_too_large_string);
+  for (s7_int i = 0; ((is_pair(p)) && (i < i1)); i++, p = cdr(p));
+  if (!is_pair(p))
+    {
+      if (is_null(p))
+	out_of_range_error_nr(sc, sc->list_set_symbol, int_two, wrap_integer(sc, i1), it_is_too_large_string);
+      wrong_type_error_nr(sc, sc->list_set_symbol, 1, p1, a_proper_list_string);
+    }
+  set_car(p, p2);
+  return(p2);
+}
+
+static s7_pointer list_increment_p_pip_unchecked(opt_info *o)
+{
+  s7_scheme *sc = o->sc;
+  s7_pointer p = slot_value(o->v[2].p), p1, p2;
+  s7_int index = integer(p);
+  if ((index < 0) || (index > sc->max_list_length))
+    out_of_range_error_nr(sc, sc->list_set_symbol, int_two, p, (index < 0) ? it_is_negative_string : it_is_too_large_string);
+  p1 = slot_value(o->v[1].p);
+  p = p1;
+  for (s7_int i = 0; ((is_pair(p)) && (i < index)); i++, p = cdr(p));
+  if (!is_pair(p))
+    {
+      if (is_null(p))
+	out_of_range_error_nr(sc, sc->list_set_symbol, int_two, wrap_integer(sc, index), it_is_too_large_string);
+      wrong_type_error_nr(sc, sc->list_set_symbol, 1, p1, a_proper_list_string);
+    }
+  p2 = g_add_xi(sc, car(p), integer(o->v[3].p), index);
+  set_car(p, p2);
+  return(p2);
+}
+
+static s7_pointer list_set_p_pip(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_pointer p2)  /* this may be uncallable now -- opt'd away in every case? */
+{
+  if (!is_pair(p1))
+    wrong_type_error_nr(sc, sc->list_set_symbol, 1, p1, sc->type_names[T_PAIR]);
+  return(list_set_p_pip_unchecked(sc, p1, i1, p2));
+}
+
+static s7_pointer g_list_set_i(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer lst = car(args), val;
+  s7_pointer p = lst;
+  s7_int index;
+  if (!is_mutable_pair(lst))
+    return(mutable_method_or_bust(sc, lst, sc->list_set_symbol, args, sc->type_names[T_PAIR], 1));
+
+  index = s7_integer_clamped_if_gmp(sc, cadr(args));
+  if ((index < 0) || (index > sc->max_list_length))
+    out_of_range_error_nr(sc, sc->list_set_symbol, int_two, wrap_integer(sc, index), (index < 0) ? it_is_negative_string : it_is_too_large_string);
+
+  for (s7_int i = 0; (i < index) && is_pair(p); i++, p = cdr(p)) {}
+  if (!is_pair(p))
+    {
+      if (is_null(p))
+	out_of_range_error_nr(sc, sc->list_set_symbol, int_two, wrap_integer(sc, index), it_is_too_large_string);
+      wrong_type_error_nr(sc, sc->list_set_symbol, 1, lst, a_proper_list_string);
+    }
+  val = caddr(args);
+  set_car(p, val);
+  return(val);
+}
+
+static s7_pointer list_set_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  if ((args == 3) &&
+      (s7_is_integer(caddr(expr))) &&
+      (s7_integer_clamped_if_gmp(sc, caddr(expr)) >= 0) &&
+      (s7_integer_clamped_if_gmp(sc, caddr(expr)) < sc->max_list_length))
+    return(sc->list_set_i);
+  return(f);
+}
+
+
+/* -------------------------------- list-tail -------------------------------- */
+static s7_pointer list_tail_p_pp(s7_scheme *sc, s7_pointer lst, s7_pointer p)
+{
+  s7_int i, index;
+  if (!s7_is_integer(p))
+    return(method_or_bust_pp(sc, p, sc->list_tail_symbol, lst, p, sc->type_names[T_INTEGER], 2));
+  index = s7_integer_clamped_if_gmp(sc, p);
+
+  if (!is_list(lst)) /* (list-tail () 0) -> () */
+    return(method_or_bust_with_type_pi(sc, lst, sc->list_tail_symbol, lst, index, a_list_string, 1));
+  if ((index < 0) || (index > sc->max_list_length))
+    out_of_range_error_nr(sc, sc->list_tail_symbol, int_two, wrap_integer(sc, index), (index < 0) ? it_is_negative_string : it_is_too_large_string);
+  for (i = 0; (i < index) && (is_pair(lst)); i++, lst = cdr(lst)) {}
+  if (i < index)
+    out_of_range_error_nr(sc, sc->list_tail_symbol, int_two, wrap_integer(sc, index), it_is_too_large_string);
+  return(lst);
+}
+
+static s7_pointer g_list_tail(s7_scheme *sc, s7_pointer args)
+{
+  #define H_list_tail "(list-tail lst i) returns the list from the i-th element on"
+  #define Q_list_tail s7_make_signature(sc, 3, sc->T, sc->is_pair_symbol, sc->is_integer_symbol) /* #t: (list-tail '(1 . 2) 1) -> 2 */
+  return(list_tail_p_pp(sc, car(args), cadr(args)));
+}
+
+
+/* -------------------------------- cons -------------------------------- */
+static s7_pointer g_cons(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cons "(cons a b) returns a pair containing a and b"
+  #define Q_cons s7_make_signature(sc, 3, sc->is_pair_symbol, sc->T, sc->T)
+
+  s7_pointer x;
+  new_cell(sc, x, T_PAIR | T_SAFE_PROCEDURE);
+  set_car(x, car(args));
+  set_cdr(x, cadr(args));
+  return(x);
+}
+
+static s7_pointer cons_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  s7_pointer x;
+  new_cell(sc, x, T_PAIR | T_SAFE_PROCEDURE);
+  set_car(x, p1);
+  set_cdr(x, p2);
+  return(x);
+}
+
+
+/* -------- car -------- */
+
+static s7_pointer g_car(s7_scheme *sc, s7_pointer args)
+{
+  #define H_car "(car pair) returns the first element of the pair"
+  #define Q_car sc->pl_p
+
+  s7_pointer lst = car(args);
+  if (is_pair(lst))
+    return(car(lst));
+  return(sole_arg_method_or_bust(sc, lst, sc->car_symbol, args, sc->type_names[T_PAIR]));
+}
+
+static s7_pointer car_p_p(s7_scheme *sc, s7_pointer p)
+{
+  if (is_pair(p))
+    return(car(p));
+  return(sole_arg_method_or_bust(sc, p, sc->car_symbol, set_plist_1(sc, p), sc->type_names[T_PAIR]));
+}
+
+static s7_pointer g_list_ref_at_0(s7_scheme *sc, s7_pointer args)
+{
+  if (is_pair(car(args))) return(caar(args));
+  return(method_or_bust(sc, car(args), sc->list_ref_symbol, args, sc->type_names[T_PAIR], 1)); /* 1=arg num if error */
+}
+
+
+static s7_pointer g_set_car(s7_scheme *sc, s7_pointer args)
+{
+  #define H_set_car "(set-car! pair val) sets the pair's first element to val"
+  #define Q_set_car s7_make_signature(sc, 3, sc->T, sc->is_pair_symbol, sc->T)
+
+  s7_pointer p = car(args);
+  if (!is_mutable_pair(p)) return(mutable_method_or_bust(sc, p, sc->set_car_symbol, args, sc->type_names[T_PAIR], 1));
+  set_car(p, cadr(args));
+  return(car(p));
+}
+
+static Inline s7_pointer inline_set_car(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  if (!is_mutable_pair(p1)) return(mutable_method_or_bust(sc, p1, sc->set_car_symbol, set_plist_1(sc, p1), sc->type_names[T_PAIR], 1));
+  set_car(p1, p2);
+  return(p2);
+}
+
+static s7_pointer set_car_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) {return(inline_set_car(sc, p1, p2));}
+
+
+/* -------- cdr -------- */
+static s7_pointer g_cdr(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cdr "(cdr pair) returns the second element of the pair"
+  #define Q_cdr sc->pl_p
+
+  s7_pointer lst = car(args);
+  if (is_pair(lst))
+    return(cdr(lst));
+  return(sole_arg_method_or_bust(sc, lst, sc->cdr_symbol, args, sc->type_names[T_PAIR]));
+}
+
+static s7_pointer cdr_p_p(s7_scheme *sc, s7_pointer p)
+{
+  if (is_pair(p))
+    return(cdr(p));
+  return(sole_arg_method_or_bust(sc, p, sc->cdr_symbol, set_plist_1(sc, p), sc->type_names[T_PAIR]));
+}
+
+
+static s7_pointer g_set_cdr(s7_scheme *sc, s7_pointer args)
+{
+  #define H_set_cdr "(set-cdr! pair val) sets the pair's second element to val"
+  #define Q_set_cdr s7_make_signature(sc, 3, sc->T, sc->is_pair_symbol, sc->T)
+
+  s7_pointer p = car(args);
+  if (!is_mutable_pair(p)) return(mutable_method_or_bust(sc, p, sc->set_cdr_symbol, args, sc->type_names[T_PAIR], 1));
+  set_cdr(p, cadr(args));
+  return(cdr(p));
+}
+
+static Inline s7_pointer inline_set_cdr(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  if (!is_mutable_pair(p1)) return(mutable_method_or_bust(sc, p1, sc->set_cdr_symbol, set_plist_1(sc, p1), sc->type_names[T_PAIR], 1));
+  set_cdr(p1, p2);
+  return(p2);
+}
+
+static s7_pointer set_cdr_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) {return(inline_set_cdr(sc, p1, p2));}
+
+
+/* -------- caar --------*/
+static s7_pointer g_caar(s7_scheme *sc, s7_pointer args)
+{
+  #define H_caar "(caar lst) returns (car (car lst)): (caar '((1 2))) -> 1"
+  #define Q_caar sc->pl_p
+
+  s7_pointer lst = car(args);
+  /* it makes no difference in timing to move lst here or below (i.e. lst=car(lst) then return(car(lst)) and so on) */
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->caar_symbol, args, sc->type_names[T_PAIR]));
+  if (!is_pair(car(lst))) sole_arg_wrong_type_error_nr(sc, sc->caar_symbol, lst, car_a_list_string);
+  return(caar(lst));
+
+}
+
+static s7_pointer caar_p_p(s7_scheme *sc, s7_pointer p)
+{
+  if ((is_pair(p)) && (is_pair(car(p)))) return(caar(p));
+  if (is_pair(p))   sole_arg_wrong_type_error_nr(sc, sc->caar_symbol, p, car_a_list_string);
+  return(sole_arg_method_or_bust(sc, p, sc->caar_symbol, set_plist_1(sc, p), sc->type_names[T_PAIR]));
+}
+
+
+/* -------- cadr --------*/
+static s7_pointer g_cadr(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cadr "(cadr lst) returns (car (cdr lst)): (cadr '(1 2 3)) -> 2"
+  #define Q_cadr sc->pl_p
+
+  s7_pointer lst = car(args);
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->cadr_symbol, args, sc->type_names[T_PAIR]));
+  if (!is_pair(cdr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cadr_symbol, lst, cdr_a_list_string);
+  return(cadr(lst));
+}
+
+static s7_pointer cadr_p_p(s7_scheme *sc, s7_pointer p)
+{
+  if ((is_pair(p)) && (is_pair(cdr(p)))) return(cadr(p));
+  if (is_pair(p)) sole_arg_wrong_type_error_nr(sc, sc->cadr_symbol, p, cdr_a_list_string);
+  return(sole_arg_method_or_bust(sc, p, sc->cadr_symbol, set_plist_1(sc, p), sc->type_names[T_PAIR]));
+}
+
+static s7_pointer g_list_ref_at_1(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer lst = car(args);
+  if (!is_pair(lst)) return(method_or_bust(sc, lst, sc->list_ref_symbol, args, sc->type_names[T_PAIR], 1));
+  if (!is_pair(cdr(lst))) out_of_range_error_nr(sc, sc->list_ref_symbol, int_two, cadr(args), it_is_too_large_string);
+  return(cadr(lst));
+}
+
+
+/* -------- cdar -------- */
+static s7_pointer g_cdar(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cdar "(cdar lst) returns (cdr (car lst)): (cdar '((1 2 3))) -> '(2 3)"
+  #define Q_cdar sc->pl_p
+
+  s7_pointer lst = car(args);
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->cdar_symbol, args, sc->type_names[T_PAIR]));
+  if (!is_pair(car(lst))) sole_arg_wrong_type_error_nr(sc, sc->cdar_symbol, lst, car_a_list_string);
+  return(cdar(lst));
+}
+
+static s7_pointer cdar_p_p(s7_scheme *sc, s7_pointer p)
+{
+  if ((is_pair(p)) && (is_pair(car(p)))) return(cdar(p));
+  if (!is_pair(p)) sole_arg_wrong_type_error_nr(sc, sc->cdar_symbol, p, car_a_list_string);
+  return(sole_arg_method_or_bust(sc, p, sc->cdar_symbol, set_plist_1(sc, p), sc->type_names[T_PAIR]));
+}
+
+
+/* -------- cddr -------- */
+static s7_pointer g_cddr(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cddr "(cddr lst) returns (cdr (cdr lst)): (cddr '(1 2 3 4)) -> '(3 4)"
+  #define Q_cddr sc->pl_p
+
+  s7_pointer lst = car(args);
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->cddr_symbol, args, sc->type_names[T_PAIR]));
+  if (!is_pair(cdr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cddr_symbol, lst, cdr_a_list_string);
+  return(cddr(lst));
+}
+
+static s7_pointer cddr_p_p(s7_scheme *sc, s7_pointer p)
+{
+  if ((is_pair(p)) && (is_pair(cdr(p)))) return(cddr(p));
+  if (is_pair(p)) sole_arg_wrong_type_error_nr(sc, sc->cddr_symbol, p, cdr_a_list_string);
+  return(sole_arg_method_or_bust(sc, p, sc->cddr_symbol, set_plist_1(sc, p), sc->type_names[T_PAIR]));
+}
+
+/* -------- caaar -------- */
+static s7_pointer caaar_p_p(s7_scheme *sc, s7_pointer lst)
+{
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->caaar_symbol, set_plist_1(sc, lst), sc->type_names[T_PAIR]));
+  if (!is_pair(car(lst))) sole_arg_wrong_type_error_nr(sc, sc->caaar_symbol, lst, car_a_list_string);
+  if (!is_pair(caar(lst))) sole_arg_wrong_type_error_nr(sc, sc->caaar_symbol, lst, caar_a_list_string);
+  if (!is_pair(caar(lst))) sole_arg_wrong_type_error_nr(sc, sc->caaar_symbol, lst, caar_a_list_string);
+  return(caaar(lst));
+}
+
+static s7_pointer g_caaar(s7_scheme *sc, s7_pointer args)
+{
+  #define H_caaar "(caaar lst) returns (car (car (car lst))): (caaar '(((1 2)))) -> 1"
+  #define Q_caaar sc->pl_p
+  return(caaar_p_p(sc, car(args)));
+}
+
+/* -------- caadr -------- */
+static s7_pointer caadr_p_p(s7_scheme *sc, s7_pointer p)
+{
+  if ((is_pair(p)) && (is_pair(cdr(p))) && (is_pair(cadr(p)))) return(caadr(p));
+  if (!is_pair(p)) return(sole_arg_method_or_bust(sc, p, sc->caadr_symbol, set_plist_1(sc, p), sc->type_names[T_PAIR]));
+  if (!is_pair(cdr(p))) sole_arg_wrong_type_error_nr(sc, sc->caadr_symbol, p, cdr_a_list_string);
+  sole_arg_wrong_type_error_nr(sc, sc->caadr_symbol, p, cadr_a_list_string);
+  return(NULL);
+}
+
+static s7_pointer g_caadr(s7_scheme *sc, s7_pointer args)
+{
+  #define H_caadr "(caadr lst) returns (car (car (cdr lst))): (caadr '(1 (2 3))) -> 2"
+  #define Q_caadr sc->pl_p
+  s7_pointer lst = car(args);
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->caadr_symbol, args, sc->type_names[T_PAIR]));
+  if (!is_pair(cdr(lst))) sole_arg_wrong_type_error_nr(sc, sc->caadr_symbol, lst, cdr_a_list_string);
+  if (!is_pair(cadr(lst))) sole_arg_wrong_type_error_nr(sc, sc->caadr_symbol, lst, cadr_a_list_string);
+  return(caadr(lst));
+}
+
+/* -------- cadar -------- */
+static s7_pointer g_cadar(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cadar "(cadar lst) returns (car (cdr (car lst))): (cadar '((1 2 3))) -> 2"
+  #define Q_cadar sc->pl_p
+
+  s7_pointer lst = car(args);
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->cadar_symbol, args, sc->type_names[T_PAIR]));
+  if (!is_pair(car(lst))) sole_arg_wrong_type_error_nr(sc, sc->cadar_symbol, lst, car_a_list_string);
+  if (!is_pair(cdar(lst))) sole_arg_wrong_type_error_nr(sc, sc->cadar_symbol, lst, cdar_a_list_string);
+  return(cadar(lst));
+}
+
+static s7_pointer cadar_p_p(s7_scheme *sc, s7_pointer p)
+{
+  if ((is_pair(p)) && (is_pair(car(p))) && (is_pair(cdar(p)))) return(cadar(p));
+  if (!is_pair(p)) return(sole_arg_method_or_bust(sc, p, sc->cadar_symbol, set_plist_1(sc, p), sc->type_names[T_PAIR]));
+  if (!is_pair(car(p))) sole_arg_wrong_type_error_nr(sc, sc->cadar_symbol, p, car_a_list_string);
+  sole_arg_wrong_type_error_nr(sc, sc->cadar_symbol, p, cdar_a_list_string);
+  return(NULL);
+}
+
+/* -------- cdaar -------- */
+static s7_pointer cdaar_p_p(s7_scheme *sc, s7_pointer lst)
+{
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->cdaar_symbol, set_plist_1(sc, lst), sc->type_names[T_PAIR]));
+  if (!is_pair(car(lst))) sole_arg_wrong_type_error_nr(sc, sc->cdaar_symbol, lst, car_a_list_string);
+  if (!is_pair(caar(lst))) sole_arg_wrong_type_error_nr(sc, sc->cdaar_symbol, lst, caar_a_list_string);
+  return(cdaar(lst));
+}
+
+static s7_pointer g_cdaar(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cdaar "(cdaar lst) returns (cdr (car (car lst))): (cdaar '(((1 2 3)))) -> '(2 3)"
+  #define Q_cdaar sc->pl_p
+  return(cdaar_p_p(sc, car(args)));
+}
+
+/* -------- caddr -------- */
+static s7_pointer g_caddr(s7_scheme *sc, s7_pointer args)
+{
+  #define H_caddr "(caddr lst) returns (car (cdr (cdr lst))): (caddr '(1 2 3 4)) -> 3"
+  #define Q_caddr sc->pl_p
+
+  s7_pointer lst = car(args);
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->caddr_symbol, args, sc->type_names[T_PAIR]));
+  if (!is_pair(cdr(lst))) sole_arg_wrong_type_error_nr(sc, sc->caddr_symbol, lst, cdr_a_list_string);
+  if (!is_pair(cddr(lst))) sole_arg_wrong_type_error_nr(sc, sc->caddr_symbol, lst, cddr_a_list_string);
+  return(caddr(lst));
+}
+
+static s7_pointer caddr_p_p(s7_scheme *sc, s7_pointer p)
+{
+  if ((is_pair(p)) && (is_pair(cdr(p))) && (is_pair(cddr(p)))) return(caddr(p));
+  if (!is_pair(p)) return(sole_arg_method_or_bust(sc, p, sc->caddr_symbol, set_plist_1(sc, p), sc->type_names[T_PAIR]));
+  if (!is_pair(cdr(p))) sole_arg_wrong_type_error_nr(sc, sc->caddr_symbol, p, cdr_a_list_string);
+  sole_arg_wrong_type_error_nr(sc, sc->caddr_symbol, p, cddr_a_list_string);
+  return(NULL);
+}
+
+static s7_pointer g_list_ref_at_2(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer lst = car(args);
+  if (!is_pair(lst))
+    return(method_or_bust(sc, lst, sc->list_ref_symbol, args, sc->type_names[T_PAIR], 1));
+  if ((!is_pair(cdr(lst))) || (!is_pair(cddr(lst))))
+    out_of_range_error_nr(sc, sc->list_ref_symbol, int_two, cadr(args), it_is_too_large_string);
+  return(caddr(lst));
+}
+
+
+/* -------- cdddr -------- */
+static s7_pointer cdddr_p_p(s7_scheme *sc, s7_pointer lst)
+{
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->cdddr_symbol, set_plist_1(sc, lst), sc->type_names[T_PAIR]));
+  if (!is_pair(cdr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cdddr_symbol, lst, cdr_a_list_string);
+  if (!is_pair(cddr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cdddr_symbol, lst, cddr_a_list_string);
+  return(cdddr(lst));
+}
+
+static s7_pointer g_cdddr(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cdddr "(cdddr lst) returns (cdr (cdr (cdr lst))): (cdddr '(1 2 3 4)) -> '(4)"
+  #define Q_cdddr sc->pl_p
+  return(cdddr_p_p(sc, car(args)));
+}
+
+/* -------- cdadr -------- */
+static s7_pointer cdadr_p_p(s7_scheme *sc, s7_pointer lst)
+{
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->cdadr_symbol, set_plist_1(sc, lst), sc->type_names[T_PAIR]));
+  if (!is_pair(cdr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cdadr_symbol, lst, cdr_a_list_string);
+  if (!is_pair(cadr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cdadr_symbol, lst, cadr_a_list_string);
+  return(cdadr(lst));
+}
+
+static s7_pointer g_cdadr(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cdadr "(cdadr lst) returns (cdr (car (cdr lst))): (cdadr '(1 (2 3 4))) -> '(3 4)"
+  #define Q_cdadr sc->pl_p
+  return(cdadr_p_p(sc, car(args)));
+}
+
+/* -------- cddar -------- */
+static s7_pointer cddar_p_p(s7_scheme *sc, s7_pointer lst)
+{
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->cddar_symbol, set_plist_1(sc, lst), sc->type_names[T_PAIR]));
+  if (!is_pair(car(lst))) sole_arg_wrong_type_error_nr(sc, sc->cddar_symbol, lst, car_a_list_string);
+  if (!is_pair(cdar(lst))) sole_arg_wrong_type_error_nr(sc, sc->cddar_symbol, lst, cdar_a_list_string);
+  return(cddar(lst));
+}
+
+static s7_pointer g_cddar(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cddar "(cddar lst) returns (cdr (cdr (car lst))): (cddar '((1 2 3 4))) -> '(3 4)"
+  #define Q_cddar sc->pl_p
+  return(cddar_p_p(sc, car(args)));
+}
+
+/* -------- caaaar -------- */
+static s7_pointer g_caaaar(s7_scheme *sc, s7_pointer args)
+{
+  #define H_caaaar "(caaaar lst) returns (car (car (car (car lst)))): (caaaar '((((1 2))))) -> 1"
+  #define Q_caaaar sc->pl_p
+
+  s7_pointer lst = car(args);
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->caaaar_symbol, args, sc->type_names[T_PAIR]));
+  if (!is_pair(car(lst))) sole_arg_wrong_type_error_nr(sc, sc->caaaar_symbol, lst, car_a_list_string);
+  if (!is_pair(caar(lst))) sole_arg_wrong_type_error_nr(sc, sc->caaaar_symbol, lst, caar_a_list_string);
+  if (!is_pair(caaar(lst))) sole_arg_wrong_type_error_nr(sc, sc->caaaar_symbol, lst, caaar_a_list_string);
+  return(caaaar(lst));
+}
+
+/* -------- caaadr -------- */
+static s7_pointer g_caaadr(s7_scheme *sc, s7_pointer args)
+{
+  #define H_caaadr "(caaadr lst) returns (car (car (car (cdr lst)))): (caaadr '(1 ((2 3)))) -> 2"
+  #define Q_caaadr sc->pl_p
+
+  s7_pointer lst = car(args);
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->caaadr_symbol, args, sc->type_names[T_PAIR]));
+  if (!is_pair(cdr(lst))) sole_arg_wrong_type_error_nr(sc, sc->caaadr_symbol, lst, cdr_a_list_string);
+  if (!is_pair(cadr(lst))) sole_arg_wrong_type_error_nr(sc, sc->caaadr_symbol, lst, cadr_a_list_string);
+  if (!is_pair(caadr(lst))) sole_arg_wrong_type_error_nr(sc, sc->caaadr_symbol, lst, caadr_a_list_string);
+  return(caaadr(lst));
+}
+
+/* -------- caadar -------- */
+static s7_pointer g_caadar(s7_scheme *sc, s7_pointer args)
+{
+  #define H_caadar "(caadar lst) returns (car (car (cdr (car lst)))): (caadar '((1 (2 3)))) -> 2"
+  #define Q_caadar sc->pl_p
+
+  s7_pointer lst = car(args);
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->caadar_symbol, args, sc->type_names[T_PAIR]));
+  if (!is_pair(car(lst))) sole_arg_wrong_type_error_nr(sc, sc->caadar_symbol, lst, car_a_list_string);
+  if (!is_pair(cdar(lst))) sole_arg_wrong_type_error_nr(sc, sc->caadar_symbol, lst, cdar_a_list_string);
+  if (!is_pair(cadar(lst))) sole_arg_wrong_type_error_nr(sc, sc->caadar_symbol, lst, cadar_a_list_string);
+  return(caadar(lst));
+}
+
+/* -------- cadaar -------- */
+static s7_pointer g_cadaar(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cadaar "(cadaar lst) returns (car (cdr (car (car lst)))): (cadaar '(((1 2 3)))) -> 2"
+  #define Q_cadaar sc->pl_p
+
+  s7_pointer lst = car(args);
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->cadaar_symbol, args, sc->type_names[T_PAIR]));
+  if (!is_pair(car(lst))) sole_arg_wrong_type_error_nr(sc, sc->cadaar_symbol, lst, car_a_list_string);
+  if (!is_pair(caar(lst))) sole_arg_wrong_type_error_nr(sc, sc->cadaar_symbol, lst, caar_a_list_string);
+  if (!is_pair(cdaar(lst))) sole_arg_wrong_type_error_nr(sc, sc->cadaar_symbol, lst, cdaar_a_list_string);
+  return(cadaar(lst));
+}
+
+/* -------- caaddr -------- */
+
+static s7_pointer caaddr_p_p(s7_scheme *sc, s7_pointer lst)
+{
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->caaddr_symbol, set_plist_1(sc, lst), sc->type_names[T_PAIR]));
+  if (!is_pair(cdr(lst))) sole_arg_wrong_type_error_nr(sc, sc->caaddr_symbol, lst, cdr_a_list_string);
+  if (!is_pair(cddr(lst))) sole_arg_wrong_type_error_nr(sc, sc->caaddr_symbol, lst, cddr_a_list_string);
+  if (!is_pair(caddr(lst))) sole_arg_wrong_type_error_nr(sc, sc->caaddr_symbol, lst, caddr_a_list_string);
+  return(caaddr(lst));
+}
+
+static s7_pointer g_caaddr(s7_scheme *sc, s7_pointer args)
+{
+  #define H_caaddr "(caaddr lst) returns (car (car (cdr (cdr lst)))): (caaddr '(1 2 (3 4))) -> 3"
+  #define Q_caaddr sc->pl_p
+  return(caaddr_p_p(sc, car(args)));
+}
+
+/* -------- cadddr -------- */
+static s7_pointer cadddr_p_p(s7_scheme *sc, s7_pointer lst)
+{
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->cadddr_symbol, set_plist_1(sc, lst), sc->type_names[T_PAIR]));
+  if (!is_pair(cdr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cadddr_symbol, lst, cdr_a_list_string);
+  if (!is_pair(cddr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cadddr_symbol, lst, cddr_a_list_string);
+  if (!is_pair(cdddr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cadddr_symbol, lst, cdddr_a_list_string);
+  return(cadddr(lst));
+}
+
+static s7_pointer g_cadddr(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cadddr "(cadddr lst) returns (car (cdr (cdr (cdr lst)))): (cadddr '(1 2 3 4 5)) -> 4"
+  #define Q_cadddr sc->pl_p
+  return(cadddr_p_p(sc, car(args)));
+}
+
+/* -------- cadadr -------- */
+static s7_pointer cadadr_p_p(s7_scheme *sc, s7_pointer lst)
+{
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->cadadr_symbol, set_plist_1(sc, lst), sc->type_names[T_PAIR]));
+  if (!is_pair(cdr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cadadr_symbol, lst, cdr_a_list_string);
+  if (!is_pair(cadr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cadadr_symbol, lst, cadr_a_list_string);
+  if (!is_pair(cdadr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cadadr_symbol, lst, cdadr_a_list_string);
+  return(cadadr(lst));
+}
+
+static s7_pointer g_cadadr(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cadadr "(cadadr lst) returns (car (cdr (car (cdr lst)))): (cadadr '(1 (2 3 4))) -> 3"
+  #define Q_cadadr sc->pl_p
+  return(cadadr_p_p(sc, car(args)));
+}
+
+/* -------- caddar -------- */
+static s7_pointer caddar_p_p(s7_scheme *sc, s7_pointer lst)
+{
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->caddar_symbol, set_plist_1(sc, lst), sc->type_names[T_PAIR]));
+  if (!is_pair(car(lst))) sole_arg_wrong_type_error_nr(sc, sc->caddar_symbol, lst, car_a_list_string);
+  if (!is_pair(cdar(lst))) sole_arg_wrong_type_error_nr(sc, sc->caddar_symbol, lst, cdar_a_list_string);
+  if (!is_pair(cddar(lst))) sole_arg_wrong_type_error_nr(sc, sc->caddar_symbol, lst, cddar_a_list_string);
+  return(caddar(lst));
+}
+
+static s7_pointer g_caddar(s7_scheme *sc, s7_pointer args)
+{
+  #define H_caddar "(caddar lst) returns (car (cdr (cdr (car lst)))): (caddar '((1 2 3 4))) -> 3"
+  #define Q_caddar sc->pl_p
+  return(caddar_p_p(sc, car(args)));
+}
+
+/* -------- cdaaar -------- */
+static s7_pointer g_cdaaar(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cdaaar "(cdaaar lst) returns (cdr (car (car (car lst)))): (cdaaar '((((1 2 3))))) -> '(2 3)"
+  #define Q_cdaaar sc->pl_p
+
+  s7_pointer lst = car(args);
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->cdaaar_symbol, args, sc->type_names[T_PAIR]));
+  if (!is_pair(car(lst))) sole_arg_wrong_type_error_nr(sc, sc->cdaaar_symbol, lst, car_a_list_string);
+  if (!is_pair(caar(lst))) sole_arg_wrong_type_error_nr(sc, sc->cdaaar_symbol, lst, caar_a_list_string);
+  if (!is_pair(caaar(lst))) sole_arg_wrong_type_error_nr(sc, sc->cdaaar_symbol, lst, caaar_a_list_string);
+  return(cdaaar(lst));
+}
+
+/* -------- cdaadr -------- */
+static s7_pointer g_cdaadr(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cdaadr "(cdaadr lst) returns (cdr (car (car (cdr lst)))): (cdaadr '(1 ((2 3 4)))) -> '(3 4)"
+  #define Q_cdaadr sc->pl_p
+
+  s7_pointer lst = car(args);
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->cdaadr_symbol, args, sc->type_names[T_PAIR]));
+  if (!is_pair(cdr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cdaadr_symbol, lst, cdr_a_list_string);
+  if (!is_pair(cadr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cdaadr_symbol, lst, cadr_a_list_string);
+  if (!is_pair(caadr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cdaadr_symbol, lst, caadr_a_list_string);
+  return(cdaadr(lst));
+}
+
+/* -------- cdadar -------- */
+static s7_pointer g_cdadar(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cdadar "(cdadar lst) returns (cdr (car (cdr (car lst)))): (cdadar '((1 (2 3 4)))) -> '(3 4)"
+  #define Q_cdadar sc->pl_p
+
+  s7_pointer lst = car(args);
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->cdadar_symbol, args, sc->type_names[T_PAIR]));
+  if (!is_pair(car(lst))) sole_arg_wrong_type_error_nr(sc, sc->cdadar_symbol, lst, car_a_list_string);
+  if (!is_pair(cdar(lst))) sole_arg_wrong_type_error_nr(sc, sc->cdadar_symbol, lst, cdar_a_list_string);
+  if (!is_pair(cadar(lst))) sole_arg_wrong_type_error_nr(sc, sc->cdadar_symbol, lst, cadar_a_list_string);
+  return(cdadar(lst));
+}
+
+/* -------- cddaar -------- */
+static s7_pointer g_cddaar(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cddaar "(cddaar lst) returns (cdr (cdr (car (car lst)))): (cddaar '(((1 2 3 4)))) -> '(3 4)"
+  #define Q_cddaar sc->pl_p
+
+  s7_pointer lst = car(args);
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->cddaar_symbol, args, sc->type_names[T_PAIR]));
+  if (!is_pair(car(lst))) sole_arg_wrong_type_error_nr(sc, sc->cddaar_symbol, lst, car_a_list_string);
+  if (!is_pair(caar(lst))) sole_arg_wrong_type_error_nr(sc, sc->cddaar_symbol, lst, caar_a_list_string);
+  if (!is_pair(cdaar(lst))) sole_arg_wrong_type_error_nr(sc, sc->cddaar_symbol, lst, cdaar_a_list_string);
+  return(cddaar(lst));
+}
+
+/* -------- cdaddr -------- */
+static s7_pointer g_cdaddr(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cdaddr "(cdaddr lst) returns (cdr (car (cdr (cdr lst)))): (cdaddr '(1 2 (3 4 5))) -> '(4 5)"
+  #define Q_cdaddr sc->pl_p
+
+  s7_pointer lst = car(args);
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->cdaddr_symbol, args, sc->type_names[T_PAIR]));
+  if (!is_pair(cdr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cdaddr_symbol, lst, cdr_a_list_string);
+  if (!is_pair(cddr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cdaddr_symbol, lst, cddr_a_list_string);
+  if (!is_pair(caddr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cdaddr_symbol, lst, caddr_a_list_string);
+  return(cdaddr(lst));
+}
+
+/* -------- cddddr -------- */
+
+static s7_pointer cddddr_p_p(s7_scheme *sc, s7_pointer lst)
+{
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->cddddr_symbol, set_plist_1(sc, lst), sc->type_names[T_PAIR]));
+  if (!is_pair(cdr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cddddr_symbol, lst, cdr_a_list_string);
+  if (!is_pair(cddr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cddddr_symbol, lst, cddr_a_list_string);
+  if (!is_pair(cdddr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cddddr_symbol, lst, cdddr_a_list_string);
+  return(cddddr(lst));
+}
+
+static s7_pointer g_cddddr(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cddddr "(cddddr lst) returns (cdr (cdr (cdr (cdr lst)))): (cddddr '(1 2 3 4 5)) -> '(5)"
+  #define Q_cddddr sc->pl_p
+  return(cddddr_p_p(sc, car(args)));
+}
+
+
+/* -------- cddadr -------- */
+static s7_pointer cddadr_p_p(s7_scheme *sc, s7_pointer lst)
+{
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->cddadr_symbol, set_plist_1(sc, lst), sc->type_names[T_PAIR]));
+  if (!is_pair(cdr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cddadr_symbol, lst, cdr_a_list_string);
+  if (!is_pair(cadr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cddadr_symbol, lst, cadr_a_list_string);
+  if (!is_pair(cdadr(lst))) sole_arg_wrong_type_error_nr(sc, sc->cddadr_symbol, lst, cdadr_a_list_string);
+  return(cddadr(lst));
+}
+
+static s7_pointer g_cddadr(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cddadr "(cddadr lst) returns (cdr (cdr (car (cdr lst)))): (cddadr '(1 (2 3 4 5))) -> '(4 5)"
+  #define Q_cddadr sc->pl_p
+  return(cddadr_p_p(sc, car(args)));
+}
+
+
+/* -------- cdddar -------- */
+
+static s7_pointer cdddar_p_p(s7_scheme *sc, s7_pointer lst)
+{
+  if (!is_pair(lst)) return(sole_arg_method_or_bust(sc, lst, sc->cdddar_symbol, set_plist_1(sc, lst), sc->type_names[T_PAIR]));
+  if (!is_pair(car(lst))) sole_arg_wrong_type_error_nr(sc, sc->cdddar_symbol, lst, car_a_list_string);
+  if (!is_pair(cdar(lst))) sole_arg_wrong_type_error_nr(sc, sc->cdddar_symbol, lst, cdar_a_list_string);
+  if (!is_pair(cddar(lst))) sole_arg_wrong_type_error_nr(sc, sc->cdddar_symbol, lst, cddar_a_list_string);
+  return(cdddar(lst));
+}
+
+static s7_pointer g_cdddar(s7_scheme *sc, s7_pointer args)
+{
+  #define H_cdddar "(cdddar lst) returns (cdr (cdr (cdr (car lst)))): (cdddar '((1 2 3 4 5))) -> '(4 5)"
+  #define Q_cdddar sc->pl_p
+  return(cdddar_p_p(sc, car(args)));
+}
+
+/* -------------------------------- assoc assv assq -------------------------------- */
+s7_pointer s7_assq(s7_scheme *sc, s7_pointer obj, s7_pointer x)
+{
+  s7_pointer y = x;
+  while (true)
+    {
+      /* we can blithely take the car of anything, since we're not treating it as an object,
+       *   then if we get a bogus match, the following check that caar made sense ought to catch it.
+       * if car(#<unspecified>) = #<unspecified> (initialization time), then cdr(nil)->unspec
+       *   and subsequent caar(unspec)->unspec so we could forgo half the is_pair checks below.
+       *   This breaks if "x" is a dotted list -- the last cdr is not nil, so we lose.
+       */
+      LOOP_8(if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x)); x = cdr(x); if (!is_pair(x)) return(sc->F));
+      y = cdr(y);
+      if (x == y) return(sc->F);
+    }
+  return(sc->F); /* not reached */
+}
+
+static s7_pointer assq_p_pp(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  return((is_pair(y)) ? s7_assq(sc, x, y) :
+	 ((is_null(y)) ? sc->F :
+	  method_or_bust_pp(sc, y, sc->assq_symbol, x, y, an_association_list_string, 2)));
+}
+
+static s7_pointer g_assq(s7_scheme *sc, s7_pointer args)
+{
+  #define H_assq "(assq obj alist) returns the key-value pair associated (via eq?) with the key obj in the association list alist"
+  #define Q_assq s7_make_signature(sc, 3, s7_make_signature(sc, 2, sc->is_pair_symbol, sc->not_symbol), sc->T, sc->is_list_symbol)
+  return(assq_p_pp(sc, car(args), cadr(args)));
+  /* we don't check for (pair? (car x)) here (or in assv) so we get some inconsistency with assoc:
+   *  (assq #f '(#f 2 . 3)) -> #f, (assoc #f '(#f 2 . 3)) -> 'error
+   */
+}
+
+static s7_pointer assv_p_pp(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  s7_pointer z;
+  if (!is_pair(y))
+    {
+      if (is_null(y)) return(sc->F);
+      return(method_or_bust_pp(sc, y, sc->assv_symbol, x, y, an_association_list_string, 2));
+    }
+  if (is_simple(x))
+    return(s7_assq(sc, x, y));
+
+  z = y;
+  while (true)
+    {
+      /* here we can't play the assq == game because s7_is_eqv thinks it's getting a legit s7 object */
+      if ((is_pair(car(y))) && (s7_is_eqv(sc, x, caar(y)))) return(car(y));
+      y = cdr(y);
+      if (!is_pair(y)) return(sc->F);
+
+      if ((is_pair(car(y))) && (s7_is_eqv(sc, x, caar(y)))) return(car(y));
+      y = cdr(y);
+      if (!is_pair(y)) return(sc->F);
+
+      z = cdr(z);
+      if (z == y) return(sc->F);
+    }
+  return(sc->F); /* not reached */
+}
+
+static s7_pointer g_assv(s7_scheme *sc, s7_pointer args)        /* g_assv is called by g_assoc below */
+{
+  #define H_assv "(assv obj alist) returns the key-value pair associated (via eqv?) with the key obj in the association list alist"
+  #define Q_assv Q_assq
+  return(assv_p_pp(sc, car(args), cadr(args)));
+}
+
+s7_pointer s7_assoc(s7_scheme *sc, s7_pointer sym, s7_pointer lst)
+{
+  s7_pointer x, y;
+  if (!is_pair(lst))
+    return(sc->F);
+  x = lst;
+  y = lst;
+  while (true)
+    {
+      if ((is_pair(car(x))) && (s7_is_equal(sc, sym, caar(x)))) return(car(x));
+      x = cdr(x);
+      if (!is_pair(x)) return(sc->F);
+
+      if ((is_pair(car(x))) && (s7_is_equal(sc, sym, caar(x)))) return(car(x));
+      x = cdr(x);
+      if (!is_pair(x)) return(sc->F);
+
+      y = cdr(y);
+      if (x == y) return(sc->F);
+    }
+  return(sc->F);
+}
+
+static s7_pointer assoc_1(s7_scheme *sc, s7_pointer obj, s7_pointer x)
+{
+  s7_pointer y = x;
+  if (is_string(obj))
+    {
+      while (true)
+	{
+	  if (is_pair(car(x)))
+	    {
+	      s7_pointer val = caar(x);
+	      if ((val == obj) ||
+		  ((is_string(val)) &&
+		   (scheme_strings_are_equal(obj, val))))
+		return(car(x));
+	    }
+	  x = cdr(x);
+	  if (!is_pair(x)) return(sc->F);
+
+	  if (is_pair(car(x)))
+	    {
+	      s7_pointer val = caar(x);
+	      if ((val == obj) ||
+		  ((is_string(val)) &&
+		   (scheme_strings_are_equal(obj, val))))
+		return(car(x));
+	    }
+	  x = cdr(x);
+	  if (!is_pair(x)) return(sc->F);
+	  y = cdr(y);
+	  if (x == y) return(sc->F);
+	}
+      return(sc->F);
+    }
+  while (true)
+    {
+      if ((is_pair(car(x))) && (s7_is_equal(sc, obj, caar(x)))) return(car(x));
+      x = cdr(x);
+      if (!is_pair(x)) return(sc->F);
+
+      if ((is_pair(car(x))) && (s7_is_equal(sc, obj, caar(x)))) return(car(x));
+      x = cdr(x);
+      if (!is_pair(x)) return(sc->F);
+      y = cdr(y);
+      if (x == y) return(sc->F);
+    }
+  return(sc->F); /* not reached */
+}
+
+static bool closure_has_two_normal_args(s7_scheme *sc, s7_pointer eq_func) /* sc for is_null */
+{
+  return((is_closure(eq_func)) &&
+	 (is_pair(closure_args(eq_func))) &&
+	 (is_pair(cdr(closure_args(eq_func)))) && /* not dotted arg list */
+	 (is_null(cddr(closure_args(eq_func)))));  /* arity == 2 */
+}
+
+static s7_pointer g_is_eq(s7_scheme *sc, s7_pointer args);
+static s7_pointer g_is_eqv(s7_scheme *sc, s7_pointer args);
+static s7_pfunc s7_bool_optimize(s7_scheme *sc, s7_pointer expr);
+
+static s7_pointer g_assoc(s7_scheme *sc, s7_pointer args)
+{
+  #define H_assoc "(assoc obj alist (func #f)) returns the key-value pair associated (via equal?) with the key obj in the association list alist.\
+If 'func' is a function of 2 arguments, it is used for the comparison instead of 'equal?"
+  #define Q_assoc s7_make_signature(sc, 4, \
+                    s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_boolean_symbol), \
+                    sc->T, sc->is_list_symbol, sc->is_procedure_symbol)
+  s7_pointer x = cadr(args), obj, eq_func = NULL;
+
+  if (!is_null(x))
+    {
+      if (!is_pair(x))
+	return(method_or_bust(sc, x, sc->assoc_symbol, args, an_association_list_string, 2));
+      if (!is_pair(car(x)))
+	wrong_type_error_nr(sc, sc->assoc_symbol, 2, x, an_association_list_string); /* we're assuming caar below so it better exist */
+    }
+  if (is_pair(cddr(args)))
+    {
+      s7_pointer y;
+      eq_func = caddr(args);
+      /* here we know x is a pair, but need to protect against circular lists */
+      /* I wonder if the assoc equality function should get the cons, not just caar? */
+
+      if (is_safe_c_function(eq_func))
+	{
+	  s7_function func = c_function_call(eq_func);
+	  if (func == g_is_eq) return(is_null(x) ? sc->F : s7_assq(sc, car(args), x));
+	  if (func == g_is_eqv) return(assv_p_pp(sc, car(args), x));
+	  if (!s7_is_aritable(sc, eq_func, 2))
+	    wrong_type_error_nr(sc, sc->assoc_symbol, 3, eq_func, an_eq_func_string);
+	  set_car(sc->t2_1, car(args));
+	  for (s7_pointer slow = x; is_pair(x); x = cdr(x), slow = cdr(slow))
+	    {
+	      if (!is_pair(car(x))) wrong_type_error_nr(sc, sc->assoc_symbol, 2, cadr(args), an_association_list_string); /* not x */
+	      set_car(sc->t2_2, caar(x));
+	      if (is_true(sc, func(sc, sc->t2_1))) return(car(x));
+	      x = cdr(x);
+	      if ((!is_pair(x)) || (x == slow)) return(sc->F);
+	      if (!is_pair(car(x))) wrong_type_error_nr(sc, sc->assoc_symbol, 2, cadr(args), an_association_list_string);
+	      set_car(sc->t2_2, caar(x));
+	      if (is_true(sc, func(sc, sc->t2_1))) return(car(x));
+	    }
+	  return(sc->F);
+	}
+      if (closure_has_two_normal_args(sc, eq_func))
+	{
+	  s7_pointer body = closure_body(eq_func);
+	  if (is_null(x)) return(sc->F);
+	  if (is_null(cdr(body)))
+	    {
+	      s7_pfunc func;
+	      set_curlet(sc, make_let_with_two_slots(sc, sc->curlet, car(closure_args(eq_func)), car(args), cadr(closure_args(eq_func)), sc->F));
+	      func = s7_bool_optimize(sc, body);
+	      if (func)
+		{
+		  s7_pointer slowx = x;
+		  opt_info *o = sc->opts[0];
+		  s7_pointer b = next_slot(let_slots(sc->curlet));
+		  while (true)
+		    {
+		      if (!is_pair(car(x))) wrong_type_error_nr(sc, sc->assoc_symbol, 2, cadr(args), an_association_list_string);
+		      slot_set_value(b, caar(x));
+		      if (o->v[0].fb(o)) return(car(x));
+		      x = cdr(x);
+		      if (!is_pair(x)) return(sc->F);
+		      if (!is_pair(car(x))) wrong_type_error_nr(sc, sc->assoc_symbol, 2, cadr(args), an_association_list_string);
+		      slot_set_value(b, caar(x));
+		      if (o->v[0].fb(o)) return(car(x));
+		      x = cdr(x);
+		      if (!is_pair(x)) return(sc->F);
+		      slowx = cdr(slowx);
+		      if (x == slowx) return(sc->F);
+		    }
+		  return(sc->F);
+		}}}
+
+      /* member_if is similar.  Do not call eval here with op_eval_done to return!  An error will longjmp past the
+       *   assoc point, leaving the op_eval_done on the stack, causing s7 to quit.
+       */
+      if (type(eq_func) < T_CONTINUATION)
+	return(method_or_bust_p(sc, eq_func, sc->assoc_symbol, a_procedure_string));
+      if (!s7_is_aritable(sc, eq_func, 2))
+	wrong_type_error_nr(sc, sc->assoc_symbol, 3, eq_func, an_eq_func_string);
+      if (is_null(x)) return(sc->F);
+      if ((is_any_macro(eq_func)) && (!is_c_macro(eq_func))) clear_all_optimizations(sc, closure_body(eq_func));
+      y = list_1(sc, copy_proper_list(sc, args));
+      set_opt1_fast(y, x);
+      set_opt2_slow(y, x);
+      push_stack(sc, OP_ASSOC_IF, list_1_unchecked(sc, y), eq_func);
+      if (needs_copied_args(eq_func))
+	push_stack(sc, OP_APPLY, list_2_unchecked(sc, car(args), caar(x)), eq_func);
+      else
+	{
+	  set_car(sc->t2_1, car(args));
+	  set_car(sc->t2_2, caar(x));
+	  push_stack(sc, OP_APPLY, sc->t2_1, eq_func);
+	}
+      return(sc->unspecified);
+    }
+  if (is_null(x)) return(sc->F);
+  obj = car(args);
+  if (is_simple(obj))
+    return(s7_assq(sc, obj, x));
+  return(assoc_1(sc, obj, x));
+}
+
+static s7_pointer assoc_p_pp(s7_scheme *sc, s7_pointer obj, s7_pointer x)
+{
+  if (!is_pair(x))
+    {
+      if (is_null(x)) return(sc->F);
+      return(method_or_bust(sc, x, sc->assoc_symbol, set_plist_2(sc, obj, x), an_association_list_string, 2));
+    }
+  if (!is_pair(car(x))) wrong_type_error_nr(sc, sc->assoc_symbol, 2, x, an_association_list_string);
+  if (is_simple(obj)) return(s7_assq(sc, obj, x));
+  return(assoc_1(sc, obj, x));
+}
+
+static bool op_assoc_if(s7_scheme *sc)
+{
+  s7_pointer orig_args = car(sc->args);
+  /* code=func, args=(list (list args)) with f/opt1_fast=list, value=result of comparison
+   *   (assoc 3 '((1 . a) (2 . b) (3 . c) (4 . d)) =)
+   */
+  if (sc->value != sc->F)            /* previous comparison was not #f -- return (car list) */
+    {
+      sc->value = car(opt1_fast(orig_args));
+      return(true);
+    }
+  if (!is_pair(cdr(opt1_fast(orig_args))))             /* (assoc 3 '((1 . 2) . 3) =) or nil */
+    {
+      sc->value = sc->F;
+      return(true);
+    }
+  set_opt1_fast(orig_args, cdr(opt1_fast(orig_args)));  /* cdr down arg list */
+
+  if (sc->cur_op == OP_ASSOC_IF1)
+    {
+      /* circular list check */
+      if (opt1_fast(orig_args) == opt2_slow(orig_args))
+	{
+	  sc->value = sc->F;
+	  return(true);
+	}
+      set_opt2_slow(orig_args, cdr(opt2_slow(orig_args))); /* cdr down the slow list */
+      push_stack_direct(sc, OP_ASSOC_IF);
+    }
+  else push_stack_direct(sc, OP_ASSOC_IF1);
+
+  if (!is_pair(car(opt1_fast(orig_args))))     /* (assoc 1 '((2 . 2) 3) =) -- we access caaadr below */
+    error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "assoc: second argument is not an alist: ~S", 42), orig_args));
+  /* not sure about this -- we could simply skip the entry both here and in g_assoc
+   *   (assoc 1 '((2 . 2) 3)) -> #f
+   *   (assoc 1 '((2 . 2) 3) =) -> error currently
+   */
+  if (needs_copied_args(sc->code))
+    sc->args = list_2(sc, caar(orig_args), caar(opt1_fast(orig_args)));
+  else sc->args = set_plist_2(sc, caar(orig_args), caar(opt1_fast(orig_args)));
+  return(false);
+}
+
+static s7_pointer assoc_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  if ((args == 3) && (is_normal_symbol(cadddr(expr))))
+    {
+      if (cadddr(expr) == sc->is_eq_symbol) return(global_value(sc->assq_symbol));
+      if (cadddr(expr) == sc->is_eqv_symbol) return(global_value(sc->assv_symbol));
+    }
+  return(f);
+}
+
+
+/* ---------------- member, memv, memq ---------------- */
+s7_pointer s7_memq(s7_scheme *sc, s7_pointer obj, s7_pointer x)
+{
+  s7_pointer y = x;
+  while (true)
+    {
+      LOOP_4(if (obj == car(x)) return(x); x = cdr(x); if (!is_pair(x)) return(sc->F));
+      y = cdr(y);
+      if (x == y) return(sc->F);
+    }
+  return(sc->F);
+}
+
+static s7_pointer memq_p_pp(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  return((is_pair(y)) ? s7_memq(sc, x, y) :
+	 ((is_null(y)) ? sc->F : method_or_bust_pp(sc, y, sc->memq_symbol, x, y, a_list_string, 2)));
+}
+
+static s7_pointer g_memq(s7_scheme *sc, s7_pointer args)
+{
+  #define H_memq "(memq obj list) looks for obj in list and returns the list from that point if it is found, otherwise #f. memq uses eq?"
+  #define Q_memq sc->pl_tl
+
+  s7_pointer x = car(args);
+  s7_pointer y = cadr(args);
+  if (is_pair(y))
+    return(s7_memq(sc, x, y));
+  if (is_null(y))
+    return(sc->F);
+  return(method_or_bust_pp(sc, y, sc->memq_symbol, x, y, a_list_string, 2));
+}
+
+/* I think (memq 'c '(a b . c)) should return #f because otherwise (memq () ...) would return the () at the end */
+/* if memq's list is a quoted list, it won't be changing, so we can tell ahead of time that it is a proper list, and what its length is */
+
+static s7_pointer g_memq_2(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer x = cadr(args);
+  const s7_pointer obj = car(args);
+  if (obj == car(x)) return(x);
+  return((obj == cadr(x)) ? cdr(x) : sc->F);
+}
+
+static s7_pointer memq_2_p_pp(s7_scheme *sc, s7_pointer obj, s7_pointer x)
+{
+  if (obj == car(x)) return(x);
+  return((obj == cadr(x)) ? cdr(x) : sc->F);
+}
+
+static s7_pointer memq_3_p_pp(s7_scheme *sc, s7_pointer obj, s7_pointer x)
+{
+  if (obj == car(x)) return(x);
+  if (obj == cadr(x)) return(cdr(x));
+  return((obj == caddr(x)) ? cddr(x) : sc->F);
+}
+
+static s7_pointer g_memq_3(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer x = cadr(args);
+  const s7_pointer obj = car(args);
+  while (true)
+    {
+      if (obj == car(x)) return(x);
+      x = cdr(x);
+      if (obj == car(x)) return(x);
+      x = cdr(x);
+      if (obj == car(x)) return(x);
+      x = cdr(x);
+      if (!is_pair(x)) return(sc->F);
+    }
+  return(sc->F);
+}
+
+static s7_pointer memq_4_p_pp(s7_scheme *sc, s7_pointer obj, s7_pointer x)
+{
+  while (true)
+    {
+      LOOP_4(if (obj == car(x)) return(x); x = cdr(x));
+      if (!is_pair(x)) return(sc->F);
+    }
+  return(sc->F);
+}
+
+static s7_pointer g_memq_4(s7_scheme *sc, s7_pointer args) {return(memq_4_p_pp(sc, car(args), cadr(args)));}
+
+static s7_pointer g_memq_any(s7_scheme *sc, s7_pointer args)
+{
+  /* no circular list check needed in this case */
+  s7_pointer x = cadr(args);
+  const s7_pointer obj = car(args);
+  while (true)
+    {
+      LOOP_4(if (obj == car(x)) return(x); x = cdr(x); if (!is_pair(x)) return(sc->F));
+    }
+  return(sc->F);
+}
+
+static s7_pointer memq_chooser(s7_scheme *sc, s7_pointer f, int32_t unused_args, s7_pointer expr)
+{
+  s7_pointer lst = caddr(expr);
+  if ((is_proper_quote(sc, lst)) &&
+      (is_pair(cadr(lst))))
+    {
+      s7_int len = s7_list_length(sc, cadr(lst));
+      if (len > 0)
+	{
+	  if (len == 2) /* this used to set opt3_any to cadr, but that doesn't survive call/cc's copy_stack */
+	    return(sc->memq_2);
+	  if ((len % 4) == 0)
+	    return(sc->memq_4);
+	  return(((len % 3) == 0) ? sc->memq_3 : sc->memq_any);
+	}}
+  return(f);
+}
+
+static bool numbers_are_eqv(s7_scheme *sc, s7_pointer a, s7_pointer b)
+{
+#if WITH_GMP
+  if ((is_big_number(a)) || (is_big_number(b)))
+    return(big_numbers_are_eqv(sc, a, b));
+  if (type(a) != type(b)) return(false);
+#endif
+  /* if (type(a) != type(b)) return(false); */   /* (eqv? 1 1.0) -> #f! but assume that we've checked types already */
+
+  /* switch is apparently as expensive as 3-4 if's! so this only loses if every call involves complex numbers? */
+  if (is_t_integer(a)) return(integer(a) == integer(b));
+  if (is_t_real(a)) return(real(a) == real(b)); /* NaNs are not equal to anything including themselves */
+  if (is_t_ratio(a)) return((numerator(a) == numerator(b)) && (denominator(a) == denominator(b)));
+  if (!is_t_complex(a)) return(false);
+  return((real_part(a) == real_part(b)) && (imag_part(a) == imag_part(b)));
+}
+
+static s7_pointer memv_number(s7_scheme *sc, s7_pointer obj, s7_pointer x)
+{
+  s7_pointer y = x;
+#if (!WITH_GMP)
+  uint8_t obj_type = type(obj);
+#endif
+  while (true)
+    {
+#if WITH_GMP
+      LOOP_4(if ((is_number(car(x))) && (numbers_are_eqv(sc, obj, car(x)))) return(x); x = cdr(x); if (!is_pair(x)) return(sc->F));
+#else
+      LOOP_4(if ((type(car(x)) == obj_type) && (numbers_are_eqv(sc, obj, car(x)))) return(x); x = cdr(x); if (!is_pair(x)) return(sc->F));
+#endif
+      y = cdr(y);
+      if (x == y) return(sc->F);
+    }
+  return(sc->F);
+}
+
+static s7_pointer memv_p_pp(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  s7_pointer z;
+  if (!is_pair(y))
+    {
+      if (is_null(y)) return(sc->F);
+      return(method_or_bust_pp(sc, y, sc->memv_symbol, x, y, a_list_string, 2));
+    }
+  if (is_simple(x)) return(s7_memq(sc, x, y));
+  if (is_number(x)) return(memv_number(sc, x, y));
+
+  z = y;
+  while (true)
+    {
+      if (s7_is_eqv(sc, x, car(y))) return(y);
+      y = cdr(y);
+      if (!is_pair(y)) return(sc->F);
+
+      if (s7_is_eqv(sc, x, car(y))) return(y);
+      y = cdr(y);
+      if (!is_pair(y)) return(sc->F);
+
+      z = cdr(z);
+      if (z == y) return(sc->F);
+    }
+  return(sc->F); /* not reached */
+}
+
+static s7_pointer g_memv(s7_scheme *sc, s7_pointer args)
+{
+  #define H_memv "(memv obj list) looks for obj in list and returns the list from that point if it is found, otherwise #f. memv uses eqv?"
+  #define Q_memv sc->pl_tl
+  return(memv_p_pp(sc, car(args), cadr(args)));
+}
+
+
+s7_pointer s7_member(s7_scheme *sc, s7_pointer sym, s7_pointer lst)
+{
+  for (s7_pointer x = lst; is_pair(x); x = cdr(x))
+    if (s7_is_equal(sc, sym, car(x)))
+      return(x);
+  return(sc->F);
+}
+
+static s7_pointer member(s7_scheme *sc, s7_pointer obj, s7_pointer x)
+{
+  s7_pointer y = x;
+  if (is_string(obj))
+    while (true)
+      {
+	if ((obj == car(x)) ||
+	    ((is_string(car(x))) &&
+	     (scheme_strings_are_equal(obj, car(x)))))
+	  return(x);
+	x = cdr(x);
+	if (!is_pair(x)) return(sc->F);
+
+	if ((obj == car(x)) ||
+	    ((is_string(car(x))) &&
+	     (scheme_strings_are_equal(obj, car(x)))))
+	  return(x);
+	x = cdr(x);
+	if (!is_pair(x)) return(sc->F);
+	y = cdr(y);
+	if (x == y) return(sc->F);
+      }
+  else
+    while (true)
+      {
+	LOOP_4(if (s7_is_equal(sc, obj, car(x))) return(x); x = cdr(x); if (!is_pair(x)) return(sc->F));
+	y = cdr(y);
+	if (x == y) return(sc->F);
+      }
+  return(sc->F);
+}
+
+static bool p_to_b(opt_info *p);
+
+static s7_pointer g_member(s7_scheme *sc, s7_pointer args)
+{
+  #define H_member "(member obj list (func #f)) looks for obj in list and returns the list from that point if it is found, otherwise #f. \
+member uses equal?  If 'func' is a function of 2 arguments, it is used for the comparison instead of 'equal?"
+  #define Q_member s7_make_signature(sc, 4, s7_make_signature(sc, 2, sc->is_pair_symbol, sc->not_symbol), sc->T, sc->is_list_symbol, sc->is_procedure_symbol)
+
+  /* this could be extended to accept sequences:
+   *    (member #\a "123123abnfc" char=?) -> "abnfc"
+   *    (member "abc" "123abc321" string=?) -> "abc321" but there's the string length complication
+   *    (member 1 #(0 1 2) =) -> #(1 2) etc but what would it do for a hash-table?
+   * the third arg can be weird: (member #f (list #t) cons) -> (#t) -- cons returns '(#f . #t) which is true, so we get '(#t)
+   * should this be an error: (member '(1 2 3) () '(1 . 2)) -- the third arg is bogus, but the second is nil
+   *
+   * here as in assoc, sort, and make-hash-table we accept macros, but I can't think of a good reason to do so.
+   */
+  s7_pointer x = cadr(args), obj;
+
+  if ((!is_pair(x)) && (!is_null(x)))
+    return(method_or_bust(sc, x, sc->member_symbol, args, a_list_string, 2));
+
+  if (is_not_null(cddr(args)))
+    {
+      s7_pointer y, eq_func = caddr(args);
+
+      if (is_safe_c_function(eq_func))
+	{
+	  s7_function func = c_function_call(eq_func);
+	  if (func == g_is_eq) return(is_null(x) ? sc->F : s7_memq(sc, car(args), x));
+	  if (func == g_is_eqv) return(g_memv(sc, args));
+	  if (func == g_less)
+	    func = g_less_2;
+	  else
+	    if (func == g_greater)
+	      func = g_greater_2;
+	  else
+	    if (!s7_is_aritable(sc, eq_func, 2))
+	      wrong_type_error_nr(sc, sc->member_symbol, 3, eq_func, an_eq_func_string);
+	  set_car(sc->t2_1, car(args));
+	  for (s7_pointer slow = x; is_pair(x); x = cdr(x), slow = cdr(slow))
+	    {
+	      set_car(sc->t2_2, car(x));
+	      if (is_true(sc, func(sc, sc->t2_1))) return(x);
+	      if (!is_pair(cdr(x))) return(sc->F);
+	      x = cdr(x);
+	      if (x == slow) return(sc->F);
+	      set_car(sc->t2_2, car(x));
+	      if (is_true(sc, func(sc, sc->t2_1))) return(x);
+	    }
+	  return(sc->F);
+	}
+
+      if (closure_has_two_normal_args(sc, eq_func))
+	{
+	  s7_pointer body = closure_body(eq_func);
+	  if (is_null(x)) return(sc->F);
+	  if ((!no_bool_opt(body)) &&
+	      (is_null(cdr(body))))
+	    {
+	      s7_pfunc func;
+	      set_curlet(sc, make_let_with_two_slots(sc, sc->curlet, car(closure_args(eq_func)), car(args), cadr(closure_args(eq_func)), sc->F));
+	      func = s7_bool_optimize(sc, body);
+	      if (func)
+		{
+		  opt_info *o = sc->opts[0];
+		  s7_pointer b = next_slot(let_slots(sc->curlet));
+		  if (o->v[0].fb == p_to_b)
+		    {
+		      s7_pointer (*fp)(opt_info *o) = o->v[O_WRAP].fp;
+		      for (s7_pointer slow = x; is_pair(x); x = cdr(x), slow = cdr(slow))
+			{
+			  slot_set_value(b, car(x));
+			  if (fp(o) != sc->F) return(x);
+			  if (!is_pair(cdr(x))) return(sc->F);
+			  x = cdr(x);
+			  if (x == slow) return(sc->F);
+			  slot_set_value(b, car(x));
+			  if (fp(o) != sc->F) return(x);
+			}}
+		  else
+		    for (s7_pointer slow = x; is_pair(x); x = cdr(x), slow = cdr(slow))
+		      {
+			slot_set_value(b, car(x));
+			if (o->v[0].fb(o)) return(x);
+			if (!is_pair(cdr(x))) return(sc->F);
+			x = cdr(x);
+			if (x == slow) return(sc->F);
+			slot_set_value(b, car(x));
+			if (o->v[0].fb(o)) return(x);
+		      }
+		  return(sc->F);
+		}
+	      set_no_bool_opt(body);
+	    }}
+      if (type(eq_func) < T_CONTINUATION)
+	return(method_or_bust(sc, eq_func, sc->member_symbol, args, a_procedure_string, 3));
+      if (!s7_is_aritable(sc, eq_func, 2))
+	wrong_type_error_nr(sc, sc->member_symbol, 3, eq_func, an_eq_func_string);
+      if (is_null(x)) return(sc->F);
+      if ((is_any_macro(eq_func)) && (!is_c_macro(eq_func))) clear_all_optimizations(sc, closure_body(eq_func));
+      y = list_1(sc, copy_proper_list(sc, args)); /* this could probably be handled with a counter cell (cdr here is unused) */
+      set_opt1_fast(y, x);
+      set_opt2_slow(y, x);
+      push_stack(sc, OP_MEMBER_IF, list_1(sc, y), eq_func);
+      if (needs_copied_args(eq_func))
+	push_stack(sc, OP_APPLY, list_2_unchecked(sc, car(args), car(x)), eq_func);
+      else
+	{
+	  set_car(sc->t2_1, car(args));
+	  set_car(sc->t2_2, car(x));
+	  push_stack(sc, OP_APPLY, sc->t2_1, eq_func);
+	}
+      return(sc->unspecified);
+    }
+  if (is_null(x)) return(sc->F);
+  obj = car(args);
+  if (is_simple(obj))
+    return(s7_memq(sc, obj, x));
+  /* the only things that aren't simply == here are c_object, string, number, vector, hash-table, pair, and c_pointer, but all the other cases are unlikely */
+  if (is_number(obj))
+    return(memv_number(sc, obj, x));
+  return(member(sc, obj, x));
+}
+
+static s7_pointer member_p_pp(s7_scheme *sc, s7_pointer obj, s7_pointer x)
+{
+  if (is_null(x)) return(sc->F);
+  if (!is_pair(x)) return(method_or_bust(sc, x, sc->member_symbol, set_plist_2(sc, obj, x), a_list_string, 2));
+  if (is_simple(obj)) return(s7_memq(sc, obj, x));
+  if (is_number(obj)) return(memv_number(sc, obj, x));
+  return(member(sc, obj, x));
+}
+
+static s7_pointer member_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  if ((args == 3) && (is_normal_symbol(cadddr(expr))))
+    {
+      if (cadddr(expr) == sc->is_eq_symbol) return(memq_chooser(sc, global_value(sc->memq_symbol), 2, expr));
+      if (cadddr(expr) == sc->is_eqv_symbol) return(global_value(sc->memv_symbol));
+    }
+  return(f);
+}
+
+static bool op_member_if(s7_scheme *sc)
+{
+  s7_pointer orig_args = car(sc->args);
+  /* code=func, args = (list (list original args)) with opt1_fast->position in cadr (the list),
+   *   the extra indirection (list (list...)) is needed because call/cc copies arg lists
+   * value = result of comparison
+   */
+  if (sc->value != sc->F)                      /* previous comparison was not #f -- return list */
+    {
+      sc->value = opt1_fast(orig_args);
+      return(true);
+    }
+  if (!is_pair(cdr(opt1_fast(orig_args))))      /* no more args -- return #f */
+    {
+      sc->value = sc->F;
+      return(true);
+    }
+  set_opt1_fast(orig_args, cdr(opt1_fast(orig_args))); /* cdr down arg list */
+
+  if (sc->cur_op == OP_MEMBER_IF1)
+    {
+      /* circular list check */
+      if (opt1_fast(orig_args) == opt2_slow(orig_args))
+	{
+	  sc->value = sc->F;
+	  return(true);
+	}
+      set_opt2_slow(orig_args, cdr(opt2_slow(orig_args))); /* cdr down the slow list (check for circular list) */
+      push_stack_direct(sc, OP_MEMBER_IF);
+    }
+  else push_stack_direct(sc, OP_MEMBER_IF1);
+
+  if (needs_copied_args(sc->code))
+    sc->args = list_2(sc, caar(orig_args), car(opt1_fast(orig_args)));
+  else sc->args = set_plist_2(sc, caar(orig_args), car(opt1_fast(orig_args)));
+  return(false);
+}
+
+
+/* -------------------------------- list -------------------------------- */
+static s7_pointer g_list(s7_scheme *sc, s7_pointer args)
+{
+  #define H_list "(list ...) returns its arguments in a list"
+  #define Q_list s7_make_circular_signature(sc, 1, 2, sc->is_proper_list_symbol, sc->T)
+  return(copy_proper_list(sc, args));
+}
+
+static s7_pointer g_list_0(s7_scheme *sc, s7_pointer args) {return(sc->nil);}
+static s7_pointer g_list_1(s7_scheme *sc, s7_pointer args) {return(list_1(sc, car(args)));}
+static s7_pointer g_list_2(s7_scheme *sc, s7_pointer args) {return(list_2(sc, car(args), cadr(args)));}
+static s7_pointer g_list_3(s7_scheme *sc, s7_pointer args) {return(list_3(sc, car(args), cadr(args), caddr(args)));}
+static s7_pointer g_list_4(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer p = cddr(args);
+  return(list_4(sc, car(args), cadr(args), car(p), cadr(p)));
+}
+
+static s7_pointer list_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer unused_expr)
+{
+  if (args == 0) return(sc->list_0);
+  if (args == 1) return(sc->list_1);
+  if (args == 2) return(sc->list_2);
+  if (args == 3) return(sc->list_3);
+  return((args == 4) ? sc->list_4 : f);
+}
+
+static s7_pointer list_p_p(s7_scheme *sc, s7_pointer p1) {return(list_1(sc, sc->value = p1));}
+static s7_pointer list_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) {return(list_2(sc, p1, p2));}
+static s7_pointer list_p_ppp(s7_scheme *sc, s7_pointer p1, s7_pointer p2, s7_pointer p3) {return(list_3(sc, p1, p2, p3));}
+/* if the GC sees a free cell here, protect it in the caller, not here, but sometimes the GC is called here! */
+
+static void check_list_validity(s7_scheme *sc, const char *caller, s7_pointer lst)
+{
+  s7_pointer p = lst;
+  for (int32_t i = 1; is_pair(p); p = cdr(p), i++)
+    if (!s7_is_valid(sc, car(p)))
+      {
+	if (i < 11)
+	  s7_warn(sc, 256, "the %s argument to %s: %p, is not an s7 object\n", ordinal[i], caller, car(p));
+	else s7_warn(sc, 256, "%s: argument number %d is not an s7 object: %p\n", caller, i, car(p));
+      }
+}
+
+s7_pointer s7_list(s7_scheme *sc, s7_int num_values, ...)
+{
+  va_list ap;
+  s7_pointer p, old_sw = sc->w;
+  if (num_values == 0)
+    return(sc->nil);
+  sc->w = make_list(sc, num_values, sc->unused);
+  p = sc->w;
+  va_start(ap, num_values);
+  for (s7_int i = 0; i < num_values; i++, p = cdr(p))
+    set_car(p, va_arg(ap, s7_pointer));
+  va_end(ap);
+  if (sc->safety > NO_SAFETY)
+    check_list_validity(sc, __func__, sc->w);
+  p = sc->w;
+  sc->w = old_sw;
+  return(p);
+}
+
+s7_pointer s7_list_nl(s7_scheme *sc, s7_int num_values, ...) /* arglist should be NULL terminated */
+{
+  s7_int i = 0;
+  va_list ap;
+  s7_pointer p;
+
+  if (num_values == 0)
+    return(sc->nil);
+
+  sc->w = make_list(sc, num_values, sc->unused);
+  va_start(ap, num_values);
+  for (s7_pointer q = sc->w; i < num_values; i++, q = cdr(q))
+    {
+      p = va_arg(ap, s7_pointer);
+      if (!p)
+	{
+	  va_end(ap);
+	  wrong_number_of_arguments_error_nr(sc, "not enough arguments for s7_list_nl: ~S", 39, sc->w); /* ideally we'd sublist this and append extra below */
+	}
+      set_car(q, p);
+    }
+  p = va_arg(ap, s7_pointer);
+  va_end(ap);
+  if (p) wrong_number_of_arguments_error_nr(sc, "too many arguments for s7_list_nl: ~S", 37, sc->w);
+
+  if (sc->safety > NO_SAFETY)
+    check_list_validity(sc, __func__, sc->w);
+
+  p = sc->w;
+  sc->w = sc->unused;
+  return(p);
+}
+
+static s7_pointer safe_list_1(s7_scheme *sc)
+{
+  if (!list_is_in_use(sc->safe_lists[1]))
+    {
+      sc->current_safe_list = 1;
+      set_list_in_use(sc->safe_lists[1]);
+#if S7_DEBUGGING
+      sc->safe_list_uses[1]++;
+#endif
+      return(sc->safe_lists[1]);
+    }
+  return(cons(sc, sc->nil, sc->nil));
+}
+
+static s7_pointer safe_list_2(s7_scheme *sc)
+{
+  if (!list_is_in_use(sc->safe_lists[2]))
+    {
+      sc->current_safe_list = 2;
+      set_list_in_use(sc->safe_lists[2]);
+#if S7_DEBUGGING
+      sc->safe_list_uses[2]++;
+#endif
+      return(sc->safe_lists[2]);
+    }
+  return(cons_unchecked(sc, sc->nil, list_1(sc, sc->nil)));
+}
+
+static s7_pointer make_safe_list(s7_scheme *sc, s7_int num_args)
+{
+  if (num_args < NUM_SAFE_LISTS)
+    {
+      sc->current_safe_list = num_args;
+      if (!is_pair(sc->safe_lists[num_args]))
+	sc->safe_lists[num_args] = semipermanent_list(sc, num_args);
+      if (!list_is_in_use(sc->safe_lists[num_args]))
+	{
+	  set_list_in_use(sc->safe_lists[num_args]);
+#if S7_DEBUGGING
+	  sc->safe_list_uses[num_args]++;
+#endif
+	  return(sc->safe_lists[num_args]);
+	}}
+  return(make_big_list(sc, num_args, sc->nil));
+}
+
+static inline s7_pointer safe_list_if_possible(s7_scheme *sc, s7_int num_args)
+{
+  if ((num_args < NUM_SAFE_PRELISTS) &&
+      (!list_is_in_use(sc->safe_lists[num_args])))
+    {
+      sc->current_safe_list = num_args;
+      set_list_in_use(sc->safe_lists[num_args]);
+#if S7_DEBUGGING
+      sc->safe_list_uses[num_args]++;
+#endif
+      return(sc->safe_lists[num_args]);
+    }
+  return(make_safe_list(sc, num_args));
+}
+
+static s7_pointer g_list_append(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer tp = sc->nil, np = NULL, pp;
+
+  /* we know here that car(args) is a list and cdr(args) is not nil; this function does not check sc->max_list_length; called only in g_append */
+  gc_protect_via_stack(sc, args);
+  for (s7_pointer y = args; is_pair(y); y = cdr(y)) /* arglist so not dotted */
+    {
+      s7_pointer p = car(y), func;
+
+      if ((has_active_methods(sc, p)) &&
+	  ((func = find_method_with_let(sc, p, sc->append_symbol)) != sc->undefined))
+	{
+	  unstack_gc_protect(sc);
+	  return(s7_apply_function(sc, func, (is_null(tp)) ? y : set_ulist_1(sc, tp, y)));
+	}
+      if (is_null(cdr(y)))
+	{
+	  if (is_null(tp))
+	    {
+	      /* Guile: (append '() 1): 1, r7rs claims an improper list is the result, yet its own examples contradict that
+	       *   (what does "share structure" mean when there are no structures?  I assume they mean sequences)
+	       */
+	      unstack_gc_protect(sc);
+	      return(p);
+	    }
+	  if (is_list(p))
+	    set_cdr(np, p);
+	  else
+	    {
+	      s7_int len = sequence_length(sc, p);
+	      if (len > 0)
+		set_cdr(np, s7_copy_1(sc, sc->append_symbol, set_plist_2(sc, p, make_list(sc, len, sc->unused))));
+	      else
+		if (len < 0)
+		  set_cdr(np, p);
+	    }
+	  sc->temp8 = sc->unused;
+	  unstack_gc_protect(sc);
+	  return(tp);
+	}
+
+      if (!is_sequence(p))
+	{
+	  unstack_gc_protect(sc);
+	  wrong_type_error_nr(sc, sc->append_symbol, position_of(y, args), p, a_sequence_string);
+	}
+      if (!sequence_is_empty(sc, p))
+	{
+	  if (is_pair(p))
+	    {
+	      if (!s7_is_proper_list(sc, p))
+		{
+		  sc->temp8 = sc->unused;
+		  unstack_gc_protect(sc);
+		  wrong_type_error_nr(sc, sc->append_symbol, position_of(y, args), p, a_proper_list_string);
+		}
+	      if (is_null(tp))
+		{
+		  tp = list_1(sc, car(p));
+		  np = tp;
+		  sc->temp8 = tp; /* GC protect? */
+		  pp = cdr(p);
+		}
+	      else pp = p;
+	      for (; is_pair(pp); pp = cdr(pp), np = cdr(np))
+		set_cdr(np, list_1(sc, car(pp)));
+	    }
+	  else
+	    {
+	      s7_int len = sequence_length(sc, p);
+	      if (len > 0)
+		{
+		  if (is_null(tp))
+		    {
+		      tp = s7_copy_1(sc, sc->append_symbol, set_plist_2(sc, p, make_list(sc, len, sc->unused)));
+		      np = tp;
+		      sc->temp8 = tp;
+		    }
+		  else set_cdr(np, s7_copy_1(sc, sc->append_symbol, set_plist_2(sc, p, make_list(sc, len, sc->unused))));
+		  for (; is_pair(cdr(np)); np = cdr(np));
+		}
+	      else
+		if (len < 0)
+		  {
+		    unstack_gc_protect(sc);
+		    wrong_type_error_nr(sc, sc->append_symbol, position_of(y, args), p, a_sequence_string);
+		  }}}}
+  unstack_gc_protect(sc);
+  return(tp);
+}
+
+static s7_pointer append_in_place(s7_scheme *sc, s7_pointer a, s7_pointer b)
+{
+  /* tack b onto the end of a without copying either -- 'a' is changed! */
+  s7_pointer p;
+  if (is_null(a)) return(b);
+  p = a;
+  while (is_not_null(cdr(p))) p = cdr(p);
+  set_cdr(p, b);
+  return(a);
+}
+
+
+/* -------------------------------- vectors -------------------------------- */
+bool s7_is_vector(s7_pointer p)       {return(is_any_vector(p));}
+bool s7_is_float_vector(s7_pointer p) {return(is_float_vector(p));}
+bool s7_is_int_vector(s7_pointer p)   {return(is_int_vector(p));}
+bool s7_is_byte_vector(s7_pointer p)  {return(is_byte_vector(p));}
+
+static bool is_byte_vector_b_p(s7_pointer b) {return(is_byte_vector(b));}
+
+s7_int s7_vector_length(s7_pointer vec) {return(vector_length(vec));}
+
+static s7_pointer t_vector_setter(s7_scheme *sc, s7_pointer vec, s7_int loc, s7_pointer val)
+{
+  vector_element(vec, loc) = val;
+  return(val);
+}
+
+static s7_pointer typed_vector_typer_symbol(s7_scheme *sc, s7_pointer p)
+{
+  s7_pointer typer = typed_vector_typer(p);
+  return((is_c_function(typer)) ? c_function_symbol(typer) : find_closure(sc, typer, closure_let(typer)));
+}
+
+static const char *typed_vector_typer_name(s7_scheme *sc, s7_pointer p)
+{
+  s7_pointer typer = typed_vector_typer(p);
+  return((is_c_function(typer)) ? c_function_name(typer) : symbol_name(typed_vector_typer_symbol(sc, p)));
+}
+
+static void port_write_vector_typer(s7_scheme *sc, s7_pointer vect, s7_pointer port)
+{
+  const char *setter = make_type_name(sc, typed_vector_typer_name(sc, vect), NO_ARTICLE);
+  port_write_string(port)(sc, setter, safe_strlen(setter), port);
+}
+
+static noreturn void typed_vector_type_error_nr(s7_scheme *sc, s7_pointer vec, s7_pointer val)
+{
+  const char *descr = typed_vector_typer_name(sc, vec);
+  error_nr(sc, sc->wrong_type_arg_symbol,
+	   set_elist_4(sc, wrap_string(sc, "vector-set! third argument ~$, is ~A, but the vector's element type checker, ~A, rejects it", 91),
+		       val, type_name_string(sc, val), wrap_string(sc, descr, safe_strlen(descr))));
+}
+
+static inline s7_pointer typed_vector_setter(s7_scheme *sc, s7_pointer vec, s7_int loc, s7_pointer val) /* tstr faster without inline, but tbig slower */
+{
+  if ((sc->safety >= NO_SAFETY) &&
+      (typed_vector_typer_call(sc, vec, set_plist_1(sc, val)) == sc->F))
+    typed_vector_type_error_nr(sc, vec, val);
+  vector_element(vec, loc) = val;
+  return(val);
+}
+
+static s7_pointer t_vector_getter(s7_scheme *sc, s7_pointer vec, s7_int loc)     {return(vector_element(vec, loc));}
+static s7_pointer int_vector_getter(s7_scheme *sc, s7_pointer vec, s7_int loc)   {return(make_integer(sc, int_vector(vec, loc)));}
+static s7_pointer float_vector_getter(s7_scheme *sc, s7_pointer vec, s7_int loc) {return(make_real(sc, float_vector(vec, loc)));}
+static s7_pointer byte_vector_getter(s7_scheme *sc, s7_pointer bv, s7_int loc)   {return(small_int(byte_vector(bv, loc)));}
+
+static s7_pointer int_vector_setter(s7_scheme *sc, s7_pointer vec, s7_int loc, s7_pointer val)
+{
+  if (s7_is_integer(val))
+    int_vector(vec, loc) = s7_integer_clamped_if_gmp(sc, val);
+  else wrong_type_error_nr(sc, sc->int_vector_set_symbol, 3, val, sc->type_names[T_INTEGER]);
+  return(val);
+}
+
+static s7_pointer float_vector_setter(s7_scheme *sc, s7_pointer vec, s7_int loc, s7_pointer val)
+{
+  float_vector(vec, loc) = real_to_double(sc, val, "float-vector-set!");
+  return(val);
+}
+
+static s7_pointer byte_vector_setter(s7_scheme *sc, s7_pointer str, s7_int loc, s7_pointer val)
+{
+  s7_int byte;
+  if (!s7_is_integer(val))
+    wrong_type_error_nr(sc, sc->byte_vector_set_symbol, 3, val, sc->type_names[T_INTEGER]);
+  byte = s7_integer_clamped_if_gmp(sc, val);
+  if ((byte < 0) || (byte >= 256))
+    wrong_type_error_nr(sc, sc->byte_vector_set_symbol, 3, val, wrap_string(sc, "a byte", 6));
+  byte_vector(str, loc) = (uint8_t)byte;
+  return(val);
+}
+
+static block_t *mallocate_empty_block(s7_scheme *sc)
+{
+  block_t *b;
+  b = mallocate_block(sc);
+#if S7_DEBUGGING
+  sc->blocks_mallocated[BLOCK_LIST]++;
+#endif
+  block_data(b) = NULL;
+  block_info(b) = NULL;
+  return(b);
+}
+
+#define mallocate_vector(Sc, Len) ((Len) > 0) ? inline_mallocate(Sc, Len) : mallocate_empty_block(Sc)
+
+static inline s7_pointer make_simple_vector(s7_scheme *sc, s7_int len) /* len >= 0 and < max */
+{
+  s7_pointer x;
+  block_t *b = mallocate_vector(sc, len * sizeof(s7_pointer));
+  new_cell(sc, x, T_VECTOR | T_SAFE_PROCEDURE);
+  vector_length(x) = len;
+  vector_block(x) = b;
+  vector_elements(x) = (s7_pointer *)block_data(b);
+  vector_set_dimension_info(x, NULL);
+  vector_getter(x) = t_vector_getter;
+  vector_setter(x) = t_vector_setter;
+  add_vector(sc, x);
+  return(x);
+}
+
+static inline s7_pointer make_simple_float_vector(s7_scheme *sc, s7_int len) /* len >= 0 and < max */
+{
+  s7_pointer x;
+  block_t *b = mallocate_vector(sc, len * sizeof(s7_double));
+  new_cell(sc, x, T_FLOAT_VECTOR | T_SAFE_PROCEDURE);
+  vector_length(x) = len;
+  vector_block(x) = b;
+  float_vector_floats(x) = (s7_double *)block_data(b);
+  vector_set_dimension_info(x, NULL);
+  vector_getter(x) = float_vector_getter;
+  vector_setter(x) = float_vector_setter;
+  add_vector(sc, x);
+  return(x);
+}
+
+static inline s7_pointer make_simple_int_vector(s7_scheme *sc, s7_int len) /* len >= 0 and < max */
+{
+  s7_pointer x;
+  block_t *b = mallocate_vector(sc, len * sizeof(s7_int));
+  new_cell(sc, x, T_INT_VECTOR | T_SAFE_PROCEDURE);
+  vector_length(x) = len;
+  vector_block(x) = b;
+  int_vector_ints(x) = (s7_int *)block_data(b);
+  vector_set_dimension_info(x, NULL);
+  vector_getter(x) = int_vector_getter;
+  vector_setter(x) = int_vector_setter;
+  add_vector(sc, x);
+  return(x);
+}
+
+static s7_pointer make_simple_byte_vector(s7_scheme *sc, s7_int len)
+{
+  s7_pointer x;
+  block_t *b = inline_mallocate(sc, len);
+  new_cell(sc, x, T_BYTE_VECTOR | T_SAFE_PROCEDURE);
+  vector_block(x) = b;
+  byte_vector_bytes(x) = (uint8_t *)block_data(b);
+  vector_length(x) = len;
+  vector_set_dimension_info(x, NULL);
+  vector_getter(x) = byte_vector_getter;
+  vector_setter(x) = byte_vector_setter;
+  add_vector(sc, x);
+  return(x);
+}
+
+static Vectorized void t_vector_fill(s7_pointer vec, s7_pointer obj)
+{
+  s7_pointer *orig = vector_elements(vec);
+  s7_int len = vector_length(vec), i, left;
+  if (len == 0) return;
+  /* splitting out this part made no difference in speed; type check of obj is handled elsewhere */
+  left = len - 8;
+  i = 0;
+  while (i <= left)
+    LOOP_8(orig[i++] = obj);
+  for (; i < len; i++)
+    orig[i] = obj;
+}
+
+static s7_pointer make_vector_1(s7_scheme *sc, s7_int len, bool filled, uint8_t typ)
+{
+  s7_pointer x;
+
+  if (len < 0)
+    out_of_range_error_nr(sc, sc->make_vector_symbol, int_one, wrap_integer(sc, len), it_is_negative_string);
+  if (len > sc->max_vector_length)
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_3(sc, wrap_string(sc, "make-vector length argument ~D is greater than (*s7* 'max-vector-length), ~D", 76),
+			 wrap_integer(sc, len), wrap_integer(sc, sc->max_vector_length)));
+
+  /* this has to follow the error checks! (else garbage in free_heap temps portion confuses GC when "vector" is finalized) */
+  new_cell(sc, x, typ | T_SAFE_PROCEDURE);
+  vector_length(x) = len;
+  if (len == 0)
+    {
+      vector_block(x) = mallocate_empty_block(sc);
+      any_vector_elements(x) = NULL;
+      if (typ == T_VECTOR) set_has_simple_elements(x);
+    }
+  else
+    if (typ == T_VECTOR)
+      {
+	block_t *b = inline_mallocate(sc, len * sizeof(s7_pointer));
+	vector_block(x) = b;
+	vector_elements(x) = (s7_pointer *)block_data(b);
+	vector_getter(x) = t_vector_getter;
+	vector_setter(x) = t_vector_setter;
+	if (filled) t_vector_fill(x, sc->nil);
+      }
+    else
+      if (typ == T_FLOAT_VECTOR)
+	{
+	  block_t *b = inline_mallocate(sc, len * sizeof(s7_double));
+	  vector_block(x) = b;
+	  float_vector_floats(x) = (s7_double *)block_data(b);
+	  if (filled)
+	    {
+	      if (STEP_8(len))
+		memclr64((void *)float_vector_floats(x), len * sizeof(s7_double));
+	      else memclr((void *)float_vector_floats(x), len * sizeof(s7_double));
+	    }
+	  vector_getter(x) = float_vector_getter;
+	  vector_setter(x) = float_vector_setter;
+	}
+      else
+	if (typ == T_INT_VECTOR)
+	  {
+	    block_t *b = inline_mallocate(sc, len * sizeof(s7_int));
+	    vector_block(x) = b;
+	    int_vector_ints(x) = (s7_int *)block_data(b);
+	    if (filled)
+	      {
+		if (STEP_8(len))
+		  memclr64((void *)int_vector_ints(x), len * sizeof(s7_int));
+		else memclr((void *)int_vector_ints(x), len * sizeof(s7_int));
+	      }
+	    vector_getter(x) = int_vector_getter;
+	    vector_setter(x) = int_vector_setter;
+	  }
+	else /* byte-vector */
+	  {
+	    block_t *b = mallocate(sc, len);
+	    vector_block(x) = b;
+	    byte_vector_bytes(x) = (uint8_t *)block_data(b);
+	    vector_getter(x) = byte_vector_getter;
+	    vector_setter(x) = byte_vector_setter;
+	    if (filled)
+	      {
+		if (STEP_64(len))
+		  memclr64((void *)(byte_vector_bytes(x)), len);
+		else memclr((void *)(byte_vector_bytes(x)), len);
+	      }}
+  vector_set_dimension_info(x, NULL);
+  return(x);
+}
+
+#define FILLED true
+#define NOT_FILLED false
+
+s7_pointer s7_make_vector(s7_scheme *sc, s7_int len)
+{
+  s7_pointer v = make_vector_1(sc, len, FILLED, T_VECTOR);
+  add_vector(sc, v);
+  return(v);
+}
+
+s7_pointer s7_make_and_fill_vector(s7_scheme *sc, s7_int len, s7_pointer fill)
+{
+  s7_pointer vect = make_simple_vector(sc, len);
+  t_vector_fill(vect, fill);
+  return(vect);
+}
+
+static vdims_t *make_wrap_only(s7_scheme *sc) /* this makes sc->wrap_only */
+{
+  vdims_t *v = (vdims_t *)mallocate_block(sc);
+#if S7_DEBUGGING
+  sc->blocks_mallocated[BLOCK_LIST]++;
+#endif
+  vdims_original(v) = sc->F;
+  vector_elements_should_be_freed(v) = false;
+  vdims_rank(v) = 1;
+  vdims_dims(v) = NULL;
+  vdims_offsets(v) = NULL;
+  return(v);
+}
+
+static vdims_t *make_vdims(s7_scheme *sc, bool elements_should_be_freed, s7_int dims, const s7_int *dim_info)
+{
+  vdims_t *v;
+  if ((dims == 1) && (!elements_should_be_freed))
+    return(sc->wrap_only);
+
+  if (dims > 1)
+    {
+      s7_int offset = 1;
+      v = (vdims_t *)mallocate(sc, dims * 2 * sizeof(s7_int));
+      vdims_original(v) = sc->F;
+      vector_elements_should_be_freed(v) = elements_should_be_freed;
+      vdims_rank(v) = dims;
+      vdims_offsets(v) = (s7_int *)(vdims_dims(v) + dims);
+      for (s7_int i = 0; i < dims; i++)
+	vdims_dims(v)[i] = dim_info[i];
+      for (s7_int i = dims - 1; i >= 0; i--)
+	{
+	  vdims_offsets(v)[i] = offset;
+	  offset *= vdims_dims(v)[i];
+	}
+      return(v);
+    }
+  v = (vdims_t *)mallocate_block(sc);
+#if S7_DEBUGGING
+  sc->blocks_mallocated[BLOCK_LIST]++;
+#endif
+  vdims_original(v) = sc->F;
+  vector_elements_should_be_freed(v) = elements_should_be_freed;
+  vdims_rank(v) = 1;
+  vdims_dims(v) = NULL;
+  vdims_offsets(v) = NULL;
+  return(v);
+}
+
+static s7_pointer make_any_vector(s7_scheme *sc, int32_t type, s7_int len, s7_int dims, const s7_int *dim_info)
+{
+  const s7_pointer p = make_vector_1(sc, len, FILLED, type);
+  if (dim_info)
+    {
+      vector_set_dimension_info(p, make_vdims(sc, false, dims, dim_info));
+      add_multivector(sc, p);
+    }
+  else add_vector(sc, p);
+  return(p);
+}
+
+s7_pointer s7_make_int_vector(s7_scheme *sc, s7_int len, s7_int dims, s7_int *dim_info)    {return(make_any_vector(sc, T_INT_VECTOR, len, dims, dim_info));}
+s7_pointer s7_make_byte_vector(s7_scheme *sc, s7_int len, s7_int dims, s7_int *dim_info)   {return(make_any_vector(sc, T_BYTE_VECTOR, len, dims, dim_info));}
+s7_pointer s7_make_float_vector(s7_scheme *sc, s7_int len, s7_int dims, s7_int *dim_info)  {return(make_any_vector(sc, T_FLOAT_VECTOR, len, dims, dim_info));}
+s7_pointer s7_make_normal_vector(s7_scheme *sc, s7_int len, s7_int dims, s7_int *dim_info) {return(make_any_vector(sc, T_VECTOR, len, dims, dim_info));}
+
+s7_pointer s7_make_float_vector_wrapper(s7_scheme *sc, s7_int len, s7_double *data, s7_int dims, s7_int *dim_info, bool free_data)
+{
+  /* this wraps up a C-allocated/freed double array as an s7 vector */
+  s7_pointer x;
+  block_t *b = mallocate_empty_block(sc);
+  new_cell(sc, x, T_FLOAT_VECTOR | T_SAFE_PROCEDURE);
+  vector_block(x) = b;
+  float_vector_floats(x) = data;
+  vector_getter(x) = float_vector_getter;
+  vector_setter(x) = float_vector_setter;
+  vector_length(x) = len;
+  if (!dim_info)
+    {
+      s7_int di[1];
+      di[0] = len;
+      vector_set_dimension_info(x, make_vdims(sc, free_data, 1, di));
+    }
+  else vector_set_dimension_info(x, make_vdims(sc, free_data, dims, dim_info));
+  add_multivector(sc, x);
+  return(x);
+}
+
+
+/* -------------------------------- vector-fill! -------------------------------- */
+static Vectorized void float_vector_fill(s7_pointer vec, s7_double x)
+{
+  s7_int len = vector_length(vec);
+  if (len == 0) return;
+  if (x == 0.0)
+    {
+      if (STEP_8(len))
+	memclr64((void *)float_vector_floats(vec), len * sizeof(s7_double));
+      else memclr((void *)float_vector_floats(vec), len * sizeof(s7_double));
+    }
+  else
+    {
+      s7_int i = 0, left = len - 8;
+      s7_double *orig = float_vector_floats(vec);
+      while (i <= left)
+	LOOP_8(orig[i++] = x);
+      for (; i < len; i++)
+	orig[i] = x;
+    }
+}
+
+static Vectorized void int_vector_fill(s7_pointer vec, s7_int k)
+{
+  s7_int len = vector_length(vec);
+  if (len == 0) return;
+  if (k == 0)
+    {
+      if (STEP_8(len))
+	memclr64((void *)int_vector_ints(vec), len * sizeof(s7_int));
+      else memclr((void *)int_vector_ints(vec), len * sizeof(s7_int));
+    }
+  else
+    {
+      s7_int i = 0, left = len - 8;
+      s7_int *orig = int_vector_ints(vec);
+      while (i <= left)
+	LOOP_8(orig[i++] = k);
+      for (; i < len; i++)
+	orig[i] = k;
+    }
+}
+
+static void byte_vector_fill(s7_pointer vec, uint8_t byte)
+{
+  s7_int len = vector_length(vec);
+  if (len == 0) return;
+  if (byte > 0)
+    local_memset((void *)(byte_vector_bytes(vec)), byte, len);
+  else /* byte == 0 */
+    if (STEP_64(len))
+      memclr64((void *)(byte_vector_bytes(vec)), len);
+    else memclr((void *)(byte_vector_bytes(vec)), len);
+}
+
+void s7_vector_fill(s7_scheme *sc, s7_pointer vec, s7_pointer obj)
+{
+  switch (type(vec))
+    {
+    case T_FLOAT_VECTOR:
+      if (!is_real(obj))
+	wrong_type_error_nr(sc, wrap_string(sc, "float-vector fill!", 18), 2, obj, sc->type_names[T_REAL]);
+      float_vector_fill(vec, s7_real(obj));
+      break;
+    case T_INT_VECTOR:
+      if (!s7_is_integer(obj)) /* possibly a bignum */
+	wrong_type_error_nr(sc, wrap_string(sc, "int-vector fill!", 16), 2, obj, sc->type_names[T_INTEGER]);
+      int_vector_fill(vec, s7_integer_clamped_if_gmp(sc, obj));
+      break;
+    case T_BYTE_VECTOR:
+      if (!is_byte(obj))
+	wrong_type_error_nr(sc, wrap_string(sc, "byte-vector fill!", 17), 2, obj, wrap_string(sc, "a byte", 6));
+      byte_vector_fill(vec, (uint8_t)s7_integer_clamped_if_gmp(sc, obj));
+      break;
+    case T_VECTOR:
+    default:
+      t_vector_fill(vec, obj);
+    }
+}
+
+static s7_pointer g_vector_fill_1(s7_scheme *sc, s7_pointer caller, s7_pointer args)
+{
+  s7_pointer x = car(args), fill;
+  s7_int start = 0, end;
+
+  if (!is_any_vector(x))
+    {
+      check_method(sc, x, sc->vector_fill_symbol, args);
+      /* not two_methods (and fill!) here else we get stuff like:
+       *   (let ((e (openlet (inlet 'fill! (lambda (obj val) (string-fill! (obj 'value) val)) 'value "01234")))) (vector-fill! e #\a) (e 'value)) -> "aaaaa"
+       */
+      wrong_type_error_nr(sc, caller, 1, x, sc->type_names[T_VECTOR]);
+    }
+  if (is_immutable_vector(x))
+    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, caller, x));
+
+  fill = cadr(args);
+
+  if ((is_typed_t_vector(x)) &&
+      (typed_vector_typer_call(sc, x, set_plist_1(sc, fill)) == sc->F))
+    {
+      const char *tstr = make_type_name(sc, typed_vector_typer_name(sc, x), INDEFINITE_ARTICLE);
+      wrong_type_error_nr(sc, wrap_string(sc, "vector fill!", 12), 2, fill, wrap_string(sc, tstr, safe_strlen(tstr)));
+    }
+  if (is_float_vector(x))
+    {
+      if (!is_real(fill)) /* possibly a bignum */
+	return(method_or_bust(sc, fill, caller, args, sc->type_names[T_REAL], 2));
+    }
+  else
+    if ((is_int_vector(x)) || (is_byte_vector(x)))
+      {
+	if (!s7_is_integer(fill))
+	  return(method_or_bust(sc, fill, caller, args, sc->type_names[T_INTEGER], 2));
+	if ((is_byte_vector(x)) &&
+	    ((s7_integer_clamped_if_gmp(sc, fill) < 0) || (s7_integer_clamped_if_gmp(sc, fill) > 255)))
+	  error_nr(sc, sc->out_of_range_symbol,
+		   set_elist_3(sc, wrap_string(sc, "~S second argument, ~S, should fit in an unsigned byte", 54), caller, fill));
+      }
+  end = vector_length(x);
+  if (!is_null(cddr(args)))
+    {
+      s7_pointer p = start_and_end(sc, caller, args, 3, cddr(args), &start, &end);
+      if (p != sc->unused) return(p);
+      if (start == end) return(fill);
+    }
+  if (end == 0) return(fill);
+
+  if ((start == 0) && (end == vector_length(x)))
+    s7_vector_fill(sc, x, fill);
+  else
+    if (is_t_vector(x))
+      for (s7_int i = start; i < end; i++) vector_element(x, i) = fill;
+    else
+      if (is_int_vector(x))
+	{
+	  s7_int k = s7_integer_clamped_if_gmp(sc, fill);
+	  if (k == 0)
+	    memclr((void *)(int_vector_ints(x) + start), (end - start) * sizeof(s7_int));
+	  else for (s7_int i = start; i < end; i++) int_vector(x, i) = k;
+	}
+      else
+	if (is_float_vector(x))
+	  {
+	    s7_double y = s7_real(fill);
+	    if (y == 0.0)
+	      memclr((void *)(float_vector_floats(x) + start), (end - start) * sizeof(s7_double));
+	    else
+	      {
+		s7_double *orig = float_vector_floats(x);
+		s7_int left = end - 8;
+		s7_int i = start;
+		while (i <= left)
+		  LOOP_8(orig[i++] = y);
+		for (; i < end; i++)
+		  orig[i] = y;
+	      }}
+	else
+	  if (is_byte_vector(x))
+	    {
+	      uint8_t k = (uint8_t)s7_integer_clamped_if_gmp(sc, fill);
+	      if (k == 0)
+		memclr((void *)(byte_vector_bytes(x) + start), end - start);
+	      else local_memset((void *)(byte_vector_bytes(x) + start), k, end - start);
+	    }
+  return(fill);
+}
+
+#if (!WITH_PURE_S7)
+/* -------------------------------- vector-fill! -------------------------------- */
+static s7_pointer g_vector_fill(s7_scheme *sc, s7_pointer args)
+{
+  #define H_vector_fill "(vector-fill! v val start end) sets all elements of the vector v between start and end to val"
+  #define Q_vector_fill s7_make_circular_signature(sc, 3, 4, sc->T, sc->is_vector_symbol, sc->T, sc->is_integer_symbol)
+  return(g_vector_fill_1(sc, sc->vector_fill_symbol, args));
+}
+
+/* -------------------------------- vector-append -------------------------------- */
+static s7_pointer vector_append(s7_scheme *sc, s7_pointer args, uint8_t typ, s7_pointer caller);
+static s7_pointer copy_source_no_dest(s7_scheme *sc, s7_pointer source, s7_pointer args);
+
+static s7_pointer g_vector_append(s7_scheme *sc, s7_pointer args)
+{
+  /* returns a one-dimensional vector.  To handle multidimensional vectors, we'd need to
+   *   ensure all the dimensional data matches (rank, size of each dimension except the last etc),
+   *   which is too much trouble.
+   */
+  #define H_vector_append "(vector-append . vectors) returns a new (1-dimensional) vector containing the elements of its vector arguments."
+  #define Q_vector_append sc->pcl_v
+
+  s7_pointer p = args;
+  if (is_null(args))
+    return(make_simple_vector(sc, 0));
+
+  if ((is_null(cdr(args))) &&
+      (is_any_vector(car(args))))
+    return(copy_source_no_dest(sc, car(args), args));
+
+  for (int32_t i = 0; is_pair(p); p = cdr(p), i++)
+    {
+      s7_pointer x = car(p);
+      if (!is_any_vector(x))
+	{
+	  if (has_active_methods(sc, x))
+	    {
+	      s7_pointer func = find_method_with_let(sc, x, sc->vector_append_symbol);
+	      if (func != sc->undefined)
+		{
+		  int32_t k;
+		  s7_pointer v, y;
+		  if (i == 0)
+		    return(s7_apply_function(sc, func, args));
+		  sc->temp9 = make_list(sc, i, sc->unused); /* we have to copy the arglist here */
+		  for (k = 0, y = args, v = sc->temp9; k < i; k++, y = cdr(y), v = cdr(v))
+		    set_car(v, car(y));
+		  v = g_vector_append(sc, sc->temp9);
+		  y = s7_apply_function(sc, func, set_ulist_1(sc, v, p));
+		  sc->temp9 = sc->unused;
+		  return(y);
+		}}
+	  wrong_type_error_nr(sc, sc->vector_append_symbol, i + 1, x, sc->type_names[T_VECTOR]);
+	}}
+  return(vector_append(sc, args, type(car(args)), sc->vector_append_symbol));
+}
+
+static s7_pointer vector_append_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  s7_pointer val;
+  sc->temp7 = list_2(sc, p1, p2); /* ideally this list would be gc_protected, avoiding temp7 (method call above) */
+  val = g_vector_append(sc, sc->temp7);
+  sc->temp7 = sc->unused;
+  return(val);
+}
+
+static s7_pointer vector_append_p_ppp(s7_scheme *sc, s7_pointer p1, s7_pointer p2, s7_pointer p3)
+{
+  s7_pointer val;
+  sc->temp7 = list_3(sc, p1, p2, p3);
+  val = g_vector_append(sc, sc->temp7);
+  sc->temp7 = sc->unused;
+  return(val);
+}
+#endif
+
+
+/* -------------------------------- vector-ref|set! -------------------------------- */
+s7_pointer s7_vector_ref(s7_scheme *sc, s7_pointer vec, s7_int index)
+{
+  if (index >= vector_length(vec))
+    out_of_range_error_nr(sc, sc->vector_ref_symbol, int_two, wrap_integer(sc, index), it_is_too_large_string);
+  return(vector_getter(vec)(sc, vec, index));
+}
+
+s7_pointer s7_vector_set(s7_scheme *sc, s7_pointer vec, s7_int index, s7_pointer a)
+{
+  if (index >= vector_length(vec))
+    out_of_range_error_nr(sc, sc->vector_set_symbol, int_two, wrap_integer(sc, index), it_is_too_large_string);
+  if (is_typed_vector(vec))
+    return(typed_vector_setter(sc, vec, index, a));
+  vector_setter(vec)(sc, vec, index, T_Ext(a));
+  return(a);
+}
+
+s7_pointer *s7_vector_elements(s7_pointer vec) {return(vector_elements(vec));}
+
+/* these are for s7.h */
+s7_int *s7_int_vector_elements(s7_pointer vec) {return(int_vector_ints(vec));}
+s7_int s7_int_vector_ref(s7_pointer vec, s7_int index) {return(int_vector(vec, index));}
+s7_int s7_int_vector_set(s7_pointer vec, s7_int index, s7_int value) {int_vector(vec, index) = value; return(value);}
+
+uint8_t *s7_byte_vector_elements(s7_pointer vec) {return(byte_vector_bytes(vec));}
+uint8_t s7_byte_vector_ref(s7_pointer vec, s7_int index) {return(byte_vector(vec, index));}
+uint8_t s7_byte_vector_set(s7_pointer vec, s7_int index, uint8_t value) {byte_vector(vec, index) = value; return(value);}
+
+s7_double *s7_float_vector_elements(s7_pointer vec) {return(float_vector_floats(vec));}
+s7_double s7_float_vector_ref(s7_pointer vec, s7_int index) {return(float_vector(vec, index));}
+s7_double s7_float_vector_set(s7_pointer vec, s7_int index, s7_double value) {float_vector(vec, index) = value; return(value);}
+
+s7_int s7_vector_dimensions(s7_pointer vec, s7_int *dims, s7_int dims_size)
+{
+  if (dims_size <= 0) return(0);
+  if (vector_dimension_info(vec))
+    {
+      s7_int lim = vector_ndims(vec);
+      if (lim > dims_size) lim = dims_size;
+      for (s7_int i = 0; i < lim; i++)	dims[i] = vector_dimension(vec, i);
+      return(lim);
+    }
+  dims[0] = vector_length(vec);
+  return(1);
+}
+
+s7_int s7_vector_dimension(s7_pointer vec, s7_int dim)
+{
+  if (vector_dimension_info(vec))
+    return(vector_dimension(vec, dim));
+  return((dim == 0) ? vector_length(vec) : -1);
+}
+
+s7_int s7_vector_offsets(s7_pointer vec, s7_int *offs, s7_int offs_size)
+{
+  if (offs_size <= 0) return(0);
+  if (vector_dimension_info(vec))
+    {
+      s7_int lim = vector_ndims(vec);
+      if (lim > offs_size) lim = offs_size;
+      for (s7_int i = 0; i < lim; i++)	offs[i] = vector_offset(vec, i);
+      return(lim);
+    }
+  offs[0] = 1;
+  return(1);
+}
+
+
+static s7_int flatten_multivector_indices(s7_scheme *sc, s7_pointer vector, s7_int indices, va_list ap)
+{
+  s7_int index, rank = vector_rank(vector);
+  if (rank != indices)
+    {
+      va_end(ap);
+      wrong_number_of_arguments_error_nr(sc, "s7_vector_ref_n: wrong number of indices: ~A", 44, wrap_integer(sc, indices));
+    }
+  if (rank == 1)
+    index = va_arg(ap, s7_int);
+  else
+    {
+      s7_int i;
+      const s7_int *dimensions = vector_dimensions(vector);
+      const s7_int *offsets = vector_offsets(vector);
+      for (i = 0, index = 0; i < indices; i++)
+	{
+	  s7_int ind = va_arg(ap, s7_int);
+	  if ((ind < 0) || (ind >= dimensions[i]))
+	    {
+	      va_end(ap);
+	      out_of_range_error_nr(sc, sc->vector_ref_symbol, wrap_integer(sc, i), wrap_integer(sc, ind), (ind < 0) ? it_is_negative_string : it_is_too_large_string);
+	      return(-1);
+	    }
+	  index += (ind * offsets[i]);
+	}}
+  va_end(ap);
+  return(index);
+}
+
+s7_pointer s7_vector_ref_n(s7_scheme *sc, s7_pointer vector, s7_int indices, ...)
+{
+  s7_int index;
+  va_list ap;
+  va_start(ap, indices);
+  index = flatten_multivector_indices(sc, vector, indices, ap);
+  return(vector_getter(vector)(sc, vector, index));
+}
+
+s7_pointer s7_vector_set_n(s7_scheme *sc, s7_pointer vector, s7_pointer value, s7_int indices, ...)
+{
+  s7_int index;
+  va_list ap;
+  va_start(ap, indices);
+  index = flatten_multivector_indices(sc, vector, indices, ap);
+  if (is_typed_vector(vector))
+    return(typed_vector_setter(sc, vector, index, value));
+  return(vector_setter(vector)(sc, vector, index, value));
+}
+
+
+/* -------------------------------- vector->list -------------------------------- */
+s7_pointer s7_vector_to_list(s7_scheme *sc, s7_pointer vect)
+{
+  s7_int len = vector_length(vect);
+  s7_pointer result;
+  if (len == 0) return(sc->nil);
+  init_temp(sc->y, sc->nil);
+  gc_protect_via_stack(sc, vect);
+  switch (type(vect))
+    {
+    case T_VECTOR:
+      check_free_heap_size(sc, len);
+      for (s7_int i = len - 1; i >= 0; i--)
+	sc->y = cons_unchecked(sc, vector_element(vect, i), sc->y);
+      break;
+    case T_BYTE_VECTOR:
+      check_free_heap_size(sc, len);
+      for (s7_int i = len - 1; i >= 0; i--)
+	sc->y = cons_unchecked(sc, small_int(byte_vector(vect, i)), sc->y);
+      break;
+    case T_INT_VECTOR:
+      check_free_heap_size(sc, 2 * len);
+      for (s7_int i = len - 1; i >= 0; i--)
+	sc->y = cons_unchecked(sc, make_integer_unchecked(sc, int_vector(vect, i)), sc->y);
+      break;
+    case T_FLOAT_VECTOR:
+      check_free_heap_size(sc, 2 * len);
+      for (s7_int i = len - 1; i >= 0; i--)
+	sc->y = cons_unchecked(sc, make_real_unchecked(sc, float_vector(vect, i)), sc->y);
+      break;
+    }
+  unstack_gc_protect(sc);
+  result = sc->y;
+  sc->y = sc->unused;
+  return(result);
+}
+
+s7_pointer s7_array_to_list(s7_scheme *sc, s7_int num_values, s7_pointer *array)
+{
+  s7_pointer result;
+  if (num_values == 0) return(sc->nil);
+  init_temp(sc->y, sc->nil);
+  check_free_heap_size(sc, num_values);
+  for (s7_int i = num_values - 1; i >= 0; i--)
+    sc->y = cons_unchecked(sc, array[i], sc->y);
+  result = sc->y;
+  if (sc->safety > NO_SAFETY)
+    check_list_validity(sc, __func__, result);
+  sc->y = sc->unused;
+  return(result);
+}
+
+#if (!WITH_PURE_S7)
+static s7_pointer g_vector_to_list(s7_scheme *sc, s7_pointer args)
+{
+  #define H_vector_to_list "(vector->list v (start 0) end) returns the elements of the vector v as a list; (map values v)"
+  #define Q_vector_to_list s7_make_signature(sc, 4, sc->is_proper_list_symbol, sc->is_vector_symbol, sc->is_integer_symbol, sc->is_integer_symbol)
+
+  s7_int i, start = 0, end;
+  s7_pointer p, vec = car(args);
+  if (!is_any_vector(vec))
+    return(sole_arg_method_or_bust(sc, vec, sc->vector_to_list_symbol, args, sc->type_names[T_VECTOR]));
+
+  end = vector_length(vec);
+  if (!is_null(cdr(args)))
+    {
+      p = start_and_end(sc, sc->vector_to_list_symbol, args, 2, cdr(args), &start, &end);
+      if (p != sc->unused) return(p);
+      if (start == end) return(sc->nil);
+    }
+  if ((end - start) > sc->max_list_length)
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_5(sc, wrap_string(sc, "vector->list length ~D, (- ~D ~D), is greater than (*s7* 'max-list-length), ~D", 78),
+			 wrap_integer(sc, end - start), wrap_integer(sc, end), wrap_integer(sc, start),
+			 wrap_integer(sc, sc->max_list_length)));
+
+  check_free_heap_size(sc, end - start);
+  sc->w = sc->nil;
+  gc_protect_via_stack(sc, vec);
+  if (is_t_vector(vec))
+    for (i = end - 1; i >= start; i--) sc->w = cons_unchecked(sc, vector_element(vec, i), sc->w);
+  else for (i = end - 1; i >= start; i--) sc->w = cons_unchecked(sc, vector_getter(vec)(sc, vec, i), sc->w);
+  unstack_gc_protect(sc);
+  p = sc->w;
+  sc->w = sc->unused;
+  return(p);
+}
+
+static s7_pointer vector_to_list_p_p(s7_scheme *sc, s7_pointer p)
+{
+  if (!is_any_vector(p))
+    return(method_or_bust_p(sc, p, sc->vector_to_list_symbol, sc->type_names[T_VECTOR]));
+  return(s7_vector_to_list(sc, p));
+}
+#endif
+
+
+/* -------------------------------- string->byte-vector -------------------------------- */
+static s7_pointer g_string_to_byte_vector(s7_scheme *sc, s7_pointer args)
+{
+  #define H_string_to_byte_vector "(string->byte-vector obj) turns a string into a byte-vector."
+  #define Q_string_to_byte_vector s7_make_signature(sc, 2, sc->is_byte_vector_symbol, sc->is_string_symbol)
+  s7_pointer str = car(args);
+  if (!is_string(str))
+    return(method_or_bust_p(sc, str, sc->string_to_byte_vector_symbol, sc->type_names[T_STRING]));
+  if (string_length(str) > sc->max_vector_length)
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_3(sc, wrap_string(sc, "string->byte-vector string is too long: (> ~D ~D) (*s7* 'max-vector-length)", 75),
+			 wrap_integer(sc, string_length(str)), wrap_integer(sc, sc->max_vector_length)));
+  return(s7_copy_1(sc, sc->string_to_byte_vector_symbol, set_plist_2(sc, str, make_simple_byte_vector(sc, string_length(str)))));
+}
+
+
+/* -------------------------------- byte-vector->string -------------------------------- */
+static s7_pointer g_byte_vector_to_string(s7_scheme *sc, s7_pointer args)
+{
+  #define H_byte_vector_to_string "(byte-vector->string obj) turns a byte-vector into a string."
+  #define Q_byte_vector_to_string s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_byte_vector_symbol)
+  s7_pointer v = car(args);
+  if (!is_byte_vector(v))
+    return(method_or_bust_p(sc, v, sc->byte_vector_to_string_symbol, sc->type_names[T_BYTE_VECTOR]));
+  if (byte_vector_length(v) > sc->max_string_length)
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_3(sc, wrap_string(sc, "byte-vector->string byte-vector is too large: (> ~D ~D) (*s7* 'max-string-length)", 81),
+			 wrap_integer(sc, byte_vector_length(v)), wrap_integer(sc, sc->max_string_length)));
+  return(s7_copy_1(sc, sc->byte_vector_to_string_symbol, set_plist_2(sc, v, make_empty_string(sc, byte_vector_length(v), '\0'))));
+}
+
+
+/* -------------------------------- vector -------------------------------- */
+static s7_pointer g_vector(s7_scheme *sc, s7_pointer args)
+{
+  #define H_vector "(vector ...) returns a vector whose elements are the arguments"
+  #define Q_vector s7_make_circular_signature(sc, 1, 2, sc->is_vector_symbol, sc->T)
+
+  s7_pointer vec, b;
+  s7_int len = proper_list_length_with_end(args, &b);
+  if (!is_null(b))
+    error_nr(sc, sc->read_error_symbol, set_elist_1(sc, wrap_string(sc, "vector contents list is not a proper list", 41)));
+  if (len > sc->max_vector_length)
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_3(sc, wrap_string(sc, "vector has too many arguments: '~S, but (*s7* 'max-vector-length) is ~D", 71),
+			 args, wrap_integer(sc, sc->max_vector_length)));
+  vec = make_simple_vector(sc, len);
+  if (len > 0)
+    {
+      s7_pointer x = args;
+      for (s7_int i = 0; is_pair(x); x = cdr(x), i++)
+	vector_element(vec, i) = car(x);
+    }
+  return(vec);
+}
+
+static inline s7_pointer vector_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2)
+{
+  s7_pointer vec = make_simple_vector(sc, 2);
+  vector_element(vec, 0) = p1;
+  vector_element(vec, 1) = p2;
+  return(vec);
+}
+
+static s7_pointer g_vector_2(s7_scheme *sc, s7_pointer args) {return(vector_p_pp(sc, car(args), cadr(args)));}
+
+static s7_pointer g_vector_3(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer vec = make_simple_vector(sc, 3);
+  vector_element(vec, 0) = car(args); args = cdr(args);
+  vector_element(vec, 1) = car(args);
+  vector_element(vec, 2) = cadr(args);
+  return(vec);
+}
+
+static s7_pointer vector_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer unused_expr)
+{
+  if (args == 2) return(sc->vector_2);
+  return((args == 3) ? sc->vector_3 : f);
+}
+
+
+/* -------------------------------- float-vector? -------------------------------- */
+static s7_pointer g_is_float_vector(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_float_vector "(float-vector? obj) returns #t if obj is an homogeneous float vector"
+  #define Q_is_float_vector sc->pl_bt
+  check_boolean_method(sc, s7_is_float_vector, sc->is_float_vector_symbol, args);
+}
+
+
+/* -------------------------------- float-vector -------------------------------- */
+static s7_pointer g_float_vector(s7_scheme *sc, s7_pointer args)
+{
+  #define H_float_vector "(float-vector ...) returns an homogeneous float vector whose elements are the arguments"
+  #define Q_float_vector s7_make_circular_signature(sc, 1, 2, sc->is_float_vector_symbol, sc->is_real_symbol)
+
+  s7_pointer vec, b;
+  s7_int len = proper_list_length_with_end(args, &b);
+  if (!is_null(b))
+    error_nr(sc, sc->read_error_symbol, set_elist_1(sc, wrap_string(sc, "float-vector contents list is not a proper list", 47)));
+  if (len > sc->max_vector_length)
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_3(sc, wrap_string(sc, "float-vector has too many arguments: '~S, but (*s7* 'max-vector-length) is ~D", 77),
+			 args, wrap_integer(sc, sc->max_vector_length)));
+  vec = make_simple_float_vector(sc, len);
+  if (len > 0)
+    {
+      s7_int i = 0;
+      for (s7_pointer x = args; is_pair(x); x = cdr(x), i++)
+	{ /* this used to gc protect vec via sc->w? was that due to very old bignum code in s7_real? */
+	  s7_pointer p = car(x);
+	  if (is_t_real(p))
+	    float_vector(vec, i) = real(p);
+	  else
+	    if (is_real(p))                         /* bignum is ok here */
+	      float_vector(vec, i) = s7_real(p);
+	    else return(method_or_bust(sc, p, sc->float_vector_symbol, args, sc->type_names[T_REAL], i + 1));
+	}}
+  return(vec);
+}
+
+static s7_pointer float_vector_p_d(s7_scheme *sc, s7_double x)
+{
+  s7_pointer vec = make_simple_float_vector(sc, 1);
+  float_vector(vec, 0) = x;
+  return(vec);
+}
+
+static s7_pointer float_vector_p_i(s7_scheme *sc, s7_int x) /* thash */
+{
+  s7_pointer vec = make_simple_float_vector(sc, 1);
+  float_vector(vec, 0) = (s7_double)x;
+  return(vec);
+}
+/* p_dd case doesn't get any hits */
+
+
+/* -------------------------------- int-vector? -------------------------------- */
+static s7_pointer g_is_int_vector(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_int_vector "(int-vector? obj) returns #t if obj is an homogeneous s7_int vector"
+  #define Q_is_int_vector sc->pl_bt
+  check_boolean_method(sc, is_int_vector, sc->is_int_vector_symbol, args);
+}
+
+
+/* -------------------------------- int-vector -------------------------------- */
+static s7_pointer g_int_vector(s7_scheme *sc, s7_pointer args)
+{
+  #define H_int_vector "(int-vector ...) returns an homogeneous s7_int vector whose elements are the arguments"
+  #define Q_int_vector s7_make_circular_signature(sc, 1, 2, sc->is_int_vector_symbol, sc->is_integer_symbol)
+
+  s7_int i = 0;
+  s7_pointer vec, b;
+  s7_int len = proper_list_length_with_end(args, &b);
+  if (!is_null(b))
+    error_nr(sc, sc->read_error_symbol, set_elist_1(sc, wrap_string(sc, "int-vector contents list is not a proper list", 45)));
+  if (len > sc->max_vector_length)
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_3(sc, wrap_string(sc, "int-vector has too many arguments: '~S, but (*s7* 'max-vector-length) is ~D", 75),
+			 args, wrap_integer(sc, sc->max_vector_length)));
+  vec = make_simple_int_vector(sc, len);
+  if (len == 0) return(vec);
+  for (s7_pointer x = args; is_pair(x); x = cdr(x), i++)
+    {
+      s7_pointer p = car(x);
+      if (!s7_is_integer(p))
+	return(method_or_bust(sc, p, sc->int_vector_symbol, args, sc->type_names[T_INTEGER], i + 1));
+      int_vector(vec, i) = s7_integer_clamped_if_gmp(sc, p);
+    }
+  return(vec);
+}
+
+static s7_pointer int_vector_p_i(s7_scheme *sc, s7_int x)
+{
+  s7_pointer vec = make_simple_int_vector(sc, 1);
+  int_vector(vec, 0) = x;
+  return(vec);
+}
+/* p_ii case doesn't get any hits */
+
+
+/* -------------------------------- byte-vector? -------------------------------- */
+static s7_pointer g_is_byte_vector(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_byte_vector "(byte-vector? obj) returns #t if obj is a byte-vector"
+  #define Q_is_byte_vector sc->pl_bt
+  check_boolean_method(sc, is_byte_vector_b_p, sc->is_byte_vector_symbol, args);
+}
+
+
+/* -------------------------------- byte-vector -------------------------------- */
+static s7_pointer g_byte_vector(s7_scheme *sc, s7_pointer args)
+{
+  #define H_byte_vector "(byte-vector ...) returns a byte-vector whose elements are the arguments"
+  #define Q_byte_vector s7_make_circular_signature(sc, 1, 2, sc->is_byte_vector_symbol, sc->is_byte_symbol)
+
+  s7_int i = 0;
+  s7_pointer vec, end;
+  uint8_t *str;
+  s7_int len = proper_list_length_with_end(args, &end);
+  if (!is_null(end))
+    error_nr(sc, sc->read_error_symbol, set_elist_1(sc, wrap_string(sc, "byte-vector contents list is not a proper list", 46)));
+  if (len > sc->max_vector_length)
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_3(sc, wrap_string(sc, "byte-vector has too many arguments: '~S, but (*s7* 'max-vector-length) is ~D", 76),
+			 args, wrap_integer(sc, sc->max_vector_length)));
+  vec = make_simple_byte_vector(sc, len);
+  str = byte_vector_bytes(vec);
+  for (s7_pointer x = args; is_pair(x); i++, x = cdr(x))
+    {
+      s7_pointer byte = car(x);
+      s7_int b;
+      if (is_t_integer(byte))
+	b = integer(byte);
+      else
+#if WITH_GMP
+	if (is_t_big_integer(byte))
+	  b = big_integer_to_s7_int(sc, big_integer(byte));
+	else
+#endif
+	  return(method_or_bust(sc, byte, sc->byte_vector_symbol, args, sc->type_names[T_INTEGER], i + 1));
+      if ((b < 0) || (b > 255))
+	wrong_type_error_nr(sc, sc->byte_vector_symbol, i + 1, byte, an_unsigned_byte_string);
+      str[i] = (uint8_t)b;
+    }
+  return(vec);
+}
+
+
+#if (!WITH_PURE_S7)
+/* -------------------------------- list->vector -------------------------------- */
+static s7_pointer g_list_to_vector(s7_scheme *sc, s7_pointer args)
+{
+  #define H_list_to_vector "(list->vector lst) returns a vector containing the elements of lst; (apply vector lst)"
+  #define Q_list_to_vector s7_make_signature(sc, 2, sc->is_vector_symbol, sc->is_proper_list_symbol)
+
+  s7_pointer p = car(args);
+  if (is_null(p))
+    return(make_simple_vector(sc, 0)); /* was s7_make_vector */
+  sc->temp3 = p;
+  if (!s7_is_proper_list(sc, p))
+    return(method_or_bust_p(sc, p, sc->list_to_vector_symbol, a_proper_list_string));
+  p = g_vector(sc, p);
+  sc->temp3 = sc->unused;
+  return(p);
+}
+
+/* -------------------------------- vector-length -------------------------------- */
+static s7_pointer g_vector_length(s7_scheme *sc, s7_pointer args)
+{
+  #define H_vector_length "(vector-length v) returns the length of vector v"
+  #define Q_vector_length s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_vector_symbol)
+
+  s7_pointer vec = car(args);
+  if (!is_any_vector(vec))
+    return(sole_arg_method_or_bust(sc, vec, sc->vector_length_symbol, args, sc->type_names[T_VECTOR]));
+  return(make_integer(sc, vector_length(vec)));
+}
+
+static s7_int vector_length_i_7p(s7_scheme *sc, s7_pointer p)
+{
+  if (!is_any_vector(p))
+    return(integer(method_or_bust_p(sc, p, sc->vector_length_symbol, sc->type_names[T_VECTOR])));
+  return(vector_length(p));
+}
+
+static s7_pointer vector_length_p_p(s7_scheme *sc, s7_pointer vec)
+{
+  if (!is_any_vector(vec))
+    return(method_or_bust_p(sc, vec, sc->vector_length_symbol, sc->type_names[T_VECTOR]));
+  return(make_integer(sc, vector_length(vec)));
+}
+#endif
+
+
+/* -------------------------------- subvector subvector? subvector-vector subvector-position -------------------------------- */
+static bool s7_is_subvector(s7_pointer g) {return((is_any_vector(g)) && (is_subvector(g)));}
+
+static s7_pointer g_is_subvector(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_subvector "(subvector? obj) returns #t if obj is a subvector"
+  #define Q_is_subvector sc->pl_bt
+  check_boolean_method(sc, s7_is_subvector, sc->is_subvector_symbol, args);
+}
+
+static s7_pointer g_subvector_position(s7_scheme *sc, s7_pointer args)
+{
+  #define H_subvector_position "(subvector-position obj) returns obj's offset"
+  #define Q_subvector_position s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_subvector_symbol)
+
+  s7_pointer sv = car(args);
+  if (s7_is_subvector(sv))
+    {
+      /* we can't use vector_elements(sv) - vector_elements(subvector_vector(sv)) because that assumes we're looking at s7_pointer*,
+       *   so a subvector of a byte_vector gets a bogus position (0 if position is less than 8 etc).
+       */
+      switch (type(sv))
+	{
+	case T_VECTOR:       return(make_integer(sc, (s7_int)(vector_elements(sv) - vector_elements(subvector_vector(sv)))));
+	case T_INT_VECTOR:   return(make_integer(sc, (s7_int)(int_vector_ints(sv) - int_vector_ints(subvector_vector(sv)))));
+	case T_FLOAT_VECTOR: return(make_integer(sc, (s7_int)(float_vector_floats(sv) - float_vector_floats(subvector_vector(sv)))));
+	case T_BYTE_VECTOR:  return(make_integer(sc, (s7_int)(byte_vector_bytes(sv) - byte_vector_bytes(subvector_vector(sv)))));
+	}}
+  return(sole_arg_method_or_bust(sc, sv, sc->subvector_position_symbol, args, sc->type_names[T_VECTOR]));
+}
+
+static s7_pointer g_subvector_vector(s7_scheme *sc, s7_pointer args)
+{
+  #define H_subvector_vector "(subvector-vector obj) returns the vector underlying the subvector obj"
+  #define Q_subvector_vector s7_make_signature(sc, 2, sc->is_vector_symbol, sc->is_subvector_symbol)
+
+  if (s7_is_subvector(car(args)))
+    return(subvector_vector(car(args)));
+  return(sole_arg_method_or_bust(sc, car(args), sc->subvector_vector_symbol, args, sc->type_names[T_VECTOR]));
+}
+
+static s7_pointer subvector(s7_scheme *sc, s7_pointer vect, s7_int skip_dims, s7_int index)
+{
+  s7_int dims = vector_ndims(vect) - skip_dims;
+  s7_pointer x;
+  new_cell(sc, x, ((full_type(vect) & (~T_UNHEAP)) & (~T_COLLECTED)) | T_SUBVECTOR | T_SAFE_PROCEDURE); /* no T_UNHEAP because we're new but vect might be unheaped */
+  vector_length(x) = 0;
+  vector_block(x) = mallocate_empty_block(sc);
+  any_vector_elements(x) = NULL;
+  vector_getter(x) = vector_getter(vect);
+  vector_setter(x) = vector_setter(vect);
+  if (dims > 1)
+    {
+      vdims_t *v = (vdims_t *)mallocate_block(sc);
+#if S7_DEBUGGING
+      sc->blocks_mallocated[BLOCK_LIST]++;
+#endif
+      vdims_rank(v) = dims;
+      vdims_dims(v) = (s7_int *)(vector_dimensions(vect) + skip_dims);
+      vdims_offsets(v) = (s7_int *)(vector_offsets(vect) + skip_dims);
+      vdims_original(v) = vect;
+      vector_elements_should_be_freed(v) = false;
+      vector_set_dimension_info(x, v);
+    }
+  else
+    {
+      vector_set_dimension_info(x, NULL);
+      subvector_set_vector(x, vect);
+    }
+
+  if (is_t_vector(vect))
+    mark_function[T_VECTOR] = mark_vector_possibly_shared;
+  else mark_function[type(vect)] = mark_int_or_float_vector_possibly_shared;
+
+  vector_length(x) = (skip_dims > 0) ? vector_offset(vect, skip_dims - 1) : vector_length(vect);
+  if (is_int_vector(vect))
+    int_vector_ints(x) = (s7_int *)(int_vector_ints(vect) + index);
+  else
+    if (is_float_vector(vect))
+      float_vector_floats(x) = (s7_double *)(float_vector_floats(vect) + index);
+    else
+      if (is_t_vector(vect))
+	vector_elements(x) = (s7_pointer *)(vector_elements(vect) + index);
+      else byte_vector_bytes(x) = (uint8_t *)(byte_vector_bytes(vect) + index);
+  add_multivector(sc, x);
+  return(x);
+}
+
+static inline vdims_t *list_to_dims(s7_scheme *sc, s7_pointer x)
+{
+  s7_int i, offset;
+  s7_pointer y;
+  s7_int *ds, *os;
+  s7_int len = proper_list_length(x);
+  vdims_t *v = (vdims_t *)inline_mallocate(sc, len * 2 * sizeof(s7_int));
+  vdims_rank(v) = len;
+  vdims_offsets(v) = (s7_int *)(vdims_dims(v) + len);
+  vector_elements_should_be_freed(v) = false;
+  ds = vdims_dims(v);
+  os = vdims_offsets(v);
+
+  for (i = 0, y = x; is_not_null(y); i++, y = cdr(y))
+    ds[i] = s7_integer_clamped_if_gmp(sc, car(y));
+
+  for (i = len - 1, offset = 1; i >= 0; i--)
+    {
+      os[i] = offset;
+      offset *= ds[i];
+    }
+  return(v);
+}
+
+static s7_pointer g_subvector(s7_scheme *sc, s7_pointer args)
+{
+  #define H_subvector "(subvector original-vector (start 0) (end original-vector-len) new-dimensions) returns \
+a vector that points to the same elements as the original-vector but with different starting point, end point, and dimensional info."
+  #define Q_subvector s7_make_signature(sc, 5, sc->is_subvector_symbol, sc->is_vector_symbol, sc->is_integer_symbol, sc->is_integer_symbol, sc->is_pair_symbol)
+
+  /* (let ((v1 #2d((1 2 3) (4 5 6)))) (let ((v2 (subvector v1 0 6))) v2)) -> #(1 2 3 4 5 6)
+   * (let ((v1 #(1 2 3 4 5 6))) (let ((v2 (subvector v1 0 6 '(3 2)))) v2)) -> #2D((1 2) (3 4) (5 6))
+   */
+  s7_pointer orig = car(args), x;
+  vdims_t *v = NULL;
+  s7_int new_len, orig_len, offset = 0;
+
+  if (!is_any_vector(orig))
+    return(method_or_bust(sc, orig, sc->subvector_symbol, args, sc->type_names[T_VECTOR], 1));
+
+  orig_len = vector_length(orig);
+  new_len = orig_len;
+
+  if (is_pair(cdr(args))) /* get start point in vector */
+    {
+      s7_pointer start = cadr(args);
+      if (!s7_is_integer(start))
+	return(method_or_bust(sc, start, sc->subvector_symbol, args, sc->type_names[T_INTEGER], 2));
+      offset = s7_integer_clamped_if_gmp(sc, start);
+      if ((offset < 0) || (offset > orig_len))  /* we need this if, for example, offset == 9223372036854775807 */
+	out_of_range_error_nr(sc, sc->subvector_symbol, int_two, start, (offset < 0) ? it_is_negative_string : it_is_too_large_string);
+      new_len -= offset;
+
+      if (is_pair(cddr(args))) /* get end point in vector */
+	{
+	  s7_pointer end = caddr(args);
+	  s7_int new_end;
+	  if (!s7_is_integer(end))
+	    return(method_or_bust(sc, end, sc->subvector_symbol, args, sc->type_names[T_INTEGER], 3));
+	  new_end = s7_integer_clamped_if_gmp(sc, end);
+	  if ((new_end < 0) || (new_end > orig_len))
+	    out_of_range_error_nr(sc, sc->subvector_symbol, int_three, end, (new_end < 0) ? it_is_negative_string : it_is_too_large_string);
+	  if (offset > new_end)
+	    out_of_range_error_nr(sc, sc->subvector_symbol, int_two, start, wrap_string(sc, "start point > end point", 23));
+	  new_len = new_end - offset;
+
+	  if (is_pair(cdddr(args))) /* get new dimensions */
+	    {
+	      s7_pointer dims = cadddr(args);
+	      if ((is_null(dims)) ||
+		  (!s7_is_proper_list(sc, dims)))
+		return(method_or_bust(sc, dims, sc->subvector_symbol, args, sc->type_names[T_PAIR], 4));
+
+	      for (s7_pointer y = dims; is_pair(y); y = cdr(y))
+		if ((!s7_is_integer(car(y)))        ||       /* (subvector v '((1 2) (3 4))) */
+		    (s7_integer_clamped_if_gmp(sc, car(y)) > orig_len) ||
+		    (s7_integer_clamped_if_gmp(sc, car(y)) < 0))
+		  error_nr(sc, sc->wrong_type_arg_symbol,
+			   set_elist_1(sc, wrap_string(sc, "a subvector must fit in the original vector", 43)));
+
+	      v = list_to_dims(sc, dims);
+	      if (vdims_rank(v) > sc->max_vector_dimensions)
+		{
+		  liberate(sc, v);
+		  error_nr(sc, sc->out_of_range_symbol,
+			   set_elist_3(sc, wrap_string(sc, "subvector specifies too many dimensions: '~S, but (*s7* 'max-vector-dimensions) is ~D", 85),
+				       dims, wrap_integer(sc, sc->max_vector_dimensions)));
+		}
+	      new_len = vdims_dims(v)[0];
+	      for (s7_int i = 1; i < vdims_rank(v); i++) new_len *= vdims_dims(v)[i];
+	      if (new_len != new_end - offset)
+		{
+		  liberate(sc, v); /* 14-Sep-23 */
+		  error_nr(sc, sc->wrong_type_arg_symbol,
+			   set_elist_4(sc, wrap_string(sc, "subvector dimensional length, ~D, does not match the start and end positions: ~S to ~S~%", 88),
+				       wrap_integer(sc, new_len), start, end));
+		}
+	      vdims_original(v) = orig;
+	    }}}
+
+  if (is_t_vector(orig))
+    mark_function[T_VECTOR] = mark_vector_possibly_shared;
+  else mark_function[type(orig)] = mark_int_or_float_vector_possibly_shared; /* I think this works for byte-vectors also */
+
+  new_cell(sc, x, ((full_type(orig) & (~T_UNHEAP)) & (~T_COLLECTED)) | T_SUBVECTOR | T_SAFE_PROCEDURE);
+  vector_block(x) = mallocate_empty_block(sc);
+  vector_set_dimension_info(x, v);
+  if (!v) subvector_set_vector(x, orig);
+  vector_length(x) = new_len;                 /* might be less than original length */
+  if ((new_len == 0) && (is_t_vector(orig))) set_has_simple_elements(x);
+  vector_getter(x) = vector_getter(orig);
+  vector_setter(x) = vector_setter(orig);
+
+  if (is_int_vector(orig))
+    int_vector_ints(x) = (s7_int *)(int_vector_ints(orig) + offset);
+  else
+    if (is_float_vector(orig))
+      float_vector_floats(x) = (s7_double *)(float_vector_floats(orig) + offset);
+    else
+      if (is_t_vector(x))
+	vector_elements(x) = (s7_pointer *)(vector_elements(orig) + offset);
+      else byte_vector_bytes(x) = (uint8_t *)(byte_vector_bytes(orig) + offset);
+  add_multivector(sc, x);
+  return(x);
+}
+
+
+/* -------------------------------- vector-ref -------------------------------- */
+static s7_pointer vector_ref_1(s7_scheme *sc, s7_pointer vect, s7_pointer indices)
+{
+  s7_int index = 0;
+  if (vector_length(vect) == 0)
+    out_of_range_error_nr(sc, sc->vector_ref_symbol, int_one, vect, it_is_too_large_string);
+
+  if (vector_rank(vect) > 1)
+    {
+      s7_int i;
+      s7_pointer x;
+      for (x = indices, i = 0; (is_not_null(x)) && (i < vector_ndims(vect)); x = cdr(x), i++)
+	{
+	  s7_int n;
+	  s7_pointer p = car(x);
+	  if (!s7_is_integer(p))
+	    return(method_or_bust(sc, p, sc->vector_ref_symbol, set_ulist_1(sc, vect, indices), sc->type_names[T_INTEGER], i + 2));
+          n = s7_integer_clamped_if_gmp(sc, p);
+	  if ((n < 0) || (n >= vector_dimension(vect, i)))
+	    out_of_range_error_nr(sc, sc->vector_ref_symbol, wrap_integer(sc, i + 2), p, (n < 0) ? it_is_negative_string : it_is_too_large_string);
+
+	  index += n * vector_offset(vect, i);
+	}
+      if (is_not_null(x))
+	{
+	  s7_pointer nv;
+	  if (!is_t_vector(vect))
+	    error_nr(sc, sc->wrong_number_of_args_symbol,
+		     set_elist_3(sc, wrap_string(sc, "~S: too many indices: ~S", 24), sc->vector_ref_symbol, copy_proper_list(sc, indices)));
+	  nv = vector_element(vect, index);
+	  return(implicit_index(sc, nv, x));
+	}
+      /* if not enough indices, return a subvector covering whatever is left */
+      if (i < vector_ndims(vect))
+	return(subvector(sc, vect, i, index));
+    }
+  else
+    {
+      s7_pointer p = car(indices);
+      /* (let ((hi (make-vector 3 0.0)) (sum 0.0)) (do ((i 0 (+ i 1))) ((= i 3)) (set! sum (+ sum (hi i)))) sum) */
+
+      if (!s7_is_integer(p))
+	return(method_or_bust(sc, p, sc->vector_ref_symbol, set_ulist_1(sc, vect, indices), sc->type_names[T_INTEGER], 2));
+      index = s7_integer_clamped_if_gmp(sc, p);
+
+      if ((index < 0) || (index >= vector_length(vect)))
+	out_of_range_error_nr(sc, sc->vector_ref_symbol, int_two, p, (index < 0) ? it_is_negative_string : it_is_too_large_string);
+
+      if (is_not_null(cdr(indices)))                /* (let ((L #(#(1 2 3) #(4 5 6)))) (vector-ref L 1 2)) */
+	{
+	  s7_pointer nv;
+	  if (!is_t_vector(vect))
+	    error_nr(sc, sc->wrong_number_of_args_symbol,
+		     set_elist_3(sc, wrap_string(sc, "~S: too many indices: ~S", 24), sc->vector_ref_symbol, copy_proper_list(sc, indices)));
+	  nv = vector_element(vect, index);
+	  return(implicit_pair_index_checked(sc, vect, nv, indices));
+	}}
+  return((vector_getter(vect))(sc, vect, index));
+}
+
+static s7_pointer g_vector_ref(s7_scheme *sc, s7_pointer args)
+{
+  #define H_vector_ref "(vector-ref v ... i) returns the i-th element of vector v."
+  #define Q_vector_ref s7_make_circular_signature(sc, 2, 3, sc->T, sc->is_vector_symbol, sc->is_integer_symbol)
+
+  s7_pointer vec = car(args);
+  if (!is_any_vector(vec))
+    return(method_or_bust(sc, vec, sc->vector_ref_symbol, args, sc->type_names[T_VECTOR], 1));
+  return(vector_ref_1(sc, vec, cdr(args))); /* 19-Jan-19 */
+}
+
+static s7_pointer vector_ref_p_pi(s7_scheme *sc, s7_pointer v, s7_int i)
+{
+  if ((!is_t_vector(v)) ||
+      (vector_rank(v) > 1) ||
+      (i < 0) || (i >= vector_length(v)))
+    return(g_vector_ref(sc, set_plist_2(sc, v, make_integer(sc, i))));
+  return(vector_element(v, i));
+}
+
+static s7_pointer vector_ref_p_pi_unchecked(s7_scheme *sc, s7_pointer v, s7_int i) /* callable but just barely (tgsl.scm) */
+{
+  if ((i >= 0) && (i < vector_length(v)))
+    return(vector_getter(v)(sc, v, i));
+  out_of_range_error_nr(sc, sc->vector_ref_symbol, int_two, wrap_integer(sc, i), (i < 0) ? it_is_negative_string : it_is_too_large_string);
+  return(v);
+}
+
+static s7_pointer t_vector_ref_p_pi_unchecked(s7_scheme *sc, s7_pointer v, s7_int i)
+{
+  if ((i >= 0) && (i < vector_length(v)))
+    return(vector_element(v, i));
+  out_of_range_error_nr(sc, sc->vector_ref_symbol, int_two, wrap_integer(sc, i), (i < 0) ? it_is_negative_string : it_is_too_large_string);
+  return(v);
+}
+
+static s7_pointer vector_ref_p_pii(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2)
+{
+  if ((!is_any_vector(v)) ||
+      (vector_rank(v) != 2) ||
+      (i1 < 0) || (i2 < 0) ||
+      (i1 >= vector_dimension(v, 0)) || (i2 >= vector_dimension(v, 1)))
+    return(g_vector_ref(sc, set_plist_3(sc, v, make_integer(sc, i1), make_integer_unchecked(sc, i2))));
+  return(vector_getter(v)(sc, v, i2 + (i1 * vector_offset(v, 0))));
+}
+
+static s7_pointer vector_ref_p_pii_direct(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2)
+{
+  if ((i1 < 0) || (i2 < 0) ||
+      (i1 >= vector_dimension(v, 0)) || (i2 >= vector_dimension(v, 1)))
+    return(g_vector_ref(sc, set_plist_3(sc, v, make_integer(sc, i1), make_integer_unchecked(sc, i2))));
+  return(vector_element(v, i2 + (i1 * vector_offset(v, 0))));
+}
+
+static s7_pointer t_vector_ref_p_pi_direct(s7_scheme *unused_sc, s7_pointer v, s7_int i) {return(vector_element(v, i));}
+
+static inline s7_pointer vector_ref_p_pp(s7_scheme *sc, s7_pointer vec, s7_pointer ind)
+{
+  s7_int index;
+  if ((!is_t_vector(vec)) ||
+      (vector_rank(vec) != 1) ||
+      (!s7_is_integer(ind)))
+    return(g_vector_ref(sc, set_plist_2(sc, vec, ind)));
+  index = s7_integer_clamped_if_gmp(sc, ind);
+  if ((index < 0) || (index >= vector_length(vec)))
+    out_of_range_error_nr(sc, sc->vector_ref_symbol, int_two, ind, (index < 0) ? it_is_negative_string : it_is_too_large_string);
+  return(vector_element(vec, index));
+}
+
+static s7_pointer g_vector_ref_2(s7_scheme *sc, s7_pointer args) {return(vector_ref_p_pp(sc, car(args), cadr(args)));}
+
+static s7_pointer g_vector_ref_3(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer vec = car(args), i1, i2;
+  s7_int ix, iy;
+
+  if (!is_any_vector(vec))
+    return(g_vector_ref(sc, args));
+  if (vector_rank(vec) != 2)
+    return(g_vector_ref(sc, args));
+
+  i1 = cadr(args);
+  if (!s7_is_integer(i1))
+    return(g_vector_ref(sc, args));
+  i2 = caddr(args);
+  if (!s7_is_integer(i2))
+    return(g_vector_ref(sc, args));
+  ix = s7_integer_clamped_if_gmp(sc, i1);
+  iy = s7_integer_clamped_if_gmp(sc, i2);
+  if ((ix >= 0) && (iy >= 0) &&
+      (ix < vector_dimension(vec, 0)) && (iy < vector_dimension(vec, 1)))
+    {
+      s7_int index = (ix * vector_offset(vec, 0)) + iy; /* vector_offset(vec, 1) == 1 */
+      return(vector_getter(vec)(sc, vec, index));
+    }
+  return(g_vector_ref(sc, args));
+}
+
+static s7_pointer vector_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer unused_expr)
+{
+  if (args == 2)
+    return(sc->vector_ref_2);
+  return((args == 3) ? sc->vector_ref_3 : f);
+}
+
+
+/* -------------------------------- vector-set! -------------------------------- */
+static s7_pointer g_vector_set(s7_scheme *sc, s7_pointer args)
+{
+  #define H_vector_set "(vector-set! v i ... value) sets the i-th element of vector v to value."
+  #define Q_vector_set s7_make_circular_signature(sc, 3, 4, sc->T, sc->is_vector_symbol, sc->is_integer_symbol, sc->is_integer_or_any_at_end_symbol)
+
+  s7_pointer vec = car(args), val;
+  s7_int index;
+
+  if (!is_any_vector(vec))
+    return(method_or_bust(sc, vec, sc->vector_set_symbol, args, sc->type_names[T_VECTOR], 1));
+  if (is_immutable_vector(vec))
+    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->vector_set_symbol, vec));
+  if (vector_length(vec) == 0)
+    out_of_range_error_nr(sc, sc->vector_set_symbol, int_one, vec, it_is_too_large_string);
+
+  if (vector_rank(vec) > 1)
+    {
+      s7_int i;
+      s7_pointer x;
+      index = 0;
+      for (x = cdr(args), i = 0; (is_not_null(cdr(x))) && (i < vector_ndims(vec)); x = cdr(x), i++)
+	{
+	  s7_int n;
+	  s7_pointer p = car(x);
+	  if (!s7_is_integer(p))
+	    return(method_or_bust(sc, p, sc->vector_set_symbol, args, sc->type_names[T_INTEGER], i + 2));
+          n = s7_integer_clamped_if_gmp(sc, p);
+	  if ((n < 0) || (n >= vector_dimension(vec, i)))
+	    out_of_range_error_nr(sc, sc->vector_set_symbol, wrap_integer(sc, i + 2), p, (n < 0) ? it_is_negative_string : it_is_too_large_string);
+
+	  index += n * vector_offset(vec, i);
+	}
+      if (is_not_null(cdr(x)))
+	wrong_number_of_arguments_error_nr(sc, "too many arguments for vector-set!: ~S", 38, args);
+      if (i != vector_ndims(vec))
+	wrong_number_of_arguments_error_nr(sc, "not enough arguments for vector-set!: ~S", 40, args);
+
+      /* since vector-ref can return a subvector (if not passed enough args), it might be interesting to
+       *   also set a complete subvector via set!, but would that introduce ambiguity?  Only copy the vector
+       *   if at least one index is missing, and the value fits.  It also makes error detection harder,
+       *   but so does the current vector-ref handling.  Can't decide...
+       *   (define v (make-vector '(2 3) 0)) (vector-set! v 0 #(1 2 3)) -> error, but (vector-ref v 0) -> #(0 0 0)
+       * Other possible additions: complex-vector and string-vector.
+       */
+      val = car(x);
+    }
+  else
+    {
+      s7_pointer p = cadr(args);
+      if (!s7_is_integer(p))
+	return(method_or_bust(sc, p, sc->vector_set_symbol, args, sc->type_names[T_INTEGER], 2));
+      index = s7_integer_clamped_if_gmp(sc, p);
+      if ((index < 0) || (index >= vector_length(vec)))
+	out_of_range_error_nr(sc, sc->vector_set_symbol, int_two, p, (index < 0) ? it_is_negative_string : it_is_too_large_string);
+
+      if (is_not_null(cdddr(args)))
+	{
+	  s7_pointer v = vector_getter(vec)(sc, vec, index);
+	  if (!is_any_vector(v))
+	    wrong_number_of_arguments_error_nr(sc, "too many arguments for vector-set!: ~S", 38, args);
+	  return(g_vector_set(sc, set_ulist_1(sc, v, cddr(args))));
+	}
+      val = caddr(args);
+    }
+  if (is_typed_t_vector(vec))
+    return(typed_vector_setter(sc, vec, index, val));
+  if (is_t_vector(vec))
+    vector_element(vec, index) = val;
+  else vector_setter(vec)(sc, vec, index, val);
+  return(val);
+}
+
+static s7_pointer vector_set_p_pip(s7_scheme *sc, s7_pointer v, s7_int i, s7_pointer p) /* almost never called -- see one case in s7test.scm[13736] */
+{
+  if ((!is_any_vector(v)) || (vector_rank(v) > 1) || (i < 0) || (i >= vector_length(v)))
+    return(g_vector_set(sc, set_plist_3(sc, v, make_integer(sc, i), p)));
+  if (is_t_vector(v))
+    {
+      if (is_typed_vector(v)) return(typed_vector_setter(sc, v, i, p));
+      vector_element(v, i) = p;
+    }
+  else vector_setter(v)(sc, v, i, p);
+  return(p);
+}
+
+static s7_pointer vector_set_p_pip_unchecked(s7_scheme *sc, s7_pointer v, s7_int i, s7_pointer p)
+{
+  if ((i >= 0) && (i < vector_length(v)))
+    vector_element(v, i) = p;
+  else out_of_range_error_nr(sc, sc->vector_set_symbol, int_two, wrap_integer(sc, i), (i < 0) ? it_is_negative_string : it_is_too_large_string);
+  return(p);
+}
+
+static s7_pointer vector_set_p_piip(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2, s7_pointer p)
+{
+  if ((!is_any_vector(v)) ||
+      (vector_rank(v) != 2) ||
+      (i1 < 0) || (i2 < 0) ||
+      (i1 >= vector_dimension(v, 0)) || (i2 >= vector_dimension(v, 1)))
+    return(g_vector_set(sc, set_plist_4(sc, v, make_integer(sc, i1), make_integer_unchecked(sc, i2), p)));
+  if (is_t_vector(v))
+    {
+      if (is_typed_vector(v))
+	return(typed_vector_setter(sc, v, i2 + (i1 * vector_offset(v, 0)), p));
+      vector_element(v, i2 + (i1 * vector_offset(v, 0))) = p;
+    }
+  else vector_setter(v)(sc, v, i2 + (i1 * vector_offset(v, 0)), p);
+  return(p);
+}
+
+static s7_pointer vector_set_p_piip_direct(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2, s7_pointer p)
+{
+  /* normal untyped vector, rank == 2, uncallable? */
+  if ((i1 < 0) || (i2 < 0) ||
+      (i1 >= vector_dimension(v, 0)) || (i2 >= vector_dimension(v, 1)))
+    return(g_vector_set(sc, set_plist_4(sc, v, make_integer(sc, i1), make_integer_unchecked(sc, i2), p)));
+  vector_element(v, i2 + (i1 * vector_offset(v, 0))) = p;
+  return(p);
+}
+
+static s7_pointer typed_vector_set_p_pip_unchecked(s7_scheme *sc, s7_pointer v, s7_int i, s7_pointer p)
+{
+  if ((i >= 0) && (i < vector_length(v)))
+    typed_vector_setter(sc, v, i, p);
+  else out_of_range_error_nr(sc, sc->vector_set_symbol, int_two, wrap_integer(sc, i), (i < 0) ? it_is_negative_string : it_is_too_large_string);
+  return(p);
+}
+
+static s7_pointer typed_vector_set_p_piip_direct(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2, s7_pointer p)
+{
+  if ((i1 < 0) || (i2 < 0) ||
+      (i1 >= vector_dimension(v, 0)) || (i2 >= vector_dimension(v, 1)))
+    return(g_vector_set(sc, set_plist_4(sc, v, make_integer(sc, i1), make_integer_unchecked(sc, i2), p)));
+  return(typed_vector_setter(sc, v, i2 + (i1 * vector_offset(v, 0)), p));
+}
+
+static s7_pointer t_vector_set_p_pip_direct(s7_scheme *unused_sc, s7_pointer v, s7_int i, s7_pointer p) {vector_element(v, i) = p; return(p);}
+
+static s7_pointer typed_t_vector_set_p_pip_direct(s7_scheme *sc, s7_pointer v, s7_int i, s7_pointer p)
+{
+  typed_vector_setter(sc, v, i, p);
+  return(p);
+}
+
+static s7_pointer g_vector_set_3(s7_scheme *sc, s7_pointer args)
+{
+  /* (vector-set! vector index value) */
+  s7_pointer ind, vec = car(args), val;
+  s7_int index;
+
+  if (!is_any_vector(vec))
+    return(g_vector_set(sc, args));
+  if (is_immutable_vector(vec))
+    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->vector_set_symbol, vec));
+  if (vector_rank(vec) > 1)
+    return(g_vector_set(sc, args));
+
+  ind = cadr(args);
+  if (!s7_is_integer(ind))
+    return(g_vector_set(sc, args));
+  index = s7_integer_clamped_if_gmp(sc, ind);
+  if ((index < 0) || (index >= vector_length(vec)))
+    out_of_range_error_nr(sc, sc->vector_set_symbol, int_two, wrap_integer(sc, index), (index < 0) ? it_is_negative_string : it_is_too_large_string);
+
+  val = caddr(args);
+  if (is_typed_t_vector(vec))
+    return(typed_vector_setter(sc, vec, index, val));
+  if (is_t_vector(vec))
+    vector_element(vec, index) = val;
+  else vector_setter(vec)(sc, vec, index, val);
+  return(val);
+}
+
+static s7_pointer vector_set_p_ppp(s7_scheme *sc, s7_pointer vec, s7_pointer ind, s7_pointer val)
+{
+  s7_int index;
+
+  if ((!is_t_vector(vec)) || (vector_rank(vec) > 1))
+    return(g_vector_set(sc, set_plist_3(sc, vec, ind, val)));
+  if (is_immutable_vector(vec))
+    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->vector_set_symbol, vec));
+  if (!s7_is_integer(ind))
+    return(g_vector_set(sc, set_plist_3(sc, vec, ind, val)));
+  index = s7_integer_clamped_if_gmp(sc, ind);
+  if ((index < 0) || (index >= vector_length(vec)))
+    out_of_range_error_nr(sc, sc->vector_set_symbol, int_two, wrap_integer(sc, index), (index < 0) ? it_is_negative_string : it_is_too_large_string);
+
+  if (is_typed_vector(vec))
+    return(typed_vector_setter(sc, vec, index, val));
+  vector_element(vec, index) = val;
+  return(val);
+}
+
+static s7_pointer g_vector_set_4(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer v = car(args), ip1 = cadr(args), ip2 = caddr(args), val;
+  s7_int i1, i2;
+  if ((!is_any_vector(v)) ||
+      (vector_rank(v) != 2) ||
+      (is_immutable_vector(v)) ||
+      (!s7_is_integer(ip1)) ||
+      (!s7_is_integer(ip2)))
+    return(g_vector_set(sc, args));
+  i1 = s7_integer_clamped_if_gmp(sc, ip1);
+  i2 = s7_integer_clamped_if_gmp(sc, ip2);
+  if ((i1 < 0) || (i2 < 0) ||
+      (i1 >= vector_dimension(v, 0)) || (i2 >= vector_dimension(v, 1)))
+    return(g_vector_set(sc, args));
+  val = cadddr(args);
+  if (is_typed_t_vector(v))
+    return(typed_vector_setter(sc, v, i2 + (i1 * vector_offset(v, 0)), val));
+  if (is_t_vector(v))
+    vector_element(v, i2 + (i1 * vector_offset(v, 0))) = val;
+  else vector_setter(v)(sc, v, i2 + (i1 * vector_offset(v, 0)), val);
+  return(val);
+}
+
+static s7_pointer vector_set_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer unused_expr)
+{
+  if (args == 3) return(sc->vector_set_3);
+  return((args == 4) ? sc->vector_set_4 : f);
+}
+
+
+/* -------------------------------- make-vector -------------------------------- */
+static s7_int multivector_length(s7_scheme *sc, s7_pointer x, s7_pointer caller)
+{
+  s7_pointer y;
+  s7_int len, dims = s7_list_length(sc, x);
+  if (dims <= 0)                /* 0 if circular, negative if dotted */
+    wrong_type_error_nr(sc, caller, 1, x, a_proper_list_string);
+  if (dims > sc->max_vector_dimensions)
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_3(sc, wrap_string(sc, "~S specifies too many dimensions: '~S, but (*s7* 'max-vector-dimensions) is ~D", 78),
+			 x, wrap_integer(sc, sc->max_vector_dimensions)));
+  for (y = x, len = 1; is_pair(y); y = cdr(y))
+    {
+      if (!s7_is_integer(car(y)))
+	wrong_type_error_nr(sc, caller, position_of(y, x), car(y), sc->type_names[T_INTEGER]);
+#if HAVE_OVERFLOW_CHECKS
+      if (multiply_overflow(len, s7_integer_clamped_if_gmp(sc, car(y)), &len)) /* or better perhaps len > sc->max_vector_length */
+	out_of_range_error_nr(sc, caller, wrap_integer(sc, position_of(y, x)), car(y), it_is_too_large_string);
+#else
+      len *= s7_integer_clamped_if_gmp(sc, car(y));
+#endif
+      if (len < 0)
+	wrong_type_error_nr(sc, caller, position_of(y, x), car(y), a_non_negative_integer_string);
+    }
+  return(len);
+}
+
+static void check_vector_typer_c_function(s7_scheme *sc, s7_pointer caller, s7_pointer typf)
+{
+  s7_pointer sig = c_function_signature(typf);
+  if ((sig != sc->pl_bt) &&
+      (is_pair(sig)) &&
+      ((car(sig) != sc->is_boolean_symbol) || (cadr(sig) != sc->T) || (!is_null(cddr(sig)))))
+    wrong_type_error_nr(sc, caller, 2, typf, wrap_string(sc, "a boolean procedure", 19));
+  if (!c_function_name(typf))
+    wrong_type_error_nr(sc, caller, 2, typf, wrap_string(sc, "a named function", 16));
+  if (!c_function_marker(typf))
+    c_function_set_marker(typf, mark_vector_1);
+  if (!c_function_symbol(typf))
+    c_function_symbol(typf) = make_symbol(sc, c_function_name(typf), c_function_name_length(typf));
+}
+
+static inline s7_pointer make_multivector(s7_scheme *sc, s7_pointer vec, s7_pointer x)
+{
+  vdims_t *v = list_to_dims(sc, x);
+  vdims_original(v) = sc->F;
+  vector_set_dimension_info(vec, v);
+  add_multivector(sc, vec);
+  return(vec);
+}
+
+static s7_pointer g_make_vector_1(s7_scheme *sc, s7_pointer args, s7_pointer caller)
+{
+  s7_int len;
+  s7_pointer x = car(args), fill = sc->unspecified, vec, typf = sc->T;
+  int32_t result_type = T_VECTOR;
+
+  if (s7_is_integer(x))
+    {
+      len = s7_integer_clamped_if_gmp(sc, x);
+      if (len < 0)
+	wrong_type_error_nr(sc, caller, 1, x, a_non_negative_integer_string);
+    }
+  else
+    {
+      if (!(is_pair(x)))
+	return(method_or_bust(sc, x, caller, args, wrap_string(sc, "an integer or a list of integers", 32), 1));
+      if (!s7_is_integer(car(x)))
+	wrong_type_error_nr(sc, caller, 1, car(x), sc->type_names[T_INTEGER]);
+      len = (is_null(cdr(x))) ? s7_integer_clamped_if_gmp(sc, car(x)) : multivector_length(sc, x, caller);
+    }
+
+  if (is_pair(cdr(args)))
+    {
+      fill = cadr(args);
+      if (caller == sc->make_int_vector_symbol)
+	result_type = T_INT_VECTOR;
+      else
+	if (caller == sc->make_float_vector_symbol)
+	  result_type = T_FLOAT_VECTOR;
+	else
+	  if (caller == sc->make_byte_vector_symbol)
+	    result_type = T_BYTE_VECTOR;
+      if (is_pair(cddr(args)))
+	{
+	  typf = caddr(args);
+	  if ((!is_c_function(typf)) &&
+	      (!is_any_closure(typf)) &&
+	      (typf != sc->T))  /* default value */
+	    wrong_type_error_nr(sc, caller, 3, typf, wrap_string(sc, "a built-in procedure, a closure or #t", 37));
+	  if (is_any_closure(typf))
+	    {
+	      if (!is_symbol(find_closure(sc, typf, closure_let(typf))))
+		wrong_type_error_nr(sc, caller, 3, typf, wrap_string(sc, "a named function", 16));
+	      /* the name is needed primarily by the error handler: "vector-set! third argument, ..., is a ... but should be a <...>" */
+	    }
+	  else
+	    if (is_c_function(typf))
+	      {
+		if (typf == global_value(sc->is_float_symbol))
+		  {
+		    if (!is_real(fill)) wrong_type_error_nr(sc, caller, 2, fill, sc->type_names[T_REAL]);
+		    result_type = T_FLOAT_VECTOR;
+		  }
+		else
+		  if (typf == global_value(sc->is_integer_symbol))
+		    {
+		      if (!s7_is_integer(fill)) wrong_type_error_nr(sc, caller, 2, fill, sc->type_names[T_INTEGER]);
+		      result_type = (WITH_GMP) ? T_VECTOR : T_INT_VECTOR;
+		    }
+		  else
+		    if (typf == global_value(sc->is_byte_symbol))
+		      {
+			if (!is_byte(fill)) wrong_type_error_nr(sc, caller, 2, fill, an_unsigned_byte_string);
+			result_type = T_BYTE_VECTOR;
+		      }
+		    else check_vector_typer_c_function(sc, caller, typf);
+	      }}}
+  /* before making the new vector, if fill is specified and the vector is typed, we have to check for a type error.
+   *    otherwise we can end up with a vector whose elements are NULL, causing a segfault in the gc.
+   */
+  if ((result_type == T_VECTOR) &&
+      (typf != sc->T) &&            /* default value */
+      (s7_apply_function(sc, typf, set_plist_1(sc, fill)) == sc->F))
+    {
+      const char *tstr = make_type_name(sc, (is_c_function(typf)) ? c_function_name(typf) : symbol_name(find_closure(sc, typf, closure_let(typf))), INDEFINITE_ARTICLE);
+      wrong_type_error_nr(sc, sc->make_vector_symbol, 2, fill, wrap_string(sc, tstr, safe_strlen(tstr)));
+    }
+
+  vec = make_vector_1(sc, len, NOT_FILLED, result_type);
+  if ((result_type == T_VECTOR) &&
+      (typf != sc->T))  /* default value */
+    {
+      set_typed_vector(vec);
+      typed_vector_set_typer(vec, typf);
+
+      if ((is_c_function(typf)) &&
+	  (c_function_has_simple_elements(typf)))
+	set_has_simple_elements(vec);
+    }
+  s7_vector_fill(sc, vec, fill);
+  if ((is_pair(x)) &&
+      (is_pair(cdr(x))))
+    return(make_multivector(sc, vec, x));
+  add_vector(sc, vec);
+  return(vec);
+}
+
+static s7_pointer g_make_vector(s7_scheme *sc, s7_pointer args)
+{
+  #define H_make_vector "(make-vector len (value #<unspecified>) type) returns a vector of len elements initialized to value. \
+To create a multidimensional vector, put the dimension bounds in a list (this is to avoid ambiguities such as \
+(make-vector 1 2) where it's not clear whether the '2' is an initial value or a dimension size).  (make-vector '(2 3) 1.0) \
+returns a 2 dimensional vector of 6 total elements, all initialized to 1.0. The 'type argument can set the element type. \
+It is a function that checks the new value, returning #f if the value is not acceptable: (make-vector 8 1/2 rational?)."
+  #define Q_make_vector s7_make_signature(sc, 4, sc->is_vector_symbol, \
+					  s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_pair_symbol), sc->T, \
+					  s7_make_signature(sc, 2, sc->is_procedure_symbol, sc->is_boolean_symbol))
+  return(g_make_vector_1(sc, args, sc->make_vector_symbol));
+}
+
+
+/* -------------------------------- make-float-vector -------------------------------- */
+static s7_pointer g_make_float_vector(s7_scheme *sc, s7_pointer args)
+{
+  #define H_make_float_vector "(make-float-vector len (init 0.0)) returns a float-vector."
+  #define Q_make_float_vector s7_make_signature(sc, 3, \
+                                sc->is_float_vector_symbol, s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_pair_symbol), sc->is_real_symbol)
+  s7_int len;
+  s7_pointer x, p = car(args);
+  block_t *arr;
+
+  if ((is_pair(cdr(args))) || (!s7_is_integer(p)))
+    {
+      s7_pointer init;
+      if (is_pair(cdr(args)))
+	{
+	  init = cadr(args);
+	  if (!is_real(init))
+	    return(method_or_bust(sc, init, sc->make_float_vector_symbol, args, sc->type_names[T_REAL], 2));
+#if WITH_GMP
+	  if (s7_is_bignum(init))
+	    return(g_make_vector_1(sc, set_plist_2(sc, p, wrap_real(sc, s7_real(init))), sc->make_float_vector_symbol));
+#endif
+	  if (is_rational(init))
+	    return(g_make_vector_1(sc, set_plist_2(sc, p, wrap_real(sc, rational_to_double(sc, init))), sc->make_float_vector_symbol));
+	}
+      else init = real_zero;
+      if (s7_is_integer(p))
+	len = s7_integer_clamped_if_gmp(sc, p);
+      else
+	{
+	  if (!is_pair(p))
+	    return(method_or_bust(sc, p, sc->make_float_vector_symbol, args, wrap_string(sc, "an integer or a list of integers", 32), 1));
+	  len = multivector_length(sc, p, sc->make_float_vector_symbol);
+	}
+      x = make_vector_1(sc, len, NOT_FILLED, T_FLOAT_VECTOR);
+      float_vector_fill(x, s7_real(init));
+      if (!s7_is_integer(p))
+	return(make_multivector(sc, x, p));
+      add_vector(sc, x);
+      return(x);
+    }
+
+  len = s7_integer_clamped_if_gmp(sc, p);
+  if (len < 0)
+    out_of_range_error_nr(sc, sc->make_float_vector_symbol, int_one, p, it_is_negative_string);
+  if (len > sc->max_vector_length)
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_3(sc, wrap_string(sc, "make-float-vector first argument ~D is greater than (*s7* 'max-vector-length), ~D", 81),
+			 wrap_integer(sc, len), wrap_integer(sc, sc->max_vector_length)));
+
+  arr = mallocate_vector(sc, len * sizeof(s7_double));
+  new_cell(sc, x, T_FLOAT_VECTOR | T_SAFE_PROCEDURE);
+  vector_length(x) = len;
+  vector_block(x) = arr;
+  float_vector_floats(x) = (s7_double *)block_data(arr);
+  if (len > 0)
+    {
+      if (STEP_8(len))
+	memclr64((void *)float_vector_floats(x), len * sizeof(s7_double));
+      else memclr((void *)float_vector_floats(x), len * sizeof(s7_double));
+    }
+  vector_set_dimension_info(x, NULL);
+  vector_getter(x) = float_vector_getter;
+  vector_setter(x) = float_vector_setter;
+
+  add_vector(sc, x);
+  return(x);
+}
+
+static s7_pointer make_float_vector_p_pp(s7_scheme *sc, s7_pointer len, s7_pointer fill)
+{
+  if ((is_t_integer(len)) && (is_t_real(fill)) &&
+      (integer(len)>= 0) && (integer(len) < sc->max_vector_length))
+    {
+      s7_pointer fv = make_simple_float_vector(sc, integer(len));
+      float_vector_fill(fv, real(fill));
+      return(fv);
+    }
+  return(g_make_float_vector(sc, set_plist_2(sc, len, fill)));
+}
+
+
+/* -------------------------------- make-int-vector -------------------------------- */
+static s7_pointer g_make_int_vector(s7_scheme *sc, s7_pointer args)
+{
+  #define H_make_int_vector "(make-int-vector len (init 0)) returns an int-vector."
+  #define Q_make_int_vector s7_make_signature(sc, 3, sc->is_int_vector_symbol, \
+                               s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_pair_symbol), sc->is_integer_symbol)
+  s7_int len;
+  s7_pointer x, p = car(args);
+  block_t *arr;
+
+  if ((is_pair(cdr(args))) ||
+      (!s7_is_integer(p)))
+    {
+      s7_pointer init;
+      if (is_pair(cdr(args)))
+	{
+	  init = cadr(args);
+	  if (!s7_is_integer(init))
+	    return(method_or_bust(sc, init, sc->make_int_vector_symbol, args, sc->type_names[T_INTEGER], 2));
+	}
+      else init = int_zero;
+      if (s7_is_integer(p))
+	len = s7_integer_clamped_if_gmp(sc, p);
+      else
+	{
+	  if (!is_pair(p))
+	    return(method_or_bust(sc, p, sc->make_int_vector_symbol, args, wrap_string(sc, "an integer or a list of integers", 32), 1));
+	  len = multivector_length(sc, p, sc->make_int_vector_symbol);
+	}
+      x = make_vector_1(sc, len, NOT_FILLED, T_INT_VECTOR);
+      int_vector_fill(x, s7_integer_clamped_if_gmp(sc, init));
+      if (!s7_is_integer(p))
+	return(make_multivector(sc, x, p));
+      add_vector(sc, x);
+      return(x);
+    }
+
+  len = s7_integer_clamped_if_gmp(sc, p);
+  if (len < 0)
+    out_of_range_error_nr(sc, sc->make_int_vector_symbol, int_one, p, it_is_negative_string);
+  if (len > sc->max_vector_length)
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_3(sc, wrap_string(sc, "make-int-vector first argument ~D is greater than (*s7* 'max-vector-length), ~D", 79),
+			 wrap_integer(sc, len), wrap_integer(sc, sc->max_vector_length)));
+
+  arr = mallocate_vector(sc, len * sizeof(s7_int));
+  new_cell(sc, x, T_INT_VECTOR | T_SAFE_PROCEDURE);
+  vector_length(x) = len;
+  vector_block(x) = arr;
+  int_vector_ints(x) = (s7_int *)block_data(arr);
+  if (len > 0)
+    {
+      if (STEP_8(len))
+	memclr64((void *)int_vector_ints(x), len * sizeof(s7_int));
+      else memclr((void *)int_vector_ints(x), len * sizeof(s7_int));
+    }
+  vector_set_dimension_info(x, NULL);
+  vector_getter(x) = int_vector_getter;
+  vector_setter(x) = int_vector_setter;
+
+  add_vector(sc, x);
+  return(x);
+}
+
+static s7_pointer make_int_vector_p_ii(s7_scheme *sc, s7_int len, s7_int init)
+{
+  s7_pointer x = make_vector_1(sc, len, NOT_FILLED, T_INT_VECTOR);
+  int_vector_fill(x, init);
+  add_vector(sc, x);
+  return(x);
+}
+
+
+/* -------------------------------- make-byte-vector -------------------------------- */
+static s7_pointer g_make_byte_vector(s7_scheme *sc, s7_pointer args)
+{
+  #define H_make_byte_vector "(make-byte-vector len (byte 0)) makes a byte-vector of length len filled with byte."
+  #define Q_make_byte_vector s7_make_signature(sc, 3, sc->is_byte_vector_symbol, \
+                               s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_pair_symbol), sc->is_byte_symbol)
+  s7_int len = 0, ib = 0;
+  s7_pointer p = car(args), init;
+
+  if (!is_pair(p))
+    {
+      if (!s7_is_integer(p))
+	return(method_or_bust(sc, p, sc->make_byte_vector_symbol, args, sc->type_names[T_INTEGER], 1));
+      len = s7_integer_clamped_if_gmp(sc, p);
+      if (len < 0)
+	out_of_range_error_nr(sc, sc->make_byte_vector_symbol, int_one, p, it_is_negative_string);
+      if (len > sc->max_vector_length)
+	error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_3(sc, wrap_string(sc, "make-byte-vector first argument ~D is greater than (*s7* 'max-vector-length), ~D", 80),
+			 wrap_integer(sc, len), wrap_integer(sc, sc->max_vector_length)));
+    }
+  if (is_pair(cdr(args)))
+    {
+      init = cadr(args);
+      if (!s7_is_integer(init))
+	return(method_or_bust(sc, init, sc->make_byte_vector_symbol, args, sc->type_names[T_INTEGER], 2));
+      ib = s7_integer_clamped_if_gmp(sc, init);
+      if ((ib < 0) || (ib > 255))
+	wrong_type_error_nr(sc, sc->make_byte_vector_symbol, 2, init, an_unsigned_byte_string);
+    }
+  else init = int_zero;
+
+ if (!s7_is_integer(p))
+   return(g_make_vector_1(sc, set_plist_2(sc, p, init), sc->make_byte_vector_symbol));
+
+  p = make_simple_byte_vector(sc, len);
+  if (len > 0) /* make-byte-vector 2) should return #u(0 0) so we always need to fill */
+    local_memset((void *)(byte_vector_bytes(p)), ib, len);
+  return(p);
+}
+
+static s7_pointer make_byte_vector_p_ii(s7_scheme *sc, s7_int len, s7_int init)
+{
+  s7_pointer p;
+  if (len < 0)
+    out_of_range_error_nr(sc, sc->make_byte_vector_symbol, int_one, wrap_integer(sc, len), it_is_negative_string);
+  if (len > sc->max_vector_length)
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_3(sc, wrap_string(sc, "make-byte-vector first argument ~D is greater than (*s7* 'max-vector-length), ~D", 80),
+			 wrap_integer(sc, len), wrap_integer(sc, sc->max_vector_length)));
+  if ((init < 0) || (init > 255))
+    wrong_type_error_nr(sc, sc->make_byte_vector_symbol, 2, wrap_integer(sc, init), an_unsigned_byte_string);
+  p = make_simple_byte_vector(sc, len);
+  if (len > 0)
+    local_memset((void *)(byte_vector_bytes(p)), init, len);
+  return(p);
+}
+
+
+/* -------------------------------- vector? -------------------------------- */
+static s7_pointer g_is_vector(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_vector "(vector? obj) returns #t if obj is a vector"
+  #define Q_is_vector sc->pl_bt
+  check_boolean_method(sc, is_any_vector, sc->is_vector_symbol, args);
+}
+
+
+/* -------------------------------- vector-rank -------------------------------- */
+s7_int s7_vector_rank(s7_pointer vect) {return((s7_int)(vector_rank(vect)));}
+
+static s7_pointer g_vector_rank(s7_scheme *sc, s7_pointer args)
+{
+  #define H_vector_rank "(vector-rank vect) returns the number of dimensions in vect"
+  #define Q_vector_rank s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_vector_symbol)
+  s7_pointer x = car(args);
+  if (!is_any_vector(x))
+    return(sole_arg_method_or_bust(sc, x, sc->vector_rank_symbol, args, sc->type_names[T_VECTOR]));
+  return(make_integer(sc, vector_rank(x)));
+}
+
+
+/* -------------------------------- vector-dimension -------------------------------- */
+static s7_pointer g_vector_dimension(s7_scheme *sc, s7_pointer args)
+{
+  #define H_vector_dimension "(vector-dimension vect n) returns the size of the n-th dimension (n is 0-based)"
+  #define Q_vector_dimension s7_make_signature(sc, 3, sc->is_integer_symbol, sc->is_vector_symbol, sc->is_integer_symbol)
+  s7_pointer v = car(args);
+  s7_pointer np = cadr(args);
+  s7_int n;
+  if (!is_any_vector(v))
+    return(method_or_bust(sc, v, sc->vector_dimension_symbol, args, sc->type_names[T_VECTOR], 1));
+  if (!s7_is_integer(np))
+    return(method_or_bust(sc, v, sc->vector_dimension_symbol, args, sc->type_names[T_INTEGER], 2));
+  n = s7_integer_clamped_if_gmp(sc, np);
+  if (n < 0)
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_2(sc, wrap_string(sc, "vector-dimension second argument is negative: ~S", 48), np));
+  if (n >= vector_rank(v))
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_3(sc, wrap_string(sc, "vector-dimension second argument, ~S, should be less than the vector rank, ~D", 77),
+			 np, wrap_integer(sc, vector_rank(v))));
+  if (vector_has_dimension_info(v))
+    return(make_integer(sc, vector_dimension(v, n)));
+  return(make_integer(sc, vector_length(v)));
+}
+
+
+/* -------------------------------- vector-dimensions -------------------------------- */
+static s7_pointer g_vector_dimensions(s7_scheme *sc, s7_pointer args)
+{
+  #define H_vector_dimensions "(vector-dimensions vect) returns a list of vect's dimensions"
+  #define Q_vector_dimensions s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_vector_symbol)
+
+  s7_pointer x = car(args);
+  if (!is_any_vector(x))
+    return(sole_arg_method_or_bust(sc, x, sc->vector_dimensions_symbol, args, sc->type_names[T_VECTOR]));
+  if (vector_rank(x) == 1)
+    return(list_1(sc, make_integer(sc, vector_length(x))));
+
+  sc->w = sc->nil;
+  for (s7_int i = vector_ndims(x) - 1; i >= 0; i--)
+    sc->w = cons(sc, make_integer(sc, vector_dimension(x, i)), sc->w);
+  x = sc->w;
+  sc->w = sc->unused;
+  return(x);
+}
+
+
+/* -------------------------------- vector-typer -------------------------------- */
+static s7_pointer g_vector_typer(s7_scheme *sc, s7_pointer args)
+{
+  #define H_vector_typer "(vector-typer vect) returns the vector's element type checking function"
+  #define Q_vector_typer s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->not_symbol, sc->is_procedure_symbol), sc->is_vector_symbol)
+
+  s7_pointer v = car(args);
+  if (!is_any_vector(v))
+    return(sole_arg_method_or_bust(sc, v, sc->vector_typer_symbol, args, sc->type_names[T_VECTOR]));
+
+  if (is_typed_t_vector(v)) return(typed_vector_typer(v));
+  if (is_float_vector(v)) return(global_value(sc->is_float_symbol));
+  if (is_int_vector(v)) return(global_value(sc->is_integer_symbol));
+  if (is_byte_vector(v)) return(global_value(sc->is_byte_symbol));
+  return(sc->F);
+}
+
+static s7_pointer g_set_vector_typer(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer v = car(args), typer = cadr(args);
+
+  if (!is_any_vector(v))
+    wrong_type_error_nr(sc, wrap_string(sc, "set! vector-typer", 17), 1, v, sc->type_names[T_VECTOR]);
+  if (is_immutable_vector(v))
+    immutable_object_error_nr(sc, set_elist_2(sc, wrap_string(sc, "~S is immutable so its vector-typer can't be set!", 49), v));
+
+  if (!is_t_vector(v))
+    {
+      if (((is_int_vector(v)) && (typer != global_value(sc->is_integer_symbol))) ||
+	  ((is_float_vector(v)) && (typer != global_value(sc->is_float_symbol))) ||
+	  ((is_byte_vector(v)) && (typer != global_value(sc->is_byte_symbol))))
+	error_nr(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, wrap_string(sc, "vector-typer can't set ~S typer to ~S", 37), v, typer));
+      return(typer);
+    }
+  if (is_boolean(typer))
+    {
+      if (is_typed_vector(v))
+	{
+	  typed_vector_set_typer(v, sc->F);
+	  clear_typed_vector(v);
+	  clear_has_simple_elements(v); /* 15-Oct-23 */
+	}}
+  else
+    {
+      if (is_c_function(typer))
+	check_vector_typer_c_function(sc, sc->vector_typer_symbol, typer); /* this is just error checking */
+      else
+	{
+	  if (!is_any_closure(typer))
+	    wrong_type_error_nr(sc, sc->vector_typer_symbol, 2, typer, wrap_string(sc, "a built-in procedure, a closure, #f or #t", 41));
+	  if (!is_symbol(find_closure(sc, typer, closure_let(typer))))
+	    wrong_type_error_nr(sc, sc->vector_typer_symbol, 2, typer, wrap_string(sc, "a named function", 16));
+	  /* the name is needed primarily by the error handler: "vector-set! second argument, ..., is a ... but should be a <...>" */
+	}
+      set_typed_vector(v);
+      typed_vector_set_typer(v, typer);
+      if ((is_c_function(typer)) &&
+	  (c_function_has_simple_elements(typer)))
+	set_has_simple_elements(v);
+      else clear_has_simple_elements(v); /* 15-Oct-23 */
+      }
+  return(typer);
+}
+
+
+/* -------------------------------- multivector -------------------------------- */
+#define MULTIVECTOR_TOO_MANY_ELEMENTS -1
+#define MULTIVECTOR_NOT_ENOUGH_ELEMENTS -2
+
+static int32_t traverse_vector_data(s7_scheme *sc, s7_pointer vec, s7_int flat_ref, s7_int dimension, s7_int dimensions, s7_int *sizes, s7_pointer lst)
+{
+  /* we're filling vec, we're currently looking for element flat_ref,
+   *   we're at ref in dimension of dimensions, where sizes gives the bounds, and lst is our data
+   *   #3D(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12)))
+   */
+  s7_pointer x = lst;
+  for (s7_int i = 0; i < sizes[dimension]; i++, x = cdr(x))
+    {
+      if (!is_pair(x))
+	return(MULTIVECTOR_NOT_ENOUGH_ELEMENTS);
+      if (dimension == (dimensions - 1))
+	vector_setter(vec)(sc, vec, flat_ref++, car(x));
+      else
+	{
+	  flat_ref = traverse_vector_data(sc, vec, flat_ref, dimension + 1, dimensions, sizes, car(x));
+	  if (flat_ref < 0) return(flat_ref);
+	}}
+  return((is_null(x)) ? flat_ref : MULTIVECTOR_TOO_MANY_ELEMENTS);
+}
+
+static s7_pointer reverse_in_place_unchecked(s7_scheme *sc, s7_pointer term, s7_pointer list)
+{
+  s7_pointer p = list, result = term;
+  while (true)
+    {
+      s7_pointer q;
+      LOOP_4(if (is_null(p)) return(result); q = cdr(p); set_cdr(p, result); result = p; p = q); /* return, not break because LOOP_4 is itself a do loop */
+    }
+  return(result);
+}
+
+static s7_pointer proper_list_reverse_in_place(s7_scheme *sc, s7_pointer list)
+{
+  return(reverse_in_place_unchecked(sc, sc->nil, list));
+}
+
+static noreturn void multivector_error_nr(s7_scheme *sc, const char *message, s7_pointer data)
+{
+  error_nr(sc, sc->read_error_symbol,
+	   set_elist_3(sc, wrap_string(sc, "reading constant vector, ~A: ~A", 31),
+		       s7_make_string_wrapper(sc, message), data));
+}
+
+static s7_pointer g_multivector(s7_scheme *sc, s7_int dims, s7_pointer data)
+{
+  /* get the dimension bounds from data, make the new vector, fill it from data
+   * dims needs to be s7_int so we can at least give correct error messages.
+   */
+  s7_pointer vec, x = data;
+  s7_int err, vec_loc;
+  s7_int *sizes;
+
+  /* (#2d((1 2 3) (4 5 6)) 0 0) -> 1
+   * (#2d((1 2 3) (4 5 6)) 1 1) -> 5
+   * (#3d(((1 2) (3 4)) ((5 6) (7 8))) 1 1 0) -> 7
+   * #3d(((1 2) (3 4)) ((5 6) (7))) -> error, #3d(((1 2) (3 4)) ((5 6) (7 8 9))), #3d(((1 2) (3 4)) (5 (7 8 9))) etc
+   * but a special case: #nd() is an n-dimensional empty vector
+   */
+
+  if (dims <= 0)      /* #0d(...) #2147483649D() [if dims is int32_t this is negative] */
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_2(sc, wrap_string(sc, "#nD(...) dimensions, ~A, should be 1 or more", 44), wrap_integer(sc, dims)));
+
+  if (dims > sc->max_vector_dimensions) /* probably can't happen -- caught in read_sharp? */
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_3(sc, wrap_string(sc, "#nD(...) dimensions, ~D, should be less that (*s7* 'max-vector-dimensions): ~D", 78),
+			 wrap_integer(sc, dims), wrap_integer(sc, sc->max_vector_dimensions)));
+  sc->w = sc->nil;
+  if (is_null(data))  /* dims are already 0 (calloc above) */
+    return(g_make_vector(sc, set_plist_1(sc, make_list(sc, dims, int_zero))));
+
+  sizes = (s7_int *)Calloc(dims, sizeof(s7_int));
+  for (s7_int i = 0; i < dims; i++)
+    {
+      sizes[i] = proper_list_length(x);
+      sc->w = cons(sc, make_integer(sc, sizes[i]), sc->w);
+      x = car(x);
+      if ((i < (dims - 1)) &&
+	  (!is_pair(x)))
+	{
+	  free(sizes);
+	  multivector_error_nr(sc, "we need a list that fully specifies the vector's elements", data);
+	}}
+
+  vec = g_make_vector(sc, set_plist_1(sc, sc->w = proper_list_reverse_in_place(sc, sc->w)));
+  vec_loc = gc_protect_1(sc, vec);
+  sc->w = sc->unused;
+
+  /* now fill the vector checking that all the lists match */
+  err = traverse_vector_data(sc, vec, 0, 0, dims, sizes, data);
+
+  free(sizes);
+  s7_gc_unprotect_at(sc, vec_loc);
+  if (err < 0)
+    multivector_error_nr(sc, (err == MULTIVECTOR_TOO_MANY_ELEMENTS) ? "found too many elements" : "not enough elements found", data);
+  return(vec);
+}
+
+static s7_pointer g_int_multivector(s7_scheme *sc, s7_int dims, s7_pointer data)
+{
+  /* dims > 1, sc->value is a pair (not null) */
+  s7_pointer *src;
+  s7_int len;
+  sc->value = g_multivector(sc, dims, data);
+  src = (s7_pointer *)vector_elements(sc->value);
+  len = vector_length(sc->value);
+  for (s7_int i = 0; i < len; i++)
+    if (!is_t_integer(src[i]))
+      wrong_type_error_nr(sc, wrap_string(sc, "#i(...)", 7), i + 1, src[i], sc->type_names[T_INTEGER]);
+  sc->args = g_make_vector_1(sc, set_plist_2(sc, g_vector_dimensions(sc, set_plist_1(sc, sc->value)), int_zero), sc->make_int_vector_symbol);
+  return(s7_copy_1(sc, sc->int_vector_symbol, set_plist_2(sc, sc->value, sc->args)));
+}
+
+static s7_pointer g_byte_multivector(s7_scheme *sc, s7_int dims, s7_pointer data)
+{
+  /* dims > 1, sc->value is a pair (not null) */
+  s7_pointer *src;
+  s7_int len;
+  sc->value = g_multivector(sc, dims, data);
+  src = (s7_pointer *)vector_elements(sc->value);
+  len = vector_length(sc->value);
+  for (s7_int i = 0; i < len; i++)
+    if (!is_byte(src[i]))
+      wrong_type_error_nr(sc, wrap_string(sc, "#u(...)", 7), i + 1, src[i], wrap_string(sc, "a byte", 6));
+  sc->args = g_make_vector_1(sc, set_plist_2(sc, g_vector_dimensions(sc, set_plist_1(sc, sc->value)), int_zero), sc->make_byte_vector_symbol);
+  return(s7_copy_1(sc, sc->byte_vector_symbol, set_plist_2(sc, sc->value, sc->args)));
+}
+
+static s7_pointer g_float_multivector(s7_scheme *sc, s7_int dims, s7_pointer data)
+{
+  /* dims > 1, sc->value is a pair (not null) */
+  s7_pointer *src;
+  s7_int len;
+  sc->value = g_multivector(sc, dims, data);
+  src = (s7_pointer *)vector_elements(sc->value);
+  len = vector_length(sc->value);
+  for (s7_int i = 0; i < len; i++)
+    if (!is_real(src[i]))
+      wrong_type_error_nr(sc, wrap_string(sc, "#r(...)", 7), i + 1, src[i], sc->type_names[T_REAL]);
+  sc->args = g_make_vector_1(sc, set_plist_2(sc, g_vector_dimensions(sc, set_plist_1(sc, sc->value)), real_zero), sc->make_float_vector_symbol);
+  return(s7_copy_1(sc, sc->float_vector_symbol, set_plist_2(sc, sc->value, sc->args)));
+}
+
+static Vectorized s7_pointer s7_vector_copy_1(s7_scheme *sc, s7_pointer old_vect)
+{
+  s7_int len = vector_length(old_vect);
+  s7_pointer new_vect;
+
+  if (is_t_vector(old_vect))
+    {
+      s7_pointer *src = (s7_pointer *)vector_elements(old_vect), *dst;
+      if ((is_typed_vector(old_vect)) && (len > 0)) /* preserve the type info as well */
+	{
+	  if (vector_rank(old_vect) > 1)
+	    new_vect = g_make_vector(sc, set_plist_3(sc, g_vector_dimensions(sc, set_plist_1(sc, old_vect)),
+						     vector_element(old_vect, 0), typed_vector_typer(old_vect)));
+	  else new_vect = g_make_vector(sc, set_plist_3(sc, make_integer(sc, len),
+							vector_element(old_vect, 0), typed_vector_typer(old_vect)));
+	}
+      else
+	if (vector_rank(old_vect) > 1)
+	  new_vect = g_make_vector(sc, set_plist_1(sc, g_vector_dimensions(sc, set_plist_1(sc, old_vect))));
+	else new_vect = make_simple_vector(sc, len);
+      /* here and in vector-fill! we have a problem with bignums -- should new bignums be allocated? (copy_proper_list also) */
+      dst = (s7_pointer *)vector_elements(new_vect);
+      for (s7_int i = len; i > 0; i--) *dst++ = *src++;
+      return(new_vect);
+    }
+
+  if (is_float_vector(old_vect))
+    {
+      const s7_double *src = (s7_double *)float_vector_floats(old_vect);
+      s7_double *dst;
+      if (vector_rank(old_vect) > 1)
+	new_vect = g_make_vector_1(sc, set_plist_2(sc, g_vector_dimensions(sc, set_plist_1(sc, old_vect)), real_zero), sc->make_float_vector_symbol);
+      else new_vect = make_simple_float_vector(sc, len);
+      dst = (s7_double *)float_vector_floats(new_vect);
+      for (s7_int i = len; i > 0; i--) *dst++ = *src++;  /* same speed as memcpy(dst, src, len * sizeof(s7_double)); */
+      return(new_vect);
+    }
+
+  if (is_int_vector(old_vect))
+    {
+      const s7_int *src = (s7_int *)int_vector_ints(old_vect);
+      s7_int *dst;
+      if (vector_rank(old_vect) > 1)
+	new_vect = g_make_vector_1(sc, set_plist_2(sc, g_vector_dimensions(sc, set_plist_1(sc, old_vect)), int_zero), sc->make_int_vector_symbol);
+      else new_vect = make_simple_int_vector(sc, len);
+      dst = (s7_int *)int_vector_ints(new_vect);
+      for (s7_int i = len; i > 0; i--) *dst++ = *src++;
+      return(new_vect);
+    }
+
+  if (is_byte_vector(old_vect))
+    {
+      const uint8_t *src = (const uint8_t *)byte_vector_bytes(old_vect);
+      uint8_t *dst;
+      if (vector_rank(old_vect) > 1)
+	new_vect = g_make_vector_1(sc, set_plist_2(sc, g_vector_dimensions(sc, set_plist_1(sc, old_vect)), int_zero), sc->make_byte_vector_symbol);
+      else new_vect = make_simple_byte_vector(sc, len);
+      dst = (uint8_t *)byte_vector_bytes(new_vect);
+      for (s7_int i = len; i > 0; i--) *dst++ = *src++;
+      return(new_vect);
+    }
+  return(NULL);
+}
+
+s7_pointer s7_vector_copy(s7_scheme *sc, s7_pointer old_vect) {return(s7_vector_copy_1(sc, old_vect));} /* repeated for Vectorized */
+
+static s7_pointer univect_ref(s7_scheme *sc, s7_pointer args, s7_pointer caller, int32_t typ)
+{
+  s7_pointer v = car(args), index;
+  s7_int ind;
+
+  if (type(v) != typ)
+    return(method_or_bust(sc, v, caller, args, sc->type_names[typ], 1));
+
+  if (vector_rank(v) == 1)
+    {
+      index = cadr(args);
+      if (!s7_is_integer(index))
+	return(method_or_bust(sc, index, caller, args, sc->type_names[T_INTEGER], 2));
+      ind = s7_integer_clamped_if_gmp(sc, index);
+      if ((ind < 0) || (ind >= vector_length(v)))
+	sole_arg_out_of_range_error_nr(sc, caller, index, (ind < 0) ? it_is_negative_string : it_is_too_large_string);
+      if (!is_null(cddr(args)))
+	out_of_range_error_nr(sc, caller, int_two, cdr(args), too_many_indices_string);
+    }
+  else
+    {
+      s7_int i;
+      s7_pointer x;
+      ind = 0;
+      for (x = cdr(args), i = 0; (is_not_null(x)) && (i < vector_ndims(v)); x = cdr(x), i++)
+	{
+	  s7_int n;
+	  index = car(x);
+	  if (!s7_is_integer(index))
+	    return(method_or_bust(sc, index, caller, args, sc->type_names[T_INTEGER], i + 2));
+	  n = s7_integer_clamped_if_gmp(sc, index);
+	  if ((n < 0) || (n >= vector_dimension(v, i)))
+	    out_of_range_error_nr(sc, caller, wrap_integer(sc, i + 2), index, (n < 0) ? it_is_negative_string : it_is_too_large_string);
+	  ind += n * vector_offset(v, i);
+	}
+      if (is_not_null(x))
+	out_of_range_error_nr(sc, caller, int_two, cdr(args), too_many_indices_string);
+
+      /* if not enough indices, return a subvector covering whatever is left */
+      if (i < vector_ndims(v))
+	return(subvector(sc, v, i, ind));
+    }
+  if (typ == T_FLOAT_VECTOR)
+    return(make_real(sc, float_vector(v, ind)));
+  return((typ == T_INT_VECTOR) ? make_integer(sc, int_vector(v, ind)) : small_int(byte_vector(v, ind)));
+}
+
+static s7_pointer univect_set(s7_scheme *sc, s7_pointer args, s7_pointer caller, int32_t typ)
+{
+  s7_pointer vec = car(args), val, index;
+  s7_int ind;
+
+  if (type(vec) != typ)
+    return(method_or_bust(sc, vec, caller, args, sc->type_names[typ], 1));
+  if (is_immutable_vector(vec))
+    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, caller, vec));
+
+  if (vector_rank(vec) > 1)
+    {
+      s7_int i;
+      s7_pointer x;
+      ind = 0;
+      for (x = cdr(args), i = 0; (is_not_null(cdr(x))) && (i < vector_ndims(vec)); x = cdr(x), i++)
+	{
+	  s7_int n;
+	  index = car(x);
+	  if (!s7_is_integer(index))
+	    return(method_or_bust(sc, index, caller, args, sc->type_names[T_INTEGER], i + 2));
+	  n = s7_integer_clamped_if_gmp(sc, index);
+	  if ((n < 0) || (n >= vector_dimension(vec, i)))
+	    out_of_range_error_nr(sc, caller, wrap_integer(sc, i + 2), index, (n < 0) ? it_is_negative_string : it_is_too_large_string);
+	  ind += n * vector_offset(vec, i);
+	}
+      if (is_not_null(cdr(x)))
+	error_nr(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, wrap_string(sc, "too many arguments for ~A: ~S", 29), caller, args));
+      if (i != vector_ndims(vec))
+	error_nr(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, wrap_string(sc, "not enough arguments for ~A: ~S", 31), caller, args));
+      val = car(x);
+    }
+  else
+    {
+      s7_pointer p = cdr(args);
+      if (is_null(p))
+	error_nr(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, wrap_string(sc, "not enough arguments for ~A: ~S", 31), caller, args));
+      /* from (set! (v) val) after optimization into op_set_opsq_a which is completely confused -- set! gets v's setter (float-vector-set!) */
+      index = car(p);
+      if (!s7_is_integer(index))
+	return(method_or_bust(sc, index, caller, args, sc->type_names[T_INTEGER], 2));
+      ind = s7_integer_clamped_if_gmp(sc, index);
+      if ((ind < 0) || (ind >= vector_length(vec)))
+	out_of_range_error_nr(sc, caller, int_two, index, (ind < 0) ? it_is_negative_string : it_is_too_large_string);
+      if (is_not_null(cddr(p)))
+	error_nr(sc, sc->wrong_number_of_args_symbol,
+		 set_elist_3(sc, wrap_string(sc, "too many arguments for ~A: ~S", 29), caller, args));
+      val = cadr(p);
+    }
+
+  if (typ == T_FLOAT_VECTOR)
+    {
+      if (!is_real(val))
+	return(method_or_bust(sc, val, caller, args, sc->type_names[T_REAL], 3));
+      float_vector(vec, ind) = s7_real(val);
+    }
+  else
+    if (typ == T_INT_VECTOR)
+      {
+	if (!s7_is_integer(val))
+	  return(method_or_bust(sc, val, caller, args, sc->type_names[T_INTEGER], 3));
+	int_vector(vec, ind) = s7_integer_clamped_if_gmp(sc, val);
+      }
+    else
+      {
+	if (!is_byte(val))
+	  return(method_or_bust(sc, val, caller, args, sc->type_names[T_INTEGER], 3));
+	byte_vector(vec, ind) = (uint8_t)s7_integer_clamped_if_gmp(sc, val);
+      }
+  return(val);
+}
+
+
+/* -------------------------------- float-vector-ref -------------------------------- */
+static s7_pointer g_float_vector_ref(s7_scheme *sc, s7_pointer args)
+{
+  #define H_float_vector_ref "(float-vector-ref v ...) returns an element of the float-vector v."
+  #define Q_float_vector_ref s7_make_circular_signature(sc, 2, 3, \
+                               s7_make_signature(sc, 2, sc->is_float_symbol, sc->is_float_vector_symbol), \
+                               sc->is_float_vector_symbol, sc->is_integer_symbol)
+  return(univect_ref(sc, args, sc->float_vector_ref_symbol, T_FLOAT_VECTOR));
+}
+
+static inline s7_pointer float_vector_ref_p_pp(s7_scheme *sc, s7_pointer v, s7_pointer index)
+{
+  s7_int ind;
+  if (!is_float_vector(v))
+    return(method_or_bust_pp(sc, v, sc->float_vector_ref_symbol, v, index, sc->type_names[T_FLOAT_VECTOR], 1));
+  if (vector_rank(v) != 1)
+    return(univect_ref(sc, set_plist_2(sc, v, index), sc->float_vector_ref_symbol, T_FLOAT_VECTOR));
+  if (!s7_is_integer(index))
+    return(method_or_bust_pp(sc, index, sc->float_vector_ref_symbol, v, index, sc->type_names[T_INTEGER], 2));
+  ind = s7_integer_clamped_if_gmp(sc, index);
+  if ((ind < 0) || (ind >= vector_length(v)))
+    out_of_range_error_nr(sc, sc->float_vector_ref_symbol, int_two, index, (ind < 0) ? it_is_negative_string : it_is_too_large_string);
+  return(make_real(sc, float_vector(v, ind)));
+}
+
+static s7_pointer g_fv_ref_2(s7_scheme *sc, s7_pointer args) {return(float_vector_ref_p_pp(sc, car(args), cadr(args)));}
+
+static s7_pointer g_fv_ref_3(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer fv = car(args), index;
+  s7_int ind1, ind2;
+  if (!is_float_vector(fv))
+    return(method_or_bust(sc, fv, sc->float_vector_ref_symbol, args, sc->type_names[T_FLOAT_VECTOR], 1));
+  if (vector_rank(fv) != 2)
+    return(univect_ref(sc, args, sc->float_vector_ref_symbol, T_FLOAT_VECTOR));
+  index = cadr(args);
+  if (!s7_is_integer(index))
+    return(method_or_bust(sc, index, sc->float_vector_ref_symbol, args, sc->type_names[T_INTEGER], 2));
+  ind1 = s7_integer_clamped_if_gmp(sc, index);
+  if ((ind1 < 0) || (ind1 >= vector_dimension(fv, 0)))
+    out_of_range_error_nr(sc, sc->float_vector_ref_symbol, int_two, index, (ind1 < 0) ? it_is_negative_string : it_is_too_large_string);
+  index = caddr(args);
+  if (!s7_is_integer(index))
+    return(method_or_bust(sc, index, sc->float_vector_ref_symbol, args, sc->type_names[T_INTEGER], 3));
+  ind2 = s7_integer_clamped_if_gmp(sc, index);
+  if ((ind2 < 0) || (ind2 >= vector_dimension(fv, 1)))
+    out_of_range_error_nr(sc, sc->float_vector_ref_symbol, int_three, index, (ind2 < 0) ? it_is_negative_string : it_is_too_large_string);
+  ind1 = ind1 * vector_offset(fv, 0) + ind2;
+  return(make_real(sc, float_vector(fv, ind1)));
+}
+
+static inline s7_int ref_check_index(s7_scheme *sc, s7_pointer v, s7_int i)
+{
+  /* according to callgrind, it is faster to split out the bounds check */
+  if ((i < 0) || (i >= vector_length(v)))
+    out_of_range_error_nr(sc, sc->float_vector_ref_symbol, int_two, wrap_integer(sc, i), (i < 0) ? it_is_negative_string : it_is_too_large_string);
+  return(i);
+}
+
+static inline s7_double float_vector_ref_d_7pi(s7_scheme *sc, s7_pointer v, s7_int i) {return(float_vector(v, ref_check_index(sc, v, i)));}
+static double float_vector_ref_d_7pi_direct(s7_scheme *sc, s7_pointer v, s7_int i) {return(float_vector(v, i));}
+static s7_pointer float_vector_ref_p_pi_direct(s7_scheme *sc, s7_pointer v, s7_int i) {return(make_real(sc, float_vector(v, i)));}
+static s7_pointer float_vector_ref_p_pi_direct_wrapped(s7_scheme *sc, s7_pointer v, s7_int i) {return(wrap_real(sc, float_vector(v, i)));}
+
+static inline s7_double float_vector_ref_d_7pii(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2)
+{
+  if ((i1 < 0) || (i1 >= vector_dimension(v, 0)))
+    out_of_range_error_nr(sc, sc->float_vector_ref_symbol, int_two, wrap_integer(sc, i1), (i1 < 0) ? it_is_negative_string : it_is_too_large_string);
+  if ((i2 < 0) || (i2 >= vector_dimension(v, 1)))
+    out_of_range_error_nr(sc, sc->float_vector_ref_symbol, int_three, wrap_integer(sc, i2), (i2 < 0) ? it_is_negative_string : it_is_too_large_string);
+  return(float_vector(v, i2 + (i1 * vector_offset(v, 0))));
+}
+
+static s7_double float_vector_ref_d_7piii(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2, s7_int i3)
+{ /* uncallable? */
+  if ((i1 < 0) || (i1 >= vector_dimension(v, 0)))
+    out_of_range_error_nr(sc, sc->float_vector_ref_symbol, int_two, wrap_integer(sc, i1), (i1 < 0) ? it_is_negative_string : it_is_too_large_string);
+  if ((i2 < 0) || (i2 >= vector_dimension(v, 1)))
+    out_of_range_error_nr(sc, sc->float_vector_ref_symbol, int_three, wrap_integer(sc, i2), (i2 < 0) ? it_is_negative_string : it_is_too_large_string);
+  if ((i3 < 0) || (i3 >= vector_dimension(v, 2)))
+    out_of_range_error_nr(sc, sc->float_vector_ref_symbol, small_int(4), wrap_integer(sc, i3), (i3 < 0) ? it_is_negative_string : it_is_too_large_string);
+  return(float_vector(v, i3 + (i2 * vector_offset(v, 1)) + (i1 * vector_offset(v, 0))));
+}
+
+static s7_pointer float_vector_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer unused_expr)
+{
+  return((args == 2) ? sc->fv_ref_2 : ((args == 3) ? sc->fv_ref_3 : f));
+}
+
+
+/* -------------------------------- float-vector-set! -------------------------------- */
+static s7_pointer g_float_vector_set(s7_scheme *sc, s7_pointer args)
+{
+  #define H_float_vector_set "(float-vector-set! v i ... value) sets the i-th element of the float-vector v to value."
+  #define Q_float_vector_set s7_make_circular_signature(sc, 3, 4, \
+                               sc->is_real_symbol, sc->is_float_vector_symbol, sc->is_integer_symbol, sc->is_integer_or_real_at_end_symbol)
+  return(univect_set(sc, args, sc->float_vector_set_symbol, T_FLOAT_VECTOR));
+}
+
+static s7_pointer g_fv_set_3(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer fv = car(args), index, value;
+  s7_int ind;
+  if (!is_float_vector(fv))
+    return(method_or_bust(sc, fv, sc->float_vector_set_symbol, args, sc->type_names[T_FLOAT_VECTOR], 1));
+  if (vector_rank(fv) != 1)
+    return(univect_set(sc, args, sc->float_vector_set_symbol, T_FLOAT_VECTOR));
+  if (is_immutable_vector(fv))
+    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->float_vector_set_symbol, fv));
+  index = cadr(args);
+  if (!s7_is_integer(index))
+    return(method_or_bust(sc, index, sc->float_vector_set_symbol, args, sc->type_names[T_INTEGER], 2));
+  ind = s7_integer_clamped_if_gmp(sc, index);
+  if ((ind < 0) || (ind >= vector_length(fv)))
+    out_of_range_error_nr(sc, sc->float_vector_set_symbol, int_two, index, (ind < 0) ? it_is_negative_string : it_is_too_large_string);
+  value = caddr(args);
+  if (!is_real(value))
+    return(method_or_bust(sc, value, sc->float_vector_set_symbol, args, sc->type_names[T_REAL], 3));
+  float_vector(fv, ind) = s7_real(value);
+  return(value);
+}
+
+static s7_pointer g_fv_set_unchecked(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer fv, value = caddr(args);
+  s7_int ind;
+  if (!is_real(value))
+    wrong_type_error_nr(sc, sc->float_vector_set_symbol, 3, value, sc->type_names[T_REAL]);
+  fv = car(args);
+  if (is_immutable_vector(fv))
+    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->float_vector_set_symbol, fv));
+  ind = s7_integer_clamped_if_gmp(sc, cadr(args));
+  float_vector(fv, ind) = s7_real(value);
+  return(value);
+}
+
+static bool find_matching_ref(s7_scheme *sc, const s7_pointer getter, s7_pointer expr)
+{
+  /* expr: (*set! v i val), val exists (i.e. args=3, so cddddr is null) */
+  s7_pointer v = cadr(expr), ind = caddr(expr);
+  if ((is_symbol(v)) && (!is_pair(ind)))
+    {
+      s7_pointer val = cadddr(expr);
+      if (is_optimized(val)) /* includes is_pair */
+	for (s7_pointer p = val; is_pair(p); p = cdr(p))
+	  if (is_pair(car(p)))
+	    {
+	      s7_pointer ref = car(p);
+	      if (((car(ref) == getter) &&             /* (getter v ind) */
+		   (is_proper_list_2(sc, cdr(ref))) &&
+		   (cadr(ref) == v) &&
+		   (caddr(ref) == ind)) ||
+		  ((car(ref) == v) &&                  /* (v ind) */
+		   (is_proper_list_1(sc, cdr(ref))) &&
+		   (cadr(ref) == ind)))
+		return(true);
+	    }}
+  return(false);
+}
+
+static s7_pointer float_vector_set_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  if (args == 3)
+    return((find_matching_ref(sc, sc->float_vector_ref_symbol, expr)) ? sc->fv_set_unchecked : sc->fv_set_3);
+  return(f);
+}
+
+static s7_double float_vector_set_d_7pid_direct(s7_scheme *unused_sc, s7_pointer v, s7_int i, s7_double x) {float_vector(v, i) = x; return(x);}
+
+static s7_int set_check_index(s7_scheme *sc, s7_pointer v, s7_int i)
+{
+  if ((i < 0) || (i >= vector_length(v)))
+    out_of_range_error_nr(sc, sc->float_vector_set_symbol, int_two, wrap_integer(sc, i), (i < 0) ? it_is_negative_string : it_is_too_large_string);
+  return(i);
+}
+
+static s7_double float_vector_set_d_7pid(s7_scheme *sc, s7_pointer v, s7_int i, s7_double x) {float_vector(v, (set_check_index(sc, v, i))) = x; return(x);}
+
+static s7_double float_vector_set_d_7piid(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2, s7_double x)
+{
+  if ((i1 < 0) || (i1 >= vector_dimension(v, 0)))
+    out_of_range_error_nr(sc, sc->float_vector_set_symbol, int_two, wrap_integer(sc, i1), (i1 < 0) ? it_is_negative_string : it_is_too_large_string);
+  if ((i2 < 0) || (i2 >= vector_dimension(v, 1)))
+    out_of_range_error_nr(sc, sc->float_vector_set_symbol, int_three, wrap_integer(sc, i2), (i2 < 0) ? it_is_negative_string : it_is_too_large_string);
+  float_vector(v, i2 + (i1 * vector_offset(v, 0))) = x;
+  return(x);
+}
+
+static s7_double float_vector_set_d_7piiid(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2, s7_int i3, s7_double x)
+{ /* uncallable? */
+  if ((i1 < 0) || (i1 >= vector_dimension(v, 0)))
+    out_of_range_error_nr(sc, sc->float_vector_set_symbol, int_two, wrap_integer(sc, i1), (i1 < 0) ? it_is_negative_string : it_is_too_large_string);
+  if ((i2 < 0) || (i2 >= vector_dimension(v, 1)))
+    out_of_range_error_nr(sc, sc->float_vector_set_symbol, int_three, wrap_integer(sc, i2), (i2 < 0) ? it_is_negative_string : it_is_too_large_string);
+  if ((i3 < 0) || (i3 >= vector_dimension(v, 2)))
+    out_of_range_error_nr(sc, sc->float_vector_set_symbol, small_int(4), wrap_integer(sc, i3), (i3 < 0) ? it_is_negative_string : it_is_too_large_string);
+  float_vector(v, i3 + (i2 * vector_offset(v, 1)) + (i1 * vector_offset(v, 0))) = x;
+  return(x);
+}
+
+static s7_pointer float_vector_set_p_pip_direct(s7_scheme *sc, s7_pointer v, s7_int i, s7_pointer p)
+{
+  float_vector(v, i) = real_to_double(sc, p, "float-vector-set!");
+  return(p);
+}
+
+
+/* -------------------------------- int-vector-ref -------------------------------- */
+static s7_pointer g_int_vector_ref(s7_scheme *sc, s7_pointer args)
+{
+  #define H_int_vector_ref "(int-vector-ref v ...) returns an element of the int-vector v."
+  #define Q_int_vector_ref s7_make_circular_signature(sc, 2, 3, \
+                             s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_int_vector_symbol), \
+                             sc->is_int_vector_symbol, sc->is_integer_symbol)
+  return(univect_ref(sc, args, sc->int_vector_ref_symbol, T_INT_VECTOR));
+}
+
+static s7_int int_vector_ref_i_pi_direct(s7_scheme *unused_sc, s7_pointer v, s7_int i) {return(int_vector(v, i));}
+static s7_pointer int_vector_ref_p_pi_direct(s7_scheme *sc, s7_pointer v, s7_int i) {return(make_integer(sc, int_vector(v, i)));}
+static s7_pointer int_vector_ref_p_pi_direct_wrapped(s7_scheme *sc, s7_pointer v, s7_int i) {return(wrap_integer(sc, int_vector(v, i)));}
+
+static s7_int int_vector_ref_i_7pi(s7_scheme *sc, s7_pointer v, s7_int i)
+{
+  if ((i < 0) || (i >= vector_length(v)))
+    out_of_range_error_nr(sc, sc->int_vector_ref_symbol, int_two, wrap_integer(sc, i), (i < 0) ? it_is_negative_string : it_is_too_large_string);
+  return(int_vector(v, i));
+}
+
+static s7_int int_vector_ref_i_7pii(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2)
+{
+  if ((i1 < 0) || (i1 >= vector_dimension(v, 0)))
+    out_of_range_error_nr(sc, sc->int_vector_ref_symbol, int_two, wrap_integer(sc, i1), (i1 < 0) ? it_is_negative_string : it_is_too_large_string);
+  if ((i2 < 0) || (i2 >= vector_dimension(v, 1)))
+    out_of_range_error_nr(sc, sc->int_vector_ref_symbol, int_three, wrap_integer(sc, i2), (i2 < 0) ? it_is_negative_string : it_is_too_large_string);
+  return(int_vector(v, i2 + (i1 * vector_offset(v, 0))));
+}
+
+static s7_int int_vector_ref_i_7piii(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2, s7_int i3)
+{
+  if ((i1 < 0) || (i1 >= vector_dimension(v, 0)))
+    out_of_range_error_nr(sc, sc->int_vector_ref_symbol, int_two, wrap_integer(sc, i1), (i1 < 0) ? it_is_negative_string : it_is_too_large_string);
+  if ((i2 < 0) || (i2 >= vector_dimension(v, 1)))
+    out_of_range_error_nr(sc, sc->int_vector_ref_symbol, int_three, wrap_integer(sc, i2), (i2 < 0) ? it_is_negative_string : it_is_too_large_string);
+  if ((i3 < 0) || (i3 >= vector_dimension(v, 2)))
+    out_of_range_error_nr(sc, sc->int_vector_ref_symbol, small_int(4), wrap_integer(sc, i3), (i3 < 0) ? it_is_negative_string : it_is_too_large_string);
+  return(int_vector(v, i3 + (i2 * vector_offset(v, 1)) + (i1 * vector_offset(v, 0))));
+}
+
+static inline s7_pointer int_vector_ref_p_pp(s7_scheme *sc, s7_pointer v, s7_pointer index)
+{
+  s7_int ind;
+  if (!is_int_vector(v))
+    return(method_or_bust_pp(sc, v, sc->int_vector_ref_symbol, v, index, sc->type_names[T_INT_VECTOR], 1));
+  if (vector_rank(v) != 1)
+    return(univect_ref(sc, set_plist_2(sc, v, index), sc->int_vector_ref_symbol, T_INT_VECTOR));
+  if (!s7_is_integer(index))
+    return(method_or_bust_pp(sc, index, sc->int_vector_ref_symbol, v, index, sc->type_names[T_INTEGER], 2));
+  ind = s7_integer_clamped_if_gmp(sc, index);
+  if ((ind < 0) || (ind >= vector_length(v)))
+    out_of_range_error_nr(sc, sc->int_vector_ref_symbol, int_two, index, (ind < 0) ? it_is_negative_string : it_is_too_large_string);
+  return(make_integer(sc, int_vector(v, ind)));
+}
+
+static s7_pointer g_iv_ref_2(s7_scheme *sc, s7_pointer args) {return(int_vector_ref_p_pp(sc, car(args), cadr(args)));}
+
+static s7_pointer g_iv_ref_3(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer iv = car(args), index;
+  s7_int ind1, ind2;
+  if (!is_int_vector(iv))
+    return(method_or_bust(sc, iv, sc->int_vector_ref_symbol, args, sc->type_names[T_INT_VECTOR], 1));
+  if (vector_rank(iv) != 2)
+    return(univect_ref(sc, args, sc->int_vector_ref_symbol, T_INT_VECTOR));
+  index = cadr(args);
+  if (!s7_is_integer(index))
+    return(method_or_bust(sc, index, sc->int_vector_ref_symbol, args, sc->type_names[T_INTEGER], 2));
+  ind1 = s7_integer_clamped_if_gmp(sc, index);
+  if ((ind1 < 0) || (ind1 >= vector_dimension(iv, 0)))
+    out_of_range_error_nr(sc, sc->int_vector_ref_symbol, int_two, index, (ind1 < 0) ? it_is_negative_string : it_is_too_large_string);
+  index = caddr(args);
+  if (!s7_is_integer(index))
+    return(method_or_bust(sc, index, sc->int_vector_ref_symbol, args, sc->type_names[T_INTEGER], 3));
+  ind2 = s7_integer_clamped_if_gmp(sc, index);
+  if ((ind2 < 0) || (ind2 >= vector_dimension(iv, 1)))
+    out_of_range_error_nr(sc, sc->int_vector_ref_symbol, int_three, index, (ind2 < 0) ? it_is_negative_string : it_is_too_large_string);
+  ind1 = ind1 * vector_offset(iv, 0) + ind2;
+  return(make_integer(sc, int_vector(iv, ind1)));
+}
+
+static s7_pointer int_vector_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer unused_expr)
+{
+  return((args == 2) ? sc->iv_ref_2 : ((args == 3) ? sc->iv_ref_3 : f));
+}
+
+
+/* -------------------------------- int-vector-set! -------------------------------- */
+static s7_pointer g_int_vector_set(s7_scheme *sc, s7_pointer args)
+{
+  #define H_int_vector_set "(int-vector-set! v i ... value) sets the i-th element of the int-vector v to value."
+  #define Q_int_vector_set s7_make_circular_signature(sc, 2, 3, sc->is_integer_symbol, sc->is_int_vector_symbol, sc->is_integer_symbol)
+  return(univect_set(sc, args, sc->int_vector_set_symbol, T_INT_VECTOR));
+}
+
+static s7_int int_vector_set_i_7pii_direct(s7_scheme *unused_sc, s7_pointer v, s7_int i, s7_int x) {int_vector(v, i) = x; return(x);}
+
+static s7_pointer int_vector_set_p_pip_direct(s7_scheme *sc, s7_pointer v, s7_int i, s7_pointer p)
+{
+  int_vector(v, i) = s7_integer_clamped_if_gmp(sc, p);
+  return(p);
+}
+
+static s7_int int_vector_set_i_7pii(s7_scheme *sc, s7_pointer v, s7_int i, s7_int x)
+{
+  if ((i < 0) || (i >= vector_length(v)))
+    out_of_range_error_nr(sc, sc->int_vector_set_symbol, int_two, wrap_integer(sc, i), (i < 0) ? it_is_negative_string : it_is_too_large_string);
+  int_vector(v, i) = x;
+  return(x);
+}
+
+static s7_int int_vector_set_i_7piii(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2, s7_int i3)
+{
+  if ((i1 < 0) || (i1 >= vector_dimension(v, 0)))
+    out_of_range_error_nr(sc, sc->int_vector_set_symbol, int_two, wrap_integer(sc, i1), (i1 < 0) ? it_is_negative_string : it_is_too_large_string);
+  if ((i2 < 0) || (i2 >= vector_dimension(v, 1)))
+    out_of_range_error_nr(sc, sc->int_vector_set_symbol, int_three, wrap_integer(sc, i2), (i2 < 0) ? it_is_negative_string : it_is_too_large_string);
+  int_vector(v, i2 + (i1 * vector_offset(v, 0))) = i3;
+  return(i3);
+}
+
+static s7_pointer int_vector_set_p_ppp(s7_scheme *sc, s7_pointer v, s7_pointer index, s7_pointer val)
+{
+  if ((is_int_vector(v)) && (vector_rank(v) == 1) && (!is_immutable_vector(v)) &&
+      (is_t_integer(index)) && (is_t_integer(val)))
+    {
+      s7_int i = integer(index);
+      if ((i < 0) || (i >= vector_length(v)))
+	out_of_range_error_nr(sc, sc->int_vector_set_symbol, int_two, index, (i < 0) ? it_is_negative_string : it_is_too_large_string);
+      int_vector(v, i) = integer(val);
+    }
+  else
+    {
+      if (!is_int_vector(v))
+	return(method_or_bust_ppp(sc, v, sc->int_vector_set_symbol, v, index, val, sc->type_names[T_INT_VECTOR], 1));
+      if (vector_rank(v) != 1)
+	return(univect_set(sc, set_plist_3(sc, v, index, val), sc->int_vector_set_symbol, T_INT_VECTOR));
+      if (is_immutable_vector(v))
+	immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->int_vector_set_symbol, v));
+      /* (int-vector-set!  #i() `(x 1) (abs x)) in a do loop in a function... */
+      if (!s7_is_integer(index))
+	return(method_or_bust_ppp(sc, index, sc->int_vector_set_symbol, v, index, val, sc->type_names[T_INTEGER], 2));
+      if (!s7_is_integer(val))
+	return(method_or_bust_ppp(sc, val, sc->int_vector_set_symbol, v, index, val, sc->type_names[T_INTEGER], 3));
+#if WITH_GMP
+      {
+	s7_int i = s7_integer_clamped_if_gmp(sc, index);
+	if ((i < 0) || (i >= vector_length(v)))
+	  out_of_range_error_nr(sc, sc->int_vector_set_symbol, int_two, index, (i < 0) ? it_is_negative_string : it_is_too_large_string);
+	int_vector(v, i) = s7_integer_clamped_if_gmp(sc, val);
+      }
+#else
+      if (S7_DEBUGGING) fprintf(stderr, "fell through %s[%d]\n", __func__, __LINE__);
+#endif
+    }
+  return(val);
+}
+
+static s7_pointer g_iv_set_3(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer v = car(args), index, value;
+  s7_int ind;
+  if (!is_int_vector(v))
+    return(method_or_bust(sc, v, sc->int_vector_set_symbol, args, sc->type_names[T_INT_VECTOR], 1));
+  if (vector_rank(v) != 1)
+    return(univect_set(sc, args, sc->int_vector_set_symbol, T_INT_VECTOR));
+  if (is_immutable_vector(v))
+    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->int_vector_set_symbol, v));
+  index = cadr(args);
+  if (!s7_is_integer(index))
+    return(method_or_bust(sc, index, sc->int_vector_set_symbol, args, sc->type_names[T_INTEGER], 2));
+  ind = s7_integer_clamped_if_gmp(sc, index);
+  if ((ind < 0) || (ind >= vector_length(v)))
+    out_of_range_error_nr(sc, sc->int_vector_set_symbol, int_two, index, (ind < 0) ? it_is_negative_string : it_is_too_large_string);
+  value = caddr(args);
+  if (!s7_is_integer(value))
+    return(method_or_bust(sc, value, sc->int_vector_set_symbol, args, sc->type_names[T_INTEGER], 3));
+  int_vector(v, ind) = s7_integer_clamped_if_gmp(sc, value);
+  return(value);
+}
+
+static s7_pointer int_vector_set_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer unused_expr)
+{
+  return((args == 3) ? sc->iv_set_3 : f);
+}
+
+
+/* -------------------------------- byte-vector-ref -------------------------------- */
+static s7_pointer g_byte_vector_ref(s7_scheme *sc, s7_pointer args)
+{
+  #define H_byte_vector_ref "(byte-vector-ref vect index) returns the byte at the index-th element of the byte-vector vect"
+  #define Q_byte_vector_ref s7_make_circular_signature(sc, 2, 3, \
+                              s7_make_signature(sc, 2, sc->is_byte_symbol, sc->is_byte_vector_symbol), \
+                              sc->is_byte_vector_symbol, sc->is_integer_symbol)
+  return(univect_ref(sc, args, sc->byte_vector_ref_symbol, T_BYTE_VECTOR));
+}
+
+static s7_int byte_vector_ref_i_7pi(s7_scheme *sc, s7_pointer p1, s7_int i1)
+{
+  if ((i1 < 0) || (i1 >= byte_vector_length(p1)))
+    out_of_range_error_nr(sc, sc->byte_vector_ref_symbol, int_two, wrap_integer(sc, i1), (i1 < 0) ? it_is_negative_string : it_is_too_large_string);
+  return((s7_int)((byte_vector(p1, i1))));
+}
+
+static s7_int byte_vector_ref_i_7pii(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2)
+{
+  if ((i1 < 0) || (i1 >= vector_dimension(v, 0)))
+    out_of_range_error_nr(sc, sc->byte_vector_ref_symbol, int_two, wrap_integer(sc, i1), (i1 < 0) ? it_is_negative_string : it_is_too_large_string);
+  if ((i2 < 0) || (i2 >= vector_dimension(v, 1)))
+    out_of_range_error_nr(sc, sc->byte_vector_ref_symbol, int_three, wrap_integer(sc, i2), (i2 < 0) ? it_is_negative_string : it_is_too_large_string);
+  return((s7_int)byte_vector(v, i2 + (i1 * vector_offset(v, 0))));
+}
+
+static s7_pointer byte_vector_ref_p_pi_direct(s7_scheme *unused_sc, s7_pointer p1, s7_int i1) {return(small_int((byte_vector(p1, i1))));}
+static s7_int byte_vector_ref_i_7pi_direct(s7_scheme *unused_sc, s7_pointer p1, s7_int i1)    {return(byte_vector(p1, i1));}
+
+static s7_pointer g_bv_ref_2(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer v = car(args), index;
+  s7_int ind;
+  if (!is_byte_vector(v))
+    return(method_or_bust(sc, v, sc->byte_vector_ref_symbol, args, sc->type_names[T_BYTE_VECTOR], 1));
+  if (vector_rank(v) != 1)
+    return(univect_ref(sc, args, sc->byte_vector_ref_symbol, T_BYTE_VECTOR));
+  index = cadr(args);
+  if (!s7_is_integer(index))
+    return(method_or_bust(sc, index, sc->byte_vector_ref_symbol, args, sc->type_names[T_INTEGER], 2));
+  ind = s7_integer_clamped_if_gmp(sc, index);
+  if ((ind < 0) || (ind >= vector_length(v)))
+    out_of_range_error_nr(sc, sc->byte_vector_ref_symbol, int_two, index, (ind < 0) ? it_is_negative_string : it_is_too_large_string);
+  return(small_int(byte_vector(v, ind)));
+}
+
+static s7_pointer g_bv_ref_3(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer iv = car(args), index;
+  s7_int ind1, ind2;
+  if (!is_byte_vector(iv))
+    return(method_or_bust(sc, iv, sc->byte_vector_ref_symbol, args, sc->type_names[T_BYTE_VECTOR], 1));
+  if (vector_rank(iv) != 2)
+    return(univect_ref(sc, args, sc->byte_vector_ref_symbol, T_BYTE_VECTOR));
+  index = cadr(args);
+  if (!s7_is_integer(index))
+    return(method_or_bust(sc, index, sc->byte_vector_ref_symbol, args, sc->type_names[T_INTEGER], 2));
+  ind1 = s7_integer_clamped_if_gmp(sc, index);
+  if ((ind1 < 0) || (ind1 >= vector_dimension(iv, 0)))
+    out_of_range_error_nr(sc, sc->byte_vector_ref_symbol, int_two, index, (ind1 < 0) ? it_is_negative_string : it_is_too_large_string);
+  index = caddr(args);
+  if (!s7_is_integer(index))
+    return(method_or_bust(sc, index, sc->byte_vector_ref_symbol, args, sc->type_names[T_INTEGER], 3));
+  ind2 = s7_integer_clamped_if_gmp(sc, index);
+  if ((ind2 < 0) || (ind2 >= vector_dimension(iv, 1)))
+    out_of_range_error_nr(sc, sc->byte_vector_ref_symbol, int_three, index, (ind2 < 0) ? it_is_negative_string : it_is_too_large_string);
+  ind1 = ind1 * vector_offset(iv, 0) + ind2;
+  return(small_int(byte_vector(iv, ind1)));
+}
+
+static s7_pointer byte_vector_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer unused_expr)
+{
+  return((args == 2) ? sc->bv_ref_2 : ((args == 3) ? sc->bv_ref_3 : f));
+}
+
+
+/* -------------------------------- byte-vector-set -------------------------------- */
+static s7_pointer g_byte_vector_set(s7_scheme *sc, s7_pointer args)
+{
+  #define H_byte_vector_set "(byte-vector-set! vect index byte) sets the index-th element of the byte-vector vect to the integer byte"
+  #define Q_byte_vector_set s7_make_circular_signature(sc, 2, 3, sc->is_byte_symbol, sc->is_byte_vector_symbol, sc->is_integer_symbol)
+  return(univect_set(sc, args, sc->byte_vector_set_symbol, T_BYTE_VECTOR));
+}
+
+static s7_int byte_vector_set_i_7pii(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_int i2)
+{
+  if (!is_byte_vector(p1))
+    wrong_type_error_nr(sc, sc->byte_vector_set_symbol, 1, p1, a_byte_vector_string);
+  if ((i2 < 0) || (i2 > 255))
+    wrong_type_error_nr(sc, sc->byte_vector_set_symbol, 3, wrap_integer(sc, i2), an_unsigned_byte_string);
+  if ((i1 < 0) || (i1 >= byte_vector_length(p1)))
+    out_of_range_error_nr(sc, sc->byte_vector_set_symbol, int_two, wrap_integer(sc, i1), (i1 < 0) ? it_is_negative_string : it_is_too_large_string);
+  byte_vector(p1, i1) = (uint8_t)i2;
+  return(i2);
+}
+
+static s7_int byte_vector_set_i_7pii_direct(s7_scheme *unused_sc, s7_pointer p1, s7_int i1, s7_int i2)
+{
+  byte_vector(p1, i1) = (uint8_t)i2; return(i2);
+}
+
+static s7_pointer byte_vector_set_p_pip_direct(s7_scheme *unused_sc, s7_pointer p1, s7_int i1, s7_pointer p2)
+{ /* uncallable */
+  byte_vector(p1, i1) = (uint8_t)s7_integer(p2); return(p2);
+}
+
+static s7_int byte_vector_set_i_7piii(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2, s7_int i3)
+{
+  if ((i3 < 0) || (i3 > 255))
+    wrong_type_error_nr(sc, sc->byte_vector_set_symbol, 4, wrap_integer(sc, i3), an_unsigned_byte_string);
+  if ((i1 < 0) || (i1 >= vector_dimension(v, 0)))
+    out_of_range_error_nr(sc, sc->int_vector_set_symbol, int_two, wrap_integer(sc, i1), (i1 < 0) ? it_is_negative_string : it_is_too_large_string);
+  if ((i2 < 0) || (i2 >= vector_dimension(v, 1)))
+    out_of_range_error_nr(sc, sc->int_vector_set_symbol, int_three, wrap_integer(sc, i2), (i2 < 0) ? it_is_negative_string : it_is_too_large_string);
+  byte_vector(v, i2 + (i1 * vector_offset(v, 0))) = i3;
+  return(i3);
+}
+
+static s7_pointer g_bv_set_3(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer v = car(args), index, value;
+  s7_int ind, uval;
+  if (!is_byte_vector(v))
+    return(method_or_bust(sc, v, sc->byte_vector_set_symbol, args, sc->type_names[T_BYTE_VECTOR], 1));
+  if (vector_rank(v) != 1)
+    return(univect_set(sc, args, sc->byte_vector_set_symbol, T_BYTE_VECTOR));
+  if (is_immutable_vector(v))
+    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->byte_vector_set_symbol, v));
+  index = cadr(args);
+  if (!s7_is_integer(index))
+    return(method_or_bust(sc, index, sc->byte_vector_set_symbol, args, sc->type_names[T_INTEGER], 2));
+  ind = s7_integer_clamped_if_gmp(sc, index);
+  if ((ind < 0) || (ind >= vector_length(v)))
+    out_of_range_error_nr(sc, sc->byte_vector_set_symbol, int_two, index, (ind < 0) ? it_is_negative_string : it_is_too_large_string);
+  value = caddr(args);
+  if (!s7_is_integer(value))
+    return(method_or_bust(sc, value, sc->byte_vector_set_symbol, args, sc->type_names[T_INTEGER], 3));
+  uval = s7_integer_clamped_if_gmp(sc, value);
+  if ((uval < 0) || (uval > 255))
+    wrong_type_error_nr(sc, sc->byte_vector_set_symbol, 3, value, an_unsigned_byte_string);
+  byte_vector(v, ind) = (uint8_t)uval;
+  return(value);
+}
+
+static s7_pointer byte_vector_set_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer unused_expr)
+{
+  return((args == 3) ? sc->bv_set_3 : f);
+}
+
+
+/* -------------------------------------------------------------------------------- */
+static bool c_function_is_ok(s7_scheme *sc, s7_pointer x)
+{
+  s7_pointer p = lookup_unexamined(sc, car(x)); /* lookup_global is usually slower (faster in Snd) */
+  if ((p == opt1_cfunc(x)) ||
+      ((p) && (is_any_c_function(p)) && (c_function_class(p) == c_function_class(opt1_cfunc(x))) && (set_opt1_cfunc(x, p))))
+    return(true);
+  sc->last_function = p;
+  return(false);
+}
+
+static bool cl_function_is_ok(s7_scheme *sc, s7_pointer x)
+{
+  sc->last_function = lookup_unexamined(sc, car(x));
+  return(sc->last_function == opt1_cfunc(x));
+}
+
+static bool arglist_has_rest(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer p;
+  for (p = args; is_pair(p); p = cdr(p))
+    if (car(p) == sc->rest_keyword)
+      return(true);
+  return(!is_null(p));
+}
+
+
+/* -------------------------------- sort! -------------------------------- */
+static int32_t dbl_less(const void *f1, const void *f2)
+{
+  if ((*((const s7_double *)f1)) < (*((const s7_double *)f2))) return(-1);
+  return(((*((const s7_double *)f1)) > (*((const s7_double *)f2))) ? 1 : 0);
+}
+
+static int32_t int_less(const void *f1, const void *f2)
+{
+  if ((*((const s7_int *)f1)) < (*((const s7_int *)f2))) return(-1);
+  return(((*((const s7_int *)f1)) > (*((const s7_int *)f2))) ? 1 : 0);
+}
+
+static int32_t dbl_greater(const void *f1, const void *f2) {return(-dbl_less(f1, f2));}
+static int32_t int_greater(const void *f1, const void *f2) {return(-int_less(f1, f2));}
+
+static int32_t byte_less(const void *f1, const void *f2)
+{
+  if ((*((const uint8_t *)f1)) < (*((const uint8_t *)f2))) return(-1);
+  return(((*((const uint8_t *)f1)) > (*((const uint8_t *)f2))) ? 1 : 0);
+}
+
+static int32_t byte_greater(const void *f1, const void *f2) {return(-byte_less(f1, f2));}
+
+static int32_t dbl_less_2(const void *f1, const void *f2)
+{
+  s7_double p1 = real(*((const s7_pointer *)f1));
+  s7_double p2 = real(*((const s7_pointer *)f2));
+  if (p1 < p2) return(-1);
+  return((p1 > p2) ? 1 : 0);
+}
+
+static int32_t int_less_2(const void *f1, const void *f2)
+{
+  s7_int p1 = integer(*((const s7_pointer *)f1));
+  s7_int p2 = integer(*((const s7_pointer *)f2));
+  if (p1 < p2) return(-1);
+  return((p1 > p2) ? 1 : 0);
+}
+
+static int32_t dbl_greater_2(const void *f1, const void *f2) {return(-dbl_less_2(f1, f2));}
+static int32_t int_greater_2(const void *f1, const void *f2) {return(-int_less_2(f1, f2));}
+
+static int32_t str_less_2(const void *f1, const void *f2)
+{
+  s7_pointer p1 = (*((const s7_pointer *)f1));
+  s7_pointer p2 = (*((const s7_pointer *)f2));
+  return(scheme_strcmp(p1, p2));
+}
+
+static int32_t str_greater_2(const void *f1, const void *f2) {return(-str_less_2(f1, f2));}
+
+static int32_t chr_less_2(const void *f1, const void *f2)
+{
+  uint8_t p1 = character(*((const s7_pointer *)f1));
+  uint8_t p2 = character(*((const s7_pointer *)f2));
+  if (p1 < p2) return(-1);
+  return((p1 > p2) ? 1 : 0);
+}
+
+static int32_t chr_greater_2(const void *f1, const void *f2) {return(-chr_less_2(f1, f2));}
+
+#if MS_WINDOWS || defined(__APPLE__) || defined(__FreeBSD__)
+struct sort_r_data {void *arg; int32_t (*compar)(const void *a1, const void *a2, void *aarg);};
+
+static int32_t sort_r_arg_swap(void *s, const void *aa, const void *bb)
+{
+  struct sort_r_data *ss = (struct sort_r_data*)s;
+  return (ss->compar)(aa, bb, ss->arg);
+}
+#endif
+
+/* qsort_r in Linux requires _GNU_SOURCE and is different from q_sort_r in FreeBSD, neither matches qsort_s in Windows
+ *   this code tested only in Linux and the mac -- my virtualbox freebsd died, netbsd and openbsd run using fallback code.
+ *
+ *   qsort_r allocates an internal array (msort.c line 221) if the original array is > 1024 elements (or whatever),
+ *   then calls the sort comparison function in a loop, after which it frees its temporary array.  This is an unavoidable
+ *   memory leak if the comparison function calls s7_error (or its equivalent) which longjmps to the nearest catch
+ *   (or, sigh, segfaults if none exists).  I can't see any way to hack around this memory leak -- don't raise
+ *   an error in the sort function!
+ */
+static void local_qsort_r(void *base, size_t nmemb, size_t size, int32_t (*compar)(const void *, const void *, void *), void *arg)
+{
+#if (defined(__linux__)) && (defined(__GLIBC__)) /* __GLIBC__ because musl does not have qsort_r and has no way to detect it */
+  qsort_r(base, nmemb, size, compar, arg);
+#else
+#if defined(__APPLE__) || defined(__FreeBSD__) /* not in OpenBSD or NetBSD as far as I can tell */
+  struct sort_r_data tmp = {arg, compar};
+  qsort_r(base, nmemb, size, &tmp, &sort_r_arg_swap);
+#else
+#if MS_WINDOWS
+  struct sort_r_data tmp = {arg, compar};
+  qsort_s(base, nmemb, size, sort_r_arg_swap, &tmp);
+#else
+    /* from the Net somewhere, by "Pete", about 25 times slower than libc's qsort_r in this context */
+  if (nmemb > 1)
+    {
+      uint8_t *array = (uint8_t *)base;
+      uint8_t *after = (uint8_t *)(nmemb * size + array);
+      size_t h, t;
+      nmemb /= 4;
+      h = nmemb + 1;
+      for (t = 1; nmemb != 0; nmemb /= 4)
+	t *= 2;
+      do {
+	size_t bytes = h * size;
+	uint8_t *i = (uint8_t *)(array + bytes);
+	uint8_t *k;
+	do {
+	  uint8_t *j = (uint8_t *)(i - bytes);
+	  if (compar(j, i, arg) > 0)
+	    {
+	      k = i;
+	      do {
+		uint8_t *p1 = j, *p2 = k;
+		uint8_t *end = (uint8_t *)(p2 + size);
+		do {
+		  uint8_t swap = *p1;
+		  *p1++ = *p2;
+		  *p2++ = swap;
+		} while (p2 != end);
+		if (bytes + array > j)
+		  break;
+		k = j;
+		j -= bytes;
+	      } while (compar(j, k, arg) > 0);
+	    }
+	  i += size;
+	} while (i != after);
+	t /= 2;
+	h = t * t - t * 3 / 2 + 1;
+      } while (t != 0);
+    }
+#endif
+#endif
+#endif
+}
+
+static int32_t vector_sort(const void *v1, const void *v2, void *arg)
+{
+  s7_scheme *sc = (s7_scheme *)arg;
+  return(((*(sc->sort_f))(sc, (*(const s7_pointer *)v1), (*(const s7_pointer *)v2))) ? -1 : 1);
+}
+
+static int32_t vector_sort_lt(const void *v1, const void *v2, void *arg) /* for qsort_r */
+{
+  s7_pointer s1 = (*(const s7_pointer *)v1);
+  s7_pointer s2 = (*(const s7_pointer *)v2);
+  if ((is_t_integer(s1)) && (is_t_integer(s2)))
+    return((integer(s1) < integer(s2)) ? -1 : 1);
+  return((lt_b_7pp((s7_scheme *)arg, s1, s2)) ? -1 : 1);
+}
+
+static int32_t vector_car_sort(const void *v1, const void *v2, void *arg)
+{
+  s7_scheme *sc = (s7_scheme *)arg;
+  s7_pointer a = (*(const s7_pointer *)v1);
+  s7_pointer b = (*(const s7_pointer *)v2);
+  a = (is_pair(a)) ? car(a) : g_car(sc, set_plist_1(sc, a));
+  b = (is_pair(b)) ? car(b) : g_car(sc, set_plist_1(sc, b));
+  return(((*(sc->sort_f))(sc, a, b)) ? -1 : 1);
+}
+
+static int32_t vector_cdr_sort(const void *v1, const void *v2, void *arg)
+{
+  s7_scheme *sc = (s7_scheme *)arg;
+  s7_pointer a = (*(const s7_pointer *)v1);
+  s7_pointer b = (*(const s7_pointer *)v2);
+  a = (is_pair(a)) ? cdr(a) : g_cdr(sc, set_plist_1(sc, a));
+  b = (is_pair(b)) ? cdr(b) : g_cdr(sc, set_plist_1(sc, b));
+  return(((*(sc->sort_f))(sc, a, b)) ? -1 : 1);
+}
+
+static int32_t opt_bool_sort(const void *v1, const void *v2, void *arg)
+{
+  s7_scheme *sc = (s7_scheme *)arg;
+  slot_set_value(sc->sort_v1, (*(const s7_pointer *)v1)); /* first slot in curlet */
+  slot_set_value(sc->sort_v2, (*(const s7_pointer *)v2)); /* second slot in curlet */
+  return((sc->sort_fb(sc->sort_o)) ? -1 : 1);
+}
+
+static int32_t opt_bool_sort_0(const void *v1, const void *v2, void *arg)
+{
+  s7_scheme *sc = (s7_scheme *)arg;
+  slot_set_value(sc->sort_v1, (*(const s7_pointer *)v1)); /* first slot in curlet */
+  slot_set_value(sc->sort_v2, (*(const s7_pointer *)v2)); /* second slot in curlet */
+  return((sc->sort_fb(sc->sort_o)) ? -1 : 1);
+}
+
+static int32_t opt_bool_sort_p(const void *v1, const void *v2, void *arg)
+{
+  s7_scheme *sc = (s7_scheme *)arg;
+  slot_set_value(sc->sort_v1, (*(const s7_pointer *)v1));
+  slot_set_value(sc->sort_v2, (*(const s7_pointer *)v2));
+  return((sc->opts[0]->v[O_WRAP].fp(sc->opts[0]) == sc->F) ? 1 : -1);
+}
+
+#define SORT_O1 1
+static inline int32_t begin_bool_sort_bp(s7_scheme *sc, const void *v1, const void *v2, bool int_expr)
+{
+  s7_int i;
+  opt_info *top = sc->opts[0], *o;
+  slot_set_value(sc->sort_v1, (*(const s7_pointer *)v1));
+  slot_set_value(sc->sort_v2, (*(const s7_pointer *)v2));
+  for (i = 0; i < sc->sort_body_len - 1; i++)
+    {
+      o = top->v[SORT_O1 + i].o1;
+      o->v[0].fp(o);
+    }
+  o = top->v[SORT_O1 + i].o1;
+  if (int_expr)
+    return((o->v[0].fb(o)) ? -1 : 1);
+  return((o->v[0].fp(o) != sc->F) ? -1 : 1);
+}
+
+static int32_t opt_begin_bool_sort_b(const void *v1, const void *v2, void *arg) {return(begin_bool_sort_bp((s7_scheme *)arg, v1, v2, true));}
+static int32_t opt_begin_bool_sort_p(const void *v1, const void *v2, void *arg) {return(begin_bool_sort_bp((s7_scheme *)arg, v1, v2, false));}
+
+static int32_t opt_begin_bool_sort_b2(const void *v1, const void *v2, void *arg)
+{
+  s7_scheme *sc = (s7_scheme *)arg;
+  opt_info *top = sc->opts[0], *o;
+  slot_set_value(sc->sort_v1, (*(const s7_pointer *)v1));
+  slot_set_value(sc->sort_v2, (*(const s7_pointer *)v2));
+  o = top->v[SORT_O1].o1;
+  o->v[0].fp(o);
+  o = top->v[SORT_O1 + 1].o1;
+  return((o->v[0].fb(o)) ? -1 : 1);
+}
+
+static int32_t closure_sort(const void *v1, const void *v2, void *arg)
+{
+  s7_scheme *sc = (s7_scheme *)arg;
+  slot_set_value(sc->sort_v1, (*(const s7_pointer *)v1));
+  slot_set_value(sc->sort_v2, (*(const s7_pointer *)v2));
+  push_stack(sc, OP_EVAL_DONE, sc->sort_body, sc->code);
+  sc->code = sc->sort_body; /* this should be ok because we checked in advance that it is a safe closure (no sort! for example) */
+  eval(sc, sc->sort_op);
+  return((sc->value != sc->F) ? -1 : 1);
+}
+
+static int32_t closure_sort_begin(const void *v1, const void *v2, void *arg)
+{
+  s7_scheme *sc = (s7_scheme *)arg;
+  slot_set_value(sc->sort_v1, (*(const s7_pointer *)v1));
+  slot_set_value(sc->sort_v2, (*(const s7_pointer *)v2));
+  push_stack(sc, OP_EVAL_DONE, sc->sort_body, sc->code);
+  push_stack_no_args(sc, OP_BEGIN_NO_HOOK, T_Pair(sc->sort_begin));
+  sc->code = sc->sort_body;
+  eval(sc, sc->sort_op);
+  return((sc->value != sc->F) ? -1 : 1);
+}
+
+static s7_b_7pp_t s7_b_7pp_function(s7_pointer f);
+static opt_info *alloc_opt_info(s7_scheme *sc);
+static bool bool_optimize(s7_scheme *sc, s7_pointer expr);
+static bool bool_optimize_nw(s7_scheme *sc, s7_pointer expr);
+static bool cell_optimize(s7_scheme *sc, s7_pointer expr);
+
+static s7_pointer g_sort(s7_scheme *sc, s7_pointer args)
+{
+  #define H_sort "(sort! sequence less?) sorts a sequence using the function 'less?' to compare elements."
+  #define Q_sort s7_make_signature(sc, 3, sc->is_sequence_symbol, sc->is_sequence_symbol, sc->is_procedure_symbol)
+
+  s7_pointer data = car(args), lessp, lx;
+  s7_int len = 0, n, k;
+  int32_t (*sort_func)(const void *v1, const void *v2, void *arg);
+  s7_pointer *elements;
+
+  /* both the intermediate vector (if any) and the current args pointer need GC protection,
+   *   but it is a real bother to unprotect args at every return statement, so I'll use temp3
+   */
+  sc->temp3 = args; /* this is needed but maybe insufficient... if sort is semisafe, we should protect the args, not the list: use OP_GC_PROTECT? */
+  if (is_null(data))
+    {
+      /* (apply sort! () #f) should be an error I think */
+      lessp = cadr(args);
+      if (type(lessp) < T_CONTINUATION)
+	return(method_or_bust(sc, lessp, sc->sort_symbol, args, a_procedure_string, 2));
+      if (!s7_is_aritable(sc, lessp, 2))
+	wrong_type_error_nr(sc, sc->sort_symbol, 2, lessp, an_eq_func_string);
+      return(sc->nil);
+    }
+
+  if (!is_sequence(data)) /* precede immutable because #f (for example) is immutable: "can't sort #f because it is immutable" is a joke */
+    wrong_type_error_nr(sc, sc->sort_symbol, 1, data, a_sequence_string);
+  if (is_immutable(data))
+    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->sort_symbol, data));
+
+  lessp = cadr(args);
+  if (type(lessp) <= T_GOTO)
+    wrong_type_error_nr(sc, sc->sort_symbol, 2, lessp, a_normal_procedure_string);
+  if (!s7_is_aritable(sc, lessp, 2))
+    wrong_type_error_nr(sc, sc->sort_symbol, 2, lessp, an_eq_func_string);
+  if ((is_any_macro(lessp)) && (!is_c_macro(lessp))) clear_all_optimizations(sc, closure_body(lessp));
+
+  sort_func = NULL;
+  sc->sort_f = NULL;
+
+  if (is_safe_c_function(lessp))    /* (sort! a <) */
+    {
+      s7_pointer sig = c_function_signature(lessp);
+      if ((sig) &&
+	  (is_pair(sig)) &&
+	  (car(sig) != sc->is_boolean_symbol))
+	wrong_type_error_nr(sc, sc->sort_symbol, 2, lessp,
+					     wrap_string(sc, "sort! function should return a boolean", 38));
+      sc->sort_f = s7_b_7pp_function(lessp);
+      if (sc->sort_f) sort_func = (sc->sort_f == lt_b_7pp) ? vector_sort_lt : vector_sort;
+    }
+  else
+    {
+      if (is_closure(lessp))
+	{
+	  s7_pointer expr = car(closure_body(lessp));
+	  s7_pointer largs = closure_args(lessp);
+
+	  if ((is_pair(largs)) &&       /* closure args not a symbol, etc */
+	      (!arglist_has_rest(sc, largs)))
+	    {
+	      if ((is_null(cdr(closure_body(lessp)))) &&
+		  (is_optimized(expr)) &&
+		  (is_safe_c_op(optimize_op(expr))) &&
+		  /* since (sort seq (lambda (a b) ...)) can't return a "safe closure" (the hop bit is off in
+		   *   optimize in this case, for some arcane reason), the optimized expression won't be hop_safe,
+		   *   but that is irrelevant at this point -- if c_function_is_ok, we're good to go.
+		   */
+		  ((op_has_hop(expr)) ||
+		   ((is_global(car(expr))) &&            /* (sort! x (lambda (car y) (car x)...))! */
+		    (c_function_is_ok(sc, expr)))))
+		{
+		  int32_t orig_data = optimize_op(expr);
+		  set_optimize_op(expr, optimize_op(expr) | 1);
+		  if ((optimize_op(expr) == HOP_SAFE_C_SS) &&
+		      (car(largs) == cadr(expr)) &&
+		      (cadr(largs) == caddr(expr)))
+		    {
+		      s7_pointer lp = lookup(sc, car(expr));
+		      sc->sort_f = s7_b_7pp_function(lp);
+		      if (sc->sort_f)
+			{
+			  sort_func = (sc->sort_f == lt_b_7pp) ? vector_sort_lt : vector_sort;
+			  lessp = lp;
+			}}
+		  else
+		    if ((optimize_op(expr) == HOP_SAFE_C_opSq_opSq) &&
+			((caadr(expr) == sc->car_symbol) || (caadr(expr) == sc->cdr_symbol)) &&
+			(caadr(expr) == caaddr(expr)) &&
+			(car(largs) == cadadr(expr)) &&
+			(cadr(largs) == cadaddr(expr)))
+		      {
+			s7_pointer lp = lookup(sc, car(expr));
+			sc->sort_f = s7_b_7pp_function(lp);
+			if (sc->sort_f)
+			  {
+			    sort_func = ((caadr(expr) == sc->car_symbol) ? vector_car_sort : vector_cdr_sort);
+			    lessp = lp;
+			  }}
+		  set_optimize_op(expr, orig_data);
+		}
+
+	      if (!sort_func)
+		{
+		  s7_pointer init_val, old_e = sc->curlet;
+		  if (is_float_vector(data))
+		    init_val = real_zero;
+		  else init_val = ((is_int_vector(data)) || (is_byte_vector(data))) ? int_zero : sc->F;
+		  set_curlet(sc, inline_make_let_with_two_slots(sc, closure_let(lessp), car(largs), init_val, cadr(largs), init_val));
+		  sc->sort_body = expr;
+		  sc->sort_v1 = let_slots(sc->curlet);
+		  sc->sort_v2 = next_slot(let_slots(sc->curlet));
+		  if (is_null(cdr(closure_body(lessp))))
+		    {
+		      if (!no_bool_opt(closure_body(lessp)))
+			{
+			  s7_pfunc sf1 = s7_bool_optimize(sc, closure_body(lessp));
+			  if (sf1)
+			    {
+			      if (sc->opts[0]->v[0].fb == p_to_b)
+				sort_func = opt_bool_sort_p;
+			      else
+				{
+				  sc->sort_o = sc->opts[0];
+				  sc->sort_fb = sc->sort_o->v[0].fb;
+				  sort_func = (sc->pc == 1) ? opt_bool_sort_0 : opt_bool_sort;
+				}}
+			  else set_no_bool_opt(closure_body(lessp));
+			}}
+		  else
+		    {
+		      sc->sort_body_len = s7_list_length(sc, closure_body(lessp));
+		      if (sc->sort_body_len < (NUM_VUNIONS - SORT_O1))
+			{
+			  s7_pointer p;
+			  int32_t ctr;
+			  opt_info *top;
+			  sc->pc = 0;
+			  top = alloc_opt_info(sc);
+			  for (ctr = SORT_O1, p = closure_body(lessp); is_pair(cdr(p)); ctr++, p = cdr(p))
+			    {
+			      top->v[ctr].o1 = sc->opts[sc->pc];
+			      if (!cell_optimize(sc, p))
+				break;
+			    }
+			  if (is_null(cdr(p)))
+			    {
+			      int32_t start = sc->pc;
+			      top->v[ctr].o1 = sc->opts[start];
+			      if (bool_optimize_nw(sc, p))
+				sort_func = (sc->sort_body_len == 2) ? opt_begin_bool_sort_b2 : opt_begin_bool_sort_b;
+			      else
+				{
+				  sc->pc = start;
+				  if (cell_optimize(sc, p))
+				    sort_func = opt_begin_bool_sort_p;
+				}}}}
+		  if (!sort_func)
+		    set_curlet(sc, old_e);
+		}
+	      if ((!sort_func) &&
+		  (is_safe_closure(lessp))) /* no embedded sort! or call/cc, etc */
+		{
+		  set_curlet(sc, make_let_with_two_slots(sc, closure_let(lessp), car(largs), sc->F, cadr(largs), sc->F));
+		  sc->sort_body = car(closure_body(lessp));
+		  sc->sort_begin = cdr(closure_body(lessp));
+		  sort_func = (is_null(sc->sort_begin)) ? closure_sort : closure_sort_begin;
+		  sc->sort_op = (is_syntactic_pair(sc->sort_body)) ? (opcode_t)optimize_op(sc->sort_body) : (opcode_t)OP_EVAL;
+		  sc->sort_v1 = let_slots(sc->curlet);
+		  sc->sort_v2 = next_slot(let_slots(sc->curlet));
+		}}}}
+
+  switch (type(data))
+    {
+    case T_PAIR:
+      len = s7_list_length(sc, data);            /* 0 here == infinite */
+      if (len <= 0)
+	error_nr(sc, sc->wrong_type_arg_symbol,
+		 set_elist_2(sc, wrap_string(sc, "sort! first argument should be a proper list: ~S", 48), data));
+      if (len < 2)
+	return(data);
+      if (sort_func)
+	{
+	  s7_int i = 0;
+	  s7_pointer vec = g_vector(sc, data);
+	  gc_protect_2_via_stack(sc, vec, data);
+	  elements = s7_vector_elements(vec);
+	  local_qsort_r((void *)elements, len, sizeof(s7_pointer), sort_func, (void *)sc);
+	  for (s7_pointer p = data; i < len; i++, p = cdr(p))
+	    {
+	      if (is_immutable_pair(p))
+		immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->sort_symbol, data));
+	      set_car(p, elements[i]);
+	    }
+	  unstack_gc_protect(sc); /* not pop_stack! */
+	  return(data);
+	}
+      push_stack(sc, OP_SORT_PAIR_END, cons(sc, data, lessp), sc->code); /* save and gc protect the original list and func */
+      set_car(args, g_vector(sc, data));
+      break;
+
+    case T_BYTE_VECTOR:
+    case T_STRING:
+      {
+	s7_int i;
+	s7_pointer vec;
+	uint8_t *chrs;
+	if (is_string(data))
+	  {
+	    len = string_length(data);
+	    chrs = (uint8_t *)string_value(data);
+	  }
+	else
+	  {
+	    len = byte_vector_length(data);
+	    chrs = byte_vector_bytes(data);
+	  }
+	if (len < 2) return(data);
+	if (is_c_function(lessp))
+	  {
+	    if (((is_string(data)) && (sc->sort_f == char_lt_b_7pp)) ||
+		((is_byte_vector(data)) && (sc->sort_f == lt_b_7pp)))
+	      {
+		qsort((void *)chrs, len, sizeof(uint8_t), byte_less);
+		return(data);
+	      }
+	    if (((is_string(data)) && (sc->sort_f == char_gt_b_7pp)) ||
+		((is_byte_vector(data)) && (sc->sort_f == gt_b_7pp)))
+	      {
+		qsort((void *)chrs, len, sizeof(uint8_t), byte_greater);
+		return(data);
+	      }}
+	vec = make_simple_vector(sc, len);
+	gc_protect_2_via_stack(sc, vec, data);
+	elements = s7_vector_elements(vec);
+	if (is_byte_vector(data))
+	  for (i = 0; i < len; i++) elements[i] = small_int(chrs[i]);
+	else for (i = 0; i < len; i++) elements[i] = chars[chrs[i]];
+	if (sort_func)
+	  {
+	    local_qsort_r((void *)elements, len, sizeof(s7_pointer), sort_func, (void *)sc);
+	    if (is_byte_vector(data))
+	      for (i = 0; i < len; i++)	chrs[i] = (char)integer(elements[i]);
+	    else for (i = 0; i < len; i++) chrs[i] = character(elements[i]);
+	    unstack_gc_protect(sc); /* not pop_stack! */
+	    return(data);
+	  }
+	unstack_gc_protect(sc); /* not pop_stack! */
+	push_stack(sc, OP_SORT_STRING_END, cons_unchecked(sc, data, lessp), sc->code);
+	set_car(args, vec);
+      }
+      break;
+
+    case T_INT_VECTOR:
+    case T_FLOAT_VECTOR:
+      {
+	s7_int i;
+	s7_pointer vec;
+	len = vector_length(data);
+	if (len < 2)
+	  return(data);
+	if (is_c_function(lessp))
+	  {
+	    if (sc->sort_f == lt_b_7pp)
+	      {
+		if (is_float_vector(data))
+		  qsort((void *)float_vector_floats(data), len, sizeof(s7_double), dbl_less);
+		else qsort((void *)int_vector_ints(data), len, sizeof(s7_int), int_less);
+		return(data);
+	      }
+	    if (sc->sort_f == gt_b_7pp)
+	      {
+		if (is_float_vector(data))
+		  qsort((void *)float_vector_floats(data), len, sizeof(s7_double), dbl_greater);
+		else qsort((void *)int_vector_ints(data), len, sizeof(s7_int), int_greater);
+		return(data);
+	      }}
+	/* currently we have to make the ordinary vector here even if not sf1
+	 *   because the sorter uses vector_element to access sort args (see SORT_DATA in eval).
+	 *   This is probably better than passing down getter/setter (fewer allocations).
+	 *   get/set macro in eval is SORT_DATA(k) then s7_vector_to_list if pair at start (sort_*_end)
+	 */
+	vec = make_vector_1(sc, len, FILLED, T_VECTOR);
+	gc_protect_2_via_stack(sc, vec, data);
+	/* we need this vector prefilled because make_real|integer below can cause a GC at any time during that loop,
+	 *   and the GC mark process expects the vector to have an s7_pointer at every element.
+	 */
+	add_vector(sc, vec);
+	elements = s7_vector_elements(vec);
+	check_free_heap_size(sc, len);
+	if (is_float_vector(data))
+	  for (i = 0; i < len; i++) elements[i] = make_real_unchecked(sc, float_vector(data, i));
+	else for (i = 0; i < len; i++) elements[i] = make_integer_unchecked(sc, int_vector(data, i));
+	if (sort_func)
+	  {
+	    local_qsort_r((void *)elements, len, sizeof(s7_pointer), sort_func, (void *)sc);
+	    if (is_float_vector(data))
+	      for (i = 0; i < len; i++)	float_vector(data, i) = real(elements[i]);
+	    else for (i = 0; i < len; i++) int_vector(data, i) = integer(elements[i]);
+	    unstack_gc_protect(sc);
+	    return(data);
+	  }
+	set_car(args, vec);
+	init_temp(sc->y, cons(sc, data, lessp));
+	unstack_gc_protect(sc);
+	push_stack(sc, OP_SORT_VECTOR_END, sc->y, sc->code); /* save and gc protect the original homogeneous vector and func */
+	sc->y = sc->unused;
+      }
+      break;
+
+    case T_VECTOR:
+      len = vector_length(data);
+      if (len < 2)
+	return(data);
+      if (sort_func)
+	{
+	  s7_pointer *els = s7_vector_elements(data);
+	  int32_t typ = type(els[0]);
+	  if ((typ == T_INTEGER) || (typ == T_REAL) || (typ == T_STRING) || (typ == T_CHARACTER))
+	    for (s7_int i = 1; i < len; i++)
+	      if (type(els[i]) != typ)
+		{
+		  typ = T_FREE;
+		  break;
+		}
+	  if ((sc->sort_f == lt_b_7pp) || (sc->sort_f == gt_b_7pp))
+	    {
+	      if (typ == T_INTEGER)
+		{
+		  qsort((void *)els, len, sizeof(s7_pointer), ((sc->sort_f == lt_b_7pp) ? int_less_2 : int_greater_2));
+		  return(data);
+		}
+	      if (typ == T_REAL)
+		{
+		  qsort((void *)els, len, sizeof(s7_pointer), ((sc->sort_f == lt_b_7pp) ? dbl_less_2 : dbl_greater_2));
+		  return(data);
+		}}
+	  if ((typ == T_STRING) &&
+	      ((sc->sort_f == string_lt_b_7pp) || (sc->sort_f == string_gt_b_7pp)))
+	    {
+	      qsort((void *)els, len, sizeof(s7_pointer), ((sc->sort_f == string_lt_b_7pp) ? str_less_2 : str_greater_2));
+	      return(data);
+	    }
+	  if ((typ == T_CHARACTER) &&
+	      ((sc->sort_f == char_lt_b_7pp) || (sc->sort_f == char_gt_b_7pp)))
+	    {
+	      qsort((void *)els, len, sizeof(s7_pointer), ((sc->sort_f == char_lt_b_7pp) ? chr_less_2 : chr_greater_2));
+	      return(data);
+	    }
+	  local_qsort_r((void *)s7_vector_elements(data), len, sizeof(s7_pointer), sort_func, (void *)sc);
+	  return(data);
+	}
+      break;
+
+    default:
+      return(method_or_bust(sc, data, sc->sort_symbol, args, wrap_string(sc, "a sortable sequence", 19), 1));
+    }
+
+  n = len - 1;
+  k = (n / 2) + 1;
+  lx = make_simple_vector(sc, (sc->safety <= NO_SAFETY) ? 4 : 6);
+  t_vector_fill(lx, sc->nil); /* make_mutable_integer below can trigger GC, so all elements of lx must be legit */
+  init_temp(sc->y, lx);
+  vector_element(lx, 0) = make_mutable_integer(sc, n);
+  vector_element(lx, 1) = make_mutable_integer(sc, k);
+  vector_element(lx, 2) = make_mutable_integer(sc, 0);
+  vector_element(lx, 3) = make_mutable_integer(sc, 0);
+  if (sc->safety > NO_SAFETY)
+    {
+      vector_element(lx, 4) = make_mutable_integer(sc, 0);
+      vector_element(lx, 5) = make_integer_unchecked(sc, n * n);
+    }
+  push_stack(sc, OP_SORT, args, lx);
+  sc->y = sc->unused;
+  return(sc->F);
+  /* if the comparison function waffles, sort! can hang: (sort! '(1 2 3) (lambda (a b) (= a b)))
+   * set 'safety to 1 to add a check for this loop, but the "safe" procedures are direct, so unchecked.
+   */
+}
+
+/* these are for the eval sort -- sort a vector, then if necessary put that data into the original sequence */
+static s7_pointer vector_into_list(s7_scheme *sc, s7_pointer vect, s7_pointer lst)
+{
+  s7_pointer *elements = vector_elements(vect);
+  s7_int i = 0, len = vector_length(vect);
+  for (s7_pointer p = lst; i < len; i++, p = cdr(p))
+    {
+      if (is_immutable_pair(p))
+	immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->sort_symbol, lst));
+      set_car(p, elements[i]);
+    }
+  return(lst);
+}
+
+static s7_pointer vector_into_fi_vector(s7_pointer source, s7_pointer dest)
+{
+  s7_pointer *elements = vector_elements(source);
+  s7_int len = vector_length(source);
+  if (is_float_vector(dest))
+    {
+      s7_double *flts = float_vector_floats(dest);
+      for (s7_int i = 0; i < len; i++)	flts[i] = real(elements[i]);
+    }
+  else
+    {
+      s7_int *ints = int_vector_ints(dest);
+      for (s7_int i = 0; i < len; i++)	ints[i] = integer(elements[i]);
+    }
+  return(dest);
+}
+
+static s7_pointer vector_into_string(s7_pointer vect, s7_pointer dest)
+{
+  s7_pointer *elements = vector_elements(vect);
+  s7_int len = vector_length(vect);
+  if (is_byte_vector(dest))
+    {
+      uint8_t *str = (uint8_t *)byte_vector_bytes(dest);
+      for (s7_int i = 0; i < len; i++)	str[i] = (uint8_t)integer(elements[i]);
+    }
+  else
+    {
+      uint8_t *str = (uint8_t *)string_value(dest);
+      for (s7_int i = 0; i < len; i++)	str[i] = character(elements[i]);
+    }
+  return(dest);
+}
+
+#define SORT_N integer(vector_element(sc->code, 0))
+#define SORT_K integer(vector_element(sc->code, 1))
+#define SORT_J integer(vector_element(sc->code, 2))
+#define SORT_K1 integer(vector_element(sc->code, 3))
+#define SORT_CALLS integer(vector_element(sc->code, 4))
+#define SORT_STOP integer(vector_element(sc->code, 5))
+#define SORT_DATA(K) vector_element(car(sc->args), K)
+#define SORT_LESSP cadr(sc->args)
+
+static s7_pointer op_heapsort(s7_scheme *sc)
+{
+  s7_int n = SORT_N, j, k = SORT_K1;
+
+  if ((n == k) || (k > ((s7_int)(n / 2)))) /* k == n == 0 is the first case */
+    return(sc->code);
+  if (sc->safety > NO_SAFETY)
+    {
+      SORT_CALLS++;
+      if (SORT_CALLS > SORT_STOP)
+	error_nr(sc, sc->out_of_range_symbol, set_elist_2(sc, wrap_string(sc, "sort! is caught in an infinite loop, comparison: ~S", 51), SORT_LESSP));
+    }
+  j = 2 * k;
+  SORT_J = j;
+  if (j < n)
+    {
+      s7_pointer lx = SORT_LESSP; /* cadr of sc->args */
+      push_stack_direct(sc, OP_SORT1);
+      if (needs_copied_args(lx))
+	sc->args = list_2(sc, SORT_DATA(j), SORT_DATA(j + 1));
+      else sc->args = with_list_t2(SORT_DATA(j), SORT_DATA(j + 1));
+      sc->code = lx;
+      sc->value = sc->T; /* for eval */
+    }
+  else sc->value = sc->F;
+  return(NULL);
+}
+
+static bool op_sort1(s7_scheme *sc)
+{
+  s7_int j = SORT_J, k = SORT_K1;
+  s7_pointer lx = SORT_LESSP;
+  if (is_true(sc, sc->value))
+    {
+      j = j + 1;
+      SORT_J = j;
+    }
+  push_stack_direct(sc, OP_SORT2);
+  if (needs_copied_args(lx))
+    sc->args = list_2(sc, SORT_DATA(k), SORT_DATA(j));
+  else sc->args = with_list_t2(SORT_DATA(k), SORT_DATA(j));
+  sc->code = lx;
+  return(false);
+}
+
+static bool op_sort2(s7_scheme *sc)
+{
+  s7_int j = SORT_J, k = SORT_K1;
+  if (is_true(sc, sc->value))
+    {
+      s7_pointer lx = SORT_DATA(j);
+      SORT_DATA(j) = SORT_DATA(k);
+      SORT_DATA(k) = lx;
+    }
+  else return(true);
+  SORT_K1 = SORT_J;
+  return(false);
+}
+
+static bool op_sort(s7_scheme *sc)
+{
+  /* coming in sc->args is sort args (data less?), sc->code = #(n k 0 ...)
+   * here we call the inner loop until k <= 0 [the local k! -- this is tricky because scheme passes args by value]
+   */
+  s7_int k = SORT_K;
+  if (k > 0)
+    {
+      SORT_K = k - 1;
+      SORT_K1 = k - 1;
+      push_stack_direct(sc, OP_SORT);
+      return(false);
+    }
+  return(true);
+}
+
+static bool op_sort3(s7_scheme *sc)
+{
+  s7_int n = SORT_N;
+  s7_pointer lx;
+  if (n <= 0)
+    {
+      sc->value = car(sc->args);
+      return(true);
+    }
+  lx = SORT_DATA(0);
+  SORT_DATA(0) = SORT_DATA(n);
+  SORT_DATA(n) = lx;
+  SORT_N = n - 1;
+  SORT_K1 = 0;
+  push_stack_direct(sc, OP_SORT3);
+  return(false);
+}
+
+
+/* -------- hash tables -------- */
+
+static void free_hash_table(s7_scheme *sc, s7_pointer table)
+{
+  if (hash_table_entries(table) > 0)
+    {
+      hash_entry_t **entries = hash_table_elements(table);
+      s7_int len = hash_table_size(table);
+      for (s7_int i = 0; i < len; i++)
+	{
+	  hash_entry_t *n;
+	  for (hash_entry_t *p = entries[i++]; p; p = n)
+	    {
+	      n = hash_entry_next(p);
+	      liberate_block(sc, p);
+	    }
+	  for (hash_entry_t *p = entries[i]; p; p = n)
+	    {
+	      n = hash_entry_next(p);
+	      liberate_block(sc, p);
+	    }}}
+  liberate(sc, hash_table_block(table));
+}
+
+static hash_entry_t *make_hash_entry(s7_scheme *sc, s7_pointer key, s7_pointer value, s7_int raw_hash)
+{
+  hash_entry_t *p = (hash_entry_t *)mallocate_block(sc);
+#if S7_DEBUGGING
+  sc->blocks_mallocated[BLOCK_LIST]++;
+#endif
+  hash_entry_key(p) = key;
+  hash_entry_set_value(p, value);
+  hash_entry_set_raw_hash(p, raw_hash);
+  return(p);
+}
+
+
+/* -------------------------------- hash-table? -------------------------------- */
+bool s7_is_hash_table(s7_pointer p) {return(is_hash_table(p));}
+
+static s7_pointer g_is_hash_table(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_hash_table "(hash-table? obj) returns #t if obj is a hash-table"
+  #define Q_is_hash_table sc->pl_bt
+  check_boolean_method(sc, is_hash_table, sc->is_hash_table_symbol, args);
+}
+
+
+/* -------------------------------- hash-table-entries -------------------------------- */
+static s7_pointer g_hash_table_entries(s7_scheme *sc, s7_pointer args)
+{
+  #define H_hash_table_entries "(hash-table-entries obj) returns the number of entries in the hash-table obj"
+  #define Q_hash_table_entries s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_hash_table_symbol)
+
+  if (!is_hash_table(car(args)))
+    return(sole_arg_method_or_bust(sc, car(args), sc->hash_table_entries_symbol, args, sc->type_names[T_HASH_TABLE]));
+  return(make_integer(sc, hash_table_entries(car(args))));
+}
+
+static s7_int hash_table_entries_i_7p(s7_scheme *sc, s7_pointer p)
+{
+  if (!is_hash_table(p))
+    return(integer(method_or_bust_p(sc, p, sc->hash_table_entries_symbol, sc->type_names[T_HASH_TABLE])));
+  return(hash_table_entries(p));
+}
+
+
+/* -------------------------------- hash-table-key|value-typer -------------------------------- */
+static s7_pointer g_hash_table_key_typer(s7_scheme *sc, s7_pointer args)
+{
+  #define H_hash_table_key_typer "(hash-table-key-typer hash) returns the hash-table's key type checking function"
+  #define Q_hash_table_key_typer s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->not_symbol, sc->is_procedure_symbol), sc->is_hash_table_symbol)
+
+  s7_pointer h = car(args);
+  if (!is_hash_table(h)) return(sole_arg_method_or_bust(sc, h, sc->hash_table_key_typer_symbol, args, sc->type_names[T_HASH_TABLE]));
+  if (is_typed_hash_table(h)) return(hash_table_key_typer(h));
+  return(sc->F);
+}
+
+static s7_pointer g_hash_table_value_typer(s7_scheme *sc, s7_pointer args)
+{
+  #define H_hash_table_value_typer "(hash-table-value-typer hash) returns the hash-table's value type checking function"
+  #define Q_hash_table_value_typer s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->not_symbol, sc->is_procedure_symbol), sc->is_hash_table_symbol)
+
+  s7_pointer h = car(args);
+  if (!is_hash_table(h)) return(sole_arg_method_or_bust(sc, h, sc->hash_table_value_typer_symbol, args, sc->type_names[T_HASH_TABLE]));
+  if (is_typed_hash_table(h)) return(hash_table_value_typer(h));
+  return(sc->F);
+}
+
+static s7_pointer make_hash_table_procedures(s7_scheme *sc)
+{
+  s7_pointer x = cons(sc, sc->T, sc->T); /* checker, mapped */
+  set_opt1_any(x, sc->T);                /* key */
+  set_opt2_any(x, sc->T);                /* value */
+  return(x);
+}
+
+static s7_pointer copy_hash_table_procedures(s7_scheme *sc, s7_pointer table)
+{
+  if (is_pair(hash_table_procedures(table)))
+    {
+      s7_pointer x = cons(sc, hash_table_procedures_checker(table), hash_table_procedures_mapper(table));
+      set_opt1_any(x, hash_table_key_typer(table));
+      set_opt2_any(x, hash_table_value_typer(table));
+      return(x);
+    }
+  return(sc->nil);
+}
+
+static void check_hash_table_typer(s7_scheme *sc, s7_pointer caller, s7_pointer h, s7_pointer typer)
+{
+  if (is_c_function(typer))
+    {
+      s7_pointer sig = c_function_signature(typer);
+      if ((sig != sc->pl_bt) &&
+	  (is_pair(sig)) &&
+	  ((car(sig) != sc->is_boolean_symbol) || (cadr(sig) != sc->T) || (!is_null(cddr(sig)))))
+	wrong_type_error_nr(sc, caller, 2, typer, wrap_string(sc, "a boolean procedure", 19));
+      if (!c_function_name(typer))
+	wrong_type_error_nr(sc, caller, 2, typer, wrap_string(sc, "a named function", 16));
+    }
+  else
+    {
+      if (!is_any_closure(typer))
+	wrong_type_error_nr(sc, caller, 2, typer, wrap_string(sc, "a built-in procedure, a closure or #t", 37));
+      if (!is_symbol(find_closure(sc, typer, closure_let(typer))))
+	wrong_type_error_nr(sc, caller, 2, typer, wrap_string(sc, "a named function", 16));
+    }
+  if (!s7_is_aritable(sc, typer, 1))
+    error_nr(sc, sc->wrong_type_arg_symbol,
+	     set_elist_3(sc, wrap_string(sc, "~A: the second argument, ~S, (the type checker) should accept one argument", 74), caller, typer));
+  if (is_c_function(typer))
+    {
+      if (!c_function_symbol(typer))
+	c_function_symbol(typer) = make_symbol(sc, c_function_name(typer), c_function_name_length(typer));
+      if (c_function_has_simple_elements(typer))
+	{
+	  if (caller == sc->hash_table_value_typer_symbol)
+	    set_has_simple_values(h);
+	  else
+	    {
+	      set_has_simple_keys(h);
+	      if (symbol_type(c_function_symbol(typer)) != T_FREE)
+		set_has_hash_key_type(h);
+	    }}}
+  if (is_null(hash_table_procedures(h)))
+    hash_table_set_procedures(h, make_hash_table_procedures(sc));
+  set_is_typed_hash_table(h);
+}
+
+static s7_pointer g_set_hash_table_key_typer(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer h = car(args), typer = cadr(args);
+
+  if (!is_hash_table(h))
+    wrong_type_error_nr(sc, wrap_string(sc, "set! hash_table-key-typer", 25), 1, h, sc->type_names[T_HASH_TABLE]);
+  if (is_immutable_hash_table(h))
+    immutable_object_error_nr(sc, set_elist_2(sc, wrap_string(sc, "~S is immutable so its key-typer can't be set!", 46), h));
+
+  if (is_boolean(typer)) /* remove current typer, if any */
+    {
+      if (is_typed_hash_table(h))
+	{
+	  hash_table_set_key_typer(h, sc->T);
+	  clear_has_simple_keys(h);
+	  if (hash_table_value_typer(h) == sc->T) clear_is_typed_hash_table(h);
+	}}
+  else
+    {
+      check_hash_table_typer(sc, sc->hash_table_key_typer_symbol, h, typer);
+      hash_table_set_key_typer(h, typer);
+    }
+  return(typer);
+}
+
+static s7_pointer g_set_hash_table_value_typer(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer h = car(args), typer = cadr(args);
+
+  if (!is_hash_table(h))
+    wrong_type_error_nr(sc, wrap_string(sc, "set! hash_table-value-typer", 27), 1, h, sc->type_names[T_HASH_TABLE]);
+  if (is_immutable_hash_table(h))
+    immutable_object_error_nr(sc, set_elist_2(sc, wrap_string(sc, "~S is immutable so its value-typer can't be set!", 48), h));
+
+  if (is_boolean(typer)) /* remove current typer, if any */
+    {
+      if (is_typed_hash_table(h))
+	{
+	  hash_table_set_value_typer(h, sc->T);
+	  clear_has_simple_values(h);
+	  if (hash_table_key_typer(h) == sc->T) clear_is_typed_hash_table(h);
+	}}
+  else
+    {
+      check_hash_table_typer(sc, sc->hash_table_value_typer_symbol, h, typer);
+      hash_table_set_value_typer(h, typer);
+    }
+  return(typer);
+}
+
+
+/* ---------------- hash map and equality tables ---------------- */
+/* built in hash loc tables for eq? eqv? equal? equivalent? = string=? string-ci=? char=? char-ci=? (default=equal?) */
+#define hash_loc(Sc, Table, Key) (*(hash_table_mapper(Table)[type(Key)]))(Sc, Table, Key)
+
+static hash_map_t eq_hash_map[NUM_TYPES];
+static hash_map_t string_eq_hash_map[NUM_TYPES];
+static hash_map_t char_eq_hash_map[NUM_TYPES];
+static hash_map_t closure_hash_map[NUM_TYPES];
+static hash_map_t equivalent_hash_map[NUM_TYPES];
+static hash_map_t c_function_hash_map[NUM_TYPES];
+#if (!WITH_PURE_S7)
+static hash_map_t string_ci_eq_hash_map[NUM_TYPES];
+static hash_map_t char_ci_eq_hash_map[NUM_TYPES];
+#endif
+/* also default_hash_map */
+
+
+/* ---------------- hash-code ---------------- */
+/* eqfunc handling which will require other dummy tables */
+
+static s7_pointer make_dummy_hash_table(s7_scheme *sc) /* make the absolute minimal hash-table that can support hash-code */
+{
+  s7_pointer table = alloc_pointer(sc);
+  set_type_bit(table, T_IMMUTABLE | T_HASH_TABLE | T_UNHEAP);
+  hash_table_mapper(table) = default_hash_map;
+  return(table);
+}
+
+s7_int s7_hash_code(s7_scheme *sc, s7_pointer obj, s7_pointer eqfunc)
+{
+  return(default_hash_map[type(obj)](sc, sc->dummy_equal_hash_table, obj));
+}
+
+static s7_pointer g_hash_code(s7_scheme *sc, s7_pointer args)
+{
+  #define H_hash_code "(hash-code obj (eqfunc)) returns an integer suitable for use as a hash code for obj."
+  #define Q_hash_code s7_make_signature(sc, 3, sc->is_integer_symbol, sc->T, sc->T)
+  s7_pointer obj = car(args);
+  if ((is_pair(cdr(args))) &&
+      (!is_procedure(cadr(args))))
+    error_nr(sc, sc->wrong_type_arg_symbol,
+	     set_elist_2(sc, wrap_string(sc, "hash-code second argument (currently ignored) should be a function: ~S", 70), cadr(args)));
+  return(make_integer(sc, default_hash_map[type(obj)](sc, sc->dummy_equal_hash_table, obj)));
+}
+
+
+static bool (*equals[NUM_TYPES])(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci);
+static bool (*equivalents[NUM_TYPES])(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci);
+
+static hash_entry_t *(*default_hash_checks[NUM_TYPES])(s7_scheme *sc, s7_pointer table, s7_pointer key);
+static hash_entry_t *(*equal_hash_checks[NUM_TYPES])(s7_scheme *sc, s7_pointer table, s7_pointer key);
+
+
+/* ---------------- hash empty ---------------- */
+static hash_entry_t *hash_empty(s7_scheme *sc, s7_pointer table, s7_pointer key) {return(sc->unentry);}
+
+/* ---------------- hash syntax ---------------- */
+static s7_int hash_map_syntax(s7_scheme *sc, s7_pointer table, s7_pointer key)  {return(pointer_map(syntax_symbol(key)));}
+
+static hash_entry_t *hash_equal_syntax(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  s7_int loc = hash_loc(sc, table, key) & hash_table_mask(table);
+  for (hash_entry_t *x = hash_table_element(table, loc); x; x = hash_entry_next(x))
+    if ((is_syntax(hash_entry_key(x))) &&
+	(syntax_symbol(hash_entry_key(x)) == syntax_symbol(key))) /* the opcodes might differ, but the symbols should not */
+      return(x);
+  return(sc->unentry);
+}
+
+/* ---------------- hash symbols ---------------- */
+static s7_int hash_map_symbol(s7_scheme *sc, s7_pointer table, s7_pointer key)  {return(pointer_map(key));}
+
+static hash_entry_t *hash_symbol(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  for (hash_entry_t *x = hash_table_element(table, pointer_map(key) & hash_table_mask(table)); x; x = hash_entry_next(x))
+    if (key == hash_entry_key(x))
+      return(x);
+  return(sc->unentry);
+}
+
+
+/* ---------------- hash numbers ---------------- */
+static s7_int hash_map_int(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  return(s7_int_abs(integer(key)));
+}
+
+static s7_int hash_map_ratio(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  /* if numerator is -9223372036854775808, s7_int_abs overflows -- need to divide, then abs:  -9223372036854775808/3: -3074457345618258602 3074457345618258602
+   * (s7_int)floorl(fabsl(fraction(key))) is no good here, 3441313796169221281/1720656898084610641: 1 2 (in valgrind),
+   *    floor ratio is 1: (- (* 2 1720656898084610641) 3441313796169221281) -> 1
+   *    or (gmp:) 1.999999999999999999418826611445214136431E0, so the floorl(fabsl) version is wrong
+   */
+  return(s7_int_abs(numerator(key) / denominator(key))); /* needs to be compatible with default-hash-table-float-epsilon which is unfortunate */
+}
+
+static s7_int hash_float_location(s7_double x)
+{
+  s7_double dx;
+  if ((is_NaN(x)) || (is_inf(x))) return(0);
+  dx = fabs(x);
+  if (dx > DOUBLE_TO_INT64_LIMIT) return(0);
+  return((s7_int)floor(dx));
+}
+  /* isnormal here in place of is_NaN and is_inf is slower.
+   *   using x*100 to expand small float bin range runs afoul of the hash-table-float-epsilon bin calcs
+   */
+
+static s7_int hash_map_real(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  return(hash_float_location(real(key)));
+}
+
+static s7_int hash_map_complex(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  return(hash_float_location(real_part(key))/* + hash_float_location(imag_part(key)) */); /* imag-part confuses epsilon distance calcs */
+}
+
+#if WITH_GMP
+static s7_int hash_map_big_int(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  /* may need to use quotient here */
+  mpz_abs(sc->mpz_1, big_integer(key));
+  return(mpz_get_si(sc->mpz_1)); /* returns the bits that fit */
+}
+
+static s7_int hash_map_big_ratio(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  mpq_abs(sc->mpq_1, big_ratio(key));
+  mpz_fdiv_q(sc->mpz_1, mpq_numref(sc->mpq_1), mpq_denref(sc->mpq_1));
+  return(mpz_get_si(sc->mpz_1));
+}
+
+static s7_int hash_map_big_real_1(s7_scheme *sc, s7_pointer table, mpfr_t key)
+{
+  if ((mpfr_nan_p(key)) || (mpfr_inf_p(key))) return(0);
+  mpfr_abs(sc->mpfr_1, key, MPFR_RNDN);
+  /* mpfr_get_si returns most-positive-int if > 2^63! luckily there aren't any more of these */
+  mpfr_get_z(sc->mpz_1, sc->mpfr_1, MPFR_RNDD); /* floor not round */
+  return(mpz_get_si(sc->mpz_1));
+}
+
+static s7_int hash_map_big_real(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  return(hash_map_big_real_1(sc, table, big_real(key)));
+}
+
+static s7_int hash_map_big_complex(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  return(hash_map_big_real_1(sc, table, mpc_realref(big_complex(key))));
+}
+#endif
+
+static hash_entry_t *find_number_in_bin(s7_scheme *sc, hash_entry_t *bin, s7_pointer key)
+{
+  s7_double old_eps = sc->equivalent_float_epsilon;
+  bool (*equiv)(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci) = equivalents[type(key)];
+  sc->equivalent_float_epsilon = sc->hash_table_float_epsilon;
+  for (; bin; bin = hash_entry_next(bin))
+    if (equiv(sc, key, hash_entry_key(bin), NULL))
+      {
+	sc->equivalent_float_epsilon = old_eps;
+	return(bin);
+      }
+  sc->equivalent_float_epsilon = old_eps;
+  return(NULL);
+}
+
+static hash_entry_t *hash_number_equivalent(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  /* for equivalent? and =, kind of complicated because two bins can be involved if the key is close to an integer */
+#if WITH_GMP
+  /* first try loc from hash_loc, then get key-floor(key) [with abs], and check against
+   *   epsilon: diff < eps call find big in bin-1, diff > 1.0-eps call same in bin+1
+   */
+  s7_int loc1, hash_mask = hash_table_mask(table);
+  s7_int loc = hash_loc(sc, table, key);
+  s7_int hash_loc = loc & hash_mask;
+  hash_entry_t *i1 = find_number_in_bin(sc, hash_table_element(table, hash_loc), key);
+  if (i1) return(i1);
+
+  if (is_real(key))
+    {
+      s7_pointer res = any_real_to_mpfr(sc, key, sc->mpfr_1);
+      if (res) return(sc->unentry);
+    }
+  else
+    if (is_t_complex(key))
+      mpfr_set_d(sc->mpfr_1, real_part(key), MPFR_RNDN);
+    else mpfr_set(sc->mpfr_1, mpc_realref(big_complex(key)), MPFR_RNDN);
+
+  /* mpfr_1 is big_real, so we can use hash_loc of big_real (and can ignore NaN's): */
+  mpfr_abs(sc->mpfr_1, sc->mpfr_1, MPFR_RNDN);
+  mpfr_add_d(sc->mpfr_2, sc->mpfr_1, sc->hash_table_float_epsilon, MPFR_RNDN);
+  mpfr_get_z(sc->mpz_1, sc->mpfr_2, MPFR_RNDD);
+  loc1 = mpz_get_si(sc->mpz_1);
+  if (loc1 != loc)
+    {
+      if (loc1 == hash_table_mask(table)) loc1 = 0;
+      hash_loc = loc1 & hash_mask;
+      i1 = find_number_in_bin(sc, hash_table_element(table, hash_loc), key);
+      return((i1) ? i1 : sc->unentry);
+    }
+  mpfr_sub_d(sc->mpfr_2, sc->mpfr_1, sc->hash_table_float_epsilon, MPFR_RNDN);
+  mpfr_get_z(sc->mpz_1, sc->mpfr_2, MPFR_RNDD);
+  loc1 = mpz_get_si(sc->mpz_1);
+  if (loc1 != loc)
+    {
+      if (loc1 < 0) loc1 = hash_table_mask(table);
+      hash_loc = loc1 & hash_mask;
+      i1 = find_number_in_bin(sc, hash_table_element(table, hash_loc), key);
+      if (i1) return(i1);
+    }
+  return(sc->unentry);
+#else
+  s7_double keyval = (is_real(key)) ? s7_real(key) : real_part(key);
+  s7_double fprobe = fabs(keyval);
+  s7_int iprobe = (s7_int)floor(fprobe);
+  s7_double bin_dist = fprobe - iprobe;
+  s7_int loc = iprobe & hash_table_mask(table);
+  hash_entry_t *i1 = find_number_in_bin(sc, hash_table_element(table, loc), key);
+  if (i1) return(i1);
+
+  if (bin_dist <= sc->hash_table_float_epsilon)        /* maybe closest is below iprobe, key+eps>iprobe but key maps to iprobe-1 */
+    i1 = find_number_in_bin(sc, hash_table_element(table, (loc > 0) ? loc - 1 : hash_table_mask(table)), key);
+  else
+    if (bin_dist >= (1.0 - sc->hash_table_float_epsilon))
+      i1 = find_number_in_bin(sc, hash_table_element(table, (loc < hash_table_mask(table)) ? loc + 1 : 0), key);
+  return((i1) ? i1 : sc->unentry);
+#endif
+}
+
+static hash_entry_t *hash_int(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+#if WITH_GMP
+  if ((is_t_integer(key)) || (is_t_big_integer(key)))
+#else
+  if (is_t_integer(key))
+#endif
+    {
+      s7_int hash_mask = hash_table_mask(table);
+      hash_entry_t *x;
+#if WITH_GMP
+      s7_int kv = (is_t_integer(key)) ? integer(key) : mpz_get_si(big_integer(key));
+#else
+      s7_int kv = integer(key);
+#endif
+      s7_int loc = s7_int_abs(kv) & hash_mask;
+      for (x = hash_table_element(table, loc); x; x = hash_entry_next(x))
+#if WITH_GMP
+	if (is_t_integer(hash_entry_key(x)))
+	  {
+	    if (integer(hash_entry_key(x)) == kv)
+	      return(x);
+	  }
+	else
+	  if ((is_t_big_integer(hash_entry_key(x))) &&
+	      (mpz_get_si(big_integer(hash_entry_key(x))) == kv))
+	    return(x);
+#else
+      if (integer(hash_entry_key(x)) == kv)
+	return(x);
+#endif
+    }
+  return(sc->unentry);
+}
+
+static hash_entry_t *hash_float(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  /* if a hash-table has only t_real keys, its checker is hash_float, but we might use a t_big_real key */
+#if WITH_GMP
+  if ((is_t_real(key)) || (is_t_big_real(key)))
+#else
+  if (is_t_real(key))
+#endif
+    {
+      s7_double keyval;
+      s7_int loc, hash_mask;
+#if WITH_GMP
+      if (is_t_real(key))
+	{
+	  keyval = real(key);
+	  if (is_NaN(keyval)) return(sc->unentry);
+	}
+      else
+	{
+	  if (mpfr_nan_p(big_real(key))) return(sc->unentry);
+	  keyval = mpfr_get_d(big_real(key), MPFR_RNDN);
+	}
+#else
+      keyval = real(key);
+      if (is_NaN(keyval)) return(sc->unentry);
+#endif
+      hash_mask = hash_table_mask(table);
+      loc = hash_float_location(keyval) & hash_mask;
+
+      for (hash_entry_t *x = hash_table_element(table, loc); x; x = hash_entry_next(x))
+	{
+	  if ((is_t_real(hash_entry_key(x))) &&
+	      (keyval == real(hash_entry_key(x))))
+	    return(x);
+#if WITH_GMP
+	  if ((is_t_big_real(hash_entry_key(x))) &&
+	      (mpfr_cmp_d(big_real(hash_entry_key(x)), keyval) == 0) &&
+	      (!mpfr_nan_p(big_real(hash_entry_key(x)))))
+	    return(x);
+#endif
+	}}
+  return(sc->unentry);
+}
+
+static hash_entry_t *hash_num_eq(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  s7_int hash_mask = hash_table_mask(table);
+  s7_int loc = hash_loc(sc, table, key) & hash_mask;
+  for (hash_entry_t *x = hash_table_element(table, loc); x; x = hash_entry_next(x))
+    if (num_eq_b_7pp(sc, key, hash_entry_key(x)))
+      return(x);
+  return(sc->unentry);
+}
+
+static hash_entry_t *hash_real_num_eq(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+#if WITH_GMP
+  if ((is_t_real(key)) && (is_NaN(real(key)))) return(sc->unentry);
+  if ((is_t_big_real(key)) && (mpfr_nan_p(big_real(key)))) return(sc->unentry);
+  return(hash_num_eq(sc, table, key));
+#else
+  return((is_NaN(s7_real(key))) ? sc->unentry : hash_num_eq(sc, table, key));
+#endif
+}
+
+static hash_entry_t *hash_complex_num_eq(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+#if WITH_GMP
+  if ((is_t_complex(key)) && ((is_NaN(real_part(key))) || (is_NaN(imag_part(key))))) return(sc->unentry);
+  if ((is_t_big_complex(key)) && ((mpfr_nan_p(mpc_realref(big_complex(key)))) || (mpfr_nan_p(mpc_imagref(big_complex(key)))))) return(sc->unentry);
+  return(hash_num_eq(sc, table, key));
+#else
+  return(((is_NaN(real_part(key))) || (is_NaN(imag_part(key)))) ? sc->unentry : hash_num_eq(sc, table, key));
+#endif
+}
+
+static hash_entry_t *hash_number_num_eq(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  if (is_number(key))
+    {
+#if (!WITH_GMP)
+      s7_int hash_mask = hash_table_mask(table);
+      hash_map_t map = hash_table_mapper(table)[type(key)];
+      if (hash_table_checker(table) == hash_int)    /* surely by far the most common case? only ints */
+	{
+	  s7_int keyi = integer(key);
+	  s7_int loc = map(sc, table, key) & hash_mask;
+	  for (hash_entry_t *x = hash_table_element(table, loc); x; x = hash_entry_next(x))
+	    if (keyi == integer(hash_entry_key(x))) /* not in gmp, hash_int as eq_func, what else can key be but t_integer? */
+	      return(x);
+	}
+      else
+#endif
+	return((is_real(key)) ? hash_real_num_eq(sc, table, key) : hash_complex_num_eq(sc, table, key));
+    }
+  return(sc->unentry);
+}
+
+
+/* ---------------- hash characters ---------------- */
+static s7_int hash_map_char(s7_scheme *sc, s7_pointer table, s7_pointer key) {return(character(key));}
+
+static hash_entry_t *hash_char(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  if (is_character(key))
+    {
+      /* return(hash_eq(sc, table, key));
+       *   but I think if we get here at all, we have to be using default_hash_checks|maps -- see hash_symbol above.
+       */
+      s7_int loc = character(key) & hash_table_mask(table);
+      for (hash_entry_t *x = hash_table_element(table, loc); x; x = hash_entry_next(x))
+	if (key == hash_entry_key(x))
+	  return(x);
+    }
+  return(sc->unentry);
+}
+
+#if (!WITH_PURE_S7)
+static s7_int hash_map_ci_char(s7_scheme *sc, s7_pointer table, s7_pointer key) {return(upper_character(key));}
+
+static hash_entry_t *hash_ci_char(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  if (is_character(key))
+    {
+      s7_int hash_mask = hash_table_mask(table);
+      s7_int loc = hash_loc(sc, table, key) & hash_mask;
+      for (hash_entry_t *x = hash_table_element(table, loc); x; x = hash_entry_next(x))
+	if (upper_character(key) == upper_character(hash_entry_key(x)))
+	  return(x);
+    }
+  return(sc->unentry);
+}
+#endif
+
+
+/* ---------------- hash strings ---------------- */
+static s7_int hash_map_string(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  if (string_hash(key) == 0)
+    string_hash(key) = raw_string_hash((const uint8_t *)string_value(key), string_length(key));
+  return(string_hash(key));
+}
+
+static hash_entry_t *hash_string(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  if (is_string(key))
+    {
+      hash_entry_t *x;
+      s7_int key_len = string_length(key);
+      uint64_t hash_mask = (uint64_t)hash_table_mask(table);
+      uint64_t hash;
+      const char *key_str = string_value(key);
+
+      if (string_hash(key) == 0)
+	string_hash(key) = raw_string_hash((const uint8_t *)string_value(key), string_length(key));
+      hash = string_hash(key); /* keep uint64_t (not s7_int from hash_map_string) */
+
+      if (key_len <= 8)
+	{
+	  for (x = hash_table_element(table, hash & hash_mask); x; x = hash_entry_next(x))
+	    if ((hash == string_hash(hash_entry_key(x))) &&
+		(key_len == string_length(hash_entry_key(x))))
+	      return(x);
+	}
+      else
+	for (x = hash_table_element(table, hash & hash_mask); x; x = hash_entry_next(x))
+	  if ((hash == string_hash(hash_entry_key(x))) &&
+	      (key_len == string_length(hash_entry_key(x))) &&        /* these are scheme strings, so we can't assume 0=end of string */
+	      (strings_are_equal_with_length(key_str, string_value(hash_entry_key(x)), key_len)))
+	    return(x);
+    }
+  return(sc->unentry);
+}
+
+#if (!WITH_PURE_S7)
+static s7_int hash_map_ci_string(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  s7_int len = string_length(key);
+  return((len == 0) ? 0 : (len + (uppers[(int32_t)(string_value(key)[0])] << 4)));
+}
+
+static hash_entry_t *hash_ci_string(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  if (is_string(key))
+    {
+      s7_int hash_mask = hash_table_mask(table);
+      s7_int hash = hash_map_ci_string(sc, table, key);
+      for (hash_entry_t *x = hash_table_element(table, hash & hash_mask); x; x = hash_entry_next(x))
+	if (scheme_strequal_ci(key, hash_entry_key(x)))
+	  return(x);
+    }
+  return(sc->unentry);
+}
+#endif
+
+
+/* ---------------- hash eq? ---------------- */
+static s7_int hash_map_nil(s7_scheme *sc, s7_pointer table, s7_pointer key) {return(type(key));}
+
+static s7_int hash_map_eq(s7_scheme *sc, s7_pointer table, s7_pointer key) {return(pointer_map(key));}
+
+static hash_entry_t *hash_eq(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  /* explicit eq? as hash equality func for (for example) symbols as keys */
+  s7_int hash_mask = hash_table_mask(table);
+  s7_int loc = pointer_map(key) & hash_mask; /* hash_map_eq */
+  for (hash_entry_t *x = hash_table_element(table, loc); x; x = hash_entry_next(x))
+    if (key == hash_entry_key(x))
+      return(x);
+  return(sc->unentry);
+}
+
+/* ---------------- hash eqv? ---------------- */
+static hash_entry_t *hash_eqv(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  hash_entry_t *x;
+  s7_int hash_mask = hash_table_mask(table);
+  s7_int loc = hash_loc(sc, table, key) & hash_mask;
+  if (is_number(key))
+    {
+#if WITH_GMP
+      for (x = hash_table_element(table, loc); x; x = hash_entry_next(x))
+	if (numbers_are_eqv(sc, key, hash_entry_key(x)))
+	  return(x);
+#else
+      uint8_t key_type = type(key);
+      for (x = hash_table_element(table, loc); x; x = hash_entry_next(x))
+	if ((key_type == type(hash_entry_key(x))) &&
+	    (numbers_are_eqv(sc, key, hash_entry_key(x))))
+	  return(x);
+#endif
+    }
+  else
+    for (x = hash_table_element(table, loc); x; x = hash_entry_next(x))
+      if (s7_is_eqv(sc, key, hash_entry_key(x)))
+	return(x);
+  return(sc->unentry);
+}
+
+/* ---------------- hash equal? ---------------- */
+static s7_int hash_map_hash_table(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  /* hash-tables are equal if key/values match independent of table size and entry order.
+   * if not using equivalent?, hash_table_checker|mapper must also be the same.
+   *    since order doesn't matter, but equal tables need to map to the same bin, we can't use key's
+   *    entries except when key has 1 or 2 entries (or 3 to be tedious).
+   * Keys are supposed to be constant while keys, so a hash-table shouldn't be a key of itself.
+   */
+  s7_int len = hash_table_entries(key);
+  if ((len == 0) || (len > 2) || (hash_table_size(key) > 32)) return(len);
+
+  {
+  s7_pointer key1 = NULL, val1;
+  hash_entry_t **els = hash_table_elements(key);
+  s7_int size = hash_table_size(key);
+  for (s7_int i = 0; i < size; i++)
+    for (hash_entry_t *x = els[i]; x; x = hash_entry_next(x))
+      {
+	if (len == 1)
+	  return(((is_sequence_or_iterator(hash_entry_key(x))) ? 0 : hash_loc(sc, key, hash_entry_key(x))) +
+		 ((is_sequence_or_iterator(hash_entry_value(x))) ? 0 : hash_loc(sc, key, hash_entry_value(x))));
+	if (!key1)
+	  {
+	    key1 = hash_entry_key(x);
+	    val1 = hash_entry_value(x);
+	  }
+	else
+	  return(((is_sequence_or_iterator(key1)) ? 0 : hash_loc(sc, key, key1)) +
+		 ((is_sequence_or_iterator(val1)) ? 0 : hash_loc(sc, key, val1)) +
+		 ((is_sequence_or_iterator(hash_entry_key(x))) ? 0 : hash_loc(sc, key, hash_entry_key(x))) +
+		 ((is_sequence_or_iterator(hash_entry_value(x))) ? 0 : hash_loc(sc, key, hash_entry_value(x))));
+      }}
+  return(0); /* placate the compiler */
+}
+
+static s7_int hash_map_int_vector(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  if (vector_length(key) == 0)
+    return(0);
+  if (vector_length(key) == 1)
+    return(s7_int_abs(int_vector(key, 0)));
+  return(vector_length(key) + s7_int_abs(int_vector(key, 0)) + s7_int_abs(int_vector(key, 1))); /* overflow is ok here (in + or abs), as long as it's consistent */
+}
+
+static s7_int hash_map_byte_vector(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  if (byte_vector_length(key) == 0)
+    return(0);
+  if (byte_vector_length(key) == 1)
+    return((s7_int)byte_vector(key, 0));
+  return(byte_vector_length(key) + byte_vector(key, 0) + byte_vector(key, 1));
+}
+
+static s7_int hash_map_float_vector(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  if (vector_length(key) == 0)
+    return(0);
+  if (vector_length(key) == 1)
+    return(hash_float_location(float_vector(key, 0)));
+  return(vector_length(key) + hash_float_location(float_vector(key, 0)) + hash_float_location(float_vector(key, 1)));
+}
+
+static s7_int hash_map_vector(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  if ((vector_length(key) == 0) ||
+      (is_sequence_or_iterator(vector_element(key, 0))))
+    return(vector_length(key));
+  if ((vector_length(key) == 1) ||
+      (is_sequence_or_iterator(vector_element(key, 1))))
+    return(hash_loc(sc, table, vector_element(key, 0)));
+  return(vector_length(key) + hash_loc(sc, table, vector_element(key, 0)) + hash_loc(sc, table, vector_element(key, 1))); /* see above */
+}
+
+
+static s7_int hash_map_closure(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  s7_pointer f = hash_table_procedures_mapper(table);
+  if (f == sc->unused)
+    error_nr(sc, make_symbol(sc, "hash-map-recursion", 18),
+	     set_elist_1(sc, wrap_string(sc, "hash-table map function called recursively", 42)));
+  /* check_stack_size(sc); -- perhaps clear typers as well here or save/restore hash-table-procedures */
+  gc_protect_via_stack(sc, f);
+  hash_table_set_procedures_mapper(table, sc->F);
+  sc->value = s7_call(sc, f, set_plist_1(sc, key));
+  unstack_gc_protect(sc);
+  hash_table_set_procedures_mapper(table, f);
+  if (!s7_is_integer(sc->value))
+    error_nr(sc, sc->wrong_type_arg_symbol,
+	     set_elist_2(sc, wrap_string(sc, "hash-table map function should return an integer: ~S", 52), sc->value));
+  return(integer(sc->value));
+}
+
+static s7_int hash_map_let(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  /* lets are equal if same symbol/value pairs, independent of order, taking into account shadowing. equal? follows outlet, but that is ridiculous here. */
+  s7_pointer slot, slot1 = NULL, slot2 = NULL;
+  s7_int slots;
+
+  if ((key == sc->rootlet) || (!tis_slot(let_slots(key)))) return(0);
+
+  for (slot = let_slots(key), slots = 0; tis_slot(slot); slot = next_slot(slot))
+    if (!is_matched_symbol(slot_symbol(slot)))
+      {
+	if (!slot1) slot1 = slot; else slot2 = slot;
+	set_match_symbol(slot_symbol(slot));
+	slots++;
+      }
+  for (slot = let_slots(key); tis_slot(slot); slot = next_slot(slot))
+    clear_match_symbol(slot_symbol(slot));
+
+  if (slots == 1)
+    return(pointer_map(slot_symbol(slot1)) + ((is_sequence_or_iterator(slot_value(slot1))) ? 0 : hash_loc(sc, table, slot_value(slot1))));
+
+  if (slots == 2)
+    return(pointer_map(slot_symbol(slot1)) + ((is_sequence_or_iterator(slot_value(slot1))) ? 0 : hash_loc(sc, table, slot_value(slot1))) +
+	   pointer_map(slot_symbol(slot2)) + ((is_sequence_or_iterator(slot_value(slot2))) ? 0 : hash_loc(sc, table, slot_value(slot2))));
+  return(slots);
+}
+
+static hash_entry_t *hash_equal_eq(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  s7_int loc = hash_loc(sc, table, key) & hash_table_mask(table);
+  for (hash_entry_t *x = hash_table_element(table, loc); x; x = hash_entry_next(x))
+    if (hash_entry_key(x) == key)
+      return(x);
+  return(sc->unentry);
+}
+
+static hash_entry_t *hash_equal_integer(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  s7_int keyint = integer(key);
+  s7_int loc = s7_int_abs(keyint) & hash_table_mask(table);  /* hash_loc -> hash_map_integer */
+  for (hash_entry_t *x = hash_table_element(table, loc); x; x = hash_entry_next(x))
+    {
+      if ((is_t_integer(hash_entry_key(x))) &&
+	  (keyint == integer(hash_entry_key(x))))
+	return(x);
+#if WITH_GMP
+      if ((is_t_big_integer(hash_entry_key(x))) &&
+	  (mpz_cmp_si(big_integer(hash_entry_key(x)), keyint) == 0))
+	return(x);
+#endif
+    }
+  return(sc->unentry);
+}
+
+static hash_entry_t *hash_equal_ratio(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  s7_int keynum = numerator(key), keyden = denominator(key);
+  s7_int loc = s7_int_abs(keynum / keyden) & hash_table_mask(table);  /* hash_loc -> hash_map_ratio */
+  for (hash_entry_t *x = hash_table_element(table, loc); x; x = hash_entry_next(x))
+    {
+      if ((is_t_ratio(hash_entry_key(x))) &&
+	  (keynum == numerator(hash_entry_key(x))) &&
+	  (keyden == denominator(hash_entry_key(x))))
+	return(x);
+#if WITH_GMP
+      if ((is_t_big_ratio(hash_entry_key(x))) &&
+	  (keynum == mpz_get_si(mpq_numref(big_ratio(hash_entry_key(x))))) &&
+	  (keyden == mpz_get_si(mpq_denref(big_ratio(hash_entry_key(x))))))
+	return(x);
+#endif
+    }
+  return(sc->unentry);
+}
+
+static hash_entry_t *hash_equal_real(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  s7_int loc;
+  s7_double keydbl = real(key);
+  if (is_NaN(keydbl)) return(sc->unentry);
+  loc = hash_float_location(keydbl) & hash_table_mask(table);
+  for (hash_entry_t *x = hash_table_element(table, loc); x; x = hash_entry_next(x))
+    {
+      if ((is_t_real(hash_entry_key(x))) &&
+	  (keydbl == real(hash_entry_key(x))))
+	return(x);
+#if WITH_GMP
+      if ((is_t_big_real(hash_entry_key(x))) &&
+	  (mpfr_cmp_d(big_real(hash_entry_key(x)), keydbl) == 0) &&
+	  (!mpfr_nan_p(big_real(hash_entry_key(x)))))
+	return(x);
+#endif
+    }
+  return(sc->unentry);
+}
+
+static hash_entry_t *hash_equal_complex(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  s7_int loc;
+  s7_double keyrl = real_part(key);
+  s7_double keyim = imag_part(key);
+
+#if WITH_GMP
+  if ((is_NaN(keyrl)) || (is_NaN(keyim))) return(sc->unentry);
+#endif
+  loc = hash_map_complex(sc, table, key) & hash_table_mask(table);
+  for (hash_entry_t *x = hash_table_element(table, loc); x; x = hash_entry_next(x))
+    {
+      if ((is_t_complex(hash_entry_key(x))) &&
+	  (keyrl == real_part(hash_entry_key(x))) &&
+	  (keyim == imag_part(hash_entry_key(x))))
+	return(x);
+#if WITH_GMP
+      if ((is_t_big_complex(hash_entry_key(x))) &&
+	  (mpfr_cmp_d(mpc_realref(big_complex(hash_entry_key(x))), keyrl) == 0) &&
+	  (mpfr_cmp_d(mpc_imagref(big_complex(hash_entry_key(x))), keyim) == 0) &&
+	  (!mpfr_nan_p(mpc_realref(big_complex(hash_entry_key(x))))) &&
+	  (!mpfr_nan_p(mpc_imagref(big_complex(hash_entry_key(x))))))
+	return(x);
+#endif
+    }
+  return(sc->unentry);
+}
+
+static hash_entry_t *hash_equal_any(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  bool (*equal)(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci) = equals[type(key)];
+  s7_int hash = hash_loc(sc, table, key);
+  s7_int loc = hash & hash_table_mask(table);
+  for (hash_entry_t *x = hash_table_element(table, loc); x; x = hash_entry_next(x))
+    if (key == hash_entry_key(x)) /* avoid the equal funcs if possible -- this saves in both hash timing tests */
+      return(x);
+  for (hash_entry_t *x = hash_table_element(table, loc); x; x = hash_entry_next(x))
+    if ((hash_entry_raw_hash(x) == hash) &&
+	(equal(sc, key, hash_entry_key(x), NULL)))
+      return(x);
+  return(sc->unentry);
+}
+
+
+/* ---------------- hash c_functions ---------------- */
+static s7_int hash_map_c_function(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  s7_function f = c_function_call(hash_table_procedures_mapper(table));
+  return(integer(f(sc, with_list_t1(key))));
+}
+
+static s7_int hash_map_c_pointer(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  return(pointer_map(c_pointer(key)));
+}
+
+static s7_int hash_map_undefined(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  return(raw_string_hash((const uint8_t *)(undefined_name(key) + 1), undefined_name_length(key) - 1) + undefined_name_length(key));
+  /* undefined_name always starts with "#", so we omit it above */
+}
+
+static s7_int hash_map_iterator(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  /* cycles can happen here if the iterator_sequence contains the iterator and hash_loc checks that element */
+  return(type(iterator_sequence(key)) + hash_loc(sc, table, iterator_sequence(key)));
+}
+
+static hash_entry_t *hash_equal(s7_scheme *sc, s7_pointer table, s7_pointer key);
+
+static hash_entry_t *hash_c_function(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  if (is_pair(hash_table_procedures(table)))
+    {
+      s7_int hash_mask = hash_table_mask(table);
+      s7_function f = c_function_call(hash_table_procedures_checker(table));
+      s7_int hash = hash_loc(sc, table, key);
+      s7_int loc = hash & hash_mask;
+      set_car(sc->t2_1, key);
+      for (hash_entry_t *x = hash_table_element(table, loc); x; x = hash_entry_next(x))
+	if (hash_entry_raw_hash(x) == hash)
+	  {
+	    set_car(sc->t2_2, hash_entry_key(x));
+	    if (is_true(sc, f(sc, sc->t2_1)))
+	      return(x);
+	  }
+      return(sc->unentry);
+    }
+  return(hash_equal(sc, table, key));
+}
+
+static int32_t len_upto_100(s7_pointer p)
+{
+  int32_t i = 0;
+  for (s7_pointer x = p; (is_pair(x)) && (i < 100); i++, x = cdr(x));
+  return(i);
+}
+
+static s7_int hash_map_pair(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  /* len+loc(car) is not horrible, but it means (for example) every list '(set! ...) is hashed to the same location,
+   *   so at least we need to take cadr into account if possible.  Better would combine the list_length (or tree-leaves == tree_len(sc, p))
+   *   with stats like symbols/pairs/constants at top level, then use those to spread it out over all the locs.
+   *   key can be cyclic, so tree_len would need to check for cycles.
+   */
+  s7_pointer p1 = cdr(key);
+  s7_int loc = 0;
+
+  if (!is_sequence_or_iterator(car(key)))
+    loc = hash_loc(sc, table, car(key)) + 1;
+  else
+    if ((is_pair(car(key))) &&
+	(!is_sequence_or_iterator(caar(key))))
+      loc = hash_loc(sc, table, caar(key)) + 1;
+  if (is_pair(p1))
+    {
+      if (!is_sequence_or_iterator(car(p1)))
+	loc += hash_loc(sc, table, car(p1)) + 1;
+      else
+	if ((is_pair(car(p1))) &&
+	    (!is_sequence_or_iterator(caar(p1))))
+	  loc += hash_loc(sc, table, caar(p1)) + 1;
+    }
+  else
+    if (!is_sequence_or_iterator(p1)) /* include () */
+      loc += hash_loc(sc, table, p1);
+  return((loc << 3) + len_upto_100(key));
+}
+
+static hash_entry_t *hash_closure(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  if (is_pair(hash_table_procedures(table)))
+    {
+      s7_int hash_mask = hash_table_mask(table);
+      s7_pointer f = hash_table_procedures_checker(table);
+      s7_int hash = hash_loc(sc, table, key);
+      s7_int loc = hash & hash_mask;
+      for (hash_entry_t *x = hash_table_element(table, loc); x; x = hash_entry_next(x))
+	if ((hash_entry_raw_hash(x) == hash) &&
+	    (is_true(sc, s7_call(sc, f, set_plist_2(sc, key, hash_entry_key(x))))))
+	  return(x);
+      return(sc->unentry);
+    }
+  return(hash_equal(sc, table, key));
+}
+
+static hash_entry_t *hash_equal(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  return((*(equal_hash_checks[type(key)]))(sc, table, key));
+}
+
+/* ---------------- hash equivalent? ---------------- */
+static hash_entry_t *hash_equivalent(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  hash_entry_t *x;
+  s7_int hash, loc;
+
+  if (is_number(key))
+    {
+#if WITH_GMP
+      if (!is_nan_b_7p(sc, key))
+	return(hash_number_equivalent(sc, table, key));
+#else
+      x = hash_number_equivalent(sc, table, key);
+      if ((x != sc->unentry) || (!is_nan_b_7p(sc, key)))
+	return(x);
+#endif
+      for (x = hash_table_element(table, 0); x; x = hash_entry_next(x)) /* NaN is mapped to 0 */
+	if (is_nan_b_7p(sc, hash_entry_key(x)))  /* all NaN's are the same to equivalent? */
+	  return(x);
+      return(sc->unentry);
+    }
+  hash = hash_loc(sc, table, key);
+  loc = hash & hash_table_mask(table);
+  for (x = hash_table_element(table, loc); x; x = hash_entry_next(x))
+    if (hash_entry_key(x) == key)
+      return(x);
+
+  for (x = hash_table_element(table, loc); x; x = hash_entry_next(x))
+    if ((hash_entry_raw_hash(x) == hash) &&
+	(s7_is_equivalent(sc, hash_entry_key(x), key)))
+      return(x);
+  return(sc->unentry);
+}
+
+static bool hash_keys_not_cyclic(s7_scheme *sc, s7_pointer hash)
+{
+  return((is_null(hash_table_procedures(hash))) &&
+	 (hash_table_mapper(hash) == default_hash_map) &&
+	 (hash_table_checker(hash) != hash_equal) &&
+	 (hash_table_checker(hash) != hash_equivalent) &&
+	 (hash_table_checker(hash) != hash_closure) &&
+	 (hash_table_checker(hash) != hash_c_function));
+}
+
+
+/* -------------------------------- make-hash-table -------------------------------- */
+s7_pointer s7_make_hash_table(s7_scheme *sc, s7_int size)
+{
+  s7_pointer table;
+  block_t *els;
+  /* size is rounded up to the next power of 2 */
+
+  if (size < 2)
+    size = 2;
+  else
+    if ((size & (size - 1)) != 0)          /* already 2^n ? */
+      {
+	if ((size & (size + 1)) != 0)      /* already 2^n - 1 ? */
+	  {
+	    size--;
+	    size |= (size >> 1);
+	    size |= (size >> 2);
+	    size |= (size >> 4);
+	    size |= (size >> 8);
+	    size |= (size >> 16);
+	    size |= (size >> 32);
+	  }
+	size++;
+      }
+  els = (block_t *)callocate(sc, size * sizeof(hash_entry_t *));
+  new_cell(sc, table, T_HASH_TABLE | T_SAFE_PROCEDURE);
+  hash_table_mask(table) = size - 1;
+  hash_table_set_block(table, els);
+  hash_table_elements(table) = (hash_entry_t **)(block_data(els));
+  hash_table_checker(table) = hash_empty;
+  hash_table_mapper(table) = default_hash_map;
+  hash_table_entries(table) = 0;
+  hash_table_set_procedures(table, sc->nil);
+  add_hash_table(sc, table);
+  return(table);
+}
+
+static bool compatible_types(s7_scheme *sc, const s7_pointer eq_type, const s7_pointer value_type)
+{
+  if (eq_type == sc->T) return(true);
+  if (eq_type == value_type) return(true);
+  if (eq_type == sc->is_number_symbol)              /* only = among built-ins, so other cases aren't needed */
+    return((value_type == sc->is_integer_symbol) ||
+	   (value_type == sc->is_real_symbol) ||
+	   (value_type == sc->is_complex_symbol) ||
+	   (value_type == sc->is_rational_symbol));
+  return(false);
+}
+
+static s7_pointer g_is_equal(s7_scheme *sc, s7_pointer args);
+static s7_pointer g_is_equivalent(s7_scheme *sc, s7_pointer args);
+
+static s7_pointer g_make_hash_table_1(s7_scheme *sc, s7_pointer args, s7_pointer caller)
+{
+  #define H_make_hash_table "(make-hash-table (size 8) eq-func typer) returns a new hash table. eq-func is the function \
+used to check equality of keys; it usually defaults to equal?. typer sets the types of the keys and values that are allowed \
+in the table; it is a cons, defaulting to (cons #t #t) which means any types are allowed.\n"
+  #define Q_make_hash_table s7_make_signature(sc, 4, sc->is_hash_table_symbol, sc->is_integer_symbol, \
+					      s7_make_signature(sc, 3, sc->is_procedure_symbol, sc->is_pair_symbol, sc->not_symbol), \
+					      s7_make_signature(sc, 2, sc->is_pair_symbol, sc->not_symbol))
+  s7_int size = sc->default_hash_table_length;
+
+  if (is_not_null(args))
+    {
+      s7_pointer p = car(args);
+      if (!s7_is_integer(p))
+	return(method_or_bust(sc, p, caller, args, sc->type_names[T_INTEGER], 1));
+      size = s7_integer_clamped_if_gmp(sc, p);
+      if (size <= 0)                      /* we need s7_int here to catch (make-hash-table most-negative-fixnum) etc */
+	out_of_range_error_nr(sc, caller, int_one, p, wrap_string(sc, "it should be a positive integer", 31));
+      if ((size > sc->max_vector_length) ||
+	  (size >= (1LL << 32LL)))
+	out_of_range_error_nr(sc, caller, int_one, p, it_is_too_large_string);
+
+      if (is_not_null(cdr(args)))
+	{
+	  s7_pointer proc;
+	  s7_pointer ht = s7_make_hash_table(sc, size);
+	  /* check for typers */
+	  if (is_pair(cddr(args)))
+	    {
+	      s7_pointer typers = caddr(args);
+	      if (is_pair(typers))
+		{
+		  s7_pointer keyp = car(typers), valp = cdr(typers);
+		  if ((keyp != sc->T) || (valp != sc->T)) /* one of them is a type checker */
+		    {
+		      if (((keyp != sc->T) && (!is_c_function(keyp)) && (!is_any_closure(keyp))) ||
+			  ((valp != sc->T) && (!is_c_function(valp)) && (!is_any_closure(valp))))
+			wrong_type_error_nr(sc, caller, 3, typers, wrap_string(sc, "(key-type . value-type)", 23));
+
+		      if ((keyp != sc->T) &&
+			  (!s7_is_aritable(sc, keyp, 1)))
+			error_nr(sc, sc->wrong_type_arg_symbol,
+				 set_elist_3(sc, wrap_string(sc, "~A: in the third argument, ~S, (the key/value type checkers) both functions should take one argument", 100),
+					     caller, typers));
+		      hash_table_set_procedures(ht, make_hash_table_procedures(sc));
+		      hash_table_set_key_typer(ht, keyp);
+		      hash_table_set_value_typer(ht, valp);
+		      if (is_c_function(keyp))
+			{
+			  if (!c_function_name(keyp))
+			    error_nr(sc, sc->wrong_type_arg_symbol,
+				     set_elist_3(sc, wrap_string(sc, "~A: in the third argument, ~S, (the key/value type checkers) the first function is anonymous", 92),
+						 caller, typers));
+			  if (c_function_has_simple_elements(keyp))
+			    set_has_simple_keys(ht);
+			  if (!c_function_symbol(keyp))
+			    c_function_symbol(keyp) = make_symbol(sc, c_function_name(keyp), c_function_name_length(keyp));
+			  if (symbol_type(c_function_symbol(keyp)) != T_FREE)
+			    set_has_hash_key_type(ht);
+			  /* c_function_marker is not currently used in this context */
+
+			  /* now a consistency check for eq-func and key type */
+			  proc = cadr(args);
+			  if (is_c_function(proc))
+			    {
+			      s7_pointer eq_sig = c_function_signature(proc);
+			      if ((eq_sig) &&
+				  (is_pair(eq_sig)) &&
+				  (is_pair(cdr(eq_sig))) &&
+				  (!compatible_types(sc, cadr(eq_sig), c_function_symbol(keyp))))
+			    error_nr(sc, sc->wrong_type_arg_symbol,
+				     set_elist_3(sc, wrap_string(sc, "~A: in the third argument, the key type function is not compatible with the equality function: ~S", 97),
+						 caller, typers));
+			    }}
+		      else
+			if ((is_any_closure(keyp)) &&
+			    (!is_symbol(find_closure(sc, keyp, closure_let(keyp)))))
+			  error_nr(sc, sc->wrong_type_arg_symbol,
+				   set_elist_3(sc, wrap_string(sc, "~A: in the third argument, ~S, (the key/value type checkers) the first function is anonymous", 92),
+					       caller, typers));
+		      if ((valp != sc->T) &&
+			  (!s7_is_aritable(sc, valp, 1)))
+			error_nr(sc, sc->wrong_type_arg_symbol,
+				 set_elist_3(sc, wrap_string(sc, "~A: in the third argument, ~S, (the key/value type checkers) both functions should take one argument", 100),
+						caller, typers));
+		      if (is_c_function(valp))
+			{
+			  if (!c_function_name(valp))
+			    error_nr(sc, sc->wrong_type_arg_symbol,
+				     set_elist_3(sc, wrap_string(sc, "~A: in the third argument, ~S, (the key/value type checkers) the second function is anonymous", 93),
+						 caller, typers));
+			  if (c_function_has_simple_elements(valp))
+			    set_has_simple_values(ht);
+			  if (!c_function_symbol(valp))
+			    c_function_symbol(valp) = make_symbol(sc, c_function_name(valp), c_function_name_length(valp));
+			  if (symbol_type(c_function_symbol(valp)) != T_FREE)
+			    set_has_hash_value_type(ht);
+			}
+		      else
+			if ((is_any_closure(valp)) &&
+			    (!is_symbol(find_closure(sc, valp, closure_let(valp)))))
+			  error_nr(sc, sc->wrong_type_arg_symbol,
+				   set_elist_3(sc, wrap_string(sc, "~A: in the third argument, ~S, (the key/value type checkers) the second function is anonymous", 93),
+					       caller, typers));
+		      set_is_typed_hash_table(ht);
+		    }}
+	      else
+		if (typers != sc->F)
+		  wrong_type_error_nr(sc, caller, 3, typers, wrap_string(sc, "either #f or (cons key-type-check value-type-check)", 51));
+	    }
+
+	  /* check eq_func */
+	  proc = cadr(args);
+
+	  if (is_c_function(proc))
+	    {
+	      hash_set_chosen(ht);
+
+	      if (!s7_is_aritable(sc, proc, 2))
+		wrong_type_error_nr(sc, caller, 2, proc, an_eq_func_string);
+
+	      if (c_function_call(proc) == g_is_equal)
+		{
+		  hash_table_checker(ht) = hash_equal;
+		  return(ht);
+		}
+	      if (c_function_call(proc) == g_is_equivalent)
+		{
+		  hash_table_checker(ht) = hash_equivalent;
+		  hash_table_mapper(ht) = equivalent_hash_map; /* needed only by hash_table_equal_1 (checker_locked looks at mapper?!) */
+		  return(ht);
+		}
+	      if (c_function_call(proc) == g_is_eq)
+		{
+		  hash_table_checker(ht) = hash_eq;
+		  hash_table_mapper(ht) = eq_hash_map;
+		  return(ht);
+		}
+	      if (c_function_call(proc) == g_strings_are_equal)
+		{
+		  hash_table_checker(ht) = hash_string;
+		  hash_table_mapper(ht) = string_eq_hash_map;
+		  return(ht);
+		}
+#if (!WITH_PURE_S7)
+	      if (c_function_call(proc) == g_strings_are_ci_equal)
+		{
+		  hash_table_checker(ht) = hash_ci_string;
+		  hash_table_mapper(ht) = string_ci_eq_hash_map;
+		  return(ht);
+		}
+	      if (c_function_call(proc) == g_chars_are_ci_equal)
+		{
+		  hash_table_checker(ht) = hash_ci_char;
+		  hash_table_mapper(ht) = char_ci_eq_hash_map;
+		  return(ht);
+		}
+#endif
+	      if (c_function_call(proc) == g_chars_are_equal)
+		{
+		  hash_table_checker(ht) = hash_char;
+		  hash_table_mapper(ht) = char_eq_hash_map;
+		  return(ht);
+		}
+	      if (c_function_call(proc) == g_num_eq)
+		{
+		  if ((is_typed_hash_table(ht)) &&
+		      (hash_table_key_typer(ht) == global_value(sc->is_integer_symbol)))
+		    hash_table_checker(ht) = hash_int;
+		  else hash_table_checker(ht) = hash_number_num_eq;
+		  return(ht);
+		}
+	      if (c_function_call(proc) == g_is_eqv)
+		{
+		  hash_table_checker(ht) = hash_eqv;
+		  return(ht);
+		}
+	      error_nr(sc, sc->out_of_range_symbol,
+		       set_elist_3(sc, wrap_string(sc, "~A second argument, ~S, is not a built-in function it can handle", 64), caller, proc));
+	    }
+	  /* proc not c_function */
+	  else
+	    {
+	      if (is_pair(proc))
+		{
+		  s7_pointer checker = car(proc), mapper = cdr(proc);
+
+		  hash_set_chosen(ht);
+		  if (!((is_any_c_function(checker)) ||
+			(is_any_closure(checker))))
+		    error_nr(sc, sc->wrong_type_arg_symbol,
+			     set_elist_4(sc, wrap_string(sc, "~A: first entry of type info, ~A, is ~A, but should be a function", 65),
+					 caller, checker, type_name_string(sc, checker)));
+		  if (!((is_any_c_function(mapper)) ||
+			(is_any_closure(mapper))))
+		    error_nr(sc, sc->wrong_type_arg_symbol,
+			     set_elist_4(sc, wrap_string(sc, "~A: second entry of type info, ~A, is ~A, but should be a function", 66),
+					 caller, mapper, type_name_string(sc, mapper)));
+
+		  if (!(s7_is_aritable(sc, checker, 2)))
+		    error_nr(sc, sc->wrong_type_arg_symbol,
+			     set_elist_3(sc, wrap_string(sc, "~A's equality function, ~A, (car of the second argument) should be a function of two arguments", 94),
+					 caller, checker));
+		  if (!(s7_is_aritable(sc, mapper, 1)))
+		    error_nr(sc, sc->wrong_type_arg_symbol,
+			     set_elist_3(sc, wrap_string(sc, "~A's mapping function, ~A, (cdr of the second argument) should be a function of one argument", 92),
+					 caller, mapper));
+
+		  if (is_any_c_function(checker))
+		    {
+		      s7_pointer sig = c_function_signature(checker);
+		      if ((sig) &&
+			  (is_pair(sig)) &&
+			  (car(sig) != sc->is_boolean_symbol))
+			error_nr(sc, sc->wrong_type_arg_symbol,
+				 set_elist_3(sc, wrap_string(sc, "~A checker function, ~S, should return a boolean value", 54), caller, checker));
+		      hash_table_checker(ht) = hash_c_function;
+		    }
+		  else hash_table_checker(ht) = hash_closure;
+
+		  if (is_any_c_function(mapper))
+		    {
+		      s7_pointer sig = c_function_signature(mapper);
+		      if ((sig) &&
+			  (is_pair(sig)) &&
+			  (car(sig) != sc->is_integer_symbol))
+			error_nr(sc, sc->wrong_type_arg_symbol,
+				 set_elist_3(sc, wrap_string(sc, "~A mapper function, ~S, should return an integer", 48), caller, mapper));
+		      hash_table_mapper(ht) = c_function_hash_map;
+		    }
+		  else hash_table_mapper(ht) = closure_hash_map;
+
+		  if (is_null(hash_table_procedures(ht)))
+		    hash_table_set_procedures(ht, make_hash_table_procedures(sc));
+		  hash_table_set_procedures_checker(ht, car(proc)); /* proc = cadr(args) */
+		  hash_table_set_procedures_mapper(ht, cdr(proc));
+		  return(ht);
+		}
+	      if (proc != sc->F)
+		  wrong_type_error_nr(sc, caller, 2, proc, wrap_string(sc, "either #f or (cons equality-func map-func)", 42));
+	      return(ht);
+	    }}}
+  return(s7_make_hash_table(sc, size));
+}
+
+static s7_pointer g_make_hash_table(s7_scheme *sc, s7_pointer args)
+{
+  return(g_make_hash_table_1(sc, args, sc->make_hash_table_symbol));
+}
+
+
+/* -------------------------------- make-weak-hash-table -------------------------------- */
+static s7_pointer g_make_weak_hash_table(s7_scheme *sc, s7_pointer args)
+{
+  #define H_make_weak_hash_table "(make-weak-hash-table (size 8) eq-func typers) returns a new weak hash table"
+  #define Q_make_weak_hash_table s7_make_signature(sc, 4, sc->is_weak_hash_table_symbol, sc->is_integer_symbol, \
+						   s7_make_signature(sc, 3, sc->is_procedure_symbol, sc->is_pair_symbol, sc->not_symbol), \
+						   s7_make_signature(sc, 2, sc->is_pair_symbol, sc->not_symbol))
+  s7_pointer table = g_make_hash_table_1(sc, args, sc->make_weak_hash_table_symbol);
+  set_weak_hash_table(table);
+  weak_hash_iters(table) = 0;
+  return(table);
+}
+
+static const char *hash_table_checker_name(s7_scheme *sc, s7_pointer ht)
+{
+  if (hash_table_checker(ht) == hash_equal) return("equal?");
+  if (hash_table_checker(ht) == hash_equivalent) return("equivalent?");
+  if (hash_table_checker(ht) == hash_eq) return("eq?");
+  if (hash_table_checker(ht) == hash_eqv) return("eqv?");
+  if (hash_table_checker(ht) == hash_string) return("string=?");
+#if (!WITH_PURE_S7)
+  if (hash_table_checker(ht) == hash_ci_string) return("string-ci=?");
+  if (hash_table_checker(ht) == hash_ci_char) return("char-ci=?");
+#endif
+  if (hash_table_checker(ht) == hash_char) return("char=?");
+  if (hash_table_checker(ht) == hash_number_num_eq) return("=");
+  return("#f");
+}
+
+
+/* -------------------------------- weak-hash-table? -------------------------------- */
+static s7_pointer g_is_weak_hash_table(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_weak_hash_table "(weak-hash-table? obj) returns #t if obj is a weak hash-table"
+  #define Q_is_weak_hash_table sc->pl_bt
+  #define is_weak_hash(p) ((is_hash_table(p)) && (is_weak_hash_table(p)))
+  check_boolean_method(sc, is_weak_hash, sc->is_weak_hash_table_symbol, args);
+}
+
+static void init_hash_maps(void)
+{
+  for (int32_t i = 0; i < NUM_TYPES; i++)
+    {
+      default_hash_map[i] = hash_map_nil;
+      string_eq_hash_map[i] = hash_map_nil;
+      char_eq_hash_map[i] = hash_map_nil;
+#if (!WITH_PURE_S7)
+      string_ci_eq_hash_map[i] = hash_map_nil;
+      char_ci_eq_hash_map[i] = hash_map_nil;
+#endif
+      closure_hash_map[i] = hash_map_closure;
+      c_function_hash_map[i] = hash_map_c_function;
+      eq_hash_map[i] = hash_map_eq;
+
+      equal_hash_checks[i] = hash_equal_any;
+      default_hash_checks[i] = hash_equal;
+    }
+  default_hash_map[T_CHARACTER] =     hash_map_char;
+  default_hash_map[T_SYMBOL] =        hash_map_symbol;
+  default_hash_map[T_SYNTAX] =        hash_map_syntax;
+  default_hash_map[T_STRING] =        hash_map_string;
+  default_hash_map[T_BYTE_VECTOR] =   hash_map_byte_vector;
+  default_hash_map[T_HASH_TABLE] =    hash_map_hash_table;
+  default_hash_map[T_VECTOR] =        hash_map_vector;
+  default_hash_map[T_INT_VECTOR] =    hash_map_int_vector;
+  default_hash_map[T_FLOAT_VECTOR] =  hash_map_float_vector;
+  default_hash_map[T_LET] =           hash_map_let;
+  default_hash_map[T_PAIR] =          hash_map_pair;
+  default_hash_map[T_C_POINTER] =     hash_map_c_pointer;
+  default_hash_map[T_UNDEFINED] =     hash_map_undefined;
+  default_hash_map[T_ITERATOR] =      hash_map_iterator;
+  for (int32_t i = T_OUTPUT_PORT; i < NUM_TYPES; i++)
+    default_hash_map[i] = hash_map_eq;
+
+  default_hash_map[T_INTEGER] =       hash_map_int;
+  default_hash_map[T_RATIO] =         hash_map_ratio;
+  default_hash_map[T_REAL] =          hash_map_real;
+  default_hash_map[T_COMPLEX] =       hash_map_complex;
+#if WITH_GMP
+  default_hash_map[T_BIG_INTEGER] =   hash_map_big_int;
+  default_hash_map[T_BIG_RATIO] =     hash_map_big_ratio;
+  default_hash_map[T_BIG_REAL] =      hash_map_big_real;
+  default_hash_map[T_BIG_COMPLEX] =   hash_map_big_complex;
+#endif
+
+  string_eq_hash_map[T_STRING] =      hash_map_string;
+  string_eq_hash_map[T_BYTE_VECTOR] = hash_map_byte_vector;
+  char_eq_hash_map[T_CHARACTER] =     hash_map_char;
+#if (!WITH_PURE_S7)
+  string_ci_eq_hash_map[T_STRING] =   hash_map_ci_string;
+  char_ci_eq_hash_map[T_CHARACTER] =  hash_map_ci_char;
+#endif
+
+  for (int32_t i = 0; i < NUM_TYPES; i++)
+    equivalent_hash_map[i] = default_hash_map[i];
+
+  equal_hash_checks[T_SYNTAX] =       hash_equal_syntax;
+  equal_hash_checks[T_SYMBOL] =       hash_equal_eq;
+  equal_hash_checks[T_CHARACTER] =    hash_equal_eq;
+  equal_hash_checks[T_INTEGER] =      hash_equal_integer;
+  equal_hash_checks[T_RATIO] =        hash_equal_ratio;
+  equal_hash_checks[T_REAL] =         hash_equal_real;
+  equal_hash_checks[T_COMPLEX] =      hash_equal_complex;
+
+  default_hash_checks[T_STRING] =     hash_string;
+  default_hash_checks[T_INTEGER] =    hash_int;
+  default_hash_checks[T_REAL] =       hash_float;
+  default_hash_checks[T_SYMBOL] =     hash_symbol;
+  default_hash_checks[T_CHARACTER] =  hash_char;
+}
+
+#if S7_DEBUGGING & (0)
+static s7_pointer hash_table_to_let(s7_scheme *sc, s7_pointer obj);
+#endif
+
+static void resize_hash_table(s7_scheme *sc, s7_pointer table)
+{
+  s7_int entries = hash_table_entries(table);
+  hash_entry_t **old_els = hash_table_elements(table);
+  s7_pointer dproc = hash_table_procedures(table); /* new block_t so we need to pass this across */
+  s7_int old_size = hash_table_size(table);
+  s7_int new_size = old_size * 4;
+  s7_int hash_mask = new_size - 1;
+#if S7_DEBUGGING & (0)
+  s7_pointer old_data = s7_gc_protect_via_stack(sc, slot_value(symbol_to_local_slot(sc, make_symbol(sc, "stats:0|1|2|n|max", 17), hash_table_to_let(sc, table))));
+#endif
+  block_t *np = (block_t *)callocate(sc, new_size * sizeof(hash_entry_t *));
+  hash_entry_t **new_els = (hash_entry_t **)(block_data(np));
+
+  for (s7_int i = 0; i < old_size; i++)
+    {
+      hash_entry_t *n;
+      for (hash_entry_t *x = old_els[i]; x; x = n)
+	{
+	  s7_int loc = hash_entry_raw_hash(x) & hash_mask;
+	  n = hash_entry_next(x);
+	  hash_entry_next(x) = new_els[loc];
+	  new_els[loc] = x;
+	}}
+  liberate(sc, hash_table_block(table));
+  hash_table_set_block(table, np);
+  hash_table_elements(table) = new_els;
+  hash_table_mask(table) = hash_mask; /* was new_size - 1 14-Jun-21 */
+  hash_table_set_procedures(table, dproc);
+  hash_table_entries(table) = entries;
+#if S7_DEBUGGING & (0)
+  fprintf(stderr, "%s: %s -> ", __func__, display(old_data));
+  unstack_gc_protect(sc);
+  fprintf(stderr, "%s\n", display(slot_value(symbol_to_local_slot(sc, make_symbol(sc, "stats:0|1|2|n|max", 17), hash_table_to_let(sc, table)))));
+#endif
+}
+
+
+/* -------------------------------- hash-table-ref -------------------------------- */
+s7_pointer s7_hash_table_ref(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  return(hash_entry_value((*hash_table_checker(table))(sc, table, key)));
+}
+
+static s7_pointer g_hash_table_ref(s7_scheme *sc, s7_pointer args)
+{
+  #define H_hash_table_ref "(hash-table-ref table key) returns the value associated with key in the hash table"
+  #define Q_hash_table_ref s7_make_circular_signature(sc, 2, 3, sc->T, sc->is_hash_table_symbol, sc->T)
+
+  s7_pointer table = car(args), nt;
+  if (!is_hash_table(table))
+    return(method_or_bust(sc, table, sc->hash_table_ref_symbol, args, sc->type_names[T_HASH_TABLE], 1));
+  nt = s7_hash_table_ref(sc, table, cadr(args));
+
+  if (is_pair(cddr(args)))
+    return(ref_index_checked(sc, global_value(sc->hash_table_ref_symbol), nt, args));
+  return(nt);
+}
+
+static s7_pointer g_hash_table_ref_2(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer table = car(args);
+  if (!is_hash_table(table))
+    return(method_or_bust(sc, table, sc->hash_table_ref_symbol, args, sc->type_names[T_HASH_TABLE], 1));
+  return(hash_entry_value((*hash_table_checker(table))(sc, table, cadr(args))));
+}
+
+static s7_pointer hash_table_ref_p_pp(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  if (!is_hash_table(table))
+    return(method_or_bust(sc, table, sc->hash_table_ref_symbol, set_plist_2(sc, table, key), sc->type_names[T_HASH_TABLE], 1));
+  return(hash_entry_value((*hash_table_checker(table))(sc, table, key)));
+}
+
+static bool op_implicit_hash_table_ref_a(s7_scheme *sc)
+{
+  s7_pointer s = lookup_checked(sc, car(sc->code));
+  if (!is_hash_table(s)) {sc->last_function = s; return(false);}
+  sc->value = s7_hash_table_ref(sc, s, fx_call(sc, cdr(sc->code)));
+  return(true);
+}
+
+static s7_pointer fx_implicit_hash_table_ref_a(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer s = lookup_checked(sc, car(arg));
+  if (!is_hash_table(s))
+    return(s7_apply_function(sc, s, list_1(sc, fx_call(sc, cdr(arg)))));
+  return(s7_hash_table_ref(sc, s, fx_call(sc, cdr(arg))));
+}
+
+static bool op_implicit_hash_table_ref_aa(s7_scheme *sc)
+{
+  s7_pointer in_obj, out_key;
+  s7_pointer table = lookup_checked(sc, car(sc->code));
+  if (!is_hash_table(table)) {sc->last_function = table; return(false);}
+  out_key = fx_call(sc, cdr(sc->code));
+  in_obj = s7_hash_table_ref(sc, table, out_key);
+  if (is_hash_table(in_obj))
+    sc->value = s7_hash_table_ref(sc, in_obj, fx_call(sc, cddr(sc->code)));
+  else sc->value = implicit_pair_index_checked(sc, table, in_obj, set_plist_2(sc, out_key, fx_call(sc, cddr(sc->code)))); /* -> implicit_index */
+  return(true);
+}
+
+static s7_pointer hash_table_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  if (args == 2)
+    {
+      s7_pointer key = caddr(expr);
+      if ((is_pair(key)) && (car(key) == sc->substring_symbol) && (is_global(sc->substring_symbol)))
+	set_c_function(key, sc->substring_uncopied);
+      return(sc->hash_table_ref_2);
+    }
+ return(f);
+}
+
+
+/* -------------------------------- hash-table-set! -------------------------------- */
+static s7_pointer remove_from_hash_table(s7_scheme *sc, s7_pointer table, hash_entry_t *p)
+{
+  hash_entry_t *x;
+  s7_int hash_mask, loc;
+
+  if (p == sc->unentry) return(sc->F);
+  hash_mask = hash_table_mask(table);
+  loc = hash_entry_raw_hash(p) & hash_mask;
+  x = hash_table_element(table, loc);
+  if (x == p)
+    hash_table_element(table, loc) = hash_entry_next(x);
+  else
+    {
+      hash_entry_t *y;
+      for (y = x, x = hash_entry_next(x); x; y = x, x = hash_entry_next(x))
+	if (x == p)
+	  {
+	    hash_entry_next(y) = hash_entry_next(x);
+	    break;
+	  }}
+  hash_table_entries(table)--;
+  if ((hash_table_entries(table) == 0) &&
+      (hash_table_mapper(table) == default_hash_map))
+    {
+      hash_table_checker(table) = hash_empty;
+      hash_clear_chosen(table);
+    }
+  liberate_block(sc, x);
+  return(sc->F);
+}
+
+static void cull_weak_hash_table(s7_scheme *sc, s7_pointer table)
+{
+  s7_int len = hash_table_size(table);
+  hash_entry_t **entries = hash_table_elements(table);
+  for (s7_int i = 0; i < len; i++)
+    {
+      hash_entry_t *nxp, *lxp = entries[i];
+      for (hash_entry_t *xp = entries[i]; xp; xp = nxp)
+	{
+	  nxp = hash_entry_next(xp);
+	  if (is_free_and_clear(hash_entry_key(xp)))
+	    {
+	      if (xp == entries[i])
+		{
+		  entries[i] = nxp;
+		  lxp = nxp;
+		}
+	      else hash_entry_next(lxp) = nxp;
+	      liberate_block(sc, xp);
+	      hash_table_entries(table)--;
+	      if (hash_table_entries(table) == 0)
+		{
+		  if (hash_table_mapper(table) == default_hash_map)
+		    {
+		      hash_table_checker(table) = hash_empty;
+		      hash_clear_chosen(table);
+		    }
+		  return;
+		}}
+	  else lxp = xp;
+	}}
+}
+
+static void hash_table_set_default_checker(s7_pointer table, uint8_t typ)
+{
+  if (hash_table_checker(table) != default_hash_checks[typ])
+    {
+      if (hash_table_checker(table) == hash_empty)
+	hash_table_checker(table) = default_hash_checks[typ];
+      else
+	{
+	  hash_table_checker(table) = hash_equal;
+	  hash_set_chosen(table);
+	}}
+}
+
+static s7_pointer hash_table_typer_symbol(s7_scheme *sc, s7_pointer typer)
+{
+  if (typer == sc->T)
+    return(sc->T);
+  return((is_c_function(typer)) ? c_function_symbol(typer) : find_closure(sc, typer, closure_let(typer)));
+}
+
+static void check_hash_types(s7_scheme *sc, s7_pointer table, s7_pointer key, s7_pointer value)
+{
+  if (has_hash_key_type(table)) /* symbol_type and c_function_symbol exist and symbol_type is not T_FREE */
+    {
+      s7_pointer typer = hash_table_key_typer(table);
+      if ((is_c_function(typer)) && ((uint8_t)symbol_type(c_function_symbol(typer)) != type(key)))
+	{
+	  const char *tstr = make_type_name(sc, hash_table_typer_name(sc, hash_table_key_typer(table)), INDEFINITE_ARTICLE);
+	  wrong_type_error_nr(sc, wrap_string(sc, "hash-table-set! key", 19), 2, key, wrap_string(sc, tstr, safe_strlen(tstr)));
+	}}
+  else
+    {
+      s7_pointer kf = hash_table_key_typer(table);
+      if (kf != sc->T)
+	{
+	  s7_pointer type_ok;
+	  if (is_c_function(kf))
+	    type_ok = c_function_call(kf)(sc, set_plist_1(sc, key));
+	  else type_ok = s7_apply_function(sc, kf, set_plist_1(sc, key));
+	  if (type_ok == sc->F)
+	    {
+	      const char *descr = hash_table_typer_name(sc, hash_table_key_typer(table));
+	      error_nr(sc, sc->wrong_type_arg_symbol,
+		       set_elist_4(sc, wrap_string(sc, "hash-table-set! second argument ~$, is ~A, but the hash-table's key type checker, ~A, rejects it", 96),
+				   key, type_name_string(sc, key), wrap_string(sc, descr, safe_strlen(descr))));
+	    }}}
+  if (has_hash_value_type(table))
+    {
+      s7_pointer typer = hash_table_value_typer(table);
+      if ((is_c_function(typer)) && ((uint8_t)symbol_type(c_function_symbol(typer)) != type(value)))
+	{
+	  const char *tstr = make_type_name(sc, hash_table_typer_name(sc, hash_table_value_typer(table)), INDEFINITE_ARTICLE);
+	  wrong_type_error_nr(sc, sc->hash_table_set_symbol, 3, value, wrap_string(sc, tstr, safe_strlen(tstr)));
+	}}
+  else
+    {
+      s7_pointer vf = hash_table_value_typer(table);
+      if (vf != sc->T)
+	{
+	  s7_pointer type_ok;
+	  if (is_c_function(vf))
+	    type_ok = c_function_call(vf)(sc, set_plist_1(sc, value));
+	  else type_ok = s7_apply_function(sc, vf, set_plist_1(sc, value));
+	  if (type_ok == sc->F)
+	    {
+	      const char *descr = hash_table_typer_name(sc, hash_table_value_typer(table));
+	      error_nr(sc, sc->wrong_type_arg_symbol,
+		       set_elist_4(sc, wrap_string(sc, "hash-table-set! third argument ~$, is ~A, but the hash-table's value type checker, ~A, rejects it", 97),
+				   value, type_name_string(sc, value), wrap_string(sc, descr, safe_strlen(descr))));
+	    }}}
+}
+
+static void check_hash_table_checker(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  /* check type -- raise error if incompatible with eq func set by make-hash-table */
+  if (hash_table_checker(table) == hash_number_num_eq)
+    {
+      if (!is_number(key))
+	error_nr(sc, sc->wrong_type_arg_symbol,
+		 set_elist_3(sc, wrap_string(sc, "hash-table-set! key ~S, is ~A, but the hash-table's key function is =", 69),
+			     key, type_name_string(sc, key)));
+    }
+  else
+    if (hash_table_checker(table) == hash_eq)
+      {
+	if (is_number(key)) /* (((type(key) >= T_INTEGER) && (type(key) < T_C_MACRO)) || (type(key) == T_PAIR)), but we might want eq? */
+	  error_nr(sc, sc->wrong_type_arg_symbol,
+		   set_elist_3(sc, wrap_string(sc, "hash-table-set! key ~S, is ~A, but the hash-table's key function is eq?", 71),
+			       key, type_name_string(sc, key)));
+      }
+    else
+#if WITH_PURE_S7
+      if (((hash_table_checker(table) == hash_string) && (!is_string(key))) ||
+	  ((hash_table_checker(table) == hash_char) && (!is_character(key))))
+	error_nr(sc, sc->wrong_type_arg_symbol,
+		 set_elist_4(sc, wrap_string(sc, "hash-table-set! key ~S, is ~A, but the hash-table's key function is ~A", 70),
+			     key, type_name_string(sc, key),
+			     (hash_table_checker(table) == hash_string) ? sc->string_eq_symbol : sc->char_eq_symbol));
+#else
+      if ((((hash_table_checker(table) == hash_string) || (hash_table_checker(table) == hash_ci_string)) &&
+	   (!is_string(key))) ||
+	  (((hash_table_checker(table) == hash_char) || (hash_table_checker(table) == hash_ci_char)) &&
+	   (!is_character(key))))
+	error_nr(sc, sc->wrong_type_arg_symbol,
+		 set_elist_4(sc, wrap_string(sc, "hash-table-set! key ~S, is ~A, but the hash-table's key function is ~A", 70),
+			     key, type_name_string(sc, key),
+			     (hash_table_checker(table) == hash_string) ? sc->string_eq_symbol :
+			     ((hash_table_checker(table) == hash_ci_string) ? sc->string_ci_eq_symbol :
+			      ((hash_table_checker(table) == hash_char) ? sc->char_eq_symbol : sc->char_ci_eq_symbol))));
+#endif
+}
+
+s7_pointer s7_hash_table_set(s7_scheme *sc, s7_pointer table, s7_pointer key, s7_pointer value)
+{
+  s7_int hash_mask, loc;
+  hash_entry_t *p, *x;
+
+  if (value == sc->F)
+    return(remove_from_hash_table(sc, table, (*hash_table_checker(table))(sc, table, key)));
+
+  if ((is_typed_hash_table(table)) && (sc->safety >= NO_SAFETY)) /* this order is faster */
+    check_hash_types(sc, table, key, value);
+
+  x = (*hash_table_checker(table))(sc, table, key);
+  if (x != sc->unentry)
+    {
+      hash_entry_set_value(x, T_Ext(value));
+      return(value);
+    }
+  /* hash_entry_raw_hash(x) can save the hash_loc from the lookup operations, but at some added complexity in
+   *   all the preceding code.  This saves about 5% compute time best case in this function.
+   */
+  if (!hash_chosen(table))
+    hash_table_set_default_checker(table, type(key)); /* raw_hash value (hash_loc(sc, table, key)) does not change via hash_table_set_default_checker etc */
+  else
+    if (sc->safety > NO_SAFETY)
+      check_hash_table_checker(sc, table, key);
+
+  p = mallocate_block(sc);
+#if S7_DEBUGGING
+  sc->blocks_mallocated[BLOCK_LIST]++;
+#endif
+  hash_entry_key(p) = key;
+  hash_entry_set_value(p, T_Ext(value));
+  hash_entry_set_raw_hash(p, hash_loc(sc, table, key));
+  hash_mask = hash_table_mask(table);
+  loc = hash_entry_raw_hash(p) & hash_mask;
+  hash_entry_next(p) = hash_table_element(table, loc);
+  hash_table_element(table, loc) = p;
+  hash_table_entries(table)++;
+  if (hash_table_entries(table) > hash_mask)
+    resize_hash_table(sc, table);
+  return(value);
+}
+
+static s7_pointer g_hash_table_set(s7_scheme *sc, s7_pointer args)
+{
+  #define H_hash_table_set "(hash-table-set! table key value) sets the value associated with key in the hash table to value"
+  #define Q_hash_table_set s7_make_signature(sc, 4, sc->T, sc->is_hash_table_symbol, sc->T, sc->T)
+
+  s7_pointer table = car(args);
+  if (!is_mutable_hash_table(table))
+    return(mutable_method_or_bust(sc, table, sc->hash_table_set_symbol, args, sc->type_names[T_HASH_TABLE], 1));
+  return(s7_hash_table_set(sc, table, cadr(args), caddr(args)));
+}
+
+static s7_pointer hash_table_set_p_ppp(s7_scheme *sc, s7_pointer p1, s7_pointer p2, s7_pointer p3)
+{
+  if (!is_mutable_hash_table(p1))  /* is_hash_table(p1) is here */
+    return(mutable_method_or_bust_ppp(sc, p1, sc->hash_table_set_symbol, p1, p2, p3, sc->type_names[T_HASH_TABLE], 1));
+  return(s7_hash_table_set(sc, p1, p2, p3));
+}
+
+static s7_pointer hash_table_set_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  if ((args == 3) && (optimize_op(expr) == HOP_SAFE_C_SSA))
+    {
+     s7_pointer val = cadddr(expr);
+     if ((is_pair(val)) && (car(val) == sc->add_symbol) && (is_proper_list_3(sc, val)) &&
+	 ((cadr(val) == int_one) || (caddr(val) == int_one)))
+       {
+	 s7_pointer add1 = (cadr(val) == int_one) ? caddr(val) : cadr(val);
+	 if ((is_pair(add1)) && (car(add1) == sc->or_symbol) && (is_proper_list_3(sc, add1)) &&
+	     (caddr(add1) == int_zero))
+	   {
+	     s7_pointer or1 = cadr(add1);
+	     if ((is_pair(or1)) && (car(or1) == sc->hash_table_ref_symbol) && (is_proper_list_3(sc, or1)) &&
+		 (cadr(or1) == cadr(expr)) && (caddr(or1) == caddr(expr)))
+	       /* (hash-table-set! counts p (+ (or (hash-table-ref counts p) 0) 1)) */
+	       set_optimize_op(expr, HOP_HASH_TABLE_INCREMENT);
+	   }}}
+ return(f);
+}
+
+
+/* -------------------------------- hash-table -------------------------------- */
+static inline s7_pointer hash_table_add(s7_scheme *sc, s7_pointer table, s7_pointer key, s7_pointer value)
+{
+  s7_int hash, hash_mask, loc;
+  hash_entry_t *p;
+
+  if (!hash_chosen(table))
+    hash_table_set_default_checker(table, type(key)); /* raw_hash value (hash_loc(sc, table, key)) does not change via hash_table_set_default_checker etc */
+
+  hash_mask = hash_table_mask(table);
+  hash = hash_loc(sc, table, key);
+  loc = hash & hash_mask;
+
+  for (hash_entry_t *x = hash_table_element(table, loc); x; x = hash_entry_next(x))
+    if ((hash_entry_raw_hash(x) == hash) &&
+	(s7_is_equal(sc, hash_entry_key(x), key)))
+      return(value);
+
+  p = mallocate_block(sc);
+#if S7_DEBUGGING
+  sc->blocks_mallocated[BLOCK_LIST]++;
+#endif
+  hash_entry_key(p) = key;
+  hash_entry_set_value(p, T_Ext(value));
+  hash_entry_set_raw_hash(p, hash);
+  hash_entry_next(p) = hash_table_element(table, loc);
+  hash_table_element(table, loc) = p;
+  hash_table_entries(table)++;
+  if (hash_table_entries(table) > hash_mask)
+    resize_hash_table(sc, table);
+  return(value);
+}
+
+static s7_pointer g_hash_table_1(s7_scheme *sc, s7_pointer args, s7_pointer caller)
+{
+  s7_pointer ht;
+  s7_int len = proper_list_length(args);
+  if (len & 1)
+    error_nr(sc, sc->wrong_number_of_args_symbol,
+	     set_elist_3(sc, wrap_string(sc, "~A got an odd number of arguments: ~S", 37), caller, args));
+  len /= 2;
+  if (len > sc->max_vector_length)
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_4(sc, wrap_string(sc, "~S passed too many entries (> ~D ~D) (*s7* 'max-vector-length)", 62),
+			 caller, wrap_integer(sc, len), wrap_integer(sc, sc->max_vector_length)));
+
+  ht = s7_make_hash_table(sc, (len > sc->default_hash_table_length) ? len : sc->default_hash_table_length);
+  if (len > 0)
+    for (s7_pointer x = args, y = cdr(args); is_pair(x); x = cddr(x), y = unchecked_cdr(cdr(y)))
+      if (car(y) != sc->F)
+	hash_table_add(sc, ht, car(x), car(y));
+  return(ht);
+}
+
+static s7_pointer g_hash_table(s7_scheme *sc, s7_pointer args)
+{
+  #define H_hash_table "(hash-table ...) returns a hash-table containing the symbol/value pairs passed as its arguments. \
+That is, (hash-table 'a 1 'b 2) returns a new hash-table with the two key/value pairs preinstalled."
+  #define Q_hash_table s7_make_circular_signature(sc, 1, 2, sc->is_hash_table_symbol, sc->T)
+  return(g_hash_table_1(sc, args, sc->hash_table_symbol));
+}
+
+static s7_pointer g_hash_table_2(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer ht = s7_make_hash_table(sc, sc->default_hash_table_length);
+  if (cadr(args) != sc->F)
+    hash_table_add(sc, ht, car(args), cadr(args));
+  return(ht);
+}
+
+
+/* -------------------------------- weak-hash-table -------------------------------- */
+static s7_pointer g_weak_hash_table(s7_scheme *sc, s7_pointer args)
+{
+  #define H_weak_hash_table "(weak-hash-table ...) returns a weak-hash-table containing the symbol/value pairs passed as its arguments. \
+That is, (weak-hash-table 'a 1 'b 2) returns a new weak-hash-table with the two key/value pairs preinstalled."
+  #define Q_weak_hash_table Q_hash_table
+
+  s7_pointer table = g_hash_table_1(sc, args, sc->weak_hash_table_symbol);
+  set_weak_hash_table(table);
+  weak_hash_iters(table) = 0;
+  return(table);
+}
+
+static s7_pointer hash_table_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer unused_expr)
+{
+  return((args == 2) ? sc->hash_table_2 : f);
+}
+
+static void check_old_hash(s7_scheme *sc, s7_pointer old_hash, s7_pointer new_hash, s7_int start, s7_int end)
+{
+  s7_int count = 0;
+  s7_int old_len = hash_table_size(old_hash);
+  hash_entry_t **old_lists = hash_table_elements(old_hash);
+  for (s7_int i = 0; i < old_len; i++)
+    for (hash_entry_t *x = old_lists[i]; x; x = hash_entry_next(x))
+      {
+	if (count >= end)
+	  return;
+	if (count >= start)
+	  check_hash_types(sc, new_hash, hash_entry_key(x), hash_entry_value(x));
+      }
+}
+
+static s7_pointer hash_table_copy(s7_scheme *sc, s7_pointer old_hash, s7_pointer new_hash, s7_int start, s7_int end)
+{
+  s7_int old_len, new_mask, count = 0;
+  hash_entry_t **old_lists, **new_lists;
+
+  if (is_typed_hash_table(new_hash))
+    check_old_hash(sc, old_hash, new_hash, start, end);
+
+  old_len = hash_table_size(old_hash);
+  new_mask = hash_table_mask(new_hash);
+  old_lists = hash_table_elements(old_hash);
+  new_lists = hash_table_elements(new_hash);
+
+  if (hash_table_entries(new_hash) == 0)
+    {
+      if ((start == 0) &&
+	  (end >= hash_table_entries(old_hash)))
+	{
+	  for (s7_int i = 0; i < old_len; i++)
+	    for (hash_entry_t *x = old_lists[i]; x; x = hash_entry_next(x))
+	      {
+		s7_int loc = hash_entry_raw_hash(x) & new_mask;
+		hash_entry_t *p = make_hash_entry(sc, hash_entry_key(x), hash_entry_value(x), hash_entry_raw_hash(x));
+		hash_entry_next(p) = new_lists[loc];
+		new_lists[loc] = p;
+	      }
+	  hash_table_entries(new_hash) = hash_table_entries(old_hash);
+	  return(new_hash);
+	}
+      for (s7_int i = 0; i < old_len; i++)
+	for (hash_entry_t *x = old_lists[i]; x; x = hash_entry_next(x))
+	  {
+	    if (count >= end)
+	      {
+		hash_table_entries(new_hash) = end - start;
+		return(new_hash);
+	      }
+	    if (count >= start)
+	      {
+		s7_int loc = hash_entry_raw_hash(x) & new_mask;
+		hash_entry_t *p = make_hash_entry(sc, hash_entry_key(x), hash_entry_value(x), hash_entry_raw_hash(x));
+		hash_entry_next(p) = new_lists[loc];
+		new_lists[loc] = p;
+	      }
+	    count++;
+	  }
+      hash_table_entries(new_hash) = count - start;
+      return(new_hash);
+    }
+
+  /* this can't be optimized much because we have to look for key matches (we're copying old_hash into the existing, non-empty new_hash) */
+  for (s7_int i = 0; i < old_len; i++)
+    for (hash_entry_t *x = old_lists[i]; x; x = hash_entry_next(x))
+      {
+	if (count >= end)
+	  return(new_hash);
+	if (count >= start)
+	  {
+	    hash_entry_t *y = (*hash_table_checker(new_hash))(sc, new_hash, hash_entry_key(x));
+	    if (y != sc->unentry)
+	      hash_entry_set_value(y, hash_entry_value(x));
+	    else
+	      {
+		s7_int loc = hash_entry_raw_hash(x) & new_mask;
+		hash_entry_t *p = make_hash_entry(sc, hash_entry_key(x), hash_entry_value(x), hash_entry_raw_hash(x));
+		hash_entry_next(p) = new_lists[loc];
+		new_lists[loc] = p;
+		hash_table_entries(new_hash)++;
+		if (!hash_chosen(new_hash))
+		  hash_table_set_default_checker(new_hash, type(hash_entry_key(x)));
+	      }}
+	count++;
+      }
+  return(new_hash);
+}
+
+static s7_pointer hash_table_fill(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer table = car(args), val = cadr(args);
+  if (is_immutable_hash_table(table))
+    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->fill_symbol, table));
+
+  if (hash_table_entries(table) > 0)
+    {
+      hash_entry_t **entries = hash_table_elements(table);
+      s7_int len = hash_table_size(table);   /* minimum len is 2 (see s7_make_hash_table) */
+      if (val == sc->F)                      /* hash-table-ref returns #f if it can't find a key, so val == #f here means empty the table */
+	{
+	  hash_entry_t **hp = entries;
+	  hash_entry_t **hn = (hash_entry_t **)(hp + len);
+	  for (; hp < hn; hp++)
+	    {
+	      if (*hp)
+		{
+		  hash_entry_t *p = *hp;
+		  while (hash_entry_next(p)) p = hash_entry_next(p);
+		  hash_entry_next(p) = sc->block_lists[BLOCK_LIST];
+		  sc->block_lists[BLOCK_LIST] = *hp;
+#if (S7_DEBUGGING)
+		  sc->blocks_mallocated[BLOCK_LIST]++;
+#endif
+		}
+	      hp++;
+	      if (*hp)
+		{
+		  hash_entry_t *p = *hp;
+		  while (hash_entry_next(p)) p = hash_entry_next(p);
+		  hash_entry_next(p) = sc->block_lists[BLOCK_LIST];
+		  sc->block_lists[BLOCK_LIST] = *hp;
+#if (S7_DEBUGGING)
+		  sc->blocks_mallocated[BLOCK_LIST]++;
+#endif
+		}}
+	  if (len >= 8)
+	    memclr64(entries, len * sizeof(hash_entry_t *));
+	  else memclr(entries, len * sizeof(hash_entry_t *));
+	  if (hash_table_mapper(table) == default_hash_map)
+	    {
+	      hash_table_checker(table) = hash_empty;
+	      hash_clear_chosen(table);
+	    }
+	  hash_table_entries(table) = 0;
+	  return(val);
+	}
+      if ((is_typed_hash_table(table)) &&
+	  (((is_c_function(hash_table_value_typer(table))) &&
+	    (c_function_call(hash_table_value_typer(table))(sc, set_plist_1(sc, val)) == sc->F)) ||
+	   ((is_any_closure(hash_table_value_typer(table))) &&
+	    (s7_apply_function(sc, hash_table_value_typer(table), set_plist_1(sc, val)) == sc->F))))
+	{
+	  const char *tstr = make_type_name(sc, hash_table_typer_name(sc, hash_table_value_typer(table)), INDEFINITE_ARTICLE);
+	  wrong_type_error_nr(sc, sc->fill_symbol, 2, val, wrap_string(sc, tstr, safe_strlen(tstr)));
+	}
+      for (s7_int i = 0; i < len; i++)
+	for (hash_entry_t *x = entries[i]; x; x = hash_entry_next(x))
+	  hash_entry_set_value(x, val);
+      /* keys haven't changed, so no need to mess with hash_table_checker */
+    }
+  return(val);
+}
+
+static s7_pointer hash_table_reverse(s7_scheme *sc, s7_pointer old_hash)
+{
+  s7_int len = hash_table_size(old_hash);
+  hash_entry_t **old_lists = hash_table_elements(old_hash);
+  s7_pointer new_hash = s7_make_hash_table(sc, len);
+  gc_protect_via_stack(sc, new_hash);
+
+  /* old_hash checker/mapper functions don't always make sense reversed, although the key/value typers might be ok */
+  for (s7_int i = 0; i < len; i++)
+    for (hash_entry_t *x = old_lists[i]; x; x = hash_entry_next(x))
+      s7_hash_table_set(sc, new_hash, hash_entry_value(x), hash_entry_key(x));
+
+  if (is_weak_hash_table(old_hash)) /* 17-May-23, not sure it makes sense to reverse a weak-hash-table but... */
+    {
+      set_weak_hash_table(new_hash);
+      weak_hash_iters(new_hash) = 0;
+    }
+  unstack_gc_protect(sc);
+  return(new_hash);
+}
+
+
+/* -------------------------------- functions -------------------------------- */
+bool s7_is_function(s7_pointer p) {return(is_c_function(p));}
+
+static s7_pointer fallback_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr) {return(f);}
+
+static void s7_function_set_class(s7_scheme *sc, s7_pointer f, s7_pointer base_f)
+{
+  c_function_class(f) = c_function_class(base_f);
+  c_function_set_base(f, base_f);
+}
+
+static s7_pointer make_function(s7_scheme *sc, const char *name, s7_function f, s7_int req, s7_int opt, bool rst, const char *doc, s7_pointer x, c_proc_t *ptr)
+{
+  set_full_type(x, ((req == 0) && (rst)) ? T_C_RST_NO_REQ_FUNCTION : T_C_FUNCTION);
+
+  c_function_data(x) = ptr;
+  c_function_call(x) = f;               /* f is T_App but needs cast */
+  c_function_set_base(x, x);
+  c_function_set_setter(x, sc->F);
+  c_function_name(x) = name;            /* (procedure-name proc) => (format #f "~A" proc) */
+  c_function_name_length(x) = safe_strlen(name);
+  c_function_documentation(x) = (doc) ? make_semipermanent_c_string(sc, doc) : NULL;
+  c_function_signature(x) = sc->F;
+
+  c_function_min_args(x) = req;
+  c_function_optional_args(x) = opt;    /* T_C_FUNCTION_STAR type may be set later, so T_Fst not usable here */
+  c_function_max_args(x) = (rst) ? MAX_ARITY : req + opt;
+
+  c_function_class(x) = ++sc->f_class;
+  c_function_chooser(x) = fallback_chooser;
+  c_function_opt_data(x) = NULL;
+  c_function_marker(x) = NULL;
+  c_function_symbol(x) = NULL;
+  return(x);
+}
+
+static c_proc_t *alloc_semipermanent_function(s7_scheme *sc)
+{
+  #define ALLOC_FUNCTION_SIZE 256
+  if (sc->alloc_function_k == ALLOC_FUNCTION_SIZE)
+    {
+      sc->alloc_function_cells = (c_proc_t *)Malloc(ALLOC_FUNCTION_SIZE * sizeof(c_proc_t));
+      add_saved_pointer(sc, sc->alloc_function_cells);
+      sc->alloc_function_k = 0;
+    }
+  return(&(sc->alloc_function_cells[sc->alloc_function_k++]));
+}
+
+s7_pointer s7_make_function(s7_scheme *sc, const char *name, s7_function f,
+			    s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc)
+{
+  s7_pointer x = alloc_pointer(sc);
+  x = make_function(sc, name, f, required_args, optional_args, rest_arg, doc, x, alloc_semipermanent_function(sc));
+  unheap(sc, x);
+  return(x);
+}
+
+s7_pointer s7_make_safe_function(s7_scheme *sc, const char *name, s7_function f,
+				 s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc)
+{
+  s7_pointer p = s7_make_function(sc, name, f, required_args, optional_args, rest_arg, doc);
+  set_type_bit(p, T_SAFE_PROCEDURE);
+  return(p);
+}
+
+s7_pointer s7_make_typed_function(s7_scheme *sc, const char *name, s7_function f,
+				  s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc, s7_pointer signature)
+{
+  s7_pointer func = s7_make_function(sc, name, f, required_args, optional_args, rest_arg, doc);
+  set_type_bit(func, T_SAFE_PROCEDURE);
+  if (signature) c_function_signature(func) = signature;
+  return(func);
+}
+
+
+/* -------------------------------- procedure? -------------------------------- */
+bool s7_is_procedure(s7_pointer x) {return(is_procedure(x));}
+
+static s7_pointer g_is_procedure(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_procedure "(procedure? obj) returns #t if obj is a procedure"
+  #define Q_is_procedure sc->pl_bt
+  return(make_boolean(sc, is_procedure(car(args))));
+}
+
+s7_pointer s7_closure_body(s7_scheme *sc, s7_pointer p) {return((has_closure_let(p)) ? closure_body(p) : sc->nil);}
+s7_pointer s7_closure_let(s7_scheme *sc, s7_pointer p)  {return((has_closure_let(p)) ? closure_let(p)  : sc->rootlet);}
+s7_pointer s7_closure_args(s7_scheme *sc, s7_pointer p) {return((has_closure_let(p)) ? closure_args(p) : sc->nil);}
+
+
+/* -------------------------------- procedure-arglist -------------------------------- */
+static s7_pointer g_procedure_arglist(s7_scheme *sc, s7_pointer args)
+{
+  #define H_procedure_arglist "(procedure-arglist func) returns func's arglist"
+  #define Q_procedure_arglist s7_make_signature(sc, 2, \
+                               s7_make_signature(sc, 2, sc->is_list_symbol, sc->is_symbol_symbol), \
+                               s7_make_signature(sc, 2, sc->is_procedure_symbol, sc->is_macro_symbol))
+  s7_pointer p = car(args);
+  if (has_closure_let(p)) return(closure_args(p));
+  check_method(sc, p, sc->procedure_arglist_symbol, set_plist_1(sc, p));
+  error_nr(sc, sc->wrong_type_arg_symbol,
+	   set_elist_2(sc, wrap_string(sc, "procedure-arglist argument, ~S, is not a function", 48), p));
+  return(sc->nil); /* never hit */
+}
+
+
+/* -------------------------------- procedure-source -------------------------------- */
+static s7_pointer procedure_type_to_symbol(s7_scheme *sc, int32_t type)
+{
+  switch (type)
+    {
+    case T_CLOSURE:      return(sc->lambda_symbol);
+    case T_CLOSURE_STAR: return(sc->lambda_star_symbol);
+    case T_MACRO:        return(sc->macro_symbol);
+    case T_MACRO_STAR:   return(sc->macro_star_symbol);
+    case T_BACRO:        return(sc->bacro_symbol);
+    case T_BACRO_STAR:   return(sc->bacro_star_symbol);
+    default: if (S7_DEBUGGING) fprintf(stderr, "%s[%d] wants %d symbol\n", __func__, __LINE__, type); /* break; ? */
+    }
+  return(sc->lambda_symbol);
+}
+
+static s7_pointer g_procedure_source(s7_scheme *sc, s7_pointer args)
+{
+  #define H_procedure_source "(procedure-source func) tries to return the definition of func"
+  #define Q_procedure_source s7_make_signature(sc, 2, sc->is_list_symbol, s7_make_signature(sc, 2, sc->is_procedure_symbol, sc->is_macro_symbol))
+  /* make it look like a scheme-level lambda */
+  s7_pointer p = car(args);
+
+  if ((is_symbol(p)) &&
+      ((symbol_ctr(p) == 0) || ((p = s7_symbol_value(sc, p)) == sc->undefined)))
+    error_nr(sc, sc->wrong_type_arg_symbol,
+	     set_elist_2(sc, wrap_string(sc, "procedure-source arg, '~S, is unbound", 37), car(args)));
+  if ((is_c_function(p)) || (is_c_macro(p)))
+    return(sc->nil);
+
+  check_method(sc, p, sc->procedure_source_symbol, set_plist_1(sc, p));
+  if (has_closure_let(p))
+    {
+      s7_pointer body = closure_body(p);
+      /* perhaps if this function has been removed from the heap, it would be better to use copy_body (as in s7_copy)? */
+      if (is_safe_closure_body(body))
+	clear_safe_closure_body(body);
+      return(append_in_place(sc, list_2(sc, procedure_type_to_symbol(sc, type(p)), closure_args(p)), body));
+    }
+  if (!is_procedure(p))
+    sole_arg_wrong_type_error_nr(sc, sc->procedure_source_symbol, p, a_procedure_or_a_macro_string);
+  return(sc->nil);
+  /* perhaps include file/line? perhaps some way to return comments in code -- source code as string exactly as in file? */
+}
+
+
+/* -------------------------------- *current-function* -------------------------------- */
+static s7_pointer let_to_function(s7_scheme *sc, s7_pointer e)
+{
+  if ((!e) || (e == sc->rootlet) || (!is_let(e)))
+    return(sc->F);
+  if (!((is_funclet(e)) || (is_maclet(e))))
+    return(sc->F);
+  if ((has_let_file(e)) &&
+      (let_file(e) <= (s7_int)sc->file_names_top) &&
+      (let_line(e) > 0))
+    return(list_3(sc, funclet_function(e), sc->file_names[let_file(e)], make_integer(sc, let_line(e))));
+  return(funclet_function(e));
+}
+
+static s7_pointer g_function(s7_scheme *sc, s7_pointer args)
+{
+  #define H_function "(*function* env field) returns the current function.  (*function*) is like __func__ in C. \
+If 'env is specified, *function* looks for the current function in the environment 'e.  If 'field (a symbol) is given \
+a function-specific value is returned.  The fields are 'name (the name of the current function), 'signature, 'arity,\
+ 'documentation, 'value (the function itself), 'line and 'file (the function's definition location), 'funclet, 'source, \
+and 'arglist. (define (func x y) (*function* (curlet) 'arglist)) (func 1 2): '(x y)"
+
+  #define Q_function s7_make_signature(sc, 3, sc->T, sc->is_let_symbol, sc->is_symbol_symbol)
+
+  s7_pointer e, sym = NULL, fname, fval;
+  if (is_null(args))                /* (*function*) is akin to __func__ in C */
+    {
+      for (e = sc->curlet; e; e = let_outlet(e))
+	if ((is_funclet(e)) || (is_maclet(e)))
+	  break;
+      return(let_to_function(sc, e));
+    }
+  e = car(args);
+  if (!is_let(e))
+    sole_arg_wrong_type_error_nr(sc, sc->_function__symbol, e, sc->type_names[T_LET]);
+  if (is_pair(cdr(args)))
+    {
+      sym = cadr(args);
+      if (!is_symbol(sym))
+	wrong_type_error_nr(sc, sc->_function__symbol, 2, sym, sc->type_names[T_SYMBOL]);
+    }
+  if (e == sc->rootlet)
+    return(sc->F);
+  if (!((is_funclet(e)) || (is_maclet(e))))
+    e = let_outlet(e);
+  if (is_null(cdr(args)))
+    return(let_to_function(sc, e));
+  if ((e == sc->rootlet) || (!is_let(e)))
+    return(sc->F);
+  if (!((is_funclet(e)) || (is_maclet(e))))
+    return(sc->F);
+
+  if (is_keyword(sym))
+    sym = keyword_symbol(sym);
+  fname = funclet_function(e);
+  fval = s7_symbol_local_value(sc, fname, e);
+
+  if (sym == sc->name_symbol) return(fname);
+  if (sym == sc->signature_symbol) return(s7_signature(sc, fval));
+  if (sym == sc->arity_symbol) return(s7_arity(sc, fval));
+  if (sym == sc->documentation_symbol) return(s7_make_string(sc, s7_documentation(sc, fval)));
+  if (sym == sc->value_symbol) return(fval);
+  if ((sym == sc->line_symbol) && (has_let_file(e))) return(make_integer(sc, let_line(e)));
+  if ((sym == sc->file_symbol) && (has_let_file(e))) return(sc->file_names[let_file(e)]);
+  if (sym == make_symbol(sc, "funclet", 7)) return(e);
+  if (sym == make_symbol(sc, "source", 6)) return(g_procedure_source(sc, set_plist_1(sc, fval)));
+  if ((sym == make_symbol(sc, "arglist", 7)) && ((is_any_closure(fval)) || (is_any_macro(fval)))) return(closure_args(fval));
+  return(sc->F);
+}
+
+
+/* -------------------------------- funclet -------------------------------- */
+s7_pointer s7_funclet(s7_scheme *sc, s7_pointer p) {return((has_closure_let(p)) ? closure_let(p) : sc->rootlet);}
+
+static s7_pointer g_funclet(s7_scheme *sc, s7_pointer args)
+{
+  #define H_funclet "(funclet func) tries to return a function's definition environment"
+  #define Q_funclet s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_let_symbol, sc->is_null_symbol), \
+				      s7_make_signature(sc, 3, sc->is_procedure_symbol, sc->is_macro_symbol, sc->is_symbol_symbol))
+  s7_pointer p = car(args);
+  if (is_symbol(p))
+    {
+      if ((symbol_ctr(p) == 0) || ((p = s7_symbol_value(sc, p)) == sc->undefined))
+	error_nr(sc, sc->wrong_type_arg_symbol,
+		 set_elist_2(sc, wrap_string(sc, "funclet argument, '~S, is unbound", 33), car(args))); /* not p here */
+    }
+  check_method(sc, p, sc->funclet_symbol, args);
+  if (!((is_any_procedure(p)) || (is_c_object(p))))
+    sole_arg_wrong_type_error_nr(sc, sc->funclet_symbol, p, a_procedure_or_a_macro_string);
+  return(find_let(sc, p));
+}
+
+
+/* -------------------------------- s7_define_function and friends --------------------------------
+ *
+ * all c_func* are semipermanent, but they might be local: (let () (load "libm.scm" (curlet)) ...)
+ *   but there's no way to tell in general that the let is not exported.
+ */
+s7_pointer s7_define_function(s7_scheme *sc, const char *name, s7_function fnc,
+			      s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc)
+{
+  s7_pointer func = s7_make_function(sc, name, fnc, required_args, optional_args, rest_arg, doc);
+  s7_pointer sym = make_symbol_with_strlen(sc, name);
+  s7_define(sc, sc->rootlet, sym, func);
+  return(sym);
+}
+
+s7_pointer s7_define_safe_function(s7_scheme *sc, const char *name, s7_function fnc,
+				   s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc)
+{
+  /* returns (string->symbol name), not the c_proc_t func */
+  s7_pointer func = s7_make_safe_function(sc, name, fnc, required_args, optional_args, rest_arg, doc);
+  s7_pointer sym = make_symbol_with_strlen(sc, name);
+  s7_define(sc, sc->rootlet, sym, func);
+  return(sym);
+}
+
+s7_pointer s7_define_typed_function(s7_scheme *sc, const char *name, s7_function fnc, /* same as above, but include sig */
+				    s7_int required_args, s7_int optional_args, bool rest_arg,
+				    const char *doc, s7_pointer signature)
+{
+  /* returns (string->symbol name), not the c_proc_t func */
+  s7_pointer func = s7_make_typed_function(sc, name, fnc, required_args, optional_args, rest_arg, doc, signature); /* includes "safe" bit */
+  s7_pointer sym = make_symbol_with_strlen(sc, name);
+  s7_define(sc, sc->rootlet, sym, func);
+  c_function_set_marker(func, NULL);
+  return(sym);
+}
+
+static s7_pointer define_bool_function(s7_scheme *sc, const char *name, s7_function fnc,
+				       s7_int optional_args, const char *doc, s7_pointer signature, int32_t sym_to_type,
+				       void (*marker)(s7_pointer p, s7_int top),
+				       bool simple, s7_function bool_setter)
+{
+  s7_pointer bfunc;
+  s7_pointer func = s7_make_typed_function(sc, name, fnc, 1, optional_args, false, doc, signature); /* includes "safe" bit */
+  s7_pointer sym = make_symbol_with_strlen(sc, name);
+  s7_define(sc, sc->rootlet, sym, func);
+  if (sym_to_type != T_FREE)
+    symbol_set_type(sym, sym_to_type);
+  c_function_symbol(func) = sym;
+  c_function_set_marker(func, marker);
+  if (simple) c_function_set_has_simple_elements(func);
+  c_function_set_bool_setter(func, bfunc = s7_make_safe_function(sc, name, bool_setter, 2, 0, false, NULL));
+  c_function_set_has_bool_setter(func);
+  c_function_set_setter(bfunc, func);
+  set_is_bool_function(bfunc);
+  return(sym);
+}
+
+s7_pointer s7_define_unsafe_typed_function(s7_scheme *sc, const char *name, s7_function fnc,
+					   s7_int required_args, s7_int optional_args, bool rest_arg,
+					   const char *doc, s7_pointer signature)
+{
+  /* returns (string->symbol name), not the c_proc_t func */
+  s7_pointer func = s7_make_function(sc, name, fnc, required_args, optional_args, rest_arg, doc);
+  s7_pointer sym = make_symbol_with_strlen(sc, name);
+  if (signature) c_function_signature(func) = signature;
+  s7_define(sc, sc->rootlet, sym, func);
+  return(sym);
+}
+
+s7_pointer s7_define_semisafe_typed_function(s7_scheme *sc, const char *name, s7_function fnc,
+					     s7_int required_args, s7_int optional_args, bool rest_arg,
+					     const char *doc, s7_pointer signature)
+{
+  s7_pointer func = s7_make_function(sc, name, fnc, required_args, optional_args, rest_arg, doc);
+  s7_pointer sym = make_symbol_with_strlen(sc, name);
+  if (signature) c_function_signature(func) = signature;
+  set_is_semisafe(func);
+  s7_define(sc, sc->rootlet, sym, func);
+  return(sym);
+}
+
+s7_pointer s7_make_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc)
+{
+  s7_pointer func, local_args;
+  char *internal_arglist;
+  s7_int n_args, len = safe_strlen(arglist);
+  s7_int gc_loc;
+  block_t *b = inline_mallocate(sc, len + 4);
+
+  internal_arglist = (char *)block_data(b);
+  internal_arglist[0] = '\'';
+  internal_arglist[1] = '(';
+  memcpy((void *)(internal_arglist + 2), (const void *)arglist, len);
+  internal_arglist[len + 2] = ')';
+  internal_arglist[len + 3] = '\0';
+  local_args = s7_eval_c_string(sc, internal_arglist);
+  gc_loc = gc_protect_1(sc, local_args);
+  liberate(sc, b);
+  n_args = s7_list_length(sc, local_args);
+  if (n_args < 0)
+    {
+      s7_warn(sc, 256, "%s rest argument is not supported in C-side define*: %s\n", name, arglist);
+      n_args = -n_args;
+    }
+  func = s7_make_function(sc, name, fnc, 0, n_args, false, doc);
+
+  if (n_args > 0)
+    {
+      s7_pointer p = local_args;
+      s7_pointer *names = (s7_pointer *)permalloc(sc, n_args * sizeof(s7_pointer));
+      s7_pointer *defaults = (s7_pointer *)permalloc(sc, n_args * sizeof(s7_pointer));
+
+      set_full_type(func, T_C_FUNCTION_STAR | T_UNHEAP); /* unheap from s7_make_function */
+      c_function_call_args(func) = NULL;
+      c_function_arg_names(func) = names;
+      c_function_arg_defaults(func) = defaults;
+      c_func_set_simple_defaults(func);
+      /* (define* (f :allow-other-keys) 32) -> :allow-other-keys can't be the only parameter: (:allow-other-keys) */
+
+      for (s7_int i = 0; i < n_args; p = cdr(p), i++)
+	{
+	  s7_pointer arg = car(p);
+	  if (arg == sc->allow_other_keys_keyword)
+	    {
+	      if (is_not_null(cdr(p)))
+		s7_warn(sc, 256, "%s :allow-other-keys should be the last parameter: %s\n", name, arglist);
+	      if (p == local_args)
+		s7_warn(sc, 256, "%s :allow-other-keys can't be the only parameter: %s\n", name, arglist);
+	      c_function_set_allow_other_keys(func); /* local_args is local, so it can't carry the bit */
+	      n_args--;
+	      c_function_optional_args(func) = n_args;
+	      c_function_max_args(func) = n_args;    /* apparently not counting keywords */
+	    }
+	  else
+	    if (is_pair(arg))                        /* there is a default */
+	      {
+		names[i] = car(arg);                 /* key can be passed at runtime as :key or key: so we need both or the symbol */
+		defaults[i] = cadr(arg);
+		remove_from_heap(sc, cadr(arg)); /* ?? */
+		if ((is_pair(defaults[i])) ||
+		    (is_normal_symbol(defaults[i])))
+		  {
+		    c_func_clear_simple_defaults(func);
+		    mark_function[T_C_FUNCTION_STAR] = mark_c_proc_star;
+		  }}
+	    else
+	      {
+		if (arg == sc->rest_keyword)
+		  s7_warn(sc, 256, "%s :rest is not supported in C-side define*: %s\n", name, arglist);
+		names[i] = arg;
+		defaults[i] = sc->F;
+	      }}}
+  else set_full_type(func, T_C_FUNCTION | T_UNHEAP);
+
+  s7_gc_unprotect_at(sc, gc_loc);
+  return(func);
+}
+
+s7_pointer s7_make_safe_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc)
+{
+  s7_pointer func = s7_make_function_star(sc, name, fnc, arglist, doc);
+  set_full_type(func, full_type(func) | T_SAFE_PROCEDURE); /* don't step on the c_func_has_simple_defaults flag */
+  if (is_c_function_star(func))                            /* thunk -> c_function */
+    c_function_call_args(func) = semipermanent_list(sc, c_function_optional_args(func));
+  return(func);
+}
+
+static void define_function_star_1(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc, bool safe, s7_pointer signature)
+{
+  s7_pointer func;
+  if (safe)
+    func = s7_make_safe_function_star(sc, name, fnc, arglist, doc);
+  else func = s7_make_function_star(sc, name, fnc, arglist, doc);
+  s7_define(sc, sc->rootlet, make_symbol_with_strlen(sc, name), func);
+  if (signature) c_function_signature(func) = signature;
+}
+
+void s7_define_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc)
+{
+  define_function_star_1(sc, name, fnc, arglist, doc, false, NULL);
+}
+
+void s7_define_safe_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc)
+{
+  define_function_star_1(sc, name, fnc, arglist, doc, true, NULL);
+}
+
+void s7_define_typed_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc, s7_pointer signature)
+{
+  define_function_star_1(sc, name, fnc, arglist, doc, true, signature);
+}
+
+
+s7_pointer s7_define_macro(s7_scheme *sc, const char *name, s7_function fnc,
+			   s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc)
+{
+  s7_pointer func = s7_make_function(sc, name, fnc, required_args, optional_args, rest_arg, doc);
+  s7_pointer sym = make_symbol_with_strlen(sc, name);
+  set_full_type(func, T_C_MACRO | T_DONT_EVAL_ARGS | T_UNHEAP); /* s7_make_function includes T_UNHEAP */
+  s7_define(sc, sc->rootlet, sym, func);
+  return(sym);
+}
+
+
+/* -------------------------------- macro? -------------------------------- */
+bool s7_is_macro(s7_scheme *sc, s7_pointer x) {return(is_any_macro(x));}
+static bool is_macro_b(s7_pointer x) {return(is_any_macro(x));}
+
+static s7_pointer g_is_macro(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_macro "(macro? arg) returns #t if 'arg' is a macro or a bacro"
+  #define Q_is_macro sc->pl_bt
+  check_boolean_method(sc, is_any_macro, sc->is_macro_symbol, args);
+}
+
+static bool closure_is_aritable(s7_scheme *sc, s7_pointer x, s7_pointer x_args, int32_t args);
+
+static s7_pointer s7_macroexpand(s7_scheme *sc, s7_pointer mac, s7_pointer args)
+{
+  int32_t arg_len;
+  if (!s7_is_proper_list(sc, args))
+    return(sc->F);
+
+  arg_len = proper_list_length(args);
+  if (!closure_is_aritable(sc, mac, closure_args(mac), arg_len))
+    return(sc->F);
+
+  push_stack_direct(sc, OP_EVAL_DONE);
+  sc->code = mac;
+  sc->args = args;
+  set_curlet(sc, make_let(sc, closure_let(sc->code)));
+  eval(sc, OP_APPLY_LAMBDA);
+  return(sc->value);
+}
+
+
+/* -------------------------------- documentation -------------------------------- */
+const char *s7_documentation(s7_scheme *sc, s7_pointer x)
+{
+  s7_pointer val;
+  if (is_symbol(x))
+    {
+      if (is_keyword(x)) return(NULL);
+      if (symbol_has_help(x))
+	return(symbol_help(x));
+      x = s7_symbol_value(sc, x); /* this is needed by Snd */
+    }
+  if ((is_any_c_function(x)) ||
+      (is_c_macro(x)))
+    return((const char *)c_function_documentation(x));
+
+  if (is_syntax(x))
+    return(syntax_documentation(x));
+
+  val = funclet_entry(sc, x, sc->local_documentation_symbol);
+  if ((val) && (is_string(val)))
+    return(string_value(val));
+
+  if (has_closure_let(x))
+    {
+      val = closure_body(x);
+      if ((is_pair(val)) && (is_string(car(val))))
+	return((char *)string_value(car(val)));
+    }
+  return(NULL);
+}
+
+static s7_pointer g_documentation(s7_scheme *sc, s7_pointer args)
+{
+  #define H_documentation "(documentation obj) returns obj's documentation string"
+  #define Q_documentation s7_make_signature(sc, 2, sc->is_string_symbol, sc->T) /* should (documentation 1) be an error? */
+
+  s7_pointer p = car(args);
+  if (is_symbol(p))
+    {
+      if ((symbol_has_help(p)) &&
+	  (is_global(p)))
+	return(s7_make_string(sc, symbol_help(p)));
+      p = s7_symbol_value(sc, p);
+    }
+  /* (documentation func) should act like (documentation abs) -- available without (openlet (funclet func)) or (openlet func)
+   *   so we check that case ahead of time here, rather than going through check_method which does not
+   *   call find_let unless has_active_methods(sc, func).  Adding T_HAS_METHODS to all closures causes other troubles.
+   */
+  if (has_closure_let(p))
+    {
+      s7_pointer func = funclet_entry(sc, p, sc->documentation_symbol);
+      if (func)
+	return(s7_apply_function(sc, func, args));
+      func = closure_body(p);
+      if ((is_pair(func)) && (is_string(car(func))))
+	return(car(func));
+    }
+  /* it would be neat if this would work (define x (let ((+documentation+ "hio")) (vector 1 2 3))) (documentation x) */
+  check_method(sc, p, sc->documentation_symbol, args);
+  return(s7_make_string(sc, s7_documentation(sc, p)));
+}
+
+const char *s7_set_documentation(s7_scheme *sc, s7_pointer sym, const char *new_doc)
+{
+  if (is_keyword(sym)) return(NULL);
+  if (is_symbol(sym))
+    {
+      symbol_set_has_help(sym);
+      symbol_set_help(sym, copy_string(new_doc));
+      add_saved_pointer(sc, symbol_help(sym));
+    }
+  return(new_doc);
+}
+
+
+/* -------------------------------- help -------------------------------- */
+const char *s7_help(s7_scheme *sc, s7_pointer obj)
+{
+  if (is_syntax(obj))
+    return(syntax_documentation(obj));
+
+  if (is_symbol(obj))
+    {
+      /* here look for name */
+      if (s7_documentation(sc, obj))
+	return(s7_documentation(sc, obj));
+      obj = s7_symbol_value(sc, obj);
+    }
+  if (is_any_procedure(obj))
+    return(s7_documentation(sc, obj));
+
+  if (obj == sc->s7_starlet)
+    return("*s7* is a let that gives access to s7's internal state: e.g. (*s7* 'print-length)");
+
+  /* if is string, apropos? (can scan symbol table) */
+  return(NULL);
+}
+
+static s7_pointer g_help(s7_scheme *sc, s7_pointer args)
+{
+  #define H_help "(help obj) returns obj's documentation"
+  #define Q_help s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_boolean_symbol), sc->T)
+  const char *doc;
+  check_method(sc, car(args), sc->help_symbol, args);
+  doc = s7_help(sc, car(args));
+  return((doc) ? s7_make_string(sc, doc) : sc->F);
+}
+
+
+/* -------------------------------- signature -------------------------------- */
+static void init_signatures(s7_scheme *sc)
+{
+  sc->string_signature =       s7_make_signature(sc, 3, sc->is_char_symbol, sc->is_string_symbol, sc->is_integer_symbol);
+  sc->byte_vector_signature =  s7_make_circular_signature(sc, 2, 3, sc->is_byte_symbol, sc->is_byte_vector_symbol, sc->is_integer_symbol);
+  sc->vector_signature =       s7_make_circular_signature(sc, 2, 3, sc->T, sc->is_vector_symbol, sc->is_integer_symbol);
+  sc->float_vector_signature = s7_make_circular_signature(sc, 2, 3, sc->is_float_symbol, sc->is_float_vector_symbol, sc->is_integer_symbol);
+  sc->int_vector_signature =   s7_make_circular_signature(sc, 2, 3, sc->is_integer_symbol, sc->is_int_vector_symbol, sc->is_integer_symbol);
+  sc->c_object_signature =     s7_make_circular_signature(sc, 2, 3, sc->T, sc->is_c_object_symbol, sc->T);
+  sc->let_signature =          s7_make_circular_signature(sc, 2, 3, sc->T, sc->is_let_symbol, sc->is_symbol_symbol);
+  sc->hash_table_signature =   s7_make_circular_signature(sc, 2, 3, sc->T, sc->is_hash_table_symbol, sc->T);
+  sc->pair_signature =         s7_make_circular_signature(sc, 2, 3, sc->T, sc->is_pair_symbol, sc->is_integer_symbol);
+}
+
+static s7_pointer g_signature(s7_scheme *sc, s7_pointer args)
+{
+  #define H_signature "(signature obj) returns obj's signature"
+  #define Q_signature s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_boolean_symbol), sc->T)
+
+  s7_pointer p = car(args);
+  switch (type(p))
+    {
+    case T_C_FUNCTION: case T_C_RST_NO_REQ_FUNCTION:
+    case T_C_FUNCTION_STAR: case T_C_MACRO:
+      return((s7_pointer)c_function_signature(p));
+
+    case T_MACRO:   case T_MACRO_STAR:
+    case T_BACRO:   case T_BACRO_STAR:
+    case T_CLOSURE: case T_CLOSURE_STAR:
+      {
+	s7_pointer func = funclet_entry(sc, p, sc->local_signature_symbol);
+	if (func) return(func);
+	func = funclet_entry(sc, p, sc->signature_symbol);
+	return((func) ? s7_apply_function(sc, func, args) : sc->F);
+      }
+
+    case T_VECTOR:
+      if (vector_length(p) == 0) return(sc->F); /* sig () is #f so sig #() should be #f */
+      if (!is_typed_vector(p))
+	return(sc->vector_signature);
+      {
+	s7_pointer lst = list_3(sc, typed_vector_typer_symbol(sc, p), sc->is_vector_symbol, sc->is_integer_symbol);
+	set_cdddr(lst, cddr(lst));
+	return(lst);
+      }
+
+    case T_FLOAT_VECTOR: return((vector_length(p) == 0) ? sc->F : sc->float_vector_signature);
+    case T_INT_VECTOR:   return((vector_length(p) == 0) ? sc->F : sc->int_vector_signature);
+    case T_BYTE_VECTOR:  return((vector_length(p) == 0) ? sc->F : sc->byte_vector_signature);
+    case T_PAIR:         return(sc->pair_signature);
+    case T_STRING:       return(sc->string_signature);
+
+    case T_HASH_TABLE:
+      if (is_typed_hash_table(p))
+	return(list_3(sc,
+		      hash_table_typer_symbol(sc, hash_table_value_typer(p)),
+		      sc->is_hash_table_symbol,
+		      hash_table_typer_symbol(sc, hash_table_key_typer(p))));
+      return(sc->hash_table_signature);
+
+    case T_ITERATOR:
+      p = iterator_sequence(p);
+      if ((is_hash_table(p)) || (is_let(p)))   /* cons returned -- would be nice to include the car/cdr types if known */
+	return(list_1(sc, sc->is_pair_symbol));
+      p = g_signature(sc, set_plist_1(sc, p));
+      return(list_1(sc, (is_pair(p)) ? car(p) : sc->T));
+
+    case T_C_OBJECT:
+      check_method(sc, p, sc->signature_symbol, args);
+      return(sc->c_object_signature);
+
+    case T_LET:
+      check_method(sc, p, sc->signature_symbol, args);
+      return(sc->let_signature);
+
+    case T_SYMBOL:
+      /* this used to get the symbol's value and call g_signature on that */
+      {
+	s7_pointer slot = s7_slot(sc, p);
+	if ((is_slot(slot)) && (slot_has_setter(slot)))
+	  {
+	    s7_pointer setter = slot_setter(slot);
+	    p = g_signature(sc, set_plist_1(sc, setter));
+	    if (is_pair(p))
+	      return(list_1(sc, car(p)));
+	  }}
+      break;
+
+    default: break;
+    }
+  return(sc->F);
+}
+
+s7_pointer s7_signature(s7_scheme *sc, s7_pointer func) {return(g_signature(sc, set_plist_1(sc, func)));}
+
+
+/* -------------------------------- dynamic-wind -------------------------------- */
+static s7_pointer closure_or_f(s7_scheme *sc, s7_pointer p)
+{
+  s7_pointer body;
+  if (!is_closure(p)) return(p);
+  body = closure_body(p);
+  if (is_pair(cdr(body))) return(p);
+  if (!is_pair(car(body))) return(sc->F);
+  return((is_quote(caar(body))) ? sc->F : p);
+}
+
+static s7_pointer make_baffled_closure(s7_scheme *sc, s7_pointer inp)
+{
+  /* for dynamic-wind to protect initial and final functions from call/cc */
+  s7_pointer nclo = make_closure_unchecked(sc, sc->nil, closure_body(inp), type(inp), 0); /* always preceded by new dw cell */
+  s7_pointer let = make_let(sc, closure_let(inp)); /* let_outlet(let) = closure_let(inp) */
+  set_baffle_let(let);
+  let_set_baffle_key(let, sc->baffle_ctr++);
+  closure_set_let(nclo, let);
+  return(nclo);
+}
+
+static bool is_dwind_thunk(s7_scheme *sc, s7_pointer x)
+{
+  switch (type(x))
+    {
+    case T_MACRO: case T_BACRO: case T_CLOSURE:
+    case T_MACRO_STAR: case T_BACRO_STAR: case T_CLOSURE_STAR:
+      return(is_null(closure_args(x)));    /* this case does not match is_aritable -- it could be loosened -- arity=0 below would need fixup */
+    case T_C_FUNCTION:
+      return(c_function_is_aritable(x, 0));
+    case T_C_FUNCTION_STAR:
+      return(c_function_max_args(x) >= 0);
+    case T_C_MACRO:
+      return((c_macro_min_args(x) <= 0) && (c_macro_max_args(x) >= 0));
+    case T_GOTO: case T_CONTINUATION: case T_C_RST_NO_REQ_FUNCTION:
+      return(true);
+    }
+  return(x == sc->F); /* (dynamic-wind #f (lambda () 3) #f) */
+}
+
+static s7_pointer g_dynamic_wind_unchecked(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer p, inp, outp;
+
+  new_cell(sc, p, T_DYNAMIC_WIND);                          /* don't mark car/cdr, don't copy */
+  dynamic_wind_in(p) = closure_or_f(sc, car(args));
+  dynamic_wind_body(p) = cadr(args);
+  dynamic_wind_out(p) = closure_or_f(sc, caddr(args));
+
+  inp = dynamic_wind_in(p);
+  if ((is_any_closure(inp)) && (!is_safe_closure(inp)))    /* wrap this use of inp in a with-baffle */
+    dynamic_wind_in(p) = make_baffled_closure(sc, inp);
+
+  outp = dynamic_wind_out(p);
+  if ((is_any_closure(outp)) && (!is_safe_closure(outp)))
+    dynamic_wind_out(p) = make_baffled_closure(sc, outp);
+
+  /* since we don't care about the in and out results, and they are thunks, if the body is not a pair,
+   *   or is a quoted thing, we just ignore that function.
+   */
+  push_stack(sc, OP_DYNAMIC_WIND, sc->nil, p);             /* args will be the saved result, code = s7_dynwind_t obj */
+  if (inp != sc->F)
+    {
+      dynamic_wind_state(p) = DWIND_INIT;
+      push_stack(sc, OP_APPLY, sc->nil, dynamic_wind_in(p));
+    }
+  else
+    {
+      dynamic_wind_state(p) = DWIND_BODY;
+      push_stack(sc, OP_APPLY, sc->nil, dynamic_wind_body(p));
+    }
+  return(sc->F);
+}
+
+static s7_pointer g_dynamic_wind_init(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer p, inp = closure_or_f(sc, car(args));
+  new_cell(sc, p, T_DYNAMIC_WIND);                          /* don't mark car/cdr, don't copy */
+  dynamic_wind_in(p) = inp;
+  dynamic_wind_body(p) = cadr(args);
+  dynamic_wind_out(p) = sc->F;
+  if ((is_any_closure(inp)) && (!is_safe_closure(inp)))    /* wrap this use of inp in a with-baffle */
+    dynamic_wind_in(p) = make_baffled_closure(sc, inp);
+  push_stack(sc, OP_DYNAMIC_WIND, sc->nil, p);             /* args will be the saved result, code = s7_dynwind_t obj */
+  dynamic_wind_state(p) = DWIND_INIT;
+  push_stack(sc, OP_APPLY, sc->nil, dynamic_wind_in(p));
+  return(sc->F);
+}
+
+static s7_pointer g_dynamic_wind_body(s7_scheme *sc, s7_pointer args)
+{
+  push_stack(sc, OP_APPLY, sc->nil, cadr(args));
+  return(sc->F);
+}
+
+static s7_pointer g_dynamic_wind(s7_scheme *sc, s7_pointer args)
+{
+  #define H_dynamic_wind "(dynamic-wind init body finish) calls init, then body, then finish, \
+each a function of no arguments, guaranteeing that finish is called even if body is exited"
+  #define Q_dynamic_wind s7_make_signature(sc, 4, sc->values_symbol, \
+                           s7_make_signature(sc, 2, sc->is_procedure_symbol, sc->not_symbol), \
+                           sc->is_procedure_symbol, \
+                           s7_make_signature(sc, 2, sc->is_procedure_symbol, sc->not_symbol))
+
+  if (!is_dwind_thunk(sc, car(args)))
+    return(method_or_bust(sc, car(args), sc->dynamic_wind_symbol, args, wrap_string(sc, "a thunk or #f", 13), 1));
+  if (!is_thunk(sc, cadr(args)))
+    return(method_or_bust(sc, cadr(args), sc->dynamic_wind_symbol, args, a_thunk_string, 2));
+  if (!is_dwind_thunk(sc, caddr(args)))
+    return(method_or_bust(sc, caddr(args), sc->dynamic_wind_symbol, args, wrap_string(sc, "a thunk or #f", 13), 3));
+
+  /* this won't work:
+       (let ((final (lambda (a b c) (list a b c))))
+         (dynamic-wind
+           (lambda () #f)
+           (lambda () (set! final (lambda () (display "in final"))))
+           final))
+   * but why not?  'final' is a thunk by the time it is evaluated. catch (the error handler) is similar.
+   * It can't work here because we set up the dynamic_wind_out slot below and
+   *   even if the thunk check was removed, we'd still be trying to apply the original function.
+   */
+  return(g_dynamic_wind_unchecked(sc, args));
+}
+
+static bool is_lambda(s7_scheme *sc, s7_pointer sym)
+{
+  return((sym == sc->lambda_symbol) && (symbol_id(sym) == 0)); /* do we need (!sc->in_with_let) ? */
+  /* symbol_id=0 means it has never been locally bound */
+}
+
+static int32_t is_ok_thunk(s7_scheme *sc, s7_pointer arg) /* used only in dynamic_wind_chooser */
+{
+  /* 0 = not ok, 1 = ok but not simple, 2 = ok body is just #f, 3 = #f */
+  if (arg == sc->F) return(3);
+  if ((is_pair(arg)) &&
+      (is_lambda(sc, car(arg))) &&
+      (is_pair(cdr(arg))) &&
+      (is_null(cadr(arg))) && /* (lambda () ...) */
+      (is_pair(cddr(arg))) &&
+      (s7_is_proper_list(sc, cddr(arg))))
+    return(((is_null(cdddr(arg))) && (caddr(arg) == sc->F)) ? 2 : 1); /* 2: (lambda () #f) */
+  return(0);
+}
+
+static s7_pointer dynamic_wind_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr)
+{
+  if ((args == 3) &&
+      (is_ok_thunk(sc, caddr(expr))))
+    {
+      int32_t init = is_ok_thunk(sc, cadr(expr));
+      int32_t end = is_ok_thunk(sc, cadddr(expr));
+      if ((init > 1) && (end > 1)) return(sc->dynamic_wind_body);
+      if ((init > 0) && (end > 1)) return(sc->dynamic_wind_init);
+      if ((init > 0) && (end > 0)) return(sc->dynamic_wind_unchecked);
+    }
+  return(f);
+}
+
+s7_pointer s7_dynamic_wind(s7_scheme *sc, s7_pointer init, s7_pointer body, s7_pointer finish)
+{
+  /* this is essentially s7_call with a dynamic-wind wrapper around "body" */
+  declare_jump_info();
+  store_jump_info(sc);
+  set_jump_info(sc, DYNAMIC_WIND_SET_JUMP);
+  if (jump_loc != NO_JUMP)
+    {
+      if (jump_loc != ERROR_JUMP)
+	eval(sc, sc->cur_op);
+    }
+  else
+    {
+      s7_pointer p;
+      push_stack_direct(sc, OP_EVAL_DONE); /* this is ok because we have called setjmp etc */
+      sc->args = sc->nil;
+      new_cell(sc, p, T_DYNAMIC_WIND);
+      dynamic_wind_in(p) = T_Ext(init);
+      dynamic_wind_body(p) = T_Ext(body);
+      dynamic_wind_out(p) = T_Ext(finish);
+      push_stack(sc, OP_DYNAMIC_WIND, sc->nil, p);
+      if (init != sc->F)
+	{
+	  dynamic_wind_state(p) = DWIND_INIT;
+	  sc->code = init;
+	}
+      else
+	{
+	  dynamic_wind_state(p) = DWIND_BODY;
+	  sc->code = body;
+	}
+      eval(sc, OP_APPLY);
+    }
+  restore_jump_info(sc);
+
+  if (is_multiple_value(sc->value))
+    sc->value = splice_in_values(sc, multiple_value(sc->value));
+ return(sc->value);
+}
+
+static void op_unwind_output(s7_scheme *sc)
+{
+  bool is_file = is_file_port(sc->code);
+
+  if ((is_output_port(sc->code)) &&
+      (!port_is_closed(sc->code)))
+    s7_close_output_port(sc, sc->code); /* may call fflush */
+  if (((is_output_port(sc->args)) &&
+       (!port_is_closed(sc->args))) ||
+      (sc->args == sc->F))
+    set_current_output_port(sc, sc->args);
+  if ((is_file) &&
+      (is_multiple_value(sc->value)))
+    sc->value = splice_in_values(sc, multiple_value(sc->value));
+}
+
+static void op_unwind_input(s7_scheme *sc)
+{
+  /* sc->code is an input port */
+  if (!port_is_closed(sc->code))
+    s7_close_input_port(sc, sc->code);
+  if ((is_input_port(sc->args)) &&
+      (!port_is_closed(sc->args)))
+    set_current_input_port(sc, sc->args);
+  if (is_multiple_value(sc->value))
+    sc->value = splice_in_values(sc, multiple_value(sc->value));
+}
+
+static bool op_dynamic_wind(s7_scheme *sc)
+{
+  s7_pointer dwind = T_Dyn(sc->code);
+  if (SHOW_EVAL_OPS) fprintf(stderr, "  %s[%d]: %s\n", __func__, __LINE__, display_truncated(dwind));
+  if (dynamic_wind_state(dwind) == DWIND_INIT)
+    {
+      dynamic_wind_state(dwind) = DWIND_BODY;
+      push_stack(sc, OP_DYNAMIC_WIND, sc->nil, dwind);
+      sc->code = dynamic_wind_body(dwind);
+      sc->args = sc->nil;
+      return(true); /* goto apply */
+    }
+  if (dynamic_wind_state(dwind) == DWIND_BODY)
+    {
+      dynamic_wind_state(dwind) = DWIND_FINISH;
+      if (dynamic_wind_out(dwind) != sc->F)
+	{
+	  push_stack(sc, OP_DYNAMIC_WIND, sc->value, dwind);
+	  sc->code = dynamic_wind_out(dwind);
+	  sc->args = sc->nil;
+	  return(true);
+	}
+      if (is_multiple_value(sc->value))
+	sc->value = splice_in_values(sc, multiple_value(sc->value));
+      return(false); /* goto start */
+    }
+  if (is_multiple_value(sc->args))       /* (+ 1 (dynamic-wind (lambda () #f) (lambda () (values 2 3 4)) (lambda () #f)) 5) */
+    sc->value = splice_in_values(sc, multiple_value(sc->args));
+  else sc->value = sc->args;             /* value saved above */
+  return(false);
+}
+
+
+/* -------------------------------- c-object? -------------------------------- */
+bool s7_is_c_object(s7_pointer p) {return(is_c_object(p));}
+
+static s7_pointer g_is_c_object(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_c_object "(c-object? obj) returns #t is obj is a c-object."
+  #define Q_is_c_object sc->pl_bt
+  s7_pointer obj = car(args);
+  if (is_c_object(obj)) return(sc->T);
+  if (!has_active_methods(sc, obj)) return(sc->F);
+  return(apply_boolean_method(sc, obj, sc->is_c_object_symbol));
+}
+
+
+/* -------------------------------- c-object-type -------------------------------- */
+static noreturn void apply_error_nr(s7_scheme *sc, s7_pointer obj, s7_pointer args)
+{
+  error_nr(sc, sc->syntax_error_symbol,
+	   set_elist_4(sc, wrap_string(sc, "attempt to apply ~A ~$ in ~S?", 29),
+		       (is_null(obj)) ? wrap_string(sc, "nil", 3) : ((is_symbol_and_keyword(obj)) ? wrap_string(sc, "a keyword", 9) : type_name_string(sc, obj)),
+		       obj,
+		       cons(sc, obj, args))); /* was current_code(sc) which is unreliable */
+}
+
+static void fallback_free(void *value) {}
+static void fallback_mark(void *value) {}
+
+static s7_pointer fallback_ref(s7_scheme *sc, s7_pointer args)   {apply_error_nr(sc, car(args), cdr(args)); return(NULL);}
+static s7_pointer fallback_set(s7_scheme *sc, s7_pointer args)   {syntax_error_nr(sc, "attempt to set ~S?", 18, car(args)); return(NULL);}
+static s7_pointer fallback_length(s7_scheme *sc, s7_pointer obj) {return(sc->F);}
+
+s7_int s7_c_object_type(s7_pointer obj) {return((is_c_object(obj)) ? c_object_type(obj) : -1);}
+
+static s7_pointer g_c_object_type(s7_scheme *sc, s7_pointer args)
+{
+  #define H_c_object_type "(c-object-type obj) returns the c_object's type tag."
+  #define Q_c_object_type s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_c_object_symbol)
+
+  s7_pointer p = car(args);
+  if (is_c_object(p))
+    return(make_integer(sc, c_object_type(p))); /* this is the c_object_types table index = tag */
+
+  /* method or bust with only one arg -- sole_arg_method_or_bust? */
+  if (!has_active_methods(sc, p))
+    sole_arg_wrong_type_error_nr(sc, sc->c_object_type_symbol, p, sc->type_names[T_C_OBJECT]);
+  return(find_and_apply_method(sc, p, sc->c_object_type_symbol, args));
+}
+
+static s7_pointer g_c_object_set(s7_scheme *sc, s7_pointer args) /* called in c_object_set_function */
+{
+  s7_pointer obj = car(args);
+  if (!is_c_object(obj))        /* (call/cc (setter (block))) will call c-object-set! with the continuation as the argument! */
+    wrong_type_error_nr(sc, make_symbol(sc, "c-object-set!", 13), 1, obj, sc->type_names[T_C_OBJECT]);
+  return((*(c_object_set(sc, obj)))(sc, args));
+}
+
+s7_int s7_make_c_type(s7_scheme *sc, const char *name) /* shouldn't this be s7_make_c_object_type? */
+{
+  c_object_t *c_type;
+  s7_int tag = sc->num_c_object_types++;
+
+  if (tag >= sc->c_object_types_size)
+    {
+      if (sc->c_object_types_size == 0)
+	{
+	  sc->c_object_types_size = 8;
+	  sc->c_object_types = (c_object_t **)Calloc(sc->c_object_types_size, sizeof(c_object_t *));
+	}
+      else
+	{
+	  sc->c_object_types_size = tag * 2;
+	  sc->c_object_types = (c_object_t **)Realloc((void *)(sc->c_object_types), sc->c_object_types_size * sizeof(c_object_t *));
+	}}
+  c_type = (c_object_t *)Calloc(1, sizeof(c_object_t)); /* Malloc+field=NULL is slightly faster here */
+  sc->c_object_types[tag] = c_type;
+  c_type->type = tag;
+  c_type->scheme_name = make_permanent_string(name, safe_strlen(name));
+  c_type->getter = sc->F;
+  c_type->setter = sc->F;
+  c_type->free = fallback_free;
+  c_type->mark = fallback_mark;
+  c_type->ref = fallback_ref;
+  c_type->set = fallback_set;
+  c_type->outer_type = T_C_OBJECT;
+  c_type->length = fallback_length;
+  /* all other fields are NULL */
+  return(tag);
+}
+
+void s7_c_type_set_gc_free(s7_scheme *sc, s7_int tag, s7_pointer (*gc_free)(s7_scheme *sc, s7_pointer obj))      {sc->c_object_types[tag]->gc_free = gc_free;}
+void s7_c_type_set_gc_mark(s7_scheme *sc, s7_int tag, s7_pointer (*marker)(s7_scheme *sc, s7_pointer obj))       {sc->c_object_types[tag]->gc_mark = marker;}
+void s7_c_type_set_equal(s7_scheme *sc, s7_int tag, bool (*equal)(void *value1, void *value2))                   {sc->c_object_types[tag]->eql = equal;}
+void s7_c_type_set_is_equal(s7_scheme *sc, s7_int tag, s7_pointer (*is_equal)(s7_scheme *sc, s7_pointer args))   {sc->c_object_types[tag]->equal = is_equal;}
+void s7_c_type_set_copy(s7_scheme *sc, s7_int tag, s7_pointer (*copy)(s7_scheme *sc, s7_pointer args))           {sc->c_object_types[tag]->copy = copy;}
+void s7_c_type_set_fill(s7_scheme *sc, s7_int tag, s7_pointer (*fill)(s7_scheme *sc, s7_pointer args))           {sc->c_object_types[tag]->fill = fill;}
+void s7_c_type_set_reverse(s7_scheme *sc, s7_int tag, s7_pointer (*reverse)(s7_scheme *sc, s7_pointer args))     {sc->c_object_types[tag]->reverse = reverse;}
+void s7_c_type_set_to_list(s7_scheme *sc, s7_int tag, s7_pointer (*to_list)(s7_scheme *sc, s7_pointer args))     {sc->c_object_types[tag]->to_list = to_list;}
+void s7_c_type_set_to_string(s7_scheme *sc, s7_int tag, s7_pointer (*to_string)(s7_scheme *sc, s7_pointer args)) {sc->c_object_types[tag]->to_string = to_string;}
+
+void s7_c_type_set_length(s7_scheme *sc, s7_int tag, s7_pointer (*length)(s7_scheme *sc, s7_pointer args))
+{
+  sc->c_object_types[tag]->length = (length) ? length : fallback_length; /* is_sequence(c_obj) is #t so we need a length method */
+}
+
+void s7_c_type_set_is_equivalent(s7_scheme *sc, s7_int tag, s7_pointer (*is_equivalent)(s7_scheme *sc, s7_pointer args))
+{
+  sc->c_object_types[tag]->equivalent = is_equivalent;
+}
+
+void s7_c_type_set_free(s7_scheme *sc, s7_int tag, void (*gc_free)(void *value))
+{
+  sc->c_object_types[tag]->free = (gc_free) ? gc_free : fallback_free;
+}
+
+void s7_c_type_set_mark(s7_scheme *sc, s7_int tag, void (*mark)(void *value))
+{
+  sc->c_object_types[tag]->mark = (mark) ? mark : fallback_mark;
+}
+
+void s7_c_type_set_ref(s7_scheme *sc, s7_int tag, s7_pointer (*ref)(s7_scheme *sc, s7_pointer args))
+{
+  sc->c_object_types[tag]->ref = (ref) ? ref : fallback_ref;
+  sc->c_object_types[tag]->outer_type = (sc->c_object_types[tag]->ref == fallback_ref) ? T_C_OBJECT : (T_C_OBJECT | T_SAFE_PROCEDURE);
+}
+
+void s7_c_type_set_getter(s7_scheme *sc, s7_int tag, s7_pointer getter)
+{
+  sc->c_object_types[tag]->getter = (getter) ? T_Fnc(getter) : sc->F;
+}
+
+void s7_c_type_set_set(s7_scheme *sc, s7_int tag, s7_pointer (*set)(s7_scheme *sc, s7_pointer args))
+{
+  sc->c_object_types[tag]->set = (set) ? set : fallback_set;
+}
+
+void s7_c_type_set_setter(s7_scheme *sc, s7_int tag, s7_pointer setter)
+{
+  sc->c_object_types[tag]->setter = (setter) ? T_Fnc(setter) : sc->F;
+}
+
+void *s7_c_object_value(s7_pointer obj) {return(c_object_value(obj));}
+
+void *s7_c_object_value_checked(s7_pointer obj, s7_int type)
+{
+  if ((is_c_object(obj)) && (c_object_type(obj) == type))
+    return(c_object_value(obj));
+  return(NULL);
+}
+
+static s7_pointer make_c_object_with_let(s7_scheme *sc, s7_int type, void *value, s7_pointer let, bool with_gc)
+{
+  s7_pointer x;
+  new_cell(sc, x, sc->c_object_types[type]->outer_type);
+
+  /* c_object_info(x) = &(sc->c_object_types[type]); */
+  /* that won't work because c_object_types can move when it is realloc'd and the old stuff is freed by realloc
+   *   and since we're checking (for example) ref_2 existence as not null, we can't use a table of c_object_t's!
+   * Using mallocate (s7_make_c_object_with_data) is faster, but not enough to warrant the code.
+   */
+  c_object_type(x) = type;
+  c_object_value(x) = value;
+  c_object_set_let(x, let);
+  c_object_s7(x) = sc;
+  if (with_gc) add_c_object(sc, x);
+  return(x);
+}
+
+s7_pointer s7_make_c_object_with_let(s7_scheme *sc, s7_int type, void *value, s7_pointer let)
+{
+  return(make_c_object_with_let(sc, type, value, let, true));
+}
+
+s7_pointer s7_make_c_object(s7_scheme *sc, s7_int type, void *value)
+{
+  return(make_c_object_with_let(sc, type, value, sc->rootlet, true));
+}
+
+s7_pointer s7_make_c_object_without_gc(s7_scheme *sc, s7_int type, void *value)
+{
+  return(make_c_object_with_let(sc, type, value, sc->rootlet, false));
+}
+
+s7_pointer s7_c_object_let(s7_pointer obj) {return(c_object_let(obj));}
+
+s7_pointer s7_c_object_set_let(s7_scheme *sc, s7_pointer obj, s7_pointer e)
+{
+  if ((!is_immutable(obj)) &&
+      (is_let(e)))
+    c_object_set_let(obj, e);
+  return(e);
+}
+
+static s7_pointer c_object_length(s7_scheme *sc, s7_pointer obj)
+{
+  return((*(c_object_len(sc, obj)))(sc, set_clist_1(sc, obj)));
+}
+
+static s7_int c_object_length_to_int(s7_scheme *sc, s7_pointer obj)
+{
+  s7_pointer res = (*(c_object_len(sc, obj)))(sc, set_clist_1(sc, obj));
+  if (s7_is_integer(res))
+    return(s7_integer_clamped_if_gmp(sc, res));
+  return(-1);
+}
+
+static s7_pointer copy_c_object(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer obj = car(args);
+  check_method(sc, obj, sc->copy_symbol, args);
+  if (!c_object_copy(sc, obj))
+    missing_method_error_nr(sc, sc->copy_symbol, obj);
+  return((*(c_object_copy(sc, obj)))(sc, args));
+}
+
+static s7_pointer c_object_type_to_let(s7_scheme *sc, s7_pointer cobj)
+{
+  s7_int type = c_object_type(cobj);
+  c_object_t *c_type = sc->c_object_types[type];
+
+  return(internal_inlet(sc, 6,
+			sc->name_symbol, c_type->scheme_name,
+			make_symbol(sc, "getter", 6), s7_object_to_string(sc, c_type->getter, false),
+			sc->setter_symbol, s7_object_to_string(sc, c_type->setter, false)));
+  /* can't display equal et al in c_types -- maybe sc->F or the pointer? or add getter equivalent fields for equal et al? */
+}
+
+static void apply_c_object(s7_scheme *sc)  /* -------- applicable c_object -------- */
+{
+  sc->value = (*(c_object_ref(sc, sc->code)))(sc, set_ulist_1(sc, sc->code, sc->args));
+  set_car(sc->u1_1, sc->F);
+}
+
+static bool op_implicit_c_object_ref_a(s7_scheme *sc)
+{
+  s7_pointer c = lookup_checked(sc, car(sc->code));
+  if (!is_c_object(c)) {sc->last_function = c; return(false);}
+  set_car(sc->t2_2, fx_call(sc, cdr(sc->code)));
+  set_car(sc->t2_1, c);        /* fx_call above might use sc->t2* */
+  sc->value = (*(c_object_ref(sc, c)))(sc, sc->t2_1);
+  return(true);
+}
+
+static s7_pointer fx_implicit_c_object_ref_a(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer c = lookup_checked(sc, car(arg));
+  if (!is_c_object(c))
+    return(s7_apply_function(sc, c, list_1(sc, fx_call(sc, cdr(arg)))));
+  set_car(sc->t2_2, fx_call(sc, cdr(arg)));
+  set_car(sc->t2_1, c);        /* fx_call above might use sc->t2* */
+  return((*(c_object_ref(sc, c)))(sc, sc->t2_1));
+}
+
+
+/* -------- dilambda -------- */
+
+s7_pointer s7_dilambda_with_environment(s7_scheme *sc, s7_pointer envir,
+					const char *name,
+					s7_pointer (*getter)(s7_scheme *sc, s7_pointer args), s7_int get_req_args, s7_int get_opt_args,
+					s7_pointer (*setter)(s7_scheme *sc, s7_pointer args), s7_int set_req_args, s7_int set_opt_args,
+					const char *documentation)
+{
+  s7_pointer get_func, set_func;
+  char *internal_set_name;
+  s7_int len, name_len;
+
+  if (!name) return(sc->F);
+  name_len = safe_strlen(name);
+  len = 16 + name_len;
+  internal_set_name = (char *)permalloc(sc, len);
+  internal_set_name[0] = '\0';
+  catstrs_direct(internal_set_name, "[set-", name, "]", (const char *)NULL);
+  get_func = s7_make_safe_function(sc, name, getter, get_req_args, get_opt_args, false, documentation);
+  s7_define(sc, envir, make_symbol(sc, name, name_len), get_func);
+  set_func = s7_make_safe_function(sc, internal_set_name, setter, set_req_args, set_opt_args, false, documentation);
+  c_function_set_setter(get_func, set_func);
+  return(get_func);
+}
+
+s7_pointer s7_dilambda(s7_scheme *sc,
+		       const char *name,
+		       s7_pointer (*getter)(s7_scheme *sc, s7_pointer args), s7_int get_req_args, s7_int get_opt_args,
+		       s7_pointer (*setter)(s7_scheme *sc, s7_pointer args), s7_int set_req_args, s7_int set_opt_args,
+		       const char *documentation)
+{
+  return(s7_dilambda_with_environment(sc, sc->nil, name, getter, get_req_args, get_opt_args, setter, set_req_args, set_opt_args, documentation));
+}
+
+s7_pointer s7_typed_dilambda(s7_scheme *sc,
+			     const char *name,
+			     s7_pointer (*getter)(s7_scheme *sc, s7_pointer args), s7_int get_req_args, s7_int get_opt_args,
+			     s7_pointer (*setter)(s7_scheme *sc, s7_pointer args), s7_int set_req_args, s7_int set_opt_args,
+			     const char *documentation,
+			     s7_pointer get_sig, s7_pointer set_sig)
+{
+  s7_pointer get_func = s7_dilambda(sc, name, getter, get_req_args, get_opt_args, setter, set_req_args, set_opt_args, documentation);
+  s7_pointer set_func = c_function_setter(get_func);
+  if (get_sig) c_function_signature(get_func) = get_sig;
+  if (set_sig) c_function_signature(set_func) = set_sig;
+  return(get_func);
+}
+
+
+/* -------------------------------- dilambda? -------------------------------- */
+bool s7_is_dilambda(s7_pointer obj)
+{
+  if (has_closure_let(obj))
+    return(is_any_procedure(closure_setter_or_map_list(obj))); /* type >= T_CLOSURE (excludes goto/continuation) */
+  if (is_any_c_function(obj))
+    return(is_any_procedure(c_function_setter(obj)));          /* type >= T_C_FUNCTION_STAR */
+  if (is_c_macro(obj))
+    return(is_any_procedure(c_macro_setter(obj)));
+  return(false);
+}
+
+static s7_pointer g_is_dilambda(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_dilambda "(dilambda? obj) returns #t if obj is a procedure with setter."
+  #define Q_is_dilambda sc->pl_bt
+  check_boolean_method(sc, s7_is_dilambda, sc->is_dilambda_symbol, args);
+}
+
+
+/* -------------------------------- dilambda -------------------------------- */
+static s7_pointer g_dilambda(s7_scheme *sc, s7_pointer args)
+{
+  #define H_dilambda "(dilambda getter setter) sets getter's setter to be setter."
+  #define Q_dilambda s7_make_signature(sc, 3, sc->is_procedure_symbol, sc->is_procedure_symbol, sc->is_procedure_symbol)
+
+  s7_pointer getter = car(args), setter;
+  if (!is_any_procedure(getter))
+    wrong_type_error_nr(sc, sc->dilambda_symbol, 1, getter, a_procedure_or_a_macro_string);
+
+  setter = cadr(args);
+  if (!is_any_procedure(setter))
+    wrong_type_error_nr(sc, sc->dilambda_symbol, 2, setter, a_procedure_or_a_macro_string);
+
+  s7_set_setter(sc, getter, setter);
+  return(getter);
+}
+
+
+/* -------------------------------- arity -------------------------------- */
+static s7_pointer closure_arity_to_cons(s7_scheme *sc, s7_pointer x, s7_pointer x_args)
+{
+  /* x_args is unprocessed -- it is exactly the list as used in the closure[*] definition */
+  int32_t len;
+
+  if (is_symbol(x_args))                    /* any number of args is ok */
+    return(cons(sc, int_zero, max_arity));
+  if (closure_arity_unknown(x))
+    closure_set_arity(x, s7_list_length(sc, x_args));
+  len = closure_arity(x);
+  if (len < 0)                              /* dotted list => rest arg, (length '(a b . c)) is -2 */
+    return(cons(sc, make_integer(sc, -len), max_arity));
+  return(cons(sc, make_integer(sc, len), make_integer_unchecked(sc, len)));
+}
+
+static void closure_star_arity_1(s7_scheme *sc, s7_pointer x, s7_pointer args)
+{
+  if (closure_arity_unknown(x))
+    {
+      if (is_null(args))
+	closure_set_arity(x, 0);
+      else
+	if ((is_symbol(args)) || (allows_other_keys(args)))
+	  closure_set_arity(x, -1);
+	else
+	  {
+	    s7_pointer p;
+	    int32_t i;
+	    for (i = 0, p = args; is_pair(p); i++, p = cdr(p)) /* is_pair(p) so (f1 a . b) will end with b not null */
+	      {
+		s7_pointer arg = car(p);
+		if (arg == sc->rest_keyword)
+		  break;
+	      }
+	    closure_set_arity(x, ((is_null(p)) ? i : -1));  /* see below */
+	  }}
+}
+
+static s7_pointer closure_star_arity_to_cons(s7_scheme *sc, s7_pointer x, s7_pointer x_args)
+{
+  closure_star_arity_1(sc, x, x_args);
+  return((closure_arity(x) == -1) ? cons(sc, int_zero, max_arity) : cons(sc, int_zero, make_integer(sc, closure_arity(x))));
+}
+
+static int32_t closure_arity_to_int(s7_scheme *sc, s7_pointer x)
+{
+  /* not lambda* here */
+  if (closure_arity_unknown(x))
+    {
+      int32_t i;
+      s7_pointer b;
+      for (i = 0, b = closure_args(x); is_pair(b); i++, b = cdr(b)) {};
+      if (is_null(b))
+	closure_set_arity(x, i);
+      else
+	{
+	  if (i == 0)
+	    return(-1);
+	  closure_set_arity(x, -i);
+	}}
+  return(closure_arity(x));
+}
+
+static int32_t closure_star_arity_to_int(s7_scheme *sc, s7_pointer x)
+{
+  /* not lambda here */
+  closure_star_arity_1(sc, x, closure_args(x));
+  return(closure_arity(x));
+}
+
+s7_pointer s7_arity(s7_scheme *sc, s7_pointer x)
+{
+  switch (type(x))
+    {
+    case T_C_FUNCTION:
+      return(cons(sc, make_integer(sc, c_function_min_args(x)), make_integer_unchecked(sc, c_function_max_args(x))));
+    case T_C_RST_NO_REQ_FUNCTION: case T_C_FUNCTION_STAR:
+      return(cons(sc, int_zero, make_integer(sc, c_function_max_args(x))));
+    case T_MACRO: case T_BACRO: case T_CLOSURE:
+      return(closure_arity_to_cons(sc, x, closure_args(x)));
+    case T_MACRO_STAR: case T_BACRO_STAR: case T_CLOSURE_STAR:
+      return(closure_star_arity_to_cons(sc, x, closure_args(x)));
+    case T_C_MACRO:
+      return(cons(sc, make_integer(sc, c_macro_min_args(x)), make_integer_unchecked(sc, c_macro_max_args(x))));
+    case T_GOTO: case T_CONTINUATION:
+      return(cons(sc, int_zero, max_arity));
+    case T_STRING:
+      return((string_length(x) == 0) ? sc->F : cons(sc, int_one, int_one));
+    case T_LET:
+      return(cons(sc, int_one, int_one));
+    case T_C_OBJECT:
+      check_method(sc, x, sc->arity_symbol, set_plist_1(sc, x));
+      return((is_safe_procedure(x)) ? cons(sc, int_zero, max_arity) : sc->F);
+    case T_VECTOR:
+      if (vector_length(x) == 0) return(sc->F);
+      if (has_simple_elements(x)) return(cons(sc, int_one, make_integer(sc, vector_rank(x))));
+      return(cons(sc, int_one, max_arity));
+    case T_INT_VECTOR: case T_FLOAT_VECTOR: case T_BYTE_VECTOR:
+      return((vector_length(x) == 0) ? sc->F : cons(sc, int_one, make_integer(sc, vector_rank(x))));
+    case T_PAIR: case T_HASH_TABLE:
+      return(cons(sc, int_one, max_arity));
+    case T_ITERATOR:
+      return(cons(sc, int_zero, int_zero));
+    case T_SYNTAX:
+      return(cons(sc, small_int(syntax_min_args(x)), (syntax_max_args(x) == -1) ? max_arity : small_int(syntax_max_args(x))));
+    }
+  return(sc->F);
+}
+
+static s7_pointer g_arity(s7_scheme *sc, s7_pointer args) /* arity-uncopied could use sc->ulist */
+{
+  #define H_arity "(arity obj) the min and max number of args that obj can be applied to.  Returns #f if the object is not applicable."
+  #define Q_arity s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_pair_symbol, sc->not_symbol), sc->T)
+  /* check_method(sc, p, sc->arity_symbol, args); */
+  return(s7_arity(sc, car(args)));
+}
+
+
+/* -------------------------------- aritable? -------------------------------- */
+static bool closure_is_aritable(s7_scheme *sc, s7_pointer x, s7_pointer x_args, int32_t args)
+{
+  /* x_args is unprocessed -- it is exactly the list as used in the closure definition */
+  s7_int len;
+
+  if (args == 0)
+    return(!is_pair(x_args));
+  if (is_symbol(x_args))                /* any number of args is ok */
+    return(true);
+
+  len = closure_arity(x);
+  if (len == CLOSURE_ARITY_NOT_SET)
+    {
+      len = s7_list_length(sc, x_args);
+      closure_set_arity(x, len);
+    }
+  if (len < 0)                          /* dotted list => rest arg, (length '(a b . c)) is -2 */
+    return((-len) <= args);             /*   so we have enough to take care of the required args */
+  return(args == len);                  /* in a normal lambda list, there are no other possibilities */
+}
+
+static bool closure_star_is_aritable(s7_scheme *sc, s7_pointer x, s7_pointer x_args, int32_t args)
+{
+  if (is_symbol(x_args))
+    return(true);
+  closure_star_arity_1(sc, x, x_args);
+  return((closure_arity(x) == -1) ||
+	 (args <= closure_arity(x)));
+}
+
+bool s7_is_aritable(s7_scheme *sc, s7_pointer x, s7_int args)
+{
+  switch (type(x))
+    {
+    case T_C_FUNCTION:
+      return(c_function_is_aritable(x, args));
+    case T_C_RST_NO_REQ_FUNCTION:
+      if ((x == initial_value(sc->hash_table_symbol)) ||  /* these two need a value for each key */
+	  (x == initial_value(sc->weak_hash_table_symbol)))
+	return((args & 1) == 0);
+    case T_C_FUNCTION_STAR:
+      return(c_function_max_args(x) >= args);
+
+    case T_MACRO: case T_BACRO: case T_CLOSURE:
+      return(closure_is_aritable(sc, x, closure_args(x), args));
+
+    case T_MACRO_STAR: case T_BACRO_STAR: case T_CLOSURE_STAR:
+      return(closure_star_is_aritable(sc, x, closure_args(x), args));
+
+    case T_C_MACRO:
+      return((c_macro_min_args(x) <= args) &&
+	     (c_macro_max_args(x) >= args));
+
+    case T_GOTO: case T_CONTINUATION:
+      return(true);
+
+    case T_STRING:
+      return((args == 1) && (string_length(x) > 0)); /* ("" 0) -> error */
+
+    case T_C_OBJECT:
+      {
+	s7_pointer func;
+	if ((has_active_methods(sc, x)) &&
+	    ((func = find_method_with_let(sc, x, sc->is_aritable_symbol)) != sc->undefined))
+	  return(s7_apply_function(sc, func, set_plist_2(sc, x, make_integer(sc, args))) != sc->F);
+	return(is_safe_procedure(x));
+      }
+
+    case T_VECTOR: case T_INT_VECTOR: case T_FLOAT_VECTOR: case T_BYTE_VECTOR:
+      return((args > 0) &&
+	     (vector_length(x) > 0) &&   /* (#() 0) -> error */
+	     (args <= vector_rank(x)));
+
+    case T_LET: case T_HASH_TABLE: case T_PAIR: /* for hash-table, this refers to (table 'key) */
+      return(args == 1);
+
+    case T_ITERATOR:
+      return(args == 0);
+
+    case T_SYNTAX:
+      return((args >= syntax_min_args(x)) && ((args <= syntax_max_args(x)) || (syntax_max_args(x) == -1)));
+    }
+  return(false);
+}
+
+static s7_pointer g_is_aritable(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_aritable "(aritable? obj num-args) returns #t if 'obj can be applied to 'num-args arguments."
+  #define Q_is_aritable s7_make_signature(sc, 3, sc->is_boolean_symbol, sc->T, sc->is_integer_symbol)
+
+  s7_pointer n = cadr(args);
+  s7_int num;
+
+  if (!s7_is_integer(n)) /* remember gmp case! */
+    return(method_or_bust(sc, n, sc->is_aritable_symbol, args, sc->type_names[T_INTEGER], 2));
+
+  num = s7_integer_clamped_if_gmp(sc, n);
+  if (num < 0)
+    out_of_range_error_nr(sc, sc->is_aritable_symbol, int_two, n, it_is_negative_string);
+  if (num > MAX_ARITY) num = MAX_ARITY;
+  return(make_boolean(sc, s7_is_aritable(sc, car(args), num)));
+}
+
+static bool is_aritable_b_7pp(s7_scheme *sc, s7_pointer f, s7_pointer i) {return(g_is_aritable(sc, set_plist_2(sc, f, i)) != sc->F);}
+
+static int32_t arity_to_int(s7_scheme *sc, s7_pointer x)
+{
+  int32_t args;
+  switch (type(x))
+    {
+    case T_C_FUNCTION: case T_C_RST_NO_REQ_FUNCTION: case T_C_FUNCTION_STAR:
+      return(c_function_max_args(x));
+
+    case T_MACRO: case T_BACRO: case T_CLOSURE:
+      args = closure_arity_to_int(sc, x);
+      return((args < 0) ? MAX_ARITY : args);
+
+    case T_MACRO_STAR: case T_BACRO_STAR: case T_CLOSURE_STAR:
+      args = closure_star_arity_to_int(sc, x);
+      return((args < 0) ? MAX_ARITY : args);
+
+    case T_C_MACRO:  return(c_macro_max_args(x));
+    /* case T_C_OBJECT: return(MAX_ARITY); */ /* this currently can't be called */
+    /* vectors et al don't make sense here -- this is called only in g_set_setter below where it is restricted to is_any_procedure (type>=T_CLOSURE) */
+    }
+  if (S7_DEBUGGING) fprintf(stderr, "%s -1\n", __func__);
+  return(-1); /* unreachable I think */
+}
+
+
+/* -------------------------------- sequence? -------------------------------- */
+static s7_pointer g_is_sequence(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_sequence "(sequence? obj) returns #t if obj is a sequence (vector, string, pair, etc)"
+  #define Q_is_sequence sc->pl_bt
+  check_boolean_method(sc, is_simple_sequence, sc->is_sequence_symbol, args);
+}
+
+static bool is_sequence_b(s7_pointer p) {return(is_simple_sequence(p));}
+
+
+/* -------------------------------- setter ------------------------------------------------ */
+static s7_pointer b_simple_setter(s7_scheme *sc, int32_t typer, s7_pointer args) /* see bool_defun -> define_bool_function */
+{
+  if (type(cadr(args)) != typer)
+    error_nr(sc, sc->wrong_type_arg_symbol,
+	     set_elist_5(sc, wrap_string(sc, "set! ~S, ~S is ~A but should be ~A", 34),
+			 car(args), cadr(args), sc->type_names[type(cadr(args))], sc->type_names[typer]));
+  return(cadr(args));
+}
+
+/* these are for the simplified setter designation: (let ((x 1)) (set! (setter 'x) integer?) (set! x 3.14)) -> error */
+
+static s7_pointer b_is_symbol_setter(s7_scheme *sc, s7_pointer args)       {return(b_simple_setter(sc, T_SYMBOL, args));}
+static s7_pointer b_is_syntax_setter(s7_scheme *sc, s7_pointer args)       {return(b_simple_setter(sc, T_SYNTAX, args));}
+static s7_pointer b_is_let_setter(s7_scheme *sc, s7_pointer args)          {return(b_simple_setter(sc, T_LET, args));}
+static s7_pointer b_is_iterator_setter(s7_scheme *sc, s7_pointer args)     {return(b_simple_setter(sc, T_ITERATOR, args));}
+static s7_pointer b_is_c_pointer_setter(s7_scheme *sc, s7_pointer args)    {return(b_simple_setter(sc, T_C_POINTER, args));}
+static s7_pointer b_is_input_port_setter(s7_scheme *sc, s7_pointer args)   {return(b_simple_setter(sc, T_INPUT_PORT, args));}
+static s7_pointer b_is_output_port_setter(s7_scheme *sc, s7_pointer args)  {return(b_simple_setter(sc, T_OUTPUT_PORT, args));}
+static s7_pointer b_is_eof_object_setter(s7_scheme *sc, s7_pointer args)   {return(b_simple_setter(sc, T_EOF, args));}
+static s7_pointer b_is_random_state_setter(s7_scheme *sc, s7_pointer args) {return(b_simple_setter(sc, T_RANDOM_STATE, args));}
+static s7_pointer b_is_char_setter(s7_scheme *sc, s7_pointer args)         {return(b_simple_setter(sc, T_CHARACTER, args));}
+static s7_pointer b_is_string_setter(s7_scheme *sc, s7_pointer args)       {return(b_simple_setter(sc, T_STRING, args));}
+static s7_pointer b_is_float_vector_setter(s7_scheme *sc, s7_pointer args) {return(b_simple_setter(sc, T_FLOAT_VECTOR, args));}
+static s7_pointer b_is_int_vector_setter(s7_scheme *sc, s7_pointer args)   {return(b_simple_setter(sc, T_INT_VECTOR, args));}
+static s7_pointer b_is_byte_vector_setter(s7_scheme *sc, s7_pointer args)  {return(b_simple_setter(sc, T_BYTE_VECTOR, args));}
+static s7_pointer b_is_hash_table_setter(s7_scheme *sc, s7_pointer args)   {return(b_simple_setter(sc, T_HASH_TABLE, args));}
+static s7_pointer b_is_continuation_setter(s7_scheme *sc, s7_pointer args) {return(b_simple_setter(sc, T_CONTINUATION, args));}
+static s7_pointer b_is_null_setter(s7_scheme *sc, s7_pointer args)         {return(b_simple_setter(sc, T_NIL, args));}
+static s7_pointer b_is_pair_setter(s7_scheme *sc, s7_pointer args)         {return(b_simple_setter(sc, T_PAIR, args));}
+static s7_pointer b_is_boolean_setter(s7_scheme *sc, s7_pointer args)      {return(b_simple_setter(sc, T_BOOLEAN, args));}
+static s7_pointer b_is_undefined_setter(s7_scheme *sc, s7_pointer args)    {return(b_simple_setter(sc, T_UNDEFINED, args));}
+static s7_pointer b_is_unspecified_setter(s7_scheme *sc, s7_pointer args)  {return(b_simple_setter(sc, T_UNSPECIFIED, args));}
+static s7_pointer b_is_c_object_setter(s7_scheme *sc, s7_pointer args)     {return(b_simple_setter(sc, T_C_OBJECT, args));}
+static s7_pointer b_is_goto_setter(s7_scheme *sc, s7_pointer args)         {return(b_simple_setter(sc, T_GOTO, args));}
+
+#define b_setter(sc, typer, args, str, len)	\
+  do {						\
+    if (!typer(cadr(args)))			\
+      error_nr(sc, sc->wrong_type_arg_symbol,			\
+	       set_elist_5(sc, wrap_string(sc, "set! ~S, ~S is ~A but should be ~A", 34), \
+			   car(args), cadr(args), sc->type_names[type(cadr(args))], wrap_string(sc, str, len))); \
+    return(cadr(args));							\
+  } while (0)
+
+static s7_pointer b_is_number_setter(s7_scheme *sc, s7_pointer args)      {b_setter(sc, s7_is_complex, args, "a number", 8);}
+static s7_pointer b_is_complex_setter(s7_scheme *sc, s7_pointer args)     {b_setter(sc, s7_is_complex, args, "a number", 8);}
+static s7_pointer b_is_gensym_setter(s7_scheme *sc, s7_pointer args)      {b_setter(sc, is_gensym, args, "a gensym", 8);}
+static s7_pointer b_is_keyword_setter(s7_scheme *sc, s7_pointer args)     {b_setter(sc, is_symbol_and_keyword, args, "a keyword", 9);}
+static s7_pointer b_is_openlet_setter(s7_scheme *sc, s7_pointer args)     {b_setter(sc, has_methods, args, "an open let", 11);}
+static s7_pointer b_is_macro_setter(s7_scheme *sc, s7_pointer args)       {b_setter(sc, is_any_macro, args, "a macro", 7);}
+static s7_pointer b_is_integer_setter(s7_scheme *sc, s7_pointer args)     {b_setter(sc, s7_is_integer, args, "an integer", 10);}
+static s7_pointer b_is_byte_setter(s7_scheme *sc, s7_pointer args)        {b_setter(sc, is_byte, args, "an unsigned byte", 16);}
+static s7_pointer b_is_real_setter(s7_scheme *sc, s7_pointer args)        {b_setter(sc, is_real, args, "a real", 6);}
+static s7_pointer b_is_float_setter(s7_scheme *sc, s7_pointer args)       {b_setter(sc, is_t_real, args, "a float", 7);}
+static s7_pointer b_is_rational_setter(s7_scheme *sc, s7_pointer args)    {b_setter(sc, is_rational, args, "a rational", 10);}
+static s7_pointer b_is_list_setter(s7_scheme *sc, s7_pointer args)        {b_setter(sc, is_list, args, "a list", 6);}
+static s7_pointer b_is_vector_setter(s7_scheme *sc, s7_pointer args)      {b_setter(sc, is_any_vector, args, "a vector", 8);}
+static s7_pointer b_is_procedure_setter(s7_scheme *sc, s7_pointer args)   {b_setter(sc, is_any_procedure, args, "a procedure", 11);}
+static s7_pointer b_is_dilambda_setter(s7_scheme *sc, s7_pointer args)    {b_setter(sc, s7_is_dilambda, args, "a dilambda", 10);}
+static s7_pointer b_is_sequence_setter(s7_scheme *sc, s7_pointer args)    {b_setter(sc, is_sequence, args, "a sequence", 10);}
+static s7_pointer b_is_subvector_setter(s7_scheme *sc, s7_pointer args)   {b_setter(sc, is_subvector, args, "a subvector", 11);}
+static s7_pointer b_is_weak_hash_table_setter(s7_scheme *sc, s7_pointer args) {b_setter(sc, is_weak_hash_table, args, "a weak hash-table", 17);}
+
+static s7_pointer b_is_proper_list_setter(s7_scheme *sc, s7_pointer args)
+{
+  if (!s7_is_proper_list(sc, car(args)))
+    error_nr(sc, sc->wrong_type_arg_symbol,
+	     set_elist_5(sc, wrap_string(sc, "set! ~S, ~S is ~A but should be ~A", 34),
+			 car(args), cadr(args), sc->type_names[type(cadr(args))], wrap_string(sc, "a proper list", 13)));
+  return(cadr(args));
+}
+
+static s7_pointer lambda_setter(s7_scheme *sc, s7_pointer p)
+{
+  if (is_any_procedure(closure_setter(p)))                /* setter already known */
+    return(closure_setter(p));
+  if (!closure_no_setter(p))
+    {
+      s7_pointer f = funclet_entry(sc, p, sc->local_setter_symbol); /* look for +setter+, save value as closure_setter(p) */
+      if (f)
+	{
+	  if (f == sc->F)
+	    {
+	      closure_set_no_setter(p);
+	      return(sc->F);
+	    }
+	  if (!is_any_procedure(f))
+	    sole_arg_wrong_type_error_nr(sc, sc->setter_symbol, p, wrap_string(sc, "a procedure or a reasonable facsimile thereof", 45));
+	  closure_set_setter(p, f);
+	  return(f);
+	}
+      /* we used to search for setter here, but that can find the built-in setter causing an infinite loop (maybe check for that??) */
+      closure_set_no_setter(p);
+    }
+  return(sc->F);
+}
+
+static s7_pointer symbol_setter(s7_scheme *sc, s7_pointer sym, s7_pointer e)
+{
+  s7_pointer slot, setter;
+  if (is_keyword(sym))
+    return(sc->F);
+  if (e == sc->rootlet)
+    slot = global_slot(sym);
+  else
+    {
+      s7_pointer old_e = sc->curlet;
+      set_curlet(sc, e);
+      slot = s7_slot(sc, sym);
+      set_curlet(sc, old_e);
+    }
+  if ((!is_slot(slot)) || (!slot_has_setter(slot))) return(sc->F);
+  setter = slot_setter(slot);
+  if ((is_any_procedure(setter)) && (is_bool_function(setter))) return(c_function_setter(setter));
+  return(setter);
+}
+
+static s7_pointer setter_p_pp(s7_scheme *sc, s7_pointer p, s7_pointer e)
+{
+  if (!is_let(e))
+    wrong_type_error_nr(sc, sc->setter_symbol, 2, e, sc->type_names[T_LET]); /* need to check this in case let arg is bogus */
+
+  switch (type(p))
+    {
+    case T_MACRO:   case T_MACRO_STAR:
+    case T_BACRO:   case T_BACRO_STAR:
+    case T_CLOSURE: case T_CLOSURE_STAR:
+      return(lambda_setter(sc, p));
+
+    case T_C_FUNCTION: case T_C_FUNCTION_STAR: case T_C_RST_NO_REQ_FUNCTION:
+      return(c_function_setter(p));
+
+    case T_C_MACRO:
+      return(c_macro_setter(p));
+
+    case T_C_OBJECT:
+      check_method(sc, p, sc->setter_symbol, set_plist_2(sc, p, e));
+      return((c_object_set(sc, p) == fallback_set) ? sc->F : sc->c_object_set_function); /* for example ((setter obj) obj 0 1.0) if s7test block */
+      /* this could wrap the setter as an s7_function giving p's class-name etc */
+
+    case T_LET:
+      check_method(sc, p, sc->setter_symbol, set_plist_2(sc, p, e));
+      return(global_value(sc->let_set_symbol));
+
+    case T_ITERATOR:                           /* (set! (iter) val) doesn't fit the other setters */
+      return((is_any_closure(iterator_sequence(p))) ? closure_setter(iterator_sequence(p)) : sc->F);
+
+    case T_PAIR:         return(global_value(sc->list_set_symbol)); /* or maybe initial-value? */
+    case T_HASH_TABLE:   return(global_value(sc->hash_table_set_symbol));
+    case T_STRING:       return(global_value(sc->string_set_symbol));
+    case T_BYTE_VECTOR:  return(global_value(sc->byte_vector_set_symbol));
+    case T_VECTOR:       return(global_value(sc->vector_set_symbol));
+    case T_INT_VECTOR:   return(global_value(sc->int_vector_set_symbol));
+    case T_FLOAT_VECTOR: return(global_value(sc->float_vector_set_symbol));
+    case T_SLOT:         return((slot_has_setter(p)) ? slot_setter(p) : sc->F);
+
+    case T_SYMBOL:                             /* (setter symbol let) */
+      return(symbol_setter(sc, p, e));
+    }
+  /* wrong_type_error_nr(sc, sc->setter_symbol, 1, p, wrap_string(sc, "something that might have a setter", 34)); */ /* this seems unfriendly */
+  return(sc->F);
+}
+
+static s7_pointer g_setter(s7_scheme *sc, s7_pointer args)
+{
+  #define H_setter "(setter obj let) returns the setter associated with obj"
+  #define Q_setter s7_make_signature(sc, 3, s7_make_signature(sc, 2, \
+                     sc->not_symbol, sc->is_procedure_symbol), sc->T, s7_make_signature(sc, 2, sc->is_let_symbol, sc->is_null_symbol))
+  return(setter_p_pp(sc, car(args), (is_pair(cdr(args))) ? cadr(args) : sc->curlet));
+}
+
+s7_pointer s7_setter(s7_scheme *sc, s7_pointer obj) {return(setter_p_pp(sc, obj, sc->curlet));}
+
+
+/* -------------------------------- set-setter -------------------------------- */
+static void protect_setter(s7_scheme *sc, s7_pointer sym, s7_pointer fnc)
+{
+  s7_int loc;
+  if (sc->protected_setters_size == sc->protected_setters_loc)
+    {
+      s7_int size = sc->protected_setters_size;
+      s7_int new_size = 2 * size;
+      block_t *ob = vector_block(sc->protected_setters);
+      block_t *nb = reallocate(sc, ob, new_size * sizeof(s7_pointer));
+      block_info(nb) = NULL;
+      vector_block(sc->protected_setters) = nb;
+      vector_elements(sc->protected_setters) = (s7_pointer *)block_data(nb);
+      vector_length(sc->protected_setters) = new_size;
+
+      ob = vector_block(sc->protected_setter_symbols);
+      nb = reallocate(sc, ob, new_size * sizeof(s7_pointer));
+      vector_block(sc->protected_setter_symbols) = nb;
+      vector_elements(sc->protected_setter_symbols) = (s7_pointer *)block_data(nb);
+      vector_length(sc->protected_setter_symbols) = new_size;
+
+      for (s7_int i = size; i < new_size; i++)
+	{
+	  vector_element(sc->protected_setters, i) = sc->unused;
+	  vector_element(sc->protected_setter_symbols, i) = sc->unused;
+	}
+      sc->protected_setters_size = new_size;
+    }
+  loc = sc->protected_setters_loc++;
+  vector_element(sc->protected_setters, loc) = fnc; /* has_closure => T_Clo(fnc) checked earlier */
+  vector_element(sc->protected_setter_symbols, loc) = sym;
+}
+
+static s7_pointer symbol_set_setter(s7_scheme *sc, s7_pointer sym, s7_pointer args)
+{
+  s7_pointer func, slot;
+  if (is_keyword(sym))
+    wrong_type_error_nr(sc, wrap_string(sc, "set! setter", 11), 1, sym, wrap_string(sc, "a normal symbol (a keyword can't be set)", 40));
+
+  if (is_pair(cddr(args)))
+    {
+      s7_pointer e = cadr(args); /* (let ((x 1)) (set! (setter 'x (curlet)) (lambda (s v e) ...))): args is (x (inlet 'x 1) #<lambda (s v ...)>) */
+      func = caddr(args);
+      if (e == sc->rootlet)
+	slot = global_slot(sym);
+      else
+	{
+	  if (!is_let(e))
+	    wrong_type_error_nr(sc, wrap_string(sc, "set! setter", 11), 2, e, sc->type_names[T_LET]);
+	  slot = lookup_slot_with_let(sc, sym, e);
+	}}
+  else
+    {
+      slot = s7_slot(sc, sym); /* (set! (setter 'x) (lambda (s v) ...)): args is: (x #<lambda (s v)>) */
+      func = cadr(args);
+    }
+  if (!is_slot(slot))
+    return(sc->F);
+
+  if (func != sc->F)
+    {
+      if (sym == sc->setter_symbol)
+	immutable_object_error_nr(sc, set_elist_2(sc, wrap_string(sc, "can't set (setter 'setter) to ~S", 32), func));
+      if (is_syntax_or_qq(slot_value(slot)))         /* (set! (setter 'begin) ...), qq is syntax sez r7rs */
+	immutable_object_error_nr(sc, set_elist_3(sc, wrap_string(sc, "can't set (setter '~S) to ~S", 28), sym, func));
+      if (!is_any_procedure(func))   /* disallow continuation/goto here */
+	wrong_type_error_nr(sc, wrap_string(sc, "set! setter", 11), 3, func, wrap_string(sc, "a function or #f", 16));
+      if (func == global_value(sc->values_symbol))
+	error_nr(sc, make_symbol(sc, "invalid-setter", 14),
+		 set_elist_2(sc, wrap_string(sc, "~S's setter can't be values", 27), sym));
+      if ((!is_c_function(func)) || (!c_function_has_bool_setter(func)))
+	{
+	  if (s7_is_aritable(sc, func, 3))
+	    set_has_let_arg(func);
+	  else
+	    if (!s7_is_aritable(sc, func, 2))
+	      error_nr(sc, sc->wrong_type_arg_symbol,
+		       set_elist_2(sc, wrap_string(sc, "symbol setter function, ~A, should take 2 or 3 arguments", 56), func));
+	}}
+  if (slot == global_slot(sym))
+    s7_set_setter(sc, sym, func);   /* special GC protection for global vars */
+  else slot_set_setter(slot, func); /* func might be #f */
+  if (func != sc->F)
+    slot_set_has_setter(slot);
+  return(func);
+}
+
+static s7_pointer g_set_setter(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer p = car(args), setter;
+  if (is_symbol(p)) /* has to precede cadr(args) checks, (set! (setter 'x let) ...) where setter is caddr(args) */
+    return(symbol_set_setter(sc, p, args));
+  if (p == sc->s7_starlet)
+    wrong_type_error_nr(sc, wrap_string(sc, "set! setter", 11), 1, p, wrap_string(sc, "something other than *s7*", 25));
+
+  setter = cadr(args);
+  if (setter != sc->F)
+    {
+      if (!is_any_procedure(setter))
+	wrong_type_error_nr(sc, wrap_string(sc, "set! setter", 11), 2, setter, wrap_string(sc, "a procedure or #f", 17));
+      if (arity_to_int(sc, setter) < 1)          /* we need at least an arg for the set! value */
+	error_nr(sc, sc->wrong_type_arg_symbol,
+		 set_elist_2(sc, wrap_string(sc, "setter function, ~A, should take at least one argument", 54), setter));
+      if (setter == global_value(sc->values_symbol))
+	error_nr(sc, make_symbol(sc, "invalid-setter", 14),
+		 set_elist_2(sc, wrap_string(sc, "~S's setter can't be values", 27), p));
+    }
+  switch (type(p))
+    {
+    case T_MACRO:   case T_MACRO_STAR:
+    case T_BACRO:   case T_BACRO_STAR:
+    case T_CLOSURE: case T_CLOSURE_STAR:
+      closure_set_setter(p, setter);
+      if (setter == sc->F)
+	closure_set_no_setter(p);
+      break;
+
+    case T_C_FUNCTION: case T_C_FUNCTION_STAR: case T_C_RST_NO_REQ_FUNCTION:
+      if (p == global_value(sc->setter_symbol))      /* (immutable? (setter setter)) is #t, but we aren't checking immutable? here -- maybe we should? */
+	immutable_object_error_nr(sc, set_elist_2(sc, wrap_string(sc, "can't set (setter setter) to ~S", 31), setter));
+      if (p == global_value(sc->values_symbol))       /* 6-Oct-23 (set! (setter values) ...) is problematic, see splice_in_values */
+	immutable_object_error_nr(sc, set_elist_2(sc, wrap_string(sc, "can't set (setter values) to ~S", 31), setter));
+      c_function_set_setter(p, setter);
+      if ((is_any_closure(setter)) ||
+	  (is_any_macro(setter)))
+	add_setter(sc, p, setter);
+      break;
+
+    case T_C_MACRO:
+      c_macro_set_setter(p, setter);
+      if ((is_any_closure(setter)) ||
+	  (is_any_macro(setter)))
+	add_setter(sc, p, setter);
+      break;
+
+    default:  /* (set! (setter 4) ...) or p==continuation etc */
+      wrong_type_error_nr(sc, wrap_string(sc, "set! setter", 11), 1, p, wrap_string(sc, "a symbol, a procedure, or a macro", 33));
+    }
+  return(setter);
+}
+
+s7_pointer s7_set_setter(s7_scheme *sc, s7_pointer p, s7_pointer setter)
+{
+  if (is_symbol(p))
+    {
+      if (slot_has_setter(global_slot(p)))
+	for (s7_int index = 0; index < sc->protected_setters_loc; index++)
+	  if (vector_element(sc->protected_setter_symbols, index) == p)
+	    {
+	      s7_pointer old_func = vector_element(sc->protected_setters, index);
+	      if ((is_any_procedure(old_func)) && /* i.e. not #f! */
+		  (is_immutable(old_func)))
+		return(setter);
+	      vector_element(sc->protected_setters, index) = setter;
+	      slot_set_setter(global_slot(p), setter);
+	      if ((setter != sc->F) && (s7_is_aritable(sc, setter, 3)))
+		set_has_let_arg(setter);
+	      return(setter);
+	    }
+      if (setter != sc->F)
+	{
+	  slot_set_has_setter(global_slot(p));
+	  if (!is_c_function(setter)) protect_setter(sc, p, T_Clo(setter)); /* these don't need GC protection */
+	  slot_set_setter(global_slot(p), setter);
+	  if (s7_is_aritable(sc, setter, 3))
+	    set_has_let_arg(setter);
+	  return(setter);
+	}
+      slot_set_setter(global_slot(p), sc->F);
+      return(sc->F);
+    }
+  return(g_set_setter(sc, set_plist_2(sc, p, setter))); /* if T_Clo(setter), doesn't it need GC protection as above? */
+}
+
+/* (let () (define xxx 23) (define (hix) (set! xxx 24)) (hix) (set! (setter 'xxx) (lambda (sym val) (format *stderr* "val: ~A~%" val) val)) (hix))
+ *    so set setter before use!
+ */
+
+static s7_pointer call_c_function_setter(s7_scheme *sc, s7_pointer func, s7_pointer symbol, s7_pointer new_value)
+{
+  if (has_let_arg(func)) /* setter has optional third arg, the let */
+    return(c_function_call(func)(sc, with_list_t3(symbol, new_value, sc->curlet)));
+  return(c_function_call(func)(sc, with_list_t2(symbol, new_value)));
+}
+
+static s7_pointer call_setter(s7_scheme *sc, s7_pointer slot, s7_pointer new_value) /* see also op_set1 */
+{
+  s7_pointer func = slot_setter(slot), result;
+  if (is_c_function(func))
+    return(call_c_function_setter(sc, func, slot_symbol(slot), new_value));
+  if (!is_any_procedure(func))
+    return(new_value);
+  sc->temp10 = (has_let_arg(func)) ? list_3(sc, slot_symbol(slot), new_value, sc->curlet) : list_2(sc, slot_symbol(slot), new_value);
+  /* safe lists here are much slower -- the setters are called more often for some reason (see tset.scm) */
+  result = s7_call(sc, func, sc->temp10);
+  sc->temp10 = sc->unused;
+  return(result);
+}
+
+static s7_pointer bind_symbol_with_setter(s7_scheme *sc, opcode_t op, s7_pointer symbol, s7_pointer new_value)
+{
+  s7_pointer func = setter_p_pp(sc, symbol, sc->curlet);
+  if (is_c_function(func))
+    return(call_c_function_setter(sc, func, symbol, new_value));
+  if (!is_any_procedure(func))
+    return(new_value);
+  sc->args = (has_let_arg(func)) ? list_3(sc, symbol, new_value, sc->curlet) : list_2(sc, symbol, new_value);
+  push_stack_direct(sc, op);
+  sc->code = func;
+  return(sc->no_value); /* this means the setter in set! needs to goto APPLY to get the new value */
+}
+
+
+/* -------------------------------- hooks -------------------------------- */
+s7_pointer s7_hook_functions(s7_scheme *sc, s7_pointer hook)
+{
+  return(s7_symbol_local_value(sc, sc->body_symbol, closure_let(hook)));
+}
+
+s7_pointer s7_hook_set_functions(s7_scheme *sc, s7_pointer hook, s7_pointer functions)
+{
+  if (is_list(functions))
+    let_set_2(sc, closure_let(hook), sc->body_symbol, functions);
+  return(functions);
+}
+
+
+/* -------------------------------- eq? eqv? equal? equivalent? -------------------------------- */
+bool s7_is_eq(s7_pointer obj1, s7_pointer obj2)
+{
+  return((obj1 == obj2) ||                                     /* so floats and NaNs might be eq? but not eqv? */
+	 ((is_unspecified(obj1)) && (is_unspecified(obj2))));  /* this is needed because this function is used by s7_b_pp */
+}
+
+static s7_pointer is_eq_p_pp(s7_scheme *sc, s7_pointer obj1, s7_pointer obj2)
+{
+  return(make_boolean(sc, ((obj1 == obj2) || ((is_unspecified(obj1)) && (is_unspecified(obj2))))));
+}
+
+static s7_pointer g_is_eq(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_eq "(eq? obj1 obj2) returns #t if obj1 is eq to (the same object as) obj2"
+  #define Q_is_eq sc->pcl_bt
+  return(make_boolean(sc, ((car(args) == cadr(args)) ||
+			   ((is_unspecified(car(args))) && (is_unspecified(cadr(args)))))));
+  /* (eq? (apply apply apply values '(())) #<unspecified>) should return #t */
+}
+
+bool s7_is_eqv(s7_scheme *sc, s7_pointer a, s7_pointer b)
+{
+#if WITH_GMP
+  if ((is_big_number(a)) || (is_big_number(b))) return(big_numbers_are_eqv(sc, a, b));
+#endif
+  if (type(a) != type(b)) return(false);
+  if ((a == b) && (!is_number(a)))         /* if a is NaN, a == b doesn't mean (eqv? a b) */
+    return(true);                          /* a == b means (let ((x "a")) (let ((y x)) (eqv? x y))) is #t */
+  if (is_number(a)) return(numbers_are_eqv(sc, a, b));
+  if (is_unspecified(a)) return(true);     /* types are the same so we know b is also unspecified */
+  return(false);
+}
+
+static s7_pointer g_is_eqv(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_eqv "(eqv? obj1 obj2) returns #t if obj1 is equivalent to obj2"
+  #define Q_is_eqv sc->pcl_bt
+  return(make_boolean(sc, s7_is_eqv(sc, car(args), cadr(args))));
+}
+
+static s7_pointer is_eqv_p_pp(s7_scheme *sc, s7_pointer obj1, s7_pointer obj2) {return(make_boolean(sc, s7_is_eqv(sc, obj1, obj2)));}
+
+static bool floats_are_equivalent(s7_scheme *sc, s7_double x, s7_double y)
+{
+  s7_double diff;
+  if (x == y) return(true);
+  diff = fabs(x - y);
+  if (diff <= sc->equivalent_float_epsilon) return(true);
+  return((is_NaN(x)) && (is_NaN(y)));
+}
+
+#if WITH_GMP
+static bool big_floats_are_equivalent(s7_scheme *sc, mpfr_t x, mpfr_t y)
+{
+  /* protect mpfr_1 */
+  if ((mpfr_nan_p(x)) || (mpfr_nan_p(y)))
+    return((mpfr_nan_p(x)) && (mpfr_nan_p(y)));
+  mpfr_sub(sc->mpfr_3, x, y, MPFR_RNDN);
+  mpfr_abs(sc->mpfr_3, sc->mpfr_3, MPFR_RNDN);
+  return(mpfr_cmp_d(sc->mpfr_3, sc->equivalent_float_epsilon) <= 0);
+}
+#endif
+
+static bool eq_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *unused_ci) {return(x == y);}
+
+static bool symbol_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci) /* symbol equal uses eq -- should it check keywords as below? */
+{
+  if (x == y) return(true);
+  if (!is_symbol(y)) return(false);
+  if (is_keyword(y))
+    return((is_keyword(x)) && (keyword_symbol(x) == keyword_symbol(y))); /* (equivalent? key: :key) -> #t */
+  if (is_keyword(x)) return(false);
+  return((is_slot(global_slot(x))) &&                 /* the optimizer can replace the original symbol with its value */
+	 (is_syntax(global_value(x))) &&
+	 (is_slot(global_slot(y))) &&
+	 (is_syntax(global_value(y))) &&
+	 (syntax_symbol(global_value(x)) == syntax_symbol(global_value(y))));
+}
+
+static bool unspecified_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  return(is_unspecified(y));
+}
+
+static bool undefined_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  return((x == y) ||
+	 ((is_undefined(y)) && (undefined_name_length(x) == undefined_name_length(y)) &&
+	  (safe_strcmp(undefined_name(x), undefined_name(y)))));
+}
+
+static bool is_equal_1(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  return((*(equals[type(x)]))(sc, x, y, ci));
+}
+
+static bool is_equivalent_1(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  return((*(equivalents[type(x)]))(sc, x, y, ci));
+}
+
+static bool c_pointer_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  shared_info_t *nci = ci;
+  if (x == y) return(true);
+  if (!s7_is_c_pointer(y)) return(false);
+  if (c_pointer(x) != c_pointer(y)) return(false);
+  if (c_pointer_type(x) != c_pointer_type(y))
+    {
+      if (!nci) nci = clear_shared_info(sc->circle_info);
+      if (!is_equivalent_1(sc, c_pointer_type(x), c_pointer_type(y), nci))
+	return(false);
+    }
+  if (c_pointer_info(x) != c_pointer_info(y))
+    {
+      if (!nci) nci = clear_shared_info(sc->circle_info);
+      if (!is_equivalent_1(sc, c_pointer_info(x), c_pointer_info(y), nci))
+	return(false);
+    }
+  return(true);
+}
+
+static bool c_pointer_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  shared_info_t *nci = ci;
+  if (x == y) return(true);
+  if (!s7_is_c_pointer(y)) return(false);
+  if (c_pointer(x) != c_pointer(y)) return(false);
+  if (c_pointer_type(x) != c_pointer_type(y))
+    {
+      if (!nci) nci = clear_shared_info(sc->circle_info);
+      if (!is_equal_1(sc, c_pointer_type(x), c_pointer_type(y), nci))
+	return(false);
+    }
+  if (c_pointer_info(x) != c_pointer_info(y))
+    {
+      if (!nci) nci = clear_shared_info(sc->circle_info);
+      if (!is_equal_1(sc, c_pointer_info(x), c_pointer_info(y), nci))
+	return(false);
+    }
+  return(true);
+}
+
+static bool string_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  return((is_string(y)) && (scheme_strings_are_equal(x, y)));
+}
+
+static bool syntax_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  return((is_syntax(y)) && (syntax_symbol(x) == syntax_symbol(y)));
+}
+
+static bool port_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci) {return(x == y);}
+
+static bool port_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  if (x == y) return(true);
+  if (type(x) != type(y)) return(false);
+  if ((port_is_closed(x)) && (port_is_closed(y))) return(true);
+  if ((port_is_closed(x)) || (port_is_closed(y))) return(false); /* if either is closed, port_port (below) might be null */
+  if (port_type(x) != port_type(y)) return(false);
+  switch (port_type(x))
+    {
+    case STRING_PORT:
+      return((port_position(x) == port_position(y)) &&
+	     (port_data_size(x) == port_data_size(y)) &&
+	     (local_strncmp((const char *)port_data(x), (const char *)port_data(y), (is_input_port(x)) ? port_data_size(x) : port_position(x))));
+    case FILE_PORT:
+      return((is_input_port(x)) &&
+	     (port_position(x) == port_position(y)) &&
+	     (local_strncmp((const char *)port_filename(x), (const char *)port_filename(y), port_filename_length(x))));
+    case FUNCTION_PORT:
+      if (is_input_port(x))
+	return(port_input_function(x) == port_input_function(y));
+      return(port_output_function(x) == port_output_function(y));
+    }
+  return(false);
+}
+
+static void add_shared_ref(shared_info_t *ci, s7_pointer x, int32_t ref_x)
+{
+  /* called only in equality check, not printer */
+  if (ci->top == ci->size)
+    enlarge_shared_info(ci);
+  set_collected(x);
+  ci->objs[ci->top] = x;
+  ci->refs[ci->top++] = ref_x;
+}
+
+static Inline bool inline_equal_ref(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci) /* pair_equal:lg/list/io, [read] */
+{
+  /* here we know x and y are pointers to the same type of structure */
+  int32_t ref_y = (is_collected(y)) ? peek_shared_ref_1(ci, y) : 0;
+  if (is_collected(x))
+    {
+      int32_t ref_x = peek_shared_ref_1(ci, x);
+      if (ref_y != 0)
+	return(ref_x == ref_y);	/* this is a change from the macro version 16-Jan-20 -- only true returns from the caller */
+      /* try to harmonize the new guy -- there can be more than one structure equal to the current one */
+      if (ref_x != 0)
+	add_shared_ref(ci, y, ref_x);
+    }
+  else
+    if (ref_y != 0)
+      add_shared_ref(ci, x, ref_y);
+    else
+      {
+	/* assume neither x nor y is in the table, and that they should share a ref value, called only in equality check, not printer */
+	if (ci->top >= ci->size2) enlarge_shared_info(ci);
+	set_collected(x);
+	set_collected(y);
+	ci->objs[ci->top] = x;
+	ci->refs[ci->top++] = ++ci->ref;
+	ci->objs[ci->top] = y;
+	ci->refs[ci->top++] = ci->ref;
+      }
+  return(false);
+}
+
+static bool equal_ref(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci) {return(inline_equal_ref(sc, x, y, ci));}
+
+static bool c_objects_are_equal(s7_scheme *sc, s7_pointer a, s7_pointer b, shared_info_t *ci)
+{
+  s7_pointer (*to_list)(s7_scheme *sc, s7_pointer args);
+  shared_info_t *nci = ci;
+  s7_pointer pa, pb;
+
+  if (a == b)
+    return(true);
+  if (!is_c_object(b))
+    return(false);
+  if (c_object_type(a) != c_object_type(b))
+    return(false);
+
+  if (c_object_equal(sc, a))
+    return(((*(c_object_equal(sc, a)))(sc, set_clist_2(sc, a, b))) != sc->F);
+  if (c_object_eql(sc, a))
+    return((*(c_object_eql(sc, a)))(c_object_value(a), c_object_value(b)));
+
+  to_list = c_object_to_list(sc, a);
+  if (!to_list)
+    return(false);
+  if (ci)
+    {
+      if (equal_ref(sc, a, b, ci)) return(true); /* and nci == ci above */
+    }
+  else nci = clear_shared_info(sc->circle_info);
+
+  for (pa = to_list(sc, set_plist_1(sc, a)), pb = to_list(sc, set_plist_1(sc, b)); is_pair(pa) && (is_pair(pb)); pa = cdr(pa), pb = cdr(pb))
+    if (!(is_equal_1(sc, car(pa), car(pb), nci)))
+      return(false);
+  return(pa == pb); /* presumably both are nil if successful */
+}
+
+#define check_equivalent_method(Sc, X, Y) \
+  do {						 \
+    if (has_active_methods(sc, X))					\
+      {									\
+	s7_pointer equal_func = find_method_with_let(Sc, X, Sc->is_equivalent_symbol); \
+	if (equal_func != Sc->undefined)				\
+	  return(s7_boolean(Sc, s7_apply_function(Sc, equal_func, set_plist_2(Sc, X, Y)))); \
+      }}								\
+    while (0)
+
+static bool c_objects_are_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  check_equivalent_method(sc, x, y);
+  if (c_object_equivalent(sc, x))
+    return(((*(c_object_equivalent(sc, x)))(sc, set_plist_2(sc, x, y))) != sc->F);
+  return(c_objects_are_equal(sc, x, y, ci));
+}
+
+static bool hash_table_equal_1(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci, bool equivalent)
+{
+  hash_entry_t **lists;
+  s7_int len;
+  shared_info_t *nci = ci;
+  hash_check_t hf;
+  bool (*eqf)(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci);
+
+  if (x == y)
+    return(true);
+  if (!is_hash_table(y))
+    {
+      if (equivalent)
+	check_equivalent_method(sc, y, x);
+      return(false);
+    }
+  if ((ci) && (equal_ref(sc, x, y, ci))) return(true);
+
+  if (hash_table_entries(x) != hash_table_entries(y))
+    return(false);
+  if (hash_table_entries(x) == 0)
+    return(true);
+  if ((!equivalent) && ((hash_table_mapper(x) != default_hash_map) || (hash_table_mapper(y) != default_hash_map)))
+    {
+      if (hash_table_checker(x) != hash_table_checker(y))
+	return(false);
+      if (hash_table_mapper(x) != hash_table_mapper(y))
+	return(false);
+    }
+
+  len = hash_table_size(x);
+  lists = hash_table_elements(x);
+  if (!nci) nci = clear_shared_info(sc->circle_info);
+  eqf = (equivalent) ? is_equivalent_1 : is_equal_1;
+
+  hf = hash_table_checker(y);
+  if ((hf != hash_equal) && (hf != hash_equivalent))
+    {
+      for (s7_int i = 0; i < len; i++)
+	for (hash_entry_t *p = lists[i]; p; p = hash_entry_next(p))
+	  {
+	    hash_entry_t *y_val = hf(sc, y, hash_entry_key(p));
+	    if (y_val == sc->unentry)
+	      return(false);
+	    if (!eqf(sc, hash_entry_value(p), hash_entry_value(y_val), nci))
+	      return(false);
+	  }
+      /* if we get here, every key/value in x has a corresponding key/value in y, and the number of entries match, so surely the tables are equal??
+       * if ci not null or hash-table-checker is equal/eqivalent, can't use hf?
+       */
+      return(true);
+    }
+
+  /* we need to protect the current shared_info data (nci) here so the current hash_table_checker won't work --
+   *   outside equal?/eqivalent? they can safely assume that they can start a new shared_info process.
+   */
+  for (s7_int i = 0; i < len; i++)
+    for (hash_entry_t *p = lists[i]; p; p = hash_entry_next(p))
+      {
+	s7_pointer key = hash_entry_key(p);
+	s7_int hash = hash_loc(sc, y, key);
+	s7_int loc = hash & hash_table_mask(y);
+	hash_entry_t *xe;
+
+	for (xe = hash_table_element(y, loc); xe; xe = hash_entry_next(xe))
+	  if ((hash_entry_raw_hash(xe) == hash) &&
+	      (eqf(sc, hash_entry_key(xe), key, nci)))
+	    break;
+	if (!xe)
+	  return(false);
+	if (!eqf(sc, hash_entry_value(p), hash_entry_value(xe), nci))
+	  return(false);
+      }
+  return(true);
+}
+
+static bool hash_table_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)      {return(hash_table_equal_1(sc, x, y, ci, false));}
+static bool hash_table_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci) {return(hash_table_equal_1(sc, x, y, ci, true));}
+
+static bool slots_match(s7_scheme *sc, s7_pointer px, s7_pointer y, shared_info_t *nci)
+{
+  for (s7_pointer ey = y; ey; ey = let_outlet(ey))
+    for (s7_pointer py = let_slots(ey); tis_slot(py); py = next_slot(py))
+      if (slot_symbol(px) == slot_symbol(py)) /* we know something will match */
+	return(is_equal_1(sc, slot_value(px), slot_value(py), nci));
+  return(false);
+}
+
+static bool slots_equivalent_match(s7_scheme *sc, s7_pointer px, s7_pointer y, shared_info_t *nci)
+{
+  for (s7_pointer ey = y; ey; ey = let_outlet(ey))
+    for (s7_pointer py = let_slots(ey); tis_slot(py); py = next_slot(py))
+      if (slot_symbol(px) == slot_symbol(py)) /* we know something will match */
+	return(is_equivalent_1(sc, slot_value(px), slot_value(py), nci));
+  return(false);
+}
+
+static bool let_equal_1(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci, bool equivalent)
+{
+  s7_pointer ex, ey, px, py;
+  shared_info_t *nci = ci;
+  int32_t x_len, y_len;
+
+  if ((!is_let(y)) || (x == sc->rootlet) || (y == sc->rootlet)) /* (equal? (rootlet) (rootlet)) is checked in let_equal below */
+    return(false);
+
+  if ((ci) && (equal_ref(sc, x, y, ci))) return(true);
+
+  clear_symbol_list(sc);
+  for (x_len = 0, ex = x; ex; ex = let_outlet(ex))
+    for (px = let_slots(ex); tis_slot(px); px = next_slot(px))
+      if (!symbol_is_in_list(sc, slot_symbol(px)))
+	{
+	  add_symbol_to_list(sc, slot_symbol(px));
+	  x_len++;
+	}
+
+  for (ey = y; ey; ey = let_outlet(ey))
+    for (py = let_slots(ey); tis_slot(py); py = next_slot(py))
+      if (!symbol_is_in_list(sc, slot_symbol(py)))           /* symbol in y, not in x */
+	return(false);
+
+  for (y_len = 0, ey = y; ey; ey = let_outlet(ey))
+    for (py = let_slots(ey); tis_slot(py); py = next_slot(py))
+      if (symbol_tag(slot_symbol(py)) != 0)
+	{
+	  y_len++;
+	  symbol_set_tag(slot_symbol(py), 0);
+	}
+
+  if (x_len != y_len)                                        /* symbol in x, not in y */
+    return(false);
+
+  if (!nci) nci = clear_shared_info(sc->circle_info);
+
+  for (ex = x; ex; ex = let_outlet(ex))
+    for (px = let_slots(ex); tis_slot(px); px = next_slot(px))
+      if (symbol_tag(slot_symbol(px)) == 0)                  /* unshadowed */
+	{
+	  symbol_set_tag(slot_symbol(px), sc->syms_tag);     /* values don't match */
+	  if (((!equivalent) && (!slots_match(sc, px, y, nci))) ||
+	      ((equivalent) && (!slots_equivalent_match(sc, px, y, nci))))
+	    return(false);
+	}
+  return(true);
+}
+
+static bool let_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  /* x == y if all unshadowed vars match, leaving aside the rootlet, so that for any local variable, we get the same value in either x or y */
+  return((x == y) || (let_equal_1(sc, x, y, ci, false)));
+}
+
+/* what should these do if there are setters? */
+static bool let_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  if (x == y) return(true);
+  if (!is_global(sc->is_equivalent_symbol))
+    {
+      check_equivalent_method(sc, x, y);
+      check_equivalent_method(sc, y, x);
+    }
+  return(let_equal_1(sc, x, y, ci, true));
+}
+
+static bool closure_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  if (x == y)
+    return(true);
+  if (type(x) != type(y))
+    return(false);
+  if ((has_active_methods(sc, x)) &&
+      (has_active_methods(sc, y)))
+    {
+      s7_pointer equal_func = find_method(sc, closure_let(x), sc->is_equal_symbol);
+      if (equal_func != sc->undefined)
+	return(s7_boolean(sc, s7_apply_function(sc, equal_func, set_plist_2(sc, x, y))));
+    }
+  return(false);
+}
+
+static bool closure_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  if (x == y)
+    return(true);
+  if (type(x) != type(y))
+    return(false);
+  if (has_active_methods(sc, y))
+    check_equivalent_method(sc, x, y);
+  /* not sure about this -- we can't simply check let_equal(closure_let(x), closure_let(y))
+   *   because locally defined constant functions on the second pass find the outer let.
+   */
+  return((is_equivalent_1(sc, closure_args(x), closure_args(y), ci)) &&
+	 (is_equivalent_1(sc, closure_body(x), closure_body(y), ci)));
+}
+
+static bool pair_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  s7_pointer px, py;
+  if (x == y)
+    return(true);
+  if (!is_pair(y))
+    return(false);
+  if (!ci)
+    ci = clear_shared_info(sc->circle_info);
+  else
+    if (inline_equal_ref(sc, x, y, ci))
+      return(true);
+
+  if (!is_equal_1(sc, car(x), car(y), ci)) return(false);
+  for (px = cdr(x), py = cdr(y); (is_pair(px)) && (is_pair(py)); px = cdr(px), py = cdr(py))
+    {
+      if (!is_equal_1(sc, car(px), car(py), ci)) return(false);
+      if (inline_equal_ref(sc, px, py, ci)) return(true);
+    }
+  return((px == py) || (is_equal_1(sc, px, py, ci)));
+}
+
+static bool pair_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  s7_pointer px, py;
+  if (x == y)
+    return(true);
+  if (!is_pair(y))
+    {
+      check_equivalent_method(sc, y, x);
+      return(false);
+    }
+  if (!ci)
+    ci = clear_shared_info(sc->circle_info);
+  else
+    if (inline_equal_ref(sc, x, y, ci))
+      return(true);
+
+  if (!is_equivalent_1(sc, car(x), car(y), ci)) return(false);
+  for (px = cdr(x), py = cdr(y); (is_pair(px)) && (is_pair(py)); px = cdr(px), py = cdr(py))
+    {
+      if (!is_equivalent_1(sc, car(px), car(py), ci)) return(false);
+      if (inline_equal_ref(sc, px, py, ci)) return(true);
+    }
+  return((px == py) || ((is_equivalent_1(sc, px, py, ci))));
+}
+
+static bool vector_rank_match(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  s7_int x_dims;
+
+  if (!vector_has_dimension_info(x))
+    return((!vector_has_dimension_info(y)) || (vector_ndims(y) == 1));
+  x_dims = vector_ndims(x);
+  if (x_dims == 1)
+    return((!vector_has_dimension_info(y)) || (vector_ndims(y) == 1));
+  if ((!vector_has_dimension_info(y)) ||
+      (x_dims != vector_ndims(y)))
+    return(false);
+
+  for (s7_int j = 0; j < x_dims; j++)
+    if (vector_dimension(x, j) != vector_dimension(y, j))
+      return(false);
+  return(true);
+}
+
+static bool iv_meq(const s7_int *ex, const s7_int *ey, s7_int len)
+{
+  s7_int i = 0, left = len - 8;
+  while (i <= left)
+    LOOP_8(if (ex[i] != ey[i]) return(false); i++);
+  for (; i < len; i++)
+    if (ex[i] != ey[i])
+      return(false);
+  return(true);
+}
+
+static bool byte_vector_equal_1(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+  s7_int len = vector_length(x);
+  const uint8_t *xp = byte_vector_bytes(x);
+  const uint8_t *yp = byte_vector_bytes(y);
+  for (s7_int i = 0; i < len; i++)
+    if (xp[i] != yp[i])
+      return(false);
+  return(true);
+}
+
+static bool biv_meq(s7_pointer x, s7_pointer y)
+{
+  s7_int len = vector_length(x);
+  const uint8_t *xp = byte_vector_bytes(x);
+  const s7_int *yp = int_vector_ints(y);
+  for (s7_int i = 0; i < len; i++)
+    if ((s7_int)(xp[i]) != yp[i])
+      return(false);
+  return(true);
+}
+
+#define base_vector_equal(sc, x, y)			\
+  do {							\
+    if (x == y) return(true);				\
+    len = vector_length(x);				\
+    if (len != vector_length(y)) return(false);		\
+    if (!vector_rank_match(sc, x, y)) return(false);	\
+    if (len == 0) return(true);				\
+  } while (0)
+
+static bool vector_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  s7_int len;
+  shared_info_t *nci = ci;
+
+  if (!is_any_vector(y)) return(false);
+  base_vector_equal(sc, x, y); /* sets len */
+  if (type(x) != type(y))
+    {
+      if ((is_int_vector(x)) && (is_byte_vector(y)))
+	return(biv_meq(y, x));
+      if ((is_byte_vector(x)) && (is_int_vector(y)))
+	return(biv_meq(x, y));
+      for (s7_int i = 0; i < len; i++)
+	if (!is_equal_1(sc, vector_getter(x)(sc, x, i), vector_getter(y)(sc, y, i), NULL)) /* this could be greatly optimized */
+	  return(false);
+      return(true);
+    }
+  if (!has_simple_elements(x))
+    {
+      if (ci)
+	{
+	  if (equal_ref(sc, x, y, ci)) return(true);
+	}
+      else nci = clear_shared_info(sc->circle_info);
+    }
+  for (s7_int i = 0; i < len; i++)
+    if (!(is_equal_1(sc, vector_element(x, i), vector_element(y, i), nci)))
+      return(false);
+  return(true);
+}
+
+static bool byte_vector_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  s7_int len;
+  if (!is_byte_vector(y))
+    return(vector_equal(sc, x, y, ci));
+  base_vector_equal(sc, x, y);
+  return(byte_vector_equal_1(sc, x, y));
+}
+
+static bool int_vector_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  s7_int len;
+  if (!is_int_vector(y))
+    return(vector_equal(sc, x, y, ci));
+  base_vector_equal(sc, x, y);
+  return(iv_meq(int_vector_ints(x), int_vector_ints(y), len));
+}
+
+static bool float_vector_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  s7_int len;
+  if (!is_float_vector(y))
+    return(vector_equal(sc, x, y, ci));
+  base_vector_equal(sc, x, y);
+  for (s7_int i = 0; i < len; i++)
+    if (float_vector(x, i) != float_vector(y, i))
+      return(false);
+  return(true);
+}
+
+static bool vector_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  /* if this is split like vector_equal above, remember it is called by iterator_equal_1 below */
+  s7_int i, len;
+  shared_info_t *nci = ci;
+
+  if (x == y)
+    return(true);
+  if (!is_any_vector(y))
+    {
+      check_equivalent_method(sc, y, x);
+      return(false);
+    }
+  len = vector_length(x);
+  if (len != vector_length(y)) return(false);
+  if (len == 0) return(true);
+  if (!vector_rank_match(sc, x, y)) return(false);
+
+  if (type(x) != type(y))
+    {
+      /* (equivalent? (make-int-vector 3 0) (make-vector 3 0)) -> #t
+       * (equivalent? (make-float-vector 3 1.0) (vector 1 1 1)) -> #t
+       */
+      if ((is_int_vector(x)) && (is_byte_vector(y)))
+	return(biv_meq(y, x));
+      if ((is_byte_vector(x)) && (is_int_vector(y)))
+	return(biv_meq(x, y));
+      for (i = 0; i < len; i++)
+	if (!is_equivalent_1(sc, vector_getter(x)(sc, x, i), vector_getter(y)(sc, y, i), NULL)) /* this could be greatly optimized */
+	  return(false);
+      return(true);
+    }
+
+  if (is_float_vector(x))
+    {
+      s7_double *arr1 = float_vector_floats(x), *arr2 = float_vector_floats(y);
+      s7_double fudge = sc->equivalent_float_epsilon;
+      if (fudge == 0.0)
+	{
+	  for (i = 0; i < len; i++)
+	    if ((arr1[i] != arr2[i]) &&
+		((!is_NaN(arr1[i])) || (!is_NaN(arr2[i]))))
+	      return(false);
+	}
+      else
+	if ((len & 0x3) == 0)
+	  for (i = 0; i < len; )
+	    LOOP_4(if (!floats_are_equivalent(sc, arr1[i], arr2[i])) return(false); i++);
+	else
+	  for (i = 0; i < len; i++)
+	    if (!floats_are_equivalent(sc, arr1[i], arr2[i]))
+	      return(false);
+      return(true);
+    }
+  if (is_int_vector(x))
+    return(iv_meq(int_vector_ints(x), int_vector_ints(y), len));
+  if (is_byte_vector(x))
+    return(byte_vector_equal_1(sc, x, y));
+
+  if (!has_simple_elements(x))
+    {
+      if (ci)
+	{
+	  if (equal_ref(sc, x, y, ci)) return(true);
+	}
+      else nci = clear_shared_info(sc->circle_info);
+    }
+  for (i = 0; i < len; i++)
+    if (!(is_equivalent_1(sc, vector_element(x, i), vector_element(y, i), nci)))
+      return(false);
+  return(true);
+}
+
+static bool iterator_equal_1(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci, bool equivalent)
+{
+  s7_pointer x_seq, y_seq, xs, ys;
+
+  if (x == y) return(true);
+  if (!is_iterator(y)) return(false);
+
+  x_seq = iterator_sequence(x);
+  y_seq = iterator_sequence(y);
+
+  switch (type(x_seq))
+    {
+    case T_STRING:
+      return((is_string(y_seq)) &&
+	     (iterator_position(x) == iterator_position(y)) &&
+	     (iterator_length(x) == iterator_length(y)) &&
+	     (string_equal(sc, x_seq, y_seq, ci)));
+
+    case T_VECTOR: case T_INT_VECTOR: case T_BYTE_VECTOR: case T_FLOAT_VECTOR:
+      return((is_any_vector(y_seq)) &&
+	     (iterator_position(x) == iterator_position(y)) &&
+	     (iterator_length(x) == iterator_length(y)) &&
+	     ((equivalent) ? (vector_equivalent(sc, x_seq, y_seq, ci)) :
+	      ((is_t_vector(x_seq)) ? (vector_equal(sc, x_seq, y_seq, ci)) :
+	       ((is_float_vector(x_seq)) ? (float_vector_equal(sc, x_seq, y_seq, ci)) :
+		((is_int_vector(x_seq)) ? (int_vector_equal(sc, x_seq, y_seq, ci)) :
+		 (byte_vector_equal(sc, x_seq, y_seq, ci)))))));
+
+      /* iterator_next is a function (pair_iterate, iterator_finished etc) */
+    case T_PAIR:
+      if (iterator_next(x) != iterator_next(y)) return(false);     /* even if seqs are equal, one might be at end */
+      if (equivalent)
+	{
+	  if (!pair_equivalent(sc, x_seq, y_seq, ci))
+	    return(false);
+	}
+      else
+	if (!pair_equal(sc, x_seq, y_seq, ci))
+	  return(false);
+
+      for (xs = x_seq, ys = y_seq; is_pair(xs) && is_pair(ys); xs = cdr(xs), ys = cdr(ys))
+	if (xs == iterator_current(x))
+	  return(ys == iterator_current(y));
+      return(is_null(xs) && is_null(ys));
+
+    case T_NIL:                                                    /* (make-iterator #()) works, so () should too */
+      return(is_null(y_seq));   /* perhaps for equivalent case, check position in y as well as pair(seq(y))? */
+
+    case T_C_OBJECT:
+      if ((is_c_object(y_seq)) &&
+	  (iterator_position(x) == iterator_position(y)) &&
+	  (iterator_length(x) == iterator_length(y)))
+	{
+	  if (equivalent)
+	    return(c_objects_are_equivalent(sc, x_seq, y_seq, ci));
+	  return(c_objects_are_equal(sc, x_seq, y_seq, ci));
+	}
+      return(false);
+
+    case T_LET:
+      if (!is_let(y_seq)) return(false);
+      if (iterator_next(x) != iterator_next(y)) return(false);
+      if (x_seq == sc->rootlet)
+	return(iterator_position(x) == iterator_position(y)); /* y_seq must also be sc->rootlet since nexts are the same (rootlet_iterate) */
+      if (equivalent)
+	{
+	  if (!let_equivalent(sc, x_seq, y_seq, ci))
+	    return(false);
+	}
+      else
+	if (!let_equal(sc, x_seq, y_seq, ci))
+	  return(false);
+
+      for (xs = let_slots(x_seq), ys = let_slots(y_seq); tis_slot(xs) && tis_slot(ys); xs = next_slot(xs), ys = next_slot(ys))
+	if (xs == iterator_current_slot(x))
+	  return(ys == iterator_current_slot(y));
+      return(is_slot_end(xs) && is_slot_end(ys));
+
+    case T_HASH_TABLE:
+      if (!is_hash_table(y_seq)) return(false);
+      if (hash_table_entries(x_seq) != hash_table_entries(y_seq)) return(false);
+      if (hash_table_entries(x_seq) == 0) return(true);
+      if (iterator_position(x) != iterator_position(y)) return(false);
+      if (!equivalent)
+	return(hash_table_equal(sc, x_seq, y_seq, ci));
+      return(hash_table_equivalent(sc, x_seq, y_seq, ci));
+
+    case T_CLOSURE: case T_CLOSURE_STAR:
+      return(x_seq == y_seq); /* or closure_equal/equivalent? */
+
+    default: break;
+    }
+  return(false);
+}
+
+static bool iterator_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)      {return(iterator_equal_1(sc, x, y, ci, false));}
+static bool iterator_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci) {return(iterator_equal_1(sc, x, y, ci, true));}
+
+#if WITH_GMP
+static bool big_integer_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  /* (equal? 1 1.0) -> #f */
+  if (is_t_big_integer(y))
+    return(mpz_cmp(big_integer(x), big_integer(y)) == 0);
+  return((is_t_integer(y)) && (mpz_cmp_si(big_integer(x), integer(y)) == 0));
+}
+
+static bool big_ratio_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  if (is_t_big_ratio(y))
+    return(mpq_equal(big_ratio(x), big_ratio(y)));
+  if (is_t_ratio(y))
+    return((numerator(y) == mpz_get_si(mpq_numref(big_ratio(x)))) &&
+	   (denominator(y) == mpz_get_si(mpq_denref(big_ratio(x)))));
+  return(false);
+}
+
+static bool big_real_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  if (is_t_big_real(y))
+    return(mpfr_equal_p(big_real(x), big_real(y)));
+  if (is_t_real(y))
+    {
+      if (mpfr_nan_p(big_real(x))) return(false);
+      return((!is_NaN(real(y))) &&
+	     (mpfr_cmp_d(big_real(x), real(y)) == 0));
+    }
+  return(false);
+}
+
+static bool big_complex_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  if ((mpfr_nan_p(mpc_realref(big_complex(x)))) || (mpfr_nan_p(mpc_imagref(big_complex(x)))))
+    return(false);
+  if (is_t_big_complex(y))
+    return((!mpfr_nan_p(mpc_realref(big_complex(y)))) &&
+	   (!mpfr_nan_p(mpc_imagref(big_complex(y)))) &&
+	   (mpc_cmp(big_complex(x), big_complex(y)) == 0));
+  if (is_t_complex(y))
+    return((!is_NaN(real_part(y))) &&
+	   (!is_NaN(imag_part(y))) &&
+	   (mpfr_cmp_d(mpc_realref(big_complex(x)), real_part(y)) == 0) &&
+	   (mpfr_cmp_d(mpc_imagref(big_complex(x)), imag_part(y)) == 0));
+  return(false);
+}
+#endif
+
+static bool integer_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  if (is_t_integer(y))
+    return(integer(x) == integer(y));
+#if WITH_GMP
+  if (is_t_big_integer(y))
+    return(mpz_cmp_si(big_integer(y), integer(x)) == 0);
+#endif
+  return(false);
+}
+
+/* apparently ratio_equal is predefined in g++ -- name collision on mac */
+static bool fraction_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  if (is_t_ratio(y))
+    return((numerator(x) == numerator(y)) &&
+	   (denominator(x) == denominator(y)));
+#if WITH_GMP
+  if (is_t_big_ratio(y))
+    return((numerator(x) == mpz_get_si(mpq_numref(big_ratio(y)))) &&
+	   (denominator(x) == mpz_get_si(mpq_denref(big_ratio(y)))));
+#endif
+  return(false);
+}
+
+static bool real_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  if (is_t_real(y))
+    return(real(x) == real(y));
+#if WITH_GMP
+  if (is_t_big_real(y))
+    return((!is_NaN(real(x))) &&
+	   (!mpfr_nan_p(big_real(y))) &&
+	   (mpfr_cmp_d(big_real(y), real(x)) == 0));
+#endif
+  return(false);
+}
+
+static bool complex_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  if (is_t_complex(y))
+    return((real_part(x) == real_part(y)) && (imag_part(x) == imag_part(y)));
+#if WITH_GMP
+  if (is_t_big_complex(y))
+    {
+      if ((is_NaN(real_part(x))) || (is_NaN(imag_part(x))) ||
+	  (mpfr_nan_p(mpc_realref(big_complex(y)))) || (mpfr_nan_p(mpc_imagref(big_complex(y)))))
+	return(false);
+      return((mpfr_cmp_d(mpc_realref(big_complex(y)), real_part(x)) == 0) &&
+	     (mpfr_cmp_d(mpc_imagref(big_complex(y)), imag_part(x)) == 0));
+    }
+#endif
+  return(false);
+}
+
+#if WITH_GMP
+static bool big_integer_or_ratio_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci, bool int_case)
+{
+  if (int_case)
+    mpfr_set_z(sc->mpfr_1, big_integer(x), MPFR_RNDN);
+  else mpfr_set_q(sc->mpfr_1, big_ratio(x), MPFR_RNDN);
+
+  switch (type(y))
+    {
+    case T_INTEGER:
+      if (int_case)
+	return(mpz_cmp_si(big_integer(x), integer(y)) == 0);
+      mpfr_set_si(sc->mpfr_2, integer(y), MPFR_RNDN);
+      return(big_floats_are_equivalent(sc, sc->mpfr_1, sc->mpfr_2));
+    case T_RATIO:
+      mpfr_set_d(sc->mpfr_2, fraction(y), MPFR_RNDN);
+      return(big_floats_are_equivalent(sc, sc->mpfr_1, sc->mpfr_2));
+    case T_REAL:
+      mpfr_set_d(sc->mpfr_2, real(y), MPFR_RNDN);
+      return(big_floats_are_equivalent(sc, sc->mpfr_1, sc->mpfr_2));
+    case T_COMPLEX:
+      mpfr_set_d(sc->mpfr_2, real_part(y), MPFR_RNDN);
+      if (!big_floats_are_equivalent(sc, sc->mpfr_1, sc->mpfr_2))
+	return(false);
+      if (is_NaN(imag_part(y))) return(false);
+      mpfr_set_d(sc->mpfr_1, sc->equivalent_float_epsilon, MPFR_RNDN);
+      mpfr_set_d(sc->mpfr_2, imag_part(y), MPFR_RNDN);
+      return(mpfr_cmpabs(sc->mpfr_2, sc->mpfr_1) <= 0);
+    case T_BIG_INTEGER:
+      if (int_case)
+	return(mpz_cmp(big_integer(x), big_integer(y)) == 0);
+      mpfr_set_z(sc->mpfr_2, big_integer(y), MPFR_RNDN);
+      return(big_floats_are_equivalent(sc, sc->mpfr_1, sc->mpfr_2));
+    case T_BIG_RATIO:
+      mpfr_set_q(sc->mpfr_2, big_ratio(y), MPFR_RNDN);
+      return(big_floats_are_equivalent(sc, sc->mpfr_1, sc->mpfr_2));
+    case T_BIG_REAL:
+      return(big_floats_are_equivalent(sc, sc->mpfr_1, big_real(y)));
+    case T_BIG_COMPLEX:
+      if (big_floats_are_equivalent(sc, sc->mpfr_1, mpc_realref(big_complex(y))))
+	{
+	  if (mpfr_nan_p(mpc_imagref(big_complex(y)))) return(false);
+	  mpfr_set_d(sc->mpfr_1, sc->equivalent_float_epsilon, MPFR_RNDN);
+	  return(mpfr_cmpabs(mpc_imagref(big_complex(y)), sc->mpfr_1) <= 0);
+	}}
+  return(false);
+}
+
+static bool big_integer_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  return(big_integer_or_ratio_equivalent(sc, x, y, ci, true));
+}
+
+static bool big_ratio_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  return(big_integer_or_ratio_equivalent(sc, x, y, ci, false));
+}
+
+
+static bool big_real_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  switch (type(y))
+    {
+    case T_INTEGER:
+      mpfr_set_si(sc->mpfr_2, integer(y), MPFR_RNDN);
+      return(big_floats_are_equivalent(sc, big_real(x), sc->mpfr_2));
+    case T_RATIO:
+      mpfr_set_d(sc->mpfr_2, fraction(y), MPFR_RNDN);
+      return(big_floats_are_equivalent(sc, big_real(x), sc->mpfr_2));
+    case T_REAL:
+      mpfr_set_d(sc->mpfr_2, real(y), MPFR_RNDN);
+      return(big_floats_are_equivalent(sc, big_real(x), sc->mpfr_2));
+    case T_COMPLEX:
+      mpfr_set_d(sc->mpfr_2, real_part(y), MPFR_RNDN);
+      if (!big_floats_are_equivalent(sc, big_real(x), sc->mpfr_2))
+	return(false);
+      if (is_NaN(imag_part(y))) return(false);
+      mpfr_set_d(sc->mpfr_1, sc->equivalent_float_epsilon, MPFR_RNDN);
+      mpfr_set_d(sc->mpfr_2, imag_part(y), MPFR_RNDN);
+      return(mpfr_cmpabs(sc->mpfr_2, sc->mpfr_1) <= 0);
+    case T_BIG_INTEGER:
+      mpfr_set_z(sc->mpfr_2, big_integer(y), MPFR_RNDN);
+      return(big_floats_are_equivalent(sc, big_real(x), sc->mpfr_2));
+    case T_BIG_RATIO:
+      mpfr_set_q(sc->mpfr_2, big_ratio(y), MPFR_RNDN);
+      return(big_floats_are_equivalent(sc, big_real(x), sc->mpfr_2));
+    case T_BIG_REAL:
+      return(big_floats_are_equivalent(sc, big_real(x), big_real(y)));
+    case T_BIG_COMPLEX:
+      if (big_floats_are_equivalent(sc, big_real(x), mpc_realref(big_complex(y))))
+	{
+	  if (mpfr_nan_p(mpc_imagref(big_complex(y)))) return(false);
+	  mpfr_set_d(sc->mpfr_1, sc->equivalent_float_epsilon, MPFR_RNDN);
+	  return(mpfr_cmpabs(mpc_imagref(big_complex(y)), sc->mpfr_1) <= 0);
+	}}
+  return(false);
+}
+
+static bool big_complex_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  mpfr_set_d(sc->mpfr_1, sc->equivalent_float_epsilon, MPFR_RNDN);
+  switch (type(y))
+    {
+    case T_INTEGER:
+      mpfr_set_si(sc->mpfr_2, integer(y), MPFR_RNDN);
+      return((big_floats_are_equivalent(sc, mpc_realref(big_complex(x)), sc->mpfr_2)) &&
+	     (big_floats_are_equivalent(sc, mpc_imagref(big_complex(x)), sc->mpfr_1)));
+    case T_RATIO:
+      mpfr_set_d(sc->mpfr_2, fraction(y), MPFR_RNDN);
+      return((big_floats_are_equivalent(sc, mpc_realref(big_complex(x)), sc->mpfr_2)) &&
+	     (big_floats_are_equivalent(sc, mpc_imagref(big_complex(x)), sc->mpfr_1)));
+    case T_REAL:
+      mpfr_set_d(sc->mpfr_2, real(y), MPFR_RNDN);
+      return((big_floats_are_equivalent(sc, mpc_realref(big_complex(x)), sc->mpfr_2)) &&
+	     (big_floats_are_equivalent(sc, mpc_imagref(big_complex(x)), sc->mpfr_1)));
+    case T_COMPLEX:
+      mpfr_set_d(sc->mpfr_1, imag_part(y), MPFR_RNDN);
+      mpfr_set_d(sc->mpfr_2, real_part(y), MPFR_RNDN);
+      return((big_floats_are_equivalent(sc, mpc_realref(big_complex(x)), sc->mpfr_2)) &&
+	     (big_floats_are_equivalent(sc, mpc_imagref(big_complex(x)), sc->mpfr_1)));
+    case T_BIG_INTEGER:
+      mpfr_set_z(sc->mpfr_2, big_integer(y), MPFR_RNDN);
+      return((big_floats_are_equivalent(sc, mpc_realref(big_complex(x)), sc->mpfr_2)) &&
+	     (big_floats_are_equivalent(sc, mpc_imagref(big_complex(x)), sc->mpfr_1)));
+    case T_BIG_RATIO:
+      mpfr_set_q(sc->mpfr_2, big_ratio(y), MPFR_RNDN);
+      return((big_floats_are_equivalent(sc, mpc_realref(big_complex(x)), sc->mpfr_2)) &&
+	     (big_floats_are_equivalent(sc, mpc_imagref(big_complex(x)), sc->mpfr_1)));
+    case T_BIG_REAL:
+      return((big_floats_are_equivalent(sc, mpc_realref(big_complex(x)), big_real(y))) &&
+	     (big_floats_are_equivalent(sc, mpc_imagref(big_complex(x)), sc->mpfr_1)));
+    case T_BIG_COMPLEX:
+      return((big_floats_are_equivalent(sc, mpc_realref(big_complex(x)), mpc_realref(big_complex(y)))) &&
+	     (big_floats_are_equivalent(sc, mpc_imagref(big_complex(x)), mpc_imagref(big_complex(y)))));
+    }
+  return(false);
+}
+
+static bool both_floats_are_equivalent(s7_scheme *sc, s7_pointer y)
+{
+  if (!big_floats_are_equivalent(sc, sc->mpfr_1, mpc_realref(big_complex(y))))
+    return(false);
+  if (mpfr_nan_p(mpc_imagref(big_complex(y)))) return(false);
+  mpfr_set_d(sc->mpfr_1, sc->equivalent_float_epsilon, MPFR_RNDN);
+  return(mpfr_cmpabs(mpc_imagref(big_complex(y)), sc->mpfr_1) <= 0);
+}
+#endif
+
+static bool integer_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  switch (type(y))
+    {
+    case T_INTEGER:
+      return(integer(x) == integer(y));
+    case T_RATIO:
+      return(floats_are_equivalent(sc, (double)integer(x), fraction(y)));
+    case T_REAL:
+      return(floats_are_equivalent(sc, (double)integer(x), real(y)));
+    case T_COMPLEX:
+      return((fabs(imag_part(y)) <= sc->equivalent_float_epsilon) &&
+	     (floats_are_equivalent(sc, (double)integer(x), real_part(y))));
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      return(mpz_cmp_si(big_integer(y), integer(x)) == 0);
+    case T_BIG_RATIO:
+      mpfr_set_si(sc->mpfr_1, integer(x), MPFR_RNDN);
+      mpfr_set_q(sc->mpfr_2, big_ratio(y), MPFR_RNDN);
+      return(big_floats_are_equivalent(sc, sc->mpfr_1, sc->mpfr_2));
+    case T_BIG_REAL:
+      mpfr_set_si(sc->mpfr_1, integer(x), MPFR_RNDN);
+      return(big_floats_are_equivalent(sc, sc->mpfr_1, big_real(y)));
+    case T_BIG_COMPLEX:
+      mpfr_set_si(sc->mpfr_1, integer(x), MPFR_RNDN);
+      return(both_floats_are_equivalent(sc, y));
+#endif
+    }
+  return(false);
+}
+
+static bool fraction_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  switch (type(y))
+    {
+    case T_INTEGER:
+      return(floats_are_equivalent(sc, (double)fraction(x), integer(y)));
+    case T_RATIO:
+      return(floats_are_equivalent(sc, (double)fraction(x), fraction(y)));
+    case T_REAL:
+      return(floats_are_equivalent(sc, (double)fraction(x), real(y)));
+    case T_COMPLEX:
+      return((fabs(imag_part(y)) <= sc->equivalent_float_epsilon) &&
+	     (floats_are_equivalent(sc, fraction(x), real_part(y))));
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpfr_set_z(sc->mpfr_1, big_integer(y), MPFR_RNDN);
+      mpfr_set_d(sc->mpfr_2, fraction(x), MPFR_RNDN);
+      return(big_floats_are_equivalent(sc, sc->mpfr_1, sc->mpfr_2));
+    case T_BIG_RATIO:
+      mpfr_set_d(sc->mpfr_1, fraction(x), MPFR_RNDN);
+      mpfr_set_q(sc->mpfr_2, big_ratio(y), MPFR_RNDN);
+      return(big_floats_are_equivalent(sc, sc->mpfr_1, sc->mpfr_2));
+    case T_BIG_REAL:
+      mpfr_set_d(sc->mpfr_1, fraction(x), MPFR_RNDN);
+      return(big_floats_are_equivalent(sc, sc->mpfr_1, big_real(y)));
+    case T_BIG_COMPLEX:
+      mpfr_set_d(sc->mpfr_1, fraction(x), MPFR_RNDN);
+      return(both_floats_are_equivalent(sc, y));
+#endif
+    }
+  return(false);
+}
+
+static bool real_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  switch (type(y))
+    {
+    case T_INTEGER:
+      return(floats_are_equivalent(sc, real(x), integer(y)));
+    case T_RATIO:
+      return(floats_are_equivalent(sc, real(x), fraction(y)));
+    case T_REAL:
+      return(floats_are_equivalent(sc, real(x), real(y)));
+    case T_COMPLEX:
+      return((fabs(imag_part(y)) <= sc->equivalent_float_epsilon) &&
+	     (floats_are_equivalent(sc, real(x), real_part(y))));
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpfr_set_z(sc->mpfr_1, big_integer(y), MPFR_RNDN);
+      mpfr_set_d(sc->mpfr_2, real(x), MPFR_RNDN);
+      return(big_floats_are_equivalent(sc, sc->mpfr_1, sc->mpfr_2));
+    case T_BIG_RATIO:
+      mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+      mpfr_set_q(sc->mpfr_2, big_ratio(y), MPFR_RNDN);
+      return(big_floats_are_equivalent(sc, sc->mpfr_1, sc->mpfr_2));
+    case T_BIG_REAL:
+      mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+      return(big_floats_are_equivalent(sc, sc->mpfr_1, big_real(y)));
+    case T_BIG_COMPLEX:
+      mpfr_set_d(sc->mpfr_1, real(x), MPFR_RNDN);
+      return(both_floats_are_equivalent(sc, y));
+#endif
+    }
+  return(false);
+}
+
+static bool complex_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+  switch (type(y))
+    {
+    case T_INTEGER:
+      return((floats_are_equivalent(sc, real_part(x), integer(y))) &&
+	     (floats_are_equivalent(sc, imag_part(x), 0.0)));
+    case T_RATIO:
+      return((floats_are_equivalent(sc, real_part(x), fraction(y))) &&
+	     (floats_are_equivalent(sc, imag_part(x), 0.0)));
+    case T_REAL:
+      return((floats_are_equivalent(sc, real_part(x), real(y))) &&
+	     (floats_are_equivalent(sc, imag_part(x), 0.0)));
+    case T_COMPLEX:
+      return((floats_are_equivalent(sc, real_part(x), real_part(y))) &&
+	     (floats_are_equivalent(sc, imag_part(x), imag_part(y))));
+#if WITH_GMP
+    case T_BIG_INTEGER:
+      mpfr_set_z(sc->mpfr_1, big_integer(y), MPFR_RNDN);
+      mpfr_set_d(sc->mpfr_2, real_part(x), MPFR_RNDN);
+      return((big_floats_are_equivalent(sc, sc->mpfr_1, sc->mpfr_2)) &&
+	     (floats_are_equivalent(sc, imag_part(x), 0.0)));
+    case T_BIG_RATIO:
+      mpfr_set_d(sc->mpfr_1, real_part(x), MPFR_RNDN);
+      mpfr_set_q(sc->mpfr_2, big_ratio(y), MPFR_RNDN);
+      return((big_floats_are_equivalent(sc, sc->mpfr_1, sc->mpfr_2)) &&
+	     (floats_are_equivalent(sc, imag_part(x), 0.0)));
+    case T_BIG_REAL:
+      mpfr_set_d(sc->mpfr_1, real_part(x), MPFR_RNDN);
+      return((big_floats_are_equivalent(sc, sc->mpfr_1, big_real(y))) &&
+	     (floats_are_equivalent(sc, imag_part(x), 0.0)));
+    case T_BIG_COMPLEX:
+      mpfr_set_d(sc->mpfr_1, real_part(x), MPFR_RNDN);
+      mpfr_set_d(sc->mpfr_2, imag_part(x), MPFR_RNDN);
+      return((big_floats_are_equivalent(sc, sc->mpfr_1, mpc_realref(big_complex(y)))) &&
+	     (big_floats_are_equivalent(sc, sc->mpfr_2, mpc_imagref(big_complex(y)))));
+#endif
+    }
+  return(false);
+}
+
+static bool random_state_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info_t *ci)
+{
+#if WITH_GMP
+  return(x == y);
+#else
+  return((x == y) ||
+	 ((is_random_state(y)) &&
+	  (random_seed(x) == random_seed(y)) &&
+	  (random_carry(x) == random_carry(y))));
+#endif
+}
+
+static void init_equals(void)
+{
+  for (int32_t i = 0; i < NUM_TYPES; i++) {equals[i] = eq_equal; equivalents[i] = eq_equal;}
+  equals[T_SYMBOL] =            eq_equal;
+  equals[T_C_POINTER] =         c_pointer_equal;
+  equals[T_UNSPECIFIED] =       unspecified_equal;
+  equals[T_UNDEFINED] =         undefined_equal;
+  equals[T_STRING] =            string_equal;
+  equals[T_SYNTAX] =            syntax_equal;
+  equals[T_C_OBJECT] =          c_objects_are_equal;
+  equals[T_RANDOM_STATE] =      random_state_equal;
+  equals[T_ITERATOR] =          iterator_equal;
+  equals[T_INPUT_PORT] =        port_equal;
+  equals[T_OUTPUT_PORT] =       port_equal;
+  equals[T_MACRO] =             closure_equal;
+  equals[T_MACRO_STAR] =        closure_equal;
+  equals[T_BACRO] =             closure_equal;
+  equals[T_BACRO_STAR] =        closure_equal;
+  equals[T_CLOSURE] =           closure_equal;
+  equals[T_CLOSURE_STAR] =      closure_equal;
+  equals[T_HASH_TABLE] =        hash_table_equal;
+  equals[T_LET] =               let_equal;
+  equals[T_PAIR] =              pair_equal;
+  equals[T_VECTOR] =            vector_equal;
+  equals[T_INT_VECTOR] =        int_vector_equal;
+  equals[T_BYTE_VECTOR] =       byte_vector_equal;
+  equals[T_FLOAT_VECTOR] =      float_vector_equal;
+  equals[T_INTEGER] =           integer_equal;
+  equals[T_RATIO] =             fraction_equal;
+  equals[T_REAL] =              real_equal;
+  equals[T_COMPLEX] =           complex_equal;
+#if WITH_GMP
+  equals[T_BIG_INTEGER] =       big_integer_equal;
+  equals[T_BIG_RATIO] =         big_ratio_equal;
+  equals[T_BIG_REAL] =          big_real_equal;
+  equals[T_BIG_COMPLEX] =       big_complex_equal;
+#endif
+  equivalents[T_SYMBOL] =       symbol_equivalent;
+  equivalents[T_C_POINTER] =    c_pointer_equivalent;
+  equivalents[T_UNSPECIFIED] =  unspecified_equal;
+  equivalents[T_UNDEFINED] =    undefined_equal;
+  equivalents[T_STRING] =       string_equal;
+  equivalents[T_SYNTAX] =       syntax_equal;
+  equivalents[T_C_OBJECT] =     c_objects_are_equivalent;
+  equivalents[T_RANDOM_STATE] = random_state_equal;
+  equivalents[T_ITERATOR] =     iterator_equivalent;
+  equivalents[T_INPUT_PORT] =   port_equivalent;
+  equivalents[T_OUTPUT_PORT] =  port_equivalent;
+  equivalents[T_MACRO] =        closure_equivalent;
+  equivalents[T_MACRO_STAR] =   closure_equivalent;
+  equivalents[T_BACRO] =        closure_equivalent;
+  equivalents[T_BACRO_STAR] =   closure_equivalent;
+  equivalents[T_CLOSURE] =      closure_equivalent;
+  equivalents[T_CLOSURE_STAR] = closure_equivalent;
+  equivalents[T_HASH_TABLE] =   hash_table_equivalent;
+  equivalents[T_LET] =          let_equivalent;
+  equivalents[T_PAIR] =         pair_equivalent;
+  equivalents[T_VECTOR] =       vector_equivalent;
+  equivalents[T_INT_VECTOR] =   vector_equivalent;
+  equivalents[T_FLOAT_VECTOR] = vector_equivalent;
+  equivalents[T_BYTE_VECTOR] =  vector_equivalent;
+  equivalents[T_INTEGER] =      integer_equivalent;
+  equivalents[T_RATIO] =        fraction_equivalent;
+  equivalents[T_REAL] =         real_equivalent;
+  equivalents[T_COMPLEX] =      complex_equivalent;
+#if WITH_GMP
+  equivalents[T_BIG_INTEGER] =  big_integer_equivalent;
+  equivalents[T_BIG_RATIO] =    big_ratio_equivalent;
+  equivalents[T_BIG_REAL] =     big_real_equivalent;
+  equivalents[T_BIG_COMPLEX] =  big_complex_equivalent;
+#endif
+}
+
+bool s7_is_equal(s7_scheme *sc, s7_pointer x, s7_pointer y) {return((*(equals[type(x)]))(sc, x, y, NULL));}
+bool s7_is_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y) {return((*(equivalents[type(x)]))(sc, x, y, NULL));}
+
+static s7_pointer g_is_equal(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_equal "(equal? obj1 obj2) returns #t if obj1 is equal to obj2"
+  #define Q_is_equal sc->pcl_bt
+  return(make_boolean(sc, is_equal_1(sc, car(args), cadr(args), NULL)));
+}
+
+static s7_pointer g_is_equivalent(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_equivalent "(equivalent? obj1 obj2) returns #t if obj1 is close enough to obj2."
+  #define Q_is_equivalent sc->pcl_bt
+  return(make_boolean(sc, is_equivalent_1(sc, car(args), cadr(args), NULL)));
+}
+
+static s7_pointer is_equal_p_pp(s7_scheme *sc, s7_pointer a, s7_pointer b)      {return((is_equal_1(sc, a, b, NULL)) ? sc->T : sc->F);}
+static s7_pointer is_equivalent_p_pp(s7_scheme *sc, s7_pointer a, s7_pointer b) {return((is_equivalent_1(sc, a, b, NULL)) ? sc->T : sc->F);}
+
+
+/* ---------------------------------------- length, copy, fill ---------------------------------------- */
+static s7_pointer s7_length(s7_scheme *sc, s7_pointer lst); /* why isn't this in s7.h? */
+
+static s7_pointer (*length_functions[256])(s7_scheme *sc, s7_pointer obj);
+static s7_pointer any_length(s7_scheme *sc, s7_pointer obj) {return(sc->F);}
+
+static s7_pointer pair_length(s7_scheme *sc, s7_pointer a)
+{
+  s7_int i = 0;
+  s7_pointer slow = a, fast = a; /* we know a is a pair, don't start with fast = cdr(a)! else if a len = 3, we never match */
+  while (true)
+    {
+      LOOP_4(fast = cdr(fast); i++; if (!is_pair(fast)) return(make_integer(sc, (is_null(fast)) ? i : -i)));
+      slow = cdr(slow);
+      if (fast == slow)	return(real_infinity);
+    }
+  return(real_infinity);
+}
+
+static s7_pointer nil_length(s7_scheme *sc, s7_pointer lst)  {return(int_zero);}
+static s7_pointer v_length(s7_scheme *sc, s7_pointer v)      {return(make_integer(sc, vector_length(v)));}
+static s7_pointer str_length(s7_scheme *sc, s7_pointer v)    {return(make_integer(sc, string_length(v)));}
+static s7_pointer bv_length(s7_scheme *sc, s7_pointer v)     {return(make_integer(sc, byte_vector_length(v)));}
+static s7_pointer h_length(s7_scheme *sc, s7_pointer lst)    {return(make_integer(sc, hash_table_size(lst)));}
+static s7_pointer iter_length(s7_scheme *sc, s7_pointer lst) {return(s7_length(sc, iterator_sequence(lst)));}
+
+static s7_pointer c_obj_length(s7_scheme *sc, s7_pointer lst)
+{
+  if (!is_global(sc->length_symbol))
+    check_method(sc, lst, sc->length_symbol, set_plist_1(sc, lst));
+  return(c_object_length(sc, lst));
+}
+
+static s7_pointer lt_length(s7_scheme *sc, s7_pointer lst)
+{
+  if (!is_global(sc->length_symbol))
+    check_method(sc, lst, sc->length_symbol, set_plist_1(sc, lst));
+  return(make_integer(sc, let_length(sc, lst)));
+}
+
+static s7_pointer fnc_length(s7_scheme *sc, s7_pointer lst)
+{
+  return((has_active_methods(sc, lst)) ? make_integer(sc, closure_length(sc, lst)) : sc->F);
+}
+
+static s7_pointer ip_length(s7_scheme *sc, s7_pointer port)
+{
+  if (port_is_closed(port))
+    return(sc->F);             /* or 0? */
+  if (is_string_port(port))
+    return(make_integer(sc, port_data_size(port))); /* length of string we're reading */
+#if (!MS_WINDOWS)
+  if (is_file_port(port))
+    {
+      long len;
+      long cur_pos = ftell(port_file(port));
+      fseek(port_file(port), 0, SEEK_END);
+      len = ftell(port_file(port));
+      rewind(port_file(port));
+      fseek(port_file(port), cur_pos, SEEK_SET);
+      return(make_integer(sc, len));
+    }
+#endif
+  return(sc->F);
+}
+
+static s7_pointer op_length(s7_scheme *sc, s7_pointer port)
+{
+  if (port_is_closed(port))
+    return(sc->F);             /* or 0? */
+  return((is_string_port(port)) ? make_integer(sc, port_position(port)) : sc->F); /* length of string we've written */
+}
+
+static s7_pointer rs_length(s7_scheme *sc, s7_pointer port) {return((WITH_GMP) ? sc->F : int_two);}
+
+static void init_length_functions(void)
+{
+  for (int32_t i = 0; i < 256; i++) length_functions[i] = any_length;
+  length_functions[T_NIL]          = nil_length;
+  length_functions[T_PAIR]         = pair_length;
+  length_functions[T_VECTOR]       = v_length;
+  length_functions[T_FLOAT_VECTOR] = v_length;
+  length_functions[T_INT_VECTOR]   = v_length;
+  length_functions[T_STRING]       = str_length;
+  length_functions[T_BYTE_VECTOR]  = bv_length;
+  length_functions[T_ITERATOR]     = iter_length;
+  length_functions[T_HASH_TABLE]   = h_length;
+  length_functions[T_C_OBJECT]     = c_obj_length;
+  length_functions[T_LET]          = lt_length;
+  length_functions[T_CLOSURE]      = fnc_length;
+  length_functions[T_CLOSURE_STAR] = fnc_length;
+  length_functions[T_INPUT_PORT]   = ip_length;
+  length_functions[T_OUTPUT_PORT]  = op_length;
+  length_functions[T_RANDOM_STATE] = rs_length;
+}
+
+static s7_pointer s7_length(s7_scheme *sc, s7_pointer lst) {return((*length_functions[unchecked_type(lst)])(sc, lst));}
+
+static s7_pointer g_length(s7_scheme *sc, s7_pointer args)
+{
+  #define H_length "(length obj) returns the length of obj, which can be a list, vector, string, input-port, or hash-table. \
+The length of a dotted list does not include the final cdr, and is returned as a negative number.  A circular \
+list has infinite length.  Length of anything else returns #f."
+  #define Q_length s7_make_signature(sc, 2, s7_make_signature(sc, 3, sc->is_integer_symbol, sc->is_infinite_symbol, sc->not_symbol), sc->T)
+  return((*length_functions[unchecked_type(car(args))])(sc, car(args)));
+}
+
+/* length_p_p = s7_length */
+
+
+/* -------------------------------- copy -------------------------------- */
+static s7_pointer string_setter(s7_scheme *sc, s7_pointer str, s7_int loc, s7_pointer val)
+{
+  if (is_character(val))
+    {
+      string_value(str)[loc] = s7_character(val);
+      return(val);
+    }
+  set_car(sc->elist_3, wrap_string(sc, "~S: ~S is not a character", 25));
+  set_caddr(sc->elist_3, val);
+  error_nr(sc, sc->wrong_type_arg_symbol, sc->elist_3);
+  return(NULL);
+}
+
+static s7_pointer string_getter(s7_scheme *sc, s7_pointer str, s7_int loc)
+{
+  return(chars[(uint8_t)(string_value(str)[loc])]); /* cast needed else (copy (string (integer->char 255))...) is trouble */
+}
+
+static s7_pointer c_object_setter(s7_scheme *sc, s7_pointer obj, s7_int loc, s7_pointer val)
+{
+  return((*(c_object_set(sc, obj)))(sc, with_list_t3(obj, wrap_integer(sc, loc), val))); /* was make_integer 14-Nov-23 */
+}
+
+static s7_pointer c_object_getter(s7_scheme *sc, s7_pointer obj, s7_int loc)
+{
+  return((*(c_object_ref(sc, obj)))(sc, set_plist_2(sc, obj, wrap_integer(sc, loc)))); /* was make_integer 14-Nov-23 */
+}
+
+static s7_pointer let_setter(s7_scheme *sc, s7_pointer e, s7_int loc, s7_pointer val)
+{
+  /* loc is irrelevant here, val has to be of the form (cons symbol value)
+   * if symbol is already in e, its value is changed, otherwise a new slot is added to e
+   */
+  if (is_pair(val))
+    {
+      s7_pointer sym = car(val);
+      if (is_symbol(sym))
+	{
+	  s7_pointer slot;
+	  if (is_keyword(sym)) sym = keyword_symbol(sym); /* else make_slot will mark the keyword as local confusing odd_bits etc */
+	  slot = slot_in_let(sc, e, sym);
+	  if (is_slot(slot))
+	    checked_slot_set_value(sc, slot, cdr(val));
+	  else add_slot_checked_with_id(sc, e, sym, cdr(val));
+	  return(cdr(val));
+	}}
+  set_car(sc->elist_3, wrap_string(sc, "~S: ~S is not (cons symbol value)", 33));
+  set_caddr(sc->elist_3, val);
+  error_nr(sc, sc->wrong_type_arg_symbol, sc->elist_3);
+  return(sc->wrong_type_arg_symbol);
+}
+
+static s7_pointer hash_table_setter(s7_scheme *sc, s7_pointer e, s7_int loc, s7_pointer val)
+{
+  /* loc is irrelevant here, e is the hash-table, val has to be of the form (cons key value)
+   * if key is already in e, its value is changed, otherwise a new slot is added to e, cadr(elist_3) is caller
+   */
+  if (!is_pair(val))
+    {
+      set_car(sc->elist_3, wrap_string(sc, "~S: ~S is not (cons key value)", 30));
+      set_caddr(sc->elist_3, val);
+      error_nr(sc, sc->wrong_type_arg_symbol, sc->elist_3);
+    }
+  return(s7_hash_table_set(sc, e, car(val), cdr(val)));
+}
+
+static s7_pointer copy_hash_table(s7_scheme *sc, s7_pointer source)
+{
+  s7_pointer new_hash = s7_make_hash_table(sc, hash_table_size(source));
+  gc_protect_via_stack(sc, new_hash);
+  hash_table_checker(new_hash) = hash_table_checker(source);
+  if (hash_chosen(source)) hash_set_chosen(new_hash);
+  hash_table_mapper(new_hash) = hash_table_mapper(source);
+  hash_table_set_procedures(new_hash, copy_hash_table_procedures(sc, source));
+  hash_table_copy(sc, source, new_hash, 0, hash_table_entries(source));
+  if (is_typed_hash_table(source))
+    {
+      set_is_typed_hash_table(new_hash);
+      if (has_hash_key_type(source)) set_has_hash_key_type(new_hash);
+      if (has_hash_value_type(source)) set_has_hash_value_type(new_hash);
+      if (has_simple_keys(source)) set_has_simple_keys(new_hash);
+      if (has_simple_values(source)) set_has_simple_values(new_hash);
+    }
+  if (is_weak_hash_table(source)) /* 16-May-23 */
+    {
+      set_weak_hash_table(new_hash);
+      weak_hash_iters(new_hash) = 0;
+    }
+  unstack_gc_protect(sc);
+  return(new_hash);
+}
+
+static s7_pointer copy_vector(s7_scheme *sc, s7_pointer source)
+{
+  s7_int len = vector_length(source);
+  s7_pointer vec;
+  if (!is_typed_vector(source))
+    return(s7_vector_copy(sc, source));
+  if (len == 0)
+    return(make_simple_vector(sc, 0));
+  vec = make_vector_1(sc, len, NOT_FILLED, T_VECTOR);
+  set_typed_vector(vec);
+  typed_vector_set_typer(vec, typed_vector_typer(source));
+  if (has_simple_elements(source)) set_has_simple_elements(vec);
+  for (s7_int i = 0; i < len; i++)
+    vector_element(vec, i) = vector_element(source, i);
+  if (vector_rank(source) > 1)
+    return(make_multivector(sc, vec, g_vector_dimensions(sc, set_plist_1(sc, source)))); /* see g_subvector to avoid g_vector_dimensions */
+  add_vector(sc, vec);
+  return(vec);
+}
+
+static s7_pointer copy_source_no_dest(s7_scheme *sc, s7_pointer source, s7_pointer args)
+{
+  s7_pointer dest;
+  switch (type(source))
+    {
+    case T_STRING:
+      if (string_length(source) == 0) return(nil_string);
+      return(make_string_with_length(sc, string_value(source), string_length(source)));
+
+    case T_C_OBJECT:
+      return(copy_c_object(sc, args));
+
+    case T_RANDOM_STATE:
+      return(random_state_copy(sc, args));
+
+    case T_HASH_TABLE:              /* this has to copy nearly everything */
+      return(copy_hash_table(sc, source));
+
+    case T_ITERATOR:
+      return(iterator_copy(sc, source));
+
+    case T_LET:
+      check_method(sc, source, sc->copy_symbol, args);
+      return(let_copy(sc, source));   /* this copies only the local let and points to outer lets */
+
+    case T_CLOSURE: case T_CLOSURE_STAR:
+    case T_MACRO:   case T_MACRO_STAR:
+    case T_BACRO:   case T_BACRO_STAR:
+      check_method(sc, source, sc->copy_symbol, args);
+      return(copy_closure(sc, source));
+
+    case T_INT_VECTOR: case T_FLOAT_VECTOR: case T_BYTE_VECTOR:
+      return(s7_vector_copy(sc, source)); /* "shallow" copy */
+
+    case T_VECTOR:
+      return(copy_vector(sc, source));
+
+    case T_PAIR:                    /* top level only, as in the other cases, checks for circles */
+      return(copy_any_list(sc, source));
+
+    case T_INTEGER:
+      new_cell(sc, dest, T_INTEGER);
+      set_integer(dest, integer(source));
+      return(dest);
+    case T_RATIO:
+      new_cell(sc, dest, T_RATIO);
+      set_numerator(dest, numerator(source));
+      set_denominator(dest, denominator(source));
+      return(dest);
+    case T_REAL:
+      new_cell(sc, dest, T_REAL);
+      set_real(dest, real(source));
+      return(dest);
+    case T_COMPLEX:
+      new_cell(sc, dest, T_COMPLEX);
+      set_real_part(dest, real_part(source));
+      set_imag_part(dest, imag_part(source));
+      return(dest);
+#if WITH_GMP
+    case T_BIG_INTEGER: return(mpz_to_big_integer(sc, big_integer(source)));
+    case T_BIG_RATIO:   return(mpq_to_big_ratio(sc, big_ratio(source)));
+    case T_BIG_REAL:    return(mpfr_to_big_real(sc, big_real(source)));
+    case T_BIG_COMPLEX: return(mpc_to_number(sc, big_complex(source)));
+#endif
+
+    case T_C_POINTER:
+      dest = s7_make_c_pointer_with_type(sc, c_pointer(source), c_pointer_type(source), c_pointer_info(source));
+      c_pointer_weak1(dest) = c_pointer_weak1(source);
+      c_pointer_weak2(dest) = c_pointer_weak2(source);
+      return(dest);
+    }
+  return(source);
+}
+
+static s7_pointer copy_p_p(s7_scheme *sc, s7_pointer source) {return(copy_source_no_dest(sc, source, set_plist_1(sc, source)));}
+
+static s7_pointer copy_c_object_to_same_type(s7_scheme *sc, s7_pointer dest, s7_pointer source, s7_int dest_start, s7_int dest_end, s7_int source_start)
+{
+  s7_pointer (*cref)(s7_scheme *sc, s7_pointer args) = c_object_ref(sc, source);
+  s7_pointer (*cset)(s7_scheme *sc, s7_pointer args) = c_object_set(sc, dest);
+  if ((is_safe_c_function(c_object_getf(sc, source))) &&
+      (is_safe_c_function(c_object_setf(sc, dest)))) /* maybe not worth the extra code */
+    {
+      s7_pointer mi = wrapped_integer(sc);
+      s7_pointer mj = wrapped_integer(sc);
+      set_car(sc->t3_1, dest);
+      set_car(sc->t3_2, mj);
+      for (s7_int i = source_start, j = dest_start; i < dest_end; i++, j++)
+	{
+	  set_integer(mi, i);
+	  set_car(sc->t3_3, cref(sc, with_list_t2(source, mi)));
+	  set_integer(mj, j);
+	  cset(sc, sc->t3_1);
+	}}
+  else
+    {
+      s7_pointer mi = make_mutable_integer(sc, 0);
+      s7_int gc_loc1 = gc_protect_1(sc, mi);
+      s7_pointer mj = make_mutable_integer(sc, 0);
+      s7_int gc_loc2 = gc_protect_1(sc, mj);
+      for (s7_int i = source_start, j = dest_start; i < dest_end; i++, j++)
+	{
+	  set_integer(mi, i);
+	  set_car(sc->t3_3, cref(sc, with_list_t2(source, mi)));
+	  set_car(sc->t3_1, dest);
+	  set_car(sc->t3_2, mj);
+	  set_integer(mj, j);
+	  cset(sc, sc->t3_1);
+	}
+      s7_gc_unprotect_at(sc, gc_loc1);
+      s7_gc_unprotect_at(sc, gc_loc2);
+      free_cell(sc, mi);
+      free_cell(sc, mj);
+    }
+  return(dest);
+}
+
+static s7_pointer copy_to_same_type(s7_scheme *sc, s7_pointer dest, s7_pointer source, s7_int dest_start, s7_int dest_end, s7_int source_start)
+{
+  /* types equal, but not a let (handled in s7_copy_1), returns NULL if not copied here */
+  s7_int source_len = dest_end - dest_start;
+  switch (type(source))
+    {
+    case T_PAIR:
+      {
+	s7_pointer pd = dest, ps = source;
+	s7_int i;
+	for (i = 0; i < source_start; i++)
+	  ps = cdr(ps);
+	for (i = 0; i < dest_start; i++)
+	  pd = cdr(pd);
+	for (; (i < dest_end) && is_pair(ps) && is_pair(pd); i++, ps = cdr(ps), pd = cdr(pd))
+	  set_car(pd, car(ps));
+	return(dest);
+      }
+
+    case T_VECTOR:
+      if (is_typed_vector(dest))
+	{
+	  s7_pointer *els = vector_elements(source);
+	  for (s7_int i = source_start, j = dest_start; j < dest_end; i++, j++)
+	    typed_vector_setter(sc, dest, j, els[i]);                     /* types are equal, so source is a normal vector */
+	}
+      else memcpy((void *)((vector_elements(dest)) + dest_start), (void *)((vector_elements(source)) + source_start), source_len * sizeof(s7_pointer));
+      return(dest);
+
+    case T_INT_VECTOR:
+      memcpy((void *)((int_vector_ints(dest)) + dest_start), (void *)((int_vector_ints(source)) + source_start), source_len * sizeof(s7_int));
+      return(dest);
+    case T_FLOAT_VECTOR:
+      memcpy((void *)((float_vector_floats(dest)) + dest_start), (void *)((float_vector_floats(source)) + source_start), source_len * sizeof(s7_double));
+      return(dest);
+    case T_BYTE_VECTOR:
+      if (is_string(dest))
+	memcpy((void *)(string_value(dest) + dest_start), (void *)((byte_vector_bytes(source)) + source_start), source_len * sizeof(uint8_t));
+      else memcpy((void *)(byte_vector_bytes(dest) + dest_start), (void *)((byte_vector_bytes(source)) + source_start), source_len * sizeof(uint8_t));
+      return(dest);
+
+    case T_STRING:
+      if (is_string(dest))
+	memcpy((void *)(string_value(dest) + dest_start), (void *)((string_value(source)) + source_start), source_len);
+      else memcpy((void *)(byte_vector_bytes(dest) + dest_start), (void *)((string_value(source)) + source_start), source_len);
+      return(dest);
+
+    case T_RANDOM_STATE:
+#if (!WITH_GMP)
+      random_seed(dest) = random_seed(source);
+      random_carry(dest) = random_carry(source);
+#endif
+      return(dest);
+
+    case T_C_OBJECT:
+      return(copy_c_object_to_same_type(sc, dest, source, dest_start, dest_end, source_start));
+
+    case T_LET:
+      return(NULL);
+
+    case T_HASH_TABLE:
+      {
+	s7_pointer p;
+	gc_protect_via_stack(sc, source);
+	p = hash_table_copy(sc, source, dest, source_start, source_start + source_len);
+	unstack_gc_protect(sc);
+	if ((hash_table_checker(source) != hash_table_checker(dest)) &&
+	    (hash_table_mapper(dest) == default_hash_map))
+	  {
+	    if (hash_table_checker(dest) == hash_empty)
+	      hash_table_checker(dest) = hash_table_checker(source); /* copy hash_table_procedures also? what about the mapper? see hash_table_copy */
+	    else
+	      {
+		hash_table_checker(dest) = hash_equal;
+		hash_set_chosen(dest);
+	      }}
+	return(p);
+      }
+
+    default:
+      return(dest);
+    }
+  return(NULL);
+}
+
+static noreturn void copy_element_error_nr(s7_scheme *sc, s7_pointer caller, s7_int num, s7_pointer element, int32_t desired_type)
+{
+  set_elist_6(sc, wrap_string(sc, "~A ~:D element, ~S, is ~A but should be ~A", 42),
+	      caller, wrap_integer(sc, num), element, type_name_string(sc, element), sc->type_names[desired_type]);
+  error_nr(sc, sc->wrong_type_arg_symbol, sc->elist_6);
+}
+
+static noreturn void copy_element_error_with_type_nr(s7_scheme *sc, s7_pointer caller, s7_int num, s7_pointer element, s7_pointer desired_type)
+{
+  set_elist_6(sc, wrap_string(sc, "~A ~:D element, ~S, is ~A but should be ~A", 42),
+	      caller, wrap_integer(sc, num), element, type_name_string(sc, element), desired_type);
+  error_nr(sc, sc->wrong_type_arg_symbol, sc->elist_6);
+}
+
+static s7_pointer s7_copy_1(s7_scheme *sc, s7_pointer caller, s7_pointer args)
+{
+  #define H_copy "(copy obj) returns a copy of obj, (copy src dest) copies src into dest, (copy src dest start end) copies src from start to end."
+  /* #define Q_copy s7_make_circular_signature(sc, 3, 4, sc->T, sc->is_sequence_symbol, sc->is_sequence_symbol, sc->is_integer_symbol) */
+  /* this is not right when c-object types are handled in lint -- a generator or Snd object need not consider itself a sequence,
+   *   but it can provide a copy method.  So, I think I'll just use #t
+   */
+  #define Q_copy s7_make_circular_signature(sc, 3, 4, sc->T, sc->T, sc->T, sc->is_integer_symbol)
+
+  s7_pointer source = car(args), dest;
+  s7_int i, j, dest_len, start, end, source_len;
+  s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_int loc, s7_pointer val) = NULL;
+  s7_pointer (*get)(s7_scheme *sc, s7_pointer obj, s7_int loc) = NULL;
+  bool have_indices;
+
+  if (is_null(cdr(args)))                  /* (copy obj) */
+    return(copy_source_no_dest(sc, source, args));
+
+  dest = T_Ext(cadr(args));
+  if ((dest == sc->readable_keyword) && (!is_pair(source)))
+    error_nr(sc, sc->out_of_range_symbol,
+	     set_elist_1(sc, wrap_string(sc, "copy argument 2, :readable, only works if the source is a pair", 62)));
+
+  if ((is_immutable(dest)) &&
+      (dest != sc->readable_keyword) &&
+      (dest != sc->nil))                 /* error_hook copies with cadr(args) :readable, so it's currently NULL */
+    wrong_type_error_nr(sc, caller, 2, dest, wrap_string(sc, "a mutable object", 16)); /* so this segfaults if not checking for :readable */
+
+  have_indices = (is_pair(cddr(args)));
+  if ((source == dest) && (!have_indices))
+    return(dest);
+
+  /* gc_protect_via_stack(sc, args); */ /* why is this problematic? */
+  sc->w = args;
+
+  switch (type(source))
+    {
+    case T_PAIR:
+      if (dest == sc->readable_keyword)  /* a kludge, but I can't think of anything less stupid */
+	{
+	  if (have_indices)              /* it seems to me that the start/end args here don't make any sense so... */
+	    error_nr(sc, sc->wrong_number_of_args_symbol,
+		     set_elist_3(sc, wrap_string(sc, "~S: start/end indices make no sense with :readable: ~S", 54), caller, args));
+	  return(copy_body(sc, source));
+	}
+      end = s7_list_length(sc, source);
+      if (end == 0)
+	end = circular_list_entries(source);
+      else
+	if (end < 0) end = -end;
+      break;
+
+    case T_INT_VECTOR:  case T_FLOAT_VECTOR: case T_VECTOR: case T_BYTE_VECTOR:
+      get = vector_getter(source);
+      end = vector_length(source);
+      break;
+
+    case T_STRING:
+      get = string_getter;
+      end = string_length(source);
+      break;
+
+    case T_HASH_TABLE:
+      if (source == dest) return(dest);
+      end = hash_table_entries(source);
+      break;
+
+    case T_RANDOM_STATE:
+      get = random_state_getter;
+      end = 2;
+      break;
+
+    case T_C_OBJECT:
+      if (c_object_copy(sc, source))
+	{
+	  s7_pointer x = (*(c_object_copy(sc, source)))(sc, args);
+	  if (x == dest) return(dest); /* this can happen (s7test block_copy) */
+	}
+      check_method(sc, source, sc->copy_symbol, args);
+      get = c_object_getter;
+      end = c_object_length_to_int(sc, source);
+      break;
+
+    case T_LET:
+      if (source == dest) return(dest);
+      check_method(sc, source, sc->copy_symbol, args);
+      if (source == sc->rootlet)
+	wrong_type_error_nr(sc, caller, 1, source, wrap_string(sc, "a sequence other than the rootlet", 33));
+      if ((!have_indices) && (is_let(dest)) && (dest != sc->s7_starlet))
+	{
+	  s7_pointer slot;
+	  if (dest == sc->rootlet) /* (copy (inlet 'a 1) (rootlet)) */
+	    for (slot = let_slots(source); tis_slot(slot); slot = next_slot(slot))
+	      s7_make_slot(sc, dest, slot_symbol(slot), slot_value(slot));
+	  else
+	    if ((has_let_fallback(source)) &&
+		(has_let_fallback(dest)))
+	      {
+		for (slot = let_slots(source); tis_slot(slot); slot = next_slot(slot))
+		  if ((slot_symbol(slot) != sc->let_ref_fallback_symbol) &&
+		      (slot_symbol(slot) != sc->let_set_fallback_symbol))
+		    add_slot_no_local(sc, dest, slot_symbol(slot), slot_value(slot));
+	      }
+	    else
+	      /* this copies reversing the order -- if shadowing, this unshadows, tmp has in-order copy code, but it's too much effort */
+	      /*   it also ignores possible slot setters */
+	      for (slot = let_slots(source); tis_slot(slot); slot = next_slot(slot))
+		add_slot_no_local(sc, dest, slot_symbol(slot), slot_value(slot));
+	  return(dest);
+	}
+      end = let_length(sc, source);
+      break;
+
+    case T_NIL:
+      end = 0;
+      if (is_sequence(dest))
+	break;
+
+    default:
+      error_nr(sc, sc->wrong_type_arg_symbol, set_elist_4(sc, wrap_string(sc, "can't ~S ~S to ~S", 17), caller, source, dest));
+    }
+
+  start = 0;
+  if (have_indices)
+    {
+      s7_pointer p = start_and_end(sc, caller, args, 3, cddr(args), &start, &end);
+      if (p != sc->unused) return(p);
+    }
+  if ((start == 0) && (source == dest))
+    return(dest);
+
+  source_len = end - start;
+  if (source_len == 0)
+    {
+      if (!is_sequence(dest))
+	wrong_type_error_nr(sc, caller, 2, dest, a_sequence_string);
+      return(dest);
+    }
+
+  switch (type(dest))
+    {
+    case T_PAIR:
+      dest_len = source_len;
+      break;
+
+    case T_INT_VECTOR:
+    case T_BYTE_VECTOR:
+      if (is_float_vector(source))
+	error_nr(sc, sc->wrong_type_arg_symbol,
+		 set_elist_4(sc, wrap_string(sc, "can't ~S ~S to ~A", 17), caller, source, sc->type_names[type(dest)]));
+    case T_FLOAT_VECTOR:
+      set = vector_setter(dest);
+      dest_len = vector_length(dest);
+      break;
+
+    case T_VECTOR:
+      set = (is_typed_vector(dest)) ? typed_vector_setter : vector_setter(dest);
+      dest_len = vector_length(dest);
+      break;
+
+    case T_STRING:
+      set = string_setter;
+      dest_len = string_length(dest);
+      set_cadr(sc->elist_3, caller);   /* for possible error handling in string_setter */
+      break;
+
+    case T_HASH_TABLE:
+      set = hash_table_setter;
+      dest_len = source_len;
+      set_cadr(sc->elist_3, caller);   /* for possible error handling in hash_table_setter */
+      break;
+
+    case T_C_OBJECT:
+      /* if source or dest is c_object, call its copy function before falling back on the get/set functions */
+      if (c_object_copy(sc, dest))
+	{
+	  s7_pointer x = (*(c_object_copy(sc, dest)))(sc, args);
+	  if (x == dest)
+	    return(dest);
+	}
+      set = c_object_setter;
+      dest_len = c_object_length_to_int(sc, dest);
+      break;
+
+    case T_LET:
+      if (dest == sc->rootlet)
+	wrong_type_error_nr(sc, caller, 2, dest, wrap_string(sc, "a sequence other rootlet", 24));
+      if (dest == sc->s7_starlet)
+	wrong_type_error_nr(sc, caller, 2, dest, wrap_string(sc, "a sequence other than *s7*", 26));
+      set = let_setter;
+      dest_len = source_len;          /* grows via set, so dest_len isn't relevant */
+      set_cadr(sc->elist_3, caller);  /* for possible error handling in let_setter */
+      break;
+
+    case T_NIL:
+      return(sc->nil);
+
+    case T_RANDOM_STATE:
+      set = random_state_setter;
+      dest_len = 2;
+      break;
+
+    default:
+      error_nr(sc, sc->wrong_type_arg_symbol, set_elist_4(sc, wrap_string(sc, "can't ~S ~S to ~S", 17), caller, source, dest));
+    }
+
+  if (dest_len == 0)
+    return(dest);
+
+  /* end is source_len if not set explicitly */
+  if (dest_len < source_len)
+    {
+      end = dest_len + start;
+      source_len = dest_len;
+    }
+
+  if ((source != dest) &&
+      ((type(source) == type(dest)) ||
+       ((is_string_or_byte_vector(source)) &&
+	(is_string_or_byte_vector(dest)))))
+    {
+      s7_pointer res = copy_to_same_type(sc, dest, source, 0, source_len, start);
+      if (res) return(res);
+    }
+
+  switch (type(source))
+    {
+    case T_PAIR:
+      {
+	s7_pointer p = source;
+	i = 0;
+	if (start > 0)
+	  for (i = 0; i < start; i++)
+	    p = cdr(p);
+	/* dest won't be a pair here if source != dest -- the pair->pair case was caught above */
+	if (source == dest) /* here start != 0 (see above) */
+	  for (s7_pointer dp = source /* i = start */; i < end; i++, p = cdr(p), dp = cdr(dp))
+	    set_car(dp, car(p));
+	else
+	  if (is_string(dest))
+	    {
+	      char *dst = string_value(dest);
+	      for (/* i = start */ j = 0; i < end; i++, j++, p = cdr(p))
+		{
+		  if (!is_character(car(p)))
+		    copy_element_error_nr(sc, caller, i + 1, car(p), T_CHARACTER);
+		  dst[j] = character(car(p));
+		}}
+	  else
+	    if ((is_t_vector(dest)) && (set != typed_vector_setter))
+	      {
+		s7_pointer *els = vector_elements(dest);
+		for (/* i = start */ j = 0; i < end; i++, j++, p = cdr(p))
+		  els[j] = car(p);
+	      }
+	    else
+	      {
+		gc_protect_via_stack(sc, source);
+		for (/* i = start */ j = 0; i < end; i++, j++, p = cdr(p))
+		  set(sc, dest, j, car(p));
+		unstack_gc_protect(sc);
+	      }
+	return(dest);
+      }
+
+    case T_LET:
+      if (source == sc->s7_starlet) /* *s7* */
+	{
+	  s7_pointer iter = s7_make_iterator(sc, sc->s7_starlet);
+	  s7_int gc_loc = gc_protect_1(sc, iter);
+	  for (i = 0; i < start; i++)
+	    {
+	      s7_iterate(sc, iter);
+	      if (iterator_is_at_end(iter))
+		{
+		  s7_gc_unprotect_at(sc, gc_loc);
+		  return(dest);
+		}}
+	  if (is_pair(dest)) /* (append '(1) *s7* ()) */
+	    {
+	      s7_pointer p;
+	      for (i = start, p = dest; (i < end) && (is_pair(p)); i++, p = cdr(p))
+		{
+		  s7_pointer val = s7_iterate(sc, iter);
+		  if (iterator_is_at_end(iter)) break;
+		  set_car(p, val);
+		}}
+	  else
+	    for (i = start, j = 0; i < end; i++, j++)
+	      {
+		s7_pointer val = s7_iterate(sc, iter);
+		if (iterator_is_at_end(iter)) break;
+		set(sc, dest, j, val);
+	      }
+	  s7_gc_unprotect_at(sc, gc_loc);
+	}
+      else
+	{
+	  /* source and dest can't be rootlet (checked above), dest also can't be *s7* */
+	  s7_pointer slot = let_slots(source);
+	  for (i = 0; i < start; i++) slot = next_slot(slot);
+	  if (is_pair(dest))
+	    {
+	      s7_pointer p;
+	      check_free_heap_size(sc, end - start);
+	      for (i = start, p = dest; (i < end) && (is_pair(p)); i++, p = cdr(p), slot = next_slot(slot))
+		set_car(p, cons_unchecked(sc, slot_symbol(slot), slot_value(slot)));
+	    }
+	  else
+	    if (is_let(dest)) /* this ignores slot setters */
+	      {
+		if ((has_let_fallback(source)) &&
+		    (has_let_fallback(dest)))
+		  {
+		    for (slot = let_slots(source); tis_slot(slot); slot = next_slot(slot))
+		      if ((slot_symbol(slot) != sc->let_ref_fallback_symbol) &&
+			  (slot_symbol(slot) != sc->let_set_fallback_symbol))
+			add_slot_no_local(sc, dest, slot_symbol(slot), slot_value(slot));
+		  }
+		else
+		  for (i = start; i < end; i++, slot = next_slot(slot))
+		    add_slot_no_local(sc, dest, slot_symbol(slot), slot_value(slot));
+	      }
+	    else
+	      if (is_hash_table(dest))
+		for (i = start; i < end; i++, slot = next_slot(slot))
+		  s7_hash_table_set(sc, dest, slot_symbol(slot), slot_value(slot)); /* if value=#f, dest will not contain symbol */
+	      else
+		if ((is_t_vector(dest)) && (set != typed_vector_setter))
+		  {
+		    s7_pointer *els = vector_elements(dest);
+		    check_free_heap_size(sc, end - start);
+		    for (i = start, j = 0; i < end; i++, j++, slot = next_slot(slot))
+		      els[j] = cons_unchecked(sc, slot_symbol(slot), slot_value(slot));
+		  }
+		else
+		  for (i = start, j = 0; i < end; i++, j++, slot = next_slot(slot))
+		    set(sc, dest, j, cons(sc, slot_symbol(slot), slot_value(slot)));
+	}
+      return(dest);
+
+    case T_HASH_TABLE:
+      {
+	s7_int loc = -1, skip = start;
+	hash_entry_t **elements = hash_table_elements(source);
+	hash_entry_t *x = NULL;
+
+	while (skip > 0)
+	  {
+	    while (!x) x = elements[++loc];
+	    skip--;
+	    x = hash_entry_next(x);
+	  }
+	if (is_pair(dest))
+	  {
+	    s7_pointer p;
+	    check_free_heap_size(sc, end - start);
+	    for (i = start, p = dest; (i < end) && (is_pair(p)); i++, p = cdr(p))
+	      {
+		while (!x) x = elements[++loc];
+		set_car(p, cons_unchecked(sc, hash_entry_key(x), hash_entry_value(x)));
+		x = hash_entry_next(x);
+	      }}
+	else
+	  if (is_let(dest))
+	    {
+	      for (i = start; i < end; i++)
+		{
+		  s7_pointer symbol;
+		  while (!x) x = elements[++loc];
+		  symbol = hash_entry_key(x);
+		  if (!is_symbol(symbol))
+		    copy_element_error_nr(sc, caller, i + 1, symbol, T_SYMBOL);
+		  if (is_constant_symbol(sc, symbol))
+		    error_nr(sc, sc->wrong_type_arg_symbol,
+			     set_elist_4(sc, wrap_string(sc, "~A into ~A: ~A is a constant", 28), caller, dest, symbol));
+		  if ((symbol != sc->let_ref_fallback_symbol) &&
+		      (symbol != sc->let_set_fallback_symbol))
+		    add_slot_no_local(sc, dest, symbol, hash_entry_value(x)); /* ...unchecked... if size ok */
+		  x = hash_entry_next(x);
+		}}
+	  else
+	    {
+	      check_free_heap_size(sc, end - start);
+	      for (i = start, j = 0; i < end; i++, j++)
+		{
+		  while (!x) x = elements[++loc];
+		  set(sc, dest, j, cons_unchecked(sc, hash_entry_key(x), hash_entry_value(x)));
+		  x = hash_entry_next(x);
+		}}
+        return(dest);
+      }
+
+    case T_VECTOR:
+      {
+	s7_pointer *vals = vector_elements(source);
+	if (is_float_vector(dest))
+	  {
+	    s7_double *dst = float_vector_floats(dest);
+	    for (i = start, j = 0; i < end; i++, j++)
+	      dst[j] = real_to_double(sc, vals[i], symbol_name(caller));
+	    return(dest);
+	  }
+	if (is_int_vector(dest))
+	  {
+	    s7_int *dst = int_vector_ints(dest);
+	    for (i = start, j = 0; i < end; i++, j++)
+	      {
+		if (!s7_is_integer(vals[i]))
+		  copy_element_error_nr(sc, caller, i + 1, vals[i], T_INTEGER);
+		dst[j] = s7_integer_clamped_if_gmp(sc, vals[i]);
+	      }
+	    return(dest);
+	  }
+	if (is_string(dest))
+	  {
+	    char *dst = string_value(dest);
+	    for (i = start, j = 0; i < end; i++, j++)
+	      {
+		if (!is_character(vals[i]))
+		  copy_element_error_nr(sc, caller, i + 1, vals[i], T_CHARACTER);
+		dst[j] = character(vals[i]);
+	      }
+	    return(dest);
+	  }
+	if (is_byte_vector(dest))
+	  {
+	    uint8_t *dst = (uint8_t *)byte_vector_bytes(dest);
+	    for (i = start, j = 0; i < end; i++, j++)
+	      {
+		s7_int byte;
+		if (!s7_is_integer(vals[i]))
+		  copy_element_error_with_type_nr(sc, caller, i + 1, vals[i], an_unsigned_byte_string);
+		byte = s7_integer_clamped_if_gmp(sc, vals[i]);
+		if ((byte >= 0) && (byte < 256))
+		  dst[j] = (uint8_t)byte;
+		else copy_element_error_with_type_nr(sc, caller, i + 1, vals[i], an_unsigned_byte_string);
+	      }
+	    return(dest);
+	  }}
+      break;
+
+    case T_FLOAT_VECTOR:
+      {
+	s7_double *src = float_vector_floats(source);
+	/* int-vector destination can't normally work, fractional parts get rounded away */
+	if ((is_t_vector(dest)) && (!is_typed_vector(dest)))
+	  {
+	    s7_pointer *dst = vector_elements(dest);
+	    check_free_heap_size(sc, end - start);
+	    for (i = start, j = 0; i < end; i++, j++)
+	      dst[j] = make_real_unchecked(sc, src[i]);
+	    return(dest);
+	  }}
+      break;
+
+    case T_INT_VECTOR:
+      {
+	s7_int *src = int_vector_ints(source);
+	if (is_float_vector(dest))
+	  {
+	    s7_double *dst = float_vector_floats(dest);
+	    for (i = start, j = 0; i < end; i++, j++)
+	      dst[j] = (s7_double)(src[i]);
+	    return(dest);
+	  }
+	if ((is_t_vector(dest)) && (!is_typed_vector(dest)))
+	  {
+	    s7_pointer *dst = vector_elements(dest);
+	    check_free_heap_size(sc, end - start);
+	    for (i = start, j = 0; i < end; i++, j++)
+	      dst[j] = make_integer_unchecked(sc, src[i]);
+	    return(dest);
+	  }
+	if (is_string(dest))
+	  {
+	    for (i = start, j = 0; i < end; i++, j++)
+	      {
+		if ((src[i] < 0) || (src[i] > 255))
+		  copy_element_error_with_type_nr(sc, caller, i + 1, wrap_integer(sc, src[i]), an_unsigned_byte_string);
+		string_value(dest)[j] = (uint8_t)(src[i]);
+	      }
+	    return(dest);
+	  }
+	if (is_byte_vector(dest))
+	  {
+	    for (i = start, j = 0; i < end; i++, j++)
+	      {
+		if ((src[i] < 0) || (src[i] > 255))
+		  copy_element_error_with_type_nr(sc, caller, i + 1, wrap_integer(sc, src[i]), an_unsigned_byte_string);
+		byte_vector(dest, j) = (uint8_t)(src[i]);
+	      }
+	    return(dest);
+	  }}
+      break;
+
+    case T_BYTE_VECTOR:
+      if ((is_t_vector(dest)) && (!is_typed_vector(dest)))
+	{
+	  s7_pointer *dst = vector_elements(dest);
+	  check_free_heap_size(sc, end - start);
+	  for (i = start, j = 0; i < end; i++, j++)
+	    dst[j] = small_int(byte_vector(source, i));
+	  return(dest);
+	}
+      if (is_int_vector(dest))
+	{
+	  s7_int *els = int_vector_ints(dest);
+	  for (i = start, j = 0; i < end; i++, j++)
+	    els[j] = (s7_int)((uint8_t)(byte_vector(source, i)));
+	  return(dest);
+	}
+      if (is_float_vector(dest))
+	{
+	  s7_double *els = float_vector_floats(dest);
+	  for (i = start, j = 0; i < end; i++, j++)
+	    els[j] = (s7_double)((uint8_t)(byte_vector(source, i)));
+	  return(dest);
+	}
+      break;
+
+    case T_STRING:
+      if ((is_t_vector(dest))  && (!is_typed_vector(dest)))
+	{
+	  s7_pointer *dst = vector_elements(dest);
+	  for (i = start, j = 0; i < end; i++, j++)
+	    dst[j] = chars[(uint8_t)string_value(source)[i]];
+	  return(dest);
+	}
+      if (is_int_vector(dest))
+	{
+	  s7_int *els = int_vector_ints(dest);
+	  for (i = start, j = 0; i < end; i++, j++)
+	    els[j] = (s7_int)((uint8_t)(string_value(source)[i]));
+	  return(dest);
+	}
+      if (is_float_vector(dest))
+	{
+	  s7_double *els = float_vector_floats(dest);
+	  for (i = start, j = 0; i < end; i++, j++)
+	    els[j] = (s7_double)((uint8_t)(string_value(source)[i]));
+	  return(dest);
+	}
+      break;
+    }
+
+  if (is_pair(dest))
+    {
+      s7_pointer p;
+      if (is_float_vector(source))
+	{
+	  s7_double *els = float_vector_floats(source);
+	  check_free_heap_size(sc, end - start);
+	  for (i = start, p = dest; (i < end) && (is_pair(p)); i++, p = cdr(p))
+	    set_car(p, make_real_unchecked(sc, els[i]));
+	}
+      else
+	if (is_int_vector(source))
+	  {
+	    s7_int *els = int_vector_ints(source);
+	    check_free_heap_size(sc, end - start);
+	    for (i = start, p = dest; (i < end) && (is_pair(p)); i++, p = cdr(p))
+	      set_car(p, make_integer_unchecked(sc, els[i]));
+	  }
+	else
+	  for (i = start, p = dest; (i < end) && (is_pair(p)); i++, p = cdr(p))
+	    set_car(p, get(sc, source, i));
+    }
+  else /* if source == dest here, we're moving data backwards, so this is safe in either case */
+    for (i = start, j = 0; i < end; i++, j++)
+      set(sc, dest, j, get(sc, source, i));
+  /* some choices probably should raise an error, but don't:
+   *   (copy (make-hash-table) "1") ; nothing to copy (empty hash table), so no error
+   */
+  return(dest);
+}
+
+s7_pointer s7_copy(s7_scheme *sc, s7_pointer args) {return(s7_copy_1(sc, sc->copy_symbol, args));}
+#define g_copy s7_copy
+
+
+/* -------------------------------- reverse -------------------------------- */
+s7_pointer s7_reverse(s7_scheme *sc, s7_pointer a) /* just pairs */
+{
+  /* reverse list -- produce new list (other code assumes this function does not return the original!) */
+  s7_pointer x, p;
+
+  if (is_null(a)) return(a);
+  if (!is_pair(cdr(a)))
+    return((is_null(cdr(a))) ? list_1(sc, car(a)) : cons(sc, cdr(a), car(a)));  /* don't return 'a' itself */
+  sc->w = list_1(sc, car(a));
+  for (x = cdr(a), p = a; is_pair(x); x = cdr(x), p = cdr(p))
+    {
+      sc->w = cons(sc, car(x), sc->w);
+      if (is_pair(cdr(x)))
+	{
+	  x = cdr(x);
+	  sc->w = cons_unchecked(sc, car(x), sc->w);
+	}
+      if (x == p) /* this can take awhile to notice there's a cycle, but what does the caller expect? */
+	break;
+    }
+  p = (is_null(x)) ? sc->w : cons(sc, x, sc->w);    /* ?? this means that (reverse '(1 2 . 3)) returns '(3 2 1) -- we used to return () here */
+  sc->w = sc->unused;
+  return(p);
+}
+
+/* s7_reverse sometimes tacks extra nodes on the end of a reversed circular list (it detects the cycle too late)
+ *  (let ((lst (list 0))) (set! (cdr lst) lst) (reverse lst)) -> (#1=(0 . #1#) 0 0 0)
+ */
+
+static s7_pointer string_reverse(s7_scheme *sc, s7_pointer p)
+{
+  s7_pointer np;
+  char *dest, *source = string_value(p);
+  s7_int len = string_length(p);
+  char *end = (char *)(source + len);
+  np = make_empty_string(sc, len, '\0');
+  dest = (char *)(string_value(np) + len);
+  while (source < end) *(--dest) = *source++;
+  return(np);
+}
+
+static s7_pointer byte_vector_reverse(s7_scheme *sc, s7_pointer p)
+{
+  s7_pointer np;
+  uint8_t *dest;
+  const uint8_t *source = byte_vector_bytes(p);
+  s7_int len = byte_vector_length(p);
+  const uint8_t *end = (const uint8_t *)(source + len);
+  np = make_simple_byte_vector(sc, len);
+  dest = (uint8_t *)(byte_vector_bytes(np) + len);
+  while (source < end) *(--dest) = *source++;
+  return(np);
+}
+
+static s7_pointer int_vector_reverse(s7_scheme *sc, s7_pointer p)
+{
+  s7_pointer np;
+  s7_int *dest, *source = int_vector_ints(p);
+  s7_int len = vector_length(p);
+  s7_int *end = (s7_int *)(source + len);
+  if (vector_rank(p) > 1)
+    np = g_make_vector_1(sc, set_plist_2(sc, g_vector_dimensions(sc, set_plist_1(sc, p)), int_zero), sc->make_int_vector_symbol);
+  else np = make_simple_int_vector(sc, len);
+  dest = (s7_int *)(int_vector_ints(np) + len);
+  while (source < end) *(--dest) = *source++;
+  return(np);
+}
+
+static s7_pointer float_vector_reverse(s7_scheme *sc, s7_pointer p)
+{
+  s7_pointer np;
+  s7_double *dest, *source = float_vector_floats(p);
+  s7_int len = vector_length(p);
+  s7_double *end = (s7_double *)(source + len);
+  if (vector_rank(p) > 1)
+    np = g_make_vector_1(sc, set_plist_2(sc, g_vector_dimensions(sc, set_plist_1(sc, p)), real_zero), sc->make_float_vector_symbol);
+  else np = make_simple_float_vector(sc, len);
+  dest = (s7_double *)(float_vector_floats(np) + len);
+  while (source < end) *(--dest) = *source++;
+  return(np);
+}
+
+static s7_pointer vector_reverse(s7_scheme *sc, s7_pointer p)
+{
+  s7_pointer np;
+  s7_pointer *dest, *source = vector_elements(p);
+  s7_int len = vector_length(p);
+  s7_pointer *end = (s7_pointer *)(source + len);
+  if (vector_rank(p) > 1)
+    np = g_make_vector(sc, set_plist_1(sc, g_vector_dimensions(sc, set_plist_1(sc, p))));
+  else np = make_simple_vector(sc, len);
+  dest = (s7_pointer *)(vector_elements(np) + len);
+  while (source < end) *(--dest) = *source++;
+  if (is_typed_vector(p))
+    {
+      set_typed_vector(np);
+      typed_vector_set_typer(np, typed_vector_typer(p));
+      if (has_simple_elements(p)) set_has_simple_elements(np);
+    }
+  return(np);
+}
+
+static s7_pointer reverse_p_p(s7_scheme *sc, s7_pointer p)
+{
+  sc->temp3 = p;
+  if (is_pair(p)) return(s7_reverse(sc, p)); /* by far the most common case */
+  switch (type(p))
+    {
+    case T_NIL:          return(sc->nil);
+    /* case T_PAIR:      return(s7_reverse(sc, p)); */
+    case T_STRING:       return(string_reverse(sc, p));
+    case T_BYTE_VECTOR:  return(byte_vector_reverse(sc, p));
+    case T_INT_VECTOR:   return(int_vector_reverse(sc, p));
+    case T_FLOAT_VECTOR: return(float_vector_reverse(sc, p));
+    case T_VECTOR:       return(vector_reverse(sc, p));
+    case T_HASH_TABLE:   return(hash_table_reverse(sc, p));
+    case T_C_OBJECT:
+      check_method(sc, p, sc->reverse_symbol, set_plist_1(sc, p));
+      if (!c_object_reverse(sc, p))
+	syntax_error_nr(sc, "attempt to reverse ~S?", 22, p);
+      return((*(c_object_reverse(sc, p)))(sc, set_plist_1(sc, p)));
+    case T_LET:
+      check_method(sc, p, sc->reverse_symbol, set_plist_1(sc, p));
+      error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "can't reverse let: ~S", 21), p));
+    default:
+      return(method_or_bust_p(sc, p, sc->reverse_symbol, a_sequence_string));
+    }
+  return(sc->nil);
+}
+
+static s7_pointer g_reverse(s7_scheme *sc, s7_pointer args)
+{
+  #define H_reverse "(reverse lst) returns a list with the elements of lst in reverse order.  reverse \
+also accepts a string or vector argument."
+  #define Q_reverse s7_make_signature(sc, 2, sc->is_sequence_symbol, sc->is_sequence_symbol)
+  return(reverse_p_p(sc, car(args)));
+}
+
+static s7_pointer any_list_reverse_in_place(s7_scheme *sc, s7_pointer term, s7_pointer list)
+{
+  s7_pointer p, result;
+  if (is_null(list)) return(term);
+  p = list;
+  result = term;
+  while (true)
+    {
+      s7_pointer q = cdr(p);
+      if (is_null(q))
+	{
+	  set_cdr(p, result);
+	  return(p);
+	}
+      if ((is_pair(q)) && (!is_immutable_pair(q)))
+	{
+	  set_cdr(p, result);
+	  result = p;
+	  p = q;
+	}
+      else return(sc->nil); /* improper or immutable */
+    }
+  return(result);
+}
+
+static s7_pointer string_or_byte_vector_reverse_in_place(s7_scheme *sc, s7_pointer p)
+{
+  s7_int len;
+  uint8_t *bytes;
+
+  if (is_string(p))
+    {
+      len = string_length(p);
+      bytes = (uint8_t *)string_value(p);
+    }
+  else
+    {
+      len = byte_vector_length(p);
+      bytes = byte_vector_bytes(p);
+    }
+  if (len < 2) return(p);
+
+  if (is_immutable(p)) /* "" might be immutable but we want (reverse! "") to return "" */
+    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->reverseb_symbol, p));
+
+#if (defined(__linux__)) && (defined(__GLIBC__)) /* need byteswp.h */
+  /* this code (from StackOverflow with changes) is much faster: */
+#include <byteswap.h>
+  if ((len & 0x7f) == 0)
+    {
+      uint32_t *dst = (uint32_t *)(bytes + len - 4);
+      uint32_t *src = (uint32_t *)bytes;
+      while (src < dst)
+	{
+	  uint32_t a, b;
+	  LOOP_4(a = *src; b = *dst; *src++ = bswap_32(b); *dst-- = bswap_32(a));
+	  LOOP_4(a = *src; b = *dst; *src++ = bswap_32(b); *dst-- = bswap_32(a));
+	  LOOP_4(a = *src; b = *dst; *src++ = bswap_32(b); *dst-- = bswap_32(a));
+	  LOOP_4(a = *src; b = *dst; *src++ = bswap_32(b); *dst-- = bswap_32(a));
+	}}
+  else
+    if ((len & 0x1f) == 0) /* 4-bytes at a time, 4 times per loop == 16 */
+      {
+	uint32_t *dst = (uint32_t *)(bytes + len - 4);
+	uint32_t *src = (uint32_t *)bytes;
+	while (src < dst)
+	  {
+	    uint32_t a, b;
+	    LOOP_4(a = *src; b = *dst; *src++ = bswap_32(b); *dst-- = bswap_32(a));
+	  }}
+    else
+#endif
+      {
+	char *s1 = (char *)bytes;
+	char *s2 = (char *)(s1 + len - 1);
+	while (s1 < s2) {char c; c = *s1; *s1++ = *s2; *s2-- = c;}
+      }
+  return(p);
+}
+
+static s7_pointer int_vector_reverse_in_place(s7_scheme *sc, s7_pointer p)
+{
+  s7_int len = vector_length(p);
+  s7_int *s1 = int_vector_ints(p), *s2;
+
+  if (len < 2) return(p); /* (reverse! #i()) -> #i() independent of immutable bit */
+  if (is_immutable_vector(p))
+    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->reverseb_symbol, p));
+
+  s2 = (s7_int *)(s1 + len - 1);
+  if ((len & 0x3f) == 0) /* 63 for 2 32's */
+    while (s1 < s2)
+      {
+	s7_int c;
+	LOOP_8(c = *s1; *s1++ = *s2; *s2-- = c);
+	LOOP_8(c = *s1; *s1++ = *s2; *s2-- = c);
+	LOOP_8(c = *s1; *s1++ = *s2; *s2-- = c);
+	LOOP_8(c = *s1; *s1++ = *s2; *s2-- = c);
+      }
+  else
+    if ((len & 0xf) == 0) /* not 0x7 -- odd multiple of 8 will leave center ints unreversed (we're moving 2 at a time) */
+      while (s1 < s2)
+	{
+	  s7_int c;
+	  LOOP_8(c = *s1; *s1++ = *s2; *s2-- = c);
+	}
+    else while (s1 < s2) {s7_int c; c = *s1; *s1++ = *s2; *s2-- = c;}
+  return(p);
+}
+
+static s7_pointer float_vector_reverse_in_place(s7_scheme *sc, s7_pointer p)
+{
+  s7_int len = vector_length(p);
+  s7_double *s1 = float_vector_floats(p), *s2;
+  if (len < 2) return(p);
+  if (is_immutable_vector(p))
+    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->reverseb_symbol, p));
+  s2 = (s7_double *)(s1 + len - 1);
+  if ((len & 0x3f) == 0) /* 63 for 2 32's */
+    while (s1 < s2)
+      {
+	s7_double c;
+	LOOP_8(c = *s1; *s1++ = *s2; *s2-- = c);
+	LOOP_8(c = *s1; *s1++ = *s2; *s2-- = c);
+	LOOP_8(c = *s1; *s1++ = *s2; *s2-- = c);
+	LOOP_8(c = *s1; *s1++ = *s2; *s2-- = c);
+      }
+  else
+    if ((len & 0xf) == 0)
+      while (s1 < s2)
+	{
+	  s7_double c;
+	  LOOP_8(c = *s1; *s1++ = *s2; *s2-- = c);
+	}
+    else while (s1 < s2) {s7_double c; c = *s1; *s1++ = *s2; *s2-- = c;}
+  return(p);
+}
+
+static s7_pointer vector_reverse_in_place(s7_scheme *sc, s7_pointer p)
+{
+  s7_int len = vector_length(p);
+  s7_pointer *s1 = vector_elements(p), *s2;
+  if (len < 2) return(p);
+  if (is_immutable_vector(p))
+    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->reverseb_symbol, p));
+  s2 = (s7_pointer *)(s1 + len - 1);
+  if ((len & 0x3f) == 0) /* 63 for 2 32's */
+    while (s1 < s2)
+      {
+	s7_pointer c;
+	LOOP_8(c = *s1; *s1++ = *s2; *s2-- = c);
+	LOOP_8(c = *s1; *s1++ = *s2; *s2-- = c);
+	LOOP_8(c = *s1; *s1++ = *s2; *s2-- = c);
+	LOOP_8(c = *s1; *s1++ = *s2; *s2-- = c);
+      }
+  else
+    if ((len & 0xf) == 0)
+      while (s1 < s2)
+	{
+	  s7_pointer c;
+	  LOOP_8(c = *s1; *s1++ = *s2; *s2-- = c);
+	}
+    else while (s1 < s2) {s7_pointer c; c = *s1; *s1++ = *s2; *s2-- = c;}
+  return(p);
+}
+
+static s7_pointer g_reverse_in_place(s7_scheme *sc, s7_pointer args)
+{
+  #define H_reverse_in_place "(reverse! lst) reverses lst in place"
+  #define Q_reverse_in_place Q_reverse
+
+  /* (reverse v) is only slighly faster than (reverse! (copy v)) */
+  s7_pointer p = car(args);
+  switch (type(p))
+    {
+    case T_NIL:       /* (reverse! ()) -> () */
+      return(sc->nil);
+
+    case T_PAIR:
+      if (is_immutable_pair(p))
+	immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->reverseb_symbol, p));
+      {
+	s7_pointer np = any_list_reverse_in_place(sc, sc->nil, p);
+	if (is_null(np))
+	  {
+	    if (!s7_is_proper_list(sc, p))
+	      wrong_type_error_nr(sc, sc->reverseb_symbol, 1, car(args), wrap_string(sc, "a proper list", 13));
+	    wrong_type_error_nr(sc, sc->reverseb_symbol, 1, car(args), wrap_string(sc, "a mutable proper list", 21));
+	  }
+	return(np);
+      }
+      /* (reverse! p) is supposed to change p directly and lisp programmers expect reverse! to be fast
+       * so in a sense this is different from the other cases: it assumes (set! p (reverse! p))
+       * To make (reverse! p) direct:
+       *    for (l = p, r = cdr(p); is_pair(r); l = r, r = cdr(r)) opt1(r) = l;
+       *    if (!is_null(r)) sole_arg_wrong_type_error_nr(sc, sc->reverseb_symbol, p, a_proper_list_string);
+       *    for (r = l, l = p; l != r; l = cdr(l)) {t = car(l); set_car(l, car(r)); set_car(r, t); if (cdr(l) != r) r = opt1(r);}
+       * immutable check is needed else (reverse! (catch #t 1 cons)) clobbers sc->wrong_type_arg_info
+       */
+
+    case T_BYTE_VECTOR:
+    case T_STRING:       return(string_or_byte_vector_reverse_in_place(sc, p));
+    case T_INT_VECTOR:   return(int_vector_reverse_in_place(sc, p));
+    case T_FLOAT_VECTOR: return(float_vector_reverse_in_place(sc, p));
+    case T_VECTOR:       return(vector_reverse_in_place(sc, p));
+
+    default:
+      if (is_immutable(p))
+	{
+	  if (is_simple_sequence(p))
+	    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->reverseb_symbol, p));
+	  sole_arg_wrong_type_error_nr(sc, sc->reverseb_symbol, p, a_sequence_string);
+	}
+      if ((is_simple_sequence(p)) &&
+	  (!has_active_methods(sc, p)))
+	sole_arg_wrong_type_error_nr(sc, sc->reverseb_symbol, p, wrap_string(sc, "a vector, string, or list", 25));
+      return(method_or_bust_p(sc, p, sc->reverseb_symbol, a_sequence_string));
+    }
+  return(p);
+}
+
+
+/* -------------------------------- fill! -------------------------------- */
+static s7_pointer pair_fill(s7_scheme *sc, s7_pointer args) /* args=(list tree-to-fill fill-val start end) */
+{
+  /* ambiguous ("tree-fill"?) but if it's like vector-fill, we just stomp on the top level */
+  s7_pointer obj = car(args), val;
+  s7_int i, start = 0, end, len;
+
+#if WITH_HISTORY
+  if ((is_immutable_pair(obj)) && (obj != sc->eval_history1) && (obj != sc->eval_history2))
+#else
+    if (is_immutable_pair(obj))
+#endif
+    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->fill_symbol, obj));
+  if (obj == global_value(sc->features_symbol)) /* (let_id(sc->curlet) == symbol_id(sc->features_symbol)) && (obj == local_value(sc->features_symbol))) */
+    error_nr(sc, sc->out_of_range_symbol, set_elist_1(sc, wrap_string(sc, "can't fill! *features*", 22)));
+  if (obj == global_value(sc->libraries_symbol))
+    error_nr(sc, sc->out_of_range_symbol, set_elist_1(sc, wrap_string(sc, "can't fill! *libraries*", 23)));
+
+  val = cadr(args);
+  len = s7_list_length(sc, obj);
+  end = len;
+  if (end < 0) end = -end; else {if (end == 0) end = 123123123;}
+  if (!is_null(cddr(args)))
+    {
+      s7_pointer p = start_and_end(sc, sc->fill_symbol, args, 3, cddr(args), &start, &end);
+      if (p != sc->unused) return(p);
+      if (start == end) return(val);
+    }
+  if (len > 0)
+    {
+      s7_pointer p;
+      if (end < len) len = end;
+      for (i = 0, p = obj; i < start; p = cdr(p), i++);
+      for (; i < len; p = cdr(p), i++) set_car(p, val);
+      return(val);
+    }
+  i = 0;
+  for (s7_pointer x = obj, y = obj; ; i++)
+    {
+      if ((end > 0) && (i >= end))
+	return(val);
+      if (i >= start) set_car(x, val);
+      if (!is_pair(cdr(x)))
+	{
+	  if (!is_null(cdr(x)))
+	    set_cdr(x, val);
+	  return(val);
+	}
+      x = cdr(x);
+      if ((i & 1) != 0) y = cdr(y);
+      if (x == y)
+	return(val);
+    }
+  return(val);
+}
+
+s7_pointer s7_fill(s7_scheme *sc, s7_pointer args)
+{
+  #define H_fill "(fill! obj val (start 0) end) fills obj with val"
+  #define Q_fill s7_make_circular_signature(sc, 3, 4, sc->T, sc->is_sequence_symbol, sc->T, sc->is_integer_symbol)
+
+  /* individual functions below check for immutable objects (rather than checking once for all here) because
+   *   they are used elsewhere, and there are complications (the history lists in pair_fill for example).
+   * However, obj might have a setter which disallows val -- I guess we'll run that setter using val,
+   *   to get the fill value to use (or raise an error).  But here we have the value not the symbol/slot!
+   */
+  s7_pointer p = car(args);
+  switch (type(p))
+    {
+    case T_STRING:     return(g_string_fill_1(sc, sc->fill_symbol, args)); /* redundant type check here and below */
+    case T_PAIR:       return(pair_fill(sc, args));
+    case T_HASH_TABLE: return(hash_table_fill(sc, args));
+    case T_NIL:
+      if (!is_null(cddr(args)))  /* (fill! () 1 21 #\a)? */
+	syntax_error_nr(sc, "fill! () ... includes indices: ~S?", 34, cddr(args));
+      return(cadr(args));        /* this parallels the empty vector case */
+    case T_BYTE_VECTOR: case T_INT_VECTOR: case T_FLOAT_VECTOR: case T_VECTOR:
+      return(g_vector_fill_1(sc, sc->fill_symbol, args));
+    case T_LET:
+      check_method(sc, p, sc->fill_symbol, args);
+      return(let_fill(sc, args));
+    case T_C_OBJECT:
+      check_method(sc, p, sc->fill_symbol, args);
+      if (!c_object_fill(sc, p)) /* default is NULL (s7_make_c_type) */
+	syntax_error_nr(sc, "attempt to fill ~S?", 19, p);
+      return((*(c_object_fill(sc, p)))(sc, args));
+    default:
+      check_method(sc, p, sc->fill_symbol, args);
+    }
+  wrong_type_error_nr(sc, sc->fill_symbol, 1, p, a_sequence_string); /* (fill! 1 0) */
+  return(NULL);
+}
+
+#define g_fill s7_fill
+
+
+/* -------------------------------- append -------------------------------- */
+static s7_int total_sequence_length(s7_scheme *sc, s7_pointer args, s7_pointer caller, uint8_t typ)
+{
+  s7_pointer p = args;
+  s7_int len = 0;
+
+  for (s7_int i = 1; is_pair(p); p = cdr(p), i++)
+    {
+      s7_pointer seq = car(p);
+      s7_int n = sequence_length(sc, seq);
+      if ((n > 0) &&
+	  (typ != T_FREE) &&
+	  ((type(seq) == T_HASH_TABLE) ||  /* can't append hash-tables (no obvious meaning to the operation) */
+	   ((type(seq) == T_LET) &&        /*   similarly for lets, unless this is a mock-string or something similar */
+	    ((!has_active_methods(sc, seq)) || (find_method(sc, seq, caller) == sc->undefined)))))
+	{
+	  wrong_type_error_nr(sc, caller, i, seq, sc->type_names[typ]);
+	  return(0);
+	}
+      if (n < 0)
+	{
+	  wrong_type_error_nr(sc, caller, i, seq, (is_pair(seq)) ? a_proper_list_string : a_sequence_string);
+	  return(0);
+	}
+      len += n;
+    }
+  return(len);
+}
+
+static s7_pointer vector_append(s7_scheme *sc, s7_pointer args, uint8_t typ, s7_pointer caller)
+{
+  s7_pointer new_vec, p, pargs, vtyper = NULL;
+  s7_pointer *v_elements = NULL;
+  s7_double *fv_elements = NULL;
+  s7_int *iv_elements = NULL;
+  uint8_t *byte_elements = NULL;
+  s7_int i, len;
+  bool typed;
+
+  gc_protect_via_stack(sc, args);
+  len = total_sequence_length(sc, args, caller, (typ == T_VECTOR) ? T_FREE : ((typ == T_FLOAT_VECTOR) ? T_REAL : T_INTEGER));
+  if (len > sc->max_vector_length)
+    {
+      unstack_gc_protect(sc);
+      error_nr(sc, sc->out_of_range_symbol,
+	       set_elist_4(sc, wrap_string(sc, "~S new vector length, ~D, is larger than (*s7* 'max-vector-length): ~D", 70),
+			   caller,
+			   wrap_integer(sc, len),
+			   wrap_integer(sc, sc->max_vector_length)));
+    }
+  new_vec = make_vector_1(sc, len, (typ == T_VECTOR) ? FILLED : NOT_FILLED, typ);  /* might hit GC in loop below so we can't use NOT_FILLED here (??) */
+  typed = (typ == T_VECTOR);
+  set_gc_protected2(sc, new_vec);
+  add_vector(sc, new_vec);
+  if (len == 0)
+    {
+      unstack_gc_protect(sc);
+      return(new_vec);
+    }
+  if (typ == T_VECTOR)
+    v_elements = vector_elements(new_vec);
+  else
+    if (typ == T_FLOAT_VECTOR)
+      fv_elements = float_vector_floats(new_vec);
+    else
+      if (typ == T_INT_VECTOR)
+	iv_elements = int_vector_ints(new_vec);
+      else byte_elements = byte_vector_bytes(new_vec);
+
+  pargs = list_2(sc, sc->F, new_vec); /* car set below */
+  /* push_stack_no_let(sc, OP_GC_PROTECT, new_vec, pargs); */
+  set_gc_protected3(sc, pargs);
+  for (i = 0, p = args; is_pair(p); p = cdr(p))    /* in-place copy by goofing (temporarily) with new_vec's elements pointer */
+    {
+      s7_pointer x = car(p);
+      s7_int n = sequence_length(sc, x);
+      if (n > 0)
+	{
+	  if ((typed) && (is_typed_t_vector(x)))
+	    {
+	      if (!vtyper)
+		vtyper = typed_vector_typer(x);
+	      else
+		if (vtyper != typed_vector_typer(x))
+		  typed = false;
+	    }
+	  else typed = false;
+	  vector_length(new_vec) = n;
+	  set_car(pargs, x);
+	  s7_copy_1(sc, caller, pargs);             /* not set_plist_2 here! */
+	  vector_length(new_vec) = 0;               /* so GC doesn't march off the end */
+	  i += n;
+	  if (typ == T_VECTOR)
+	    vector_elements(new_vec) = (s7_pointer *)(v_elements + i);
+	  else
+	    if (typ == T_FLOAT_VECTOR)
+	      float_vector_floats(new_vec) = (s7_double *)(fv_elements + i);
+	    else
+	      if (typ == T_INT_VECTOR)
+		int_vector_ints(new_vec) = (s7_int *)(iv_elements + i);
+	      else byte_vector_bytes(new_vec) = (uint8_t *)(byte_elements + i);
+	}}
+  /* unstack_gc_protect(sc); */ /* free_cell(sc, pargs); */ /* this is trouble if any arg is openlet with append method -- e.g. block */
+
+  if (typ == T_VECTOR)
+    vector_elements(new_vec) = v_elements;
+  else
+    if (typ == T_FLOAT_VECTOR)
+      float_vector_floats(new_vec) = fv_elements;
+    else
+      if (typ == T_INT_VECTOR)
+	int_vector_ints(new_vec) = iv_elements;
+      else byte_vector_bytes(new_vec) = byte_elements;
+  vector_length(new_vec) = len;
+  if ((typed) && (vtyper))
+    {
+      set_typed_vector(new_vec);
+      typed_vector_set_typer(new_vec, vtyper);
+    }
+  unstack_gc_protect(sc);
+  return(new_vec);
+}
+
+static s7_pointer hash_table_append(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer new_hash, key_typer = NULL, value_typer = NULL;
+  bool typed = true;
+  gc_protect_via_stack(sc, args);
+  check_stack_size(sc);
+  new_hash = s7_make_hash_table(sc, sc->default_hash_table_length);
+  set_gc_protected2(sc, new_hash);
+  for (s7_pointer p = args; is_pair(p); p = cdr(p))
+    {
+      s7_pointer seq = car(p);
+      if (!sequence_is_empty(sc, seq))
+	{
+	  /* perhaps check seq-length+hash_table_entries(new_hash) > sc->max_vector_length here? */
+	  s7_copy_1(sc, sc->append_symbol, set_plist_2(sc, seq, new_hash));
+	  if ((typed) && (is_hash_table(seq)) && (is_typed_hash_table(seq)))
+	    {
+	      if (!key_typer)
+		{ /* the equality/mapping procedures are either partly implicit or in hash-table-procedures -- a bit of a mess currently */
+		  key_typer = hash_table_key_typer(seq);
+		  value_typer = hash_table_value_typer(seq);
+		}
+	      else
+		if ((hash_table_key_typer(seq) != key_typer) ||
+		    (hash_table_value_typer(seq) != value_typer))
+		  typed = false;
+	    }
+	  else typed = false;
+	}}
+  if ((typed) && (key_typer))
+    {
+      hash_table_set_procedures(new_hash, make_hash_table_procedures(sc));
+      set_is_typed_hash_table(new_hash);
+      hash_table_set_key_typer(new_hash, key_typer);
+      hash_table_set_value_typer(new_hash, value_typer);
+    }
+  if (is_weak_hash_table(car(args))) /* 16-May-23, args gc protected above, should we limit weak-hash result to pure weak-hash args? */
+    {
+      set_weak_hash_table(new_hash);
+      weak_hash_iters(new_hash) = 0;
+    }
+  set_plist_2(sc, sc->nil, sc->nil);
+  unstack_gc_protect(sc);
+  return(new_hash);
+}
+
+static s7_pointer let_append(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer new_let, e = car(args);
+  check_method(sc, e, sc->append_symbol, args);
+  gc_protect_via_stack(sc, args);
+  new_let = make_let(sc, sc->rootlet);
+  set_gc_protected2(sc, new_let);
+  for (s7_pointer p = args; is_pair(p); p = cdr(p))
+    if (!sequence_is_empty(sc, car(p)))
+      s7_copy_1(sc, sc->append_symbol, set_plist_2(sc, car(p), new_let));
+  set_plist_2(sc, sc->nil, sc->nil);
+  unstack_gc_protect(sc);
+  return(new_let);
+}
+
+static s7_pointer g_append(s7_scheme *sc, s7_pointer args)
+{
+  #define H_append "(append ...) returns its argument sequences appended into one sequence"
+  #define Q_append s7_make_circular_signature(sc, 0, 1, sc->T)
+
+  if (is_null(args)) return(sc->nil);         /* (append) -> () */
+  if (is_null(cdr(args))) return(car(args));  /* (append <anything>) -> <anything> */
+  sc->value = args;
+  args = copy_proper_list(sc, args);          /* copied since other args might invoke methods */
+  sc->value = args;
+  switch (type(car(args)))
+    {
+    case T_NIL:        return(g_list_append(sc, cdr(args)));
+    case T_PAIR:       return(g_list_append(sc, args));
+    case T_STRING:     return(g_string_append_1(sc, args, sc->append_symbol));
+      /* should this work in the generic append: (append "12" #\3) -- currently an error, (append (list 1 2) 3) -> '(1 2 . 3), but vector is error */
+    case T_HASH_TABLE: return(hash_table_append(sc, args));
+    case T_LET:        return(let_append(sc, args));
+    case T_VECTOR: case T_INT_VECTOR: case T_FLOAT_VECTOR: case T_BYTE_VECTOR:
+      return(vector_append(sc, args, type(car(args)), sc->append_symbol));
+    default: check_method(sc, car(args), sc->append_symbol, args);
+    }
+  wrong_type_error_nr(sc, sc->append_symbol, 1, car(args), a_sequence_string); /* (append 1 0) */
+  return(NULL);
+}
+
+static s7_pointer append_p_ppp(s7_scheme *sc, s7_pointer p1, s7_pointer p2, s7_pointer p3) {return(g_append(sc, set_plist_3(sc, p1, p2, p3)));}
+
+s7_pointer s7_append(s7_scheme *sc, s7_pointer a, s7_pointer b)
+{
+  if (is_pair(a))
+    {
+      s7_pointer q, p, np, op;
+      if ((!is_pair(b)) && (!is_null(b)))
+	return(g_list_append(sc, list_2(sc, a, b)));
+      q = list_1(sc, car(a));
+      sc->temp8 = q;
+      for (op = a, p = cdr(a), np = q; (is_pair(p)) && (p != op); p = cdr(p), np = cdr(np), op = cdr(op))
+	{
+	  set_cdr(np, list_1_unchecked(sc, car(p))); p = cdr(p); np = cdr(np);
+	  if (!is_pair(p)) break;
+	  set_cdr(np, list_1(sc, car(p)));
+	}
+      if (!is_null(p))
+	wrong_type_error_nr(sc, sc->append_symbol, 1, a, a_proper_list_string);
+      set_cdr(np, b);
+      sc->temp8 = sc->unused;
+      return(q);
+    }
+  if (is_null(a)) return(b);
+  return(g_append(sc, set_plist_2(sc, a, b)));
+}
+
+static s7_pointer g_append_2(s7_scheme *sc, s7_pointer args) {return(s7_append(sc, car(args), cadr(args)));}
+
+static s7_pointer append_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer unused_expr)
+{
+  if (args == 2) return(sc->append_2);
+  return(f);
+}
+
+
+/* -------------------------------- object->let -------------------------------- */
+static s7_pointer byte_vector_to_list(s7_scheme *sc, const uint8_t *str, s7_int len)
+{
+  s7_pointer p;
+  if (len == 0) return(sc->nil);
+  check_free_heap_size(sc, len);
+  sc->w = sc->nil;
+  for (s7_int i = len - 1; i >= 0; i--)
+    sc->w = cons_unchecked(sc, small_int((uint32_t)(str[i])), sc->w);
+  p = sc->w;
+  sc->w = sc->unused;
+  return(p);
+}
+
+static s7_pointer hash_table_to_list(s7_scheme *sc, s7_pointer obj)
+{
+  s7_pointer x, iterator;
+  if (hash_table_entries(obj) <= 0) return(sc->nil);
+  iterator = s7_make_iterator(sc, obj);
+  gc_protect_via_stack(sc, iterator);
+  sc->w = sc->nil;
+  while (true)
+    {
+      x = s7_iterate(sc, iterator);
+      if (iterator_is_at_end(iterator)) break;
+      sc->w = cons(sc, x, sc->w);
+    }
+  x = sc->w;
+  sc->w = sc->unused;
+  unstack_gc_protect(sc);
+  return(x);
+}
+
+static s7_pointer iterator_to_list(s7_scheme *sc, s7_pointer obj)
+{
+  s7_pointer result = sc->nil, p = NULL;
+  s7_int results = 0;
+  while (true)
+    {
+      s7_pointer val = s7_iterate(sc, obj);
+      if ((val == ITERATOR_END) &&
+	  (iterator_is_at_end(obj)))
+	{
+	  if (is_pair(result)) unstack_gc_protect(sc);
+	  return(result);
+	}
+      if (sc->safety > NO_SAFETY)
+	{
+	  results++;
+	  if (results > 10000)
+	    {
+	      s7_warn(sc, 256, "iterator is creating a very long list!\n");
+	      results = S7_INT32_MIN;
+	    }}
+      if (val != sc->no_value)
+	{
+	  if (is_null(result))
+	    {
+	      if (is_multiple_value(val))
+		{
+		  result = multiple_value(val);
+		  clear_multiple_value(val);
+		  for (p = result; is_pair(cdr(p)); p = cdr(p));
+		}
+	      else
+		{
+		  result = list_1(sc, val);
+		  p = result;
+		}
+	      gc_protect_via_stack(sc, result); /* unstacked above */
+	    }
+	  else
+	    if (is_multiple_value(val))
+	      {
+		set_cdr(p, multiple_value(val));
+		clear_multiple_value(val);
+		for (; is_pair(cdr(p)); p = cdr(p));
+	      }
+	    else
+	      {
+		set_cdr(p, list_1(sc, val));
+		p = cdr(p);
+	      }}}
+}
+
+static s7_pointer c_obj_to_list(s7_scheme *sc, s7_pointer obj) /* "c_object_to_list" is the ->list method mentioned below */
+{
+  int64_t len;
+  s7_pointer x, z, zc, result;
+  s7_int gc_z;
+
+  if (c_object_to_list(sc, obj))
+    return((*(c_object_to_list(sc, obj)))(sc, set_plist_1(sc, obj)));
+
+  x = c_object_length(sc, obj);
+  if (!s7_is_integer(x)) return(sc->F);
+  len = s7_integer_clamped_if_gmp(sc, x);
+  if (len < 0)
+    return(sc->F);
+  if (len == 0)
+    return(sc->nil);
+
+  result = make_list(sc, len, sc->nil);
+  sc->temp7 = result;
+  zc = wrapped_integer(sc); /* was make_mutable_integer 17-Nov-23 */
+  z = list_2_unchecked(sc, obj, zc);
+  gc_z = gc_protect_1(sc, z);
+  x = result;
+  for (int64_t i = 0; i < len; i++, x = cdr(x))  /* used to save/restore sc->x|z here */
+    {
+      set_integer(zc, i);
+      set_car(x, (*(c_object_ref(sc, obj)))(sc, z));
+    }
+  s7_gc_unprotect_at(sc, gc_z);
+  sc->temp7 = sc->unused;
+  return(result);
+}
+
+static s7_pointer object_to_list(s7_scheme *sc, s7_pointer obj) /* used only in format_to_port_1 and (map values ...) */
+{
+  switch (type(obj))
+    {
+    case T_STRING:      return(string_to_list(sc, string_value(obj), string_length(obj)));
+    case T_BYTE_VECTOR: return(byte_vector_to_list(sc, byte_vector_bytes(obj), byte_vector_length(obj)));
+    case T_HASH_TABLE:  return(hash_table_to_list(sc, obj));
+    case T_ITERATOR:    return(iterator_to_list(sc, obj));
+    case T_C_OBJECT:    return(c_obj_to_list(sc, obj));
+    case T_INT_VECTOR: case T_FLOAT_VECTOR: case T_VECTOR:
+      return(s7_vector_to_list(sc, obj));
+    case T_LET:
+#if (!WITH_PURE_S7)
+      check_method(sc, obj, sc->let_to_list_symbol, set_plist_1(sc, obj));
+#endif
+      return(s7_let_to_list(sc, obj));
+    }
+  return(obj);
+}
+
+
+/* ---------------- object->let ---------------- */
+static s7_pointer symbol_to_let(s7_scheme *sc, s7_pointer obj)
+{
+  s7_pointer let = internal_inlet(sc, 4, sc->value_symbol, obj,
+				  sc->type_symbol, (is_keyword(obj)) ? sc->is_keyword_symbol :
+				                     ((is_gensym(obj)) ? sc->is_gensym_symbol : sc->is_symbol_symbol));
+  if (!is_keyword(obj))
+    {
+      s7_int gc_loc = gc_protect_1(sc, let);
+      s7_pointer val = s7_symbol_value(sc, obj);
+      if (!sc->current_value_symbol)
+	sc->current_value_symbol = make_symbol(sc, "current-value", 13);
+      s7_varlet(sc, let, sc->current_value_symbol, val);
+      s7_varlet(sc, let, sc->setter_symbol, setter_p_pp(sc, obj, sc->curlet));
+      s7_varlet(sc, let, sc->is_mutable_symbol, make_boolean(sc, !is_immutable_symbol(obj)));
+      if (!is_undefined(val))
+	{
+	  const char *doc = s7_documentation(sc, obj);
+	  if (doc)
+	    s7_varlet(sc, let, sc->local_documentation_symbol, s7_make_string(sc, doc));
+	}
+      s7_gc_unprotect_at(sc, gc_loc);
+    }
+  return(let);
+}
+
+static s7_pointer random_state_to_let(s7_scheme *sc, s7_pointer obj)
+{
+#if WITH_GMP
+  return(internal_inlet(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_random_state_symbol));
+#else
+  if (!sc->seed_symbol)
+    {
+      sc->seed_symbol = make_symbol(sc, "seed", 4);
+      sc->carry_symbol = make_symbol(sc, "carry", 5);
+    }
+  return(internal_inlet(sc, 8, sc->value_symbol, obj,
+			sc->type_symbol, sc->is_random_state_symbol,
+			sc->seed_symbol, make_integer(sc, random_seed(obj)),
+			sc->carry_symbol, make_integer(sc, random_carry(obj))));
+#endif
+}
+
+static s7_pointer vector_to_let(s7_scheme *sc, s7_pointer obj)
+{
+  s7_pointer let;
+  if (!sc->dimensions_symbol) sc->dimensions_symbol = make_symbol(sc, "dimensions", 10);
+  if (!sc->original_vector_symbol) sc->original_vector_symbol = make_symbol(sc, "original-vector", 15);
+  let = internal_inlet(sc, 10, sc->value_symbol, obj,
+		       sc->type_symbol, (is_subvector(obj)) ? cons(sc, sc->is_subvector_symbol, s7_type_of(sc, subvector_vector(obj))) : s7_type_of(sc, obj),
+		       sc->size_symbol, s7_length(sc, obj),
+		       sc->dimensions_symbol, g_vector_dimensions(sc, set_plist_1(sc, obj)),
+		       sc->is_mutable_symbol, make_boolean(sc, !is_immutable_vector(obj)));
+  gc_protect_via_stack(sc, let);
+  if (is_subvector(obj))
+    {
+      s7_int pos = 0;
+      switch (type(obj)) /* correct type matters here: gcc 10.2 with -O2 segfaults otherwise, cast to intptr_t has a similar role in earlier gcc's */
+	{
+	  case T_VECTOR:       pos = (s7_int)((intptr_t)(vector_elements(obj) - vector_elements(subvector_vector(obj))));         break;
+	  case T_INT_VECTOR:   pos = (s7_int)((intptr_t)(int_vector_ints(obj) - int_vector_ints(subvector_vector(obj))));         break;
+	  case T_FLOAT_VECTOR: pos = (s7_int)((intptr_t)(float_vector_floats(obj) - float_vector_floats(subvector_vector(obj)))); break;
+	  case T_BYTE_VECTOR:  pos = (s7_int)((intptr_t)(byte_vector_bytes(obj) - byte_vector_bytes(subvector_vector(obj))));     break;
+	}
+      s7_varlet(sc, let, sc->position_symbol, make_integer(sc, pos));
+      s7_varlet(sc, let, sc->original_vector_symbol, subvector_vector(obj));
+    }
+  if (is_typed_t_vector(obj))
+    s7_varlet(sc, let, sc->signature_symbol, g_signature(sc, set_plist_1(sc, obj)));
+
+#if S7_DEBUGGING
+  if ((is_t_vector(obj)) && (is_symbol_table(obj))) /* (object->let (symbol-table)) */
+    {
+      s7_int max_len = 0, zeros = 0, ones = 0, twos = 0, biggies = 0;
+      for (s7_int i = 0; i < SYMBOL_TABLE_SIZE; i++)
+	{
+	  s7_int j;
+	  s7_pointer p;
+	  for (p = vector_element(sc->symbol_table, i), j = 0; is_pair(p); p = cdr(p), j++);
+	  if (j == 0) zeros++; else
+	    if (j == 1) ones++;  else
+	      if (j == 2) twos++; else
+		biggies++;
+	  if (j > max_len) max_len = j;
+	}
+      s7_varlet(sc, let, make_symbol(sc, "stats:0|1|2|n|max", 17),
+		cons(sc, make_integer(sc, zeros),
+		     cons(sc, make_integer(sc, ones),
+			  cons(sc, make_integer(sc, twos),
+			       cons(sc, make_integer(sc, biggies),
+				    cons(sc, make_integer(sc, max_len), sc->nil))))));
+    }
+#endif
+
+  unstack_gc_protect(sc);
+  return(let);
+}
+
+static void hash_table_checker_to_let(s7_scheme *sc, s7_pointer let, s7_pointer obj)
+{
+  if ((hash_table_checker(obj) == hash_eq) ||
+      (hash_table_checker(obj) == hash_c_function) ||
+      (hash_table_checker(obj) == hash_closure) ||
+      (hash_table_checker(obj) == hash_equal_eq) ||
+      (hash_table_checker(obj) == hash_equal_syntax) ||
+      (hash_table_checker(obj) == hash_symbol))
+    s7_varlet(sc, let, sc->function_symbol, sc->is_eq_symbol);
+  else
+    if (hash_table_checker(obj) == hash_eqv)
+      s7_varlet(sc, let, sc->function_symbol, sc->is_eqv_symbol);
+    else
+      if ((hash_table_checker(obj) == hash_equal) ||
+	  (hash_table_checker(obj) == hash_empty))
+	s7_varlet(sc, let, sc->function_symbol, sc->is_equal_symbol);
+      else
+	if (hash_table_checker(obj) == hash_equivalent)
+	  s7_varlet(sc, let, sc->function_symbol, sc->is_equivalent_symbol);
+	else
+	  if ((hash_table_checker(obj) == hash_number_num_eq) ||
+	      (hash_table_checker(obj) == hash_int) ||
+	      (hash_table_checker(obj) == hash_float))
+	    s7_varlet(sc, let, sc->function_symbol, sc->num_eq_symbol);
+	  else
+	    if (hash_table_checker(obj) == hash_string)
+	      s7_varlet(sc, let, sc->function_symbol, sc->string_eq_symbol);
+	    else
+	      if (hash_table_checker(obj) == hash_char)
+		s7_varlet(sc, let, sc->function_symbol, sc->char_eq_symbol);
+#if (!WITH_PURE_S7)
+	      else
+		if (hash_table_checker(obj) == hash_ci_char)
+		  s7_varlet(sc, let, sc->function_symbol, sc->char_ci_eq_symbol);
+		else
+		  if (hash_table_checker(obj) == hash_ci_string)
+		    s7_varlet(sc, let, sc->function_symbol, sc->string_ci_eq_symbol);
+#endif
+}
+
+static s7_pointer hash_table_to_let(s7_scheme *sc, s7_pointer obj)
+{
+  s7_pointer let;
+  s7_int gc_loc;
+  if (!sc->entries_symbol)
+    {
+      sc->entries_symbol = make_symbol(sc, "entries", 7);
+      sc->weak_symbol = make_symbol(sc, "weak", 4);
+    }
+  let = internal_inlet(sc, 10, sc->value_symbol, obj,
+		       sc->type_symbol, sc->is_hash_table_symbol,
+		       sc->size_symbol, s7_length(sc, obj),
+		       sc->entries_symbol, make_integer(sc, hash_table_entries(obj)),
+		       sc->is_mutable_symbol, make_boolean(sc, !is_immutable_hash_table(obj)));
+  gc_loc = gc_protect_1(sc, let);
+  if (is_weak_hash_table(obj))
+    s7_varlet(sc, let, sc->weak_symbol, sc->T);
+
+  if (is_typed_hash_table(obj))
+    {
+      s7_pointer checker = hash_table_procedures_checker(obj);
+      if (checker == sc->T)  /* perhaps typed because typers were set, but not checker/mapper */
+	hash_table_checker_to_let(sc, let, obj);
+      else s7_varlet(sc, let, sc->function_symbol, list_2(sc, checker, hash_table_procedures_mapper(obj)));
+      s7_varlet(sc, let, sc->signature_symbol,
+	            (is_typed_hash_table(obj)) ?
+		      list_3(sc,
+			     hash_table_typer_symbol(sc, hash_table_value_typer(obj)),
+			     sc->is_hash_table_symbol,
+			     hash_table_typer_symbol(sc, hash_table_key_typer(obj))) :
+ 	              sc->hash_table_signature);
+    }
+  else hash_table_checker_to_let(sc, let, obj);
+
+#if S7_DEBUGGING
+  if (hash_table_entries(obj) > 0)
+    {
+      s7_int max_len = 0, zeros = 0, ones = 0, twos = 0, biggies = 0, hash_len = hash_table_size(obj);
+      for (s7_int i = 0; i < hash_len; i++)
+	{
+	  hash_entry_t *p;
+	  s7_int j;
+	  for (p = hash_table_element(obj, i), j = 0; p; p = hash_entry_next(p), j++);
+	  if (j == 0) zeros++; else
+	    if (j == 1) ones++;  else
+	      if (j == 2) twos++; else
+		biggies++;
+	  if (j > max_len) max_len = j;
+	}
+      s7_varlet(sc, let, make_symbol(sc, "stats:0|1|2|n|max", 17),
+		cons(sc, make_integer(sc, zeros),
+		     cons(sc, make_integer(sc, ones),
+			  cons(sc, make_integer(sc, twos),
+			       cons(sc, make_integer(sc, biggies),
+				    cons(sc, make_integer(sc, max_len), sc->nil))))));
+    }
+#endif
+
+  s7_gc_unprotect_at(sc, gc_loc);
+  return(let);
+}
+
+static s7_pointer iterator_to_let(s7_scheme *sc, s7_pointer obj)
+{
+  s7_pointer let, seq = iterator_sequence(obj);
+  if (!sc->at_end_symbol)
+    {
+      sc->at_end_symbol = make_symbol(sc, "at-end", 6);
+      sc->sequence_symbol = make_symbol(sc, "sequence", 8);
+    }
+  let = internal_inlet(sc, 8, sc->value_symbol, obj,
+		       sc->type_symbol, sc->is_iterator_symbol,
+		       sc->at_end_symbol, make_boolean(sc, iterator_is_at_end(obj)),
+		       sc->sequence_symbol, iterator_sequence(obj));
+  gc_protect_via_stack(sc, let);
+  if (is_pair(seq))
+    s7_varlet(sc, let, sc->size_symbol, s7_length(sc, seq));
+  else
+    if (is_hash_table(seq))
+      s7_varlet(sc, let, sc->size_symbol, make_integer(sc, hash_table_entries(seq)));
+    else s7_varlet(sc, let, sc->size_symbol, s7_length(sc, obj));
+  if ((is_string(seq)) ||
+      (is_any_vector(seq)) ||
+      (seq == sc->rootlet) ||
+      (is_c_object(seq)) ||
+      (is_hash_table(seq)))
+    s7_varlet(sc, let, sc->position_symbol, make_integer(sc, iterator_position(obj)));
+  else
+    if (is_pair(seq))
+      s7_varlet(sc, let, sc->position_symbol, iterator_current(obj));
+  unstack_gc_protect(sc);
+  return(let);
+}
+
+static s7_pointer let_to_let(s7_scheme *sc, s7_pointer obj)
+{
+  /* how to handle setters?
+   *   (display (let ((e (let ((i 0)) (set! (setter 'i) integer?) (curlet)))) (object->let e))):
+   *   "(inlet 'value (inlet 'i 0) 'type let? 'length 1 'open #f 'outlet () 'immutable? #f)"
+   */
+  s7_pointer let;
+  s7_int gc_loc;
+  if (!sc->open_symbol)
+    {
+      sc->open_symbol = make_symbol(sc, "open", 4);
+      sc->alias_symbol = make_symbol(sc, "alias", 5);
+    }
+  let = internal_inlet(sc, 12, sc->value_symbol, obj,
+		       sc->type_symbol, sc->is_let_symbol,
+		       sc->size_symbol, s7_length(sc, obj),
+		       sc->open_symbol, make_boolean(sc, is_openlet(obj)),
+		       sc->outlet_symbol, (obj == sc->rootlet) ? sc->nil : let_outlet(obj),
+		       sc->is_mutable_symbol, make_boolean(sc, !is_immutable_let(obj)));
+  gc_loc = gc_protect_1(sc, let);
+  if (obj == sc->rootlet)
+    s7_varlet(sc, let, sc->alias_symbol, sc->rootlet_symbol);
+  else
+    if (obj == sc->owlet) /* this can't happen, I think -- owlet is always copied first */
+      s7_varlet(sc, let, sc->alias_symbol, sc->owlet_symbol);
+    else
+      if (is_funclet(obj))
+	{
+	  s7_varlet(sc, let, sc->function_symbol, funclet_function(obj));
+	  if ((has_let_file(obj)) &&
+	      (let_file(obj) <= (s7_int)sc->file_names_top) &&
+	      (let_line(obj) > 0) &&
+	      (let_line(obj) < 1000000))
+	    {
+	      s7_varlet(sc, let, sc->file_symbol, sc->file_names[let_file(obj)]);
+	      s7_varlet(sc, let, sc->line_symbol, make_integer(sc, let_line(obj)));
+	    }}
+      else
+	if (obj == sc->s7_starlet)
+	  {
+	    s7_pointer iter = s7_make_iterator(sc, obj);
+	    s7_int gc_loc1 = gc_protect_1(sc, iter);
+	    while (true)
+	      {
+		s7_pointer x = s7_iterate(sc, iter);
+		if (iterator_is_at_end(iter)) break;
+		s7_varlet(sc, let, car(x), cdr(x));
+	      }
+	    s7_gc_unprotect_at(sc, gc_loc1);
+	  }
+  if (has_active_methods(sc, obj))
+    {
+      s7_pointer func = find_method(sc, obj, sc->object_to_let_symbol);
+      if (func != sc->undefined)
+	s7_apply_function(sc, func, set_plist_2(sc, obj, let));
+    }
+  s7_gc_unprotect_at(sc, gc_loc);
+  return(let);
+}
+
+static s7_pointer c_object_to_let(s7_scheme *sc, s7_pointer obj)
+{
+  s7_pointer let, clet = c_object_let(obj);
+  if (!sc->class_symbol)
+    {
+      sc->class_symbol = make_symbol(sc, "class", 5);
+      sc->c_object_let_symbol = make_symbol(sc, "c-object-let", 12);
+    }
+  let = internal_inlet(sc, 10, sc->value_symbol, obj,
+		       sc->type_symbol, sc->is_c_object_symbol,
+		       sc->c_object_type_symbol, make_integer(sc, c_object_type(obj)),
+		       sc->c_object_let_symbol, clet,
+		       sc->class_symbol, c_object_type_to_let(sc, obj));
+  if ((is_let(clet)) &&
+      ((has_active_methods(sc, clet)) || (has_active_methods(sc, obj))))
+    {
+      s7_int gc_loc = gc_protect_1(sc, let);
+      s7_pointer func = find_method(sc, clet, sc->object_to_let_symbol);
+      if (func != sc->undefined)
+	s7_apply_function(sc, func, set_plist_2(sc, obj, let));
+      s7_gc_unprotect_at(sc, gc_loc);
+    }
+  return(let);
+}
+
+static s7_pointer port_to_let(s7_scheme *sc, s7_pointer obj) /* note the underbars! */
+{
+  s7_pointer let;
+  s7_int gc_loc;
+  if (!sc->data_symbol)
+    {
+      sc->data_symbol = make_symbol(sc, "data", 4);
+      sc->port_type_symbol = make_symbol(sc, "port-type", 9);
+      sc->closed_symbol = make_symbol(sc, "closed", 6);
+      sc->file_info_symbol = make_symbol(sc, "file-info", 9);
+    }
+  let = internal_inlet(sc, 10, sc->value_symbol, obj,
+		       /* obj as 'value means it will say "(closed)" when subsequently the let is displayed */
+		       sc->type_symbol, (is_input_port(obj)) ? sc->is_input_port_symbol : sc->is_output_port_symbol,
+		       sc->port_type_symbol, (is_string_port(obj)) ? sc->string_symbol : ((is_file_port(obj)) ? sc->file_symbol : sc->function_symbol),
+		       sc->closed_symbol, make_boolean(sc, port_is_closed(obj)),
+		       sc->is_mutable_symbol, make_boolean(sc, !is_immutable_port(obj)));
+  gc_loc = gc_protect_1(sc, let);
+  if (is_file_port(obj))
+    {
+      s7_varlet(sc, let, sc->file_symbol, g_port_filename(sc, set_plist_1(sc, obj)));
+      if (is_input_port(obj))
+	s7_varlet(sc, let, sc->line_symbol, g_port_line_number(sc, set_plist_1(sc, obj)));
+#if (!MS_WINDOWS)
+      if ((!port_is_closed(obj)) && (obj != sc->standard_error) && (obj != sc->standard_input) && (obj != sc->standard_output))
+	{
+	  struct stat sb;
+	  s7_varlet(sc, let, sc->file_symbol, make_integer(sc, fileno(port_file(obj))));
+	  if (fstat(fileno(port_file(obj)), &sb) != -1)
+	    {
+	      char c1[64], c2[64], str[512];
+	      int32_t bytes;
+	      strftime(c1, 64, "%a %d-%b-%Y %H:%M", localtime(&sb.st_atime));
+	      strftime(c2, 64, "%a %d-%b-%Y %H:%M", localtime(&sb.st_mtime));
+	      bytes = snprintf(str, 512, "mode: #o%u, links: %ld, owner uid: %d gid: %d, size: %ld bytes, last file access: %s, last file modification: %s",
+			       sb.st_mode,
+			       (long)sb.st_nlink,
+			       (int)sb.st_uid, (int)sb.st_gid,
+			       (long)sb.st_size,
+			       c1, c2);
+	      s7_varlet(sc, let, sc->file_info_symbol, make_string_with_length(sc, (const char *)str, bytes));
+	    }}
+#endif
+    }
+  if ((is_string_port(obj)) && /* file port might not have a data buffer */
+      (port_data(obj)) &&
+      (port_data_size(obj) > 0))
+    {
+      s7_varlet(sc, let, sc->size_symbol, make_integer(sc, port_data_size(obj)));
+      s7_varlet(sc, let, sc->position_symbol, make_integer(sc, port_position(obj)));
+      /* I think port_data need not be null-terminated, but s7_make_string assumes it is:
+       *   both valgrind and lib*san complain about the uninitialized data during strlen.
+       */
+      s7_varlet(sc, let, sc->data_symbol,
+		make_string_with_length(sc, (const char *)port_data(obj), ((port_position(obj)) > 16) ? 16 : port_position(obj))); /* sc->print_length? */
+    }
+  if (is_function_port(obj))
+    s7_varlet(sc, let, sc->function_symbol, port_string_or_function(obj));
+  s7_gc_unprotect_at(sc, gc_loc);
+  return(let);
+}
+
+static s7_pointer closure_to_let(s7_scheme *sc, s7_pointer obj)
+{
+  const char *doc = s7_documentation(sc, obj);
+  s7_pointer sig = s7_signature(sc, obj);
+  s7_pointer let = internal_inlet(sc, 8, sc->value_symbol, obj,
+				  sc->type_symbol, (is_t_procedure(obj)) ? sc->is_procedure_symbol : sc->is_macro_symbol,
+				  sc->arity_symbol, s7_arity(sc, obj),
+				  sc->is_mutable_symbol, make_boolean(sc, !is_immutable(obj)));
+  gc_protect_via_stack(sc, let);
+  if (is_pair(sig))
+    s7_varlet(sc, let, sc->local_signature_symbol, sig);
+  if (doc)
+    s7_varlet(sc, let, sc->local_documentation_symbol, s7_make_string(sc, doc));
+
+  if (is_let(closure_let(obj)))
+    {
+      s7_pointer flet = closure_let(obj);
+      if ((has_let_file(flet)) &&
+	  (let_file(flet) <= (s7_int)sc->file_names_top) &&
+	  (let_line(flet) > 0))
+	{
+	  s7_varlet(sc, let, sc->file_symbol, sc->file_names[let_file(flet)]);
+	  s7_varlet(sc, let, sc->line_symbol, make_integer(sc, let_line(flet)));
+	}}
+
+  if (closure_setter(obj) != sc->F)
+    s7_varlet(sc, let, sc->local_setter_symbol, closure_setter(obj));
+
+  if (!sc->source_symbol)
+    sc->source_symbol = make_symbol(sc, "source", 6);
+  s7_varlet(sc, let, sc->source_symbol,
+	    append_in_place(sc, list_2(sc, procedure_type_to_symbol(sc, type(obj)), closure_args(obj)),
+			    closure_body(obj)));
+  unstack_gc_protect(sc);
+  return(let);
+}
+
+static s7_pointer c_pointer_to_let(s7_scheme *sc, s7_pointer obj)
+{
+  /* c_pointer_info can be a let and might have an object->let method (see c_object below) */
+  if (!sc->c_type_symbol)
+    {
+      sc->c_type_symbol = make_symbol(sc, "c-type", 6);
+      sc->info_symbol = make_symbol(sc, "info", 4);
+    }
+  if (!sc->pointer_symbol) sc->pointer_symbol = make_symbol(sc, "pointer", 7);
+  return(internal_inlet(sc, 10, sc->value_symbol, obj,
+			sc->type_symbol, sc->is_c_pointer_symbol,
+			sc->pointer_symbol, make_integer(sc, (s7_int)((intptr_t)c_pointer(obj))),
+			sc->c_type_symbol, c_pointer_type(obj),
+			sc->info_symbol, c_pointer_info(obj)));
+}
+
+static s7_pointer c_function_to_let(s7_scheme *sc, s7_pointer obj)
+{
+  const char *doc = s7_documentation(sc, obj);
+  s7_pointer sig = c_function_signature(obj);
+  s7_pointer let = internal_inlet(sc, 8, sc->value_symbol, obj,
+				  sc->type_symbol, (is_t_procedure(obj)) ? sc->is_procedure_symbol : sc->is_macro_symbol,
+				  sc->arity_symbol, s7_arity(sc, obj),
+				  sc->is_mutable_symbol, make_boolean(sc, !is_immutable(obj)));
+  gc_protect_via_stack(sc, let);
+  if (is_pair(sig))
+    s7_varlet(sc, let, sc->local_signature_symbol, sig);
+  if (doc)
+    s7_varlet(sc, let, sc->local_documentation_symbol, s7_make_string(sc, doc));
+
+  if (c_function_setter(obj) != sc->F) /* c_macro_setter is the same underlying field */
+    s7_varlet(sc, let, sc->local_setter_symbol, c_function_setter(obj));
+  unstack_gc_protect(sc);
+  return(let);
+}
+
+static s7_pointer goto_to_let(s7_scheme *sc, s7_pointer obj)
+{
+  /* there's room in s7_cell to store the procedure, but we would have to mark it (goto escapes, context GC'd) */
+  if (!sc->active_symbol)
+    sc->active_symbol = make_symbol(sc, "active", 6);
+  if (is_symbol(call_exit_name(obj)))
+    return(internal_inlet(sc, 8, sc->value_symbol, obj, sc->type_symbol, sc->is_goto_symbol,
+			  sc->active_symbol, make_boolean(sc, call_exit_active(obj)),
+			  sc->name_symbol, call_exit_name(obj)));
+  return(internal_inlet(sc, 6, sc->value_symbol, obj, sc->type_symbol, sc->is_goto_symbol,
+			sc->active_symbol, make_boolean(sc, call_exit_active(obj))));
+}
+
+static s7_pointer object_to_let_p_p(s7_scheme *sc, s7_pointer obj)
+{
+  switch (type(obj))
+    {
+    case T_NIL:          return(internal_inlet(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_null_symbol));
+    case T_UNSPECIFIED:  return(internal_inlet(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_unspecified_symbol));
+    case T_UNDEFINED:    return(internal_inlet(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_undefined_symbol));
+    case T_EOF:          return(internal_inlet(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_eof_object_symbol));
+    case T_BOOLEAN:      return(internal_inlet(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_boolean_symbol));
+    case T_CHARACTER:    return(internal_inlet(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_char_symbol));
+    case T_SYMBOL:       return(symbol_to_let(sc, obj));
+    case T_RANDOM_STATE: return(random_state_to_let(sc, obj));
+    case T_GOTO:         return(goto_to_let(sc, obj));
+    case T_C_POINTER:    return(c_pointer_to_let(sc, obj));
+    case T_ITERATOR:     return(iterator_to_let(sc, obj));
+    case T_HASH_TABLE:   return(hash_table_to_let(sc, obj));
+    case T_LET:          return(let_to_let(sc, obj));
+    case T_C_OBJECT:     return(c_object_to_let(sc, obj));
+
+    case T_INTEGER: case T_BIG_INTEGER: return(internal_inlet(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_integer_symbol));
+    case T_RATIO:   case T_BIG_RATIO:   return(internal_inlet(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_rational_symbol));
+    case T_REAL:    case T_BIG_REAL:    return(internal_inlet(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_real_symbol));
+    case T_COMPLEX: case T_BIG_COMPLEX: return(internal_inlet(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_complex_symbol));
+
+    case T_STRING:
+      return(internal_inlet(sc, 8, sc->value_symbol, obj,
+			    sc->type_symbol, sc->is_string_symbol,
+			    sc->size_symbol, str_length(sc, obj),
+			    sc->is_mutable_symbol, make_boolean(sc, !is_immutable_string(obj))));
+    case T_PAIR:
+      return(internal_inlet(sc, 6, sc->value_symbol, obj,
+			    sc->type_symbol, sc->is_pair_symbol,
+			    sc->size_symbol, pair_length(sc, obj)));
+    case T_SYNTAX:
+      return(internal_inlet(sc, 6, sc->value_symbol, obj,
+			    sc->type_symbol, sc->is_syntax_symbol,
+			    sc->documentation_symbol, s7_make_string(sc, syntax_documentation(obj))));
+
+    case T_INT_VECTOR: case T_FLOAT_VECTOR: case T_BYTE_VECTOR: case T_VECTOR:
+      return(vector_to_let(sc, obj));
+
+    case T_CONTINUATION:  /* perhaps include the continuation-key */
+      if (is_symbol(continuation_name(obj)))
+	return(internal_inlet(sc, 6, sc->value_symbol, obj, sc->type_symbol, sc->is_continuation_symbol, sc->name_symbol, continuation_name(obj)));
+      return(internal_inlet(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_continuation_symbol));
+
+    case T_INPUT_PORT: case T_OUTPUT_PORT:
+      return(port_to_let(sc, obj));
+
+    case T_CLOSURE: case T_CLOSURE_STAR: case T_MACRO: case T_MACRO_STAR: case T_BACRO: case T_BACRO_STAR:
+      return(closure_to_let(sc, obj));
+
+    case T_C_MACRO: case T_C_FUNCTION_STAR:
+    case T_C_FUNCTION: case T_C_RST_NO_REQ_FUNCTION:
+      return(c_function_to_let(sc, obj));
+
+    default:
+      return(sc->F);
+    }
+  return(sc->F);
+}
+
+static s7_pointer g_object_to_let(s7_scheme *sc, s7_pointer args)
+{
+  #define H_object_to_let "(object->let obj) returns a let (namespace) describing obj."
+  #define Q_object_to_let s7_make_signature(sc, 2, sc->is_let_symbol, sc->T)
+  return(object_to_let_p_p(sc, car(args)));
+}
+
+
+/* ---------------- stacktrace ---------------- */
+static s7_pointer stacktrace_find_caller(s7_scheme *sc, s7_pointer e)
+{
+  if ((is_let(e)) && (e != sc->rootlet))
+    return(((is_funclet(e)) || (is_maclet(e))) ? funclet_function(e) : stacktrace_find_caller(sc, let_outlet(e)));
+  return(sc->F);
+}
+
+static bool stacktrace_find_let(s7_scheme *sc, int64_t loc, s7_pointer e)
+{
+  return((loc > 0) &&
+	 ((stack_let(sc->stack, loc) == e) ||
+	  (stacktrace_find_let(sc, loc - 4, e))));
+}
+
+static int64_t stacktrace_find_error_hook_quit(s7_scheme *sc)
+{
+  for (int64_t i = stack_top(sc) - 1; i >= 3; i -= 4)
+    if (stack_op(sc->stack, i) == OP_ERROR_HOOK_QUIT)
+      return(i);
+  return(-1);
+}
+
+static bool stacktrace_in_error_handler(s7_scheme *sc, int64_t loc)
+{
+  return((let_outlet(sc->owlet) == sc->curlet) ||
+	 (stacktrace_find_let(sc, loc * 4, let_outlet(sc->owlet))) ||
+	 (stacktrace_find_error_hook_quit(sc) > 0));
+}
+
+static bool stacktrace_error_hook_function(s7_scheme *sc, s7_pointer sym)
+{
+  if (is_symbol(sym))
+    {
+      s7_pointer f = s7_symbol_value(sc, sym);
+      return((is_procedure(f)) &&
+	     (hook_has_functions(sc->error_hook)) &&
+	     (direct_memq(f, s7_hook_functions(sc, sc->error_hook))));
+    }
+  return(false);
+}
+
+static char *stacktrace_walker(s7_scheme *sc, s7_pointer code, s7_pointer e, char *notes,
+			       s7_int code_cols, s7_int total_cols, s7_int notes_start_col,
+			       bool as_comment, int32_t depth)
+{
+  if (is_symbol(code))
+    {
+      if ((!symbol_is_in_list(sc, code)) &&
+	  (!is_slot(global_slot(code))))
+	{
+	  s7_pointer val;
+	  add_symbol_to_list(sc, code);
+	  val = s7_symbol_local_value(sc, code, e);
+	  if ((val) &&
+	      (val != sc->undefined) &&
+	      (!is_any_macro(val)))
+	    {
+	      int32_t typ = type(val);
+	      if (typ < T_CONTINUATION)
+		{
+		  char *objstr, *str;
+		  s7_pointer objp;
+		  s7_int new_note_len, notes_max;
+		  bool new_notes_line = false, old_short_print = sc->short_print;
+		  s7_int old_len = sc->print_length, objlen;
+
+		  if (notes_start_col < 0) notes_start_col = 50;
+		  if (notes_start_col > total_cols) notes_start_col = 0;
+		  notes_max = total_cols - notes_start_col;
+		  sc->short_print = true;
+		  if (sc->print_length > 4) sc->print_length = 4;
+		  objp = s7_object_to_string(sc, val, true);
+		  objstr = string_value(objp);
+		  objlen = string_length(objp);
+		  if ((objlen > notes_max) &&
+		      (notes_max > 5))
+		    {
+		      objstr[notes_max - 4] = '.';
+		      objstr[notes_max - 3] = '.';
+		      objstr[notes_max - 2] = '.';
+		      objstr[notes_max - 1] = '\0';
+		      objlen = notes_max;
+		    }
+		  sc->short_print = old_short_print;
+		  sc->print_length = old_len;
+
+		  new_note_len = symbol_name_length(code) + 3 + objlen;
+		  /* we want to append this much info to the notes, but does it need a new line? */
+		  if (notes_start_col < code_cols)
+		    new_notes_line = true;
+		  else
+		    if (notes)
+		      {
+			char *last_newline = strrchr(notes, (int)'\n'); /* returns ptr to end if none = nil if not found? */
+			s7_int cur_line_len = (last_newline) ? (strlen(notes) - strlen(last_newline)) : strlen(notes);
+			new_notes_line = ((cur_line_len + new_note_len) > notes_max);
+		      }
+		  if (new_notes_line)
+		    {
+		      const char *spaces = "                                                                                ";
+		      s7_int spaces_len = 80;
+		      new_note_len += (4 + notes_start_col + ((notes) ? strlen(notes) : 0));
+		      str = (char *)Malloc(new_note_len);   /* str[0] = '\0'; */
+		      catstrs_direct(str,
+			      (notes) ? notes : "",
+			      "\n",
+			      (as_comment) ? "; " : "",
+			      (spaces_len >= notes_start_col) ? (const char *)(spaces + spaces_len - notes_start_col) : "",
+			      (as_comment) ? "" : " ; ",
+			      symbol_name(code),
+			      ": ",
+			      objstr, (const char *)NULL);
+		    }
+		  else
+		    {
+		      new_note_len += ((notes) ? strlen(notes) : 0) + 4;
+		      str = (char *)Malloc(new_note_len);   /* str[0] = '\0'; */
+		      catstrs_direct(str,
+			      (notes) ? notes : "",
+			      (notes) ? ", " : " ; ",
+			      symbol_name(code),
+			      ": ",
+			      objstr, (const char *)NULL);
+		    }
+		  if (notes) free(notes);
+		  return(str);
+		}}}
+      return(notes);
+    }
+  if ((is_pair(code)) &&
+      (s7_list_length(sc, code) > 0) &&
+      (depth < 32))
+    {
+      notes = stacktrace_walker(sc, car(code), e, notes, code_cols, total_cols, notes_start_col, as_comment, depth + 1);
+      return(stacktrace_walker(sc, cdr(code), e, notes, code_cols, total_cols, notes_start_col, as_comment, depth + 2));
+    }
+  return(notes);
+}
+
+static block_t *stacktrace_add_func(s7_scheme *sc, s7_pointer f, s7_pointer code, const char *errstr, char *notes, s7_int code_max, bool as_comment)
+{
+  s7_int newlen, errlen = strlen(errstr);
+  char *newstr, *str;
+  block_t *newp, *b;
+  if ((is_symbol(f)) &&
+      (f != car(code)))
+    {
+      newlen = symbol_name_length(f) + errlen + 10;
+      newp = mallocate(sc, newlen);
+      newstr = (char *)block_data(newp);      /* newstr[0] = '\0'; */
+      errlen = catstrs_direct(newstr, symbol_name(f), ": ", errstr, (const char *)NULL);
+    }
+  else
+    {
+      newlen = errlen + 8;
+      newp = mallocate(sc, newlen);
+      newstr = (char *)block_data(newp);      /* newstr[0] = '\0'; */
+      if ((errlen > 2) && (errstr[2] == '('))
+        errlen = catstrs_direct(newstr, "  ", errstr, (const char *)NULL);
+      else
+	{
+	  memcpy((void *)newstr, (const void *)errstr, errlen);
+	  newstr[errlen] = '\0';
+	}}
+  newlen = code_max + 8 + ((notes) ? strlen(notes) : 0);
+  b = mallocate(sc, newlen);
+  str = (char *)block_data(b);                /* str[0] = '\0'; */
+
+  if (errlen >= code_max)
+    {
+      newstr[code_max - 4] = '.';
+      newstr[code_max - 3] = '.';
+      newstr[code_max - 2] = '.';
+      newstr[code_max - 1] = '\0';
+      catstrs_direct(str, (as_comment) ? "; " : "", newstr, (notes) ? notes : "", "\n", (const char *)NULL);
+    }
+  else
+    {
+      /* send out newstr, pad with spaces to code_max, then notes */
+      s7_int len = catstrs_direct(str, (as_comment) ? "; " : "", newstr, (const char *)NULL);
+      if (notes)
+	{
+	  s7_int i;
+	  for (i = len; i < code_max - 1; i++) str[i] = ' ';
+	  str[i] = '\0';
+	  catstrs(str, newlen, notes, "\n", (char *)NULL);
+	}
+      else catstrs(str, newlen, "\n", (char *)NULL);
+    }
+  liberate(sc, newp);
+  return(b);
+}
+
+static s7_pointer stacktrace_1(s7_scheme *sc, s7_int frames_max, s7_int code_cols, s7_int total_cols, s7_int notes_start_col, bool as_comment)
+{
+  char *str = NULL;
+  block_t *strp = NULL;
+  int64_t loc, frames = 0;
+  int64_t top = (sc->stack_end - sc->stack_start) / 4; /* (*s7* 'stack_top), not stack_top(sc)! */
+  clear_symbol_list(sc);
+
+  if (stacktrace_in_error_handler(sc, top))
+    {
+      s7_pointer err_code = slot_value(sc->error_code);
+      if ((is_pair(err_code)) &&
+	  (!tree_is_cyclic(sc, err_code)))
+	{
+	  char *notes = NULL;
+	  s7_pointer current_let = let_outlet(sc->owlet);
+	  s7_pointer errstr = s7_object_to_string(sc, err_code, false);
+	  s7_pointer f = stacktrace_find_caller(sc, current_let); /* this is a symbol */
+	  if ((is_let(current_let)) &&
+	      (current_let != sc->rootlet))
+	    notes = stacktrace_walker(sc, err_code, current_let, NULL, code_cols, total_cols, notes_start_col, as_comment, 0);
+	  strp = stacktrace_add_func(sc, f, err_code, string_value(errstr), notes, code_cols, as_comment);
+	  str = (char *)block_data(strp);
+	  if ((S7_DEBUGGING) && (notes == str)) fprintf(stderr, "%s[%d]: notes==str\n", __func__, __LINE__);
+	  if (notes) free(notes); /* copied into strp, 29-Sep-23 -- see below: maybe check that notes!=str? */
+	}
+      loc = stacktrace_find_error_hook_quit(sc); /* if OP_ERROR_HOOK_QUIT is in the stack, jump past it! */
+      if (loc > 0) top = (loc + 1) / 4;
+    }
+  for (loc = top - 1; loc > 0; loc--)
+    {
+      s7_int true_loc = (loc + 1) * 4 - 1;
+      s7_pointer code = stack_code(sc->stack, true_loc);
+      if ((is_pair(code)) &&
+	  (!tree_is_cyclic(sc, code)))
+	{
+	  s7_pointer codep = s7_object_to_string(sc, code, false);
+	  if (string_length(codep) > 0)
+	    {
+	      char *codestr = string_value(codep);
+	      if ((!local_strcmp(codestr, "(result)")) &&
+		  (!local_strcmp(codestr, "(#f)")) &&
+		  (!strstr(codestr, "(stacktrace)")) &&
+		  (!strstr(codestr, "(stacktrace ")))
+		{
+		  s7_pointer e = stack_let(sc->stack, true_loc); /* might not be let (gc stack protection etc) */
+		  s7_pointer f = stacktrace_find_caller(sc, e);
+		  if (!stacktrace_error_hook_function(sc, f))
+		    {
+		      char *notes = NULL, *newstr, *catstr;
+		      block_t *newp, *catp;
+		      s7_int newlen;
+
+		      frames++;
+		      if (frames > frames_max)
+			return(block_to_string(sc, strp, safe_strlen((char *)block_data(strp))));
+
+		      if ((is_let(e)) && (e != sc->rootlet))
+			notes = stacktrace_walker(sc, code, e, NULL, code_cols, total_cols, notes_start_col, as_comment, 0);
+		      newp = stacktrace_add_func(sc, f, code, codestr, notes, code_cols, as_comment);
+		      newstr = (char *)block_data(newp);
+		      if ((S7_DEBUGGING) && (notes == newstr)) fprintf(stderr, "%s[%d]: notes=newstr\n", __func__, __LINE__);
+		      if ((notes) && (notes != newstr) && (is_let(e)) && (e != sc->rootlet))
+			free(notes);
+
+		      newlen = strlen(newstr) + 1 + ((str) ? strlen(str) : 0);
+		      catp = mallocate(sc, newlen);
+		      catstr = (char *)block_data(catp);
+		      catstrs_direct(catstr, (str) ? str : "", newstr, (const char *)NULL);
+		      liberate(sc, newp);
+		      if (strp) liberate(sc, strp);
+		      strp = catp;
+		      str = (char *)block_data(strp);
+		    }}}}}
+  return((strp) ? block_to_string(sc, strp, safe_strlen((char *)block_data(strp))) : nil_string);
+}
+
+s7_pointer s7_stacktrace(s7_scheme *sc)
+{
+  return(stacktrace_1(sc,
+		      s7_integer_clamped_if_gmp(sc, car(sc->stacktrace_defaults)),
+		      s7_integer_clamped_if_gmp(sc, cadr(sc->stacktrace_defaults)),
+		      s7_integer_clamped_if_gmp(sc, caddr(sc->stacktrace_defaults)),
+		      s7_integer_clamped_if_gmp(sc, cadddr(sc->stacktrace_defaults)),
+		      s7_boolean(sc, s7_list_ref(sc, sc->stacktrace_defaults, 4))));
+}
+
+static s7_pointer g_stacktrace(s7_scheme *sc, s7_pointer args)
+{
+  #define H_stacktrace "(stacktrace (max-frames 30) (code-cols 50) (total-cols 80) (note-col 50) as-comment) returns \
+a stacktrace as a string.  Each line has two portions, the code being evaluated and a note giving \
+the value of local variables in that code.  The first argument sets how many lines are displayed. \
+The next three arguments set the length and layout of those lines.  'as-comment' if #t causes each \
+line to be preceded by a semicolon."
+  #define Q_stacktrace s7_make_signature(sc, 6, \
+                         sc->is_string_symbol, sc->is_integer_symbol, sc->is_integer_symbol, \
+                         sc->is_integer_symbol, sc->is_integer_symbol, sc->is_boolean_symbol)
+
+  s7_int max_frames = 30, code_cols = 50, total_cols = 80, notes_start_col = 50;
+  bool as_comment = false;
+
+  if (!is_null(args))
+    {
+      if (!s7_is_integer(car(args)))
+	return(method_or_bust(sc, car(args), sc->stacktrace_symbol, args, sc->type_names[T_INTEGER], 1));
+      max_frames = s7_integer_clamped_if_gmp(sc, car(args));
+      if ((max_frames <= 0) || (max_frames > S7_INT32_MAX))
+	max_frames = 30;
+      args = cdr(args);
+      if (!is_null(args))
+	{
+	  if (!s7_is_integer(car(args)))
+	    wrong_type_error_nr(sc, sc->stacktrace_symbol, 2, car(args), sc->type_names[T_INTEGER]);
+	  code_cols = s7_integer_clamped_if_gmp(sc, car(args));
+	  if ((code_cols <= 8) || (code_cols > 1024))
+	    code_cols = 50;
+	  args = cdr(args);
+	  if (!is_null(args))
+	    {
+	      if (!s7_is_integer(car(args)))
+		wrong_type_error_nr(sc, sc->stacktrace_symbol, 3, car(args), sc->type_names[T_INTEGER]);
+	      total_cols = s7_integer_clamped_if_gmp(sc, car(args));
+	      if ((total_cols <= code_cols) || (total_cols > S7_INT32_MAX))
+		total_cols = 80;
+	      args = cdr(args);
+	      if (!is_null(args))
+		{
+		  if (!s7_is_integer(car(args)))
+		    wrong_type_error_nr(sc, sc->stacktrace_symbol, 4, car(args), sc->type_names[T_INTEGER]);
+		  notes_start_col = s7_integer_clamped_if_gmp(sc, car(args));
+		  if ((notes_start_col <= 0) || (notes_start_col > S7_INT32_MAX))
+		    notes_start_col = 50;
+		  args = cdr(args);
+		  if (!is_null(args))
+		    {
+		      if (!is_boolean(car(args)))
+			wrong_type_error_nr(sc, sc->stacktrace_symbol, 5, car(args), sc->type_names[T_BOOLEAN]);
+		      as_comment = s7_boolean(sc, car(args));
+		    }}}}}
+  return(stacktrace_1(sc, max_frames, code_cols, total_cols, notes_start_col, as_comment));
+}
+
+
+/* -------- s7_history, s7_add_to_history, s7_history_enabled -------- */
+
+s7_pointer s7_add_to_history(s7_scheme *sc, s7_pointer entry)
+{
+#if WITH_HISTORY
+  set_current_code(sc, entry);
+#endif
+  return(entry);
+}
+
+s7_pointer s7_history(s7_scheme *sc)
+{
+#if WITH_HISTORY
+  if (sc->cur_code == sc->history_sink)
+    return(sc->old_cur_code);
+#endif
+  return(sc->cur_code);
+}
+
+bool s7_history_enabled(s7_scheme *sc)
+{
+#if WITH_HISTORY
+  return(sc->cur_code != sc->history_sink);
+#else
+  return(false);
+#endif
+}
+
+bool s7_set_history_enabled(s7_scheme *sc, bool enabled)
+{
+#if WITH_HISTORY
+  bool old_enabled = (sc->cur_code == sc->history_sink);
+  if (enabled) /* this needs to restore the old cur_code (saving its position in the history_buffer) */
+    sc->cur_code = sc->old_cur_code;
+  else
+    if (sc->cur_code != sc->history_sink)
+      {
+	sc->old_cur_code = sc->cur_code;
+	sc->cur_code = sc->history_sink;
+      }
+  return(old_enabled);
+#else
+  return(false);
+#endif
+}
+
+#if WITH_HISTORY
+static s7_pointer history_cons(s7_scheme *sc, s7_pointer code, s7_pointer args)
+{
+  s7_pointer p = car(sc->history_pairs);
+  sc->history_pairs = cdr(sc->history_pairs);
+  set_car(p, code);
+  unchecked_set_cdr(p, args);
+  return(p);
+}
+#else
+#define history_cons(Sc, Code, Args) Code
+#endif
+
+
+/* -------------------------------- profile -------------------------------- */
+static void swap_stack(s7_scheme *sc, opcode_t new_op, s7_pointer new_code, s7_pointer new_args)
+{
+  s7_pointer code, args, e;
+  opcode_t op;
+
+  sc->stack_end -= 4;
+  code = stack_end_code(sc);
+  e = stack_end_let(sc);
+  args = stack_end_args(sc);
+  op = (opcode_t)T_Op(stack_end_op(sc)); /* this should be begin1 */
+  if ((S7_DEBUGGING) && (op != OP_BEGIN_NO_HOOK) && (op != OP_BEGIN_HOOK))
+    fprintf(stderr, "swap %s in %s\n", op_names[op], display(s7_name_to_value(sc, "estr")));
+  push_stack(sc, new_op, new_args, new_code);
+  stack_end_code(sc) = code;
+  stack_end_let(sc) = e;
+  stack_end_args(sc) = args;
+  stack_end_op(sc) = (s7_pointer)op;
+  sc->stack_end += 4;
+}
+
+static s7_pointer find_funclet(s7_scheme *sc, s7_pointer e)
+{
+  if ((e == sc->rootlet) || (!is_let(e))) return(sc->F);
+  if (!((is_funclet(e)) || (is_maclet(e)))) e = let_outlet(e);
+  if ((e == sc->rootlet) || (!is_let(e))) return(sc->F);
+  return(((is_funclet(e)) || (is_maclet(e))) ? e : sc->F);
+}
+
+#define PD_INITIAL_SIZE 16
+enum {PD_CALLS = 0, PD_RECUR, PD_START, PD_ITOTAL, PD_ETOTAL, PD_BLOCK_SIZE};
+
+static s7_pointer g_profile_out(s7_scheme *sc, s7_pointer args)
+{
+  s7_int pos = integer(car(args)) * PD_BLOCK_SIZE;
+  profile_data_t *pd = sc->profile_data;
+  s7_int *v = (s7_int *)(pd->timing_data + pos);
+  v[PD_RECUR]--;
+  if (v[PD_RECUR] == 0)
+    {
+      s7_int cur_time = (my_clock() - v[PD_START]);
+      v[PD_ITOTAL] += cur_time;
+      v[PD_ETOTAL] += (cur_time - pd->excl[pd->excl_top]);
+      pd->excl_top--;
+      pd->excl[pd->excl_top] += cur_time;
+    }
+  return(sc->F);
+}
+
+static s7_pointer g_profile_in(s7_scheme *sc, s7_pointer args) /* only external func -- added to each profiled func by add_profile above */
+{
+  #define H_profile_in "(profile-in e) is the profiler's hook into closures"
+  #define Q_profile_in s7_make_signature(sc, 3, sc->T, sc->is_integer_symbol, sc->is_let_symbol)
+
+  s7_pointer e;
+  s7_int pos;
+  if (sc->profile == 0) return(sc-> F);
+
+  pos = integer(car(args));
+  e = find_funclet(sc, cadr(args));
+
+  if ((is_let(e)) &&
+      (is_symbol(funclet_function(e))))
+    {
+      s7_pointer func_name = funclet_function(e);
+      s7_int *v;
+      profile_data_t *pd = sc->profile_data;
+
+      if (pos >= pd->size)
+	{
+	  s7_int new_size = 2 * pos;
+	  pd->funcs = (s7_pointer *)Realloc(pd->funcs, new_size * sizeof(s7_pointer));
+	  memclr((void *)(pd->funcs + pd->size), (new_size - pd->size) * sizeof(s7_pointer));
+	  pd->timing_data = (s7_int *)Realloc(pd->timing_data, new_size * PD_BLOCK_SIZE * sizeof(s7_int));
+          memclr((void *)(pd->timing_data + (pd->size * PD_BLOCK_SIZE)), (new_size - pd->size) * PD_BLOCK_SIZE * sizeof(s7_int));
+	  pd->let_names = (s7_pointer *)Realloc(pd->let_names, new_size * sizeof(s7_pointer));
+	  memclr((void *)(pd->let_names + pd->size), (new_size - pd->size) * sizeof(s7_pointer));
+	  pd->files = (s7_pointer *)Realloc(pd->files, new_size * sizeof(s7_pointer));
+	  memclr((void *)(pd->files + pd->size), (new_size - pd->size) * sizeof(s7_pointer));
+	  pd->lines = (s7_int *)Realloc(pd->lines, new_size * sizeof(s7_int));
+	  memclr((void *)(pd->lines + pd->size), (new_size - pd->size) * sizeof(s7_int));
+	  pd->size = new_size;
+	}
+      if (pd->funcs[pos] == NULL)
+	{
+	  pd->funcs[pos] = func_name;
+	  if (is_gensym(func_name)) sc->profiling_gensyms = true;
+	  if (pos >= pd->top) pd->top = (pos + 1);
+
+	  /* perhaps add_profile needs to reuse ints if file/line exists? */
+	  if (is_symbol(sc->profile_prefix))
+	    {
+	      s7_pointer let_name = s7_symbol_local_value(sc, sc->profile_prefix, e);
+	      if (is_symbol(let_name)) pd->let_names[pos] = let_name;
+	    }
+	  if (has_let_file(e))
+	    {
+	      pd->files[pos] = sc->file_names[let_file(e)];
+	      pd->lines[pos] = let_line(e);
+	    }}
+      v = (s7_int *)(sc->profile_data->timing_data + (pos * PD_BLOCK_SIZE));
+      v[PD_CALLS]++;
+      if (v[PD_RECUR] == 0)
+	{
+	  v[PD_START] = my_clock();
+	  pd->excl_top++;
+	  if (pd->excl_top == pd->excl_size)
+	    {
+	      pd->excl_size *= 2;
+	      pd->excl = (s7_int *)Realloc(pd->excl, pd->excl_size * sizeof(s7_int));
+	    }
+	  pd->excl[pd->excl_top] = 0;
+	}
+      v[PD_RECUR]++;
+
+      /* this doesn't work in "continuation passing" code (e.g. cpstak.scm in the so-called standard benchmarks).
+       *   swap_stack pushes dynamic_unwind, but we don't pop back to it, so the stack grows to the recursion depth.
+       */
+      if (sc->stack_end >= sc->stack_resize_trigger)
+	{
+	  #define PROFILE_MAX_STACK_SIZE 10000000  /* around 5G counting lets/arglists/slots, maybe an *s7* field for this? */
+	  if (sc->stack_size > PROFILE_MAX_STACK_SIZE)
+	    error_nr(sc, make_symbol(sc, "stack-too-big", 13),
+		     set_elist_2(sc, wrap_string(sc, "profiling stack size has grown past ~D", 38), wrap_integer(sc, PROFILE_MAX_STACK_SIZE)));
+	  /* rather than raise an error, we could unwind the stack here, popping off all unwind entries, but this is
+	   *   a very rare problem, and the results will be confusing anyway.
+	   */
+	  resize_stack(sc);
+	}
+      swap_stack(sc, OP_DYNAMIC_UNWIND_PROFILE, sc->profile_out, car(args));
+    }
+  return(sc->F);
+}
+
+static s7_pointer profile_info_out(s7_scheme *sc)
+{
+  s7_pointer p, pp, vs, vi, vn, vf, vl, matches;
+  s7_int i;
+  profile_data_t *pd = sc->profile_data;
+  if ((!pd) || (pd->top == 0)) return(sc->F);
+  p = make_list(sc, 7, sc->F);
+  sc->w = p;
+  set_car(p, vs = make_simple_vector(sc, pd->top));
+  set_car(cdr(p), vi = make_simple_int_vector(sc, pd->top * PD_BLOCK_SIZE));
+  set_car(cddr(p), make_integer(sc, ticks_per_second()));
+  pp = cdddr(p);
+  set_car(pp, vn = make_simple_vector(sc, pd->top));
+  set_car(cdr(pp), vf = make_simple_vector(sc, pd->top));
+  set_car(cddr(pp), vl = make_simple_int_vector(sc, pd->top));
+  matches = cdddr(pp);
+  set_car(matches, sc->nil);
+  for (i = 0; i < pd->top; i++)
+    {
+      if (pd->funcs[i])
+	{
+	  vector_element(vs, i) = pd->funcs[i];
+	  if ((is_matched_symbol(pd->funcs[i])) && /* find ambiguous names */
+	      (!direct_memq(pd->funcs[i], car(matches))))
+	    set_car(matches, cons(sc, pd->funcs[i], car(matches)));
+	  set_match_symbol(pd->funcs[i]);
+	}
+      else vector_element(vs, i) = sc->F;
+      vector_element(vn, i) = (!pd->let_names[i]) ? sc->F : pd->let_names[i];
+      vector_element(vf, i) = (!pd->files[i]) ? sc->F : pd->files[i];
+    }
+  for (i = 0; i < pd->top; i++) if (pd->funcs[i]) clear_match_symbol(pd->funcs[i]);
+  memcpy((void *)int_vector_ints(vl), (void *)pd->lines, pd->top * sizeof(s7_int));
+  memcpy((void *)int_vector_ints(vi), (void *)pd->timing_data, pd->top * PD_BLOCK_SIZE * sizeof(s7_int));
+  sc->w = sc->unused;
+  return(p);
+}
+
+static s7_pointer clear_profile_info(s7_scheme *sc)
+{
+  if (sc->profile_data)
+    {
+      profile_data_t *pd = sc->profile_data;
+      memclr(pd->timing_data, pd->top * PD_BLOCK_SIZE * sizeof(s7_int));
+      memclr(pd->funcs, pd->top * sizeof(s7_pointer));
+      memclr(pd->let_names, pd->top * sizeof(s7_pointer));
+      memclr(pd->files, pd->top * sizeof(s7_pointer));
+      memclr(pd->lines, pd->top * sizeof(s7_int));
+      pd->top = 0;
+      for (int32_t i = 0; i < pd->excl_top; i++)
+	pd->excl[i] = 0;
+      pd->excl_top = 0;
+      sc->profiling_gensyms = false;
+    }
+  return(sc->F);
+}
+
+static s7_pointer make_profile_info(s7_scheme *sc)
+{
+  if (!sc->profile_data)
+    {
+      profile_data_t *pd = (profile_data_t *)Malloc(sizeof(profile_data_t));
+      pd->size = PD_INITIAL_SIZE;
+      pd->excl_size = PD_INITIAL_SIZE;
+      pd->top = 0;
+      pd->excl_top = 0;
+      pd->funcs = (s7_pointer *)Calloc(pd->size, sizeof(s7_pointer));
+      pd->let_names = (s7_pointer *)Calloc(pd->size, sizeof(s7_pointer));
+      pd->files = (s7_pointer *)Calloc(pd->size, sizeof(s7_pointer));
+      pd->lines = (s7_int *)Calloc(pd->size, sizeof(s7_int));
+      pd->excl = (s7_int *)Calloc(pd->excl_size, sizeof(s7_int));
+      pd->timing_data = (s7_int *)Calloc(pd->size * PD_BLOCK_SIZE, sizeof(s7_int));
+      sc->profile_data = pd;
+    }
+  return(sc->F);
+}
+
+
+/* -------------------------------- dynamic-unwind -------------------------------- */
+static s7_pointer dynamic_unwind(s7_scheme *sc, s7_pointer func, s7_pointer e)
+{
+  if ((S7_DEBUGGING) && (is_multiple_value(sc->value)))
+    fprintf(stderr, "%s[%d]: unexpected multiple-value! %s %s %s\n", __func__, __LINE__, display(func), display(e), display(sc->value));
+  return(s7_apply_function(sc, func, set_plist_2(sc, e, sc->value))); /* s7_apply_function returns sc->value */
+}
+
+static s7_pointer g_dynamic_unwind(s7_scheme *sc, s7_pointer args)
+{
+  #define H_dynamic_unwind "(dynamic-unwind func arg) pushes func and arg on the stack, then (func arg) is called when the stack unwinds."
+  #define Q_dynamic_unwind s7_make_signature(sc, 3, sc->is_procedure_symbol, sc->is_procedure_symbol, sc->T)
+
+  s7_pointer func = car(args);
+  if (((is_closure(func)) && (closure_arity_to_int(sc, func) == 2)) ||
+      ((is_c_function(func)) && (c_function_is_aritable(func, 2))) ||
+      ((is_closure_star(func)) && (closure_star_arity_to_int(sc, func) == 2)) ||
+      ((is_c_function_star(func)) && (c_function_max_args(func) == 2)))
+    swap_stack(sc, OP_DYNAMIC_UNWIND, func, cadr(args));
+  else wrong_type_error_nr(sc, sc->dynamic_unwind_symbol, 1, func, wrap_string(sc, "a procedure of two arguments", 28));
+  return(cadr(args));
+}
+
+
+/* -------------------------------- catch -------------------------------- */
+static s7_pointer g_catch(s7_scheme *sc, s7_pointer args)
+{
+  #define H_catch "(catch tag thunk handler) evaluates thunk; if an error occurs that matches the tag (#t matches all), the handler is called"
+  #define Q_catch s7_make_signature(sc, 4, sc->values_symbol, \
+                    s7_make_signature(sc, 2, sc->is_symbol_symbol, sc->is_boolean_symbol), \
+                    sc->is_procedure_symbol, sc->is_procedure_symbol)
+  s7_pointer p, proc, err;
+
+  /* Guile sets up the catch before looking for arg errors: (catch #t log (lambda args "hiho")) -> "hiho"
+   *   which is consistent in that (catch #t (lambda () (log))...) should probably be the same as (catch #t log ...)
+   *   but what if the error handler arg is messed up?  Seems weird to handle args in reverse order with an intervening let etc.
+   *   I think log as the second arg is an outer error (we don't wait until the catch is called, then fall into
+   *   the local error handler).
+   */
+  /* if ((is_let(err)) && (is_openlet(err))) check_method(sc, err, sc->catch_symbol, args); */ /* causes exit from s7! */
+  if (SHOW_EVAL_OPS) fprintf(stderr, "  %s[%d]\n", __func__, __LINE__);
+
+  if (!is_pair(cdr(args))) /* (let ((mlet (openlet (inlet 'abs catch)))) (abs mlet)) -- this is a special case, avoid calling this everywhere */
+    error_nr(sc, sc->syntax_error_symbol,
+	     set_elist_2(sc, wrap_string(sc, "catch: function missing: ~S", 27), set_ulist_1(sc, sc->catch_symbol, args)));
+  proc = cadr(args);
+  if (!is_thunk(sc, proc))
+    {
+      if (is_any_procedure(proc))        /* i.e. c_function, lambda, macro, etc */
+	{
+	  s7_pointer req_args = wrap_integer(sc, procedure_required_args(sc, proc));
+	  error_nr(sc, sc->wrong_type_arg_symbol,
+		   set_elist_4(sc, wrap_string(sc, "~A requires ~D argument~P, but catch's second argument should be a thunk", 72), proc, req_args, req_args));
+	}
+      else wrong_type_error_nr(sc, sc->catch_symbol, 2, proc, a_thunk_string);
+    }
+  if (!is_pair(cddr(args)))
+    error_nr(sc, sc->syntax_error_symbol,
+	     set_elist_2(sc, wrap_string(sc, "catch: error handler missing: ~S", 32), set_ulist_1(sc, sc->catch_symbol, args)));
+  err = caddr(args);
+  if (!is_applicable(err))
+    wrong_type_error_nr(sc, sc->catch_symbol, 3, err, something_applicable_string);
+  /* should we check here for (aritable? err 2)?  (catch #t (lambda () 1) "hiho") -> 1
+   * currently this is checked only if the error handler is called
+   */
+
+  new_cell(sc, p, T_CATCH);
+  catch_tag(p) = car(args);
+  catch_goto_loc(p) = stack_top(sc);
+  catch_op_loc(p) = (int32_t)(sc->op_stack_now - sc->op_stack);
+  catch_set_handler(p, err);
+  catch_cstack(p) = sc->goto_start;
+  push_stack(sc, (intptr_t)((is_any_macro(err)) ? OP_CATCH_2 : OP_CATCH), args, p);
+
+  if (is_closure(proc))                        /* not also lambda* here because we need to handle the arg defaults */
+    {
+      /* is_thunk above checks is_aritable(proc, 0), but if it's (lambda args ...) we have to set up the let with args=()
+       *    the case that caught this: (catch #t make-hook ...)
+       */
+      sc->code = closure_body(proc);
+      if (is_symbol(closure_args(proc)))
+	set_curlet(sc, make_let_with_slot(sc, closure_let(proc), closure_args(proc), sc->nil));
+      else set_curlet(sc, inline_make_let(sc, closure_let(proc)));
+      push_stack_no_args_direct(sc, sc->begin_op);
+    }
+  else push_stack(sc, OP_APPLY, sc->nil, proc);
+  return(sc->F);
+}
+
+s7_pointer s7_call_with_catch(s7_scheme *sc, s7_pointer tag, s7_pointer body, s7_pointer error_handler)
+{
+  s7_pointer p, result;
+  if (sc->stack_end == sc->stack_start) /* no stack! */
+    push_stack_direct(sc, OP_EVAL_DONE);
+
+  if (SHOW_EVAL_OPS) fprintf(stderr, "  %s[%d]\n", __func__, __LINE__);
+  new_cell(sc, p, T_CATCH);
+  catch_tag(p) = tag;
+  catch_goto_loc(p) = stack_top(sc);
+  catch_op_loc(p) = (int32_t)(sc->op_stack_now - sc->op_stack);
+  catch_set_handler(p, error_handler);
+  catch_cstack(p) = sc->goto_start;
+
+  {
+    declare_jump_info();
+    TRACK(sc);
+    store_jump_info(sc);
+    set_jump_info(sc, S7_CALL_SET_JUMP);
+
+    if (SHOW_EVAL_OPS) fprintf(stderr, "jump_loc: %s\n", jump_string[(int)jump_loc]);
+    if (jump_loc == NO_JUMP)
+      {
+	catch_cstack(p) = &new_goto_start;
+	if (SHOW_EVAL_OPS) fprintf(stderr, "  longjmp call %s\n", display_truncated(body));
+	push_stack(sc, OP_CATCH, error_handler, p);
+	result = s7_call(sc, body, sc->nil);
+	if (stack_top_op(sc) == OP_CATCH) sc->stack_end -= 4;
+      }
+    else
+      {
+	if (SHOW_EVAL_OPS) fprintf(stderr, "  jump back with %s (%d)\n", jump_string[(int)jump_loc], (sc->stack_end == sc->stack_start));
+	if (jump_loc != ERROR_JUMP)
+	  eval(sc, sc->cur_op);
+	if ((jump_loc == CATCH_JUMP) &&    /* we're returning from an error in catch */
+	    ((sc->stack_end == sc->stack_start) ||
+	     (((sc->stack_end - 4) == sc->stack_start) && (stack_top_op(sc) == OP_GC_PROTECT)))) /* s7_apply_function probably */
+	  push_stack_op(sc, OP_ERROR_QUIT);
+	result = sc->value;
+      }
+    restore_jump_info(sc);
+  }
+
+  return(result);
+}
+
+static void op_c_catch(s7_scheme *sc)
+{
+  /* (catch #t (lambda () (set! ("hi") #\a)) (lambda args args))
+   *    code is (catch #t (lambda () ....) (lambda args ....))
+   */
+  s7_pointer p, f = cadr(sc->code), args = cddr(sc->code), tag;
+
+  /* defer making the error lambda */
+  if (!is_pair(f))                         /* (catch #t ...) or (catch sym ...) */
+    tag = (is_symbol(f)) ? lookup_checked(sc, f) : f;
+  else tag = cadr(f);                      /* (catch 'sym ...) */
+
+  new_cell(sc, p, T_CATCH);                /* the catch object sitting on the stack */
+  catch_tag(p) = tag;
+  catch_goto_loc(p) = stack_top(sc);
+  catch_op_loc(p) = sc->op_stack_now - sc->op_stack;
+  catch_set_handler(p, cdadr(args));       /* not yet a closure... */
+  catch_cstack(p) = sc->goto_start;
+  push_stack(sc, OP_CATCH_1, sc->code, p); /* code ignored here, except by GC */
+  set_curlet(sc, inline_make_let(sc, sc->curlet));
+  sc->code = T_Pair(cddar(args));
+}
+
+static void op_c_catch_all(s7_scheme *sc)
+{
+  s7_pointer p;
+  new_cell(sc, p, T_CATCH);
+  catch_tag(p) = sc->T;
+  catch_goto_loc(p) = stack_top(sc);
+  catch_op_loc(p) = sc->op_stack_now - sc->op_stack;
+  catch_set_handler(p, sc->nil);
+  catch_cstack(p) = sc->goto_start;
+  push_stack(sc, OP_CATCH_ALL, opt2_con(sc->code), p);    /* push_stack: op args code */
+  sc->code = T_Pair(opt1_pair(cdr(sc->code)));            /* the body of the first lambda (or car of it if catch_all_o) */
+}
+
+static void op_c_catch_all_a(s7_scheme *sc)
+{
+  op_c_catch_all(sc);
+  sc->value = fx_call(sc, sc->code);
+}
+
+
+/* -------------------------------- owlet -------------------------------- */
+/* error reporting info -- save filename and line number */
+
+static s7_pointer init_owlet(s7_scheme *sc)
+{
+  s7_pointer p; /* watch out for order below */
+  s7_pointer e = make_let(sc, sc->rootlet);
+  sc->temp3 = e;
+  sc->error_type = add_slot_checked_with_id(sc, e, make_symbol(sc, "error-type", 10), sc->F);    /* the error type or tag ('division-by-zero) */
+  sc->error_data = add_slot_unchecked_with_id(sc, e, make_symbol(sc, "error-data", 10), sc->F);  /* the message or information passed by the error function */
+  sc->error_code = add_slot_unchecked_with_id(sc, e, make_symbol(sc, "error-code", 10), sc->F);  /* the code that s7 thinks triggered the error */
+  sc->error_line = add_slot_unchecked_with_id(sc, e, make_symbol(sc, "error-line", 10), p = make_permanent_integer(0));  /* the line number of that code */
+  add_saved_pointer(sc, p);
+  sc->error_file = add_slot_unchecked_with_id(sc, e, make_symbol(sc, "error-file", 10), sc->F);  /* the file name of that code */
+  sc->error_position = add_slot_unchecked_with_id(sc, e, make_symbol(sc, "error-position", 14), p = make_permanent_integer(0)); /* file-byte position of that code */
+  add_saved_pointer(sc, p);
+#if WITH_HISTORY
+  sc->error_history = add_slot_unchecked_with_id(sc, e, make_symbol(sc, "error-history", 13), sc->F); /* buffer of previous evaluations */
+#endif
+  sc->temp3 = sc->unused;
+  return(e);
+}
+
+#if WITH_HISTORY
+static s7_pointer cull_history(s7_scheme *sc, s7_pointer code)
+{
+  clear_symbol_list(sc); /* make a list of words banned from the history */
+  add_symbol_to_list(sc, sc->s7_starlet_symbol);
+  add_symbol_to_list(sc, sc->eval_symbol);
+  add_symbol_to_list(sc, make_symbol(sc, "debug", 5));
+  add_symbol_to_list(sc, make_symbol(sc, "trace-in", 8));
+  add_symbol_to_list(sc, make_symbol(sc, "trace-out", 9));
+  add_symbol_to_list(sc, sc->dynamic_unwind_symbol);
+  add_symbol_to_list(sc, make_symbol(sc, "history-enabled", 15));
+  for (s7_pointer p = code; is_pair(p); p = cdr(p))
+    {
+      if ((is_pair(car(p))) && (!is_quote(car(p))) && (pair_set_memq(sc, car(p))))
+	set_car(p, sc->nil);
+      if (cdr(p) == code) break;
+    }
+  return(code);
+}
+#endif
+
+static s7_pointer g_owlet(s7_scheme *sc, s7_pointer args)
+{
+#if WITH_HISTORY
+  #define H_owlet "(owlet) returns the environment at the point of the last error. \
+It has the additional local variables: error-type, error-data, error-code, error-line, error-file, and error-history."
+#else
+  #define H_owlet "(owlet) returns the environment at the point of the last error. \
+It has the additional local variables: error-type, error-data, error-code, error-line, and error-file."
+#endif
+  #define Q_owlet s7_make_signature(sc, 1, sc->is_let_symbol)
+  /* if owlet is not copied, (define e (owlet)), e changes as owlet does! */
+
+  s7_pointer e;
+  bool old_gc = sc->gc_off;
+  if (is_pair(args))
+    error_nr(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, too_many_arguments_string, sc->owlet_symbol, args));
+#if WITH_HISTORY
+  slot_set_value(sc->error_history, cull_history(sc, slot_value(sc->error_history)));
+#endif
+  e = let_copy(sc, sc->owlet);
+  gc_protect_via_stack(sc, e);
+
+  /* make sure the pairs/reals/strings/integers are copied: should be error-data, error-code, and error-history */
+  sc->gc_off = true;
+
+  for (s7_pointer x = let_slots(e); tis_slot(x); x = next_slot(x))
+    if (is_pair(slot_value(x)))
+      {
+	s7_pointer new_list = copy_any_list(sc, slot_value(x));
+	slot_set_value(x, new_list);
+	for (s7_pointer p = new_list, sp = p; is_pair(p); p = cdr(p), sp = cdr(sp))
+	  {
+	    s7_pointer val = car(p);
+	    if (is_t_real(val))
+	      set_car(p, make_real(sc, real(val)));
+	    else
+	      if (is_string(val))
+		set_car(p, make_string_with_length(sc, string_value(val), string_length(val)));
+	      else
+		if (is_t_integer(val))
+		  set_car(p, make_integer(sc, integer(val)));
+	    p = cdr(p);
+	    if ((!is_pair(p)) || (p == sp)) break;
+	    val = car(p);
+	    if (is_t_real(val))
+	      set_car(p, make_real(sc, real(val)));
+	    else
+	      if (is_string(val))
+		set_car(p, make_string_with_length(sc, string_value(val), string_length(val)));
+	  }}
+  sc->gc_off = old_gc;
+  unstack_gc_protect(sc);
+  return(e);
+}
+
+
+/* -------- catch handlers -------- (don't free the catcher) */
+static void load_catch_cstack(s7_scheme *sc, s7_pointer c)
+{
+  if (catch_cstack(c))
+    sc->goto_start = catch_cstack(c);
+}
+
+static bool catch_all_function(s7_scheme *sc, s7_int catch_loc, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+  s7_pointer catcher = T_Cat(stack_code(sc->stack, catch_loc));
+  if (SHOW_EVAL_OPS) fprintf(stderr, "catcher: %s\n", __func__);
+  sc->value = stack_args(sc->stack, catch_loc);      /* error result, optimize_func_three_args -> op_c_catch_all etc */
+  if (sc->value == sc->unused) sc->value = type;
+  sc->op_stack_now = (s7_pointer *)(sc->op_stack + catch_op_loc(catcher));
+  sc->stack_end = (s7_pointer *)(sc->stack_start + catch_goto_loc(catcher));
+  load_catch_cstack(sc, catcher);
+  pop_stack(sc);
+  return(true);
+}
+
+static bool catch_2_function(s7_scheme *sc, s7_int catch_loc, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+  /* this is the macro-error-handler case from g_catch
+   *    (let () (define-macro (m . args) (apply (car args) (cadr args))) (catch #t (lambda () (error abs -1)) m))
+   */
+  s7_pointer x = T_Cat(stack_code(sc->stack, catch_loc));
+  if (SHOW_EVAL_OPS) fprintf(stderr, "catcher: %s\n", __func__);
+  if ((catch_tag(x) == sc->T) || (catch_tag(x) == type) || (type == sc->T))
+    {
+      sc->op_stack_now = (s7_pointer *)(sc->op_stack + catch_op_loc(x));
+      sc->stack_end = (s7_pointer *)(sc->stack_start + catch_goto_loc(x));
+      sc->code = catch_handler(x);
+      load_catch_cstack(sc, x);
+      if (needs_copied_args(sc->code))
+	sc->args = list_2(sc, type, info);
+      else sc->args = with_list_t2(type, info); /* very unlikely: need c_macro as error catcher: (catch #t (lambda () (error 'oops)) require) */
+      sc->cur_op = OP_APPLY;
+      return(true);
+    }
+  return(false);
+}
+
+static bool catch_1_function(s7_scheme *sc, s7_int catch_loc, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+  s7_pointer x = T_Cat(stack_code(sc->stack, catch_loc));
+  if (SHOW_EVAL_OPS) fprintf(stderr, "catcher: %s\n", __func__);
+  if ((catch_tag(x) == sc->T) ||  /* the normal case */
+      (catch_tag(x) == type) ||
+      (type == sc->T))
+    {
+      opcode_t op = stack_op(sc->stack, catch_loc);
+      s7_pointer catcher = x, error_body, error_args;
+      s7_pointer error_func = catch_handler(catcher);
+      uint64_t loc = catch_goto_loc(catcher);
+
+      init_temp(sc->y, type);
+      sc->value = info;
+
+      sc->temp4 = stack_let(sc->stack, catch_loc); /* GC protect this, since we're moving the stack top below */
+      sc->op_stack_now = (s7_pointer *)(sc->op_stack + catch_op_loc(catcher));
+      sc->stack_end = (s7_pointer *)(sc->stack_start + loc);
+      load_catch_cstack(sc, catcher);
+
+      /* very often the error handler just returns either a constant ('error or #f), or
+       *   the args passed to it, so there's no need to laboriously make a closure,
+       *   and apply it -- just set sc->value to the closure body (or the args) and return.
+       * so first examine closure_body(error_func)
+       *   if it is a constant, or quoted symbol, return that,
+       *   if it is the args symbol, return (list type info)
+       */
+
+      /* if OP_CATCH_1, we deferred making the error handler until it is actually needed */
+      if (op == OP_CATCH_1)
+	{
+	  error_body = cdr(error_func);
+	  error_args = car(error_func);
+	}
+      else
+	if (is_closure(error_func))
+	  {
+	    error_body = closure_body(error_func);
+	    error_args = closure_args(error_func);
+	  }
+	else
+	  {
+	    error_body = NULL;
+	    error_args = NULL;
+	  }
+      if ((error_body) && (is_null(cdr(error_body))))
+	{
+	  s7_pointer y = NULL;
+	  error_body = car(error_body);
+	  if (is_pair(error_body))
+	    {
+	      if (is_quote(car(error_body)))
+		y = cadr(error_body);
+	      else
+		if ((car(error_body) == sc->car_symbol) &&
+		    (is_pair(cdr(error_body))) &&            /* catch: (lambda (type info) (car)) */
+		    (cadr(error_body) == error_args))
+		  y = type;
+	    }
+	  else
+	    if (!is_symbol(error_body))
+	      y = error_body; /* not pair or symbol */
+	    else
+	      if (error_body == error_args)
+		y = list_2(sc, type, info);
+	      else
+		if (is_keyword(error_body))
+		  y = error_body;
+		else
+		  if ((is_pair(error_args)) &&
+		      (error_body == car(error_args)))
+		    y = type;
+	  if (y)
+	    {
+	      if ((SHOW_EVAL_OPS) && (loc > 4)) {fprintf(stderr, "  about to pop_stack: \n"); s7_show_stack(sc);}
+	      if (loc > 4)
+		pop_stack(sc);
+	      /* we're at OP_CATCH, normally we want to pop that away, but (handwaving...) if we're coming
+	       *   from s7_eval (indirectly perhaps through s7_eval_c_string), we might push the OP_EVAL_DONE
+	       *   to end that call, but it's pushed at the precatch stack end (far beyond the catch loc).
+	       *   If we catch an error, catch unwinds to its starting point, and the pop_stack above
+	       *   puts us at the bottom of the stack (i.e. stack_end == stack_start), OP_EVAL_DONE.
+	       *   Now we return true, ending up back in eval, because the error handler jumped out of eval,
+	       *   back to wherever we were in eval when we hit the error.  eval jumps back to the start
+	       *   of its loop, and pops the stack to see what to do next!  So the (loc > 4) at least
+	       *   protects against stack underflow, but ideally we'd know we came from OP_CATCH+s7_eval.
+	       *   We can't do anything fancy here because we have to unwind the C stack as well as s7's stack.
+	       *   s7_eval doesn't know anything about the catches on the stack.  We can't look back for
+	       *   OP_EVAL_DONE -- segfault in OP_BEGIN.  Hmmmm.  Perhaps catch should not unwind until the
+	       *   end?  But we want the error handler to run as a part of the calling expression, and
+	       *   in any case the OP_EVAL_DONE is not useful (it marks the end of the no-error case).
+	       */
+	      sc->value = y;
+	      sc->y = sc->unused;
+	      sc->temp4 = sc->unused;
+	      sc->w = sc->unused;
+	      if (loc == 4)
+		sc->code = cons(sc, sc->value, sc->nil); /* if we end up at op_begin, give it something it can handle */
+	      return(true);
+	    }}
+      /* here type and info need to be GC protected (new_cell below), g_throw and error_nr, throw sc->w for type, but error_nr nothing currently */
+      if (op == OP_CATCH_1)
+	{
+	  s7_pointer p;
+	  new_cell(sc, p, T_CLOSURE);
+	  closure_set_args(p, car(error_func));
+	  closure_set_body(p, cdr(error_func));
+	  closure_set_setter(p, sc->F);
+	  closure_set_arity(p, CLOSURE_ARITY_NOT_SET);
+	  closure_set_let(p, sc->temp4);
+	  sc->code = p;
+	  if ((S7_DEBUGGING) && (!s7_is_aritable(sc, sc->code, 2))) fprintf(stderr, "%s[%d]: errfunc not aritable(2)!\n", __func__, __LINE__);
+	}
+      else
+	{
+	  sc->code = error_func;
+	  sc->y = sc->unused;
+	  if (!s7_is_aritable(sc, sc->code, 2)) /* op_catch_1 from op_c_catch already checks this */
+	    wrong_number_of_arguments_error_nr(sc, "catch error handler should accept two arguments: ~S", 51, sc->code);
+	}
+      sc->temp4 = sc->unused;
+      /* if user (i.e. yers truly!) copies/pastes the preceding lambda () into the
+       *   error handler portion of the catch, he gets the inexplicable message:
+       *       ;(): too many arguments: (a1 ())
+       *   when this apply tries to call the handler.  So, we need a special case error check here!
+       */
+      sc->args = list_2(sc, type, info); /* almost never able to skip this -- costs more to check! */
+      sc->w = sc->unused;
+      sc->y = sc->unused;
+      sc->cur_op = OP_APPLY;
+      /* explicit eval needed if s7_call called into scheme where a caught error occurred (ex6 in exs7.c)
+       *  but putting it here (via eval(sc, OP_APPLY)) means the C stack is not cleared correctly in non-s7-call cases,
+       *  so defer it until s7_call
+       */
+      return(true);
+    }
+  return(false);
+}
+
+static bool catch_dynamic_wind_function(s7_scheme *sc, s7_int catch_loc, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+  s7_pointer x = T_Dyn(stack_code(sc->stack, catch_loc));
+  if (SHOW_EVAL_OPS) fprintf(stderr, "catcher: %s\n", __func__);
+  if (dynamic_wind_state(x) == DWIND_BODY)
+    {
+      dynamic_wind_state(x) = DWIND_FINISH;    /* make sure an uncaught error in the exit thunk doesn't cause us to loop */
+      if (dynamic_wind_out(x) != sc->F)
+	sc->value = s7_call(sc, dynamic_wind_out(x), sc->nil);
+    }
+  return(false);
+}
+
+static bool catch_out_function(s7_scheme *sc, s7_int catch_loc, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+  s7_pointer x = T_Pro(stack_code(sc->stack, catch_loc));   /* "code" = port that we opened */
+  if (SHOW_EVAL_OPS) fprintf(stderr, "catcher: %s\n", __func__);
+  s7_close_output_port(sc, x);
+  x = stack_args(sc->stack, catch_loc);                     /* "args" = port that we shadowed, if not #<unused> */
+  if (x != sc->unused)
+    set_current_output_port(sc, x);
+  return(false);
+}
+
+static bool catch_in_function(s7_scheme *sc, s7_int catch_loc, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+  if (SHOW_EVAL_OPS) fprintf(stderr, "catcher: %s\n", __func__);
+  s7_close_input_port(sc, T_Pri(stack_code(sc->stack, catch_loc)));     /* "code" = port that we opened */
+  if (stack_args(sc->stack, catch_loc) != sc->unused)
+    set_current_input_port(sc, stack_args(sc->stack, catch_loc));       /* "args" = port that we shadowed */
+  return(false);
+}
+
+static bool catch_read_function(s7_scheme *sc, s7_int catch_loc, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+  if (SHOW_EVAL_OPS) fprintf(stderr, "catcher: %s\n", __func__);
+  pop_input_port(sc);
+  return(false);
+}
+
+static bool catch_eval_function(s7_scheme *sc, s7_int catch_loc, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+  if (SHOW_EVAL_OPS) fprintf(stderr, "catcher: %s\n", __func__);
+  s7_close_input_port(sc, current_input_port(sc));
+  pop_input_port(sc);
+  return(false);
+}
+
+static bool catch_barrier_function(s7_scheme *sc, s7_int catch_loc, s7_pointer type, s7_pointer info, bool *reset_hook)
+{ /* can this happen? is it doing the right thing? read/eval/call_begin_hook push_stack op_barrier but only s7_read includes a port (this is not hit in s7test.scm) */
+  if (SHOW_EVAL_OPS) fprintf(stderr, "catcher: %s\n", __func__);
+  if (is_input_port(stack_args(sc->stack, catch_loc)))
+    {
+      if (current_input_port(sc) == stack_args(sc->stack, catch_loc))
+	pop_input_port(sc);
+      s7_close_input_port(sc, stack_args(sc->stack, catch_loc));
+    }
+  return(false);
+}
+
+static bool catch_error_hook_function(s7_scheme *sc, s7_int catch_loc, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+  if (SHOW_EVAL_OPS) fprintf(stderr, "catcher: %s\n", __func__);
+  let_set_2(sc, closure_let(sc->error_hook), sc->body_symbol, stack_code(sc->stack, catch_loc));
+  /* apparently there was an error during *error-hook* evaluation, but Rick wants the hook re-established anyway */
+  (*reset_hook) = true;
+  /* avoid infinite loop -- don't try to (re-)evaluate (buggy) *error-hook*! */
+  return(false);
+}
+
+static bool catch_goto_function(s7_scheme *sc, s7_int catch_loc, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+  if (SHOW_EVAL_OPS) fprintf(stderr, "catcher: %s\n", __func__);
+  call_exit_active(stack_args(sc->stack, catch_loc)) = false;
+  return(false);
+}
+
+static bool catch_map_unwind_function(s7_scheme *sc, s7_int catch_loc, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+  if (SHOW_EVAL_OPS) fprintf(stderr, "catcher: %s\n", __func__);
+  sc->map_call_ctr--;
+  if ((S7_DEBUGGING) && (sc->map_call_ctr < 0)) {fprintf(stderr, "%s[%d]: map ctr: %" ld64 "\n", __func__, __LINE__, sc->map_call_ctr); sc->map_call_ctr = 0;}
+  return(false);
+}
+
+static bool op_let_temp_done1(s7_scheme *sc);
+
+static bool catch_let_temporarily_function(s7_scheme *sc, s7_int catch_loc, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+  /* this is aimed at let-temp error-hook... error -- not yet tested much */
+  if (SHOW_EVAL_OPS) fprintf(stderr, "catcher: %s\n", __func__);
+  if ((!*reset_hook) &&
+      (hook_has_functions(sc->error_hook)))
+    {
+      s7_pointer error_hook_funcs = s7_hook_functions(sc, sc->error_hook);
+
+      let_set_2(sc, closure_let(sc->error_hook), sc->body_symbol, sc->nil);
+      let_set_2(sc, closure_let(sc->let_temp_hook), sc->body_symbol, error_hook_funcs);
+      sc->code = sc->let_temp_hook;
+      sc->args = list_2(sc, type, info);
+
+      push_stack_direct(sc, OP_EVAL_DONE);
+      set_curlet(sc, make_let(sc, closure_let(sc->code)));
+      eval(sc, OP_APPLY_LAMBDA);
+
+      let_set_2(sc, closure_let(sc->error_hook), sc->body_symbol, error_hook_funcs);
+      let_set_2(sc, closure_let(sc->let_temp_hook), sc->body_symbol, sc->nil);
+
+      sc->args = stack_args(sc->stack, catch_loc);
+      sc->code = stack_code(sc->stack, catch_loc);
+      set_curlet(sc, stack_let(sc->stack, catch_loc));
+
+      push_stack_direct(sc, OP_GC_PROTECT);
+      if (!op_let_temp_done1(sc))
+	{
+	  push_stack_direct(sc, OP_EVAL_DONE);
+	  eval(sc, OP_SET_UNCHECKED);
+	}}
+  else let_temp_done(sc, stack_args(sc->stack, catch_loc), T_Let(stack_let(sc->stack, catch_loc)));
+  return(false);
+}
+
+static bool catch_let_temp_unwind_function(s7_scheme *sc, s7_int catch_loc, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+  s7_pointer slot = stack_code(sc->stack, catch_loc);
+  s7_pointer val = stack_args(sc->stack, catch_loc);
+  if (SHOW_EVAL_OPS) fprintf(stderr, "catcher: %s, unwind setting %s to %s\n", __func__, display_truncated(slot), display_truncated(val));
+  if (is_immutable_slot(slot)) /* we're already in an error/throw situation, so raising an error here leads to an infinite loop */
+    s7_warn(sc, 512, "let-temporarily can't reset %s to %s: it is immutable!", symbol_name(slot_symbol(slot)), display(val));
+  else slot_set_value(slot, val);
+  return(false);
+}
+
+static bool catch_let_temp_s7_unwind_function(s7_scheme *sc, s7_int catch_loc, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+  if (SHOW_EVAL_OPS) fprintf(stderr, "catcher: %s\n", __func__);
+  s7_starlet_set_1(sc, T_Sym(stack_code(sc->stack, catch_loc)), stack_args(sc->stack, catch_loc));
+  return(false);
+}
+
+static bool catch_let_temp_s7_direct_unwind_function(s7_scheme *sc, s7_int catch_loc, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+  if (SHOW_EVAL_OPS) fprintf(stderr, "catcher: %s\n", __func__);
+  sc->has_openlets = (stack_args(sc->stack, catch_loc) != sc->F);
+  return(false);
+}
+
+static bool catch_dynamic_unwind_function(s7_scheme *sc, s7_int catch_loc, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+  /* if func has an error, s7_error will call it as it unwinds the stack -- an infinite loop. So, cancel the unwind first */
+  if (SHOW_EVAL_OPS) fprintf(stderr, "catcher: %s\n", __func__);
+  set_stack_op(sc->stack, catch_loc, OP_GC_PROTECT);
+
+  /* we're in an error or throw, so there is no return value to report, but we need to decrement *debug-spaces* (if in debug)
+   *    stack_let is the trace-in let at the point of the dynamic_unwind call
+   */
+  if (sc->debug > 0)
+    {
+      s7_pointer spaces = lookup_slot_with_let(sc, make_symbol(sc, "*debug-spaces*", 14), T_Let(stack_let(sc->stack, catch_loc)));
+      if (is_slot(spaces))
+	slot_set_value(spaces, make_integer(sc, max_i_ii(0LL, integer(slot_value(spaces)) - 2))); /* should involve only small_ints */
+    }
+  return(false);
+}
+
+typedef bool (*catch_function_t)(s7_scheme *sc, s7_int catch_loc, s7_pointer type, s7_pointer info, bool *reset_hook);
+static catch_function_t catchers[NUM_OPS];
+
+static void init_catchers(void)
+{
+  for (int32_t i = 0; i < NUM_OPS; i++) catchers[i] = NULL;
+  catchers[OP_CATCH_ALL] =          catch_all_function;
+  catchers[OP_CATCH_2] =            catch_2_function;
+  catchers[OP_CATCH_1] =            catch_1_function;
+  catchers[OP_CATCH] =              catch_1_function;
+  catchers[OP_DYNAMIC_WIND] =       catch_dynamic_wind_function;
+  catchers[OP_DYNAMIC_UNWIND] =     catch_dynamic_unwind_function;
+  catchers[OP_GET_OUTPUT_STRING] =  catch_out_function;
+  catchers[OP_UNWIND_OUTPUT] =      catch_out_function;
+  catchers[OP_UNWIND_INPUT] =       catch_in_function;
+  catchers[OP_READ_DONE] =          catch_read_function;      /* perhaps an error during (read) */
+  catchers[OP_EVAL_STRING] =        catch_eval_function;
+  catchers[OP_BARRIER] =            catch_barrier_function;
+  catchers[OP_DEACTIVATE_GOTO] =    catch_goto_function;
+  catchers[OP_LET_TEMP_DONE] =      catch_let_temporarily_function;
+  catchers[OP_LET_TEMP_UNWIND] =    catch_let_temp_unwind_function;
+  catchers[OP_LET_TEMP_S7_UNWIND] = catch_let_temp_s7_unwind_function;
+  catchers[OP_LET_TEMP_S7_DIRECT_UNWIND] = catch_let_temp_s7_direct_unwind_function;
+  catchers[OP_ERROR_HOOK_QUIT] =    catch_error_hook_function;
+  catchers[OP_MAP_UNWIND] =         catch_map_unwind_function;
+}
+
+/* -------------------------------- throw -------------------------------- */
+static s7_pointer g_throw(s7_scheme *sc, s7_pointer args)
+{
+  #define H_throw "(throw tag . info) is like (error ...) but it does not affect owlet. \
+It looks for an existing catch with a matching tag, and jumps to it if found.  Otherwise it raises an error."
+  #define Q_throw s7_make_circular_signature(sc, 1, 2, sc->values_symbol, sc->T)
+
+  bool ignored_flag = false;
+  s7_pointer type = car(args), info = cdr(args);
+  gc_protect_via_stack(sc, args);
+  /* type can be anything: (throw (list 1 2 3) (make-list 512)), sc->w and sc->value not good here for gc protection */
+
+  for (int64_t i = stack_top(sc) - 5; i >= 3; i -= 4) /* look for a catcher */
+    {
+      catch_function_t catcher = catchers[stack_op(sc->stack, i)];
+      if ((catcher) &&
+	  (catcher(sc, i, type, info, &ignored_flag)))
+	{
+	  if (sc->longjmp_ok) LongJmp(*(sc->goto_start), THROW_JUMP);
+	  return(sc->value);
+	}}
+  if (is_let(car(args)))
+    check_method(sc, car(args), sc->throw_symbol, args);
+  error_nr(sc, make_symbol(sc, "uncaught-throw", 14),
+	   set_elist_3(sc, wrap_string(sc, "no catch found for (throw ~W~{~^ ~S~})", 38), type, info));
+  return(sc->F);
+}
+
+
+/* -------------------------------- warn -------------------------------- */
+#if WITH_GCC
+static __attribute__ ((format (printf, 3, 4))) void s7_warn(s7_scheme *sc, s7_int len, const char *ctrl, ...)
+#else
+static void s7_warn(s7_scheme *sc, s7_int len, const char *ctrl, ...) /* len = max size of output string (for vsnprintf) */
+#endif
+{
+  if ((current_error_port(sc) != sc->F) && (!sc->muffle_warnings))
+    {
+      int32_t bytes;
+      va_list ap;
+      block_t *b = mallocate(sc, len);
+      char *str = (char *)block_data(b);
+      str[0] = '\0';
+      va_start(ap, ctrl);
+      bytes = vsnprintf(str, len, ctrl, ap);
+      va_end(ap);
+      if (port_is_closed(current_error_port(sc)))
+	set_current_error_port(sc, sc->standard_error);
+      if ((bytes > 0) && (current_error_port(sc) != sc->F))
+	port_write_string(current_error_port(sc))(sc, str, bytes, current_error_port(sc));
+      liberate(sc, b);
+    }
+}
+
+
+/* -------------------------------- error -------------------------------- */
+static void fill_error_location(s7_scheme *sc)
+{
+  if (((is_input_port(current_input_port(sc))) && (is_loader_port(current_input_port(sc)))) ||
+      (((sc->cur_op >= OP_READ_LIST) && (sc->cur_op <= OP_READ_DONE))))
+    {
+      set_integer(slot_value(sc->error_line), port_line_number(current_input_port(sc)));
+      set_integer(slot_value(sc->error_position), port_position(current_input_port(sc)));
+      slot_set_value(sc->error_file, wrap_string(sc, port_filename(current_input_port(sc)), port_filename_length(current_input_port(sc))));
+    }
+  else
+    {
+      set_integer(slot_value(sc->error_line), 0);
+      set_integer(slot_value(sc->error_position), 0);
+      slot_set_value(sc->error_file, sc->F);
+    }
+}
+
+static void format_to_error_port(s7_scheme *sc, const char *str, s7_pointer args, s7_int len)
+{
+  if (current_error_port(sc) != sc->F)
+    format_to_port_1(sc, current_error_port(sc), str, args, NULL, false, true /* is_columnizing(str) */, len, NULL);
+  /* is_columnizing on every call is much slower than ignoring the issue */
+}
+
+static noreturn void error_nr(s7_scheme *sc, s7_pointer type, s7_pointer info)
+{
+  bool reset_error_hook = false;
+  s7_pointer cur_code = current_code(sc);
+
+  sc->format_depth = -1;
+  sc->object_out_locked = false;  /* possible error in obj->str method after object_out has set this flag */
+  sc->has_openlets = true;        /*   same problem -- we need a cleaner way to handle this, op_?_unwind */
+  sc->value = info;               /* feeble GC protection (otherwise info is sometimes freed in this function), throw also protects type */
+
+  if (sc->current_safe_list > 0)
+    clear_list_in_use(sc->safe_lists[sc->current_safe_list]);
+  slot_set_value(sc->error_type, type);
+  slot_set_value(sc->error_data, info);
+
+  if (unchecked_type(sc->curlet) != T_LET)
+    set_curlet(sc, sc->rootlet);      /* in the reader, the sc->curlet stack entry is mostly ignored, so it can be (and usually is) garbage */
+  let_set_outlet(sc->owlet, sc->curlet);
+  slot_set_value(sc->error_code, cur_code); /* if mv here, evalable code has the mv bit set, maybe from c-macro that uses s7_values */
+
+#if WITH_HISTORY
+  slot_set_value(sc->error_history, sc->cur_code);
+  if (sc->cur_code != sc->history_sink)
+    {
+      sc->cur_code = (sc->using_history1) ? sc->eval_history2 : sc->eval_history1;
+      sc->using_history1 = (!sc->using_history1);
+      pair_fill(sc, set_plist_2(sc, sc->cur_code, sc->nil));
+    }
+#endif
+  if (is_pair(cur_code))
+    {
+      s7_int line = -1, file, position;
+      if (has_location(cur_code))
+	{
+	  line = pair_line_number(cur_code);
+	  file = pair_file_number(cur_code);
+	  position = pair_position(cur_code);
+	}
+      else /* try to find a plausible line number! */
+	for (s7_pointer p = cur_code, sp = cur_code; is_pair(p); p = cdr(p), sp = cdr(sp))
+	  {
+	    if ((is_pair(car(p))) &&  /* what about p itself? */
+		(has_location(car(p))))
+	      {
+		line = pair_line_number(car(p));
+		file = pair_file_number(car(p));
+		position = pair_position(car(p));
+		break;
+	      }
+	    p = cdr(p);
+	    if ((!is_pair(p)) || (p == sp)) break;
+	    if ((is_pair(car(p))) &&
+		(has_location(car(p))))
+	      {
+		line = pair_line_number(car(p));
+		file = pair_file_number(car(p));
+		position = pair_position(car(p));
+		break;
+	      }}
+      if ((line <= 0) || (file < 0))
+	fill_error_location(sc);
+      else
+	{
+	  set_integer(slot_value(sc->error_line), line);
+	  set_integer(slot_value(sc->error_position), position);
+	  slot_set_value(sc->error_file, sc->file_names[file]);
+	}}
+  else fill_error_location(sc);
+
+  /* look for a catcher, call catch*function in the error context (before unwinding the stack), outlet(owlet) is curlet */
+  /* top is 1 past actual top, top - 1 is op, if op = OP_CATCH, top - 4 is the cell containing the catch struct */
+  for (int64_t i = stack_top(sc) - 1; i >= 3; i -= 4)
+    {
+      catch_function_t catcher = catchers[stack_op(sc->stack, i)];
+      if ((SHOW_EVAL_OPS) && (catcher)) {fprintf(stderr, "before catch:\n"); s7_show_stack(sc);}
+      if ((catcher) &&
+	  (catcher(sc, i, type, info, &reset_error_hook)))
+	{
+	  if (SHOW_EVAL_OPS) {fprintf(stderr, "  after catch: \n"); s7_show_stack(sc);}
+	  if ((S7_DEBUGGING) && (!sc->longjmp_ok)) fprintf(stderr, "s7_error jump not available?\n");
+	  LongJmp(*(sc->goto_start), CATCH_JUMP);
+	}}
+  /* error not caught (but catcher might have been called and returned false) */
+
+  if ((!reset_error_hook) &&
+      (hook_has_functions(sc->error_hook)))
+    {
+      s7_pointer error_hook_funcs = s7_hook_functions(sc, sc->error_hook);
+      /* (set! (hook-functions *error-hook*) (list (lambda (h) (format *stderr* "got error ~A~%" (h 'data))))) */
+      let_set_2(sc, closure_let(sc->error_hook), sc->body_symbol, sc->nil);
+      let_set_2(sc, closure_let(sc->let_temp_hook), sc->body_symbol, error_hook_funcs);
+      /* if the *error-hook* functions trigger an error, we had better not have hook_functions(*error-hook*) still set! */
+
+      /* here we have no catcher (anywhere!), we're headed back to the top-level(?), so error_hook_quit can call reset_stack? */
+      push_stack(sc, OP_ERROR_HOOK_QUIT, sc->nil, error_hook_funcs); /* restore *error-hook* upon successful (or any!) evaluation */
+      sc->code = sc->let_temp_hook;
+      sc->args = list_2(sc, type, info);
+      /* if we drop into the longjmp below, the hook functions are not called!
+       *   OP_ERROR_HOOK_QUIT performs the longjmp, so it should be safe to go to eval.
+       */
+      set_curlet(sc, make_let(sc, closure_let(sc->code)));
+      eval(sc, OP_APPLY_LAMBDA);
+      /* we'll longjmp below -- is that really what we want? */
+    }
+  else
+    {
+      s7_int op = sc->print_length;
+      if (op < 32) sc->print_length = 32;
+
+      if ((!is_output_port(current_error_port(sc))) || /* error-port can be #f */
+	  (port_is_closed(current_error_port(sc))))
+	set_current_error_port(sc, sc->standard_error);
+      /* if info is not a list, send object->string to current error port,
+       *   else assume car(info) is a format control string, and cdr(info) are its args
+       * if at all possible, get some indication of where we are!
+       */
+
+      if ((!is_pair(info)) ||
+	  (!is_string(car(info))))
+	format_to_error_port(sc, "\n;~S ~S", set_plist_2(sc, type, info), 7);
+      else
+	{
+	  /* it's possible that the error string is just a string -- not intended for format */
+	  if ((type != sc->format_error_symbol) &&      /* avoid an infinite loop of format errors */
+	      (strchr(string_value(car(info)), '~')))
+	    {
+	      s7_int len = string_length(car(info)) + 8;
+	      block_t *b = mallocate(sc, len);
+	      char *errstr = (char *)block_data(b);
+	      s7_int str_len = catstrs_direct(errstr, "\n;", string_value(car(info)), (const char *)NULL);
+	      format_to_error_port(sc, errstr, cdr(info), str_len);
+	      liberate(sc, b);
+	    }
+	  else format_to_error_port(sc, "\n;~S ~S", set_plist_2(sc, type, info), 7); /* 7 = ctrl str len */
+	}
+      if (op < 32) sc->print_length = op;
+
+      /* now display location at end */
+      if (is_string(slot_value(sc->error_file)))
+	{
+	  s7_newline(sc, current_error_port(sc));
+	  format_to_error_port(sc, ";    ~A\n", set_plist_1(sc, object_to_string_truncated(sc, cur_code)), 8);
+	  format_to_error_port(sc, ";    ~A, line ~D, position: ~D\n",
+			 set_plist_3(sc, slot_value(sc->error_file), slot_value(sc->error_line), slot_value(sc->error_position)), 31);
+	}
+      else
+	{
+	  if ((is_input_port(current_input_port(sc))) &&
+	      (port_file(current_input_port(sc)) != stdin) &&
+	      (!port_is_closed(current_input_port(sc))))
+	    {
+	      const char *filename = port_filename(current_input_port(sc));
+	      int32_t line = port_line_number(current_input_port(sc));
+
+	      if (filename)
+		format_to_error_port(sc, "\n;  ~A[~D]",
+			       set_plist_2(sc, wrap_string(sc, filename, port_filename_length(current_input_port(sc))),
+					   wrap_integer(sc, line)), 10);
+	      else
+		if ((line > 0) &&
+		    (integer(slot_value(sc->error_line)) > 0))
+		  format_to_error_port(sc, "\n;  line ~D", set_plist_1(sc, wrap_integer(sc, line)), 11);
+		else
+		  if (sc->input_port_stack_loc > 0)
+		    {
+		      s7_pointer p = sc->input_port_stack[sc->input_port_stack_loc - 1];
+		      if ((is_input_port(p)) &&
+			  (port_file(p) != stdin) &&
+			  (!port_is_closed(p)))
+			{
+			  filename = port_filename(p);
+			  line = port_line_number(p);
+			  if (filename)
+			    format_to_error_port(sc, "\n;  ~A[~D]",
+					   set_plist_2(sc, wrap_string(sc, filename, port_filename_length(current_input_port(sc))),
+						       wrap_integer(sc, line)), 10);
+			}}}
+	  else
+	    {
+	      const char *call_name = sc->s7_call_name;
+	      if (call_name)
+		{
+		  sc->s7_call_name = NULL;
+		  if ((sc->s7_call_file) &&
+		      (sc->s7_call_line >= 0))
+		    format_to_error_port(sc, "\n;  ~A ~A[~D]",
+				   set_plist_3(sc,
+					       s7_make_string_wrapper(sc, call_name),
+					       s7_make_string_wrapper(sc, sc->s7_call_file),
+					       wrap_integer(sc, sc->s7_call_line)), 13);
+		}}
+	  s7_newline(sc, current_error_port(sc));
+	}
+      /* look for __func__ in the error environment etc */
+      if (current_error_port(sc) != sc->F)
+	{
+	  s7_pointer errp = s7_stacktrace(sc);
+	  if (string_length(errp) > 0)
+	    {
+	      port_write_string(current_error_port(sc))(sc, string_value(errp), string_length(errp), current_error_port(sc));
+	      port_write_character(current_error_port(sc))(sc, '\n', current_error_port(sc));
+	    }}
+      else
+	if (is_pair(slot_value(sc->error_code)))
+	  {
+	    format_to_error_port(sc, ";    ~S", set_plist_1(sc, slot_value(sc->error_code)), 7);
+	    s7_newline(sc, current_error_port(sc));
+	  }
+      /* if (is_continuation(type))
+       *   go into repl here with access to continuation?  Or expect *error-handler* to deal with it?
+       */
+      sc->value = type;
+      sc->cur_op = OP_ERROR_QUIT;
+    }
+  LongJmp(*(sc->goto_start), ERROR_JUMP);
+}
+
+s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info) /* s7.h backwards compatibility */
+{
+  error_nr(sc, type, info);
+  /* info is a temporary value -- do not expect it to be useful beyond the error handler procedure itself */
+  return(type);
+}
+
+static noreturn void read_error_1_nr(s7_scheme *sc, const char *errmsg, bool string_error)
+{
+  /* read errors happen before the evaluator gets involved, so forms such as:
+   *   (catch #t (lambda () (car '( . ))) (lambda arg 'error))
+   * do not catch the error if we simply signal an error when we encounter it.
+   */
+  s7_pointer pt = current_input_port(sc);
+
+  if (!string_error)
+    {
+      /* make an heroic effort to find where we slid off the tracks */
+      if (is_string_port(current_input_port(sc)))
+	{
+          #define QUOTE_SIZE 40
+	  s7_int i, j, start = 0, end, slen, size;
+	  char *recent_input = NULL;
+
+	  /* we can run off the end in cases like (eval-string "(. . ,.)") or (eval-string " (@ . ,.)") */
+	  if (port_position(pt) >= port_data_size(pt))
+	    port_position(pt) = port_data_size(pt) - 1;
+
+	  /* start at current position and look back a few chars */
+	  for (i = port_position(pt), j = 0; (i > 0) && (j < QUOTE_SIZE); i--, j++)
+	    if ((port_data(pt)[i] == '\0') || (port_data(pt)[i] == '\n') || (port_data(pt)[i] == '\r'))
+	      break;
+	  start = i;
+
+	  /* start at current position and look ahead a few chars */
+	  size = port_data_size(pt);
+	  for (i = port_position(pt), j = 0; (i < size) && (j < QUOTE_SIZE); i++, j++)
+	    if ((port_data(pt)[i] == '\0') || (port_data(pt)[i] == '\n') || (port_data(pt)[i] == '\r'))
+	      break;
+	  end = i;
+
+	  slen = end - start;  /* hopefully this is more or less the current line where the read error happened */
+	  if (slen > 0)
+	    {
+	      recent_input = (char *)Calloc(slen + 9, 1);
+	      for (i = 0; i < (slen + 8); i++) recent_input[i] = '.';
+	      recent_input[3] = ' ';
+	      recent_input[slen + 4] = ' ';
+	      for (i = 0; i < slen; i++) recent_input[i + 4] = port_data(pt)[start + i];
+	    }
+
+	  if ((port_line_number(pt) > 0) &&
+	      (port_filename(pt)))
+	    {
+	      s7_int len = safe_strlen(recent_input) + safe_strlen(errmsg) + port_filename_length(pt) + safe_strlen(sc->current_file) + 64;
+	      s7_pointer p = make_empty_string(sc, len, '\0');
+	      char *msg = string_value(p);
+	      string_length(p) = snprintf(msg, len, "%s: %s %s[%u], last top-level form at: %s[%" ld64 "]",
+					  errmsg, (recent_input) ? recent_input : "", port_filename(pt), port_line_number(pt),
+					  sc->current_file, sc->current_line);
+	      if (recent_input) free(recent_input);
+	      error_nr(sc, sc->read_error_symbol, set_elist_1(sc, p));
+	    }
+	  else
+	    {
+	      s7_int len = safe_strlen(recent_input) + safe_strlen(errmsg) + safe_strlen(sc->current_file) + 64;
+	      s7_pointer p = make_empty_string(sc, len, '\0');
+	      char *msg = string_value(p);
+	      if ((sc->current_file) &&
+		  (sc->current_line >= 0))
+		string_length(p) = snprintf(msg, len, "%s: %s, last top-level form at %s[%" ld64 "]",
+					    errmsg, (recent_input) ? recent_input : "",
+					    sc->current_file, sc->current_line);
+	      else string_length(p) = snprintf(msg, len, "%s: %s", errmsg, (recent_input) ? recent_input : "");
+	      if (recent_input) free(recent_input);
+	      error_nr(sc, sc->read_error_symbol, set_elist_1(sc, p));
+	    }}}
+
+  if ((port_line_number(pt) > 0) &&
+      (port_filename(pt)))
+    {
+      s7_int nlen = 0;
+      s7_int len = safe_strlen(errmsg) + port_filename_length(pt) + safe_strlen(sc->current_file) + 128;
+      s7_pointer p = make_empty_string(sc, len, '\0');
+      char *msg = string_value(p);
+      if (string_error)
+	nlen = snprintf(msg, len, "%s %s[%u],\n;  possible culprit: \"%s...\"\n;  last top-level form at %s[%" ld64 "]",
+		       errmsg, port_filename(pt), port_line_number(pt),
+		       sc->strbuf, sc->current_file, sc->current_line);
+      else nlen = snprintf(msg, len, "%s %s[%u], last top-level form at %s[%" ld64 "]",
+			  errmsg, port_filename(pt), port_line_number(pt),
+			  sc->current_file, sc->current_line);
+      string_length(p) = nlen;
+      error_nr(sc, sc->read_error_symbol, set_elist_1(sc, p));
+    }
+  error_nr(sc, (string_error) ? sc->string_read_error_symbol : sc->read_error_symbol,
+	   set_elist_1(sc, s7_make_string_wrapper(sc, errmsg)));
+}
+
+static noreturn void read_error_nr(s7_scheme *sc, const char *errmsg) {read_error_1_nr(sc, errmsg, false);}
+static noreturn void string_read_error_nr(s7_scheme *sc, const char *errmsg) {read_error_1_nr(sc, errmsg, true);}
+
+static s7_pointer g_error(s7_scheme *sc, s7_pointer args)
+{
+  #define H_error "(error type ...) signals an error.  The 'type' can be used with catch to trap \
+particular errors.  If the error is not caught, s7 treats the second argument as a format control string, \
+and applies it to the rest of the arguments."
+  #define Q_error s7_make_circular_signature(sc, 1, 2, sc->values_symbol, sc->T)
+
+  if (is_string(car(args)))  /* a CL-style error -- use tag='no-catch */
+    error_nr(sc, make_symbol(sc, "no-catch", 8), args);
+  error_nr(sc, car(args), cdr(args));
+  return(sc->unspecified);
+}
+
+static char *truncate_string(char *form, s7_int len, use_write_t use_write)
+{
+  uint8_t *f = (uint8_t *)form;
+  s7_int i;
+  if (use_write != P_DISPLAY)
+    {
+      /* I guess we need to protect the outer double quotes in this case */
+      for (i = len - 5; i >= (len / 2); i--)
+	if (is_white_space((int32_t)f[i]))
+	  return(form);
+      i = len - 5;
+      if (i > 0) {form[i] = '.'; form[i + 1] = '.'; form[i + 2] = '.'; form[i + 3] = '"'; form[i + 4] = '\0';}
+      else
+	if (len >= 2)
+	  {
+	    form[len - 1] = '"';
+	    form[len] = '\0';
+	  }}
+  else
+    {
+      for (i = len - 4; i >= (len / 2); i--)
+	if (is_white_space((int32_t)f[i]))
+	  {
+	    form[i] = '.'; form[i + 1] = '.'; form[i + 2] = '.'; form[i + 3] = '\0';
+	    return(form);
+	  }
+      i = len - 4;
+      if (i >= 0) {form[i] = '.'; form[i + 1] = '.'; form[i + 2] = '.'; form[i + 3] = '\0';}
+      else form[len] = '\0';
+    }
+  return(form);
+}
+
+static s7_pointer object_to_string_truncated(s7_scheme *sc, s7_pointer p)
+{
+  s7_pointer strp;
+  s7_int len = sc->print_length;
+  s7_int old_max_len = sc->objstr_max_len;
+  sc->objstr_max_len = len + 2;
+  strp = s7_object_to_string(sc, p, false);
+  sc->objstr_max_len = old_max_len;
+  if (string_length(strp) > len)
+    truncate_string(string_value(strp), len, P_DISPLAY); /* only use of truncate_string */
+  return(strp);
+}
+
+static s7_pointer tree_descend(s7_scheme *sc, s7_pointer p, uint32_t line)
+{
+  s7_pointer tp;
+  if (!is_pair(p)) return(NULL);
+  if (has_location(p))
+    {
+      uint32_t x = (uint32_t)pair_line_number(p);
+      if (x > 0)
+	{
+	  if (line == 0) /* first line number we encounter will be the current reader location (i.e. the end of the form) */
+	    line = x;
+	  else
+	    if (x < line)
+	      return(p);
+	}}
+  tp = tree_descend(sc, car(p), line);
+  return((tp) ? tp : tree_descend(sc, cdr(p), line));
+}
+
+static noreturn void missing_close_paren_error_nr(s7_scheme *sc)
+{
+  char *syntax_msg = NULL;
+  s7_pointer pt = current_input_port(sc);
+
+  if (unchecked_type(sc->curlet) != T_LET)
+    set_curlet(sc, sc->rootlet);
+
+  /* check *missing-close-paren-hook* */
+  if (hook_has_functions(sc->missing_close_paren_hook))
+    {
+      s7_pointer result;
+      if ((port_line_number(pt) > 0) &&
+	  (port_filename(pt)))
+	{
+	  set_integer(slot_value(sc->error_line), port_line_number(pt));
+	  set_integer(slot_value(sc->error_position), port_position(pt));
+	  slot_set_value(sc->error_file, wrap_string(sc, port_filename(pt), port_filename_length(pt)));
+	}
+      result = s7_call(sc, sc->missing_close_paren_hook, sc->nil);
+      if (result != sc->unspecified)
+	g_throw(sc, list_1(sc, result));
+    }
+
+  if (is_pair(sc->args))
+    {
+      s7_pointer p = tree_descend(sc, sc->args, 0);
+      if ((p) && (is_pair(p)) &&
+	  (has_location(p)))
+	{
+	  s7_pointer strp = object_to_string_truncated(sc, p);
+	  char *form = string_value(strp);
+	  s7_int form_len = string_length(strp);
+	  s7_int msg_len = form_len + 128;
+	  syntax_msg = (char *)Malloc(msg_len);
+	  snprintf(syntax_msg, msg_len, ";  current form awaiting a close paren starts around line %u: %s", (uint32_t)pair_line_number(p), form);
+	}}
+
+  if ((port_line_number(pt) > 0) &&
+      (port_filename(pt)))
+    {
+      s7_int nlen;
+      s7_int len = port_filename_length(pt) + safe_strlen(sc->current_file) + safe_strlen(syntax_msg) + 128;
+      s7_pointer p = make_empty_string(sc, len, '\0');
+      char *msg = string_value(p);
+      if (syntax_msg)
+	{
+	  nlen = snprintf(msg, len, "missing close paren, %s[%u], last top-level form at %s[%" ld64 "]\n%s",
+			 port_filename(pt), port_line_number(pt),
+			 sc->current_file, sc->current_line, syntax_msg);
+	  free(syntax_msg);
+	}
+      else nlen = snprintf(msg, len, "missing close paren, %s[%u], last top-level form at %s[%" ld64 "]",
+			  port_filename(pt), port_line_number(pt),
+			  sc->current_file, sc->current_line);
+      string_length(p) = nlen;
+      error_nr(sc, sc->read_error_symbol, set_elist_1(sc, p));
+    }
+
+  if (syntax_msg)
+    {
+      s7_int len = safe_strlen(syntax_msg) + 128;
+      s7_pointer p = make_empty_string(sc, len, '\0');
+      char *msg = string_value(p);
+      len = catstrs(msg, len, "missing close paren\n", syntax_msg, "\n", (char *)NULL);
+      free(syntax_msg);
+      string_length(p) = len;
+      error_nr(sc, sc->read_error_symbol, set_elist_1(sc, p));
+    }
+  if ((is_input_port(pt)) &&
+      (!port_is_closed(pt)) &&
+      (port_data(pt)) &&
+      (port_position(pt) > 0))
+    {
+      s7_pointer p = make_empty_string(sc, 128, '\0');
+      s7_int pos = port_position(pt);
+      s7_int start = pos - 40;
+      char *msg = string_value(p);
+      memcpy((void *)msg, (const void *)"missing close paren: ", 21);
+      if (start < 0) start = 0;
+      memcpy((void *)(msg + 21), (void *)(port_data(pt) + start), pos - start);
+      string_length(p) = 21 + pos - start;
+      error_nr(sc, sc->read_error_symbol, set_elist_1(sc, p));
+    }
+  error_nr(sc, sc->read_error_symbol, set_elist_1(sc, wrap_string(sc, "missing close paren", 19)));
+}
+
+static noreturn void improper_arglist_error_nr(s7_scheme *sc)
+{
+  /* sc->code is the last (dotted) arg, sc->args is the arglist reversed not including sc->code
+   *   the original was `(func ,@(reverse args) . ,code) essentially where func is sc->value or pop_op_stack(sc)
+   */
+  s7_pointer func = pop_op_stack(sc);
+  if (sc->args == sc->nil)               /* (abs . 1) */
+    error_nr(sc, sc->syntax_error_symbol,
+	     set_elist_3(sc, wrap_string(sc, "attempt to evaluate (~S . ~S)?", 30), func, sc->code));
+  error_nr(sc, sc->syntax_error_symbol,
+	   set_elist_4(sc, wrap_string(sc, "attempt to evaluate (~S ~S . ~S)?", 33),
+		       func, sc->args = proper_list_reverse_in_place(sc, sc->args), sc->code));
+}
+
+static void op_error_hook_quit(s7_scheme *sc)
+{
+  let_set_2(sc, closure_let(sc->error_hook), sc->body_symbol, sc->code);  /* restore old value */
+  let_set_2(sc, closure_let(sc->let_temp_hook), sc->body_symbol, sc->nil);
+  /* now mimic the end of the normal error handler.  Since this error hook evaluation can happen
+   *   in an arbitrary s7_call nesting, we can't just return from the current evaluation --
+   *   we have to jump to the original (top-level) call.  Otherwise '#<unspecified> or whatever
+   *   is simply treated as the (non-error) return value, and the higher level evaluations
+   *   get confused.
+   */
+  stack_reset(sc);                                 /* is this necessary? is it a good idea?? */
+  push_stack_op(sc, OP_ERROR_QUIT);                /* added 3-Dec-16: try to make sure we actually exit! */
+  sc->cur_op = OP_ERROR_QUIT;
+  if (sc->longjmp_ok)
+    LongJmp(*(sc->goto_start), ERROR_QUIT_JUMP);
+}
+
+
+/* -------------------------------- begin_hook -------------------------------- */
+void (*s7_begin_hook(s7_scheme *sc))(s7_scheme *sc, bool *val) {return(sc->begin_hook);}
+
+void s7_set_begin_hook(s7_scheme *sc, void (*hook)(s7_scheme *sc, bool *val))
+{
+  sc->begin_hook = hook;
+  sc->begin_op = (hook) ? OP_BEGIN_HOOK : OP_BEGIN_NO_HOOK;
+}
+
+static bool call_begin_hook(s7_scheme *sc)
+{
+  bool result = false;
+  /* originally begin_hook was bool (*hook)(s7_scheme *sc): the value was returned directly,
+   *   rather than going through a *bool arg (&result below).  That works in gcc (Linux/OSX),
+   *   but does not work in MS Visual C++.  In the latter, the compiler apparently completely
+   *   eliminates any local, returning (for example) a thread-relative stack-allocated value
+   *   directly, but then by the time we get here, that variable has vanished, and we get
+   *   garbage.  We had to thwart the optimization by adding if ((flag) && (!flag)) fprintf(...);
+   *   So, in the new form (26-Jun-13), the value is passed directly into an s7 variable
+   *   that I hope can't be optimized out of existence.
+   *
+   * cm/src/Scheme.cpp, used in Snd (listener looking for C-g I think)
+   *   originally this facility was aimed at interrupting infinite loops, and the expected usage was:
+   *     set begin_hook, eval-string(...), unset begin_hook
+   */
+  opcode_t op = sc->cur_op;
+  push_stack_direct(sc, OP_BARRIER);
+  sc->begin_hook(sc, &result);
+  if (result)
+    {
+      s7_pointer cur_code = current_code(sc);
+      /* set (owlet) in case we were interrupted and need to see why something was hung */
+      slot_set_value(sc->error_type, sc->F);
+      slot_set_value(sc->error_data, sc->value); /* was sc->F but we now clobber this below */
+      slot_set_value(sc->error_code, cur_code);
+      if (has_location(cur_code))
+	{
+	  set_integer(slot_value(sc->error_line), (s7_int)pair_line_number(cur_code));
+	  slot_set_value(sc->error_file, sc->file_names[pair_file_number(cur_code)]);
+	  set_integer(slot_value(sc->error_position), (s7_int)pair_position(cur_code));
+	}
+      else
+	{
+	  set_integer(slot_value(sc->error_line), 0);
+	  set_integer(slot_value(sc->error_position), 0);
+	  slot_set_value(sc->error_file, sc->F);
+	}
+#if WITH_HISTORY
+      slot_set_value(sc->error_history, sc->F);
+#endif
+      let_set_outlet(sc->owlet, sc->curlet);
+      sc->value = make_symbol(sc, "begin-hook-interrupt", 20);
+      /* otherwise the evaluator returns whatever random thing is in sc->value (normally #<closure>)
+       *   which makes debugging unnecessarily difficult. ?? why not return something useful? make return s7_pointer*, not bool*
+       */
+      s7_quit(sc);     /* don't call gc here -- eval_c_string is the context -- allows interrupt of infinite loop */
+      return(true);
+    }
+  pop_stack_no_op(sc);
+  sc->cur_op = op;     /* for better error handling.  otherwise we get "barrier" as the offending function name in syntax_error */
+  return(false);
+}
+
+
+/* -------------------------------- apply -------------------------------- */
+static s7_pointer apply_list_star(s7_scheme *sc, s7_pointer d)
+{
+  /* we check this ahead of time: if (is_null(cdr(d))) return(car(d)); */
+  s7_pointer p;
+  gc_protect_via_stack(sc, d);
+  p = cons(sc, car(d), cdr(d));
+  sc->w = p;
+  while (is_not_null(cddr(p)))
+    {
+      d = cdr(d);
+      set_cdr(p, cons(sc, car(d), cdr(d)));
+      if (is_not_null(cdr(d)))
+	p = cdr(p);
+    }
+  unstack_gc_protect(sc);
+  set_cdr(p, cadr(p));
+  return(sc->w);
+}
+
+static noreturn void apply_list_error_nr(s7_scheme *sc, s7_pointer lst)
+{
+  error_nr(sc, sc->wrong_type_arg_symbol,
+	   set_elist_2(sc, wrap_string(sc, "apply's last argument should be a proper list: ~S", 49), lst));
+}
+
+static s7_pointer g_apply(s7_scheme *sc, s7_pointer args)
+{
+  #define H_apply "(apply func ...) applies func to the rest of the arguments"
+  #define Q_apply s7_make_circular_signature(sc, 2, 3, sc->values_symbol, s7_make_signature(sc, 2, sc->is_procedure_symbol, sc->is_sequence_symbol), sc->T)
+
+  /* can apply always be replaced with apply values? (apply + '(1 2 3)) is the same as (+ (apply values '(1 2 3)))
+   * not if apply* in disguise, I think: (apply + 1 2 ()) -> 3, (apply + 1 2 (apply values ())) -> error
+   */
+  s7_pointer func = car(args);
+  if (!is_applicable(func))
+    apply_error_nr(sc, func, cdr(args));
+
+  if (is_null(cdr(args)))
+    {
+      push_stack(sc, OP_APPLY, sc->nil, func);
+      return(sc->nil);
+    }
+  if (is_safe_procedure(func))
+    {
+      s7_pointer p, q;
+      for (q = args, p = cdr(args); is_not_null(cdr(p)); q = p, p = cdr(p));
+      /* the last arg is supposed to be a list, it will be spliced onto the end of the previous arg list (if any) below */
+
+      if (!s7_is_proper_list(sc, car(p))) /* (apply + #f) etc, the cycle protection here is checked in s7test */
+	apply_list_error_nr(sc, args);
+      set_cdr(q, car(p));                 /* args affected, so don't depend on cdr(args) from above */
+
+      if (is_c_function(func))            /* handle in-place to get better error messages */
+	{
+	  s7_int len;
+	  uint8_t typ = type(func);
+	  if (typ == T_C_RST_NO_REQ_FUNCTION)
+	    return(c_function_call(func)(sc, cdr(args)));
+	  len = proper_list_length(cdr(args));
+	  if (c_function_max_args(func) < len)
+	    error_nr(sc, sc->wrong_number_of_args_symbol,
+		     set_elist_3(sc, too_many_arguments_string, func, set_ulist_1(sc, sc->apply_symbol, args)));
+	  if ((typ == T_C_FUNCTION) &&
+	      (len < c_function_min_args(func)))
+	    error_nr(sc, sc->wrong_number_of_args_symbol,
+		     set_elist_3(sc, not_enough_arguments_string, func, set_ulist_1(sc, sc->apply_symbol, args)));
+	  return(c_function_call(func)(sc, cdr(args)));
+	}
+      push_stack(sc, OP_APPLY, cdr(args), func);
+      return(sc->nil);
+    }
+  sc->code = func;
+  sc->args = (is_null(cddr(args))) ? cadr(args) : apply_list_star(sc, cdr(args));
+  if (!s7_is_proper_list(sc, sc->args))
+    apply_list_error_nr(sc, sc->args);
+
+  /* (define imp (immutable! (cons 0 (immutable! (cons 1 (immutable! (cons 2 ())))))))
+   * (define (fop4 x y) (apply x y))
+   * (display (object->string (apply (lambda (a . b) (cons a b)) imp) :readable)) -> (list 0 1 2)
+   * (display (object->string (fop4 (lambda (a . b) (cons a b)) imp) :readable)) -> (cons 0 (immutable! (cons 1 (immutable! (cons 2 ())
+   * g_apply sees the first one and thinks the lambda arg is unsafe, apply_ss sees the second and thinks it is safe (hence the list is not copied),
+   * so calling sort on the first is fine, but on the second gets an immutable object error.
+   */
+  sc->args = (needs_copied_args(sc->code)) ? copy_proper_list(sc, sc->args) : sc->args;
+  push_stack_direct(sc, OP_APPLY);
+  return(sc->nil);
+}
+
+s7_pointer s7_apply_function(s7_scheme *sc, s7_pointer fnc, s7_pointer args)
+{
+  TRACK(sc);
+  if (is_c_function(fnc))
+    return(c_function_call(fnc)(sc, args));
+  /* if [if (!is_applicable(fnc)) apply_error_nr(sc, fnc, sc->args);] here, needs_copied_args can be T_App */
+  push_stack_direct(sc, OP_EVAL_DONE);
+  sc->code = fnc;
+  sc->args = (needs_copied_args(sc->code)) ? copy_proper_list(sc, args) : args;
+  eval(sc, OP_APPLY);
+  /* we're limited in choices here -- the caller might be (say) car(sc->t1_1) = fn_proc(...) where the fn_proc
+   *   happens to fallback on a method -- we can't just push OP_APPLY and drop back into the evaluator normally.
+   */
+  return(sc->value);
+}
+
+static s7_pointer apply_method_closure(s7_scheme *sc, s7_pointer func, s7_pointer args)
+{
+  push_stack_direct(sc, OP_EVAL_DONE);
+  sc->code = func;
+  sc->args = (needs_copied_args(sc->code)) ? copy_proper_list(sc, args) : args;
+  set_curlet(sc, make_let(sc, closure_let(sc->code)));
+  eval(sc, OP_APPLY_LAMBDA);
+  return(sc->value);
+}
+
+static s7_pointer apply_c_function_unopt(s7_scheme *sc, s7_pointer func, s7_pointer args);
+
+static s7_pointer implicit_index_checked(s7_scheme *sc, s7_pointer obj, s7_pointer in_obj, s7_pointer indices)
+{
+  if (!is_applicable(in_obj))
+    error_nr(sc, sc->syntax_error_symbol,
+	     set_elist_4(sc, wrap_string(sc, "~$ becomes ~$, but ~S can't take arguments", 42),
+			 set_ulist_1(sc, obj, indices), cons(sc, in_obj, cdr(indices)), in_obj));
+  return(implicit_index(sc, in_obj, cdr(indices)));
+}
+
+static s7_pointer implicit_index(s7_scheme *sc, s7_pointer obj, s7_pointer indices)
+{
+  /* (let ((lst '("12" "34"))) (lst 0 1)) -> #\2
+   * (let ((lst (list #(1 2) #(3 4)))) (lst 0 1)) -> 2
+   * this can get tricky: ((list (lambda (a) (+ a 1)) (lambda (b) (* b 2))) 1 2) -> 4
+   * but what if func takes rest/optional args, etc: ((list (lambda args (car args))) 0 "hi" 0)
+   *   should this return #\h or "hi"?? currently it is "hi" which is consistent with ((lambda args (car args)) "hi" 0)
+   * but ((lambda (arg) arg) "hi" 0) is currently an error (too many arguments)
+   * maybe it should be (((lambda (arg) arg) "hi") 0) -> #\h
+   */
+  s7_pointer res, in_obj;
+  switch (type(obj))
+    {
+    case T_VECTOR:                       /* (#(#(1 2) #(3 4)) 1 1) -> 4 */
+      return(vector_ref_1(sc, obj, indices));
+
+    case T_FLOAT_VECTOR:
+      res = univect_ref(sc, set_ulist_1(sc, obj, indices), sc->float_vector_ref_symbol, T_FLOAT_VECTOR);
+      set_car(sc->u1_1, sc->F);
+      return(res);
+
+    case T_INT_VECTOR:
+      res = univect_ref(sc, set_ulist_1(sc, obj, indices), sc->int_vector_ref_symbol, T_INT_VECTOR);
+      set_car(sc->u1_1, sc->F);
+      return(res);
+
+    case T_BYTE_VECTOR:
+      res = univect_ref(sc, set_ulist_1(sc, obj, indices), sc->byte_vector_ref_symbol, T_BYTE_VECTOR);
+      set_car(sc->u1_1, sc->F);
+      return(res);
+
+    case T_STRING:                       /* (#("12" "34") 0 1) -> #\2 */
+      if (!is_null(cdr(indices)))
+	error_nr(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, too_many_arguments_string, obj, indices));
+      if (!is_t_integer(car(indices)))
+	wrong_type_error_nr(sc, sc->string_ref_symbol, 2, car(indices), sc->type_names[T_INTEGER]);
+      return(string_ref_p_pi_unchecked(sc, obj, integer(car(indices))));
+
+    case T_PAIR:                         /* (#((1 2) (3 4)) 1 0) -> 3, (#((1 (2 3))) 0 1 0) -> 2 */
+      in_obj = list_ref_1(sc, obj, car(indices));
+      if (is_pair(cdr(indices)))
+	return(implicit_index_checked(sc, obj, in_obj, indices));
+      return(in_obj);
+
+    case T_HASH_TABLE:                   /* ((vector (hash-table '(a . 1) '(b . 2))) 0 'a) -> 1 */
+      in_obj = s7_hash_table_ref(sc, obj, car(indices));
+      if (is_pair(cdr(indices)))
+	return(implicit_index_checked(sc, obj, in_obj, indices));
+      return(in_obj);
+
+    case T_LET:
+      in_obj = let_ref(sc, obj, car(indices));
+      if (is_pair(cdr(indices)))
+	return(implicit_index_checked(sc, obj, in_obj, indices));
+      return(in_obj);
+
+    case T_C_OBJECT:
+      res = (*(c_object_ref(sc, obj)))(sc, set_ulist_1(sc, obj, indices));
+      set_car(sc->u1_1, sc->F);
+      return(res);
+
+    case T_ITERATOR: /* indices is not nil, so this is an error */
+      error_nr(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, too_many_arguments_string, obj, indices));
+
+    case T_CLOSURE: case T_CLOSURE_STAR:
+      if (!is_safe_closure(obj))               /* s7_call can't work in general with unsafe stuff */
+	error_nr(sc, sc->syntax_error_symbol,  /* ((list (lambda (x) (values x x))) 0 1) */
+		 set_elist_3(sc, wrap_string(sc, "can't call a (possibly unsafe) function implicitly: ~S ~S", 57), obj, indices));
+      check_stack_size(sc);
+      sc->temp10 = indices; /* (needs_copied_args(obj)) ? copy_proper_list(sc, indices) : indices; */ /* s7_call copies and this is safe? 2-Oct-22 (and below) */
+      sc->value = s7_call(sc, obj, sc->temp10);
+      sc->temp10 = sc->unused;
+      if ((S7_DEBUGGING) && (is_multiple_value(sc->value))) fprintf(stderr, "mv: %s %s %s\n", display(obj), display(indices), display(sc->value));
+      /* if mv: sc->value = splice_in_values(sc, multiple_value(sc->value)); */
+      return(sc->value);
+
+    case T_C_FUNCTION: /* probably something like ((list abs) 0 -1) */
+      return(apply_c_function_unopt(sc, obj, indices));
+
+    case T_C_RST_NO_REQ_FUNCTION:
+      return(c_function_call(obj)(sc, indices));
+
+    default:
+      if (!is_applicable(obj)) /* (#2d((0 0)(0 0)) 0 0 0) */
+	apply_error_nr(sc, obj, indices);
+      sc->temp10 = indices; /* (needs_copied_args(obj)) ? copy_proper_list(sc, indices) : indices; */ /* do not use sc->args here! */
+      sc->value = s7_call(sc, obj, sc->temp10);
+      sc->temp10 = sc->unused;
+      if (is_multiple_value(sc->value))
+	sc->value = splice_in_values(sc, multiple_value(sc->value));
+      return(sc->value);
+    }
+}
+
+static inline void fill_star_defaults(s7_scheme *sc, s7_pointer func, int32_t start_arg, int32_t n_args, s7_pointer par)
+{
+  s7_pointer *df = c_function_arg_defaults(func);
+  if (c_func_has_simple_defaults(func))
+    for (int32_t i = start_arg; i < n_args; i++, par = cdr(par))
+      set_car(par, df[i]);
+  else
+    for (int32_t i = start_arg; i < n_args; i++, par = cdr(par))
+      {
+	s7_pointer defval = df[i];
+	if (is_symbol(defval))
+	  set_car(par, lookup_checked(sc, defval));
+	else set_car(par, (is_pair(defval)) ? s7_eval(sc, defval, sc->rootlet) : defval);
+      }
+}
+
+static s7_pointer set_c_function_star_args(s7_scheme *sc)
+{
+  int32_t i, j;
+  s7_pointer arg, par, call_args, func = sc->code;
+  s7_pointer *df;
+  int32_t n_args = c_function_max_args(func);     /* not counting keywords, I think */
+
+  if (is_safe_procedure(func))
+    call_args = c_function_call_args(func);
+  else
+    {
+      call_args = make_list(sc, c_function_optional_args(func), sc->F);
+      gc_protect_via_stack(sc, call_args);
+    }
+
+  /* assume at the start that there are no keywords */
+  for (i = 0, arg = sc->args, par = call_args; (i < n_args) && (is_pair(arg)); i++, arg = cdr(arg), par = cdr(par))
+    if (!is_symbol_and_keyword(car(arg)))
+      set_car(par, car(arg));
+    else
+      {
+	s7_pointer kpar, karg;
+	int32_t ki;
+	/* oops -- there are keywords, change scanners (much duplicated code...)
+	 *   setting checked on the call_args here rather than parsing the parameters to use add_symbol_to_list
+	 */
+	for (kpar = call_args; kpar != par; kpar = cdr(kpar))
+	  set_checked(kpar);
+	for (; is_pair(kpar); kpar = cdr(kpar))
+	  clear_checked(kpar);
+	df = c_function_arg_names(func); /* changed to use symbols here, not keywords 2-Jan-24 */
+	for (ki = i, karg = arg, kpar = par; (ki < n_args) && (is_pair(karg)); ki++, karg = cdr(karg))
+	  if (!is_symbol_and_keyword(car(karg)))
+	    {
+	      if (is_checked(kpar))
+		{
+		  if (!is_safe_procedure(func)) unstack_gc_protect(sc);
+		  error_nr(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, parameter_set_twice_string, car(kpar), sc->args));
+		}
+	      set_checked(kpar);
+	      set_car(kpar, car(karg));
+	      kpar = cdr(kpar);
+	    }
+	  else
+	    {
+	      s7_pointer p;
+	      for (j = 0, p = call_args; j < n_args; j++, p = cdr(p))
+		if (df[j] == keyword_symbol(car(karg)))
+		  break;
+	      if (j == n_args)
+		{
+		  if (!c_function_allows_other_keys(func))
+		    {
+		      if (!is_safe_procedure(func)) unstack_gc_protect(sc);
+		      error_nr(sc, sc->wrong_type_arg_symbol,
+			       set_elist_2(sc, wrap_string(sc, "~A is not a parameter name?", 27), car(karg)));
+		    }
+		  karg = cdr(karg);
+		  if (is_null(karg)) /* (f :x) where f arglist includes :allow-other-keys */
+		    {
+		      if (!is_safe_procedure(func)) unstack_gc_protect(sc);
+		      error_nr(sc, sc->syntax_error_symbol,
+			       set_elist_4(sc, wrap_string(sc, "~A: key ~S, but no value: ~S", 28), func, car(arg), sc->args));
+		    }
+		  ki--;
+		}
+	      else
+		{
+		  if (is_checked(p))
+		    {
+		      if (!is_safe_procedure(func)) unstack_gc_protect(sc);
+		      error_nr(sc, sc->wrong_type_arg_symbol,
+			       set_elist_3(sc, parameter_set_twice_string, car(p), sc->args));
+		    }
+		  if (!is_pair(cdr(karg)))
+		    {
+		      if (!is_safe_procedure(func)) unstack_gc_protect(sc);
+		      error_nr(sc, sc->syntax_error_symbol,
+			       set_elist_4(sc, wrap_string(sc, "~A: key ~S, but no value: ~S", 28), func, car(karg), sc->args));
+		    }
+		  set_checked(p);
+		  karg = cdr(karg);
+		  set_car(p, car(karg));
+		  kpar = cdr(kpar);
+		}}
+	if ((!is_null(karg)) && (!c_function_allows_other_keys(func)))
+	  {
+	    if (!is_safe_procedure(func)) unstack_gc_protect(sc);
+	    error_nr(sc, sc->wrong_number_of_args_symbol,
+		     set_elist_4(sc, wrap_string(sc, "~A: too many arguments: (~A~{~^ ~S~})", 37), func, func, sc->args));
+	  }
+	if (ki < n_args)
+	  {
+	    df = c_function_arg_defaults(func);
+	    if (c_func_has_simple_defaults(func))
+	      {
+		for (ki = i, kpar = par; ki < n_args; ki++, kpar = cdr(kpar))
+		  if (!is_checked(kpar))
+		    set_car(kpar, df[ki]);
+	      }
+	    else
+	      for (ki = i, kpar = par; ki < n_args; ki++, kpar = cdr(kpar))
+		if (!is_checked(kpar))
+		  {
+		    s7_pointer defval = df[ki];
+		    if (is_symbol(defval))
+		      set_car(kpar, lookup_checked(sc, defval));
+		    else set_car(kpar, (is_pair(defval)) ? s7_eval(sc, defval, sc->rootlet) : defval);
+		  }}
+	if (!is_safe_procedure(func)) unstack_gc_protect(sc);
+	return(call_args);
+      }
+  if (!is_null(arg))
+    {
+      if (!is_safe_procedure(func)) unstack_gc_protect(sc);
+      error_nr(sc, sc->wrong_number_of_args_symbol,
+	       set_elist_4(sc, wrap_string(sc, "~A: too many arguments: (~A~{~^ ~S~})", 37), func, func, sc->args));
+    }
+  if (i < n_args)
+    fill_star_defaults(sc, func, i, n_args, par);
+  if (!is_safe_procedure(func)) unstack_gc_protect(sc);
+  return(call_args);
+}
+
+static s7_pointer set_c_function_star_defaults(s7_scheme *sc, int32_t num)
+{
+  s7_pointer call_args, func = sc->code, par;
+  int32_t n_args = c_function_max_args(func);
+
+  if (is_safe_procedure(func))
+    call_args = c_function_call_args(func);
+  else
+    {
+      call_args = make_list(sc, c_function_optional_args(func), sc->F);
+      gc_protect_via_stack(sc, call_args);
+    }
+  par = call_args;
+  if (num == 1)
+    {
+      set_car(par, car(sc->args));
+      par = cdr(par);
+    }
+  fill_star_defaults(sc, func, num, n_args, par);
+  if (!is_safe_procedure(func)) unstack_gc_protect(sc);
+  return(call_args);
+}
+
+#define apply_c_function_star(Sc) Sc->value = c_function_call(Sc->code)(Sc, set_c_function_star_args(Sc))
+#define apply_c_function_star_fill_defaults(Sc, Num) Sc->value = c_function_call(Sc->code)(Sc, set_c_function_star_defaults(Sc, Num))
+
+s7_pointer s7_apply_function_star(s7_scheme *sc, s7_pointer fnc, s7_pointer args)
+{
+  TRACK(sc);
+  if (is_c_function_star(fnc))
+    {
+      sc->w = sc->args;
+      sc->z = sc->code;
+      sc->args = T_Ext(args);
+      sc->code = fnc;
+      apply_c_function_star(sc);
+      sc->args = sc->w;
+      sc->code = sc->z;
+      return(sc->value);
+    }
+  push_stack_direct(sc, OP_EVAL_DONE);
+  sc->code = fnc;
+  sc->args = (needs_copied_args(sc->code)) ? copy_proper_list(sc, args) : args;
+  eval(sc, OP_APPLY);
+  return(sc->value);
+}
+
+/* -------------------------------- eval -------------------------------- */
+s7_pointer s7_eval(s7_scheme *sc, s7_pointer code, s7_pointer e)
+{
+  declare_jump_info();
+  TRACK(sc);
+  if (sc->safety > NO_SAFETY)
+    {
+      if (!s7_is_valid(sc, code))
+	s7_warn(sc, 256, "the second argument to %s (the code to be evaluated): %p, is not an s7 object\n", __func__, code);
+      if (!s7_is_valid(sc, e))
+	s7_warn(sc, 256, "the third argument to %s (the environment): %p, is not an s7 object\n", __func__, e);
+    }
+  store_jump_info(sc);
+  set_jump_info(sc, EVAL_SET_JUMP);
+  if (jump_loc != NO_JUMP)
+    {
+      if (jump_loc != ERROR_JUMP)
+	eval(sc, sc->cur_op);
+    }
+  else
+    {
+      push_stack_direct(sc, OP_EVAL_DONE);
+      sc->code = code;
+      set_curlet(sc, (is_let(e)) ? e : sc->rootlet);
+      eval(sc, OP_EVAL);
+    }
+  restore_jump_info(sc);
+
+  if (is_multiple_value(sc->value))
+    sc->value = splice_in_values(sc, multiple_value(sc->value));
+  return(sc->value);
+}
+
+s7_pointer s7_eval_with_location(s7_scheme *sc, s7_pointer code, s7_pointer e, const char *caller, const char *file, s7_int line)
+{
+  s7_pointer result;
+  if (caller)
+    {
+      sc->s7_call_name = caller;
+      sc->s7_call_file = file;
+      sc->s7_call_line = line;
+    }
+  result = s7_eval(sc, code, (e == sc->nil) ? sc->rootlet : e);
+  if (caller)
+    {
+      sc->s7_call_name = NULL;
+      sc->s7_call_file = NULL;
+      sc->s7_call_line = -1;
+    }
+  return(result);
+}
+
+static s7_pointer g_eval(s7_scheme *sc, s7_pointer args)
+{
+  #define H_eval "(eval code (let (curlet))) evaluates code in the environment let. 'let' \
+defaults to the curlet; to evaluate something in the top-level environment instead, \
+pass (rootlet):\n\
+\n\
+  (define x 32) \n\
+  (let ((x 3))\n\
+    (eval 'x (rootlet)))\n\
+\n\
+  returns 32"
+  #define Q_eval s7_make_signature(sc, 3, sc->values_symbol, sc->T, sc->is_let_symbol)
+
+  if (is_not_null(cdr(args)))
+    {
+      s7_pointer e = cadr(args);
+      if (!is_let(e))
+	wrong_type_error_nr(sc, sc->eval_symbol, 2, e, a_let_string);
+      set_curlet(sc, e);
+    }
+  sc->code = car(args);
+
+  if ((sc->safety > NO_SAFETY) &&
+      (is_pair(sc->code)))
+    {
+      check_free_heap_size(sc, 8192);
+      sc->code = copy_body(sc, sc->code);
+    }
+  else
+    if (is_optimized(sc->code))
+      clear_all_optimizations(sc, sc->code); /* clears "unsafe" ops, not all ops */
+
+  set_current_code(sc, sc->code);
+  if (stack_top(sc) < 12)
+    push_stack_op(sc, OP_BARRIER);
+  push_stack_direct(sc, OP_EVAL);
+  return(sc->nil);
+}
+
+
+s7_pointer s7_call(s7_scheme *sc, s7_pointer func, s7_pointer args)
+{
+  if (is_c_function(func))
+    return(c_function_call(func)(sc, args));         /* no check for wrong-number-of-args -- is that reasonable? maybe use apply_c_function(sc, func, args) */
+  {
+    declare_jump_info();
+    TRACK(sc);
+    set_current_code(sc, history_cons(sc, func, args));
+    if (SHOW_EVAL_OPS) safe_print(fprintf(stderr, "%s: %s %s\n", __func__, display_truncated(func), display_truncated(args)));
+
+    sc->temp4 = T_App(func);                           /* this is feeble GC protection */
+    sc->temp2 = T_Lst(args);                           /* only use of temp2 */
+
+    store_jump_info(sc);
+    set_jump_info(sc, S7_CALL_SET_JUMP);
+    if (jump_loc != NO_JUMP)
+      {
+	if (jump_loc != ERROR_JUMP)
+	  eval(sc, sc->cur_op);
+
+	if ((jump_loc == CATCH_JUMP) &&                /* we're returning (back to eval) from an error in catch */
+	    (sc->stack_end == sc->stack_start))
+	  push_stack_op(sc, OP_ERROR_QUIT);
+      }
+    else
+      {
+	if (sc->safety > NO_SAFETY)
+	  check_list_validity(sc, __func__, args);
+	push_stack_direct(sc, OP_EVAL_DONE); /* this saves the current evaluation and will eventually finish this (possibly) nested call */
+	sc->code = func;
+	sc->args = (needs_copied_args(func)) ? copy_proper_list(sc, args) : args;
+	eval(sc, OP_APPLY);
+      }
+    restore_jump_info(sc);
+    /* don't clear temp4 or temp2 here -- lots of (Snd) code calls s7_call repeatedly and assumes the "func" arg is protected between calls */
+    return(sc->value);
+  }
+}
+
+s7_pointer s7_call_with_location(s7_scheme *sc, s7_pointer func, s7_pointer args, const char *caller, const char *file, s7_int line)
+{
+  s7_pointer result;
+  if (caller)
+    {
+      sc->s7_call_name = caller;
+      sc->s7_call_file = file;
+      sc->s7_call_line = line;
+    }
+  result = s7_call(sc, func, args);
+  if (caller)
+    {
+      sc->s7_call_name = NULL;
+      sc->s7_call_file = NULL;
+      sc->s7_call_line = -1;
+    }
+  return(result);
+}
+
+
+/* -------------------------------- type-of -------------------------------- */
+#if (!WITH_GCC)
+static inline bool gen_type_match(s7_scheme *sc, s7_pointer val, uint8_t typ)  /* opt3_byte = uint8_t */
+{
+  return((type(val) == typ) ||
+	 ((has_active_methods(sc, val)) &&
+	  (apply_boolean_method(sc, val, sc->type_to_typers[typ]) != sc->F)));
+}
+#else
+#define gen_type_match(Sc, Val, Typ) \
+         ({s7_pointer _val_ = Val; \
+           ((type(_val_) == Typ) || \
+            ((has_active_methods(Sc, _val_)) && \
+             (apply_boolean_method(Sc, _val_, Sc->type_to_typers[Typ]) != Sc->F)));})
+#endif
+
+static void init_typers(s7_scheme *sc)
+{
+  sc->type_to_typers[T_FREE] =                sc->F;
+  sc->type_to_typers[T_PAIR] =                sc->is_pair_symbol;
+  sc->type_to_typers[T_NIL] =                 sc->is_null_symbol;
+  sc->type_to_typers[T_UNUSED] =              sc->F;
+  sc->type_to_typers[T_EOF] =                 sc->is_eof_object_symbol;
+  sc->type_to_typers[T_UNDEFINED] =           sc->is_undefined_symbol;
+  sc->type_to_typers[T_UNSPECIFIED] =         sc->is_unspecified_symbol;
+  sc->type_to_typers[T_BOOLEAN] =             sc->is_boolean_symbol;
+  sc->type_to_typers[T_CHARACTER] =           sc->is_char_symbol;
+  sc->type_to_typers[T_SYMBOL] =              sc->is_symbol_symbol;      /* and keyword? */
+  sc->type_to_typers[T_SYNTAX] =              sc->is_syntax_symbol;
+  sc->type_to_typers[T_INTEGER] =             sc->is_integer_symbol;
+  sc->type_to_typers[T_RATIO] =               sc->is_rational_symbol;
+  sc->type_to_typers[T_REAL] =                sc->is_float_symbol;
+  sc->type_to_typers[T_COMPLEX] =             sc->is_complex_symbol;
+  sc->type_to_typers[T_BIG_INTEGER] =         sc->is_integer_symbol;
+  sc->type_to_typers[T_BIG_RATIO] =           sc->is_rational_symbol;
+  sc->type_to_typers[T_BIG_REAL] =            sc->is_float_symbol;
+  sc->type_to_typers[T_BIG_COMPLEX] =         sc->is_complex_symbol;
+  sc->type_to_typers[T_STRING] =              sc->is_string_symbol;
+  sc->type_to_typers[T_BYTE_VECTOR] =         sc->is_byte_vector_symbol;
+  sc->type_to_typers[T_C_OBJECT] =            sc->is_c_object_symbol;
+  sc->type_to_typers[T_VECTOR] =              sc->is_vector_symbol;
+  sc->type_to_typers[T_INT_VECTOR] =          sc->is_int_vector_symbol;
+  sc->type_to_typers[T_FLOAT_VECTOR] =        sc->is_float_vector_symbol;
+  sc->type_to_typers[T_CATCH] =               sc->F;
+  sc->type_to_typers[T_DYNAMIC_WIND] =        sc->F;
+  sc->type_to_typers[T_HASH_TABLE] =          sc->is_hash_table_symbol;
+  sc->type_to_typers[T_LET] =                 sc->is_let_symbol;
+  sc->type_to_typers[T_ITERATOR] =            sc->is_iterator_symbol;
+  sc->type_to_typers[T_STACK] =               sc->F;
+  sc->type_to_typers[T_COUNTER] =             sc->F;
+  sc->type_to_typers[T_SLOT] =                sc->F;
+  sc->type_to_typers[T_C_POINTER] =           sc->is_c_pointer_symbol;
+  sc->type_to_typers[T_OUTPUT_PORT] =         sc->is_output_port_symbol;
+  sc->type_to_typers[T_INPUT_PORT] =          sc->is_input_port_symbol;
+  sc->type_to_typers[T_RANDOM_STATE] =        sc->is_random_state_symbol;
+  sc->type_to_typers[T_GOTO] =                sc->is_goto_symbol;
+  sc->type_to_typers[T_CONTINUATION] =        sc->is_continuation_symbol;
+  sc->type_to_typers[T_CLOSURE] =             sc->is_procedure_symbol;
+  sc->type_to_typers[T_CLOSURE_STAR] =        sc->is_procedure_symbol;
+  sc->type_to_typers[T_C_MACRO] =             sc->is_macro_symbol;
+  sc->type_to_typers[T_MACRO] =               sc->is_macro_symbol;
+  sc->type_to_typers[T_MACRO_STAR] =          sc->is_macro_symbol;
+  sc->type_to_typers[T_BACRO] =               sc->is_macro_symbol;
+  sc->type_to_typers[T_BACRO_STAR] =          sc->is_macro_symbol;
+  sc->type_to_typers[T_C_FUNCTION] =          sc->is_procedure_symbol;
+  sc->type_to_typers[T_C_FUNCTION_STAR] =     sc->is_procedure_symbol;
+  sc->type_to_typers[T_C_RST_NO_REQ_FUNCTION] = sc->is_procedure_symbol;
+}
+
+s7_pointer s7_type_of(s7_scheme *sc, s7_pointer arg) {return(sc->type_to_typers[type(arg)]);}
+
+static s7_pointer g_type_of(s7_scheme *sc, s7_pointer args)
+{
+  #define H_type_of "(type-of obj) returns a symbol describing obj's type: (type-of 1): 'integer?"
+  #define Q_type_of s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_symbol_symbol, sc->not_symbol), sc->T)
+  return(sc->type_to_typers[type(car(args))]);
+}
+
+
+/* -------------------------------- exit emergency-exit -------------------------------- */
+void s7_quit(s7_scheme *sc)
+{
+  sc->longjmp_ok = false;
+  pop_input_port(sc);
+  stack_reset(sc);
+  push_stack_op_let(sc, OP_EVAL_DONE);
+}
+
+#ifndef EXIT_SUCCESS
+  #define EXIT_SUCCESS 0
+  #define EXIT_FAILURE 1
+#endif
+
+static s7_pointer g_emergency_exit(s7_scheme *sc, s7_pointer args)
+{
+  #define H_emergency_exit "(emergency-exit (obj #t)) exits s7 immediately. 'obj', the value passed to libc's _exit, can be an integer or #t=success (0) or #f=fail (1)."
+  #define Q_emergency_exit s7_make_signature(sc, 2, sc->T, sc->T)
+
+  s7_pointer obj;
+  if (is_null(args)) _exit(EXIT_SUCCESS);  /* r7rs spec says use _exit here (which does not call any functions registered with atexit or on_exit */
+  obj = car(args);
+  if (obj == sc->F) _exit(EXIT_FAILURE);
+  if ((obj == sc->T) || (!s7_is_integer(obj))) _exit(EXIT_SUCCESS);
+  _exit((int)s7_integer_clamped_if_gmp(sc, obj));
+  return(sc->F);
+}
+
+static s7_pointer g_exit(s7_scheme *sc, s7_pointer args)
+{
+  #define H_exit "(exit obj) exits s7. 'obj', the value passed to libc's exit, can be an integer or #t=success (0) or #f=fail (1)."
+  #define Q_exit s7_make_signature(sc, 2, sc->T, sc->T)
+  /* calling s7_eval_c_string in an atexit function seems to be problematic -- it works, but args can be changed? */
+
+  s7_pointer obj;
+  /* r7rs.pdf says exit checks the stack for dynamic-winds and runs the "after" functions, if any --
+   *   this strikes me as ridiculous -- surely they don't expect me to find all the stacks (other s7's running etc)
+   *   and search them for dynamic-winds?  The exit must happen in either the init or body sections -- how can we
+   *   guarantee the quit function makes sense if even the init hasn't run to completion yet? Anyone who calls exit
+   *   should clean up resources themselves.  Anyway, scheme's exit is also supposed to allow atexit functions
+   *   to be called, so we need to use libc's exit, not _exit -- there's an example C program at the end of s7test.scm.
+   */
+  for (int64_t i = stack_top(sc) - 1; i > 0; i -= 4)
+    if (stack_op(sc->stack, i) == OP_DYNAMIC_WIND)
+      {
+	s7_pointer dwind = T_Dyn(stack_code(sc->stack, i));
+	if (dynamic_wind_state(dwind) == DWIND_BODY) /* otherwise init func never ran? */
+	  {
+	    dynamic_wind_state(dwind) = DWIND_FINISH;
+	    if (dynamic_wind_out(dwind) != sc->F)
+	      s7_call(sc, dynamic_wind_out(dwind), sc->nil);
+	  }}
+  s7_quit(sc);
+
+  if (show_gc_stats(sc))
+    s7_warn(sc, 256, "gc calls %" ld64 " total time: %f\n", sc->gc_calls, (double)(sc->gc_total_time) / ticks_per_second());
+
+  if (is_null(args)) exit(EXIT_SUCCESS); /* allow atexit functions etc */
+  obj = car(args);
+  if (obj == sc->F) exit(EXIT_FAILURE);
+  if ((obj == sc->T) || (!s7_is_integer(obj))) exit(EXIT_SUCCESS);
+  exit((int)s7_integer_clamped_if_gmp(sc, obj));
+  return(sc->F); /* never reached? */
+}
+
+#if WITH_GCC
+static s7_pointer g_abort(s7_scheme *sc, s7_pointer args) {abort(); return(NULL);}
+#endif
+
+
+/* -------------------------------- optimizer stuff -------------------------------- */
+/* There is a problem with cache misses:  a bigger cache reduces one test from 24 seconds to 17 (cachegrind agrees).
+ *   But how to optimize s7 for cache hits?  The culprits are eval and gc.  Looking at the numbers,
+ *   I think the least affected tests are able to use opt_info optimization which makes everything local?
+ */
+
+#if S7_DEBUGGING
+static void check_t_1(s7_scheme *sc, s7_pointer e, const char* func, s7_pointer expr, s7_pointer var)
+{
+  if (let_slots(e) != s7_slot(sc, var))
+    {
+      fprintf(stderr, "%s%s %s is out of date (%s in %s -> %s)%s\n", bold_text, func, display(expr), display(var), display(sc->curlet),
+	      (tis_slot(let_slots(e))) ? display(let_slots(e)) : "no slots", unbold_text);
+      if (sc->stop_at_error) abort();
+    }
+}
+
+static s7_pointer t_lookup_1(s7_scheme *sc, s7_pointer symbol, const char *func, s7_pointer expr)
+{
+  check_t_1(sc, sc->curlet, func, expr, symbol);
+  return(slot_value(let_slots(sc->curlet)));
+}
+
+static s7_pointer T_lookup_1(s7_scheme *sc, s7_pointer symbol, const char *func, s7_pointer expr)
+{
+  check_t_1(sc, let_outlet(sc->curlet), func, expr, symbol);
+  return(slot_value(let_slots(let_outlet(sc->curlet))));
+}
+
+static void check_u_1(s7_scheme *sc, s7_pointer e, const char* func, s7_pointer expr, s7_pointer var)
+{
+  if (next_slot(let_slots(e)) != s7_slot(sc, var))
+    {
+      fprintf(stderr, "%s%s %s is out of date (%s in %s -> %s)%s\n", bold_text, func, display(expr), display(var), display(e),
+	      (tis_slot(next_slot(let_slots(e)))) ? display(next_slot(let_slots(e))) : "no next slot", unbold_text);
+      if (sc->stop_at_error) abort();
+    }
+}
+
+static s7_pointer u_lookup_1(s7_scheme *sc, s7_pointer symbol, const char *func, s7_pointer expr)
+{
+  check_u_1(sc, sc->curlet, func, expr, symbol);
+  return(slot_value(next_slot(let_slots(sc->curlet))));
+}
+
+static s7_pointer U_lookup_1(s7_scheme *sc, s7_pointer symbol, const char *func, s7_pointer expr)
+{
+  check_u_1(sc, let_outlet(sc->curlet), func, expr, symbol);
+  return(slot_value(next_slot(let_slots(let_outlet(sc->curlet)))));
+}
+
+static void check_v_1(s7_scheme *sc, s7_pointer e, const char* func, s7_pointer expr, s7_pointer var)
+{
+  if (next_slot(next_slot(let_slots(e))) != s7_slot(sc, var))
+    {
+      fprintf(stderr, "%s%s %s is out of date (%s in %s -> %s)%s\n", bold_text, func, display(expr), display(var), display(e),
+	      (tis_slot(next_slot(next_slot(let_slots(e))))) ? display(next_slot(next_slot(let_slots(e)))) : "no next slot", unbold_text);
+      if (sc->stop_at_error) abort();
+    }
+}
+
+static s7_pointer v_lookup_1(s7_scheme *sc, s7_pointer symbol, const char *func, s7_pointer expr)
+{
+  check_v_1(sc, sc->curlet, func, expr, symbol);
+  return(slot_value(next_slot(next_slot(let_slots(sc->curlet)))));
+}
+
+static s7_pointer V_lookup_1(s7_scheme *sc, s7_pointer symbol, const char *func, s7_pointer expr)
+{
+  check_v_1(sc, let_outlet(sc->curlet), func, expr, symbol);
+  return(slot_value(next_slot(next_slot(let_slots(let_outlet(sc->curlet))))));
+}
+
+static void check_o_1(s7_scheme *sc, s7_pointer e, const char* func, s7_pointer expr, s7_pointer var)
+{
+  s7_pointer slot = s7_slot(sc, var);
+  if (lookup_slot_with_let(sc, var, e) != slot)
+    {
+      fprintf(stderr, "%s%s %s is out of date (%s in %s -> %s)%s\n", bold_text, func, display(expr), display(var), display(e),
+	      (tis_slot(slot)) ? display(slot) : "undefined", unbold_text);
+      if (sc->stop_at_error) abort();
+    }
+}
+
+static s7_pointer o_lookup_1(s7_scheme *sc, s7_pointer symbol, const char *func, s7_pointer expr)
+{
+  check_o_1(sc, let_outlet(sc->curlet), func, expr, symbol);
+  return(inline_lookup_from(sc, symbol, let_outlet(sc->curlet)));
+}
+
+#define t_lookup(Sc, Symbol, Expr) t_lookup_1(Sc, Symbol, __func__, Expr)
+#define u_lookup(Sc, Symbol, Expr) u_lookup_1(Sc, Symbol, __func__, Expr)
+#define v_lookup(Sc, Symbol, Expr) v_lookup_1(Sc, Symbol, __func__, Expr)
+#define T_lookup(Sc, Symbol, Expr) T_lookup_1(Sc, Symbol, __func__, Expr)
+#define U_lookup(Sc, Symbol, Expr) U_lookup_1(Sc, Symbol, __func__, Expr)
+#define V_lookup(Sc, Symbol, Expr) V_lookup_1(Sc, Symbol, __func__, Expr)
+#define o_lookup(Sc, Symbol, Expr) o_lookup_1(Sc, Symbol, __func__, Expr)
+#else
+#define t_lookup(Sc, Symbol, Expr) slot_value(let_slots(sc->curlet))
+#define u_lookup(Sc, Symbol, Expr) slot_value(next_slot(let_slots(sc->curlet)))
+#define v_lookup(Sc, Symbol, Expr) slot_value(next_slot(next_slot(let_slots(sc->curlet))))
+#define T_lookup(Sc, Symbol, Expr) slot_value(let_slots(let_outlet(sc->curlet)))
+#define U_lookup(Sc, Symbol, Expr) slot_value(next_slot(let_slots(let_outlet(sc->curlet))))
+#define V_lookup(Sc, Symbol, Expr) slot_value(next_slot(next_slot(let_slots(let_outlet(sc->curlet)))))
+#define o_lookup(Sc, Symbol, Expr) inline_lookup_from(Sc, Symbol, let_outlet(Sc->curlet))
+#endif
+
+#define s_lookup(Sc, Sym, Expr) lookup(Sc, Sym)
+#define g_lookup(Sc, Sym, Expr) lookup_global(Sc, Sym)
+
+/* arg here is the full expression */
+static s7_pointer fx_c(s7_scheme *sc, s7_pointer arg)        {return(arg);}
+static s7_pointer fx_q(s7_scheme *sc, s7_pointer arg)        {return(cadr(arg));}
+static s7_pointer fx_unsafe_s(s7_scheme *sc, s7_pointer arg) {return(lookup_checked(sc, T_Sym(arg)));}
+
+static s7_pointer fx_s(s7_scheme *sc, s7_pointer arg) {return(lookup(sc, T_Sym(arg)));}
+static s7_pointer fx_g(s7_scheme *sc, s7_pointer arg) {return((is_global(arg)) ? global_value(arg) : lookup(sc, arg));}
+static s7_pointer fx_o(s7_scheme *sc, s7_pointer arg) {return(o_lookup(sc, T_Sym(arg), arg));}
+static s7_pointer fx_t(s7_scheme *sc, s7_pointer arg) {return(t_lookup(sc, T_Sym(arg), arg));}
+static s7_pointer fx_u(s7_scheme *sc, s7_pointer arg) {return(u_lookup(sc, T_Sym(arg), arg));}
+static s7_pointer fx_v(s7_scheme *sc, s7_pointer arg) {return(v_lookup(sc, T_Sym(arg), arg));}
+static s7_pointer fx_T(s7_scheme *sc, s7_pointer arg) {return(T_lookup(sc, T_Sym(arg), arg));}
+static s7_pointer fx_U(s7_scheme *sc, s7_pointer arg) {return(U_lookup(sc, T_Sym(arg), arg));}
+static s7_pointer fx_V(s7_scheme *sc, s7_pointer arg) {return(V_lookup(sc, T_Sym(arg), arg));}
+static s7_pointer fx_c_nc(s7_scheme *sc, s7_pointer arg) {return(fn_call(sc, arg));}
+static s7_pointer fx_c_0c(s7_scheme *sc, s7_pointer arg) {return(fn_proc(arg)(sc, sc->nil));}
+static s7_pointer fx_cons_cc(s7_scheme *sc, s7_pointer arg) {return(cons(sc, cadr(arg), caddr(arg)));}
+static s7_pointer fx_curlet(s7_scheme *sc, s7_pointer arg) {return(s7_curlet(sc));}
+
+#define fx_c_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    return(fn_proc(arg)(sc, with_list_t1(Lookup(sc, cadr(arg), arg)))); \
+  }
+
+fx_c_any(fx_c_s, s_lookup)
+fx_c_any(fx_c_g, g_lookup)
+fx_c_any(fx_c_t, t_lookup)
+fx_c_any(fx_c_u, u_lookup)
+fx_c_any(fx_c_v, v_lookup)
+fx_c_any(fx_c_o, o_lookup)
+fx_c_any(fx_c_T, T_lookup)
+fx_c_any(fx_c_V, V_lookup)
+
+static s7_pointer fx_c_g_direct(s7_scheme *sc, s7_pointer arg) {return(((s7_p_p_t)opt2_direct(cdr(arg)))(sc, lookup_global(sc, cadr(arg))));}
+static s7_pointer fx_c_s_direct(s7_scheme *sc, s7_pointer arg) {return(((s7_p_p_t)opt2_direct(cdr(arg)))(sc, lookup(sc, cadr(arg))));}
+static s7_pointer fx_c_o_direct(s7_scheme *sc, s7_pointer arg) {return(((s7_p_p_t)opt2_direct(cdr(arg)))(sc, o_lookup(sc, cadr(arg), arg)));}
+static s7_pointer fx_c_t_direct(s7_scheme *sc, s7_pointer arg) {return(((s7_p_p_t)opt2_direct(cdr(arg)))(sc, t_lookup(sc, cadr(arg), arg)));}
+static s7_pointer fx_c_u_direct(s7_scheme *sc, s7_pointer arg) {return(((s7_p_p_t)opt2_direct(cdr(arg)))(sc, u_lookup(sc, cadr(arg), arg)));}
+static s7_pointer fx_c_v_direct(s7_scheme *sc, s7_pointer arg) {return(((s7_p_p_t)opt2_direct(cdr(arg)))(sc, v_lookup(sc, cadr(arg), arg)));}
+
+
+#define fx_car_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  {							\
+    s7_pointer val = Lookup(sc, cadr(arg), arg);        \
+    return((is_pair(val)) ? car(val) : g_car(sc, set_plist_1(sc, val))); \
+  }
+  /* using car_p_p(val) here is exactly the same in speed according to callgrind, also opt3_sym(arg) for cadr(arg) */
+
+fx_car_any(fx_car_s, s_lookup)
+fx_car_any(fx_car_t, t_lookup)
+fx_car_any(fx_car_u, u_lookup)
+fx_car_any(fx_car_o, o_lookup)
+fx_car_any(fx_car_T, T_lookup)
+fx_car_any(fx_car_U, U_lookup)
+
+
+#define fx_cdr_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  {							\
+    s7_pointer val = Lookup(sc, cadr(arg), arg);					\
+    return((is_pair(val)) ? cdr(val) : g_cdr(sc, set_plist_1(sc, val))); \
+  }
+
+fx_cdr_any(fx_cdr_s, s_lookup)
+fx_cdr_any(fx_cdr_t, t_lookup)
+fx_cdr_any(fx_cdr_u, u_lookup)
+fx_cdr_any(fx_cdr_v, v_lookup)
+fx_cdr_any(fx_cdr_o, o_lookup)
+fx_cdr_any(fx_cdr_T, T_lookup)
+fx_cdr_any(fx_cdr_U, U_lookup)
+
+
+#define fx_cadr_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg)\
+  { \
+    s7_pointer val = Lookup(sc, cadr(arg), arg); \
+    return(((is_pair(val)) && (is_pair(cdr(val)))) ? cadr(val) : g_cadr(sc, set_plist_1(sc, val))); \
+  }
+
+fx_cadr_any(fx_cadr_s, s_lookup)
+fx_cadr_any(fx_cadr_t, t_lookup)
+fx_cadr_any(fx_cadr_u, u_lookup)
+fx_cadr_any(fx_cadr_o, o_lookup)
+
+
+#define fx_cddr_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg)\
+  { \
+    s7_pointer val = Lookup(sc, cadr(arg), arg); \
+    return(((is_pair(val)) && (is_pair(cdr(val)))) ? cddr(val) : g_cddr(sc, set_plist_1(sc, val))); \
+  }
+
+fx_cddr_any(fx_cddr_s, s_lookup)
+fx_cddr_any(fx_cddr_t, t_lookup)
+fx_cddr_any(fx_cddr_u, u_lookup)
+fx_cddr_any(fx_cddr_o, o_lookup)
+
+
+#define fx_add_s1_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer x = Lookup(sc, cadr(arg), arg); \
+    if ((!WITH_GMP) && (is_t_integer(x))) return(make_integer(sc, integer(x) + 1)); \
+    return(g_add_x1_1(sc, x, 1)); /* arg=(+ x 1) */ \
+  }
+
+fx_add_s1_any(fx_add_s1, s_lookup)
+fx_add_s1_any(fx_add_t1, t_lookup)
+fx_add_s1_any(fx_add_u1, u_lookup)
+fx_add_s1_any(fx_add_v1, v_lookup)
+fx_add_s1_any(fx_add_T1, T_lookup)
+fx_add_s1_any(fx_add_U1, U_lookup)
+fx_add_s1_any(fx_add_V1, V_lookup)
+
+
+static s7_pointer fx_num_eq_xi_1(s7_scheme *sc, s7_pointer args, s7_pointer val, s7_int y)
+{
+  if ((S7_DEBUGGING) && (is_t_integer(val))) fprintf(stderr, "%s[%d]: %s is an integer\n", __func__, __LINE__, display(val));
+  switch (type(val))
+    {
+    case T_REAL:    return(make_boolean(sc, real(val) == y));
+    case T_RATIO:
+    case T_COMPLEX: return(sc->F);
+#if WITH_GMP
+    case T_BIG_INTEGER: return(make_boolean(sc, mpz_cmp_si(big_integer(val), y) == 0));
+    case T_BIG_REAL:    return(make_boolean(sc, mpfr_cmp_si(big_real(val), y) == 0));
+    case T_BIG_RATIO:
+    case T_BIG_COMPLEX: return(sc->F);
+#endif
+    default: return(method_or_bust_pp(sc, val, sc->num_eq_symbol, val, cadr(args), a_number_string, 1));
+    }
+  return(sc->T);
+}
+
+static s7_pointer fx_num_eq_s0f(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer val = lookup(sc, cadr(arg));
+  if (is_t_real(val)) return(make_boolean(sc, real(val) == 0.0));
+  return(make_boolean(sc, num_eq_b_7pp(sc, val, real_zero)));
+}
+
+#define fx_num_eq_si_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer args = cdr(arg); \
+    s7_pointer val = Lookup(sc, car(args), arg); \
+    s7_int y = integer(cadr(args)); \
+    return((is_t_integer(val)) ? make_boolean(sc, integer(val) == y) : \
+           ((is_t_real(val)) ? make_boolean(sc, real(val) == y) : fx_num_eq_xi_1(sc, args, val, y))); \
+}
+
+fx_num_eq_si_any(fx_num_eq_si, s_lookup)
+fx_num_eq_si_any(fx_num_eq_ti, t_lookup)
+fx_num_eq_si_any(fx_num_eq_ui, u_lookup)
+fx_num_eq_si_any(fx_num_eq_vi, v_lookup)
+fx_num_eq_si_any(fx_num_eq_Ti, T_lookup)
+fx_num_eq_si_any(fx_num_eq_oi, o_lookup)
+
+#define fx_num_eq_s0_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer val = Lookup(sc, cadr(arg), arg); \
+    return((is_t_integer(val)) ? make_boolean(sc, integer(val) == 0) : fx_num_eq_xi_1(sc, cdr(arg), val, 0)); \
+  }
+
+fx_num_eq_s0_any(fx_num_eq_s0, s_lookup)
+fx_num_eq_s0_any(fx_num_eq_t0, t_lookup)
+fx_num_eq_s0_any(fx_num_eq_u0, u_lookup)
+fx_num_eq_s0_any(fx_num_eq_v0, v_lookup)
+
+static s7_pointer fx_num_eq_0s(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer val = lookup(sc, opt3_sym(arg)); /* opt3_sym: caddr(arg) -- this actually makes a measurable difference in callgrind! */
+  return((is_t_integer(val)) ? make_boolean(sc, integer(val) == 0) : g_num_eq(sc, set_plist_2(sc, val, int_zero)));
+}
+
+
+static s7_pointer fx_random_i(s7_scheme *sc, s7_pointer arg)
+{
+#if WITH_GMP
+  return(g_random_i(sc, cdr(arg)));
+#else
+  return(make_integer(sc, (s7_int)(integer(cadr(arg)) * next_random(sc->default_random_state))));
+#endif
+}
+
+#if (!WITH_GMP)
+static s7_pointer fx_add_i_random(s7_scheme *sc, s7_pointer arg)
+{
+  s7_int x = integer(cadr(arg));
+  s7_int y = opt3_int(cdr(arg)); /* cadadr */
+  return(make_integer(sc, x + (s7_int)(y * next_random(sc->default_random_state)))); /* (+ -1 (random 1)) -- placement of the (s7_int) cast matters! */
+}
+#endif
+
+static s7_pointer fx_add_sf(s7_scheme *sc, s7_pointer arg) {return(g_add_xf(sc, lookup(sc, cadr(arg)), real(opt2_con(cdr(arg))), 1));}
+static s7_pointer fx_add_fs(s7_scheme *sc, s7_pointer arg) {return(g_add_xf(sc, lookup(sc, opt2_sym(cdr(arg))), real(cadr(arg)), 2));}
+static s7_pointer fx_add_tf(s7_scheme *sc, s7_pointer arg) {return(g_add_xf(sc, t_lookup(sc, cadr(arg), arg), real(opt2_con(cdr(arg))), 1));}
+static s7_pointer fx_add_ft(s7_scheme *sc, s7_pointer arg) {return(g_add_xf(sc, t_lookup(sc, opt2_sym(cdr(arg)), arg), real(cadr(arg)), 2));}
+
+#define fx_add_si_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer x = Lookup(sc, cadr(arg), arg); \
+    if ((!WITH_GMP) && (is_t_integer(x))) \
+      { \
+        if (HAVE_OVERFLOW_CHECKS) \
+  	  { \
+  	    s7_int val; \
+  	    if (!add_overflow(integer(x), integer(opt2_con(cdr(arg))), &val)) \
+  	      return(make_integer(sc, val)); \
+  	  } \
+        else return(make_integer(sc, integer(x) + integer(opt2_con(cdr(arg))))); \
+      } \
+    return(add_p_pp(sc, x, opt2_con(cdr(arg)))); /* caddr(arg) */ \
+  }
+
+fx_add_si_any(fx_add_si, s_lookup)
+fx_add_si_any(fx_add_ti, t_lookup)
+
+static s7_pointer fx_add_ss(s7_scheme *sc, s7_pointer arg) {return(add_p_pp(sc, s_lookup(sc, cadr(arg), arg), s_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_add_ts(s7_scheme *sc, s7_pointer arg) {return(add_p_pp(sc, t_lookup(sc, cadr(arg), arg), s_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_add_tu(s7_scheme *sc, s7_pointer arg) {return(add_p_pp(sc, t_lookup(sc, cadr(arg), arg), u_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_add_ut(s7_scheme *sc, s7_pointer arg) {return(add_p_pp(sc, u_lookup(sc, cadr(arg), arg), t_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_add_uv(s7_scheme *sc, s7_pointer arg) {return(add_p_pp(sc, u_lookup(sc, cadr(arg), arg), v_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_add_us(s7_scheme *sc, s7_pointer arg) {return(add_p_pp(sc, u_lookup(sc, cadr(arg), arg), s_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_add_vu(s7_scheme *sc, s7_pointer arg) {return(add_p_pp(sc, v_lookup(sc, cadr(arg), arg), u_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+
+#define fx_subtract_s1_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer x = Lookup(sc, cadr(arg), arg); \
+    if ((!WITH_GMP) && (is_t_integer(x))) return(make_integer(sc, integer(x) - 1)); \
+    return(minus_c1(sc, x)); \
+  }
+
+fx_subtract_s1_any(fx_subtract_s1, s_lookup)
+fx_subtract_s1_any(fx_subtract_t1, t_lookup)
+fx_subtract_s1_any(fx_subtract_u1, u_lookup)
+fx_subtract_s1_any(fx_subtract_v1, v_lookup)
+fx_subtract_s1_any(fx_subtract_T1, T_lookup)
+fx_subtract_s1_any(fx_subtract_U1, U_lookup)
+
+
+#define fx_subtract_si_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer x = Lookup(sc, cadr(arg), arg); \
+    if ((!WITH_GMP) && (is_t_integer(x))) \
+      { \
+        if (HAVE_OVERFLOW_CHECKS) \
+  	  { \
+  	    s7_int val; \
+  	    if (!subtract_overflow(integer(x), integer(opt2_con(cdr(arg))), &val)) \
+  	      return(make_integer(sc, val)); \
+  	  } \
+        else return(make_integer(sc, integer(x) - integer(opt2_con(cdr(arg))))); \
+      } \
+    return(subtract_p_pp(sc, x, opt2_con(cdr(arg)))); /* caddr(arg) */ \
+  }
+
+fx_subtract_si_any(fx_subtract_si, s_lookup)
+fx_subtract_si_any(fx_subtract_ti, t_lookup)
+fx_subtract_si_any(fx_subtract_ui, u_lookup)
+
+
+#define fx_subtract_sf_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer x = Lookup(sc, cadr(arg), arg); \
+    if (is_t_real(x)) \
+      return(make_real(sc, real(x) - real(opt2_con(cdr(arg)))));       /* caddr(arg) */ \
+    return(g_subtract_2f(sc, set_plist_2(sc, x, opt2_con(cdr(arg))))); /* caddr(arg) */ \
+  }
+
+fx_subtract_sf_any(fx_subtract_sf, s_lookup)
+fx_subtract_sf_any(fx_subtract_tf, t_lookup)
+
+
+#define fx_subtract_ss_any(Name, Lookup1, Lookup2) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) {return(subtract_p_pp(sc, Lookup1(sc, cadr(arg), arg), Lookup2(sc, opt2_sym(cdr(arg)), arg)));}
+
+fx_subtract_ss_any(fx_subtract_ss, s_lookup, s_lookup)
+fx_subtract_ss_any(fx_subtract_ts, t_lookup, s_lookup)
+fx_subtract_ss_any(fx_subtract_tu, t_lookup, u_lookup)
+fx_subtract_ss_any(fx_subtract_ut, u_lookup, t_lookup)
+fx_subtract_ss_any(fx_subtract_us, u_lookup, s_lookup)
+
+
+static s7_pointer fx_subtract_fs(s7_scheme *sc, s7_pointer arg)
+{
+  s7_double n = real(cadr(arg));
+  s7_pointer x = lookup(sc, opt2_sym(cdr(arg))); /* caddr(arg) */
+  switch (type(x))
+    {
+    case T_INTEGER: return(make_real(sc, n - integer(x)));
+    case T_RATIO:   return(make_real(sc, n - fraction(x)));
+    case T_REAL:    return(make_real(sc, n - real(x)));
+    case T_COMPLEX: return(make_complex_not_0i(sc, n - real_part(x), -imag_part(x)));
+#if WITH_GMP
+    case T_BIG_INTEGER: case T_BIG_RATIO: case T_BIG_REAL: case T_BIG_COMPLEX:
+      return(subtract_p_pp(sc, cadr(arg), x));
+#endif
+    default:
+      return(method_or_bust_pp(sc, x, sc->subtract_symbol, cadr(arg), x, a_number_string, 2));
+    }
+  return(x);
+}
+
+#define fx_is_eq_sc_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    return(make_boolean(sc, Lookup(sc, cadr(arg), arg) == opt2_con(cdr(arg)))); /* fx_choose checks that the second arg is not unspecified */ \
+  }
+
+fx_is_eq_sc_any(fx_is_eq_sc, s_lookup)
+fx_is_eq_sc_any(fx_is_eq_tc, t_lookup)
+fx_is_eq_sc_any(fx_is_eq_uc, u_lookup)
+
+
+#define fx_is_eq_car_sq_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer a = cdr(arg); \
+    s7_pointer lst = Lookup(sc, opt3_sym(a), arg); \
+    return(make_boolean(sc, (is_pair(lst)) ? (car(lst) == opt2_con(a)) : s7_is_eq(g_car(sc, set_plist_1(sc, lst)), opt2_con(a)))); \
+  }
+
+fx_is_eq_car_sq_any(fx_is_eq_car_sq, s_lookup)
+fx_is_eq_car_sq_any(fx_is_eq_car_tq, t_lookup)
+
+
+static s7_pointer fx_is_eq_caar_sq(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer a = cdr(arg);
+  s7_pointer lst = lookup(sc, opt3_sym(a));
+  if ((is_pair(lst)) && (is_pair(car(lst))))
+    return(make_boolean(sc, caar(lst) == opt2_con(a)));
+  return(make_boolean(sc, s7_is_eq(g_caar(sc, set_plist_1(sc, lst)), opt2_con(a))));
+}
+
+static s7_pointer fx_not_is_eq_car_sq(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer lst = lookup(sc, opt1_sym(cdr(arg)));
+  if (is_pair(lst))
+    return(make_boolean(sc, car(lst) != opt3_con(cdr(arg))));
+  return(make_boolean(sc, !s7_is_eq(g_car(sc, set_plist_1(sc, lst)), opt3_con(cdr(arg)))));
+}
+
+#define fx_is_pair_car_s_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer p = Lookup(sc, opt3_sym(arg), arg); \
+    return((is_pair(p)) ? make_boolean(sc, is_pair(car(p))) : g_is_pair(sc, set_plist_1(sc, g_car(sc, set_plist_1(sc, p))))); \
+  }
+
+fx_is_pair_car_s_any(fx_is_pair_car_s, s_lookup)
+fx_is_pair_car_s_any(fx_is_pair_car_t, t_lookup)
+
+
+#define fx_is_pair_cdr_s_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer p = Lookup(sc, opt3_sym(arg), arg); \
+    return((is_pair(p)) ? make_boolean(sc, is_pair(cdr(p))) : g_is_pair(sc, set_plist_1(sc, g_cdr(sc, set_plist_1(sc, p))))); \
+  }
+
+fx_is_pair_cdr_s_any(fx_is_pair_cdr_s, s_lookup)
+fx_is_pair_cdr_s_any(fx_is_pair_cdr_t, t_lookup)
+fx_is_pair_cdr_s_any(fx_is_pair_cdr_u, u_lookup)
+
+
+#define fx_is_pair_cadr_s_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer p = Lookup(sc, opt3_sym(arg), arg); \
+    return(((is_pair(p)) && (is_pair(cdr(p)))) ? make_boolean(sc, is_pair(cadr(p))) : g_is_pair(sc, set_plist_1(sc, g_cadr(sc, set_plist_1(sc, p))))); \
+  }
+
+fx_is_pair_cadr_s_any(fx_is_pair_cadr_s, s_lookup)
+fx_is_pair_cadr_s_any(fx_is_pair_cadr_t, t_lookup)
+
+
+#define fx_is_pair_cddr_s_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer p = Lookup(sc, opt3_sym(arg), arg); \
+    return(((is_pair(p)) && (is_pair(cdr(p)))) ? make_boolean(sc, is_pair(cddr(p))) : g_is_pair(sc, set_plist_1(sc, g_cddr(sc, set_plist_1(sc, p))))); \
+  }
+
+fx_is_pair_cddr_s_any(fx_is_pair_cddr_s, s_lookup)
+fx_is_pair_cddr_s_any(fx_is_pair_cddr_t, t_lookup)
+
+
+#define fx_is_null_cdr_s_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer p = Lookup(sc, opt3_sym(arg), arg); \
+    return((is_pair(p)) ? make_boolean(sc, is_null(cdr(p))) : g_is_null(sc, set_plist_1(sc, g_cdr(sc, set_plist_1(sc, p))))); \
+  }
+
+fx_is_null_cdr_s_any(fx_is_null_cdr_s, s_lookup)
+fx_is_null_cdr_s_any(fx_is_null_cdr_t, t_lookup)
+
+
+#define fx_is_null_cadr_s_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer p = Lookup(sc, opt3_sym(arg), arg); \
+    return(((is_pair(p)) && (is_pair(cdr(p)))) ? make_boolean(sc, is_null(cadr(p))) : g_is_null(sc, set_plist_1(sc, g_cadr(sc, set_plist_1(sc, p))))); \
+  }
+
+fx_is_null_cadr_s_any(fx_is_null_cadr_s, s_lookup)
+fx_is_null_cadr_s_any(fx_is_null_cadr_t, t_lookup)
+
+
+#define fx_is_null_cddr_s_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer p = Lookup(sc, opt3_sym(arg), arg); \
+    return(((is_pair(p)) && (is_pair(cdr(p)))) ? make_boolean(sc, is_null(cddr(p))) : g_is_null(sc, set_plist_1(sc, g_cddr(sc, set_plist_1(sc, p))))); \
+  }
+
+fx_is_null_cddr_s_any(fx_is_null_cddr_s, s_lookup)
+fx_is_null_cddr_s_any(fx_is_null_cddr_t, t_lookup)
+
+
+#define fx_is_symbol_cadr_s_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer p = Lookup(sc, opt3_sym(arg), arg); \
+    return(((is_pair(p)) && (is_pair(cdr(p)))) ? make_boolean(sc, is_symbol(cadr(p))) : g_is_symbol(sc, set_plist_1(sc, g_cadr(sc, set_plist_1(sc, p))))); \
+  }
+
+fx_is_symbol_cadr_s_any(fx_is_symbol_cadr_s, s_lookup)
+fx_is_symbol_cadr_s_any(fx_is_symbol_cadr_t, t_lookup)
+
+static s7_pointer fx_is_symbol_car_t(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer val = t_lookup(sc, opt3_sym(arg), arg);
+  return(make_boolean(sc, (is_pair(val)) ? is_symbol(car(val)) : is_symbol(g_car(sc, set_plist_1(sc, val)))));
+}
+
+static s7_pointer fx_floor_sqrt_s(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p = lookup(sc, opt3_sym(arg));
+#if WITH_GMP
+  if ((is_t_big_integer(p)) &&
+      (mpz_cmp_ui(big_integer(p), 0) >= 0)) /* p >= 0 */
+    {
+      mpz_sqrt(sc->mpz_1, big_integer(p));
+      return(mpz_to_integer(sc, sc->mpz_1));
+    }
+#else
+  if (!is_negative_b_7p(sc, p))
+    return(make_integer(sc, (s7_int)floor(sqrt(s7_number_to_real_with_location(sc, p, sc->sqrt_symbol)))));
+#endif
+  return(floor_p_p(sc, sqrt_p_p(sc, p)));
+}
+
+
+static s7_pointer fx_is_positive_u(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p1 = u_lookup(sc, cadr(arg), arg);
+  if (is_t_integer(p1)) return(make_boolean(sc, integer(p1) > 0));
+  return(make_boolean(sc, is_positive_b_7p(sc, p1)));
+}
+
+static s7_pointer fx_is_zero_u(s7_scheme *sc, s7_pointer arg) {return(make_boolean(sc, is_zero_b_7p(sc, u_lookup(sc, cadr(arg), arg))));}
+
+#define fx_real_part_s_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer z = Lookup(sc, cadr(arg), arg); \
+    return((is_t_complex(z)) ? make_real(sc, real_part(z)) : real_part_p_p(sc, z)); \
+  }
+
+fx_real_part_s_any(fx_real_part_s, s_lookup)
+fx_real_part_s_any(fx_real_part_t, t_lookup)
+
+#define fx_imag_part_s_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer z = Lookup(sc, cadr(arg), arg); \
+    return((is_t_complex(z)) ? make_real(sc, imag_part(z)) : imag_part_p_p(sc, z)); \
+  }
+
+fx_imag_part_s_any(fx_imag_part_s, s_lookup)
+fx_imag_part_s_any(fx_imag_part_t, t_lookup) /* not used in current timing tests */
+
+#define fx_iterate_s_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer iter = Lookup(sc, cadr(arg), arg); \
+    if (is_iterator(iter)) \
+      return((iterator_next(iter))(sc, iter)); \
+    return(method_or_bust_p(sc, iter, sc->iterate_symbol, sc->type_names[T_ITERATOR])); \
+  }
+
+fx_iterate_s_any(fx_iterate_s, s_lookup)
+fx_iterate_s_any(fx_iterate_o, o_lookup)
+fx_iterate_s_any(fx_iterate_T, T_lookup)
+
+static s7_pointer fx_read_char_0(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer port = input_port_if_not_loading(sc);
+  if (!port) return(eof_object);
+  if (!is_input_port(port))
+    return(method_or_bust_p(sc, port, sc->read_char_symbol, an_input_port_string));
+  return(chars[port_read_character(port)(sc, port)]);
+}
+
+static s7_pointer fx_length_s(s7_scheme *sc, s7_pointer arg) {return(s7_length(sc, lookup(sc, cadr(arg))));}
+static s7_pointer fx_length_t(s7_scheme *sc, s7_pointer arg) {return(s7_length(sc, t_lookup(sc, cadr(arg), arg)));}
+
+static s7_pointer fx_num_eq_length_i(s7_scheme *sc, s7_pointer arg)
+{
+  /* avoid make_integer (and telescope opts), we get here with car=length expr, cadr=int */
+  s7_int ilen = integer(opt3_con(arg)); /* is_t_integer checked in fx_choose */
+  s7_pointer val = lookup(sc, opt3_sym(cdr(arg)));
+
+  switch (type(val))
+    {
+    case T_PAIR:       return(make_boolean(sc, s7_list_length(sc, val) == ilen));
+    case T_NIL:        return(make_boolean(sc, ilen == 0));
+    case T_STRING:     return(make_boolean(sc, string_length(val) == ilen));
+    case T_HASH_TABLE: return(make_boolean(sc, (hash_table_size(val)) == ilen));
+    case T_C_OBJECT:   return(make_boolean(sc, c_object_length_to_int(sc, val) == ilen));
+    case T_LET:        return(make_boolean(sc, let_length(sc, val) == ilen));
+
+    case T_BYTE_VECTOR: case T_INT_VECTOR: case T_FLOAT_VECTOR: case T_VECTOR:
+      return(make_boolean(sc, vector_length(val) == ilen));
+
+    case T_ITERATOR:
+      {
+	s7_pointer len = s7_length(sc, iterator_sequence(val));
+	return(make_boolean(sc, (is_t_integer(len)) && (integer(len) == ilen)));
+      }
+
+    case T_CLOSURE:
+    case T_CLOSURE_STAR:
+      if (has_active_methods(sc, val))
+	return(make_boolean(sc, closure_length(sc, val) == ilen));
+      /* fall through */
+
+    default:
+      sole_arg_wrong_type_error_nr(sc, sc->length_symbol, val, a_sequence_string);
+      /* here we already lost because we checked for the length above */
+    }
+  return(sc->F);
+}
+
+static s7_pointer fx_less_length_i(s7_scheme *sc, s7_pointer arg)
+{
+  s7_int ilen = integer(opt3_con(arg));    /* caddr(arg) */
+  s7_pointer val = lookup(sc, opt3_sym(cdr(arg)));  /* cadadr(arg) */
+
+  switch (type(val))
+    {
+    case T_PAIR:       return(make_boolean(sc, s7_list_length(sc, val) < ilen));
+    case T_NIL:        return(make_boolean(sc, ilen > 0));
+    case T_STRING:     return(make_boolean(sc, string_length(val) < ilen));
+    case T_HASH_TABLE: return(make_boolean(sc, (hash_table_size(val)) < ilen)); /* was <=? -- changed 15-Dec-15, then again 6-Jan-17: mask is len-1 */
+    case T_C_OBJECT:   return(make_boolean(sc, c_object_length_to_int(sc, val) < ilen));
+    case T_LET:        return(make_boolean(sc, let_length(sc, val) < ilen));  /* this works because let_length handles the length method itself! */
+
+    case T_BYTE_VECTOR: case T_INT_VECTOR: case T_FLOAT_VECTOR: case T_VECTOR:
+      return(make_boolean(sc, vector_length(val) < ilen));
+
+    case T_ITERATOR:
+      {
+	s7_pointer len = s7_length(sc, iterator_sequence(val));
+	return(make_boolean(sc, (is_t_integer(len)) && (integer(len) < ilen)));
+      }
+
+    case T_CLOSURE:
+    case T_CLOSURE_STAR:
+      if (has_active_methods(sc, val))
+	return(make_boolean(sc, closure_length(sc, val) < ilen));
+      /* fall through */
+
+    default:
+      sole_arg_wrong_type_error_nr(sc, sc->length_symbol, val, a_sequence_string); /* no check method here because we checked above */
+    }
+  return(sc->F);
+}
+
+static s7_pointer fx_is_null_s(s7_scheme *sc, s7_pointer arg)   {return((is_null(lookup(sc, cadr(arg)))) ? sc->T : sc->F);}
+static s7_pointer fx_is_null_o(s7_scheme *sc, s7_pointer arg)   {return((is_null(o_lookup(sc, cadr(arg), arg))) ? sc->T : sc->F);} /* very few hits */
+static s7_pointer fx_is_null_t(s7_scheme *sc, s7_pointer arg)   {return((is_null(t_lookup(sc, cadr(arg), arg))) ? sc->T : sc->F);}
+static s7_pointer fx_is_null_u(s7_scheme *sc, s7_pointer arg)   {return((is_null(u_lookup(sc, cadr(arg), arg))) ? sc->T : sc->F);}
+static s7_pointer fx_is_null_v(s7_scheme *sc, s7_pointer arg)   {return((is_null(v_lookup(sc, cadr(arg), arg))) ? sc->T : sc->F);}
+static s7_pointer fx_is_null_T(s7_scheme *sc, s7_pointer arg)   {return((is_null(T_lookup(sc, cadr(arg), arg))) ? sc->T : sc->F);}
+static s7_pointer fx_is_symbol_s(s7_scheme *sc, s7_pointer arg) {return((is_symbol(lookup(sc, cadr(arg)))) ? sc->T : sc->F);}
+static s7_pointer fx_is_symbol_t(s7_scheme *sc, s7_pointer arg) {return((is_symbol(t_lookup(sc, cadr(arg), arg))) ? sc->T : sc->F);}
+static s7_pointer fx_is_symbol_u(s7_scheme *sc, s7_pointer arg) {return((is_symbol(u_lookup(sc, cadr(arg), arg))) ? sc->T : sc->F);}
+static s7_pointer fx_is_eof_s(s7_scheme *sc, s7_pointer arg)    {return((lookup(sc, cadr(arg)) == eof_object) ? sc->T : sc->F);}
+static s7_pointer fx_is_eof_t(s7_scheme *sc, s7_pointer arg)    {return((t_lookup(sc, cadr(arg), arg) == eof_object) ? sc->T : sc->F);}
+static s7_pointer fx_is_eof_u(s7_scheme *sc, s7_pointer arg)    {return((u_lookup(sc, cadr(arg), arg) == eof_object) ? sc->T : sc->F);}
+static s7_pointer fx_is_type_s(s7_scheme *sc, s7_pointer arg)   {return(make_boolean(sc, (uint8_t)(opt3_byte(cdr(arg))) == type(lookup(sc, cadr(arg)))));}
+static s7_pointer fx_is_type_t(s7_scheme *sc, s7_pointer arg)   {return(make_boolean(sc, (uint8_t)(opt3_byte(cdr(arg))) == type(t_lookup(sc, cadr(arg), arg))));}
+static s7_pointer fx_is_type_u(s7_scheme *sc, s7_pointer arg)   {return(make_boolean(sc, (uint8_t)(opt3_byte(cdr(arg))) == type(u_lookup(sc, cadr(arg), arg))));}
+#if WITH_GMP
+static s7_pointer fx_is_integer_s(s7_scheme *sc, s7_pointer arg) {return((s7_is_integer(lookup(sc, cadr(arg)))) ? sc->T : sc->F);}
+static s7_pointer fx_is_integer_t(s7_scheme *sc, s7_pointer arg) {return((s7_is_integer(t_lookup(sc, cadr(arg), arg))) ? sc->T : sc->F);}
+#else
+static s7_pointer fx_is_integer_s(s7_scheme *sc, s7_pointer arg) {return((is_t_integer(lookup(sc, cadr(arg)))) ? sc->T : sc->F);}
+static s7_pointer fx_is_integer_t(s7_scheme *sc, s7_pointer arg) {return((is_t_integer(t_lookup(sc, cadr(arg), arg))) ? sc->T : sc->F);}
+#endif
+static s7_pointer fx_is_string_s(s7_scheme *sc, s7_pointer arg)    {return((is_string(lookup(sc, cadr(arg)))) ? sc->T : sc->F);}
+static s7_pointer fx_is_string_t(s7_scheme *sc, s7_pointer arg)    {return((is_string(t_lookup(sc, cadr(arg), arg))) ? sc->T : sc->F);}
+static s7_pointer fx_is_procedure_s(s7_scheme *sc, s7_pointer arg) {return((is_procedure(lookup(sc, cadr(arg)))) ? sc->T : sc->F);}
+static s7_pointer fx_is_procedure_t(s7_scheme *sc, s7_pointer arg) {return((is_procedure(t_lookup(sc, cadr(arg), arg))) ? sc->T : sc->F);}
+static s7_pointer fx_is_pair_s(s7_scheme *sc, s7_pointer arg)      {return((is_pair(lookup(sc, cadr(arg)))) ? sc->T : sc->F);}
+static s7_pointer fx_is_pair_t(s7_scheme *sc, s7_pointer arg)      {return((is_pair(t_lookup(sc, cadr(arg), arg))) ? sc->T : sc->F);}
+static s7_pointer fx_is_pair_u(s7_scheme *sc, s7_pointer arg)      {return((is_pair(u_lookup(sc, cadr(arg), arg))) ? sc->T : sc->F);}
+static s7_pointer fx_is_pair_v(s7_scheme *sc, s7_pointer arg)      {return((is_pair(v_lookup(sc, cadr(arg), arg))) ? sc->T : sc->F);}
+static s7_pointer fx_is_keyword_s(s7_scheme *sc, s7_pointer arg)   {return((is_symbol_and_keyword(lookup(sc, cadr(arg)))) ? sc->T : sc->F);}
+static s7_pointer fx_is_vector_s(s7_scheme *sc, s7_pointer arg)    {return((is_any_vector(lookup(sc, cadr(arg)))) ? sc->T : sc->F);}
+static s7_pointer fx_is_vector_t(s7_scheme *sc, s7_pointer arg)    {return((is_any_vector(t_lookup(sc, cadr(arg), arg))) ? sc->T : sc->F);}
+static s7_pointer fx_is_proper_list_s(s7_scheme *sc, s7_pointer arg) {return((s7_is_proper_list(sc, lookup(sc, cadr(arg)))) ? sc->T : sc->F);}
+static s7_pointer fx_not_s(s7_scheme *sc, s7_pointer arg) {return(make_boolean(sc, is_false(sc, lookup(sc, cadr(arg)))));}
+static s7_pointer fx_not_t(s7_scheme *sc, s7_pointer arg) {return(make_boolean(sc, is_false(sc, t_lookup(sc, cadr(arg), arg))));}
+static s7_pointer fx_not_o(s7_scheme *sc, s7_pointer arg) {return(make_boolean(sc, is_false(sc, o_lookup(sc, cadr(arg), arg))));}
+static s7_pointer fx_not_is_pair_s(s7_scheme *sc, s7_pointer arg)  {return((is_pair(lookup(sc, opt3_sym(arg)))) ? sc->F : sc->T);}
+static s7_pointer fx_not_is_pair_t(s7_scheme *sc, s7_pointer arg)  {return((is_pair(t_lookup(sc, opt3_sym(arg), arg))) ? sc->F : sc->T);}
+static s7_pointer fx_not_is_pair_u(s7_scheme *sc, s7_pointer arg)  {return((is_pair(u_lookup(sc, opt3_sym(arg), arg))) ? sc->F : sc->T);}
+static s7_pointer fx_not_is_pair_v(s7_scheme *sc, s7_pointer arg)  {return((is_pair(v_lookup(sc, opt3_sym(arg), arg))) ? sc->F : sc->T);}
+static s7_pointer fx_not_is_null_s(s7_scheme *sc, s7_pointer arg)  {return((is_null(lookup(sc, opt3_sym(arg)))) ? sc->F : sc->T);}
+static s7_pointer fx_not_is_null_t(s7_scheme *sc, s7_pointer arg)  {return((is_null(t_lookup(sc, opt3_sym(arg), arg))) ? sc->F : sc->T);}
+static s7_pointer fx_not_is_null_u(s7_scheme *sc, s7_pointer arg)  {return((is_null(u_lookup(sc, opt3_sym(arg), arg))) ? sc->F : sc->T);}
+static s7_pointer fx_not_is_symbol_s(s7_scheme *sc, s7_pointer arg) {return((is_symbol(lookup(sc, opt3_sym(arg)))) ? sc->F : sc->T);}
+static s7_pointer fx_not_is_symbol_t(s7_scheme *sc, s7_pointer arg) {return((is_symbol(t_lookup(sc, opt3_sym(arg), arg))) ? sc->F : sc->T);}
+
+#define fx_c_sc_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    set_car(sc->t2_1, Lookup(sc, cadr(arg), arg)); \
+    set_car(sc->t2_2, opt2_con(cdr(arg))); \
+    return(fn_proc(arg)(sc, sc->t2_1)); \
+  }
+
+fx_c_sc_any(fx_c_sc, s_lookup)
+fx_c_sc_any(fx_c_tc, t_lookup)
+fx_c_sc_any(fx_c_uc, u_lookup)  /* few hits */
+fx_c_sc_any(fx_c_vc, v_lookup)
+fx_c_sc_any(fx_c_oc, o_lookup)
+
+
+static s7_pointer fx_c_sc_direct(s7_scheme *sc, s7_pointer arg) {return(((s7_p_pp_t)opt3_direct(cdr(arg)))(sc, lookup(sc, cadr(arg)), opt2_con(cdr(arg))));}
+static s7_pointer fx_c_si_direct(s7_scheme *sc, s7_pointer arg) {return(((s7_p_pi_t)opt3_direct(cdr(arg)))(sc, lookup(sc, cadr(arg)), integer(opt2_con(cdr(arg)))));}
+static s7_pointer fx_c_ti_direct(s7_scheme *sc, s7_pointer arg) {return(((s7_p_pi_t)opt3_direct(cdr(arg)))(sc, t_lookup(sc, cadr(arg), arg), integer(opt2_con(cdr(arg)))));}
+static s7_pointer fx_c_ti_remainder(s7_scheme *sc, s7_pointer arg) {return(remainder_p_pi(sc, t_lookup(sc, cadr(arg), arg), integer(opt2_con(cdr(arg)))));}
+static s7_pointer fx_c_tc_direct(s7_scheme *sc, s7_pointer arg) {return(((s7_p_pp_t)opt3_direct(cdr(arg)))(sc, t_lookup(sc, cadr(arg), arg), opt2_con(cdr(arg))));}
+static s7_pointer fx_vector_ref_tc(s7_scheme *sc, s7_pointer arg) {return(vector_ref_p_pi(sc, t_lookup(sc, cadr(arg), arg), integer(opt2_con(cdr(arg)))));}
+  /* tc happens a lot, but others almost never */
+
+static s7_pointer fx_memq_sc(s7_scheme *sc, s7_pointer arg)   {return(memq_p_pp(sc, lookup(sc, cadr(arg)), opt2_con(cdr(arg))));}
+static s7_pointer fx_memq_sc_3(s7_scheme *sc, s7_pointer arg) {return(memq_3_p_pp(sc, lookup(sc, cadr(arg)), opt2_con(cdr(arg))));}
+static s7_pointer fx_memq_tc(s7_scheme *sc, s7_pointer arg)   {return(memq_p_pp(sc, t_lookup(sc, cadr(arg), arg), opt2_con(cdr(arg))));}
+static s7_pointer fx_leq_sc(s7_scheme *sc, s7_pointer arg)    {return(leq_p_pp(sc, lookup(sc, cadr(arg)), opt2_con(cdr(arg))));}
+static s7_pointer fx_lt_sc(s7_scheme *sc, s7_pointer arg)     {return(lt_p_pp(sc, lookup(sc, cadr(arg)), opt2_con(cdr(arg))));}
+static s7_pointer fx_gt_sc(s7_scheme *sc, s7_pointer arg)     {return(gt_p_pp(sc, lookup(sc, cadr(arg)), opt2_con(cdr(arg))));}
+static s7_pointer fx_geq_sc(s7_scheme *sc, s7_pointer arg)    {return(geq_p_pp(sc, lookup(sc, cadr(arg)), opt2_con(cdr(arg))));}
+static s7_pointer fx_list_sc(s7_scheme *sc, s7_pointer arg)   {return(list_2(sc, lookup(sc, cadr(arg)), opt2_con(cdr(arg))));}
+
+#define fx_char_eq_sc_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer c = Lookup(sc, cadr(arg), arg); \
+    if (c == opt2_con(cdr(arg))) return(sc->T); \
+    if (is_character(c)) return(sc->F); \
+    return(method_or_bust(sc, cadr(arg), sc->char_eq_symbol, cdr(arg), sc->type_names[T_CHARACTER], 1)); \
+  }
+
+fx_char_eq_sc_any(fx_char_eq_sc, s_lookup)
+fx_char_eq_sc_any(fx_char_eq_tc, t_lookup)
+
+
+#define fx_c_cs_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    set_car(sc->t2_1, opt1_con(cdr(arg))); /* cadr(arg) or cadadr */ \
+    set_car(sc->t2_2, Lookup(sc, opt2_sym(cdr(arg)), arg)); /* caddr(arg) */ \
+    return(fn_proc(arg)(sc, sc->t2_1)); \
+  }
+
+fx_c_cs_any(fx_c_cs, s_lookup)
+fx_c_cs_any(fx_c_ct, t_lookup)
+fx_c_cs_any(fx_c_cu, u_lookup)
+
+
+static s7_pointer fx_c_ct_direct(s7_scheme *sc, s7_pointer arg)
+{
+  return(((s7_p_pp_t)opt3_direct(cdr(arg)))(sc, opt1_con(cdr(arg)), t_lookup(sc, opt2_sym(cdr(arg)), arg)));
+}
+
+static s7_pointer fx_cons_cs(s7_scheme *sc, s7_pointer arg) {return(cons(sc, opt1_con(cdr(arg)), lookup(sc, opt2_sym(cdr(arg)))));}
+static s7_pointer fx_cons_ct(s7_scheme *sc, s7_pointer arg) {return(cons(sc, opt1_con(cdr(arg)), t_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+
+
+#define fx_c_ss_any(Name, Lookup1, Lookup2) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    set_car(sc->t2_1, Lookup1(sc, cadr(arg), arg)); \
+    set_car(sc->t2_2, Lookup2(sc, opt2_sym(cdr(arg)), arg)); \
+    return(fn_proc(arg)(sc, sc->t2_1)); \
+}
+
+fx_c_ss_any(fx_c_ss, s_lookup, s_lookup)
+fx_c_ss_any(fx_c_st, s_lookup, t_lookup)
+fx_c_ss_any(fx_c_ts, t_lookup, s_lookup)
+fx_c_ss_any(fx_c_tu, t_lookup, u_lookup)
+fx_c_ss_any(fx_c_uv, u_lookup, v_lookup)
+fx_c_ss_any(fx_c_tU, t_lookup, U_lookup)
+
+static s7_pointer fx_memq_ss(s7_scheme *sc, s7_pointer arg) {return(memq_p_pp(sc, lookup(sc, cadr(arg)), lookup(sc, opt2_sym(cdr(arg)))));}
+static s7_pointer fx_memq_tu(s7_scheme *sc, s7_pointer arg) {return(memq_p_pp(sc, t_lookup(sc, cadr(arg), arg), u_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_assq_ss(s7_scheme *sc, s7_pointer arg) {return(assq_p_pp(sc, lookup(sc, cadr(arg)), lookup(sc, opt2_sym(cdr(arg)))));}
+static s7_pointer fx_vref_ss(s7_scheme *sc, s7_pointer arg) {return(vector_ref_p_pp(sc, lookup(sc, cadr(arg)), lookup(sc, opt2_sym(cdr(arg)))));}
+static s7_pointer fx_vref_st(s7_scheme *sc, s7_pointer arg) {return(vector_ref_p_pp(sc, lookup(sc, cadr(arg)), t_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_vref_ts(s7_scheme *sc, s7_pointer arg) {return(vector_ref_p_pp(sc, t_lookup(sc, cadr(arg), arg), s_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_vref_tu(s7_scheme *sc, s7_pointer arg) {return(vector_ref_p_pp(sc, t_lookup(sc, cadr(arg), arg), u_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_vref_ot(s7_scheme *sc, s7_pointer arg) {return(vector_ref_p_pp(sc, o_lookup(sc, cadr(arg), arg), t_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_vref_gt(s7_scheme *sc, s7_pointer arg) {return(vector_ref_p_pp(sc, lookup_global(sc, cadr(arg)), t_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_sref_ss(s7_scheme *sc, s7_pointer arg) {return(string_ref_p_pp(sc, lookup(sc, cadr(arg)), lookup(sc, opt2_sym(cdr(arg)))));}
+static s7_pointer fx_sref_su(s7_scheme *sc, s7_pointer arg) {return(string_ref_p_pp(sc, lookup(sc, cadr(arg)), u_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_cons_ss(s7_scheme *sc, s7_pointer arg) {return(cons(sc, lookup(sc, cadr(arg)), lookup(sc, opt2_sym(cdr(arg)))));}
+static s7_pointer fx_cons_st(s7_scheme *sc, s7_pointer arg) {return(cons(sc, s_lookup(sc, cadr(arg), arg), t_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_cons_ts(s7_scheme *sc, s7_pointer arg) {return(cons(sc, t_lookup(sc, cadr(arg), arg), lookup(sc, opt2_sym(cdr(arg)))));}
+static s7_pointer fx_cons_tu(s7_scheme *sc, s7_pointer arg) {return(cons(sc, t_lookup(sc, cadr(arg), arg), u_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_cons_tU(s7_scheme *sc, s7_pointer arg) {return(cons(sc, t_lookup(sc, cadr(arg), arg), U_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+/* static s7_pointer fx_cons_Ts(s7_scheme *sc, s7_pointer arg) {return(cons(sc, T_lookup(sc, cadr(arg), arg), s_lookup(sc, opt2_sym(cdr((arg)), arg)));} */
+
+#define fx_c_ss_direct_any(Name, Lookup1, Lookup2) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    return(((s7_p_pp_t)opt3_direct(cdr(arg)))(sc, Lookup1(sc, cadr(arg), arg), Lookup2(sc, opt2_sym(cdr(arg)), arg))); \
+  }
+
+fx_c_ss_direct_any(fx_c_ss_direct, s_lookup, s_lookup)
+fx_c_ss_direct_any(fx_c_ts_direct, t_lookup, s_lookup)
+fx_c_ss_direct_any(fx_c_tu_direct, t_lookup, u_lookup)
+fx_c_ss_direct_any(fx_c_st_direct, s_lookup, t_lookup)
+fx_c_ss_direct_any(fx_c_gt_direct, g_lookup, t_lookup)
+fx_c_ss_direct_any(fx_c_tU_direct, t_lookup, U_lookup)
+
+static s7_pointer fx_multiply_ss(s7_scheme *sc, s7_pointer arg) {return(multiply_p_pp(sc, lookup(sc, cadr(arg)), lookup(sc, opt2_sym(cdr(arg)))));}
+static s7_pointer fx_multiply_ts(s7_scheme *sc, s7_pointer arg) {return(multiply_p_pp(sc, t_lookup(sc, cadr(arg), arg), lookup(sc, opt2_sym(cdr(arg)))));}
+/* static s7_pointer fx_multiply_Ts(s7_scheme *sc, s7_pointer arg) {return(multiply_p_pp(sc, T_lookup(sc, cadr(arg), arg), lookup(sc, opt2_sym(cdr(arg)))));} */
+static s7_pointer fx_multiply_fs(s7_scheme *sc, s7_pointer arg) {return(g_mul_xf(sc, lookup(sc, opt2_sym(cdr(arg))), real(cadr(arg)), 2));}
+static s7_pointer fx_multiply_sf(s7_scheme *sc, s7_pointer arg) {return(g_mul_xf(sc, lookup(sc, cadr(arg)), real(opt2_con(cdr(arg))), 1));}
+static s7_pointer fx_multiply_tf(s7_scheme *sc, s7_pointer arg) {return(g_mul_xf(sc, t_lookup(sc, cadr(arg), arg), real(opt2_con(cdr(arg))), 1));}
+static s7_pointer fx_multiply_si(s7_scheme *sc, s7_pointer arg) {return(g_mul_xi(sc, lookup(sc, cadr(arg)), integer(opt2_con(cdr(arg))), 1));}
+static s7_pointer fx_multiply_ti(s7_scheme *sc, s7_pointer arg) {return(g_mul_xi(sc, t_lookup(sc, cadr(arg), arg), integer(opt2_con(cdr(arg))), 1));}
+static s7_pointer fx_multiply_ui(s7_scheme *sc, s7_pointer arg) {return(g_mul_xi(sc, u_lookup(sc, cadr(arg), arg), integer(opt2_con(cdr(arg))), 1));}
+static s7_pointer fx_multiply_is(s7_scheme *sc, s7_pointer arg) {return(g_mul_xi(sc, lookup(sc, opt2_sym(cdr(arg))), integer(cadr(arg)), 2));}
+static s7_pointer fx_multiply_it(s7_scheme *sc, s7_pointer arg) {return(g_mul_xi(sc, t_lookup(sc, opt2_sym(cdr(arg)), arg), integer(cadr(arg)), 2));}
+static s7_pointer fx_multiply_tu(s7_scheme *sc, s7_pointer arg) {return(multiply_p_pp(sc, t_lookup(sc, cadr(arg), arg), u_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+
+static inline s7_pointer fx_sqr_1(s7_scheme *sc, s7_pointer x)
+{
+  if (is_t_real(x)) return(make_real(sc, real(x) * real(x)));
+
+#if WITH_GMP
+  return(multiply_p_pp(sc, x, x));
+#else
+  switch (type(x))
+    {
+#if HAVE_OVERFLOW_CHECKS
+    case T_INTEGER:
+      {
+	s7_int val;
+	if (multiply_overflow(integer(x), integer(x), &val))
+	  {
+	    if (WITH_WARNINGS) s7_warn(sc, 128, "integer sqr overflow: (* %" ld64 " %" ld64 ")\n", integer(x), integer(x));
+	    return(make_real(sc, (long_double)integer(x) * (long_double)integer(x)));
+	  }
+	return(make_integer(sc, val));
+      }
+    case T_RATIO:
+      {
+	s7_int num, den;
+	if ((multiply_overflow(numerator(x), numerator(x), &num)) ||
+	    (multiply_overflow(denominator(x), denominator(x), &den)))
+	  return(make_real(sc, fraction(x) * fraction(x)));
+	return(make_ratio_with_div_check(sc, sc->multiply_symbol, num, den));
+      }
+#else
+    case T_INTEGER: return(make_integer(sc, integer(x) * integer(x)));
+    case T_RATIO:   return(make_ratio(sc, numerator(x) * numerator(x), denominator(x) * denominator(x)));
+#endif
+    case T_REAL:    return(make_real(sc, real(x) * real(x)));
+    case T_COMPLEX: return(make_complex(sc, real_part(x) * real_part(x) - imag_part(x) * imag_part(x), 2.0 * real_part(x) * imag_part(x)));
+    default:        return(method_or_bust_pp(sc, x, sc->multiply_symbol, x, x, a_number_string, 1));
+    }
+  return(x);
+#endif
+}
+
+static s7_pointer fx_sqr_s(s7_scheme *sc, s7_pointer arg) {return(fx_sqr_1(sc, lookup(sc, cadr(arg))));}
+static s7_pointer fx_sqr_t(s7_scheme *sc, s7_pointer arg) {return(fx_sqr_1(sc, t_lookup(sc, cadr(arg), arg)));}
+
+static s7_pointer fx_add_sqr_sqr(s7_scheme *sc, s7_pointer arg)  /* tbig -- need t case here */
+{
+  sc->temp5 = fx_sqr_1(sc, lookup(sc, car(opt1_pair(cdr(arg)))));                   /* cadadr(arg) */
+  return(add_p_pp(sc, sc->temp5, fx_sqr_1(sc, lookup(sc, car(opt3_pair(arg))))));   /* cadaddr(arg) */
+}
+
+static s7_pointer fx_c_s_sqr(s7_scheme *sc, s7_pointer arg) /* call */
+{
+  set_car(sc->t2_1, lookup(sc, cadr(arg)));
+  set_car(sc->t2_2, fx_sqr_1(sc, lookup(sc, opt2_sym(cdr(arg))))); /* cadaddr(arg) */
+  return(fn_proc(arg)(sc, sc->t2_1));
+}
+
+static s7_pointer fx_c_c_sqr(s7_scheme *sc, s7_pointer arg) /* fb */
+{
+  set_car(sc->t2_2, fx_sqr_1(sc, lookup(sc, opt1_sym(cdr(arg))))); /* cadaddr(arg) */
+  set_car(sc->t2_1, cadr(arg));
+  return(fn_proc(arg)(sc, sc->t2_1));
+}
+
+static s7_pointer fx_geq_ss(s7_scheme *sc, s7_pointer arg) {return(geq_p_pp(sc, lookup(sc, cadr(arg)), lookup(sc, opt2_sym(cdr(arg)))));}
+static s7_pointer fx_geq_ts(s7_scheme *sc, s7_pointer arg) {return(geq_p_pp(sc, t_lookup(sc, cadr(arg), arg), lookup(sc, opt2_sym(cdr(arg)))));}
+static s7_pointer fx_geq_st(s7_scheme *sc, s7_pointer arg) {return(geq_p_pp(sc, lookup(sc, cadr(arg)), t_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_geq_us(s7_scheme *sc, s7_pointer arg) {return(geq_p_pp(sc, u_lookup(sc, cadr(arg), arg), lookup(sc, opt2_sym(cdr(arg)))));}
+static s7_pointer fx_geq_vs(s7_scheme *sc, s7_pointer arg) {return(geq_p_pp(sc, v_lookup(sc, cadr(arg), arg), lookup(sc, opt2_sym(cdr(arg)))));}
+static s7_pointer fx_geq_tT(s7_scheme *sc, s7_pointer arg) {return(geq_p_pp(sc, t_lookup(sc, cadr(arg), arg), T_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_geq_tu(s7_scheme *sc, s7_pointer arg) {return(geq_p_pp(sc, t_lookup(sc, cadr(arg), arg), u_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_geq_TU(s7_scheme *sc, s7_pointer arg) {return(geq_p_pp(sc, T_lookup(sc, cadr(arg), arg), U_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_geq_to(s7_scheme *sc, s7_pointer arg) {return(geq_p_pp(sc, t_lookup(sc, cadr(arg), arg), o_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_geq_vo(s7_scheme *sc, s7_pointer arg) {return(geq_p_pp(sc, v_lookup(sc, cadr(arg), arg), o_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_geq_ot(s7_scheme *sc, s7_pointer arg) {return(geq_p_pp(sc, o_lookup(sc, cadr(arg), arg), t_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+
+static s7_pointer fx_gt_ss(s7_scheme *sc, s7_pointer arg) {return(gt_p_pp(sc, lookup(sc, cadr(arg)), lookup(sc, opt2_sym(cdr(arg)))));}
+static s7_pointer fx_gt_ts(s7_scheme *sc, s7_pointer arg) {return(gt_p_pp(sc, t_lookup(sc, cadr(arg), arg), lookup(sc, opt2_sym(cdr(arg)))));}
+static s7_pointer fx_gt_to(s7_scheme *sc, s7_pointer arg) {return(gt_p_pp(sc, t_lookup(sc, cadr(arg), arg), o_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_gt_tu(s7_scheme *sc, s7_pointer arg) {return(gt_p_pp(sc, t_lookup(sc, cadr(arg), arg), u_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_gt_ut(s7_scheme *sc, s7_pointer arg) {return(gt_p_pp(sc, u_lookup(sc, cadr(arg), arg), t_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_gt_tg(s7_scheme *sc, s7_pointer arg) {return(gt_p_pp(sc, t_lookup(sc, cadr(arg), arg), global_value(opt2_sym(cdr(arg)))));}
+
+static s7_pointer fx_gt_tT(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p1 = t_lookup(sc, cadr(arg), arg);
+  s7_pointer p2 = T_lookup(sc, opt2_sym(cdr(arg)), arg);
+  return(((is_t_integer(p1)) && (is_t_integer(p2))) ? make_boolean(sc, integer(p1) > integer(p2)) : gt_p_pp(sc, p1, p2));
+}
+
+#define fx_gt_si_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer x = Lookup(sc, cadr(arg), arg); \
+    if (is_t_integer(x)) return(make_boolean(sc, integer(x) > integer(opt2_con(cdr(arg))))); \
+    if (is_t_real(x)) return(make_boolean(sc, real(x) > integer(opt2_con(cdr(arg))))); \
+    return(g_greater_xi(sc, set_plist_2(sc, x, opt2_con(cdr(arg))))); /* caddr(arg) */ \
+  }
+
+fx_gt_si_any(fx_gt_si, s_lookup)
+fx_gt_si_any(fx_gt_ti, t_lookup)
+fx_gt_si_any(fx_gt_ui, u_lookup)
+
+static s7_pointer fx_leq_ss(s7_scheme *sc, s7_pointer arg) {return(leq_p_pp(sc, lookup(sc, cadr(arg)), lookup(sc, opt2_sym(cdr(arg)))));}
+static s7_pointer fx_leq_ts(s7_scheme *sc, s7_pointer arg) {return(leq_p_pp(sc, t_lookup(sc, cadr(arg), arg), lookup(sc, opt2_sym(cdr(arg)))));}
+static s7_pointer fx_leq_tu(s7_scheme *sc, s7_pointer arg) {return(leq_p_pp(sc, t_lookup(sc, cadr(arg), arg), u_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+
+#define fx_leq_si_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer x = Lookup(sc, cadr(arg), arg); \
+    if (is_t_integer(x)) return(make_boolean(sc, integer(x) <= integer(opt2_con(cdr(arg))))); \
+    return(g_leq_xi(sc, set_plist_2(sc, x, opt2_con(cdr(arg))))); /* caddr(arg) */ \
+  }
+
+fx_leq_si_any(fx_leq_si, s_lookup)
+fx_leq_si_any(fx_leq_ti, t_lookup)
+fx_leq_si_any(fx_leq_ui, u_lookup)
+fx_leq_si_any(fx_leq_vi, v_lookup)
+
+static s7_pointer fx_lt_ss(s7_scheme *sc, s7_pointer arg) {return(lt_p_pp(sc, lookup(sc, cadr(arg)), lookup(sc, opt2_sym(cdr(arg)))));}
+static s7_pointer fx_lt_sg(s7_scheme *sc, s7_pointer arg) {return(lt_p_pp(sc, lookup(sc, cadr(arg)), lookup_global(sc, opt2_sym(cdr(arg)))));}
+static s7_pointer fx_lt_tg(s7_scheme *sc, s7_pointer arg) {return(lt_p_pp(sc, t_lookup(sc, cadr(arg), arg), lookup_global(sc, opt2_sym(cdr(arg)))));}
+
+static s7_pointer fx_lt_gsg(s7_scheme *sc, s7_pointer arg) /* gsg is much faster than sss */
+{
+  s7_pointer v1 = lookup_global(sc, cadr(arg));
+  s7_pointer v2 = lookup(sc, opt1_sym(cdr(arg)));        /* caddr(arg) */
+  s7_pointer v3 = lookup_global(sc, opt2_sym(cdr(arg))); /* cadddr(arg) */
+  if ((is_t_integer(v1)) && (is_t_integer(v2)) && (is_t_integer(v3)))
+    return(make_boolean(sc, ((integer(v1) < integer(v2)) && (integer(v2) < integer(v3)))));
+  if (!is_real(v3))
+    wrong_type_error_nr(sc, sc->lt_symbol, 3, v3, sc->type_names[T_REAL]); /* else (< 2 1 1+i) returns #f */
+  return(make_boolean(sc, (lt_b_7pp(sc, v1, v2)) && (lt_b_7pp(sc, v2, v3))));
+}
+
+static s7_pointer fx_lt_ts(s7_scheme *sc, s7_pointer arg) {return(lt_p_pp(sc, t_lookup(sc, cadr(arg), arg), lookup(sc, opt2_sym(cdr(arg)))));}
+static s7_pointer fx_lt_tT(s7_scheme *sc, s7_pointer arg) {return(lt_p_pp(sc, t_lookup(sc, cadr(arg), arg), T_lookup(sc, opt2_sym(cdr(arg)), cadr(arg))));}
+static s7_pointer fx_lt_tu(s7_scheme *sc, s7_pointer arg) {return(lt_p_pp(sc, t_lookup(sc, cadr(arg), arg), u_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_lt_tU(s7_scheme *sc, s7_pointer arg) {return(lt_p_pp(sc, t_lookup(sc, cadr(arg), arg), U_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_lt_ut(s7_scheme *sc, s7_pointer arg) {return(lt_p_pp(sc, u_lookup(sc, cadr(arg), arg), t_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+
+static s7_pointer fx_lt_tf(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer x = t_lookup(sc, cadr(arg), arg);
+  if (is_t_real(x)) return(make_boolean(sc, real(x) < real(opt2_con(cdr(arg)))));
+  return(g_less_xf(sc, set_plist_2(sc, x, opt2_con(cdr(arg))))); /* caddr(arg) */
+}
+
+#define fx_lt_si_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer x = Lookup(sc, cadr(arg), arg); \
+    if (is_t_integer(x)) return(make_boolean(sc, integer(x) < integer(opt2_con(cdr(arg))))); \
+    return(g_less_xi(sc, set_plist_2(sc, x, opt2_con(cdr(arg))))); /* caddr(arg) */ \
+  }
+
+fx_lt_si_any(fx_lt_si, s_lookup)
+fx_lt_si_any(fx_lt_ti, t_lookup)
+
+static s7_pointer fx_lt_t0(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer x = t_lookup(sc, cadr(arg), arg);
+  if (is_t_integer(x)) return(make_boolean(sc, integer(x) < 0));
+  return(g_less_xi(sc, set_plist_2(sc, x, int_zero)));
+}
+
+static s7_pointer fx_lt_t1(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer x = t_lookup(sc, cadr(arg), arg);
+  if (is_t_integer(x)) return(make_boolean(sc, integer(x) < 1));
+  return(g_less_xi(sc, set_plist_2(sc, x, int_one)));
+}
+
+static s7_pointer fx_lt_t2(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer x = t_lookup(sc, cadr(arg), arg);
+  if (is_t_integer(x)) return(make_boolean(sc, integer(x) < 2));
+  return(g_less_xi(sc, set_plist_2(sc, x, int_two)));
+}
+
+static s7_pointer fx_geq_tf(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer x = t_lookup(sc, cadr(arg), arg);
+  if (is_t_real(x)) return(make_boolean(sc, real(x) >= real(opt2_con(cdr(arg)))));
+  return(g_geq_xf(sc, set_plist_2(sc, x, opt2_con(cdr(arg))))); /* caddr(arg) */
+}
+
+#define fx_geq_si_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer x = Lookup(sc, cadr(arg), arg); \
+    if (is_t_integer(x)) return(make_boolean(sc, integer(x) >= integer(opt2_con(cdr(arg))))); \
+    return(g_geq_xi(sc, set_plist_2(sc, x, opt2_con(cdr(arg))))); /* caddr(arg) */ \
+  }
+
+fx_geq_si_any(fx_geq_si, s_lookup)
+fx_geq_si_any(fx_geq_ti, t_lookup)
+
+static s7_pointer fx_geq_t0(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer x = t_lookup(sc, cadr(arg), arg);
+  if (is_t_integer(x)) return(make_boolean(sc, integer(x) >= 0));
+  return(g_geq_xi(sc, set_plist_2(sc, x, int_zero)));
+}
+
+#define fx_num_eq_ss_any(Name, Lookup1, Lookup2) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer x = Lookup1(sc, cadr(arg), arg); \
+    s7_pointer y = Lookup2(sc, opt2_sym(cdr(arg)), arg);				\
+    return(make_boolean(sc, ((is_t_integer(x)) && (is_t_integer(y))) ? (integer(x) == integer(y)) : num_eq_b_7pp(sc, x, y))); \
+  }
+
+fx_num_eq_ss_any(fx_num_eq_ss, s_lookup, s_lookup)
+fx_num_eq_ss_any(fx_num_eq_ts, t_lookup, s_lookup)
+fx_num_eq_ss_any(fx_num_eq_to, t_lookup, o_lookup)
+fx_num_eq_ss_any(fx_num_eq_tg, t_lookup, g_lookup)
+fx_num_eq_ss_any(fx_num_eq_tT, t_lookup, T_lookup)
+fx_num_eq_ss_any(fx_num_eq_tu, t_lookup, u_lookup)
+fx_num_eq_ss_any(fx_num_eq_tv, t_lookup, v_lookup)
+fx_num_eq_ss_any(fx_num_eq_ut, u_lookup, t_lookup)
+fx_num_eq_ss_any(fx_num_eq_us, u_lookup, s_lookup)
+fx_num_eq_ss_any(fx_num_eq_vs, v_lookup, s_lookup)
+fx_num_eq_ss_any(fx_num_eq_uU, u_lookup, U_lookup)
+fx_num_eq_ss_any(fx_num_eq_vU, v_lookup, U_lookup)
+
+
+#define fx_is_eq_ss_any(Name, Lookup1, Lookup2) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer x = Lookup1(sc, cadr(arg), arg);	      \
+    s7_pointer y = Lookup2(sc, opt2_sym(cdr(arg)), arg); \
+    return(make_boolean(sc, (x == y) || ((is_unspecified(x)) && (is_unspecified(y))))); \
+  }
+
+fx_is_eq_ss_any(fx_is_eq_ss, s_lookup, s_lookup)
+fx_is_eq_ss_any(fx_is_eq_ts, t_lookup, s_lookup)
+fx_is_eq_ss_any(fx_is_eq_tu, t_lookup, u_lookup)
+fx_is_eq_ss_any(fx_is_eq_to, t_lookup, o_lookup)
+
+
+static s7_pointer fx_not_is_eq_ss(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer x = lookup(sc, opt3_sym(arg));
+  s7_pointer y = lookup(sc, opt1_sym(cdr(arg)));
+  return(make_boolean(sc, (x != y) && ((!is_unspecified(x)) || (!is_unspecified(y)))));
+}
+
+static s7_pointer fx_not_is_eq_sq(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer x = lookup(sc, opt3_sym(arg));
+  s7_pointer y = opt3_con(cdr(arg));
+  return(make_boolean(sc, (x != y) && ((!is_unspecified(x)) || (!is_unspecified(y)))));
+}
+
+static s7_pointer x_hash_table_ref_ss(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+  return((is_hash_table(table)) ? hash_entry_value((*hash_table_checker(table))(sc, table, key)) : g_hash_table_ref(sc, set_plist_2(sc, table, key)));
+}
+
+static s7_pointer fx_hash_table_ref_ss(s7_scheme *sc, s7_pointer arg) {return(x_hash_table_ref_ss(sc, lookup(sc, cadr(arg)), lookup(sc, opt2_sym(cdr(arg)))));}
+static s7_pointer fx_hash_table_ref_st(s7_scheme *sc, s7_pointer arg) {return(x_hash_table_ref_ss(sc, lookup(sc, cadr(arg)), t_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+static s7_pointer fx_hash_table_ref_TV(s7_scheme *sc, s7_pointer arg) {return(x_hash_table_ref_ss(sc, T_lookup(sc, cadr(arg), arg), V_lookup(sc, opt2_sym(cdr(arg)), arg)));}
+
+static s7_pointer fx_hash_table_ref_car(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer table = lookup(sc, cadr(arg));
+  s7_pointer lst = lookup(sc, opt2_sym(cdr(arg)));
+  if (!is_pair(lst))
+    sole_arg_wrong_type_error_nr(sc, sc->car_symbol, lst, sc->type_names[T_PAIR]);
+  return((is_hash_table(table)) ? hash_entry_value((*hash_table_checker(table))(sc, table, car(lst))) : g_hash_table_ref(sc, set_plist_2(sc, table, car(lst))));
+}
+
+
+static inline s7_pointer fx_hash_table_increment_1(s7_scheme *sc, s7_pointer table, s7_pointer key, s7_pointer arg)
+{
+  hash_entry_t *val;
+  if (!is_hash_table(table))
+    return(mutable_method_or_bust_ppp(sc, table, sc->hash_table_set_symbol, table, key, fx_call(sc, cdddr(arg)), sc->type_names[T_HASH_TABLE], 1));
+  val = (*hash_table_checker(table))(sc, table, key);
+  if (val != sc->unentry)
+    {
+      if (!is_t_integer(hash_entry_value(val)))
+	sole_arg_wrong_type_error_nr(sc, sc->add_symbol, cadddr(arg), sc->type_names[T_INTEGER]);
+      hash_entry_set_value(val, make_integer(sc, integer(hash_entry_value(val)) + 1));
+      return(hash_entry_value(val));
+    }
+  s7_hash_table_set(sc, table, key, int_one);
+  return(int_one);
+}
+
+static s7_pointer fx_hash_table_increment(s7_scheme *sc, s7_pointer arg)
+{
+  return(fx_hash_table_increment_1(sc, lookup(sc, cadr(arg)), lookup(sc, caddr(arg)), arg));
+}
+
+
+static s7_pointer fx_simple_let_ref_s(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer sym;
+  s7_pointer lt = s_lookup(sc, opt2_sym(arg), arg);  /* (var-ref local-var) -> local-var, opt_sym2(arg) == cadr(arg) */
+  if (!is_pair(lt))
+    error_nr(sc, sc->wrong_type_arg_symbol,
+	     set_elist_3(sc, wrap_string(sc, "~S should be (cons name let), but it is ~S", 42), opt2_sym(arg), lt));
+  lt = cdr(lt);
+  if (!is_let(lt)) wrong_type_error_nr(sc, sc->let_ref_symbol, 1, lt, a_let_string);
+  sym = opt2_sym(cdr(arg));                  /* (let-ref (cdr v) 'ref) -> ref == opt3_sym(cdar(closure_body(opt1_lambda(arg)))); */
+  for (s7_pointer y = let_slots(lt); tis_slot(y); y = next_slot(y))
+    if (slot_symbol(y) == sym)
+      return(slot_value(y));
+  return(let_ref_p_pp(sc, let_outlet(lt), sym));
+}
+
+static s7_pointer fx_memq_sq_2(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p = opt2_con(cdr(arg));
+  s7_pointer obj = lookup(sc, cadr(arg));
+  if (obj == car(p)) return(p);
+  return((obj == cadr(p)) ? cdr(p) : sc->F);
+}
+
+static s7_pointer fx_c_cq(s7_scheme *sc, s7_pointer arg) {return(fn_proc(arg)(sc, with_list_t2(cadr(arg), opt2_con(cdr(arg)))));}
+
+#define fx_c_sss_any(Name, Lookup1, Lookup2, Lookup3) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    set_car(sc->t3_1, Lookup1(sc, cadr(arg), arg)); \
+    set_car(sc->t3_2, Lookup2(sc, opt1_sym(cdr(arg)), arg)); /* caddr(arg) */ \
+    set_car(sc->t3_3, Lookup3(sc, opt2_sym(cdr(arg)), arg)); /* cadddr(arg) */ \
+    return(fn_proc(arg)(sc, sc->t3_1)); \
+  }
+
+fx_c_sss_any(fx_c_sss, s_lookup, s_lookup, s_lookup)
+fx_c_sss_any(fx_c_sts, s_lookup, t_lookup, s_lookup)
+fx_c_sss_any(fx_c_tus, t_lookup, u_lookup, s_lookup)
+fx_c_sss_any(fx_c_tuv, t_lookup, u_lookup, v_lookup)
+
+
+static s7_pointer fx_c_sss_direct(s7_scheme *sc, s7_pointer arg)
+{
+  return(((s7_p_ppp_t)opt3_direct(cdr(arg)))(sc, lookup(sc, cadr(arg)), lookup(sc, opt1_sym(cdr(arg))), lookup(sc, opt2_sym(cdr(arg)))));
+}
+
+static s7_pointer fx_c_tuv_direct(s7_scheme *sc, s7_pointer arg)
+{
+  return(((s7_p_ppp_t)opt3_direct(cdr(arg)))(sc, t_lookup(sc, cadr(arg), arg), u_lookup(sc, opt1_sym(cdr(arg)), arg), v_lookup(sc, opt2_sym(cdr(arg)), arg)));
+}
+
+static s7_pointer fx_vset_sts(s7_scheme *sc, s7_pointer arg)
+{
+  return(vector_set_p_ppp(sc, lookup(sc, cadr(arg)), t_lookup(sc, opt1_sym(cdr(arg)), arg), lookup(sc, opt2_sym(cdr(arg)))));
+}
+
+static s7_pointer fx_vset_oto(s7_scheme *sc, s7_pointer arg)
+{
+  return(vector_set_p_ppp(sc, o_lookup(sc, cadr(arg), arg), t_lookup(sc, opt1_sym(cdr(arg)), arg), o_lookup(sc, opt2_sym(cdr(arg)), arg)));
+}
+
+#define fx_c_scs_any(Name, Lookup1, Lookup2) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    set_car(sc->t3_1, Lookup1(sc, cadr(arg), arg)); \
+    set_car(sc->t3_3, Lookup2(sc, opt2_sym(cdr(arg)), arg)); /* cadddr(arg) */ \
+    set_car(sc->t3_2, opt1_con(cdr(arg)));                   /* caddr(arg) */ \
+    return(fn_proc(arg)(sc, sc->t3_1)); \
+  }
+
+fx_c_scs_any(fx_c_scs, s_lookup, s_lookup)
+fx_c_scs_any(fx_c_tcs, t_lookup, s_lookup)
+
+
+#define fx_c_scs_direct_any(Name, Lookup1, Lookup2) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    return(((s7_p_ppp_t)opt3_direct(cdr(arg)))(sc, Lookup1(sc, cadr(arg), arg), opt1_con(cdr(arg)), Lookup2(sc, opt2_sym(cdr(arg)), arg))); \
+  }
+
+fx_c_scs_direct_any(fx_c_scs_direct, s_lookup, s_lookup)
+fx_c_scs_direct_any(fx_c_tcu_direct, t_lookup, u_lookup)
+fx_c_scs_direct_any(fx_c_tcs_direct, t_lookup, s_lookup)
+fx_c_scs_direct_any(fx_c_TcU_direct, T_lookup, U_lookup)
+
+
+static s7_pointer fx_c_scc(s7_scheme *sc, s7_pointer arg)
+{
+  set_car(sc->t3_1, lookup(sc, cadr(arg)));
+  set_car(sc->t3_2, opt1_con(cdr(arg))); /* caddr(arg) */
+  set_car(sc->t3_3, opt2_con(cdr(arg))); /* cadddr(arg) */
+  return(fn_proc(arg)(sc, sc->t3_1));
+}
+
+#define fx_c_css_any(Name, Lookup1, Lookup2) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    set_car(sc->t3_2, Lookup1(sc, opt1_sym(cdr(arg)), arg)); /* caddr(arg) */ \
+    set_car(sc->t3_3, Lookup2(sc, opt2_sym(cdr(arg)), arg)); /* cadddr(arg) */ \
+    set_car(sc->t3_1, cadr(arg)); \
+    return(fn_proc(arg)(sc, sc->t3_1)); \
+  }
+
+fx_c_css_any(fx_c_css, s_lookup, s_lookup)
+fx_c_css_any(fx_c_ctv, t_lookup, v_lookup)
+
+static s7_pointer fx_c_csc(s7_scheme *sc, s7_pointer arg)
+{
+  set_car(sc->t3_2, lookup(sc, opt1_sym(cdr(arg)))); /* caddr(arg) */
+  set_car(sc->t3_1, opt3_con(cdr(arg)));             /* cadr(arg) or maybe cadadr if quoted? */
+  set_car(sc->t3_3, opt2_con(cdr(arg)));             /* cadddr(arg) */
+  return(fn_proc(arg)(sc, sc->t3_1));
+}
+
+static s7_pointer fx_c_ccs(s7_scheme *sc, s7_pointer arg)
+{
+  set_car(sc->t3_3, lookup(sc, opt1_sym(cdr(arg)))); /* cadddr(arg) */
+  set_car(sc->t3_1, cadr(arg)); /* maybe opt3_con? */
+  set_car(sc->t3_2, opt2_con(cdr(arg)));             /* caddr(arg) */
+  return(fn_proc(arg)(sc, sc->t3_1));
+}
+
+#define fx_c_ssc_any(Name, Lookup1, Lookup2) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    set_car(sc->t3_1, Lookup1(sc, cadr(arg), arg)); \
+    set_car(sc->t3_2, Lookup2(sc, opt1_sym(cdr(arg)), arg)); /* caddr(arg) */ \
+    set_car(sc->t3_3, opt2_con(cdr(arg)));             /* cadddr(arg) */ \
+    return(fn_proc(arg)(sc, sc->t3_1)); \
+  }
+
+fx_c_ssc_any(fx_c_ssc, s_lookup, s_lookup)
+fx_c_ssc_any(fx_c_tuc, t_lookup, u_lookup)
+
+static s7_pointer fx_c_opncq(s7_scheme *sc, s7_pointer arg)
+{
+  return(fn_proc(arg)(sc, with_list_t1(fn_call(sc, cadr(arg)))));
+}
+
+#define fx_c_opsq_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer largs = cadr(arg); \
+    set_car(sc->t1_1, fn_proc(largs)(sc, with_list_t1(Lookup(sc, cadr(largs), largs)))); \
+    return(fn_proc(arg)(sc, sc->t1_1)); \
+  }
+
+fx_c_opsq_any(fx_c_opsq, s_lookup)
+fx_c_opsq_any(fx_c_optq, t_lookup)
+
+static s7_pointer fx_c_optq_direct(s7_scheme *sc, s7_pointer arg)
+{
+  return(((s7_p_p_t)opt2_direct(cdr(arg)))(sc, ((s7_p_p_t)opt3_direct(cdr(arg)))(sc, t_lookup(sc, opt1_sym(cdr(arg)), arg))));
+}
+
+#define fx_c_car_s_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer val = Lookup(sc, opt3_sym(arg), arg); \
+    set_car(sc->t1_1, (is_pair(val)) ? car(val) : g_car(sc, set_plist_1(sc, val))); \
+    return(fn_proc(arg)(sc, sc->t1_1)); \
+  }
+
+fx_c_car_s_any(fx_c_car_s, s_lookup)
+fx_c_car_s_any(fx_c_car_t, t_lookup)
+fx_c_car_s_any(fx_c_car_u, u_lookup)
+
+#define fx_c_cdr_s_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer val = Lookup(sc, opt3_sym(arg), arg); \
+    set_car(sc->t1_1, (is_pair(val)) ? cdr(val) : g_cdr(sc, set_plist_1(sc, val))); \
+    return(fn_proc(arg)(sc, sc->t1_1)); \
+  }
+
+fx_c_cdr_s_any(fx_c_cdr_s, s_lookup)
+fx_c_cdr_s_any(fx_c_cdr_t, t_lookup)
+
+#define fx_is_type_opsq_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    set_car(sc->t1_1, Lookup(sc, opt3_sym(arg), arg)); \
+    return(make_boolean(sc, (uint8_t)(opt3_byte(cdr(arg))) == type(fn_proc(cadr(arg))(sc, sc->t1_1)))); \
+  }
+
+fx_is_type_opsq_any(fx_is_type_opsq, s_lookup)
+fx_is_type_opsq_any(fx_is_type_optq, t_lookup)
+
+static s7_pointer fx_is_type_car_s(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer val = lookup(sc, opt3_sym(arg));
+  return(make_boolean(sc, (is_pair(val)) ?
+		            ((uint8_t)(opt3_byte(cdr(arg))) == type(car(val))) :
+		            ((uint8_t)(opt3_byte(cdr(arg))) == type(g_car(sc, set_plist_1(sc, val))))));
+}
+
+static s7_pointer fx_is_type_car_t(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer func, val = t_lookup(sc, opt3_sym(arg), arg);
+  if (is_pair(val))
+    return(make_boolean(sc, (uint8_t)(opt3_byte(cdr(arg))) == type(car(val))));
+  if (!has_active_methods(sc, val)) /* this verbosity saves 1/3 total compute time (overhead!) */
+    wrong_type_error_nr(sc, sc->car_symbol, 1, val, sc->type_names[T_PAIR]);
+  func = find_method_with_let(sc, val, sc->car_symbol);
+  if (func == sc->undefined)
+    wrong_type_error_nr(sc, sc->car_symbol, 1, val, sc->type_names[T_PAIR]);
+  return(make_boolean(sc, type(s7_apply_function(sc, func, set_plist_1(sc, val))) == (uint8_t)opt3_byte(cdr(arg))));
+}
+
+static s7_pointer fx_eq_weak1_type_s(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer func, val = lookup(sc, opt3_sym(arg));
+  if (is_c_pointer(val))                /* (let? (c-pointer-weak1 val)) etc */
+    return(make_boolean(sc, (uint8_t)(opt3_byte(cdr(arg))) == type(c_pointer_weak1(val))));
+  if (!has_active_methods(sc, val)) /* calling g_c_pointer_weak1 here instead is much slower, error by itself is much faster! splitting out does not help */
+    wrong_type_error_nr(sc, sc->c_pointer_weak1_symbol, 1, val, sc->type_names[T_C_POINTER]);
+  func = find_method_with_let(sc, val, sc->c_pointer_weak1_symbol);
+  if (func == sc->undefined)
+    wrong_type_error_nr(sc, sc->c_pointer_weak1_symbol, 1, val, sc->type_names[T_C_POINTER]);
+  return(make_boolean(sc, type(s7_apply_function(sc, func, set_plist_1(sc, val))) == (uint8_t)opt3_byte(cdr(arg))));
+}
+
+#define fx_not_opsq_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer largs = cadr(arg); \
+    set_car(sc->t1_1, Lookup(sc, cadr(largs), arg)); \
+    return((fn_proc(largs)(sc, sc->t1_1) == sc->F) ? sc->T : sc->F); \
+  }
+
+fx_not_opsq_any(fx_not_opsq, s_lookup)
+fx_not_opsq_any(fx_not_optq, t_lookup)
+
+static s7_pointer fx_not_car_t(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p = t_lookup(sc, opt3_sym(arg), arg); /* cadadr */
+  s7_pointer res = (is_pair(p)) ? car(p) : g_car(sc, set_plist_1(sc, p));
+  return((res == sc->F) ? sc->T : sc->F);
+}
+
+
+#define fx_c_opssq_any(Name, Lookup1, Lookup2) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    set_car(sc->t2_1, Lookup1(sc, opt3_sym(arg), arg)); \
+    set_car(sc->t2_2, Lookup2(sc, opt1_sym(cdr(arg)), arg)); /* or opt2_sym */ \
+    return(fn_proc(arg)(sc, with_list_t1(fn_proc(cadr(arg))(sc, sc->t2_1)))); \
+  }
+
+fx_c_opssq_any(fx_c_opssq, s_lookup, s_lookup)
+fx_c_opssq_any(fx_c_optuq, t_lookup, u_lookup)
+fx_c_opssq_any(fx_c_opstq, s_lookup, t_lookup)
+
+
+#define fx_c_opssq_direct_any(Name, Lookup1, Lookup2) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    return(((s7_p_p_t)opt2_direct(cdr(arg)))(sc, \
+              ((s7_p_pp_t)opt3_direct(cdr(arg)))(sc, Lookup1(sc, opt3_sym(arg), arg), Lookup2(sc, opt1_sym(cdr(arg)), arg)))); \
+  }
+
+fx_c_opssq_direct_any(fx_c_opssq_direct, s_lookup, s_lookup)
+fx_c_opssq_direct_any(fx_c_opstq_direct, s_lookup, t_lookup)
+fx_c_opssq_direct_any(fx_c_optuq_direct, t_lookup, u_lookup)
+
+
+#define fx_not_opssq_any(Name, Lookup1, Lookup2) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer larg = cadr(arg); \
+    set_car(sc->t2_1, Lookup1(sc, cadr(larg), larg)); \
+    set_car(sc->t2_2, Lookup2(sc, opt2_sym(cdr(larg)), larg)); \
+    return((fn_proc(larg)(sc, sc->t2_1) == sc->F) ? sc->T : sc->F); \
+ }
+
+fx_not_opssq_any(fx_not_opssq, s_lookup, s_lookup)
+fx_not_opssq_any(fx_not_oputq, u_lookup, t_lookup)
+
+
+static s7_pointer fx_not_lt_ut(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer y = u_lookup(sc, opt3_sym(arg), arg);
+  s7_pointer x = t_lookup(sc, opt1_sym(cdr(arg)), arg);
+  return(make_boolean(sc, ((is_t_integer(x)) && (is_t_integer(y))) ? (integer(y) >= integer(x)) : geq_b_7pp(sc, y, x)));
+}
+
+static s7_pointer fx_is_zero_remainder_car(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer t = t_lookup(sc, opt1_sym(cdr(arg)), arg);
+  s7_pointer u = u_lookup(sc, opt3_sym(arg), arg);
+  u = (is_pair(u)) ? car(u) : g_car(sc, set_plist_1(sc, u)); /* g_car much less overhead than car_p_p or simple_error(?) */
+  if ((is_t_integer(u)) && (is_t_integer(t)))
+    return(make_boolean(sc, remainder_i_7ii(sc, integer(u), integer(t)) == 0));
+  return(make_boolean(sc, is_zero_b_7p(sc, remainder_p_pp(sc, u, t))));
+}
+
+static s7_pointer fx_is_zero_remainder_o(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer s = o_lookup(sc, opt3_sym(arg), arg);
+  s7_pointer t = t_lookup(sc, opt1_sym(cdr(arg)), arg);
+  if ((is_t_integer(s)) && (is_t_integer(t)))
+    return(make_boolean(sc, remainder_i_7ii(sc, integer(s), integer(t)) == 0));
+  return(make_boolean(sc, is_zero_b_7p(sc, remainder_p_pp(sc, s, t))));
+}
+
+#define fx_c_opscq_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer largs = cadr(arg); \
+    set_car(sc->t2_1, Lookup(sc, cadr(largs), largs)); \
+    set_car(sc->t2_2, opt2_con(cdr(largs))); \
+    return(fn_proc(arg)(sc, with_list_t1(fn_proc(largs)(sc, sc->t2_1)))); \
+  }
+
+fx_c_opscq_any(fx_c_opscq, s_lookup)
+fx_c_opscq_any(fx_c_optcq, t_lookup)
+
+static s7_pointer fx_is_zero_remainder_ti(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer larg = cdadr(arg);
+  s7_pointer t = t_lookup(sc, car(larg), arg);
+  s7_int u = integer(cadr(larg));
+  if (is_t_integer(t)) return(make_boolean(sc, (integer(t) % u) == 0));
+  return(make_boolean(sc, is_zero_b_7p(sc, remainder_p_pi(sc, t, u))));
+}
+
+static s7_pointer fx_not_opscq(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer largs = cadr(arg);
+  set_car(sc->t2_1, lookup(sc, cadr(largs)));
+  set_car(sc->t2_2, opt2_con(cdr(largs)));
+  return((fn_proc(largs)(sc, sc->t2_1) == sc->F) ? sc->T : sc->F);
+}
+
+static s7_pointer fx_c_opcsq(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer largs = cadr(arg);
+  set_car(sc->t2_2, lookup(sc, caddr(largs)));
+  set_car(sc->t2_1, opt1_con(cdr(largs)));  /* cadr(largs) or cadadr */
+  return(fn_proc(arg)(sc, with_list_t1(fn_proc(largs)(sc, sc->t2_1))));
+}
+
+static s7_pointer fx_c_opcsq_c(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer largs = cadr(arg);
+  set_car(sc->t2_2, lookup(sc, caddr(largs)));
+  set_car(sc->t2_1, opt1_con(cdr(largs))); /* cadr(largs) or cadadr */
+  set_car(sc->t2_1, fn_proc(largs)(sc, sc->t2_1));
+  set_car(sc->t2_2, caddr(arg));
+  return(fn_proc(arg)(sc, sc->t2_1));
+}
+
+static s7_pointer fx_c_opcsq_s(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer largs = cadr(arg);
+  set_car(sc->t2_2, lookup(sc, caddr(largs)));
+  set_car(sc->t2_1, opt1_con(cdr(largs))); /* cadr(largs) or cadadr */
+  set_car(sc->t2_1, fn_proc(largs)(sc, sc->t2_1));
+  set_car(sc->t2_2, lookup(sc, caddr(arg)));
+  return(fn_proc(arg)(sc, sc->t2_1));
+}
+
+static s7_pointer fx_c_opssq_s(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer largs = cadr(arg);
+  set_car(sc->t2_1, lookup(sc, cadr(largs)));
+  set_car(sc->t2_2, lookup(sc, opt2_sym(cdr(largs))));
+  set_car(sc->t2_1, fn_proc(largs)(sc, sc->t2_1));
+  set_car(sc->t2_2, lookup(sc, caddr(arg)));
+  return(fn_proc(arg)(sc, sc->t2_1));
+}
+
+static s7_pointer fx_c_opssq_s_direct(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer largs = opt3_pair(arg); /* cdadr(arg) */
+  return(((s7_p_pp_t)opt2_direct(cdr(arg)))(sc,
+	   ((s7_p_pp_t)opt3_direct(cdr(arg)))(sc, lookup(sc, car(largs)), lookup(sc, opt2_sym(largs))),
+	   lookup(sc, caddr(arg))));
+}
+
+static s7_pointer fx_add_mul_opssq_s(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer largs = opt3_pair(arg);   /* cdadr(arg) */
+  s7_pointer a = lookup(sc, car(largs));
+  s7_pointer b = lookup(sc, opt2_sym(largs));
+  s7_pointer c = lookup(sc, caddr(arg));
+  if ((is_t_integer(a)) && (is_t_integer(b)) && (is_t_integer(c)))
+#if HAVE_OVERFLOW_CHECKS
+    {
+      s7_int val;
+      if ((multiply_overflow(integer(a), integer(b), &val)) ||
+	  (add_overflow(val, integer(c), &val)))
+	{
+	  if (WITH_WARNINGS) s7_warn(sc, 128, "integer multiply/add overflow: (+ (* %" ld64 " %" ld64 ") %" ld64 ")\n", integer(a), integer(b), integer(c));
+	  return(make_real(sc, ((long_double)integer(a) * (long_double)integer(b)) + (long_double)integer(c)));
+	}
+      return(make_integer(sc, val));
+    }
+#else
+    return(make_integer(sc, (integer(a) * integer(b)) + integer(c)));
+#endif
+  return(add_p_pp(sc, multiply_p_pp(sc, a, b), c));
+}
+
+static s7_pointer fx_add_vref_s(s7_scheme *sc, s7_pointer arg)
+{
+  return(add_p_pp(sc, vector_ref_p_pp(sc, lookup(sc, car(opt3_pair(arg))), lookup(sc, opt2_sym(opt3_pair(arg)))), lookup(sc, caddr(arg))));
+}
+
+static s7_pointer fx_add_s_vref(s7_scheme *sc, s7_pointer arg)
+{
+  return(add_p_pp(sc, lookup(sc, cadr(arg)), vector_ref_p_pp(sc, lookup(sc, car(opt3_pair(arg))), lookup(sc, opt2_sym(opt3_pair(arg))))));
+}
+
+static s7_pointer fx_subtract_vref_s(s7_scheme *sc, s7_pointer arg)
+{
+  return(subtract_p_pp(sc, vector_ref_p_pp(sc, lookup(sc, car(opt3_pair(arg))), lookup(sc, opt2_sym(opt3_pair(arg)))), lookup(sc, caddr(arg))));
+}
+
+static s7_pointer fx_subtract_s_vref(s7_scheme *sc, s7_pointer arg)
+{
+  return(subtract_p_pp(sc, lookup(sc, cadr(arg)), vector_ref_p_pp(sc, lookup(sc, car(opt3_pair(arg))), lookup(sc, opt2_sym(opt3_pair(arg))))));
+}
+
+static s7_pointer fx_multiply_s_vref(s7_scheme *sc, s7_pointer arg)
+{
+  return(multiply_p_pp(sc, lookup(sc, cadr(arg)), vector_ref_p_pp(sc, lookup(sc, car(opt3_pair(arg))), lookup(sc, opt2_sym(opt3_pair(arg))))));
+}
+
+static s7_pointer fx_cons_cons_s(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer largs = opt3_pair(arg); /* cdadr(arg) */
+  return(cons_unchecked(sc, cons(sc, lookup(sc, car(largs)), lookup(sc, opt2_sym(largs))), lookup(sc, caddr(arg))));
+}
+
+#define fx_add_sqr_s_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer p1 = Lookup(sc, car(opt3_pair(arg)), arg); \
+    s7_pointer p3 = lookup(sc, caddr(arg)); \
+    if ((is_t_complex(p1)) && (is_t_complex(p3))) \
+      { \
+        s7_double r = real_part(p1), i = imag_part(p1); \
+        return(make_complex(sc, real_part(p3) + r * r - i * i, imag_part(p3) + 2.0 * r * i)); \
+      } \
+    return(add_p_pp(sc, fx_sqr_1(sc, p1), p3)); \
+  }
+
+fx_add_sqr_s_any(fx_add_sqr_s, s_lookup)
+fx_add_sqr_s_any(fx_add_sqr_T, T_lookup)
+
+static s7_pointer fx_add_sub_s(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer largs = opt3_pair(arg); /* cdadr(arg) */
+  s7_pointer p1 = lookup(sc, car(largs));
+  s7_pointer p2 = lookup(sc, opt2_sym(largs));
+  s7_pointer p3 = lookup(sc, caddr(arg));
+  if ((is_t_real(p1)) && (is_t_real(p2)) && (is_t_real(p3))) return(make_real(sc, real(p3) + real(p1) - real(p2)));
+  return(add_p_pp(sc, subtract_p_pp(sc, p1, p2), p3));
+}
+
+static s7_pointer fx_add_sub_tu_s(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p1 = t_lookup(sc, car(cdadr(arg)), arg);
+  s7_pointer p2 = u_lookup(sc, cadr(cdadr(arg)), arg);
+  s7_pointer p3 = lookup(sc, caddr(arg));
+  if ((is_t_real(p1)) && (is_t_real(p2)) && (is_t_real(p3))) return(make_real(sc, real(p3) + real(p1) - real(p2)));
+  return(add_p_pp(sc, subtract_p_pp(sc, p1, p2), p3));
+}
+
+static s7_pointer fx_gt_add_s(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer largs = opt3_pair(arg); /* cdadr(arg) */
+  s7_pointer x1 = lookup(sc, car(largs));
+  s7_pointer x2 = lookup(sc, opt2_sym(largs));
+  s7_pointer x3 = lookup(sc, caddr(arg));
+  if ((is_t_real(x1)) && (is_t_real(x2)) && (is_t_real(x3))) return(make_boolean(sc, (real(x1) + real(x2)) > real(x3)));
+  return(gt_p_pp(sc, add_p_pp(sc, x1, x2), x3));
+}
+
+static s7_pointer fx_gt_add_tu_s(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer x1 = t_lookup(sc, car(cdadr(arg)), arg);
+  s7_pointer x2 = u_lookup(sc, cadr(cdadr(arg)), arg);
+  s7_pointer x3 = lookup(sc, caddr(arg));
+  if ((is_t_real(x1)) && (is_t_real(x2)) && (is_t_real(x3))) return(make_boolean(sc, (real(x1) + real(x2)) > real(x3)));
+  return(gt_p_pp(sc, add_p_pp(sc, x1, x2), x3));
+}
+
+static s7_pointer fx_gt_vref_s(s7_scheme *sc, s7_pointer arg)
+{
+  return(gt_p_pp(sc, vector_ref_p_pp(sc, lookup(sc, car(opt3_pair(arg))), lookup(sc, opt2_sym(opt3_pair(arg)))), lookup(sc, caddr(arg))));
+}
+
+static s7_pointer fx_geq_s_vref(s7_scheme *sc, s7_pointer arg)
+{
+  return(geq_p_pp(sc, lookup(sc, cadr(arg)), vector_ref_p_pp(sc, lookup(sc, car(opt3_pair(arg))), lookup(sc, opt2_sym(opt3_pair(arg))))));
+}
+
+static s7_pointer fx_is_eq_s_vref(s7_scheme *sc, s7_pointer arg)
+{
+  return(make_boolean(sc, lookup(sc, cadr(arg)) == vector_ref_p_pp(sc, lookup(sc, car(opt3_pair(arg))), lookup(sc, opt2_sym(opt3_pair(arg))))));
+}
+
+static s7_pointer fx_href_s_vref(s7_scheme *sc, s7_pointer arg)
+{
+  return(hash_table_ref_p_pp(sc, lookup(sc, cadr(arg)), vector_ref_p_pp(sc, lookup(sc, car(opt3_pair(arg))), lookup(sc, opt2_sym(opt3_pair(arg))))));
+}
+
+static s7_pointer fx_lref_s_vref(s7_scheme *sc, s7_pointer arg) /* tbig */
+{
+  return(let_ref(sc, lookup(sc, cadr(arg)), vector_ref_p_pp(sc, lookup(sc, car(opt3_pair(arg))), lookup(sc, opt2_sym(opt3_pair(arg))))));
+}
+
+static s7_pointer fx_vref_s_add(s7_scheme *sc, s7_pointer arg)
+{
+  return(vector_ref_p_pp(sc, lookup(sc, cadr(arg)), add_p_pp(sc, lookup(sc, car(opt3_pair(arg))), lookup(sc, opt2_sym(opt3_pair(arg))))));
+}
+
+static inline s7_pointer fx_vref_vref_3(s7_scheme *sc, s7_pointer v1, s7_pointer p1, s7_pointer p2)
+{
+  if ((is_t_integer(p1)) && (is_t_integer(p2)) && ((is_t_vector(v1)) && (vector_rank(v1) == 1)))
+    {
+      s7_int i1 = integer(p1), i2 = integer(p2);
+      if ((i1 >= 0) && (i2 >= 0) && (i1 < vector_length(v1)))
+	{
+	  s7_pointer v2 = vector_element(v1, i1);
+	  if ((is_t_vector(v2)) && (vector_rank(v2) == 1) && (i2 < vector_length(v2)))
+	    return(vector_element(v2, i2));
+	}}
+  return(vector_ref_p_pp(sc, vector_ref_p_pp(sc, v1, p1), p2));
+}
+
+#define fx_vref_vref_ss_s_any(Name, Lookup1, Lookup2, Lookup3) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    return(fx_vref_vref_3(sc, Lookup1(sc, car(opt3_pair(arg)), arg), Lookup2(sc, opt2_sym(opt3_pair(arg)), arg), Lookup3(sc, caddr(arg), arg))); \
+  }
+
+fx_vref_vref_ss_s_any(fx_vref_vref_ss_s, s_lookup, s_lookup, s_lookup)
+fx_vref_vref_ss_s_any(fx_vref_vref_gs_t, g_lookup, s_lookup, t_lookup)
+fx_vref_vref_ss_s_any(fx_vref_vref_go_t, g_lookup, o_lookup, t_lookup)
+fx_vref_vref_ss_s_any(fx_vref_vref_tu_v, t_lookup, u_lookup, v_lookup)
+
+static s7_pointer fx_vref_vref_3_no_let(s7_scheme *sc, s7_pointer code) /* out one level from vref_vref_tu_v */
+{
+  return(fx_vref_vref_3(sc, lookup(sc, cadr(code)), lookup(sc, opt2_sym(code)), lookup(sc, opt3_sym(code))));
+}
+
+static s7_pointer fx_c_opscq_c(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer largs = cadr(arg);
+  set_car(sc->t2_1, lookup(sc, cadr(largs)));
+  set_car(sc->t2_2, opt2_con(cdr(largs)));
+  set_car(sc->t2_1, fn_proc(largs)(sc, sc->t2_1));
+  set_car(sc->t2_2, caddr(arg));
+  return(fn_proc(arg)(sc, sc->t2_1));
+}
+
+#define fx_c_opssq_c_any(Name, Lookup1, Lookup2) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer largs = cadr(arg); \
+    set_car(sc->t2_1, Lookup1(sc, cadr(largs), largs)); \
+    set_car(sc->t2_2, Lookup2(sc, opt2_sym(cdr(largs)), largs)); \
+    set_car(sc->t2_1, fn_proc(largs)(sc, sc->t2_1)); \
+    set_car(sc->t2_2, opt3_con(cdr(arg))); /* caddr */ \
+    return(fn_proc(arg)(sc, sc->t2_1)); \
+  }
+
+fx_c_opssq_c_any(fx_c_opssq_c, s_lookup, s_lookup)
+fx_c_opssq_c_any(fx_c_opstq_c, s_lookup, t_lookup)
+
+
+static s7_pointer fx_c_opstq_c_direct(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer largs = cadr(arg);
+  return(((s7_p_pp_t)opt3_direct(arg))(sc, fn_proc(largs)(sc, set_plist_2(sc, lookup(sc, cadr(largs)), t_lookup(sc, caddr(largs), arg))), opt3_con(cdr(arg))));
+}
+
+static s7_pointer fx_is_eq_vref_opotq_c(s7_scheme *sc, s7_pointer arg) /* experiment, (eqv? <> char) is <>==char without error checks? */
+{
+  s7_pointer largs = cdadr(arg);
+  return(make_boolean(sc, vector_ref_p_pp(sc, o_lookup(sc, car(largs), largs), t_lookup(sc, cadr(largs), arg)) == opt3_con(cdr(arg))));
+}
+
+#define fx_c_opsq_s_any(Name, Lookup1, Lookup2) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer largs = cadr(arg); \
+    set_car(sc->t2_1, fn_proc(largs)(sc, with_list_t1(Lookup1(sc, cadr(largs), arg)))); /* also opt1_sym(cdr(arg)) */ \
+    set_car(sc->t2_2, Lookup2(sc, opt3_sym(arg), arg)); /* caddr(arg) */ \
+    return(fn_proc(arg)(sc, sc->t2_1)); \
+  }
+
+fx_c_opsq_s_any(fx_c_opsq_s, s_lookup, s_lookup)
+fx_c_opsq_s_any(fx_c_optq_s, t_lookup, s_lookup)
+fx_c_opsq_s_any(fx_c_opuq_t, u_lookup, t_lookup)
+
+
+#define fx_c_opsq_s_direct_any(Name, Lookup1, Lookup2) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    return(((s7_p_pp_t)opt2_direct(cdr(arg)))(sc, \
+	      ((s7_p_p_t)opt3_direct(cdr(arg)))(sc, Lookup1(sc, opt1_sym(cdr(arg)), arg)), \
+	      Lookup2(sc, opt3_sym(arg), arg))); \
+  }
+
+fx_c_opsq_s_direct_any(fx_c_opsq_s_direct, s_lookup, s_lookup)
+fx_c_opsq_s_direct_any(fx_c_optq_s_direct, t_lookup, s_lookup)
+fx_c_opsq_s_direct_any(fx_c_opuq_t_direct, u_lookup, t_lookup)
+
+#define fx_cons_car_s_s_any(Name, Lookup1, Lookup2) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer p = Lookup1(sc, opt1_sym(cdr(arg)), arg); \
+    if (is_pair(p)) return(cons(sc, car(p), Lookup2(sc, opt3_sym(arg), arg))); \
+    return(cons(sc, car_p_p(sc, p), Lookup2(sc, opt3_sym(arg), arg))); \
+  }
+
+fx_cons_car_s_s_any(fx_cons_car_s_s, s_lookup, s_lookup)
+fx_cons_car_s_s_any(fx_cons_car_t_s, t_lookup, s_lookup)
+fx_cons_car_s_s_any(fx_cons_car_t_v, t_lookup, v_lookup)
+fx_cons_car_s_s_any(fx_cons_car_u_t, u_lookup, t_lookup)
+
+
+static s7_pointer fx_cons_opuq_t(s7_scheme *sc, s7_pointer arg)
+{
+  return(cons(sc, ((s7_p_p_t)opt3_direct(cdr(arg)))(sc, u_lookup(sc, opt1_sym(cdr(arg)), arg)), t_lookup(sc, opt3_sym(arg), arg)));
+}
+
+#define fx_c_opsq_cs_any(Name, Lookup1, Lookup2) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    set_car(sc->t3_1, fn_proc(cadr(arg))(sc, with_list_t1(Lookup1(sc, opt3_sym(cdr(arg)), arg))));  /* cadadr(arg) */ \
+    set_car(sc->t3_2, opt1_con(cdr(arg)));              /* caddr(arg) or cadaddr(arg) */ \
+    set_car(sc->t3_3, Lookup2(sc, opt2_sym(cdr(arg)), arg));  /* cadddr(arg) */ \
+    return(fn_proc(arg)(sc, sc->t3_1)); \
+  }
+
+fx_c_opsq_cs_any(fx_c_opsq_cs, s_lookup, s_lookup)
+fx_c_opsq_cs_any(fx_c_optq_cu, t_lookup, u_lookup)
+
+
+#define fx_c_opsq_c_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    set_car(sc->t2_1, fn_proc(cadr(arg))(sc, with_list_t1(Lookup(sc, opt1_sym(cdr(arg)), arg)))); /* cadadr */ \
+    set_car(sc->t2_2, opt2_con(cdr(arg))); \
+    return(fn_proc(arg)(sc, sc->t2_1)); \
+  }
+
+fx_c_opsq_c_any(fx_c_opsq_c, s_lookup)
+fx_c_opsq_c_any(fx_c_optq_c, t_lookup)
+
+
+static s7_pointer fx_c_optq_c_direct(s7_scheme *sc, s7_pointer arg)
+{
+  return(((s7_p_pp_t)opt3_direct(arg))(sc, ((s7_p_p_t)opt3_direct(cdr(arg)))(sc, t_lookup(sc, opt1_sym(cdr(arg)), arg)), opt2_con(cdr(arg))));
+}
+
+static s7_pointer fx_c_optq_i_direct(s7_scheme *sc, s7_pointer arg)
+{
+  return(((s7_p_ii_t)opt3_direct(arg))(sc, ((s7_i_7p_t)opt3_direct(cdr(arg)))(sc, t_lookup(sc, opt1_sym(cdr(arg)), arg)), integer(opt2_con(cdr(arg)))));
+}
+
+static s7_pointer fx_memq_car_s(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer x = opt2_con(cdr(arg));
+  s7_pointer obj = lookup(sc, opt1_sym(cdr(arg)));
+  obj = (is_pair(obj)) ? car(obj) : g_car(sc, set_plist_1(sc, obj));
+  while (true) LOOP_4(if (obj == car(x)) return(x); x = cdr(x); if (!is_pair(x)) return(sc->F));
+  return(sc->F);
+}
+
+static s7_pointer fx_memq_car_s_2(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer x = opt2_con(cdr(arg));
+  s7_pointer obj = lookup(sc, opt1_sym(cdr(arg)));
+  obj = (is_pair(obj)) ? car(obj) : g_car(sc, set_plist_1(sc, obj));
+  if (obj == car(x)) return(x);
+  return((obj == cadr(x)) ? cdr(x) : sc->F);
+}
+
+static s7_pointer fx_c_s_opssq(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer largs = caddr(arg);
+  set_car(sc->t2_2, fn_proc(largs)(sc, with_list_t2(lookup(sc, cadr(largs)), lookup(sc, opt2_sym(cdr(largs))))));
+  set_car(sc->t2_1, lookup(sc, cadr(arg)));
+  return(fn_proc(arg)(sc, sc->t2_1));
+}
+
+#define fx_c_s_opssq_direct_any(Name, Lookup1, Lookup2) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer largs = opt3_pair(arg); /* cdaddr(arg) */ \
+    arg = cdr(arg); \
+    return(((s7_p_pp_t)opt2_direct(arg))(sc, Lookup1(sc, car(arg), arg), \
+					 ((s7_p_pp_t)opt3_direct(arg))(sc, lookup(sc, car(largs)), Lookup2(sc, opt2_sym(largs), largs)))); \
+  }
+
+fx_c_s_opssq_direct_any(fx_c_s_opssq_direct, s_lookup, s_lookup)
+fx_c_s_opssq_direct_any(fx_c_s_opstq_direct, s_lookup, t_lookup)
+fx_c_s_opssq_direct_any(fx_c_t_opsuq_direct, t_lookup, u_lookup)
+
+static s7_pointer fx_vref_g_vref_gs(s7_scheme *sc, s7_pointer arg)
+{
+  return(vector_ref_p_pp(sc, lookup_global(sc, cadr(arg)),
+			 vector_ref_p_pp(sc, lookup_global(sc, car(opt3_pair(arg))), lookup(sc, opt2_sym(opt3_pair(arg))))));
+}
+
+static s7_pointer fx_vref_g_vref_gt(s7_scheme *sc, s7_pointer arg)
+{
+  return(vector_ref_p_pp(sc, lookup_global(sc, cadr(arg)),
+			 vector_ref_p_pp(sc, lookup_global(sc, car(opt3_pair(arg))), t_lookup(sc, opt2_sym(opt3_pair(arg)), arg))));
+}
+
+static s7_pointer fx_c_c_opssq(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer largs = caddr(arg);
+  set_car(sc->t2_2, fn_proc(largs)(sc, with_list_t2(lookup(sc, cadr(largs)), lookup(sc, opt2_sym(cdr(largs))))));
+  set_car(sc->t2_1, cadr(arg));      /* currently (<safe-f> 'a <opssq>) goes to safe_c_ca so this works by inadvertence */
+  return(fn_proc(arg)(sc, sc->t2_1));
+}
+
+static s7_pointer fx_c_c_opssq_direct(s7_scheme *sc, s7_pointer arg)
+{
+  return(((s7_p_pp_t)opt2_direct(cdr(arg)))(sc, cadr(arg), /* see above */
+	   ((s7_p_pp_t)opt3_direct(cdr(arg)))(sc, lookup(sc, opt3_sym(arg)), lookup(sc, opt1_sym(cdr(arg))))));
+}
+
+static s7_pointer fx_c_nc_opssq_direct(s7_scheme *sc, s7_pointer arg) /* clm2xen (* 1.0 (oscil g2 x2)) */
+{
+  s7_double x2 = ((s7_d_pd_t)opt3_direct(cdr(arg)))(lookup(sc, opt3_sym(arg)), real_to_double(sc, lookup(sc, opt1_sym(cdr(arg))), __func__));
+  return(((s7_p_dd_t)opt2_direct(cdr(arg)))(sc, real_to_double(sc, cadr(arg), __func__), x2));
+}
+
+static s7_pointer fx_multiply_c_opssq(s7_scheme *sc, s7_pointer arg) /* (* c=float (* x1 x2))! */
+{
+  s7_pointer x1 = lookup(sc, opt3_sym(arg));
+  s7_pointer x2 = lookup(sc, opt1_sym(cdr(arg)));
+  if ((is_t_real(x1)) && (is_t_real(x2))) return(make_real(sc, real(cadr(arg)) * real(x1) * real(x2)));
+  return(multiply_p_pp(sc, cadr(arg), multiply_p_pp(sc, x1, x2)));
+}
+
+#define fx_c_s_opscq_any(Name, Lookup1, Lookup2)		\
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg)		\
+  {								\
+    s7_pointer largs = caddr(arg);				\
+    set_car(sc->t2_1, Lookup2(sc, cadr(largs), arg));		\
+    set_car(sc->t2_2, opt2_con(cdr(largs)));			\
+    set_car(sc->t2_2, fn_proc(largs)(sc, sc->t2_1));		\
+    set_car(sc->t2_1, Lookup1(sc, cadr(arg), arg));		\
+    return(fn_proc(arg)(sc, sc->t2_1));				\
+  }
+
+fx_c_s_opscq_any(fx_c_s_opscq, s_lookup, s_lookup)
+fx_c_s_opscq_any(fx_c_u_optcq, u_lookup, t_lookup)
+/* also fx_c_T_optcq */
+
+static s7_pointer fx_c_s_opscq_direct(s7_scheme *sc, s7_pointer arg)
+{
+  return(((s7_p_pp_t)opt2_direct(cdr(arg)))(sc, lookup(sc, cadr(arg)), ((s7_p_pp_t)opt3_direct(cdr(arg)))(sc, lookup(sc, opt3_sym(arg)), opt1_con(cdr(arg)))));
+}
+
+static s7_pointer fx_c_s_opsiq_direct(s7_scheme *sc, s7_pointer arg)
+{
+  return(((s7_p_pp_t)opt2_direct(cdr(arg)))(sc, lookup(sc, cadr(arg)),
+	   ((s7_p_pi_t)opt3_direct(cdr(arg)))(sc, lookup(sc, opt3_sym(arg)), integer(opt1_con(cdr(arg))))));
+}
+
+static s7_pointer fx_c_u_optiq_direct(s7_scheme *sc, s7_pointer arg)
+{
+  return(((s7_p_pp_t)opt2_direct(cdr(arg)))(sc, u_lookup(sc, cadr(arg), arg),
+	   ((s7_p_pi_t)opt3_direct(cdr(arg)))(sc, t_lookup(sc, opt3_sym(arg), arg), integer(opt1_con(cdr(arg))))));
+}
+
+static s7_pointer fx_c_t_opoiq_direct(s7_scheme *sc, s7_pointer arg)
+{
+  return(((s7_p_pp_t)opt2_direct(cdr(arg)))(sc, t_lookup(sc, cadr(arg), arg),
+	   ((s7_p_pi_t)opt3_direct(cdr(arg)))(sc, o_lookup(sc, opt3_sym(arg), arg), integer(opt1_con(cdr(arg))))));
+}
+
+static s7_pointer fx_vref_p1(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer i = lookup(sc, opt3_sym(arg));
+  s7_pointer v = lookup(sc, cadr(arg));
+  if ((is_t_integer(i)) && (is_t_vector(v)) && (vector_rank(v) == 1))
+    {
+      s7_int index = integer(i) + 1;
+      if ((index >= 0) && (vector_length(v) > index))
+	return(vector_element(v, index));
+    }
+  return(vector_ref_p_pp(sc, v, g_add_xi(sc, i, 1, 2)));
+}
+
+static s7_pointer fx_num_eq_add_s_si(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer i1 = lookup(sc, cadr(arg));
+  s7_pointer i2 = lookup(sc, opt3_sym(arg));
+  if ((is_t_integer(i1)) && (is_t_integer(i2)))
+    return(make_boolean(sc, integer(i1) == (integer(i2) + integer(opt1_con(cdr(arg))))));
+  return(make_boolean(sc, num_eq_b_7pp(sc, i1, g_add_xi(sc, i2, integer(opt1_con(cdr(arg))), 2))));
+}
+
+static s7_pointer fx_num_eq_subtract_s_si(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer i1 = lookup(sc, cadr(arg));
+  s7_pointer i2 = lookup(sc, opt3_sym(arg));
+  if ((is_t_integer(i1)) && (is_t_integer(i2)))
+    return(make_boolean(sc, integer(i1) == (integer(i2) - integer(opt1_con(cdr(arg))))));
+  return(make_boolean(sc, num_eq_b_7pp(sc, i1, g_sub_xi(sc, i2, integer(opt1_con(cdr(arg)))))));
+}
+
+#define fx_c_t_opscq_direct_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    return(((s7_p_pp_t)opt2_direct(cdr(arg)))(sc, t_lookup(sc, cadr(arg), arg), \
+	     ((s7_p_pp_t)opt3_direct(cdr(arg)))(sc, Lookup(sc, opt3_sym(arg), arg), opt1_con(cdr(arg))))); \
+  }
+
+fx_c_t_opscq_direct_any(fx_c_t_opscq_direct, s_lookup)
+fx_c_t_opscq_direct_any(fx_c_t_opucq_direct, u_lookup)
+
+
+static s7_pointer fx_c_s_opsq(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer largs = caddr(arg);
+  set_car(sc->t2_2, fn_proc(largs)(sc, with_list_t1(lookup(sc, cadr(largs)))));
+  set_car(sc->t2_1, lookup(sc, cadr(arg)));
+  return(fn_proc(arg)(sc, sc->t2_1));
+}
+
+#define fx_c_s_opsq_direct_any(Name, Lookup1, Lookup2) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    arg = cdr(arg); \
+    return(((s7_p_pp_t)opt2_direct(arg))(sc, Lookup1(sc, car(arg), arg), ((s7_p_p_t)opt3_direct(arg))(sc, Lookup2(sc, opt1_sym(arg), arg)))); /* cadadr */ \
+  }
+
+fx_c_s_opsq_direct_any(fx_c_s_opsq_direct, s_lookup, s_lookup)
+fx_c_s_opsq_direct_any(fx_c_t_opsq_direct, t_lookup, s_lookup)
+fx_c_s_opsq_direct_any(fx_c_t_opuq_direct, t_lookup, u_lookup)
+fx_c_s_opsq_direct_any(fx_c_u_opvq_direct, u_lookup, v_lookup)
+
+#define fx_c_s_car_s_any(Name, Lookup1, Lookup2) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer val = Lookup2(sc, opt2_sym(cdr(arg)), arg); \
+    set_car(sc->t2_2, (is_pair(val)) ? car(val) : g_car(sc, set_plist_1(sc, val))); \
+    set_car(sc->t2_1, Lookup1(sc, cadr(arg), arg)); \
+    return(fn_proc(arg)(sc, sc->t2_1)); \
+  }
+
+fx_c_s_car_s_any(fx_c_s_car_s, s_lookup, s_lookup)
+fx_c_s_car_s_any(fx_c_s_car_t, s_lookup, t_lookup)
+fx_c_s_car_s_any(fx_c_t_car_u, t_lookup, u_lookup)
+fx_c_s_car_s_any(fx_c_t_car_v, t_lookup, v_lookup)
+
+
+#define fx_add_s_car_s_any(Name, Lookup1, Lookup2) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer val1 = Lookup1(sc, cadr(arg), arg); \
+    s7_pointer val2 = Lookup2(sc, opt2_sym(cdr(arg)), arg); \
+    val2 = (is_pair(val2)) ? car(val2) : g_car(sc, set_plist_1(sc, val2)); \
+    return(((is_t_integer(val1)) && (is_t_integer(val2))) ? make_integer(sc, integer(val1) + integer(val2)) : add_p_pp(sc, val1, val2)); \
+  }
+
+fx_add_s_car_s_any(fx_add_s_car_s, s_lookup, s_lookup)
+fx_add_s_car_s_any(fx_add_u_car_t, u_lookup, t_lookup)
+fx_add_s_car_s_any(fx_add_t_car_v, t_lookup, v_lookup)
+
+
+static s7_pointer fx_cons_s_cdr_s(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer val = lookup(sc, opt2_sym(cdr(arg)));
+  val = (is_pair(val)) ? cdr(val) : g_cdr(sc, set_plist_1(sc, val));
+  return(cons(sc, lookup(sc, cadr(arg)), val));
+}
+
+static s7_pointer fx_c_op_s_opsqq(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer outer = cadr(arg);
+  s7_pointer args = caddr(outer);
+  set_car(sc->t2_2, fn_proc(args)(sc, with_list_t1(lookup(sc, cadr(args)))));
+  set_car(sc->t2_1, lookup(sc, cadr(outer)));
+  return(fn_proc(arg)(sc, with_list_t1(fn_proc(outer)(sc, sc->t2_1))));
+}
+
+static s7_pointer fx_not_op_s_opsqq(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer outer = cadr(arg);
+  s7_pointer args = caddr(outer);
+  set_car(sc->t2_2, fn_proc(args)(sc, with_list_t1(lookup(sc, cadr(args)))));
+  set_car(sc->t2_1, lookup(sc, cadr(outer)));
+  return(((fn_proc(outer)(sc, sc->t2_1)) == sc->F) ? sc->T : sc->F);
+}
+
+static s7_pointer fx_c_op_opsq_sq(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer outer = cadr(arg);
+  s7_pointer args = cadr(outer);
+  set_car(sc->t2_1, fn_proc(args)(sc, with_list_t1(lookup(sc, cadr(args)))));
+  set_car(sc->t2_2, lookup(sc, caddr(outer)));
+  return(fn_proc(arg)(sc, with_list_t1(fn_proc(outer)(sc, sc->t2_1))));
+}
+
+static s7_pointer fx_not_op_optq_sq(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer outer = cadr(arg);
+  s7_pointer args = cadr(outer);
+  set_car(sc->t2_1, fn_proc(args)(sc, with_list_t1(t_lookup(sc, cadr(args), arg))));
+  set_car(sc->t2_2, lookup(sc, caddr(outer)));
+  return((fn_proc(outer)(sc, sc->t2_1) == sc->F) ? sc->T : sc->F);
+}
+
+static s7_pointer fx_c_c_opsq(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer largs = opt3_pair(arg); /* caddr(arg) */
+  set_car(sc->t2_2, fn_proc(largs)(sc, with_list_t1(lookup(sc, cadr(largs)))));
+  set_car(sc->t2_1, cadr(arg));
+  return(fn_proc(arg)(sc, sc->t2_1));
+}
+
+static s7_pointer fx_c_c_opsq_direct(s7_scheme *sc, s7_pointer arg)
+{
+  return(((s7_p_pp_t)opt2_direct(cdr(arg)))(sc, cadr(arg), ((s7_p_p_t)opt3_direct(cdr(arg)))(sc, lookup(sc, opt1_sym(cdr(arg))))));
+}
+
+/* perhaps fx_c_c_opt|T|Vq_direct tlet/tmisc */
+
+static s7_pointer fx_c_opsq_opsq(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer largs = cdr(arg);
+  gc_protect_via_stack(sc, fn_proc(car(largs))(sc, with_list_t1(lookup(sc, cadar(largs)))));
+  largs = cadr(largs);
+  set_car(sc->t2_2, fn_proc(largs)(sc, with_list_t1(lookup(sc, cadr(largs)))));
+  set_car(sc->t2_1, gc_protected1(sc));
+  unstack_gc_protect(sc);
+  return(fn_proc(arg)(sc, sc->t2_1));
+}
+
+static s7_pointer fx_c_opsq_opsq_direct(s7_scheme *sc, s7_pointer arg)
+{
+  return(((s7_p_pp_t)opt3_direct(arg))(sc,
+	    ((s7_p_p_t)opt2_direct(cdr(arg)))(sc, lookup(sc, cadadr(arg))),          /* no free field in arg or cdr(arg) */
+            ((s7_p_p_t)opt3_direct(cdr(arg)))(sc, lookup(sc, opt1_sym(cdr(arg)))))); /* cadaddr(arg) */
+}
+
+static s7_pointer fx_c_optq_optq_direct(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer x = t_lookup(sc, opt1_sym(cdr(arg)), arg); /* cadadr and cadaddr */
+  return(((s7_p_pp_t)opt3_direct(arg))(sc, ((s7_p_p_t)opt2_direct(cdr(arg)))(sc, x), ((s7_p_p_t)opt3_direct(cdr(arg)))(sc, x)));
+}
+
+#define fx_car_s_car_s_any(Name, Lookup1, Lookup2) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    s7_pointer p1 = Lookup1(sc, opt1_sym(cdr(arg)), arg); \
+    s7_pointer p2 = Lookup2(sc, opt2_sym(cdr(arg)), arg);  /* cadaddr(arg) */ \
+    return(((s7_p_pp_t)opt3_direct(arg))(sc, (is_pair(p1)) ? car(p1) : g_car(sc, set_plist_1(sc, p1)), \
+                                             (is_pair(p2)) ? car(p2) : g_car(sc, set_plist_1(sc, p2)))); \
+  }
+
+fx_car_s_car_s_any(fx_car_s_car_s, s_lookup, s_lookup)
+fx_car_s_car_s_any(fx_car_t_car_u, t_lookup, u_lookup)
+
+
+static s7_pointer fx_cdr_s_cdr_s(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p1 = lookup(sc, opt1_sym(cdr(arg)));
+  s7_pointer p2 = lookup(sc, opt2_sym(cdr(arg)));  /* cadaddr(arg) */
+  return(((s7_p_pp_t)opt3_direct(arg))(sc, (is_pair(p1)) ? cdr(p1) : g_cdr(sc, set_plist_1(sc, p1)),
+				           (is_pair(p2)) ? cdr(p2) : g_cdr(sc, set_plist_1(sc, p2))));
+}
+
+static s7_pointer fx_is_eq_car_car_tu(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p1 = t_lookup(sc, opt1_sym(cdr(arg)), arg);
+  s7_pointer p2 = u_lookup(sc, opt2_sym(cdr(arg)), arg);
+  p1 = (is_pair(p1)) ? car(p1) : g_car(sc, set_plist_1(sc, p1));
+  p2 = (is_pair(p2)) ? car(p2) : g_car(sc, set_plist_1(sc, p2));
+  return(make_boolean(sc, (p1 == p2) || ((is_unspecified(p1)) && (is_unspecified(p2)))));
+}
+
+static s7_pointer fx_c_opsq_opssq(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer largs = cdr(arg);
+  gc_protect_via_stack(sc, fn_proc(car(largs))(sc, with_list_t1(lookup(sc, cadar(largs)))));
+  largs = cadr(largs);
+  set_car(sc->t2_1, lookup(sc, cadr(largs)));
+  set_car(sc->t2_2, lookup(sc, opt2_sym(cdr(largs)))); /* caddr(largs) */
+  set_car(sc->t2_2, fn_proc(largs)(sc, sc->t2_1));
+  set_car(sc->t2_1, gc_protected1(sc));
+  unstack_gc_protect(sc);
+  return(fn_proc(arg)(sc, sc->t2_1));
+}
+
+static s7_pointer fx_c_opsq_optuq_direct(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer largs = cdr(arg);
+  return(((s7_p_pp_t)opt3_direct(arg))(sc,
+	    ((s7_p_p_t)opt2_direct(largs))(sc, lookup(sc, cadar(largs))),
+            ((s7_p_pp_t)opt3_direct(largs))(sc, t_lookup(sc, opt2_sym(cdr(largs)), arg), u_lookup(sc, opt1_sym(largs), arg))));
+}
+
+static s7_pointer fx_num_eq_car_v_add_tu(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p1 = car_p_p(sc, v_lookup(sc, cadadr(arg), arg));
+  s7_pointer p2 = t_lookup(sc, opt2_sym(cddr(arg)), arg);
+  s7_pointer p3 = u_lookup(sc, opt1_sym(cdr(arg)), arg);
+  if ((is_t_integer(p1)) && (is_t_integer(p2)) && (is_t_integer(p3)))
+    return(make_boolean(sc, integer(p1) == (integer(p2) + integer(p3))));
+  return(make_boolean(sc, num_eq_b_7pp(sc, p1, add_p_pp(sc, p2, p3))));
+}
+
+static s7_pointer fx_num_eq_car_v_subtract_tu(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p1 = car_p_p(sc, v_lookup(sc, cadadr(arg), arg));
+  s7_pointer p2 = t_lookup(sc, opt2_sym(cddr(arg)), arg);
+  s7_pointer p3 = u_lookup(sc, opt1_sym(cdr(arg)), arg);
+  if ((is_t_integer(p1)) && (is_t_integer(p2)) && (is_t_integer(p3)))
+    return(make_boolean(sc, integer(p1) == (integer(p2) - integer(p3))));
+  return(make_boolean(sc, num_eq_b_7pp(sc, p1, subtract_p_pp(sc, p2, p3))));
+}
+
+static s7_pointer fx_c_opssq_opsq(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer largs = cdr(arg);
+  set_car(sc->t2_1, lookup(sc, cadar(largs)));
+  set_car(sc->t2_2, lookup(sc, opt2_sym(cdar(largs))));
+  gc_protect_via_stack(sc, fn_proc(car(largs))(sc, sc->t2_1));
+  largs = cadr(largs);
+  set_car(sc->t2_2, fn_proc(largs)(sc, with_list_t1(lookup(sc, cadr(largs)))));
+  set_car(sc->t2_1, gc_protected1(sc));
+  unstack_gc_protect(sc);
+  return(fn_proc(arg)(sc, sc->t2_1));
+}
+
+static s7_pointer fx_c_opssq_opssq(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer largs = cdr(arg);
+  set_car(sc->t2_1, lookup(sc, cadar(largs)));
+  set_car(sc->t2_2, lookup(sc, opt2_sym(cdar(largs))));
+  gc_protect_via_stack(sc, fn_proc(car(largs))(sc, sc->t2_1));
+  largs = cadr(largs);
+  set_car(sc->t2_1, lookup(sc, cadr(largs)));
+  set_car(sc->t2_2, lookup(sc, opt2_sym(cdr(largs))));
+  set_car(sc->t2_2, fn_proc(largs)(sc, sc->t2_1));
+  set_car(sc->t2_1, gc_protected1(sc));
+  unstack_gc_protect(sc);
+  return(fn_proc(arg)(sc, sc->t2_1));
+}
+
+static s7_pointer fx_sub_mul_mul(s7_scheme *sc, s7_pointer arg) /* (- (* s1 s2) (* s3 s4)) */
+{
+  s7_pointer a1 = opt3_pair(arg);      /* cdaddr(arg) */
+  s7_pointer s1 = lookup(sc, car(a1));
+  s7_pointer s2 = lookup(sc, cadr(a1));
+  s7_pointer a2 = opt1_pair(cdr(arg)); /* cdadr(arg) */ /* here and elsewhere this should be GC safe -- opssq->* (no methods?) etc */
+  s7_pointer s3 = lookup(sc, car(a2));
+  s7_pointer s4 = lookup(sc, cadr(a2));
+  if ((is_t_real(s1)) && (is_t_real(s2)) && (is_t_real(s3)) && (is_t_real(s4)))
+    return(make_real(sc, (real(s3) * real(s4)) - (real(s1) * real(s2))));
+  sc->temp5 = multiply_p_pp(sc, s1, s2);
+  return(subtract_p_pp(sc, multiply_p_pp(sc, s3, s4), sc->temp5));
+}
+
+static s7_pointer fx_add_mul_mul(s7_scheme *sc, s7_pointer arg) /* (+ (* s1 s2) (* s3 s4)) */
+{
+  s7_pointer a1 = opt3_pair(arg);      /* cdaddr(arg) */
+  s7_pointer s1 = lookup(sc, car(a1));
+  s7_pointer s2 = lookup(sc, cadr(a1));
+  s7_pointer a2 = opt1_pair(cdr(arg)); /* cdadr(arg) */
+  s7_pointer s3 = lookup(sc, car(a2));
+  s7_pointer s4 = lookup(sc, cadr(a2));
+  if ((is_t_real(s1)) && (is_t_real(s2)) && (is_t_real(s3)) && (is_t_real(s4)))
+    return(make_real(sc, (real(s3) * real(s4)) + (real(s1) * real(s2))));
+  sc->temp5 = multiply_p_pp(sc, s1, s2);
+  return(add_p_pp(sc, multiply_p_pp(sc, s3, s4), sc->temp5));
+}
+
+static s7_pointer fx_mul_sub_sub(s7_scheme *sc, s7_pointer arg) /* (* (- s1 s2) (- s3 s4)) */
+{
+  s7_pointer a1 = opt3_pair(arg);      /* cdaddr(arg) */
+  s7_pointer s1 = lookup(sc, car(a1));
+  s7_pointer s2 = lookup(sc, cadr(a1));
+  s7_pointer a2 = opt1_pair(cdr(arg)); /* cdadr(arg) */
+  s7_pointer s3 = lookup(sc, car(a2));
+  s7_pointer s4 = lookup(sc, cadr(a2));
+  if ((is_t_real(s1)) && (is_t_real(s2)) && (is_t_real(s3)) && (is_t_real(s4)))
+    return(make_real(sc, (real(s3) - real(s4)) * (real(s1) - real(s2))));
+  sc->temp5 = subtract_p_pp(sc, s1, s2);
+  return(multiply_p_pp(sc, subtract_p_pp(sc, s3, s4), sc->temp5));
+}
+
+static s7_pointer fx_lt_sub2(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer a1 = opt3_pair(arg);      /* cdaddr(arg) */
+  sc->temp5 = subtract_p_pp(sc, lookup(sc, car(a1)), lookup(sc, cadr(a1)));
+  a1 = opt1_pair(cdr(arg)); /* cdadr(arg) */
+  return(lt_p_pp(sc, subtract_p_pp(sc, lookup(sc, car(a1)), lookup(sc, cadr(a1))), sc->temp5));
+}
+
+static s7_pointer fx_sub_vref2(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer a1 = cdadr(arg);
+  s7_pointer v1 = lookup(sc, car(a1));
+  s7_pointer p1 = lookup(sc, cadr(a1));
+  s7_pointer p2 = lookup(sc, opt3_sym(arg)); /* caddaddr(arg) */
+  if ((is_t_integer(p1)) && (is_t_integer(p2)) && ((is_t_vector(v1)) && (vector_rank(v1) == 1)))
+    {
+      s7_int i1 = integer(p1), i2 = integer(p2);
+      if ((i1 >= 0) && (i1 <= vector_length(v1)) && (i2 >= 0) && (i2 < vector_length(v1)))
+	return(subtract_p_pp(sc, vector_ref_p_pi(sc, v1, i1), vector_ref_p_pi(sc, v1, i2)));
+    }
+  return(subtract_p_pp(sc, vector_ref_p_pp(sc, v1, p1), vector_ref_p_pp(sc, v1, p2)));
+}
+
+static s7_pointer fx_c_op_opsqq(s7_scheme *sc, s7_pointer code)
+{
+  set_car(sc->t1_1, fn_proc(opt3_pair(code))(sc, with_list_t1(lookup(sc, opt3_sym(cdr(code))))));
+  set_car(sc->t1_1, fn_proc(cadr(code))(sc, sc->t1_1));
+  return(fn_proc(code)(sc, sc->t1_1));
+}
+
+static s7_pointer fx_not_op_opsqq(s7_scheme *sc, s7_pointer code)
+{
+  set_car(sc->t1_1, fn_proc(opt3_pair(code))(sc, with_list_t1(lookup(sc, opt3_sym(cdr(code))))));
+  return((fn_proc(cadr(code))(sc, sc->t1_1) == sc->F) ? sc->T : sc->F);
+}
+
+static s7_pointer fx_not_is_pair_opsq(s7_scheme *sc, s7_pointer code)
+{
+  return(make_boolean(sc, !is_pair(fn_proc(opt3_pair(code))(sc, set_plist_1(sc, lookup(sc, opt3_sym(cdr(code))))))));
+}
+
+static s7_pointer fx_sref_t_last(s7_scheme *sc, s7_pointer arg) {return(string_ref_p_plast(sc, t_lookup(sc, cadr(arg), arg), int_zero));} /* both syms are t_lookup */
+
+static s7_pointer fx_c_a(s7_scheme *sc, s7_pointer arg)
+{
+  return(fn_proc(arg)(sc, with_list_t1(fx_call(sc, cdr(arg)))));
+}
+
+static s7_pointer fx_c_a_direct(s7_scheme *sc, s7_pointer arg) {return(((s7_p_p_t)opt3_direct(arg))(sc, fx_call(sc, cdr(arg))));}
+static s7_pointer fx_not_a(s7_scheme *sc, s7_pointer arg)      {return((fx_call(sc, cdr(arg)) == sc->F) ? sc->T : sc->F);}
+
+static s7_pointer fx_c_saa(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer res;
+  gc_protect_via_stack(sc, fx_call(sc, opt3_pair(arg))); /* opt3_pair=cddr */
+  set_car(sc->t3_3, fx_call(sc, cdr(opt3_pair(arg))));
+  set_car(sc->t3_1, lookup(sc, cadr(arg)));
+  set_car(sc->t3_2, gc_protected1(sc));
+  res = fn_proc(arg)(sc, sc->t3_1);
+  unstack_gc_protect(sc);
+  return(res);
+}
+
+#define fx_c_ssa_any(Name, Lookup1, Lookup2) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+  set_car(sc->t3_3, fx_call(sc, cdr(opt3_pair(arg)))); \
+  set_car(sc->t3_1, Lookup1(sc, cadr(arg), arg));\
+  set_car(sc->t3_2, Lookup2(sc, car(opt3_pair(arg)), arg)); \
+  return(fn_proc(arg)(sc, sc->t3_1));\
+  }
+
+fx_c_ssa_any(fx_c_ssa, s_lookup, s_lookup)
+fx_c_ssa_any(fx_c_tsa, t_lookup, s_lookup)
+fx_c_ssa_any(fx_c_sta, s_lookup, t_lookup)
+
+static s7_pointer fx_c_ssa_direct(s7_scheme *sc, s7_pointer arg)
+{
+  return(((s7_p_ppp_t)opt2_direct(cdr(arg)))(sc, lookup(sc, cadr(arg)), lookup(sc, car(opt3_pair(arg))), fx_call(sc, cdr(opt3_pair(arg)))));
+}
+
+static s7_pointer fx_c_ass(s7_scheme *sc, s7_pointer arg)
+{
+  set_car(sc->t3_1, fx_call(sc, cdr(arg)));
+  set_car(sc->t3_2, lookup(sc, car(opt3_pair(arg))));
+  set_car(sc->t3_3, lookup(sc, cadr(opt3_pair(arg))));
+  return(fn_proc(arg)(sc, sc->t3_1));
+}
+
+static s7_pointer fx_c_agg(s7_scheme *sc, s7_pointer arg)
+{
+  set_car(sc->t3_1, fx_call(sc, cdr(arg)));
+  set_car(sc->t3_2, fx_call(sc, opt3_pair(arg)));
+  set_car(sc->t3_3, fx_call(sc, cdr(opt3_pair(arg))));
+  return(fn_proc(arg)(sc, sc->t3_1));
+}
+
+static s7_pointer fx_c_sas(s7_scheme *sc, s7_pointer arg)
+{
+  set_car(sc->t3_2, fx_call(sc, opt3_pair(arg)));
+  set_car(sc->t3_1, lookup(sc, cadr(arg)));
+  set_car(sc->t3_3, lookup(sc, cadr(opt3_pair(arg))));
+  return(fn_proc(arg)(sc, sc->t3_1));
+}
+
+static s7_pointer fx_c_sca(s7_scheme *sc, s7_pointer arg)
+{
+  set_car(sc->t3_3, fx_call(sc, cdr(opt3_pair(arg))));
+  set_car(sc->t3_1, lookup(sc, cadr(arg)));
+  set_car(sc->t3_2, car(opt3_pair(arg)));
+  return(fn_proc(arg)(sc, sc->t3_1));
+}
+
+static s7_pointer fx_c_Tca(s7_scheme *sc, s7_pointer arg)
+{
+  set_car(sc->t3_3, fx_call(sc, cdr(opt3_pair(arg))));
+  set_car(sc->t3_1, T_lookup(sc, cadr(arg), arg));
+  set_car(sc->t3_2, car(opt3_pair(arg)));
+  return(fn_proc(arg)(sc, sc->t3_1));
+}
+
+static s7_pointer fx_c_csa(s7_scheme *sc, s7_pointer arg)
+{
+  set_car(sc->t3_3, fx_call(sc, cdr(opt3_pair(arg))));
+  set_car(sc->t3_1, cadr(arg));
+  set_car(sc->t3_2, lookup(sc, car(opt3_pair(arg))));
+  return(fn_proc(arg)(sc, sc->t3_1));
+}
+
+static s7_pointer fx_c_cac(s7_scheme *sc, s7_pointer arg)
+{
+  set_car(sc->t3_2, fx_call(sc, opt3_pair(arg)));
+  set_car(sc->t3_1, cadr(arg));
+  set_car(sc->t3_3, cadr(opt3_pair(arg)));
+  return(fn_proc(arg)(sc, sc->t3_1));
+}
+
+static s7_pointer fx_c_aa(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer res;
+  /* check_stack_size(sc); */
+  gc_protect_2_via_stack(sc, fx_call(sc, cdr(arg)), fx_call(sc, opt3_pair(arg))); /* opt3_pair = cddr(arg) */
+  set_car(sc->t2_1, T_Ext(gc_protected1(sc)));
+  set_car(sc->t2_2, gc_protected2(sc));
+  res = fn_proc(arg)(sc, sc->t2_1);
+  unstack_gc_protect(sc);
+  return(res);
+}
+
+static s7_pointer fx_c_ca(s7_scheme *sc, s7_pointer arg)
+{
+  set_car(sc->t2_2, fx_call(sc, cddr(arg)));
+  set_car(sc->t2_1, opt3_con(arg));
+  return(fn_proc(arg)(sc, sc->t2_1));
+}
+
+static s7_pointer fx_c_ac(s7_scheme *sc, s7_pointer arg)
+{
+  set_car(sc->t2_1, fx_call(sc, cdr(arg)));
+  set_car(sc->t2_2, opt3_con(arg));
+  return(fn_proc(arg)(sc, sc->t2_1));
+}
+
+static s7_pointer fx_c_ac_direct(s7_scheme *sc, s7_pointer arg) {return(((s7_p_pp_t)opt3_direct(cdr(arg)))(sc, fx_call(sc, cdr(arg)), opt3_con(arg)));}
+static s7_pointer fx_c_ai_direct(s7_scheme *sc, s7_pointer arg) {return(((s7_p_pi_t)opt3_direct(cdr(arg)))(sc, fx_call(sc, cdr(arg)), integer(opt3_con(arg))));}
+
+static s7_pointer fx_sub_a1(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p = fx_call(sc, cdr(arg));
+  if (is_t_integer(p)) return(subtract_if_overflow_to_real_or_big_integer(sc, integer(p), 1));
+  if (is_t_real(p)) return(make_real(sc, real(p) - 1.0));
+  return(subtract_p_pp(sc, p, int_one));
+}
+
+static s7_pointer fx_add_a1(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p = fx_call(sc, cdr(arg));
+  if (is_t_integer(p)) return(add_if_overflow_to_real_or_big_integer(sc, integer(p), 1));
+  if (is_t_real(p)) return(make_real(sc, real(p) + 1.0));
+  return(add_p_pp(sc, p, int_one));
+}
+
+static s7_pointer fx_lt_ad(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p = fx_call(sc, cdr(arg));
+  if (is_t_real(p)) return(make_boolean(sc, real(p) < real(opt3_con(arg))));
+  if (is_t_integer(p)) return(make_boolean(sc, integer(p) < real(opt3_con(arg))));
+  return(make_boolean(sc, lt_b_7pp(sc, p, opt3_con(arg))));
+}
+
+static s7_pointer fx_is_eq_ac(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer y = opt3_con(arg);
+  s7_pointer x = fx_call(sc, cdr(arg));
+  return(make_boolean(sc, (x == y) || ((is_unspecified(x)) && (is_unspecified(y)))));
+}
+
+#define fx_c_sa_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    set_car(sc->t2_2, fx_call(sc, cddr(arg))); \
+    set_car(sc->t2_1, Lookup(sc, opt3_sym(arg), arg)); \
+    return(fn_proc(arg)(sc, sc->t2_1)); \
+  }
+
+fx_c_sa_any(fx_c_sa, s_lookup)
+fx_c_sa_any(fx_c_ta, t_lookup)
+fx_c_sa_any(fx_c_ua, u_lookup)
+
+#define fx_c_sa_direct_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    return(((s7_p_pp_t)opt3_direct(cdr(arg)))(sc, Lookup(sc, opt3_sym(arg), arg), fx_call(sc, cddr(arg)))); \
+  }
+
+fx_c_sa_direct_any(fx_c_sa_direct, s_lookup)
+fx_c_sa_direct_any(fx_c_ua_direct, u_lookup)
+
+static s7_pointer fx_cons_ca(s7_scheme *sc, s7_pointer arg) {return(cons(sc, opt3_con(arg), fx_call(sc, cddr(arg))));}
+static s7_pointer fx_cons_ac(s7_scheme *sc, s7_pointer arg) {return(cons(sc, sc->temp3 = fx_call(sc, cdr(arg)), opt3_con(arg)));}
+static s7_pointer fx_cons_sa(s7_scheme *sc, s7_pointer arg) {return(cons(sc, lookup(sc, opt3_sym(arg)), fx_call(sc, cddr(arg))));}
+static s7_pointer fx_cons_as(s7_scheme *sc, s7_pointer arg) {return(cons(sc, sc->temp3 = fx_call(sc, cdr(arg)), lookup(sc, opt3_sym(arg))));}
+static s7_pointer fx_cons_aa(s7_scheme *sc, s7_pointer arg) {return(cons(sc, sc->temp3 = fx_call(sc, cdr(arg)), fx_call(sc, opt3_pair(arg))));}
+
+#define fx_c_as_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    set_car(sc->t2_1, fx_call(sc, cdr(arg))); \
+    set_car(sc->t2_2, Lookup(sc, opt3_sym(arg), arg)); \
+    return(fn_proc(arg)(sc, sc->t2_1)); \
+  }
+
+fx_c_as_any(fx_c_as, s_lookup)
+fx_c_as_any(fx_c_at, t_lookup)
+
+static s7_pointer fx_c_as_direct(s7_scheme *sc, s7_pointer arg)
+{
+  return(((s7_p_pp_t)opt3_direct(cdr(arg)))(sc, fx_call(sc, cdr(arg)), lookup(sc, opt3_sym(arg))));
+}
+
+static s7_pointer fx_add_as(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer x1 = fx_call(sc, cdr(arg));
+  s7_pointer x2 = lookup(sc, opt3_sym(arg));
+  if ((is_t_real(x1)) && (is_t_real(x2))) return(make_real(sc, real(x1) + real(x2)));
+  return(add_p_pp(sc, x1, x2));
+}
+
+static s7_pointer fx_multiply_sa(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer x1 = lookup(sc, cadr(arg));
+  s7_pointer x2 = fx_call(sc, cddr(arg));
+  if ((is_t_real(x1)) && (is_t_real(x2))) return(make_real(sc, real(x1) * real(x2)));
+  return(multiply_p_pp(sc, x1, x2));
+}
+
+static s7_pointer fx_subtract_aa(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer x2;
+  s7_pointer x1 = fx_call(sc, cdr(arg));
+  sc->value = x1;
+  x2 = fx_call(sc, opt3_pair(arg));
+  if ((is_t_real(x1)) && (is_t_real(x2))) return(make_real(sc, real(x1) - real(x2)));
+  return(subtract_p_pp(sc, x1, x2));
+}
+
+static s7_pointer fx_add_aa(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer x2;
+  s7_pointer x1 = fx_call(sc, cdr(arg));
+  sc->value = x1;
+  x2 = fx_call(sc, opt3_pair(arg));
+  if (is_t_real(x1)) {if (is_t_real(x2)) return(make_real(sc, real(x1) + real(x2)));}
+  else if ((is_t_integer(x1)) && (is_t_integer(x2))) return(make_integer(sc, integer(x1) + integer(x2)));
+  /* maybe use add_if_overflow_to_real_or_big_integer, but that seems unnecessary currently */
+  return(add_p_pp(sc, x1, x2));
+}
+
+static s7_pointer fx_multiply_aa(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer x2;
+  s7_pointer x1 = fx_call(sc, cdr(arg));
+  sc->value = x1;
+  x2 = fx_call(sc, opt3_pair(arg));
+  if ((is_t_real(x1)) && (is_t_real(x2))) return(make_real(sc, real(x1) * real(x2)));
+  return(multiply_p_pp(sc, x1, x2));
+}
+
+static s7_pointer fx_add_sa(s7_scheme *sc, s7_pointer arg) {return(add_p_pp(sc, lookup(sc, opt3_sym(arg)), fx_call(sc, cddr(arg))));}
+static s7_pointer fx_number_to_string_aa(s7_scheme *sc, s7_pointer arg) {return(number_to_string_p_pp(sc, fx_call(sc, cdr(arg)), fx_call(sc, opt3_pair(arg))));}
+
+static s7_pointer fx_c_3g(s7_scheme *sc, s7_pointer arg)
+{
+  set_car(sc->t3_1, fx_call(sc, cdr(arg)));
+  set_car(sc->t3_2, fx_call(sc, opt3_pair(arg)));
+  set_car(sc->t3_3, fx_call(sc, cdr(opt3_pair(arg))));
+  return(fn_proc(arg)(sc, sc->t3_1));
+}
+
+static s7_pointer fx_c_aaa(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer res;
+  /* check_stack_size(sc); */
+  gc_protect_2_via_stack(sc, fx_call(sc, cdr(arg)), fx_call(sc, opt3_pair(arg)));
+  set_car(sc->t3_3, fx_call(sc, cdr(opt3_pair(arg))));
+  set_car(sc->t3_2, gc_protected2(sc));
+  set_car(sc->t3_1, gc_protected1(sc));
+  res = fn_proc(arg)(sc, sc->t3_1);
+  unstack_gc_protect(sc);
+  return(res);
+}
+
+static s7_pointer fx_c_gac(s7_scheme *sc, s7_pointer arg)
+{
+  set_car(sc->t3_2, fx_call(sc, opt3_pair(arg)));
+  set_car(sc->t3_3, cadr(opt3_pair(arg)));
+  set_car(sc->t3_1, lookup_global(sc, cadr(arg)));
+  return(fn_proc(arg)(sc, sc->t3_1));
+}
+
+static s7_pointer fx_c_opaq_s(s7_scheme *sc, s7_pointer arg)
+{
+  set_car(sc->t2_1, fn_proc(cadr(arg))(sc, with_list_t1(fx_call(sc, cdadr(arg)))));
+  set_car(sc->t2_2, lookup_checked(sc, caddr(arg)));
+  return(fn_proc(arg)(sc, sc->t2_1));
+}
+
+static s7_pointer fx_c_s_opaq(s7_scheme *sc, s7_pointer arg)
+{
+  set_car(sc->t2_2, fn_proc(caddr(arg))(sc, with_list_t1(fx_call(sc, opt3_pair(arg))))); /* cdaddr(arg) */
+  set_car(sc->t2_1, lookup_checked(sc, cadr(arg)));
+  return(fn_proc(arg)(sc, sc->t2_1));
+}
+
+static s7_pointer fx_c_opaq(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p = cadr(arg);
+  set_car(sc->t1_1, fx_call(sc, cdr(p)));
+  return(fn_proc(arg)(sc, with_list_t1(fn_proc(p)(sc, sc->t1_1))));
+}
+
+static s7_pointer fx_c_opaaq(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p = cadr(arg), res;
+  /* check_stack_size(sc); */
+  gc_protect_via_stack(sc, fx_call(sc, cdr(p)));
+  set_car(sc->t2_2, fx_call(sc, cddr(p)));
+  set_car(sc->t2_1, gc_protected1(sc));
+  res = fn_proc(p)(sc, sc->t2_1);
+  set_gc_protected2(sc, res); /* might be a big list etc (see s7test.scm fx_c_opaaq test) */
+  res = fn_proc(arg)(sc, with_list_t1(res));
+  unstack_gc_protect(sc);
+  return(res);
+}
+
+static s7_pointer fx_c_opsaq(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p = cadr(arg);
+  set_car(sc->t2_2, fx_call(sc, cddr(p)));
+  set_car(sc->t2_1, lookup(sc, cadr(p)));
+  return(fn_proc(arg)(sc, with_list_t1(fn_proc(p)(sc, sc->t2_1))));
+}
+
+static s7_pointer fx_c_opaaaq(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer arg = cadr(code), res;
+  gc_protect_2_via_stack(sc, fx_call(sc, cdr(arg)), fx_call(sc, opt3_pair(arg)));      /* cddr(arg) */
+  set_car(sc->t3_3, fx_call(sc, cdr(opt3_pair(arg))));
+  set_car(sc->t3_1, gc_protected1(sc));
+  set_car(sc->t3_2, gc_protected2(sc));
+  res = fn_proc(code)(sc, with_list_t1(fn_proc(arg)(sc, sc->t3_1)));
+  unstack_gc_protect(sc);
+  return(res);
+}
+
+static s7_pointer fx_c_s_opaaq(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer arg = caddr(code), res;
+  gc_protect_via_stack(sc, fx_call(sc, cdr(arg)));
+  set_car(sc->t2_2, fx_call(sc, cddr(arg)));
+  set_car(sc->t2_1, gc_protected1(sc));
+  set_car(sc->t2_2, fn_proc(arg)(sc, sc->t2_1));
+  set_car(sc->t2_1, lookup(sc, cadr(code)));
+  res = fn_proc(code)(sc, sc->t2_1);
+  unstack_gc_protect(sc);
+  return(res);
+}
+
+static s7_pointer fx_c_4a(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer res = cdr(code);
+  check_stack_size(sc); /* t718 pp cycles #f */
+  gc_protect_2_via_stack(sc, fx_call(sc, res), fx_call(sc, cdr(res)));
+  res = cddr(res);
+  set_gc_protected3(sc, fx_call(sc, res));
+  set_car(sc->t3_3, fx_call(sc, cdr(res)));
+  set_car(sc->t3_2, gc_protected3(sc));
+  set_car(sc->t3_1, gc_protected2(sc));
+  set_car(sc->t4_1, gc_protected1(sc));
+  res = fn_proc(code)(sc, sc->t4_1);
+  unstack_gc_protect(sc);
+  set_car(sc->t4_1, sc->F);
+  return(res);
+}
+
+static s7_pointer fx_c_4g(s7_scheme *sc, s7_pointer code)
+{ /* all opts in use for code, opt1 free cdr(code), code opt3 is line_number, cdr(code) opt3 is arglen?? */
+  s7_pointer res = cdr(code);
+  set_car(sc->t4_1, fx_call(sc, res));
+  set_car(sc->t3_1, fx_call(sc, cdr(res)));
+  set_car(sc->t3_2, fx_call(sc, opt3_pair(code)));      /* cddr(res) */
+  set_car(sc->t3_3, fx_call(sc, cdr(opt3_pair(code)))); /* cdddr(res) */
+  res = fn_proc(code)(sc, sc->t4_1);
+  set_car(sc->t4_1, sc->F);
+  return(res);
+}
+
+static s7_pointer fx_c_c_opscq(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer largs = caddr(arg);
+  set_car(sc->t2_1, lookup(sc, cadr(largs)));
+  set_car(sc->t2_2, opt2_con(cdr(largs)));
+  set_car(sc->t2_2, fn_proc(largs)(sc, sc->t2_1));
+  set_car(sc->t2_1, cadr(arg));
+  return(fn_proc(arg)(sc, sc->t2_1));
+}
+
+static s7_pointer fx_c_s_opcsq(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer largs = caddr(arg);
+  set_car(sc->t2_2, lookup(sc, caddr(largs)));
+  set_car(sc->t2_1, opt1_con(cdr(largs))); /* cadr(largs) or cadadr */
+  set_car(sc->t2_2, fn_proc(largs)(sc, sc->t2_1));
+  set_car(sc->t2_1, lookup(sc, cadr(arg)));
+  return(fn_proc(arg)(sc, sc->t2_1));
+}
+
+static s7_pointer fx_c_op_opssqq_s(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer arg = opt1_pair(cdr(code));
+  set_car(sc->t2_1, lookup(sc, cadr(arg)));
+  set_car(sc->t2_2, lookup(sc, opt2_sym(cdr(arg))));
+  set_car(sc->t2_1, fn_proc(cadr(code))(sc, with_list_t1(fn_proc(arg)(sc, sc->t2_1))));
+  set_car(sc->t2_2, lookup(sc, caddr(code)));
+  return(fn_proc(code)(sc, sc->t2_1));
+}
+
+static s7_pointer fx_c_op_opssqq_s_direct(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer arg = opt1_pair(cdr(code));
+  return(((s7_p_pp_t)opt3_direct(code))(sc,
+            ((s7_p_p_t)opt2_direct(cdr(code)))(sc,
+               ((s7_p_pp_t)opt3_direct(cdr(code)))(sc, lookup(sc, cadr(arg)), lookup(sc, caddr(arg)))),
+	    lookup(sc, caddr(code))));
+}
+
+static s7_pointer fx_c_ns(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p1, lst = safe_list_if_possible(sc, opt3_arglen(cdr(arg)));
+  if (in_heap(lst)) gc_protect_via_stack(sc, lst);
+  for (s7_pointer args = cdr(arg), p = lst; is_pair(args); args = cdr(args), p = cdr(p))
+    set_car(p, lookup(sc, car(args)));
+  p1 = fn_proc(arg)(sc, lst);
+  if (in_heap(lst)) unstack_gc_protect(sc);
+  else clear_list_in_use(lst);
+  return(p1);
+}
+
+static s7_pointer fx_list_ns(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer lst = make_list(sc, opt3_arglen(cdr(arg)), sc->unused);
+  for (s7_pointer args = cdr(arg), p = lst; is_pair(args); args = cdr(args), p = cdr(p))
+    set_car(p, lookup(sc, car(args)));
+  return(lst);
+}
+
+static s7_pointer fx_c_all_ca(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer p1, lst = safe_list_if_possible(sc, opt3_arglen(cdr(code)));
+  if (in_heap(lst)) gc_protect_via_stack(sc, lst);
+  for (s7_pointer args = cdr(code), p = lst; is_pair(args); args = cdr(args), p = cddr(p))
+    {
+      set_car(p, opt2_con(args));
+      args = cdr(args);
+      set_car(cdr(p), fx_call(sc, args));
+    }
+  p1 = fn_proc(code)(sc, lst);
+  if (in_heap(lst)) unstack_gc_protect(sc);
+  else clear_list_in_use(lst);
+  return(p1);
+}
+
+static s7_pointer fx_inlet_ca(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer new_e, sp = NULL;
+  int64_t id;
+
+  new_cell(sc, new_e, T_LET | T_SAFE_PROCEDURE);
+  let_set_slots(new_e, slot_end); /* needed by add_slot_unchecked */
+  let_set_outlet(new_e, sc->rootlet);
+  gc_protect_via_stack(sc, new_e);
+
+  /* as in let, we need to call the var inits before making the new let, but a simpler equivalent is to make the new let
+   *    but don't set its id yet, and don't set local_slot until end either because fx_call might refer to same-name symbol in outer let.
+   *    That is, symbol_id=outer_let_id so lookup->local_slot, so we better not set local_slot ahead of time here.
+   */
+  for (s7_pointer x = cdr(code); is_pair(x); x = cddr(x))
+    {
+      s7_pointer symbol = car(x), value;
+      symbol = (is_symbol_and_keyword(symbol)) ? keyword_symbol(symbol) : cadr(symbol);  /* (inlet ':allow-other-keys 3) */
+      if (is_constant_symbol(sc, symbol))     /* (inlet 'pi 1) */
+	{
+	  unstack_gc_protect(sc);
+	  wrong_type_error_nr(sc, sc->inlet_symbol, 1, symbol, a_non_constant_symbol_string);
+	}
+      value = fx_call(sc, cdr(x));            /* it's necessary to do this first, before add_slot_unchecked */
+      if (!sp)
+	  sp = add_slot_unchecked_no_local_slot(sc, new_e, symbol, value);
+      else sp = add_slot_at_end_no_local(sc, sp, symbol, value);
+    }
+  id = ++sc->let_number;
+  let_set_id(new_e, id);
+  for (s7_pointer x = let_slots(new_e); tis_slot(x); x = next_slot(x))
+    symbol_set_local_slot_unincremented(slot_symbol(x), id, x);  /* was symbol_set_id(slot_symbol(x), id) */
+  unstack_gc_protect(sc);
+  return(new_e);
+}
+
+static s7_pointer fx_c_na(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer args, p, val = safe_list_if_possible(sc, opt3_arglen(cdr(arg)));
+  if (in_heap(val)) gc_protect_via_stack(sc, val);
+  for (args = cdr(arg), p = val; is_pair(args); args = cdr(args), p = cdr(p))
+    set_car(p, fx_call(sc, args));
+  p = fn_proc(arg)(sc, val);
+  if (in_heap(val)) unstack_gc_protect(sc);
+  else clear_list_in_use(val);
+  return(p);
+}
+
+static s7_pointer fx_vector_ns(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer args = cdr(arg);
+  s7_pointer vec = make_simple_vector(sc, opt3_arglen(cdr(arg)));
+  s7_pointer *els = (s7_pointer *)vector_elements(vec);
+  for (s7_int i = 0; is_pair(args); args = cdr(args), i++)
+    els[i] = lookup(sc, car(args));
+  return(vec);
+}
+
+static s7_pointer fx_vector_na(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer args = cdr(arg);
+  s7_pointer v = make_simple_vector(sc, opt3_arglen(cdr(arg))); /* was s7_make_vector */
+  s7_pointer *els = vector_elements(v);
+  gc_protect_via_stack(sc, v);
+  t_vector_fill(v, sc->nil); /* fx_calls below can trigger GC, so all elements of v must be legit */
+  for (s7_int i = 0; is_pair(args); args = cdr(args), i++)
+    els[i] = fx_call(sc, args);
+  sc->value = v; /* full-s7test 12262 list_p_p case */
+  unstack_gc_protect(sc);
+  return(v);
+}
+
+static s7_pointer fx_if_a_a(s7_scheme *sc, s7_pointer arg)
+{
+  return((is_true(sc, fx_call(sc, cdr(arg)))) ? fx_call(sc, opt1_pair(arg)) : sc->unspecified);
+}
+
+static s7_pointer fx_if_not_a_a(s7_scheme *sc, s7_pointer arg)
+{
+  return((is_false(sc, fx_call(sc, opt1_pair(arg)))) ? fx_call(sc, opt2_pair(arg)) : sc->unspecified);
+}
+
+static s7_pointer fx_if_a_a_a(s7_scheme *sc, s7_pointer arg)
+{
+  return((is_true(sc, fx_call(sc, cdr(arg)))) ? fx_call(sc, opt1_pair(arg)) : fx_call(sc, opt2_pair(arg)));
+}
+
+#define fx_if_s_a_a_any(Name, Lookup) \
+  static s7_pointer Name(s7_scheme *sc, s7_pointer arg) \
+  { \
+    return((Lookup(sc, cadr(arg), arg) != sc->F) ? fx_call(sc, opt1_pair(arg)) : fx_call(sc, opt2_pair(arg))); \
+  }
+
+fx_if_s_a_a_any(fx_if_s_a_a, s_lookup)
+fx_if_s_a_a_any(fx_if_o_a_a, o_lookup) /* diff s->o of ca 3 */
+
+
+static s7_pointer fx_if_and2_s_a(s7_scheme *sc, s7_pointer arg)
+{
+  return(((fx_call(sc, opt1_pair(arg)) == sc->F) || (fx_call(sc, opt2_pair(arg)) == sc->F)) ? fx_call(sc, cdddr(arg)) : lookup(sc, opt3_sym(arg)));
+}
+
+static s7_pointer fx_if_not_a_a_a(s7_scheme *sc, s7_pointer arg)
+{
+  return((is_false(sc, fx_call(sc, opt1_pair(arg)))) ? fx_call(sc, opt2_pair(arg)) : fx_call(sc, opt3_pair(arg)));
+}
+
+static s7_pointer fx_if_a_c_c(s7_scheme *sc, s7_pointer arg) {return((is_true(sc, fx_call(sc, cdr(arg)))) ? opt1_con(arg) : opt2_con(arg));}
+
+static s7_pointer fx_if_is_type_s_a_a(s7_scheme *sc, s7_pointer arg)
+{
+  if (gen_type_match(sc, lookup(sc, opt2_sym(cdr(arg))), opt3_byte(cdr(arg))))
+    return(fx_call(sc, cddr(arg)));
+  return(fx_call(sc, opt2_pair(arg))); /* cdddr(arg) */
+}
+
+static inline s7_pointer fx_and_2a(s7_scheme *sc, s7_pointer arg)   /* arg is the full expr: (and ...) */
+{
+  return((fx_call(sc, cdr(arg)) == sc->F) ? sc->F : fx_call(sc, cddr(arg)));
+}
+
+static inline s7_pointer fx_and_s_2(s7_scheme *sc, s7_pointer arg)
+{
+  set_car(sc->t1_1, lookup(sc, opt3_sym(cdr(arg))));  /* cadadr(arg) */
+  return((fn_proc(cadr(arg))(sc, sc->t1_1) == sc->F) ? sc->F : fn_proc(caddr(arg))(sc, sc->t1_1));
+}
+
+static s7_pointer fx_and_or_2a_vref(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer or1 = cadr(arg);
+  s7_pointer arg11 = cdadr(or1);
+  s7_pointer v = lookup(sc, cadar(arg11));
+  if ((is_t_vector(v)) && (vector_rank(v) == 1))
+    {
+      s7_pointer ip = lookup(sc, opt3_sym(or1));
+      s7_pointer jp = lookup(sc, opt1_sym(or1));
+      if ((is_t_integer(ip)) && (is_t_integer(jp)))
+	{
+	  s7_int i = integer(ip), j = integer(jp);
+	  if ((i >= 0) && (j >= 0) &&
+	      (i < vector_length(v)) && (j < vector_length(v)) &&
+	      (is_t_real(vector_element(v, i))) && (is_t_real(vector_element(v, j))))
+	    {
+	      s7_pointer xp = lookup(sc, cadr(arg11));
+	      if (is_t_real(xp))
+		{
+		  s7_double vi = real(vector_element(v, i)), vj = real(vector_element(v, j)), xf = real(xp);
+		  return(make_boolean(sc, ((vi > xf) || (xf >= vj)) && ((vj > xf) || (xf >= vi))));
+		}}}}
+  return(fx_and_2a(sc, arg));
+}
+
+static s7_pointer fx_len2_t(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer val = t_lookup(sc, opt1_sym(cdr(arg)), arg); /* isn't this unprotected from mock pair? */ /* opt1_sym == cadadr(arg) */
+  return(make_boolean(sc, is_pair(val) && (is_pair(cdr(val))) && (is_null(cddr(val)))));
+}
+
+static s7_pointer fx_len3_t(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer val = t_lookup(sc, opt1_sym(cdr(arg)), arg);
+  return(make_boolean(sc, is_pair(val) && (is_pair(cdr(val))) && (is_pair(cddr(val)))));
+}
+
+static s7_pointer fx_and_3a(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p = cdr(arg);
+  if (fx_call(sc, p) == sc->F) return(sc->F);
+  p = cdr(p);
+  return((fx_call(sc, p) == sc->F) ? sc->F : fx_call(sc, cdr(p)));
+}
+
+static s7_pointer fx_and_n(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer x = sc->T;
+  for (s7_pointer p = cdr(arg); (is_pair(p)) && (x != sc->F); p = cdr(p)) /* in lg, 5/6 args appears to predominate */
+    x = fx_call(sc, p);
+  return(x);
+}
+
+static s7_pointer fx_or_2a(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p = cdr(arg);
+  s7_pointer val = fx_call(sc, p);
+  return((val != sc->F) ? val : fx_call(sc, cdr(p)));
+}
+
+static s7_pointer fx_or_s_2(s7_scheme *sc, s7_pointer arg)
+{
+  /* the "s" is looked up once here -- not obvious how to use fx_call anyway */
+  s7_pointer x = fn_proc(cadr(arg))(sc, with_list_t1(lookup(sc, opt3_sym(cdr(arg))))); /* cadadr(arg) */
+  return((x != sc->F) ? x : fn_proc(caddr(arg))(sc, sc->t1_1));
+}
+
+static s7_pointer fx_or_s_type_2(s7_scheme *sc, s7_pointer arg)
+{
+  int32_t x = type(lookup(sc, opt3_sym(cdr(arg)))); /* cadadr(arg)) */
+  return(make_boolean(sc, (x == opt3_int(arg)) || (x == opt2_int(cdr(arg)))));
+}
+
+static s7_pointer fx_not_symbol_or_keyword(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer val = lookup(sc, opt3_sym(arg));
+  return(make_boolean(sc, (!is_symbol(val)) || (is_keyword(val))));
+}
+
+static s7_pointer fx_or_and_2a(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p = cdr(arg);
+  s7_pointer val = fx_call(sc, p);
+  if (val != sc->F) return(val);
+  p = opt3_pair(arg); /* cdadr(p) */
+  val = fx_call(sc, p);
+  return((val == sc->F) ? val : fx_call(sc, cdr(p)));
+}
+
+static s7_pointer fx_or_and_3a(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p = cdr(arg);
+  s7_pointer val = fx_call(sc, p);
+  if (val != sc->F) return(val);
+  p = opt3_pair(arg); /* cdadr(p) */
+  val = fx_call(sc, p);
+  if (val == sc->F) return(val);
+  p = cdr(p);
+  val = fx_call(sc, p);
+  return((val == sc->F) ? val : fx_call(sc, cdr(p)));
+}
+
+static s7_pointer fx_or_3a(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p = cdr(arg);
+  s7_pointer val = fx_call(sc, p);
+  if (val != sc->F) return(val);
+  p = cdr(p);
+  val = fx_call(sc, p);
+  return((val != sc->F) ? val : fx_call(sc, cdr(p)));
+}
+
+static s7_pointer fx_or_n(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer x = sc->F;
+  for (s7_pointer p = cdr(arg); (is_pair(p)) && (x == sc->F); p = cdr(p))
+    x = fx_call(sc, p);
+  return(x);
+}
+
+static s7_pointer fx_begin_aa(s7_scheme *sc, s7_pointer arg)
+{
+  fx_call(sc, cdr(arg));
+  return(fx_call(sc, cddr(arg)));
+}
+
+static s7_pointer fx_begin_na(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p;
+  for (p = cdr(arg); is_pair(cdr(p)); p = cdr(p))
+    fx_call(sc, p);
+  return(fx_call(sc, p));
+}
+
+static s7_pointer fx_safe_thunk_a(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer f = opt1_lambda(code), result;
+  gc_protect_via_stack(sc, sc->curlet); /* we do need to GC protect curlet here and below (not just remember it) */
+  set_curlet(sc, closure_let(f));
+  result = fx_call(sc, closure_body(f));
+  set_curlet(sc, gc_protected1(sc));
+  unstack_gc_protect(sc);
+  return(result);
+}
+
+static s7_pointer fx_safe_closure_s_a(s7_scheme *sc, s7_pointer code) /* also called from h_safe_closure_s_a in eval */
+{
+  s7_pointer result;
+  gc_protect_via_stack(sc, sc->curlet);
+  set_curlet(sc, update_let_with_slot(sc, closure_let(opt1_lambda(code)), lookup(sc, opt2_sym(code))));
+  result = fx_call(sc, closure_body(opt1_lambda(code)));
+  set_curlet(sc, gc_protected1(sc));
+  unstack_gc_protect(sc);
+  return(result);
+}
+
+static s7_pointer op_safe_closure_s_a(s7_scheme *sc, s7_pointer code) /* also called from h_safe_closure_s_a in eval */
+{
+  set_curlet(sc, update_let_with_slot(sc, closure_let(opt1_lambda(code)), lookup(sc, opt2_sym(code))));
+  return(fx_call(sc, closure_body(opt1_lambda(code))));
+}
+
+static s7_pointer fx_safe_closure_t_a(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer result;
+  gc_protect_via_stack(sc, sc->curlet);
+  set_curlet(sc, update_let_with_slot(sc, closure_let(opt1_lambda(code)), t_lookup(sc, opt2_sym(code), code)));
+  result = fx_call(sc, closure_body(opt1_lambda(code)));
+  set_curlet(sc, gc_protected1(sc));
+  unstack_gc_protect(sc);
+  return(result);
+}
+
+static s7_pointer fx_safe_closure_s_to_s(s7_scheme *sc, s7_pointer arg)
+{
+  return(fn_proc(car(closure_body(opt1_lambda(arg))))(sc, with_list_t1(lookup(sc, opt2_sym(arg)))));
+}
+
+static s7_pointer fx_safe_closure_s_to_sc(s7_scheme *sc, s7_pointer arg)
+{
+  set_car(sc->t2_2, opt3_con(cdr(arg)));
+  set_car(sc->t2_1, lookup(sc, opt2_sym(arg)));
+  return(fn_proc(car(closure_body(opt1_lambda(arg))))(sc, sc->t2_1));
+}
+
+static s7_pointer fx_safe_closure_s_to_vref(s7_scheme *sc, s7_pointer arg) {return(vector_ref_p_pp(sc, lookup(sc, opt2_sym(arg)), opt3_con(cdr(arg))));}
+static s7_pointer fx_safe_closure_s_to_sub1(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p = lookup(sc, opt2_sym(arg));
+  if ((!WITH_GMP) && (is_t_integer(p))) return(make_integer(sc, integer(p) - 1));
+  return(minus_c1(sc, p));
+}
+
+static s7_pointer fx_safe_closure_s_to_add1(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p = lookup(sc, opt2_sym(arg));
+  if ((!WITH_GMP) && (is_t_integer(p))) return(make_integer(sc, integer(p) + 1));
+  return(g_add_x1_1(sc, p, 1));
+}
+
+static s7_pointer fx_c_ff(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer p = cdr(arg);
+  s7_pointer x = fx_proc(cdar(p))(sc, car(p));
+  sc->value = x;
+  set_car(sc->t2_2, fx_proc(cdadr(p))(sc, cadr(p)));
+  set_car(sc->t2_1, x);
+  return(fn_proc(arg)(sc, sc->t2_1));
+}
+
+static s7_pointer fx_safe_closure_a_to_sc(s7_scheme *sc, s7_pointer arg)
+{
+  set_car(sc->t2_1, fx_call(sc, cdr(arg)));
+  set_car(sc->t2_2, opt3_con(cdr(arg)));
+  return(fn_proc(car(closure_body(opt1_lambda(arg))))(sc, sc->t2_1));
+}
+
+static s7_pointer fx_safe_closure_a_to_vref(s7_scheme *sc, s7_pointer arg) {return(vector_ref_p_pp(sc, fx_call(sc, cdr(arg)), opt3_con(cdr(arg))));}
+
+static s7_pointer fx_safe_closure_s_and_2a(s7_scheme *sc, s7_pointer code) /* safe_closure_s_a where "a" is fx_and_2a */
+{
+  s7_pointer result;
+  gc_protect_via_stack(sc, sc->curlet);
+  set_curlet(sc, update_let_with_slot(sc, closure_let(opt1_lambda(code)), lookup(sc, opt2_sym(code))));
+  code = cdar(closure_body(opt1_lambda(code)));
+  result = fx_call(sc, code);  /* have to unwind the stack so this can't return */
+  if (result != sc->F)
+    result = fx_call(sc, cdr(code));
+  set_curlet(sc, gc_protected1(sc));
+  unstack_gc_protect(sc);
+  return(result);
+}
+
+static s7_pointer fx_safe_closure_s_and_pair(s7_scheme *sc, s7_pointer code) /* safe_closure_s_a where "a" is fx_and_2a with is_pair as first clause */
+{
+  s7_pointer result;
+  gc_protect_via_stack(sc, sc->curlet);
+  set_curlet(sc, update_let_with_slot(sc, closure_let(opt1_lambda(code)), lookup(sc, opt2_sym(code))));
+  code = cdar(closure_body(opt1_lambda(code)));
+  result = (is_pair(t_lookup(sc, cadar(code), code))) ? fx_call(sc, cdr(code)) : sc->F;  /* pair? arg = func par, pair? is global, symbol_id=0 */
+  set_curlet(sc, gc_protected1(sc));
+  unstack_gc_protect(sc);
+  return(result);
+}
+
+static s7_pointer fx_safe_closure_a_a(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer result;
+  gc_protect_via_stack(sc, sc->curlet);
+  set_curlet(sc, update_let_with_slot(sc, closure_let(opt1_lambda(code)), fx_call(sc, cdr(code))));
+  result = fx_call(sc, closure_body(opt1_lambda(code)));
+  set_curlet(sc, gc_protected1(sc));
+  unstack_gc_protect(sc);
+  return(result);
+}
+
+static s7_pointer op_safe_closure_a_a(s7_scheme *sc, s7_pointer code)
+{
+  set_curlet(sc, update_let_with_slot(sc, closure_let(opt1_lambda(code)), fx_call(sc, cdr(code))));
+  return(fx_call(sc, closure_body(opt1_lambda(code))));
+}
+
+static s7_pointer fx_safe_closure_a_sqr(s7_scheme *sc, s7_pointer code) {return(fx_sqr_1(sc, fx_call(sc, cdr(code))));}
+static s7_pointer fx_safe_closure_s_sqr(s7_scheme *sc, s7_pointer code) {return(fx_sqr_1(sc, lookup(sc, opt2_sym(code))));}
+
+static s7_pointer fx_safe_closure_a_and_2a(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer and_arg = cdar(closure_body(opt1_lambda(code)));
+  s7_pointer result;
+  gc_protect_via_stack(sc, sc->curlet);
+  set_curlet(sc, update_let_with_slot(sc, closure_let(opt1_lambda(code)), fx_call(sc, cdr(code))));
+  result = fx_call(sc, and_arg);
+  if (result != sc->F) result = fx_call(sc, cdr(and_arg));
+  set_curlet(sc, gc_protected1(sc));
+  unstack_gc_protect(sc);
+  return(result);
+}
+
+static s7_pointer fx_safe_closure_ss_a(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer result;
+  gc_protect_via_stack(sc, sc->curlet);
+  set_curlet(sc, update_let_with_two_slots(sc, closure_let(opt1_lambda(code)), lookup(sc, cadr(code)), lookup(sc, opt2_sym(code))));
+  result = fx_call(sc, closure_body(opt1_lambda(code)));
+  set_curlet(sc, gc_protected1(sc));
+  unstack_gc_protect(sc);
+  return(result);
+}
+
+static s7_pointer op_safe_closure_ss_a(s7_scheme *sc, s7_pointer code)
+{
+  set_curlet(sc, update_let_with_two_slots(sc, closure_let(opt1_lambda(code)), lookup(sc, cadr(code)), lookup(sc, opt2_sym(code))));
+  return(fx_call(sc, closure_body(opt1_lambda(code))));
+}
+
+static s7_pointer fx_safe_closure_3s_a(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer result;
+  gc_protect_via_stack(sc, sc->curlet);
+  set_curlet(sc, update_let_with_three_slots(sc, closure_let(opt1_lambda(code)), lookup(sc, cadr(code)), lookup(sc, opt2_sym(code)), lookup(sc, opt3_sym(code))));
+  result = fx_call(sc, closure_body(opt1_lambda(code)));
+  set_curlet(sc, gc_protected1(sc));
+  unstack_gc_protect(sc);
+  return(result);
+}
+
+static s7_pointer op_safe_closure_3s_a(s7_scheme *sc, s7_pointer code)
+{
+  set_curlet(sc, update_let_with_three_slots(sc, closure_let(opt1_lambda(code)), lookup(sc, cadr(code)), lookup(sc, opt2_sym(code)), lookup(sc, opt3_sym(code))));
+  return(fx_call(sc, closure_body(opt1_lambda(code))));
+}
+
+static s7_pointer fx_safe_closure_aa_a(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer p = cdr(code);
+  s7_pointer f = opt1_lambda(code);
+  check_stack_size(sc); /* lint+s7test.scm can overflow here */
+  gc_protect_2_via_stack(sc, sc->curlet, fx_call(sc, cdr(p))); /* this is needed even if one of the args is a symbol */
+  set_curlet(sc, update_let_with_two_slots(sc, closure_let(f), fx_call(sc, p), gc_protected2(sc)));
+  p = fx_call(sc, closure_body(f));
+  set_curlet(sc, gc_protected1(sc));
+  unstack_gc_protect(sc);
+  return(p);
+}
+
+static inline s7_pointer fx_cond_na_na(s7_scheme *sc, s7_pointer code)  /* all tests are fxable, results are all fx, no =>, no missing results */
+{
+  for (s7_pointer p = cdr(code); is_pair(p); p = cdr(p))
+    if (is_true(sc, fx_call(sc, car(p))))
+      {
+	for (p = cdar(p); is_pair(cdr(p)); p = cdr(p))
+	  fx_call(sc, p);
+	return(fx_call(sc, p));
+      }
+  return(sc->unspecified);
+}
+
+static s7_pointer s7_starlet(s7_scheme *sc, s7_int choice);
+
+static s7_pointer fx_implicit_s7_starlet_ref_s(s7_scheme *sc, s7_pointer arg) {return(s7_starlet(sc, opt3_int(arg)));}
+static s7_pointer fx_implicit_s7_starlet_print_length(s7_scheme *sc, s7_pointer arg) {return(make_integer(sc, sc->print_length));}
+static s7_pointer fx_implicit_s7_starlet_safety(s7_scheme *sc, s7_pointer arg) {return(make_integer(sc, sc->safety));}
+
+static s7_function *fx_function = NULL;
+
+static bool is_fxable(s7_scheme *sc, s7_pointer p)
+{
+  if (!is_pair(p)) return(true);
+  if ((is_optimized(p)) &&  /* this is needed.  In check_tc, for example, is_fxable can be confused by early optimize_op  */
+      (fx_function[optimize_op(p)]))
+    return(true);
+  return(is_proper_quote(sc, p));
+}
+
+static int32_t fx_count(s7_scheme *sc, s7_pointer x)
+{
+  int32_t count = 0;
+  for (s7_pointer p = cdr(x); is_pair(p); p = cdr(p))
+    if (is_fxable(sc, car(p)))
+      count++;
+  return(count);
+}
+
+static bool is_code_constant(s7_scheme *sc, s7_pointer p) {return((is_pair(p)) ? (is_quote(car(p))) : (!is_normal_symbol(p)));}
+
+static inline s7_pointer check_quote(s7_scheme *sc, s7_pointer code);
+
+static s7_p_dd_t s7_p_dd_function(s7_pointer f);
+static s7_p_pi_t s7_p_pi_function(s7_pointer f);
+static s7_p_ii_t s7_p_ii_function(s7_pointer f);
+
+#define is_unchanged_global(P) ((is_symbol(P)) && (is_global(P)) && (initial_value(P) == global_value(P)))
+#define is_global_and_has_func(P, Func) ((is_unchanged_global(P)) && (Func(global_value(P)))) /* Func = s7_p_pp_function and friends */
+
+static bool fx_matches(s7_pointer symbol, const s7_pointer target_symbol) {return((symbol == target_symbol) && (is_unchanged_global(symbol)));}
+
+typedef bool (safe_sym_t)(s7_scheme *sc, s7_pointer sym, s7_pointer e);
+
+/* #define fx_choose(Sc, Holder, E, Checker) fx_choose_1(Sc, Holder, E, Checker, __func__, __LINE__) */
+static s7_function fx_choose(s7_scheme *sc, s7_pointer holder, s7_pointer cur_env, safe_sym_t *checker) /* , const char *func, int32_t line) */
+{
+  s7_pointer arg = car(holder);
+  if (!is_pair(arg))
+    {
+      if (is_symbol(arg))
+	{
+	  if (is_keyword(arg)) return(fx_c);
+	  if (arg == sc->else_symbol)
+	    {
+	      if (is_let(cur_env)) {if (s7_symbol_local_value(sc, arg, cur_env) == sc->else_symbol) return(fx_c);}
+	      else if ((is_pair(cur_env)) && (!direct_memq(arg, cur_env))) return(fx_c);
+	    }
+	  return((is_global(arg)) ? fx_g : ((checker(sc, arg, cur_env)) ? fx_s : fx_unsafe_s));
+	}
+      return(fx_c);
+    }
+  if (is_optimized(arg))
+    {
+      switch (optimize_op(arg))
+	{
+	case HOP_SAFE_C_NC: /* includes 0-arg cases, newline/current-input|output-port, [make-]hash-table?, read-line, [float-]vector/list, gensym */
+	  if (cdr(arg) == sc->nil) return((fn_proc(arg) == g_read_char) ? fx_read_char_0 : fx_c_0c);
+#if (!WITH_GMP)
+	  if (fn_proc(arg) == g_add_i_random) return(fx_add_i_random);
+#endif
+	  return((fn_proc(arg) == g_random_i) ? fx_random_i : ((fn_proc(arg) == g_cons) ? fx_cons_cc : fx_c_nc));
+
+	case OP_OR_2A:
+	  if (fx_proc(cddr(arg)) == fx_and_2a) {set_opt3_pair(arg, cdaddr(arg)); return(fx_or_and_2a);}
+	  if (fx_proc(cddr(arg)) == fx_and_3a) {set_opt3_pair(arg, cdaddr(arg)); return(fx_or_and_3a);}
+	  if ((fx_proc(cdr(arg)) == fx_not_is_symbol_s) && (fx_proc(cddr(arg)) == fx_is_keyword_s) && (cadr(cadadr(arg)) == cadaddr(arg)))
+	    {
+	      /* (or (not (symbol? body)) (keyword? body)) */
+	      set_opt3_sym(arg, cadaddr(arg));
+	      return(fx_not_symbol_or_keyword);
+	    }
+	  return(fx_or_2a);
+
+	case OP_AND_2A:
+	  if ((fx_proc(cdr(arg)) == fx_or_2a) && (fx_proc(cddr(arg)) == fx_or_2a))
+	    {
+	      s7_pointer o1 = cadr(arg), o2 = caddr(arg);
+	      if ((fx_proc(cdr(o1)) == fx_gt_vref_s) &&
+		  (fx_proc(cddr(o1)) == fx_geq_s_vref) &&
+		  (fx_proc(cdr(o2)) == fx_gt_vref_s) &&
+		  (fx_proc(cddr(o2)) == fx_geq_s_vref))
+		{
+		  s7_pointer v = cadr(cadadr(o1));
+		  if ((v == cadr(cadadr(o2))) && (v == (cadr(caddaddr(o1)))) && (v == (cadr(caddaddr(o2)))))
+		    {
+		      s7_pointer x = caddadr(o1);
+		      if ((x == caddadr(o2)) && (x == cadaddr(o1)) && (x == cadaddr(o2)))
+			{
+			  s7_pointer i = caddr(cadadr(o1)), j = caddaddr(caddr(o1));
+			  if ((j == caddr(cadadr(o2))) && (i == caddaddr(caddr(o2))))
+			    {
+			      set_opt1_sym(o1, j);
+			      set_opt3_sym(o1, i);
+			      return(fx_and_or_2a_vref);
+			    }}}}}
+	  return(fx_and_2a);
+
+	case HOP_SAFE_C_S:
+	  if (is_unchanged_global(car(arg))) /* mus-copy would work here but in tgen (for example) it's loading generators.scm with local mus-copy methods */
+	    {
+	      uint8_t typ;
+	      if (car(arg) == sc->cdr_symbol)            return(fx_cdr_s);
+	      if (car(arg) == sc->car_symbol)            return(fx_car_s);
+	      if (car(arg) == sc->cadr_symbol)           return(fx_cadr_s);
+	      if (car(arg) == sc->cddr_symbol)           return(fx_cddr_s);
+	      if (car(arg) == sc->is_null_symbol)        return(fx_is_null_s);
+	      if (car(arg) == sc->is_pair_symbol)        return(fx_is_pair_s);
+	      if (car(arg) == sc->is_symbol_symbol)      return(fx_is_symbol_s);
+	      if (car(arg) == sc->is_eof_object_symbol)  return(fx_is_eof_s);
+	      if (car(arg) == sc->is_integer_symbol)     return(fx_is_integer_s);
+	      if (car(arg) == sc->is_string_symbol)      return(fx_is_string_s);
+	      if (car(arg) == sc->not_symbol)            return(fx_not_s);
+	      if (car(arg) == sc->is_proper_list_symbol) return(fx_is_proper_list_s);
+	      if (car(arg) == sc->is_vector_symbol)      return(fx_is_vector_s);
+	      if (car(arg) == sc->is_keyword_symbol)     return(fx_is_keyword_s);
+	      if (car(arg) == sc->is_procedure_symbol)   return(fx_is_procedure_s);
+	      if (car(arg) == sc->length_symbol)         return(fx_length_s);
+	      /* not read_char here... */
+	      typ = symbol_type(car(arg));
+	      if (typ > 0)
+		{
+		  set_opt3_byte(cdr(arg), typ);
+		  return(fx_is_type_s);
+		}
+	      /* car_p_p (et al) does not look for a method so in:
+	       *    (define kar car) (load "mockery.scm") (let ((p (mock-pair '(1 2 3)))) (call-with-exit (lambda (x) (x (kar p)))))
+	       *  "kar" fails but not "car" because symbol_id(kar) == 0!  symbol_id(car) > 0 because mockery provides a method for it.
+	       */
+	      if (symbol_id(c_function_name_to_symbol(sc, global_value(car(arg)))) == 0)
+		{
+		  s7_p_p_t f = s7_p_p_function(global_value(car(arg)));
+		  if (f)
+		    {
+		      set_opt2_direct(cdr(arg), (s7_pointer)f);
+		      if (f == real_part_p_p) return(fx_real_part_s);
+		      if (f == imag_part_p_p) return(fx_imag_part_s);
+		      if (f == iterate_p_p)   return(fx_iterate_s);
+		      if (f == car_p_p)       return(fx_car_s); /* can happen if (define var-name car) etc */
+		      return((is_global(cadr(arg))) ? fx_c_g_direct : fx_c_s_direct);
+		    }}}
+	  return((is_global(cadr(arg))) ? fx_c_g : fx_c_s);
+
+	case HOP_SAFE_C_SS:
+	  if (fn_proc(arg) == g_cons)       return(fx_cons_ss);
+	  if (fx_matches(car(arg), sc->num_eq_symbol)) return(fx_num_eq_ss);
+	  if (fn_proc(arg) == g_geq_2)      return(fx_geq_ss);
+	  if (fn_proc(arg) == g_greater_2)  return(fx_gt_ss);
+	  if (fn_proc(arg) == g_leq_2)      return(fx_leq_ss);
+	  if (fn_proc(arg) == g_less_2)     return((is_global(caddr(arg))) ? fx_lt_sg : fx_lt_ss);
+	  if ((fx_matches(car(arg), sc->multiply_symbol)) && (cadr(arg) == caddr(arg))) return(fx_sqr_s);
+	  if (fn_proc(arg) == g_multiply_2) return(fx_multiply_ss);
+	  if (fn_proc(arg) == g_is_eq)      return(fx_is_eq_ss);
+	  if (fn_proc(arg) == g_add_2)      return(fx_add_ss);
+	  if (fn_proc(arg) == g_subtract_2) return(fx_subtract_ss);
+	  if (fn_proc(arg) == g_hash_table_ref_2) return(fx_hash_table_ref_ss);
+
+	  if (is_global_and_has_func(car(arg), s7_p_pp_function))
+	    {
+	      if (car(arg) == sc->assq_symbol) return(fx_assq_ss);
+	      if (car(arg) == sc->memq_symbol) return(fx_memq_ss);
+	      if (car(arg) == sc->vector_ref_symbol) return(fx_vref_ss);
+	      if (car(arg) == sc->string_ref_symbol) return(fx_sref_ss);
+	      set_opt3_direct(cdr(arg), (s7_pointer)(s7_p_pp_function(global_value(car(arg)))));
+	      return(fx_c_ss_direct);
+	    }
+	  /* fx_c_ss_direct via b_7pp is slower than fx_c_ss + g_<> */
+	  return(fx_c_ss);
+
+        case HOP_SAFE_C_NS:
+	  if (fn_proc(arg) == g_list) return(fx_list_ns);    /* it is no faster here to divide out the big list cases!? */
+	  return((fn_proc(arg) == g_vector) ? fx_vector_ns : fx_c_ns);
+
+	case HOP_SAFE_C_opSq_S:
+	  if ((is_global_and_has_func(car(arg), s7_p_pp_function)) &&
+	      (is_global_and_has_func(caadr(arg), s7_p_p_function)))
+	    {
+	      set_opt2_direct(cdr(arg), (s7_pointer)(s7_p_pp_function(global_value(car(arg)))));
+	      set_opt3_direct(cdr(arg), (s7_pointer)(s7_p_p_function(global_value(caadr(arg)))));
+	      return(((car(arg) == sc->cons_symbol) && (caadr(arg) == sc->car_symbol)) ? fx_cons_car_s_s : fx_c_opsq_s_direct);
+	    }
+	  return(fx_c_opsq_s);
+
+	case HOP_SAFE_C_SSS:
+	  if ((fn_proc(arg) == g_less) && (is_global(cadr(arg))) && (is_global(cadddr(arg)))) return(fx_lt_gsg);
+	  if (is_global_and_has_func(car(arg), s7_p_ppp_function))
+	    {
+	      set_opt3_direct(cdr(arg), (s7_pointer)(s7_p_ppp_function(global_value(car(arg)))));
+	      return(fx_c_sss_direct);
+	    }
+	  return(fx_c_sss);
+
+	case HOP_SAFE_C_SSA:
+	  if (is_global_and_has_func(car(arg), s7_p_ppp_function))
+	    {
+	      set_opt2_direct(cdr(arg), (s7_pointer)(s7_p_ppp_function(global_value(car(arg)))));
+	      return(fx_c_ssa_direct);
+	    }
+	  return(fx_c_ssa);
+
+	case HOP_SAFE_C_SCS:
+	  if (is_global_and_has_func(car(arg), s7_p_ppp_function))
+	    {
+	      set_opt3_direct(cdr(arg), (s7_pointer)(s7_p_ppp_function(global_value(car(arg)))));
+	      return(fx_c_scs_direct);
+	    }
+	  return(fx_c_scs);
+
+	case HOP_SAFE_C_AAA:
+	  if ((fx_proc(cdr(arg)) == fx_g) && (fx_proc(cdddr(arg)) == fx_c)) return(fx_c_gac);
+	  if ((is_unquoted_pair(cadr(arg))) || (is_unquoted_pair(caddr(arg))) || (is_unquoted_pair(cadddr(arg)))) return(fx_c_aaa);
+	  return(fx_c_3g);
+
+	case HOP_SAFE_C_4A:
+	  set_opt3_pair(arg, cdddr(arg));
+	  for (s7_pointer p = cdr(arg); is_pair(p); p = cdr(p))
+	    if (is_unquoted_pair(car(p)))
+	      return(fx_c_4a);
+	  return(fx_c_4g); /* fx_c_ssaa doesn't save much */
+
+	case HOP_SAFE_C_S_opSSq:
+	  {
+	    s7_pointer s2 = caddr(arg);
+	    if ((fx_matches(car(s2), sc->multiply_symbol)) && (cadr(s2) == caddr(s2))) return(fx_c_s_sqr);
+
+	    if ((is_global_and_has_func(car(arg), s7_p_pp_function)) &&
+		(is_global_and_has_func(car(s2), s7_p_pp_function)))
+	      {
+		set_opt2_direct(cdr(arg), (s7_pointer)(s7_p_pp_function(global_value(car(arg)))));
+		set_opt3_direct(cdr(arg), (s7_pointer)(s7_p_pp_function(global_value(car(s2)))));
+		set_opt3_pair(arg, cdr(s2));
+		if (car(s2) == sc->vector_ref_symbol)
+		  {
+		    if (car(arg) == sc->add_symbol)      return(fx_add_s_vref);
+		    if (car(arg) == sc->subtract_symbol) return(fx_subtract_s_vref);
+		    if (car(arg) == sc->multiply_symbol) return(fx_multiply_s_vref);
+		    if (car(arg) == sc->geq_symbol)      return(fx_geq_s_vref);
+		    if (car(arg) == sc->is_eq_symbol)    return(fx_is_eq_s_vref);
+		    if (car(arg) == sc->hash_table_ref_symbol) return(fx_href_s_vref);
+		    if (car(arg) == sc->let_ref_symbol)  return(fx_lref_s_vref);
+		    if ((is_global(cadr(arg))) && (is_global(cadr(s2))) && (car(arg) == sc->vector_ref_symbol)) return(fx_vref_g_vref_gs);
+		  }
+		if ((car(arg) == sc->vector_ref_symbol) && (car(s2) == sc->add_symbol)) return(fx_vref_s_add);
+		return(fx_c_s_opssq_direct);
+	      }
+	    return(fx_c_s_opssq);
+	  }
+
+	case HOP_SAFE_C_opSSq_S:
+	  if ((is_global_and_has_func(car(arg), s7_p_pp_function)) &&
+	      (is_global_and_has_func(caadr(arg), s7_p_pp_function)))
+	    {
+	      /* op_c_opgsq_t */
+	      set_opt2_direct(cdr(arg), (s7_pointer)(s7_p_pp_function(global_value(car(arg)))));
+	      set_opt3_direct(cdr(arg), (s7_pointer)(s7_p_pp_function(global_value(caadr(arg)))));
+	      set_opt3_pair(arg, cdadr(arg));
+	      if (caadr(arg) == sc->vector_ref_symbol)
+		{
+		  if (car(arg) == sc->subtract_symbol) return(fx_subtract_vref_s);
+		  if (car(arg) == sc->gt_symbol) return(fx_gt_vref_s);
+		  if (car(arg) == sc->vector_ref_symbol) return(fx_vref_vref_ss_s);
+		  if (car(arg) == sc->add_symbol) return(fx_add_vref_s);
+		}
+	      if (car(arg) == sc->add_symbol)
+		{
+		  if ((caadr(arg) == sc->multiply_symbol) && (cadadr(arg) == caddadr(arg))) return(fx_add_sqr_s);
+		  if (caadr(arg) == sc->subtract_symbol) return(fx_add_sub_s);
+		}
+	      if ((car(arg) == sc->cons_symbol) && (caadr(arg) == sc->cons_symbol)) return(fx_cons_cons_s);
+	      /* also div(sub)[2] mul(div) */
+	      return(((car(arg) == sc->gt_symbol) && (caadr(arg) == sc->add_symbol)) ? fx_gt_add_s :
+		     (((car(arg) == sc->add_symbol) && (caadr(arg) == sc->multiply_symbol)) ? fx_add_mul_opssq_s : fx_c_opssq_s_direct));
+	    }
+	  return(fx_c_opssq_s);
+
+	case HOP_SAFE_C_opSSq_opSSq:
+	  {
+	    s7_pointer s1 = cadr(arg), s2 = caddr(arg);
+	    set_opt3_pair(arg, cdr(s2));
+	    if ((fx_matches(car(s1), sc->multiply_symbol)) && (car(s2) == sc->multiply_symbol))
+	      {
+		set_opt1_pair(cdr(arg), cdr(s1));
+		if (car(arg) == sc->subtract_symbol) return(fx_sub_mul_mul);
+		if (car(arg) == sc->add_symbol)
+		  return(((cadr(s1) == caddr(s1)) && (cadr(s2) == caddr(s2))) ? fx_add_sqr_sqr : fx_add_mul_mul);
+	      }
+	    if ((fx_matches(car(s1), sc->subtract_symbol)) && (car(s2) == sc->subtract_symbol))
+	      {
+		set_opt1_pair(cdr(arg), cdr(s1));
+		if (car(arg) == sc->multiply_symbol) return(fx_mul_sub_sub);
+		if (car(arg) == sc->lt_symbol) return(fx_lt_sub2);
+	      }
+	    if ((fx_matches(car(arg), sc->subtract_symbol)) &&
+		(fx_matches(car(s1), sc->vector_ref_symbol)) &&
+		(car(s2) == sc->vector_ref_symbol) &&
+		(cadr(s1) == cadr(s2)))
+	      {
+		set_opt3_sym(arg, cadr(cdaddr(arg)));
+		return(fx_sub_vref2);
+	      }
+	    return(fx_c_opssq_opssq);
+	  }
+
+	case HOP_SAFE_C_opSq:
+	  if (is_unchanged_global(caadr(arg)))
+	    {
+	      if (fx_matches(car(arg), sc->is_pair_symbol))
+		{
+		  if (caadr(arg) == sc->car_symbol)  {set_opt3_sym(arg, cadadr(arg)); return(fx_is_pair_car_s);} /* (pair? ...) is ok, so loc can be sym? 7 in lg */
+		  if (caadr(arg) == sc->cdr_symbol)  {set_opt3_sym(arg, cadadr(arg)); return(fx_is_pair_cdr_s);}
+		  if (caadr(arg) == sc->cadr_symbol) {set_opt3_sym(arg, cadadr(arg)); return(fx_is_pair_cadr_s);}
+		  if (caadr(arg) == sc->cddr_symbol) {set_opt3_sym(arg, cadadr(arg)); return(fx_is_pair_cddr_s);}
+		}
+	      if (fx_matches(car(arg), sc->is_null_symbol))
+		{
+		  if (caadr(arg) == sc->cdr_symbol)  {set_opt3_sym(arg, cadadr(arg)); return(fx_is_null_cdr_s);}
+		  if (caadr(arg) == sc->cadr_symbol) {set_opt3_sym(arg, cadadr(arg)); return(fx_is_null_cadr_s);}
+		  if (caadr(arg) == sc->cddr_symbol) {set_opt3_sym(arg, cadadr(arg)); return(fx_is_null_cddr_s);}
+		}
+	      if ((fx_matches(car(arg), sc->is_symbol_symbol)) &&
+		  (caadr(arg) == sc->cadr_symbol))
+		{set_opt3_sym(arg, cadadr(arg)); return(fx_is_symbol_cadr_s);}
+
+	      if (fx_matches(car(arg), sc->not_symbol))
+		{
+		  if (caadr(arg) == sc->is_pair_symbol)   {set_opt3_sym(arg, cadadr(arg)); return(fx_not_is_pair_s);}
+		  if (caadr(arg) == sc->is_null_symbol)   {set_opt3_sym(arg, cadadr(arg)); return(fx_not_is_null_s);}
+		  if (caadr(arg) == sc->is_symbol_symbol) {set_opt3_sym(arg, cadadr(arg)); return(fx_not_is_symbol_s);}
+		  return(fx_not_opsq);
+		}
+	      if ((fx_matches(car(arg), sc->floor_symbol)) && (caadr(arg) == sc->sqrt_symbol))
+		{set_opt3_sym(arg, cadadr(arg)); return(fx_floor_sqrt_s);}
+	    }
+	  if (is_unchanged_global(car(arg))) /* (? (op arg)) where (op arg) might return a let with a ? method etc */
+	    {                                /* other possibility: fx_c_a */
+	      uint8_t typ = symbol_type(car(arg));
+	      if (typ > 0)                   /* h_safe_c here so the type checker isn't shadowed */
+		{
+		  set_opt3_sym(arg, cadadr(arg));
+		  set_opt3_byte(cdr(arg), typ);
+		  if (fn_proc(cadr(arg)) == (s7_function)g_c_pointer_weak1)
+		    return(fx_eq_weak1_type_s);
+		  return(fx_matches(caadr(arg), sc->car_symbol) ? fx_is_type_car_s : fx_is_type_opsq);
+		}}
+	  /* this should follow the is_type* check above */
+	  if (fx_matches(caadr(arg), sc->car_symbol))
+	    {
+	      set_opt3_sym(arg, cadadr(arg));
+	      return(fx_c_car_s);
+	    }
+	  if (fx_matches(caadr(arg), sc->cdr_symbol))
+	    {
+	      set_opt3_sym(arg, cadadr(arg));
+	      return(fx_c_cdr_s);
+	    }
+	  return(fx_c_opsq);
+
+	case HOP_SAFE_C_SC:
+	  if (is_unchanged_global(car(arg)))
+	    {
+	      if (car(arg) == sc->add_symbol)
+		{
+		  if (is_t_real(caddr(arg))) return(fx_add_sf);
+		  if (is_t_integer(caddr(arg))) return((integer(caddr(arg)) == 1) ? fx_add_s1 : fx_add_si);
+		}
+	      if (car(arg) == sc->subtract_symbol)
+		{
+		  if (is_t_real(caddr(arg))) return(fx_subtract_sf);
+		  if (is_t_integer(caddr(arg))) return((integer(caddr(arg)) == 1) ? fx_subtract_s1 : fx_subtract_si);
+		}
+	      if (car(arg) == sc->multiply_symbol)
+		{
+		  if (is_t_real(caddr(arg))) return(fx_multiply_sf);
+		  if (is_t_integer(caddr(arg))) return(fx_multiply_si);
+		}
+	      if ((fn_proc(arg) == g_memq_2) && (is_pair(caddr(arg)))) return(fx_memq_sq_2);
+	      if ((fn_proc(arg) == g_is_eq) && (!is_unspecified(caddr(arg)))) return(fx_is_eq_sc);
+
+	      if ((is_t_integer(caddr(arg))) && (s7_p_pi_function(global_value(car(arg)))))
+		{
+		  if (car(arg) == sc->num_eq_symbol) return((integer(caddr(arg)) == 0) ? fx_num_eq_s0 : fx_num_eq_si);
+		  if (car(arg) == sc->lt_symbol)  return(fx_lt_si);
+		  if (car(arg) == sc->leq_symbol) return(fx_leq_si);
+		  if (car(arg) == sc->gt_symbol)  return(fx_gt_si);
+		  if (car(arg) == sc->geq_symbol) return(fx_geq_si);
+		  set_opt3_direct(cdr(arg), (s7_pointer)(s7_p_pi_function(global_value(car(arg)))));
+		  return(fx_c_si_direct);
+		}
+	      if ((is_t_real(caddr(arg))) && (real(caddr(arg)) == 0.0) && (car(arg) == sc->num_eq_symbol)) return(fx_num_eq_s0f);
+	      if ((s7_p_pp_function(global_value(car(arg)))) && (fn_proc(arg) != g_divide_by_2))
+		{
+		  if (car(arg) == sc->memq_symbol)
+		    {
+		      if ((is_pair(caddr(arg))) && (is_proper_list_3(sc, cadaddr(arg)))) return(fx_memq_sc_3);
+		      return(fx_memq_sc);
+		    }
+		  if ((car(arg) == sc->char_eq_symbol) && (is_character(caddr(arg)))) return(fx_char_eq_sc); /* maybe fx_char_eq_newline */
+		  if (car(arg) == sc->lt_symbol)  return(fx_lt_sc); /* integer case handled above */
+		  if (car(arg) == sc->leq_symbol) return(fx_leq_sc);
+		  if (car(arg) == sc->gt_symbol)  return(fx_gt_sc);
+		  if (car(arg) == sc->geq_symbol) return(fx_geq_sc);
+		  if (car(arg) == sc->list_symbol) return(fx_list_sc);
+		  set_opt3_direct(cdr(arg), (s7_pointer)(s7_p_pp_function(global_value(car(arg)))));
+		  return(fx_c_sc_direct);
+		}}
+	  return(fx_c_sc);
+
+	case HOP_SAFE_C_CS:
+	  if (is_unchanged_global(car(arg)))
+	    {
+	      if (car(arg) == sc->cons_symbol) return(fx_cons_cs);
+	      if ((car(arg) == sc->add_symbol) && (is_t_real(cadr(arg)))) return(fx_add_fs);
+	      if ((car(arg) == sc->subtract_symbol) && (is_t_real(cadr(arg)))) return(fx_subtract_fs);
+	      if ((car(arg) == sc->num_eq_symbol) && (cadr(arg) == int_zero))
+		{
+		  set_opt3_sym(arg, caddr(arg)); /* opt3_location is in use, but the num_eq is ok, so only symbol might care about that info? (or use cdr(arg)) */
+		  return(fx_num_eq_0s);
+		}
+	      if (car(arg) == sc->multiply_symbol)
+		{
+		  if (is_t_real(cadr(arg))) return(fx_multiply_fs);
+		  if (is_t_integer(cadr(arg))) return(fx_multiply_is);
+		}}
+	  return(fx_c_cs);
+
+	case HOP_SAFE_C_S_opSq:
+	  if (fx_matches(car(caddr(arg)), sc->car_symbol))
+	    {
+	      set_opt2_sym(cdr(arg), cadaddr(arg));
+	      if (fx_matches(car(arg), sc->hash_table_ref_symbol)) return(fx_hash_table_ref_car);
+	      return(fx_matches(car(arg), sc->add_symbol) ? fx_add_s_car_s : fx_c_s_car_s);
+	    }
+	  if ((is_global_and_has_func(car(arg), s7_p_pp_function)) &&
+	      (is_global_and_has_func(caaddr(arg), s7_p_p_function)))
+	    {
+	      if ((car(arg) == sc->cons_symbol) && (caaddr(arg) == sc->cdr_symbol)) {set_opt2_sym(cdr(arg), cadaddr(arg)); return(fx_cons_s_cdr_s);}
+	      set_opt1_sym(cdr(arg), cadaddr(arg));
+	      set_opt2_direct(cdr(arg), (s7_pointer)(s7_p_pp_function(global_value(car(arg)))));
+	      set_opt3_direct(cdr(arg), (s7_pointer)(s7_p_p_function(global_value(caaddr(arg))))); /* arg opt3 only location, but no change in callgrind */
+	      return(fx_c_s_opsq_direct);
+	    }
+	  return(fx_c_s_opsq);
+
+	case HOP_SAFE_C_C_opSq:
+	  if (is_global_and_has_func(car(arg), s7_p_pp_function))
+	    {
+	      s7_pointer arg2 = caddr(arg);
+	      if (is_global_and_has_func(car(arg2), s7_p_p_function))
+		{
+		  set_opt2_direct(cdr(arg), (s7_pointer)(s7_p_pp_function(global_value(car(arg)))));
+		  set_opt3_direct(cdr(arg), (s7_pointer)(s7_p_p_function(global_value(car(arg2)))));
+		  set_opt1_sym(cdr(arg), cadr(arg2));
+		  return(fx_c_c_opsq_direct);
+		}}
+	  return(fx_c_c_opsq);
+
+	case HOP_SAFE_C_opSq_C:
+	  if (is_unchanged_global(car(arg)))
+	    {
+	      if ((car(arg) == sc->memq_symbol) &&
+		  (fx_matches(caadr(arg), sc->car_symbol)) &&
+		  (is_proper_quote(sc, caddr(arg))) &&
+		  (is_pair(cadaddr(arg))))
+		return((s7_list_length(sc, opt2_con(cdr(arg))) == 2) ? fx_memq_car_s_2 : fx_memq_car_s);
+
+	      if (car(arg) == sc->is_eq_symbol)
+		{
+		  if (((fx_matches(caadr(arg), sc->car_symbol)) || (fx_matches(caadr(arg), sc->caar_symbol))) &&
+		      (is_proper_quote(sc, caddr(arg))))
+		    {
+		      set_opt3_sym(cdr(arg), cadadr(arg));
+		      set_opt2_con(cdr(arg), cadaddr(arg));
+		      return((caadr(arg) == sc->car_symbol) ? fx_is_eq_car_sq : fx_is_eq_caar_sq);
+		    }}
+	      if (((car(arg) == sc->lt_symbol) || (car(arg) == sc->num_eq_symbol)) &&
+		  (is_t_integer(caddr(arg))) &&
+		  (fx_matches(caadr(arg), sc->length_symbol)))
+		{
+		  set_opt3_sym(cdr(arg), cadadr(arg));
+		  set_opt3_con(arg, caddr(arg));
+		  return((car(arg) == sc->lt_symbol) ? fx_less_length_i : fx_num_eq_length_i);
+		}}
+	  set_opt1_sym(cdr(arg), cadadr(arg));
+	  return(fx_c_opsq_c);
+
+	case HOP_SAFE_C_op_opSqq:
+	  return((fx_matches(car(arg), sc->not_symbol)) ? ((fn_proc(cadr(arg)) == g_is_pair) ? fx_not_is_pair_opsq : fx_not_op_opsqq) : fx_c_op_opsqq);
+
+	case HOP_SAFE_C_opSCq:
+	  if (fx_matches(car(arg), sc->not_symbol))
+	    {
+	      if (fn_proc(cadr(arg)) == g_is_eq)
+		{
+		  set_opt3_sym(arg, cadadr(arg));
+		  set_opt3_con(cdr(arg), (is_pair(caddadr(arg))) ? cadaddr(cadr(arg)) : caddadr(arg));
+		  return(fx_not_is_eq_sq);
+		}
+	      return(fx_not_opscq);
+	    }
+	  return(fx_c_opscq);
+
+	case HOP_SAFE_C_S_opSCq:
+	  if (is_global_and_has_func(car(arg), s7_p_pp_function))
+	    {
+	      s7_pointer arg2 = caddr(arg);
+	      if ((is_global_and_has_func(car(arg2), s7_p_pi_function)) &&
+		  (is_t_integer(caddr(arg2))))
+		{
+		  set_opt2_direct(cdr(arg), (s7_pointer)(s7_p_pp_function(global_value(car(arg)))));
+		  set_opt3_direct(cdr(arg), (s7_pointer)(s7_p_pi_function(global_value(car(arg2)))));
+		  set_opt3_sym(arg, cadr(arg2));
+		  set_opt1_con(cdr(arg), caddr(arg2));
+		  if (car(arg) == sc->num_eq_symbol)
+		    {
+		      if (car(arg2) == sc->add_symbol) return(fx_num_eq_add_s_si);
+		      if (car(arg2) == sc->subtract_symbol) return(fx_num_eq_subtract_s_si);
+		    }
+		  if ((car(arg) == sc->vector_ref_symbol) && (car(arg2) == sc->add_symbol) && (integer(caddr(arg2)) == 1))
+		    return(fx_vref_p1);
+		  return(fx_c_s_opsiq_direct);
+		}
+	      if (is_global_and_has_func(car(arg2), s7_p_pp_function))
+		{
+		  set_opt2_direct(cdr(arg), (s7_pointer)(s7_p_pp_function(global_value(car(arg)))));
+		  set_opt3_direct(cdr(arg), (s7_pointer)(s7_p_pp_function(global_value(car(arg2)))));
+		  set_opt3_sym(arg, cadr(arg2));
+		  set_opt1_con(cdr(arg), (is_pair(caddr(arg2))) ? cadaddr(arg2) : caddr(arg2));
+		  return(fx_c_s_opscq_direct);
+		}}
+	  return(fx_c_s_opscq);
+
+	case HOP_SAFE_C_opSSq:
+	  if (fx_matches(car(arg), sc->not_symbol))
+	    {
+	      if (fn_proc(cadr(arg)) == g_is_eq) return(fx_not_is_eq_ss);
+	      return(fx_not_opssq);
+	    }
+	  if ((is_global_and_has_func(car(arg), s7_p_p_function)) &&
+	      (is_global_and_has_func(caadr(arg), s7_p_pp_function)))
+	    {
+	      set_opt2_direct(cdr(arg), (s7_pointer)(s7_p_p_function(global_value(car(arg)))));
+	      set_opt3_direct(cdr(arg), (s7_pointer)(s7_p_pp_function(global_value(caadr(arg)))));
+	      return(fx_c_opssq_direct);
+	    }
+	  return(fx_c_opssq);
+
+	case HOP_SAFE_C_C_opSSq:
+	  {
+	    s7_pointer s2 = caddr(arg);
+	    if ((fx_matches(car(s2), sc->multiply_symbol)) && (cadr(s2) == caddr(s2)))
+	      return(fx_c_c_sqr);
+	  }
+	  if ((is_small_real(cadr(arg))) &&
+	      (is_global_and_has_func(car(arg), s7_p_dd_function)) &&
+	      (is_global_and_has_func(caaddr(arg), s7_d_pd_function))) /* not * currently (this is for clm) */
+	    {
+	      set_opt3_direct(cdr(arg), s7_d_pd_function(global_value(caaddr(arg))));
+	      set_opt2_direct(cdr(arg), s7_p_dd_function(global_value(car(arg))));
+	      set_opt3_sym(arg, cadaddr(arg));
+	      set_opt1_sym(cdr(arg), caddaddr(arg));
+	      return(fx_c_nc_opssq_direct);
+	    }
+	  if ((is_global_and_has_func(car(arg), s7_p_pp_function)) &&
+	      (is_global_and_has_func(caaddr(arg), s7_p_pp_function)))
+	    {
+	      set_opt2_direct(cdr(arg), (s7_pointer)(s7_p_pp_function(global_value(car(arg)))));
+	      set_opt3_direct(cdr(arg), (s7_pointer)(s7_p_pp_function(global_value(caaddr(arg)))));
+	      set_opt3_sym(arg, cadaddr(arg));
+	      set_opt1_sym(cdr(arg), caddaddr(arg));
+	      if ((is_t_real(cadr(arg))) && (car(arg) == caaddr(arg)) && (car(arg) == sc->multiply_symbol)) return(fx_multiply_c_opssq);
+	      return(fx_c_c_opssq_direct);
+	    }
+	  return(fx_c_c_opssq);
+
+	case HOP_SAFE_C_opSq_opSq:
+	  if ((is_global_and_has_func(car(arg), s7_p_pp_function)) &&
+	      (is_global_and_has_func(caadr(arg), s7_p_p_function)) &&
+	      (is_global_and_has_func(caaddr(arg), s7_p_p_function)))
+	    {
+	      set_opt3_direct(arg, (s7_pointer)(s7_p_pp_function(global_value(car(arg)))));
+	      set_opt2_direct(cdr(arg), (s7_pointer)(s7_p_p_function(global_value(caadr(arg)))));
+	      set_opt3_direct(cdr(arg), (s7_pointer)(s7_p_p_function(global_value(caaddr(arg)))));
+	      if ((caadr(arg) == caaddr(arg)) && ((caadr(arg) == sc->cdr_symbol) || (caadr(arg) == sc->car_symbol)))
+		{
+		  set_opt1_sym(cdr(arg), cadadr(arg));
+		  set_opt2_sym(cdr(arg), cadaddr(arg)); /* usable because we know func is cdr|car */
+		  return((caadr(arg) == sc->cdr_symbol) ? fx_cdr_s_cdr_s : fx_car_s_car_s);
+		}
+	      set_opt1_sym(cdr(arg), cadaddr(arg)); /* opt2 is taken by second func */
+	      return(fx_c_opsq_opsq_direct);
+	    }
+	  return(fx_c_opsq_opsq);
+
+	case HOP_SAFE_C_op_S_opSqq:
+	  return((fx_matches(car(arg), sc->not_symbol)) ? fx_not_op_s_opsqq : fx_c_op_s_opsqq);
+
+	case HOP_SAFE_C_op_opSSqq_S:
+	  if ((is_global_and_has_func(car(arg), s7_p_pp_function)) &&
+	      (is_global_and_has_func(caadr(arg), s7_p_p_function)) &&
+	      (is_global_and_has_func(car(cadadr(arg)), s7_p_pp_function)))
+	    {
+	      set_opt3_direct(arg, (s7_pointer)(s7_p_pp_function(global_value(car(arg)))));
+	      set_opt2_direct(cdr(arg), (s7_pointer)(s7_p_p_function(global_value(caadr(arg)))));
+	      set_opt3_direct(cdr(arg), (s7_pointer)(s7_p_pp_function(global_value(caadr(cadr(arg))))));
+	      return(fx_c_op_opssqq_s_direct);
+	    }
+	  return(fx_c_op_opssqq_s);
+
+	case HOP_SAFE_C_A:
+	  if (fx_matches(car(arg), sc->not_symbol))
+	    {
+	      if (fx_proc(cdr(arg)) == fx_is_eq_car_sq)
+		{
+		  set_opt1_sym(cdr(arg), cadadr(cadr(arg)));
+		  set_opt3_con(cdr(arg), cadaddr(cadr(arg)));
+		  return(fx_not_is_eq_car_sq);
+		}
+	      return(fx_not_a);
+	    }
+	  if (is_global_and_has_func(car(arg), s7_p_p_function))
+	    {
+	      set_opt3_direct(arg, (s7_pointer)(s7_p_p_function(global_value(car(arg)))));
+	      return(fx_c_a_direct);
+	    }
+	  return(fx_c_a);
+
+	case HOP_SAFE_C_AC:
+	  if (fn_proc(arg) == g_cons) return(fx_cons_ac);
+	  if (fx_matches(car(arg), sc->is_eq_symbol)) return(fx_is_eq_ac);
+	  if (is_global_and_has_func(car(arg), s7_p_pp_function))
+	    {
+	      set_opt3_direct(cdr(arg), (s7_pointer)(s7_p_pp_function(global_value(car(arg)))));
+	      if ((opt3_direct(cdr(arg)) == (s7_pointer)string_ref_p_pp) && (is_t_integer(caddr(arg))) && (integer(caddr(arg)) == 0))
+		set_opt3_direct(cdr(arg), string_ref_p_p0);
+	      if (opt3_direct(cdr(arg)) == (s7_pointer)memq_p_pp)
+		{
+		  if (fn_proc(arg) == g_memq_2)
+		    set_opt3_direct(cdr(arg), (s7_pointer)memq_2_p_pp);
+		  else
+		    if ((is_pair(caddr(arg))) && (is_proper_list_3(sc, cadaddr(arg))))
+		      set_opt3_direct(cdr(arg), memq_3_p_pp);
+		    else
+		      if (fn_proc(arg) == g_memq_4)
+			set_opt3_direct(cdr(arg), memq_4_p_pp); /* this does not parallel 2 and 3 above (sigh) */
+		}
+	      else
+		if ((is_t_real(opt3_con(arg))) && (opt3_direct(cdr(arg)) == (s7_pointer)lt_p_pp))
+		  return(fx_lt_ad);
+	      if ((is_t_integer(opt3_con(arg))) && (s7_p_pi_function(global_value(car(arg)))))
+		{
+		  set_opt3_direct(cdr(arg), (s7_pointer)(s7_p_pi_function(global_value(car(arg)))));
+		  if (integer(opt3_con(arg)) == 1)
+		    {
+		      if (opt3_direct(cdr(arg)) == (s7_pointer)g_sub_xi)
+			return(fx_sub_a1);
+		      if (opt3_direct(cdr(arg)) == (s7_pointer)add_p_pi)
+			return(fx_add_a1);
+		    }
+		  return(fx_c_ai_direct);
+		}
+	      return(fx_c_ac_direct);
+	    }
+	  return(fx_c_ac);
+
+	case HOP_SAFE_C_CA:
+	  return((fn_proc(arg) == g_cons) ? fx_cons_ca : fx_c_ca);
+
+	case HOP_SAFE_C_SA:
+	  if (fn_proc(arg) == g_multiply_2) return(fx_multiply_sa);
+	  if (fn_proc(arg) == g_add_2) return(fx_add_sa);
+	  if (is_global_and_has_func(car(arg), s7_p_pp_function))
+	    {
+	      set_opt3_direct(cdr(arg), (s7_pointer)(s7_p_pp_function(global_value(car(arg)))));
+	      return((fn_proc(arg) == g_cons) ? fx_cons_sa : fx_c_sa_direct);
+	    }
+	  return(fx_c_sa);
+
+	case HOP_SAFE_C_AS:
+	  if (fn_proc(arg) == g_add_2) return(fx_add_as);
+	  if (is_global_and_has_func(car(arg), s7_p_pp_function))
+	    {
+	      set_opt3_direct(cdr(arg), (s7_pointer)(s7_p_pp_function(global_value(car(arg)))));
+	      return((fn_proc(arg) == g_cons) ? fx_cons_as : fx_c_as_direct);
+	    }
+	  return(fx_c_as);
+
+	case HOP_SAFE_C_AA:  /* (* wr (float-vector-ref rl 0 j)) (* wr (block-ref (vector-ref rl j) 0)) (- (float-vector-ref rl 0 i) tempr)  */
+	  if (fn_proc(arg) == g_add_2)            return(fx_add_aa);
+	  if (fn_proc(arg) == g_subtract_2)       return(fx_subtract_aa);
+	  if (fn_proc(arg) == g_multiply_2)       return(fx_multiply_aa);
+	  if (fn_proc(arg) == g_number_to_string) return(fx_number_to_string_aa);
+	  if (fn_proc(arg) == g_cons)             return(fx_cons_aa);
+	  return(fx_c_aa);
+
+	case HOP_SAFE_C_opAAq:
+	  return((fx_proc(cdadr(arg)) == fx_s) ? fx_c_opsaq : fx_c_opaaq);
+
+	case HOP_SAFE_C_NA:
+	  return((fn_proc(arg) == g_vector) ? fx_vector_na : fx_c_na);
+
+	case HOP_SAFE_C_ALL_CA:
+	  return((fn_proc(arg) == g_simple_inlet) ? fx_inlet_ca : fx_c_all_ca);
+
+	case HOP_SAFE_CLOSURE_S_A:
+	  {
+	    s7_pointer body = car(closure_body(opt1_lambda(arg)));
+	    if (is_pair(body))
+	      {
+		if (optimize_op(body) == OP_AND_2A)
+		  {
+		    if ((fx_matches(caadr(body), sc->is_pair_symbol)) &&
+			(cadadr(body) == car(closure_args(opt1_lambda(arg)))))
+		      return(fx_safe_closure_s_and_pair);       /* lint arg: (len>1? init), args: (x) body: (and (pair? x) (pair? (cdr x))) */
+		    return(fx_safe_closure_s_and_2a);
+		  }
+		if (optimize_op(body) == HOP_SAFE_C_opSq_C)
+		  {
+		    if ((fn_proc(body) == g_simple_let_ref) &&
+			(cadadr(body) == car(closure_args(opt1_lambda(arg)))))
+		      {
+			set_opt2_sym(cdr(arg), cadaddr(body));
+			return(fx_simple_let_ref_s); /* (var-ref local-var) -> (let-ref (cdr v=local_var) 'ref) */
+		      }}}
+	    return((fx_proc(closure_body(opt1_lambda(arg))) == fx_sqr_t) ? fx_safe_closure_s_sqr : fx_safe_closure_s_a);
+	  }
+
+	case HOP_SAFE_CLOSURE_S_TO_SC:
+	  {
+	    s7_pointer body = car(closure_body(opt1_lambda(arg)));
+	    if (fn_proc(body) == g_vector_ref_2) return(fx_safe_closure_s_to_vref);
+	    if ((is_t_integer(caddr(body))) && (integer(caddr(body)) == 1))
+	      {
+		if (car(body) == sc->subtract_symbol) return(fx_safe_closure_s_to_sub1);
+		if (car(body) == sc->add_symbol) return(fx_safe_closure_s_to_add1);
+	      }
+	    return(fx_safe_closure_s_to_sc);
+	  }
+
+	case HOP_SAFE_CLOSURE_A_TO_SC:
+	  return((fn_proc(car(closure_body(opt1_lambda(arg)))) == g_vector_ref_2) ? fx_safe_closure_a_to_vref : fx_safe_closure_a_to_sc);
+
+	case HOP_SAFE_CLOSURE_A_A:
+	  if (fx_proc(closure_body(opt1_lambda(arg))) == fx_and_2a)
+	    return(fx_safe_closure_a_and_2a);
+	  return((fx_proc(closure_body(opt1_lambda(arg))) == fx_sqr_t) ? fx_safe_closure_a_sqr : fx_safe_closure_a_a);
+
+	case HOP_SAFE_CLOSURE_3S_A:
+	  if (fx_proc(closure_body(opt1_lambda(arg))) == fx_vref_vref_tu_v) return(fx_vref_vref_3_no_let);
+	  return(fx_function[optimize_op(arg)]);
+
+	case OP_IMPLICIT_S7_STARLET_REF_S:
+	  if (opt3_int(arg) == SL_PRINT_LENGTH) return(fx_implicit_s7_starlet_print_length);
+	  if (opt3_int(arg) == SL_SAFETY) return(fx_implicit_s7_starlet_safety);
+	  return(fx_implicit_s7_starlet_ref_s);
+
+	case HOP_C:
+	  if ((is_unchanged_global(car(arg))) && (car(arg) == sc->curlet_symbol)) return(fx_curlet);
+	  /* fall through */
+
+	default:
+	  /* if ((S7_DEBUGGING) && (!fx_function[optimize_op(arg)]) && (is_h_optimized(arg))) fprintf(stderr, "fx_choose %s %s\n", op_names[optimize_op(arg)], display(arg)); */
+	  /* this includes unsafe c funcs (hop_c_a) and p-arg safe funcs (hop_safe_c_p) -- name needs "safe" and no "p" */
+	  return(fx_function[optimize_op(arg)]);
+	}} /* is_optimized */
+
+  if (is_safe_quote(car(arg)))
+    {
+      check_quote(sc, arg);
+      return(fx_q);
+    }
+  return(NULL);
+}
+
+#if S7_DEBUGGING
+#define with_fx(P, F) with_fx_1(sc, P, F)
+static bool with_fx_1(s7_scheme *sc, s7_pointer p, s7_function f) /* sc needed for set_opt2 under debugger = set_opt2_1(sc,...) */
+#else
+static bool with_fx(s7_pointer p, s7_function f)
+#endif
+{
+  set_fx_direct(p, f);
+  return(true);
+}
+
+static bool o_var_ok(const s7_pointer p, const s7_pointer var1, const s7_pointer var2, const s7_pointer var3) {return((p != var1) && (p != var2) && (p != var3));}
+
+static bool fx_tree_out(s7_scheme *sc, s7_pointer tree, const s7_pointer var1, const s7_pointer var2, const s7_pointer var3, bool unused_more_vars)
+{
+  s7_pointer p = car(tree);
+  if (is_symbol(p))
+    {
+      if ((fx_proc(tree) == fx_s) || (fx_proc(tree) == fx_o))
+	{
+	  if (p == var1) return(with_fx(tree, fx_T));
+	  if (p == var2) return(with_fx(tree, fx_U));
+	  if (p == var3) return(with_fx(tree, fx_V));
+	}
+      return(false);
+    }
+  if ((is_pair(p)) && (is_pair(cdr(p))))
+    {
+      if (cadr(p) == var1)
+	{
+	  if ((fx_proc(tree) == fx_c_s) || (fx_proc(tree) == fx_c_o)) return(with_fx(tree, fx_c_T)); /* fx_c_T_direct got no hits */
+	  if ((fx_proc(tree) == fx_car_s) || (fx_proc(tree) == fx_car_o)) return(with_fx(tree, fx_car_T));
+	  if ((fx_proc(tree) == fx_cdr_s) || (fx_proc(tree) == fx_cdr_o)) return(with_fx(tree, fx_cdr_T));
+	  if (fx_proc(tree) == fx_is_null_s)   return(with_fx(tree, fx_is_null_T));
+	  if (fx_proc(tree) == fx_iterate_o)   return(with_fx(tree, fx_iterate_T));
+	  if (fx_proc(tree) == fx_subtract_s1) return(with_fx(tree, fx_subtract_T1));
+	  if (fx_proc(tree) == fx_add_s1)      return(with_fx(tree, fx_add_T1));
+	  if (fx_proc(tree) == fx_c_sca)       return(with_fx(tree, fx_c_Tca));
+	  if ((fx_proc(tree) == fx_num_eq_si) || (fx_proc(tree) == fx_num_eq_s0) || (fx_proc(tree) == fx_num_eq_oi)) return(with_fx(tree, fx_num_eq_Ti));
+	  /* if (fx_proc(tree) == fx_cons_ss)     return(with_fx(tree, fx_cons_Ts)); */ /* can be fooled -- there is no fx_cons_us etc -- need fx_cons_os */
+	  /* if (fx_proc(tree) == fx_multiply_ss) return(with_fx(tree, fx_multiply_Ts)); */ /* this also can be fooled? */
+	  if ((fx_proc(tree) == fx_c_scs_direct) && (cadddr(p) == var2)) return(with_fx(tree, fx_c_TcU_direct));
+	  if ((fx_proc(tree) == fx_hash_table_ref_ss) && (var3 == caddr(p))) return(with_fx(tree, fx_hash_table_ref_TV));
+	  if ((fx_proc(tree) == fx_geq_ss) && (var2 == caddr(p))) return(with_fx(tree, fx_geq_TU));
+	}
+      else
+	if (cadr(p) == var2)
+	  {
+	    if (fx_proc(tree) == fx_subtract_s1) return(with_fx(tree, fx_subtract_U1));
+	    if (fx_proc(tree) == fx_add_s1) return(with_fx(tree, fx_add_U1));
+	    if ((fx_proc(tree) == fx_car_s) || (fx_proc(tree) == fx_car_o)) return(with_fx(tree, fx_car_U));
+	    if ((fx_proc(tree) == fx_cdr_s) || (fx_proc(tree) == fx_cdr_o)) return(with_fx(tree, fx_cdr_U));
+	  }
+	else
+	  if (cadr(p) == var3)
+	    {
+	      if ((fx_proc(tree) == fx_c_s) || (fx_proc(tree) == fx_c_o)) return(with_fx(tree, fx_c_V));
+	      if (fx_proc(tree) == fx_add_s1) return(with_fx(tree, fx_add_V1));
+	    }
+	  else
+	    if (is_pair(cddr(p)))
+	      {
+		if (caddr(p) == var1)
+		  {
+		    if ((fx_proc(tree) == fx_num_eq_ts) || (fx_proc(tree) == fx_num_eq_to)) return(with_fx(tree, fx_num_eq_tT));
+		    if ((fx_proc(tree) == fx_gt_ts) || (fx_proc(tree) == fx_gt_to)) return(with_fx(tree, fx_gt_tT));
+		    if (fx_proc(tree) == fx_lt_ts) return(with_fx(tree, fx_lt_tT));
+		    if ((fx_proc(tree) == fx_geq_ts) || (fx_proc(tree) == fx_geq_to)) return(with_fx(tree, fx_geq_tT));
+		  }
+		else
+		  if (caddr(p) == var2)
+		    {
+		      if (fx_proc(tree) == fx_c_ts)        return(with_fx(tree, fx_c_tU));
+		      if (fx_proc(tree) == fx_cons_ts)     return(with_fx(tree, fx_cons_tU));
+		      if (fx_proc(tree) == fx_c_ts_direct) return(with_fx(tree, fx_c_tU_direct));
+		      if (fx_proc(tree) == fx_lt_ts)       return(with_fx(tree, fx_lt_tU));
+		      if (fx_proc(tree) == fx_num_eq_us)   return(with_fx(tree, fx_num_eq_uU));
+		      if (fx_proc(tree) == fx_num_eq_vs)   return(with_fx(tree, fx_num_eq_vU));
+		    }
+		  else
+		    if ((fx_proc(tree) == fx_add_sqr_s) && (cadadr(p) == var1)) return(with_fx(tree, fx_add_sqr_T));
+	      }}
+  return(false);
+}
+
+static void fx_tree_outer(s7_scheme *sc, s7_pointer tree, s7_pointer var1, s7_pointer var2, s7_pointer var3, bool more_vars)
+{
+  if ((!is_pair(tree)) ||
+      ((is_symbol(car(tree))) && (is_definer_or_binder(car(tree)))) ||
+      (is_syntax(car(tree))))
+    return;
+  if ((!has_fx(tree)) ||
+      (!fx_tree_out(sc, tree, var1, var2, var3, more_vars)))
+    fx_tree_outer(sc, car(tree), var1, var2, var3, more_vars);
+  fx_tree_outer(sc, cdr(tree), var1, var2, var3, more_vars);
+}
+
+static bool fx_tree_in(s7_scheme *sc, s7_pointer tree, s7_pointer var1, s7_pointer var2, s7_pointer var3, bool more_vars)
+{
+  s7_pointer p = car(tree);
+  if (is_symbol(p))
+    {
+      if (fx_proc(tree) == fx_s)
+	{
+	  if (p == var1) return(with_fx(tree, fx_t));
+	  if (p == var2) return(with_fx(tree, fx_u));
+	  if (p == var3) return(with_fx(tree, fx_v));
+	  if (is_global(p)) return(with_fx(tree, fx_g));
+	  if (!more_vars) return(with_fx(tree, fx_o));
+	}
+      return(false);
+    }
+  if ((!is_pair(p)) || (is_fx_treed(tree)) || (!has_fx(tree))) return(false);
+  set_fx_treed(tree);
+  switch (optimize_op(p))
+    {
+    case HOP_SAFE_C_S:
+      if (cadr(p) == var1)
+	{
+	  if (fx_proc(tree) == fx_c_s)         return(with_fx(tree, fx_c_t));
+	  if (fx_proc(tree) == fx_c_s_direct)  return(with_fx(tree, (opt2_direct(cdr(p)) == (s7_pointer)cddr_p_p) ? fx_cddr_t : fx_c_t_direct));
+	  if (fx_proc(tree) == fx_car_s)       return(with_fx(tree, fx_car_t));
+	  if (fx_proc(tree) == fx_cdr_s)       return(with_fx(tree, fx_cdr_t));
+	  if (fx_proc(tree) == fx_cddr_s)      return(with_fx(tree, fx_cddr_t));
+	  if (fx_proc(tree) == fx_cadr_s)      return(with_fx(tree, fx_cadr_t));
+	  if (fx_proc(tree) == fx_not_s)       return(with_fx(tree, fx_not_t));
+	  if (fx_proc(tree) == fx_is_null_s)   return(with_fx(tree, fx_is_null_t));
+	  if (fx_proc(tree) == fx_is_pair_s)   return(with_fx(tree, fx_is_pair_t));
+	  if (fx_proc(tree) == fx_is_symbol_s) return(with_fx(tree, fx_is_symbol_t));
+	  if (fx_proc(tree) == fx_is_eof_s)    return(with_fx(tree, fx_is_eof_t));
+	  if (fx_proc(tree) == fx_is_string_s) return(with_fx(tree, fx_is_string_t));
+	  if (fx_proc(tree) == fx_is_vector_s) return(with_fx(tree, fx_is_vector_t));
+	  if (fx_proc(tree) == fx_is_integer_s) return(with_fx(tree, fx_is_integer_t));
+	  if (fx_proc(tree) == fx_is_procedure_s) return(with_fx(tree, fx_is_procedure_t));
+	  if (fx_proc(tree) == fx_is_type_s)   return(with_fx(tree, fx_is_type_t));
+	  if (fx_proc(tree) == fx_length_s)    return(with_fx(tree, fx_length_t));
+	  if (fx_proc(tree) == fx_real_part_s) return(with_fx(tree, fx_real_part_t));
+	  if (fx_proc(tree) == fx_imag_part_s) return(with_fx(tree, fx_imag_part_t));
+	  return(false);
+	}
+      if (cadr(p) == var2)
+	{
+	  if (fx_proc(tree) == fx_c_s)
+	    {
+	      if (is_global_and_has_func(car(p), s7_p_p_function))
+		{
+		  set_opt2_direct(cdr(p), (s7_pointer)(s7_p_p_function(global_value(car(p)))));
+		  return(with_fx(tree, (car(p) == sc->cddr_symbol) ? fx_cddr_u :
+				     ((car(p) == sc->is_positive_symbol) ? fx_is_positive_u :
+				      ((car(p) == sc->is_zero_symbol) ? fx_is_zero_u : fx_c_u_direct))));
+		}
+	      return(with_fx(tree, fx_c_u));
+	    }
+	  if (fx_proc(tree) == fx_c_s_direct)
+	    return(with_fx(tree, (car(p) == sc->cddr_symbol) ? fx_cddr_u :
+			       ((car(p) == sc->is_positive_symbol) ? fx_is_positive_u :
+				((car(p) == sc->is_zero_symbol) ? fx_is_zero_u : fx_c_u_direct))));
+
+	  if (fx_proc(tree) == fx_cdr_s)       return(with_fx(tree, fx_cdr_u));
+	  if (fx_proc(tree) == fx_cadr_s)      return(with_fx(tree, fx_cadr_u));
+	  if (fx_proc(tree) == fx_cddr_s)      return(with_fx(tree, fx_cddr_u));
+	  if (fx_proc(tree) == fx_car_s)       return(with_fx(tree, fx_car_u));
+	  if (fx_proc(tree) == fx_is_null_s)   return(with_fx(tree, fx_is_null_u));
+	  if (fx_proc(tree) == fx_is_type_s)   return(with_fx(tree, fx_is_type_u));
+	  if (fx_proc(tree) == fx_is_pair_s)   return(with_fx(tree, fx_is_pair_u));
+	  if (fx_proc(tree) == fx_is_symbol_s) return(with_fx(tree, fx_is_symbol_u));
+	  if (fx_proc(tree) == fx_is_eof_s)    return(with_fx(tree, fx_is_eof_u));
+	  return(false);
+	}
+      if (cadr(p) == var3)
+	{
+	  if (fx_proc(tree) == fx_cdr_s)      return(with_fx(tree, fx_cdr_v));
+	  if (fx_proc(tree) == fx_is_null_s)  return(with_fx(tree, fx_is_null_v));
+	  if (fx_proc(tree) == fx_is_pair_s)  return(with_fx(tree, fx_is_pair_v));
+	  if (fx_proc(tree) == fx_c_s)        return(with_fx(tree, fx_c_v));
+	  if (fx_proc(tree) == fx_c_s_direct) return(with_fx(tree, fx_c_v_direct));
+	  return(false);
+	}
+      if (!more_vars)
+	{
+	  if (fx_proc(tree) == fx_is_null_s)  return(with_fx(tree, fx_is_null_o));
+	  if (fx_proc(tree) == fx_car_s)      return(with_fx(tree, fx_car_o));
+	  if (fx_proc(tree) == fx_cdr_s)      return(with_fx(tree, fx_cdr_o));
+	  if (fx_proc(tree) == fx_cadr_s)     return(with_fx(tree, fx_cadr_o));
+	  if (fx_proc(tree) == fx_cddr_s)     return(with_fx(tree, fx_cddr_o));
+	  if (fx_proc(tree) == fx_iterate_s)  return(with_fx(tree, fx_iterate_o));
+	  if (fx_proc(tree) == fx_not_s)      return(with_fx(tree, fx_not_o));
+	  if (fx_proc(tree) == fx_c_s_direct) return(with_fx(tree, fx_c_o_direct));
+	  if (fx_proc(tree) == fx_c_s)        return(with_fx(tree, fx_c_o));
+	}
+      break;
+
+    case HOP_SAFE_C_SC:
+      if (cadr(p) == var1)
+	{
+	  if ((fx_proc(tree) == fx_char_eq_sc) || (fn_proc(p) == g_char_equal_2)) return(with_fx(tree, fx_char_eq_tc));
+	  if (fx_proc(tree) == fx_c_sc)   return(with_fx(tree, fx_c_tc));
+	  if (fx_proc(tree) == fx_add_sf) return(with_fx(tree, fx_add_tf));
+	  if (fn_proc(p) == g_less_xf)    return(with_fx(tree, fx_lt_tf));
+	  if (fn_proc(p) == g_less_x0)    return(with_fx(tree, fx_lt_t0));
+	  if (fn_proc(p) == g_less_xi)
+	    return(with_fx(tree, (integer(caddr(p)) == 2) ? fx_lt_t2 : ((integer(caddr(p)) == 1) ? fx_lt_t1 : fx_lt_ti)));
+	  if (fn_proc(p) == g_geq_xf)     return(with_fx(tree, fx_geq_tf));
+	  if (fn_proc(p) == g_geq_xi)     return(with_fx(tree, (integer(caddr(p)) == 0) ? fx_geq_t0 : fx_geq_ti));
+	  if (fn_proc(p) == g_leq_xi)     return(with_fx(tree, fx_leq_ti));
+	  if (fn_proc(p) == g_greater_xi) return(with_fx(tree, fx_gt_ti));
+	  if (fx_proc(tree) == fx_leq_si) return(with_fx(tree, fx_leq_ti));
+	  if (fx_proc(tree) == fx_gt_si)  return(with_fx(tree, fx_gt_ti));
+
+	  if (fx_proc(tree) == fx_c_sc_direct) /* p_pp cases */
+	    {
+	      if ((opt3_direct(cdr(p)) == (s7_pointer)vector_ref_p_pp) && (is_t_integer(caddr(p))))
+		return(with_fx(tree, fx_vector_ref_tc));
+	      if ((opt3_direct(cdr(p)) == (s7_pointer)string_ref_p_pp) && (is_t_integer(caddr(p))) && (integer(caddr(p)) == 0))
+		set_opt3_direct(cdr(p), string_ref_p_p0);
+	      return(with_fx(tree, fx_c_tc_direct));
+	    }
+	  if (fx_proc(tree) == fx_c_si_direct) /* p_pi cases */
+	    {
+	      if (opt3_direct(cdr(p)) == (s7_pointer)vector_ref_p_pi)
+		return(with_fx(tree, fx_vector_ref_tc));
+	      if ((opt3_direct(cdr(p)) == (s7_pointer)string_ref_p_pi) && (integer(caddr(p)) == 0))
+		set_opt3_direct(cdr(p), string_ref_p_p0);
+	      return(with_fx(tree, (opt3_direct(cdr(p)) == (s7_pointer)remainder_p_pi) ? fx_c_ti_remainder : fx_c_ti_direct));
+	    }
+
+	  if (fx_proc(tree) == fx_is_eq_sc)    return(with_fx(tree, fx_is_eq_tc));
+	  if (fx_proc(tree) == fx_add_s1)      return(with_fx(tree, fx_add_t1));
+	  if (fx_proc(tree) == fx_add_si)      return(with_fx(tree, fx_add_ti));
+	  if (fx_proc(tree) == fx_subtract_s1) return(with_fx(tree, fx_subtract_t1));
+	  if (fx_proc(tree) == fx_subtract_si) return(with_fx(tree, fx_subtract_ti));
+	  if (fx_proc(tree) == fx_subtract_sf) return(with_fx(tree, fx_subtract_tf));
+	  if (fx_proc(tree) == fx_multiply_sf) return(with_fx(tree, fx_multiply_tf));
+	  if (fx_proc(tree) == fx_multiply_si) return(with_fx(tree, fx_multiply_ti));
+	  if (fx_proc(tree) == fx_lt_si) /* is this ever hit? */
+	    return(with_fx(tree, (integer(caddr(p)) == 2) ? fx_lt_t2 : ((integer(caddr(p)) == 1) ? fx_lt_t1 : fx_lt_ti)));
+	  if (fx_proc(tree) == fx_num_eq_si)   return(with_fx(tree, fx_num_eq_ti));
+	  if (fx_proc(tree) == fx_num_eq_s0)   return(with_fx(tree, fx_num_eq_t0));
+	  if (fx_proc(tree) == fx_memq_sc)     return(with_fx(tree, fx_memq_tc));
+	  return(false);
+	}
+      if (cadr(p) == var2)
+	{
+	  if (fx_proc(tree) == fx_c_sc)        return(with_fx(tree, fx_c_uc));
+	  if (fx_proc(tree) == fx_num_eq_s0)   return(with_fx(tree, fx_num_eq_u0));
+	  if (fx_proc(tree) == fx_num_eq_si)   return(with_fx(tree, fx_num_eq_ui));
+	  if (fx_proc(tree) == fx_add_s1)      return(with_fx(tree, fx_add_u1));
+	  if (fx_proc(tree) == fx_subtract_s1) return(with_fx(tree, fx_subtract_u1));
+	  if (fx_proc(tree) == fx_subtract_si) return(with_fx(tree, fx_subtract_ui));
+	  if (fx_proc(tree) == fx_multiply_si) return(with_fx(tree, fx_multiply_ui));
+	  if (fx_proc(tree) == fx_is_eq_sc)    return(with_fx(tree, fx_is_eq_uc));
+	  if (fx_proc(tree) == fx_leq_si)      return(with_fx(tree, fx_leq_ui));
+	  if (fx_proc(tree) == fx_gt_si)       return(with_fx(tree, fx_gt_ui));
+	  return(false);
+	}
+      if (cadr(p) == var3)
+	{
+	  if (fx_proc(tree) == fx_num_eq_s0)   return(with_fx(tree, fx_num_eq_v0));
+	  if (fx_proc(tree) == fx_num_eq_si)   return(with_fx(tree, fx_num_eq_vi));
+	  if (fx_proc(tree) == fx_add_s1)      return(with_fx(tree, fx_add_v1));
+	  if (fx_proc(tree) == fx_subtract_s1) return(with_fx(tree, fx_subtract_v1));
+	  if (fx_proc(tree) == fx_leq_si)      return(with_fx(tree, fx_leq_vi));
+	  if (fx_proc(tree) == fx_c_sc)        return(with_fx(tree, fx_c_vc));
+	  return(false);
+	}
+      if (!more_vars)
+	{
+	  if (fx_proc(tree) == fx_num_eq_si) return(with_fx(tree, fx_num_eq_oi));
+	  if ((fx_proc(tree) == fx_c_sc) && (o_var_ok(cadr(p), var1, var2, var3))) return(with_fx(tree, fx_c_oc));
+	}
+      break;
+
+    case HOP_SAFE_C_CS:
+      if (caddr(p) == var1)
+	{
+	  if ((car(p) == sc->cons_symbol) && (is_unchanged_global(sc->cons_symbol))) return(with_fx(tree, fx_cons_ct));
+	  if (fx_proc(tree) == fx_multiply_is) return(with_fx(tree, fx_multiply_it));
+	  if (fx_proc(tree) == fx_add_fs) return(with_fx(tree, fx_add_ft));
+	  if (fx_proc(tree) == fx_c_cs)
+	    {
+	      if (is_global_and_has_func(car(p), s7_p_pp_function))
+		{
+		  if (fn_proc(p) == g_tree_set_memq_syms)
+		    set_opt3_direct(cdr(p), (s7_pointer)tree_set_memq_syms_direct);
+		  else set_opt3_direct(cdr(p), (s7_pointer)(s7_p_pp_function(global_value(car(p)))));
+		  set_fx_direct(tree, fx_c_ct_direct);
+		}
+	      else set_fx_direct(tree, fx_c_ct);
+	      return(true);
+	    }}
+      if ((caddr(p) == var2) && (fx_proc(tree) == fx_c_cs)) return(with_fx(tree, fx_c_cu));
+      break;
+
+    case HOP_SAFE_C_SS:
+      if (cadr(p) == var1)
+	{
+	  if (fx_proc(tree) == fx_c_ss)        return(with_fx(tree, (caddr(p) == var2) ? fx_c_tu : fx_c_ts));
+	  if (fx_proc(tree) == fx_c_ss_direct) return(with_fx(tree, (caddr(p) == var2) ? fx_c_tu_direct : fx_c_ts_direct));
+	  if (fx_proc(tree) == fx_add_ss)      return(with_fx(tree, (caddr(p) == var2) ? fx_add_tu : fx_add_ts));
+	  if (fx_proc(tree) == fx_subtract_ss) return(with_fx(tree, (caddr(p) == var2) ? fx_subtract_tu : fx_subtract_ts));
+	  if (fx_proc(tree) == fx_cons_ss)     return(with_fx(tree, (caddr(p) == var2) ? fx_cons_tu : fx_cons_ts));
+	  if (caddr(p) == var2)
+	    {
+	      if (fx_proc(tree) == fx_gt_ss)       return(with_fx(tree, fx_gt_tu));
+	      if (fx_proc(tree) == fx_lt_ss)       return(with_fx(tree, fx_lt_tu));
+	      if (fx_proc(tree) == fx_leq_ss)      return(with_fx(tree, fx_leq_tu));
+	      if (fx_proc(tree) == fx_geq_ss)      return(with_fx(tree, fx_geq_tu));
+	      if (fx_proc(tree) == fx_multiply_ss) return(with_fx(tree, fx_multiply_tu));
+	      if (fx_proc(tree) == fx_num_eq_ss)   return(with_fx(tree, fx_num_eq_tu));
+	      if (fx_proc(tree) == fx_memq_ss)     return(with_fx(tree, fx_memq_tu));
+	    }
+	  if (fx_proc(tree) == fx_multiply_ss) return(with_fx(tree, fx_multiply_ts));
+	  if (fx_proc(tree) == fx_num_eq_ss)
+	    {
+	      if (caddr(p) == var3) return(with_fx(tree, fx_num_eq_tv));
+	      if (is_global(caddr(p))) return(with_fx(tree, fx_num_eq_tg));
+	      if ((!more_vars) && (o_var_ok(caddr(p), var1, var2, var3))) return(with_fx(tree, fx_num_eq_to));
+	      return(with_fx(tree, fx_num_eq_ts));
+	    }
+	  if (fx_proc(tree) == fx_geq_ss)
+	    {
+	      if ((!more_vars) && (o_var_ok(caddr(p), var1, var2, var3))) return(with_fx(tree, fx_geq_to));
+	      return(with_fx(tree, fx_geq_ts));
+	    }
+	  if (fx_proc(tree) == fx_leq_ss) return(with_fx(tree, fx_leq_ts));
+	  if (fx_proc(tree) == fx_lt_ss)  return(with_fx(tree, fx_lt_ts));
+	  if (fx_proc(tree) == fx_lt_sg)  return(with_fx(tree, fx_lt_tg));
+	  if (fx_proc(tree) == fx_gt_ss)
+	    {
+	      if (is_global(caddr(p))) return(with_fx(tree, fx_gt_tg));
+	      if ((!more_vars) && (o_var_ok(caddr(p), var1, var2, var3))) return(with_fx(tree, fx_gt_to));
+	      return(with_fx(tree, fx_gt_ts));
+	    }
+	  if (fx_proc(tree) == fx_sqr_s) return(with_fx(tree, fx_sqr_t));
+	  if (fx_proc(tree) == fx_is_eq_ss)
+	    {
+	      if (caddr(p) == var2) return(with_fx(tree, fx_is_eq_tu));
+	      if ((!more_vars) && (caddr(p) != var3) && (caddr(p) != var1)) return(with_fx(tree, fx_is_eq_to));
+	      return(with_fx(tree, fx_is_eq_ts));
+	    }
+	  if (fx_proc(tree) == fx_vref_ss)
+	    {
+	      if (caddr(p) == var2) return(with_fx(tree, fx_vref_tu));
+	      return(with_fx(tree, fx_vref_ts));
+	    }}
+      if (caddr(p) == var1)
+	{
+	  if (fx_proc(tree) == fx_c_ss) return(with_fx(tree, fx_c_st));
+	  if (fx_proc(tree) == fx_c_ss_direct) {return(with_fx(tree, (is_global(cadr(p))) ? fx_c_gt_direct : fx_c_st_direct));}
+	  if (fx_proc(tree) == fx_hash_table_ref_ss) return(with_fx(tree, fx_hash_table_ref_st));
+	  if (fx_proc(tree) == fx_cons_ss) return(with_fx(tree, fx_cons_st));
+	  if (fx_proc(tree) == fx_vref_ss)
+	    {
+	      if (is_global(cadr(p))) return(with_fx(tree, fx_vref_gt));
+	      if ((!more_vars) && (cadr(p) != var2) && (cadr(p) != var3)) return(with_fx(tree, fx_vref_ot));
+	      return(with_fx(tree, fx_vref_st));
+	    }
+	  if ((fx_proc(tree) == fx_gt_ss) && (cadr(p) == var2)) return(with_fx(tree, fx_gt_ut));
+	  if ((fx_proc(tree) == fx_lt_ss) && (cadr(p) == var2)) return(with_fx(tree, fx_lt_ut));
+	  if ((fx_proc(tree) == fx_geq_ss))
+	    {
+	      if ((!more_vars) && (o_var_ok(cadr(p), var1, var2, var3))) return(with_fx(tree, fx_geq_ot));
+	      return(with_fx(tree, fx_geq_st));
+	    }}
+      if (cadr(p) == var2)
+	{
+	  if (fx_proc(tree) == fx_num_eq_ss) return(with_fx(tree, (caddr(p) == var1) ? fx_num_eq_ut : fx_num_eq_us));
+	  if (fx_proc(tree) == fx_geq_ss) return(with_fx(tree, fx_geq_us));
+	  if (fx_proc(tree) == fx_add_ss) return(with_fx(tree, (caddr(p) == var1) ? fx_add_ut : ((caddr(p) == var3) ? fx_add_uv : fx_add_us)));
+	  if (fx_proc(tree) == fx_subtract_ss) return(with_fx(tree, (caddr(p) == var1) ? fx_subtract_ut : fx_subtract_us));
+	  if (caddr(p) == var3) return(with_fx(tree, fx_c_uv));
+	}
+      if ((caddr(p) == var2) && (fx_proc(tree) == fx_sref_ss)) return(with_fx(tree, fx_sref_su));
+      if (cadr(p) == var3)
+	{
+	  if (fx_proc(tree) == fx_num_eq_ss) return(with_fx(tree, fx_num_eq_vs));
+	  if ((fx_proc(tree) == fx_add_ss) && (caddr(p) == var2)) return(with_fx(tree, fx_add_vu));
+	  if (fx_proc(tree) == fx_geq_ss) return(with_fx(tree, ((!more_vars) && (o_var_ok(caddr(p), var1, var2, var3))) ? fx_geq_vo : fx_geq_vs));
+	}
+      break;
+
+    case HOP_SAFE_C_AS:
+      if (caddr(p) == var1) return(with_fx(tree, fx_c_at));
+      break;
+
+    case HOP_SAFE_C_SA:
+      if (cadr(p) == var1)
+	{
+	  if ((fx_proc(cddr(p)) == fx_c_opsq_c) &&
+	      (cadadr(caddr(p)) == var1) &&
+	      (is_t_integer(caddaddr(p))) &&
+	      (integer(caddaddr(p)) == 1) &&
+	      (car(p) == sc->string_ref_symbol) &&
+	      (caaddr(p) == sc->subtract_symbol) &&
+#if (!WITH_PURE_S7)
+	      ((caadr(caddr(p)) == sc->string_length_symbol) || (caadr(caddr(p)) == sc->length_symbol)))
+#else
+	      (caadr(caddr(p)) == sc->length_symbol))
+#endif
+	    return(with_fx(tree, fx_sref_t_last));
+	  return(with_fx(tree, fx_c_ta));
+	}
+      if (cadr(p) == var2) return(with_fx(tree, (fx_proc(tree) == fx_c_sa_direct) ? fx_c_ua_direct : fx_c_ua));
+      break;
+
+    case HOP_SAFE_C_SCS:
+      if (cadr(p) == var1)
+	{
+	  if (fx_proc(tree) == fx_c_scs) return(with_fx(tree, fx_c_tcs));
+	  if (fx_proc(tree) == fx_c_scs_direct) return(with_fx(tree, (cadddr(p) == var2) ? fx_c_tcu_direct : fx_c_tcs_direct));
+	}
+      break;
+
+    case HOP_SAFE_C_SSC:
+      if ((cadr(p) == var1) && (caddr(p) == var2)) return(with_fx(tree, fx_c_tuc));
+      break;
+
+    case HOP_SAFE_C_CSS:
+      if ((caddr(p) == var1) && (cadddr(p) == var3)) return(with_fx(tree, fx_c_ctv));
+      break;
+
+    case HOP_SAFE_C_SSS:
+      if ((cadr(p) == var1) && ((caddr(p) == var2) && ((fx_proc(tree) == fx_c_sss) || (fx_proc(tree) == fx_c_sss_direct))))
+	return(with_fx(tree, (cadddr(p) == var3) ? ((fx_proc(tree) == fx_c_sss_direct) ? fx_c_tuv_direct : fx_c_tuv) : fx_c_tus));
+      if (caddr(p) == var1)
+	{
+	  if (car(p) == sc->vector_set_symbol)
+	    {
+	      if ((!more_vars) && (o_var_ok(cadr(p), var1, var2, var3)) && (o_var_ok(cadddr(p), var1, var2, var3))) return(with_fx(tree, fx_vset_oto));
+	      return(with_fx(tree, fx_vset_sts));
+	    }
+	  return(with_fx(tree, fx_c_sts));
+	}
+      break;
+
+    case HOP_SAFE_C_SSA:
+      if (cadr(p) == var1) return(with_fx(tree, fx_c_tsa)); /* tua is hit but not called much */
+      if (caddr(p) == var1) return(with_fx(tree, fx_c_sta));
+      break;
+
+    case HOP_SAFE_C_opSq:
+      if (cadadr(p) == var1)
+	{
+	  if (fx_proc(tree) == fx_is_pair_car_s)    return(with_fx(tree, fx_is_pair_car_t));
+	  if (fx_proc(tree) == fx_is_pair_cdr_s)    return(with_fx(tree, fx_is_pair_cdr_t));
+	  if (fx_proc(tree) == fx_is_pair_cadr_s)   return(with_fx(tree, fx_is_pair_cadr_t));
+	  if (fx_proc(tree) == fx_is_symbol_cadr_s) return(with_fx(tree, fx_is_symbol_cadr_t));
+	  if (fx_proc(tree) == fx_is_pair_cddr_s)   return(with_fx(tree, fx_is_pair_cddr_t));
+	  if (fx_proc(tree) == fx_is_null_cdr_s)    return(with_fx(tree, fx_is_null_cdr_t));
+	  if (fx_proc(tree) == fx_is_null_cadr_s)   return(with_fx(tree, fx_is_null_cadr_t));
+	  if (fx_proc(tree) == fx_is_null_cddr_s)   return(with_fx(tree, fx_is_null_cddr_t));
+	  if (fx_proc(tree) == fx_not_is_pair_s)    return(with_fx(tree, fx_not_is_pair_t));
+	  if (fx_proc(tree) == fx_not_is_null_s)    return(with_fx(tree, fx_not_is_null_t));
+	  if (fx_proc(tree) == fx_not_is_symbol_s)  return(with_fx(tree, fx_not_is_symbol_t));
+	  if (fx_proc(tree) == fx_is_type_car_s)
+	    return(with_fx(tree, (car(p) == sc->is_symbol_symbol) ? fx_is_symbol_car_t : fx_is_type_car_t));
+	  if (fx_proc(tree) == fx_c_opsq)
+	    {
+	      set_opt1_sym(cdr(p), cadadr(p));
+	      if ((is_global_and_has_func(car(p), s7_p_p_function)) &&
+		  (is_global_and_has_func(caadr(p), s7_p_p_function)))
+		{
+		  set_opt2_direct(cdr(p), (s7_pointer)(s7_p_p_function(global_value(car(p)))));
+		  set_opt3_direct(cdr(p), (s7_pointer)(s7_p_p_function(global_value(caadr(p)))));
+		  return(with_fx(tree, fx_c_optq_direct));
+		}
+	      return(with_fx(tree, fx_c_optq));
+	    }
+	  if (fx_proc(tree) == fx_c_car_s) return(with_fx(tree, fx_c_car_t));
+	  if (fx_proc(tree) == fx_c_cdr_s) return(with_fx(tree, fx_c_cdr_t));
+	  if (fx_proc(tree) == fx_is_type_opsq) return(with_fx(tree, fx_is_type_optq));
+	  if (fx_proc(tree) == fx_not_opsq)
+	    {
+	      set_opt3_sym(p, cadadr(p));
+	      return(with_fx(tree, (caadr(p) == sc->car_symbol) ? fx_not_car_t : fx_not_optq));
+	    }}
+      if (cadadr(p) == var2)
+	{
+	  if (fx_proc(tree) == fx_c_car_s) return(with_fx(tree, fx_c_car_u));
+	  if (fx_proc(tree) == fx_not_is_null_s) return(with_fx(tree, fx_not_is_null_u));
+	  if (fx_proc(tree) == fx_not_is_pair_s) return(with_fx(tree, fx_not_is_pair_u));
+	  if (fx_proc(tree) == fx_is_pair_cdr_s) return(with_fx(tree, fx_is_pair_cdr_u));
+	}
+      if (cadadr(p) == var3)
+	{
+	  if (fx_proc(tree) == fx_not_is_pair_s) return(with_fx(tree, fx_not_is_pair_v));
+	}
+      break;
+
+    case HOP_SAFE_C_opSq_S:
+      if (cadadr(p) == var1)
+	{
+	  if (fx_proc(tree) == fx_c_opsq_s)
+	    {
+	      if ((is_global_and_has_func(car(p), s7_p_pp_function)) &&
+		  (is_global_and_has_func(caadr(p), s7_p_p_function)))
+		{
+		  set_opt2_direct(cdr(p), (s7_pointer)(s7_p_pp_function(global_value(car(p)))));
+		  set_opt3_direct(cdr(p), (s7_pointer)(s7_p_p_function(global_value(caadr(p)))));
+		  return(with_fx(tree, fx_c_optq_s_direct));
+		}
+	      return(with_fx(tree, fx_c_optq_s));
+	    }
+	  if (fx_proc(tree) == fx_c_opsq_s_direct) return(with_fx(tree, fx_c_optq_s_direct));
+	  if (fx_proc(tree) == fx_cons_car_s_s)
+	    {
+	      set_opt1_sym(cdr(p), var1);
+	      return(with_fx(tree, (caddr(p) == var3) ? fx_cons_car_t_v : fx_cons_car_t_s));
+	    }}
+      if (cadadr(p) == var2)
+	{
+	  if ((fx_proc(tree) == fx_c_opsq_s) && (caddr(p) == var1))
+	    {
+	      if ((is_global_and_has_func(car(p), s7_p_pp_function)) &&
+		  (is_global_and_has_func(caadr(p), s7_p_p_function))) /* (memq (car sequence) items) lint */
+		{
+		  set_opt2_direct(cdr(p), (s7_pointer)(s7_p_pp_function(global_value(car(p)))));
+		  set_opt3_direct(cdr(p), (s7_pointer)(s7_p_p_function(global_value(caadr(p)))));
+		  return(with_fx(tree, (car(p) == sc->cons_symbol) ?
+				     ((caadr(p) == sc->car_symbol) ? fx_cons_car_u_t : fx_cons_opuq_t) : fx_c_opuq_t_direct));
+		}
+	      return(with_fx(tree, fx_c_opuq_t));
+	    }
+	  if (((fx_proc(tree) == fx_c_opsq_s_direct) || (fx_proc(tree) == fx_cons_car_s_s)) &&
+	      (caddr(p) == var1))
+	    return(with_fx(tree, (car(p) == sc->cons_symbol) ?
+			   ((caadr(p) == sc->car_symbol) ? fx_cons_car_u_t : fx_cons_opuq_t) : fx_c_opuq_t_direct));
+	}
+      break;
+
+    case HOP_SAFE_C_S_opSq:
+      if (cadr(p) == var1)
+	{
+	  if (cadaddr(p) == var2)
+	    {
+	      if (fx_proc(tree) == fx_c_s_car_s) return(with_fx(tree, fx_c_t_car_u));
+	      if (fx_proc(tree) == fx_c_s_opsq_direct) return(with_fx(tree, fx_c_t_opuq_direct));
+	    }
+	  if (cadaddr(p) == var3)
+	    {
+	      if (fx_proc(tree) == fx_add_s_car_s) return(with_fx(tree, fx_add_t_car_v));
+	      if (fx_proc(tree) == fx_c_s_car_s) return(with_fx(tree, fx_c_t_car_v)); /* ideally eq_p_pp not g_is_eq */
+	    }
+	  if (fx_proc(tree) == fx_c_s_opsq_direct) return(with_fx(tree, fx_c_t_opsq_direct));
+	}
+      if (cadr(p) == var2)
+	{
+	  if ((fx_proc(tree) == fx_add_s_car_s) && (cadaddr(p) == var1)) return(with_fx(tree, fx_add_u_car_t));
+	  if ((fx_proc(tree) == fx_c_s_opsq_direct) && (cadaddr(p) == var3)) return(with_fx(tree, fx_c_u_opvq_direct));
+	}
+      if ((cadaddr(p) == var1) && (fx_proc(tree) == fx_c_s_car_s)) return(with_fx(tree, fx_c_s_car_t));
+      break;
+
+    case HOP_SAFE_C_opSq_opSq:
+      if ((fx_proc(tree) == fx_c_opsq_opsq_direct) && (cadadr(p) == var1) && (cadadr(p) == cadaddr(p)))
+	{
+	  set_opt1_sym(cdr(p), cadadr(p));
+	  return(with_fx(tree, fx_c_optq_optq_direct));   /* opuq got few hits */
+	}
+      if (((fx_proc(tree) == fx_c_opsq_opsq_direct) || (fx_proc(tree) == fx_car_s_car_s)) &&
+	  ((caadr(p) == sc->car_symbol) && (caadr(p) == caaddr(p))))
+	{
+	  set_opt1_sym(cdr(p), cadadr(p));
+	  set_opt2_sym(cdr(p), cadaddr(p));
+	  return(with_fx(tree, ((cadadr(p) == var1) && (cadaddr(p) == var2)) ?
+			 ((opt3_direct(p) == (s7_pointer)is_eq_p_pp) ? fx_is_eq_car_car_tu : fx_car_t_car_u) : fx_car_s_car_s));
+	}
+      break;
+
+    case HOP_SAFE_C_opSq_C:
+      if (cadadr(p) == var1)
+	{
+	  if (fx_proc(tree) == fx_is_eq_car_sq) return(with_fx(tree, fx_is_eq_car_tq));
+	  if ((fx_proc(tree) == fx_c_opsq_c) || (fx_proc(tree) == fx_c_optq_c))
+	    {
+	      if (fn_proc(p) != g_simple_let_ref) /* don't step on opt3_sym */
+		{
+		  if ((is_global_and_has_func(car(p), s7_p_pp_function)) &&
+		      (is_global_and_has_func(caadr(p), s7_p_p_function)))
+		    {
+		      if (fn_proc(p) == g_memq_2)
+			set_opt3_direct(p, (s7_pointer)memq_2_p_pp);
+		      else set_opt3_direct(p, (s7_pointer)(s7_p_pp_function(global_value(car(p)))));
+		      set_opt3_direct(cdr(p), (s7_pointer)(s7_p_p_function(global_value(caadr(p)))));
+		      set_fx_direct(tree, fx_c_optq_c_direct);
+		      return(true);
+		    }
+		  if ((is_t_integer(caddr(p))) &&
+		      (is_global_and_has_func(caadr(p), s7_i_7p_function)) &&
+		      (is_global_and_has_func(car(p), s7_p_ii_function)))
+		    {
+		      set_opt3_direct(p, (s7_pointer)(s7_p_ii_function(global_value(car(p)))));
+		      set_opt3_direct(cdr(p), (s7_pointer)(s7_i_7p_function(global_value(caadr(p)))));
+		      set_fx_direct(tree, fx_c_optq_i_direct);
+		    }
+		  else set_fx_direct(tree, fx_c_optq_c);
+		}
+	      return(true);
+	    }}
+      break;
+
+    case HOP_SAFE_C_opSSq:
+      if (fx_proc(tree) == fx_c_opssq)
+	{
+	  if (caddadr(p) == var1) return(with_fx(tree, fx_c_opstq));
+	  if ((cadadr(p) == var1) && (caddadr(p) == var2)) return(with_fx(tree, fx_c_optuq));
+	}
+      if (fx_proc(tree) == fx_c_opssq_direct)
+	{
+	  if ((cadadr(p) == var1) && (caddadr(p) == var2)) return(with_fx(tree, fx_c_optuq_direct));
+	  if (caddadr(p) == var1)
+	    {
+	      if ((opt2_direct(cdr(p)) == (s7_pointer)is_zero_p_p) && (opt3_direct(cdr(p)) == (s7_pointer)remainder_p_pp) &&
+		  (!more_vars) && (o_var_ok(cadadr(p), var1, var2, var3)))
+		return(with_fx(tree, fx_is_zero_remainder_o));
+	      return(with_fx(tree, fx_c_opstq_direct));
+	    }}
+      if ((cadadr(p) == var2) && (fx_proc(tree) == fx_not_opssq) && (caddadr(p) == var1))
+	{
+	  set_fx_direct(tree, (fn_proc(cadr(p)) == g_less_2) ? fx_not_lt_ut : fx_not_oputq);
+	  return(true);
+	}
+      break;
+
+    case HOP_SAFE_C_opSCq:
+      if (cadadr(p) == var1)
+	{
+	  if ((fn_proc(p) == g_is_zero) && (fn_proc(cadr(p)) == g_remainder) &&
+	      (is_t_integer(caddadr(p))) && (integer(caddadr(p)) > 1))
+	    return(with_fx(tree, fx_is_zero_remainder_ti));
+	  return(with_fx(tree, fx_c_optcq)); /* there currently isn't any fx_c_opscq_direct */
+	}
+      break;
+
+    case HOP_SAFE_C_opSSq_C:
+      if ((fx_proc(tree) == fx_c_opssq_c) && (caddadr(p) == var1))
+	{
+	  if (is_global_and_has_func(car(p), s7_p_pp_function))
+	    {
+	      if ((car(p) == sc->is_eq_symbol) && (!is_unspecified(caddr(p))) && (caadr(p) == sc->vector_ref_symbol) &&
+		  (!more_vars) && (o_var_ok(cadadr(p), var1, var2, var3)))
+		return(with_fx(tree, fx_is_eq_vref_opotq_c));
+	      set_opt3_direct(p, (s7_pointer)(s7_p_pp_function(global_value(car(p)))));
+	      return(with_fx(tree, fx_c_opstq_c_direct));
+	    }
+	  return(with_fx(tree, fx_c_opstq_c));
+	}
+      break;
+
+    case HOP_SAFE_C_S_opSCq:
+      if (cadr(p) == var1)
+	{
+	  if (fx_proc(tree) == fx_c_s_opscq_direct) return(with_fx(tree, (cadaddr(p) == var2) ? fx_c_t_opucq_direct : fx_c_t_opscq_direct));
+      	  if ((fx_proc(tree) == fx_c_s_opsiq_direct) && (!more_vars) && (o_var_ok(cadaddr(p), var1, var2, var3))) return(with_fx(tree, fx_c_t_opoiq_direct));
+	}
+      else
+	if ((cadr(p) == var2) && (cadaddr(p) == var1))
+	  {
+	    if (fx_proc(tree) == fx_c_s_opsiq_direct) return(with_fx(tree, fx_c_u_optiq_direct));
+	    if (fx_proc(tree) == fx_c_s_opscq) return(with_fx(tree, fx_c_u_optcq));
+	  }
+      break;
+
+    case HOP_SAFE_C_opSq_CS:
+      if ((cadadr(p) == var1) && (fx_proc(tree) == fx_c_opsq_cs) && (cadddr(p) == var2)) return(with_fx(tree, fx_c_optq_cu));
+      break;
+
+    case HOP_SAFE_C_opSq_opSSq:
+      if ((fx_proc(tree) == fx_c_opsq_opssq) && (cadaddr(p) == var1) && (caddaddr(p) == var2) &&
+	  (is_global_and_has_func(car(p), s7_p_pp_function)) &&
+	  (is_global_and_has_func(caadr(p), s7_p_p_function)) &&
+	  (is_global_and_has_func(caaddr(p), s7_p_pp_function)))
+	{
+	  set_opt3_direct(p, (s7_pointer)(s7_p_pp_function(global_value(car(p)))));
+	  set_opt2_direct(cdr(p), (s7_pointer)(s7_p_p_function(global_value(caadr(p)))));
+	  set_opt3_direct(cdr(p), (s7_pointer)(s7_p_pp_function(global_value(caaddr(p)))));
+	  set_opt1_sym(cdr(p), var2); /* caddaddr(p) */
+
+	  set_opt2_sym(cddr(p), var1);
+	  if ((car(p) == sc->num_eq_symbol) && (caadr(p) == sc->car_symbol) && (cadadr(p) == var3))
+	    {
+	      if (caaddr(p) == sc->add_symbol) return(with_fx(tree, fx_num_eq_car_v_add_tu));
+	      if (caaddr(p) == sc->subtract_symbol) return(with_fx(tree, fx_num_eq_car_v_subtract_tu));
+	    }
+	  return(with_fx(tree, fx_c_opsq_optuq_direct));
+	}
+      break;
+
+    case HOP_SAFE_C_opSSq_S:
+      if (fx_proc(tree) == fx_vref_vref_ss_s)
+	{
+	  if ((caddr(p) == var1) && (is_global(cadadr(p))))
+	    {
+	      if ((!more_vars) && (o_var_ok(caddadr(p), var1, var2, var3))) return(with_fx(tree, fx_vref_vref_go_t));
+	      return(with_fx(tree, fx_vref_vref_gs_t));
+	    }
+	  if ((cadadr(p) == var1) && (caddadr(p) == var2) && (caddr(p) == var3)) return(with_fx(tree, fx_vref_vref_tu_v));
+	}
+      if ((fx_proc(tree) == fx_gt_add_s) && (cadadr(p) == var1) && (caddadr(p) == var2))
+	return(with_fx(tree, fx_gt_add_tu_s));
+      if ((fx_proc(tree) == fx_add_sub_s) && (cadadr(p) == var1) && (caddadr(p) == var2))
+	return(with_fx(tree, fx_add_sub_tu_s));
+      break;
+
+    case HOP_SAFE_C_S_opSSq:
+      if (caddaddr(p) == var1)
+	{
+	  if ((fn_proc(p) == g_vector_ref_2) && (is_global(cadr(p)) && (is_global(cadaddr(p)))))
+	    {
+	      set_opt3_pair(p, cdaddr(p));
+	      return(with_fx(tree, fx_vref_g_vref_gt));
+	    }
+	  if (fx_proc(tree) == fx_c_s_opssq_direct) return(with_fx(tree, fx_c_s_opstq_direct));
+	}
+      if ((fx_proc(tree) == fx_c_s_opssq_direct) && (cadr(p) == var1) && (caddaddr(p) == var2)) return(with_fx(tree, fx_c_t_opsuq_direct));
+      break;
+
+    case HOP_SAFE_C_op_opSq_Sq:
+      if ((car(p) == sc->not_symbol) && (is_global(sc->not_symbol)) && (var1 == cadr(cadadr(p))))
+	return(with_fx(tree, fx_not_op_optq_sq));
+      break;
+
+    case HOP_SAFE_C_AC:
+      if (((fx_proc(tree) == fx_c_ac) || (fx_proc(tree) == fx_c_ac_direct)) && (fn_proc(p) == g_num_eq_xi) && (caddr(p) == int_zero) &&
+	  (fx_proc(cdr(p)) == fx_c_opuq_t_direct) && (caadr(p) == sc->remainder_symbol) && (fn_proc(cadadr(p)) == g_car))
+	{
+	  set_opt3_sym(p, cadr(cadadr(p)));
+	  set_opt1_sym(cdr(p), caddadr(p));
+	  return(with_fx(tree, fx_is_zero_remainder_car));
+	}
+      break;
+
+    case HOP_SAFE_CLOSURE_S_A:
+      if ((cadr(p) == var1) && (fx_proc(tree) == fx_safe_closure_s_a)) return(with_fx(tree, fx_safe_closure_t_a));
+      break;
+
+    case OP_IF_S_A_A:
+      if ((!more_vars) && (o_var_ok(cadr(p), var1, var2, var3))) return(with_fx(tree, fx_if_o_a_a));
+      break;
+
+    case OP_AND_3A:
+      if ((fx_proc(tree) == fx_and_3a) &&
+	  (is_pair(cadr(p))) &&
+	  (is_pair(cdadr(p))) && (cadadr(p) == var1) && /* so "s" below is "t" */
+	  (((fx_proc(cdr(p)) == fx_is_pair_t) && (fx_proc(cddr(p)) == fx_is_pair_cdr_t)) ||
+	      ((fx_proc(cdr(p)) == fx_is_pair_s) && (fx_proc(cddr(p)) == fx_is_pair_cdr_s))))
+	{
+	  set_opt1_sym(cdr(p), cadadr(p));
+	  if ((fx_proc(cdddr(p)) == fx_is_null_cddr_t) || (fx_proc(cdddr(p)) == fx_is_null_cddr_s))
+	    return(with_fx(tree, fx_len2_t));
+	  if ((fx_proc(cdddr(p)) == fx_is_pair_cddr_t) || (fx_proc(cdddr(p)) == fx_is_pair_cddr_s))
+	    return(with_fx(tree, fx_len3_t));
+	}
+      break;
+     }
+  return(false);
+}
+
+static void fx_tree(s7_scheme *sc, s7_pointer tree, s7_pointer var1, s7_pointer var2, s7_pointer var3, bool more_vars)
+{
+  /* if (is_pair(tree)) fprintf(stderr, "fx_tree %s %d %d\n", display(tree), has_fx(tree), is_syntax(car(tree))); */
+  if (!is_pair(tree)) return;
+  if ((is_symbol(car(tree))) &&
+      (is_definer_or_binder(car(tree))))
+    {
+      if ((car(tree) == sc->let_symbol) && (is_pair(cdr(tree))) && (is_pair(cadr(tree))) &&
+	  (is_null(cdadr(tree))) && (is_pair(caadr(tree)))) /* (let (a) ...) */
+	fx_tree(sc, cddr(tree), caaadr(tree), NULL, NULL, more_vars);
+      return;
+    }
+  if (is_syntax(car(tree))) return; /* someday let #_when/#_if etc through -- the symbol 'if, for example, is not syntax */
+
+  if ((!has_fx(tree)) ||
+      (!fx_tree_in(sc, tree, var1, var2, var3, more_vars)))
+    fx_tree(sc, car(tree), var1, var2, var3, more_vars);
+  fx_tree(sc, cdr(tree), var1, var2, var3, more_vars);
+}
+
+/* -------------------------------------------------------------------------------- */
+static opt_funcs_t *alloc_semipermanent_opt_func(s7_scheme *sc)
+{
+  if (sc->alloc_opt_func_k == ALLOC_FUNCTION_SIZE)
+    {
+      sc->alloc_opt_func_cells = (opt_funcs_t *)Malloc(ALLOC_FUNCTION_SIZE * sizeof(opt_funcs_t));
+      add_saved_pointer(sc, sc->alloc_opt_func_cells);
+      sc->alloc_opt_func_k = 0;
+    }
+  return(&(sc->alloc_opt_func_cells[sc->alloc_opt_func_k++]));
+}
+
+static void add_opt_func(s7_scheme *sc, s7_pointer f, opt_func_t typ, void *func)
+{
+  opt_funcs_t *op;
+#if S7_DEBUGGING
+  static const char *o_names[] = {"o_d_v", "o_d_vd", "o_d_vdd", "o_d_vid", "o_d_id", "o_d_7pi", "o_d_7pii", "o_d_7piid", "o_d_7piii", "o_d_7piiid",
+				"o_d_ip", "o_d_pd", "o_d_7pid",	"o_d", "o_d_d", "o_d_dd", "o_d_7dd", "o_d_ddd", "o_d_dddd",
+				"o_i_i", "o_i_7i", "o_i_ii", "o_i_7ii", "o_i_iii", "o_i_7pi", "o_i_7pii", "o_i_7_piii", "o_d_p",
+				"o_b_p", "o_b_7p", "o_b_pp", "o_b_7pp", "o_b_pp_unchecked", "o_b_pi", "o_b_ii", "o_b_7ii", "o_b_dd",
+				"o_p", "o_p_p", "o_p_ii", "o_p_d", "o_p_dd", "o_i_7d", "o_i_7p", "o_d_7d", "o_p_pp", "o_p_ppp", "o_p_pi", "o_p_pi_unchecked",
+				"o_p_ppi", "o_p_i", "o_p_pii", "o_p_pip", "o_p_pip_unchecked", "o_p_piip", "o_b_i", "o_b_d"};
+  if (!is_c_function(f))
+    {
+      fprintf(stderr, "%s[%d]: %s is not a c_function\n", __func__, __LINE__, display(f));
+      if (sc->stop_at_error) abort();
+    }
+  else
+    if (c_function_opt_data(f))
+      for (opt_funcs_t *p = c_function_opt_data(f); p; p = p->next)
+	{
+	  if (p->typ == typ)
+	    fprintf(stderr, "%s[%d]: %s has a function of type %d (%s)\n",
+		    __func__, __LINE__, display(f), typ, o_names[typ]);
+	  if (p->func == func)
+	    fprintf(stderr, "%s[%d]: %s already has this function as type %d %s (current: %d %s)\n",
+		    __func__, __LINE__, display(f), p->typ, o_names[p->typ], typ, o_names[typ]);
+	}
+#endif
+  op = alloc_semipermanent_opt_func(sc);
+  op->typ = typ;
+  op->func = func;
+  op->next = c_function_opt_data(f);
+  c_function_opt_data(f) = op;
+}
+
+static void *opt_func(s7_pointer f, opt_func_t typ)
+{
+  if (is_c_function(f))
+    for (opt_funcs_t *p = c_function_opt_data(f); p; p = p->next)
+      if (p->typ == typ)
+	return(p->func);
+  return(NULL);
+}
+
+/* clm2xen.c */
+void s7_set_d_function(s7_scheme *sc, s7_pointer f, s7_d_t df) {add_opt_func(sc, f, o_d, (void *)df);}
+s7_d_t s7_d_function(s7_pointer f) {return((s7_d_t)opt_func(f, o_d));}
+
+void s7_set_d_d_function(s7_scheme *sc, s7_pointer f, s7_d_d_t df) {add_opt_func(sc, f, o_d_d, (void *)df);}
+s7_d_d_t s7_d_d_function(s7_pointer f) {return((s7_d_d_t)opt_func(f, o_d_d));}
+
+void s7_set_d_dd_function(s7_scheme *sc, s7_pointer f, s7_d_dd_t df) {add_opt_func(sc, f, o_d_dd, (void *)df);}
+s7_d_dd_t s7_d_dd_function(s7_pointer f) {return((s7_d_dd_t)opt_func(f, o_d_dd));}
+
+void s7_set_d_v_function(s7_scheme *sc, s7_pointer f, s7_d_v_t df) {add_opt_func(sc, f, o_d_v, (void *)df);}
+s7_d_v_t s7_d_v_function(s7_pointer f) {return((s7_d_v_t)opt_func(f, o_d_v));}
+
+void s7_set_d_vd_function(s7_scheme *sc, s7_pointer f, s7_d_vd_t df) {add_opt_func(sc, f, o_d_vd, (void *)df);}
+s7_d_vd_t s7_d_vd_function(s7_pointer f) {return((s7_d_vd_t)opt_func(f, o_d_vd));}
+
+void s7_set_d_vdd_function(s7_scheme *sc, s7_pointer f, s7_d_vdd_t df) {add_opt_func(sc, f, o_d_vdd, (void *)df);}
+s7_d_vdd_t s7_d_vdd_function(s7_pointer f) {return((s7_d_vdd_t)opt_func(f, o_d_vdd));}
+
+void s7_set_d_vid_function(s7_scheme *sc, s7_pointer f, s7_d_vid_t df) {add_opt_func(sc, f, o_d_vid, (void *)df);}
+s7_d_vid_t s7_d_vid_function(s7_pointer f) {return((s7_d_vid_t)opt_func(f, o_d_vid));}
+
+void s7_set_d_id_function(s7_scheme *sc, s7_pointer f, s7_d_id_t df) {add_opt_func(sc, f, o_d_id, (void *)df);}
+s7_d_id_t s7_d_id_function(s7_pointer f) {return((s7_d_id_t)opt_func(f, o_d_id));}
+
+void s7_set_d_7pid_function(s7_scheme *sc, s7_pointer f, s7_d_7pid_t df) {add_opt_func(sc, f, o_d_7pid, (void *)df);}
+s7_d_7pid_t s7_d_7pid_function(s7_pointer f) {return((s7_d_7pid_t)opt_func(f, o_d_7pid));}
+
+void s7_set_d_ip_function(s7_scheme *sc, s7_pointer f, s7_d_ip_t df) {add_opt_func(sc, f, o_d_ip, (void *)df);}
+s7_d_ip_t s7_d_ip_function(s7_pointer f) {return((s7_d_ip_t)opt_func(f, o_d_ip));}
+
+void s7_set_d_pd_function(s7_scheme *sc, s7_pointer f, s7_d_pd_t df) {add_opt_func(sc, f, o_d_pd, (void *)df);}
+s7_d_pd_t s7_d_pd_function(s7_pointer f) {return((s7_d_pd_t)opt_func(f, o_d_pd));}
+
+void s7_set_d_p_function(s7_scheme *sc, s7_pointer f, s7_d_p_t df) {add_opt_func(sc, f, o_d_p, (void *)df);}
+s7_d_p_t s7_d_p_function(s7_pointer f) {return((s7_d_p_t)opt_func(f, o_d_p));}
+
+void s7_set_b_p_function(s7_scheme *sc, s7_pointer f, s7_b_p_t df) {add_opt_func(sc, f, o_b_p, (void *)df);}
+s7_b_p_t s7_b_p_function(s7_pointer f) {return((s7_b_p_t)opt_func(f, o_b_p));}
+
+void s7_set_d_7pi_function(s7_scheme *sc, s7_pointer f, s7_d_7pi_t df) {add_opt_func(sc, f, o_d_7pi, (void *)df);}
+s7_d_7pi_t s7_d_7pi_function(s7_pointer f) {return((s7_d_7pi_t)opt_func(f, o_d_7pi));}
+
+static void s7_set_d_7pii_function(s7_scheme *sc, s7_pointer f, s7_d_7pii_t df) {add_opt_func(sc, f, o_d_7pii, (void *)df);}
+static s7_d_7pii_t s7_d_7pii_function(s7_pointer f) {return((s7_d_7pii_t)opt_func(f, o_d_7pii));}
+
+static void s7_set_d_7piii_function(s7_scheme *sc, s7_pointer f, s7_d_7piii_t df) {add_opt_func(sc, f, o_d_7piii, (void *)df);}
+static s7_d_7piii_t s7_d_7piii_function(s7_pointer f) {return((s7_d_7piii_t)opt_func(f, o_d_7piii));}
+
+void s7_set_i_7p_function(s7_scheme *sc, s7_pointer f, s7_i_7p_t df) {add_opt_func(sc, f, o_i_7p, (void *)df);}
+s7_i_7p_t s7_i_7p_function(s7_pointer f) {return((s7_i_7p_t)opt_func(f, o_i_7p));}
+
+/* cload.scm */
+void s7_set_d_ddd_function(s7_scheme *sc, s7_pointer f, s7_d_ddd_t df) {add_opt_func(sc, f, o_d_ddd, (void *)df);}
+s7_d_ddd_t s7_d_ddd_function(s7_pointer f) {return((s7_d_ddd_t)opt_func(f, o_d_ddd));}
+
+void s7_set_d_dddd_function(s7_scheme *sc, s7_pointer f, s7_d_dddd_t df) {add_opt_func(sc, f, o_d_dddd, (void *)df);}
+s7_d_dddd_t s7_d_dddd_function(s7_pointer f) {return((s7_d_dddd_t)opt_func(f, o_d_dddd));}
+
+void s7_set_i_i_function(s7_scheme *sc, s7_pointer f, s7_i_i_t df) {add_opt_func(sc, f, o_i_i, (void *)df);}
+s7_i_i_t s7_i_i_function(s7_pointer f) {return((s7_i_i_t)opt_func(f, o_i_i));}
+
+void s7_set_i_ii_function(s7_scheme *sc, s7_pointer f, s7_i_ii_t df) {add_opt_func(sc, f, o_i_ii, (void *)df);}
+s7_i_ii_t s7_i_ii_function(s7_pointer f) {return((s7_i_ii_t)opt_func(f, o_i_ii));}
+
+void s7_set_i_7d_function(s7_scheme *sc, s7_pointer f, s7_i_7d_t df) {add_opt_func(sc, f, o_i_7d, (void *)df);}
+s7_i_7d_t s7_i_7d_function(s7_pointer f) {return((s7_i_7d_t)opt_func(f, o_i_7d));}
+
+/* s7test.scm */
+void s7_set_p_d_function(s7_scheme *sc, s7_pointer f, s7_p_d_t df) {add_opt_func(sc, f, o_p_d, (void *)df);}
+s7_p_d_t s7_p_d_function(s7_pointer f) {return((s7_p_d_t)opt_func(f, o_p_d));}
+
+static void s7_set_d_7dd_function(s7_scheme *sc, s7_pointer f, s7_d_7dd_t df) {add_opt_func(sc, f, o_d_7dd, (void *)df);}
+static s7_d_7dd_t s7_d_7dd_function(s7_pointer f) {return((s7_d_7dd_t)opt_func(f, o_d_7dd));}
+
+static void s7_set_i_7i_function(s7_scheme *sc, s7_pointer f, s7_i_7i_t df) {add_opt_func(sc, f, o_i_7i, (void *)df);}
+static s7_i_7i_t s7_i_7i_function(s7_pointer f) {return((s7_i_7i_t)opt_func(f, o_i_7i));}
+
+static void s7_set_i_7ii_function(s7_scheme *sc, s7_pointer f, s7_i_7ii_t df) {add_opt_func(sc, f, o_i_7ii, (void *)df);}
+static s7_i_7ii_t s7_i_7ii_function(s7_pointer f) {return((s7_i_7ii_t)opt_func(f, o_i_7ii));}
+
+static void s7_set_i_iii_function(s7_scheme *sc, s7_pointer f, s7_i_iii_t df) {add_opt_func(sc, f, o_i_iii, (void *)df);}
+static s7_i_iii_t s7_i_iii_function(s7_pointer f) {return((s7_i_iii_t)opt_func(f, o_i_iii));}
+
+static void s7_set_p_pi_function(s7_scheme *sc, s7_pointer f, s7_p_pi_t df) {add_opt_func(sc, f, o_p_pi, (void *)df);}
+static s7_p_pi_t s7_p_pi_function(s7_pointer f) {return((s7_p_pi_t)opt_func(f, o_p_pi));}
+
+static void s7_set_p_ppi_function(s7_scheme *sc, s7_pointer f, s7_p_ppi_t df) {add_opt_func(sc, f, o_p_ppi, (void *)df);}
+static s7_p_ppi_t s7_p_ppi_function(s7_pointer f) {return((s7_p_ppi_t)opt_func(f, o_p_ppi));}
+
+static void s7_set_i_7pi_function(s7_scheme *sc, s7_pointer f, s7_i_7pi_t df) {add_opt_func(sc, f, o_i_7pi, (void *)df);}
+static s7_i_7pi_t s7_i_7pi_function(s7_pointer f) {return((s7_i_7pi_t)opt_func(f, o_i_7pi));}
+
+static void s7_set_i_7pii_function(s7_scheme *sc, s7_pointer f, s7_i_7pii_t df) {add_opt_func(sc, f, o_i_7pii, (void *)df);}
+static s7_i_7pii_t s7_i_7pii_function(s7_pointer f) {return((s7_i_7pii_t)opt_func(f, o_i_7pii));}
+
+static void s7_set_i_7piii_function(s7_scheme *sc, s7_pointer f, s7_i_7piii_t df) {add_opt_func(sc, f, o_i_7piii, (void *)df);}
+static s7_i_7piii_t s7_i_7piii_function(s7_pointer f) {return((s7_i_7piii_t)opt_func(f, o_i_7piii));}
+
+static void s7_set_b_d_function(s7_scheme *sc, s7_pointer f, s7_b_d_t df) {add_opt_func(sc, f, o_b_d, (void *)df);}
+static s7_b_d_t s7_b_d_function(s7_pointer f) {return((s7_b_d_t)opt_func(f, o_b_d));}
+
+static void s7_set_b_i_function(s7_scheme *sc, s7_pointer f, s7_b_i_t df) {add_opt_func(sc, f, o_b_i, (void *)df);}
+static s7_b_i_t s7_b_i_function(s7_pointer f) {return((s7_b_i_t)opt_func(f, o_b_i));}
+
+static void s7_set_b_7p_function(s7_scheme *sc, s7_pointer f, s7_b_7p_t df) {add_opt_func(sc, f, o_b_7p, (void *)df);}
+static s7_b_7p_t s7_b_7p_function(s7_pointer f) {return((s7_b_7p_t)opt_func(f, o_b_7p));}
+
+static void s7_set_b_pp_function(s7_scheme *sc, s7_pointer f, s7_b_pp_t df) {add_opt_func(sc, f, o_b_pp, (void *)df);}
+static s7_b_pp_t s7_b_pp_function(s7_pointer f) {return((s7_b_pp_t)opt_func(f, o_b_pp));}
+
+static void s7_set_b_7pp_function(s7_scheme *sc, s7_pointer f, s7_b_7pp_t df) {add_opt_func(sc, f, o_b_7pp, (void *)df);}
+static s7_b_7pp_t s7_b_7pp_function(s7_pointer f) {return((s7_b_7pp_t)opt_func(f, o_b_7pp));}
+
+static void s7_set_d_7d_function(s7_scheme *sc, s7_pointer f, s7_d_7d_t df) {add_opt_func(sc, f, o_d_7d, (void *)df);}
+static s7_d_7d_t s7_d_7d_function(s7_pointer f) {return((s7_d_7d_t)opt_func(f, o_d_7d));}
+
+static void s7_set_b_pi_function(s7_scheme *sc, s7_pointer f, s7_b_pi_t df) {add_opt_func(sc, f, o_b_pi, (void *)df);}
+static s7_b_pi_t s7_b_pi_function(s7_pointer f) {return((s7_b_pi_t)opt_func(f, o_b_pi));}
+
+static void s7_set_b_ii_function(s7_scheme *sc, s7_pointer f, s7_b_ii_t df) {add_opt_func(sc, f, o_b_ii, (void *)df);}
+static s7_b_ii_t s7_b_ii_function(s7_pointer f) {return((s7_b_ii_t)opt_func(f, o_b_ii));}
+
+static void s7_set_b_7ii_function(s7_scheme *sc, s7_pointer f, s7_b_7ii_t df) {add_opt_func(sc, f, o_b_7ii, (void *)df);}
+static s7_b_7ii_t s7_b_7ii_function(s7_pointer f) {return((s7_b_7ii_t)opt_func(f, o_b_7ii));}
+
+static void s7_set_b_dd_function(s7_scheme *sc, s7_pointer f, s7_b_dd_t df) {add_opt_func(sc, f, o_b_dd, (void *)df);}
+static s7_b_dd_t s7_b_dd_function(s7_pointer f) {return((s7_b_dd_t)opt_func(f, o_b_dd));}
+
+void s7_set_p_p_function(s7_scheme *sc, s7_pointer f, s7_p_p_t df) {add_opt_func(sc, f, o_p_p, (void *)df);}
+s7_p_p_t s7_p_p_function(s7_pointer f) {return((s7_p_p_t)opt_func(f, o_p_p));}
+
+static void s7_set_p_function(s7_scheme *sc, s7_pointer f, s7_p_t df) {add_opt_func(sc, f, o_p, (void *)df);}
+static s7_p_t s7_p_function(s7_pointer f) {return((s7_p_t)opt_func(f, o_p));}
+
+void s7_set_p_pp_function(s7_scheme *sc, s7_pointer f, s7_p_pp_t df) {add_opt_func(sc, f, o_p_pp, (void *)df);}
+s7_p_pp_t s7_p_pp_function(s7_pointer f) {return((s7_p_pp_t)opt_func(f, o_p_pp));}
+
+void s7_set_p_ppp_function(s7_scheme *sc, s7_pointer f, s7_p_ppp_t df) {add_opt_func(sc, f, o_p_ppp, (void *)df);}
+s7_p_ppp_t s7_p_ppp_function(s7_pointer f) {return((s7_p_ppp_t)opt_func(f, o_p_ppp));}
+
+static void s7_set_p_pip_function(s7_scheme *sc, s7_pointer f, s7_p_pip_t df) {add_opt_func(sc, f, o_p_pip, (void *)df);}
+static s7_p_pip_t s7_p_pip_function(s7_pointer f) {return((s7_p_pip_t)opt_func(f, o_p_pip));}
+
+static void s7_set_p_pii_function(s7_scheme *sc, s7_pointer f, s7_p_pii_t df) {add_opt_func(sc, f, o_p_pii, (void *)df);}
+static s7_p_pii_t s7_p_pii_function(s7_pointer f) {return((s7_p_pii_t)opt_func(f, o_p_pii));}
+
+static void s7_set_p_piip_function(s7_scheme *sc, s7_pointer f, s7_p_piip_t df) {add_opt_func(sc, f, o_p_piip, (void *)df);}
+static s7_p_piip_t s7_p_piip_function(s7_pointer f) {return((s7_p_piip_t)opt_func(f, o_p_piip));}
+
+static void s7_set_p_pi_unchecked_function(s7_scheme *sc, s7_pointer f, s7_p_pi_t df) {add_opt_func(sc, f, o_p_pi_unchecked, (void *)df);}
+static s7_p_pi_t s7_p_pi_unchecked_function(s7_pointer f) {return((s7_p_pi_t)opt_func(f, o_p_pi_unchecked));}
+
+static void s7_set_p_pip_unchecked_function(s7_scheme *sc, s7_pointer f, s7_p_pip_t df) {add_opt_func(sc, f, o_p_pip_unchecked, (void *)df);}
+static s7_p_pip_t s7_p_pip_unchecked_function(s7_pointer f) {return((s7_p_pip_t)opt_func(f, o_p_pip_unchecked));}
+
+static void s7_set_b_pp_unchecked_function(s7_scheme *sc, s7_pointer f, s7_b_pp_t df) {add_opt_func(sc, f, o_b_pp_unchecked, (void *)df);}
+static s7_b_pp_t s7_b_pp_unchecked_function(s7_pointer f) {return((s7_b_pp_t)opt_func(f, o_b_pp_unchecked));}
+
+static void s7_set_p_i_function(s7_scheme *sc, s7_pointer f, s7_p_i_t df) {add_opt_func(sc, f, o_p_i, (void *)df);}
+static s7_p_i_t s7_p_i_function(s7_pointer f) {return((s7_p_i_t)opt_func(f, o_p_i));}
+
+static void s7_set_p_ii_function(s7_scheme *sc, s7_pointer f, s7_p_ii_t df) {add_opt_func(sc, f, o_p_ii, (void *)df);}
+static s7_p_ii_t s7_p_ii_function(s7_pointer f) {return((s7_p_ii_t)opt_func(f, o_p_ii));}
+
+static void s7_set_d_7piid_function(s7_scheme *sc, s7_pointer f, s7_d_7piid_t df) {add_opt_func(sc, f, o_d_7piid, (void *)df);}
+static s7_d_7piid_t s7_d_7piid_function(s7_pointer f) {return((s7_d_7piid_t)opt_func(f, o_d_7piid));}
+
+static void s7_set_d_7piiid_function(s7_scheme *sc, s7_pointer f, s7_d_7piiid_t df) {add_opt_func(sc, f, o_d_7piiid, (void *)df);}
+static s7_d_7piiid_t s7_d_7piiid_function(s7_pointer f) {return((s7_d_7piiid_t)opt_func(f, o_d_7piiid));}
+
+static void s7_set_p_dd_function(s7_scheme *sc, s7_pointer f, s7_p_dd_t df) {add_opt_func(sc, f, o_p_dd, (void *)df);}
+static s7_p_dd_t s7_p_dd_function(s7_pointer f) {return((s7_p_dd_t)opt_func(f, o_p_dd));}
+
+static opt_info *alloc_opt_info(s7_scheme *sc)
+{
+  opt_info *o;
+  if (sc->pc >= OPTS_SIZE)
+    sc->pc = OPTS_SIZE - 1;
+  o = sc->opts[sc->pc++];
+  o->v[O_WRAP].fd = NULL; /* see bool_optimize -- this is a kludge */
+  return(o);
+}
+
+#define backup_pc(sc) sc->pc--
+
+#define OPT_PRINT 0 /* print out info about the opt_* optimizations */
+#if OPT_PRINT
+
+#define return_false(Sc, Expr) return(return_false_1(Sc, Expr, __func__, __LINE__))
+static bool return_false_1(s7_scheme *sc, s7_pointer expr, const char *func, int32_t line)
+{
+  if (expr)
+    fprintf(stderr, "   %s[%d]: %s\n", func, line, display_truncated(expr));
+  else fprintf(stderr, "   %s[%d]: false\n", func, line);
+  return(false);
+}
+
+#define return_true(Sc, Expr) return(return_true_1(Sc, Expr, __func__, __LINE__))
+static bool return_true_1(s7_scheme *sc, s7_pointer expr, const char *func, int32_t line)
+{
+  if (expr)
+    fprintf(stderr, "   %s%s[%d]%s: %s\n", bold_text blue_text, func, line, unbold_text uncolor_text, display_truncated(expr));
+  else fprintf(stderr, "   %s%s[%d]%s: true\n", blue_text, func, line, uncolor_text);
+  return(true);
+}
+
+#define return_success(Sc, P, Expr) return(return_success_1(Sc, P, Expr, __func__, __LINE__))
+static s7_pfunc return_success_1(s7_scheme *sc, s7_pfunc p, s7_pointer expr, const char *func, int32_t line)
+{
+  fprintf(stderr, "   %s%s[%d]%s: %s\n", bold_text green_text, func, line, unbold_text uncolor_text, display(expr));
+  return(p);
+}
+
+#define return_null(Sc, Expr) return(return_null_1(Sc, Expr, __func__, __LINE__))
+static s7_pfunc return_null_1(s7_scheme *sc, s7_pointer expr, const char *func, int32_t line)
+{
+  fprintf(stderr, "   %s%s[%d]%s: %s\n   %sfailure%s\n", bold_text, func, line, unbold_text, display_truncated(expr), bold_text red_text, unbold_text uncolor_text);
+  return(NULL);
+}
+#else
+#define return_false(Sc, Expr) return(false)
+#define return_true(Sc, Expr) return(true)
+#define return_success(Sc, P, Expr) return(P)
+#define return_null(Sc, Expr) return(NULL)
+#endif
+
+static s7_pointer opt_integer_symbol(s7_scheme *sc, s7_pointer sym)
+{
+  if (is_symbol(sym))
+    {
+      s7_pointer p = s7_slot(sc, sym);
+      if ((is_slot(p)) &&
+	  (is_t_integer(slot_value(p))))
+	return(p);
+    }
+  return(NULL);
+}
+
+static s7_pointer opt_real_symbol(s7_scheme *sc, s7_pointer sym)
+{
+  if (is_symbol(sym))
+    {
+      s7_pointer p = s7_slot(sc, sym);
+      if ((is_slot(p)) &&
+	  (is_small_real(slot_value(p))))
+	return(p);
+    }
+  return(NULL);
+}
+
+static s7_pointer opt_float_symbol(s7_scheme *sc, s7_pointer sym)
+{
+  if (is_symbol(sym))
+    {
+      s7_pointer p = s7_slot(sc, sym);
+      if ((is_slot(p)) &&
+	  (is_t_real(slot_value(p))))
+	return(p);
+    }
+  return(NULL);
+}
+
+static s7_pointer opt_simple_symbol(s7_scheme *sc, s7_pointer sym)
+{
+  s7_pointer p = s7_slot(sc, sym);
+  if ((is_slot(p)) &&
+      (!has_methods(slot_value(p))))
+    return(p);
+  return(NULL);
+}
+
+static s7_pointer opt_types_match(s7_scheme *sc, s7_pointer check, s7_pointer sym)
+{
+  s7_pointer checker = s7_symbol_value(sc, check);
+  s7_pointer slot = s7_slot(sc, sym);
+  if (is_slot(slot))
+    {
+      s7_pointer obj = slot_value(slot);
+      if (s7_apply_function(sc, checker, set_plist_1(sc, obj)) == sc->T)
+	return(slot);
+    }
+  return(NULL);
+}
+
+static s7_pointer opt_bool_any(s7_scheme *sc)     {return((sc->opts[0]->v[0].fb(sc->opts[0])) ? sc->T : sc->F);}
+static s7_pointer opt_float_any_nv(s7_scheme *sc) {sc->opts[0]->v[0].fd(sc->opts[0]); return(NULL);}
+static s7_pointer opt_int_any_nv(s7_scheme *sc)   {sc->opts[0]->v[0].fi(sc->opts[0]); return(NULL);}
+static s7_pointer opt_bool_any_nv(s7_scheme *sc)  {sc->opts[0]->v[0].fb(sc->opts[0]); return(NULL);}
+static s7_pointer opt_cell_any_nv(s7_scheme *sc)  {return(sc->opts[0]->v[0].fp(sc->opts[0]));} /* this is faster than returning null */
+
+static s7_pointer opt_make_float(s7_scheme *sc) {return(make_real(sc, sc->opts[0]->v[0].fd(sc->opts[0])));}
+static s7_pointer opt_make_int(s7_scheme *sc)   {return(make_integer(sc, sc->opts[0]->v[0].fi(sc->opts[0])));}
+static s7_pointer opt_wrap_cell(s7_scheme *sc)  {return(sc->opts[0]->v[0].fp(sc->opts[0]));}
+static s7_pointer opt_wrap_bool(s7_scheme *sc)  {return((sc->opts[0]->v[0].fb(sc->opts[0])) ? sc->T : sc->F);}
+
+static bool p_to_b(opt_info *o)          {return(o->v[O_WRAP].fp(o) != o->sc->F);}
+static s7_pointer d_to_p(opt_info *o)    {return(make_real(o->sc, o->v[O_WRAP].fd(o)));}
+static s7_pointer d_to_p_nr(opt_info *o) {o->v[O_WRAP].fd(o); return(NULL);}
+static s7_pointer i_to_p(opt_info *o)    {return(make_integer(o->sc, o->v[O_WRAP].fi(o)));}
+static s7_pointer i_to_p_nr(opt_info *o) {o->v[O_WRAP].fi(o); return(NULL);}
+
+
+/* -------------------------------- int opts -------------------------------- */
+static s7_int opt_i_c(opt_info *o) {return(o->v[1].i);}
+static s7_int opt_i_s(opt_info *o) {return(integer(slot_value(o->v[1].p)));}
+
+static bool opt_int_not_pair(s7_scheme *sc, s7_pointer car_x)
+{
+  opt_info *opc;
+  s7_pointer p;
+  if (is_t_integer(car_x))
+    {
+      opc = alloc_opt_info(sc);
+      opc->v[1].i = integer(car_x);
+      opc->v[0].fi = opt_i_c;
+      return_true(sc, car_x);
+    }
+  p = opt_integer_symbol(sc, car_x);
+  if (!p)
+    return_false(sc, car_x);
+  opc = alloc_opt_info(sc);
+  opc->v[1].p = p;
+  opc->v[0].fi = opt_i_s;
+  return_true(sc, car_x);
+}
+
+/* -------- i_i|d|p -------- */
+static s7_int opt_i_i_c(opt_info *o)  {return(o->v[2].i_i_f(o->v[1].i));}
+static s7_int opt_i_i_s(opt_info *o)  {return(o->v[2].i_i_f(integer(slot_value(o->v[1].p))));}
+static s7_int opt_i_7i_c(opt_info *o) {return(o->v[2].i_7i_f(o->sc, o->v[1].i));}
+static s7_int opt_i_7i_s(opt_info *o) {return(o->v[2].i_7i_f(o->sc, integer(slot_value(o->v[1].p))));}
+static s7_int opt_i_7i_s_rand(opt_info *o) {return(random_i_7i(o->sc, integer(slot_value(o->v[1].p))));}
+static s7_int opt_i_d_c(opt_info *o)  {return(o->v[2].i_7d_f(o->sc, o->v[1].x));}
+static s7_int opt_i_d_s(opt_info *o)  {return(o->v[2].i_7d_f(o->sc, real(slot_value(o->v[1].p))));}
+
+static s7_int opt_i_i_f(opt_info *o)  {return(o->v[2].i_i_f(o->v[4].fi(o->v[3].o1)));}
+static s7_int opt_i_7i_f(opt_info *o) {return(o->v[2].i_7i_f(o->sc, o->v[4].fi(o->v[3].o1)));}
+static s7_int opt_i_7d_f(opt_info *o) {return(o->v[2].i_7d_f(o->sc, o->v[4].fd(o->v[3].o1)));}
+static s7_int opt_i_7p_f(opt_info *o) {return(o->v[2].i_7p_f(o->sc, o->v[4].fp(o->v[3].o1)));}
+static s7_int opt_i_7p_f_cint(opt_info *o) {return(char_to_integer_i_7p(o->sc, o->v[4].fp(o->v[3].o1)));}
+
+static s7_int opt_i_i_s_abs(opt_info *o) {return(abs_i_i(integer(slot_value(o->v[1].p))));}
+static s7_int opt_i_i_f_abs(opt_info *o) {return(abs_i_i(o->v[4].fi(o->v[3].o1)));}
+
+static bool int_optimize(s7_scheme *sc, s7_pointer expr);
+static bool float_optimize(s7_scheme *sc, s7_pointer expr);
+
+static bool i_idp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  s7_i_i_t func = s7_i_i_function(s_func);
+  s7_i_7i_t func7 = NULL;
+  s7_i_7p_t ipf;
+  s7_pointer p, arg1 = cadr(car_x);
+  int32_t start = sc->pc;
+  opc->v[3].o1 = sc->opts[start];
+  if (!func)
+    func7 = s7_i_7i_function(s_func);
+  if ((func) || (func7))
+    {
+      if (func)
+	opc->v[2].i_i_f = func;
+      else opc->v[2].i_7i_f = func7;
+      if (is_t_integer(arg1))
+	{
+	  if (opc->v[2].i_i_f == subtract_i_i)
+	    {
+	      opc->v[1].i = -integer(arg1);
+	      opc->v[0].fi = opt_i_c;
+	    }
+	  else
+	    {
+	      opc->v[1].i = integer(arg1);
+	      opc->v[0].fi = (func) ? opt_i_i_c : opt_i_7i_c;
+	    }
+	  return_true(sc, car_x);
+	}
+      p = opt_integer_symbol(sc, arg1);
+      if (p)
+	{
+	  opc->v[1].p = p;
+	  opc->v[0].fi = (func) ? ((func == abs_i_i) ? opt_i_i_s_abs : opt_i_i_s) : ((func7 == random_i_7i) ? opt_i_7i_s_rand : opt_i_7i_s);
+	  return_true(sc, car_x);
+	}
+      if (int_optimize(sc, cdr(car_x)))
+	{
+	  opc->v[4].fi = sc->opts[start]->v[0].fi;
+	  opc->v[0].fi = (func) ? ((func == abs_i_i) ? opt_i_i_f_abs : opt_i_i_f) : opt_i_7i_f;
+	  return_true(sc, car_x);
+	}
+      sc->pc = start;
+    }
+  if (!is_t_ratio(arg1))
+    {
+      s7_i_7d_t idf = s7_i_7d_function(s_func);
+      if (idf)
+	{
+	  opc->v[2].i_7d_f = idf;
+	  if (is_small_real(arg1))
+	    {
+	      opc->v[1].x = s7_number_to_real(sc, arg1);
+	      opc->v[0].fi = opt_i_d_c;
+	      return_true(sc, car_x);
+	    }
+	  p = opt_float_symbol(sc, arg1);
+	  if (p)
+	    {
+	      opc->v[1].p = p;
+	      opc->v[0].fi = opt_i_d_s;
+	      return_true(sc, car_x);
+	    }
+	  if (float_optimize(sc, cdr(car_x)))
+	    {
+	      opc->v[0].fi = opt_i_7d_f;
+	      opc->v[4].fd = sc->opts[start]->v[0].fd;
+	      return_true(sc, car_x);
+	    }
+	  sc->pc = start;
+	}}
+  ipf = s7_i_7p_function(s_func);
+  if (ipf)
+    {
+      opc->v[2].i_7p_f = ipf;
+      if (cell_optimize(sc, cdr(car_x)))
+	{
+	  opc->v[0].fi = (ipf == char_to_integer_i_7p) ? opt_i_7p_f_cint : opt_i_7p_f;
+	  opc->v[4].fp = sc->opts[start]->v[0].fp;
+	  return_true(sc, car_x);
+	}
+      sc->pc = start;
+    }
+  return_false(sc, car_x);
+}
+
+
+/* -------- i_pi -------- */
+
+static s7_int opt_i_7pi_ss(opt_info *o) {return(o->v[3].i_7pi_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p))));}
+static s7_int opt_i_pi_ss_ivref(opt_info *o) {return(int_vector(slot_value(o->v[1].p), integer(slot_value(o->v[2].p))));}
+static s7_int opt_i_pi_ss_bvref(opt_info *o) {return(byte_vector(slot_value(o->v[1].p), integer(slot_value(o->v[2].p))));}
+static s7_int opt_i_7pi_sf(opt_info *o) {return(o->v[3].i_7pi_f(o->sc, slot_value(o->v[1].p), o->v[5].fi(o->v[4].o1)));}
+
+static bool i_7pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  s7_pointer sig;
+  s7_i_7pi_t pfunc = s7_i_7pi_function(s_func);
+  if (!pfunc)
+    {
+      if ((s_func == initial_value(sc->vector_ref_symbol)) && (is_normal_symbol(cadr(car_x)))) /* (vector-ref <int-vector> <int>)? */
+	{
+	  s7_pointer v_slot = s7_slot(sc, cadr(car_x));
+	  if (is_slot(v_slot))
+	    {
+	      s7_pointer v = slot_value(v_slot);
+	      if (is_int_vector(v))
+		{
+		  pfunc = int_vector_ref_i_7pi;
+		  s_func = initial_value(sc->int_vector_ref_symbol);
+		  /* a normal vector can have vector-typer integer? if it's set after vector creation, but that can't be optimized much */
+		}
+	      else
+		if (is_byte_vector(v))
+		  {
+		    pfunc = byte_vector_ref_i_7pi;
+		    s_func = initial_value(sc->byte_vector_ref_symbol);
+		  }}}
+      if (!pfunc) return_false(sc, car_x);
+    }
+  sig = c_function_signature(s_func);
+  if (is_pair(sig))
+    {
+      s7_pointer slot, arg1 = cadr(car_x), arg2 = caddr(car_x);
+      int32_t start = sc->pc;
+      if ((is_symbol(cadr(sig))) &&
+	  (is_symbol(arg1)) &&
+	  (slot = opt_types_match(sc, cadr(sig), arg1)))
+	{
+	  s7_pointer p;
+	  opc->v[1].p = slot;
+	  if ((s_func == global_value(sc->int_vector_ref_symbol)) && /* ivref etc */
+	      ((!is_int_vector(slot_value(slot))) ||
+	       (vector_rank(slot_value(slot)) > 1)))
+	    return_false(sc, car_x);
+	  if ((s_func == global_value(sc->byte_vector_ref_symbol)) && /* bvref etc */
+	      ((!is_byte_vector(slot_value(slot))) ||
+	       (vector_rank(slot_value(slot)) > 1)))
+	    return_false(sc, car_x);
+
+	  opc->v[3].i_7pi_f = pfunc;
+	  p = opt_integer_symbol(sc, arg2);
+	  if (p)
+	    {
+	      opc->v[2].p = p;
+	      opc->v[0].fi = opt_i_7pi_ss;
+	      if ((s_func == global_value(sc->int_vector_ref_symbol)) &&
+		  (loop_end_fits(opc->v[2].p, vector_length(slot_value(opc->v[1].p)))))
+		{
+		  opc->v[0].fi = opt_i_pi_ss_ivref;
+		  opc->v[3].i_7pi_f = int_vector_ref_i_pi_direct;
+		}
+	      else
+		if ((s_func == global_value(sc->byte_vector_ref_symbol)) &&
+		    (loop_end_fits(opc->v[2].p, vector_length(slot_value(opc->v[1].p)))))
+		  {
+		    opc->v[0].fi = opt_i_pi_ss_bvref;
+		    opc->v[3].i_7pi_f = byte_vector_ref_i_7pi_direct;
+		  }
+	      return_true(sc, car_x);
+	    }
+	  opc->v[4].o1 = sc->opts[sc->pc];
+	  if (int_optimize(sc, cddr(car_x)))
+	    {
+	      opc->v[0].fi = opt_i_7pi_sf;
+	      opc->v[5].fi = opc->v[4].o1->v[0].fi;
+	      return_true(sc, car_x);
+	    }
+	  sc->pc = start;
+	}}
+  return_false(sc, car_x);
+}
+
+/* -------- i_ii -------- */
+static s7_int opt_i_ii_cc(opt_info *o)     {return(o->v[3].i_ii_f(o->v[1].i, o->v[2].i));}
+static s7_int opt_i_ii_cs(opt_info *o)     {return(o->v[3].i_ii_f(o->v[1].i, integer(slot_value(o->v[2].p))));}
+static s7_int opt_i_ii_cs_mul(opt_info *o) {return(o->v[1].i * integer(slot_value(o->v[2].p)));}
+static s7_int opt_i_ii_sc(opt_info *o)     {return(o->v[3].i_ii_f(integer(slot_value(o->v[1].p)), o->v[2].i));}
+static s7_int opt_i_ii_sc_add(opt_info *o) {return(integer(slot_value(o->v[1].p)) + o->v[2].i);} /* +1 is not faster */
+static s7_int opt_i_ii_sc_sub(opt_info *o) {return(integer(slot_value(o->v[1].p)) - o->v[2].i);} /* -1 is not faster */
+static s7_int opt_i_ii_ss(opt_info *o)     {return(o->v[3].i_ii_f(integer(slot_value(o->v[1].p)), integer(slot_value(o->v[2].p))));}
+static s7_int opt_i_ii_ss_add(opt_info *o) {return(integer(slot_value(o->v[1].p)) + integer(slot_value(o->v[2].p)));}
+static s7_pointer opt_p_ii_ss_add(opt_info *o) {return(make_integer(o->sc, integer(slot_value(o->v[1].p)) + integer(slot_value(o->v[2].p))));}
+static s7_int opt_i_ii_cf(opt_info *o)     {return(o->v[3].i_ii_f(o->v[1].i, o->v[5].fi(o->v[4].o1)));}
+static s7_int opt_i_ii_cf_mul(opt_info *o) {return(o->v[1].i * o->v[5].fi(o->v[4].o1));}
+static s7_int opt_i_ii_sf(opt_info *o)     {return(o->v[3].i_ii_f(integer(slot_value(o->v[1].p)), o->v[5].fi(o->v[4].o1)));}
+static s7_int opt_i_ii_sf_add(opt_info *o) {return(integer(slot_value(o->v[1].p)) + o->v[5].fi(o->v[4].o1));}
+static s7_int opt_i_ii_ff(opt_info *o)     {return(o->v[3].i_ii_f(o->v[11].fi(o->v[10].o1), o->v[9].fi(o->v[8].o1)));}
+static s7_int opt_i_7ii_ff_quo(opt_info *o){return(quotient_i_7ii(o->sc,o->v[11].fi(o->v[10].o1), o->v[9].fi(o->v[8].o1)));}
+static s7_int opt_i_ii_fc(opt_info *o)     {return(o->v[3].i_ii_f(o->v[11].fi(o->v[10].o1), o->v[2].i));}
+static s7_int opt_i_ii_fc_add(opt_info *o) {return(o->v[11].fi(o->v[10].o1) + o->v[2].i);}
+static s7_int opt_i_ii_fc_mul(opt_info *o) {return(o->v[11].fi(o->v[10].o1) * o->v[2].i);}
+/* returning s7_int so overflow->real is not doable here, so
+ *   (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (* (lognot 4294967297) 4294967297)))) (func) (func)
+ *   will return -12884901890 rather than -18446744086594454000.0, 4294967297 > sqrt(fixmost)
+ *   This affects all the opt arithmetical functions.  Unfortunately the gmp version also gets -12884901890!
+ *   We need to make sure none of these are available in the gmp version.
+ */
+static s7_int opt_i_7ii_fc(opt_info *o)    {return(o->v[3].i_7ii_f(o->sc, o->v[11].fi(o->v[10].o1), o->v[2].i));}
+static s7_int opt_i_ii_fco(opt_info *o)    {return(o->v[3].i_ii_f(o->v[4].i_7pi_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p))), o->v[5].i));}
+static s7_int opt_i_ii_fco_ivref_add(opt_info *o){return(int_vector_ref_i_pi_direct(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p))) + o->v[5].i);}  /* tref */
+static s7_int opt_i_7ii_fco(opt_info *o)   {return(o->v[3].i_7ii_f(o->sc, o->v[4].i_7pi_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p))), o->v[5].i));}
+
+static bool i_ii_fc_combinable(s7_scheme *sc, opt_info *opc, s7_i_ii_t func)
+{
+  if ((sc->pc > 1) &&
+      (opc == sc->opts[sc->pc - 2]))
+    {
+      opt_info *o1 = sc->opts[sc->pc - 1];
+      if ((o1->v[0].fi == opt_i_7pi_ss) || (o1->v[0].fi == opt_i_pi_ss_ivref))
+	{
+	  opc->v[5].i = opc->v[2].i; /* move v2.i ("c" in fc = arg2) out of the symbols' way */
+	  opc->v[4].i_7pi_f = o1->v[3].i_7pi_f;
+	  opc->v[1].p = o1->v[1].p;
+	  opc->v[2].p = o1->v[2].p;
+	  if (func)
+	    opc->v[0].fi = ((opc->v[3].i_ii_f == add_i_ii) && (opc->v[4].i_7pi_f == int_vector_ref_i_pi_direct)) ? opt_i_ii_fco_ivref_add : opt_i_ii_fco;
+	  else opc->v[0].fi = opt_i_7ii_fco;
+	  backup_pc(sc);
+	  return_true(sc, NULL);
+	}}
+  return_false(sc, NULL);
+}
+
+static s7_int opt_i_7ii_cc(opt_info *o) {return(o->v[3].i_7ii_f(o->sc, o->v[1].i, o->v[2].i));}
+static s7_int opt_i_7ii_cs(opt_info *o) {return(o->v[3].i_7ii_f(o->sc, o->v[1].i, integer(slot_value(o->v[2].p))));}
+static s7_int opt_i_7ii_sc(opt_info *o) {return(o->v[3].i_7ii_f(o->sc, integer(slot_value(o->v[1].p)), o->v[2].i));}
+static s7_int opt_i_7ii_ss(opt_info *o) {return(o->v[3].i_7ii_f(o->sc, integer(slot_value(o->v[1].p)), integer(slot_value(o->v[2].p))));}
+static s7_int opt_i_7ii_cf(opt_info *o) {return(o->v[3].i_7ii_f(o->sc, o->v[1].i, o->v[5].fi(o->v[4].o1)));}
+static s7_int opt_i_7ii_sf(opt_info *o) {return(o->v[3].i_7ii_f(o->sc, integer(slot_value(o->v[1].p)), o->v[5].fi(o->v[4].o1)));}
+
+static s7_int opt_i_7ii_ff(opt_info *o)
+{
+  s7_int i1 = o->v[11].fi(o->v[10].o1);
+  s7_int i2 = o->v[9].fi(o->v[8].o1);
+  return(o->v[3].i_7ii_f(o->sc, i1, i2));
+}
+
+#if WITH_GMP
+static s7_int opt_add_i_random_i(opt_info *o)      {return(o->v[1].i + (s7_int)(o->v[2].i * next_random(o->sc)));}
+static s7_int opt_subtract_random_i_i(opt_info *o) {return((s7_int)(o->v[1].i * next_random(o->sc)) - o->v[2].i);}
+#else
+static s7_int opt_add_i_random_i(opt_info *o)      {return(o->v[1].i + (s7_int)(o->v[2].i * next_random(o->sc->default_random_state)));}
+static s7_int opt_subtract_random_i_i(opt_info *o) {return((s7_int)(o->v[1].i * next_random(o->sc->default_random_state)) - o->v[2].i);}
+#endif
+
+static bool i_ii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  s7_i_ii_t ifunc = s7_i_ii_function(s_func);
+  s7_i_7ii_t ifunc7 = NULL;
+  s7_pointer sig;
+
+  if (!ifunc)
+    {
+      ifunc7 = s7_i_7ii_function(s_func);
+      if (!ifunc7)
+	return_false(sc, car_x);
+    }
+  sig = c_function_signature(s_func);
+  if (is_pair(sig))
+    {
+      s7_pointer arg1 = cadr(car_x);
+      s7_pointer arg2 = caddr(car_x);
+      int32_t start = sc->pc;
+      s7_pointer p;
+      if (ifunc)
+	opc->v[3].i_ii_f = ifunc;
+      else opc->v[3].i_7ii_f = ifunc7;
+
+      if (is_t_integer(arg1))
+	{
+	  opc->v[1].i = integer(arg1);
+	  if (is_t_integer(arg2))
+	    {
+	      if (opc->v[3].i_ii_f == add_i_ii)
+		{
+		  opc->v[1].i = integer(arg1) + integer(arg2); /* no overflow check for sc_add case above */
+		  opc->v[0].fi = opt_i_c;
+		}
+	      else
+		{
+		  opc->v[2].i = integer(arg2);
+		  opc->v[0].fi = (ifunc) ? opt_i_ii_cc : opt_i_7ii_cc;
+		}
+	      return_true(sc, car_x);
+	    }
+	  p = opt_integer_symbol(sc, arg2);
+	  if (p)
+	    {
+	      opc->v[2].p = p;
+	      if (ifunc)
+		opc->v[0].fi = (opc->v[3].i_ii_f == multiply_i_ii) ? opt_i_ii_cs_mul : opt_i_ii_cs;
+	      else opc->v[0].fi = opt_i_7ii_cs;
+	      return_true(sc, car_x);
+	    }
+	  opc->v[4].o1 = sc->opts[sc->pc];
+	  if (int_optimize(sc, cddr(car_x)))
+	    {
+	      if (ifunc)
+		{
+		  opc->v[0].fi = opt_i_ii_cf;       /* sc->opts[start]->v[0].fi -> opt_i_7i_c -> same_opt->v[2].i_7i_f = random_i_7i tmap */
+		  if ((ifunc == add_i_ii) && (opc == sc->opts[sc->pc - 2]) &&
+		      (sc->opts[start]->v[0].fi == opt_i_7i_c) &&
+		      (sc->opts[start]->v[2].i_7i_f == random_i_7i))
+		    {
+		      opc->v[0].fi = opt_add_i_random_i;
+		      opc->v[2].i = sc->opts[start]->v[1].i;
+		      backup_pc(sc);
+		    }
+		  else if (ifunc == multiply_i_ii) opc->v[0].fi = opt_i_ii_cf_mul;
+		}
+	      else opc->v[0].fi = opt_i_7ii_cf;
+	      opc->v[5].fi = opc->v[4].o1->v[0].fi;
+	      return_true(sc, car_x);
+	    }
+	  sc->pc = start;
+	  return_false(sc, car_x);
+	}
+
+      /* arg1 not integer */
+      p = opt_integer_symbol(sc, arg1);
+      if (p)
+	{
+	  opc->v[1].p = p;
+	  if (is_t_integer(arg2))
+	    {
+	      opc->v[2].i = integer(arg2);
+	      if (ifunc)
+		{
+		  if (opc->v[3].i_ii_f == add_i_ii)
+		    opc->v[0].fi = opt_i_ii_sc_add;
+		  else opc->v[0].fi = (opc->v[3].i_ii_f == subtract_i_ii) ? opt_i_ii_sc_sub : opt_i_ii_sc; /* add1/sub1 are not faster */
+		}
+	      else opc->v[0].fi = opt_i_7ii_sc;
+	      if ((car(car_x) == sc->modulo_symbol) &&
+		  (integer(arg2) > 1))
+		opc->v[3].i_ii_f = modulo_i_ii_unchecked;
+	      else
+		{
+		  if (car(car_x) == sc->ash_symbol)
+		    {
+		      if (opc->v[2].i < 0)
+			{
+			  opc->v[3].i_ii_f = (opc->v[2].i == -1) ? rsh_i_i2_direct : rsh_i_ii_unchecked;
+			  opc->v[0].fi = opt_i_ii_sc;
+			}
+		      else
+			if (opc->v[2].i < S7_INT_BITS)
+			  {
+			    opc->v[3].i_ii_f = lsh_i_ii_unchecked;
+			    opc->v[0].fi = opt_i_ii_sc;
+			  }}
+		  else
+		    if (opc->v[2].i > 0)
+		      {
+			/* these assume vunion is a union, not a struct; i_7ii_f otherwise might be leftover from a previous use */
+			if (opc->v[3].i_7ii_f == quotient_i_7ii)
+			  {
+			    opc->v[3].i_ii_f = quotient_i_ii_unchecked;
+			    opc->v[0].fi = opt_i_ii_sc;
+			  }
+			else
+			  if ((opc->v[2].i > 1) && (opc->v[3].i_7ii_f == remainder_i_7ii))
+			    {
+			      opc->v[3].i_ii_f = remainder_i_ii_unchecked;
+			      opc->v[0].fi = opt_i_ii_sc;
+			    }}}
+	      return_true(sc, car_x);
+	    }
+
+	  /* arg2 not integer, arg1 is int symbol */
+	  p = opt_integer_symbol(sc, arg2);
+	  if (p)
+	    {
+	      opc->v[2].p = p;
+	      if (ifunc)
+		opc->v[0].fi = (opc->v[3].i_ii_f == add_i_ii) ? opt_i_ii_ss_add : opt_i_ii_ss;
+	      else opc->v[0].fi = opt_i_7ii_ss;
+	      return_true(sc, car_x);
+	    }
+	  if (int_optimize(sc, cddr(car_x)))
+	    {
+	      opc->v[4].o1 = sc->opts[start];
+	      opc->v[5].fi = sc->opts[start]->v[0].fi;
+	      if (ifunc)
+		opc->v[0].fi = (opc->v[3].i_ii_f == add_i_ii) ? opt_i_ii_sf_add : opt_i_ii_sf;
+	      else opc->v[0].fi = opt_i_7ii_sf;
+	      return_true(sc, car_x);
+	    }
+	  sc->pc = start;
+	  return_false(sc, car_x);
+	}
+
+      /* arg1 not int symbol */
+      if (is_t_integer(arg2))
+	{
+	  opc->v[2].i = integer(arg2);
+	  opc->v[10].o1 = sc->opts[sc->pc];
+	  if (int_optimize(sc, cdr(car_x)))
+	    {
+	      opc->v[11].fi = opc->v[10].o1->v[0].fi;
+	      if (!i_ii_fc_combinable(sc, opc, ifunc))
+		{
+		  if (ifunc)
+		    {
+		      if (opc->v[3].i_ii_f == add_i_ii) {opc->v[0].fi = opt_i_ii_fc_add; return_true(sc, car_x);}
+		      if (opc->v[3].i_ii_f == multiply_i_ii) {opc->v[0].fi = opt_i_ii_fc_mul; return_true(sc, car_x);}
+		      opc->v[0].fi = opt_i_ii_fc;
+
+		      if ((opc->v[3].i_ii_f == subtract_i_ii) && (opc == sc->opts[sc->pc - 2]) &&
+			  (sc->opts[start]->v[0].fi == opt_i_7i_c) &&
+			  (sc->opts[start]->v[2].i_7i_f == random_i_7i))
+			{
+			  opc->v[0].fi = opt_subtract_random_i_i;
+			  opc->v[1].i = sc->opts[start]->v[1].i;
+			  backup_pc(sc);
+			}}
+		  else opc->v[0].fi = opt_i_7ii_fc;
+		  if (opc->v[2].i > 0)
+		    {
+		      if (opc->v[3].i_7ii_f == quotient_i_7ii)
+			{
+			  opc->v[3].i_ii_f = quotient_i_ii_unchecked;
+			  opc->v[0].fi = opt_i_ii_fc;
+			}
+		      else
+			if ((opc->v[2].i > 1) && (opc->v[3].i_7ii_f == remainder_i_7ii))
+			  {
+			    opc->v[3].i_ii_f = remainder_i_ii_unchecked;
+			    opc->v[0].fi = opt_i_ii_fc;
+			  }}}
+	      return_true(sc, car_x);
+	    }
+	  sc->pc = start;
+	  return_false(sc, car_x);
+	}
+
+      /* arg1 not integer or symbol, arg2 not integer */
+      opc->v[10].o1 = sc->opts[sc->pc];
+      if (int_optimize(sc, cdr(car_x)))
+	{
+	  opc->v[11].fi = opc->v[10].o1->v[0].fi;
+	  opc->v[8].o1 = sc->opts[sc->pc];
+	  if (int_optimize(sc, cddr(car_x)))
+	    {
+	      opc->v[9].fi = opc->v[8].o1->v[0].fi;
+	      opc->v[0].fi = (ifunc) ? opt_i_ii_ff : ((opc->v[3].i_7ii_f == quotient_i_7ii) ? opt_i_7ii_ff_quo : opt_i_7ii_ff);
+	      return_true(sc, car_x);
+	    }
+	  sc->pc = start;
+	}}
+  return_false(sc, car_x);
+}
+
+/* -------- i_iii -------- */
+static s7_int opt_i_iii_fff(opt_info *o)
+{
+  s7_int i1 = o->v[11].fi(o->v[10].o1);
+  s7_int i2 = o->v[9].fi(o->v[8].o1);
+  s7_int i3 = o->v[5].fi(o->v[4].o1);
+  return(o->v[3].i_iii_f(i1, i2, i3));
+}
+
+static bool i_iii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  int32_t start = sc->pc;
+  s7_i_iii_t ifunc = s7_i_iii_function(s_func);
+  if (!ifunc)
+    return_false(sc, car_x);
+  opc->v[10].o1 = sc->opts[start];
+  if (int_optimize(sc, cdr(car_x)))
+    {
+      opc->v[8].o1 = sc->opts[sc->pc];
+      if (int_optimize(sc, cddr(car_x)))
+	{
+	  opc->v[4].o1 = sc->opts[sc->pc];
+	  if (int_optimize(sc, cdddr(car_x)))
+	    {
+	      opc->v[3].i_iii_f = ifunc;
+	      opc->v[0].fi = opt_i_iii_fff;
+	      opc->v[11].fi = opc->v[10].o1->v[0].fi;
+	      opc->v[9].fi = opc->v[8].o1->v[0].fi;
+	      opc->v[5].fi = opc->v[4].o1->v[0].fi;
+	      return_true(sc, car_x);
+	    }}}
+  sc->pc = start;
+  return_false(sc, car_x);
+}
+
+/* -------- i_7pii -------- */
+static s7_int opt_i_7pii_ssf(opt_info *o) {return(o->v[3].i_7pii_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o->v[5].fi(o->v[4].o1)));}
+static s7_int opt_i_7pii_ssf_vset(opt_info *o) {return(int_vector_set_i_7pii_direct(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o->v[5].fi(o->v[4].o1)));}
+static s7_int opt_i_7pii_ssc(opt_info *o) {return(o->v[3].i_7pii_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o->v[4].i));}
+static s7_int opt_i_7pii_sss(opt_info *o) {return(o->v[4].i_7pii_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), integer(slot_value(o->v[3].p))));}
+static s7_int opt_i_7pii_sif(opt_info *o) {return(o->v[3].i_7pii_f(o->sc, slot_value(o->v[1].p), o->v[12].i, o->v[9].fi(o->v[8].o1)));}
+
+static s7_int opt_i_pii_sss_ivref_unchecked(opt_info *o)
+{
+  s7_pointer v = slot_value(o->v[1].p);
+  return(int_vector(v, ((integer(slot_value(o->v[2].p)) * vector_offset(v, 0)) + integer(slot_value(o->v[3].p)))));
+}
+
+static s7_int opt_i_7pii_sff(opt_info *o)
+{
+  s7_int i1 = o->v[11].fi(o->v[10].o1);
+  s7_int i2 = o->v[9].fi(o->v[8].o1);
+  return(o->v[3].i_7pii_f(o->sc, slot_value(o->v[1].p), i1, i2));
+}
+
+/* -------- i_7piii -------- */
+static s7_int opt_i_7piii_sssf(opt_info *o)
+{
+  return(o->v[5].i_7piii_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), integer(slot_value(o->v[3].p)), o->v[11].fi(o->v[10].o1)));
+}
+
+static s7_int opt_i_piii_sssf_ivset_unchecked(opt_info *o)
+{
+  s7_pointer v = slot_value(o->v[1].p);
+  s7_int val = o->v[11].fi(o->v[10].o1);
+  int_vector(v, ((integer(slot_value(o->v[2].p)) * vector_offset(v, 0)) + integer(slot_value(o->v[3].p)))) = val;
+  return(val);
+}
+
+static s7_int opt_i_7piii_sssc(opt_info *o)
+{
+  return(o->v[5].i_7piii_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), integer(slot_value(o->v[3].p)), o->v[4].i));
+}
+
+static s7_int opt_i_7piii_ssss(opt_info *o)
+{
+  return(o->v[5].i_7piii_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), integer(slot_value(o->v[3].p)), integer(slot_value(o->v[4].p))));
+}
+
+static s7_int opt_i_7piii_sfff(opt_info *o)
+{
+  s7_int i1 = o->v[11].fi(o->v[10].o1);
+  s7_int i2 = o->v[9].fi(o->v[8].o1);
+  s7_int i3 = o->v[6].fi(o->v[4].o1);
+  return(o->v[5].i_7piii_f(o->sc, slot_value(o->v[1].p), i1, i2, i3));
+}
+
+static bool opt_i_7piii_args(s7_scheme *sc, opt_info *opc, s7_pointer indexp1, s7_pointer indexp2, s7_pointer valp)
+{
+  /* opc->v[5] is the called function (int-vector-set! etc) */
+  s7_pointer slot = opt_integer_symbol(sc, car(indexp2));
+  if (slot)
+    {
+      opc->v[3].p = slot;
+      slot = opt_integer_symbol(sc, car(indexp1));
+      if (slot)
+	{
+	  opc->v[2].p = slot;
+	  if (is_t_integer(car(valp)))
+	    {
+	      opc->v[0].fi = opt_i_7piii_sssc;
+	      opc->v[4].i = integer(car(valp));
+	      return_true(sc, NULL);
+	    }
+	  slot = opt_integer_symbol(sc, car(valp));
+	  if (slot)
+	    {
+	      opc->v[4].p = slot;
+	      opc->v[0].fi = opt_i_7piii_ssss;
+	      return_true(sc, NULL);
+	    }
+	  opc->v[10].o1 = sc->opts[sc->pc];
+	  if (int_optimize(sc, valp))
+	    {
+	      opc->v[11].fi = opc->v[10].o1->v[0].fi;
+	      opc->v[0].fi = opt_i_7piii_sssf;
+	      if ((opc->v[5].i_7piii_f == int_vector_set_i_7piii) &&
+		  (loop_end_fits(opc->v[2].p, vector_dimension(slot_value(opc->v[1].p), 0))) &&
+		  (loop_end_fits(opc->v[3].p, vector_dimension(slot_value(opc->v[1].p), 1))))
+		opc->v[0].fi = opt_i_piii_sssf_ivset_unchecked;
+	      return_true(sc, NULL);
+	    }}
+      return_false(sc, valp);
+    }
+  opc->v[10].o1 = sc->opts[sc->pc];
+  if (int_optimize(sc, indexp1))
+    {
+      opc->v[8].o1 = sc->opts[sc->pc];
+      if (int_optimize(sc, indexp2))
+	{
+	  opc->v[4].o1 = sc->opts[sc->pc];
+	  if (int_optimize(sc, valp))
+	    {
+	      opc->v[0].fi = opt_i_7piii_sfff;
+	      opc->v[11].fi = opc->v[10].o1->v[0].fi;
+	      opc->v[9].fi = opc->v[8].o1->v[0].fi;
+	      opc->v[6].fi = opc->v[4].o1->v[0].fi; /* v[5] is in use */
+	      return_true(sc, NULL);
+	    }}}
+  return_false(sc, indexp1);
+}
+
+static bool opt_int_vector_set(s7_scheme *sc, int32_t otype, opt_info *opc, s7_pointer v, s7_pointer indexp1, s7_pointer indexp2, s7_pointer valp)
+{
+  s7_pointer settee = s7_slot(sc, v);
+  if ((is_slot(settee)) &&
+      (!is_immutable(slot_value(settee))))
+    {
+      s7_pointer slot, vect = slot_value(settee);
+      bool int_case = (is_int_vector(vect));
+      opc->v[1].p = settee;
+      if ((int_case) || (is_byte_vector(vect)))
+	{
+	  if ((otype >= 0) && (otype != ((int_case) ? 1 : 0)))
+	    return_false(sc, indexp1);
+	  if ((!indexp2) &&
+	      (vector_rank(vect) == 1))
+	    {
+	      opc->v[3].i_7pii_f = (int_case) ? int_vector_set_i_7pii : byte_vector_set_i_7pii;
+	      slot = opt_integer_symbol(sc, car(indexp1));
+	      if (slot)
+		{
+		  int32_t start = sc->pc;
+		  opc->v[2].p = slot;
+		  if (loop_end_fits(opc->v[2].p, vector_length(vect)))
+		    opc->v[3].i_7pii_f = (int_case) ? int_vector_set_i_7pii_direct : byte_vector_set_i_7pii_direct;
+		  if ((is_pair(valp)) &&
+		      (is_null(cdr(valp))) &&
+		      (is_t_integer(car(valp))))
+		    {
+		      opc->v[4].i = integer(car(valp));
+		      opc->v[0].fi = opt_i_7pii_ssc;
+		      return_true(sc, NULL);
+		    }
+		  if (!int_optimize(sc, valp))
+		    return_false(sc, valp);
+		  opc->v[0].fi = (opc->v[3].i_7pii_f == int_vector_set_i_7pii_direct) ? opt_i_7pii_ssf_vset : opt_i_7pii_ssf;
+		  opc->v[4].o1 = sc->opts[start];
+		  opc->v[5].fi = sc->opts[start]->v[0].fi;
+		  return_true(sc, NULL);
+		}
+	      opc->v[10].o1 = sc->opts[sc->pc];
+	      if (int_optimize(sc, indexp1))
+		{
+		  opc->v[8].o1 = sc->opts[sc->pc];
+		  if (int_optimize(sc, valp))
+		    {
+		      opc->v[11].fi = opc->v[10].o1->v[0].fi;
+		      opc->v[9].fi = opc->v[8].o1->v[0].fi;
+		      if (opc->v[11].fi == opt_i_c) /* (int-vector-set! v 0 (floor (sqrt i))) */
+			{
+			  opc->v[0].fi = opt_i_7pii_sif;
+			  opc->v[12].i = opc->v[10].o1->v[1].i;
+			}
+		      else opc->v[0].fi = opt_i_7pii_sff;
+		      return_true(sc, NULL);
+		    }}
+	      return_false(sc, valp);
+	    }
+	  if ((indexp2) &&
+	      (vector_rank(vect) == 2))
+	    {
+	      opc->v[5].i_7piii_f = (int_case) ? int_vector_set_i_7piii : byte_vector_set_i_7piii;
+	      return(opt_i_7piii_args(sc, opc, indexp1, indexp2, valp));
+	    }}}
+  return_false(sc, v);
+}
+
+static bool is_target_or_its_alias(const s7_pointer symbol, const s7_pointer symfunc, s7_pointer target)
+{
+  return((symbol == target) || (symfunc == initial_value(target)));
+}
+
+static bool i_7pii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  s7_pointer sig;
+  s7_i_7pii_t pfunc = s7_i_7pii_function(s_func);
+  if (!pfunc)
+    return_false(sc, car_x);
+  sig = c_function_signature(s_func);
+  if ((is_pair(sig)) &&
+      (is_symbol(cadr(car_x))))
+    {
+      s7_pointer slot, fname = car(car_x);
+
+      if ((is_target_or_its_alias(fname, s_func, sc->int_vector_set_symbol)) ||
+	  (is_target_or_its_alias(fname, s_func, sc->byte_vector_set_symbol)))
+	return(opt_int_vector_set(sc, (fname == sc->int_vector_set_symbol) ? 1 : 0, opc, cadr(car_x), cddr(car_x), NULL, cdddr(car_x)));
+
+      slot = opt_types_match(sc, cadr(sig), cadr(car_x));
+      if (slot)
+	{
+	  s7_pointer arg2, p;
+	  int32_t start = sc->pc;
+	  opc->v[1].p = slot;
+
+	  if (((is_target_or_its_alias(fname, s_func, sc->int_vector_ref_symbol)) ||
+	       (is_target_or_its_alias(fname, s_func, sc->byte_vector_ref_symbol))) &&
+	      (vector_rank(slot_value(slot)) != 2))
+	    return_false(sc, car_x);
+
+	  arg2 = caddr(car_x);
+	  p = opt_integer_symbol(sc, arg2);
+	  if (p)
+	    {
+	      opc->v[2].p = p;
+	      p = opt_integer_symbol(sc, cadddr(car_x));
+	      if (p)
+		{
+		  opc->v[3].p = p;
+		  opc->v[4].i_7pii_f = pfunc;
+		  opc->v[0].fi = opt_i_7pii_sss;
+		  if ((pfunc == int_vector_ref_i_7pii) &&
+		      (loop_end_fits(opc->v[2].p, vector_dimension(slot_value(opc->v[1].p), 0))) &&
+		      (loop_end_fits(opc->v[3].p, vector_dimension(slot_value(opc->v[1].p), 1))))
+		    opc->v[0].fi = opt_i_pii_sss_ivref_unchecked;
+		  return_true(sc, car_x);
+		}
+	      if (int_optimize(sc, cdddr(car_x)))
+		{
+		  opc->v[3].i_7pii_f = pfunc;
+		  opc->v[0].fi = opt_i_7pii_ssf;
+		  opc->v[4].o1 = sc->opts[start];
+		  opc->v[5].fi = sc->opts[start]->v[0].fi;
+		  return_true(sc, car_x);
+		}
+	      return_false(sc, car_x);
+	    }
+	  opc->v[10].o1 = sc->opts[sc->pc];
+	  if (int_optimize(sc, cddr(car_x)))
+	    {
+	      opc->v[8].o1 = sc->opts[sc->pc];
+	      if (int_optimize(sc, cdddr(car_x)))
+		{
+		  opc->v[3].i_7pii_f = pfunc;
+		  opc->v[0].fi = opt_i_7pii_sff;
+		  opc->v[11].fi = opc->v[10].o1->v[0].fi;
+		  opc->v[9].fi = opc->v[8].o1->v[0].fi;
+		  return_true(sc, car_x);
+		}}
+	  sc->pc = start;
+	}}
+  return_false(sc, car_x);
+}
+
+static bool i_7piii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  s7_i_7piii_t f = s7_i_7piii_function(s_func);
+  if ((f) &&
+      (is_symbol(cadr(car_x))))
+    {
+      s7_pointer settee;
+      if ((is_target_or_its_alias(car(car_x), s_func, sc->int_vector_set_symbol)) ||
+	  (is_target_or_its_alias(car(car_x), s_func, sc->byte_vector_set_symbol)))
+	return(opt_int_vector_set(sc, (car(car_x) == sc->int_vector_set_symbol) ? 1 : 0, opc, cadr(car_x), cddr(car_x), cdddr(car_x), cddddr(car_x)));
+
+      settee = s7_slot(sc, cadr(car_x));
+      if (is_slot(settee))
+	{
+	  s7_pointer vect = slot_value(settee);
+	  if ((is_int_vector(vect)) && (vector_rank(vect) == 3))
+	    {
+	      opc->v[5].i_7piii_f = f;
+	      opc->v[1].p = settee;
+	      return(opt_i_7piii_args(sc, opc, cddr(car_x), cdddr(car_x), cddddr(car_x)));
+	    }}}
+  return_false(sc, car_x);
+}
+
+/* -------- i_add|multiply_any -------- */
+static s7_int opt_i_add_any_f(opt_info *o)
+{
+  s7_int sum = 0;
+  for (s7_int i = 0; i < o->v[1].i; i++)
+    {
+      opt_info *o1 = o->v[i + 2].o1;
+      sum += o1->v[0].fi(o1);
+    }
+  return(sum);
+}
+
+static s7_int opt_i_add2(opt_info *o)
+{
+  s7_int sum = o->v[6].fi(o->v[2].o1);
+  return(sum + o->v[7].fi(o->v[3].o1));
+}
+
+static s7_int opt_i_mul2(opt_info *o)
+{
+  s7_int sum = o->v[6].fi(o->v[2].o1);
+  return(sum * o->v[7].fi(o->v[3].o1));
+}
+
+static s7_int opt_i_add3(opt_info *o)
+{
+  s7_int sum = o->v[6].fi(o->v[2].o1);
+  sum += o->v[7].fi(o->v[3].o1);
+  return(sum + o->v[8].fi(o->v[4].o1));
+}
+
+static s7_int opt_i_mul3(opt_info *o)
+{
+  s7_int sum = o->v[6].fi(o->v[2].o1);
+  sum *= o->v[7].fi(o->v[3].o1);
+  return(sum * o->v[8].fi(o->v[4].o1));
+}
+
+static s7_int opt_i_add4(opt_info *o)
+{
+  s7_int sum = o->v[6].fi(o->v[2].o1);
+  sum += o->v[7].fi(o->v[3].o1);
+  sum += o->v[8].fi(o->v[4].o1);
+  return(sum + o->v[9].fi(o->v[5].o1));
+}
+
+static s7_int opt_i_mul4(opt_info *o)
+{
+  s7_int sum = o->v[6].fi(o->v[2].o1);
+  sum *= o->v[7].fi(o->v[3].o1);
+  sum *= o->v[8].fi(o->v[4].o1);
+  return(sum * o->v[9].fi(o->v[5].o1));
+}
+
+static s7_int opt_i_multiply_any_f(opt_info *o)
+{
+  s7_int sum = 1;
+  for (s7_int i = 0; i < o->v[1].i; i++)
+    {
+      opt_info *o1 = o->v[i + 2].o1;
+      sum *= o1->v[0].fi(o1);
+    }
+  return(sum);
+}
+
+static bool i_add_any_ok(s7_scheme *sc, opt_info *opc, s7_pointer car_x)
+{
+  s7_pointer p, head = car(car_x);
+  int32_t cur_len, start = sc->pc;
+  for (cur_len = 0, p = cdr(car_x); (is_pair(p)) && (cur_len < 12); p = cdr(p), cur_len++)
+    {
+      opc->v[cur_len + 2].o1 = sc->opts[sc->pc];
+      if (!int_optimize(sc, p))
+	break;
+    }
+  if (is_null(p))
+    {
+      opc->v[1].i = cur_len;
+      if (cur_len <= 4)
+	for (int32_t i = 0; i < cur_len; i++)
+	  opc->v[i + 6].fi = opc->v[i + 2].o1->v[0].fi;
+      if (cur_len == 2)
+	opc->v[0].fi = (head == sc->add_symbol) ? opt_i_add2 : opt_i_mul2;
+      else
+	if (cur_len == 3)
+	  opc->v[0].fi = (head == sc->add_symbol) ? opt_i_add3 : opt_i_mul3;
+	else
+	  if (cur_len == 4)
+	    opc->v[0].fi = (head == sc->add_symbol) ? opt_i_add4 : opt_i_mul4;
+	  else opc->v[0].fi = (head == sc->add_symbol) ? opt_i_add_any_f : opt_i_multiply_any_f;
+      return_true(sc, car_x);
+    }
+  sc->pc = start;
+  return_false(sc, car_x);
+}
+
+
+/* -------- set_i_i -------- */
+static s7_int opt_set_i_i_f(opt_info *o)
+{
+  s7_int x = o->v[3].fi(o->v[2].o1);
+  slot_set_value(o->v[1].p, make_integer(o->sc, x));
+  return(x);
+}
+
+#if S7_DEBUGGING
+static void check_mutability(s7_scheme *sc, opt_info *o, const char *func, int line)
+{
+  if (!is_mutable_number(slot_value(o->v[1].p)))
+    {
+      fprintf(stderr, "%s[%d]: %s value is not mutable", func, line, display(o->v[1].p));
+      if (sc->stop_at_error) abort();
+    }
+}
+#else
+#define check_mutability(Sc, O, Func, Line)
+#endif
+
+static s7_int opt_set_i_i_fm(opt_info *o) /* called in increment: (set! sum (+ sum (...))) where all are ints */
+{
+  s7_int x = o->v[3].fi(o->v[2].o1);
+  check_mutability(o->sc, o, __func__, __LINE__);
+  set_integer(slot_value(o->v[1].p), x);
+  return(x);
+}
+
+static s7_int opt_set_i_i_fo(opt_info *o)
+{
+  s7_int x = integer(slot_value(o->v[3].p)) + o->v[2].i;
+  slot_set_value(o->v[1].p, make_integer(o->sc, x));
+  return(x);
+}
+
+static s7_int opt_set_i_i_fom(opt_info *o)
+{
+  s7_int x = integer(slot_value(o->v[3].p)) + o->v[2].i;
+  check_mutability(o->sc, o, __func__, __LINE__);
+  set_integer(slot_value(o->v[1].p), x);
+  return(x);
+}
+
+static bool set_i_i_f_combinable(s7_scheme *sc, opt_info *opc)
+{
+  if ((sc->pc > 1) &&
+      (opc == sc->opts[sc->pc - 2]))
+    {
+      opt_info *o1 = sc->opts[sc->pc - 1];
+      if (o1->v[0].fi == opt_i_ii_sc_add)
+	{
+	  /* opc->v[4].i_ii_f = o1->v[3].i_ii_f; */
+	  opc->v[3].p = o1->v[1].p;
+	  opc->v[2].i = o1->v[2].i;
+	  opc->v[0].fi = opt_set_i_i_fo;
+	  backup_pc(sc);
+	  return_true(sc, NULL); /* ii_sc v[1].p is a slot */
+	}}
+  return_false(sc, NULL);
+}
+
+static bool i_syntax_ok(s7_scheme *sc, s7_pointer car_x, int32_t len)
+{
+  if ((car(car_x) == sc->set_symbol) &&
+      (len == 3))
+    {
+      s7_pointer arg1 = cadr(car_x);
+      opt_info *opc = alloc_opt_info(sc);
+      if (is_symbol(arg1))  /* (set! i 3) */
+	{
+	  s7_pointer settee;
+	  if (is_immutable(arg1))
+	    return_false(sc, car_x);
+	  settee = s7_slot(sc, arg1);
+	  if ((is_slot(settee)) &&
+	      (is_t_integer(slot_value(settee))) &&
+	      (!is_immutable_slot(settee)) &&
+	      ((!slot_has_setter(settee)) ||
+	       ((is_c_function(slot_setter(settee))) &&
+		((slot_setter(settee) == initial_value(sc->is_integer_symbol)) ||
+		 (c_function_call(slot_setter(settee)) == b_is_integer_setter)))))
+	    /* opt set! won't change type, and it is an integer now (and we might not hit opt_cell_set) */
+	    {
+	      opt_info *o1 = sc->opts[sc->pc];
+	      opc->v[1].p = settee;
+	      if (int_optimize(sc, cddr(car_x)))
+		{
+		  if (set_i_i_f_combinable(sc, opc))
+		    return_true(sc, car_x);
+		  opc->v[0].fi = (is_mutable_integer(slot_value(opc->v[1].p))) ? opt_set_i_i_fm : opt_set_i_i_f;
+		  /* only a few opt_set_i_i_f|fo's remain in valcall suite */
+		  opc->v[2].o1 = o1;
+		  opc->v[3].fi = o1->v[0].fi;
+		  return_true(sc, car_x);
+		}}}
+      else
+	if ((is_pair(arg1)) &&    /* if is_pair(settee) get setter */
+	    (is_symbol(car(arg1))) &&
+	    (is_pair(cdr(arg1))))
+	  {
+	    if (is_null(cddr(arg1)))
+	      return(opt_int_vector_set(sc, -1, opc, car(arg1), cdr(arg1), NULL, cddr(car_x)));
+	    if (is_null(cdddr(arg1)))
+	      return(opt_int_vector_set(sc, -1, opc, car(arg1), cdr(arg1), cddr(arg1), cddr(car_x)));
+	  }}
+  return_false(sc, car_x);
+}
+
+static bool i_implicit_ok(s7_scheme *sc, s7_pointer s_slot, s7_pointer car_x, int32_t len)
+{
+  s7_pointer obj = slot_value(s_slot);
+  if ((is_int_vector(obj)) || (is_byte_vector(obj)))
+    {
+      bool int_case = is_int_vector(obj);
+      s7_pointer slot;
+
+      if ((len == 2) &&
+	  (vector_rank(obj) == 1))
+	{
+	  opt_info *opc = alloc_opt_info(sc);
+	  opc->v[1].p = s_slot;
+	  slot = opt_integer_symbol(sc, cadr(car_x));
+	  if (slot)
+	    {
+	      opc->v[0].fi = opt_i_7pi_ss;
+	      opc->v[3].i_7pi_f = (int_case) ? int_vector_ref_i_7pi : byte_vector_ref_i_7pi;
+	      opc->v[2].p = slot;
+	      if (loop_end_fits(opc->v[2].p, vector_length(obj)))
+		opc->v[3].i_7pi_f = (int_case) ? int_vector_ref_i_pi_direct : byte_vector_ref_i_7pi_direct;
+		  /* not opc->v[0].fi = opt_i_pi_ss_ivref -- this causes a huge slowdown in dup.scm?? */
+	      return_true(sc, car_x);
+	    }
+	  opc->v[4].o1 = sc->opts[sc->pc];
+	  if (!int_optimize(sc, cdr(car_x)))
+	    return_false(sc, car_x);
+	  opc->v[0].fi = opt_i_7pi_sf;
+	  opc->v[3].i_7pi_f = (int_case) ? int_vector_ref_i_7pi : byte_vector_ref_i_7pi;
+	  opc->v[5].fi = opc->v[4].o1->v[0].fi;
+	  return_true(sc, car_x);
+	}
+      if ((len == 3) &&
+	  (vector_rank(obj) == 2))
+	{
+	  opt_info *opc = alloc_opt_info(sc);
+	  opc->v[1].p = s_slot;
+	  slot = opt_integer_symbol(sc, cadr(car_x));
+	  if (slot)
+	    {
+	      opc->v[2].p = slot;
+	      slot = opt_integer_symbol(sc, caddr(car_x));
+	      if (!slot)
+		return_false(sc, car_x);
+	      opc->v[4].i_7pii_f = (int_case) ? int_vector_ref_i_7pii : byte_vector_ref_i_7pii;
+	      opc->v[3].p = slot;
+	      opc->v[0].fi = opt_i_7pii_sss;
+	      if ((int_case) &&
+		  (loop_end_fits(opc->v[2].p, vector_dimension(obj, 0))) &&
+		  (loop_end_fits(opc->v[3].p, vector_dimension(obj, 1))))
+		opc->v[0].fi = opt_i_pii_sss_ivref_unchecked;
+	      return_true(sc, car_x);
+	    }
+	  opc->v[10].o1 = sc->opts[sc->pc];
+	  if (int_optimize(sc, cdr(car_x)))
+	    {
+	      opc->v[8].o1 = sc->opts[sc->pc];
+	      if (int_optimize(sc, cddr(car_x)))
+		{
+		  opc->v[3].i_7pii_f = (int_case) ? int_vector_ref_i_7pii : byte_vector_ref_i_7pii;
+		  opc->v[0].fi = opt_i_7pii_sff;
+		  opc->v[11].fi = opc->v[10].o1->v[0].fi;
+		  opc->v[9].fi = opc->v[8].o1->v[0].fi;
+		  return_true(sc, car_x);
+		}}}}
+  return_false(sc, car_x);
+}
+
+
+/* ------------------------------------- float opts ------------------------------------------- */
+static s7_double opt_d_c(opt_info *o) {return(o->v[1].x);}
+static s7_double opt_d_s(opt_info *o) {return(real(slot_value(o->v[1].p)));}
+
+static s7_double opt_D_s(opt_info *o)
+{
+  s7_pointer x = slot_value(o->v[1].p);
+  return((is_t_integer(x)) ? (s7_double)(integer(x)) : s7_number_to_real(o->sc, x));
+}
+
+static bool opt_float_not_pair(s7_scheme *sc, s7_pointer car_x)
+{
+  s7_pointer p;
+  if (is_small_real(car_x))
+    {
+      opt_info *opc = alloc_opt_info(sc);
+      opc->v[1].x = s7_number_to_real(sc, car_x);
+      opc->v[0].fd = opt_d_c;
+      return_true(sc, car_x);
+    }
+  p = opt_real_symbol(sc, car_x);
+  if (p)
+    {
+      opt_info *opc = alloc_opt_info(sc);
+      opc->v[1].p = p;
+      opc->v[0].fd = (is_t_real(slot_value(p))) ? opt_d_s : opt_D_s;
+      return_true(sc, car_x);
+    }
+  return_false(sc, car_x);
+}
+
+/* -------- d -------- */
+static s7_double opt_d_f(opt_info *o) {return(o->v[1].d_f());}
+
+static bool d_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func)  /* (f): (mus-srate), ignored damned ccpcheck! */
+{
+  s7_d_t func = s7_d_function(s_func);
+  if (!func)
+    return_false(sc, NULL);
+  opc->v[0].fd = opt_d_f;
+  opc->v[1].d_f = func;
+  return_true(sc, NULL);
+}
+
+/* -------- d_d -------- */
+static s7_double opt_d_d_c(opt_info *o)  {return(o->v[3].d_d_f(o->v[1].x));}
+static s7_double opt_d_d_s(opt_info *o)  {return(o->v[3].d_d_f(real(slot_value(o->v[1].p))));}
+static s7_double opt_d_d_s_abs(opt_info *o) {return(abs_d_d(real(slot_value(o->v[1].p))));}
+static s7_double opt_d_7d_c(opt_info *o) {return(o->v[3].d_7d_f(o->sc, o->v[1].x));}
+static s7_double opt_d_7d_s(opt_info *o) {return(o->v[3].d_7d_f(o->sc, real(slot_value(o->v[1].p))));}
+static s7_double opt_d_d_f(opt_info *o)  {return(o->v[3].d_d_f(o->v[5].fd(o->v[4].o1)));}
+static s7_double opt_d_d_f_abs(opt_info *o) {return(abs_d_d(o->v[5].fd(o->v[4].o1)));}
+static s7_double opt_d_d_f_sin(opt_info *o) {return(sin_d_d(o->v[5].fd(o->v[4].o1)));}
+static s7_double opt_d_d_f_cos(opt_info *o) {return(cos_d_d(o->v[5].fd(o->v[4].o1)));}
+static s7_double opt_d_7d_f(opt_info *o) {return(o->v[3].d_7d_f(o->sc, o->v[5].fd(o->v[4].o1)));}
+static s7_double opt_d_7d_f_divide(opt_info *o) {return(divide_d_7d(o->sc, o->v[5].fd(o->v[4].o1)));}
+
+static s7_double opt_d_7pi_ss_fvref_direct(opt_info *o);
+static s7_double opt_abs_d_ss_fvref(opt_info *o)
+{
+  opt_info *o1 = o->v[4].o1;
+  return(abs_d_d(float_vector(slot_value(o1->v[1].p), integer(slot_value(o1->v[2].p)))));
+}
+
+static bool d_d_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  s7_d_7d_t func7 = NULL;
+  int32_t start = sc->pc;
+  s7_d_d_t func = s7_d_d_function(s_func);
+  if (!func) func7 = s7_d_7d_function(s_func);
+  if ((func) || (func7))
+    {
+      s7_pointer p, arg1 = cadr(car_x);
+      if (func)
+	opc->v[3].d_d_f = func;
+      else opc->v[3].d_7d_f = func7;
+      if (is_small_real(arg1))
+	{
+	  if ((!is_t_real(arg1)) &&                          /* (random 1) != (random 1.0) */
+	      ((car(car_x) == sc->random_symbol) ||
+	       (car(car_x) == sc->sin_symbol) || (car(car_x) == sc->cos_symbol)))
+	    return_false(sc, car_x);
+	  opc->v[1].x = s7_number_to_real(sc, arg1);
+	  opc->v[0].fd = (func) ? opt_d_d_c : opt_d_7d_c;
+	  return_true(sc, car_x);
+	}
+      p = opt_float_symbol(sc, arg1);
+      if ((p) &&
+	  (!has_methods(slot_value(p))))
+	{
+	  opc->v[1].p = p;
+	  opc->v[0].fd = (func) ? ((func == abs_d_d) ? opt_d_d_s_abs : opt_d_d_s) : opt_d_7d_s;
+	  return_true(sc, car_x);
+	}
+      opc->v[4].o1 = sc->opts[sc->pc];
+      if (float_optimize(sc, cdr(car_x)))
+	{
+	  opc->v[0].fd = (func) ? ((func == abs_d_d) ? opt_d_d_f_abs : ((func == sin_d_d) ? opt_d_d_f_sin :
+				    ((func == cos_d_d) ? opt_d_d_f_cos : opt_d_d_f))) :
+	                          ((func7 == divide_d_7d) ? opt_d_7d_f_divide : opt_d_7d_f);
+	  /* if (opc->v[0].fd == opt_d_7d_f_divide) in tnum we know the arg is not 0.0, so it could be further optimized (but it's the loop stepper) */
+	  opc->v[5].fd = opc->v[4].o1->v[0].fd;
+	  if ((func == abs_d_d) && (opc->v[5].fd == opt_d_7pi_ss_fvref_direct))
+	    opc->v[0].fd = opt_abs_d_ss_fvref;
+	  return_true(sc, car_x);
+	}
+      sc->pc = start;
+    }
+  return_false(sc, car_x);
+}
+
+/* -------- d_v -------- */
+static s7_double opt_d_v(opt_info *o) {return(o->v[3].d_v_f(o->v[5].obj));}
+
+static bool d_v_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  s7_pointer sig;
+  s7_d_v_t flt_func = s7_d_v_function(s_func);
+  if (!flt_func)
+    return_false(sc, car_x);
+  sig = c_function_signature(s_func);
+  if ((is_pair(sig)) &&
+      (is_symbol(cadr(sig))) &&
+      (is_symbol(cadr(car_x))))           /* look for (oscil g) */
+    {
+      s7_pointer slot = opt_types_match(sc, cadr(sig), cadr(car_x));
+      if (slot)
+	{
+	  opc->v[1].p = slot;
+	  opc->v[5].obj = (void *)c_object_value(slot_value(slot));
+	  opc->v[3].d_v_f = flt_func;
+	  opc->v[0].fd = opt_d_v;
+	  return_true(sc, car_x);
+	}}
+  return_false(sc, car_x);
+}
+
+/* -------- d_p -------- */
+static s7_double opt_d_p_s(opt_info *o) {return(o->v[3].d_p_f(slot_value(o->v[1].p)));}
+static s7_double opt_d_p_f(opt_info *o) {return(o->v[3].d_p_f(o->v[5].fp(o->v[4].o1)));}
+
+static bool d_p_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  int32_t start = sc->pc;
+  s7_d_p_t dpf = s7_d_p_function(s_func); /* mostly clm gens */
+  if (!dpf)
+    return_false(sc, car_x);
+  opc->v[3].d_p_f = dpf;
+  if (is_symbol(cadr(car_x)))
+    {
+      s7_pointer slot = opt_simple_symbol(sc, cadr(car_x));
+      if (!slot)
+	return_false(sc, car_x);
+      opc->v[1].p = slot;
+      opc->v[0].fd = opt_d_p_s;
+      return_true(sc, car_x);
+    }
+  opc->v[4].o1 = sc->opts[sc->pc];
+  if (cell_optimize(sc, cdr(car_x)))
+    {
+      opc->v[0].fd = opt_d_p_f;
+      opc->v[5].fp = opc->v[4].o1->v[0].fp;
+      return_true(sc, car_x);
+    }
+  sc->pc = start;
+  return_false(sc, car_x);
+}
+
+/* -------- d_7pi -------- */
+
+static s7_double opt_d_7pi_sc(opt_info *o) {return(o->v[3].d_7pi_f(o->sc, slot_value(o->v[1].p), o->v[2].i));}
+static s7_double opt_d_7pi_ss(opt_info *o) {return(o->v[3].d_7pi_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p))));}
+static s7_double opt_d_7pi_sf(opt_info *o) {return(o->v[3].d_7pi_f(o->sc, slot_value(o->v[1].p), o->v[11].fi(o->v[10].o1)));}
+static s7_double opt_d_7pi_ss_fvref(opt_info *o) {return(float_vector_ref_d_7pi(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p))));}
+static s7_double opt_d_7pi_ss_fvref_direct(opt_info *o) {return(float_vector(slot_value(o->v[1].p), integer(slot_value(o->v[2].p))));}
+
+static s7_double opt_d_7pi_ff(opt_info *o)
+{
+  s7_pointer seq = o->v[5].fp(o->v[4].o1);
+  return(o->v[3].d_7pi_f(o->sc, seq, o->v[9].fi(o->v[8].o1)));
+}
+
+static bool d_7pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  /* float-vector-ref is checked for a 1D float-vector arg, but other callers should do type checking */
+  int32_t start = sc->pc;
+  s7_d_7pi_t ifunc = s7_d_7pi_function(s_func); /* ifunc: float_vector_ref_d_7pi, s_func: global_value(sc->float_vector_ref_symbol) */
+  if (!ifunc)
+    {
+      if ((s_func == initial_value(sc->vector_ref_symbol)) && (is_normal_symbol(cadr(car_x))))  /* (vector-ref <float-vector> <int>)? */
+	{
+	  s7_pointer v_slot = s7_slot(sc, cadr(car_x));
+	  if (is_slot(v_slot))
+	    {
+	      s7_pointer v = slot_value(v_slot);
+	      if ((is_float_vector(v)) ||
+		  ((is_typed_t_vector(v)) && (typed_vector_typer_symbol(sc, v) == sc->is_float_symbol)))
+		{
+		  ifunc = float_vector_ref_d_7pi;
+		  if (is_float_vector(v)) s_func = initial_value(sc->float_vector_ref_symbol);
+		}}}
+      if (!ifunc) return_false(sc, car_x);
+    }
+  opc->v[3].d_7pi_f = ifunc;
+  if (is_symbol(cadr(car_x)))  /* (float-vector-ref v i) */
+    {
+      s7_pointer arg2, p, obj;
+      opc->v[1].p = s7_slot(sc, cadr(car_x));
+      if (!is_slot(opc->v[1].p))
+	return_false(sc, car_x);
+
+      obj = slot_value(opc->v[1].p);
+      if ((is_target_or_its_alias(car(car_x), s_func, sc->float_vector_ref_symbol)) &&
+	  ((!is_float_vector(obj)) ||   /* if it's float-vector-ref, make sure obj is a float-vector */
+	   (vector_rank(obj) > 1)))
+	return_false(sc, car_x);        /*   but if it's e.g. (block-ref...), go on */
+
+      arg2 = caddr(car_x);
+      if (!is_pair(arg2))
+	{
+	  if (is_t_integer(arg2))
+	    {
+	      opc->v[2].i = integer(arg2);
+	      opc->v[0].fd = opt_d_7pi_sc;
+	      return_true(sc, car_x);
+	    }
+	  p = opt_integer_symbol(sc, arg2);
+	  if (!p)
+	    return_false(sc, car_x);
+	  opc->v[2].p = p;
+	  opc->v[0].fd = opt_d_7pi_ss;
+	  if (is_target_or_its_alias(car(car_x), s_func, sc->float_vector_ref_symbol))
+	    {
+	      opc->v[0].fd = (loop_end_fits(opc->v[2].p, vector_length(obj))) ? opt_d_7pi_ss_fvref_direct : opt_d_7pi_ss_fvref;
+	      if (opc->v[0].fd == opt_d_7pi_ss_fvref_direct) opc->v[3].d_7pi_f = float_vector_ref_d_7pi_direct;
+	    }
+	  return_true(sc, car_x);
+	}
+      if (int_optimize(sc, cddr(car_x)))
+	{
+	  opc->v[0].fd = opt_d_7pi_sf;
+	  opc->v[10].o1 = sc->opts[start];
+	  opc->v[11].fi = opc->v[10].o1->v[0].fi;
+	  return_true(sc, car_x);
+	}
+      sc->pc = start;
+      return_false(sc, car_x);
+    }
+
+  if ((is_target_or_its_alias(car(car_x), s_func, sc->float_vector_ref_symbol)) &&
+      ((!is_float_vector(cadr(car_x))) ||
+       (vector_rank(cadr(car_x)) > 1)))          /* (float-vector-ref #r2d((.1 .2) (.3 .4)) 3) */
+    return_false(sc, car_x);
+
+  if (cell_optimize(sc, cdr(car_x)))
+    {
+      opt_info *o2 = sc->opts[sc->pc];
+      if (int_optimize(sc, cddr(car_x)))
+	{
+	  opc->v[0].fd = opt_d_7pi_ff;
+	  opc->v[4].o1 = sc->opts[start];
+	  opc->v[5].fp = sc->opts[start]->v[0].fp;
+	  opc->v[8].o1 = o2;
+	  opc->v[9].fi = o2->v[0].fi;
+	  return_true(sc, car_x);
+	}}
+  sc->pc = start;
+  return_false(sc, car_x);
+}
+
+/* -------- d_ip -------- */
+static s7_double opt_d_ip_ss(opt_info *o) {return(o->v[3].d_ip_f(integer(slot_value(o->v[1].p)), slot_value(o->v[2].p)));}
+
+static bool d_ip_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  s7_d_ip_t pfunc = s7_d_ip_function(s_func);
+  if ((pfunc) &&
+      (is_symbol(caddr(car_x))))
+    {
+      s7_pointer p = opt_integer_symbol(sc, cadr(car_x));
+      if (p)
+	{
+	  opc->v[3].d_ip_f = pfunc;
+	  opc->v[1].p = p;
+	  opc->v[2].p = s7_slot(sc, caddr(car_x));
+	  if (is_slot(opc->v[2].p))    /* (with-sound (:reverb jc-reverb) (fm-violin 0 .1 440 .4 :reverb-amount .5)) */
+	    {
+	      opc->v[0].fd = opt_d_ip_ss;
+	      return_true(sc, car_x);
+	    }}}
+  return_false(sc, car_x);
+}
+
+/* -------- d_pd -------- */
+static s7_double opt_d_pd_sf(opt_info *o) {return(o->v[3].d_pd_f(slot_value(o->v[1].p), o->v[11].fd(o->v[10].o1)));}
+static s7_double opt_d_pd_ss(opt_info *o) {return(o->v[3].d_pd_f(slot_value(o->v[1].p), real(slot_value(o->v[2].p))));}
+
+static bool d_pd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  if (is_symbol(cadr(car_x)))
+    {
+      s7_d_pd_t func = s7_d_pd_function(s_func);
+      if (func)
+	{
+	  s7_pointer p, arg2 = caddr(car_x);
+	  int32_t start = sc->pc;
+	  opc->v[3].d_pd_f = func;
+	  opc->v[1].p = s7_slot(sc, cadr(car_x));
+	  if (!is_slot(opc->v[1].p))
+	    return_false(sc, car_x);
+	  p = opt_float_symbol(sc, arg2);
+	  if (p)
+	    {
+	      opc->v[2].p = p;
+	      opc->v[0].fd = opt_d_pd_ss;
+	      return_true(sc, car_x);
+	    }
+	  opc->v[10].o1 = sc->opts[sc->pc];
+	  if (float_optimize(sc, cddr(car_x)))
+	    {
+	      opc->v[0].fd = opt_d_pd_sf;
+	      opc->v[11].fd = opc->v[10].o1->v[0].fd;
+	      return_true(sc, car_x);
+	    }
+	  sc->pc = start;
+	}}
+  return_false(sc, car_x);
+}
+
+/* -------- d_vd -------- */
+static s7_double opt_d_vd_c(opt_info *o) {return(o->v[3].d_vd_f(o->v[5].obj, o->v[2].x));}
+static s7_double opt_d_vd_s(opt_info *o) {return(o->v[3].d_vd_f(o->v[5].obj, real(slot_value(o->v[2].p))));}
+static s7_double opt_d_vd_f(opt_info *o) {return(o->v[3].d_vd_f(o->v[5].obj, o->v[9].fd(o->v[8].o1)));}
+static s7_double opt_d_vd_o(opt_info *o) {return(o->v[3].d_vd_f(o->v[5].obj, o->v[4].d_v_f(o->v[6].obj)));}
+static s7_double opt_d_vd_o1_mul(opt_info *o) {return(o->v[3].d_vd_f(o->v[5].obj, real(slot_value(o->v[2].p)) * o->v[11].fd(o->v[10].o1)));}
+static s7_double opt_d_vd_o1(opt_info *o) {return(o->v[3].d_vd_f(o->v[5].obj, o->v[4].d_dd_f(real(slot_value(o->v[2].p)), o->v[11].fd(o->v[10].o1))));}
+static s7_double opt_d_vd_o2(opt_info *o) {return(o->v[4].d_vd_f(o->v[6].obj, o->v[5].d_vd_f(o->v[2].obj, real(slot_value(o->v[3].p)))));}
+static s7_double opt_d_vd_o3(opt_info *o) {return(o->v[3].d_vd_f(o->v[5].obj, o->v[4].d_dd_f(o->v[6].x, real(slot_value(o->v[2].p)))));}
+static s7_double opt_d_vd_ff(opt_info *o) {return(o->v[3].d_vd_f(o->v[5].obj, o->v[2].d_vd_f(o->v[4].obj, o->v[11].fd(o->v[10].o1))));}
+
+static s7_double opt_d_dd_cs(opt_info *o);
+static s7_double opt_d_dd_sf_mul(opt_info *o);
+static s7_double opt_d_dd_sf_add(opt_info *o);
+static s7_double opt_d_dd_sf(opt_info *o);
+
+static bool d_vd_f_combinable(s7_scheme *sc, int32_t start)
+{
+  opt_info *opc = sc->opts[start - 1], *o1 = sc->opts[start];
+  if (o1->v[0].fd == opt_d_v)
+    {
+      opc->v[2].p = o1->v[1].p;
+      opc->v[6].obj = o1->v[5].obj;
+      opc->v[4].d_v_f = o1->v[3].d_v_f;
+      opc->v[0].fd = opt_d_vd_o;
+      backup_pc(sc);
+      return_true(sc, NULL);
+    }
+  if (o1->v[0].fd == opt_d_vd_s)
+    {
+      opc->v[6].obj = opc->v[5].obj;
+      opc->v[4].d_vd_f = opc->v[3].d_vd_f; /* room for symbols */
+      opc->v[2].obj = o1->v[5].obj;
+      opc->v[5].d_vd_f = o1->v[3].d_vd_f;
+      opc->v[3].p = o1->v[2].p;
+      opc->v[7].p = o1->v[1].p;
+      opc->v[0].fd = opt_d_vd_o2;
+      backup_pc(sc);
+      return_true(sc, NULL);
+    }
+  if (o1->v[0].fd == opt_d_dd_cs)
+    {
+      opc->v[4].d_dd_f = o1->v[3].d_dd_f;
+      opc->v[6].x = o1->v[2].x;
+      opc->v[2].p = o1->v[1].p;
+      opc->v[0].fd = opt_d_vd_o3;
+      backup_pc(sc);
+      return_true(sc, NULL);
+    }
+  if ((o1->v[0].fd == opt_d_dd_sf_mul) || (o1->v[0].fd == opt_d_dd_sf) || (o1->v[0].fd == opt_d_dd_sf_add))
+    {
+      opc->v[2].p = o1->v[1].p;
+      opc->v[4].d_dd_f = o1->v[3].d_dd_f;
+      opc->v[0].fd = (o1->v[0].fd == opt_d_dd_sf_mul) ? opt_d_vd_o1_mul : opt_d_vd_o1;
+      opc->v[11].fd = o1->v[5].fd;
+      opc->v[10].o1 = o1->v[4].o1;
+      return_true(sc, NULL);
+    }
+  if (o1->v[0].fd == opt_d_vd_f)
+    {
+      opc->v[2].d_vd_f = o1->v[3].d_vd_f;
+      opc->v[4].obj = o1->v[5].obj;
+      opc->v[6].p = o1->v[1].p;
+      opc->v[0].fd = opt_d_vd_ff;
+      opc->v[11].fd = o1->v[9].fd;
+      opc->v[10].o1 = o1->v[8].o1;
+      return_true(sc, NULL);
+    }
+  return_false(sc, NULL);
+}
+
+static bool d_vd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  s7_pointer sig;
+  s7_d_vd_t vfunc;
+  if (!is_symbol(cadr(car_x)))
+    return_false(sc, car_x);
+  vfunc = s7_d_vd_function(s_func);
+  if (!vfunc)
+    return_false(sc, car_x);
+  sig = c_function_signature(s_func);
+  if ((is_pair(sig)) &&
+      (is_symbol(cadr(sig))))
+    {
+      s7_pointer slot = opt_types_match(sc, cadr(sig), cadr(car_x));
+      if (slot)
+	{
+	  s7_pointer arg2 = caddr(car_x);
+	  int32_t start = sc->pc;
+	  opc->v[3].d_vd_f = vfunc;
+	  if (!is_pair(arg2))
+	    {
+	      opc->v[1].p = slot;
+	      opc->v[5].obj = (void *)c_object_value(slot_value(slot));
+	      if (is_small_real(arg2))
+		{
+		  opc->v[2].x = s7_number_to_real(sc, arg2);
+		  opc->v[0].fd = opt_d_vd_c;
+		  return_true(sc, car_x);
+		}
+	      opc->v[2].p = s7_slot(sc, arg2);
+	      if (is_slot(opc->v[2].p))
+		{
+		  if (is_t_real(slot_value(opc->v[2].p)))
+		    {
+		      opc->v[0].fd = opt_d_vd_s;
+		      return_true(sc, car_x);
+		    }
+		  if (!float_optimize(sc, cddr(car_x)))
+		    return_false(sc, car_x);
+		  if (d_vd_f_combinable(sc, start))
+		    return_true(sc, car_x);
+		  opc->v[0].fd = opt_d_vd_f;
+		  opc->v[8].o1 = sc->opts[start];
+		  opc->v[9].fd = sc->opts[start]->v[0].fd;
+		  return_true(sc, car_x);
+		}}
+	  else /* is pair arg2 */
+	    {
+	      if (float_optimize(sc, cddr(car_x)))
+		{
+		  opc->v[1].p = slot;
+		  opc->v[5].obj = (void *)c_object_value(slot_value(slot));
+		  if (d_vd_f_combinable(sc, start))
+		    return_true(sc, car_x);
+		  opc->v[0].fd = opt_d_vd_f;
+		  opc->v[8].o1 = sc->opts[start];
+		  opc->v[9].fd = sc->opts[start]->v[0].fd;
+		  return_true(sc, car_x);
+		}
+	      sc->pc = start;
+	    }}}
+  return_false(sc, car_x);
+}
+
+/* -------- d_id -------- */
+static s7_double opt_d_id_ss(opt_info *o)   {return(o->v[3].d_id_f(integer(slot_value(o->v[1].p)), real(slot_value(o->v[2].p))));}
+static s7_double opt_d_i2_mul(opt_info *o)  {s7_int p = integer(slot_value(o->v[1].p)); return(p * p);}
+static s7_double opt_d_id_sf(opt_info *o)   {return(o->v[3].d_id_f(integer(slot_value(o->v[1].p)), o->v[5].fd(o->v[4].o1)));}
+static s7_double opt_d_id_sc(opt_info *o)   {return(o->v[3].d_id_f(integer(slot_value(o->v[1].p)), o->v[2].x));}
+static s7_double opt_d_id_sfo1(opt_info *o) {return(o->v[3].d_id_f(integer(slot_value(o->v[1].p)), o->v[5].d_v_f(o->v[2].obj)));}
+static s7_double opt_d_id_sfo(opt_info *o)  {return(o->v[4].d_id_f(integer(slot_value(o->v[1].p)), o->v[5].d_vd_f(o->v[6].obj, real(slot_value(o->v[3].p)))));}
+static s7_double opt_d_id_cf(opt_info *o)   {return(o->v[3].d_id_f(o->v[1].i, o->v[5].fd(o->v[4].o1)));}
+
+static s7_double opt_d_id_ff(opt_info *o)
+{
+  s7_int x1 = o->v[9].fi(o->v[8].o1);
+  return(o->v[3].d_id_f(x1, o->v[11].fd(o->v[10].o1)));
+}
+
+static bool d_id_sf_combinable(s7_scheme *sc, opt_info *opc)
+{
+  if ((sc->pc > 1) &&
+      (opc == sc->opts[sc->pc - 2]))
+    {
+      opt_info *o1 = sc->opts[sc->pc - 1];
+      if (o1->v[0].fd == opt_d_vd_s)
+	{
+	  opc->v[4].d_id_f = opc->v[3].d_id_f;
+	  opc->v[2].p = o1->v[1].p;
+	  opc->v[6].obj = o1->v[5].obj;
+	  opc->v[5].d_vd_f = o1->v[3].d_vd_f;
+	  opc->v[3].p = o1->v[2].p;
+	  opc->v[0].fd = opt_d_id_sfo;
+	  backup_pc(sc);
+	  return_true(sc, NULL);
+	}
+      if (o1->v[0].fd == opt_d_v)
+	{
+	  opc->v[6].p = o1->v[1].p;
+	  opc->v[2].obj = o1->v[5].obj;
+	  opc->v[5].d_v_f = o1->v[3].d_v_f;
+	  opc->v[0].fd = opt_d_id_sfo1;
+	  backup_pc(sc);
+	  return_true(sc, NULL);
+	}}
+  return_false(sc, NULL);
+}
+
+static bool d_id_ok_1(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, bool expr_case)
+{
+  s7_pointer p;
+  int32_t start = sc->pc;
+  s7_d_id_t flt_func = s7_d_id_function(s_func);
+  if (!flt_func)
+    return_false(sc, car_x);
+  opc->v[3].d_id_f = flt_func;
+  p = opt_integer_symbol(sc, cadr(car_x));
+  if (p)
+    {
+      s7_pointer arg2 = caddr(car_x);
+      opc->v[1].p = p;
+      if (is_t_real(arg2))
+	{
+	  opc->v[0].fd = opt_d_id_sc;
+	  opc->v[2].x = real(arg2);
+	  return_true(sc, car_x);
+	}
+      if ((cadr(car_x) == arg2) && (flt_func == multiply_d_id))
+	{
+	  opc->v[0].fd = opt_d_i2_mul;
+	  return_true(sc, car_x);
+	}
+      p = opt_float_symbol(sc, arg2);
+      if (p)
+	{
+	  opc->v[0].fd = opt_d_id_ss;
+	  opc->v[2].p = p;
+	  return_true(sc, car_x);
+	}
+      if (float_optimize(sc, cddr(car_x)))
+	{
+	  if (d_id_sf_combinable(sc, opc))
+	    return_true(sc, car_x);
+	  opc->v[0].fd = opt_d_id_sf;
+	  opc->v[4].o1 = sc->opts[start];
+	  opc->v[5].fd = sc->opts[start]->v[0].fd;
+	  return_true(sc, car_x);
+	}
+      sc->pc = start;
+    }
+  if (is_t_integer(cadr(car_x)))
+    {
+      if (float_optimize(sc, cddr(car_x)))
+	{
+	  opc->v[0].fd = opt_d_id_cf;
+	  opc->v[1].i = integer(cadr(car_x));
+	  opc->v[4].o1 = sc->opts[start];
+	  opc->v[5].fd = sc->opts[start]->v[0].fd;
+	  return_true(sc, car_x);
+	}
+      sc->pc = start;
+    }
+  if (!expr_case) return_false(sc, car_x);
+  opc->v[8].o1 = sc->opts[sc->pc];
+  if (int_optimize(sc, cdr(car_x)))
+    {
+      opc->v[9].fi = opc->v[8].o1->v[0].fi;
+      opc->v[10].o1 = sc->opts[sc->pc];
+      if (float_optimize(sc, cddr(car_x)))
+	{
+	  opc->v[11].fd = opc->v[10].o1->v[0].fd;
+	  opc->v[0].fd = opt_d_id_ff;
+	  return_true(sc, car_x);
+	}
+      sc->pc = start;
+    }
+  return_false(sc, car_x);
+}
+
+static bool d_id_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  return(d_id_ok_1(sc, opc, s_func, car_x, true));
+}
+
+
+/* -------- d_dd -------- */
+
+static s7_double opt_d_dd_cc(opt_info *o)     {return(o->v[3].d_dd_f(o->v[1].x, o->v[2].x));}
+static s7_double opt_d_dd_cs(opt_info *o)     {return(o->v[3].d_dd_f(o->v[2].x, real(slot_value(o->v[1].p))));}
+static s7_double opt_d_dd_sc(opt_info *o)     {return(o->v[3].d_dd_f(real(slot_value(o->v[1].p)), o->v[2].x));}
+static s7_double opt_d_dd_sc_sub(opt_info *o) {return(real(slot_value(o->v[1].p)) - o->v[2].x);}
+static s7_double opt_d_dd_ss(opt_info *o)     {return(o->v[3].d_dd_f(real(slot_value(o->v[1].p)), real(slot_value(o->v[2].p))));}
+static s7_double opt_d_dd_ss_add(opt_info *o) {return(real(slot_value(o->v[1].p)) + real(slot_value(o->v[2].p)));}
+static s7_double opt_d_dd_ss_mul(opt_info *o) {return(real(slot_value(o->v[1].p)) * real(slot_value(o->v[2].p)));}
+
+static s7_double opt_d_dd_cf(opt_info *o) {return(o->v[3].d_dd_f(o->v[1].x, o->v[5].fd(o->v[4].o1)));}
+static s7_double opt_d_dd_1f_subtract(opt_info *o) {return(1.0 - o->v[5].fd(o->v[4].o1));}
+static s7_double opt_d_dd_fc(opt_info *o) {return(o->v[3].d_dd_f(o->v[5].fd(o->v[4].o1), o->v[2].x));}
+
+#if WITH_GMP
+static s7_double opt_subtract_random_f_f(opt_info *o) {return(o->v[1].x * next_random(o->sc) - o->v[2].x);}
+#else
+static s7_double opt_subtract_random_f_f(opt_info *o) {return(o->v[1].x * next_random(o->sc->default_random_state) - o->v[2].x);}
+#endif
+
+static s7_double opt_d_dd_fc_add(opt_info *o) {return(o->v[5].fd(o->v[4].o1) + o->v[2].x);}
+static s7_double opt_d_dd_fc_fvref_add(opt_info *o) {return(o->v[2].x + float_vector(slot_value(o->v[4].o1->v[1].p), integer(slot_value(o->v[4].o1->v[2].p))));}
+static s7_double opt_d_dd_fc_subtract(opt_info *o) {return(o->v[5].fd(o->v[4].o1) - o->v[2].x);}
+static s7_double opt_d_dd_sf(opt_info *o) {return(o->v[3].d_dd_f(real(slot_value(o->v[1].p)), o->v[5].fd(o->v[4].o1)));}
+static s7_double opt_d_dd_sf_mul(opt_info *o) {return(real(slot_value(o->v[1].p)) * o->v[5].fd(o->v[4].o1));}
+static s7_double opt_d_dd_sf_add(opt_info *o) {return(real(slot_value(o->v[1].p)) + o->v[5].fd(o->v[4].o1));}
+static s7_double opt_d_dd_sf_sub(opt_info *o) {return(real(slot_value(o->v[1].p)) - o->v[5].fd(o->v[4].o1));}
+
+static s7_double opt_d_7dd_cc(opt_info *o) {return(o->v[3].d_7dd_f(o->sc, o->v[1].x, o->v[2].x));}
+static s7_double opt_d_7dd_cs(opt_info *o) {return(o->v[3].d_7dd_f(o->sc, o->v[2].x, real(slot_value(o->v[1].p))));}
+static s7_double opt_d_7dd_sc(opt_info *o) {return(o->v[3].d_7dd_f(o->sc, real(slot_value(o->v[1].p)), o->v[2].x));}
+static s7_double opt_d_7dd_ss(opt_info *o) {return(o->v[3].d_7dd_f(o->sc, real(slot_value(o->v[1].p)), real(slot_value(o->v[2].p))));}
+static s7_double opt_d_7dd_cf(opt_info *o) {return(o->v[3].d_7dd_f(o->sc, o->v[1].x, o->v[5].fd(o->v[4].o1)));}
+static s7_double opt_d_7dd_fc(opt_info *o) {return(o->v[3].d_7dd_f(o->sc, o->v[5].fd(o->v[4].o1), o->v[2].x));}
+static s7_double opt_d_7dd_sf(opt_info *o) {return(o->v[3].d_7dd_f(o->sc, real(slot_value(o->v[1].p)), o->v[5].fd(o->v[4].o1)));}
+
+static s7_double opt_d_dd_sf_mul_fvref(opt_info *o)
+{
+  opt_info *o1 = o->v[4].o1;
+  return(real(slot_value(o->v[1].p)) * float_vector_ref_d_7pii(o1->sc, slot_value(o1->v[1].p), o1->v[2].i, integer(slot_value(o1->v[3].p))));
+}
+
+static s7_double opt_d_dd_sfo(opt_info *o)
+{
+  return(o->v[4].d_dd_f(real(slot_value(o->v[1].p)), o->v[5].d_7pi_f(o->sc, slot_value(o->v[2].p), integer(slot_value(o->v[3].p)))));
+}
+
+static s7_double opt_d_7dd_sfo(opt_info *o)
+{
+  return(o->v[4].d_7dd_f(o->sc, real(slot_value(o->v[1].p)), o->v[5].d_7pi_f(o->sc, slot_value(o->v[2].p), integer(slot_value(o->v[3].p)))));
+}
+
+static bool d_dd_sf_combinable(s7_scheme *sc, opt_info *opc, s7_d_dd_t func)
+{
+  if ((sc->pc > 1) &&
+      (opc == sc->opts[sc->pc - 2]))
+    {
+      opt_info *o1 = sc->opts[sc->pc - 1];
+      if ((o1->v[0].fd == opt_d_7pi_ss) || (o1->v[0].fd == opt_d_7pi_ss_fvref) || (o1->v[0].fd == opt_d_7pi_ss_fvref_direct))
+	{
+	  if (func)
+	    {
+	      opc->v[4].d_dd_f = opc->v[3].d_dd_f; /* need room for 3 symbols */
+	      opc->v[0].fd = opt_d_dd_sfo;
+	    }
+	  else
+	    {
+	      opc->v[4].d_7dd_f = opc->v[3].d_7dd_f; /* need room for 3 symbols */
+	      opc->v[0].fd = opt_d_7dd_sfo;
+	    }
+	  opc->v[2].p = o1->v[1].p;
+	  opc->v[3].p = o1->v[2].p;
+	  opc->v[5].d_7pi_f = o1->v[3].d_7pi_f;
+	  backup_pc(sc);
+	  return_true(sc, NULL);
+	}}
+  return_false(sc, NULL);
+}
+
+static s7_double opt_d_dd_fs(opt_info *o) {return(o->v[3].d_dd_f(o->v[5].fd(o->v[4].o1), real(slot_value(o->v[1].p))));}
+static s7_double opt_d_dd_fs_mul(opt_info *o) {return(o->v[5].fd(o->v[4].o1) * real(slot_value(o->v[1].p)));}
+static s7_double opt_d_dd_fs_add(opt_info *o) {return(o->v[5].fd(o->v[4].o1) + real(slot_value(o->v[1].p)));}
+static s7_double opt_d_dd_fs_sub(opt_info *o) {return(o->v[5].fd(o->v[4].o1) - real(slot_value(o->v[1].p)));}
+static s7_double opt_d_7dd_fs(opt_info *o) {return(o->v[3].d_7dd_f(o->sc, o->v[5].fd(o->v[4].o1), real(slot_value(o->v[1].p))));}
+
+static s7_double opt_d_dd_fs_add_fvref(opt_info *o)
+{
+  opt_info *o1 = o->v[4].o1;
+  return(real(slot_value(o->v[1].p)) + float_vector_ref_d_7pii(o1->sc, slot_value(o1->v[1].p), o1->v[2].i, integer(slot_value(o1->v[3].p))));
+}
+
+static s7_double opt_d_dd_fso(opt_info *o)
+{
+  return(o->v[4].d_dd_f(o->v[5].d_7pi_f(o->sc, slot_value(o->v[2].p), integer(slot_value(o->v[3].p))), real(slot_value(o->v[1].p))));
+}
+
+static s7_double opt_d_7dd_fso(opt_info *o)
+{
+  return(o->v[4].d_7dd_f(o->sc, o->v[5].d_7pi_f(o->sc, slot_value(o->v[2].p), integer(slot_value(o->v[3].p))), real(slot_value(o->v[1].p))));
+}
+
+static bool d_dd_fs_combinable(s7_scheme *sc, opt_info *opc, s7_d_dd_t func)
+{
+  if ((sc->pc > 1) &&
+      (opc == sc->opts[sc->pc - 2]))
+    {
+      opt_info *o1 = sc->opts[sc->pc - 1];
+      if ((o1->v[0].fd == opt_d_7pi_ss) || (o1->v[0].fd == opt_d_7pi_ss_fvref) || (o1->v[0].fd == opt_d_7pi_ss_fvref_direct))
+	{
+	  if (func)
+	    {
+	      opc->v[4].d_dd_f = opc->v[3].d_dd_f; /* need room for 3 symbols */
+	      opc->v[0].fd = opt_d_dd_fso;
+	    }
+	  else
+	    {
+	      opc->v[4].d_7dd_f = opc->v[3].d_7dd_f;
+	      opc->v[0].fd = opt_d_7dd_fso;
+	    }
+	  opc->v[2].p = o1->v[1].p;
+	  opc->v[3].p = o1->v[2].p;
+	  opc->v[5].d_7pi_f = o1->v[3].d_7pi_f;
+	  backup_pc(sc);
+	  return_true(sc, NULL);
+	}}
+  return_false(sc, NULL);
+}
+
+static s7_double opt_d_dd_ff(opt_info *o)
+{
+  s7_double x1 = o->v[9].fd(o->v[8].o1);
+  return(o->v[3].d_dd_f(x1, o->v[11].fd(o->v[10].o1)));
+}
+
+static s7_double opt_d_dd_ff_mul(opt_info *o)
+{
+  s7_double x1 = o->v[9].fd(o->v[8].o1);
+  return(x1 * o->v[11].fd(o->v[10].o1));
+}
+
+static s7_double opt_d_dd_ff_square(opt_info *o)
+{
+  s7_double x1 = o->v[9].fd(o->v[8].o1);
+  return(x1 * x1);
+}
+
+static s7_double opt_d_dd_ff_add(opt_info *o)
+{
+  s7_double x1 = o->v[5].fd(o->v[4].o1);
+  return(x1 + o->v[11].fd(o->v[10].o1));
+}
+
+static s7_double opt_d_dd_ff_add_mul(opt_info *o)
+{
+  s7_double x1 = o->v[5].fd(o->v[4].o1);
+  s7_double x2 = o->v[9].fd(o->v[8].o1);
+  return(x1 + (x2 * o->v[11].fd(o->v[10].o1)));
+}
+
+static s7_double opt_d_dd_ff_add_fv_ref(opt_info *o)
+{
+  s7_double x1 = o->v[5].fd(o->v[4].o1);
+  return(x1 + float_vector_ref_d_7pi(o->sc, slot_value(o->v[6].p), o->v[9].fi(o->v[8].o1)));
+}
+
+static s7_double opt_d_dd_ff_sub(opt_info *o)
+{
+  s7_double x1 = o->v[5].fd(o->v[4].o1);
+  return(x1 - o->v[11].fd(o->v[10].o1));
+}
+
+static s7_double opt_d_7dd_ff(opt_info *o)
+{
+  s7_double x1 = o->v[9].fd(o->v[8].o1);
+  return(o->v[3].d_7dd_f(o->sc, x1, o->v[11].fd(o->v[10].o1)));
+}
+
+static s7_double opt_d_7dd_ff_add_fv_ref_direct(opt_info *o)
+{
+  s7_double x1 = opt_d_7pi_ss_fvref_direct(o->v[4].o1);
+  return(x1 + opt_d_7dd_ff(o->v[10].o1));
+}
+
+static s7_double opt_d_7dd_ff_add_div(opt_info *o)
+{
+  s7_double x1 = opt_d_7pi_ss_fvref_direct(o->v[4].o1);
+  s7_double x2 = opt_d_7pi_ss_fvref_direct(o->v[8].o1);
+  return(x1 + divide_d_7dd(o->sc, x2, opt_d_id_sf(o->v[10].o1)));
+}
+
+static s7_double opt_d_dd_ff_o1(opt_info *o)
+{
+  s7_double x1 = o->v[2].d_v_f(o->v[1].obj);
+  return(o->v[3].d_dd_f(x1, o->v[11].fd(o->v[10].o1)));
+}
+
+static s7_double opt_d_dd_ff_mul1(opt_info *o) {return(o->v[2].d_v_f(o->v[1].obj) * o->v[11].fd(o->v[10].o1));}
+
+static s7_double opt_d_dd_ff_o2(opt_info *o)
+{
+  s7_double x1 = o->v[4].d_v_f(o->v[1].obj);
+  return(o->v[3].d_dd_f(x1, o->v[5].d_v_f(o->v[2].obj)));
+}
+
+static s7_double opt_d_dd_ff_mul2(opt_info *o) {return(o->v[4].d_v_f(o->v[1].obj) * o->v[5].d_v_f(o->v[2].obj));}
+
+static s7_double opt_d_dd_ff_o3(opt_info *o)
+{
+  s7_double x1 = o->v[5].d_v_f(o->v[1].obj);
+  return(o->v[4].d_dd_f(x1, o->v[6].d_vd_f(o->v[2].obj, real(slot_value(o->v[3].p)))));
+}
+
+static s7_double opt_d_dd_fff(opt_info *o)
+{
+  s7_double x1 = o->v[3+4].d_dd_f(o->v[3+5].d_7pi_f(o->sc, slot_value(o->v[3+2].p), integer(slot_value(o->v[3+3].p))), real(slot_value(o->v[3+1].p))); /* dd_fso */
+  s7_double x2 = o->v[8+4].d_dd_f(o->v[8+5].d_7pi_f(o->sc, slot_value(o->v[8+2].p), integer(slot_value(o->v[8+3].p))), real(slot_value(o->v[8+1].p))); /* dd_fso */
+  return(o->v[3].d_dd_f(x1, x2));
+}
+
+static s7_double opt_d_mm_fff(opt_info *o)
+{
+  s7_double x1 = float_vector_ref_d_7pi(o->sc, slot_value(o->v[3+2].p), integer(slot_value(o->v[3+3].p))) * real(slot_value(o->v[3+1].p));
+  s7_double x2 = float_vector_ref_d_7pi(o->sc, slot_value(o->v[8+2].p), integer(slot_value(o->v[8+3].p))) * real(slot_value(o->v[8+1].p));
+  return(o->v[3].d_dd_f(x1, x2));
+}
+
+static s7_double opt_d_dd_fff_rev(opt_info *o) /* faster with o->sc? */
+{
+  s7_double x1 = o->v[3+4].d_dd_f(real(slot_value(o->v[3+1].p)), o->v[3+5].d_7pi_f(o->sc, slot_value(o->v[3+2].p), integer(slot_value(o->v[3+3].p))));
+  s7_double x2 = o->v[8+4].d_dd_f(real(slot_value(o->v[8+1].p)), o->v[8+5].d_7pi_f(o->sc, slot_value(o->v[8+2].p), integer(slot_value(o->v[8+3].p))));
+  return(o->v[3].d_dd_f(x1, x2));
+}
+
+static s7_double opt_d_dd_ff_o4(opt_info *o)
+{
+  s7_double x1 = o->v[2].d_v_f(o->v[1].obj);
+  return(o->v[3].d_dd_f(x1, o->v[7].d_vd_f(o->v[5].obj, o->v[4].d_v_f(o->v[6].obj))));
+}
+
+static s7_double opt_d_dd_ff_mul4(opt_info *o) {return(o->v[2].d_v_f(o->v[1].obj) * o->v[7].d_vd_f(o->v[5].obj, o->v[4].d_v_f(o->v[6].obj)));}
+
+static s7_double opt_d_dd_ff_mul_sss_unchecked(opt_info *o)
+{
+  opt_info *o1 = o->v[8].o1;
+  s7_pointer v = slot_value(o1->v[1].p);
+  s7_int i1 = integer(slot_value(o1->v[2].p));
+  s7_int i2 = integer(slot_value(o1->v[3].p));
+  s7_double x1 = float_vector(v, (i1 * vector_offset(v, 0)) + i2);
+  o1 = o->v[10].o1;
+  v = slot_value(o1->v[1].p);
+  i1 = integer(slot_value(o1->v[2].p));                /* in (* (A i j) (B j k)) we could reuse i2->i1 (flipping args below) */
+  i2 = integer(slot_value(o1->v[3].p));
+  return(x1 * float_vector(v, (i1 * vector_offset(v, 0)) + i2));
+}
+
+static bool finish_dd_fso(opt_info *opc, opt_info *o1, opt_info *o2)
+{
+  opc->v[3+1].p = o1->v[1].p;
+  opc->v[3+2].p = o1->v[2].p;
+  opc->v[3+3].p = o1->v[3].p;
+  opc->v[3+4].d_dd_f = o1->v[4].d_dd_f;
+  opc->v[3+5].d_7pi_f = o1->v[5].d_7pi_f;
+  opc->v[8+1].p = o2->v[1].p;
+  opc->v[8+2].p = o2->v[2].p;
+  opc->v[8+3].p = o2->v[3].p;
+  opc->v[8+4].d_dd_f = o2->v[4].d_dd_f;
+  opc->v[8+5].d_7pi_f = o2->v[5].d_7pi_f;
+  return(true);
+}
+
+static s7_double opt_d_7dd_ff_div_add(opt_info *o)
+{
+  opt_info *o2 = o->v[10].o1;
+  s7_double x1 = o->v[9].fd(o->v[8].o1);
+  s7_double x2 = o2->v[5].fd(o2->v[4].o1);
+  x2 += float_vector_ref_d_7pi(o2->sc, slot_value(o2->v[6].p), o2->v[9].fi(o2->v[8].o1));
+  return(divide_d_7dd(o->sc, x1, x2));
+}
+
+static bool d_dd_ff_combinable(s7_scheme *sc, opt_info *opc, int32_t start)
+{
+  opt_info *o1 = opc->v[8].o1, *o2 = opc->v[10].o1;
+  if (o1->v[0].fd == opt_d_v)
+    {
+      /* opc->v[3] is in use */
+      if ((o2->v[0].fd == opt_d_v) &&
+	  (sc->pc == start + 2))
+	{
+	  opc->v[1].obj = o1->v[5].obj;
+	  opc->v[6].p = o1->v[1].p;
+	  opc->v[4].d_v_f = o1->v[3].d_v_f;
+	  opc->v[2].obj = o2->v[5].obj;
+	  opc->v[7].p = o2->v[1].p;
+	  opc->v[5].d_v_f = o2->v[3].d_v_f;
+	  opc->v[0].fd = (opc->v[3].d_dd_f == multiply_d_dd) ? opt_d_dd_ff_mul2 : opt_d_dd_ff_o2;
+	  sc->pc -= 2;
+	  return_true(sc, NULL);
+	}
+      if ((o2->v[0].fd == opt_d_vd_s) &&
+	  (sc->pc == start + 2))
+	{
+	  opc->v[4].d_dd_f = opc->v[3].d_dd_f; /* make room for symbols */
+	  opc->v[1].obj = o1->v[5].obj;
+	  opc->v[7].p = o1->v[1].p;
+	  opc->v[5].d_v_f = o1->v[3].d_v_f;
+	  opc->v[2].obj = o2->v[5].obj;
+	  opc->v[8].p = o2->v[1].p;
+	  opc->v[6].d_vd_f = o2->v[3].d_vd_f;
+	  opc->v[3].p = o2->v[2].p;
+	  opc->v[0].fd = opt_d_dd_ff_o3;
+	  sc->pc -= 2;
+	  return_true(sc, NULL);
+	}
+      if ((o2->v[0].fd == opt_d_vd_o) &&
+	  (sc->pc == start + 2))
+	{
+	  opc->v[1].obj = o1->v[5].obj;
+	  opc->v[8].p = o1->v[1].p;
+	  opc->v[2].d_v_f = o1->v[3].d_v_f;
+	  opc->v[7].d_vd_f = o2->v[3].d_vd_f;
+	  opc->v[4].d_v_f = o2->v[4].d_v_f;
+	  opc->v[5].obj = o2->v[5].obj;
+	  opc->v[9].p = o2->v[1].p;
+	  opc->v[6].obj = o2->v[6].obj;
+	  opc->v[10].p = o2->v[2].p;
+	  opc->v[0].fd = (opc->v[3].d_dd_f == multiply_d_dd) ? opt_d_dd_ff_mul4 : opt_d_dd_ff_o4;
+	  sc->pc -= 2;
+	  return_true(sc, NULL);
+	}
+      opc->v[1].obj = o1->v[5].obj;
+      opc->v[4].p = o1->v[1].p;
+      opc->v[2].d_v_f = o1->v[3].d_v_f;
+      opc->v[0].fd = (opc->v[3].d_dd_f == multiply_d_dd) ? opt_d_dd_ff_mul1 : opt_d_dd_ff_o1;
+      return_true(sc, NULL);
+    }
+  if (o1->v[0].fd == opt_d_dd_fso)
+    {
+      if (o2->v[0].fd == opt_d_dd_fso)
+	{
+	  if ((o1->v[4].d_dd_f == multiply_d_dd) &&
+	      (o2->v[4].d_dd_f == multiply_d_dd) &&
+	      ((o1->v[5].d_7pi_f == float_vector_ref_d_7pi) || (o1->v[5].d_7pi_f == float_vector_ref_d_7pi_direct)) &&
+	      ((o2->v[5].d_7pi_f == float_vector_ref_d_7pi) || (o2->v[5].d_7pi_f == float_vector_ref_d_7pi_direct)))
+	    opc->v[0].fd = opt_d_mm_fff; /* a placeholder (never called) */
+	  else opc->v[0].fd = opt_d_dd_fff;
+	  return(finish_dd_fso(opc, o1, o2));
+	}}
+  if (o1->v[0].fd == opt_d_dd_sfo)
+    {
+      if (o2->v[0].fd == opt_d_dd_sfo)
+	{
+	  if ((o1->v[4].d_dd_f == multiply_d_dd) &&
+	      (o2->v[4].d_dd_f == multiply_d_dd) &&
+	      ((o1->v[5].d_7pi_f == float_vector_ref_d_7pi) || (o1->v[5].d_7pi_f == float_vector_ref_d_7pi_direct)) &&
+	      ((o2->v[5].d_7pi_f == float_vector_ref_d_7pi) || (o2->v[5].d_7pi_f == float_vector_ref_d_7pi_direct)))
+	    opc->v[0].fd = opt_d_mm_fff; /* multiply is commutative */
+	  else opc->v[0].fd = opt_d_dd_fff_rev;
+	  return(finish_dd_fso(opc, o1, o2));
+	}}
+  return_false(sc, NULL);
+}
+
+static s7_double opt_d_dd_cfo(opt_info *o)  {return(o->v[3].d_dd_f(o->v[2].x, o->v[4].d_v_f(o->v[1].obj)));}
+static s7_double opt_d_7dd_cfo(opt_info *o) {return(o->v[3].d_7dd_f(o->sc, o->v[2].x, o->v[4].d_v_f(o->v[1].obj)));}
+static s7_double opt_d_dd_cfo1(opt_info *o) {return(o->v[3].d_dd_f(o->v[4].x, o->v[5].d_vd_f(o->v[6].obj, real(slot_value(o->v[2].p)))));}
+static s7_double opt_d_7dd_cfo1(opt_info *o){return(o->v[3].d_7dd_f(o->sc, o->v[4].x, o->v[5].d_vd_f(o->v[6].obj, real(slot_value(o->v[2].p)))));}
+
+static bool d_dd_call_combinable(s7_scheme *sc, opt_info *opc, s7_d_dd_t func)
+{
+  if ((sc->pc > 1) &&
+      (opc == sc->opts[sc->pc - 2]))
+    {
+      opt_info *o1 = sc->opts[sc->pc - 1];
+      if (o1->v[0].fd == opt_d_v)
+	{
+	  opc->v[2].x = opc->v[1].x;
+	  opc->v[6].p = o1->v[1].p;
+	  opc->v[1].obj = o1->v[5].obj;
+	  opc->v[4].d_v_f = o1->v[3].d_v_f;
+	  opc->v[0].fd = (func) ? opt_d_dd_cfo : opt_d_7dd_cfo;
+	  backup_pc(sc);
+	  return_true(sc, NULL);
+	}
+      if (o1->v[0].fd == opt_d_vd_s)
+	{
+	  opc->v[4].x = opc->v[1].x;
+	  opc->v[1].p = o1->v[1].p;
+	  opc->v[6].obj = o1->v[5].obj;
+	  opc->v[2].p = o1->v[2].p;
+	  opc->v[5].d_vd_f = o1->v[3].d_vd_f;
+	  opc->v[0].fd = (func) ? opt_d_dd_cfo1 : opt_d_7dd_cfo1;
+	  backup_pc(sc);
+	  return_true(sc, NULL);
+	}}
+  return_false(sc, NULL);
+}
+
+static s7_double opt_d_7pii_scs(opt_info *o);
+static s7_double opt_d_7pii_sss(opt_info *o);
+static s7_double opt_d_7pii_sss_unchecked(opt_info *o);
+
+static bool d_dd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  s7_pointer slot, arg1 = cadr(car_x), arg2 = caddr(car_x);
+  int32_t start = sc->pc;
+  opt_info *o1;
+  s7_d_7dd_t func7 = NULL;
+  s7_d_dd_t func = s7_d_dd_function(s_func);
+  if (!func)
+    {
+      func7 = s7_d_7dd_function(s_func);
+      if (!func7) return_false(sc, car_x);
+    }
+  if (func)
+    opc->v[3].d_dd_f = func;
+  else opc->v[3].d_7dd_f = func7;
+
+  /* arg1 = real constant */
+  if (is_small_real(arg1))
+    {
+      if (is_small_real(arg2))
+	{
+	  if ((!is_t_real(arg1)) && (!is_t_real(arg2)))
+	    return_false(sc, car_x);
+	  opc->v[1].x = s7_number_to_real(sc, arg1);
+	  opc->v[2].x = s7_number_to_real(sc, arg2);
+	  opc->v[0].fd = (func) ? opt_d_dd_cc : opt_d_7dd_cc;
+	  return_true(sc, car_x);
+	}
+      slot = opt_float_symbol(sc, arg2);
+      if (slot)
+	{
+	  opc->v[1].p = slot;
+	  opc->v[2].x = s7_number_to_real(sc, arg1); /* move arg1? */
+	  opc->v[0].fd = (func) ? opt_d_dd_cs : opt_d_7dd_cs;
+	  return_true(sc, car_x);
+	}
+      if (float_optimize(sc, cddr(car_x)))
+	{
+	  opc->v[1].x = s7_number_to_real(sc, arg1);
+	  if (d_dd_call_combinable(sc, opc, func))
+	    return_true(sc, car_x);
+	  opc->v[4].o1 = sc->opts[start];
+	  opc->v[5].fd = sc->opts[start]->v[0].fd;
+	  opc->v[0].fd = (func) ? opt_d_dd_cf : opt_d_7dd_cf;
+	  if ((opc->v[1].x == 1.0) && (func == subtract_d_dd)) opc->v[0].fd = opt_d_dd_1f_subtract;
+	  return_true(sc, car_x);
+	}
+      sc->pc = start;
+      return_false(sc, car_x);
+    }
+
+  /* arg1 = float symbol */
+  slot = opt_float_symbol(sc, arg1);
+  if (slot)
+    {
+      opc->v[1].p = slot;
+      if (is_small_real(arg2))
+	{
+	  opc->v[2].x = s7_number_to_real(sc, arg2);
+	  if (func)
+	    opc->v[0].fd = (func == subtract_d_dd) ? opt_d_dd_sc_sub : opt_d_dd_sc;
+	  else opc->v[0].fd = opt_d_7dd_sc;
+	  return_true(sc, car_x);
+	}
+      slot = opt_float_symbol(sc, arg2);
+      if (slot)
+	{
+	  opc->v[2].p = slot;
+	  if (func)
+	    {
+	      if (func == multiply_d_dd)
+		opc->v[0].fd = opt_d_dd_ss_mul;
+	      else opc->v[0].fd = (func == add_d_dd) ? opt_d_dd_ss_add : opt_d_dd_ss;
+	    }
+	  else opc->v[0].fd = opt_d_7dd_ss;
+	  return_true(sc, car_x);
+	}
+      if (float_optimize(sc, cddr(car_x)))
+	{
+	  if (d_dd_sf_combinable(sc, opc, func))
+	    return_true(sc, car_x);
+	  opc->v[4].o1 = sc->opts[start];
+	  opc->v[5].fd = sc->opts[start]->v[0].fd;
+	  if (func)
+	    {
+	      opc->v[0].fd = (func == multiply_d_dd) ? opt_d_dd_sf_mul :
+		((func == add_d_dd) ? opt_d_dd_sf_add :
+		 ((func == subtract_d_dd) ? opt_d_dd_sf_sub : opt_d_dd_sf));
+	      if ((func == multiply_d_dd) && (opc->v[5].fd == opt_d_7pii_scs))
+		opc->v[0].fd = opt_d_dd_sf_mul_fvref;
+	    }
+	  else opc->v[0].fd = opt_d_7dd_sf;
+	  return_true(sc, car_x);
+	}
+      sc->pc = start;
+      return_false(sc, car_x);
+    }
+
+  /* arg1 = float expr or non-float */
+
+  /* first check for obvious d_id cases */
+  if (((is_t_integer(arg1)) || (opt_integer_symbol(sc, arg1))) &&
+      (s7_d_id_function(s_func)))
+    return(d_id_ok_1(sc, opc, s_func, car_x, false));
+
+  o1 = sc->opts[sc->pc];
+  if (float_optimize(sc, cdr(car_x)))
+    {
+      int32_t start2 = sc->pc;
+      if (is_small_real(arg2))
+	{
+	  opc->v[2].x = s7_number_to_real(sc, arg2);
+	  opc->v[4].o1 = sc->opts[start];
+	  opc->v[5].fd = sc->opts[start]->v[0].fd;
+	  if (func)
+	    {
+	      if (func == add_d_dd)
+		{
+		  opc->v[0].fd = (opc->v[5].fd == opt_d_7pi_ss_fvref_direct) ? opt_d_dd_fc_fvref_add : opt_d_dd_fc_add;
+		  return_true(sc, car_x);
+		}
+	      if (func == subtract_d_dd)
+		{
+		  opc->v[0].fd = opt_d_dd_fc_subtract;
+		  /* if o1->v[0].fd = opt_d_7d_c and its o->v[3].d_7d_f = random_d_7d it's (- (random f1) f2) */
+		  if ((opc == sc->opts[sc->pc - 2]) &&
+		      (sc->opts[start]->v[0].fd == opt_d_7d_c) &&
+		      (sc->opts[start]->v[3].d_7d_f == random_d_7d))
+		    {
+		      opc->v[0].fd = opt_subtract_random_f_f;
+		      opc->v[1].x = sc->opts[start]->v[1].x; /* random arg */
+		      backup_pc(sc);
+		    }}
+	      else opc->v[0].fd = opt_d_dd_fc;
+	    }
+	  else opc->v[0].fd = opt_d_7dd_fc;
+	  return_true(sc, car_x);
+	}
+      slot = opt_float_symbol(sc, arg2);
+      if (slot)
+	{
+	  opc->v[1].p = slot;
+	  if (d_dd_fs_combinable(sc, opc, func))
+	    return_true(sc, car_x);
+	  opc->v[4].o1 = sc->opts[start];
+	  opc->v[5].fd = sc->opts[start]->v[0].fd;
+	  if (func)
+	    {
+	      opc->v[0].fd = (func == multiply_d_dd) ? opt_d_dd_fs_mul :
+		((func == add_d_dd) ? opt_d_dd_fs_add :
+		 ((func == subtract_d_dd) ? opt_d_dd_fs_sub : opt_d_dd_fs));
+	      if ((func == add_d_dd) && (opc->v[5].fd == opt_d_7pii_scs))
+		opc->v[0].fd = opt_d_dd_fs_add_fvref;
+	    }
+	  else opc->v[0].fd = opt_d_7dd_fs;
+	  return_true(sc, car_x);
+	}
+      opc->v[10].o1 = sc->opts[sc->pc];
+      if (float_optimize(sc, cddr(car_x)))
+	{
+	  opt_info *o2;
+	  opc->v[8].o1 = o1;
+	  opc->v[9].fd = o1->v[0].fd;
+	  opc->v[11].fd = opc->v[10].o1->v[0].fd;
+	  if (func)
+	    {
+	      if (d_dd_ff_combinable(sc, opc, start))
+		return_true(sc, car_x);
+	      opc->v[0].fd = opt_d_dd_ff;
+	      if (func == multiply_d_dd)
+		{
+		  if (arg1 == arg2)
+		    opc->v[0].fd = opt_d_dd_ff_square;
+		  else
+		    if ((opc->v[9].fd == opt_d_7pii_sss_unchecked) && (opc->v[11].fd == opt_d_7pii_sss_unchecked) &&
+			(o1->v[4].d_7pii_f == float_vector_ref_d_7pii))
+		      opc->v[0].fd = opt_d_dd_ff_mul_sss_unchecked;
+		    else opc->v[0].fd = opt_d_dd_ff_mul;
+		  return_true(sc, car_x);
+		}
+	      o2 = sc->opts[start2]; /* this is opc->v[10].o1 */
+	      if (func == add_d_dd)
+		{
+		  if (o2->v[0].fd == opt_d_dd_ff_mul)
+		    {
+		      opc->v[0].fd = opt_d_dd_ff_add_mul;
+		      opc->v[4].o1 = o1;            /* add first arg */
+		      opc->v[5].fd = o1->v[0].fd;
+		      opc->v[8].o1 = o2->v[8].o1;   /* mul first arg */
+		      opc->v[9].fd = o2->v[9].fd;
+		      opc->v[10].o1 = o2->v[10].o1; /* mul second arg */
+		      opc->v[11].fd = o2->v[11].fd;
+		      return_true(sc, car_x);
+		    }
+		  if ((o2->v[0].fd == opt_d_7pi_sf) &&
+		      ((o2->v[3].d_7pi_f == float_vector_ref_d_7pi) || (o2->v[3].d_7pi_f == float_vector_ref_d_7pi_direct)))
+		    {
+		      opc->v[0].fd = opt_d_dd_ff_add_fv_ref;
+		      opc->v[6].p = o2->v[1].p;
+		      opc->v[8].o1 = o2->v[10].o1; /* sc->opts[start2 + 1]; */
+		      opc->v[9].fi = o2->v[11].fi; /* sc->opts[start2 + 1]->v[0].fi; */
+		    }
+		  else
+		    {
+		      opc->v[0].fd = opt_d_dd_ff_add;
+		      opc->v[10].o1 = o2;
+		      opc->v[11].fd = o2->v[0].fd;
+
+		      if ((o1->v[0].fd == opt_d_7pi_ss_fvref_direct) && (opc->v[11].fd == opt_d_7dd_ff))
+			{
+			  opt_info *ov = opc->v[10].o1;
+			  if ((ov->v[3].d_7dd_f == divide_d_7dd) && (ov->v[11].fd == opt_d_id_sf) && (ov->v[9].fd == opt_d_7pi_ss_fvref_direct))
+			    {
+			      opc->v[8].o1 = ov->v[8].o1;
+			      opc->v[10].o1 = ov->v[10].o1;
+			      opc->v[0].fd = opt_d_7dd_ff_add_div;
+			    }
+			  else opc->v[0].fd = opt_d_7dd_ff_add_fv_ref_direct;
+			}}
+		  opc->v[4].o1 = o1;              /* sc->opts[start]; */
+		  opc->v[5].fd = o1->v[0].fd;     /* sc->opts[start]->v[0].fd; */
+		  return_true(sc, car_x);
+		}
+	      if (func == subtract_d_dd)
+		{
+		  opc->v[0].fd = opt_d_dd_ff_sub;
+		  opc->v[4].o1 = o1;          /* sc->opts[start]; */
+		  opc->v[5].fd = o1->v[0].fd; /* sc->opts[start]->v[0].fd; */
+		  opc->v[10].o1 = o2;
+		  opc->v[11].fd = o2->v[0].fd;
+		  return_true(sc, car_x);
+		}}
+	  else
+	    {
+	      opc->v[0].fd = opt_d_7dd_ff;
+	      if ((opc->v[11].fd == opt_d_dd_ff_add_fv_ref) &&
+		  (opc->v[3].d_7dd_f == divide_d_7dd))
+		opc->v[0].fd = opt_d_7dd_ff_div_add;
+	    }
+	  return_true(sc, car_x);
+	}}
+  sc->pc = start;
+  return_false(sc, car_x);
+}
+
+/* -------- d_ddd -------- */
+static s7_double opt_d_ddd_sss(opt_info *o) {return(o->v[4].d_ddd_f(real(slot_value(o->v[1].p)), real(slot_value(o->v[2].p)), real(slot_value(o->v[3].p))));}
+static s7_double opt_d_ddd_ssf(opt_info *o) {return(o->v[4].d_ddd_f(real(slot_value(o->v[1].p)), real(slot_value(o->v[2].p)), o->v[11].fd(o->v[10].o1)));}
+
+static s7_double opt_d_ddd_sff(opt_info *o)
+{
+  s7_double x1 = o->v[11].fd(o->v[10].o1);
+  s7_double x2 = o->v[9].fd(o->v[8].o1);
+  return(o->v[4].d_ddd_f(real(slot_value(o->v[1].p)), x1, x2));
+}
+
+static s7_double opt_d_ddd_fff(opt_info *o)
+{
+  s7_double x1 = o->v[11].fd(o->v[10].o1);
+  s7_double x2 = o->v[9].fd(o->v[8].o1);
+  s7_double x3 = o->v[6].fd(o->v[5].o1);
+  return(o->v[4].d_ddd_f(x1, x2, x3));
+}
+
+static s7_double opt_d_ddd_fff1(opt_info *o)
+{
+  s7_double x1 = o->v[1].d_v_f(o->v[2].obj);
+  s7_double x2 = o->v[3].d_v_f(o->v[4].obj);
+  s7_double x3 = o->v[5].d_v_f(o->v[6].obj);
+  return(o->v[7].d_ddd_f(x1, x2, x3));
+}
+
+static s7_double opt_d_ddd_fff2(opt_info *o)
+{
+  s7_double x1 = o->v[1].d_v_f(o->v[2].obj);
+  s7_double x2 = o->v[9].fd(o->v[12].o1);
+  s7_double x3 = o->v[6].fd(o->v[5].o1);
+  return(o->v[7].d_ddd_f(x1, x2, x3));
+}
+
+static s7_double opt_d_ddd_fff_mul(opt_info *o)
+{
+  s7_double x1 = opt_D_s(o->v[10].o1);
+  s7_double x2 = opt_D_s(o->v[8].o1);
+  s7_double x3 = opt_d_s(o->v[5].o1);
+  return(multiply_d_ddd(x1, x2, x3));
+}
+
+static bool d_ddd_fff_combinable(s7_scheme *sc, opt_info *opc, int32_t start)
+{
+  opt_info *o1;
+  if (sc->opts[start]->v[0].fd != opt_d_v)
+    return_false(sc, NULL);
+  opc->v[12].o1 = opc->v[8].o1;
+  opc->v[7].d_ddd_f = opc->v[4].d_ddd_f;
+  o1 = sc->opts[start];
+  opc->v[1].d_v_f = o1->v[3].d_v_f;
+  opc->v[2].obj = o1->v[5].obj;
+  opc->v[8].p = o1->v[1].p;
+  if ((sc->opts[start + 1]->v[0].fd == opt_d_v) &&
+      (sc->opts[start + 2]->v[0].fd == opt_d_v))
+    {
+      opc->v[0].fd = opt_d_ddd_fff1;
+      o1 = sc->opts[start + 1];
+      opc->v[3].d_v_f = o1->v[3].d_v_f;
+      opc->v[4].obj = o1->v[5].obj;
+      opc->v[9].p = o1->v[1].p;
+      o1 = sc->opts[start + 2];
+      opc->v[5].d_v_f = o1->v[3].d_v_f;
+      opc->v[6].obj = o1->v[5].obj;
+      opc->v[10].p = o1->v[1].p;
+      sc->pc -= 3;
+      return_true(sc, NULL);
+    }
+  opc->v[0].fd = opt_d_ddd_fff2;
+  opc->v[9].fd = opc->v[12].o1->v[0].fd;
+  opc->v[6].fd = opc->v[5].o1->v[0].fd;
+  return_true(sc, NULL);
+}
+
+static bool d_ddd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  int32_t start = sc->pc;
+  s7_pointer slot, arg1 = cadr(car_x), arg2 = caddr(car_x);
+  s7_d_ddd_t f = s7_d_ddd_function(s_func);
+  if (!f)
+    return_false(sc, car_x);
+  opc->v[4].d_ddd_f = f;
+  slot = opt_float_symbol(sc, arg1);
+  opc->v[10].o1 = sc->opts[start];
+  if (slot)
+    {
+      opc->v[1].p = slot;
+      slot = opt_float_symbol(sc, arg2);
+      if (slot)
+	{
+	  s7_pointer arg3 = cadddr(car_x);
+	  opc->v[2].p = slot;
+	  slot = opt_float_symbol(sc, arg3);
+	  if (slot)
+	    {
+	      opc->v[3].p = slot;
+	      opc->v[0].fd = opt_d_ddd_sss;
+	      return_true(sc, car_x);
+	    }
+	  if (float_optimize(sc, cdddr(car_x)))
+	    {
+	      opc->v[11].fd = opc->v[10].o1->v[0].fd;
+	      opc->v[0].fd = opt_d_ddd_ssf;
+	      return_true(sc, car_x);
+	    }
+	  sc->pc = start;
+	}
+      if (float_optimize(sc, cddr(car_x)))
+	{
+	  opc->v[8].o1 = sc->opts[sc->pc];
+	  if (float_optimize(sc, cdddr(car_x)))
+	    {
+	      opc->v[0].fd = opt_d_ddd_sff;
+	      opc->v[11].fd = opc->v[10].o1->v[0].fd;
+	      opc->v[9].fd = opc->v[8].o1->v[0].fd;
+	      return_true(sc, car_x);
+	    }}
+      sc->pc = start;
+    }
+  if (float_optimize(sc, cdr(car_x)))
+    {
+      opc->v[8].o1 = sc->opts[sc->pc];
+      if (float_optimize(sc, cddr(car_x)))
+	{
+	  opc->v[5].o1 = sc->opts[sc->pc];
+	  if (float_optimize(sc, cdddr(car_x)))
+	    {
+	      if (d_ddd_fff_combinable(sc, opc, start))
+		return_true(sc, car_x);
+	      opc->v[0].fd = opt_d_ddd_fff; /* tfft: (* xout xin iw) (+ (* xout xin iw) (* yout yin ih) (* zout zin id)) */
+	      opc->v[11].fd = opc->v[10].o1->v[0].fd;
+	      opc->v[9].fd = opc->v[8].o1->v[0].fd;
+	      opc->v[6].fd = opc->v[5].o1->v[0].fd;
+	      if ((f == multiply_d_ddd) && (opc->v[11].fd == opt_D_s) && (opc->v[9].fd == opt_D_s) && (opc->v[6].fd == opt_d_s))
+		opc->v[0].fd = opt_d_ddd_fff_mul;
+	      return_true(sc, car_x);
+	    }}}
+  sc->pc = start;
+  return_false(sc, car_x);
+}
+
+/* -------- d_7pid -------- */
+static s7_double opt_d_7pid_ssf(opt_info *o)
+{
+  return(o->v[4].d_7pid_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o->v[11].fd(o->v[10].o1)));
+}
+
+static s7_pointer opt_d_7pid_ssf_nr(opt_info *o)
+{
+  o->v[4].d_7pid_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o->v[11].fd(o->v[10].o1));
+  return(NULL);
+}
+
+static s7_double opt_d_7pid_sss(opt_info *o)
+{
+  return(o->v[4].d_7pid_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), real(slot_value(o->v[3].p))));
+}
+
+static s7_double opt_d_7pid_ssc(opt_info *o)
+{
+  return(o->v[4].d_7pid_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o->v[3].x));
+}
+
+static s7_double opt_d_7pid_sff(opt_info *o)
+{
+  s7_int pos = o->v[11].fi(o->v[10].o1);
+  return(o->v[4].d_7pid_f(o->sc, slot_value(o->v[1].p), pos, o->v[9].fd(o->v[8].o1)));
+}
+
+static s7_double opt_d_7pid_sff_fvset(opt_info *o)
+{
+  s7_int pos = o->v[11].fi(o->v[10].o1);
+  return(float_vector_set_d_7pid(o->sc, slot_value(o->v[1].p), pos, o->v[9].fd(o->v[8].o1)));
+}
+
+static s7_double opt_d_7pid_sso(opt_info *o)
+{
+  return(o->v[4].d_7pid_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o->v[5].d_v_f(o->v[3].obj)));
+}
+
+static s7_double opt_d_7pid_ss_ss(opt_info *o)
+{
+  return(o->v[4].d_7pid_f(o->sc, slot_value(o->v[1].p),
+			  integer(slot_value(o->v[2].p)),
+			  o->v[3].d_7pi_f(o->sc, slot_value(o->v[5].p), integer(slot_value(o->v[6].p)))));
+}
+
+static s7_double opt_d_7pid_ssfo(opt_info *o)
+{
+  s7_pointer fv = slot_value(o->v[1].p);
+  return(o->v[4].d_7pid_f(o->sc, fv, integer(slot_value(o->v[2].p)),
+	    o->v[6].d_dd_f(o->v[5].d_7pi_f(o->sc, fv, integer(slot_value(o->v[3].p))), real(slot_value(o->v[8].p)))));
+}
+
+static s7_double opt_d_7pid_ssfo_fv(opt_info *o)
+{
+  s7_double *els = float_vector_floats(slot_value(o->v[1].p));
+  s7_double val = o->v[6].d_dd_f(els[integer(slot_value(o->v[3].p))], real(slot_value(o->v[8].p)));
+  els[integer(slot_value(o->v[2].p))] = val;
+  return(val);
+}
+
+static s7_pointer opt_d_7pid_ssfo_fv_nr(opt_info *o) /* these next are variations on (float-vector-set! s (float-vector-ref s...)) */
+{
+  s7_double *els = float_vector_floats(slot_value(o->v[1].p));
+  els[integer(slot_value(o->v[2].p))] = o->v[6].d_dd_f(els[integer(slot_value(o->v[3].p))], real(slot_value(o->v[8].p)));
+  return(NULL);
+}
+
+static s7_pointer opt_d_7pid_ssfo_fv_add_nr(opt_info *o)
+{
+  s7_double *els = float_vector_floats(slot_value(o->v[1].p));
+  els[integer(slot_value(o->v[2].p))] = els[integer(slot_value(o->v[3].p))] + real(slot_value(o->v[8].p));
+  return(NULL);
+}
+
+static s7_pointer opt_d_7pid_ssfo_fv_sub_nr(opt_info *o)
+{
+  s7_double *els = float_vector_floats(slot_value(o->v[1].p));
+  els[integer(slot_value(o->v[2].p))] = els[integer(slot_value(o->v[3].p))] - real(slot_value(o->v[8].p));
+  return(NULL);
+}
+
+static bool d_7pid_ssf_combinable(s7_scheme *sc, opt_info *opc)
+{
+  if ((sc->pc > 1) &&
+      (opc == sc->opts[sc->pc - 2]))
+    {
+      opt_info *o1 = sc->opts[sc->pc - 1];
+      if (o1->v[0].fd == opt_d_v)
+	{
+	  opc->v[6].p = o1->v[1].p;
+	  opc->v[3].obj = o1->v[5].obj;
+	  opc->v[5].d_v_f = o1->v[3].d_v_f;
+	  opc->v[0].fd = opt_d_7pid_sso;
+	  backup_pc(sc);
+	  return_true(sc, NULL);
+	}
+      if ((o1->v[0].fd == opt_d_7pi_ss) || (o1->v[0].fd == opt_d_7pi_ss_fvref) || (o1->v[0].fd == opt_d_7pi_ss_fvref_direct))
+	{
+	  opc->v[3].d_7pi_f = o1->v[3].d_7pi_f;
+	  opc->v[5].p = o1->v[1].p;
+	  opc->v[6].p = o1->v[2].p;
+	  opc->v[0].fd = opt_d_7pid_ss_ss;
+	  backup_pc(sc);
+	  return_true(sc, NULL);
+	}
+      if ((o1->v[0].fd == opt_d_dd_fso) &&
+	  (opc->v[1].p == o1->v[2].p))
+	{
+	  /* opc: pid_ssf: o->v[4].d_7pid_f(slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o1->v[0].fd(o1))
+	   * o1: d_dd_fso: o->v[4].d_dd_f(o->v[5].d_7pi_f(slot_value(o->v[2].p), integer(slot_value(o->v[3].p))), real(slot_value(o->v[1].p))))
+	   */
+	  opc->v[6].d_dd_f = o1->v[4].d_dd_f;
+	  opc->v[5].d_7pi_f = o1->v[5].d_7pi_f;
+	  opc->v[3].p = o1->v[3].p;
+	  opc->v[8].p = o1->v[1].p;
+	  opc->v[0].fd = opt_d_7pid_ssfo;
+	  if (((opc->v[5].d_7pi_f == float_vector_ref_d_7pi) || (opc->v[5].d_7pi_f == float_vector_ref_d_7pi_direct)) &&
+	      ((opc->v[4].d_7pid_f == float_vector_set_d_7pid_direct) || (opc->v[4].d_7pid_f == float_vector_set_d_7pid)))
+	    opc->v[0].fd = opt_d_7pid_ssfo_fv; /* actually if either is *_d, we need to check the indices */
+	  backup_pc(sc);
+	  return_true(sc, NULL);
+	}}
+  return_false(sc, NULL);
+}
+
+static bool opt_float_vector_set(s7_scheme *sc, opt_info *opc, s7_pointer v, s7_pointer indexp1, s7_pointer indexp2, s7_pointer indexp3, s7_pointer valp);
+
+static bool d_7pid_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  s7_d_7pid_t f = s7_d_7pid_function(s_func);
+  if ((f) &&
+      (is_symbol(cadr(car_x))))
+    {
+      s7_pointer slot, head = car(car_x);
+      int32_t start = sc->pc;
+      opc->v[4].d_7pid_f = f;
+
+      if (is_target_or_its_alias(head, s_func, sc->float_vector_set_symbol))
+	return(opt_float_vector_set(sc, opc, cadr(car_x), cddr(car_x), NULL, NULL, cdddr(car_x)));
+
+      opc->v[1].p = s7_slot(sc, cadr(car_x));
+      opc->v[10].o1 = sc->opts[start];
+      if (is_slot(opc->v[1].p))
+	{
+	  slot = opt_integer_symbol(sc, caddr(car_x));
+	  if (slot)
+	    {
+	      opc->v[2].p = slot;
+	      slot = opt_float_symbol(sc, cadddr(car_x));
+	      if (slot)
+		{
+		  opc->v[3].p = slot;
+		  opc->v[0].fd = opt_d_7pid_sss;
+		  return_true(sc, car_x);
+		}
+	      if (float_optimize(sc, cdddr(car_x)))
+		{
+		  opc->v[11].fd = sc->opts[start]->v[0].fd;
+		  if (d_7pid_ssf_combinable(sc, opc))
+		    return_true(sc, car_x);
+		  opc->v[0].fd = opt_d_7pid_ssf;
+		  return_true(sc, car_x);
+		}
+	      sc->pc = start;
+	    }
+	  if (int_optimize(sc, cddr(car_x)))
+	    {
+	      opc->v[8].o1 = sc->opts[sc->pc];
+	      if (float_optimize(sc, cdddr(car_x)))
+		{
+		  opc->v[0].fd = opt_d_7pid_sff;
+		  opc->v[11].fi = opc->v[10].o1->v[0].fi;
+		  opc->v[9].fd = opc->v[8].o1->v[0].fd;
+		  return_true(sc, car_x);
+		}}
+	  sc->pc = start;
+	}}
+  return_false(sc, car_x);
+}
+
+/* -------- d_7pii -------- */
+/* currently this can only be float_vector_ref_d_7pii (d_7pii is not exported at this time) */
+
+static s7_double opt_d_7pii_sss(opt_info *o)
+{ /*     o->v[4].d_7pii_f */
+  return(float_vector_ref_d_7pii(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), integer(slot_value(o->v[3].p))));
+}
+
+static s7_double opt_d_7pii_sss_unchecked(opt_info *o)
+{
+  s7_pointer v = slot_value(o->v[1].p);
+  return(float_vector(v, ((integer(slot_value(o->v[2].p)) * vector_offset(v, 0)) + integer(slot_value(o->v[3].p)))));
+}
+
+static s7_double opt_d_7pii_scs(opt_info *o)
+{
+  return(float_vector_ref_d_7pii(o->sc, slot_value(o->v[1].p), o->v[2].i, integer(slot_value(o->v[3].p))));
+}
+
+static s7_double opt_d_7pii_sff(opt_info *o)
+{
+  return(float_vector_ref_d_7pii(o->sc, slot_value(o->v[1].p), o->v[11].fi(o->v[10].o1), o->v[9].fi(o->v[8].o1)));
+}
+
+static bool d_7pii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  s7_d_7pii_t ifunc = s7_d_7pii_function(s_func);
+  if ((ifunc == float_vector_ref_d_7pii) &&
+      (is_symbol(cadr(car_x))))
+    {
+      s7_pointer slot;
+      int32_t start = sc->pc;
+      opc->v[1].p = s7_slot(sc, cadr(car_x));
+      if ((!is_slot(opc->v[1].p)) ||
+	  (!is_float_vector(slot_value(opc->v[1].p))) ||
+	  (vector_rank(slot_value(opc->v[1].p)) != 2))
+	return_false(sc, car_x);
+
+      opc->v[4].d_7pii_f = ifunc; /* currently pointless */
+      slot = opt_integer_symbol(sc, cadddr(car_x));
+      if (slot)
+	{
+	  opc->v[3].p = slot;
+	  slot = opt_integer_symbol(sc, caddr(car_x));
+	  if (slot)
+	    {
+	      opc->v[2].p = slot;
+	      opc->v[0].fd = opt_d_7pii_sss;
+	      if ((loop_end_fits(opc->v[2].p, vector_dimension(slot_value(opc->v[1].p), 0))) &&
+		  (loop_end_fits(opc->v[3].p, vector_dimension(slot_value(opc->v[1].p), 1))))
+		opc->v[0].fd = opt_d_7pii_sss_unchecked;
+	      return_true(sc, car_x);
+	    }
+	  if (is_t_integer(caddr(car_x)))
+	    {
+	      opc->v[2].i = integer(caddr(car_x));
+	      opc->v[0].fd = opt_d_7pii_scs;
+	      return_true(sc, car_x);
+	    }}
+      opc->v[10].o1 = sc->opts[start];
+      if (int_optimize(sc, cddr(car_x)))
+	{
+	  opc->v[8].o1 = sc->opts[sc->pc];
+	  if (int_optimize(sc, cdddr(car_x)))
+	    {
+	      opc->v[0].fd = opt_d_7pii_sff;
+	      opc->v[11].fi = opc->v[10].o1->v[0].fi;
+	      opc->v[9].fi = opc->v[8].o1->v[0].fi;
+	      return_true(sc, car_x);
+	    }}
+      sc->pc = start;
+    }
+  return_false(sc, car_x);
+}
+
+/* -------- d_7piid -------- */
+/* currently only float_vector_set */
+
+static s7_double opt_d_7piid_sssf(opt_info *o)
+{ /*     o->v[5].d_7piid_f and below */
+  return(float_vector_set_d_7piid(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), integer(slot_value(o->v[3].p)), o->v[9].fd(o->v[8].o1)));
+}
+
+static s7_double opt_d_7piid_sssc(opt_info *o)
+{
+  return(float_vector_set_d_7piid(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), integer(slot_value(o->v[3].p)), o->v[4].x));
+}
+
+static s7_double opt_d_7piid_scsf(opt_info *o)
+{
+  return(float_vector_set_d_7piid(o->sc, slot_value(o->v[1].p), o->v[2].i, integer(slot_value(o->v[3].p)), o->v[11].fd(o->v[10].o1)));
+}
+
+static s7_double opt_d_7piid_sfff(opt_info *o)
+{
+  s7_int i1 = o->v[11].fi(o->v[10].o1);
+  s7_int i2 = o->v[9].fi(o->v[8].o1);
+  return(float_vector_set_d_7piid(o->sc, slot_value(o->v[1].p), i1, i2, o->v[4].fd(o->v[3].o1)));
+}
+
+static s7_double opt_d_7piid_sssf_unchecked(opt_info *o) /* this could be subsumed by the call above if we were using o->v[5] or o->v[0].fd */
+{
+  s7_int i1 = integer(slot_value(o->v[2].p)), i2 = integer(slot_value(o->v[3].p));
+  s7_pointer vect = slot_value(o->v[1].p);
+  s7_double val = o->v[9].fd(o->v[8].o1);
+  float_vector(vect, (i1 * (vector_offset(vect, 0)) + i2)) = val;
+  return(val);
+}
+
+static bool d_7piid_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  s7_d_7piid_t f = s7_d_7piid_function(s_func);
+  if ((f) &&
+      (is_symbol(cadr(car_x))))
+    {
+      opc->v[4].d_7piid_f = f;
+      if (is_target_or_its_alias(car(car_x), s_func, sc->float_vector_set_symbol))
+	return(opt_float_vector_set(sc, opc, cadr(car_x), cddr(car_x), cdddr(car_x), NULL, cddddr(car_x)));
+    }
+  return_false(sc, car_x);
+}
+
+/* -------- d_7piii -------- */
+static s7_double opt_d_7piii_ssss(opt_info *o)
+{
+  return(float_vector_ref_d_7piii(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)),
+				  integer(slot_value(o->v[3].p)), integer(slot_value(o->v[5].p))));
+}
+
+static s7_double opt_d_7piii_ssss_unchecked(opt_info *o)
+{
+  s7_pointer v = slot_value(o->v[1].p);
+  s7_int i1 = integer(slot_value(o->v[2].p)) * vector_offset(v, 0);
+  s7_int i2 = integer(slot_value(o->v[3].p)) * vector_offset(v, 1); /* offsets accumulate */
+  return(float_vector(v, (i1 + i2 + integer(slot_value(o->v[5].p)))));
+}
+
+static bool d_7piii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  s7_d_7piii_t ifunc = s7_d_7piii_function(s_func);
+  if ((ifunc == float_vector_ref_d_7piii) &&
+      (is_symbol(cadr(car_x))))
+    {
+      s7_pointer slot;
+      opc->v[1].p = s7_slot(sc, cadr(car_x));
+      if ((!is_slot(opc->v[1].p)) ||
+	  (!is_float_vector(slot_value(opc->v[1].p))) ||
+	  (vector_rank(slot_value(opc->v[1].p)) != 3))
+	return_false(sc, car_x);
+
+      opc->v[4].d_7piii_f = ifunc; /* currently ignored */
+      slot = opt_integer_symbol(sc, car(cddddr(car_x)));
+      if (slot)
+	{
+	  opc->v[5].p = slot;
+	  slot = opt_integer_symbol(sc, cadddr(car_x));
+	  if (slot)
+	    {
+	      opc->v[3].p = slot;
+	      slot = opt_integer_symbol(sc, caddr(car_x));
+	      if (slot)
+		{
+		  s7_pointer vect = slot_value(opc->v[1].p);
+		  opc->v[2].p = slot;
+		  opc->v[0].fd = opt_d_7piii_ssss;
+		  if ((loop_end_fits(opc->v[2].p, vector_dimension(vect, 0))) &&
+		      (loop_end_fits(opc->v[3].p, vector_dimension(vect, 1))) &&
+		      (loop_end_fits(opc->v[5].p, vector_dimension(vect, 2))))
+		    opc->v[0].fd = opt_d_7piii_ssss_unchecked;
+		  return_true(sc, car_x);
+		}}}}
+  return_false(sc, car_x);
+}
+
+/* -------- d_7piiid -------- */
+static s7_double opt_d_7piiid_ssssf(opt_info *o)
+{
+  return(float_vector_set_d_7piiid(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)),
+				   integer(slot_value(o->v[3].p)), integer(slot_value(o->v[5].p)), o->v[11].fd(o->v[10].o1)));
+}
+
+static s7_double opt_d_7piiid_ssssf_unchecked(opt_info *o)
+{
+  s7_pointer vect = slot_value(o->v[1].p);
+  s7_int i1 = integer(slot_value(o->v[2].p)) * vector_offset(vect, 0);
+  s7_int i2 = integer(slot_value(o->v[3].p)) * vector_offset(vect, 1);
+  s7_int i3 = integer(slot_value(o->v[5].p));
+  s7_double val = o->v[11].fd(o->v[10].o1);
+  float_vector(vect, (i1 + i2 + i3)) = val;
+  return(val);
+}
+
+static bool d_7piiid_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  s7_d_7piiid_t f = s7_d_7piiid_function(s_func);
+  if ((f == float_vector_set_d_7piiid) &&
+      (is_symbol(cadr(car_x))))
+    {
+      opc->v[4].d_7piiid_f = f;
+      if (is_target_or_its_alias(car(car_x), s_func, sc->float_vector_set_symbol))
+	return(opt_float_vector_set(sc, opc, cadr(car_x), cddr(car_x), cdddr(car_x), cddddr(car_x), cdr(cddddr(car_x))));
+    }
+  return_false(sc, car_x);
+}
+
+static bool opt_float_vector_set(s7_scheme *sc, opt_info *opc, s7_pointer v, s7_pointer indexp1, s7_pointer indexp2, s7_pointer indexp3, s7_pointer valp)
+{
+  s7_pointer settee = s7_slot(sc, v);
+  if ((is_slot(settee)) &&
+      (!is_immutable(slot_value(settee))))
+    {
+      s7_pointer slot, vect = slot_value(settee);
+      int32_t start = sc->pc;
+      opc->v[1].p = settee;
+      if (!is_float_vector(vect))
+	return_false(sc, vect);
+      opc->v[10].o1 = sc->opts[start];
+      if ((!indexp2) &&
+	  (vector_rank(vect) == 1))
+	{
+	  opc->v[4].d_7pid_f = float_vector_set_d_7pid;
+	  slot = opt_integer_symbol(sc, car(indexp1));
+	  if (slot)
+	    {
+	      opc->v[2].p = slot;
+	      if (loop_end_fits(opc->v[2].p, vector_length(vect)))
+		opc->v[4].d_7pid_f = float_vector_set_d_7pid_direct;
+	      slot = opt_float_symbol(sc, car(valp));
+	      if (slot)
+		{
+		  opc->v[3].p = slot;
+		  opc->v[0].fd = opt_d_7pid_sss;
+		  return_true(sc, NULL);
+		}
+	      if (is_small_real(car(valp)))
+		{
+		  opc->v[3].x = s7_real(car(valp));
+		  opc->v[0].fd = opt_d_7pid_ssc;
+		  return_true(sc, NULL);
+		}
+	      if (float_optimize(sc, valp))
+		{
+		  opc->v[11].fd = sc->opts[start]->v[0].fd;
+		  if (d_7pid_ssf_combinable(sc, opc))
+		    return_true(sc, NULL);
+		  opc->v[0].fd = opt_d_7pid_ssf;
+		  return_true(sc, NULL);
+		}
+	      sc->pc = start;
+	    }
+	  if (int_optimize(sc, indexp1))
+	    {
+	      opc->v[8].o1 = sc->opts[sc->pc];
+	      if (float_optimize(sc, valp))
+		{
+		  opc->v[0].fd = (opc->v[4].d_7pid_f == float_vector_set_d_7pid) ? opt_d_7pid_sff_fvset : opt_d_7pid_sff;
+		  opc->v[11].fi = opc->v[10].o1->v[0].fi;
+		  opc->v[9].fd = opc->v[8].o1->v[0].fd;
+		  return_true(sc, NULL);
+		}}
+	  return_false(sc, indexp1);
+	}
+      if ((indexp2) && (!indexp3) &&
+	  (vector_rank(vect) == 2))
+	{
+	  opc->v[5].d_7piid_f = float_vector_set_d_7piid;
+	  /* could check for loop_end/end-ok here for both indices, but the d_7pii* functions currently assume fv_d_7piid
+	   *    perhaps set a different fd? so opc->v[0].fd = fvset_unchecked_d_7piid or whatever
+	   */
+	  slot = opt_integer_symbol(sc, car(indexp2));
+	  if (slot)
+	    {
+	      opc->v[3].p = slot;
+	      if (is_t_integer(car(indexp1)))
+		{
+		  if (!float_optimize(sc, valp))
+		    return_false(sc, valp);
+		  opc->v[0].fd = opt_d_7piid_scsf;
+		  opc->v[2].i = integer(car(indexp1));
+		  opc->v[11].fd = opc->v[10].o1->v[0].fd;
+		  return_true(sc, NULL);
+		}
+	      slot = opt_integer_symbol(sc, car(indexp1));
+	      if (slot)
+		{
+		  opc->v[2].p = slot;
+		  if (is_small_real(car(valp)))
+		    {
+		      opc->v[0].fd = opt_d_7piid_sssc;
+		      opc->v[4].x = s7_real(car(valp));
+		      return_true(sc, NULL);
+		    }
+		  opc->v[8].o1 = sc->opts[sc->pc];
+		  if (float_optimize(sc, valp))
+		    {
+		      opc->v[0].fd = opt_d_7piid_sssf;
+		      opc->v[9].fd = opc->v[8].o1->v[0].fd;
+
+		      if ((loop_end_fits(opc->v[2].p, vector_dimension(vect, 0))) &&
+			  (loop_end_fits(opc->v[3].p, vector_dimension(vect, 1))))
+			opc->v[0].fd = opt_d_7piid_sssf_unchecked;
+		      return_true(sc, NULL);
+		    }
+		  sc->pc = start;
+		}}
+	  if (int_optimize(sc, indexp1))
+	    {
+	      opc->v[8].o1 = sc->opts[sc->pc];
+	      if (int_optimize(sc, indexp2))
+		{
+		  opc->v[3].o1 = sc->opts[sc->pc];
+		  if (float_optimize(sc, valp))
+		    {
+		      opc->v[0].fd = opt_d_7piid_sfff;
+		      opc->v[11].fi = opc->v[10].o1->v[0].fi;
+		      opc->v[9].fi = opc->v[8].o1->v[0].fi;
+		      opc->v[4].fd = opc->v[3].o1->v[0].fd;
+		      return_true(sc, NULL);
+		    }}}
+	  return_false(sc, indexp1);
+	}
+      if ((indexp3) &&
+	  (vector_rank(vect) == 3))
+	{
+	  opc->v[4].d_7piiid_f = float_vector_set_d_7piiid;
+	  slot = opt_integer_symbol(sc, car(indexp3));
+	  if (slot)
+	    {
+	      opc->v[5].p = slot;
+	      slot = opt_integer_symbol(sc, car(indexp2));
+	      if (slot)
+		{
+		  opc->v[3].p = slot;
+		  slot = opt_integer_symbol(sc, car(indexp1));
+		  if (slot)
+		    {
+		      opc->v[2].p = slot;
+		      if (float_optimize(sc, valp))
+			{
+			  opc->v[0].fd = opt_d_7piiid_ssssf;
+			  opc->v[11].fd = sc->opts[start]->v[0].fd;
+			  if ((loop_end_fits(opc->v[2].p, vector_dimension(vect, 0))) &&
+			      (loop_end_fits(opc->v[3].p, vector_dimension(vect, 1))) &&
+			      (loop_end_fits(opc->v[5].p, vector_dimension(vect, 2))))
+			    opc->v[0].fd = opt_d_7piiid_ssssf_unchecked;
+			  return_true(sc, NULL);
+			}}}}}}
+  return_false(sc, NULL);
+}
+
+
+/* -------- d_vid -------- */
+static s7_double opt_d_vid_ssf(opt_info *o) {return(o->v[4].d_vid_f(o->v[5].obj, integer(slot_value(o->v[2].p)), o->v[11].fd(o->v[10].o1)));}
+
+static inline s7_double opt_fmv(opt_info *o)
+{
+  /* d_vid_ssf -> d_dd_ff_o1 -> d_vd_o1 -> d_dd_ff_o3, this is a placeholder */
+  opt_info *o1 = o->v[12].o1;
+  opt_info *o2 = o->v[13].o1;
+  opt_info *o3 = o->v[14].o1;
+  s7_double amp_env = o1->v[2].d_v_f(o1->v[1].obj);
+  s7_double vib = real(slot_value(o2->v[2].p));
+  s7_double index_env = o3->v[5].d_v_f(o3->v[1].obj);
+  return(o->v[4].d_vid_f(o->v[5].obj,
+			 integer(slot_value(o->v[2].p)),
+			 amp_env * o2->v[3].d_vd_f(o2->v[5].obj,
+						   vib + (index_env * o3->v[6].d_vd_f(o3->v[2].obj, vib)))));
+}
+
+static bool d_vid_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  if ((is_symbol(cadr(car_x))) &&
+      (is_symbol(caddr(car_x))))
+    {
+      s7_pointer sig;
+      s7_d_vid_t flt = s7_d_vid_function(s_func);
+      if (!flt)
+	return_false(sc, car_x);
+      opc->v[4].d_vid_f = flt;
+      sig = c_function_signature(s_func);
+      if (is_pair(sig))
+	{
+	  int32_t start = sc->pc;
+	  s7_pointer vslot = opt_types_match(sc, cadr(sig), cadr(car_x));
+	  if (vslot)
+	    {
+	      s7_pointer slot;
+	      opc->v[0].fd = opt_d_vid_ssf;
+	      opc->v[1].p = vslot;
+	      opc->v[10].o1 = sc->opts[start];
+	      slot = opt_integer_symbol(sc, caddr(car_x));
+	      if ((slot) &&
+		  (float_optimize(sc, cdddr(car_x))))
+		{
+		  opt_info *o2;
+		  opc->v[2].p = slot;
+		  opc->v[5].obj = (void *)c_object_value(slot_value(vslot));
+		  opc->v[11].fd = opc->v[10].o1->v[0].fd;
+		  o2 = sc->opts[start];
+		  if (o2->v[0].fd == opt_d_dd_ff_mul1)
+		    {
+		      opt_info *o3 = sc->opts[start + 2];
+		      if (o3->v[0].fd == opt_d_vd_o1)
+			{
+			  opt_info *o1 = sc->opts[start + 4];
+			  if ((o1->v[0].fd == opt_d_dd_ff_o3) &&
+			      (o1->v[4].d_dd_f == multiply_d_dd) &&
+			      (o3->v[4].d_dd_f == add_d_dd))
+			    {
+			      opc->v[0].fd = opt_fmv; /* a placeholder -- see below */
+			      opc->v[12].o1 = o2;
+			      opc->v[13].o1 = o3;
+			      opc->v[14].o1 = o1;
+			    }}}
+		  return_true(sc, car_x);
+		}}
+	  sc->pc = start;
+	}}
+  return_false(sc, car_x);
+}
+
+/* -------- d_vdd -------- */
+static s7_double opt_d_vdd_ff(opt_info *o)
+{
+  s7_double x1 = o->v[11].fd(o->v[10].o1);
+  s7_double x2 = o->v[9].fd(o->v[8].o1);
+  return(o->v[4].d_vdd_f(o->v[5].obj, x1, x2));
+}
+
+static bool d_vdd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  s7_d_vdd_t flt = s7_d_vdd_function(s_func);
+  if (flt)
+    {
+      s7_pointer sig = c_function_signature(s_func);
+      opc->v[4].d_vdd_f = flt;
+      if (is_pair(sig))
+	{
+	  s7_pointer slot = opt_types_match(sc, cadr(sig), cadr(car_x));
+	  if (slot)
+	    {
+	      int32_t start = sc->pc;
+	      opc->v[10].o1 = sc->opts[start];
+	      if (float_optimize(sc, cddr(car_x)))
+		{
+		  opc->v[8].o1 = sc->opts[sc->pc];
+		  if (float_optimize(sc, cdddr(car_x)))
+		    {
+		      opc->v[11].fd = opc->v[10].o1->v[0].fd;
+		      opc->v[9].fd = opc->v[8].o1->v[0].fd;
+		      opc->v[1].p = slot;
+		      opc->v[5].obj = (void *)c_object_value(slot_value(slot));
+		      opc->v[0].fd = opt_d_vdd_ff;
+		      return_true(sc, car_x);
+		    }}
+	      sc->pc = start;
+	    }}}
+  return_false(sc, car_x);
+}
+
+
+/* -------- d_dddd -------- */
+static s7_double opt_d_dddd_ffff(opt_info *o)
+{
+  s7_double x1 = o->v[11].fd(o->v[10].o1);
+  s7_double x2 = o->v[9].fd(o->v[8].o1);
+  s7_double x3 = o->v[5].fd(o->v[4].o1);
+  s7_double x4 = o->v[3].fd(o->v[2].o1);
+  return(o->v[1].d_dddd_f(x1, x2, x3, x4));
+}
+
+static bool d_dddd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  s7_d_dddd_t f = s7_d_dddd_function(s_func);
+  if (!f)
+    return_false(sc, car_x);
+  opc->v[10].o1 = sc->opts[sc->pc];
+  if (float_optimize(sc, cdr(car_x)))
+    {
+      opc->v[8].o1 = sc->opts[sc->pc];
+      if (float_optimize(sc, cddr(car_x)))
+	{
+	  opc->v[4].o1 = sc->opts[sc->pc];
+	  if (float_optimize(sc, cdddr(car_x)))
+	    {
+	      opc->v[2].o1 = sc->opts[sc->pc];
+	      if (float_optimize(sc, cddddr(car_x)))
+		{
+		  opc->v[1].d_dddd_f = f;
+		  opc->v[0].fd = opt_d_dddd_ffff;
+		  opc->v[11].fd = opc->v[10].o1->v[0].fd;
+		  opc->v[9].fd = opc->v[8].o1->v[0].fd;
+		  opc->v[5].fd = opc->v[4].o1->v[0].fd;
+		  opc->v[3].fd = opc->v[2].o1->v[0].fd;
+		  return_true(sc, car_x);
+		}}}}
+  return_false(sc, car_x);
+}
+
+/* -------- d_add|multiply|subtract_any ------- */
+static s7_double opt_d_add_any_f(opt_info *o)
+{
+  s7_double sum = 0.0;
+  for (s7_int i = 0; i < o->v[1].i; i++)
+    {
+      opt_info *o1 = o->v[i + 2].o1;
+      sum += o1->v[0].fd(o1);
+    }
+  return(sum);
+}
+
+static s7_double opt_d_multiply_any_f(opt_info *o)
+{
+  s7_double sum = 1.0;
+  for (s7_int i = 0; i < o->v[1].i; i++)
+    {
+      opt_info *o1 = o->v[i + 2].o1;
+      sum *= o1->v[0].fd(o1);
+    }
+  return(sum);
+}
+
+static bool d_add_any_ok(s7_scheme *sc, opt_info *opc, s7_pointer car_x)
+{
+  s7_pointer head = car(car_x);
+  int32_t start = sc->pc;
+  if ((head == sc->add_symbol) ||
+      (head == sc->multiply_symbol))
+    {
+      s7_pointer p;
+      int32_t cur_len;
+      for (cur_len = 0, p = cdr(car_x); (is_pair(p)) && (cur_len < 12); p = cdr(p), cur_len++)
+	{
+	  opc->v[cur_len + 2].o1 = sc->opts[sc->pc];
+	  if (!float_optimize(sc, p))
+	    break;
+	}
+      if (is_null(p))
+	{
+	  opc->v[1].i = cur_len;
+	  opc->v[0].fd = (head == sc->add_symbol) ? opt_d_add_any_f : opt_d_multiply_any_f;
+	  return_true(sc, car_x);
+	}}
+  sc->pc = start;
+  return_false(sc, car_x);
+}
+
+
+/* -------- d_syntax -------- */
+static s7_double opt_set_d_d_f(opt_info *o)
+{
+  s7_double x = o->v[3].fd(o->v[2].o1);
+  slot_set_value(o->v[1].p, make_real(o->sc, x));
+  return(x);
+}
+
+static s7_double opt_set_d_d_fm(opt_info *o)
+{
+  s7_double x = o->v[3].fd(o->v[2].o1);
+  check_mutability(o->sc, o, __func__, __LINE__);
+  set_real(slot_value(o->v[1].p), x);
+  return(x);
+}
+
+static bool d_syntax_ok(s7_scheme *sc, s7_pointer car_x, int32_t len)
+{
+  if ((len == 3) &&
+      (car(car_x) == sc->set_symbol))
+    {
+      s7_pointer arg1 = cadr(car_x);
+      opt_info *opc = alloc_opt_info(sc);
+      if (is_symbol(arg1))
+	{
+	  s7_pointer settee;
+	  if (is_immutable(arg1))
+	    return_false(sc, car_x);
+	  settee = s7_slot(sc, arg1);
+	  if ((is_slot(settee)) &&
+	      (is_t_real(slot_value(settee))) &&
+	      (!is_immutable_slot(settee)) &&
+	      ((!slot_has_setter(settee)) ||
+	       ((is_c_function(slot_setter(settee))) &&
+		((slot_setter(settee) == initial_value(sc->is_float_symbol)) ||
+		 (c_function_call(slot_setter(settee)) == b_is_float_setter)))))
+	    {
+	      opt_info *o1 = sc->opts[sc->pc];
+	      opc->v[1].p = settee;
+	      if ((!is_t_integer(caddr(car_x))) &&
+		  (float_optimize(sc, cddr(car_x))))
+		{ /* tari: (set! rlo (min rlo (real-part (v i)))) -- can't tell here that it is used only in this line in the do body */
+		  /*  PERHAPS: if tree_count(body) - tree_count(line) == 0 and no setters within line it's safe as mutable? use the two_sets bit as before? */
+		  /*   but we also need a list of such opt_info ptrs to cancel mutability at the end */
+		  /* tall: (set! la ca)! (How?)
+		   *       (set! temp1 (one-zero dryTap0 (one-pole dryTap1 (piano-noise pnoise amp))))
+		   *   and many more, but none will be self-contained I think
+		   */
+		  opc->v[0].fd = (is_mutable_number(slot_value(opc->v[1].p))) ? opt_set_d_d_fm : opt_set_d_d_f;
+		  /* if (opc->v[0].fd == opt_set_d_d_f) fprintf(stderr, "%d: %s\n", __LINE__, display(car_x)); */
+		  opc->v[2].o1 = o1;
+		  opc->v[3].fd = o1->v[0].fd;
+		  return_true(sc, car_x);
+		}}}
+      else /* if is_pair(settee) get setter */
+	if ((is_pair(arg1)) &&
+	    (is_symbol(car(arg1))) &&
+	    (is_pair(cdr(arg1))))
+	  {
+	    if (is_null(cddr(arg1)))
+	      return(opt_float_vector_set(sc, opc, car(arg1), cdr(arg1), NULL, NULL, cddr(car_x)));
+	    if (is_null(cdddr(arg1)))
+	      return(opt_float_vector_set(sc, opc, car(arg1), cdr(arg1), cddr(arg1), NULL, cddr(car_x)));
+	  }}
+  return_false(sc, car_x);
+}
+
+static bool d_implicit_ok(s7_scheme *sc, s7_pointer s_slot, s7_pointer car_x, int32_t len)
+{
+  s7_pointer slot, obj = slot_value(s_slot);
+  if (is_float_vector(obj))
+    {
+      /* implicit float-vector-ref */
+      if ((len == 2) &&
+	  (vector_rank(obj) == 1))
+	{
+	  opt_info *opc = alloc_opt_info(sc);
+	  opc->v[1].p = s_slot;
+	  opc->v[3].d_7pi_f = float_vector_ref_d_7pi;
+	  slot = opt_integer_symbol(sc, cadr(car_x));
+	  if (slot)
+	    {
+	      opc->v[2].p = slot;
+	      if (loop_end_fits(opc->v[2].p, vector_length(obj)))
+		opc->v[0].fd = opt_d_7pi_ss_fvref_direct;
+	      else opc->v[0].fd = opt_d_7pi_ss_fvref;
+	      return_true(sc, car_x);
+	    }
+	  opc->v[10].o1 = sc->opts[sc->pc];
+	  if (!int_optimize(sc, cdr(car_x)))
+	    return_false(sc, car_x);
+	  opc->v[11].fi = opc->v[10].o1->v[0].fi;
+	  opc->v[0].fd = opt_d_7pi_sf;
+	  return_true(sc, car_x);
+	}
+      if ((len == 3) &&
+	  (vector_rank(obj) == 2))
+	{
+	  opt_info *opc = alloc_opt_info(sc);
+	  opc->v[1].p = s_slot;
+	  opc->v[4].d_7pii_f = float_vector_ref_d_7pii;
+	  slot = opt_integer_symbol(sc, cadr(car_x));
+	  if (slot)
+	    {
+	      opc->v[2].p = slot;
+	      slot = opt_integer_symbol(sc, caddr(car_x));
+	      if (slot)
+		{
+		  opc->v[3].p = slot;
+		  opc->v[0].fd = opt_d_7pii_sss;
+		  if ((loop_end_fits(opc->v[2].p, vector_dimension(obj, 0))) &&
+		      (loop_end_fits(opc->v[3].p, vector_dimension(obj, 1))))
+		    opc->v[0].fd = opt_d_7pii_sss_unchecked;
+		  return_true(sc, car_x);
+		}}
+	  opc->v[10].o1 = sc->opts[sc->pc];
+	  if (int_optimize(sc, cdr(car_x)))
+	    {
+	      opc->v[8].o1 = sc->opts[sc->pc];
+	      if (int_optimize(sc, cddr(car_x)))
+		{
+		  opc->v[0].fd = opt_d_7pii_sff;
+		  opc->v[11].fi = opc->v[10].o1->v[0].fi;
+		  opc->v[9].fi = opc->v[8].o1->v[0].fi;
+		  return_true(sc, car_x);
+		}}}
+      if ((len == 4) &&
+	  (vector_rank(obj) == 3))
+	{
+	  opt_info *opc = alloc_opt_info(sc);
+	  opc->v[1].p = s_slot;
+	  opc->v[4].d_7piii_f = float_vector_ref_d_7piii;
+	  slot = opt_integer_symbol(sc, cadr(car_x));
+	  if (slot)
+	    {
+	      opc->v[2].p = slot;
+	      slot = opt_integer_symbol(sc, caddr(car_x));
+	      if (slot)
+		{
+		  opc->v[3].p = slot;
+		  slot = opt_integer_symbol(sc, cadddr(car_x));
+		  if (slot)
+		    {
+		      opc->v[5].p = slot;
+		      opc->v[0].fd = opt_d_7piii_ssss;
+		      if ((loop_end_fits(opc->v[2].p, vector_dimension(obj, 0))) &&
+			  (loop_end_fits(opc->v[3].p, vector_dimension(obj, 1))) &&
+			  (loop_end_fits(opc->v[5].p, vector_dimension(obj, 2))))
+			opc->v[0].fd = opt_d_7piii_ssss_unchecked;
+		      return_true(sc, car_x);
+		    }}}}}
+  if ((is_c_object(obj)) &&
+      (len == 2))
+    {
+      s7_pointer getf = c_object_getf(sc, obj);
+      if (is_c_function(getf)) /* default is #f */
+	{
+	  s7_d_7pi_t func = s7_d_7pi_function(getf);
+	  if (func)
+	    {
+	      opt_info *opc = alloc_opt_info(sc);
+	      opc->v[1].p = s_slot;
+	      opc->v[4].obj = (void *)c_object_value(obj);
+	      opc->v[3].d_7pi_f = func;
+	      slot = opt_integer_symbol(sc, cadr(car_x));
+	      if (slot)
+		{
+		  opc->v[0].fd = opt_d_7pi_ss;
+		  opc->v[2].p = slot;
+		  return_true(sc, car_x);
+		}
+	      opc->v[10].o1 = sc->opts[sc->pc];
+	      if (int_optimize(sc, cdr(car_x)))
+		{
+		  opc->v[11].fi = opc->v[10].o1->v[0].fi;
+		  opc->v[0].fd = opt_d_7pi_sf;
+		  return_true(sc, car_x);
+		}}}}
+  return_false(sc, car_x);
+}
+
+
+/* -------------------------------- bool opts -------------------------------- */
+static bool opt_b_s(opt_info *o) {return(slot_value(o->v[1].p) != o->sc->F);}
+
+static bool opt_bool_not_pair(s7_scheme *sc, s7_pointer car_x)
+{
+  s7_pointer p;
+  if (!is_symbol(car_x))
+    return_false(sc, car_x); /* i.e. use cell_optimize */
+  p = opt_simple_symbol(sc, car_x);
+  if ((p) &&
+      (is_boolean(slot_value(p))))
+    {
+      opt_info *opc = alloc_opt_info(sc);
+      opc->v[1].p = p;
+      opc->v[0].fb = opt_b_s;
+      return_true(sc, car_x);
+    }
+  return_false(sc, car_x);
+}
+
+/* -------- b_idp -------- */
+static bool opt_b_i_s(opt_info *o)  {return(o->v[2].b_i_f(integer(slot_value(o->v[1].p))));}
+static bool opt_b_i_f(opt_info *o)  {return(o->v[2].b_i_f(o->v[11].fi(o->v[10].o1)));}
+static bool opt_b_d_s(opt_info *o)  {return(o->v[2].b_d_f(real(slot_value(o->v[1].p))));}
+static bool opt_b_d_f(opt_info *o)  {return(o->v[2].b_d_f(o->v[11].fd(o->v[10].o1)));}
+static bool opt_b_p_s(opt_info *o)  {return(o->v[2].b_p_f(slot_value(o->v[1].p)));}
+static bool opt_b_p_f(opt_info *o)  {return(o->v[2].b_p_f(o->v[4].fp(o->v[3].o1)));}
+static bool opt_b_7p_s(opt_info *o) {return(o->v[2].b_7p_f(o->sc, slot_value(o->v[1].p)));}
+static bool opt_b_7p_s_not(opt_info *o) {return(slot_value(o->v[1].p) == o->sc->F);}
+static bool opt_b_7p_f(opt_info *o) {return(o->v[2].b_7p_f(o->sc, o->v[4].fp(o->v[3].o1)));}
+static bool opt_b_d_s_is_positive(opt_info *o) {return(real(slot_value(o->v[1].p)) > 0.0);}
+static bool opt_b_p_s_is_integer(opt_info *o) {return(s7_is_integer(slot_value(o->v[1].p)));}
+static bool opt_b_p_s_is_pair(opt_info *o) {return(is_pair(slot_value(o->v[1].p)));}
+static bool opt_b_p_f_is_string(opt_info *o) {return(s7_is_string(o->v[4].fp(o->v[3].o1)));}
+static bool opt_b_7p_s_iter_at_end(opt_info *o) {return(iterator_is_at_end(slot_value(o->v[1].p)));}
+static bool opt_b_7p_f_not(opt_info *o) {return((o->v[4].fp(o->v[3].o1)) == o->sc->F);}
+
+static bool opt_zero_mod(opt_info *o)
+{
+  s7_int x = integer(slot_value(o->v[1].p));
+  return((x % o->v[2].i) == 0);
+}
+
+static bool b_idp_ok(s7_scheme *sc, s7_pointer s_func, s7_pointer car_x, const s7_pointer arg_type)
+{
+  s7_b_p_t bpf = NULL;
+  s7_b_7p_t bpf7 = NULL;
+  opt_info *opc = alloc_opt_info(sc);
+  int32_t cur_index = sc->pc;
+
+  if ((arg_type == sc->is_integer_symbol) || (arg_type == sc->is_byte_symbol))
+    {
+      s7_b_i_t bif = s7_b_i_function(s_func);
+      if (bif)
+	{
+	  opc->v[2].b_i_f = bif;
+	  if (is_symbol(cadr(car_x)))
+	    {
+	      opc->v[1].p = s7_slot(sc, cadr(car_x));
+	      opc->v[0].fb = opt_b_i_s;
+	      return_true(sc, car_x);
+	    }
+	  opc->v[10].o1 = sc->opts[sc->pc];
+	  if (int_optimize(sc, cdr(car_x)))
+	    {
+	      opt_info *o1 = sc->opts[sc->pc - 1];
+	      if ((car(car_x) == sc->is_zero_symbol) &&
+		  (o1->v[0].fi == opt_i_ii_sc) &&
+		  (o1->v[3].i_ii_f == modulo_i_ii_unchecked))
+		{
+		  opc->v[0].fb = opt_zero_mod;
+		  opc->v[1].p = o1->v[1].p;
+		  opc->v[2].i = o1->v[2].i;
+		  backup_pc(sc);
+		  return_true(sc, car_x);
+		}
+	      opc->v[0].fb = opt_b_i_f;
+	      opc->v[11].fi = opc->v[10].o1->v[0].fi;
+	      return_true(sc, car_x);
+	    }}}
+  else
+    if (arg_type == sc->is_float_symbol)
+      {
+	s7_b_d_t bdf = s7_b_d_function(s_func);
+	if (bdf)
+	  {
+	    opc->v[2].b_d_f = bdf;
+	    if (is_symbol(cadr(car_x)))
+	      {
+		opc->v[1].p = s7_slot(sc, cadr(car_x));
+		opc->v[0].fb = (bdf == is_positive_d) ? opt_b_d_s_is_positive : opt_b_d_s;
+		return_true(sc, car_x);
+	      }
+	    opc->v[10].o1 = sc->opts[sc->pc];
+	    if (float_optimize(sc, cdr(car_x)))
+	      {
+		opc->v[0].fb = opt_b_d_f;
+		opc->v[11].fd = opc->v[10].o1->v[0].fd;
+		return_true(sc, car_x);
+	      }}}
+  sc->pc = cur_index;
+
+  bpf = s7_b_p_function(s_func);
+  if (!bpf) bpf7 = s7_b_7p_function(s_func);
+  if ((bpf) || (bpf7))
+    {
+      if (bpf)
+	opc->v[2].b_p_f = bpf;
+      else opc->v[2].b_7p_f = bpf7;
+      if (is_symbol(cadr(car_x)))
+	{
+	  s7_pointer p = opt_simple_symbol(sc, cadr(car_x));
+	  if (!p) return_false(sc, car_x);
+	  opc->v[1].p = p;
+ 	  opc->v[0].fb = (bpf) ? ((bpf == s7_is_integer) ? opt_b_p_s_is_integer : ((bpf == s7_is_pair) ? opt_b_p_s_is_pair : opt_b_p_s)) :
+	                         (((bpf7 == iterator_is_at_end_b_7p) && (is_iterator(slot_value(p)))) ? opt_b_7p_s_iter_at_end :
+				  ((bpf7 == not_b_7p) ? opt_b_7p_s_not : opt_b_7p_s));
+	  return_true(sc, car_x);
+	}
+      opc->v[3].o1 = sc->opts[sc->pc];
+      if (cell_optimize(sc, cdr(car_x)))
+	{
+	  opc->v[0].fb = (bpf) ? ((bpf == s7_is_string) ? opt_b_p_f_is_string : opt_b_p_f) : (bpf7 == not_b_7p) ? opt_b_7p_f_not : opt_b_7p_f;
+	  opc->v[4].fp = opc->v[3].o1->v[0].fp;
+	  return_true(sc, car_x);
+	}}
+  return_false(sc, car_x);
+}
+
+
+/* -------- b_pp -------- */
+static s7_pointer opt_arg_type(s7_scheme *sc, s7_pointer argp)
+{
+  s7_pointer slot, arg = car(argp);
+  if (is_pair(arg))
+    {
+      if (is_symbol(car(arg)))
+	{
+	  if ((is_global(car(arg))) ||
+	      ((is_slot(global_slot(car(arg)))) &&
+	       (s7_slot(sc, car(arg)) == global_slot(car(arg)))))
+	    {
+	      s7_pointer a_func = global_value(car(arg));
+	      if (is_c_function(a_func))
+		{
+		  s7_pointer sig = c_function_signature(a_func);
+		  if (is_pair(sig))
+		    {
+		      if ((car(sig) == sc->is_integer_symbol) ||
+			  ((is_pair(car(sig))) && (direct_memq(sc->is_integer_symbol, car(sig))))) /* multidim vector for example with too few indices */
+			return(sc->is_integer_symbol);
+		      if ((car(sig) == sc->is_float_symbol) ||
+			  ((is_pair(car(sig))) && (direct_memq(sc->is_float_symbol, car(sig)))))
+			return(sc->is_float_symbol);
+		      if ((car(sig) == sc->is_byte_symbol) ||
+			  ((is_pair(car(sig))) && (direct_memq(sc->is_byte_symbol, car(sig)))))
+			return(sc->is_integer_symbol);  /* or '(integer? byte)? */
+		      if ((car(sig) == sc->is_real_symbol) ||
+			  (car(sig) == sc->is_number_symbol))
+			{
+			  int32_t start = sc->pc;
+			  if (int_optimize(sc, argp))
+			    {
+			      sc->pc = start;
+			      return(sc->is_integer_symbol);
+			    }
+			  if (float_optimize(sc, argp))
+			    {
+			      sc->pc = start;
+			      return(sc->is_float_symbol);
+			    }
+			  sc->pc = start;
+			}
+
+ 		      if (((car(arg) == sc->vector_ref_symbol) || (car(arg) == sc->hash_table_ref_symbol)) &&
+			  (is_pair(cdr(arg))) && (is_normal_symbol(cadr(arg)))) /* (vector-ref) -> is_pair check */
+			{
+			  s7_pointer v_slot = s7_slot(sc, cadr(arg)); /* (vector-ref not-a-var ...) -> is_slot check, not #<undefined> */
+			  if (is_slot(v_slot))
+			    {
+			      s7_pointer v = slot_value(v_slot);
+			      if (car(arg) == sc->vector_ref_symbol)
+				{
+				  if (is_int_vector(v))	    return(sc->is_integer_symbol);
+				  if (is_float_vector(v))   return(sc->is_float_symbol);
+				  if (is_byte_vector(v))    return(sc->is_byte_symbol);
+				  if (is_typed_t_vector(v)) return(typed_vector_typer_symbol(sc, v)); /* includes closure name ?? */
+				}
+			      else
+				if ((is_hash_table(v)) && (is_typed_hash_table(v)) && (is_c_function(hash_table_value_typer(v))))
+				  return(c_function_symbol(hash_table_value_typer(v)));
+			    }}
+		      return(car(sig)); /* we want the function's return type in this context */
+		    }
+		  return(sc->T);
+		}
+	      if ((is_quote(car(arg))) && (is_pair(cdr(arg))))
+		return(s7_type_of(sc, cadr(arg)));
+	    }
+	  slot = s7_slot(sc, car(arg));
+	  if ((is_slot(slot)) &&
+	      (is_sequence(slot_value(slot))))
+	    {
+	      s7_pointer sig = s7_signature(sc, slot_value(slot));
+	      if (is_pair(sig))
+		return(car(sig));
+	    }}
+      else
+	if ((car(arg) == sc->quote_function) && (is_pair(cdr(arg))))
+	  return(s7_type_of(sc, cadr(arg)));
+	else
+	  if (is_c_function(car(arg)))
+	    {
+	      s7_pointer sig = c_function_signature(car(arg));
+	      if (is_pair(sig))
+		return(car(sig));
+	    }
+      return(sc->T);
+    }
+  if (is_symbol(arg))
+    {
+      slot = opt_simple_symbol(sc, arg);
+      if (!slot) return(sc->T);
+#if WITH_GMP
+      if (is_big_number(slot_value(slot)))
+	return(sc->T);
+      if ((is_t_integer(slot_value(slot))) &&
+	  (integer(slot_value(slot)) > QUOTIENT_INT_LIMIT))
+	return(sc->T);
+      if ((is_t_real(slot_value(slot))) &&
+	  (real(slot_value(slot)) > QUOTIENT_FLOAT_LIMIT))
+	return(sc->T);
+#endif
+      return(s7_type_of(sc, slot_value(slot)));
+    }
+  return(s7_type_of(sc, arg));
+}
+
+static bool opt_b_pp_sf(opt_info *o)      {return(o->v[3].b_pp_f(slot_value(o->v[1].p), o->v[11].fp(o->v[10].o1)));}
+static bool opt_b_pp_fs(opt_info *o)      {return(o->v[3].b_pp_f(o->v[11].fp(o->v[10].o1), slot_value(o->v[1].p)));}
+static bool opt_b_pp_ss(opt_info *o)      {return(o->v[3].b_pp_f(slot_value(o->v[1].p), slot_value(o->v[2].p)));}
+static bool opt_b_pp_sc(opt_info *o)      {return(o->v[3].b_pp_f(slot_value(o->v[1].p), o->v[2].p));}
+static bool opt_b_pp_sfo(opt_info *o)     {return(o->v[3].b_pp_f(slot_value(o->v[1].p), o->v[4].p_p_f(o->sc, slot_value(o->v[2].p))));}
+static bool opt_b_7pp_sf(opt_info *o)     {return(o->v[3].b_7pp_f(o->sc, slot_value(o->v[1].p), o->v[11].fp(o->v[10].o1)));}
+static bool opt_b_7pp_fs(opt_info *o)     {return(o->v[3].b_7pp_f(o->sc, o->v[11].fp(o->v[10].o1), slot_value(o->v[1].p)));}
+static bool opt_b_7pp_ss(opt_info *o)     {return(o->v[3].b_7pp_f(o->sc, slot_value(o->v[1].p), slot_value(o->v[2].p)));}
+static bool opt_b_7pp_ss_lt(opt_info *o)  {return(lt_b_7pp(o->sc, slot_value(o->v[1].p), slot_value(o->v[2].p)));}
+static bool opt_b_7pp_ss_gt(opt_info *o)  {return(gt_b_7pp(o->sc, slot_value(o->v[1].p), slot_value(o->v[2].p)));}
+static bool opt_b_7pp_ss_char_lt(opt_info *o) {return(char_lt_b_7pp(o->sc, slot_value(o->v[1].p), slot_value(o->v[2].p)));}
+static bool opt_b_7pp_sc(opt_info *o)     {return(o->v[3].b_7pp_f(o->sc, slot_value(o->v[1].p), o->v[2].p));}
+static bool opt_b_7pp_sfo(opt_info *o)    {return(o->v[3].b_7pp_f(o->sc, slot_value(o->v[1].p), o->v[4].p_p_f(o->sc, slot_value(o->v[2].p))));}
+static bool opt_is_equal_sfo(opt_info *o) {return(s7_is_equal(o->sc, slot_value(o->v[1].p), o->v[4].p_p_f(o->sc, slot_value(o->v[2].p))));}
+static bool opt_is_equivalent_sfo(opt_info *o) {return(is_equivalent_1(o->sc, slot_value(o->v[1].p), o->v[4].p_p_f(o->sc, slot_value(o->v[2].p)), NULL));}
+static bool opt_b_pp_sf_char_eq(opt_info *o) {return(slot_value(o->v[1].p) == o->v[11].fp(o->v[10].o1));} /* lt above checks for char args */
+static bool opt_b_7pp_ff(opt_info *o)        {s7_pointer p1 = o->v[9].fp(o->v[8].o1); return(o->v[3].b_7pp_f(o->sc, p1, o->v[11].fp(o->v[10].o1)));}
+static bool opt_b_pp_ff(opt_info *o)         {s7_pointer p1 = o->v[9].fp(o->v[8].o1); return(o->v[3].b_pp_f(p1, o->v[11].fp(o->v[10].o1)));}
+static bool opt_b_pp_ff_char_eq(opt_info *o) {return(o->v[9].fp(o->v[8].o1) == o->v[11].fp(o->v[10].o1));}
+static bool opt_b_pp_fc_char_eq(opt_info *o) {return(o->v[9].fp(o->v[8].o1) == o->v[11].p);}
+static bool opt_b_pp_fc(opt_info *o)      {return(o->v[3].b_pp_f(o->v[9].fp(o->v[8].o1), o->v[11].p));}
+static bool opt_b_7pp_fc(opt_info *o)     {return(o->v[3].b_7pp_f(o->sc, o->v[9].fp(o->v[8].o1), o->v[11].p));}
+
+static bool opt_car_equal_sf(opt_info *o)
+{
+  s7_pointer p = slot_value(o->v[2].p);
+  return(s7_is_equal(o->sc, slot_value(o->v[1].p), (is_pair(p)) ? car(p) : g_car(o->sc, set_plist_1(o->sc, p))));
+}
+
+static bool opt_car_equivalent_sf(opt_info *o)
+{
+  s7_pointer p = slot_value(o->v[2].p);
+  return(is_equivalent_1(o->sc, slot_value(o->v[1].p), (is_pair(p)) ? car(p) : g_car(o->sc, set_plist_1(o->sc, p)), NULL));
+}
+
+static bool opt_b_7pp_car_sf(opt_info *o)
+{
+  s7_pointer p = slot_value(o->v[2].p);
+  return(o->v[3].b_7pp_f(o->sc, slot_value(o->v[1].p), (is_pair(p)) ? car(p) : g_car(o->sc, set_plist_1(o->sc, p))));
+}
+
+static s7_pointer opt_p_substring_uncopied_ssf(opt_info *o) /* "inline" here rather than copying below is much slower? */
+{
+  return(substring_uncopied_p_pii(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o->v[6].fi(o->v[5].o1)));
+}
+
+static bool opt_substring_equal_sf(opt_info *o) {return(scheme_strings_are_equal(slot_value(o->v[1].p), opt_p_substring_uncopied_ssf(o->v[10].o1)));}
+
+static s7_pointer opt_p_p_s(opt_info *o);
+
+static bool b_pp_sf_combinable(s7_scheme *sc, opt_info *opc, bool bpf_case)
+{
+  if ((sc->pc > 1) &&
+      (opc == sc->opts[sc->pc - 2]))
+    {
+      opt_info *o1 = sc->opts[sc->pc - 1];
+      if (o1->v[0].fp == opt_p_p_s)
+	{
+	  opc->v[2].p = o1->v[1].p;
+	  opc->v[4].p_p_f = o1->v[2].p_p_f;
+	  if (bpf_case)
+	    opc->v[0].fb = opt_b_pp_sfo;
+	  else
+	    if (opc->v[4].p_p_f == car_p_p)
+	      opc->v[0].fb = ((opc->v[3].b_7pp_f == s7_is_equal) ? opt_car_equal_sf :
+			      ((opc->v[3].b_7pp_f == s7_is_equivalent) ? opt_car_equivalent_sf : opt_b_7pp_car_sf));
+	    else opc->v[0].fb = ((opc->v[3].b_7pp_f == s7_is_equal) ? opt_is_equal_sfo :
+				 ((opc->v[3].b_7pp_f == s7_is_equivalent) ? opt_is_equivalent_sfo : opt_b_7pp_sfo));
+	  backup_pc(sc);
+	  return_true(sc, NULL);
+	}}
+  return_false(sc, NULL);
+}
+
+static bool opt_b_pp_ffo(opt_info *o)
+{
+  s7_pointer b1 = o->v[4].p_p_f(o->sc, slot_value(o->v[1].p));
+  return(o->v[3].b_pp_f(b1, o->v[5].p_p_f(o->sc, slot_value(o->v[2].p))));
+}
+
+static bool opt_b_pp_ffo_is_eq(opt_info *o)
+{
+  s7_pointer b1 = o->v[4].p_p_f(o->sc, slot_value(o->v[1].p));
+  s7_pointer b2 = o->v[5].p_p_f(o->sc, slot_value(o->v[2].p));
+  return((b1 == b2) || ((is_unspecified(b1)) && (is_unspecified(b2))));
+}
+
+static bool opt_b_7pp_ffo(opt_info *o)
+{
+  s7_pointer b1 = o->v[4].p_p_f(o->sc, slot_value(o->v[1].p));
+  return(o->v[3].b_7pp_f(o->sc, b1, o->v[5].p_p_f(o->sc, slot_value(o->v[2].p))));
+}
+
+static bool opt_b_cadr_cadr(opt_info *o)
+{
+  s7_pointer p1 = slot_value(o->v[1].p);
+  s7_pointer p2 = slot_value(o->v[2].p);
+  p1 = ((is_pair(p1)) && (is_pair(cdr(p1)))) ? cadr(p1) : g_cadr(o->sc, set_plist_1(o->sc, p1));
+  p2 = ((is_pair(p2)) && (is_pair(cdr(p2)))) ? cadr(p2) : g_cadr(o->sc, set_plist_1(o->sc, p2));
+  return(o->v[3].b_7pp_f(o->sc, p1, p2));
+}
+
+static bool b_pp_ff_combinable(s7_scheme *sc, opt_info *opc, bool bpf_case)
+{
+  if ((sc->pc > 2) &&
+      (opc == sc->opts[sc->pc - 3]))
+    {
+      opt_info *o1 = sc->opts[sc->pc - 2], *o2 = sc->opts[sc->pc - 1];
+      if ((o1->v[0].fp == opt_p_p_s) && (o2->v[0].fp == opt_p_p_s))
+	{
+	  opc->v[1].p = o1->v[1].p;
+	  opc->v[4].p_p_f = o1->v[2].p_p_f;
+	  opc->v[2].p = o2->v[1].p;
+	  opc->v[5].p_p_f = o2->v[2].p_p_f;
+	  opc->v[0].fb = (bpf_case) ? ((opc->v[3].b_pp_f == s7_is_eq) ? opt_b_pp_ffo_is_eq : opt_b_pp_ffo) :
+	                              (((opc->v[4].p_p_f == cadr_p_p) && (opc->v[5].p_p_f == cadr_p_p)) ? opt_b_cadr_cadr : opt_b_7pp_ffo);
+	  sc->pc -= 2;
+	  return_true(sc, NULL);
+	}}
+  return_false(sc, NULL);
+}
+
+static void check_b_types(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, bool (*fb)(opt_info *o))
+{
+  if (s7_b_pp_unchecked_function(s_func))
+    {
+      s7_pointer call_sig = c_function_signature(s_func);
+      s7_pointer arg1_type = opt_arg_type(sc, cdr(car_x));
+      s7_pointer arg2_type = opt_arg_type(sc, cddr(car_x));
+      if ((cadr(call_sig) == arg1_type) &&                   /* not car(arg1_type) here: (string>? (string) (read-line)) */
+	  (caddr(call_sig) == arg2_type))
+	{
+	  opc->v[0].fb = fb;
+	  opc->v[3].b_pp_f = s7_b_pp_unchecked_function(s_func);
+	}}
+}
+
+static s7_pointer opt_p_c(opt_info *o);
+
+static bool b_pp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, s7_pointer arg1, s7_pointer arg2, bool bpf_case)
+{
+  int32_t cur_index = sc->pc;
+  opt_info *o1;
+  /* v[3] is set when we get here */
+  if ((is_symbol(arg1)) &&
+      (is_symbol(arg2)))
+    {
+      opc->v[1].p = opt_simple_symbol(sc, arg1);
+      opc->v[2].p = opt_simple_symbol(sc, arg2);
+      if ((opc->v[1].p) &&
+	  (opc->v[2].p))
+	{
+	  s7_b_7pp_t b7f = (bpf_case) ? NULL : opc->v[3].b_7pp_f;
+	  opc->v[0].fb = (bpf_case) ? opt_b_pp_ss :
+	                  ((b7f == lt_b_7pp) ? opt_b_7pp_ss_lt : ((b7f == gt_b_7pp) ? opt_b_7pp_ss_gt :
+                           ((b7f == char_lt_b_7pp) ? opt_b_7pp_ss_char_lt : opt_b_7pp_ss)));
+	  return_true(sc, car_x);
+	}}
+  if (is_symbol(arg1))
+    {
+      opc->v[1].p = opt_simple_symbol(sc, arg1);
+      if (!opc->v[1].p)
+	return_false(sc, car_x);
+      if ((!is_symbol(arg2)) &&
+	  (!is_pair(arg2)))
+	{
+	  opc->v[2].p = arg2;
+	  opc->v[0].fb = (bpf_case) ? opt_b_pp_sc : opt_b_7pp_sc;
+	  check_b_types(sc, opc, s_func, car_x, opt_b_pp_sc);
+	  return_true(sc, car_x);
+	}
+      if (cell_optimize(sc, cddr(car_x)))
+	{
+	  if (!b_pp_sf_combinable(sc, opc, bpf_case))
+	    {
+	      opc->v[10].o1 = sc->opts[cur_index];
+	      opc->v[11].fp = opc->v[10].o1->v[0].fp;
+	      opc->v[0].fb = (bpf_case) ? opt_b_pp_sf : opt_b_7pp_sf;
+	      check_b_types(sc, opc, s_func, car_x, opt_b_pp_sf); /* this finds b_pp_unchecked cases */
+	      if ((opc->v[11].fp == opt_p_substring_uncopied_ssf) && (opc->v[3].b_pp_f == string_eq_b_unchecked))
+		opc->v[0].fb = opt_substring_equal_sf;
+	      else if (opc->v[3].b_pp_f == char_eq_b_unchecked) opc->v[0].fb = opt_b_pp_sf_char_eq;
+	    }
+	  return_true(sc, car_x);
+	}
+      sc->pc = cur_index;
+    }
+  else
+    if ((is_symbol(arg2)) &&
+	(is_pair(arg1)))
+      {
+	opc->v[10].o1 = sc->opts[sc->pc];
+	if (cell_optimize(sc, cdr(car_x)))
+	  {
+	    opc->v[1].p = s7_slot(sc, arg2);
+	    if ((!is_slot(opc->v[1].p)) ||
+		(has_methods(slot_value(opc->v[1].p))))
+	      return_false(sc, car_x);
+	    opc->v[11].fp = opc->v[10].o1->v[0].fp;
+	    opc->v[0].fb = (bpf_case) ? opt_b_pp_fs : opt_b_7pp_fs;
+	    check_b_types(sc, opc, s_func, car_x, opt_b_pp_fs);
+	    return_true(sc, car_x);
+	  }
+	sc->pc = cur_index;
+      }
+  o1 = sc->opts[sc->pc]; /* used below opc->v[8].o1 etc */
+  if (cell_optimize(sc, cdr(car_x)))
+    {
+      opc->v[10].o1 = sc->opts[sc->pc];
+      if (cell_optimize(sc, cddr(car_x)))
+	{
+	  if (b_pp_ff_combinable(sc, opc, bpf_case))
+	    return_true(sc, car_x);
+	  opc->v[0].fb = (bpf_case) ? opt_b_pp_ff : opt_b_7pp_ff;
+	  opc->v[8].o1 = o1;
+	  opc->v[9].fp = o1->v[0].fp;
+	  opc->v[11].fp = opc->v[10].o1->v[0].fp;
+	  check_b_types(sc, opc, s_func, car_x, opt_b_pp_ff);
+
+	  if (opc->v[3].b_pp_f == char_eq_b_unchecked)
+	    {
+	      if (opc->v[11].fp == opt_p_c) /* opc->v[11].fp can be opt_p_c where opc->v[10].o1->v[1].p is the char */
+		{
+		  opc->v[0].fb = opt_b_pp_fc_char_eq;
+		  opc->v[11].p = opc->v[10].o1->v[1].p;
+		}
+	      else opc->v[0].fb = opt_b_pp_ff_char_eq;
+	    }
+	  else
+	    if (opc->v[11].fp == opt_p_c)
+	      {
+		opc->v[0].fb = (opc->v[0].fb == opt_b_pp_ff) ? opt_b_pp_fc : opt_b_7pp_fc; /* can't use bpf_case here -- check_b_types can use the other form */
+		opc->v[11].p = opc->v[10].o1->v[1].p;
+	      }
+	  return_true(sc, car_x);
+	}}
+  return_false(sc, car_x);
+}
+
+/* -------- b_pi -------- */
+static bool opt_b_pi_fs(opt_info *o) {return(o->v[2].b_pi_f(o->sc, o->v[11].fp(o->v[10].o1), integer(slot_value(o->v[1].p))));}
+static bool opt_b_pi_fs_num_eq(opt_info *o) {return(num_eq_b_pi(o->sc, o->v[11].fp(o->v[10].o1), integer(slot_value(o->v[1].p))));}
+static bool opt_b_pi_fi(opt_info *o) {return(o->v[2].b_pi_f(o->sc, o->v[11].fp(o->v[10].o1), o->v[1].i));}
+static bool opt_b_pi_ff(opt_info *o) {s7_pointer p1 = o->v[11].fp(o->v[10].o1); return(o->v[2].b_pi_f(o->sc, p1, o->v[9].fi(o->v[8].o1)));}
+
+static bool b_pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, s7_pointer arg2)
+{
+  s7_b_pi_t bpif = s7_b_pi_function(s_func); /* perhaps add vector-ref/equal? */
+  if (bpif)
+    {
+      opc->v[10].o1 = sc->opts[sc->pc];
+      if (cell_optimize(sc, cdr(car_x)))
+	{
+	  opt_info *o1 = sc->opts[sc->pc];
+	  opc->v[2].b_pi_f = bpif;
+	  opc->v[11].fp = opc->v[10].o1->v[0].fp;
+	  if (is_symbol(arg2))
+	    {
+	      opc->v[1].p = s7_slot(sc, arg2); /* slot checked in opt_arg_type */
+	      opc->v[0].fb = (bpif == num_eq_b_pi) ? opt_b_pi_fs_num_eq : opt_b_pi_fs;
+	      return_true(sc, car_x);
+	    }
+	  if (is_t_integer(arg2))
+	    {
+	      opc->v[1].i = integer(arg2);
+	      opc->v[0].fb = opt_b_pi_fi;
+	      return_true(sc, car_x);
+	    }
+	  if (int_optimize(sc, cddr(car_x)))
+	    {
+	      opc->v[0].fb = opt_b_pi_ff;
+	      opc->v[8].o1 = o1;
+	      opc->v[9].fp = o1->v[0].fp;
+	      return_true(sc, car_x);
+	    }}}
+  return_false(sc, car_x);
+}
+
+
+/* -------- b_dd -------- */
+static bool opt_b_dd_ss(opt_info *o) {return(o->v[3].b_dd_f(real(slot_value(o->v[1].p)), real(slot_value(o->v[2].p))));}
+static bool opt_b_dd_ss_lt(opt_info *o) {return(real(slot_value(o->v[1].p)) < real(slot_value(o->v[2].p)));}
+static bool opt_b_dd_ss_gt(opt_info *o) {return(real(slot_value(o->v[1].p)) > real(slot_value(o->v[2].p)));}
+
+static bool opt_b_dd_sc(opt_info *o) {return(o->v[3].b_dd_f(real(slot_value(o->v[1].p)), o->v[2].x));}
+static bool opt_b_dd_sc_lt(opt_info *o) {return(real(slot_value(o->v[1].p)) < o->v[2].x);}
+static bool opt_b_dd_sc_geq(opt_info *o) {return(real(slot_value(o->v[1].p)) >= o->v[2].x);}
+static bool opt_b_dd_sc_eq(opt_info *o) {return(real(slot_value(o->v[1].p)) == o->v[2].x);}
+
+static bool opt_b_dd_sf(opt_info *o) {return(o->v[3].b_dd_f(real(slot_value(o->v[1].p)), o->v[11].fd(o->v[10].o1)));}
+static bool opt_b_dd_fs(opt_info *o) {return(o->v[3].b_dd_f(o->v[11].fd(o->v[10].o1), real(slot_value(o->v[1].p))));}
+static bool opt_b_dd_fs_gt(opt_info *o) {return(o->v[11].fd(o->v[10].o1) > real(slot_value(o->v[1].p)));}
+static bool opt_b_dd_fc(opt_info *o) {return(o->v[3].b_dd_f(o->v[11].fd(o->v[10].o1), o->v[1].x));}
+static bool opt_b_dd_fc_gt(opt_info *o) {return(o->v[11].fd(o->v[10].o1) > o->v[1].x);}
+
+static bool opt_b_dd_ff(opt_info *o)
+{
+  s7_double x1 = o->v[11].fd(o->v[10].o1);
+  s7_double x2 = o->v[9].fd(o->v[8].o1);
+  return(o->v[3].b_dd_f(x1, x2));
+}
+
+static bool b_dd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, s7_pointer arg1, s7_pointer arg2)
+{
+  s7_b_dd_t bif = s7_b_dd_function(s_func);
+  int32_t cur_index = sc->pc;
+  if (!bif)
+    return_false(sc, car_x);
+  opc->v[3].b_dd_f = bif;
+  if (is_symbol(arg1))
+    {
+      opc->v[1].p = s7_slot(sc, arg1);
+      if (is_symbol(arg2))
+	{
+	  opc->v[2].p = s7_slot(sc, arg2);
+	  opc->v[0].fb = (bif == lt_b_dd) ? opt_b_dd_ss_lt : ((bif == gt_b_dd) ? opt_b_dd_ss_gt : opt_b_dd_ss);
+	  return_true(sc, car_x);
+	}
+      if (is_t_real(arg2))
+	{
+	  opc->v[2].x = s7_number_to_real(sc, arg2);
+	  opc->v[0].fb = (bif == lt_b_dd) ? opt_b_dd_sc_lt : ((bif == geq_b_dd) ? opt_b_dd_sc_geq : ((bif == num_eq_b_dd) ? opt_b_dd_sc_eq : opt_b_dd_sc));
+	  return_true(sc, car_x);
+	}
+      opc->v[10].o1 = sc->opts[sc->pc];
+      if (float_optimize(sc, cddr(car_x)))
+	{
+	  opc->v[11].fd = opc->v[10].o1->v[0].fd;
+	  opc->v[0].fb = opt_b_dd_sf;
+	  return_true(sc, car_x);
+	}}
+  sc->pc = cur_index;
+  opc->v[10].o1 = sc->opts[sc->pc];
+  if (float_optimize(sc, cdr(car_x)))
+    {
+      opc->v[11].fd = opc->v[10].o1->v[0].fd;
+      if (is_symbol(arg2))
+	{
+	  opc->v[1].p = s7_slot(sc, arg2);
+	  opc->v[0].fb = (bif == gt_b_dd) ? opt_b_dd_fs_gt : opt_b_dd_fs;
+	  return_true(sc, car_x);
+	}
+      if (is_small_real(arg2))
+	{
+	  opc->v[1].x = s7_number_to_real(sc, arg2);
+	  opc->v[0].fb = (bif == gt_b_dd) ? opt_b_dd_fc_gt : opt_b_dd_fc;
+	  return_true(sc, car_x);
+	}
+      opc->v[8].o1 = sc->opts[sc->pc];
+      if (float_optimize(sc, cddr(car_x)))
+	{
+	  opc->v[9].fd = opc->v[8].o1->v[0].fd;
+	  opc->v[0].fb = opt_b_dd_ff;
+	  return_true(sc, car_x);
+	}}
+  sc->pc = cur_index;
+  return_false(sc, car_x);
+}
+
+
+/* -------- b_ii -------- */
+static bool opt_b_ii_ss(opt_info *o)      {return(o->v[3].b_ii_f(integer(slot_value(o->v[1].p)), integer(slot_value(o->v[2].p))));}
+static bool opt_b_ii_ss_lt(opt_info *o)   {return(integer(slot_value(o->v[1].p)) < integer(slot_value(o->v[2].p)));}
+static bool opt_b_ii_ss_gt(opt_info *o)   {return(integer(slot_value(o->v[1].p)) > integer(slot_value(o->v[2].p)));}
+static bool opt_b_ii_ss_leq(opt_info *o)  {return(integer(slot_value(o->v[1].p)) <= integer(slot_value(o->v[2].p)));}
+static bool opt_b_ii_ss_geq(opt_info *o)  {return(integer(slot_value(o->v[1].p)) >= integer(slot_value(o->v[2].p)));}
+static bool opt_b_ii_ss_eq(opt_info *o)   {return(integer(slot_value(o->v[1].p)) == integer(slot_value(o->v[2].p)));}
+static bool opt_b_ii_sc(opt_info *o)      {return(o->v[3].b_ii_f(integer(slot_value(o->v[1].p)), o->v[2].i));}
+static bool opt_b_ii_sc_lt(opt_info *o)   {return(integer(slot_value(o->v[1].p)) < o->v[2].i);}
+static bool opt_b_ii_sc_leq(opt_info *o)  {return(integer(slot_value(o->v[1].p)) <= o->v[2].i);}
+static bool opt_b_ii_sc_gt(opt_info *o)   {return(integer(slot_value(o->v[1].p)) > o->v[2].i);}
+static bool opt_b_ii_sc_geq(opt_info *o)  {return(integer(slot_value(o->v[1].p)) >= o->v[2].i);}
+static bool opt_b_ii_sc_eq(opt_info *o)   {return(integer(slot_value(o->v[1].p)) == o->v[2].i);}
+static bool opt_b_ii_sc_lt_2(opt_info *o) {return(integer(slot_value(o->v[1].p)) < 2);}
+static bool opt_b_ii_sc_lt_1(opt_info *o) {return(integer(slot_value(o->v[1].p)) < 1);}
+static bool opt_b_ii_sc_lt_0(opt_info *o) {return(integer(slot_value(o->v[1].p)) < 0);}
+static bool opt_b_ii_sc_leq_0(opt_info *o){return(integer(slot_value(o->v[1].p)) <= 0);}
+static bool opt_b_ii_sc_gt_0(opt_info *o) {return(integer(slot_value(o->v[1].p)) > 0);}
+static bool opt_b_ii_sc_geq_0(opt_info *o){return(integer(slot_value(o->v[1].p)) >= 0);}
+static bool opt_b_ii_sc_eq_0(opt_info *o) {return(integer(slot_value(o->v[1].p)) == 0);}
+static bool opt_b_ii_sc_eq_1(opt_info *o) {return(integer(slot_value(o->v[1].p)) == 1);}
+
+static bool opt_b_7ii_ss(opt_info *o)    {return(o->v[3].b_7ii_f(o->sc, integer(slot_value(o->v[1].p)), integer(slot_value(o->v[2].p))));}
+static bool opt_b_7ii_sc(opt_info *o)    {return(o->v[3].b_7ii_f(o->sc, integer(slot_value(o->v[1].p)), o->v[2].i));}
+static bool opt_b_7ii_sc_bit(opt_info *o) {return((integer(slot_value(o->v[1].p)) & ((int64_t)(1LL << o->v[2].i))) != 0);}
+
+static bool opt_b_ii_ff(opt_info *o)
+{
+  s7_int i1 = o->v[11].fi(o->v[10].o1);
+  s7_int i2 = o->v[9].fi(o->v[8].o1);
+  return(o->v[3].b_ii_f(i1, i2));
+}
+
+static bool opt_b_ii_fs(opt_info *o) {return(o->v[3].b_ii_f(o->v[11].fi(o->v[10].o1), integer(slot_value(o->v[2].p))));}
+static bool opt_b_ii_sf(opt_info *o) {return(o->v[3].b_ii_f(integer(slot_value(o->v[1].p)), o->v[11].fi(o->v[10].o1)));}
+static bool opt_b_ii_sf_eq(opt_info *o) {return(integer(slot_value(o->v[1].p)) == o->v[11].fi(o->v[10].o1));}
+static bool opt_b_ii_fc(opt_info *o) {return(o->v[3].b_ii_f(o->v[11].fi(o->v[10].o1), o->v[2].i));}
+static bool opt_b_ii_fc_eq(opt_info *o) {return(o->v[11].fi(o->v[10].o1) == o->v[2].i);}
+
+static bool b_ii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, s7_pointer arg1, s7_pointer arg2)
+{
+  s7_b_ii_t bif = s7_b_ii_function(s_func);
+  s7_b_7ii_t b7if = NULL;
+  if (!bif)
+    {
+      b7if = s7_b_7ii_function(s_func);
+      if (!b7if)
+	return_false(sc, car_x);
+    }
+  if (bif) opc->v[3].b_ii_f = bif; else opc->v[3].b_7ii_f = b7if;
+  if (is_symbol(arg1))
+    {
+      opc->v[1].p = s7_slot(sc, arg1);
+      if (is_symbol(arg2))
+	{
+	  opc->v[2].p = s7_slot(sc, arg2);
+
+	  opc->v[0].fb = (bif == lt_b_ii) ? opt_b_ii_ss_lt :
+	    ((bif == leq_b_ii) ? opt_b_ii_ss_leq :
+	     ((bif == gt_b_ii) ? opt_b_ii_ss_gt :
+	      ((bif == geq_b_ii) ? opt_b_ii_ss_geq :
+	       ((bif == num_eq_b_ii) ? opt_b_ii_ss_eq :
+		((bif) ? opt_b_ii_ss : opt_b_7ii_ss)))));
+	  return_true(sc, car_x);
+	}
+      if (is_t_integer(arg2))
+	{
+	  s7_int i2 = integer(arg2);
+	  opc->v[2].i = i2;
+	  opc->v[0].fb = (bif == num_eq_b_ii) ? ((i2 == 0) ? opt_b_ii_sc_eq_0 : ((i2 == 1) ? opt_b_ii_sc_eq_1 : opt_b_ii_sc_eq)) :
+	    ((bif == lt_b_ii) ? ((i2 == 0) ? opt_b_ii_sc_lt_0 : ((i2 == 1) ? opt_b_ii_sc_lt_1 : ((i2 == 2) ? opt_b_ii_sc_lt_2 : opt_b_ii_sc_lt))) :
+	     ((bif == gt_b_ii) ? ((i2 == 0) ? opt_b_ii_sc_gt_0 : opt_b_ii_sc_gt) :
+	      ((bif == leq_b_ii) ? ((i2 == 0) ? opt_b_ii_sc_leq_0 : opt_b_ii_sc_leq) :
+	       ((bif == geq_b_ii) ? ((i2 == 0) ? opt_b_ii_sc_geq_0 : opt_b_ii_sc_geq) :
+		(((b7if == logbit_b_7ii) && (i2 >= 0) && (i2 < S7_INT_BITS)) ? opt_b_7ii_sc_bit :
+		 ((bif) ? opt_b_ii_sc : opt_b_7ii_sc))))));
+	  return_true(sc, car_x);
+	}
+      opc->v[10].o1 = sc->opts[sc->pc];
+      if ((bif) && (int_optimize(sc, cddr(car_x))))
+	{
+	  opc->v[0].fb = (bif == num_eq_b_ii) ? opt_b_ii_sf_eq : opt_b_ii_sf;
+	  opc->v[11].fi = opc->v[10].o1->v[0].fi;
+	  return_true(sc, car_x);
+	}
+      return_false(sc, car_x);
+    }
+  if (!bif) return_false(sc, car_x);
+
+  if (is_symbol(arg2))
+    {
+      opc->v[10].o1 = sc->opts[sc->pc];
+      if (!int_optimize(sc, cdr(car_x)))
+	return_false(sc, car_x);
+      opc->v[11].fi = opc->v[10].o1->v[0].fi;
+      opc->v[2].p = s7_slot(sc, arg2);
+      opc->v[0].fb = opt_b_ii_fs;
+      return_true(sc, car_x);
+    }
+  opc->v[10].o1 = sc->opts[sc->pc];
+  if (int_optimize(sc, cdr(car_x)))
+    {
+      opc->v[11].fi = opc->v[10].o1->v[0].fi;
+      if (is_t_integer(arg2))
+	{
+	  opc->v[2].i = integer(arg2);
+	  opc->v[0].fb = (bif == num_eq_b_ii) ? opt_b_ii_fc_eq : opt_b_ii_fc;
+	  return_true(sc, car_x);
+	}
+      opc->v[8].o1 = sc->opts[sc->pc];
+      if (int_optimize(sc, cddr(car_x)))
+	{
+	  opc->v[9].fi = opc->v[8].o1->v[0].fi;
+	  opc->v[0].fb = opt_b_ii_ff;
+	  return_true(sc, car_x);
+	}}
+  return_false(sc, car_x);
+}
+
+/* -------- b_or|and -------- */
+static bool opt_and_bb(opt_info *o) {return((o->v[3].fb(o->v[2].o1)) && (o->v[11].fb(o->v[10].o1)));}
+
+static bool opt_and_any_b(opt_info *o)
+{
+  for (s7_int i = 0; i < o->v[1].i; i++)
+    {
+      opt_info *o1 = o->v[i + 3].o1;
+      if (!o1->v[0].fb(o1))
+	return(false);
+    }
+  return(true);
+}
+
+static bool opt_or_bb(opt_info *o) {return((o->v[3].fb(o->v[2].o1)) || o->v[11].fb(o->v[10].o1));}
+
+static bool opt_or_any_b(opt_info *o)
+{
+  for (s7_int i = 0; i < o->v[1].i; i++)
+    {
+      opt_info *o1 = o->v[i + 3].o1;
+      if (o1->v[0].fb(o1))
+	return(true);
+    }
+  return(false);
+}
+
+static bool opt_b_or_and(s7_scheme *sc, s7_pointer car_x, int32_t len, int32_t is_and)
+{
+  opt_info *opc = alloc_opt_info(sc);
+  s7_pointer p = cdr(car_x);
+  if (len == 3)
+    {
+      opt_info *o1 = sc->opts[sc->pc];
+      if (bool_optimize_nw(sc, cdr(car_x)))
+	{
+	  opt_info *o2 = sc->opts[sc->pc];
+	  if (bool_optimize_nw(sc, cddr(car_x)))
+	    {
+	      opc->v[10].o1 = o2;
+	      opc->v[11].fb = o2->v[0].fb;
+	      opc->v[0].fb = (is_and) ? opt_and_bb : opt_or_bb;
+	      opc->v[2].o1 = o1;
+	      opc->v[3].fb = o1->v[0].fb;
+	      return_true(sc, car_x);
+	    }}
+      return_false(sc, car_x);
+    }
+  opc->v[1].i = (len - 1);
+  for (int32_t i = 0; (is_pair(p)) && (i < 12); i++, p = cdr(p))
+    {
+      opc->v[i + 3].o1 = sc->opts[sc->pc];
+      if (!bool_optimize_nw(sc, p))
+	break;
+    }
+  if (!is_null(p))
+    return_false(sc, car_x);
+  opc->v[0].fb = (is_and) ? opt_and_any_b : opt_or_any_b;
+  return_true(sc, car_x);
+}
+
+static bool opt_b_and(s7_scheme *sc, s7_pointer car_x, int32_t len) {return(opt_b_or_and(sc, car_x, len, true));}
+static bool opt_b_or(s7_scheme *sc, s7_pointer car_x, int32_t len)  {return(opt_b_or_and(sc, car_x, len, false));}
+
+
+/* ---------------------------------------- cell opts ---------------------------------------- */
+static s7_pointer opt_p_c(opt_info *o) {return(o->v[1].p);}
+static s7_pointer opt_p_s(opt_info *o) {return(slot_value(o->v[1].p));}
+
+static bool opt_cell_not_pair(s7_scheme *sc, s7_pointer car_x)
+{
+  s7_pointer p;
+  opt_info *opc;
+  if (!is_symbol(car_x))
+    {
+      opc = alloc_opt_info(sc);
+      opc->v[1].p = car_x;
+      opc->v[0].fp = opt_p_c;
+      return_true(sc, car_x);
+    }
+  p = opt_simple_symbol(sc, car_x);
+  if (!p)
+    return_false(sc, car_x);
+  opc = alloc_opt_info(sc);
+  opc->v[1].p = p;
+  opc->v[0].fp = opt_p_s;
+  return_true(sc, car_x);
+}
+
+/* -------- p -------- */
+#define is_opt_safe(P) ((optimize_op(P) >= OP_SAFE_C_S) && (!is_unknown_op(optimize_op(P))))
+
+#define cf_call(Sc, Car_x, S_func, Num) \
+   (((is_optimized(Car_x)) && (is_opt_safe(Car_x))) ? fn_proc(Car_x) : c_function_call(c_function_chooser(S_func)(Sc, S_func, Num, Car_x))) /* was ops=false 19-Mar-24 */
+
+static s7_pointer opt_p_f(opt_info *o)  {return(o->v[1].p_f(o->sc));}
+static s7_pointer opt_p_call(opt_info *o) {return(o->v[1].call(o->sc, o->sc->nil));}
+
+static bool p_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  s7_p_t func = s7_p_function(s_func);
+  if (func)
+    {
+      opc->v[1].p_f = func;
+      opc->v[0].fp = opt_p_f;
+      return_true(sc, car_x);
+    }
+  if ((is_safe_procedure(s_func)) &&
+      (c_function_min_args(s_func) == 0))
+    {
+      opc->v[1].call = cf_call(sc, car_x, s_func, 0);
+      opc->v[0].fp = opt_p_call;
+      return_true(sc, car_x);
+    }
+  return_false(sc, car_x);
+}
+
+/* -------- p_p -------- */
+static s7_pointer opt_p_p_c(opt_info *o)     {return(o->v[2].p_p_f(o->sc, o->v[1].p));}
+static s7_pointer opt_p_i_c(opt_info *o)     {return(make_integer(o->sc, o->v[2].i_i_f(o->v[1].i)));}
+static s7_pointer opt_p_7i_c(opt_info *o)    {return(make_integer(o->sc, o->v[2].i_7i_f(o->sc, o->v[1].i)));}
+static s7_pointer opt_p_d_c(opt_info *o)     {return(make_real(o->sc, o->v[2].d_d_f(o->v[1].x)));}
+static s7_pointer opt_p_7d_c(opt_info *o)    {return(make_real(o->sc, o->v[2].d_7d_f(o->sc, o->v[1].x)));}
+static s7_pointer opt_p_p_s(opt_info *o)     {return(o->v[2].p_p_f(o->sc, slot_value(o->v[1].p)));}
+static s7_pointer opt_p_p_s_abs(opt_info *o) {return(abs_p_p(o->sc, slot_value(o->v[1].p)));}
+static s7_pointer opt_p_p_s_cdr(opt_info *o) {s7_pointer p = slot_value(o->v[1].p); return((is_pair(p)) ? cdr(p) : cdr_p_p(o->sc, p));}
+static s7_pointer opt_p_p_f(opt_info *o)     {return(o->v[2].p_p_f(o->sc, o->v[4].fp(o->v[3].o1)));}
+static s7_pointer opt_p_p_f1(opt_info *o)    {return(o->v[2].p_p_f(o->sc, o->v[3].p_p_f(o->sc, slot_value(o->v[1].p))));}
+static s7_pointer opt_p_p_f_exp(opt_info *o) {return(exp_p_p(o->sc, o->v[4].fp(o->v[3].o1)));}
+static s7_pointer opt_p_7d_c_random(opt_info *o) {return(make_real(o->sc, random_d_7d(o->sc, o->v[1].x)));}
+static s7_pointer opt_p_p_s_iterate(opt_info *o) {return(iterate_p_p(o->sc, slot_value(o->v[1].p)));}
+static s7_pointer opt_p_p_f_iterate(opt_info *o) {return(iterate_p_p(o->sc, o->v[4].fp(o->v[3].o1)));}
+static s7_pointer opt_p_p_f_string_to_number(opt_info *o) {return(string_to_number_p_p(o->sc, o->v[4].fp(o->v[3].o1)));}
+static s7_pointer opt_p_p_s_iterate_unchecked(opt_info *o) {s7_pointer iter = slot_value(o->v[1].p); return(iterator_next(iter)(o->sc, iter));}
+/* string_iterate built-in here if iterator_sequence is a string is about 12% faster, but currently we can have an unchecked iterator
+ *   that changes sequence type (via (set! L1 L2) where L1 and L2 are both iterators)
+ */
+
+static s7_pointer opt_p_pi_ss_vref_direct(opt_info *o);
+static s7_pointer opt_p_pi_ss_fvref_direct(opt_info *o);
+static s7_pointer opt_p_pi_ss_ivref_direct(opt_info *o);
+static s7_pointer opt_p_pi_ss_fvref_direct_wrapped(opt_info *o);
+static s7_pointer opt_p_pi_ss_ivref_direct_wrapped(opt_info *o);
+static s7_pointer opt_p_p_fvref(opt_info *o) {return(o->v[2].p_p_f(o->sc, opt_p_pi_ss_fvref_direct_wrapped(o->v[3].o1)));} /* unwrap to fvref is not faster */
+static s7_pointer opt_p_p_ivref(opt_info *o) {return(o->v[2].p_p_f(o->sc, opt_p_pi_ss_ivref_direct_wrapped(o->v[3].o1)));} /* unwrap to ivref is not faster */
+static s7_pointer opt_p_p_vref(opt_info *o) {return(o->v[2].p_p_f(o->sc, opt_p_pi_ss_vref_direct(o->v[3].o1)));}
+
+static bool p_p_f_combinable(s7_scheme *sc, opt_info *opc)
+{
+  if ((sc->pc > 1) &&
+      (opc == sc->opts[sc->pc - 2]))
+    {
+      opt_info *o1 = sc->opts[sc->pc - 1];
+      if (o1->v[0].fp == opt_p_p_s)
+	{
+	  opc->v[3].p_p_f = o1->v[2].p_p_f;
+	  opc->v[1].p = o1->v[1].p;
+	  opc->v[0].fp = opt_p_p_f1;
+	  backup_pc(sc);
+	  return_true(sc, NULL);
+	}}
+  return_false(sc, NULL);
+}
+
+static s7_pointer opt_p_call_f(opt_info *o) {return(o->v[2].call(o->sc, set_plist_1(o->sc, o->v[5].fp(o->v[4].o1))));}
+static s7_pointer opt_p_call_s(opt_info *o) {return(o->v[2].call(o->sc, set_plist_1(o->sc, slot_value(o->v[1].p))));}
+static s7_pointer opt_p_call_c(opt_info *o) {return(o->v[2].call(o->sc, set_plist_1(o->sc, o->v[1].p)));}
+
+static bool p_p_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  s7_p_p_t ppf;
+  int32_t start = sc->pc;
+  s7_pointer arg1 = cadr(car_x);
+  if (is_t_integer(arg1))
+    {
+      s7_i_i_t iif = s7_i_i_function(s_func);
+      s7_i_7i_t i7if;
+      opc->v[1].i = integer(arg1);
+      if (iif)
+	{
+	  opc->v[2].i_i_f = iif;
+	  opc->v[0].fp = opt_p_i_c;
+	  return_true(sc, car_x);
+	}
+      i7if = s7_i_7i_function(s_func);
+      if (i7if)
+	{
+	  opc->v[2].i_7i_f = i7if;
+	  opc->v[0].fp = opt_p_7i_c;
+	  return_true(sc, car_x);
+	}}
+  if (is_t_real(arg1))
+    {
+      s7_d_d_t ddf = s7_d_d_function(s_func);
+      s7_d_7d_t d7df;
+      opc->v[1].x = real(arg1);
+      if (ddf)
+	{
+	  opc->v[2].d_d_f = ddf;
+	  opc->v[0].fp = opt_p_d_c;
+	  return_true(sc, car_x);
+	}
+      d7df = s7_d_7d_function(s_func);
+      if (d7df)
+	{
+	  opc->v[2].d_7d_f = d7df;
+	  opc->v[0].fp = (d7df == random_d_7d) ? opt_p_7d_c_random : opt_p_7d_c;
+	  return_true(sc, car_x);
+	}}
+  ppf = s7_p_p_function(s_func);
+  if (ppf)
+    {
+      opt_info *o1;
+      opc->v[2].p_p_f = ppf;
+      if ((ppf == symbol_to_string_p_p) &&
+	  (is_optimized(car_x)) &&
+	  (fn_proc(car_x) == g_symbol_to_string_uncopied))
+	opc->v[2].p_p_f = symbol_to_string_uncopied_p;
+
+      if (is_symbol(arg1))
+	{
+	  opc->v[1].p = opt_simple_symbol(sc, arg1);
+	  if (!opc->v[1].p)
+	    return_false(sc, car_x);
+	  opc->v[0].fp = (ppf == abs_p_p) ? opt_p_p_s_abs : ((ppf == cdr_p_p) ? opt_p_p_s_cdr :
+			   ((ppf == iterate_p_p) ? ((is_iterator(slot_value(opc->v[1].p))) ? opt_p_p_s_iterate_unchecked : opt_p_p_s_iterate) : opt_p_p_s));
+	  return_true(sc, car_x);
+	}
+      if (!is_pair(arg1))
+	{
+	  if (opc->v[2].p_p_f == s7_length)
+	    {
+	      opc->v[1].p = s7_length(sc, arg1);
+	      opc->v[0].fp = opt_p_c;
+	    }
+	  else
+	    {
+	      opc->v[1].p = arg1;
+	      opc->v[0].fp = opt_p_p_c;
+	    }
+	  return_true(sc, car_x);
+	}
+      o1 = sc->opts[sc->pc];
+      if (cell_optimize(sc, cdr(car_x)))
+	{
+	  if (!p_p_f_combinable(sc, opc))
+	    {
+	      s7_pointer (*fp)(opt_info *o);
+	      opc->v[0].fp = (ppf == exp_p_p) ? opt_p_p_f_exp : ((ppf == iterate_p_p) ? opt_p_p_f_iterate :
+			       ((ppf == string_to_number_p_p) ? opt_p_p_f_string_to_number : opt_p_p_f));
+	      if (caadr(car_x) == sc->string_ref_symbol)
+		{
+		  if (opc->v[2].p_p_f == char_upcase_p_p)
+		    opc->v[2].p_p_f = char_upcase_p_p_unchecked;
+		  else
+		    if (opc->v[2].p_p_f == is_char_whitespace_p_p)
+		      opc->v[2].p_p_f = is_char_whitespace_p_p_unchecked;
+		}
+	      opc->v[3].o1 = o1;
+	      fp = o1->v[0].fp;
+	      opc->v[4].fp = fp;
+	      if (fp == opt_p_pi_ss_fvref_direct) opc->v[0].fp = opt_p_p_fvref;
+	      else if (fp == opt_p_pi_ss_vref_direct) opc->v[0].fp = opt_p_p_vref;
+	      else if (fp == opt_p_pi_ss_ivref_direct) opc->v[0].fp = opt_p_p_ivref;
+	    }
+	  return_true(sc, car_x);
+	}}
+
+  sc->pc = start;
+  if ((is_safe_procedure(s_func)) && (c_function_is_aritable(s_func, 1)))
+    {
+      opc->v[2].call = cf_call(sc, car_x, s_func, 1);
+      if (is_symbol(arg1))
+	{
+	  s7_pointer slot = opt_simple_symbol(sc, arg1);
+	  if (slot)
+	    {
+	      opc->v[1].p = slot;
+	      opc->v[0].fp = opt_p_call_s;
+	      return_true(sc, car_x);
+	    }}
+      else
+	{
+	  opt_info *o1;
+	  if (!is_pair(arg1))
+	    {
+	      opc->v[1].p = arg1;
+	      opc->v[0].fp = opt_p_call_c;
+	      return_true(sc, car_x);
+	    }
+	  o1 = sc->opts[sc->pc];
+	  if (cell_optimize(sc, cdr(car_x)))
+	    {
+	      opc->v[0].fp = opt_p_call_f;
+	      opc->v[4].o1 = o1;
+	      opc->v[5].fp = o1->v[0].fp;
+	      if (opc->v[5].fp == opt_p_pi_ss_fvref_direct) opc->v[5].fp = opt_p_pi_ss_fvref_direct_wrapped;
+	      else if (opc->v[5].fp == opt_p_pi_ss_ivref_direct) opc->v[5].fp = opt_p_pi_ss_ivref_direct_wrapped;
+	      return_true(sc, car_x);
+	    }}}
+  return_false(sc, car_x);
+}
+
+/* -------- p_i -------- */
+static s7_pointer opt_p_i_s(opt_info *o) {return(o->v[2].p_i_f(o->sc, integer(slot_value(o->v[1].p))));} /* number_to_string_p_i expanded here doesn't gain much */
+static s7_pointer opt_p_i_f(opt_info *o) {return(o->v[2].p_i_f(o->sc, o->v[4].fi(o->v[3].o1)));}
+static s7_pointer opt_p_i_f_intc(opt_info *o) {return(integer_to_char_p_i(o->sc, o->v[4].fi(o->v[3].o1)));}
+
+static bool p_i_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, int32_t pstart)
+{
+  s7_pointer p;
+  s7_p_i_t ifunc = s7_p_i_function(s_func);
+  if (!ifunc)
+    return_false(sc, car_x);
+  p = opt_integer_symbol(sc, cadr(car_x));
+  if (p)
+    {
+      opc->v[1].p = p;
+      opc->v[2].p_i_f = ifunc;
+      opc->v[0].fp = opt_p_i_s;
+      return_true(sc, car_x);
+    }
+  if (int_optimize(sc, cdr(car_x)))
+    {
+      opc->v[2].p_i_f = ifunc;
+      opc->v[0].fp = (ifunc == integer_to_char_p_i) ? opt_p_i_f_intc : opt_p_i_f;
+      opc->v[3].o1 = sc->opts[pstart];
+      opc->v[4].fi = sc->opts[pstart]->v[0].fi;
+      return_true(sc, car_x);
+    }
+  sc->pc = pstart;
+  return_false(sc, car_x);
+}
+
+/* -------- p_ii -------- */
+static s7_pointer opt_p_ii_ss(opt_info *o) {return(o->v[3].p_ii_f(o->sc, integer(slot_value(o->v[1].p)), integer(slot_value(o->v[2].p))));}
+static s7_pointer opt_p_ii_fs(opt_info *o) {return(o->v[3].p_ii_f(o->sc, o->v[11].fi(o->v[10].o1), integer(slot_value(o->v[2].p))));}
+static s7_pointer opt_p_ii_ff_divide(opt_info *o) {return(make_ratio_with_div_check(o->sc, o->sc->divide_symbol, o->v[11].fi(o->v[10].o1), o->v[9].fi(o->v[8].o1)));}
+
+static s7_pointer opt_p_ii_ff(opt_info *o)
+{
+  s7_int i1 = o->v[11].fi(o->v[10].o1);
+  return(o->v[3].p_ii_f(o->sc, i1, o->v[9].fi(o->v[8].o1)));
+}
+
+static bool p_ii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, int32_t pstart)
+{
+  s7_pointer p2;
+  s7_p_ii_t ifunc = s7_p_ii_function(s_func);
+  if (!ifunc)
+    return_false(sc, car_x);
+  p2 = opt_integer_symbol(sc, caddr(car_x));
+  if (p2)
+    {
+      s7_pointer p1 = opt_integer_symbol(sc, cadr(car_x));
+      if (p1)
+	{
+	  opc->v[1].p = p1;
+	  opc->v[2].p = p2;
+	  opc->v[3].p_ii_f = ifunc;
+	  opc->v[0].fp = opt_p_ii_ss;
+	  return_true(sc, car_x);
+	}
+      opc->v[10].o1 = sc->opts[sc->pc];
+      if (int_optimize(sc, cdr(car_x)))
+	{
+	  opc->v[11].fi = opc->v[10].o1->v[0].fi;
+	  opc->v[2].p = p2;
+	  opc->v[3].p_ii_f = ifunc;
+	  opc->v[0].fp = opt_p_ii_fs;
+	  return_true(sc, car_x);
+	}
+      sc->pc = pstart;
+      return_false(sc, car_x);
+    }
+  opc->v[10].o1 = sc->opts[sc->pc];
+  if (int_optimize(sc, cdr(car_x)))
+    {
+      opc->v[8].o1 = sc->opts[sc->pc];
+      if (int_optimize(sc, cddr(car_x)))
+	{
+	  opc->v[11].fi = opc->v[10].o1->v[0].fi;
+	  opc->v[9].fi = opc->v[8].o1->v[0].fi;
+	  opc->v[3].p_ii_f = ifunc;
+	  opc->v[0].fp = (ifunc == divide_p_ii) ? opt_p_ii_ff_divide : opt_p_ii_ff;
+	  return_true(sc, car_x);
+	}}
+  sc->pc = pstart;
+  return_false(sc, car_x);
+}
+
+/* -------- p_d -------- */
+static s7_pointer opt_p_d_s(opt_info *o) {return(o->v[2].p_d_f(o->sc, real_to_double(o->sc, slot_value(o->v[1].p), __func__)));}
+static s7_pointer opt_p_d_f(opt_info *o) {return(o->v[2].p_d_f(o->sc, o->v[4].fd(o->v[3].o1)));}
+/* static s7_pointer opt_p_d_fvref(opt_info *o) {return(o->v[2].p_d_f(o->sc, float_vector(slot_value(o->v[1].p), integer(slot_value(o->v[2].p)))));} */
+
+static bool p_d_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, int32_t pstart)
+{
+  s7_pointer p;
+  opt_info *o1;
+  s7_p_d_t ifunc = s7_p_d_function(s_func);
+
+  if (!ifunc)
+    return_false(sc, car_x);
+  p = opt_float_symbol(sc, cadr(car_x));
+  if (p)
+    {
+      opc->v[1].p = p;
+      opc->v[2].p_d_f = ifunc;
+      opc->v[0].fp = opt_p_d_s;
+      return_true(sc, car_x);
+    }
+  if ((is_number(cadr(car_x))) && (!is_t_real(cadr(car_x))))
+    return_false(sc, car_x);
+  o1 = sc->opts[sc->pc];
+  if (float_optimize(sc, cdr(car_x)))
+    {
+      opc->v[2].p_d_f = ifunc;
+      opc->v[0].fp = opt_p_d_f;
+      opc->v[3].o1 = o1;
+      opc->v[4].fd = o1->v[0].fd;
+      return_true(sc, car_x);
+    }
+  sc->pc = pstart;
+  return_false(sc, car_x);
+}
+
+/* -------- p_dd -------- */
+static s7_pointer opt_p_dd_sc(opt_info *o) {return(o->v[3].p_dd_f(o->sc, real_to_double(o->sc, slot_value(o->v[1].p), __func__), o->v[2].x));}
+static s7_pointer opt_p_dd_cs(opt_info *o) {return(o->v[3].p_dd_f(o->sc, o->v[2].x, real_to_double(o->sc, slot_value(o->v[1].p), __func__)));}
+static s7_pointer opt_p_dd_cc(opt_info *o) {return(o->v[3].p_dd_f(o->sc, o->v[1].x, o->v[2].x));}
+
+static bool p_dd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, int32_t pstart)
+{
+  s7_pointer slot, arg1 = cadr(car_x), arg2 = caddr(car_x);
+  s7_p_dd_t ifunc = s7_p_dd_function(s_func);
+  if (!ifunc)
+    return_false(sc, car_x);
+  if (is_t_real(arg2))
+    {
+      if (is_t_real(arg1))
+	{
+	  opc->v[1].x = real(arg1);
+	  opc->v[2].x = real(arg2);
+	  opc->v[3].p_dd_f = ifunc;
+	  opc->v[0].fp = opt_p_dd_cc;
+	  return_true(sc, car_x);
+	}
+      slot = opt_real_symbol(sc, arg1);
+      if (slot)
+	{
+	  opc->v[2].x = real(arg2);
+	  opc->v[1].p = slot;
+	  opc->v[3].p_dd_f = ifunc;
+	  opc->v[0].fp = opt_p_dd_sc;
+	  return_true(sc, car_x);
+	}}
+  if (is_t_real(arg1))
+    {
+      slot = opt_real_symbol(sc, arg2);
+      if (slot)
+	{
+	  opc->v[2].x = real(arg1);
+	  opc->v[1].p = slot;
+	  opc->v[3].p_dd_f = ifunc;
+	  opc->v[0].fp = opt_p_dd_cs;
+	  return_true(sc, car_x);
+	}}
+  sc->pc = pstart;
+  return_false(sc, car_x);
+}
+
+/* -------- p_pi -------- */
+static s7_pointer opt_p_pi_ss(opt_info *o) {return(o->v[3].p_pi_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p))));}
+static s7_pointer opt_p_pi_ss_sref(opt_info *o) {return(string_ref_p_pi_unchecked(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p))));}
+static s7_pointer opt_p_pi_ss_sref_direct(opt_info *o) {return(string_ref_p_pi_direct(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p))));}
+static s7_pointer opt_p_pi_ss_vref(opt_info *o) {return(t_vector_ref_p_pi_unchecked(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p))));}
+static s7_pointer opt_p_pi_ss_vref_direct(opt_info *o) {return(t_vector_ref_p_pi_direct(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p))));}
+static s7_pointer opt_p_pi_ss_fvref_direct(opt_info *o) {return(float_vector_ref_p_pi_direct(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p))));}
+static s7_pointer opt_p_pi_ss_ivref_direct(opt_info *o) {return(int_vector_ref_p_pi_direct(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p))));}
+static s7_pointer opt_p_pi_ss_fvref_direct_wrapped(opt_info *o) {return(float_vector_ref_p_pi_direct_wrapped(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p))));}
+static s7_pointer opt_p_pi_ss_ivref_direct_wrapped(opt_info *o) {return(int_vector_ref_p_pi_direct_wrapped(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p))));}
+static s7_pointer opt_p_pi_ss_pref(opt_info *o) {return(list_ref_p_pi_unchecked(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p))));}
+static s7_pointer opt_p_pi_sc(opt_info *o) {return(o->v[3].p_pi_f(o->sc, slot_value(o->v[1].p), o->v[2].i));}
+static s7_pointer opt_p_pi_sc_pref(opt_info *o) {return(list_ref_p_pi_unchecked(o->sc, slot_value(o->v[1].p), o->v[2].i));}
+static s7_pointer opt_p_pi_sf(opt_info *o) {return(o->v[3].p_pi_f(o->sc, slot_value(o->v[1].p), o->v[5].fi(o->v[4].o1)));}
+static s7_pointer opt_p_pi_sf_sref(opt_info *o) {return(string_ref_p_pi_unchecked(o->sc, slot_value(o->v[1].p), o->v[5].fi(o->v[4].o1)));}
+static s7_pointer opt_p_pi_sf_sref_direct(opt_info *o) {return(string_ref_p_pi_direct(o->sc, slot_value(o->v[1].p), o->v[5].fi(o->v[4].o1)));}
+static s7_pointer opt_p_pi_fc(opt_info *o) {return(o->v[3].p_pi_f(o->sc, o->v[5].fp(o->v[4].o1), o->v[2].i));}
+
+/* use a unique name (in this code) for this use of denominator -- this is a kludge -- we don't have anywhere in the slot
+ *   to store the loop end, but the slot_value can be a small_int (or any unheaped integer), so we're assuming there
+ *   aren't collisions?  Each use is a single (uncomplicated) do loop, set up before each call?
+ */
+#if S7_DEBUGGING
+static s7_pointer check_loop_end_ref(s7_pointer p, const char *func, int32_t line)
+{
+  uint8_t typ = unchecked_type(T_Slt(p));
+  if (!has_loop_end(p)) complain("%s%s[%d]: loop_end not set, %s (%s)%s\n", p, func, line, typ);
+  return(T_Int(slot_value(p)));
+}
+#define loop_end(A) denominator(check_loop_end_ref(A, __func__, __LINE__))
+#else
+#define loop_end(A) denominator(T_Int(slot_value(A)))
+#endif
+#define set_loop_end(A, B) set_denominator(T_Int(slot_value(A)), B)
+
+static void check_unchecked(s7_scheme *sc, s7_pointer obj, s7_pointer slot, opt_info *opc, s7_pointer expr)
+{
+  switch (type(obj)) /* can't use funcs here (opc->v[3].p_pi_f et al) because there are so many, and copy depends on this choice */
+    {
+    case T_STRING:
+      if (((!expr) || (car(expr) == sc->string_ref_symbol)) && (loop_end(slot) <= string_length(obj)))
+	opc->v[3].p_pi_f = string_ref_p_pi_direct;
+      break;
+    case T_BYTE_VECTOR:
+      if (((!expr) || (car(expr) == sc->byte_vector_ref_symbol) || (car(expr) == sc->vector_ref_symbol)) &&
+	  (loop_end(slot) <= byte_vector_length(obj)))
+	opc->v[3].p_pi_f = byte_vector_ref_p_pi_direct;
+      break;
+    case T_VECTOR:
+      if (((!expr) || (car(expr) == sc->vector_ref_symbol)) && (loop_end(slot) <= vector_length(obj)))
+	opc->v[3].p_pi_f = t_vector_ref_p_pi_direct;
+      break;
+    case T_FLOAT_VECTOR:
+      if (((!expr) || (car(expr) == sc->float_vector_ref_symbol) || (car(expr) == sc->vector_ref_symbol)) &&
+	  (loop_end(slot) <= vector_length(obj)))
+	opc->v[3].p_pi_f = float_vector_ref_p_pi_direct;
+      break;
+    case T_INT_VECTOR:
+      if (((!expr) || (car(expr) == sc->int_vector_ref_symbol) || (car(expr) == sc->vector_ref_symbol)) &&
+	  (loop_end(slot) <= vector_length(obj)))
+	opc->v[3].p_pi_f = int_vector_ref_p_pi_direct;
+      break;
+    }
+}
+
+static void fixup_p_pi_ss(opt_info *opc)
+{
+  opc->v[0].fp = (opc->v[3].p_pi_f == string_ref_p_pi_unchecked) ? opt_p_pi_ss_sref :
+    ((opc->v[3].p_pi_f == string_ref_p_pi_direct) ? opt_p_pi_ss_sref_direct :
+     ((opc->v[3].p_pi_f == t_vector_ref_p_pi_unchecked) ? opt_p_pi_ss_vref :
+      ((opc->v[3].p_pi_f == float_vector_ref_p_pi_direct) ? opt_p_pi_ss_fvref_direct :
+       ((opc->v[3].p_pi_f == int_vector_ref_p_pi_direct) ? opt_p_pi_ss_ivref_direct :
+	((opc->v[3].p_pi_f == t_vector_ref_p_pi_direct) ? opt_p_pi_ss_vref_direct :
+	 ((opc->v[3].p_pi_f == list_ref_p_pi_unchecked) ? opt_p_pi_ss_pref : opt_p_pi_ss))))));
+}
+
+static bool p_pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer sig, s7_pointer car_x)
+{
+  s7_pointer obj = NULL, slot1, checker = NULL;
+  opt_info *o1;
+  s7_p_pi_t func = s7_p_pi_function(s_func);
+  if (!func)
+    return_false(sc, car_x);
+  /* here we know cadr is a symbol */
+  slot1 = opt_simple_symbol(sc, cadr(car_x));
+  if (!slot1)
+    return_false(sc, car_x);
+  if ((is_any_vector(slot_value(slot1))) &&
+      (vector_rank(slot_value(slot1)) > 1))
+    return_false(sc, car_x);
+
+  opc->v[3].p_pi_f = func;
+  opc->v[1].p = slot1;
+
+  if (is_symbol(cadr(sig)))
+    checker = cadr(sig);
+
+  if ((s7_p_pi_unchecked_function(s_func)) &&
+      (checker))
+    {
+      obj = slot_value(opc->v[1].p);
+      if ((is_string(obj)) ||
+	  (is_pair(obj)) ||
+	  (is_any_vector(obj)))
+	{
+	  if (((is_string(obj)) && (checker == sc->is_string_symbol)) ||
+	      ((is_any_vector(obj)) && (checker == sc->is_vector_symbol)) ||
+	      ((is_pair(obj)) && (checker == sc->is_pair_symbol)) ||
+	      ((is_byte_vector(obj)) && (checker == sc->is_byte_vector_symbol)))
+	    opc->v[3].p_pi_f = (is_t_vector(obj)) ? t_vector_ref_p_pi_unchecked : s7_p_pi_unchecked_function(s_func);
+	}}
+  slot1 = opt_integer_symbol(sc, caddr(car_x));
+  if (slot1)
+    {
+      opc->v[2].p = slot1;
+      if ((obj) &&
+	  (has_loop_end(slot1)))
+	check_unchecked(sc, obj, slot1, opc, car_x);
+      fixup_p_pi_ss(opc);
+      return_true(sc, car_x);
+    }
+  if (is_t_integer(caddr(car_x)))
+    {
+      opc->v[2].i = integer(caddr(car_x));
+      opc->v[0].fp = (opc->v[3].p_pi_f == list_ref_p_pi_unchecked) ? opt_p_pi_sc_pref : opt_p_pi_sc;
+      return_true(sc, car_x);
+    }
+  o1 = sc->opts[sc->pc];
+  if (int_optimize(sc, cddr(car_x)))
+    {
+      opc->v[0].fp = (opc->v[3].p_pi_f == string_ref_p_pi_unchecked) ? opt_p_pi_sf_sref :
+	              ((opc->v[3].p_pi_f == string_ref_p_pi_direct) ? opt_p_pi_sf_sref_direct : opt_p_pi_sf);
+      opc->v[4].o1 = o1;
+      opc->v[5].fi = o1->v[0].fi;
+      return_true(sc, car_x);
+    }
+  return_false(sc, car_x);
+}
+
+static s7_pointer opt_p_pi_fco(opt_info *o) {return(o->v[3].p_pi_f(o->sc, o->v[4].p_p_f(o->sc, slot_value(o->v[1].p)), o->v[2].i));}
+
+static bool p_pi_fc_combinable(s7_scheme *sc, opt_info *opc)
+{
+  if ((sc->pc > 1) &&
+      (opc == sc->opts[sc->pc - 2]))
+    {
+      opt_info *o1 = sc->opts[sc->pc - 1];
+      if (o1->v[0].fp == opt_p_p_s)
+	{
+	  opc->v[4].p_p_f = o1->v[2].p_p_f;
+	  opc->v[1].p = o1->v[1].p;
+	  opc->v[0].fp = opt_p_pi_fco;
+	  backup_pc(sc);
+	  return_true(sc, NULL);
+	}}
+  return_false(sc, NULL);
+}
+
+/* -------- p_pp -------- */
+static s7_pointer opt_p_pp_ss(opt_info *o) {return(o->v[3].p_pp_f(o->sc, slot_value(o->v[1].p), slot_value(o->v[2].p)));}
+static s7_pointer opt_p_pp_sc(opt_info *o) {return(o->v[3].p_pp_f(o->sc, slot_value(o->v[1].p), o->v[2].p));}
+static s7_pointer opt_p_pp_slot_ref(opt_info *o) {return(slot_value(o->v[2].p));}
+static s7_pointer opt_p_pp_cs(opt_info *o) {return(o->v[3].p_pp_f(o->sc, o->v[2].p, slot_value(o->v[1].p)));}
+static s7_pointer opt_p_pp_sf(opt_info *o) {return(o->v[3].p_pp_f(o->sc, slot_value(o->v[1].p), o->v[5].fp(o->v[4].o1)));}
+static s7_pointer opt_p_pp_fs(opt_info *o) {return(o->v[3].p_pp_f(o->sc, o->v[5].fp(o->v[4].o1), slot_value(o->v[1].p)));}
+static s7_pointer opt_p_pp_fc(opt_info *o) {return(o->v[3].p_pp_f(o->sc, o->v[5].fp(o->v[4].o1), o->v[2].p));}
+static s7_pointer opt_p_pp_cc(opt_info *o) {return(o->v[3].p_pp_f(o->sc, o->v[1].p, o->v[2].p));}
+static s7_pointer opt_p_pp_cc_make_list(opt_info *o) {return(make_list(o->sc, o->v[1].i, o->v[2].p));}
+static s7_pointer opt_set_car_pp_ss(opt_info *o) {return(inline_set_car(o->sc, slot_value(o->v[1].p), slot_value(o->v[2].p)));}
+static s7_pointer opt_p_pp_ss_href(opt_info *o) {return(s7_hash_table_ref(o->sc, slot_value(o->v[1].p), slot_value(o->v[2].p)));}
+static s7_pointer opt_p_pp_sf_add(opt_info *o) {return(add_p_pp(o->sc, slot_value(o->v[1].p), o->v[5].fp(o->v[4].o1)));}
+static s7_pointer opt_p_pp_sf_sub(opt_info *o) {return(subtract_p_pp(o->sc, slot_value(o->v[1].p), o->v[5].fp(o->v[4].o1)));}
+static s7_pointer opt_p_pp_sf_mul(opt_info *o) {return(multiply_p_pp(o->sc, slot_value(o->v[1].p), o->v[5].fp(o->v[4].o1)));}
+static s7_pointer opt_p_pp_sf_set_car(opt_info *o) {return(inline_set_car(o->sc, slot_value(o->v[1].p), o->v[5].fp(o->v[4].o1)));}
+static s7_pointer opt_p_pp_sf_set_cdr(opt_info *o) {return(inline_set_cdr(o->sc, slot_value(o->v[1].p), o->v[5].fp(o->v[4].o1)));}
+static s7_pointer opt_p_pp_sf_href(opt_info *o) {return(s7_hash_table_ref(o->sc, slot_value(o->v[1].p), o->v[5].fp(o->v[4].o1)));}
+static s7_pointer opt_p_pp_fs_vref(opt_info *o) {return(vector_ref_p_pp(o->sc, o->v[5].fp(o->v[4].o1), slot_value(o->v[1].p)));}
+static s7_pointer opt_p_pp_fs_cons(opt_info *o) {return(cons(o->sc, o->v[5].fp(o->v[4].o1), slot_value(o->v[1].p)));}
+static s7_pointer opt_p_pp_fs_add(opt_info *o) {return(add_p_pp(o->sc, o->v[5].fp(o->v[4].o1), slot_value(o->v[1].p)));}
+static s7_pointer opt_p_pp_fs_sub(opt_info *o) {return(subtract_p_pp(o->sc, o->v[5].fp(o->v[4].o1), slot_value(o->v[1].p)));}
+
+static s7_pointer opt_p_pp_ss_lref(opt_info *o)
+{
+  s7_pointer sym = slot_value(o->v[2].p);
+  if (is_symbol(sym))
+    return(let_ref_p_pp(o->sc, slot_value(o->v[1].p), (is_keyword(sym)) ? keyword_symbol(sym) : sym));
+  return(let_ref(o->sc, slot_value(o->v[1].p), sym));
+}
+
+static s7_pointer opt_p_pp_sf_lref(opt_info *o)
+{
+  s7_pointer sym = o->v[5].fp(o->v[4].o1);
+  if (is_symbol(sym))
+    return(let_ref_p_pp(o->sc, slot_value(o->v[1].p), (is_keyword(sym)) ? keyword_symbol(sym) : sym));
+  return(let_ref(o->sc, slot_value(o->v[1].p), sym));
+}
+
+static s7_pointer opt_p_pp_ff(opt_info *o)
+{
+  s7_scheme *sc = o->sc;
+  s7_pointer result;
+  gc_protect_2_via_stack_no_let(sc, o->v[11].fp(o->v[10].o1), o->v[9].fp(o->v[8].o1)); /* we do need to protect both */
+  result = o->v[3].p_pp_f(sc, gc_protected1(sc), gc_protected2(sc));
+  unstack_gc_protect(sc);
+  return(result);
+}
+
+static s7_pointer opt_p_pp_ff_add_mul_mul_1(opt_info *o, bool add_case) /* (+|- (* s1 f2) (* s3 f4)) */
+{
+  opt_info *o1 = o->v[10].o1, *o2 = o->v[8].o1;
+  s7_pointer f4;
+  s7_scheme *sc = o->sc;
+  s7_pointer s1 = slot_value(o1->v[1].p);
+  s7_pointer s3 = slot_value(o2->v[1].p);
+  s7_pointer f2 = o1->v[5].fp(o1->v[4].o1);
+  if ((is_t_real(f2)) && (is_t_real(s1)) && (is_t_real(s3)))
+    {
+      s7_double r2 = real(f2);
+      f4 = o2->v[5].fp(o2->v[4].o1);
+      if (is_t_real(f4))
+	return(make_real(sc, (add_case) ? ((real(s1) * r2) + (real(s3) * real(f4))) : ((real(s1) * r2) - (real(s3) * real(f4)))));
+      gc_protect_via_stack_no_let(sc, f2);
+    }
+  else
+    {
+      gc_protect_via_stack_no_let(sc, f2);
+      f4 = o2->v[5].fp(o2->v[4].o1);
+    }
+  set_gc_protected2(sc, f4);
+  set_gc_protected2(sc, multiply_p_pp(sc, s3, f4));
+  set_gc_protected1(sc, multiply_p_pp(sc, s1, f2));
+  s3 = (add_case) ? add_p_pp(sc, gc_protected1(sc), gc_protected2(sc)) : subtract_p_pp(sc, gc_protected1(sc), gc_protected2(sc));
+  unstack_gc_protect(sc);
+  return(s3);
+}
+
+static s7_pointer opt_p_pp_ff_add_mul_mul(opt_info *o) {return(opt_p_pp_ff_add_mul_mul_1(o, true));}
+static s7_pointer opt_p_pp_ff_sub_mul_mul(opt_info *o) {return(opt_p_pp_ff_add_mul_mul_1(o, false));}
+
+static void check_opc_vector_wraps(opt_info *opc)
+{
+  if (opc->v[9].fp == opt_p_pi_ss_ivref_direct) opc->v[9].fp = opt_p_pi_ss_ivref_direct_wrapped;
+  if (opc->v[9].fp == opt_p_pi_ss_fvref_direct) opc->v[9].fp = opt_p_pi_ss_fvref_direct_wrapped;
+  if (opc->v[11].fp == opt_p_pi_ss_ivref_direct) opc->v[11].fp = opt_p_pi_ss_ivref_direct_wrapped;
+  if (opc->v[11].fp == opt_p_pi_ss_fvref_direct) opc->v[11].fp = opt_p_pi_ss_fvref_direct_wrapped;
+}
+
+static void use_slot_ref(s7_scheme *sc, opt_info *opc, s7_pointer let, s7_pointer symbol)
+{
+  s7_pointer slot = symbol_to_local_slot(sc, symbol, let);
+  if (is_slot(slot))
+    {
+      opc->v[2].p = slot;
+      opc->v[0].fp = opt_p_pp_slot_ref;
+    }
+}
+
+static s7_pointer opt_p_unlet_ref(opt_info *o) {return(o->v[1].p);}
+static s7_pointer opt_p_rootlet_ref(opt_info *o) {return(global_value(o->v[1].p));}
+
+static bool opt_unlet_rootlet_ref(s7_scheme *sc, opt_info *opc, s7_pointer arg1, s7_pointer sym, s7_pointer car_x)
+{
+  if (car(arg1) == sc->rootlet_symbol)
+    {
+      if (!is_slot(global_slot(sym)))
+	{
+	  opc->v[0].fp = opt_p_c;
+	  opc->v[1].p = sc->undefined;
+	  return_true(sc, car_x);
+	}
+      opc->v[0].fp = opt_p_rootlet_ref;
+      opc->v[1].p = sym;
+      return_true(sc, car_x);
+    }
+  opc->v[0].fp = opt_p_unlet_ref;
+  opc->v[1].p = initial_value(sym);
+  return_true(sc, car_x);
+}
+
+static bool p_pp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, int32_t pstart)
+{
+  s7_pointer slot, arg1, arg2;
+  s7_p_pp_t func = s7_p_pp_function(s_func);
+  if (!func)
+    return_false(sc, car_x);
+
+  opc->v[3].p_pp_f = func;
+  arg1 = cadr(car_x);
+  arg2 = caddr(car_x);
+  if (is_symbol(arg1))
+    {
+      s7_pointer obj;
+      slot = opt_simple_symbol(sc, arg1);
+      if (!slot)
+	{
+	  sc->pc = pstart;
+	  return_false(sc, car_x);
+	}
+      obj = slot_value(slot);
+      if ((is_any_vector(obj)) && (vector_rank(obj) > 1))
+	{
+	  sc->pc = pstart;
+	  return_false(sc, car_x);
+	}
+      opc->v[1].p = slot;
+
+      if ((func == hash_table_ref_p_pp) && (is_hash_table(obj)))
+	opc->v[3].p_pp_f = s7_hash_table_ref;
+
+      if (is_symbol(arg2))
+	{
+	  opc->v[2].p = opt_simple_symbol(sc, arg2);
+	  if (opc->v[2].p)
+	    {
+	      opc->v[0].fp = (func == set_car_p_pp) ? opt_set_car_pp_ss :
+		(((is_hash_table(obj)) && (func == hash_table_ref_p_pp)) ? opt_p_pp_ss_href :
+		 (((is_let(obj)) && (func == let_ref)) ? opt_p_pp_ss_lref : opt_p_pp_ss));
+
+	      /* if ss = s+k use slot_ref */
+	      if ((opc->v[0].fp == opt_p_pp_ss_lref) && (is_keyword(arg2)))
+		use_slot_ref(sc, opc, obj, keyword_symbol(arg2));
+
+	      return_true(sc, car_x);
+	    }
+	  sc->pc = pstart;
+	  return_false(sc, car_x);
+	}
+      if ((!is_pair(arg2)) ||
+	  (is_proper_quote(sc, arg2)))
+	{
+	  opc->v[2].p = (!is_pair(arg2)) ? arg2 : cadr(arg2);
+	  opc->v[0].fp = opt_p_pp_sc;
+	  if ((is_pair(arg2)) && (is_symbol(opc->v[2].p)) && (is_let(obj)) && (opc->v[3].p_pp_f == let_ref))
+	    use_slot_ref(sc, opc, obj, cadr(arg2));          /* car_x: (let-ref L 'a), can't be keyword here (handled above) */
+	  return_true(sc, car_x);
+	}
+      if (cell_optimize(sc, cddr(car_x)))
+	{
+	  opc->v[0].fp = (func == add_p_pp) ? opt_p_pp_sf_add : ((func == subtract_p_pp) ? opt_p_pp_sf_sub : ((func == multiply_p_pp) ? opt_p_pp_sf_mul :
+                           ((func == set_car_p_pp) ? opt_p_pp_sf_set_car : ((func == set_cdr_p_pp) ? opt_p_pp_sf_set_cdr :
+                            (((is_hash_table(obj)) && (opc->v[3].p_pp_f == s7_hash_table_ref)) ? opt_p_pp_sf_href :
+			     (((is_let(obj)) && (opc->v[3].p_pp_f == let_ref)) ? opt_p_pp_sf_lref : opt_p_pp_sf))))));
+	  opc->v[4].o1 = sc->opts[pstart];
+	  opc->v[5].fp = sc->opts[pstart]->v[0].fp;
+	  if (opc->v[5].fp == opt_p_pi_ss_ivref_direct) opc->v[5].fp = opt_p_pi_ss_ivref_direct_wrapped;
+	  return_true(sc, car_x);
+	}}
+  else /* cadr not a symbol */
+    {
+      opt_info *o1 = sc->opts[sc->pc];
+      if ((!is_pair(arg1)) ||
+	  (is_proper_quote(sc, arg1)))
+	{
+	  opc->v[1].p = (!is_pair(arg1)) ? arg1 : cadr(arg1);
+	  if ((!is_symbol(arg2)) &&
+	      ((!is_pair(arg2)) ||
+	       (is_proper_quote(sc, arg2))))
+	    {
+	      opc->v[2].p = (!is_pair(arg2)) ? arg2 : cadr(arg2);
+	      if ((opc->v[3].p_pp_f == make_list_p_pp) &&
+		  (is_t_integer(opc->v[1].p)) && (integer(opc->v[1].p) >= 0) && (integer(opc->v[1].p) < sc->max_list_length))
+		{
+		  opc->v[0].fp = opt_p_pp_cc_make_list;
+		  opc->v[1].i = integer(opc->v[1].p);
+		}
+	      else opc->v[0].fp = opt_p_pp_cc;
+	      return_true(sc, car_x);
+	    }
+	  if (is_symbol(arg2))
+	    {
+	      opc->v[2].p = opc->v[1].p;
+	      opc->v[1].p = opt_simple_symbol(sc, arg2);
+	      if (opc->v[1].p)
+		{
+		  opc->v[0].fp = opt_p_pp_cs;
+		  if (is_pair(slot_value(opc->v[1].p)))
+		    {
+		      if (func == assq_p_pp) opc->v[3].p_pp_f = s7_assq;
+		      else
+			if (func == memq_p_pp) opc->v[3].p_pp_f = s7_memq;
+			else
+			  if ((func == member_p_pp) && (is_simple(opc->v[2].p))) opc->v[3].p_pp_f = s7_memq;
+			  else
+			    if (func == assoc_p_pp)
+			      {
+				if (is_simple(opc->v[2].p)) opc->v[3].p_pp_f = s7_assq;
+				else if (is_pair(car(slot_value(opc->v[1].p)))) opc->v[3].p_pp_f = assoc_1;
+			      }}
+		  return_true(sc, car_x);
+		}
+	      sc->pc = pstart;
+	      return_false(sc, car_x);
+	    }}
+
+      if ((car(car_x) == sc->let_ref_symbol) && (is_pair(arg1)) &&
+	  ((is_symbol_and_keyword(arg2)) || ((is_quoted_symbol(arg2)))) &&
+	  ((car(arg1) == sc->unlet_symbol) || (car(arg1) == sc->rootlet_symbol)))
+	return(opt_unlet_rootlet_ref(sc, opc, arg1, (is_pair(arg2)) ? cadr(arg2) : keyword_symbol(arg2), car_x));
+
+      if (cell_optimize(sc, cdr(car_x)))
+	{
+	  if (is_symbol(arg2))
+	    {
+	      opc->v[1].p = opt_simple_symbol(sc, arg2);
+	      if (opc->v[1].p)
+		{
+		  opc->v[0].fp = (func == add_p_pp) ? opt_p_pp_fs_add : ((func == subtract_p_pp) ? opt_p_pp_fs_sub :
+                                   ((func == vector_ref_p_pp) ? opt_p_pp_fs_vref : ((func == cons_p_pp) ? opt_p_pp_fs_cons : opt_p_pp_fs)));
+		  opc->v[4].o1 = o1;
+		  opc->v[5].fp = o1->v[0].fp;
+		  return_true(sc, car_x);
+		}
+	      sc->pc = pstart;
+	      return_false(sc, car_x);
+	    }
+	  if ((!is_pair(arg2)) ||
+	      (is_proper_quote(sc, arg2)))
+	    {
+	      if (is_t_integer(arg2))
+		{
+		  s7_p_pi_t ifunc = s7_p_pi_function(s_func);
+		  if (ifunc)
+		    {
+		      opc->v[2].i = integer(arg2);
+		      opc->v[3].p_pi_f = ifunc;
+		      if (!p_pi_fc_combinable(sc, opc))
+			{
+			  opc->v[0].fp = opt_p_pi_fc;
+			  opc->v[4].o1 = o1;
+			  opc->v[5].fp = o1->v[0].fp;
+			}
+		      return_true(sc, car_x);
+		    }}
+	      opc->v[2].p = (!is_pair(arg2)) ? arg2 : cadr(arg2);
+	      opc->v[0].fp = opt_p_pp_fc;
+	      opc->v[4].o1 = o1;
+	      opc->v[5].fp = o1->v[0].fp;
+	      return_true(sc, car_x);
+	    }
+	  opc->v[8].o1 = sc->opts[sc->pc];
+	  if (cell_optimize(sc, cddr(car_x)))
+	    {
+	      opc->v[10].o1 = o1;
+	      opc->v[11].fp = o1->v[0].fp;
+	      opc->v[9].fp = opc->v[8].o1->v[0].fp;
+	      opc->v[0].fp = opt_p_pp_ff;
+
+	      if ((opc->v[9].fp == opt_p_pp_sf_mul) && (opc->v[11].fp == opt_p_pp_sf_mul))
+		{
+		  if (func == add_p_pp) opc->v[0].fp = opt_p_pp_ff_add_mul_mul;
+		  else if (func == subtract_p_pp) opc->v[0].fp = opt_p_pp_ff_sub_mul_mul;
+		}
+	      check_opc_vector_wraps(opc);
+	      return_true(sc, car_x);
+	    }}}
+  sc->pc = pstart;
+  return_false(sc, car_x);
+}
+
+/* -------- p_call_pp -------- */
+static s7_pointer opt_p_call_ff(opt_info *o)
+{
+  s7_pointer po2;
+  s7_scheme *sc = o->sc;
+  gc_protect_via_stack_no_let(sc, o->v[11].fp(o->v[10].o1));
+  po2 = o->v[9].fp(o->v[8].o1);
+  po2 = o->v[3].call(sc, set_plist_2(sc, gc_protected1(sc), po2));
+  unstack_gc_protect(sc);
+  return(po2);
+}
+
+static s7_pointer opt_p_call_fs(opt_info *o)
+{
+  s7_pointer po1 = o->v[11].fp(o->v[10].o1);
+  return(o->v[3].call(o->sc, set_plist_2(o->sc, po1, slot_value(o->v[1].p))));
+}
+
+static s7_pointer opt_p_call_sf(opt_info *o)
+{
+  s7_pointer po1 = o->v[11].fp(o->v[10].o1);
+  return(o->v[3].call(o->sc, set_plist_2(o->sc, slot_value(o->v[1].p), po1)));
+}
+
+static s7_pointer opt_p_call_fc(opt_info *o)
+{
+  s7_pointer po1 = o->v[11].fp(o->v[10].o1);
+  return(o->v[3].call(o->sc, set_plist_2(o->sc, po1, o->v[2].p)));
+}
+
+static s7_pointer opt_p_call_cc(opt_info *o) {return(o->v[3].call(o->sc, set_plist_2(o->sc, o->v[1].p, o->v[2].p)));}
+static s7_pointer opt_p_call_sc(opt_info *o) {return(o->v[3].call(o->sc, set_plist_2(o->sc, slot_value(o->v[1].p), o->v[2].p)));}
+static s7_pointer opt_p_call_ss(opt_info *o) {return(o->v[3].call(o->sc, set_plist_2(o->sc, slot_value(o->v[1].p), slot_value(o->v[2].p))));}
+
+static bool p_call_pp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, int32_t pstart)
+{
+  if ((is_safe_procedure(s_func)) && (c_function_is_aritable(s_func, 2)))
+    {
+      s7_pointer arg1 = cadr(car_x);
+      s7_pointer arg2 = caddr(car_x);
+      opc->v[3].call = cf_call(sc, car_x, s_func, 2);
+      if ((is_code_constant(sc, arg1)) && (is_code_constant(sc, arg2)))
+	{
+	  opc->v[0].fp = opt_p_call_cc;
+	  opc->v[1].p = (is_pair(arg1)) ? cadr(arg1) : arg1;
+	  opc->v[2].p = (is_pair(arg2)) ? cadr(arg2) : arg2;
+	  return_true(sc, car_x);
+	}
+      if (is_symbol(arg1))
+	{
+	  opc->v[1].p = s7_slot(sc, arg1);
+	  if ((is_slot(opc->v[1].p)) &&
+	      (!has_methods(slot_value(opc->v[1].p))))
+	    {
+	      if (is_symbol(arg2))
+		{
+		  opc->v[2].p = opt_simple_symbol(sc, arg2);
+		  if (opc->v[2].p)
+		    {
+		      opc->v[0].fp = opt_p_call_ss;
+		      return_true(sc, car_x);
+		    }
+		  sc->pc = pstart;
+		  return_false(sc, car_x);
+		}
+	      if (!is_pair(arg2))
+		{
+		  opc->v[2].p = arg2;
+		  opc->v[0].fp = opt_p_call_sc;
+		  return_true(sc, car_x);
+		}
+	      if (cell_optimize(sc, cddr(car_x)))
+		{
+		  opc->v[10].o1 = sc->opts[pstart];
+		  opc->v[11].fp = opc->v[10].o1->v[0].fp;
+		  opc->v[0].fp = opt_p_call_sf;
+		  return_true(sc, car_x);
+		}}
+	  else
+	    {
+	      sc->pc = pstart;
+	      return_false(sc, car_x);
+	    }}
+      opc->v[10].o1 = sc->opts[sc->pc];
+      if (cell_optimize(sc, cdr(car_x)))
+	{
+	  opc->v[11].fp = opc->v[10].o1->v[0].fp;
+	  if (is_symbol(arg2))
+	    {
+	      opc->v[1].p = opt_simple_symbol(sc, arg2);
+	      if (opc->v[1].p)
+		{
+		  opc->v[0].fp = opt_p_call_fs;
+		  return_true(sc, car_x);
+		}
+	      sc->pc = pstart;
+	      return_false(sc, car_x);
+	    }
+	  if ((!is_pair(arg2)) || (is_proper_quote(sc, arg2))) /* (char-ci<? (null? i) (quote . let)) t101-43.scm */
+	    {
+	      opc->v[0].fp = opt_p_call_fc;
+	      opc->v[2].p = (is_pair(arg2)) ? cadr(arg2) : arg2;
+	      check_opc_vector_wraps(opc);
+	      return_true(sc, car_x);
+	    }
+	  opc->v[8].o1 = sc->opts[sc->pc];
+	  if (cell_optimize(sc, cddr(car_x)))
+	    {
+	      opc->v[9].fp = opc->v[8].o1->v[0].fp;
+	      opc->v[0].fp = opt_p_call_ff;
+	      check_opc_vector_wraps(opc);
+	      return_true(sc, car_x);
+	    }}}
+  sc->pc = pstart;
+  return_false(sc, car_x);
+}
+
+
+/* -------- p_pip --------*/
+
+static s7_pointer opt_p_pip_ssf(opt_info *o) {return(o->v[3].p_pip_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o->v[5].fp(o->v[4].o1)));}
+static s7_pointer opt_p_pip_ssf_sset(opt_info *o) {return(string_set_p_pip_direct(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o->v[5].fp(o->v[4].o1)));}
+static s7_pointer opt_p_pip_ssf_vset(opt_info *o) {return(vector_set_p_pip_unchecked(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o->v[5].fp(o->v[4].o1)));}
+static s7_pointer opt_p_pip_sss(opt_info *o) {return(o->v[4].p_pip_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), slot_value(o->v[3].p)));}
+static s7_pointer opt_p_pip_sss_vset(opt_info *o) {return(vector_set_p_pip_unchecked(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), slot_value(o->v[3].p)));}
+static s7_pointer opt_p_pip_ssc(opt_info *o) {return(o->v[3].p_pip_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o->v[4].p));}
+static s7_pointer opt_p_pip_c(opt_info *o) {return(o->v[3].p_pip_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o->v[5].p_p_f(o->sc, o->v[4].p)));}
+
+static s7_pointer opt_p_pip_sff(opt_info *o)
+{
+  s7_int i1 = o->v[11].fi(o->v[10].o1);
+  return(o->v[3].p_pip_f(o->sc, slot_value(o->v[1].p), i1, o->v[9].fp(o->v[8].o1)));
+}
+
+static s7_pointer opt_p_pip_sff_lset(opt_info *o)
+{
+  s7_int i1 = o->v[11].fi(o->v[10].o1);
+  return(list_set_p_pip_unchecked(o->sc, slot_value(o->v[1].p), i1, o->v[9].fp(o->v[8].o1)));
+}
+
+static s7_pointer opt_p_pip_sso(opt_info *o)
+{
+  return(o->v[5].p_pip_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)),
+			o->v[6].p_pi_f(o->sc, slot_value(o->v[3].p), integer(slot_value(o->v[4].p)))));
+}
+
+static s7_pointer opt_p_pip_ssf1(opt_info *o)
+{
+  return(o->v[3].p_pip_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o->v[4].p_p_f(o->sc, o->v[6].fp(o->v[5].o1))));
+}
+
+static bool p_pip_ssf_combinable(s7_scheme *sc, opt_info *opc, int32_t start)
+{
+  opt_info *o1;
+  if ((sc->pc > 1) &&
+      (opc == sc->opts[sc->pc - 2]))
+    {
+      o1 = sc->opts[sc->pc - 1];
+      if ((o1->v[0].fp == opt_p_pi_ss) || (o1->v[0].fp == opt_p_pi_ss_sref) || (o1->v[0].fp == opt_p_pi_ss_vref) ||
+	  (o1->v[0].fp == opt_p_pi_ss_sref_direct) || (o1->v[0].fp == opt_p_pi_ss_vref_direct) ||
+	  (o1->v[0].fp == opt_p_pi_ss_fvref_direct) || (o1->v[0].fp == opt_p_pi_ss_ivref_direct) ||
+	  (o1->v[0].fp == opt_p_pi_ss_pref))
+	{
+	  opc->v[5].p_pip_f = opc->v[3].p_pip_f;
+	  opc->v[6].p_pi_f = o1->v[3].p_pi_f;
+	  opc->v[3].p = o1->v[1].p;
+	  opc->v[4].p = o1->v[2].p;
+	  opc->v[0].fp = opt_p_pip_sso;
+	  backup_pc(sc);
+	  return_true(sc, NULL);
+	}
+      if (o1->v[0].fp == opt_p_p_c)
+	{
+	  opc->v[5].p_p_f = o1->v[2].p_p_f;
+	  opc->v[4].p = o1->v[1].p;
+	  backup_pc(sc);
+	  opc->v[0].fp = opt_p_pip_c;
+	  return_true(sc, NULL);
+	}}
+  o1 = sc->opts[start];
+  if (o1->v[0].fp != opt_p_p_f)
+    return_false(sc, NULL);
+  opc->v[4].p_p_f = o1->v[2].p_p_f;
+  opc->v[5].o1 = sc->opts[start + 1];
+  opc->v[6].fp = sc->opts[start + 1]->v[0].fp;
+  opc->v[0].fp = opt_p_pip_ssf1;
+  return_true(sc, NULL);
+}
+
+static bool p_pip_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  s7_pointer obj, slot1, obj1, sig, checker = NULL, val_type;
+  s7_p_pip_t func = s7_p_pip_function(s_func);
+  if (!func)
+    return_false(sc, car_x);
+
+  sig = c_function_signature(s_func);
+  if ((is_pair(sig)) &&
+      (is_pair(cdr(sig))) &&
+      (is_symbol(cadr(sig))))
+    checker = cadr(sig);
+
+  /* here we know cadr is a symbol */
+  slot1 = s7_slot(sc, cadr(car_x));
+  if (!is_slot(slot1))
+    return_false(sc, car_x);
+  obj1 = slot_value(slot1);
+  if ((has_methods(obj1)) || (is_immutable(obj1)))
+    return_false(sc, car_x);
+  if ((is_any_vector(obj1)) && (vector_rank(obj1) > 1))
+    return_false(sc, car_x);
+
+  val_type = opt_arg_type(sc, cdddr(car_x));
+  opc->v[1].p = slot1;
+  obj = slot_value(opc->v[1].p);
+  opc->v[3].p_pip_f = func;
+  if ((s7_p_pip_unchecked_function(s_func)) &&
+      (checker))
+    {
+      if ((is_t_vector(obj)) && (checker == sc->is_vector_symbol))
+	opc->v[3].p_pip_f = (is_typed_vector(obj)) ? typed_vector_set_p_pip_unchecked : vector_set_p_pip_unchecked;
+      else
+	if ((is_pair(obj)) && (checker == sc->is_pair_symbol)) /* avoid dumb mismatch in val_type and sig below, #t integer:any? and integer? integer:any? */
+	  opc->v[3].p_pip_f = s7_p_pip_unchecked_function(s_func);
+	else
+	  if ((val_type == cadddr(sig)) &&
+	      (((is_string(obj)) && (checker == sc->is_string_symbol)) ||
+	       ((is_float_vector(obj)) && (checker == sc->is_float_vector_symbol)) ||
+	       ((is_int_vector(obj)) && (checker == sc->is_int_vector_symbol)) ||
+	       ((is_byte_vector(obj)) && (checker == sc->is_byte_vector_symbol))))
+	    opc->v[3].p_pip_f = s7_p_pip_unchecked_function(s_func);
+    }
+  if (is_symbol(caddr(car_x)))
+    {
+      int32_t start = sc->pc;
+      s7_pointer arg3 = cadddr(car_x); /* see val_type above */
+      s7_pointer slot2 = opt_integer_symbol(sc, caddr(car_x));
+      if (slot2)
+	{
+	  opc->v[2].p = slot2;
+	  if (has_loop_end(slot2))
+	    switch (type(obj))
+	      {
+	      case T_VECTOR:
+		if (loop_end(slot2) <= vector_length(obj))
+		  opc->v[3].p_pip_f = (is_typed_vector(obj)) ? typed_t_vector_set_p_pip_direct : t_vector_set_p_pip_direct;
+		break;
+	      case T_BYTE_VECTOR:
+		if ((val_type != sc->is_integer_symbol) && (val_type != sc->is_byte_symbol)) return_false(sc, car_x);
+		if (loop_end(slot2) <= vector_length(obj))
+		  opc->v[3].p_pip_f = byte_vector_set_p_pip_direct;
+		break;
+	      case T_INT_VECTOR:
+		if ((val_type != sc->is_integer_symbol) && (val_type != sc->is_byte_symbol)) return_false(sc, car_x);
+		if (loop_end(slot2) <= vector_length(obj))
+		  opc->v[3].p_pip_f = int_vector_set_p_pip_direct;
+		break;
+	      case T_FLOAT_VECTOR:
+		if ((val_type != sc->is_float_symbol) && (val_type != sc->is_real_symbol)) return_false(sc, car_x);
+		if (loop_end(slot2) <= vector_length(obj))
+		  opc->v[3].p_pip_f = float_vector_set_p_pip_direct;
+		break;
+	      case T_STRING:
+		if (loop_end(slot2) <= string_length(obj))
+		  opc->v[3].p_pip_f = string_set_p_pip_direct;
+		break;
+	      } /* T_PAIR here would require list_length check which sort of defeats the purpose */
+
+	  if (is_symbol(arg3))
+	    {
+	      s7_pointer val_slot = opt_simple_symbol(sc, arg3);
+	      /* TODO: for int|byte|float-vector and string need opt_arg_type check?? see val_type above, if vector-set! but have int-vector sig is wrong */
+	      if (val_slot)
+		{
+		  opc->v[4].p_pip_f = opc->v[3].p_pip_f;
+		  opc->v[3].p = val_slot;
+		  opc->v[0].fp = (opc->v[4].p_pip_f == vector_set_p_pip_unchecked) ? opt_p_pip_sss_vset : opt_p_pip_sss;
+		  return_true(sc, car_x);
+		}}
+	  else
+	    if ((!is_pair(arg3)) ||
+		(is_proper_quote(sc, arg3)))
+	      {
+		opc->v[4].p = (is_pair(arg3)) ? cadr(arg3) : arg3;
+		opc->v[0].fp = opt_p_pip_ssc;
+		return_true(sc, car_x);
+	      }
+	  if (cell_optimize(sc, cdddr(car_x)))
+	    {
+	      if (p_pip_ssf_combinable(sc, opc, start))
+		return_true(sc, car_x);
+	      opc->v[0].fp = (opc->v[3].p_pip_f == string_set_p_pip_direct) ? opt_p_pip_ssf_sset :
+                               ((opc->v[3].p_pip_f == vector_set_p_pip_unchecked) ? opt_p_pip_ssf_vset : opt_p_pip_ssf);
+	      opc->v[4].o1 = sc->opts[start];
+	      opc->v[5].fp = sc->opts[start]->v[0].fp;
+	      return_true(sc, car_x);
+	    }}}
+  else /* not symbol caddr */
+    {
+      opc->v[10].o1 = sc->opts[sc->pc];
+      if (int_optimize(sc, cddr(car_x)))
+	{
+	  opc->v[8].o1 = sc->opts[sc->pc];
+	  if (cell_optimize(sc, cdddr(car_x)))
+	    {
+	      opc->v[0].fp = (opc->v[3].p_pip_f == list_set_p_pip_unchecked) ? opt_p_pip_sff_lset : opt_p_pip_sff;
+	      opc->v[11].fi = opc->v[10].o1->v[0].fi;
+	      opc->v[9].fp = opc->v[8].o1->v[0].fp;
+	      return_true(sc, car_x);
+	    }}}
+  return_false(sc, car_x);
+}
+
+/* -------- p_piip -------- */
+static s7_pointer opt_p_piip_sssf(opt_info *o)
+{
+  return(o->v[5].p_piip_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), integer(slot_value(o->v[3].p)), o->v[11].fp(o->v[10].o1)));
+}
+
+static s7_pointer vector_set_piip_sssf_unchecked(opt_info *o)
+{
+  s7_pointer v = slot_value(o->v[1].p);
+  s7_pointer val = o->v[11].fp(o->v[10].o1);
+  vector_element(v, ((integer(slot_value(o->v[2].p)) * vector_offset(v, 0)) + integer(slot_value(o->v[3].p)))) = val;
+  return(val);
+}
+
+static s7_pointer opt_p_piip_sssc(opt_info *o)
+{
+  return(o->v[5].p_piip_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), integer(slot_value(o->v[3].p)), o->v[4].p));
+}
+
+static s7_pointer opt_p_piip_sfff(opt_info *o)
+{
+  s7_int i1 = o->v[11].fi(o->v[10].o1);
+  s7_int i2 = o->v[9].fi(o->v[8].o1);
+  return(o->v[5].p_piip_f(o->sc, slot_value(o->v[1].p), i1, i2, o->v[3].fp(o->v[4].o1))); /* v[3] because v[5] is already in use */
+}
+
+static bool p_piip_to_sx(s7_scheme *sc, opt_info *opc, s7_pointer indexp1, s7_pointer indexp2, s7_pointer valp, s7_pointer obj)
+{
+  s7_pointer slot = opt_integer_symbol(sc, car(indexp2));
+  if (!slot)
+    return_false(sc, indexp1);
+  opc->v[3].p = slot;
+  slot = opt_integer_symbol(sc, car(indexp1));
+  if (slot)
+    {
+      opc->v[2].p = slot;
+      if ((is_symbol(car(valp))) ||
+	  (is_unquoted_pair(car(valp))))
+	{
+	  opc->v[10].o1 = sc->opts[sc->pc];
+	  if (!cell_optimize(sc, valp))
+	    return_false(sc, indexp1);
+	  opc->v[11].fp = opc->v[10].o1->v[0].fp;
+	  opc->v[0].fp = opt_p_piip_sssf;
+	  if ((is_t_vector(obj)) &&
+	      (loop_end_fits(opc->v[2].p, vector_dimension(obj, 0))) &&
+	      (loop_end_fits(opc->v[3].p, vector_dimension(obj, 1))))
+	    opc->v[0].fp = vector_set_piip_sssf_unchecked;
+	  return_true(sc, NULL);
+	}
+      opc->v[0].fp = opt_p_piip_sssc;
+      opc->v[4].p = (is_pair(car(valp))) ? cadar(valp) : car(valp);
+      return_true(sc, NULL);
+    }
+  opc->v[10].o1 = sc->opts[sc->pc];
+  if (int_optimize(sc, indexp1))
+    {
+      opc->v[8].o1 = sc->opts[sc->pc];
+      if (int_optimize(sc, indexp2))
+	{
+	  opc->v[4].o1 = sc->opts[sc->pc];
+	  if (cell_optimize(sc, valp))
+	    {
+	      opc->v[11].fi = opc->v[10].o1->v[0].fi;
+	      opc->v[9].fi = opc->v[8].o1->v[0].fi;
+	      opc->v[3].fp = opc->v[4].o1->v[0].fp;
+	      opc->v[0].fp = opt_p_piip_sfff;
+	      return_true(sc, NULL);
+	    }}}
+  return_false(sc, indexp1);
+}
+
+static bool p_piip_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  s7_p_piip_t func = s7_p_piip_function(s_func);
+  if ((func) && (s_func == global_value(sc->vector_set_symbol)) && (is_symbol(cadr(car_x))))
+    {
+      s7_pointer obj;
+      s7_pointer slot1 = s7_slot(sc, cadr(car_x));
+      if (!is_slot(slot1))
+	return_false(sc, car_x);
+      obj = slot_value(slot1);
+      if ((has_methods(obj)) || (is_immutable(obj)))
+	return_false(sc, car_x);
+      if ((is_any_vector(obj)) && /* vector_set_p_piip calls vector_setter(obj) */
+	  (vector_rank(obj) == 2))
+	{
+	  opc->v[1].p = slot1;
+	  opc->v[5].p_piip_f = vector_set_p_piip;
+	  return(p_piip_to_sx(sc, opc, cddr(car_x), cdddr(car_x), cddddr(car_x), obj));
+	}}
+  return_false(sc, car_x);
+}
+
+/* -------- p_pii -------- */
+static s7_pointer opt_p_pii_sss(opt_info *o)
+{
+  return(o->v[4].p_pii_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), integer(slot_value(o->v[3].p))));
+}
+
+static s7_pointer opt_p_pii_sff(opt_info *o)
+{
+  s7_int i1 = o->v[11].fi(o->v[10].o1);
+  s7_int i2 = o->v[9].fi(o->v[8].o1);
+  return(o->v[4].p_pii_f(o->sc, slot_value(o->v[1].p), i1, i2));
+}
+
+static s7_pointer vector_ref_pii_sss_unchecked(opt_info *o)
+{
+  s7_pointer v = slot_value(o->v[1].p);
+  return(vector_element(v, ((integer(slot_value(o->v[2].p)) * vector_offset(v, 0)) + integer(slot_value(o->v[3].p)))));
+}
+
+static bool p_pii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  s7_p_pii_t func = s7_p_pii_function(s_func);
+  if ((func) &&
+      (is_symbol(cadr(car_x))))
+    {
+      s7_pointer obj;
+      s7_pointer slot1 = s7_slot(sc, cadr(car_x));
+      if (!is_slot(slot1))
+	return_false(sc, car_x);
+      obj = slot_value(slot1);
+      if ((has_methods(obj)) || (is_immutable(obj)))
+	return_false(sc, car_x);
+      if ((is_t_vector(obj)) &&
+	  (vector_rank(obj) == 2))
+	{
+	  s7_pointer slot, indexp1 = cddr(car_x), indexp2 = cdddr(car_x);
+	  opc->v[1].p = slot1;
+	  opc->v[4].p_pii_f = vector_ref_p_pii;
+	  slot = opt_integer_symbol(sc, car(indexp2));
+	  if (slot)
+	    {
+	      opc->v[3].p = slot;
+	      slot = opt_integer_symbol(sc, car(indexp1));
+	      if (slot)
+		{
+		  opc->v[2].p = slot;
+		  opc->v[0].fp = opt_p_pii_sss;
+		  /* normal vector rank 2 (see above) */
+		  if ((loop_end_fits(opc->v[2].p, vector_dimension(slot_value(opc->v[1].p), 0))) &&
+		      (loop_end_fits(opc->v[3].p, vector_dimension(slot_value(opc->v[1].p), 1))))
+		    opc->v[0].fp = vector_ref_pii_sss_unchecked;
+		  return_true(sc, car_x);
+		}}
+	  opc->v[10].o1 = sc->opts[sc->pc];
+	  if (int_optimize(sc, indexp1))
+	    {
+	      opc->v[8].o1 = sc->opts[sc->pc];
+	      if (int_optimize(sc, indexp2))
+		{
+		  opc->v[0].fp = opt_p_pii_sff;
+		  opc->v[11].fi = opc->v[10].o1->v[0].fi;
+		  opc->v[9].fi = opc->v[8].o1->v[0].fi;
+		  return_true(sc, car_x);
+		}}}}
+  return_false(sc, car_x);
+}
+
+/* -------- p_ppi -------- */
+static s7_pointer opt_p_ppi_psf(opt_info *o) {return(o->v[3].p_ppi_f(o->sc, o->v[2].p, slot_value(o->v[1].p), o->v[5].fi(o->v[4].o1)));}
+static s7_pointer opt_p_ppi_psf_cpos(opt_info *o) {return(char_position_p_ppi(o->sc, o->v[2].p, slot_value(o->v[1].p), o->v[5].fi(o->v[4].o1)));}
+
+static bool p_ppi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  int32_t start = sc->pc;
+  s7_p_ppi_t ifunc = s7_p_ppi_function(s_func);
+  if (!ifunc)
+    return_false(sc, car_x);
+  opc->v[3].p_ppi_f = ifunc;
+  if ((is_character(cadr(car_x))) &&
+      (is_symbol(caddr(car_x))) &&
+      (int_optimize(sc, cdddr(car_x))))
+    {
+      s7_pointer slot = opt_simple_symbol(sc, caddr(car_x));
+      if (slot)
+	{
+	  opc->v[2].p = cadr(car_x);
+	  opc->v[1].p = slot;
+	  opc->v[0].fp = (ifunc == char_position_p_ppi) ? opt_p_ppi_psf_cpos : opt_p_ppi_psf;
+	  opc->v[4].o1 = sc->opts[start];
+	  opc->v[5].fi = sc->opts[start]->v[0].fi;
+	  return_true(sc, car_x);
+	}}
+  sc->pc = start;
+  return_false(sc, car_x);
+}
+
+/* -------- p_ppp -------- */
+static s7_pointer opt_p_ppp_ssf(opt_info *o) {return(o->v[3].p_ppp_f(o->sc, slot_value(o->v[1].p), slot_value(o->v[2].p), o->v[5].fp(o->v[4].o1)));}
+static s7_pointer opt_p_ppp_hash_table_increment(opt_info *o) {return(fx_hash_table_increment_1(o->sc, slot_value(o->v[1].p), slot_value(o->v[2].p), o->v[5].p));}
+static s7_pointer opt_p_ppp_sfs(opt_info *o) {return(o->v[3].p_ppp_f(o->sc, slot_value(o->v[1].p), o->v[5].fp(o->v[4].o1), slot_value(o->v[2].p)));}
+static s7_pointer opt_p_ppp_scs(opt_info *o) {return(o->v[3].p_ppp_f(o->sc, slot_value(o->v[1].p), o->v[2].p, slot_value(o->v[4].p)));}
+static s7_pointer opt_p_ppp_sss(opt_info *o) {return(o->v[4].p_ppp_f(o->sc, slot_value(o->v[1].p), slot_value(o->v[2].p), slot_value(o->v[3].p)));}
+static s7_pointer opt_p_ppp_sss_mul(opt_info *o) {return(multiply_p_ppp(o->sc, slot_value(o->v[1].p), slot_value(o->v[2].p), slot_value(o->v[3].p)));}
+static s7_pointer opt_p_ppp_sss_hset(opt_info *o) {return(s7_hash_table_set(o->sc, slot_value(o->v[1].p), slot_value(o->v[2].p), slot_value(o->v[3].p)));}
+static s7_pointer opt_p_ppp_ssc(opt_info *o) {return(o->v[3].p_ppp_f(o->sc, slot_value(o->v[1].p), slot_value(o->v[2].p), o->v[4].p));}
+static s7_pointer opt_list_3c(opt_info *o) {s7_scheme *sc = o->sc; return(list_3(sc, o->v[10].p, o->v[8].p, o->v[4].p));}
+
+static s7_pointer opt_p_ppp_sff(opt_info *o)
+{
+  s7_pointer res;
+  s7_scheme *sc = o->sc;
+  gc_protect_2_via_stack_no_let(sc, T_Ext(o->v[11].fp(o->v[10].o1)), T_Ext(o->v[9].fp(o->v[8].o1)));
+  res = o->v[3].p_ppp_f(o->sc, slot_value(o->v[1].p), gc_protected1(sc), gc_protected2(sc));
+  unstack_gc_protect(sc);
+  return(res);
+}
+
+static s7_pointer opt_p_ppp_fff(opt_info *o)
+{
+  s7_pointer res;
+  s7_scheme *sc = o->sc;
+  gc_protect_2_via_stack_no_let(sc, T_Ext(o->v[11].fp(o->v[10].o1)), T_Ext(o->v[9].fp(o->v[8].o1)));
+  res = o->v[3].p_ppp_f(sc, gc_protected1(sc), gc_protected2(sc), o->v[5].fp(o->v[4].o1));
+  unstack_gc_protect(sc);
+  return(res);
+}
+
+static s7_pointer opt_p_ppc_slot_set(opt_info *o) {slot_set_value(o->v[2].p, o->v[4].p); return(o->v[4].p);}
+static s7_pointer opt_p_pps_slot_set(opt_info *o) {slot_set_value(o->v[2].p, slot_value(o->v[4].p)); return(slot_value(o->v[4].p));}
+static s7_pointer opt_p_ppf_slot_set(opt_info *o) {slot_set_value(o->v[2].p, o->v[5].fp(o->v[4].o1)); return(slot_value(o->v[2].p));}
+
+static bool use_ppc_slot_set(s7_scheme *sc, opt_info *opc, s7_pointer let, s7_pointer symbol, s7_pointer value)
+{
+  s7_pointer slot = symbol_to_local_slot(sc, symbol, let);
+  if ((is_slot(slot)) && (!is_immutable(slot)))
+    {
+      opc->v[2].p = slot;
+      opc->v[4].p = value;
+      opc->v[0].fp = opt_p_ppc_slot_set;
+      return(true);
+    }
+  return(false);
+}
+
+static bool use_pps_slot_set(s7_scheme *sc, opt_info *opc, s7_pointer let, s7_pointer symbol, s7_pointer val_slot)
+{
+  s7_pointer slot = symbol_to_local_slot(sc, symbol, let);
+  if ((is_slot(slot)) && (!is_immutable(slot)))
+    {
+      opc->v[2].p = slot;
+      opc->v[4].p = val_slot;
+      opc->v[0].fp = opt_p_pps_slot_set;
+      return(true);
+    }
+  return(false);
+}
+
+static bool use_ppf_slot_set(s7_scheme *sc, opt_info *opc, s7_pointer let, s7_pointer symbol)
+{
+  s7_pointer slot = symbol_to_local_slot(sc, symbol, let);
+  if ((is_slot(slot)) && (!is_immutable(slot)))
+    {
+      opc->v[2].p = slot;
+      opc->v[0].fp = opt_p_ppf_slot_set;
+      return(true);
+    }
+  return(false);
+}
+
+static bool p_ppp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  s7_pointer arg1 = cadr(car_x);
+  s7_pointer arg2 = caddr(car_x);
+  s7_pointer arg3 = cadddr(car_x);
+  int32_t start = sc->pc;
+  s7_p_ppp_t func = s7_p_ppp_function(s_func);
+  if (!func)
+    return_false(sc, car_x);
+  opc->v[3].p_ppp_f = func;
+  if (is_symbol(arg1))
+    {
+      s7_pointer obj;
+      opt_info *o1;
+      s7_pointer slot = s7_slot(sc, arg1);
+      if ((!is_slot(slot)) ||
+	  (has_methods(slot_value(slot))))
+	return_false(sc, car_x);
+
+      obj = slot_value(slot);
+      if ((is_any_vector(obj)) &&
+	  (vector_rank(obj) > 1))
+	return_false(sc, car_x);
+
+      if (is_target_or_its_alias(car(car_x), s_func, sc->hash_table_set_symbol))
+	{
+	  if ((!is_hash_table(obj)) || (is_immutable_hash_table(obj)))
+	    return_false(sc, car_x);
+	}
+      else
+	if ((is_target_or_its_alias(car(car_x), s_func, sc->let_set_symbol)) &&
+	    ((!is_let(obj)) || (is_immutable(obj))))
+	  return_false(sc, car_x);
+
+      opc->v[1].p = slot;
+
+      if ((func == hash_table_set_p_ppp) && (is_hash_table(obj)))
+	opc->v[3].p_ppp_f = s7_hash_table_set;
+
+      if (is_symbol(arg2))
+	{
+	  if ((is_keyword(arg2)) && (is_symbol(arg3)) && (is_let(obj)) && (opc->v[3].p_ppp_f == let_set_2))
+	    {
+	      s7_pointer val_slot = opt_simple_symbol(sc, arg3);
+	      if ((val_slot) && (use_pps_slot_set(sc, opc, obj, keyword_symbol(arg2), val_slot)))
+		return_true(sc, car_x);
+	    }
+	  slot = opt_simple_symbol(sc, arg2);
+	  if (slot)
+	    {
+	      opc->v[2].p = slot;
+	      arg2 = slot_value(slot);
+	      if (is_symbol(arg3))
+		{
+		  slot = opt_simple_symbol(sc, arg3);
+		  if (slot)
+		    {
+		      s7_p_ppp_t func1 = opc->v[3].p_ppp_f;
+		      opc->v[4].p_ppp_f = func1;
+		      opc->v[3].p = slot;
+		      opc->v[0].fp = (func1 == multiply_p_ppp) ? opt_p_ppp_sss_mul : ((func1 == s7_hash_table_set) ? opt_p_ppp_sss_hset : opt_p_ppp_sss);
+		      return_true(sc, car_x);
+		    }}
+	      else
+		if ((!is_pair(arg3)) ||
+		    (is_proper_quote(sc, arg3)))
+		  {
+		    opc->v[4].p = (is_pair(arg3)) ? cadr(arg3) : arg3;
+		    opc->v[0].fp = opt_p_ppp_ssc;
+		    if ((is_let(obj)) && (opc->v[3].p_ppp_f == let_set_2) && (is_symbol(arg2))) /* (let-set! L3 :x 0) */
+		      use_ppc_slot_set(sc, opc, obj, (is_keyword(arg2)) ? keyword_symbol(arg2) : arg2, opc->v[4].p);
+		    return_true(sc, car_x);
+		  }
+	      if (optimize_op(car_x) == HOP_HASH_TABLE_INCREMENT)
+		{
+		  opc->v[0].fp = opt_p_ppp_hash_table_increment;
+		  opc->v[5].p = car_x;
+		  return_true(sc, car_x);
+		}
+	      if (cell_optimize(sc, cdddr(car_x)))
+		{
+		  opc->v[4].o1 = sc->opts[start];
+		  opc->v[5].fp = opc->v[4].o1->v[0].fp;
+		  opc->v[0].fp = opt_p_ppp_ssf;
+		  if ((is_let(obj)) && (is_symbol_and_keyword(arg2)) && (opc->v[3].p_ppp_f == let_set_2)) /* (let-set! L3 :x (+ (L3 'x) 1)) */
+		    use_ppf_slot_set(sc, opc, obj, keyword_symbol(arg2));
+		  return_true(sc, car_x);
+		}
+	      sc->pc = start;
+	    }}
+      if ((is_proper_quote(sc, arg2)) &&
+	  (is_symbol(arg3)))
+	{
+	  s7_pointer val_slot = opt_simple_symbol(sc, arg3);
+	  if (val_slot)
+	    {
+	      opc->v[2].p = cadr(arg2);
+	      opc->v[4].p = val_slot;
+	      opc->v[0].fp = opt_p_ppp_scs;
+	      if ((is_let(obj)) && (opc->v[3].p_ppp_f == let_set_2) && (is_symbol(cadr(arg2))))
+		use_pps_slot_set(sc, opc, obj, cadr(arg2), val_slot);
+	      return_true(sc, car_x);
+	    }}
+      o1 = sc->opts[sc->pc];
+      if (cell_optimize(sc, cddr(car_x)))
+	{
+	  opt_info *o2 = sc->opts[sc->pc];
+	  if (is_symbol(arg3))
+	    {
+	      s7_pointer val_slot = opt_simple_symbol(sc, arg3);
+	      if (val_slot)
+		{
+		  opc->v[2].p = val_slot;
+		  opc->v[0].fp = opt_p_ppp_sfs; /* hset case goes through the case below */
+		  opc->v[4].o1 = o1;
+		  opc->v[5].fp = o1->v[0].fp;
+		  return_true(sc, car_x);
+		}}
+	  if ((!is_pair(arg3)) && (is_let(obj)) && (is_quoted_symbol(arg2)) &&
+	      (opc->v[3].p_ppp_f == let_set_2) &&                   /* (let-set! L3 'x 0) */
+	      (use_ppc_slot_set(sc, opc, obj, cadr(arg2), arg3)))
+	    return_true(sc, car_x);
+
+	  if (cell_optimize(sc, cdddr(car_x)))
+	    {
+	      if ((is_let(obj)) && (is_quoted_symbol(arg2)) && (opc->v[3].p_ppp_f == let_set_2) && /* (let-set! L3 'x (+ (L3 'x) 1)) */
+		  (use_ppf_slot_set(sc, opc, obj, cadr(arg2))))
+		{
+		  opc->v[4].o1 = o2;
+		  opc->v[5].fp = opc->v[4].o1->v[0].fp;
+		  return_true(sc, car_x);
+		}
+	      opc->v[0].fp = opt_p_ppp_sff;
+	      opc->v[10].o1 = o1;
+	      opc->v[11].fp = o1->v[0].fp;
+	      opc->v[8].o1 = o2;
+	      opc->v[9].fp = o2->v[0].fp;
+	      return_true(sc, car_x);
+	    }}}
+  else /* arg1 not symbol */
+    {
+      opc->v[10].o1 = sc->opts[start];
+      if (cell_optimize(sc, cdr(car_x)))
+	{
+	  opc->v[8].o1 = sc->opts[sc->pc];
+	  if (cell_optimize(sc, cddr(car_x)))
+	    {
+	      opc->v[4].o1 = sc->opts[sc->pc];
+	      if (cell_optimize(sc, cdddr(car_x)))
+		{
+		  opc->v[0].fp = opt_p_ppp_fff;
+		  opc->v[11].fp = opc->v[10].o1->v[0].fp;
+		  opc->v[9].fp = opc->v[8].o1->v[0].fp;
+		  opc->v[5].fp = opc->v[4].o1->v[0].fp;
+		  if ((opc->v[3].p_ppp_f == list_p_ppp) &&
+		      (opc->v[5].fp == opt_p_c) && (opc->v[9].fp == opt_p_c) && (opc->v[11].fp == opt_p_c))
+		    {
+		      opc->v[0].fp = opt_list_3c;
+		      opc->v[4].p = opc->v[4].o1->v[1].p;
+		      opc->v[8].p = opc->v[8].o1->v[1].p;
+		      opc->v[10].p = opc->v[10].o1->v[1].p;
+		    }
+		  return_true(sc, car_x);
+		}}}}
+  sc->pc = start;
+  return_false(sc, car_x);
+}
+
+
+/* -------- p_call_ppp -------- */
+static s7_pointer opt_p_call_sss(opt_info *o)
+{
+  return(o->v[4].call(o->sc, set_plist_3(o->sc, slot_value(o->v[1].p), slot_value(o->v[2].p), slot_value(o->v[3].p))));
+}
+
+static s7_pointer opt_p_call_ccs(opt_info *o)
+{
+  return(o->v[4].call(o->sc, set_plist_3(o->sc, o->v[1].p, o->v[2].p, slot_value(o->v[3].p))));
+}
+
+static s7_pointer opt_p_call_css(opt_info *o)
+{
+  return(o->v[4].call(o->sc, set_plist_3(o->sc, o->v[1].p, slot_value(o->v[2].p), slot_value(o->v[3].p))));
+}
+
+static s7_pointer opt_p_call_ssf(opt_info *o)
+{
+  return(o->v[4].call(o->sc, set_plist_3(o->sc, slot_value(o->v[1].p), slot_value(o->v[2].p), o->v[6].fp(o->v[5].o1))));
+}
+
+static s7_pointer opt_p_call_ppp(opt_info *o)
+{
+  s7_pointer res;
+  s7_scheme *sc = o->sc;
+  gc_protect_2_via_stack_no_let(sc, o->v[4].fp(o->v[3].o1), o->v[6].fp(o->v[5].o1));
+  res = o->v[11].fp(o->v[10].o1); /* not combinable into next */
+  res = o->v[2].call(sc, set_plist_3(sc, gc_protected1(sc), gc_protected2(sc), res));
+  unstack_gc_protect(sc);
+  return(res);
+}
+
+static bool p_call_ppp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+  int32_t start = sc->pc;
+  if ((is_safe_procedure(s_func)) && (c_function_is_aritable(s_func, 3)) &&
+      (s_func != global_value(sc->hash_table_ref_symbol)) && (s_func != global_value(sc->list_ref_symbol)))
+    {
+      s7_pointer slot, arg1 = cadr(car_x), arg2 = caddr(car_x), arg3 = cadddr(car_x);
+      opt_info *o1 = sc->opts[sc->pc];
+
+      if (!is_pair(arg1))
+	{
+	  if (is_normal_symbol(arg1))
+	    {
+	      slot = opt_simple_symbol(sc, arg1);
+	      if (slot)
+		{
+		  opc->v[1].p = slot;
+		  if ((s_func == global_value(sc->vector_ref_symbol)) &&
+		      (is_t_vector(slot_value(slot))) && (vector_rank(slot_value(slot)) != 2))
+		    return_false(sc, car_x);
+		}
+	      else return_false(sc, car_x); /* no need for sc->pc = start here, I think */
+	    }
+	  else
+	    {
+	      if ((is_code_constant(sc, arg1)) && (is_code_constant(sc, arg2)) && (is_normal_symbol(arg3)))
+		{
+		  s7_pointer val_slot = opt_simple_symbol(sc, arg3);
+		  if (val_slot)
+		    {
+		      opc->v[1].p = (is_pair(arg1)) ? cadr(arg1) : arg1;
+		      opc->v[2].p = (is_pair(arg2)) ? cadr(arg2) : arg2;
+		      opc->v[3].p = val_slot;
+		      opc->v[4].call = cf_call(sc, car_x, s_func, 3);
+		      opc->v[0].fp = opt_p_call_ccs;
+		      return_true(sc, car_x);
+		    }}
+	      opc->v[1].p = arg1;
+	      if (s_func == global_value(sc->vector_ref_symbol))
+		return_false(sc, car_x);
+	    }
+	  if (is_normal_symbol(arg2))
+	    {
+	      slot = opt_simple_symbol(sc, arg2);
+	      if (slot)
+		{
+		  opc->v[2].p = slot;
+		  if (is_normal_symbol(arg3))
+		    {
+		      slot = opt_simple_symbol(sc, arg3);
+		      if (slot)
+			{
+			  opc->v[3].p = slot;
+			  opc->v[4].call = cf_call(sc, car_x, s_func, 3);
+			  opc->v[0].fp = (is_slot(opc->v[1].p)) ? opt_p_call_sss : opt_p_call_css;
+			  return_true(sc, car_x);
+			}}
+		  else
+		    if (is_slot(opc->v[1].p))
+		      {
+			int32_t start1 = sc->pc;
+			if ((cf_call(sc, car_x, s_func, 3) == g_substring_uncopied) && /* opc->v[4].call is unsafe -- might not be set */
+			    (is_t_integer(slot_value(opc->v[2].p))) &&
+			    (is_string(slot_value(opc->v[1].p))) &&
+			    (int_optimize(sc, cdddr(car_x))))
+			  {
+			    opc->v[0].fp = opt_p_substring_uncopied_ssf;
+			    opc->v[5].o1 = o1;
+			    opc->v[6].fi = o1->v[0].fi;
+			    return_true(sc, car_x);
+			  }
+			sc->pc = start1;
+			if (cell_optimize(sc, cdddr(car_x)))
+			  {
+			    opc->v[4].call = cf_call(sc, car_x, s_func, 3);
+			    opc->v[0].fp = opt_p_call_ssf;
+			    opc->v[5].o1 = o1;
+			    opc->v[6].fp = o1->v[0].fp;
+			    return_true(sc, car_x);
+			  }}}}}
+      if (s_func == global_value(sc->vector_ref_symbol))
+	return_false(sc, car_x);
+      if (cell_optimize(sc, cdr(car_x)))
+	{
+	  opt_info *o2 = sc->opts[sc->pc];
+	  if (cell_optimize(sc, cddr(car_x)))
+	    {
+	      opt_info *o3 = sc->opts[sc->pc];
+	      if (cell_optimize(sc, cdddr(car_x)))
+		{
+		  opc->v[2].call = cf_call(sc, car_x, s_func, 3);
+		  opc->v[0].fp = opt_p_call_ppp;
+		  opc->v[3].o1 = o1;
+		  opc->v[4].fp = o1->v[0].fp;
+		  opc->v[5].o1 = o2;
+		  opc->v[6].fp = o2->v[0].fp;
+		  opc->v[10].o1 = o3;
+		  opc->v[11].fp = o3->v[0].fp;
+		  return_true(sc, car_x);
+		}}}}
+  sc->pc = start;
+  return_false(sc, car_x);
+}
+
+
+/* -------- p_call_any -------- */
+#define P_CALL_O1 3
+
+static s7_pointer opt_p_call_any(opt_info *o)
+{
+  s7_scheme *sc = o->sc;
+  s7_pointer val = safe_list_if_possible(sc, o->v[1].i);
+  s7_pointer arg = val;
+  if (in_heap(val)) gc_protect_via_stack_no_let(sc, val);
+  for (s7_int i = 0; i < o->v[1].i; i++, arg = cdr(arg))
+    {
+      opt_info *o1 = o->v[i + P_CALL_O1].o1;
+      set_car(arg, o1->v[0].fp(o1));
+    }
+  arg = o->v[2].call(sc, val);
+  if (in_heap(val)) unstack_gc_protect(sc);
+  else clear_list_in_use(val);
+  return(arg);
+}
+
+static bool p_call_any_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, int32_t len)
+{
+  if ((len < (NUM_VUNIONS - P_CALL_O1)) &&
+      (is_safe_procedure(s_func)) &&
+      (c_function_is_aritable(s_func, len - 1)))
+    {
+      s7_pointer p = cdr(car_x);      /* (vector-set! v k i 2) gets here */
+      opc->v[1].i = (len - 1);
+      for (int32_t pctr = P_CALL_O1; is_pair(p); pctr++, p = cdr(p))
+	{
+	  opc->v[pctr].o1 = sc->opts[sc->pc];
+	  if (!cell_optimize(sc, p))
+	    break;
+	}
+      if (is_null(p))
+	{
+	  opc->v[0].fp = opt_p_call_any;
+	  opc->v[2].call = cf_call(sc, car_x, s_func, len - 1);
+	  return_true(sc, car_x);
+	}}
+  return_false(sc, car_x);
+}
+
+
+/* -------- p_fx_any -------- */
+
+static s7_pointer opt_p_fx_any(opt_info *o) {return(o->v[1].call(o->sc, o->v[2].p));}
+
+static bool p_fx_any_ok(s7_scheme *sc, opt_info *opc, s7_pointer x)
+{
+  s7_function f = ((is_pair(car(x))) && (has_fx(car(x)))) ? fx_proc(car(x)) : NULL;
+  /* if (!f) f = ((is_pair(car(x))) && (is_pair(cdar(x))) && (has_fx(cdar(x)))) ? fx_proc(cdar(x)) : NULL; else fprintf(stderr, "use car\n"); */
+#if 0
+  fprintf(stderr, "car(x): %s %d %s %p\n", display(car(x)), has_fx(car(x)), describe_type_bits(sc, car(x)), f);
+  fprintf(stderr, "cdar(x): %s %d %s %p\n", display(cdar(x)), has_fx(cdar(x)), describe_type_bits(sc, cdar(x)), f);
+#endif
+  if (!f) return_false(sc, x);
+  opc->v[0].fp = opt_p_fx_any;
+  opc->v[1].call = f;
+  opc->v[2].p = car(x);
+  return_true(sc, x);
+}
+
+
+/* -------- p_implicit -------- */
+
+static bool p_implicit_ok(s7_scheme *sc, s7_pointer s_slot, s7_pointer car_x, int32_t len)
+{
+  s7_pointer obj = slot_value(s_slot);
+  s7_pointer arg1 = (len > 1) ? cadr(car_x) : sc->F;
+  opt_info *opc;
+  int32_t start;
+
+  if ((!is_simple_sequence(obj)) || (len < 2)) /* was is_sequence? */
+    return_false(sc, car_x);
+
+  opc = alloc_opt_info(sc);
+  opc->v[1].p = s_slot;
+  start = sc->pc;
+  if (len == 2)
+    {
+      switch (type(obj))
+	{
+	case T_PAIR:       opc->v[3].p_pi_f = list_ref_p_pi_unchecked;   break;
+	case T_HASH_TABLE: opc->v[3].p_pp_f = s7_hash_table_ref;         break;
+	case T_LET:        opc->v[3].p_pp_f = let_ref;	                 break;
+	case T_STRING:     opc->v[3].p_pi_f = string_ref_p_pi_unchecked; break;
+	case T_C_OBJECT:   return_false(sc, car_x); /* no pi_ref because ref assumes pp */
+
+	case T_VECTOR:
+	  if (vector_rank(obj) != 1)
+	    return_false(sc, car_x);
+	  opc->v[3].p_pi_f = t_vector_ref_p_pi_unchecked;
+	  break;
+
+	case T_BYTE_VECTOR:
+	case T_INT_VECTOR:
+	case T_FLOAT_VECTOR:
+	  if (vector_rank(obj) != 1)
+	    return_false(sc, car_x);
+	  opc->v[3].p_pi_f = vector_ref_p_pi_unchecked;
+	  break;
+
+	default:
+	  return_false(sc, car_x);
+	}
+      /* now v3.p_pi|pp.f is set */
+      if (is_symbol(arg1))
+	{
+	  s7_pointer slot = s7_slot(sc, arg1); /* not the desired slot if let+keyword, see below */
+	  if (is_slot(slot))
+	    {
+	      opc->v[2].p = slot;
+	      if ((!is_hash_table(obj)) && /* these because opt_int below */
+		  (!is_let(obj)))
+		{
+		  if (!is_t_integer(slot_value(slot)))
+		    return_false(sc, car_x); /* I think this reflects that a non-int index is an error for list-ref et al */
+		  opc->v[0].fp = opt_p_pi_ss;
+		  if (has_loop_end(opc->v[2].p))
+		    check_unchecked(sc, obj, opc->v[2].p, opc, NULL);
+		  fixup_p_pi_ss(opc);
+		  return_true(sc, car_x);
+		}
+	      opc->v[0].fp = ((is_hash_table(obj)) && (opc->v[3].p_pp_f == s7_hash_table_ref)) ? opt_p_pp_ss_href :
+		              (((is_let(obj)) && (opc->v[3].p_pp_f == let_ref)) ? opt_p_pp_ss_lref :  opt_p_pp_ss);
+	      if ((opc->v[0].fp == opt_p_pp_ss_lref) && (is_keyword(arg1)))
+		use_slot_ref(sc, opc, obj, keyword_symbol(arg1));  /* if keyword, slot is: (L3 :x) -> #<slot: :x :x> */
+	      return_true(sc, car_x);
+	    }}
+      else /* arg1 not a symbol */
+	{
+	  if ((!is_hash_table(obj)) &&
+	      (!is_let(obj)))
+	    {
+	      opt_info *o1;
+	      if (is_t_integer(arg1))
+		{
+		  opc->v[2].i = integer(arg1);
+		  opc->v[0].fp = opt_p_pi_sc;
+		  return_true(sc, car_x);
+		}
+	      o1 = sc->opts[sc->pc];
+	      if (!int_optimize(sc, cdr(car_x)))
+		return_false(sc, car_x);
+	      opc->v[0].fp = opt_p_pi_sf;
+	      opc->v[4].o1 = o1;
+	      opc->v[5].fi = o1->v[0].fi;
+	      return_true(sc, car_x);
+	    }
+
+	  if ((!is_pair(arg1)) ||
+	      (is_proper_quote(sc, arg1)))
+	    {
+	      opc->v[2].p = (!is_pair(arg1)) ? arg1 : cadr(arg1);
+	      opc->v[0].fp = opt_p_pp_sc;
+	      if ((is_pair(arg1)) && (is_symbol(opc->v[2].p)) && (is_let(obj)) && (opc->v[3].p_pp_f == let_ref))
+		use_slot_ref(sc, opc, obj, cadr(arg1));
+	      return_true(sc, car_x);
+	    }
+
+	  if (cell_optimize(sc, cdr(car_x)))
+	    { /* need both type check and func check! (hash-table-ref or 123) */
+	      opc->v[0].fp = ((is_hash_table(obj)) && (opc->v[3].p_pp_f == s7_hash_table_ref)) ? opt_p_pp_sf_href :
+		              (((is_let(obj)) && (opc->v[3].p_pp_f == let_ref)) ? opt_p_pp_sf_lref :  opt_p_pp_sf);
+	      opc->v[4].o1 = sc->opts[start];
+	      opc->v[5].fp = sc->opts[start]->v[0].fp;
+	      return_true(sc, car_x);
+	    }}} /* len==2 */
+  else
+    { /* len > 2 */
+      if ((is_t_vector(obj)) && (len == 3) && (vector_rank(obj) == 2))
+	{
+	  s7_pointer slot = opt_integer_symbol(sc, caddr(car_x));
+	  if (slot)
+	    {
+	      opc->v[3].p = slot;
+	      slot = opt_integer_symbol(sc, arg1);
+	      if (slot)
+		{
+		  opc->v[2].p = slot;
+		  opc->v[4].p_pii_f = vector_ref_p_pii;
+		  opc->v[0].fp = opt_p_pii_sss;
+		  if ((loop_end_fits(opc->v[2].p, vector_dimension(obj, 0))) &&
+		      (loop_end_fits(opc->v[3].p, vector_dimension(obj, 1))))
+		    opc->v[0].fp = vector_ref_pii_sss_unchecked;
+		  return_true(sc, car_x);
+		}}
+	  opc->v[10].o1 = sc->opts[sc->pc];
+	  if (int_optimize(sc, cdr(car_x)))
+	    {
+	      opc->v[8].o1 = sc->opts[sc->pc];
+	      if (int_optimize(sc, cddr(car_x)))
+		{
+		  opc->v[0].fp = opt_p_pii_sff;
+		  opc->v[11].fi = opc->v[10].o1->v[0].fi;
+		  opc->v[9].fi = opc->v[8].o1->v[0].fi;
+		  /* opc->v[1].p set above */
+		  opc->v[4].p_pii_f = vector_ref_p_pii_direct;
+		  return_true(sc, car_x);
+		}}
+	  sc->pc = start;
+	}
+
+      #define P_IMPLICIT_CALL_O1 4
+      if (len < (NUM_VUNIONS - P_IMPLICIT_CALL_O1))  /* mimic p_call_any_ok */
+	{
+	  s7_pointer p = car_x;
+	  opc->v[1].i = len;
+	  for (int32_t pctr = (P_IMPLICIT_CALL_O1 - 1); is_pair(p); pctr++, p = cdr(p))
+	    {
+	      opc->v[pctr].o1 = sc->opts[sc->pc];
+	      if (!cell_optimize(sc, p))
+		break;
+	    }
+	  if (is_null(p))
+	    {
+	      /* here we know the vector rank/type, probably can handle the new value type, and maybe indices/dimensions,
+	       *   so at least forgo the vec type/rank + immutable checks, the *_set cases are from p_call_any_ok called in cell_optimize,
+	       *   but this is called very rarely mainly because hi-rank implicit refs are rare, and check_type_uncertainty is unhappy
+	       *   if there are multiple sets of a var.
+	       * hash-tables, lets, lists, and vectors with extra (implicit) args can't be handled because we have no way to tell
+	       *   what the implicit call will do, and in the opt_* context, everything must be "safe" (i.e. no defines or
+	       *   hidden multiple-values, etc).
+	       */
+	      if ((!is_any_vector(obj)) || (vector_rank(obj) != (len - 1))) return_false(sc, car_x); /* (* i (P2 1 1)) in timp.scm where P2 is a list */
+	      opc->v[0].fp = opt_p_call_any;
+	      switch (type(obj))     /* string can't happen here (no multidimensional strings), for pair/hash/let see above */
+		{
+		case T_INT_VECTOR:   opc->v[2].call = g_int_vector_ref;     break;
+		case T_BYTE_VECTOR:  opc->v[2].call = g_byte_vector_ref;    break;
+		case T_FLOAT_VECTOR: opc->v[2].call = g_float_vector_ref;   break;
+		case T_VECTOR:       opc->v[2].call = g_vector_ref;  	    break;
+		default:	     return_false(sc, car_x);
+		}
+	      return_true(sc, car_x);
+	    }}}
+  return_false(sc, car_x);
+}
+
+/* -------- cell_quote -------- */
+static bool opt_cell_quote(s7_scheme *sc, s7_pointer car_x)
+{
+  opt_info *opc;
+  if (!is_null(cddr(car_x)))
+    return_false(sc, car_x);
+  opc = alloc_opt_info(sc);
+  opc->v[1].p = cadr(car_x);
+  opc->v[0].fp = opt_p_c;
+  return_true(sc, car_x);
+}
+
+/* -------- cell_set -------- */
+static s7_pointer opt_set_p_p_f(opt_info *o)
+{
+  s7_pointer x = o->v[4].fp(o->v[3].o1);
+  slot_set_value(o->v[1].p, x);
+  return(x);
+}
+
+static s7_pointer opt_set_p_p_f_with_setter(opt_info *o)
+{
+  s7_pointer x = o->v[4].fp(o->v[3].o1);
+  call_c_function_setter(o->sc, slot_setter(o->v[1].p), slot_symbol(o->v[1].p), x);
+  slot_set_value(o->v[1].p, x); /* symbol_increment?? */
+  return(x);
+}
+
+static s7_pointer opt_set_input_port_string_p_p_f(opt_info *o)
+{
+  s7_pointer x = o->v[4].fp(o->v[3].o1); /* the string */
+  s7_pointer port = slot_value(o->v[2].p);
+  if (!is_input_port(port)) wrong_type_error_nr(o->sc, o->sc->port_string_symbol, 1, port, an_input_port_string);
+  set_input_port_string(o->sc, port, x);
+  return(x);
+}
+
+static s7_pointer opt_set_output_port_string_p_p_f(opt_info *o)
+{
+  s7_pointer x = o->v[4].fp(o->v[3].o1); /* the string */
+  s7_pointer port = slot_value(o->v[2].p);
+  if (!is_output_port(port)) wrong_type_error_nr(o->sc, o->sc->port_string_symbol, 1, port, an_input_port_string);
+  set_output_port_string(o->sc, port, x);
+  return(x);
+}
+
+static s7_pointer opt_set_p_i_s(opt_info *o)
+{
+  s7_pointer val = slot_value(o->v[2].p);
+  if (is_mutable_integer(val))
+    val = make_integer(o->sc, integer(val));
+  slot_set_value(o->v[1].p, val);
+  return(val);
+}
+
+static s7_pointer opt_set_p_i_f(opt_info *o)
+{
+  s7_pointer x = make_integer(o->sc, o->v[6].fi(o->v[5].o1));
+  slot_set_value(o->v[1].p, x);
+  return(x);
+}
+/* here and below (opt_set_p_d_f), the mutable versions are not safe, and are very tricky to make safe.  First if a variable is set twice,
+ *  in the body, as in (do (...) (... (set! buffix (+ 1 buffix)) (if (>= buffix fftsize) (set! buffix 0)))) from pvoc.scm,
+ *  if the first set! is opt_set_p_i_fm (buffix is assumed mutable), the second sets it to built-in immutable zero, so the next time around loop,
+ *  the set_integer is direct so now built-in 0 == 128 (yet still prints itself as "0").  Also if a mutable variable is stored,
+ * (define (f2) (let ((v (vector 0 0 0)) (y 1.0)) (do ((i 0 (+ i 1))) ((= i 3) v) (set! y (+ y 1.0)) (vector-set! v i y))))
+ * (f2) -> #(4.0 4.0 4.0).  Maybe safe if body has just one statement?
+ */
+
+#if 0
+static s7_pointer opt_set_p_i_fm(opt_info *o)
+{
+  s7_int x = o->v[6].fi(o->v[5].o1);
+  check_mutability(o->sc, o, __func__, __LINE__);
+  set_integer(slot_value(o->v[1].p), x);
+  return(slot_value(o->v[1].p));
+}
+#endif
+
+static s7_pointer opt_set_p_d_s(opt_info *o)
+{
+  s7_pointer val = slot_value(o->v[2].p);
+  if (is_mutable_number(val))
+    val = make_real(o->sc, real(val));
+  slot_set_value(o->v[1].p, val);
+  return(val);
+}
+
+static s7_pointer opt_set_p_d_f(opt_info *o)
+{
+  s7_pointer x = make_real(o->sc, o->v[5].fd(o->v[4].o1));
+  slot_set_value(o->v[1].p, x);
+  return(x);
+}
+
+#if 0
+static s7_pointer opt_set_p_d_fm(opt_info *o)
+{
+  s7_double x = o->v[5].fd(o->v[4].o1);
+  check_mutability(o->sc, o, __func__, __LINE__);
+  set_real(slot_value(o->v[1].p), x);
+  return(slot_value(o->v[1].p));
+}
+#endif
+
+static s7_pointer opt_set_p_d_f_sf_add(opt_info *o)
+{
+  s7_pointer x = make_real(o->sc, opt_d_dd_sf_add(o->v[4].o1));
+  slot_set_value(o->v[1].p, x);
+  return(x);
+}
+
+static s7_pointer opt_set_p_d_fm_sf_add(opt_info *o)
+{
+  s7_double x = opt_d_dd_sf_add(o->v[4].o1);
+  check_mutability(o->sc, o, __func__, __LINE__);
+  set_real(slot_value(o->v[1].p), x);
+  return(slot_value(o->v[1].p));
+}
+
+static s7_pointer opt_set_p_d_f_mm_add(opt_info *o)
+{
+  s7_double x1 = float_vector_ref_d_7pi(o->sc, slot_value(o->v[4].p), integer(slot_value(o->v[5].p))) * real(slot_value(o->v[3].p));
+  s7_double x2 = float_vector_ref_d_7pi(o->sc, slot_value(o->v[10].p), integer(slot_value(o->v[11].p))) * real(slot_value(o->v[9].p));
+  slot_set_value(o->v[1].p, make_real(o->sc, x1 + x2));
+  return(slot_value(o->v[1].p));
+}
+
+static s7_pointer opt_set_p_d_f_mm_subtract(opt_info *o)
+{
+  s7_double x1 = float_vector_ref_d_7pi(o->sc, slot_value(o->v[4].p), integer(slot_value(o->v[5].p))) * real(slot_value(o->v[3].p));
+  s7_double x2 = float_vector_ref_d_7pi(o->sc, slot_value(o->v[10].p), integer(slot_value(o->v[11].p))) * real(slot_value(o->v[9].p));
+  slot_set_value(o->v[1].p, make_real(o->sc, x1 - x2));
+  return(slot_value(o->v[1].p));
+}
+
+static s7_pointer opt_set_p_c(opt_info *o)
+{
+  slot_set_value(o->v[1].p, o->v[2].p);
+  return(o->v[2].p);
+}
+
+static s7_pointer opt_set_p_i_fo(opt_info *o)
+{
+  s7_int i = o->v[4].i_ii_f(integer(slot_value(o->v[2].p)), integer(slot_value(o->v[3].p)));
+  s7_pointer x = make_integer(o->sc, i);
+  slot_set_value(o->v[1].p, x);
+  return(x);
+}
+
+static s7_pointer opt_set_p_i_fo_add(opt_info *o)
+{
+  s7_int i = integer(slot_value(o->v[2].p)) + integer(slot_value(o->v[3].p));
+  s7_pointer x = make_integer(o->sc, i);
+  slot_set_value(o->v[1].p, x);
+  return(x);
+}
+
+static s7_pointer opt_set_p_i_fo1(opt_info *o)
+{
+  s7_int i = o->v[4].i_ii_f(integer(slot_value(o->v[2].p)), o->v[3].i);
+  s7_pointer x = make_integer(o->sc, i);
+  slot_set_value(o->v[1].p, x);
+  return(x);
+}
+
+static s7_pointer opt_set_p_i_fo1_add(opt_info *o)
+{
+  s7_int i = integer(slot_value(o->v[2].p)) + o->v[3].i;
+  s7_pointer x = make_integer(o->sc, i);
+  slot_set_value(o->v[1].p, x);
+  return(x);
+}
+
+static bool set_p_i_f_combinable(s7_scheme *sc, opt_info *opc)
+{
+  if ((sc->pc > 1) &&
+      (opc == sc->opts[sc->pc - 2]))
+    {
+      opt_info *o1 = sc->opts[sc->pc - 1];
+      if ((o1->v[0].fi == opt_i_ii_ss) ||
+	  (o1->v[0].fi == opt_i_ii_ss_add))
+	{
+	  opc->v[4].i_ii_f = o1->v[3].i_ii_f;
+	  opc->v[2].p = o1->v[1].p;
+	  opc->v[3].p = o1->v[2].p;
+	  opc->v[0].fp = (o1->v[0].fi == opt_i_ii_ss_add) ? opt_set_p_i_fo_add : opt_set_p_i_fo;
+	  backup_pc(sc);
+	  return_true(sc, NULL);
+	}
+      if ((o1->v[0].fi == opt_i_ii_sc) || (o1->v[0].fi == opt_i_ii_sc_add) || (o1->v[0].fi == opt_i_ii_sc_sub))
+	{
+	  opc->v[4].i_ii_f = o1->v[3].i_ii_f;
+	  opc->v[2].p = o1->v[1].p;
+	  opc->v[3].i = o1->v[2].i;
+	  opc->v[0].fp = (o1->v[0].fi == opt_i_ii_sc_add) ? opt_set_p_i_fo1_add : opt_set_p_i_fo1;
+	  /* opt_if_nbp: opt_set_p_i_fo1_add b/shoot */
+	  backup_pc(sc);
+	  return_true(sc, NULL);
+	}}
+  return_false(sc, NULL);
+}
+
+static bool set_p_d_f_combinable(s7_scheme *sc, opt_info *opc)
+{
+  if ((sc->pc > 3) &&
+      (opc == sc->opts[sc->pc - 4]))
+    {
+      opt_info *o1 = sc->opts[sc->pc - 3];
+      if ((o1->v[0].fd == opt_d_mm_fff) &&
+	  ((o1->v[3].d_dd_f == add_d_dd) || (o1->v[3].d_dd_f == subtract_d_dd)))
+	{
+	  opt_info *o2 = sc->opts[sc->pc - 2];
+	  opc->v[0].fp = (o1->v[3].d_dd_f == add_d_dd) ? opt_set_p_d_f_mm_add : opt_set_p_d_f_mm_subtract;
+	  opc->v[3].p = o2->v[1].p;
+	  opc->v[4].p = o2->v[2].p;
+	  opc->v[5].p = o2->v[3].p;
+	  o1 = sc->opts[sc->pc - 1];
+	  opc->v[9].p = o1->v[1].p;
+	  opc->v[10].p = o1->v[2].p;
+	  opc->v[11].p = o1->v[3].p;
+	  sc->pc -= 3;
+	  return_true(sc, NULL);
+	}}
+  return_false(sc, NULL);
+}
+
+static bool is_some_number(s7_scheme *sc, const s7_pointer tp)
+{
+  return((tp == sc->is_integer_symbol) ||
+	 (tp == sc->is_float_symbol) ||
+	 (tp == sc->is_real_symbol) ||
+	 (tp == sc->is_complex_symbol) ||
+	 (tp == sc->is_number_symbol) ||
+	 (tp == sc->is_byte_symbol) ||
+	 (tp == sc->is_rational_symbol));
+}
+
+static bool check_type_uncertainty(s7_scheme *sc, s7_pointer target, s7_pointer car_x, opt_info *opc, int32_t start_pc)
+{
+  s7_pointer code = sc->code;
+  /* if we're optimizing do, sc->code is (sometimes) ((vars...) (end...) car_x) where car_x is the do body, but it can also be for-each etc */
+
+  /* maybe the type uncertainty is not a problem */
+  if ((is_pair(code)) &&      /* t101-14: (vector-set! !v! 0 (do ((x (list 1 2 3) (cdr x)) (j -1)) ((null? x) j) (set! j (car x)))) */
+      (is_pair(car(code))) &&
+      (is_pair(cdr(code))) && /* weird that code sometimes has nothing to do with car_x -- tree_memq below for reality check */
+      (is_pair(cadr(code))))
+    {
+      s7_int counts;
+      if ((!has_low_count(code)) && /* only set below */
+	  (s7_tree_memq(sc, car_x, code)))
+	{
+	  if (is_pair(caar(code)))
+	    {
+	      counts = tree_count(sc, target, car(code), 0) +
+		       tree_count(sc, target, caadr(code), 0) +
+	               tree_count(sc, target, cddr(code), 0);
+	      for (s7_pointer p = car(code); is_pair(p); p = cdr(p))
+		{
+		  s7_pointer var = car(p);
+		  if ((is_proper_list_2(sc, var)) &&
+		      (car(var) == target))
+		    counts--;
+		}}
+	  else counts = tree_count(sc, target, code, 0);
+	}
+      else counts = 2;
+      /* can be from lambda: (lambda (n)...): ((n) (set! sum (+ sum n))) etc */
+      if (counts <= 2)
+	{
+	  set_has_low_count(code);
+	  sc->pc = start_pc;
+	  if (cell_optimize(sc, cddr(car_x)))
+	    {
+	      opc->v[0].fp = opt_set_p_p_f;
+	      opc->v[3].o1 = sc->opts[start_pc];
+	      opc->v[4].fp = sc->opts[start_pc]->v[0].fp;
+	      return_true(sc, car_x);
+	    }}}
+  return_false(sc, car_x);
+}
+
+static bool opt_cell_set(s7_scheme *sc, s7_pointer car_x) /* len == 3 here (p_syntax_ok) */
+{
+  opt_info *opc = alloc_opt_info(sc);
+  s7_pointer target = cadr(car_x);
+  s7_pointer value = caddr(car_x);
+  if (is_symbol(target))
+    {
+      s7_pointer settee;
+      if ((is_constant_symbol(sc, target)) ||
+	  ((is_slot(global_slot(target))) && (slot_has_setter(global_slot(target)))))
+	return_false(sc, car_x);
+
+      settee = s7_slot(sc, target);
+      if ((is_slot(settee)) &&
+	  (!is_immutable_slot(settee)) &&
+	  (!is_syntax(slot_value(settee))))
+	{
+ 	  int32_t start_pc = sc->pc;
+	  s7_pointer stype = s7_type_of(sc, slot_value(settee));
+	  s7_pointer atype;
+	  opc->v[1].p = settee;
+	  if (slot_has_setter(settee))
+	    {
+	      if ((is_c_function(slot_setter(settee))) &&
+		  (is_bool_function(slot_setter(settee))) &&
+		  (stype == opt_arg_type(sc, cddr(car_x))) &&
+		  (cell_optimize(sc, cddr(car_x))))
+		{
+		  opc->v[1].p = settee;
+		  opc->v[0].fp = opt_set_p_p_f_with_setter;
+		  opc->v[3].o1 = sc->opts[start_pc];
+		  opc->v[4].fp = sc->opts[start_pc]->v[0].fp;
+		  return_true(sc, car_x);
+		}
+	      return_false(sc, car_x);
+	    }
+
+	  if (stype == sc->is_integer_symbol)
+	    {
+	      if (is_symbol(value))
+		{
+		  s7_pointer val_slot = opt_integer_symbol(sc, value);
+		  if (val_slot)
+		    {
+		      opc->v[2].p = val_slot;
+		      opc->v[0].fp = opt_set_p_i_s;
+		      return_true(sc, car_x);
+		    }}
+	      else
+		{
+		  opc->v[5].o1 = sc->opts[sc->pc];
+		  if (!int_optimize(sc, cddr(car_x)))
+		    return(check_type_uncertainty(sc, target, car_x, opc, start_pc));
+		  if (!set_p_i_f_combinable(sc, opc))
+		    {
+		      opc->v[0].fp = opt_set_p_i_f;
+		      opc->v[6].fi = opc->v[5].o1->v[0].fi;
+		    }
+		  return_true(sc, car_x);
+		}
+	      return_false(sc, car_x);
+	    }
+	  if (stype == sc->is_float_symbol)
+	    {
+	      if (is_t_real(value))
+		{
+		  opc->v[2].p = value;
+		  opc->v[0].fp = opt_set_p_c;
+		  return_true(sc, car_x);
+		}
+	      if (is_symbol(caddr(car_x)))
+		{
+		  s7_pointer val_slot = opt_float_symbol(sc, value);
+		  if (val_slot)
+		    {
+		      opc->v[2].p = val_slot;
+		      opc->v[0].fp = opt_set_p_d_s;
+		      return_true(sc, car_x);
+		    }}
+	      else
+		{
+		  if ((is_pair(value)) &&
+		      (float_optimize(sc, cddr(car_x))))
+		    {
+		      if (!set_p_d_f_combinable(sc, opc))
+			{
+			  opc->v[4].o1 = sc->opts[start_pc];
+			  opc->v[5].fd = sc->opts[start_pc]->v[0].fd;
+			  opc->v[0].fp = (opc->v[5].fd == opt_d_dd_sf_add) ? opt_set_p_d_f_sf_add : opt_set_p_d_f;
+			}
+		      return_true(sc, car_x);
+		    }
+		  return(check_type_uncertainty(sc, target, car_x, opc, start_pc));
+		}
+	      return_false(sc, car_x);
+	    }
+
+	  atype = opt_arg_type(sc, cddr(car_x));
+	  if ((is_some_number(sc, atype)) && (!is_some_number(sc, stype)))
+	    return_false(sc, car_x);
+	  if ((stype != atype) &&
+	      (is_symbol(stype)) &&
+	      (((t_sequence_p[symbol_type(stype)]) &&
+		(stype != sc->is_null_symbol) && (stype != sc->is_pair_symbol) &&
+		(stype != sc->is_list_symbol) && (stype != sc->is_proper_list_symbol)) ||
+	       (stype == sc->is_iterator_symbol)))
+	    return_false(sc, car_x);
+	  if (cell_optimize(sc, cddr(car_x)))
+	    {
+	      opc->v[0].fp = opt_set_p_p_f;
+	      opc->v[3].o1 = sc->opts[start_pc];
+	      opc->v[4].fp = sc->opts[start_pc]->v[0].fp;
+	      return_true(sc, car_x);
+	    }}
+      return_false(sc, car_x);
+    }
+  if ((is_pair(target)) &&
+      (is_symbol(car(target))) &&
+      (is_pair(cdr(target))) &&
+      ((is_null(cddr(target))) || (is_null(cdddr(target))) || (is_null(cddddr(target)))))
+    {
+      s7_pointer obj, index, index_type, s_slot = s7_slot(sc, car(target));
+      if (!is_slot(s_slot))
+	return_false(sc, car_x);
+
+      obj = slot_value(s_slot);
+      opc->v[1].p = s_slot;
+
+      if (!is_mutable_sequence(obj))
+	{
+	  /* a ridiculous experiment... */
+	  if ((car(target) == sc->port_string_symbol) &&
+	      (obj == initial_value(car(target))) &&
+	      (is_normal_symbol(cadr(target))) &&
+	      (opt_arg_type(sc, cddr(car_x)) == sc->is_string_symbol))
+	    {
+	      s7_pointer port_type = opt_arg_type(sc, cdr(target));
+	      if ((port_type == sc->is_input_port_symbol) || (port_type == sc->is_output_port_symbol))
+		{
+		  int32_t start_pc = sc->pc;
+		  opc->v[2].p = s7_slot(sc, cadr(target));
+		  if ((is_slot(opc->v[2].p)) && (is_string_port(slot_value(opc->v[2].p))) && (cell_optimize(sc, cddr(car_x))))
+		    {
+		      opc->v[3].o1 = sc->opts[start_pc];
+		      opc->v[4].fp = sc->opts[start_pc]->v[0].fp;
+		      opc->v[0].fp = (port_type == sc->is_input_port_symbol) ? opt_set_input_port_string_p_p_f : opt_set_output_port_string_p_p_f;
+		      return_true(sc, car_x);
+		    }}}
+	  return_false(sc, car_x);
+	}
+
+      index = cadr(target);
+      index_type = opt_arg_type(sc, cdr(target));
+      switch (type(obj))
+	{
+	case T_STRING:
+	  {
+	    s7_pointer val_type;
+	    if ((index_type != sc->is_integer_symbol) || (is_pair(cddr(target)))) return_false(sc, car_x);
+	    val_type = opt_arg_type(sc, cddr(car_x));
+	    if (val_type != sc->is_char_symbol)
+	      return_false(sc, car_x);
+	    opc->v[3].p_pip_f = string_set_p_pip_unchecked;
+	  }
+	  break;
+
+	case T_VECTOR:
+	  if (index_type != sc->is_integer_symbol) return_false(sc, car_x);
+	  if (is_null(cddr(target)))
+	    {
+	      if (vector_rank(obj) != 1) return_false(sc, car_x);
+	      opc->v[3].p_pip_f = (is_typed_vector(obj)) ? typed_vector_set_p_pip_unchecked : vector_set_p_pip_unchecked;
+	    }
+	  else
+	    {
+	      if (vector_rank(obj) != 2)
+		return_false(sc, car_x);
+	      opc->v[5].p_piip_f = (is_typed_vector(obj)) ? typed_vector_set_p_piip_direct : vector_set_p_piip_direct;
+	      return(p_piip_to_sx(sc, opc, cdr(target), cddr(target), cddr(car_x), obj));
+	    }
+	  break;
+
+	case T_FLOAT_VECTOR:
+	  if (opt_float_vector_set(sc, opc, car(target), cdr(target),
+				   (is_null(cddr(target))) ? NULL : cddr(target),
+				   ((!is_pair(cddr(target))) || (is_null(cdddr(target)))) ? NULL : cdddr(target),
+				   cddr(car_x)))
+	    {
+	      opc->v[O_WRAP].fd = opc->v[0].fd;
+	      opc->v[0].fp = d_to_p;
+	      return_true(sc, car_x);
+	    }
+	  return_false(sc, car_x);
+
+	case T_BYTE_VECTOR:
+	case T_INT_VECTOR:
+	  if (opt_int_vector_set(sc, -1, opc, car(target), cdr(target), (is_null(cddr(target))) ? NULL : cddr(target), cddr(car_x)))
+	    {
+	      opc->v[O_WRAP].fi = opc->v[0].fi;
+	      opc->v[0].fp = i_to_p;
+	      return_true(sc, car_x);
+	    }
+	  return_false(sc, car_x);
+
+	case T_C_OBJECT:
+	  if ((is_null(cddr(target))) &&
+	      (is_c_function(c_object_setf(sc, obj))))
+	    {
+	      /* d_7pid_ok assumes cadr is the target, not car etc */
+	      s7_d_7pid_t func = s7_d_7pid_function(c_object_setf(sc, obj));
+	      if (func)
+		{
+		  s7_pointer slot = opt_integer_symbol(sc, cadr(target));
+		  opc->v[4].d_7pid_f = func;
+		  opc->v[10].o1 = sc->opts[sc->pc];
+		  if (slot)
+		    {
+		      if (float_optimize(sc, cddr(car_x)))
+			{
+			  opc->v[O_WRAP].fd = opt_d_7pid_ssf;
+			  opc->v[0].fp = d_to_p; /* cell_optimize, so need to return s7_pointer */
+			  opc->v[2].p = slot;
+			  opc->v[11].fd = opc->v[10].o1->v[0].fd;
+			  return_true(sc, car_x);
+			}}
+		  else
+		    if (int_optimize(sc, cdr(target)))
+		      {
+			opc->v[8].o1 = sc->opts[sc->pc];
+			if (float_optimize(sc, cddr(car_x)))
+			  {
+			    opc->v[O_WRAP].fd = opt_d_7pid_sff;
+			    opc->v[11].fi = opc->v[10].o1->v[0].fi;
+			    opc->v[9].fd = opc->v[8].o1->v[0].fd;
+			    opc->v[0].fp = d_to_p;
+			    return_true(sc, car_x);
+			  }}}}
+	  return_false(sc, car_x);
+
+	case T_PAIR:
+	  if (index_type != sc->is_integer_symbol) return_false(sc, car_x); /* (let ((tf13 '(()))) (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 letrec*) 0))) (f)) */
+	  if (is_pair(cddr(target))) return_false(sc, car_x);
+	  opc->v[3].p_pip_f = list_set_p_pip_unchecked;
+
+	  { /* an experiment -- is this ever hit in normal code? (for tref.scm) */
+	    if ((is_pair(value)) && (car(value) == sc->add_symbol) && (is_t_integer(caddr(value))) && (is_null(cdddr(value))) && (is_symbol(cadr(target))) &&
+		(car(target) == (caadr(value))) && (is_pair(cdadr(value))) && (is_null(cddadr(value))) && (cadr(target) == cadadr(value)))
+	      {
+		s7_pointer slot = opt_simple_symbol(sc, index);
+		if ((slot) && (is_t_integer(slot_value(slot))))
+		  {
+		    opc->v[2].p = slot;
+		    opc->v[3].p = caddr(value);
+		    opc->v[0].fp = list_increment_p_pip_unchecked;
+		    return_true(sc, car_x);
+		  }}}
+	  break;
+
+	case T_HASH_TABLE:
+	  if (is_pair(cddr(target))) return_false(sc, car_x);
+	  opc->v[3].p_ppp_f = s7_hash_table_set;
+	  break;
+
+	case T_LET:
+	  /* here we know the let is a covered mutable let -- ?? not true if s7-optimize called explicitly */
+	  if ((is_pair(cddr(target))) || (is_openlet(obj)))
+	    return_false(sc, car_x);
+	  if ((is_symbol_and_keyword(cadr(target))) ||
+	      ((is_quoted_symbol(cadr(target)))))
+	    opc->v[3].p_ppp_f = let_set_1;
+	  else opc->v[3].p_ppp_f = let_set_p_ppp_2;  /* (set! (L3 'x) (+ (L3 'x) 1)) */
+	  break;
+
+	default:
+	  return_false(sc, car_x);
+	}
+      if (is_symbol(index))
+	{
+	  int32_t start = sc->pc;
+	  s7_pointer slot = opt_simple_symbol(sc, index);
+	  if (slot)
+	    {
+	      opc->v[2].p = slot;
+	      if ((is_t_integer(slot_value(slot))) &&
+		  (has_loop_end(opc->v[2].p)))
+		{
+		  if (is_string(obj))
+		    {
+		      if (loop_end(opc->v[2].p) <= string_length(obj))
+			opc->v[3].p_pip_f = string_set_p_pip_direct;
+		    }
+		  else
+		    if (is_byte_vector(obj))
+		      {
+			if (loop_end(opc->v[2].p) <= byte_vector_length(obj))
+			  opc->v[3].p_pip_f = byte_vector_set_p_pip_direct;
+		      }
+		    else
+		      if (is_any_vector(obj)) /* true for all 3 vectors */
+			{
+			  if ((is_any_vector(obj)) &&
+			      (loop_end(opc->v[2].p) <= vector_length(obj)))
+			    {
+			      if (is_typed_t_vector(obj))
+				opc->v[3].p_pip_f = typed_t_vector_set_p_pip_direct;
+			      else opc->v[3].p_pip_f = t_vector_set_p_pip_direct;
+			    }}}
+	      if (is_symbol(value))
+		{
+		  s7_pointer val_slot = opt_simple_symbol(sc, value);
+		  if (val_slot)
+		    {
+		      s7_p_ppp_t func1;
+		      if ((is_string(obj)) ||
+			  (is_any_vector(obj)) ||
+			  (is_pair(obj)))
+			{
+			  opc->v[4].p_pip_f = opc->v[3].p_pip_f;
+			  opc->v[3].p = val_slot;
+			  opc->v[0].fp = opt_p_pip_sss;
+			  return_true(sc, car_x);
+			}
+		      if ((is_let(obj)) && (is_keyword(index)) && (opc->v[3].p_ppp_f == let_set_1) && /* (set! (L3 :x) i) */
+			  (use_pps_slot_set(sc, opc, obj, keyword_symbol(index), val_slot)))
+			return_true(sc, car_x);
+		      func1 = opc->v[3].p_ppp_f;
+		      opc->v[4].p_ppp_f = func1;
+		      opc->v[3].p = val_slot;
+		      opc->v[0].fp = (func1 == multiply_p_ppp) ? opt_p_ppp_sss_mul :
+			               (((is_hash_table(obj)) && (func1 == s7_hash_table_set)) ? opt_p_ppp_sss_hset : opt_p_ppp_sss);
+		      return_true(sc, car_x);
+		    }}
+	      else
+		if ((!is_pair(value)) ||
+		    (is_proper_quote(sc, value)))
+		  {
+		    if (!is_pair(value))
+		      opc->v[4].p = value;
+		    else opc->v[4].p = cadr(value);
+		    if ((is_string(obj)) ||
+			(is_any_vector(obj)) ||
+			(is_pair(obj)))
+		      {
+			opc->v[0].fp = opt_p_pip_ssc;
+			return_true(sc, car_x);
+		      }
+		    if ((is_let(obj)) && (is_keyword(index)) && (opc->v[3].p_ppp_f == let_set_1) && /* (set! (L3 :x) 0) */
+			(use_ppc_slot_set(sc, opc, obj, keyword_symbol(index), opc->v[4].p)))
+		      return_true(sc, car_x);
+		    opc->v[0].fp = opt_p_ppp_ssc;
+		    return_true(sc, car_x);
+		  }
+	      if (cell_optimize(sc, cddr(car_x)))
+		{
+		  opc->v[4].o1 = sc->opts[start];
+		  opc->v[5].fp = sc->opts[start]->v[0].fp;
+		  if ((is_string(obj)) ||
+		      (is_any_vector(obj)) ||
+		      (is_pair(obj)))
+		    {
+		      if (p_pip_ssf_combinable(sc, opc, start))
+			return_true(sc, car_x);
+		      opc->v[0].fp = opt_p_pip_ssf;
+		      return_true(sc, car_x);
+		    }
+		  if ((is_let(obj)) && (is_keyword(index)) && (opc->v[3].p_ppp_f == let_set_1) && /* (set! (L3 :x) (+ (L3 'x) 1)) */
+		      (use_ppf_slot_set(sc, opc, obj, keyword_symbol(index))))
+		    return_true(sc, car_x);
+
+		  opc->v[0].fp = opt_p_ppp_ssf;
+		  return_true(sc, car_x);
+		}}}
+      else /* index not a symbol */
+	{
+	  opt_info *o1;
+	  if ((is_string(obj)) ||
+	      (is_pair(obj)) ||
+	      (is_any_vector(obj)))
+	    {
+	      opc->v[10].o1 = sc->opts[sc->pc];
+	      if (int_optimize(sc, cdr(target)))
+		{
+		  opc->v[8].o1 = sc->opts[sc->pc];
+		  if (cell_optimize(sc, cddr(car_x)))
+		    {
+		      opc->v[0].fp = opt_p_pip_sff;
+		      opc->v[11].fi = opc->v[10].o1->v[0].fi;
+		      opc->v[9].fp = opc->v[8].o1->v[0].fp;
+		      return_true(sc, car_x);
+		    }}
+	      return_false(sc, car_x);
+	    }
+	  if (is_quoted_symbol(cadr(target)))
+	    {
+	      if (is_symbol(value))
+		{
+		  s7_pointer val_slot = opt_simple_symbol(sc, value);
+		  if (val_slot)
+		    {
+		      opc->v[2].p = cadadr(target);
+		      opc->v[4].p = val_slot;
+		      opc->v[0].fp = opt_p_ppp_scs;
+		      if ((is_let(obj)) && (opc->v[3].p_ppp_f == let_set_1))
+			use_pps_slot_set(sc, opc, obj, cadadr(target), val_slot);
+		      return_true(sc, car_x);
+		    }}
+	      if ((!is_pair(value)) && (is_let(obj)) && (opc->v[3].p_ppp_f == let_set_1) &&
+		  (use_ppc_slot_set(sc, opc, obj, cadadr(target), value)))
+		return_true(sc, car_x);
+	    }
+	  o1 = sc->opts[sc->pc];
+	  if (cell_optimize(sc, cdr(target)))
+	    {
+	      opt_info *o2;
+	      if (is_symbol(value))
+		{
+		  s7_pointer val_slot = opt_simple_symbol(sc, value);
+		  if (val_slot)
+		    {
+		      opc->v[2].p = val_slot;
+		      opc->v[0].fp = opt_p_ppp_sfs;
+		      opc->v[4].o1 = o1;
+		      opc->v[5].fp = o1->v[0].fp;
+		      return_true(sc, car_x);
+		    }}
+	      o2 = sc->opts[sc->pc];
+	      if (cell_optimize(sc, cddr(car_x)))
+		{
+		  opc->v[0].fp = opt_p_ppp_sff;
+		  if ((is_let(obj)) && (is_quoted_symbol(cadr(target))) && (opc->v[3].p_ppp_f == let_set_1) && /* (set! (L3 'x) (+ (L3 'x) 1)) */
+		      (use_ppf_slot_set(sc, opc, obj, cadadr(target))))
+		    {
+		      opc->v[4].o1 = o2;
+		      opc->v[5].fp = opc->v[4].o1->v[0].fp;
+		      return_true(sc, car_x);
+		    }
+		  opc->v[10].o1 = o1;
+		  opc->v[11].fp = o1->v[0].fp;
+		  opc->v[8].o1 = o2;
+		  opc->v[9].fp = o2->v[0].fp;
+		  return_true(sc, car_x);
+		}}}}
+  return_false(sc, car_x);
+}
+
+
+/* -------- cell_begin -------- */
+static s7_pointer opt_begin_p(opt_info *o)
+{
+  opt_info *o1;
+  s7_int i, len = o->v[1].i;            /* len = 1 if 2 exprs, etc */
+  for (i = 0; i < len; i++)
+    {
+      o1 = o->v[i + 2].o1;
+      o1->v[0].fp(o1);
+    }
+  o1 = o->v[i + 2].o1;
+  return(o1->v[0].fp(o1));
+}
+
+static s7_pointer opt_begin_p_1(opt_info *o)
+{
+  o->v[3].fp(o->v[2].o1);
+  return(o->v[5].fp(o->v[4].o1));
+}
+
+static void oo_idp_nr_fixup(opt_info *start)
+{
+  if (start->v[0].fp == d_to_p)
+    {
+      start->v[0].fp = d_to_p_nr;
+      if (start->v[O_WRAP].fd == opt_d_7pid_ssf)
+	start->v[0].fp = opt_d_7pid_ssf_nr;
+      else
+	if (start->v[O_WRAP].fd == opt_d_7pid_ssfo_fv)
+	  {
+	    start->v[0].fp = opt_d_7pid_ssfo_fv_nr;
+	    if (start->v[6].d_dd_f == add_d_dd)
+	      start->v[0].fp = opt_d_7pid_ssfo_fv_add_nr;
+	    else
+	      if (start->v[6].d_dd_f == subtract_d_dd)
+		start->v[0].fp = opt_d_7pid_ssfo_fv_sub_nr;
+	  }}
+  else
+    if (start->v[0].fp == i_to_p)
+      start->v[0].fp = i_to_p_nr;
+}
+
+static bool opt_cell_begin(s7_scheme *sc, s7_pointer car_x, int32_t len)
+{
+  int32_t i;
+  opt_info *opc;
+  s7_pointer p;
+  if (len > (NUM_VUNIONS - 3))
+    return_false(sc, car_x);
+  opc = alloc_opt_info(sc);
+  for (i = 2, p = cdr(car_x); is_pair(p); i++, p = cdr(p))
+    {
+      opt_info *start = sc->opts[sc->pc];
+      if (!cell_optimize(sc, p))
+	return_false(sc, car_x);
+      if (is_pair(cdr(p)))
+	oo_idp_nr_fixup(start);
+      opc->v[i].o1 = start;
+    }
+  opc->v[1].i = len - 2;
+  if (len == 3)
+    {
+      opc->v[0].fp = opt_begin_p_1;
+      opc->v[4].o1 = opc->v[3].o1;
+      opc->v[5].fp = opc->v[4].o1->v[0].fp;
+      opc->v[3].fp = opc->v[2].o1->v[0].fp;
+    }
+  else opc->v[0].fp = opt_begin_p;
+  return_true(sc, car_x);
+}
+
+/* -------- cell_when|unless -------- */
+static s7_pointer opt_when_p_2(opt_info *o)
+{
+  if (o->v[4].fb(o->v[3].o1))
+    {
+      o->v[6].fp(o->v[5].o1);
+      return(o->v[8].fp(o->v[7].o1));
+    }
+  return(o->sc->unspecified);
+}
+
+static s7_pointer opt_when_p(opt_info *o)
+{
+  if (o->v[4].fb(o->v[3].o1))
+    {
+      s7_int i, len = o->v[1].i - 1;
+      opt_info *o1;
+      for (i = 0; i < len; i++)
+	{
+	  o1 = o->v[i + 5].o1;
+	  o1->v[0].fp(o1);
+	}
+      o1 = o->v[i + 5].o1;
+      return(o1->v[0].fp(o1));
+    }
+  return(o->sc->unspecified);
+}
+
+static s7_pointer opt_when_p_1(opt_info *o)
+{
+  opt_info *o1;
+  if (!o->v[4].fb(o->v[3].o1))
+    return(o->sc->unspecified);
+  o1 = o->v[5].o1;
+  return(o1->v[0].fp(o1));
+}
+
+static s7_pointer opt_unless_p(opt_info *o)
+{
+  opt_info *o1;
+  s7_int i, len;
+  if (o->v[4].fb(o->v[3].o1))
+    return(o->sc->unspecified);
+  len = o->v[1].i - 1;
+  for (i = 0; i < len; i++)
+    {
+      o1 = o->v[i + 5].o1;
+      o1->v[0].fp(o1);
+    }
+  o1 = o->v[i + 5].o1;
+  return(o1->v[0].fp(o1));
+}
+
+static s7_pointer opt_unless_p_1(opt_info *o)
+{
+  opt_info *o1;
+  if (o->v[4].fb(o->v[3].o1))
+    return(o->sc->unspecified);
+  o1 = o->v[5].o1;
+  return(o1->v[0].fp(o1));
+}
+
+static bool opt_cell_when(s7_scheme *sc, s7_pointer car_x, int32_t len)
+{
+  s7_pointer p;
+  int32_t k;
+  opt_info *opc;
+  if (len > (NUM_VUNIONS - 6))
+    return_false(sc, car_x);
+  opc = alloc_opt_info(sc);
+  opc->v[3].o1 = sc->opts[sc->pc];
+  if (!bool_optimize(sc, cdr(car_x)))
+    return_false(sc, car_x);
+  for (k = 5, p = cddr(car_x); is_pair(p); k++, p = cdr(p))
+    {
+      opt_info *start = sc->opts[sc->pc];
+      if (!cell_optimize(sc, p))
+	return_false(sc, car_x);
+      if (is_pair(cdr(p)))
+	oo_idp_nr_fixup(start);
+      opc->v[k].o1 = start;
+    }
+  opc->v[4].fb = opc->v[3].o1->v[0].fb;
+  opc->v[1].i = len - 2;
+  if (car(car_x) == sc->when_symbol)
+    {
+      if (len == 3)
+	opc->v[0].fp = opt_when_p_1;
+      else
+	if (len == 4)
+	  {
+	    opc->v[0].fp = opt_when_p_2;
+	    opc->v[7].o1 = opc->v[6].o1;
+	    opc->v[8].fp = opc->v[7].o1->v[0].fp;
+	    opc->v[6].fp = opc->v[5].o1->v[0].fp;
+	  }
+	else opc->v[0].fp = opt_when_p;
+    }
+  else opc->v[0].fp = (len == 3) ? opt_unless_p_1 : opt_unless_p;
+  return_true(sc, car_x);
+}
+
+/* -------- cell_cond -------- */
+
+#define COND_O1 3
+#define COND_CLAUSE_O1 5
+
+static s7_pointer cond_value(opt_info *o)
+{
+  opt_info *o1;
+  s7_int i, len = o->v[1].i - 1;
+  for (i = 0; i < len; i++)
+    {
+      o1 = o->v[i + COND_CLAUSE_O1].o1;
+      o1->v[0].fp(o1);
+    }
+  o1 = o->v[i + COND_CLAUSE_O1].o1;
+  return(o1->v[0].fp(o1));
+}
+
+static s7_pointer opt_cond(opt_info *top)
+{
+  s7_int len = top->v[2].i;
+  for (s7_int clause = 0; clause < len; clause++)
+    {
+      opt_info *o1 = top->v[clause + COND_O1].o1;
+      opt_info *o2 = o1->v[4].o1;
+      if (o2->v[0].fb(o2))
+	{
+	  s7_pointer res = cond_value(o1);
+	  return(res);
+	}}
+  return(top->sc->unspecified);
+}
+
+static s7_pointer opt_cond_1(opt_info *o) {return((o->v[5].fb(o->v[4].o1)) ? cond_value(o->v[6].o1) : o->sc->unspecified);} /* cond as when */
+static s7_pointer opt_cond_1b(opt_info *o) {return((o->v[4].o1->v[O_WRAP].fp(o->v[4].o1) != o->sc->F) ? cond_value(o->v[6].o1) : o->sc->unspecified);}
+
+static s7_pointer opt_cond_2(opt_info *o)  /* 2 branches, results 1 expr, else */
+{
+  opt_info *o1 = (o->v[5].fb(o->v[4].o1)) ? o->v[6].o1 : o->v[7].o1;
+  s7_pointer res = o1->v[0].fp(o1);
+  return(res);
+}
+
+static bool opt_cell_cond(s7_scheme *sc, s7_pointer car_x)
+{
+  /* top->v[1].i is end index, clause->v[3].i is end of current clause, clause->v[1].i = clause result len */
+  s7_pointer last_clause = NULL;
+  int32_t branches = 0, max_blen = 0;
+  opt_info *top = alloc_opt_info(sc);
+  int32_t start_pc = sc->pc;
+  for (s7_pointer p = cdr(car_x); is_pair(p); p = cdr(p), branches++)
+    {
+      opt_info *opc;
+      s7_pointer clause = car(p), cp;
+      int32_t blen;
+      if ((branches >= (NUM_VUNIONS - COND_O1)) ||
+	  (!is_pair(clause)) ||
+	  (!is_pair(cdr(clause))) || /* leave the test->result case for later */
+	  (cadr(clause) == sc->feed_to_symbol))
+	return_false(sc, clause);
+
+      last_clause = clause;
+      top->v[branches + COND_O1].o1 = sc->opts[sc->pc];
+      opc = alloc_opt_info(sc);
+      opc->v[4].o1 = sc->opts[sc->pc];
+      if (!bool_optimize(sc, clause))
+	return_false(sc, clause);
+
+      for (blen = 0, cp = cdr(clause); is_pair(cp); blen++, cp = cdr(cp))
+	{
+	  if (blen >= NUM_VUNIONS - COND_CLAUSE_O1)
+	    return_false(sc, cp);
+	  opc->v[blen + COND_CLAUSE_O1].o1 = sc->opts[sc->pc];
+	  if (!cell_optimize(sc, cp))
+	    return_false(sc, cp);
+	}
+      if (!is_null(cp))
+	return_false(sc, cp);
+      opc->v[1].i = blen;
+      if (max_blen < blen) max_blen = blen;
+      opc->v[0].fp = opt_cond; /* a placeholder */
+    }
+  if (branches == 1)
+    {
+      opt_info *o1 = sc->opts[start_pc + 1];
+      top->v[0].fp = (o1->v[0].fb == p_to_b) ? opt_cond_1b : opt_cond_1;
+      top->v[4].o1 = o1;
+      top->v[5].fb = o1->v[0].fb;
+      top->v[6].o1 = sc->opts[start_pc];
+      return_true(sc, car_x);
+    }
+  if (branches == 2)
+    {
+      if ((max_blen == 1) &&
+	  ((car(last_clause) == sc->else_symbol) || (car(last_clause) == sc->T)))
+	{
+	  opt_info *o1;
+	  top->v[6].o1 = top->v[COND_O1].o1->v[COND_CLAUSE_O1].o1;
+	  top->v[7].o1 = top->v[COND_O1 + 1].o1->v[COND_CLAUSE_O1].o1;
+
+	  o1 = sc->opts[start_pc + 1];
+	  top->v[4].o1 = o1;
+	  top->v[5].fb = o1->v[0].fb;
+	  top->v[0].fp = opt_cond_2;
+	  return_true(sc, car_x);
+	}}
+  top->v[2].i = branches;
+  top->v[0].fp = opt_cond;
+  return_true(sc, car_x);
+}
+
+/* -------- cell_and|or -------- */
+static s7_pointer opt_and_pp(opt_info *o) {return((o->v[11].fp(o->v[10].o1) == o->sc->F) ? o->sc->F : o->v[9].fp(o->v[8].o1));}
+
+static s7_pointer opt_and_any_p(opt_info *o)
+{
+  s7_pointer val = o->sc->T; /* (and) -> #t */
+  for (s7_int i = 0; i < o->v[1].i; i++)
+    {
+      opt_info *o1 = o->v[i + 3].o1;
+      val = o1->v[0].fp(o1);
+      if (val == o->sc->F)
+	return(o->sc->F);
+    }
+  return(val);
+}
+
+static s7_pointer opt_or_pp(opt_info *o)
+{
+  s7_pointer val = o->v[11].fp(o->v[10].o1);
+  return((val != o->sc->F) ? val : o->v[9].fp(o->v[8].o1));
+}
+
+static s7_pointer opt_or_any_p(opt_info *o)
+{
+  for (s7_int i = 0; i < o->v[1].i; i++)
+    {
+      opt_info *o1 = o->v[i + 3].o1;
+      s7_pointer val = o1->v[0].fp(o1);
+      if (val != o->sc->F)
+	return(val);
+    }
+  return(o->sc->F);
+}
+
+static bool opt_cell_and(s7_scheme *sc, s7_pointer car_x, int32_t len)
+{
+  opt_info *opc = alloc_opt_info(sc);
+  if (len == 3)
+    {
+      opc->v[0].fp = ((car(car_x) == sc->or_symbol) ? opt_or_pp : opt_and_pp);
+      opc->v[10].o1 = sc->opts[sc->pc];
+      if (!cell_optimize(sc, cdr(car_x)))
+	return_false(sc, car_x);
+      opc->v[11].fp = opc->v[10].o1->v[0].fp;
+      opc->v[8].o1 = sc->opts[sc->pc];
+      if (!cell_optimize(sc, cddr(car_x)))
+	return_false(sc, car_x);
+      opc->v[9].fp = opc->v[8].o1->v[0].fp;
+      return_true(sc, car_x);
+    }
+  if ((len > 1) && (len < (NUM_VUNIONS - 4)))
+    {
+      s7_pointer p = cdr(car_x);
+      opc->v[1].i = (len - 1);
+      opc->v[0].fp = ((car(car_x) == sc->or_symbol) ? opt_or_any_p : opt_and_any_p);
+      for (int32_t i = 3; is_pair(p); i++, p = cdr(p))
+	{
+	  opc->v[i].o1 = sc->opts[sc->pc];
+	  if (!cell_optimize(sc, p))
+	    return_false(sc, car_x);
+	}
+      return_true(sc, car_x);
+    }
+  return_false(sc, car_x);
+}
+
+/* -------- cell_if -------- */
+static s7_pointer opt_if_bp(opt_info *o) {return((o->v[3].fb(o->v[2].o1)) ? o->v[5].fp(o->v[4].o1) : o->sc->unspecified);}
+static s7_pointer opt_if_b7p(opt_info *o) {return((opt_b_7p_f(o->v[2].o1)) ? o->v[5].fp(o->v[4].o1) : o->sc->unspecified);} /* expanded not faster */
+static s7_pointer opt_if_nbp(opt_info *o) {return((o->v[5].fb(o->v[4].o1)) ? o->sc->unspecified : o->v[11].fp(o->v[10].o1));}
+static s7_pointer opt_if_bp_and(opt_info *o) {return((opt_and_bb(o->v[2].o1)) ? o->v[5].fp(o->v[4].o1) : o->sc->unspecified);}
+
+static s7_pointer opt_if_bp_pb(opt_info *o) /* p_to_b at outer, p_to_b expanded and moved to o[3] */
+{
+  return((o->v[3].fp(o->v[2].o1) != o->sc->F) ? o->v[5].fp(o->v[4].o1) : o->sc->unspecified);
+}
+
+static s7_pointer opt_if_bp_ii_fc(opt_info *o)
+{
+  return((o->v[3].b_ii_f(o->v[11].fi(o->v[10].o1), o->v[2].i)) ? o->v[5].fp(o->v[4].o1) : o->sc->unspecified);
+}
+
+static s7_pointer opt_if_nbp_s(opt_info *o)
+{
+  return((o->v[2].b_p_f(slot_value(o->v[3].p))) ? o->sc->unspecified : o->v[11].fp(o->v[10].o1));
+}
+
+static s7_pointer opt_if_nbp_sc(opt_info *o)    /* b_pp_sc */
+{
+  return((o->v[3].b_pp_f(slot_value(o->v[2].p), o->v[4].p)) ? o->sc->unspecified : o->v[11].fp(o->v[10].o1));
+}
+
+static s7_pointer opt_if_nbp_7sc(opt_info *o)   /* b_7pp_sc */
+{
+  return((o->v[3].b_7pp_f(o->sc, slot_value(o->v[2].p), o->v[4].p)) ? o->sc->unspecified : o->v[11].fp(o->v[10].o1));
+}
+
+static s7_pointer opt_if_nbp_ss(opt_info *o)    /* b_ii_ss */
+{
+  return((o->v[3].b_ii_f(integer(slot_value(o->v[2].p)), integer(slot_value(o->v[4].p)))) ? o->sc->unspecified : o->v[11].fp(o->v[10].o1));
+}
+
+static s7_pointer opt_if_num_eq_ii_ss(opt_info *o)  /* b_ii_ss */
+{
+  return((integer(slot_value(o->v[2].p)) == integer(slot_value(o->v[4].p))) ? o->sc->unspecified : o->v[11].fp(o->v[10].o1));
+}
+
+static s7_pointer opt_if_nbp_fs(opt_info *o)    /* b_pi_fs */
+{
+  return((o->v[2].b_pi_f(o->sc, o->v[5].fp(o->v[4].o1), integer(slot_value(o->v[3].p)))) ? o->sc->unspecified : o->v[11].fp(o->v[10].o1));
+}
+
+static s7_pointer opt_if_nbp_sf(opt_info *o)    /* b_pp_sf */
+{
+  return((o->v[2].b_pp_f(slot_value(o->v[3].p), o->v[5].fp(o->v[4].o1))) ? o->sc->unspecified : o->v[11].fp(o->v[10].o1));
+}
+
+static s7_pointer opt_if_nbp_7sf(opt_info *o)   /* b_7pp_sf */
+{
+  return((o->v[2].b_7pp_f(o->sc, slot_value(o->v[3].p), o->v[5].fp(o->v[4].o1))) ? o->sc->unspecified : o->v[11].fp(o->v[10].o1));
+}
+
+static s7_pointer opt_if_bpp(opt_info *o) {return((o->v[5].fb(o->v[4].o1)) ? o->v[9].fp(o->v[8].o1) : o->v[11].fp(o->v[10].o1));}
+static s7_pointer opt_if_bpp_bit(opt_info *o) {return((opt_b_7ii_sc_bit(o->v[4].o1)) ? o->v[9].fp(o->v[8].o1) : o->v[11].fp(o->v[10].o1));}
+
+static bool opt_cell_if(s7_scheme *sc, s7_pointer car_x, int32_t len)
+{
+  opt_info *opc = alloc_opt_info(sc);
+  opt_info *bop = sc->opts[sc->pc];
+  if (len == 3)
+    {
+      if ((is_proper_list_2(sc, cadr(car_x))) && /* (not arg) */
+	  (caadr(car_x) == sc->not_symbol))
+	{
+	  if (bool_optimize(sc, cdadr(car_x)))
+	    {
+	      opt_info *top = sc->opts[sc->pc];
+	      if (cell_optimize(sc, cddr(car_x)))
+		{
+		  opc->v[10].o1 = top;
+		  opc->v[11].fp = top->v[0].fp;
+		  if (bop->v[0].fb == opt_b_p_s)
+		    {
+		      opc->v[2].b_p_f = bop->v[2].b_p_f;
+		      opc->v[3].p = bop->v[1].p;
+		      opc->v[0].fp = opt_if_nbp_s;
+		      return_true(sc, car_x);
+		    }
+		  if ((bop->v[0].fb == opt_b_pi_fs) || (bop->v[0].fb == opt_b_pi_fs_num_eq))
+		    {
+		      opc->v[2].b_pi_f = bop->v[2].b_pi_f;
+		      opc->v[3].p = bop->v[1].p;
+		      opc->v[4].o1 = bop->v[10].o1;
+		      opc->v[5].fp = bop->v[11].fp;
+		      opc->v[0].fp = opt_if_nbp_fs;
+		      return_true(sc, car_x);
+		    }
+		  if ((bop->v[0].fb == opt_b_pp_sf) ||
+		      (bop->v[0].fb == opt_b_7pp_sf))
+		    {
+		      opc->v[4].o1 = bop->v[10].o1;
+		      opc->v[5].fp = bop->v[11].fp;
+		      if (bop->v[0].fb == opt_b_pp_sf)
+			{
+			  opc->v[2].b_pp_f = bop->v[3].b_pp_f;
+			  opc->v[0].fp = opt_if_nbp_sf;
+			}
+		      else
+			{
+			  opc->v[2].b_7pp_f = bop->v[3].b_7pp_f;
+			  opc->v[0].fp = opt_if_nbp_7sf;
+			}
+		      opc->v[3].p = bop->v[1].p;
+		      return_true(sc, car_x);
+		    }
+		  if ((bop->v[0].fb == opt_b_pp_sc) ||
+		      (bop->v[0].fb == opt_b_7pp_sc))
+		    {
+		      if (bop->v[0].fb == opt_b_pp_sc)
+			{
+			  opc->v[3].b_pp_f = bop->v[3].b_pp_f;
+			  opc->v[0].fp = opt_if_nbp_sc;
+			}
+		      else
+			{
+			  opc->v[3].b_7pp_f = bop->v[3].b_7pp_f;
+			  opc->v[0].fp = opt_if_nbp_7sc;
+			}
+		      opc->v[2].p = bop->v[1].p;
+		      opc->v[4].p = bop->v[2].p;
+		      return_true(sc, car_x);
+		    }
+		  if ((bop->v[0].fb == opt_b_ii_ss) || (bop->v[0].fb == opt_b_ii_ss_eq) ||
+		      (bop->v[0].fb == opt_b_ii_ss_lt) || (bop->v[0].fb == opt_b_ii_ss_gt) ||
+		      (bop->v[0].fb == opt_b_ii_ss_leq) || (bop->v[0].fb == opt_b_ii_ss_geq))
+		    {
+		      opc->v[3].b_ii_f = bop->v[3].b_ii_f;
+		      opc->v[2].p = bop->v[1].p;
+		      opc->v[4].p = bop->v[2].p;
+		      opc->v[0].fp = (opc->v[3].b_ii_f == num_eq_b_ii) ? opt_if_num_eq_ii_ss : opt_if_nbp_ss;
+		      return_true(sc, car_x);
+		    }
+		  opc->v[4].o1 = bop;
+		  opc->v[5].fb = bop->v[0].fb;
+		  opc->v[0].fp = opt_if_nbp;
+		  return_true(sc, car_x);
+		}}}
+      else
+	if (bool_optimize(sc, cdr(car_x)))
+	  {
+	    opt_info *top = sc->opts[sc->pc];
+	    if (cell_optimize(sc, cddr(car_x)))
+	      {
+		opc->v[2].o1 = bop;
+		opc->v[4].o1 = top;
+		opc->v[5].fp = top->v[0].fp;
+		if (bop->v[0].fb == p_to_b)
+		  {
+		    opc->v[0].fp = opt_if_bp_pb;
+		    opc->v[3].fp = bop->v[O_WRAP].fp;
+		    return_true(sc, car_x);
+		  }
+		if (bop->v[0].fb == opt_b_ii_fc)
+		  {
+		    opc->v[2].i = bop->v[2].i;
+		    opc->v[3].b_ii_f = bop->v[3].b_ii_f;
+		    opc->v[11].fi = bop->v[11].fi;
+		    opc->v[10].o1 = bop->v[10].o1;
+		    opc->v[0].fp = opt_if_bp_ii_fc;
+		    return_true(sc, car_x);
+		  }
+		opc->v[0].fp = (bop->v[0].fb == opt_b_7p_f) ? opt_if_b7p : ((bop->v[0].fb == opt_and_bb) ? opt_if_bp_and : opt_if_bp);
+		opc->v[3].fb = bop->v[0].fb;
+		return_true(sc, car_x);
+	      }}
+      return_false(sc, car_x);
+    }
+  if (len == 4)
+    {
+      if (bool_optimize(sc, cdr(car_x)))
+	{
+	  opt_info *top = sc->opts[sc->pc];
+	  if (cell_optimize(sc, cddr(car_x)))
+	    {
+	      opt_info *o3 = sc->opts[sc->pc];
+	      opc->v[0].fp = (bop->v[0].fb == opt_b_7ii_sc_bit) ? opt_if_bpp_bit : opt_if_bpp;
+	      if (cell_optimize(sc, cdddr(car_x)))
+		{
+		  opc->v[4].o1 = bop;
+		  opc->v[5].fb = bop->v[0].fb;
+		  opc->v[8].o1 = top;
+		  opc->v[9].fp = top->v[0].fp;
+		  opc->v[10].o1 = o3;
+		  opc->v[11].fp = o3->v[0].fp;
+		  return_true(sc, car_x);
+		}}}}
+  return_false(sc, car_x);
+}
+
+/* -------- cell_case -------- */
+#define CASE_O1 3
+#define CASE_SEL 2
+#define CASE_CLAUSE_O1 4
+#define CASE_CLAUSE_KEYS 2
+
+static s7_pointer case_value(opt_info *o)
+{
+  opt_info *o1;
+  int32_t i, len = o->v[1].i - 1; /* int32_t here and below seems to be faster than s7_int (tleft.scm) */
+  for (i = 0; i < len; i++)
+    {
+      o1 = o->v[i + CASE_CLAUSE_O1].o1;
+      o1->v[0].fp(o1);
+    }
+  o1 = o->v[i + CASE_CLAUSE_O1].o1;
+  return(o1->v[0].fp(o1));
+}
+
+static s7_pointer opt_case(opt_info *o)
+{
+  opt_info *o1 = o->v[CASE_SEL].o1;
+  int32_t lim = o->v[1].i;
+  s7_scheme *sc = o->sc;
+  s7_pointer selector = o1->v[0].fp(o1);
+
+  if (is_simple(selector))
+    {
+      for (int32_t ctr = CASE_O1; ctr < lim; ctr++)
+	{
+	  s7_pointer z;
+	  o1 = o->v[ctr].o1;
+	  for (z = o1->v[CASE_CLAUSE_KEYS].p; is_pair(z); z = cdr(z))
+	    if (selector == car(z))
+	      return(case_value(o1));
+	  if (z == sc->else_symbol)
+	    return(case_value(o1));
+	}}
+  else
+    for (int32_t ctr = CASE_O1; ctr < lim; ctr++)
+      {
+	s7_pointer z;
+	o1 = o->v[ctr].o1;
+	for (z = o1->v[CASE_CLAUSE_KEYS].p; is_pair(z); z = cdr(z))
+	  if (s7_is_eqv(sc, selector, car(z)))
+	    return(case_value(o1));
+	if (z == sc->else_symbol)
+	  return(case_value(o1));
+      }
+  return(sc->unspecified);
+}
+
+static bool opt_cell_case(s7_scheme *sc, s7_pointer car_x)
+{
+  /* top->v[1].i is end index, clause->v[3].i is end of current clause, clause->v[1].i = clause result len */
+  s7_pointer p;
+  int32_t ctr;
+  opt_info *top = alloc_opt_info(sc);
+  top->v[CASE_SEL].o1 = sc->opts[sc->pc];
+  if (!cell_optimize(sc, cdr(car_x))) /* selector */
+    return_false(sc, car_x);
+  for (ctr = CASE_O1, p = cddr(car_x); (is_pair(p)) && (ctr < NUM_VUNIONS); ctr++, p = cdr(p))
+    {
+      opt_info *opc;
+      s7_pointer clause = car(p), cp;
+      int32_t blen;
+      if ((!is_pair(clause)) ||
+	  ((!is_pair(car(clause))) && (car(clause) != sc->else_symbol)) ||
+	  (!is_pair(cdr(clause))) ||
+	  (cadr(clause) == sc->feed_to_symbol))
+	return_false(sc, clause);
+
+      opc = alloc_opt_info(sc);
+      top->v[ctr].o1 = opc;
+      if (car(clause) == sc->else_symbol)
+	{
+	  if (!is_null(cdr(p)))
+	    return_false(sc, clause);
+	  opc->v[CASE_CLAUSE_KEYS].p = sc->else_symbol;
+	}
+      else
+	{
+	  if (!s7_is_proper_list(sc, car(clause)))
+	    return_false(sc, clause);
+	  opc->v[CASE_CLAUSE_KEYS].p = car(clause);
+	}
+
+      for (blen = 0, cp = cdr(clause); (is_pair(cp)) && (blen < (NUM_VUNIONS - CASE_CLAUSE_O1)); blen++, cp = cdr(cp))
+	{
+	  opc->v[blen + CASE_CLAUSE_O1].o1 = sc->opts[sc->pc];
+	  if (!cell_optimize(sc, cp))
+	    return_false(sc, cp);
+	}
+      if (!is_null(cp))
+	return_false(sc, cp);
+      opc->v[1].i = blen;
+      opc->v[0].fp = opt_case; /* just a placeholder I hope */
+    }
+  if (!is_null(p))
+    return_false(sc, p);
+  top->v[1].i = ctr;
+  top->v[0].fp = opt_case;
+  return_true(sc, car_x);
+}
+
+/* -------- cell_let_temporarily -------- */
+
+#define LET_TEMP_O1 5
+
+static s7_pointer opt_let_temporarily(opt_info *o)
+{
+  opt_info *o1 = o->v[4].o1;
+  s7_int i, len;
+  s7_pointer result;
+  s7_scheme *sc = o->sc;
+
+  if (is_immutable_slot(o->v[1].p))
+    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->let_temporarily_symbol, slot_symbol(o->v[1].p)));
+
+  o->v[3].p = slot_value(o->v[1].p);         /* save and protect old value */
+  gc_protect_via_stack(sc, o->v[3].p);
+  slot_set_value(o->v[1].p, o1->v[0].fp(o1)); /* set new value */
+  len = o->v[2].i - 1;
+  for (i = 0; i < len; i++)
+    {
+      o1 = o->v[i + LET_TEMP_O1].o1;
+      o1->v[0].fp(o1);
+    }
+  o1 = o->v[i + LET_TEMP_O1].o1;
+  result = o1->v[0].fp(o1);
+  slot_set_value(o->v[1].p, o->v[3].p);      /* restore old */
+  unstack_gc_protect(sc);
+  return(result);
+}
+
+static bool opt_cell_let_temporarily(s7_scheme *sc, s7_pointer car_x, int32_t len)
+{
+  s7_pointer vars;
+  if (len <= 2)
+    return_false(sc, car_x);
+
+  vars = cadr(car_x);
+  if ((len < (NUM_VUNIONS - LET_TEMP_O1)) &&
+      (is_proper_list_1(sc, vars)) &&       /* just one var for now */
+      (is_proper_list_2(sc, car(vars))) &&  /*   and var is (sym val) */
+      (is_symbol(caar(vars))) &&
+      (!is_immutable_symbol(caar(vars))) &&
+      (!is_syntactic_symbol(caar(vars))))
+    {
+      int32_t i;
+      s7_pointer p;
+      opt_info *opc = alloc_opt_info(sc);
+      opc->v[1].p = s7_slot(sc, caaadr(car_x));
+      if (!is_slot(opc->v[1].p))
+	return_false(sc, car_x);
+
+      opc->v[4].o1 = sc->opts[sc->pc];
+      if (!cell_optimize(sc, cdaadr(car_x)))
+	return_false(sc, car_x);
+
+      for (i = LET_TEMP_O1, p = cddr(car_x); is_pair(p); i++, p = cdr(p))
+	{
+	  opc->v[i].o1 = sc->opts[sc->pc];
+	  if (!cell_optimize(sc, p))
+	    return_false(sc, car_x);
+	}
+      opc->v[2].i = len - 2;
+      opc->v[0].fp = opt_let_temporarily;
+      return_true(sc, car_x);
+    }
+  return_false(sc, car_x);
+}
+
+/* -------- cell_do -------- */
+
+#define do_curlet(o)        T_Let(o->v[2].p)
+#define do_curlet_unchecked(o) o->v[2].p
+#define do_body_length(o)   o->v[3].i
+#define do_result_length(o) o->v[4].i
+#define do_any_inits(o)     o->v[7].o1
+#define do_any_body(o)      o->v[10].o1
+#define do_any_results(o)   o->v[11].o1
+#define do_any_test(o)      o->v[12].o1
+#define do_any_steps(o)     o->v[13].o1
+
+static void let_set_has_pending_value(s7_pointer lt)
+{
+  for (s7_pointer vp = let_slots(lt); tis_slot(vp); vp = next_slot(vp))
+    slot_set_pending_value(vp, eof_object); /* gc needs a legit value here */
+}
+
+static void let_clear_has_pending_value(s7_scheme *sc, s7_pointer lt)
+{
+  for (s7_pointer vp = let_slots(lt); tis_slot(vp); vp = next_slot(vp))
+    slot_clear_has_pending_value(vp);
+}
+
+typedef s7_pointer (*opt_info_fp)(opt_info *o);
+
+static s7_pointer opt_do_any(opt_info *o)
+{
+  opt_info *o1;
+  opt_info *ostart = do_any_test(o);
+  opt_info *body = do_any_body(o);
+  opt_info *inits = do_any_inits(o);
+  opt_info *steps = do_any_steps(o);
+  opt_info *results = do_any_results(o);
+  int32_t i, k, len = do_body_length(o);   /* len=6 tlist, 6|7 tbig, 0 tvect */
+  s7_pointer vp, result;
+  s7_scheme *sc = o->sc;
+  opt_info *os[NUM_VUNIONS];
+  opt_info_fp fp[NUM_VUNIONS];
+  s7_pointer old_e = sc->curlet;
+  gc_protect_via_stack(sc, old_e);
+  set_curlet(sc, do_curlet(o));
+  /* init */
+  for (k = 0, vp = let_slots(sc->curlet); tis_slot(vp); k++, vp = next_slot(vp))
+    {
+      o1 = inits->v[k].o1;
+      slot_set_value(vp, o1->v[0].fp(o1));
+    }
+  let_set_has_pending_value(sc->curlet);
+  for (i = 0; i < len; i++)
+    {
+      os[i] = body->v[i].o1;
+      fp[i] = os[i]->v[0].fp;
+    }
+  while (true)
+    {
+      /* end */
+      if (ostart->v[0].fb(ostart))
+	break;
+      /* body */
+      if (len == 6) /* here and in opt_do_n we need a better way to unroll these loops */
+	{fp[0](os[0]); fp[1](os[1]); fp[2](os[2]); fp[3](os[3]); fp[4](os[4]); fp[5](os[5]);}
+      else
+	if (len == 7)
+	  {fp[0](os[0]); fp[1](os[1]); fp[2](os[2]); fp[3](os[3]); fp[4](os[4]); fp[5](os[5]); fp[6](os[6]);}
+	else for (i = 0; i < len; i++) fp[i](os[i]);
+      /* step (let not let*) */
+      for (k = 0, vp = let_slots(sc->curlet); tis_slot(vp); k++, vp = next_slot(vp))
+	if (has_stepper(vp))
+	  {
+	    o1 = steps->v[k].o1;
+	    slot_simply_set_pending_value(vp, o1->v[0].fp(o1));
+	  }
+      for (vp = let_slots(sc->curlet); tis_slot(vp); vp = next_slot(vp))
+	if (has_stepper(vp))
+	  slot_set_value(vp, slot_pending_value(vp));
+    }
+  /* result */
+  result = sc->T;
+  for (i = 0; i < do_result_length(o); i++)
+    {
+      o1 = results->v[i].o1;
+      result = o1->v[0].fp(o1);
+    }
+  let_clear_has_pending_value(sc, sc->curlet);
+  unstack_gc_protect(sc);
+  set_curlet(sc, old_e);
+  return(result);
+}
+
+static s7_pointer opt_do_step_1(opt_info *o)
+{
+  /* 1 stepper (multi inits perhaps), 1 body, 1 rtn */
+  opt_info *o1;
+  opt_info *ostart = do_any_test(o);
+  opt_info *ostep = o->v[9].o1;
+  opt_info *inits = do_any_inits(o);
+  opt_info *body = do_any_body(o);
+  int32_t k;
+  s7_pointer vp, result, stepper = NULL;
+  s7_scheme *sc = o->sc;
+  s7_pointer old_e = sc->curlet;
+  gc_protect_via_stack(sc, old_e);
+  set_curlet(sc, do_curlet(o));
+  for (k = 0, vp = let_slots(sc->curlet); tis_slot(vp); k++, vp = next_slot(vp))
+    {
+      o1 = inits->v[k].o1;
+      slot_set_value(vp, o1->v[0].fp(o1));
+      if (has_stepper(vp)) stepper = vp;
+    }
+  while (!(ostart->v[0].fb(ostart)))
+    {
+      body->v[0].fp(body);
+      slot_set_value(stepper, ostep->v[0].fp(ostep));
+    }
+  o1 = do_any_results(o);
+  result = o1->v[0].fp(o1);
+  unstack_gc_protect(sc);
+  set_curlet(sc, old_e);
+  return(result);
+}
+
+static s7_pointer opt_do_step_i(opt_info *o)
+{
+  /* 1 stepper (multi inits perhaps), 1 body expr, 1 rtn expr */
+  /*   (do ((sum 0.0) (k 0 (+ k 1))) ((= k size) (set! (C i j) sum)) (set! sum (+ sum (* (A i k) (B k j))))) */
+  opt_info *o1;
+  opt_info *ostart = do_any_test(o);
+  opt_info *ostep = o->v[9].o1;
+  opt_info *inits = do_any_inits(o);
+  opt_info *body = do_any_body(o);
+  s7_pointer (*fp)(opt_info *o) = body->v[0].fp;
+  int32_t k;
+  s7_pointer vp, result, stepper = NULL, si;
+  s7_scheme *sc = o->sc;
+  s7_int end, incr;
+  s7_pointer old_e = sc->curlet;
+  gc_protect_via_stack(sc, old_e);
+  set_curlet(sc, do_curlet(o));
+  for (k = 0, vp = let_slots(sc->curlet); tis_slot(vp); k++, vp = next_slot(vp))
+    {
+      o1 = inits->v[k].o1;
+      slot_set_value(vp, o1->v[0].fp(o1));
+      if (has_stepper(vp)) stepper = vp;
+    }
+  end = integer(slot_value(ostart->v[2].p));
+  incr = ostep->v[2].i;
+  si = make_mutable_integer(sc, integer(slot_value(ostart->v[1].p)));
+  if (stepper) slot_set_value(stepper, si);
+  if (fp == opt_set_p_d_f_sf_add) /* ok since used only if body has one expr */
+    {
+      fp = opt_set_p_d_fm_sf_add;
+      slot_set_value(body->v[1].p, make_mutable_real(sc, real(slot_value(body->v[1].p))));
+    }
+  while (integer(si) != end)
+    {
+      fp(body);
+      integer(si) += incr;
+    }
+  clear_mutable_integer(si);
+  if (fp == opt_set_p_d_fm_sf_add)
+    clear_mutable_number(slot_value(body->v[1].p));
+  o1 = do_any_results(o);
+  result = o1->v[0].fp(o1);
+  unstack_gc_protect(sc);
+  set_curlet(sc, old_e);
+  return(result);
+}
+
+#define do_no_vars_test(o) o->v[6].o1
+#define do_no_vars_body(o) o->v[7].o1
+
+static s7_pointer opt_do_no_vars(opt_info *o)
+{
+  /* no vars, no return, o->v[2].p=let, o->v[3].i=body length, o->v[4].i=return length=0, o->v[6]=end test */
+  opt_info *ostart = do_no_vars_test(o);
+  int32_t len = do_body_length(o);
+  s7_scheme *sc = o->sc;
+  bool (*fb)(opt_info *o) = ostart->v[0].fb;
+  s7_pointer old_e = sc->curlet;
+  gc_protect_via_stack(sc, old_e);
+  set_curlet(sc, do_curlet(o));
+  if (len == 0)       /* titer */
+    while (!(fb(ostart)));
+  else
+    {
+      opt_info *body = do_no_vars_body(o);
+      while (!(fb(ostart)))   /* tshoot, tfft */
+	for (int32_t i = 0; i < len; i++)
+	  {
+	    opt_info *o1 = body->v[i].o1;
+	    o1->v[0].fp(o1);
+	  }}
+  unstack_gc_protect(sc);
+  set_curlet(sc, old_e);
+  return(sc->T);
+}
+
+#define do_stepper_init(o) o->v[11].o1
+
+static s7_pointer opt_do_1(opt_info *o)
+{
+  /* 1 var, 1 expr, no return */
+  opt_info *o1 = do_stepper_init(o);
+  opt_info *ostart = do_any_test(o);
+  opt_info *ostep = o->v[9].o1;
+  opt_info *body = do_any_body(o);
+  s7_pointer vp = let_slots(do_curlet(o));
+  s7_scheme *sc = o->sc;
+  s7_pointer old_e = sc->curlet;
+  gc_protect_via_stack(sc, old_e);
+  set_curlet(sc, do_curlet(o));
+  slot_set_value(vp, o1->v[0].fp(o1));
+  if ((o->v[8].i == 1) &&
+      (is_t_integer(slot_value(vp))))
+    {
+      if ((ostep->v[0].fp == opt_p_ii_ss_add) || /* tmap */
+	  (ostep->v[0].fp == i_to_p))
+	{
+	  s7_pointer step_val = make_mutable_integer(sc, integer(slot_value(vp)));
+	  slot_set_value(vp, step_val);
+	  if (ostep->v[0].fp == opt_p_ii_ss_add)
+	    while (!ostart->v[0].fb(ostart))
+	      {
+		body->v[0].fp(body);
+		set_integer(step_val, opt_i_ii_ss_add(ostep));
+	      }
+	  else
+	    while (!ostart->v[0].fb(ostart))
+	      {
+		body->v[0].fp(body);
+		set_integer(step_val, ostep->v[O_WRAP].fi(ostep));
+	      }
+	  unstack_gc_protect(sc);
+	  set_curlet(sc, old_e);
+	  return(sc->T);
+	}
+      o->v[8].i = 2;
+    }
+  while (!(ostart->v[0].fb(ostart)))   /* s7test tref */
+    {
+      body->v[0].fp(body);
+      slot_set_value(vp, ostep->v[0].fp(ostep));
+    }
+  unstack_gc_protect(sc);
+  set_curlet(sc, old_e);
+  return(sc->T);
+}
+
+#define do_n_body(o) o->v[7].o1
+
+static s7_pointer opt_do_n(opt_info *o)
+{
+  /* 1 var, no return */
+  opt_info *o1 = do_stepper_init(o);
+  opt_info *ostart = do_any_test(o);
+  opt_info *ostep = o->v[9].o1;
+  opt_info *body = do_n_body(o);
+  int32_t len = do_body_length(o);
+  s7_pointer vp = let_slots(do_curlet(o));
+  s7_scheme *sc = o->sc;
+  s7_pointer old_e = sc->curlet;
+  gc_protect_via_stack(sc, old_e);
+  set_curlet(sc, do_curlet(o));
+  slot_set_value(vp, o1->v[0].fp(o1));
+  if (len == 2) /* tmac tshoot */
+    {
+      opt_info *e1 = body->v[0].o1, *e2 = body->v[1].o1;
+      while (!(ostart->v[0].fb(ostart)))
+	{
+	  e1->v[0].fp(e1);
+	  e2->v[0].fp(e2);
+	  slot_set_value(vp, ostep->v[0].fp(ostep));
+	}}
+  else
+    {
+      opt_info *os[NUM_VUNIONS];
+      opt_info_fp fp[NUM_VUNIONS];
+      for (int32_t i = 0; i < len; i++)
+	{
+	  os[i] = body->v[i].o1;
+	  fp[i] = os[i]->v[0].fp;
+	}
+      if (len == 7)
+	while (!ostart->v[0].fb(ostart)) /* tfft teq */ /* this is probably fft code */
+	  {
+	    fp[0](os[0]); fp[1](os[1]); fp[2](os[2]); fp[3](os[3]); fp[4](os[4]); fp[5](os[5]); fp[6](os[6]);
+	    slot_set_value(vp, ostep->v[0].fp(ostep));
+	  }
+      else
+	while (!ostart->v[0].fb(ostart)) /* tfft teq */
+	  {
+	    for (int32_t i = 0; i < len; i++) fp[i](os[i]);
+	    slot_set_value(vp, ostep->v[0].fp(ostep));
+	  }}
+  unstack_gc_protect(sc);
+  set_curlet(sc, old_e);
+  return(sc->T);
+}
+
+static s7_pointer opt_do_times(opt_info *o)
+{
+  /* 1 var, no return */
+  opt_info *o1 = do_stepper_init(o);
+  opt_info *body = do_n_body(o);
+  int32_t len = do_body_length(o);
+  s7_int end = (is_slot(let_dox_slot2_unchecked(do_curlet(o)))) ? integer(slot_value(let_dox_slot2(do_curlet(o)))) : o->v[6].i;
+  s7_pointer vp = let_dox1_value(do_curlet(o));
+  s7_scheme *sc = o->sc;
+  s7_pointer old_e = sc->curlet;
+  gc_protect_via_stack(sc, old_e);
+  set_curlet(sc, do_curlet(o));
+  set_integer(vp, integer(o1->v[0].fp(o1)));
+  if (len == 2)                 /* tmac tmisc */
+    {
+      opt_info *e1 = body->v[0].o1, *e2 = body->v[1].o1;
+      while (integer(vp) < end)
+	{
+	  e1->v[0].fp(e1);
+	  e2->v[0].fp(e2);
+	  integer(vp)++;
+	}}
+  else
+    while (integer(vp) < end)  /* tbig sg */
+      {
+	for (int32_t i = 0; i < len; i++)
+	  {
+	    o1 = body->v[i].o1;
+	    o1->v[0].fp(o1);
+	  }
+	integer(vp)++;
+      }
+  unstack_gc_protect(sc);
+  set_curlet(sc, old_e);
+  return(sc->T);
+}
+
+static s7_pointer opt_do_list_simple(opt_info *o)
+{
+  opt_info *o1 = do_stepper_init(o);
+  s7_pointer vp = let_slots(do_curlet(o));
+  s7_scheme *sc = o->sc;
+  s7_pointer (*fp)(opt_info *o);
+  s7_pointer old_e = sc->curlet;
+  gc_protect_via_stack(sc, old_e);
+  set_curlet(sc, do_curlet(o));
+  slot_set_value(vp, o1->v[0].fp(o1));
+  o1 = do_any_body(o);
+  fp = o1->v[0].fp;
+  if (fp == opt_if_bp)
+    while (is_pair(slot_value(vp)))
+      {
+	if (o1->v[3].fb(o1->v[2].o1))
+	  o1->v[5].fp(o1->v[4].o1);
+	slot_set_value(vp, cdr(slot_value(vp)));
+      }
+  else
+    while (!is_null(slot_value(vp)))
+      {
+	fp(o1);
+	slot_set_value(vp, cdr(slot_value(vp)));
+      }
+  unstack_gc_protect(sc);
+  set_curlet(sc, old_e);
+  return(sc->T);
+}
+
+static s7_pointer opt_do_very_simple(opt_info *o)
+{
+  /* like simple but step can be direct, v[2].p is a let, v[3].i=end? */
+  opt_info *o1 = do_stepper_init(o);
+  s7_int end = (is_slot(let_dox_slot2_unchecked(do_curlet_unchecked(o)))) ? integer(slot_value(let_dox_slot2(do_curlet(o)))) : o->v[3].i;
+  s7_pointer vp = let_dox1_value(do_curlet(o));
+  s7_pointer (*f)(opt_info *o);
+  s7_scheme *sc = o->sc;
+  s7_pointer old_e = sc->curlet;
+  gc_protect_via_stack(sc, old_e);
+  set_curlet(sc, do_curlet(o));
+  set_integer(vp, integer(o1->v[0].fp(o1)));
+  o1 = do_any_body(o);
+  f = o1->v[0].fp;
+  if (f == opt_p_pip_ssf)                            /* tref.scm */
+    {
+      opt_info *o2 = o1;
+      o1 = o2->v[4].o1;
+      if (o2->v[3].p_pip_f == t_vector_set_p_pip_direct)
+	{
+	  s7_pointer v = slot_value(o2->v[1].p);
+	  while (integer(vp) < end)
+	    {
+	      t_vector_set_p_pip_direct(o2->sc, v, integer(slot_value(o2->v[2].p)), o1->v[0].fp(o1));
+	      integer(vp)++;
+	    }}
+      else
+	while (integer(vp) < end)
+	  {
+	    o2->v[3].p_pip_f(o2->sc, slot_value(o2->v[1].p), integer(slot_value(o2->v[2].p)), o1->v[0].fp(o1));
+	    integer(vp)++;
+	  }}
+  else
+    {
+      if (f == opt_p_pip_sso)
+	{ /* vector-set from vector-ref (i.e. copy), but treating vector-* as generic */
+	  if (((let_dox_slot1(do_curlet_unchecked(o)) == o1->v[2].p) && (o1->v[2].p == o1->v[4].p)) &&
+	      (((o1->v[5].p_pip_f == float_vector_set_p_pip_direct) && (o1->v[6].p_pi_f == float_vector_ref_p_pi_direct)) ||
+	       ((o1->v[5].p_pip_f == int_vector_set_p_pip_direct) &&   (o1->v[6].p_pi_f == int_vector_ref_p_pi_direct))   ||
+	       ((o1->v[5].p_pip_f == string_set_p_pip_direct) &&       (o1->v[6].p_pi_f == string_ref_p_pi_direct))       ||
+	       ((o1->v[5].p_pip_f == byte_vector_set_p_pip_direct) &&  (o1->v[6].p_pi_f == byte_vector_ref_p_pi_direct))))
+	    {
+	      copy_to_same_type(sc, slot_value(o1->v[1].p), slot_value(o1->v[3].p), integer(vp), end, integer(vp));
+	      unstack_gc_protect(sc);
+	      set_curlet(sc, old_e);
+	      return(sc->T);
+	    }
+	  while (integer(vp) < end)
+	    {
+	      o1->v[5].p_pip_f(o1->sc, slot_value(o1->v[1].p), integer(slot_value(o1->v[2].p)),
+			       o1->v[6].p_pi_f(o1->sc, slot_value(o1->v[3].p), integer(slot_value(o1->v[4].p))));
+	      integer(vp)++;
+	    }}
+      else
+	if ((f == opt_set_p_i_f) &&                      /* tvect.scm */
+	    (is_t_integer(slot_value(o1->v[1].p))) &&
+	    (o1->v[1].p != let_dox_slot1(do_curlet(o))))
+	  {
+	    opt_info *o2 = o1->v[5].o1;                  /* set_p_i_f: x = make_integer(o->sc, o->v[6].fi(o->v[5].o1)); */
+	    s7_int (*fi)(opt_info *o) = o2->v[0].fi;
+	    s7_pointer ival = make_mutable_integer(sc, integer(slot_value(o1->v[1].p)));
+	    slot_set_value(o1->v[1].p, ival);
+	    while (integer(vp) < end)
+	      {
+		set_integer(ival, fi(o2));
+		integer(vp)++;
+	      }
+	    slot_set_value(o1->v[1].p, make_integer(sc, integer(slot_value(o1->v[1].p))));
+	  }
+	else
+	  if ((f == opt_d_7pid_ssf_nr) &&           /* tref.scm */
+	      (o1->v[4].d_7pid_f == float_vector_set_d_7pid_direct))
+	    {
+	      s7_pointer ind = o1->v[2].p;
+	      opt_info *o2 = do_any_body(o1);
+	      s7_double (*fd)(opt_info *o) = o2->v[0].fd;
+	      s7_pointer fv = slot_value(o1->v[1].p);
+	      while (integer(vp) < end)
+		{
+		  float_vector_set_d_7pid_direct(sc, fv, integer(slot_value(ind)), fd(o2));
+		  /* weird! els[integer(slot_value(ind))] = fd(o2) is much slower according to callgrind? */
+		  integer(vp)++;
+		}}
+	  else
+	    while (integer(vp) < end) {f(o1); integer(vp)++;}}
+          /* splitting out opt_set_p_d_f_sf_add here (for tgsl.scm) is marginal (time is in opt_d_dd_ff_mul -> opt_d_id_sf -> bessel funcs) */
+  unstack_gc_protect(sc);
+  set_curlet(sc, old_e);
+  return(sc->T);
+}
+
+#define do_prepack_end(o)     o->v[1].i
+#define do_prepack_stepper(o) o->v[6].p
+
+static s7_pointer opt_do_prepackaged(opt_info *o)
+{
+  opt_info *o1 = do_stepper_init(o);
+  s7_int end = (is_slot(let_dox_slot2_unchecked(do_curlet_unchecked(o)))) ? integer(slot_value(let_dox_slot2(do_curlet(o)))) : o->v[3].i;
+  s7_pointer vp = let_dox1_value(do_curlet(o));
+  s7_scheme *sc = o->sc;
+  s7_pointer old_e = sc->curlet;
+  gc_protect_via_stack(sc, old_e);
+  set_curlet(sc, do_curlet(o));
+  set_integer(vp, integer(o1->v[0].fp(o1)));
+
+  do_prepack_stepper(o) = vp;
+  do_prepack_end(o) = end;
+  o->v[7].fp(o);  /* call opt_do_i|dpnr below */
+
+  unstack_gc_protect(sc);
+  set_curlet(sc, old_e);
+  return(sc->T);
+}
+
+static s7_pointer opt_do_dpnr(opt_info *o)
+{
+  opt_info *o1 = do_any_body(o);
+  s7_pointer vp = do_prepack_stepper(o);
+  s7_int end = do_prepack_end(o);
+  s7_double (*f)(opt_info *o) = o1->v[O_WRAP].fd;
+  while (integer(vp) < end) {f(o1); integer(vp)++;}
+  return(NULL);
+}
+
+static s7_pointer opt_do_ipnr(opt_info *o)
+{
+  opt_info *o1 = do_any_body(o);
+  s7_pointer vp = do_prepack_stepper(o);
+  s7_int end = do_prepack_end(o);
+  s7_int (*f)(opt_info *o) = o1->v[O_WRAP].fi;
+  while (integer(vp) < end) {f(o1); integer(vp)++;}
+  return(NULL);
+}
+
+static bool stop_is_safe(s7_scheme *sc, s7_pointer stop, s7_pointer body)
+{
+  /* this could be folded into the cell_optimize traversal */
+  for (s7_pointer p = body; is_pair(p); p = cdr(p))
+    if ((is_pair(car(p))) &&
+	(caar(p) == sc->set_symbol) &&
+	(is_pair(cdar(p))) &&
+	(cadar(p) == stop))
+      return(!s7_tree_memq(sc, stop, cdr(p)));
+  return(true);
+}
+
+static bool tree_has_setters(s7_scheme *sc, s7_pointer tree)
+{
+  if (is_quote(car(tree))) return(false);
+  clear_symbol_list(sc);
+  add_symbol_to_list(sc, sc->set_symbol);
+  add_symbol_to_list(sc, sc->vector_set_symbol);
+  add_symbol_to_list(sc, sc->list_set_symbol);
+  add_symbol_to_list(sc, sc->let_set_symbol);
+  add_symbol_to_list(sc, sc->hash_table_set_symbol);
+  add_symbol_to_list(sc, sc->set_car_symbol);
+  add_symbol_to_list(sc, sc->set_cdr_symbol);
+  return(pair_set_memq(sc, tree));
+}
+
+static bool do_is_safe(s7_scheme *sc, s7_pointer body, s7_pointer stepper, s7_pointer var_list, s7_pointer step_vars, bool *has_set);
+
+static bool do_passes_safety_check(s7_scheme *sc, s7_pointer body, s7_pointer stepper, s7_pointer step_vars, bool *has_set)
+{
+  if (!is_pair(body)) return(true);
+  if (!is_safety_checked(body))
+    {
+      set_safety_checked(body);
+      if (!(do_is_safe(sc, body, stepper, sc->nil, step_vars, has_set)))
+	set_unsafe_do(body);
+    }
+  return(!is_unsafe_do(body));
+}
+
+#define SIZE_O NUM_VUNIONS
+
+static bool all_integers(s7_scheme *sc, s7_pointer expr)
+{
+  if ((is_symbol(car(expr))) && (is_all_integer(car(expr))))
+    {
+      s7_pointer p;
+      for (p = cdr(expr); is_pair(p); p = cdr(p))
+	if (!((is_t_integer(car(p))) ||
+	      ((is_symbol(car(p))) && (is_t_integer(slot_value(s7_slot(sc, car(p)))))) ||
+	      ((is_pair(car(p))) && (all_integers(sc, car(p))))))
+	  break;
+      return(is_null(p));
+    }
+  return(false);
+}
+
+static bool all_floats(s7_scheme *sc, s7_pointer expr)
+{
+  if ((is_symbol(car(expr))) && (is_all_float(car(expr))))
+    {
+      s7_pointer p;
+      for (p = cdr(expr); is_pair(p); p = cdr(p))
+	if (!((is_t_real(car(p))) ||
+	      ((is_symbol(car(p))) && (is_t_real(slot_value(s7_slot(sc, car(p)))))) ||
+	      ((is_pair(car(p))) && (all_floats(sc, car(p))))))
+	  break;
+      return(is_null(p));
+    }
+  return(false);
+}
+
+static bool opt_cell_do(s7_scheme *sc, s7_pointer car_x, int32_t len)
+{
+  opt_info *opc;
+  s7_pointer p, end, let = NULL, old_e = sc->curlet, stop, ind, ind_step;
+  int32_t i, k, var_len, body_len = len - 3, body_index, step_len, rtn_len, step_pc, init_pc, end_test_pc;
+  bool has_set = false;
+  opt_info *init_o[SIZE_O], *step_o[SIZE_O], *body_o[SIZE_O], *return_o[SIZE_O];
+
+  if (len < 3)
+    return_false(sc, car_x);
+
+  if (!s7_is_proper_list(sc, cadr(car_x)))
+    return_false(sc, car_x);
+  var_len = proper_list_length(cadr(car_x));
+  step_len = var_len;
+  if (body_len > SIZE_O)
+    return_false(sc, car_x);
+  end = caddr(car_x);
+  if (!is_pair(end))
+    return_false(sc, car_x);
+
+  opc = alloc_opt_info(sc);
+  let = inline_make_let(sc, sc->curlet);
+  push_stack(sc, OP_GC_PROTECT, old_e, let);
+
+  /* the vars have to be added to the let before evaluating the inits
+   *    else symbol_id can be > let_id (see "(test (do ((i (do ((i (do ((i 0 (+ i 1)))...")
+   */
+  clear_symbol_list(sc);
+  for (p = cadr(car_x); is_pair(p); p = cdr(p))
+    {
+      s7_pointer var = car(p);
+      if ((is_pair(var)) &&
+	  (is_symbol(car(var))) &&
+	  (is_pair(cdr(var))))
+	{
+	  s7_pointer sym = car(var);
+	  if (is_constant_symbol(sc, sym))
+	    return_false(sc, car_x);
+	  if (symbol_is_in_list(sc, sym))
+	    syntax_error_nr(sc, "duplicate identifier in do: ~A", 30, var);
+	  add_symbol_to_list(sc, sym);
+	  add_slot(sc, let, sym, sc->undefined);
+	}
+      else return_false(sc, car_x);
+    }
+  if (tis_slot(let_slots(let)))
+    let_set_slots(let, reverse_slots(let_slots(let)));
+
+  /* inits */
+  {
+    s7_pointer slot;
+    init_pc = sc->pc;
+    for (k = 0, p = cadr(car_x), slot = let_slots(let); (is_pair(p)) && (k < SIZE_O); k++, p = cdr(p), slot = next_slot(slot))
+      {
+	s7_pointer var = car(p);
+	init_o[k] = sc->opts[sc->pc];
+	if (!cell_optimize(sc, cdr(var))) /* opt init in outer let */
+	  return_false(sc, car_x);
+	if (is_pair(cddr(var)))
+	  {
+	    set_has_stepper(slot);
+	    if (!is_null(cdddr(var)))
+	      return_false(sc, car_x);
+	  }
+	else
+	  {
+	    step_len--;
+	    if (!is_null(cddr(var)))
+	      return_false(sc, car_x);
+	  }
+	/* we can't use slot_set_value(slot, init_o[k]->v[0].fp(init_o[k])) to get the init value here: it might involve side-effects,
+	 *   and in some contexts might access variables that aren't set up yet.  So, we kludge around...
+	 */
+	if (is_symbol(cadr(var)))
+	  slot_set_value(slot, slot_value(s7_slot(sc, cadr(var))));
+	else
+	  if (!is_pair(cadr(var)))
+	    slot_set_value(slot, cadr(var));
+	  else
+	    if (is_proper_quote(sc, cadr(var)))
+	      slot_set_value(slot, cadadr(var));
+	    else
+	      {
+		s7_pointer sf = lookup_checked(sc, caadr(var));
+		if (is_c_function(sf))
+		  {
+		    s7_pointer sig = c_function_signature(sf);
+		    if (is_pair(sig))
+		      {
+			if ((car(sig) == sc->is_integer_symbol) ||
+			    ((is_pair(car(sig))) &&
+			     (direct_memq(sc->is_integer_symbol, car(sig)))) ||
+			    (all_integers(sc, cadr(var))))
+			  slot_set_value(slot, int_zero);
+			else
+			  if ((car(sig) == sc->is_float_symbol) ||
+			      ((is_pair(car(sig))) &&
+			       (direct_memq(sc->is_float_symbol, car(sig)))) ||
+			      (all_floats(sc, cadr(var))))
+			    slot_set_value(slot, real_zero);
+			/* need for stepper too -- how does it know (+ x 0.1) is float? try (i 0 (floor (+ i 1))) etc */
+		      }}}}
+    set_curlet(sc, let);
+    for (p = cadr(car_x); is_pair(p); p = cdr(p))
+      {
+	s7_pointer var = car(p);
+	if (is_pair(cddr(var)))
+	  {
+	    s7_pointer init_type = opt_arg_type(sc, cdr(var));
+	    if (((init_type == sc->is_integer_symbol) ||
+		 (init_type == sc->is_float_symbol)) &&
+		(opt_arg_type(sc, cddr(var)) != init_type))
+	      {
+		unstack_gc_protect(sc); /* not pop_stack! */
+		set_curlet(sc, old_e);
+		return_false(sc, car_x);
+	      }}}}
+
+  /* end test */
+  end_test_pc = sc->pc;
+  if (!bool_optimize_nw(sc, end))
+    {
+      unstack_gc_protect(sc); /* not pop_stack! */
+      set_curlet(sc, old_e);
+      return_false(sc, car_x);
+    }
+
+  stop = car(end);
+  if ((is_proper_list_3(sc, stop)) &&
+      ((car(stop) == sc->num_eq_symbol) || (car(stop) == sc->geq_symbol) || (car(stop) == sc->gt_symbol)) &&
+      (is_symbol(cadr(stop))) &&
+      ((is_t_integer(caddr(stop))) || (is_symbol(caddr(stop)))))
+    {
+      s7_pointer stop_slot = (is_symbol(caddr(stop))) ? opt_integer_symbol(sc, caddr(stop)) : sc->nil;
+      if (stop_slot)
+	{
+	  s7_int lim = (is_slot(stop_slot)) ? integer(slot_value(stop_slot)) : integer(caddr(stop));
+	  bool set_stop = false;
+	  s7_pointer slot;
+
+	  if (car(stop) == sc->gt_symbol) lim++;
+	  for (p = cadr(car_x), slot = let_slots(let); is_pair(p); p = cdr(p), slot = next_slot(slot))
+	    {
+	      /* this could be put off until it is needed (ref/set), but this code is not called much
+	       *    another choice: go from init downto 0: init is lim
+	       */
+	      if (slot_symbol(slot) == cadr(stop))
+		set_stop = true; /* don't overrule this decision below */
+	      if (has_stepper(slot))
+		{
+		  s7_pointer var = car(p), step = caddr(var);
+		  if ((is_t_integer(slot_value(slot))) &&
+		      (is_pair(step)) &&
+		      (is_pair(cdr(step))) &&
+		      (car(var) == cadr(stop)) &&
+		      (car(var) == cadr(step)) &&
+		      ((car(stop) != sc->num_eq_symbol) || /* else > protects at least the top */
+		       ((caddr(step) == int_one) && (car(step) == sc->add_symbol))))
+		    {
+		      set_has_loop_end(slot);
+		      slot_set_value(slot, make_mutable_integer(sc, integer(slot_value(slot))));
+		      set_loop_end(slot, lim);
+		    }}}
+
+	  if (!set_stop)
+	    {
+	      s7_pointer slot2 = opt_integer_symbol(sc, cadr(stop));
+	      if ((slot2) &&
+		  (stop_is_safe(sc, cadr(stop), cddr(car_x)))) /* b_fft in tfft.scm */
+		{
+		  set_has_loop_end(slot2);
+		  set_loop_end(slot2, lim);
+		}}}}
+
+  /* body */
+  body_index = sc->pc;
+  for (k = 0, i = 3, p = cdddr(car_x); i < len; k++, i++, p = cdr(p))
+    {
+      opt_info *start = sc->opts[sc->pc];
+      body_o[k] = start;
+      if (i < 5) opc->v[i + 7].o1 = start;
+      if (!cell_optimize(sc, p))
+	break;
+      oo_idp_nr_fixup(start);
+    }
+  if (!is_null(p))
+    {
+      unstack_gc_protect(sc);
+      set_curlet(sc, old_e);
+      return_false(sc, car_x);
+    }
+
+  /* we faked up sc->curlet above, so s7_optimize_1 (float_optimize) isn't safe here
+   *    this means if clm nested loops get here, they aren't fully optimized -- fallback into dox would be better
+   */
+  /* steps */
+  step_pc = sc->pc;
+  for (k = 0, p = cadr(car_x); is_pair(p); k++, p = cdr(p))
+    {
+      s7_pointer var = car(p);
+      step_o[k] = sc->opts[sc->pc];
+      if ((is_pair(cddr(var))) &&
+	  (!cell_optimize(sc, cddr(var))))
+	break;
+    }
+  if (!is_null(p))
+    {
+      unstack_gc_protect(sc);
+      set_curlet(sc, old_e);
+      return_false(sc, car_x);
+    }
+
+  /* result */
+  if (!is_list(cdr(end)))
+    {
+      unstack_gc_protect(sc);
+      set_curlet(sc, old_e);
+      return_false(sc, car_x);
+    }
+  for (rtn_len = 0, p = cdr(end); (is_pair(p)) && (rtn_len < SIZE_O); p = cdr(p), rtn_len++)
+    {
+      return_o[rtn_len] = sc->opts[sc->pc];
+      if (!cell_optimize(sc, p))
+	break;
+    }
+  if (!is_null(p))
+    {
+      unstack_gc_protect(sc);
+      set_curlet(sc, old_e);
+      return_false(sc, car_x);
+    }
+
+  do_curlet_unchecked(opc) = T_Let(let);
+  do_body_length(opc) = len - 3;
+  do_result_length(opc) = rtn_len;
+  opc->v[9].o1 = sc->opts[step_pc];
+  set_curlet(sc, old_e);
+
+  if ((var_len == 0) && (rtn_len == 0))
+    {
+      opt_info *body;
+      do_no_vars_test(opc) = sc->opts[end_test_pc];
+      opc->v[0].fp = opt_do_no_vars;
+      if (body_len > 0)
+	{
+	  body = alloc_opt_info(sc);
+	  for (k = 0; k < body_len; k++)
+	    body->v[k].o1 = body_o[k];
+	  do_no_vars_body(opc) = body;
+	}
+      return_true(sc, car_x);
+    }
+  opc->v[8].i = 0;
+  if (body_len == 1)
+    {
+      s7_pointer expr = cadddr(car_x);
+      if ((is_pair(expr)) &&
+	  ((is_c_function(car(expr))) ||
+	   (is_safe_setter(car(expr))) ||
+	   ((car(expr) == sc->set_symbol) &&
+	    (cadr(expr) != caaadr(car_x))) || /* caadr: (stepper init ...) */
+	   ((car(expr) == sc->vector_set_symbol) &&
+	    (is_null(cddddr(expr))) &&
+	    (is_code_constant(sc, cadddr(expr))))))
+	opc->v[8].i = 1;
+    }
+  if ((var_len != 1) || (step_len != 1) || (rtn_len != 0))
+    {
+      opt_info *inits;
+
+      opc->v[0].fp = ((step_len == 1) && (body_len == 1) && (rtn_len == 1)) ? opt_do_step_1 : opt_do_any;
+      /* (do ((sum 0.0) (k 0 (+ k 1))) ((= k size) (set! (C i j) sum)) (set! sum (+ sum (* (A i k) (B k j))))) tmat */
+
+      do_any_test(opc) = sc->opts[end_test_pc];
+
+      if ((opc->v[0].fp == opt_do_step_1) &&
+	  (opc->v[9].o1->v[0].fp == i_to_p) &&
+	  (opc->v[9].o1->v[O_WRAP].fi == opt_i_ii_sc_add) &&
+	  (do_any_test(opc)->v[0].fb == opt_b_ii_ss_eq))
+	opc->v[0].fp = opt_do_step_i;
+
+      inits = alloc_opt_info(sc);
+      for (k = 0; k < var_len; k++)
+	inits->v[k].o1 = init_o[k];
+      do_any_inits(opc) = inits;
+
+      if (opc->v[0].fp == opt_do_any)
+	{
+	  opt_info *result, *step;
+	  opt_info *body = alloc_opt_info(sc);
+
+	  for (k = 0; k < body_len; k++)
+	    body->v[k].o1 = body_o[k];
+	  do_any_body(opc) = body;
+
+	  result = alloc_opt_info(sc);
+	  for (k = 0; k < rtn_len; k++)
+	    result->v[k].o1 = return_o[k];
+	  do_any_results(opc) = result;
+
+	  step = alloc_opt_info(sc);
+	  for (k = 0; k < var_len; k++)
+	    step->v[k].o1 = step_o[k];
+	  do_any_steps(opc) = step;
+	}
+      else
+	{
+	  do_any_body(opc) = sc->opts[body_index];
+	  do_any_results(opc) = return_o[0];
+	}
+      return_true(sc, car_x);
+    }
+
+  opc->v[0].fp = (body_len == 1) ? opt_do_1 : opt_do_n;
+  p = caadr(car_x);
+  ind = car(p);
+  ind_step = caddr(p);
+  end = caaddr(car_x);
+
+  if (body_len == 1) /* opt_do_1 */
+    do_any_body(opc) = sc->opts[body_index];
+  else
+    {
+      opt_info *body = alloc_opt_info(sc);
+      for (k = 0; k < body_len; k++)
+	body->v[k].o1 = body_o[k];
+      do_n_body(opc) = body;
+    }
+  do_stepper_init(opc) = sc->opts[init_pc];
+  do_any_test(opc) = sc->opts[end_test_pc];
+  do_any_steps(opc) = sc->opts[step_pc];
+
+  if ((is_pair(end)) &&                      /* (= i len|100) */
+      (cadr(end) == ind) &&
+      (is_pair(ind_step)))                   /* (+ i 1) */
+    {
+      /* we can't use loop_end_possible here yet (not set except for op_dox?) */
+
+      if (((car(end) == sc->num_eq_symbol) || (car(end) == sc->geq_symbol)) &&
+	  ((is_symbol(caddr(end))) || (is_t_integer(caddr(end)))) &&
+	  (is_null(cdddr(end))) &&
+	  (car(ind_step) == sc->add_symbol) &&
+	  (cadr(ind_step) == ind) &&
+	  (caddr(ind_step) == int_one) &&
+	  (is_null(cdddr(ind_step))) &&
+	  (do_passes_safety_check(sc, cdddr(car_x), ind, cadr(car_x), &has_set)))
+	{
+	  s7_pointer slot = let_slots(let);
+	  let_set_dox_slot1(let, slot);
+	  let_set_dox_slot2_unchecked(let, (is_symbol(caddr(end))) ? s7_slot(sc, caddr(end)) : sc->undefined);
+	  slot_set_value(slot, make_mutable_integer(sc, integer(slot_value(slot))));
+	  opc->v[4].i = body_index;
+	  if (body_len == 1) /* opt_do_1 */
+	    {
+	      opt_info *o1 = sc->opts[body_index];
+	      opc->v[0].fp = opt_do_very_simple;
+	      if (is_t_integer(caddr(end)))
+		opc->v[3].i = integer(caddr(end));
+	      if (o1->v[0].fp == d_to_p_nr) /* snd-test: (do ((k 0 (+ k 1))) ((= k N)) (float-vector-set! rl k (read-sample rd))) */
+		{
+		  opc->v[0].fp = opt_do_prepackaged;
+		  opc->v[7].fp = opt_do_dpnr;
+		}
+	      else
+		if (o1->v[0].fp == i_to_p_nr)
+		  {
+		    opc->v[0].fp = opt_do_prepackaged;
+		    opc->v[7].fp = opt_do_ipnr;
+		  }}
+	  else
+	    {
+	      opc->v[0].fp = opt_do_times;
+	      if (is_t_integer(caddr(end)))
+		opc->v[6].i = integer(caddr(end));
+	    }}
+      else
+	if ((car(end) == sc->is_null_symbol) &&
+	    (is_null(cddr(end))) &&
+	    (car(ind_step) == sc->cdr_symbol) &&
+	    (cadr(ind_step) == ind) &&
+	    (is_null(cddr(ind_step))) &&
+	    (body_len == 1) &&
+	    (do_passes_safety_check(sc, cdddr(car_x), ind, cadr(car_x), &has_set)))
+	  opc->v[0].fp = opt_do_list_simple;
+    }
+  return_true(sc, car_x);
+}
+
+static bool p_syntax_ok(s7_scheme *sc, s7_pointer car_x, int32_t len)
+{
+  s7_pointer func = lookup_global(sc, car(car_x));
+  opcode_t op;
+  if (!is_syntax(func)) {clear_syntactic(car_x); return_false(sc, car_x);}
+  /* I think this is the only case where we don't precede syntax_opcode with syntactic_symbol checks */
+  op = syntax_opcode(func);
+  switch (op)
+    {
+    case OP_QUOTE:  if ((is_pair(cdr(car_x))) && (is_null(cddr(car_x)))) return(opt_cell_quote(sc, car_x)); break;
+    case OP_SET:    if (len == 3) return(opt_cell_set(sc, car_x));       break;
+    case OP_BEGIN:  if (len > 1) return(opt_cell_begin(sc, car_x, len)); break;
+    case OP_WHEN:
+    case OP_UNLESS: if (len > 2) return(opt_cell_when(sc, car_x, len));  break;
+    case OP_COND:   if (len > 1) return(opt_cell_cond(sc, car_x));       break;
+    case OP_CASE:   if (len > 2) return(opt_cell_case(sc, car_x));       break;
+    case OP_AND:
+    case OP_OR:     return(opt_cell_and(sc, car_x, len));
+    case OP_IF:     return(opt_cell_if(sc, car_x, len));
+    case OP_DO:     return(opt_cell_do(sc, car_x, len));
+    case OP_LET_TEMPORARILY: return(opt_cell_let_temporarily(sc, car_x, len));
+    default:
+      /* for lambda et al we'd return the new closure, but if unsafe?
+       *     let(*) -> make the let -> body (let=99% of cases), could we use do (i.e. do+no steppers+no end!) or let-temp?
+       *     with-let -> establish car(args)=let, then body
+       *     macroexpand -> return the expansion
+       *     define et al -> define + return value
+       * map and for-each are not syntax, also call-with*(=exit)
+       * also let-temp for vars>1
+       */
+      break;
+    }
+  return_false(sc, car_x);
+}
+
+
+/* -------------------------------------------------------------------------------- */
+static bool float_optimize_1(s7_scheme *sc, s7_pointer expr)
+{
+  s7_pointer car_x = car(expr), head, s_func, s_slot = NULL;
+  s7_int len;
+  if (OPT_PRINT) fprintf(stderr, "     float_optimize %s\n", display(expr));
+  if (WITH_GMP) return(false);
+  if (!is_pair(car_x)) /* wrap constants/symbols */
+    return(opt_float_not_pair(sc, car_x));
+
+  head = car(car_x);
+  len = s7_list_length(sc, car_x);
+  if (is_symbol(head))
+    {
+      if ((is_syntactic_symbol(head)) ||
+	  (is_syntactic_pair(car_x)))
+	return(d_syntax_ok(sc, car_x, len));
+
+      s_slot = s7_slot(sc, head);
+      if (!is_slot(s_slot)) return_false(sc, car_x);
+      s_func = slot_value(s_slot);
+    }
+  else
+    if (is_c_function(head))
+      s_func = head;
+    else return_false(sc, car_x);
+
+  if (is_c_function(s_func))
+    {
+      opt_info *opc = alloc_opt_info(sc);
+      switch (len)
+	{
+	case 1:
+	  return(d_ok(sc, opc, s_func));
+
+	case 2:                            /* (f v) or (f d): (env e) or (abs x) */
+	  return((d_d_ok(sc, opc, s_func, car_x)) ||
+		 (d_v_ok(sc, opc, s_func, car_x)) ||
+		 (d_p_ok(sc, opc, s_func, car_x)));
+
+	case 3:
+	  return((d_dd_ok(sc, opc, s_func, car_x)) ||
+		 (d_id_ok(sc, opc, s_func, car_x)) ||
+		 (d_vd_ok(sc, opc, s_func, car_x)) ||
+		 (d_pd_ok(sc, opc, s_func, car_x)) ||
+		 (d_ip_ok(sc, opc, s_func, car_x)) ||
+		 (d_7pi_ok(sc, opc, s_func, car_x)));
+
+	case 4:
+	  return((d_ddd_ok(sc, opc, s_func, car_x)) ||
+		 (d_7pid_ok(sc, opc, s_func, car_x)) ||
+		 (d_vid_ok(sc, opc, s_func, car_x)) ||
+		 (d_vdd_ok(sc, opc, s_func, car_x)) ||
+		 (d_7pii_ok(sc, opc, s_func, car_x)));
+
+	case 5:
+	  return((d_dddd_ok(sc, opc, s_func, car_x)) ||
+		 (d_7piid_ok(sc, opc, s_func, car_x)) ||
+		 (d_7piii_ok(sc, opc, s_func, car_x)));
+
+	case 6:
+	  if (d_7piiid_ok(sc, opc, s_func, car_x))
+	    return_true(sc, car_x);
+	  /* fall through */
+
+	default:
+	  return(d_add_any_ok(sc, opc, car_x));
+	}}
+  else
+    {
+      if ((is_macro(s_func)) && (!no_cell_opt(expr)))
+	{
+	  s7_pointer body = closure_body(s_func);
+	  if ((is_null(cdr(body))) && (is_pair(car(body))) &&
+	      ((caar(body) == sc->list_symbol) || (caar(body) == sc->list_values_symbol) || (caar(body) == initial_value(sc->list_values_symbol))))
+	    {
+	      s7_pointer result = s7_macroexpand(sc, s_func, cdar(expr));
+	      if (result == sc->F) return_false(sc, car_x);
+	      return(float_optimize(sc, set_plist_1(sc, result)));
+	    }}
+      if (!s_slot) return_false(sc, car_x);
+      return(d_implicit_ok(sc, s_slot, car_x, len));
+    }
+  return_false(sc, car_x);
+}
+
+static bool float_optimize(s7_scheme *sc, s7_pointer expr) {return((float_optimize_1(sc, expr)) && (sc->pc < OPTS_SIZE));}
+/* combining the sc->pc check into float_optimize_1 (and similarly for the other 3 cases) does not given any speedup */
+
+static bool int_optimize_1(s7_scheme *sc, s7_pointer expr)
+{
+  s7_pointer car_x = car(expr), head, s_func, s_slot = NULL;
+  s7_int len;
+  if (OPT_PRINT) fprintf(stderr, "     int_optimize %s\n", display(expr));
+  if (WITH_GMP) return(false);
+  if (!is_pair(car_x)) /* wrap constants/symbols */
+    return(opt_int_not_pair(sc, car_x));
+
+  head = car(car_x);
+  len = s7_list_length(sc, car_x);
+  if (is_symbol(head))
+    {
+      if ((is_syntactic_symbol(head)) ||
+	  (is_syntactic_pair(car_x)))
+	return(i_syntax_ok(sc, car_x, len));
+      s_slot = s7_slot(sc, head);
+      if (!is_slot(s_slot)) return_false(sc, car_x);
+      s_func = slot_value(s_slot);
+    }
+  else
+    if (is_c_function(head))
+      s_func = head;
+    else return_false(sc, car_x);
+
+  if (is_c_function(s_func))
+    {
+      opt_info *opc = alloc_opt_info(sc);
+      switch (len)
+	{
+	case 2:
+	  return(i_idp_ok(sc, opc, s_func, car_x));
+
+	case 3:
+	  return((i_ii_ok(sc, opc, s_func, car_x)) ||
+		 (i_7pi_ok(sc, opc, s_func, car_x)));
+
+	case 4:
+	  return((i_iii_ok(sc, opc, s_func, car_x)) ||
+		 (i_7pii_ok(sc, opc, s_func, car_x)));
+
+	case 5:
+	  {
+	    int32_t pstart = sc->pc;
+	    if (i_7piii_ok(sc, opc, s_func, car_x))
+	      return_true(sc, car_x);
+	    sc->pc = pstart;
+	  }
+	  /* fall through */
+
+	default:
+	  return(((head == sc->add_symbol) ||
+		  (head == sc->multiply_symbol)) &&
+		 (i_add_any_ok(sc, opc, car_x)));
+	}}
+  else
+    {
+      if ((is_macro(s_func)) && (!no_cell_opt(expr)))
+	{
+	  s7_pointer body = closure_body(s_func);
+	  if ((is_null(cdr(body))) && (is_pair(car(body))) &&
+	      ((caar(body) == sc->list_symbol) || (caar(body) == sc->list_values_symbol) || (caar(body) == initial_value(sc->list_values_symbol))))
+	    {
+	      s7_pointer result = s7_macroexpand(sc, s_func, cdar(expr));
+	      if (result == sc->F) return_false(sc, car_x);
+	      return(int_optimize(sc, set_plist_1(sc, result)));
+	    }}
+      if (!s_slot) return_false(sc, car_x);
+      return(i_implicit_ok(sc, s_slot, car_x, len));
+    }
+  return_false(sc, car_x);
+}
+
+static bool int_optimize(s7_scheme *sc, s7_pointer expr) {return((int_optimize_1(sc, expr)) && (sc->pc < OPTS_SIZE));}
+
+/* cell_optimize... */
+static bool p_2x_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, int32_t pstart, s7_pointer expr)
+{
+  s7_pointer sig = c_function_signature(s_func);
+  if (is_symbol(cadr(car_x)))
+    {
+      if ((is_pair(sig)) && (is_pair(cdr(sig))) && (is_pair(cddr(sig))) && (caddr(sig) == sc->is_integer_symbol))
+	{
+	  if (p_pi_ok(sc, opc, s_func, sig, car_x))
+	    return_true(sc, car_x);
+
+	  if ((car(sig) == sc->is_float_symbol) ||
+	      (car(sig) == sc->is_real_symbol))
+	    {
+	      s7_d_7pi_t f = s7_d_7pi_function(s_func);
+	      if (f)
+		{
+		  sc->pc = pstart - 1;
+		  if (float_optimize(sc, expr))
+		    {
+		      opc->v[O_WRAP].fd = opc->v[0].fd;
+		      opc->v[0].fp = d_to_p;
+		      return_true(sc, car_x);
+		    }}}
+	  sc->pc = pstart;
+	}}
+  {
+    s7_i_ii_t ifunc = s7_i_ii_function(s_func);
+    sc->pc = pstart - 1;
+    if ((ifunc) &&
+	(int_optimize(sc, expr)))
+      {
+	opc->v[O_WRAP].fi = opc->v[0].fi;
+	opc->v[0].fp = i_to_p;
+	if (opc->v[O_WRAP].fi == opt_i_ii_ss_add)
+	  opc->v[0].fp = opt_p_ii_ss_add;
+	return_true(sc, car_x);
+      }}
+  sc->pc = pstart;
+  return((p_ii_ok(sc, opc, s_func, car_x, pstart)) ||
+	 (p_dd_ok(sc, opc, s_func, car_x, pstart)) ||
+	 (p_pp_ok(sc, opc, s_func, car_x, pstart)) ||
+	 (p_call_pp_ok(sc, opc, s_func, car_x, pstart)));
+}
+
+static bool p_3x_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, int32_t pstart, s7_pointer expr)
+{
+  s7_pointer sig = c_function_signature(s_func);
+  if (is_symbol(cadr(car_x)))
+    {
+      if ((is_pair(sig)) && (is_pair(cdr(sig))) && (is_pair(cddr(sig))) &&
+	  (caddr(sig) == sc->is_integer_symbol))
+	{
+	  if (p_pii_ok(sc, opc, s_func, car_x))
+	    return_true(sc, car_x);
+	  if (p_pip_ok(sc, opc, s_func, car_x))
+	    return_true(sc, car_x);
+
+	  if (((car(sig) == sc->is_float_symbol) ||
+	       (car(sig) == sc->is_real_symbol)) &&
+	      (s7_d_7pid_function(s_func)) &&
+	      (d_7pid_ok(sc, opc, s_func, car_x)))
+	    {
+	      /* if d_7pid is ok, we need d_to_p for cell_optimize */
+	      opc->v[O_WRAP].fd = opc->v[0].fd;
+	      opc->v[0].fp = d_to_p;
+	      return_true(sc, car_x);
+	    }
+
+	  sc->pc = pstart - 1;
+	  if ((car(sig) == sc->is_integer_symbol) &&
+	      (s7_i_7pii_function(s_func)) &&
+	      (i_7pii_ok(sc, alloc_opt_info(sc), s_func, car_x)))
+	    {
+	      opc->v[O_WRAP].fi = opc->v[0].fi;
+	      opc->v[0].fp = i_to_p;
+	      return_true(sc, car_x);
+	    }
+	  sc->pc = pstart;
+	}}
+  return((p_ppi_ok(sc, opc, s_func, car_x)) ||
+	 (p_ppp_ok(sc, opc, s_func, car_x)) ||
+	 (p_call_ppp_ok(sc, opc, s_func, car_x)));
+}
+
+static bool p_4x_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, int32_t pstart, s7_pointer expr)
+{
+  s7_pointer head = car(car_x);
+  s7_int len = s7_list_length(sc, car_x);
+
+  if ((is_target_or_its_alias(head, s_func, sc->float_vector_set_symbol)) &&
+      (d_7piid_ok(sc, opc, s_func, car_x)))
+    {
+      opc->v[O_WRAP].fd = opc->v[0].fd;
+      opc->v[0].fp = d_to_p;         /* as above, if d_7piid is ok, we need d_to_p for cell_optimize */
+      return_true(sc, car_x);
+    }
+  if ((is_target_or_its_alias(head, s_func, sc->float_vector_ref_symbol)) &&
+      (d_7piii_ok(sc, opc, s_func, car_x)))
+    {
+      opc->v[O_WRAP].fd = opc->v[0].fd;
+      opc->v[0].fp = d_to_p;
+      return_true(sc, car_x);
+    }
+  if (i_7piii_ok(sc, opc, s_func, car_x))
+    {
+      opc->v[O_WRAP].fi = opc->v[0].fi;
+      opc->v[0].fp = i_to_p;
+      return_true(sc, car_x);
+    }
+  if (is_target_or_its_alias(head, s_func, sc->int_vector_set_symbol))
+    return_false(sc, car_x);
+  if (p_piip_ok(sc, opc, s_func, car_x))
+    return_true(sc, car_x);
+  sc->pc = pstart;
+  if (s_func == global_value(sc->vector_ref_symbol))
+    {
+      s7_pointer obj;
+      if (!is_symbol(cadr(car_x))) return_false(sc, car_x);
+      obj = lookup_unexamined(sc, cadr(car_x)); /* was lookup_from (to avoid the unbound variable check) */
+      if ((!obj) || (!is_any_vector(obj)) || (vector_rank(obj) != 3))
+	return_false(sc, car_x);
+    }
+  return(p_call_any_ok(sc, opc, s_func, car_x, len));
+}
+
+static bool p_5x_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, int32_t pstart, s7_pointer expr)
+{
+  s7_pointer head = car(car_x);
+  if ((is_target_or_its_alias(head, s_func, sc->float_vector_set_symbol)) &&
+      (d_7piiid_ok(sc, opc, s_func, car_x)))
+    {
+      opc->v[O_WRAP].fd = opc->v[0].fd;
+      opc->v[0].fp = d_to_p;
+      return_true(sc, car_x);
+    }
+  return_false(sc, car_x);
+}
+
+static bool cell_optimize_1(s7_scheme *sc, s7_pointer expr)
+{
+  s7_pointer car_x = car(expr), head, s_func, s_slot = NULL;
+  s7_int len;
+  if (OPT_PRINT) fprintf(stderr, "     cell_optimize %s\n", display(expr));
+  if (WITH_GMP) return(false);
+  if (!is_pair(car_x)) /* wrap constants/symbols */
+    return(opt_cell_not_pair(sc, car_x));
+
+  head = car(car_x);
+  len = s7_list_length(sc, car_x);
+  if (is_symbol(head))
+    {
+      if ((is_syntactic_symbol(head)) ||
+	  (is_syntactic_pair(car_x))) /* this can be wrong! */
+	return(p_syntax_ok(sc, car_x, len));
+
+      s_slot = s7_slot(sc, head);
+      if (!is_slot(s_slot)) return_false(sc, car_x);
+      s_func = slot_value(s_slot);
+    }
+  else
+    if (is_c_function(head)) /* (#_abs -1) I think */
+      s_func = head;
+    else
+      { /* ((let-ref L 'mult) 1 2) or 'a etc */
+	/* fprintf(stderr, "%d: car_x: %s, head: %s\n", __LINE__, display(car_x), display(head)); */
+	if ((head == sc->quote_function) &&
+	    ((is_pair(cdr(car_x))) && (is_null(cddr(car_x)))))
+	  return(opt_cell_quote(sc, car_x));
+
+	/* if head is ([let-ref] L 'multiply), it should be accessible now, so we could do the lookup, set up s_func and go on */
+	if (is_pair(head))
+	  {
+	    s7_pointer let, slot, sym;
+	    if ((car(head) == sc->let_ref_symbol) && (s7_list_length(sc, head) == 3))
+	      {
+		let = cadr(head);
+		sym = caddr(head);
+	      }
+	    else
+	      if (s7_list_length(sc, head) == 2)
+		{
+		  let = car(head);
+		  sym = cadr(head);
+		}
+	      else
+		if (((car(head) == sc->unlet_symbol) || (car(head) == sc->rootlet_symbol)) && (is_pair(cdr(car_x)))) /* ((unlet) :abs) */
+		  {
+		    sym = cadr(car_x);
+		    if ((is_symbol_and_keyword(sym)) || (is_quoted_symbol(sym)))
+		      return(opt_unlet_rootlet_ref(sc, alloc_opt_info(sc), head, (is_pair(sym)) ? cadr(sym) : keyword_symbol(sym), car_x));
+		    return_false(sc, car_x);
+		  }
+		else return_false(sc, car_x);
+	    if ((is_symbol(let)) && ((is_symbol_and_keyword(sym)) || (is_quoted_symbol(sym))))
+	      {
+		slot = s7_slot(sc, let);
+		if (!is_slot(slot)) return_false(sc, car_x);
+		let = slot_value(slot);
+		if ((!is_let(let)) || (has_let_ref_fallback(let))) return_false(sc, car_x);
+		sym = (is_pair(sym)) ? cadr(sym) : keyword_symbol(sym);
+		s_func = let_ref_p_pp(sc, let, sym);
+	      }
+	    else return_false(sc, car_x);
+	  }
+	else return_false(sc, car_x);
+      }
+  if (is_c_function(s_func))
+    {
+      opt_info *opc = alloc_opt_info(sc);
+      switch (len)
+	{
+	case 1: return(p_ok(sc, opc, s_func, car_x));
+
+	case 2: return((p_i_ok(sc, opc, s_func, car_x, sc->pc)) ||
+		       (p_d_ok(sc, opc, s_func, car_x, sc->pc)) ||
+		       (p_p_ok(sc, opc, s_func, car_x)));
+
+	case 3: return(p_2x_ok(sc, opc, s_func, car_x, sc->pc, expr));
+	case 4: return(p_3x_ok(sc, opc, s_func, car_x, sc->pc, expr));
+	case 5: return(p_4x_ok(sc, opc, s_func, car_x, sc->pc, expr));
+
+	case 6: if (p_5x_ok(sc, opc, s_func, car_x, sc->pc, expr)) return_true(sc, car_x);
+	  /* fall through */
+
+	default: return(p_call_any_ok(sc, opc, s_func, car_x, len)); /* >3D vector-set etc */
+	}}
+  else
+    {
+      if (is_closure(s_func))
+	{
+	  opt_info *opc = alloc_opt_info(sc);
+	  if (p_fx_any_ok(sc, opc, expr))
+	    return_true(sc, car_x);
+	}
+      if (is_macro(s_func))
+	return_false(sc, car_x); /* macroexpand+cell_optimize here restarts the optimize process */
+      if (!s_slot) return_false(sc, car_x);
+#if OPT_PRINT
+      {
+	bool res = p_implicit_ok(sc, s_slot, car_x, len);
+	if (!res) fprintf(stderr, "   %sno p_implicit for %s%s\n", bold_text red_text, display(car_x), unbold_text uncolor_text);
+	return(res);
+      }
+#else
+      return(p_implicit_ok(sc, s_slot, car_x, len));
+#endif
+    }
+  return_false(sc, car_x);
+}
+
+static bool cell_optimize(s7_scheme *sc, s7_pointer expr) {return((cell_optimize_1(sc, expr)) && (sc->pc < OPTS_SIZE));}
+
+static bool bool_optimize_nw_1(s7_scheme *sc, s7_pointer expr)
+{
+  s7_pointer car_x = car(expr), head, s_func = NULL;
+  s7_int len;
+  if (!is_pair(car_x)) /* wrap constants/symbols */
+    return(opt_bool_not_pair(sc, car_x));
+
+  head = car(car_x);
+  len = s7_list_length(sc, car_x);
+  if (is_symbol(head))
+    {
+      if ((is_syntactic_symbol(head)) ||
+	  (is_syntactic_pair(car_x)))
+	{
+	  if (head == sc->and_symbol)
+	    return(opt_b_and(sc, car_x, len));
+	  if (head == sc->or_symbol)
+	    return(opt_b_or(sc, car_x, len));
+	  return_false(sc, car_x);
+	}
+      s_func = lookup_unexamined(sc, head);
+    }
+  else
+    if (is_c_function(head))
+      s_func = head;
+    else return_false(sc, car_x);
+
+  if (!s_func) return_false(sc, car_x);
+  if (is_c_function(s_func))
+    {
+      if ((is_symbol(head)) && (symbol_id(head) != 0))  /* (float-vector? (block)) -- both safe c_funcs, but this is a method invocation */
+	return_false(sc, car_x);
+      switch (len)
+	{
+	case 2:
+	  return(b_idp_ok(sc, s_func, car_x, opt_arg_type(sc, cdr(car_x))));
+
+	case 3:
+	  {
+	    s7_pointer arg1 = cadr(car_x), arg2 = caddr(car_x);
+	    s7_pointer sig1 = opt_arg_type(sc, cdr(car_x));
+	    s7_pointer sig2 = opt_arg_type(sc, cddr(car_x));
+	    opt_info *opc = alloc_opt_info(sc);
+	    int32_t cur_index = sc->pc;
+	    s7_b_7pp_t bpf7 = NULL;
+	    s7_b_pp_t bpf;
+
+	    if ((sig2 == sc->is_integer_symbol) || (sig2 == sc->is_byte_symbol))
+	      {
+		if (((sig1 == sc->is_integer_symbol) || (sig1 == sc->is_byte_symbol)) &&
+		    (b_ii_ok(sc, opc, s_func, car_x, arg1, arg2)))
+		  return_true(sc, car_x);
+		sc->pc = cur_index;
+		if (b_pi_ok(sc, opc, s_func, car_x, arg2))
+		  return_true(sc, car_x);
+		sc->pc = cur_index;
+	      }
+
+	    if ((sig1 == sc->is_float_symbol) &&
+		(sig2 == sc->is_float_symbol) &&
+		(b_dd_ok(sc, opc, s_func, car_x, arg1, arg2)))
+	      return_true(sc, car_x);
+	    sc->pc = cur_index;
+
+	    bpf = s7_b_pp_function(s_func);
+	    if (!bpf) bpf7 = s7_b_7pp_function(s_func);
+	    if ((bpf) || (bpf7))
+	      {
+		if (bpf)
+		  opc->v[3].b_pp_f = bpf;
+		else opc->v[3].b_7pp_f = bpf7;
+		return(b_pp_ok(sc, opc, s_func, car_x, arg1, arg2, bpf));
+	      }}
+	  break;
+
+	default: break;
+	}}
+  return_false(sc, car_x);
+}
+
+static bool bool_optimize_nw(s7_scheme *sc, s7_pointer expr) {return((bool_optimize_nw_1(sc, expr)) && (sc->pc < OPTS_SIZE));}
+
+static bool bool_optimize(s7_scheme *sc, s7_pointer expr)
+{
+  int32_t start = sc->pc;
+  opt_info *wrapper;
+  if (OPT_PRINT) fprintf(stderr, "     bool_optimize %s\n", display(expr));
+  if (WITH_GMP) return(false);
+  if (bool_optimize_nw(sc, expr))
+    return_true(sc, expr);
+  sc->pc = start;
+  wrapper = sc->opts[start];
+  if (!cell_optimize(sc, expr))
+    return_false(sc, expr);
+  if (wrapper->v[O_WRAP].fp) /* (when (+ i 1) ...) */
+    return_false(sc, expr);
+  wrapper->v[O_WRAP].fp = wrapper->v[0].fp;
+  wrapper->v[0].fb = p_to_b;
+  return_true(sc, expr);
+}
+
+static s7_pfunc s7_bool_optimize(s7_scheme *sc, s7_pointer expr)
+{
+  sc->pc = 0;
+  if ((bool_optimize(sc, expr)) && (sc->pc < OPTS_SIZE))
+    return_success(sc, opt_bool_any, expr);
+  return_null(sc, expr);
+}
+
+static s7_double opt_float_any(s7_scheme *sc) {return(sc->opts[0]->v[0].fd(sc->opts[0]));} /* for snd-sig.c */
+
+s7_float_function s7_float_optimize(s7_scheme *sc, s7_pointer expr)
+{
+  sc->pc = 0;
+  if ((float_optimize(sc, expr)) && (sc->pc < OPTS_SIZE))
+    return(opt_float_any);
+  return(NULL); /* can't return_null(sc, expr) here due to type mismatch (s7_pfunc vs s7_float_function) */
+}
+
+static s7_pfunc s7_optimize_1(s7_scheme *sc, s7_pointer expr, bool nv)
+{
+  if (WITH_GMP) return(NULL);
+  if ((!is_pair(expr)) || (no_cell_opt(expr)) || (sc->debug != 0))
+    return_null(sc, expr);
+  sc->pc = 0;
+  if (!no_int_opt(expr))
+    {
+      if (int_optimize(sc, expr))
+	return_success(sc, (nv) ? opt_int_any_nv : opt_make_int, expr);
+      sc->pc = 0;
+      set_no_int_opt(expr);
+    }
+  if (!no_float_opt(expr))
+    {
+      if (float_optimize(sc, expr))
+	return_success(sc, (nv) ? opt_float_any_nv : opt_make_float, expr);
+      sc->pc = 0;
+      set_no_float_opt(expr);
+    }
+  if (!no_bool_opt(expr))
+    {
+      if (bool_optimize_nw(sc, expr))
+	return_success(sc, (nv) ? opt_bool_any_nv : opt_wrap_bool, expr);
+      sc->pc = 0;
+      set_no_bool_opt(expr);
+    }
+  if (cell_optimize(sc, expr))
+    return_success(sc, (nv) ? opt_cell_any_nv : opt_wrap_cell, expr);
+  set_no_cell_opt(expr); /* checked above */
+  return_null(sc, expr);
+}
+
+s7_pfunc s7_optimize(s7_scheme *sc, s7_pointer expr)           {return(s7_optimize_1(sc, expr, false));}
+static s7_pfunc s7_optimize_nv(s7_scheme *sc, s7_pointer expr) {return(s7_optimize_1(sc, expr, true));}
+
+static s7_pointer g_optimize(s7_scheme *sc, s7_pointer args)
+{
+  s7_pfunc f;
+  s7_pointer code = car(args), result = sc->undefined;
+  gc_protect_via_stack(sc, code);
+  f = s7_optimize(sc, code);
+  if (f) result = f(sc);
+  if (stack_top_op(sc) == OP_GC_PROTECT) unstack_gc_protect(sc);
+  return(result);
+}
+
+static s7_pfunc s7_cell_optimize(s7_scheme *sc, s7_pointer expr, bool nv)
+{
+  sc->pc = 0;
+  if ((cell_optimize(sc, expr)) && (sc->pc < OPTS_SIZE))
+    return((nv) ? opt_cell_any_nv : opt_wrap_cell);
+  return_null(sc, expr);
+}
+
+
+/* ---------------- bool funcs (an experiment) ---------------- */
+static void fx_curlet_tree(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer slot1 = let_slots(sc->curlet), slot3 = NULL, outer_e;
+  bool more_vars;
+  s7_pointer slot2 = next_slot(slot1);
+  if (tis_slot(slot2)) slot3 = next_slot(slot2);
+
+  more_vars = (tis_slot(slot3)) && (tis_slot(next_slot(slot3)));
+  fx_tree(sc, code,
+	  slot_symbol(slot1),
+	  (tis_slot(slot2)) ? slot_symbol(slot2) : NULL,
+	  (tis_slot(slot3)) ? slot_symbol(slot3) : NULL,
+	  more_vars);
+
+  outer_e = let_outlet(sc->curlet);
+  if ((!more_vars) &&
+      (is_let(outer_e)) &&
+      (!is_funclet(outer_e)) &&
+      (tis_slot(let_slots(outer_e))) &&
+      (slot_symbol(let_slots(outer_e)) != slot_symbol(slot1)))
+    {
+      slot1 = let_slots(outer_e);
+      slot2 = next_slot(slot1);
+      slot3 = (tis_slot(slot2)) ? next_slot(slot2) : NULL;
+      fx_tree_outer(sc, code,
+		    slot_symbol(slot1),
+		    (tis_slot(slot2)) ? slot_symbol(slot2) : NULL,
+		    (tis_slot(slot3)) ? slot_symbol(slot3) : NULL,
+		    (tis_slot(slot3)) && (tis_slot(next_slot(slot3))));
+    }
+}
+
+static void fx_curlet_tree_in(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer slot1 = let_slots(sc->curlet), slot3 = NULL;
+  s7_pointer slot2 = next_slot(slot1);
+  if (tis_slot(slot2)) slot3 = next_slot(slot2);
+  fx_tree_in(sc, code,
+	  slot_symbol(slot1),
+	  (tis_slot(slot2)) ? slot_symbol(slot2) : NULL,
+	  (tis_slot(slot3)) ? slot_symbol(slot3) : NULL,
+	  (tis_slot(slot3)) && (tis_slot(next_slot(slot3))));
+}
+
+typedef bool (*s7_bfunc)(s7_scheme *sc, s7_pointer expr); /* used in eval */
+
+static bool fb_lt_ss(s7_scheme *sc, s7_pointer expr)
+{
+  s7_pointer x = lookup(sc, cadr(expr));
+  s7_pointer y = lookup(sc, opt2_sym(cdr(expr)));
+  return(((is_t_integer(x)) && (is_t_integer(y))) ? (integer(x) < integer(y)) : lt_b_7pp(sc, x, y));
+}
+
+static bool fb_lt_ts(s7_scheme *sc, s7_pointer expr)
+{
+  s7_pointer x = t_lookup(sc, cadr(expr), expr);
+  s7_pointer y = lookup(sc, opt2_sym(cdr(expr)));
+  return(((is_t_integer(x)) && (is_t_integer(y))) ? (integer(x) < integer(y)) : lt_b_7pp(sc, x, y));
+}
+
+static bool fb_num_eq_ss(s7_scheme *sc, s7_pointer expr)
+{
+  s7_pointer x = lookup(sc, cadr(expr));
+  s7_pointer y = lookup(sc, opt2_sym(cdr(expr)));
+  return(((is_t_integer(x)) && (is_t_integer(y))) ? (integer(x) == integer(y)) : num_eq_b_7pp(sc, x, y));
+}
+
+static bool fb_num_eq_s0(s7_scheme *sc, s7_pointer expr)
+{
+  s7_pointer x = lookup(sc, cadr(expr));
+  return((is_t_integer(x)) ? (integer(x) == 0) : num_eq_b_7pp(sc, x, int_zero));
+}
+
+static bool fb_num_eq_s0f(s7_scheme *sc, s7_pointer expr)
+{
+  s7_pointer x = lookup(sc, cadr(expr));
+  return((is_t_real(x)) ? (real(x) == 0.0) : num_eq_b_7pp(sc, x, real_zero));
+}
+
+static bool fb_gt_tu(s7_scheme *sc, s7_pointer expr)
+{
+  s7_pointer x = t_lookup(sc, cadr(expr), expr), y = u_lookup(sc, opt2_sym(cdr(expr)), expr);
+  return(((is_t_integer(x)) && (is_t_integer(y))) ? (integer(x) > integer(y)) : gt_b_7pp(sc, x, y));
+}
+
+static bool fb_gt_ss(s7_scheme *sc, s7_pointer expr)
+{
+  s7_pointer x = s_lookup(sc, cadr(expr), expr);
+  s7_pointer y = s_lookup(sc, opt2_sym(cdr(expr)), expr);
+  return(((is_t_integer(x)) && (is_t_integer(y))) ? (integer(x) > integer(y)) : gt_b_7pp(sc, x, y));
+}
+
+static bool fb_geq_ss(s7_scheme *sc, s7_pointer expr)
+{
+  s7_pointer x = s_lookup(sc, cadr(expr), expr);
+  s7_pointer y = s_lookup(sc, opt2_sym(cdr(expr)), expr);
+  return(((is_t_integer(x)) && (is_t_integer(y))) ? (integer(x) >= integer(y)) : geq_b_7pp(sc, x, y));
+}
+
+static bool fb_leq_ss(s7_scheme *sc, s7_pointer expr)
+{
+  s7_pointer x = s_lookup(sc, cadr(expr), expr);
+  s7_pointer y = s_lookup(sc, opt2_sym(cdr(expr)), expr);
+  return(((is_t_integer(x)) && (is_t_integer(y))) ? (integer(x) <= integer(y)) : leq_b_7pp(sc, x, y));
+}
+
+static bool fb_leq_ti(s7_scheme *sc, s7_pointer expr)
+{
+  s7_pointer x = t_lookup(sc, cadr(expr), expr);
+  if (is_t_integer(x)) return(integer(x) <= integer(opt2_con(cdr(expr))));
+  return(g_leq_xi(sc, set_plist_2(sc, x, opt2_con(cdr(expr)))));
+}
+
+static bool fb_leq_ui(s7_scheme *sc, s7_pointer expr)
+{
+  s7_pointer x = u_lookup(sc, cadr(expr), expr);
+  if (is_t_integer(x)) return(integer(x) <= integer(opt2_con(cdr(expr))));
+  return(g_leq_xi(sc, set_plist_2(sc, x, opt2_con(cdr(expr)))));
+}
+
+static s7_pointer fx_to_fb(s7_scheme *sc, s7_function fx) /* eventually parallel arrays? */
+{
+  if (fx == fx_num_eq_ss) return((s7_pointer)fb_num_eq_ss);
+  if (fx == fx_lt_ss) return((s7_pointer)fb_lt_ss);
+  if (fx == fx_lt_ts) return((s7_pointer)fb_lt_ts);
+  if (fx == fx_gt_ss) return((s7_pointer)fb_gt_ss);
+  if (fx == fx_leq_ss) return((s7_pointer)fb_leq_ss);
+  if (fx == fx_leq_ti) return((s7_pointer)fb_leq_ti);
+  if (fx == fx_leq_ui) return((s7_pointer)fb_leq_ui);
+  if (fx == fx_geq_ss) return((s7_pointer)fb_geq_ss);
+  if (fx == fx_gt_tu) return((s7_pointer)fb_gt_tu);
+  if (fx == fx_num_eq_s0) return((s7_pointer)fb_num_eq_s0);
+  if (fx == fx_num_eq_s0f) return((s7_pointer)fb_num_eq_s0f);
+  return(NULL);
+}
+
+static void fb_annotate(s7_scheme *sc, s7_pointer form, s7_pointer fx_expr, opcode_t op)
+{
+  s7_pointer bfunc;
+  if ((is_fx_treeable(cdr(form))) && (tis_slot(let_slots(sc->curlet)))) fx_curlet_tree(sc, cdr(form)); /* and not already treed? just the one expr? */
+  bfunc = fx_to_fb(sc, fx_proc(fx_expr));
+  if (bfunc)
+    {
+      set_opt3_any(cdr(form), bfunc);
+      pair_set_syntax_op(form, op);
+    }
+#if 0
+  /* fb_annotate additions? [these currently require new "B" ops] */
+  else
+    {
+      fprintf(stderr, "fx: %s %s\n", ((is_pair(fx_expr)) && (is_pair(car(fx_expr)))) ? op_names[optimize_op(car(fx_expr))] : "", display_truncated(fx_expr));
+      if (caar(fx_expr) == sc->num_eq_symbol) abort();
+      /* [fx_leq_ti] fx_lt_t0 fx_gt_ti fx_num_eq_u0 */
+    }
+#endif
+}
+
+/* when_b cond? do end-test? num_eq_vs|us */
+
+
+/* ---------------------------------------- for-each ---------------------------------------- */
+static Inline s7_pointer inline_make_counter(s7_scheme *sc, s7_pointer iter) /* all calls are hit about the same: lg/sg */
+{
+  s7_pointer x;
+  new_cell(sc, x, T_COUNTER);
+  counter_set_result(x, sc->nil);
+  if ((S7_DEBUGGING) && (!is_iterator(iter)) && (!is_pair(iter))) fprintf(stderr, "%s[%d]: %s?\n", __func__, __LINE__, display(iter));
+  counter_set_list(x, iter);        /* iterator -- here it's always either an iterator or a pair */
+  counter_set_capture(x, 0);        /* will be capture_let_counter */
+  counter_set_let(x, sc->rootlet);  /* will be the saved let */
+  counter_set_slots(x, sc->nil);    /* local let slots before body is evalled */
+  stack_set_has_counters(sc->stack);
+  return(x);
+}
+
+static s7_pointer make_iterators(s7_scheme *sc, s7_pointer caller, s7_pointer args)
+{
+  s7_pointer p = cdr(args);
+  sc->temp3 = args;
+  sc->z = sc->nil;               /* don't use sc->args here -- it needs GC protection until we get the iterators */
+  for (s7_int i = 2; is_pair(p); p = cdr(p), i++)
+    {
+      s7_pointer iter = car(p);
+      if (!is_iterator(iter))
+	{
+	  if (!is_mappable(iter))
+	    wrong_type_error_nr(sc, caller, i, iter, a_sequence_string);
+	  iter = s7_make_iterator(sc, iter);
+	}
+      sc->z = cons(sc, iter, sc->z);
+    }
+  sc->temp3 = sc->unused;
+  return(proper_list_reverse_in_place(sc, sc->z));
+}
+
+static s7_pointer seq_init(s7_scheme *sc, s7_pointer seq)
+{
+  if (is_float_vector(seq)) return(real_zero);
+  if (is_string(seq)) return(chars[65]);
+  if ((is_int_vector(seq)) || (is_byte_vector(seq))) return(int_zero);
+  return(sc->F);
+}
+
+#define MUTLIM 32 /* was 1000, sets when (in vector-length) to start using a mutated real, rather than make_real during the loop through the vector */
+
+static s7_pointer clear_for_each(s7_scheme *sc)
+{
+  sc->map_call_ctr--;
+  unstack_with(sc, OP_MAP_UNWIND);
+  return(sc->unspecified);
+}
+
+static s7_pointer g_for_each_closure(s7_scheme *sc, s7_pointer f, s7_pointer seq) /* one sequence arg */
+{
+  s7_pointer body = closure_body(f);
+  if (!no_cell_opt(body)) /* if at top level we often get an unoptimized (not safe) function here that can be cell_optimized below */
+    {
+      s7_pfunc func = NULL;
+      s7_pointer old_e = sc->curlet, pars = closure_args(f), val, slot, res = NULL;
+
+      val = seq_init(sc, seq);
+      set_curlet(sc, inline_make_let_with_slot(sc, closure_let(f), (is_pair(car(pars))) ? caar(pars) : car(pars), val));
+      slot = let_slots(sc->curlet);
+
+      if (sc->map_call_ctr == 0)
+	{
+	  if (is_null(cdr(body)))
+	    func = s7_optimize_nv(sc, body);
+	  else
+	    if (is_null(cddr(body))) /* 3 sometimes works */
+	      {
+		set_ulist_1(sc, sc->begin_symbol, body);
+		func = s7_cell_optimize(sc, set_clist_1(sc, sc->u1_1), true); /* was list_1 via cons 8-Apr-21, true=nr */
+	      }}
+
+      if (func)
+	{
+	  push_stack_no_let(sc, OP_MAP_UNWIND, f, seq);
+	  sc->map_call_ctr++;
+	  if (is_pair(seq))
+	    {
+	      for (s7_pointer x = seq, y = x; is_pair(x); )
+		{
+		  slot_set_value(slot, car(x));
+		  func(sc);
+		  x = cdr(x);
+		  if (is_pair(x))
+		    {
+		      slot_set_value(slot, car(x));
+		      func(sc);
+		      x = cdr(x);
+		      y = cdr(y);
+		      if (x == y) break;
+		    }}
+	      res = sc->unspecified;
+	    }
+	  else
+	    if (is_float_vector(seq))
+	      {
+		s7_double *vals = float_vector_floats(seq);
+		s7_int i, len = vector_length(seq);
+		if ((len > MUTLIM) &&
+		    (!tree_has_setters(sc, body)))
+		  {
+		    s7_pointer sv = wrapped_real(sc); /* make_mutable_real(sc, 0.0) 16-Nov-23 */
+		    slot_set_value(slot, sv);
+		    if (func == opt_float_any_nv)
+		      {
+			opt_info *o = sc->opts[0];
+			s7_double (*fd)(opt_info *o) = o->v[0].fd;
+			for (i = 0; i < len; i++) {set_real(sv, vals[i]); fd(o);}}
+		    else
+		      if (func == opt_cell_any_nv)
+			{
+			  opt_info *o = sc->opts[0];
+			  s7_pointer (*fp)(opt_info *o) = o->v[0].fp;
+			  if (fp == opt_unless_p_1)
+			    for (i = 0; i < len; i++) {set_real(sv, vals[i]); if (!(o->v[4].fb(o->v[3].o1))) o->v[5].o1->v[0].fp(o->v[5].o1);}
+			  else for (i = 0; i < len; i++) {set_real(sv, vals[i]); fp(o);}
+			}
+		      else for (i = 0; i < len; i++) {set_real(sv, vals[i]); func(sc);}
+		  }
+		else for (i = 0; i < len; i++) {slot_set_value(slot, make_real(sc, vals[i])); func(sc);}
+		res = sc->unspecified;
+	      }
+	    else
+	      if (is_int_vector(seq))
+		{
+		  s7_int *vals = int_vector_ints(seq);
+		  s7_int i, len = vector_length(seq);
+		  if ((len > MUTLIM) &&
+		      (!tree_has_setters(sc, body)))
+		    {
+		      s7_pointer sv = wrapped_integer(sc); /* make_mutable_integer(sc, 0) */
+		      slot_set_value(slot, sv);
+		      /* since there are no setters, the inner step is also mutable if there is one.
+		       *    func=opt_cell_any_nv, sc->opts[0]->v[0].fp(sc->opts[0]) fp=opt_do_1 -> mutable version
+		       */
+		      if (func == opt_int_any_nv)
+			{
+			  opt_info *o = sc->opts[0];
+			  s7_int (*fi)(opt_info *o) = o->v[0].fi;
+			  for (i = 0; i < len; i++) {set_integer(sv, vals[i]); fi(o);}
+			}
+		      else for (i = 0; i < len; i++) {set_integer(sv, vals[i]); func(sc);}
+		    }
+		  else for (i = 0; i < len; i++) {slot_set_value(slot, make_integer(sc, vals[i])); func(sc);}
+		  res = sc->unspecified;
+		}
+	      else
+		if (is_t_vector(seq))
+		  {
+		    s7_pointer *vals = vector_elements(seq);
+		    s7_int i, len = vector_length(seq);
+		    if (func == opt_cell_any_nv)
+		      {
+			opt_info *o = sc->opts[0];
+			s7_pointer (*fp)(opt_info *o) = o->v[0].fp;
+			for (i = 0; i < len; i++) {slot_set_value(slot, vals[i]); fp(o);}}
+		    else for (i = 0; i < len; i++) {slot_set_value(slot, vals[i]); func(sc);}
+		    res = sc->unspecified;
+		  }
+		else
+		  if (is_string(seq))
+		    {
+		      const char *str = string_value(seq);
+		      s7_int len = string_length(seq);
+		      for (s7_int i = 0; i < len; i++) {slot_set_value(slot, chars[(uint8_t)(str[i])]); func(sc);}
+		      res = sc->unspecified;
+		    }
+		  else
+		    if (is_byte_vector(seq))
+		      {
+			const uint8_t *vals = (const uint8_t *)byte_vector_bytes(seq);
+			s7_int i, len = vector_length(seq);
+			if (func == opt_int_any_nv)
+			  {
+			    opt_info *o = sc->opts[0];
+			    s7_int (*fi)(opt_info *o) = o->v[0].fi;
+			    for (i = 0; i < len; i++) {slot_set_value(slot, small_int(vals[i])); fi(o);}}
+			else for (i = 0; i < len; i++) {slot_set_value(slot, small_int(vals[i])); func(sc);}
+			res = sc->unspecified;
+		      }
+	  if (res)
+	    return(clear_for_each(sc));
+	  if (!is_iterator(seq))
+	    {
+	      if (!is_mappable(seq))
+		wrong_type_error_nr(sc, sc->for_each_symbol, 2, seq, a_sequence_string);
+	      seq = s7_make_iterator(sc, seq);
+	      set_map_iterator(sc, seq); /* GC protect new iterator */
+	    }
+	  /* push_stack_no_let(sc, OP_GC_PROTECT, seq, f); */
+	  if (func == opt_cell_any_nv)
+	    {
+	      opt_info *o = sc->opts[0];
+	      s7_pointer (*fp)(opt_info *o) = o->v[0].fp;
+	      while (true)
+		{
+		  slot_set_value(slot, s7_iterate(sc, seq));
+		  if (iterator_is_at_end(seq)) return(clear_for_each(sc));
+		  fp(o);
+		}}
+	  if (func == opt_int_any_nv)
+	    {
+	      opt_info *o = sc->opts[0];
+	      s7_int (*fi)(opt_info *o) = o->v[0].fi;
+	      while (true)
+		{
+		  slot_set_value(slot, s7_iterate(sc, seq));
+		  if (iterator_is_at_end(seq)) return(clear_for_each(sc));
+		  fi(o);
+		}}
+	  while (true)
+	    {
+	      slot_set_value(slot, s7_iterate(sc, seq));
+	      if (iterator_is_at_end(seq)) return(clear_for_each(sc));
+	      func(sc);
+	    }} /* we never get here -- the while loops above exit via return #<unspecified> */
+      else /* not func -- unneeded "else" but otherwise confusing code */
+	{
+	  set_no_cell_opt(body);
+	  set_curlet(sc, old_e);
+	}}
+  if ((!is_closure_star(f)) && /* for simplicity in op_for_each_2 (otherwise we need to check for default arg) */
+      (is_null(cdr(body))) &&
+      (is_pair(seq)))
+    {
+      s7_pointer c = inline_make_counter(sc, seq);
+      counter_set_result(c, seq);
+      push_stack(sc, OP_FOR_EACH_2, c, f);
+      return(sc->unspecified);
+    }
+
+  if (!is_iterator(seq))
+    {
+      if (!is_mappable(seq))
+	wrong_type_error_nr(sc, sc->for_each_symbol, 2, seq, a_sequence_string);
+      sc->z = s7_make_iterator(sc, seq);
+    }
+  else sc->z = seq;
+  push_stack(sc, OP_FOR_EACH_1, inline_make_counter(sc, sc->z), f);
+  sc->z = sc->unused;
+  return(sc->unspecified);
+}
+
+static void map_or_for_each_closure_pair_2(s7_scheme *sc, s7_pfunc func, s7_pointer seq1, s7_pointer seq2, s7_pointer slot1, s7_pointer slot2, bool for_each_case)
+{
+  for (s7_pointer fast1 = seq1, slow1 = seq1, fast2 = seq2, slow2 = seq2; (is_pair(fast1)) && (is_pair(fast2));
+       fast1 = cdr(fast1), slow1 = cdr(slow1), fast2 = cdr(fast2), slow2 = cdr(slow2))
+    {
+      slot_set_value(slot1, car(fast1));
+      slot_set_value(slot2, car(fast2));
+      if (for_each_case)
+	func(sc);
+      else
+	{
+	  s7_pointer val = func(sc);
+	  if (val != sc->no_value)
+	    set_map_unwind_list(sc, cons(sc, val, map_unwind_list(sc))); /* see map_closure_2 below -- gc_protected3 is our temp */
+	}
+      if ((is_pair(cdr(fast1))) && (is_pair(cdr(fast2))))
+	{
+	  fast1 = cdr(fast1);
+	  if (fast1 == slow1) break;
+	  fast2 = cdr(fast2);
+	  if (fast2 == slow2) break;
+	  slot_set_value(slot1, car(fast1));
+	  slot_set_value(slot2, car(fast2));
+	  if (for_each_case)
+	    func(sc);
+	  else
+	    {
+	      s7_pointer val = func(sc);
+	      if (val != sc->no_value)
+		set_map_unwind_list(sc, cons(sc, val, map_unwind_list(sc)));
+	    }}}
+}
+
+static void map_or_for_each_closure_vector_2(s7_scheme *sc, s7_pfunc func, s7_pointer seq1, s7_pointer seq2, s7_pointer slot1, s7_pointer slot2, bool for_each_case)
+{
+  s7_int len = vector_length(seq1);
+  if (len > vector_length(seq2)) len = vector_length(seq2);
+  for (s7_int i = 0; i < len; i++)
+    {
+      slot_set_value(slot1, vector_getter(seq1)(sc, seq1, i));
+      slot_set_value(slot2, vector_getter(seq2)(sc, seq2, i));
+      if (for_each_case)
+	func(sc);
+      else
+	{
+	  s7_pointer val = func(sc);
+	  if (val != sc->no_value)
+	    set_map_unwind_list(sc, cons(sc, val, map_unwind_list(sc)));
+	}}
+}
+
+static void map_or_for_each_closure_string_2(s7_scheme *sc, s7_pfunc func, s7_pointer seq1, s7_pointer seq2, s7_pointer slot1, s7_pointer slot2, bool for_each_case)
+{
+  s7_int len = string_length(seq1);
+  const char *s1 = string_value(seq1), *s2 = string_value(seq2);
+  if (len > string_length(seq2)) len = string_length(seq2);
+  for (s7_int i = 0; i < len; i++)
+    {
+      slot_set_value(slot1, chars[(uint8_t)(s1[i])]);
+      slot_set_value(slot2, chars[(uint8_t)(s2[i])]);
+      if (for_each_case)
+	func(sc);
+      else
+	{
+	  s7_pointer val = func(sc);
+	  if (val != sc->no_value)
+	    set_map_unwind_list(sc, cons(sc, val, map_unwind_list(sc)));
+	}}
+}
+
+static s7_pointer g_for_each_closure_2(s7_scheme *sc, s7_pointer f, s7_pointer seq1, s7_pointer seq2)
+{
+  s7_pointer body = closure_body(f);
+  if (!no_cell_opt(body))
+    {
+      s7_pfunc func = NULL;
+      s7_pointer olde = sc->curlet, pars = closure_args(f), slot1, slot2;
+      s7_pointer val1 = seq_init(sc, seq1);
+      s7_pointer val2 = seq_init(sc, seq2);
+      set_curlet(sc, make_let_with_two_slots(sc, closure_let(f),
+					    (is_pair(car(pars))) ? caar(pars) : car(pars), val1,
+					    (is_pair(cadr(pars))) ? cadar(pars) : cadr(pars), val2));
+      slot1 = let_slots(sc->curlet);
+      slot2 = next_slot(slot1);
+
+      if (sc->map_call_ctr == 0)
+	{
+	  if (is_null(cdr(body)))
+	    func = s7_optimize_nv(sc, body);
+	  else
+	    if (is_null(cddr(body)))
+	      {
+		set_ulist_1(sc, sc->begin_symbol, body);
+		func = s7_cell_optimize(sc, set_clist_1(sc, sc->u1_1), true);
+	      }}
+
+      if (func)
+	{
+	  s7_pointer res = NULL;
+	  push_stack_no_let(sc, OP_MAP_UNWIND, f, seq1);
+	  sc->map_call_ctr++;
+	  if ((is_pair(seq1)) && (is_pair(seq2)))
+	    {
+	      map_or_for_each_closure_pair_2(sc, func, seq1, seq2, slot1, slot2, true);
+	      res = sc->unspecified;
+	    }
+	  else
+	    if ((is_any_vector(seq1)) && (is_any_vector(seq2)))
+	      {
+		map_or_for_each_closure_vector_2(sc, func, seq1, seq2, slot1, slot2, true);
+		res = sc->unspecified;
+	      }
+	    else
+	      if ((is_string(seq1)) && (is_string(seq2)))
+		{
+		  map_or_for_each_closure_string_2(sc, func, seq1, seq2, slot1, slot2, true);
+		  res = sc->unspecified;
+		}
+	  sc->map_call_ctr--;
+	  unstack_with(sc, OP_MAP_UNWIND);
+	  set_curlet(sc, olde);
+	  if (res) return(res);
+	  set_no_cell_opt(body);
+	}
+      else /* not func */
+	{
+	  set_no_cell_opt(body);
+	  set_curlet(sc, olde);
+	}}
+
+  if (!is_iterator(seq1))
+    {
+      if (!is_mappable(seq1))
+	wrong_type_error_nr(sc, sc->for_each_symbol, 2, seq1, a_sequence_string);
+      sc->z = s7_make_iterator(sc, seq1);
+    }
+  else sc->z = seq1;
+  if (!is_iterator(seq2))
+    {
+      if (!is_mappable(seq2))
+	wrong_type_error_nr(sc, sc->for_each_symbol, 3, seq2, a_sequence_string);
+      sc->z = list_2(sc, sc->z, s7_make_iterator(sc, seq2));
+    }
+  else sc->z = list_2(sc, sc->z, seq2);
+  push_stack(sc, OP_FOR_EACH, cons_unchecked(sc, sc->z, make_list(sc, 2, sc->nil)), f);
+  sc->z = sc->unused;
+  return(sc->unspecified);
+}
+
+static inline bool for_each_arg_is_null(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer p = args;
+  bool got_nil = false;
+  for (s7_int i = 2; is_pair(p); p = cdr(p), i++)
+    {
+      s7_pointer obj = car(p);
+      if (!is_mappable(obj))
+	{
+	  if (is_null(obj))
+	    got_nil = true;
+	  else wrong_type_error_nr(sc, sc->for_each_symbol, i, obj, a_sequence_string);
+	}}
+  return(got_nil);
+}
+
+static s7_pointer g_for_each(s7_scheme *sc, s7_pointer args)
+{
+  #define H_for_each "(for-each proc object . objects) applies proc to each element of the objects traversed in parallel. \
+Each object can be a list, string, vector, hash-table, or any other sequence."
+  #define Q_for_each s7_make_circular_signature(sc, 2, 3, sc->is_unspecified_symbol, sc->is_procedure_symbol, sc->is_sequence_symbol)
+
+  s7_pointer f = car(args);
+  s7_int len = proper_list_length(cdr(args));
+  bool arity_ok = false;
+
+  /* try the normal case first */
+  sc->value = f;
+  if (is_closure(f))                            /* not lambda* that might get confused about arg names */
+    {
+      if ((len == 1) &&
+	  (is_pair(closure_args(f))) &&
+	  (is_null(cdr(closure_args(f)))))
+	arity_ok = true;
+    }
+  else
+    if (is_c_object(f)) /* see note in g_map; s7_is_aritable can clobber sc->args=plist=args */
+      args = copy_proper_list(sc, args);
+    else
+      if (!is_applicable(f))
+	return(method_or_bust(sc, f, sc->for_each_symbol, args, something_applicable_string, 1));
+
+  if ((!arity_ok) &&
+      (!s7_is_aritable(sc, f, len)))
+    error_nr(sc, sc->wrong_number_of_args_symbol,
+	     set_elist_4(sc, wrap_string(sc, "for-each first argument ~A called with ~D argument~P?", 53), f, wrap_integer(sc, len), wrap_integer(sc, len)));
+
+  if (for_each_arg_is_null(sc, cdr(args))) return(sc->unspecified);
+
+  /* if function is safe c func, do the for-each locally */
+  if (is_safe_c_function(f))
+    {
+      s7_function func;
+      s7_pointer iters;
+
+      s7_p_p_t fp = s7_p_p_function(f);
+      if ((fp) && (len == 1))
+	{
+	  if (is_pair(cadr(args)))
+	    {
+	      for (s7_pointer fast = cadr(args), slow = cadr(args); is_pair(fast); fast = cdr(fast), slow = cdr(slow))
+		{
+		  fp(sc, car(fast));
+		  if (is_pair(cdr(fast)))
+		    {
+		      fast = cdr(fast);
+		      if (fast == slow) break;
+		      fp(sc, car(fast));
+		    }}
+	      return(sc->unspecified);
+	    }
+	  if (is_any_vector(cadr(args)))
+	    {
+	      s7_pointer v = cadr(args);
+	      s7_int vlen = vector_length(v);
+	      if (is_float_vector(v))
+		{
+		  s7_pointer rl = wrapped_real(sc); /* make_mutable_real(sc, 0.0) */
+		  sc->temp7 = rl;
+		  for (s7_int i = 0; i < vlen; i++)
+		    {
+		      set_real(rl, float_vector(v, i));
+		      fp(sc, rl);
+		    }}
+	      else
+		if (is_int_vector(v))
+		  {
+		    s7_pointer iv = wrapped_integer(sc); /* make_mutable_integer(sc, 0) */
+		    sc->temp7 = iv;
+		    for (s7_int i = 0; i < vlen; i++)
+		      {
+			set_integer(iv, int_vector(v, i));
+			fp(sc, iv);
+		      }}
+		else
+		  for (s7_int i = 0; i < vlen; i++)
+		    fp(sc, vector_getter(v)(sc, v, i)); /* LOOP_4 here gains almost nothing */
+	      return(sc->unspecified);
+	    }
+	  if (is_string(cadr(args)))
+	    {
+	      s7_pointer str = cadr(args);
+	      const char *s = string_value(str);
+	      s7_int slen = string_length(str);
+	      for (s7_int i = 0; i < slen; i++) fp(sc, chars[(uint8_t)(s[i])]);
+	      return(sc->unspecified);
+	    }}
+      func = c_function_call(f);    /* presumably this is either display/write, or method call? */
+      sc->z = make_iterators(sc, sc->for_each_symbol, args);
+      sc->z = cons_unchecked(sc, sc->z, make_list(sc, len, sc->nil));
+      push_stack_no_let(sc, OP_GC_PROTECT, sc->args, sc->z); /* temporary GC protection */
+      if (len == 1)
+	{
+	  s7_pointer x = caar(sc->z), y = cdr(sc->z);
+	  sc->z = sc->unused;
+	  while (true)
+	    {
+	      set_car(y, s7_iterate(sc, x));
+	      if (iterator_is_at_end(x))
+		{
+		  /* not pop_stack here since that can clobber sc->code et al, and if this for-each call is
+		   *   being treated as safe, fn_proc(for-each) assumes everywhere that sc->code is left alone.
+		   */
+		  unstack_gc_protect(sc);		  /* free_cell(sc, x); */ /* 16-Jan-19 */
+		  return(sc->unspecified);
+		}
+	      func(sc, y);
+	    }}
+      iters = sc->z;
+      sc->z = sc->unused;
+      while (true)
+	{
+	  for (s7_pointer x = car(iters), y = cdr(iters); is_pair(x); x = cdr(x), y = cdr(y))
+	    {
+	      set_car(y, s7_iterate(sc, car(x)));
+	      if (iterator_is_at_end(car(x)))
+		{
+		  unstack_gc_protect(sc);
+		  return(sc->unspecified);
+		}}
+	  func(sc, cdr(iters));
+	}}
+
+  /* if closure call is straightforward, use OP_FOR_EACH_1 */
+  if ((len == 1) &&
+      (((is_closure(f)) &&
+	(closure_arity_to_int(sc, f) == 1) &&
+	(!is_constant_symbol(sc, car(closure_args(f))))) ||
+       ((is_closure_star(f)) &&
+	(closure_star_arity_to_int(sc, f) == 1) &&
+	(!is_constant_symbol(sc, (is_pair(car(closure_args(f)))) ? caar(closure_args(f)) : car(closure_args(f)))))))
+    return(g_for_each_closure(sc, f, cadr(args)));
+
+  push_stack(sc, OP_FOR_EACH, cons_unchecked(sc, make_iterators(sc, sc->for_each_symbol, args), make_list(sc, len, sc->nil)), f);
+  sc->z = sc->unused;
+  return(sc->unspecified);
+}
+
+static bool op_for_each(s7_scheme *sc)
+{
+  s7_pointer iterators = car(sc->args);
+  s7_pointer saved_args = cdr(sc->args);
+  for (s7_pointer x = saved_args, y = iterators; is_pair(x); x = cdr(x), y = cdr(y))
+    {
+      set_car(x, s7_iterate(sc, car(y)));
+      if (iterator_is_at_end(car(y)))
+	{
+	  sc->value = sc->unspecified;
+	  free_cell(sc, sc->args);
+	  return(true);
+	}}
+  push_stack_direct(sc, OP_FOR_EACH);
+  sc->args = (needs_copied_args(sc->code)) ? copy_proper_list(sc, saved_args) : saved_args;
+  return(false);
+}
+
+/* for-each et al remake the local let, but that's only needed if the local let is exported,
+ *   and that can only happen through make-closure in various guises and curlet.
+ *   owlet captures, but it would require a deliberate error to use it in this context.
+ *   c_objects call object_set_let but that requires a prior curlet or sublet.  So we have
+ *   sc->capture_let_counter that is incremented every time an environment is captured, then
+ *   here we save that ctr, call body, on rerun check ctr, if it has not changed we are safe and
+ *   can reuse let.  But that reuse assumes no new slots were added (by define etc), because
+ *   update_let* only update the symbol_id's they expect, and that can happen even in op_for_each_2.
+ */
+
+static Inline bool inline_op_for_each_1(s7_scheme *sc)  /* called once in eval, case fb gc iter */
+{
+  s7_pointer counter = sc->args, code;
+  s7_pointer p = counter_list(counter);
+  s7_pointer arg = s7_iterate(sc, p);
+  if (iterator_is_at_end(p))
+    {
+      sc->value = sc->unspecified;
+      /* free_cell(sc, counter); */ /* unsafe? */
+      return(true);
+    }
+  code = T_Clo(sc->code);
+  if (counter_capture(counter) != sc->capture_let_counter)
+    {
+      s7_pointer sym = car(closure_args(code));
+      set_curlet(sc, inline_make_let_with_slot(sc, closure_let(code), (is_symbol(sym)) ? sym : car(sym), arg));
+      counter_set_let(counter, sc->curlet);
+      counter_set_slots(counter, let_slots(sc->curlet));
+      counter_set_capture(counter, sc->capture_let_counter);
+    }
+  else
+    {
+      let_set_slots(counter_let(counter), counter_slots(counter)); /* this is needed (unless safe_closure but that costs more to check than this set) */
+      set_curlet(sc, update_let_with_slot(sc, counter_let(counter), arg));
+    }
+  push_stack(sc, OP_FOR_EACH_1, counter, code);
+  sc->code = T_Pair(closure_body(code));
+  return(false);
+}
+
+static Inline bool inline_op_for_each_2(s7_scheme *sc) /* called once in eval, lg set */
+{
+  s7_pointer c = sc->args;
+  s7_pointer lst = counter_list(c);
+  if (!is_pair(lst))  /* '(1 2 . 3) as arg? -- counter_list can be anything here */
+    {
+      sc->value = sc->unspecified;
+      /* free_cell(sc, c); */ /* unsafe? t101-2|4|6|7|9|18|26|34|38 */ /* not sc->args = sc->nil; */
+      return(true);
+    }
+  counter_set_list(c, cdr(lst));
+  if (sc->cur_op == OP_FOR_EACH_3)
+    {
+      counter_set_result(c, cdr(counter_result(c)));
+      if (counter_result(c) == counter_list(c))
+	{
+	  sc->value = sc->unspecified;
+	  free_cell(sc, c);  /* not sc->args = sc->nil; */
+	  return(true);
+	}
+      push_stack_direct(sc, OP_FOR_EACH_2);
+    }
+  else push_stack_direct(sc, OP_FOR_EACH_3);
+  if (counter_capture(c) != sc->capture_let_counter)
+    {
+      set_curlet(sc, inline_make_let_with_slot(sc, closure_let(sc->code), car(closure_args(sc->code)), car(lst)));
+      counter_set_let(c, sc->curlet);
+      counter_set_slots(c, let_slots(sc->curlet));
+      counter_set_capture(c, sc->capture_let_counter);
+    }
+  else
+    {
+      let_set_slots(counter_let(c), counter_slots(c));
+      set_curlet(sc, update_let_with_slot(sc, counter_let(c), car(lst)));
+    }
+  sc->code = car(closure_body(sc->code));
+  return(false);
+}
+
+
+/* ---------------------------------------- map ---------------------------------------- */
+
+static s7_pointer g_map_closure(s7_scheme *sc, s7_pointer f, s7_pointer seq) /* one sequence argument */
+{
+  s7_pointer body = closure_body(f);
+  sc->value = f;
+
+  if (!no_cell_opt(body))
+    {
+      s7_pfunc func = NULL;
+      s7_pointer old_e = sc->curlet, pars = closure_args(f), slot;
+      s7_pointer val = seq_init(sc, seq);
+      set_curlet(sc, inline_make_let_with_slot(sc, closure_let(f), (is_pair(car(pars))) ? caar(pars) : car(pars), val));
+      slot = let_slots(sc->curlet);
+
+      if (sc->map_call_ctr == 0)
+	{
+	  if (is_null(cdr(body)))
+	    func = s7_cell_optimize(sc, body, false);
+	  else
+	    if (is_null(cddr(body)))
+	      {
+		set_ulist_1(sc, sc->begin_symbol, body);
+		func = s7_cell_optimize(sc, set_clist_1(sc, sc->u1_1), false); /* list_1 8-Apr-21 */
+	      }}
+      if (func)
+	{
+	  s7_pointer z, res = NULL;
+	  push_stack_no_let(sc, OP_MAP_UNWIND, f, seq);
+	  sc->map_call_ctr++;
+	  if (is_pair(seq))
+	    {
+	      set_map_unwind_list(sc, sc->nil);
+	      for (s7_pointer fast = seq, slow = seq; is_pair(fast); fast = cdr(fast), slow = cdr(slow))
+		{
+		  slot_set_value(slot, car(fast));
+		  z = func(sc);
+		  if (z != sc->no_value) set_map_unwind_list(sc, cons(sc, z, map_unwind_list(sc)));
+		  if (is_pair(cdr(fast)))
+		    {
+		      fast = cdr(fast);
+		      if (fast == slow)	break;
+		      slot_set_value(slot, car(fast));
+		      z = func(sc);
+		      if (z != sc->no_value) set_map_unwind_list(sc, cons(sc, z, map_unwind_list(sc)));
+		    }}
+	      res = proper_list_reverse_in_place(sc, map_unwind_list(sc));
+	    }
+	  else
+	    if (is_float_vector(seq))
+	      {
+		s7_double *vals = float_vector_floats(seq);
+		s7_int len = vector_length(seq);
+		set_map_unwind_list(sc, sc->nil);
+		for (s7_int i = 0; i < len; i++)
+		  {
+		    slot_set_value(slot, make_real(sc, vals[i]));
+		    z = func(sc);
+		    if (z != sc->no_value) set_map_unwind_list(sc, cons(sc, z, map_unwind_list(sc)));
+		  }
+		res = proper_list_reverse_in_place(sc, map_unwind_list(sc));
+	      }
+	    else
+	      if (is_int_vector(seq))
+		{
+		  s7_int *vals = int_vector_ints(seq);
+		  s7_int len = vector_length(seq);
+		  set_map_unwind_list(sc, sc->nil);
+		  for (s7_int i = 0; i < len; i++)
+		    {
+		      slot_set_value(slot, make_integer(sc, vals[i]));
+		      z = func(sc);
+		      if (z != sc->no_value) set_map_unwind_list(sc, cons(sc, z, map_unwind_list(sc)));
+		    }
+		  res = proper_list_reverse_in_place(sc, map_unwind_list(sc));
+		}
+	      else
+		if (is_t_vector(seq))
+		  {
+		    s7_pointer *vals = vector_elements(seq);
+		    s7_int len = vector_length(seq);
+		    set_map_unwind_list(sc, sc->nil);
+		    for (s7_int i = 0; i < len; i++)
+		      {
+			slot_set_value(slot, vals[i]);
+			z = func(sc);
+			if (z != sc->no_value) set_map_unwind_list(sc, cons(sc, z, map_unwind_list(sc)));
+		      }
+		    res = proper_list_reverse_in_place(sc, map_unwind_list(sc));
+		  }
+		else
+		  if (is_string(seq))
+		    {
+		      s7_int len = string_length(seq);
+		      const char *str = string_value(seq);
+		      set_map_unwind_list(sc, sc->nil);
+		      for (s7_int i = 0; i < len; i++)
+			{
+			  slot_set_value(slot, chars[(uint8_t)(str[i])]);
+			  z = func(sc);
+			  if (z != sc->no_value) set_map_unwind_list(sc, cons(sc, z, map_unwind_list(sc)));
+			}
+		      res = proper_list_reverse_in_place(sc, map_unwind_list(sc));
+		    }
+	  sc->map_call_ctr--;
+	  unstack_with(sc, OP_MAP_UNWIND);
+	  if ((S7_DEBUGGING) && (sc->map_call_ctr < 0)) {fprintf(stderr, "%s[%d]: map ctr: %" ld64 "\n", __func__, __LINE__, sc->map_call_ctr); sc->map_call_ctr = 0;}
+	  if (res) return(res);
+	}
+      set_no_cell_opt(body);
+      set_curlet(sc, old_e);
+    }
+  if (is_closure_star(f))
+    {
+      sc->z = make_iterators(sc, sc->map_symbol, set_plist_2(sc, sc->nil, seq));
+      push_stack(sc, OP_MAP, inline_make_counter(sc, sc->z), f);
+      sc->z = sc->unused;
+      return(sc->nil);
+    }
+  if ((is_null(cdr(body))) &&
+      (is_pair(seq)))
+    {
+      closure_set_map_list(f, seq);
+      push_stack(sc, OP_MAP_2, inline_make_counter(sc, seq), f);
+      return(sc->unspecified);
+    }
+  if (!is_iterator(seq))
+    {
+      if (!is_mappable(seq))
+	wrong_type_error_nr(sc, sc->map_symbol, 2, seq, a_sequence_string);
+      sc->z = s7_make_iterator(sc, seq);
+    }
+  else sc->z = seq;
+  push_stack(sc, OP_MAP_1, inline_make_counter(sc, sc->z), f);
+  sc->z = sc->unused;
+  return(sc->nil);
+}
+
+static s7_pointer g_map_closure_2(s7_scheme *sc, s7_pointer f, s7_pointer seq1, s7_pointer seq2) /* two sequences */
+{
+  s7_pointer body = closure_body(f);
+  if (!no_cell_opt(body))
+    {
+      s7_pfunc func = NULL;
+      s7_pointer old_e = sc->curlet, pars = closure_args(f), slot1, slot2;
+      s7_pointer val1 = seq_init(sc, seq1);
+      s7_pointer val2 = seq_init(sc, seq2);
+      set_curlet(sc, make_let_with_two_slots(sc, closure_let(f),
+					    (is_pair(car(pars))) ? caar(pars) : car(pars), val1,
+					    (is_pair(cadr(pars))) ? cadar(pars) : cadr(pars), val2));
+      slot1 = let_slots(sc->curlet);
+      slot2 = next_slot(slot1);
+
+      if (sc->map_call_ctr == 0)
+	{
+	  if (is_null(cdr(body)))
+	    func = s7_cell_optimize(sc, body, false);
+	  else
+	    if (is_null(cddr(body)))
+	      {
+		set_ulist_1(sc, sc->begin_symbol, body);
+		func = s7_cell_optimize(sc, set_clist_1(sc, sc->u1_1), false);
+	      }}
+      if (func)
+	{
+	  s7_pointer res = NULL;
+	  push_stack_no_let(sc, OP_MAP_UNWIND, f, seq1);
+	  sc->map_call_ctr++;
+	  if ((is_pair(seq1)) && (is_pair(seq2)))
+	    {
+	      set_map_unwind_list(sc, sc->nil);
+	      map_or_for_each_closure_pair_2(sc, func, seq1, seq2, slot1, slot2, false); /* builds result on gc_protected3 */
+	      res = proper_list_reverse_in_place(sc, map_unwind_list(sc));
+	    }
+	  else
+	    if ((is_any_vector(seq1)) && (is_any_vector(seq2)))
+	      {
+		set_map_unwind_list(sc, sc->nil);
+		map_or_for_each_closure_vector_2(sc, func, seq1, seq2, slot1, slot2, false);
+		res = proper_list_reverse_in_place(sc, map_unwind_list(sc));
+	      }
+	    else
+	      if ((is_string(seq1)) && (is_string(seq2)))
+		{
+		  set_map_unwind_list(sc, sc->nil);
+		  map_or_for_each_closure_string_2(sc, func, seq1, seq2, slot1, slot2, false);
+		  res = proper_list_reverse_in_place(sc, map_unwind_list(sc));
+		}
+	  sc->map_call_ctr--;
+	  unstack_with(sc, OP_MAP_UNWIND);
+	  set_curlet(sc, old_e);
+	  if (res) return(res);
+	  set_no_cell_opt(body);
+	}
+      else /* not func */
+	{
+	  set_no_cell_opt(body);
+	  set_curlet(sc, old_e);
+	}}
+
+  if (!is_iterator(seq1))
+    {
+      if (!is_mappable(seq1))
+	wrong_type_error_nr(sc, sc->map_symbol, 2, seq1, a_sequence_string);
+      sc->z = s7_make_iterator(sc, seq1);
+    }
+  else sc->z = seq1;
+  if (!is_iterator(seq2))
+    {
+      if (!is_mappable(seq2))
+	wrong_type_error_nr(sc, sc->map_symbol, 3, seq2, a_sequence_string);
+      sc->z = list_2(sc, sc->z, s7_make_iterator(sc, seq2));
+    }
+  else sc->z = list_2(sc, sc->z, seq2);
+
+  push_stack(sc, OP_MAP, inline_make_counter(sc, sc->z), f);
+  sc->z = sc->unused;
+  return(sc->unspecified);
+}
+
+static s7_pointer g_map(s7_scheme *sc, s7_pointer args)
+{
+  #define H_map "(map proc object . objects) applies proc to a list made up of the next element of each of its arguments, returning \
+a list of the results.  Its arguments can be lists, vectors, strings, hash-tables, or any applicable objects."
+  #define Q_map s7_make_circular_signature(sc, 2, 3, sc->is_proper_list_symbol, sc->is_procedure_symbol, sc->is_sequence_symbol)
+
+  /* (apply f (map <safe f> ...)) e.g. f=append -> use safe_list for map output list here? also for (<safe-func> (map...))
+   *   but less savings if mapped func would have used the same safe_list?
+   */
+  s7_pointer p, f = car(args);
+  s7_int len;
+  bool got_nil = false;
+
+  for (len = 0, p = cdr(args); is_not_null(p); p = cdr(p), len++)
+    if (!is_mappable(car(p)))
+      {
+	if (is_null(car(p)))
+	  got_nil = true;
+	else wrong_type_error_nr(sc, sc->map_symbol, len + 2, car(p), a_sequence_string);
+      }
+
+  switch (type(f))
+    {
+    case T_C_FUNCTION:
+      if (!(c_function_is_aritable(f, len)))
+	error_nr(sc, sc->wrong_number_of_args_symbol,
+		 set_elist_4(sc, wrap_string(sc, "map ~A: ~D argument~P?", 22), f, wrap_integer(sc, len), wrap_integer(sc, len)));
+    case T_C_RST_NO_REQ_FUNCTION:
+      /* if function is safe c func, do the map locally */
+      if (got_nil) return(sc->nil);
+      if (is_safe_procedure(f))
+	{
+	  s7_pointer val, val1, old_args, iter_list;
+	  s7_function func = c_function_call(f);
+	  if (is_pair(cadr(args)))
+	    {
+	      if (len == 1)
+		{
+		  s7_p_p_t fp = s7_p_p_function(f);
+		  if (fp)
+		    {
+		      val = list_1_unchecked(sc, sc->nil);
+		      gc_protect_via_stack(sc, val);
+		      for (s7_pointer fast = cadr(args), slow = cadr(args); is_pair(fast); fast = cdr(fast), slow = cdr(slow))
+			{
+			  s7_pointer z = fp(sc, car(fast));
+			  if (z != sc->no_value) set_car(val, cons(sc, z, car(val)));
+			  if (is_pair(cdr(fast)))
+			    {
+			      fast = cdr(fast);
+			      if (fast == slow) break;
+			      z = fp(sc, car(fast));
+			      if (z != sc->no_value) set_car(val, cons(sc, z, car(val)));
+			    }}
+		      unstack_gc_protect(sc);
+		      return(proper_list_reverse_in_place(sc, car(val)));
+		    }}
+	      if ((len == 2) && (is_pair(caddr(args))))
+		{
+		  s7_p_pp_t fp = s7_p_pp_function(f);
+		  if (fp)
+		    {
+		      val = list_1_unchecked(sc, sc->nil);
+		      gc_protect_via_stack(sc, val);
+		      for (s7_pointer fast1 = cadr(args), slow1 = cadr(args), fast2 = caddr(args), slow2 = caddr(args);
+			   (is_pair(fast1)) && (is_pair(fast2));
+			   fast1 = cdr(fast1), slow1 = cdr(slow1), fast2 = cdr(fast2), slow2 = cdr(slow2))
+			{
+			  s7_pointer z = fp(sc, car(fast1), car(fast2));
+			  if (z != sc->no_value) set_car(val, cons(sc, z, car(val)));
+			  if ((is_pair(cdr(fast1))) && (is_pair(cdr(fast2))))
+			    {
+			      fast1 = cdr(fast1);
+			      if (fast1 == slow1) break;
+			      fast2 = cdr(fast2);
+			      if (fast2 == slow2) break;
+			      z = fp(sc, car(fast1), car(fast2));
+			      if (z != sc->no_value) set_car(val, cons(sc, z, car(val)));
+			    }}
+		      unstack_gc_protect(sc);
+		      return(proper_list_reverse_in_place(sc, car(val)));
+		    }}}
+	  if ((is_string(cadr(args))) && (len == 1))
+	    {
+	      s7_p_p_t fp = s7_p_p_function(f);
+	      if (fp)
+		{
+		  s7_pointer str = cadr(args);
+		  const char *s = string_value(str);
+		  val = list_1_unchecked(sc, sc->nil);
+		  gc_protect_via_stack(sc, val);
+		  len = string_length(str);
+		  for (s7_int i = 0; i < len; i++)
+		    {
+		      s7_pointer z = fp(sc, chars[(uint8_t)(s[i])]);
+		      if (z != sc->no_value) set_car(val, cons(sc, z, car(val)));
+		    }
+		  unstack_gc_protect(sc);
+		  return(proper_list_reverse_in_place(sc, car(val)));
+		}}
+	  if ((is_any_vector(cadr(args))) && (len == 1))
+	    {
+	      s7_p_p_t fp = s7_p_p_function(f);
+	      if (fp)
+		{
+		  s7_pointer vec = cadr(args);
+		  val = list_1_unchecked(sc, sc->nil);
+		  gc_protect_via_stack(sc, val);
+		  len = vector_length(vec);
+		  for (s7_int i = 0; i < len; i++)
+		    {
+		      s7_pointer z = fp(sc, vector_getter(vec)(sc, vec, i));
+		      if (z != sc->no_value) set_car(val, cons(sc, z, car(val)));
+		    }
+		  unstack_gc_protect(sc);
+		  return(proper_list_reverse_in_place(sc, car(val)));
+		}}
+
+	  sc->z = make_iterators(sc, sc->map_symbol, args);
+	  val1 = cons_unchecked(sc, sc->z, make_list(sc, len, sc->nil));
+	  iter_list = sc->z;
+	  old_args = sc->args;
+	  push_stack_no_let(sc, OP_GC_PROTECT, val1, val = cons(sc, sc->nil, sc->code)); /* temporary GC protection: need to protect val1, iter_list, val */
+	  sc->z = sc->unused;
+	  while (true)
+	    {
+	      s7_pointer z;
+	      for (s7_pointer x = iter_list, y = cdr(val1); is_pair(x); x = cdr(x), y = cdr(y))
+		{
+		  set_car(y, s7_iterate(sc, car(x)));
+		  if (iterator_is_at_end(car(x)))
+		    {
+		      unstack_gc_protect(sc); /* free_cell(sc, car(x)); */ /* 16-Jan-19 iterator in circular list -- see s7test */
+		      sc->args = T_Pos(old_args); /* can be #<unused> or #<counter> */
+		      return(proper_list_reverse_in_place(sc, car(val)));
+		    }}
+	      z = func(sc, cdr(val1)); /* multiple-values? values is unsafe, but s7_values used externally and claims to be safe? */ /* func = c_function_call(f) */
+	      if (z != sc->no_value)
+		set_car(val, cons(sc, z, car(val)));
+	    }}
+
+      else /* not safe procedure */
+	if ((f == global_value(sc->values_symbol)) &&
+	    (len == 1) &&
+	    (!has_methods(cadr(args)))) /* iterator should be ok here -- object_to_list can handle it */
+	  {
+	    p = object_to_list(sc, cadr(args));
+	    if (p != cadr(args))
+	      return(p);
+	  }
+      break;
+
+    case T_CLOSURE:
+    case T_CLOSURE_STAR:
+      {
+	int32_t fargs = (is_closure(f)) ? closure_arity_to_int(sc, f) : closure_star_arity_to_int(sc, f);
+	if ((len == 1) &&
+	    (fargs == 1) &&
+	    (!is_constant_symbol(sc, (is_pair(car(closure_args(f)))) ? caar(closure_args(f)) : car(closure_args(f)))))
+	  {
+	    if (got_nil) return(sc->nil);
+	    if (is_closure_star(f))
+	      return(g_map_closure(sc, f, cadr(args)));
+
+	    /* don't go to OP_MAP_2 here! It assumes no recursion */
+	    sc->z = (!is_iterator(cadr(args))) ? s7_make_iterator(sc, cadr(args)) : cadr(args);
+	    push_stack(sc, OP_MAP_1, inline_make_counter(sc, sc->z), f);
+	    sc->z = sc->unused;
+	    symbol_increment_ctr(car(closure_args(f)));
+	    return(sc->nil);
+	  }
+	if (((fargs >= 0) && (fargs < len)) ||
+	    ((is_closure(f)) && (abs(fargs) > len)))
+	  error_nr(sc, sc->wrong_number_of_args_symbol,
+		   set_elist_4(sc, wrap_string(sc, "map ~A: ~D argument~P?", 22), f, wrap_integer(sc, len), wrap_integer(sc, len)));
+	if (got_nil) return(sc->nil);
+      }
+      break;
+
+    case T_C_OBJECT:
+      /* args if sc->args (plist + c_object) can be clobbered here by s7_is_aritable, so we need to protect it */
+      args = copy_proper_list(sc, args);
+      sc->temp10 = args;
+
+    default:
+      if (!is_applicable(f))
+	return(method_or_bust(sc, f, sc->map_symbol, args, something_applicable_string, 1));
+      if ((!is_pair(f)) &&
+	  (!s7_is_aritable(sc, f, len)))
+	error_nr(sc, sc->wrong_number_of_args_symbol,
+		 set_elist_4(sc, wrap_string(sc, "map: ~D argument~P for ~A?", 26), wrap_integer(sc, len), wrap_integer(sc, len), f));
+      if (got_nil) return(sc->nil);
+      break;
+    }
+
+  sc->z = make_iterators(sc, sc->map_symbol, args);
+  push_stack(sc, OP_MAP, inline_make_counter(sc, sc->z), f);
+  sc->z = sc->unused;
+  return(sc->nil);
+}
+
+static bool op_map(s7_scheme *sc)
+{
+  s7_pointer iterators = counter_list(sc->args);
+  sc->x = sc->nil;                     /* can't use preset args list here (as in for-each): (map list '(a b c)) */
+  for (s7_pointer y = iterators; is_pair(y); y = cdr(y))
+    {
+      s7_pointer x = s7_iterate(sc, car(y));
+      if (iterator_is_at_end(car(y)))
+	{
+	  sc->value = proper_list_reverse_in_place(sc, counter_result(sc->args));
+	  free_cell(sc, sc->args);  /* unsafe? */ /* not sc->args = sc->nil; */
+	  return(true);
+	}
+      sc->x = cons(sc, x, sc->x);
+    }
+  sc->x = proper_list_reverse_in_place(sc, sc->x);
+  push_stack_direct(sc, OP_MAP_GATHER);
+  sc->args = sc->x;
+  sc->x = sc->unused;
+  if (needs_copied_args(sc->code))
+    sc->args = copy_proper_list(sc, sc->args);
+  return(false);
+}
+
+static bool op_map_1(s7_scheme *sc)
+{
+  s7_pointer args = sc->args, code = sc->code;
+  s7_pointer p = counter_list(args);
+  s7_pointer x = s7_iterate(sc, p);
+
+  if (iterator_is_at_end(p))
+    {
+      sc->value = proper_list_reverse_in_place(sc, counter_result(args));
+      free_cell(sc, sc->args); /* unsafe? */  /* not sc->args = sc->nil; */
+      return(true);
+    }
+  push_stack_direct(sc, OP_MAP_GATHER_1);
+  if (counter_capture(args) != sc->capture_let_counter)
+    {
+      set_curlet(sc, inline_make_let_with_slot(sc, closure_let(code), car(closure_args(code)), x));
+      counter_set_let(args, sc->curlet);
+      counter_set_slots(args, let_slots(sc->curlet));
+      counter_set_capture(args, sc->capture_let_counter);
+    }
+  else
+    {
+      /* the counter_slots field saves the original local let slot(s) representing the function
+       *   argument.  If the function has internal defines, they get added to the front of the
+       *   slots list, but update_let_with_slot (maybe stupidly) assumes only the one original
+       *   slot exists when it updates its symbol_id from the (possibly changed) let_id.  So,
+       *   a subsequent reference to the parameter name causes "unbound variable", or a segfault
+       *   if the check has been optimized away.  I think each function call should start with
+       *   the original let slots, so counter_slots saves that pointer, and resets it here.
+       */
+      let_set_slots(counter_let(args), counter_slots(args));
+      set_curlet(sc, update_let_with_slot(sc, counter_let(args), x));
+    }
+  sc->code = T_Pair(closure_body(code));
+  return(false);
+}
+
+static bool op_map_2(s7_scheme *sc) /* possibly inline lg */
+{
+  s7_pointer x, c = sc->args, code = sc->code;
+  s7_pointer p = counter_list(c);
+  if (!is_pair(p))
+    {
+      sc->value = proper_list_reverse_in_place(sc, counter_result(c));
+      free_cell(sc, c); /* unsafe? */  /* not sc->args = sc->nil; */
+      return(true);
+    }
+  x = car(p);
+  counter_set_list(c, cdr(p));
+
+  if (sc->cur_op == OP_MAP_GATHER_3)
+    {
+      closure_set_map_list(code, cdr(closure_map_list(code)));
+      /* this depends on code (the function) being non-recursive, else closure_setter gets stepped on */
+      if (closure_map_list(code) == counter_list(c))
+	{
+	  sc->value = proper_list_reverse_in_place(sc, counter_result(c));
+	  free_cell(sc, c);  /* possibly unsafe */ /* not sc->args = sc->nil; */
+	  return(true);
+	}
+      push_stack_direct(sc, OP_MAP_GATHER_2);
+    }
+  else push_stack_direct(sc, OP_MAP_GATHER_3);
+
+  if (counter_capture(c) != sc->capture_let_counter)
+    {
+      set_curlet(sc, inline_make_let_with_slot(sc, closure_let(code), car(closure_args(code)), x));
+      counter_set_let(c, sc->curlet);
+      counter_set_slots(c, let_slots(sc->curlet));
+      counter_set_capture(c, sc->capture_let_counter);
+    }
+  else
+    {
+      let_set_slots(counter_let(c), counter_slots(c)); /* needed -- see comment under for-each above */
+      set_curlet(sc, update_let_with_slot(sc, counter_let(c), x));
+    }
+  sc->code = car(closure_body(code));
+  return(false);
+}
+
+static s7_pointer revappend(s7_scheme *sc, s7_pointer a, s7_pointer b)
+{
+  /* (map (lambda (x) (if (odd? x) (apply values '(1 2 3)) (values))) (list 1 2 3 4)) is a bad case -- we have to copy the incoming list (in op_map_gather) */
+  s7_pointer p = b;
+  if (is_not_null(a))
+    {
+      a = copy_proper_list(sc, a);
+      do {
+	s7_pointer q = cdr(a);
+	set_cdr(a, p);
+	p = a;
+	a = q;
+      } while (is_pair(a));
+    }
+  return(p);
+}
+
+static Inline void inline_op_map_gather(s7_scheme *sc) /* called thrice in eval, cb lg map */
+{
+  if (sc->value != sc->no_value)
+    {
+      if (is_multiple_value(sc->value))
+	counter_set_result(sc->args, revappend(sc, multiple_value(sc->value), counter_result(sc->args)));
+      else counter_set_result(sc->args, cons(sc, sc->value, counter_result(sc->args)));
+    }
+}
+
+
+/* -------------------------------- multiple-values -------------------------------- */
+
+#define stack_top4_op(Sc)             ((opcode_t)T_Op(Sc->stack_end[-5])) /* top4 == top - 4 */
+#define stack_top4_args(Sc)           (Sc->stack_end[-6])
+/* #define stack_top4_let(Sc)         (Sc->stack_end[-7]) */
+/* #define stack_top4_code(Sc)        (Sc->stack_end[-8]) */
+
+static void apply_c_rst_no_req_function(s7_scheme *sc);
+
+static s7_pointer op_safe_c_p_mv(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer p;
+  bool use_safe = false;
+  sc->value = args;
+  pop_stack_no_op(sc);
+  p = cddr(sc->value);
+  if (is_null(p))
+    sc->args = set_plist_2(sc, car(sc->value), cadr(sc->value));
+  else
+    if (is_null(cdr(p)))
+      sc->args = set_plist_3(sc, car(sc->value), cadr(sc->value), car(p));
+    else
+      {
+	s7_pointer lst;
+	s7_int len = proper_list_length(p) + 2;
+	sc->args = safe_list_if_possible(sc, len);
+	use_safe = (!in_heap(sc->args));
+	lst = sc->args;
+	for (s7_pointer p = sc->value; is_pair(p); p = cdr(p), lst = cdr(lst)) set_car(lst, car(p));
+      }
+  sc->code = c_function_base(opt1_cfunc(sc->code));
+  if (type(sc->code) == T_C_FUNCTION)
+    sc->value = apply_c_function_unopt(sc, sc->code, sc->args);
+  else apply_c_rst_no_req_function(sc);
+  if (use_safe) clear_list_in_use(sc->args);
+  return(sc->value);
+}
+
+static s7_pointer op_safe_c_pc_mv(s7_scheme *sc, s7_pointer args)
+{
+  /* sc->value = mv vals from e.g. safe_c_pc_1 below, fn_proc = splice_in_values via values chooser synonym sc->values_uncopied */
+  /* sc->args is the trailing constant arg (the "c" in "pc") */
+  s7_pointer p;
+  bool use_safe = false;
+  sc->value = args;
+  pop_stack_no_op(sc);
+  p = cddr(sc->value);
+  if (is_null(p))
+    sc->args = set_plist_3(sc, car(sc->value), cadr(sc->value), sc->args);
+  else
+    {
+      if (is_null(cdr(p)))
+	sc->args = set_plist_4(sc, car(sc->value), cadr(sc->value), car(p), sc->args);
+      else             /* sc->args = pair_append(sc, sc->value, list_1(sc, sc->args)); */ /* not plist! sc->value is not reusable */
+	{
+	  s7_pointer lst, val = sc->args;
+	  s7_int len = proper_list_length(p);
+	  sc->args = safe_list_if_possible(sc, len + 3);
+	  use_safe = (!in_heap(sc->args));
+	  lst = sc->args;
+	  for (s7_pointer p = sc->value; is_pair(p); p = cdr(p), lst = cdr(lst)) set_car(lst, car(p));
+	  set_car(lst, val);
+	}}
+  sc->code = c_function_base(opt1_cfunc(sc->code));
+  if (type(sc->code) == T_C_FUNCTION)
+    sc->value = apply_c_function_unopt(sc, sc->code, sc->args);
+  else apply_c_rst_no_req_function(sc);
+  if (use_safe) clear_list_in_use(sc->args);
+  return(sc->value);
+}
+
+static s7_pointer op_safe_c_ps_mv(s7_scheme *sc, s7_pointer args)  /* (define (hi a) (+ (values 1 2) a))  from safe_c_ps_1 */
+{
+  /* old form: sc->args = pair_append(sc, sc->value, list_1(sc, lookup(sc, caddr(sc->code)))); */ /* don't assume sc->value can be used as sc->args here! */
+  s7_pointer p, val;
+  bool use_safe = false;
+  sc->value = args;
+  pop_stack_no_op(sc);
+  p = cddr(sc->value);
+  val = lookup(sc, caddr(sc->code));
+  if (is_null(p))
+    sc->args = set_plist_3(sc, car(sc->value), cadr(sc->value), val);
+  else
+    {
+      if (is_null(cdr(p)))
+	sc->args = set_plist_4(sc, car(sc->value), cadr(sc->value), car(p), val);
+      else                   /* sc->args = pair_append(sc, sc->value, list_1(sc, val)); */
+	{
+	  s7_pointer lst;
+	  s7_int len = proper_list_length(p);
+	  sc->args = safe_list_if_possible(sc, len + 3); /* sc->args is not clobbered by fx_call (below) */
+	  use_safe = (!in_heap(sc->args));
+	  lst = sc->args;
+	  for (s7_pointer p = sc->value; is_pair(p); p = cdr(p), lst = cdr(lst)) set_car(lst, car(p));
+	  set_car(lst, val);
+	}}
+  sc->code = c_function_base(opt1_cfunc(sc->code));
+  if (type(sc->code) == T_C_FUNCTION)
+    sc->value = apply_c_function_unopt(sc, sc->code, sc->args);
+  else apply_c_rst_no_req_function(sc);
+  if (use_safe) clear_list_in_use(sc->args);
+  return(sc->value);
+}
+
+static s7_pointer op_safe_c_pa_mv(s7_scheme *sc, s7_pointer args)
+{ /* (let () (define (func) (do ((x 0.0 (+ x 0.1)) (i 0 (+ i 1))) ((>= x 0.1) (#_with-baffle (inlet (values 1 2) (symbol? x)))))) (func)) */
+  s7_pointer p;
+  bool use_safe = false;
+  sc->value = args;
+  pop_stack_no_op(sc);
+  p = cddr(sc->value);
+  if (is_null(p))
+    {
+      s7_pointer val1 = car(sc->value), val2 = cadr(sc->value);
+      s7_pointer val3 = fx_call(sc, cddr(sc->code)); /* is plist3 ever clobbered by fx_call? plist_1|2 are set */
+      sc->args = set_plist_3(sc, val1, val2, val3);
+    }
+  else
+    {
+      if (is_null(cdr(p)))
+	{
+	  s7_pointer val1 = car(sc->value), val2 = cadr(sc->value), val3 = car(p);
+	  s7_pointer val4 = fx_call(sc, cddr(sc->code));
+	  sc->args = set_plist_4(sc, val1, val2, val3, val4);
+	}
+      else
+	{
+	  s7_pointer lst;
+	  s7_int len = proper_list_length(p);
+	  sc->args = safe_list_if_possible(sc, len + 3); /* sc->args is not clobbered by fx_call (below) */
+	  use_safe = (!in_heap(sc->args));
+	  lst = sc->args;
+	  for (s7_pointer p = sc->value; is_pair(p); p = cdr(p), lst = cdr(lst)) set_car(lst, car(p));
+	  set_car(lst, fx_call(sc, cddr(sc->code)));
+	}}
+  sc->code = c_function_base(opt1_cfunc(sc->code));
+  if (type(sc->code) == T_C_FUNCTION)
+    sc->value = apply_c_function_unopt(sc, sc->code, sc->args);
+  else apply_c_rst_no_req_function(sc);
+  if (use_safe) clear_list_in_use(sc->args);
+  return(sc->value);
+}
+
+static s7_pointer op_safe_c_sp_mv(s7_scheme *sc, s7_pointer args)
+{ /* (let () (define (ho a) (+ a 2)) (define (hi) (+ (ho 1) (values 3 4))) (hi)) safe_add_sp_1 */
+  s7_pointer p;
+  sc->value = args;
+  clear_multiple_value(args); /* see op_safe_c_sp_mv in s7test */
+  pop_stack_no_op(sc);
+  p = cddr(sc->value);
+  if (is_null(p))
+    sc->args = set_plist_3(sc, sc->args, car(sc->value), cadr(sc->value));
+  else
+    if (is_null(cdr(p)))
+      sc->args = set_plist_4(sc, sc->args, car(sc->value), cadr(sc->value), car(p));
+    else sc->args = cons(sc, sc->args, sc->value); /* not ulist */
+  sc->code = c_function_base(opt1_cfunc(sc->code));
+  if (type(sc->code) == T_C_FUNCTION)
+    sc->value = apply_c_function_unopt(sc, sc->code, sc->args);
+  else apply_c_rst_no_req_function(sc);
+  return(sc->value);
+}
+
+static s7_pointer op_safe_c_ssp_mv(s7_scheme *sc, s7_pointer args) /*sc->code: (+ pi pi (values 1 2))  sc->value: '(1 2) */
+{
+  sc->value = args;
+  pop_stack_no_op(sc);
+  if (is_null(cddr(sc->value)))
+    sc->args = set_plist_4(sc, lookup(sc, cadr(sc->code)), lookup(sc, caddr(sc->code)), car(sc->value), cadr(sc->value));
+  else sc->args = cons_unchecked(sc, lookup(sc, cadr(sc->code)), cons(sc, lookup(sc, caddr(sc->code)), sc->value)); /* not ulist here */
+  sc->code = c_function_base(opt1_cfunc(sc->code));
+  if (type(sc->code) == T_C_FUNCTION)
+    sc->value = apply_c_function_unopt(sc, sc->code, sc->args);
+  else apply_c_rst_no_req_function(sc);
+  return(sc->value);
+}
+
+static s7_pointer op_safe_c_3p_mv(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer res;
+  sc->temp8 = copy_proper_list(sc, args);
+  res = cons(sc, sc->unused, sc->temp8);
+  sc->temp8 = sc->unused;
+  return(res);
+}
+
+static s7_pointer op_c_p_mv(s7_scheme *sc, s7_pointer args) /* (values (values 1 2)) or (apply (values + '(2))) */
+{
+  sc->value = args;
+  pop_stack_no_op(sc);
+  sc->code = c_function_base(opt1_cfunc(sc->code));
+  sc->args = copy_proper_list(sc, sc->value);
+  if (type(sc->code) == T_C_FUNCTION)
+    sc->value = apply_c_function_unopt(sc, sc->code, sc->args);
+  else apply_c_rst_no_req_function(sc);
+  return(sc->value);
+}
+
+static s7_pointer op_c_ap_mv(s7_scheme *sc, s7_pointer args) /* (values 2 (values 3 4)) or (apply + (values 5 '(1 2))) */
+{
+  sc->value = args;
+  pop_stack_no_op(sc);
+  clear_multiple_value(sc->value); /* sc->value not copied? */
+  sc->args = cons(sc, sc->args, sc->value);
+  sc->code = c_function_base(opt1_cfunc(sc->code));
+  if (type(sc->code) == T_C_FUNCTION)
+    sc->value = apply_c_function_unopt(sc, sc->code, sc->args);
+  else apply_c_rst_no_req_function(sc);
+  return(sc->value);
+}
+
+static s7_pointer op_safe_c_pp_6_mv(s7_scheme *sc, s7_pointer args) /* both args mv */
+{
+  s7_pointer p;
+  sc->value = args;
+  pop_stack_no_op(sc);
+  for (p = cdr(sc->args); is_pair(cdr(p)); p = cdr(p)); /* we used to copy here: sc->args = pair_append(sc, sc->args, sc->value); */
+  set_cdr(p, sc->value);
+  /* fn_proc(sc->code) here is g_add_2, but we have any number of args from a values call
+   *   the original (unoptimized) function is c_function_base(opt1_cfunc(sc->code))
+   *   (let () (define (hi) (+ (values 1 2) (values 3 4))) (hi)) -> 10
+   */
+  sc->code = c_function_base(opt1_cfunc(sc->code));
+  if (type(sc->code) == T_C_FUNCTION)
+    sc->value = apply_c_function_unopt(sc, sc->code, sc->args);
+  else apply_c_rst_no_req_function(sc);
+  return(sc->value);
+}
+
+static s7_pointer splice_in_values(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer x;
+  if (SHOW_EVAL_OPS)
+    safe_print(fprintf(stderr, "  %s[%d]: splice %s %s\n", __func__, __LINE__,
+		       (sc->stack_end > sc->stack_start) ? op_names[stack_top_op(sc)] : "no stack!", display_truncated(args)));
+  if ((S7_DEBUGGING) && ((is_null(args)) || (is_null(cdr(args))))) fprintf(stderr, "%s: %s\n", __func__, display(args));
+
+  switch (unchecked_stack_top_op(sc)) /* unchecked for C s7_values call at top-level -- see ffitest.c */
+    {
+      /* the normal case -- splice values into caller's args */
+    case OP_EVAL_ARGS1: case OP_EVAL_ARGS2: case OP_EVAL_ARGS3: case OP_EVAL_ARGS4:
+      /* code = args yet to eval in order, args = evalled args reversed.
+       * it is not safe to simply reverse args and tack the current stacked args onto its (new) end,
+       *   setting stacked args to cdr of reversed-args and returning car because the list (args)
+       *   can be some variable's value in a macro expansion via ,@ and reversing it in place
+       *   (all this to avoid consing), clobbers the variable's value.
+       * (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) (values c 2))))) (g-1 (lambda (b c d e) (+ b c d e)) 2 3 5)) eval_args2
+       */
+      sc->w = args;
+      for (x = args; is_not_null(cdr(x)); x = cdr(x))
+	set_stack_top_args(sc, cons(sc, car(x), stack_top_args(sc)));
+      sc->w = sc->unused;
+      return(car(x));
+
+    case OP_EVAL_ARGS5:
+      /* (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) 2 (values c 2))))) (g-1 (macro (x y z w) (list-values '+ x y z w)) 2 3 5)) */
+      /* code = previous arg saved, args = ante-previous args reversed, we'll take value->code->args and reverse in args5 */
+      if (is_null(args))
+	return(sc->unspecified);
+      if (is_null(cdr(args)))
+	return(car(args));
+      set_stack_top_args(sc, cons(sc, stack_top_code(sc), stack_top_args(sc)));
+      for (x = args; is_not_null(cddr(x)); x = cdr(x))
+	set_stack_top_args(sc, cons(sc, car(x), stack_top_args(sc)));
+      set_stack_top_code(sc, car(x));
+      return(cadr(x));
+
+      /* handle implicit set! */
+    case OP_EVAL_SET1_NO_MV: /* (set! (fnc) <val>) where evaluation of <val> returned multiple values */
+    case OP_EVAL_SET2_NO_MV: /* (set! (fnc <ind...>) <val>), <val> = mv */
+    case OP_EVAL_SET3_NO_MV: /* (define f (dilambda (lambda () 1) (lambda (x) x))) (define (f2) (values 1 2 3)) (set! (f) (f2)) */
+      syntax_error_nr(sc, "too many arguments to set!: ~S", 30, set_ulist_1(sc, sc->values_symbol, args));
+    case OP_EVAL_SET2:       /* here <ind> = args is mv */
+      set_stack_top_op(sc, OP_EVAL_SET2_MV);
+      return(args); /* ?? */
+    case OP_EVAL_SET3:       /* here <ind> = args is mv */
+      set_stack_top_op(sc, OP_EVAL_SET3_MV);
+      return(args); /* ?? */
+
+    case OP_ANY_CLOSURE_NP_1: case OP_ANY_CLOSURE_NP_2:
+      sc->code = pop_op_stack(sc);
+      error_nr(sc, sc->wrong_number_of_args_symbol,
+	       set_elist_3(sc, too_many_arguments_string, closure_name(sc, sc->code), set_ulist_1(sc, sc->value_symbol, args)));
+
+    case OP_ANY_C_NP_2:
+      set_stack_top_op(sc, OP_ANY_C_NP_MV);
+      goto FP_MV;
+
+    case OP_ANY_C_NP_1:      /* ((eval-string (object->string mac5 :readable)) 1 5 3 4) */
+      set_stack_top_op(sc, OP_ANY_C_NP_MV); /* ?? */
+    case OP_ANY_C_NP_MV:
+    FP_MV:
+      if ((is_immutable(args)) || /* (let () (define (func) (with-output-to-string (lambda () (apply-values (write '(1 2)))))) (func) (func)) */
+	  (needs_copied_args(args)))
+	{
+	  clear_needs_copied_args(args);
+	  args = copy_proper_list(sc, args);
+	}
+      set_multiple_value(args);
+      return(args);
+
+      /* in the next set, the main evaluator branches blithely assume no multiple-values, and if it happens anyway, we go to a different branch here */
+    case OP_SAFE_C_SP_1: case OP_SAFE_CONS_SP_1: case OP_SAFE_ADD_SP_1: case OP_SAFE_MULTIPLY_SP_1:
+      /* (let () (define (ho a) (+ a 2)) (define (hi) (+ (ho 1) (values 3 4))) (hi)) from safe_c_pp->h_c_aa? */
+      return(op_safe_c_sp_mv(sc, args));
+
+    case OP_SAFE_C_PS_1:  return(op_safe_c_ps_mv(sc, args));    /* (define (f) (let ((d #\d)) (string (values #\a #\b #\c) d))) (f) */
+    case OP_SAFE_C_PC_1:  return(op_safe_c_pc_mv(sc, args));    /* (define (f) (string (values #\a #\b #\c) #\d)) (f) */
+    case OP_SAFE_C_PA_1:  return(op_safe_c_pa_mv(sc, args));
+    case OP_SAFE_C_SSP_1: return(op_safe_c_ssp_mv(sc, args));
+    case OP_SAFE_C_P_1:   return(op_safe_c_p_mv(sc, args));     /* (string (values #\a #\b #\c)) */
+    case OP_C_P_1:        return(op_c_p_mv(sc, args));          /* (let () (define (ho a) (values a 1)) (define (hi) (- (ho 2))) (hi)) */
+    case OP_C_AP_1:       return(op_c_ap_mv(sc, args));
+    case OP_SAFE_C_PP_5:  return(op_safe_c_pp_6_mv(sc, args));  /* (let () (define (hi) (+ (values 1 2) (values 3 4))) (hi)) (also safe_c_pp_1) */
+
+    case OP_SAFE_C_PP_1:                                        /* (define (f) (list (values 1 2) (values 3 4))) (f): args='(1 2), top_args=#<unused> */
+      set_stack_top_op(sc, OP_SAFE_C_PP_3_MV);
+      return(args);
+
+    case OP_SAFE_C_3P_1: case OP_SAFE_C_3P_2: case OP_SAFE_C_3P_3:          /* (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) (values c 2))))) (g-1 + 2 3 5)) */
+      set_stack_top_op(sc, stack_top_op(sc) +  3); /* change op to parallel mv case */
+    case OP_SAFE_C_3P_1_MV: case OP_SAFE_C_3P_2_MV: case OP_SAFE_C_3P_3_MV: /* (list-values '+ 1 (apply-values (list 2 3))) */
+      return(op_safe_c_3p_mv(sc, args));
+
+    case OP_SAFE_CLOSURE_P_1:  case OP_CLOSURE_P_1: case OP_SAFE_CLOSURE_P_A_1:
+    case OP_SAFE_CLOSURE_AP_1: case OP_CLOSURE_AP_1:
+    case OP_SAFE_CLOSURE_PP_1: case OP_CLOSURE_PP_1:
+    case OP_SAFE_CLOSURE_PA_1: case OP_CLOSURE_PA_1:      /* arity is 2, we have 2 args, this has to be an error (see optimize_closure_sym) */
+    case OP_ANY_CLOSURE_3P_1: case OP_ANY_CLOSURE_3P_2: case OP_ANY_CLOSURE_3P_3:
+    case OP_ANY_CLOSURE_4P_1: case OP_ANY_CLOSURE_4P_2: case OP_ANY_CLOSURE_4P_3: case OP_ANY_CLOSURE_4P_4:
+      /* (let () (define (func) (do ((x 0.0 (+ x 0.1)) (i 0 (+ i 1))) ((>= x 0.1) (#_with-baffle (inlet (values 1 2) (symbol? x)))))) (func)) */
+      if (is_multiple_value(sc->value)) clear_multiple_value(sc->value);
+      error_nr(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, too_many_arguments_string, stack_top_code(sc), sc->value));
+
+      /* look for errors here rather than glomming up the set! and let code */
+    case OP_SET_SAFE:                         /* symbol is sc->code after pop */
+    case OP_SET1:
+    case OP_SET_FROM_LET_TEMP:                /* (let-temporarily ((var (values 1 2 3))) var) */
+    case OP_SET_FROM_SETTER:                  /* stack_top_code(sc) is slot if (set! x (set! (setter 'x) g)) s7test.scm */
+      syntax_error_with_caller_nr(sc, "set!: can't set ~A to ~S", 24,
+				  (is_slot(stack_top_code(sc))) ? slot_symbol(stack_top_code(sc)) : stack_top_code(sc),
+				  set_ulist_1(sc, sc->values_symbol, args));
+
+    case OP_SET_opSAq_P_1: case OP_SET_opSAAq_P_1:
+      /* we can assume here that we're dealing with the section after the target, (set! (target...) arg) where arg can't be (values...)
+       *   (define (a3 x) x)
+       *   (set! (setter a3) (lambda (x y z) (list x y z)))
+       *   <11> (set! (a3 1) 2)
+       *   error: <10>: not enough arguments: ((lambda (x y z) ...) 1 2)
+       *   <12> (set! (a3 1) 2 3)
+       *   error: (set! (a3 1) 2 3): too many arguments to set!
+       *   <13> (set! (a3 1) (values 2 3))
+       *   (set! (a3 1) (values 2 3)): too many arguments to set!
+       * but (set! (a3 1 2) 3) is ok, also (set! (a3 (values 1 2)) 3)
+       */
+      syntax_error_nr(sc, "too many arguments to set! ~S", 29, set_ulist_1(sc, sc->values_symbol, args));
+
+    case OP_LET1:                         /* (let ((var (values 1 2 3))) ...) */
+      {
+	/* (let () (define (hi) (let ((x (values 1 2))) (if x (list x)))) (define (ho) (hi)) (catch #t (lambda () (ho)) (lambda args #f)) (ho)) */
+	/* this code assumes op_let_1 is building a list of values stored in sc->args etc */
+	s7_pointer let_code, vars, sym, p = stack_top_args(sc);
+	for (let_code = p; is_pair(cdr(let_code)); let_code = cdr(let_code));
+	for (vars = caar(let_code); is_pair(cdr(p)); p = cdr(p), vars = cdr(vars));
+	sym = caar(vars);
+	syntax_error_with_caller2_nr(sc, "~A: can't bind ~A to ~S", 23, sc->let_symbol, sym, set_ulist_1(sc, sc->values_symbol, args));
+	/* stack_args: ((((x (values 1 2))) x)) in (let ((x (values 1 2))) x)
+	 *             (1 (((x 1) (y (values 1 2))) x)) in (let ((x 1) (y (values 1 2))) x)
+	 */
+      }
+
+    case OP_LET_ONE_NEW_1: case OP_LET_ONE_P_NEW_1:
+      /* (let () (define (hi) (let ((x (values 1 2))) (display x) (if x (list x)))) (define (ho) (hi)) (catch #t (lambda () (ho)) (lambda args #f)) (ho)) */
+      syntax_error_with_caller2_nr(sc, "~A: can't bind ~A to ~S", 23, sc->let_symbol,
+			      opt2_sym(stack_top_code(sc)), set_ulist_1(sc, sc->values_symbol, args));
+
+    case OP_LET_ONE_OLD_1: case OP_LET_ONE_P_OLD_1:
+      syntax_error_with_caller2_nr(sc, "~A: can't bind ~A to ~S", 23, sc->let_symbol,
+			      slot_symbol(let_slots(opt3_let(stack_top_code(sc)))), set_ulist_1(sc, sc->values_symbol, args));
+
+    case OP_LET_STAR1:             /* here caar(sc->code) is bound to sc->value */
+      syntax_error_with_caller2_nr(sc, "~A: can't bind ~A to ~S", 23, sc->let_star_symbol,
+			      caar(stack_top_code(sc)), set_ulist_1(sc, sc->values_symbol, args));
+
+    case OP_LETREC1:               /* here sc->args is the slot about to receive a value */
+      syntax_error_with_caller2_nr(sc, "~A: can't bind ~A to ~S", 23, sc->letrec_symbol,
+			      slot_symbol(stack_top_args(sc)), set_ulist_1(sc, sc->values_symbol, args));
+
+    case OP_LETREC_STAR1:
+      syntax_error_with_caller2_nr(sc, "~A: can't bind ~A to ~S", 23, sc->letrec_star_symbol,
+			      slot_symbol(stack_top_args(sc)), set_ulist_1(sc, sc->values_symbol, args));
+
+    case OP_AND_P1:
+    case OP_AND_SAFE_P_REST: /* from OP_AND_SAFE_P1 or P2 */
+      for (x = args; is_not_null(cdr(x)); x = cdr(x))
+	if (car(x) == sc->F)
+	  return(sc->F);
+      return(car(x));
+
+    case OP_OR_P1:
+      for (x = args; is_not_null(cdr(x)); x = cdr(x))
+	if (car(x) != sc->F)
+	  return(car(x));
+      return(car(x));
+
+    case OP_IF1:    /* (if (values ...) ...) -- see s7.html at the end of the values writeup for explanation (we're following CL here) */
+    case OP_IF_PP: case OP_IF_PPP: case OP_IF_PR: case OP_IF_PRR:
+    case OP_WHEN_PP: case OP_UNLESS_PP: case OP_WITH_LET1:
+    case OP_CASE_G_G: case OP_CASE_G_S: case OP_CASE_E_G: case OP_CASE_E_S: case OP_CASE_I_S:
+    case OP_COND1: case OP_COND1_SIMPLE:
+      /* (if (values 1 2) 3) */
+      return(car(args));
+
+    case OP_IF_PN: /* (if|when (not (values...)) ...) as opposed to (if|unless (values...)...) which follows CL and drops trailing values */
+      /* doesn't this error check happen elsewhere? */
+      syntax_error_nr(sc, "too many arguments to not: ~S", 29, set_ulist_1(sc, sc->values_symbol, args));
+
+    case OP_DYNAMIC_UNWIND: case OP_DYNAMIC_UNWIND_PROFILE:
+      {
+	s7_pointer old_value = sc->value;
+	bool mv = is_multiple_value(args);
+	if (mv) clear_multiple_value(args);
+	sc->value = cons(sc, sc->values_symbol, args);
+	dynamic_unwind(sc, stack_top_code(sc), stack_top_args(sc)); /* position (curlet), this applies code to sc->value */
+	sc->value = old_value;
+	if (mv) set_multiple_value(args);
+	sc->stack_end -= 4; /* either op is possible I think */
+	return(splice_in_values(sc, args));
+      }
+
+    case OP_DEACTIVATE_GOTO:  /* (+ (call-with-exit (lambda (ret) (values 1 2 3)))) */
+      call_exit_active(stack_top_args(sc)) = false; /* stack_top_args(sc) is the goto */
+      /* fall through */
+    case OP_CATCH: case OP_CATCH_1: case OP_CATCH_2: case OP_CATCH_ALL: /* (+ (catch #t (lambda () (values 3 4)) (lambda args args))) */
+    case OP_BARRIER:
+      pop_stack_no_op(sc);
+      return(splice_in_values(sc, args));
+
+    case OP_GC_PROTECT:
+      sc->stack_end -= 4;
+      return(splice_in_values(sc, args));
+
+    case OP_BEGIN_HOOK: case OP_BEGIN_NO_HOOK: case OP_BEGIN_2_UNCHECKED:
+    case OP_SIMPLE_DO_STEP: case OP_DOX_STEP_O: case OP_DOX_STEP:
+      /* here we have a values call with nothing to splice into.  So flush it...
+       *   otherwise the multiple-values bit gets set in some innocent list and never unset:
+       *     (let ((x '((1 2)))) (eval `(apply apply values x)) x) -> ((values 1 2))
+       * other cases: (+ 1 (begin (values 5 6) (values 2 3)) 4) -> 10 -- the (5 6) is dropped
+       *              (let () (values 1 2 3) 4) but (+ (let () (values 1 2))) -> 3
+       */
+      return(args);
+
+    case OP_EVAL_MACRO_MV: /* perhaps reader-cond expansion at eval-time (not at run-time) via ((let () reader-cond) ...)? */
+      {
+	opcode_t s_op = stack_top4_op(sc);
+	if ((S7_DEBUGGING) && (SHOW_EVAL_OPS))
+	  fprintf(stderr, "  eval_macro_mv splice %s with %s, code: %s, args: %s, value: %s\n",
+		  display_truncated(args), op_names[s_op], display_truncated(sc->code), display_truncated(sc->args), display_truncated(sc->value));
+	if ((s_op == OP_DO_STEP) || (s_op == OP_DEACTIVATE_GOTO) || (s_op == OP_LET1))
+	  return(args); /* tricky reader-cond as macro in do body returning values... or call-with-exit */
+
+	/* if eval_args2 here, how to maintain the current evaluation?
+	 *   (+ (reader-cond (#t 1 (values 2 3) 4))) -> 10
+         *   (+ (((vector reader-cond) 0) (#t 1 (values 2 3) 4))) -> 5 [10 if this block of code is included, s7test is ok with this code]
+	 */
+	if (s_op == OP_EVAL_ARGS2)
+	  {
+	    sc->w = args;
+	    for (x = args; is_not_null(cdr(x)); x = cdr(x))
+	      stack_top4_args(sc) = cons(sc, car(x), stack_top4_args(sc));
+	    sc->w = sc->unused;
+	    if (SHOW_EVAL_OPS)
+	      fprintf(stderr, "  eval_macro splice %s with %s, code: %s, args: %s, value: %s -> %s %s\n",
+		      display_truncated(args), op_names[s_op], display_truncated(sc->code), display_truncated(sc->args),
+		      display_truncated(sc->value), display_truncated(stack_top4_args(sc)), display_truncated(car(x)));
+	    return(car(x));
+	  }
+	/* else fall through */
+	/* safe_c_p_1 also happens and currently drops trailing arg: ((let () reader-cond) (#t (values 1 2) (iv)))
+	 *   op_eval_macro (not op_expansion) is called and can be included below (except it segfaults in s7test...), but trailing arg
+	 *   is still dropped because optimizer sees (reader-cond ...) -- one arg!
+	 *   (define iv (int-vector 1 2)) (define (func) (eof-object? ((let () reader-cond) (#t (values 1 2) (iv))))) (func)
+	 */
+      }
+
+    case OP_EXPANSION:
+      /* we get here if a reader-macro (define-expansion) returns multiple values.
+       *    these need to be read in order into the current reader lists (we'll assume OP_READ_LIST is next in the stack.
+       *    and that it will be expecting the next arg entry in sc->value; but it could be OP_LOAD_RETURN_IF_EOF if the expansion is at top level).
+       * (+ (reader-cond (#t 1 (values 2 3) 4)))
+       */
+      if (SHOW_EVAL_OPS)
+	fprintf(stderr, "  %s[%d]: %s stack top: %" ld64 ", op: %s, args: %s\n", __func__, __LINE__,
+		op_names[stack_top_op(sc)], (s7_int)(intptr_t)stack_top(sc), op_names[stack_top4_op(sc)], display_truncated(args));
+      if (stack_top4_op(sc) == OP_LOAD_RETURN_IF_EOF)
+	{
+	  /* expansion at top-level returned values, eval args in order */
+	  sc->code = args;
+	  push_stack_no_args_direct(sc, sc->begin_op);
+	  return(sc->code);
+	}
+      for (x = args; is_not_null(cdr(x)); x = cdr(x))
+	stack_top4_args(sc) = cons(sc, car(x), stack_top4_args(sc));
+      pop_stack_no_op(sc);         /* need GC protection in loop above, so do this afterwards */
+      return(car(x));              /* sc->value from OP_READ_LIST point of view */
+
+    case OP_EVAL_DONE:    /* ((lambda (w) 1) (char-ready? (open-input-function (lambda (x) (values 1 2 3 4 5 6 7))))) */
+      if (stack_top4_op(sc) == OP_NO_VALUES)
+ 	error_nr(sc, sc->error_symbol,
+		 set_elist_1(sc, wrap_string(sc, "function-port should not return multiple-values", 47)));
+      set_stack_top_op(sc, OP_SPLICE_VALUES); /* tricky -- continue from eval_done with the current splice */
+      set_stack_top_args(sc, args);
+      push_stack_op(sc, OP_EVAL_DONE);
+      return(args);
+
+    default:
+      /* (let () (define (f1) (do ((i 0 (+ i 1))) ((= i 1)) (values (append "" (block)) 1))) (f1)) safe_dotimes_step_o */
+      /* ((values memq (values #\a '(#\A 97 #\a)))) eval_args */
+      if (SHOW_EVAL_OPS) fprintf(stderr, "  %s[%d]: splice punts: %s\n", __func__, __LINE__, op_names[stack_top_op(sc)]);
+      break;
+    }
+
+  /* let it meander back up the call chain until someone knows where to splice it
+   *   the is_immutable check protects against setting the multiple value bit on (say) sc->hash_table_signature
+   */
+  if (is_immutable(args))
+    args = copy_proper_list(sc, args); /* copy needed else (apply values x) where x is a list can leave the mv bit on for x's value */
+  if (needs_copied_args(args))
+    {
+      clear_needs_copied_args(args);
+      args = copy_proper_list(sc, args);
+    }
+  set_multiple_value(args);
+  return(args);
+}
+
+
+/* -------------------------------- values -------------------------------- */
+s7_pointer s7_values(s7_scheme *sc, s7_pointer args)
+{
+  #define H_values "(values obj ...) splices its arguments into whatever list holds it (its 'continuation')"
+  #define Q_values s7_make_circular_signature(sc, 1, 2, sc->values_symbol, sc->T)
+
+  if (is_null(args))         /* ((lambda () (let ((x 1)) (set! x (boolean? (values)))))) */
+    return(sc->no_value);
+  if (is_null(cdr(args)))
+    return(car(args));
+  set_needs_copied_args(args);
+  /* copy needed: see s7test (test `(,x ,@y ,x) '(3 a b c 3)) -> (append (list-values x (#_apply-values y)) x), and #_apply_values calls s7_values directly */
+  return(splice_in_values(sc, args));
+}
+
+#define g_values s7_values
+
+static s7_pointer values_p(s7_scheme *sc) {return(sc->no_value);}
+static s7_pointer values_p_p(s7_scheme *unused_sc, s7_pointer p) {return(p);}
+
+static s7_pointer values_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer unused_expr)
+{
+  if (args > 1) return(sc->values_uncopied); /* splice_in_values */
+  return(f);
+}
+
+bool s7_is_multiple_value(s7_pointer obj) {return(is_multiple_value(obj));}
+
+
+/* -------------------------------- list-values -------------------------------- */
+static s7_pointer splice_out_values(s7_scheme *sc, s7_pointer args)
+{ /* (list-values ... (values) ... ) removes the (values) */
+  s7_pointer tp;
+  while (car(args) == sc->no_value) {args = cdr(args); if (is_null(args)) return(sc->nil);}
+  tp = list_1(sc, car(args));
+  if (is_null(cdr(args))) return(tp);
+  sc->temp8 = tp;
+  for (s7_pointer p = cdr(args), np = tp; is_pair(p); p = cdr(p))
+    if (car(p) != sc->no_value)
+      {
+	set_cdr(np, list_1(sc, car(p)));
+	np = cdr(np);
+      }
+  sc->temp8 = sc->unused;
+  return(tp);
+}
+
+static s7_pointer g_list_values(s7_scheme *sc, s7_pointer args)
+{
+  #define H_list_values "(list-values ...) returns its arguments in a list (internal to quasiquote)"
+  #define Q_list_values s7_make_circular_signature(sc, 1, 2, sc->is_list_symbol, sc->T)
+
+  /* list-values can't be replaced by list(-n) because (list-values (values)) -> () and anything can be #<no-values> (see s7test) */
+  /* but (list-values <circular-list>) will complain or get into an infinite recursion in copy_tree, so it should not use copy_tree */
+
+  s7_pointer x;
+  bool checked = false;
+  for (x = args; is_pair(x); x = cdr(x))
+    if (is_pair(car(x)))
+      {
+	if (is_checked(car(x)))
+	  checked = true;
+      }
+    else
+      if (car(x) == sc->no_value) /* unchecked_car|cdr unrolled here is not faster */
+	break;
+  if (is_null(x))
+    {
+      if (!checked) /* (!tree_has_definers(sc, args)) seems to work, reduces copy_tree calls slightly, but costs more than it saves in tgen */
+	{
+	  for (s7_pointer p = args; is_pair(p); p = cdr(p)) /* embedded list can be immutable, so we need to copy (sigh) */
+	    if (is_immutable_pair(p))
+	      return(copy_proper_list(sc, args));
+	  return(args);
+	}
+      sc->temp5 = args;
+      check_free_heap_size(sc, 8192);
+      if (sc->safety > NO_SAFETY)
+	{
+	  if (!tree_is_cyclic(sc, args)) /* we're copying to clear optimizations I think, and a cyclic list here can't be optimized */
+	    args = cons_unchecked(sc,     /* since list-values is a safe function, args can be immutable, which should not be passed through the copy */
+				  (is_unquoted_pair(car(args))) ? copy_tree_with_type(sc, car(args)) : car(args),
+				  (is_unquoted_pair(cdr(args))) ? copy_tree_with_type(sc, cdr(args)) : cdr(args));
+	}
+      else args = copy_tree(sc, args);      /* not copy_any_list here -- see comment below */
+      sc->temp5 = sc->unused;
+      return(args);
+    }
+  /* if a macro expands into a recursive function with a macro argument as its body (or reasonable facsimile thereof),
+   *   and the safety (as in safe_closure) of the body changes from safe to unsafe, then (due to the checked bits
+   *   protecting against cycles in optimize_expression|syntax), the possible safe_closure call will not be fixed,
+   *   the safe_closure's assumption about the saved local let will be violated, and we'll get "<arg> unbound" (see tgen.scm).
+   * clear_all_optimizations assumes its argument has no cycles, and automatically calling copy_tree slows
+   *   everything down intolerably, so if the checked bit is on in a macro expansion, that means we're re-expanding this macro,
+   *   and therefore have to copy the tree.  But isn't that only the case if the macro expands into closures?
+   */
+  return(splice_out_values(sc, args));
+}
+
+static s7_pointer g_simple_list_values(s7_scheme *sc, s7_pointer args)
+{
+  /* if just (code-)constant/symbol, symbol->pair won't be checked (not optimized/re-expanded code), but might be no-values */
+  for (s7_pointer p = args; is_pair(p); p = cdr(p))
+    if (car(p) == sc->no_value)
+      return(splice_out_values(sc, args));
+  if (is_immutable(args))
+    return(copy_proper_list(sc, args));
+  return(args);
+}
+
+static s7_pointer list_values_chooser(s7_scheme *sc, s7_pointer f, int32_t unused_args, s7_pointer expr)
+{
+  for (s7_pointer p = cdr(expr); is_pair(p); p = cdr(p))
+    if (is_unquoted_pair(car(p)))
+      return(f);
+  return(sc->simple_list_values);
+}
+
+
+/* -------------------------------- apply-values -------------------------------- */
+static s7_pointer g_apply_values(s7_scheme *sc, s7_pointer args)
+{
+  #define H_apply_values "(apply-values var) applies values to var.  This is an internal function."
+  #define Q_apply_values s7_make_signature(sc, 2, sc->T, sc->is_list_symbol)
+  s7_pointer x;     /* apply-values takes 1 arg: ,@a -> (apply-values a) */
+  if (is_null(args)) return(sc->no_value);
+  x = car(args);
+  if (is_null(x)) return(sc->no_value);
+  if (!s7_is_proper_list(sc, x)) apply_list_error_nr(sc, x);
+  if (is_null(cdr(x))) return(car(x)); /* needs to follow previous because it might not be a pair: (apply-values 2) */
+  set_needs_copied_args(x);
+  return(splice_in_values(sc, x));
+  /* return(s7_values(sc, x)); *//* g_values == s7_values */
+}
+
+/* (apply values ...) replaces (unquote_splicing ...)
+ *   (define-macro (hi a) `(+ 1 ,a) == (list '+ 1 a)
+ *   (define-macro (hi a) `(+ 1 ,@a) == (list '+ 1 (apply values a))
+ * this is not the same as CL's quasiquote; for example:
+ *   [1]> (let ((a 1) (b 2)) `(,a ,@b)) -> '(1 . 2) but in s7 this is an error.
+ * also in CL the target of ,@ can apparently be a circular list
+ */
+
+
+/* -------------------------------- quasiquote -------------------------------- */
+static bool is_simple_code(s7_scheme *sc, s7_pointer form)
+{
+  /* if nested with quasiquotes say 20 levels, this is really slow, but to tag intermediate results burns up 2 type bits */
+  s7_pointer tmp, slow;
+  for (tmp = form, slow = form; is_pair(tmp); tmp = cdr(tmp), slow = cdr(slow))
+    {
+      if (is_pair(car(tmp)))
+	{
+	  if (!is_simple_code(sc, car(tmp)))
+	    return(false);
+	}
+      else
+	if (car(tmp) == sc->unquote_symbol)
+	  return(false);
+      tmp = cdr(tmp);
+      if (!is_pair(tmp)) return(is_null(tmp));
+      if (tmp == slow) return(false);
+      if (is_pair(car(tmp)))
+	{
+	  if (!is_simple_code(sc, car(tmp)))
+	    return(false);
+	}
+      else
+	if (car(tmp) == sc->unquote_symbol)
+	  return(false);
+    }
+  return(is_null(tmp));
+}
+
+/* since the reader expands unquote et al, and the printer does not unexpand them, the standard scheme quine in s7 is:
+ *   ((lambda (x) (list-values x (list-values 'quote x))) '(lambda (x) (list-values x (list-values 'quote x))))
+ * but that depends on the "p" in repl...
+ */
+
+static s7_pointer g_quasiquote_1(s7_scheme *sc, s7_pointer form, bool check_cycles)
+{
+  #define H_quasiquote "(quasiquote arg) is the same as `arg.  If arg is a list, it can contain \
+comma (\"unquote\") and comma-atsign (\"apply values\") to pre-evaluate portions of the list. \
+unquoted expressions are evaluated and plugged into the list, apply-values evaluates the expression \
+and splices the resultant list into the outer list. `(1 ,(+ 1 1) ,@(list 3 4)) -> (1 2 3 4)."
+
+  if (!is_pair(form))
+    {
+      if (is_normal_symbol(form))
+        return(list_2(sc, sc->quote_function, form));
+      /* things that evaluate to themselves don't need to be quoted */
+      return(form);
+    }
+  if (car(form) == sc->unquote_symbol)
+    {
+      if (!is_pair(cdr(form)))             /* (unquote) or (unquote . 1) */
+	{
+	  if (is_null(cdr(form)))
+	    syntax_error_nr(sc, "unquote: no argument, ~S", 24, form);
+	  syntax_error_nr(sc, "unquote: stray dot, ~S", 22, form);
+	}
+      if (is_not_null(cddr(form)))
+	syntax_error_nr(sc, "unquote: too many arguments, ~S", 31, form);
+      return(cadr(form));
+    }
+
+  /* it's a list, so return the list with each element handled as above.
+   *    we try to support dotted lists which makes the code much messier.
+   * if no element of the list is a list or unquote, just return the original quoted
+   */
+  if (((check_cycles) && (tree_is_cyclic(sc, form))) ||
+      (is_simple_code(sc, form)))
+    return(list_2(sc, sc->quote_function, form));
+
+  {
+    s7_int i;
+    s7_pointer orig, bq, old_scw = sc->w; /* very often, sc->w is in use here */
+    bool dotted = false;
+    s7_int len = s7_list_length(sc, form);
+    if (len < 0)
+      {
+	len = -len;
+	dotted = true;
+      }
+    gc_protect_via_stack(sc, sc->w);
+
+    check_free_heap_size(sc, len + 1);
+    sc->w = sc->nil;
+    for (i = 0; i <= len; i++)
+      sc->w = cons_unchecked(sc, sc->nil, sc->w);
+
+    set_car(sc->w, initial_value(sc->list_values_symbol));
+    if (!dotted)
+      {
+	for (orig = form, bq = cdr(sc->w), i = 0; i < len; i++, orig = cdr(orig), bq = cdr(bq))
+	  if ((is_pair(cdr(orig))) &&             /* this was is_pair(orig) which seems to be always the case */
+	      (cadr(orig) == sc->unquote_symbol)) /* `(1 . ,(+ 1 1)) -> '(1 unquote (+ 1 1)) -> '(1 . 2) etc */
+	    {
+	      if (!is_pair(cddr(orig)))
+		{
+		  sc->w = old_scw;
+		  unstack_gc_protect(sc);
+		  syntax_error_nr(sc, "unquote: no argument, ~S", 24, form);
+		}
+	      set_car(bq, g_quasiquote_1(sc, car(orig), false));
+	      set_cdr(bq, sc->nil);
+	      sc->w = list_3(sc, initial_value(sc->qq_append_symbol), sc->w, caddr(orig)); /* `(f . ,(string-append "h" "i")) */
+	      break;
+	    }
+	  else set_car(bq, g_quasiquote_1(sc, car(orig), false));
+      }
+    else /* `(1 2 . 3) */
+      {
+	len--;
+	for (orig = form, bq = cdr(sc->w), i = 0; i < len; i++, orig = cdr(orig), bq = cdr(bq))
+	  set_car(bq, g_quasiquote_1(sc, car(orig), false));
+	set_car(bq, g_quasiquote_1(sc, car(orig), false));
+	sc->w = list_3(sc, initial_value(sc->qq_append_symbol), sc->w, g_quasiquote_1(sc, cdr(orig), false));
+	/* quasiquote might quote a symbol in cdr(orig), so it's not completely pointless */
+      }
+    bq = sc->w;
+    sc->w = old_scw;
+    unstack_gc_protect(sc);
+    return(bq);
+  }
+}
+
+static s7_pointer g_quasiquote(s7_scheme *sc, s7_pointer args) /* this is for explicit quasiquote support, not the backquote stuff in macros */
+{
+  return(g_quasiquote_1(sc, car(args), true));
+}
+
+static s7_pointer g_qq_append(s7_scheme *sc, s7_pointer args)
+{
+  #define H_qq_append "<list*>: CL list* (I think) for quasiquote's internal use"
+  #define Q_qq_append s7_make_signature(sc, 3, sc->is_list_symbol, sc->is_list_symbol, sc->T)
+  s7_pointer a = T_Lst(car(args)), b = cadr(args);
+  s7_pointer p, tp, np;
+  if (is_null(a)) return(b);
+  p = cdr(a);
+  if (is_null(p)) return(cons(sc, car(a), b));
+  tp = list_1(sc, car(a));
+  gc_protect_via_stack(sc, tp);
+  for (np = tp; is_pair(p); p = cdr(p), np = cdr(np))
+    set_cdr(np, list_1(sc, car(p)));
+  set_cdr(np, b);
+  unstack_gc_protect(sc);
+  return(tp);
+}
+
+
+/* -------------------------------- choosers -------------------------------- */
+static s7_pointer make_function_with_class(s7_scheme *sc, s7_pointer cls, const char *name, s7_function f,
+					   int32_t required_args, int32_t optional_args, bool rest_arg)
+{
+  s7_pointer uf = s7_make_safe_function(sc, name, f, required_args, optional_args, rest_arg, NULL);
+  s7_function_set_class(sc, uf, cls);
+  c_function_signature(uf) = c_function_signature(cls);
+  return(uf);
+}
+
+static s7_pointer make_unsafe_function_with_class(s7_scheme *sc, s7_pointer cls, const char *name, s7_function f,
+						  int32_t required_args, int32_t optional_args, bool rest_arg)
+{
+  s7_pointer uf = s7_make_function(sc, name, f, required_args, optional_args, rest_arg, NULL); /* was s7_make_safe_function! 14-Dec-20 */
+  s7_function_set_class(sc, uf, cls);
+  c_function_signature(uf) = c_function_signature(cls);
+  return(uf);
+}
+
+static s7_pointer set_function_chooser(s7_pointer sym, s7_pointer (*chooser)(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr))
+{
+  s7_pointer f = global_value(sym);
+  c_function_chooser(f) = chooser;
+  return(f);
+}
+
+static void init_choosers(s7_scheme *sc)
+{
+  s7_pointer f;
+
+  /* + */
+  f = set_function_chooser(sc->add_symbol, add_chooser);
+  sc->add_class = c_function_class(f);
+  sc->add_2 = make_function_with_class(sc, f, "+", g_add_2, 2, 0, false);
+  sc->add_3 = make_function_with_class(sc, f, "+", g_add_3, 3, 0, false);
+  sc->add_1x = make_function_with_class(sc, f, "+", g_add_1x, 2, 0, false);
+  sc->add_x1 = make_function_with_class(sc, f, "+", g_add_x1, 2, 0, false);
+  sc->add_i_random = make_function_with_class(sc, f, "+", g_add_i_random, 2, 0, false);
+  sc->add_2_ff = make_function_with_class(sc, f, "+", g_add_2_ff, 2, 0, false);
+  sc->add_2_ii = make_function_with_class(sc, f, "+", g_add_2_ii, 2, 0, false);
+  sc->add_2_if = make_function_with_class(sc, f, "+", g_add_2_if, 2, 0, false);
+  sc->add_2_fi = make_function_with_class(sc, f, "+", g_add_2_fi, 2, 0, false);
+  sc->add_2_xi = make_function_with_class(sc, f, "+", g_add_2_xi, 2, 0, false);
+  sc->add_2_ix = make_function_with_class(sc, f, "+", g_add_2_ix, 2, 0, false);
+  sc->add_2_fx = make_function_with_class(sc, f, "+", g_add_2_fx, 2, 0, false);
+  sc->add_2_xf = make_function_with_class(sc, f, "+", g_add_2_xf, 2, 0, false);
+
+  /* - */
+  f = set_function_chooser(sc->subtract_symbol, subtract_chooser);
+  sc->subtract_class = c_function_class(f);
+  sc->subtract_1 = make_function_with_class(sc, f, "-", g_subtract_1, 1, 0, false);
+  sc->subtract_2 = make_function_with_class(sc, f, "-", g_subtract_2, 2, 0, false);
+  sc->subtract_3 = make_function_with_class(sc, f, "-", g_subtract_3, 3, 0, false);
+  sc->subtract_x1 = make_function_with_class(sc, f, "-", g_subtract_x1, 2, 0, false);
+  sc->subtract_2f = make_function_with_class(sc, f, "-", g_subtract_2f, 2, 0, false);
+  sc->subtract_f2 = make_function_with_class(sc, f, "-", g_subtract_f2, 2, 0, false);
+
+  /* * */
+  f = set_function_chooser(sc->multiply_symbol, multiply_chooser);
+  sc->multiply_class = c_function_class(f);
+  sc->multiply_2 = make_function_with_class(sc, f, "*", g_multiply_2, 2, 0, false);
+  sc->mul_2_ff = make_function_with_class(sc, f, "*", g_mul_2_ff, 2, 0, false);
+  sc->mul_2_ii = make_function_with_class(sc, f, "*", g_mul_2_ii, 2, 0, false);
+  sc->mul_2_if = make_function_with_class(sc, f, "*", g_mul_2_if, 2, 0, false);
+  sc->mul_2_fi = make_function_with_class(sc, f, "*", g_mul_2_fi, 2, 0, false);
+  sc->mul_2_xi = make_function_with_class(sc, f, "*", g_mul_2_xi, 2, 0, false);
+  sc->mul_2_ix = make_function_with_class(sc, f, "*", g_mul_2_ix, 2, 0, false);
+  sc->mul_2_fx = make_function_with_class(sc, f, "*", g_mul_2_fx, 2, 0, false);
+  sc->mul_2_xf = make_function_with_class(sc, f, "*", g_mul_2_xf, 2, 0, false);
+
+  /* / */
+  f = set_function_chooser(sc->divide_symbol, divide_chooser);
+  sc->invert_1 = make_function_with_class(sc, f, "/", g_invert_1, 1, 0, false);
+  sc->divide_2 = make_function_with_class(sc, f, "/", g_divide_2, 2, 0, false);
+  sc->invert_x = make_function_with_class(sc, f, "/", g_invert_x, 2, 0, false);
+  sc->divide_by_2 = make_function_with_class(sc, f, "/", g_divide_by_2, 2, 0, false);
+
+  /* = */
+  f = set_function_chooser(sc->num_eq_symbol, num_eq_chooser);
+  sc->num_eq_class = c_function_class(f);
+  sc->num_eq_2 = make_function_with_class(sc, f, "=", g_num_eq_2, 2, 0, false);
+  sc->num_eq_xi = make_function_with_class(sc, f, "=", g_num_eq_xi, 2, 0, false);
+  sc->num_eq_ix = make_function_with_class(sc, f, "=", g_num_eq_ix, 2, 0, false);
+
+  /* min */
+  f = set_function_chooser(sc->min_symbol, min_chooser);
+  sc->min_2 = make_function_with_class(sc, f, "min", g_min_2, 2, 0, false);
+  sc->min_3 = make_function_with_class(sc, f, "min", g_min_3, 3, 0, false);
+
+  /* max */
+  f = set_function_chooser(sc->max_symbol, max_chooser);
+  sc->max_2 = make_function_with_class(sc, f, "max", g_max_2, 2, 0, false);
+  sc->max_3 = make_function_with_class(sc, f, "max", g_max_3, 3, 0, false);
+
+  /* < */
+  f = set_function_chooser(sc->lt_symbol, less_chooser);
+  sc->less_xi = make_function_with_class(sc, f, "<", g_less_xi, 2, 0, false);
+  sc->less_x0 = make_function_with_class(sc, f, "<", g_less_x0, 2, 0, false);
+  sc->less_xf = make_function_with_class(sc, f, "<", g_less_xf, 2, 0, false);
+  sc->less_2 = make_function_with_class(sc, f, "<", g_less_2, 2, 0, false);
+
+  /* > */
+  f = set_function_chooser(sc->gt_symbol, greater_chooser);
+  sc->greater_xi = make_function_with_class(sc, f, ">", g_greater_xi, 2, 0, false);
+  sc->greater_xf = make_function_with_class(sc, f, ">", g_greater_xf, 2, 0, false);
+  sc->greater_2 = make_function_with_class(sc, f, ">", g_greater_2, 2, 0, false);
+
+  /* <= */
+  f = set_function_chooser(sc->leq_symbol, leq_chooser);
+  sc->leq_xi = make_function_with_class(sc, f, "<=", g_leq_xi, 2, 0, false);
+  sc->leq_2 = make_function_with_class(sc, f, "<=", g_leq_2, 2, 0, false);
+  sc->leq_ixx = make_function_with_class(sc, f, "<=", g_leq_ixx, 3, 0, false);
+
+  /* >= */
+  f = set_function_chooser(sc->geq_symbol, geq_chooser);
+  sc->geq_xi = make_function_with_class(sc, f, ">=", g_geq_xi, 2, 0, false);
+  sc->geq_xf = make_function_with_class(sc, f, ">=", g_geq_xf, 2, 0, false);
+  sc->geq_2 = make_function_with_class(sc, f, ">=", g_geq_2, 2, 0, false);
+
+  /* log */
+  f = set_function_chooser(sc->log_symbol, log_chooser);
+  sc->int_log2 = make_function_with_class(sc, f, "log", g_int_log2, 2, 0, false);
+
+  /* random */
+  f = set_function_chooser(sc->random_symbol, random_chooser);
+  sc->random_1 = make_function_with_class(sc, f, "random", g_random_1, 1, 0, false);
+  sc->random_i = make_function_with_class(sc, f, "random", g_random_i, 1, 0, false);
+  sc->random_f = make_function_with_class(sc, f, "random", g_random_f, 1, 0, false);
+
+  /* defined? */
+  f = set_function_chooser(sc->is_defined_symbol, is_defined_chooser);
+  sc->is_defined_in_rootlet = make_function_with_class(sc, f, "defined?", g_is_defined_in_rootlet, 2, 0, false);
+  sc->is_defined_in_unlet = make_function_with_class(sc, f, "defined?", g_is_defined_in_unlet, 2, 0, false);
+
+  /* char=? */
+  f = set_function_chooser(sc->char_eq_symbol, char_equal_chooser);
+  sc->simple_char_eq = make_function_with_class(sc, f, "char=?", g_simple_char_eq, 2, 0, false);
+  sc->char_equal_2 = make_function_with_class(sc, f, "char=?", g_char_equal_2, 2, 0, false);
+
+  /* char>? */
+  f = set_function_chooser(sc->char_gt_symbol, char_greater_chooser);
+  sc->char_greater_2 = make_function_with_class(sc, f, "char>?", g_char_greater_2, 2, 0, false);
+
+  /* char<? */
+  f = set_function_chooser(sc->char_lt_symbol, char_less_chooser);
+  sc->char_less_2 = make_function_with_class(sc, f, "char<?", g_char_less_2, 2, 0, false);
+
+  /* read-char */
+  f = set_function_chooser(sc->read_char_symbol, read_char_chooser);
+  sc->read_char_1 = make_function_with_class(sc, f, "read-char", g_read_char_1, 1, 0, false);
+
+  /* char-position */
+  f = set_function_chooser(sc->char_position_symbol, char_position_chooser);
+  sc->char_position_csi = make_function_with_class(sc, f, "char-position", g_char_position_csi, 2, 1, false);
+
+  /* string=? */
+  f = set_function_chooser(sc->string_eq_symbol, string_equal_chooser);
+  sc->string_equal_2 = make_function_with_class(sc, f, "string=?", g_string_equal_2, 2, 0, false);
+  sc->string_equal_2c = make_function_with_class(sc, f, "string=?", g_string_equal_2c, 2, 0, false);
+
+  /* substring */
+  /* sc->substring_uncopied = s7_make_safe_function(sc, "substring", g_substring_uncopied, 1, 2, false, NULL); */ /* now exported to Scheme 28-May-24 */
+  sc->substring_uncopied = global_value(sc->substring_uncopied_symbol);
+  s7_function_set_class(sc, sc->substring_uncopied, global_value(sc->substring_symbol));
+
+  /* string>? */
+  f = set_function_chooser(sc->string_gt_symbol, string_greater_chooser);
+  sc->string_greater_2 = make_function_with_class(sc, f, "string>?", g_string_greater_2, 2, 0, false);
+
+  /* string<? */
+  f = set_function_chooser(sc->string_lt_symbol, string_less_chooser);
+  sc->string_less_2 = make_function_with_class(sc, f, "string<?", g_string_less_2, 2, 0, false);
+
+  /* string */
+  f = set_function_chooser(sc->string_symbol, string_chooser);
+  sc->string_c1 = make_function_with_class(sc, f, "string", g_string_c1, 1, 0, false);
+
+  /* string-append */
+  f = set_function_chooser(sc->string_append_symbol, string_append_chooser);
+  sc->string_append_2 = make_function_with_class(sc, f, "string-append", g_string_append_2, 2, 0, false);
+
+  /* string-ref et al */
+  set_function_chooser(sc->string_ref_symbol, string_substring_chooser);
+  set_function_chooser(sc->string_to_symbol_symbol, string_substring_chooser); /* not string_to_number here (not const char*??) */
+  set_function_chooser(sc->string_to_keyword_symbol, string_substring_chooser);
+  set_function_chooser(sc->string_downcase_symbol, string_substring_chooser);
+  set_function_chooser(sc->string_upcase_symbol, string_substring_chooser);
+  set_function_chooser(sc->string_position_symbol, string_substring_chooser);
+  set_function_chooser(sc->string_geq_symbol, string_substring_chooser);
+  set_function_chooser(sc->string_leq_symbol, string_substring_chooser);
+  set_function_chooser(sc->string_copy_symbol, string_copy_chooser);
+  set_function_chooser(sc->eval_string_symbol, string_substring_chooser);
+  set_function_chooser(sc->symbol_symbol, string_substring_chooser);
+  set_function_chooser(sc->string_to_byte_vector_symbol, string_substring_chooser);
+  /* if the function assumes a null-terminated string, substring needs to return a copy (which assume this?) */
+#if (!WITH_PURE_S7)
+  set_function_chooser(sc->string_length_symbol, string_substring_chooser);
+  set_function_chooser(sc->string_to_list_symbol, string_substring_chooser);
+  set_function_chooser(sc->string_ci_eq_symbol, string_substring_chooser);
+  set_function_chooser(sc->string_ci_geq_symbol, string_substring_chooser);
+  set_function_chooser(sc->string_ci_leq_symbol, string_substring_chooser);
+  set_function_chooser(sc->string_ci_gt_symbol, string_substring_chooser);
+  set_function_chooser(sc->string_ci_lt_symbol, string_substring_chooser);
+#endif
+#if WITH_SYSTEM_EXTRAS
+  set_function_chooser(sc->file_exists_symbol, string_substring_chooser);
+#endif
+
+  /* also: directory->list substring with-input-from-file with-input-from-string with-output-to-file open-output-file open-input-file
+   *   system load getenv file-mtime gensym directory? call-with-output-file delete-file call-with-input-file call-with-input-string open-input-string
+   *   length et al?
+   */
+
+  /* symbol->string */
+  f = global_value(sc->symbol_to_string_symbol);
+  sc->symbol_to_string_uncopied = s7_make_safe_function(sc, "symbol->string", g_symbol_to_string_uncopied, 1, 0, false, NULL);
+  s7_function_set_class(sc, sc->symbol_to_string_uncopied, f);
+
+  /* symbol->value */
+  set_function_chooser(sc->symbol_to_value_symbol, symbol_to_value_chooser);
+  sc->sv_unlet_ref = make_function_with_class(sc, f, "symbol->value", g_sv_unlet_ref, 1, 1, false);
+
+  /* display */
+  f = set_function_chooser(sc->display_symbol, display_chooser);
+  sc->display_f = make_function_with_class(sc, f, "display", g_display_f, 2, 0, false);
+  sc->display_2 = make_function_with_class(sc, f, "display", g_display_2, 2, 0, false);
+
+  /* vector */
+  f = set_function_chooser(sc->vector_symbol, vector_chooser);
+  sc->vector_2 = make_function_with_class(sc, f, "vector", g_vector_2, 2, 0, false);
+  sc->vector_3 = make_function_with_class(sc, f, "vector", g_vector_3, 3, 0, false);
+
+  /* vector-ref */
+  f = set_function_chooser(sc->vector_ref_symbol, vector_ref_chooser);
+  sc->vector_ref_2 = make_function_with_class(sc, f, "vector-ref", g_vector_ref_2, 2, 0, false);
+  sc->vector_ref_3 = make_function_with_class(sc, f, "vector-ref", g_vector_ref_3, 3, 0, false);
+
+  /* vector-set! */
+  f = set_function_chooser(sc->vector_set_symbol, vector_set_chooser);
+  sc->vector_set_3 = make_function_with_class(sc, f, "vector-set!", g_vector_set_3, 3, 0, false);
+  sc->vector_set_4 = make_function_with_class(sc, f, "vector-set!", g_vector_set_4, 4, 0, false);
+
+  /* float-vector-ref */
+  f = set_function_chooser(sc->float_vector_ref_symbol, float_vector_ref_chooser);
+  sc->fv_ref_2 = make_function_with_class(sc, f, "float-vector-ref", g_fv_ref_2, 2, 0, false);
+  sc->fv_ref_3 = make_function_with_class(sc, f, "float-vector-ref", g_fv_ref_3, 3, 0, false);
+
+  /* float-vector-set */
+  f = set_function_chooser(sc->float_vector_set_symbol, float_vector_set_chooser);
+  sc->fv_set_3 = make_function_with_class(sc, f, "float-vector-set!", g_fv_set_3, 3, 0, false);
+  sc->fv_set_unchecked = make_function_with_class(sc, f, "float-vector-set!", g_fv_set_unchecked, 3, 0, false);
+
+  /* int-vector-ref */
+  f = set_function_chooser(sc->int_vector_ref_symbol, int_vector_ref_chooser);
+  sc->iv_ref_2 = make_function_with_class(sc, f, "int-vector-ref", g_iv_ref_2, 2, 0, false);
+  sc->iv_ref_3 = make_function_with_class(sc, f, "int-vector-ref", g_iv_ref_3, 3, 0, false);
+
+  /* int-vector-set */
+  f = set_function_chooser(sc->int_vector_set_symbol, int_vector_set_chooser);
+  sc->iv_set_3 = make_function_with_class(sc, f, "int-vector-set!", g_iv_set_3, 3, 0, false);
+
+  /* byte-vector-ref */
+  f = set_function_chooser(sc->byte_vector_ref_symbol, byte_vector_ref_chooser);
+  sc->bv_ref_2 = make_function_with_class(sc, f, "byte-vector-ref", g_bv_ref_2, 2, 0, false);
+  sc->bv_ref_3 = make_function_with_class(sc, f, "byte-vector-ref", g_bv_ref_3, 3, 0, false);
+
+  /* byte-vector-set */
+  f = set_function_chooser(sc->byte_vector_set_symbol, byte_vector_set_chooser);
+  sc->bv_set_3 = make_function_with_class(sc, f, "byte-vector-set!", g_bv_set_3, 3, 0, false);
+
+  /* list-set! */
+  f = set_function_chooser(sc->list_set_symbol, list_set_chooser);
+  sc->list_set_i = make_function_with_class(sc, f, "list-set!", g_list_set_i, 3, 0, false);
+
+  /* hash-table-ref */
+  f = set_function_chooser(sc->hash_table_ref_symbol, hash_table_ref_chooser);
+  sc->hash_table_ref_2 = make_function_with_class(sc, f, "hash-table-ref", g_hash_table_ref_2, 2, 0, false);
+
+  /* hash-table-set! */
+  set_function_chooser(sc->hash_table_set_symbol, hash_table_set_chooser);
+
+  /* hash-table */
+  f = set_function_chooser(sc->hash_table_symbol, hash_table_chooser);
+  sc->hash_table_2 = make_function_with_class(sc, f, "hash-table", g_hash_table_2, 2, 0, false);
+
+  /* format */
+  f = set_function_chooser(sc->format_symbol, format_chooser);
+  sc->format_f = make_function_with_class(sc, f, "format", g_format_f, 1, 0, true);
+  sc->format_no_column = make_function_with_class(sc, f, "format", g_format_no_column, 1, 0, true);
+  sc->format_just_control_string = make_function_with_class(sc, f, "format", g_format_just_control_string, 2, 0, false);
+  sc->format_as_objstr = make_function_with_class(sc, f, "format", g_format_as_objstr, 3, 0, true);
+
+  /* list */
+  f = set_function_chooser(sc->list_symbol, list_chooser);
+  sc->list_0 = make_function_with_class(sc, f, "list", g_list_0, 0, 0, false);
+  sc->list_1 = make_function_with_class(sc, f, "list", g_list_1, 1, 0, false);
+  sc->list_2 = make_function_with_class(sc, f, "list", g_list_2, 2, 0, false);
+  sc->list_3 = make_function_with_class(sc, f, "list", g_list_3, 3, 0, false);
+  sc->list_4 = make_function_with_class(sc, f, "list", g_list_4, 4, 0, false);
+
+  /* append */
+  f = set_function_chooser(sc->append_symbol, append_chooser);
+  sc->append_2 = make_function_with_class(sc, f, "append", g_append_2, 2, 0, false);
+
+  /* list-ref */
+  f = set_function_chooser(sc->list_ref_symbol, list_ref_chooser);
+  sc->list_ref_at_0 = make_function_with_class(sc, f, "list", g_list_ref_at_0, 2, 0, false);
+  sc->list_ref_at_1 = make_function_with_class(sc, f, "list", g_list_ref_at_1, 2, 0, false);
+  sc->list_ref_at_2 = make_function_with_class(sc, f, "list", g_list_ref_at_2, 2, 0, false);
+
+  /* assoc */
+  set_function_chooser(sc->assoc_symbol, assoc_chooser);
+
+  /* member */
+  set_function_chooser(sc->member_symbol, member_chooser);
+
+  /* memq */
+  f = set_function_chooser(sc->memq_symbol, memq_chooser);  /* in pure-s7, use member here */
+  sc->memq_2 = make_function_with_class(sc, f, "memq", g_memq_2, 2, 0, false);
+  sc->memq_3 = make_function_with_class(sc, f, "memq", g_memq_3, 2, 0, false);
+  sc->memq_4 = make_function_with_class(sc, f, "memq", g_memq_4, 2, 0, false);
+  sc->memq_any = make_function_with_class(sc, f, "memq", g_memq_any, 2, 0, false);
+
+  /* tree-set-memq */
+  f = set_function_chooser(sc->tree_set_memq_symbol, tree_set_memq_chooser);
+  sc->tree_set_memq_syms = make_function_with_class(sc, f, "tree-set-memq", g_tree_set_memq_syms, 2, 0, false);
+
+  /* dynamic-wind */
+  f = set_function_chooser(sc->dynamic_wind_symbol, dynamic_wind_chooser);
+  sc->dynamic_wind_unchecked = make_unsafe_function_with_class(sc, f, "dynamic-wind", g_dynamic_wind_unchecked, 3, 0, false);
+  sc->dynamic_wind_body = make_unsafe_function_with_class(sc, f, "dynamic-wind", g_dynamic_wind_body, 3, 0, false);
+  sc->dynamic_wind_init = make_unsafe_function_with_class(sc, f, "dynamic-wind", g_dynamic_wind_init, 3, 0, false);
+
+  /* outlet */
+  f = set_function_chooser(sc->outlet_symbol, outlet_chooser);
+  sc->unlet_disabled = make_function_with_class(sc, f, "unlet", g_unlet_disabled, 0, 0, false);
+  sc->outlet_unlet = make_function_with_class(sc, f, "outlet", g_outlet_unlet, 1, 0, false);
+
+  /* inlet */
+  f = set_function_chooser(sc->inlet_symbol, inlet_chooser);
+  sc->simple_inlet = make_function_with_class(sc, f, "inlet", g_simple_inlet, 0, 0, true);
+
+  /* sublet */
+  f = set_function_chooser(sc->sublet_symbol, sublet_chooser);
+  sc->sublet_curlet = make_function_with_class(sc, f, "sublet", g_sublet_curlet, 3, 0, false);
+
+  /* let-ref */
+  f = set_function_chooser(sc->let_ref_symbol, let_ref_chooser);
+  sc->simple_let_ref = make_function_with_class(sc, f, "let-ref", g_simple_let_ref, 2, 0, false);
+  sc->rootlet_ref = make_function_with_class(sc, f, "let-ref", g_rootlet_ref, 2, 0, false);
+  sc->unlet_ref = make_function_with_class(sc, f, "let-ref", g_unlet_ref, 2, 0, false);
+
+  /* let-set */
+  f = set_function_chooser(sc->let_set_symbol, let_set_chooser);
+  sc->simple_let_set = make_function_with_class(sc, f, "let-set!", g_simple_let_set, 3, 0, false);
+  sc->unlet_set = make_function_with_class(sc, f, "let-set!", g_unlet_set, 3, 0, false);
+
+  /* values */
+  f = set_function_chooser(sc->values_symbol, values_chooser);
+  sc->values_uncopied = make_unsafe_function_with_class(sc, f, "values", splice_in_values, 0, 0, true);
+
+  /* list-values */
+  f = set_function_chooser(sc->list_values_symbol, list_values_chooser);
+  sc->simple_list_values = make_function_with_class(sc, f, "list-values", g_simple_list_values, 0, 0, true);
+}
+
+
+/* ---------------- *unbound-variable-hook* ---------------- */
+static s7_pointer loaded_library(s7_scheme *sc, const char *file)
+{
+  for (s7_pointer p = global_value(sc->libraries_symbol); is_pair(p); p = cdr(p))
+    if (local_strcmp(file, string_value(caar(p))))
+      return(cdar(p));
+  return(sc->nil);
+}
+
+static void pair_set_current_input_location(s7_scheme *sc, s7_pointer p)
+{
+  if (current_input_port(sc) != sc->standard_input) /* (port_file_number(current_input_port(sc)) > 1) -- maybe 0 is legit? */
+    {
+      pair_set_location(p, port_location(current_input_port(sc)));
+      set_has_location(p);	      /* current_input_port(sc) above can't be nil(?) -- it falls back on stdin now */
+    }
+}
+
+static noreturn void unbound_variable_error_nr(s7_scheme *sc, s7_pointer sym)
+{
+  s7_pointer err_code = NULL;
+  if ((is_pair(current_code(sc))) && (s7_tree_memq(sc, sym, current_code(sc))))
+    err_code = current_code(sc);
+  else
+    if ((is_pair(sc->code)) && (s7_tree_memq(sc, sym, sc->code)))
+      err_code = sc->code;
+#if WITH_HISTORY
+  else
+    {
+      s7_pointer p;
+      for (p = cdr(sc->cur_code); cdr(p) != sc->cur_code; p = cdr(p));
+      if ((is_pair(car(p))) && (s7_tree_memq(sc, sym, car(p)))) err_code = car(p);
+    }
+#endif
+  if (err_code) /* these cases look ok */
+    error_nr(sc, sc->unbound_variable_symbol, set_elist_3(sc, wrap_string(sc, "unbound variable ~S in ~S", 25), sym, err_code));
+  if ((symbol_name(sym)[symbol_name_length(sym) - 1] == ',') &&
+      (lookup_unexamined(sc, make_symbol(sc, symbol_name(sym), symbol_name_length(sym) - 1))))
+    error_nr(sc, sc->unbound_variable_symbol, set_elist_2(sc, wrap_string(sc, "unbound variable ~S (perhaps a stray comma?)", 44), sym));
+  error_nr(sc, sc->unbound_variable_symbol, set_elist_2(sc, wrap_string(sc, "unbound variable ~S", 19), sym));
+}
+
+static s7_pointer check_autoload_and_error_hook(s7_scheme *sc, s7_pointer sym)
+{
+  /* this always occurs in a context where we're trying to find anything, so I'll move a couple of those checks here */
+  if ((sc->curlet != sc->nil) &&
+      (has_let_ref_fallback(sc->curlet))) /* an experiment -- see s7test (with-let *db* (+ int32_t (length str))) */
+    return(call_let_ref_fallback(sc, sc->curlet, sym));
+  /* but if the thing we want to hit this fallback happens to exist at a higher level, oops... */
+
+  if (sym == sc->unquote_symbol)
+    syntax_error_nr(sc, "unquote (',') occurred outside quasiquote: ~S", 45, current_code(sc));
+
+  if (safe_strcmp(symbol_name(sym), "|#"))
+    read_error_nr(sc, "unmatched |#");
+
+  /* check *autoload*, autoload_names, then *unbound-variable-hook* */
+  if ((sc->autoload_names) ||
+      (is_hash_table(sc->autoload_table)) ||
+      ((is_procedure(sc->unbound_variable_hook)) &&
+       (hook_has_functions(sc->unbound_variable_hook))))
+    {
+      s7_pointer cur_code = current_code(sc);
+      s7_pointer value = sc->value;
+      s7_pointer code = sc->code;
+      s7_pointer current_let = sc->curlet;
+      s7_pointer x = sc->x;
+      s7_pointer z = sc->z;
+      /* sc->args and sc->code are pushed on the stack by s7_call, then
+       *   restored by eval, so they are normally protected, but sc->value and current_code(sc) are
+       *   not protected.  We need current_code(sc) so that the possible eventual error
+       *   call can tell where the error occurred, and we need sc->value because it might
+       *   be awaiting addition to sc->args in e.g. OP_EVAL_ARGS5, and then be clobbered
+       *   by the hook function.  (+ 1 asdf) will end up evaluating (+ asdf asdf) if sc->value
+       *   is not protected.  We also need to save/restore sc->curlet in case s7_load is called.
+       */
+      s7_pointer args = (sc->args) ? sc->args : sc->nil;
+      s7_pointer result = sc->undefined;
+      sc->temp7 = cons_unchecked(sc, current_let, cons_unchecked(sc, code,         /* perhaps elist_7 except we use elist_3 above? */
+                    cons_unchecked(sc, args, list_4(sc, value, cur_code, x, z)))); /* not s7_list (debugger checks) */
+      if (!is_pair(cur_code))
+	{
+	  /* isolated typo perhaps -- no pair to hold the position info, so make one. current_code(sc) is GC-protected, so this should be safe */
+	  cur_code = list_1(sc, sym);     /* the error will say "(sym)" which is not too misleading */
+	  pair_set_current_input_location(sc, cur_code);
+	}
+#if (!DISABLE_AUTOLOAD)
+      if ((sc->is_autoloading) &&
+	  (sc->autoload_names)) /* created by s7_autoload_set_names which requires alphabetization by the caller (e.g. snd-xref.c) */
+	{
+	  bool loaded = false;
+	  const char *file = find_autoload_name(sc, sym, &loaded, true);
+	  if ((file) && (!loaded))
+	    {
+	      /* if we've already loaded this file, we can get the library (e) from a table [(file lib) ...]
+	       * here it was possible to get caught in a loop:
+	       *   change file, reload, unbound var seen, check autoload, it says "load file"... (where file does not get added to *libraries*)
+	       *   so the "loaded" arg tries to catch such cases
+	       */
+	      s7_pointer e = loaded_library(sc, file);
+	      if ((!e) || (!is_let(e)))
+		{
+		  if (hook_has_functions(sc->autoload_hook))
+		    s7_apply_function(sc, sc->autoload_hook, set_plist_2(sc, sym, s7_make_string(sc, file)));
+		  e = s7_load(sc, file);         /* s7_load can return NULL */
+		}
+	      result = s7_symbol_value(sc, sym); /* calls lookup, does not trigger unbound_variable search */
+	      if ((result == sc->undefined) && (e) && (is_let(e)))
+		{
+		  /* the current_let refs here are trying to handle local autoloads, but that is problematic -- we'd need to
+		   *   save the autoload curlet when autoload is called, and hope the current reference can still access that let?
+		   *   but if the same symbol is autloaded in several lets, we are in trouble, and how to handle a function that
+		   *   has an autoload?  I think I'll just assume rootlet, even though that is not very elegant.  Actually in the
+		   *   libgsl case, we're trying to export a name from *libgsl* -- should that be done with define rather than autoload?
+		   */
+		  result = let_ref_p_pp(sc, e, sym);  /* add '(sym . result) to current_let (was sc->nil, s7_load can set sc->curlet to sc->nil) */
+		  if (result != sc->undefined)
+		    s7_define(sc, sc->nil /* current_let */, sym, result);
+		}}}
+#endif
+      if (result == sc->undefined)
+	{
+#if (!DISABLE_AUTOLOAD)
+	  /* check the *autoload* hash table */
+	  if ((sc->is_autoloading) &&
+	      (is_hash_table(sc->autoload_table)))
+	    {
+	      /* it was possible to get in a loop here: missing paren in x.scm, checks last symbol, sees
+	       *   autoload sym -> x.scm, loads x.scm, missing paren...
+	       */
+	      s7_pointer val = s7_hash_table_ref(sc, sc->autoload_table, sym);
+	      s7_pointer e = NULL;
+	      if (is_string(val))       /* val should be a filename. *load-path* is searched if necessary */
+		{
+		  if (hook_has_functions(sc->autoload_hook))
+		    s7_apply_function(sc, sc->autoload_hook, set_plist_2(sc, sym, val));
+		  e = s7_load(sc, string_value(val));
+		}
+	      else
+		if (is_closure(val))   /* val should be a function of one argument, the current (calling) environment */
+		  {
+		    if (hook_has_functions(sc->autoload_hook))
+		      s7_apply_function(sc, sc->autoload_hook, set_plist_2(sc, sym, val));
+		    e = s7_call(sc, val, set_ulist_1(sc, sc->curlet, sc->nil));
+		  }
+	      result = s7_symbol_value(sc, sym);                   /* calls lookup, does not trigger unbound_variable search */
+	      if ((result == sc->undefined) && (e) && (is_let(e))) /* added 31-Mar-23 to match sc->autoload_names case above */
+		{
+		  result = let_ref_p_pp(sc, e, sym);
+		  if (result != sc->undefined)
+		    s7_define(sc, sc->nil /* current_let */, sym, result); /* as above, was sc->nil -- s7_load above can set sc->curlet to sc->nil */
+		}}
+#endif
+	  /* check *unbound-variable-hook* */
+	  if ((result == sc->undefined) &&
+	      (is_procedure(sc->unbound_variable_hook)) &&
+	      (hook_has_functions(sc->unbound_variable_hook)))
+	    {
+	      /* (let () (set! (hook-functions *unbound-variable-hook*) (list (lambda (v) _asdf_))) _asdf_) */
+	      s7_pointer old_hook = sc->unbound_variable_hook;
+	      bool old_history_enabled = s7_set_history_enabled(sc, false);
+	      gc_protect_via_stack(sc, old_hook);
+	      sc->unbound_variable_hook = sc->nil;
+	      result = s7_call(sc, old_hook, set_plist_1(sc, sym)); /* not s7_apply_function */
+	      if (result == sc->unspecified) result = sc->undefined;
+	      sc->unbound_variable_hook = old_hook;
+	      s7_set_history_enabled(sc, old_history_enabled);
+	      unstack_gc_protect(sc);
+	    }}
+      sc->value = T_Ext(value);
+      sc->args = T_Pos(args); /* can be #<unused> or #<counter>! */
+      sc->code = code;
+      set_curlet(sc, current_let);
+      sc->x = x;
+      sc->z = z;
+      sc->temp7 = sc->unused;
+      return(result);
+    }
+  return(sc->undefined);
+}
+
+static s7_pointer unbound_variable(s7_scheme *sc, s7_pointer sym)
+{
+  s7_pointer result = check_autoload_and_error_hook(sc, sym);
+  if (result != sc->undefined) return(result);
+  unbound_variable_error_nr(sc, sym);
+  return(sc->unbound_variable_symbol);
+}
+
+#define choose_c_function(Sc, Expr, Func, Args) set_c_function(Expr, c_function_chooser(Func)(Sc, Func, Args, Expr))
+
+static void fx_annotate_arg(s7_scheme *sc, s7_pointer arg, s7_pointer e)
+{
+#if S7_DEBUGGING
+  s7_function fx;
+  if (has_fx(arg)) return;
+  fx = fx_choose(sc, arg, e, (is_list(e)) ? pair_symbol_is_safe : let_symbol_is_safe);
+  if (fx) set_fx_direct(arg, fx);
+  /* else fprintf(stderr, "%s[%d]: no fx for %s in %s\n", __func__, __LINE__, display(arg), display(e)); */
+#else
+  if (has_fx(arg)) return;
+  set_fx(arg, fx_choose(sc, arg, e, (is_list(e)) ? pair_symbol_is_safe : let_symbol_is_safe));
+#endif
+}
+
+static void fx_annotate_args(s7_scheme *sc, s7_pointer args, s7_pointer e)
+{
+  for (s7_pointer p = args; is_pair(p); p = cdr(p))
+#if S7_DEBUGGING
+    fx_annotate_arg(sc, p, e); /* checks has_fx */
+#else
+    if (!has_fx(p))
+      set_fx(p, fx_choose(sc, p, e, (is_list(e)) ? pair_symbol_is_safe : let_symbol_is_safe));
+#endif
+}
+
+static opt_t optimize_thunk(s7_scheme *sc, s7_pointer expr, s7_pointer func, int32_t hop, s7_pointer e)
+{
+  if (SHOW_EVAL_OPS) fprintf(stderr, "  %s[%d]: expr: %s, func: %s, hop: %d, e: %s\n",
+			     __func__, __LINE__, display_truncated(expr), display(func), hop, display_truncated(e));
+  if ((hop != 1) && (is_constant_symbol(sc, car(expr)))) hop = 1;
+
+  if ((is_closure(func)) || (is_closure_star(func)))
+    {
+      bool safe_case = is_safe_closure(func);
+      s7_pointer body = closure_body(func);
+      bool one_form = is_null(cdr(body));
+
+      if (is_immutable(func)) hop = 1;
+      if (is_null(closure_args(func)))               /* no rest arg funny business */
+	{
+	  set_optimized(expr);
+	  if ((one_form) && (safe_case) && (is_fxable(sc, car(body)))) /* fx stuff is not set yet */
+	    {
+	      fx_annotate_arg(sc, body, e);
+	      set_optimize_op(expr, hop + OP_SAFE_THUNK_A);
+	      set_closure_one_form_fx_arg(func);
+	      set_opt1_lambda_add(expr, func);
+	      return(OPT_T);
+	    }
+	  /* thunks with fully fxable bodies are rare apparently, and the time spent here overwhelms run time gains */
+	  set_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_THUNK : ((one_form) ? OP_THUNK_O : OP_THUNK)));
+	  set_opt1_lambda_add(expr, func);
+	  return((safe_case) ? OPT_T : OPT_F);
+	}
+
+      if (is_symbol(closure_args(func))) /* (define* (f1 . a) ...) called (f1) -- called a closure (not closure*) in define_unchecked */
+	{
+	  set_opt1_lambda_add(expr, func);
+	  if (safe_case)
+	    {
+	      if (!has_fx(body))
+		{
+		  fx_annotate_args(sc, body, e);
+		  fx_tree(sc, body, closure_args(func), NULL, NULL, false);
+		}
+	      set_safe_optimize_op(expr, hop + OP_SAFE_THUNK_ANY);
+	      return(OPT_T);
+	    }
+	  set_unsafe_optimize_op(expr, hop + OP_THUNK_ANY); /* "thunk" because here it is called with no args, I guess */
+	  return(OPT_F);
+	}
+      if (is_closure_star(func))
+	{
+	  set_opt1_lambda_add(expr, func);
+	  set_safe_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_STAR_NA_0 : OP_CLOSURE_STAR_NA));
+	}
+      return(OPT_F);
+    }
+  if (is_c_function(func))
+    {
+      if (c_function_min_args(func) != 0)
+	return(OPT_F);
+      if ((hop == 0) && (symbol_id(car(expr)) == 0)) hop = 1;
+      if ((is_safe_procedure(func)) || (c_function_call(func) == s7_values))
+	{
+	  set_safe_optimize_op(expr, hop + OP_SAFE_C_NC);
+	  choose_c_function(sc, expr, func, 0);
+	  return(OPT_T);
+	}
+      set_unsafe_optimize_op(expr, hop + OP_C);
+      choose_c_function(sc, expr, func, 0);
+      return(OPT_F);
+    }
+  if (is_c_function_star(func))
+    {
+      set_safe_optimize_op(expr, hop + OP_SAFE_C_STAR);
+      set_c_function(expr, func);
+      return(OPT_T);
+    }
+  return(OPT_F);
+}
+
+static int32_t combine_ops(s7_scheme *sc, s7_pointer expr, combine_op_t cop, s7_pointer e1, s7_pointer e2) /* sc needed for debugger stuff */
+{ /* sc arg is used if debugging (hidden in set_op2_con for example) */
+  switch (cop)
+    {
+    case E_C_P:
+      switch (op_no_hop(e1))
+	{
+	case OP_SAFE_C_S:      return(OP_SAFE_C_opSq);
+	case OP_SAFE_C_NC:     return(OP_SAFE_C_opNCq);
+	case OP_SAFE_C_SC:     return(OP_SAFE_C_opSCq);
+	case OP_SAFE_C_CS:     return(OP_SAFE_C_opCSq);
+	case OP_SAFE_C_A:      return(OP_SAFE_C_opAq);
+	case OP_SAFE_C_AA:     return(OP_SAFE_C_opAAq);
+	case OP_SAFE_C_AAA:    return(OP_SAFE_C_opAAAq);
+	case OP_SAFE_C_SS:
+	  set_opt3_sym(expr, cadr(e1));
+	  set_opt1_sym(cdr(expr), caddr(e1));
+	  return(OP_SAFE_C_opSSq);
+	case OP_SAFE_C_opSq:
+	  set_opt3_pair(expr, cadr(e1));
+	  set_opt3_sym(cdr(expr), cadadr(e1));
+	  return(OP_SAFE_C_op_opSqq);
+	case OP_SAFE_C_S_opSq:
+	  set_opt3_pair(expr, caddr(e1));
+	  return(OP_SAFE_C_op_S_opSqq);
+	case OP_SAFE_C_opSq_S:
+	  set_opt3_pair(expr, cadr(e1));
+	  return(OP_SAFE_C_op_opSq_Sq);
+	}
+      return(OP_SAFE_C_P); /* this splits out to A in optimize_func one_arg */
+
+    case E_C_SP:
+      switch (op_no_hop(e2))
+	{
+	case OP_SAFE_C_S:   return(OP_SAFE_C_S_opSq);
+	case OP_SAFE_C_AA:  return(OP_SAFE_C_S_opAAq);
+	case OP_SAFE_C_SC:
+	  set_opt2_con(cdr(expr), caddr(e2));
+	  return(OP_SAFE_C_S_opSCq);
+	case OP_SAFE_C_CS:	  /* expr is (* a (- 1 b)), e2 is (- 1 b) */
+	  set_opt2_sym(cdr(expr), caddr(e2));
+	  return(OP_SAFE_C_S_opCSq);
+	case OP_SAFE_C_SS:	  /* (* a (- b c)) */
+	  set_opt2_sym(cdr(expr), caddr(e2));
+	  return(OP_SAFE_C_S_opSSq);
+	case OP_SAFE_C_A:
+	  set_opt3_pair(expr, cdaddr(expr));
+	  return(OP_SAFE_C_S_opAq);
+	}
+      return(OP_SAFE_C_SP); /* if fxable -> AA later */
+
+    case E_C_PS:
+      switch (op_no_hop(e1))
+	{
+	case OP_SAFE_C_S:
+	  set_opt1_sym(cdr(expr), cadr(e1));
+	  set_opt3_sym(expr, e2);
+	  return(OP_SAFE_C_opSq_S);
+	case OP_SAFE_C_SS:    return(OP_SAFE_C_opSSq_S);
+	case OP_SAFE_C_CS:    return(OP_SAFE_C_opCSq_S);
+	case OP_SAFE_C_A:     return(OP_SAFE_C_opAq_S);
+	case OP_SAFE_C_opSSq:
+	  set_opt1_pair(cdr(expr), cadadr(expr));
+	  set_opt3_pair(expr, cadr(e1));
+	  return(OP_SAFE_C_op_opSSqq_S);
+	}
+      return(OP_SAFE_C_PS);
+
+    case E_C_PC:
+      switch (op_no_hop(e1))
+	{
+	case OP_SAFE_C_S:
+	  set_opt1_sym(cdr(expr), cadr(e1));
+	  set_opt2_con(cdr(expr), e2);
+	  return(OP_SAFE_C_opSq_C);
+	case OP_SAFE_C_CS:    return(OP_SAFE_C_opCSq_C);
+	case OP_SAFE_C_SC:    return(OP_SAFE_C_opSCq_C);
+	case OP_SAFE_C_SS:
+	  set_opt3_con(cdr(expr), caddr(expr));
+	  return(OP_SAFE_C_opSSq_C);
+	}
+      set_opt3_con(cdr(expr), caddr(expr));
+      return(OP_SAFE_C_PC);
+
+    case E_C_CP:
+      switch (op_no_hop(e2))
+	{
+	case OP_SAFE_C_S:
+	  set_opt3_pair(expr, e2);
+	  return(OP_SAFE_C_C_opSq);
+	case OP_SAFE_C_SC:
+	  set_opt1_sym(cdr(expr), cadr(e2));
+	  set_opt2_con(cdr(expr), caddr(e2));
+	  return(OP_SAFE_C_C_opSCq);
+	case OP_SAFE_C_SS:
+	  set_opt1_sym(cdr(expr), cadr(e2));
+	  return(OP_SAFE_C_C_opSSq);
+	}
+      return(OP_SAFE_C_CP);
+
+    case E_C_PP:
+      switch (op_no_hop(e2))
+	{
+	case OP_SAFE_C_S:
+	  if (is_safe_c_s(e1))
+	    return(OP_SAFE_C_opSq_opSq);
+	  if (optimize_op_match(e1, OP_SAFE_C_SS))
+	    return(OP_SAFE_C_opSSq_opSq);
+	  break;
+	case OP_SAFE_C_SS:
+	  if (optimize_op_match(e1, OP_SAFE_C_SS))
+	    return(OP_SAFE_C_opSSq_opSSq);
+	  if (is_safe_c_s(e1))
+	    return(OP_SAFE_C_opSq_opSSq);
+	  break;
+	}
+      return(OP_SAFE_C_PP);
+
+    default: break;
+    }
+  return(OP_UNOPT);
+}
+
+static bool arg_findable(s7_scheme *sc, s7_pointer arg1, s7_pointer e)
+{
+  if (pair_symbol_is_safe(sc, arg1, e)) return(true); /* includes global_slot check */
+  return((!sc->in_with_let) &&
+	 (is_slot(s7_slot(sc, arg1))));
+}
+
+static bool safe_c_aa_to_ag_ga(s7_scheme *sc, s7_pointer arg, int32_t hop)
+{
+  if (fx_proc(cddr(arg)) == fx_s) {set_opt3_sym(arg, caddr(arg));   set_safe_optimize_op(arg, hop + OP_SAFE_C_AS); return(true);}
+  if (fx_proc(cdr(arg)) == fx_s)  {set_opt3_sym(arg, cadr(arg));    set_safe_optimize_op(arg, hop + OP_SAFE_C_SA); return(true);}
+  if (fx_proc(cddr(arg)) == fx_c) {set_opt3_con(arg, caddr(arg));   set_safe_optimize_op(arg, hop + OP_SAFE_C_AC); return(true);}
+  if (fx_proc(cdr(arg)) == fx_c)  {set_opt3_con(arg, cadr(arg));    set_safe_optimize_op(arg, hop + OP_SAFE_C_CA); return(true);}
+  if (fx_proc(cddr(arg)) == fx_q) {set_opt3_con(arg, cadaddr(arg)); set_safe_optimize_op(arg, hop + OP_SAFE_C_AC); return(true);}
+  if (fx_proc(cdr(arg)) == fx_q)  {set_opt3_con(arg, cadadr(arg));  set_safe_optimize_op(arg, hop + OP_SAFE_C_CA); return(true);}
+  return(false);
+}
+
+static opt_t check_c_aa(s7_scheme *sc, s7_pointer expr, s7_pointer func, int32_t hop, s7_pointer e)
+{
+  fx_annotate_args(sc, cdr(expr), e);
+  if (!safe_c_aa_to_ag_ga(sc, expr, hop))
+    {
+      set_optimize_op(expr, hop + OP_SAFE_C_AA);
+      set_opt3_pair(expr, cddr(expr));
+    }
+  choose_c_function(sc, expr, func, 2);
+  return(OPT_T);
+}
+
+static opt_t wrap_bad_args(s7_scheme *sc, s7_pointer func, s7_pointer expr, int32_t n_args, int32_t hop, s7_pointer e)
+{
+  set_opt3_arglen(cdr(expr), n_args);
+  if (is_c_function(func))
+    {
+      set_safe_optimize_op(expr, hop + ((is_safe_procedure(func)) ?
+					((n_args == 1) ? OP_SAFE_C_A : OP_SAFE_C_AA) :
+					((n_args == 1) ? ((is_semisafe(func)) ? OP_CL_A : OP_C_A) :
+					                 ((is_semisafe(func)) ? OP_CL_AA : OP_C_AA))));
+      if (op_no_hop(expr) == OP_SAFE_C_AA)
+	{
+	  set_opt3_pair(expr, cddr(expr));
+	  if (optimize_op(expr) == HOP_SAFE_C_AA) return(check_c_aa(sc, expr, func, hop, e));
+	}
+      set_c_function(expr, func);
+      return(OPT_T);
+    }
+  if ((is_closure(func)) &&
+      (!arglist_has_rest(sc, closure_args(func))))
+    {
+      s7_pointer body = closure_body(func);
+      bool one_form = is_null(cdr(body)), safe_case = is_safe_closure(func);
+      set_unsafely_optimized(expr);
+      set_opt1_lambda_add(expr, func);
+      if (one_form)
+	set_optimize_op(expr, hop + ((safe_case) ?
+				     ((n_args == 1) ? OP_SAFE_CLOSURE_A_O : OP_SAFE_CLOSURE_AA_O) :
+				     ((n_args == 1) ? OP_CLOSURE_A_O : OP_CLOSURE_AA_O)));
+      else
+	set_optimize_op(expr, hop + ((safe_case) ?
+				     ((n_args == 1) ? OP_SAFE_CLOSURE_A : OP_SAFE_CLOSURE_AA) :
+				     ((n_args == 1) ? OP_CLOSURE_A : OP_CLOSURE_AA)));
+      return(OPT_F);
+    }
+  if ((is_closure_star(func)) &&
+      (lambda_has_simple_defaults(func)) &&
+      (closure_star_arity_to_int(sc, func) >= n_args) &&
+      (!arglist_has_rest(sc, closure_args(func))))
+    {
+      set_unsafely_optimized(expr);
+      if (n_args == 1)
+	set_optimize_op(expr, ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_STAR_A : OP_CLOSURE_STAR_A));
+      else
+	if (closure_star_arity_to_int(sc, func) == 2)
+	  set_optimize_op(expr, ((is_safe_closure(func)) ? ((is_null(cdr(closure_body(func)))) ? OP_SAFE_CLOSURE_STAR_AA_O :
+							    OP_SAFE_CLOSURE_STAR_AA) : OP_CLOSURE_STAR_NA));
+	else set_optimize_op(expr, ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_STAR_NA : OP_CLOSURE_STAR_NA));
+      set_opt1_lambda_add(expr, func);
+    }
+  return(OPT_F);
+}
+
+static inline s7_pointer find_uncomplicated_symbol(s7_scheme *sc, s7_pointer symbol, s7_pointer e)
+{
+  s7_pointer x;
+  int64_t id;
+
+  if ((symbol_is_in_list(sc, symbol)) &&
+      (direct_memq(symbol, e)))   /* it's probably a local variable reference */
+    return(sc->nil);
+  /* ((!symbol_is_in_list(sc, symbol)) && (direct_memq(symbol, e))) can happen if there's an intervening lambda:
+   *   (let loop () (with-let (for-each (lambda (a) a) (list))) (loop))
+   * misses 'loop (it's not in symbol_list when recursive call is encountered) -- tricky to fix
+   */
+
+  if (is_global(symbol))
+    return(global_slot(symbol));
+
+  /* see 59108 (OP_DEFINE_* in optimize_syntax) -- keyword version of name is used if a definition is
+   *   contingent on some run-time decision, so we're looking here for local defines that might not happen.
+   *   s7test.scm has a test case using acos.
+   */
+  if ((has_keyword(symbol)) &&
+      (symbol_is_in_list(sc, symbol_to_keyword(sc, symbol))))
+    return(sc->nil);
+
+  for (x = sc->curlet, id = symbol_id(symbol); let_id(x) > id; x = let_outlet(x));
+  for (; x; x = let_outlet(x))
+    {
+      if (let_id(x) == id)
+	return(local_slot(symbol));
+      for (s7_pointer y = let_slots(x); tis_slot(y); y = next_slot(y))
+	if (slot_symbol(y) == symbol)
+	  return(y);
+    }
+  return(global_slot(symbol)); /* it's no longer global perhaps (local definition now inaccessible) */
+}
+
+static bool is_ok_lambda(s7_scheme *sc, s7_pointer arg2)
+{
+  return((is_pair(arg2)) &&
+	 (is_lambda(sc, car(arg2))) && /* must start (lambda ...) */
+	 (is_pair(cdr(arg2))) &&       /* must have arg(s) */
+	 (is_pair(cddr(arg2))) &&      /* must have body */
+	 (s7_is_proper_list(sc, cdddr(arg2))));
+}
+
+static bool hop_if_constant(s7_scheme *sc, s7_pointer sym)
+{
+  return(((!sc->in_with_let) && (symbol_id(sym) == 0)) ? 1 : 0); /* for with-let, see s7test atanh (77261) */
+}
+
+static opt_t optimize_c_function_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer func,
+					 int32_t hop, int32_t pairs, int32_t symbols, int32_t quotes, int32_t bad_pairs, s7_pointer e)
+{
+  s7_pointer arg1 = cadr(expr);
+  bool func_is_safe = is_safe_procedure(func);
+  if (hop == 0) hop = hop_if_constant(sc, car(expr));
+  if (SHOW_EVAL_OPS) fprintf(stderr, "  %s[%d]: %s %d %d\n", __func__, __LINE__, display_truncated(expr), func_is_safe, pairs);
+  if (pairs == 0)
+    {
+      if ((func_is_safe) || (c_function_call(func) == s7_values))                /* safe c function */
+	{
+	  set_safe_optimize_op(expr, hop + ((symbols == 0) ? OP_SAFE_C_NC : OP_SAFE_C_S));
+	  choose_c_function(sc, expr, func, 1);
+	  return(OPT_T);
+	}
+      /* c function is not safe */
+      if (symbols == 0)
+	{
+	  set_unsafe_optimize_op(expr, hop + ((is_semisafe(func)) ? OP_CL_A : OP_C_A)); /* OP_C_C never happens */
+	  fx_annotate_arg(sc, cdr(expr), e);
+	  set_opt3_arglen(cdr(expr), 1);
+	}
+      else
+	{
+	  set_unsafely_optimized(expr);
+	  if (c_function_call(func) == g_read)
+	    set_optimize_op(expr, hop + OP_READ_S);
+	  else set_optimize_op(expr, hop + ((is_semisafe(func)) ? OP_CL_S : OP_C_S));
+	}
+      choose_c_function(sc, expr, func, 1);
+      return(OPT_F);
+    }
+  /* pairs == 1 */
+  if (bad_pairs == 0)
+    {
+      if (func_is_safe)
+	{
+	  int32_t op = combine_ops(sc, expr, E_C_P, arg1, NULL);
+	  /* if ((hop == 1) && (!op_has_hop(arg1))) hop = 0; *//* probably not the right way to fix this (s7test tc_or_a_and_a_a_la) */
+	  set_safe_optimize_op(expr, hop + op);
+
+	  if ((op == OP_SAFE_C_P) &&
+	      (is_fxable(sc, arg1)))
+	    {
+	      set_optimize_op(expr, hop + OP_SAFE_C_A);
+	      fx_annotate_arg(sc, cdr(expr), e);
+	    }
+	  choose_c_function(sc, expr, func, 1);
+	  return(OPT_T);
+	}
+      if (is_fxable(sc, arg1))
+	{
+	  set_unsafe_optimize_op(expr, hop + ((is_semisafe(func)) ? OP_CL_A : OP_C_A));
+	  fx_annotate_arg(sc, cdr(expr), e);
+	  set_opt3_arglen(cdr(expr), 1);
+	  choose_c_function(sc, expr, func, 1);
+	  return(OPT_F);
+	}}
+  else /* bad_pairs == 1 */
+    {
+      if (quotes == 1)
+	{
+	  fx_annotate_arg(sc, cdr(expr), e);
+	  set_opt3_arglen(cdr(expr), 1);
+	  if (func_is_safe)
+	    {
+	      set_safe_optimize_op(expr, hop + OP_SAFE_C_A);
+	      choose_c_function(sc, expr, func, 1);
+	      return(OPT_T);
+	    }
+	  set_unsafe_optimize_op(expr, hop + ((is_semisafe(func)) ? OP_CL_A : OP_C_A));
+	  choose_c_function(sc, expr, func, 1);
+	  return(OPT_F);
+	}
+      /* quotes == 0 */
+      if (!func_is_safe)
+	{
+	  s7_pointer lambda_expr = arg1;
+	  if ((is_ok_lambda(sc, lambda_expr)) &&
+	      (!direct_memq(car(lambda_expr), e)))            /* (let ((lambda #f)) (call-with-exit (lambda ...))) */
+	    {
+	      if (((c_function_call(func) == g_call_with_exit) ||
+		   (c_function_call(func) == g_call_cc) ||
+		   (c_function_call(func) == g_call_with_output_string)) &&
+		  (is_proper_list_1(sc, cadr(lambda_expr))) &&
+		  (is_symbol(caadr(lambda_expr))) &&
+		  (!is_probably_constant(caadr(lambda_expr)))) /* (call-with-exit (lambda (pi) ...) */
+		{
+		  if (c_function_call(func) == g_call_cc)
+		    set_unsafe_optimize_op(expr, OP_CALL_CC);
+		  else
+		    if (c_function_call(func) == g_call_with_exit)
+		      set_unsafe_optimize_op(expr, (is_null(cdddr(lambda_expr))) ? OP_CALL_WITH_EXIT_O : OP_CALL_WITH_EXIT);
+		    else
+		      {
+			set_unsafe_optimize_op(expr, OP_CALL_WITH_OUTPUT_STRING);
+			set_opt2_pair(expr, cddr(lambda_expr));
+			set_opt3_sym(expr, caadr(lambda_expr));
+			set_local(caadr(lambda_expr));
+			return(OPT_F);
+		      }
+		  choose_c_function(sc, expr, func, 1);
+		  set_opt2_pair(expr, cdr(lambda_expr));
+		  set_local(caadr(lambda_expr)); /* check_lambda_args normally handles this, but if hop==1, we'll skip that step */
+		  return(OPT_F);
+		}
+	      if ((c_function_call(func) == g_with_output_to_string) &&
+		  (is_null(cadr(lambda_expr))))
+		{
+		  set_unsafe_optimize_op(expr, OP_WITH_OUTPUT_TO_STRING);
+		  set_opt2_pair(expr, cddr(lambda_expr));
+		  return(OPT_F);
+		}}}}
+  set_unsafe_optimize_op(expr, hop + ((func_is_safe) ? OP_SAFE_C_P : OP_C_P));
+  choose_c_function(sc, expr, func, 1);
+  return(OPT_F);
+}
+
+static bool walk_fxable(s7_scheme *sc, s7_pointer tree)
+{
+  for (s7_pointer p = cdr(tree); is_pair(p); p = cdr(p))
+    {
+      s7_pointer q = car(p);
+      if ((is_pair(q)) &&
+	  (is_optimized(q)))
+	{
+	  opcode_t op = optimize_op(q);
+	  if (is_safe_c_op(op)) return(true);
+	  if ((op >= OP_TC_AND_A_OR_A_LA) ||
+	      ((op >= OP_THUNK) && (op < OP_BEGIN)) ||
+	      (!walk_fxable(sc, q)))
+	    return(false);
+	}}
+  return(true);
+}
+
+static bool is_safe_fxable(s7_scheme *sc, s7_pointer p)
+{
+  if (!is_pair(p)) return(true);
+  if (is_optimized(p))
+    {
+      if ((fx_function[optimize_op(p)]) &&
+	  (walk_fxable(sc, (p))))
+	return(true);
+    }
+  if (is_proper_quote(sc, p)) return(true);
+  if ((S7_DEBUGGING) && (is_optimized(p)) && (fx_function[optimize_op(p)])) fprintf(stderr, "omit %s: %s\n", op_names[optimize_op(p)], display(p));
+  return(false);
+}
+
+static opt_t fxify_closure_s(s7_scheme *sc, s7_pointer func, s7_pointer expr, s7_pointer e, int32_t hop)
+{
+  s7_pointer body = closure_body(func);
+  fx_annotate_arg(sc, body, e);
+  /* we can't currently fx_annotate_arg(sc, cdr(expr), e) here because that opt2 field is in use elsewhere (opt2_sym, not sure where it's set) */
+  set_safe_optimize_op(expr, hop + OP_SAFE_CLOSURE_S_A);
+  if ((is_pair(car(body))) && (is_pair(cdar(body))) && (car(closure_args(func)) == cadar(body)))
+    {
+      if (optimize_op(car(body)) == HOP_SAFE_C_S)
+	set_safe_optimize_op(expr, hop + OP_SAFE_CLOSURE_S_TO_S);
+      else
+	if (optimize_op(car(body)) == HOP_SAFE_C_SC)
+	  {
+	    s7_pointer body_arg2 = caddar(body);
+	    set_opt3_con(cdr(expr), (is_pair(body_arg2)) ? cadr(body_arg2) : body_arg2);
+	    set_safe_optimize_op(expr, hop + OP_SAFE_CLOSURE_S_TO_SC);
+	    if ((caar(body) == sc->vector_ref_symbol) && (is_global(sc->vector_ref_symbol)))
+	      set_fx_direct(cdr(expr), fx_safe_closure_s_to_vref);
+	    else
+	      {
+		set_fx_direct(cdr(expr), fx_safe_closure_s_to_sc);
+		if ((is_t_integer(body_arg2)) && (integer(body_arg2) == 1))
+		  {
+		    if (caar(body) == sc->subtract_symbol) set_fx_direct(cdr(expr), fx_safe_closure_s_to_sub1);
+		    if (caar(body) == sc->add_symbol) set_fx_direct(cdr(expr), fx_safe_closure_s_to_add1);
+		  }}}}
+  set_closure_one_form_fx_arg(func);
+  fx_tree(sc, body, car(closure_args(func)), NULL, NULL, false);
+  return(OPT_T);
+}
+
+static bool fxify_closure_a(s7_scheme *sc, s7_pointer func, bool one_form, bool safe_case, int32_t hop, s7_pointer expr, s7_pointer e)
+{
+  if (!one_form)
+    set_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_A : OP_CLOSURE_A));
+  else
+    if (!safe_case)
+      set_optimize_op(expr, hop + OP_CLOSURE_A_O);
+    else
+      {
+	s7_pointer body = closure_body(func);
+	if (!is_fxable(sc, car(body)))
+	  set_optimize_op(expr, hop + OP_SAFE_CLOSURE_A_O);
+	else
+	  {
+	    fx_annotate_arg(sc, body, e);
+	    set_safe_optimize_op(expr, hop + OP_SAFE_CLOSURE_A_A);
+	    if ((is_pair(car(body))) &&
+		(optimize_op(car(body)) == HOP_SAFE_C_SC) &&
+		(car(closure_args(func)) == cadar(body)))
+	      {
+		s7_pointer body_arg2 = caddar(body);
+		set_opt3_con(cdr(expr), (is_pair(body_arg2)) ? cadr(body_arg2) : body_arg2);
+		set_safe_optimize_op(expr, hop + OP_SAFE_CLOSURE_A_TO_SC);
+		/* why is this setting expr whereas _s case above sets cdr(expr)? */
+		if ((caar(body) == sc->vector_ref_symbol) && (is_global(sc->vector_ref_symbol)))
+		  set_fx_direct(expr, fx_safe_closure_a_to_vref);
+		else set_fx_direct(expr, fx_safe_closure_a_to_sc);
+	      }
+	    set_closure_one_form_fx_arg(func);
+	    fx_tree(sc, body, car(closure_args(func)), NULL, NULL, false);
+	    return(true);
+	  }}
+  return(false);
+}
+
+static opt_t optimize_closure_sym(s7_scheme *sc, s7_pointer expr, s7_pointer func, int32_t hop, int32_t args, s7_pointer e)
+{
+  if (fx_count(sc, expr) != args) /* fx_count starts at cdr, args here is the number of exprs in cdr(expr) -- so this means "are all args fxable" */
+    return(OPT_F);
+  set_opt3_arglen(cdr(expr), args);
+  set_opt1_lambda_add(expr, func);
+  fx_annotate_args(sc, cdr(expr), e);
+  if (is_safe_closure(func))
+    {
+      s7_pointer body = closure_body(func);
+      if (!has_fx(body)) /* does this have any effect? */
+	{
+	  fx_annotate_args(sc, body, e);
+	  fx_tree(sc, body, closure_args(func), NULL, NULL, false);
+	}
+      set_safe_optimize_op(expr, hop + OP_ANY_CLOSURE_SYM);
+      return(OPT_T);
+    }
+  set_unsafe_optimize_op(expr, hop + OP_ANY_CLOSURE_SYM);
+  return(OPT_F);
+}
+
+static opt_t optimize_closure_a_sym(s7_scheme *sc, s7_pointer expr, s7_pointer func, int32_t hop, int32_t args, s7_pointer e)
+{
+  if (fx_count(sc, expr) != args) return(OPT_F);
+  set_opt3_arglen(cdr(expr), args);
+  set_opt1_lambda_add(expr, func);
+  fx_annotate_args(sc, cdr(expr), e);
+  if (is_safe_closure(func))
+    {
+      s7_pointer body = closure_body(func);
+      if (!has_fx(body)) /* does this have any effect? */
+	{
+	  fx_annotate_args(sc, body, e);
+	  fx_tree(sc, body, car(closure_args(func)), cdr(closure_args(func)), NULL, false);
+	}
+      set_safe_optimize_op(expr, hop + OP_ANY_CLOSURE_A_SYM);
+      return(OPT_T);
+    }
+  set_unsafe_optimize_op(expr, hop + OP_ANY_CLOSURE_A_SYM);
+  return(OPT_F);
+}
+
+static opt_t optimize_closure_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer func, int32_t hop, int32_t symbols, s7_pointer e)
+{
+  bool one_form, safe_case;
+  s7_pointer body, arg1 = cadr(expr);
+  int32_t arit = closure_arity_to_int(sc, func);
+  if (arit != 1)
+    {
+      if (is_symbol(closure_args(func))) /* (arit == -1) is ambiguous: (define (f . a)...) and (define (f a . b)...) both are -1 here */
+	return(optimize_closure_sym(sc, expr, func, hop, 1, e));
+      if ((arit == -1) && (is_symbol(cdr(closure_args(func)))))
+	return(optimize_closure_a_sym(sc, expr, func, hop, 1, e));
+      return(OPT_F);
+    }
+  safe_case = is_safe_closure(func);
+  body = closure_body(func);
+  one_form = is_null(cdr(body));
+  if (is_immutable(func)) hop = 1;
+
+  if (symbols == 1)
+    {
+      set_opt2_sym(expr, arg1);
+      set_opt1_lambda_add(expr, func);
+      if (one_form)
+	{
+	  if (safe_case)
+	    {
+	      if (is_fxable(sc, car(body)))
+		return(fxify_closure_s(sc, func, expr, e, hop));
+	      set_optimize_op(expr, hop + OP_SAFE_CLOSURE_S_O); /* tleft 7638 if _O here, 7692 if not (and claims 80 in the begin setup) */
+	    }
+	  else set_optimize_op(expr, hop + OP_CLOSURE_S_O);
+	}
+      else set_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_S : OP_CLOSURE_S));
+      set_unsafely_optimized(expr);
+      return(OPT_F);
+    }
+  if (fx_count(sc, expr) == 1)
+    {
+      set_unsafely_optimized(expr);
+      set_opt1_lambda_add(expr, func);
+      fx_annotate_arg(sc, cdr(expr), e);
+      set_opt3_arglen(cdr(expr), 1);
+      if (fxify_closure_a(sc, func, one_form, safe_case, hop, expr, e)) return(OPT_T);
+      set_unsafely_optimized(expr);
+      return(OPT_F);
+    }
+  set_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_P : OP_CLOSURE_P));
+  set_opt1_lambda_add(expr, func);
+  set_opt3_arglen(cdr(expr), 1);
+  set_unsafely_optimized(expr);
+  if ((safe_case) && (one_form) && (is_fxable(sc, car(closure_body(func)))))
+    {
+      set_optimize_op(expr, hop + OP_SAFE_CLOSURE_P_A); /* other possibilities: 3p fp (ap|pa only get a few hits), but none of these matter much */
+      fx_annotate_arg(sc, closure_body(func), e);
+    }
+  return(OPT_F);  /* don't check is_optimized here for OPT_T */
+}
+
+static opt_t optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer func,
+				   int32_t hop, int32_t pairs, int32_t symbols, int32_t quotes, int32_t bad_pairs, s7_pointer e)
+{
+  s7_pointer arg1;
+  if (SHOW_EVAL_OPS) fprintf(stderr, "  %s[%d]: expr: %s, func: %s, hop: %d, pairs: %d, symbols: %d, quotes: %d, bad_pairs: %d, e: %s\n",
+			     __func__, __LINE__, display_truncated(expr), display(func), hop, pairs, symbols, quotes, bad_pairs, display_truncated(e));
+  /* very often, expr is already optimized, quoted stuff is counted under "bad_pairs"! as well as quotes */
+  if (quotes > 0)
+    {
+      if (direct_memq(sc->quote_symbol, e))
+	return(OPT_OOPS);
+      if ((bad_pairs == quotes) &&
+	  (is_symbol(car(expr))) &&
+	  (is_constant_symbol(sc, car(expr))))
+	hop = 1;
+    }
+  arg1 = cadr(expr);
+  /* need in_with_let -> search only rootlet not lookup */
+  if ((symbols == 1) &&
+      ((!arg_findable(sc, arg1, e)) || (sc->in_with_let))) /* (set! (with-let ...) ...) can involve an unbound variable otherwise bound */
+    {
+      /* wrap the bad arg in a check symbol lookup */
+      if (s7_is_aritable(sc, func, 1))
+	{
+	  set_fx_direct(cdr(expr), fx_unsafe_s);
+	  return(wrap_bad_args(sc, func, expr, 1, hop, e));
+	}
+      return(OPT_F);
+    }
+
+  switch (type(func))
+    {
+    case T_C_FUNCTION: /* these two happen much more than everything else put together, but splitting them out to avoid the switch doesn't gain much */
+      if (!c_function_is_aritable(func, 1)) return(OPT_F);
+    case T_C_RST_NO_REQ_FUNCTION:
+      return(optimize_c_function_one_arg(sc, expr, func, hop, pairs, symbols, quotes, bad_pairs, e));
+
+    case T_CLOSURE:
+      return(optimize_closure_one_arg(sc, expr, func, hop, symbols, e));
+
+    case T_CLOSURE_STAR:
+      if (is_null(closure_args(func)))
+	return(OPT_F);
+      if (fx_count(sc, expr) == 1)
+	{
+	  bool safe_case = is_safe_closure(func);
+	  if (is_immutable(func)) hop = 1;
+	  fx_annotate_arg(sc, cdr(expr), e);
+	  set_opt1_lambda_add(expr, func);
+	  set_opt3_arglen(cdr(expr), 1);
+	  set_unsafely_optimized(expr);
+
+	  if ((safe_case) && (is_null(cdr(closure_args(func)))))
+	    set_optimize_op(expr, hop + OP_SAFE_CLOSURE_STAR_A1);
+	  else
+	    if (lambda_has_simple_defaults(func))
+	      {
+		if (arglist_has_rest(sc, closure_args(func)))
+		  set_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_STAR_NA_1 : OP_CLOSURE_STAR_NA));
+		else set_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_STAR_A : OP_CLOSURE_STAR_A));
+	      }
+	    else set_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_STAR_NA_1 : OP_CLOSURE_STAR_NA));
+	}
+      return(OPT_F);
+
+      case T_C_FUNCTION_STAR:
+	if ((fx_count(sc, expr) == 1) &&
+	    (c_function_max_args(func) >= 1) &&
+	    (!is_symbol_and_keyword(arg1)))           /* the only arg should not be a keyword (needs error checks later) */
+	  {
+	    if ((hop == 0) && ((is_immutable(func)) || ((!sc->in_with_let) && (symbol_id(car(expr)) == 0)))) hop = 1;
+	    set_safe_optimize_op(expr, hop + OP_SAFE_C_STAR_A);
+	    fx_annotate_arg(sc, cdr(expr), e);
+	    set_opt3_arglen(cdr(expr), 1);
+	    set_c_function(expr, func);
+	    return(OPT_T);
+	  }
+	break;
+
+    case T_PAIR: case T_VECTOR: case T_INT_VECTOR: case T_BYTE_VECTOR: case T_FLOAT_VECTOR:
+      if (is_fxable(sc, arg1))
+	{
+	  set_unsafe_optimize_op(expr, (is_pair(func) ? OP_IMPLICIT_PAIR_REF_A : OP_IMPLICIT_VECTOR_REF_A));
+	  fx_annotate_arg(sc, cdr(expr), e);
+	  set_opt3_arglen(cdr(expr), 1);
+	  return(OPT_T);
+	}
+      break;
+
+    case T_LET:
+      if (((quotes == 1) && (is_symbol(cadr(arg1)))) || /* (e 'a) or (e ':a) */
+	  (is_symbol_and_keyword(arg1)))                /* (e :a) */
+	{
+	  s7_pointer sym = (quotes == 1) ? cadr(arg1) : arg1;
+	  if (is_keyword(sym)) sym = keyword_symbol(sym);
+	  if (func == sc->s7_starlet)                   /* (*s7* ...), sc->s7_starlet is a let */
+	    {
+	      set_safe_optimize_op(expr, OP_IMPLICIT_S7_STARLET_REF_S);
+	      set_opt3_int(expr, s7_starlet_symbol_id(sym));
+	      return(OPT_T);
+	    }
+	  set_opt3_con(expr, sym);
+	  set_unsafe_optimize_op(expr, OP_IMPLICIT_LET_REF_C);
+	  return(OPT_T);
+	}
+      /* fall through */
+
+    case T_HASH_TABLE: case T_C_OBJECT:
+      if (is_fxable(sc, arg1))
+	{
+	  set_unsafe_optimize_op(expr, (type(func) == T_LET) ? OP_IMPLICIT_LET_REF_A :
+				 ((type(func) == T_HASH_TABLE) ? OP_IMPLICIT_HASH_TABLE_REF_A : OP_IMPLICIT_C_OBJECT_REF_A));
+	  fx_annotate_arg(sc, cdr(expr), e);
+	  set_opt3_arglen(cdr(expr), 1);
+	  return(OPT_T);
+	}
+      break;
+
+    default:
+      break;
+    }
+  return((is_optimized(expr)) ? OPT_T : OPT_F);
+}
+
+static bool unsafe_is_safe(s7_scheme *sc, s7_pointer f, s7_pointer e)
+{
+  if (!is_symbol(f)) return(false);
+  f = find_uncomplicated_symbol(sc, f, e); /* how to catch local c-funcs here? */
+  if (!is_slot(f)) return(false);
+  return(is_safe_c_function(slot_value(f)));
+}
+
+static opt_t set_any_closure_np(s7_scheme *sc, s7_pointer func, s7_pointer expr, s7_pointer e, int32_t num_args, opcode_t op)
+{
+  for (s7_pointer p = cdr(expr); is_pair(p); p = cdr(p))
+    set_fx(p, fx_choose(sc, p, e, (is_list(e)) ? pair_symbol_is_safe : let_symbol_is_safe));
+  set_opt3_arglen(cdr(expr), num_args);
+  set_unsafe_optimize_op(expr, op);
+  set_opt1_lambda_add(expr, func);
+  return(OPT_F);
+}
+
+static bool two_args_ok(s7_scheme *sc, s7_pointer expr, s7_pointer e)
+{
+  if ((is_symbol(car(expr))) && ((car(expr) == sc->member_symbol) || (car(expr) == sc->assoc_symbol))) return(true);
+  return(unsafe_is_safe(sc, cadr(expr), e));
+}
+
+static void opt_sp_1(s7_scheme *sc, s7_function g, s7_pointer expr)
+{
+  set_opt1_any(cdr(expr),
+	       (s7_pointer)((intptr_t)((g == g_cons) ? OP_SAFE_CONS_SP_1 :
+				       (((g == g_multiply) || (g == g_multiply_2)) ? OP_SAFE_MULTIPLY_SP_1 :
+					(((g == g_add) || (g == g_add_2)) ? OP_SAFE_ADD_SP_1 : OP_SAFE_C_SP_1)))));
+}
+
+static opt_t set_any_c_np(s7_scheme *sc, s7_pointer func, s7_pointer expr, s7_pointer e, int32_t num_args, opcode_t op)
+{
+  /* we get semisafe funcs here of 2 args and up, very few more than 5 */
+  /* would safe_c_pp work for cl? or should unknown_* deal with op_cl_*? why aren't unknown* used in op_safe_c and op_c?
+   *   or use op_stack? error clears this? op-any-c-fp: op_any_c_2p|3p|fp? -- mimic clo_3p|4p?
+   */
+  for (s7_pointer p = cdr(expr); is_pair(p); p = cdr(p))
+    set_fx(p, fx_choose(sc, p, e, (is_list(e)) ? pair_symbol_is_safe : let_symbol_is_safe));
+  set_opt3_arglen(cdr(expr), num_args); /* for op_unknown_np */
+  set_unsafe_optimize_op(expr, op);
+  choose_c_function(sc, expr, func, num_args); /* we can use num_args -- mv will redirect to generic call */
+  return(OPT_F);
+}
+
+static s7_function io_function(s7_function func)
+{
+  if (func == g_with_input_from_string) return(with_string_in);
+  if (func == g_with_input_from_file) return(with_file_in);
+  if (func == g_with_output_to_file)  return(with_file_out);
+  if (func == g_call_with_input_string) return(call_string_in);
+  if (func == g_call_with_input_file) return(call_file_in);
+  return(call_file_out); /* call_with_output_to_file */
+}
+
+static void fixup_closure_star_aa(s7_scheme *sc, s7_pointer f, s7_pointer code, int32_t hop)
+{
+  int32_t arity = closure_star_arity_to_int(sc, f);
+  bool safe_case = is_safe_closure(f);
+  s7_pointer arg1 = cadr(code), par1 = car(closure_args(f));
+
+  if (is_pair(par1)) par1 = car(par1);
+  set_opt3_arglen(cdr(code), 2);
+  set_unsafely_optimized(code);
+
+  if ((arity == 1) && (is_symbol_and_keyword(arg1)) && (keyword_symbol(arg1) == par1))
+    set_optimize_op(code, hop + ((safe_case) ? OP_SAFE_CLOSURE_STAR_KA : OP_CLOSURE_STAR_KA));
+  else
+    if ((lambda_has_simple_defaults(f)) && (arity == 2))
+      set_optimize_op(code, hop + ((is_safe_closure(f)) ? ((is_null(cdr(closure_body(f)))) ? OP_SAFE_CLOSURE_STAR_AA_O :
+							   OP_SAFE_CLOSURE_STAR_AA) : OP_CLOSURE_STAR_NA));
+    else set_optimize_op(code, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_NA_2 : OP_CLOSURE_STAR_NA));
+}
+
+static int32_t check_lambda(s7_scheme *sc, s7_pointer form, bool optl);
+
+static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer func, int32_t hop,
+				    int32_t pairs, int32_t symbols, int32_t quotes, int32_t bad_pairs, s7_pointer e)
+{
+  s7_pointer arg1 = cadr(expr), arg2 = caddr(expr);
+  if (SHOW_EVAL_OPS) fprintf(stderr, "  %s[%d]: expr: %s, func: %s, hop: %d, pairs: %d, symbols: %d, quotes: %d, bad_pairs: %d, e: %s\n",
+			     __func__, __LINE__, display_truncated(expr), display(func), hop, pairs, symbols, quotes, bad_pairs, display_truncated(e));
+  if (quotes > 0)
+    {
+      if (direct_memq(sc->quote_symbol, e))
+	return(OPT_OOPS);
+      if ((bad_pairs == quotes) &&
+	  (is_symbol(car(expr))) &&
+	  (is_constant_symbol(sc, car(expr))))
+	hop = 1;
+    }
+  if (((is_symbol(arg1)) &&
+       (!arg_findable(sc, arg1, e))) ||
+      ((is_symbol(arg2)) &&
+       (!arg_findable(sc, arg2, e))))
+    {
+      /* wrap bad args */
+      if ((is_fxable(sc, arg1)) &&
+	  (is_fxable(sc, arg2)) &&
+	  (s7_is_aritable(sc, func, 2))) /* arg_findable key -> #t(?) so clo* ok */
+	{
+	  fx_annotate_args(sc, cdr(expr), e);
+	  return(wrap_bad_args(sc, func, expr, 2, hop, e));
+	}
+      return(OPT_F);
+    }
+  /* end of bad symbol wrappers */
+
+  if (is_c_function(func) && (c_function_is_aritable(func, 2)))
+    {
+      /* this is a mess */
+      bool func_is_safe = is_safe_procedure(func);
+      if (hop == 0) hop = hop_if_constant(sc, car(expr));
+
+      if (pairs == 0)
+	{
+	  if ((func_is_safe) ||
+	      ((is_maybe_safe(func)) && (two_args_ok(sc, expr, e))))
+	    {
+	      /* another case here: set-car! and set-cdr! are safe if symbols==1 and arg1 is the symbol (i.e. arg2 is a constant) */
+	      if (symbols == 0)
+		set_optimize_op(expr, hop + OP_SAFE_C_NC);
+	      else
+		if (symbols == 2) /* these two symbols are almost never the same, (sqrt (+ (* x x) (* y y))) */
+		  {
+		    set_optimize_op(expr, hop + OP_SAFE_C_SS);
+		    set_opt2_sym(cdr(expr), arg2);
+		  }
+		else
+		  if (is_normal_symbol(arg1))
+		    {
+		      set_opt2_con(cdr(expr), arg2);
+		      set_optimize_op(expr, hop + OP_SAFE_C_SC);
+		    }
+		  else
+		    {
+		      set_opt1_con(cdr(expr), arg1);
+		      set_opt2_sym(cdr(expr), arg2);
+		      set_optimize_op(expr, hop + OP_SAFE_C_CS);
+		    }
+	      set_optimized(expr);
+	      choose_c_function(sc, expr, func, 2);
+	      return(OPT_T);
+	    }
+
+	  set_unsafely_optimized(expr);
+	  if (symbols == 2)
+	    {
+	      if (c_function_call(func) == g_apply)
+		{
+		  set_optimize_op(expr, OP_APPLY_SS);
+		  set_opt1_cfunc(expr, func); /* not quite set_c_function */
+		  set_opt2_sym(expr, arg2);
+		}
+	      else
+		{
+		  if (is_semisafe(func))
+		    {
+		      set_opt2_sym(cdr(expr), arg2);
+		      set_optimize_op(expr, hop + OP_CL_SS);
+		    }
+		  else set_optimize_op(expr, hop + OP_C_SS);
+		  choose_c_function(sc, expr, func, 2);
+		}}
+	  else
+	    {
+	      set_optimize_op(expr, hop + ((is_semisafe(func)) ? OP_CL_AA :
+					   (((symbols == 0) && (pairs == 0) && (car(expr) == sc->values_symbol)) ? OP_C_NC : OP_C_AA)));
+	      fx_annotate_args(sc, cdr(expr), e);
+	      set_opt3_arglen(cdr(expr), 2);
+	      choose_c_function(sc, expr, func, 2);
+	      if (is_safe_procedure(opt1_cfunc(expr)))
+		{
+		  clear_unsafe(expr);
+		  /* symbols can be 0..2 here, no pairs */
+		  set_optimized(expr);
+		  if (symbols == 1)
+		    {
+		      if (is_normal_symbol(arg1))
+			{
+			  set_optimize_op(expr, hop + OP_SAFE_C_SC);
+			  set_opt2_con(cdr(expr), arg2);
+			}
+		      else
+			{
+			  set_opt1_con(cdr(expr), arg1);
+			  set_opt2_sym(cdr(expr), arg2);
+			  set_optimize_op(expr, hop + OP_SAFE_C_CS);
+			}}
+		  return(OPT_T);
+		}
+	      else
+		if ((symbols == 1) && (is_normal_symbol(arg1))) /* arg2 must be constant since pairs==0 */
+		  {
+		    set_optimize_op(expr, hop + OP_C_SC);
+		    set_opt3_con(cdr(expr), arg2); /* a very small optimization! */
+		  }}
+	  return(OPT_F);
+	}
+
+      /* pairs != 0 */
+      if ((bad_pairs == 0) &&
+	  (pairs == 2))
+	{
+	  if ((func_is_safe) ||
+	      ((is_maybe_safe(func)) && (two_args_ok(sc, expr, e))))
+	    {
+	      int32_t op = combine_ops(sc, expr, E_C_PP, arg1, arg2);
+	      set_safe_optimize_op(expr, hop + op);
+	      if (op == OP_SAFE_C_PP)
+		{
+		  if (((op_no_hop(cadr(expr))) == OP_SAFE_CLOSURE_S_TO_SC) &&
+		      ((op_no_hop(caddr(expr))) == OP_SAFE_CLOSURE_S_TO_SC) &&
+		      (is_global(caadr(expr))) && (is_global(caaddr(expr))))
+		    {
+		      /* ideally this would be OP not HOP, but safe_closure_s_to_sc is too picky */
+		      /* set_opt3_pair(expr, caddr(expr)); */ /* set_opt3_arglen(cdr(expr), 2); */
+		      set_safe_optimize_op(expr, HOP_SAFE_C_FF);
+		    }
+
+		  opt_sp_1(sc, c_function_call(func), expr); /* calls set_opt1_any, sets opt1(cdr(expr)) to OP_SAFE_CONS_SP_1 and friends */
+		  if (is_fxable(sc, arg1))
+		    {
+		      if (is_fxable(sc, arg2))
+			return(check_c_aa(sc, expr, func, hop, e)); /* AA case */
+		      set_optimize_op(expr, hop + OP_SAFE_C_AP);
+		      fx_annotate_arg(sc, cdr(expr), e);
+		      set_opt3_arglen(cdr(expr), 2);
+		    }
+		  else
+		    if (is_fxable(sc, arg2))
+		      {
+			set_optimize_op(expr, hop + OP_SAFE_C_PA);
+			fx_annotate_arg(sc, cddr(expr), e);
+			set_opt3_arglen(cdr(expr), 2);
+		      }}
+	      choose_c_function(sc, expr, func, 2); /* this might change the op to safe_c_c, so it has to be last */
+	      return(OPT_T);
+	    }}
+
+      if ((bad_pairs == 0) &&
+	  (pairs == 1))
+	{
+	  if ((func_is_safe) ||
+	      ((is_maybe_safe(func)) && (two_args_ok(sc, expr, e))))
+	    {
+	      combine_op_t orig_op;
+	      int32_t op;
+
+	      if (is_pair(arg1))
+		{
+		  orig_op = (is_normal_symbol(arg2)) ? E_C_PS : E_C_PC;
+		  op = combine_ops(sc, expr, orig_op, arg1, arg2);
+		}
+	      else
+		{
+		  orig_op = (is_normal_symbol(arg1)) ? E_C_SP : E_C_CP;
+		  op = combine_ops(sc, expr, orig_op, arg1, arg2);
+		}
+	      if ((((op == OP_SAFE_C_SP) || (op == OP_SAFE_C_CP)) &&
+		   (is_fxable(sc, arg2))) ||
+		  (((op == OP_SAFE_C_PS) || (op == OP_SAFE_C_PC)) &&
+		   (is_fxable(sc, arg1))))
+		{
+		  fx_annotate_args(sc, cdr(expr), e);
+		  if (!safe_c_aa_to_ag_ga(sc, expr, hop))
+		    {
+		      set_safe_optimize_op(expr, hop + OP_SAFE_C_AA);
+		      set_opt3_pair(expr, cddr(expr));
+		    }}
+	      else
+		{
+		  set_safe_optimize_op(expr, hop + op);
+		  if ((op == OP_SAFE_C_SP) || (op == OP_SAFE_C_CP))
+		    {
+		      opt_sp_1(sc, c_function_call(func), expr);
+		      set_opt3_any(cdr(expr), arg1);
+		    }
+		  else
+		    if (op == OP_SAFE_C_PC)
+		      set_opt3_con(cdr(expr), arg2);
+		}
+	      choose_c_function(sc, expr, func, 2);
+	      return(OPT_T);
+	    }}
+
+      if ((bad_pairs == 1) && (quotes == 1))
+	{
+	  if ((func_is_safe) ||
+	      ((is_maybe_safe(func)) && (two_args_ok(sc, expr, e))))
+	    {
+	      if  (symbols == 1)
+		{
+		  set_optimized(expr);
+		  if (is_normal_symbol(arg1))
+		    {
+		      set_opt2_con(cdr(expr), cadr(arg2));
+		      set_optimize_op(expr, hop + OP_SAFE_C_SC);
+		    }
+		  else
+		    {
+		      set_opt1_con(cdr(expr), cadr(arg1));
+		      set_opt2_sym(cdr(expr), arg2);
+		      set_optimize_op(expr, hop + OP_SAFE_C_CS);
+		    }
+		  choose_c_function(sc, expr, func, 2);
+		  return(OPT_T);
+		}
+	      if ((pairs == 1) && (is_pair(arg2))) /* QC never happens */
+		{
+		  set_safe_optimize_op(expr, hop + OP_SAFE_C_CQ);
+		  set_opt2_con(cdr(expr), cadr(arg2));
+		  choose_c_function(sc, expr, func, 2);
+		  return(OPT_T);
+		}
+	      if (!is_safe_c_s(arg1))
+		{
+		  if ((is_fxable(sc, arg1)) && (is_fxable(sc, arg2)))
+		    return(check_c_aa(sc, expr, func, hop, e));
+		}}
+	  else
+	    if (pairs == 1)
+	      {
+		set_unsafe_optimize_op(expr, hop + ((is_semisafe(func)) ? OP_CL_AA : OP_C_AA));
+		fx_annotate_args(sc, cdr(expr), e);
+		set_opt3_arglen(cdr(expr), 2);
+		choose_c_function(sc, expr, func, 2);
+		return(OPT_F);
+	      }}
+
+      if (quotes == 2)
+	{
+	  if (func_is_safe)
+	    {
+	      set_safe_optimize_op(expr, hop + OP_SAFE_C_AA); /* op_safe_c_nc -> fx_c_nc appears to leave quoted pairs quoted? */
+	      set_opt3_pair(expr, cddr(expr));
+	    }
+	  else
+	    {
+	      set_unsafe_optimize_op(expr, hop + ((is_semisafe(func)) ? OP_CL_AA : OP_C_AA));
+	      set_opt3_arglen(cdr(expr), 2);
+	    }
+	  fx_annotate_args(sc, cdr(expr), e);
+	  choose_c_function(sc, expr, func, 2);
+	  return((func_is_safe) ? OPT_T : OPT_F);
+	}
+
+      if ((pairs == 1) &&
+	  (quotes == 0) &&
+	  ((func_is_safe) ||
+	   ((is_maybe_safe(func)) && (two_args_ok(sc, expr, e)))))
+	{
+	  if (symbols == 1)
+	    {
+	      set_optimized(expr);
+	      if (is_normal_symbol(arg1)) /* this is what optimize_expression uses to count symbols */
+		{
+		  set_optimize_op(expr, hop + OP_SAFE_C_SP);
+		  opt_sp_1(sc, c_function_call(func), expr);
+		}
+	      else set_optimize_op(expr, hop + OP_SAFE_C_PS);
+	      choose_c_function(sc, expr, func, 2);
+	      if (bad_pairs == 0)
+		return(OPT_T);
+	      set_unsafe(expr);
+	      return(OPT_F);
+	    }
+	  if (symbols == 0)
+	    {
+	      set_optimized(expr);
+	      if ((is_fxable(sc, arg1)) && (is_fxable(sc, arg2)))
+		return(check_c_aa(sc, expr, func, hop, e));
+	      if (is_pair(arg1))
+		{
+		  set_optimize_op(expr, hop + OP_SAFE_C_PC);
+		  set_opt3_con(cdr(expr), arg2);
+		}
+	      else
+		{
+		  set_optimize_op(expr, hop + OP_SAFE_C_CP);
+		  opt_sp_1(sc, c_function_call(func), expr);
+		  set_opt3_any(cdr(expr), arg1);
+		}
+	      choose_c_function(sc, expr, func, 2);
+	      if (bad_pairs == 0)
+		return(OPT_T);
+	      set_unsafe(expr);
+	      return(OPT_F);
+	    }}
+
+      if ((pairs == 2) &&
+	  ((func_is_safe) ||
+	   ((is_maybe_safe(func)) && (two_args_ok(sc, expr, e)))))
+	{
+	  if ((bad_pairs == 1) &&
+	      (is_safe_c_s(arg1)))
+	    {
+	      /* unsafe func here won't work unless we check that later and make the new arg list (for list-values etc)
+	       *   (and it has to be the last pair else the unknown_g stuff can mess up)
+	       */
+	      if (is_safe_quote(car(arg2)))
+		{
+		  if (!is_proper_list_1(sc, cdr(arg2)))
+		    return(OPT_OOPS);
+		  set_safe_optimize_op(expr, hop + OP_SAFE_C_opSq_C);
+		  set_opt1_sym(cdr(expr), cadr(arg1));
+		  set_opt2_con(cdr(expr), cadr(arg2));
+		  choose_c_function(sc, expr, func, 2);
+		  return(OPT_T);
+		}}
+	  if (quotes == 0)
+	    {
+	      set_unsafely_optimized(expr);
+	      if (is_fxable(sc, arg1))
+		{
+		  if (is_fxable(sc, arg2))
+		    return(check_c_aa(sc, expr, func, hop, e));
+		  set_optimize_op(expr, hop + OP_SAFE_C_AP);
+		  opt_sp_1(sc, c_function_call(func), expr);
+		  fx_annotate_arg(sc, cdr(expr), e);
+		}
+	      else
+		if (is_fxable(sc, arg2))
+		  {
+		    set_optimize_op(expr, hop + OP_SAFE_C_PA);
+		    fx_annotate_arg(sc, cddr(expr), e);
+		  }
+		else
+		  {
+		    set_optimize_op(expr, hop + OP_SAFE_C_PP);
+		    opt_sp_1(sc, c_function_call(func), expr);
+		  }
+	      choose_c_function(sc, expr, func, 2);
+	      return(OPT_F);
+	    }
+	  if (quotes == 1)
+	    {
+	      if (is_safe_quote(car(arg1)))
+		{
+		  if (!is_proper_list_1(sc, cdr(arg1)))
+		    return(OPT_OOPS);
+		  set_optimize_op(expr, hop + OP_SAFE_C_CP);
+		  opt_sp_1(sc, c_function_call(func), expr);
+		  set_opt3_any(cdr(expr), cadr(arg1));
+		}
+	      else
+		{
+		  set_optimize_op(expr, hop + OP_SAFE_C_PC);
+		  set_opt3_con(cdr(expr), cadr(arg2));
+		}
+	      set_unsafely_optimized(expr);
+	      choose_c_function(sc, expr, func, 2);
+	      return(OPT_F);
+	    }}
+
+      if (func_is_safe)
+	{
+	  if (fx_count(sc, expr) == 2)
+	    return(check_c_aa(sc, expr, func, hop, e));
+	}
+       else
+	{
+	  if (is_fxable(sc, arg1))
+	    {
+	      if (is_fxable(sc, arg2))
+		{
+		  if ((c_function_call(func) == g_apply) &&
+		      (is_normal_symbol(arg1)))
+		    {
+		      set_optimize_op(expr, OP_APPLY_SA);
+		      if ((is_pair(arg2)) &&
+			  (is_normal_symbol(car(arg2)))) /* arg2 might be ((if expr op1 op2) ...) */
+			{
+			  s7_pointer lister = lookup(sc, car(arg2));
+			  if ((is_c_function(lister)) &&
+			      (is_pair(c_function_signature(lister))) &&
+			      (car(c_function_signature(lister)) == sc->is_proper_list_symbol))
+			    set_optimize_op(expr, OP_APPLY_SL);
+			}
+		      set_opt1_cfunc(expr, func); /* not quite set_c_function */
+		    }
+		  else set_unsafe_optimize_op(expr, hop + ((is_semisafe(func)) ? OP_CL_AA : OP_C_AA));
+		  fx_annotate_args(sc, cdr(expr), e);
+		  set_opt3_arglen(cdr(expr), 2);
+		}
+	      else
+		{
+		  if (((c_function_call(func) == g_with_input_from_string) ||
+		       (c_function_call(func) == g_with_input_from_file) ||
+		       (c_function_call(func) == g_with_output_to_file)) &&
+		      (is_ok_lambda(sc, arg2)) &&
+		      (is_null(cadr(arg2))) &&
+		      (!direct_memq(car(arg2), e)))   /* lambda is redefined?? */
+		    {
+		      set_unsafe_optimize_op(expr, (is_string(arg1)) ? OP_WITH_IO_C : OP_WITH_IO);
+		      set_opt2_pair(expr, cddr(arg2));
+		      set_opt1_any(expr, (s7_pointer)io_function(c_function_call(func)));
+		      return(OPT_F);
+		    }
+		  if (((c_function_call(func) == g_call_with_input_string) ||
+		       (c_function_call(func) == g_call_with_input_file) ||
+		       (c_function_call(func) == g_call_with_output_file)) &&
+		      (is_ok_lambda(sc, arg2)) &&
+		      (is_proper_list_1(sc, cadr(arg2))) &&
+		      (is_symbol(caadr(arg2))) &&
+		      (!is_probably_constant(caadr(arg2))) &&
+		      (!direct_memq(sc->lambda_symbol, e)))   /* lambda is redefined?? */
+		    {
+		      set_unsafe_optimize_op(expr, (is_string(arg1)) ? OP_WITH_IO_C : OP_WITH_IO);
+		      set_opt2_pair(expr, cddr(arg2));
+		      set_opt3_sym(expr, caadr(arg2));
+		      set_opt1_any(expr, (s7_pointer)io_function(c_function_call(func)));
+		      return(OPT_F);
+		    }
+		  set_unsafe_optimize_op(expr, hop + OP_C_AP);
+		  fx_annotate_arg(sc, cdr(expr), e);
+		}
+	      choose_c_function(sc, expr, func, 2);
+	      return(OPT_F);
+	    }
+
+	  if ((is_semisafe(func)) &&
+	      (is_symbol(car(expr))) &&
+	      (car(expr) != sc->values_symbol) &&
+	      (is_fxable(sc, arg2)) &&
+	      (is_pair(arg1)) &&
+	      (car(arg1) == sc->lambda_symbol))
+	    {
+	      fx_annotate_arg(sc, cddr(expr), e);
+	      set_unsafe_optimize_op(expr, hop + OP_CL_FA);
+	      check_lambda(sc, arg1, true);        /* this changes symbol_list */
+
+	      clear_symbol_list(sc);               /* so restore it */
+	      for (s7_pointer p = e; is_pair(p); p = cdr(p))
+		if (is_normal_symbol(car(p)))
+		  add_symbol_to_list(sc, car(p));
+
+	      /* two seq args can't happen here (func_2_args = map + lambda + seq, arg1 is the lambda form, arg2 is fxable (see above) */
+	      choose_c_function(sc, expr, func, 2);
+	      if (((fn_proc(expr) == g_for_each) || (fn_proc(expr) == g_map)) &&
+		  ((is_proper_list_1(sc, cadr(arg1))) &&    /* one parameter */
+		   (!is_possibly_constant(caadr(arg1)))))    /* parameter name not trouble */
+		{
+		  /* built-in permanent closure here was not much faster */
+		  set_fn(expr, (fn_proc(expr) == g_for_each) ? g_for_each_closure : NULL);
+		  set_opt3_pair(expr, cdr(arg1));
+		  set_unsafe_optimize_op(expr, OP_MAP_FOR_EACH_FA);
+		}
+	      return(OPT_F);
+	    }}
+      return(set_any_c_np(sc, func, expr, e, 2, hop + OP_ANY_C_NP)); /* OP_C_PP doesn't exist, presumably OP_SAFE_C_PP was caught above? */
+    }
+
+  if (is_closure(func))
+    {
+      bool one_form, safe_case;
+      s7_pointer body;
+      int32_t arit = closure_arity_to_int(sc, func);
+
+      if (arit != 2)
+	{
+	  if (is_symbol(closure_args(func)))
+	    return(optimize_closure_sym(sc, expr, func, hop, 2, e));
+	  if ((arit == -1) && (is_symbol(cdr(closure_args(func))))) /* (define (f a . b) ...) */
+	    return(optimize_closure_a_sym(sc, expr, func, hop, 2, e));
+	  return(OPT_F);
+	}
+      if (is_immutable(func)) hop = 1;
+
+      body = closure_body(func);
+      one_form = is_null(cdr(body));
+      safe_case = is_safe_closure(func);
+
+      if ((pairs == 0) &&
+	  (symbols >= 1))
+	{
+	  set_unsafely_optimized(expr);
+	  set_opt1_lambda_add(expr, func);
+	  if (symbols == 2)
+	    {
+	      set_opt2_sym(expr, arg2);
+	      if (!one_form)
+		set_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_SS : OP_CLOSURE_SS));
+	      else
+		if (!safe_case)
+		  set_optimize_op(expr, hop + OP_CLOSURE_SS_O);
+		else
+		  if (!is_fxable(sc, car(body)))
+		    set_optimize_op(expr, hop + OP_SAFE_CLOSURE_SS_O);
+		  else
+		    {
+		      fx_annotate_arg(sc, body, e);
+		      fx_tree(sc, body, car(closure_args(func)), cadr(closure_args(func)), NULL, false);
+		      set_safe_optimize_op(expr, hop + OP_SAFE_CLOSURE_SS_A);
+		      /* fx_annotate_args(sc, cdr(expr), e); */
+		      set_closure_one_form_fx_arg(func);
+		      return(OPT_T);
+		    }
+	      return(OPT_F);
+	    }
+	  if (is_normal_symbol(arg1))
+	    {
+	      if (one_form)
+		set_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_SC_O : OP_CLOSURE_SC_O)); /* _A case is very rare */
+	      else set_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_SC : OP_CLOSURE_SC));
+	      set_opt2_con(expr, arg2);
+	      return(OPT_F);
+	    }}
+
+      if ((!arglist_has_rest(sc, closure_args(func))) &&
+	  (fx_count(sc, expr) == 2))
+	{
+	  if (!one_form)
+	    set_safe_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_AA : OP_CLOSURE_AA));
+	  else
+	    if (!safe_case)
+	      set_optimize_op(expr, hop + OP_CLOSURE_AA_O);
+	    else
+	      if (!is_fxable(sc, car(body)))
+		set_optimize_op(expr, hop + OP_SAFE_CLOSURE_AA_O);
+	      else
+		{
+		  fx_annotate_arg(sc, body, e);
+		  set_safe_optimize_op(expr, hop + OP_SAFE_CLOSURE_AA_A); /* safe_closure_as|sa_a? */
+		  set_closure_one_form_fx_arg(func);
+		  fx_annotate_args(sc, cdr(expr), e);
+		  set_opt1_lambda_add(expr, func);
+		  set_opt3_arglen(cdr(expr), 2);
+		  return(OPT_T);
+		}
+	  fx_annotate_args(sc, cdr(expr), e);
+	  set_opt1_lambda_add(expr, func);
+	  set_opt3_arglen(cdr(expr), 2);
+	  return(OPT_F);
+	}
+
+      if (is_fxable(sc, arg1))
+	{
+	  set_unsafely_optimized(expr);
+	  fx_annotate_arg(sc, cdr(expr), e);
+	  set_safe_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_AP : OP_CLOSURE_AP));
+	  set_opt1_lambda_add(expr, func);
+	  set_opt3_arglen(cdr(expr), 2); /* for op_unknown_np */
+	  return(OPT_F);
+	}
+
+      if ((is_pair(arg1)) &&
+	  (car(arg1) == sc->lambda_symbol) &&
+	  (is_pair(cdr(arg1))) &&              /* not (lambda) */
+	  (is_fxable(sc, arg2)) &&
+	  (is_null(cdr(closure_body(func)))))
+	{
+	  fx_annotate_arg(sc, cddr(expr), e);
+	  set_opt2_pair(expr, cdr(arg1));
+	  set_unsafe_optimize_op(expr, hop + OP_CLOSURE_FA);
+	  check_lambda(sc, arg1, false);
+
+	  clear_symbol_list(sc); /* clobbered in check_lambda so restore it? */
+	  for (s7_pointer p = e; is_pair(p); p = cdr(p))
+	    if (is_normal_symbol(car(p)))
+	      add_symbol_to_list(sc, car(p));
+
+	  /* check_lambda calls optimize_lambda if define in progress, else just optimize on the body */
+	  clear_safe_closure_body(cddr(arg1)); /* otherwise we need to fixup the local let for the optimizer -- see s7test intersection case 91492 */
+	  set_opt1_lambda_add(expr, func);
+	  return(OPT_F);
+	}
+
+      if (is_fxable(sc, arg2))
+	{
+	  set_unsafely_optimized(expr);
+	  fx_annotate_arg(sc, cddr(expr), e);
+	  set_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_PA : OP_CLOSURE_PA));
+	  set_opt1_lambda_add(expr, func);
+	  set_opt3_arglen(cdr(expr), 2); /* for op_unknown_np */
+	  return(OPT_F);
+	}
+
+      if (is_safe_closure(func)) /* clo* too */
+	return(set_any_closure_np(sc, func, expr, e, 2, hop + OP_SAFE_CLOSURE_PP));
+
+      set_unsafely_optimized(expr);
+      set_optimize_op(expr, hop + OP_CLOSURE_PP);
+      set_opt1_lambda_add(expr, func);
+      set_opt3_arglen(cdr(expr), 2); /* for op_unknown_np */
+      return(OPT_F);
+    }
+
+  if (is_closure_star(func))
+    {
+      if (!closure_star_is_aritable(sc, func, closure_args(func), 1)) /* not 2, cadr(expr) might be keyword or pair->keyword etc */
+	return(OPT_OOPS);                                             /* (let* cons () (lambda* (a . b) (cons a b))) so closure_args=(), arity=0 ?? */
+      if (is_immutable(func)) hop = 1;
+      if (fx_count(sc, expr) == 2)
+	{
+	  fixup_closure_star_aa(sc, func, expr, hop);
+	  fx_annotate_args(sc, cdr(expr), e);
+	  set_opt1_lambda_add(expr, func);
+	  return(OPT_F);
+	}}
+
+  if ((is_c_function_star(func)) &&
+      (fx_count(sc, expr) == 2) &&
+      (c_function_max_args(func) >= 1) &&
+      (!is_symbol_and_keyword(arg2)))
+    {
+      if ((hop == 0) && ((is_immutable(func)) || ((!sc->in_with_let) && (symbol_id(car(expr)) == 0)))) hop = 1;
+      set_optimized(expr);
+      set_optimize_op(expr, hop + OP_SAFE_C_STAR_AA); /* k+c? = cc */
+      fx_annotate_args(sc, cdr(expr), e);
+      set_opt3_arglen(cdr(expr), 2);
+      set_c_function(expr, func);
+      return(OPT_T);
+    }
+
+  if ((((is_any_vector(func)) && (vector_rank(func) == 2)) || (is_pair(func))) &&
+      (is_fxable(sc, arg1)) && (is_fxable(sc, arg2)))
+    {
+      set_unsafe_optimize_op(expr, ((is_pair(func)) ? OP_IMPLICIT_PAIR_REF_AA : OP_IMPLICIT_VECTOR_REF_AA));
+      fx_annotate_args(sc, cdr(expr), e);
+      set_opt3_arglen(cdr(expr), 2);
+      return(OPT_T);
+    }
+  return((is_optimized(expr)) ? OPT_T : OPT_F);
+}
+
+static opt_t optimize_safe_c_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer func,
+					     int32_t hop, int32_t pairs, int32_t symbols, int32_t quotes, s7_pointer e)
+{
+  s7_pointer arg1 = cadr(expr), arg2 = caddr(expr), arg3 = cadddr(expr);
+  if (pairs == 0)
+    {
+      set_optimized(expr);
+      if (symbols == 0)
+	set_optimize_op(expr, hop + OP_SAFE_C_NC);
+      else
+	{
+	  clear_has_fx(cdr(expr));
+	  if (symbols == 3)
+	    {
+	      set_optimize_op(expr, hop + OP_SAFE_C_SSS);
+	      set_opt1_sym(cdr(expr), arg2);
+	      set_opt2_sym(cdr(expr), arg3);
+	    }
+	  else
+	    if (symbols == 2)
+	      if (!is_normal_symbol(arg1))
+		{
+		  set_optimize_op(expr, hop + OP_SAFE_C_CSS);
+		  set_opt1_sym(cdr(expr), arg2);
+		  set_opt2_sym(cdr(expr), arg3);
+		}
+	      else
+		if (!is_normal_symbol(arg3))
+		  {
+		    set_opt2_con(cdr(expr), arg3);
+		    set_opt1_sym(cdr(expr), arg2);
+		    set_optimize_op(expr, hop + OP_SAFE_C_SSC);
+		  }
+		else
+		  {
+		    set_opt1_con(cdr(expr), arg2);
+		    set_opt2_sym(cdr(expr), arg3);
+		    set_optimize_op(expr, hop + OP_SAFE_C_SCS);
+		  }
+	    else
+	      if (is_normal_symbol(arg1))
+		{
+		  set_opt1_con(cdr(expr), arg2);
+		  set_opt2_con(cdr(expr), arg3);
+		  set_optimize_op(expr, hop + OP_SAFE_C_SCC);
+		}
+	      else
+		if (is_normal_symbol(arg2))
+		  {
+		    set_opt1_sym(cdr(expr), arg2);
+		    set_opt2_con(cdr(expr), arg3);
+		    set_opt3_con(cdr(expr), arg1);
+		    set_optimize_op(expr, hop + OP_SAFE_C_CSC);
+		  }
+		else
+		  {
+		    set_opt1_sym(cdr(expr), arg3);
+		    set_opt2_con(cdr(expr), arg2);
+		    set_opt3_con(cdr(expr), arg1);
+		    set_optimize_op(expr, hop + OP_SAFE_C_CCS);
+		  }}
+      choose_c_function(sc, expr, func, 3);
+      return(OPT_T);
+    }
+
+  /* pairs != 0 */
+  if (fx_count(sc, expr) == 3)
+    {
+      set_optimized(expr);
+      if (quotes == 1)
+	{
+	  if ((symbols == 2) &&
+	      (is_normal_symbol(arg1)) &&
+	      (is_normal_symbol(arg3)))
+	    {
+	      set_opt1_con(cdr(expr), cadr(arg2));        /* fx_c_scs uses opt1_con */
+	      clear_has_fx(cdr(expr));                    /* (s7test safe_c_func_three_args) this is used above -- maybe just clear it at the top? */
+	      set_opt2_sym(cdr(expr), arg3);
+	      set_optimize_op(expr, hop + OP_SAFE_C_SCS); /* used to be SQS */
+	      choose_c_function(sc, expr, func, 3);
+	      return(OPT_T);
+	    }
+	  if (symbols == 1)
+	    {
+	      if ((is_normal_symbol(arg3)) &&
+		  (is_proper_quote(sc, arg2)) &&
+		  (is_safe_c_s(arg1)))
+		{
+		  set_safe_optimize_op(expr, hop + OP_SAFE_C_opSq_CS); /* lg */
+		  set_opt1_con(cdr(expr), cadr(arg2)); /* opt1_con is T_Exs (unchecked) */
+		  set_opt2_sym(cdr(expr), arg3);
+		  set_opt3_sym(cdr(expr), cadr(arg1));
+		  choose_c_function(sc, expr, func, 3);
+		  return(OPT_T);
+		}
+	      if ((is_normal_symbol(arg2)) &&
+		  (is_proper_quote(sc, arg1)) &&
+		  (!is_pair(arg3)))
+		{
+		  set_optimize_op(expr, hop + OP_SAFE_C_CSC);
+		  set_opt1_sym(cdr(expr), arg2);
+		  set_opt2_con(cdr(expr), arg3);
+		  set_opt3_con(cdr(expr), cadr(arg1));
+		  choose_c_function(sc, expr, func, 3);
+		  return(OPT_T);
+		}}}
+
+      fx_annotate_args(sc, cdr(expr), e);
+      set_opt3_arglen(cdr(expr), 3);
+      set_opt3_pair(expr, cddr(expr));
+      set_optimize_op(expr, hop + OP_SAFE_C_AAA);
+
+      if (pairs == 1)
+	{
+	  if (is_pair(arg1)) set_optimize_op(expr, hop + OP_SAFE_C_AGG);
+
+	  if ((symbols == 0) && (is_pair(arg2)))
+	    set_optimize_op(expr, hop + OP_SAFE_C_CAC);
+	  else
+	    {
+	      if ((symbols == 1) && (is_pair(arg3)))
+		set_optimize_op(expr, hop + ((is_normal_symbol(arg2)) ? OP_SAFE_C_CSA : OP_SAFE_C_SCA));
+	      else
+		{
+		  if (symbols == 2)
+		    {
+		      if (is_normal_symbol(arg1))
+			{
+			  if (is_normal_symbol(arg2))
+			    {
+			      set_optimize_op(expr, hop + OP_SAFE_C_SSA);
+			      clear_has_fx(cdr(expr)); /* has_fx might have been on (see s7test) */
+			    }
+			  else set_optimize_op(expr, hop + OP_SAFE_C_SAS);
+			}
+		      else
+			if (is_pair(arg1))
+			  set_optimize_op(expr, hop + OP_SAFE_C_ASS);
+		    }}}}
+      else
+	if ((is_normal_symbol(arg1)) && (pairs == 2))
+	  set_optimize_op(expr, hop + OP_SAFE_C_SAA);
+
+      choose_c_function(sc, expr, func, 3);
+      return(OPT_T);
+    }
+  return(OPT_F); /* tell caller to try something else */
+}
+
+static opt_t optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer func, int32_t hop,
+				      int32_t pairs, int32_t symbols, int32_t quotes, int32_t bad_pairs, s7_pointer e)
+{
+  s7_pointer arg1, arg2, arg3;
+  if ((quotes > 0) &&
+      (direct_memq(sc->quote_symbol, e)))
+    return(OPT_OOPS);
+
+  arg1 = cadr(expr);
+  arg2 = caddr(expr);
+  arg3 = cadddr(expr);
+  if (((is_symbol(arg1)) &&
+       (!arg_findable(sc, arg1, e))) ||
+      ((is_symbol(arg2)) &&
+       (!arg_findable(sc, arg2, e))) ||
+      ((is_symbol(arg3)) &&
+       (!arg_findable(sc, arg3, e))))
+    {
+      /* wrap bad args */
+      if ((is_fxable(sc, arg1)) &&
+	  (is_fxable(sc, arg2)) &&
+	  (is_fxable(sc, arg3)) &&
+	  (s7_is_aritable(sc, func, 3)))
+	{
+	  fx_annotate_args(sc, cdr(expr), e);
+	  set_opt3_arglen(cdr(expr), 3);
+	  if (is_c_function(func))
+	    {
+	      if (is_safe_procedure(func))
+		{
+		  set_safe_optimize_op(expr, hop + OP_SAFE_C_AAA);
+		  set_opt3_pair(cdr(expr), cdddr(expr));
+		  set_opt3_pair(expr, cddr(expr));
+		}
+	      else set_safe_optimize_op(expr, hop + ((is_semisafe(func)) ? OP_CL_NA : OP_C_NA));
+	      set_c_function(expr, func);
+	      return(OPT_T);
+	    }
+	  if ((is_closure(func)) &&
+	      (closure_arity_to_int(sc, func) == 3) &&
+	      (!arglist_has_rest(sc, closure_args(func))))
+	    {
+	      set_unsafely_optimized(expr);
+	      set_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_3A : OP_CLOSURE_3A));
+	      set_opt1_lambda_add(expr, func);
+	      return(OPT_F);
+	    }
+	  if ((is_closure_star(func)) &&
+	      (lambda_has_simple_defaults(func)) &&
+	      (closure_star_arity_to_int(sc, func) != 0) &&
+	      (closure_star_arity_to_int(sc, func) != 1))
+	    {
+	      set_unsafely_optimized(expr);
+	      if ((is_safe_closure(func)) && (closure_star_arity_to_int(sc, func) == 3))
+		set_optimize_op(expr, OP_SAFE_CLOSURE_STAR_3A);
+	      else set_optimize_op(expr, ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_STAR_NA : OP_CLOSURE_STAR_NA));
+	      set_opt1_lambda_add(expr, func);
+	    }}
+      return(OPT_F);
+    }  /* end of bad symbol wrappers */
+
+  if ((bad_pairs == quotes) &&
+      (is_symbol(car(expr))) &&
+      (is_constant_symbol(sc, car(expr))))
+    hop = 1;
+
+  if (is_c_function(func) && (c_function_is_aritable(func, 3)))
+    {
+      if (hop == 0) hop = hop_if_constant(sc, car(expr));
+      if ((is_safe_procedure(func)) ||
+	  ((is_maybe_safe(func)) && (unsafe_is_safe(sc, arg3, e))))
+	{
+	  if (optimize_safe_c_func_three_args(sc, expr, func, hop, pairs, symbols, quotes, e) == OPT_T)
+	    return(OPT_T);
+	  if ((is_normal_symbol(arg1)) && (is_normal_symbol(arg2)))
+	    {
+	      set_opt3_pair(expr, arg3);
+	      set_unsafe_optimize_op(expr, hop + OP_SAFE_C_SSP); /* vector-set! in tbig apparently */
+	      choose_c_function(sc, expr, func, 3);
+	      return(OPT_F);
+	    }
+	  return(set_any_c_np(sc, func, expr, e, 3, hop + OP_SAFE_C_3P));
+	}
+      /* func is not safe */
+      if (fx_count(sc, expr) == 3)
+	{
+	  set_optimized(expr);
+	  fx_annotate_args(sc, cdr(expr), e);
+	  set_opt3_arglen(cdr(expr), 3);
+	  if (is_semisafe(func))
+	    set_optimize_op(expr, hop + (((is_normal_symbol(arg1)) && (is_normal_symbol(arg3))) ? OP_CL_SAS : OP_CL_NA));
+	  else
+	    if ((fx_proc(cdr(expr)) == fx_c) && (fx_proc(cddr(expr)) == fx_c) && (fx_proc(cdddr(expr)) == fx_c))
+	      set_optimize_op(expr, hop + OP_C_NC);
+	    else set_optimize_op(expr, hop + OP_C_NA);
+	  choose_c_function(sc, expr, func, 3);
+	  set_unsafe(expr);
+	  return(OPT_F);
+	}
+
+      /* (define (hi) (catch #t (lambda () 1) (lambda args 2)))
+       *   first arg list must be (), second a symbol
+       */
+      if (c_function_call(func) == g_catch)
+	{
+	  if (((bad_pairs == 2) && (!is_pair(arg1))) ||
+	      ((bad_pairs == 3) && (is_quote(car(arg1)))))
+	    {
+	      s7_pointer body_lambda = arg2, error_lambda = arg3;
+	      if ((is_ok_lambda(sc, body_lambda)) &&
+		  (is_ok_lambda(sc, error_lambda)) &&
+		  (is_null(cadr(body_lambda))) &&
+		  (((is_symbol(cadr(error_lambda))) &&                /* (lambda args ... */
+		    (!is_probably_constant(cadr(error_lambda)))) ||
+		   ((is_pair(cadr(error_lambda))) &&                  /* (lambda (type info) ... */
+		    (is_pair(cdadr(error_lambda))) &&
+		    (is_null(cddadr(error_lambda))) &&
+		    (!is_probably_constant(caadr(error_lambda))) &&   /* (lambda (pi ...) ...) */
+		    (!is_probably_constant(cadadr(error_lambda))))))
+		{
+		  s7_pointer error_result = caddr(error_lambda);
+		  set_unsafely_optimized(expr);
+		  if ((arg1 == sc->T) &&                              /* tag is #t */
+		      (is_null(cdddr(error_lambda))) &&               /* error lambda body is one expr */
+		      ((!is_symbol(error_result)) ||                  /* (lambda args #f) */
+		       ((is_pair(cadr(error_lambda))) &&
+			(error_result == caadr(error_lambda)))) &&    /* (lambda (type info) type) */
+		      ((!is_pair(error_result)) ||
+		       (is_quote(car(error_result))) ||               /* (lambda args 'a) */
+		       ((car(error_result) == sc->car_symbol) &&
+			(is_pair(cdr(error_result))) &&               /* (lambda (type info) (car)) */
+			(cadr(error_result) == cadr(error_lambda))))) /* (lambda args (car args) -> error-type */
+		    {
+		      set_optimize_op(expr, OP_C_CATCH_ALL);          /* catch_all* = #t tag, error handling can skip to the simple lambda body */
+		      set_c_function(expr, func);
+
+		      if (is_pair(error_result))
+			error_result = (is_quote(car(error_result))) ? cadr(error_result) : sc->unused;
+		      else
+			if (is_symbol(error_result))
+			  error_result = sc->unused;
+		      set_opt2_con(expr, error_result);               /* for op_c_catch_all|_a -> stack */
+
+		      set_opt1_pair(cdr(expr), cddr(body_lambda));
+		      if (is_null(cdddr(body_lambda)))
+			{
+			  if (is_fxable(sc, caddr(body_lambda)))
+			    {
+			      set_optimize_op(expr, OP_C_CATCH_ALL_A);
+			      set_fx_direct(cddr(body_lambda), fx_choose(sc, cddr(body_lambda), sc->curlet, let_symbol_is_safe));
+			    }
+			  else
+			    {
+			      set_opt1_pair(cdr(expr), caddr(body_lambda));
+			      set_optimize_op(expr, OP_C_CATCH_ALL_O);
+			      /* fn got no hits */
+			    }}}
+		  else
+		    {
+		      set_optimize_op(expr, OP_C_CATCH); /* mainly c_catch_p, but this is not a common case */
+		      choose_c_function(sc, expr, func, 3);
+		    }
+		  return(OPT_F);
+		}}}
+
+      if ((is_semisafe(func)) &&
+	  (is_symbol(car(expr))) && (car(expr) != sc->values_symbol) &&
+	  (is_fxable(sc, arg2)) && (is_fxable(sc, arg3)) &&
+	  (is_pair(arg1)) && (car(arg1) == sc->lambda_symbol))
+	{
+	  choose_c_function(sc, expr, func, 3);
+	  if (((fn_proc(expr) == g_for_each) || (fn_proc(expr) == g_map)) &&
+	      (is_proper_list_2(sc, cadr(arg1))) &&                                /* two parameters */
+	      (is_symbol(caadr(arg1))) && (!is_possibly_constant(caadr(arg1))) &&  /* parameter name not trouble */
+	      (is_symbol(cadadr(arg1))) && (!is_possibly_constant(cadadr(arg1))))
+	    {
+	      fx_annotate_args(sc, cddr(expr), e);
+	      check_lambda(sc, arg1, true);        /* this changes symbol_list */
+
+	      clear_symbol_list(sc);               /* so restore it */
+	      for (s7_pointer p = e; is_pair(p); p = cdr(p))
+		if (is_normal_symbol(car(p)))
+		  add_symbol_to_list(sc, car(p));
+
+	      set_fn(expr, (fn_proc(expr) == g_for_each) ? g_for_each_closure_2 : NULL);
+	      set_opt3_pair(expr, cdr(arg1));
+	      set_unsafe_optimize_op(expr, OP_MAP_FOR_EACH_FAA);
+	      return(OPT_F);
+	    }}
+
+      if ((is_safe_procedure(func)) ||
+	  ((is_semisafe(func)) &&
+	   (((car(expr) != sc->assoc_symbol) && (car(expr) != sc->member_symbol)) ||
+	    (unsafe_is_safe(sc, arg3, e)))))
+	return(set_any_c_np(sc, func, expr, e, 3, hop + OP_SAFE_C_3P));
+      return(set_any_c_np(sc, func, expr, e, 3, hop + OP_ANY_C_NP));
+    }
+
+  /* not c func */
+  if (is_closure(func))
+    {
+      int32_t arit = closure_arity_to_int(sc, func);
+      if (arit != 3)
+	{
+	  if (is_symbol(closure_args(func)))
+	    return(optimize_closure_sym(sc, expr, func, hop, 3, e));
+	  return(OPT_F);
+	}
+      if (is_immutable(func)) hop = 1;
+
+      if (symbols == 3)
+	{
+	  s7_pointer body = closure_body(func);
+	  bool one_form = is_null(cdr(body));
+	  set_opt1_lambda_add(expr, func);
+	  set_opt3_arglen(cdr(expr), 3);
+
+	  if (is_safe_closure(func))
+	    {
+	      if ((one_form) &&
+		  (is_fxable(sc, car(body))))
+		{
+		  set_opt2_sym(expr, arg2);
+		  set_opt3_sym(expr, arg3);
+		  fx_annotate_arg(sc, body, e);
+		  fx_tree(sc, body, car(closure_args(func)), cadr(closure_args(func)), caddr(closure_args(func)), false);
+		  set_safe_optimize_op(expr, hop + OP_SAFE_CLOSURE_3S_A);
+		  set_closure_one_form_fx_arg(func);
+		}
+	      else set_optimize_op(expr, hop + OP_SAFE_CLOSURE_3S);
+	      return(OPT_T);
+	    }
+	  set_unsafe_optimize_op(expr, hop + ((one_form) ? OP_CLOSURE_3S_O : OP_CLOSURE_3S));
+	  return(OPT_F);
+	}
+
+      if (fx_count(sc, expr) == 3)
+	{
+	  if (is_safe_closure(func))
+	    {
+	      if ((!is_pair(arg2)) && (!is_pair(arg3)))
+		set_optimize_op(expr, hop + OP_SAFE_CLOSURE_AGG);
+	      else
+		if (is_normal_symbol(arg1))
+		  set_optimize_op(expr, hop + ((is_normal_symbol(arg2)) ? OP_SAFE_CLOSURE_SSA : OP_SAFE_CLOSURE_SAA));
+		else set_optimize_op(expr, hop + OP_SAFE_CLOSURE_3A);
+	    }
+	  else
+	    if ((is_normal_symbol(arg2)) && (is_normal_symbol(arg3)))
+	      set_optimize_op(expr, hop + OP_CLOSURE_ASS);
+	    else
+	      if (is_normal_symbol(arg1))
+		set_optimize_op(expr, hop + ((is_normal_symbol(arg3)) ? OP_CLOSURE_SAS : OP_CLOSURE_SAA));
+	      else
+		if (is_normal_symbol(arg3))
+		  set_optimize_op(expr, hop + OP_CLOSURE_AAS);
+		else set_optimize_op(expr, hop + ((is_normal_symbol(arg2)) ?  OP_CLOSURE_ASA : OP_CLOSURE_3A));
+	  set_unsafely_optimized(expr);
+	  fx_annotate_args(sc, cdr(expr), e);
+
+	  if (is_fx_treeable(cdr(expr)))
+	    fx_tree(sc, closure_body(func), car(closure_args(func)), cadr(closure_args(func)), caddr(closure_args(func)), false);
+
+	  set_opt1_lambda_add(expr, func);
+	  set_opt3_arglen(cdr(expr), 3);
+	  return(OPT_F);
+	}
+      return(set_any_closure_np(sc, func, expr, e, 3, hop + OP_ANY_CLOSURE_3P));
+    }
+
+  if (is_closure_star(func))
+    {
+      if ((!lambda_has_simple_defaults(func)) ||
+	  (closure_star_arity_to_int(sc, func) == 0) ||
+	  (closure_star_arity_to_int(sc, func) == 1))
+	return(OPT_F);
+      if (fx_count(sc, expr) == 3)
+	{
+	  if (is_immutable(func)) hop = 1;
+	  if ((is_safe_closure(func)) && (closure_star_arity_to_int(sc, func) == 3))
+	    set_optimize_op(expr, OP_SAFE_CLOSURE_STAR_3A);
+	  else set_unsafe_optimize_op(expr, hop + ((is_safe_closure(func) ? OP_SAFE_CLOSURE_STAR_NA : OP_CLOSURE_STAR_NA)));
+	  fx_annotate_args(sc, cdr(expr), e);
+	  set_opt1_lambda_add(expr, func);
+	  set_opt3_arglen(cdr(expr), 3);
+	  return(OPT_F);
+	}}
+
+  if ((is_c_function_star(func)) &&
+      (fx_count(sc, expr) == 3) &&
+      (c_function_max_args(func) >= 2))
+    {
+      set_safe_optimize_op(expr, hop + OP_SAFE_C_STAR_NA);
+      fx_annotate_args(sc, cdr(expr), e);
+      set_opt3_arglen(cdr(expr), 3);
+      set_c_function(expr, func);
+      return(OPT_T);
+    }
+  /* implicit_vector_3a doesn't happen */
+
+  if (bad_pairs > quotes) return(OPT_F);
+  return((is_optimized(expr)) ? OPT_T : OPT_F);
+}
+
+static bool symbols_are_safe(s7_scheme *sc, s7_pointer args, s7_pointer e)
+{
+  for (s7_pointer p = args; is_pair(p); p = cdr(p))
+    {
+      s7_pointer arg = car(p);
+      if ((is_normal_symbol(arg)) &&
+	  (!arg_findable(sc, arg, e)))
+	return(false);
+    }
+  return(true);
+}
+
+static opt_t optimize_func_many_args(s7_scheme *sc, s7_pointer expr, s7_pointer func, int32_t hop, int32_t args,
+				     int32_t pairs, int32_t symbols, int32_t quotes, int32_t bad_pairs, s7_pointer e)
+{
+  bool func_is_closure;
+  if (quotes > 0)
+    {
+      if (direct_memq(sc->quote_symbol, e))
+	return(OPT_OOPS);
+      if ((bad_pairs == quotes) &&
+	  (is_symbol(car(expr))) &&
+	  (is_constant_symbol(sc, car(expr))))
+	hop = 1;
+    }
+  if ((is_c_function(func)) && (c_function_is_aritable(func, args)))
+    {
+      if (hop == 0) hop = hop_if_constant(sc, car(expr));
+      if (is_safe_procedure(func))
+	{
+	  if (pairs == 0)
+	    {
+	      if (symbols == 0)
+		{
+		  set_safe_optimize_op(expr, hop + OP_SAFE_C_NC);
+		  choose_c_function(sc, expr, func, args);
+		  return(OPT_T);
+		}
+	      if (symbols == args)
+		{
+		  if (symbols_are_safe(sc, cdr(expr), e))
+		    set_safe_optimize_op(expr, hop + OP_SAFE_C_NS);
+		  else
+		    {
+		      set_safe_optimize_op(expr, hop + ((args == 4) ? OP_SAFE_C_4A : OP_SAFE_C_NA));
+		      fx_annotate_args(sc, cdr(expr), e);
+		    }
+		  set_opt3_arglen(cdr(expr), args);
+		  choose_c_function(sc, expr, func, args);
+		  return(OPT_T);
+		}}
+
+	  if (fx_count(sc, expr) == args)
+	    {
+	      s7_pointer p;
+	      set_optimized(expr);
+	      set_optimize_op(expr, hop + ((args == 4) ? OP_SAFE_C_4A : OP_SAFE_C_NA));
+	      fx_annotate_args(sc, cdr(expr), e);
+	      set_opt3_arglen(cdr(expr), args);
+	      choose_c_function(sc, expr, func, args);
+
+	      for (p = cdr(expr); (is_pair(p)) && (is_pair(cdr(p))); p = cddr(p))
+		{
+		  if (is_normal_symbol(car(p)))
+		    break;
+		  if ((is_pair(car(p))) &&
+		      ((!is_pair(cdar(p))) || (!is_quote(caar(p)))))
+		    break;
+		}
+	      if (is_null(p))
+		{
+		  set_optimize_op(expr, hop + OP_SAFE_C_ALL_CA);
+		  for (p = cdr(expr); is_pair(p); p = cddr(p))
+		    {
+		      clear_has_fx(p);
+		      set_opt2_con(p, (is_pair(car(p))) ? cadar(p) : car(p));
+		    }}
+	      return(OPT_T);
+	    }
+	  return(set_any_c_np(sc, func, expr, e, args, hop + OP_ANY_C_NP));
+	}
+      /* c_func is not safe */
+      if (fx_count(sc, expr) == args) /* trigger_size doesn't matter for unsafe funcs */
+	{
+	  fx_annotate_args(sc, cdr(expr), e);
+	  set_opt3_arglen(cdr(expr), args);
+	  set_unsafe_optimize_op(expr, hop + ((is_semisafe(func)) ? OP_CL_NA : OP_C_NA));
+	  choose_c_function(sc, expr, func, args);
+	  return(OPT_F);
+	}
+      return(set_any_c_np(sc, func, expr, e, args, hop + OP_ANY_C_NP)); /* was num_args=3! 2-Sep-20 */
+    }
+
+  func_is_closure = is_closure(func);
+  if (func_is_closure)
+    {
+      int32_t arit = closure_arity_to_int(sc, func);
+      if (arit != args)
+	{
+	  if (is_symbol(closure_args(func)))
+	    return(optimize_closure_sym(sc, expr, func, hop, args, e));
+	  return(OPT_F);
+	}
+      if (is_immutable(func)) hop = 1;
+
+      if (fx_count(sc, expr) == args)
+	{
+	  bool safe_case = is_safe_closure(func);
+	  set_unsafely_optimized(expr);
+	  set_unsafe_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_NA : ((args == 4) ? OP_CLOSURE_4A : OP_CLOSURE_NA)));
+	  fx_annotate_args(sc, cdr(expr), e);
+	  set_opt3_arglen(cdr(expr), args);
+	  set_opt1_lambda_add(expr, func);
+
+	  if ((symbols == args) &&
+	      (symbols_are_safe(sc, cdr(expr), e)))
+	    {
+	      if (safe_case)
+		set_optimize_op(expr, hop + OP_SAFE_CLOSURE_NS);
+	      else set_optimize_op(expr, hop + ((args == 4) ? ((is_null(cdr(closure_body(func)))) ? OP_CLOSURE_4S_O : OP_CLOSURE_4S) :
+						((args == 5) ? OP_CLOSURE_5S : OP_CLOSURE_NS)));
+	    }
+	  return(OPT_F);
+	}
+      if (args == 4)
+	return(set_any_closure_np(sc, func, expr, e, 4, hop + OP_ANY_CLOSURE_4P));
+      return(set_any_closure_np(sc, func, expr, e, args, hop + OP_ANY_CLOSURE_NP));
+    }
+
+  if ((is_closure_star(func)) &&
+      ((!lambda_has_simple_defaults(func)) ||
+       (closure_star_arity_to_int(sc, func) == 0) ||
+       (closure_star_arity_to_int(sc, func) == 1)))
+    return(OPT_F);
+
+  if ((is_c_function_star(func)) &&
+      (fx_count(sc, expr) == args) &&
+      (c_function_max_args(func) >= (args / 2)))
+    {
+      if (is_immutable(func)) hop = 1;
+      set_safe_optimize_op(expr, hop + OP_SAFE_C_STAR_NA);
+      fx_annotate_args(sc, cdr(expr), e);
+      set_opt3_arglen(cdr(expr), args);
+      set_c_function(expr, func);
+      return(OPT_T);
+    }
+  if (((func_is_closure) ||
+       (is_closure_star(func))) &&
+      (fx_count(sc, expr) == args))
+    {
+      set_unsafely_optimized(expr);
+      if (func_is_closure)
+	set_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_NA : ((args == 4) ? OP_CLOSURE_4A : OP_CLOSURE_NA)));
+      else set_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_STAR_NA : OP_CLOSURE_STAR_NA));
+      fx_annotate_args(sc, cdr(expr), e);
+      set_opt3_arglen(cdr(expr), args);
+      set_opt1_lambda_add(expr, func);
+      return(OPT_F);
+    }
+  return((is_optimized(expr)) ? OPT_T : OPT_F);
+}
+
+static bool vars_syntax_ok(s7_pointer vars)
+{
+  for (s7_pointer p = vars; is_pair(p); p = cdr(p))
+    {
+      s7_pointer var = car(p);
+      if ((!is_pair(var)) ||
+	  (!is_symbol(car(var))) ||
+	  (!is_pair(cdr(var))) ||
+	  (is_pair(cddr(var))))
+	return(false);
+    }
+  return(true);
+}
+
+static opt_t optimize_expression(s7_scheme *sc, s7_pointer expr, int32_t hop, s7_pointer e, bool export_ok);
+
+static bool vars_opt_ok(s7_scheme *sc, s7_pointer vars, int32_t hop, s7_pointer e)
+{
+  for (s7_pointer p = vars; is_pair(p); p = cdr(p))
+    {
+#if 0
+      s7_pointer var = car(p);
+      s7_pointer init = cadr(var);
+      /* if ((is_slot(global_slot(car(var)))) && (is_c_function(global_value(car(var))))) return(false); */ /* too draconian (see snd-test) */
+      if ((is_normal_symbol(car(var))) && (is_global(car(var)))) /* (define (f) (let ((+ -)) (with-let (curlet) (#_integer? (+))))) (f) */
+	{
+	  /* fprintf(stderr, "set %s local in %s\n", display(car(var)), display_truncated(vars)); */
+	  set_local(car(var));
+	  return(false);
+	}
+      /* also too draconian (tall for example) but +/- above is broken now (returns #t)
+       *   perhaps set_local could be undone upon leaving the let if there's no capture possible:
+       *   for each here, save full type, add to list, set_local, then when let opt is done, reset to outside type
+       *   would need lists of such lists following the let chain
+       */
+#else
+      s7_pointer init = cadar(p);
+#endif
+      if ((is_pair(init)) &&
+	  (!is_checked(init)) &&
+	  (optimize_expression(sc, init, hop, e, false) == OPT_OOPS))
+	return(false);
+    }
+  return(true);
+}
+
+static opt_t optimize_syntax(s7_scheme *sc, s7_pointer expr, s7_pointer func, int32_t hop, s7_pointer e, bool export_ok)
+{
+  opcode_t op = syntax_opcode(func);
+  s7_pointer body = cdr(expr), vars;
+  bool body_export_ok = true;
+  if (SHOW_EVAL_OPS) fprintf(stderr, "  %s[%d]: %s\n", __func__, __LINE__, display_truncated(expr));
+
+  sc->w = e;
+  switch (op)
+    {
+    case OP_QUOTE:
+    case OP_MACROEXPAND:
+      return((is_proper_list_1(sc, body)) ? OPT_F : OPT_OOPS);
+
+    case OP_LET: case OP_LETREC:
+    case OP_LET_STAR: case OP_LETREC_STAR:
+      if (is_symbol(cadr(expr)))
+	{
+	  if (!is_pair(cddr(expr))) /* (let name . x) */
+	    return(OPT_F);
+	  vars = caddr(expr);
+	  if (!is_list(vars)) return(OPT_OOPS);
+	  body = cdddr(expr);
+	}
+      else
+	{
+	  vars = cadr(expr);
+	  body = cddr(expr);
+	  if (is_null(vars))
+	    e = cons(sc, sc->nil, e); /* () in e = empty let */
+	  else
+	    if (!is_pair(vars))
+	      return(OPT_OOPS);
+	}
+      if (!is_pair(body)) return(OPT_OOPS);
+
+      if (!vars_syntax_ok(vars))
+	return(OPT_OOPS);
+
+      if ((op == OP_LETREC) || (op == OP_LETREC_STAR))
+	{
+	  e = collect_variables(sc, vars, e);
+	  if (!vars_opt_ok(sc, vars, hop, e))
+	    return(OPT_OOPS);
+	}
+      else
+	if (op == OP_LET)
+	  {
+	    if (!vars_opt_ok(sc, vars, hop, e))
+	      return(OPT_OOPS);
+	    e = collect_variables(sc, vars, e);
+	  }
+	else
+	  for (s7_pointer p = vars; is_pair(p); p = cdr(p))
+	    {
+	      s7_pointer var = car(p);
+	      if ((is_pair(cadr(var))) &&
+		  (!is_checked(cadr(var))) &&
+		  (optimize_expression(sc, cadr(var), hop, e, false) == OPT_OOPS))
+		return(OPT_OOPS);
+	      e = cons(sc, add_symbol_to_list(sc, car(var)), e);
+	      sc->w = e;
+	    }
+      if (is_symbol(cadr(expr)))
+	{
+	  e = cons(sc, add_symbol_to_list(sc, cadr(expr)), e);
+	  sc->w = e;
+	}
+      break;
+
+    case OP_LET_TEMPORARILY:
+      vars = cadr(expr);
+      if (!is_list(vars)) return(OPT_OOPS);
+      body = cddr(expr);
+      for (s7_pointer p = vars; is_pair(p); p = cdr(p))
+	{
+	  s7_pointer var = car(vars);
+	  if ((is_pair(var)) &&
+	      (is_pair(cdr(var))) &&
+	      (is_pair(cadr(var))) &&
+	      (!is_checked(cadr(var))) &&
+	      (optimize_expression(sc, cadr(var), hop, e, false) == OPT_OOPS))
+	    return(OPT_OOPS);
+	}
+      /* e = cons(sc, sc->nil, e); */ /* !? currently let-temporarily does not make a new let, so it is like begin? */
+      body_export_ok = export_ok;     /* (list x (let-temporarily () (define x 0))) just as in begin */
+      break;
+
+    case OP_DO:
+      vars = cadr(expr);
+      if (is_null(vars))
+	e = cons(sc, sc->nil, e);
+      else
+	if (!is_pair(vars))
+	  return(OPT_OOPS);
+      body = cddr(expr);
+
+      for (s7_pointer p = vars; is_pair(p); p = cdr(p))
+	{
+	  s7_pointer var = car(p);
+	  if ((!is_pair(var)) ||
+	      (!is_symbol(car(var))) ||
+	      (!is_pair(cdr(var))))
+	    return(OPT_OOPS);
+	  if ((is_pair(cadr(var))) &&
+	      (!is_checked(cadr(var))) &&
+	      (optimize_expression(sc, cadr(var), hop, e, false) == OPT_OOPS)) /* the init field -- locals are not defined yet */
+	    return(OPT_OOPS);
+	}
+      e = collect_variables(sc, vars, e);
+      for (s7_pointer p = vars; is_pair(p); p = cdr(p))
+	{
+	  s7_pointer var = cddar(p);
+	  if ((is_pair(var)) &&
+	      (is_pair(car(var))) &&
+	      (!is_checked(car(var))) &&
+	      (optimize_expression(sc, car(var), hop, e, false) == OPT_OOPS)) /* the step field -- locals are defined */
+	    return(OPT_OOPS);
+	}
+      break;
+
+    case OP_BEGIN:
+      body_export_ok = export_ok; /* (list x (begin (define x 0))) */
+      break;
+
+    case OP_WITH_BAFFLE:
+      e = cons(sc, sc->nil, e);
+      break;
+
+    case OP_DEFINE_BACRO: case OP_DEFINE_BACRO_STAR:
+    case OP_BACRO:  case OP_BACRO_STAR:
+      return(OPT_F);
+
+    case OP_DEFINE_MACRO:    case OP_DEFINE_MACRO_STAR:
+    case OP_DEFINE_CONSTANT: case OP_DEFINE_EXPANSION: case OP_DEFINE_EXPANSION_STAR:
+    case OP_DEFINE:          case OP_DEFINE_STAR:
+      /* define adds a name to the incoming let (e), the added name is inserted into e after the first, so the caller
+       *   can flush added symbols by maintaining its own pointer into the list if blockers set the car.
+       * the list is used both to see local symbols and to catch "complicated" functions (find_uncomplicated_symbol).
+       * In cases like (if expr (define...)) we can't tell at this level whether the define takes place, so
+       *   its name should not be in "e", but it needs to be marked for find_uncomplicated_symbol in a way
+       *   that can be distinguished from members of "e".  So in that (rare) case, we use the associated keyword.
+       *   Then find_uncomplicated_symbol can use has_keyword to tell if the keyword search is needed.
+       * export_ok is trying to protect against optimizing (list x (define x 0)) as op_safe_c_sp and all related cases
+       */
+      vars = cadr(expr);
+      body = cddr(expr);
+      if (is_pair(vars))
+	{
+	  if ((export_ok) &&
+	      (is_symbol(car(vars))))
+	    {
+	      add_symbol_to_list(sc, car(vars));
+	      if (is_pair(e))
+		{
+		  if (car(e) != sc->if_keyword)
+		    set_cdr(e, cons(sc, car(vars), cdr(e))); /* export it */
+		  else add_symbol_to_list(sc, symbol_to_keyword(sc, car(vars)));
+		}
+	      else e = cons(sc, car(vars), e);
+	    }
+	  e = collect_parameters(sc, cdr(vars), e);
+	  body_export_ok = export_ok;
+	}
+      else
+	{
+	  if ((export_ok) &&
+	      (is_symbol(vars)))
+	    {
+	      /* actually if this is defining a function, the name should probably be included in the local let
+	       *   but that's next-to-impossible to guarantee unless it's (define x (lambda...)) of course.
+	       */
+	      sc->temp9 = e;
+	      for (s7_pointer p = body; is_pair(p); p = cdr(p))
+		if ((is_pair(car(p))) &&
+		    (!is_checked(car(p))) && /* ((full_type(p) & (TYPE_MASK | T_CHECKED)) == T_PAIR) is not faster */
+		    (optimize_expression(sc, car(p), hop, e, false) == OPT_OOPS)) /* "body" here is not body in terms of export_ok */
+		  {
+		    sc->temp9 = sc->unused;
+		    return(OPT_OOPS);
+		  }
+	      sc->temp9 = sc->unused;
+
+	      add_symbol_to_list(sc, vars);
+	      if (is_pair(e))
+		{
+		  if (car(e) != sc->if_keyword)
+		    set_cdr(e, cons(sc, vars, cdr(e)));     /* export it */
+		  else add_symbol_to_list(sc, symbol_to_keyword(sc, vars));
+		}
+	      /* else e = cons(sc, vars, e); */ /* ?? should this be set-cdr etc? */
+	      return(OPT_F);
+	    }
+	  body_export_ok = false;
+	}
+      break;
+
+    case OP_LAMBDA: case OP_LAMBDA_STAR:
+    case OP_MACRO:  case OP_MACRO_STAR:
+      vars = cadr(expr);
+      if (is_null(vars))
+	e = cons(sc, sc->nil, e);
+      else
+	if ((!is_pair(vars)) && (!is_symbol(vars)))
+	  return(OPT_OOPS);
+      e = collect_parameters(sc, vars, e);
+      body = cddr(expr);
+      break;
+
+    case OP_SET:
+      if ((is_pair(cadr(expr))) && (caadr(expr) == sc->outlet_symbol))
+	return(OPT_OOPS);
+      if (!is_pair(cddr(expr)))
+	return(OPT_OOPS);
+      if ((is_pair(cadr(expr))) &&
+	  (!is_checked(cadr(expr))))
+	{
+	  bool old_in_with_let = sc->in_with_let;
+	  set_checked(cadr(expr));
+	  if (caadr(expr) == sc->with_let_symbol) sc->in_with_let = true;
+	  for (s7_pointer lp = cdadr(expr); is_pair(lp); lp = cdr(lp))
+	    if ((is_pair(car(lp))) &&
+		(!is_checked(car(lp))) &&
+		(optimize_expression(sc, car(lp), hop, e, body_export_ok) == OPT_OOPS))
+	      {
+		sc->in_with_let = old_in_with_let;
+		return(OPT_OOPS);
+	      }
+	  sc->in_with_let = old_in_with_let;
+	}
+      if ((is_pair(caddr(expr))) &&
+	  (!is_checked(caddr(expr))) &&
+	  (optimize_expression(sc, caddr(expr), hop, e, body_export_ok) == OPT_OOPS))
+	return(OPT_OOPS);
+
+      if ((is_pair(cadr(expr))) && (caadr(expr) == sc->s7_starlet_symbol))
+	return(OPT_T);
+      return(OPT_F);
+
+    case OP_WITH_LET:
+      /* we usually can't trust anything here, so hop ought to be off.  For example,
+       *   (define (hi) (let ((e (sublet (curlet) :abs (lambda (a) (- a 1))))) (with-let e (abs -1))))
+       * returns 1 if hop is 1, but -2 otherwise.  (with-let (unlet)...) is safe however.
+       */
+      {
+	bool old_with_let = sc->in_with_let;
+	sc->in_with_let = (old_with_let) || (!is_pair(body)) || (!is_pair(car(body))) ||
+	                  ((caar(body) != sc->unlet_symbol) && /* (caar(body) != sc->rootlet_symbol) && */ (caar(body) != sc->curlet_symbol));
+	/* not rootlet here: (let ((i 0)) (_rd3_ (with-let (rootlet) ((null? i) i)))) */
+	for (s7_pointer p = body; is_pair(p); p = cdr(p))
+	  if ((is_pair(car(p))) &&
+	      (!is_checked(car(p))) &&
+	      (optimize_expression(sc, car(p), 0, sc->nil, body_export_ok) == OPT_OOPS))
+	    {
+	      sc->in_with_let = old_with_let;
+	      return(OPT_OOPS);
+	    }
+	sc->in_with_let = old_with_let;
+	return(OPT_F);
+      }
+
+    case OP_CASE:
+      if ((is_pair(cadr(expr))) &&
+	  (!is_checked(cadr(expr))) &&
+	  (optimize_expression(sc, cadr(expr), hop, e, false) == OPT_OOPS))
+	return(OPT_OOPS);
+      for (s7_pointer p = cddr(expr); is_pair(p); p = cdr(p))
+	if ((is_pair(car(p))) &&
+	    (is_pair(cdar(p))))
+	  for (s7_pointer rst = cdar(p); is_pair(rst); rst = cdr(rst))
+	    if ((is_pair(car(rst))) &&
+		(!is_checked(car(rst))) &&
+		(optimize_expression(sc, car(rst), hop, e, false) == OPT_OOPS))
+	      return(OPT_OOPS);
+      return(OPT_F);
+
+    case OP_COND: /* split opt is necessary: (cond (lambda (x) ...)) */
+      for (s7_pointer p = cdr(expr); is_pair(p); p = cdr(p))
+	if (is_pair(car(p)))
+	  {
+	    s7_pointer test = caar(p);
+	    e = cons(sc, sc->if_keyword, e);  /* I think this is a marker in case define is encountered? (see above) */
+	    if ((is_pair(test)) &&
+		(!is_checked(test)) &&
+		(optimize_expression(sc, test, hop, e, false) == OPT_OOPS))
+	      return(OPT_OOPS);
+	    for (s7_pointer rst = cdar(p); is_pair(rst); rst = cdr(rst))
+	      if ((is_pair(car(rst))) &&
+		  (!is_checked(car(rst))) &&
+		  (optimize_expression(sc, car(rst), hop, e, false) == OPT_OOPS))
+		return(OPT_OOPS);
+	  }
+      {
+	s7_pointer p;
+	for (p = cdr(expr); is_pair(p); p = cdr(p))
+	  {
+	    s7_pointer q;
+	    if ((!is_pair(car(p))) || (!is_fxable(sc, caar(p))))
+	      break;
+	    if (!is_pair(cdar(p)))
+	      break;
+	    for (q = cdar(p); is_pair(q); q = cdr(q))
+	      if ((car(q) == sc->feed_to_symbol) || (!is_fxable(sc, car(q))))
+		break;
+	    if (!is_null(q)) break;
+	  }
+	if (!is_null(p)) return(OPT_F);
+	set_safe_optimize_op(expr, OP_COND_NA_NA);
+      }
+      for (s7_pointer p = cdr(expr); is_pair(p); p = cdr(p))
+	{
+	  set_fx_direct(car(p), fx_choose(sc, car(p), e, pair_symbol_is_safe));
+	  for (s7_pointer q = cdar(p); is_pair(q); q = cdr(q))
+	    set_fx_direct(q, fx_choose(sc, q, e, pair_symbol_is_safe));
+	}
+      return(OPT_T);
+
+    case OP_IF: case OP_WHEN: case OP_UNLESS:
+      if ((!is_pair(cdr(expr))) || (!is_pair(cddr(expr))))
+	return(OPT_OOPS);
+    case OP_OR: case OP_AND:
+      e = cons(sc, sc->if_keyword, e);
+      break;
+
+    default: break;
+    }
+
+  sc->temp9 = e;
+  for (s7_pointer p = body; is_pair(p); p = cdr(p))
+    if ((is_pair(car(p))) &&
+	(!is_checked(car(p))) && /* ((full_type(p) & (TYPE_MASK | T_CHECKED)) == T_PAIR) is not faster */
+	(optimize_expression(sc, car(p), hop, e, body_export_ok) == OPT_OOPS))
+      {
+	sc->temp9 = sc->unused;
+	return(OPT_OOPS);
+      }
+  sc->temp9 = sc->unused;
+
+  if ((hop == 1) &&
+      ((is_syntax(car(expr))) ||
+       (symbol_id(car(expr)) == 0)))
+    {
+      if (op == OP_IF)
+	{
+	  s7_pointer test = cdr(expr), b1, b2, p;
+	  for (p = cdr(expr); is_pair(p); p = cdr(p))
+	    if (!is_fxable(sc, car(p)))
+	      return(OPT_F);
+	  if (!is_null(p)) return(OPT_OOPS);
+	  if ((is_pair(cdr(test))) && (is_pair(cddr(test))) && (!is_null(cdddr(test))))
+	    return(OPT_OOPS);
+
+	  for (p = cdr(expr); is_pair(p); p = cdr(p))
+	    set_fx_direct(p, fx_choose(sc, p, e, pair_symbol_is_safe));
+
+	  b1 = cdr(test);
+	  b2 = cdr(b1);
+	  if ((fx_proc(b1) == fx_q) &&
+	      (is_pair(b2)))
+	    {
+	      set_opt3_con(test, cadar(b1));
+	      if (fx_proc(b2) == fx_q)
+		{
+		  set_safe_optimize_op(expr, OP_IF_A_C_C);
+		  set_opt1_con(expr, cadar(b1));
+		  set_opt2_con(expr, cadar(b2));
+		  return(OPT_T);
+		}
+	      set_opt1_pair(expr, b1);
+	      set_opt2_pair(expr, b2);
+	      set_safe_optimize_op(expr, OP_IF_A_A_A);
+	    }
+	  else
+	    {
+	      if ((is_pair(car(test))) &&
+		  (caar(test) == sc->not_symbol) &&
+		  (is_fxable(sc, cadar(test))))
+		{
+		  set_fx_direct(cdar(test), fx_choose(sc, cdar(test), e, pair_symbol_is_safe));
+		  set_opt1_pair(expr, cdar(test));
+		  set_opt2_pair(expr, b1);
+		  if (is_pair(b2)) set_opt3_pair(expr, b2);
+		  set_safe_optimize_op(expr, (is_null(b2)) ? OP_IF_NOT_A_A : OP_IF_NOT_A_A_A);
+		}
+	      else
+		{
+		  if ((is_pair(b2)) && (fx_proc(b1) == fx_c) && (fx_proc(b2) == fx_c))
+		    {
+		      set_safe_optimize_op(expr, OP_IF_A_C_C);
+		      set_opt1_con(expr, car(b1));
+		      set_opt2_con(expr, car(b2));
+		      return(OPT_T);
+		    }
+		  if ((fx_proc(test) == fx_and_2a) && (fx_proc(b1) == fx_s))
+		    {
+		      set_opt1_pair(expr, cdadr(expr));
+		      set_opt2_pair(expr, cddadr(expr));
+		      set_opt3_sym(expr, car(b1));
+		      set_safe_optimize_op(expr, OP_IF_AND2_S_A);
+		      return(OPT_T);
+		    }
+		  set_opt1_pair(expr, b1);
+		  if (is_pair(b2)) set_opt2_pair(expr, b2);
+		  set_safe_optimize_op(expr, (is_null(b2)) ? OP_IF_A_A : ((fx_proc(test) == fx_s) ? OP_IF_S_A_A : OP_IF_A_A_A));
+		}}
+	  return(OPT_T);
+	}
+      else
+	{
+	  if ((op == OP_OR) || (op == OP_AND))
+	    {
+	      int32_t args, pairs = 0;
+	      s7_pointer p, sym = NULL;
+	      bool c_s_is_ok = true;
+
+	      for (p = cdr(expr); is_pair(p); p = cdr(p))
+		if (!is_fxable(sc, car(p)))
+		  return(OPT_F);
+	      if (!is_null(p)) return(OPT_OOPS);
+	      for (args = 0, p = cdr(expr); is_pair(p); p = cdr(p), args++) /* this only applies to or/and */
+		if (is_pair(car(p)))
+		  {
+		    pairs++;
+		    if ((c_s_is_ok) &&
+			((!is_h_safe_c_s(car(p))) ||
+			 ((sym) && (sym != cadar(p)))))
+		      c_s_is_ok = false;
+		    else sym = (is_pair(cdar(p))) ? cadar(p) : sc->unspecified;
+		  }
+
+	      if ((c_s_is_ok) && (args == 2) && (pairs == 2))
+		{
+		  if (op == OP_OR)
+		    {
+		      set_opt3_sym(cdr(expr), cadadr(expr));
+		      if ((is_symbol(caadr(expr))) && (symbol_type(caadr(expr)) > 0) && (is_global(caadr(expr))) &&
+			  ((is_symbol(caaddr(expr))) && (symbol_type(caaddr(expr)) > 0) && (is_global(caaddr(expr)))))
+			{
+			  set_opt3_int(expr, symbol_type(caadr(expr)));
+			  set_opt2_int(cdr(expr), symbol_type(caaddr(expr)));
+			  set_safe_optimize_op(expr, OP_OR_S_TYPE_2);
+			}
+		      else set_safe_optimize_op(expr, OP_OR_S_2);
+		    }
+		  else
+		    {
+		      set_opt3_sym(cdr(expr), cadadr(expr));
+		      set_safe_optimize_op(expr, OP_AND_S_2);
+		    }
+		  return(OPT_T);
+		}
+
+	      for (p = cdr(expr); is_pair(p); p = cdr(p))
+		set_fx_direct(p, fx_choose(sc, p, e, pair_symbol_is_safe));
+	      if (op == OP_OR)
+		{
+		  if (args == 2)
+		    set_safe_optimize_op(expr, OP_OR_2A);
+		  else
+		    {
+		      if (args == 3)
+			set_safe_optimize_op(expr, OP_OR_3A);
+		      else set_safe_optimize_op(expr, OP_OR_N);
+		    }
+		  return(OPT_T);
+		}
+	      if (args == 2)
+		set_safe_optimize_op(expr, OP_AND_2A);
+	      else set_safe_optimize_op(expr, (args == 3) ? OP_AND_3A : OP_AND_N);
+	      return(OPT_T);
+	    }
+	  else
+	    if (op == OP_BEGIN)
+	      {
+		s7_pointer p;
+		if (!is_pair(cdr(expr))) return(OPT_F);
+		for (p = cdr(expr); is_pair(p); p = cdr(p))
+		  if (!is_fxable(sc, car(p)))
+		    return(OPT_F);
+		if (!is_null(p)) return(OPT_OOPS);
+		for (p = cdr(expr); is_pair(p); p = cdr(p))
+		  set_fx_direct(p, fx_choose(sc, p, e, pair_symbol_is_safe));
+		set_safe_optimize_op(expr, ((is_pair(cddr(expr))) && (is_null(cdddr(expr)))) ? OP_BEGIN_AA : OP_BEGIN_NA);
+		return(OPT_T);
+	      }}}   /* fully fxable lets don't happen much: even let-2a-a is scarcely used */
+  return(OPT_F);
+}
+
+static opt_t optimize_funcs(s7_scheme *sc, s7_pointer expr, s7_pointer func, int32_t hop, int32_t orig_hop, s7_pointer e)
+{
+  int32_t pairs = 0, symbols = 0, args = 0, bad_pairs = 0, quotes = 0;
+  s7_pointer p;
+  if (SHOW_EVAL_OPS) fprintf(stderr, "  %s[%d]: %s, func: %s\n", __func__, __LINE__, display_truncated(expr), display(func));
+  for (p = cdr(expr); is_pair(p); p = cdr(p), args++) /* check the args (the calling expression) */
+    {
+      s7_pointer car_p = car(p);
+      if (is_normal_symbol(car_p)) /* for opt func */
+	symbols++;
+      else
+	if (is_pair(car_p))
+	  {
+	    pairs++;
+	    if (!is_checked(car_p))
+	      {
+		opt_t res;
+		if ((is_pair(car(car_p))) && (caar(car_p) == sc->let_symbol))
+		  res = OPT_F;
+		else res = optimize_expression(sc, car_p, orig_hop, e, false);
+		if (res == OPT_F)
+		  {
+		    bad_pairs++;
+		    if (is_proper_quote(sc, car_p))
+		      quotes++;
+		  }
+		else
+		  if (res == OPT_OOPS)
+		    return(OPT_OOPS);
+	      }
+	    else
+	      if ((!is_optimized(car_p)) ||
+		  (is_unsafe(car_p)))
+		{
+		  bad_pairs++;
+		  if (is_proper_quote(sc, car_p))
+		    quotes++;
+		}}}
+  if (is_null(p))            /* if not null, dotted list of args, (cons 1 . 2) etc -- error perhaps? */
+    {
+      switch (args)
+	{
+	case 0:  return(optimize_thunk(sc, expr, func, hop, e));
+	case 1:  return(optimize_func_one_arg(sc, expr, func, hop, pairs, symbols, quotes, bad_pairs, e));
+	case 2:  return(optimize_func_two_args(sc, expr, func, hop, pairs, symbols, quotes, bad_pairs, e));
+	case 3:  return(optimize_func_three_args(sc, expr, func, hop, pairs, symbols, quotes, bad_pairs, e));
+	default: return(optimize_func_many_args(sc, expr, func, hop, args, pairs, symbols, quotes, bad_pairs, e));
+	}}
+  return(OPT_OOPS); /* was OPT_F, but this is always an error */
+}
+
+static opt_t optimize_expression(s7_scheme *sc, s7_pointer expr, int32_t hop, s7_pointer e, bool export_ok)
+{
+  s7_pointer car_expr = car(expr);
+  int32_t orig_hop = hop;
+  set_checked(expr);
+
+  if (is_symbol(car_expr))
+    {
+      s7_pointer slot;
+      if (is_syntactic_symbol(car_expr))
+	{
+	  if (!is_pair(cdr(expr)))
+	    return(OPT_OOPS);
+	  return(optimize_syntax(sc, expr, T_Syn(global_value(car_expr)), hop, e, export_ok));
+	}
+      slot = find_uncomplicated_symbol(sc, car_expr, e); /* local vars (recursive calls too??) are considered complicated */
+      if (is_slot(slot))
+	{
+	  s7_pointer func = slot_value(slot);
+	  if (is_syntax(func))                           /* not is_syntactic -- here we have the value */
+	    return((is_pair(cdr(expr))) ? optimize_syntax(sc, expr, func, hop, e, export_ok) : OPT_OOPS);  /* e can be extended via set-cdr! here */
+
+	  if (is_any_macro(func))
+	    return(OPT_F);
+
+	  /* we miss implicit indexing here because at this time, the data are not set */
+	  if ((is_t_procedure(func)) ||                  /* t_procedure_p: c_funcs, closures, etc */
+	      ((is_applicable(func)) &&
+	       (is_safe_procedure(func))))               /* built-in applicable objects like vectors */
+	    {
+	      if ((hop != 0) &&
+		  ((is_any_closure(func)) ||             /* see use-redef in s7test -- I'm not sure about this */
+		   ((!is_global(car_expr)) &&
+		    ((!is_slot(global_slot(car_expr))) ||
+		     (global_value(car_expr) != func)))) &&
+		  (!is_immutable(car_expr)) && /* list|apply-values -- can't depend on opt1 here because it might not be global, or might be redefined locally */
+		  (!is_immutable_slot(slot)))       /* (define-constant...) */
+		{
+		  /* (let () (define (f2 a) (+ a 1)) (define (f1 a) (f2 a)) (define (f2 a) (- a)) (f1 12))
+		   * (let () (define (f2 a) (+ a 1)) (define (f1 a) (f2 a)) (define (f2 a) (- a 1)) (f1 12))
+		   * and similar define* cases
+		   */
+		  hop = 0;
+		  /* this is very tricky!  See s7test for some cases.  Basically, we need to protect a recursive call
+		   *   of the current function being optimized from being confused with some previous definition
+		   *   of the same name.  But method lists have global names so the global bit is off even though the
+		   *   thing is actually a safe global.  But no closure can be considered safe in the hop sense --
+		   *   even a global function might be redefined at any time, and previous uses of it in other functions
+		   *   need to reflect its new value.
+		   *   So, closures are always checked, but built-in functions are used as if never redefined until that redefinition.
+		   * Syntax handling is already impure in s7, so the special handling of built-in functions doesn't
+		   *   offend me much.  Consider each a sort of reader macro until someone redefines it -- previous
+		   *   uses might not be affected because they might have been optimized away -- the result depends on the
+		   *   current optimizer.
+		   * Another case (from K Matheussen):
+		   *   (define (call-func func arg1 arg2) (define (call) (func arg1 arg2)) (call)) (call-func + 1 2.5) (call-func - 5 2)
+		   *   when we get here originally "func" is +, hop=1, but just checking for !is_global(car_expr) is
+		   *   not good enough -- if we load mockery.scm, nothing is global!
+		   * Yet another case (define (test-abs) (define (abs x) (+ x 1)) (format *stderr* "abs ~A~%" (abs -1)))
+		   *   when optimize_syntax sees the (define abs ...), it inserts abs into e so that the caller's e is extended (set-cdr!)
+		   *   so that find_uncomplicated_symbol above will be unhappy when we reach (abs -1) as the format arg.
+		   *   This can be confused if lambda is redefined at some point, but...
+		   */
+		}
+	      return(optimize_funcs(sc, expr, func, hop, orig_hop, e));
+	    }}
+      else
+	if ((sc->undefined_identifier_warnings) &&
+	    (slot == sc->undefined) &&           /* car_expr is not in e or global */
+	    (symbol_tag(car_expr) == 0))         /*    and we haven't looked it up earlier */
+	  {
+	    s7_pointer p = current_input_port(sc);
+	    if ((is_input_port(p)) &&
+		(port_file(p) != stdin) &&
+		(!port_is_closed(p)) &&
+		(port_filename(p)))
+	      s7_warn(sc, 1024, "%s might be undefined (%s %u)\n", display(car_expr), port_filename(p), port_line_number(p));
+	    else s7_warn(sc, 1024, "; %s might be undefined\n", display(car_expr));
+	    symbol_set_tag(car_expr, 1);        /* one warning is enough */
+	  }
+
+      /* car_expr is a symbol but it's not a built-in procedure or a safe case = vector etc */
+      {
+	/* else maybe it's something like a let variable binding: (sqrtfreq (sqrt frequency)) */
+	s7_pointer p;
+	int32_t len = 0, pairs = 0, symbols = 0;
+
+	for (p = cdr(expr); is_pair(p); p = cdr(p), len++)
+	  {
+	    s7_pointer car_p = car(p);
+	    if (is_pair(car_p))
+	      {
+		pairs++;
+		if ((!is_checked(car_p)) &&
+		    (optimize_expression(sc, car_p, hop, e, false) == OPT_OOPS))
+		  return(OPT_OOPS);
+	      }
+	    else
+	      if (is_symbol(car_p))
+		symbols++;
+	  }
+	if ((is_null(p)) &&              /* (+ 1 . 2) */
+	    (!is_optimized(expr)))
+	  {
+	    /* len=0 case is almost entirely arglists */
+	    set_opt1_con(expr, sc->unused);
+
+	    if (pairs == 0)
+	      {
+		if (len == 0)
+		  {
+		    /* hoping to catch object application here, as in readers in Snd */
+		    set_unsafe_optimize_op(expr, OP_UNKNOWN);
+		    return(OPT_F);
+		  }
+		if (len == 1)
+		  {
+		    if (!is_quote(car_expr)) /* !! quote can be redefined locally, unsetting the T_SYNTACTIC flag -- can this happen elsewhere? */
+		      set_unsafe_optimize_op(expr, (is_normal_symbol(cadr(expr))) ? OP_UNKNOWN_S : OP_UNKNOWN_A);
+		    fx_annotate_arg(sc, cdr(expr), e); /* g->a later if closure */
+		    return(OPT_F);
+		  }
+		if (len == 2)
+		  {
+		    set_unsafely_optimized(expr);
+		    set_optimize_op(expr, OP_UNKNOWN_GG);
+		    return(OPT_F);
+		  }
+		if (len >= 3)
+		  {
+		    if (len == symbols)
+		      {
+			set_unsafe_optimize_op(expr, OP_UNKNOWN_NS);
+			set_opt3_arglen(cdr(expr), len);
+			return(OPT_F);
+		      }
+		    if (fx_count(sc, expr) == len)
+		      {
+			set_unsafe_optimize_op(expr, OP_UNKNOWN_NA);
+			set_opt3_arglen(cdr(expr), len);
+			return(OPT_F);
+		      }}}
+	    else /* pairs != 0 */
+	      {
+		s7_pointer arg1 = cadr(expr);
+		if ((pairs == 1) && (len == 1))
+		  {
+		    if ((is_quote(car_expr)) &&
+			(direct_memq(sc->quote_symbol, e)))
+		      return(OPT_OOPS);
+
+		    if (is_fxable(sc, arg1))
+		      {
+			set_opt3_arglen(cdr(expr), 1);
+			fx_annotate_arg(sc, cdr(expr), e);
+			set_unsafe_optimize_op(expr, OP_UNKNOWN_A);
+			return(OPT_F);
+		      }}
+		if (fx_count(sc, expr) == len)
+		  {
+		    set_unsafe_optimize_op(expr, (len == 1) ? OP_UNKNOWN_A : ((len == 2) ? OP_UNKNOWN_AA : OP_UNKNOWN_NA));
+		    set_opt3_arglen(cdr(expr), len);
+		    if (len <= 2) fx_annotate_args(sc, cdr(expr), e);
+		    return(OPT_F);
+		  }
+		set_unsafe_optimize_op(expr, OP_UNKNOWN_NP);
+		set_opt3_arglen(cdr(expr), len);
+		return(OPT_F);
+	      }}}}
+  else
+    {
+      /* car(expr) is not a symbol, but there might be interesting stuff here */
+      /* (define (hi a) (case 1 ((1) (if (> a 2) a 2)))) */
+      s7_pointer p;
+
+      if ((car_expr == sc->quote_function) && (is_pair(cdr(expr)))) /* very common */
+	return(optimize_syntax(sc, expr, sc->quote_function, hop, e, export_ok));
+
+      if (is_c_function(car_expr)) /* (#_abs x) etc */
+	return(optimize_funcs(sc, expr, car_expr, 1, orig_hop, e));
+
+      if (is_syntax(car_expr)) /* (#_cond...) etc */
+	{
+	  if (!is_pair(cdr(expr)))
+	    return(OPT_OOPS);
+	  return(optimize_syntax(sc, expr, car_expr, orig_hop, e, export_ok));
+	}
+      if (is_any_macro(car_expr))
+	return(OPT_F);
+
+      /* if car is a pair, we can't easily tell whether its value is (say) + or cond, so we need to catch this case and fixup fx settings */
+      for (p = expr; is_pair(p); p = cdr(p))
+	if (((is_symbol(car(p))) && (is_syntactic_symbol(car(p)))) ||
+	    ((is_pair(car(p))) && (!is_checked(car(p))) &&
+	     (optimize_expression(sc, car(p), hop, e, false) == OPT_OOPS)))
+	  return(OPT_OOPS);
+      /* here we get for example:
+       *  ((if (not (let? p)) write write-to-vector) obj p) ; not uncomplicated/c-function [((if 3d fourth third) p) in index]
+       *  ((if (symbol? (cadr f)) cadr (if (pair? (cadr f)) caadr not)) f) ; fx not symbol -- opif_a_aaq_a
+       *  ((if (input-port? port) call-with-input-file call-with-output-file) port proc) ; not safe I guess
+       */
+    }
+  return(OPT_F);
+}
+
+static opt_t optimize(s7_scheme *sc, s7_pointer code, int32_t hop, s7_pointer e)
+{
+  s7_pointer x;
+  for (x = code; (is_pair(x)) && (!is_checked(x)); x = cdr(x))
+    {
+      s7_pointer obj = car(x);
+      set_checked(x);
+      if (is_pair(obj))
+	{
+	  if ((!is_checked(obj)) &&
+	      (optimize_expression(sc, obj, hop, e, true) == OPT_OOPS))
+	    {
+	      s7_pointer p;
+	      for (p = cdr(x); is_pair(p); p = cdr(p));
+	      if (!is_null(p))
+		syntax_error_nr(sc, "stray dot in function body: ~S", 30, code);
+	      return(OPT_OOPS);
+	    }}
+      else /* new 22-Sep-19, but I don't think this saves anything over falling into trailers */
+	if (is_symbol(obj))
+	  set_optimize_op(obj, (is_keyword(obj)) ? OP_CONSTANT : OP_SYMBOL);
+	else set_optimize_op(obj, OP_CONSTANT);
+    }
+  if (!is_list(x))
+    syntax_error_nr(sc, "stray dot in function body: ~S", 30, code);
+  return(OPT_F);
+}
+
+
+static bool symbol_is_in_arg_list(const s7_pointer sym, s7_pointer lst)
+{
+  s7_pointer x;
+  for (x = lst; is_pair(x); x = cdr(x))
+    if ((sym == car(x)) ||
+	((is_pair(car(x))) && (sym == caar(x))))
+      return(true);
+  return(sym == x);
+}
+
+static void check_lambda_args(s7_scheme *sc, s7_pointer args, int32_t *arity, s7_pointer form)
+{
+  s7_pointer x;
+  int32_t i;
+
+  if (!is_list(args))
+    {
+      if (is_constant(sc, args))                       /* (lambda :a ...) or (define (f :a) ...) */
+	error_nr(sc, sc->syntax_error_symbol,
+		 set_elist_3(sc, wrap_string(sc, "lambda parameter is a constant: (~S ~S ...)", 43), car(form), cadr(form)));
+      /* we currently accept (lambda i i . i) (lambda quote i)  (lambda : : . #()) (lambda : 1 . "")
+       *   at this level, but when the lambda form is evaluated, it will trigger an error.
+       */
+      if (is_symbol(args)) set_local(args);
+      if (arity) (*arity) = -1;
+      return;
+    }
+  for (i = 0, x = args; is_pair(x); i++, x = cdr(x))
+    {
+      s7_pointer car_x = car(x);
+      if (is_constant(sc, car_x))                      /* (lambda (pi) pi), constant here means not a symbol */
+	{
+	  if (is_pair(car_x))                          /* (lambda ((:hi . "hi") . "hi") 1) */
+	    error_nr(sc, sc->syntax_error_symbol,      /* don't use ~A here or below, (lambda #\null do) for example */
+		     set_elist_4(sc, wrap_string(sc, "lambda parameter ~S is a pair (perhaps use lambda*?): (~S ~S ...)", 65),
+				 car_x, car(form), cadr(form)));
+	  if ((car_x == sc->rest_keyword) &&
+	      ((car(form) == sc->define_symbol) || (car(form) == sc->lambda_symbol)))
+	    error_nr(sc, sc->syntax_error_symbol,
+		     set_elist_5(sc, wrap_string(sc, "lambda parameter is ~S? (~S ~S ...), perhaps use ~S", 51),
+				 car_x, car(form), cadr(form),
+				 (car(form) == sc->define_symbol) ? sc->define_star_symbol : sc->lambda_star_symbol));
+	  error_nr(sc, sc->syntax_error_symbol,        /* (lambda (a :b c) 1) */
+		   set_elist_4(sc, wrap_string(sc, "lambda parameter ~S is a constant: (~S ~S ...)", 46),
+			       car_x, car(form), cadr(form)));
+	}
+      if (symbol_is_in_arg_list(car_x, cdr(x)))       /* (lambda (a a) ...) or (lambda (a . a) ...) */
+	error_nr(sc, sc->syntax_error_symbol,
+		 set_elist_4(sc, wrap_string(sc, "lambda parameter ~S is used twice in the parameter list, (~S ~S ...)", 68),
+			     car_x, car(form), cadr(form)));
+      set_local(car_x);
+    }
+  if (is_not_null(x))
+    {
+      if (is_constant(sc, x))                         /* (lambda (a . 0.0) a) or (lambda (a . :b) a) */
+	error_nr(sc, sc->syntax_error_symbol,
+		 set_elist_4(sc, wrap_string(sc, "lambda :rest parameter ~S is a constant in (~S ~S ...)", 54),
+			     x, car(form), cadr(form)));
+      i = -i - 1;
+    }
+  if (arity) (*arity) = i;
+}
+
+static s7_pointer check_lambda_star_args(s7_scheme *sc, s7_pointer args, s7_pointer body, s7_pointer form) /* checks closure*, macro*, and bacro* */
+{
+  s7_pointer top, v, w;
+  bool has_defaults;
+
+  if (!is_list(args))
+    {
+      if (is_constant(sc, args))                                /* (lambda* :a ...) or (define* (f . :a) ...) */
+	error_nr(sc, sc->syntax_error_symbol,
+		 set_elist_3(sc, wrap_string(sc, "lambda* parameter is a constant: (~S ~S ...)", 44), car(form), cadr(form)));
+      if (is_symbol(args)) set_local(args);
+      return(args);
+    }
+
+  has_defaults = false;
+  top = args;
+  for (v = args, w = args; is_pair(w); v = w, w = cdr(w))
+    {
+      s7_pointer car_w = car(w);
+      if (is_pair(car_w))
+	{
+	  has_defaults = true;
+	  if (is_constant(sc, car(car_w)))                      /* (lambda* ((:a 1)) ...) */
+	    error_nr(sc, sc->syntax_error_symbol,
+		     set_elist_4(sc, wrap_string(sc, "lambda* parameter ~S is a constant: (~S ~S ...)", 47),
+				 car(car_w), car(form), cadr(form)));
+	  if (symbol_is_in_arg_list(caar(w), cdr(w)))           /* (lambda* ((a 1) a) ...) */
+	    error_nr(sc, sc->syntax_error_symbol,
+		     set_elist_4(sc, wrap_string(sc, "lambda* parameter ~S occurs twice in the argument list: (~S ~S ...)", 67),
+				 car(car_w), car(form), cadr(form)));
+	  if (!is_pair(cdr(car_w)))
+	    {
+	      if (is_null(cdr(car_w)))                          /* (lambda* ((a)) ...) */
+		error_nr(sc, sc->syntax_error_symbol,
+			 set_elist_4(sc, wrap_string(sc, "lambda* parameter ~S default value missing in (~S ~S ...)", 57),
+				     car_w, car(form), cadr(form)));
+	      error_nr(sc, sc->syntax_error_symbol,             /* (lambda* ((a . 0.0)) a) */
+		       set_elist_4(sc, wrap_string(sc, "lambda* parameter ~S is a dotted pair in (~S ~S ...)", 52),
+				   car_w, car(form), cadr(form)));
+	    }
+	  if ((is_pair(cadr(car_w))) &&                         /* (lambda* ((a (quote . -1))) ...) */
+	      (s7_list_length(sc, cadr(car_w)) < 0))
+	    error_nr(sc, sc->syntax_error_symbol,
+		     set_elist_4(sc, wrap_string(sc, "lambda* parameter ~S default value is not a proper list in (~S ~S ...)", 70),
+				 car_w, car(form), cadr(form)));
+	  if (is_not_null(cddr(car_w)))                         /* (lambda* ((a 0.0 'hi)) a) */
+	    error_nr(sc, sc->syntax_error_symbol,
+		     set_elist_4(sc, wrap_string(sc, "lambda* parameter ~S has multiple default values in (~S ~S ...)", 63),
+				 car_w, car(form), cadr(form)));
+
+	  set_local(car(car_w));
+	}
+      else
+	if (car_w != sc->rest_keyword)
+	  {
+	    if (is_constant(sc, car_w))
+	      {
+		if (car_w != sc->allow_other_keys_keyword)
+		  error_nr(sc, sc->syntax_error_symbol,         /* (lambda* (pi) ...) */
+			   set_elist_4(sc, wrap_string(sc, "lambda* parameter ~S is a constant: (~S ~S ...)", 47),
+				       car_w, car(form), cadr(form)));
+		if (is_not_null(cdr(w)))                        /* (lambda* (:allow-other-keys x) x) */
+		  error_nr(sc, sc->syntax_error_symbol,
+			   set_elist_3(sc, wrap_string(sc, ":allow-other-keys should be the last parameter: (~S ~S ...)", 59),
+				       car(form), cadr(form)));
+		if (w == top)                                   /* (lambda* (:allow-other-keys) 1) */
+		  error_nr(sc, sc->syntax_error_symbol,
+			   set_elist_3(sc, wrap_string(sc, ":allow-other-keys can't be the only parameter: (~S ~S ...)", 58),
+				       car(form), cadr(form)));
+		set_allow_other_keys(top);
+		set_cdr(v, sc->nil);
+	      }
+	    if (symbol_is_in_arg_list(car_w, cdr(w)))           /* (lambda* (a a) ...) or (lambda* (a . a) ...) */
+	      error_nr(sc, sc->syntax_error_symbol,
+		       set_elist_4(sc, wrap_string(sc, "lambda* parameter ~S is used twice in the parameter list: (~S ~S ...)", 69),
+				   car_w, car(form), cadr(form)));
+
+	    if (!is_keyword(car_w)) set_local(car_w);
+	  }
+	else
+	  {
+	    has_defaults = true;
+	    if (!is_pair(cdr(w)))                               /* (lambda* (:rest) ...) */
+	      error_nr(sc, sc->syntax_error_symbol,
+		       set_elist_3(sc, wrap_string(sc, "lambda* :rest parameter missing in (~S ~S ...)", 46),
+				   car(form), cadr(form)));
+	    if (!is_symbol(cadr(w)))                            /* (lambda* (:rest (a 1)) ...) */
+	      {
+		if (!is_pair(cadr(w)))                          /* (lambda* (:rest 1) ...) */
+		  error_nr(sc, sc->syntax_error_symbol,
+			   set_elist_4(sc, wrap_string(sc, "lambda* :rest parameter is not a symbol: ~S in (~S ~S ...)", 58),
+				       w, car(form), cadr(form)));
+		error_nr(sc, sc->syntax_error_symbol,           /* (lambda* (:rest '(1 2)) 1) */
+			 set_elist_4(sc, wrap_string(sc, "lambda* :rest parameter can't have a default value: ~S in (~S ~S ...)", 69),
+				     w, car(form), cadr(form)));
+	      }
+	    if (is_constant(sc, cadr(w)))                       /* (lambda* (a :rest x) ...) where x is locally a constant */
+	      error_nr(sc, sc->wrong_type_arg_symbol,
+		       set_elist_4(sc, wrap_string(sc, "lambda*: ~S is immutable, so it can't be the :rest parameter name: (~S ~S ...)", 78),
+				   cadr(w), car(form), cadr(form)));
+	    set_local(cadr(w));
+	  }}
+  if (is_not_null(w))
+    {
+      if (is_constant(sc, w))                                   /* (lambda* (a . 0.0) a) or (lambda* (a . :b) a) */
+	error_nr(sc, sc->syntax_error_symbol,
+		 set_elist_4(sc, wrap_string(sc, "lambda* :rest parameter ~S is a constant, (~S ~S ...)", 53),
+			     w, car(form), cadr(form)));
+      if (is_symbol(w))
+	set_local(w);
+    }
+  else
+    if ((body) && (!has_defaults) && (is_pair(args)))
+      set_has_no_defaults(body);
+  return(top);
+}
+
+static void set_rec_tc_args(s7_scheme *sc, s7_int args)
+{
+  if (sc->rec_tc_args == -1)
+    sc->rec_tc_args = args;
+  else
+    if (sc->rec_tc_args != args)
+      sc->rec_tc_args = -2;
+}
+
+typedef enum {UNSAFE_BODY=0, RECUR_BODY, SAFE_BODY, VERY_SAFE_BODY} body_t;
+static body_t min_body(body_t b1, body_t b2) {return((b1 < b2) ? b1 : b2);}
+static body_t body_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer body, bool at_end);
+
+static body_t form_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer x, bool at_end) /* called only from body_is_safe */
+{
+  s7_pointer expr = car(x);
+  body_t result = VERY_SAFE_BODY;
+
+  if (is_symbol_and_syntactic(expr))
+    {
+      if (!is_pair(cdr(x))) return(UNSAFE_BODY);
+      switch (symbol_syntax_op_checked(x))
+	/* symbol_syntax_op(expr) here gets tangled in fx_annotation order problems! -- fix this?!?
+	 *   it appears that safe bodies are marked unsafe because the opts are out-of-order?
+	 */
+	{
+	case OP_OR: case OP_AND: case OP_BEGIN:	case OP_WITH_BAFFLE:
+	  return(body_is_safe(sc, func, cdr(x), at_end));
+
+	case OP_MACROEXPAND:
+	  return(UNSAFE_BODY);
+
+	case OP_QUOTE: case OP_QUOTE_UNCHECKED:
+	  return(((!is_pair(cdr(x))) || (!is_null(cddr(x)))) ? UNSAFE_BODY : VERY_SAFE_BODY);  /* (quote . 1) or (quote 1 2) etc */
+
+	case OP_IF:
+	  if (!is_pair(cddr(x))) return(UNSAFE_BODY);
+	  if (is_pair(cadr(x)))
+	    {
+	      result = form_is_safe(sc, func, cadr(x), false);
+	      if (result == UNSAFE_BODY) return(UNSAFE_BODY);
+	    }
+	  if (is_pair(caddr(x)))
+	    {
+	      result = min_body(result, form_is_safe(sc, func, caddr(x), at_end));
+	      if (result == UNSAFE_BODY) return(UNSAFE_BODY);
+	    }
+	  if ((is_pair(cdddr(x))) &&
+	      (is_pair(cadddr(x))))
+	    return(min_body(result, form_is_safe(sc, func, cadddr(x), at_end)));
+	  return(result);
+
+	case OP_WHEN: case OP_UNLESS:
+	  if (!is_pair(cddr(x))) return(UNSAFE_BODY);
+	  if (is_pair(cadr(x)))
+	    {
+	      result = form_is_safe(sc, func, cadr(x), false);
+	      if (result == UNSAFE_BODY) return(UNSAFE_BODY);
+	    }
+	  return(min_body(result, body_is_safe(sc, func, cddr(x), at_end)));
+
+	case OP_COND:
+	  {
+	    bool follow = false;
+	    s7_pointer p = cdr(x);
+	    for (s7_pointer sp = x; is_pair(p); p = cdr(p))
+	      {
+		s7_pointer ex = car(p);
+		if (!is_pair(ex)) return(UNSAFE_BODY);
+		if (is_pair(car(ex)))
+		  {
+		    result = min_body(result, form_is_safe(sc, func, car(ex), false));
+		    if (result == UNSAFE_BODY) return(UNSAFE_BODY);
+		  }
+		if (is_pair(cdr(ex)))
+		  {
+		    result = min_body(result, body_is_safe(sc, func, cdr(ex), at_end));
+		    if (result == UNSAFE_BODY) return(UNSAFE_BODY);
+		  }
+		if (follow) {sp = cdr(sp); if (p == sp) return(UNSAFE_BODY);}
+		follow = (!follow);
+	      }
+	    return((is_null(p)) ? result : UNSAFE_BODY);
+	  }
+
+	case OP_CASE:
+	  {
+	    bool follow = false;
+	    s7_pointer sp, p;
+	    if (!is_pair(cddr(x))) return(UNSAFE_BODY);
+	    if (is_pair(cadr(x)))
+	      {
+		result = form_is_safe(sc, func, cadr(x), false);
+		if (result == UNSAFE_BODY) return(UNSAFE_BODY);
+	      }
+	    sp = cdr(x);
+	    for (p = cdr(sp); is_pair(p); p = cdr(p))
+	      {
+		if (!is_pair(car(p))) return(UNSAFE_BODY);
+		if (is_pair(cdar(p)))
+		  {
+		    result = min_body(result, body_is_safe(sc, func, cdar(p), at_end)); /* null cdar(p) ok here */
+		    if (result == UNSAFE_BODY) return(UNSAFE_BODY);
+		  }
+		if (follow) {sp = cdr(sp); if (p == sp) return(UNSAFE_BODY);}
+		follow = (!follow);
+	      }
+	    return(result);
+	  }
+
+	case OP_SET:
+	  /* if we set func, we have to abandon the tail call scan: (let () (define (hi a) (let ((v (vector 1 2 3))) (set! hi v) (hi a))) (hi 1)) */
+	  if (!is_pair(cddr(x))) return(UNSAFE_BODY);
+	  if (cadr(x) == func) return(UNSAFE_BODY);
+
+	  /* car(x) is set!, cadr(x) is settee or obj, caddr(x) is val */
+	  if (is_pair(caddr(x)))
+	    {
+	      result = form_is_safe(sc, func, caddr(x), false);
+	      if (result == UNSAFE_BODY) return(UNSAFE_BODY);
+	    }
+	  return((is_pair(cadr(x))) ? min_body(result, form_is_safe(sc, func, cadr(x), false)) : result);
+	  /* not OP_DEFINE even in simple cases (safe_closure assumes constant funclet) */
+
+	case OP_WITH_LET:
+	  if (!is_pair(cddr(x))) return(UNSAFE_BODY);
+	  return((is_pair(cadr(x))) ? UNSAFE_BODY : min_body(body_is_safe(sc, sc->F, cddr(x), at_end), SAFE_BODY));
+	  /* shadowing can happen in with-let -- symbols are global so local_slots are shadowable */
+
+	case OP_LET_TEMPORARILY:
+	  if (!is_pair(cadr(x))) return(UNSAFE_BODY);
+	  for (s7_pointer p = cadr(x); is_pair(p); p = cdr(p))
+	    {
+	      if ((!is_pair(car(p))) ||
+		  (!is_pair(cdar(p))))
+		return(UNSAFE_BODY);
+	      if (is_pair(cadar(p)))
+		{
+		  result = min_body(result, form_is_safe(sc, sc->F, cadar(p), false));
+		  if (result == UNSAFE_BODY) return(UNSAFE_BODY);
+		}}
+	  return(min_body(result, body_is_safe(sc, sc->F, cddr(x), at_end)));
+
+	  /* in the name binders, we first have to check that "func" actually is the same thing as the caller's func */
+	case OP_LET: case OP_LET_STAR: case OP_LETREC: case OP_LETREC_STAR:
+	  {
+	    bool follow = false;
+	    s7_pointer let_name, sp, vars = cadr(x), body = cddr(x);
+	    if (is_symbol(vars))
+	      {
+		if (!is_pair(body)) return(UNSAFE_BODY);        /* (let name . res) */
+		if (vars == func) return(UNSAFE_BODY);          /* named let shadows caller */
+		let_name = vars;
+		vars = caddr(x);
+		body = cdddr(x);
+		if (is_symbol(func))
+		  add_symbol_to_list(sc, func);
+	      }
+	    else let_name = func;
+
+	    for (sp = NULL; is_pair(vars); vars = cdr(vars))
+	      {
+		s7_pointer let_var = car(vars), var_name;
+
+		if ((!is_pair(let_var)) ||
+		    (!is_pair(cdr(let_var))))
+		  return(UNSAFE_BODY);
+		var_name = car(let_var);
+		if ((!is_symbol(var_name)) ||
+		    (var_name == let_name) || /* let var shadows caller */
+		    (var_name == func))
+		  return(UNSAFE_BODY);
+		add_symbol_to_list(sc, var_name);
+
+		if (is_pair(cadr(let_var)))
+		  {
+		    result = min_body(result, form_is_safe(sc, let_name, cadr(let_var), false));
+		    if (result == UNSAFE_BODY) return(UNSAFE_BODY);
+		  }
+		follow = (!follow);
+		if (follow)
+		  {
+		    if (!sp)
+		      sp = vars;
+		    else
+		      {
+			sp = cdr(sp);
+			if (vars == sp) return(UNSAFE_BODY);
+		      }}}
+	    return(min_body(result, body_is_safe(sc, let_name, body, (let_name != func) || at_end)));
+	  }
+
+	case OP_DO:	  /* (do (...) (...) ...) */
+	  if (!is_pair(cddr(x))) return(UNSAFE_BODY);
+	  if (is_pair(cadr(x)))
+	    {
+	      s7_pointer vars = cadr(x);
+	      s7_pointer sp = vars;
+	      for (bool follow = false; is_pair(vars); vars = cdr(vars))
+		{
+		  s7_pointer do_var = car(vars);
+		  if ((!is_pair(do_var)) ||
+		      (!is_pair(cdr(do_var))) ||   /* (do ((a . 1) (b . 2)) ...) */
+		      (car(do_var) == func) ||
+		      (!is_symbol(car(do_var))))
+		    return(UNSAFE_BODY);
+
+		  add_symbol_to_list(sc, car(do_var));
+
+		  if (is_pair(cadr(do_var)))
+		    result = min_body(result, form_is_safe(sc, func, cadr(do_var), false));
+		  if ((is_pair(cddr(do_var))) && (is_pair(caddr(do_var))))
+		    result = min_body(result, form_is_safe(sc, func, caddr(do_var), false));
+		  if (result == UNSAFE_BODY)
+		    return(UNSAFE_BODY);
+		  if (sp != vars)
+		    {
+		      if (follow) {sp = cdr(sp); if (vars == sp) return(UNSAFE_BODY);}
+		      follow = (!follow);
+		    }}}
+	  if (is_pair(caddr(x)))
+	    result = min_body(result, body_is_safe(sc, func, caddr(x), at_end));
+	  return(min_body(result, body_is_safe(sc, func, cdddr(x), false)));
+
+	  /* define and friends are not safe: (define (a) (define b 3)...) tries to put b in the current let,
+	   *   but in a safe func, that's a constant.  See s7test L 1865 for an example.
+	   */
+	default:
+	  /* OP_LAMBDA is major case here */
+	  /* try to catch weird cases like:
+	   * (let () (define (hi1 a) (define (hi1 b) (+ b 1)) (hi1 a)) (hi1 1))
+	   * (let () (define (hi1 a) (define (ho1 b) b) (define (hi1 b) (+ b 1)) (hi1 a)) (hi1 1))
+	   */
+	  return(UNSAFE_BODY);
+	}}
+  else /* car(x) is not syntactic */
+    {
+      if (expr == func) /* try to catch tail call, expr is car(x) */
+	{
+	  bool follow = false;
+	  s7_pointer sp = x, p;
+	  sc->got_rec = true; /* (walk (car tree)) lint and almost all others in s7test */
+	  set_rec_tc_args(sc, proper_list_length(cdr(x)));
+	  if (!at_end) {result = RECUR_BODY; sc->not_tc = true;}
+	  for (p = cdr(x); is_pair(p); p = cdr(p))
+	    {
+	      if (is_pair(car(p)))
+		{
+		  if (caar(p) == func)    /* func called as arg, so not tail call */
+		    {
+		      sc->not_tc = true;
+		      result = RECUR_BODY;
+		    }
+		  result = min_body(result, form_is_safe(sc, func, car(p), false));
+		  if (result == UNSAFE_BODY) return(UNSAFE_BODY);
+		}
+	      else
+		if (car(p) == func) /* func itself as arg */
+		  return(UNSAFE_BODY);
+
+	      if (follow) {sp = cdr(sp); if (p == sp) return(UNSAFE_BODY);}
+	      follow = (!follow);
+	    }
+	  if ((at_end) && (!sc->not_tc) && (is_null(p))) /* tail call, so safe */
+	    {
+	      sc->got_tc = true;
+	      set_rec_tc_args(sc, proper_list_length(cdr(x)));
+	      return(result);
+	    }
+	  if (result != UNSAFE_BODY) result = RECUR_BODY;
+	  return(result);
+	}
+
+      if (is_symbol(expr)) /* expr=car(x) */
+	{
+	  s7_pointer f, f_slot;
+	  bool c_safe;
+
+	  if (symbol_is_in_list(sc, expr)) return(UNSAFE_BODY);
+	  if ((is_slot(global_slot(expr))) && (is_syntax(global_value(expr))))
+	    return(UNSAFE_BODY); /* syntax hidden behind some other name */
+
+	  f_slot = s7_slot(sc, expr);
+	  if (!is_slot(f_slot)) return(UNSAFE_BODY);
+
+	  f = slot_value(f_slot);
+	  if (is_c_function(f))
+	    {
+	      if ((expr == sc->apply_symbol) && (is_pair(cdr(x))) && (is_symbol(cadr(x)))) /* (apply <safe_c_function> ...) */
+		{
+		  s7_pointer cadr_f = lookup_unexamined(sc, cadr(x)); /* "unexamined" to skip unbound_variable */
+		  c_safe = ((cadr_f) && /* (cadr_f != sc->undefined) && */
+			    ((is_safe_c_function(cadr_f)) ||
+			     ((is_closure(cadr_f)) && (is_very_safe_closure(cadr_f)))));
+		}
+	      else c_safe = (is_safe_or_scope_safe_procedure(f));
+	    }
+	  else c_safe = false;
+
+	  result = ((is_simple_sequence(f)) || /* was is_sequence? */
+		    ((is_closure(f)) && (is_very_safe_closure(f))) ||
+		    ((c_safe) && ((is_immutable_slot(f_slot)) || (is_global(expr))))) ? VERY_SAFE_BODY : SAFE_BODY;
+
+	  if ((c_safe) ||
+	      ((is_any_closure(f)) && (is_safe_closure(f))) ||
+	      (is_simple_sequence(f)))  /* was is_sequence? */
+	    {
+	      bool follow = false;
+	      s7_pointer sp = x, p = cdr(x);
+
+	      for (; is_pair(p); p = cdr(p))
+		{
+		  if (is_unquoted_pair(car(p)))
+		    {
+		      if (caar(p) == func)
+			{
+			  sc->got_rec = true; /* (+ 1 (recur (- x 1))) t123 (and others) */
+			  set_rec_tc_args(sc, proper_list_length(cdar(p)));
+			  return(RECUR_BODY);
+			}
+		      if ((is_c_function(f)) && (is_scope_safe(f)) &&
+			  (caar(p) == sc->lambda_symbol))
+			{
+			  s7_pointer largs, lbody, q;
+			  body_t lresult;
+
+			  if (!is_pair(cdar(p))) /* (lambda . /) */
+			    return(UNSAFE_BODY);
+			  largs = cadar(p);
+			  lbody = cddar(p);
+			  for (q = largs; is_pair(q); q = cdr(q))
+			    {
+			      if (!is_symbol(car(q)))
+				return(UNSAFE_BODY);
+			      add_symbol_to_list(sc, car(q));
+			    }
+			  lresult = body_is_safe(sc, func, lbody, false);
+			  result = min_body(result, lresult);
+			}
+		      else result = min_body(result, form_is_safe(sc, func, car(p), false));
+		      if (result == UNSAFE_BODY) return(UNSAFE_BODY);
+		    }
+		  else
+		    if (car(p) == func)          /* the current function passed as an argument to something */
+		      return(UNSAFE_BODY);
+
+		  if (follow) {sp = cdr(sp); if (p == sp) return(UNSAFE_BODY);}
+		  follow = (!follow);
+		}
+	      return((is_null(p)) ? result : UNSAFE_BODY);
+	    }
+	  if ((is_safe_quote(expr)) &&
+	      (is_proper_list_1(sc, cdr(x))))
+	    return(result);
+
+	  if (expr == sc->values_symbol)      /* (values) is safe, as is (values x) if x is: (values (define...)) */
+	    {
+	      if (is_null(cdr(x))) return(result);
+	      if ((is_pair(cdr(x))) && (is_null(cddr(x))))
+		return((is_pair(cadr(x))) ? min_body(result, form_is_safe(sc, func, cadr(x), false)) : result);
+	    }}
+      else
+	if (expr == sc->quote_function)
+	  return(((!is_pair(cdr(x))) || (!is_null(cddr(x)))) ? UNSAFE_BODY : VERY_SAFE_BODY);  /* (#_quote . 1) or (#_quote 1 2) etc */
+
+      return(UNSAFE_BODY); /* not recur_body here if at_end -- possible defines in body etc */
+    }
+  return(result);
+}
+
+static body_t body_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer body, bool at_end)
+{
+  bool follow = false;
+  s7_pointer p = body;
+  body_t result = VERY_SAFE_BODY;
+  for (s7_pointer sp = body; is_pair(p); p = cdr(p))
+    {
+      if (is_pair(car(p)))
+	{
+	  result = min_body(result, form_is_safe(sc, func, car(p), (at_end) && (is_null(cdr(p)))));
+	  if (result == UNSAFE_BODY) return(UNSAFE_BODY);
+	}
+      if (p != body)
+	{
+	  if (follow) {sp = cdr(sp); if (p == sp) return(UNSAFE_BODY);}
+	  follow = (!follow);
+	}}
+  return((is_null(p)) ? result : UNSAFE_BODY);
+}
+
+static bool tree_has_definers_or_binders(s7_scheme *sc, s7_pointer tree)
+{
+  for (s7_pointer p = tree; is_pair(p); p = cdr(p))
+    if (tree_has_definers_or_binders(sc, car(p)))
+      return(true);
+  return((is_symbol(tree)) &&
+	 (is_definer_or_binder(tree)));
+}
+
+static bool check_recur_if(s7_scheme *sc, const s7_pointer name, int32_t vars, s7_pointer args, s7_pointer body)
+{
+  s7_pointer test = cadr(body);
+  if (is_fxable(sc, test))        /* if_(A)... */
+    {
+      s7_pointer obody = cddr(body), orig = NULL;
+      s7_pointer true_p = car(obody);        /* if_a_(A)... */
+      s7_pointer false_p = cadr(obody);      /* if_a_a_(if...) */
+
+      if ((vars <= 2) &&
+	  (is_fxable(sc, true_p)) &&
+	  (is_proper_list_4(sc, false_p)))
+	{
+	  if (car(false_p) == sc->if_symbol)
+	    {
+	      s7_pointer test2 = cadr(false_p);
+	      s7_pointer true2 = caddr(false_p);
+	      s7_pointer false2 = cadddr(false_p);
+	      if ((is_fxable(sc, test2)) &&
+		  (is_proper_list_3(sc, false2)) &&  /* opa_laaq or oplaa_laaq */
+		  (is_h_optimized(false2)))          /* the c-op */
+		{
+		  s7_pointer la1 = cadr(false2);
+		  s7_pointer la2 = caddr(false2);
+		  if ((is_fxable(sc, true2)) &&
+		      (((vars == 1) && (is_proper_list_2(sc, la1)) && (is_proper_list_2(sc, la2))) ||
+		       (((vars == 2) && (is_proper_list_3(sc, la1)) && (is_proper_list_3(sc, la2))))) &&
+		      (car(la1) == name) &&  	     (car(la2) == name) &&
+		      (is_fxable(sc, cadr(la1))) &&  (is_fxable(sc, cadr(la2))) &&
+		      ((vars == 1) || ((is_fxable(sc, caddr(la1))) && (is_fxable(sc, caddr(la2))))))
+		    {
+		      set_safe_optimize_op(body, (vars == 1) ? OP_RECUR_IF_A_A_IF_A_A_opLA_LAq : OP_RECUR_IF_A_A_IF_A_A_opLAA_LAAq);
+		      fx_annotate_arg(sc, cdr(body), args);
+		      fx_annotate_arg(sc, obody, args);
+		      fx_annotate_args(sc, cdr(false_p), args);
+		      fx_annotate_args(sc, cdr(la1), args);
+		      fx_annotate_args(sc, cdr(la2), args);
+		      fx_tree(sc, cdr(body), car(args), (vars == 2) ? cadr(args) : NULL, NULL, false);
+		      set_opt1_pair(body, cdr(false_p));
+		      set_opt3_pair(body, false2);
+		      set_opt3_pair(false2, cdr(la2));
+		      return(true);
+		    }
+		  if ((vars == 2) && (is_proper_list_3(sc, true2)) &&
+		      (car(true2) == name) &&
+		      (is_fxable(sc, cadr(true2))) && (is_fxable(sc, caddr(true2))) &&
+		      (is_fxable(sc, cadr(false2))) &&
+		      (is_proper_list_3(sc, la2)) &&
+		      (car(la2) == name) &&          /* actually, not needed because func is TC (not RECUR) if not == name */
+		      (is_fxable(sc, cadr(la2))) &&
+		      (is_fxable(sc, caddr(la2))))
+		    {
+		      set_safe_optimize_op(body, OP_RECUR_IF_A_A_IF_A_LAA_opA_LAAq);
+		      fx_annotate_arg(sc, cdr(body), args);       /* if_(A)... */
+		      fx_annotate_arg(sc, obody, args);           /* if_a_(A)... */
+		      fx_annotate_arg(sc, cdr(false_p), args);    /* if_a_a_if_(A)... */
+		      fx_annotate_args(sc, cdr(true2), args);     /* if_a_a_if_a_l(AA)... */
+		      fx_annotate_arg(sc, cdr(false2), args);     /* if_a_a_if_a_laa_op(A).. */
+		      fx_annotate_args(sc, cdr(la2), args);       /* if_a_a_if_a_laa_opa_l(AA)q */
+		      fx_tree(sc, cdr(body), car(args), cadr(args), NULL, false);
+		      set_opt3_pair(body, false2);
+		      set_opt3_pair(false2, la2);
+		      return(true);
+		    }}}
+
+	  if (car(false_p) == sc->and_symbol)
+	    {
+	      s7_pointer a1 = cadr(false_p);
+	      s7_pointer a2 = caddr(false_p);
+	      s7_pointer a3 = cadddr(false_p);
+	      if ((is_fxable(sc, a1)) &&
+		  (is_proper_list_3(sc, a2)) && (is_proper_list_3(sc, a3)) &&
+		  (car(a2) == name) && (car(a3) == name) &&
+		  (is_fxable(sc, cadr(a2))) && (is_fxable(sc, cadr(a3))) &&
+		  (is_fxable(sc, caddr(a2))) && (is_fxable(sc, caddr(a3))))
+		{
+		  set_safe_optimize_op(body, OP_RECUR_IF_A_A_AND_A_LAA_LAA);
+		  fx_annotate_arg(sc, cdr(body), args);       /* if_(A)... */
+		  fx_annotate_arg(sc, cddr(body), args);      /* if_a_(A)... */
+		  fx_annotate_arg(sc, cdr(false_p), args);    /* if_a_a_and_(A)... */
+		  fx_annotate_args(sc, cdr(a2), args);        /* if_a_a_and_a_l(AA)... */
+		  fx_annotate_args(sc, cdr(a3), args);        /* if_a_a_and_a_laa_l(AA) */
+		  fx_tree(sc, cdr(body), car(args), cadr(args), NULL, false);
+		  set_opt3_pair(body, false_p);
+		  return(true);
+		}}}
+
+      if ((is_fxable(sc, true_p)) &&
+	  (is_pair(false_p)) &&
+	  (is_h_optimized(false_p)) &&
+	  (is_pair(cdr(false_p))) &&
+	  (is_pair(cddr(false_p))))
+	orig = false_p;
+      else
+	if ((is_fxable(sc, false_p)) &&
+	    (is_pair(true_p)) &&
+	    (is_h_optimized(true_p)) &&
+	    (is_pair(cdr(true_p))) &&
+	    (is_pair(cddr(true_p))))
+	  {
+	    orig = true_p;
+	    /* true_p = false_p; */
+	    false_p = orig;
+	    obody = cdr(obody);
+	  }
+
+      if (orig)
+	{
+	  if (is_null(cdddr(false_p))) /* 2 args to outer (c) func */
+	    {
+	      if ((is_fxable(sc, cadr(false_p))) || (is_fxable(sc, caddr(false_p))))
+		{
+		  s7_pointer la = (is_fxable(sc, cadr(false_p))) ? caddr(false_p) : cadr(false_p);
+		  if ((is_pair(la)) &&
+		      (car(la) == name) &&
+		      (is_pair(cdr(la))) &&
+		      (is_fxable(sc, cadr(la))))
+		    {
+		      if ((vars == 1) && (is_null(cddr(la))))
+			set_safe_optimize_op(body, (orig == cadddr(body)) ?
+					     ((la == cadr(false_p)) ? OP_RECUR_IF_A_A_opLA_Aq : OP_RECUR_IF_A_A_opA_LAq) :
+					     ((la == cadr(false_p)) ? OP_RECUR_IF_A_opLA_Aq_A : OP_RECUR_IF_A_opA_LAq_A));
+		      else
+			if ((vars == 2) &&
+			    (is_pair(cddr(la))) && (is_fxable(sc, caddr(la))) &&
+			    (is_null(cdddr(la))))
+			  set_safe_optimize_op(body, (orig == cadddr(body)) ? OP_RECUR_IF_A_A_opA_LAAq : OP_RECUR_IF_A_opA_LAAq_A);
+			else
+			  {
+			    if ((vars == 3) &&
+				(is_pair(cddr(la))) && (is_fxable(sc, caddr(la))) &&
+				(is_pair(cdddr(la))) && (is_fxable(sc, cadddr(la))) &&
+				(is_null(cddddr(la))) &&
+				(orig == cadddr(body)))
+			      set_safe_optimize_op(body, OP_RECUR_IF_A_A_opA_L3Aq);
+			    else return(false);
+			  }
+		      fx_annotate_arg(sc, cdr(body), args);
+		      fx_annotate_arg(sc, obody, args);
+		      fx_annotate_arg(sc, (la == cadr(false_p)) ? cddr(false_p) : cdr(false_p), args);
+		      fx_annotate_args(sc, cdr(la), args);
+		      fx_tree(sc, cdr(body), car(args), (vars > 1) ? cadr(args) : NULL, (vars > 2) ? caddr(args) : NULL, false);
+		      set_opt3_pair(body, false_p);
+		      set_opt3_pair(false_p, la);
+		      return(true);
+		    }}
+	      else
+		{
+		  s7_pointer la1 = cadr(false_p);
+		  s7_pointer la2 = caddr(false_p);
+		  if ((vars == 1) &&
+		      (is_proper_list_2(sc, la1)) && (is_proper_list_2(sc, la2)) &&
+		      (car(la1) == name) && (car(la2) == name) &&
+		      (is_fxable(sc, cadr(la1))) && (is_fxable(sc, cadr(la2))))
+		    {
+		      set_safe_optimize_op(body, (orig == cadddr(body)) ? OP_RECUR_IF_A_A_opLA_LAq : OP_RECUR_IF_A_opLA_LAq_A);
+		      fx_annotate_arg(sc, cdr(body), args);
+		      fx_annotate_arg(sc, obody, args);
+		      fx_annotate_arg(sc, cdr(la1), args);
+		      fx_annotate_arg(sc, cdr(la2), args);
+		      fx_tree(sc, cdr(body), car(args), NULL, NULL, false);
+		      set_opt3_pair(body, false_p);
+		      set_opt3_pair(false_p, la2);
+		      return(true);
+		    }}}
+	  else /* 3 args to c func */
+	    {
+	      if ((vars == 1) &&
+		  (is_pair(cdddr(false_p))) &&
+		  (is_null(cddddr(false_p))))
+		{
+		  s7_pointer la1 = cadr(false_p);
+		  s7_pointer la2 = caddr(false_p);
+		  s7_pointer la3 = cadddr(false_p);
+		  if ((is_proper_list_2(sc, la2)) && (is_proper_list_2(sc, la3)) &&
+		      (car(la2) == name) && (car(la3) == name) &&
+		      (is_fxable(sc, cadr(la2))) && (is_fxable(sc, cadr(la3))))
+		    {
+		      if ((is_proper_list_2(sc, la1)) && (car(la1) == name) && (is_fxable(sc, cadr(la1))))
+			{
+			  if (orig != cadddr(body))
+			    return(false);
+			  set_safe_optimize_op(body, OP_RECUR_IF_A_A_opLA_LA_LAq);
+			  fx_annotate_arg(sc, cdr(la1), args);
+			}
+		      else
+			if (is_fxable(sc, la1))
+			  {
+			    set_safe_optimize_op(body, (orig == cadddr(body)) ? OP_RECUR_IF_A_A_opA_LA_LAq : OP_RECUR_IF_A_opA_LA_LAq_A);
+			    fx_annotate_arg(sc, cdr(false_p), args);
+			  }
+			else return(false);
+		      fx_annotate_arg(sc, cdr(body), args);
+		      fx_annotate_arg(sc, obody, args);
+		      fx_annotate_arg(sc, cdr(la2), args);
+		      fx_annotate_arg(sc, cdr(la3), args);
+		      fx_tree(sc, cdr(body), car(args), NULL, NULL, false);
+		      set_opt3_pair(body, false_p);
+		      set_opt3_pair(false_p, la3);
+		      return(true);
+		    }}}}}
+
+      if ((vars == 3) &&
+	  (is_fxable(sc, test)))
+	{
+	  s7_pointer true_p = caddr(body);
+	  s7_pointer false_p = cadddr(body);
+	  if ((is_fxable(sc, true_p)) &&
+	      (is_proper_list_4(sc, false_p)) &&
+	      (car(false_p) == name))
+	    {
+	      s7_pointer l3a = cdr(false_p);
+	      s7_pointer la1 = car(l3a);
+	      s7_pointer la2 = cadr(l3a);
+	      s7_pointer la3 = caddr(l3a);
+	      if ((is_proper_list_4(sc, la1)) && (is_proper_list_4(sc, la2)) && (is_proper_list_4(sc, la3)) &&
+		  (car(la1) == name) && (car(la2) == name) && (car(la3) == name) &&
+		  (is_fxable(sc, cadr(la1))) && (is_fxable(sc, cadr(la2))) && (is_fxable(sc, cadr(la3))) &&
+		  (is_fxable(sc, caddr(la1))) && (is_fxable(sc, caddr(la2))) && (is_fxable(sc, caddr(la3))) &&
+		  (is_fxable(sc, cadddr(la1))) && (is_fxable(sc, cadddr(la2))) && (is_fxable(sc, cadddr(la3))))
+		{
+		  set_safe_optimize_op(body, OP_RECUR_IF_A_A_LopL3A_L3A_L3Aq);
+		  fx_annotate_args(sc, cdr(la1), args);
+		  fx_annotate_args(sc, cdr(la2), args);
+		  fx_annotate_args(sc, cdr(la3), args);
+		  fx_annotate_arg(sc, cdr(body), args);
+		  fx_annotate_arg(sc, cddr(body), args);
+		  fx_tree(sc, cdr(body), car(args), cadr(args), caddr(args), false);
+		  set_opt3_pair(body, false_p);
+		  set_opt3_pair(false_p, la3);
+		  return(true);
+		}}}
+  return(false);
+}
+
+static bool check_recur(s7_scheme *sc, s7_pointer name, int32_t vars, s7_pointer args, s7_pointer body)
+{
+  if ((car(body) == sc->if_symbol) &&
+      (proper_list_length(body) == 4))
+    return(check_recur_if(sc, name, vars, args, body));
+
+  if ((car(body) == sc->and_symbol) &&
+      (vars == 2) &&
+      (proper_list_length(body) == 3) &&
+      (proper_list_length(caddr(body)) == 4) &&
+      (caaddr(body) == sc->or_symbol) &&
+      (is_fxable(sc, cadr(body))))
+    {
+      s7_pointer or_p = caddr(body);
+      s7_pointer la1 = caddr(or_p);
+      s7_pointer la2 = cadddr(or_p);
+      if ((is_fxable(sc, cadr(or_p))) &&
+	  (proper_list_length(la1) == 3) &&
+	  (proper_list_length(la2) == 3) &&
+	  (car(la1) == name) &&
+	  (car(la2) == name) &&
+	  (is_fxable(sc, cadr(la1))) &&
+	  (is_fxable(sc, caddr(la1))) &&
+	  (is_fxable(sc, cadr(la2))) &&
+	  (is_fxable(sc, caddr(la2))))
+	{
+	  set_safe_optimize_op(body, OP_RECUR_AND_A_OR_A_LAA_LAA);
+	  fx_annotate_args(sc, cdr(la1), args);
+	  fx_annotate_args(sc, cdr(la2), args);
+	  fx_annotate_arg(sc, cdr(body), args);
+	  fx_annotate_arg(sc, cdr(or_p), args);
+	  fx_tree(sc, cdr(body), car(args), cadr(args), NULL, false);
+	  set_opt3_pair(body, or_p);
+	  return(true);
+	}}
+
+  if (car(body) == sc->cond_symbol)
+    {
+      s7_pointer clause = cadr(body), clause2 = NULL;
+      if ((is_proper_list_1(sc, (cdr(clause)))) &&
+	  (is_fxable(sc, car(clause))) &&
+	  (is_fxable(sc, cadr(clause))))
+	{
+	  s7_pointer la_clause = caddr(body);
+	  s7_int len = proper_list_length(body);
+	  if (len == 4)
+	    {
+	      if ((is_proper_list_2(sc, la_clause)) &&
+		  (is_fxable(sc, car(la_clause))))
+		{
+		  clause2 = la_clause;
+		  la_clause = cadddr(body);
+		}
+	      else return(false);
+	    }
+	  if ((is_proper_list_2(sc, la_clause)) &&
+	      ((car(la_clause) == sc->else_symbol) || (car(la_clause) == sc->T)) &&
+	      (is_pair(cadr(la_clause))))
+	    {
+	      la_clause = cadr(la_clause); /* (c_op arg (recur par)) or (c_op (recur) (recur)) or (op|l a laa) */
+	      if (is_proper_list_2(sc, cdr(la_clause)))
+		{
+		  if (is_h_optimized(la_clause))
+		    {
+		      if ((is_fxable(sc, cadr(la_clause))) &&
+			  ((len == 3) ||
+			   ((len == 4) && (vars == 2) &&
+			    (is_proper_list_3(sc, cadr(clause2))) &&
+			    (caadr(clause2) == name))))
+			{
+			  s7_pointer la = caddr(la_clause);
+			  if ((is_pair(la)) &&
+			      (car(la) == name) &&
+			      (is_pair(cdr(la))) &&
+			      (is_fxable(sc, cadr(la))) &&
+			      (((vars == 1) && (is_null(cddr(la)))) ||
+			       ((vars == 2) &&
+				(is_pair(cddr(la))) &&
+				(is_fxable(sc, caddr(la))) &&
+				(is_null(cdddr(la))))))
+			    {
+			      if (len == 3)
+				set_safe_optimize_op(body, (vars == 1) ? OP_RECUR_COND_A_A_opA_LAq : OP_RECUR_COND_A_A_opA_LAAq);
+			      else
+				{
+				  s7_pointer laa = cadr(clause2);
+				  if ((is_fxable(sc, cadr(laa))) && /* args to first laa */
+				      (is_fxable(sc, caddr(laa))))
+				    {
+				      set_safe_optimize_op(body, OP_RECUR_COND_A_A_A_LAA_opA_LAAq);
+				      fx_annotate_arg(sc, clause2, args);
+				      fx_annotate_args(sc, cdr(laa), args);
+				    }
+				  else return(false);
+				}
+			      fx_annotate_args(sc, clause, args);
+			      fx_annotate_arg(sc, cdr(la_clause), args);
+			      fx_annotate_args(sc, cdr(la), args);
+			      fx_tree(sc, cdr(body), car(args), (vars == 1) ? NULL : cadr(args), NULL, false);
+			      set_opt3_pair(body, la_clause);
+			      set_opt3_pair(la_clause, la);
+			      return(true);
+			    }}
+		      else
+			{
+			  if ((len == 4) &&
+			      (is_fxable(sc, cadr(clause2))))
+			    {
+			      s7_pointer la1 = cadr(la_clause);
+			      s7_pointer la2 = caddr(la_clause);
+			      bool happy = false;
+
+			      if ((vars == 1) &&
+				  (is_proper_list_2(sc, la1)) && (is_proper_list_2(sc, la2)) &&
+				  (car(la1) == name) && (car(la2) == name) && (is_fxable(sc, cadr(la1))) && (is_fxable(sc, cadr(la2))))
+				{
+				  set_safe_optimize_op(body, OP_RECUR_COND_A_A_A_A_opLA_LAq);
+				  fx_annotate_arg(sc, cdr(la1), args);
+				  happy = true;
+				}
+			      else
+				if ((vars == 2) &&
+				    /* (is_fxable(sc, cadr(clause2))) && */
+				    (is_proper_list_3(sc, la2)) && (car(la2) == name) && (is_fxable(sc, cadr(la2))) && (is_fxable(sc, caddr(la2))))
+				  {
+				    if (is_fxable(sc, la1))
+				      {
+					set_safe_optimize_op(body, OP_RECUR_COND_A_A_A_A_opA_LAAq);
+					fx_annotate_arg(sc, cdr(la_clause), args);
+					happy = true;
+				      }
+				    else
+				      if ((is_proper_list_3(sc, la1)) &&
+					  (car(la1) == name) &&
+					  (is_fxable(sc, cadr(la1))) &&
+					  (is_fxable(sc, caddr(la1))))
+					{
+					  set_safe_optimize_op(body, OP_RECUR_COND_A_A_A_A_opLAA_LAAq);
+					  fx_annotate_args(sc, cdr(la1), args);
+					  happy = true;
+					}}
+			      if (happy)
+				{
+				  set_opt3_pair(la_clause, cdr(la2));
+				  fx_annotate_args(sc, clause, args);
+				  fx_annotate_args(sc, clause2, args);
+				  fx_annotate_args(sc, cdr(la2), args);
+				  fx_tree(sc, cdr(body), car(args), (vars == 1) ? NULL : cadr(args), NULL, false);
+				  set_opt3_pair(body, la_clause);
+				  return(true);
+				}}}}
+		  else
+		    {
+		      if (clause2)
+			{
+			  s7_pointer laa = cadr(clause2);
+			  if ((vars == 2) && (len == 4) &&
+			      (is_proper_list_3(sc, laa)) && (car(laa) == name) && (is_fxable(sc, cadr(laa))) && (is_fxable(sc, caddr(laa))))
+			    {
+			      s7_pointer la1 = cadr(la_clause);
+			      s7_pointer la2 = caddr(la_clause);
+			      if ((is_fxable(sc, la1)) &&
+				  (is_proper_list_3(sc, la2)) && (car(la2) == name) && (is_fxable(sc, cadr(la2))) && (is_fxable(sc, caddr(la2))))
+				{
+				  set_safe_optimize_op(body, OP_RECUR_COND_A_A_A_LAA_LopA_LAAq);
+				  fx_annotate_args(sc, clause, args);
+				  fx_annotate_arg(sc, clause2, args);
+				  fx_annotate_args(sc, cdr(laa), args);
+				  fx_annotate_arg(sc, cdr(la_clause), args);
+				  fx_annotate_args(sc, cdr(la2), args);
+				  fx_tree(sc, cdr(body), car(args), cadr(args), NULL, false);
+				  set_opt3_pair(body, la_clause);
+				  set_opt3_pair(la_clause, cdr(la2));
+				  return(true);
+				}}}}}}}}
+  return(false);
+}
+
+static bool check_tc_when(s7_scheme *sc, const s7_pointer name, int32_t vars, s7_pointer args, s7_pointer body)
+{
+  s7_pointer test_expr = cadr(body);
+  if (is_fxable(sc, test_expr))
+    {
+      s7_pointer p;
+      for (p = cddr(body); is_pair(cdr(p)); p = cdr(p))
+	if (!is_fxable(sc, car(p)))
+	  break;
+      if ((is_proper_list_1(sc, p)) &&     /* i.e. p is the last form in the when body */
+	  (is_pair(car(p))) &&
+	  (caar(p) == name))
+	{
+	  s7_pointer laa = car(p);
+	  set_opt3_pair(body, p);
+	  if ((is_pair(cdr(laa))) && (is_fxable(sc, cadr(laa))))
+	    {
+	      if (is_null(cddr(laa)))
+		{
+		  if (vars != 1) return(false);
+		  set_safe_optimize_op(body, OP_TC_WHEN_LA);
+		}
+	      else
+		if (is_fxable(sc, caddr(laa)))
+		  {
+		    if (is_null(cdddr(laa)))
+		      {
+			if (vars != 2) return(false);
+			set_safe_optimize_op(body, OP_TC_WHEN_LAA);
+		      }
+		    else
+		      if ((vars == 3) && (is_fxable(sc, cadddr(laa))) && (is_null(cddddr(laa))))
+			set_safe_optimize_op(body, OP_TC_WHEN_L3A);
+		      else return(false);
+		  }
+	      fx_annotate_arg(sc, cdr(body), args);
+	      for (p = cddr(body); is_pair(cdr(p)); p = cdr(p))
+		fx_annotate_arg(sc, p, args);
+	      fx_annotate_args(sc, cdr(laa), args);
+	      fx_tree(sc, cdr(body), car(args), (is_pair(cdr(args))) ? cadr(args) : NULL, ((is_pair(cdr(args))) && (is_pair(cddr(args)))) ? caddr(args) : NULL, false);
+	      return(true);
+	    }}}
+  return(false);
+}
+
+static bool check_tc_case(s7_scheme *sc, s7_pointer name, s7_pointer args, s7_pointer body)
+{
+  /* vars == 1, opt1_any(clause) = key, has_tc(arg) = is tc call, opt2_any(clause) = result: has_tc(la arg) has_fx(val) or ((...)...) */
+  s7_pointer clauses;
+  s7_int len;
+  bool got_else = false, results_fxable = true;
+  for (clauses = cddr(body), len = 0; is_pair(clauses); clauses = cdr(clauses), len++)
+    {
+      s7_pointer clause = car(clauses), result;
+      if (is_proper_list_1(sc, car(clause)))
+	{
+	  if (!is_simple(caar(clause)))
+	    return(false); /* even if key is a small int, selector might be a mutable alias of that, so = will fail */
+	  set_opt1_any(clauses, caar(clause));
+	}
+      else
+	{
+	  if ((car(clause) != sc->else_symbol) ||
+	      (!is_null(cdr(clauses))))
+	    return(false);
+	  got_else = true;
+	}
+      set_opt2_any(clauses, NULL);
+      result = cdr(clause);
+      if (is_null(result))
+	return(false);
+      if (is_proper_list_1(sc, result))
+	{
+	  if (is_fxable(sc, car(result)))
+	    {
+	      fx_annotate_arg(sc, result, args);
+	      set_opt2_any(clauses, result);
+	    }
+	  else
+	    if ((is_proper_list_2(sc, car(result))) &&
+		(caar(result) == name) &&
+		(is_fxable(sc, cadar(result))))
+	      {
+		set_has_tc(car(result));
+		set_opt2_any(clauses, car(result));
+		fx_annotate_arg(sc, cdar(result), args);
+	      }
+	    else results_fxable = false;
+	}
+      else results_fxable = false;
+      if (!opt2_any(clauses))
+	{
+	  if (car(result) == sc->feed_to_symbol)
+	    return(false);
+	  if (tree_count(sc, name, result, 0) != 0)
+	    return(false);
+	  set_opt2_any(clauses, result);
+	}}
+  if ((!got_else) || (!is_null(clauses)))
+    return(false);
+  set_optimize_op(body, OP_TC_CASE_LA);
+  set_opt3_arglen(cdr(body), (len < 6) ? len : 0);
+  fx_annotate_arg(sc, cdr(body), args);
+  fx_tree(sc, cdr(body), car(args), NULL, NULL, true);
+  if (results_fxable) set_optimized(body);
+  return(results_fxable);
+}
+
+static bool check_tc_cond(s7_scheme *sc, s7_pointer name, int32_t vars, s7_pointer args, s7_pointer body)
+{
+  s7_pointer p = cdr(body), clause1 = car(p);
+  if ((is_proper_list_2(sc, clause1)) && (is_fxable(sc, car(clause1)))) /* cond_a... */
+    {
+      p = cdr(p);
+      if ((is_pair(p)) && (is_null(cdr(p))) && ((caar(p) == sc->else_symbol) || (caar(p) == sc->T)))
+	{
+	  s7_pointer else_clause;
+	  if (((vars != 1) && (vars != 2)) || (tree_count(sc, name, body, 0) != 1)) return(false);
+	  else_clause = cdar(p);
+	  if (is_proper_list_1(sc, else_clause))
+	    {
+	      s7_pointer la = car(else_clause);
+	      fx_annotate_arg(sc, clause1, args);
+	      if ((is_pair(la)) && (car(la) == name) && (is_pair(cdr(la))))
+		{
+		  if ((is_fxable(sc, cadr(la))) &&
+		      ((((vars == 1) && (is_null(cddr(la)))) ||
+			((vars == 2) && (is_pair(cddr(la))) && (is_null(cdddr(la))) && (is_fxable(sc, caddr(la)))))))
+		    {
+		      bool zs_fxable = is_fxable(sc, cadr(clause1));
+		      set_optimize_op(body, (vars == 1) ? OP_TC_COND_A_Z_LA : OP_TC_COND_A_Z_LAA);
+		      if (zs_fxable) fx_annotate_arg(sc, cdr(clause1), args);
+		      fx_annotate_args(sc, cdr(la), args);
+		      fx_tree(sc, cdr(body), car(args), (vars == 1) ? NULL : cadr(args), NULL, false);
+		      if (zs_fxable) set_optimized(body);
+		      set_opt1_pair(cdr(body), cdadr(body));
+		      set_opt3_pair(cdr(body), cdadr(caddr(body)));
+		      return(zs_fxable);
+		    }}
+	      else
+		{
+		  la = cadr(clause1);
+		  if ((is_pair(la)) && (car(la) == name) && (is_pair(cdr(la))))
+		    {
+		      if ((is_fxable(sc, cadr(la))) &&
+			  (((vars == 1) && (is_null(cddr(la)))) ||
+			   ((vars == 2) && (is_pair(cddr(la))) && (is_null(cdddr(la))) && (is_fxable(sc, caddr(la))))))
+			{
+			  bool zs_fxable = is_fxable(sc, car(else_clause));
+			  set_optimize_op(body, (vars == 1) ? OP_TC_COND_A_LA_Z : OP_TC_COND_A_LAA_Z);
+			  if (zs_fxable) fx_annotate_arg(sc, else_clause, args);
+			  fx_annotate_args(sc, cdr(la), args);
+			  fx_tree(sc, cdr(body), car(args), (vars == 1) ? NULL : cadr(args), NULL, false);
+			  if (zs_fxable) set_optimized(body);
+			  set_opt1_pair(cdr(body), cdaddr(body));
+			  set_opt3_pair(cdr(body), cdadr(cadr(body)));
+			  return(zs_fxable);
+			}}}}
+	  return(false);
+	}
+      if (is_proper_list_2(sc, p))
+	{
+	  s7_pointer clause2 = car(p);
+	  if ((is_proper_list_2(sc, clause2)) &&
+	      (is_fxable(sc, car(clause2))))
+	    {
+	      s7_pointer else_p = cdr(p);
+	      s7_pointer else_clause = car(else_p);
+
+	      if ((is_proper_list_2(sc, else_clause)) &&
+		  ((car(else_clause) == sc->else_symbol) || (car(else_clause) == sc->T)))
+		{
+		  bool zs_fxable = true;
+		  if ((vars == 2) && /* ...laa_laa case */
+		      (is_proper_list_3(sc, cadr(clause2))) && (caadr(clause2) == name) &&
+		      (is_fxable(sc, cadadr(clause2))) && (is_safe_fxable(sc, caddadr(clause2))) &&
+		      (is_proper_list_3(sc, cadr(else_clause))) && (caadr(else_clause) == name) &&
+		      (is_fxable(sc, cadadr(else_clause))) && (is_safe_fxable(sc, caddadr(else_clause))))
+		    {
+		      set_optimize_op(body, OP_TC_COND_A_Z_A_LAA_LAA);
+		      if (is_fxable(sc, cadr(clause1)))
+			fx_annotate_args(sc, clause1, args);
+		      else
+			{
+			  fx_annotate_arg(sc, clause1, args);
+			  zs_fxable = false;
+			}
+		      fx_annotate_arg(sc, clause2, args);
+		      fx_annotate_args(sc, cdadr(clause2), args);
+		      fx_annotate_args(sc, cdadr(else_clause), args);
+		      fx_tree(sc, cdr(body), car(args), cadr(args), NULL, false);
+		      set_opt3_pair(body, cadr(else_clause));
+		      if (zs_fxable) set_optimized(body);
+		      return(zs_fxable);
+		    }
+
+		  if ((tree_count(sc, name, body, 0) == 1) && /* needed to filter out cond_a_a_a_laa_opa_laa */
+
+		      (((is_pair(cadr(else_clause))) && (caadr(else_clause) == name) &&
+			(is_pair(cdadr(else_clause))) && (is_fxable(sc, cadadr(else_clause))) &&
+			(((vars == 1) && (is_null(cddadr(else_clause)))) ||
+			 ((vars == 2) && (is_proper_list_3(sc, cadr(else_clause))) && (is_fxable(sc, caddadr(else_clause)))))) ||
+
+		       ((is_pair(cadr(clause2))) && (caadr(clause2) == name) &&
+			(is_pair(cdadr(clause2))) && (is_fxable(sc, cadadr(clause2))) &&
+			(((vars == 1) && (is_null(cddadr(clause2)))) ||
+			 ((vars == 2) && (is_pair(cddadr(clause2))) && (is_fxable(sc, caddadr(clause2))) && (is_null(cdddr(cadr(clause2)))))))))
+		    {
+		      s7_pointer test2 = clause2;
+		      s7_pointer la_test = else_clause;
+		      if (vars == 1)
+			{
+			  if ((is_pair(cadr(else_clause))) && (caadr(else_clause) == name))
+			    set_optimize_op(body, OP_TC_COND_A_Z_A_Z_LA);
+			  else
+			    {
+			      set_optimize_op(body, OP_TC_COND_A_Z_A_LA_Z);
+			      test2 = else_clause;
+			      la_test = clause2;
+			      fx_annotate_arg(sc, clause2, args);
+			    }}
+		      else
+			if ((is_pair(cadr(else_clause))) && (caadr(else_clause) == name))
+			  {
+			    set_opt3_pair(body, cdadr(else_clause));
+			    set_optimize_op(body, OP_TC_COND_A_Z_A_Z_LAA);
+			  }
+			else
+			  {
+			    set_optimize_op(body, OP_TC_COND_A_Z_A_LAA_Z);
+			    test2 = else_clause;
+			    la_test = clause2;
+			    set_opt3_pair(body, cdadr(la_test));
+			    fx_annotate_arg(sc, clause2, args);
+			  }
+		      if (is_fxable(sc, cadr(clause1)))
+			fx_annotate_args(sc, clause1, args);
+		      else
+			{
+			  fx_annotate_arg(sc, clause1, args);
+			  zs_fxable = false;
+			}
+		      if (is_fxable(sc, cadr(test2)))
+			fx_annotate_args(sc, test2, args);
+		      else
+			{
+			  fx_annotate_arg(sc, test2, args);
+			  zs_fxable = false;
+			}
+		      fx_annotate_args(sc, cdadr(la_test), args);
+		      fx_tree(sc, cdr(body), car(args), (vars == 2) ? cadr(args) : NULL, NULL, false);
+		      if (zs_fxable) set_optimized(body);
+		      return(zs_fxable);
+		    }}}}}
+  return(false);
+}
+
+static bool check_tc_let(s7_scheme *sc, const s7_pointer name, int32_t vars, s7_pointer args, s7_pointer body)
+{
+  s7_pointer let_body = caddr(body); /* body: (let ((x (- y 1))) (if (<= x 0) 0 (f1 (- x 1)))) etc */
+  if (((vars == 2) && ((car(let_body) == sc->if_symbol) || (car(let_body) == sc->when_symbol) || (car(let_body) == sc->unless_symbol))) ||
+      ((vars == 1) && (car(let_body) == sc->if_symbol)))
+    {
+      s7_pointer test_expr = cadr(let_body);
+      if (is_fxable(sc, test_expr))
+	{
+	  if ((car(let_body) == sc->if_symbol) && (is_pair(cdddr(let_body))))
+	    {
+	      s7_pointer laa = cadddr(let_body);
+	      if ((is_pair(laa)) && /* else caddr is laa and cadddr is z */
+		  (car(laa) == name) &&
+		  (((vars == 1) && (is_proper_list_2(sc, laa))) ||
+		   ((vars == 2) && (is_proper_list_3(sc, laa)) && (is_safe_fxable(sc, caddr(laa))))) &&
+		  (is_fxable(sc, cadr(laa))))
+		{
+		  bool z_fxable;
+		  set_optimize_op(body, (vars == 1) ? OP_TC_LET_IF_A_Z_LA : OP_TC_LET_IF_A_Z_LAA);
+		  fx_annotate_arg(sc, cdaadr(body), args);  /* let var binding, caadr: (x (- y 1)) etc */
+		  fx_tree(sc, cdaadr(body), car(args), (vars == 1) ? NULL : cadr(args), NULL, false); /* these are references to laa args, applied to the let var binding */
+		  fx_annotate_arg(sc, cdr(let_body), args); /* test_expr */
+		  fx_annotate_args(sc, cdr(laa), args);
+		  z_fxable = is_fxable(sc, caddr(let_body));
+		  if (z_fxable) fx_annotate_arg(sc, cddr(let_body), args);
+		  fx_tree(sc, cdr(let_body), car(caadr(body)), NULL, NULL, false);
+		  fx_tree_outer(sc, cdr(let_body), car(args), (vars == 1) ? NULL : cadr(args), NULL, false);
+		  if (z_fxable) set_optimized(body);
+		  return(z_fxable);
+		}}
+	  else
+	    {
+	      s7_pointer p;
+	      for (p = cddr(let_body); is_pair(cdr(p)); p = cdr(p))
+		if (!is_fxable(sc, car(p)))
+		  break;
+	      if ((is_proper_list_1(sc, p)) &&
+		  (is_proper_list_3(sc, car(p))) &&
+		  (caar(p) == name))
+		{
+		  s7_pointer laa = car(p);
+		  if ((is_fxable(sc, cadr(laa))) &&
+		      (is_safe_fxable(sc, caddr(laa))))
+		    {
+		      set_optimize_op(body, (car(let_body) == sc->when_symbol) ? OP_TC_LET_WHEN_LAA : OP_TC_LET_UNLESS_LAA);
+		      fx_annotate_arg(sc, cdaadr(body), args);  /* outer var */
+		      fx_annotate_arg(sc, cdr(let_body), args); /* test */
+		      for (p = cddr(let_body); is_pair(cdr(p)); p = cdr(p))
+			fx_annotate_arg(sc, p, args);
+		      fx_annotate_args(sc, cdr(laa), args);
+		      fx_tree(sc, cdaadr(body), car(args), cadr(args), NULL, false); /* these are references to the outer let */
+		      fx_tree(sc, cdr(let_body), car(caadr(body)), NULL, NULL, false);
+		      fx_tree_outer(sc, cdr(let_body), car(args), cadr(args), NULL, false);
+		      set_optimized(body);
+		      return(true);
+		    }}}}}
+  else
+    {
+      if (car(let_body) == sc->cond_symbol) /* vars=#loop pars, args=names thereof (arglist) */
+	{
+	  s7_pointer var_name;
+	  bool all_fxable = true;
+	  for (s7_pointer p = cdr(let_body); is_pair(p); p = cdr(p))
+	    {
+	      s7_pointer clause = car(p);
+	      if ((is_proper_list_2(sc, clause)) &&
+		  (is_fxable(sc, car(clause)))) /* test is ok */
+		{
+		  s7_pointer result;
+
+		  if ((!is_pair(cdr(p))) &&
+		      (car(clause) != sc->else_symbol) && (car(clause) != sc->T))
+		    return(false);
+		  result = cadr(clause);
+		  if ((is_pair(result)) &&
+		      (car(result) == name))    /* result is recursive call */
+		    {
+		      s7_int i = 0;
+		      for (s7_pointer arg = cdr(result); is_pair(arg); i++, arg = cdr(arg))
+			if (!is_fxable(sc, car(arg)))
+			  return(false);
+		      if (i != vars)
+			return(false);
+		    }}
+	      else return(false);
+	    }
+	  /* cond form looks ok */
+	  set_optimize_op(body, OP_TC_LET_COND);
+	  set_opt3_arglen(cdr(body), vars);
+	  fx_annotate_arg(sc, cdaadr(body), args);   /* let var */
+	  if (vars > 0)
+	    fx_tree(sc, cdaadr(body), car(args), (vars > 1) ? cadr(args) : NULL, (vars > 2) ? caddr(args) : NULL, vars > 3);
+	  var_name = caaadr(body);
+	  for (s7_pointer p = cdr(let_body); is_pair(p); p = cdr(p))
+	    {
+	      s7_pointer clause = car(p);
+	      s7_pointer result = cadr(clause);
+	      fx_annotate_arg(sc, clause, args);
+	      if ((is_pair(result)) && (car(result) == name))
+		{
+		  set_has_tc(cdr(clause));
+		  fx_annotate_args(sc, cdr(result), args);
+		}
+	      else
+		if (is_fxable(sc, result))
+		  fx_annotate_arg(sc, cdr(clause), args);
+		else all_fxable = false;
+	      fx_tree(sc, clause, var_name, NULL, NULL, false); /* just 1 let var */
+	      if (vars > 0)
+		fx_tree_outer(sc, clause, car(args), (vars > 1) ? cadr(args) : NULL, (vars > 2) ? caddr(args) : NULL, vars > 3);
+	    }
+	  if (all_fxable) set_optimized(body);
+	  return(all_fxable);
+	}}
+  return(false);
+}
+
+/* tc lets can be let* or let+vars that don't refer to previous names, and there are more cond/if choices */
+
+static bool check_tc(s7_scheme *sc, s7_pointer name, int32_t vars, s7_pointer args, s7_pointer body)
+{
+  if (!is_pair(body)) return(false);
+
+  if (((vars == 1) || (vars == 2) || (vars == 3)) &&
+      ((car(body) == sc->and_symbol) || (car(body) == sc->or_symbol)) &&
+      (is_pair(cdr(body))) &&
+      (is_fxable(sc, cadr(body))) &&
+      (is_pair(cddr(body))))
+    {
+      s7_pointer orx = caddr(body);
+      if (((car(orx) == sc->or_symbol) || (car(orx) == sc->and_symbol)) &&
+	  (car(body) != car(orx)) &&
+	  (is_fxable(sc, cadr(orx))))
+	{
+	  s7_int len = proper_list_length(orx);
+	  if ((len == 3) ||
+	      ((vars == 1) && (len == 4) && (tree_count(sc, name, orx, 0) == 1) && (is_fxable(sc, caddr(orx))))) /* the ...or|and_a_a_la case below? */
+	    {
+	      s7_pointer tc = (len == 3) ? caddr(orx) : cadddr(orx);
+	      if ((is_pair(tc)) &&
+		  (car(tc) == name) &&
+		  (is_pair(cdr(tc))) &&
+		  (is_fxable(sc, cadr(tc))) &&
+		  (((vars == 1) && (is_null(cddr(tc)))) ||
+		   ((vars == 2) && (is_pair(cddr(tc))) && (is_null(cdddr(tc))) && (is_safe_fxable(sc, caddr(tc)))) ||
+		   ((vars == 3) && (is_pair(cddr(tc))) && (is_pair(cdddr(tc))) && (is_null(cddddr(tc))) &&
+		    (is_safe_fxable(sc, caddr(tc))) && (is_safe_fxable(sc, cadddr(tc))))))
+		{
+		  if (vars == 1)
+		    set_safe_optimize_op(body, (car(body) == sc->and_symbol) ?
+					 ((len == 3) ? OP_TC_AND_A_OR_A_LA : OP_TC_AND_A_OR_A_A_LA) :
+					 ((len == 3) ? OP_TC_OR_A_AND_A_LA : OP_TC_OR_A_AND_A_A_LA));
+		  else
+		    if (vars == 2)
+		      set_safe_optimize_op(body, (car(body) == sc->and_symbol) ? OP_TC_AND_A_OR_A_LAA : OP_TC_OR_A_AND_A_LAA);
+		    else set_safe_optimize_op(body, (car(body) == sc->and_symbol) ? OP_TC_AND_A_OR_A_L3A : OP_TC_OR_A_AND_A_L3A);
+		  fx_annotate_arg(sc, cdr(body), args);
+		  fx_annotate_arg(sc, cdr(orx), args);
+		  if (len == 4) fx_annotate_arg(sc, cddr(orx), args);
+		  fx_annotate_args(sc, cdr(tc), args);
+		  /* if ((fx_proc(cdr(tc)) == fx_c_sca) && (fn_proc(cadr(tc)) == g_substring)) -> g_substring_uncopied); */
+		  /*   for that to be safe we need to be sure nothing in the body looks for null-termination (e.g.. string->number) */
+		  fx_tree(sc, cdr(body), car(args), (vars == 1) ? NULL : cadr(args), (vars == 3) ? caddr(args) : NULL, false);
+		  return(true);
+		}}}
+      else
+	{
+	  if ((vars == 1) &&
+	      (car(body) == sc->or_symbol) &&
+	      (is_fxable(sc, orx)) &&
+	      (is_pair(cdddr(body))) &&
+	      (is_pair(cadddr(body))))
+	    {
+	      s7_pointer and_p = cadddr(body);
+	      if ((is_proper_list_4(sc, and_p)) &&
+		  (car(and_p) == sc->and_symbol) &&
+		  (is_fxable(sc, cadr(and_p))) &&
+		  (is_fxable(sc, caddr(and_p))))
+		{
+		  s7_pointer la = cadddr(and_p);
+		  if ((is_proper_list_2(sc, la)) &&
+		      (car(la) == name) &&
+		      (is_fxable(sc, cadr(la))))
+		    {
+		      set_safe_optimize_op(body, OP_TC_OR_A_A_AND_A_A_LA);
+		      fx_annotate_arg(sc, cdr(body), args);
+		      fx_annotate_arg(sc, cddr(body), args);
+		      fx_annotate_arg(sc, cdr(and_p), args);
+		      fx_annotate_arg(sc, cddr(and_p), args);
+		      fx_annotate_args(sc, cdr(la), args);
+		      fx_tree(sc, cdr(body), car(args), NULL, NULL, false);
+		      return(true);
+		    }}}
+	  else
+ 	    {
+ 	      if ((vars == 1) && (car(body) == sc->and_symbol) && (car(orx) == sc->if_symbol) &&
+ 		  (is_proper_list_4(sc, orx)) && (is_fxable(sc, cadr(orx))) && (tree_count(sc, name, orx, 0) == 1))
+ 		{
+		  bool z_first = ((is_pair(cadddr(orx))) && (car(cadddr(orx)) == name));
+ 		  s7_pointer la = (z_first) ? cadddr(orx) : caddr(orx);
+ 		  if ((car(la) == name) && (is_proper_list_2(sc, la)) && (is_fxable(sc, cadr(la))))
+ 		    {
+		      bool z_fxable = true;
+		      s7_pointer z = (z_first) ? cddr(orx) : cdddr(orx);
+ 		      set_optimize_op(body, (z_first) ? OP_TC_AND_A_IF_A_Z_LA : OP_TC_AND_A_IF_A_LA_Z);
+ 		      fx_annotate_arg(sc, cdr(body), args);
+ 		      fx_annotate_arg(sc, cdr(orx), args);
+ 		      fx_annotate_arg(sc, cdr(la), args);
+ 		      if (is_fxable(sc, car(z))) fx_annotate_arg(sc, z, args); else z_fxable = false;
+ 		      fx_tree(sc, cdr(body), car(args), NULL, NULL, false);
+		      if (z_fxable) set_optimized(body);
+ 		      return(z_fxable);
+		    }}}}}
+
+  if ((vars == 3) &&
+      (((car(body) == sc->or_symbol) && (is_proper_list_2(sc, cdr(body)))) ||
+       ((car(body) == sc->if_symbol) && (is_proper_list_3(sc, cdr(body))) && (caddr(body) == sc->T))) &&
+      (is_fxable(sc, cadr(body))))
+    {
+      s7_pointer and_p = (car(body) == sc->or_symbol) ? caddr(body) : cadddr(body);
+      if ((is_proper_list_4(sc, and_p)) &&
+	  (car(and_p) == sc->and_symbol) &&
+	  (is_fxable(sc, cadr(and_p))) &&
+	  (is_fxable(sc, caddr(and_p))))
+	{
+	  s7_pointer la = cadddr(and_p);
+	  if ((is_proper_list_4(sc, la)) &&
+	      (car(la) == name) &&
+	      (is_fxable(sc, cadr(la))) &&
+	      (is_safe_fxable(sc, caddr(la))) &&
+	      (is_safe_fxable(sc, cadddr(la))))
+	    {
+	      set_safe_optimize_op(body, OP_TC_OR_A_AND_A_A_L3A);
+	      set_opt3_pair(cdr(body), (car(body) == sc->or_symbol) ? cdaddr(body) : cdr(cadddr(body)));
+	      fx_annotate_arg(sc, cdr(body), args);
+	      fx_annotate_arg(sc, cdr(and_p), args);
+	      fx_annotate_arg(sc, cddr(and_p), args);
+	      fx_annotate_args(sc, cdr(la), args);
+	      fx_tree(sc, cdr(body), car(args), cadr(args), caddr(args), false);
+	      return(true);
+	    }}}
+
+  if (((vars >= 1) && (vars <= 3)) &&
+      (car(body) == sc->if_symbol) &&
+      (proper_list_length(body) == 4))
+    {
+      s7_pointer test = cadr(body);
+      if (is_fxable(sc, test))
+	{
+	  s7_pointer true_p = caddr(body);
+	  s7_pointer false_p = cadddr(body);
+	  s7_int true_len = proper_list_length(true_p);
+	  s7_int false_len = proper_list_length(false_p);
+
+	  fx_annotate_arg(sc, cdr(body), args);
+
+	  if (vars == 1)
+	    {
+	      if ((false_len == 2) &&
+		  (car(false_p) == name) &&
+		  (is_fxable(sc, cadr(false_p))))
+		{
+		  set_optimize_op(body, OP_TC_IF_A_Z_LA);
+		  fx_annotate_arg(sc, cdr(false_p), args);  /* arg */
+		  set_opt1_pair(cdr(body), cddr(body));
+		  set_opt3_pair(cdr(body), cdar(cdddr(body)));
+		  if (!is_fxable(sc, true_p)) return(false);
+		  fx_annotate_arg(sc, cddr(body), args);    /* result */
+		  fx_tree(sc, cdr(body), car(args), NULL, NULL, false);
+		  set_optimized(body); /* split here and elsewhere from set_optimize_op is deliberate */
+		  return(true);
+		}
+	      if ((true_len == 2) &&
+		  (car(true_p) == name) &&
+		  (is_fxable(sc, cadr(true_p))))
+		{
+		  set_optimize_op(body, OP_TC_IF_A_LA_Z);
+		  fx_annotate_arg(sc, cdr(true_p), args);   /* arg */
+		  set_opt1_pair(cdr(body), cdddr(body));
+		  set_opt3_pair(cdr(body), cdar(cddr(body)));
+		  if (!is_fxable(sc, false_p)) return(false);
+		  fx_annotate_arg(sc, cdddr(body), args);    /* result */
+		  fx_tree(sc, cdr(body), car(args), NULL, NULL, false);
+		  set_optimized(body);
+		  return(true);
+		}}
+
+	  if (vars == 2)
+	    {
+	      if ((false_len == 3) &&
+		  (car(false_p) == name) &&
+		  (is_fxable(sc, cadr(false_p))) &&
+		  (is_safe_fxable(sc, caddr(false_p))))
+		{
+		  set_optimize_op(body, OP_TC_IF_A_Z_LAA);
+		  fx_annotate_args(sc, cdr(false_p), args);
+		  set_opt1_pair(cdr(body), cddr(body)); /* body == code in op, if_z */
+		  set_opt3_pair(cdr(body), cdar(cdddr(body))); /* la */
+		  if (!is_fxable(sc, true_p)) return(false);
+		  fx_annotate_arg(sc, cddr(body), args);
+		  fx_tree(sc, cdr(body), car(args), cadr(args), NULL, false);
+		  set_optimized(body);
+		  return(true);
+		}
+	      if ((true_len == 3) &&
+		  (car(true_p) == name) &&
+		  (is_fxable(sc, cadr(true_p))) &&
+		  (is_safe_fxable(sc, caddr(true_p))))
+		{
+		  set_optimize_op(body, OP_TC_IF_A_LAA_Z);
+		  fx_annotate_args(sc, cdr(true_p), args);
+		  set_opt1_pair(cdr(body), cdddr(body));
+		  set_opt3_pair(cdr(body), cdar(cddr(body)));
+		  if (!is_fxable(sc, false_p)) return(false);
+		  fx_annotate_arg(sc, cdddr(body), args);
+		  fx_tree(sc, cdr(body), car(args), cadr(args), NULL, false);
+		  set_optimized(body);
+		  return(true);
+		}}
+
+	  if (vars == 3)
+	    {
+	      if ((false_len == 4) &&
+		  (car(false_p) == name) &&
+		  (is_fxable(sc, cadr(false_p))) && (is_safe_fxable(sc, caddr(false_p))) && (is_safe_fxable(sc, cadddr(false_p))))
+		{
+		  set_optimize_op(body, OP_TC_IF_A_Z_L3A);
+		  fx_annotate_args(sc, cdr(false_p), args);
+		  set_opt1_pair(cdr(body), cddr(body));
+		  set_opt3_pair(cdr(body), cdar(cdddr(body)));
+		  if (!is_fxable(sc, true_p)) return(false);
+		  fx_annotate_arg(sc, cddr(body), args);
+		  fx_tree(sc, cdr(body), car(args), cadr(args), caddr(args), false);
+		  set_optimized(body);
+		  return(true);
+		}
+	      if ((true_len == 4) &&
+		  (car(true_p) == name) &&
+		  (is_fxable(sc, cadr(true_p))) && (is_safe_fxable(sc, caddr(true_p))) && (is_safe_fxable(sc, cadddr(true_p))))
+		{
+		  set_optimize_op(body, OP_TC_IF_A_L3A_Z);
+		  fx_annotate_args(sc, cdr(true_p), args);
+		  set_opt1_pair(cdr(body), cdddr(body));
+		  set_opt3_pair(cdr(body), cdar(cddr(body)));
+		  if (!is_fxable(sc, false_p)) return(false);
+		  fx_annotate_arg(sc, cdddr(body), args);
+		  fx_tree(sc, cdr(body), car(args), cadr(args), caddr(args), false);
+		  set_optimized(body);
+		  return(true);
+		}}
+
+ 	  if ((false_len == 4) &&
+ 	      (car(false_p) == sc->if_symbol))
+ 	    {
+ 	      s7_pointer in_test = cadr(false_p);
+	      s7_pointer in_true = caddr(false_p);
+	      s7_pointer in_false = cadddr(false_p);
+ 	      if (is_fxable(sc, in_test))
+		{
+		  s7_pointer la = NULL, z;
+		  if ((is_pair(in_false)) &&
+		      (car(in_false) == name) &&
+		      (is_pair(cdr(in_false))) &&
+		      (is_fxable(sc, cadr(in_false))))
+		    {
+		      la = in_false;
+		      z = cddr(false_p);
+		    }
+		  else
+		    if ((is_pair(in_true)) &&
+			(car(in_true) == name) &&
+			(is_pair(cdr(in_true))) &&
+			(is_fxable(sc, cadr(in_true))))
+		      {
+			la = in_true;
+			z = cdddr(false_p);
+		      }
+		  if ((la) && ((vars == 3) || (!s7_tree_memq(sc, name, car(z)))))
+		    {
+		      if (((vars == 1) && (is_null(cddr(la)))) ||
+			  ((vars == 2) && (is_pair(cddr(la))) && (is_null(cdddr(la))) && (is_safe_fxable(sc, caddr(la)))) ||
+			  ((vars == 3) && (is_proper_list_4(sc, in_true)) && (car(in_true) == name) &&
+			   (is_proper_list_4(sc, in_false)) && (is_safe_fxable(sc, caddr(la))) && (is_safe_fxable(sc, cadddr(la))) &&
+			   (is_fxable(sc, cadr(in_true))) && (is_safe_fxable(sc, caddr(in_true))) && (is_safe_fxable(sc, cadddr(in_true)))))
+			{
+			  bool zs_fxable = true;
+			  if (vars == 1)
+			    set_optimize_op(body, (la == in_false) ? OP_TC_IF_A_Z_IF_A_Z_LA : OP_TC_IF_A_Z_IF_A_LA_Z);
+			  else
+			    if (vars == 2)
+			      set_optimize_op(body, (la == in_false) ? OP_TC_IF_A_Z_IF_A_Z_LAA : OP_TC_IF_A_Z_IF_A_LAA_Z);
+			    else set_optimize_op(body, OP_TC_IF_A_Z_IF_A_L3A_L3A);
+			  if (is_fxable(sc, true_p))             /* outer (z) result */
+			    fx_annotate_arg(sc, cddr(body), args);
+			  else zs_fxable = false;
+			  fx_annotate_arg(sc, cdr(false_p), args);  /* inner test */
+			  fx_annotate_args(sc, cdr(la), args);      /* la arg(s) */
+			  if (vars == 3)
+			    fx_annotate_args(sc, cdr(in_true), args);
+			  else
+			    if (is_fxable(sc, car(z)))
+			      fx_annotate_arg(sc, z, args);       /* inner (z) result */
+			    else zs_fxable = false;
+			  if ((has_fx(cddr(body))) && (has_fx(z)))
+			    fx_tree(sc, cdr(body), car(args), (vars > 1) ? cadr(args) : NULL, (vars > 2) ? caddr(args) : NULL, false);
+			  if (zs_fxable) set_optimized(body);
+			  return(zs_fxable);
+			}}}}
+
+	  if ((vars == 2) &&
+	      (false_len == 3) &&
+	      (car(false_p) == sc->let_star_symbol))
+	    {
+	      s7_pointer letv = cadr(false_p), letb, v;
+
+	      if (!is_pair(letv)) return(false);
+	      letb = caddr(false_p);
+	      for (v = letv; is_pair(v); v = cdr(v))
+		if (!is_fxable(sc, cadar(v)))
+		  return(false);
+	      if ((is_proper_list_4(sc, letb)) &&
+		  (car(letb) == sc->if_symbol) &&
+		  (is_fxable(sc, cadr(letb))))
+		{
+		  s7_pointer laa = cadddr(letb);
+		  if ((car(laa) == name) &&
+		      (is_proper_list_3(sc, laa)) &&
+		      (is_fxable(sc, cadr(laa))) &&
+		      (is_safe_fxable(sc, caddr(laa))))
+		    {
+		      bool zs_fxable;
+		      set_safe_optimize_op(body, OP_TC_IF_A_Z_LET_IF_A_Z_LAA);
+		      fx_annotate_args(sc, cdr(laa), args);
+		      zs_fxable = is_fxable(sc, caddr(letb));
+		      fx_annotate_args(sc, cdr(letb), args);
+		      for (v = letv; is_pair(v); v = cdr(v))
+			fx_annotate_arg(sc, cdar(v), args);
+		      fx_tree(sc, cdar(letv), car(args), cadr(args), NULL, true); /* first var of let*, second var of let* can't be fx_treed */
+		      fx_tree(sc, cdr(body), car(args), cadr(args), NULL, true);  /* these are references to the outer let */
+		      fx_tree(sc, cdr(laa), caar(letv), (is_pair(cdr(letv))) ? caadr(letv) : NULL, NULL, true);
+		      fx_tree(sc, cdr(letb), caar(letv), (is_pair(cdr(letv))) ? caadr(letv) : NULL, NULL, true);
+		      fx_tree_outer(sc, cddr(letb), car(args), cadr(args), NULL, true);
+		      if (!is_fxable(sc, caddr(body)))
+			return(false);
+		      fx_annotate_arg(sc, cddr(body), args);
+		      return(zs_fxable);
+		    }}}}}
+
+  /* let */
+  if ((is_proper_list_3(sc, body)) &&
+      (car(body) == sc->let_symbol) &&
+      (is_proper_list_1(sc, cadr(body))) &&
+      (is_fxable(sc, cadr(caadr(body)))) && /* let one var is fxable */
+      (is_pair(caddr(body))))
+    return(check_tc_let(sc, name, vars, args, body));
+
+  /* cond */
+  if ((car(body) == sc->cond_symbol) &&
+      (vars <= 2))
+    return(check_tc_cond(sc, name, vars, args, body));
+
+  /* case */
+  if ((vars == 1) &&
+      (car(body) == sc->case_symbol) &&
+      (is_pair(cdr(body))) &&
+      (is_fxable(sc, cadr(body))))
+    return(check_tc_case(sc, name, args, body));
+
+  /* when */
+  if ((vars >= 1) && (vars <= 3) &&
+      (car(body) == sc->when_symbol) &&
+      (is_fxable(sc, cadr(body))))
+    return(check_tc_when(sc, name, vars, args, body));
+  return(false);
+}
+
+static void mark_fx_treeable(s7_scheme *sc, s7_pointer body)
+{ /* it is possible to encounter a cyclic body here -- should we protect against that if safety>0? */
+  if (is_pair(body)) /* slightly faster than the other way of writing this */
+    {
+      if (is_pair(car(body)))
+	{
+	  set_is_fx_treeable(body);
+	  mark_fx_treeable(sc, car(body));
+	}
+      mark_fx_treeable(sc, cdr(body));
+    }
+}
+
+static void optimize_lambda(s7_scheme *sc, bool unstarred_lambda, s7_pointer func, s7_pointer args, s7_pointer body)
+{                                                                 /* func is either sc->unused or a symbol */
+  s7_int len = s7_list_length(sc, body);
+  if (SHOW_EVAL_OPS) fprintf(stderr, "  %s[%d]: %s\n", __func__, __LINE__, display_truncated(body));
+  if (len < 0)                /* (define (hi) 1 . 2) */
+    error_nr(sc, sc->syntax_error_symbol,
+	     set_elist_3(sc, wrap_string(sc, "~A: function body messed up, ~A", 31),
+			 (unstarred_lambda) ? sc->lambda_symbol : sc->lambda_star_symbol,
+			 sc->code));
+  if (len > 0)  /* i.e. not circular */
+    {
+      body_t result;
+      s7_pointer p, lst, cleared_args;
+
+      clear_symbol_list(sc);
+      for (p = args; is_pair(p); p = cdr(p))
+	add_symbol_to_list(sc, (is_symbol(car(p))) ? car(p) : caar(p));
+      if (!is_null(p))
+	add_symbol_to_list(sc, p);
+      sc->got_tc = false;
+      sc->not_tc = false;
+      sc->got_rec = false;
+      sc->rec_tc_args = -1;
+      result = ((is_symbol(func)) && (symbol_is_in_list(sc, func))) ? UNSAFE_BODY : body_is_safe(sc, func, body, true);  /* (define (f f)...) */
+      clear_symbol_list(sc);
+
+      /* if the body is safe, we can optimize the calling sequence */
+      if (!unstarred_lambda)
+	{
+	  bool happy = true;
+	  /* check default vals -- if none is an expression or symbol, set simple args */
+	  for (p = args; is_pair(p); p = cdr(p))
+	    {
+	      s7_pointer arg = car(p);
+	      if ((is_pair(arg)) &&                   /* has default value */
+		  (is_pair(cdr(arg))) &&              /*   is not a ridiculous improper list */
+		  ((is_symbol(cadr(arg))) ||          /*   if default value might involve eval in any way, it isn't simple */
+		   (is_unquoted_pair(cadr(arg)))))    /*   pair as default only ok if it is (quote ...) */
+		{
+		  happy = false;
+		  if ((result > UNSAFE_BODY) &&
+		      (tree_has_definers_or_binders(sc, cadr(arg)))) /* if the default has a definer, body is not safe (funclet is not stable) */
+		    result = UNSAFE_BODY;
+		  break;
+		}}
+	  if (happy)
+	    lambda_set_simple_defaults(body);
+	}
+      if (result >= SAFE_BODY) /* not RECUR_BODY here (need new let for cons-r in s7test) */
+	{
+	  set_safe_closure_body(body);
+	  if (result == VERY_SAFE_BODY)
+	    set_very_safe_closure_body(body);
+	}
+      if (is_symbol(func))
+	{
+	  lst = list_1(sc, add_symbol_to_list(sc, func));
+	  sc->temp1 = lst;
+	}
+      else lst = sc->nil;
+
+      if (optimize(sc, body, 1, cleared_args = collect_parameters(sc, args, lst)) == OPT_OOPS)
+	clear_all_optimizations(sc, body);
+      else
+	if (result >= RECUR_BODY)
+	  {
+	    int32_t nvars;
+	    mark_fx_treeable(sc, body);
+
+	    for (nvars = 0, p = args; (is_pair(p)) && (!is_symbol_and_keyword(car(p))); nvars++, p = cdr(p));
+	    if ((is_null(p)) &&
+		(nvars > 0))
+	      {
+		fx_annotate_args(sc, body, cleared_args); /* almost useless -- we need a recursive traversal here but that collides with check_if et al */
+		fx_tree(sc, body, /* this usually costs more than it saves! */
+			(is_pair(car(args))) ? caar(args) : car(args),
+			(nvars > 1) ? ((is_pair(cadr(args))) ? caadr(args) : cadr(args)) : NULL,
+			(nvars > 2) ? ((is_pair(caddr(args))) ? caaddr(args) : caddr(args)) : NULL,
+			nvars > 3);
+	      }
+	    if (((unstarred_lambda) || ((is_null(p)) && (nvars == sc->rec_tc_args))) &&
+		(is_null(cdr(body))))
+	      { /* (if <a> #t|#f...) happens only rarely */
+		if (sc->got_tc)
+		  {
+		    if (check_tc(sc, func, nvars, args, car(body)))
+		      set_safe_closure_body(body);	      /* (very_)safe_closure set above if > RECUR_BODY */
+		    /* if not check_tc, car(body) is either not a tc op or it is not optimized so that is_fxable will return false */
+		  }
+		if ((sc->got_rec) &&
+		    (!is_tc_op(optimize_op(car(body)))) &&
+		    (check_recur(sc, func, nvars, args, car(body))))
+		  set_safe_closure_body(body);
+	      }}
+      if (is_symbol(func))
+	{
+	  sc->temp1 = sc->unused;
+	  free_cell(sc, lst);
+	}
+      sc->got_tc = false;
+      sc->not_tc = false;
+      sc->got_rec = false;
+    }
+}
+
+static int32_t check_lambda(s7_scheme *sc, s7_pointer form, bool opt)
+{
+  /* code is a lambda form: (lambda (a b) (+ a b)) */
+  /* this includes unevaluated symbols (direct symbol table refs) in macro arg list */
+  s7_pointer code, body;
+  int32_t arity = 0;
+
+  if ((sc->safety > NO_SAFETY) &&
+      (tree_is_cyclic(sc, form)))
+    error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "lambda: body is cyclic: ~S", 26), form));
+
+  code = cdr(form);
+  if (!is_pair(code))                                 /* (lambda) or (lambda . 1) */
+    syntax_error_nr(sc, "lambda: no arguments? ~A", 24, form);
+
+  body = cdr(code);
+  if (!is_pair(body))                                 /* (lambda #f) */
+    syntax_error_nr(sc, "lambda: no body? ~A", 19, form);
+
+  /* in many cases, this is a no-op -- we already checked at define */
+  check_lambda_args(sc, car(code), &arity, sc->code);
+  /* clear_symbol_list(sc); */ /* not used in check_lambda_args and clobbers optimize_expression find_uncomplicated_symbol check */
+
+  /* look for (define f (let (...) (lambda ...))) and treat as equivalent to (define (f ...)...)
+   *   one problem the hop=0 fixes is that safe closures assume the old let exists, so we need to check for define below
+   *   I wonder about apply define...
+   */
+  /* OP_LET1 should work here also, (let ((f (lambda...)))), but subsequent calls assume a saved let if safe
+   *   to mimic define, we need to parallel op_define_with_setter + make_funclet, I think
+   */
+  if ((opt) ||
+      (stack_top_op(sc) == OP_DEFINE1) ||
+      (((sc->stack_end - sc->stack_start) > 4) &&
+       (stack_top4_op(sc) == OP_DEFINE1) &&  /* surely if define is ok, so is define dilambda? 16-Apr-16 */
+       (sc->op_stack_now > sc->op_stack) &&
+       ((*(sc->op_stack_now - 1)) == (s7_pointer)global_value(sc->dilambda_symbol))))
+    optimize_lambda(sc, true, sc->unused, car(code), body);
+  else
+    if (optimize(sc, body, 0,
+		 /* ((sc->op_stack_now > sc->op_stack) && (is_c_function((*(sc->op_stack_now - 1)))) && (is_scope_safe((*(sc->op_stack_now - 1))))) ? 1 : 0, */
+		 /* this works except when someone resets outlet(curlet) after defining a local function! */
+		 collect_parameters(sc, car(code), sc->nil)) == OPT_OOPS)
+      clear_all_optimizations(sc, body);
+  pair_set_syntax_op(form, OP_LAMBDA_UNCHECKED);
+  if (arity < -1) arity++; /* confusing! at least 0 = (), but (lambda arg...) has same "arity" here as (lambda (a . b)...)? */
+  set_opt3_any(code, (s7_pointer)((intptr_t)arity));
+  return(arity);
+}
+
+static s7_pointer op_lambda(s7_scheme *sc, s7_pointer code)
+{
+  int32_t arity = check_lambda(sc, code, false);
+  code = cdr(code);
+  set_opt3_any(code, (s7_pointer)((intptr_t)arity));
+  return(make_closure(sc, car(code), cdr(code), T_CLOSURE | ((arity < 0) ? T_COPY_ARGS : 0), arity));
+}
+
+static inline s7_pointer op_lambda_unchecked(s7_scheme *sc, s7_pointer code)
+{
+  int32_t arity = (int32_t)((intptr_t)opt3_any(cdr(code)));
+  return(make_closure_gc_checked(sc, cadr(code), cddr(code), T_CLOSURE | ((arity < 0) ? T_COPY_ARGS : 0), arity));
+}
+
+static void check_lambda_star(s7_scheme *sc)
+{
+  s7_pointer code = cdr(sc->code);
+  if ((sc->safety > NO_SAFETY) &&
+      (tree_is_cyclic(sc, sc->code)))
+    error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "lambda*: body is cyclic: ~S", 27), sc->code));
+
+  if ((!is_pair(code)) ||
+      (!is_pair(cdr(code))))                                          /* (lambda*) or (lambda* #f) */
+    syntax_error_nr(sc, "lambda*: no arguments or no body? ~A", 36, sc->code);
+
+  set_car(code, check_lambda_star_args(sc, car(code), NULL, sc->code));
+  if ((sc->safety > NO_SAFETY) ||
+      (stack_top_op(sc) != OP_DEFINE1))
+    {
+      if (optimize(sc, cdr(code), 0, collect_parameters(sc, car(code), sc->nil)) == OPT_OOPS)
+	clear_all_optimizations(sc, cdr(code));
+    }
+  else optimize_lambda(sc, false, sc->unused, car(code), cdr(code));
+
+  pair_set_syntax_op(sc->code, OP_LAMBDA_STAR_UNCHECKED);
+  sc->code = code;
+}
+
+
+/* -------------------------------- case -------------------------------- */
+static inline bool is_undefined_feed_to(s7_scheme *sc, const s7_pointer sym)
+{
+  return((sym == sc->feed_to_symbol) &&
+	 ((symbol_ctr(sc->feed_to_symbol) == 0) || (s7_symbol_value(sc, sc->feed_to_symbol) == sc->undefined)));
+}
+
+static bool is_all_fxable(s7_scheme *sc, s7_pointer x)
+{
+  for (s7_pointer p = x; is_pair(p); p = cdr(p))
+    if (!is_fxable(sc, car(p)))
+      return(false);
+  return(true);
+}
+
+static s7_pointer check_case(s7_scheme *sc)
+{
+  /* we're not checking repeated or ridiculous (non-eqv?) keys here because they aren't errors */
+  bool keys_simple = true, has_feed_to = false, keys_single = true, bodies_simple = true, has_else = false, use_fx = true;
+  int32_t key_type = T_FREE;
+  s7_pointer x, carc, code = cdr(sc->code), form = sc->code;
+
+  if (!is_pair(code))                                            /* (case) or (case . 1) */
+    syntax_error_nr(sc, "case has no selector:  ~S", 25, form);
+  if (!is_pair(cdr(code)))                                       /* (case 1) or (case 1 . 1) */
+    syntax_error_nr(sc, "case has no clauses?:  ~S", 25, form);
+  if (!is_pair(cadr(code)))                                      /* (case 1 1) */
+    syntax_error_nr(sc, "case clause is not a pair? ~S", 29, form);
+  set_opt3_any(code, sc->unspecified);
+
+  for (x = cdr(code); is_pair(x); x = cdr(x))
+    {
+      s7_pointer y, car_x;
+      if (!is_pair(car(x)))
+	error_nr(sc, sc->syntax_error_symbol,
+		 set_elist_3(sc, wrap_string(sc, "case clause ~S messed up in ~A", sc->print_length),
+			     x, object_to_string_truncated(sc, form)));
+      car_x = car(x);
+
+      if (!is_list(cdr(car_x)))                                      /* (case 1 ((1))) */
+	error_nr(sc, sc->syntax_error_symbol,
+		 set_elist_3(sc, wrap_string(sc, "case clause result ~S is messed up in ~A", sc->print_length),
+			     car_x, object_to_string_truncated(sc, form)));
+      if ((bodies_simple) &&
+	  ((is_null(cdr(car_x))) || (!is_null(cddr(car_x)))))
+	bodies_simple = false;
+
+      use_fx = ((use_fx) && (is_pair(cdr(car_x))) && (is_all_fxable(sc, cdr(car_x))));
+      y = car(car_x);
+      if (!is_pair(y))
+	{
+	  if ((y != sc->else_symbol) &&                              /* (case 1 (2 1)) */
+	      ((!is_symbol(y)) ||
+	       (s7_symbol_value(sc, y) != sc->else_symbol)))         /* "proper list" below because: (case 1 (() 2) ... */
+	    error_nr(sc, sc->syntax_error_symbol,
+		     set_elist_4(sc, wrap_string(sc, "case clause key-list ~S in ~S is not a proper list or 'else', in ~A", 67),
+				 y, car_x, object_to_string_truncated(sc, form)));
+	  has_else = true;
+	  if (is_not_null(cdr(x)))                                  /* (case 1 (else 1) ((2) 1)) */
+	    syntax_error_nr(sc, "case 'else' clause is not the last clause: ~S", 45, x);
+	  if (!is_null(cdr(car_x)))                                  /* else (else) so return selector */
+	    {
+	      if (is_pair(cddr(car_x)))
+		{
+		  set_opt3_any(code, cdr(car_x));
+		  bodies_simple = false;
+		}
+	      else
+		{
+		  set_opt3_any(code, ((bodies_simple) && (keys_single)) ? cadr(car_x) : cdr(car_x));
+		  set_opt1_clause(x, cadr(car_x));
+		}}}
+      else
+	{
+	  if (!is_simple(car(y))) keys_simple = false;
+	  if (!is_null(cdr(y)))   keys_single = false;
+	  if (key_type == T_FREE)
+	    key_type = type(car(y));
+	  else
+	    if (key_type != type(car(y)))
+	      key_type = NUM_TYPES;
+	  if (key_type == T_SYMBOL) set_case_key(car(y));
+
+	  for (y = cdr(y); is_pair(y); y = cdr(y))
+	    {
+	      if (!is_simple(car(y)))
+		keys_simple = false;
+	      if (key_type != type(car(y)))
+		key_type = NUM_TYPES;
+	      if (key_type == T_SYMBOL) set_case_key(car(y));
+	    }
+	  if (!is_null(y))                                        /* (case () ((1 . 2) . hi) . hi) */
+	    error_nr(sc, sc->syntax_error_symbol,
+		     set_elist_3(sc, wrap_string(sc, "case key list ~S is improper, in ~A", 35),
+				 car_x, object_to_string_truncated(sc, form)));
+	}
+      y = car_x;
+      if (!s7_is_proper_list(sc, cdr(y)))                         /* (case 2 ((1 2) 1 . 2)) */
+	error_nr(sc, sc->syntax_error_symbol,
+		 set_elist_3(sc, wrap_string(sc, "case: stray dot? ~S in ~A", 25),
+			     y, object_to_string_truncated(sc, form)));
+      if ((is_pair(cdr(y))) && (is_undefined_feed_to(sc, cadr(y))))
+	{
+	  has_feed_to = true;
+	  if (!is_pair(cddr(y)))                                  /* (case 1 (else =>)) */
+	    error_nr(sc, sc->syntax_error_symbol,
+		     set_elist_3(sc, wrap_string(sc, "case: '=>' target missing: ~S in ~A", 35),
+				 y, object_to_string_truncated(sc, form)));
+	  if (is_pair(cdddr(y)))                                  /* (case 1 (else => + - *)) */
+	    error_nr(sc, sc->syntax_error_symbol,
+		     set_elist_3(sc, wrap_string(sc, "case: '=>' has too many targets: ~S in ~A", 41),
+				 y, object_to_string_truncated(sc, form)));
+	}}
+  if (is_not_null(x))                                             /* (case x ((1 2)) . 1) */
+    syntax_error_nr(sc, "case: stray dot? ~S", 19, form);
+
+  if ((keys_single) &&
+      (bodies_simple))
+    {
+      for (x = cdr(code); is_not_null(x); x = cdr(x))
+	{
+	  set_opt2_any(x, caar(x));
+	  if (is_pair(opt2_any(x)))
+	    {
+	      set_opt2_any(x, car(opt2_any(x)));
+	      if (is_pair(cdar(x)))
+		set_opt1_clause(x, cadar(x));
+	    }}}
+  else
+    for (x = cdr(code); is_not_null(x); x = cdr(x))
+      {
+	set_opt2_any(x, caar(x));
+	if ((is_pair(opt2_any(x))) &&
+	    (is_pair(cdar(x))))
+	  set_opt1_clause(x, cadar(x));
+      }
+  if (key_type == T_INTEGER)
+    set_has_integer_keys(form);
+
+  /* X_Y_Z: X (selector): S=symbol, A=fxable, P=any, Y: E(keys simple) G(any keys) I(integer keys) , Z: S: no =>, bodies simple, keys single G: all else, -- ?? */
+  pair_set_syntax_op(form, OP_CASE_P_G_G); /* fallback on this */
+  if ((has_feed_to) ||
+      (!bodies_simple) ||  /* x_x_g g=general keys or bodies */
+      (!keys_single))
+    {
+      if (!keys_simple)  /* x_g_g */
+	{
+	  if (is_fxable(sc, car(code)))
+	    {
+	      pair_set_syntax_op(form, OP_CASE_A_G_G);
+	      set_fx_direct(code, fx_choose(sc, code, sc->curlet, let_symbol_is_safe));
+	      if ((is_fx_treeable(cdr(code))) && (tis_slot(let_slots(sc->curlet)))) fx_curlet_tree_in(sc, code);
+	    }
+	  else pair_set_syntax_op(form, OP_CASE_P_G_G);
+	}
+      else             /* x_e_g */
+	{
+	  if (!has_else) set_opt3_any(code, sc->unused); /* affects all that goto CASE_E_G */
+	  if (is_fxable(sc, car(code)))
+	    {
+	      pair_set_syntax_op(form, (key_type == T_SYMBOL) ? OP_CASE_A_S_G : OP_CASE_A_E_G);
+	      set_fx_direct(code, fx_choose(sc, code, sc->curlet, let_symbol_is_safe));
+	      if ((is_fx_treeable(cdr(code))) && (tis_slot(let_slots(sc->curlet)))) fx_curlet_tree_in(sc, code);
+	    }
+	  else pair_set_syntax_op(form, OP_CASE_P_E_G);
+	}}
+  else                 /* x_x_s */
+    if (!keys_simple)  /* x_g|i_s */
+      {
+	if (is_fxable(sc, car(code)))
+	  {
+	    pair_set_syntax_op(form, ((!WITH_GMP) && (key_type == T_INTEGER)) ? OP_CASE_A_I_S : OP_CASE_A_G_S);
+	    set_fx_direct(code, fx_choose(sc, code, sc->curlet, let_symbol_is_safe));
+	    if ((is_fx_treeable(cdr(code))) && (tis_slot(let_slots(sc->curlet)))) fx_curlet_tree_in(sc, code);
+	  }
+	else pair_set_syntax_op(form, ((!WITH_GMP) && (key_type == T_INTEGER)) ? OP_CASE_P_I_S : OP_CASE_P_G_S);
+      }
+    else              /* x_e_s */
+      if (is_fxable(sc, car(code)))
+	{
+	  pair_set_syntax_op(form, OP_CASE_A_E_S);
+	  set_fx_direct(code, fx_choose(sc, code, sc->curlet, let_symbol_is_safe));
+	  if ((is_fx_treeable(cdr(code))) && (tis_slot(let_slots(sc->curlet)))) fx_curlet_tree_in(sc, code);
+	}
+      else pair_set_syntax_op(form, OP_CASE_P_E_S);
+
+  if ((use_fx) && (has_else) && (!has_feed_to))
+    {
+      opcode_t op = optimize_op(form);
+      if ((op == OP_CASE_A_E_S) || (op == OP_CASE_A_G_S) || (op == OP_CASE_A_S_G) || ((!WITH_GMP) && (op == OP_CASE_A_I_S)))
+	{
+	  pair_set_syntax_op(form,
+			     (op == OP_CASE_A_I_S) ? OP_CASE_A_I_S_A :
+			       ((op == OP_CASE_A_E_S) ? OP_CASE_A_E_S_A :
+				 ((op == OP_CASE_A_S_G) ? OP_CASE_A_S_G_A : OP_CASE_A_G_S_A)));
+	  for (x = cdr(code); is_pair(x); x = cdr(x))
+	    {
+	      s7_pointer clause = cdar(x);
+	      fx_annotate_args(sc, clause, sc->curlet);
+	      if ((is_fx_treeable(cdr(code))) && (tis_slot(let_slots(sc->curlet)))) fx_curlet_tree(sc, clause);
+	      if (is_null(cdr(x))) set_opt3_any(code, clause);
+	    }}}
+  carc = cadr(form);
+  if (!is_pair(carc))
+    {
+      sc->value = (is_symbol(carc)) ? lookup_checked(sc, carc) : carc;
+      return(NULL);
+    }
+  push_stack_no_args_direct(sc, OP_CASE_G_G);
+  sc->code = carc;
+  return(carc);
+}
+
+#if (!WITH_GMP)
+static bool op_case_i_s(s7_scheme *sc)
+{
+  s7_pointer selector  = sc->value;
+  s7_pointer else_clause = opt3_any(cdr(sc->code));
+  if (else_clause != sc->unspecified)
+    {
+      if (is_t_integer(selector))
+	{
+	  s7_int val = integer(selector);
+	  for (s7_pointer x = cddr(sc->code); is_pair(cdr(x)); x = cdr(x))
+	    if (integer(opt2_any(x)) == val)
+	      {
+		sc->code = opt1_clause(x);
+		return(false);
+	      }}
+      sc->code = else_clause;
+      return(false);
+    }
+  if (is_t_integer(selector))
+    {
+      s7_int val = integer(selector);
+      for (s7_pointer x = cddr(sc->code); is_pair(x); x = cdr(x))
+	if (integer(opt2_any(x)) == val)
+	  {
+	    sc->code = opt1_clause(x);
+	    return(false);
+	  }}
+  sc->value = sc->unspecified;
+  return(true);
+}
+
+static inline s7_pointer fx_case_a_i_s_a(s7_scheme *sc, s7_pointer code) /* inline saves about 30 in tleft */
+{
+  s7_pointer selector = fx_call(sc, cdr(code));
+  if (is_t_integer(selector))
+    {
+      s7_int val = integer(selector);
+      for (s7_pointer x = cddr(sc->code); is_pair(cdr(x)); x = cdr(x))
+	if (integer(opt2_any(x)) == val)
+	  return(fx_call(sc, cdar(x)));
+    }
+  return(fx_call(sc, opt3_any(cdr(code))));
+}
+#endif
+
+static bool op_case_e_g_1(s7_scheme *sc, const s7_pointer selector, bool ok)
+{
+  s7_pointer x;
+  if (ok)
+    {
+      for (x = cddr(sc->code); is_pair(x); x = cdr(x))
+	{
+	  s7_pointer y = opt2_any(x);
+	  if (!is_pair(y)) /* i.e. else? */
+	    goto ELSE_CASE_1;
+	  do {
+	    if (car(y) == selector)
+	      goto ELSE_CASE_1;
+	    y = cdr(y);
+	  } while (is_pair(y));
+	}
+      sc->value = sc->unspecified;
+      pop_stack(sc);
+      return(true);
+    }
+
+  sc->code = opt3_any(cdr(sc->code));
+  if (sc->code == sc->unused)    /* set in check_case if no else clause */
+    sc->value = sc->unspecified;
+  else
+    if (is_pair(sc->code))
+      goto ELSE_CASE_2;
+  pop_stack(sc);
+  return(true);
+
+ ELSE_CASE_1:
+  /* x is the entire matching clause, (case 2 ((2) 3)), x: (((2) 3)) */
+  sc->code = T_Lst(cdar(x));
+  if (is_null(sc->code))  /* sc->value is already the selector */
+    {
+      pop_stack(sc);
+      return(true);
+    }
+
+ ELSE_CASE_2:
+  if (is_null(cdr(sc->code)))
+    {
+      sc->code = car(sc->code);
+      sc->cur_op = optimize_op(sc->code);
+      return(true);
+    }
+
+  if (is_undefined_feed_to(sc, car(sc->code)))
+    return(false);
+
+  push_stack_no_args(sc, sc->begin_op, T_Pair(cdr(sc->code)));
+  sc->code = car(sc->code);
+  sc->cur_op = optimize_op(sc->code);
+  return(true);
+}
+
+static inline s7_pointer fx_call_all(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer p;
+  for (p = code; is_pair(cdr(p)); p = cdr(p))
+    fx_call(sc, p);
+  return(fx_call(sc, p));
+}
+
+static s7_pointer fx_case_a_s_g_a(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer selector = fx_call(sc, cdr(code));
+  if (is_case_key(selector))
+    for (s7_pointer x = cddr(sc->code); is_pair(x); x = cdr(x))
+      {
+	s7_pointer y = opt2_any(x);
+	if (!is_pair(y)) /* i.e. else? */
+	  return(fx_call_all(sc, cdar(x))); /* else clause */
+	do {
+	  if (car(y) == selector)
+	    return(fx_call_all(sc, cdar(x)));
+	  y = cdr(y);
+	} while (is_pair(y));
+      }
+  return(fx_call_all(sc, opt3_any(cdr(code)))); /* selector is not a case-key */
+}
+
+#define if_pair_set_up_begin(Sc) if (is_pair(cdr(Sc->code))) {check_stack_size(Sc); push_stack_no_args(Sc, Sc->begin_op, cdr(Sc->code));} Sc->code = car(Sc->code);
+#define if_pair_set_up_begin_unchecked(Sc) if (is_pair(cdr(Sc->code))) push_stack_no_args(Sc, Sc->begin_op, cdr(Sc->code)); Sc->code = car(Sc->code);
+/* using the one_form bit here was slower */
+
+static bool op_case_g_g(s7_scheme *sc)
+{
+  s7_pointer x;
+  if (has_integer_keys(sc->code))
+    {
+      s7_int selector;
+      sc->code = cddr(sc->code);
+      if (is_t_integer(sc->value))
+	selector = integer(sc->value);
+      else
+	{
+#if WITH_GMP
+	  if ((is_t_big_integer(sc->value)) && (mpz_fits_slong_p(big_integer(sc->value))))
+	    selector = mpz_get_si(big_integer(sc->value));
+	  else
+#endif
+	    {
+	      for (x = sc->code; is_pair(x); x = cdr(x))
+		if (!is_pair(caar(x)))
+		  goto ELSE_CASE;
+	      sc->value = sc->unspecified;
+	      pop_stack(sc);
+	      return(true);
+	    }}
+      for (x = sc->code; is_pair(x); x = cdr(x))
+	{
+	  s7_pointer y = caar(x);
+	  if (!is_pair(y))
+	    goto ELSE_CASE;
+	  for (; is_pair(y); y = cdr(y))
+	    if (integer(car(y)) == selector)
+	      goto ELSE_CASE;
+	}
+      sc->value = sc->unspecified;
+      pop_stack(sc);
+      return(true);
+    }
+  sc->code = cddr(sc->code);
+  if (is_simple(sc->value))
+    {
+      for (x = sc->code; is_pair(x); x = cdr(x))
+	{
+	  s7_pointer y = caar(x);
+	  if (!is_pair(y))
+	    goto ELSE_CASE;
+	  do {
+	    if (car(y) == sc->value)
+	      goto ELSE_CASE;
+	    y = cdr(y);
+	  } while (is_pair(y));
+	}
+      sc->value = sc->unspecified;
+      pop_stack(sc);
+      return(true);
+    }
+  for (x = sc->code; is_pair(x); x = cdr(x))
+    {
+      s7_pointer y = caar(x);
+      if (!is_pair(y))
+	goto ELSE_CASE;
+      for (; is_pair(y); y = cdr(y))
+	if (s7_is_eqv(sc, car(y), sc->value))
+	  goto ELSE_CASE;
+    }
+  sc->value = sc->unspecified; /* this was sc->nil but the spec says case value is unspecified if no clauses match */
+  pop_stack(sc);
+  return(true);
+
+ ELSE_CASE:
+  /* x is the entire matching clause, (case 2 ((2) 3)), x: (((2) 3)) */
+  sc->code = T_Lst(cdar(x));
+  if (is_null(sc->code))  /* sc->value is already the selector */
+    {
+      pop_stack(sc);
+      return(true);
+    }
+  if (is_null(cdr(sc->code)))
+    {
+      sc->code = car(sc->code);
+      sc->cur_op = optimize_op(sc->code);
+      return(true);
+    }
+  if (is_undefined_feed_to(sc, car(sc->code)))
+    return(false);
+  if_pair_set_up_begin_unchecked(sc);
+  sc->cur_op = optimize_op(sc->code);
+  return(true);
+}
+
+static void op_case_e_s(s7_scheme *sc)
+{
+  s7_pointer selector = sc->value;
+  if (is_simple(selector))
+    for (s7_pointer x = cddr(sc->code); is_pair(x); x = cdr(x))
+      if (opt2_any(x) == selector)
+	{
+	  sc->code = opt1_clause(x);
+	  return;
+	}
+  sc->code = opt3_any(cdr(sc->code));
+}
+
+static s7_pointer fx_case_a_e_s_a(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer selector = fx_call(sc, cdr(code));
+  if (is_simple(selector))
+    for (s7_pointer x = cddr(code); is_pair(x); x = cdr(x))
+      if (opt2_any(x) == selector)
+	return(fx_call(sc, cdar(x)));
+  return(fx_call(sc, opt3_any(cdr(code))));
+}
+
+static void op_case_g_s(s7_scheme *sc)
+{
+  s7_pointer selector = sc->value;
+  for (s7_pointer x = cddr(sc->code); is_pair(x); x = cdr(x))
+    if (s7_is_eqv(sc, opt2_any(x), selector))
+      {
+	sc->code = opt1_clause(x);
+	return;
+      }
+  sc->code = opt3_any(cdr(sc->code));
+}
+
+static inline s7_pointer fx_case_a_g_s_a(s7_scheme *sc, s7_pointer code) /* split into int/any cases in g_g, via has_integer_keys(sc->code) */
+{
+  s7_pointer selector = fx_call(sc, cdr(code));
+  for (s7_pointer x = cddr(code); is_pair(x); x = cdr(x))
+    if (s7_is_eqv(sc, opt2_any(x), selector))
+      return(fx_call(sc, cdar(x)));
+  return(fx_call(sc, opt3_any(cdr(code))));
+}
+
+
+/* -------------------------------- let -------------------------------- */
+static void check_let_a_body(s7_scheme *sc, s7_pointer form)
+{
+  s7_pointer code = cdr(form);
+  if (is_fxable(sc, cadr(code)))
+    {
+      fx_annotate_arg(sc, cdr(code), set_plist_1(sc, caaar(code))); /* was sc->curlet) ? */
+      fx_tree(sc, cdr(code), caaar(code), NULL, NULL, false);
+      pair_set_syntax_op(form, OP_LET_A_A_OLD);
+    }
+  else
+    if (is_pair(cadr(code)))
+      {
+	pair_set_syntax_op(form, OP_LET_A_P_OLD);
+	if (is_fx_treeable(cdaar(code))) fx_tree(sc, cdr(code), caaar(code), NULL, NULL, false);
+      }
+}
+
+static void check_let_one_var(s7_scheme *sc, s7_pointer form, s7_pointer start)
+{
+  s7_pointer binding = car(start), code = cdr(form);
+  if (is_pair(cadr(binding)))
+    {
+      /* this is not a named let */
+      pair_set_syntax_op(form, ((is_pair(cdr(code))) && (is_null(cddr(code)))) ? OP_LET_ONE_P_OLD : OP_LET_ONE_OLD);
+      set_opt2_sym(cdr(code), car(binding)); /* these don't collide -- cdr(code) and code */
+      set_opt2_pair(code, cadr(binding));
+      if (is_optimized(cadr(binding)))
+	{
+	  if ((optimize_op(cadr(binding)) == HOP_SAFE_C_SS) &&
+	      (fn_proc(cadr(binding)) == g_assq))
+	    {
+	      set_opt2_sym(code, cadadr(binding));
+	      pair_set_syntax_op(form, OP_LET_opaSSq_OLD);
+	      set_opt3_sym(cdr(code), caddadr(binding));
+	      set_opt1_sym(code, car(binding));
+	    }
+	  else
+	    if (is_fxable(sc, cadr(binding)))
+	      {
+		set_opt2_pair(code, binding);
+		pair_set_syntax_op(form, OP_LET_A_OLD);
+		fx_annotate_arg(sc, cdr(binding), sc->curlet);
+		if (is_null(cddr(code)))
+		  check_let_a_body(sc, form);
+		else
+		  {
+		    s7_pointer p;
+		    for (p = cdr(code); is_pair(p); p = cdr(p))
+		      if (!is_fxable(sc, car(p)))
+			break;
+		    if (is_null(p))
+		      {
+			pair_set_syntax_op(form, OP_LET_A_NA_OLD);
+			fx_annotate_args(sc, cdr(code), set_plist_1(sc, car(binding)));
+			fx_tree(sc, cdr(code), car(binding), NULL, NULL, false);
+			return;
+		      }
+		    if (is_fx_treeable(cdr(code))) fx_tree(sc, cdr(code), car(binding), NULL, NULL, false);
+		  }}}}
+  else
+    {
+      set_opt2_pair(code, binding);
+      pair_set_syntax_op(form, OP_LET_A_OLD);
+      fx_annotate_arg(sc, cdr(binding), sc->curlet);
+      if (is_null(cddr(code)))
+	check_let_a_body(sc, form);
+      else
+	{
+	  fx_annotate_args(sc, cdr(code), set_plist_1(sc, caaar(code))); /* no effect if not syntactic -- how to fix? */
+	  if (is_fx_treeable(cdr(code))) fx_tree(sc, cdr(code), car(binding), NULL, NULL, false);
+	}}
+  if ((optimize_op(form) == OP_LET_A_OLD) &&
+      (is_pair(cddr(code))) && (is_null(cdddr(code))))
+    pair_set_syntax_op(form, OP_LET_A_OLD_2);
+}
+
+static s7_pointer check_named_let(s7_scheme *sc, int32_t vars)
+{
+  s7_pointer code = cdr(sc->code);
+  set_opt2_int(code, vars);
+  if (vars == 0)
+    {
+      pair_set_syntax_op(sc->code, OP_NAMED_LET_NO_VARS);
+      set_opt1_pair(sc->code, cddr(code));
+      optimize_lambda(sc, true, car(code), sc->nil, cddr(code));
+    }
+  else
+    {
+      bool fx_ok = true;
+      pair_set_syntax_op(sc->code, OP_NAMED_LET);
+      /* this is (let name ...) so the initial values need to be removed from the closure arg list */
+
+      sc->args = T_Pair(safe_list_if_possible(sc, vars));
+      for (s7_pointer ex = cadr(code), exp = sc->args; is_pair(ex); ex = cdr(ex), exp = cdr(exp))
+	{
+	  s7_pointer val = cdar(ex);
+	  s7_function fx = fx_choose(sc, val, sc->curlet, let_symbol_is_safe);
+	  if (fx) set_fx_direct(val, fx); else fx_ok = false;
+	  set_car(exp, caar(ex));
+	}
+      if (fx_ok)
+	{
+	  set_opt1_pair(code, caadr(code));
+	  if (vars == 2) set_opt3_pair(code, cadadr(code));
+	  pair_set_syntax_op(sc->code, (vars == 1) ? OP_NAMED_LET_A : ((vars == 2) ? OP_NAMED_LET_AA : OP_NAMED_LET_NA));
+	}
+      optimize_lambda(sc, true, car(code), sc->args, cddr(code)); /* car(code) is the name */
+      if (!in_heap(sc->args)) clear_list_in_use(sc->args);
+      sc->args = sc->nil;
+    }
+  return(code);
+}
+
+static s7_pointer check_let(s7_scheme *sc) /* called only from op_let */
+{
+  s7_pointer x, start, code = cdr(sc->code), form = sc->code;
+  bool named_let;
+  int32_t vars;
+
+  if (!is_pair(code))               /* (let . 1) */
+    {
+      if (is_null(code))            /* (let) */
+	syntax_error_nr(sc, "let has no variables or body: ~A", 32, form);
+      syntax_error_nr(sc, "let form is an improper list? ~A", 32, form);
+    }
+
+  if (!is_pair(cdr(code)))          /* (let () ) or (let () . 1) */
+    syntax_error_nr(sc, "let has no body: ~A", 19, form);
+
+  if ((!is_list(car(code))) &&      /* (let 1 ...) */
+      (!is_normal_symbol(car(code))))
+    syntax_error_nr(sc, "let variable list is messed up or missing: ~A", 45, form);
+
+  named_let = (is_symbol(car(code)));
+  if (named_let)
+    {
+      if (!is_list(cadr(code)))             /* (let hi #t) */
+	syntax_error_nr(sc, "let variable list is messed up: ~A", 34, form);
+      if (!is_pair(cddr(code)))             /* (let hi () . =>) or (let hi () ) */
+	{
+	  if (is_null(cddr(code)))
+	    syntax_error_nr(sc, "named let has no body: ~A", 25 , form);
+	  syntax_error_nr(sc, "named let stray dot? ~A", 23, form);
+	}
+      if (is_constant_symbol(sc, car(code)))
+	error_nr(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, cant_bind_immutable_string, sc->let_symbol, form));
+      set_local(car(code));
+      start = cadr(code);
+    }
+  else start = car(code);
+
+  clear_symbol_list(sc);
+  for (vars = 0, x = start; is_pair(x); vars++, x = cdr(x))
+    {
+      s7_pointer y, carx = car(x);
+
+      if ((!is_pair(carx)) || (is_null(cdr(carx))))  /* (let ((x)) ...) or (let ((x 1) . (y 2)) ...) */
+	error_nr(sc, sc->syntax_error_symbol,
+		 set_elist_3(sc, wrap_string(sc, "let variable declaration, but no value?: ~A in ~A", 49),
+			     x, object_to_string_truncated(sc, form)));
+
+      if (!(is_pair(cdr(carx))))                     /* (let ((x . 1))...) */
+	error_nr(sc, sc->syntax_error_symbol,
+		 set_elist_3(sc, wrap_string(sc, "let variable declaration, ~A, is not a proper list in ~A", 56),
+			     x, object_to_string_truncated(sc, form)));
+
+      if (is_not_null(cddr(carx)))                   /* (let ((x 1 2 3)) ...) */
+	error_nr(sc, sc->syntax_error_symbol,
+		 set_elist_3(sc, wrap_string(sc, "let variable declaration, ~A, has more than one value in ~A", 59),
+			     x, object_to_string_truncated(sc, form)));
+      y = car(carx);
+      if (!(is_symbol(y)))
+	{
+	  if (is_c_function(y))                      /* (let ((#_abs 3)) ...) */
+	    {
+	      s7_pointer sym = c_function_name_to_symbol(sc, y);
+	      if (initial_value(sym) != sc->undefined)
+		error_nr(sc, sc->syntax_error_symbol,
+			 set_elist_2(sc, wrap_string(sc, "variable name #_~S in let is a function, not a symbol", 53), y));
+	    }
+	  error_nr(sc, sc->syntax_error_symbol,
+		   set_elist_4(sc, wrap_string(sc, "bad variable name ~W in let (it is ~A, not a symbol) in ~A", 58),
+			       y, object_type_name(sc, y),
+			       object_to_string_truncated(sc, form)));
+	}
+      if (is_constant_symbol(sc, y))
+	error_nr(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, cant_bind_immutable_string, sc->let_symbol, x));
+
+      /* check for name collisions -- not sure this is required by Scheme */
+      if (symbol_is_in_list(sc, y))
+	error_nr(sc, sc->syntax_error_symbol,
+		 set_elist_3(sc, wrap_string(sc, "duplicate identifier in let: ~S in ~S", 37), y, form));
+      add_symbol_to_list(sc, y);
+      set_local(y);
+    }
+  /* (let ('1) quote) -> 1 */
+
+  if (is_not_null(x))                     /* (let* ((a 1) . b) a) */
+    syntax_error_nr(sc, "let variable list improper?: ~A", 31, form);
+
+  if (!s7_is_proper_list(sc, cdr(code))) /* (let ((a 1)) a . 1) */
+    syntax_error_nr(sc, "stray dot in let body: ~S", 25, cdr(code));
+
+  if (named_let)
+    return(check_named_let(sc, vars));
+
+  if (vars == 0)        /* !in_heap does not happen much here */
+    pair_set_syntax_op(form, OP_LET_NO_VARS);
+  else
+    {
+      pair_set_syntax_op(form, OP_LET_UNCHECKED);
+      if (vars == 1)
+	check_let_one_var(sc, form, start);
+      else
+	{
+	  /* this used to check that vars < gc_trigger_size, but I can't see why */
+	  opcode_t opt = OP_UNOPT;
+	  for (s7_pointer p = start; is_pair(p); p = cdr(p))
+	    {
+	      x = car(p);
+	      if (is_fxable(sc, cadr(x)))
+		{
+		  set_fx_direct(cdr(x), fx_choose(sc, cdr(x), sc->curlet, let_symbol_is_safe));
+		  if (opt == OP_UNOPT)
+		    opt = OP_LET_NA_OLD;
+		}
+	      else opt = OP_LET_UNCHECKED;
+	    }
+	  pair_set_syntax_op(form, opt);
+	  if ((opt == OP_LET_NA_OLD) &&
+	      (is_null(cddr(code))))        /* 1 form in body */
+	    {
+	      if (vars == 2)
+		{
+		  pair_set_syntax_op(form, OP_LET_2A_OLD);
+		  set_opt1_pair(code, caar(code));
+		  set_opt2_pair(code, cadar(code));
+		}
+	      else
+		if (vars == 3)
+		  {
+		    pair_set_syntax_op(form, OP_LET_3A_OLD);
+		    set_opt1_pair(code, cadar(code));
+		    set_opt2_pair(code, caddar(code));
+		  }}}}
+
+  /* if safe_c or safe_closure as car(body), null cdr(body), see if only vars as args
+   *   symbol_list is intact??
+   */
+  if (optimize_op(form) >= OP_LET_NA_OLD)
+    {
+      if ((!in_heap(form)) &&
+	  (body_is_safe(sc, sc->unused, cdr(code), true) >= SAFE_BODY)) /* recur_body is apparently never hit */
+	set_opt3_let(code, make_semipermanent_let(sc, car(code)));
+      else
+	{
+	  set_optimize_op(form, optimize_op(form) + 1); /* *_old -> *_new */
+	  set_opt3_let(code, sc->rootlet);
+	}}
+
+  /* fx_tree inits */
+  if ((is_pair(code)) &&
+      /* (is_let(sc->curlet)) && */  /* not rootlet=() but treeable is only in functions */
+      (is_fx_treeable(code)) &&      /* was is_funclet(sc->curlet) 27-Sep-21, but that seems too restrictive */
+      (tis_slot(let_slots(sc->curlet))))
+    {
+      s7_pointer s1 = let_slots(sc->curlet), s2 = next_slot(s1), s3 = NULL;
+      bool more_vars = false;
+      if (tis_slot(s2))
+	{
+	  if (tis_slot(next_slot(s2)))
+	    {
+	      s3 = next_slot(s2);
+	      more_vars = tis_slot(next_slot(s3));
+	      s3 = slot_symbol(s3);
+	    }
+	  s2 = slot_symbol(s2);
+	}
+      s1 = slot_symbol(s1);
+      for (s7_pointer p = car(code); is_pair(p); p = cdr(p)) /* var list */
+	{
+	  s7_pointer init = cdar(p);
+	  fx_tree(sc, init, s1, s2, s3, more_vars);
+	}}
+  return(code);
+}
+
+static void op_named_let_1(s7_scheme *sc, s7_pointer args) /* args = vals in decl order */
+{ /* sc->code = (name vars . body), args = vals in decl order */
+  s7_pointer body = cddr(sc->code), x;
+  s7_int n = opt2_int(sc->code); /* num pars, see check_named_let called in check_let */
+  for (x = cadr(sc->code), sc->w = sc->nil; is_pair(x); x = cdr(x))
+    {
+      sc->w = cons(sc, caar(x), sc->w);
+      x = cdr(x);
+      if (!is_pair(x)) break;
+      sc->w = cons_unchecked(sc, caar(x), sc->w);
+    }
+  sc->w = proper_list_reverse_in_place(sc, sc->w); /* needed for closure_args */
+  set_curlet(sc, make_let(sc, sc->curlet));
+  sc->x = make_closure_unchecked(sc, sc->w, body, T_CLOSURE, n); /* n = num pars */
+  add_slot(sc, sc->curlet, car(sc->code), sc->x);
+  set_curlet(sc, make_let(sc, sc->curlet)); /* inner let */
+  for (x = sc->w; is_not_null(args); x = cdr(x), args = cdr(args))
+    add_slot_unchecked_with_id(sc, sc->curlet, car(x), unchecked_car(args));
+  closure_set_let(sc->x, sc->curlet);
+  let_set_slots(sc->curlet, reverse_slots(let_slots(sc->curlet)));
+  sc->x = sc->unused;
+  sc->code = T_Pair(body);
+  sc->w = sc->unused;
+}
+
+static bool op_let_1(s7_scheme *sc)
+{ /* op_let form: (let ((i 0) (j 1)) (+ i j)), code: ((i 0) (j 1)), value: (((i 0) (j 1)) (+ i j)), args: ()
+   * op_named_let: (let loop ((i 0)) (if (< i 3) (loop (+ i 1)) i)), code: ((i 0)), value: (loop ((i 0)) (if (< i 3) (loop (+ i 1)) i)), args: ()
+   * eval->op_let_unchecked: (let ((i (catch #t (lambda () 1) (lambda (t i) 'error))) (j 2)) (+ i j))) (in a function),
+   *    code: ((j 2)), value: 1, args: ((((i (catch #t (lambda () 1) (lambda (t i) 'error))) (j 2)) (+ i j)))
+   */
+  /* true -> BEGIN, false -> EVAL */
+  s7_pointer y;
+  int64_t id;
+  while (true)
+    {
+      /* slot list, need current symbol, p=slot(code, value), slot_end=sc->args, sc->args=p, then let add reversing at end */
+      sc->args = cons(sc, sc->value, sc->args);
+      if (is_pair(sc->code))
+	{
+	  s7_pointer x = cdar(sc->code);
+	  if (has_fx(x))
+	    sc->value = fx_call(sc, x);
+	  else
+	    {
+	      check_stack_size(sc);
+	      push_stack(sc, OP_LET1, sc->args, cdr(sc->code));
+	      sc->code = car(x);
+	      return(false); /* goto EVAL */
+	    }
+	  sc->code = cdr(sc->code);
+	}
+      else break;
+    }
+
+  sc->args = proper_list_reverse_in_place(sc, sc->args);
+  sc->code = car(sc->args); /* restore the original form */
+  y = cdr(sc->args);
+  sc->temp8 = y;
+  free_cell(sc, sc->args);
+  set_curlet(sc, make_let(sc, T_Let(sc->curlet)));
+  if (is_symbol(car(sc->code)))
+    {
+      op_named_let_1(sc, y); /* inner let here, y = var list?? */
+      return(true);
+    }
+  id = let_id(sc->curlet);
+  if (is_pair(y))
+    {
+      s7_pointer args = cdr(y), last_slot, x = car(sc->code);
+      last_slot = add_slot_unchecked_with_id(sc, sc->curlet, caar(x), unchecked_car(y));
+      for (x = cdr(x), y = args; is_not_null(y); x = cdr(x), y = cdr(y))
+	last_slot = inline_add_slot_at_end(sc, id, last_slot, caar(x), unchecked_car(y));
+    }
+  sc->code = T_Pair(cdr(sc->code));
+  sc->temp8 = sc->unused;
+  return(true); /* goto BEGIN */
+}
+
+static bool op_let(s7_scheme *sc)
+{
+  /* sc->code is everything after the let: (let ((a 1)) a) so sc->code is (((a 1)) a) */
+  /*   car can be either a list or a symbol ("named let") */
+  bool named_let;
+
+  sc->code = check_let(sc);
+  sc->value = sc->code;
+  named_let = is_symbol(car(sc->code));
+  sc->code = (named_let) ? cadr(sc->code) : car(sc->code);
+  if (is_null(sc->code))                    /* (let [name] () ...):  no bindings, so skip that step */
+    {
+      sc->code = sc->value;
+      set_curlet(sc, make_let(sc, sc->curlet));
+      if (named_let)  /* see also below -- there are 3 cases */
+	{
+	  s7_pointer body = cddr(sc->code);
+	  set_opt2_int(cdr(sc->code), 0);
+	  sc->x = make_closure_unchecked(sc, sc->nil, body, T_CLOSURE, 0);
+	  /* args = () in new closure, see NAMED_LET_NO_VARS above */
+	  /* if this is a safe closure, we can build its let in advance and name it (a thunk in this case) */
+	  set_funclet(closure_let(sc->x));
+	  funclet_set_function(closure_let(sc->x), car(sc->code));
+	  add_slot_checked(sc, sc->curlet, car(sc->code), sc->x);
+	  set_curlet(sc, make_let(sc, sc->curlet)); /* inner let */
+	  sc->code = T_Pair(body);
+	  sc->x = sc->unused;
+	}
+      else sc->code = T_Pair(cdr(sc->code));
+      return(true); /* goto BEGIN */
+    }
+  sc->args = sc->nil;
+  /* value: (((i 0)) (+ i 1)), code: ((i 0)) */
+  return(op_let_1(sc)); /* sc->code == vars */
+}
+
+static bool op_let_unchecked(s7_scheme *sc)     /* not named, but has vars, called from eval if looping via op_let->op_let_1 + unopt'd args */
+{
+  s7_pointer code = cadr(sc->code);
+  s7_pointer x = cdar(code);  /* next arg */
+  /* value: 0, code: ((radix (+ 2 (random 15)))) from (do ((i 0 (+ i 1))) ((= i 2)) (let ((j 0) (radix (+ 2 (random 15)))) (+ j radix))) on second iteration (i == 1) */
+  sc->args = list_1(sc, cdr(sc->code)); /* as if sc->value were this, then absorbed into sc->args */
+  if (has_fx(x))
+    sc->value = fx_call(sc, x);
+  else
+    {
+      push_stack(sc, OP_LET1, sc->args, cdr(code));
+      sc->code = car(x);
+      return(false); /* goto EVAL */
+    }
+  sc->code = cdr(code);
+  return(op_let_1(sc));
+}
+
+static bool op_named_let(s7_scheme *sc)
+{ /* from eval */
+  sc->args = sc->nil;
+  sc->value = cdr(sc->code);
+  sc->code = cadr(sc->value);
+  return(op_let_1(sc));
+}
+
+static void op_named_let_no_vars(s7_scheme *sc)
+{                                                     /* sc->code is full form (let name () ...) */
+  s7_pointer name = cadr(sc->code);
+  sc->code = opt1_pair(sc->code);                     /* cdddr(sc->code) == body */
+  set_curlet(sc, inline_make_let(sc, sc->curlet));
+  sc->args = make_closure_unchecked(sc, sc->nil, sc->code, T_CLOSURE, 0);
+  add_slot_checked(sc, sc->curlet, name, sc->args);   /* sc->args is a temp here */
+  set_curlet(sc, make_let(sc, sc->curlet));           /* inner let */
+  /* goto BEGIN */
+}
+
+static void op_named_let_a(s7_scheme *sc)
+{                                                     /* sc->code is the full form (let name vars...), par pointers are preset in opt1|3(cdr(sc->code)) */
+  s7_pointer data = cdr(sc->code);
+  s7_pointer par1 = opt1_pair(data);                  /* cdaadr(args) == first par */
+  sc->code = cddr(data);                              /* (vars ...) */
+  sc->args = fx_call(sc, cdr(par1));
+  set_curlet(sc, make_let(sc, sc->curlet));           /* funclet(?) */
+  sc->w = list_1_unchecked(sc, car(par1));            /* (list sym1), subsequent calls will need a normal list of pars in closure_args */
+  sc->x = make_closure_unchecked(sc, sc->w, sc->code, T_CLOSURE, 1); /* picks up curlet (this is the funclet?) */
+  add_slot(sc, sc->curlet, car(data), sc->x);         /* car(data) == the function name */
+  set_curlet(sc, inline_make_let_with_slot(sc, sc->curlet, car(sc->w), sc->args)); /* inner let */
+  closure_set_let(sc->x, sc->curlet);
+  sc->x = sc->unused;
+  sc->w = sc->unused;
+  /* goto BEGIN */
+}
+
+static void op_named_let_aa(s7_scheme *sc)
+{                                                       /* sc->code is the full form (let name vars...), par pointers are preset in opt1|3(cdr(sc->code)) */
+  s7_pointer data = cdr(sc->code);
+  s7_pointer par1 = opt1_pair(data);                    /* cdaadr(data) == first par */
+  s7_pointer par2 = opt3_pair(data);                    /* cdadadr == second */
+  sc->code = cddr(data);                                /* (vars ...) */
+  sc->args = fx_call(sc, cdr(par1));
+  sc->value = fx_call(sc, cdr(par2));
+  set_curlet(sc, make_let(sc, sc->curlet));             /* funclet below I think */
+  sc->w = list_2_unchecked(sc, car(par1), car(par2));   /* (list sym1 sym2): subsequent calls will need a normal list of pars in closure_args */
+  sc->x = make_closure_unchecked(sc, sc->w, sc->code, T_CLOSURE, 2); /* picks up curlet (this is the funclet?) */
+  add_slot(sc, sc->curlet, car(data), sc->x);           /* car(data) == the function name */
+  set_curlet(sc, inline_make_let_with_two_slots(sc, sc->curlet, car(sc->w), sc->args, cadr(sc->w), sc->value)); /* inner let */
+  closure_set_let(sc->x, sc->curlet);
+  sc->x = sc->unused;
+  sc->w = sc->unused;
+  /* goto BEGIN */
+}
+
+static void op_named_let_na(s7_scheme *sc)
+{
+  sc->code = cdr(sc->code);
+  sc->args = sc->nil;
+  for (s7_pointer p = cadr(sc->code); is_pair(p); p = cdr(p))
+    {
+      sc->args = cons(sc, sc->value = fx_call(sc, cdar(p)), sc->args);
+      p = cdr(p);
+      if (!is_pair(p)) break;
+      sc->args = cons_unchecked(sc, sc->value = fx_call(sc, cdar(p)), sc->args);
+    }
+  sc->args = proper_list_reverse_in_place(sc, sc->args);
+  op_named_let_1(sc, sc->args); /* sc->code = (name vars . body), args = vals in decl order, op_named_let_1 handles inner let */
+  /* goto BEGIN */
+}
+
+static void op_let_no_vars(s7_scheme *sc)
+{
+  set_curlet(sc, inline_make_let(sc, sc->curlet));
+  sc->code = T_Pair(cddr(sc->code));         /* ignore the () */
+}
+
+static void op_let_one_new(s7_scheme *sc)
+{
+  sc->code = cdr(sc->code);
+  /* check_stack_size(sc) -- needed if we're in an infinite loop -- maybe let it trigger "stack too big" instead */
+  /*   e.g. (let ((set! let*)) (let* set! ((x 1234) (y 1/2)) (let ((<1> (list 1 #f))) (set! (<1> 1) ...)))) */
+  push_stack_no_args(sc, OP_LET_ONE_NEW_1, cdr(sc->code));
+  sc->code = opt2_pair(sc->code);
+}
+
+static void op_let_one_p_new(s7_scheme *sc)
+{
+  sc->code = cdr(sc->code);
+  check_stack_size(sc); /* hit in (lint "s7test.scm") */
+  push_stack_no_args(sc, OP_LET_ONE_P_NEW_1, cdr(sc->code));
+  sc->code = T_Pair(opt2_pair(sc->code));
+}
+
+static void op_let_one_old(s7_scheme *sc)
+{
+  sc->code = cdr(sc->code);
+  push_stack_no_args_direct(sc, OP_LET_ONE_OLD_1);
+  sc->code = opt2_pair(sc->code);
+}
+
+static void op_let_one_old_1(s7_scheme *sc)
+{
+  s7_pointer let = update_let_with_slot(sc, opt3_let(sc->code), sc->value);
+  let_set_outlet(let, sc->curlet);
+  set_curlet(sc, let);
+  sc->code = cdr(sc->code);
+}
+
+static void op_let_one_p_old(s7_scheme *sc)
+{
+  sc->code = cdr(sc->code);
+  push_stack_no_args_direct(sc, OP_LET_ONE_P_OLD_1);
+  sc->code = T_Pair(opt2_pair(sc->code));
+}
+
+static void op_let_one_p_old_1(s7_scheme *sc)
+{
+  s7_pointer let = update_let_with_slot(sc, opt3_let(sc->code), sc->value);
+  let_set_outlet(let, sc->curlet);
+  set_curlet(sc, let);
+  sc->code = cadr(sc->code);
+}
+
+static Inline void inline_op_let_a_new(s7_scheme *sc) /* three calls in eval, all get hits */
+{
+  sc->code = cdr(sc->code);
+  set_curlet(sc, inline_make_let_with_slot(sc, sc->curlet, car(opt2_pair(sc->code)), fx_call(sc, cdr(opt2_pair(sc->code)))));
+}
+
+static Inline void inline_op_let_a_old(s7_scheme *sc)  /* tset(2) fb(0) cb(4) left(2) */
+{
+  s7_pointer let;
+  sc->code = cdr(sc->code);
+  let = update_let_with_slot(sc, opt3_let(sc->code), fx_call(sc, cdr(opt2_pair(sc->code))));
+  let_set_outlet(let, sc->curlet);
+  set_curlet(sc, let);
+}
+
+static inline void op_let_a_old(s7_scheme *sc) {return(inline_op_let_a_old(sc));}
+
+static void op_let_a_a_new(s7_scheme *sc)
+{
+  s7_pointer binding;
+  sc->code = cdr(sc->code);
+  binding = opt2_pair(sc->code);
+  set_curlet(sc, inline_make_let_with_slot(sc, sc->curlet, car(binding), fx_call(sc, cdr(binding))));
+  sc->value = fx_call(sc, cdr(sc->code));
+  /* free_cell(sc, sc->curlet); *//* t101-3 and t725+unlet */ /* don't free let_slots here unless checked first (can be null after fx_call above?) */
+  /* upon return, we continue, so sc->curlet should be ok */
+}
+
+static void op_let_a_a_old(s7_scheme *sc) /* these are not called as fx*, and restoring sc->curlet has noticeable cost (e.g. 8 in thash) */
+{
+  s7_pointer let;
+  sc->code = cdr(sc->code);
+  let = update_let_with_slot(sc, opt3_let(sc->code), fx_call(sc, cdr(opt2_pair(sc->code))));
+  let_set_outlet(let, sc->curlet);
+  set_curlet(sc, let);
+  sc->value = fx_call(sc, cdr(sc->code));
+}
+
+static void op_let_a_na_new(s7_scheme *sc)
+{
+  s7_pointer binding, p;
+  sc->code = cdr(sc->code);
+  binding = opt2_pair(sc->code);
+  set_curlet(sc, make_let_with_slot(sc, sc->curlet, car(binding), fx_call(sc, cdr(binding))));
+  for (p = cdr(sc->code); is_pair(cdr(p)); p = cdr(p)) fx_call(sc, p);
+  sc->value = fx_call(sc, p);
+  free_cell(sc, sc->curlet); /* possibly unsafe */ /* see above */
+}
+
+/* this and others like it could easily be fx funcs, but check_let is called too late, so it's never seen as fxable */
+static void op_let_a_na_old(s7_scheme *sc)
+{
+  s7_pointer let, p;
+  sc->code = cdr(sc->code);
+  let = update_let_with_slot(sc, opt3_let(sc->code), fx_call(sc, cdr(opt2_pair(sc->code))));
+  let_set_outlet(let, sc->curlet);
+  set_curlet(sc, let);
+  for (p = cdr(sc->code); is_pair(cdr(p)); p = cdr(p)) fx_call(sc, p);
+  sc->value = fx_call(sc, p);
+}
+
+static inline void op_let_opassq(s7_scheme *sc)
+{
+  s7_pointer in_val, lst;
+  sc->code = cdr(sc->code);
+  in_val = lookup(sc, opt2_sym(sc->code));                  /* cadadr(caar(sc->code)); */
+  lst = lookup(sc, opt3_sym(cdr(sc->code)));
+  if (is_pair(lst))
+    sc->value = s7_assq(sc, in_val, lst);
+  else sc->value = (is_null(lst)) ? sc->F : g_assq(sc, set_plist_2(sc, in_val, lst));
+}
+
+static inline void op_let_opassq_old(s7_scheme *sc)
+{
+  s7_pointer let;
+  op_let_opassq(sc);
+  let = update_let_with_slot(sc, opt3_let(sc->code), sc->value);
+  let_set_outlet(let, sc->curlet);
+  set_curlet(sc, let);
+  sc->code = T_Pair(cdr(sc->code));
+}
+
+static inline void op_let_opassq_new(s7_scheme *sc)
+{
+  op_let_opassq(sc);
+  set_curlet(sc, inline_make_let_with_slot(sc, sc->curlet, opt1_sym(sc->code), sc->value));
+  sc->code = T_Pair(cdr(sc->code));
+}
+
+static Inline void inline_op_let_na_new(s7_scheme *sc) /* called once in eval, case gsl lg mock */
+{
+  s7_pointer let, sp = NULL;
+  new_cell(sc, let, T_LET | T_SAFE_PROCEDURE);
+  let_set_id(let, sc->let_number + 1);
+  let_set_slots(let, slot_end);
+  let_set_outlet(let, T_Let(sc->curlet));
+  sc->args = let;
+  for (s7_pointer p = cadr(sc->code); is_pair(p); p = cdr(p))
+    {
+      s7_pointer arg = cdar(p);
+      sc->value = fx_call(sc, arg);
+      if (!sp)
+	{
+	  add_slot(sc, let, caar(p), sc->value);
+	  sp = let_slots(let);
+	}
+      else sp = inline_add_slot_at_end(sc, let_id(let), sp, caar(p), sc->value);
+    }
+  sc->let_number++;
+  set_curlet(sc, let);
+  sc->code = T_Pair(cddr(sc->code));
+}
+
+static void op_let_na_old(s7_scheme *sc)
+{
+  s7_pointer let = opt3_let(cdr(sc->code));
+  s7_pointer slot = let_slots(let);
+  uint64_t id = ++sc->let_number;
+  sc->args = let;
+  let_set_id(let, id);
+  let_set_outlet(let, sc->curlet);
+  for (s7_pointer p = cadr(sc->code); is_pair(p); p = cdr(p), slot = next_slot(slot))
+    {
+      /* GC protected because it's a semipermanent let? or perhaps use sc->args? */
+      slot_set_value(slot, fx_call(sc, cdar(p)));
+      symbol_set_local_slot_unincremented(slot_symbol(slot), id, slot);
+    }
+  set_curlet(sc, let);
+  sc->code = T_Pair(cddr(sc->code));
+}
+
+static void op_let_2a_new(s7_scheme *sc) /* 2 vars, 1 expr in body */
+{
+  s7_pointer code = cdr(sc->code);
+  s7_pointer a1 = opt1_pair(code); /* caar(code) */
+  s7_pointer a2 = opt2_pair(code); /* cadar(code) */
+  set_curlet(sc, inline_make_let_with_two_slots(sc, sc->curlet, car(a1), fx_call(sc, cdr(a1)), car(a2), fx_call(sc, cdr(a2))));
+  sc->code = cadr(code);
+}
+
+static inline void op_let_2a_old(s7_scheme *sc) /* 2 vars, 1 expr in body */
+{
+  s7_pointer code = cdr(sc->code);
+  s7_pointer let = update_let_with_two_slots(sc, opt3_let(code), fx_call(sc, cdr(opt1_pair(code))), fx_call(sc, cdr(opt2_pair(code))));
+  let_set_outlet(let, sc->curlet);
+  set_curlet(sc, let);
+  sc->code = cadr(code);
+}
+
+static void op_let_3a_new(s7_scheme *sc) /* 3 vars, 1 expr in body */
+{
+  s7_pointer code = cdr(sc->code);
+  s7_pointer a1 = caar(code);
+  s7_pointer a2 = opt1_pair(code); /* cadar */
+  s7_pointer a3 = opt2_pair(code); /* caddar */
+  gc_protect_via_stack(sc, fx_call(sc, cdr(a1))); /* fx_call might be fx_car_t (etc) so it needs to precede the new let */
+  set_gc_protected2(sc, fx_call(sc, cdr(a2)));
+  set_curlet(sc, inline_make_let_with_two_slots(sc, sc->curlet, car(a2), gc_protected2(sc), car(a3), fx_call(sc, cdr(a3))));
+  add_slot(sc, sc->curlet, car(a1), gc_protected1(sc));
+  unstack_gc_protect(sc);
+  sc->code = cadr(code);
+}
+
+static void op_let_3a_old(s7_scheme *sc) /* 3 vars, 1 expr in body */
+{
+  s7_pointer code = cdr(sc->code);
+  s7_pointer let = update_let_with_three_slots(sc, opt3_let(code), fx_call(sc, cdr(caar(code))), fx_call(sc, cdr(opt1_pair(code))), fx_call(sc, cdr(opt2_pair(code))));
+  let_set_outlet(let, sc->curlet);
+  set_curlet(sc, let);
+  sc->code = cadr(code);
+}
+
+
+/* -------------------------------- let* -------------------------------- */
+static bool check_let_star(s7_scheme *sc)
+{
+  s7_pointer vars, form = sc->code, code = cdr(sc->code);
+  bool named_let, fxable = true, shadowing = false;
+
+  if (!is_pair(code))                           /* (let* . 1) */
+    syntax_error_nr(sc, "let* variable list is messed up: ~A", 35, form);
+  if (!is_pair(cdr(code)))                      /* (let* ()) */
+    syntax_error_nr(sc, "let* has no body: ~A", 20, form);
+
+  named_let = (is_symbol(car(code)));
+
+  if (named_let)
+    {
+      if (!is_list(cadr(code)))                 /* (let* hi #t) */
+	syntax_error_nr(sc, "let* variable list is messed up: ~A", 35, form);
+      if (!is_pair(cddr(code)))                 /* (let* hi () . =>) or (let* hi () ) */
+	{
+	  if (is_null(cddr(code)))
+	    syntax_error_nr(sc, "named let* has no body: ~A", 26, form);
+	  syntax_error_nr(sc, "named let* stray dot? ~A", 24, form);
+	}
+      if (is_constant_symbol(sc, car(code)))
+	error_nr(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, cant_bind_immutable_string, sc->let_star_symbol, form));
+      set_local(car(code));
+    }
+  else
+    if (!is_list(car(code)))                        /* (let* x ... ) */
+      syntax_error_nr(sc, "let* variable declaration value is missing: ~A", 46, form);
+
+  clear_symbol_list(sc);
+  for (vars = ((named_let) ? cadr(code) : car(code)); is_pair(vars); vars = cdr(vars))
+    {
+      s7_pointer var, var_and_val = car(vars);
+      if (!is_pair(var_and_val))                    /* (let* (3) ... */
+	error_nr(sc, sc->syntax_error_symbol,
+		 set_elist_3(sc, wrap_string(sc, "let* variable list, ~A, is messed up in ~A", 42),
+			     var_and_val, object_to_string_truncated(sc, form)));
+
+      if (!(is_pair(cdr(var_and_val))))             /* (let* ((x . 1))...) */
+	{
+	  if (is_null(cdr(var_and_val)))
+	    error_nr(sc, sc->syntax_error_symbol,
+		     set_elist_3(sc, wrap_string(sc, "let* variable declaration, but no value?: ~A in ~A", 50),
+				 var_and_val, object_to_string_truncated(sc, form)));
+	  error_nr(sc, sc->syntax_error_symbol,
+		   set_elist_3(sc, wrap_string(sc, "let* variable declaration is not a proper list: ~A in ~A", 56),
+			       var_and_val, object_to_string_truncated(sc, form)));
+	}
+      if (!is_null(cddr(var_and_val)))              /* (let* ((c 1 2)) ...) */
+	error_nr(sc, sc->syntax_error_symbol,
+		 set_elist_3(sc, wrap_string(sc, "let* variable declaration has more than one value?: ~A in ~A", 60),
+			     var_and_val, object_to_string_truncated(sc, form)));
+
+      var = car(var_and_val);
+      if (!(is_symbol(var)))                        /* (let* ((3 1)) 1) */
+	error_nr(sc, sc->syntax_error_symbol,
+		 set_elist_4(sc, wrap_string(sc, "bad variable name ~W in let* (it is ~A, not a symbol) in ~A", 59),
+			     var, object_type_name(sc, var),
+			     object_to_string_truncated(sc, form)));
+
+      if (is_constant_symbol(sc, var))              /* (let* ((pi 3)) ...) */
+	error_nr(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, cant_bind_immutable_string, sc->let_star_symbol, var_and_val));
+
+      if ((named_let) && (symbol_is_in_arg_list(var, cdr(vars)))) /* (let* loop ((a 1) (a 2)) ...) -- added 2-Dec-19 */
+	error_nr(sc, sc->syntax_error_symbol,
+		 set_elist_3(sc, wrap_string(sc, "named let* parameter, ~A, is used twice in the parameter list in ~A", 67),
+			     var, object_to_string_truncated(sc, form)));
+      /* currently (let* ((a 1) (a (+ a 1))) a) is 2, not an error */
+
+      if (symbol_is_in_list(sc, var)) shadowing = true;
+      add_symbol_to_list(sc, var);
+      set_local(var);
+    }
+  if (!is_null(vars))
+    error_nr(sc, sc->syntax_error_symbol,
+	     set_elist_3(sc, wrap_string(sc, "let* variable list is not a proper list: ~A in ~A", 49),
+			 vars, object_to_string_truncated(sc, form)));
+
+  if (!s7_is_proper_list(sc, cdr(code)))
+    syntax_error_nr(sc, "stray dot in let* body: ~S", 26, cdr(code));
+
+  if (shadowing)
+    fxable = false;
+  else
+    for (vars = (named_let) ? cadr(code) : car(code); is_pair(vars); vars = cdr(vars))
+      if (is_fxable(sc, cadar(vars)))
+	set_fx_direct(cdar(vars), fx_choose(sc, cdar(vars), sc->curlet, let_star_symbol_is_safe));
+      else fxable = false;
+
+  if (named_let)
+    {
+      if (is_null(cadr(code)))
+	{
+	  pair_set_syntax_op(form, OP_NAMED_LET_NO_VARS);
+	  set_opt1_pair(form, cdddr(form));
+	}
+      else
+	{
+	  pair_set_syntax_op(form, OP_NAMED_LET_STAR);
+	  set_opt2_con(code, cadr(caadr(code)));
+	}
+      sc->value = cdr(code);
+      if (is_null(car(sc->value)))                   /* (let* name () ... */
+	{
+	  s7_pointer let_sym = car(code);
+	  set_curlet(sc, make_let(sc, sc->curlet));
+	  sc->code = T_Pair(cdr(sc->value));
+	  add_slot_checked(sc, sc->curlet, let_sym, make_closure_unchecked(sc, sc->nil, sc->code, T_CLOSURE_STAR, 0));
+	  set_curlet(sc, make_let(sc, sc->curlet));  /* inner let */
+	  return(false);
+	}
+      set_curlet(sc, make_let(sc, sc->curlet));
+      push_stack(sc, OP_LET_STAR1, code, cadr(code));
+      sc->code = cadr(caadr(code));               /* first var val */
+      return(true);
+    }
+  if (is_null(car(code)))
+    {
+      pair_set_syntax_op(form, OP_LET_NO_VARS);   /* (let* () ...) */
+      set_curlet(sc, make_let(sc, sc->curlet));
+      sc->code = T_Pair(cdr(code));
+      return(false);
+    }
+  else
+    if (is_null(cdar(code)))
+      {
+	check_let_one_var(sc, form, car(code));   /* (let* ((var...))...) -> (let ((var...))...) */
+	if (optimize_op(form) >= OP_LET_NA_OLD)
+	  {
+	    if ((!in_heap(form)) &&
+		(body_is_safe(sc, sc->unused, cdr(code), true) >= SAFE_BODY))
+	      set_opt3_let(code, make_semipermanent_let(sc, car(code)));
+	    else
+	      {
+		set_optimize_op(form, optimize_op(form) + 1); /* *_old -> *_new */
+		set_opt3_let(code, sc->rootlet);
+	      }}}
+    else  /* multiple variables */
+      {
+	if (fxable)
+	  {
+	    pair_set_syntax_op(form, OP_LET_STAR_NA);
+	    if ((is_null(cddr(code))) &&
+		(is_fxable(sc, cadr(code))))
+	      {
+		fx_annotate_arg(sc, cdr(code), sc->curlet);
+		pair_set_syntax_op(form, OP_LET_STAR_NA_A);
+	      }}
+	else pair_set_syntax_op(form, OP_LET_STAR2);
+	set_opt2_con(code, cadaar(code));
+      }
+  push_stack(sc, ((intptr_t)((shadowing) ? OP_LET_STAR_SHADOWED : OP_LET_STAR1)), code, car(code));
+  /* args is the let body, saved for later, code is the list of vars+initial-values */
+  sc->code = cadr(caar(code));
+  /* caar(code) = first var/val pair, we've checked that all these guys are legit, so cadr of that is the value */
+  return(true);
+}
+
+static bool op_let_star_shadowed(s7_scheme *sc)
+{
+  while (true)
+    {
+      set_curlet(sc, inline_make_let_with_slot(sc, sc->curlet, caar(sc->code), sc->value));
+      sc->code = cdr(sc->code);
+      if (is_pair(sc->code))
+	{
+	  s7_pointer x = cdar(sc->code);
+	  if (has_fx(x))
+	    sc->value = fx_call(sc, x);
+	  else
+	    {
+	      push_stack_direct(sc, OP_LET_STAR_SHADOWED);
+	      sc->code = car(x);
+	      return(true);
+	    }}
+      else break;
+    }
+  sc->code = cdr(sc->args); /* original sc->code set in push_stack above */
+  return(false);
+}
+
+static inline bool op_let_star1(s7_scheme *sc)
+{
+  uint64_t let_counter = S7_INT64_MAX;
+  s7_pointer sp = NULL;
+  while (true)
+    {
+      if (let_counter == sc->capture_let_counter)
+	{
+	  if (sp == NULL)
+	    {
+	      add_slot_checked(sc, sc->curlet, caar(sc->code), sc->value);
+	      sp = let_slots(sc->curlet);
+	    }
+	  else sp = inline_add_slot_at_end(sc, let_id(sc->curlet), sp, caar(sc->code), sc->value);
+	}
+      else
+	{
+	  set_curlet(sc, inline_make_let_with_slot(sc, sc->curlet, caar(sc->code), sc->value));
+	  sp = let_slots(sc->curlet);
+	  let_counter = sc->capture_let_counter;
+	}
+      sc->code = cdr(sc->code);
+      if (is_pair(sc->code))
+	{
+	  s7_pointer x = cdar(sc->code);
+	  if (has_fx(x))
+	    sc->value = fx_call(sc, x);
+	  else
+	    {
+	      push_stack_direct(sc, OP_LET_STAR1);
+	      sc->code = car(x);
+	      return(true);
+	    }}
+      else break;
+    }
+  sc->code = sc->args; /* original sc->code set in push_stack above */
+  if (is_symbol(car(sc->code)))
+    {
+      s7_pointer name = car(sc->code), body = cddr(sc->code), args = cadr(sc->code);
+      /* now we need to declare the new function (in the outer let) -- must delay this because init might reference same-name outer func */
+      /*   but the let name might be shadowed by a variable: (let* x ((x 1))...) so the name's symbol_id can be incorrect */
+      if (symbol_id(name) > let_id(let_outlet(sc->curlet)))
+	{
+	  s7_int cur_id = symbol_id(name);
+	  s7_pointer cur_slot = local_slot(name);
+	  symbol_set_id_unchecked(name, let_id(let_outlet(sc->curlet)));
+	  add_slot_checked(sc, let_outlet(sc->curlet), name,
+			   make_closure_unchecked(sc, args, body, T_CLOSURE_STAR, (is_null(args)) ? 0 : CLOSURE_ARITY_NOT_SET));
+	  symbol_set_id_unchecked(name, cur_id);
+	  set_local_slot(name, cur_slot);
+	}
+      else add_slot_checked(sc, let_outlet(sc->curlet), name,
+			    make_closure_unchecked(sc, args, body, T_CLOSURE_STAR, (is_null(args)) ? 0 : CLOSURE_ARITY_NOT_SET));
+
+      sc->code = body;
+    }
+  else sc->code = T_Pair(cdr(sc->code));
+  return(false);
+}
+
+static void op_let_star_na(s7_scheme *sc)
+{
+  /* fx safe does not mean we can dispense with the inner lets (curlet is safe for example) */
+  s7_pointer sp = NULL;
+  uint64_t let_counter = S7_INT64_MAX;
+  sc->code = cdr(sc->code);
+  for (s7_pointer p = car(sc->code); is_pair(p); p = cdr(p))
+    {
+      s7_pointer val = fx_call(sc, cdar(p)); /* eval in outer let */
+      if (let_counter == sc->capture_let_counter)
+	{
+	  if (!sp)
+	    {
+	      add_slot_checked(sc, sc->curlet, caar(p), val);
+	      sp = let_slots(sc->curlet);
+	    }
+	  else sp = inline_add_slot_at_end(sc, let_id(sc->curlet), sp, caar(p), val);
+	}
+      else
+	{
+	  set_curlet(sc, inline_make_let_with_slot(sc, sc->curlet, caar(p), val));
+	  sp = let_slots(sc->curlet);
+	  let_counter = sc->capture_let_counter;
+	}}
+  sc->code = T_Pair(cdr(sc->code));
+}
+
+static void op_let_star_na_a(s7_scheme *sc)
+{
+  s7_pointer sp = NULL;
+  uint64_t let_counter = S7_INT64_MAX;
+  sc->code = cdr(sc->code);
+  for (s7_pointer p = car(sc->code); is_pair(p); p = cdr(p))
+    {
+      s7_pointer val = fx_call(sc, cdar(p));
+      if (let_counter == sc->capture_let_counter)
+	{
+	  if (!sp)
+	    {
+	      add_slot_checked(sc, sc->curlet, caar(p), val);
+	      sp = let_slots(sc->curlet);
+	    }
+	  else sp = inline_add_slot_at_end(sc, let_id(sc->curlet), sp, caar(p), val);
+	}
+      else
+	{
+	  set_curlet(sc, inline_make_let_with_slot(sc, sc->curlet, caar(p), val));
+	  sp = let_slots(sc->curlet);
+	  let_counter = sc->capture_let_counter;
+	}}
+  sc->value = fx_call(sc, cdr(sc->code));
+}
+
+static void op_named_let_star(s7_scheme *sc)
+{
+  s7_pointer code = cdr(sc->code); /* code: (name vars ...) */
+  set_curlet(sc, make_let(sc, sc->curlet));
+  push_stack(sc, OP_LET_STAR1, code, cadr(code));
+  sc->code = opt2_con(code);
+}
+
+static void op_let_star2(s7_scheme *sc)
+{
+  s7_pointer code = cdr(sc->code);
+  /* check_stack_size(sc); */ /* t101-42 but commented out */
+  push_stack(sc, OP_LET_STAR1, code, car(code));
+  sc->code = opt2_con(code);
+}
+
+
+/* -------------------------------- letrec, letrec* -------------------------------- */
+static void check_letrec(s7_scheme *sc, bool letrec)
+{
+  s7_pointer x, code = cdr(sc->code);
+  s7_pointer caller = (letrec) ? sc->letrec_symbol : sc->letrec_star_symbol;
+
+  if ((!is_pair(code)) ||                     /* (letrec . 1) */
+      (!is_list(car(code))))                  /* (letrec 1 ...) */
+    syntax_error_with_caller_nr(sc, "~A: variable list is messed up: ~A", 34, caller, sc->code);
+
+  if (!is_pair(cdr(code)))                    /* (letrec ()) */
+    syntax_error_with_caller_nr(sc, "~A has no body: ~A", 18, caller, sc->code);
+
+  clear_symbol_list(sc);
+  for (x = car(code); is_not_null(x); x = cdr(x))
+    {
+      s7_pointer y, carx;
+      if (!is_pair(x))                        /* (letrec ((a 1) . 2) ...) */
+	syntax_error_with_caller_nr(sc, "~A: improper list of variables? ~A", 34, caller, sc->code);
+
+      carx = car(x);
+      if (!is_pair(carx))                     /* (letrec (1 2) #t) */
+	syntax_error_with_caller_nr(sc, "~A: bad variable ~S (should be a pair (name value))", 51, caller, carx);
+
+      y = car(carx);
+      if (!(is_symbol(y)))
+	error_nr(sc, sc->syntax_error_symbol,
+		 set_elist_5(sc, wrap_string(sc, "bad variable name ~W in ~A (it is ~A, not a symbol) in ~A", 57),
+			     y, caller, object_type_name(sc, y),
+			     object_to_string_truncated(sc, sc->code)));
+      if (is_constant_symbol(sc, y))
+	error_nr(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, cant_bind_immutable_string, caller, x));
+
+      if (!is_pair(cdr(carx)))                /* (letrec ((x . 1))...) */
+	{
+	  if (is_null(cdr(carx)))             /* (letrec ((x)) x) -- perhaps this is legal? */
+	    syntax_error_with_caller_nr(sc, "~A: variable declaration has no value?: ~A", 42, caller, carx);
+	  syntax_error_with_caller_nr(sc, "~A: variable declaration is not a proper list?: ~A", 50, caller, carx);
+	}
+      if (is_not_null(cddr(carx)))            /* (letrec ((x 1 2 3)) ...) */
+	syntax_error_with_caller_nr(sc, "~A: variable declaration has more than one value?: ~A", 53, caller, carx);
+
+      /* check for name collisions -- this is needed in letrec* else which of the two legit values does our "rec" refer to, so to speak */
+      if (symbol_is_in_list(sc, y))
+	syntax_error_with_caller_nr(sc, "~A: duplicate identifier: ~A", 28, caller, y);
+      add_symbol_to_list(sc, y);
+      set_local(y);
+    }
+
+  if (!s7_is_proper_list(sc, cdr(code)))
+    syntax_error_with_caller_nr(sc, "stray dot in ~A body: ~S", 24, caller, cdr(code));
+
+  for (x = car(code); is_pair(x); x = cdr(x))
+    if (is_fxable(sc, cadar(x)))
+      set_fx_direct(cdar(x), fx_choose(sc, cdar(x), sc->curlet, let_symbol_is_safe_or_listed));
+
+  pair_set_syntax_op(sc->code, (letrec) ? OP_LETREC_UNCHECKED : OP_LETREC_STAR_UNCHECKED);
+}
+
+static s7_pointer make_funclet(s7_scheme *sc, s7_pointer new_func, s7_pointer func_name, s7_pointer outer_let);
+
+static void letrec_setup_closures(s7_scheme *sc)
+{
+  for (s7_pointer slot = let_slots(sc->curlet); tis_slot(slot); slot = next_slot(slot))
+    if (is_closure(slot_value(slot)))
+      {
+	s7_pointer func = slot_value(slot);
+	if ((!is_safe_closure(func)) ||
+	    (!is_optimized(car(closure_body(func)))))
+	  optimize_lambda(sc, true, slot_symbol(slot), closure_args(func), closure_body(func));
+	if (is_safe_closure_body(closure_body(func)))
+	  {
+	    set_safe_closure(func);
+	    if (is_very_safe_closure_body(closure_body(func)))
+	      set_very_safe_closure(func);
+	  }
+	make_funclet(sc, func, slot_symbol(slot), closure_let(func));
+      }
+}
+
+static void op_letrec2(s7_scheme *sc)
+{
+  for (s7_pointer slot = let_slots(sc->curlet); tis_slot(slot); slot = next_slot(slot))
+    if (is_checked_slot(slot))
+      slot_set_value(slot, slot_pending_value(slot));
+  letrec_setup_closures(sc);
+}
+
+static bool op_letrec_unchecked(s7_scheme *sc)
+{
+  s7_pointer code = cdr(sc->code);
+  /*   get all local vars and set to #<undefined>
+   *   get parallel list of values
+   *   eval each member of values list with let still full of #<undefined>'s
+   *   assign each value to its variable
+   *   eval body
+   * which means that (letrec ((x x)) x) is not an error!
+   * but this assumes the environment is not changed by evaluating the exprs?
+   * (letrec ((a (define b 1))) b) -- if let, the define takes place in the calling let, not the current let
+   * (letrec ((f1 (lambda (x) (f2 (* 2 x))))) (define (f2 y) (- y 1)) (f1 3)) -> 5 (Guile says unbound f2)
+   * I think I need to check here that slot_pending_value is set (using the is_checked bit below):
+   *   (letrec ((i (begin (define xyz 37) 0))) (curlet)): (inlet 'i 0 'xyz 37) -- is this correct?
+   */
+  set_curlet(sc, make_let(sc, sc->curlet));
+  if (is_pair(car(code)))
+    {
+      s7_pointer slot;
+      for (s7_pointer x = car(code); is_not_null(x); x = cdr(x))
+	{
+	  slot = add_slot_checked(sc, sc->curlet, caar(x), sc->undefined);
+	  slot_set_pending_value(slot, sc->undefined);
+	  slot_set_expression(slot, cdar(x));
+	  set_checked_slot(slot);
+	}
+      for (slot = let_slots(sc->curlet); tis_slot(slot) && (has_fx(slot_expression(slot))); slot = next_slot(slot))
+	slot_set_pending_value(slot, fx_call(sc, slot_expression(slot)));
+      if (tis_slot(slot))
+	{
+	  push_stack(sc, OP_LETREC1, slot, code);
+	  sc->code = car(slot_expression(slot));
+	  return(true);
+	}
+      op_letrec2(sc);
+    }
+  sc->code = T_Pair(cdr(code));
+  return(false);
+}
+
+static bool op_letrec1(s7_scheme *sc)
+{
+  s7_pointer slot;
+  slot_set_pending_value(sc->args, sc->value);
+  for (slot = next_slot(sc->args); tis_slot(slot) && (has_fx(slot_expression(slot))); slot = next_slot(slot))
+    slot_set_pending_value(slot, fx_call(sc, slot_expression(slot)));
+  if (tis_slot(slot))
+    {
+      push_stack(sc, OP_LETREC1, slot, sc->code);
+      sc->code = car(slot_expression(slot));
+      return(true);
+    }
+  op_letrec2(sc);
+  sc->code = T_Pair(cdr(sc->code));
+  return(false);
+}
+
+
+static bool op_letrec_star_unchecked(s7_scheme *sc)
+{
+  s7_pointer code = cdr(sc->code);
+  /* get all local vars and set to #<undefined>
+   * eval each member of values list and assign immediately, as in let*
+   * eval body
+   */
+  set_curlet(sc, make_let(sc, sc->curlet));
+  if (is_pair(car(code)))
+    {
+      s7_pointer slot;
+      for (s7_pointer x = car(code); is_not_null(x); x = cdr(x))
+	{
+	  slot = add_slot_checked(sc, sc->curlet, caar(x), sc->undefined);
+	  slot_set_expression(slot, cdar(x));
+	}
+      let_set_slots(sc->curlet, reverse_slots(let_slots(sc->curlet)));
+
+      for (slot = let_slots(sc->curlet); tis_slot(slot) && (has_fx(slot_expression(slot))); slot = next_slot(slot))
+	slot_set_value(slot, fx_call(sc, slot_expression(slot)));
+      if (tis_slot(slot))
+	{
+	  push_stack(sc, OP_LETREC_STAR1, slot, code);
+	  sc->code = car(slot_expression(slot));
+	  return(true);
+	}}
+  sc->code = T_Pair(cdr(code));
+  return(false);
+}
+
+static bool op_letrec_star1(s7_scheme *sc)
+{
+  s7_pointer slot = sc->args;
+  slot_set_value(slot, sc->value);
+
+  for (slot = next_slot(slot); tis_slot(slot) && (has_fx(slot_expression(slot))); slot = next_slot(slot))
+    slot_set_value(slot, fx_call(sc, slot_expression(slot)));
+  if (tis_slot(slot))
+    {
+      push_stack(sc, OP_LETREC_STAR1, slot, sc->code);
+      sc->code = car(slot_expression(slot));
+      return(true);
+    }
+  letrec_setup_closures(sc);
+  sc->code = T_Pair(cdr(sc->code));
+  return(false);
+}
+
+
+/* -------------------------------- let-temporarily -------------------------------- */
+static void check_let_temporarily(s7_scheme *sc)
+{
+  s7_pointer x, form = sc->code, code = cdr(sc->code);
+  bool all_fx, all_s7;
+
+  if ((!is_pair(code)) ||                 /* (let-temporarily . 1) */
+      (!is_list(car(code))))              /* (let-temporarily 1 ...) */
+    syntax_error_nr(sc, "let-temporarily: variable list is messed up: ~A", 47, form);
+  /* cdr(code) = body can be nil */
+
+  all_fx = is_pair(car(code));
+  all_s7 = all_fx;
+
+  for (x = car(code); is_not_null(x); x = cdr(x))
+    {
+      s7_pointer carx, caarx;
+      if (!is_pair(x))                        /* (let-temporarily ((a 1) . 2) ...) */
+	syntax_error_nr(sc, "let-temporarily: improper list of variables? ~A", 47, form);
+
+      carx = car(x);
+      if (!is_pair(carx))                     /* (let-temporarily (1 2) #t) */
+	syntax_error_nr(sc, "let-temporarily: bad variable ~S (it should be a pair (name value))", 67, carx);
+
+      caarx = car(carx);
+      if (is_symbol(caarx))
+	{
+	  if (is_constant_symbol(sc, caarx)) /* (let-temporarily ((pi 3)) ...) */
+	    error_nr(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, cant_bind_immutable_string, sc->let_temporarily_symbol, x));
+	}
+      else
+	if (!is_pair(caarx))                 /* (let-temporarily ((1 2)) ...) */
+	  syntax_error_nr(sc, "let-temporarily: bad variable ~S (it should be a symbol or a pair)", 66, caarx);
+
+      if (!is_pair(cdr(carx)))               /* (let-temporarily ((x . 1))...) */
+	syntax_error_nr(sc, "let-temporarily: variable declaration value is messed up: ~S", 60, carx);
+
+      if (is_not_null(cddr(carx)))           /* (let-temporarily ((x 1 2 3)) ...) */
+	syntax_error_nr(sc, "let-temporarily: variable declaration has more than one value?: ~A", 66, carx);
+
+      if ((all_fx) &&
+	  ((!is_symbol(caarx)) || (!is_fxable(sc, cadr(carx))))) /* if all_fx, each var is (symbol fxable-expr) */
+	all_fx = false;
+      if ((all_s7) &&
+	  ((!is_pair(caarx)) || (car(caarx) != sc->s7_starlet_symbol) ||
+	   (!is_quoted_symbol(cadr(caarx))) || (is_keyword(cadr(cadr(caarx)))) ||
+	   (!is_fxable(sc, cadr(carx)))))
+	all_s7 = false;
+    }
+  if (!s7_is_proper_list(sc, cdr(code)))
+    syntax_error_nr(sc, "stray dot in let-temporarily body: ~S", 37, cdr(code));
+
+  if ((all_fx) || (all_s7))
+    {
+      pair_set_syntax_op(form, (all_fx) ? ((is_null(cdar(code))) ? OP_LET_TEMP_A : OP_LET_TEMP_NA) : OP_LET_TEMP_S7);
+      for (x = car(code); is_pair(x); x = cdr(x))
+	fx_annotate_arg(sc, cdar(x), sc->curlet);
+
+      if ((optimize_op(form) == OP_LET_TEMP_A) && (is_pair(cdr(code))) && (is_null(cddr(code))) && (is_fxable(sc, cadr(code))))
+	{
+	  fx_annotate_arg(sc, cdr(code), sc->curlet);
+	  pair_set_syntax_op(form, OP_LET_TEMP_A_A);
+	}
+      else
+	if (all_s7) /* not OP_LET_TEMP_NA */
+	  {
+	    s7_pointer var = caar(code);
+	    if ((is_fxable(sc, cadr(var))) &&  /* code: ((((*s7* 'openlets) fxable-expr)) ...) */
+		(is_null(cdar(code))))
+	      {
+		if ((is_quoted_symbol(cadar(var))) &&
+		    (s7_starlet_symbol_id(cadr(cadar(var))) == SL_OPENLETS)) /* (cadr(cadar(var)) == make_symbol_with_strlen(sc, "openlets"))) */
+		  {
+		    pair_set_syntax_op(form, OP_LET_TEMP_S7_DIRECT);
+		    set_opt1_pair(form, cdr(var));
+		  }}}
+
+      if ((is_fx_treeable(code)) && (tis_slot(let_slots(sc->curlet)))) {fx_curlet_tree(sc, code); fx_curlet_tree_in(sc, code);}
+    }
+  else
+    {
+      pair_set_syntax_op(form, OP_LET_TEMP_UNCHECKED);
+      if ((is_pair(car(code))) && (is_null(cdar(code))) && (is_pair(caar(code))))
+	{
+	  s7_pointer var = caar(code);
+	  s7_pointer val = cadr(var);
+	  var = car(var);
+	  if ((is_pair(var)) && (car(var) == sc->setter_symbol) && (is_pair(cdr(var))) && (is_pair(cddr(var))) && (val == sc->F))
+	    {
+	      /* (let-temporarily (((setter (slot-symbol cp) (slot-env cp)) #f)) ...) reactive.scm */
+	      optimize_expression(sc, cadr(var), 0, sc->curlet, false);
+	      optimize_expression(sc, caddr(var), 0, sc->curlet, false);
+	      if ((is_fxable(sc, cadr(var))) && (is_fxable(sc, caddr(var))))
+		{
+		  fx_annotate_args(sc, cdr(var), sc->curlet);
+		  pair_set_syntax_op(form, OP_LET_TEMP_SETTER);
+		}}}}
+}
+
+static void op_let_temp_unchecked(s7_scheme *sc)
+{
+  sc->code = cdr(sc->code); /* step past let-temporarily */
+  sc->args = list_4(sc, car(sc->code), sc->nil, sc->nil, sc->nil);
+  push_stack_direct(sc, OP_GC_PROTECT);
+  /* sc->args: varlist, settees, old_values, new_values */
+}
+
+static void op_let_temp_init1_1(s7_scheme *sc)
+{
+  if ((is_symbol(sc->value)) && (is_symbol_from_symbol(sc->value))) /* (let-temporarily (((symbol ...))) ..) */
+    {
+      clear_symbol_from_symbol(sc->value);
+      if (is_immutable_symbol(sc->value))
+	error_nr(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, cant_bind_immutable_string, sc->let_temporarily_symbol, sc->value));
+      sc->value = s7_symbol_value(sc, sc->value);
+    }
+  set_caddr(sc->args, cons(sc, sc->value, caddr(sc->args)));
+}
+
+static bool op_let_temp_init1(s7_scheme *sc)
+{
+  while (is_pair(car(sc->args)))
+    {
+      /* eval car, add result to old-vals list, if any vars undefined, error */
+      s7_pointer binding = caar(sc->args);
+      s7_pointer settee = car(binding);
+      s7_pointer new_value = cadr(binding);
+      set_cadr(sc->args, cons(sc, settee, cadr(sc->args)));
+      binding = cdddr(sc->args);
+      set_car(binding, cons_unchecked(sc, new_value, car(binding)));
+      set_car(sc->args, cdar(sc->args));
+      if (is_symbol(settee))                    /* get initial values */
+	set_caddr(sc->args, cons_unchecked(sc, lookup_checked(sc, settee), caddr(sc->args)));
+      else
+	{
+	  if (is_pair(settee))
+	    {
+	      push_stack_direct(sc, OP_LET_TEMP_INIT1);
+	      sc->code = settee;
+	      return(true);
+	    }
+	  set_caddr(sc->args, cons_unchecked(sc, new_value, caddr(sc->args)));
+	}}
+  set_car(sc->args, cadr(sc->args));
+  return(false);
+}
+
+typedef enum {goto_start, goto_begin, fall_through, goto_do_end_clauses, goto_safe_do_end_clauses,
+	      goto_eval, goto_apply_lambda, goto_do_end, goto_top_no_pop, goto_apply,
+	      goto_eval_args, goto_eval_args_top, goto_do_unchecked, goto_pop_read_list,
+	      goto_read_tok, goto_feed_to, goto_set_unchecked, goto_unopt} goto_t;
+
+static goto_t op_let_temp_init2(s7_scheme *sc)
+{
+  /* now eval set car new-val, cadr=settees, cadddr=new_values */
+  while (is_pair(car(sc->args)))
+    {
+      s7_pointer settee = caar(sc->args), slot, p = cdddr(sc->args);
+      s7_pointer new_value = caar(p);
+      set_car(p, cdar(p));
+      set_car(sc->args, cdar(sc->args));
+      if ((!is_symbol(settee)) || (is_pair(new_value)))
+	{
+	  if (is_symbol(settee))
+	    {
+	      push_stack_direct(sc, OP_LET_TEMP_INIT2);          /* (let-temporarily (((*s7* 'print-length) 32)) ...) */
+	      push_stack_no_args(sc, OP_SET_FROM_LET_TEMP, settee);
+	      sc->code = new_value;
+	      return(goto_eval);
+	    }
+	  sc->code = set_plist_3(sc, sc->set_symbol, settee, new_value);
+	  push_stack_direct(sc, OP_LET_TEMP_INIT2);
+	  return(goto_set_unchecked);
+	}
+      slot = s7_slot(sc, settee);
+      if (!is_slot(slot))
+	unbound_variable_error_nr(sc, settee);
+      if (is_immutable_slot(slot))
+	immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->let_temporarily_symbol, settee));
+      if (is_symbol(new_value))
+	new_value = lookup_checked(sc, new_value);
+      slot_set_value(slot, (slot_has_setter(slot)) ? call_setter(sc, slot, new_value) : new_value);
+    }
+  set_car(sc->args, cadr(sc->args));
+  /* pop_stack(sc); */ /* this clobbers sc->args! 7-May-22 */
+  unstack_gc_protect(sc);         /* pop_stack_no_args(sc) in effect */
+  sc->code = cdr(stack_end_code(sc));
+  if (is_pair(sc->code))
+    {
+      push_stack_direct(sc, OP_LET_TEMP_DONE);
+      return(goto_begin);
+    }
+  sc->value = sc->nil; /* so (let-temporarily (<vars)) -> () like begin I guess */
+  return(fall_through);
+}
+
+static bool op_let_temp_done1(s7_scheme *sc)
+{
+  while (is_pair(car(sc->args)))
+    {
+      s7_pointer settee = caar(sc->args), p = cddr(sc->args);
+      sc->value = caar(p);
+      set_car(p, cdar(p));
+      set_car(sc->args, cdar(sc->args));
+
+      if ((is_pair(settee)) && (car(settee) == sc->s7_starlet_symbol) &&  /* (let-temporarily (((*s7* (symbol "print-length")) 43))...) */
+	  ((is_symbol_and_keyword(cadr(settee))) ||
+	   (is_quoted_symbol(cadr(settee)))))
+	{
+	  s7_pointer sym = cadr(settee);
+	  if (is_pair(sym)) sym = cadr(sym);
+	  s7_starlet_set_1(sc, T_Sym(sym), sc->value);
+	}
+      else
+	{
+	  s7_pointer slot;
+	  if (!is_symbol(settee))
+	    {
+	      push_stack_direct(sc, OP_LET_TEMP_DONE1); /* save args and (pending) body value==sc->code */
+	      if ((is_pair(sc->value)) || (is_symbol(sc->value)))
+		sc->code = set_plist_3(sc, sc->set_symbol, settee, set_plist_2(sc, sc->quote_function, sc->value));
+	      else sc->code = set_plist_3(sc, sc->set_symbol, settee, sc->value);
+	      return(false); /* goto set_unchecked */
+	    }
+	  slot = s7_slot(sc, settee);
+	  if (is_immutable_slot(slot))
+	    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->let_temporarily_symbol, settee));
+	  if (slot_has_setter(slot))             /* maybe setter changed in let-temp body? else setter has already checked the init value */
+	    slot_set_value(slot, call_setter(sc, slot, sc->value));
+	  else slot_set_value(slot, sc->value);
+	}}
+  pop_stack(sc); /* not unstack */
+  sc->value = sc->code;
+  if (is_multiple_value(sc->value))
+    sc->value = splice_in_values(sc, multiple_value(sc->value));
+  return(true);          /* goto start */
+}
+
+static bool *s7_starlet_immutable_field = NULL;
+
+static bool op_let_temp_s7(s7_scheme *sc) /* all entries are of the form ((*s7* 'field) fx-able-value) */
+{
+  s7_pointer p, code = cdr(sc->code); /* don't use sc->code here -- it can be changed */
+  s7_pointer *end = sc->stack_end;
+  for (p = car(code); is_pair(p); p = cdr(p))
+    {
+      s7_pointer old_value, field = cadadr(caar(p)); /* p: (((*s7* 'expansions?) #f)) -- no keywords here (see check_let_temporarily) */
+      if (s7_starlet_immutable_field[s7_starlet_symbol_id(field)])
+	immutable_object_error_nr(sc, set_elist_2(sc, wrap_string(sc, "let-temporarily: can't set! (*s7* '~S)", 38), field));
+      old_value = s7_starlet(sc, s7_starlet_symbol_id(field));
+      /* check_stack_size(sc); */ /* t101-42 but commented out (probably the #symbol stuff) */
+      push_stack(sc, OP_LET_TEMP_S7_UNWIND, old_value, field);
+    }
+  for (p = car(code); is_pair(p); p = cdr(p), end += 4)
+    s7_starlet_set_1(sc, T_Sym(end[0]), fx_call(sc, cdar(p)));
+  sc->code = cdr(code);
+  return(is_pair(sc->code)); /* sc->code can be null if no body */
+}
+
+static void op_let_temp_s7_unwind(s7_scheme *sc)
+{
+  s7_starlet_set_1(sc, T_Sym(sc->code), sc->args);
+  if (is_multiple_value(sc->value))
+    sc->value = splice_in_values(sc, multiple_value(sc->value));
+}
+
+static bool op_let_temp_s7_direct(s7_scheme *sc)
+{
+  s7_pointer new_val;
+  push_stack_no_code(sc, OP_LET_TEMP_S7_DIRECT_UNWIND, (sc->has_openlets) ? sc->T : sc->F);
+  new_val = fx_call(sc, opt1_pair(sc->code));
+  sc->has_openlets = (new_val != sc->F);
+  sc->code = cddr(sc->code); /* cddr is body of let-temp */
+  return(is_pair(sc->code));
+}
+
+static void op_let_temp_s7_direct_unwind(s7_scheme *sc)
+{
+  sc->has_openlets = (sc->args != sc->F);
+  if (is_multiple_value(sc->value))
+    sc->value = splice_in_values(sc, multiple_value(sc->value));
+}
+
+static void let_temp_done(s7_scheme *sc, s7_pointer args, s7_pointer let)
+{
+  /* called in call/cc, call-with-exit and, catch (unwind to catch) */
+  check_stack_size(sc);
+  push_stack_direct(sc, OP_GC_PROTECT);
+  sc->args = T_Ext(args);
+  set_curlet(sc, let);
+  op_let_temp_done1(sc);
+}
+
+static void let_temp_unwind(s7_scheme *sc, s7_pointer slot, s7_pointer new_value)
+{
+  if (slot_has_setter(slot)) /* setter has to be called because it might affect other vars (*clm-srate* -> mus-srate etc), but it should not change sc->value */
+    {
+      s7_pointer old_value = sc->value;
+      slot_set_value(slot, call_setter(sc, slot, new_value)); /* s7_apply_function(sc, slot_setter(slot), set_plist_2(sc, slot_symbol(slot), new_value))); */
+      sc->value = old_value;
+    }
+  else slot_set_value(slot, new_value);
+}
+
+static void op_let_temp_unwind(s7_scheme *sc)
+{
+  let_temp_unwind(sc, sc->code, sc->args);
+  if (is_multiple_value(sc->value))
+    sc->value = splice_in_values(sc, multiple_value(sc->value));
+}
+
+static bool op_let_temp_na(s7_scheme *sc) /* all entries are of the form (symbol fx-able-value) */
+{
+  s7_pointer p, slot;
+  s7_pointer *end = sc->stack_end;
+  sc->code = cdr(sc->code);
+
+  for (p = car(sc->code); is_pair(p); p = cdr(p))
+    {
+      s7_pointer var = car(p);
+      s7_pointer settee = car(var);
+      slot = s7_slot(sc, settee);
+      if (!is_slot(slot))
+	unbound_variable_error_nr(sc, settee);
+      if (is_immutable_slot(slot))
+	immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->let_temporarily_symbol, settee));
+      push_stack(sc, OP_LET_TEMP_UNWIND, slot_value(slot), slot);
+    }
+  for (p = car(sc->code); is_pair(p); p = cdr(p), end += 4)
+    {
+      s7_pointer var = car(p);
+      s7_pointer new_val = fx_call(sc, cdr(var));
+      slot = end[0];
+      if (slot_has_setter(slot))
+	slot_set_value(slot, call_setter(sc, slot, new_val)); /* s7_apply_function(sc, slot_setter(slot), set_plist_2(sc, settee, new_val))); */
+      else slot_set_value(slot, new_val);
+    }
+  sc->code = cdr(sc->code);
+  return(is_pair(sc->code)); /* sc->code can be null if no body */
+}
+
+static bool op_let_temp_a(s7_scheme *sc) /* one entry */
+{
+  s7_pointer var, settee, new_val, slot;
+  sc->code = cdr(sc->code);
+  var = caar(sc->code);
+  settee = car(var);
+  slot = s7_slot(sc, settee);
+  if (!is_slot(slot))
+    unbound_variable_error_nr(sc, settee);
+  if (is_immutable_slot(slot))
+    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->let_temporarily_symbol, settee));
+  push_stack(sc, OP_LET_TEMP_UNWIND, slot_value(slot), slot);
+  new_val = fx_call(sc, cdr(var));
+  if (slot_has_setter(slot))
+    slot_set_value(slot, call_setter(sc, slot, new_val)); /* s7_apply_function(sc, slot_setter(slot), set_plist_2(sc, settee, new_val))); */
+  else slot_set_value(slot, new_val);
+  sc->code = cdr(sc->code);
+  return(is_pair(sc->code)); /* sc->code can be null if no body */
+}
+
+static s7_pointer fx_let_temp_a_a(s7_scheme *sc, s7_pointer code) /* one entry, body is fx'd */
+{
+  s7_pointer result;
+  op_let_temp_a(sc);
+  result = fx_call(sc, sc->code);
+  pop_stack(sc);
+  let_temp_unwind(sc, sc->code, sc->args);
+  return(result);
+}
+
+static bool op_let_temp_setter(s7_scheme *sc)
+{
+  s7_pointer var, slot, sym, e = sc->curlet;
+  sc->code = cdr(sc->code);
+  var = caaar(sc->code);
+  sym = fx_call(sc, cdr(var));
+  set_curlet(sc, fx_call(sc, cddr(var)));
+  slot = s7_slot(sc, sym);
+  set_curlet(sc, e);
+  push_stack(sc, OP_LET_TEMP_SETTER_UNWIND, slot_setter(slot), slot);
+  slot_set_setter(slot, sc->F);
+  sc->code = cdr(sc->code);
+  return(is_pair(sc->code)); /* sc->code can be null if no body */
+}
+
+static void op_let_temp_setter_unwind(s7_scheme *sc)
+{
+  slot_set_setter(sc->code, sc->args);
+  if (is_multiple_value(sc->value))
+    sc->value = splice_in_values(sc, multiple_value(sc->value));
+}
+
+
+/* -------------------------------- quote -------------------------------- */
+static inline s7_pointer check_quote(s7_scheme *sc, s7_pointer code)
+{
+  if (!is_pair(cdr(code)))                    /* (quote . -1) */
+    {
+      if (is_null(cdr(code)))
+	syntax_error_nr(sc, "quote: not enough arguments: ~A", 31, code);
+      syntax_error_nr(sc, "quote: stray dot?: ~A", 21, code);
+    }
+  if (is_not_null(cddr(code)))             /* (quote . (1 2)) or (quote 1 1) */
+    syntax_error_nr(sc, "quote: too many arguments ~A", 28, code);
+  pair_set_syntax_op(code, OP_QUOTE_UNCHECKED);
+  return(cadr(code));
+}
+
+
+/* -------------------------------- and -------------------------------- */
+static bool check_and(s7_scheme *sc, s7_pointer expr)
+{
+  /* this, check_or and check_if might not be called -- optimize_syntax can short-circuit it to return fx* choices */
+  s7_pointer p, code = cdr(expr);
+  int32_t any_nils = 0, len;
+
+  if (is_null(code))
+    {
+      sc->value = sc->T;
+      return(true);
+    }
+  for (len = 0, p = code; is_pair(p); p = cdr(p), len++)
+    {
+      s7_function callee = (has_fx(p)) ? fx_proc(p) : fx_choose(sc, p, sc->curlet, let_symbol_is_safe);  /* fx_proc can be nil! */
+      if (!callee) any_nils++;
+      set_fx(p, callee);
+    }
+  if (is_not_null(p))                                    /* (and . 1) (and #t . 1) */
+    syntax_error_nr(sc, "and: stray dot?: ~A", 19, expr);
+
+  if ((fx_proc(code)) &&
+      (is_proper_list_1(sc, cdr(code))))
+    {
+      if ((fx_proc(code) == fx_is_pair_s) || (fx_proc(code) == fx_is_pair_t))
+	{
+	  pair_set_syntax_op(expr, OP_AND_PAIR_P);
+	  set_opt3_sym(expr, cadar(code));
+	  set_opt2_con(expr, cadr(code));
+	}
+      else pair_set_syntax_op(expr, (any_nils > 0) ? OP_AND_AP : OP_AND_2A);
+    }
+  else
+    {
+      pair_set_syntax_op(expr, (any_nils > 0) ? OP_AND_P : OP_AND_N);
+      if ((any_nils == 1) && (len > 2))
+	{
+	  if (!has_fx(code))
+	    pair_set_syntax_op(expr, OP_AND_SAFE_P1);
+	  else
+	    if (!has_fx(cdr(code)))
+	      pair_set_syntax_op(expr, OP_AND_SAFE_P2);
+	    else
+	      if ((!has_fx(cddr(code))) && (len == 3))
+		pair_set_syntax_op(expr, OP_AND_SAFE_P3);
+	}}
+  if ((is_fx_treeable(code)) && (tis_slot(let_slots(sc->curlet)))) fx_curlet_tree(sc, code);
+  set_current_code(sc, sc->code);
+  return(false);
+}
+
+static bool op_and_pair_p(s7_scheme *sc)
+{
+  if (!is_pair(lookup(sc, opt3_sym(sc->code)))) /* cadadr(sc->code) */
+    {
+      sc->value = sc->F;
+      return(true);
+    }
+  sc->code = opt2_con(sc->code);                /* caddr(sc->code); */
+  return(false);
+}
+
+static bool op_and_ap(s7_scheme *sc)
+{
+  /* we know fx_proc is set on sc->code, and there are only two branches */
+  if (is_false(sc, fx_call(sc, cdr(sc->code))))
+    {
+      sc->value = sc->F;
+      return(true);
+    }
+  sc->code = caddr(sc->code);
+  return(false);
+}
+
+static void op_and_safe_p1(s7_scheme *sc) /* sc->code: (and (func...) (fx...)...) */
+{
+  sc->code = cdr(sc->code); /* new value will be pushed below */
+  push_stack_no_args_direct(sc, OP_AND_SAFE_P_REST);
+  sc->code = car(sc->code);
+}
+
+static bool op_and_safe_p2(s7_scheme *sc)
+{
+  sc->value = fx_call(sc, cdr(sc->code));
+  if (is_false(sc, sc->value)) return(true);
+  sc->code = cddr(sc->code);
+  push_stack_no_args_direct(sc, OP_AND_SAFE_P_REST);
+  sc->code = car(sc->code);
+  return(false);
+}
+
+static bool op_and_safe_p3(s7_scheme *sc)
+{
+  sc->value = fx_call(sc, cdr(sc->code));
+  if (is_false(sc, sc->value)) return(true);
+  sc->code = cddr(sc->code);
+  sc->value = fx_call(sc, sc->code);
+  if (is_false(sc, sc->value)) return(true);
+  sc->code = cadr(sc->code);
+  return(false);
+}
+
+
+/* -------------------------------- or -------------------------------- */
+static bool check_or(s7_scheme *sc, s7_pointer expr)
+{
+  s7_pointer p, code = cdr(expr);
+  bool any_nils = false;
+  if (is_null(code))
+    {
+      sc->value = sc->F;
+      return(true);
+    }
+  for (p = code; is_pair(p); p = cdr(p))
+    {
+      s7_function callee = (has_fx(p)) ? fx_proc(p) : fx_choose(sc, p, sc->curlet, let_symbol_is_safe);
+      if (!callee) any_nils = true;
+      set_fx(p, callee);
+    }
+  if (is_not_null(p))
+    syntax_error_nr(sc, "or: stray dot?: ~A", 18, expr);
+
+  if ((fx_proc(code)) &&
+      (is_proper_list_1(sc, cdr(code)))) /* list_1 of cdr so there are 2 exprs */
+    pair_set_syntax_op(expr, (any_nils) ? OP_OR_AP : OP_OR_2A);
+  else pair_set_syntax_op(expr, (any_nils) ? OP_OR_P : OP_OR_N);
+
+  if ((is_fx_treeable(code)) && (tis_slot(let_slots(sc->curlet)))) fx_curlet_tree(sc, code);
+  set_current_code(sc, sc->code);
+  return(false);
+}
+
+static bool op_or_ap(s7_scheme *sc)
+{
+  /* we know fx_proc is set on sc->code, and there are only two branches */
+  sc->value = fx_call(sc, cdr(sc->code));
+  if (is_true(sc, sc->value))
+    return(true);
+  sc->code = caddr(sc->code);
+  return(false);
+}
+
+
+/* -------------------------------- if -------------------------------- */
+static void fb_if_annotate(s7_scheme *sc, s7_pointer code, s7_pointer form)
+{
+  if (optimize_op(form) == OP_IF_A_P)
+    {
+      if (is_fxable(sc, cadr(code)))
+	{
+	  pair_set_syntax_op(form, OP_IF_A_A);
+	  fx_annotate_arg(sc, cdr(code), sc->curlet);
+	  set_opt1_pair(form, cdr(code));
+	  fb_annotate(sc, form, code, OP_IF_B_A);
+	}
+      else fb_annotate(sc, form, code, OP_IF_B_P);
+    }
+  if (optimize_op(form) == OP_IF_A_R)
+    fb_annotate(sc, form, code, OP_IF_B_R);
+  if (optimize_op(form) == OP_IF_A_N_N)
+    fb_annotate(sc, form, cdar(code), OP_IF_B_N_N);
+  if (optimize_op(form) == OP_IF_A_P_P)
+    {
+      if (is_fxable(sc, cadr(code)))
+	{
+	  set_opt1_pair(form, cdr(code));
+	  if (is_fxable(sc, caddr(code)))
+	    {
+	      pair_set_syntax_op(form, OP_IF_A_A_A); /* b_a_a never happens? */
+	      set_opt2_pair(form, cddr(code));
+	    }
+	  else
+	    {
+	      pair_set_syntax_op(form, OP_IF_A_A_P);
+	      fb_annotate(sc, form, code, OP_IF_B_A_P);
+	    }
+	  fx_annotate_args(sc, cdr(code), sc->curlet);
+	}
+      else
+	if (is_fxable(sc, caddr(code)))
+	  {
+	    pair_set_syntax_op(form, OP_IF_A_P_A);
+	    fx_annotate_args(sc, cdr(code), sc->curlet);
+	    set_opt2_pair(form, cddr(code));
+	    fb_annotate(sc, form, code, OP_IF_B_P_A);
+	  }
+	else fb_annotate(sc, form, code, OP_IF_B_P_P);
+    }
+}
+
+#define choose_if_optc(Opc, One, Reversed, Not) \
+          ((One) ? ((Reversed) ? OP_ ## Opc ## _R : \
+            ((Not) ? OP_ ## Opc ## _N : OP_ ## Opc ## _P)) : \
+            ((Not) ? OP_ ## Opc ## _N_N : OP_ ## Opc ## _P_P))
+
+static void set_if_opts(s7_scheme *sc, s7_pointer form, bool one_branch, bool reversed) /* cdr(form) == sc->code */
+{
+  s7_pointer code = cdr(form);
+  s7_pointer test = car(code);
+  bool not_case = false;
+
+  if ((!reversed) &&
+      (is_pair(test)) &&
+      (car(test) == sc->not_symbol))
+    {
+      if (!is_proper_list_1(sc, cdr(test))) return; /* (not) or (not a b) */
+      not_case = true;
+      test = cadr(test);
+    }
+
+  set_opt1_any(form, cadr(code));
+  if (!one_branch) set_opt2_any(form, caddr(code));
+
+  if (is_pair(test))
+    {
+      if (is_optimized(test))
+	{
+	  if (is_h_safe_c_nc(test)) /* replace these with fx_and* */
+	    {
+	      pair_set_syntax_op(form, choose_if_optc(IF_A, one_branch, reversed, not_case));
+	      if (not_case)
+		{
+		  set_fx(cdar(code), fx_choose(sc, cdar(code), sc->curlet, let_symbol_is_safe));
+		  if (!reversed) set_opt3_pair(form, cdadr(form));
+		}
+	      else set_fx(code, fx_choose(sc, code, sc->curlet, let_symbol_is_safe));
+	      if ((is_fx_treeable(code)) && (tis_slot(let_slots(sc->curlet)))) fx_curlet_tree(sc, code);
+	      fb_if_annotate(sc, code, form);
+	      return;
+	    }
+	  if ((is_h_safe_c_s(test)) &&
+	      (is_symbol(car(test))))
+	    {
+	      uint8_t typ = symbol_type(car(test));
+	      if (typ > 0)
+		{
+		  pair_set_syntax_op(form, choose_if_optc(IF_IS_TYPE_S, one_branch, reversed, not_case));
+		  set_opt3_byte(code, typ);
+		  if (optimize_op(form) == OP_IF_IS_TYPE_S_P_P)
+		    {
+		      if (is_fxable(sc, caddr(code)))
+			{
+			  set_opt2_pair(form, cddr(code));
+			  if (is_fxable(sc, cadr(code)))
+			    {
+			      set_opt1_pair(form, cdr(code));
+			      fx_annotate_args(sc, cdr(code), sc->curlet);
+			      pair_set_syntax_op(form, OP_IF_IS_TYPE_S_A_A);
+			    }
+			  else
+			    {
+			      set_opt1_any(form, cadr(code));
+			      pair_set_syntax_op(form, OP_IF_IS_TYPE_S_P_A);
+			      fx_annotate_arg(sc, cddr(code), sc->curlet);
+			    }
+			  if ((is_fx_treeable(code)) && (tis_slot(let_slots(sc->curlet)))) fx_curlet_tree(sc, code);
+			}
+		      else
+			if (is_fxable(sc, cadr(code)))
+			  {
+			    set_opt2_any(form, caddr(code));
+			    set_opt1_pair(form, cdr(code));
+			    fx_annotate_arg(sc, cdr(code), sc->curlet);
+			    pair_set_syntax_op(form, OP_IF_IS_TYPE_S_A_P);
+			    if ((is_fx_treeable(code)) && (tis_slot(let_slots(sc->curlet)))) fx_curlet_tree(sc, code);
+			  }}}
+	      else
+		{
+		  pair_set_syntax_op(form, choose_if_optc(IF_opSq, one_branch, reversed, not_case));
+		  if (not_case) set_opt1_pair(code, cadar(code)); /* code is cdr(if...): ((not (f sym)) ...) */
+		}
+	      clear_has_fx(code);
+	      set_opt2_sym(code, cadr(test));
+	      return;
+	    }
+	  if (is_fxable(sc, test))
+	    {
+	      if ((optimize_op(test) == OP_OR_2A) || (optimize_op(test) == OP_AND_2A))
+		{
+		  if (optimize_op(test) == OP_OR_2A)
+		    pair_set_syntax_op(form, choose_if_optc(IF_OR2, one_branch, reversed, not_case));
+		  else pair_set_syntax_op(form, choose_if_optc(IF_AND2, one_branch, reversed, not_case));
+		  clear_has_fx(code);
+		  set_opt2_pair(code, cdr(test));
+		  set_opt3_pair(code, cddr(test));
+		  return;
+		}
+	      if (optimize_op(test) == OP_AND_3A)
+		{
+		  pair_set_syntax_op(form, choose_if_optc(IF_AND3, one_branch, reversed, not_case));
+		  clear_has_fx(code);
+		  set_opt2_pair(code, cdr(test));
+		  set_opt3_pair(code, cddr(test));
+		  set_opt1_pair(code, cdddr(test));
+		  return;
+		}
+
+	      pair_set_syntax_op(form, choose_if_optc(IF_A, one_branch, reversed, not_case));
+	      if (not_case)
+		{
+		  set_fx_direct(cdar(code), fx_choose(sc, cdar(code), sc->curlet, let_symbol_is_safe));
+		  if (!reversed) set_opt3_pair(form, cdadr(form));
+		}
+	      else set_fx_direct(code, fx_choose(sc, code, sc->curlet, let_symbol_is_safe));
+	      fb_if_annotate(sc, code, form);
+	    }
+	  else
+	    {
+	      pair_set_syntax_op(form, choose_if_optc(IF_P, one_branch, reversed, not_case));
+	      set_opt2_any(code, (one_branch) ? cadr(code) : cdr(code));
+	      set_opt3_any(code, (not_case) ? cadar(code) : car(code));
+	    }
+	  if ((is_fx_treeable(code)) && (tis_slot(let_slots(sc->curlet))))
+	    fx_curlet_tree(sc, code);
+	}
+      else
+	{
+	  pair_set_syntax_op(form, choose_if_optc(IF_P, one_branch, reversed, not_case));
+	  clear_has_fx(code);
+	  set_opt2_any(code, (one_branch) ? cadr(code) : cdr(code));
+	  set_opt3_any(code, (not_case) ? cadar(code) : car(code));
+	  if (is_symbol_and_syntactic(car(test)))
+	    {
+	      pair_set_syntax_op(test, symbol_syntax_op_checked(test));
+	      if ((symbol_syntax_op(car(test)) == OP_AND) ||
+		  (symbol_syntax_op(car(test)) == OP_OR))
+		{
+		  opcode_t new_op;
+		  if (symbol_syntax_op(car(test)) == OP_AND)
+		    check_and(sc, test);
+		  else check_or(sc, test);
+		  new_op = symbol_syntax_op_checked(test);
+		  if ((new_op == OP_AND_P) || (new_op == OP_AND_AP) || (new_op == OP_AND_PAIR_P) ||
+		      (new_op == OP_AND_N) || (new_op == OP_AND_SAFE_P1) || (new_op == OP_AND_SAFE_P2) || (new_op == OP_AND_SAFE_P3))
+		    {
+		      pair_set_syntax_op(form, choose_if_optc(IF_ANDP, one_branch, reversed, not_case));
+		      set_opt2_any(code, (one_branch) ? cadr(code) : cdr(code));
+		      set_opt3_pair(code, (not_case) ? cdadar(code) : cdar(code));
+		    }
+		  else
+		    if ((new_op == OP_OR_P) || (new_op == OP_OR_AP))
+		      {
+			pair_set_syntax_op(form, choose_if_optc(IF_ORP, one_branch, reversed, not_case));
+			set_opt2_any(code, (one_branch) ? cadr(code) : cdr(code));
+			set_opt3_pair(code, (not_case) ? cdadar(code) : cdar(code));
+		      }}}}}
+  else /* test is symbol or constant, but constant here is nutty */
+    if (is_safe_symbol(test))
+      {
+	pair_set_syntax_op(form, choose_if_optc(IF_S, one_branch, reversed, not_case));
+	if (not_case) set_opt1_sym(code, cadar(code)); /* code is cdr(if...): ((not sym) ...) */
+	if (optimize_op(form) == OP_IF_S_P_P)
+	  {
+	    if (is_fxable(sc, caddr(code)))
+	      {
+		if ((is_fx_treeable(code)) && (tis_slot(let_slots(sc->curlet)))) fx_curlet_tree(sc, code);
+		set_opt2_pair(form, cddr(code)); /* opt1_any set above to cadr(code) */
+		if (is_fxable(sc, cadr(code)))
+		  {
+		    pair_set_syntax_op(form, OP_IF_S_A_A);
+		    fx_annotate_args(sc, cdr(code), sc->curlet);
+		    set_opt1_pair(form, cdr(code));
+		  }
+		else
+		  {
+		    pair_set_syntax_op(form, OP_IF_S_P_A);
+		    fx_annotate_arg(sc, cddr(code), sc->curlet);
+		  }
+		if ((is_fx_treeable(code)) && (tis_slot(let_slots(sc->curlet)))) fx_curlet_tree(sc, code);
+	      }
+	    else
+	      if (is_fxable(sc, cadr(code)))
+		{
+		  pair_set_syntax_op(form, OP_IF_S_A_P);
+		  fx_annotate_arg(sc, cdr(code), sc->curlet);
+		  if ((is_fx_treeable(code)) && (tis_slot(let_slots(sc->curlet)))) fx_curlet_tree(sc, code);
+		  set_opt1_pair(form, cdr(code));
+		  set_opt2_any(form, caddr(code));
+		}}}
+}
+
+/* (cond <> (else <>)) only happens in old-fashioned code, so set_if_opts covers if/when/unless but not cond */
+
+static s7_pointer check_if(s7_scheme *sc, s7_pointer form)
+{
+  s7_pointer cdr_code, code = cdr(form);
+  if (!is_pair(code))                                /* (if) or (if . 1) */
+    syntax_error_nr(sc, "(if): if needs at least 2 expressions: ~A", 41, form);
+
+  cdr_code = cdr(code);
+  if (!is_pair(cdr_code))                            /* (if 1) */
+    {
+      if (is_null(cdr(code)))
+	syntax_error_nr(sc, "~S: if needs another clause", 27, form);
+      syntax_error_nr(sc, "~S: stray dot?", 14, form);    /* (if 1 . 2) */
+    }
+
+  if (is_pair(cdr(cdr_code)))
+    {
+      if (is_not_null(cddr(cdr_code)))               /* (if 1 2 3 4) */
+	syntax_error_nr(sc, "too many clauses for if: ~A", 27, form);
+    }
+  else
+    if (is_not_null(cdr(cdr_code)))                  /* (if 1 2 . 3) */
+      syntax_error_nr(sc, "if: ~A has improper list?", 25, form);
+
+  pair_set_syntax_op(form, OP_IF_UNCHECKED);
+  set_if_opts(sc, form, is_null(cdr(cdr_code)), false);
+  set_current_code(sc, sc->code);
+  return(code);
+}
+
+static void op_if(s7_scheme *sc)
+{
+  sc->code = check_if(sc, sc->code);
+  push_stack_no_args(sc, OP_IF1, cdr(sc->code));
+  sc->code = car(sc->code);
+}
+
+static void op_if_unchecked(s7_scheme *sc)
+{
+  push_stack_no_args(sc, OP_IF1, cddr(sc->code));
+  sc->code = cadr(sc->code);
+}
+
+static bool op_if1(s7_scheme *sc)
+{
+  sc->code = (is_true(sc, sc->value)) ? T_Pos(car(sc->code)) : T_Pos(unchecked_car(cdr(sc->code)));
+  /* even pre-optimization, (if #f #f) ==> #<unspecified> because unique_car(sc->nil) = sc->unspecified */
+  if (is_pair(sc->code))
+    return(true);
+  sc->value = (is_symbol(sc->code)) ? lookup_checked(sc, sc->code) : sc->code;
+  return(false);
+}
+
+
+/* -------------------------------- when -------------------------------- */
+static void check_when(s7_scheme *sc)
+{
+  s7_pointer form = sc->code, code = cdr(sc->code);
+
+  if (!is_pair(code))                                            /* (when) or (when . 1) */
+    syntax_error_nr(sc, "when has no expression or body:  ~A", 35, form);
+  if (!is_pair(cdr(code)))                                       /* (when 1) or (when 1 . 1) */
+    syntax_error_nr(sc, "when has no body?:  ~A", 22, form);
+  if (!s7_is_proper_list(sc, cddr(code)))
+    syntax_error_nr(sc, "when: stray dot? ~A", 19, form);
+
+  pair_set_syntax_op(form, OP_WHEN_P);
+  if (is_null(cddr(code)))
+    set_if_opts(sc, form, true, false); /* use if where possible */
+  else
+    {
+      s7_pointer test = car(code);
+      if (is_safe_symbol(test))
+	{
+	  pair_set_syntax_op(form, OP_WHEN_S);
+	  set_opt2_con(form, cadr(code));
+	  set_opt3_pair(form, cddr(code));
+	}
+      else
+	/* fxable body doesn't happen very often -- a dozen or so hits in the standard tests */
+	if (is_fxable(sc, test))
+	  {
+	    pair_set_syntax_op(form, OP_WHEN_A);
+	    if (is_pair(car(code))) set_opt2_pair(form, cdar(code));
+	    set_opt3_pair(form, cdr(code));
+	    set_fx_direct(code, fx_choose(sc, code, sc->curlet, let_symbol_is_safe)); /* "A" in when_a */
+
+	    if (fx_proc(code) == fx_and_2a)
+	      pair_set_syntax_op(form, OP_WHEN_AND_2A);
+	    else
+	      if (fx_proc(code) == fx_and_3a)
+		pair_set_syntax_op(form, OP_WHEN_AND_3A);
+	  }
+	else
+	  if ((is_pair(test)) && (car(test) == sc->and_symbol))
+	    {
+	      opcode_t new_op;
+	      pair_set_syntax_op(test, symbol_syntax_op_checked(test));
+	      check_and(sc, test);
+	      new_op = symbol_syntax_op_checked(test);
+	      if (new_op == OP_AND_AP)
+		pair_set_syntax_op(form, OP_WHEN_AND_AP);
+	    }}
+  push_stack_no_args(sc, OP_WHEN_PP, cdr(code));
+  set_current_code(sc, sc->code);
+  sc->code = car(code);
+}
+
+static bool op_when_s(s7_scheme *sc)
+{
+  if (is_true(sc, lookup(sc, cadr(sc->code))))
+    {
+      push_stack_no_args(sc, sc->begin_op, opt3_pair(sc->code)); /* cdddr(sc->code) */
+      sc->code = opt2_con(sc->code);                             /* caddr(sc->code) */
+      return(false);
+    }
+  sc->value = sc->unspecified;
+  return(true);
+}
+
+static bool op_when_a(s7_scheme *sc)
+{
+  if (is_true(sc, fx_call(sc, cdr(sc->code))))
+    {
+      push_stack_no_args(sc, sc->begin_op, T_Pair(cdr(opt3_pair(sc->code)))); /* cdddr(sc->code) */
+      sc->code = car(opt3_pair(sc->code));                                    /* caddr(sc->code) */
+      return(false);
+    }
+  sc->value = sc->unspecified;
+  return(true);
+}
+
+static bool op_when_and_2a(s7_scheme *sc)
+{
+  if ((is_true(sc, fx_call(sc, opt2_pair(sc->code)))) && (is_true(sc, fx_call(sc, cdr(opt2_pair(sc->code))))))
+    {
+      push_stack_no_args(sc, sc->begin_op, T_Pair(cdr(opt3_pair(sc->code)))); /* cdddr(sc->code) */
+      sc->code = car(opt3_pair(sc->code));                                    /* caddr(sc->code) */
+      return(false);
+    }
+  sc->value = sc->unspecified;
+  return(true);
+}
+
+static bool op_when_and_3a(s7_scheme *sc)
+{
+  if ((is_true(sc, fx_call(sc, opt2_pair(sc->code)))) &&
+      (is_true(sc, fx_call(sc, cdr(opt2_pair(sc->code))))) &&
+      (is_true(sc, fx_call(sc, cddr(opt2_pair(sc->code))))))
+    {
+      push_stack_no_args(sc, sc->begin_op, T_Pair(cdr(opt3_pair(sc->code)))); /* cdddr(sc->code) */
+      sc->code = car(opt3_pair(sc->code));                                    /* caddr(sc->code) */
+      return(false);
+    }
+  sc->value = sc->unspecified;
+  return(true);
+}
+
+static void op_when_p(s7_scheme *sc)
+{
+  push_stack_no_args(sc, OP_WHEN_PP, cddr(sc->code));
+  sc->code = cadr(sc->code);
+}
+
+static bool op_when_and_ap(s7_scheme *sc)
+{
+  s7_pointer andp = cdadr(sc->code);
+  if (is_true(sc, fx_call(sc, andp)))
+    {
+      push_stack_no_args(sc, OP_WHEN_PP, cddr(sc->code));
+      sc->code = cadr(andp);
+      return(false);
+    }
+  sc->value = sc->unspecified;
+  return(true);
+}
+
+static bool op_when_pp(s7_scheme *sc)
+{
+  if (is_true(sc, sc->value))
+    {
+      if_pair_set_up_begin_unchecked(sc);
+      return(false);
+    }
+  sc->value = sc->unspecified;
+  return(true);
+}
+
+
+/* -------------------------------- unless -------------------------------- */
+static void check_unless(s7_scheme *sc)
+{
+  s7_pointer form = sc->code, code = cdr(sc->code);
+
+  if (!is_pair(code))                                            /* (unless) or (unless . 1) */
+    syntax_error_nr(sc, "unless has no expression or body:  ~A", 37, form);
+  if (!is_pair(cdr(code)))                                       /* (unless 1) or (unless 1 . 1) */
+    syntax_error_nr(sc, "unless has no body?:  ~A", 24, form);
+  if (!s7_is_proper_list(sc, cddr(code)))
+    syntax_error_nr(sc, "unless: stray dot? ~A", 21, form);
+
+  pair_set_syntax_op(form, OP_UNLESS_P);
+  if (is_null(cddr(code)))
+    set_if_opts(sc, form, true, true);
+  else
+    if (is_safe_symbol(car(code)))
+      {
+	pair_set_syntax_op(form, OP_UNLESS_S);
+	set_opt2_con(form, cadr(code));
+	set_opt3_pair(form, cddr(code));
+      }
+    else
+      if (is_fxable(sc, car(code)))
+	{
+	  pair_set_syntax_op(form, OP_UNLESS_A);
+	  set_opt2_con(form, cadr(code));
+	  set_opt3_pair(form, cddr(code));
+	  set_fx_direct(code, fx_choose(sc, code, sc->curlet, let_symbol_is_safe));
+	}
+  push_stack_no_args(sc, OP_UNLESS_PP, cdr(code));
+  set_current_code(sc, sc->code);
+  sc->code = car(code);
+}
+
+static bool op_unless_s(s7_scheme *sc)
+{
+  if (is_false(sc, lookup(sc, cadr(sc->code))))
+    {
+      push_stack_no_args(sc, sc->begin_op, opt3_pair(sc->code)); /* cdddr(sc->code) */
+      sc->code = opt2_con(sc->code);                             /* caddr(sc->code) */
+      return(false);
+    }
+  sc->value = sc->unspecified;
+  return(true);
+}
+
+static bool op_unless_a(s7_scheme *sc)
+{
+  if (is_false(sc, fx_call(sc, cdr(sc->code))))
+    {
+      push_stack_no_args(sc, sc->begin_op, opt3_pair(sc->code)); /* cdddr(sc->code) */
+      sc->code = opt2_con(sc->code);                             /* caddr(sc->code) */
+      return(false);
+    }
+  sc->value = sc->unspecified;
+  return(true);
+}
+
+static void op_unless_p(s7_scheme *sc)
+{
+  push_stack_no_args(sc, OP_UNLESS_PP, cddr(sc->code));
+  sc->code = cadr(sc->code);
+}
+
+static bool op_unless_pp(s7_scheme *sc)
+{
+  if (is_false(sc, sc->value))
+    {
+      if_pair_set_up_begin_unchecked(sc);
+      return(false);
+    }
+  sc->value = sc->unspecified;
+  return(true);
+}
+
+
+/* -------------------------------- begin -------------------------------- */
+static bool op_begin(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer form = cdr(code);
+  if (!s7_is_proper_list(sc, form))    /* proper list includes () */
+    syntax_error_nr(sc, "unexpected dot? ~A", 18, code);
+  if (is_null(form))                   /* (begin) -> () */
+    {
+      sc->value = sc->nil;
+      return(true);
+    }
+  pair_set_syntax_op(sc->code, ((is_pair(cdr(form))) && (is_null(cddr(form)))) ? OP_BEGIN_2_UNCHECKED : OP_BEGIN_UNCHECKED); /* begin_1 doesn't happen much */
+  return(false);
+}
+
+
+/* -------------------------------- define -------------------------------- */
+static s7_pointer print_truncate(s7_scheme *sc, s7_pointer code)
+{
+  if (tree_len(sc, code) > sc->print_length)
+    {
+      s7_pointer obj;
+      s7_int old_len;
+      old_len = sc->print_length;
+      sc->print_length = old_len * 10;
+      obj = object_to_string_truncated(sc, code);
+      sc->print_length = old_len;
+      return(obj);
+    }
+  return(code);
+}
+
+static void check_define(s7_scheme *sc)
+{
+  s7_pointer func, caller, code = cdr(sc->code);
+  bool starred = (sc->cur_op == OP_DEFINE_STAR);
+  if (starred)
+    {
+      caller = sc->define_star_symbol;
+      sc->cur_op = OP_DEFINE_STAR_UNCHECKED;
+    }
+  else caller = (sc->cur_op == OP_DEFINE) ? sc->define_symbol : sc->define_constant_symbol;
+
+  if (!is_pair(code))
+    syntax_error_with_caller_nr(sc, "~A: nothing to define? ~A", 25, caller, sc->code); /* (define) */
+
+  if (!is_pair(cdr(code)))
+    {
+      if (is_null(cdr(code)))
+	syntax_error_with_caller_nr(sc, "~A: no value? ~A", 16, caller, sc->code);  /* (define var) */
+      syntax_error_with_caller_nr(sc, "~A: stray dot? ~A", 17, caller, sc->code);   /* (define var . 1) */
+    }
+  if (!is_pair(car(code)))
+    {
+      if (is_not_null(cddr(code)))                                               /* (define var 1 . 2) */
+	error_nr(sc, sc->syntax_error_symbol,
+		 set_elist_3(sc, wrap_string(sc, "~A: more than one value? ~A", 27), caller, print_truncate(sc, sc->code)));
+      if (starred)
+	syntax_error_nr(sc, "define* is restricted to functions: ~S", 38, sc->code);
+
+      func = car(code);
+      if (!is_symbol(func))                                                      /* (define 3 a) */
+	syntax_error_with_caller2_nr(sc, "~A: can't define ~W (~A); it should be a symbol", 47, caller, func, object_type_name(sc, func));
+      if (is_keyword(func))                                                      /* (define :hi 1) */
+	syntax_error_with_caller_nr(sc, "~A ~A: keywords are constants", 29, caller, func);
+      if (is_syntactic_symbol(func))                                             /* (define and a) */
+	{
+	  if (sc->safety > NO_SAFETY)
+	    s7_warn(sc, 256, "%s: syntactic keywords tend to behave badly if redefined: %s\n", display(func), display_truncated(sc->code));
+	  set_local(func);
+	}
+
+      if ((is_pair(cadr(code))) &&               /* look for (define sym (lambda ...)) and treat it like (define (sym ...)...) */
+	  ((caadr(code) == sc->lambda_symbol) ||
+	   (caadr(code) == sc->lambda_star_symbol)) &&
+	  (symbol_id(caadr(code)) == 0))
+	{
+	  if ((is_global(func)) && (is_immutable(global_slot(func))) && (initial_value(func) != sc->undefined))
+	    immutable_object_error_nr(sc, set_elist_3(sc, wrap_string(sc, "can't ~A ~S: it is immutable", 28), caller, func));
+
+	  /* not is_global here because that bit might not be set for initial symbols (why not? -- redef as method etc) */
+	  if (!is_pair(cdadr(code)))                                             /* (define x (lambda . 1)) */
+	    syntax_error_with_caller_nr(sc, "~A: stray dot? ~A", 17, caller, sc->code);
+	  if (!is_pair(cddr(cadr(code))))                                        /* (define f (lambda (arg))) */
+	    syntax_error_with_caller_nr(sc, "~A: no body: ~A", 15, caller, sc->code);
+	  if (caadr(code) == sc->lambda_star_symbol)
+	    check_lambda_star_args(sc, cadadr(code), cddr(cadr(code)), cadr(code));
+	  else check_lambda_args(sc, cadadr(code), NULL, cadr(code));
+	  optimize_lambda(sc, caadr(code) == sc->lambda_symbol, func, cadadr(code), cddr(cadr(code)));
+	}}
+  else
+    {
+      func = caar(code);
+      if (!is_symbol(func))                                                      /* (define (3 a) a) */
+	syntax_error_with_caller2_nr(sc, "~A: can't define ~S, ~A (should be a symbol)", 44, caller, func, object_type_name(sc, func));
+      if (is_syntactic_symbol(func))                                             /* (define (and a) a) */
+	{
+	  if (sc->safety > NO_SAFETY)
+	    s7_warn(sc, 256, "%s: syntactic keywords tend to behave badly if redefined: %s\n", display(func), display_truncated(sc->code));
+	  set_local(func);
+	}
+      if ((is_global(func)) && (is_immutable(global_slot(func))) && (initial_value(func) != sc->undefined))     /* (define (abs x) 1) after (immutable! abs) */
+	immutable_object_error_nr(sc, set_elist_3(sc, wrap_string(sc, "can't ~A ~S: it is immutable", 28), caller, func));
+      if (starred)
+	set_cdar(code, check_lambda_star_args(sc, cdar(code), cdr(code), sc->code));
+      else check_lambda_args(sc, cdar(code), NULL, sc->code);
+      optimize_lambda(sc, !starred, func, cdar(code), cdr(code));
+    }
+
+  if (sc->cur_op == OP_DEFINE)
+    {
+      if ((is_pair(car(code))) &&
+	  (!is_possibly_constant(func)))
+	pair_set_syntax_op(sc->code, OP_DEFINE_FUNCHECKED);
+      else pair_set_syntax_op(sc->code, OP_DEFINE_UNCHECKED);
+    }
+  else pair_set_syntax_op(sc->code, (starred) ? OP_DEFINE_STAR_UNCHECKED : OP_DEFINE_CONSTANT_UNCHECKED);
+}
+
+static bool op_define_unchecked(s7_scheme *sc)
+{
+  s7_pointer code = cdr(sc->code), locp;
+
+  if ((is_pair(car(code))) && (has_location(car(code))))
+    locp = car(code);
+  else locp = ((is_pair(cadr(code))) && (has_location(cadr(code)))) ? cadr(code) : sc->nil;
+
+  if ((sc->cur_op == OP_DEFINE_STAR_UNCHECKED) && /* sc->cur_op changed above if define* */
+      (is_pair(cdar(code))))
+    {
+      sc->value = make_closure(sc, cdar(code), cdr(code), T_CLOSURE_STAR, CLOSURE_ARITY_NOT_SET);
+      /* closure_body might not be cdr(code) after make_closure (add_trace) */
+      if ((is_pair(locp)) && (has_location(locp)))
+	{
+	  pair_set_location(closure_body(sc->value), pair_location(locp));
+	  set_has_location(closure_body(sc->value));
+	}
+      sc->code = caar(code);
+      return(false);
+    }
+
+  if (!is_pair(car(code)))
+    {
+      s7_pointer x = car(code);
+      sc->code = cadr(code);
+      if (is_pair(sc->code))
+	{
+	  push_stack_no_args(sc, OP_DEFINE1, x);
+	  sc->cur_op = optimize_op(sc->code);
+	  return(true);
+	}
+      sc->value = (is_symbol(sc->code)) ? lookup_global(sc, sc->code) : sc->code;
+      sc->code = x;
+    }
+  else
+    {
+      s7_pointer args = cdar(code);
+      /* a closure.  If we called this same code earlier (a local define), the only thing
+       *   that is new here is the environment -- we can't blithely save the closure object
+       *   in opt2 somewhere, and pick it up the next time around (since call/cc might take
+       *   us back to the previous case).  We also can't re-use opt2(sc->code) because opt2
+       *   is not cleared in the gc.
+       */
+      s7_pointer x = make_closure(sc, args, cdr(code), T_CLOSURE | ((!s7_is_proper_list(sc, args)) ? T_COPY_ARGS : 0), (is_null(args)) ? 0 : CLOSURE_ARITY_NOT_SET);
+      if ((is_pair(locp)) && (has_location(locp)))
+	{
+	  pair_set_location(closure_body(x), pair_location(locp));
+	  set_has_location(closure_body(x));
+	}
+      sc->value = T_Ext(x);
+      sc->code = caar(code);
+    }
+  return(false);
+}
+
+static s7_pointer make_funclet(s7_scheme *sc, s7_pointer new_func, s7_pointer func_name, s7_pointer outer_let)
+{
+  s7_pointer new_let, arg;
+  new_cell_no_check(sc, new_let, T_LET | T_FUNCLET);
+  let_set_id(new_let, ++sc->let_number);
+  let_set_outlet(new_let, outer_let);
+  closure_set_let(new_func, new_let);
+  funclet_set_function(new_let, func_name); /* *function* returns at least funclet_function */
+  let_set_slots(new_let, slot_end);
+
+  arg = closure_args(new_func);
+  if (is_null(arg))
+    {
+      let_set_slots(new_let, slot_end);
+      return(new_let);
+    }
+
+  if (is_safe_closure(new_func))
+    {
+      s7_pointer last_slot = NULL;
+      if (is_closure(new_func))
+	{
+	  if (is_pair(arg))
+	    {
+	      last_slot = make_slot(sc, car(arg), sc->nil);
+	      slot_set_next(last_slot, slot_end);
+	      let_set_slots(new_let, last_slot);
+	      symbol_set_local_slot(car(arg), let_id(new_let), last_slot);
+	      for (arg = cdr(arg); is_pair(arg); arg = cdr(arg))
+		last_slot = inline_add_slot_at_end(sc, let_id(new_let), last_slot, car(arg), sc->nil);
+	    }
+	  if (is_symbol(arg))
+	    {
+	      if (last_slot)
+		last_slot = add_slot_at_end(sc, let_id(new_let), last_slot, arg, sc->nil);
+	      else
+		{
+		  last_slot = make_slot(sc, arg, sc->nil);
+		  slot_set_next(last_slot, slot_end);
+		  let_set_slots(new_let, last_slot);
+		  symbol_set_local_slot(arg, let_id(new_let), last_slot);
+		}
+	      set_is_rest_slot(last_slot);
+	    }}
+      else /* closure_star */
+	{
+	  s7_pointer slot, first_default = sc->nil;
+	  let_set_slots(new_let, slot_end);
+	  for (; is_pair(arg); arg = cdr(arg))
+	    {
+	      s7_pointer par = car(arg);
+	      if (is_pair(par))
+		{
+		  s7_pointer val = cadr(par);
+		  slot = add_slot_checked(sc, new_let, car(par), sc->nil);
+		  slot_set_expression(slot, val);
+		  if ((is_symbol(val)) || (is_pair(val)))
+		    {
+		      if (is_null(first_default))
+			first_default = slot;
+		      set_slot_defaults(slot);
+		    }}
+	      else
+		if (is_keyword(par))
+		  {
+		    if (par == sc->rest_keyword)
+		      {
+			arg = cdr(arg);
+			slot = add_slot_checked(sc, new_let, car(arg), sc->nil);
+			slot_set_expression(slot, sc->nil);
+		      }}
+		else
+		  {
+		    slot = add_slot_checked(sc, new_let, par, sc->nil);
+		    slot_set_expression(slot, sc->F);
+		  }}
+	  if (is_symbol(arg))
+	    {
+	      slot = add_slot_checked(sc, new_let, arg, sc->nil);     /* set up rest arg */
+	      set_is_rest_slot(slot);
+	      slot_set_expression(slot, sc->nil);
+	    }
+	  if (tis_slot(let_slots(new_let)))
+	    {
+	      let_set_slots(new_let, reverse_slots(let_slots(new_let)));
+	      slot_set_pending_value(let_slots(new_let), first_default);
+	    }}
+      set_immutable_let(new_let);
+    }
+  else let_set_slots(new_let, slot_end); /* if unsafe closure, arg-holding-let will be created on each call */
+  return(new_let);
+}
+
+static bool op_define_constant(s7_scheme *sc)
+{
+  s7_pointer code = cdr(sc->code);
+  if ((!is_pair(code)) || (!is_pair(cdr(code)))) /* (define-constant) */
+    syntax_error_nr(sc, "define-constant: not enough arguments: ~S", 41, sc->code);
+
+  if (is_symbol_and_keyword(car(code)))        /* (define-constant :rest :allow-other-keys) */
+    {
+      if (car(code) == cadr(code))             /* (define-constant pi pi) returns pi */
+	{
+	  sc->value = car(code);
+	  return(true);
+	}
+      syntax_error_with_caller_nr(sc, "~A ~A: keywords are constants", 29, sc->define_constant_symbol, car(code));
+    }
+  if ((is_symbol(car(code))) &&                /* (define-constant abs abs): "abs will not be touched" */
+      (car(code) == cadr(code)) &&
+      (symbol_id(car(code)) == 0) &&           /* else (let iter ... (define-constant iter iter) ...) -> segfault on later calls */
+      (is_null(cddr(code))))
+    {
+      s7_pointer sym = car(code);
+      set_immutable_slot(global_slot(sym)); /* id == 0 so its global */
+      set_possibly_constant(sym);
+      sc->value = lookup_checked(sc, car(code));
+      return(true);
+    }
+  push_stack_no_args(sc, OP_DEFINE_CONSTANT1, car(code));
+  return(false);
+}
+
+static void op_define_constant1(s7_scheme *sc)
+{
+  if (is_pair(sc->code))
+    sc->code = car(sc->code); /* (define-constant (ex3 a)...) */
+  if (is_symbol(sc->code))
+    {
+      s7_pointer slot = s7_slot(sc, sc->code);
+      set_possibly_constant(sc->code);
+      set_immutable_slot(slot);
+      if (is_any_closure(slot_value(slot)))
+	set_immutable(slot_value(slot)); /* for the optimizer mainly */
+    }
+}
+
+static inline void define_funchecked(s7_scheme *sc)
+{
+  s7_pointer new_func, code = cdr(sc->code);
+  sc->value = caar(code); /* func name */
+
+  new_cell(sc, new_func, T_CLOSURE | ((!s7_is_proper_list(sc, cdar(code))) ? T_COPY_ARGS : 0));
+  closure_set_args(new_func, cdar(code));
+  closure_set_body(new_func, cdr(code));
+  if (is_pair(cddr(code))) set_closure_has_multiform(new_func); else set_closure_has_one_form(new_func);
+  closure_set_setter(new_func, sc->F);
+  closure_set_arity(new_func, CLOSURE_ARITY_NOT_SET);
+  sc->capture_let_counter++;
+
+  if (is_safe_closure_body(cdr(code)))
+    {
+      set_safe_closure(new_func);
+      if (is_very_safe_closure_body(cdr(code)))
+	set_very_safe_closure(new_func);
+      make_funclet(sc, new_func, sc->value, sc->curlet);
+    }
+  else closure_set_let(new_func, sc->curlet);  /* unsafe closures created by other functions do not support *function* */
+
+  if (let_id(sc->curlet) < symbol_id(sc->value))
+    sc->let_number++; /* dummy let, force symbol lookup */
+  add_slot_unchecked(sc, sc->curlet, sc->value, new_func, sc->let_number);
+  sc->value = new_func;
+}
+
+static s7_pointer check_define_macro(s7_scheme *sc, opcode_t op, s7_pointer form)
+{
+  s7_pointer mac_name, args, caller = cur_op_to_caller(sc, op);
+
+  if (!is_pair(sc->code))                                           /* (define-macro . 1) */
+    syntax_error_with_caller_nr(sc, "~A name missing (stray dot?): ~A", 32, caller, sc->code);
+  if (!is_pair(car(sc->code)))                                      /* (define-macro a ...) */
+    wrong_type_error_nr(sc, caller, 1, car(sc->code), wrap_string(sc, "a list: (name ...)", 18));
+
+  mac_name = caar(sc->code);
+  if (!is_symbol(mac_name))
+    syntax_error_with_caller_nr(sc, "~A: ~S is not a symbol?", 23, caller, mac_name);
+  if (is_syntactic_symbol(mac_name))
+    {
+      if (sc->safety > NO_SAFETY)
+	s7_warn(sc, 256, "%s: syntactic keywords tend to behave badly if redefined: %s\n", display(mac_name), display_truncated(sc->code));
+      set_local(mac_name);
+    }
+  if (is_constant_symbol(sc, mac_name))
+    syntax_error_with_caller_nr(sc, "~A: ~S is constant", 18, caller, mac_name);
+
+  if (!is_pair(cdr(sc->code)))                                    /* (define-macro (...)) */
+    syntax_error_with_caller_nr(sc, "~A ~A, but no body?", 19, caller, mac_name);
+
+  if (s7_list_length(sc, cdr(sc->code)) < 0)                      /* (define-macro (hi) 1 . 2) */
+    error_nr(sc, sc->syntax_error_symbol,
+	     set_elist_3(sc, wrap_string(sc, "~A: macro body messed up, ~A", 28), caller, sc->code));
+
+  args = cdar(sc->code);
+  if ((!is_list(args)) &&
+      (!is_symbol(args)))
+    error_nr(sc, sc->syntax_error_symbol,                      /* (define-macro (mac . 1) ...) */
+	     set_elist_3(sc, wrap_string(sc, "macro ~A argument list is ~S?", 29), mac_name, args));
+
+  if ((op == OP_DEFINE_MACRO) || (op == OP_DEFINE_BACRO) || (op == OP_DEFINE_EXPANSION))
+    {
+      for (; is_pair(args); args = cdr(args))
+	if (!is_symbol(car(args)))
+	  error_nr(sc, sc->syntax_error_symbol,                /* (define-macro (mac 1) ...) */
+		   set_elist_3(sc, wrap_string(sc, "~A parameter name, ~A, is not a symbol", 38), caller, car(args)));
+      check_lambda_args(sc, cdar(sc->code), NULL, form);
+    }
+  else set_cdar(sc->code, check_lambda_star_args(sc, args, NULL, form));
+  return(sc->code);
+}
+
+static s7_pointer check_macro(s7_scheme *sc, opcode_t op, s7_pointer form)
+{
+  s7_pointer args, caller = cur_op_to_caller(sc, op);
+
+  if (!is_pair(sc->code)) /* sc->code = cdr(form) */           /* (macro) or (macro . 1) */
+    syntax_error_with_caller_nr(sc, "~S: ~S has no parameters or body?", 33, caller, form);
+  if (!is_pair(cdr(sc->code)))                                        /* (macro (a)) */
+    syntax_error_with_caller_nr(sc, "~S: ~S has no body?", 19, caller, form);
+
+  args = car(sc->code);
+  if ((!is_list(args)) &&
+      (!is_symbol(args)))
+    error_nr(sc, sc->syntax_error_symbol,                      /* (macro #(0) ...) */
+	     set_elist_2(sc, wrap_string(sc, "macro parameter list is ~S?", 27), args));
+
+  if ((op == OP_MACRO) || (op == OP_BACRO))
+    {
+      for (; is_pair(args); args = cdr(args))
+	if (!is_symbol(car(args)))
+	  error_nr(sc, sc->syntax_error_symbol,                /* (macro (1) ...) */
+		   set_elist_3(sc, wrap_string(sc, "~A parameter name, ~A, is not a symbol", 38), caller, car(args)));
+      check_lambda_args(sc, car(sc->code), NULL, form);
+    }
+  else set_car(sc->code, check_lambda_star_args(sc, args, NULL, form));
+  if (s7_list_length(sc, cdr(sc->code)) < 0)                   /* (macro () 1 . 2) */
+    error_nr(sc, sc->syntax_error_symbol,
+	     set_elist_3(sc, wrap_string(sc, "~A: macro body messed up, ~A", 28), caller, form));
+
+  return(sc->code);
+}
+
+static void op_macro(s7_scheme *sc) /* (macro (x) `(+ ,x 1)) */
+{
+  s7_pointer form = sc->code;
+  sc->code = cdr(sc->code);
+  if ((!is_pair(sc->code)) || (!mac_is_ok(sc->code))) /* (macro)? or (macro . #\a)? */
+    {
+      check_macro(sc, sc->cur_op, form);
+      set_mac_is_ok(sc->code);
+    }
+  sc->value = make_macro(sc, sc->cur_op, false);
+}
+
+static void op_define_macro(s7_scheme *sc)
+{
+  s7_pointer form = sc->code;
+  sc->code = cdr(sc->code);
+  check_define_macro(sc, sc->cur_op, form);
+  if ((is_immutable(sc->curlet)) &&
+      (is_let(sc->curlet)))
+    syntax_error_nr(sc, "define-macro ~S: let is immutable", 33, caar(sc->code)); /* need syntax_error_any_with_caller? */
+  sc->value = make_macro(sc, sc->cur_op, true);
+}
+
+static bool unknown_any(s7_scheme *sc, s7_pointer f, s7_pointer code);
+
+static opcode_t fixup_macro_d(s7_scheme *sc, opcode_t op, s7_pointer mac)
+{
+  if (closure_arity_unknown(mac))
+    closure_set_arity(mac, s7_list_length(sc, closure_args(mac)));
+  return(op);
+}
+
+static inline bool op_macro_d(s7_scheme *sc, uint8_t typ)
+{
+  sc->value = lookup(sc, car(sc->code));
+  if (type(sc->value) != typ)                 /* for-each (etc) called a macro before, now it's something else -- a very rare case */
+    return(unknown_any(sc, sc->value, sc->code));
+
+  /* it's probably safer to always copy the list here, but that costs 4-5% in tmac, whereas this costs 3% -- maybe not worth the code? */
+  if (closure_arity(sc->value) <= 0)
+    sc->args = copy_proper_list(sc, cdr(sc->code));
+  else sc->args = cdr(sc->code);
+
+  sc->code = sc->value;                       /* the macro */
+  check_stack_size(sc);                       /* (define-macro (f) (f)) (f) */
+  push_stack_op_let(sc, OP_EVAL_MACRO);
+  set_curlet(sc, inline_make_let(sc, closure_let(sc->code)));
+  return(false);                              /* fall into apply_lambda */
+}
+
+static void apply_macro_star_1(s7_scheme *sc);
+
+static bool op_macro_star_d(s7_scheme *sc)
+{
+  if (op_macro_d(sc, T_MACRO_STAR)) return(true);
+  apply_macro_star_1(sc);
+  return(false);
+}
+
+static void transfer_macro_info(s7_scheme *sc, s7_pointer mac)
+{
+  s7_pointer body = closure_body(mac);
+  if (has_pair_macro(mac))
+    {
+      set_maclet(sc->curlet);
+      funclet_set_function(sc->curlet, pair_macro(body));
+    }
+  if (has_location(body))
+    {
+      let_set_file(sc->curlet, pair_file_number(body));
+      let_set_line(sc->curlet, pair_line_number(body));
+      set_has_let_file(sc->curlet);
+    }
+}
+
+static goto_t op_expansion(s7_scheme *sc)
+{
+  s7_pointer caller = (is_pair(stack_top_args(sc))) ? car(stack_top_args(sc)) : sc->F; /* this can be garbage */
+  if ((sc->stack_end > sc->stack_start) &&          /* there is a stack... */
+      (stack_top_op(sc) != OP_READ_QUOTE) &&        /* '(expansion ...) */
+      (stack_top_op(sc) != OP_READ_VECTOR) &&       /* #(expansion ...) */
+      (!is_quote(caller)) &&                        /* (#_quote ...) */
+      (caller != sc->macroexpand_symbol) &&         /* (macroexpand (expansion ...)) */
+      (caller != sc->define_expansion_symbol) &&    /* (define-expansion ...) being reloaded/redefined */
+      (caller != sc->define_expansion_star_symbol)) /* (define-expansion* ...) being reloaded/redefined */
+    {
+      s7_pointer symbol = car(sc->value), slot;
+      /* we're playing fast and loose with sc->curlet in the reader, so here we need a disaster check */
+      if (!is_let(sc->curlet)) set_curlet(sc, sc->rootlet);
+
+      if ((symbol_id(symbol) == 0) ||
+	  (sc->curlet == sc->nil))
+	slot = global_slot(symbol);
+      else slot = s7_slot(sc, symbol);
+
+      sc->code = (is_slot(slot)) ? slot_value(slot) : sc->undefined;
+      if ((!is_either_macro(sc->code)) || (!is_expansion(sc->code)))
+	clear_expansion(symbol);
+      else
+	{
+	  /* call the reader macro */
+	  sc->args = cdr(sc->value);
+	  push_stack_no_code(sc, OP_EXPANSION, sc->nil);
+	  set_curlet(sc, make_let(sc, closure_let(sc->code)));
+	  transfer_macro_info(sc, sc->code);
+	  if (!is_macro_star(sc->code))
+	    return(goto_apply_lambda);
+	  apply_macro_star_1(sc);
+	  return(goto_begin);
+	  /* bacros don't seem to make sense here -- they are tied to the run-time environment,
+	   *   procedures would need to evaluate their arguments in rootlet
+	   */
+	}}
+  return(fall_through);
+}
+
+static void macroexpand_c_macro(s7_scheme *sc) /* callgrind shows this when it's actually calling apply_c_function (code is identical) */
+{
+  s7_int len = proper_list_length(sc->args);
+  if (len < c_macro_min_args(sc->code))
+    error_nr(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, not_enough_arguments_string, sc->code, sc->args));
+  if (c_macro_max_args(sc->code) < len)
+    error_nr(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, too_many_arguments_string, sc->code, sc->args));
+  sc->value = c_macro_call(sc->code)(sc, sc->args);
+}
+
+static goto_t macroexpand(s7_scheme *sc)
+{
+  switch (type(sc->code))
+    {
+    case T_MACRO:
+      set_curlet(sc, make_let(sc, closure_let(sc->code)));
+      return(goto_apply_lambda);
+    case T_BACRO:
+      set_curlet(sc, make_let(sc, sc->curlet));
+      return(goto_apply_lambda);
+    case T_MACRO_STAR:
+      set_curlet(sc, make_let(sc, closure_let(sc->code)));
+      apply_macro_star_1(sc);
+      return(goto_begin);
+    case T_BACRO_STAR:
+      set_curlet(sc, make_let(sc, sc->curlet));
+      apply_macro_star_1(sc);
+      return(goto_begin);
+    case T_C_MACRO:
+      macroexpand_c_macro(sc);
+      return(goto_start);
+    default:
+      syntax_error_nr(sc, "macroexpand argument is not a macro call: ~A", 44, sc->args); /* maybe car(sc->args)? */
+    }
+  return(fall_through); /* for the compiler */
+}
+
+static goto_t op_macroexpand(s7_scheme *sc)
+{
+  s7_pointer form = sc->code;
+  sc->code = cdr(sc->code);
+  /* mimic APPLY, but don't push OP_EVAL_MACRO or OP_EXPANSION
+   *   (define-macro (mac a) `(+ ,a 1)) (macroexpand (mac 3)), sc->code: ((mac 3))
+   */
+  if ((!is_pair(sc->code)) ||
+      (!is_pair(car(sc->code))))
+    syntax_error_nr(sc, "macroexpand argument is not a macro call: ~A", 44, form);
+
+  if (!is_null(cdr(sc->code)))
+    syntax_error_nr(sc, "macroexpand: too many arguments: ~A", 35, form);
+
+  if (is_pair(caar(sc->code)))                            /* (macroexpand ((symbol->value 'mac) (+ 1 2))) */
+    {
+      push_stack_no_args_direct(sc, OP_MACROEXPAND_1);
+      sc->code = caar(sc->code);
+      return(goto_eval);
+    }
+
+  sc->args = cdar(sc->code);
+  if (!is_list(sc->args))                                  /* (macroexpand (mac . 7)) */
+    syntax_error_nr(sc, "can't macroexpand ~S: the macro's argument list is not a list", 61, car(sc->code));
+
+  if (!is_symbol(caar(sc->code)))
+    {
+      if (!is_any_macro(caar(sc->code)))
+	syntax_error_nr(sc, "macroexpand argument is not a macro call: ~A", 44, sc->code);
+      sc->code = caar(sc->code);
+      return(macroexpand(sc));
+    }
+  sc->code = lookup_checked(sc, caar(sc->code));
+  return(macroexpand(sc));
+}
+
+static goto_t op_macroexpand_1(s7_scheme *sc)
+{
+  sc->args = cdar(sc->code);
+  sc->code = sc->value;
+  return(macroexpand(sc));
+}
+
+static void op_eval_macro(s7_scheme *sc) /* after (scheme-side) macroexpansion, evaluate the resulting expression */
+{
+  /* (define-macro (hi a) `(+ ,a 1)), (hi 2), here with value: (+ 2 1) */
+  if (is_multiple_value(sc->value))
+    {
+      /* a normal macro's result is evaluated (below) and its value replaces the macro invocation,
+       *   so if a macro returns multiple values, evaluate each one, then replace the macro
+       *   invocation with (apply values evaluated-results-in-a-list).  We need to save the
+       *   new list of results, and where we are in the macro's output list, so code=macro output,
+       *   args=new list.  If it returns (values), should we use #<unspecified>?  I think that
+       *   happens now without generating a multiple_value object:
+       *       (define-macro (hi) (values)) (hi) -> #<unspecified>
+       *   (define-macro (ho) (values '(+ 1 2) '(* 3 4))) (+ 1 (ho) 3) -> 19
+       *   (define-macro (ha) (values '(define a 1) '(define b 2))) (let () (ha) (+ a b)) -> 3
+       */
+      push_stack(sc, OP_EVAL_MACRO_MV, sc->nil, cdr(sc->value));
+      sc->code = car(sc->value);
+    }
+  else sc->code = sc->value;
+}
+
+static bool op_eval_macro_mv(s7_scheme *sc)
+{
+  if (is_null(sc->code)) /* end of values list */
+    {
+      sc->value = splice_in_values(sc, multiple_value(proper_list_reverse_in_place(sc, cons(sc, sc->value, sc->args))));
+      return(true);
+    }
+  push_stack(sc, OP_EVAL_MACRO_MV, cons(sc, sc->value, sc->args), cdr(sc->code));
+  sc->code = car(sc->code);
+  return(false);
+}
+
+static void op_finish_expansion(s7_scheme *sc)
+{
+  /* after the expander has finished, if a list was returned, we need to add some annotations.
+   *   if the expander returned (values), the list-in-progress vanishes! (This mimics map and *#readers*).
+   */
+  if (SHOW_EVAL_OPS) fprintf(stderr, "  %s[%d]: op: %s, value: %s\n", __func__, __LINE__, op_names[stack_top_op(sc)], display_truncated(sc->value));
+  if (sc->value == sc->no_value)
+    {
+      if (stack_top_op(sc) != OP_LOAD_RETURN_IF_EOF) /* latter op if empty expansion at top-level */
+	{
+	  if (stack_top_op(sc) != OP_READ_LIST)      /* OP_EVAL_STRING: (eval-string "(reader-cond...)") where reader-cond returns (values) */
+	    sc->value = sc->F;                       /* (eval-string "") -> #f, was nil_string for awhile */
+	  else set_stack_top_op(sc, OP_READ_NEXT);
+	  /* OP_READ_DONE: (eval-string (object->string (with-input-from-string "(reader-cond ((provided? 'surreals) 123))" read))) */
+	}}
+  else
+    if (is_pair(sc->value))
+      sc->value = copy_body(sc, sc->value);
+}
+
+
+/* -------------------------------- with-let -------------------------------- */
+static void check_with_let(s7_scheme *sc)
+{
+  s7_pointer form = cdr(sc->code);
+
+  if (!is_pair(form))                            /* (with-let . "hi") */
+    syntax_error_nr(sc, "with-let takes an environment argument: ~A", 42, sc->code);
+  if (is_null(cdr(form)))                        /* (with-let e) */
+    syntax_error_nr(sc, "with-let has no body: ~A", 24, sc->code);
+  if (!s7_is_proper_list(sc, cdr(form)))         /* (with-let e . 3) */
+    syntax_error_nr(sc, "stray dot in with-let body: ~S", 30, sc->code);
+
+  pair_set_syntax_op(sc->code, ((is_normal_symbol(car(form))) &&
+				(is_normal_symbol(cadr(form))) && /* (with-let lt a) is not the same as (with-let lt :a) */
+				(is_null(cddr(form)))) ? OP_WITH_LET_S : OP_WITH_LET_UNCHECKED);
+  set_current_code(sc, sc->code);
+}
+
+static bool op_with_let_unchecked(s7_scheme *sc)
+{
+  sc->code = cdr(sc->code);
+  sc->value = car(sc->code);
+  if (!is_pair(sc->value))
+    {
+      if (is_symbol(sc->value))
+	sc->value = lookup_checked(sc, sc->value);
+      sc->code = cdr(sc->code);
+      return(false);
+    }
+  push_stack_no_args(sc, OP_WITH_LET1, cdr(sc->code));
+  sc->code = sc->value;   /* eval let arg */
+  return(true);
+}
+
+static s7_pointer fx_with_let_s(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer code = cdr(arg);
+  s7_pointer e = lookup_checked(sc, car(code));
+  s7_pointer sym = cadr(code);
+  s7_pointer val;
+  if (!is_let(e))
+    {
+      e = find_let(sc, e);
+      if (!is_let(e))
+	error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "with-let takes an environment argument: ~A", 42), car(code)));
+    }
+  val = let_ref(sc, e, sym); /* (with-let e s) -> (let-ref e s), "s" unevalled? */
+  if (val == sc->undefined)  /* but sym can have the value #<undefined>: (with-let (inlet 'x #<undefined>) x) */
+    {
+      if ((e == sc->s7_starlet) && (is_slot(global_slot(sym)))) /* (let () (define (func) (with-let *s7* letrec*)) (func) (func)), .5 tlet */
+	return(global_value(sym));                              /* perhaps the e=*s7* check is not needed */
+      if (is_slot(lookup_slot_with_let(sc, sym, e)))
+	return(sc->undefined);
+      unbound_variable_error_nr(sc, sym);
+    }
+  return(val);
+}
+
+static void activate_with_let(s7_scheme *sc, s7_pointer e)
+{
+  if (!is_let(e)) /* (with-let . "hi") */
+    {
+      s7_pointer new_e = find_let(sc, e); /* sc->nil here means no let found */
+      if ((!is_let(new_e)) && (!has_closure_let(e)))
+	error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "with-let takes an environment argument: ~A", 42), e));
+      e = new_e;
+    }
+  if (e == sc->rootlet)
+    set_curlet(sc, e);         /* (with-let (rootlet) ...) */
+  else
+    {
+      set_with_let_let(e);
+      let_set_id(e, ++sc->let_number);
+      set_curlet(sc, e);
+      update_symbol_ids(sc, e);
+    }
+}
+
+
+/* -------------------------------- cond -------------------------------- */
+static void check_cond(s7_scheme *sc)
+{
+  bool has_feed_to = false, result_fx = true, result_single = true;
+  s7_pointer x, code = cdr(sc->code), form = sc->code;
+
+  if (!is_pair(code))                                           /* (cond) or (cond . 1) */
+    syntax_error_nr(sc, "cond, but no body: ~A", 21, form);
+
+  for (x = code; is_pair(x); x = cdr(x))
+    if (!is_pair(car(x)))                                       /* (cond 1) or (cond (#t 1) 3) */
+      error_nr(sc, sc->syntax_error_symbol,
+	       set_elist_3(sc, wrap_string(sc, "every clause in cond must be a pair: ~S in ~A", 45),
+			   car(x), object_to_string_truncated(sc, form)));
+    else
+      {
+	s7_pointer y = car(x);
+	if (!s7_is_proper_list(sc, cdr(y)))                     /* (cond (xxx . 1)) */
+	  error_nr(sc, sc->syntax_error_symbol,
+		   set_elist_3(sc, wrap_string(sc, "stray dot? ~S in ~A", 19),
+			       y, object_to_string_truncated(sc, form)));
+	if (is_pair(cdr(y)))
+	  {
+	    if (is_pair(cddr(y))) result_single = false;
+	    if (is_undefined_feed_to(sc, cadr(y)))
+	      {
+		has_feed_to = true;
+		if (!is_pair(cddr(y)))                         /* (cond (#t =>)) or (cond (#t => . 1)) */
+		  error_nr(sc, sc->syntax_error_symbol,
+			   set_elist_3(sc, wrap_string(sc, "cond: '=>' target missing?  ~S in ~A", 36),
+				       x, object_to_string_truncated(sc, form)));
+		if (is_pair(cdddr(y)))                         /* (cond (1 => + abs)) */
+		  error_nr(sc, sc->syntax_error_symbol,
+			   set_elist_3(sc, wrap_string(sc, "cond: '=>' has too many targets: ~S in ~A", 41),
+				       x, object_to_string_truncated(sc, form)));
+	      }}
+	else result_single = false;
+      }
+  if (is_not_null(x))                                          /* (cond ((1 2)) . 1) */
+    error_nr(sc, sc->syntax_error_symbol, set_elist_2(sc, wrap_string(sc, "cond: stray dot? ~S", 19), form));
+
+  for (x = code; is_pair(x); x = cdr(x))
+    {
+      s7_pointer p = car(x);
+      /* clear_has_fx(p); */ /* a kludge -- if has_fx here (and not re-fx'd below), someone messed up earlier -- but was fx_treeable set? */
+      if (is_fxable(sc, car(p)))
+	fx_annotate_arg(sc, p, sc->curlet);
+      for (p = cdr(p); is_pair(p); p = cdr(p))
+	if (!has_fx(p))
+	  {
+	    s7_function f = fx_choose(sc, p, sc->curlet, let_symbol_is_safe);
+	    if (f) set_fx_direct(p, f); else result_fx = false;
+	  }}
+  if ((is_fx_treeable(code)) && (tis_slot(let_slots(sc->curlet)))) fx_curlet_tree(sc, code);
+
+  if (has_feed_to)
+    {
+      pair_set_syntax_op(form, OP_COND_UNCHECKED);
+      if (is_null(cdr(code)))
+	{
+	  s7_pointer expr = car(code), f;
+	  f = caddr(expr);
+	  if ((is_proper_list_3(sc, f)) &&
+	      (car(f) == sc->lambda_symbol))
+	    {
+	      s7_pointer arg = cadr(f);
+	      if ((is_pair(arg)) &&
+		  (is_null(cdr(arg))) &&
+		  (is_symbol(car(arg)))) /* (define (hi) (cond (#t => (lambda (s) s)))) */
+		{
+		  set_opt2_lambda(code, caddar(code));  /* (lambda ...) above */
+		  pair_set_syntax_op(form, OP_COND_FEED);
+		}}}}
+  else
+    {
+      s7_pointer p;
+      bool xopt = true;
+      int32_t i;
+
+      pair_set_syntax_op(form, OP_COND_SIMPLE);
+      for (i = 0, p = code; xopt && (is_pair(p)); i++, p = cdr(p))
+	xopt = ((has_fx(car(p))) && (is_pair(cdar(p))));
+      if (xopt)
+	{
+	  pair_set_syntax_op(form, (result_fx) ? OP_COND_NA_NA : ((result_single) ? OP_COND_NA_NP_O : OP_COND_NA_NP));
+          if (result_single)
+	    {
+	      if (i == 2)
+		{
+		  p = caadr(code);
+		  if ((p == sc->else_symbol) || (p == sc->T))
+		    pair_set_syntax_op(form, OP_COND_NA_2E);
+		}
+	      else
+		if (i == 3)
+		  {
+		    p = caaddr(code);
+		    if ((p == sc->else_symbol) || (p == sc->T))
+		      pair_set_syntax_op(form, OP_COND_NA_3E);
+		  }}}
+      else
+	if (result_single)
+	  pair_set_syntax_op(form, OP_COND_SIMPLE_O);
+    }
+  set_opt3_any(code, caar(code));
+}
+
+static bool op_cond_unchecked(s7_scheme *sc)
+{
+  sc->code = cdr(sc->code);
+  if (has_fx(car(sc->code)))
+    {
+      sc->value = fx_call(sc, car(sc->code)); /* false -> fall through into cond1 */
+      return(false);
+    }
+  push_stack_no_args_direct(sc, OP_COND1);    /* true -> push cond1, goto eval */
+  sc->code = opt3_any(sc->code);              /* caar */
+  return(true);
+}
+
+static bool op_cond_simple(s7_scheme *sc)     /* no => */
+{
+  sc->code = cdr(sc->code);
+  if (has_fx(car(sc->code)))
+    {
+      sc->value = fx_call(sc, car(sc->code));
+      return(false);
+    }
+  push_stack_no_args_direct(sc, OP_COND1_SIMPLE);
+  sc->code = opt3_any(sc->code);  /* caar */
+  return(true);
+}
+
+static bool op_cond_simple_o(s7_scheme *sc)  /* no =>, no null or multiform consequent */
+{
+  sc->code = cdr(sc->code);
+  if (has_fx(car(sc->code)))
+    {
+      sc->value = fx_call(sc, car(sc->code));
+      return(false);
+    }
+  push_stack_no_args_direct(sc, OP_COND1_SIMPLE_O);
+  sc->code = opt3_any(sc->code);  /* caar */
+  return(true);
+}
+
+static bool op_cond1(s7_scheme *sc)
+{
+  while (true)
+    {
+      if (is_true(sc, sc->value)) /* test is true, so evaluate result */
+	{
+	  sc->code = cdar(sc->code);
+	  if (is_pair(sc->code))
+	    {
+	      if (is_null(cdr(sc->code)))
+		{
+		  if (has_fx(sc->code))
+		    {
+		      sc->value = fx_call(sc, sc->code);
+		      pop_stack(sc);
+		      return(true); /* goto top_no_pop */
+		    }
+		  sc->code = car(sc->code);
+		  sc->cur_op = optimize_op(sc->code);
+		  return(true);
+		}
+	      /* check_cond catches stray dots */
+	      if (is_undefined_feed_to(sc, car(sc->code)))
+		return(false);
+	      if (has_fx(sc->code))
+		{
+		  sc->value = fx_call(sc, sc->code);
+		  sc->code = cdr(sc->code);
+		  if (is_pair(cdr(sc->code)))
+		    push_stack_no_args(sc, sc->begin_op, cdr(sc->code));
+		}
+	      else push_stack_no_args(sc, sc->begin_op, T_Pair(cdr(sc->code)));
+	      sc->code = car(sc->code);
+	      sc->cur_op = optimize_op(sc->code);
+	      return(true);
+	    }
+	  if ((S7_DEBUGGING) && (is_multiple_value(sc->value))) fprintf(stderr, "cond1 mv case %s\n", display(sc->value));
+	  pop_stack(sc);
+	  return(true);
+	}
+      sc->code = cdr(sc->code); /* go to next clause */
+      if (is_null(sc->code))
+	{
+	  sc->value = sc->unspecified;
+	  pop_stack(sc);
+	  return(true);
+	}
+      if (has_fx(car(sc->code)))
+	sc->value = fx_call(sc, car(sc->code));
+      else
+	{
+	  push_stack_no_args_direct(sc, OP_COND1);
+	  sc->code = caar(sc->code);
+	  sc->cur_op = optimize_op(sc->code);
+	  return(true);
+	}}
+  return(true); /* make the compiler happy */
+}
+
+static bool op_cond1_simple(s7_scheme *sc)
+{
+  while (true)
+    {
+      if (is_true(sc, sc->value))
+	{
+	  sc->code = T_Lst(cdar(sc->code));
+	  if (is_null(sc->code))
+	    {
+	      if ((S7_DEBUGGING) && (is_multiple_value(sc->value))) fprintf(stderr, "cond1_simple mv case %s\n", display(sc->value));
+	      pop_stack(sc);
+	      return(true);
+	    }
+ 	  if (!has_fx(sc->code))
+	    return(false);
+	  sc->value = fx_call(sc, sc->code);
+	  sc->code = cdr(sc->code);
+	  if (is_pair(sc->code)) return(false); /* goto begin */
+	  pop_stack(sc);
+	  return(true); /* goto top_no_pop */
+	}
+      sc->code = cdr(sc->code);
+      if (is_null(sc->code))
+	{
+	  sc->value = sc->unspecified;
+	  pop_stack(sc);
+	  return(true);
+	}
+      if (has_fx(car(sc->code)))
+	sc->value = fx_call(sc, car(sc->code));
+      else
+	{
+	  push_stack_no_args_direct(sc, OP_COND1_SIMPLE);
+	  sc->code = caar(sc->code);
+	  sc->cur_op = optimize_op(sc->code);
+	  return(true);
+	}}
+}
+
+static bool op_cond1_simple_o(s7_scheme *sc)
+{
+  while (true)
+    {
+      if (is_true(sc, sc->value))
+	{
+ 	  sc->code = cdar(sc->code);
+ 	  if (has_fx(sc->code))
+ 	    {
+ 	      sc->value = fx_call(sc, sc->code);
+ 	      return(true); /* goto start */
+ 	    }
+ 	  sc->code = car(sc->code);
+	  return(false);
+	}
+      sc->code = cdr(sc->code);
+      if (is_null(sc->code))
+	{
+	  sc->value = sc->unspecified;
+	  return(true);
+	}
+      if (has_fx(car(sc->code)))
+	sc->value = fx_call(sc, car(sc->code));
+      else
+	{
+	  check_stack_size(sc); /* 4-May-21 snd-test */
+	  push_stack_no_args_direct(sc, OP_COND1_SIMPLE_O);
+	  sc->code = caar(sc->code);
+	  return(false);
+	}}
+}
+
+static bool op_cond_na_np(s7_scheme *sc)  /* all tests are fxable, results may be a mixture, no =>, no missing results */
+{
+  for (s7_pointer p = cdr(sc->code); is_pair(p); p = cdr(p))
+    if (is_true(sc, fx_call(sc, car(p))))
+      {
+	for (p = T_Lst(cdar(p)); is_pair(p); p = cdr(p))
+	  if (has_fx(T_Pair(p)))
+	    sc->value = fx_call(sc, p);
+	  else
+	    {
+	      if (is_pair(cdr(p)))
+		push_stack_no_args(sc, OP_COND_NA_NP_1, cdr(p));
+	      sc->code = car(p);
+	      return(false);
+	    }
+	return(true);
+      }
+  sc->value = sc->unspecified;
+  return(true);
+}
+
+static bool op_cond_na_np_1(s7_scheme *sc)  /* continuing to handle a multi-statement result from cond_na_np */
+{
+  for (s7_pointer p = sc->code; is_pair(p); p = cdr(p))
+    if (has_fx(T_Pair(p)))
+      sc->value = fx_call(sc, p);
+    else
+      {
+	if (is_pair(cdr(p)))
+	  push_stack_no_args(sc, OP_COND_NA_NP_1, cdr(p));
+	sc->code = car(p);
+	return(false);
+      }
+  return(true);
+}
+
+static Inline bool inline_op_cond_na_np_o(s7_scheme *sc)  /* all tests are fxable, results may be a mixture, no =>, no missing results, all result one expr */
+{ /* called once in eval, b case cb lg rclo str */
+  for (s7_pointer p = cdr(sc->code); is_pair(p); p = cdr(p))
+    if (is_true(sc, fx_call(sc, car(p))))
+      {
+	p = cdar(p);
+	if (has_fx(T_Pair(p)))
+	  {
+	    sc->value = fx_call(sc, p);
+	    return(true);
+	  }
+	sc->code = car(p);
+	return(false);
+      }
+  sc->value = sc->unspecified;
+  return(true);
+}
+
+static inline bool fx_cond_value(s7_scheme *sc, s7_pointer p)
+{
+  if (has_fx(p))
+    {
+      sc->value = fx_call(sc, p);
+      return(true);
+    }
+  sc->code = car(p);
+  return(false);
+}
+
+static bool op_cond_na_2e(s7_scheme *sc)
+{
+  s7_pointer p = cdr(sc->code);
+  return(fx_cond_value(sc, (is_true(sc, fx_call(sc, car(p)))) ? cdar(p) : cdadr(p)));
+}
+
+static bool op_cond_na_3e(s7_scheme *sc)
+{
+  s7_pointer p = cdr(sc->code);
+  if (is_true(sc, fx_call(sc, car(p))))
+    return(fx_cond_value(sc, cdar(p)));
+  p = cdr(p);
+  return(fx_cond_value(sc, (is_true(sc, fx_call(sc, car(p)))) ? cdar(p) : cdadr(p)));
+}
+
+static bool op_cond_feed(s7_scheme *sc)
+{
+  /* (cond (expr => p)) where p is (lambda (s) ...) -- see check_cond */
+  sc->code = cdr(sc->code);
+  if (has_fx(car(sc->code)))
+    sc->value = fx_call(sc, car(sc->code));
+  else
+    {
+      push_stack_no_args_direct(sc, OP_COND_FEED_1);
+      sc->code = caar(sc->code);
+      return(true);
+    }
+  return(false);
+}
+
+static void op_cond_feed_1(s7_scheme *sc)
+{
+  if ((S7_DEBUGGING) && (is_multiple_value(sc->value))) fprintf(stderr, "%s %s unexpected mv\n", __func__, display(sc->value));
+  set_curlet(sc, inline_make_let_with_slot(sc, sc->curlet, caadr(opt2_lambda(sc->code)), sc->value));
+  sc->code = caddr(opt2_lambda(sc->code));
+}
+
+static bool feed_to(s7_scheme *sc)
+{
+  if (is_multiple_value(sc->value))  /* (... ((values 1 2) => +)) more or less s7test.scm 29539 */
+    {
+      sc->args = multiple_value(sc->value);
+      clear_multiple_value(sc->args);
+      if (is_symbol(cadr(sc->code)))
+	{
+	  sc->code = lookup_global(sc, cadr(sc->code));  /* car is => */
+	  return(true);
+	}}
+  else
+    {
+      if (is_symbol(cadr(sc->code)))
+	{
+	  sc->code = lookup_global(sc, cadr(sc->code));  /* car is => */
+	  sc->args = (needs_copied_args(sc->code)) ? list_1(sc, sc->value) : set_plist_1(sc, sc->value);
+	  return(true);
+	}
+      sc->args = list_1(sc, sc->value);                 /* not plist here */
+    }
+  push_stack_direct(sc, OP_FEED_TO_1);
+  sc->code = cadr(sc->code);                            /* need to evaluate the target function */
+  return(false);
+}
+
+
+/* -------------------------------- set! -------------------------------- */
+static void check_set(s7_scheme *sc)
+{
+  s7_pointer form = sc->code, code = cdr(sc->code), settee, value;
+  if (!is_pair(code))
+    {
+      if (is_null(code))                                             /* (set!) */
+	syntax_error_nr(sc, "set!: not enough arguments: ~A", 30, form);
+      syntax_error_nr(sc, "set!: stray dot? ~A", 19, form);          /* (set! . 1) */
+    }
+  settee = car(code);
+
+  if (!is_pair(cdr(code)))
+    {
+      if (is_null(cdr(code)))                                        /* (set! var) */
+	syntax_error_nr(sc, "set!: not enough arguments: ~A", 30, form);
+      syntax_error_nr(sc, "set!: stray dot? ~A", 19, form);          /* (set! var . 1) */
+    }
+  value = cadr(code);                                                /* the value has not yet been evaluated */
+
+  if ((is_not_null(cddr(code))) ||                                   /* (set! var 1 2) */
+      ((is_pair(value)) &&
+       (car(value) == sc->values_symbol) &&                          /* (set! var (values...) but 0 or 1 arg is ok */
+       (is_pair(cdr(value))) &&                                      /*    this can be fooled if we rename values, etc */
+       (is_pair(cddr(value)))))
+    syntax_error_nr(sc, "~A: too many arguments to set!", 30, form);
+
+  if (is_pair(settee))
+    {
+      if ((is_pair(car(settee))) &&
+	  (!is_list(cdr(settee))))                                   /* (set! ('(1 2) . 0) 1) */
+	syntax_error_nr(sc, "improper list of arguments to set!: ~A", 38, form);
+      if (!s7_is_proper_list(sc, settee))                            /* (set! ("hi" . 1) #\a) or (set! (#(1 2) . 1) 0) */
+	syntax_error_nr(sc, "set! target is an improper list: (set! ~A ...)", 46, settee);
+    }
+  else
+    if (!is_symbol(settee))                                          /* (set! 12345 1) */
+      error_nr(sc, sc->syntax_error_symbol,                          /* (set! #_abs 32) -> "error: set! can't change #_abs (a c-function)" */
+	       (is_c_function(settee)) ? set_elist_2(sc, wrap_string(sc, "set! can't change #_~S (a c-function)", 37), settee) : 
+	       set_elist_4(sc, wrap_string(sc, "set! can't change ~S (~A), ~S", 29), settee, sc->type_names[type(settee)], form));
+
+    else
+      if (is_keyword(settee))                                        /* (set! :hi 3) */
+	error_nr(sc, sc->syntax_error_symbol,
+		 set_elist_3(sc, wrap_string(sc, "set!: can't change keyword's value: ~S in ~S", 44), settee, form));
+
+  if (is_pair(settee))                                               /* here we have (set! (...) ...) */
+    {
+      pair_set_syntax_op(form, OP_SET_UNCHECKED); /* if not pair car, op_set_normal below */
+      if (is_symbol(car(settee)))
+	{
+	  if (is_null(cdr(settee)))                                  /* (set! (symbol) ...) */
+	    {
+	      if (is_fxable(sc, value))
+		{
+		  pair_set_syntax_op(form, OP_SET_opSq_A);           /* (set! (symbol) fxable) */
+		  fx_annotate_arg(sc, cdr(code), sc->curlet);        /* cdr(code) = value */
+		}}
+	  else
+	    if (is_null(cddr(settee))) /* we check cddr(code) above */  /* this leaves (set! (vect i j) 1) unhandled so we go to OP_SET_UNCHECKED */
+	      {
+		s7_pointer index = cadr(settee);
+		if (is_fxable(sc, index))
+		  {
+		    if ((car(settee) == sc->let_ref_symbol) && (!is_pair(cddr(settee)))) /* perhaps also check for hash-table-ref */
+		      /* (let () (define (func) (catch #t (lambda () (set! (let-ref (list 1)) 1)) (lambda args 'error))) (func) (func)) */
+		      error_nr(sc, sc->wrong_number_of_args_symbol,
+			       set_elist_2(sc, wrap_string(sc, "set!: not enough arguments for let-ref: ~S", 42), sc->code));
+		    fx_annotate_arg(sc, cdr(settee), sc->curlet);    /* cdr(settee) -> index */
+		    if (is_fxable(sc, value))
+		      {
+			pair_set_syntax_op(form, OP_SET_opSAq_A);   /* (set! (symbol fxable) fxable) */
+			/* perhaps: if "S" is a known function (etc), split this -- the runtime check for a macro here is very expensive
+			 *   fprintf(stderr, "(set! %s %s)\n", display(settee), display(value));
+			 *   S=vector[tnum]/hash-table/c_func/s7/setter[tset]/var-*[lt]/c-obj[tobj]/dilambda[tstar]
+			 * so, if not any_macro OP_SET_opFAq_A else OP_SET_opMAq_A? or just the latter
+			 * also (set! (car a) b) -> (set-car! a b), (set! (cfunc a) b) -> ((setter cfunc) a b)
+			 * set_opsaq_a as "unknown" equivalent -> all the special cases which check just their case, maybe a no-parcel option
+                         */
+			fx_annotate_arg(sc, cdr(code), sc->curlet); /* cdr(code) -> value */
+
+			if (car(settee) == sc->s7_starlet_symbol)    /* (set! (*s7* 'field) value) */
+			  {
+			    s7_pointer sym = (is_symbol(index)) ?
+			                       ((is_keyword(index)) ? keyword_symbol(index) : index) :
+                                               ((is_quoted_symbol(index)) ? cadr(index) : index);
+			    if ((is_symbol(sym)) && (s7_starlet_symbol_id(sym) != SL_NO_FIELD))
+			      {
+				/* perhaps preset field -> op_print_length_set[misc?]|safety[tstar] etc, most (timing test) cases are just heap-size called once */
+				set_safe_optimize_op(form, OP_IMPLICIT_S7_STARLET_SET);
+				set_opt3_sym(form, sym);
+			      }}}
+		    else pair_set_syntax_op(form, OP_SET_opSAq_P);  /* (set! (symbol fxable) any) */
+		  }}
+	    else
+	      if ((is_null(cdddr(settee))) &&
+		  (car(settee) != sc->with_let_symbol))              /* (set! (with-let lt a) 32) needs to be handled by op_set_with_let_1 */
+		{
+		  s7_pointer index1 = cadr(settee), index2 = caddr(settee);
+		  if ((is_fxable(sc, index1)) && (is_fxable(sc, index2)))
+		    {
+		      fx_annotate_args(sc, cdr(settee), sc->curlet);    /* cdr(settee) -> index1 and 2 */
+		      if (is_fxable(sc, value))
+			{
+			  pair_set_syntax_op(form, OP_SET_opSAAq_A);   /* (set! (symbol fxable fxable) fxable) */
+			  fx_annotate_arg(sc, cdr(code), sc->curlet);  /* cdr(code) -> value */
+			}
+		      else pair_set_syntax_op(form, OP_SET_opSAAq_P);  /* (set! (symbol fxable fxable) any) */
+		    }}}
+      return;
+    }
+  pair_set_syntax_op(form, OP_SET_NORMAL);
+  if (is_symbol(settee))
+    {
+      s7_pointer slot = s7_slot(sc, settee);
+      if ((is_slot(slot)) &&
+	  (!slot_has_setter(slot)) &&
+	  (!is_immutable(slot)) &&
+	  (!is_syntactic_symbol(settee)) &&
+	  (!s7_tree_memq(sc, sc->setter_symbol, value))) /* (set! x (set! (setter 'x) ...) ...)! */
+	{
+	  if (is_normal_symbol(value))
+	    {
+	      s7_pointer slot1 = s7_slot(sc, value);
+	      if ((is_slot(slot1)) && (!slot_has_setter(slot1)))
+		{
+		  pair_set_syntax_op(form, OP_SET_S_S);
+		  set_opt2_sym(code, value);
+		}}
+	  else
+	    if ((!is_pair(value)) ||
+		((is_quote(car(value))) && (is_pair(cdr(value))))) /* (quote . 1) ? */
+	      {
+		pair_set_syntax_op(form, OP_SET_S_C);
+		set_opt1_con(code, (is_pair(value)) ? cadr(value) : value); /* collision if ((values set!) x 32) code: (x 32) value: 32, opt2: fx_s, opt1|3 is free */
+	      }
+	    else
+	      {
+		pair_set_syntax_op(form, OP_SET_S_P);
+		if (is_optimized(value))
+		  {
+		    if (optimize_op(value) == HOP_SAFE_C_SS)
+		      {
+			if (settee == cadr(value))
+			  {
+			    pair_set_syntax_op(form, OP_INCREMENT_SA);
+			    fx_annotate_arg(sc, cddr(value), sc->curlet); /* this sets fx_proc(arg) */
+			    set_opt2_pair(code, cddr(value));
+			  }
+			else
+			  {
+			    pair_set_syntax_op(form, OP_SET_S_A);
+			    fx_annotate_arg(sc, cdr(code), sc->curlet);
+			  }}
+		    else
+		      {
+			if (is_fxable(sc, value))
+			  {
+			    pair_set_syntax_op(form, OP_SET_S_A);
+			    fx_annotate_arg(sc, cdr(code), sc->curlet);
+			  }
+			if ((is_safe_c_op(optimize_op(value))) &&
+			    (is_pair(cdr(value))) &&
+			    (settee == cadr(value)) &&
+			    (!is_null(cddr(value))))
+			  {
+			    if (is_null(cdddr(value)))
+			      {
+				if (is_fxable(sc, caddr(value)))
+				  {
+				    pair_set_syntax_op(form, OP_INCREMENT_SA);
+				    fx_annotate_arg(sc, cddr(value), sc->curlet); /* this sets fx_proc(arg) */
+				    set_opt2_pair(code, cddr(value));
+				  }}
+			    else
+			      if ((is_null(cddddr(value))) &&
+				  (is_fxable(sc, caddr(value))) &&
+				  (is_fxable(sc, cadddr(value))))
+				{
+				  pair_set_syntax_op(form, OP_INCREMENT_SAA);
+				  fx_annotate_args(sc, cddr(value), sc->curlet);
+				  /* fx_annotate_arg(sc, cdddr(value), sc->curlet); */
+				  set_opt2_pair(code, cddr(value));
+				}}}}
+		if ((is_h_optimized(value)) &&
+		    (is_safe_c_op(optimize_op(value))) &&    /* else might not be opt1_cfunc? (opt1_lambda probably) */
+		    (!is_unsafe(value)) &&                   /* is_unsafe(value) can happen! */
+		    (is_not_null(cdr(value))))               /* (set! x (y)) */
+		  {
+		    if (is_not_null(cddr(value)))
+		      {
+			if ((caddr(value) == int_one) &&
+			    (cadr(value) == settee))
+			  {
+			    if (opt1_cfunc(value) == sc->add_x1)
+			      pair_set_syntax_op(form, OP_INCREMENT_BY_1);
+			    else
+			      if (opt1_cfunc(value) == sc->subtract_x1)
+				pair_set_syntax_op(form, OP_DECREMENT_BY_1);
+			  }
+			else
+			  if ((cadr(value) == int_one) &&
+			      (caddr(value) == settee) &&
+			      (opt1_cfunc(value) == sc->add_1x))
+			    pair_set_syntax_op(form, OP_INCREMENT_BY_1);
+			  else
+			    if ((settee == caddr(value)) &&
+				(is_safe_symbol(cadr(value))) &&
+				(car(value) == sc->cons_symbol))
+			      {
+				pair_set_syntax_op(form, OP_SET_CONS);
+				set_opt2_sym(code, cadr(value));
+			      }}}}}}
+}
+
+static void op_set_s_c(s7_scheme *sc)
+{
+  s7_pointer slot = T_Slt(s7_slot(sc, cadr(sc->code)));
+  if (is_immutable(slot))
+    immutable_object_error_nr(sc, set_elist_3(sc, wrap_string(sc, "~S, but ~S is immutable", 23), sc->code, cadr(sc->code)));
+  slot_set_value(slot, sc->value = opt1_con(cdr(sc->code)));
+}
+
+static inline void op_set_s_s(s7_scheme *sc)
+{
+  s7_pointer slot = T_Slt(s7_slot(sc, cadr(sc->code)));
+  if (is_immutable(slot))
+    immutable_object_error_nr(sc, set_elist_3(sc, wrap_string(sc, "~S, but ~S is immutable", 23), sc->code, cadr(sc->code)));
+  slot_set_value(slot, sc->value = lookup(sc, opt2_sym(cdr(sc->code))));
+}
+
+static Inline void op_set_s_a(s7_scheme *sc)
+{
+  s7_pointer slot = T_Slt(s7_slot(sc, cadr(sc->code)));
+  if (is_immutable(slot))
+    immutable_object_error_nr(sc, set_elist_3(sc, wrap_string(sc, "~S, but ~S is immutable", 23), sc->code, cadr(sc->code)));
+  slot_set_value(slot, sc->value = fx_call(sc, cddr(sc->code)));
+}
+
+static void op_set_s_p(s7_scheme *sc)
+{
+  check_stack_size(sc);
+  push_stack_no_args(sc, OP_SET_SAFE, cadr(sc->code)); /* only path to op_set_safe, but we're not safe! cadr(sc->code) might be immutable */
+  sc->code = caddr(sc->code);
+}
+
+static void op_set_safe(s7_scheme *sc) /* name is misleading -- we need to check for immutable slot, but no setter */
+{
+  s7_pointer slot = s7_slot(sc, sc->code);
+  if (is_slot(slot))
+    {
+      if (is_immutable_slot(slot))
+	immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->set_symbol, sc->code));
+      slot_set_value(slot, sc->value);
+    }
+  else
+    if ((is_let(sc->curlet)) && (has_let_set_fallback(sc->curlet)))
+      sc->value = call_let_set_fallback(sc, sc->curlet, sc->code, sc->value);
+    else unbound_variable_error_nr(sc, sc->code);
+}
+
+static void op_set_from_let_temp(s7_scheme *sc)
+{
+  s7_pointer settee = sc->code;
+  s7_pointer slot = s7_slot(sc, settee);
+  if (!is_slot(slot))
+    unbound_variable_error_nr(sc, settee);
+  if (is_immutable_slot(slot))
+    immutable_object_error_nr(sc, set_elist_2(sc, wrap_string(sc, "let-temporarily can't reset ~S: it is immutable!", 48), settee));
+  slot_set_value(slot, (slot_has_setter(slot)) ? call_setter(sc, slot, sc->value) : sc->value);
+}
+
+static inline void op_set_cons(s7_scheme *sc)
+{
+  s7_pointer slot = s7_slot(sc, cadr(sc->code));
+  slot_set_value(slot, sc->value = cons(sc, lookup(sc, opt2_sym(cdr(sc->code))), slot_value(slot)));  /* ([set!] bindings (cons v bindings)) */
+}
+
+static void op_increment_saa(s7_scheme *sc)
+{
+  s7_pointer slot, arg, val;
+  sc->code = cdr(sc->code);
+  slot = s7_slot(sc, car(sc->code));
+  arg = opt2_pair(sc->code);               /* cddr(value) */
+  val = fx_call(sc, cdr(arg));
+  set_car(sc->t3_2, fx_call(sc, arg));
+  set_car(sc->t3_3, val);
+  set_car(sc->t3_1, slot_value(slot));
+  slot_set_value(slot, sc->value = fn_proc(cadr(sc->code))(sc, sc->t3_1));
+}
+
+static void op_increment_sa(s7_scheme *sc)
+{
+  s7_pointer slot, arg;
+  sc->code = cdr(sc->code);
+  slot = s7_slot(sc, car(sc->code));
+  arg = opt2_pair(sc->code);
+  set_car(sc->t2_2, fx_call(sc, arg));
+  set_car(sc->t2_1, slot_value(slot));
+  slot_set_value(slot, sc->value = fn_proc(cadr(sc->code))(sc, sc->t2_1));
+}
+
+static noreturn void no_setter_error_nr(s7_scheme *sc, s7_pointer obj)
+{
+  /* sc->code here is form without set!: ((abs 1) 2) from (set! (abs 1) 2)
+   *   but in implicit case, (let ((L (list 0))) (set! (L 0 0) 2)), code is ((0 0) 2)
+   *   at entry to s7_error: ((0 0 2)??  but we print something from define-hook-function if in the repl
+   *   add indices and new-value args, is unevaluated code always available?
+   */
+  int32_t typ = type(obj);
+  if (!is_pair(car(sc->code))) sc->code = cdr(sc->code);
+
+  if (is_any_c_function(caar(sc->code)))
+    error_nr(sc, sc->no_setter_symbol,
+	     set_elist_6(sc, wrap_string(sc, "~W (~A) does not have a setter: (set! (~W~{~^ ~S~}) ~S)", 55),
+			 caar(sc->code), sc->type_names[typ], caar(sc->code), cdar(sc->code), cadr(sc->code)));
+  error_nr(sc, sc->no_setter_symbol,
+	   set_elist_5(sc, wrap_string(sc, "~A (~A) does not have a setter: (set! ~S ~S)", 44),
+		       caar(sc->code), sc->type_names[typ],
+		       (is_pair(car(sc->code))) ? copy_any_list(sc, car(sc->code)) : car(sc->code),
+		       (is_pair(cadr(sc->code))) ? sc->z = copy_any_list(sc, cadr(sc->code)) : cadr(sc->code)));
+  /* copy is necessary due to the way quoted lists|symbols are handled in op_set_with_let_1|2 and copy_tree
+   *   copy_proper_list can fail: (let ((x #f)) (map set! `((set! x (+ x 1)) (* x 2)) (hash-table 'a 1)))
+   */
+}
+
+static bool pair3_cfunc(s7_scheme *sc, s7_pointer obj, s7_pointer setf, s7_pointer arg, s7_pointer value)
+{
+  if (!c_function_is_aritable(setf, 2))
+    error_nr(sc, sc->wrong_number_of_args_symbol,
+	     set_elist_6(sc, wrap_string(sc, "set!: two arguments? (~A ~S ~S), ~A is (setter ~A)", 50), setf, arg, value, setf, obj));
+  if (!is_safe_procedure(setf)) /* if unsafe, we can't call c_function_call(setf) directly (need drop into eval+apply) */
+    {
+      sc->code = setf;
+      sc->args = list_2(sc, arg, value);
+      return(true); /* goto APPLY */
+    }
+  sc->value = c_function_call(setf)(sc, with_list_t2(arg, value));
+  return(false);
+}
+
+static bool set_pair3(s7_scheme *sc, s7_pointer obj, s7_pointer arg, s7_pointer value)
+{
+  switch (type(obj))
+    {
+    case T_C_OBJECT:
+      sc->value = (*(c_object_set(sc, obj)))(sc, with_list_t3(obj, arg, value));
+      break;
+
+    case T_FLOAT_VECTOR:
+      sc->value = g_fv_set_3(sc, with_list_t3(obj, arg, value));
+      break;
+    case T_INT_VECTOR:
+      sc->value = g_iv_set_3(sc, with_list_t3(obj, arg, value));
+      break;
+    case T_BYTE_VECTOR:
+      sc->value = g_bv_set_3(sc, with_list_t3(obj, arg, value));
+      break;
+    case T_VECTOR:
+#if WITH_GMP
+      sc->value = g_vector_set_3(sc, with_list_t3(obj, arg, value));
+#else
+      if (vector_rank(obj) > 1)
+	sc->value = g_vector_set(sc, with_list_t3(obj, arg, value));
+      else
+	{
+	  s7_int index;
+	  if (!is_t_integer(arg))
+	    error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "vector-set!: index must be an integer: ~S", 41), sc->code));
+	  index = integer(arg);
+	  if (index < 0)
+	    error_nr(sc, sc->out_of_range_symbol, set_elist_2(sc, wrap_string(sc, "vector-set!: index must not be negative: ~S", 43), sc->code));
+	  if (index >= vector_length(obj))
+	    error_nr(sc, sc->out_of_range_symbol, set_elist_2(sc, wrap_string(sc, "vector-set!: index must be less than vector length: ~S", 54), sc->code));
+	  if (is_immutable_vector(obj))
+	    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->vector_set_symbol, obj));
+	  if (is_typed_vector(obj))
+	    value = typed_vector_setter(sc, obj, index, value);
+	  else vector_element(obj, index) = value;
+	  sc->value = T_Ext(value);
+	}
+#endif
+      break;
+
+    case T_STRING:
+#if WITH_GMP
+      sc->value = g_string_set(sc, with_list_t3(obj, arg, value));
+#else
+      {
+	s7_int index;
+	if (!is_t_integer(arg))
+	  error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "index must be an integer: ~S", 28), sc->code));
+	index = integer(arg);
+	if (index < 0)
+	  error_nr(sc, sc->out_of_range_symbol, set_elist_2(sc, wrap_string(sc, "index must not be negative: ~S", 30), sc->code));
+	if (index >= string_length(obj))
+	  error_nr(sc, sc->out_of_range_symbol, set_elist_2(sc, wrap_string(sc, "index must be less than sequence length: ~S", 43), sc->code));
+	if (is_immutable_string(obj))
+	  immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->string_set_symbol, obj));
+	if (!is_character(value))
+	  error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "string-set!: value must be a character: ~S", 42), sc->code));
+	string_value(obj)[index] = (char)s7_character(value);
+	sc->value = value;
+      }
+#endif
+      break;
+
+    case T_PAIR:
+      sc->value = g_list_set(sc, with_list_t3(obj, arg, value));
+      break;
+
+    case T_HASH_TABLE:
+      if (is_immutable_hash_table(obj))  /* not checked in s7_hash_table_set */
+	immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->hash_table_set_symbol, obj));
+      sc->value = s7_hash_table_set(sc, obj, arg, value);
+      break;
+
+    case T_LET:
+      sc->value = let_set_2(sc, obj, arg, value); /* this checks immutable */
+      break;
+
+    case T_C_RST_NO_REQ_FUNCTION: case T_C_FUNCTION:
+    case T_C_FUNCTION_STAR:      /* obj here is a c_function, but its setter could be a closure and vice versa below */
+      if (is_c_function(c_function_setter(obj)))
+	return(pair3_cfunc(sc, obj, c_function_setter(obj), arg, value));
+      sc->code = c_function_setter(obj); /* closure/macro */
+      sc->args = (needs_copied_args(sc->code)) ? list_2(sc, arg, value) : set_plist_2(sc, arg, value);
+      return(true); /* goto APPLY; not redundant -- setter type might not match getter type */
+
+    case T_C_MACRO: /* (set! (setter quasiquote) (lambda args args)) (define (f) (set! (quasiquote 1) (setter 'i))) (f) (f) */
+      if (is_c_function(c_macro_setter(obj)))
+	return(pair3_cfunc(sc, obj, c_macro_setter(obj), arg, value));
+      sc->code = c_macro_setter(obj);
+      sc->args = (needs_copied_args(sc->code)) ? list_2(sc, arg, value) : set_plist_2(sc, arg, value);
+      return(true); /* goto APPLY; */
+
+    case T_MACRO:   case T_MACRO_STAR:
+    case T_BACRO:   case T_BACRO_STAR:
+    case T_CLOSURE: case T_CLOSURE_STAR:
+      if (is_c_function(closure_setter(obj)))
+	return(pair3_cfunc(sc, obj, closure_setter(obj), arg, value));
+      sc->code = closure_setter(obj);
+      sc->args = (needs_copied_args(sc->code)) ? list_2(sc, arg, value) : set_plist_2(sc, arg, value);
+      return(true); /* goto APPLY; */
+
+    default:
+      no_setter_error_nr(sc, obj); /* possibly a continuation/goto? */
+    }
+  return(false);
+}
+
+static bool op_set_opsq_a(s7_scheme *sc)        /* (set! (symbol) fxable) */
+{
+  s7_pointer setf, value, code = cdr(sc->code);
+  s7_pointer obj = lookup_checked(sc, caar(code));
+
+  if ((is_sequence(obj)) && (!is_c_object(obj)))
+    error_nr(sc, sc->wrong_number_of_args_symbol,
+	     set_elist_3(sc, wrap_string(sc, "set!: not enough arguments for ~S: ~S", 37), caar(code), sc->code));
+
+  setf = setter_p_pp(sc, obj, sc->curlet);
+  if (is_any_macro(setf))
+    {
+      sc->code = setf;
+      sc->args = cdr(code);
+      return(true);
+    }
+  value = fx_call(sc, cdr(code));
+  if (is_c_function(setf))
+    {
+      if (c_function_min_args(setf) > 1)
+	error_nr(sc, sc->wrong_number_of_args_symbol,
+		 set_elist_3(sc, wrap_string(sc, "set!: not enough arguments: (~A ~S)", 35), setf, value));
+      sc->value = c_function_call(setf)(sc, with_list_t1(value));
+      return(false);
+    }
+  sc->code = setf;
+  sc->args = list_1(sc, value);
+  return(true);
+}
+
+static bool op_set_opsaq_a(s7_scheme *sc)        /* (set! (symbol fxable) fxable) */
+{
+  s7_pointer index, value, code = cdr(sc->code);
+  s7_pointer obj = lookup_checked(sc, caar(code));
+  bool result;
+  if (could_be_macro_setter(obj))
+    {
+      s7_pointer setf = setter_p_pp(sc, obj, sc->curlet);
+      if (is_any_macro(setf))
+	{
+	  sc->code = setf;
+	  sc->args = pair_append(sc, cdar(code), cdr(code));
+	  return(true); /* goto APPLY */
+	}}
+  value = fx_call(sc, cdr(code));
+  gc_protect_via_stack(sc, value);
+  if (dont_eval_args(obj)) /* this check is expensive, 8 in tstar, similar lg, but it's faster than is_any_macro */
+    index = cadar(code);   /* if obj is a c_macro, surely we don't want to evaluate cdar(code)? */
+  else index = fx_call(sc, cdar(code));
+  set_gc_protected2(sc, index);
+  result = set_pair3(sc, obj, index, value);
+  unstack_gc_protect(sc);
+  return(result);
+}
+
+static inline bool op_set_opsaq_p(s7_scheme *sc)
+{
+  s7_pointer code = cdr(sc->code);
+  /* ([set!] (car a) (cadr a)) */
+  /* here the pair can't generate multiple values, or if it does, it's an error (caught below)
+   *  splice_in_values will notice the OP_SET_opSAq_P_1 and complain.
+   * (let () (define (hi) (let ((str "123")) (set! (str 0) (values #\a)) str)) (hi) (hi)) is "a23"
+   * (let ((v (make-vector '(2 3) 0))) (set! (v (values 0 1)) 23) v) -> #2D((0 23 0) (0 0 0))
+   */
+  s7_pointer obj = lookup_checked(sc, caar(code));
+  if (could_be_macro_setter(obj))
+    {
+      s7_pointer setf = setter_p_pp(sc, obj, sc->curlet);
+      if (is_any_macro(setf))
+	{
+	  sc->code = setf;
+	  sc->args = pair_append(sc, cdar(code), cdr(code));
+	  return(true); /* goto APPLY */
+	}}
+  push_stack(sc, OP_SET_opSAq_P_1, obj, code);
+  sc->code = cadr(code);
+  return(false);        /* goto EVAL */
+}
+
+static inline bool op_set_opsaq_p_1(s7_scheme *sc)
+{
+  s7_pointer value = sc->value;
+  s7_pointer index;
+  if (dont_eval_args(sc->args)) /* see above */
+    index = cadar(sc->code);
+  else index = fx_call(sc, cdar(sc->code));
+  return(set_pair3(sc, sc->args, index, value)); /* not lookup, (set! (_!asdf!_ 3) 'a) -> unbound_variable */
+}
+
+static bool pair4_cfunc(s7_scheme *sc, s7_pointer obj, s7_pointer setf, s7_pointer index1, s7_pointer index2, s7_pointer value)
+{
+  if (!c_function_is_aritable(setf, 3))
+    error_nr(sc, sc->wrong_number_of_args_symbol,
+	     set_elist_7(sc, wrap_string(sc, "set!: three arguments? (~A ~S ~S ~S), ~A is (setter ~A)", 55), setf, index1, index2, value, setf, obj));
+  if (!is_safe_procedure(setf))
+    {
+      sc->code = setf;
+      sc->args = list_3(sc, index1, index2, value);
+      return(true);
+    }
+  sc->value = c_function_call(setf)(sc, with_list_t3(index1, index2, value));
+  return(false);
+}
+
+static bool set_pair4(s7_scheme *sc, s7_pointer obj, s7_pointer index1, s7_pointer index2, s7_pointer value)
+{
+  switch (type(obj))
+    {
+    case T_C_OBJECT:
+      sc->value = (*(c_object_ref(sc, obj)))(sc, with_list_t2(obj, index1));
+      return(set_pair3(sc, sc->value, index2, value));
+
+    case T_FLOAT_VECTOR:
+      sc->value = g_float_vector_set(sc, set_plist_4(sc, obj, index1, index2, value)); /* fv_unchecked_set_4? */
+      break;
+    case T_INT_VECTOR:
+      sc->value = g_int_vector_set(sc, set_plist_4(sc, obj, index1, index2, value));
+      break;
+    case T_BYTE_VECTOR:
+      sc->value = g_byte_vector_set(sc, set_plist_4(sc, obj, index1, index2, value));
+      break;
+    case T_VECTOR:
+      if (vector_rank(obj) == 2)
+	sc->value = g_vector_set_4(sc, set_plist_4(sc, obj, index1, index2, value));
+      else
+	{
+	  sc->value = g_vector_ref(sc, with_list_t2(obj, index1));
+	  return(set_pair3(sc, sc->value, index2, value));
+	}
+      break;
+
+    case T_PAIR:
+      sc->value = g_list_ref(sc, with_list_t2(obj, index1));
+      return(set_pair3(sc, sc->value, index2, value));
+
+    case T_HASH_TABLE:
+      sc->value = s7_hash_table_ref(sc, obj, index1);
+      return(set_pair3(sc, sc->value, index2, value));
+
+    case T_LET:
+      sc->value = let_ref(sc, obj, index1);
+      return(set_pair3(sc, sc->value, index2, value));
+
+    case T_C_RST_NO_REQ_FUNCTION: case T_C_FUNCTION:
+    case T_C_FUNCTION_STAR:      /* obj here is any_c_function, but its setter could be a closure and vice versa below */
+      if (is_c_function(c_function_setter(obj)))
+	return(pair4_cfunc(sc, obj, c_function_setter(obj), index1, index2, value));
+      sc->code = c_function_setter(obj); /* closure|macro */
+      sc->args = (needs_copied_args(sc->code)) ? list_3(sc, index1, index2, value) : set_plist_3(sc, index1, index2, value);
+      return(true); /* goto APPLY; not redundant -- setter type might not match getter type */
+
+    case T_C_MACRO: /* (set! (setter quasiquote) (lambda (a . b) a)) (let () (define (func) (set! (quasiquote 'a 0) 3)) (func) (func)) */
+      if (is_c_function(c_macro_setter(obj)))
+	return(pair4_cfunc(sc, obj, c_macro_setter(obj), index1, index2, value));
+      sc->code = c_macro_setter(obj);
+      sc->args = (needs_copied_args(sc->code)) ? list_3(sc, index1, index2, value) : set_plist_3(sc, index1, index2, value);
+      return(true); /* goto APPLY; */
+
+    case T_MACRO:   case T_MACRO_STAR:
+    case T_BACRO:   case T_BACRO_STAR:
+    case T_CLOSURE: case T_CLOSURE_STAR:
+      if (is_c_function(closure_setter(obj)))
+	return(pair4_cfunc(sc, obj, closure_setter(obj), index1, index2, value));
+      sc->code = closure_setter(obj);
+      sc->args = (needs_copied_args(sc->code)) ? list_3(sc, index1, index2, value) : set_plist_3(sc, index1, index2, value);
+      return(true); /* goto APPLY; */
+
+    default:
+      no_setter_error_nr(sc, obj); /* possibly a continuation/goto or string */
+    }
+  return(false); /* goto start */
+}
+
+static bool op_set_opsaaq_a(s7_scheme *sc)        /* (set! (symbol fxable fxable) fxable) */
+{
+  s7_pointer index1, value, code = cdr(sc->code);
+  s7_pointer obj = lookup_checked(sc, caar(code));
+  bool result;
+  if (could_be_macro_setter(obj))
+    {
+      s7_pointer setf = setter_p_pp(sc, obj, sc->curlet);
+      if (is_any_macro(setf))
+	{
+	  sc->code = setf;
+	  sc->args = pair_append(sc, cdar(code), cdr(code));
+	  return(true);
+	}}
+  value = fx_call(sc, cdr(code));
+  gc_protect_via_stack(sc, value);
+  index1 = fx_call(sc, cdar(code));
+  set_gc_protected2(sc, index1);
+  result = set_pair4(sc, obj, index1, fx_call(sc, cddar(code)), value);
+  unstack_gc_protect(sc);
+  return(result);
+}
+
+static bool op_set_opsaaq_p(s7_scheme *sc)
+{
+  s7_pointer code = cdr(sc->code);
+  s7_pointer obj = lookup_checked(sc, caar(code));
+  if (could_be_macro_setter(obj))
+    {
+      s7_pointer setf = setter_p_pp(sc, obj, sc->curlet);
+      if (is_any_macro(setf))
+	{
+	  sc->code = setf;
+	  sc->args = pair_append(sc, cdar(code), cdr(code));
+	  return(true);
+	}}
+  push_stack(sc, OP_SET_opSAAq_P_1, obj, code);
+  sc->code = cadr(code);
+  return(false);
+}
+
+static bool op_set_opsaaq_p_1(s7_scheme *sc)
+{
+  s7_pointer value = sc->value;
+  bool result;
+  s7_pointer index1 = fx_call(sc, cdar(sc->code));
+  gc_protect_via_stack(sc, index1);
+  result = set_pair4(sc, sc->args, index1, fx_call(sc, cddar(sc->code)), value);
+  unstack_gc_protect(sc);
+  return(result);
+}
+
+static bool op_set1(s7_scheme *sc)
+{
+  s7_pointer sym = T_Sym(sc->code);    /* protect from sc->code possible change in call_c_function_setter below */
+  s7_pointer lx = s7_slot(sc, sym);    /* if unbound variable hook here, we need the binding, not the current value */
+  if (is_slot(lx))
+    {
+      if (is_immutable_slot(lx))
+	{
+	  if (s7_is_eqv(sc, slot_value(lx), sc->value)) return(true); /* (set! pi pi) -- this can be confusing! */
+	  /* eqv? needed here because 0 != 0 if one is int_zero and the other a mutable_integer from a loop, etc */
+	  immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->set_symbol, sym));
+	}
+      if (slot_has_setter(lx))
+	{
+	  s7_pointer func = slot_setter(lx);
+	  if (is_c_function(func))
+	    sc->value = call_c_function_setter(sc, func, sym, sc->value); /* perhaps better: apply_c_function -- has argnum error checks */
+	  else
+	    if (is_any_procedure(func))
+	      {
+		/* don't push OP_EVAL_DONE here and call eval(sc, OP_APPLY) below -- setter might hit an error */
+		/* 41297 (set! (v) val) where v=vector gets the setter, but calls vector-set! with no args */
+		push_stack_no_args(sc, OP_SET_FROM_SETTER, lx);
+		if (has_let_arg(func))
+		  sc->args = list_3(sc, sym, sc->value, sc->curlet);
+		else sc->args = list_2(sc, sym, sc->value);   /* these lists are reused as the closure_let slots in apply_lambda via apply_closure */
+		sc->code = func;
+		return(false); /* goto APPLY */
+	      }}
+      slot_set_value(lx, sc->value);
+      symbol_increment_ctr(sym);        /* see define setfib example in s7test.scm -- I'm having second thoughts about this... */
+      return(true); /* continue */
+    }
+  if ((!is_let(sc->curlet)) ||              /* (with-let (rootlet) (set! undef 3)) */
+      (!has_let_set_fallback(sc->curlet)))  /* (with-let (mock-hash-table 'b 2) (set! b 3)) */
+    error_nr(sc, sc->unbound_variable_symbol, set_elist_4(sc, wrap_string(sc, "~S is unbound in (set! ~S ~S)", 29), sym, sym, sc->value));
+  sc->value = call_let_set_fallback(sc, sc->curlet, sym, sc->value);
+  return(true);
+}
+
+static bool op_set_with_let_1(s7_scheme *sc)
+{
+  s7_pointer e, b, x = sc->value;
+  /* from the T_SYNTAX branch of op_set_pair: (set! (with-let e b) x) as in let-temporarily
+   *   here sc->value is the new value for the settee = x, args has the (as yet unevaluated) let and settee-expression.
+   *   'b above can be a pair = generalized set in the 'e environment.
+   */
+  if (!is_pair(sc->args))                /* (set! (with-let) ...) */
+    syntax_error_nr(sc, "with-let needs a let and a symbol: (set! (with-let) ~$)", 55, sc->value);
+  if (!is_pair(cdr(sc->args)))           /* (set! (with-let e) ...) */
+    error_nr(sc, sc->syntax_error_symbol,
+	     set_elist_3(sc, wrap_string(sc, "with-let in (set! (with-let ~S) ~$) has no symbol to set?", 57), car(sc->args), sc->value));
+
+  e = car(sc->args);
+  b = cadr(sc->args);
+  if (is_multiple_value(x))              /* (set! (with-let lt) (values 1 2)) */
+    error_nr(sc, sc->syntax_error_symbol,
+	     set_elist_4(sc, wrap_string(sc, "can't (set! (with-let ~S ~S) (values ~{~S~^ ~})): too many values", 65), e, b, x));
+
+  if (is_symbol(e))
+    {
+      if (is_symbol(b))
+	{
+	  e = lookup_checked(sc, e);     /* the let */
+	  if (!is_let(e))
+	    wrong_type_error_nr(sc, sc->let_set_symbol, 1, e, a_let_string);
+	  sc->value = let_set_1(sc, e, b, x);
+	  pop_stack(sc);
+	  return(true);
+	}
+      sc->value = lookup_checked(sc, e);
+      sc->code = set_plist_3(sc, sc->set_symbol, b, ((is_symbol(x)) || (is_pair(x))) ? set_plist_2(sc, sc->quote_function, x) : x);
+      /* (let* ((x (vector 1 2)) (lt (curlet))) (set! (with-let lt (x 0)) 32) x) here: (set! (x 0) 32) */
+      return(false); /* goto SET_WITH_LET */
+    }
+  sc->code = e;                            /* 'e above, an expression we need to evaluate */
+  sc->args = set_plist_2(sc, b, x);        /* can't reuse sc->args here via set-car! etc */
+  push_stack_direct(sc, OP_SET_WITH_LET_2);
+  sc->cur_op = optimize_op(sc->code);
+  return(true); /* goto top_no_pop */
+}
+
+static bool op_set_with_let_2(s7_scheme *sc)
+{
+  s7_pointer b, x;
+  /* here sc->value = let = 'e, args = '(b x) where 'b might be a pair */
+  if (!is_let(sc->value))
+    wrong_type_error_nr(sc, sc->let_set_symbol, 1, sc->value, a_let_string);
+  b = car(sc->args);
+  if ((!is_symbol(b)) && (!is_pair(b)))
+    error_nr(sc, sc->syntax_error_symbol,
+	     set_elist_3(sc, wrap_string(sc, "can't set ~S in ~$", 18), b, set_ulist_1(sc, global_value(sc->set_symbol), sc->args)));
+  x = cadr(sc->args);
+  if (is_symbol(b))   /* b is a symbol -- everything else is ready so call let-set! */
+    {
+      sc->value = let_set_1(sc, sc->value, b, x);
+      return(true); /* continue */
+    }
+  if ((is_symbol(x)) || (is_pair(x)))                        /* (set! (with-let (inlet :v (vector 1 2)) (v 0)) 'a) */
+    sc->code = list_3(sc, sc->set_symbol, b,
+		      ((is_symbol(x)) || (is_pair(x))) ? list_2(sc, sc->quote_function, x) : x);
+  else sc->code = cons(sc, sc->set_symbol, sc->args);        /* (set! (with-let (curlet) (*s7* 'print-length)) 16), x=16 b=(*s7* 'print-length) */
+  return(false); /* fall into SET_WITH_LET */
+}
+
+static bool op_set_normal(s7_scheme *sc)
+{
+  s7_pointer x;
+  sc->code = cdr(sc->code);
+  x = cadr(sc->code);
+  if (is_pair(x))
+    {
+      push_stack_no_args(sc, OP_SET1, car(sc->code));
+      sc->code = x;
+      return(true);
+    }
+  sc->value = (is_symbol(x)) ? lookup_checked(sc, x) : T_Ext(x);
+  sc->code = car(sc->code);
+  return(false);
+}
+
+static Inline void inline_op_increment_by_1(s7_scheme *sc)  /* ([set!] ctr (+ ctr 1)) -- why is this always inlined? saves 22 in concordance */
+{
+  s7_pointer val, y = T_Slt(s7_slot(sc, cadr(sc->code)));
+  val = slot_value(y);
+  if (is_t_integer(val))
+    sc->value = make_integer(sc, integer(val) + 1);
+  else
+    switch (type(val))
+      {
+      case T_RATIO:
+	new_cell(sc, sc->value, T_RATIO);
+	set_numerator(sc->value, numerator(val) + denominator(val));
+	set_denominator(sc->value, denominator(val));
+	break;
+      case T_REAL:
+	sc->value = make_real(sc, real(val) + 1.0);
+	break;
+      case T_COMPLEX:
+	new_cell(sc, sc->value, T_COMPLEX);
+	set_real_part(sc->value, real_part(val) + 1.0);
+	set_imag_part(sc->value, imag_part(val));
+	break;
+      default:
+	sc->value = add_p_pp(sc, val, int_one);
+	break;
+      }
+  slot_set_value(y, sc->value);
+}
+
+static void op_decrement_by_1(s7_scheme *sc)  /* ([set!] ctr (- ctr 1)) */
+{
+  s7_pointer val, y = T_Slt(s7_slot(sc, cadr(sc->code)));
+  val = slot_value(y);
+  if (is_t_integer(val))
+    sc->value = make_integer(sc, integer(val) - 1); /* increment (set!) returns the new value in sc->value */
+  else
+    switch (type(val))
+      {
+      case T_RATIO:
+	new_cell(sc, sc->value, T_RATIO);
+	set_numerator(sc->value, numerator(val) - denominator(val));
+	set_denominator(sc->value, denominator(val));
+	break;
+      case T_REAL:
+	sc->value = make_real(sc, real(val) - 1.0);
+	break;
+      case T_COMPLEX:
+	new_cell(sc, sc->value, T_COMPLEX);
+	set_real_part(sc->value, real_part(val) - 1.0);
+	set_imag_part(sc->value, imag_part(val));
+	break;
+      default:
+	sc->value = g_subtract(sc, set_plist_2(sc, val, int_one));
+	break;
+      }
+  slot_set_value(y, sc->value);
+}
+
+
+/* ---------------- implicit ref/set ---------------- */
+static Inline bool inline_op_implicit_vector_ref_a(s7_scheme *sc) /* called once in eval */
+{
+  s7_pointer x, v = lookup_checked(sc, car(sc->code));
+  if (!is_any_vector(v)) {sc->last_function = v; return(false);}
+  x = fx_call(sc, cdr(sc->code));
+  if ((s7_is_integer(x)) &&
+      (vector_rank(v) == 1))
+    {
+      s7_int index = s7_integer_clamped_if_gmp(sc, x);
+      if ((index < vector_length(v)) && (index >= 0))
+	{
+	  sc->value = (is_float_vector(v)) ? make_real(sc, float_vector(v, index)) : vector_getter(v)(sc, v, index);
+	  return(true);
+	}}
+  sc->value = vector_ref_1(sc, v, set_plist_1(sc, x));
+  return(true);
+}
+
+static s7_pointer fx_implicit_vector_ref_a(s7_scheme *sc, s7_pointer arg)
+{
+  s7_pointer x, v = lookup_checked(sc, car(arg));
+  if (!is_any_vector(v))
+    return(s7_apply_function(sc, v, list_1(sc, fx_call(sc, cdr(arg)))));
+  x = fx_call(sc, cdr(arg));
+  if ((s7_is_integer(x)) &&
+      (vector_rank(v) == 1))
+    {
+      s7_int index = s7_integer_clamped_if_gmp(sc, x);
+      if ((index < vector_length(v)) && (index >= 0))
+	return(vector_getter(v)(sc, v, index));
+    }
+  return(vector_ref_1(sc, v, set_plist_1(sc, x)));
+}
+
+static bool op_implicit_vector_ref_aa(s7_scheme *sc) /* if Inline 70 in concordance */
+{
+  s7_pointer x, y, code;
+  s7_pointer v = lookup_checked(sc, car(sc->code));
+  if ((!is_any_vector(v)) || (vector_rank(v) != 2))
+    {
+      sc->last_function = v;
+      return(false);
+    }
+  code = cdr(sc->code);
+  x = fx_call(sc, code);
+  gc_protect_via_stack(sc, x);
+  y = fx_call(sc, cdr(code));
+  set_gc_protected2(sc, y);
+  if ((s7_is_integer(x)) && (s7_is_integer(y)) &&
+      (vector_rank(v) == 2))
+    {
+      s7_int ix = s7_integer_clamped_if_gmp(sc, x);
+      s7_int iy = s7_integer_clamped_if_gmp(sc, y);
+      if ((ix >= 0) && (iy >= 0) &&
+	  (ix < vector_dimension(v, 0)) && (iy < vector_dimension(v, 1)))
+	{
+	  s7_int index = (ix * vector_offset(v, 0)) + iy;
+	  sc->value = vector_getter(v)(sc, v, index); /* check for normal vector saves in some cases, costs in others */
+	  unstack_gc_protect(sc);
+	  return(true);
+	}}
+  sc->value = vector_ref_1(sc, v, set_plist_2(sc, x, y));
+  unstack_gc_protect(sc);
+  return(true);
+}
+
+static /* inline */ bool op_implicit_vector_set_3(s7_scheme *sc) /* inline no diffs? */
+{
+  s7_pointer i1, code = cdr(sc->code);
+  s7_pointer v = lookup(sc, caar(code));
+  if (!is_any_vector(v))
+    {
+      /* this could be improved -- set_pair3 perhaps: pair3 set opt3? but this calls g_vector_set_3 */
+      pair_set_syntax_op(sc->code, OP_SET_UNCHECKED);
+      return(true);
+    }
+  i1 = fx_call(sc, cdar(code)); /* gc protect? */
+  set_car(sc->t3_3, fx_call(sc, cdr(code)));
+  set_car(sc->t3_1, v);
+  set_car(sc->t3_2, i1);
+  sc->value = g_vector_set_3(sc, sc->t3_1); /* calls vector_setter handling any vector type whereas vector_set_p_ppp wants a normal vector */
+  /* sc->value = vector_set_p_ppp(sc, v, i1, fx_call(sc, cdr(code))); */
+  return(false);
+}
+
+static bool op_implicit_vector_set_4(s7_scheme *sc)
+{
+  s7_pointer i1, i2, code = cdr(sc->code);
+  s7_pointer v = lookup(sc, caar(code));
+  if (!is_any_vector(v))
+    {
+      pair_set_syntax_op(sc->code, OP_SET_UNCHECKED);
+      return(true);
+    }
+  i1 = fx_call(sc, cdar(code));
+  i2 = fx_call(sc, opt3_pair(sc->code)); /* cddar(code) */
+  set_car(sc->t3_3, fx_call(sc, cdr(code)));
+  set_car(sc->t4_1, v);
+  set_car(sc->t3_1, i1);
+  set_car(sc->t3_2, i2);
+  sc->value = g_vector_set_4(sc, sc->t4_1);
+  set_car(sc->t4_1, sc->F);
+  return(false);
+}
+
+static goto_t call_set_implicit(s7_scheme *sc, s7_pointer obj, s7_pointer inds, s7_pointer val, s7_pointer form);
+
+static goto_t set_implicit_vector(s7_scheme *sc, s7_pointer vect, s7_pointer inds, s7_pointer val, s7_pointer form)
+{
+  /* vect is the vector, sc->code is expr without the set!, form is the full expr, args have not been evaluated! */
+  s7_pointer index;
+  s7_int argnum;
+
+  if (!is_pair(inds))
+    wrong_number_of_arguments_error_nr(sc, "no index for implicit vector-set!: ~S", 37, form);
+  if (is_immutable_vector(vect))
+    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->vector_set_symbol, vect));
+
+  argnum = proper_list_length(inds);
+  if ((argnum > 1) &&
+      (is_t_vector(vect)) &&
+      (argnum != vector_rank(vect)))
+    {
+      /* this block needs to be first to handle (eg):
+       *   (let ((v (vector (inlet 'a 0)))) (set! (v 0 'a) 32) v): #((inlet 'a 32))
+       *   sc->code here: ((v 0 'a) 32)
+       */
+      if (vector_rank(vect) == 1)
+	{
+	  s7_pointer ind = car(inds);
+	  if (is_symbol(ind)) ind = lookup_checked(sc, ind);
+	  if (is_t_integer(ind))
+	    {
+	      s7_pointer obj;
+	      s7_int index1 = integer(ind);
+	      if ((index1 < 0) || (index1 >= vector_length(vect)))
+		out_of_range_error_nr(sc, sc->vector_ref_symbol, int_two, car(inds), (index1 < 0) ? it_is_negative_string : it_is_too_large_string);
+	      obj = vector_element(vect, index1);
+	      if (!is_applicable(obj))
+		error_nr(sc, sc->no_setter_symbol,
+			 set_elist_5(sc, wrap_string(sc, "in ~S, (~S ~S) is ~S which can't take arguments", 47), form, vect, car(inds), obj));
+	      return(call_set_implicit(sc, obj, cdr(inds), val, form));
+	    }}
+      push_stack(sc, OP_SET2, cdr(inds), val);
+      sc->code = list_2(sc, vect, car(inds));
+      return(goto_unopt);
+    }
+
+  if ((argnum > 1) || (vector_rank(vect) > 1))
+    {
+      if ((argnum == 2) &&
+	  (cdr(form) == sc->code) &&     /* form == cdr(sc->code) only on the outer call, thereafter form is the old form for better error messages */
+	  (is_fxable(sc, car(inds))) &&
+	  (is_fxable(sc, cadr(inds))) &&
+	  (is_fxable(sc, car(val))))     /* (set! (v fx fx) fx) */
+	{
+	  fx_annotate_args(sc, inds, sc->curlet);
+	  fx_annotate_arg(sc, val, sc->curlet);
+	  set_opt3_pair(form, cdr(inds));
+	  pair_set_syntax_op(form, OP_IMPLICIT_VECTOR_SET_4);
+	}
+      if ((argnum == vector_rank(vect)) &&
+	  (!is_pair(car(val))))
+	{
+	  s7_pointer p;
+	  for (p = inds; is_pair(p); p = cdr(p))
+	    if (is_pair(car(p))) break;
+	  if (is_null(p))
+	    {
+	      s7_pointer pa;
+	      s7_pointer args = safe_list_if_possible(sc, argnum + 2);
+	      if (in_heap(args)) gc_protect_via_stack(sc, args);
+	      set_car(args, vect);
+	      for (p = inds, pa = cdr(args); is_pair(p); p = cdr(p), pa = cdr(pa))
+		{
+		  index = car(p);
+		  if (is_symbol(index))
+		    index = lookup_checked(sc, index);
+		  if (!s7_is_integer(index))
+		    {
+		      if (in_heap(args)) unstack_gc_protect(sc);
+		      error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "vector-set!: index must be an integer: ~S", 41), form));
+		    }
+		  set_car(pa, index);
+		}
+	      set_car(pa, car(val));
+	      if (is_symbol(car(pa)))
+		set_car(pa, lookup_checked(sc, car(pa)));
+	      sc->value = g_vector_set(sc, args);
+	      if (in_heap(args)) unstack_gc_protect(sc);
+	      else clear_list_in_use(args);
+	      return(goto_start);
+	    }}
+      push_op_stack(sc, sc->vector_set_function); /* vector_setter(vect) has wrong args */
+      sc->code = (is_null(cdr(inds))) ? val : ((is_null(cddr(inds))) ? cons(sc, cadr(inds), val) : pair_append(sc, cdr(inds), T_Lst(val))); /* i.e. rest(args) + val */
+      push_stack(sc, OP_EVAL_ARGS4, list_1(sc, vect), sc->code);
+      sc->code = car(inds);
+      sc->cur_op = optimize_op(sc->code);
+      return(goto_top_no_pop);
+    }
+
+  /* one index, rank == 1 */
+  index = car(inds);
+  if ((is_symbol(car(sc->code))) && /* not (set! (#(a 0 (3)) 1) 0) -- implicit_vector_set_3 assumes symbol vect ref */
+      (cdr(form) == sc->code) &&
+      (is_fxable(sc, index)) &&
+      (is_fxable(sc, car(val))))
+    {
+      fx_annotate_arg(sc, inds, sc->curlet);
+      fx_annotate_arg(sc, val, sc->curlet);
+      pair_set_syntax_op(form, OP_IMPLICIT_VECTOR_SET_3);
+    }
+  if (!is_pair(index))
+    {
+      s7_int ind;
+      s7_pointer value;
+
+      if (is_symbol(index))
+	index = lookup_checked(sc, index);
+      if (!s7_is_integer(index))
+	error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "vector-set!: index must be an integer: ~S", 41), sc->code));
+      ind = s7_integer_clamped_if_gmp(sc, index);
+      if ((ind < 0) || (ind >= vector_length(vect)))
+	out_of_range_error_nr(sc, sc->vector_set_symbol, int_two, index, (ind < 0) ? it_is_negative_string : it_is_too_large_string);
+      value = car(val);
+      if (!is_pair(value))
+	{
+	  if (is_symbol(value))
+	    value = lookup_checked(sc, value);
+	  if (is_typed_t_vector(vect))
+	    typed_vector_setter(sc, vect, ind, value);
+	  else vector_setter(vect)(sc, vect, ind, value);
+	  sc->value = T_Ext(value);
+	  return(goto_start);
+	}
+      push_op_stack(sc, sc->vector_set_function);
+      sc->args = list_2(sc, index, vect);
+      sc->code = val;
+      return(goto_eval_args);
+    }
+  /* here the index calc might be trivial -- (+ i 1) or (- j 1) but this branch hardly ever happens */
+  push_stack(sc, OP_EVAL_ARGS4, list_1(sc, vect), val);
+  push_op_stack(sc, sc->vector_set_function);
+  sc->code = car(inds);
+  sc->cur_op = optimize_op(sc->code);
+  return(goto_top_no_pop);
+}
+
+static goto_t set_implicit_c_object(s7_scheme *sc, s7_pointer c_obj, s7_pointer inds, s7_pointer val, s7_pointer form)
+{
+  s7_pointer index;
+  /* c_obj's set! method needs to provide error checks */
+
+  if ((!is_pair(inds)) || (!is_null(cdr(inds))))
+    {
+      push_op_stack(sc, sc->c_object_set_function);
+      if (is_null(inds))
+	{
+	  push_stack(sc, OP_EVAL_ARGS1, list_1(sc, c_obj), sc->nil);
+	  sc->code = car(val);
+	}
+      else
+	{
+	  sc->code = (is_null(cdr(inds))) ? cons(sc, car(inds), val) : pair_append(sc, cdr(inds), T_Lst(val));
+	  push_stack(sc, OP_EVAL_ARGS4, list_1(sc, c_obj), sc->code);
+	  sc->code = car(inds);
+	}
+      sc->cur_op = optimize_op(sc->code);
+      return(goto_top_no_pop);
+    }
+  index = car(inds);
+  if (!is_pair(index))
+    {
+      s7_pointer value = car(val);
+      if (is_symbol(index))
+	index = lookup_checked(sc, index);
+      if (!is_pair(value))
+	{
+	  if (is_symbol(value))
+	    value = lookup_checked(sc, value);
+	  sc->value = (*(c_object_set(sc, c_obj)))(sc, with_list_t3(c_obj, index, value));
+	  return(goto_start);
+	}
+      push_op_stack(sc, sc->c_object_set_function);
+      sc->args = list_2(sc, index, c_obj);
+      sc->code = val;
+      return(goto_eval_args);
+    }
+  push_stack(sc, OP_EVAL_ARGS4, list_1(sc, c_obj), val);
+  push_op_stack(sc, sc->c_object_set_function);
+  sc->code = car(inds);
+  sc->cur_op = optimize_op(sc->code);
+  return(goto_top_no_pop);
+}
+
+static bool op_implicit_string_ref_a(s7_scheme *sc)
+{
+  s7_int index;
+  s7_pointer s = lookup_checked(sc, car(sc->code));
+  s7_pointer x = fx_call(sc, cdr(sc->code));
+  if (!is_string(s))
+    {
+      sc->last_function = s;
+      return(false);
+    }
+  if (!s7_is_integer(x))
+    {
+      sc->value = string_ref_1(sc, s, set_plist_1(sc, x));
+      return(true);
+    }
+  index = s7_integer_clamped_if_gmp(sc, x);
+  if ((index < string_length(s)) && (index >= 0))
+    {
+      sc->value = chars[((uint8_t *)string_value(s))[index]];
+      return(true);
+    }
+  sc->value = string_ref_1(sc, s, x);
+  return(true);
+}
+
+static goto_t set_implicit_string(s7_scheme *sc, s7_pointer str, s7_pointer inds, s7_pointer val, s7_pointer form)
+{
+  /* here only one index makes sense and it is required, so (set! ("str") #\a), (set! ("str" . 1) #\a) and (set! ("str" 1 2) #\a) are all errors (but see below!) */
+  s7_pointer index;
+
+  if (!is_pair(inds))
+    wrong_number_of_arguments_error_nr(sc, "no index for string set!: ~S", 28, form);
+  if (!is_null(cdr(inds)))
+    wrong_number_of_arguments_error_nr(sc, "too many indices for string set!: ~S", 36, form);
+
+  index = car(inds);
+  if (!is_pair(index))
+    {
+      s7_int ind;
+      if (is_symbol(index))
+	index = lookup_checked(sc, index);
+      if (!s7_is_integer(index))
+	error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "index must be an integer: ~S", 28), form));
+      ind = s7_integer_clamped_if_gmp(sc, index);
+      if ((ind < 0) || (ind >= string_length(str)))
+	out_of_range_error_nr(sc, sc->string_set_symbol, int_two, index, (ind < 0) ? it_is_negative_string : it_is_too_large_string);
+      if (is_immutable_string(str))
+	immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->string_set_symbol, str));
+
+      val = car(val);
+      if (!is_pair(val))
+	{
+	  if (is_symbol(val))
+	    val = lookup_checked(sc, val);
+	  if (is_character(val))
+	    {
+	      string_value(str)[ind] = character(val);
+	      sc->value = val;
+	      return(goto_start);
+	    }
+	  error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "value must be a character: ~S", 29), form));
+	}
+      /* maybe op_implicit_string_set_a as in vector someday, but this code isn't (currently) called much */
+      push_op_stack(sc, sc->string_set_function);
+      sc->args = list_2(sc, index, str);
+      sc->code = cdr(sc->code);
+      return(goto_eval_args);
+    }
+  push_stack(sc, OP_EVAL_ARGS4, list_1(sc, str), val); /* args4 not 1 because we know cdr(sc->code) is a pair */
+  push_op_stack(sc, sc->string_set_function);
+  sc->code = car(inds);
+  sc->cur_op = optimize_op(sc->code);
+  return(goto_top_no_pop);
+}
+
+static goto_t set_implicit_pair(s7_scheme *sc, s7_pointer lst, s7_pointer inds, s7_pointer val, s7_pointer form)
+{
+  s7_pointer index, index_val = NULL, value = car(val);
+
+  if (!is_pair(inds)) /* (!is_pair(val)) and (!is_null(cdr(val))) are apparently caught somewhere else */
+    wrong_number_of_arguments_error_nr(sc, "no index for list-set!: ~S", 26, form);
+
+  index = car(inds);
+  if (!is_pair(index))
+    index_val = (is_normal_symbol(index)) ? lookup_checked(sc, index) : index;
+
+  if (!is_null(cdr(inds)))
+    {
+      /* split (set! (a b c...) v) into (set! ((a b) c ...) v), eval (a b), return (let ((L (list (list 1 2)))) (set! (L 0 0) 3) L) */
+      if (index_val)
+	{
+	  s7_pointer obj = list_ref_1(sc, lst, index_val);
+	  if (!is_applicable(obj))
+	    error_nr(sc, sc->no_setter_symbol,
+		     set_elist_5(sc, wrap_string(sc, "in ~S, (~S ~$) is ~S which can't take arguments", 47), form, lst, index_val, obj));
+	  return(call_set_implicit(sc, obj, cdr(inds), val, form));
+	}
+      push_stack(sc, OP_SET2, cdr(inds), val);            /* (let ((L (list (list 1 2 3)))) (set! (L (- (length L) 1) 2) 0) L) */
+      sc->code = list_2(sc, caadr(form), car(inds));
+      return(goto_unopt);
+    }
+  if (index_val)
+    {
+      if (!is_pair(value))
+	{
+	  set_car(sc->t2_1, index_val);
+	  set_car(sc->t2_2, (is_symbol(value)) ? lookup_checked(sc, value) : value);
+	  sc->value = g_list_set_1(sc, lst, sc->t2_1, 2);
+	  return(goto_start);
+	}
+      push_op_stack(sc, sc->list_set_function); /* because cdr(inds) is nil, we're definitely calling list_set */
+      sc->args = list_2(sc, index_val, lst);                     /* plist unsafe here */
+      sc->code = val;
+      return(goto_eval_args);
+    }
+  push_stack(sc, OP_EVAL_ARGS4, list_1(sc, lst), val); /* plist unsafe here */
+  push_op_stack(sc, sc->list_set_function);
+  sc->code = car(inds);
+  sc->cur_op = optimize_op(sc->code);
+  return(goto_top_no_pop);
+}
+
+static goto_t set_implicit_hash_table(s7_scheme *sc, s7_pointer table, s7_pointer inds, s7_pointer val, s7_pointer form)
+{
+  s7_pointer key, keyval = NULL;
+
+  if (!is_pair(inds)) /* (!is_pair(val)) and (!is_null(cdr(val))) are apparently caught elsewhere */
+    wrong_number_of_arguments_error_nr(sc, "no key for hash-table-set!: ~S", 30, form);
+  if (is_immutable_hash_table(table))
+    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->hash_table_set_symbol, table));
+
+  key = car(inds);
+  if (is_pair(key))
+    {
+      if (is_quote(car(key)))
+	keyval = cadr(key);
+    }
+  else keyval = (is_normal_symbol(key)) ? lookup_checked(sc, key) : key;
+
+  if (!is_null(cdr(inds)))
+    {
+      if (keyval)
+	{
+	  s7_pointer obj = s7_hash_table_ref(sc, table, keyval);
+	  if (obj == sc->F)                           /* (let ((h (hash-table 'b 1))) (set! (h 'a 'asdf) 32)) */
+	    error_nr(sc, sc->syntax_error_symbol,
+		     set_elist_4(sc, wrap_string(sc, "in ~S, ~$ does not exist in ~S", 30), form, keyval, table));
+	  else
+	    if (!is_applicable(obj))                  /* (let ((h (hash-table 'b 1))) (set! (h 'b 'asdf) 32)) */
+	      error_nr(sc, sc->no_setter_symbol,
+		       set_elist_5(sc, wrap_string(sc, "in ~S, (~S ~$) is ~S which can't take arguments", 47), form, table, keyval, obj));
+	  /* (let ((v (hash-table 'a (hash-table 'b 1)))) (set! (v 'a 'b 'b) 32) v) ->
+	   *    error: in (set! (v 'a 'b 'b) 32), ((hash-table 'b 1) 'b) is 1 which can't take arguments
+	   * (let ((v (hash-table 'a (list 1 2)))) (set! (v 'a 1) 5)) -> code: (set! ((1 2) 1) 5) -> 5 (v: (hash-table 'a (1 5)))
+	   */
+	  return(call_set_implicit(sc, obj, cdr(inds), val, form));
+	}
+      push_stack(sc, OP_SET2, cdr(inds), val); /* (let ((L (hash-table 'b (hash-table 'a 1)))) (set! (L (symbol "b") (symbol "a")) 0) L) */
+      sc->code = list_2(sc, caadr(form), key);  /* plist unsafe */
+      return(goto_unopt);
+    }
+  if (keyval)
+    {
+      s7_pointer value = car(val);
+      if (is_pair(value))
+	{
+	  if (is_quote(car(value)))
+	    {
+	      sc->value = s7_hash_table_set(sc, table, keyval, cadr(value));
+	      return(goto_start);
+	    }}
+      else
+	{
+	  sc->value = s7_hash_table_set(sc, table, keyval, (is_normal_symbol(value)) ? lookup_checked(sc, value) : value);
+	  return(goto_start);
+	}
+      push_op_stack(sc, sc->hash_table_set_function); /* because cdr(inds) is nil, we're definitely calling hash_table_set */
+      sc->args = list_2(sc, keyval, table);                        /* plist unsafe here */
+      sc->code = val;
+      return(goto_eval_args);
+    }
+  push_stack(sc, OP_EVAL_ARGS4, list_1(sc, table), val); /* plist unsafe here */
+  push_op_stack(sc, sc->hash_table_set_function);
+  sc->code = car(inds);
+  sc->cur_op = optimize_op(sc->code);
+  return(goto_top_no_pop);
+}
+
+static goto_t set_implicit_let(s7_scheme *sc, s7_pointer let, s7_pointer inds, s7_pointer val, s7_pointer form)
+{
+  s7_pointer sym, symval = NULL;
+
+  if (!is_pair(inds)) /* as above, bad val caught elsewhere */
+    wrong_number_of_arguments_error_nr(sc, "no symbol (variable name) for let-set!: ~S", 42, form);
+
+  sym = car(inds);
+  if (is_pair(sym))
+    {
+      if (is_quote(car(sym)))
+	symval = cadr(sym);
+    }
+  else symval = (is_normal_symbol(sym)) ? lookup_checked(sc, sym) : sym;
+
+  if (!is_null(cdr(inds)))
+    {
+      if (symval)
+	{
+	  s7_pointer obj = let_ref(sc, let, symval);
+	  if (!is_applicable(obj))              /* (let ((h (hash-table 'b 1))) (set! (h 'b 'asdf) 32)) */
+	    error_nr(sc, sc->no_setter_symbol,
+		     set_elist_5(sc, wrap_string(sc, "in ~S, (~S ~$) is ~S which can't take arguments", 47), form, let, symval, obj));
+	  return(call_set_implicit(sc, obj, cdr(inds), val, form));
+	}
+      push_stack(sc, OP_SET2, cdr(inds), val);
+      sc->code = list_2(sc, let, car(inds));
+      return(goto_unopt);
+    }
+  if (symval)
+    {
+      s7_pointer value = car(val);
+      if (!is_pair(value))
+	{
+	  if (is_symbol(value))
+	    value = lookup_checked(sc, value);
+	  sc->value = let_set_2(sc, let, symval, value);
+	  return(goto_start);
+	}
+      push_op_stack(sc, sc->let_set_function);
+      sc->args = list_2(sc, symval, let);
+      sc->code = val;
+      return(goto_eval_args);
+    }
+  push_stack(sc, OP_EVAL_ARGS4, list_1(sc, let), val);
+  push_op_stack(sc, sc->let_set_function);
+  sc->code = car(inds);
+  sc->cur_op = optimize_op(sc->code);
+  return(goto_top_no_pop);
+}
+
+static goto_t set_implicit_c_function(s7_scheme *sc, s7_pointer fnc)  /* (let ((lst (list 1 2))) (set! (list-ref lst 0) 2) lst) */
+{
+  if (!is_t_procedure(c_function_setter(fnc)))
+    {
+      if (!is_any_macro(c_function_setter(fnc)))
+	no_setter_error_nr(sc, fnc);
+      sc->args = (is_null(cdar(sc->code))) ? cdr(sc->code) :
+                  ((is_null(cddar(sc->code))) ? cons(sc, cadar(sc->code), cdr(sc->code)) : pair_append(sc, cdar(sc->code), cdr(sc->code)));
+      sc->code = c_function_setter(fnc);
+      /* here multiple-values can't happen because we don't eval the new-value argument */
+      return(goto_apply);
+    }
+  /* here the setter can be anything, so we need to check the needs_copied_args bit. (set! ((dilambda / (let ((x 3)) (lambda (y) (+ x y))))) 3)! */
+  if (is_null(cdar(sc->code)))
+    {
+      push_stack(sc, OP_EVAL_SET1_NO_MV, sc->nil, c_function_setter(fnc));
+      sc->code = cadr(sc->code); /* new value */
+    }
+  else
+    {
+      if (is_null(cddar(sc->code)))                          /* (set! (fnc ind) val) */
+	push_stack(sc, OP_EVAL_SET2, cadr(sc->code), c_function_setter(fnc));
+      else
+	{
+	  push_op_stack(sc, c_function_setter(fnc));
+	  sc->value = pair_append(sc, cddar(sc->code), cdr(sc->code));
+	  push_stack(sc, OP_EVAL_SET3, sc->nil, sc->value); /* args=evalled, code=unevalled */
+	}
+      sc->code = cadar(sc->code);
+    }
+  sc->cur_op = optimize_op(sc->code);
+  return(goto_top_no_pop);
+}
+
+static goto_t set_implicit_closure(s7_scheme *sc, s7_pointer fnc)
+{
+  s7_pointer setter = closure_setter(fnc);  /* (set! (fnc ind...) val), sc->code = ((fnc ind...) val) */
+  if ((setter == sc->F) && (!closure_no_setter(fnc))) /* maybe closure_setter hasn't been set yet: see fset3 in s7test.scm */
+    setter = setter_p_pp(sc, fnc, sc->curlet);
+  if (!is_t_procedure(setter))
+    {
+      if (!is_any_macro(setter))
+	no_setter_error_nr(sc, fnc);
+      sc->args = (is_null(cdar(sc->code))) ? cdr(sc->code) :
+                  ((is_null(cddar(sc->code))) ? cons(sc, cadar(sc->code), cdr(sc->code)) : pair_append(sc, cdar(sc->code), cdr(sc->code)));
+      sc->code = setter;
+      return(goto_apply);
+    }
+  if (is_null(cdar(sc->code)))                             /* (set! (fnc) val) */
+    {
+      push_stack(sc, OP_EVAL_SET1_NO_MV, sc->nil, setter); /* args=(), code=setter */
+      sc->code = cadr(sc->code);                           /* the value */
+    }
+  else
+    {
+      if (is_null(cddar(sc->code)))                        /* (set! (fnc ind) val) */
+	push_stack(sc, OP_EVAL_SET2, cadr(sc->code), setter);
+      else                                                 /* (set! (fnc inds ...) val) */
+	{
+	  push_op_stack(sc, setter);
+	  sc->value = pair_append(sc, cddar(sc->code), cdr(sc->code));
+	  push_stack(sc, OP_EVAL_SET3, sc->nil, sc->value); /* args=evalled, code=unevalled */
+	}
+      sc->code = cadar(sc->code); /* "ind" above */
+    }
+  sc->cur_op = optimize_op(sc->code);
+  return(goto_top_no_pop);
+}
+
+static goto_t set_implicit_iterator(s7_scheme *sc, s7_pointer iter)
+{
+  s7_pointer setter = iterator_sequence(iter);
+
+  if ((is_any_closure(setter)) || (is_any_macro(setter)))
+    setter = closure_setter(iterator_sequence(iter));
+  else no_setter_error_nr(sc, iter);
+
+  if (!is_null(cdar(sc->code))) /* (set! (iter ...) val) but iter is a thunk */
+    error_nr(sc, sc->wrong_number_of_args_symbol,
+	     set_elist_3(sc, wrap_string(sc, "~S (an iterator): too many arguments: ~S", 40), iter, sc->code));
+
+  if (is_procedure(setter))
+    {
+      push_op_stack(sc, setter);
+      push_stack(sc, OP_EVAL_ARGS1, sc->nil, sc->nil);
+      sc->code = cadr(sc->code);    /* the (as yet unevaluated) value, incoming code was ((obj) val) */
+      sc->cur_op = optimize_op(sc->code);
+      return(goto_top_no_pop);
+    }
+  sc->args = cdr(sc->code);
+  sc->code = setter;
+  return(goto_apply);
+}
+
+static goto_t set_implicit_syntax(s7_scheme *sc, s7_pointer wlet)
+{
+  if (wlet != global_value(sc->with_let_symbol))
+    no_setter_error_nr(sc, wlet);
+
+  /* (set! (with-let a b) x), wlet = with-let, sc->code = ((with-let a b) x)
+   *   a and x are in the current let, b is in a, we need to evaluate a and x, then
+   *   call (with-let a-value (set! b x-value))
+   */
+  sc->args = cdar(sc->code);
+  sc->code = cadr(sc->code);
+  push_stack_direct(sc, OP_SET_WITH_LET_1);
+  sc->cur_op = optimize_op(sc->code);
+  return(goto_top_no_pop);
+}
+
+static goto_t call_set_implicit(s7_scheme *sc, s7_pointer obj, s7_pointer inds, s7_pointer val, s7_pointer form)
+{
+  /* these depend on sc->code making sense given obj as the sequence being set */
+  switch (type(obj))
+    {
+    case T_STRING:     return(set_implicit_string(sc, obj, inds, val, form));
+    case T_PAIR:       return(set_implicit_pair(sc, obj, inds, val, form));
+    case T_HASH_TABLE: return(set_implicit_hash_table(sc, obj, inds, val, form));
+    case T_LET:        return(set_implicit_let(sc, obj, inds, val, form));
+    case T_C_OBJECT:   return(set_implicit_c_object(sc, obj, inds, val, form));
+    case T_ITERATOR:   return(set_implicit_iterator(sc, obj));    /* not sure this makes sense */
+    case T_SYNTAX:     return(set_implicit_syntax(sc, obj));
+
+    case T_INT_VECTOR: case T_FLOAT_VECTOR: case T_VECTOR: case T_BYTE_VECTOR:
+      return(set_implicit_vector(sc, obj, inds, val, form));
+
+    case T_C_MACRO: case T_C_FUNCTION_STAR:
+    case T_C_RST_NO_REQ_FUNCTION: case T_C_FUNCTION:
+      return(set_implicit_c_function(sc, obj)); /* (set! (setter...) ...) also comes here */
+
+    case T_MACRO: case T_MACRO_STAR: case T_BACRO: case T_BACRO_STAR:
+    case T_CLOSURE: case T_CLOSURE_STAR:
+      return(set_implicit_closure(sc, obj));
+
+    default:                    /* (set! (1 2) 3) */
+      if (is_applicable(obj))
+	no_setter_error_nr(sc, obj); /* this is reachable if obj is a goto or continuation: (set! (go 1) 2) in s7test.scm */
+      error_nr(sc, sc->no_setter_symbol,
+	       list_3(sc, wrap_string(sc, "in ~S, ~S has no setter", 23),
+		      cons_unchecked(sc, sc->set_symbol,       /* copy_tree(sc, form) also works but copies too much: we want to copy the ulists */
+				     cons(sc, copy_proper_list(sc, cadr(form)), cddr(form))),
+		      obj));
+    }
+  return(goto_top_no_pop);
+}
+
+static goto_t set_implicit(s7_scheme *sc) /* sc->code incoming is (set! (...) ...) */
+{
+  s7_pointer caar_code, obj, form = sc->code;
+  sc->code = cdr(sc->code);
+  caar_code = caar(sc->code);
+  if (is_symbol(caar_code))
+    {
+      obj = s7_slot(sc, caar_code);
+      obj = (is_slot(obj)) ? slot_value(obj) : unbound_variable(sc, caar_code);
+    }
+  else
+    if (!is_pair(caar_code))
+      obj = caar_code;
+    else
+      {
+	push_stack(sc, OP_SET2, cdar(sc->code), T_Pair(cdr(sc->code)));
+	sc->code = caar_code;
+	sc->cur_op = optimize_op(sc->code);
+	return(goto_top_no_pop);
+      }
+  /* code here is the setter and the value without the "set!": ((window-width) 800), (set! (hi 0) (* 2 3)) -> ((hi 0) (* 2 3)) */
+  /* for gmp case, indices need to be decoded via s7_integer, not just integer */
+  return(call_set_implicit(sc, obj, cdar(sc->code), cdr(sc->code), form));
+}
+
+static noreturn void set_with_let_error_nr(s7_scheme *sc)
+{
+  s7_pointer target = cadr(sc->code), value = caddr(sc->code);
+  error_nr(sc, sc->no_setter_symbol,
+	   set_elist_3(sc, wrap_string(sc, "can't set ~A in ~S", 18), target,
+		       list_3(sc, sc->set_symbol,
+			      (is_pair(target)) ? copy_proper_list(sc, target) : target,
+			      (is_pair(value)) ? copy_proper_list(sc, value) : value)));
+}
+
+static goto_t op_set2(s7_scheme *sc)
+{
+  if (is_pair(sc->value))
+    {
+      /* (let ((L '((1 2 3)))) (set! ((L 0) 1) 32) L), (let ((L '(((1 2 3))))) (set! ((L 0) 0 1) 32) L)
+       * any deeper nesting was handled already by the first eval
+       *   set! looks at its first argument, if it's a symbol, it sets the associated value,
+       *   if it's a list, it looks at the car of that list to decide which setter to call,
+       *   if it's a list of lists, it passes the embedded lists to eval, then looks at the
+       *   car of the result.  This means that we can do crazy things like:
+       *   (let ((x '(1)) (y '(2))) (set! ((if #t x y) 0) 32) x)
+       * the other args need to be evaluated (but not the list as if it were code):
+       *   (let ((L '((1 2 3))) (index 1)) (set! ((L 0) index) 32) L)
+       */
+      if (!s7_is_proper_list(sc, sc->args))        /* (set! ('(1 2) 1 . 2) 1) */
+	syntax_error_nr(sc, "set! target arguments are an improper list: ~A", 46, sc->args);
+      if (is_multiple_value(sc->value))            /* (set! ((values fnc 0)) 32) etc */
+	{
+	  if (is_null(sc->args))
+	    { /* can't assume we're in list-set! here -- first value is target */
+	      sc->code = list_3(sc, sc->set_symbol, multiple_value(sc->value), car(sc->code));
+	      return(goto_eval);
+	    }
+	  else   /* this has to be at least 2 args, sc->args and sc->code make 2 more, so... */
+	    syntax_error_nr(sc, "set!: too many arguments: ~S", 28,
+			    set_ulist_1(sc, sc->set_symbol, pair_append(sc, multiple_value(sc->value), pair_append(sc, sc->args, T_Lst(sc->code)))));
+	}
+      if (is_null(sc->args))
+	syntax_error_nr(sc, "list set!: not enough arguments: ~S", 35, sc->code);
+      push_op_stack(sc, sc->list_set_function);
+      if (!is_null(cdr(sc->args))) sc->code = pair_append(sc, cdr(sc->args), T_Lst(sc->code));
+      push_stack(sc, OP_EVAL_ARGS4, list_1(sc, sc->value), T_Pair(sc->code));
+      sc->code = car(sc->args);
+      return(goto_eval);
+    }
+  if ((is_any_vector(sc->value)) &&
+      (vector_rank(sc->value) == proper_list_length(sc->args))) /* sc->code == new value? */
+    {
+      /* (let ((L #(#(1 2 3) #(4 5 6)))) (set! ((L 1) 0) 32) L)
+       * bad case when args is nil: (let ((L #(#(1 2 3) #(4 5 6)))) (set! ((L 1)) 32) L)
+       */
+      if (sc->args == sc->nil)
+	syntax_error_nr(sc, "vector set!: not enough arguments: ~S", 37, sc->code);
+      push_op_stack(sc, sc->vector_set_function);
+      if (!is_null(cdr(sc->args))) sc->code = pair_append(sc, cdr(sc->args), T_Lst(sc->code));
+      push_stack(sc, OP_EVAL_ARGS4, list_1(sc, sc->value), T_Pair(sc->code));
+      sc->code = car(sc->args);
+      return(goto_eval);
+    }
+  sc->code = cons_unchecked(sc, sc->set_symbol, cons(sc, set_ulist_1(sc, sc->value, sc->args), sc->code)); /* (let ((x 32)) (set! ((curlet) 'x) 3) x) */
+  return(set_implicit(sc));
+}
+
+
+/* -------------------------------- do -------------------------------- */
+static bool safe_stepper_expr(s7_pointer expr, const s7_pointer var)
+{
+  /* for now, just look for stepper as last element of any list
+   *    any embedded set is handled by do_is_safe, so we don't need to descend into the depths
+   */
+  s7_pointer p;
+  if (cadr(expr) == var) return(false);
+  for (p = cdr(expr); is_pair(cdr(p)); p = cdr(p));
+  if (is_pair(p))
+    {
+      if ((is_optimized(p)) &&
+	  (op_has_hop(p)) &&
+	  (is_safe_c_op(optimize_op(p))))
+	return(true);
+      if (car(p) == var) return(false);
+    }
+  else
+    if (p == var) return(false);
+  return(true);
+}
+
+static bool tree_match(s7_pointer tree)
+{
+  if (is_symbol(tree))
+    return(is_matched_symbol(tree));
+  return((is_pair(tree)) &&
+	 ((tree_match(car(tree))) || (tree_match(cdr(tree)))));
+}
+
+static bool all_ints_here(s7_scheme *sc, s7_pointer settee, s7_pointer expr, s7_pointer step_vars) /* see also all_integers above */
+{
+  /* since any type change causes false return, we can accept inits across step-vars */
+  s7_pointer func, sig;
+  if (is_number(expr))
+    return(is_t_integer(expr));
+  if (is_symbol(expr))
+    {
+      s7_pointer val;
+      if (expr == settee) return(true);
+      for (s7_pointer step = step_vars; is_pair(step); step = cdr(step))
+	if (caar(step) == expr)
+	  {
+	    if (!all_ints_here(sc, caar(step), cadar(step), step_vars)) /* TODO: can we lookup step_vars here? or only in do_is_safe? */
+	      return(false);
+	    if (is_pair(cddar(step)))
+	      return(all_ints_here(sc, caar(step), caddar(step), step_vars));
+	    return(true);
+	  }
+      val = lookup_unexamined(sc, expr);
+      return((val) && (is_t_integer(val)));
+    }
+  if (!is_pair(expr)) return(false);
+  if (!is_symbol(car(expr))) return(false);
+  func = lookup_unexamined(sc, car(expr));
+  if (!func) return(false);
+  if ((is_int_vector(func)) || (is_byte_vector(func))) return(true);
+  if (!is_any_c_function(func)) return(false);
+  if ((car(expr) == sc->vector_ref_symbol) && (is_pair(cdr(expr))) && (is_symbol(cadr(expr))))
+    {
+      s7_pointer v = lookup_unexamined(sc, cadr(expr));
+      if ((v) && ((is_int_vector(v)) || (is_byte_vector(v)))) return(true);
+    }
+  sig = c_function_signature(func);
+  if ((is_pair(sig)) &&
+      ((car(sig) == sc->is_integer_symbol) || (car(sig) == sc->is_byte_symbol) ||
+       ((is_pair(car(sig))) &&
+	((direct_memq(sc->is_integer_symbol, car(sig))) || (direct_memq(sc->is_byte_symbol, car(sig)))))))
+    return(true); /* like int-vector or length */
+  if (!is_all_integer(car(expr))) return(false);
+  for (s7_pointer p = cdr(expr); is_pair(p); p = cdr(p))
+    if (!all_ints_here(sc, settee, car(p), step_vars))
+      return(false);
+  return(true);
+}
+
+static bool do_is_safe(s7_scheme *sc, s7_pointer body, s7_pointer stepper, s7_pointer var_list, s7_pointer step_vars, bool *has_set)
+{
+  /* here any (unsafe?) closure or jumping-op (call/cc) or shadowed variable is trouble
+   *   we can free var_list if return(false) not after (!do_is_safe...), but it seems to make no difference, or be slightly slower
+   */
+  /* sc->code is the complete do form (do ...) */
+
+  for (s7_pointer p = body; is_pair(p); p = cdr(p))
+    {
+      s7_pointer expr = car(p);
+      if (is_pair(expr))
+	{
+	  s7_pointer x = car(expr);
+
+	  if ((!is_symbol(x)) && (!is_safe_c_function(x)) && (x != sc->quote_function))
+	    return(false);
+	  /* car(expr) ("x") is not a symbol: ((mus-data loc) chan) for example, but that's actually safe since it's
+	   * just in effect vector-ref, there are several examples in dlocsig: ((group-speakers group) i) etc
+	   */
+
+	  if (is_symbol_and_syntactic(x))
+	    {
+	      s7_pointer func = global_value(x), vars, cp;
+	      opcode_t op = syntax_opcode(func);
+	      switch (op)
+		{
+		case OP_MACROEXPAND:
+		  return(false);
+
+		case OP_QUOTE:
+		  if ((!is_pair(cdr(expr))) || (!is_null(cddr(expr))))  /* (quote . 1) or (quote 1 2) etc */
+		    return(false);
+		  break;
+
+		case OP_LET:    case OP_LET_STAR:
+		case OP_LETREC: case OP_LETREC_STAR:
+		  if ((!is_pair(cdr(expr))) ||
+		      (!is_list(cadr(expr))) ||
+		      (!is_pair(cddr(expr))))
+		    return(false);
+		  cp = var_list;
+		  for (vars = cadr(expr); is_pair(vars); vars = cdr(vars))
+		    {
+		      s7_pointer var;
+		      if (!is_pair(car(vars))) return(false);
+		      var = caar(vars);
+		      if (direct_memq(var, ((op == OP_LET) || (op == OP_LETREC)) ? cp : var_list)) return(false);
+		      if ((!is_symbol(var)) || (is_keyword(var))) return(false);
+		      cp = cons(sc, var, cp);
+		      sc->x = cp;
+		    }
+		  sc->x = sc->unused;
+		  if (!do_is_safe(sc, cddr(expr), stepper, cp, step_vars, has_set)) return(false);
+		  break;
+
+		case OP_DO:
+		  {
+		    s7_pointer combined_vars;
+		    if ((!is_pair(cdr(expr))) || (!is_pair(cddr(expr))))  /* (do) or (do (...)) */
+		      return(false);
+		    cp = var_list;
+		    sc->w = (is_pair(cadr(expr))) ? pair_append(sc, cadr(expr), step_vars) : step_vars;
+		    combined_vars = sc->w;
+		    for (vars = cadr(expr); is_pair(vars); vars = cdr(vars))
+		      {
+			s7_pointer var;
+			if (!is_pair(car(vars))) return(false);
+			var = caar(vars);
+			if ((direct_memq(var, cp)) || (var == stepper)) return(false);
+			cp = cons(sc, var, cp);
+			sc->x = cp;
+			if ((is_pair(cdar(vars))) &&
+			    (!do_is_safe(sc, cdar(vars), stepper, cp, combined_vars, has_set)))
+			  {
+			    sc->x = sc->unused;
+			    return(false);
+			  }}
+		    sc->x = sc->unused;
+		    if (!do_is_safe(sc, caddr(expr), stepper, cp, combined_vars, has_set)) return(false);
+		    if ((is_pair(cdddr(expr))) &&
+			(!do_is_safe(sc, cadddr(expr), stepper, cp, combined_vars, has_set)))
+		      return(false);
+		  }
+		  break;
+
+		case OP_SET:
+		  {
+		    s7_pointer settee;
+		    if ((!is_pair(cdr(expr))) || (!is_pair(cddr(expr))))  /* (set!) or (set! x) */
+		      return(false);
+		    settee = cadr(expr);
+		    if (!is_symbol(settee))             /* (set! (...) ...) which is tricky due to setter functions/macros */
+		      {
+			s7_pointer setv;
+			if ((!is_pair(settee)) || (!is_symbol(car(settee))))
+			  return(false);
+			setv = lookup_unexamined(sc, car(settee));
+			if (!((setv) &&
+			      ((is_sequence(setv)) ||
+			       ((is_c_function(setv)) &&
+				(is_safe_procedure(c_function_setter(setv)))))))
+			  return(false);
+
+			/* if ((has_set) && (!is_sequence(setv))) (*has_set) = true; */
+			/*    ^ trouble in tmock.scm (opt2_fn not set) -- apparently op_simple_do assumes has_fn which set! lacks */
+			if (has_set) (*has_set) = true;
+		      }
+		    else
+		      {
+			s7_pointer end_and_result = caddr(sc->code);
+			if ((is_pair(end_and_result)) &&        /* sc->code = do-form (formerly (cdr(do-form)) causing a bug here) */
+			    (is_pair(car(end_and_result))) &&
+			    (!is_syntax(caar(end_and_result)))) /* 10-Jan-24 */
+			  {
+			    bool res;
+			    set_match_symbol(settee);
+			    res = tree_match(car(end_and_result));  /* (set! end ...) in some fashion */
+			    clear_match_symbol(settee);
+			    if (res) return(false);
+			  }
+			if (!direct_memq(settee, var_list)) /* is some local variable being set? */
+			  {
+			    s7_pointer val = lookup_unexamined(sc, settee);
+			    if (has_set) (*has_set) = true;
+			    if ((val) && (is_t_integer(val)) && (!all_ints_here(sc, settee, caddr(expr), step_vars)))
+			      return(false);
+			  }}
+		    if (!do_is_safe(sc, cddr(expr), stepper, var_list, step_vars, has_set))
+		      return(false);
+		    if (!safe_stepper_expr(expr, stepper))      /* is step var's value used as the stored value by set!? */
+		      return(false);
+		  }
+		  break;
+
+		case OP_LET_TEMPORARILY:
+		  if ((!is_pair(cdr(expr))) ||
+		      (!is_pair(cadr(expr))) ||
+		      (!is_pair(cddr(expr))))
+		    return(false);
+		  for (cp = cadr(expr); is_pair(cp); cp = cdr(cp))
+		    if ((!is_pair(car(cp))) ||
+			(!is_pair(cdar(cp))) ||
+			(!do_is_safe(sc, cdar(cp), stepper, var_list, step_vars, has_set)))
+		      return(false);
+		  if (!do_is_safe(sc, cddr(expr), stepper, var_list, step_vars, has_set)) return(false);
+		  break;
+
+		case OP_COND:
+		  for (cp = cdr(expr); is_pair(cp); cp = cdr(cp))
+		    if (!do_is_safe(sc, car(cp), stepper, var_list, step_vars, has_set))
+		      return(false);
+		  break;
+
+		case OP_CASE:
+		  if ((!is_pair(cdr(expr))) ||
+		      (!do_is_safe(sc, cadr(expr), stepper, var_list, step_vars, has_set)))
+		    return(false);
+		  for (cp = cddr(expr); is_pair(cp); cp = cdr(cp))
+		    if ((!is_pair(car(cp))) ||      /* (case x #(123)...) */
+			(!do_is_safe(sc, cdar(cp), stepper, var_list, step_vars, has_set)))
+		      return(false);
+		  break;
+
+		case OP_IF: case OP_WHEN: case OP_UNLESS:
+		case OP_AND: case OP_OR: case OP_BEGIN:
+		case OP_WITH_BAFFLE:
+		  if (!do_is_safe(sc, cdr(expr), stepper, var_list, step_vars, has_set))
+		    return(false);
+		  break;
+
+		case OP_WITH_LET:
+		  return(false); /* 11-Jan-24, this was true!? */
+
+		default:
+		  return(false);
+		}} /* is_syntax(x=car(expr)) */
+	  else
+	    if (x == sc->quote_function)
+	      {
+		if ((!is_pair(cdr(expr))) || (!is_null(cddr(expr))))  /* (#_quote . 1) or (#_quote 1 2) etc */
+		  return(false);
+	      }
+	    else
+	      {
+		/* if a macro, we'll eventually expand it (if *_optimize), but that requires a symbol lookup here and macroexpand */
+		if ((!is_optimized(expr)) ||
+		    (optimize_op(expr) == OP_UNKNOWN_NP) ||
+		    (!do_is_safe(sc, cdr(expr), stepper, var_list, step_vars, has_set)))
+		  return(false);
+
+		/* is this still needed? fx_c_optcq bug -- tests seem ok without it -- 3.5 in tmat */
+		if ((is_symbol(x)) && (is_slot(global_slot(x))) && (is_syntax(global_value(x)))) /* maybe (x == sc->immutable_symbol)? */
+		  return(false); /* syntax hidden behind some other name */
+
+		if ((is_symbol(x)) && (is_setter(x)))             /* "setter" includes stuff like cons and vector -- x is a symbol */
+		  {
+		    /* (hash-table-set! ht i 0) -- caddr is being saved, so this is not safe
+		     *   similarly (vector-set! v 0 i) etc
+		     */
+		    if (is_null(cdr(expr)))
+		      {
+			if (is_null(cdr(p)))                    /* (vector) for example */
+			  return((x == sc->vector_symbol) || (x == sc->list_symbol) || (x == sc->string_symbol));
+		      }
+		    else
+		      {
+			if ((has_set) &&
+			    (!direct_memq(cadr(expr), var_list)) &&   /* non-local is being changed */
+			    ((cadr(expr) == stepper) ||               /* stepper is being set? */
+			     (!is_pair(cddr(expr))) ||
+			     (!is_pair(cdddr(expr))) ||
+			     (is_pair(cddddr(expr))) ||
+			     ((x == sc->hash_table_set_symbol) && (caddr(expr) == stepper)) ||
+			     (cadddr(expr) == stepper) ||             /* used to check is_symbol here and above but that's unnecessary */
+			     ((is_pair(cadddr(expr))) && (s7_tree_memq(sc, stepper, cadddr(expr))))))
+			  (*has_set) = true;
+
+			if (!do_is_safe(sc, cddr(expr), stepper, var_list, step_vars, has_set))
+			  return(false);
+			if (!safe_stepper_expr(expr, stepper))
+			  return(false);
+		      }}}}}
+  return(true);
+}
+
+static bool preserves_type(s7_scheme *sc, uint32_t x)
+{
+  return((x == sc->add_class) ||
+	 (x == sc->subtract_class) ||
+	 (x == sc->multiply_class));
+}
+
+static s7_pointer simple_stepper(s7_scheme *sc, s7_pointer v)
+{
+  if ((is_proper_list_3(sc, v)) &&
+      (is_fxable(sc, cadr(v))))
+    {
+      s7_pointer step_expr = caddr(v);
+      if ((is_optimized(step_expr)) &&
+	  (((optimize_op(step_expr) == HOP_SAFE_C_SC) && (car(v) == cadr(step_expr))) ||
+	   ((is_h_safe_c_nc(step_expr)) &&       /* replace with is_fxable? */
+	    (is_pair(cdr(step_expr))) &&         /* ((v 0 (+))) */
+	    (car(v) == cadr(step_expr)) &&
+	    ((opt1_cfunc(step_expr) == sc->add_x1) || (opt1_cfunc(step_expr) == sc->subtract_x1))) ||
+	   ((optimize_op(step_expr) == HOP_SAFE_C_CS) && (car(v) == caddr(step_expr)))))
+	return(step_expr);
+    }
+  return(NULL);
+}
+
+static bool is_simple_end(s7_scheme *sc, s7_pointer end)
+{
+  return((is_optimized(end)) &&
+	 (is_safe_c_op(optimize_op(end))) &&
+	 (is_pair(cddr(end))) &&      /* end: (zero? n) */
+	 (cadr(end) != caddr(end)) &&
+	 ((opt1_cfunc(end) == sc->num_eq_xi) ||
+	  (optimize_op(end) == HOP_SAFE_C_SS) || (optimize_op(end) == HOP_SAFE_C_SC)));
+}
+
+static s7_pointer fxify_step_exprs(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer vars = car(code);
+  s7_pointer e = collect_variables(sc, vars, sc->nil); /* only valid in step exprs, not in inits */
+
+  for (s7_pointer p = vars; is_pair(p); p = cdr(p))
+    {
+      s7_function callee = NULL;
+      s7_pointer expr = cdar(p);    /* init */
+      if (is_pair(expr))
+	{
+	  callee = fx_choose(sc, expr, sc->nil, do_symbol_is_safe); /* not vars -- they aren't defined yet */
+	  if (callee) set_fx(expr, callee);
+	}
+      expr = cddar(p);   /* step */
+      if (is_pair(expr))
+	{
+	  if ((is_pair(car(expr))) &&
+	      (!is_checked(car(expr))))
+	    optimize_expression(sc, car(expr), 0, e, false);
+	  callee = fx_choose(sc, expr, vars, do_symbol_is_safe);  /* fx_proc can be nil! */
+	  if (callee) set_fx(expr, callee);
+	}}
+  if ((is_pair(cdr(code))) &&
+      (is_pair(cadr(code))))
+    {
+      s7_pointer result = cdadr(code);
+      if ((is_pair(result)) &&
+	  (is_fxable(sc, car(result))))
+	set_fx_direct(result, fx_choose(sc, result, vars, do_symbol_is_safe));
+    }
+  return(code);
+}
+
+static bool do_vector_has_definers(s7_pointer v)
+{
+  s7_int len = vector_length(v);
+  s7_pointer *els = vector_elements(v);
+  for (s7_int i = 0; i < len; i++)
+    if ((is_pair(els[i])) &&
+	(is_symbol(car(els[i]))) &&
+	(is_definer(car(els[i])))) /* this is a desperate kludge */
+      return(true);
+  return(false);
+}
+
+static /* inline */ bool do_tree_has_definers(s7_scheme *sc, s7_pointer tree)
+{
+  /* we can't be very fancy here because quote gloms up everything: (cond '(define x 0) ...) etc, and the tree here can
+   *   be arbitrarily messed up, and we need to be reasonably fast.  So we accept some false positives: (case ((define)...)...) or '(define...)
+   * but what about ((f...)...) where (f...) returns a macro that defines something? Or (for-each or ...) where for-each and or might be
+   * obfuscated and the args might contain a definer?
+   */
+  for (s7_pointer p = tree; is_pair(p); p = cdr(p))
+    {
+      s7_pointer pp = car(p);
+      if (is_symbol(pp))
+	{
+	  if (is_definer(pp))
+	    {
+	      if (pp == sc->varlet_symbol) /* tlet case (varlet e1 ...) */
+		{
+		  if ((is_pair(cdr(p))) && (is_symbol(cadr(p))) && (!symbol_is_in_list(sc, cadr(p))))
+		    return(true);
+		}
+	      else
+		if (pp == sc->apply_symbol)
+		  {
+		    s7_pointer val;
+		    if ((!is_pair(cdr(p))) || (!is_symbol(cadr(p)))) return(true);
+		    val = lookup_unexamined(sc, cadr(p));
+		    if ((!val) || (!is_c_function(val))) return(true);
+		  }
+		else return(true);
+	    }}
+      else
+	if (is_pair(pp))
+	  {
+	    if (do_tree_has_definers(sc, pp))
+	      return(true);
+	  }
+	else
+	  if ((is_applicable(pp)) &&
+	      (((is_t_vector(pp)) && (do_vector_has_definers(pp))) ||
+	       ((is_c_function(pp)) && (is_func_definer(pp))) ||
+	       ((is_syntax(pp)) && (is_syntax_definer(pp)))))
+	    return(true);
+    }
+  return(false);
+}
+
+static void check_do_for_obvious_errors(s7_scheme *sc, s7_pointer form)
+{
+  s7_pointer x, code = cdr(form);
+
+  if ((!is_pair(code)) ||                             /* (do . 1) */
+      ((!is_pair(car(code))) &&                       /* (do 123) */
+       (is_not_null(car(code)))))                     /* (do () ...) is ok */
+    syntax_error_nr(sc, "do: variable list is not a list: ~S", 35, form);
+
+  if (!is_pair(cdr(code)))                            /* (do () . 1) */
+    syntax_error_nr(sc, "do body is messed up: ~A", 24, form);
+
+  if ((!is_pair(cadr(code))) &&                       /* (do ((i 0)) 123) */
+      (is_not_null(cadr(code))))                      /* no end-test? */
+    syntax_error_nr(sc, "do: end-test and end-value list is not a list: ~A", 49, form);
+
+  if (is_pair(car(code)))
+    {
+      clear_symbol_list(sc);
+      for (x = car(code); is_pair(x); x = cdr(x))
+	{
+	  s7_pointer y = car(x);
+	  if (!(is_pair(y)))                          /* (do (4) (= 3)) */
+	    syntax_error_nr(sc, "do: variable name missing? ~A", 29, form);
+
+	  if (!is_symbol(car(y)))                     /* (do ((3 2)) ()) */
+	    syntax_error_nr(sc, "do step variable: ~S is not a symbol?", 37, y);
+
+	  if (is_constant_symbol(sc, car(y)))         /* (do ((pi 3 (+ pi 1))) ((= pi 4)) pi) */
+	    syntax_error_nr(sc, "do step variable: ~S is immutable", 33, y);
+
+	  if (!is_pair(cdr(y)))
+	    syntax_error_nr(sc, "do: step variable has no initial value: ~A", 42, x);
+	  if (!is_pair(cddr(y)))
+	    {
+	      if (is_not_null(cddr(y)))               /* (do ((i 0 . 1)) ...) */
+		syntax_error_nr(sc, "do: step variable info is an improper list?: ~A", 47, x);
+	    }
+	  else
+	    if (is_not_null(cdddr(y)))                /* (do ((i 0 1 (+ i 1))) ...) */
+	      syntax_error_nr(sc, "do: step variable info has extra stuff after the increment: ~A", 62, x);
+	  set_local(car(y));
+
+	  if (symbol_is_in_list(sc, car(y)))          /* (do ((i 0 (+ i 1)) (i 2))...) */
+	    syntax_error_nr(sc, "duplicate identifier in do: ~A", 30, x);
+	  add_symbol_to_list(sc, car(y));
+	}
+      if (is_not_null(x))                             /* (do ((i 0 i) . 1) ((= i 1))) */
+	syntax_error_nr(sc, "do: list of variables is improper: ~A", 37, form);
+    }
+  if (is_pair(cadr(code)))
+    {
+      for (x = cadr(code); is_pair(x); x = cdr(x));
+      if (is_not_null(x))                             /* (do ((i 0 (+ i 1))) ((= i 2) . 3) */
+	syntax_error_nr(sc, "stray dot in do end section? ~A", 31, form);
+    }
+  for (x = cddr(code); is_pair(x); x = cdr(x));
+  if (is_not_null(x))
+    syntax_error_nr(sc, "stray dot in do body? ~A", 24, form);
+}
+
+static s7_pointer do_end_bad(s7_scheme *sc, s7_pointer form)
+{
+  s7_pointer code = cdr(form);
+  if (is_null(cddr(code)))
+    {
+      s7_pointer p;
+      /* no body, end not fxable (if eval car(end) might be unopt) */
+      for (p = car(code); is_pair(p); p = cdr(p))  /* gather var names */
+	{
+	  s7_pointer var = car(p);
+	  if (is_pair(cddr(var)))                  /* if no step expr it's safe in other step exprs 16-Apr-19 */
+	    set_match_symbol(car(var));
+	}
+      for (p = car(code); is_pair(p); p = cdr(p))  /* look for stuff like (do ((i 0 j) (j 0 (+ j 1))) ((= j 3) i)) */
+	{
+	  s7_pointer var = car(p);
+	  s7_pointer val = cddr(var);
+	  if (is_pair(val))
+	    {
+	      clear_match_symbol(car(var));        /* ignore current var */
+	      if (tree_match(car(val)))
+		{
+		  for (s7_pointer q = car(code); is_pair(q); q = cdr(q))
+		    clear_match_symbol(caar(q));
+		  return(code);
+		}}
+	  set_match_symbol(car(var));
+	}
+      for (p = car(code); is_pair(p); p = cdr(p))  /* clear var names */
+	clear_match_symbol(caar(p));
+
+      if (is_null(p))
+	{
+	  if ((is_null(cadr(code))) && /* (do () ()) or (do (fxable vars) ()) */
+	      (is_null(cddr(code))))
+	    {
+	      if (sc->safety > NO_SAFETY)
+		s7_warn(sc, 256, "%s: infinite do loop: %s\n", __func__, display(form));
+	      return(code);
+	    }
+	  fxify_step_exprs(sc, code);
+	  for (p = car(code); is_pair(p); p = cdr(p))
+	    {
+	      s7_pointer var = car(p);
+	      if ((!has_fx(cdr(var))) ||
+		  ((is_pair(cddr(var))) && (!has_fx(cddr(var)))))
+		return(code);
+	    }
+	  pair_set_syntax_op(form, OP_DO_NO_BODY_NA_VARS);
+	  return(sc->nil);
+	}}
+  return(fxify_step_exprs(sc, code));
+}
+
+static s7_pointer check_do(s7_scheme *sc)
+{
+  /* returns nil if optimizable */
+  s7_pointer form = sc->code, code, vars, end, body, p;
+
+  check_do_for_obvious_errors(sc, form);
+  pair_set_syntax_op(form, OP_DO_UNCHECKED);
+  code = cdr(form);
+  end = cadr(code);
+
+  if ((!is_pair(end)) || (!is_fxable(sc, car(end))))
+    return(do_end_bad(sc, form)); /* can return code (not sc->nil) */
+
+  /* sc->curlet is the outer environment, local vars are in the symbol_list via check_do_for_obvious_error, and it's only needed for fx_unsafe_s */
+  set_fx_direct(end, fx_choose(sc, end, sc->curlet, let_symbol_is_safe_or_listed));
+  if ((is_pair(cdr(end))) &&
+      (is_fxable(sc, cadr(end))))
+    set_fx_direct(cdr(end), fx_choose(sc, cdr(end), sc->curlet, let_symbol_is_safe_or_listed));
+
+  vars = car(code);
+  if (is_null(vars))
+    {
+      pair_set_syntax_op(form, OP_DO_NO_VARS);
+      if (is_fx_treeable(end))
+	{
+	  if ((is_pair(car(end))) && /* this code is repeated below */
+	      (has_fx(end)) &&
+	      (!(is_syntax(caar(end)))) &&
+	      (!((is_symbol(caar(end))) && (is_definer_or_binder(caar(end))))))
+	    {
+	      s7_pointer v1 = NULL, v2 = NULL, v3 = NULL;
+	      bool more_vs = false;
+	      if (tis_slot(let_slots(sc->curlet))) /* outer vars */
+		{
+		  p = let_slots(sc->curlet);
+		  v1 = slot_symbol(p);
+		  p = next_slot(p);
+		  if (tis_slot(p))
+		    {
+		      v2 = slot_symbol(p);
+		      p = next_slot(p);
+		      if (tis_slot(p))
+			{
+			  v3 = slot_symbol(p);
+			  more_vs = tis_slot(next_slot(p));
+			}}}
+	      if (v1) fx_tree_outer(sc, end, v1, v2, v3, more_vs);
+	    }}
+      return(sc->nil);
+    }
+
+  if (do_tree_has_definers(sc, form))           /* we don't want definers in body, vars, or end test */
+    return(fxify_step_exprs(sc, code));
+
+  body = cddr(code);
+  if ((is_pair(end)) && (is_pair(car(end))) &&   /* end test is a pair */
+      (is_pair(vars)) && (is_null(cdr(vars))) && /* one stepper */
+      (is_pair(body)) && (is_pair(car(body))) && /* body is normal-looking */
+      ((is_symbol(caar(body))) || (is_safe_c_function(caar(body)))))
+    {
+      /* loop has one step variable, and normal-looking end test */
+      s7_pointer v = car(vars), step_expr;
+
+      fx_tree(sc, end, car(v), NULL, NULL, false);
+      if (is_fx_treeable(body)) /* this is thwarted by gotos */
+	fx_tree(sc, body, car(v), NULL, NULL, false);
+
+      step_expr = simple_stepper(sc, v);
+      if (step_expr)
+	{
+	  s7_pointer orig_end = end;
+	  set_fx(cdr(v), fx_choose(sc, cdr(v), vars, do_symbol_is_safe)); /* v is (i 0 (+ i 1)) or the like */
+
+	  /* step var is (var const|symbol (op var const)|(op const var)) */
+	  end = car(end);
+	  if ((is_simple_end(sc, end)) &&
+	      (car(v) == cadr(end)))
+	    {
+	      /* end var is (op var const|symbol) using same var as step so at least we can use SIMPLE_DO */
+	      bool has_set = false;
+	      bool one_line = ((is_null(cdr(body))) && (is_pair(car(body))));
+	      if ((car(end) == sc->num_eq_symbol) && (is_symbol(cadr(end))) && (is_t_integer(caddr(end))))
+		{
+		  set_c_function(end, sc->num_eq_2);
+		  set_opt2_con(cdr(end), caddr(end));
+		  set_fx_direct(orig_end, (integer(caddr(end)) == 0) ? fx_num_eq_s0 : fx_num_eq_si);
+		}
+	      set_opt1_any(code, caddr(end)); /* symbol or int(?) */
+	      set_opt2_pair(code, step_expr); /* caddr(caar(code)) */
+	      pair_set_syntax_op(form, OP_SIMPLE_DO);              /* simple_do: 1 var easy step/end */
+
+	      if ((c_function_class(opt1_cfunc(step_expr)) == sc->add_class) &&  /* we check above that (car(v) == cadr(step_expr)) and (car(v) == cadr(end)) */
+		  ((c_function_class(opt1_cfunc(end)) == sc->num_eq_class) ||
+		   (opt1_cfunc(end) == sc->geq_2)))
+		{
+		  if ((one_line) &&
+		      ((!is_optimized(car(body))) || (op_no_hop(car(body)) != OP_SAFE_C_NC)) && /* this does happen: (if (= i 3) (vector-set! j 0 i)) */
+		      (is_symbol_and_syntactic(caar(body))) &&
+		      (s7_is_integer(caddr(step_expr))) && /* this currently blocks s7_optimize of float steppers */
+		      (s7_integer_clamped_if_gmp(sc, caddr(step_expr)) == 1))
+		    {
+		      pair_set_syntax_op(car(body), symbol_syntax_op_checked(car(body)));
+		      pair_set_syntax_op(form, OP_DOTIMES_P);          /* dotimes_p: simple + syntax body + 1 expr */
+		    }
+
+		  if (((caddr(step_expr) == int_one) || (cadr(step_expr) == int_one)) &&
+		      (do_is_safe(sc, body, car(v), sc->nil, vars, &has_set)))
+		    {
+		      pair_set_syntax_op(form, OP_SAFE_DO);             /* safe_do: body is safe, step by 1 */
+		      /* no semipermanent let here because apparently do_is_safe accepts recursive calls? */
+		      if ((!has_set) &&
+			  (c_function_class(opt1_cfunc(end)) == sc->num_eq_class))
+			{
+			  pair_set_syntax_op(form, OP_SAFE_DOTIMES);   /* safe_dotimes: end is = */
+			  if (is_fxable(sc, car(body)))
+			    fx_annotate_arg(sc, body, collect_variables(sc, vars, sc->nil));
+			}
+		      fx_tree(sc, body, car(v), NULL, NULL, false);
+		      if (stack_top_op(sc) == OP_SAFE_DO_STEP)
+			fx_tree_outer(sc, body, caaar(stack_top_code(sc)), NULL, NULL, true);
+		    }}
+	      return(sc->nil);
+	    }}}
+
+  /* we get here if there is more than one local var or anything "non-simple" about the rest */
+  for (p = vars; is_pair(p); p = cdr(p))
+    {
+      s7_pointer var = car(p);
+      if ((!is_fxable(sc, cadr(var))) ||
+	  ((is_pair(cddr(var))) && (!is_fxable(sc, caddr(var)))) ||
+	  ((is_symbol(cadr(var))) && (is_definer_or_binder(cadr(var)))))
+	{
+	  for (s7_pointer q = vars; q != p; q = cdr(q))
+	    clear_match_symbol(caar(q));
+	  return(fxify_step_exprs(sc, code));
+	}
+      if (is_pair(cddr(var))) /* if no step expr it's safe in other step exprs 16-Apr-19 */
+	set_match_symbol(car(var));
+    }
+
+  {
+    s7_pointer stepper0 = NULL, stepper1 = NULL, stepper2 = NULL, stepper3 = NULL;
+    bool got_pending = false, outer_shadowed = false;
+
+    for (p = vars; is_pair(p); p = cdr(p))
+      {
+	s7_pointer var = car(p);
+	s7_pointer val = cddr(var);
+	stepper3 = stepper2;
+	stepper2 = stepper1;
+	stepper1 = stepper0;
+	stepper0 = car(var);
+	if (is_pair(val))
+	  {
+	    var = car(var);
+	    clear_match_symbol(var); /* ignore current var */
+	    if (tree_match(car(val)))
+	      {
+		for (s7_pointer q = vars; is_pair(q); q = cdr(q))
+		  clear_match_symbol(caar(q));
+		if (is_null(body))
+		  got_pending = true;
+		else return(fxify_step_exprs(sc, code));
+	      }
+	    set_match_symbol(var);
+	  }}
+
+    for (p = vars; is_pair(p); p = cdr(p))
+      set_match_symbol(caar(p));
+    for (p = let_slots(sc->curlet); tis_slot(p); p = next_slot(p))
+      if (is_matched_symbol(slot_symbol(p)))
+	{
+	  outer_shadowed = true;
+	  break;
+	}
+    for (p = vars; is_pair(p); p = cdr(p))
+      clear_match_symbol(caar(p));
+
+    /* end and steps look ok! */
+    for (p = vars; is_pair(p); p = cdr(p))
+      {
+	s7_pointer var = car(p);
+	set_fx_direct(cdr(var), fx_choose(sc, cdr(var), sc->curlet, let_symbol_is_safe)); /* init val */
+	if (is_pair(cddr(var)))
+	  {
+	    s7_pointer step_expr = caddr(var);
+	    set_fx_direct(cddr(var), fx_choose(sc, cddr(var), vars, do_symbol_is_safe)); /* sets opt2(cddr(var)), not opt1 */
+	    if (!is_pair(step_expr))                /* (i 0 0) */
+	      {
+		if (cadr(var) == caddr(var))        /* not types match: (i x y) etc */
+		  set_safe_stepper_expr(cddr(var));
+	      }
+	    else
+	      {
+		s7_pointer endp = car(end);
+		s7_pointer var1 = car(var);
+		if ((!is_quote(car(step_expr))) &&     /* opt1_cfunc(==opt1) might not be set in this case (sigh) */
+		    (is_safe_c_op(optimize_op(step_expr))) &&
+		    ((preserves_type(sc, c_function_class(opt1_cfunc(step_expr)))) || /* add etc */
+		     (car(step_expr) == sc->cdr_symbol) ||
+		     (car(step_expr) == sc->cddr_symbol) ||
+		     ((is_pair(cadr(var))) &&
+		      (is_pair(c_function_signature(c_function_base(opt1_cfunc(step_expr))))) &&
+		      (car(c_function_signature(c_function_base(opt1_cfunc(step_expr)))) != sc->T) &&
+		      (caadr(var) == car(step_expr)))))	       /* i.e. accept char-position as init/step, but not iterate */
+		  set_safe_stepper_expr(cddr(var));
+
+		if ((is_proper_list_3(sc, endp)) && (is_proper_list_3(sc, step_expr)) &&
+		    ((car(endp) == sc->num_eq_symbol) || (car(endp) == sc->geq_symbol)) &&
+		    (is_symbol(cadr(endp))) &&
+		    ((is_t_integer(caddr(endp))) || (is_symbol(caddr(endp)))) &&
+		    (car(step_expr) == sc->add_symbol) &&
+		    (var1 == cadr(endp)) && (var1 == cadr(step_expr)) &&
+		    ((car(endp) != sc->num_eq_symbol) || ((caddr(step_expr) == int_one))))
+		  set_loop_end_possible(end);
+	      }}}
+    pair_set_syntax_op(form, (got_pending) ? OP_DOX_PENDING_NO_BODY : OP_DOX);
+    /* there are only a couple of cases in snd-test where a multi-statement do body is completely fx-able */
+
+    if ((is_null(body)) &&
+	(is_null(cdr(vars))) &&
+	(is_pair(cdr(end))) &&
+	(is_null(cddr(end))) &&
+	(has_fx(cdr(end))) &&
+	(is_pair(cdar(vars))) &&
+	(is_pair(cddar(vars))))
+      {
+	s7_pointer var = caar(vars);
+	s7_pointer step = cddar(vars);
+	set_opt3_any(code, (in_heap(code)) ? sc->F : make_semipermanent_let(sc, vars));
+	if (!got_pending)
+	  pair_set_syntax_op(form, OP_DOX_NO_BODY);
+	if (is_safe_stepper_expr(step))
+	  {
+	    step = car(step);
+	    if ((is_pair(step)) && (is_proper_list_3(sc, step)))
+	      {
+		if ((car(step) == sc->add_symbol) &&
+		    (((cadr(step) == var) && (caddr(step) == int_one)) ||
+		     (caddr(step) == var)) && (cadr(step) == int_one))
+		  set_opt2_con(code, int_one);
+		else
+		  if ((car(step) == sc->subtract_symbol) &&
+		      (cadr(step) == var) &&
+		      (caddr(step) == int_one))
+		    set_opt2_con(code, minus_one);
+		  else set_opt2_con(code, int_zero);
+	      }
+	    else set_opt2_con(code, int_zero);
+	  }
+	else set_opt2_con(code, int_zero);
+      }
+
+    if (do_passes_safety_check(sc, body, sc->nil, vars, NULL))
+      {
+	s7_pointer var1 = NULL, var2 = NULL, var3 = NULL;
+	bool more_vars = false;
+	if (tis_slot(let_slots(sc->curlet))) /* outer vars */
+	  {
+	    p = let_slots(sc->curlet);
+	    var1 = slot_symbol(p);
+	    p = next_slot(p);
+	    if (tis_slot(p))
+	      {
+		var2 = slot_symbol(p);
+		p = next_slot(p);
+		if (tis_slot(p))
+		  {
+		    var3 = slot_symbol(p);
+		    more_vars = tis_slot(next_slot(p));
+		  }}}
+
+	for (p = vars; is_pair(p); p = cdr(p))
+	  {
+	    s7_pointer var = car(p);
+	    if (is_pair(cdr(var)))
+	      {
+		if (var1) fx_tree_in(sc, cdr(var), var1, var2, var3, more_vars); /* init vals, more_vars refers to outer let, stepper3 == local let more_vars */
+		if (is_pair(cddr(var)))
+		  {
+		    if (stepper0) fx_tree(sc, cddr(var), stepper0, stepper1, stepper2, stepper3);
+		    if ((var1) && (!outer_shadowed) && (!stepper3)) fx_tree_outer(sc, cddr(var), var1, var2, var3, more_vars);
+		  }}}
+
+	if ((is_pair(cdr(end))) &&
+	    (is_null(cddr(end))) &&
+	    (has_fx(cdr(end))))
+	  {
+	    if (!fx_tree_in(sc, cdr(end), stepper0, stepper1, stepper2, stepper3))
+	      fx_tree(sc, cadr(end), stepper0, stepper1, stepper2, stepper3);
+	    if ((var1) && (!outer_shadowed) && (!stepper3)) fx_tree_outer(sc, cdr(end), var1, var2, var3, more_vars);
+	  }
+
+	if ((is_pair(car(end))) &&
+	    (has_fx(end)) &&
+	    (!(is_syntax(caar(end)))) &&
+	    (!((is_symbol(caar(end))) && (is_definer_or_binder(caar(end))))))
+	  {
+	    if (!fx_tree_in(sc, end, stepper0, stepper1, stepper2, stepper3)) /* just the end-test, not the results */
+	      fx_tree(sc, car(end), stepper0, stepper1, stepper2, stepper3);    /* car(end) might be (or ...) */
+	    if ((var1) && (!outer_shadowed) && (!stepper3)) fx_tree_outer(sc, end, var1, var2, var3, more_vars);
+	  }
+
+	if ((is_pair(body)) && (is_null(cdr(body))) &&
+	    (is_fxable(sc, car(body))))
+	  {
+	    fx_annotate_arg(sc, body, collect_variables(sc, vars, sc->nil));
+	    if (stepper0) fx_tree(sc, body, stepper0, stepper1, stepper2, stepper3);
+	    if ((var1) && (!outer_shadowed) && (!stepper3)) fx_tree_outer(sc, body, var1, var2, var3, more_vars);
+	  }}}
+  return(sc->nil);
+}
+
+static bool has_safe_steppers(s7_scheme *sc, s7_pointer let)
+{
+  for (s7_pointer slot = let_slots(let); tis_slot(slot); slot = next_slot(slot))
+    {
+      s7_pointer val = slot_value(slot);
+      if (slot_has_expression(slot))
+	{
+	  s7_pointer step_expr = T_Pair(slot_expression(slot));
+	  if (is_safe_stepper_expr(step_expr))
+	    {
+	      if (is_t_integer(val))
+		{
+		  if (is_int_optable(step_expr))
+		    set_safe_stepper(slot);
+		  else
+		    if (no_int_opt(step_expr))
+		      clear_safe_stepper(slot);
+		    else
+		      {
+			sc->pc = 0;
+			if (int_optimize(sc, step_expr))
+			  {
+			    set_safe_stepper(slot);
+			    set_is_int_optable(step_expr);
+			  }
+			else
+			  {
+			    clear_safe_stepper(slot);
+			    set_no_int_opt(step_expr);
+			  }}}
+	      else
+		if (is_small_real(val))
+		  {
+		    if (is_float_optable(step_expr))
+		      set_safe_stepper(slot);
+		    else
+		      if (no_float_opt(step_expr))
+			clear_safe_stepper(slot);
+		      else
+			{
+			  sc->pc = 0;
+			  if (float_optimize(sc, step_expr))
+			    {
+			      set_safe_stepper(slot);
+			      set_is_float_optable(step_expr);
+			    }
+			  else
+			    {
+			      clear_safe_stepper(slot);
+			      set_no_float_opt(step_expr);
+			    }}}
+		else set_safe_stepper(slot);  /* ?? shouldn't this check types ?? */
+	    }}
+      else
+	{
+	  if (is_t_real(val))
+	    slot_set_value(slot, make_mutable_real(sc, real(val)));
+	  else
+	    if (is_t_integer(val))
+	      slot_set_value(slot, make_mutable_integer(sc, integer(val)));
+	  set_safe_stepper(slot);
+	}
+      if (!is_safe_stepper(slot))
+	return(false);
+    }
+  return(true);
+}
+
+static bool copy_if_end_ok(s7_scheme *sc, s7_pointer dest, s7_pointer source, s7_int i, s7_pointer endp, s7_pointer stepper)
+{
+  if ((fn_proc(endp) == g_num_eq_2) && (is_symbol(cadr(endp))) && (is_symbol(caddr(endp))))
+    {
+      s7_pointer end_slot = s7_slot(sc, (cadr(endp) == slot_symbol(stepper)) ? caddr(endp) : cadr(endp));
+      if ((is_slot(end_slot)) && (is_t_integer(slot_value(end_slot))))
+	{
+	  copy_to_same_type(sc, dest, source, i, integer(slot_value(end_slot)), i);
+	  return(true);
+	}}
+  return(false);
+}
+
+static bool op_dox_init(s7_scheme *sc)
+{
+  s7_pointer test, code = cdr(sc->code);
+  s7_pointer let = inline_make_let(sc, sc->curlet);
+  sc->temp1 = let;
+
+  for (s7_pointer vars = car(code); is_pair(vars); vars = cdr(vars))
+    {
+      add_slot(sc, let, caar(vars), fx_call(sc, cdar(vars)));
+      if (is_pair(cddar(vars)))
+	slot_set_expression(let_slots(let), cddar(vars));
+      else slot_just_set_expression(let_slots(let), sc->nil);
+    }
+  set_curlet(sc, let);
+  sc->temp1 = sc->unused;
+  test = cadr(code);
+  if (is_true(sc, sc->value = fx_call(sc, test)))
+    {
+      sc->code = cdr(test);
+      return(true); /* goto DO_END_CLAUSES */
+    }
+  sc->code = T_Pair(cddr(code));
+  push_stack_no_args(sc, (intptr_t)((is_null(cdr(sc->code))) ? OP_DOX_STEP_O : OP_DOX_STEP), code);
+  return(false); /* goto BEGIN */
+}
+
+static goto_t op_dox_no_body_1(s7_scheme *sc, s7_pointer slots, s7_pointer end, int32_t steppers, s7_pointer stepper)
+{
+  s7_function endf = fx_proc(end);
+  s7_pointer endp = car(end);
+  if ((endf == fx_c_nc) || (endf == fx_c_0c))
+    {
+      endf = fn_proc(endp);
+      endp = cdr(endp);
+    }
+  if (steppers == 1)
+    {
+      s7_function f = fx_proc(slot_expression(stepper)); /* e.g. fx_add_s1 */
+      s7_pointer a = car(slot_expression(stepper));
+      if ((f == fx_c_nc) || (f == fx_c_0c))
+	{
+	  f = fn_proc(a);
+	  a = cdr(a);
+	}
+      if (((f == fx_cdr_s) || (f == fx_cdr_t)) &&
+	  (cadr(a) == slot_symbol(stepper)))
+	{
+	  do {slot_set_value(stepper, cdr(slot_value(stepper)));} while (endf(sc, endp) == sc->F);
+	  sc->value = sc->T;
+	}
+      else /* (- n 1) tpeak dup */
+	if (((f == fx_add_t1) || (f == fx_add_u1)) && (is_t_integer(slot_value(stepper))))
+	  {
+	    s7_pointer p = make_mutable_integer(sc, integer(slot_value(stepper)));
+	    slot_set_value(stepper, p);
+	    if (!no_bool_opt(end))
+	      {
+		sc->pc = 0;
+		if (bool_optimize(sc, end))  /* in dup.scm this costs more than the fb(o) below saves (search is short) */
+		  {                          /*    but tc is much slower (and bool|int_optimize dominates) */
+		    opt_info *o = sc->opts[0];
+		    bool (*fb)(opt_info *o) = o->v[0].fb;
+		    do {integer(p)++;} while (!fb(o)); /* do {integer(p)++;} while ((sc->value = optf(sc, endp)) == sc->F); */
+		    clear_mutable_integer(p);
+		    sc->value = sc->T;
+		    sc->code = cdr(end);
+		    return(goto_do_end_clauses);
+		  }
+		set_no_bool_opt(end);
+	      }
+	    do {integer(p)++;} while ((sc->value = endf(sc, endp)) == sc->F);
+	    clear_mutable_integer(p);
+	  }
+	else do {slot_set_value(stepper, f(sc, a));} while ((sc->value = endf(sc, endp)) == sc->F);
+
+      sc->code = cdr(end);
+      return(goto_do_end_clauses);
+    }
+  if ((steppers == 2) &&
+      (!tis_slot(next_slot(next_slot(slots)))))
+    {
+      s7_pointer step1 = slots;
+      s7_pointer expr1 = slot_expression(step1);
+      s7_pointer step2 = next_slot(step1);
+      s7_pointer expr2 = slot_expression(step2); /* presetting fx_proc/car(expr) is not faster */
+      if ((fx_proc(expr2) == fx_subtract_u1) &&
+	  (is_t_integer(slot_value(step2))) &&
+	  (endf == fx_num_eq_ui))
+	{
+	  s7_int lim = integer(caddr(endp));
+	  for (s7_int i = integer(slot_value(step2)) - 1; i >= lim; i--)
+	    slot_set_value(step1, fx_call(sc, expr1));
+	}
+      else
+	do {
+	  slot_set_value(step1, fx_call(sc, expr1));
+	  slot_set_value(step2, fx_call(sc, expr2));
+	} while ((sc->value = endf(sc, endp)) == sc->F);
+      sc->code = cdr(end);
+      if (!is_pair(sc->code)) return(goto_start);                  /* no result: (define (f) (do ((x 0 (+ x 1)) (i 0 (+ i 1))) ((= i 1)))) (f) (f) */
+      if ((!is_symbol(car(sc->code))) || (is_pair(cdr(sc->code)))) /* more than one result: (define (f) (do ((x 0 (+ x 1)) (i 0 (+ i 1))) ((= i 1) x 3 4))) (f) */
+	return(goto_do_end_clauses);
+      step1 = s7_slot(sc, car(sc->code));
+      if (step1 == sc->undefined)                                  /* (let () (define (f) (do ((x 0 (+ x 1)) (i 0 (+ i 1))) ((= i 1) y))) (f)) */
+	unbound_variable_error_nr(sc, car(sc->code));
+      sc->value = slot_value(step1);
+      if (is_t_real(sc->value))
+	clear_mutable_number(sc->value);
+      return(goto_start);
+    }
+  do {
+    s7_pointer slt = slots;
+    do {
+      if (slot_has_expression(slt))
+	slot_set_value(slt, fx_call(sc, slot_expression(slt)));
+      slt = next_slot(slt);
+    } while (tis_slot(slt));
+  } while ((sc->value = endf(sc, endp)) == sc->F);
+  sc->code = cdr(end);
+  return(goto_do_end_clauses);
+}
+
+static goto_t op_dox(s7_scheme *sc)
+{
+  /* any number of steppers using dox exprs, end also dox, body and end result arbitrary.
+   *    since all these exprs are local, we don't need to jump until the body
+   */
+  int64_t id;
+  int32_t steppers = 0;
+  s7_pointer code, end, endp, stepper = NULL, form = sc->code, slots;
+  s7_function endf;
+#if WITH_GMP
+  bool got_bignum = false;
+#endif
+  s7_pointer let = inline_make_let(sc, sc->curlet);   /* new let is not tied into the symbol lookup process yet */
+  sc->temp1 = let;
+  sc->code = cdr(sc->code);
+  for (s7_pointer vars = car(sc->code); is_pair(vars); vars = cdr(vars))
+    {
+      s7_pointer expr = cdar(vars), slot;
+      s7_pointer val = fx_call(sc, expr);
+      s7_pointer stp = cdr(expr); /* cddar(vars) */
+#if WITH_GMP
+      if (!got_bignum) got_bignum = is_big_number(val);
+#endif
+      new_cell_no_check(sc, slot, T_SLOT);
+      slot_set_symbol_and_value(slot, caar(vars), val);
+      if (is_pair(stp))
+	{
+	  steppers++;
+	  stepper = slot;
+	  slot_set_expression(slot, stp);
+	}
+      else slot_just_set_expression(slot, sc->nil);
+      slot_set_next(slot, let_slots(let));
+      let_set_slots(let, slot);
+    }
+  set_curlet(sc, let);
+  slots = let_slots(sc->curlet);
+  sc->temp1 = sc->unused;
+  id = let_id(let);
+
+  /* the fn_calls above could have redefined a previous stepper, so that its symbol_id is > let let_id when we get here,
+   *   so we use symbol_set_local_slot_unchecked below to sidestep the debugger (see zauto.scm: i is a stepper, but then mock-vector-ref uses i as its index)
+   */
+  for (s7_pointer slot = slots; tis_slot(slot); slot = next_slot(slot))
+    symbol_set_local_slot_unchecked_and_unincremented(slot_symbol(slot), id, slot);
+
+  end = cadr(sc->code);
+  endp = car(end);
+  endf = fx_proc(end);
+
+  if ((loop_end_possible(end)) && (steppers == 1) &&
+      (is_t_integer(slot_value(stepper))))
+    {
+      s7_pointer stop_slot = (is_symbol(caddr(endp))) ? opt_integer_symbol(sc, caddr(endp)) : sc->nil;
+      if (stop_slot) /* sc->nil -> it's an integer */
+	{
+	  set_has_loop_end(stepper);
+	  set_loop_end(stepper, (is_slot(stop_slot)) ? integer(slot_value(stop_slot)) : integer(caddr(endp)));
+	}}
+
+  if (is_true(sc, sc->value = endf(sc, endp)))
+    {
+      sc->code = cdr(end);
+      return(goto_do_end_clauses);
+    }
+  code = cddr(sc->code);
+  if (is_null(code)) /* no body -- how does this happen? */
+    return(op_dox_no_body_1(sc, slots, end, steppers, stepper));
+
+  if ((is_null(cdr(code))) && /* 1 expr, code is cdddr(form) here */
+      (is_pair(car(code))))
+    {
+      s7_pointer body = car(code);
+      s7_pfunc bodyf = NULL;
+      if ((!no_cell_opt(code)) &&
+#if WITH_GMP
+	  (!got_bignum) &&
+#endif
+	  (has_safe_steppers(sc, sc->curlet)))
+	bodyf = s7_optimize_nv(sc, code);
+
+      if ((!bodyf) &&
+	  (is_fxable(sc, body)) &&     /* happens very rarely, #_* as car etc */
+	  (is_c_function(car(body))))
+	bodyf = s7_optimize_nv(sc, set_dlist_1(sc, set_ulist_1(sc, c_function_name_to_symbol(sc, car(body)), cdr(body))));
+
+      if (bodyf)
+	{
+	  if (steppers == 1)                                /* one expr body, 1 stepper */
+	    {
+	      s7_pointer stepa = car(slot_expression(stepper));
+	      s7_function stepf = fx_proc(slot_expression(stepper));
+	      if (((stepf == fx_add_t1) || (stepf == fx_add_u1)) && (is_t_integer(slot_value(stepper))))
+		{
+		  s7_int i = integer(slot_value(stepper));
+		  opt_info *o = sc->opts[0];
+		  if (bodyf == opt_cell_any_nv)
+		    {
+		      s7_pointer (*fp)(opt_info *o) = o->v[0].fp;
+		      if (!((fp == opt_p_pip_sso) && (o->v[2].p == o->v[4].p) &&
+			    (((o->v[5].p_pip_f == string_set_p_pip_unchecked) && (o->v[6].p_pi_f == string_ref_p_pi_unchecked)) ||
+			     ((o->v[5].p_pip_f == string_set_p_pip_direct) && (o->v[6].p_pi_f == string_ref_p_pi_direct)) ||
+			     ((o->v[5].p_pip_f == vector_set_p_pip_unchecked) && (o->v[6].p_pi_f == t_vector_ref_p_pi_unchecked)) ||
+			     ((o->v[5].p_pip_f == t_vector_set_p_pip_direct) && (o->v[6].p_pi_f == t_vector_ref_p_pi_direct)) ||
+			     ((o->v[5].p_pip_f == list_set_p_pip_unchecked) && (o->v[6].p_pi_f == list_ref_p_pi_unchecked))) &&
+			    (copy_if_end_ok(sc, slot_value(o->v[1].p), slot_value(o->v[3].p), i, endp, stepper))))
+			{
+			  if (has_loop_end(stepper))
+			    {                /* (do ((val 0) (i 0 (+ i 1))) ((= i 1) val) (set! val (real-part (v b1 b2)))) */
+			      s7_int lim = loop_end(stepper);
+			      if ((i >= 0) && (lim < NUM_SMALL_INTS))
+				do {fp(o); slot_set_value(stepper, small_int(++i));} while (i < lim);
+			      else do {fp(o); slot_set_value(stepper, make_integer(sc, ++i));} while (i < lim);
+			      sc->value = sc->T;
+			    }
+			  else
+			    do {             /* (do ((i start (+ i 1))) ((= end i)) (display i)) */
+			      fp(o);
+			      slot_set_value(stepper, make_integer(sc, ++i));
+			    } while ((sc->value = endf(sc, endp)) == sc->F);
+			}}
+		  else
+		    if (!(((bodyf == opt_float_any_nv) && (o->v[0].fd == opt_d_7pid_ss_ss) &&
+			   (o->v[2].p == o->v[6].p) &&
+			   ((o->v[4].d_7pid_f == float_vector_set_d_7pid) || (o->v[4].d_7pid_f == float_vector_set_d_7pid_direct)) &&
+			   ((o->v[3].d_7pi_f == float_vector_ref_d_7pi) || (o->v[3].d_7pi_f == float_vector_ref_d_7pi_direct)) &&
+			   (copy_if_end_ok(sc, slot_value(o->v[1].p), slot_value(o->v[5].p), i, endp, stepper))) ||
+
+			  ((bodyf == opt_int_any_nv) && ((o->v[0].fi == opt_i_7pii_ssf) || (o->v[0].fi == opt_i_7pii_ssf_vset)) &&
+			   (o->v[2].p == o->v[4].o1->v[2].p) &&
+			   (((o->v[3].i_7pii_f == int_vector_set_i_7pii) && (o->v[4].o1->v[3].i_7pi_f == int_vector_ref_i_7pi)) ||
+			    ((o->v[3].i_7pii_f == int_vector_set_i_7pii_direct) && (o->v[4].o1->v[3].i_7pi_f == int_vector_ref_i_pi_direct))) &&
+			   (copy_if_end_ok(sc, slot_value(o->v[1].p), slot_value(o->v[4].o1->v[1].p), i, endp, stepper)))))
+		      /* here the has_loop_end business doesn't happen much */
+		      do {                 /* (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (quotient i 3))) */
+			bodyf(sc);
+			slot_set_value(stepper, make_integer(sc, ++i));
+		      } while ((sc->value = endf(sc, endp)) == sc->F);
+		  sc->code = cdr(end);
+		  return(goto_do_end_clauses);
+		}
+	      do {              /* (do ((count 0.0) (i 7.0 (+ i 1.0))) ((>= i 10.0) count) (set! count (modulo i 3.0))) */
+		bodyf(sc);
+		slot_set_value(stepper, stepf(sc, stepa));
+	      } while ((sc->value = endf(sc, endp)) == sc->F);
+	      sc->code = cdr(end);
+	      return(goto_do_end_clauses);
+	    }
+
+	  if ((steppers == 2) &&
+	      (!tis_slot(next_slot(next_slot(slots)))))
+	    {
+	      s7_pointer s1 = slots, s2 = next_slot(slots);
+	      s7_function f1 = fx_proc(slot_expression(s1));
+	      s7_function f2 = fx_proc(slot_expression(s2));
+	      s7_pointer p1 = car(slot_expression(s1));
+	      s7_pointer p2 = car(slot_expression(s2));
+	      /* split out opt_float_any_nv gained nothing (see tmp), same for opt_cell_any_nv, constant end value was never hit */
+	      if (bodyf == opt_cell_any_nv)
+		{
+		  opt_info *o = sc->opts[0];
+		  s7_pointer (*fp)(opt_info *o) = o->v[0].fp;
+		  s7_pointer s3 = NULL;
+		  /* thash case -- this is dumb */
+		  if ((f2 == fx_add_u1) && (is_t_integer(slot_value(s2))) && (cadr(endp) == slot_symbol(s2)) && (!s7_tree_memq(sc, cadr(endp), body)) &&
+		      (((endf == fx_num_eq_ui) && (is_t_integer(caddr(endp)))) ||
+		       ((endf == fx_num_eq_us) && (s3 = opt_integer_symbol(sc, caddr(endp))) && (!s7_tree_memq(sc, caddr(endp), body)))))
+		    { /* (do ((i 0 (+ i 1)) (z (random 100) (random 100))) ((= i 5000000) counts) (hash-table-set! counts z (+ (or (hash-table-ref counts z) 0) 1))) */
+		      s7_int i = integer(slot_value(s2));
+		      s7_int endi = (is_t_integer(caddr(endp))) ? integer(caddr(endp)) : integer(slot_value(s3));
+		      do {
+			fp(o);
+			slot_set_value(s1, f1(sc, p1));
+			i++;
+		      } while (i < endi);
+		      slot_set_value(s2, make_integer(sc, endi));
+		    }
+		  else
+		    do {          /* (do ((i 0 (+ i 1)) (lst lis (cdr lst))) ((= i (- len 1)) (reverse result)) (set! result (cons (car lst) result))) */
+		      fp(o);
+		      slot_set_value(s1, f1(sc, p1));
+		      slot_set_value(s2, f2(sc, p2));
+		    } while ((sc->value = endf(sc, endp)) == sc->F);
+		}
+	      else
+		do {              /* (do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 3) x) (set! x (max x (* i j)))) */
+		  bodyf(sc);
+		  slot_set_value(s1, f1(sc, p1));
+		  slot_set_value(s2, f2(sc, p2));
+		} while ((sc->value = endf(sc, endp)) == sc->F);
+	      sc->code = cdr(end);
+	      return(goto_do_end_clauses);
+	    }
+	  if (bodyf == opt_cell_any_nv)
+	    {                     /* (do ((i npats (- i 1)) (ipats ipats (cdr ipats)) (a '())) ((zero? i) a) (set! a (cons (car ipats) a))) */
+	      opt_info *o = sc->opts[0];
+	      s7_pointer (*fp)(opt_info *o) = o->v[0].fp;
+	      do {
+		s7_pointer slot1 = slots;
+		fp(o);
+		do {
+		  if (slot_has_expression(slot1))
+		    slot_set_value(slot1, fx_call(sc, slot_expression(slot1)));
+		  slot1 = next_slot(slot1);
+		} while (tis_slot(slot1));
+	      } while ((sc->value = endf(sc, endp)) == sc->F);
+	    }
+	  else
+	    do { /* (do ((i 0 (+ i 1)) (ph 0.0 (+ ph incr)) (kph 0.0 (+ kph kincr))) ((= i 4410)) (float-vector-set! v1 i (+ (cos ph) (cos kph)))) */
+	      s7_pointer slot1 = slots;
+	      bodyf(sc);
+	      do {
+		if (slot_has_expression(slot1))
+		  slot_set_value(slot1, fx_call(sc, slot_expression(slot1)));
+		slot1 = next_slot(slot1);
+	      } while (tis_slot(slot1));
+	    } while ((sc->value = endf(sc, endp)) == sc->F);
+	  sc->code = cdr(end);
+	  return(goto_do_end_clauses);
+	}
+
+      if ((steppers == 1) &&
+	  (car(body) == sc->set_symbol) &&
+	  (is_pair(cdr(body))) &&
+	  (is_symbol(cadr(body))) &&
+	  (is_pair(cddr(body))) &&
+	  ((has_fx(cddr(body))) || (is_fxable(sc, caddr(body)))) &&
+	  (is_null(cdddr(body))))
+	{
+	  s7_pointer val = cddr(body), stepa;
+	  s7_function stepf, valf;
+	  s7_pointer slot = s7_slot(sc, cadr(body));
+	  if (slot == sc->undefined)      /* (let ((lim 1)) (define (f) (let ((y 1)) (do ((i 0 (+ i y))) ((= i lim)) (set! xxx 3)))) (f)) */
+	    unbound_variable_error_nr(sc, cadr(body));
+	  /* here we could jump to the end of this procedure (unsetting op_dox etc) to avoid (set! a a) as an error if 'a is immutable */
+	  if (is_immutable_slot(slot))    /* (let ((lim 1)) (define-constant x 1) (define (f) (let ((y 1)) (do ((i 0 (+ i y))) ((= i lim)) (set! x 3)))) (f)) */
+	    immutable_object_error_nr(sc, set_elist_3(sc, wrap_string(sc, "~S is immutable in ~S", 21), cadr(body), body)); /* "x is immutable in (set! x 3)" */
+
+	  if (!has_fx(val))
+	    set_fx(val, fx_choose(sc, val, sc->curlet, let_symbol_is_safe));
+	  valf = fx_proc(val);
+	  val = car(val);
+	  stepf = fx_proc(slot_expression(stepper));
+	  stepa = car(slot_expression(stepper));
+	  do {             /* (do ((i 1 4)) ((> i 3)) (set! x (+ x i))) */
+	    slot_set_value(slot, valf(sc, val));
+	    slot_set_value(stepper, stepf(sc, stepa));
+	  } while ((sc->value = endf(sc, endp)) == sc->F);
+	  sc->code = cdr(end);
+	  return(goto_do_end_clauses);
+	}}
+  else /* more than one expr */
+    {
+      s7_pointer p = code;
+      bool use_opts = false;
+      int32_t body_len = 0;
+      opt_info *body[32];
+      #define MAX_OPT_BODY_SIZE 32
+
+      if ((!no_cell_opt(code)) &&
+#if WITH_GMP
+	  (!got_bignum) &&
+#endif
+	  (has_safe_steppers(sc, sc->curlet)))
+	{
+	  sc->pc = 0;
+	  for (int32_t k = 0; (is_pair(p)) && (k < MAX_OPT_BODY_SIZE); k++, p = cdr(p), body_len++)
+	    {
+	      opt_info *start = sc->opts[sc->pc];
+	      if (!cell_optimize(sc, p))
+		{
+		  set_no_cell_opt(code);
+		  p = code;
+		  break;
+		}
+	      oo_idp_nr_fixup(start);
+	      body[k] = start;
+	    }
+	  use_opts = is_null(p);
+	}
+
+      if (p == code)
+	for (; is_pair(p); p = cdr(p))
+	  if (!is_fxable(sc, car(p)))
+	    break;
+
+      if (is_null(p))
+	{
+	  s7_pointer stepa = NULL;
+	  s7_function stepf = NULL;
+	  if (!use_opts)
+	    fx_annotate_args(sc, code, sc->curlet);
+	  if (stepper)
+	    {
+	      stepf = fx_proc(slot_expression(stepper));
+	      stepa = car(slot_expression(stepper));
+	    }
+	  while (true) /* (do ((i 0 (+ 1 i))) ((= end i)) (set! end 8) (display i)) */
+	    {
+	      if (use_opts)
+		for (int32_t i = 0; i < body_len; i++)
+		  body[i]->v[0].fp(body[i]);
+	      /* opt_set_p_d_f shoot: 144,186,857  => s7.c:opt_set_p_d_f (2,093,278x) (b also, big/fft as part of fft code 7M) */
+	      else
+		for (p = code; is_pair(p); p = cdr(p))
+		  fx_call(sc, p);
+
+	      if (steppers == 1)
+		slot_set_value(stepper, stepf(sc, stepa));
+	      else
+		{
+		  s7_pointer slot = slots;
+		  do {
+		    if (slot_has_expression(slot))
+		      slot_set_value(slot, fx_call(sc, slot_expression(slot)));
+		    slot = next_slot(slot);
+		  } while (tis_slot(slot));
+		}
+	      if (is_true(sc, sc->value = endf(sc, endp)))
+		{
+		  sc->code = cdr(end);
+		  return(goto_do_end_clauses);
+		}}}}
+  if ((is_null(cdr(code))) && /* one expr */
+      (is_pair(car(code))))
+    {
+      code = car(code);
+      if ((is_syntactic_pair(code)) ||
+	  (is_symbol_and_syntactic(car(code))))
+	{
+	  push_stack_no_args_direct(sc, OP_DOX_STEP_O);
+	  if (is_syntactic_pair(code))
+	    sc->cur_op = (opcode_t)optimize_op(code);
+	  else
+	    {
+	      sc->cur_op = (opcode_t)symbol_syntax_op_checked(code);
+	      pair_set_syntax_op(code, sc->cur_op);
+	    }
+	  sc->code = code;
+	  return(goto_top_no_pop);
+	}}
+  pair_set_syntax_op(form, OP_DOX_INIT);
+  sc->code = T_Pair(cddr(sc->code));
+  push_stack_no_args(sc, (intptr_t)((is_null(cdr(sc->code))) ? OP_DOX_STEP_O : OP_DOX_STEP), cdr(form));
+  return(goto_begin);
+}
+
+static inline bool op_dox_step_1(s7_scheme *sc) /* inline for 50 in concordance, 30 in dup */
+{
+  s7_pointer slot = let_slots(sc->curlet);
+  do {                                      /* every dox case has vars (else op_do_no_vars) */
+    if (slot_has_expression(slot))          /* splitting out 1-slot has_expr case is not faster (not enough hits) */
+      slot_set_value(slot, fx_call(sc, slot_expression(slot)));
+    slot = next_slot(slot);
+    } while (tis_slot(slot));
+  sc->value = fx_call(sc, cadr(sc->code));
+  if (is_true(sc, sc->value))
+    {
+      sc->code = cdadr(sc->code);
+      return(true);
+    }
+  return(false);
+}
+
+static void op_dox_step(s7_scheme *sc)
+{
+  push_stack_no_args_direct(sc, OP_DOX_STEP);
+  sc->code = T_Pair(cddr(sc->code));
+}
+
+static void op_dox_step_o(s7_scheme *sc)
+{
+  push_stack_no_args_direct(sc, OP_DOX_STEP_O);
+  sc->code = caddr(sc->code);
+}
+
+static void op_dox_no_body(s7_scheme *sc)
+{
+  s7_pointer slot, var, test, result;
+  s7_function testf;
+
+  sc->code = cdr(sc->code);
+  var = caar(sc->code);
+  testf = fx_proc(cadr(sc->code));
+  test = caadr(sc->code);
+  result = cdadr(sc->code);
+
+  if ((!in_heap(sc->code)) &&
+      (is_let(opt3_any(sc->code)))) /* (*repl* 'keymap) anything -> segfault because opt3_any here is #f. (see line 80517) */
+    {
+      s7_pointer let = update_let_with_slot(sc, opt3_any(sc->code), fx_call(sc, cdr(var)));
+      let_set_outlet(let, sc->curlet);
+      set_curlet(sc, let);
+    }
+  else set_curlet(sc, make_let_with_slot(sc, sc->curlet, car(var), fx_call(sc, cdr(var))));
+
+  slot = let_slots(sc->curlet);
+  if ((is_t_integer(slot_value(slot))) &&
+      ((integer(opt2_con(sc->code))) != 0))
+    {
+      s7_int incr = integer(opt2_con(sc->code));
+      s7_pointer istep = make_mutable_integer(sc, integer(slot_value(slot))); /* mutable integer is faster here than wrapped */
+      /* this can cause unexpected, but correct behavior: (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (memq x '(0)))) -> #f
+       *   because (eq? 0 x) here is false -- memv will return '(0).  tree-count is similar.
+       */
+      slot_set_value(slot, istep);
+      if (testf == fx_or_2a)
+	{
+	  s7_pointer t1 = cadr(test);
+	  s7_pointer t2 = caddr(test);
+	  s7_function f1 = fx_proc(cdr(test));
+	  s7_function f2 = fx_proc(cddr(test));
+	  while ((f1(sc, t1) == sc->F) && (f2(sc, t2) == sc->F))
+	    integer(istep) += incr;
+	}
+      else while (testf(sc, test) == sc->F) {integer(istep) += incr;}
+      if (is_small_int(integer(istep)))
+	slot_set_value(slot, small_int(integer(istep)));
+      else clear_mutable_integer(istep); /* just clears the T_MUTABLE bit */
+      sc->value = fx_call(sc, result);
+    }
+  else
+    {
+      s7_function stepf = fx_proc(cddr(var));
+      s7_pointer step = caddr(var);
+      if (testf == fx_or_and_2a)
+	{
+	  s7_pointer f1_arg = cadr(test), p = opt3_pair(test); /* cdadr(p) */
+	  s7_function f1 = fx_proc(cdr(test));
+	  s7_pointer f2_arg = car(p);
+	  s7_pointer f3_arg = cadr(p);
+	  s7_function f2 = fx_proc(p);
+	  s7_function f3 = fx_proc(cdr(p));
+	  if (((stepf == fx_add_t1) || (stepf == fx_add_u1)) && (is_t_integer(slot_value(slot))))
+	    {
+	      s7_pointer ip = make_mutable_integer(sc, integer(slot_value(slot)));
+	      slot_set_value(slot, ip);
+	      while ((f1(sc, f1_arg) == sc->F) &&
+		     ((f2(sc, f2_arg) == sc->F) || (f3(sc, f3_arg) == sc->F)))
+		integer(ip)++;
+	      clear_mutable_integer(ip);
+	    }
+	  else
+	    while ((f1(sc, f1_arg) == sc->F) &&
+		   ((f2(sc, f2_arg) == sc->F) || (f3(sc, f3_arg) == sc->F)))
+	      slot_set_value(slot, stepf(sc, step));
+	}
+      else while (testf(sc, test) == sc->F) {slot_set_value(slot, stepf(sc, step));}
+      sc->value = fx_call(sc, result);
+    }
+}
+
+static void op_dox_pending_no_body(s7_scheme *sc)
+{
+  s7_pointer test, slots;
+  bool all_steps = true;
+  s7_pointer let = inline_make_let(sc, sc->curlet);
+  sc->temp1 = let;
+  sc->code = cdr(sc->code);
+  for (s7_pointer vars = car(sc->code); is_pair(vars); vars = cdr(vars))
+    {
+      add_slot(sc, let, caar(vars), fx_call(sc, cdar(vars)));
+      if (is_pair(cddar(vars)))
+	slot_set_expression(let_slots(let), cddar(vars));
+      else
+	{
+	  all_steps = false;
+	  slot_just_set_expression(let_slots(let), sc->nil);
+	}}
+  slots = let_slots(let);
+  set_curlet(sc, let);
+  sc->temp1 = sc->unused;
+  test = cadr(sc->code);
+
+  let_set_has_pending_value(sc->curlet);
+  if ((all_steps) &&
+      (!tis_slot(next_slot(next_slot(slots)))) &&
+      (is_pair(cdr(test))))
+    {
+      s7_pointer slot1 = slots;
+      s7_pointer expr1 = slot_expression(slot1);
+      s7_pointer slot2 = next_slot(slot1);
+      s7_pointer expr2 = slot_expression(slot2);
+      while (fx_call(sc, test) == sc->F)
+	{
+	  slot_simply_set_pending_value(slot1, fx_call(sc, expr1)); /* use pending_value for GC protection */
+	  slot_set_value(slot2, fx_call(sc, expr2));
+	  slot_set_value(slot1, slot_pending_value(slot1));
+	}
+      sc->code = cdr(test);
+      let_clear_has_pending_value(sc, sc->curlet);
+      return;
+    }
+  while ((sc->value = fx_call(sc, test)) == sc->F)
+    {
+      s7_pointer slt = slots;
+      do {
+	if (slot_has_expression(slt))
+	  slot_simply_set_pending_value(slt, fx_call(sc, slot_expression(slt)));
+	slt = next_slot(slt);
+      } while (tis_slot(slt));
+      slt = slots;
+      do {
+	if (slot_has_expression(slt))
+	  slot_set_value(slt, slot_pending_value(slt));
+	slt = next_slot(slt);
+      } while (tis_slot(slt));
+    }
+  sc->code = cdr(test);
+  let_clear_has_pending_value(sc, sc->curlet);
+}
+
+static bool op_do_no_vars(s7_scheme *sc)
+{
+  s7_pointer p, form = sc->code;
+  int32_t i;
+  opt_info *body[32];
+  sc->code = cdr(sc->code);
+  sc->pc = 0;
+
+  for (i = 0, p = cddr(sc->code); (is_pair(p)) && (i < 32); i++, p = cdr(p))
+    {
+      body[i] = sc->opts[sc->pc];
+      if (!cell_optimize(sc, p))
+	break;
+    }
+  if (is_null(p))
+    {
+      s7_pointer end = cadr(sc->code);
+      set_curlet(sc, inline_make_let(sc, sc->curlet));
+      if (i == 1)
+	while ((sc->value = fx_call(sc, end)) == sc->F) body[0]->v[0].fp(body[0]); /* presetting body[0] and body[0]->v[0].fp is not faster */
+      else
+	if (i == 2)
+	  {
+	    opt_info *o0 = body[0], *o1 = body[1];
+	    s7_pointer (*fp0)(opt_info *o) = o0->v[0].fp;
+	    s7_pointer (*fp1)(opt_info *o) = o1->v[0].fp;
+	    while ((sc->value = fx_call(sc, end)) == sc->F) {fp0(o0); fp1(o1);}
+	  }
+	else
+	  if (i == 0) /* null body! */
+	    {
+	      s7_function endf = fx_proc(end);
+	      s7_pointer endp = car(end);
+	      while (!is_true(sc, sc->value = endf(sc, endp))); /* the assignment is (normally) in the noise */
+	    }
+	  else
+	    while ((sc->value = fx_call(sc, end)) == sc->F)
+	      for (int32_t k = 0; k < i; k++)
+		body[k]->v[0].fp(body[k]);
+      sc->code = cdr(end); /* inner let still active during result */
+      return(true);
+    }
+  /* back out */
+  pair_set_syntax_op(form, OP_DO_NO_VARS_NO_OPT);
+  set_curlet(sc, make_let(sc, sc->curlet));
+  sc->value = fx_call(sc, cadr(sc->code));
+  if (is_true(sc, sc->value))
+    {
+      sc->code = cdadr(sc->code);
+      return(true);
+    }
+  push_stack_no_args_direct(sc, OP_DO_NO_VARS_NO_OPT_1);
+  sc->code = T_Pair(cddr(sc->code));
+  return(false);
+}
+
+static void op_do_no_vars_no_opt(s7_scheme *sc)
+{
+  sc->code = cdr(sc->code);
+  set_curlet(sc, inline_make_let(sc, sc->curlet));
+}
+
+static bool op_do_no_vars_no_opt_1(s7_scheme *sc)
+{
+  sc->value = fx_call(sc, cadr(sc->code));
+  if (is_true(sc, sc->value))
+    {
+      sc->code = cdadr(sc->code);
+      return(true);
+    }
+  push_stack_no_args_direct(sc, OP_DO_NO_VARS_NO_OPT_1);
+  sc->code = T_Pair(cddr(sc->code));
+  return(false);
+}
+
+static void op_do_no_body_na_vars(s7_scheme *sc) /* vars fxable, end-test not */
+{
+  s7_pointer stepper = NULL;
+  s7_int steppers = 0;
+  s7_pointer let = inline_make_let(sc, sc->curlet);
+  sc->temp1 = let;
+  sc->code = cdr(sc->code);
+  for (s7_pointer vars = car(sc->code); is_pair(vars); vars = cdr(vars))
+    {
+      add_slot(sc, let, caar(vars), fx_call(sc, cdar(vars)));
+      if (is_pair(cddar(vars)))
+	{
+	  slot_set_expression(let_slots(let), cddar(vars));
+	  steppers++;
+	  stepper = let_slots(let);
+	}
+      else slot_just_set_expression(let_slots(let), sc->nil);
+    }
+  if (steppers == 1) let_set_dox_slot1(let, stepper);
+  set_curlet(sc, let);
+  sc->temp1 = sc->unused;
+  push_stack_no_args_direct(sc, (intptr_t)((steppers == 1) ? OP_DO_NO_BODY_NA_VARS_STEP_1 : OP_DO_NO_BODY_NA_VARS_STEP));
+  sc->code = caadr(sc->code);
+}
+
+static bool op_do_no_body_na_vars_step(s7_scheme *sc)
+{
+  if (sc->value != sc->F)
+    {
+      sc->code = cdadr(sc->code);
+      return(true);
+    }
+  for (s7_pointer slot = let_slots(sc->curlet); tis_slot(slot); slot = next_slot(slot))
+    if (slot_has_expression(slot))
+      slot_set_value(slot, fx_call(sc, slot_expression(slot)));
+  push_stack_no_args_direct(sc, OP_DO_NO_BODY_NA_VARS_STEP);
+  sc->code = caadr(sc->code);
+  return(false);
+}
+
+static bool op_do_no_body_na_vars_step_1(s7_scheme *sc)
+{
+  if (sc->value != sc->F)
+    {
+      sc->code = cdadr(sc->code);
+      return(true);
+    }
+  slot_set_value(let_dox_slot1(sc->curlet), fx_call(sc, slot_expression(let_dox_slot1(sc->curlet))));
+  push_stack_no_args_direct(sc, OP_DO_NO_BODY_NA_VARS_STEP_1);
+  sc->code = caadr(sc->code);
+  return(false);
+}
+
+static bool do_step1(s7_scheme *sc)
+{
+  while (true)
+    {
+      s7_pointer code;
+      if (is_null(sc->args)) /* after getting the new values, transfer them into the slot_values */
+	{
+	  for (s7_pointer x = sc->code; is_pair(x); x = cdr(x))   /* sc->code here is the original sc->args list */
+	    {
+	      s7_pointer slot = car(x);
+	      if (is_immutable_slot(slot))    /* (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (immutable! 'i)))) (func)) */
+		immutable_object_error_nr(sc, set_elist_3(sc, wrap_string(sc, "~S is immutable in ~S", 21), slot_symbol(slot), car(slot_expression(slot))));
+	      slot_set_value(slot, slot_pending_value(slot));
+	      slot_clear_has_pending_value(slot);
+	    }
+	  pop_stack_no_op(sc);
+	  return(true);
+	}
+      code = T_Pair(slot_expression(car(sc->args))); /* get the next stepper new value */
+      if (has_fx(code))
+	{
+	  sc->value = fx_call(sc, code);
+	  slot_set_pending_value(car(sc->args), sc->value); /* consistently slower if slot_simply_set... here? */
+	  sc->args = T_Lst(cdr(sc->args));           /* go to next step var */
+	}
+      else
+	{
+	  push_stack_direct(sc, OP_DO_STEP2);
+	  sc->code = car(code);
+	  return(false);
+	}}
+}
+
+static bool op_do_step2(s7_scheme *sc)
+{
+  if (is_multiple_value(sc->value))
+    syntax_error_nr(sc, "do: variable step value can't be ~S", 35, set_ulist_1(sc, sc->values_symbol, sc->value));
+  slot_set_pending_value(car(sc->args), sc->value);  /* save current value */
+  sc->args = cdr(sc->args);                   /* go to next step var */
+  return(do_step1(sc));
+}
+
+static bool op_do_step(s7_scheme *sc)     /* called only in eval OP_DO_STEP via op_do_end_false */
+{
+  /* increment all vars, return to endtest
+   *   these are also updated in parallel at the end, so we gather all the incremented values first
+   * here we know car(sc->args) is not null, args is the list of steppable vars,
+   *   any unstepped vars in the do var section are not in this list, so
+   *  (do ((i 0 (+ i 1)) (j 2)) ...) arrives here with sc->args: '(slot<((+ i 1)=expr, 0=pending_value>)) -- is this comment correct?
+   */
+  push_stack_direct(sc, OP_DO_END);
+  sc->args = car(sc->args);                /* the var data lists */
+  sc->code = T_Lst(sc->args);              /* save the top of the list */
+  return(do_step1(sc));
+}
+
+static goto_t do_end_code(s7_scheme *sc)
+{
+  if (is_pair(cdr(sc->code)))
+    {
+      if (is_undefined_feed_to(sc, car(sc->code)))
+	return(goto_feed_to);
+      /* never has_fx(sc->code) here (first of a body) */
+      push_stack_no_args(sc, sc->begin_op, cdr(sc->code));
+      sc->code = car(sc->code);
+      return(goto_eval);
+    }
+  if (has_fx(sc->code))
+    {
+      sc->value = fx_call(sc, sc->code);
+      return(goto_start);
+    }
+  sc->code = T_Pair(car(sc->code));
+  return(goto_eval);
+}
+
+static bool do_end_clauses(s7_scheme *sc)
+{
+  if (!is_null(sc->code))
+    return(false);
+  if (is_multiple_value(sc->value))
+    sc->value = splice_in_values(sc, multiple_value(sc->value));
+  return(true);
+}
+
+static bool opt_do_copy(s7_scheme *sc, opt_info *o, s7_int start, s7_int stop)
+{
+  s7_pointer (*fp)(opt_info *o) = o->v[0].fp; /* o->v[6].p_pi_f is getter, o->v[5].p_pip_f is setter */
+  if (start >= stop) return(true);
+  if ((fp == opt_p_pip_sso) &&
+      (type(slot_value(o->v[1].p)) == type(slot_value(o->v[3].p))) &&
+      (o->v[2].p == o->v[4].p))
+    {
+      s7_pointer caller = NULL;
+      s7_pointer dest = slot_value(o->v[1].p);
+      s7_pointer source = slot_value(o->v[3].p);
+      if ((is_t_vector(dest)) &&
+	  (((o->v[5].p_pip_f == vector_set_p_pip_unchecked) || (o->v[5].p_pip_f == t_vector_set_p_pip_direct)) &&
+	   ((o->v[6].p_pi_f == t_vector_ref_p_pi_unchecked) || (o->v[6].p_pi_f == vector_ref_p_pi_unchecked) || (o->v[6].p_pi_f == t_vector_ref_p_pi_direct))))
+	caller = sc->vector_set_symbol;
+      else
+	if ((is_string(dest)) &&
+	    (((o->v[5].p_pip_f == string_set_p_pip_unchecked) || (o->v[5].p_pip_f == string_set_p_pip_direct)) &&
+	     ((o->v[6].p_pi_f == string_ref_p_pi_unchecked) || (o->v[6].p_pi_f == string_ref_p_pi_direct))))
+	  caller = sc->string_set_symbol;
+	else
+	  if ((is_pair(dest)) &&
+	      ((o->v[5].p_pip_f == list_set_p_pip_unchecked) && (o->v[6].p_pi_f == list_ref_p_pi_unchecked)))
+	    caller = sc->list_set_symbol;
+	  else return(false);
+      if (start < 0)
+	out_of_range_error_nr(sc, caller, wrap_integer(sc, 2), wrap_integer(sc, start), it_is_negative_string);
+      if ((stop > integer(s7_length(sc, source))) || (stop > integer(s7_length(sc, dest))))
+	out_of_range_error_nr(sc, caller, wrap_integer(sc, 2), wrap_integer(sc, stop), it_is_too_large_string);
+      if ((caller) && (copy_to_same_type(sc, dest, source, start, stop, start)))
+	return(true);
+    }
+  return(false);
+}
+
+static bool op_simple_do_1(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer step_expr, step_var, ctr_slot, end_slot;
+  s7_function stepf, endf;
+  s7_pfunc func;
+
+  if (no_cell_opt(cddr(code)))
+    return(false);
+  func = s7_optimize_nv(sc, cddr(code));
+  if (!func)
+    {
+      set_no_cell_opt(cddr(code));
+      return(false);
+    }
+  /* func must be set */
+  step_expr = opt2_pair(code); /* caddr(caar(code)) */
+  stepf = fn_proc(step_expr);
+  endf = fn_proc(caadr(code));
+  ctr_slot = let_dox_slot1(sc->curlet);
+  end_slot = let_dox_slot2(sc->curlet);
+  step_var = caddr(step_expr);
+  /* use g* funcs (not fx) because we're passing the actual values, not the expressions */
+
+  if ((stepf == g_add_x1) &&
+      (is_t_integer(slot_value(ctr_slot))) &&
+      ((endf == g_num_eq_2) || (endf == g_num_eq_xi) || (endf == g_geq_2)) &&
+      (is_t_integer(slot_value(end_slot))))
+    {
+      s7_int i;
+      s7_int start = integer(slot_value(ctr_slot));
+      s7_int stop = integer(slot_value(end_slot));
+
+      if (func == opt_cell_any_nv)
+	{
+	  opt_info *o = sc->opts[0];
+	  s7_pointer (*fp)(opt_info *o) = o->v[0].fp;
+	  if ((fp == opt_p_ppp_sss) || (fp == opt_p_ppp_sss_mul) || (fp == opt_p_ppp_sss_hset))
+	    { /* (do ((i 0 (+ i 1))) ((= i 1) (let-ref lt 'a)) (let-set! lt sym i)) */
+	      s7_p_ppp_t fpt = o->v[4].p_ppp_f;
+	      for (i = start; i < stop; i++)  /* thash and below */
+		{
+		  slot_set_value(ctr_slot, make_integer(sc, i));
+		  fpt(sc, slot_value(o->v[1].p), slot_value(o->v[2].p), slot_value(o->v[3].p));
+		}}
+	  else
+	    if (fp == opt_p_ppp_sfs)
+	      { /* (do ((i 0 (+ i 1))) ((= i 9)) (vector-set! v4 (expt 2 i) i)) */
+		s7_p_ppp_t fpt = o->v[3].p_ppp_f;
+		for (i = start; i < stop; i++)
+		  {
+		    slot_set_value(ctr_slot, make_integer(sc, i));
+		    fpt(sc, slot_value(o->v[1].p), o->v[5].fp(o->v[4].o1), slot_value(o->v[2].p));
+		  }}
+	    else
+	      if ((fp == opt_p_pip_sss_vset) && (start >= 0) && (stop <= vector_length(slot_value(o->v[1].p))))
+		{ /* (do ((i 0 (+ i 1))) ((= i 10) v) (vector-set! v i i)) */
+		  s7_pointer *vels = vector_elements(slot_value(o->v[1].p)); /* better in callgrind, possibly slightly slower in time */
+		  check_free_heap_size(sc, stop - start);
+		  for (i = start; i < stop; i++)
+		    {
+		      slot_set_value(ctr_slot, make_integer_unchecked(sc, i));
+		      vels[integer(slot_value(o->v[2].p))] = slot_value(o->v[3].p);
+		    }}
+	      else /* (do ((i 0 (+ i 1))) ((= i 1) (let-ref lt 'a)) (let-set! lt 'a i)) or (do ((i 0 (+ i 1))) ((= i 10)) (list-set! lst i i)) */
+		for (i = start; i < stop; i++)
+		  {
+		    slot_set_value(ctr_slot, make_integer(sc, i));
+		    fp(o);
+		  }}
+      else
+	{ /* (do ((j (+ nv k -1) (- j 1))) ((< j k)) (set! (r j) (- (r j) (* (q k) (p2 (- j k)))))) */
+	  /* (do ((__i__ 0 (+ __i__ 1))) ((= __i__ 1) 32.0) (b 0)) and many more, all wrap-int safe I think */
+	  /* splitting out opt_float_any_nv here saves almost nothing */
+	  for (i = start; i < stop; i++)
+	    {
+	      slot_set_value(ctr_slot, make_integer(sc, i));
+	      func(sc);
+	    }}
+      sc->value = sc->T;
+      sc->code = cdadr(code);
+      return(true);
+    }
+  if ((stepf == g_subtract_x1) &&
+      (is_t_integer(slot_value(ctr_slot))) &&
+      ((endf == g_less_x0) || (endf == g_less_2) || (endf == g_less_xi)) &&
+      (is_t_integer(slot_value(end_slot))))
+    {
+      s7_int i, start = integer(slot_value(ctr_slot)), stop = integer(slot_value(end_slot));
+      if (func == opt_cell_any_nv)
+	{
+	  opt_info *o = sc->opts[0];
+	  if (!opt_do_copy(sc, o, stop, start + 1))
+	    { /* (do ((i 9 (- i 1))) ((< i 0) v) (vector-set! v i i)) */
+	      s7_pointer (*fp)(opt_info *o) = o->v[0].fp;
+	      for (i = start; i >= stop; i--)
+		{
+		  slot_set_value(ctr_slot, make_integer(sc, i));
+		  fp(o);
+		}}}
+      else /* (do ((i 9 (- i 1))) ((< i 0)) (set! (v i) (delay gen 0.5 i))) */
+	for (i = start; i >= stop; i--)
+	  {
+	    slot_set_value(ctr_slot, make_integer(sc, i));
+	    func(sc);
+	  }
+      sc->value = sc->T;
+      sc->code = cdadr(code);
+      return(true);
+    }
+  if ((stepf == g_add_2_xi) &&
+      (is_t_integer(slot_value(ctr_slot))) &&
+      ((endf == g_num_eq_2) || (endf == g_num_eq_xi) || (endf == g_geq_2)) &&
+      (is_t_integer(slot_value(end_slot))))
+    {
+      s7_int i, start = integer(slot_value(ctr_slot)), stop = integer(slot_value(end_slot)), incr = integer(caddr(step_expr));
+      if (func == opt_cell_any_nv)
+	{ /* (do ((i 0 (+ i 2))) ((= i 20)) (display (/ i 2))) */
+	  /* (do ((i 0 (+ i 8))) ((= i 64)) (write-byte (logand (ash int (- i)) 255))) */
+	  opt_info *o = sc->opts[0];
+	  s7_pointer (*fp)(opt_info *o) = o->v[0].fp;
+	  for (i = start; i < stop; i += incr)
+	    {
+	      slot_set_value(ctr_slot, make_integer(sc, i));
+	      fp(o);
+	    }}
+      else
+	for (i = start; i < stop; i += incr)
+	  {
+	    slot_set_value(ctr_slot, make_integer(sc, i));
+	    func(sc);
+	  }
+      sc->value = sc->T;
+      sc->code = cdadr(code);
+      return(true);
+    }
+  if (func == opt_cell_any_nv)
+    {
+      opt_info *o = sc->opts[0];
+      s7_pointer (*fp)(opt_info *o) = o->v[0].fp;
+      if ((stepf == g_add_x1) && (is_t_integer(slot_value(ctr_slot))) &&
+	  (endf == g_greater_2) && (is_t_integer(slot_value(end_slot))))
+	{
+	  s7_int start = integer(slot_value(ctr_slot));
+	  s7_int stop = integer(slot_value(end_slot));
+	  if (fp == opt_cond_1b)
+	    { /*  (do ((i 0 (+ i 1))) ((> i a)) (cond (i i))) ! */
+	      s7_pointer (*test_fp)(opt_info *o) = o->v[4].o1->v[O_WRAP].fp;
+	      opt_info *test_o1 = o->v[4].o1;
+	      opt_info *o2 = o->v[6].o1;
+	      for (s7_int i = start; i <= stop; i++)
+		{
+		  slot_set_value(ctr_slot, make_integer(sc, i));
+		  if (test_fp(test_o1) != sc->F) cond_value(o2);
+		}}
+	  else /* (do ((i 0 (+ i 1))) ((> i a)) (vector-set! v i 1)) */
+	    for (s7_int i = start; i <= stop; i++)
+	      {
+		slot_set_value(ctr_slot, make_integer(sc, i));
+		fp(o);
+	      }}
+      else /*  (do ((i 0 (+ i 1))) ((> i 10)) (display i)) */
+	do {
+	  fp(o);
+	  set_car(sc->t2_1, slot_value(ctr_slot));
+	  set_car(sc->t2_2, step_var);
+	  slot_set_value(ctr_slot, stepf(sc, sc->t2_1));
+	  set_car(sc->t2_1, slot_value(ctr_slot));
+	  set_car(sc->t2_2, slot_value(end_slot));
+	} while ((sc->value = endf(sc, sc->t2_1)) == sc->F);
+    }
+  else /* (do ((i 0 (+ i 1))) ((> i 3) i) (set! i (* i 10))) */
+    do {
+	func(sc);
+	set_car(sc->t2_1, slot_value(ctr_slot));
+	set_car(sc->t2_2, step_var);
+	slot_set_value(ctr_slot, stepf(sc, sc->t2_1));
+	set_car(sc->t2_1, slot_value(ctr_slot));
+	set_car(sc->t2_2, slot_value(end_slot));
+      } while ((sc->value = endf(sc, sc->t2_1)) == sc->F);
+  sc->code = cdadr(code);
+  return(true);
+}
+
+static bool op_simple_do(s7_scheme *sc)
+{
+  /* body might not be safe in this case, but the step and end exprs are easy */
+  s7_pointer code = cdr(sc->code);
+  s7_pointer end = opt1_any(code);        /* caddr(caadr(code)) */
+  s7_pointer body = cddr(code);
+
+  set_curlet(sc, make_let(sc, sc->curlet));
+  sc->value = fx_call(sc, cdaar(code));
+  let_set_dox_slot1(sc->curlet, add_slot_checked(sc, sc->curlet, caaar(code), sc->value));
+
+  if (is_symbol(end))
+    let_set_dox_slot2(sc->curlet, s7_slot(sc, end));
+  else let_set_dox_slot2(sc->curlet, make_slot(sc, caaar(code), end));
+  set_car(sc->t2_1, let_dox1_value(sc->curlet));
+  set_car(sc->t2_2, let_dox2_value(sc->curlet));
+  sc->value = fn_proc(caadr(code))(sc, sc->t2_1);
+  if (is_true(sc, sc->value))
+    {
+      sc->code = cdadr(code);
+      return(true);                       /* goto DO_END_CLAUSES */
+    }
+  if ((is_null(cdr(body))) &&             /* one expr in body */
+      (is_pair(car(body))) &&             /*   and it is a pair */
+      (is_symbol(cadr(opt2_pair(code)))) && /* caddr(caar(code)), caar=(i 0 (+ i 1)), caddr=(+ i 1), so this checks that stepf is reasonable? */
+      (is_t_integer(caddr(opt2_pair(code)))) &&
+      (op_simple_do_1(sc, cdr(sc->code))))
+    return(true);                         /* goto DO_END_CLAUSES */
+
+  push_stack_no_args(sc, OP_SIMPLE_DO_STEP, code);
+  sc->code = body;
+  return(false);                          /* goto BEGIN */
+}
+
+static bool op_simple_do_step(s7_scheme *sc)
+{
+  s7_pointer ctr = let_dox_slot1(sc->curlet);
+  s7_pointer end = let_dox_slot2(sc->curlet);
+  s7_pointer code = sc->code;
+  s7_pointer step = opt2_pair(code); /* caddr(caar(code)) */
+  if (is_symbol(cadr(step)))
+    {
+      set_car(sc->t2_1, slot_value(ctr));
+      set_car(sc->t2_2, caddr(step));
+    }
+  else /* is_symbol(caddr(step)) I think: (+ 1 x) vs (+ x 1) */
+    {
+      set_car(sc->t2_2, slot_value(ctr));
+      set_car(sc->t2_1, cadr(step));
+    }
+  slot_set_value(ctr, fn_proc(step)(sc, sc->t2_1));
+  set_car(sc->t2_1, slot_value(ctr));
+  set_car(sc->t2_2, slot_value(end));
+  end = cadr(code);
+  sc->value = fn_proc(car(end))(sc, sc->t2_1);
+  if (is_true(sc, sc->value))
+    {
+      sc->code = cdr(end);
+      return(true);
+    }
+  push_stack_direct(sc, OP_SIMPLE_DO_STEP);
+  sc->code = T_Pair(cddr(code));
+  return(false);
+}
+
+static bool op_safe_do_step(s7_scheme *sc)
+{
+  s7_int end = integer(let_dox2_value(sc->curlet));
+  s7_pointer slot = let_dox_slot1(sc->curlet);
+  s7_int step = integer(slot_value(slot)) + 1;
+  slot_set_value(slot, make_integer(sc, step));
+  if ((step == end) ||
+      ((step > end) && (opt1_cfunc(caadr(sc->code)) == sc->geq_2)))
+    {
+      sc->value = sc->T;
+      sc->code = cdadr(sc->code);
+      return(true);
+    }
+  push_stack_direct(sc, OP_SAFE_DO_STEP);
+  sc->code = T_Pair(opt2_pair(sc->code));
+  return(false);
+}
+
+static bool op_safe_dotimes_step(s7_scheme *sc)
+{
+  s7_pointer arg = slot_value(sc->args);
+  numerator(arg)++;
+  if (numerator(arg) == loop_end(sc->args))
+    {
+      sc->value = sc->T;
+      sc->code = cdadr(sc->code);
+      return(true);
+    }
+  push_stack_direct(sc, OP_SAFE_DOTIMES_STEP);
+  sc->code = opt2_pair(sc->code); /* here we know the body has more than one form */
+  push_stack_no_args(sc, sc->begin_op, T_Pair(cdr(sc->code)));
+  sc->code = car(sc->code);
+  return(false);
+}
+
+static bool op_safe_dotimes_step_o(s7_scheme *sc)
+{
+  s7_pointer arg = slot_value(sc->args);
+  numerator(arg)++;
+  if (numerator(arg) == loop_end(sc->args))
+    {
+      sc->value = sc->T;
+      sc->code = cdadr(sc->code);
+      return(true); /* goto DO_END_CLAUSES */
+    }
+  push_stack_direct(sc, OP_SAFE_DOTIMES_STEP_O);
+  sc->code = opt2_pair(sc->code);
+  return(false); /* goto EVAL */
+}
+
+static /* inline */ bool op_dotimes_step_o(s7_scheme *sc) /* called once in eval, mat(10+6), num(7+1) */
+{
+  s7_pointer ctr = let_dox_slot1(sc->curlet);
+  s7_pointer end = let_dox2_value(sc->curlet);
+  s7_pointer now = slot_value(ctr);
+  s7_pointer code = sc->code;
+  s7_pointer end_test = opt2_pair(code);
+
+  if (is_t_integer(now))
+    {
+      slot_set_value(ctr, make_integer(sc, integer(now) + 1));
+      now = slot_value(ctr);
+      if (is_t_integer(end))
+	{
+	  if ((integer(now) == integer(end)) ||
+	      ((integer(now) > integer(end)) && (opt1_cfunc(end_test) == sc->geq_2)))
+	    {
+	      sc->value = sc->T;
+	      sc->code = cdadr(code);
+	      return(true);
+	    }}
+      else
+	{
+	  set_car(sc->t2_1, now);
+	  set_car(sc->t2_2, end);
+	  end = cadr(code);
+	  sc->value = fn_proc(car(end))(sc, sc->t2_1);
+	  if (is_true(sc, sc->value))
+	    {
+	      sc->code = cdr(end);
+	      return(true);
+	    }}}
+  else
+    {
+      slot_set_value(ctr, g_add_x1(sc, with_list_t1(now)));
+      /* (define (hi) (let ((x 0.0) (y 1.0)) (do ((i y (+ i 1))) ((= i 6)) (do ((i i (+ i 1))) ((>= i 7)) (set! x (+ x i)))) x)) */
+      set_car(sc->t2_1, slot_value(ctr));
+      set_car(sc->t2_2, end);
+      end = cadr(code);
+      sc->value = fn_proc(car(end))(sc, sc->t2_1);
+      if (is_true(sc, sc->value))
+	{
+	  sc->code = cdr(end);
+	  return(true);
+	}}
+  push_stack_direct(sc, OP_DOTIMES_STEP_O);
+  sc->code = caddr(code);
+  return(false);
+}
+
+static bool opt_dotimes(s7_scheme *sc, s7_pointer code, s7_pointer scc, bool loop_end_ok)
+{
+  s7_pointer step_val;
+  if (loop_end_ok)
+    set_safe_stepper(sc->args);
+  else set_safe_stepper(let_dox_slot1(sc->curlet));
+
+  if (is_null(cdr(code)))
+    {
+      s7_pfunc func;
+      if (no_cell_opt(code)) return(false);
+      func = s7_optimize_nv(sc, code);
+      if (!func)
+	{
+	  set_no_cell_opt(code);
+	  return(false);
+	}
+      if (loop_end_ok)
+	{
+	  s7_int end = loop_end(sc->args);
+	  s7_pointer stepper = make_mutable_integer(sc, integer(slot_value(sc->args)));
+	  slot_set_value(sc->args, stepper);
+	  if ((func == opt_float_any_nv) ||
+	      (func == opt_cell_any_nv))
+	    {
+	      opt_info *o = sc->opts[0];
+	      if (func == opt_float_any_nv)
+		{
+		  s7_double (*fd)(opt_info *o) = o->v[0].fd;
+		  if ((fd == opt_d_id_sf) && /* by far the most common case in clm: (outa i ...) etc */
+		      (is_slot(o->v[1].p)) &&
+		      (stepper == slot_value(o->v[1].p)))
+		    { /* (do ((i 0 (+ i 1))) ((= i len) (set! *output* #f) v1) (outa i (- (* i incr) 0.5))) */
+		      opt_info *o1 = sc->opts[1];
+		      s7_int end8 = end - 8;
+		      s7_d_id_t f0 = o->v[3].d_id_f;
+		      fd = o1->v[0].fd;
+		      while (integer(stepper) < end8)
+			LOOP_8(f0(integer(stepper), fd(o1)); integer(stepper)++);
+		      while (integer(stepper) < end)
+			{
+   			  f0(integer(stepper), fd(o1));
+			  integer(stepper)++;
+			}}
+		  else
+		    if ((o->v[0].fd == opt_d_7pid_ss_ss) && (o->v[4].d_7pid_f == float_vector_set_d_7pid_direct) &&
+			((o->v[3].d_7pi_f == float_vector_ref_d_7pi) || (o->v[3].d_7pi_f == float_vector_ref_d_7pi_direct)) &&
+			(o->v[2].p == o->v[6].p))
+		      copy_to_same_type(sc, slot_value(o->v[1].p), slot_value(o->v[5].p), integer(stepper), end, integer(stepper));
+		    else
+		      if ((o->v[0].fd == opt_d_7pid_ssc) &&
+			  (o->v[4].d_7pid_f == float_vector_set_d_7pid_direct) &&
+			  (stepper == slot_value(o->v[2].p)))
+			s7_fill(sc, set_plist_4(sc, slot_value(o->v[1].p), wrap_real(sc, o->v[3].x), stepper, wrap_integer(sc, end))); /* wrapped 16-Nov-23 */
+		      else
+			{ /* (do ((i 0 (+ i 1))) ((= i 2) fv) (float-vector-set! fv (+ i 0) (+ i 1) (* 2.0 3.0))) */
+			  s7_int end4 = end - 4;
+			  while (integer(stepper) < end4)
+			    LOOP_4(fd(o); integer(stepper)++);
+			  for (; integer(stepper) < end; integer(stepper)++)
+			    fd(o);
+			}}
+	      else
+		{
+		  s7_pointer (*fp)(opt_info *o) = o->v[0].fp;
+		  if ((fp == opt_p_pip_ssc) &&
+		      (stepper == slot_value(o->v[2].p)) &&        /* i.e. index by do counter */
+		      ((o->v[3].p_pip_f == string_set_p_pip_direct) ||
+		       (o->v[3].p_pip_f == t_vector_set_p_pip_direct) ||
+		       (o->v[3].p_pip_f == list_set_p_pip_unchecked)))
+		    s7_fill(sc, set_plist_4(sc, slot_value(o->v[1].p), o->v[4].p, stepper, wrap_integer(sc, end)));  /* wrapped 16-Nov-23 */
+		  else
+		    if (fp == opt_if_bp)
+		      {      /* (do ((i 0 (+ i 1))) ((= i 3) y) (if (= (+ z 1) 2.2) (display (+ z 1)))) */
+			for (; integer(stepper) < end; integer(stepper)++)
+			  if (o->v[3].fb(o->v[2].o1)) o->v[5].fp(o->v[4].o1);
+		      }
+		    else
+		      if (fp == opt_if_nbp_fs)
+			{    /* (do ((i 0 (+ i 1))) ((= i len)) (if (not (= (list-ref lst i) i)) (display "oops"))) */
+			  for (; integer(stepper) < end; integer(stepper)++)
+			    if (!(o->v[2].b_pi_f(sc, o->v[5].fp(o->v[4].o1), integer(slot_value(o->v[3].p))))) o->v[11].fp(o->v[10].o1);
+			}
+		      else
+			if (fp == opt_unless_p_1)
+			  {  /* (do ((i 0 (+ i 1))) ((= i size)) (unless (= (hash-table-ref vct-hash (float-vector i)) i) (display "oops"))) */
+			    for (; integer(stepper) < end; integer(stepper)++)
+			      if (!(o->v[4].fb(o->v[3].o1))) o->v[5].o1->v[0].fp(o->v[5].o1);
+			  }
+			else /* (do ((i 0 (+ i 1))) ((= i size) (vector-ref v 0)) (vector-set! v i 2)) */
+			  for (; integer(stepper) < end; integer(stepper)++) fp(o);
+		}}
+	  else
+	    if (func == opt_int_any_nv)
+	      {
+		opt_info *o = sc->opts[0];
+		s7_int (*fi)(opt_info *o) = o->v[0].fi;
+		if ((fi == opt_i_7pii_ssc) && (stepper == slot_value(o->v[2].p)) && (o->v[3].i_7pii_f == int_vector_set_i_7pii_direct))
+		  s7_fill(sc, set_plist_4(sc, slot_value(o->v[1].p), wrap_integer(sc, o->v[4].i), stepper, wrap_integer(sc, end)));  /* wrapped 16-Nov-23 */
+		else
+		  if ((o->v[3].i_7pii_f == int_vector_set_i_7pii_direct) && (o->v[5].fi == opt_i_pi_ss_ivref) && (o->v[2].p == o->v[4].o1->v[2].p))
+		    copy_to_same_type(sc, slot_value(o->v[1].p), slot_value(o->v[4].o1->v[1].p), integer(stepper), end, integer(stepper));
+		  else /* (do ((i 0 (+ i 1))) ((= i size) (byte-vector-ref v 0)) (byte-vector-set! v i 2)) */
+		    for (; integer(stepper) < end; integer(stepper)++)
+		      fi(o);
+	      }
+	    else /* (do ((i 0 (+ i 1))) ((= i 1)) (char-alphabetic? (string-ref #u(0 1) 1))) or (logbit? i -1): kinda nutty */
+	      for (; integer(stepper) < end; integer(stepper)++)
+		func(sc);
+	  clear_mutable_integer(stepper);
+	}
+      else
+	{
+	  s7_pointer step_slot = let_dox_slot1(sc->curlet);
+	  s7_pointer end_slot = let_dox_slot2(sc->curlet);
+	  s7_int step = integer(slot_value(step_slot));
+	  s7_int stop = integer(slot_value(end_slot));
+	  step_val = slot_value(step_slot);
+
+	  if (func == opt_cell_any_nv)
+	    {
+	      opt_info *o = sc->opts[0];
+	      s7_pointer (*fp)(opt_info *o) = o->v[0].fp;
+	      if (!opt_do_copy(sc, o, step, stop))
+		{
+		  if ((step >= 0) && (stop < NUM_SMALL_INTS))
+		    {
+		      if (fp == opt_when_p_2)
+			{ /* (do ((i 0 (+ i 1))) ((= i len) (list mx loc)) (when (> (abs (vect i)) mx) (set! mx (vect i)) (set! loc i))) */
+			  for (; step < stop; step++)
+			    {
+			      slot_set_value(step_slot, small_int(step));
+			      if (o->v[4].fb(o->v[3].o1))
+				{
+				  o->v[6].fp(o->v[5].o1);
+				  o->v[8].fp(o->v[7].o1);
+				}}}
+		      else /* (do ((k 0 (+ k 1))) ((= k 10) sum) (do ((i 0 (+ i 1))) ((= i size/10)) (set! sum (+ sum (round (vector-ref v k i)))))) */
+			for (; step < stop; step++)
+			  {
+			    slot_set_value(step_slot, small_int(step));
+			    fp(o);
+			  }}
+		  else /* (do ((i 0 (+ i 1))) ((= i len) (list mx loc)) (when (> (abs (vect i)) mx) (set! mx (vect i)) (set! loc i))) */
+		    for (; step < stop; step++)
+		      {
+			slot_set_value(step_slot, make_integer(sc, step));
+			fp(o);
+		      }}}
+	  else
+	    if ((step >= 0) && (stop < NUM_SMALL_INTS))
+	      {	/* (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (+ (* x1 (block-ref b1 i)) (* x2 (block-ref b2 j))))) */
+		for (; step < stop; step++)
+		  {
+		    slot_set_value(step_slot, small_int(step));
+		    func(sc);
+		  }}
+	    else
+	      if (func == opt_int_any_nv)
+		{ /* (do ((i 0 (+ i 1))) ((= i size) sum) (set! sum (+ sum (floor (vector-ref v i))))) */
+		  opt_info *o = sc->opts[0];
+		  s7_int (*fi)(opt_info *o) = o->v[0].fi;
+		  if ((fi == opt_set_i_i_f) || (fi == opt_set_i_i_fo))
+		    {
+		      slot_set_value(o->v[1].p, make_mutable_integer(sc, integer(slot_value(o->v[1].p))));
+		      fi = (fi == opt_set_i_i_f) ? opt_set_i_i_fm : opt_set_i_i_fom;
+		    }
+		  while (step < stop)
+		    {
+		      fi(o);
+		      step = ++integer(step_val);
+		    }
+		  if ((fi == opt_set_i_i_fm) || (fi == opt_set_i_i_fom))
+		    clear_mutable_integer(slot_value(o->v[1].p));
+		}
+	      else
+		if (func == opt_float_any_nv)
+		  { /* (do ((i 1 (+ i 1))) ((= i 1000)) (set! (v i) (filter f1 0.0))) */
+		    opt_info *o = sc->opts[0];
+		    s7_double (*fd)(opt_info *o) = o->v[0].fd;
+		    if (fd == opt_set_d_d_f)
+		      { /* (do ((i 0 (+ i 1))) ((= i 32768)) (set! sum (+ sum (float-vector-ref ndat i)))) */
+			slot_set_value(o->v[1].p, make_mutable_real(sc, real(slot_value(o->v[1].p))));
+			fd = opt_set_d_d_fm;
+		      }
+		    while (step < stop)
+		      {
+			fd(o);
+			step = ++integer(step_val);
+		      }
+		    if (fd == opt_set_d_d_fm)
+		      clear_mutable_number(slot_value(o->v[1].p));
+		  }}
+	        /* there aren't any other possibilities */
+      sc->value = sc->T;
+      sc->code = cdadr(scc);
+      return(true);
+    }
+
+  { /* not is_null(cdr(code)) i.e. there's more than one thing to do in the body */
+    s7_pointer p;
+    s7_int body_len = s7_list_length(sc, code);
+    opt_info *body[32];
+    int32_t k;
+
+    sc->pc = 0;
+    if (body_len >= 32) return(false);
+
+    if (!no_float_opt(code))
+      {
+	for (k = 0, p = code; is_pair(p); k++, p = cdr(p))
+	  {
+	    body[k] = sc->opts[sc->pc];
+	    if (!float_optimize(sc, p))
+	      break;
+	    /* if opt_set_d_d_f -> fm mutablizing body[k]->v[1].p? see 83033 but protect against (data i) as below */
+	  }
+	if (is_pair(p))
+	  {
+	    sc->pc = 0;
+	    set_no_float_opt(code);
+	  }
+	else
+	  {
+	    if (loop_end_ok)
+	      { /* (do ((i start (+ i 1))) ((= i end)) (outa i (* ampa (ina i *reverb*))) (outb i (* ampb (inb i *reverb*)))) */
+		s7_int end = loop_end(sc->args);
+		s7_pointer stepper = make_mutable_integer(sc, integer(slot_value(sc->args)));
+		slot_set_value(sc->args, stepper);
+		for (; integer(stepper) < end; integer(stepper)++)
+		  for (int32_t i = 0; i < body_len; i++) body[i]->v[0].fd(body[i]);
+		clear_mutable_integer(stepper);
+	      }
+	    else
+	      { /* (do ((i 0 (+ i 1))) ((= i 5)) (set! (data i) (delay dly1 impulse -0.4)) (set! impulse 0.0)) */
+		s7_pointer step_slot = let_dox_slot1(sc->curlet);
+		s7_pointer end_slot = let_dox_slot2(sc->curlet);
+		s7_int stop = integer(slot_value(end_slot));
+		step_val = slot_value(step_slot);
+		for (s7_int step = integer(step_val); step < stop; step = ++integer(step_val))
+		  for (int32_t i = 0; i < body_len; i++) body[i]->v[0].fd(body[i]);
+		/* tari[99 ff]: 4 calls here all safe (see d_syntax_ok, need to make the change and the list here dependent on two-sets bit(?) (3.3M calls) */
+		/* tall: (3.3M calls) */
+	      }
+	    sc->value = sc->T;
+	    sc->code = cdadr(scc);
+	    return(true);
+	  }}
+
+    /* not float opt */
+    sc->pc = 0;
+    for (k = 0, p = code; is_pair(p); k++, p = cdr(p))
+      {
+	opt_info *start = sc->opts[sc->pc];
+	if (!cell_optimize(sc, p))
+	  break;
+	oo_idp_nr_fixup(start);
+	body[k] = start;
+      }
+
+    if (is_null(p))
+      {
+	if ((S7_DEBUGGING) && (loop_end_ok) && (!has_loop_end(sc->args))) fprintf(stderr, "%s[%d]: loop_end_ok but not has_loop_end\n", __func__, __LINE__);
+	if (loop_end_ok)
+	  { /* (do ((i 0 (+ i 1))) ((= i 1) strs) (copy (vector-ref strs i) (make-string 1)) (copy (vector-ref strs i) (make-string 0))) */
+	    s7_int end = loop_end(sc->args);
+	    s7_pointer stepper = make_mutable_integer(sc, integer(slot_value(sc->args)));
+	    slot_set_value(sc->args, stepper);
+	    if ((body_len & 0x3) == 0)
+	      for (; integer(stepper) < end; integer(stepper)++)
+		for (int32_t i = 0; i < body_len; )
+		  LOOP_4(body[i]->v[0].fp(body[i]); i++);
+	    else
+	      for (; integer(stepper) < end; integer(stepper)++)
+		for (int32_t i = 0; i < body_len; i++) body[i]->v[0].fp(body[i]);
+	    clear_mutable_integer(stepper);
+	  }
+	else
+	  { /* (do ((k j (+ k 1))) ((= k len2) obj) (set! (obj n) (seq2 k)) (set! n (+ n 1))) */
+	    s7_pointer step_slot = let_dox_slot1(sc->curlet);
+	    s7_pointer end_slot = let_dox_slot2(sc->curlet);
+	    s7_int stop = integer(slot_value(end_slot));
+	    for (s7_int step = integer(slot_value(step_slot)); step < stop; step++)
+	      {
+		slot_set_value(step_slot, make_integer(sc, step));
+		for (int32_t i = 0; i < body_len; i++) body[i]->v[0].fp(body[i]);
+	      }}
+	sc->value = sc->T;
+	sc->code = cdadr(scc);
+	return(true);
+      }}
+  return(false);
+}
+
+static bool do_let(s7_scheme *sc, s7_pointer step_slot, s7_pointer scc)
+{
+  s7_pointer let_body, p = NULL, let_vars, let_code = caddr(scc), ip;
+  bool let_star;
+  s7_pointer old_e, stepper;
+  s7_int body_len, var_len, k, end;
+  #define O_SIZE 32
+  opt_info *body[O_SIZE], *vars[O_SIZE];
+  memclr((void *)body, O_SIZE * sizeof(opt_info *)); /* placate the damned compiler */
+  memclr((void *)vars, O_SIZE * sizeof(opt_info *));
+
+  /* do_let with non-float vars doesn't get many fixable hits */
+  if ((!is_pair(cdr(let_code))) || (!is_list(cadr(let_code)))) /* (do ((j 0 (+ j 1))) ((= j 1)) (let name 123)) */
+    return(false);
+  let_body = cddr(let_code);
+  body_len = s7_list_length(sc, let_body);
+  if ((body_len <= 0) || (body_len >= 32)) return(false);
+  let_star = (symbol_syntax_op_checked(let_code) == OP_LET_STAR);
+  let_vars = cadr(let_code);
+  set_safe_stepper(step_slot);
+  stepper = slot_value(step_slot);
+  old_e = sc->curlet;
+  set_curlet(sc, make_let(sc, sc->curlet));
+
+  sc->pc = 0;
+  for (var_len = 0, p = let_vars; (is_pair(p)) && (var_len < 32); var_len++, p = cdr(p))
+    {
+      if ((!is_pair(car(p))) ||
+	  (!is_normal_symbol(caar(p))) ||
+	  (!is_pair(cdar(p))))
+	return(false);
+      vars[var_len] = sc->opts[sc->pc];
+      if (!float_optimize(sc, cdar(p)))   /* each of these needs to set the associated variable */
+	{
+	  set_curlet(sc, old_e);
+	  return(false);
+	}
+      if (let_star)
+	add_slot_checked(sc, sc->curlet, caar(p), make_mutable_real(sc, 1.5));
+    }
+
+  if (!let_star)
+    for (p = let_vars; is_pair(p); p = cdr(p))
+      add_slot_checked(sc, sc->curlet, caar(p), make_mutable_real(sc, 1.5));
+
+  for (k = 0, p = let_body; is_pair(p); k++, p = cdr(p))
+    {
+      body[k] = sc->opts[sc->pc];
+      if (!float_optimize(sc, p))
+	{
+	  set_curlet(sc, old_e);
+	  return(false);
+	}}
+  if (!is_null(p)) /* no hits in s7test or snd-test */
+    {
+      set_curlet(sc, old_e);
+      return(false);
+    }
+  end = loop_end(step_slot);
+  let_set_slots(sc->curlet, reverse_slots(let_slots(sc->curlet)));
+  ip = slot_value(step_slot);
+
+  if (body_len == 1)
+    {
+      if (var_len == 1)
+	{
+	  opt_info *first = sc->opts[0];
+	  opt_info *o = body[0];
+	  s7_pointer xp = t_lookup(sc, caar(let_vars), let_vars);
+	  s7_double (*f1)(opt_info *o) = first->v[0].fd;
+	  s7_double (*f2)(opt_info *o) = o->v[0].fd;
+	  set_integer(ip, numerator(stepper));
+	  set_real(xp, f1(first));
+	  f2(o);
+	  if ((f2 == opt_fmv) &&
+	      (f1 == opt_d_dd_ff_o2) &&
+	      (first->v[3].d_dd_f == add_d_dd) &&
+	      (slot_symbol(step_slot) == slot_symbol(o->v[2].p)))
+	    {
+	      opt_info *o1 = o->v[12].o1;
+	      opt_info *o2 = o->v[13].o1;
+	      opt_info *o3 = o->v[14].o1;
+	      s7_d_vid_t vf7 = o->v[4].d_vid_f;
+	      s7_d_v_t vf1 = first->v[4].d_v_f;
+	      s7_d_v_t vf2 = first->v[5].d_v_f;
+	      s7_d_v_t vf3 = o1->v[2].d_v_f;
+	      s7_d_v_t vf4 = o3->v[5].d_v_f;
+	      s7_d_vd_t vf5 = o2->v[3].d_vd_f;
+	      s7_d_vd_t vf6 = o3->v[6].d_vd_f;
+	      void *obj1 = first->v[1].obj;
+	      void *obj2 = first->v[2].obj;
+	      void *obj3 = o1->v[1].obj;
+	      void *obj4 = o3->v[1].obj;
+	      void *obj5 = o->v[5].obj;
+	      void *obj6 = o2->v[5].obj;
+	      void *obj7 = o3->v[2].obj;
+	      for (k = numerator(stepper) + 1; k < end; k++)
+		{
+		  s7_double vib = vf1(obj1) + vf2(obj2);
+		  s7_double amp_env = vf3(obj3);
+		  vf7(obj5, k, amp_env * vf5(obj6, vib + (vf4(obj4) * vf6(obj7, vib))));
+		}}
+	  else
+	    for (k = numerator(stepper) + 1; k < end; k++)
+	      {
+		set_integer(ip, k);
+		set_real(xp, f1(first));
+		f2(o);
+	      }} /* body_len == 1 and var_len == 1 */
+      else
+	{
+	  if (var_len == 2)
+	    {
+	      s7_pointer s1 = let_slots(sc->curlet);
+	      s7_pointer s2 = next_slot(s1);
+	      for (k = numerator(stepper); k < end; k++)
+		{
+		  set_integer(ip, k);
+		  set_real(slot_value(s1), vars[0]->v[0].fd(vars[0]));
+		  set_real(slot_value(s2), vars[1]->v[0].fd(vars[1]));
+		  body[0]->v[0].fd(body[0]);
+		}} /* body_len == 1 and var_len == 2 */
+	  else
+	    for (k = numerator(stepper); k < end; k++)
+	      {
+		set_integer(ip, k);
+		p = let_slots(sc->curlet);
+		for (int32_t n = 0; tis_slot(p); n++, p = next_slot(p))
+		  set_real(slot_value(p), vars[n]->v[0].fd(vars[n]));
+		body[0]->v[0].fd(body[0]);
+	      }}} /* end body_len == 1 */
+  else
+    if ((body_len == 2) && (var_len == 1))
+      {
+	s7_pointer s1 = let_slots(sc->curlet);
+	for (k = numerator(stepper); k < end; k++)
+	  {
+	    set_integer(ip, k);
+	    set_real(slot_value(s1), vars[0]->v[0].fd(vars[0]));
+	    body[0]->v[0].fd(body[0]);
+	    body[1]->v[0].fd(body[1]);
+	  }}
+    else
+      for (k = numerator(stepper); k < end; k++)
+	{
+	  int32_t i;
+	  set_integer(ip, k);
+	  for (i = 0, p = let_slots(sc->curlet); tis_slot(p); i++, p = next_slot(p))
+	    set_real(slot_value(p), vars[i]->v[0].fd(vars[i]));
+	  for (i = 0; i < body_len; i++) body[i]->v[0].fd(body[i]);
+	}
+  set_curlet(sc, old_e);
+  sc->value = sc->T;
+  sc->code = cdadr(scc);
+  return(true);
+}
+
+static bool do_let_or_dotimes(s7_scheme *sc, s7_pointer code, bool loop_end_ok)
+{
+  s7_pointer body = caddr(code);   /* here we assume one expr in body?? */
+  if (((is_syntactic_pair(body)) ||
+       (is_symbol_and_syntactic(car(body)))) &&
+      ((symbol_syntax_op_checked(body) == OP_LET) ||
+       (symbol_syntax_op(car(body)) == OP_LET_STAR)))
+    return(do_let(sc, sc->args, code));
+  return(opt_dotimes(sc, cddr(code), code, loop_end_ok));
+}
+
+static goto_t op_safe_dotimes(s7_scheme *sc)
+{
+  s7_pointer init_val, form = sc->code;
+  sc->code = cdr(sc->code);
+
+  init_val = fx_call(sc, cdaar(sc->code));
+  if (s7_is_integer(init_val))
+    {
+      s7_pointer end_expr = caadr(sc->code);
+      s7_pointer code = sc->code;
+      s7_pointer end_val = caddr(end_expr);
+      if (is_symbol(end_val))
+	end_val = lookup_checked(sc, end_val);
+
+      if (s7_is_integer(end_val))
+	{
+	  sc->code = cddr(code);
+	  set_curlet(sc, make_let(sc, sc->curlet));
+	  sc->args = add_slot_checked(sc, sc->curlet, caaar(code), make_mutable_integer(sc, s7_integer_clamped_if_gmp(sc, init_val)));
+	  set_loop_end(sc->args, s7_integer_clamped_if_gmp(sc, end_val));
+	  set_has_loop_end(sc->args);  /* safe_dotimes step is by 1 */
+
+	  /* (define (hi) (do ((i 1 (+ 1 i))) ((= i 1) i))) -- we need the let even if the loop is not evaluated */
+
+	  /* safe_dotimes: (car(body) is known to be a pair here)
+	   *   if 1-expr body look for syntactic case, if let(*) goto do_let, else opt_dotimes
+	   *       if they are unhappy, goto safe_dotimes_step_o
+	   *   else goto opt_dotimes then safe_dotimes_step_o
+	   *   if multi-line body, check opt_dotimes, then safe_dotimes_step
+	   */
+	  if (s7_integer_clamped_if_gmp(sc, init_val) == s7_integer_clamped_if_gmp(sc, end_val))
+	    {
+	      sc->value = sc->T;
+	      sc->code = cdadr(code);
+	      return(goto_safe_do_end_clauses);
+	    }
+	  if ((is_null(cdr(sc->code))) &&
+	      (is_pair(car(sc->code))))
+	    {
+	      sc->code = car(sc->code);
+	      set_opt2_pair(code, sc->code); /* is_pair above */
+	      if ((is_syntactic_pair(sc->code)) ||
+		  (is_symbol_and_syntactic(car(sc->code))))
+		{
+		  if (!is_unsafe_do(code))
+		    {
+		      if (do_let_or_dotimes(sc, code, true))
+			return(goto_safe_do_end_clauses);
+		      set_unsafe_do(code);
+		    }
+		  push_stack(sc, OP_SAFE_DOTIMES_STEP_O, sc->args, code);
+		  if (is_syntactic_pair(sc->code))
+		    sc->cur_op = (opcode_t)optimize_op(sc->code);
+		  else
+		    {
+		      sc->cur_op = (opcode_t)symbol_syntax_op_checked(sc->code);
+		      pair_set_syntax_op(sc->code, sc->cur_op);
+		    }
+		  return(goto_top_no_pop);
+		}
+	      /* car not syntactic? */
+	      if ((!is_unsafe_do(code)) &&
+		  (opt_dotimes(sc, cddr(code), code, true)))
+		return(goto_safe_do_end_clauses);
+	      set_unsafe_do(code);
+
+	      if (has_fx(cddr(code))) /* this almost never happens and the func case below is only in timing tests */
+		{
+		  s7_int end = s7_integer_clamped_if_gmp(sc, end_val);
+		  s7_pointer body = cddr(code), stepper = slot_value(sc->args);
+		  for (; integer(stepper) < end; integer(stepper)++)
+		    fx_call(sc, body);
+		  sc->value = sc->T;
+		  sc->code = cdadr(code);
+		  return(goto_safe_do_end_clauses);
+		}
+	      push_stack(sc, OP_SAFE_DOTIMES_STEP_O, sc->args, code); /* arg is local step var slot, code is do form - do, sc->code is the body */
+	      return(goto_eval);
+	    }
+	  /* multi-line body */
+	  if ((!is_unsafe_do(code)) &&
+	      (opt_dotimes(sc, sc->code, code, true)))
+	    return(goto_safe_do_end_clauses);
+	  set_unsafe_do(code);
+	  set_opt2_pair(code, sc->code);
+	  push_stack(sc, OP_SAFE_DOTIMES_STEP, sc->args, code);
+	  return(goto_begin);
+	}}
+  pair_set_syntax_op(form, OP_SIMPLE_DO);
+  sc->code = form;
+  if (op_simple_do(sc)) return(goto_do_end_clauses);
+  return(goto_begin);
+}
+
+static goto_t op_safe_do(s7_scheme *sc)
+{
+  /* body is safe, step = +1, end is = or >=, but stepper and end might be set (or at least indirectly exported) in the body:
+   *    (let ((lst ())) (do ((i 0 (+ i 1))) ((= i 10)) (let ((j (min i 100))) (set! lst (cons j lst)))) lst)
+   *  however, we're very restrictive about this in check_do and do_is_safe; even this is considered trouble:
+   *    (let ((x 0)) (do ((i i (+ i 1))) ((= i 7)) (set! x (+ x i))) x)
+   * but end might not be an integer -- need to catch this earlier.
+   */
+  s7_pointer end, init_val, end_val, code, form = sc->code;
+
+  /* inits, if not >= opt_dotimes else safe_do_step */
+  sc->code = cdr(sc->code);
+  code = sc->code;
+  init_val = fx_call(sc, cdaar(code));
+  end = opt1_any(code);  /* caddr(caadr(code)) */
+  end_val = (is_symbol(end)) ? lookup_checked(sc, end) : end;
+
+  if ((!s7_is_integer(init_val)) || (!s7_is_integer(end_val))) /* this almost never happens */
+    {
+      pair_set_syntax_op(form, OP_DO_UNCHECKED);
+      return(goto_do_unchecked);
+    }
+  /* (let ((sum 0)) (define (hi) (do ((i 10 (+ i 1))) ((= i 10) i) (set! sum (+ sum i)))) (hi)) */
+  set_curlet(sc, make_let(sc, sc->curlet));
+  let_set_dox_slot1(sc->curlet, add_slot_checked(sc, sc->curlet, caaar(code), init_val)); /* define the step var -- might be needed in the end clauses */
+
+  if ((s7_integer_clamped_if_gmp(sc, init_val) == s7_integer_clamped_if_gmp(sc, end_val)) ||
+      ((s7_integer_clamped_if_gmp(sc, init_val) > s7_integer_clamped_if_gmp(sc, end_val)) &&
+       (opt1_cfunc(caadr(code)) == sc->geq_2)))
+    {
+      sc->value = sc->T;
+      sc->code = cdadr(code);
+      return(goto_safe_do_end_clauses);
+    }
+
+  if (is_symbol(end))
+    let_set_dox_slot2(sc->curlet, s7_slot(sc, end));
+  else let_set_dox_slot2(sc->curlet, make_slot(sc, caaar(code), end));
+  sc->args = let_dox_slot2(sc->curlet);  /* the various safe steps assume sc->args is the end slot */
+
+  {
+    s7_pointer step_slot = let_dox_slot1(sc->curlet);
+    slot_set_value(step_slot, make_mutable_integer(sc, integer(slot_value(step_slot))));
+    set_loop_end(step_slot, s7_integer_clamped_if_gmp(sc, end_val));
+    set_has_loop_end(step_slot);
+  }
+
+  if (!is_unsafe_do(sc->code))
+    {
+      s7_pointer old_let = sc->curlet;
+      sc->temp7 = old_let;
+      if (opt_dotimes(sc, cddr(sc->code), sc->code, false))
+	return(goto_safe_do_end_clauses);
+      set_curlet(sc, old_let);  /* apparently s7_optimize can step on sc->curlet? */
+      sc->temp7 = sc->unused;
+    }
+
+  if (is_null(cdddr(sc->code))) /* (do ((k 0 (+ k 1))) ((= k 2)) (set! sum (+ sum 1))) */
+    {
+      s7_pointer body = caddr(sc->code);
+      if ((car(body) == sc->set_symbol) &&
+	  (is_pair(cdr(body))) &&
+	  (is_symbol(cadr(body))) &&
+	  (is_pair(cddr(body))) &&
+	  (has_fx(cddr(body))) &&
+	  (is_null(cdddr(body))))                   /* so we're (set! symbol (fxable-expr...)) */
+	{
+	  s7_pointer step_slot = let_dox_slot1(sc->curlet);
+	  if (slot_symbol(step_slot) != cadr(body)) /* we're not setting the stepper */
+	    {
+	      s7_int endi = integer(let_dox2_value(sc->curlet));
+	      s7_pointer fx_p = cddr(body);
+	      s7_pointer val_slot = s7_slot(sc, cadr(body));
+	      s7_int step = integer(slot_value(step_slot));
+	      s7_pointer step_val = slot_value(step_slot);
+	      do {
+		slot_set_value(val_slot, fx_call(sc, fx_p));
+		set_integer(step_val, ++step);
+	      } while (step != endi); /* geq not needed here -- we're leq endi and stepping by +1 all ints */
+	      clear_mutable_integer(step_val);
+	      sc->value = sc->T;
+	      sc->code = cdadr(code);
+	      return(goto_safe_do_end_clauses);
+	    }}}
+  sc->code = cddr(code);
+  set_unsafe_do(sc->code);
+  set_opt2_pair(code, sc->code);
+  push_stack_no_args(sc, OP_SAFE_DO_STEP, code);  /* (do ((i 0 (+ i 1))) ((= i 2)) (set! (str i) #\a)) */
+  return(goto_begin);
+}
+
+static goto_t op_dotimes_p(s7_scheme *sc)
+{
+  s7_pointer code = cdr(sc->code), end_val, slot, old_e;
+  s7_pointer end = opt1_any(code); /* caddr(opt2_pair(code)) */
+  /* (do ... (set! args ...)) -- one line, syntactic */
+
+  s7_pointer init_val = fx_call(sc, cdaar(code));
+  sc->value = init_val;
+  set_opt2_pair(code, caadr(code));
+  if (is_symbol(end))
+    {
+      slot = s7_slot(sc, end);
+      end_val = slot_value(slot);
+    }
+  else
+    {
+      slot = make_slot(sc, make_symbol(sc, "___end___", 9), end); /* name is ignored, but needs to be > 8 chars for gcc's benefit (version 10.2.1)! */
+      end_val = end;
+    }
+  if ((!s7_is_integer(init_val)) || (!s7_is_integer(end_val)))
+    {
+      pair_set_syntax_op(sc->code, OP_DO_UNCHECKED);
+      sc->code = cdr(sc->code);
+      return(goto_do_unchecked);
+    }
+
+  old_e = sc->curlet;
+  set_curlet(sc, make_let(sc, sc->curlet));
+  let_set_dox_slot1(sc->curlet, add_slot_checked(sc, sc->curlet, caaar(code), init_val));
+  let_set_dox_slot2(sc->curlet, slot);
+
+  set_car(sc->t2_1, let_dox1_value(sc->curlet));
+  set_car(sc->t2_2, let_dox2_value(sc->curlet));
+  if (is_true(sc, sc->value = fn_proc(caadr(code))(sc, sc->t2_1)))
+    {
+      sc->code = cdadr(code);
+      return(goto_do_end_clauses);
+    }
+  if ((!is_unsafe_do(code)) &&
+      (opt1_cfunc(caadr(code)) != sc->geq_2))
+    {
+      s7_pointer old_args = sc->args;
+      s7_pointer old_init = let_dox1_value(sc->curlet);
+      sc->args = T_Slt(let_dox_slot1(sc->curlet));  /* used in opt_dotimes */
+      slot_set_value(sc->args, make_mutable_integer(sc, integer(let_dox1_value(sc->curlet))));
+      set_loop_end(sc->args, integer(let_dox2_value(sc->curlet)));
+      set_has_loop_end(sc->args);                  /* dotimes step is by 1 */
+      sc->code = cdr(sc->code);
+      if (do_let_or_dotimes(sc, code, false))
+	return(goto_do_end_clauses); /* not safe_do here */
+      slot_set_value(sc->args, old_init);
+      set_curlet(sc, old_e); /* free_cell(sc, sc->curlet) beforehand is not safe */
+      sc->args = old_args;
+      set_unsafe_do(code);
+      return(goto_do_unchecked);
+    }
+  push_stack_no_args(sc, OP_DOTIMES_STEP_O, code);
+  sc->code = caddr(code);
+  return(goto_eval);
+}
+
+static bool op_do_init_1(s7_scheme *sc)
+{
+  while (true)  /* at start, first value is the loop (for GC protection?), returning sc->value is the next value */
+    {
+      s7_pointer init;
+      sc->args = cons(sc, sc->value, sc->args);    /* code will be last element (first after reverse), these cons's will be used below for the new let/slots */
+      if (!is_pair(sc->code)) break;
+      /* here sc->code is a list like: ((i 0 (+ i 1)) ...) so cadar gets the init value */
+      init = cdar(sc->code);
+      if (has_fx(init))
+	sc->value = fx_call(sc, init);
+      else
+	{
+	  init = car(init);
+	  if (is_pair(init))
+	    {
+	      push_stack(sc, OP_DO_INIT, sc->args, cdr(sc->code));  /* OP_DO_INIT only used here */
+	      sc->code = init;
+	      return(true); /* goto EVAL */
+	    }
+	  sc->value = (is_symbol(init)) ? lookup_checked(sc, init) : init;
+	}
+      sc->code = cdr(sc->code);
+    }
+  /* all the initial values are now in the args list */
+  sc->args = proper_list_reverse_in_place(sc, sc->args);
+  sc->code = car(sc->args);                       /* saved at the start */
+  sc->x = cdr(sc->args);                          /* init values */
+  free_cell(sc, sc->args);
+  sc->args = sc->x;
+  set_curlet(sc, make_let(sc, T_Let(sc->curlet)));
+
+  /* run through sc->code and sc->args adding '( caar(car(code)) . car(args) ) to sc->curlet */
+  sc->value = sc->nil;
+  for (s7_pointer x = car(sc->code), y = sc->args; is_not_null(y); x = cdr(x), y = cdr(y))
+    {
+      s7_pointer slot = add_slot_unchecked_with_id(sc, sc->curlet, caar(x), unchecked_car(y));
+      if (is_pair(cddar(x)))                   /* else no incr expr, so ignore it henceforth */
+	{
+	  slot_set_expression(slot, cddar(x));
+	  sc->value = cons_unchecked(sc, slot, sc->value);
+	}}
+  sc->args = cons(sc, sc->value = proper_list_reverse_in_place(sc, sc->value), cadr(sc->code));
+  sc->code = cddr(sc->code);
+  return(false); /* fall through */
+}
+
+static bool op_do_init(s7_scheme *sc) /* looping through inits via eval */
+{
+  if (is_multiple_value(sc->value))               /* (do ((i (values 1 2)))...) */
+    error_nr(sc, sc->wrong_type_arg_symbol,
+	     set_elist_2(sc, wrap_string(sc, "do: variable initial value can't be ~S", 38),
+			     set_ulist_1(sc, sc->values_symbol, sc->value)));
+  return(!op_do_init_1(sc));
+}
+
+static void op_do_unchecked(s7_scheme *sc)
+{
+  gc_protect_via_stack(sc, sc->code);
+  sc->code = cdr(sc->code);
+}
+
+static bool do_unchecked(s7_scheme *sc)
+{
+  if (is_null(car(sc->code)))                     /* (do () ...) -- (let ((i 0)) (do () ((= i 1)) (set! i 1))) */
+    {
+      set_curlet(sc, make_let(sc, sc->curlet));
+      sc->args = cons_unchecked(sc, sc->nil, cadr(sc->code));
+      sc->code = cddr(sc->code);
+      return(false);
+    }
+  /* eval each init value, then set up the new let (like let, not let*) */
+  sc->args = sc->nil;                             /* the evaluated var-data */
+  sc->value = sc->code;                           /* protect it */
+  sc->code = car(sc->code);                       /* the vars */
+  return(op_do_init_1(sc));
+}
+
+static bool op_do_end(s7_scheme *sc)
+{
+  if (is_pair(cdr(sc->args)))
+    {
+      if (!has_fx(cdr(sc->args)))
+	{
+	  push_stack_direct(sc, OP_DO_END1);
+	  sc->code = cadr(sc->args);              /* evaluate the end expr */
+	  return(true);
+	}
+      sc->value = fx_call(sc, cdr(sc->args));
+    }
+  else sc->value = sc->F;                         /* goto "if (is_pair(sc->code))..." below */
+  return(false);
+}
+
+static goto_t op_do_end_false(s7_scheme *sc)
+{
+  if (!is_pair(sc->code))
+    return((is_null(car(sc->args))) ? /* no steppers */ goto_do_end : fall_through);
+  if (is_null(car(sc->args)))
+    push_stack_direct(sc, OP_DO_END);
+  else push_stack_direct(sc, OP_DO_STEP);
+  return(goto_begin);
+}
+
+static goto_t op_do_end_true(s7_scheme *sc)
+{
+  /* we're done -- deal with result exprs, if there isn't an end test, there also isn't a result (they're in the same list)
+   * multiple-value end-test result is ok
+   */
+  sc->code = T_Lst(cddr(sc->args));   /* result expr (a list -- implicit begin) */
+  /* unsafe: free_cell(sc, sc->args); */ /* t101-8|13 */
+  sc->args = sc->nil;
+  if (is_null(sc->code))
+    {
+      if (is_multiple_value(sc->value))  /* (define (f) (+ 1 (do ((i 2 (+ i 1))) ((values i (+ i 1)))))) -> 6 */
+	sc->value = splice_in_values(sc, multiple_value(sc->value));
+      /* similarly, if the result is a multiple value: (define (f) (+ 1 (do ((i 2 (+ i 1))) ((= i 3) (values i (+ i 1)))))) -> 8 */
+      return(goto_start);
+    }
+  /* might be => here as in cond and case */
+  if (is_null(cdr(sc->code)))
+    {
+      if (has_fx(sc->code))
+	{
+	  sc->value = fx_call(sc, sc->code);
+	  return(goto_start);
+	}
+      sc->code = car(sc->code);
+      return(goto_eval);
+    }
+  if (is_undefined_feed_to(sc, car(sc->code)))
+    return(goto_feed_to);
+  push_stack_no_args(sc, sc->begin_op, cdr(sc->code));
+  sc->code = car(sc->code);
+  return(goto_eval);
+}
+
+
+/* -------------------------------- apply functions -------------------------------- */
+static inline s7_pointer apply_c_function(s7_scheme *sc, s7_pointer func, s7_pointer args) /* -------- C-based function -------- */
+{
+  s7_int len = proper_list_length(args);
+  if (len < c_function_min_args(func))
+    error_nr(sc, sc->wrong_number_of_args_symbol,
+	     set_elist_4(sc, wrap_string(sc, "~A: not enough arguments: (~A~{~^ ~S~})", 39), func, func, args));
+  if (c_function_max_args(func) < len)
+    error_nr(sc, sc->wrong_number_of_args_symbol,
+	     set_elist_4(sc, wrap_string(sc, "~A: too many arguments: (~A~{~^ ~S~})", 37), func, func, args));
+  return(c_function_call(func)(sc, args));
+  /* just by chance, this code is identical to macroexpand_c_macro's code (after macro expansion)! So,
+   *   gcc -O2 uses the macroexpand code, but then valgrind shows us calling macros all the time, and
+   *   gdb with break apply_c_function breaks at macroexpand -- confusing!
+   */
+}
+
+static s7_pointer apply_c_function_unopt(s7_scheme *sc, s7_pointer func, s7_pointer args) /* an experiment -- callgrind says this saves time */
+{
+  s7_int len = proper_list_length(args);
+  if (len < c_function_min_args(func))
+    error_nr(sc, sc->wrong_number_of_args_symbol,
+	     set_elist_4(sc, wrap_string(sc, "~A: not enough arguments: (~A~{~^ ~S~})", 39), func, func, args));
+  if (c_function_max_args(func) < len)
+    error_nr(sc, sc->wrong_number_of_args_symbol,
+	     set_elist_4(sc, wrap_string(sc, "~A: too many arguments: (~A~{~^ ~S~})", 37), func, func, args));
+  return(c_function_call(func)(sc, args));
+}
+
+static void apply_c_rst_no_req_function(s7_scheme *sc)      /* -------- C-based function that can take any number of arguments -------- */
+{
+  if ((S7_DEBUGGING) && (type(sc->code) == T_C_FUNCTION_STAR)) fprintf(stderr, "%s: c_func*!\n", __func__);
+  sc->value = c_function_call(sc->code)(sc, sc->args);
+}
+
+static void apply_c_macro(s7_scheme *sc)  	            /* -------- C-based macro -------- */
+{
+  s7_int len = proper_list_length(sc->args);
+  if (len < c_macro_min_args(sc->code))
+    error_nr(sc, sc->wrong_number_of_args_symbol,
+	     set_elist_4(sc, wrap_string(sc, "~A: not enough arguments: (~A~{~^ ~S~})", 39), sc->code, sc->code, sc->args));
+  if (c_macro_max_args(sc->code) < len)
+    error_nr(sc, sc->wrong_number_of_args_symbol,
+	     set_elist_4(sc, wrap_string(sc, "~A: too many arguments: (~A~{~^ ~S~})", 37), sc->code, sc->code, sc->args));
+  sc->code = c_macro_call(sc->code)(sc, sc->args);
+}
+
+static void apply_syntax(s7_scheme *sc)                    /* -------- syntactic keyword as applicable object -------- */
+{                                                          /* current reader-cond macro uses this via (map quote ...) */
+  s7_int len;                                              /*    ((apply lambda '((x) (+ x 1))) 4) */
+  if (is_pair(sc->args))                                   /* this is ((pars) . body) */
+    {
+      len = s7_list_length(sc, sc->args);
+      if (len == 0)
+	syntax_error_nr(sc, "attempt to evaluate a circular list: ~S", 39, sc->args);
+      if ((sc->safety > NO_SAFETY) &&
+	  (tree_is_cyclic(sc, sc->args)))
+	error_nr(sc, sc->syntax_error_symbol,
+		 set_elist_3(sc, wrap_string(sc, "apply ~S: body is circular: ~S", 30), sc->code, sc->args));
+    }
+  else len = 0;
+
+  if (len < syntax_min_args(sc->code))
+    error_nr(sc, sc->wrong_number_of_args_symbol,
+	     set_elist_4(sc, wrap_string(sc, "~A: not enough arguments: (~A~{~^ ~S~})", 39), sc->code, sc->code, sc->args));
+  if ((syntax_max_args(sc->code) < len) &&
+      (syntax_max_args(sc->code) != -1))
+    error_nr(sc, sc->wrong_number_of_args_symbol,
+		set_elist_4(sc, wrap_string(sc, "~A: too many arguments: (~A~{~^ ~S~})", 37), sc->code, sc->code, sc->args));
+  sc->cur_op = syntax_opcode(sc->code);          /* (apply begin '((define x 3) (+ x 2))) */
+  /* I had elaborate checks here for embedded circular lists, but now I think that is the caller's problem */
+  sc->code = cons(sc, sc->code, sc->args);
+  set_current_code(sc, sc->code);
+  pair_set_syntax_op(sc->code, sc->cur_op);
+}
+
+static void apply_vector(s7_scheme *sc)                    /* -------- vector as applicable object -------- */
+{
+  /* sc->code is the vector, sc->args is the list of indices */
+  if (is_null(sc->args))                  /* (#2d((1 2) (3 4))) */
+    wrong_number_of_arguments_error_nr(sc, "implicit vector-ref nedes an index argument: (~A)", 49, sc->code);
+  if ((is_null(cdr(sc->args))) &&
+      (s7_is_integer(car(sc->args))) &&
+      (vector_rank(sc->code) == 1))
+    {
+      s7_int index = s7_integer_clamped_if_gmp(sc, car(sc->args));
+      if ((index >= 0) &&
+	  (index < vector_length(sc->code)))
+	sc->value = vector_getter(sc->code)(sc, sc->code, index);
+      else out_of_range_error_nr(sc, sc->vector_ref_symbol, int_two, car(sc->args), (index < 0) ? it_is_negative_string : it_is_too_large_string);
+    }
+  else sc->value = vector_ref_1(sc, sc->code, sc->args);
+}
+
+static void apply_string(s7_scheme *sc)                    /* -------- string as applicable object -------- */
+{
+  if (!is_pair(sc->args))
+    error_nr(sc, sc->wrong_number_of_args_symbol,
+	     set_elist_3(sc, wrap_string(sc, "impicit string-ref needs an index argument: (~S~{~^ ~S~})", 57), sc->code, sc->args));
+  if (!is_null(cdr(sc->args)))
+    error_nr(sc, sc->wrong_number_of_args_symbol,
+	     set_elist_3(sc, wrap_string(sc, "string ref: too many indices: (~S~{~^ ~S~})", 43), sc->code, sc->args));
+
+  if (s7_is_integer(car(sc->args)))
+    {
+      s7_int index = s7_integer_clamped_if_gmp(sc, car(sc->args));
+      if ((index >= 0) &&
+	  (index < string_length(sc->code)))
+	{
+	  sc->value = chars[((uint8_t *)string_value(sc->code))[index]];
+	  return;
+	}}
+  sc->value = string_ref_1(sc, sc->code, car(sc->args));
+}
+
+static bool apply_pair(s7_scheme *sc)                       /* -------- list as applicable object -------- */
+{
+  if (is_multiple_value(sc->code))                          /* ((values + 2 3) 4) */
+    {
+      /* car of values can be anything, so conjure up a new expression, and apply again */
+      sc->args = pair_append(sc, cdr(sc->code), T_Lst(sc->args));  /* can't use pair_append_in_place here */
+      sc->code = car(sc->code);
+      return(false);
+    }
+  if (is_null(sc->args))
+    wrong_number_of_arguments_error_nr(sc, "implicit list-ref needs an index argument: (~S)", 47, sc->code);
+  sc->value = list_ref_1(sc, sc->code, car(sc->args));    /* (L 1) */
+  if (!is_null(cdr(sc->args)))
+    sc->value = implicit_index_checked(sc, sc->code, sc->value, sc->args);
+  return(true);
+}
+
+static void apply_hash_table(s7_scheme *sc)                /* -------- hash-table as applicable object -------- */
+{
+  if (is_null(sc->args))
+    wrong_number_of_arguments_error_nr(sc, "implicit hash-table-ref needs a key to lookup: (~S)", 51, sc->code);
+  sc->value = s7_hash_table_ref(sc, sc->code, car(sc->args));
+  if (!is_null(cdr(sc->args)))
+    sc->value = implicit_index_checked(sc, sc->code, sc->value, sc->args);
+}
+
+static void apply_let(s7_scheme *sc)                       /* -------- environment as applicable object -------- */
+{
+  if (is_null(sc->args))
+    wrong_number_of_arguments_error_nr(sc, "implicit let-ref needs a symbol to lookup: (~S)", 47, sc->code);
+  sc->value = let_ref(sc, sc->code, car(sc->args));
+  if (is_pair(cdr(sc->args)))
+    sc->value = implicit_index_checked(sc, sc->code, sc->value, sc->args);
+  /*    (let ((v #(1 2 3))) (let ((e (curlet))) ((e 'v) 1))) -> 2
+   * so (let ((v #(1 2 3))) (let ((e (curlet))) (e 'v 1))) -> 2
+   */
+}
+
+static void apply_iterator(s7_scheme *sc)                  /* -------- iterator as applicable object -------- */
+{
+  if (!is_null(sc->args))
+    error_nr(sc, sc->wrong_number_of_args_symbol,
+	     set_elist_3(sc, wrap_string(sc, "iterator takes no arguments: (~A~{~^ ~S~})", 42), sc->code, sc->args));
+  sc->value = s7_iterate(sc, sc->code);
+}
+
+static Inline void inline_apply_lambda(s7_scheme *sc)      /* -------- normal function (lambda), or macro --------, called once in eval */
+{             /* load up the current args into the ((args) (lambda)) layout [via the current environment] */
+  s7_pointer x, z, e = sc->curlet, slot, last_slot = slot_end;
+  uint64_t id = let_id(sc->curlet);
+
+  for (x = closure_args(sc->code), z = T_Lst(sc->args); is_pair(x); x = cdr(x), z = cdr(z)) /* closure_args can be a symbol, for example */
+    {
+      s7_pointer sym = car(x);
+      if (is_null(z))
+	error_nr(sc, sc->wrong_number_of_args_symbol,
+		 set_elist_5(sc, wrap_string(sc, "~S: not enough arguments: ((~S ~S ...)~{~^ ~S~})", 48),
+			     closure_name(sc, sc->code),
+			     (is_closure(sc->code)) ? sc->lambda_symbol : ((is_bacro(sc->code)) ? sc->bacro_symbol : sc->macro_symbol),
+			     closure_args(sc->code), sc->args));
+      slot = make_slot(sc, sym, T_Ext(unchecked_car(z)));
+      symbol_set_local_slot(sym, id, slot);
+      if (tis_slot(last_slot))
+	slot_set_next(last_slot, slot);
+      else let_set_slots(e, slot);
+      last_slot = slot;
+      slot_set_next(slot, slot_end);
+    }
+  if (is_null(x))
+    {
+      if (is_not_null(z))
+	error_nr(sc, sc->wrong_number_of_args_symbol,
+		 set_elist_5(sc, wrap_string(sc, "~S: too many arguments: ((~S ~S ...)~{~^ ~S~})", 46),
+			     closure_name(sc, sc->code),
+			     (is_closure(sc->code)) ? sc->lambda_symbol : ((is_bacro(sc->code)) ? sc->bacro_symbol : sc->macro_symbol),
+			     closure_args(sc->code), sc->args));
+    }
+  else
+    {
+      slot = make_slot(sc, x, z);
+      symbol_set_local_slot(x, id, slot);
+      if (tis_slot(last_slot))
+	slot_set_next(last_slot, slot);
+      else let_set_slots(e, slot);
+      slot_set_next(slot, slot_end);
+    }
+  sc->code = closure_body(sc->code);
+}
+
+static void op_f(s7_scheme *sc)     /* sc->code: ((lambda () 32)) -> (let () 32) */
+{
+  set_curlet(sc, make_let(sc, sc->curlet));
+  sc->code = opt3_pair(sc->code); /* cddar */
+}
+
+static void op_f_a(s7_scheme *sc)   /* sc->code: ((lambda (x) (+ x 1)) i) -> (let ((x i)) (+ x 1)) */
+{
+  /* if caddar(sc->code) is fxable [(+ x 1) above], this could call fx and return to the top */
+  set_curlet(sc, inline_make_let_with_slot(sc, sc->curlet, opt3_sym(cdr(sc->code)), fx_call(sc, cdr(sc->code))));
+  sc->code = opt3_pair(sc->code);
+}
+
+static void op_f_aa(s7_scheme *sc)  /* sc->code: ((lambda (x y) (+ x y)) i j) -> (let ((x i) (y j)) (+ x y)) */
+{
+  gc_protect_via_stack(sc, fx_call(sc, cdr(sc->code)));
+  set_curlet(sc, make_let_with_two_slots(sc, sc->curlet, opt3_sym(cdr(sc->code)), gc_protected1(sc), cadadr(car(sc->code)), fx_call(sc, cddr(sc->code))));
+  unstack_gc_protect(sc);
+  sc->code = opt3_pair(sc->code);
+}
+
+static void op_f_np(s7_scheme *sc)   /* sc->code: ((lambda (x y) (+ x y)) (values i j)) -> (let ((x i) (y j)) (+ x y)) after splice */
+{
+  s7_pointer pars = cadar(sc->code);
+  s7_pointer e = make_let(sc, sc->curlet);
+  if (is_pair(pars))
+    {
+      s7_pointer last_slot;
+      if (is_null(cdr(sc->code))) /* ((lambda (x) 21)) */
+	error_nr(sc, sc->wrong_number_of_args_symbol,
+		 set_elist_3(sc, wrap_string(sc, "not enough arguments: ((lambda ~S ...)~{~^ ~S~})", 48),
+			     cadar(sc->code), cdr(sc->code)));
+      if (is_constant(sc, car(pars)))
+	error_nr(sc, sc->syntax_error_symbol,        /* (lambda (a) 1) where 'a is immutable (locally perhaps) */
+		 set_elist_4(sc, wrap_string(sc, "lambda parameter ~S is a constant: ((lambda ~S ...)~{~^ ~S~})", 61),
+			     car(pars), cadar(sc->code), cdr(sc->code)));
+
+      last_slot = add_slot_unchecked_no_local_slot(sc, e, car(pars), sc->undefined);
+      for (pars = cdr(pars); is_pair(pars); pars = cdr(pars))
+	last_slot = add_slot_at_end_no_local(sc, last_slot, car(pars), sc->undefined);
+      /* last par might be rest par (dotted) */
+      if (!is_null(pars))
+	{
+	  last_slot = add_slot_at_end_no_local(sc, last_slot, pars, sc->undefined);
+	  set_is_rest_slot(last_slot);
+	}}
+  /* check_stack_size(sc); */
+  if ((sc->stack_end + 4) >= sc->stack_resize_trigger) resize_stack(sc);
+  push_stack(sc, OP_GC_PROTECT, let_slots(e), cddr(sc->code)); /* not for gc-protection, but as implicit loop vars */
+  push_stack(sc, OP_F_NP_1, e, sc->code);
+  sc->code = cadr(sc->code);
+}
+
+static bool op_f_np_1(s7_scheme *sc)
+{
+  s7_pointer e, slot = gc_protected1(sc), arg = gc_protected2(sc);
+  if (is_multiple_value(sc->value))
+    {
+      s7_pointer p, oslot = slot;
+      for (p = sc->value; (is_pair(p)) && (tis_slot(slot)); p = cdr(p), oslot = slot, slot = next_slot(slot))
+	if (is_rest_slot(slot))
+	  {
+	    if (slot_value(slot) == sc->undefined)
+	      slot_set_value(slot, copy_proper_list(sc, p));
+	    else slot_set_value(slot, pair_append(sc, slot_value(slot), copy_proper_list(sc, p)));
+	    p = sc->nil;
+	    break;
+	  }
+	else slot_set_value(slot, car(p));
+      if (is_pair(p))
+	error_nr(sc, sc->wrong_number_of_args_symbol,
+		 set_elist_3(sc, wrap_string(sc, "not enough arguments: ((lambda ~S ...)~{~^ ~S~})", 48),
+			     cadar(sc->code), cdr(sc->code)));
+      slot = oslot; /* snd-test 22 grani */
+    }
+  else /* not mv */
+    if (!is_rest_slot(slot))
+      slot_set_value(slot, sc->value);
+    else
+      if (slot_value(slot) == sc->undefined)
+	slot_set_value(slot, list_1(sc, sc->value));
+      else slot_set_value(slot, pair_append(sc, slot_value(slot), list_1(sc, sc->value)));
+
+  if (is_pair(arg))
+    {
+      if ((!tis_slot(next_slot(slot))) && (!is_rest_slot(slot)))
+	error_nr(sc, sc->wrong_number_of_args_symbol,
+		 set_elist_3(sc, wrap_string(sc, "too many arguments: ((lambda ~S ...)~{~^ ~S~})", 46),
+			     cadar(sc->code), cdr(sc->code)));
+      set_gc_protected1(sc, (is_rest_slot(slot)) ? slot : next_slot(slot));
+      set_gc_protected2(sc, cdr(arg));
+      push_stack_direct(sc, OP_F_NP_1); /* sc->args=e, sc->code from start */
+      sc->code = car(arg);
+      return(true);
+    }
+  if (tis_slot(next_slot(slot)))
+    {
+      if (!is_rest_slot(next_slot(slot)))
+	error_nr(sc, sc->wrong_number_of_args_symbol,
+		 set_elist_3(sc, wrap_string(sc, "not enough arguments: ((lambda ~S ...)~{~^ ~S~})", 48),
+			     cadar(sc->code), cdr(sc->code)));
+      if (slot_value(next_slot(slot)) == sc->undefined)
+	slot_set_value(next_slot(slot), sc->nil);
+    }
+  e = sc->args;
+  let_set_id(e, ++sc->let_number);
+  set_curlet(sc, e);
+  update_symbol_ids(sc, e);
+  sc->code = cddar(sc->code);
+  unstack_gc_protect(sc);
+  return(false);
+}
+
+static void op_lambda_star(s7_scheme *sc)
+{
+  check_lambda_star(sc);
+  if (!is_pair(car(sc->code)))
+    sc->value = make_closure(sc, car(sc->code), cdr(sc->code),
+			     (is_symbol(car(sc->code))) ? (T_CLOSURE | T_COPY_ARGS) : T_CLOSURE,
+			     CLOSURE_ARITY_NOT_SET);
+  else sc->value = make_closure(sc, car(sc->code), cdr(sc->code),
+				(!arglist_has_rest(sc, car(sc->code))) ? T_CLOSURE_STAR : (T_CLOSURE_STAR | T_COPY_ARGS),
+				CLOSURE_ARITY_NOT_SET);
+}
+
+static void op_lambda_star_unchecked(s7_scheme *sc)
+{
+  s7_pointer code = cdr(sc->code);
+  if (!is_pair(car(code)))
+    sc->value = make_closure(sc, car(code), cdr(code),
+			     (is_symbol(car(code))) ? (T_CLOSURE | T_COPY_ARGS) : T_CLOSURE,
+			     CLOSURE_ARITY_NOT_SET);
+  else sc->value = make_closure(sc, car(code), cdr(code),
+				(!arglist_has_rest(sc, car(code))) ? T_CLOSURE_STAR : (T_CLOSURE_STAR | T_COPY_ARGS),
+				CLOSURE_ARITY_NOT_SET);
+}
+
+static s7_pointer star_set(s7_scheme *sc, s7_pointer slot, s7_pointer val, bool check_rest)
+{
+  if (is_checked_slot(slot))
+    error_nr(sc, sc->wrong_type_arg_symbol,
+	     set_elist_3(sc, parameter_set_twice_string, slot_symbol(slot), sc->args));
+  if ((check_rest) && (is_rest_slot(slot)))
+    error_nr(sc, sc->wrong_type_arg_symbol,
+	     set_elist_3(sc, wrap_string(sc, "can't set rest argument ~S to ~S via keyword", 44), slot_symbol(slot), val));
+  set_checked_slot(slot);
+  slot_set_value(slot, val);
+  return(val);
+}
+
+static s7_pointer lambda_star_argument_set_value(s7_scheme *sc, const s7_pointer sym, s7_pointer val, s7_pointer slot, bool check_rest)
+{
+  if (val == sc->no_value) val = sc->unspecified;
+  if (sym == slot_symbol(slot))
+    return(star_set(sc, slot, val, check_rest));
+  for (s7_pointer x = let_slots(sc->curlet) /* presumably the arglist */; tis_slot(x); x = next_slot(x))
+    if (slot_symbol(x) == sym)
+      return(star_set(sc, x, val, check_rest));
+  return(sc->no_value);
+}
+
+static s7_pointer lambda_star_set_args(s7_scheme *sc)
+{
+  s7_pointer arg_vals = sc->args, rest_key = sc->nil, code = sc->code, args = sc->args;
+  s7_pointer slot = let_slots(sc->curlet);
+  s7_pointer pars = closure_args(code);
+  bool allow_other_keys = ((is_pair(pars)) && (allows_other_keys(pars)));
+
+  while ((is_pair(pars)) &&
+	 (is_pair(arg_vals)))
+    {
+      if (car(pars) == sc->rest_keyword)           /* the rest arg: a default is not allowed here (see check_lambda_star_args) */
+	{
+	  /* next arg is bound to trailing args from this point as a list */
+	  pars = cdr(pars);
+	  if ((is_symbol_and_keyword(car(arg_vals))) &&
+	      (is_pair(cdr(arg_vals))) &&
+	      (keyword_symbol(car(arg_vals)) == car(pars)))
+	    error_nr(sc, sc->wrong_type_arg_symbol,
+		     set_elist_3(sc, wrap_string(sc, "can't set rest argument ~S to ~S via keyword", 44),
+				 car(pars), cadr(arg_vals)));
+	  lambda_star_argument_set_value(sc, car(pars), (in_heap(arg_vals)) ? arg_vals : copy_proper_list(sc, arg_vals), slot, false); /* sym5 :rest bug */
+	  rest_key = sc->rest_keyword;
+	  arg_vals = cdr(arg_vals);
+	  pars = cdr(pars);
+	  slot = next_slot(slot);
+	}
+      else
+	{
+	  s7_pointer arg_val = car(arg_vals);
+	  if (is_symbol_and_keyword(arg_val))
+	    {
+	      if (!is_pair(cdr(arg_vals)))
+		{
+		  if (!sc->accept_all_keyword_arguments)
+		    error_nr(sc, sc->wrong_type_arg_symbol,
+			     set_elist_4(sc, keyword_value_missing_string, closure_name(sc, code), arg_vals, args));
+		  slot_set_value(slot, arg_val);
+		  set_checked_slot(slot);
+		  arg_vals = cdr(arg_vals);
+		}
+	      else
+		{
+		  s7_pointer sym = keyword_symbol(arg_val);
+		  if (lambda_star_argument_set_value(sc, sym, cadr(arg_vals), slot, true) == sc->no_value)
+		    {
+		      /* if default value is a key, go ahead and use this value. (define* (f (a :b)) a) (f :c), this has become much trickier than I anticipated... */
+		      if (allow_other_keys)
+			/* in CL: (defun hi (&key (a 1) &allow-other-keys) a) (hi :b :a :a 3) -> 3
+			 * in s7: (define* (hi (a 1) :allow-other-keys) a)    (hi :b :a :a 3) -> 3
+			 */
+			arg_vals = cddr(arg_vals);
+		      else
+			{
+			  if (!sc->accept_all_keyword_arguments)
+			    error_nr(sc, sc->wrong_type_arg_symbol,
+				     set_elist_4(sc, wrap_string(sc, "~A: unknown key: ~S in ~S", 25), closure_name(sc, code), arg_vals, args));
+			  slot_set_value(slot, arg_val);
+			  set_checked_slot(slot);
+			  arg_vals = cdr(arg_vals);
+			  pars = cdr(pars);
+			  slot = next_slot(slot);
+			}
+		      continue;
+		    }
+		  arg_vals = cddr(arg_vals);
+		}
+	      slot = next_slot(slot);
+	    }
+	  else /* not a key/value pair */
+	    {
+	      if (is_checked_slot(slot))
+		error_nr(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, parameter_set_twice_string, slot_symbol(slot), sc->args));
+	      set_checked_slot(slot);
+	      slot_set_value(slot, car(arg_vals));
+	      slot = next_slot(slot);
+	      arg_vals = cdr(arg_vals);
+	    }
+	  pars = cdr(pars);
+	}}
+  /* (let () (define* (hi (a 1) :allow-other-keys) a) (hi :a 2 32)) -> 'error */
+  /* (let () (define* (f (a :b)) a) (list (f) (f 1) (f :c) (f :a :c) (f :a 1) (f))) -> 'error */
+
+  /* check for trailing args with no :rest arg */
+  if (is_not_null(arg_vals))
+    {
+      if ((is_not_null(pars)) ||
+	  (rest_key == sc->rest_keyword))
+	{
+	  if (is_symbol(pars))
+	    {
+	      if ((is_symbol_and_keyword(car(arg_vals))) &&
+		  (is_pair(cdr(arg_vals))) &&
+		  (keyword_symbol(car(arg_vals)) == pars))
+		error_nr(sc, sc->wrong_type_arg_symbol,
+			 set_elist_3(sc, wrap_string(sc, "can't set rest argument ~S to ~S via keyword", 44), pars, cadr(arg_vals)));
+	      slot_set_value(slot, (in_heap(arg_vals)) ? arg_vals : copy_proper_list(sc, arg_vals)); /* sym5 :rest bug */
+	    }}
+      else
+	{
+	  if (!allow_other_keys)                                 /* ((lambda* (a) a) :a 1 2) */
+	    error_nr(sc, sc->wrong_number_of_args_symbol,
+		     set_elist_4(sc, wrap_string(sc, "too many arguments: (~S ~S ...)~{~^ ~S~})", 41),
+				 (is_closure_star(code)) ? sc->lambda_star_symbol : ((is_bacro_star(sc->code)) ? sc->bacro_star_symbol : sc->macro_star_symbol),
+				 closure_args(code), args));
+	  /* check trailing args for repeated keys or keys with no values or values with no keys */
+	  while (is_pair(arg_vals))
+	    {
+	      if ((!is_symbol_and_keyword(car(arg_vals))) ||     /* ((lambda* (a :allow-other-keys) a) :a 1 :b 2 3) */
+		  (!is_pair(cdr(arg_vals))))                     /* ((lambda* (a :allow-other-keys) a) :a 1 :b) */
+		error_nr(sc, sc->wrong_type_arg_symbol,
+			 set_elist_3(sc, wrap_string(sc, "~A: not a key/value pair: ~S", 28), closure_name(sc, code), arg_vals));
+	      slot = symbol_to_local_slot(sc, keyword_symbol(car(arg_vals)), sc->curlet);
+	      if ((is_slot(slot)) &&
+		  (is_checked_slot(slot)))
+		error_nr(sc, sc->wrong_type_arg_symbol,
+			 set_elist_3(sc, parameter_set_twice_string, slot_symbol(slot), sc->args));
+	      arg_vals = cddr(arg_vals);
+	    }}}
+  return(sc->nil);
+}
+
+static inline bool lambda_star_default(s7_scheme *sc)
+{
+  for (s7_pointer z = sc->args; tis_slot(z); z = next_slot(z))
+    {
+      if ((slot_value(z) == sc->undefined) &&    /* trouble: (lambda* ((e #<undefined>))...) */
+	  (slot_has_expression(z)) &&            /* if default val is not a pair or a symbol, this is false */
+	  (!is_checked_slot(z)))
+	{
+	  s7_pointer val = slot_expression(z);
+	  if (is_symbol(val))
+	    {
+	      slot_set_value(z, lookup_checked(sc, val));
+	      if (slot_value(z) == sc->undefined)
+		{
+		  /* the current environment here contains the function parameters which defaulted to #<undefined>
+		   *   (or maybe #<unused>?) earlier in apply_*_closure_star_1, so (define (f f) (define* (f (f f)) f) (f)) (f 0)
+		   *   looks for the default f, finds itself currently undefined, and raises an error! So, before
+		   *   claiming it is unbound, we need to check outlet as well. But in the case above, the inner
+		   *   define* shadows the caller's parameter before checking the default arg values, so the default f
+		   *   refers to the define* -- I'm not sure this is a bug.  It means that (define* (f (a f)) a)
+		   *   returns f: (equal? f (f)) -> #t, so any outer f needs an extra let and endless outlets:
+		   *   (let ((f 3)) (let () (define* (f (a ((outlet (outlet (outlet (curlet)))) 'f))) a) (f))) -> 3
+		   *   We want the shadowing once the define* is done, so the current mess is simplest.
+		   */
+		  slot_set_value(z, s7_symbol_local_value(sc, val, let_outlet(sc->curlet)));
+		  if (slot_value(z) == sc->undefined)
+		    syntax_error_nr(sc, "lambda* defaults: ~A is unbound", 31, slot_symbol(z));
+		}}
+	  else
+	    if (!is_pair(val))
+	      slot_set_value(z, val);
+	    else
+	      if (is_quote(car(val)))
+		{
+		  if ((!is_pair(cdr(val))) ||      /* (lambda* ((a (quote))) a) or (lambda* ((a (quote 1 1))) a) etc */
+		      (is_pair(cddr(val))))
+		    syntax_error_nr(sc, "lambda* default: ~A is messed up", 32, val);
+		  slot_set_value(z, cadr(val));
+		}
+	      else
+		{
+		  push_stack(sc, OP_LAMBDA_STAR_DEFAULT, z, sc->code);
+		  sc->code = val;
+		  return(true); /* goto eval */
+		}}}
+  return(false); /* goto BEGIN */
+}
+
+static bool op_lambda_star_default(s7_scheme *sc)
+{
+  /* sc->args is the current let slots position, sc->value is the default expression's value */
+  if (is_multiple_value(sc->value))
+    syntax_error_nr(sc, "lambda*: argument default value can't be ~S", 43, set_ulist_1(sc, sc->values_symbol, sc->value));
+  slot_set_value(sc->args, sc->value);
+  sc->args = next_slot(sc->args);
+  if (lambda_star_default(sc)) return(true);
+  pop_stack_no_op(sc);
+  sc->code = T_Pair(closure_body(sc->code));
+  return(false); /* goto BEGIN */
+}
+
+static inline bool set_star_args(s7_scheme *sc, s7_pointer top)
+{
+  lambda_star_set_args(sc);                     /* load up current arg vals */
+  sc->args = top;
+  if (is_slot(sc->args))
+    {
+      /* get default values, which may involve evaluation -- see also OP_LAMBDA_STAR_DEFAULT  */
+      push_stack_direct(sc, OP_GC_PROTECT);
+      if (lambda_star_default(sc)) return(true); /* else fall_through */
+      pop_stack_no_op(sc);              /* get original args and code back */
+    }
+  sc->code = closure_body(sc->code);
+  return(false); /* goto BEGIN */
+}
+
+static inline bool apply_safe_closure_star_1(s7_scheme *sc)  /* -------- define* (lambda*) -------- */
+{
+  /* slots are in "reverse order" -- in the same order as the args, despite let printout (which reverses the order!) */
+  set_curlet(sc, closure_let(sc->code));
+  if (has_no_defaults(sc->code))
+    {
+      for (s7_pointer z = let_slots(sc->curlet); tis_slot(z); z = next_slot(z))
+	{
+	  clear_checked_slot(z);
+	  slot_set_value(z, sc->F);
+	}
+      if (!is_null(sc->args))
+	lambda_star_set_args(sc);                     /* load up current arg vals */
+      sc->code = closure_body(sc->code);
+      return(false); /* goto BEGIN */
+    }
+  for (s7_pointer z = let_slots(sc->curlet); tis_slot(z); z = next_slot(z))
+    {
+      clear_checked_slot(z);
+      slot_set_value(z, (slot_defaults(z)) ? sc->undefined : slot_expression(z));
+    }
+  return(set_star_args(sc, slot_pending_value(let_slots(sc->curlet))));
+}
+
+static bool apply_unsafe_closure_star_1(s7_scheme *sc)
+{
+  s7_pointer z, top = sc->nil;
+  for (z = closure_args(sc->code); is_pair(z); z = cdr(z))
+    {
+      s7_pointer car_z = car(z);
+      if (is_pair(car_z))           /* arg has a default value */
+	{
+	  s7_pointer slot, val = cadr(car_z);
+	  if ((!is_pair(val)) &&
+	      (!is_symbol(val)))
+	    slot = add_slot_checked(sc, sc->curlet, car(car_z), val);
+	  else
+	    {
+	      add_slot(sc, sc->curlet, car(car_z), sc->undefined);
+	      slot = let_slots(sc->curlet);
+	      slot_set_expression(slot, val);
+	    }
+	  if (is_null(top))
+	    top = slot;
+	}
+      else
+	if (!is_keyword(car_z))
+	  add_slot(sc, sc->curlet, car_z, sc->F);
+	else
+	  if (car_z == sc->rest_keyword) /* else it's :allow-other-keys? */
+	    {
+	      set_is_rest_slot(add_slot_checked(sc, sc->curlet, cadr(z), sc->nil));
+	      z = cdr(z);
+	    }}
+  if (is_symbol(z))
+    set_is_rest_slot(add_slot_checked(sc, sc->curlet, z, sc->nil));     /* set up rest arg */
+  let_set_slots(sc->curlet, reverse_slots(let_slots(sc->curlet)));
+  return(set_star_args(sc, top));
+}
+
+static void apply_macro_star_1(s7_scheme *sc)
+{
+  /* here the defaults (if any) are not evalled, and there is not an existing let */
+  s7_pointer p;
+  for (p = closure_args(sc->code); is_pair(p); p = cdr(p))
+    {
+      s7_pointer par = car(p);
+      if (is_pair(par))
+	add_slot_checked(sc, sc->curlet, car(par), cadr(par));
+      else
+	if (!is_keyword(par))
+	  add_slot_checked(sc, sc->curlet, par, sc->F);
+	else
+	  if (par == sc->rest_keyword)
+	    {
+	      set_is_rest_slot(add_slot_checked(sc, sc->curlet, cadr(p), sc->nil));
+	      p = cdr(p);
+	    }}
+  if (is_symbol(p))
+    set_is_rest_slot(add_slot_checked(sc, sc->curlet, p, sc->nil));
+  let_set_slots(sc->curlet, reverse_slots(let_slots(sc->curlet)));
+  lambda_star_set_args(sc);
+  sc->code = T_Pair(closure_body(sc->code));
+}
+
+static void clear_absolutely_all_optimizations(s7_pointer p)
+{
+  if ((is_pair(p)) && (!is_matched_pair(p)))
+    {
+      clear_has_fx(p);
+      clear_optimized(p);
+      clear_optimize_op(p);
+      set_match_pair(p);
+      clear_absolutely_all_optimizations(cdr(p));
+      clear_absolutely_all_optimizations(car(p));
+    }
+}
+
+static void clear_matches(s7_pointer p)
+{
+  if ((is_pair(p)) && (is_matched_pair(p)))
+    {
+      clear_match_pair(p);
+      clear_matches(car(p));
+      clear_matches(cdr(p));
+    }
+}
+
+static void apply_macro(s7_scheme *sc)  /* this is not from the reader, so treat expansions here as normal macros */
+{
+  check_stack_size(sc);
+  if (closure_arity_to_int(sc, sc->code) < 0)
+    {
+      clear_absolutely_all_optimizations(sc->args); /* desperation... */
+      clear_matches(sc->args);
+    }
+  push_stack_op_let(sc, OP_EVAL_MACRO);
+  set_curlet(sc, inline_make_let(sc, closure_let(sc->code))); /* closure_let -> sc->curlet, sc->code is the macro */
+  transfer_macro_info(sc, sc->code);
+}
+
+static void apply_bacro(s7_scheme *sc)
+{
+  check_stack_size(sc);
+  push_stack_op_let(sc, OP_EVAL_MACRO);
+  set_curlet(sc, make_let(sc, sc->curlet)); /* like let* -- we'll be adding macro args, so might as well sequester things here */
+  transfer_macro_info(sc, sc->code);
+}
+
+static void apply_macro_star(s7_scheme *sc)
+{
+  check_stack_size(sc);
+  push_stack_op_let(sc, OP_EVAL_MACRO);
+  set_curlet(sc, make_let(sc, closure_let(sc->code)));
+  transfer_macro_info(sc, sc->code);
+  apply_macro_star_1(sc);
+}
+
+static void apply_bacro_star(s7_scheme *sc)
+{
+  check_stack_size(sc);
+  push_stack_op_let(sc, OP_EVAL_MACRO);
+  set_curlet(sc, make_let(sc, sc->curlet));
+  transfer_macro_info(sc, sc->code);
+  apply_macro_star_1(sc);
+}
+
+static void apply_closure(s7_scheme *sc)
+{
+  /* we can get safe_closures here, but can't easily determine whether we have the expected saved funclet */
+  check_stack_size(sc);
+  set_curlet(sc, inline_make_let(sc, closure_let(sc->code)));
+}
+
+static bool apply_closure_star(s7_scheme *sc)
+{
+  if (is_safe_closure(sc->code))
+    return(apply_safe_closure_star_1(sc));
+  check_stack_size(sc);
+  set_curlet(sc, make_let(sc, closure_let(sc->code)));
+  return(apply_unsafe_closure_star_1(sc));
+}
+
+static inline s7_pointer op_safe_closure_star_a1(s7_scheme *sc, s7_pointer code) /* called in eval and below, tlamb */
+{
+  s7_pointer func = opt1_lambda(code);
+  s7_pointer val = fx_call(sc, cdr(code));
+  if ((is_symbol_and_keyword(val)) &&
+      (!sc->accept_all_keyword_arguments))
+    error_nr(sc, sc->wrong_type_arg_symbol, set_elist_4(sc, keyword_value_missing_string, closure_name(sc, func), val, sc->args));
+  set_curlet(sc, update_let_with_slot(sc, closure_let(func), val));
+  sc->code = T_Pair(closure_body(func));
+  return(func);
+}
+
+static void op_safe_closure_star_a(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer func = op_safe_closure_star_a1(sc, code);
+  s7_pointer p = cdr(closure_args(func));
+  if (is_pair(p))
+    for (s7_pointer x = next_slot(let_slots(closure_let(func))); is_pair(p); p = cdr(p), x = next_slot(x))
+      {
+	if (is_pair(car(p)))
+	  {
+	    s7_pointer defval = cadar(p);
+	    slot_set_value(x, (is_pair(defval)) ? cadr(defval) : defval);
+	  }
+	else slot_set_value(x, sc->F);
+	symbol_set_local_slot(slot_symbol(x), let_id(sc->curlet), x);
+      }
+}
+
+static void op_safe_closure_star_ka(s7_scheme *sc, s7_pointer code) /* two args, but k=arg key, key has been checked. no trailing pars */
+{
+  s7_pointer func = opt1_lambda(code);
+  set_curlet(sc, update_let_with_slot(sc, closure_let(func), fx_call(sc, cddr(code))));
+  sc->code = T_Pair(closure_body(func));
+}
+
+static void op_safe_closure_star_aa(s7_scheme *sc, s7_pointer code)
+{
+  /* here closure_arity == 2 and we have 2 args and those args' defaults are simple (no eval or lookup needed) */
+  s7_pointer arg2, func = opt1_lambda(code);
+  s7_pointer arg1 = fx_call(sc, cdr(code));
+  sc->w = arg1; /* weak GC protection */
+  arg2 = fx_call(sc, cddr(code));
+
+  if (is_symbol_and_keyword(arg1))
+    {
+      if (keyword_symbol(arg1) == slot_symbol(let_slots(closure_let(func))))
+	{
+	  arg1 = arg2;
+	  arg2 = cadr(closure_args(func));
+	  if (is_pair(arg2)) arg2 = (is_pair(cadr(arg2))) ? cadadr(arg2) : cadr(arg2); else arg2 = sc->F;
+	}
+      else
+	if (keyword_symbol(arg1) == slot_symbol(next_slot(let_slots(closure_let(func)))))
+	  {
+	    arg1 = car(closure_args(func));
+	    if (is_pair(arg1)) arg1 = (is_pair(cadr(arg1))) ? cadadr(arg1) : cadr(arg1); else arg1 = sc->F;
+	  }
+	else
+	  if (!sc->accept_all_keyword_arguments)
+	    error_nr(sc, sc->wrong_type_arg_symbol,
+		     set_elist_4(sc, wrap_string(sc, "~A: unknown keyword argument: ~S in ~S", 38),
+				 closure_name(sc, func), arg1, code));  /* arg1 is already the value */
+    }
+  else
+    if ((is_symbol_and_keyword(arg2)) &&
+	(!sc->accept_all_keyword_arguments))
+      error_nr(sc, sc->wrong_type_arg_symbol, set_elist_4(sc, keyword_value_missing_string, closure_name(sc, func), arg2, code));
+  set_curlet(sc, update_let_with_two_slots(sc, closure_let(func), arg1, arg2));
+  sc->code = T_Pair(closure_body(func));
+}
+
+static bool call_lambda_star(s7_scheme *sc, s7_pointer code, s7_pointer arglist)
+{
+  bool target;
+  sc->code = opt1_lambda(code);
+  target = apply_safe_closure_star_1(sc);
+  if (!in_heap(arglist)) clear_list_in_use(arglist);
+  return(target);
+}
+
+static bool op_safe_closure_star_aaa(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer arg2, arg3, func = opt1_lambda(code);
+  s7_pointer arg1 = fx_call(sc, cdr(code));
+  gc_protect_via_stack(sc, arg1);
+  arg2 = fx_call(sc, cddr(code));
+  set_gc_protected2(sc, arg2);
+  arg3 = fx_call(sc, cdddr(code));
+  if ((is_symbol_and_keyword(arg1)) || (is_symbol_and_keyword(arg2)) || (is_symbol_and_keyword(arg3)))
+    {
+      s7_pointer arglist = make_safe_list(sc, 3);
+      sc->args = arglist;
+      set_car(arglist, arg1);
+      set_cadr(arglist, arg2);
+      set_caddr(arglist, arg3);
+      unstack_gc_protect(sc);
+      return(call_lambda_star(sc, code, arglist));       /* this clears list_in_use */
+    }
+  set_curlet(sc, update_let_with_three_slots(sc, closure_let(func), arg1, arg2, arg3));
+  unstack_gc_protect(sc);
+  sc->code = T_Pair(closure_body(func));
+  if_pair_set_up_begin_unchecked(sc);
+  return(true);
+}
+
+static bool op_safe_closure_star_na_0(s7_scheme *sc, s7_pointer code)
+{
+  sc->args = sc->nil;
+  sc->code = opt1_lambda(code);
+  return(apply_safe_closure_star_1(sc));
+}
+
+static bool op_safe_closure_star_na_1(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer arglist = safe_list_1(sc);
+  sc->args = arglist;
+  set_car(arglist, fx_call(sc, cdr(code)));
+  return(call_lambda_star(sc, code, arglist));  /* clears list_in_use */
+}
+
+static bool op_safe_closure_star_na_2(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer arglist = safe_list_2(sc);
+  sc->args = arglist;
+  set_car(arglist, fx_call(sc, cdr(code)));
+  set_cadr(arglist, fx_call(sc, cddr(code)));
+  return(call_lambda_star(sc, code, arglist));  /* clears list_in_use */
+}
+
+static inline bool op_safe_closure_star_na(s7_scheme *sc, s7_pointer code) /* called once in eval, clo */
+{
+  s7_pointer arglist = safe_list_if_possible(sc, opt3_arglen(cdr(code)));
+  sc->args = arglist;
+  for (s7_pointer p = arglist, old_args = cdr(code); is_pair(p); p = cdr(p), old_args = cdr(old_args))
+    set_car(p, fx_call(sc, old_args));
+  return(call_lambda_star(sc, code, arglist));   /* clears list_in_use */
+}
+
+static void op_closure_star_ka(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer func = opt1_lambda(code);
+  s7_pointer p = car(closure_args(func));
+  sc->value = fx_call(sc, cddr(code));
+  set_curlet(sc, inline_make_let_with_slot(sc, closure_let(func), (is_pair(p)) ? car(p) : p, sc->value));
+  sc->code = T_Pair(closure_body(func));
+}
+
+static void op_closure_star_a(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer p, func = opt1_lambda(code);
+  sc->value = fx_call(sc, cdr(code));
+  if ((is_symbol_and_keyword(sc->value)) &&
+      (!sc->accept_all_keyword_arguments))
+    error_nr(sc, sc->wrong_type_arg_symbol,
+	     set_elist_4(sc, keyword_value_missing_string, closure_name(sc, opt1_lambda(code)), sc->value, code));
+  p = car(closure_args(func));
+  set_curlet(sc, make_let_with_slot(sc, closure_let(func), (is_pair(p)) ? car(p) : p, sc->value));
+  if (closure_star_arity_to_int(sc, func) > 1)
+    {
+      s7_pointer last_slot = let_slots(sc->curlet);
+      s7_int id = let_id(sc->curlet);
+      for (p = cdr(closure_args(func)); is_pair(p); p = cdr(p))
+	{
+	  s7_pointer par = car(p);
+	  if (is_pair(par))
+	    last_slot = add_slot_at_end(sc, id, last_slot, car(par), (is_pair(cadr(par))) ? cadadr(par) : cadr(par)); /* possible quoted list as default value */
+	  else last_slot = add_slot_at_end(sc, id, last_slot, par, sc->F);
+	}}
+  sc->code = T_Pair(closure_body(func));
+}
+
+static inline bool op_closure_star_na(s7_scheme *sc, s7_pointer code)
+{
+  /* check_stack_size(sc); */
+  if (is_pair(cdr(code)))
+    {
+      sc->w = cdr(code);               /* args aren't evaluated yet */
+      sc->args = make_list(sc, opt3_arglen(cdr(code)), sc->unused);
+      for (s7_pointer p = sc->args, old_args = sc->w; is_pair(p); p = cdr(p), old_args = cdr(old_args))
+	set_car(p, fx_call(sc, old_args));
+      sc->w = sc->unused;
+    }
+  else sc->args = sc->nil;
+  sc->code = opt1_lambda(code);
+  set_curlet(sc, inline_make_let(sc, closure_let(sc->code)));
+  return(apply_unsafe_closure_star_1(sc));
+}
+
+static s7_pointer define1_caller(s7_scheme *sc)
+{
+  /* we can jump to op_define1, so this is not fool-proof */
+  if (sc->cur_op == OP_DEFINE_CONSTANT) return(sc->define_constant_symbol);
+  if ((sc->cur_op == OP_DEFINE_STAR) || (sc->cur_op == OP_DEFINE_STAR_UNCHECKED)) return(sc->define_star_symbol);
+  return(sc->define_symbol);
+}
+
+static bool op_define1(s7_scheme *sc)
+{
+  /* sc->code is the symbol being defined, sc->value is its value
+   *   if sc->value is a closure, car is of the form ((args...) body...)
+   * it's not possible to expand and replace macros at this point without evaluating
+   *   the body.  Just as examples, say we have a macro "mac",
+   *   (define (hi) (call/cc (lambda (mac) (mac 1))))
+   *   (define (hi) (quote (mac 1))) or macroexpand etc
+   *   (define (hi mac) (mac 1)) assuming mac here is a function passed as an arg, etc...
+   * the immutable constant check needs to wait until we have the actual new value because
+   *   we want to ignore the rebinding (not raise an error) if it is the existing value.
+   *   This happens when we reload a file that calls define-constant.  But we want a
+   *   warning if we got define (as opposed to the original define-constant).
+   */
+  s7_pointer x;
+  if (is_multiple_value(sc->value))                 /* (define x (values 1 2)) */
+    error_nr(sc, sc->syntax_error_symbol,
+	     set_elist_5(sc, wrap_string(sc, "~A: more than one value: (~A ~A ~S)", 35),
+			 define1_caller(sc), define1_caller(sc), sc->code, sc->value));
+  if (is_constant_symbol(sc, sc->code))             /* (define pi 3) or (define (pi a) a) */
+    {
+      x = (is_slot(global_slot(sc->code))) ? global_slot(sc->code) : s7_slot(sc, sc->code);
+      /* local_slot can be free even if sc->code is immutable (local constant now defunct) */
+
+      if (!((is_slot(x)) &&
+	    (type(sc->value) == unchecked_type(slot_value(x))) &&
+	    (s7_is_equivalent(sc, sc->value, slot_value(x)))))                                    /* if value is unchanged, just ignore this (re)definition */
+	syntax_error_with_caller_nr(sc, "~A: ~S is immutable", 19, define1_caller(sc), sc->code); /*   can't use s7_is_equal because value might be NaN, etc */
+
+      if ((sc->safety > NO_SAFETY) &&          /* (define-constant x 3) (define x 3)... */
+	  (sc->cur_op == OP_DEFINE))
+	s7_warn(sc, 256, "(define %s %s), but %s is a constant\n", display(sc->code), display(sc->value), display(sc->code));
+    }
+  else x = s7_slot(sc, sc->code);
+  if ((is_slot(x)) && (slot_has_setter(x)))
+    {
+      sc->value = bind_symbol_with_setter(sc, OP_DEFINE_WITH_SETTER, sc->code, sc->value);
+      if (sc->value == sc->no_value)
+	return(true); /* goto apply, if all goes well, OP_DEFINE_WITH_SETTER will jump to DEFINE2 */
+    }
+  return(false); /* fall through */
+}
+
+static void set_let_file_and_line(s7_scheme *sc, s7_pointer new_let, s7_pointer new_func)
+{
+  if (port_file(current_input_port(sc)) != stdin)
+    {
+      if ((is_pair(closure_args(new_func))) &&
+	  (has_location(closure_args(new_func))))
+	{
+	  let_set_file(new_let, pair_file_number(closure_args(new_func)));
+	  let_set_line(new_let, pair_line_number(closure_args(new_func)));
+	}
+      else
+	if (has_location(closure_body(new_func)))
+	  {
+	    let_set_file(new_let, pair_file_number(closure_body(new_func)));
+	    let_set_line(new_let, pair_line_number(closure_body(new_func)));
+	  }
+	else
+	  {
+	    s7_pointer p;
+	    for (p = cdr(closure_body(new_func)); is_pair(p); p = cdr(p))
+	      if ((is_pair(car(p))) && (has_location(car(p))))
+		break;
+	    let_set_file(new_let, (is_pair(p)) ? pair_file_number(car(p)) : port_file_number(current_input_port(sc)));
+	    let_set_line(new_let, (is_pair(p)) ? pair_line_number(car(p)) : port_line_number(current_input_port(sc)));
+	  }
+      set_has_let_file(new_let);
+    }
+  else
+    {
+      let_set_file(new_let, 0);
+      let_set_line(new_let, 0);
+      clear_has_let_file(new_let);
+    }
+}
+
+static void op_define_with_setter(s7_scheme *sc)
+{
+  s7_pointer code = sc->code;
+  if ((is_immutable(sc->curlet)) &&
+      (is_let(sc->curlet))) /* not () */
+    immutable_object_error_nr(sc, set_elist_2(sc, wrap_string(sc, "can't define ~S: curlet is immutable", 36), code));
+
+  if ((is_any_closure(sc->value)) &&
+      ((!(is_let(closure_let(sc->value)))) ||
+       (!(is_funclet(closure_let(sc->value))))))  /* otherwise it's (define f2 f1) or something similar */
+    {
+      s7_pointer new_func = sc->value, new_let;
+      if (is_safe_closure_body(closure_body(new_func)))
+	{
+	  set_safe_closure(new_func);
+	  if (is_very_safe_closure_body(closure_body(new_func)))
+	    set_very_safe_closure(new_func);
+	}
+      new_let = make_funclet(sc, new_func, code, closure_let(new_func));
+
+      /* this should happen only if the closure* default values do not refer in any way to
+       *   the enclosing environment (else we can accidentally shadow something that happens
+       *   to share an argument name that is being used as a default value -- kinda dumb!).
+       *   I think I'll check this before setting the safe_closure bit.
+       */
+      set_let_file_and_line(sc, new_let, new_func);
+      /* add the newly defined thing to the current environment */
+      if ((is_let(sc->curlet)) && (sc->curlet != sc->rootlet))
+	{
+	  if (let_id(sc->curlet) <= symbol_id(code)) /* we're adding a later-bound symbol to an old let (?) */
+	    {                                        /* was < 16-Aug-22: (let ((a 3)) (define (a) 4) (curlet)) */
+	      s7_pointer slot;
+	      sc->let_number++; /* dummy let, force symbol lookup */
+	      for (slot = let_slots(sc->curlet); tis_slot(slot); slot = next_slot(slot))
+		if (slot_symbol(slot) == code)
+		  {
+		    if (is_immutable_slot(slot))
+		      syntax_error_nr(sc, "define ~S, but it is immutable", 30, code); /* someday give the location of the immutable definition or setting */
+		    slot_set_value(slot, new_func);
+		    symbol_set_local_slot(code, sc->let_number, slot);
+		    set_local(code);
+		    sc->value = new_func; /* probably not needed? */
+		    return;
+		  }
+	      new_cell_no_check(sc, slot, T_SLOT);
+	      slot_set_symbol_and_value(slot, code, new_func);
+	      symbol_set_local_slot(code, sc->let_number, slot);
+	      slot_set_next(slot, let_slots(sc->curlet));
+	      let_set_slots(sc->curlet, slot);
+	    }
+	  else add_slot(sc, sc->curlet, code, new_func);
+	  set_local(code);
+	}
+      else
+	{
+	  if ((is_slot(global_slot(code))) &&
+	      (is_immutable_slot(global_slot(code))))
+	    {
+	      s7_pointer old_symbol = code, old_value = global_value(code);
+	      if ((type(old_value) != type(new_func)) ||
+		  (!s7_is_equivalent(sc, old_value, new_func)))    /* if value is unchanged, just ignore this (re)definition */
+		syntax_error_nr(sc, "define ~S, but it is immutable", 30, old_symbol);
+	    }
+	  else s7_make_slot(sc, sc->curlet, code, new_func);
+	}
+      sc->value = new_func; /* 25-Jul-14 so define returns the value not the name */
+    }
+  else
+    {
+      s7_pointer slot = symbol_to_local_slot(sc, code, sc->curlet);
+      if (is_slot(slot))
+	{
+	  if (is_immutable_slot(slot))
+	    {
+	      s7_pointer old_symbol = code, old_value = slot_value(slot);
+	      if ((type(old_value) != type(sc->value)) ||
+		  (!s7_is_equivalent(sc, old_value, sc->value)))    /* if value is unchanged, just ignore this (re)definition */
+		syntax_error_nr(sc, "define ~S, but it is immutable", 30, old_symbol);
+	    }
+	  else
+	    {
+	      slot_set_value_with_hook(slot, sc->value);
+	      symbol_increment_ctr(code);
+	    }}
+      else s7_make_slot(sc, sc->curlet, code, sc->value);
+      if ((is_any_macro(sc->value)) && (!is_c_macro(sc->value)))
+	{
+	  set_pair_macro(closure_body(sc->value), code);
+	  set_has_pair_macro(sc->value);
+	}}
+}
+
+
+/* -------------------------------- eval -------------------------------- */
+static void check_for_cyclic_code(s7_scheme *sc, s7_pointer code)
+{
+  if (tree_is_cyclic(sc, code))
+    {
+      /* sc->stack_resize_trigger = (s7_pointer *)(sc->stack_start + (sc->stack_size - ((STACK_RESIZE_TRIGGER) / 2))); */
+      syntax_error_nr(sc, "attempt to evaluate a circular list: ~A", 39, code);
+    }
+  resize_stack(sc); /* we've already checked that resize_stack is needed */
+}
+
+static void op_thunk(s7_scheme *sc)
+{
+  s7_pointer p = opt1_lambda(sc->code);
+  set_curlet(sc, inline_make_let(sc, closure_let(p)));
+  sc->code = T_Pair(closure_body(p));
+  if_pair_set_up_begin(sc);
+}
+
+static void op_thunk_o(s7_scheme *sc)
+{
+  s7_pointer p = opt1_lambda(sc->code);
+  set_curlet(sc, inline_make_let(sc, closure_let(p)));
+  sc->code = car(closure_body(p));
+}
+
+static void op_safe_thunk(s7_scheme *sc) /* no let needed */
+{
+  s7_pointer p = opt1_lambda(sc->code);
+  set_curlet(sc, closure_let(p));
+  sc->code = T_Pair(closure_body(p));
+  if_pair_set_up_begin_unchecked(sc);
+}
+
+static s7_pointer op_safe_thunk_a(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer f = opt1_lambda(code);
+  set_curlet(sc, closure_let(f));
+  return(fx_call(sc, closure_body(f)));
+}
+
+static void op_thunk_any(s7_scheme *sc)
+{
+  s7_pointer p = opt1_lambda(sc->code);
+  set_curlet(sc, make_let_with_slot(sc, closure_let(p), closure_args(p), sc->nil));
+  sc->code = closure_body(p);
+}
+
+static void op_safe_thunk_any(s7_scheme *sc)
+{
+  s7_pointer p = opt1_lambda(sc->code);
+  set_curlet(sc, closure_let(p));
+  slot_set_value(let_slots(sc->curlet), sc->nil);
+  sc->code = T_Pair(closure_body(p));
+  if_pair_set_up_begin_unchecked(sc);
+}
+
+static void op_closure_s(s7_scheme *sc)
+{
+  s7_pointer p = opt1_lambda(sc->code);
+  check_stack_size(sc);
+  set_curlet(sc, inline_make_let_with_slot(sc, closure_let(p), car(closure_args(p)), lookup(sc, opt2_sym(sc->code))));
+  sc->code = T_Pair(closure_body(p));
+  if_pair_set_up_begin_unchecked(sc);
+}
+
+static inline void op_closure_s_o(s7_scheme *sc)
+{
+  s7_pointer f = opt1_lambda(sc->code);
+  set_curlet(sc, inline_make_let_with_slot(sc, closure_let(f), car(closure_args(f)), lookup(sc, opt2_sym(sc->code))));
+  sc->code = car(closure_body(f));
+}
+
+static void op_safe_closure_s(s7_scheme *sc)
+{
+  s7_pointer p = opt1_lambda(sc->code);
+  set_curlet(sc, update_let_with_slot(sc, closure_let(p), lookup(sc, opt2_sym(sc->code))));
+  sc->code = T_Pair(closure_body(p));
+  if_pair_set_up_begin_unchecked(sc);
+}
+
+static void op_safe_closure_s_o(s7_scheme *sc)
+{
+  s7_pointer f = opt1_lambda(sc->code);
+  set_curlet(sc, update_let_with_slot(sc, closure_let(f), lookup(sc, opt2_sym(sc->code))));
+  sc->code = car(closure_body(f));
+}
+
+static void op_safe_closure_p(s7_scheme *sc)
+{
+  check_stack_size(sc);
+  push_stack_no_args(sc, OP_SAFE_CLOSURE_P_1, opt1_lambda(sc->code));
+  sc->code = cadr(sc->code);
+}
+
+static void op_safe_closure_p_1(s7_scheme *sc)
+{
+  set_curlet(sc, update_let_with_slot(sc, closure_let(sc->code), sc->value));
+  sc->code = T_Pair(closure_body(sc->code));
+}
+
+static void op_safe_closure_p_a(s7_scheme *sc)
+{
+  check_stack_size(sc);
+  push_stack_no_args_direct(sc, OP_SAFE_CLOSURE_P_A_1);
+  sc->code = cadr(sc->code);
+}
+
+static void op_safe_closure_p_a_1(s7_scheme *sc)
+{
+  s7_pointer f = opt1_lambda(sc->code);
+  set_curlet(sc, update_let_with_slot(sc, closure_let(f), sc->value));
+  sc->value = fx_call(sc, closure_body(f));
+}
+
+static Inline void inline_op_closure_a(s7_scheme *sc) /* called twice in eval */
+{
+  s7_pointer f = opt1_lambda(sc->code);
+  sc->value = fx_call(sc, cdr(sc->code));
+  set_curlet(sc, inline_make_let_with_slot(sc, closure_let(f), car(closure_args(f)), sc->value));
+  sc->code = T_Pair(closure_body(f));
+}
+
+static void op_safe_closure_3s(s7_scheme *sc)
+{
+  s7_pointer args = cddr(sc->code);
+  s7_pointer f = opt1_lambda(sc->code);
+  set_curlet(sc, update_let_with_three_slots(sc, closure_let(f), lookup(sc, cadr(sc->code)), lookup(sc, car(args)), lookup(sc, cadr(args))));
+  sc->code = T_Pair(closure_body(f));
+  if_pair_set_up_begin_unchecked(sc);
+}
+
+static void op_safe_closure_ssa(s7_scheme *sc) /* possibly inline b */
+{ /* ssa_a is hit once, but is only about 3/4% faster -- there's the fx overhead, etc */
+  s7_pointer args = cdr(sc->code);
+  s7_pointer f = opt1_lambda(sc->code);
+  set_curlet(sc, update_let_with_three_slots(sc, closure_let(f), lookup(sc, car(args)), lookup(sc, cadr(args)), fx_call(sc, cddr(args))));
+  sc->code = T_Pair(closure_body(f));
+  if_pair_set_up_begin_unchecked(sc);
+}
+
+static void op_safe_closure_saa(s7_scheme *sc)
+{
+  s7_pointer f = opt1_lambda(sc->code);
+  s7_pointer args = cddr(sc->code);
+  s7_pointer arg2 = lookup(sc, cadr(sc->code)); /* I don't see fx_t|u here? */
+  sc->code = fx_call(sc, args);
+  set_curlet(sc, update_let_with_three_slots(sc, closure_let(f), arg2, sc->code, fx_call(sc, cdr(args))));
+  sc->code = T_Pair(closure_body(f));
+  if_pair_set_up_begin_unchecked(sc);
+}
+
+static void op_safe_closure_agg(s7_scheme *sc) /* possibly inline tleft */
+{
+  s7_pointer args = cdr(sc->code);
+  s7_pointer f = opt1_lambda(sc->code);
+  set_curlet(sc, update_let_with_three_slots(sc, closure_let(f), fx_call(sc, args), fx_call(sc, cdr(args)), fx_call(sc, cddr(args))));
+  sc->code = T_Pair(closure_body(f));
+  if_pair_set_up_begin_unchecked(sc);
+}
+
+static void op_closure_p(s7_scheme *sc)
+{
+  check_stack_size(sc);
+  push_stack_no_args(sc, OP_CLOSURE_P_1, opt1_lambda(sc->code));
+  sc->code = cadr(sc->code);
+}
+
+static void op_closure_p_1(s7_scheme *sc)
+{
+  set_curlet(sc, inline_make_let_with_slot(sc, closure_let(sc->code), car(closure_args(sc->code)), sc->value));
+  sc->code = T_Pair(closure_body(sc->code));
+}
+
+static void op_safe_closure_a(s7_scheme *sc)
+{
+  s7_pointer f = opt1_lambda(sc->code);
+  set_curlet(sc, update_let_with_slot(sc, closure_let(f), fx_call(sc, cdr(sc->code))));
+  sc->code = T_Pair(closure_body(f));
+  push_stack_no_args(sc, sc->begin_op, T_Pair(cdr(sc->code)));
+  sc->code = car(sc->code);
+}
+
+static void op_safe_closure_a_o(s7_scheme *sc)
+{
+  s7_pointer f = opt1_lambda(sc->code);
+  set_curlet(sc, update_let_with_slot(sc, closure_let(f), fx_call(sc, cdr(sc->code))));
+  sc->code = car(closure_body(f));
+}
+
+static void op_closure_ap(s7_scheme *sc)
+{
+  s7_pointer code = sc->code;
+  sc->args = fx_call(sc, cdr(code));
+  /* (hook-push (undo-hook ind 0) (lambda (hook) (set! u0 #t))) -> #<unused>
+   *    g_undo_hook calls s7_eval_c_string so it obviously should be declared unsafe!
+   */
+  push_stack(sc, OP_CLOSURE_AP_1, opt1_lambda(sc->code), sc->args);
+  sc->code = caddr(code);
+}
+
+static void op_closure_ap_1(s7_scheme *sc)
+{
+  /* sc->value is presumably the "P" argument value, "A" is sc->args->sc->code above (sc->args here is opt1_lambda(original sc->code)) */
+  set_curlet(sc, inline_make_let_with_two_slots(sc, closure_let(sc->args), car(closure_args(sc->args)), sc->code, cadr(closure_args(sc->args)), sc->value));
+  sc->code = T_Pair(closure_body(sc->args));
+}
+
+static void op_closure_pa(s7_scheme *sc)
+{
+  s7_pointer code = sc->code;
+  sc->args = fx_call(sc, cddr(code));
+  check_stack_size(sc);
+  push_stack(sc, OP_CLOSURE_PA_1, sc->args, opt1_lambda(sc->code)); /* "p" can be self-call changing func locally! so pass opt1_lambda(sc->code), not sc->code */
+  sc->code = cadr(code);
+}
+
+static void op_closure_pa_1(s7_scheme *sc)
+{
+  set_curlet(sc, inline_make_let_with_two_slots(sc, closure_let(sc->code), car(closure_args(sc->code)), sc->value, cadr(closure_args(sc->code)), sc->args));
+  sc->code = T_Pair(closure_body(sc->code));
+}
+
+static void op_closure_pp(s7_scheme *sc)
+{
+  check_stack_size(sc);
+  push_stack(sc, OP_CLOSURE_PP_1, opt1_lambda(sc->code), sc->code);
+  sc->code = cadr(sc->code);
+}
+
+static void op_closure_pp_1(s7_scheme *sc)
+{
+  push_stack(sc, OP_CLOSURE_AP_1, sc->args, sc->value);
+  sc->code = caddr(sc->code);
+}
+
+static void op_safe_closure_ap(s7_scheme *sc)
+{
+  check_stack_size(sc);
+  sc->args = fx_call(sc, cdr(sc->code));
+  push_stack(sc, OP_SAFE_CLOSURE_AP_1, sc->args, opt1_lambda(sc->code));
+  sc->code = caddr(sc->code);
+}
+
+static void op_safe_closure_ap_1(s7_scheme *sc)
+{
+  set_curlet(sc, update_let_with_two_slots(sc, closure_let(sc->code), sc->args, sc->value));
+  sc->code = T_Pair(closure_body(sc->code));
+}
+
+static void op_safe_closure_pa(s7_scheme *sc)
+{
+  check_stack_size(sc);
+  sc->args = fx_call(sc, cddr(sc->code));
+  push_stack(sc, OP_SAFE_CLOSURE_PA_1, sc->args, opt1_lambda(sc->code));
+  sc->code = cadr(sc->code);
+}
+
+static void op_safe_closure_pa_1(s7_scheme *sc)
+{
+  set_curlet(sc, update_let_with_two_slots(sc, closure_let(sc->code), sc->value, sc->args));
+  sc->code = T_Pair(closure_body(sc->code));
+}
+
+static void op_safe_closure_pp(s7_scheme *sc)
+{
+  check_stack_size(sc);
+  push_stack(sc, OP_SAFE_CLOSURE_PP_1, opt1_lambda(sc->code), sc->code);
+  sc->code = cadr(sc->code);
+}
+
+static void op_safe_closure_pp_1(s7_scheme *sc)
+{
+  push_stack(sc, OP_SAFE_CLOSURE_AP_1, sc->value, sc->args);
+  sc->code = caddr(sc->code);
+}
+
+static void op_any_closure_3p(s7_scheme *sc)
+{
+  s7_pointer p = cdr(sc->code);
+  if (has_fx(p))
+    {
+      sc->args = fx_call(sc, p);
+      p = cdr(p);
+      if (has_fx(p))
+	{
+	  stack_end_code(sc) = sc->code; /* push_stack_direct(sc, OP_ANY_CLOSURE_3P_3) here but trying to be too clever? */
+	  stack_end_args(sc) = sc->args; /* stack[args] == arg1 to closure) */
+	  stack_end_op(sc) = (s7_pointer)(opcode_t)(OP_ANY_CLOSURE_3P_3);
+	  sc->stack_end += 4;
+	  set_stack_protected3(sc, fx_call(sc, p), OP_ANY_CLOSURE_3P_3); /* set stack_let */
+	  /* (i.e. stack[curlet] == arg2 of closure), fx_call might push_stack gc_protect etc, so push_stack via +4 before it */
+	  sc->code = cadr(p);
+	}
+      else
+	{
+	  push_stack_direct(sc, OP_ANY_CLOSURE_3P_2); /* arg1 == stack[args] */
+	  sc->code = car(p);
+	}}
+  else
+    {
+      push_stack_no_args_direct(sc, OP_ANY_CLOSURE_3P_1);
+      sc->code = car(p);
+    }
+}
+
+static bool closure_3p_end(s7_scheme *sc, s7_pointer p)
+{
+  if (has_fx(p))
+    {
+      s7_pointer func = opt1_lambda(sc->code);
+      gc_protect_2_via_stack(sc, sc->args, sc->value); /* sc->args == arg1, sc->value == arg2 */
+      set_gc_protected3(sc, fx_call(sc, p));
+      if (is_safe_closure(func))
+	set_curlet(sc, update_let_with_three_slots(sc, closure_let(func), gc_protected1(sc), gc_protected2(sc), gc_protected3(sc)));
+      else make_let_with_three_slots(sc, func, gc_protected1(sc), gc_protected2(sc), gc_protected3(sc));
+      unstack_gc_protect(sc);
+      sc->code = T_Pair(closure_body(func));
+      return(true);
+    }
+  push_stack_direct(sc, OP_ANY_CLOSURE_3P_3);
+  set_stack_protected3(sc, sc->value, OP_ANY_CLOSURE_3P_3); /* set stack_let, arg2 == curlet stack loc */
+  sc->code = car(p);
+  return(false);
+}
+
+static bool op_any_closure_3p_1(s7_scheme *sc)
+{
+  s7_pointer p = cddr(sc->code);
+  sc->args = sc->value; /* (arg1 of closure) sc->value can be clobbered by fx_call? */
+  if (has_fx(p))
+    {
+      sc->value = fx_call(sc, p);
+      return(closure_3p_end(sc, cdr(p)));
+    }
+  push_stack_direct(sc, OP_ANY_CLOSURE_3P_2);
+  sc->code = car(p);
+  return(false);
+}
+
+static bool op_any_closure_3p_2(s7_scheme *sc) {return(closure_3p_end(sc, cdddr(sc->code)));}
+
+static void op_any_closure_3p_3(s7_scheme *sc)
+{
+  /* display(obj) will not work here because sc->curlet is being used as arg2 of the closure3 */
+  s7_pointer func = opt1_lambda(sc->code);  /* incoming args (from pop_stack): sc->args, sc->curlet, and sc->value from last evaluation */
+  if (is_safe_closure(func))
+    set_curlet(sc, update_let_with_three_slots(sc, closure_let(func), sc->args, sc->curlet, sc->value));
+  else make_let_with_three_slots(sc, func, sc->args, sc->curlet, sc->value);
+  sc->code = T_Pair(closure_body(func));
+}
+
+static void op_any_closure_4p(s7_scheme *sc)
+{
+  s7_pointer p = cdr(sc->code);
+  check_stack_size(sc);
+  if (has_fx(p))
+    {
+      gc_protect_via_stack(sc, fx_call(sc, p));
+      p = cdr(p);
+      if (has_fx(p))
+	{
+	  set_gc_protected2(sc, fx_call(sc, p));
+	  p = cdr(p);
+	  if (has_fx(p))
+	    {
+	      set_gc_protected3(sc, fx_call(sc, p));
+	      push_stack_no_args_direct(sc, OP_ANY_CLOSURE_4P_4);
+	      sc->code = cadr(p);
+	    }
+	  else
+	    {
+	      push_stack_no_args_direct(sc, OP_ANY_CLOSURE_4P_3);
+	      sc->code = car(p);
+	    }}
+      else
+	{
+	  stack_end_args(sc) = sc->unused; /* copy_stack dangling pair */
+	  push_stack_no_args_direct(sc, OP_ANY_CLOSURE_4P_2);
+	  sc->code = car(p);
+	}}
+  else
+    {
+      push_stack_no_args_direct(sc, OP_ANY_CLOSURE_4P_1);
+      sc->code = car(p);
+    }
+}
+
+static bool closure_4p_end(s7_scheme *sc, s7_pointer p)
+{
+  if (has_fx(p))
+    {
+      s7_pointer func = opt1_lambda(sc->code);
+      sc->args = fx_call(sc, p);
+      if (is_safe_closure(func))
+	set_curlet(sc, update_let_with_four_slots(sc, closure_let(func), gc_protected1(sc), gc_protected2(sc), gc_protected3(sc), sc->args));
+      else make_let_with_four_slots(sc, func, gc_protected1(sc), gc_protected2(sc), gc_protected3(sc), sc->args);
+      sc->code = T_Pair(closure_body(func));
+      unstack_gc_protect(sc);
+      return(true);
+    }
+  push_stack_no_args_direct(sc, OP_ANY_CLOSURE_4P_4);
+  sc->code = car(p);
+  return(false);
+}
+
+static bool op_any_closure_4p_1(s7_scheme *sc)
+{
+  s7_pointer p = cddr(sc->code);
+  gc_protect_via_stack(sc, sc->value);
+  if (has_fx(p))
+    {
+      set_gc_protected2(sc, fx_call(sc, p));
+      p = cdr(p);
+      if (has_fx(p))
+	{
+	  set_gc_protected3(sc, fx_call(sc, p));
+	  return(closure_4p_end(sc, cdr(p)));
+	}
+      push_stack_no_args_direct(sc, OP_ANY_CLOSURE_4P_3);
+      sc->code = car(p);
+    }
+  else
+    {
+      push_stack_no_args_direct(sc, OP_ANY_CLOSURE_4P_2);
+      sc->code = car(p);
+    }
+  return(false);
+}
+
+static bool op_any_closure_4p_2(s7_scheme *sc)
+{
+  s7_pointer p = cdddr(sc->code);
+  set_gc_protected2(sc, sc->value);
+  if (has_fx(p))
+    {
+      set_gc_protected3(sc, fx_call(sc, p));
+      return(closure_4p_end(sc, cdr(p)));
+    }
+  push_stack_no_args_direct(sc, OP_ANY_CLOSURE_4P_3);
+  sc->code = car(p);
+  return(false);
+}
+
+static bool op_any_closure_4p_3(s7_scheme *sc)
+{
+  set_gc_protected3(sc, sc->value);
+  return(closure_4p_end(sc, cddddr(sc->code)));
+}
+
+static inline void op_any_closure_4p_4(s7_scheme *sc)
+{
+  s7_pointer func = opt1_lambda(sc->code);
+  if (is_safe_closure(func))
+    set_curlet(sc, update_let_with_four_slots(sc, closure_let(func), gc_protected1(sc), gc_protected2(sc), gc_protected3(sc), sc->value));
+  else make_let_with_four_slots(sc, func, gc_protected1(sc), gc_protected2(sc), gc_protected3(sc), sc->value);
+  sc->code = T_Pair(closure_body(func));
+  unstack_gc_protect(sc);
+}
+
+static void op_safe_closure_ss(s7_scheme *sc)
+{
+  s7_pointer f = opt1_lambda(sc->code);
+  set_curlet(sc, update_let_with_two_slots(sc, closure_let(f), lookup(sc, cadr(sc->code)), lookup(sc, opt2_sym(sc->code))));
+  sc->code = T_Pair(closure_body(f));
+  push_stack_no_args(sc, sc->begin_op, T_Pair(cdr(sc->code)));
+  sc->code = car(sc->code);
+}
+
+static void op_safe_closure_ss_o(s7_scheme *sc)
+{
+  s7_pointer f = opt1_lambda(sc->code);
+  set_curlet(sc, update_let_with_two_slots(sc, closure_let(f), lookup(sc, cadr(sc->code)), lookup(sc, opt2_sym(sc->code))));
+  sc->code = car(closure_body(f));
+}
+
+static inline void op_closure_ss(s7_scheme *sc)
+{
+  s7_pointer f = opt1_lambda(sc->code);
+  check_stack_size(sc);
+  set_curlet(sc, inline_make_let_with_two_slots(sc, closure_let(f),
+					        car(closure_args(f)), lookup(sc, cadr(sc->code)),
+					        cadr(closure_args(f)), lookup(sc, opt2_sym(sc->code))));
+  sc->code = T_Pair(closure_body(f));
+  push_stack_no_args(sc, sc->begin_op, T_Pair(cdr(sc->code)));
+  sc->code = car(sc->code);
+}
+
+static inline void op_closure_ss_o(s7_scheme *sc)
+{
+  s7_pointer f = opt1_lambda(sc->code);
+  set_curlet(sc, inline_make_let_with_two_slots(sc, closure_let(f),
+					        car(closure_args(f)), lookup(sc, cadr(sc->code)),
+					        cadr(closure_args(f)), lookup(sc, opt2_sym(sc->code))));
+  sc->code = car(closure_body(f));
+}
+
+static void op_safe_closure_sc(s7_scheme *sc)
+{
+  s7_pointer f = opt1_lambda(sc->code);
+  set_curlet(sc, update_let_with_two_slots(sc, closure_let(f), lookup(sc, cadr(sc->code)), opt2_con(sc->code)));
+  sc->code = T_Pair(closure_body(f));
+  push_stack_no_args(sc, sc->begin_op, T_Pair(cdr(sc->code)));
+  sc->code = car(sc->code);
+}
+
+static void op_safe_closure_sc_o(s7_scheme *sc)
+{
+  s7_pointer f = opt1_lambda(sc->code);
+  set_curlet(sc, update_let_with_two_slots(sc, closure_let(f), lookup(sc, cadr(sc->code)), opt2_con(sc->code)));
+  sc->code = car(closure_body(f));
+}
+
+static void op_closure_sc(s7_scheme *sc)
+{
+  s7_pointer f = opt1_lambda(sc->code);
+  check_stack_size(sc);
+  set_curlet(sc, make_let_with_two_slots(sc, closure_let(f), car(closure_args(f)), lookup(sc, cadr(sc->code)), cadr(closure_args(f)), opt2_con(sc->code)));
+  sc->code = T_Pair(closure_body(f));
+  push_stack_no_args(sc, sc->begin_op, T_Pair(cdr(sc->code)));
+  sc->code = car(sc->code);
+}
+
+static inline void op_closure_sc_o(s7_scheme *sc)
+{
+  s7_pointer f = opt1_lambda(sc->code);
+  check_stack_size(sc);
+  set_curlet(sc, inline_make_let_with_two_slots(sc, closure_let(f), car(closure_args(f)), lookup(sc, cadr(sc->code)), cadr(closure_args(f)), opt2_con(sc->code)));
+  sc->code = car(closure_body(f));
+}
+
+static void op_closure_3s(s7_scheme *sc)
+{
+  s7_pointer args = cdr(sc->code);
+  s7_pointer v1 = lookup(sc, car(args));
+  s7_pointer f = opt1_lambda(sc->code);
+  args = cdr(args);
+  make_let_with_three_slots(sc, f, v1, lookup(sc, car(args)), lookup(sc, cadr(args))); /* sets sc->curlet */
+  sc->code = T_Pair(closure_body(f));
+  if_pair_set_up_begin(sc);
+}
+
+static inline void op_closure_3s_o(s7_scheme *sc)
+{
+  s7_pointer args = cdr(sc->code);
+  s7_pointer v1 = lookup(sc, car(args));
+  s7_pointer f = opt1_lambda(sc->code);
+  args = cdr(args);
+  make_let_with_three_slots(sc, f, v1, lookup(sc, car(args)), lookup(sc, cadr(args))); /* sets sc->curlet */
+  sc->code = car(closure_body(f));
+}
+
+static void op_closure_4s(s7_scheme *sc)
+{
+  s7_pointer args = cdr(sc->code);
+  s7_pointer v1 = lookup(sc, car(args)), v2 = lookup(sc, cadr(args));
+  s7_pointer f = opt1_lambda(sc->code);
+  args = cddr(args);
+  make_let_with_four_slots(sc, f, v1, v2, lookup(sc, car(args)), lookup(sc, cadr(args))); /* sets sc->curlet */
+  sc->code = T_Pair(closure_body(f));
+  if_pair_set_up_begin(sc);
+}
+
+static inline void op_closure_4s_o(s7_scheme *sc)
+{
+  s7_pointer args = cdr(sc->code);
+  s7_pointer v1 = lookup(sc, car(args)), v2 = lookup(sc, cadr(args));
+  s7_pointer f = opt1_lambda(sc->code);
+  args = cddr(args);
+  make_let_with_four_slots(sc, f, v1, v2, lookup(sc, car(args)), lookup(sc, cadr(args))); /* sets sc->curlet */
+  sc->code = car(closure_body(f));
+}
+
+static void op_closure_5s(s7_scheme *sc) /* .1 in lg but this is marginal -- adds two ops etc */
+{
+  s7_pointer args = cdr(sc->code);
+  s7_pointer v1 = lookup(sc, car(args)), v2 = lookup(sc, cadr(args));
+  s7_pointer f = opt1_lambda(sc->code);
+  args = cddr(args);
+  make_let_with_five_slots(sc, f, v1, v2, lookup(sc, car(args)), lookup(sc, cadr(args)), lookup(sc, caddr(args))); /* sets sc->curlet */
+  sc->code = T_Pair(closure_body(f));
+  if_pair_set_up_begin(sc);
+}
+
+static void op_safe_closure_aa(s7_scheme *sc)
+{
+  s7_pointer p = cdr(sc->code);
+  s7_pointer f = opt1_lambda(sc->code);
+  sc->code = fx_call(sc, cdr(p)); /* fx_call can affect sc->value, but not sc->code, I think */
+  set_curlet(sc, update_let_with_two_slots(sc, closure_let(f), fx_call(sc, p), sc->code));
+  p = T_Pair(closure_body(f));
+  /* check_stack_size(sc); */ /* pretty-print if cycles=#f? */
+  push_stack_no_args(sc, sc->begin_op, T_Pair(cdr(p)));
+  sc->code = car(p);
+}
+
+static inline void op_safe_closure_aa_o(s7_scheme *sc)
+{
+  s7_pointer p = cdr(sc->code);
+  s7_pointer f = opt1_lambda(sc->code);
+  sc->code = fx_call(sc, cdr(p));
+  set_curlet(sc, update_let_with_two_slots(sc, closure_let(f), fx_call(sc, p), sc->code));
+  sc->code = car(closure_body(f));
+  /* (let values ((x 1) (y 2)) (values 1 2)): sc->code incoming is 0x7fffbf681c98 (values 1 2), car(closure_body) out is the same -> infinite loop! */
+}
+
+static void op_closure_aa(s7_scheme *sc)
+{
+  s7_pointer p = cdr(sc->code);
+  s7_pointer f = opt1_lambda(sc->code);
+  sc->code = fx_call(sc, cdr(p));
+  sc->value = fx_call(sc, p);
+  set_curlet(sc, inline_make_let_with_two_slots(sc, closure_let(f), car(closure_args(f)), sc->value, cadr(closure_args(f)), sc->code));
+  p = T_Pair(closure_body(f));
+  check_stack_size(sc);
+  push_stack_no_args(sc, sc->begin_op, T_Pair(cdr(p)));
+  sc->code = car(p);
+}
+
+static Inline void inline_op_closure_aa_o(s7_scheme *sc) /* called once in eval, b cb left lg list */
+{
+  s7_pointer p = cdr(sc->code);
+  s7_pointer f = opt1_lambda(sc->code);
+  sc->code = fx_call(sc, cdr(p));
+  sc->value = fx_call(sc, p);
+  set_curlet(sc, inline_make_let_with_two_slots(sc, closure_let(f), car(closure_args(f)), sc->value, cadr(closure_args(f)), sc->code));
+  sc->code = car(closure_body(f));
+}
+
+static /* inline */ void op_closure_fa(s7_scheme *sc) /* "inline" matters perhaps in texit.scm */
+{
+  s7_pointer new_clo, code = sc->code;
+  s7_pointer farg = opt2_pair(code);             /* cdadr(code), '((a . b) (cons a b)) for (lambda (a . b) (cons a b)) */
+  s7_pointer aarg = fx_call(sc, cddr(code));
+  s7_pointer func = opt1_lambda(code);           /* outer func */
+  s7_pointer func_args = closure_args(func);     /* outer func args (not the arglist of the applied func) */
+  sc->value = inline_make_let_with_two_slots(sc, closure_let(func), car(func_args), sc->F, cadr(func_args), aarg);
+  new_clo = make_closure_unchecked(sc, car(farg), cdr(farg), T_CLOSURE | ((!s7_is_proper_list(sc, car(farg))) ? T_COPY_ARGS : 0), CLOSURE_ARITY_NOT_SET);
+  /* this is checking the called closure arglist (see op_lambda), arity<0 probably not usable since "f" in "fa" is a parameter */
+  slot_set_value(let_slots(sc->value), new_clo); /* this order allows us to use make_closure_unchecked */
+  set_curlet(sc, sc->value);
+  sc->code = car(closure_body(func));
+}
+
+static void op_safe_closure_ns(s7_scheme *sc)
+{
+  s7_pointer args = cdr(sc->code);
+  s7_pointer f = opt1_lambda(sc->code);
+  s7_pointer let = closure_let(f);
+  uint64_t id = ++sc->let_number;
+  let_set_id(let, id);
+  for (s7_pointer x = let_slots(let); tis_slot(x); x = next_slot(x), args = cdr(args))
+    {
+      slot_set_value(x, lookup(sc, car(args)));
+      symbol_set_local_slot(slot_symbol(x), id, x);
+    }
+  set_curlet(sc, let);
+  sc->code = closure_body(f);
+  if_pair_set_up_begin_unchecked(sc);
+}
+
+static inline void op_safe_closure_3a(s7_scheme *sc)
+{
+  s7_pointer p = cdr(sc->code);
+  s7_pointer f = opt1_lambda(sc->code);
+  sc->code = fx_call(sc, cdr(p));   /* fx_call can affect sc->value, but not sc->code, I think */
+  sc->args = fx_call(sc, cddr(p));  /* is sc->args safe here? */
+  set_curlet(sc, update_let_with_three_slots(sc, closure_let(f), fx_call(sc, p), sc->code, sc->args));
+  sc->code = closure_body(f);
+  if_pair_set_up_begin_unchecked(sc);
+}
+
+static void op_safe_closure_na(s7_scheme *sc)
+{
+  s7_pointer let;
+  uint64_t id;
+
+  sc->args = safe_list_if_possible(sc, opt3_arglen(cdr(sc->code)));
+  for (s7_pointer args = cdr(sc->code), p = sc->args; is_pair(args); args = cdr(args), p = cdr(p))
+    set_car(p, fx_call(sc, args));
+  sc->code = opt1_lambda(sc->code);
+  id = ++sc->let_number;
+  let = closure_let(sc->code);
+  let_set_id(let, id);
+  for (s7_pointer x = let_slots(let), z = sc->args; tis_slot(x); x = next_slot(x), z = cdr(z))
+    {
+      slot_set_value(x, car(z));
+      symbol_set_local_slot(slot_symbol(x), id, x);
+    }
+  if (!in_heap(sc->args)) clear_list_in_use(sc->args);
+  set_curlet(sc, let);
+  sc->code = closure_body(sc->code);
+  if_pair_set_up_begin_unchecked(sc);
+}
+
+static /* inline */ void op_closure_ns(s7_scheme *sc) /* called once in eval, lg? */
+{
+  /* in this case, we have just lambda (not lambda*), and no dotted arglist,
+   *   and no accessed symbols in the arglist, and we know the arglist matches the parameter list.
+   */
+  s7_pointer args = cdr(sc->code), last_slot;
+  s7_pointer f = opt1_lambda(sc->code);
+  s7_pointer p = closure_args(f);
+  s7_pointer e = inline_make_let(sc, closure_let(f));
+  s7_int id = let_id(e);
+  sc->z = e;
+  add_slot_unchecked(sc, e, car(p), lookup(sc, car(args)), id);
+  last_slot = let_slots(e);
+  for (p = cdr(p), args = cdr(args); is_pair(p); p = cdr(p), args = cdr(args))
+    last_slot = inline_add_slot_at_end(sc, id, last_slot, car(p), lookup(sc, car(args))); /* main such call in lt (fx_s is 1/2, this is 1/5 of all calls) */
+  set_curlet(sc, e);
+  sc->z = sc->unused;
+  sc->code = T_Pair(closure_body(f));
+  if_pair_set_up_begin(sc);
+}
+
+static void op_closure_ass(s7_scheme *sc) /* possibly inline b */
+{
+  s7_pointer args = cdr(sc->code);
+  s7_pointer f = opt1_lambda(sc->code);
+  make_let_with_three_slots(sc, f, fx_call(sc, args), lookup(sc, cadr(args)), lookup(sc, caddr(args)));
+  sc->code = T_Pair(closure_body(f));
+  if_pair_set_up_begin(sc);
+}
+
+static void op_closure_aas(s7_scheme *sc) /* possibly inline b */
+{
+  s7_pointer args = cdr(sc->code);
+  s7_pointer f = opt1_lambda(sc->code);
+  sc->z = fx_call(sc, args);
+  make_let_with_three_slots(sc, f, sc->z, fx_call(sc, cdr(args)), lookup(sc, caddr(args)));
+  sc->code = T_Pair(closure_body(f));
+  if_pair_set_up_begin(sc);
+}
+
+static void op_closure_saa(s7_scheme *sc)
+{
+  s7_pointer args = cdr(sc->code);
+  s7_pointer f = opt1_lambda(sc->code);
+  sc->z = fx_call(sc, cdr(args));
+  make_let_with_three_slots(sc, f, lookup(sc, car(args)), sc->z, fx_call(sc, cddr(args)));
+  sc->code = T_Pair(closure_body(f));
+  if_pair_set_up_begin(sc);
+}
+
+static void op_closure_asa(s7_scheme *sc)
+{
+  s7_pointer args = cdr(sc->code);
+  s7_pointer f = opt1_lambda(sc->code);
+  sc->z = fx_call(sc, args);
+  make_let_with_three_slots(sc, f, sc->z, lookup(sc, cadr(args)), fx_call(sc, cddr(args)));
+  sc->code = T_Pair(closure_body(f));
+  if_pair_set_up_begin(sc);
+}
+
+static void op_closure_sas(s7_scheme *sc)
+{
+  s7_pointer args = cdr(sc->code);
+  s7_pointer f = opt1_lambda(sc->code);
+  make_let_with_three_slots(sc, f, lookup(sc, car(args)), fx_call(sc, cdr(args)), lookup(sc, caddr(args)));
+  sc->code = T_Pair(closure_body(f));
+  if_pair_set_up_begin(sc);
+}
+
+static inline void op_closure_3a(s7_scheme *sc) /* if inlined, tlist -60 */
+{
+  s7_pointer args = cdr(sc->code);
+  s7_pointer f = opt1_lambda(sc->code);
+  gc_protect_2_via_stack(sc, fx_call(sc, args), fx_call(sc, cdr(args)));
+  make_let_with_three_slots(sc, f, gc_protected1(sc), gc_protected2(sc), fx_call(sc, cddr(args)));
+  unstack_gc_protect(sc);
+  sc->code = T_Pair(closure_body(f));
+  if_pair_set_up_begin(sc);
+}
+
+static void op_closure_4a(s7_scheme *sc) /* sass */
+{
+  s7_pointer args = cdr(sc->code);
+  s7_pointer f = opt1_lambda(sc->code);
+  gc_protect_2_via_stack(sc, fx_call(sc, args), fx_call(sc, cddr(args)));
+  args = cdr(args);
+  set_gc_protected3(sc, fx_call(sc, args));
+  make_let_with_four_slots(sc, f, gc_protected1(sc), gc_protected3(sc), gc_protected2(sc), fx_call(sc, cddr(args)));
+  unstack_gc_protect(sc);
+  sc->code = T_Pair(closure_body(f));
+  if_pair_set_up_begin(sc);
+}
+
+static void op_closure_na(s7_scheme *sc)
+{
+  s7_pointer exprs = cdr(sc->code);         /* "n" = opt3_arglen(exprs), mostly 5 in lt, 6 in tlet */
+  s7_pointer func = opt1_lambda(sc->code), slot, last_slot;
+  s7_int id;
+  s7_pointer pars = closure_args(func);
+  s7_pointer e = inline_make_let(sc, closure_let(func));
+  sc->z = e;
+  sc->value = fx_call(sc, exprs);
+  new_cell_no_check(sc, last_slot, T_SLOT);
+  slot_set_symbol_and_value(last_slot, car(pars), sc->value);
+  slot_set_next(last_slot, let_slots(e));   /* i.e. slot_end */
+  let_set_slots(e, last_slot);
+  for (pars = cdr(pars), exprs = cdr(exprs); is_pair(pars); pars = cdr(pars), exprs = cdr(exprs))
+    {
+      sc->value = fx_call(sc, exprs);       /* before new_cell since it might call the GC */
+      new_cell(sc, slot, T_SLOT);           /* args < GC_TRIGGER checked in optimizer, but we're calling fx_call? */
+      slot_set_symbol_and_value(slot, car(pars), sc->value);
+      /* setting up the let might use unrelated-but-same-name symbols, so wait to set the symbol ids */
+      slot_set_next(slot, slot_end);
+      slot_set_next(last_slot, slot);
+      last_slot = slot;
+    }
+  set_curlet(sc, e);
+  sc->z = sc->unused;
+  let_set_id(e, ++sc->let_number);
+  for (id = let_id(e), slot = let_slots(e); tis_slot(slot); slot = next_slot(slot))
+    {
+      symbol_set_local_slot(slot_symbol(slot), id, slot);
+      set_local(slot_symbol(slot));
+    }
+  sc->code = T_Pair(closure_body(func));
+  if_pair_set_up_begin(sc);
+}
+
+static bool check_closure_sym(s7_scheme *sc, int32_t args)
+{
+  /* can't use closure_is_fine -- (lambda args 1) and (lambda (name . args) 1) are both arity -1 for the internal arity checkers! */
+  if ((symbol_ctr(car(sc->code)) != 1) ||
+      (unchecked_local_value(car(sc->code)) != opt1_lambda_unchecked(sc->code)))
+    {
+      s7_pointer f = lookup_unexamined(sc, car(sc->code));
+      if ((f != opt1_lambda_unchecked(sc->code)) &&
+	  ((!f) ||
+	   ((low_type_bits(f) & (TYPE_MASK | T_SAFE_CLOSURE)) != T_CLOSURE) ||
+	   (((args == 1) && (!is_symbol(closure_args(f)))) ||
+	    ((args == 2) && ((!is_pair(closure_args(f))) || (!is_symbol(cdr(closure_args(f)))))))))
+	{
+	  sc->last_function = f;
+	  return(false);
+	}
+      set_opt1_lambda(sc->code, f);
+    }
+  return(true);
+}
+
+static void op_any_closure_sym(s7_scheme *sc) /* for (lambda a ...) */
+{
+  s7_pointer func = opt1_lambda(sc->code), old_args = cdr(sc->code); /* args aren't evaluated yet */
+  s7_int num_args = opt3_arglen(old_args);
+
+  if (num_args == 1)
+    set_curlet(sc, inline_make_let_with_slot(sc, closure_let(func), closure_args(func),
+					     ((is_safe_closure(func)) && (!sc->debug_or_profile)) ?
+					     set_plist_1(sc, fx_call(sc, old_args)) : list_1(sc, sc->value = fx_call(sc, old_args))));
+  else
+    if (num_args == 2)
+      {
+	gc_protect_via_stack(sc, fx_call(sc, old_args)); /* not sc->value as GC protection! -- fx_call below can clobber it */
+	sc->args = fx_call(sc, cdr(old_args));
+	set_curlet(sc, inline_make_let_with_slot(sc, closure_let(func), closure_args(func),
+					         ((is_safe_closure(func)) && (!sc->debug_or_profile)) ?
+					         set_plist_2(sc, gc_protected1(sc), sc->args) : list_2(sc, gc_protected1(sc), sc->args)));
+	unstack_gc_protect(sc);
+      }
+    else
+      if (num_args == 0)
+	set_curlet(sc, inline_make_let_with_slot(sc, closure_let(func), closure_args(func), sc->nil));
+      else
+	{
+	  sc->args = make_list(sc, num_args, sc->unused);
+	  for (s7_pointer p = sc->args; is_pair(p); p = cdr(p), old_args = cdr(old_args))
+	    set_car(p, fx_call(sc, old_args));
+	  set_curlet(sc, make_let_with_slot(sc, closure_let(func), closure_args(func), sc->args));
+	}
+  sc->code = T_Pair(closure_body(func));
+}
+
+static void op_any_closure_a_sym(s7_scheme *sc) /* for (lambda (a . b) ...) */
+{
+  s7_pointer func = opt1_lambda(sc->code), old_args = cdr(sc->code);
+  s7_int num_args = opt3_arglen(old_args);
+  s7_pointer func_args = closure_args(func);
+
+  if (num_args == 1)
+    set_curlet(sc, make_let_with_two_slots(sc, closure_let(func), car(func_args), sc->value = fx_call(sc, old_args), cdr(func_args), sc->nil));
+  else
+    {
+      gc_protect_via_stack(sc, fx_call(sc, old_args)); /* not sc->value as GC protection! -- fx_call below can clobber it */
+      if (num_args == 2)
+	{
+	  sc->args = fx_call(sc, cdr(old_args));
+	  set_curlet(sc, inline_make_let_with_two_slots(sc, closure_let(func), car(func_args), gc_protected1(sc), cdr(func_args), list_1(sc, sc->args)));
+	}
+      else
+	{
+	  sc->args = make_list(sc, num_args - 1, sc->unused);
+	  old_args = cdr(old_args);
+	  for (s7_pointer p = sc->args; is_pair(p); p = cdr(p), old_args = cdr(old_args))
+	    set_car(p, fx_call(sc, old_args));
+	  set_curlet(sc, make_let_with_two_slots(sc, closure_let(func), car(func_args), gc_protected1(sc), cdr(func_args), sc->args));
+	}
+      unstack_gc_protect(sc);
+    }
+  sc->code = T_Pair(closure_body(func));
+}
+
+
+/* -------- */
+#if S7_DEBUGGING
+#define TC_REC_SIZE NUM_OPS
+#define TC_REC_LOW_OP OP_TC_AND_A_OR_A_LA
+
+static void init_tc_rec(s7_scheme *sc)
+{
+  sc->tc_rec_calls = (int *)Calloc(TC_REC_SIZE, sizeof(int));
+  add_saved_pointer(sc, sc->tc_rec_calls);
+}
+
+static s7_pointer g_report_missed_calls(s7_scheme *sc, s7_pointer args)
+{
+  for (int32_t i = TC_REC_LOW_OP; i < NUM_OPS; i++)
+    if (sc->tc_rec_calls[i] == 0)
+      fprintf(stderr, "%s missed\n", op_names[i]);
+  return(sc->F);
+}
+
+static void tick_tc(s7_scheme *sc, int32_t op)
+{
+  sc->tc_rec_calls[op]++;
+}
+#else
+#define tick_tc(Sc, Op)
+#endif
+
+static bool op_tc_case_la(s7_scheme *sc, s7_pointer code)
+{
+  /* opt1_any(clause) = key, has_tc(arg) = is tc call, opt2_any(clause) = result: has_tc(la arg) has_fx(val) or ((...)...) */
+  s7_pointer clauses = cddr(code), la_slot = let_slots(sc->curlet), endp, selp = cdr(code);
+  s7_int len = opt3_arglen(cdr(code));
+  if (len == 3)
+    {
+      while (true)
+	{
+	  s7_pointer selector = fx_call(sc, selp);
+	  if (selector == opt1_any(clauses))
+	    endp = opt2_any(clauses);
+	  else
+	    {
+	      s7_pointer p = cdr(clauses);
+	      endp = (selector == opt1_any(p)) ? opt2_any(p) : opt2_any(cdr(p));
+	    }
+	  if (has_tc(endp))
+	    slot_set_value(la_slot, fx_call(sc, cdr(endp)));
+	  else break;
+	}}
+  else
+    while (true)
+      {
+	s7_pointer p, selector = fx_call(sc, selp);
+	for (p = clauses; is_pair(cdr(p)); p = cdr(p))
+	  if (selector == opt1_any(p)) {endp = opt2_any(p); goto CASE_ALA_END;}
+	endp = opt2_any(p);
+      CASE_ALA_END:
+	if (has_tc(endp))
+	  slot_set_value(la_slot, fx_call(sc, cdr(endp)));
+	else break;
+      }
+  if (has_fx(endp))
+    {
+      sc->value = fx_call(sc, endp);
+      return(true); /* continue */
+    }
+  sc->code = endp;
+  return(false);    /* goto BEGIN (not like op_tc_z below) */
+}
+
+static s7_pointer fx_tc_case_la(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_CASE_LA);
+  op_tc_case_la(sc, arg);
+  return(sc->value);
+}
+
+static bool op_tc_z(s7_scheme *sc, s7_pointer expr)
+{
+  if (has_fx(expr))
+    {
+      sc->value = fx_call(sc, expr);
+      return(true);
+    }
+  sc->code = car(expr);
+  return(false);
+}
+
+static void op_tc_and_a_or_a_la(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer fx_and = cdr(code), la_slot = let_slots(sc->curlet);
+  s7_pointer fx_or = cdadr(fx_and);
+  s7_pointer fx_la = cdadr(fx_or);
+  /* cell_optimize here is slower! */
+  while (true)
+    {
+      s7_pointer p;
+      if (fx_call(sc, fx_and) == sc->F) {sc->value = sc->F; return;}
+      p = fx_call(sc, fx_or);
+      if (p != sc->F) {sc->value = p; return;}
+      slot_set_value(la_slot, fx_call(sc, fx_la));
+    }
+}
+
+static s7_pointer fx_tc_and_a_or_a_la(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_AND_A_OR_A_LA);
+  op_tc_and_a_or_a_la(sc, arg);
+  return(sc->value);
+}
+
+static void op_tc_or_a_and_a_la(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer fx_or = cdr(code), la_slot = let_slots(sc->curlet);
+  s7_pointer fx_and = cdadr(fx_or);
+  s7_pointer fx_la = cdadr(fx_and);
+  while (true)
+    {
+      s7_pointer p = fx_call(sc, fx_or);
+      if (p != sc->F) {sc->value = p; return;}
+      if (fx_call(sc, fx_and) == sc->F) {sc->value = sc->F; return;}
+      slot_set_value(la_slot, fx_call(sc, fx_la));
+    }
+}
+
+static s7_pointer fx_tc_or_a_and_a_la(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_OR_A_AND_A_LA);
+  op_tc_or_a_and_a_la(sc, arg);
+  return(sc->value);
+}
+
+static void op_tc_and_a_or_a_a_la(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer fx_and = cdr(code), la_slot = let_slots(sc->curlet);
+  s7_pointer fx_or1 = cdadr(fx_and);
+  s7_pointer fx_or2 = cdr(fx_or1);
+  s7_pointer fx_la = cdadr(fx_or2);
+  while (true)
+    {
+      s7_pointer p;
+      if (fx_call(sc, fx_and) == sc->F) {sc->value = sc->F; return;}
+      p = fx_call(sc, fx_or1);
+      if (p != sc->F) {sc->value = p; return;}
+      p = fx_call(sc, fx_or2);
+      if (p != sc->F) {sc->value = p; return;}
+      slot_set_value(la_slot, fx_call(sc, fx_la));
+    }
+}
+
+static s7_pointer fx_tc_and_a_or_a_a_la(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_AND_A_OR_A_A_LA);
+  op_tc_and_a_or_a_a_la(sc, arg);
+  return(sc->value);
+}
+
+static void op_tc_or_a_and_a_a_la(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer fx_or = cdr(code), la_slot = let_slots(sc->curlet);
+  s7_pointer fx_and1 = cdadr(fx_or);
+  s7_pointer fx_and2 = cdr(fx_and1);
+  s7_pointer fx_la = cdadr(fx_and2);
+  while (true)
+    {
+      s7_pointer p = fx_call(sc, fx_or);
+      if (p != sc->F) {sc->value = p; return;}
+      if ((fx_call(sc, fx_and1) == sc->F) ||
+	  (fx_call(sc, fx_and2) == sc->F))
+	{sc->value = sc->F; return;}
+      slot_set_value(la_slot, fx_call(sc, fx_la));
+    }
+}
+
+static s7_pointer fx_tc_or_a_and_a_a_la(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_OR_A_AND_A_A_LA);
+  op_tc_or_a_and_a_a_la(sc, arg);
+  return(sc->value);
+}
+
+static void op_tc_or_a_a_and_a_a_la(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer fx_or1 = cdr(code), la_slot = let_slots(sc->curlet);
+  s7_pointer fx_or2 = cdr(fx_or1);
+  s7_pointer fx_and1 = cdadr(fx_or2);
+  s7_pointer fx_and2 = cdr(fx_and1);
+  s7_pointer fx_la = cdadr(fx_and2);
+  while (true)
+    {
+      s7_pointer p = fx_call(sc, fx_or1);
+      if (p != sc->F) {sc->value = p; return;}
+      p = fx_call(sc, fx_or2);
+      if (p != sc->F) {sc->value = p; return;}
+      if (fx_call(sc, fx_and1) == sc->F) {sc->value = sc->F; return;}
+      if (fx_call(sc, fx_and2) == sc->F) {sc->value = sc->F; return;}
+      slot_set_value(la_slot, fx_call(sc, fx_la));
+    }
+}
+
+static s7_pointer fx_tc_or_a_a_and_a_a_la(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_OR_A_A_AND_A_A_LA);
+  op_tc_or_a_a_and_a_a_la(sc, arg);
+  return(sc->value);
+}
+
+static void op_tc_and_a_or_a_laa(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer fx_and = cdr(code), la_slot = let_slots(sc->curlet);
+  s7_pointer fx_or = cdadr(fx_and);
+  s7_pointer fx_la = cdadr(fx_or);
+  s7_pointer fx_laa = cdr(fx_la);
+  s7_pointer laa_slot = next_slot(la_slot);
+
+  if ((fx_proc(fx_and) == fx_not_is_null_u) && (fx_proc(fx_or) == fx_is_null_t) &&
+      (fx_proc(fx_la) == fx_cdr_t) && (fx_proc(fx_laa) == fx_cdr_u))
+    {
+      s7_pointer la_val = slot_value(la_slot), laa_val = slot_value(laa_slot);
+      while (true)
+	{
+	  if (is_null(laa_val)) {sc->value = sc->F; return;}
+	  if (is_null(la_val)) {sc->value = sc->T; return;}
+	  la_val = cdr(la_val);
+	  laa_val = cdr(laa_val);
+	}}
+  while (true)
+    {
+      s7_pointer p;
+      if (fx_call(sc, fx_and) == sc->F) {sc->value = sc->F; return;}
+      p = fx_call(sc, fx_or);
+      if (p != sc->F) {sc->value = p; return;}
+      sc->rec_p1 = fx_call(sc, fx_la);
+      slot_set_value(laa_slot, fx_call(sc, fx_laa));
+      slot_set_value(la_slot, sc->rec_p1);
+    }
+}
+
+static s7_pointer fx_tc_and_a_or_a_laa(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_AND_A_OR_A_LAA);
+  op_tc_and_a_or_a_laa(sc, arg);
+  sc->rec_p1 = sc->unused;
+  return(sc->value);
+}
+
+static void op_tc_or_a_and_a_laa(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer fx_or = cdr(code), la_slot = let_slots(sc->curlet);
+  s7_pointer fx_and = cdadr(fx_or);
+  s7_pointer fx_la = cdadr(fx_and);
+  s7_pointer fx_laa = cdr(fx_la);
+  s7_pointer laa_slot = next_slot(la_slot);
+  while (true)
+    {
+      s7_pointer p = fx_call(sc, fx_or);
+      if (p != sc->F) {sc->value = p; return;}
+      if (fx_call(sc, fx_and) == sc->F) {sc->value = sc->F; return;}
+      sc->rec_p1 = fx_call(sc, fx_la);
+      slot_set_value(laa_slot, fx_call(sc, fx_laa));
+      slot_set_value(la_slot, sc->rec_p1);
+    }
+}
+
+static s7_pointer fx_tc_or_a_and_a_laa(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_OR_A_AND_A_LAA);
+  op_tc_or_a_and_a_laa(sc, arg);
+  sc->rec_p1 = sc->unused;
+  return(sc->value);
+}
+
+static void op_tc_and_a_or_a_l3a(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer fx_and = cdr(code), la_slot = let_slots(sc->curlet);
+  s7_pointer fx_or = cdadr(fx_and);
+  s7_pointer fx_la = cdadr(fx_or);
+  s7_pointer fx_laa = cdr(fx_la);
+  s7_pointer fx_l3a = cdr(fx_laa);
+  s7_pointer laa_slot = next_slot(la_slot);
+  s7_pointer l3a_slot = next_slot(laa_slot);
+  while (true)
+    {
+      s7_pointer p;
+      if (fx_call(sc, fx_and) == sc->F) {sc->value = sc->F; return;}
+      p = fx_call(sc, fx_or);
+      if (p != sc->F) {sc->value = p; return;}
+      sc->rec_p1 = fx_call(sc, fx_la);
+      sc->rec_p2 = fx_call(sc, fx_laa);
+      slot_set_value(l3a_slot, fx_call(sc, fx_l3a));
+      slot_set_value(laa_slot, sc->rec_p2);
+      slot_set_value(la_slot, sc->rec_p1);
+    }
+}
+
+static s7_pointer fx_tc_and_a_or_a_l3a(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_AND_A_OR_A_L3A);
+  op_tc_and_a_or_a_l3a(sc, arg);
+  sc->rec_p1 = sc->unused;
+  sc->rec_p2 = sc->unused;
+  return(sc->value);
+}
+
+static void op_tc_or_a_and_a_l3a(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer fx_or = cdr(code), la_slot = let_slots(sc->curlet);
+  s7_pointer fx_and = cdadr(fx_or);
+  s7_pointer fx_la = cdadr(fx_and);
+  s7_pointer fx_laa = cdr(fx_la);
+  s7_pointer fx_l3a = cdr(fx_laa);
+  s7_pointer laa_slot = next_slot(la_slot);
+  s7_pointer l3a_slot = next_slot(laa_slot);
+  while (true)
+    {
+      s7_pointer p = fx_call(sc, fx_or);
+      if (p != sc->F) {sc->value = p; return;}
+      if (fx_call(sc, fx_and) == sc->F) {sc->value = sc->F; return;}
+      sc->rec_p1 = fx_call(sc, fx_la);
+      sc->rec_p2 = fx_call(sc, fx_laa);
+      slot_set_value(l3a_slot, fx_call(sc, fx_l3a));
+      slot_set_value(laa_slot, sc->rec_p2);
+      slot_set_value(la_slot, sc->rec_p1);
+    }
+}
+
+static s7_pointer fx_tc_or_a_and_a_l3a(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_OR_A_AND_A_L3A);
+  op_tc_or_a_and_a_l3a(sc, arg);
+  sc->rec_p1 = sc->unused;
+  sc->rec_p2 = sc->unused;
+  return(sc->value);
+}
+
+static void op_tc_or_a_and_a_a_l3a(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer fx_or = cdr(code), la_slot = let_slots(sc->curlet);
+  s7_pointer fx_and1 = opt3_pair(fx_or); /* (or_case) ? cdadr(fx_or) : cdaddr(fx_or); */
+  s7_pointer fx_and2 = cdr(fx_and1);
+  s7_pointer fx_la = cdadr(fx_and2);
+  s7_pointer fx_laa = cdr(fx_la);
+  s7_pointer laa_slot = next_slot(la_slot);
+  s7_pointer fx_l3a = cdr(fx_laa);
+  s7_pointer l3a_slot = next_slot(laa_slot);
+  if ((fx_proc(fx_and1) == fx_not_a) && (fx_proc(fx_and2) == fx_not_a))
+    {
+      fx_and1 = cdar(fx_and1);
+      fx_and2 = cdar(fx_and2);
+      while (true)
+	{
+	  s7_pointer p = fx_call(sc, fx_or);
+	  if (p != sc->F) {sc->value = p; return;}
+	  if ((fx_call(sc, fx_and1) != sc->F) || (fx_call(sc, fx_and2) != sc->F)) {sc->value = sc->F; return;}
+	  sc->rec_p1 = fx_call(sc, fx_la);
+	  sc->rec_p2 = fx_call(sc, fx_laa);
+	  slot_set_value(l3a_slot, fx_call(sc, fx_l3a));
+	  slot_set_value(la_slot, sc->rec_p1);
+	  slot_set_value(laa_slot, sc->rec_p2);
+	}}
+  while (true)
+    {
+      s7_pointer p = fx_call(sc, fx_or);
+      if (p != sc->F) {sc->value = p; return;}
+      if ((fx_call(sc, fx_and1) == sc->F) || (fx_call(sc, fx_and2) == sc->F)) {sc->value = sc->F; return;}
+      sc->rec_p1 = fx_call(sc, fx_la);
+      sc->rec_p2 = fx_call(sc, fx_laa);
+      slot_set_value(l3a_slot, fx_call(sc, fx_l3a));
+      slot_set_value(la_slot, sc->rec_p1);
+      slot_set_value(laa_slot, sc->rec_p2);
+    }
+}
+
+static s7_pointer fx_tc_or_a_and_a_a_l3a(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_OR_A_AND_A_A_L3A);
+  op_tc_or_a_and_a_a_l3a(sc, arg);
+  sc->rec_p1 = sc->unused;
+  sc->rec_p2 = sc->unused;
+  return(sc->value);
+}
+
+static bool op_tc_if_a_z_la(s7_scheme *sc, s7_pointer code, bool cond)
+{
+  s7_pointer la_slot = let_slots(sc->curlet);
+  s7_pointer if_test = (cond) ? cadr(code) : cdr(code);
+  s7_pointer if_true = (cond) ? opt1_pair(cdr(code)) : opt1_pair(if_test);
+  s7_pointer la = (cond) ? opt3_pair(cdr(code)) : opt3_pair(if_test);
+  if (is_t_integer(slot_value(la_slot)))
+    {
+      sc->pc = 0;
+      if (bool_optimize(sc, if_test))
+	{
+	  opt_info *o = sc->opts[0], *o1 = sc->opts[sc->pc];
+	  if (int_optimize(sc, la))
+	    {
+	      s7_pointer val = make_mutable_integer(sc, integer(slot_value(la_slot)));
+	      slot_set_value(la_slot, val);
+	      while (!(o->v[0].fb(o))){set_integer(val, o1->v[0].fi(o1));}
+	      return(op_tc_z(sc, if_true));
+	    }}}
+  while (fx_call(sc, if_test) == sc->F) {slot_set_value(la_slot, fx_call(sc, la));}
+  return(op_tc_z(sc, if_true));
+}
+
+static s7_pointer fx_tc_if_a_z_la(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_IF_A_Z_LA);
+  op_tc_if_a_z_la(sc, arg, false);
+  return(sc->value);
+}
+
+static s7_pointer fx_tc_cond_a_z_la(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_COND_A_Z_LA);
+  op_tc_if_a_z_la(sc, arg, true);
+  return(sc->value);
+}
+
+static bool op_tc_if_a_la_z(s7_scheme *sc, s7_pointer code, bool cond)
+{
+  s7_pointer la_slot = let_slots(sc->curlet);
+  s7_pointer if_test = (cond) ? cadr(code) : cdr(code);
+  s7_pointer if_false = (cond) ? opt1_pair(cdr(code)) : opt1_pair(if_test);
+  s7_pointer la = (cond) ? opt3_pair(cdr(code)) : opt3_pair(if_test);
+  if (is_t_integer(slot_value(la_slot)))
+    {
+      sc->pc = 0;
+      if (bool_optimize(sc, if_test))
+	{
+	  opt_info *o = sc->opts[0], *o1 = sc->opts[sc->pc];
+	  if (int_optimize(sc, la))
+	    {
+	      s7_pointer val = make_mutable_integer(sc, integer(slot_value(la_slot)));
+	      slot_set_value(la_slot, val);
+	      while (o->v[0].fb(o)) {set_integer(val, o1->v[0].fi(o1));}
+	      return(op_tc_z(sc, if_false));
+	    }}}
+  while (fx_call(sc, if_test) != sc->F) {slot_set_value(la_slot, fx_call(sc, la));}
+  return(op_tc_z(sc, if_false));
+}
+
+static s7_pointer fx_tc_if_a_la_z(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_IF_A_LA_Z);
+  op_tc_if_a_la_z(sc, arg, false);
+  return(sc->value);
+}
+
+static s7_pointer fx_tc_cond_a_la_z(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_COND_A_LA_Z);
+  op_tc_if_a_la_z(sc, arg, true);
+  return(sc->value);
+}
+
+typedef enum {TC_IF, TC_COND, TC_AND} tc_choice_t;
+
+static bool op_tc_if_a_z_laa(s7_scheme *sc, s7_pointer code, bool z_first, tc_choice_t cond)
+{
+  s7_pointer if_test, if_z, la, laa, laa_slot, la_slot = let_slots(sc->curlet);
+  s7_function tf;
+  if (cond == TC_IF)
+    {
+      if_test = cdr(code);
+      if_z = opt1_pair(if_test); /* if_z = (z_first) ? cdr(if_test) : cddr(if_test) */
+      la = opt3_pair(if_test);   /* la = (z_first) ? cdaddr(if_test) : cdadr(if_test) */
+    }
+  else
+    {
+      if_test = cadr(code);
+      if_z = opt1_pair(cdr(code)); /* if_z = (z_first) ? cdr(if_test) : cdr(caddr(code)) */
+      la = opt3_pair(cdr(code));   /* la = (z_first) ? cdr(cadaddr(code)) : cdadr(if_test) */
+    }
+  laa = cdr(la);
+  laa_slot = next_slot(la_slot);
+#if (!WITH_GMP)
+  if (!no_bool_opt(code))
+    {
+      sc->pc = 0;
+      if (bool_optimize(sc, if_test))
+	{
+	  opt_info *o = sc->opts[0], *o1 = sc->opts[sc->pc], *o2;
+	  int32_t start_pc = sc->pc;
+	  if ((is_t_integer(slot_value(la_slot))) &&
+	      (is_t_integer(slot_value(laa_slot))))
+	    {
+	      if (int_optimize(sc, la))
+		{
+		  o2 = sc->opts[sc->pc];
+		  if (int_optimize(sc, laa))
+		    {
+		      s7_int (*fi1)(opt_info *o) = o1->v[0].fi;
+		      s7_int (*fi2)(opt_info *o) = o2->v[0].fi;
+		      bool (*fb)(opt_info *o) = o->v[0].fb;
+		      s7_pointer val1 = make_mutable_integer(sc, integer(slot_value(la_slot)));
+		      s7_pointer val2;
+		      slot_set_value(la_slot, val1);
+		      slot_set_value(laa_slot, val2 = make_mutable_integer(sc, integer(slot_value(laa_slot))));
+		      if ((z_first) &&
+			  ((fb == opt_b_ii_sc_lt) || (fb == opt_b_ii_sc_lt_0)) &&
+			  (fi1 == opt_i_ii_sc_sub))
+			{
+			  s7_int lim = o->v[2].i, m = o1->v[2].i;
+			  s7_pointer slot1 = o->v[1].p, slot2 = o1->v[1].p;
+			  while (integer(slot_value(slot1)) >= lim)
+			    {
+			      s7_int i1 = integer(slot_value(slot2)) - m;
+			      set_integer(val2, fi2(o2));
+			      set_integer(val1, i1);
+			    }}
+		      else
+			while (fb(o) != z_first)
+			  {
+			    s7_int i1 = fi1(o1);
+			    set_integer(val2, fi2(o2));
+			    set_integer(val1, i1);
+			  }
+		      return(op_tc_z(sc, if_z));
+		    }}}
+
+	  if ((is_t_real(slot_value(la_slot))) &&
+	      (is_t_real(slot_value(laa_slot))))
+	    {
+	      sc->pc = start_pc;
+	      if (float_optimize(sc, la))
+		{
+		  o2 = sc->opts[sc->pc];
+		  if (float_optimize(sc, laa))
+		    {
+		      s7_double (*fd1)(opt_info *o) = o1->v[0].fd;
+		      s7_double (*fd2)(opt_info *o) = o2->v[0].fd;
+		      bool (*fb)(opt_info *o) = o->v[0].fb;
+		      s7_pointer val1 = make_mutable_real(sc, real(slot_value(la_slot)));
+		      s7_pointer val2 = make_mutable_real(sc, real(slot_value(laa_slot)));
+		      slot_set_value(la_slot, val1);
+		      slot_set_value(laa_slot, val2);
+		      if ((z_first) &&
+			  (fb == opt_b_dd_sc_lt) &&
+			  (fd1 == opt_d_dd_sc_sub))
+			{
+			  s7_double lim = o->v[2].x;
+			  s7_double m = o1->v[2].x;
+			  s7_pointer slot1 = o->v[1].p;
+			  s7_pointer slot2 = o1->v[1].p;
+			  while (real(slot_value(slot1)) >= lim)
+			    {
+			      s7_double x1 = real(slot_value(slot2)) - m;
+			      set_real(val2, fd2(o2));
+			      set_real(val1, x1);
+			    }}
+		      else
+			while (fb(o) != z_first)
+			  {
+			    s7_double x1 = fd1(o1);
+			    set_real(val2, fd2(o2));
+			    set_real(val1, x1);
+			  }
+		      return(op_tc_z(sc, if_z));
+		    }}}}
+      set_no_bool_opt(code);
+    }
+#endif
+  tf = fx_proc(if_test);
+  if_test = car(if_test);
+  if (z_first)
+    {
+      if ((fx_proc(la) == fx_cdr_t) && (fx_proc(laa) == fx_subtract_u1) &&
+	  (fn_proc(if_test) == g_num_eq_xi) &&  /* was also (fx_proc(if_test) == fx_num_eq_ui) but we cloberred if_test above */
+	  (is_pair(slot_value(la_slot))) && (is_t_integer(slot_value(laa_slot))))
+	{ /* list-tail ferchrissake */
+	  s7_int end = integer(caddr(if_test));
+	  s7_pointer lst = slot_value(la_slot);
+	  for (s7_int start = integer(slot_value(laa_slot)); start > end; start--)
+	    lst = cdr(lst);
+	  slot_set_value(la_slot, lst);
+	}
+      else
+	while (tf(sc, if_test) == sc->F)
+	  {
+	    sc->rec_p1 = fx_call(sc, la);
+	    slot_set_value(laa_slot, fx_call(sc, laa));
+	    slot_set_value(la_slot, sc->rec_p1);
+	  }}
+  else
+    while (tf(sc, if_test) != sc->F)
+      {
+	sc->rec_p1 = fx_call(sc, la);
+	slot_set_value(laa_slot, fx_call(sc, laa));
+	slot_set_value(la_slot, sc->rec_p1);
+      }
+  return(op_tc_z(sc, if_z));
+}
+
+static s7_pointer fx_tc_if_a_z_laa(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_IF_A_Z_LAA);
+  op_tc_if_a_z_laa(sc, arg, true, TC_IF);
+  sc->rec_p1 = sc->unused;
+  return(sc->value);
+}
+
+static s7_pointer fx_tc_cond_a_z_laa(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_COND_A_Z_LAA);
+  op_tc_if_a_z_laa(sc, arg, true, TC_COND);
+  sc->rec_p1 = sc->unused;
+  return(sc->value);
+}
+
+static s7_pointer fx_tc_if_a_laa_z(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_IF_A_LAA_Z);
+  op_tc_if_a_z_laa(sc, arg, false, TC_IF);
+  sc->rec_p1 = sc->unused;
+  return(sc->value);
+}
+
+static s7_pointer fx_tc_cond_a_laa_z(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_COND_A_LAA_Z);
+  op_tc_if_a_z_laa(sc, arg, false, TC_COND);
+  sc->rec_p1 = sc->unused;
+  return(sc->value);
+}
+
+static void op_tc_when_la(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer if_test = cadr(code), body = cddr(code), la_call, la, la_slot = let_slots(sc->curlet);
+  s7_function tf = fx_proc(cdr(code));
+  /* for (la_call = body; is_pair(cdr(la_call)); la_call = cdr(la_call)); */
+  la_call = opt3_pair(code);
+  la = cdar(la_call);
+  while (tf(sc, if_test) != sc->F)
+    {
+      for (s7_pointer p = body; p != la_call; p = cdr(p)) fx_call(sc, p);
+      slot_set_value(la_slot, fx_call(sc, la));
+    }
+  sc->value = sc->unspecified;
+}
+
+static s7_pointer fx_tc_when_la(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_WHEN_LA);
+  op_tc_when_la(sc, arg);
+  return(sc->value);
+}
+
+static void op_tc_when_laa(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer if_test = cadr(code), body = cddr(code), la, laa, laa_slot, la_call, la_slot = let_slots(sc->curlet);
+  s7_function tf = fx_proc(cdr(code));
+  /* for (la_call = body; is_pair(cdr(la_call)); la_call = cdr(la_call)); */
+  la_call = opt3_pair(code);
+  la = cdar(la_call);
+  laa = cdr(la);
+  laa_slot = next_slot(la_slot);
+  while (tf(sc, if_test) != sc->F)
+    {
+      for (s7_pointer p = body; p != la_call; p = cdr(p)) fx_call(sc, p);
+      sc->rec_p1 = fx_call(sc, la);
+      slot_set_value(laa_slot, fx_call(sc, laa));
+      slot_set_value(la_slot, sc->rec_p1);
+    }
+  sc->rec_p1 = sc->unused;
+  sc->value = sc->unspecified;
+}
+
+static s7_pointer fx_tc_when_laa(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_WHEN_LAA);
+  op_tc_when_laa(sc, arg);
+  return(sc->value);
+}
+
+static void op_tc_when_l3a(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer if_test = cadr(code), body = cddr(code), la, laa, l3a, laa_slot, l3a_slot, la_call, la_slot = let_slots(sc->curlet);
+  s7_function tf = fx_proc(cdr(code));
+  /* for (la_call = body; is_pair(cdr(la_call)); la_call = cdr(la_call)); */
+  la_call = opt3_pair(code);
+  la = cdar(la_call);
+  laa = cdr(la);
+  l3a = cdr(laa);
+  laa_slot = next_slot(la_slot);
+  l3a_slot = next_slot(laa_slot);
+  while (tf(sc, if_test) != sc->F)
+    {
+      for (s7_pointer p = body; p != la_call; p = cdr(p)) fx_call(sc, p);
+      sc->rec_p1 = fx_call(sc, la);
+      sc->rec_p2 = fx_call(sc, laa);
+      slot_set_value(l3a_slot, fx_call(sc, l3a));
+      slot_set_value(laa_slot, sc->rec_p2);
+      slot_set_value(la_slot, sc->rec_p1);
+    }
+  sc->rec_p1 = sc->unused;
+  sc->value = sc->unspecified;
+}
+
+static s7_pointer fx_tc_when_l3a(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_WHEN_L3A);
+  op_tc_when_l3a(sc, arg);
+  return(sc->value);
+}
+
+static bool op_tc_if_a_z_l3a(s7_scheme *sc, s7_pointer code, bool z_first)
+{
+  s7_pointer if_test = cdr(code), la_slot = let_slots(sc->curlet);
+  s7_pointer f_z = opt1_pair(if_test);  /* if_z = (z_first) ? cdr(if_test) : cddr(if_test) */
+  s7_pointer la = opt3_pair(if_test);   /* la = (z_first) ? cdaddr(if_test) : cdadr(if_test) */
+  s7_pointer laa = cdr(la);
+  s7_pointer l3a = cdr(laa);
+  s7_pointer laa_slot = next_slot(la_slot);
+  s7_pointer l3a_slot = next_slot(laa_slot);
+  s7_function tf = fx_proc(if_test);
+  if_test = car(if_test);
+  while ((tf(sc, if_test) == sc->F) == z_first)
+    {
+      sc->rec_p1 = fx_call(sc, la);
+      sc->rec_p2 = fx_call(sc, laa);
+      slot_set_value(l3a_slot, fx_call(sc, l3a));
+      slot_set_value(laa_slot, sc->rec_p2);
+      slot_set_value(la_slot, sc->rec_p1);
+    }
+  return(op_tc_z(sc, f_z));
+}
+
+static s7_pointer fx_tc_if_a_z_l3a(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_IF_A_Z_L3A);
+  op_tc_if_a_z_l3a(sc, arg, true);
+  sc->rec_p1 = sc->unused;
+  sc->rec_p2 = sc->unused;
+  return(sc->value);
+}
+
+static s7_pointer fx_tc_if_a_l3a_z(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_IF_A_L3A_Z);
+  op_tc_if_a_z_l3a(sc, arg, false);
+  sc->rec_p1 = sc->unused;
+  sc->rec_p2 = sc->unused;
+  return(sc->value);
+}
+
+static bool op_tc_if_a_z_if_a_z_la(s7_scheme *sc, s7_pointer code, bool z_first, tc_choice_t cond)
+{
+  s7_pointer if_test, if_true, if_false, f_test, f_z, la, endp, la_slot = let_slots(sc->curlet);
+  bool tc_and = (cond == TC_AND);
+  if (cond != TC_COND)
+    {
+      if_test = cdr(code);
+      if_true = (!tc_and) ? cdr(if_test) : sc->F;
+      if_false = (!tc_and) ? cadr(if_true) : cadr(if_test);
+      f_test = cdr(if_false);
+      f_z = (z_first) ? cdr(f_test) : cddr(f_test);
+      la = (z_first) ? cdaddr(f_test) : cdadr(f_test);
+    }
+  else
+    {
+      if_test = cadr(code);    /* code: (cond (a1 z1) (a2 z2|la) (else la|z2)) */
+      if_true = cdr(if_test);
+      if_false = caddr(code);  /* (a2 z2|la) */
+      f_test = if_false;
+      f_z = (z_first) ? cdr(f_test) : cdr(cadddr(code));
+      la = (z_first) ? cdadr(cadddr(code)) : cdadr(caddr(code));
+    }
+#if (!WITH_GMP)
+  if (is_t_integer(slot_value(la_slot)))
+    {
+      opt_info *o = sc->opts[0];
+      sc->pc = 0;
+      if (bool_optimize_nw(sc, if_test))
+ 	{
+	  opt_info *o1 = sc->opts[sc->pc];
+ 	  if (bool_optimize_nw(sc, f_test))
+ 	    {
+	      opt_info *o2 = sc->opts[sc->pc];
+ 	      if (int_optimize(sc, la))
+ 		{
+ 		  s7_pointer val = make_mutable_integer(sc, integer(slot_value(la_slot)));
+ 		  slot_set_value(la_slot, val);
+ 		  if (tc_and)
+		    while (true)
+		      {
+			if (!o->v[0].fb(o)) {sc->value = sc->F; return(true);}
+			if (o1->v[0].fb(o1) == z_first) {endp = f_z; break;}
+			set_integer(val, o2->v[0].fi(o2));
+		      }
+ 		  else
+		    while (true)
+		      {
+			if (o->v[0].fb(o)) {endp = if_true; break;}
+			if (o1->v[0].fb(o1) == z_first) {endp = f_z; break;}
+			set_integer(val, o2->v[0].fi(o2));
+		      }
+ 		  return(op_tc_z(sc, endp));
+ 		}}}}
+#endif
+  while (true)
+    {
+      if ((fx_call(sc, if_test) == sc->F) == tc_and) {if (tc_and) {sc->value = sc->F; return(true);} else {endp = if_true; break;}}
+      if ((fx_call(sc, f_test) == sc->F) != z_first) {endp = f_z; break;}
+      slot_set_value(la_slot, fx_call(sc, la));
+    }
+  return(op_tc_z(sc, endp));
+}
+
+static s7_pointer fx_tc_if_a_z_if_a_z_la(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_IF_A_Z_IF_A_Z_LA);
+  op_tc_if_a_z_if_a_z_la(sc, arg, true, TC_IF);
+  return(sc->value);
+}
+
+static s7_pointer fx_tc_if_a_z_if_a_la_z(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_IF_A_Z_IF_A_LA_Z);
+  op_tc_if_a_z_if_a_z_la(sc, arg, false, TC_IF);
+  return(sc->value);
+}
+
+static s7_pointer fx_tc_cond_a_z_a_z_la(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_COND_A_Z_A_Z_LA);
+  op_tc_if_a_z_if_a_z_la(sc, arg, true, TC_COND);
+  return(sc->value);
+}
+
+static s7_pointer fx_tc_cond_a_z_a_la_z(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_COND_A_Z_A_LA_Z);
+  op_tc_if_a_z_if_a_z_la(sc, arg, false, TC_COND);
+  return(sc->value);
+}
+
+static s7_pointer fx_tc_and_a_if_a_z_la(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_AND_A_IF_A_Z_LA);
+  op_tc_if_a_z_if_a_z_la(sc, arg, true, TC_AND);
+  return(sc->value);
+}
+
+static s7_pointer fx_tc_and_a_if_a_la_z(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_AND_A_IF_A_LA_Z);
+  op_tc_if_a_z_if_a_z_la(sc, arg, false, TC_AND);
+  return(sc->value);
+}
+
+static bool op_tc_if_a_z_if_a_z_laa(s7_scheme *sc, bool cond, s7_pointer code)
+{
+  s7_pointer if_false, f_test, f_true, la, laa, laa_slot, endp, slot1, la_slot = let_slots(sc->curlet);
+  s7_pointer if_test = (cond) ? cadr(code) : cdr(code);
+  s7_pointer if_true = cdr(if_test);
+  if (!cond) if_false = cadr(if_true);
+  f_test = (cond) ? caddr(code) : cdr(if_false);
+  f_true = cdr(f_test);
+  la = (cond) ? opt3_pair(code) : cdadr(f_true);  /* cdadr(cadddr(code)) */
+  laa = cdr(la);
+  laa_slot = next_slot(la_slot);
+  slot1 = (fx_proc(if_test) == fx_is_null_t) ? la_slot : ((fx_proc(if_test) == fx_is_null_u) ? laa_slot : NULL);
+  if (slot1)
+    {
+      if ((slot1 == laa_slot) && (fx_proc(f_test) == fx_is_null_t) && (fx_proc(la) == fx_cdr_t) && (fx_proc(laa) == fx_cdr_u) &&
+	  (is_boolean(car(if_true))) && (is_boolean(car(f_true))))
+	{
+	  s7_pointer la_val = slot_value(la_slot), laa_val = slot_value(laa_slot);
+	  while (true)
+	    {
+	      if (is_null(laa_val)) {sc->value = car(if_true); return(true);}
+	      if (is_null(la_val)) {sc->value = car(f_true); return(true);}
+	      la_val = cdr(la_val);
+	      laa_val = cdr(laa_val);
+	    }}
+      while (true)
+	{
+	  if (is_null(slot_value(slot1))) {endp = if_true; break;}
+	  if (fx_call(sc, f_test) != sc->F) {endp = f_true; break;}
+	  sc->rec_p1 = fx_call(sc, la);
+	  slot_set_value(laa_slot, fx_call(sc, laa));
+	  slot_set_value(la_slot, sc->rec_p1);
+	}}
+  else
+    while (true)
+      {
+	if (fx_call(sc, if_test) != sc->F) {endp = if_true; break;}
+	if (fx_call(sc, f_test) != sc->F) {endp = f_true; break;}
+	sc->rec_p1 = fx_call(sc, la);
+	slot_set_value(laa_slot, fx_call(sc, laa));
+	slot_set_value(la_slot, sc->rec_p1);
+      }
+  return(op_tc_z(sc, endp));
+}
+
+static s7_pointer fx_tc_if_a_z_if_a_z_laa(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_IF_A_Z_IF_A_Z_LAA);
+  op_tc_if_a_z_if_a_z_laa(sc, false, arg);
+  sc->rec_p1 = sc->unused;
+  return(sc->value);
+}
+
+static s7_pointer fx_tc_cond_a_z_a_z_laa(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_COND_A_Z_A_Z_LAA);
+  op_tc_if_a_z_if_a_z_laa(sc, true, arg);
+  sc->rec_p1 = sc->unused;
+  return(sc->value);
+}
+
+static bool op_tc_if_a_z_if_a_laa_z(s7_scheme *sc, bool cond, s7_pointer code)
+{
+  s7_pointer if_false, f_test, f_true, f_false, la, laa, laa_slot, endp, la_slot = let_slots(sc->curlet);
+  s7_pointer if_test = (cond) ? cadr(code) : cdr(code);
+  s7_pointer if_true = cdr(if_test);
+  if (!cond) if_false = cadr(if_true);
+  f_test = (cond) ? caddr(code) : cdr(if_false);
+  f_true = cdr(f_test);
+  f_false = (cond) ? cdr(cadddr(code)) : cdr(f_true);
+  la = (cond) ? opt3_pair(code) : cdar(f_true); /* cdadr(caddr(code)) */
+  laa = cdr(la);
+  laa_slot = next_slot(la_slot);
+  while (true)
+    {
+      if (fx_call(sc, if_test) != sc->F) {endp = if_true; break;}
+      if (fx_call(sc, f_test) == sc->F) {endp = f_false; break;}
+      sc->rec_p1 = fx_call(sc, la);
+      slot_set_value(laa_slot, fx_call(sc, laa));
+      slot_set_value(la_slot, sc->rec_p1);
+    }
+  return(op_tc_z(sc, endp));
+}
+
+static s7_pointer fx_tc_if_a_z_if_a_laa_z(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_IF_A_Z_IF_A_LAA_Z);
+  op_tc_if_a_z_if_a_laa_z(sc, false, arg);
+  sc->rec_p1 = sc->unused;
+  return(sc->value);
+}
+
+static s7_pointer fx_tc_cond_a_z_a_laa_z(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_COND_A_Z_A_LAA_Z);
+  op_tc_if_a_z_if_a_laa_z(sc, true, arg);
+  sc->rec_p1 = sc->unused;
+  return(sc->value);
+}
+
+static bool op_tc_if_a_z_if_a_l3a_l3a(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer if_test = cdr(code);
+  s7_pointer endp, la_slot = let_slots(sc->curlet);
+  s7_pointer if_true = cdr(if_test);
+  s7_pointer if_false = cadr(if_true);
+  s7_pointer f_test = cdr(if_false);
+  s7_pointer f_true = cdr(f_test);
+  s7_pointer f_false = cdr(f_true);
+  s7_pointer la1 = cdar(f_true);
+  s7_pointer la2 = cdar(f_false);
+  s7_pointer laa1 = cdr(la1);
+  s7_pointer laa2 = cdr(la2);
+  s7_pointer laa_slot = next_slot(la_slot);
+  s7_pointer l3a1 = cdr(laa1);
+  s7_pointer l3a2 = cdr(laa2);
+  s7_pointer l3a_slot = next_slot(laa_slot);
+  while (true)
+    {
+      if (fx_call(sc, if_test) != sc->F) {endp = if_true; break;}
+      if (fx_call(sc, f_test) != sc->F)
+	{
+	  sc->rec_p1 = fx_call(sc, la1);
+	  sc->rec_p2 = fx_call(sc, laa1);
+	  slot_set_value(l3a_slot, fx_call(sc, l3a1));
+	}
+      else
+	{
+	  sc->rec_p1 = fx_call(sc, la2);
+	  sc->rec_p2 = fx_call(sc, laa2);
+	  slot_set_value(l3a_slot, fx_call(sc, l3a2));
+	}
+      slot_set_value(laa_slot, sc->rec_p2);
+      slot_set_value(la_slot, sc->rec_p1);
+    }
+  return(op_tc_z(sc, endp));
+}
+
+static s7_pointer fx_tc_if_a_z_if_a_l3a_l3a(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_IF_A_Z_IF_A_L3A_L3A);
+  op_tc_if_a_z_if_a_l3a_l3a(sc, arg);
+  sc->rec_p1 = sc->unused;
+  sc->rec_p2 = sc->unused;
+  return(sc->value);
+}
+
+static bool op_tc_let_if_a_z_la(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer body = caddr(code);
+  s7_pointer outer_let = sc->curlet;
+  s7_pointer la_slot = let_slots(outer_let);
+  s7_pointer if_test = cdr(body);
+  s7_pointer if_true = cddr(body);
+  s7_pointer if_false = cadddr(body);
+  s7_pointer la = cdr(if_false);
+  s7_pointer let_var = caadr(code);
+  s7_pointer inner_let = make_let_with_slot(sc, sc->curlet, car(let_var), fx_call(sc, cdr(let_var)));
+  s7_pointer let_slot = let_slots(inner_let);
+  set_curlet(sc, inner_let);
+  gc_protect_via_stack(sc, inner_let);
+  let_var = cdr(let_var);
+
+  while (fx_call(sc, if_test) == sc->F)
+    {
+      slot_set_value(la_slot, fx_call(sc, la));
+      set_curlet(sc, outer_let);
+      slot_set_value(let_slot, fx_call(sc, let_var));
+      set_curlet(sc, inner_let);
+    }
+  unstack_gc_protect(sc);
+  if (!op_tc_z(sc, if_true))
+    return(false);
+  free_cell(sc, let_slots(inner_let));
+  free_cell(sc, inner_let);
+  return(true);
+}
+
+static s7_pointer fx_tc_let_if_a_z_la(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_LET_IF_A_Z_LA);
+  op_tc_let_if_a_z_la(sc, arg);
+  return(sc->value);
+}
+
+static bool op_tc_let_if_a_z_laa(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer body = caddr(code);
+  s7_pointer outer_let = sc->curlet;
+  s7_pointer la_slot = let_slots(outer_let);
+  s7_pointer laa_slot = next_slot(la_slot);
+  s7_pointer if_test = cdr(body);
+  s7_pointer if_true = cddr(body);
+  s7_pointer if_false = cadddr(body);
+  s7_pointer la = cdr(if_false);
+  s7_pointer laa = cddr(if_false);
+  s7_pointer let_var = caadr(code);
+  s7_pointer inner_let = make_let_with_slot(sc, sc->curlet, car(let_var), fx_call(sc, cdr(let_var)));
+  s7_pointer let_slot = let_slots(inner_let);
+  set_curlet(sc, inner_let);
+  gc_protect_via_stack(sc, inner_let);
+  let_var = cdr(let_var);
+#if (!WITH_GMP)
+  if (!no_bool_opt(code))
+    {
+      sc->pc = 0;
+      if (bool_optimize(sc, if_test))
+	{
+	  opt_info *o = sc->opts[0];
+	  opt_info *o1 = sc->opts[sc->pc], *o2, *o3;
+	  if ((is_t_integer(slot_value(la_slot))) &&
+	      (is_t_integer(slot_value(laa_slot))))
+	    {
+	      if (int_optimize(sc, la))
+		{
+		  o2 = sc->opts[sc->pc];
+		  if (int_optimize(sc, laa))
+		    {
+		      o3 = sc->opts[sc->pc];
+		      set_curlet(sc, outer_let);
+		      if (int_optimize(sc, let_var))
+			{
+			  s7_pointer val1 = make_mutable_integer(sc, integer(slot_value(la_slot)));
+			  s7_pointer val2 = make_mutable_integer(sc, integer(slot_value(laa_slot)));
+			  s7_pointer val3 = make_mutable_integer(sc, integer(slot_value(let_slot)));
+			  set_curlet(sc, inner_let);
+			  slot_set_value(la_slot, val1);
+			  slot_set_value(laa_slot, val2);
+			  slot_set_value(let_slot, val3);
+			  while (!(o->v[0].fb(o)))
+			    {
+			      s7_int i1 = o1->v[0].fi(o1);
+			      set_integer(val2, o2->v[0].fi(o2));
+			      set_integer(val1, i1);
+			      set_integer(val3, o3->v[0].fi(o3));
+			    }
+			  unstack_gc_protect(sc);
+			  if (!op_tc_z(sc, if_true))  /* sc->inner_let in effect here since it was the last set above */
+			    return(false);
+			  free_cell(sc, let_slots(inner_let));
+			  free_cell(sc, inner_let);
+			  return(true);
+			}}}}}
+      set_no_bool_opt(code);
+    }
+#endif
+  while (fx_call(sc, if_test) == sc->F)
+    {
+      sc->rec_p1 = fx_call(sc, la);
+      slot_set_value(laa_slot, fx_call(sc, laa));
+      slot_set_value(la_slot, sc->rec_p1);
+      set_curlet(sc, outer_let);
+      slot_set_value(let_slot, fx_call(sc, let_var));
+      set_curlet(sc, inner_let);
+    }
+  unstack_gc_protect(sc);
+  if (!op_tc_z(sc, if_true))
+    return(false);
+  free_cell(sc, let_slots(inner_let));
+  free_cell(sc, inner_let);
+  return(true);
+}
+
+static s7_pointer fx_tc_let_if_a_z_laa(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_LET_IF_A_Z_LAA);
+  op_tc_let_if_a_z_laa(sc, arg);
+  sc->rec_p1 = sc->unused;
+  return(sc->value);
+}
+
+static void op_tc_let_when_laa(s7_scheme *sc, bool when, s7_pointer code)
+{
+  s7_pointer p, body = caddr(code), la, laa, let_var = caadr(code), outer_let = sc->curlet;
+  s7_pointer if_test = cdr(body);
+  s7_pointer if_true = cddr(body);
+  s7_pointer inner_let = make_let_with_slot(sc, sc->curlet, car(let_var), fx_call(sc, cdr(let_var)));
+  s7_pointer let_slot = let_slots(inner_let);
+  set_curlet(sc, inner_let);
+  gc_protect_via_stack(sc, inner_let);
+  let_var = cdr(let_var);
+
+  for (p = if_true; is_pair(cdr(p)); p = cdr(p));
+  la = cdar(p);
+  laa = cddar(p);
+  if ((car(la) == slot_symbol(let_slots(outer_let))) &&
+      (car(laa) == slot_symbol(next_slot(let_slots(outer_let)))))
+    {
+      if ((cdr(if_true) == p) && (!when))
+	{
+	  s7_pointer a1 = slot_value(let_slots(outer_let));
+	  s7_pointer a2 = slot_value(next_slot(let_slots(outer_let)));
+	  if ((is_input_port(a1)) && (is_output_port(a2)) && (is_string_port(a1)) && (is_file_port(a2)) &&
+	      (!port_is_closed(a1)) && (!port_is_closed(a2)) && (fx_proc(if_true) == fx_c_tU_direct) &&
+	      (fx_proc(let_var) == fx_c_t_direct) && (((s7_p_pp_t)opt3_direct(cdar(if_true))) == write_char_p_pp) &&
+	      (((s7_p_p_t)opt2_direct(cdar(let_var))) == read_char_p_p) && (fx_proc(if_test) == fx_is_eof_t))
+	    {
+	      int32_t c = (int32_t)s7_character(slot_value(let_slots(inner_let)));
+	      a1 = slot_value(let_slots(outer_let));
+	      a2 = slot_value(next_slot(let_slots(outer_let)));
+	      while (c != EOF)
+		{
+		  inline_file_write_char(sc, (uint8_t)c, a2);
+		  c = string_read_char(sc, a1);
+		}}
+	  else
+	    while (fx_call(sc, if_test) == sc->F)
+	      {
+		fx_call(sc, if_true);
+		set_curlet(sc, outer_let);
+		slot_set_value(let_slot, fx_call(sc, let_var));
+		set_curlet(sc, inner_let);
+	      }}
+      else
+	while (true)
+	  {
+	    p = fx_call(sc, if_test);
+	    if (when) {if (p == sc->F) break;} else {if (p != sc->F) break;}
+	    for (p = if_true; is_pair(cdr(p)); p = cdr(p))
+	      fx_call(sc, p);
+	    set_curlet(sc, outer_let);
+	    slot_set_value(let_slot, fx_call(sc, let_var));
+	    set_curlet(sc, inner_let);
+	  }}
+  else
+    {
+      s7_pointer la_slot = let_slots(outer_let);
+      s7_pointer laa_slot = next_slot(la_slot);
+      while (true)
+	{
+	  p = fx_call(sc, if_test);
+	  if (when) {if (p == sc->F) break;} else {if (p != sc->F) break;}
+	  for (p = if_true; is_pair(cdr(p)); p = cdr(p))
+	    fx_call(sc, p);
+	  sc->rec_p1 = fx_call(sc, la);
+	  slot_set_value(laa_slot, fx_call(sc, laa));
+	  slot_set_value(la_slot, sc->rec_p1);
+	  set_curlet(sc, outer_let);
+	  slot_set_value(let_slot, fx_call(sc, let_var));
+	  set_curlet(sc, inner_let);
+	}}
+  unstack_gc_protect(sc);
+  free_cell(sc, let_slots(inner_let));
+  free_cell(sc, inner_let);
+  sc->value = sc->unspecified;
+}
+
+static s7_pointer fx_tc_let_when_laa(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_LET_WHEN_LAA);
+  op_tc_let_when_laa(sc, true, arg);
+  sc->rec_p1 = sc->unused;
+  return(sc->value);
+}
+
+static s7_pointer fx_tc_let_unless_laa(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_LET_WHEN_LAA);
+  op_tc_let_when_laa(sc, false, arg);
+  sc->rec_p1 = sc->unused;
+  return(sc->value);
+}
+
+static bool op_tc_if_a_z_let_if_a_z_laa(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer if1_test = cdr(code), endp, outer_let = sc->curlet, slot, var, la_slot = let_slots(sc->curlet);
+  s7_pointer if1_true = cdr(if1_test);  /*   cddr(code) */
+  s7_pointer let_expr = cadr(if1_true); /* cadddr(code) */
+  s7_pointer let_vars = cadr(let_expr);
+  s7_pointer if2 = caddr(let_expr);
+  s7_pointer if2_test = cdr(if2);
+  s7_pointer if2_true = cdr(if2_test);  /*       cddr(if2) */
+  s7_pointer la = cdadr(if2_true);      /* cdr(cadddr(if2)) */
+  s7_pointer laa = cdr(la);
+  s7_pointer laa_slot = next_slot(la_slot);
+  s7_pointer inner_let = inline_make_let(sc, sc->curlet);
+
+  gc_protect_via_stack(sc, inner_let);
+  slot = make_slot(sc, caar(let_vars), sc->F);
+  slot_set_next(slot, slot_end);
+  let_set_slots(inner_let, slot);
+  symbol_set_local_slot_unincremented(caar(let_vars), let_id(inner_let), slot);
+  for (var = cdr(let_vars); is_pair(var); var = cdr(var))
+    slot = inline_add_slot_at_end(sc, let_id(inner_let), slot, caar(var), sc->F);
+
+  while (true)
+    {
+      if (fx_call(sc, if1_test) != sc->F) {endp = if1_true; break;}
+      slot = let_slots(inner_let);
+      slot_set_value(slot, fx_call(sc, cdar(let_vars)));
+      set_curlet(sc, inner_let);
+      for (var = cdr(let_vars), slot = next_slot(slot); is_pair(var); var = cdr(var), slot = next_slot(slot))
+	slot_set_value(slot, fx_call(sc, cdar(var)));
+
+      if (fx_call(sc, if2_test) != sc->F) {endp = if2_true; break;}
+      sc->rec_p1 = fx_call(sc, la);
+      slot_set_value(laa_slot, fx_call(sc, laa));
+      slot_set_value(la_slot, sc->rec_p1);
+      set_curlet(sc, outer_let);
+    }
+  sc->rec_p1 = sc->unused;
+  unstack_gc_protect(sc);
+  if (!op_tc_z(sc, endp))  /* might refer to inner_let slots */
+    return(false);
+  free_cell(sc, let_slots(inner_let)); /* true = has_fx, so we should be done with the let */
+  free_cell(sc, inner_let);
+  return(true);
+}
+
+static bool op_tc_let_cond(s7_scheme *sc, s7_pointer code)
+{
+  bool read_case;
+  s7_pointer result;
+  s7_pointer outer_let = sc->curlet;
+  s7_pointer slots = let_slots(outer_let);
+  s7_pointer cond_body = cdaddr(code);  /* code here == body in check_tc */
+  s7_pointer let_var = caadr(code);
+  s7_function letf = fx_proc(cdr(let_var));
+  s7_pointer inner_let = make_let_with_slot(sc, sc->curlet, car(let_var), fx_call(sc, cdr(let_var)));
+  s7_pointer let_slot = let_slots(inner_let);
+  set_curlet(sc, inner_let);
+  gc_protect_via_stack(sc, inner_let);
+  let_var = cadr(let_var);
+  if ((letf == fx_c_s_direct) &&
+      (symbol_id(cadr(let_var)) != let_id(outer_let))) /* i.e. not an argument to the recursive function, and not set! (safe closure body) */
+    {
+      letf = (s7_p_p_t)opt2_direct(cdr(let_var));
+      let_var = lookup(sc, cadr(let_var));
+    }
+  /* in the named let no-var case slots may contain the let name (it's the funclet) */
+
+  if (opt3_arglen(cdr(code)) == 0) /* (loop) etc -- no args */
+    while (true)
+      {
+	for (s7_pointer p = cond_body; is_pair(p); p = cdr(p))
+	  if (fx_call(sc, car(p)) != sc->F)
+	    {
+	      result = cdar(p);
+	      if (!has_tc(result))
+		goto TC_LET_COND_DONE;
+	      set_curlet(sc, outer_let);
+	      slot_set_value(let_slot, letf(sc, let_var));
+	      set_curlet(sc, inner_let);
+	      break;
+	    }}
+  else
+    if (opt3_arglen(cdr(code)) == 1)
+      while (true)
+	for (s7_pointer p = cond_body; is_pair(p); p = cdr(p))
+	  if (fx_call(sc, car(p)) != sc->F)
+	    {
+	      result = cdar(p);
+	      if (!has_tc(result))
+		goto TC_LET_COND_DONE;
+	      slot_set_value(slots, fx_call(sc, cdar(result))); /* arg to recursion */
+	      set_curlet(sc, outer_let);
+	      slot_set_value(let_slot, letf(sc, let_var));   /* inner let var */
+	      set_curlet(sc, inner_let);
+	      break;
+	    }
+
+  let_set_has_pending_value(outer_let);
+  read_case = ((letf == read_char_p_p) && (is_input_port(let_var)) && (is_string_port(let_var)) && (!port_is_closed(let_var)));
+  while (true)
+    for (s7_pointer p = cond_body; is_pair(p); p = cdr(p))
+      if (fx_call(sc, car(p)) != sc->F)
+	{
+	  result = cdar(p);
+	  if (!has_tc(result))
+	    goto TC_LET_COND_DONE;
+	  for (s7_pointer slot = slots, arg = cdar(result); is_pair(arg); slot = next_slot(slot), arg = cdr(arg))
+	    slot_simply_set_pending_value(slot, fx_call(sc, arg));
+	  for (s7_pointer slot = slots; tis_slot(slot); slot = next_slot(slot)) /* using two swapping lets instead is slightly slower */
+	    slot_set_value(slot, slot_pending_value(slot));
+
+	  if (read_case)
+	    slot_set_value(let_slot, chars[string_read_char(sc, let_var)]);
+	  else
+	    {
+	      set_curlet(sc, outer_let);
+	      slot_set_value(let_slot, letf(sc, let_var));
+	      set_curlet(sc, inner_let);
+	    }
+	  break;
+	}
+  let_clear_has_pending_value(sc, outer_let);
+
+ TC_LET_COND_DONE:
+  unstack_gc_protect(sc);
+  if (has_fx(result))
+    {
+      sc->value = fx_call(sc, result);
+      free_cell(sc, let_slots(inner_let));
+      free_cell(sc, inner_let);
+      return(true);
+    }
+  sc->code = car(result);
+  return(false);
+}
+
+static s7_pointer fx_tc_let_cond(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_LET_COND);
+  op_tc_let_cond(sc, arg);
+  return(sc->value);
+}
+
+static bool op_tc_cond_a_z_a_laa_laa(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer c1 = cadr(code), c2 = caddr(code), la_slot = let_slots(sc->curlet);
+  s7_pointer la1 = cdadr(c2);
+  s7_pointer laa1 = cddadr(c2);
+  s7_pointer c3 = opt3_pair(code);  /* cadr(cadddr(code)) = cadr(else_clause) */
+  s7_pointer la2 = cdr(c3);
+  s7_pointer laa2 = cddr(c3);
+  s7_pointer laa_slot = next_slot(la_slot);
+  while (true)
+    {
+      if (fx_call(sc, c1) != sc->F) {c1 = cdr(c1); break;}
+      if (fx_call(sc, c2) != sc->F)
+	{
+	  sc->rec_p1 = fx_call(sc, la1);
+	  slot_set_value(laa_slot, fx_call(sc, laa1));
+	}
+      else
+	{
+	  sc->rec_p1 = fx_call(sc, la2);
+	  slot_set_value(laa_slot, fx_call(sc, laa2));
+	}
+      slot_set_value(la_slot, sc->rec_p1);
+    }
+  return(op_tc_z(sc, c1));
+}
+
+static s7_pointer fx_tc_cond_a_z_a_laa_laa(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_TC_COND_A_Z_A_LAA_LAA);
+  op_tc_cond_a_z_a_laa_laa(sc, arg);
+  sc->rec_p1 = sc->unused;
+  return(sc->value);
+}
+
+
+#define RECUR_INITIAL_STACK_SIZE 1024
+
+static void recur_resize(s7_scheme *sc)
+{
+  s7_pointer stack = sc->rec_stack;
+  block_t *ob, *nb;
+  vector_length(stack) = sc->rec_len * 2;
+  ob = vector_block(stack);
+  nb = reallocate(sc, ob, vector_length(stack) * sizeof(s7_pointer));
+  block_info(nb) = NULL;
+  vector_block(stack) = nb;
+  vector_elements(stack) = (s7_pointer *)block_data(nb); /* GC looks only at elements within sc->rec_loc */
+  sc->rec_len = vector_length(stack);
+  sc->rec_els = vector_elements(stack);
+}
+
+static inline void recur_push(s7_scheme *sc, s7_pointer value)
+{
+  if (sc->rec_loc == sc->rec_len)
+    recur_resize(sc);
+  sc->rec_els[sc->rec_loc] = value;
+  sc->rec_loc++;
+}
+
+static inline void recur_push_unchecked(s7_scheme *sc, s7_pointer value) {sc->rec_els[sc->rec_loc++] = value;}
+static s7_pointer recur_pop(s7_scheme *sc) {return(sc->rec_els[--sc->rec_loc]);}
+static s7_pointer recur_ref(s7_scheme *sc, s7_int loc) {return(sc->rec_els[sc->rec_loc - loc]);}
+
+static s7_pointer recur_pop2(s7_scheme *sc)
+{
+  sc->rec_loc -= 2;
+  return(sc->rec_els[sc->rec_loc + 1]);
+}
+
+static s7_pointer recur_swap(s7_scheme *sc, s7_pointer value)
+{
+  s7_pointer res = sc->rec_els[sc->rec_loc - 1];
+  sc->rec_els[sc->rec_loc - 1] = value;
+  return(res);
+}
+
+static s7_pointer recur_make_stack(s7_scheme *sc)
+{
+  if (!sc->rec_stack)
+    {
+      sc->rec_stack = make_simple_vector(sc, RECUR_INITIAL_STACK_SIZE);
+      sc->rec_els = vector_elements(sc->rec_stack);
+      sc->rec_len = RECUR_INITIAL_STACK_SIZE;
+    }
+  sc->rec_loc = 0;
+  return(sc->rec_stack);
+}
+
+static void rec_set_test(s7_scheme *sc, s7_pointer p)
+{
+  sc->rec_testp = p;
+  sc->rec_testf = fx_proc(sc->rec_testp);
+  sc->rec_testp = car(sc->rec_testp);
+}
+
+static void rec_set_res(s7_scheme *sc, s7_pointer p)
+{
+  sc->rec_resp = p;
+  sc->rec_resf = fx_proc(sc->rec_resp);
+  sc->rec_resp = car(sc->rec_resp);
+}
+
+static void rec_set_f1(s7_scheme *sc, s7_pointer p)
+{
+  sc->rec_f1p = p;
+  sc->rec_f1f = fx_proc(sc->rec_f1p);
+  sc->rec_f1p = car(sc->rec_f1p);
+}
+
+static void rec_set_f2(s7_scheme *sc, s7_pointer p)
+{
+  sc->rec_f2p = p;
+  sc->rec_f2f = fx_proc(sc->rec_f2p);
+  sc->rec_f2p = car(sc->rec_f2p);
+}
+
+static void rec_set_f3(s7_scheme *sc, s7_pointer p)
+{
+  sc->rec_f3p = p;
+  sc->rec_f3f = fx_proc(sc->rec_f3p);
+  sc->rec_f3p = car(sc->rec_f3p);
+}
+
+static void rec_set_f4(s7_scheme *sc, s7_pointer p)
+{
+  sc->rec_f4p = p;
+  sc->rec_f4f = fx_proc(sc->rec_f4p);
+  sc->rec_f4p = car(sc->rec_f4p);
+}
+
+static void rec_set_f5(s7_scheme *sc, s7_pointer p)
+{
+  sc->rec_f5p = p;
+  sc->rec_f5f = fx_proc(sc->rec_f5p);
+  sc->rec_f5p = car(sc->rec_f5p);
+}
+
+static void rec_set_f6(s7_scheme *sc, s7_pointer p)
+{
+  sc->rec_f6p = p;
+  sc->rec_f6f = fx_proc(sc->rec_f6p);
+  sc->rec_f6p = car(sc->rec_f6p);
+}
+
+/* -------- if_a_a_opa_laq and if_a_opa_laq_a -------- */
+typedef enum {OPT_PTR, OPT_INT, OPT_DBL, OPT_INT_0} opt_pid_t;
+
+static opt_pid_t opinit_if_a_a_opa_laq(s7_scheme *sc, bool a_op, bool la_op, s7_pointer code)
+{
+  s7_pointer caller = opt3_pair(code); /* false_p in check_recur */
+#if (!WITH_GMP)
+  s7_pointer c_op = car(caller);
+  if ((is_symbol(c_op)) &&
+      ((is_global(c_op)) ||
+       ((is_slot(global_slot(c_op))) &&
+	(s7_slot(sc, c_op) == global_slot(c_op)))))
+    {
+      s7_pointer s_func = global_value(c_op), slot = let_slots(sc->curlet);
+      if (is_c_function(s_func))
+	{
+	  sc->pc = 0;
+	  sc->rec_test_o = sc->opts[0];
+	  if (bool_optimize(sc, cdr(code)))
+	    {
+	      int32_t start_pc = sc->pc;
+	      sc->rec_result_o = sc->opts[start_pc];
+	      if (is_t_integer(slot_value(slot)))
+		{
+		  sc->rec_i_ii_f = s7_i_ii_function(s_func);
+		  if ((sc->rec_i_ii_f) &&
+		      (int_optimize(sc, (a_op) ? cddr(code) : cdddr(code))))
+		    {
+		      sc->rec_a1_o = sc->opts[sc->pc];
+		      if (int_optimize(sc, (la_op) ? cdr(caller) : cddr(caller))) /* cdadr? */
+			{
+			  sc->rec_a2_o = sc->opts[sc->pc];
+			  if (int_optimize(sc, cdr(opt3_pair(caller))))
+			    {
+			      sc->rec_val1 = make_mutable_integer(sc, integer(slot_value(slot)));
+			      slot_set_value(slot, sc->rec_val1);
+			      return(OPT_INT);
+			    }}}}}}}
+#endif
+  rec_set_test(sc, cdr(code));
+  rec_set_res(sc, (a_op) ?  cddr(code) : cdddr(code));
+  rec_set_f1(sc, (la_op) ? cdr(caller) : cddr(caller));
+  rec_set_f2(sc, cdr(opt3_pair(caller)));
+  sc->rec_slot1 = let_slots(sc->curlet);
+  sc->rec_fn = fn_proc(caller);
+  return(OPT_PTR);
+}
+
+static s7_int oprec_i_if_a_a_opa_laq(s7_scheme *sc)
+{
+  s7_int i1;
+  if (sc->rec_test_o->v[0].fb(sc->rec_test_o)) return(sc->rec_result_o->v[0].fi(sc->rec_result_o));
+  i1 = sc->rec_a1_o->v[0].fi(sc->rec_a1_o);
+  set_integer(sc->rec_val1, sc->rec_a2_o->v[0].fi(sc->rec_a2_o));
+  return(sc->rec_i_ii_f(i1, oprec_i_if_a_a_opa_laq(sc)));
+}
+
+static s7_int oprec_i_if_a_opa_laq_a(s7_scheme *sc)
+{
+  s7_int i1;
+  if (!sc->rec_test_o->v[0].fb(sc->rec_test_o)) return(sc->rec_result_o->v[0].fi(sc->rec_result_o));
+  i1 = sc->rec_a1_o->v[0].fi(sc->rec_a1_o);
+  set_integer(sc->rec_val1, sc->rec_a2_o->v[0].fi(sc->rec_a2_o));
+  return(sc->rec_i_ii_f(i1, oprec_i_if_a_opa_laq_a(sc)));
+}
+
+static s7_pointer oprec_if_a_a_opa_laq(s7_scheme *sc)
+{
+  if (sc->rec_testf(sc, sc->rec_testp) != sc->F) return(sc->rec_resf(sc, sc->rec_resp));
+  recur_push(sc, sc->rec_f1f(sc, sc->rec_f1p));
+  slot_set_value(sc->rec_slot1, sc->rec_f2f(sc, sc->rec_f2p));
+
+  if (sc->rec_testf(sc, sc->rec_testp) != sc->F)
+    set_car(sc->t2_2, sc->rec_resf(sc, sc->rec_resp));
+  else
+    {
+      recur_push(sc, sc->rec_f1f(sc, sc->rec_f1p));
+      slot_set_value(sc->rec_slot1, sc->rec_f2f(sc, sc->rec_f2p));
+      set_car(sc->t2_2, oprec_if_a_a_opa_laq(sc));
+      set_car(sc->t2_1, recur_pop(sc));
+      set_car(sc->t2_2, sc->rec_fn(sc, sc->t2_1));
+    }
+  set_car(sc->t2_1, recur_pop(sc));
+  return(sc->rec_fn(sc, sc->t2_1));
+}
+
+static s7_pointer oprec_if_a_a_opla_aq(s7_scheme *sc)
+{
+  if (sc->rec_testf(sc, sc->rec_testp) != sc->F) return(sc->rec_resf(sc, sc->rec_resp));
+  recur_push(sc, sc->rec_f1f(sc, sc->rec_f1p));
+  slot_set_value(sc->rec_slot1, sc->rec_f2f(sc, sc->rec_f2p));
+  set_car(sc->t2_1, oprec_if_a_a_opla_aq(sc));
+  set_car(sc->t2_2, recur_pop(sc));
+  return(sc->rec_fn(sc, sc->t2_1));
+}
+
+static s7_pointer oprec_if_a_opa_laq_a(s7_scheme *sc)
+{
+  if (sc->rec_testf(sc, sc->rec_testp) == sc->F) return(sc->rec_resf(sc, sc->rec_resp));
+  recur_push(sc, sc->rec_f1f(sc, sc->rec_f1p));
+  slot_set_value(sc->rec_slot1, sc->rec_f2f(sc, sc->rec_f2p));
+
+  if (sc->rec_testf(sc, sc->rec_testp) == sc->F)
+    set_car(sc->t2_2, sc->rec_resf(sc, sc->rec_resp));
+  else
+    {
+      recur_push(sc, sc->rec_f1f(sc, sc->rec_f1p));
+      slot_set_value(sc->rec_slot1, sc->rec_f2f(sc, sc->rec_f2p));
+      set_car(sc->t2_2, oprec_if_a_opa_laq_a(sc));
+      set_car(sc->t2_1, recur_pop(sc));
+      set_car(sc->t2_2, sc->rec_fn(sc, sc->t2_1));
+    }
+  set_car(sc->t2_1, recur_pop(sc));
+  return(sc->rec_fn(sc, sc->t2_1));
+}
+
+static s7_pointer oprec_if_a_opla_aq_a(s7_scheme *sc)
+{
+  if (sc->rec_testf(sc, sc->rec_testp) == sc->F) return(sc->rec_resf(sc, sc->rec_resp));
+  recur_push(sc, sc->rec_f1f(sc, sc->rec_f1p));
+  slot_set_value(sc->rec_slot1, sc->rec_f2f(sc, sc->rec_f2p));
+  set_car(sc->t2_1, oprec_if_a_opla_aq_a(sc));
+  set_car(sc->t2_2, recur_pop(sc));
+  return(sc->rec_fn(sc, sc->t2_1));
+}
+
+static void wrap_recur_if_a_a_opa_laq(s7_scheme *sc, bool a_op, bool la_op)
+{
+  opt_pid_t choice = opinit_if_a_a_opa_laq(sc, a_op, la_op, sc->code);
+  tick_tc(sc, sc->cur_op);
+  if (choice == OPT_INT)
+    sc->value = make_integer(sc, (a_op) ? oprec_i_if_a_a_opa_laq(sc) : oprec_i_if_a_opa_laq_a(sc));
+  else
+    {
+      sc->rec_stack = recur_make_stack(sc);
+      if (a_op)
+	sc->value = (la_op) ? oprec_if_a_a_opa_laq(sc) : oprec_if_a_a_opla_aq(sc);
+      else sc->value = (la_op) ? oprec_if_a_opa_laq_a(sc) : oprec_if_a_opla_aq_a(sc);
+      sc->rec_loc = 0;
+    }
+}
+
+static s7_pointer fx_recur_if_a_a_opa_laq(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_RECUR_IF_A_A_opA_LAq);
+  if (opinit_if_a_a_opa_laq(sc, true, true, arg) == OPT_INT)
+    sc->value = make_integer(sc, oprec_i_if_a_a_opa_laq(sc));
+  else
+    {
+      sc->rec_stack = recur_make_stack(sc);
+      sc->value = oprec_if_a_a_opa_laq(sc);
+      sc->rec_loc = 0;
+    }
+  return(sc->value);
+}
+
+static s7_pointer fx_recur_if_a_opa_laq_a(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_RECUR_IF_A_opA_LAq_A);
+  if (opinit_if_a_a_opa_laq(sc, false, true, arg) == OPT_INT)
+    sc->value = make_integer(sc, oprec_i_if_a_opa_laq_a(sc));
+  else
+    {
+      sc->rec_stack = recur_make_stack(sc);
+      sc->value = oprec_if_a_opa_laq_a(sc);
+      sc->rec_loc = 0;
+    }
+  return(sc->value);
+}
+
+/* -------- cond_a_a_opa_laq -------- */
+static void opinit_cond_a_a_opa_laq(s7_scheme *sc)
+{
+  s7_pointer caller = opt3_pair(sc->code);
+  rec_set_test(sc, cadr(sc->code));
+  rec_set_res(sc, cdadr(sc->code));
+  rec_set_f1(sc, cdr(caller));
+  rec_set_f2(sc, cdr(opt3_pair(caller)));
+  sc->rec_slot1 = let_slots(sc->curlet);
+  sc->rec_fn = fn_proc(caller);
+}
+
+static s7_pointer op_recur_cond_a_a_opa_laq(s7_scheme *sc)
+{
+  opinit_cond_a_a_opa_laq(sc);
+  return(oprec_if_a_a_opa_laq(sc));
+}
+
+/* -------- if_a_a_opa_laaq and if_a_opa_laaq_a and cond_a_a_opa_laaq -------- */
+typedef enum {IF1A_LA2, IF2A_LA2, COND2A_LA2} laaq_t;
+
+static void opinit_if_a_a_opa_laaq(s7_scheme *sc, laaq_t a_op)
+{
+  s7_pointer caller = opt3_pair(sc->code);
+  rec_set_test(sc, (a_op == COND2A_LA2) ? cadr(sc->code) : cdr(sc->code));
+  rec_set_res(sc, (a_op == IF2A_LA2) ?  cddr(sc->code) : ((a_op == IF1A_LA2) ? cdddr(sc->code) : cdadr(sc->code)));
+  rec_set_f1(sc, cdr(caller));
+  rec_set_f2(sc, cdr(opt3_pair(caller)));
+  rec_set_f3(sc, cddr(opt3_pair(caller)));
+  sc->rec_slot1 = let_slots(sc->curlet);
+  sc->rec_slot2 = next_slot(sc->rec_slot1);
+  sc->rec_fn = fn_proc(caller);
+}
+
+static s7_pointer oprec_if_a_a_opa_laaq(s7_scheme *sc)
+{
+  if (sc->rec_testf(sc, sc->rec_testp) != sc->F) return(sc->rec_resf(sc, sc->rec_resp));
+  recur_push(sc, sc->rec_f1f(sc, sc->rec_f1p));
+  recur_push(sc, sc->rec_f2f(sc, sc->rec_f2p));
+  slot_set_value(sc->rec_slot2, sc->rec_f3f(sc, sc->rec_f3p));
+  slot_set_value(sc->rec_slot1, recur_pop(sc));
+  if (sc->rec_testf(sc, sc->rec_testp) != sc->F)
+    set_car(sc->t2_2, sc->rec_resf(sc, sc->rec_resp));
+  else
+    {
+      recur_push(sc, sc->rec_f1f(sc, sc->rec_f1p));
+      recur_push(sc, sc->rec_f2f(sc, sc->rec_f2p));
+      slot_set_value(sc->rec_slot2, sc->rec_f3f(sc, sc->rec_f3p));
+      slot_set_value(sc->rec_slot1, recur_pop(sc));
+      set_car(sc->t2_2, oprec_if_a_a_opa_laaq(sc));
+      set_car(sc->t2_1, recur_pop(sc));
+      set_car(sc->t2_2, sc->rec_fn(sc, sc->t2_1));
+    }
+  set_car(sc->t2_1, recur_pop(sc));
+  return(sc->rec_fn(sc, sc->t2_1));
+}
+
+static s7_pointer oprec_if_a_opa_laaq_a(s7_scheme *sc)
+{
+  if (sc->rec_testf(sc, sc->rec_testp) == sc->F) return(sc->rec_resf(sc, sc->rec_resp));
+  recur_push(sc, sc->rec_f1f(sc, sc->rec_f1p));
+  recur_push(sc, sc->rec_f2f(sc, sc->rec_f2p));
+  slot_set_value(sc->rec_slot2, sc->rec_f3f(sc, sc->rec_f3p));
+  slot_set_value(sc->rec_slot1, recur_pop(sc));
+  set_car(sc->t2_2, oprec_if_a_opa_laaq_a(sc));
+  set_car(sc->t2_1, recur_pop(sc));
+  return(sc->rec_fn(sc, sc->t2_1));
+}
+
+static s7_pointer op_recur_if_a_a_opa_laaq(s7_scheme *sc)
+{
+  opinit_if_a_a_opa_laaq(sc, IF2A_LA2);
+  return(oprec_if_a_a_opa_laaq(sc));
+}
+
+static s7_pointer op_recur_if_a_opa_laaq_a(s7_scheme *sc)
+{
+  opinit_if_a_a_opa_laaq(sc, IF1A_LA2);
+  return(oprec_if_a_opa_laaq_a(sc));
+}
+
+static s7_pointer op_recur_cond_a_a_opa_laaq(s7_scheme *sc)
+{
+  opinit_if_a_a_opa_laaq(sc, COND2A_LA2);
+  return(oprec_if_a_a_opa_laaq(sc));
+}
+
+
+/* -------- if_a_a_opa_l3aq -------- */
+static void opinit_if_a_a_opa_l3aq(s7_scheme *sc)
+{
+  s7_pointer caller = opt3_pair(sc->code), l3a = cdr(opt3_pair(caller));
+  rec_set_test(sc, cdr(sc->code));
+  rec_set_res(sc, cddr(sc->code));
+  rec_set_f1(sc, cdr(caller));
+  rec_set_f2(sc, l3a);
+  rec_set_f3(sc, cdr(l3a));
+  rec_set_f4(sc, cddr(l3a));
+  sc->rec_slot1 = let_slots(sc->curlet);
+  sc->rec_slot2 = next_slot(sc->rec_slot1);
+  sc->rec_slot3 = next_slot(sc->rec_slot2);
+  sc->rec_fn = fn_proc(caller);
+}
+
+static s7_pointer oprec_if_a_a_opa_l3aq(s7_scheme *sc)
+{
+  if (sc->rec_testf(sc, sc->rec_testp) != sc->F) return(sc->rec_resf(sc, sc->rec_resp));
+  recur_push(sc, sc->rec_f1f(sc, sc->rec_f1p));
+  recur_push(sc, sc->rec_f2f(sc, sc->rec_f2p));
+  recur_push(sc, sc->rec_f3f(sc, sc->rec_f3p));
+  slot_set_value(sc->rec_slot3, sc->rec_f4f(sc, sc->rec_f4p));
+  slot_set_value(sc->rec_slot2, recur_pop(sc));
+  slot_set_value(sc->rec_slot1, recur_pop(sc));
+  if (sc->rec_testf(sc, sc->rec_testp) != sc->F)
+    set_car(sc->t2_2, sc->rec_resf(sc, sc->rec_resp));
+  else
+    {
+      recur_push(sc, sc->rec_f1f(sc, sc->rec_f1p));
+      recur_push(sc, sc->rec_f2f(sc, sc->rec_f2p));
+      recur_push(sc, sc->rec_f3f(sc, sc->rec_f3p));
+      slot_set_value(sc->rec_slot3, sc->rec_f4f(sc, sc->rec_f4p));
+      slot_set_value(sc->rec_slot2, recur_pop(sc));
+      slot_set_value(sc->rec_slot1, recur_pop(sc));
+      set_car(sc->t2_2, oprec_if_a_a_opa_l3aq(sc));
+      set_car(sc->t2_1, recur_pop(sc));
+      set_car(sc->t2_2, sc->rec_fn(sc, sc->t2_1));
+    }
+  set_car(sc->t2_1, recur_pop(sc));
+  return(sc->rec_fn(sc, sc->t2_1));
+}
+
+static s7_pointer op_recur_if_a_a_opa_l3aq(s7_scheme *sc)
+{
+  opinit_if_a_a_opa_l3aq(sc);
+  return(oprec_if_a_a_opa_l3aq(sc));
+}
+
+/* -------- if_a_a_opla_laq and if_a_opla_laq_a -------- */
+static opt_pid_t opinit_if_a_a_opla_laq(s7_scheme *sc, bool a_op)
+{
+  s7_pointer caller = opt3_pair(sc->code);
+#if (!WITH_GMP)
+  s7_pointer c_op = car(caller);
+  if ((is_symbol(c_op)) &&
+      ((is_global(c_op)) ||
+       ((is_slot(global_slot(c_op))) &&
+	(s7_slot(sc, c_op) == global_slot(c_op)))))
+    {
+      s7_pointer s_func = global_value(c_op);
+      s7_pointer slot = let_slots(sc->curlet);
+      if (is_c_function(s_func))
+	{
+	  sc->pc = 0;
+	  sc->rec_test_o = sc->opts[0];
+	  if (bool_optimize(sc, cdr(sc->code)))
+	    {
+	      int32_t start_pc = sc->pc;
+	      sc->rec_result_o = sc->opts[start_pc];
+	      if (is_t_integer(slot_value(slot)))
+		{
+		  sc->rec_i_ii_f = s7_i_ii_function(s_func);
+		  if ((sc->rec_i_ii_f) &&
+		      (int_optimize(sc, (a_op) ? cddr(sc->code) : cdddr(sc->code))))
+		    {
+		      sc->rec_a1_o = sc->opts[sc->pc];
+		      if (int_optimize(sc, cdadr(caller)))
+			{
+			  sc->rec_a2_o = sc->opts[sc->pc];
+			  if (int_optimize(sc, cdr(opt3_pair(caller))))
+			    {
+			      sc->rec_val1 = make_mutable_integer(sc, integer(slot_value(slot)));
+			      slot_set_value(slot, sc->rec_val1);
+			      if (sc->pc != 4)
+				return(OPT_INT);
+			      sc->rec_fb1 = sc->rec_test_o->v[0].fb;
+			      sc->rec_fi1 = sc->rec_result_o->v[0].fi;
+			      sc->rec_fi2 = sc->rec_a1_o->v[0].fi;
+			      sc->rec_fi3 = sc->rec_a2_o->v[0].fi;
+			      return(OPT_INT_0);
+			    }}}}
+	      if (is_t_real(slot_value(slot)))
+		{
+		  sc->rec_d_dd_f = s7_d_dd_function(s_func);
+		  if (sc->rec_d_dd_f)
+		    {
+		      sc->pc = start_pc;
+		      sc->rec_result_o = sc->opts[start_pc];
+		      if (float_optimize(sc, (a_op) ? cddr(sc->code) : cdddr(sc->code)))
+			{
+			  sc->rec_a1_o = sc->opts[sc->pc];
+			  if (float_optimize(sc, cdadr(caller)))
+			    {
+			      sc->rec_a2_o = sc->opts[sc->pc];
+			      if (float_optimize(sc, cdr(opt3_pair(caller))))
+				{
+				  sc->rec_val1 = make_mutable_real(sc, real(slot_value(slot)));
+				  slot_set_value(slot, sc->rec_val1);
+				  return(OPT_DBL);
+				}}}}}}}}
+#endif
+  rec_set_test(sc, cdr(sc->code));
+  rec_set_res(sc, (a_op) ?  cddr(sc->code) : cdddr(sc->code));
+  rec_set_f1(sc, cdadr(caller));
+  rec_set_f2(sc, cdr(opt3_pair(caller)));
+  sc->rec_slot1 = let_slots(sc->curlet);
+  sc->rec_fn = fn_proc(caller);
+  return(OPT_PTR);
+}
+
+static s7_int oprec_i_if_a_a_opla_laq(s7_scheme *sc)
+{
+  s7_int i1, i2;
+  if (sc->rec_test_o->v[0].fb(sc->rec_test_o))                   /* if_(A) */
+    return(sc->rec_result_o->v[0].fi(sc->rec_result_o));         /* if_a_(A) */
+  i1 = sc->rec_a1_o->v[0].fi(sc->rec_a1_o);                      /* save a1 */
+  set_integer(sc->rec_val1, sc->rec_a2_o->v[0].fi(sc->rec_a2_o));/* slot1 = a2 */
+  i2 = oprec_i_if_a_a_opla_laq(sc);                              /* save la2 */
+  set_integer(sc->rec_val1, i1);                                 /* slot1 = a1 */
+  return(sc->rec_i_ii_f(oprec_i_if_a_a_opla_laq(sc), i2));       /* call op(la1, la2) */
+}
+
+static s7_int oprec_i_if_a_a_opla_laq_0(s7_scheme *sc)
+{
+  s7_int i1, i2;
+  if (sc->rec_fb1(sc->rec_test_o)) return(sc->rec_fi1(sc->rec_result_o));
+  i1 = sc->rec_fi2(sc->rec_a1_o);
+  set_integer(sc->rec_val1, sc->rec_fi3(sc->rec_a2_o));
+  if (sc->rec_fb1(sc->rec_test_o))
+    i2 = sc->rec_fi1(sc->rec_result_o);
+  else
+    {
+      s7_int i3;
+      i2 = sc->rec_fi2(sc->rec_a1_o);
+      set_integer(sc->rec_val1, sc->rec_fi3(sc->rec_a2_o));
+      i3 = oprec_i_if_a_a_opla_laq_0(sc);
+      set_integer(sc->rec_val1, i2);
+      i2 = sc->rec_i_ii_f(oprec_i_if_a_a_opla_laq_0(sc), i3);
+    }
+  set_integer(sc->rec_val1, i1);
+  return(sc->rec_i_ii_f(oprec_i_if_a_a_opla_laq_0(sc), i2));
+}
+
+static s7_double oprec_d_if_a_a_opla_laq(s7_scheme *sc)
+{
+  s7_double x1, x2;
+  if (sc->rec_test_o->v[0].fb(sc->rec_test_o)) return(sc->rec_result_o->v[0].fd(sc->rec_result_o));
+  x1 = sc->rec_a1_o->v[0].fd(sc->rec_a1_o);
+  set_real(sc->rec_val1, sc->rec_a2_o->v[0].fd(sc->rec_a2_o));
+  if (sc->rec_test_o->v[0].fb(sc->rec_test_o))
+    x2 = sc->rec_result_o->v[0].fd(sc->rec_result_o);
+  else
+    {
+      s7_double x3;
+      x2 = sc->rec_a1_o->v[0].fd(sc->rec_a1_o);
+      set_real(sc->rec_val1, sc->rec_a2_o->v[0].fd(sc->rec_a2_o));
+      x3 = oprec_d_if_a_a_opla_laq(sc);
+      set_real(sc->rec_val1, x2);
+      x2 = sc->rec_d_dd_f(oprec_d_if_a_a_opla_laq(sc), x3);
+    }
+  set_real(sc->rec_val1, x1);
+  return(sc->rec_d_dd_f(oprec_d_if_a_a_opla_laq(sc), x2));
+}
+
+static s7_pointer oprec_if_a_a_opla_laq(s7_scheme *sc)
+{
+  if (sc->rec_testf(sc, sc->rec_testp) != sc->F) return(sc->rec_resf(sc, sc->rec_resp));
+  recur_push(sc, sc->rec_f1f(sc, sc->rec_f1p));
+  slot_set_value(sc->rec_slot1, sc->rec_f2f(sc, sc->rec_f2p));
+  slot_set_value(sc->rec_slot1, recur_swap(sc, oprec_if_a_a_opla_laq(sc)));
+  set_car(sc->t2_1, oprec_if_a_a_opla_laq(sc));
+  set_car(sc->t2_2, recur_pop(sc));
+  return(sc->rec_fn(sc, sc->t2_1));
+}
+
+static s7_int oprec_i_if_a_opla_laq_a(s7_scheme *sc)
+{
+  s7_int i1, i2;
+  if (!(sc->rec_test_o->v[0].fb(sc->rec_test_o))) return(sc->rec_result_o->v[0].fi(sc->rec_result_o));
+  i1 = sc->rec_a1_o->v[0].fi(sc->rec_a1_o);
+  set_integer(sc->rec_val1, sc->rec_a2_o->v[0].fi(sc->rec_a2_o));
+  i2 = oprec_i_if_a_opla_laq_a(sc);
+  set_integer(sc->rec_val1, i1);
+  return(sc->rec_i_ii_f(oprec_i_if_a_opla_laq_a(sc), i2));
+}
+
+static s7_int oprec_i_if_a_opla_laq_a_0(s7_scheme *sc)
+{
+  s7_int i1, i2;
+  if (!sc->rec_fb1(sc->rec_test_o)) return(sc->rec_fi1(sc->rec_result_o));
+  i1 = sc->rec_fi2(sc->rec_a1_o);
+  set_integer(sc->rec_val1, sc->rec_fi3(sc->rec_a2_o));
+  if (!sc->rec_fb1(sc->rec_test_o))
+    i2 = sc->rec_fi1(sc->rec_result_o);
+  else
+    {
+      s7_int i3;
+      i2 = sc->rec_fi2(sc->rec_a1_o);
+      set_integer(sc->rec_val1, sc->rec_fi3(sc->rec_a2_o));
+      i3 = oprec_i_if_a_opla_laq_a_0(sc);
+      set_integer(sc->rec_val1, i2);
+      i2 = sc->rec_i_ii_f(oprec_i_if_a_opla_laq_a_0(sc), i3);
+    }
+  set_integer(sc->rec_val1, i1);
+  return(sc->rec_i_ii_f(oprec_i_if_a_opla_laq_a_0(sc), i2));
+}
+
+static s7_double oprec_d_if_a_opla_laq_a(s7_scheme *sc)
+{
+  s7_double x1, x2;
+  if (!(sc->rec_test_o->v[0].fb(sc->rec_test_o))) return(sc->rec_result_o->v[0].fd(sc->rec_result_o));
+  x1 = sc->rec_a1_o->v[0].fd(sc->rec_a1_o);
+  set_real(sc->rec_val1, sc->rec_a2_o->v[0].fd(sc->rec_a2_o));
+  x2 = oprec_d_if_a_opla_laq_a(sc);
+  set_real(sc->rec_val1, x1);
+  return(sc->rec_d_dd_f(oprec_d_if_a_opla_laq_a(sc), x2));
+}
+
+static s7_pointer oprec_if_a_opla_laq_a(s7_scheme *sc)
+{
+  if (sc->rec_testf(sc, sc->rec_testp) == sc->F) return(sc->rec_resf(sc, sc->rec_resp));
+  recur_push(sc, sc->rec_f1f(sc, sc->rec_f1p));
+  slot_set_value(sc->rec_slot1, sc->rec_f2f(sc, sc->rec_f2p));
+  slot_set_value(sc->rec_slot1, recur_swap(sc, oprec_if_a_opla_laq_a(sc)));
+  set_car(sc->t2_1, oprec_if_a_opla_laq_a(sc));
+  set_car(sc->t2_2, recur_pop(sc));
+  return(sc->rec_fn(sc, sc->t2_1));
+}
+
+static void wrap_recur_if_a_a_opla_laq(s7_scheme *sc, bool a_op)
+{
+  opt_pid_t choice = opinit_if_a_a_opla_laq(sc, a_op);
+  tick_tc(sc, sc->cur_op);
+  if ((choice == OPT_INT) || (choice == OPT_INT_0))
+    {
+      if (choice == OPT_INT_0)
+	sc->value = make_integer(sc, (a_op) ? oprec_i_if_a_a_opla_laq_0(sc) : oprec_i_if_a_opla_laq_a_0(sc));
+      else sc->value = make_integer(sc, (a_op) ? oprec_i_if_a_a_opla_laq(sc) : oprec_i_if_a_opla_laq_a(sc));
+    }
+  else
+    if (choice == OPT_PTR)
+      {
+	sc->rec_stack = recur_make_stack(sc);
+	sc->value = (a_op) ? oprec_if_a_a_opla_laq(sc) : oprec_if_a_opla_laq_a(sc);
+	sc->rec_loc = 0;
+      }
+    else sc->value = make_real(sc, (a_op) ? oprec_d_if_a_a_opla_laq(sc) : oprec_d_if_a_opla_laq_a(sc));
+}
+
+
+/* -------- if_a_a_opa_la_laq and if_a_opa_la_laq_a -------- */
+static void opinit_if_a_a_opa_la_laq(s7_scheme *sc, bool a_op)
+{
+  s7_pointer caller = opt3_pair(sc->code);
+  rec_set_test(sc, cdr(sc->code));
+  rec_set_res(sc, (a_op) ?  cddr(sc->code) : cdddr(sc->code));
+  rec_set_f1(sc, cdr(caller));
+  rec_set_f2(sc, cdaddr(caller));
+  rec_set_f3(sc, cdr(opt3_pair(caller)));
+  sc->rec_slot1 = let_slots(sc->curlet);
+  sc->rec_fn = fn_proc(caller);
+}
+
+static s7_pointer oprec_if_a_a_opa_la_laq(s7_scheme *sc)
+{
+  if (sc->rec_testf(sc, sc->rec_testp) != sc->F) return(sc->rec_resf(sc, sc->rec_resp));
+  recur_push(sc, sc->rec_f1f(sc, sc->rec_f1p));
+  recur_push(sc, sc->rec_f2f(sc, sc->rec_f2p));
+  slot_set_value(sc->rec_slot1, sc->rec_f3f(sc, sc->rec_f3p));
+  slot_set_value(sc->rec_slot1, recur_swap(sc, oprec_if_a_a_opa_la_laq(sc)));
+  set_car(sc->t3_2, oprec_if_a_a_opa_la_laq(sc));
+  set_car(sc->t3_3, recur_pop(sc));
+  set_car(sc->t3_1, recur_pop(sc));
+  return(sc->rec_fn(sc, sc->t3_1));
+}
+
+static s7_pointer oprec_if_a_opa_la_laq_a(s7_scheme *sc)
+{
+  if (sc->rec_testf(sc, sc->rec_testp) == sc->F) return(sc->rec_resf(sc, sc->rec_resp));
+  recur_push(sc, sc->rec_f1f(sc, sc->rec_f1p));
+  recur_push(sc, sc->rec_f2f(sc, sc->rec_f2p));
+  slot_set_value(sc->rec_slot1, sc->rec_f3f(sc, sc->rec_f3p));
+  slot_set_value(sc->rec_slot1, recur_swap(sc, oprec_if_a_opa_la_laq_a(sc)));
+  set_car(sc->t3_2, oprec_if_a_opa_la_laq_a(sc));
+  set_car(sc->t3_3, recur_pop(sc));
+  set_car(sc->t3_1, recur_pop(sc));
+  return(sc->rec_fn(sc, sc->t3_1));
+}
+
+static s7_pointer op_recur_if_a_a_opa_la_laq(s7_scheme *sc)
+{
+  opinit_if_a_a_opa_la_laq(sc, true);
+  return(oprec_if_a_a_opa_la_laq(sc));
+}
+
+static s7_pointer op_recur_if_a_opa_la_laq_a(s7_scheme *sc)
+{
+  opinit_if_a_a_opa_la_laq(sc, false);
+  return(oprec_if_a_opa_la_laq_a(sc));
+}
+
+/* -------- if_a_a_opla_la_laq -------- */
+static void opinit_if_a_a_opla_la_laq(s7_scheme *sc, bool a_op)
+{
+  s7_pointer caller = opt3_pair(sc->code);
+  rec_set_test(sc, cdr(sc->code));
+  rec_set_res(sc, (a_op) ?  cddr(sc->code) : cdddr(sc->code));
+  rec_set_f1(sc, cdadr(caller));
+  rec_set_f2(sc, cdaddr(caller));
+  rec_set_f3(sc, cdr(opt3_pair(caller)));
+  sc->rec_slot1 = let_slots(sc->curlet);
+  sc->rec_fn = fn_proc(caller);
+}
+
+static s7_pointer oprec_if_a_a_opla_la_laq(s7_scheme *sc)
+{
+  if (sc->rec_testf(sc, sc->rec_testp) != sc->F) return(sc->rec_resf(sc, sc->rec_resp));
+  recur_push(sc, sc->rec_f1f(sc, sc->rec_f1p));
+  recur_push(sc, sc->rec_f2f(sc, sc->rec_f2p));
+  slot_set_value(sc->rec_slot1, sc->rec_f3f(sc, sc->rec_f3p));
+  slot_set_value(sc->rec_slot1, recur_swap(sc, oprec_if_a_a_opla_la_laq(sc)));
+  recur_push(sc, oprec_if_a_a_opla_la_laq(sc));
+  slot_set_value(sc->rec_slot1, recur_ref(sc, 3));
+  set_car(sc->t3_1, oprec_if_a_a_opla_la_laq(sc));
+  set_car(sc->t3_2, recur_pop(sc));
+  set_car(sc->t3_3, recur_pop2(sc));
+  return(sc->rec_fn(sc, sc->t3_1));
+}
+
+static s7_pointer op_recur_if_a_a_opla_la_laq(s7_scheme *sc)
+{
+  opinit_if_a_a_opla_la_laq(sc, true);
+  return(oprec_if_a_a_opla_la_laq(sc));
+}
+
+/* -------- if_a_a_lopl3a_l3a_l3aq(s7_scheme *sc) --------
+ * esteemed reader, please ignore this nonsense!
+ *  The opt_info version was not a lot faster -- ~/old/tak-st.c: say 10% faster. The current fx-based
+ *  version has immediate lookups, and since the data is (ahem) simple, the GC is not a factor.
+ *  The opt version has its own overheads, and has to do the same amount of stack manipulations.
+ */
+static s7_pointer rec_x(s7_scheme *sc, s7_pointer code) {return(slot_value(sc->rec_slot1));}
+static s7_pointer rec_y(s7_scheme *sc, s7_pointer code) {return(slot_value(sc->rec_slot2));}
+static s7_pointer rec_z(s7_scheme *sc, s7_pointer code) {return(slot_value(sc->rec_slot3));}
+static s7_pointer rec_sub_z1(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer x = slot_value(sc->rec_slot3);
+  return((is_t_integer(x)) ? make_integer(sc, integer(x) - 1) : minus_c1(sc, x));
+}
+
+static void opinit_if_a_a_lopl3a_l3a_l3aq(s7_scheme *sc)
+{
+  s7_pointer caller = opt3_pair(sc->code);
+  s7_pointer la1 = cadr(caller);
+  s7_pointer la2 = caddr(caller);
+  s7_pointer la3 = opt3_pair(caller);
+  rec_set_test(sc, cdr(sc->code));
+  rec_set_res(sc, cddr(sc->code));
+  rec_set_f1(sc, cdr(la1));
+  rec_set_f2(sc, cddr(la1));
+  if (sc->rec_f2f == fx_u) sc->rec_f2f = rec_y;
+  rec_set_f3(sc, cdddr(la1));
+  rec_set_f4(sc, cdr(la2));
+  rec_set_f5(sc, cddr(la2));
+  rec_set_f6(sc, cdddr(la2));
+  if (sc->rec_f6f == fx_t) sc->rec_f6f = rec_x;
+
+  sc->rec_f7p = cdr(la3);
+  sc->rec_f7f = fx_proc(sc->rec_f7p);
+  sc->rec_f7p = car(sc->rec_f7p);
+
+  sc->rec_f8p = cddr(la3);
+  sc->rec_f8f = fx_proc(sc->rec_f8p);
+  if (sc->rec_f8f == fx_t) sc->rec_f8f = rec_x;
+  sc->rec_f8p = car(sc->rec_f8p);
+
+  sc->rec_f9p = cdddr(la3);
+  sc->rec_f9f = fx_proc(sc->rec_f9p);
+  if (sc->rec_f9f == fx_u) sc->rec_f9f = rec_y;
+  sc->rec_f9p = car(sc->rec_f9p);
+
+  sc->rec_slot1 = let_slots(sc->curlet);
+  sc->rec_slot2 = next_slot(sc->rec_slot1);
+  sc->rec_slot3 = next_slot(sc->rec_slot2);
+  if (cadddr(la1) == slot_symbol(sc->rec_slot3)) sc->rec_f3f = rec_z;
+  if (caddr(la2) == slot_symbol(sc->rec_slot3)) sc->rec_f5f = rec_z;
+  if ((sc->rec_f7f == fx_subtract_s1) && (cadadr(la3) == slot_symbol(sc->rec_slot3))) sc->rec_f7f = rec_sub_z1;
+}
+
+static s7_pointer oprec_if_a_a_lopl3a_l3a_l3aq(s7_scheme *sc)
+{
+  if (sc->rec_testf(sc, sc->rec_testp) != sc->F) return(sc->rec_resf(sc, sc->rec_resp));
+  recur_push(sc, sc->rec_f1f(sc, sc->rec_f1p));
+  recur_push(sc, sc->rec_f2f(sc, sc->rec_f2p));
+  recur_push(sc, sc->rec_f3f(sc, sc->rec_f3p));
+  recur_push(sc, sc->rec_f4f(sc, sc->rec_f4p));
+  recur_push(sc, sc->rec_f5f(sc, sc->rec_f5p));
+  recur_push(sc, sc->rec_f6f(sc, sc->rec_f6p));
+  recur_push(sc, sc->rec_f7f(sc, sc->rec_f7p));
+  recur_push(sc, sc->rec_f8f(sc, sc->rec_f8p));
+  slot_set_value(sc->rec_slot3, sc->rec_f9f(sc, sc->rec_f9p));
+  slot_set_value(sc->rec_slot2, recur_pop(sc));
+  slot_set_value(sc->rec_slot1, recur_pop(sc));
+  recur_push(sc, oprec_if_a_a_lopl3a_l3a_l3aq(sc));
+  slot_set_value(sc->rec_slot3, recur_ref(sc, 2));
+  slot_set_value(sc->rec_slot2, recur_ref(sc, 3));
+  slot_set_value(sc->rec_slot1, recur_ref(sc, 4));
+  recur_push(sc, oprec_if_a_a_lopl3a_l3a_l3aq(sc));
+  slot_set_value(sc->rec_slot3, recur_ref(sc, 6));
+  slot_set_value(sc->rec_slot2, recur_ref(sc, 7));
+  slot_set_value(sc->rec_slot1, recur_ref(sc, 8));
+  slot_set_value(sc->rec_slot1, oprec_if_a_a_lopl3a_l3a_l3aq(sc));
+  slot_set_value(sc->rec_slot2, recur_pop(sc));
+  slot_set_value(sc->rec_slot3, recur_pop(sc));
+  sc->rec_loc -= 6;
+  return(oprec_if_a_a_lopl3a_l3a_l3aq(sc));
+}
+
+static s7_pointer op_recur_if_a_a_lopl3a_l3a_l3aq(s7_scheme *sc)
+{
+  opinit_if_a_a_lopl3a_l3a_l3aq(sc);
+  return(oprec_if_a_a_lopl3a_l3a_l3aq(sc));
+}
+
+/* -------- if_a_a_and_a_laa_laa -------- */
+static void opinit_if_a_a_and_a_laa_laa(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer caller = opt3_pair(code);
+  s7_pointer la1 = caddr(caller);
+  s7_pointer la2 = cadddr(caller);
+  rec_set_test(sc, cdr(code));
+  rec_set_res(sc, cddr(code));
+  rec_set_f1(sc, cdr(caller));
+  rec_set_f2(sc, cdr(la1));
+  rec_set_f3(sc, cddr(la1));
+  rec_set_f4(sc, cdr(la2));
+  rec_set_f5(sc, cddr(la2));
+  sc->rec_slot1 = let_slots(sc->curlet);
+  sc->rec_slot2 = next_slot(sc->rec_slot1);
+}
+
+static s7_pointer oprec_if_a_a_and_a_laa_laa(s7_scheme *sc)
+{
+  if (sc->rec_testf(sc, sc->rec_testp) != sc->F) return(sc->rec_resf(sc, sc->rec_resp));
+  if (sc->rec_f1f(sc, sc->rec_f1p) == sc->F) return(sc->F);
+  recur_push(sc, slot_value(sc->rec_slot1));
+  recur_push(sc, slot_value(sc->rec_slot2));
+  recur_push(sc, sc->rec_f2f(sc, sc->rec_f2p));
+  slot_set_value(sc->rec_slot2, sc->rec_f3f(sc, sc->rec_f3p));
+  slot_set_value(sc->rec_slot1, recur_pop(sc));
+  if (oprec_if_a_a_and_a_laa_laa(sc) == sc->F)
+    {
+      sc->rec_loc -= 2;
+      return(sc->F);
+    }
+  slot_set_value(sc->rec_slot2, recur_pop(sc));
+  slot_set_value(sc->rec_slot1, recur_pop(sc));
+  recur_push(sc, sc->rec_f4f(sc, sc->rec_f4p));
+  slot_set_value(sc->rec_slot2, sc->rec_f5f(sc, sc->rec_f5p));
+  slot_set_value(sc->rec_slot1, recur_pop(sc));
+  return(oprec_if_a_a_and_a_laa_laa(sc));
+}
+
+static s7_pointer op_recur_if_a_a_and_a_laa_laa(s7_scheme *sc)
+{
+  opinit_if_a_a_and_a_laa_laa(sc, sc->code);
+  return(oprec_if_a_a_and_a_laa_laa(sc));
+}
+
+static s7_pointer fx_recur_if_a_a_and_a_laa_laa(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_RECUR_IF_A_A_AND_A_LAA_LAA);
+  /* sc->curlet is set already and will be restored by the caller */
+  sc->rec_stack = recur_make_stack(sc);
+  opinit_if_a_a_and_a_laa_laa(sc, arg);
+  sc->value = oprec_if_a_a_and_a_laa_laa(sc);
+  sc->rec_loc = 0;
+  return(sc->value);
+}
+
+/* -------- cond_a_a_a_a_opla_laq -------- */
+static void opinit_cond_a_a_a_a_opla_laq(s7_scheme *sc, s7_pointer code, bool cond_case)
+{
+  s7_pointer caller = opt3_pair(code);
+  if (cond_case)
+    {
+      rec_set_test(sc, cadr(code));
+      rec_set_res(sc, cdadr(code));
+      rec_set_f1(sc, caddr(code));
+      rec_set_f2(sc, cdaddr(code));
+    }
+  else
+    {
+      rec_set_test(sc, cdr(code));
+      rec_set_res(sc, cddr(code));       /* (if a b...) */
+      rec_set_f1(sc, opt1_pair(code));   /* cdr(cadddr(code)), (if a b (if c d...)) */
+      rec_set_f2(sc, cdr(opt1_pair(code)));
+    }
+  rec_set_f3(sc, cdadr(caller));
+  rec_set_f4(sc, opt3_pair(caller));
+  sc->rec_slot1 = let_slots(sc->curlet);
+  sc->rec_fn = fn_proc(caller);
+}
+
+static inline s7_pointer oprec_cond_a_a_a_a_opla_laq(s7_scheme *sc) /* inline = 27 in trec */
+{
+  if (sc->rec_testf(sc, sc->rec_testp) != sc->F) return(sc->rec_resf(sc, sc->rec_resp));
+  if (sc->rec_f1f(sc, sc->rec_f1p) != sc->F) return(sc->rec_f2f(sc, sc->rec_f2p));
+  recur_push(sc, sc->rec_f3f(sc, sc->rec_f3p));
+  slot_set_value(sc->rec_slot1, sc->rec_f4f(sc, sc->rec_f4p));
+  slot_set_value(sc->rec_slot1, recur_swap(sc, oprec_cond_a_a_a_a_opla_laq(sc)));
+  set_car(sc->t2_1, oprec_cond_a_a_a_a_opla_laq(sc));
+  set_car(sc->t2_2, recur_pop(sc));
+  return(sc->rec_fn(sc, sc->t2_1));
+}
+
+static s7_pointer op_recur_cond_a_a_a_a_opla_laq(s7_scheme *sc)
+{
+  opinit_cond_a_a_a_a_opla_laq(sc, sc->code, true);
+  return(oprec_cond_a_a_a_a_opla_laq(sc));
+}
+
+static s7_pointer op_recur_if_a_a_if_a_a_opla_laq(s7_scheme *sc)
+{
+  opinit_cond_a_a_a_a_opla_laq(sc, sc->code, false);
+  return(oprec_cond_a_a_a_a_opla_laq(sc));
+}
+
+static s7_pointer fx_recur_cond_a_a_a_a_opla_laq(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_RECUR_COND_A_A_A_A_opLA_LAq);
+  sc->rec_stack = recur_make_stack(sc);
+  opinit_cond_a_a_a_a_opla_laq(sc, arg, true);
+  sc->value = oprec_cond_a_a_a_a_opla_laq(sc);
+  sc->rec_loc = 0;
+  return(sc->value);
+}
+
+
+/* -------- cond_a_a_a_a_oplaa_laaq -------- */
+static void opinit_cond_a_a_a_a_oplaa_laaq(s7_scheme *sc, bool cond_case)
+{
+  s7_pointer caller = opt3_pair(sc->code);             /* cadr(cadddr(sc->code)) = (cfunc laa laa) */
+  if (cond_case)
+    {
+      rec_set_test(sc, cadr(sc->code));
+      rec_set_res(sc, cdadr(sc->code));
+      rec_set_f1(sc, caddr(sc->code));
+      rec_set_f2(sc, cdaddr(sc->code));
+    }
+  else
+    {
+      rec_set_test(sc, cdr(sc->code));
+      rec_set_res(sc, cddr(sc->code));       /* (if a b...) */
+      rec_set_f1(sc, opt1_pair(sc->code));   /* cdr(cadddr(sc->code)), (if a b (if c d...)) */
+      rec_set_f2(sc, cdr(opt1_pair(sc->code)));
+    }
+  sc->rec_f3p = cdadr(caller);
+  rec_set_f4(sc, cdr(sc->rec_f3p));
+  sc->rec_f3f = fx_proc(sc->rec_f3p);
+  sc->rec_f3p = car(sc->rec_f3p);
+  sc->rec_f5p = opt3_pair(caller);
+  rec_set_f6(sc, cdr(sc->rec_f5p));
+  sc->rec_f5f = fx_proc(sc->rec_f5p);
+  sc->rec_f5p = car(sc->rec_f5p);
+  sc->rec_slot1 = let_slots(sc->curlet);
+  sc->rec_slot2 = next_slot(sc->rec_slot1);
+  sc->rec_fn = fn_proc(caller);
+}
+
+static s7_pointer oprec_cond_a_a_a_a_oplaa_laaq(s7_scheme *sc)
+{
+  if (sc->rec_testf(sc, sc->rec_testp) != sc->F) return(sc->rec_resf(sc, sc->rec_resp));
+  if (sc->rec_f1f(sc, sc->rec_f1p) != sc->F) return(sc->rec_f2f(sc, sc->rec_f2p));
+  recur_push(sc, sc->rec_f3f(sc, sc->rec_f3p));
+  recur_push(sc, sc->rec_f4f(sc, sc->rec_f4p));
+  recur_push(sc, sc->rec_f5f(sc, sc->rec_f5p));
+  slot_set_value(sc->rec_slot2, sc->rec_f6f(sc, sc->rec_f6p));
+  slot_set_value(sc->rec_slot1, recur_pop(sc));
+  sc->value = oprec_cond_a_a_a_a_oplaa_laaq(sc);        /* second laa arg */
+  slot_set_value(sc->rec_slot2, recur_pop(sc));
+  slot_set_value(sc->rec_slot1, recur_pop(sc));
+  recur_push_unchecked(sc, sc->value);
+  set_car(sc->t2_1, oprec_cond_a_a_a_a_oplaa_laaq(sc)); /* first laa arg */
+  set_car(sc->t2_2, recur_pop(sc));
+  return(sc->rec_fn(sc, sc->t2_1));
+}
+
+static s7_pointer op_recur_cond_a_a_a_a_oplaa_laaq(s7_scheme *sc)
+{
+  opinit_cond_a_a_a_a_oplaa_laaq(sc, true);
+  return(oprec_cond_a_a_a_a_oplaa_laaq(sc));
+}
+
+static s7_pointer op_recur_if_a_a_if_a_a_oplaa_laaq(s7_scheme *sc)
+{
+  opinit_cond_a_a_a_a_oplaa_laaq(sc, false);
+  return(oprec_cond_a_a_a_a_oplaa_laaq(sc));
+}
+
+
+/* -------- cond_a_a_a_a_opa_laaq -------- */
+static void opinit_cond_a_a_a_a_opa_laaq(s7_scheme *sc)
+{
+  s7_pointer caller = opt3_pair(sc->code);
+  rec_set_test(sc, cadr(sc->code));
+  rec_set_res(sc, cdadr(sc->code));
+  sc->rec_f1p = caddr(sc->code);
+  rec_set_f2(sc, cdr(sc->rec_f1p));
+  sc->rec_f1f = fx_proc(sc->rec_f1p);
+  sc->rec_f1p = car(sc->rec_f1p);
+  rec_set_f3(sc, cdr(caller));
+  rec_set_f4(sc, opt3_pair(caller));
+  rec_set_f5(sc, cdr(opt3_pair(caller)));
+  sc->rec_slot1 = let_slots(sc->curlet);
+  sc->rec_slot2 = next_slot(sc->rec_slot1);
+  sc->rec_fn = fn_proc(caller);
+}
+
+static s7_pointer oprec_cond_a_a_a_a_opa_laaq(s7_scheme *sc)
+{
+  if (sc->rec_testf(sc, sc->rec_testp) != sc->F) return(sc->rec_resf(sc, sc->rec_resp));
+  if (sc->rec_f1f(sc, sc->rec_f1p) != sc->F) return(sc->rec_f2f(sc, sc->rec_f2p));
+  recur_push(sc, sc->rec_f3f(sc, sc->rec_f3p));
+  recur_push(sc, sc->rec_f4f(sc, sc->rec_f4p));
+  slot_set_value(sc->rec_slot2, sc->rec_f5f(sc, sc->rec_f5p));
+  slot_set_value(sc->rec_slot1, recur_pop(sc));
+  set_car(sc->t2_2, oprec_cond_a_a_a_a_opa_laaq(sc));
+  set_car(sc->t2_1, recur_pop(sc));
+  return(sc->rec_fn(sc, sc->t2_1));
+}
+
+static s7_pointer op_recur_cond_a_a_a_a_opa_laaq(s7_scheme *sc)
+{
+  opinit_cond_a_a_a_a_opa_laaq(sc);
+  return(oprec_cond_a_a_a_a_opa_laaq(sc));
+}
+
+
+/* -------- cond_a_a_a_laa_opa_laaq -------- */
+static void opinit_cond_a_a_a_laa_opa_laaq(s7_scheme *sc, bool cond)
+{
+  s7_pointer caller = opt3_pair(sc->code);          /* opA_LAA */
+  rec_set_test(sc, (cond) ? cadr(sc->code) : cdr(sc->code));
+  rec_set_res(sc, (cond) ? cdadr(sc->code) : cddr(sc->code));
+  sc->rec_f1p = (cond) ? caddr(sc->code) : cdr(cadddr(sc->code));
+  sc->rec_f2p = cdadr(sc->rec_f1p);
+  rec_set_f3(sc, cdr(sc->rec_f2p));
+  sc->rec_f1f = fx_proc(sc->rec_f1p);
+  sc->rec_f1p = car(sc->rec_f1p);
+  sc->rec_f2f = fx_proc(sc->rec_f2p);
+  sc->rec_f2p = car(sc->rec_f2p);
+  rec_set_f4(sc, cdr(caller));
+  sc->rec_f5p = cdr(opt3_pair(caller));  /* (L)AA */
+  rec_set_f6(sc, cdr(sc->rec_f5p));
+  sc->rec_f5f = fx_proc(sc->rec_f5p);
+  sc->rec_f5p = car(sc->rec_f5p);
+  sc->rec_fn = fn_proc(caller);
+  sc->rec_slot1 = let_slots(sc->curlet);
+  sc->rec_slot2 = next_slot(sc->rec_slot1);
+}
+
+static s7_pointer oprec_cond_a_a_a_laa_opa_laaq(s7_scheme *sc)
+{
+  if (sc->rec_testf(sc, sc->rec_testp) != sc->F) return(sc->rec_resf(sc, sc->rec_resp));
+  if (sc->rec_f1f(sc, sc->rec_f1p) != sc->F)
+    {
+      recur_push(sc, sc->rec_f2f(sc, sc->rec_f2p));
+      slot_set_value(sc->rec_slot2, sc->rec_f3f(sc, sc->rec_f3p));
+      slot_set_value(sc->rec_slot1, recur_pop(sc));
+      return(oprec_cond_a_a_a_laa_opa_laaq(sc)); /* first laa above */
+    }
+  recur_push(sc, sc->rec_f4f(sc, sc->rec_f4p));
+  recur_push(sc, sc->rec_f5f(sc, sc->rec_f5p));
+  slot_set_value(sc->rec_slot2, sc->rec_f6f(sc, sc->rec_f6p));
+  slot_set_value(sc->rec_slot1, recur_pop(sc));
+  if (sc->rec_testf(sc, sc->rec_testp) != sc->F)
+    set_car(sc->t2_2, sc->rec_resf(sc, sc->rec_resp));
+  else
+    if (sc->rec_f1f(sc, sc->rec_f1p) != sc->F)
+      {
+	recur_push(sc, sc->rec_f2f(sc, sc->rec_f2p));
+	slot_set_value(sc->rec_slot2, sc->rec_f3f(sc, sc->rec_f3p));
+	slot_set_value(sc->rec_slot1, recur_pop(sc));
+	set_car(sc->t2_2, oprec_cond_a_a_a_laa_opa_laaq(sc)); /* first laa above */
+      }
+    else
+      {
+	recur_push(sc, sc->rec_f4f(sc, sc->rec_f4p));
+	recur_push(sc, sc->rec_f5f(sc, sc->rec_f5p));
+	slot_set_value(sc->rec_slot2, sc->rec_f6f(sc, sc->rec_f6p));
+	slot_set_value(sc->rec_slot1, recur_pop(sc));
+	set_car(sc->t2_2, oprec_cond_a_a_a_laa_opa_laaq(sc));
+	set_car(sc->t2_1, recur_pop(sc));
+	set_car(sc->t2_2, sc->rec_fn(sc, sc->t2_1));
+      }
+  set_car(sc->t2_1, recur_pop(sc));
+  return(sc->rec_fn(sc, sc->t2_1));
+}
+
+static s7_pointer op_recur_cond_a_a_a_laa_opa_laaq(s7_scheme *sc)
+{
+  opinit_cond_a_a_a_laa_opa_laaq(sc, true);
+  return(oprec_cond_a_a_a_laa_opa_laaq(sc));
+}
+
+static s7_pointer op_recur_if_a_a_if_a_laa_opa_laaq(s7_scheme *sc) /* if version, same logic as cond above */
+{
+  opinit_cond_a_a_a_laa_opa_laaq(sc, false);
+  return(oprec_cond_a_a_a_laa_opa_laaq(sc));
+}
+
+/* -------- cond_a_a_a_laa_lopa_laaq -------- */
+
+static opt_pid_t opinit_cond_a_a_a_laa_lopa_laaq(s7_scheme *sc)
+{
+  s7_pointer caller = opt3_pair(sc->code);
+  sc->rec_slot1 = let_slots(sc->curlet);
+  sc->rec_slot2 = next_slot(sc->rec_slot1);
+
+#if (!WITH_GMP)
+  if ((is_t_integer(slot_value(sc->rec_slot1))) &&
+      (is_t_integer(slot_value(sc->rec_slot2))))
+    {
+      sc->pc = 0;
+      sc->rec_test_o = sc->opts[0];
+      if (bool_optimize(sc, cadr(sc->code)))
+	{
+	  sc->rec_result_o = sc->opts[sc->pc];
+	  if (int_optimize(sc, cdadr(sc->code)))
+	    {
+	      s7_pointer laa1 = caddr(sc->code);
+	      sc->rec_a1_o = sc->opts[sc->pc];
+	      if (bool_optimize(sc, laa1))
+		{
+		  sc->rec_a2_o = sc->opts[sc->pc];
+	  	  if (int_optimize(sc, cdadr(laa1)))
+		    {
+		      sc->rec_a3_o = sc->opts[sc->pc];
+		      if (int_optimize(sc, cddadr(laa1)))
+			{
+			  s7_pointer laa2 = cadr(cadddr(sc->code)), laa3 = caddr(laa2);
+			  sc->rec_a4_o = sc->opts[sc->pc];
+			  if (int_optimize(sc, cdr(laa2)))
+			    {
+			      sc->rec_a5_o = sc->opts[sc->pc];
+			      if (int_optimize(sc, cdr(laa3)))
+				{
+				  sc->rec_a6_o = sc->opts[sc->pc];
+				  if (int_optimize(sc, cddr(laa3)))
+				    {
+				      sc->rec_val1 = make_mutable_integer(sc, integer(slot_value(sc->rec_slot1)));
+				      slot_set_value(sc->rec_slot1, sc->rec_val1);
+				      sc->rec_val2 = make_mutable_integer(sc, integer(slot_value(sc->rec_slot2)));
+				      slot_set_value(sc->rec_slot2, sc->rec_val2);
+				      if (sc->pc != 8)
+					return(OPT_INT);
+				      sc->rec_fb1 = sc->rec_test_o->v[0].fb;
+				      sc->rec_fb2 = sc->rec_a1_o->v[0].fb;
+				      sc->rec_fi1 = sc->rec_result_o->v[0].fi;
+				      sc->rec_fi2 = sc->rec_a2_o->v[0].fi;
+				      sc->rec_fi3 = sc->rec_a3_o->v[0].fi;
+				      sc->rec_fi4 = sc->rec_a4_o->v[0].fi;
+				      sc->rec_fi5 = sc->rec_a5_o->v[0].fi;
+				      sc->rec_fi6 = sc->rec_a6_o->v[0].fi;
+				      return(OPT_INT_0);
+				    }}}}}}}}}
+#endif
+  rec_set_test(sc, cadr(sc->code));
+  rec_set_res(sc, cdadr(sc->code));
+  sc->rec_f1p = caddr(sc->code);
+  sc->rec_f2p = cdadr(sc->rec_f1p);
+  rec_set_f3(sc, cdr(sc->rec_f2p));
+  sc->rec_f1f = fx_proc(sc->rec_f1p);
+  sc->rec_f1p = car(sc->rec_f1p);
+  sc->rec_f2f = fx_proc(sc->rec_f2p);
+  sc->rec_f2p = car(sc->rec_f2p);
+  rec_set_f4(sc, cdr(caller));
+  sc->rec_f5p = opt3_pair(caller);
+  rec_set_f6(sc, cdr(sc->rec_f5p));
+  sc->rec_f5f = fx_proc(sc->rec_f5p);
+  sc->rec_f5p = car(sc->rec_f5p);
+  return(OPT_PTR);
+}
+
+static s7_int oprec_i_cond_a_a_a_laa_lopa_laaq(s7_scheme *sc)
+{
+  s7_int i1, i2;
+  if (sc->rec_test_o->v[0].fb(sc->rec_test_o)) return(sc->rec_result_o->v[0].fi(sc->rec_result_o));
+  if (sc->rec_a1_o->v[0].fb(sc->rec_a1_o))
+    {
+      i1 = sc->rec_a2_o->v[0].fi(sc->rec_a2_o);
+      set_integer(sc->rec_val2, sc->rec_a3_o->v[0].fi(sc->rec_a3_o));
+      set_integer(sc->rec_val1, i1);
+      return(oprec_i_cond_a_a_a_laa_lopa_laaq(sc));
+    }
+  i1 = sc->rec_a4_o->v[0].fi(sc->rec_a4_o);
+  i2 = sc->rec_a5_o->v[0].fi(sc->rec_a5_o);
+  set_integer(sc->rec_val2, sc->rec_a6_o->v[0].fi(sc->rec_a6_o));
+  set_integer(sc->rec_val1, i2);
+  set_integer(sc->rec_val2, oprec_i_cond_a_a_a_laa_lopa_laaq(sc));
+  set_integer(sc->rec_val1, i1);
+  return(oprec_i_cond_a_a_a_laa_lopa_laaq(sc));
+}
+
+static s7_int oprec_i_cond_a_a_a_laa_lopa_laaq_0(s7_scheme *sc)
+{
+  s7_int i1, i2;
+  if (sc->rec_fb1(sc->rec_test_o)) return(sc->rec_fi1(sc->rec_result_o));
+  if (sc->rec_fb2(sc->rec_a1_o))
+    {
+      i1 = sc->rec_fi2(sc->rec_a2_o);
+      set_integer(sc->rec_val2, sc->rec_fi3(sc->rec_a3_o));
+      set_integer(sc->rec_val1, i1);
+      return(oprec_i_cond_a_a_a_laa_lopa_laaq_0(sc));
+    }
+  i1 = sc->rec_fi4(sc->rec_a4_o);
+  i2 = sc->rec_fi5(sc->rec_a5_o);
+  set_integer(sc->rec_val2, sc->rec_fi6(sc->rec_a6_o));
+  set_integer(sc->rec_val1, i2);
+  set_integer(sc->rec_val2, oprec_i_cond_a_a_a_laa_lopa_laaq_0(sc));
+  set_integer(sc->rec_val1, i1);
+  return(oprec_i_cond_a_a_a_laa_lopa_laaq_0(sc));
+}
+
+static s7_pointer oprec_cond_a_a_a_laa_lopa_laaq(s7_scheme *sc)
+{
+  if (sc->rec_testf(sc, sc->rec_testp) != sc->F) return(sc->rec_resf(sc, sc->rec_resp));
+  if (sc->rec_f1f(sc, sc->rec_f1p) != sc->F)
+    {
+      recur_push(sc, sc->rec_f2f(sc, sc->rec_f2p));
+      slot_set_value(sc->rec_slot2, sc->rec_f3f(sc, sc->rec_f3p));
+      slot_set_value(sc->rec_slot1, recur_pop(sc));
+      return(oprec_cond_a_a_a_laa_lopa_laaq(sc));
+    }
+  recur_push(sc, sc->rec_f4f(sc, sc->rec_f4p));
+  recur_push(sc, sc->rec_f5f(sc, sc->rec_f5p));
+  slot_set_value(sc->rec_slot2, sc->rec_f6f(sc, sc->rec_f6p));
+  slot_set_value(sc->rec_slot1, recur_pop(sc));
+  slot_set_value(sc->rec_slot2, oprec_cond_a_a_a_laa_lopa_laaq(sc));
+  slot_set_value(sc->rec_slot1, recur_pop(sc));
+  return(oprec_cond_a_a_a_laa_lopa_laaq(sc));
+}
+
+static void wrap_recur_cond_a_a_a_laa_lopa_laaq(s7_scheme *sc)
+{
+  opt_pid_t choice = opinit_cond_a_a_a_laa_lopa_laaq(sc);
+  tick_tc(sc, sc->cur_op);
+  if (choice != OPT_PTR)
+    sc->value = make_integer(sc, (choice == OPT_INT) ? oprec_i_cond_a_a_a_laa_lopa_laaq(sc) : oprec_i_cond_a_a_a_laa_lopa_laaq_0(sc));
+  else
+    {
+      sc->rec_stack = recur_make_stack(sc);
+      sc->value = oprec_cond_a_a_a_laa_lopa_laaq(sc);
+      sc->rec_loc = 0;
+    }
+}
+
+/* -------- and_a_or_a_laa_laa -------- */
+static void opinit_and_a_or_a_laa_laa(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer orp = cdr(opt3_pair(code));
+  rec_set_test(sc, cdr(code));
+  rec_set_res(sc, orp);
+  rec_set_f1(sc, cdr(cadr(orp)));
+  rec_set_f2(sc, cddr(cadr(orp)));
+  rec_set_f3(sc, cdr(caddr(orp)));
+  rec_set_f4(sc, cddr(caddr(orp)));
+  sc->rec_slot1 = let_slots(sc->curlet);
+  sc->rec_slot2 = next_slot(sc->rec_slot1);
+}
+
+static s7_pointer oprec_and_a_or_a_laa_laa(s7_scheme *sc)
+{
+  s7_pointer p;
+  if (sc->rec_testf(sc, sc->rec_testp) == sc->F) return(sc->F);
+  p = sc->rec_resf(sc, sc->rec_resp);
+  if (p != sc->F) return(p);
+  recur_push(sc, slot_value(sc->rec_slot1));
+  recur_push(sc, slot_value(sc->rec_slot2));
+  recur_push(sc, sc->rec_f1f(sc, sc->rec_f1p));
+  slot_set_value(sc->rec_slot2, sc->rec_f2f(sc, sc->rec_f2p));
+  slot_set_value(sc->rec_slot1, recur_pop(sc));
+  p = oprec_and_a_or_a_laa_laa(sc);
+  if (p != sc->F)
+    {
+      sc->rec_loc -= 2;
+      return(p);
+    }
+  slot_set_value(sc->rec_slot2, recur_pop(sc));
+  slot_set_value(sc->rec_slot1, recur_pop(sc));
+  recur_push(sc, sc->rec_f3f(sc, sc->rec_f3p));
+  slot_set_value(sc->rec_slot2, sc->rec_f4f(sc, sc->rec_f4p));
+  slot_set_value(sc->rec_slot1, recur_pop(sc));
+  return(oprec_and_a_or_a_laa_laa(sc));
+}
+
+static s7_pointer op_recur_and_a_or_a_laa_laa(s7_scheme *sc)
+{
+  opinit_and_a_or_a_laa_laa(sc, sc->code);
+  return(oprec_and_a_or_a_laa_laa(sc));
+}
+
+static s7_pointer fx_recur_and_a_or_a_laa_laa(s7_scheme *sc, s7_pointer arg)
+{
+  tick_tc(sc, OP_RECUR_AND_A_OR_A_LAA_LAA);
+  sc->rec_stack = recur_make_stack(sc);
+  opinit_and_a_or_a_laa_laa(sc, arg);
+  sc->value = oprec_and_a_or_a_laa_laa(sc);
+  sc->rec_loc = 0;
+  return(sc->value);
+}
+
+static void wrap_recur(s7_scheme *sc, s7_pointer (*recur)(s7_scheme *sc))
+{
+  tick_tc(sc, sc->cur_op);
+  sc->rec_stack = recur_make_stack(sc);
+  sc->value = recur(sc);
+  sc->rec_loc = 0;
+}
+
+
+/* -------------------------------- */
+static void op_safe_c_p(s7_scheme *sc)
+{
+  check_stack_size(sc);
+  push_stack_no_args_direct(sc, OP_SAFE_C_P_1);
+  sc->code = T_Pair(cadr(sc->code));
+}
+
+static void op_safe_c_p_1(s7_scheme *sc) {sc->value = fn_proc(sc->code)(sc, with_list_t1(sc->value));}
+
+static void op_safe_c_ssp(s7_scheme *sc)
+{
+  check_stack_size(sc);
+  push_stack_no_args_direct(sc, OP_SAFE_C_SSP_1);
+  sc->code = opt3_pair(sc->code);
+}
+
+static void op_safe_c_ssp_1(s7_scheme *sc)
+{
+  set_car(sc->t3_3, sc->value);
+  set_car(sc->t3_1, lookup(sc, cadr(sc->code)));
+  set_car(sc->t3_2, lookup(sc, caddr(sc->code)));
+  sc->value = fn_proc(sc->code)(sc, sc->t3_1);
+}
+
+static void op_s(s7_scheme *sc)
+{
+  sc->code = lookup(sc, car(sc->code));
+  if (!is_applicable(sc->code))
+    apply_error_nr(sc, sc->code, sc->nil);
+  sc->args = sc->nil; /* op_s -> apply, so we'll apply sc->code to sc->args */
+}
+
+static bool op_s_g(s7_scheme *sc)
+{
+  s7_pointer code = sc->code;
+  sc->code = lookup_checked(sc, car(code));
+  if ((is_c_function(sc->code)) &&
+      (c_function_min_args(sc->code) == 1) &&
+      (!needs_copied_args(sc->code)))
+    {
+      sc->value = c_function_call(sc->code)(sc, with_list_t1((is_symbol(cadr(code))) ? lookup_checked(sc, cadr(code)) : cadr(code)));
+      return(true); /* continue */
+    }
+  if (!is_applicable(sc->code))
+    apply_error_nr(sc, sc->code, cdr(code));
+  if (dont_eval_args(sc->code))
+    sc->args = cdr(code);
+  else
+    {
+      s7_pointer val = (is_symbol(cadr(code))) ? lookup_checked(sc, cadr(code)) : cadr(code);
+      sc->args = (needs_copied_args(sc->code)) ? list_1(sc, val) : set_plist_1(sc, val);
+    }
+  return(false);
+}
+
+static bool op_x_a(s7_scheme *sc, s7_pointer f)
+{
+  if ((((type(f) == T_C_FUNCTION) &&
+	(c_function_is_aritable(f, 1))) ||
+       ((type(f) == T_C_RST_NO_REQ_FUNCTION) &&
+	(c_function_max_args(f) >= 1) &&
+	(f != initial_value(sc->hash_table_symbol)) &&
+	(f != initial_value(sc->weak_hash_table_symbol)))) &&
+      (!needs_copied_args(f)))
+    {
+      sc->value = c_function_call(f)(sc, with_list_t1(fx_call(sc, cdr(sc->code))));
+      return(true);
+    }
+  if (is_any_vector(f))
+    {
+      sc->args = set_plist_1(sc, fx_call(sc, cdr(sc->code)));
+      sc->code = f;
+      apply_vector(sc);
+      return(true);
+    }
+  if (!is_applicable(f))
+    apply_error_nr(sc, f, cdr(sc->code));
+  if (dont_eval_args(f))
+    sc->args = cdr(sc->code); /* list_1(sc, cadr(sc->code)); */
+  else
+    if (!needs_copied_args(f))
+      sc->args = set_plist_1(sc, fx_call(sc, cdr(sc->code)));
+    else
+      {
+	sc->args = fx_call(sc, cdr(sc->code));
+	sc->args = list_1(sc, sc->args);
+      }
+  sc->code = f;
+  return(false); /* goto APPLY */
+}
+
+static bool op_x_sc(s7_scheme *sc, s7_pointer f)
+{
+  s7_pointer code = sc->code;
+  if (((type(f) == T_C_FUNCTION) && (c_function_is_aritable(f, 2))) ||
+      ((type(f) == T_C_RST_NO_REQ_FUNCTION) &&	(c_function_max_args(f) >= 2)))
+    { /* ((L 'abs) x 0.0001) where 'abs is '* in timp.scm */
+      if (!needs_copied_args(f))
+	{
+	  sc->value = c_function_call(f)(sc, set_plist_2(sc, lookup_checked(sc, cadr(code)), caddr(code)));
+	  return(true);
+	}
+      sc->args = list_2(sc, lookup_checked(sc, cadr(code)), caddr(code));
+      sc->code = f;
+      return(false); /* goto APPLY */
+    }
+  if (!is_applicable(f))
+    apply_error_nr(sc, f, cdr(code));
+  if (dont_eval_args(f))
+    sc->args = list_2(sc, cadr(code), caddr(code));
+  else
+    if (!needs_copied_args(f))
+      sc->args = set_plist_2(sc, lookup_checked(sc, cadr(code)), caddr(code));
+    else sc->args = list_2(sc, lookup_checked(sc, cadr(code)), caddr(code));
+  sc->code = f;
+  return(false); /* goto APPLY */
+}
+
+static bool op_x_aa(s7_scheme *sc, s7_pointer f)
+{
+  s7_pointer code = sc->code;
+  if (((type(f) == T_C_FUNCTION) && (c_function_is_aritable(f, 2))) ||
+      ((type(f) == T_C_RST_NO_REQ_FUNCTION) &&	(c_function_max_args(f) >= 2)))
+    { /* ((L 'abs) x 0.0001) where 'abs is '* in timp.scm */
+      if (!needs_copied_args(f))
+	{
+	  sc->value = c_function_call(f)(sc, with_list_t2(fx_call(sc, cdr(code)), fx_call(sc, cddr(code))));
+	  return(true);
+	}
+      sc->args = fx_call(sc, cddr(code));
+      sc->args = list_2(sc, sc->value = fx_call(sc, cdr(code)), sc->args);
+      sc->code = f;
+      return(false); /* goto APPLY */
+    }
+  if (!is_applicable(f))
+    apply_error_nr(sc, f, cdr(code));
+  if (dont_eval_args(f))
+    sc->args = list_2(sc, cadr(code), caddr(code));
+  else
+    {
+      sc->args = fx_call(sc, cddr(code));
+      if (!needs_copied_args(f))
+	sc->args = set_plist_2(sc, fx_call(sc, cdr(code)), sc->args);
+      else sc->args = list_2(sc, sc->value = fx_call(sc, cdr(code)), sc->args);
+    }
+  sc->code = f;
+  return(false); /* goto APPLY */
+}
+
+static void op_p_s_1(s7_scheme *sc)
+{
+  /* we get multiple values here (from op calc = "p" not "s") but don't need to handle it ourselves:
+   *   let v be #(#_abs), so ((v 0) -2), (v 0 -2), ((values v 0) -2), and (((values v 0)) -2) are all 2
+   *      or: (define (f1) (values vector-ref (vector 1 2 3))) (define arg 1) (define (f2) ((f1) arg)) (f2) (f2)
+   *   so apply calls apply_pair which handles multiple values explicitly.
+   */
+  if (dont_eval_args(sc->value))
+    sc->args = cdr(sc->code);
+  else
+    {
+      sc->args = lookup_checked(sc, cadr(sc->code));
+      sc->args = (needs_copied_args(sc->value)) ? list_1(sc, sc->args) : set_plist_1(sc, sc->args);
+    }
+  sc->code = sc->value; /* goto APPLY */
+}
+
+static void op_safe_c_star_na(s7_scheme *sc)
+{
+  sc->args = safe_list_if_possible(sc, opt3_arglen(cdr(sc->code)));
+  for (s7_pointer args = cdr(sc->code), p = sc->args; is_pair(args); args = cdr(args), p = cdr(p))
+    set_car(p, fx_call(sc, args));
+  sc->code = opt1_cfunc(sc->code);
+  apply_c_function_star(sc);
+  if (!in_heap(sc->args)) clear_list_in_use(sc->args);
+}
+
+static void op_safe_c_star(s7_scheme *sc)
+{
+  sc->code = opt1_cfunc(sc->code);
+  apply_c_function_star_fill_defaults(sc, 0);
+}
+
+static void op_safe_c_star_a(s7_scheme *sc)
+{
+  sc->args = fx_call(sc, cdr(sc->code));
+  if (is_symbol_and_keyword(sc->args))               /* (blocks3 (car (list :asdf))) */
+    error_nr(sc, sc->syntax_error_symbol,
+	     set_elist_4(sc, wrap_string(sc, "~A: keyword ~S, but no value: ~S", 32), car(sc->code), sc->args, sc->code));
+  /* scheme-level define* here also gives "not a parameter name" */
+  sc->args = list_1(sc, sc->args);
+  sc->code = opt1_cfunc(sc->code);
+  /* one arg, so it's not a keyword; all we need to do is fill in the defaults */
+  apply_c_function_star_fill_defaults(sc, 1);
+}
+
+static void op_safe_c_star_aa(s7_scheme *sc)
+{
+  sc->args = fx_call(sc, cdr(sc->code));
+  set_car(sc->t2_2, fx_call(sc, cddr(sc->code)));
+  set_car(sc->t2_1, sc->args);
+  sc->args = sc->t2_1;
+  sc->code = opt1_cfunc(sc->code);
+  apply_c_function_star(sc);
+}
+
+
+static void op_safe_c_ps(s7_scheme *sc)
+{
+  push_stack_no_args_direct(sc, OP_SAFE_C_PS_1); /* got to wait in this case */
+  sc->code = cadr(sc->code);
+}
+
+static void op_safe_c_ps_1(s7_scheme *sc)
+{
+  set_car(sc->t2_2, lookup(sc, caddr(sc->code)));
+  set_car(sc->t2_1, sc->value);
+  sc->value = fn_proc(sc->code)(sc, sc->t2_1);
+}
+
+static void op_safe_c_sp(s7_scheme *sc)
+{
+  s7_pointer args = cdr(sc->code);
+  check_stack_size(sc);
+  push_stack(sc, (opcode_t)T_Op(opt1_any(args)), lookup(sc, car(args)), sc->code);
+  sc->code = cadr(args);
+}
+
+static void op_safe_c_sp_1(s7_scheme *sc)
+{
+  /* we get here from many places (op_safe_c_sp for example), but all are safe */
+  sc->value = fn_proc(sc->code)(sc, with_list_t2(sc->args, sc->value));
+}
+
+static void op_safe_add_sp_1(s7_scheme *sc)
+{
+  if ((is_t_integer(sc->args)) && (is_t_integer(sc->value)))
+    sc->value = add_if_overflow_to_real_or_big_integer(sc, integer(sc->args), integer(sc->value));
+  else sc->value = add_p_pp(sc, sc->args, sc->value);
+}
+
+static void op_safe_multiply_sp_1(s7_scheme *sc)
+{
+  if ((is_t_real(sc->args)) && (is_t_real(sc->value)))
+    sc->value = make_real(sc, real(sc->args) * real(sc->value));
+  else sc->value = multiply_p_pp(sc, sc->args, sc->value);
+}
+
+static void op_safe_c_pc(s7_scheme *sc)
+{
+  s7_pointer args = cdr(sc->code);
+  check_stack_size(sc); /* b dyn */
+  push_stack(sc, OP_SAFE_C_PC_1, opt3_con(args), sc->code);
+  sc->code = car(args);
+}
+
+static void op_safe_c_pc_1(s7_scheme *sc) {sc->value = fn_proc(sc->code)(sc, with_list_t2(sc->value, sc->args));}
+
+static void op_safe_c_cp(s7_scheme *sc)
+{
+  s7_pointer args = cdr(sc->code);
+  /* it's possible in a case like this to overflow the stack -- s7test has a deeply
+   *   nested expression involving (+ c (+ c (+ ... ))) all opt'd as safe_c_cp -- if we're close
+   *   to the stack end at the start, it runs off the end.  Normally the stack increase in
+   *   the reader protects us, but a call/cc can replace the original stack with a much smaller one.
+   */
+  check_stack_size(sc);
+  push_stack(sc, (opcode_t)T_Op(opt1_any(args)), opt3_any(args), sc->code); /* to safe_add_sp_1 for example */
+  sc->code = cadr(args);
+}
+
+static Inline void inline_op_safe_c_s(s7_scheme *sc) /* called twice in eval c/cl_s many hits */
+{
+  sc->value = fn_proc(sc->code)(sc, with_list_t1(lookup(sc, cadr(sc->code))));
+}
+/* if op_safe_c_t added and set in fx_tree_in, we get a few hits, but nothing significant.
+ *   if that had worked, it would be interesting to set opt1(cdr) to the fx_tree fx_proc, (init to fx_c_s), then call that here.
+ *   opt1(cdr) is not used here, opt3_byte happens a few times, but opt2_direct clobbers opt2_fx sometimes
+ *   (also need fx_annotate cdr(expr) in optimize_c_function_one_arg)
+ */
+
+static Inline void inline_op_safe_c_ss(s7_scheme *sc) /* called twice in eval c/cl_ss many hits */
+{
+  sc->value = fn_proc(sc->code)(sc, with_list_t2(lookup(sc, cadr(sc->code)), lookup(sc, opt2_sym(cdr(sc->code)))));
+}
+
+static void op_safe_c_sc(s7_scheme *sc)
+{
+  sc->value = fn_proc(sc->code)(sc, with_list_t2(lookup(sc, cadr(sc->code)), opt2_con(cdr(sc->code))));
+}
+
+static void op_cl_a(s7_scheme *sc) {sc->value = fn_proc(sc->code)(sc, with_list_t1(fx_call(sc, cdr(sc->code))));}
+
+static inline void op_cl_aa(s7_scheme *sc)
+{
+  gc_protect_via_stack(sc, fx_call(sc, cdr(sc->code)));
+  set_car(sc->t2_2, fx_call(sc, cddr(sc->code)));
+  set_car(sc->t2_1, T_Ext(gc_protected1(sc)));
+  unstack_gc_protect(sc);
+  sc->value = fn_proc(sc->code)(sc, sc->t2_1);
+}
+
+static void op_cl_fa(s7_scheme *sc)
+{
+  s7_pointer code = cdadr(sc->code);
+  set_car(sc->t2_2, fx_call(sc, cddr(sc->code)));
+  set_car(sc->t2_1, make_closure_gc_checked(sc, car(code), cdr(code), T_CLOSURE | ((!s7_is_proper_list(sc, car(sc->code))) ? T_COPY_ARGS : 0), CLOSURE_ARITY_NOT_SET));
+  /* arg1 lambda can be any arity, but it must be applicable to one arg (the "a" above) */
+  /* was checking is_symbol(car(sc->code) i.e. is arglist a symbol, but we need T_COPY_ARGS if arglist is '(a . b) as well (can this happen here?) */
+  sc->value = fn_proc(sc->code)(sc, sc->t2_1);
+}
+
+static inline void op_map_for_each_fa(s7_scheme *sc)
+{
+  s7_pointer f = cddr(sc->code), code = sc->code;
+  sc->value = fx_call(sc, f);
+  if (is_null(sc->value))
+    sc->value = (fn_proc_unchecked(code)) ? sc->unspecified : sc->nil;
+  else
+    {
+      sc->code = opt3_pair(code); /* cdadr(code); */
+      f = make_closure_gc_checked(sc, car(sc->code), cdr(sc->code), T_CLOSURE, 1); /* arity=1 checked in optimizer */
+      sc->value = (fn_proc_unchecked(code)) ? g_for_each_closure(sc, f, sc->value) : g_map_closure(sc, f, sc->value);
+    }
+}
+
+static void op_map_for_each_faa(s7_scheme *sc)
+{
+  s7_pointer f = cddr(sc->code), code = sc->code;
+  sc->value = fx_call(sc, f);
+  sc->args = fx_call(sc, cdr(f));
+  if ((is_null(sc->value)) || (is_null(sc->args)))
+    sc->value = (fn_proc_unchecked(code)) ? sc->unspecified : sc->nil;
+  else
+    {
+      sc->code = opt3_pair(code); /* cdadr(code); */
+      f = make_closure_gc_checked(sc, car(sc->code), cdr(sc->code), T_CLOSURE, 2); /* arity=2 checked in optimizer */
+      sc->value = (fn_proc_unchecked(code)) ? g_for_each_closure_2(sc, f, sc->value, sc->args) : g_map_closure_2(sc, f, sc->value, sc->args);
+    }
+}
+
+static void op_cl_na(s7_scheme *sc)
+{
+  s7_pointer val = safe_list_if_possible(sc, opt3_arglen(cdr(sc->code)));
+  if (in_heap(val)) gc_protect_via_stack(sc, val);
+  for (s7_pointer args = cdr(sc->code), p = val; is_pair(args); args = cdr(args), p = cdr(p))
+    set_car(p, fx_call(sc, args));
+  sc->value = fn_proc(sc->code)(sc, val);
+  if (!in_heap(val))
+    clear_list_in_use(val);
+  else
+    /* the fn_proc call might push its own op (e.g. for-each/map) so we have to check for that */
+    if (stack_top_op(sc) == OP_GC_PROTECT) unstack_gc_protect(sc);
+}
+
+static void op_cl_sas(s7_scheme *sc)
+{
+  set_car(sc->t3_2, fx_call(sc, cddr(sc->code)));
+  set_car(sc->t3_1, lookup(sc, cadr(sc->code)));
+  set_car(sc->t3_3, lookup(sc, cadddr(sc->code)));
+  sc->value = fn_proc(sc->code)(sc, sc->t3_1);
+}
+
+static inline void op_safe_c_pp(s7_scheme *sc)
+{
+  s7_pointer args = cdr(sc->code);
+  check_stack_size(sc);
+  push_stack_no_args_direct(sc, OP_SAFE_C_PP_1); /* first arg = p, if mv -> op_safe_c_pp_3 */
+  sc->code = car(args);
+}
+
+static void op_safe_c_pp_1(s7_scheme *sc)
+{
+  push_stack(sc, (opcode_t)T_Op(opt1_any(cdr(sc->code))), sc->value, sc->code); /* args[i.e. sc->value] = first value, func(args, value) if no mv */
+  sc->code = caddr(sc->code);
+}
+
+static void op_safe_c_pp_3_mv(s7_scheme *sc)
+{
+  /* we get here if the first arg returned multiple values */
+  push_stack(sc, OP_SAFE_C_PP_5, copy_proper_list(sc, sc->value), sc->code); /* copy is needed here */
+  sc->code = caddr(sc->code);
+}
+
+static void op_safe_c_pp_5(s7_scheme *sc)
+{
+  /* 1 mv, 2 normal (else mv->6), sc->args was copied above (and this is a safe c function so its args are in no danger) */
+  if (is_null(sc->args))
+    sc->args = list_1(sc, sc->value); /* plist here and below, but this is almost never called */
+  else
+    {
+      s7_pointer p;
+      for (p = sc->args; is_pair(cdr(p)); p = cdr(p));
+      set_cdr(p, list_1(sc, sc->value));
+    }
+  sc->code = c_function_base(opt1_cfunc(sc->code));
+  if (type(sc->code) == T_C_FUNCTION)
+    sc->value = apply_c_function_unopt(sc, sc->code, sc->args);
+  else apply_c_rst_no_req_function(sc);
+}
+
+static void op_safe_c_3p(s7_scheme *sc)
+{
+  check_stack_size(sc);
+  push_stack_no_args_direct(sc, OP_SAFE_C_3P_1);
+  sc->code = cadr(sc->code);
+}
+
+static void op_safe_c_3p_1(s7_scheme *sc)
+{
+  sc->args = sc->value;                      /* possibly fx/gx? and below */
+  push_stack_direct(sc, OP_SAFE_C_3P_2);
+  sc->code = caddr(sc->code);
+}
+
+static void op_safe_c_3p_1_mv(s7_scheme *sc) /* here only if sc->value is mv */
+{
+  sc->args = sc->value;
+  push_stack_direct(sc, OP_SAFE_C_3P_2_MV);
+  sc->code = caddr(sc->code);
+}
+
+static void op_safe_c_3p_2(s7_scheme *sc)
+{
+  gc_protect_via_stack(sc, sc->value);
+  check_stack_size(sc);
+  push_stack_direct(sc, OP_SAFE_C_3P_3);
+  sc->code = cadddr(sc->code);
+}
+
+static void op_safe_c_3p_2_mv(s7_scheme *sc) /* here from 1 + 2mv, or 1_mv with 2 or 2mv */
+{
+  gc_protect_via_stack(sc, sc->value);
+  push_stack_direct(sc, OP_SAFE_C_3P_3_MV);
+  sc->code = cadddr(sc->code);
+}
+
+static void op_safe_c_3p_3(s7_scheme *sc)
+{
+  set_car(sc->t3_3, sc->value);
+  set_car(sc->t3_1, sc->args);
+  set_car(sc->t3_2, gc_protected1(sc));
+  unstack_gc_protect(sc);
+  sc->value = fn_proc(sc->code)(sc, sc->t3_1);
+}
+
+static void op_safe_c_3p_3_mv(s7_scheme *sc)
+{
+  s7_pointer p;
+  s7_pointer p1 = ((is_pair(sc->args)) && (car(sc->args) == sc->unused)) ? cdr(sc->args) : list_1(sc, sc->args);
+  s7_pointer ps1 = gc_protected1(sc);
+  s7_pointer p2 = ((is_pair(ps1)) && (car(ps1) == sc->unused)) ? cdr(ps1) : list_1(sc, ps1);
+  s7_pointer p3 = ((is_pair(sc->value)) && (car(sc->value) == sc->unused)) ? cdr(sc->value) : list_1(sc, sc->value);
+  unstack_gc_protect(sc);
+  for (p = p1; is_pair(cdr(p)); p = cdr(p));
+  set_cdr(p, p2);
+  for (p = cdr(p); is_pair(cdr(p)); p = cdr(p));
+  set_cdr(p, p3);
+  sc->args = p1;
+  sc->code = c_function_base(opt1_cfunc(sc->code));
+  if (type(sc->code) == T_C_FUNCTION)
+    sc->value = apply_c_function_unopt(sc, sc->code, sc->args);
+  else apply_c_rst_no_req_function(sc);
+}
+
+static Inline bool inline_collect_np_args(s7_scheme *sc, opcode_t op, s7_pointer args) /* called (all hits:)op_any_c_np_1/mv and eval, tlet (cb/set) */
+{
+  sc->args = args;
+  for (s7_pointer p = sc->code; is_pair(p); p = cdr(p))
+    if (has_fx(p))
+      sc->args = cons(sc, sc->value = fx_call(sc, p), sc->args); /* reversed before apply in OP_ANY_C_NP_1 */
+    else
+      {
+	push_stack(sc, op, sc->args, cdr(p));
+	sc->code = T_Pair(car(p));
+	return(true);
+      }
+  return(false);
+}
+
+static bool collect_np_args(s7_scheme *sc, opcode_t op, s7_pointer args) {return(inline_collect_np_args(sc, op, args));}
+
+static /* inline */ bool op_any_c_np(s7_scheme *sc) /* code: (func . args) where at least one arg is not fxable */
+{
+  sc->args = sc->nil;
+  for (s7_pointer p = cdr(sc->code); is_pair(p); p = cdr(p))
+    if (has_fx(p))
+      sc->args = cons(sc, sc->value = fx_call(sc, p), sc->args); /* reversed before apply in OP_ANY_C_NP_1 */
+    else
+      {
+	if (sc->op_stack_now >= sc->op_stack_end)
+	  resize_op_stack(sc);
+	push_op_stack(sc, sc->code);
+	check_stack_size(sc);
+	push_stack(sc, ((intptr_t)((is_pair(cdr(p))) ? OP_ANY_C_NP_1 : OP_ANY_C_NP_2)), sc->args, cdr(p));
+	sc->code = T_Pair(car(p));
+	return(true);
+      }
+  sc->args = proper_list_reverse_in_place(sc, sc->args);
+  sc->value = fn_proc(sc->code)(sc, sc->args);
+  return(false);
+}
+
+static Inline bool inline_op_any_c_np_1(s7_scheme *sc) /* called once in eval, tlet (cb/set) */
+{
+  /* in-coming sc->value has the current arg value, sc->args is all previous args, sc->code is on op-stack */
+  if (inline_collect_np_args(sc, OP_ANY_C_NP_1, cons(sc, sc->value, sc->args)))
+    return(true);
+  sc->args = proper_list_reverse_in_place(sc, sc->args);
+  sc->code = pop_op_stack(sc);
+  sc->value = fn_proc(sc->code)(sc, sc->args);
+  return(false);
+}
+
+static void op_any_c_np_2(s7_scheme *sc)
+{
+  sc->args = proper_list_reverse_in_place(sc, sc->args = cons(sc, sc->value, sc->args));
+  sc->code = pop_op_stack(sc);
+  sc->value = fn_proc(sc->code)(sc, sc->args);
+}
+
+static bool op_any_c_np_mv(s7_scheme *sc)
+{
+  /* we're looping through fp cases here, so sc->value can be non-mv after the first */
+  if (collect_np_args(sc, OP_ANY_C_NP_MV, (is_multiple_value(sc->value)) ? revappend(sc, sc->value, sc->args) : cons(sc, sc->value, sc->args)))
+    return(true);
+  sc->args = proper_list_reverse_in_place(sc, sc->args);
+  sc->code = pop_op_stack(sc);
+  sc->code = c_function_base(opt1_cfunc(sc->code));
+  return(false);
+}
+
+static void op_any_closure_np(s7_scheme *sc)
+{
+  s7_pointer p = cdr(sc->code);
+  check_stack_size(sc);
+  if (sc->op_stack_now >= sc->op_stack_end)
+    resize_op_stack(sc);
+  push_op_stack(sc, sc->code);
+  if (has_fx(p))
+    {
+      sc->args = fx_call(sc, p);
+      sc->args = list_1(sc, sc->args);
+      for (p = cdr(p); (is_pair(p)) && (has_fx(p)); p = cdr(p))
+	sc->args = cons_unchecked(sc, fx_call(sc, p), sc->args);
+    }
+  else sc->args = sc->nil;
+  push_stack(sc, ((intptr_t)((is_pair(cdr(p))) ? OP_ANY_CLOSURE_NP_1 : OP_ANY_CLOSURE_NP_2)), sc->args, cdr(p));
+  sc->code = T_Pair(car(p));
+}
+
+static void op_any_closure_np_end(s7_scheme *sc)
+{
+  s7_pointer x, z, f;
+  uint64_t id;
+
+  sc->args = proper_list_reverse_in_place(sc, sc->args); /* needed in either case -- closure_args(f) is not reversed */
+  sc->code = pop_op_stack(sc);
+  f = opt1_lambda(sc->code);
+
+  if (is_safe_closure(f))
+    {
+      id = ++sc->let_number;
+      set_curlet(sc, closure_let(f));
+      let_set_id(sc->curlet, id);
+      for (x = let_slots(sc->curlet), z = sc->args; tis_slot(x); x = next_slot(x), z = cdr(z))
+	{
+	  slot_set_value(x, car(z));
+	  symbol_set_local_slot(slot_symbol(x), id, x);
+	  /* don't free sc->args -- it might be needed in the error below */
+	}
+      if (tis_slot(x))
+	error_nr(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, not_enough_arguments_string, sc->code, sc->args));
+    }
+  else
+    {
+      s7_pointer p = closure_args(f), last_slot;
+      s7_pointer e = inline_make_let(sc, closure_let(f));
+      sc->z = e;
+      id = let_id(e);
+      last_slot = make_slot(sc, car(p), car(sc->args));
+      slot_set_next(last_slot, slot_end);
+      let_set_slots(e, last_slot);
+      symbol_set_local_slot(car(p), id, last_slot);
+      for (p = cdr(p), z = cdr(sc->args); is_pair(p); p = cdr(p), z = cdr(z))
+	last_slot = inline_add_slot_at_end(sc, id, last_slot, car(p), car(z)); /* sets last_slot, don't free sc->args -- used below */
+      set_curlet(sc, e);
+      sc->z = sc->unused;
+      if (is_pair(p))
+	error_nr(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, not_enough_arguments_string, sc->code, sc->args));
+    }
+  if (is_pair(z))  /* these checks are needed because multiple-values might evade earlier arg num checks */
+    error_nr(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, too_many_arguments_string, sc->code, sc->args));
+
+  sc->code = closure_body(f);
+  if_pair_set_up_begin(sc);
+}
+
+static bool op_safe_c_ap(s7_scheme *sc)
+{
+  s7_pointer code = cdr(sc->code);
+  s7_pointer val = cdr(code);
+  check_stack_size(sc);
+  sc->args = fx_call(sc, code);
+  push_stack_direct(sc, (opcode_t)T_Op(opt1_any(code))); /* safe_c_sp cases, mv->safe_c_sp_mv */
+  sc->code = car(val);
+  return(true);
+}
+
+static bool op_safe_c_pa(s7_scheme *sc)
+{
+  s7_pointer args = cdr(sc->code);
+  check_stack_size(sc);
+  push_stack_no_args_direct(sc, OP_SAFE_C_PA_1);
+  sc->code = car(args);
+  return(true);
+}
+
+static void op_safe_c_pa_1(s7_scheme *sc)
+{
+  sc->args = sc->value;                                /* fx* might change sc->value */
+  set_car(sc->t2_2, fx_call(sc, cddr(sc->code)));
+  set_car(sc->t2_1, sc->args);
+  sc->value = fn_proc(sc->code)(sc, sc->t2_1);
+}
+
+static void op_c_nc(s7_scheme *sc)
+{
+  if (car(sc->code) != sc->values_symbol) /* (define (f) (let ((val (catch #t (lambda () (error 1 2 3)) (lambda args (list 2 3 4))))) val)) (f) */
+    {
+      s7_pointer new_args = make_list(sc, opt3_arglen(cdr(sc->code)), sc->unused);
+      for (s7_pointer args = cdr(sc->code), p = new_args; is_pair(args); args = cdr(args), p = cdr(p)) set_car(p, car(args));
+      sc->temp3 = new_args; /* desperation? */
+      sc->value = fn_proc(sc->code)(sc, new_args);
+      sc->temp3 = sc->unused;
+    }
+  else
+    { /* opt2 = splice_in_values */
+      set_needs_copied_args(cdr(sc->code)); /* needed, see s7test, set_multiple_value which currently aborts if not a heap pointer */
+      sc->value = splice_in_values(sc, cdr(sc->code));
+    }
+}
+
+static void op_c_na(s7_scheme *sc)  /* (set-cdr! lst ()) */
+{
+  s7_pointer new_args = make_list(sc, opt3_arglen(cdr(sc->code)), sc->unused);
+  gc_protect_via_stack(sc, new_args);
+  for (s7_pointer args = cdr(sc->code), p = new_args; is_pair(args); args = cdr(args), p = cdr(p))
+    set_car(p, fx_call(sc, args));
+  unstack_gc_protect(sc);
+  sc->temp3 = new_args; /* desperation? */
+  sc->value = fn_proc(sc->code)(sc, new_args);
+  sc->temp3 = sc->unused;
+}
+
+static void op_c_a(s7_scheme *sc)
+{
+  sc->value = fx_call(sc, cdr(sc->code)); /* gc protect result before list_1 */
+  sc->args = list_1(sc, sc->value);
+  sc->value = fn_proc(sc->code)(sc, sc->args);
+}
+
+static void op_c_p(s7_scheme *sc)
+{
+  push_stack_no_args_direct(sc, OP_C_P_1);
+  sc->code = T_Pair(cadr(sc->code));
+}
+
+static inline void op_c_ss(s7_scheme *sc)
+{
+  sc->args = list_2(sc, lookup(sc, cadr(sc->code)), lookup(sc, caddr(sc->code)));
+  sc->value = fn_proc(sc->code)(sc, sc->args);
+}
+
+static void op_c_sc(s7_scheme *sc)
+{
+  sc->args = list_2(sc, lookup(sc, cadr(sc->code)), opt3_con(cdr(sc->code))); /* caddr(sc->code)) */
+  sc->value = fn_proc(sc->code)(sc, sc->args);
+}
+
+static void op_c_ap(s7_scheme *sc)
+{
+  sc->args = fx_call(sc, cdr(sc->code));
+  push_stack_direct(sc, OP_C_AP_1); /* op_c_ap_1 sends us to apply which calls check_stack_size I think */
+  sc->code = caddr(sc->code);
+}
+
+static void op_c_aa(s7_scheme *sc)
+{
+  gc_protect_via_stack(sc, fx_call(sc, cdr(sc->code)));
+  set_gc_protected2(sc, fx_call(sc, cddr(sc->code)));
+  sc->value = list_2(sc, gc_protected1(sc), gc_protected2(sc));
+  unstack_gc_protect(sc); /* fn_proc here is unsafe so clear stack first */
+  sc->value = fn_proc(sc->code)(sc, sc->value);
+}
+
+static inline void op_c_s(s7_scheme *sc)
+{
+  sc->args = list_1(sc, lookup_checked(sc, cadr(sc->code)));
+  sc->value = fn_proc(sc->code)(sc, sc->args);
+}
+
+static Inline void inline_op_apply_ss(s7_scheme *sc)  /* called once in eval, sg: all time spent in proper_list check */
+{
+  sc->args = lookup(sc, opt2_sym(sc->code));
+  if (!s7_is_proper_list(sc, sc->args))
+    error_nr(sc, sc->syntax_error_symbol, set_elist_2(sc, wrap_string(sc, "apply: improper list of arguments: ~S", 37), sc->args));
+  sc->code = lookup(sc, cadr(sc->code));              /* global search here was slower (e.g. tauto) */
+  if (needs_copied_args(sc->code))
+    sc->args = copy_proper_list(sc, sc->args);
+}
+
+static void op_apply_sa(s7_scheme *sc)
+{
+  s7_pointer p = cdr(sc->code);
+  sc->args = fx_call(sc, cdr(p));
+  if (!s7_is_proper_list(sc, sc->args))
+    error_nr(sc, sc->syntax_error_symbol, set_elist_2(sc, wrap_string(sc, "apply: improper list of arguments: ~S", 37), sc->args));
+  sc->code = lookup_global(sc, car(p));
+  if (needs_copied_args(sc->code))
+    sc->args = copy_proper_list(sc, sc->args);
+}
+
+static void op_apply_sl(s7_scheme *sc)
+{
+  s7_pointer p = cdr(sc->code);
+  sc->args = fx_call(sc, cdr(p));
+  sc->code = lookup_global(sc, car(p));
+}
+
+static bool op_pair_pair(s7_scheme *sc)
+{
+  if (!is_pair(car(sc->code))) /* (for-each (macro* (a . b) `(cons ,a ,b)) #(0 1) (list '(values +) -1)) sc->code is (-1) */
+    {
+      clear_optimize_op(sc->code);
+      return(false);
+    }
+  if (sc->stack_end >= sc->stack_resize_trigger - 8) /* -8 so the next two push_stacks don't hit the resize_trigger before we can check for cyclic code */
+    check_for_cyclic_code(sc, sc->code);         /* calls resize_stack */
+  push_stack_no_args_direct(sc, OP_EVAL_ARGS);   /* eval args goes immediately to cdr(sc->code) */
+  /* don't put check_stack_size here! */
+  push_stack_no_args(sc, OP_EVAL_ARGS, car(sc->code));
+  sc->code = caar(sc->code);
+  return(true);
+}
+
+static bool op_pair_sym(s7_scheme *sc)
+{
+  if (!is_symbol(car(sc->code)))  /* (for-each (macro* (a . b) `(cons ,a ,b)) #(0 1) (list `+ -1)) ! sc->code is (-1) */
+    {
+      clear_optimize_op(sc->code);
+      return(false);
+    }
+  sc->value = lookup_global(sc, car(sc->code));
+  return(true);
+}
+
+static void op_eval_set3(s7_scheme *sc)
+{
+  push_stack(sc, is_null(cdr(sc->code)) ? OP_EVAL_SET3_NO_MV : OP_EVAL_SET3, sc->args, cdr(sc->code));
+  sc->code = car(sc->code);
+  sc->cur_op = optimize_op(sc->code);
+}
+
+static void op_eval_set3_no_mv(s7_scheme *sc)
+{
+  sc->args = pair_append(sc, sc->args, list_1(sc, sc->value));
+  sc->code = pop_op_stack(sc);    /* args = (ind... val), code = setter */
+}
+
+static void op_eval_args2(s7_scheme *sc)
+{
+  sc->code = pop_op_stack(sc);
+  sc->args = (is_null(sc->args)) ? list_1(sc, sc->value) : proper_list_reverse_in_place(sc, cons(sc, sc->value, sc->args));
+}
+
+static void op_eval_args3(s7_scheme *sc)
+{
+  s7_pointer val = sc->code;
+  if (is_symbol(val))
+    val = lookup_checked(sc, val);
+  sc->args = proper_list_reverse_in_place(sc, cons_unchecked(sc, val, cons(sc, sc->value, sc->args)));
+  sc->code = pop_op_stack(sc);
+}
+
+static void op_eval_args5(s7_scheme *sc)      /* sc->value is the last arg, sc->code is the previous */
+{
+  sc->args = proper_list_reverse_in_place(sc, cons_unchecked(sc, sc->value, cons(sc, sc->code, sc->args)));
+  sc->code = pop_op_stack(sc);
+}
+
+static bool eval_args_no_eval_args(s7_scheme *sc)
+{
+  if (is_any_macro(sc->value))
+    {
+      if (!s7_is_proper_list(sc, cdr(sc->code)))
+	error_nr(sc, sc->syntax_error_symbol, set_elist_2(sc, wrap_string(sc, "improper list of arguments: ~S", 30), sc->code));
+      sc->args = cdr(sc->code);
+      if (is_symbol(car(sc->code))) /* not ((f p) args...) where (f p) has returned a macro, op_macro_d assumes car is a symbol */
+	{
+	  if (is_macro(sc->value))
+	    set_optimize_op(sc->code, fixup_macro_d(sc, OP_MACRO_D, sc->value));
+	  else
+	    if (is_macro_star(sc->value))
+	      set_optimize_op(sc->code, fixup_macro_d(sc, OP_MACRO_STAR_D, sc->value));
+	}
+      sc->code = sc->value;
+      return(true);
+    }
+  if (is_syntactic_pair(sc->code)) /* (define progn begin) (progn (display "hi") (+ 1 23)) */
+    sc->cur_op = optimize_op(sc->code);
+  else
+    {
+      sc->cur_op = syntax_opcode(sc->value);
+      if ((is_symbol(car(sc->code))) &&  /* don't opt pair to syntax op if sc->value is actually an arg not the op! ((write and)) should not be op_and */
+	  ((car(sc->code) == syntax_symbol(sc->value)) || (lookup_global(sc, car(sc->code)) == sc->value)))
+	pair_set_syntax_op(sc->code, sc->cur_op);
+      /* weird that sc->cur_op setting above seems ok, but OP_PAIR_PAIR hangs?? */
+    }
+  return(false);
+}
+
+static s7_pointer unbound_last_arg(s7_scheme *sc, s7_pointer car_code)
+{
+  /* save call-state before autoload/error-hook invocations */
+  s7_int loc = port_location(current_input_port(sc));
+  s7_pointer ops = op_stack_entry(sc);
+  s7_pointer args = sc->args; /* maybe GC protect? */
+  s7_pointer val = check_autoload_and_error_hook(sc, car_code);
+  if (val == sc->undefined)
+    {
+      bool probably_in_repl = ((location_to_line(loc) == 0) || (safe_strcmp("*stdin*", string_value(sc->file_names[location_to_file(loc)]))));
+      sc->w = (is_null(sc->args)) ? list_1(sc, car_code) : proper_list_reverse_in_place(sc, cons(sc, car_code, args));
+      sc->w = cons_unchecked(sc, ops, sc->w);
+      error_nr(sc, sc->unbound_variable_symbol,
+	       (probably_in_repl) ?
+	       set_elist_3(sc, wrap_string(sc, "'~S is unbound in ~S", 20), car_code, sc->w) :
+	       set_elist_5(sc, wrap_string(sc, "'~S is unbound in ~S (~A[~D])", 29), car_code, sc->w,
+			   sc->file_names[location_to_file(loc)],
+			   wrap_integer(sc, location_to_line(loc))));
+    }
+  return(val);
+}
+
+static inline void eval_last_arg(s7_scheme *sc, s7_pointer car_code) /* one call, eval 91557 */
+{
+  /* here we've reached the last arg (sc->code == nil), it is not a pair */
+  if (!is_null(cdr(sc->code)))
+    improper_arglist_error_nr(sc);
+  if (is_symbol(car_code))
+    {
+      s7_pointer val = lookup_unexamined(sc, car_code);
+      sc->code = (val) ? val : unbound_last_arg(sc, car_code);
+    }
+  else sc->code = car_code;
+  sc->args = (is_null(sc->args)) ? list_1(sc, sc->code) : proper_list_reverse_in_place(sc, cons(sc, sc->code, sc->args));
+  sc->code = pop_op_stack(sc);
+}
+
+static s7_pointer unbound_args_last_arg(s7_scheme *sc, s7_pointer car_code)
+{
+  /* save call-state before autoload/error-hook invocations */
+  s7_int loc = port_location(current_input_port(sc));
+  s7_pointer ops = op_stack_entry(sc);
+  s7_pointer args = sc->args; /* maybe GC protect? */
+  s7_pointer value = sc->value;
+  s7_pointer val = check_autoload_and_error_hook(sc, car_code);
+  if (val == sc->undefined)
+    {
+      bool probably_in_repl = ((location_to_line(loc) == 0) || (safe_strcmp("*stdin*", string_value(sc->file_names[location_to_file(loc)]))));
+      sc->w = cons(sc, value, args); /* GC protect this info */
+      sc->w = cons_unchecked(sc, car_code, sc->w);
+      sc->w = cons_unchecked(sc, ops, proper_list_reverse_in_place(sc, sc->w));
+      error_nr(sc, sc->unbound_variable_symbol,
+	       (probably_in_repl) ?
+	       set_elist_3(sc, wrap_string(sc, "'~S is unbound in ~S", 20), car_code, sc->w) :
+	       set_elist_5(sc, wrap_string(sc, "'~S is unbound in ~S (~A[~D])", 29), car_code, sc->w,
+			   sc->file_names[location_to_file(loc)], wrap_integer(sc, location_to_line(loc))));
+    }
+  return(val);
+}
+
+
+static /* inline */ bool eval_args_last_arg(s7_scheme *sc) /* inline: no diff tmisc, small diff tmac (3) */
+{
+  s7_pointer car_code = car(sc->code);  /* we're at the last arg, sc->value is the previous one, not yet saved in the args list */
+  if (is_pair(car_code))
+    {
+      if (sc->stack_end >= sc->stack_resize_trigger)
+	check_for_cyclic_code(sc, sc->code);
+      push_stack(sc, OP_EVAL_ARGS5, sc->args, sc->value);
+      sc->code = car_code;
+      return(true);
+    }
+  /* get the last arg */
+  if (is_symbol(car_code))
+    {
+      s7_pointer val = lookup_unexamined(sc, car_code);
+      sc->code = (val) ? val : unbound_args_last_arg(sc, car_code);
+    }
+  else sc->code = car_code;
+  /* get the current arg, which is not a list */
+  sc->args = proper_list_reverse_in_place(sc, cons_unchecked(sc, sc->code, cons(sc, sc->value, sc->args)));
+  sc->code = pop_op_stack(sc);
+  return(false);
+}
+
+static inline void eval_args_pair_car(s7_scheme *sc)
+{
+  s7_pointer code = cdr(sc->code);
+  if (sc->stack_end >= sc->stack_resize_trigger)
+    check_for_cyclic_code(sc, sc->code); /* calls resize_stack */
+  if (is_null(code))
+    push_stack_no_code(sc, OP_EVAL_ARGS2, sc->args);
+  else
+    {
+      if (!is_pair(code))            /* (= 0 '(1 . 2) . 3) */
+	improper_arglist_error_nr(sc);
+      if ((is_null(cdr(code))) &&
+	  (!is_pair(car(code))))
+	push_stack(sc, OP_EVAL_ARGS3, sc->args, car(code));
+      else push_stack(sc, OP_EVAL_ARGS4, sc->args, code);
+    }
+  sc->code = car(sc->code);
+}
+
+static bool eval_car_pair(s7_scheme *sc)
+{
+  s7_pointer code = sc->code, carc = car(sc->code);
+
+  /* evaluate the inner list but that list can be circular: carc: #1=(#1# #1#)! and the cycle can be well-hidden -- #1=((#1 2) . 2) and other such stuff */
+  if (sc->stack_end >= sc->stack_resize_trigger)
+    check_for_cyclic_code(sc, code);
+
+  if (is_symbol_and_syntactic(car(carc)))
+    /* was checking for is_syntactic (pair or symbol) here but that can be confused by successive optimizer passes: (define (hi) (((lambda () list)) 1 2 3)) etc */
+    {
+      if (!no_int_opt(code))
+	{
+	  /* lambda */
+	  if ((car(carc) == sc->lambda_symbol) &&                  /* ((lambda ...) expr) */
+	      (is_pair(cddr(carc))) && (s7_is_proper_list(sc, cddr(carc)))) /* not dotted! */
+	    {
+	      set_opt3_pair(code, cddr(carc));              /* lambda body */
+	      if ((is_null(cadr(carc))) && (is_null(cdr(code))))
+		{
+		  set_optimize_op(code, OP_F);    	           /* ((lambda () ...)) */
+		  return(false);
+		}
+	      if (is_pair(cadr(carc)))
+		{
+		  if ((is_normal_symbol(caadr(carc))) && (!is_constant(sc, caadr(carc))) &&
+		      (is_pair(cdr(code))) && (is_fxable(sc, cadr(code))))
+		    {
+		      set_opt3_sym(cdr(code), caadr(carc)); /* new curlet symbol #1 (first arg of lambda) */
+		      if ((is_null(cdadr(carc))) && (is_null(cddr(code))))
+			{
+			  fx_annotate_args(sc, cdr(code), sc->curlet); /* ((lambda (x) ...) expr) */
+			  set_optimize_op(code, OP_F_A);
+			  return(false);
+			}
+		      if ((is_pair(cdadr(carc))) && (is_pair(cddr(code))) && (is_fxable(sc, caddr(code))) &&
+			  (is_null(cddadr(carc))) && (is_null(cdddr(code))) &&
+			  (is_normal_symbol(cadadr(carc))) && (!is_constant(sc, cadadr(carc))) && (caadr(carc) != cadadr(carc)))
+			{
+			  fx_annotate_args(sc, cdr(code), sc->curlet);
+			  set_optimize_op(code, OP_F_AA);              /* ((lambda (x y) ...) expr exor) */
+			  return(false);
+			}}
+		  set_optimize_op(code, OP_F_NP);
+		}}
+	  set_no_int_opt(code);
+	}
+      /* ((if op1 op2) args...) is another somewhat common case */
+      push_stack_no_args(sc, OP_EVAL_ARGS, code);
+      sc->code = carc;
+      if (!no_cell_opt(carc))
+	{
+	  /* if */
+	  if ((car(carc) == sc->if_symbol) &&
+	      (is_pair(cdr(code))) &&       /* check that we got one or two args */
+	      ((is_null(cddr(code))) ||
+	       ((is_pair(cddr(code))) && (is_null(cdddr(code))))))
+	    {
+	      check_if(sc, carc);
+	      if ((fx_function[optimize_op(carc)]) &&
+		  (is_fxable(sc, cadr(code))) &&
+		  ((is_null(cddr(code))) || (is_fxable(sc, caddr(code))))) /* checked cdddr above */
+		{
+		  fx_annotate_args(sc, cdr(code), sc->curlet);
+		  set_fx_direct(code, fx_function[optimize_op(carc)]);
+		  if (is_null(cddr(code)))
+		    set_optimize_op(code, OP_A_A);
+		  else set_optimize_op(code, ((is_symbol(cadr(code))) && (!is_pair(caddr(code))) && (!is_normal_symbol(caddr(code)))) ? OP_A_SC : OP_A_AA);
+		  return(false);  /* goto eval in trailers */
+		}}
+	  set_no_cell_opt(carc);
+	}
+      sc->cur_op = (opcode_t)symbol_syntax_op_checked(sc->code);
+      pair_set_syntax_op(sc->code, sc->cur_op);
+      return(true);
+    }
+
+  push_stack_no_args(sc, OP_EVAL_ARGS, code);
+  if ((is_pair(cdr(code))) && (is_optimized(carc)))
+    {
+      if ((fx_function[optimize_op(carc)]) &&
+	  (is_fxable(sc, cadr(code))) &&
+	  ((is_null(cddr(code))) ||
+	   ((is_fxable(sc, caddr(code))) && (is_null(cdddr(code))))))
+	{
+	  fx_annotate_args(sc, cdr(code), sc->curlet);
+	  set_fx_direct(code, fx_function[optimize_op(carc)]);
+	  if (is_null(cddr(code)))
+	    set_optimize_op(code, OP_A_A);
+	  else set_optimize_op(code, ((is_symbol(cadr(code))) && (!is_pair(caddr(code))) && (!is_normal_symbol(caddr(code)))) ? OP_A_SC : OP_A_AA);
+	  sc->code = carc;
+	  return(false);  /* goto eval in trailers */
+	}
+      if ((is_null(cddr(code))) && (is_symbol(cadr(code))))
+	{
+	  set_optimize_op(code, OP_P_S);
+	  set_opt3_sym(code, cadr(code));
+	}
+      /* possible op OP_P_ALL_A runs into opt2 fx overwrites in a case like ((values set!) x 32) */
+      else set_optimize_op(code, OP_PAIR_PAIR);
+    }
+  else set_optimize_op(code, OP_PAIR_PAIR);
+  push_stack_no_args(sc, OP_EVAL_ARGS, carc);
+  sc->code = car(carc);
+  return(false);
+}
+
+static goto_t trailers(s7_scheme *sc)
+{
+  s7_pointer code = T_Ext(sc->code);
+  if (SHOW_EVAL_OPS) fprintf(stderr, "  trailers %s\n", display_truncated(code));
+  set_current_code(sc, code);
+  if (is_pair(code))
+    {
+      s7_pointer carc = T_Ext(car(code));
+      if (is_symbol(carc))
+	{
+	  /* car is a symbol, sc->code a list */
+	  if (is_syntactic_symbol(carc))
+	    {
+	      sc->cur_op = (opcode_t)symbol_syntax_op_checked(code);
+	      pair_set_syntax_op(sc->code, sc->cur_op);
+	      return(goto_top_no_pop);
+	    }
+	  sc->value = lookup_global(sc, carc);
+	  set_optimize_op(code, OP_PAIR_SYM);	  /* mostly stuff outside functions (unopt) */
+	  return(goto_eval_args_top);
+	}
+      if (is_pair(carc))                          /* ((if x y z) a b) etc */
+	return((eval_car_pair(sc)) ? goto_top_no_pop : goto_eval);
+
+      /* here we can get syntax objects like quote */
+      if (is_syntax(carc))
+	{
+	  sc->cur_op = syntax_opcode(carc);
+	  pair_set_syntax_op(sc->code, sc->cur_op);
+	  return(goto_top_no_pop);
+	}
+      /* car must be the function to be applied, or (for example) a syntax variable like quote that has been used locally */
+      set_optimize_op(code, OP_PAIR_ANY);        /* usually an error: (#\a) etc, might be (#(0) 0) */
+      sc->value = carc;
+      return(goto_eval_args_top);
+    }
+  if (is_normal_symbol(code))
+    {
+      sc->value = lookup_checked(sc, code);
+      set_optimize_op(code, OP_SYMBOL);
+    }
+  else
+    {
+      sc->value = code;
+      set_optimize_op(code, OP_CONSTANT);
+    }
+  return(goto_start);
+}
+
+
+/* ---------------- reader funcs for eval ---------------- */
+static void back_up_stack(s7_scheme *sc)
+{
+  opcode_t top_op = stack_top_op(sc);
+  if (top_op == OP_READ_DOT)
+    {
+      pop_stack(sc);
+      top_op = stack_top_op(sc);
+    }
+  if ((top_op == OP_READ_VECTOR) ||
+      (top_op == OP_READ_BYTE_VECTOR) ||
+      (top_op == OP_READ_INT_VECTOR) ||
+      (top_op == OP_READ_FLOAT_VECTOR))
+   {
+      pop_stack(sc);
+      top_op = stack_top_op(sc);
+    }
+  if (top_op == OP_READ_QUOTE)
+    pop_stack(sc);
+}
+
+static token_t read_block_comment(s7_scheme *sc, s7_pointer pt)
+{
+  /* block comments in #| ... |#
+   *   since we ignore everything until the |#, internal semicolon comments are ignored,
+   *   meaning that ;|# is as effective as |#
+   */
+  const char *str, *orig_str, *p, *pend;
+  if (is_file_port(pt))
+    {
+      char last_char = ' ';
+      while (true)
+	{
+	  int32_t c = fgetc(port_file(pt));
+	  if (c == EOF)
+	    error_nr(sc, sc->read_error_symbol,
+		     set_elist_1(sc, wrap_string(sc, "unexpected end of input while reading #|", 40)));
+	  if ((c == '#') &&
+	      (last_char == '|'))
+	    break;
+	  last_char = c;
+	  if (c == '\n')
+	    port_line_number(pt)++;
+	}
+      return(token(sc));
+    }
+  orig_str = (const char *)(port_data(pt) + port_position(pt));
+  pend = (const char *)(port_data(pt) + port_data_size(pt));
+  str = orig_str;
+  while (true)
+    {
+      p = strchr(str, (int)'|');
+      if ((!p) || (p >= pend))
+	{
+	  port_position(pt) = port_data_size(pt);
+	  error_nr(sc, sc->read_error_symbol,
+		   set_elist_1(sc, wrap_string(sc, "unexpected end of input while reading #|", 40)));
+	}
+      if (p[1] == '#')
+	break;
+      str = (const char *)(p + 1);
+    }
+  port_position(pt) += (p - orig_str + 2);
+  /* now count newlines inside the comment */
+  str = (const char *)orig_str;
+  pend = p;
+  while (true)
+    {
+      p = strchr(str, (int)'\n');
+      if ((p) && (p < pend))
+	{
+	  port_line_number(pt)++;
+	  str = (const char *)(p + 1);
+	}
+      else break;
+    }
+  return(token(sc));
+}
+
+static token_t read_excl_comment(s7_scheme *sc, s7_pointer pt)
+{
+  /* block comments in #! ... !#
+   * this is needed when an input file is treated as a script:
+       #!/home/bil/cl/snd
+       !#
+       (format #t "a test~%")
+       (exit)
+   * but very often the closing !# is omitted which is too bad
+   */
+  int32_t c;
+  char last_char = ' ';
+  /* make it possible to override #! handling */
+  for (s7_pointer reader = slot_value(sc->sharp_readers); is_pair(reader); reader = cdr(reader))
+    if (s7_character(caar(reader)) == '!')
+      {
+	sc->strbuf[0] = (unsigned char)'!';
+	return(TOKEN_SHARP_CONST); /* next stage notices any errors */
+      }
+  /* not #! as block comment (for Guile I guess) */
+  while ((c = inchar(pt)) != EOF)
+    {
+      if ((c == '#') &&
+	  (last_char == '!'))
+	break;
+      last_char = c;
+    }
+  if (c == EOF)
+    error_nr(sc, sc->read_error_symbol,
+	     set_elist_1(sc, wrap_string(sc, "unexpected end of input while reading #!", 40)));
+  return(token(sc));
+}
+
+static token_t read_sharp(s7_scheme *sc, s7_pointer pt)
+{
+  int32_t c = inchar(pt); /* inchar can return EOF, so it can't be used directly as an index into the digits array */
+  switch (c)
+    {
+    case EOF:
+      error_nr(sc, sc->read_error_symbol, set_elist_1(sc, wrap_string(sc, "unexpected '#' at end of input", 30)));
+      break;
+
+    case '(':                      /* #(...) */
+      sc->w = int_one;
+      return(TOKEN_VECTOR);
+
+    case 'i':                      /* #i(...) */
+      if (read_sharp(sc, pt) == TOKEN_VECTOR)
+	return(TOKEN_INT_VECTOR);
+      backchar('i', pt);
+      break;
+
+    case 'r':                      /* #r(...) */
+      if (read_sharp(sc, pt) == TOKEN_VECTOR)
+	return(TOKEN_FLOAT_VECTOR);
+      backchar('r', pt);
+      break;
+
+    case 'u':                      /* #u(...) or #u8(...) */
+      if (s7_peek_char(sc, pt) == chars[(int32_t)('8')]) /* backwards compatibility: #u8(...) == #u(...) */
+	{
+	  int32_t bc = inchar(pt);
+	  if (s7_peek_char(sc, pt) == chars[(int32_t)('(')])
+	    {
+	      inchar(pt);
+	      sc->w = int_one;
+	      return(TOKEN_BYTE_VECTOR);
+	    }
+	  backchar(bc, pt);
+	}
+      if (read_sharp(sc, pt) == TOKEN_VECTOR)
+	return(TOKEN_BYTE_VECTOR);
+      backchar('u', pt);
+      break;
+
+    case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9':
+      {
+	/* here we can get an overflow: #1231231231231232131D() */
+	s7_int dims = digits[c];
+	int32_t d = 0, loc = 0;
+
+	sc->strbuf[loc++] = (unsigned char)c;
+	while (true)
+	  {
+	    s7_int dig;
+	    d = inchar(pt);
+	    if (d == EOF)
+	      error_nr(sc, sc->read_error_symbol,
+		       set_elist_1(sc, wrap_string(sc, "unexpected end of input while reading #n...", 43)));
+	    dig = digits[d];
+	    if (dig >= 10) break;
+	    dims = dig + (dims * 10);
+	    if (dims <= 0)
+	      {
+		sc->strbuf[loc++] = (unsigned char)d;
+		error_nr(sc, sc->read_error_symbol,
+			 set_elist_3(sc, wrap_string(sc, "reading #~A...: ~D must be a positive integer", 45),
+				     wrap_string(sc, sc->strbuf, loc),
+				     wrap_integer(sc, dims)));
+	      }
+	    if (dims > sc->max_vector_dimensions)
+	      {
+		sc->strbuf[loc++] = (unsigned char)d;
+		sc->strbuf[loc + 1] = '\0';
+		error_nr(sc, sc->read_error_symbol,
+			 set_elist_4(sc, wrap_string(sc, "reading #~A...: ~D is too large, (*s7* 'max-vector-dimensions): ~D", 66),
+				     wrap_string(sc, sc->strbuf, loc),
+				     wrap_integer(sc, dims), wrap_integer(sc, sc->max_vector_dimensions)));
+	      }
+	    sc->strbuf[loc++] = (unsigned char)d;
+	  }
+	sc->strbuf[loc++] = d;
+	if ((d == 'd') || (d == 'i') || (d == 'r') || (d == 'u'))
+	  {
+	    int32_t e = inchar(pt);
+	    if (e == EOF)
+	      error_nr(sc, sc->read_error_symbol,
+		       set_elist_1(sc, wrap_string(sc, "unexpected end of input while reading #n()", 42)));
+	    sc->strbuf[loc++] = (unsigned char)e;
+	    if (e == '(')
+	      {
+		sc->w = make_integer(sc, dims);
+		if (d == 'd') return(TOKEN_VECTOR);
+		if (d == 'r') return(TOKEN_FLOAT_VECTOR);
+		return((d == 'u') ? TOKEN_BYTE_VECTOR : TOKEN_INT_VECTOR);
+	      }}
+	/* try to back out */
+	for (d = loc - 1; d > 0; d--)
+	  backchar(sc->strbuf[d], pt);
+      }
+      break;
+
+    case ':':  /* turn #: into : -- this is for compatibility with Guile, sigh. I just noticed that Rick is using this --
+		* I'll just leave it alone, but that means : readers need to handle this case specially.
+		*/
+      sc->strbuf[0] = ':';
+      return(TOKEN_ATOM);
+
+    case '!':  /*  I don't think #! is special anymore -- maybe remove this code? */
+      return(read_excl_comment(sc, pt));
+
+    case '|':
+      return(read_block_comment(sc, pt));
+    }
+  sc->strbuf[0] = (unsigned char)c;
+  return(TOKEN_SHARP_CONST); /* next stage notices any errors */
+}
+
+static token_t read_comma(s7_scheme *sc, s7_pointer pt)
+{
+  /* here we probably should check for symbol names that start with "@":
+         (define-macro (hi @foo) `(+ ,@foo 1)): (hi 2) -> ;foo: unbound variable
+     but (define-macro (hi .foo) `(+ ,.foo 1)): (hi 2) -> 3
+     and ambiguous: (define-macro (hi @foo . foo) `(list ,@foo))
+     what about , @foo -- is the space significant?  We accept ,@ foo. (Currently , @ says unbound variable @foo).
+  */
+  int32_t c = inchar(pt);
+  if (c == '@')
+    return(TOKEN_AT_MARK);
+  if (c == EOF)
+    {
+      sc->strbuf[0] = ',';  /* was '@' which doesn't make any sense */
+      return(TOKEN_COMMA);  /* was TOKEN_ATOM, which also doesn't seem sensible */
+    }
+  backchar(c, pt);
+  return(TOKEN_COMMA);
+}
+
+static token_t read_dot(s7_scheme *sc, s7_pointer pt)
+{
+  int32_t c = inchar(pt);
+  if (c != EOF)
+    {
+      backchar(c, pt);
+      if ((!char_ok_in_a_name[c]) && (c != 0))
+	return(TOKEN_DOT);
+    }
+  else
+    {
+      sc->strbuf[0] = '.';
+      return(TOKEN_DOT);
+    }
+  sc->strbuf[0] = '.';
+  return(TOKEN_ATOM);  /* i.e. something that can start with a dot like a number */
+}
+
+static token_t token(s7_scheme *sc) /* inline here is slower */
+{
+  int32_t c = port_read_white_space(current_input_port(sc))(sc, current_input_port(sc));
+  switch (c)
+    {
+    case '(':  return(TOKEN_LEFT_PAREN);
+    case ')':  return(TOKEN_RIGHT_PAREN);
+    case '.':  return(read_dot(sc, current_input_port(sc)));
+    case '\'': return(TOKEN_QUOTE);
+    case ';':  return(port_read_semicolon(current_input_port(sc))(sc, current_input_port(sc)));
+    case '"':  return(TOKEN_DOUBLE_QUOTE);
+    case '`':  return(TOKEN_BACK_QUOTE);
+    case ',':  return(read_comma(sc, current_input_port(sc)));
+    case '#':  return(read_sharp(sc, current_input_port(sc)));
+    case '\0':
+    case EOF:  return(TOKEN_EOF);
+    default:
+      sc->strbuf[0] = (unsigned char)c; /* every TOKEN_ATOM return goes to port_read_name, so we save a backchar/inchar shuffle by starting the read here */
+      return(TOKEN_ATOM);
+    }
+}
+
+static int32_t read_x_char(s7_scheme *sc, int32_t i, s7_pointer pt)
+{
+  /* possible "\xn...;" char (write creates these things, so we have to read them)
+   *   but we could have crazy input like "\x -- with no trailing double quote
+   */
+  for (int32_t c_ctr = 0; ; c_ctr++)
+    {
+      int32_t d1, d2, c = inchar(pt);
+      if (c == '"')                  /* "\x" -> error, "\x44" or "\x44;" -> #\D */
+	{
+	  if (c_ctr == 0)            /* "\x" */
+ 	    read_error_nr(sc, "unknown backslash usage -- perhaps you meant two backslashes?");
+	  backchar(c, pt);           /* "\x44" I think -- not sure about this -- Guile is happy but I think it contradicts r7rs.pdf */
+	  return(i);
+	}
+      if (c == ';')
+	{
+	  if (c_ctr == 0)            /* "\x;" */
+ 	    read_error_nr(sc, "unknown backslash usage -- perhaps you meant two backslashes?");
+	  return(i);                 /* "\x44;" */
+	}
+      if (c == EOF)                  /* "\x<eof> */
+	{
+	  read_error_nr(sc, "#<eof> in midst of hex-char");
+	  return(i);
+	}
+      d1 = digits[c];
+      if (d1 >= 16)                  /* "\x4H", also "\x44H" which Guile thinks is ok -- it apparently reads 2 digits and quits? */
+	{
+	  if (c_ctr == 0)
+	    read_error_nr(sc, "unknown backslash usage -- perhaps you meant two backslashes?");
+	  backchar(c, pt);
+	  return(i);
+	}
+      /* perhaps if c_ctr==0 error else backchar + return(i??) */
+
+      c = inchar(pt);
+      if (c == '"')                  /* "\x4" */
+	{
+	  sc->strbuf[i++] = (unsigned char)d1;
+	  backchar((char)c, pt);
+	  return(i);
+	}
+      if (c == ';')                  /* "\x4;" */
+	{
+	  sc->strbuf[i++] = (unsigned char)d1;
+	  return(i);
+	}
+      if (c == EOF)                  /* "\x4<eof */
+	{
+	  read_error_nr(sc, "#<eof> in midst of hex-char");
+	  return(i);
+	}
+      d2 = digits[c];
+      if (d2 >= 16)
+	{
+	  if (c_ctr == 0)
+	    read_error_nr(sc, "unknown backslash usage -- perhaps you meant two backslashes?");
+	  backchar(c, pt);
+	  return(i);
+	}
+      sc->strbuf[i++] = (unsigned char)(16 * d1 + d2);
+    }
+  return(i);
+}
+
+static s7_pointer unknown_string_constant(s7_scheme *sc, int32_t c)
+{
+  /* check *read-error-hook* */
+  if (hook_has_functions(sc->read_error_hook))
+    {
+      s7_pointer result = s7_call(sc, sc->read_error_hook, set_plist_2(sc, sc->F, chars[(uint8_t)c]));
+      if (is_character(result))
+	return(result);
+    }
+  return(sc->T);
+}
+
+static s7_pointer read_string_constant(s7_scheme *sc, s7_pointer pt)
+{
+  /* sc->F => error, no check needed here for bad input port and so on */
+  s7_int i = 0;
+
+  if (is_string_port(pt))
+    {
+      /* try the most common case first */
+      char *s, *end, *start = (char *)(port_data(pt) + port_position(pt));
+      if (*start == '"')
+	{
+	  port_position(pt)++;
+	  return(nil_string);
+	}
+      end = (char *)(port_data(pt) + port_data_size(pt));
+      s = strpbrk(start, "\"\n\\");
+      if ((!s) || (s >= end))                     /* can this read a huge string constant from a file? */
+	{
+	  if (start == end)
+	    sc->strbuf[0] = '\0';
+	  else memcpy((void *)(sc->strbuf), (void *)start, (end - start > 8) ? 8 : (end - start));
+	  sc->strbuf[8] = '\0';
+	  return(sc->F);
+	}
+      if (*s == '"')
+	{
+	  s7_int len = s - start;
+	  port_position(pt) += (len + 1);
+	  return(make_string_with_length(sc, start, len));
+	}
+      for (; s < end; s++)
+	{
+	  if (*s == '"')                         /* switch here no faster */
+	    {
+	      s7_int len = s - start;
+	      port_position(pt) += (len + 1);
+	      return(make_string_with_length(sc, start, len));
+	    }
+	  if (*s == '\\')
+	    {
+	      /* all kinds of special cases here (resultant string is not the current string), so drop to loop below (setting "i") */
+	      s7_int len = (s7_int)(s - start);
+	      if (len > 0)
+		{
+		  if (len >= sc->strbuf_size)
+		    resize_strbuf(sc, len);
+		  memcpy((void *)(sc->strbuf), (void *)(port_data(pt) + port_position(pt)), len);
+		  port_position(pt) += len;
+		}
+	      i = len;
+	      break;
+	    }
+	  else
+	    if (*s == '\n')
+	      port_line_number(pt)++;
+	}}
+
+  while (true)
+    {
+      /* splitting this check out and duplicating the loop was slower?!? */
+      int32_t c = port_read_character(pt)(sc, pt);
+      switch (c)
+	{
+	case '\n':
+	  port_line_number(pt)++;
+	  sc->strbuf[i++] = (unsigned char)c;
+	  break;
+
+	case EOF:
+	  sc->strbuf[(i > 8) ? 8 : i] = '\0';
+	  return(sc->F);
+
+	case '"':
+	  return(make_string_with_length(sc, sc->strbuf, i));
+
+	case '\\':
+	  c = inchar(pt);
+	  switch (c)
+	    {
+	    case EOF:
+	      sc->strbuf[(i > 8) ? 8 : i] = '\0';
+	      return(sc->F);
+
+	    case '\\': case '"': case '|':
+	      sc->strbuf[i++] = (unsigned char)c;
+              break;
+
+	    case 'n': sc->strbuf[i++] = '\n'; break;
+	    case 't': sc->strbuf[i++] = '\t'; break;
+	    case 'r': sc->strbuf[i++] = '\r'; break;
+	    case '/': sc->strbuf[i++] = '/';  break;
+	    case 'b': sc->strbuf[i++] = (unsigned char)8;    break;
+	    case 'f': sc->strbuf[i++] = (unsigned char)12;   break;
+
+	    case 'x':
+	      i = read_x_char(sc, i, pt);
+              break;
+
+            default:	      /* if (!is_white_space(c)) */ /* changed 8-Apr-12 */
+	      if ((c != '\n') && (c != '\r')) /* i.e. line continuation via #\\ at end of line */
+		{
+		  s7_pointer result = unknown_string_constant(sc, c);
+		  if (!is_character(result)) return(result);
+		  sc->strbuf[i++] = character(result);
+		}
+	      /* #f here would give confusing error message "end of input", so return #t=bad backslash.
+	       *     this is not optimal. It's easy to forget that backslash needs to be backslashed.
+	       * the white_space business half-implements Scheme's \<newline>...<eol>... or \<space>...<eol>...
+	       *   feature -- the characters after \ are flushed if they're all white space and include a newline.
+	       *   (string->number "1\   2") is 12??  Too bizarre.
+	       */
+	    }
+	  break;
+
+	default:
+	  sc->strbuf[i++] = (unsigned char)c;
+	  break;
+	}
+      if (i >= sc->strbuf_size)
+	resize_strbuf(sc, i);
+    }
+}
+
+static void read_double_quote(s7_scheme *sc)
+{
+  sc->value = read_string_constant(sc, current_input_port(sc));
+  if (sc->value == sc->F)                                /* can happen if input code ends in the middle of a string */
+    string_read_error_nr(sc, "end of input encountered while in a string");
+  if (sc->value == sc->T)
+    read_error_nr(sc, "unknown backslash usage -- perhaps you meant two backslashes?");
+  if (sc->safety > IMMUTABLE_VECTOR_SAFETY) set_immutable(sc->value);
+}
+
+static /* inline */ bool read_sharp_const(s7_scheme *sc) /* tread but inline makes no difference? (it's currently inlined anyway) */
+{
+  sc->value = port_read_sharp(current_input_port(sc))(sc, current_input_port(sc));
+  if (sc->value == sc->no_value)
+    {
+      /* (set! *#readers* (cons (cons #\; (lambda (s) (read) (values))) *#readers*))
+       * (+ 1 #;(* 2 3) 4)
+       * so we need to get the next token, act on it without any assumptions about read list
+       */
+      sc->tok = token(sc);
+      return(true);
+    }
+  return(false);
+}
+
+static noreturn void read_expression_read_error_nr(s7_scheme *sc)
+{
+  s7_pointer pt = current_input_port(sc);
+  pop_stack(sc);
+  if ((is_input_port(pt)) &&
+      (!port_is_closed(pt)) &&
+      (port_data(pt)) &&
+      (port_position(pt) > 0))
+    {
+      s7_pointer p = make_empty_string(sc, 128, '\0');
+      char *msg = string_value(p);
+      s7_int pos = port_position(pt);
+      s7_int start = pos - 40;
+      if (start < 0) start = 0;
+      memcpy((void *)msg, (const void *)"at \"...", 7);
+      memcpy((void *)(msg + 7), (void *)(port_data(pt) + start), pos - start);
+      memcpy((void *)(msg + 7 + pos - start), (const void *)"...", 3);
+      string_length(p) = 7 + pos - start + 3;
+      error_nr(sc, sc->read_error_symbol, set_elist_1(sc, p));
+    }
+  read_error_nr(sc, "stray comma before ')'?");         /* '("a" "b",) */
+}
+
+static s7_pointer read_expression(s7_scheme *sc)
+{
+  while (true)
+    {
+      switch (sc->tok)
+	{
+	case TOKEN_EOF:
+	  return(eof_object);
+
+	case TOKEN_BYTE_VECTOR:
+	  push_stack_no_let_no_code(sc, OP_READ_BYTE_VECTOR, sc->w);
+	  sc->tok = TOKEN_LEFT_PAREN;
+	  break;
+
+	case TOKEN_INT_VECTOR:
+	  push_stack_no_let_no_code(sc, OP_READ_INT_VECTOR, sc->w);
+	  sc->tok = TOKEN_LEFT_PAREN;
+	  break;
+
+	case TOKEN_FLOAT_VECTOR:
+	  push_stack_no_let_no_code(sc, OP_READ_FLOAT_VECTOR, sc->w); /* here sc->w (vector dimensions from read_sharp) -> sc->args */
+	  sc->tok = TOKEN_LEFT_PAREN;
+	  break;
+
+	case TOKEN_VECTOR:         /* already read #( -- TOKEN_VECTOR is triggered by #( */
+	  push_stack_no_let_no_code(sc, OP_READ_VECTOR, sc->w);  /* sc->w is the dimensions */
+	  /* fall through */
+
+	case TOKEN_LEFT_PAREN:
+	  sc->tok = token(sc);
+	  if (sc->tok == TOKEN_RIGHT_PAREN)
+	    return(sc->nil);
+	  if (sc->tok == TOKEN_DOT)
+	    {
+	      int32_t c;
+	      back_up_stack(sc);
+	      do {c = inchar(current_input_port(sc));} while ((c != ')') && (c != EOF));
+	      read_error_nr(sc, "stray dot after '('?");         /* (car '( . )) */
+	    }
+	  if (sc->tok == TOKEN_EOF)
+	    missing_close_paren_error_nr(sc);
+	  push_stack_no_let_no_code(sc, OP_READ_LIST, sc->nil);  /* here we need to clear args, but code is ignored */
+	  check_stack_size(sc);                                  /* s7test */
+	  break;
+
+	case TOKEN_QUOTE:
+	  check_stack_size(sc); /* no speed diff in tload.scm which looks like the worst case */
+	  push_stack_no_let_no_code(sc, OP_READ_QUOTE, sc->nil);
+	  sc->tok = token(sc);
+	  break;
+
+	case TOKEN_BACK_QUOTE:
+	  sc->tok = token(sc);
+	  push_stack_no_let_no_code(sc, OP_READ_QUASIQUOTE, sc->nil);
+	  break;
+
+	case TOKEN_COMMA:
+	  push_stack_no_let_no_code(sc, OP_READ_UNQUOTE, sc->nil);
+	  sc->tok = token(sc);
+	  if (sc->tok == TOKEN_RIGHT_PAREN)
+	    read_expression_read_error_nr(sc);
+	  if (sc->tok == TOKEN_EOF)
+	    {
+	      pop_stack(sc);
+	      read_error_nr(sc, "stray comma at the end of the input?");
+	    }
+	  break;
+
+	case TOKEN_AT_MARK:
+	  push_stack_no_let_no_code(sc, OP_READ_APPLY_VALUES, sc->nil);
+	  sc->tok = token(sc);
+	  break;
+
+	case TOKEN_ATOM:
+	  return(port_read_name(current_input_port(sc))(sc, current_input_port(sc)));
+	  /* If reading list (from lparen), this will finally get us to op_read_list */
+
+	case TOKEN_DOUBLE_QUOTE:
+	  read_double_quote(sc);
+	  return(sc->value);
+
+	case TOKEN_SHARP_CONST:
+	  return(port_read_sharp(current_input_port(sc))(sc, current_input_port(sc)));
+
+	case TOKEN_DOT:                                        /* (catch #t (lambda () (+ 1 . . )) (lambda args 'hiho)) */
+	  back_up_stack(sc);
+	  {int32_t c; do {c = inchar(current_input_port(sc));} while ((c != ')') && (c != EOF));}
+	  read_error_nr(sc, "stray dot in list?");             /* (+ 1 . . ) */
+
+	case TOKEN_RIGHT_PAREN:                                /* (catch #t (lambda () '(1 2 . )) (lambda args 'hiho)) */
+	  back_up_stack(sc);
+	  read_error_nr(sc, "unexpected close paren");         /* (+ 1 2)) or (+ 1 . ) */
+	}}
+  /* we never get here */
+  return(sc->nil);
+}
+
+static void read_dot_and_expression(s7_scheme *sc)
+{
+  push_stack_no_let_no_code(sc, OP_READ_DOT, sc->args);
+  sc->tok = token(sc);
+  sc->value = read_expression(sc);
+}
+
+static void read_tok_default(s7_scheme *sc)
+{
+  /* by far the main case here is TOKEN_LEFT_PAREN, but it doesn't save anything to move it to this level */
+  push_stack_no_let_no_code(sc, OP_READ_LIST, sc->args);
+  sc->value = read_expression(sc);
+  /* check for op_read_list here and explicit pop_stack are slower */
+}
+
+static int32_t read_atom(s7_scheme *sc, s7_pointer pt)
+{
+  push_stack_no_let_no_code(sc, OP_READ_LIST, sc->args);
+  /* check_stack_size(sc); */
+  sc->value = port_read_name(pt)(sc, pt);
+  sc->args = list_1(sc, sc->value);
+  pair_set_current_input_location(sc, sc->args);
+  return(port_read_white_space(pt)(sc, pt));
+}
+
+static /* inline */ int32_t read_start_list(s7_scheme *sc, s7_pointer pt, int32_t c)
+{
+  sc->strbuf[0] = (unsigned char)c;
+  push_stack_no_let_no_code(sc, OP_READ_LIST, sc->args);
+  check_stack_size(sc); /* s7test */
+  sc->value = port_read_name(pt)(sc, pt);
+  sc->args = list_1(sc, sc->value);
+  pair_set_current_input_location(sc, sc->args);
+  return(port_read_white_space(pt)(sc, pt));
+}
+
+static void op_read_internal(s7_scheme *sc)
+{
+  /* if we're loading a file, and in the file we evaluate (at top-level) something like:
+   *      (set-current-input-port (open-input-file "tmp2.r5rs"))
+   *      (close-input-port (current-input-port))
+   *      ... (with no reset of input port to its original value)
+   * the load process tries to read the loaded string, but the current-input-port is now closed,
+   * and the original is inaccessible!  So we get a segfault in token.  We don't want to put
+   * a port_is_closed check there because token only rarely is in this danger.  I think this
+   * is the only place where we can be about to call token, and someone has screwed up our port.
+   */
+  if (port_is_closed(current_input_port(sc)))
+    error_nr(sc, sc->read_error_symbol, /* not read_error here because it paws through the port string which doesn't exist here */
+	     set_elist_1(sc, wrap_string(sc, (is_loader_port(current_input_port(sc))) ? "load input port is closed!" : "read input port is closed!", 26)));
+
+  sc->tok = token(sc);
+  switch (sc->tok)
+    {
+    case TOKEN_EOF:         break;
+    case TOKEN_RIGHT_PAREN: read_error_nr(sc, "unexpected close paren");
+    case TOKEN_COMMA:       read_error_nr(sc, "unexpected comma");
+    default:
+      sc->value = read_expression(sc);
+      sc->current_line = port_line_number(current_input_port(sc));  /* this info is used to track down missing close parens */
+      sc->current_file = port_filename(current_input_port(sc));
+      break;
+    }
+}
+
+static void op_read_done(s7_scheme *sc)
+{
+  pop_input_port(sc);
+  if (sc->tok == TOKEN_EOF)
+    sc->value = eof_object;
+  sc->current_file = NULL; /* this is for error handling */
+}
+
+static void op_read_s(s7_scheme *sc)
+{
+  s7_pointer port = lookup(sc, cadr(sc->code));
+  if (!is_input_port(port)) /* was also not stdin */
+    {
+      sc->value = g_read(sc, set_plist_1(sc, port));
+      return;
+    }
+  if (port_is_closed(port))  /* I guess the port_is_closed check is needed because we're going down a level below */
+    sole_arg_wrong_type_error_nr(sc, sc->read_symbol, port, an_open_input_port_string);
+
+  if (is_function_port(port))
+    {
+      sc->value = (*(port_input_function(port)))(sc, S7_READ, port);
+      if (is_multiple_value(sc->value))
+	{
+	  clear_multiple_value(sc->value);
+	  error_nr(sc, sc->bad_result_symbol, set_elist_2(sc, wrap_string(sc, "input-function-port read returned: ~S", 37), sc->value));
+	}}
+  else /* we used to check for string port at end here, but that is rarely true so checking takes up more time than it saves */
+    {
+      push_input_port(sc, port);
+      push_stack_op(sc, OP_READ_DONE); /* this stops the internal read process so we only get one form */
+      sc->tok = token(sc);
+      switch (sc->tok)
+	{
+	case TOKEN_EOF:	        return;
+	case TOKEN_RIGHT_PAREN: read_error_nr(sc, "unexpected close paren");
+	case TOKEN_COMMA:	read_error_nr(sc, "unexpected comma");
+	default:
+	  sc->value = read_expression(sc);
+	  sc->current_line = port_line_number(current_input_port(sc));  /* this info is used to track down missing close parens */
+	  sc->current_file = port_filename(current_input_port(sc));
+	}}
+}
+
+static bool op_read_quasiquote(s7_scheme *sc)
+{
+  /* this was pushed when the backquote was seen, then eventually we popped back to it */
+  sc->value = g_quasiquote_1(sc, sc->value, false);
+  /* doing quasiquote at read time means there are minor inconsistencies in various combinations or quote/' and quasiquote/`.
+   *   A quoted ` will expand but quoted quasiquote will not (` can't be redefined, but quasiquote can).  see s7test.scm for examples.
+   */
+  return(stack_top_op(sc) != OP_READ_LIST);
+}
+
+static bool pop_read_list(s7_scheme *sc)
+{
+  /* push-stack OP_READ_LIST is always no_code and op is always OP_READ_LIST (and not used), sc->curlet is apparently not needed here */
+  unstack_with(sc, OP_READ_LIST);
+  sc->args = stack_end_args(sc);
+  if (!is_null(sc->args)) return(false); /* fall into read_list where sc->args is placed at end of on-going list, sc->value */
+  sc->args = list_1(sc, sc->value);
+  pair_set_current_input_location(sc, sc->args); /* uses port_location */
+  return(true);
+}
+
+static bool op_load_return_if_eof(s7_scheme *sc)
+{
+  if (SHOW_EVAL_OPS) fprintf(stderr, "  op_load_return_if_eof: value: %s\n", display_truncated(sc->value));
+  if (sc->tok != TOKEN_EOF)
+    {
+      push_stack_op_let(sc, OP_LOAD_RETURN_IF_EOF);
+      push_stack_op_let(sc, OP_READ_INTERNAL);
+      sc->code = sc->value;
+      return(true);             /* we read an expression, now evaluate it, and return to read the next */
+    }
+  sc->current_file = NULL;
+  return(false);
+}
+
+static bool op_load_close_and_pop_if_eof(s7_scheme *sc)
+{
+  /* (load "file") in scheme: read and evaluate all exprs, then upon EOF, close current and pop input port stack */
+  if (sc->tok != TOKEN_EOF)
+    {
+      push_stack_op_let(sc, OP_LOAD_CLOSE_AND_POP_IF_EOF); /* was push args, code */
+      if ((!is_string_port(current_input_port(sc))) ||
+	  (port_position(current_input_port(sc)) < port_data_size(current_input_port(sc))))
+	push_stack_op_let(sc, OP_READ_INTERNAL);
+      else sc->tok = TOKEN_EOF;
+      sc->code = sc->value;
+      return(true);             /* we read an expression, now evaluate it, and return to read the next */
+    }
+  if ((S7_DEBUGGING) && (!is_loader_port(current_input_port(sc)))) fprintf(stderr, "%s not loading?\n", display(current_input_port(sc)));
+  /* if *#readers* func hits error, clear_loader_port might not be undone? */
+  s7_close_input_port(sc, current_input_port(sc));
+  pop_input_port(sc);
+  sc->current_file = NULL;
+  if (is_multiple_value(sc->value))                    /* (load (file)) where file returns (values "a-file" an-environment)? */
+    sc->value = splice_in_values(sc, multiple_value(sc->value));
+  return(false);
+}
+
+static bool op_read_apply_values(s7_scheme *sc)
+{
+  sc->value = list_2_unchecked(sc, sc->unquote_symbol, list_2(sc, initial_value(sc->apply_values_symbol), sc->value));
+  return(stack_top_op(sc) != OP_READ_LIST);
+}
+
+static goto_t op_read_dot(s7_scheme *sc)
+{
+  token_t c = token(sc);
+  if (c != TOKEN_RIGHT_PAREN) /* '(1 . (2) 3) -> '(1 2 3), Guile says "missing close paren" */
+    {
+      if (is_pair(sc->value))
+	{
+	  for (s7_pointer p = sc->value; is_pair(p); p = cdr(p))
+	    sc->args = cons(sc, car(p), sc->args);
+	  sc->tok = c;
+	  return(goto_read_tok);
+	}
+      back_up_stack(sc);
+      read_error_nr(sc, "stray dot?");            /* (+ 1 . 2 3) or (list . ) */
+    }
+  /* args = previously read stuff, value = thing just after the dot and before the ')':
+   *   (list 1 2 . 3) -> value: 3, args: (2 1 list), '(1 . 2) -> value: 2, args: (1)
+   * but we also get here in a lambda arg list: (lambda (a b . c) #f) -> value: c, args: (b a)
+   */
+  sc->value = any_list_reverse_in_place(sc, sc->value, sc->args);
+  return((stack_top_op(sc) == OP_READ_LIST) ? goto_pop_read_list : goto_start);
+}
+
+static bool op_read_quote(s7_scheme *sc) /* '<datum> -> (#_quote <datum) in s7, not (quote <datum>) because quote is not immutable */
+{
+  /* can't check for sc->value = sc->nil here because we want ''() to be different from '() */
+  if ((sc->safety > IMMUTABLE_VECTOR_SAFETY) &&
+      ((is_pair(sc->value)) || (is_any_vector(sc->value)) || (is_string(sc->value))))
+    set_immutable(sc->value);
+  sc->value = list_2(sc, (sc->symbol_quote) ? sc->quote_symbol : sc->quote_function, sc->value);
+  return(stack_top_op(sc) != OP_READ_LIST);
+}
+
+static bool op_read_unquote(s7_scheme *sc)
+{
+  /* here if sc->value is a constant, the unquote is pointless (should we complain?)
+   *   also currently stray "," can be ignored: (abs , 1) -- scanning the stack for quasiquote or quote seems to be unreliable
+   */
+  if ((is_pair(sc->value)) ||
+      (is_symbol(sc->value)))
+    sc->value = list_2(sc, sc->unquote_symbol, sc->value);
+  return(stack_top_op(sc) != OP_READ_LIST);
+}
+
+/* safety check is at read time, so (immutable? (let-temporarily (((*s7* 'safety) 2)) #(1 2 3))) is #f
+ *    but (immutable? (let-temporarily (((*s7* 'safety) 2)) (eval-string "#(1 2 3)"))) is #t
+ */
+static bool op_read_vector(s7_scheme *sc)
+{
+  sc->value = (sc->args == int_one) ? g_vector(sc, sc->value) : g_multivector(sc, integer(sc->args), sc->value); /* sc->args was sc->w earlier from read_sharp */
+  /* here and below all of the sc->value list can be freed, but my tests showed no speed up even in large cases */
+  if (sc->safety > IMMUTABLE_VECTOR_SAFETY) set_immutable(sc->value);
+  return(stack_top_op(sc) != OP_READ_LIST);
+}
+
+static bool op_read_int_vector(s7_scheme *sc)
+{
+  sc->value = (sc->args == int_one) ? g_int_vector(sc, sc->value) : g_int_multivector(sc, integer(sc->args), sc->value);
+  if (sc->safety > IMMUTABLE_VECTOR_SAFETY) set_immutable(sc->value);
+  return(stack_top_op(sc) != OP_READ_LIST);
+}
+
+static bool op_read_float_vector(s7_scheme *sc)
+{
+  /* sc->value is the list of values, #r(...sc->value...) */
+  sc->value = (sc->args == int_one) ? g_float_vector(sc, sc->value) : g_float_multivector(sc, integer(sc->args), sc->value);
+  if (sc->safety > IMMUTABLE_VECTOR_SAFETY) set_immutable(sc->value);
+  return(stack_top_op(sc) != OP_READ_LIST);
+
+  /* to avoid making the list: sc->floats array (growable and maybe pruned),
+   *   token_float_vector in read_expression: sc->value = unused, push op_read_float_vector
+   *   sc->args = dims (read_sharp sc->w = dims, read_expression push_op moves it to sc->args
+   *   <read each entry...>: push op_read_float_vector (no op_read_list), read, eval,
+   *   fill sc->floats, when right-paren make new vector [for multidims, get list->frame]
+   */
+}
+
+static bool op_read_byte_vector(s7_scheme *sc)
+{
+  sc->value = (sc->args == int_one) ? g_byte_vector(sc, sc->value) : g_byte_multivector(sc, integer(sc->args), sc->value);
+  if (sc->safety > IMMUTABLE_VECTOR_SAFETY) set_immutable(sc->value);
+  return(stack_top_op(sc) != OP_READ_LIST);
+}
+
+
+/* ---------------- unknown ops ---------------- */
+static bool fixup_unknown_op(s7_scheme *sc, s7_pointer code, s7_pointer func, opcode_t op)
+{
+  set_optimize_op(code, op);
+  if (is_any_closure(func))
+    set_opt1_lambda_add(code, func);   /* perhaps set_opt1_lambda_add here and throughout op_unknown* */
+  return(true);
+}
+
+static bool unknown_unknown(s7_scheme *sc, s7_pointer code, opcode_t op)
+{
+  if ((is_symbol(car(code))) &&
+      (!is_slot(s7_slot(sc, car(code)))))
+    unbound_variable_error_nr(sc, car(code));
+  set_optimize_op(code, op);
+  return(true);
+}
+
+static bool is_immutable_and_stable(s7_scheme *sc, s7_pointer func)
+{
+  if (symbol_ctr(func) != 1) /* protect against (define-constant (p) (define-constant (p) ...)) */
+    return(false);
+  if ((is_global(func)) && (is_immutable_slot(global_slot(func))))
+    return(true);
+  for (s7_pointer p = sc->curlet; p; p = let_outlet(p))
+    if ((is_funclet(p)) && (funclet_function(p) != func))
+      return(false);
+  return(is_immutable_slot(s7_slot(sc, func)));
+}
+
+static bool op_unknown(s7_scheme *sc)
+{
+  s7_pointer code = sc->code, f = sc->last_function;
+  if (!f) /* can be NULL if unbound variable */
+    unbound_variable_error_nr(sc, car(sc->code));
+  if (SHOW_EVAL_OPS) fprintf(stderr, "  %s %s %s\n", __func__, display_truncated(f), s7_type_names[type(f)]);
+
+  switch (type(f))
+    {
+    case T_CLOSURE:
+    case T_CLOSURE_STAR:
+      if (!has_methods(f))
+	{
+	  int32_t hop = (is_immutable_and_stable(sc, car(code))) ? 1 : 0;
+	  if (is_null(closure_args(f)))
+	    {
+	      s7_pointer body = closure_body(f);
+	      bool one_form = is_null(cdr(body));
+	      bool safe_case = is_safe_closure(f);
+	      set_opt1_lambda_add(code, f);
+	      if (one_form)
+		{
+		  if ((safe_case) && (is_fxable(sc, car(body))))
+		    {
+		      set_safe_closure(f);   /* safe because no args so no reference to funclet? needed because op_safe_thunk_a will check for it */
+		      fx_annotate_arg(sc, body, sc->curlet);
+		      set_safe_optimize_op(code, hop + OP_SAFE_THUNK_A);
+		      set_closure_one_form_fx_arg(f);
+		      sc->value = fx_safe_thunk_a(sc, sc->code);
+		      return(false);
+		    }
+		  clear_has_fx(code);
+		}
+	      set_safe_optimize_op(code, hop + ((safe_case) ? OP_SAFE_THUNK : ((one_form) ? OP_THUNK_O : OP_THUNK)));
+	      return(true);
+	    }
+	  if (is_closure_star(f))
+	    {
+	      set_safe_optimize_op(code, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_NA_0 : OP_CLOSURE_STAR_NA));
+	      set_opt1_lambda_add(code, f);
+	      return(true);
+	    }}
+      break;
+
+    case T_GOTO:       return(fixup_unknown_op(sc, code, f, OP_IMPLICIT_GOTO));
+    case T_ITERATOR:   return(fixup_unknown_op(sc, code, f, OP_IMPLICIT_ITERATE));
+    case T_BACRO: case T_MACRO:           return(fixup_unknown_op(sc, code, f, fixup_macro_d(sc, OP_MACRO_D, f)));
+    case T_BACRO_STAR: case T_MACRO_STAR: return(fixup_unknown_op(sc, code, f, fixup_macro_d(sc, OP_MACRO_STAR_D, f)));
+
+    default:
+      if ((is_symbol(car(code))) &&
+	  (!is_slot(s7_slot(sc, car(code)))))
+	unbound_variable_error_nr(sc, car(code));
+    }
+  return(fixup_unknown_op(sc, code, f, OP_S));
+}
+
+static bool fxify_closure_star_g(s7_scheme *sc, s7_pointer f, s7_pointer code)
+{
+  if ((!has_methods(f)) &&
+      (closure_star_arity_to_int(sc, f) != 0))
+    {
+      int32_t hop = (is_immutable_and_stable(sc, car(code))) ? 1 : 0;
+      bool safe_case = is_safe_closure(f);
+      fx_annotate_arg(sc, cdr(code), sc->curlet);
+      set_opt3_arglen(cdr(code), 1);
+      if ((safe_case) && (is_null(cdr(closure_args(f)))))
+	set_optimize_op(code, hop + OP_SAFE_CLOSURE_STAR_A1);
+      else
+	if (lambda_has_simple_defaults(f))
+	  {
+	    if (arglist_has_rest(sc, closure_args(f)))
+	      fixup_unknown_op(sc, code, f, hop + ((safe_case) ? OP_SAFE_CLOSURE_STAR_NA_1 : OP_CLOSURE_STAR_NA));
+	    else fixup_unknown_op(sc, code, f, hop + ((safe_case) ?
+						      ((is_null(cdr(closure_args(f)))) ? OP_SAFE_CLOSURE_STAR_A1 : OP_SAFE_CLOSURE_STAR_A) : OP_CLOSURE_STAR_A));
+	    return(true);
+	  }
+      fixup_unknown_op(sc, code, f, hop + ((safe_case) ? OP_SAFE_CLOSURE_STAR_NA_1 : OP_CLOSURE_STAR_NA));
+      return(true);
+    }
+  return(false);
+}
+
+static bool op_unknown_closure_s(s7_scheme *sc, s7_pointer f, s7_pointer code)
+{
+  s7_pointer body = closure_body(f);
+  bool one_form = is_null(cdr(body));
+  int32_t hop = (is_immutable_and_stable(sc, car(code))) ? 1 : 0;
+  set_opt2_sym(code, cadr(code));
+
+  /* code here might be (f x) where f is passed elsewhere as a function parameter,
+   *   first time through we look it up, find a safe-closure and optimize as (say) safe_closure_s_a,
+   *   next time it is something else, etc.  Rather than keep optimizing it locally, we need to
+   *   back out: safe_closure_s_* -> safe_closure_s -> closure_s -> op_s_g.  Ideally we'd know
+   *   this was a parameter or whatever.  The tricky case is local letrec(f) calling f which initially
+   *   thinks it is not safe, then later is set safe correctly, now outer func is called again,
+   *   this time f is safe, and we're ok from then on.
+   */
+  if (is_unknopt(code))
+    {
+      switch (op_no_hop(code))
+	{
+	case OP_CLOSURE_S:
+	  set_optimize_op(code, (is_safe_closure(f)) ? ((one_form) ? OP_SAFE_CLOSURE_S_O : OP_SAFE_CLOSURE_S) :  OP_S_G); break;
+	case OP_CLOSURE_S_O:
+	case OP_SAFE_CLOSURE_S:
+	  set_optimize_op(code, ((one_form) ? OP_CLOSURE_S_O : OP_CLOSURE_S)); break;
+	case OP_SAFE_CLOSURE_S_O:
+	case OP_SAFE_CLOSURE_S_A:
+	case OP_SAFE_CLOSURE_S_TO_S:
+	case OP_SAFE_CLOSURE_S_TO_SC:
+	  set_optimize_op(code, (is_safe_closure(f)) ?
+			  ((one_form) ? OP_SAFE_CLOSURE_S_O : OP_SAFE_CLOSURE_S) :
+			  ((one_form) ? OP_CLOSURE_S_O : OP_CLOSURE_S));
+	  break;
+	default:
+	  set_optimize_op(code, OP_S_G); break;
+	}
+      set_opt1_lambda_add(code, f);
+      return(true);
+    }
+  if (!is_safe_closure(f))
+    set_optimize_op(code, hop + ((one_form) ? OP_CLOSURE_S_O : OP_CLOSURE_S));
+  else
+    if (!is_null(cdr(body)))
+      set_safe_optimize_op(code, hop + OP_SAFE_CLOSURE_S);
+    else
+      if (is_fxable(sc, car(body)))
+	fxify_closure_s(sc, f, code, sc->curlet, hop);
+      else set_safe_optimize_op(code, hop + OP_SAFE_CLOSURE_S_O);
+  /* hop if is_constant(sc, car(code)) is not foolproof here (see t967.scm):
+   *    (define (f) (define-constant (f1) ... (f1))...) where each call on f makes a different f1
+   */
+  set_is_unknopt(code);
+  set_opt1_lambda_add(code, f);
+  return(true);
+}
+
+static bool op_unknown_s(s7_scheme *sc)
+{
+  s7_pointer code = sc->code, f = sc->last_function;
+
+  if (!f) unbound_variable_error_nr(sc, car(sc->code));
+  if (SHOW_EVAL_OPS) fprintf(stderr, "  %s %s\n", __func__, display_truncated(f));
+
+  if ((S7_DEBUGGING) && (!is_normal_symbol(cadr(code)))) fprintf(stderr, "%s[%d]: not a symbol: %s\n", __func__, __LINE__, display(code));
+  if ((!is_any_macro(f)) &&   /* if f is a macro, its argument can be unbound legitimately */
+      (!is_slot(s7_slot(sc, cadr(code)))))
+    return(unknown_unknown(sc, sc->code, (is_normal_symbol(cadr(sc->code))) ? OP_CLEAR_OPTS : OP_S_G));
+
+  if ((is_unknopt(code)) && (!is_closure(f)))
+    return(fixup_unknown_op(sc, code, f, OP_S_G));
+
+  switch (type(f))
+    {
+    case T_C_FUNCTION:
+      if (!(c_function_is_aritable(f, 1))) break;
+    case T_C_RST_NO_REQ_FUNCTION:
+      set_c_function(code, f);
+      if ((is_safe_procedure(f)) || (c_function_call(f) == s7_values))
+	{
+	  set_optimize_op(code, OP_SAFE_C_S);
+	  sc->value = fx_c_s(sc, sc->code);
+	}
+      else
+	{
+	  set_optimize_op(code, OP_C_S);
+	  op_c_s(sc);
+	}
+      return(false);
+
+    case T_CLOSURE:
+      if ((!has_methods(f)) && (closure_arity_to_int(sc, f) == 1))
+	return(op_unknown_closure_s(sc, f, code));
+      break;
+
+    case T_CLOSURE_STAR:
+      if (fxify_closure_star_g(sc, f, code)) return(true);
+      break;
+
+    case T_GOTO:
+      fx_annotate_arg(sc, cdr(code), sc->curlet);
+      set_opt3_arglen(cdr(code), 1);
+      return(fixup_unknown_op(sc, code, f, OP_IMPLICIT_GOTO_A));
+
+    case T_INT_VECTOR: case T_FLOAT_VECTOR: case T_VECTOR: case T_BYTE_VECTOR:
+      fx_annotate_arg(sc, cdr(code), sc->curlet);
+      return(fixup_unknown_op(sc, code, f, OP_IMPLICIT_VECTOR_REF_A));
+
+    case T_STRING:
+      fx_annotate_arg(sc, cdr(code), sc->curlet);
+      return(fixup_unknown_op(sc, code, f, OP_IMPLICIT_STRING_REF_A));
+
+    case T_PAIR:
+      fx_annotate_arg(sc, cdr(code), sc->curlet);
+      return(fixup_unknown_op(sc, code, f, OP_IMPLICIT_PAIR_REF_A));
+
+    case T_C_OBJECT:
+      if (s7_is_aritable(sc, f, 1))
+	{
+	  fx_annotate_arg(sc, cdr(code), sc->curlet);
+	  return(fixup_unknown_op(sc, code, f, OP_IMPLICIT_C_OBJECT_REF_A));
+	}
+      break;
+
+    case T_LET:
+      fx_annotate_arg(sc, cdr(code), sc->curlet);
+      return(fixup_unknown_op(sc, code, f, OP_IMPLICIT_LET_REF_A));
+
+    case T_HASH_TABLE:
+      fx_annotate_arg(sc, cdr(code), sc->curlet);
+      return(fixup_unknown_op(sc, code, f, OP_IMPLICIT_HASH_TABLE_REF_A));
+
+    case T_CONTINUATION:
+      fx_annotate_arg(sc, cdr(code), sc->curlet);
+      return(fixup_unknown_op(sc, code, f, OP_IMPLICIT_CONTINUATION_A));
+
+    case T_BACRO: case T_MACRO:
+      return(fixup_unknown_op(sc, code, f, fixup_macro_d(sc, OP_MACRO_D, f)));
+    case T_BACRO_STAR: case T_MACRO_STAR:
+      return(fixup_unknown_op(sc, code, f, fixup_macro_d(sc, OP_MACRO_STAR_D, f)));
+
+    default: break;
+    }
+  if ((is_symbol(car(code))) &&
+      (!is_slot(s7_slot(sc, car(code)))))
+    unbound_variable_error_nr(sc, car(code));
+  return(fixup_unknown_op(sc, code, f, OP_S_G));
+}
+
+static bool op_unknown_a(s7_scheme *sc)
+{
+  s7_pointer code = sc->code, f = sc->last_function;
+  if (!f) unbound_variable_error_nr(sc, car(sc->code));
+  if (SHOW_EVAL_OPS) fprintf(stderr, "  %s %s\n", __func__, display_truncated(f));
+
+  switch (type(f))
+    {
+    case T_C_FUNCTION:
+      if (!(c_function_is_aritable(f, 1))) break;
+    case T_C_RST_NO_REQ_FUNCTION:
+      clear_has_fx(code);
+      set_c_function(code, f);
+      if (is_safe_procedure(f))
+	{
+	  set_optimize_op(code, OP_SAFE_C_A);
+	  sc->value = fx_c_a(sc, code);
+	}
+      else
+	{
+	  set_optimize_op(code, OP_C_A);
+	  op_c_a(sc);
+	}
+      return(false);
+
+    case T_CLOSURE:
+      if ((!has_methods(f)) &&
+	  (closure_arity_to_int(sc, f) == 1))
+	{
+	  s7_pointer body = closure_body(f);
+	  bool safe_case = is_safe_closure(f);
+	  int32_t hop = (is_immutable_and_stable(sc, car(code))) ? 1 : 0;
+	  bool one_form = is_null(cdr(body));
+
+	  fxify_closure_a(sc, f, one_form, safe_case, hop, code, sc->curlet);
+	  set_opt1_lambda_add(code, f);
+	  return(true);
+	}
+      break;
+
+    case T_CLOSURE_STAR:
+      if (fxify_closure_star_g(sc, f, code)) return(true);
+      break;
+
+    case T_INT_VECTOR: case T_FLOAT_VECTOR: case T_VECTOR: case T_BYTE_VECTOR:
+      return(fixup_unknown_op(sc, code, f, OP_IMPLICIT_VECTOR_REF_A));
+
+    case T_STRING:       return(fixup_unknown_op(sc, code, f, OP_IMPLICIT_STRING_REF_A));
+    case T_PAIR:         return(fixup_unknown_op(sc, code, f, OP_IMPLICIT_PAIR_REF_A));
+    case T_C_OBJECT:     return(fixup_unknown_op(sc, code, f, OP_IMPLICIT_C_OBJECT_REF_A));
+    case T_HASH_TABLE:   return(fixup_unknown_op(sc, code, f, OP_IMPLICIT_HASH_TABLE_REF_A));
+    case T_GOTO:         return(fixup_unknown_op(sc, code, f, OP_IMPLICIT_GOTO_A));
+    case T_CONTINUATION: return(fixup_unknown_op(sc, code, f, OP_IMPLICIT_CONTINUATION_A));
+    case T_BACRO: case T_MACRO:
+      return(fixup_unknown_op(sc, code, f, fixup_macro_d(sc, OP_MACRO_D, f)));
+    case T_BACRO_STAR: case T_MACRO_STAR:
+      return(fixup_unknown_op(sc, code, f, fixup_macro_d(sc, OP_MACRO_STAR_D, f)));
+
+    case T_LET:
+      {
+	s7_pointer arg1 = cadr(code);
+	if ((is_quoted_symbol(arg1)) || (is_symbol_and_keyword(arg1)))
+	  {
+	    s7_pointer sym = (is_pair(arg1)) ? cadr(arg1) : arg1;
+	    if (is_keyword(sym)) sym = keyword_symbol(sym);
+	    set_opt3_con(code, sym);
+	    return(fixup_unknown_op(sc, code, f, OP_IMPLICIT_LET_REF_C));
+	  }
+	return(fixup_unknown_op(sc, code, f, OP_IMPLICIT_LET_REF_A)); /* "A" might be a symbol */
+      }
+
+    default: break;
+    }
+  if ((is_symbol(car(code))) &&
+      (!is_slot(s7_slot(sc, car(code)))))
+    unbound_variable_error_nr(sc, car(code));
+  return(fixup_unknown_op(sc, code, f, OP_S_A)); /* closure with methods etc */
+}
+
+static bool op_unknown_gg(s7_scheme *sc)
+{
+  bool s1, s2;
+  s7_pointer code = sc->code, f = sc->last_function;
+  if (!f) unbound_variable_error_nr(sc, car(sc->code));
+  if (SHOW_EVAL_OPS) fprintf(stderr, "  %s %s\n", __func__, display_truncated(f));
+
+  s1 = is_normal_symbol(cadr(code));
+  s2 = is_normal_symbol(caddr(code));
+
+  if ((s1) &&
+      (!is_slot(s7_slot(sc, cadr(code)))))
+    return(unknown_unknown(sc, sc->code, OP_CLEAR_OPTS));
+  if ((s2) &&
+      (!is_slot(s7_slot(sc, caddr(code)))))
+    return(unknown_unknown(sc, sc->code, OP_CLEAR_OPTS));
+
+  switch (type(f))
+    {
+    case T_C_FUNCTION:
+      if (!(c_function_is_aritable(f, 2))) break;
+    case T_C_RST_NO_REQ_FUNCTION:
+      if (is_safe_procedure(f))
+	{
+	  if (s1)
+	    {
+	      set_optimize_op(code, (s2) ? OP_SAFE_C_SS : OP_SAFE_C_SC);
+	      if (s2)
+		set_opt2_sym(cdr(code), caddr(code));
+	      else set_opt2_con(cdr(code), caddr(code));
+	    }
+	  else
+	    {
+	      set_optimize_op(code, (s2) ? OP_SAFE_C_CS : OP_SAFE_C_NC);
+	      if (s2)
+		{
+		  set_opt1_con(cdr(code), (is_pair(cadr(code))) ? cadadr(code) : cadr(code));
+		  set_opt2_sym(cdr(code), caddr(code));
+		}}}
+      else
+	{
+	  set_optimize_op(code, (is_semisafe(f)) ? OP_CL_NA : OP_C_NA);
+	  fx_annotate_args(sc, cdr(code), sc->curlet);
+	}
+      set_opt3_arglen(cdr(code), 2);
+      set_c_function(code, f);
+      return(true);
+
+    case T_CLOSURE:
+      if (has_methods(f)) break;
+      if (closure_arity_to_int(sc, f) == 2)
+	{
+	  s7_pointer body = closure_body(f);
+	  bool safe_case = is_safe_closure(f);
+	  int32_t hop = (is_immutable_and_stable(sc, car(code))) ? 1 : 0;
+	  bool one_form = is_null(cdr(body));
+
+	  if ((s1) && (s2))
+	    {
+	      set_opt2_sym(code, caddr(code));
+	      if (!one_form)
+		set_optimize_op(code, hop + ((safe_case) ? OP_SAFE_CLOSURE_SS : OP_CLOSURE_SS));
+	      else
+		if (!safe_case)
+		  set_optimize_op(code, hop + OP_CLOSURE_SS_O);
+		else
+		  if (!is_fxable(sc, car(body)))
+		    set_safe_optimize_op(code, hop + OP_SAFE_CLOSURE_SS_O);
+		  else
+		    {
+		      fx_annotate_arg(sc, body, sc->curlet);
+		      fx_tree(sc, body, car(closure_args(f)), cadr(closure_args(f)), NULL, false);
+		      set_safe_optimize_op(code, hop + OP_SAFE_CLOSURE_SS_A);
+		      set_closure_one_form_fx_arg(f);
+		    }}
+	  else
+	    if (s1)
+	      {
+		set_opt2_con(code, caddr(code));
+		if (one_form)
+		  set_safe_optimize_op(code, hop + ((safe_case) ? OP_SAFE_CLOSURE_SC_O : OP_CLOSURE_SC_O));
+		else set_optimize_op(code, hop + ((safe_case) ? OP_SAFE_CLOSURE_SC : OP_CLOSURE_SC));
+	      }
+	    else
+	      {
+		set_opt3_arglen(cdr(code), 2);
+		fx_annotate_args(sc, cdr(code), sc->curlet);
+		if (safe_case)
+		  set_safe_optimize_op(code, hop + ((one_form) ? OP_SAFE_CLOSURE_AA_O : OP_SAFE_CLOSURE_AA));
+		else set_safe_optimize_op(code, hop + ((one_form) ? OP_CLOSURE_AA_O : OP_CLOSURE_AA));
+	      }
+	  set_opt1_lambda_add(code, f);
+	  return(true);
+	}
+      break;
+
+    case T_CLOSURE_STAR:
+      if ((closure_star_arity_to_int(sc, f) != 0) &&
+	  (closure_star_arity_to_int(sc, f) != 1))
+	{
+	  fx_annotate_args(sc, cdr(code), sc->curlet);
+	  if (!has_methods(f))
+	    {
+	      fixup_closure_star_aa(sc, f, code, (is_immutable_and_stable(sc, car(code))) ? 1 : 0);
+	      set_opt1_lambda_add(code, f);
+	    }
+	  else set_optimize_op(code, OP_S_AA);
+	  return(true);
+	}
+      break;
+
+    case T_INT_VECTOR: case T_FLOAT_VECTOR: case T_VECTOR: case T_BYTE_VECTOR: case T_PAIR:
+      set_opt3_arglen(cdr(code), 2);
+      fx_annotate_args(sc, cdr(code), sc->curlet);
+      if ((!is_pair(f)) && (vector_rank(f) != 2))
+	return(fixup_unknown_op(sc, code, f, OP_S_AA));
+      return(fixup_unknown_op(sc, code, f, (is_pair(f)) ? OP_IMPLICIT_PAIR_REF_AA : OP_IMPLICIT_VECTOR_REF_AA));
+
+    case T_HASH_TABLE:
+      fx_annotate_args(sc, cdr(code), sc->curlet);
+      return(fixup_unknown_op(sc, code, f, OP_IMPLICIT_HASH_TABLE_REF_AA));
+
+    case T_BACRO: case T_MACRO:
+      return(fixup_unknown_op(sc, code, f, fixup_macro_d(sc, OP_MACRO_D, f)));
+    case T_BACRO_STAR: case T_MACRO_STAR:
+      return(fixup_unknown_op(sc, code, f, fixup_macro_d(sc, OP_MACRO_STAR_D, f)));
+
+    default: break;
+    }
+  if ((is_symbol(car(code))) &&
+      (!is_slot(s7_slot(sc, car(code)))))
+    unbound_variable_error_nr(sc, car(code));
+  fx_annotate_args(sc, cdr(code), sc->curlet);
+  return(fixup_unknown_op(sc, code, f, OP_S_AA));
+}
+
+static bool op_unknown_ns(s7_scheme *sc)
+{
+  s7_pointer code = sc->code, f = sc->last_function;
+  int32_t num_args = opt3_arglen(cdr(code));
+
+  if (!f) unbound_variable_error_nr(sc, car(sc->code));
+  if (SHOW_EVAL_OPS) fprintf(stderr, "  %s %s\n", __func__, display_truncated(f));
+
+  for (s7_pointer arg = cdr(code); is_pair(arg); arg = cdr(arg))
+    if (!is_slot(s7_slot(sc, car(arg))))
+      unbound_variable_error_nr(sc, car(arg));
+
+  switch (type(f))
+    {
+    case T_C_FUNCTION:
+      if (!(c_function_is_aritable(f, num_args))) break;
+    case T_C_RST_NO_REQ_FUNCTION:
+      if (is_safe_procedure(f))
+	{
+	  if (num_args == 3)
+	    {
+	      set_safe_optimize_op(code, OP_SAFE_C_SSS);
+	      set_opt1_sym(cdr(code), caddr(code));
+	      set_opt2_sym(cdr(code), cadddr(code));
+	    }
+	  else set_safe_optimize_op(code, OP_SAFE_C_NS);
+	}
+      else
+	{
+	  set_optimize_op(code, (is_semisafe(f)) ? OP_CL_NA : OP_C_NA);
+	  fx_annotate_args(sc, cdr(code), sc->curlet);
+	}
+      set_c_function(code, f);
+      return(true);
+
+    case T_CLOSURE:
+      if ((!has_methods(f)) &&
+	  (closure_arity_to_int(sc, f) == num_args))
+	{
+	  int32_t hop = (is_immutable_and_stable(sc, car(code))) ? 1 : 0;
+	  bool one_form = is_null(cdr(closure_body(f)));
+	  fx_annotate_args(sc, cdr(code), sc->curlet);
+	  if (num_args == 3)
+	    return(fixup_unknown_op(sc, code, f, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_3S : ((one_form) ? OP_CLOSURE_3S_O : OP_CLOSURE_3S))));
+	  if (num_args == 4)
+	    return(fixup_unknown_op(sc, code, f, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_NS : ((one_form) ? OP_CLOSURE_4S_O : OP_CLOSURE_4S))));
+	  return(fixup_unknown_op(sc, code, f, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_NS : ((num_args == 5) ? OP_CLOSURE_5S : OP_CLOSURE_NS))));
+	}
+      break;
+
+    case T_CLOSURE_STAR:
+      if ((!has_methods(f)) &&
+	  ((closure_star_arity_to_int(sc, f) < 0) || ((closure_star_arity_to_int(sc, f) * 2) >= num_args)))
+	{
+	  int32_t hop = (is_immutable_and_stable(sc, car(code))) ? 1 : 0;
+	  fx_annotate_args(sc, cdr(code), sc->curlet);
+	  if ((is_safe_closure(f)) && (num_args == 3) && (closure_star_arity_to_int(sc, f) == 3))
+	    return(fixup_unknown_op(sc, code, f, OP_SAFE_CLOSURE_STAR_3A));
+	  return(fixup_unknown_op(sc, code, f, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_NA : OP_CLOSURE_STAR_NA)));
+	}
+      break;
+
+    case T_BACRO: case T_MACRO:
+      return(fixup_unknown_op(sc, code, f, fixup_macro_d(sc, OP_MACRO_D, f)));
+    case T_BACRO_STAR: case T_MACRO_STAR:
+      return(fixup_unknown_op(sc, code, f, fixup_macro_d(sc, OP_MACRO_STAR_D, f)));
+
+      /* PERHAPS: vector, but need op_implicit_vector_ns? */
+    default: break;
+    }
+  return(unknown_unknown(sc, sc->code, OP_CLEAR_OPTS));
+}
+
+static bool op_unknown_aa(s7_scheme *sc)
+{
+  s7_pointer code = sc->code, f = sc->last_function;
+
+  if (!f) unbound_variable_error_nr(sc, car(sc->code));
+  if (SHOW_EVAL_OPS) fprintf(stderr, "  %s %s\n", __func__, display_truncated(f));
+
+  switch (type(f))
+    {
+    case T_C_FUNCTION:
+      if (!(c_function_is_aritable(f, 2))) break;
+    case T_C_RST_NO_REQ_FUNCTION:
+      if (is_safe_procedure(f)) /* why is this different from unknown_a and unknown_na? */
+	{
+	  if (!safe_c_aa_to_ag_ga(sc, code, 0))
+	    {
+	      set_safe_optimize_op(code, OP_SAFE_C_AA);
+	      set_opt3_pair(code, cddr(code));
+	    }}
+      else set_optimize_op(code, (is_semisafe(f)) ? OP_CL_NA : OP_C_NA);
+      set_c_function(code, f);
+      return(true);
+
+    case T_CLOSURE:
+      if ((!has_methods(f)) &&
+	  (closure_arity_to_int(sc, f) == 2))
+	{
+	  s7_pointer body = closure_body(f);
+	  bool safe_case = is_safe_closure(f);
+	  int32_t hop = (is_immutable_and_stable(sc, car(code))) ? 1 : 0;
+	  bool one_form = is_null(cdr(body));
+	  if (!one_form)
+	    set_safe_optimize_op(code, hop + ((safe_case) ? OP_SAFE_CLOSURE_AA : OP_CLOSURE_AA));
+	  else
+	    if (!safe_case)
+	      set_optimize_op(code, hop + OP_CLOSURE_AA_O);
+	    else
+	      if (!is_fxable(sc, car(body)))
+		set_safe_optimize_op(code, hop + OP_SAFE_CLOSURE_AA_O);
+	      else
+		{
+		  fx_annotate_arg(sc, body, sc->curlet);
+		  set_safe_optimize_op(code, hop + OP_SAFE_CLOSURE_AA_A);
+		  set_closure_one_form_fx_arg(f);
+		}
+	  if ((is_fx_treeable(cdr(code))) && (tis_slot(let_slots(sc->curlet)))) fx_curlet_tree(sc, cdr(code));
+	  set_opt1_lambda_add(code, f);
+	  return(true);
+	}
+      break;
+
+    case T_CLOSURE_STAR:
+      if (!has_methods(f))
+	{
+	  fixup_closure_star_aa(sc, f, code, (is_immutable_and_stable(sc, car(code))) ? 1 : 0);
+	  set_opt1_lambda_add(code, f);
+	}
+      else set_optimize_op(code, OP_S_AA);
+      return(true);
+
+    case T_INT_VECTOR: case T_FLOAT_VECTOR: case T_VECTOR: case T_BYTE_VECTOR:
+      if (vector_rank(f) != 2)
+	return(fixup_unknown_op(sc, code, f, OP_S_AA));
+      return(fixup_unknown_op(sc, code, f, OP_IMPLICIT_VECTOR_REF_AA));
+
+    case T_PAIR:       return(fixup_unknown_op(sc, code, f, OP_IMPLICIT_PAIR_REF_AA));
+    case T_HASH_TABLE: return(fixup_unknown_op(sc, code, f, OP_IMPLICIT_HASH_TABLE_REF_AA));
+    case T_MACRO:      return(fixup_unknown_op(sc, code, f, fixup_macro_d(sc, OP_MACRO_D, f)));
+    case T_MACRO_STAR: return(fixup_unknown_op(sc, code, f, fixup_macro_d(sc, OP_MACRO_STAR_D, f)));
+
+    default: break;
+    }
+  if ((is_symbol(car(code))) &&
+      (!is_slot(s7_slot(sc, car(code)))))
+    unbound_variable_error_nr(sc, car(code));
+  return(fixup_unknown_op(sc, code, f, OP_S_AA));
+}
+
+static bool is_normal_happy_symbol(s7_scheme *sc, s7_pointer sym)
+{
+  if (!is_normal_symbol(sym))
+    return(false);
+  if (!is_slot(s7_slot(sc, sym)))
+    unbound_variable_error_nr(sc, sym);
+  return(true);
+}
+
+static bool op_unknown_na(s7_scheme *sc)
+{
+  s7_pointer code = sc->code, f = sc->last_function;
+  int32_t num_args = (is_pair(cdr(code))) ? opt3_arglen(cdr(code)) : 0;
+
+  if (!f) unbound_variable_error_nr(sc, car(sc->code));
+  if (SHOW_EVAL_OPS) fprintf(stderr, "  %s[%d]: %s %s\n", __func__, __LINE__, display_truncated(f), display_truncated(sc->code));
+  if (num_args == 0) return(fixup_unknown_op(sc, code, f, OP_S));  /* via op_closure*-fx where original had 0 args, safe case -> op_safe_closure*_0 */
+
+  switch (type(f))
+    {
+    case T_C_FUNCTION:
+      if (!(c_function_is_aritable(f, num_args))) break;
+    case T_C_RST_NO_REQ_FUNCTION:
+      if (is_safe_procedure(f))
+	{
+	  if (num_args == 3)
+	    {
+	      int32_t pairs = 0, symbols = 0, quotes = 0; /* specialize aaa->ssc etc, this makes less difference than I expected */
+	      for (s7_pointer p = cdr(code); is_pair(p); p = cdr(p))
+		{
+		  s7_pointer car_p = car(p);
+		  if (is_normal_happy_symbol(sc, car_p))
+		    symbols++;
+		  else
+		    if (is_pair(car_p))
+		      {
+			pairs++;
+			if (is_proper_quote(sc, car_p))
+			  quotes++;
+		      }}
+	      if (optimize_safe_c_func_three_args(sc, code, f, 0 /* hop */, pairs, symbols, quotes, sc->curlet) == OPT_T)
+		return(true);
+	      set_opt3_pair(cdr(code), cdddr(code));
+	      set_opt3_pair(code, cddr(code));
+	      set_safe_optimize_op(code, OP_SAFE_C_AAA);
+	    }
+	  else set_safe_optimize_op(code, (num_args == 4) ? OP_SAFE_C_4A : OP_SAFE_C_NA);
+	}
+      else set_safe_optimize_op(code, (is_semisafe(f)) ? OP_CL_NA : OP_C_NA);
+      fx_annotate_args(sc, cdr(code), sc->curlet);
+      set_c_function(code, f);
+      return(true);
+
+    case T_CLOSURE:
+      if ((!has_methods(f)) &&
+	  (closure_arity_to_int(sc, f) == num_args))
+	{
+	  int32_t hop = (is_immutable_and_stable(sc, car(code))) ? 1 : 0;
+	  fx_annotate_args(sc, cdr(code), sc->curlet);
+	  if ((is_fx_treeable(cdr(code))) && (tis_slot(let_slots(sc->curlet)))) fx_curlet_tree(sc, cdr(code));
+	  if (is_safe_closure(f))
+	    {
+	      if (num_args != 3)
+		set_safe_optimize_op(code, hop + OP_SAFE_CLOSURE_NA);
+	      else
+		if (is_normal_happy_symbol(sc, cadr(code)))
+		  set_safe_optimize_op(code, hop + ((is_normal_happy_symbol(sc, caddr(code))) ? OP_SAFE_CLOSURE_SSA : OP_SAFE_CLOSURE_SAA));
+		else set_safe_optimize_op(code, hop + (((!is_pair(caddr(code))) && (!is_pair(cadddr(code)))) ? OP_SAFE_CLOSURE_AGG : OP_SAFE_CLOSURE_3A));
+	    }
+	  else
+	    if (num_args != 3)
+	      set_safe_optimize_op(code, hop + ((num_args == 4) ? OP_CLOSURE_4A : OP_CLOSURE_NA));
+	    else
+	      if ((is_normal_happy_symbol(sc, caddr(code))) && (is_normal_happy_symbol(sc, cadddr(code))))
+		set_safe_optimize_op(code, hop + OP_CLOSURE_ASS);
+	      else
+		if (is_normal_happy_symbol(sc, cadr(code)))
+		  set_safe_optimize_op(code, hop + ((is_normal_happy_symbol(sc, cadddr(code))) ? OP_CLOSURE_SAS : OP_CLOSURE_SAA));
+		else
+		  if (is_normal_happy_symbol(sc, caddr(code)))
+		    set_safe_optimize_op(code, hop + OP_CLOSURE_ASA);
+		  else set_safe_optimize_op(code, hop + ((is_normal_happy_symbol(sc, cadddr(code))) ? OP_CLOSURE_AAS : OP_CLOSURE_3A));
+	  set_opt1_lambda_add(code, f);
+	  return(true);
+	}
+      if (is_symbol(closure_args(f)))
+	{
+	  optimize_closure_sym(sc, code, f, 0, num_args, sc->curlet);
+	  if (optimize_op(code) == OP_ANY_CLOSURE_SYM) return(true);
+	}
+      break;
+
+    case T_CLOSURE_STAR:
+      if ((!has_methods(f)) &&
+	  ((closure_star_arity_to_int(sc, f) < 0) || ((closure_star_arity_to_int(sc, f) * 2) >= num_args)))
+	{
+	  int32_t hop = (is_immutable_and_stable(sc, car(code))) ? 1 : 0;
+	  if (num_args > 0)
+	    {
+	      set_opt3_arglen(cdr(code), num_args);
+	      fx_annotate_args(sc, cdr(code), sc->curlet);
+	      if ((is_fx_treeable(cdr(code))) && (tis_slot(let_slots(sc->curlet)))) fx_curlet_tree(sc, cdr(code));
+	    }
+	  if (is_safe_closure(f))
+	    switch (num_args)
+	      {
+	      case 0: return(fixup_unknown_op(sc, code, f, hop + OP_SAFE_CLOSURE_STAR_NA_0));
+	      case 1: return(fixup_unknown_op(sc, code, f, hop + OP_SAFE_CLOSURE_STAR_NA_1));
+	      case 2: return(fixup_unknown_op(sc, code, f, hop + OP_SAFE_CLOSURE_STAR_NA_2));
+	      case 3: if (closure_star_arity_to_int(sc, f) == 3) return(fixup_unknown_op(sc, code, f, OP_SAFE_CLOSURE_STAR_3A));
+	      default: return(fixup_unknown_op(sc, code, f, hop + OP_SAFE_CLOSURE_STAR_NA));
+	      }
+	  return(fixup_unknown_op(sc, code, f, hop + OP_CLOSURE_STAR_NA));
+	}
+      break;
+
+    case T_MACRO:      return(fixup_unknown_op(sc, code, f, fixup_macro_d(sc, OP_MACRO_D, f)));
+    case T_MACRO_STAR: return(fixup_unknown_op(sc, code, f, fixup_macro_d(sc, OP_MACRO_STAR_D, f)));
+      /* implicit vector doesn't happen */
+
+    default: break;
+    }
+  /* closure happens if wrong-number-of-args passed -- probably no need for op_s_na */
+  /* PERHAPS: vector */
+  return(unknown_unknown(sc, sc->code, OP_CLEAR_OPTS));
+}
+
+static bool op_unknown_np(s7_scheme *sc)
+{
+  s7_pointer code = sc->code, f = sc->last_function;
+  int32_t num_args = (is_pair(cdr(code))) ? opt3_arglen(cdr(code)) : 0;
+
+  if (!f) unbound_variable_error_nr(sc, car(sc->code));
+  if (SHOW_EVAL_OPS) fprintf(stderr, "  %s[%d]: %s %s %s\n",
+			     __func__, __LINE__, display_truncated(f), type_name(sc, f, NO_ARTICLE), display_truncated(sc->code));
+
+  switch (type(f))
+    {
+    case T_C_FUNCTION:
+      if (!(c_function_is_aritable(f, num_args))) break;
+    case T_C_RST_NO_REQ_FUNCTION:
+      if (num_args == 1)
+	set_any_c_np(sc, f, code, sc->curlet, num_args, (is_safe_procedure(f)) ? OP_SAFE_C_P : OP_C_P);
+      else
+	if ((num_args == 2) && (is_safe_procedure(f)))
+	  {
+	    set_any_c_np(sc, f, code, sc->curlet, 2, OP_SAFE_C_PP);
+	    opt_sp_1(sc, c_function_call(f), code);
+	  }
+	else
+	  if ((num_args == 3) &&
+	      ((is_safe_procedure(f)) ||
+	       ((is_semisafe(f)) &&
+		(((car(code) != sc->assoc_symbol) && (car(code) != sc->member_symbol)) ||
+		 (unsafe_is_safe(sc, cadddr(code), sc->curlet))))))
+	    set_any_c_np(sc, f, code, sc->curlet, 3, OP_SAFE_C_3P);
+	  else set_any_c_np(sc, f, code, sc->curlet, num_args, OP_ANY_C_NP);
+      return(true);
+
+    case T_CLOSURE:
+      if ((!has_methods(f)) &&
+	  (closure_arity_to_int(sc, f) == num_args)) /* if values clo as arg, we need to know how many values etc */
+	{
+	  int32_t hop = (is_immutable_and_stable(sc, car(code))) ? 1 : 0;
+	  switch (num_args)
+	    {
+	    case 1:
+	      if (is_safe_closure(f))
+		{
+		  s7_pointer body = closure_body(f);
+		  if ((is_null(cdr(body))) && (is_fxable(sc, car(body))))
+		    {
+		      set_optimize_op(code, hop + OP_SAFE_CLOSURE_P_A);
+		      fx_annotate_arg(sc, body, sc->curlet);
+		    }
+		  else set_optimize_op(code, hop + OP_SAFE_CLOSURE_P);
+		}
+	      else set_optimize_op(code, hop + OP_CLOSURE_P);
+	      set_opt1_lambda_add(code, f); /* added 8-Jun-22 */
+	      set_opt3_arglen(cdr(code), 1);
+	      set_unsafely_optimized(code);
+	      break;
+
+	    case 2:
+	      if (is_fxable(sc, cadr(code)))
+		{
+		  fx_annotate_arg(sc, cdr(code), sc->curlet);
+		  set_optimize_op(code, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_AP : OP_CLOSURE_AP));
+		}
+	      else
+		if (is_fxable(sc, caddr(code)))
+		  {
+		    fx_annotate_arg(sc, cddr(code), sc->curlet);
+		    set_optimize_op(code, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_PA : OP_CLOSURE_PA));
+		  }
+		else set_optimize_op(code, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_PP : OP_CLOSURE_PP));
+	      set_opt1_lambda_add(code, f);  /* added 8-Jun-22 */
+	      set_opt3_arglen(cdr(code), 2); /* for later op_unknown_np */
+	      set_unsafely_optimized(code);
+	      break;
+
+	    case 3:  set_any_closure_np(sc, f, code, sc->curlet, 3, hop + OP_ANY_CLOSURE_3P);        break;
+	    case 4:  set_any_closure_np(sc, f, code, sc->curlet, 4, hop + OP_ANY_CLOSURE_4P);        break;
+	    default: set_any_closure_np(sc, f, code, sc->curlet, num_args, hop + OP_ANY_CLOSURE_NP); break;
+	    }
+	  return(true);
+	}
+      break;
+
+    case T_MACRO:      return(fixup_unknown_op(sc, code, f, fixup_macro_d(sc, OP_MACRO_D, f)));
+    case T_MACRO_STAR: return(fixup_unknown_op(sc, code, f, fixup_macro_d(sc, OP_MACRO_STAR_D, f)));
+    }
+  return(unknown_unknown(sc, sc->code, OP_CLEAR_OPTS));
+}
+
+static bool unknown_any(s7_scheme *sc, s7_pointer f, s7_pointer code)
+{
+  sc->last_function = f;
+  if (is_null(cdr(code))) return(op_unknown(sc));
+  if ((is_null(cddr(code))) && (is_normal_symbol(cadr(code)))) return(op_unknown_s(sc));
+  set_opt3_arglen(cdr(code), proper_list_length(cdr(code)));
+  return(op_unknown_np(sc));
+}
+
+
+/* ---------------- eval type checkers ---------------- */
+#if WITH_GCC
+#define h_c_function_is_ok(Sc, P) ({s7_pointer _P_; _P_ = P; ((op_has_hop(_P_)) || (c_function_is_ok(Sc, _P_)));})
+#else
+#define h_c_function_is_ok(Sc, P) ((op_has_hop(P)) || (c_function_is_ok(Sc, P)))
+#endif
+
+#define c_function_is_ok_cadr(Sc, P) ((c_function_is_ok(Sc, P)) && (h_c_function_is_ok(Sc, cadr(P))))
+#define c_function_is_ok_caddr(Sc, P) ((c_function_is_ok(Sc, P)) && (h_c_function_is_ok(Sc, caddr(P))))
+
+static bool c_function_is_ok_cadr_caddr(s7_scheme *sc, s7_pointer p)
+{
+  return((c_function_is_ok(sc, p)) && (h_c_function_is_ok(sc, cadr(p))) && (h_c_function_is_ok(sc, caddr(p))));
+}
+
+static bool c_function_is_ok_cadr_cadadr(s7_scheme *sc, s7_pointer p)
+{
+  return((c_function_is_ok(sc, p)) && (h_c_function_is_ok(sc, cadr(p))) && (h_c_function_is_ok(sc, opt3_pair(p))));  /* cadadr(P) */
+}
+
+static bool c_function_is_ok_cadr_caddadr(s7_scheme *sc, s7_pointer p)
+{
+  return((c_function_is_ok(sc, p)) && (h_c_function_is_ok(sc, cadr(p))) && (h_c_function_is_ok(sc, opt3_pair(p)))); /* caddadr(p) */
+}
+
+/* closure_is_ok_1 checks the type and the body length indications
+ * closure_is_fine_1 just checks the type (safe or unsafe closure)
+ * closure_is_ok calls _ok_1, closure_is_fine calls _fine_1
+ * closure_np_is_ok accepts safe/unsafe etc
+ */
+
+static /* inline */ bool closure_is_ok_1(s7_scheme *sc, s7_pointer code, uint16_t type, int32_t args)
+{
+  s7_pointer f = lookup_unexamined(sc, car(code));
+  if ((f == opt1_lambda_unchecked(code)) ||
+      ((f) && /* this fixup check does save time (e.g. cb) */
+       (low_type_bits(f) == type) &&
+       ((closure_arity(f) == args) || (closure_arity_to_int(sc, f) == args)) && /* 3 type bits to replace this but not hit enough to warrant them */
+       (set_opt1_lambda(code, f))))
+    return(true);
+  sc->last_function = f;
+  return(false);
+}
+
+static /* inline */ bool closure_is_fine_1(s7_scheme *sc, s7_pointer code, uint16_t type, int32_t args)
+{
+  s7_pointer f = lookup_unexamined(sc, car(code));
+  if ((f == opt1_lambda_unchecked(code)) ||
+      ((f) &&
+       ((low_type_bits(f) & (TYPE_MASK | T_SAFE_CLOSURE)) == type) &&
+       ((closure_arity(f) == args) || (closure_arity_to_int(sc, f) == args)) &&
+       (set_opt1_lambda(code, f))))
+    return(true);
+  sc->last_function = f;
+  return(false);
+}
+
+static bool closure_np_is_ok_1(s7_scheme *sc, s7_pointer code)
+{
+  s7_pointer f = lookup_unexamined(sc, car(code));
+  if ((f == opt1_lambda_unchecked(code)) ||
+      ((f) &&
+       (is_closure(f)) &&
+       (set_opt1_lambda(code, f))))
+    return(true);
+  sc->last_function = f;
+  return(false);
+}
+
+#define closure_is_ok(Sc, Code, Type, Args)        ((symbol_ctr(car(Code)) == 1) || (closure_is_ok_1(Sc, Code, Type, Args)))
+#define closure_np_is_ok(Sc, Code)                 ((symbol_ctr(car(Code)) == 1) || (closure_np_is_ok_1(Sc, Code)))
+#define closure_is_fine(Sc, Code, Type, Args)      ((symbol_ctr(car(Code)) == 1) || (closure_is_fine_1(Sc, Code, Type, Args)))
+#define closure_star_is_fine(Sc, Code, Type, Args) ((symbol_ctr(car(Code)) == 1) || (closure_star_is_fine_1(Sc, Code, Type, Args)))
+
+static /* inline */ bool closure_is_eq(s7_scheme *sc)
+{
+  sc->last_function = lookup_unexamined(sc, car(sc->code));
+  return(sc->last_function == opt1_lambda_unchecked(sc->code));
+}
+
+static bool star_arity_is_ok(s7_scheme *sc, s7_pointer val, int32_t args)
+{
+  int32_t arity = closure_star_arity_to_int(sc, val);
+  return((arity < 0) || ((arity * 2) >= args));
+}
+
+static bool closure_star_is_fine_1(s7_scheme *sc, s7_pointer code, uint16_t type, int32_t args)
+{
+  s7_pointer val = lookup_unexamined(sc, car(code));
+  if ((val == opt1_lambda_unchecked(code)) ||
+      ((val) &&
+       ((low_type_bits(val) & (T_SAFE_CLOSURE | TYPE_MASK)) == type) &&
+       (star_arity_is_ok(sc, val, args)) &&
+       (set_opt1_lambda(code, val))))
+    return(true);
+  sc->last_function = val;
+  return(false);
+}
+
+/* closure_is_fine: */
+#define FINE_UNSAFE_CLOSURE      (T_CLOSURE)
+#define FINE_SAFE_CLOSURE        (T_CLOSURE      | T_SAFE_CLOSURE)
+
+/* closure_star_is_fine: */
+#define FINE_UNSAFE_CLOSURE_STAR (T_CLOSURE_STAR)
+#define FINE_SAFE_CLOSURE_STAR   (T_CLOSURE_STAR | T_SAFE_CLOSURE)
+
+/* closure_is_ok: */
+#define OK_UNSAFE_CLOSURE_P      (T_CLOSURE                       | T_ONE_FORM)
+#define OK_SAFE_CLOSURE_P        (T_CLOSURE      | T_SAFE_CLOSURE | T_ONE_FORM)
+#define OK_UNSAFE_CLOSURE_M      (T_CLOSURE                       | T_MULTIFORM)
+#define OK_SAFE_CLOSURE_M        (T_CLOSURE      | T_SAFE_CLOSURE | T_MULTIFORM)
+#define OK_SAFE_CLOSURE_A        (T_CLOSURE      | T_SAFE_CLOSURE | T_ONE_FORM_FX_ARG)
+/* since T_HAS_METHODS is on if there might be methods, this can protect us from that case */
+
+static noreturn void eval_apply_error_nr(s7_scheme *sc)
+{
+  error_nr(sc, sc->syntax_error_symbol, /* apply_error_nr expanded */
+	   set_elist_4(sc, wrap_string(sc, "attempt to apply ~A ~$ in ~$?", 29),
+		       ((is_symbol_and_keyword(sc->code)) ? wrap_string(sc, "a keyword", 9) : type_name_string(sc, sc->code)),
+		       sc->code,
+		       cons(sc, sc->code, sc->args)));
+}
+
+
+/* ---------------- eval ---------------- */
+static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
+{
+  if (SHOW_EVAL_OPS) safe_print(fprintf(stderr, "  eval[%d]:, %s %s %s\n",
+					__LINE__, op_names[first_op], display_truncated(sc->code), display_truncated(sc->args)));
+  sc->cur_op = first_op;
+  goto TOP_NO_POP;
+
+  while (true) /* "continue" in this procedure refers to this loop */
+    {
+      pop_stack(sc);
+      goto TOP_NO_POP;
+
+    BEGIN:
+      if (is_pair(cdr(sc->code)))
+	{
+	  set_current_code(sc, sc->code);
+	  push_stack_no_args(sc, sc->begin_op, cdr(sc->code));
+	}
+      sc->code = car(sc->code);
+
+    EVAL:
+      sc->cur_op = optimize_op(sc->code); /* sc->code can be anything, optimize_op examines a type field (opt_bits) */
+
+    TOP_NO_POP:
+      if (SHOW_EVAL_OPS) safe_print(fprintf(stderr, "  %s (%d), code: %s\n", op_names[sc->cur_op], (int)(sc->cur_op), display_truncated(sc->code)));
+
+      /* it is only slightly faster to use labels as values (computed gotos) here. In my timing tests (June-2018), the best case speedup was in titer.scm
+       *    callgrind numbers 4808 to 4669; another good case was tread.scm: 2410 to 2386.  Most timings were a draw.  computed-gotos-s7.c has the code,
+       *    macroized so it will work if such gotos aren't available.  I think I'll stick with a switch statement.
+       * Another idea is to put the function in the tree, not an index to it (the optimize_op business above),
+       *    then the switch below is not needed, and we free up 16 type bits.  C does not guarantee tail calls (I think)
+       *    so we'd have each function return the next, and eval would be [while (true) f = f(sc)] but would the function
+       *    call overhead be less expensive than the switch? (We get most functions inlined in the current code).
+       * with some fake fx_calls for the P cases, many of these could be [sc->value = fx_function[sc->cur_op](sc, sc->code); continue;]
+       *    so the switch statement is unnecessary -- maybe a table eval_functions[cur_op] eventually
+       */
+      switch (sc->cur_op)
+	{
+	  /* safe c_functions */
+	case OP_SAFE_C_NC: if (!c_function_is_ok(sc, sc->code)) break;   /* break refers to the switch statement */
+	case HOP_SAFE_C_NC: sc->value = fn_call(sc, sc->code); continue; /* continue refers to the outer while loop -- unfortunate C ambiguity */
+
+	case OP_SAFE_C_S: if (!c_function_is_ok(sc, sc->code)) {if (op_unknown_s(sc)) goto EVAL; continue;} /* checking symbol_ctr(car(sc->code)) == 1 just slows us down */
+	case HOP_SAFE_C_S: inline_op_safe_c_s(sc); continue;
+
+	case OP_SAFE_C_SS: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_SS: inline_op_safe_c_ss(sc); continue;
+
+	case OP_SAFE_C_NS: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_NS: sc->value = fx_c_ns(sc, sc->code); continue;
+
+	case OP_SAFE_C_SC: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_SC: op_safe_c_sc(sc); continue;
+
+	case OP_SAFE_C_CS: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_CS: sc->value = fx_c_cs(sc, sc->code); continue;
+
+	case OP_SAFE_C_CQ: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_CQ: sc->value = fx_c_cq(sc, sc->code); continue;
+
+	case OP_SAFE_C_FF: if (!c_function_is_ok(sc, sc->code))  {if (op_unknown_np(sc)) goto EVAL; continue;}
+	case HOP_SAFE_C_FF: sc->value = fx_c_ff(sc, sc->code); continue;
+
+	case OP_SAFE_C_P: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_P: op_safe_c_p(sc); goto EVAL;
+	case OP_SAFE_C_P_1: op_safe_c_p_1(sc); continue;
+
+	case OP_ANY_C_NP:    if (!c_function_is_ok(sc, sc->code))  {if (op_unknown_np(sc)) goto EVAL; continue;}
+	case HOP_ANY_C_NP:   if (op_any_c_np(sc)) goto EVAL; continue;
+	case OP_ANY_C_NP_1:  if (inline_op_any_c_np_1(sc)) goto EVAL; continue;
+	case OP_ANY_C_NP_2:  op_any_c_np_2(sc); continue;
+	case OP_ANY_C_NP_MV: if (op_any_c_np_mv(sc)) goto EVAL; goto APPLY;
+
+	case OP_SAFE_C_SSP:    if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_SSP:   op_safe_c_ssp(sc); goto EVAL;
+	case OP_SAFE_C_SSP_1:  op_safe_c_ssp_1(sc); continue;
+
+	case OP_SAFE_C_A: if (!c_function_is_ok(sc, sc->code)) {if (op_unknown_a(sc)) goto EVAL; continue;}
+	case HOP_SAFE_C_A: sc->value = fx_c_a(sc, sc->code); continue;
+
+	case OP_SAFE_C_opAq: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_opAq: sc->value = fx_c_opaq(sc, sc->code); continue;
+
+	case OP_SAFE_C_opAAq: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_opAAq: sc->value = fx_c_opaaq(sc, sc->code); continue;
+
+	case OP_SAFE_C_opAAAq: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_opAAAq: sc->value = fx_c_opaaaq(sc, sc->code); continue;
+
+	case OP_SAFE_C_S_opAq: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_S_opAq: sc->value = fx_c_s_opaq(sc, sc->code); continue;
+
+	case OP_SAFE_C_opAq_S: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_opAq_S: sc->value = fx_c_opaq_s(sc, sc->code); continue;
+
+	case OP_SAFE_C_S_opAAq: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_S_opAAq: sc->value = fx_c_s_opaaq(sc, sc->code); continue;
+
+	case OP_SAFE_C_AA: if (!c_function_is_ok(sc, sc->code)) {if (op_unknown_aa(sc)) goto EVAL; continue;}
+	case HOP_SAFE_C_AA: sc->value = fx_c_aa(sc, sc->code); continue;
+
+	case OP_SAFE_C_SA: if (!c_function_is_ok(sc, sc->code)) {if (op_unknown_aa(sc)) goto EVAL; continue;}
+	case HOP_SAFE_C_SA: sc->value = fx_c_sa(sc, sc->code); continue;
+
+	case OP_SAFE_C_AS: if (!c_function_is_ok(sc, sc->code)) {if (op_unknown_aa(sc)) goto EVAL; continue;}
+	case HOP_SAFE_C_AS: sc->value = fx_c_as(sc, sc->code); continue;
+
+	case OP_SAFE_C_CA: if (!c_function_is_ok(sc, sc->code)) {if (op_unknown_aa(sc)) goto EVAL; continue;}
+	case HOP_SAFE_C_CA: sc->value = fx_c_ca(sc, sc->code); continue;
+
+	case OP_SAFE_C_AC: if (!c_function_is_ok(sc, sc->code)) {if (op_unknown_aa(sc)) goto EVAL; continue;}
+	case HOP_SAFE_C_AC: sc->value = fx_c_ac(sc, sc->code); continue;
+
+	case OP_SAFE_C_AAA: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_AAA: sc->value = fx_c_aaa(sc, sc->code); continue;
+
+	case OP_SAFE_C_SAA: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_SAA: sc->value = fx_c_saa(sc, sc->code); continue;
+
+	case OP_SAFE_C_SSA: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_SSA: sc->value = fx_c_ssa(sc, sc->code); continue;
+        case HOP_HASH_TABLE_INCREMENT: sc->value = fx_hash_table_increment(sc, sc->code); continue; /* a placeholder, almost never called */
+
+	case OP_SAFE_C_SAS: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_SAS: sc->value = fx_c_sas(sc, sc->code); continue;
+
+	case OP_SAFE_C_ASS: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_ASS: sc->value = fx_c_ass(sc, sc->code); continue;
+
+	case OP_SAFE_C_AGG: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_AGG: sc->value = fx_c_agg(sc, sc->code); continue;
+
+	case OP_SAFE_C_CAC: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_CAC: sc->value = fx_c_cac(sc, sc->code); continue;
+
+	case OP_SAFE_C_CSA: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_CSA: sc->value = fx_c_csa(sc, sc->code); continue;
+
+	case OP_SAFE_C_SCA: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_SCA: sc->value = fx_c_sca(sc, sc->code); continue;
+
+	case OP_SAFE_C_4A: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_4A: sc->value = fx_c_4a(sc, sc->code); continue;
+
+	case OP_SAFE_C_NA: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_NA: sc->value = fx_c_na(sc, sc->code); continue;
+
+	case OP_SAFE_C_ALL_CA: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_ALL_CA: sc->value = fx_c_all_ca(sc, sc->code); continue;
+
+	case OP_SAFE_C_SCS: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_SCS: sc->value = fx_c_scs(sc, sc->code); continue;
+
+	case OP_SAFE_C_SSC: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_SSC: sc->value = fx_c_ssc(sc, sc->code); continue;
+
+	case OP_SAFE_C_SCC: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_SCC: sc->value = fx_c_scc(sc, sc->code); continue;
+
+	case OP_SAFE_C_CSC: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_CSC: sc->value = fx_c_csc(sc, sc->code); continue;
+
+	case OP_SAFE_C_CCS: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_CCS: sc->value = fx_c_ccs(sc, sc->code); continue;
+
+	case OP_SAFE_C_CSS: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_CSS: sc->value = fx_c_css(sc, sc->code); continue;
+
+	case OP_SAFE_C_SSS: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_SSS: sc->value = fx_c_sss(sc, sc->code); continue;
+
+	case OP_SAFE_C_opNCq: if (!c_function_is_ok_cadr(sc, sc->code)) break;
+	case HOP_SAFE_C_opNCq: sc->value = fx_c_opncq(sc, sc->code); continue;
+
+	case OP_SAFE_C_opSq: if (!c_function_is_ok_cadr(sc, sc->code)) break;
+	case HOP_SAFE_C_opSq: sc->value = fx_c_opsq(sc, sc->code); continue;
+
+	case OP_SAFE_C_op_opSqq: if (!c_function_is_ok_cadr_cadadr(sc, sc->code)) break;
+	case HOP_SAFE_C_op_opSqq: sc->value = fx_c_op_opsqq(sc, sc->code); continue;     /* lg cb (splits to not) */
+
+	case OP_SAFE_C_op_S_opSqq: if (!c_function_is_ok_cadr_caddadr(sc, sc->code)) break;
+	case HOP_SAFE_C_op_S_opSqq: sc->value = fx_c_op_s_opsqq(sc, sc->code); continue; /* tlet sg (splits to not) */
+
+	case OP_SAFE_C_op_opSq_Sq: if (!c_function_is_ok_cadr_cadadr(sc, sc->code)) break;
+	case HOP_SAFE_C_op_opSq_Sq: sc->value = fx_c_op_opsq_sq(sc, sc->code); continue; /* lg cb (splits to not etc) */
+
+	case OP_SAFE_C_PS:    if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_PS:   op_safe_c_ps(sc); goto EVAL;
+	case OP_SAFE_C_PS_1:  op_safe_c_ps_1(sc); continue;
+
+	case OP_SAFE_C_PC:    if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_PC:   op_safe_c_pc(sc); goto EVAL;
+	case OP_SAFE_C_PC_1:  op_safe_c_pc_1(sc); continue;
+
+	case OP_SAFE_C_SP:    if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_SP:   op_safe_c_sp(sc); goto EVAL;
+	case OP_SAFE_C_SP_1:  op_safe_c_sp_1(sc); continue;
+
+	case OP_SAFE_CONS_SP_1:     sc->value = cons(sc, sc->args, sc->value); continue;
+	case OP_SAFE_ADD_SP_1:      op_safe_add_sp_1(sc); continue;
+	case OP_SAFE_MULTIPLY_SP_1: op_safe_multiply_sp_1(sc); continue;
+
+	case OP_SAFE_C_AP: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_AP: if (op_safe_c_ap(sc)) goto EVAL; continue;
+
+	case OP_SAFE_C_PA: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_PA: if (op_safe_c_pa(sc)) goto EVAL; continue;
+	case OP_SAFE_C_PA_1: op_safe_c_pa_1(sc); continue;
+
+ 	case OP_SAFE_C_CP: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_CP: op_safe_c_cp(sc); goto EVAL;
+	  /* mv case goes through opt_sp_1 to op_safe_c_sp_mv */
+
+	case OP_SAFE_C_PP:      if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_PP:     op_safe_c_pp(sc);      goto EVAL;
+	case OP_SAFE_C_PP_1:    op_safe_c_pp_1(sc);    goto EVAL;
+	case OP_SAFE_C_PP_3_MV: op_safe_c_pp_3_mv(sc); goto EVAL;
+	case OP_SAFE_C_PP_5:    op_safe_c_pp_5(sc);    continue;
+
+	case OP_SAFE_C_3P:      if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_3P:     op_safe_c_3p(sc);      goto EVAL;
+	case OP_SAFE_C_3P_1:    op_safe_c_3p_1(sc);    goto EVAL;
+	case OP_SAFE_C_3P_2:    op_safe_c_3p_2(sc);    goto EVAL;
+	case OP_SAFE_C_3P_3:    op_safe_c_3p_3(sc);    continue;
+	case OP_SAFE_C_3P_1_MV: op_safe_c_3p_1_mv(sc); goto EVAL;
+	case OP_SAFE_C_3P_2_MV: op_safe_c_3p_2_mv(sc); goto EVAL;
+	case OP_SAFE_C_3P_3_MV: op_safe_c_3p_3_mv(sc); continue;
+
+	case OP_SAFE_C_opSSq: if (!c_function_is_ok_cadr(sc, sc->code)) break;
+	case HOP_SAFE_C_opSSq: sc->value = fx_c_opssq(sc, sc->code); continue;
+
+	case OP_SAFE_C_opSCq: if (!c_function_is_ok_cadr(sc, sc->code)) break;
+	case HOP_SAFE_C_opSCq: sc->value = fx_c_opscq(sc, sc->code); continue;
+
+	case OP_SAFE_C_opCSq: if (!c_function_is_ok_cadr(sc, sc->code)) break;
+	case HOP_SAFE_C_opCSq: sc->value = fx_c_opcsq(sc, sc->code); continue;
+
+	case OP_SAFE_C_S_opSq: if (!c_function_is_ok_caddr(sc, sc->code)) break;
+	case HOP_SAFE_C_S_opSq: sc->value = fx_c_s_opsq(sc, sc->code); continue;
+
+	case OP_SAFE_C_C_opSq: if (!c_function_is_ok_caddr(sc, sc->code)) break;
+	case HOP_SAFE_C_C_opSq: sc->value = fx_c_c_opsq(sc, sc->code); continue;
+
+	case OP_SAFE_C_C_opSSq: if (!c_function_is_ok_caddr(sc, sc->code)) break;
+	case HOP_SAFE_C_C_opSSq: sc->value = fx_c_c_opssq(sc, sc->code); continue;
+
+	case OP_SAFE_C_opCSq_C: if (!c_function_is_ok_cadr(sc, sc->code)) break;
+	case HOP_SAFE_C_opCSq_C: sc->value = fx_c_opcsq_c(sc, sc->code); continue;
+
+	case OP_SAFE_C_opSSq_C: if (!c_function_is_ok_cadr(sc, sc->code)) break;
+	case HOP_SAFE_C_opSSq_C: sc->value = fx_c_opssq_c(sc, sc->code); continue;
+
+	case OP_SAFE_C_opSSq_S: if (!c_function_is_ok_cadr(sc, sc->code)) break;
+	case HOP_SAFE_C_opSSq_S: sc->value = fx_c_opssq_s(sc, sc->code); continue;
+
+	case OP_SAFE_C_op_opSSqq_S: if (!c_function_is_ok_cadr_cadadr(sc, sc->code)) break;
+	case HOP_SAFE_C_op_opSSqq_S: sc->value = fx_c_op_opssqq_s(sc, sc->code); continue;
+
+	case OP_SAFE_C_opSCq_C: if (!c_function_is_ok_cadr(sc, sc->code)) break;
+	case HOP_SAFE_C_opSCq_C: sc->value = fx_c_opscq_c(sc, sc->code); continue;
+
+	case OP_SAFE_C_opCSq_S: if (!c_function_is_ok_cadr(sc, sc->code)) break;
+	case HOP_SAFE_C_opCSq_S: sc->value = fx_c_opcsq_s(sc, sc->code); continue;
+
+	case OP_SAFE_C_S_opSCq: if (!c_function_is_ok_caddr(sc, sc->code)) break;
+	case HOP_SAFE_C_S_opSCq: sc->value = fx_c_s_opscq(sc, sc->code); continue;
+
+	case OP_SAFE_C_C_opSCq: if (!c_function_is_ok_caddr(sc, sc->code)) break;
+	case HOP_SAFE_C_C_opSCq: sc->value = fx_c_c_opscq(sc, sc->code); continue;
+
+	case OP_SAFE_C_S_opSSq: if (!c_function_is_ok_caddr(sc, sc->code)) break;
+	case HOP_SAFE_C_S_opSSq: sc->value = fx_c_s_opssq(sc, sc->code); continue;
+
+	case OP_SAFE_C_S_opCSq: if (!c_function_is_ok_caddr(sc, sc->code)) break;
+	case HOP_SAFE_C_S_opCSq: sc->value = fx_c_s_opcsq(sc, sc->code); continue;
+
+	case OP_SAFE_C_opSq_S: if (!c_function_is_ok_cadr(sc, sc->code)) break;
+	case HOP_SAFE_C_opSq_S: sc->value = fx_c_opsq_s(sc, sc->code); continue;
+
+	case OP_SAFE_C_opSq_CS: if (!c_function_is_ok_cadr(sc, sc->code)) break;
+	case HOP_SAFE_C_opSq_CS: sc->value = fx_c_opsq_cs(sc, sc->code); continue;
+
+	case OP_SAFE_C_opSq_C: if (!c_function_is_ok_cadr(sc, sc->code)) break;
+	case HOP_SAFE_C_opSq_C: sc->value = fx_c_opsq_c(sc, sc->code); continue;
+
+	case OP_SAFE_C_opSq_opSq: if (!c_function_is_ok_cadr_caddr(sc, sc->code)) break;
+	case HOP_SAFE_C_opSq_opSq: sc->value = fx_c_opsq_opsq(sc, sc->code); continue;
+
+	case OP_SAFE_C_opSSq_opSSq: if (!c_function_is_ok_cadr_caddr(sc, sc->code)) break;
+	case HOP_SAFE_C_opSSq_opSSq: sc->value = fx_c_opssq_opssq(sc, sc->code); continue;
+
+	case OP_SAFE_C_opSSq_opSq: if (!c_function_is_ok_cadr_caddr(sc, sc->code)) break;
+	case HOP_SAFE_C_opSSq_opSq: sc->value = fx_c_opssq_opsq(sc, sc->code); continue;
+
+	case OP_SAFE_C_opSq_opSSq: if (!c_function_is_ok_cadr_caddr(sc, sc->code)) break;
+	case HOP_SAFE_C_opSq_opSSq: sc->value = fx_c_opsq_opssq(sc, sc->code); continue;
+
+
+	  /* semisafe c_functions */
+	case OP_CL_S: if (!cl_function_is_ok(sc, sc->code)) break;
+	case HOP_CL_S: inline_op_safe_c_s(sc); continue;
+
+	case OP_CL_SS: if (!cl_function_is_ok(sc, sc->code)) break;
+	case HOP_CL_SS: inline_op_safe_c_ss(sc); continue; /* safe_c case has the code we want */
+
+	case OP_CL_A: if (!cl_function_is_ok(sc, sc->code)) {set_optimize_op(sc->code, OP_S_A); goto EVAL;}
+	case HOP_CL_A: op_cl_a(sc); continue;
+
+	case OP_CL_AA: if (!cl_function_is_ok(sc, sc->code)) break;
+	case HOP_CL_AA: op_cl_aa(sc); continue;
+
+	case OP_CL_SAS: if (!cl_function_is_ok(sc, sc->code)) break;
+	case HOP_CL_SAS: op_cl_sas(sc); continue;
+
+	case OP_CL_NA: if (!cl_function_is_ok(sc, sc->code)) break;
+	case HOP_CL_NA: op_cl_na(sc); continue;
+
+	case OP_CL_FA:  if (!cl_function_is_ok(sc, sc->code)) break;
+	case HOP_CL_FA: op_cl_fa(sc); continue;                        /* op_c_fs was not faster if fx_s below */
+	case OP_MAP_FOR_EACH_FA:  op_map_for_each_fa(sc); continue;    /* here only if for-each or map + one seq */
+	case OP_MAP_FOR_EACH_FAA: op_map_for_each_faa(sc); continue;   /* here only if for-each or map + twp seqs */
+
+
+	  /* unsafe c_functions */
+	case OP_C: if (!c_function_is_ok(sc, sc->code)) {set_optimize_op(sc->code, OP_S); goto EVAL;}
+	case HOP_C: sc->value = fn_proc(sc->code)(sc, sc->nil); continue;
+
+	case OP_C_S: if (!c_function_is_ok(sc, sc->code)) {set_optimize_op(sc->code, OP_S_G); goto EVAL;}
+	case HOP_C_S: op_c_s(sc); continue;
+
+	case OP_READ_S: if (!c_function_is_ok(sc, sc->code)) {set_optimize_op(sc->code, OP_S_G); goto EVAL;}
+	case HOP_READ_S: op_read_s(sc); continue;
+
+	case OP_C_A: if (!c_function_is_ok(sc, sc->code)) {set_optimize_op(sc->code, OP_S_A); goto EVAL;}
+	case HOP_C_A: op_c_a(sc); continue;
+
+	case OP_C_P: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_C_P: op_c_p(sc); goto EVAL;
+	case OP_C_P_1: sc->value = fn_proc(sc->code)(sc, list_1(sc, sc->value)); continue;
+
+	case OP_C_SS: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_C_SS: op_c_ss(sc); continue;
+
+	case OP_C_SC: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_C_SC: op_c_sc(sc); continue;
+
+	case OP_C_AP: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_C_AP: op_c_ap(sc); goto EVAL;
+	case OP_C_AP_1: sc->value = fn_proc(sc->code)(sc, sc->args = list_2(sc, sc->args, sc->value)); continue;
+
+	case OP_C_AA: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_C_AA: op_c_aa(sc); continue;
+
+	case OP_C_NC: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_C_NC: op_c_nc(sc); continue;
+	case OP_C_NA: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_C_NA: op_c_na(sc); continue;
+
+	case OP_APPLY_SS: inline_op_apply_ss(sc); goto APPLY;
+	case OP_APPLY_SA:        op_apply_sa(sc); goto APPLY;
+	case OP_APPLY_SL:        op_apply_sl(sc); goto APPLY;
+
+	case OP_CALL_WITH_EXIT:   op_call_with_exit(sc);   goto BEGIN;
+	case OP_CALL_CC:          op_call_cc(sc);          goto BEGIN;
+	case OP_CALL_WITH_EXIT_O: op_call_with_exit_o(sc); goto EVAL;
+	case OP_C_CATCH:          op_c_catch(sc);          goto BEGIN;
+	case OP_C_CATCH_ALL:      op_c_catch_all(sc);      goto BEGIN;
+	case OP_C_CATCH_ALL_O:    op_c_catch_all(sc);      goto EVAL;
+	case OP_C_CATCH_ALL_A:    op_c_catch_all_a(sc);    continue;
+
+	case OP_WITH_IO: if (op_with_io_op(sc)) goto EVAL; goto BEGIN;
+	case OP_WITH_IO_1:
+	  if (!is_string(sc->value)) {op_with_io_1_method(sc); continue;}
+	  sc->code = op_with_io_1(sc);
+	  goto BEGIN;
+
+	case OP_WITH_IO_C: sc->value = cadr(sc->code); sc->code = op_with_io_1(sc); goto BEGIN;
+	case OP_WITH_OUTPUT_TO_STRING:   op_with_output_to_string(sc);   goto BEGIN;
+	case OP_CALL_WITH_OUTPUT_STRING: op_call_with_output_string(sc); goto BEGIN;
+
+
+	case OP_F:    op_f(sc);    goto BEGIN;
+	case OP_F_A:  op_f_a(sc);  goto BEGIN;
+	case OP_F_AA: op_f_aa(sc); goto BEGIN;
+	case OP_F_NP: op_f_np(sc); goto EVAL;
+	case OP_F_NP_1: if (op_f_np_1(sc)) goto EVAL; goto BEGIN;
+
+	case OP_S:    op_s(sc); goto APPLY;
+	case OP_S_G:  if (op_s_g(sc)) continue;                                     goto APPLY;
+	case OP_S_A:  if (op_x_a(sc, lookup_checked(sc, car(sc->code)))) continue;  goto APPLY;
+	case OP_A_A:  if (op_x_a(sc, fx_call(sc, sc->code))) continue;              goto APPLY;
+	case OP_S_AA: if (op_x_aa(sc, lookup_checked(sc, car(sc->code)))) continue; goto APPLY;
+	case OP_A_AA: if (op_x_aa(sc, fx_call(sc, sc->code))) continue;             goto APPLY;
+	case OP_A_SC: if (op_x_sc(sc, fx_call(sc, sc->code))) continue;             goto APPLY;
+	case OP_P_S:  push_stack_no_args_direct(sc, OP_P_S_1); sc->code = car(sc->code); goto EVAL;
+	case OP_P_S_1: op_p_s_1(sc); goto APPLY;
+
+	case OP_SAFE_C_STAR: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_STAR: op_safe_c_star(sc); continue;
+
+	case OP_SAFE_C_STAR_A: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_STAR_A: op_safe_c_star_a(sc); continue;
+
+	case OP_SAFE_C_STAR_AA: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_STAR_AA: op_safe_c_star_aa(sc); continue;
+
+	case OP_SAFE_C_STAR_NA: if (!c_function_is_ok(sc, sc->code)) break;
+	case HOP_SAFE_C_STAR_NA: op_safe_c_star_na(sc); continue;
+
+
+	case OP_THUNK: if (!closure_is_ok(sc, sc->code, FINE_UNSAFE_CLOSURE, 0)) {if (op_unknown(sc)) goto EVAL; continue;}
+	case HOP_THUNK: op_thunk(sc); goto EVAL;
+
+	case OP_THUNK_O: if (!closure_is_ok(sc, sc->code, OK_UNSAFE_CLOSURE_P, 0)) {if (op_unknown(sc)) goto EVAL; continue;}
+	case HOP_THUNK_O: op_thunk_o(sc); goto EVAL;
+
+	case OP_SAFE_THUNK: if (!closure_is_fine(sc, sc->code, FINE_SAFE_CLOSURE, 0)) {if (op_unknown(sc)) goto EVAL; continue;}
+	case HOP_SAFE_THUNK: op_safe_thunk(sc); goto EVAL;
+
+	case OP_THUNK_ANY: if (!closure_is_fine(sc, sc->code, FINE_UNSAFE_CLOSURE, 1)) break; /* symbol as arglist */
+	case HOP_THUNK_ANY: op_thunk_any(sc); goto BEGIN;
+
+	case OP_SAFE_THUNK_ANY: if (!closure_is_fine(sc, sc->code, FINE_SAFE_CLOSURE, 1)) break; /* symbol as arglist */
+	case HOP_SAFE_THUNK_ANY: op_safe_thunk_any(sc); goto EVAL;
+
+	case OP_SAFE_THUNK_A: if (!closure_is_ok(sc, sc->code, OK_SAFE_CLOSURE_A, 0)) {if (op_unknown(sc)) goto EVAL; continue;}
+	case HOP_SAFE_THUNK_A: sc->value = op_safe_thunk_a(sc, sc->code); continue;
+
+	case OP_CLOSURE_S: if (!closure_is_fine(sc, sc->code, FINE_UNSAFE_CLOSURE, 1)) {if (op_unknown_s(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_S: op_closure_s(sc); goto EVAL;
+
+	case OP_CLOSURE_S_O: if (!closure_is_ok(sc, sc->code, OK_UNSAFE_CLOSURE_P, 1)) {if (op_unknown_s(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_S_O: op_closure_s_o(sc); goto EVAL;
+
+	case OP_SAFE_CLOSURE_S: if (!closure_is_fine(sc, sc->code, FINE_SAFE_CLOSURE, 1)) {if (op_unknown_s(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_S: op_safe_closure_s(sc); goto EVAL;
+
+	case OP_SAFE_CLOSURE_S_O: if (!closure_is_ok(sc, sc->code, OK_SAFE_CLOSURE_P, 1)) {if (op_unknown_s(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_S_O: op_safe_closure_s_o(sc); goto EVAL;
+
+	case OP_SAFE_CLOSURE_S_A: if (!closure_is_ok(sc, sc->code, OK_SAFE_CLOSURE_A, 1)) {if (op_unknown_s(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_S_A: sc->value = op_safe_closure_s_a(sc, sc->code); continue;
+
+	case OP_SAFE_CLOSURE_S_TO_S: if ((symbol_ctr(car(sc->code)) > 1) && (!closure_is_eq(sc))) {if (op_unknown_s(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_S_TO_S: sc->value = fx_safe_closure_s_to_s(sc, sc->code); continue;
+
+	case OP_SAFE_CLOSURE_S_TO_SC: if ((symbol_ctr(car(sc->code)) > 1) && (!closure_is_eq(sc))) {if (op_unknown_s(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_S_TO_SC: sc->value = fx_proc(cdr(sc->code))(sc, sc->code); continue;
+
+	case OP_SAFE_CLOSURE_A_TO_SC: if ((symbol_ctr(car(sc->code)) > 1) && (!closure_is_eq(sc))) {if (op_unknown_a(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_A_TO_SC: sc->value = fx_proc(sc->code)(sc, sc->code); continue;
+
+	case OP_CLOSURE_P: if (!closure_is_fine(sc, sc->code, FINE_UNSAFE_CLOSURE, 1))  {if (op_unknown_np(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_P: op_closure_p(sc); goto EVAL;
+	case OP_CLOSURE_P_1: op_closure_p_1(sc); goto BEGIN;
+
+	case OP_SAFE_CLOSURE_P:   if (!closure_is_fine(sc, sc->code, FINE_SAFE_CLOSURE, 1))  {if (op_unknown_np(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_P:  op_safe_closure_p(sc);   goto EVAL;
+	case OP_SAFE_CLOSURE_P_1: op_safe_closure_p_1(sc); goto BEGIN;
+
+	case OP_SAFE_CLOSURE_P_A:   if (!closure_is_fine(sc, sc->code, FINE_SAFE_CLOSURE, 1))  {if (op_unknown_np(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_P_A:  op_safe_closure_p_a(sc);   goto EVAL;
+	case OP_SAFE_CLOSURE_P_A_1: op_safe_closure_p_a_1(sc); continue;
+
+	case OP_CLOSURE_A: if (!closure_is_ok(sc, sc->code, OK_UNSAFE_CLOSURE_M, 1)) {if (op_unknown_a(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_A: inline_op_closure_a(sc); push_stack_no_args(sc, sc->begin_op, T_Pair(cdr(sc->code))); sc->code = car(sc->code); goto EVAL;
+
+	case OP_CLOSURE_A_O: if (!closure_is_ok(sc, sc->code, OK_UNSAFE_CLOSURE_P, 1)) {if (op_unknown_a(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_A_O: inline_op_closure_a(sc); sc->code = car(sc->code); goto EVAL;
+
+	case OP_SAFE_CLOSURE_A: if (!closure_is_ok(sc, sc->code, OK_SAFE_CLOSURE_M, 1)) {if (op_unknown_a(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_A: op_safe_closure_a(sc); goto EVAL;
+
+	case OP_SAFE_CLOSURE_A_O: if (!closure_is_ok(sc, sc->code, OK_SAFE_CLOSURE_P, 1)) {if (op_unknown_a(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_A_O: op_safe_closure_a_o(sc); goto EVAL;
+
+	case OP_SAFE_CLOSURE_A_A: if (!closure_is_ok(sc, sc->code, OK_SAFE_CLOSURE_A, 1)) {if (op_unknown_a(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_A_A: sc->value = op_safe_closure_a_a(sc, sc->code); continue;
+
+	case OP_CLOSURE_AP: if (!closure_is_fine(sc, sc->code, FINE_UNSAFE_CLOSURE, 2)) {if (op_unknown_np(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_AP: op_closure_ap(sc); goto EVAL;
+	case OP_CLOSURE_AP_1: op_closure_ap_1(sc); goto BEGIN;
+
+	case OP_CLOSURE_PA: if (!closure_is_fine(sc, sc->code, FINE_UNSAFE_CLOSURE, 2)) {if (op_unknown_np(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_PA: op_closure_pa(sc); goto EVAL;
+	case OP_CLOSURE_PA_1: op_closure_pa_1(sc); goto BEGIN;
+
+	case OP_CLOSURE_PP: if (!closure_is_fine(sc, sc->code, FINE_UNSAFE_CLOSURE, 2))  {if (op_unknown_np(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_PP: op_closure_pp(sc); goto EVAL;
+	case OP_CLOSURE_PP_1: op_closure_pp_1(sc); goto EVAL;
+
+	case OP_SAFE_CLOSURE_AP: if (!closure_is_fine(sc, sc->code, FINE_SAFE_CLOSURE, 2)) {if (op_unknown_np(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_AP: op_safe_closure_ap(sc); goto EVAL;
+	case OP_SAFE_CLOSURE_AP_1: op_safe_closure_ap_1(sc); goto BEGIN;
+
+	case OP_SAFE_CLOSURE_PA: if (!closure_is_fine(sc, sc->code, FINE_SAFE_CLOSURE, 2)) {if (op_unknown_np(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_PA: op_safe_closure_pa(sc); goto EVAL;
+	case OP_SAFE_CLOSURE_PA_1: op_safe_closure_pa_1(sc); goto BEGIN;
+
+	case OP_SAFE_CLOSURE_PP: if (!closure_is_fine(sc, sc->code, FINE_SAFE_CLOSURE, 2))  {if (op_unknown_np(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_PP: op_safe_closure_pp(sc); goto EVAL;
+	case OP_SAFE_CLOSURE_PP_1: op_safe_closure_pp_1(sc); goto EVAL;
+
+	case OP_ANY_CLOSURE_3P:   if (!closure_is_fine(sc, sc->code, FINE_SAFE_CLOSURE, 3)) {if (op_unknown_np(sc)) goto EVAL; continue;}
+	case HOP_ANY_CLOSURE_3P:  op_any_closure_3p(sc); goto EVAL;
+	case OP_ANY_CLOSURE_3P_1: if (!op_any_closure_3p_1(sc)) goto EVAL; goto BEGIN;
+	case OP_ANY_CLOSURE_3P_2: if (!op_any_closure_3p_2(sc)) goto EVAL; goto BEGIN;
+	case OP_ANY_CLOSURE_3P_3: op_any_closure_3p_3(sc); goto BEGIN;
+
+	case OP_ANY_CLOSURE_4P:   if (!closure_is_fine(sc, sc->code, FINE_SAFE_CLOSURE, 4))  {if (op_unknown_np(sc)) goto EVAL; continue;}
+	case HOP_ANY_CLOSURE_4P:  op_any_closure_4p(sc); goto EVAL;
+	case OP_ANY_CLOSURE_4P_1: if (!op_any_closure_4p_1(sc)) goto EVAL; goto BEGIN;
+	case OP_ANY_CLOSURE_4P_2: if (!op_any_closure_4p_2(sc)) goto EVAL; goto BEGIN;
+	case OP_ANY_CLOSURE_4P_3: if (!op_any_closure_4p_3(sc)) goto EVAL; goto BEGIN;
+	case OP_ANY_CLOSURE_4P_4: op_any_closure_4p_4(sc); goto BEGIN;
+
+	case OP_CLOSURE_FA: if (!closure_is_fine(sc, sc->code, FINE_UNSAFE_CLOSURE, 2)) break;
+	case HOP_CLOSURE_FA: op_closure_fa(sc); goto EVAL;
+
+	case OP_CLOSURE_SS: if (!closure_is_ok(sc, sc->code, OK_UNSAFE_CLOSURE_M, 2)) {if (op_unknown_gg(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_SS: op_closure_ss(sc); goto EVAL;
+
+	case OP_CLOSURE_SS_O: if (!closure_is_ok(sc, sc->code, OK_UNSAFE_CLOSURE_P, 2)) {if (op_unknown_gg(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_SS_O: op_closure_ss_o(sc); goto EVAL;
+
+	case OP_SAFE_CLOSURE_SS: if (!closure_is_ok(sc, sc->code, OK_SAFE_CLOSURE_M, 2)) {if (op_unknown_gg(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_SS: op_safe_closure_ss(sc); goto EVAL;
+
+	case OP_SAFE_CLOSURE_SS_O: if (!closure_is_ok(sc, sc->code, OK_SAFE_CLOSURE_P, 2)) {if (op_unknown_gg(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_SS_O: op_safe_closure_ss_o(sc); goto EVAL;
+
+	case OP_SAFE_CLOSURE_SS_A: if (!closure_is_ok(sc, sc->code, OK_SAFE_CLOSURE_A, 2)) {if (op_unknown_gg(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_SS_A: sc->value = op_safe_closure_ss_a(sc, sc->code); continue;
+
+	case OP_CLOSURE_3S: if (!closure_is_fine(sc, sc->code, FINE_UNSAFE_CLOSURE, 3)) {if (op_unknown_ns(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_3S: op_closure_3s(sc); goto EVAL; /* "fine" here means changing func (as arg) does not constantly call op_unknown_ns */
+
+	case OP_CLOSURE_3S_O: if (!closure_is_ok(sc, sc->code, OK_UNSAFE_CLOSURE_P, 3)) {if (op_unknown_ns(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_3S_O: op_closure_3s_o(sc); goto EVAL;
+
+	case OP_CLOSURE_4S: if (!closure_is_fine(sc, sc->code, FINE_UNSAFE_CLOSURE, 4)) {if (op_unknown_ns(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_4S: op_closure_4s(sc); goto EVAL;
+
+	case OP_CLOSURE_4S_O: if (!closure_is_ok(sc, sc->code, OK_UNSAFE_CLOSURE_P, 4)) {if (op_unknown_ns(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_4S_O: op_closure_4s_o(sc); goto EVAL;
+
+	case OP_CLOSURE_5S: if (!closure_is_fine(sc, sc->code, FINE_UNSAFE_CLOSURE, 5)) {if (op_unknown_ns(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_5S: op_closure_5s(sc); goto EVAL;
+
+	case OP_CLOSURE_SC: if (!closure_is_ok(sc, sc->code, OK_UNSAFE_CLOSURE_M, 2)) {if (op_unknown_gg(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_SC: op_closure_sc(sc); goto EVAL;
+
+	case OP_CLOSURE_SC_O: if (!closure_is_ok(sc, sc->code, OK_UNSAFE_CLOSURE_P, 2)) {if (op_unknown_gg(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_SC_O: op_closure_sc_o(sc); goto EVAL;
+
+	case OP_SAFE_CLOSURE_SC: if (!closure_is_ok(sc, sc->code, OK_SAFE_CLOSURE_M, 2)) {if (op_unknown_gg(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_SC: op_safe_closure_sc(sc); goto EVAL;
+
+	case OP_SAFE_CLOSURE_SC_O: if (!closure_is_ok(sc, sc->code, OK_SAFE_CLOSURE_P, 2)) {if (op_unknown_gg(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_SC_O: op_safe_closure_sc_o(sc); goto EVAL;
+
+	case OP_CLOSURE_AA: if (!closure_is_ok(sc, sc->code, OK_UNSAFE_CLOSURE_M, 2)) {if (op_unknown_aa(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_AA: op_closure_aa(sc); goto EVAL;
+
+	case OP_CLOSURE_AA_O: if (!closure_is_ok(sc, sc->code, OK_UNSAFE_CLOSURE_P, 2)) {if (op_unknown_aa(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_AA_O: inline_op_closure_aa_o(sc); goto EVAL;
+
+	case OP_SAFE_CLOSURE_AA: if (!closure_is_ok(sc, sc->code, OK_SAFE_CLOSURE_M, 2)) {if (op_unknown_aa(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_AA: op_safe_closure_aa(sc); goto EVAL;
+
+	case OP_SAFE_CLOSURE_AA_O: if (!closure_is_ok(sc, sc->code, OK_SAFE_CLOSURE_P, 2)) {if (op_unknown_aa(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_AA_O: op_safe_closure_aa_o(sc); goto EVAL;
+
+	case OP_SAFE_CLOSURE_AA_A: if (!closure_is_ok(sc, sc->code, OK_SAFE_CLOSURE_A, 2)) {if (op_unknown_aa(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_AA_A: sc->value = fx_safe_closure_aa_a(sc, sc->code); continue;
+
+	case OP_SAFE_CLOSURE_SSA: if (!closure_is_fine(sc, sc->code, FINE_SAFE_CLOSURE, 3)) {if (op_unknown_na(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_SSA: op_safe_closure_ssa(sc); goto EVAL;
+
+	case OP_SAFE_CLOSURE_SAA: if (!closure_is_fine(sc, sc->code, FINE_SAFE_CLOSURE, 3)) {if (op_unknown_na(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_SAA: op_safe_closure_saa(sc); goto EVAL;
+
+	case OP_SAFE_CLOSURE_AGG: if (!closure_is_fine(sc, sc->code, FINE_SAFE_CLOSURE, 3)) {if (op_unknown_na(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_AGG: op_safe_closure_agg(sc); goto EVAL;
+
+	case OP_SAFE_CLOSURE_3A: if (!closure_is_ok(sc, sc->code, FINE_SAFE_CLOSURE, 3)) {if (op_unknown_na(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_3A: op_safe_closure_3a(sc); goto EVAL;
+
+	case OP_SAFE_CLOSURE_NS:  if (!closure_is_fine(sc, sc->code, FINE_SAFE_CLOSURE, opt3_arglen(cdr(sc->code)))) {if (op_unknown_ns(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_NS: op_safe_closure_ns(sc); goto EVAL;
+
+	case OP_SAFE_CLOSURE_NA:  if (!closure_is_fine(sc, sc->code, FINE_SAFE_CLOSURE, opt3_arglen(cdr(sc->code)))) {if (op_unknown_na(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_NA: op_safe_closure_na(sc); goto EVAL;
+
+	case OP_SAFE_CLOSURE_3S:  if (!closure_is_fine(sc, sc->code, FINE_SAFE_CLOSURE, 3)) {if (op_unknown_ns(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_3S: op_safe_closure_3s(sc); goto EVAL;
+
+	case OP_SAFE_CLOSURE_3S_A: if (!closure_is_ok(sc, sc->code, OK_SAFE_CLOSURE_A, 3)) {if (op_unknown_ns(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_3S_A: sc->value = op_safe_closure_3s_a(sc, sc->code); continue;
+
+	case OP_CLOSURE_NS:  if (!closure_is_fine(sc, sc->code, FINE_UNSAFE_CLOSURE, opt3_arglen(cdr(sc->code)))) {if (op_unknown_ns(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_NS: op_closure_ns(sc); goto EVAL;
+
+	case OP_CLOSURE_ASS:  if (!closure_is_fine(sc, sc->code, FINE_UNSAFE_CLOSURE, 3)) {if (op_unknown_na(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_ASS: op_closure_ass(sc); goto EVAL;
+
+	case OP_CLOSURE_AAS:  if (!closure_is_fine(sc, sc->code, FINE_UNSAFE_CLOSURE, 3)) {if (op_unknown_na(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_AAS: op_closure_aas(sc); goto EVAL;
+
+	case OP_CLOSURE_SAA:  if (!closure_is_fine(sc, sc->code, FINE_UNSAFE_CLOSURE, 3)) {if (op_unknown_na(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_SAA: op_closure_saa(sc); goto EVAL;
+
+	case OP_CLOSURE_ASA:  if (!closure_is_fine(sc, sc->code, FINE_UNSAFE_CLOSURE, 3)) {if (op_unknown_na(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_ASA: op_closure_asa(sc); goto EVAL;
+
+	case OP_CLOSURE_SAS:  if (!closure_is_fine(sc, sc->code, FINE_UNSAFE_CLOSURE, 3)) {if (op_unknown_na(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_SAS: op_closure_sas(sc); goto EVAL;
+
+	case OP_CLOSURE_3A:  if (!closure_is_fine(sc, sc->code, FINE_UNSAFE_CLOSURE, 3)) {if (op_unknown_na(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_3A: op_closure_3a(sc); goto EVAL;
+
+ 	case OP_CLOSURE_4A:  if (!closure_is_fine(sc, sc->code, FINE_UNSAFE_CLOSURE, 4)) {if (op_unknown_na(sc)) goto EVAL; continue;}
+ 	case HOP_CLOSURE_4A: op_closure_4a(sc); goto EVAL;
+
+	case OP_CLOSURE_NA: if (!closure_is_fine(sc, sc->code, FINE_UNSAFE_CLOSURE, opt3_arglen(cdr(sc->code)))) {if (op_unknown_na(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_NA: op_closure_na(sc); goto EVAL;
+
+	case OP_ANY_CLOSURE_NP: if (!closure_np_is_ok(sc, sc->code)) {if (op_unknown_np(sc)) goto EVAL; continue;}
+	case HOP_ANY_CLOSURE_NP: op_any_closure_np(sc); goto EVAL;
+	case OP_ANY_CLOSURE_NP_1:
+	  if (!(inline_collect_np_args(sc, OP_ANY_CLOSURE_NP_1, cons(sc, sc->value, sc->args))))
+	    op_any_closure_np_end(sc);
+	  goto EVAL;
+	case OP_ANY_CLOSURE_NP_2:
+	  sc->args = cons(sc, sc->value, sc->args);
+	  op_any_closure_np_end(sc);
+	  goto EVAL;
+
+	case OP_ANY_CLOSURE_SYM: if (!check_closure_sym(sc, 1)) break; /* (lambda args ...) */
+	case HOP_ANY_CLOSURE_SYM: op_any_closure_sym(sc); goto BEGIN;
+	case OP_ANY_CLOSURE_A_SYM: if (!check_closure_sym(sc, 2)) break; /* (lambda (a . args) ...) */
+	case HOP_ANY_CLOSURE_A_SYM: op_any_closure_a_sym(sc); goto BEGIN;
+
+
+	case OP_TC_AND_A_OR_A_LA:         tick_tc(sc, sc->cur_op); op_tc_and_a_or_a_la(sc, sc->code);                       continue;
+	case OP_TC_OR_A_AND_A_LA:         tick_tc(sc, sc->cur_op); op_tc_or_a_and_a_la(sc, sc->code);                       continue;
+	case OP_TC_AND_A_OR_A_LAA:        tick_tc(sc, sc->cur_op); op_tc_and_a_or_a_laa(sc, sc->code);                      continue;
+	case OP_TC_OR_A_AND_A_LAA:        tick_tc(sc, sc->cur_op); op_tc_or_a_and_a_laa(sc, sc->code);                      continue;
+	case OP_TC_AND_A_OR_A_L3A:        tick_tc(sc, sc->cur_op); op_tc_and_a_or_a_l3a(sc, sc->code);                      continue;
+	case OP_TC_OR_A_AND_A_L3A:        tick_tc(sc, sc->cur_op); op_tc_or_a_and_a_l3a(sc, sc->code);                      continue;
+	case OP_TC_AND_A_OR_A_A_LA:       tick_tc(sc, sc->cur_op); op_tc_and_a_or_a_a_la(sc, sc->code);                     continue;
+	case OP_TC_OR_A_AND_A_A_LA:       tick_tc(sc, sc->cur_op); op_tc_or_a_and_a_a_la(sc, sc->code);                     continue;
+	case OP_TC_OR_A_A_AND_A_A_LA:     tick_tc(sc, sc->cur_op); op_tc_or_a_a_and_a_a_la(sc, sc->code);                   continue;
+	case OP_TC_OR_A_AND_A_A_L3A:      tick_tc(sc, sc->cur_op); op_tc_or_a_and_a_a_l3a(sc, sc->code);                    continue;
+
+	case OP_TC_IF_A_Z_LA:             tick_tc(sc, sc->cur_op); if (op_tc_if_a_z_la(sc, sc->code, false))                continue; goto EVAL;
+	case OP_TC_IF_A_LA_Z:             tick_tc(sc, sc->cur_op); if (op_tc_if_a_la_z(sc, sc->code, false))                continue; goto EVAL;
+	case OP_TC_COND_A_Z_LA:           tick_tc(sc, sc->cur_op); if (op_tc_if_a_z_la(sc, sc->code, true))                 continue; goto EVAL;
+	case OP_TC_COND_A_LA_Z:           tick_tc(sc, sc->cur_op); if (op_tc_if_a_la_z(sc, sc->code, true))                 continue; goto EVAL;
+
+	case OP_TC_IF_A_LAA_Z:            tick_tc(sc, sc->cur_op); if (op_tc_if_a_z_laa(sc, sc->code, false, TC_IF))        continue; goto EVAL;
+	case OP_TC_IF_A_Z_LAA:            tick_tc(sc, sc->cur_op); if (op_tc_if_a_z_laa(sc, sc->code, true, TC_IF))         continue; goto EVAL;
+	case OP_TC_COND_A_Z_LAA:          tick_tc(sc, sc->cur_op); if (op_tc_if_a_z_laa(sc, sc->code, true, TC_COND))       continue; goto EVAL;
+	case OP_TC_COND_A_LAA_Z:          tick_tc(sc, sc->cur_op); if (op_tc_if_a_z_laa(sc, sc->code, false, TC_COND))      continue; goto EVAL;
+	case OP_TC_WHEN_LA:               tick_tc(sc, sc->cur_op); op_tc_when_la(sc, sc->code);                             continue;
+	case OP_TC_WHEN_LAA:              tick_tc(sc, sc->cur_op); op_tc_when_laa(sc, sc->code);                            continue;
+	case OP_TC_WHEN_L3A:              tick_tc(sc, sc->cur_op); op_tc_when_l3a(sc, sc->code);                            continue;
+
+	case OP_TC_IF_A_Z_L3A:            tick_tc(sc, sc->cur_op); if (op_tc_if_a_z_l3a(sc, sc->code, true))                continue; goto EVAL;
+	case OP_TC_IF_A_L3A_Z:            tick_tc(sc, sc->cur_op); if (op_tc_if_a_z_l3a(sc, sc->code, false))               continue; goto EVAL;
+
+	case OP_TC_IF_A_Z_IF_A_Z_LA:      tick_tc(sc, sc->cur_op); if (op_tc_if_a_z_if_a_z_la(sc, sc->code, true, TC_IF))   continue; goto EVAL;
+	case OP_TC_IF_A_Z_IF_A_LA_Z:      tick_tc(sc, sc->cur_op); if (op_tc_if_a_z_if_a_z_la(sc, sc->code, false, TC_IF))  continue; goto EVAL;
+	case OP_TC_COND_A_Z_A_Z_LA:       tick_tc(sc, sc->cur_op); if (op_tc_if_a_z_if_a_z_la(sc, sc->code, true, TC_COND)) continue; goto EVAL;
+	case OP_TC_COND_A_Z_A_LA_Z:       tick_tc(sc, sc->cur_op); if (op_tc_if_a_z_if_a_z_la(sc, sc->code, false, TC_COND))continue; goto EVAL;
+ 	case OP_TC_AND_A_IF_A_LA_Z:       tick_tc(sc, sc->cur_op); if (op_tc_if_a_z_if_a_z_la(sc, sc->code, false, TC_AND)) continue; goto EVAL;
+ 	case OP_TC_AND_A_IF_A_Z_LA:       tick_tc(sc, sc->cur_op); if (op_tc_if_a_z_if_a_z_la(sc, sc->code, true, TC_AND))  continue; goto EVAL;
+
+	case OP_TC_IF_A_Z_IF_A_Z_LAA:     tick_tc(sc, sc->cur_op); if (op_tc_if_a_z_if_a_z_laa(sc, false, sc->code))        continue; goto EVAL;
+	case OP_TC_IF_A_Z_IF_A_LAA_Z:     tick_tc(sc, sc->cur_op); if (op_tc_if_a_z_if_a_laa_z(sc, false, sc->code))        continue; goto EVAL;
+	case OP_TC_COND_A_Z_A_Z_LAA:      tick_tc(sc, sc->cur_op); if (op_tc_if_a_z_if_a_z_laa(sc, true, sc->code))         continue; goto EVAL;
+	case OP_TC_COND_A_Z_A_LAA_Z:      tick_tc(sc, sc->cur_op); if (op_tc_if_a_z_if_a_laa_z(sc, true, sc->code))         continue; goto EVAL;
+
+	case OP_TC_LET_IF_A_Z_LA:         tick_tc(sc, sc->cur_op); if (op_tc_let_if_a_z_la(sc, sc->code))                   continue; goto EVAL;
+	case OP_TC_LET_IF_A_Z_LAA:        tick_tc(sc, sc->cur_op); if (op_tc_let_if_a_z_laa(sc, sc->code))                  continue; goto EVAL;
+	case OP_TC_LET_WHEN_LAA:          tick_tc(sc, sc->cur_op); op_tc_let_when_laa(sc, true, sc->code);                  continue;
+	case OP_TC_LET_UNLESS_LAA:        tick_tc(sc, sc->cur_op); op_tc_let_when_laa(sc, false, sc->code);                 continue;
+
+	case OP_TC_COND_A_Z_A_LAA_LAA:    tick_tc(sc, sc->cur_op); if (op_tc_cond_a_z_a_laa_laa(sc, sc->code))              continue; goto EVAL;
+	case OP_TC_IF_A_Z_IF_A_L3A_L3A:   tick_tc(sc, sc->cur_op); if (op_tc_if_a_z_if_a_l3a_l3a(sc, sc->code))             continue; goto EVAL;
+	case OP_TC_IF_A_Z_LET_IF_A_Z_LAA: tick_tc(sc, sc->cur_op); if (op_tc_if_a_z_let_if_a_z_laa(sc, sc->code))           continue; goto EVAL;
+	case OP_TC_CASE_LA:               tick_tc(sc, sc->cur_op); if (op_tc_case_la(sc, sc->code))                         continue; goto BEGIN;
+	case OP_TC_LET_COND:              tick_tc(sc, sc->cur_op); if (op_tc_let_cond(sc, sc->code))                        continue; goto EVAL;
+
+	case OP_RECUR_IF_A_A_opA_LAq:           wrap_recur_if_a_a_opa_laq(sc, true, true);         continue;
+ 	case OP_RECUR_IF_A_A_opLA_Aq:           wrap_recur_if_a_a_opa_laq(sc, true, false);        continue;
+	case OP_RECUR_IF_A_opA_LAq_A:           wrap_recur_if_a_a_opa_laq(sc, false, true);        continue;
+	case OP_RECUR_IF_A_opLA_Aq_A:           wrap_recur_if_a_a_opa_laq(sc, false, false);       continue;
+	case OP_RECUR_IF_A_A_opA_LAAq:          wrap_recur(sc, op_recur_if_a_a_opa_laaq);          continue;
+	case OP_RECUR_IF_A_A_opA_L3Aq:          wrap_recur(sc, op_recur_if_a_a_opa_l3aq);          continue;
+	case OP_RECUR_IF_A_opA_LAAq_A:          wrap_recur(sc, op_recur_if_a_opa_laaq_a);          continue;
+	case OP_RECUR_IF_A_A_opLA_LAq:          wrap_recur_if_a_a_opla_laq(sc, true);              continue;
+	case OP_RECUR_IF_A_opLA_LAq_A:          wrap_recur_if_a_a_opla_laq(sc, false);             continue;
+	case OP_RECUR_IF_A_A_opA_LA_LAq:        wrap_recur(sc, op_recur_if_a_a_opa_la_laq);        continue;
+	case OP_RECUR_IF_A_opA_LA_LAq_A:        wrap_recur(sc, op_recur_if_a_opa_la_laq_a);        continue;
+	case OP_RECUR_IF_A_A_LopL3A_L3A_L3Aq:   wrap_recur(sc, op_recur_if_a_a_lopl3a_l3a_l3aq);   continue;
+	case OP_RECUR_IF_A_A_AND_A_LAA_LAA:     wrap_recur(sc, op_recur_if_a_a_and_a_laa_laa);     continue;
+	case OP_RECUR_IF_A_A_opLA_LA_LAq:       wrap_recur(sc, op_recur_if_a_a_opla_la_laq);       continue;
+	case OP_RECUR_IF_A_A_IF_A_LAA_opA_LAAq: wrap_recur(sc, op_recur_if_a_a_if_a_laa_opa_laaq); continue;
+	case OP_RECUR_IF_A_A_IF_A_A_opLA_LAq:   wrap_recur(sc, op_recur_if_a_a_if_a_a_opla_laq);   continue;
+	case OP_RECUR_IF_A_A_IF_A_A_opLAA_LAAq: wrap_recur(sc, op_recur_if_a_a_if_a_a_oplaa_laaq); continue;
+	case OP_RECUR_COND_A_A_opA_LAq:         wrap_recur(sc, op_recur_cond_a_a_opa_laq);         continue;
+	case OP_RECUR_COND_A_A_opA_LAAq:        wrap_recur(sc, op_recur_cond_a_a_opa_laaq);        continue;
+	case OP_RECUR_COND_A_A_A_A_opLA_LAq:    wrap_recur(sc, op_recur_cond_a_a_a_a_opla_laq);    continue;
+	case OP_RECUR_COND_A_A_A_A_opA_LAAq:    wrap_recur(sc, op_recur_cond_a_a_a_a_opa_laaq);    continue;
+	case OP_RECUR_COND_A_A_A_A_opLAA_LAAq:  wrap_recur(sc, op_recur_cond_a_a_a_a_oplaa_laaq);  continue;
+	case OP_RECUR_COND_A_A_A_LAA_opA_LAAq:  wrap_recur(sc, op_recur_cond_a_a_a_laa_opa_laaq);  continue;
+	case OP_RECUR_COND_A_A_A_LAA_LopA_LAAq: wrap_recur_cond_a_a_a_laa_lopa_laaq(sc);           continue;
+	case OP_RECUR_AND_A_OR_A_LAA_LAA:       wrap_recur(sc, op_recur_and_a_or_a_laa_laa);       continue;
+
+
+	case OP_SAFE_CLOSURE_STAR_A: if (!closure_star_is_fine(sc, sc->code, FINE_SAFE_CLOSURE_STAR, 1)) {if (op_unknown_a(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_STAR_A: op_safe_closure_star_a(sc, sc->code); goto BEGIN;
+
+	case OP_SAFE_CLOSURE_STAR_A1: if (!closure_star_is_fine(sc, sc->code, FINE_SAFE_CLOSURE_STAR, 1)) {if (op_unknown_a(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_STAR_A1: op_safe_closure_star_a1(sc, sc->code); goto BEGIN;
+
+	case OP_SAFE_CLOSURE_STAR_KA: if (!closure_star_is_fine(sc, sc->code, FINE_SAFE_CLOSURE_STAR, 1)) {if (op_unknown_a(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_STAR_KA: op_safe_closure_star_ka(sc, sc->code); goto BEGIN;
+
+	case OP_SAFE_CLOSURE_STAR_AA: if (!closure_star_is_fine(sc, sc->code, FINE_SAFE_CLOSURE_STAR, 2)) {if (op_unknown_aa(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_STAR_AA: op_safe_closure_star_aa(sc, sc->code); goto BEGIN;
+
+	case OP_SAFE_CLOSURE_STAR_AA_O: if (!closure_star_is_fine(sc, sc->code, FINE_SAFE_CLOSURE_STAR, 2)) {if (op_unknown_aa(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_STAR_AA_O: op_safe_closure_star_aa(sc, sc->code); sc->code = car(sc->code); goto EVAL;
+
+	case OP_SAFE_CLOSURE_STAR_3A: if (!closure_star_is_fine(sc, sc->code, FINE_UNSAFE_CLOSURE_STAR, 3)) {if (op_unknown_na(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_STAR_3A: if (op_safe_closure_star_aaa(sc, sc->code)) goto EVAL; goto BEGIN;
+
+	case OP_SAFE_CLOSURE_STAR_NA:
+	  if (!closure_star_is_fine(sc, sc->code, FINE_SAFE_CLOSURE_STAR, (is_pair(cdr(sc->code))) ? opt3_arglen(cdr(sc->code)) : 0))
+	    {if (op_unknown_na(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_STAR_NA: if (op_safe_closure_star_na(sc, sc->code)) goto EVAL; goto BEGIN;
+
+	case OP_SAFE_CLOSURE_STAR_NA_0: if (!closure_star_is_fine(sc, sc->code, FINE_SAFE_CLOSURE_STAR, 0)) {if (op_unknown(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_STAR_NA_0: if (op_safe_closure_star_na_0(sc, sc->code)) goto EVAL; goto BEGIN;
+
+	case OP_SAFE_CLOSURE_STAR_NA_1: if (!closure_star_is_fine(sc, sc->code, FINE_SAFE_CLOSURE_STAR, 1)) {if (op_unknown_a(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_STAR_NA_1: if (op_safe_closure_star_na_1(sc, sc->code)) goto EVAL; goto BEGIN;
+
+	case OP_SAFE_CLOSURE_STAR_NA_2: if (!closure_star_is_fine(sc, sc->code, FINE_SAFE_CLOSURE_STAR, 2)) {if (op_unknown_aa(sc)) goto EVAL; continue;}
+	case HOP_SAFE_CLOSURE_STAR_NA_2: if (op_safe_closure_star_na_2(sc, sc->code)) goto EVAL; goto BEGIN;
+
+
+	case OP_CLOSURE_STAR_A: if (!closure_star_is_fine(sc, sc->code, FINE_UNSAFE_CLOSURE_STAR, 1)) {if (op_unknown_a(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_STAR_A: op_closure_star_a(sc, sc->code); goto BEGIN;
+
+	case OP_CLOSURE_STAR_KA: if (!closure_star_is_fine(sc, sc->code, FINE_UNSAFE_CLOSURE_STAR, 1)) {if (op_unknown_aa(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_STAR_KA: op_closure_star_ka(sc, sc->code); goto BEGIN;
+
+	case OP_CLOSURE_STAR_NA:
+	  if (!closure_star_is_fine(sc, sc->code, FINE_UNSAFE_CLOSURE_STAR, (is_pair(cdr(sc->code))) ? opt3_arglen(cdr(sc->code)) : 0))
+	    {if (op_unknown_na(sc)) goto EVAL; continue;}
+	case HOP_CLOSURE_STAR_NA: if (op_closure_star_na(sc, sc->code)) goto EVAL; goto BEGIN;
+
+
+	case OP_UNKNOWN:    sc->last_function = lookup_checked(sc, car(sc->code)); if (op_unknown(sc))    goto EVAL; continue;
+	case OP_UNKNOWN_NS: sc->last_function = lookup_checked(sc, car(sc->code)); if (op_unknown_ns(sc)) goto EVAL; continue;
+	case OP_UNKNOWN_S:  sc->last_function = lookup_checked(sc, car(sc->code)); if (op_unknown_s(sc))  goto EVAL; continue;
+	case OP_UNKNOWN_GG: sc->last_function = lookup_checked(sc, car(sc->code)); if (op_unknown_gg(sc)) goto EVAL; continue;
+	case OP_UNKNOWN_A:  sc->last_function = lookup_checked(sc, car(sc->code)); if (op_unknown_a(sc))  goto EVAL; continue;
+	case OP_UNKNOWN_AA: sc->last_function = lookup_checked(sc, car(sc->code)); if (op_unknown_aa(sc)) goto EVAL; continue;
+	case OP_UNKNOWN_NA: sc->last_function = lookup_checked(sc, car(sc->code)); if (op_unknown_na(sc)) goto EVAL; continue;
+	case OP_UNKNOWN_NP: sc->last_function = lookup_checked(sc, car(sc->code)); if (op_unknown_np(sc)) goto EVAL; continue;
+
+
+	case OP_IMPLICIT_VECTOR_REF_A:      if (!inline_op_implicit_vector_ref_a(sc)) {if (op_unknown_a(sc))  goto EVAL;} continue;
+	case OP_IMPLICIT_VECTOR_REF_AA:     if (!op_implicit_vector_ref_aa(sc))     {if (op_unknown_aa(sc)) goto EVAL;} continue;
+	case OP_IMPLICIT_STRING_REF_A:      if (!op_implicit_string_ref_a(sc))      {if (op_unknown_a(sc))  goto EVAL;} continue;
+	case OP_IMPLICIT_HASH_TABLE_REF_A:  if (!op_implicit_hash_table_ref_a(sc))  {if (op_unknown_a(sc))  goto EVAL;} continue;
+	case OP_IMPLICIT_HASH_TABLE_REF_AA: if (!op_implicit_hash_table_ref_aa(sc)) {if (op_unknown_a(sc))  goto EVAL;} continue;
+	case OP_IMPLICIT_CONTINUATION_A:    if (!op_implicit_continuation_a(sc))    {if (op_unknown_a(sc))  goto EVAL;} continue;
+	case OP_IMPLICIT_ITERATE:           if (!op_implicit_iterate(sc))           {if (op_unknown(sc))    goto EVAL;} continue;
+	case OP_IMPLICIT_LET_REF_C:         if (!op_implicit_let_ref_c(sc))         {if ((has_fx(cdr(sc->code))) && (op_unknown_a(sc))) goto EVAL;} continue;
+	case OP_IMPLICIT_LET_REF_A:         if (!op_implicit_let_ref_a(sc))         {if (op_unknown_a(sc))  goto EVAL;} continue;
+	case OP_IMPLICIT_PAIR_REF_A:        if (!op_implicit_pair_ref_a(sc))        {if (op_unknown_a(sc))  goto EVAL;} continue;
+	case OP_IMPLICIT_PAIR_REF_AA:       if (!op_implicit_pair_ref_aa(sc))       {if (op_unknown_aa(sc)) goto EVAL;} continue;
+	case OP_IMPLICIT_C_OBJECT_REF_A:    if (!op_implicit_c_object_ref_a(sc))    {if (op_unknown_a(sc))  goto EVAL;} continue;
+	case OP_IMPLICIT_GOTO:              if (!op_implicit_goto(sc))              {if (op_unknown(sc))    goto EVAL;} continue;
+	case OP_IMPLICIT_GOTO_A:            if (!op_implicit_goto_a(sc))            {if (op_unknown_a(sc))  goto EVAL;} continue;
+	case OP_IMPLICIT_VECTOR_SET_3:      if (op_implicit_vector_set_3(sc)) goto EVAL; continue;
+	case OP_IMPLICIT_VECTOR_SET_4:      if (op_implicit_vector_set_4(sc)) goto EVAL; continue;
+	case OP_IMPLICIT_S7_STARLET_REF_S:  sc->value = s7_starlet(sc, opt3_int(sc->code)); continue;
+	case OP_IMPLICIT_S7_STARLET_SET:    sc->value = s7_starlet_set_1(sc, opt3_sym(sc->code), fx_call(sc, cddr(sc->code))); continue;
+
+	case OP_UNOPT:       goto UNOPT;
+	case OP_SYMBOL:      sc->value = lookup_checked(sc, sc->code);     continue;
+	case OP_CONSTANT:    sc->value = sc->code;                         continue;
+	case OP_PAIR_PAIR:   if (op_pair_pair(sc)) goto EVAL;              continue;         /* car is pair ((if x car cadr) ...) */
+	case OP_PAIR_ANY:    sc->value = car(sc->code);                    goto EVAL_ARGS_TOP;
+	case OP_PAIR_SYM:    if (op_pair_sym(sc)) goto EVAL_ARGS_TOP;      continue;
+
+	case OP_EVAL_SET1_NO_MV:
+	  sc->args = list_1(sc, sc->value);
+	  goto APPLY; /* args = (val), code = setter */
+
+	case OP_EVAL_SET2_NO_MV: sc->args = pair_append(sc, sc->args, list_1(sc, sc->value)); goto APPLY; /* <val> is a normal value */
+	  /* perhaps in_place is safe here: args=list_1(sc->value) if eval_set2, mv if eval_set2_mv */
+
+	case OP_EVAL_SET2_MV: /* <inds> = sc->value is a mv */
+	  push_stack(sc, OP_EVAL_SET2_NO_MV, sc->value, sc->code); /* sc->value = inds */
+	  goto EVAL_SET2;
+
+	case OP_EVAL_SET2: /* <ind> = sc->value is a normal value */
+	  push_stack(sc, OP_EVAL_SET2_NO_MV, list_1(sc, sc->value), sc->code); /* sc->value = ind */
+	EVAL_SET2:
+	  sc->code = sc->args; /* value */
+	  sc->cur_op = optimize_op(sc->code);
+	  goto TOP_NO_POP;
+
+	case OP_EVAL_SET3_NO_MV: op_eval_set3_no_mv(sc); goto APPLY; /* <val> is a normal value */
+
+	case OP_EVAL_SET3_MV: /* <inds> = sc->value is a mv */
+	  sc->args = (is_null(sc->args)) ? sc->value : pair_append(sc, sc->args, T_Lst(sc->value));
+	  goto EVAL_SET3;
+
+	case OP_EVAL_SET3: /* <ind> = sc->value is a normal value */
+	  sc->args = (is_null(sc->args)) ? list_1(sc, sc->value) : pair_append(sc, sc->args, list_1(sc, sc->value)); /* not in_place here */
+	EVAL_SET3:
+	  op_eval_set3(sc);
+	  goto TOP_NO_POP;
+
+	case OP_EVAL_ARGS1: sc->args = cons(sc, sc->value, sc->args); goto EVAL_ARGS;
+	case OP_EVAL_ARGS2: op_eval_args2(sc); goto APPLY; /* sc->value is the last arg, [so if is_null(cdr(sc->code) and current is pair, push args2] */
+	case OP_EVAL_ARGS3: op_eval_args3(sc); goto APPLY; /* sc->value is the next-to-last arg, and the last arg is not a list (so values can't mess us up!) */
+	case OP_EVAL_ARGS4: sc->args = cons(sc, sc->value, sc->args); goto EVAL_ARGS_PAIR;
+	case OP_EVAL_ARGS5: op_eval_args5(sc); goto APPLY;
+
+	EVAL_ARGS_TOP:
+	case OP_EVAL_ARGS:
+	  if (dont_eval_args(sc->value))
+	    {
+	      if (eval_args_no_eval_args(sc)) goto APPLY;
+	      goto TOP_NO_POP;
+	    }
+	  sc->code = cdr(sc->code);
+	  /* sc->value is the func (but can be anything if the code is messed up: (#\a 3))
+	   *   we don't have to delay lookup of the func because arg evaluation order is not specified, so
+	   *     (let ((func +)) (func (let () (set! func -) 3) 2))
+	   *   can return 5.
+	   */
+	  push_op_stack(sc, sc->value);
+	  if (sc->op_stack_now >= sc->op_stack_end)
+	    resize_op_stack(sc);
+	  sc->args = sc->nil;
+
+	EVAL_ARGS:	          /* first time, value = op, args = nil, code is args */
+	  if (is_pair(sc->code))  /* evaluate current arg -- must check for pair here, not sc->nil (improper list as args) */
+	    {
+	      if ((sc->safety > NO_SAFETY) &&
+		  (!is_safety_checked(sc->code)))
+		{
+		  if (tree_is_cyclic(sc, sc->code))
+		    syntax_error_nr(sc, "attempt to evaluate a circular list: ~A", 39, sc->code);
+		  set_safety_checked(sc->code);
+		}
+	    EVAL_ARGS_PAIR:
+	      if (is_pair(car(sc->code)))
+		{
+		  eval_args_pair_car(sc);
+		  goto EVAL;
+		}
+	      if (is_pair(cdr(sc->code)))
+		{
+		  s7_pointer car_code = car(sc->code); /* not a pair */
+		  sc->code = cdr(sc->code);
+		  sc->value = (is_symbol(car_code)) ? lookup_checked(sc, car_code) : T_Ext(car_code);
+		  /* sc->value is the current arg's value, sc->code is pointing to the next */
+
+		  /* cdr(sc->code) might not be a pair or nil here! (eq? #f . 1) -> sc->code is 1 */
+		  if (is_null(cdr(sc->code)))
+		    {
+		      if (eval_args_last_arg(sc)) goto EVAL;
+		      /* drop into APPLY */
+		    }
+		  else
+		    {
+		      /* here we know sc->code is a pair, cdr(sc->code) is not null, sc->value is the previous arg's value */
+		      sc->args = cons(sc, sc->value, sc->args);
+		      goto EVAL_ARGS_PAIR;
+		    }}
+	      else eval_last_arg(sc, car(sc->code));
+	      /* drop into APPLY */
+	    }
+	  else                       /* got all args -- go to apply */
+	    {
+	      /* *(--sc->op_stack_now) is the "function" (sc->value perhaps), sc->code is the arglist end, sc->args might be the preceding args reversed? */
+	      if (is_not_null(sc->code))
+		improper_arglist_error_nr(sc);
+	      sc->code = pop_op_stack(sc);
+	      sc->args = proper_list_reverse_in_place(sc, sc->args);
+	    }
+	  /* turning this into a call on an array of functions was not a complete disaster, but tauto.scm was ~1.5% slower.
+	   *   the array-index overhead is the same as the current switch statement's, but there was also the boolean+jump overhead,
+	   *   and the function-local overhead currently otherwise 0 if inlined.
+	   */
+	APPLY:
+	case OP_APPLY:
+	  if (SHOW_EVAL_OPS) safe_print(fprintf(stderr, "  %s[%d]: op_apply %s (%s) to %s\n", __func__, __LINE__,
+						display_truncated(sc->code), s7_type_names[type(sc->code)], display_truncated(sc->args)));
+	  switch (type(sc->code))
+	    {
+	    case T_C_FUNCTION:          sc->value = apply_c_function(sc, sc->code, sc->args); continue;
+	    case T_C_RST_NO_REQ_FUNCTION: apply_c_rst_no_req_function(sc); continue;
+	    case T_C_FUNCTION_STAR:     apply_c_function_star(sc);      continue;
+	    case T_CONTINUATION:        call_with_current_continuation(sc); continue;
+	    case T_GOTO:	        call_with_exit(sc);	        continue;
+	    case T_C_OBJECT:	        apply_c_object(sc);	        continue;
+	    case T_STRING:	        apply_string(sc);	        continue;
+	    case T_HASH_TABLE:	        apply_hash_table(sc);           continue;
+	    case T_ITERATOR:	        apply_iterator(sc);	        continue;
+	    case T_LET:	                apply_let(sc);	                continue;
+	    case T_INT_VECTOR: case T_BYTE_VECTOR: case T_FLOAT_VECTOR:
+	    case T_VECTOR: 	        apply_vector(sc);	        continue;
+	    case T_SYNTAX:	        apply_syntax(sc); 	        goto TOP_NO_POP;
+	    case T_PAIR:	        if (apply_pair(sc)) continue;   goto APPLY;
+	    case T_CLOSURE:             apply_closure(sc);              goto APPLY_LAMBDA;
+	    case T_CLOSURE_STAR:        if (apply_closure_star(sc)) goto EVAL; goto BEGIN;
+	    case T_C_MACRO:  	        apply_c_macro(sc);	        goto EVAL;
+	    case T_MACRO:               apply_macro(sc);                goto APPLY_LAMBDA;
+	    case T_BACRO:               apply_bacro(sc);                goto APPLY_LAMBDA;
+	    case T_MACRO_STAR:          apply_macro_star(sc);           goto BEGIN;
+	    case T_BACRO_STAR:          apply_bacro_star(sc);           goto BEGIN;
+	    default:                    eval_apply_error_nr(sc);
+	    }
+
+	case OP_MACRO_STAR_D: if (op_macro_star_d(sc))     goto EVAL_ARGS_TOP; goto BEGIN;
+	case OP_MACRO_D:      if (op_macro_d(sc, T_MACRO)) goto EVAL_ARGS_TOP; /* fall through presumably */
+
+	APPLY_LAMBDA:
+	case OP_APPLY_LAMBDA:
+	  inline_apply_lambda(sc);
+	  goto BEGIN;
+
+	case OP_LAMBDA_STAR_DEFAULT: if (op_lambda_star_default(sc)) goto EVAL; goto BEGIN;
+
+	case OP_MACROEXPAND_1:
+	  switch (op_macroexpand_1(sc)) {case goto_begin: goto BEGIN; case goto_eval: goto EVAL; case goto_start: continue; default: goto APPLY_LAMBDA;}
+	case OP_MACROEXPAND:
+	  switch (op_macroexpand(sc)) {case goto_begin: goto BEGIN; case goto_eval: goto EVAL; case goto_start: continue; default: goto APPLY_LAMBDA;}
+
+
+	HEAPSORT: if (op_heapsort(sc)) continue; if (sc->value != sc->F) goto APPLY;
+	case OP_SORT1: op_sort1(sc); goto APPLY;
+	case OP_SORT2: if (op_sort2(sc)) continue; goto HEAPSORT;
+	case OP_SORT:  if (!op_sort(sc)) goto HEAPSORT;
+	case OP_SORT3: if (op_sort3(sc)) continue; goto HEAPSORT;
+	case OP_SORT_PAIR_END:   sc->value = vector_into_list(sc, sc->value, car(sc->args)); continue;
+	case OP_SORT_VECTOR_END: sc->value = vector_into_fi_vector(sc->value, car(sc->args)); continue;
+	case OP_SORT_STRING_END: sc->value = vector_into_string(sc->value, car(sc->args)); continue;
+
+#if S7_DEBUGGING
+	case OP_MAP_UNWIND: /* this probably can't happen -- left on stack only if opt succeeds then func called */
+	  fprintf(stderr, "%s[%d]: op_map_unwind %" ld64 "\n", __func__, __LINE__, sc->map_call_ctr);
+	  sc->map_call_ctr--;
+	  if (sc->map_call_ctr < 0) {fprintf(stderr, "%s[%d]: map ctr: %" ld64 "\n", __func__, __LINE__, sc->map_call_ctr); sc->map_call_ctr = 0;}
+	  continue;
+#endif
+	case OP_MAP_GATHER: inline_op_map_gather(sc);
+	case OP_MAP: if (op_map(sc)) continue; goto APPLY;
+
+	case OP_MAP_GATHER_1: inline_op_map_gather(sc);
+	case OP_MAP_1: if (op_map_1(sc)) continue; goto BEGIN;
+
+	case OP_MAP_GATHER_2:
+	case OP_MAP_GATHER_3: inline_op_map_gather(sc);
+	case OP_MAP_2: if (op_map_2(sc)) continue; goto EVAL;
+
+	case OP_FOR_EACH:   if (op_for_each(sc)) continue;   goto APPLY;
+	case OP_FOR_EACH_1: if (inline_op_for_each_1(sc)) continue; goto BEGIN;
+
+	case OP_FOR_EACH_2:
+	case OP_FOR_EACH_3: if (inline_op_for_each_2(sc)) continue; goto EVAL;
+
+	case OP_MEMBER_IF:
+	case OP_MEMBER_IF1: if (op_member_if(sc)) continue; goto APPLY;
+
+	case OP_ASSOC_IF:
+	case OP_ASSOC_IF1:  if (op_assoc_if(sc)) continue;  goto APPLY;
+
+
+	case OP_SAFE_DOTIMES: /* gen form */
+	SAFE_DOTIMES:         /* check_do */
+	  switch (op_safe_dotimes(sc))
+	    {
+	    case goto_safe_do_end_clauses: if (is_null(sc->code)) continue; goto DO_END_CODE;
+	    case goto_do_end_clauses: goto DO_END_CLAUSES;
+	    case goto_eval:           goto EVAL;
+	    case goto_top_no_pop:     goto TOP_NO_POP;
+	    default:                  goto BEGIN;
+	    }
+
+	case OP_SAFE_DO:
+	SAFE_DO:             /* from check_do */
+	  switch (op_safe_do(sc)) /* mat */
+	    {
+	    case goto_safe_do_end_clauses:
+	      if (is_null(sc->code)) continue; /* multiple values (as test result) can't happen -- safe do loops involve counters by 1 to some integer end */
+	      goto DO_END_CODE;
+	    case goto_do_unchecked: goto DO_UNCHECKED;
+	    default: goto BEGIN;
+	    }
+
+	case OP_DOTIMES_P:
+	DOTIMES_P:           /* from check_do */
+	  switch (op_dotimes_p(sc))
+	    {
+	    case goto_do_end_clauses: goto DO_END_CLAUSES;
+	    case goto_do_unchecked:   goto DO_UNCHECKED;
+	    default:                  goto EVAL;
+	    }
+
+	case OP_DOX:
+	DOX:                  /* from check_do */
+	  switch (op_dox(sc)) /* lg fft exit */
+	    {
+	    case goto_do_end_clauses: goto DO_END_CLAUSES;
+	    case goto_start:          continue;
+	    case goto_top_no_pop:     goto TOP_NO_POP; /* includes dox_step_o */
+	    default:		      goto BEGIN;
+	  }
+
+	DO_NO_BODY:
+	case OP_DO_NO_BODY_NA_VARS:        op_do_no_body_na_vars(sc); goto EVAL;
+	case OP_DO_NO_BODY_NA_VARS_STEP:   if (op_do_no_body_na_vars_step(sc)) goto DO_END_CLAUSES; goto EVAL;
+	case OP_DO_NO_BODY_NA_VARS_STEP_1: if (op_do_no_body_na_vars_step_1(sc)) goto DO_END_CLAUSES; goto EVAL;
+
+	case OP_DO_NO_VARS_NO_OPT:   op_do_no_vars_no_opt(sc); /* fall through */
+	case OP_DO_NO_VARS_NO_OPT_1: if (op_do_no_vars_no_opt_1(sc)) goto DO_END_CLAUSES; goto BEGIN;
+	case OP_DO_NO_VARS:	     if (op_do_no_vars(sc))          goto DO_END_CLAUSES; goto BEGIN;
+	case OP_SAFE_DOTIMES_STEP_O: if (op_safe_dotimes_step_o(sc)) goto DO_END_CLAUSES; goto EVAL;
+	case OP_SAFE_DOTIMES_STEP:   if (op_safe_dotimes_step(sc))   goto DO_END_CLAUSES; goto EVAL;
+	case OP_SAFE_DO_STEP:        if (op_safe_do_step(sc))        goto DO_END_CLAUSES; goto BEGIN;
+	case OP_SIMPLE_DO:           if (op_simple_do(sc))           goto DO_END_CLAUSES; goto BEGIN;
+	case OP_SIMPLE_DO_STEP:      if (op_simple_do_step(sc))      goto DO_END_CLAUSES; goto BEGIN;
+	case OP_DOTIMES_STEP_O:      if (op_dotimes_step_o(sc))      goto DO_END_CLAUSES; goto EVAL;
+	case OP_DOX_INIT:            if (op_dox_init(sc))            goto DO_END_CLAUSES; goto BEGIN;
+	case OP_DOX_STEP:            if (op_dox_step_1(sc))          goto DO_END_CLAUSES; op_dox_step(sc);   goto BEGIN;
+	case OP_DOX_STEP_O:          if (op_dox_step_1(sc))          goto DO_END_CLAUSES; op_dox_step_o(sc); goto EVAL;
+	case OP_DOX_NO_BODY:         op_dox_no_body(sc);             continue;
+	case OP_DOX_PENDING_NO_BODY: op_dox_pending_no_body(sc);     goto DO_END_CLAUSES;
+
+	case OP_DO_INIT: if (op_do_init(sc)) goto DO_END; goto EVAL; /* looping if need eval for init */
+
+	case OP_DO:
+	  if (is_null(check_do(sc)))
+	    switch (optimize_op(sc->code))
+	      {
+ 	      case OP_DOX:	    goto DOX;
+ 	      case OP_SAFE_DOTIMES: goto SAFE_DOTIMES;
+ 	      case OP_DOTIMES_P:    goto DOTIMES_P;
+ 	      case OP_SAFE_DO:	    goto SAFE_DO;
+	      case OP_DO_NO_BODY_NA_VARS: goto DO_NO_BODY;
+ 	      case OP_DO_NO_VARS:   if (op_do_no_vars(sc)) goto DO_END_CLAUSES; goto BEGIN;
+	      case OP_DOX_NO_BODY:  op_dox_no_body(sc); continue;
+	      case OP_DOX_PENDING_NO_BODY: op_dox_pending_no_body(sc); goto DO_END_CLAUSES;
+	      default:              if (op_simple_do(sc)) goto DO_END_CLAUSES; goto BEGIN;
+	      }
+
+	case OP_DO_UNCHECKED:
+	  op_do_unchecked(sc);
+	DO_UNCHECKED:
+	  if (do_unchecked(sc)) goto EVAL;
+
+	DO_END:
+	case OP_DO_END:
+	  if (op_do_end(sc)) goto EVAL;
+
+	case OP_DO_END1:
+	  if (is_true(sc, sc->value))
+	    {
+	      goto_t next = op_do_end_true(sc);
+	      if (next == goto_start) continue;
+	      if (next == goto_eval) goto EVAL;
+	      goto FEED_TO;
+	    }
+	  else
+	    {
+	      goto_t next = op_do_end_false(sc);
+	      if (next == goto_begin) goto BEGIN;
+	      if (next == goto_do_end) goto DO_END;
+	      /* fall through */
+	    }
+
+	case OP_DO_STEP:  if (op_do_step(sc))  goto DO_END; goto EVAL;
+	case OP_DO_STEP2: if (op_do_step2(sc)) goto DO_END; goto EVAL;
+
+	DO_END_CLAUSES:
+	  if (do_end_clauses(sc)) continue;
+	DO_END_CODE:
+	  {
+	    goto_t next = do_end_code(sc);
+	    if (next == goto_eval) goto EVAL;
+	    if (next == goto_start) continue;
+	    goto FEED_TO;
+	  }
+
+
+	case OP_BEGIN_UNCHECKED:
+	  set_current_code(sc, sc->code);
+	  sc->code = T_Pair(cdr(sc->code));
+	  goto BEGIN;
+
+	case OP_BEGIN:
+	  if (op_begin(sc, sc->code)) continue;
+	  sc->code = T_Pair(cdr(sc->code));
+
+	case OP_BEGIN_HOOK:
+	  if (sc->begin_hook)
+	    {
+	      /* call_begin_hook might clobber sc->code? via s7_eval_string probably yes */
+	      set_current_code(sc, sc->code);
+	      if (call_begin_hook(sc))
+		return(sc->F);
+	    }
+	case OP_BEGIN_NO_HOOK:
+	  goto BEGIN;
+
+	case OP_BEGIN_2_UNCHECKED:
+	  push_stack_no_args(sc, OP_EVAL, caddr(sc->code));
+	  sc->code = cadr(sc->code);
+	  goto EVAL;
+
+	case OP_BEGIN_AA: sc->value = fx_begin_aa(sc, sc->code); continue;
+	case OP_BEGIN_NA: sc->value = fx_begin_na(sc, sc->code); continue;
+
+
+	case OP_EVAL: goto EVAL;
+	case OP_EVAL_STRING: op_eval_string(sc); goto EVAL;
+
+	case OP_QUOTE: sc->value = check_quote(sc, sc->code); continue;
+	case OP_QUOTE_UNCHECKED: sc->value = cadr(sc->code); continue;
+
+	case OP_DEFINE_FUNCHECKED: define_funchecked(sc);   continue;
+	case OP_DEFINE_CONSTANT1:  op_define_constant1(sc); continue;
+
+	case OP_DEFINE_CONSTANT_UNCHECKED:
+	  push_stack_no_args(sc, OP_DEFINE_CONSTANT1, cadr(sc->code));
+	  goto DEFCONS;
+
+	case OP_DEFINE_CONSTANT:
+	  if (op_define_constant(sc)) continue;
+
+	case OP_DEFINE_STAR: case OP_DEFINE:
+	  check_define(sc);
+
+	DEFCONS:
+	case OP_DEFINE_STAR_UNCHECKED:
+	case OP_DEFINE_UNCHECKED:
+	  if (op_define_unchecked(sc)) goto TOP_NO_POP;
+
+	case OP_DEFINE1: if (op_define1(sc)) goto APPLY;
+	case OP_DEFINE_WITH_SETTER: op_define_with_setter(sc); continue;
+
+	case OP_SET_opSq_A:     if (op_set_opsq_a(sc))     goto APPLY; continue;
+	case OP_SET_opSAq_A:	if (op_set_opsaq_a(sc))    goto APPLY; continue;
+	case OP_SET_opSAq_P:    if (op_set_opsaq_p(sc))    goto APPLY; goto EVAL;
+	case OP_SET_opSAq_P_1:  if (op_set_opsaq_p_1(sc))  goto APPLY; continue;
+	case OP_SET_opSAAq_A:	if (op_set_opsaaq_a(sc))   goto APPLY; continue;
+	case OP_SET_opSAAq_P:   if (op_set_opsaaq_p(sc))   goto APPLY; goto EVAL;
+	case OP_SET_opSAAq_P_1: if (op_set_opsaaq_p_1(sc)) goto APPLY; continue;
+
+	case OP_INCREMENT_BY_1: inline_op_increment_by_1(sc); continue;
+	case OP_DECREMENT_BY_1: op_decrement_by_1(sc); continue;
+	case OP_INCREMENT_SA:   op_increment_sa(sc);   continue;
+	case OP_INCREMENT_SAA:  op_increment_saa(sc);  continue;
+
+	case OP_SET_S_C:        op_set_s_c(sc);  continue;
+	case OP_SET_S_S:        op_set_s_s(sc);  continue;
+	case OP_SET_S_A:        op_set_s_a(sc);  continue;
+	case OP_SET_S_P:        op_set_s_p(sc);  goto EVAL;
+	case OP_SET_CONS:       op_set_cons(sc); continue;
+ 	case OP_SET_SAFE:	op_set_safe(sc); continue;
+
+	case OP_SET_FROM_SETTER: slot_set_value(sc->code, sc->value); continue; /* mv caught in splice_in_values */
+	case OP_SET_FROM_LET_TEMP: op_set_from_let_temp(sc); continue;
+
+	case OP_SET2:
+	  switch (op_set2(sc)) /* imp */
+	    {
+	    case goto_eval:       goto EVAL;
+	    case goto_top_no_pop: goto TOP_NO_POP;
+	    case goto_start:      continue;
+	    case goto_apply:      goto APPLY;
+	    case goto_unopt:      goto UNOPT;
+	    default:              goto EVAL_ARGS; /* goto_eval_args in funcs called by op_set2, unopt */
+	    }
+
+	case OP_SET: check_set(sc);
+	case OP_SET_UNCHECKED:
+	SET_UNCHECKED:
+	  if (is_pair(cadr(sc->code)))             /* has setter */
+	    switch (set_implicit(sc))
+	      {
+	      case goto_top_no_pop: goto TOP_NO_POP;
+	      case goto_start:      continue;
+	      case goto_apply:      goto APPLY;
+	      case goto_unopt:      goto UNOPT;
+	      default:              goto EVAL_ARGS; /* very common, op_unopt at this point */
+	      }
+	case OP_SET_NORMAL: if (op_set_normal(sc)) goto EVAL;
+	case OP_SET1:       if (op_set1(sc)) continue; goto APPLY;
+
+	case OP_SET_WITH_LET_1: if (op_set_with_let_1(sc)) goto TOP_NO_POP; goto SET_WITH_LET;
+	case OP_SET_WITH_LET_2: if (op_set_with_let_2(sc)) continue;
+	SET_WITH_LET:
+	  activate_with_let(sc, sc->value);  /* this activates sc->value, so the set! will happen in that environment */
+	  if (is_pair(cadr(sc->code)))
+	    switch (set_implicit(sc))  /* imp misc */
+	      {
+	      case goto_top_no_pop: goto TOP_NO_POP;
+	      case goto_start:      continue;
+	      case goto_apply:      goto APPLY;
+	      case goto_unopt:      goto UNOPT;
+	      default:              goto EVAL_ARGS; /* unopt */
+	      }
+	  set_with_let_error_nr(sc);
+
+	case OP_IF:           op_if(sc);           goto EVAL;
+	case OP_IF_UNCHECKED: op_if_unchecked(sc); goto EVAL;
+	case OP_IF1:	      if (op_if1(sc)) goto EVAL; continue;
+
+	  #define if_a_p(sc) if (is_true(sc, fx_call(sc, cdr(sc->code))))
+	  #define if_not_a_p(sc) if (is_false(sc, fx_call(sc, opt3_pair(sc->code)))) /* cdadr(sc->code) */
+
+	case OP_IF_A_C_C:     sc->value = (is_true(sc, fx_call(sc, cdr(sc->code)))) ? opt1_con(sc->code) : opt2_con(sc->code); continue;
+	case OP_IF_A_A:       sc->value = (is_true(sc, fx_call(sc, cdr(sc->code)))) ? fx_call(sc, opt1_pair(sc->code)) : sc->unspecified; continue;
+	case OP_IF_S_A_A:     sc->value = (is_true(sc, lookup(sc, cadr(sc->code)))) ? fx_call(sc, opt1_pair(sc->code)) : fx_call(sc, opt2_pair(sc->code)); continue;
+	case OP_IF_A_A_A:     sc->value = (is_true(sc, fx_call(sc, cdr(sc->code)))) ? fx_call(sc, opt1_pair(sc->code)) : fx_call(sc, opt2_pair(sc->code)); continue;
+	case OP_IF_A_A_P:     if_a_p(sc) {sc->value = fx_call(sc, opt1_pair(sc->code)); continue;} sc->code = opt2_any(sc->code); goto EVAL;
+	case OP_IF_A_P_A:     if_a_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->value = fx_call(sc, opt2_pair(sc->code)); continue;
+	case OP_IF_NOT_A_A:   sc->value = (is_false(sc, fx_call(sc, opt1_pair(sc->code)))) ? fx_call(sc, opt2_pair(sc->code)) : sc->unspecified; continue;
+	case OP_IF_NOT_A_A_A: sc->value = (is_false(sc, fx_call(sc, opt1_pair(sc->code)))) ? fx_call(sc, opt2_pair(sc->code)) : fx_call(sc, opt3_pair(sc->code)); continue;
+	case OP_IF_AND2_S_A:  sc->value = fx_if_and2_s_a(sc, sc->code); continue;
+
+	  #define call_bfunc(Sc, Expr) ((s7_bfunc)opt3_any(cdr(Sc->code)))(Sc, Expr)
+	case OP_IF_B_A:   sc->value = (call_bfunc(sc, cadr(sc->code))) ? fx_call(sc, opt1_pair(sc->code)) : sc->unspecified; continue;
+	case OP_IF_B_A_P: if (call_bfunc(sc, cadr(sc->code))) {sc->value = fx_call(sc, opt1_pair(sc->code)); continue;} sc->code = opt2_any(sc->code); goto EVAL;
+	case OP_IF_B_P_A: if (call_bfunc(sc, cadr(sc->code))) {sc->code = opt1_any(sc->code); goto EVAL;} sc->value = fx_call(sc, opt2_pair(sc->code)); continue;
+	case OP_IF_B_P_P: if (call_bfunc(sc, cadr(sc->code))) {sc->code = opt1_any(sc->code); goto EVAL;} sc->code = opt2_any(sc->code); goto EVAL;
+
+	  #define if_s_p(sc) if (is_true(sc, lookup(sc, cadr(sc->code))))
+	  #define if_not_s_p(sc) if (is_false(sc, lookup(sc, opt1_sym(cdr(sc->code))))) /* cadadr(sc->code) */
+
+	case OP_IF_S_P:   if_s_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->value = sc->unspecified; continue;
+	case OP_IF_S_R:   if_s_p(sc) {sc->value = sc->unspecified; continue;} sc->code = opt1_any(sc->code); goto EVAL;
+	case OP_IF_S_P_P: if_s_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->code = opt2_any(sc->code); goto EVAL;
+	case OP_IF_S_N:   if_not_s_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->value = sc->unspecified; continue;
+	case OP_IF_S_N_N: if_not_s_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->code = opt2_any(sc->code); goto EVAL;
+	case OP_IF_S_P_A: if_s_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->value = fx_call(sc, opt2_pair(sc->code)); continue;
+	case OP_IF_S_A_P: if_s_p(sc) {sc->value = fx_call(sc, opt1_pair(sc->code)); continue;} sc->code = opt2_any(sc->code); goto EVAL;
+
+	case OP_IF_A_P:   if_a_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->value = sc->unspecified; continue;
+	case OP_IF_A_R:   if_a_p(sc) {sc->value = sc->unspecified; continue;} sc->code = opt1_any(sc->code); goto EVAL;
+	case OP_IF_A_P_P: if_a_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->code = opt2_any(sc->code); goto EVAL;
+	case OP_IF_A_N:   if_not_a_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->value = sc->unspecified; continue;
+	case OP_IF_A_N_N: if_not_a_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->code = opt2_any(sc->code); goto EVAL;
+
+	case OP_IF_B_P:   if (call_bfunc(sc, cadr(sc->code))) {sc->code = opt1_any(sc->code); goto EVAL;} sc->value = sc->unspecified; continue;
+	case OP_IF_B_R:   if (call_bfunc(sc, cadr(sc->code))) {sc->value = sc->unspecified; continue;} sc->code = opt1_any(sc->code); goto EVAL;
+	case OP_IF_B_N_N: if (call_bfunc(sc, car(opt3_pair(sc->code)))) {sc->code = opt2_any(sc->code); goto EVAL;} sc->code = opt1_any(sc->code); goto EVAL;
+
+	  #define if_is_type_s_p(sc) if (gen_type_match(sc, lookup(sc, opt2_sym(cdr(sc->code))), opt3_byte(cdr(sc->code))))
+	  #define if_is_not_type_s_p(sc) if (!gen_type_match(sc, lookup(sc, opt2_sym(cdr(sc->code))), opt3_byte(cdr(sc->code))))
+
+	case OP_IF_IS_TYPE_S_P:   if_is_type_s_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->value = sc->unspecified; continue;
+	case OP_IF_IS_TYPE_S_R:   if_is_type_s_p(sc) {sc->value = sc->unspecified; continue;} sc->code = opt1_any(sc->code); goto EVAL;
+	case OP_IF_IS_TYPE_S_P_P: if_is_type_s_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->code = opt2_any(sc->code); goto EVAL;
+	case OP_IF_IS_TYPE_S_N:   if_is_not_type_s_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->value = sc->unspecified; continue;
+	case OP_IF_IS_TYPE_S_N_N: if_is_not_type_s_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->code = opt2_any(sc->code); goto EVAL;
+	case OP_IF_IS_TYPE_S_A_A: if_is_type_s_p(sc) sc->value = fx_call(sc, opt1_pair(sc->code)); else sc->value = fx_call(sc, opt2_pair(sc->code)); continue;
+	case OP_IF_IS_TYPE_S_P_A: if_is_type_s_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->value = fx_call(sc, opt2_pair(sc->code)); continue;
+	case OP_IF_IS_TYPE_S_A_P: if_is_type_s_p(sc) {sc->value = fx_call(sc, opt1_pair(sc->code)); continue;} sc->code = opt2_any(sc->code); goto EVAL;
+
+	  #define if_opsq_p(sc) set_car(sc->t1_1, lookup(sc, opt2_sym(cdr(sc->code)))); if (is_true(sc, fn_proc(cadr(sc->code))(sc, sc->t1_1)))
+	  #define if_not_opsq_p(sc) set_car(sc->t1_1, lookup(sc, opt2_sym(cdr(sc->code)))); if (is_false(sc, fn_proc(opt1_pair(cdr(sc->code)))(sc, sc->t1_1))) /* cadadr */
+
+	case OP_IF_opSq_P:   if_opsq_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->value = sc->unspecified; continue;
+	case OP_IF_opSq_R:   if_opsq_p(sc) {sc->value = sc->unspecified; continue;} sc->code = opt1_any(sc->code); goto EVAL;
+	case OP_IF_opSq_P_P: if_opsq_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->code = opt2_any(sc->code); goto EVAL;
+	case OP_IF_opSq_N:   if_not_opsq_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->value = sc->unspecified; continue;
+	case OP_IF_opSq_N_N: if_not_opsq_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->code = opt2_any(sc->code); goto EVAL;
+
+	  #define if_and2_p(sc) if ((is_true(sc, fx_call(sc, opt2_pair(cdr(sc->code))))) && (is_true(sc, fx_call(sc, opt3_pair(cdr(sc->code))))))
+	  #define if_not_and2_p(sc) if ((is_false(sc, fx_call(sc, opt2_pair(cdr(sc->code))))) || (is_false(sc, fx_call(sc, opt3_pair(cdr(sc->code))))))
+
+	case OP_IF_AND2_P:   if_and2_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->value = sc->unspecified; continue;
+	case OP_IF_AND2_R:   if_and2_p(sc) {sc->value = sc->unspecified; continue;} sc->code = opt1_any(sc->code); goto EVAL;
+	case OP_IF_AND2_P_P: if_and2_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->code = opt2_any(sc->code); goto EVAL;
+	case OP_IF_AND2_N:   if_not_and2_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->value = sc->unspecified; continue;
+	case OP_IF_AND2_N_N: if_not_and2_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->code = opt2_any(sc->code); goto EVAL;
+
+	  #define if_or2_p(sc) if ((is_true(sc, fx_call(sc, opt2_pair(cdr(sc->code))))) || (is_true(sc, fx_call(sc, opt3_pair(cdr(sc->code))))))
+	  #define if_not_or2_p(sc) if ((is_false(sc, fx_call(sc, opt2_pair(cdr(sc->code))))) && (is_false(sc, fx_call(sc, opt3_pair(cdr(sc->code))))))
+
+	case OP_IF_OR2_P:   if_or2_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->value = sc->unspecified; continue;
+	case OP_IF_OR2_R:   if_or2_p(sc) {sc->value = sc->unspecified; continue;} sc->code = opt1_any(sc->code); goto EVAL;
+	case OP_IF_OR2_P_P: if_or2_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->code = opt2_any(sc->code); goto EVAL;
+	case OP_IF_OR2_N:   if_not_or2_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->value = sc->unspecified; continue;
+	case OP_IF_OR2_N_N: if_not_or2_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->code = opt2_any(sc->code); goto EVAL;
+
+	  #define if_and3_p(sc) if ((is_true(sc, fx_call(sc, opt2_pair(cdr(sc->code))))) && \
+                                       (is_true(sc, fx_call(sc, opt3_pair(cdr(sc->code))))) && (is_true(sc, fx_call(sc, opt1_pair(cdr(sc->code))))))
+	  #define if_not_and3_p(sc) if ((is_false(sc, fx_call(sc, opt2_pair(cdr(sc->code))))) || \
+                                          (is_false(sc, fx_call(sc, opt3_pair(cdr(sc->code))))) || (is_false(sc, fx_call(sc, opt1_pair(cdr(sc->code))))))
+
+	case OP_IF_AND3_P:   if_and3_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->value = sc->unspecified; continue;
+	case OP_IF_AND3_R:   if_and3_p(sc) {sc->value = sc->unspecified; continue;} sc->code = opt1_any(sc->code); goto EVAL;
+	case OP_IF_AND3_P_P: if_and3_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->code = opt2_any(sc->code); goto EVAL;
+	case OP_IF_AND3_N:   if_not_and3_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->value = sc->unspecified; continue;
+	case OP_IF_AND3_N_N: if_not_and3_p(sc) {sc->code = opt1_any(sc->code); goto EVAL;} sc->code = opt2_any(sc->code); goto EVAL;
+
+	    #define if_p_push(op) do {push_stack_no_args(sc, op, opt2_any(cdr(sc->code)));  sc->code = opt3_any(cdr(sc->code));} while (0)
+	case OP_IF_P_P:      if_p_push(OP_IF_PP); goto EVAL;
+	case OP_IF_P_N:      if_p_push(OP_IF_PN); goto EVAL;
+	case OP_IF_P_P_P:    if_p_push(OP_IF_PPP); goto EVAL;
+	case OP_IF_P_R:      if_p_push(OP_IF_PR); goto EVAL;
+	case OP_IF_P_N_N:    if_p_push(OP_IF_PRR); goto EVAL;
+
+	    #define if_bp_push(op) do {push_stack_no_args(sc, op, opt2_any(cdr(sc->code)));  sc->code = opt3_pair(cdr(sc->code));} while (0)
+	case OP_IF_ANDP_P:   if_bp_push(OP_IF_PP);  goto AND_P;
+	case OP_IF_ANDP_R:   if_bp_push(OP_IF_PR);  goto AND_P;
+	case OP_IF_ANDP_P_P: if_bp_push(OP_IF_PPP); goto AND_P;
+	case OP_IF_ANDP_N:   if_bp_push(OP_IF_PR);  goto AND_P;
+	case OP_IF_ANDP_N_N: if_bp_push(OP_IF_PRR); goto AND_P;
+
+	case OP_IF_ORP_P:    if_bp_push(OP_IF_PP);  goto OR_P;
+	case OP_IF_ORP_R:    if_bp_push(OP_IF_PR);  goto OR_P;
+	case OP_IF_ORP_P_P:  if_bp_push(OP_IF_PPP); goto OR_P;
+	case OP_IF_ORP_N:    if_bp_push(OP_IF_PR);  goto OR_P;
+	case OP_IF_ORP_N_N:  if_bp_push(OP_IF_PRR); goto OR_P;
+
+	case OP_IF_PP:       if (sc->value != sc->F) goto EVAL; sc->value = sc->unspecified; continue;
+	case OP_IF_PN:
+	case OP_IF_PR:       if (sc->value == sc->F) goto EVAL; sc->value = sc->unspecified; continue;
+	case OP_IF_PPP:      sc->code = (sc->value != sc->F) ? car(sc->code) : cadr(sc->code); goto EVAL;
+	case OP_IF_PRR:      sc->code = (sc->value == sc->F) ? car(sc->code) : cadr(sc->code); goto EVAL;
+
+	case OP_WHEN:        check_when(sc);                   goto EVAL;
+	case OP_WHEN_S:      if (op_when_s(sc)) continue;      goto EVAL;
+	case OP_WHEN_A:      if (op_when_a(sc)) continue;      goto EVAL;
+        case OP_WHEN_P:      op_when_p(sc);                    goto EVAL;
+	case OP_WHEN_AND_2A: if (op_when_and_2a(sc)) continue; goto EVAL;
+	case OP_WHEN_AND_3A: if (op_when_and_3a(sc)) continue; goto EVAL;
+	case OP_WHEN_AND_AP: if (op_when_and_ap(sc)) continue; goto EVAL;
+	case OP_WHEN_PP:     if (op_when_pp(sc)) continue;     goto EVAL;
+
+	case OP_UNLESS:      check_unless(sc);                 goto EVAL;
+	case OP_UNLESS_S:    if (op_unless_s(sc)) continue;    goto EVAL;
+	case OP_UNLESS_A:    if (op_unless_a(sc)) continue;    goto EVAL;
+        case OP_UNLESS_P:    op_unless_p(sc);                  goto EVAL;
+	case OP_UNLESS_PP:   if (op_unless_pp(sc)) continue;   goto EVAL;
+
+
+	case OP_COND_FEED:   if (op_cond_feed(sc)) goto EVAL; /* else fall through */
+	case OP_COND_FEED_1: if (is_true(sc, sc->value)) {op_cond_feed_1(sc); goto EVAL;} sc->value = sc->unspecified; continue;
+
+	case OP_COND:           check_cond(sc);
+	case OP_COND_UNCHECKED: if (op_cond_unchecked(sc)) goto EVAL;
+	case OP_COND1:          if (op_cond1(sc)) goto TOP_NO_POP; /* else fall through */
+	FEED_TO:
+	  if (feed_to(sc)) goto APPLY;
+	  goto EVAL;
+	case OP_FEED_TO_1:       sc->code = sc->value; goto APPLY;   /* sc->args saved in feed_to via push_stack */
+
+	case OP_COND_SIMPLE:     if (op_cond_simple(sc)) goto EVAL;
+	case OP_COND1_SIMPLE:    if (op_cond1_simple(sc)) goto TOP_NO_POP; goto BEGIN;
+	case OP_COND_SIMPLE_O:   if (op_cond_simple_o(sc)) goto EVAL;
+	case OP_COND1_SIMPLE_O:  if (op_cond1_simple_o(sc)) continue;  goto EVAL;
+
+	case OP_COND_NA_NA:      sc->value = fx_cond_na_na(sc, sc->code); continue;
+	case OP_COND_NA_NP:      if (op_cond_na_np(sc)) continue;   goto EVAL;
+	case OP_COND_NA_NP_1:    if (op_cond_na_np_1(sc)) continue; goto EVAL;
+	case OP_COND_NA_NP_O:    if (inline_op_cond_na_np_o(sc)) continue; goto EVAL;
+	case OP_COND_NA_2E:      if (op_cond_na_2e(sc)) continue; goto EVAL;
+	case OP_COND_NA_3E:      if (op_cond_na_3e(sc)) continue; goto EVAL;
+
+
+	case OP_AND:
+	  if (check_and(sc, sc->code)) continue;
+	case OP_AND_P:
+	  sc->code = cdr(sc->code);
+	AND_P:                        /* this code (and OR_P below) is ugly, but the pretty version (procedurized) is much slower */
+	  if (has_fx(sc->code))       /* all fx_proc's are set via fx_choose which can return nil, but it is not cleared when type is */
+	    {                         /*   so, if (fx_proc(sc->code)) here and in OR_P is not safe */
+	      sc->value = fx_call(sc, sc->code);
+	      if (is_false(sc, sc->value)) continue;
+	      sc->code = cdr(sc->code);
+	      if (is_null(sc->code)) continue;  /* this order of checks appears to be faster than any of the alternatives */
+	      goto AND_P;
+	    }
+	  if (is_pair(cdr(sc->code)))  /* apparently exactly as fast as is_not_null */
+	    push_stack_no_args(sc, OP_AND_P1, cdr(sc->code));
+	  sc->code = car(sc->code);
+	  goto EVAL;
+
+	case OP_AND_P1:
+	  if ((is_false(sc, sc->value)) ||
+	      (is_null(sc->code)))
+	    continue;
+	  goto AND_P;
+
+	case OP_AND_AP:      if (op_and_ap(sc)) continue; goto EVAL;
+	case OP_AND_2A:      sc->value = fx_and_2a(sc, sc->code); continue;
+	case OP_AND_3A:      sc->value = fx_and_3a(sc, sc->code); continue;
+	case OP_AND_N:       sc->value = fx_and_n(sc, sc->code); continue;
+	case OP_AND_S_2:     sc->value = fx_and_s_2(sc, sc->code); continue;
+	case OP_AND_PAIR_P:  if (op_and_pair_p(sc)) continue; goto EVAL;
+	case OP_AND_SAFE_P1: op_and_safe_p1(sc); goto EVAL;
+	case OP_AND_SAFE_P2: if (op_and_safe_p2(sc)) continue; goto EVAL;
+	case OP_AND_SAFE_P3: if (op_and_safe_p3(sc)) continue; goto EVAL;
+	case OP_AND_SAFE_P_REST: if (is_true(sc, sc->value)) sc->value = fx_and_n(sc, sc->code); continue;
+
+
+	case OP_OR:
+	  if (check_or(sc, sc->code)) continue;
+	case OP_OR_P:
+	  sc->code = cdr(sc->code);
+	OR_P:
+	  if (has_fx(sc->code))
+	    {
+	      sc->value = fx_call(sc, sc->code);
+	      if (is_true(sc, sc->value)) continue;
+	      sc->code = cdr(sc->code);
+	      if (is_null(sc->code)) continue;
+	      goto OR_P;
+	    }
+	  if (is_pair(cdr(sc->code)))
+	    push_stack_no_args(sc, OP_OR_P1, cdr(sc->code)); /* might need to check stack size here */
+	  sc->code = car(sc->code);
+	  goto EVAL;
+
+	case OP_OR_P1:
+	  if ((is_true(sc, sc->value)) ||
+	      (is_null(sc->code)))
+	    continue;
+	  goto OR_P;
+
+	case OP_OR_AP:       if (op_or_ap(sc)) continue; goto EVAL;
+	case OP_OR_2A:       sc->value = fx_or_2a(sc, sc->code);       continue;
+	case OP_OR_S_2:      sc->value = fx_or_s_2(sc, sc->code);      continue;
+	case OP_OR_S_TYPE_2: sc->value = fx_or_s_type_2(sc, sc->code); continue;
+	case OP_OR_3A:       sc->value = fx_or_3a(sc, sc->code);       continue;
+	case OP_OR_N:        sc->value = fx_or_n(sc, sc->code);        continue;
+
+
+	case OP_NAMED_LET_NO_VARS: op_named_let_no_vars(sc);   goto BEGIN;
+	case OP_NAMED_LET:	   if (op_named_let(sc))       goto BEGIN; goto EVAL;
+	case OP_NAMED_LET_A:       op_named_let_a(sc);         goto BEGIN;
+	case OP_NAMED_LET_AA:      op_named_let_aa(sc);        goto BEGIN;
+	case OP_NAMED_LET_NA:      op_named_let_na(sc);        goto BEGIN;
+
+	case OP_LET: 	           if (op_let(sc))             goto BEGIN; goto EVAL;
+	case OP_LET_UNCHECKED:	   if (op_let_unchecked(sc))   goto BEGIN; goto EVAL;
+	case OP_LET1:	           if (op_let_1(sc))           goto BEGIN; goto EVAL;
+	case OP_LET_NO_VARS: 	   op_let_no_vars(sc);	       goto BEGIN;
+
+	case OP_LET_A_A_OLD:       op_let_a_a_old(sc);         continue;
+	case OP_LET_A_A_NEW:       op_let_a_a_new(sc);         continue;
+	case OP_LET_A_NA_OLD:      op_let_a_na_old(sc);        continue;
+	case OP_LET_A_NA_NEW:      op_let_a_na_new(sc);        continue;
+	case OP_LET_NA_OLD: 	   op_let_na_old(sc);	       goto BEGIN;
+	case OP_LET_NA_NEW: 	   inline_op_let_na_new(sc);   goto BEGIN;
+	case OP_LET_2A_OLD: 	   op_let_2a_old(sc);	       goto EVAL;
+	case OP_LET_2A_NEW: 	   op_let_2a_new(sc);	       goto EVAL;
+	case OP_LET_3A_OLD: 	   op_let_3a_old(sc);	       goto EVAL;
+	case OP_LET_3A_NEW: 	   op_let_3a_new(sc);	       goto EVAL;
+	case OP_LET_ONE_OLD:	   op_let_one_old(sc);	       goto EVAL;
+	case OP_LET_ONE_NEW:	   op_let_one_new(sc);	       goto EVAL;
+	case OP_LET_ONE_P_OLD: 	   op_let_one_p_old(sc);       goto EVAL;
+	case OP_LET_ONE_P_NEW: 	   op_let_one_p_new(sc);       goto EVAL;
+
+	case OP_LET_A_OLD:         op_let_a_old(sc);        sc->code = cdr(sc->code);  goto BEGIN;
+	case OP_LET_A_NEW:         inline_op_let_a_new(sc); sc->code = cdr(sc->code);  goto BEGIN;
+	case OP_LET_A_OLD_2:       inline_op_let_a_old(sc); push_stack_no_args(sc, OP_EVAL, caddr(sc->code)); sc->code = cadr(sc->code); goto EVAL;
+	case OP_LET_A_NEW_2:       inline_op_let_a_new(sc); push_stack_no_args(sc, OP_EVAL, caddr(sc->code)); sc->code = cadr(sc->code); goto EVAL;
+	case OP_LET_A_P_OLD:       inline_op_let_a_old(sc); sc->code = cadr(sc->code); goto EVAL;
+	case OP_LET_A_P_NEW:       inline_op_let_a_new(sc); sc->code = cadr(sc->code); goto EVAL;
+	case OP_LET_ONE_OLD_1:     op_let_one_old_1(sc);    goto BEGIN;
+	case OP_LET_ONE_P_OLD_1:   op_let_one_p_old_1(sc);  goto EVAL;
+	case OP_LET_ONE_NEW_1:	   set_curlet(sc, inline_make_let_with_slot(sc, sc->curlet, opt2_sym(sc->code), sc->value)); goto BEGIN;
+	case OP_LET_ONE_P_NEW_1:   set_curlet(sc, inline_make_let_with_slot(sc, sc->curlet, opt2_sym(sc->code), sc->value)); sc->code = car(sc->code); goto EVAL;
+	case OP_LET_opaSSq_OLD:    op_let_opassq_old(sc);   goto BEGIN;
+	case OP_LET_opaSSq_NEW:    op_let_opassq_new(sc);   goto BEGIN;
+
+	case OP_LET_STAR_NA:       op_let_star_na(sc);     goto BEGIN;
+	case OP_LET_STAR_NA_A:     op_let_star_na_a(sc);   continue;
+
+	case OP_NAMED_LET_STAR:    op_named_let_star(sc);  goto EVAL;
+	case OP_LET_STAR2:         op_let_star2(sc);       goto EVAL;
+	case OP_LET_STAR:          if (check_let_star(sc)) goto EVAL; goto BEGIN;
+	case OP_LET_STAR1:         if (op_let_star1(sc))   goto EVAL; goto BEGIN;
+	case OP_LET_STAR_SHADOWED: if (op_let_star_shadowed(sc)) goto EVAL; goto BEGIN;
+
+	case OP_LETREC:            check_letrec(sc, true);
+	case OP_LETREC_UNCHECKED:  if (op_letrec_unchecked(sc)) goto EVAL; goto BEGIN;
+	case OP_LETREC1:           if (op_letrec1(sc)) goto EVAL; goto BEGIN;
+
+	case OP_LETREC_STAR:           check_letrec(sc, false);
+	case OP_LETREC_STAR_UNCHECKED: if (op_letrec_star_unchecked(sc)) goto EVAL; goto BEGIN;
+	case OP_LETREC_STAR1:          if (op_letrec_star1(sc)) goto EVAL; goto BEGIN;
+
+
+	case OP_LET_TEMPORARILY: check_let_temporarily(sc);
+	case OP_LET_TEMP_UNCHECKED: op_let_temp_unchecked(sc); goto LET_TEMP_INIT1;
+
+	case OP_LET_TEMP_INIT1:
+	  op_let_temp_init1_1(sc);
+	LET_TEMP_INIT1:
+	  if (op_let_temp_init1(sc)) goto EVAL;
+	case OP_LET_TEMP_INIT2:
+	  switch (op_let_temp_init2(sc)) /* let misc obj */
+	    {
+	    case goto_begin:         goto BEGIN;
+	    case goto_eval:          goto EVAL;
+	    case goto_set_unchecked: goto SET_UNCHECKED;
+	    case fall_through:
+	    default:                 break;
+	    }
+
+	case OP_LET_TEMP_DONE:
+	  sc->code = sc->value;
+	  push_stack(sc, OP_GC_PROTECT, sc->args, sc->value);  /* save let-temp body val as sc->code */
+	case OP_LET_TEMP_DONE1:
+	  if (op_let_temp_done1(sc)) continue;
+	  goto SET_UNCHECKED;
+
+	case OP_LET_TEMP_S7:        if(op_let_temp_s7(sc))         goto BEGIN; sc->value = sc->nil; continue;
+	case OP_LET_TEMP_S7_DIRECT: if (op_let_temp_s7_direct(sc)) goto BEGIN; sc->value = sc->nil; continue;
+	case OP_LET_TEMP_NA:        if (op_let_temp_na(sc))        goto BEGIN; sc->value = sc->nil; continue;
+	case OP_LET_TEMP_A:         if (op_let_temp_a(sc))         goto BEGIN; sc->value = sc->nil; continue;
+	case OP_LET_TEMP_SETTER:    if (op_let_temp_setter(sc))    goto BEGIN; sc->value = sc->nil; continue;
+	case OP_LET_TEMP_A_A:       sc->value = fx_let_temp_a_a(sc, sc->code); continue;
+
+	case OP_LET_TEMP_UNWIND:           op_let_temp_unwind(sc);           continue;
+	case OP_LET_TEMP_S7_UNWIND:        op_let_temp_s7_unwind(sc);        continue;
+	case OP_LET_TEMP_S7_DIRECT_UNWIND: op_let_temp_s7_direct_unwind(sc); continue;
+	case OP_LET_TEMP_SETTER_UNWIND:    op_let_temp_setter_unwind(sc);    continue;
+
+
+	case OP_EVAL_MACRO:    op_eval_macro(sc);                  goto EVAL;
+	case OP_EVAL_MACRO_MV: if (op_eval_macro_mv(sc)) continue; goto EVAL;
+	case OP_EXPANSION:     op_finish_expansion(sc);            continue;
+
+	case OP_DEFINE_BACRO:     case OP_DEFINE_BACRO_STAR:
+	case OP_DEFINE_EXPANSION: case OP_DEFINE_EXPANSION_STAR:
+	case OP_DEFINE_MACRO:     case OP_DEFINE_MACRO_STAR:
+	  op_define_macro(sc);
+	  continue;
+
+	case OP_MACRO: case OP_BACRO: case OP_MACRO_STAR: case OP_BACRO_STAR:
+	  op_macro(sc);
+	  continue;
+
+	case OP_LAMBDA:                sc->value = op_lambda(sc, sc->code);           continue;
+	case OP_LAMBDA_UNCHECKED:      sc->value = op_lambda_unchecked(sc, sc->code); continue;
+	case OP_LAMBDA_STAR:           op_lambda_star(sc);                            continue;
+	case OP_LAMBDA_STAR_UNCHECKED: op_lambda_star_unchecked(sc);                  continue;
+
+
+	case OP_CASE:                     /* car(sc->code) is the selector */
+	  /* selector A, key type: E=eq (symbol/char), I=integer, G=any, S=single keys and single bodies */
+	  if (check_case(sc)) goto EVAL; else goto G_G;  /* selector is a symbol or constant, stupid "else" to shut up the compiler */
+
+	case OP_CASE_A_G_G: sc->value = fx_call(sc, cdr(sc->code));
+	G_G: case OP_CASE_G_G: if (op_case_g_g(sc)) goto TOP_NO_POP; goto FEED_TO;
+	case OP_CASE_A_E_S: sc->value = fx_call(sc, cdr(sc->code));
+	case OP_CASE_E_S:   op_case_e_s(sc); goto EVAL;
+#if (!WITH_GMP)
+	case OP_CASE_P_I_S: push_stack_no_args_direct(sc, OP_CASE_I_S); sc->code = cadr(sc->code); goto EVAL;
+	case OP_CASE_A_I_S: sc->value = fx_call(sc, cdr(sc->code));
+	case OP_CASE_I_S:   if (op_case_i_s(sc)) continue; goto EVAL;
+#endif
+	case OP_CASE_A_G_S: sc->value = fx_call(sc, cdr(sc->code)); /* this almost never happens? */
+	case OP_CASE_G_S:   op_case_g_s(sc); goto EVAL;
+
+	case OP_CASE_A_E_G: sc->value = fx_call(sc, cdr(sc->code));
+	case OP_CASE_E_G:   if (op_case_e_g_1(sc, sc->value, is_simple(sc->value))) goto TOP_NO_POP; goto FEED_TO;
+	case OP_CASE_A_S_G:  /* splitting this case out matters in lint */
+	  sc->value = fx_call(sc, cdr(sc->code));
+	  if (op_case_e_g_1(sc, sc->value, is_case_key(sc->value))) goto TOP_NO_POP; else goto FEED_TO;
+
+	case OP_CASE_P_G_G: push_stack_no_args_direct(sc, OP_CASE_G_G); sc->code = cadr(sc->code); goto EVAL;
+	case OP_CASE_P_E_S: push_stack_no_args_direct(sc, OP_CASE_E_S); sc->code = cadr(sc->code); goto EVAL;
+	case OP_CASE_P_G_S: push_stack_no_args_direct(sc, OP_CASE_G_S); sc->code = cadr(sc->code); goto EVAL;
+	case OP_CASE_P_E_G: push_stack_no_args_direct(sc, OP_CASE_E_G); sc->code = cadr(sc->code); goto EVAL;
+#if (!WITH_GMP)
+	case OP_CASE_A_I_S_A: sc->value = fx_case_a_i_s_a(sc, sc->code); continue;
+#endif
+	case OP_CASE_A_E_S_A: sc->value = fx_case_a_e_s_a(sc, sc->code); continue;
+	case OP_CASE_A_G_S_A: sc->value = fx_case_a_g_s_a(sc, sc->code); continue;
+	case OP_CASE_A_S_G_A: sc->value = fx_case_a_s_g_a(sc, sc->code); continue;
+
+
+	case OP_ERROR_QUIT:
+	  if (sc->stack_end <= sc->stack_start) stack_reset(sc);  /* sets stack_end to stack_start, then pushes op_eval_done, (can <= be <?) */
+	  return(sc->F);
+
+	case OP_ERROR_HOOK_QUIT:
+	  op_error_hook_quit(sc);
+
+	case OP_EVAL_DONE:
+	  return(sc->F);
+
+	case OP_SPLICE_VALUES:         /* if splice_in_values hits eval_done, it needs to continue the splice after returning, so we get here */
+	  sc->value = splice_in_values(sc, sc->args);
+	  continue;
+
+	case OP_GC_PROTECT: case OP_BARRIER: case OP_NO_VALUES:
+	case OP_CATCH_ALL: case OP_CATCH: case OP_CATCH_1: case OP_CATCH_2:
+	  if (SHOW_EVAL_OPS) fprintf(stderr, "  flush %s\n", op_names[sc->cur_op]);
+	  continue;
+
+	case OP_GET_OUTPUT_STRING:      op_get_output_string(sc); /* from call-with-output-string|with-output-to-string; return the port string directly *//* fall through */
+	case OP_UNWIND_OUTPUT:          op_unwind_output(sc);                          continue;
+	case OP_UNWIND_INPUT:           op_unwind_input(sc);                           continue;
+	case OP_DYNAMIC_UNWIND:         dynamic_unwind(sc, sc->code, sc->args);        continue;
+	case OP_PROFILE_IN:             g_profile_in(sc, set_plist_2(sc, cadr(sc->code), sc->curlet)); continue;
+	case OP_DYNAMIC_UNWIND_PROFILE: g_profile_out(sc, set_plist_1(sc, sc->args));  continue;
+	case OP_DYNAMIC_WIND:           if (op_dynamic_wind(sc)) goto APPLY;           continue;
+	case OP_DEACTIVATE_GOTO:        call_exit_active(sc->args) = false;            continue; /* deactivate the exiter */
+
+	case OP_WITH_LET_S:             sc->value = fx_with_let_s(sc, sc->code); continue;
+	case OP_WITH_LET:               check_with_let(sc);
+	case OP_WITH_LET_UNCHECKED:     if (op_with_let_unchecked(sc)) goto EVAL;
+	case OP_WITH_LET1:              if (sc->value != sc->curlet) activate_with_let(sc, sc->value); goto BEGIN;
+
+	case OP_WITH_BAFFLE:            check_with_baffle(sc);
+	case OP_WITH_BAFFLE_UNCHECKED:  if (op_with_baffle_unchecked(sc)) continue; goto BEGIN;
+
+
+	case OP_READ_INTERNAL:             op_read_internal(sc); continue;
+	case OP_READ_DONE:                 op_read_done(sc);     continue;
+	case OP_LOAD_RETURN_IF_EOF:        if (op_load_return_if_eof(sc)) goto EVAL; return(sc->F);
+	case OP_LOAD_CLOSE_AND_POP_IF_EOF: if (op_load_close_and_pop_if_eof(sc)) goto EVAL; continue;
+
+	POP_READ_LIST:
+	  if (pop_read_list(sc)) goto READ_NEXT;
+
+	READ_LIST:
+	case OP_READ_LIST:        /* sc->args is sc->nil at first */
+	  sc->args = cons(sc, sc->value, sc->args);
+
+	READ_NEXT:
+	case OP_READ_NEXT:       /* this is 75% of the token calls, so expanding it saves lots of time */
+	  {
+	    int32_t c;
+	    s7_pointer pt = current_input_port(sc);
+	    c = port_read_white_space(pt)(sc, pt);
+
+	  READ_C:
+	    switch (c)
+	      {
+	      case '(':
+		c = port_read_white_space(pt)(sc, pt);  /* sc->tok = token(sc) */
+		switch (c)
+		  {
+		  case '(':  sc->tok = TOKEN_LEFT_PAREN;                break;
+		  case ')':  sc->value = sc->nil; goto READ_LIST;       /* was tok = TOKEN_RIGHT_PAREN */
+		  case '.':  sc->tok = read_dot(sc, pt);                break;
+		  case '\'': sc->tok = TOKEN_QUOTE;                     break;
+		  case ';':  sc->tok = port_read_semicolon(pt)(sc, pt); break;
+		  case '"':  sc->tok = TOKEN_DOUBLE_QUOTE;              break;
+		  case '`':  sc->tok = TOKEN_BACK_QUOTE;                break;
+		  case ',':  sc->tok = read_comma(sc, pt);              break;
+		  case '#':  sc->tok = read_sharp(sc, pt);              break;
+		  case '\0': case EOF: sc->tok = TOKEN_EOF;             break;
+
+		  default: /* read first element of list (ignore callgrind confusion -- this happens a lot) */
+		    c = read_start_list(sc, pt, c);
+		    goto READ_C;
+		  }
+		if (sc->tok == TOKEN_ATOM)
+		  {
+		    c = read_atom(sc, pt);
+		    goto READ_C;
+		  }
+		if (sc->tok == TOKEN_RIGHT_PAREN)
+		  {
+		    sc->value = sc->nil;
+		    goto READ_LIST;
+		  }
+		if (sc->tok == TOKEN_DOT)
+		  {
+		    do {c = inchar(pt);} while ((c != ')') && (c != EOF));
+		    read_error_nr(sc, "stray dot after '('?");      /* (car '( . )) */
+		  }
+		if (sc->tok == TOKEN_EOF)
+		  missing_close_paren_error_nr(sc);
+
+		push_stack_no_let_no_code(sc, OP_READ_LIST, sc->args);
+		push_stack_no_let_no_code(sc, OP_READ_LIST, sc->nil);
+		/* check_stack_size(sc); */
+		sc->value = read_expression(sc);
+		if (stack_top_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
+		continue;
+
+	      case ')':
+		sc->tok = TOKEN_RIGHT_PAREN;
+		break;
+
+	      case '.':
+		sc->tok = read_dot(sc, pt); /* dot or atom */
+		break;
+
+	      case '\'':
+		sc->tok = TOKEN_QUOTE;
+		/* might need check_stack_size(sc) here */
+		push_stack_no_let_no_code(sc, OP_READ_LIST, sc->args);
+		sc->value = read_expression(sc);
+		continue;
+
+	      case ';':
+		sc->tok = port_read_semicolon(pt)(sc, pt);
+		break;
+
+	      case '"':
+		sc->tok = TOKEN_DOUBLE_QUOTE;
+		read_double_quote(sc);
+		goto READ_LIST;
+
+	      case '`':
+		sc->tok = TOKEN_BACK_QUOTE;
+		push_stack_no_let_no_code(sc, OP_READ_LIST, sc->args);
+		sc->value = read_expression(sc);
+		if (stack_top_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
+		continue;
+
+	      case ',':
+		sc->tok = read_comma(sc, pt); /* at_mark or comma */
+		push_stack_no_let_no_code(sc, OP_READ_LIST, sc->args);
+		sc->value = read_expression(sc);
+		continue;
+
+	      case '#':
+		sc->tok = read_sharp(sc, pt);
+		break;
+
+	      case '\0':
+	      case EOF:
+		missing_close_paren_error_nr(sc);
+
+	      default:
+		sc->strbuf[0] = (unsigned char)c;
+		sc->value = port_read_name(pt)(sc, pt);
+		goto READ_LIST;
+	      }}
+
+	READ_TOK:
+	  switch (sc->tok)
+	    {
+	    case TOKEN_RIGHT_PAREN: 	      /* sc->args can't be null here */
+	      sc->value = proper_list_reverse_in_place(sc, sc->args);
+	      if ((is_expansion(car(sc->value))) &&
+		  (sc->is_expanding))
+		switch (op_expansion(sc))
+		  {
+		  case goto_begin: goto BEGIN;
+		  case goto_apply_lambda: goto APPLY_LAMBDA;
+		  default: break;
+		  }
+	      break;
+
+	    case TOKEN_EOF:          missing_close_paren_error_nr(sc);       /* can't happen, I believe */
+	    case TOKEN_ATOM:         sc->value = port_read_name(current_input_port(sc))(sc, current_input_port(sc)); goto READ_LIST;
+	    case TOKEN_SHARP_CONST:  if (read_sharp_const(sc)) goto READ_TOK; goto READ_LIST;
+	    case TOKEN_DOUBLE_QUOTE: read_double_quote(sc); goto READ_LIST;
+	    case TOKEN_DOT:          read_dot_and_expression(sc); break;
+	    default:                 read_tok_default(sc); break;
+	    }
+	  if (stack_top_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
+	  continue;
+
+	case OP_READ_DOT:
+	  switch (op_read_dot(sc))
+	    {
+	    case goto_start: continue;
+	    case goto_pop_read_list: goto POP_READ_LIST;
+	    default: goto READ_TOK;
+	    }
+	case OP_READ_QUOTE:        if (op_read_quote(sc)) continue;        goto POP_READ_LIST;
+	case OP_READ_QUASIQUOTE:   if (op_read_quasiquote(sc)) continue;   goto POP_READ_LIST;
+	case OP_READ_UNQUOTE:      if (op_read_unquote(sc)) continue;      goto POP_READ_LIST;
+	case OP_READ_APPLY_VALUES: if (op_read_apply_values(sc)) continue; goto POP_READ_LIST;
+	case OP_READ_VECTOR:       if (op_read_vector(sc)) continue;       goto POP_READ_LIST;
+	case OP_READ_INT_VECTOR:   if (op_read_int_vector(sc)) continue;   goto POP_READ_LIST;
+	case OP_READ_FLOAT_VECTOR: if (op_read_float_vector(sc)) continue; goto POP_READ_LIST;
+	case OP_READ_BYTE_VECTOR:  if (op_read_byte_vector(sc)) continue;  goto POP_READ_LIST;
+
+	case OP_CLEAR_OPTS:
+	  break;
+
+	default:
+	  return(sc->F);
+	}
+
+      /* this code is reached from OP_CLEAR_OPTS and many others where the optimization has turned out to be incorrect, OP_CLOSURE_SYM for example; search for break */
+      if (!tree_is_cyclic(sc, sc->code))
+	clear_all_optimizations(sc, sc->code);
+    UNOPT:
+      switch (trailers(sc))
+	{
+	case goto_top_no_pop:    goto TOP_NO_POP;
+	case goto_eval_args_top: goto EVAL_ARGS_TOP;
+	case goto_eval:          goto EVAL;
+	case goto_start:         continue; /* sc->value has been set, this is OP_SYMBOL|CONSTANT on the next pass */
+	default:
+	  if (S7_DEBUGGING) fprintf(stderr, "%s[%d]: unexpected switch default: %s\n", __func__, __LINE__, display(sc->code));
+	  break;
+	}}
+  return(sc->F); /* this never happens (make the compiler happy) */
+}
+
+
+/* -------------------------------- s7_heap_scan -------------------------------- */
+#if S7_DEBUGGING
+static void mark_holdee(s7_pointer holder, s7_pointer holdee, const char *root)
+{
+  holdee->holders++;
+  if (holder) holdee->holder = holder;
+  if (root) holdee->root = root;
+}
+
+static void mark_stack_holdees(s7_scheme *sc, s7_pointer p, s7_int top)
+{
+  if (stack_elements(p))
+    {
+      s7_pointer heap0 = *(sc->heap);
+      s7_pointer heap1 = (s7_pointer)(heap0 + sc->heap_size);
+      for (s7_pointer *tp = (s7_pointer *)(stack_elements(p)), *tend = (s7_pointer *)(tp + top); (tp < tend); tp++)
+	{
+	  s7_pointer x = *tp++;
+	  if ((x >= heap0) && (x < heap1)) mark_holdee(p, x, NULL);
+	  x = *tp++;
+	  if ((x >= heap0) && (x < heap1)) mark_holdee(p, x, NULL);
+	  x = *tp++;
+	  if ((x >= heap0) && (x < heap1)) mark_holdee(p, x, NULL);
+	}}
+}
+
+static void save_holder_data(s7_scheme *sc, s7_pointer p)
+{
+  switch (unchecked_type(p))
+    {
+    case T_PAIR:         mark_holdee(p, car(p), NULL); mark_holdee(p, cdr(p), NULL); break;
+    case T_CATCH:        mark_holdee(p, catch_tag(p), NULL); mark_holdee(p, catch_handler(p), NULL); break;
+    case T_DYNAMIC_WIND: mark_holdee(p, dynamic_wind_in(p), NULL); mark_holdee(p, dynamic_wind_out(p), NULL); mark_holdee(p, dynamic_wind_body(p), NULL); break;
+    case T_INPUT_PORT:   mark_holdee(p, port_string_or_function(p), NULL); break;
+    case T_C_POINTER:    mark_holdee(p, c_pointer_type(p), NULL); mark_holdee(p, c_pointer_info(p), NULL); break;
+    case T_COUNTER:      mark_holdee(p, counter_result(p), NULL); mark_holdee(p, counter_list(p), NULL); mark_holdee(p, counter_let(p), NULL); break;
+    case T_STACK:        mark_stack_holdees(sc, p, (p == sc->stack) ? stack_top(sc) : temp_stack_top(p)); break;
+    case T_OUTPUT_PORT:  if (is_function_port(p)) mark_holdee(p, port_string_or_function(p), NULL); break;
+
+    case T_ITERATOR:
+      mark_holdee(p, iterator_sequence(p), NULL);
+      if (is_mark_seq(p)) mark_holdee(p, iterator_current(p), NULL);
+      break;
+
+    case T_SLOT:
+      mark_holdee(p, slot_value(p), NULL);
+      mark_holdee(p, slot_symbol(p), NULL);
+      if (slot_has_setter(p)) mark_holdee(p, slot_setter(p), NULL);
+      if (slot_has_pending_value(p)) mark_holdee(p, slot_pending_value(p), NULL);
+      break;
+
+    case T_VECTOR:
+      if (is_subvector(p)) mark_holdee(p, subvector_vector(p), NULL);
+      for (s7_int i = 0, len = vector_length(p); i < len; i++)
+	if (vector_element(p, i)) mark_holdee(p, vector_element(p, i), NULL);
+      break;
+
+    case T_INT_VECTOR: case T_FLOAT_VECTOR: case T_BYTE_VECTOR:
+      if (is_subvector(p)) mark_holdee(p, subvector_vector(p), NULL);
+      break;
+
+    case T_LET:
+      if (p != sc->rootlet) /* do rootlet later? */
+	{
+	  for (s7_pointer slot = let_slots(p); tis_slot(slot); slot = next_slot(slot)) mark_holdee(p, slot, NULL);
+	  if (has_dox_slot1(p)) mark_holdee(p, let_dox_slot1(p), NULL);
+	  if ((has_dox_slot2(p)) && (is_slot(let_dox_slot2(p)))) mark_holdee(p, let_dox_slot2(p), NULL);
+	}
+      break;
+
+    case T_C_FUNCTION_STAR:
+      if ((!c_func_has_simple_defaults(p)) && (c_function_call_args(p)))
+	for (s7_pointer arg = c_function_call_args(p); is_pair(arg); arg = cdr(arg))
+	  mark_holdee(p, car(arg), NULL);
+      break;
+
+    case T_CLOSURE: case T_CLOSURE_STAR:
+    case T_MACRO: case T_MACRO_STAR:
+    case T_BACRO: case T_BACRO_STAR:
+      mark_holdee(p, closure_args(p), NULL);
+      mark_holdee(p, closure_body(p), NULL);
+      mark_holdee(p, closure_let(p), NULL);
+      mark_holdee(p, closure_setter_or_map_list(p), NULL);
+      break;
+
+    case T_HASH_TABLE:
+      mark_holdee(p, hash_table_procedures(p), NULL);
+      if (is_pair(hash_table_procedures(p)))
+	{
+	  mark_holdee(p, hash_table_key_typer_unchecked(p), NULL);
+	  mark_holdee(p, hash_table_value_typer_unchecked(p), NULL);
+	}
+      if (hash_table_entries(p) > 0)
+	{
+	  s7_int len = hash_table_size(p);
+	  hash_entry_t **entries = hash_table_elements(p);
+	  hash_entry_t **last = (hash_entry_t **)(entries + len);
+	  if ((is_weak_hash_table(p)) && (weak_hash_iters(p) == 0))
+	    while (entries < last)
+	      {
+		for (hash_entry_t *xp = *entries++; xp; xp = hash_entry_next(xp))
+		  mark_holdee(p, hash_entry_value(xp), NULL);
+	      }
+	  else
+	    while (entries < last)
+	      for (hash_entry_t *xp = *entries++; xp; xp = hash_entry_next(xp))
+		{
+		  mark_holdee(p, hash_entry_key(xp), NULL);
+		  mark_holdee(p, hash_entry_value(xp), NULL);
+		}}
+      break;
+
+    case T_CONTINUATION:
+      mark_holdee(p, continuation_op_stack(p), NULL);
+      mark_stack_holdees(sc, continuation_stack(p), continuation_stack_top(p));
+      break;
+
+    default: break; /* includes T_C_OBJECT */
+    }
+}
+
+void s7_heap_analyze(s7_scheme *sc);
+void s7_heap_analyze(s7_scheme *sc)
+{
+  /* clear possible previous data */
+  for (s7_int k = 0; k < sc->heap_size; k++)
+    {
+      s7_pointer obj = sc->heap[k];
+      obj->root = NULL;
+      obj->holders = 0;
+      obj->holder = NULL;
+    }
+  /* now parcel out all the holdings */
+  for (s7_int k = 0; k < sc->heap_size; k++)
+    save_holder_data(sc, sc->heap[k]);
+
+  {
+    s7_pointer *tmps = sc->free_heap_top;
+    s7_pointer *tmps_top = tmps + sc->gc_temps_size;
+    if (tmps_top > sc->previous_free_heap_top) tmps_top = sc->previous_free_heap_top;
+    while (tmps < tmps_top)
+      {
+	s7_pointer p = *tmps++;
+	mark_holdee(NULL, p, "gc temp");
+      }}
+
+  mark_holdee(NULL, sc->w, "sc->w");
+  mark_holdee(NULL, sc->x, "sc->x");
+  mark_holdee(NULL, sc->y, "sc->y");
+  mark_holdee(NULL, sc->z, "sc->z");
+  mark_holdee(NULL, sc->temp1, "sc->temp1");
+  mark_holdee(NULL, sc->temp2, "sc->temp2");
+  mark_holdee(NULL, sc->temp3, "sc->temp3");
+  mark_holdee(NULL, sc->temp4, "sc->temp4");
+  mark_holdee(NULL, sc->temp5, "sc->temp5");
+  mark_holdee(NULL, sc->temp6, "sc->temp6");
+  mark_holdee(NULL, sc->temp7, "sc->temp7");
+  mark_holdee(NULL, sc->temp8, "sc->temp8");
+  mark_holdee(NULL, sc->temp9, "sc->temp9");
+  mark_holdee(NULL, sc->temp10, "sc->temp10");
+  mark_holdee(NULL, sc->rec_p1, "sc->rec_p1");
+  mark_holdee(NULL, sc->rec_p2, "sc->rec_p2");
+
+  mark_holdee(NULL, car(sc->t1_1), "car(sc->t1_1)");
+  mark_holdee(NULL, car(sc->t2_1), "car(sc->t2_1)");
+  mark_holdee(NULL, car(sc->t2_2), "car(sc->t2_2)");
+  mark_holdee(NULL, car(sc->t3_1), "car(sc->t3_1)");
+  mark_holdee(NULL, car(sc->t3_2), "car(sc->t3_2)");
+  mark_holdee(NULL, car(sc->t3_3), "car(sc->t3_3)");
+  mark_holdee(NULL, car(sc->t4_1), "car(sc->t4_1)");
+  mark_holdee(NULL, car(sc->u1_1), "car(sc->u1_1)");
+  mark_holdee(NULL, car(sc->plist_1), "car(sc->plist_1)");
+  mark_holdee(NULL, car(sc->plist_2), "car(sc->plist_2)");
+  mark_holdee(NULL, car(sc->plist_3), "car(sc->plist_3)");
+  mark_holdee(NULL, car(sc->plist_4), "car(sc->plist_4)");
+  mark_holdee(NULL, car(sc->qlist_2), "car(sc->qlist_2)");
+  mark_holdee(NULL, car(sc->qlist_3), "car(sc->qlist_3)");
+  mark_holdee(NULL, car(sc->elist_1), "car(sc->elist_1)");
+  mark_holdee(NULL, car(sc->elist_2), "car(sc->elist_2)");
+  mark_holdee(NULL, car(sc->elist_3), "car(sc->elist_3)");
+  mark_holdee(NULL, car(sc->elist_4), "car(sc->elist_4)");
+  mark_holdee(NULL, car(sc->elist_5), "car(sc->elist_5)");
+  mark_holdee(NULL, car(sc->elist_6), "car(sc->elist_6)");
+  mark_holdee(NULL, car(sc->elist_7), "car(sc->elist_7)");
+  mark_holdee(NULL, car(sc->plist_2_2), "cadr(sc->plist_2)");
+  mark_holdee(NULL, cadr(sc->plist_3), "cadr(sc->plist_3)");
+  mark_holdee(NULL, cadr(sc->elist_2), "cadr(sc->elist_2)");
+  mark_holdee(NULL, cadr(sc->elist_3), "cadr(sc->elist_3)");
+  mark_holdee(NULL, cadr(sc->qlist_2), "cadr(sc->qlist_2)");
+  mark_holdee(NULL, caddr(sc->plist_3), "caddr(sc->plist_3)");
+  mark_holdee(NULL, caddr(sc->elist_3), "caddr(sc->elist_3)");
+
+  mark_holdee(NULL, sc->code, "sc->code");
+  mark_holdee(NULL, sc->value, "sc->value");
+  mark_holdee(NULL, sc->args, "sc->args");
+  mark_holdee(NULL, sc->curlet, "sc->curlet");
+  mark_holdee(NULL, sc->stack, "sc->stack");
+  mark_holdee(NULL, sc->default_random_state, "sc->default_random_state");
+  mark_holdee(NULL, sc->let_temp_hook, "sc->let_temp_hook");
+  mark_holdee(NULL, sc->stacktrace_defaults, "sc->stacktrace_defaults");
+  mark_holdee(NULL, sc->protected_objects, "sc->protected_objects");
+  mark_holdee(NULL, sc->protected_setters, "sc->protected_setters");
+  mark_holdee(NULL, sc->protected_setter_symbols, "sc->protected_setter_symbols");
+  mark_holdee(NULL, sc->error_type, "sc->error_type");
+  mark_holdee(NULL, sc->error_data, "sc->error_data");
+  mark_holdee(NULL, sc->error_code, "sc->error_code");
+  mark_holdee(NULL, sc->error_line, "sc->error_line");
+  mark_holdee(NULL, sc->error_file, "sc->error_file");
+  mark_holdee(NULL, sc->error_position, "sc->error_position");
+#if WITH_HISTORY
+  mark_holdee(NULL, sc->error_history, "sc->error_history");
+#endif
+
+  for (gc_obj_t *g = sc->semipermanent_objects; g; g = (gc_obj_t *)(g->nxt))
+    mark_holdee(NULL, g->p, "permanent object");
+
+  for (s7_int i = 0; i < sc->protected_objects_size; i++)
+    mark_holdee(NULL, vector_element(sc->protected_objects, i), "gc protected object");
+
+  for (s7_int i = 0; i < sc->protected_setters_loc; i++)
+    mark_holdee(NULL, vector_element(sc->protected_setters, i), "gc protected setter");
+
+  for (s7_int i = 0; i < sc->setters_loc; i++)
+    mark_holdee(NULL, cdr(sc->setters[i]), "setter");
+
+  for (s7_int i = 0; i <= sc->format_depth; i++)
+    if (sc->fdats[i])
+      mark_holdee(NULL, sc->fdats[i]->curly_arg, "fdat curly_arg");
+
+  {
+    s7_pointer *tp = (s7_pointer *)(sc->input_port_stack + sc->input_port_stack_loc);
+    for (s7_pointer *p = sc->input_port_stack; p < tp; p++)
+      mark_holdee(NULL, *p, "input stack");
+  }
+  {
+    s7_pointer *p = sc->op_stack;
+    s7_pointer *tp = sc->op_stack_now;
+    while (p < tp) {s7_pointer x = *p++; mark_holdee(NULL, x, "op stack");}
+  }
+
+  if (sc->rec_stack)
+    for (s7_int i = 0; i < sc->rec_loc; i++)
+      mark_holdee(NULL, sc->rec_els[i], "sc->rec_els");
+
+  {
+    gc_list_t *gp = sc->opt1_funcs;
+    for (s7_int i = 0; i < gp->loc; i++)
+      {
+	s7_pointer s1 = T_Pair(gp->list[i]);
+	mark_holdee(NULL, opt1_any(s1), "opt1_funcs");
+      }}
+
+  for (int32_t i = 1; i < NUM_SAFE_LISTS; i++)
+    if ((is_pair(sc->safe_lists[i])) &&
+	(list_is_in_use(sc->safe_lists[i])))
+      for (s7_pointer p = sc->safe_lists[i]; is_pair(p); p = cdr(p))
+	mark_holdee(NULL, car(p), "safe_lists");
+
+  for (s7_pointer p = sc->wrong_type_arg_info; is_pair(p); p = cdr(p)) mark_holdee(NULL, car(p), "wrong-type-arg");
+  for (s7_pointer p = sc->sole_arg_wrong_type_info; is_pair(p); p = cdr(p)) mark_holdee(NULL, car(p), "simple wrong-type-arg");
+  for (s7_pointer p = sc->out_of_range_info; is_pair(p); p = cdr(p)) mark_holdee(NULL, car(p), "out-of-range");
+  for (s7_pointer p = sc->sole_arg_out_of_range_info; is_pair(p); p = cdr(p)) mark_holdee(NULL, car(p), "simple out-of-range");
+  for (s7_pointer y = sc->rootlet_slots; tis_slot(y); y = next_slot(y))
+    mark_holdee(NULL, slot_value(y), "rootlet");
+#if WITH_HISTORY
+  for (s7_pointer p1 = sc->eval_history1, p2 = sc->eval_history2, p3 = sc->history_pairs; ; p2 = cdr(p2), p3 = cdr(p3))
+    {
+      mark_holdee(NULL, car(p1), "eval history1");
+      mark_holdee(NULL, car(p2), "eval history2");
+      mark_holdee(NULL, car(p3), "eval history3");
+      p1 = cdr(p1);
+      if (p1 == sc->eval_history1) break;
+    }
+#else
+  mark_holdee(NULL, sc->cur_code, "current code");
+#endif
+}
+
+void s7_heap_scan(s7_scheme *sc, int32_t typ);
+void s7_heap_scan(s7_scheme *sc, int32_t typ)
+{
+  bool found_one = false;
+  for (s7_int k = 0; k < sc->heap_size; k++)
+    {
+      s7_pointer obj = sc->heap[k];
+      if (unchecked_type(obj) == typ)
+	{
+	  found_one = true;
+	  if (obj->holders == 0)
+	    fprintf(stderr, "%s found no holder (alloc: %s[%d])\n", display_truncated(obj), obj->alloc_func, obj->alloc_line);
+	  else
+	    if (!obj->holder)
+	      fprintf(stderr, "%s has built-in holder (holders: %d, alloc: %s[%d])\n", display_truncated(obj), obj->holders, obj->alloc_func, obj->alloc_line);
+	    else
+	      if (obj->root)
+		fprintf(stderr, "%s from %s alloc: %s[%d] (%d holder%s, alloc: %s[%d])\n",
+			display_truncated(obj), obj->root, obj->alloc_func, obj->alloc_line,
+			obj->holders, (obj->holders != 1) ? "s" : "", obj->holder->alloc_func, obj->holder->alloc_line);
+	      else fprintf(stderr, "%s (%s, alloc: %s[%d], holder%s: %d %p %s alloc: %s[%d])\n",
+			   display_truncated(obj), s7_type_names[unchecked_type(obj->holder)], obj->alloc_func, obj->alloc_line,
+			   (obj->holders != 1) ? "s" : "", obj->holders, obj->holder, display(obj->holder), obj->holder->alloc_func, obj->holder->alloc_line);
+	}}
+  if (!found_one)
+    fprintf(stderr, "heap-scan: no %s found\n", s7_type_names[typ]);
+}
+
+static s7_pointer g_heap_scan(s7_scheme *sc, s7_pointer args)
+{
+  #define H_heap_scan "(heap-scan type) scans the heap for objects of type and reports info about them"
+  #define Q_heap_scan s7_make_signature(sc, 2, sc->not_symbol, sc->is_integer_symbol)
+  s7_pointer p = car(args);
+  if (!s7_is_integer(p))
+    sole_arg_wrong_type_error_nr(sc, make_symbol(sc, "heap-scan", 9), p, sc->type_names[T_INTEGER]);
+  if ((s7_integer(p) <= 0) || (s7_integer(p) >= NUM_TYPES))
+    sole_arg_out_of_range_error_nr(sc, make_symbol(sc, "heap-scan", 9), p, wrap_string(sc, "0 < type < 48", 13));
+  s7_heap_scan(sc, (int32_t)s7_integer(p)); /* 0..48 currently */
+  return(sc->F);
+}
+
+static s7_pointer g_heap_analyze(s7_scheme *sc, s7_pointer args)
+{
+  #define H_heap_analyze "(heap-analyze) gets heap data for subsequent heap-scan"
+  #define Q_heap_analyze s7_make_signature(sc, 1, sc->not_symbol)
+  s7_heap_analyze(sc);
+  return(sc->F);
+}
+
+static s7_pointer g_heap_holder(s7_scheme *sc, s7_pointer args)
+{
+  #define H_heap_holder "(heap-holder obj) returns the object pointing to obj"
+  #define Q_heap_holder s7_make_signature(sc, 2, sc->T, sc->T)
+  s7_pointer p = car(args);
+  if ((p->holders == 0) || ((!(p->holder)) && (!(p->root)))) return(sc->F);
+  return((p->holder) ? p->holder : s7_make_string(sc, p->root));
+}
+
+static s7_pointer g_heap_holders(s7_scheme *sc, s7_pointer args)
+{
+  #define H_heap_holders "(heap-holders obj) returns the number of objects pointing to obj"
+  #define Q_heap_holders s7_make_signature(sc, 2, sc->is_integer_symbol, sc->T)
+  return(make_integer(sc, car(args)->holders));
+}
+
+/* random debugging stuff */
+static s7_pointer g_show_stack(s7_scheme *sc, s7_pointer args)
+{
+  #define H_show_stack "(show-stack ((limit sc->show_stack_limit)))"
+  #define Q_show_stack s7_make_signature(sc, 2, sc->not_symbol, sc->is_integer_symbol)
+  if ((!is_null(args)) && (s7_is_integer(car(args))))
+    {
+      s7_int old_limit = sc->show_stack_limit;
+      sc->show_stack_limit = s7_integer(car(args));
+      s7_show_stack(sc);
+      sc->show_stack_limit = old_limit;
+    }
+  else s7_show_stack(sc);
+  return(sc->F);
+}
+
+void s7_show_op_stack(s7_scheme *sc);
+void s7_show_op_stack(s7_scheme *sc)
+{
+  fprintf(stderr, "op_stack:\n");
+  for (s7_pointer *p = sc->op_stack, *tp = sc->op_stack_now; (p < tp); p++)
+    fprintf(stderr, "  %s\n", display(*p));
+}
+
+static s7_pointer g_show_op_stack(s7_scheme *sc, s7_pointer args)
+{
+  #define H_show_op_stack "no help"
+  #define Q_show_op_stack s7_make_signature(sc, 1, sc->not_symbol)
+  s7_show_op_stack(sc);
+  return(sc->F);
+}
+
+static s7_pointer g_is_op_stack(s7_scheme *sc, s7_pointer args)
+{
+  #define H_is_op_stack "no help"
+  #define Q_is_op_stack s7_make_signature(sc, 1, sc->is_boolean_symbol)
+  return(make_boolean(sc, (sc->op_stack < sc->op_stack_now)));
+}
+#endif
+
+
+/* -------------------------------- *s7* let -------------------------------- */
+
+static noreturn void s7_starlet_wrong_type_error_nr(s7_scheme *sc, s7_pointer caller, s7_pointer arg, s7_pointer typ)
+{
+  error_nr(sc, sc->wrong_type_arg_symbol,
+	   set_elist_5(sc, wrap_string(sc, "(set! (*s7* '~A) ~S): new value is ~A but should be ~A", 54),
+		       caller, arg, object_type_name(sc, arg), typ));
+}
+
+static noreturn void sl_stacktrace_wrong_type_error_nr(s7_scheme *sc, s7_pointer caller, s7_int num, s7_pointer arg, s7_pointer typ, s7_pointer val)
+{
+  set_elist_7(sc, wrap_string(sc, "(set! (*s7* '~A) '~S): the ~:D list element ~S is ~A but should be ~A", 69),
+	      caller, val, wrap_integer(sc, num), arg, object_type_name(sc, arg), typ);
+  error_nr(sc, sc->wrong_type_arg_symbol, sc->elist_7);
+}
+
+static noreturn void s7_starlet_out_of_range_error_nr(s7_scheme *sc, s7_pointer caller, s7_pointer arg, s7_pointer descr)
+{
+  error_nr(sc, sc->out_of_range_symbol,
+	   set_elist_4(sc, wrap_string(sc, "(set! (*s7* '~A) ~S): new value is out of range (~A)", 52), caller, arg, descr));
+}
+
+static s7_int s7_starlet_length(void) {return(SL_NUM_FIELDS - 1);}
+
+static s7_pointer g_s7_starlet_set_fallback(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer sym = cadr(args);
+  if (!is_symbol(sym))
+    sole_arg_wrong_type_error_nr(sc, sc->let_set_symbol, sym, sc->type_names[T_SYMBOL]);
+  return(s7_starlet_set_1(sc, sym, caddr(args)));
+}
+
+static s7_pointer g_s7_starlet_ref_fallback(s7_scheme *sc, s7_pointer args);
+
+static s7_pointer make_s7_starlet(s7_scheme *sc)  /* *s7* is semipermanent -- 20-May-21 */
+{
+  s7_pointer slot1 = make_semipermanent_slot(sc, sc->let_set_fallback_symbol, s7_make_function(sc, "s7-let-set", g_s7_starlet_set_fallback, 3, 0, false, "*s7* writer"));
+  s7_pointer slot2 = make_semipermanent_slot(sc, sc->let_ref_fallback_symbol, s7_make_function(sc, "s7-let-ref", g_s7_starlet_ref_fallback, 2, 0, false, "*s7* reader"));
+  s7_pointer x = alloc_pointer(sc);
+  set_full_type(x, T_LET | T_SAFE_PROCEDURE | T_UNHEAP | T_HAS_METHODS | T_HAS_LET_REF_FALLBACK | T_HAS_LET_SET_FALLBACK);
+  let_set_id(x, ++sc->let_number);
+  let_set_outlet(x, sc->rootlet);
+  symbol_set_local_slot(sc->let_set_fallback_symbol, sc->let_number, slot1);
+  slot_set_next(slot1, slot_end);
+  symbol_set_local_slot(sc->let_ref_fallback_symbol, sc->let_number, slot2);
+  slot_set_next(slot2, slot1);
+  let_set_slots(x, slot2);
+  set_immutable_slot(slot1);         /* make the *s7* let-ref|set! fallbacks immutable */
+  set_immutable_slot(slot2);
+  set_immutable_let(x);
+  sc->s7_starlet_symbol = s7_define_constant(sc, "*s7*", s7_openlet(sc, x)); /* define_constant returns the symbol */
+  for (int32_t i = 1; i < (int32_t)SL_NUM_FIELDS; i++)
+    {
+      s7_pointer sym = make_symbol_with_strlen(sc, s7_starlet_names[i]);
+      s7_starlet_symbol_set(sym, (s7_starlet_t)i); /* evaluates sym twice */
+    }
+  return(x);
+}
+
+static void add_symbol_table(s7_scheme *sc, s7_pointer mu_let)
+{
+  /* check the symbol table, counting gensyms etc */
+  s7_int syms = 0, gens = 0, keys = 0, mx_list = 0;
+  s7_pointer *els = vector_elements(sc->symbol_table);
+  for (s7_int i = 0; i < SYMBOL_TABLE_SIZE; i++)
+    {
+      s7_pointer x;
+      s7_int k = 0;
+      for (x = els[i]; is_not_null(x); x = cdr(x), k++)
+	{
+	  syms++;
+	  if (is_gensym(car(x))) gens++;
+	  if (is_keyword(car(x))) keys++;
+	}
+      if (k > mx_list) mx_list = k;
+    }
+  add_slot_unchecked_with_id(sc, mu_let, sc->symbol_table_symbol,
+			     s7_inlet(sc,
+			       s7_list(sc, 10,
+				     sc->size_symbol, make_integer(sc, SYMBOL_TABLE_SIZE),
+				     make_symbol(sc, "max-bin", 7), make_integer(sc, mx_list),
+				     make_symbol(sc, "symbols", 7), cons(sc, make_integer(sc, syms), make_integer(sc, syms - gens - keys)),
+				     make_symbol(sc, "gensyms", 7), make_integer(sc, gens),
+				     make_symbol(sc, "keys", 4),    make_integer(sc, keys))));
+}
+
+static s7_pointer kmg(s7_scheme *sc, s7_int bytes)
+{
+  block_t *b = mallocate(sc, 128);
+  int32_t len = 0;
+  if (bytes < 1000)
+    len = snprintf((char *)block_data(b), 128, "%" ld64, bytes);
+  else
+    if (bytes < 1000000)
+      len = snprintf((char *)block_data(b), 128, "%.1fk", bytes / 1000.0);
+    else
+      if (bytes < 1000000000)
+	len = snprintf((char *)block_data(b), 128, "%.1fM", bytes / 1000000.0);
+      else len = snprintf((char *)block_data(b), 128, "%.1fG", bytes / 1000000000.0);
+  return(cons(sc, make_integer(sc, bytes), block_to_string(sc, b, len)));
+}
+
+static void add_gc_list_sizes(s7_scheme *sc, s7_pointer mu_let)
+{
+  /* check the gc lists (finalizations), at startup there are strings/input-strings from the s7_eval_c_string calls for make-polar et el */
+  s7_int len = sc->strings->size + sc->vectors->size + sc->input_ports->size + sc->output_ports->size + sc->input_string_ports->size +
+               sc->continuations->size + sc->c_objects->size + sc->hash_tables->size + sc->gensyms->size + sc->undefineds->size +
+               sc->multivectors->size + sc->weak_refs->size + sc->weak_hash_iterators->size + sc->opt1_funcs->size;
+
+  int32_t loc = sc->strings->loc + sc->vectors->loc + sc->input_ports->loc + sc->output_ports->loc + sc->input_string_ports->loc +
+                sc->continuations->loc + sc->c_objects->loc + sc->hash_tables->loc + sc->gensyms->loc + sc->undefineds->loc +
+                sc->multivectors->loc + sc->weak_refs->loc + sc->weak_hash_iterators->loc + sc->opt1_funcs->loc;
+
+  add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "gc-lists", 8),
+   s7_inlet(sc,
+     s7_list(sc, 6,
+	     make_symbol(sc, "active/total", 12), cons(sc, make_integer(sc, loc), make_integer(sc, len)),
+	     make_symbol(sc, "total-bytes", 11), kmg(sc, len * sizeof(s7_pointer)),
+	     make_symbol(sc, "lists", 5),
+       s7_inlet(sc,
+         s7_list(sc, 28,
+	   sc->string_symbol,                    cons(sc, make_integer(sc, sc->strings->loc),             make_integer(sc, sc->strings->size)),
+	   sc->vector_symbol,                    cons(sc, make_integer(sc, sc->vectors->loc),             make_integer(sc, sc->vectors->size)),
+	   sc->hash_table_symbol,                cons(sc, make_integer(sc, sc->hash_tables->loc),         make_integer(sc, sc->hash_tables->size)),
+	   make_symbol(sc, "multivector", 11),   cons(sc, make_integer(sc, sc->multivectors->loc),        make_integer(sc, sc->multivectors->size)),
+	   make_symbol(sc, "input", 5),          cons(sc, make_integer(sc, sc->input_ports->loc),         make_integer(sc, sc->input_ports->size)),
+	   make_symbol(sc, "output", 6),         cons(sc, make_integer(sc, sc->output_ports->loc),        make_integer(sc, sc->output_ports->size)),
+	   make_symbol(sc, "input-string", 12),  cons(sc, make_integer(sc, sc->input_string_ports->loc),  make_integer(sc, sc->input_string_ports->size)),
+	   make_symbol(sc, "continuation", 12),  cons(sc, make_integer(sc, sc->continuations->loc),       make_integer(sc, sc->continuations->size)),
+	   make_symbol(sc, "c-object", 8),       cons(sc, make_integer(sc, sc->c_objects->loc),           make_integer(sc, sc->c_objects->size)),
+	   sc->gensym_symbol,                    cons(sc, make_integer(sc, sc->gensyms->loc),             make_integer(sc, sc->gensyms->size)),
+	   make_symbol(sc, "undefined", 9),      cons(sc, make_integer(sc, sc->undefineds->loc),          make_integer(sc, sc->undefineds->size)),
+	   make_symbol(sc, "weak-ref", 8),       cons(sc, make_integer(sc, sc->weak_refs->loc),           make_integer(sc, sc->weak_refs->size)),
+	   make_symbol(sc, "weak-hash-iter", 14),cons(sc, make_integer(sc, sc->weak_hash_iterators->loc), make_integer(sc, sc->weak_hash_iterators->size)),
+	   make_symbol(sc, "opt1-func", 9),      cons(sc, make_integer(sc, sc->opt1_funcs->loc),          make_integer(sc, sc->opt1_funcs->size)))))));
+}
+
+/* handling all *s7* fields via fallbacks lets us use direct field accesses in the rest of s7, and avoids
+ *   using ca 100 cells for the let slots/values.  We would need the fallbacks anyway for 'files et al.
+ *   Since most of the fields need special setters, it's actually less code this way.  See old/s7-let-s7.c.
+ */
+
+#if (!_WIN32) /* (!MS_WINDOWS) */
+  #include <sys/resource.h>
+#endif
+
+static s7_pointer memory_usage(s7_scheme *sc)
+{
+  s7_int i, k, len, in_use = 0, all_len = 0;
+  gc_list_t *gp;
+  s7_int ts[NUM_TYPES];
+
+#if (!_WIN32) /* (!MS_WINDOWS) */
+  struct rusage info;
+  struct timeval ut;
+#endif
+
+  s7_pointer mu_let = s7_inlet(sc, sc->nil);
+  s7_int gc_loc = gc_protect_1(sc, mu_let);
+
+#if (!_WIN32) /* (!MS_WINDOWS) */
+  getrusage(RUSAGE_SELF, &info);
+  ut = info.ru_utime;
+  add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "process-time", 12), make_real(sc, ut.tv_sec + (floor(ut.tv_usec / 1000.0) / 1000.0)));
+#ifdef __APPLE__
+  add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "process-resident-size", 21), kmg(sc, info.ru_maxrss));
+  /* apple docs say this is in kilobytes, but apparently that is an error */
+#else
+  add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "process-resident-size", 21), kmg(sc, info.ru_maxrss * 1024));
+  /* why does this number sometimes have no relation to RES in top? */
+#endif
+  add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "IO", 2), cons(sc, make_integer(sc, info.ru_inblock), make_integer(sc, info.ru_oublock)));
+#endif
+
+  add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "rootlet-size", 12), make_integer(sc, let_length(sc, sc->rootlet)));
+  add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "heap-size", 9),
+			     cons(sc, make_integer(sc, sc->heap_size), kmg(sc, sc->heap_size * (sizeof(s7_cell) + 2 * sizeof(s7_pointer)))));
+  add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "cell-size", 9), make_integer(sc, sizeof(s7_cell)));
+  add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "gc-total-freed", 14), make_integer(sc, sc->gc_total_freed));
+  add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "gc-total-time", 13), make_real(sc, (double)(sc->gc_total_time) / ticks_per_second()));
+  add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "gc-calls", 8), make_integer(sc, sc->gc_calls));
+
+  add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "small_ints", 10),
+			     cons(sc, make_integer(sc, NUM_SMALL_INTS), kmg(sc, NUM_SMALL_INTS * (sizeof(s7_pointer) + sizeof(s7_cell)))));
+
+  add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "permanent-cells", 15),
+			     cons(sc, make_integer(sc, sc->semipermanent_cells), kmg(sc, sc->semipermanent_cells * sizeof(s7_cell))));
+  i = 0;
+  for (gc_obj_t *g = sc->semipermanent_objects; g; i++, g = (gc_obj_t *)(g->nxt));
+  add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "permanent_objects", 17), make_integer(sc, i));
+  i = 0;
+  for (gc_obj_t *g = sc->semipermanent_lets; g; i++, g = (gc_obj_t *)(g->nxt));
+  add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "permanent_lets", 14), make_integer(sc, i));
+
+  /* safe_lists */
+  {
+    s7_int live = 0, in_use = 0, line_used = 0;
+    for (i = 1; i < NUM_SAFE_LISTS; i++)
+      if (is_pair(sc->safe_lists[i]))
+	{
+	  live++;
+	  if (list_is_in_use(sc->safe_lists[i])) {in_use++; line_used = i;}
+	}
+    sc->w = sc->nil;
+#if S7_DEBUGGING
+    for (i = NUM_SAFE_LISTS - 1; i > 0; i--) /* omit safe_lists[0]=() since it is never used */
+      sc->w = cons(sc, make_integer(sc, sc->safe_list_uses[i]), sc->w);
+#endif
+    add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "safe-lists", 10),
+			       (in_use == 0) ? list_3(sc, small_int(live), int_zero, sc->w) :
+			                       list_4(sc, small_int(live), small_int(in_use), small_int(line_used), sc->w));
+#if S7_DEBUGGING
+    sc->w = sc->unused;
+#endif
+  }
+
+  /* show how many active cells there are of each type (this is where all the memory_usage cpu time goes) */
+  for (i = 0; i < NUM_TYPES; i++) ts[i] = 0;
+  for (k = 0; k < sc->heap_size; k++)
+    ts[unchecked_type(sc->heap[k])]++;
+  sc->w = sc->nil;
+  for (i = 0; i < NUM_TYPES; i++)
+    {
+      if (i > 0) in_use += ts[i];
+      if (ts[i] > 0) /* was 50, 26-Sep-23 */
+	{
+	  /* can't use bare type name here ("let" is a syntactic symbol) */
+	  const char *tname = (i == 0) ? "free" : type_name_from_type(i, NO_ARTICLE);
+	  s7_int len = safe_strlen(tname);
+	  uint8_t name[32]; /* not 16 -- gmp overflows this buffer with "big-complex-number", len=18 */
+	  memcpy((void *)name, (const void *)tname, len);
+	  name[len] = (uint8_t)'\0';
+	  name[0] = (uint8_t)toupper((int)name[0]);
+	  sc->w = cons_unchecked(sc, make_integer(sc, ts[i]), cons(sc, make_symbol(sc, (const char *)name, len), sc->w));
+	}}
+  if (is_pair(sc->w))
+    add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "heap-by-type", 12), s7_inlet(sc, proper_list_reverse_in_place(sc, sc->w)));
+  sc->w = sc->unused;
+  /* same for semipermanent cells requires traversing saved_pointers and the alloc and big_alloc blocks up to alloc_k, or keeping explicit counts */
+
+  add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "cells-in-use/free", 17),
+			     cons(sc, make_integer(sc, in_use), make_integer(sc, sc->free_heap_top - sc->free_heap)));
+  add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "gc-protected-objects", 20),
+			     cons(sc, make_integer(sc, sc->protected_objects_size - sc->protected_objects_free_list_loc),
+				  make_integer(sc, sc->protected_objects_size)));
+  add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "setters", 7), make_integer(sc, sc->protected_setters_loc));
+
+  add_symbol_table(sc, mu_let);
+  add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "stack", 5), cons(sc, make_integer(sc, stack_top(sc)), make_integer(sc, sc->stack_size)));
+
+  len = sc->autoload_names_top * (sizeof(const char **) + sizeof(s7_int) + sizeof(bool));
+  for (i = 0; i < sc->autoload_names_loc; i++) len += sc->autoload_names_sizes[i];
+  add_slot_unchecked_with_id(sc, mu_let, sc->autoload_symbol, make_integer(sc, len));
+
+  add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "circle_info", 11),
+			     make_integer(sc, sc->circle_info->size * (sizeof(s7_pointer) + sizeof(int32_t) + sizeof(bool))));
+
+  add_gc_list_sizes(sc, mu_let);
+
+  /* strings */
+  gp = sc->strings;
+  for (len = 0, i = 0; i < (int32_t)(gp->loc); i++)
+    len += string_length(gp->list[i]);
+  add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "strings", 7), cons(sc, make_integer(sc, gp->loc), make_integer(sc, len)));
+
+  /* vectors */
+  {
+    s7_int vlen = 0, vs = 0, flen = 0, fvs = 0, ilen = 0, ivs = 0, blen = 0, bvs = 0;
+    for (k = 0, gp = sc->vectors; k < 2; k++, gp = sc->multivectors)
+      for (i = 0; i < gp->loc; i++)
+	{
+	  s7_pointer v = gp->list[i];
+	  if (is_float_vector(v))
+	    {fvs++; flen += vector_length(v);}
+	  else
+	    if (is_int_vector(v))
+	      {ivs++; ilen += vector_length(v);}
+	    else
+	      if (is_byte_vector(v))
+		{bvs++; blen += vector_length(v);}
+	      else {vs++; vlen += vector_length(v);}
+	}
+    all_len += blen + ilen * sizeof(s7_int) + flen * sizeof(s7_double) + vlen * sizeof(s7_pointer);
+    add_slot_unchecked_with_id(sc, mu_let,
+			       make_symbol(sc, "vectors", 7),
+			       s7_inlet(sc,
+			         s7_list(sc, 10,
+				   make_symbol(sc, "total", 5),  make_integer(sc, sc->vectors->loc + sc->multivectors->loc),
+				   make_symbol(sc, "normal", 6), cons(sc, make_integer(sc, vs), make_integer(sc, vlen)),
+				   make_symbol(sc, "float", 5),  cons(sc, make_integer(sc, fvs), make_integer(sc, flen)),
+				   make_symbol(sc, "int", 3),    cons(sc, make_integer(sc, ivs), make_integer(sc, ilen)),
+				   make_symbol(sc, "byte", 4),   cons(sc, make_integer(sc, bvs), make_integer(sc, blen)))));
+  }
+  /* hash-tables */
+  {
+    s7_int hlen = 0;
+    for (i = 0, gp = sc->hash_tables; i < gp->loc; i++)
+    {
+      s7_pointer v = gp->list[i];
+      hlen += ((hash_table_size(v)) * sizeof(hash_entry_t *));
+      hlen += (hash_table_entries(v) * sizeof(hash_entry_t));
+    }
+    all_len += all_len;
+    add_slot_unchecked_with_id(sc, mu_let,
+			       make_symbol(sc, "hash-tables", 11),
+			       cons(sc, make_integer(sc, sc->hash_tables->loc), make_integer(sc, hlen)));
+  }
+  /* ports */
+  add_slot_unchecked_with_id(sc, mu_let,
+			     make_symbol(sc, "input-port-stack", 16),
+			     cons(sc, make_integer(sc, sc->input_port_stack_loc), make_integer(sc, sc->input_port_stack_size)));
+  gp = sc->input_ports;
+  for (i = 0, len = 0; i < gp->loc; i++)
+    {
+      s7_pointer v = gp->list[i];
+      if (port_data(v)) len += port_data_size(v);
+    }
+  add_slot_unchecked_with_id(sc, mu_let,
+			     make_symbol(sc, "input-ports", 11),
+			     cons(sc, make_integer(sc, sc->input_ports->loc), make_integer(sc, len)));
+
+  gp = sc->input_string_ports;
+  for (i = 0, len = 0; i < gp->loc; i++)
+    {
+      s7_pointer v = gp->list[i];
+      if (port_data(v)) len += port_data_size(v);
+    }
+  add_slot_unchecked_with_id(sc, mu_let,
+			     make_symbol(sc, "input-string-ports", 18),
+			     cons(sc, make_integer(sc, sc->input_string_ports->loc), make_integer(sc, len)));
+
+  gp = sc->output_ports;
+  for (i = 0, len = 0; i < gp->loc; i++)
+    {
+      s7_pointer v = gp->list[i];
+      if (port_data(v)) len += port_data_size(v);
+    }
+  add_slot_unchecked_with_id(sc, mu_let,
+			     make_symbol(sc, "output-ports", 12),
+			     cons(sc, make_integer(sc, sc->output_ports->loc), make_integer(sc, len)));
+#if S7_DEBUGGING
+  i = 0;
+  for (s7_pointer p = sc->format_ports; p; i++, p = (s7_pointer)port_next(p));
+  add_slot_unchecked_with_id(sc, mu_let,
+			     make_symbol(sc, "format-ports-allocated/free/inuse", 33),
+			     list_3(sc, make_integer(sc, sc->format_ports_allocated), make_integer(sc, i), make_integer(sc, sc->format_ports_allocated - i)));
+#endif
+  /* continuations (sketchy!) */
+  gp = sc->continuations;
+  for (i = 0, len = 0; i < gp->loc; i++)
+    if (is_continuation(gp->list[i]))
+      len += continuation_stack_size(gp->list[i]);
+  if (len > 0)
+    add_slot_unchecked_with_id(sc, mu_let,
+			       make_symbol(sc, "continuations", 13),
+			       cons(sc, make_integer(sc, sc->continuations->loc), make_integer(sc, len * sizeof(s7_pointer))));
+  /* c-objects */
+  if (sc->c_objects->loc > 0)
+    add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "c-objects", 9), make_integer(sc, sc->c_objects->loc));
+  if (sc->num_c_object_types > 0)
+    add_slot_unchecked_with_id(sc, mu_let,
+			       make_symbol(sc, "c-types", 7),
+			       cons(sc, make_integer(sc, sc->num_c_object_types),
+				    make_integer(sc, (sc->c_object_types_size * sizeof(c_object_t *)) + (sc->num_c_object_types * sizeof(c_object_t)))));
+				    /* we're ignoring c_type->scheme_name: make_permanent_string(sc, name) */
+#if WITH_GMP
+  add_slot_unchecked_with_id(sc, mu_let,
+			     make_symbol(sc, "bignums", 7),
+			     s7_list(sc, 5, make_integer(sc, sc->big_integers->loc), make_integer(sc, sc->big_ratios->loc),
+				     make_integer(sc, sc->big_reals->loc), make_integer(sc, sc->big_complexes->loc),
+				     make_integer(sc, sc->big_random_states->loc)));
+#endif
+  /* free-lists (mallocate) */
+  {
+    block_t *b;
+#if S7_DEBUGGING
+    s7_int num_blocks = 0;
+    s7_pointer ff, frees = make_big_list(sc, NUM_BLOCK_LISTS, sc->nil);
+    s7_pointer fa, allocs = make_big_list(sc, NUM_BLOCK_LISTS, sc->nil);
+    s7_pointer fb, borrows = make_big_list(sc, NUM_BLOCK_LISTS, sc->nil);
+    ff = frees;
+    fa = allocs;
+    fb = borrows;
+#endif
+    for (i = 0, len = 0, sc->w = sc->nil; i < TOP_BLOCK_LIST; i++)
+      {
+	for (b = sc->block_lists[i], k = 0; b; b = block_next(b), k++); /* these are the free blocks awaiting mallocate */
+	sc->w = cons(sc, make_integer(sc, k), sc->w);
+	len += ((sizeof(block_t) + (1LL << i)) * k);
+#if S7_DEBUGGING
+	num_blocks += k;
+	set_car(ff, make_integer(sc, sc->blocks_freed[i])); ff = cdr(ff);
+	set_car(fa, make_integer(sc, sc->blocks_mallocated[i])); fa = cdr(fa);
+	set_car(fb, make_integer(sc, sc->blocks_borrowed[i])); fb = cdr(fb);
+#endif
+      }
+    for (b = sc->block_lists[TOP_BLOCK_LIST], k = 0; b; b = block_next(b), k++)
+      len += (sizeof(block_t) + block_size(b));
+    sc->w = cons(sc, make_integer(sc, k), sc->w);
+#if S7_DEBUGGING
+    num_blocks += k;
+    set_car(ff, make_integer(sc, sc->blocks_freed[TOP_BLOCK_LIST]));
+    set_car(fa, make_integer(sc, sc->blocks_mallocated[TOP_BLOCK_LIST]));
+    set_car(fb, make_integer(sc, sc->blocks_borrowed[TOP_BLOCK_LIST]));
+    add_slot_unchecked_with_id(sc, mu_let,
+			       make_symbol(sc, "blocks-allocated/available/in-use", 33),
+			       list_3(sc, make_integer(sc, sc->blocks_allocated), make_integer(sc, num_blocks), make_integer(sc, sc->blocks_allocated - num_blocks)));
+    add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "free-lists", 10),
+			       s7_inlet(sc, cons(sc, cons(sc, make_symbol(sc, "bytes", 5), kmg(sc, len)),
+						 list_4(sc, cons(sc, make_symbol(sc, "bins", 4), proper_list_reverse_in_place(sc, sc->w)),
+							cons(sc, make_symbol(sc, "allocs", 6), allocs),
+							cons(sc, make_symbol(sc, "frees", 5), frees),
+							cons(sc, make_symbol(sc, "borrows", 7), borrows)))));
+#else
+    add_slot_unchecked_with_id(sc, mu_let, make_symbol(sc, "free-lists", 10),
+			       s7_inlet(sc, list_2(sc, cons(sc, make_symbol(sc, "bytes", 5), kmg(sc, len)),
+						   cons(sc, make_symbol(sc, "bins", 4), proper_list_reverse_in_place(sc, sc->w)))));
+#endif
+    sc->w = sc->unused;
+    add_slot_unchecked_with_id(sc, mu_let,
+			       make_symbol(sc, "approximate-s7-size", 19),
+			       kmg(sc, ((sc->semipermanent_cells + NUM_SMALL_INTS + sc->heap_size) * (sizeof(s7_pointer) + sizeof(s7_cell))) +
+				   ((2 * sc->heap_size + SYMBOL_TABLE_SIZE + sc->stack_size) * sizeof(s7_pointer)) +
+				   len + all_len));
+  }
+
+  s7_gc_unprotect_at(sc, gc_loc);
+  return(mu_let);
+}
+
+static s7_pointer sl_c_types(s7_scheme *sc)
+{
+  s7_pointer res;
+  sc->w = sc->nil;
+  for (int32_t i = 0; i < sc->num_c_object_types; i++)           /* c-object type (tag) is i */
+    sc->w = cons(sc, sc->c_object_types[i]->scheme_name, sc->w);
+  res = proper_list_reverse_in_place(sc, sc->w);                 /* so car(types) has tag 0 */
+  sc->w = sc->unused;
+  return(res);
+}
+
+static s7_pointer sl_file_names(s7_scheme *sc)
+{
+  s7_pointer p;
+  sc->w = sc->nil;
+  for (int32_t i = 0; i <= sc->file_names_top; i++)
+    sc->w = cons(sc, sc->file_names[i], sc->w);
+  p = proper_list_reverse_in_place(sc, sc->w);
+  sc->w = sc->unused;
+  return(p);
+}
+
+static s7_pointer sl_int_fixup(s7_scheme *sc, s7_pointer val)
+{
+#if WITH_GMP
+  return(s7_int_to_big_integer(sc, s7_integer_clamped_if_gmp(sc, val)));
+#else
+  return(val);
+#endif
+}
+
+static s7_pointer sl_history(s7_scheme *sc)
+{
+#if WITH_HISTORY
+  return(cull_history(sc, (sc->cur_code == sc->history_sink) ? sc->old_cur_code : sc->cur_code));
+#else
+  return(sc->cur_code);
+#endif
+}
+
+static s7_pointer sl_active_catches(s7_scheme *sc)
+{
+  s7_pointer lst = sc->nil;
+  for (int64_t i = stack_top(sc) - 1; i >= 3; i -= 4)
+    switch (stack_op(sc->stack, i))
+      {
+      case OP_CATCH_ALL:
+	lst = cons(sc, sc->T, lst);
+	break;
+      case OP_CATCH_2: case OP_CATCH_1: case OP_CATCH:
+	lst = cons(sc, catch_tag(stack_code(sc->stack, i)), lst);
+	break;
+      }
+  return(reverse_in_place_unchecked(sc, sc->nil, lst));
+}
+
+static s7_pointer sl_stack_entries(s7_scheme *sc, s7_pointer stack, int64_t top)
+{
+  s7_pointer lst = sc->nil;       /* the stack can contain  anything (like #<unused>): this is a dangerous function */
+  for (int64_t i = top - 1; i >= 3; i -= 4)
+    {
+      s7_pointer func = stack_code(stack, i), args = stack_args(stack, i), e = stack_let(stack, i);
+      opcode_t op = stack_op(stack, i);
+      s7_pointer entry = sc->nil;
+      if (s7_is_valid(sc, e)) entry = cons(sc, e, entry);
+      if (s7_is_valid(sc, args)) entry = cons_unchecked(sc, args, entry);
+      if (s7_is_valid(sc, func)) entry = cons_unchecked(sc, func, entry);
+      if ((op >= 0) && (op < NUM_OPS)) entry = cons_unchecked(sc, make_symbol_with_strlen(sc, op_names[op]), entry);
+      lst = cons_unchecked(sc, entry, lst);
+      sc->w = lst;
+    }
+  sc->w = sc->unused;
+  return(reverse_in_place_unchecked(sc, sc->nil, lst));
+}
+
+static s7_pointer sl_protected_objects(s7_scheme *sc)
+{
+  s7_pointer nv = s7_vector_copy(sc, sc->protected_objects);
+  s7_pointer *vals = vector_elements(nv);
+  s7_int len = vector_length(nv);
+  for (s7_int i = 0; i < len; i++)
+    if (vals[i] == sc->unused)
+      vals[i] = sc->F;
+  return(nv);
+}
+
+static s7_pointer s7_starlet(s7_scheme *sc, s7_int choice)
+{
+  switch (choice)
+    {
+    case SL_ACCEPT_ALL_KEYWORD_ARGUMENTS:  return(make_boolean(sc, sc->accept_all_keyword_arguments));
+    case SL_AUTOLOADING:                   return(make_boolean(sc, sc->is_autoloading));
+    case SL_BIGNUM_PRECISION:              return(make_integer(sc, sc->bignum_precision));
+    case SL_CATCHES:                       return(sl_active_catches(sc));
+    case SL_CPU_TIME:                      return(make_real(sc, (double)clock() / (double)CLOCKS_PER_SEC)); /* cpu, not wall-clock time */
+    case SL_C_TYPES:                       return(sl_c_types(sc));
+    case SL_DEBUG:                         return(make_integer(sc, sc->debug));
+    case SL_DEFAULT_HASH_TABLE_LENGTH:     return(make_integer(sc, sc->default_hash_table_length));
+    case SL_DEFAULT_RANDOM_STATE:          return(sc->default_random_state);
+    case SL_DEFAULT_RATIONALIZE_ERROR:     return(make_real(sc, sc->default_rationalize_error));
+    case SL_EQUIVALENT_FLOAT_EPSILON:      return(make_real(sc, sc->equivalent_float_epsilon));
+    case SL_EXPANSIONS:                    return(make_boolean(sc, sc->is_expanding));
+    case SL_FILE_NAMES: case SL_FILENAMES: return(sl_file_names(sc));
+    case SL_FLOAT_FORMAT_PRECISION:        return(make_integer(sc, sc->float_format_precision));
+    case SL_FREE_HEAP_SIZE:                return(make_integer(sc, sc->free_heap_top - sc->free_heap));
+    case SL_GC_FREED:                      return(make_integer(sc, sc->gc_freed));
+    case SL_GC_INFO:                       return(list_3(sc, make_integer(sc, sc->gc_calls), make_integer(sc, sc->gc_total_time), make_integer(sc, ticks_per_second())));
+    case SL_GC_PROTECTED_OBJECTS:          return(sl_protected_objects(sc));
+    case SL_GC_RESIZE_HEAP_BY_4_FRACTION:  return(make_real(sc, sc->gc_resize_heap_by_4_fraction));
+    case SL_GC_RESIZE_HEAP_FRACTION:       return(make_real(sc, sc->gc_resize_heap_fraction));
+    case SL_GC_STATS:                      return(make_integer(sc, sc->gc_stats));
+    case SL_GC_TEMPS_SIZE:                 return(make_integer(sc, sc->gc_temps_size));
+    case SL_GC_TOTAL_FREED:                return(make_integer(sc, sc->gc_total_freed));
+    case SL_HASH_TABLE_FLOAT_EPSILON:      return(make_real(sc, sc->hash_table_float_epsilon));
+    case SL_HEAP_SIZE:                     return(make_integer(sc, sc->heap_size));
+    case SL_HISTORY:                       return(sl_history(sc));
+    case SL_HISTORY_ENABLED:               return(make_boolean(sc, s7_history_enabled(sc)));
+    case SL_HISTORY_SIZE:                  return(make_integer(sc, sc->history_size));
+    case SL_INITIAL_STRING_PORT_LENGTH:    return(make_integer(sc, sc->initial_string_port_length));
+    case SL_MAJOR_VERSION:                 return(make_integer(sc, S7_MAJOR_VERSION));
+    case SL_MINOR_VERSION:                 return(make_integer(sc, S7_MINOR_VERSION));
+    case SL_MAX_FORMAT_LENGTH:             return(make_integer(sc, sc->max_format_length));
+    case SL_MAX_HEAP_SIZE:                 return(make_integer(sc, sc->max_heap_size));
+    case SL_MAX_LIST_LENGTH:               return(make_integer(sc, sc->max_list_length));
+    case SL_MAX_PORT_DATA_SIZE:            return(make_integer(sc, sc->max_port_data_size));
+    case SL_MAX_STACK_SIZE:                return(make_integer(sc, sc->max_stack_size));
+    case SL_MAX_STRING_LENGTH:             return(make_integer(sc, sc->max_string_length));
+    case SL_MAX_VECTOR_DIMENSIONS:         return(make_integer(sc, sc->max_vector_dimensions));
+    case SL_MAX_VECTOR_LENGTH:             return(make_integer(sc, sc->max_vector_length));
+    case SL_MEMORY_USAGE:                  return(memory_usage(sc));
+    case SL_MOST_NEGATIVE_FIXNUM:          return(sl_int_fixup(sc, leastfix));
+    case SL_MOST_POSITIVE_FIXNUM:          return(sl_int_fixup(sc, mostfix));
+    case SL_MUFFLE_WARNINGS:               return(make_boolean(sc, sc->muffle_warnings));
+    case SL_NUMBER_SEPARATOR:              return(chars[(int)(sc->number_separator)]);
+    case SL_OPENLETS:                      return(make_boolean(sc, sc->has_openlets));
+    case SL_OUTPUT_FILE_PORT_DATA_SIZE:    return(make_integer(sc, sc->output_file_port_data_size));
+    case SL_PRINT_LENGTH:                  return(make_integer(sc, sc->print_length));
+    case SL_PROFILE:                       return(make_integer(sc, sc->profile));
+    case SL_PROFILE_INFO:                  return(profile_info_out(sc));
+    case SL_PROFILE_PREFIX:                return(sc->profile_prefix);
+    case SL_ROOTLET_SIZE:                  return(make_integer(sc, let_length(sc, sc->rootlet)));
+    case SL_SAFETY:                        return(make_integer(sc, sc->safety));
+    case SL_STACK:                         return(sl_stack_entries(sc, sc->stack, stack_top(sc)));
+    case SL_STACKTRACE_DEFAULTS:           return(copy_proper_list(sc, sc->stacktrace_defaults)); /* if not copied, we can set! entries directly to garbage */
+    case SL_STACK_SIZE:                    return(make_integer(sc, sc->stack_size));
+    case SL_STACK_TOP:                     return(make_integer(sc, (sc->stack_end - sc->stack_start) / 4));
+    case SL_SYMBOL_QUOTE:                  return(make_boolean(sc, sc->symbol_quote));
+    case SL_SYMBOL_PRINTER:                return(sc->symbol_printer);
+    case SL_UNDEFINED_CONSTANT_WARNINGS:   return(make_boolean(sc, sc->undefined_constant_warnings));
+    case SL_UNDEFINED_IDENTIFIER_WARNINGS: return(make_boolean(sc, sc->undefined_identifier_warnings));
+    case SL_VERSION:                       return(s7_make_string(sc, "s7 " S7_VERSION ", " S7_DATE));
+    }
+  return(sc->undefined);
+}
+
+s7_pointer s7_starlet_ref(s7_scheme *sc, s7_pointer sym) /* s7.h, not used here */
+{
+  if (is_symbol(sym))
+    {
+      if (is_keyword(sym))
+	sym = keyword_symbol(sym);
+      if (s7_starlet_symbol_id(sym) != SL_NO_FIELD)
+	return(s7_starlet(sc, s7_starlet_symbol_id(sym)));
+    }
+  return(sc->undefined);
+}
+
+s7_pointer s7_let_field_ref(s7_scheme *sc, s7_pointer sym) {return(s7_starlet_ref(sc, sym));}
+
+static s7_pointer g_s7_starlet_ref_fallback(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer sym = cadr(args);
+  if (!is_symbol(sym))
+    sole_arg_wrong_type_error_nr(sc, sc->let_ref_symbol, sym, sc->type_names[T_SYMBOL]);
+  if (is_keyword(sym))
+    sym = keyword_symbol(sym);
+  return(s7_starlet(sc, s7_starlet_symbol_id(sym)));
+}
+
+static s7_pointer s7_starlet_iterate(s7_scheme *sc, s7_pointer iterator)
+{
+  s7_pointer symbol, value;
+  iterator_position(iterator)++;
+  if (iterator_position(iterator) >= SL_NUM_FIELDS)
+    return(iterator_quit(iterator));
+  symbol = make_symbol_with_strlen(sc, s7_starlet_names[iterator_position(iterator)]);
+
+  if ((iterator_position(iterator) == SL_STACK) ||
+      (iterator_position(iterator) == SL_GC_PROTECTED_OBJECTS) ||
+      (iterator_position(iterator) == SL_MEMORY_USAGE))
+    value = sc->F;  /* (format #f "~W" (inlet *s7*)) or (let->list *s7*) etc */
+  else
+    {
+      s7_pointer osw = sc->w;  /* protect against s7_starlet list making */
+      value = s7_starlet(sc, s7_starlet_symbol_id(symbol));
+      sc->w = osw;
+    }
+  if (iterator_let_cons(iterator))
+    {
+      s7_pointer p = iterator_let_cons(iterator);
+      set_car(p, symbol);
+      set_cdr(p, value);
+      return(p);
+    }
+  return(cons(sc, symbol, value));
+}
+
+static s7_pointer s7_starlet_make_iterator(s7_scheme *sc, s7_pointer iter)
+{
+  iterator_position(iter) = SL_NO_FIELD;
+  iterator_next(iter) = s7_starlet_iterate;
+  iterator_let_cons(iter) = NULL;
+  return(iter);
+}
+
+static s7_pointer sl_real_geq_0(s7_scheme *sc, s7_pointer sym, s7_pointer val)
+{
+  if (!is_real(val)) s7_starlet_wrong_type_error_nr(sc, sym, val, sc->type_names[T_REAL]);
+  if (s7_real(val) < 0.0) s7_starlet_out_of_range_error_nr(sc, sym, val, wrap_string(sc, "it should not be negative", 25));
+  return(val);
+}
+
+static s7_pointer sl_integer_gt_0(s7_scheme *sc, s7_pointer sym, s7_pointer val)
+{
+  if (!s7_is_integer(val)) s7_starlet_wrong_type_error_nr(sc, sym, val, sc->type_names[T_INTEGER]);
+  if (s7_integer_clamped_if_gmp(sc, val) <= 0) s7_starlet_out_of_range_error_nr(sc, sym, val, wrap_string(sc, "it should be positive", 21));
+  return(val);
+}
+
+static s7_pointer sl_integer_geq_0(s7_scheme *sc, s7_pointer sym, s7_pointer val)
+{
+  if (!s7_is_integer(val)) s7_starlet_wrong_type_error_nr(sc, sym, val, sc->type_names[T_INTEGER]);
+  if (s7_integer_clamped_if_gmp(sc, val) < 0) s7_starlet_out_of_range_error_nr(sc, sym, val, wrap_string(sc, "it should not be negative", 25));
+  return(val);
+}
+
+#if WITH_HISTORY
+static void sl_set_history_size(s7_scheme *sc, s7_int iv)
+{
+  s7_pointer p1, p2;
+  if (iv > MAX_HISTORY_SIZE) iv = MAX_HISTORY_SIZE;
+  if (iv > sc->true_history_size)
+    {
+      /* splice in the new cells, reattach the circles */
+      s7_pointer p3;
+      s7_pointer next1 = cdr(sc->eval_history1);
+      s7_pointer next2 = cdr(sc->eval_history2);
+      s7_pointer next3 = cdr(sc->history_pairs);
+      set_cdr(sc->eval_history1, semipermanent_list(sc, iv - sc->true_history_size));
+      set_cdr(sc->eval_history2, semipermanent_list(sc, iv - sc->true_history_size));
+      set_cdr(sc->history_pairs, semipermanent_list(sc, iv - sc->true_history_size));
+      for (p3 = cdr(sc->history_pairs); is_pair(cdr(p3)); p3 = cdr(p3)) set_car(p3, semipermanent_list(sc, 1));
+      set_car(p3, semipermanent_list(sc, 1));
+      set_cdr(p3, next3);
+      for (p1 = sc->eval_history1, p2 = sc->eval_history2; is_pair(cdr(p1)); p1 = cdr(p1), p2 = cdr(p2));
+      set_cdr(p1, next1);
+      set_cdr(p2, next2);
+      sc->true_history_size = iv;
+    }
+  sc->history_size = iv;
+  /* clear out both buffers to avoid GC confusion */
+  for (p1 = sc->eval_history1, p2 = sc->eval_history2; ; p2 = cdr(p2))
+    {
+      set_car(p1, sc->nil);
+      set_car(p2, sc->nil);
+      p1 = cdr(p1);
+      if (p1 == sc->eval_history1) break;
+    }
+}
+#endif
+
+#if WITH_GMP
+static s7_pointer set_bignum_precision(s7_scheme *sc, int32_t precision)
+{
+  mp_prec_t bits = (mp_prec_t)precision;
+  s7_pointer bpi;
+  if (precision <= 1)                   /* (set! (*s7* 'bignum-precision) 1) causes mpfr to segfault! (also 0 and -1) */
+    sole_arg_out_of_range_error_nr(sc, wrap_string(sc, "set! (*s7* 'bignum-precision)", 29), wrap_integer(sc, precision), wrap_string(sc, "has to be greater than 1", 24));
+  mpfr_set_default_prec(bits);
+  mpc_set_default_precision(bits);
+  bpi = big_pi(sc);
+  global_slot(sc->pi_symbol)->object.slt.val = bpi; /* don't check immutable flag here (if debugging) -- i.e. don't use slot_set_value! */
+  return(sc->F);
+}
+#endif
+
+static s7_pointer sl_set_stacktrace_defaults(s7_scheme *sc, s7_pointer sym, s7_pointer val)
+{
+  if (!is_pair(val))
+    s7_starlet_wrong_type_error_nr(sc, sym, val, sc->type_names[T_PAIR]);
+  if (s7_list_length(sc, val) != 5)
+    s7_starlet_wrong_type_error_nr(sc, sym, val, wrap_string(sc, "a list with 5 entries", 21));
+  if (!is_t_integer(car(val)))
+    sl_stacktrace_wrong_type_error_nr(sc, sym, 1, car(val), wrap_string(sc, "an integer (stack frames)", 25), val);
+  if (!is_t_integer(cadr(val)))
+    sl_stacktrace_wrong_type_error_nr(sc, sym, 2, cadr(val), wrap_string(sc, "an integer (cols-for-data)", 26), val);
+  if (!is_t_integer(caddr(val)))
+    sl_stacktrace_wrong_type_error_nr(sc, sym, 3, caddr(val), wrap_string(sc, "an integer (line length)", 24), val);
+  if (!is_t_integer(cadddr(val)))
+    sl_stacktrace_wrong_type_error_nr(sc, sym, 4, cadddr(val), wrap_string(sc, "an integer (comment position)", 29), val);
+  if (!is_boolean(s7_list_ref(sc, val, 4)))
+    sl_stacktrace_wrong_type_error_nr(sc, sym, 5, s7_list_ref(sc, val, 4), wrap_string(sc, "a boolean (treat-data-as-comment)", 33), val);
+  sc->stacktrace_defaults = copy_proper_list(sc, val);
+  return(val);
+}
+
+static s7_pointer sl_set_gc_stats(s7_scheme *sc, s7_pointer sym, s7_pointer val)
+{
+  if (is_boolean(val))
+    {
+      sc->gc_stats = ((val == sc->T) ? GC_STATS : 0);
+      return(val);
+    }
+  if (!s7_is_integer(val))
+    s7_starlet_wrong_type_error_nr(sc, sym, val, sc->type_names[T_BOOLEAN]);
+  sc->gc_stats = s7_integer_clamped_if_gmp(sc, val);
+  if (sc->gc_stats >= 16) /* gc_stats is uint32_t */
+    {
+      sc->gc_stats = 0;
+      s7_starlet_out_of_range_error_nr(sc, sym, val, wrap_string(sc, "it should be between 0 and 15", 29));
+    }
+  return(val);
+}
+
+static s7_pointer sl_set_gc_info(s7_scheme *sc, s7_pointer sym, s7_pointer val) /* ticks_per_second is not settable */
+{
+  if (val == sc->F)
+    {
+      sc->gc_total_time = 0;
+      sc->gc_calls = 0;
+    }
+  else
+    if ((is_pair(val)) && (s7_is_integer(car(val))) &&
+	(is_pair(cdr(val))) && (s7_is_integer(cadr(val)))) /* caddr is ticks_per_second which can't sensibly be set */
+      {
+	sc->gc_total_time = s7_integer(car(val));
+	sc->gc_calls = s7_integer(cadr(val));
+      }
+    else s7_starlet_wrong_type_error_nr(sc, sym, val, wrap_string(sc, "#f or a list of two or three integers (the third is ignored)", 60));
+  return(sc->F);
+}
+
+static s7_pointer sl_set_profile(s7_scheme *sc, s7_pointer sym, s7_pointer val)
+{
+  if (!s7_is_integer(val))
+    s7_starlet_wrong_type_error_nr(sc, sym, val, sc->type_names[T_INTEGER]);
+  sc->profile = s7_integer_clamped_if_gmp(sc, val);
+  sc->debug_or_profile = ((sc->debug  > 1) || (sc->profile > 0));
+  if (sc->profile > 0)
+    {
+      if (!is_a_feature(make_symbol(sc, "profile.scm", 11), s7_symbol_value(sc, sc->features_symbol)))
+	s7_load(sc, "profile.scm");
+      if (!sc->profile_data)
+	make_profile_info(sc);
+      if (!sc->profile_out)
+	sc->profile_out = s7_make_function(sc, "profile-out", g_profile_out, 2, 0, false, NULL);
+    }
+  return(val);
+}
+
+static s7_pointer sl_set_debug(s7_scheme *sc, s7_pointer sym, s7_pointer val)
+{
+  if (!s7_is_integer(val))
+    s7_starlet_wrong_type_error_nr(sc, sym, val, sc->type_names[T_INTEGER]);
+  sc->debug = s7_integer_clamped_if_gmp(sc, val);
+  sc->debug_or_profile = ((sc->debug  > 1) || (sc->profile > 0));
+  if ((sc->debug > 0) &&
+      (!is_a_feature(make_symbol(sc, "debug.scm", 9), s7_symbol_value(sc, sc->features_symbol))))
+    s7_load(sc, "debug.scm");
+  return(val);
+}
+
+static s7_pointer sl_set_number_separator(s7_scheme *sc, s7_pointer sym, s7_pointer val)
+{
+#if (!WITH_NUMBER_SEPARATOR)
+  s7_warn(sc, 128, "(set! (*s7* 'number-separator) ...) but number-separator is not included in this s7");
+#endif
+  if (!is_character(val))
+    s7_starlet_wrong_type_error_nr(sc, sym, val, sc->type_names[T_CHARACTER]);
+  if ((is_char_numeric(val)) || (is_char_whitespace(val)) || (!t_number_separator_p[character(val)]) ||
+      (character(val) == 'i') || (character(val) == 'e') || (character(val) == 'E'))
+    /* I guess +nan.0 and +inf.0 are not numeric literals, so we don't need to catch +n_a_n.0 */
+    s7_starlet_wrong_type_error_nr(sc, sym, val, wrap_string(sc, "a printing, non-numeric character", 33));
+  sc->number_separator = character(val);
+  return(val);
+}
+
+static s7_pointer sl_set_bignum_precision(s7_scheme *sc, s7_pointer sym, s7_pointer val)
+{
+  s7_int iv;
+  iv = s7_integer_clamped_if_gmp(sc, sl_integer_gt_0(sc, sym, val));
+  sc->bignum_precision = iv;
+#if WITH_GMP
+  set_bignum_precision(sc, sc->bignum_precision);
+  mpfr_set_prec(sc->mpfr_1, sc->bignum_precision);
+  mpfr_set_prec(sc->mpfr_2, sc->bignum_precision);
+  mpc_set_prec(sc->mpc_1, sc->bignum_precision);
+  mpc_set_prec(sc->mpc_2, sc->bignum_precision);
+#endif
+  return(val);
+}
+
+static noreturn void sl_unsettable_error_nr(s7_scheme *sc, s7_pointer sym)
+{
+  immutable_object_error_nr(sc, set_elist_2(sc, wrap_string(sc, "can't set (*s7* '~S)", 20), sym));
+}
+
+static s7_pointer s7_starlet_set_1(s7_scheme *sc, s7_pointer sym, s7_pointer val)
+{
+  s7_int iv;
+
+  if ((S7_DEBUGGING) && (!is_symbol(sym)))
+    {
+      fprintf(stderr, "%s: %s\n", __func__, display(sym));
+      sole_arg_wrong_type_error_nr(sc, sc->let_set_symbol, sym, sc->type_names[T_SYMBOL]);
+    }
+  if (is_keyword(sym))
+    sym = keyword_symbol(sym);
+
+  switch (s7_starlet_symbol_id(sym))
+    {
+    case SL_ACCEPT_ALL_KEYWORD_ARGUMENTS:
+      if (!is_boolean(val)) s7_starlet_wrong_type_error_nr(sc, sym, val, sc->type_names[T_BOOLEAN]);
+      sc->accept_all_keyword_arguments = s7_boolean(sc, val);
+      return(val);
+
+    case SL_AUTOLOADING:
+      if (!is_boolean(val)) s7_starlet_wrong_type_error_nr(sc, sym, val, sc->type_names[T_BOOLEAN]);
+      sc->is_autoloading = s7_boolean(sc, val);
+      return(val);
+
+    case SL_BIGNUM_PRECISION:
+      return(sl_set_bignum_precision(sc, sym, val));
+
+    case SL_CATCHES:
+    case SL_CPU_TIME:
+    case SL_C_TYPES:
+      sl_unsettable_error_nr(sc, sym);
+
+    case SL_DEBUG:
+      return(sl_set_debug(sc, sym, val));
+
+    case SL_DEFAULT_HASH_TABLE_LENGTH:
+      sc->default_hash_table_length = s7_integer_clamped_if_gmp(sc, sl_integer_gt_0(sc, sym, val));
+      return(val);
+
+    case SL_DEFAULT_RANDOM_STATE:
+      if (!is_random_state(val)) s7_starlet_wrong_type_error_nr(sc, sym, val, sc->type_names[T_RANDOM_STATE]);
+#if (!WITH_GMP)
+      random_seed(sc->default_random_state) = random_seed(val);
+      random_carry(sc->default_random_state) = random_carry(val);
+#endif
+      return(val);
+
+    case SL_DEFAULT_RATIONALIZE_ERROR:
+      sc->default_rationalize_error = s7_real(sl_real_geq_0(sc, sym, val));
+      return(val);
+
+    case SL_EQUIVALENT_FLOAT_EPSILON:
+      sc->equivalent_float_epsilon = s7_real(sl_real_geq_0(sc, sym, val));
+      return(val);
+
+    case SL_EXPANSIONS:
+      if (!is_boolean(val)) s7_starlet_wrong_type_error_nr(sc, sym, val, sc->type_names[T_BOOLEAN]);
+      sc->is_expanding = s7_boolean(sc, val);
+      return(val);
+
+    case SL_FILE_NAMES: case SL_FILENAMES: sl_unsettable_error_nr(sc, sym);
+
+    case SL_FLOAT_FORMAT_PRECISION: /* float-format-precision should not be huge => hangs in snprintf -- what's a reasonable limit here? */
+      iv = s7_integer_clamped_if_gmp(sc, sl_integer_geq_0(sc, sym, val));
+      sc->float_format_precision = (iv < MAX_FLOAT_FORMAT_PRECISION) ? iv : MAX_FLOAT_FORMAT_PRECISION;
+      return(val);
+
+    case SL_FREE_HEAP_SIZE:
+    case SL_GC_FREED:
+    case SL_GC_TOTAL_FREED:
+    case SL_GC_PROTECTED_OBJECTS:
+      sl_unsettable_error_nr(sc, sym);
+
+    case SL_GC_TEMPS_SIZE:
+      sc->gc_temps_size = s7_integer_clamped_if_gmp(sc, sl_integer_gt_0(sc, sym, val));
+      return(val);
+    case SL_GC_RESIZE_HEAP_FRACTION:
+      sc->gc_resize_heap_fraction = s7_real(sl_real_geq_0(sc, sym, val));
+      return(val);
+    case SL_GC_RESIZE_HEAP_BY_4_FRACTION:
+      sc->gc_resize_heap_by_4_fraction = s7_real(sl_real_geq_0(sc, sym, val));
+      return(val);
+    case SL_GC_STATS:
+      return(sl_set_gc_stats(sc, sym, val));
+    case SL_GC_INFO:
+      return(sl_set_gc_info(sc, sym, val));
+
+    case SL_HASH_TABLE_FLOAT_EPSILON:
+      sc->hash_table_float_epsilon = s7_real(sl_real_geq_0(sc, sym, val));
+      return(val);
+
+    case SL_HEAP_SIZE:
+      iv = s7_integer_clamped_if_gmp(sc, sl_integer_geq_0(sc, sym, val));
+      if (iv > sc->heap_size)
+	resize_heap_to(sc, iv);
+      return(val);
+
+    case SL_HISTORY:               /* (set! (*s7* 'history) val) */
+      replace_current_code(sc, val);
+      return(val);
+
+    case SL_HISTORY_ENABLED:       /* (set! (*s7* 'history-enabled) #f|#t) */
+      if (!is_boolean(val)) s7_starlet_wrong_type_error_nr(sc, sym, val, sc->type_names[T_BOOLEAN]);
+      return(make_boolean(sc, s7_set_history_enabled(sc, s7_boolean(sc, val))));
+
+    case SL_HISTORY_SIZE:
+      iv = s7_integer_clamped_if_gmp(sc, sl_integer_geq_0(sc, sym, val));
+#if WITH_HISTORY
+      sl_set_history_size(sc, iv);
+#else
+      sc->history_size = iv;
+#endif
+      return(val);
+
+    case SL_INITIAL_STRING_PORT_LENGTH: sc->initial_string_port_length = s7_integer_clamped_if_gmp(sc, sl_integer_gt_0(sc, sym, val)); return(val);
+
+    case SL_MAJOR_VERSION:
+    case SL_MINOR_VERSION:
+      sl_unsettable_error_nr(sc, sym);
+
+    case SL_MAX_FORMAT_LENGTH:     sc->max_format_length = s7_integer_clamped_if_gmp(sc, sl_integer_gt_0(sc, sym, val));     return(val);
+    case SL_MAX_HEAP_SIZE:         sc->max_heap_size = s7_integer_clamped_if_gmp(sc, sl_integer_gt_0(sc, sym, val));         return(val);
+    case SL_MAX_LIST_LENGTH:       sc->max_list_length = s7_integer_clamped_if_gmp(sc, sl_integer_gt_0(sc, sym, val));       return(val);
+    case SL_MAX_PORT_DATA_SIZE:    sc->max_port_data_size = s7_integer_clamped_if_gmp(sc, sl_integer_gt_0(sc, sym, val));    return(val);
+
+    case SL_MAX_STACK_SIZE:
+      iv = s7_integer_clamped_if_gmp(sc, sl_integer_geq_0(sc, sym, val));
+      if (iv < INITIAL_STACK_SIZE)
+	s7_starlet_out_of_range_error_nr(sc, sym, val, wrap_string(sc, "it should be greater than the initial stack size", 48));
+      sc->max_stack_size = (uint32_t)iv;
+      return(val);
+
+    case SL_MAX_STRING_LENGTH:     sc->max_string_length = s7_integer_clamped_if_gmp(sc, sl_integer_gt_0(sc, sym, val));     return(val);
+    case SL_MAX_VECTOR_DIMENSIONS: sc->max_vector_dimensions = s7_integer_clamped_if_gmp(sc, sl_integer_gt_0(sc, sym, val)); return(val);
+    case SL_MAX_VECTOR_LENGTH:     sc->max_vector_length = s7_integer_clamped_if_gmp(sc, sl_integer_gt_0(sc, sym, val));     return(val);
+
+    case SL_MEMORY_USAGE:
+    case SL_MOST_NEGATIVE_FIXNUM:
+    case SL_MOST_POSITIVE_FIXNUM:
+      sl_unsettable_error_nr(sc, sym);
+
+    case SL_MUFFLE_WARNINGS:
+      if (!is_boolean(val)) s7_starlet_wrong_type_error_nr(sc, sym, val, sc->type_names[T_BOOLEAN]);
+      sc->muffle_warnings = s7_boolean(sc, val);
+      return(val);
+
+    case SL_NUMBER_SEPARATOR:   /* I think no PL uses the separator in output */
+      return(sl_set_number_separator(sc, sym, val));
+
+    case SL_OPENLETS:
+      if (!is_boolean(val)) s7_starlet_wrong_type_error_nr(sc, sym, val, sc->type_names[T_BOOLEAN]);
+      sc->has_openlets = s7_boolean(sc, val);
+      return(val);
+
+    case SL_OUTPUT_FILE_PORT_DATA_SIZE:
+      sc->output_file_port_data_size = s7_integer_clamped_if_gmp(sc, sl_integer_gt_0(sc, sym, val));
+      return(val);
+    case SL_PRINT_LENGTH: /* for pairs and vectors this affects how many elements are printed -- confusing */
+      sc->print_length = s7_integer_clamped_if_gmp(sc, sl_integer_geq_0(sc, sym, val));
+      return(val);
+
+    case SL_PROFILE:
+      return(sl_set_profile(sc,  sym, val));
+    case SL_PROFILE_INFO:
+      if (val != sc->F) s7_starlet_wrong_type_error_nr(sc, sym, val, wrap_string(sc, "#f (to clear the table)", 23));
+      return(clear_profile_info(sc));
+    case SL_PROFILE_PREFIX:
+      if ((is_symbol(val)) || val == sc->F) {sc->profile_prefix = val; return(val);}
+      s7_starlet_wrong_type_error_nr(sc, sym, val, wrap_string(sc, "a symbol or #f", 14));
+
+    case SL_ROOTLET_SIZE:
+      sl_unsettable_error_nr(sc, sym);
+
+    case SL_SAFETY:
+      if (!s7_is_integer(val))
+	s7_starlet_wrong_type_error_nr(sc, sym, val, sc->type_names[T_INTEGER]);
+      if ((s7_integer_clamped_if_gmp(sc, val) > 2) || (s7_integer_clamped_if_gmp(sc, val) < -1))
+	s7_starlet_out_of_range_error_nr(sc, sym, val, wrap_string(sc, "it should be between -1 (no safety) and 2 (max safety)", 54));
+      sc->safety = s7_integer_clamped_if_gmp(sc, val);
+      return(val);
+
+    case SL_STACKTRACE_DEFAULTS:
+      return(sl_set_stacktrace_defaults(sc, sym,val));
+
+    case SL_STACK:
+    case SL_STACK_SIZE:
+    case SL_STACK_TOP:
+      sl_unsettable_error_nr(sc, sym);
+
+    case SL_SYMBOL_PRINTER:
+      if (val != sc->F)
+	{
+	  if (!is_any_procedure(val))
+	    error_nr(sc, sc->wrong_type_arg_symbol,
+		     set_elist_4(sc, wrap_string(sc, "(set! (*s7* '~A) ~S): new value is ~A but should be a function or #f", 68),
+				 sym, val, object_type_name(sc, val)));
+	  if (!s7_is_aritable(sc, val, 1))
+	    error_nr(sc, sc->wrong_type_arg_symbol,
+		     set_elist_2(sc, wrap_string(sc, "(*s7* 'symbol-printer) function, ~A, should take one argument", 61), val));
+	}
+      sc->symbol_printer = val;
+      return(val);
+
+    case SL_SYMBOL_QUOTE:
+      if (!is_boolean(val)) s7_starlet_wrong_type_error_nr(sc, sym, val, sc->type_names[T_BOOLEAN]);
+      sc->symbol_quote = s7_boolean(sc, val);
+      return(val);
+
+    case SL_UNDEFINED_CONSTANT_WARNINGS:
+      if (!is_boolean(val)) s7_starlet_wrong_type_error_nr(sc, sym, val, sc->type_names[T_BOOLEAN]);
+      sc->undefined_constant_warnings = s7_boolean(sc, val);
+      return(val);
+
+    case SL_UNDEFINED_IDENTIFIER_WARNINGS:
+      if (!is_boolean(val)) s7_starlet_wrong_type_error_nr(sc, sym, val, sc->type_names[T_BOOLEAN]);
+      sc->undefined_identifier_warnings = s7_boolean(sc, val);
+      return(val);
+
+    case SL_VERSION:
+      sl_unsettable_error_nr(sc, sym);
+
+    default:
+      error_nr(sc, sc->out_of_range_symbol,
+	       set_elist_2(sc, wrap_string(sc, "can't set (*s7* '~S); no such field in *s7*", 43), sym));
+    }
+  return(sc->undefined);
+}
+
+s7_pointer s7_starlet_set(s7_scheme *sc, s7_pointer sym, s7_pointer new_value)
+{
+  if (is_symbol(sym))
+    {
+      if (is_keyword(sym))
+	sym = keyword_symbol(sym);
+      if (s7_starlet_symbol_id(sym) != SL_NO_FIELD)
+	return(s7_starlet_set_1(sc, sym, new_value));
+    }
+  return(sc->undefined);
+}
+
+s7_pointer s7_let_field_set(s7_scheme *sc, s7_pointer sym, s7_pointer new_value) {return(s7_starlet_set(sc, sym, new_value));}
+
+static void init_s7_starlet_immutable_field(void)
+{
+  s7_starlet_immutable_field = (bool *)Calloc(SL_NUM_FIELDS, sizeof(bool));
+  s7_starlet_immutable_field[SL_CATCHES] = true;
+  s7_starlet_immutable_field[SL_CPU_TIME] = true;
+  s7_starlet_immutable_field[SL_C_TYPES] = true;
+  s7_starlet_immutable_field[SL_FILE_NAMES] = true;
+  s7_starlet_immutable_field[SL_FILENAMES] = true;
+  s7_starlet_immutable_field[SL_FREE_HEAP_SIZE] = true;
+  s7_starlet_immutable_field[SL_GC_FREED] = true;
+  s7_starlet_immutable_field[SL_GC_TOTAL_FREED] = true;
+  s7_starlet_immutable_field[SL_GC_PROTECTED_OBJECTS] = true;
+  s7_starlet_immutable_field[SL_MEMORY_USAGE] = true;
+  s7_starlet_immutable_field[SL_MOST_NEGATIVE_FIXNUM] = true;
+  s7_starlet_immutable_field[SL_MOST_POSITIVE_FIXNUM] = true;
+  s7_starlet_immutable_field[SL_ROOTLET_SIZE] = true;
+  s7_starlet_immutable_field[SL_STACK] = true;
+  s7_starlet_immutable_field[SL_STACK_SIZE] = true;
+  s7_starlet_immutable_field[SL_STACK_TOP] = true;
+  s7_starlet_immutable_field[SL_VERSION] = true;
+  s7_starlet_immutable_field[SL_MAJOR_VERSION] = true;
+  s7_starlet_immutable_field[SL_MINOR_VERSION] = true;
+}
+
+#define NUM_INTEGER_WRAPPERS 4
+#define NUM_REAL_WRAPPERS 4
+
+/* ---------------- gdbinit annotated stacktrace ---------------- */
+#if (!MS_WINDOWS)
+/* s7bt, s7btfull: gdb stacktrace decoding */
+
+static const char *decoded_name(s7_scheme *sc, const s7_pointer p)
+{
+  if (p == sc->value)               return("sc->value");
+  if (p == sc->args)                return("sc->args");
+  if (p == sc->code)                return("sc->code");
+  if (p == sc->cur_code)            return("sc->cur_code");
+  if (p == sc->curlet)              return("sc->curlet");
+  if (p == sc->nil)                 return("()");
+  if (p == sc->T)                   return("#t");
+  if (p == sc->F)                   return("#f");
+  if (p == eof_object)              return("eof_object");
+  if (p == sc->undefined)           return("undefined");
+  if (p == sc->unspecified)         return("unspecified");
+  if (p == sc->no_value)            return("no_value");
+  if (p == sc->unused)              return("#<unused>");
+  if (p == sc->symbol_table)        return("symbol_table");
+  if (p == sc->rootlet)             return("rootlet");
+  if (p == sc->s7_starlet)          return("*s7*"); /* this is the function */
+  if (p == sc->owlet)               return("owlet");
+  if (p == sc->standard_input)      return("*stdin*");
+  if (p == sc->standard_output)     return("*stdout*");
+  if (p == sc->standard_error)      return("*stderr*");
+  if (p == sc->else_symbol)         return("else_symbol");
+  if (p == current_input_port(sc))  return("current-input-port");
+  if (p == current_output_port(sc)) return("current-output-port");
+  if (p == current_error_port(sc))  return("current-error_port");
+  if ((is_let(p)) && (is_unlet(p))) return("unlet");
+  {
+    s7_pointer wrapper;
+    int32_t i;
+    for (i = 0, wrapper = sc->string_wrappers; i < NUM_STRING_WRAPPERS; i++, wrapper = cdr(wrapper)) if (car(wrapper) == p) return("string-wrapper");
+    for (i = 0, wrapper = sc->integer_wrappers; i < NUM_INTEGER_WRAPPERS; i++, wrapper = cdr(wrapper)) if (car(wrapper) == p) return("integer-wrapper");
+    for (i = 0, wrapper = sc->real_wrappers; i < NUM_REAL_WRAPPERS; i++, wrapper = cdr(wrapper)) if (car(wrapper) == p) return("real-wrapper");
+    for (i = 0, wrapper = sc->c_pointer_wrappers; i < NUM_C_POINTER_WRAPPERS; i++, wrapper = cdr(wrapper)) if (car(wrapper) == p) return("c-pointer-wrapper");
+  }
+  return((p == sc->stack) ? "stack" : NULL);
+}
+
+static bool is_decodable(s7_scheme *sc, const s7_pointer p)
+{
+  int32_t i;
+  s7_pointer *tp = sc->heap;
+  s7_pointer *heap_top = (s7_pointer *)(sc->heap + sc->heap_size);
+
+  /* check symbol-table */
+  for (i = 0; i < SYMBOL_TABLE_SIZE; i++)
+    for (s7_pointer x = vector_element(sc->symbol_table, i); is_not_null(x); x = cdr(x))
+      {
+	s7_pointer sym = car(x);
+	if ((sym == p) ||
+	    ((is_global(sym)) && (is_slot(global_slot(sym))) && (p == global_value(sym))))
+	  return(true);
+      }
+
+  for (i = 0; i < NUM_CHARS; i++) if (p == chars[i]) return(true);
+  for (i = 0; i < NUM_SMALL_INTS; i++) if (p == small_ints[i]) return(true);
+
+  /* check the heap */
+  while (tp < heap_top)
+    if (p == (*tp++))
+      return(true);
+  return(false);
+}
+
+const char *s7_decode_bt(s7_scheme *sc);
+const char *s7_decode_bt(s7_scheme *sc)
+{
+  FILE *fp = fopen("gdb.txt", "r");
+  if (fp)
+    {
+      int64_t size;
+      size_t bytes;
+      bool in_quotes = false, old_stop = sc->stop_at_error;
+      uint8_t *bt;
+      block_t *bt_block;
+
+      sc->stop_at_error = false;
+      fseek(fp, 0, SEEK_END);
+      size = ftell(fp);
+      rewind(fp);
+
+      bt_block = mallocate(sc, (size + 1) * sizeof(uint8_t));
+      bt = (uint8_t *)block_data(bt_block);
+      bytes = fread(bt, sizeof(uint8_t), size, fp);
+      if (bytes != (size_t)size)
+	{
+	  fclose(fp);
+	  liberate(sc, bt_block);
+	  return(" oops ");
+	}
+      bt[size] = '\0';
+      fclose(fp);
+
+      for (int64_t i = 0; i < size; i++)
+	{
+	  fputc(bt[i], stdout);
+	  if ((bt[i] == '"') && ((i == 0) || (bt[i - 1] != '\\')))
+	    in_quotes = (!in_quotes);
+	  else
+	    if ((!in_quotes) && (i < size - 8) &&
+		((bt[i] == '=') &&
+		 (((bt[i + 1] == '0') && (bt[i + 2] == 'x')) ||
+		  ((bt[i + 1] == ' ') && (bt[i + 2] == '0') && (bt[i + 3] == 'x')))))
+	      {
+		void *vp;
+		int32_t vals = sscanf((const char *)(bt + i + 1), "%p", &vp);
+		if ((vp) && (vals == 1))
+		  {
+		    int32_t k;
+		    for (k = i + ((bt[i + 2] == 'x') ? 3 : 4); (k < size) && (is_digit(bt[k], 16)); k++);
+		    if ((bt[k] != ' ') || (bt[k + 1] != '"'))
+		      {
+			if (vp == (void *)sc)
+			  {
+			    if (bt[i + 1] == ' ') fputc(' ', stdout);
+			    fprintf(stdout, "%s[s7]%s", bold_text, unbold_text);
+			    i = k - 1;
+			  }
+			else
+			  {
+			    s7_pointer p = (s7_pointer)vp;
+			    const char *dname = decoded_name(sc, p);
+			    if (dname)
+			      {
+				if (bt[i + 1] == ' ') fputc(' ', stdout);
+				fprintf(stdout, "%s[%s]%s", bold_text, dname, unbold_text);
+			      }
+			    if ((dname) || (is_decodable(sc, p)))
+			      {
+				if (bt[i + 1] == ' ') fputc(' ', stdout);
+				i = k - 1;
+				if (s7_is_valid(sc, p))
+				  {
+				    s7_pointer strp = object_to_string_truncated(sc, p);
+				    if (dname) fprintf(stdout, " ");
+				    fprintf(stdout, "%s%s%s", bold_text, string_value(strp), unbold_text);
+				    if ((is_pair(p)) &&
+					(has_location(p)))
+				      {
+					uint32_t line = pair_line_number(p), file = pair_file_number(p);
+					if (line > 0)
+					  fprintf(stdout, " %s(%s[%u])%s", bold_text, string_value(sc->file_names[file]), line, unbold_text);
+				      }}}}}}}}
+      liberate(sc, bt_block);
+      sc->stop_at_error = old_stop;
+    }
+  return("");
+}
+#endif
+
+
+/* -------------------------------- initialization -------------------------------- */
+static void init_fx_function(void)
+{
+  fx_function = (s7_function *)Calloc(NUM_OPS, sizeof(s7_function));
+
+  fx_function[HOP_SAFE_C_NC] = fx_c_nc;
+  fx_function[HOP_SAFE_C_S] = fx_c_s;
+  fx_function[HOP_SAFE_C_SC] = fx_c_sc;
+  fx_function[HOP_SAFE_C_CS] = fx_c_cs;
+  fx_function[HOP_SAFE_C_CQ] = fx_c_cq;
+  fx_function[HOP_SAFE_C_FF] = fx_c_ff;
+  fx_function[HOP_SAFE_C_SS] = fx_c_ss;
+  fx_function[HOP_SAFE_C_opNCq] = fx_c_opncq;
+  fx_function[HOP_SAFE_C_opSq] = fx_c_opsq;
+  fx_function[HOP_SAFE_C_opSSq] = fx_c_opssq;
+  fx_function[HOP_SAFE_C_opSCq] = fx_c_opscq;
+  fx_function[HOP_SAFE_C_opCSq] = fx_c_opcsq;
+  fx_function[HOP_SAFE_C_opSq_S] = fx_c_opsq_s;
+  fx_function[HOP_SAFE_C_opSq_C] = fx_c_opsq_c;
+  fx_function[HOP_SAFE_C_opSq_CS] = fx_c_opsq_cs;
+  fx_function[HOP_SAFE_C_S_opSq] = fx_c_s_opsq;
+  fx_function[HOP_SAFE_C_C_opSq] = fx_c_c_opsq;
+  fx_function[HOP_SAFE_C_opCSq_C] = fx_c_opcsq_c;
+  fx_function[HOP_SAFE_C_opCSq_S] = fx_c_opcsq_s;
+  fx_function[HOP_SAFE_C_S_opCSq] = fx_c_s_opcsq;
+  fx_function[HOP_SAFE_C_opSSq_C] = fx_c_opssq_c;
+  fx_function[HOP_SAFE_C_opSCq_C] = fx_c_opscq_c;
+  fx_function[HOP_SAFE_C_opSSq_S] = fx_c_opssq_s;
+  fx_function[HOP_SAFE_C_S_opSSq] = fx_c_s_opssq;
+  fx_function[HOP_SAFE_C_C_opSSq] = fx_c_c_opssq;
+  fx_function[HOP_SAFE_C_S_opSCq] = fx_c_s_opscq;
+  fx_function[HOP_SAFE_C_C_opSCq] = fx_c_c_opscq;
+  fx_function[HOP_SAFE_C_opSq_opSq] = fx_c_opsq_opsq;
+  fx_function[HOP_SAFE_C_opSq_opSSq] = fx_c_opsq_opssq;
+  fx_function[HOP_SAFE_C_opSSq_opSq] = fx_c_opssq_opsq;
+  fx_function[HOP_SAFE_C_opSSq_opSSq] = fx_c_opssq_opssq;
+  fx_function[HOP_SAFE_C_op_opSqq] = fx_c_op_opsqq;
+  fx_function[HOP_SAFE_C_op_S_opSqq] = fx_c_op_s_opsqq;
+  fx_function[HOP_SAFE_C_op_opSq_Sq] = fx_c_op_opsq_sq;
+  fx_function[HOP_SAFE_C_op_opSSqq_S] = fx_c_op_opssqq_s;
+
+  fx_function[HOP_SAFE_C_SSC] = fx_c_ssc;
+  fx_function[HOP_SAFE_C_SSS] = fx_c_sss;
+  fx_function[HOP_SAFE_C_SCS] = fx_c_scs;
+  fx_function[HOP_SAFE_C_SCC] = fx_c_scc;
+  fx_function[HOP_SAFE_C_CSS] = fx_c_css;
+  fx_function[HOP_SAFE_C_CSC] = fx_c_csc;
+  fx_function[HOP_SAFE_C_CCS] = fx_c_ccs;
+  fx_function[HOP_SAFE_C_NS] = fx_c_ns;
+
+  fx_function[HOP_SAFE_C_A] = fx_c_a;
+  fx_function[HOP_SAFE_C_AA] = fx_c_aa;
+  fx_function[HOP_SAFE_C_SA] = fx_c_sa;
+  fx_function[HOP_SAFE_C_AS] = fx_c_as;
+  fx_function[HOP_SAFE_C_CA] = fx_c_ca;
+  fx_function[HOP_SAFE_C_AC] = fx_c_ac;
+  fx_function[HOP_SAFE_C_AAA] = fx_c_aaa;
+  fx_function[HOP_SAFE_C_CAC] = fx_c_cac;
+  fx_function[HOP_SAFE_C_CSA] = fx_c_csa;
+  fx_function[HOP_SAFE_C_SCA] = fx_c_sca;
+  fx_function[HOP_SAFE_C_SAS] = fx_c_sas;
+  fx_function[HOP_SAFE_C_SAA] = fx_c_saa;
+  fx_function[HOP_SAFE_C_SSA] = fx_c_ssa;
+  fx_function[HOP_SAFE_C_ASS] = fx_c_ass;
+  fx_function[HOP_SAFE_C_AGG] = fx_c_agg;
+  fx_function[HOP_SAFE_C_ALL_CA] = fx_c_all_ca;
+  fx_function[HOP_SAFE_C_NA] = fx_c_na;
+  fx_function[HOP_SAFE_C_4A] = fx_c_4a;
+  fx_function[HOP_SAFE_C_opAq] = fx_c_opaq;
+  fx_function[HOP_SAFE_C_opAAq] = fx_c_opaaq;
+  fx_function[HOP_SAFE_C_opAAAq] = fx_c_opaaaq;
+  fx_function[HOP_SAFE_C_opAq_S] = fx_c_opaq_s;
+  fx_function[HOP_SAFE_C_S_opAq] = fx_c_s_opaq;
+  fx_function[HOP_SAFE_C_S_opAAq] = fx_c_s_opaaq;
+
+  fx_function[HOP_HASH_TABLE_INCREMENT] = fx_hash_table_increment;
+
+  fx_function[HOP_SAFE_THUNK_A] = fx_safe_thunk_a;
+  fx_function[HOP_SAFE_CLOSURE_S_A] = fx_safe_closure_s_a;
+  fx_function[HOP_SAFE_CLOSURE_A_A] = fx_safe_closure_a_a;
+  fx_function[HOP_SAFE_CLOSURE_SS_A] = fx_safe_closure_ss_a;
+  fx_function[HOP_SAFE_CLOSURE_AA_A] = fx_safe_closure_aa_a;
+  fx_function[HOP_SAFE_CLOSURE_3S_A] = fx_safe_closure_3s_a;
+  fx_function[HOP_SAFE_CLOSURE_S_TO_S] = fx_safe_closure_s_to_s;
+  fx_function[HOP_SAFE_CLOSURE_S_TO_SC] = fx_safe_closure_s_to_sc;
+  fx_function[HOP_SAFE_CLOSURE_A_TO_SC] = fx_safe_closure_a_to_sc;
+
+  fx_function[OP_COND_NA_NA] = fx_cond_na_na;
+#if (!WITH_GMP)
+  fx_function[OP_CASE_A_I_S_A] = fx_case_a_i_s_a;
+#endif
+  fx_function[OP_CASE_A_E_S_A] = fx_case_a_e_s_a;
+  fx_function[OP_CASE_A_G_S_A] = fx_case_a_g_s_a;
+  fx_function[OP_CASE_A_S_G_A] = fx_case_a_s_g_a;
+  fx_function[OP_IF_A_C_C] = fx_if_a_c_c;
+  fx_function[OP_IF_A_A] = fx_if_a_a;
+  fx_function[OP_IF_S_A_A] = fx_if_s_a_a;
+  fx_function[OP_IF_A_A_A] = fx_if_a_a_a;
+  fx_function[OP_IF_AND2_S_A] = fx_if_and2_s_a;
+  fx_function[OP_IF_NOT_A_A] = fx_if_not_a_a;
+  fx_function[OP_IF_NOT_A_A_A] = fx_if_not_a_a_a;
+  fx_function[OP_IF_IS_TYPE_S_A_A] = fx_if_is_type_s_a_a;
+  fx_function[OP_OR_2A] = fx_or_2a;
+  fx_function[OP_OR_S_2] = fx_or_s_2;
+  fx_function[OP_OR_S_TYPE_2] = fx_or_s_type_2;
+  fx_function[OP_OR_3A] = fx_or_3a;
+  fx_function[OP_OR_N] = fx_or_n;
+  fx_function[OP_AND_2A] = fx_and_2a;
+  fx_function[OP_AND_S_2] = fx_and_s_2;
+  fx_function[OP_AND_3A] = fx_and_3a;
+  fx_function[OP_AND_N] = fx_and_n;
+  fx_function[OP_BEGIN_NA] = fx_begin_na;
+  fx_function[OP_BEGIN_AA] = fx_begin_aa;
+  fx_function[OP_LET_TEMP_A_A] = fx_let_temp_a_a;
+  fx_function[OP_WITH_LET_S] = fx_with_let_s;
+
+  fx_function[OP_IMPLICIT_S7_STARLET_REF_S] = fx_implicit_s7_starlet_ref_s;
+  fx_function[OP_IMPLICIT_LET_REF_C] =        fx_implicit_let_ref_c;
+  fx_function[OP_IMPLICIT_HASH_TABLE_REF_A] = fx_implicit_hash_table_ref_a;
+  fx_function[OP_IMPLICIT_PAIR_REF_A] =       fx_implicit_pair_ref_a;
+  fx_function[OP_IMPLICIT_C_OBJECT_REF_A] =   fx_implicit_c_object_ref_a;
+  fx_function[OP_IMPLICIT_VECTOR_REF_A] =     fx_implicit_vector_ref_a;
+
+  /* these are ok even if a "z" branch is taken -- in that case the body does not have the is_optimized bit, so is_fxable returns false */
+  fx_function[OP_TC_AND_A_OR_A_LA] = fx_tc_and_a_or_a_la;
+  fx_function[OP_TC_OR_A_AND_A_LA] = fx_tc_or_a_and_a_la;
+  fx_function[OP_TC_OR_A_A_AND_A_A_LA] = fx_tc_or_a_a_and_a_a_la;
+  fx_function[OP_TC_AND_A_OR_A_LAA] = fx_tc_and_a_or_a_laa;
+  fx_function[OP_TC_OR_A_AND_A_LAA] = fx_tc_or_a_and_a_laa;
+  fx_function[OP_TC_AND_A_OR_A_L3A] = fx_tc_and_a_or_a_l3a;
+  fx_function[OP_TC_OR_A_AND_A_L3A] = fx_tc_or_a_and_a_l3a;
+  fx_function[OP_TC_AND_A_OR_A_A_LA] = fx_tc_and_a_or_a_a_la;
+  fx_function[OP_TC_OR_A_AND_A_A_LA] = fx_tc_or_a_and_a_a_la;
+  fx_function[OP_TC_IF_A_Z_LA] = fx_tc_if_a_z_la;
+  fx_function[OP_TC_IF_A_LA_Z] = fx_tc_if_a_la_z;
+  fx_function[OP_TC_COND_A_Z_LA] = fx_tc_cond_a_z_la;
+  fx_function[OP_TC_COND_A_LA_Z] = fx_tc_cond_a_la_z;
+  fx_function[OP_TC_IF_A_Z_LAA] = fx_tc_if_a_z_laa;
+  fx_function[OP_TC_IF_A_LAA_Z] = fx_tc_if_a_laa_z;
+  fx_function[OP_TC_COND_A_Z_LAA] = fx_tc_cond_a_z_laa;
+  fx_function[OP_TC_COND_A_LAA_Z] = fx_tc_cond_a_laa_z;
+  fx_function[OP_TC_IF_A_Z_L3A] = fx_tc_if_a_z_l3a;
+  fx_function[OP_TC_IF_A_L3A_Z] = fx_tc_if_a_l3a_z;
+  fx_function[OP_TC_IF_A_Z_IF_A_Z_LA] = fx_tc_if_a_z_if_a_z_la;
+  fx_function[OP_TC_IF_A_Z_IF_A_LA_Z] = fx_tc_if_a_z_if_a_la_z;
+  fx_function[OP_TC_COND_A_Z_A_Z_LA] = fx_tc_cond_a_z_a_z_la;
+  fx_function[OP_TC_COND_A_Z_A_LA_Z] = fx_tc_cond_a_z_a_la_z;
+  fx_function[OP_TC_AND_A_IF_A_Z_LA] = fx_tc_and_a_if_a_z_la;
+  fx_function[OP_TC_AND_A_IF_A_LA_Z] = fx_tc_and_a_if_a_la_z;
+  fx_function[OP_TC_IF_A_Z_IF_A_LAA_Z] = fx_tc_if_a_z_if_a_laa_z;
+  fx_function[OP_TC_IF_A_Z_IF_A_Z_LAA] = fx_tc_if_a_z_if_a_z_laa;
+  fx_function[OP_TC_COND_A_Z_A_Z_LAA] = fx_tc_cond_a_z_a_z_laa;
+  fx_function[OP_TC_COND_A_Z_A_LAA_Z] = fx_tc_cond_a_z_a_laa_z;
+  fx_function[OP_TC_IF_A_Z_IF_A_L3A_L3A] = fx_tc_if_a_z_if_a_l3a_l3a;
+  fx_function[OP_TC_CASE_LA] = fx_tc_case_la;
+  fx_function[OP_TC_OR_A_AND_A_A_L3A] = fx_tc_or_a_and_a_a_l3a;
+  fx_function[OP_TC_LET_IF_A_Z_LA] = fx_tc_let_if_a_z_la;
+  fx_function[OP_TC_LET_IF_A_Z_LAA] = fx_tc_let_if_a_z_laa;
+  fx_function[OP_TC_LET_WHEN_LAA] = fx_tc_let_when_laa;
+  fx_function[OP_TC_LET_UNLESS_LAA] = fx_tc_let_unless_laa;
+  fx_function[OP_TC_LET_COND] = fx_tc_let_cond;
+  fx_function[OP_TC_COND_A_Z_A_LAA_LAA] = fx_tc_cond_a_z_a_laa_laa;
+  fx_function[OP_TC_WHEN_LA] = fx_tc_when_la;
+  fx_function[OP_TC_WHEN_LAA] = fx_tc_when_laa;
+  fx_function[OP_TC_WHEN_L3A] = fx_tc_when_l3a;
+
+  fx_function[OP_RECUR_IF_A_A_opA_LAq] = fx_recur_if_a_a_opa_laq;
+  fx_function[OP_RECUR_IF_A_opA_LAq_A] = fx_recur_if_a_opa_laq_a;
+  fx_function[OP_RECUR_IF_A_A_AND_A_LAA_LAA] = fx_recur_if_a_a_and_a_laa_laa;
+  fx_function[OP_RECUR_COND_A_A_A_A_opLA_LAq] = fx_recur_cond_a_a_a_a_opla_laq; /* very few calls (only s7test) */
+  fx_function[OP_RECUR_AND_A_OR_A_LAA_LAA] = fx_recur_and_a_or_a_laa_laa;       /* very few calls (lint) */
+}
+
+static void init_opt_functions(s7_scheme *sc)
+{
+#if (!WITH_PURE_S7)
+  s7_set_b_7pp_function(sc, global_value(sc->char_ci_lt_symbol), char_ci_lt_b_7pp);
+  s7_set_b_7pp_function(sc, global_value(sc->char_ci_leq_symbol), char_ci_leq_b_7pp);
+  s7_set_b_7pp_function(sc, global_value(sc->char_ci_gt_symbol), char_ci_gt_b_7pp);
+  s7_set_b_7pp_function(sc, global_value(sc->char_ci_geq_symbol), char_ci_geq_b_7pp);
+  s7_set_b_7pp_function(sc, global_value(sc->char_ci_eq_symbol), char_ci_eq_b_7pp);
+  s7_set_b_7pp_function(sc, global_value(sc->string_ci_lt_symbol), string_ci_lt_b_7pp);
+  s7_set_b_7pp_function(sc, global_value(sc->string_ci_leq_symbol), string_ci_leq_b_7pp);
+  s7_set_b_7pp_function(sc, global_value(sc->string_ci_gt_symbol), string_ci_gt_b_7pp);
+  s7_set_b_7pp_function(sc, global_value(sc->string_ci_geq_symbol), string_ci_geq_b_7pp);
+  s7_set_b_7pp_function(sc, global_value(sc->string_ci_eq_symbol), string_ci_eq_b_7pp);
+
+  s7_set_b_pp_unchecked_function(sc, global_value(sc->char_ci_lt_symbol), char_ci_lt_b_unchecked);
+  s7_set_b_pp_unchecked_function(sc, global_value(sc->char_ci_leq_symbol), char_ci_leq_b_unchecked);
+  s7_set_b_pp_unchecked_function(sc, global_value(sc->char_ci_gt_symbol), char_ci_gt_b_unchecked);
+  s7_set_b_pp_unchecked_function(sc, global_value(sc->char_ci_geq_symbol), char_ci_geq_b_unchecked);
+  s7_set_b_pp_unchecked_function(sc, global_value(sc->char_ci_eq_symbol), char_ci_eq_b_unchecked);
+  s7_set_b_pp_unchecked_function(sc, global_value(sc->string_ci_lt_symbol), string_ci_lt_b_unchecked);
+  s7_set_b_pp_unchecked_function(sc, global_value(sc->string_ci_leq_symbol), string_ci_leq_b_unchecked);
+  s7_set_b_pp_unchecked_function(sc, global_value(sc->string_ci_gt_symbol), string_ci_gt_b_unchecked);
+  s7_set_b_pp_unchecked_function(sc, global_value(sc->string_ci_geq_symbol), string_ci_geq_b_unchecked);
+  s7_set_b_pp_unchecked_function(sc, global_value(sc->string_ci_eq_symbol), string_ci_eq_b_unchecked);
+
+  s7_set_p_pp_function(sc, global_value(sc->vector_append_symbol), vector_append_p_pp);
+  s7_set_p_ppp_function(sc, global_value(sc->vector_append_symbol), vector_append_p_ppp);
+  s7_set_i_i_function(sc, global_value(sc->integer_length_symbol), integer_length_i_i);
+  s7_set_i_7p_function(sc, global_value(sc->string_length_symbol), string_length_i_7p);
+  s7_set_i_7p_function(sc, global_value(sc->vector_length_symbol), vector_length_i_7p);
+  s7_set_p_p_function(sc, global_value(sc->vector_to_list_symbol), vector_to_list_p_p);
+  s7_set_p_p_function(sc, global_value(sc->string_to_list_symbol), string_to_list_p_p);
+  s7_set_p_p_function(sc, global_value(sc->vector_length_symbol), vector_length_p_p);
+  s7_set_b_7p_function(sc, global_value(sc->is_exact_symbol), is_exact_b_7p);
+  s7_set_b_7p_function(sc, global_value(sc->is_inexact_symbol), is_inexact_b_7p);
+  s7_set_p_p_function(sc, global_value(sc->exact_to_inexact_symbol), exact_to_inexact_p_p);
+  s7_set_p_p_function(sc, global_value(sc->inexact_to_exact_symbol), inexact_to_exact_p_p);
+#endif
+
+  s7_set_p_pp_function(sc, global_value(sc->float_vector_ref_symbol), float_vector_ref_p_pp);
+  s7_set_d_7pi_function(sc, global_value(sc->float_vector_ref_symbol), float_vector_ref_d_7pi);
+  s7_set_d_7pii_function(sc, global_value(sc->float_vector_ref_symbol), float_vector_ref_d_7pii);
+  s7_set_d_7piii_function(sc, global_value(sc->float_vector_ref_symbol), float_vector_ref_d_7piii);
+  s7_set_d_7pid_function(sc, global_value(sc->float_vector_set_symbol), float_vector_set_d_7pid);
+  s7_set_d_7piid_function(sc, global_value(sc->float_vector_set_symbol), float_vector_set_d_7piid);
+  s7_set_d_7piiid_function(sc, global_value(sc->float_vector_set_symbol), float_vector_set_d_7piiid);
+
+  s7_set_p_pp_function(sc, global_value(sc->int_vector_ref_symbol), int_vector_ref_p_pp);
+  s7_set_i_7pi_function(sc, global_value(sc->int_vector_ref_symbol), int_vector_ref_i_7pi);
+  s7_set_i_7pii_function(sc, global_value(sc->int_vector_ref_symbol), int_vector_ref_i_7pii);
+  s7_set_i_7piii_function(sc, global_value(sc->int_vector_ref_symbol), int_vector_ref_i_7piii);
+  s7_set_i_7pii_function(sc, global_value(sc->int_vector_set_symbol), int_vector_set_i_7pii);
+  s7_set_i_7piii_function(sc, global_value(sc->int_vector_set_symbol), int_vector_set_i_7piii);
+
+  s7_set_i_7pi_function(sc, global_value(sc->byte_vector_ref_symbol), byte_vector_ref_i_7pi);
+  s7_set_i_7pii_function(sc, global_value(sc->byte_vector_ref_symbol), byte_vector_ref_i_7pii);
+  s7_set_i_7pii_function(sc, global_value(sc->byte_vector_set_symbol), byte_vector_set_i_7pii);
+  s7_set_i_7piii_function(sc, global_value(sc->byte_vector_set_symbol), byte_vector_set_i_7piii);
+
+  s7_set_p_pp_function(sc, global_value(sc->vector_ref_symbol), vector_ref_p_pp);
+  s7_set_p_pi_function(sc, global_value(sc->vector_ref_symbol), vector_ref_p_pi);
+  s7_set_p_pii_function(sc, global_value(sc->vector_ref_symbol), vector_ref_p_pii);
+  s7_set_p_pip_function(sc, global_value(sc->vector_set_symbol), vector_set_p_pip);
+  s7_set_p_piip_function(sc, global_value(sc->vector_set_symbol), vector_set_p_piip);
+  s7_set_p_pi_unchecked_function(sc, global_value(sc->vector_ref_symbol), vector_ref_p_pi_unchecked);
+  s7_set_p_pip_unchecked_function(sc, global_value(sc->vector_set_symbol), vector_set_p_pip_unchecked);
+  s7_set_p_ppp_function(sc, global_value(sc->vector_set_symbol), vector_set_p_ppp);
+  s7_set_p_ppp_function(sc, global_value(sc->int_vector_set_symbol), int_vector_set_p_ppp);
+
+  s7_set_p_pp_function(sc, global_value(sc->list_ref_symbol), list_ref_p_pp);
+  s7_set_p_pi_function(sc, global_value(sc->list_ref_symbol), list_ref_p_pi);
+  s7_set_p_pip_function(sc, global_value(sc->list_set_symbol), list_set_p_pip);
+  s7_set_p_pi_unchecked_function(sc, global_value(sc->list_ref_symbol), list_ref_p_pi_unchecked);
+  s7_set_p_pip_unchecked_function(sc, global_value(sc->list_set_symbol), list_set_p_pip_unchecked);
+  s7_set_p_p_function(sc, global_value(sc->cyclic_sequences_symbol), cyclic_sequences_p_p);
+  s7_set_p_pp_function(sc, global_value(sc->let_ref_symbol), let_ref);
+  s7_set_p_ppp_function(sc, global_value(sc->let_set_symbol), let_set_2); /* originally named "let_set" but that was unsearchable */
+  s7_set_p_pi_function(sc, global_value(sc->string_ref_symbol), string_ref_p_pi);
+  s7_set_p_pp_function(sc, global_value(sc->string_ref_symbol), string_ref_p_pp);
+  s7_set_p_pip_function(sc, global_value(sc->string_set_symbol), string_set_p_pip);
+  s7_set_p_pi_unchecked_function(sc, global_value(sc->string_ref_symbol), string_ref_p_pi_unchecked);
+  s7_set_p_pip_unchecked_function(sc, global_value(sc->string_set_symbol), string_set_p_pip_unchecked);
+  s7_set_p_pp_function(sc, global_value(sc->hash_table_ref_symbol), hash_table_ref_p_pp);
+  s7_set_p_ppp_function(sc, global_value(sc->hash_table_set_symbol), hash_table_set_p_ppp);
+
+  s7_set_p_ii_function(sc, global_value(sc->complex_symbol), complex_p_ii);
+  s7_set_p_dd_function(sc, global_value(sc->complex_symbol), complex_p_dd);
+  s7_set_p_i_function(sc, global_value(sc->number_to_string_symbol), number_to_string_p_i);
+  s7_set_p_p_function(sc, global_value(sc->number_to_string_symbol), number_to_string_p_p);
+  s7_set_p_pp_function(sc, global_value(sc->number_to_string_symbol), number_to_string_p_pp);
+  s7_set_p_p_function(sc, global_value(sc->string_to_number_symbol), string_to_number_p_p);
+  s7_set_p_pp_function(sc, global_value(sc->string_to_number_symbol), string_to_number_p_pp);
+
+  s7_set_p_p_function(sc, global_value(sc->car_symbol), car_p_p);
+  s7_set_p_pp_function(sc, global_value(sc->set_car_symbol), set_car_p_pp);
+  s7_set_p_p_function(sc, global_value(sc->cdr_symbol), cdr_p_p);
+  s7_set_p_pp_function(sc, global_value(sc->set_cdr_symbol), set_cdr_p_pp);
+  s7_set_p_p_function(sc, global_value(sc->caar_symbol), caar_p_p);
+  s7_set_p_p_function(sc, global_value(sc->cadr_symbol), cadr_p_p);
+  s7_set_p_p_function(sc, global_value(sc->cdar_symbol), cdar_p_p);
+  s7_set_p_p_function(sc, global_value(sc->cddr_symbol), cddr_p_p);
+  s7_set_p_p_function(sc, global_value(sc->caddr_symbol), caddr_p_p);
+  s7_set_p_p_function(sc, global_value(sc->caadr_symbol), caadr_p_p);
+  s7_set_p_p_function(sc, global_value(sc->cadar_symbol), cadar_p_p);
+  s7_set_p_p_function(sc, global_value(sc->cdddr_symbol), cdddr_p_p);
+  s7_set_p_p_function(sc, global_value(sc->cdadr_symbol), cdadr_p_p);
+  s7_set_p_p_function(sc, global_value(sc->cddar_symbol), cddar_p_p);
+  s7_set_p_p_function(sc, global_value(sc->cdaar_symbol), cdaar_p_p);
+  s7_set_p_p_function(sc, global_value(sc->caaar_symbol), caaar_p_p);
+  s7_set_p_p_function(sc, global_value(sc->caddar_symbol), caddar_p_p);
+  s7_set_p_p_function(sc, global_value(sc->caaddr_symbol), caaddr_p_p);
+  s7_set_p_p_function(sc, global_value(sc->cadddr_symbol), cadddr_p_p);
+  s7_set_p_p_function(sc, global_value(sc->cadadr_symbol), cadadr_p_p);
+  s7_set_p_p_function(sc, global_value(sc->cddadr_symbol), cddadr_p_p);
+  s7_set_p_p_function(sc, global_value(sc->cdddar_symbol), cdddar_p_p);
+  s7_set_p_p_function(sc, global_value(sc->cddddr_symbol), cddddr_p_p);
+
+  s7_set_p_p_function(sc, global_value(sc->string_symbol), string_p_p);
+  s7_set_p_p_function(sc, global_value(sc->string_to_symbol_symbol), string_to_symbol_p_p);
+  s7_set_p_p_function(sc, global_value(sc->symbol_to_string_symbol), symbol_to_string_p_p);
+  s7_set_p_p_function(sc, global_value(sc->symbol_symbol), string_to_symbol_p_p);
+  s7_set_p_pp_function(sc, global_value(sc->symbol_symbol), symbol_p_pp);
+  s7_set_p_function(sc, global_value(sc->newline_symbol), newline_p);
+  s7_set_p_p_function(sc, global_value(sc->newline_symbol), newline_p_p);
+  s7_set_p_p_function(sc, global_value(sc->display_symbol), display_p_p);
+  s7_set_p_pp_function(sc, global_value(sc->display_symbol), display_p_pp);
+  s7_set_p_p_function(sc, global_value(sc->write_symbol), write_p_p);
+  s7_set_p_pp_function(sc, global_value(sc->write_symbol), write_p_pp);
+  s7_set_p_p_function(sc, global_value(sc->write_char_symbol), write_char_p_p);
+  s7_set_p_pp_function(sc, global_value(sc->write_char_symbol), write_char_p_pp);
+  s7_set_p_pp_function(sc, global_value(sc->write_string_symbol), write_string_p_pp);
+  s7_set_p_pp_function(sc, global_value(sc->read_line_symbol), read_line_p_pp);
+  s7_set_p_p_function(sc, global_value(sc->read_line_symbol), read_line_p_p);
+
+  s7_set_p_pp_function(sc, global_value(sc->inlet_symbol), inlet_p_pp);
+  s7_set_i_7p_function(sc, global_value(sc->port_line_number_symbol), s7_port_line_number);
+  s7_set_p_pp_function(sc, global_value(sc->cons_symbol), cons_p_pp);
+  s7_set_p_function(sc, global_value(sc->open_output_string_symbol), s7_open_output_string);
+  s7_set_p_ppi_function(sc, global_value(sc->char_position_symbol), char_position_p_ppi);
+  s7_set_p_pp_function(sc, global_value(sc->append_symbol), s7_append);
+  s7_set_p_pp_function(sc, global_value(sc->string_append_symbol), string_append_p_pp);
+  s7_set_p_ppp_function(sc, global_value(sc->append_symbol), append_p_ppp);
+  s7_set_p_function(sc, global_value(sc->values_symbol), values_p);
+  s7_set_p_p_function(sc, global_value(sc->values_symbol), values_p_p);
+  s7_set_p_pp_function(sc, global_value(sc->member_symbol), member_p_pp);
+  s7_set_p_pp_function(sc, global_value(sc->assoc_symbol), assoc_p_pp);
+
+  s7_set_i_i_function(sc, global_value(sc->abs_symbol), abs_i_i);
+  s7_set_d_d_function(sc, global_value(sc->abs_symbol), abs_d_d);
+  s7_set_p_p_function(sc, global_value(sc->abs_symbol), abs_p_p);
+  s7_set_i_i_function(sc, global_value(sc->magnitude_symbol), magnitude_i_i);
+  s7_set_d_d_function(sc, global_value(sc->magnitude_symbol), magnitude_d_d);
+  s7_set_p_p_function(sc, global_value(sc->magnitude_symbol), magnitude_p_p);
+
+  s7_set_d_d_function(sc, global_value(sc->angle_symbol), angle_d_d);
+  s7_set_p_d_function(sc, global_value(sc->sin_symbol), sin_p_d);
+  s7_set_p_p_function(sc, global_value(sc->sin_symbol), sin_p_p);
+  s7_set_p_d_function(sc, global_value(sc->cos_symbol), cos_p_d);
+  s7_set_p_p_function(sc, global_value(sc->cos_symbol), cos_p_p);
+  s7_set_p_p_function(sc, global_value(sc->tan_symbol), tan_p_p);
+  s7_set_p_p_function(sc, global_value(sc->asin_symbol), asin_p_p);
+  s7_set_p_p_function(sc, global_value(sc->acos_symbol), acos_p_p);
+  s7_set_p_p_function(sc, global_value(sc->sinh_symbol), sinh_p_p);
+  s7_set_p_p_function(sc, global_value(sc->cosh_symbol), cosh_p_p);
+  s7_set_p_p_function(sc, global_value(sc->asinh_symbol), asinh_p_p);
+  s7_set_p_p_function(sc, global_value(sc->acosh_symbol), acosh_p_p);
+  s7_set_p_p_function(sc, global_value(sc->atanh_symbol), atanh_p_p);
+  s7_set_p_p_function(sc, global_value(sc->tanh_symbol), tanh_p_p);
+  s7_set_d_d_function(sc, global_value(sc->sin_symbol), sin_d_d);
+  s7_set_d_d_function(sc, global_value(sc->cos_symbol), cos_d_d);
+  s7_set_d_d_function(sc, global_value(sc->sinh_symbol), sinh_d_d);
+  s7_set_p_d_function(sc, global_value(sc->sinh_symbol), sinh_p_d);
+  s7_set_d_d_function(sc, global_value(sc->cosh_symbol), cosh_d_d);
+  s7_set_p_d_function(sc, global_value(sc->cosh_symbol), cosh_p_d);
+  s7_set_d_d_function(sc, global_value(sc->exp_symbol), exp_d_d);
+  s7_set_p_d_function(sc, global_value(sc->exp_symbol), exp_p_d);
+
+  s7_set_p_d_function(sc, global_value(sc->rationalize_symbol), rationalize_p_d);
+  s7_set_p_i_function(sc, global_value(sc->rationalize_symbol), rationalize_p_i);
+  s7_set_i_i_function(sc, global_value(sc->rationalize_symbol), rationalize_i_i);
+  s7_set_p_p_function(sc, global_value(sc->truncate_symbol), truncate_p_p);
+  s7_set_p_p_function(sc, global_value(sc->round_symbol), round_p_p);
+  s7_set_p_p_function(sc, global_value(sc->ceiling_symbol), ceiling_p_p);
+  s7_set_p_p_function(sc, global_value(sc->floor_symbol), floor_p_p);
+  s7_set_p_pp_function(sc, global_value(sc->max_symbol), max_p_pp);
+  s7_set_p_pp_function(sc, global_value(sc->min_symbol), min_p_pp);
+  s7_set_p_p_function(sc, global_value(sc->sqrt_symbol), sqrt_p_p);
+#if (!WITH_GMP)
+  s7_set_p_pp_function(sc, global_value(sc->expt_symbol), expt_p_pp);
+  /* same problem affects big_log|logior|logand|logxor|lcm|gcd|rationalize|remainder|modulo -- *_p_* will fail in gmp s7 */
+  s7_set_p_d_function(sc, global_value(sc->ceiling_symbol), ceiling_p_d);
+  s7_set_p_d_function(sc, global_value(sc->floor_symbol), floor_p_d);
+  s7_set_p_d_function(sc, global_value(sc->truncate_symbol), truncate_p_d);
+  s7_set_p_d_function(sc, global_value(sc->round_symbol), round_p_d);
+#endif
+  s7_set_d_7dd_function(sc, global_value(sc->remainder_symbol), remainder_d_7dd);
+  s7_set_i_7ii_function(sc, global_value(sc->remainder_symbol), remainder_i_7ii);
+  s7_set_i_7ii_function(sc, global_value(sc->quotient_symbol), quotient_i_7ii);
+  s7_set_d_7dd_function(sc, global_value(sc->modulo_symbol), modulo_d_7dd);
+  s7_set_i_ii_function(sc, global_value(sc->modulo_symbol), modulo_i_ii);
+  s7_set_p_dd_function(sc, global_value(sc->multiply_symbol), mul_p_dd);
+  s7_set_p_dd_function(sc, global_value(sc->add_symbol), add_p_dd);
+  s7_set_p_ii_function(sc, global_value(sc->add_symbol), add_p_ii);
+  s7_set_p_dd_function(sc, global_value(sc->subtract_symbol), subtract_p_dd);
+  s7_set_p_ii_function(sc, global_value(sc->subtract_symbol), subtract_p_ii);
+
+  s7_set_p_pp_function(sc, global_value(sc->modulo_symbol), modulo_p_pp);
+  s7_set_p_pi_function(sc, global_value(sc->modulo_symbol), modulo_p_pi);
+  s7_set_p_pp_function(sc, global_value(sc->remainder_symbol), remainder_p_pp);
+  s7_set_p_pi_function(sc, global_value(sc->remainder_symbol), remainder_p_pi);
+  s7_set_p_pp_function(sc, global_value(sc->quotient_symbol), quotient_p_pp);
+  s7_set_p_pi_function(sc, global_value(sc->quotient_symbol), quotient_p_pi);
+  s7_set_p_pp_function(sc, global_value(sc->subtract_symbol), subtract_p_pp);
+  s7_set_p_pp_function(sc, global_value(sc->add_symbol), add_p_pp);
+  s7_set_p_ppp_function(sc, global_value(sc->add_symbol), add_p_ppp);
+  s7_set_p_pp_function(sc, global_value(sc->multiply_symbol), multiply_p_pp);
+  s7_set_p_ppp_function(sc, global_value(sc->multiply_symbol), multiply_p_ppp);
+  s7_set_p_pp_function(sc, global_value(sc->divide_symbol), divide_p_pp);
+  s7_set_p_p_function(sc, global_value(sc->divide_symbol), invert_p_p);
+  s7_set_p_p_function(sc, global_value(sc->subtract_symbol), negate_p_p);
+  s7_set_p_p_function(sc, global_value(sc->is_even_symbol), is_even_p_p);
+  s7_set_p_p_function(sc, global_value(sc->is_odd_symbol), is_odd_p_p);
+
+  s7_set_p_p_function(sc, global_value(sc->random_symbol), random_p_p);
+  s7_set_d_7d_function(sc, global_value(sc->random_symbol), random_d_7d);
+  s7_set_i_7i_function(sc, global_value(sc->random_symbol), random_i_7i);
+
+  s7_set_p_d_function(sc, global_value(sc->float_vector_symbol), float_vector_p_d);
+  s7_set_p_i_function(sc, global_value(sc->int_vector_symbol), int_vector_p_i);
+  s7_set_p_i_function(sc, global_value(sc->float_vector_symbol), float_vector_p_i);
+  s7_set_i_i_function(sc, global_value(sc->round_symbol), round_i_i);
+  s7_set_i_i_function(sc, global_value(sc->floor_symbol), floor_i_i);
+  s7_set_i_i_function(sc, global_value(sc->ceiling_symbol), ceiling_i_i);
+  s7_set_i_i_function(sc, global_value(sc->truncate_symbol), truncate_i_i);
+
+  s7_set_d_d_function(sc, global_value(sc->tan_symbol), tan_d_d);
+  s7_set_d_d_function(sc, global_value(sc->atan_symbol), atan_d_d);
+  s7_set_d_dd_function(sc, global_value(sc->atan_symbol), atan_d_dd);
+  s7_set_d_d_function(sc, global_value(sc->tanh_symbol), tanh_d_d);
+  s7_set_p_p_function(sc, global_value(sc->exp_symbol), exp_p_p);
+#if (!WITH_GMP)
+  s7_set_i_7ii_function(sc, global_value(sc->ash_symbol), ash_i_7ii);
+  s7_set_i_7d_function(sc, global_value(sc->round_symbol), round_i_7d);
+  s7_set_i_7d_function(sc, global_value(sc->floor_symbol), floor_i_7d);
+  s7_set_i_7d_function(sc, global_value(sc->ceiling_symbol), ceiling_i_7d);
+  s7_set_i_7p_function(sc, global_value(sc->floor_symbol), floor_i_7p);
+  s7_set_i_7p_function(sc, global_value(sc->ceiling_symbol), ceiling_i_7p);
+  s7_set_i_7d_function(sc, global_value(sc->truncate_symbol), truncate_i_7d);
+#endif
+
+  s7_set_d_d_function(sc, global_value(sc->add_symbol), add_d_d);
+  s7_set_d_d_function(sc, global_value(sc->subtract_symbol), subtract_d_d);
+  s7_set_d_d_function(sc, global_value(sc->multiply_symbol), multiply_d_d);
+  s7_set_d_7d_function(sc, global_value(sc->divide_symbol), divide_d_7d);
+  s7_set_d_dd_function(sc, global_value(sc->add_symbol), add_d_dd);
+  s7_set_d_id_function(sc, global_value(sc->add_symbol), add_d_id);
+  s7_set_d_dd_function(sc, global_value(sc->subtract_symbol), subtract_d_dd);
+  s7_set_d_id_function(sc, global_value(sc->subtract_symbol), subtract_d_id);
+  s7_set_d_dd_function(sc, global_value(sc->multiply_symbol), multiply_d_dd);
+  s7_set_d_id_function(sc, global_value(sc->multiply_symbol), multiply_d_id);
+  s7_set_d_7dd_function(sc, global_value(sc->divide_symbol), divide_d_7dd);
+  s7_set_d_ddd_function(sc, global_value(sc->add_symbol), add_d_ddd);
+  s7_set_d_ddd_function(sc, global_value(sc->subtract_symbol), subtract_d_ddd);
+  s7_set_d_ddd_function(sc, global_value(sc->multiply_symbol), multiply_d_ddd);
+  s7_set_d_dddd_function(sc, global_value(sc->add_symbol), add_d_dddd);
+  s7_set_d_dddd_function(sc, global_value(sc->subtract_symbol), subtract_d_dddd);
+  s7_set_d_dddd_function(sc, global_value(sc->multiply_symbol), multiply_d_dddd);
+  s7_set_p_i_function(sc, global_value(sc->divide_symbol), divide_p_i);
+  s7_set_p_ii_function(sc, global_value(sc->divide_symbol), divide_p_ii);
+  s7_set_d_dd_function(sc, global_value(sc->max_symbol), max_d_dd);
+  s7_set_d_dd_function(sc, global_value(sc->min_symbol), min_d_dd);
+  s7_set_d_ddd_function(sc, global_value(sc->max_symbol), max_d_ddd);
+  s7_set_d_ddd_function(sc, global_value(sc->min_symbol), min_d_ddd);
+  s7_set_d_dddd_function(sc, global_value(sc->max_symbol), max_d_dddd);
+  s7_set_d_dddd_function(sc, global_value(sc->min_symbol), min_d_dddd);
+  s7_set_i_ii_function(sc, global_value(sc->max_symbol), max_i_ii);
+  s7_set_i_ii_function(sc, global_value(sc->min_symbol), min_i_ii);
+  s7_set_i_iii_function(sc, global_value(sc->max_symbol), max_i_iii);
+  s7_set_i_iii_function(sc, global_value(sc->min_symbol), min_i_iii);
+  s7_set_i_i_function(sc, global_value(sc->subtract_symbol), subtract_i_i);
+  s7_set_i_ii_function(sc, global_value(sc->add_symbol), add_i_ii);
+  s7_set_i_iii_function(sc, global_value(sc->add_symbol), add_i_iii);
+  s7_set_i_ii_function(sc, global_value(sc->subtract_symbol), subtract_i_ii);
+  s7_set_i_iii_function(sc, global_value(sc->subtract_symbol), subtract_i_iii);
+  s7_set_i_ii_function(sc, global_value(sc->multiply_symbol), multiply_i_ii);
+  s7_set_i_iii_function(sc, global_value(sc->multiply_symbol), multiply_i_iii);
+
+  s7_set_i_i_function(sc, global_value(sc->lognot_symbol), lognot_i_i);
+  s7_set_i_ii_function(sc, global_value(sc->logior_symbol), logior_i_ii);
+  s7_set_i_ii_function(sc, global_value(sc->logxor_symbol), logxor_i_ii);
+  s7_set_i_ii_function(sc, global_value(sc->logand_symbol), logand_i_ii);
+  s7_set_i_iii_function(sc, global_value(sc->logior_symbol), logior_i_iii);
+  s7_set_i_iii_function(sc, global_value(sc->logxor_symbol), logxor_i_iii);
+  s7_set_i_iii_function(sc, global_value(sc->logand_symbol), logand_i_iii);
+  s7_set_b_7ii_function(sc, global_value(sc->logbit_symbol), logbit_b_7ii);
+  s7_set_b_7pp_function(sc, global_value(sc->logbit_symbol), logbit_b_7pp);
+
+  s7_set_i_7p_function(sc, global_value(sc->numerator_symbol), numerator_i_7p);
+  s7_set_i_7p_function(sc, global_value(sc->denominator_symbol), denominator_i_7p);
+  s7_set_i_7p_function(sc, global_value(sc->char_to_integer_symbol), char_to_integer_i_7p);
+  s7_set_i_7p_function(sc, global_value(sc->hash_table_entries_symbol), hash_table_entries_i_7p);
+  s7_set_i_7p_function(sc, global_value(sc->tree_leaves_symbol), tree_leaves_i_7p);
+  s7_set_p_p_function(sc, global_value(sc->char_to_integer_symbol), char_to_integer_p_p);
+
+  s7_set_b_p_function(sc, global_value(sc->is_boolean_symbol), s7_is_boolean);
+  s7_set_b_p_function(sc, global_value(sc->is_byte_symbol), is_byte);
+  s7_set_b_p_function(sc, global_value(sc->is_byte_vector_symbol), is_byte_vector_b_p);
+  s7_set_b_p_function(sc, global_value(sc->is_c_object_symbol), s7_is_c_object);
+  s7_set_b_p_function(sc, global_value(sc->is_char_symbol), s7_is_character);
+  s7_set_b_p_function(sc, global_value(sc->is_complex_symbol), s7_is_complex);
+  s7_set_b_p_function(sc, global_value(sc->is_continuation_symbol), is_continuation_b_p);
+  s7_set_b_p_function(sc, global_value(sc->is_c_pointer_symbol), s7_is_c_pointer);
+  s7_set_b_p_function(sc, global_value(sc->is_dilambda_symbol), s7_is_dilambda);
+  s7_set_b_p_function(sc, global_value(sc->is_eof_object_symbol), is_eof_object_b_p);
+  s7_set_b_7p_function(sc, global_value(sc->is_even_symbol), is_even_b_7p);
+  s7_set_b_7p_function(sc, global_value(sc->is_odd_symbol), is_odd_b_7p);
+  s7_set_b_p_function(sc, global_value(sc->is_float_symbol), is_float_b);
+  s7_set_b_p_function(sc, global_value(sc->is_float_vector_symbol), s7_is_float_vector);
+  s7_set_b_p_function(sc, global_value(sc->is_gensym_symbol), is_gensym_b_p);
+  s7_set_b_p_function(sc, global_value(sc->is_hash_table_symbol), s7_is_hash_table);
+  s7_set_b_7p_function(sc, global_value(sc->is_infinite_symbol), is_infinite_b_7p);
+  s7_set_b_7p_function(sc, global_value(sc->is_nan_symbol), is_nan_b_7p);
+  s7_set_b_p_function(sc, global_value(sc->is_input_port_symbol), is_input_port_b);
+  s7_set_b_p_function(sc, global_value(sc->is_integer_symbol), s7_is_integer);
+  s7_set_b_p_function(sc, global_value(sc->is_int_vector_symbol), s7_is_int_vector);
+  s7_set_b_p_function(sc, global_value(sc->is_keyword_symbol), s7_is_keyword);
+  s7_set_b_p_function(sc, global_value(sc->is_let_symbol), s7_is_let);
+  s7_set_b_p_function(sc, global_value(sc->is_list_symbol), is_list_b);
+  s7_set_b_p_function(sc, global_value(sc->is_macro_symbol), is_macro_b);
+  s7_set_b_p_function(sc, global_value(sc->is_number_symbol), s7_is_number);
+  s7_set_b_p_function(sc, global_value(sc->is_output_port_symbol), is_output_port_b);
+  s7_set_b_p_function(sc, global_value(sc->is_pair_symbol), s7_is_pair);
+  s7_set_b_p_function(sc, global_value(sc->is_null_symbol), is_null_b_p);
+  s7_set_b_7p_function(sc, global_value(sc->is_port_closed_symbol), is_port_closed_b_7p);
+  s7_set_b_p_function(sc, global_value(sc->is_procedure_symbol), s7_is_procedure);
+  s7_set_b_7p_function(sc, global_value(sc->is_proper_list_symbol), s7_is_proper_list);
+  s7_set_b_p_function(sc, global_value(sc->is_random_state_symbol), s7_is_random_state);
+  s7_set_b_p_function(sc, global_value(sc->is_rational_symbol), s7_is_rational);
+  s7_set_b_p_function(sc, global_value(sc->is_real_symbol), s7_is_real);
+  s7_set_b_p_function(sc, global_value(sc->is_sequence_symbol), is_sequence_b);
+  s7_set_b_p_function(sc, global_value(sc->is_string_symbol), s7_is_string);
+  s7_set_b_p_function(sc, global_value(sc->is_symbol_symbol), s7_is_symbol);
+  s7_set_b_p_function(sc, global_value(sc->is_syntax_symbol), s7_is_syntax);
+  s7_set_b_p_function(sc, global_value(sc->is_vector_symbol), s7_is_vector);
+  s7_set_b_7p_function(sc, global_value(sc->is_iterator_symbol), is_iterator_b_7p);
+
+  s7_set_b_7p_function(sc, global_value(sc->is_char_alphabetic_symbol), is_char_alphabetic_b_7p);
+  s7_set_b_7p_function(sc, global_value(sc->is_char_lower_case_symbol), is_char_lower_case_b_7p);
+  s7_set_b_7p_function(sc, global_value(sc->is_char_numeric_symbol), is_char_numeric_b_7p);
+  s7_set_b_7p_function(sc, global_value(sc->is_char_upper_case_symbol), is_char_upper_case_b_7p);
+  s7_set_b_7p_function(sc, global_value(sc->is_char_whitespace_symbol), is_char_whitespace_b_7p);
+
+  s7_set_b_p_function(sc, global_value(sc->is_openlet_symbol), s7_is_openlet);
+  s7_set_b_7p_function(sc, global_value(sc->iterator_is_at_end_symbol), iterator_is_at_end_b_7p);
+  s7_set_b_7p_function(sc, global_value(sc->is_zero_symbol), is_zero_b_7p);
+  s7_set_b_7p_function(sc, global_value(sc->is_negative_symbol), is_negative_b_7p);
+  s7_set_b_7p_function(sc, global_value(sc->is_positive_symbol), is_positive_b_7p);
+  s7_set_b_7p_function(sc, global_value(sc->not_symbol), not_b_7p);
+  s7_set_b_7p_function(sc, global_value(sc->is_provided_symbol), is_provided_b_7p);
+  s7_set_b_7p_function(sc, global_value(sc->is_defined_symbol), is_defined_b_7p);
+  s7_set_b_7pp_function(sc, global_value(sc->is_defined_symbol), is_defined_b_7pp);
+  s7_set_b_7pp_function(sc, global_value(sc->tree_memq_symbol), s7_tree_memq);
+  s7_set_b_7p_function(sc, global_value(sc->tree_is_cyclic_symbol), tree_is_cyclic);
+  s7_set_b_7pp_function(sc, global_value(sc->tree_set_memq_symbol), tree_set_memq_b_7pp);
+  s7_set_p_pp_function(sc, global_value(sc->tree_set_memq_symbol), tree_set_memq_p_pp);
+  s7_set_b_p_function(sc, global_value(sc->is_immutable_symbol), s7_is_immutable);
+
+  s7_set_p_p_function(sc, global_value(sc->is_proper_list_symbol), is_proper_list_p_p);
+  s7_set_p_p_function(sc, global_value(sc->is_pair_symbol), is_pair_p_p);
+  s7_set_p_p_function(sc, global_value(sc->is_char_symbol), is_char_p_p);
+  s7_set_p_p_function(sc, global_value(sc->is_constant_symbol), is_constant_p_p);
+  s7_set_b_7p_function(sc, global_value(sc->is_constant_symbol), is_constant_b_7p);
+  s7_set_p_p_function(sc, global_value(sc->type_of_symbol), s7_type_of);
+  s7_set_p_i_function(sc, global_value(sc->integer_to_char_symbol), integer_to_char_p_i);
+  s7_set_p_p_function(sc, global_value(sc->integer_to_char_symbol), integer_to_char_p_p);
+  s7_set_p_p_function(sc, global_value(sc->iterate_symbol), iterate_p_p);
+  s7_set_p_p_function(sc, global_value(sc->list_symbol), list_p_p);
+  s7_set_p_pp_function(sc, global_value(sc->list_symbol), list_p_pp);
+  s7_set_p_ppp_function(sc, global_value(sc->list_symbol), list_p_ppp);
+  s7_set_p_pp_function(sc, global_value(sc->list_tail_symbol), list_tail_p_pp);
+  s7_set_p_pp_function(sc, global_value(sc->make_list_symbol), make_list_p_pp);
+  s7_set_p_pp_function(sc, global_value(sc->assq_symbol), assq_p_pp);
+  s7_set_p_pp_function(sc, global_value(sc->assv_symbol), assv_p_pp);
+  s7_set_p_pp_function(sc, global_value(sc->memq_symbol), memq_p_pp);
+  s7_set_p_pp_function(sc, global_value(sc->memv_symbol), memv_p_pp);
+  s7_set_p_p_function(sc, global_value(sc->tree_leaves_symbol), tree_leaves_p_p);
+  s7_set_p_p_function(sc, global_value(sc->length_symbol), s7_length);
+  s7_set_p_p_function(sc, global_value(sc->pair_line_number_symbol), pair_line_number_p_p);
+  s7_set_p_p_function(sc, global_value(sc->port_line_number_symbol), port_line_number_p_p);
+  s7_set_p_p_function(sc, global_value(sc->port_filename_symbol), port_filename_p_p);
+  s7_set_p_p_function(sc, global_value(sc->c_pointer_info_symbol), c_pointer_info_p_p);
+  s7_set_p_p_function(sc, global_value(sc->c_pointer_type_symbol), c_pointer_type_p_p);
+  s7_set_p_p_function(sc, global_value(sc->c_pointer_weak1_symbol), c_pointer_weak1_p_p);
+  s7_set_p_p_function(sc, global_value(sc->c_pointer_weak2_symbol), c_pointer_weak2_p_p);
+  s7_set_p_p_function(sc, global_value(sc->is_char_alphabetic_symbol), is_char_alphabetic_p_p);
+  s7_set_p_p_function(sc, global_value(sc->is_char_whitespace_symbol), is_char_whitespace_p_p);
+  s7_set_p_p_function(sc, global_value(sc->is_char_numeric_symbol), is_char_numeric_p_p);
+  s7_set_p_p_function(sc, global_value(sc->char_upcase_symbol), char_upcase_p_p);
+  s7_set_p_p_function(sc, global_value(sc->read_char_symbol), read_char_p_p);
+  s7_set_p_i_function(sc, global_value(sc->make_string_symbol), make_string_p_i);
+  s7_set_p_ii_function(sc, global_value(sc->make_int_vector_symbol), make_int_vector_p_ii);
+  s7_set_p_ii_function(sc, global_value(sc->make_byte_vector_symbol), make_byte_vector_p_ii);
+  s7_set_p_pp_function(sc, global_value(sc->vector_symbol), vector_p_pp);
+  s7_set_p_p_function(sc, global_value(sc->signature_symbol), s7_signature);
+  s7_set_p_p_function(sc, global_value(sc->copy_symbol), copy_p_p);
+  s7_set_p_p_function(sc, global_value(sc->reverse_symbol), reverse_p_p);
+  s7_set_p_p_function(sc, global_value(sc->object_to_let_symbol), object_to_let_p_p);
+  s7_set_p_p_function(sc, global_value(sc->outlet_symbol), outlet_p_p);
+  s7_set_p_p_function(sc, global_value(sc->make_iterator_symbol), s7_make_iterator);
+
+#if WITH_SYSTEM_EXTRAS
+  s7_set_b_7p_function(sc, global_value(sc->is_directory_symbol), is_directory_b_7p);
+  s7_set_b_7p_function(sc, global_value(sc->file_exists_symbol), file_exists_b_7p);
+#endif
+
+  s7_set_b_i_function(sc, global_value(sc->is_even_symbol), is_even_i);
+  s7_set_b_i_function(sc, global_value(sc->is_odd_symbol), is_odd_i);
+  s7_set_b_i_function(sc, global_value(sc->is_zero_symbol), is_zero_i);
+  s7_set_b_d_function(sc, global_value(sc->is_zero_symbol), is_zero_d);
+  s7_set_p_p_function(sc, global_value(sc->is_zero_symbol), is_zero_p_p);
+  s7_set_p_p_function(sc, global_value(sc->is_positive_symbol), is_positive_p_p);
+  s7_set_p_p_function(sc, global_value(sc->is_negative_symbol), is_negative_p_p);
+  s7_set_p_p_function(sc, global_value(sc->real_part_symbol), real_part_p_p);
+  s7_set_p_p_function(sc, global_value(sc->imag_part_symbol), imag_part_p_p);
+  s7_set_d_p_function(sc, global_value(sc->real_part_symbol), real_part_d_p);
+  s7_set_d_p_function(sc, global_value(sc->imag_part_symbol), imag_part_d_p);
+  s7_set_b_i_function(sc, global_value(sc->is_positive_symbol), is_positive_i);
+  s7_set_b_d_function(sc, global_value(sc->is_positive_symbol), is_positive_d);
+  s7_set_b_i_function(sc, global_value(sc->is_negative_symbol), is_negative_i);
+  s7_set_b_d_function(sc, global_value(sc->is_negative_symbol), is_negative_d);
+
+  s7_set_p_pi_function(sc, global_value(sc->lt_symbol), lt_p_pi);
+  s7_set_b_pi_function(sc, global_value(sc->lt_symbol), lt_b_pi);
+  s7_set_p_pi_function(sc, global_value(sc->leq_symbol), leq_p_pi);
+  s7_set_b_pi_function(sc, global_value(sc->leq_symbol), leq_b_pi);
+  s7_set_p_pi_function(sc, global_value(sc->gt_symbol), gt_p_pi);
+  s7_set_b_pi_function(sc, global_value(sc->gt_symbol), gt_b_pi);
+  s7_set_p_pi_function(sc, global_value(sc->geq_symbol), geq_p_pi);
+  s7_set_b_pi_function(sc, global_value(sc->geq_symbol), geq_b_pi);
+  /* no ip pd dp! */
+  s7_set_b_pi_function(sc, global_value(sc->num_eq_symbol), num_eq_b_pi);
+  s7_set_p_pi_function(sc, global_value(sc->num_eq_symbol), num_eq_p_pi);
+  s7_set_p_pi_function(sc, global_value(sc->add_symbol), add_p_pi);
+  s7_set_p_pi_function(sc, global_value(sc->subtract_symbol), g_sub_xi);
+  s7_set_p_pi_function(sc, global_value(sc->multiply_symbol), multiply_p_pi);
+
+  s7_set_p_ii_function(sc, global_value(sc->num_eq_symbol), num_eq_p_ii);
+  s7_set_p_dd_function(sc, global_value(sc->num_eq_symbol), num_eq_p_dd);
+  s7_set_p_pp_function(sc, global_value(sc->num_eq_symbol), num_eq_p_pp);
+  s7_set_b_7pp_function(sc, global_value(sc->num_eq_symbol), num_eq_b_7pp);
+  s7_set_b_ii_function(sc, global_value(sc->num_eq_symbol), num_eq_b_ii);
+  s7_set_b_dd_function(sc, global_value(sc->num_eq_symbol), num_eq_b_dd);
+
+  s7_set_p_ii_function(sc, global_value(sc->lt_symbol), lt_p_ii);
+  s7_set_p_dd_function(sc, global_value(sc->lt_symbol), lt_p_dd);
+  s7_set_p_pp_function(sc, global_value(sc->lt_symbol), lt_p_pp);
+  s7_set_b_7pp_function(sc, global_value(sc->lt_symbol), lt_b_7pp);
+  s7_set_b_ii_function(sc, global_value(sc->lt_symbol), lt_b_ii);
+  s7_set_b_dd_function(sc, global_value(sc->lt_symbol), lt_b_dd);
+
+  s7_set_b_ii_function(sc, global_value(sc->leq_symbol), leq_b_ii);
+  s7_set_p_dd_function(sc, global_value(sc->leq_symbol), leq_p_dd);
+  s7_set_p_ii_function(sc, global_value(sc->leq_symbol), leq_p_ii);
+  s7_set_b_dd_function(sc, global_value(sc->leq_symbol), leq_b_dd);
+  s7_set_p_pp_function(sc, global_value(sc->leq_symbol), leq_p_pp);
+  s7_set_b_7pp_function(sc, global_value(sc->leq_symbol), leq_b_7pp);
+
+  s7_set_b_ii_function(sc, global_value(sc->gt_symbol), gt_b_ii);
+  s7_set_b_dd_function(sc, global_value(sc->gt_symbol), gt_b_dd);
+  s7_set_p_dd_function(sc, global_value(sc->gt_symbol), gt_p_dd);
+  s7_set_p_ii_function(sc, global_value(sc->gt_symbol), gt_p_ii);
+  s7_set_p_pp_function(sc, global_value(sc->gt_symbol), gt_p_pp);
+  s7_set_b_7pp_function(sc, global_value(sc->gt_symbol), gt_b_7pp);
+
+  s7_set_b_ii_function(sc, global_value(sc->geq_symbol), geq_b_ii);
+  s7_set_b_dd_function(sc, global_value(sc->geq_symbol), geq_b_dd);
+  s7_set_p_ii_function(sc, global_value(sc->geq_symbol), geq_p_ii);
+  s7_set_p_dd_function(sc, global_value(sc->geq_symbol), geq_p_dd);
+  s7_set_p_pp_function(sc, global_value(sc->geq_symbol), geq_p_pp);
+  s7_set_b_7pp_function(sc, global_value(sc->geq_symbol), geq_b_7pp);
+
+  s7_set_b_pp_function(sc, global_value(sc->is_eq_symbol), s7_is_eq);
+  s7_set_p_pp_function(sc, global_value(sc->is_eq_symbol), is_eq_p_pp);
+  s7_set_b_7pp_function(sc, global_value(sc->is_eqv_symbol), s7_is_eqv);
+  s7_set_p_pp_function(sc, global_value(sc->is_eqv_symbol), is_eqv_p_pp);
+  s7_set_b_7pp_function(sc, global_value(sc->is_equal_symbol), s7_is_equal);
+  s7_set_b_7pp_function(sc, global_value(sc->is_equivalent_symbol), s7_is_equivalent);
+  s7_set_p_pp_function(sc, global_value(sc->is_equal_symbol), is_equal_p_pp);
+  s7_set_p_pp_function(sc, global_value(sc->is_equivalent_symbol), is_equivalent_p_pp);
+  s7_set_p_pp_function(sc, global_value(sc->char_eq_symbol), char_eq_p_pp);
+  s7_set_p_pp_function(sc, global_value(sc->make_float_vector_symbol), make_float_vector_p_pp);
+  s7_set_p_pp_function(sc, global_value(sc->setter_symbol), setter_p_pp);
+  s7_set_p_pp_function(sc, global_value(sc->complex_symbol), complex_p_pp);
+  s7_set_p_pp_function(sc, global_value(sc->string_eq_symbol), string_eq_p_pp);
+  s7_set_p_pp_function(sc, global_value(sc->string_lt_symbol), string_lt_p_pp);
+  s7_set_p_pp_function(sc, global_value(sc->string_gt_symbol), string_gt_p_pp);
+
+  s7_set_b_7pp_function(sc, global_value(sc->char_lt_symbol), char_lt_b_7pp);
+  s7_set_b_7pp_function(sc, global_value(sc->char_leq_symbol), char_leq_b_7pp);
+  s7_set_b_7pp_function(sc, global_value(sc->char_gt_symbol), char_gt_b_7pp);
+  s7_set_b_7pp_function(sc, global_value(sc->char_geq_symbol), char_geq_b_7pp);
+  s7_set_b_7pp_function(sc, global_value(sc->char_eq_symbol), char_eq_b_7pp);
+  s7_set_b_7pp_function(sc, global_value(sc->string_lt_symbol), string_lt_b_7pp);
+  s7_set_b_7pp_function(sc, global_value(sc->string_leq_symbol), string_leq_b_7pp);
+  s7_set_b_7pp_function(sc, global_value(sc->string_gt_symbol), string_gt_b_7pp);
+  s7_set_b_7pp_function(sc, global_value(sc->string_geq_symbol), string_geq_b_7pp);
+  s7_set_b_7pp_function(sc, global_value(sc->string_eq_symbol), string_eq_b_7pp);
+
+  s7_set_b_pp_unchecked_function(sc, global_value(sc->char_lt_symbol), char_lt_b_unchecked);
+  s7_set_b_pp_unchecked_function(sc, global_value(sc->char_leq_symbol), char_leq_b_unchecked);
+  s7_set_b_pp_unchecked_function(sc, global_value(sc->char_gt_symbol), char_gt_b_unchecked);
+  s7_set_b_pp_unchecked_function(sc, global_value(sc->char_geq_symbol), char_geq_b_unchecked);
+  s7_set_b_pp_unchecked_function(sc, global_value(sc->char_eq_symbol), char_eq_b_unchecked);
+  s7_set_b_pp_unchecked_function(sc, global_value(sc->string_lt_symbol), string_lt_b_unchecked);
+  s7_set_b_pp_unchecked_function(sc, global_value(sc->string_leq_symbol), string_leq_b_unchecked);
+  s7_set_b_pp_unchecked_function(sc, global_value(sc->string_gt_symbol), string_gt_b_unchecked);
+  s7_set_b_pp_unchecked_function(sc, global_value(sc->string_geq_symbol), string_geq_b_unchecked);
+  s7_set_b_pp_unchecked_function(sc, global_value(sc->string_eq_symbol), string_eq_b_unchecked);
+
+  s7_set_b_7pp_function(sc, global_value(sc->is_aritable_symbol), is_aritable_b_7pp);
+}
+
+static void init_features(s7_scheme *sc)
+{
+  s7_provide(sc, "s7");
+  s7_provide(sc, "s7-" S7_VERSION);
+  s7_provide(sc, "ratios"); /* changed from ratio 22-Aug-23; r7rs uses the plural */
+
+#if HAVE_COMPLEX_NUMBERS
+  s7_provide(sc, "complex-numbers");
+#endif
+#if WITH_GMP
+  s7_provide(sc, "gmp");
+#else
+  s7_provide(sc, "ieee-float"); /* why would anyone care? -- this is for r7rs -- why singular this time? */
+#endif
+#if WITH_PURE_S7
+  s7_provide(sc, "pure-s7");
+#endif
+#if WITH_EXTRA_EXPONENT_MARKERS
+  s7_provide(sc, "dfls-exponents");
+#endif
+#if HAVE_OVERFLOW_CHECKS
+  s7_provide(sc, "overflow-checks");
+#endif
+#if WITH_SYSTEM_EXTRAS
+  s7_provide(sc, "system-extras");
+#endif
+#if WITH_IMMUTABLE_UNQUOTE
+  s7_provide(sc, "immutable-unquote");
+#endif
+#if S7_DEBUGGING
+  s7_provide(sc, "debugging");
+#endif
+#if WITH_NUMBER_SEPARATOR
+  s7_provide(sc, "number-separator");
+#endif
+#if WITH_HISTORY
+  s7_provide(sc, "history");
+#endif
+#if WITH_C_LOADER
+  s7_provide(sc, "dlopen");
+#endif
+#if (!DISABLE_AUTOLOAD)
+  s7_provide(sc, "autoload");
+#endif
+#if S7_ALIGNED
+  s7_provide(sc, "aligned");
+#endif
+#if POINTER_32
+  s7_provide(sc, "32-bit");
+#endif
+
+#ifdef __APPLE__
+  s7_provide(sc, "osx");
+#endif
+#ifdef __linux__
+  s7_provide(sc, "linux");
+#endif
+#ifdef __OpenBSD__
+  s7_provide(sc, "openbsd");
+#endif
+#ifdef __NetBSD__
+  s7_provide(sc, "netbsd");
+#endif
+#ifdef __FreeBSD__
+  s7_provide(sc, "freebsd");
+#endif
+#if MS_WINDOWS
+  s7_provide(sc, "windows");
+#endif
+#ifdef __bfin__
+  s7_provide(sc, "blackfin");
+#endif
+#ifdef __ANDROID__
+  s7_provide(sc, "android");
+#endif
+#ifdef __MSYS__
+  s7_provide(sc, "msys2");  /* from chai xiaoxiang */
+#endif
+#ifdef __MINGW32__          /* this is also defined in mingw64 */
+  s7_provide(sc, "mingw");
+#endif
+#ifdef __CYGWIN__
+  s7_provide(sc, "cygwin"); /* this is also defined in msys2 */
+#endif
+#ifdef __hpux
+  s7_provide(sc, "hpux");
+#endif
+#if defined(__sun) && defined(__SVR4)
+  s7_provide(sc, "solaris");
+#endif
+
+#ifdef __clang__
+  s7_provide(sc, "clang");
+#endif
+#ifdef __GNUC__
+  s7_provide(sc, "gcc");
+#endif
+#ifdef __TINYC__
+  s7_provide(sc, "tcc"); /* appears to be 3-4 times slower than gcc (compilation is at least 10 times faster however) */
+#endif
+#ifdef __EMSCRIPTEN__
+  s7_provide(sc, "emscripten");
+#endif
+#ifdef _MSC_VER
+  s7_provide(sc, "msvc");
+#endif
+}
+
+static void init_wrappers(s7_scheme *sc)
+{
+  s7_pointer cp, qp;
+
+  sc->integer_wrappers = semipermanent_list(sc, NUM_INTEGER_WRAPPERS);
+  for (cp = sc->integer_wrappers, qp = sc->integer_wrappers; is_pair(cp); qp = cp, cp = cdr(cp))
+    {
+      s7_pointer p = alloc_pointer(sc);
+      full_type(p) = T_INTEGER | T_IMMUTABLE | T_MUTABLE | T_UNHEAP;  /* mutable to turn off set_has_number_name (see set_number_name) */
+      set_integer(p, 0);
+      set_car(cp, p);
+    }
+  unchecked_set_cdr(qp, sc->integer_wrappers);
+
+  sc->real_wrappers = semipermanent_list(sc, NUM_REAL_WRAPPERS);
+  for (cp = sc->real_wrappers, qp = sc->real_wrappers; is_pair(cp); qp = cp, cp = cdr(cp))
+    {
+      s7_pointer p = alloc_pointer(sc);
+      full_type(p) = T_REAL | T_IMMUTABLE | T_MUTABLE | T_UNHEAP;
+      set_real(p, 0.0);
+      set_car(cp, p);
+    }
+  unchecked_set_cdr(qp, sc->real_wrappers);
+
+  sc->string_wrappers = semipermanent_list(sc, NUM_STRING_WRAPPERS);
+  for (cp = sc->string_wrappers, qp = sc->string_wrappers; is_pair(cp); qp = cp, cp = cdr(cp))
+    {
+      s7_pointer p = alloc_pointer(sc);
+      full_type(p) = T_STRING | T_IMMUTABLE | T_SAFE_PROCEDURE | T_UNHEAP;
+      string_block(p) = NULL;
+      string_value(p) = NULL;
+      string_length(p) = 0;
+      string_hash(p) = 0;
+      set_car(cp, p);
+    }
+  unchecked_set_cdr(qp, sc->string_wrappers);
+
+  sc->c_pointer_wrappers = semipermanent_list(sc, NUM_C_POINTER_WRAPPERS);
+  for (cp = sc->c_pointer_wrappers, qp = sc->c_pointer_wrappers; is_pair(cp); qp = cp, cp = cdr(cp))
+    {
+      s7_pointer p = alloc_pointer(sc);
+      full_type(p) = T_C_POINTER | T_IMMUTABLE | T_UNHEAP;
+      c_pointer(p) = NULL;
+      c_pointer_type(p) = sc->F;
+      c_pointer_info(p) = sc->F;
+      c_pointer_weak1(p) = sc->F;
+      c_pointer_weak2(p) = sc->F;
+      set_car(cp, p);
+    }
+  unchecked_set_cdr(qp, sc->c_pointer_wrappers);
+}
+
+static s7_pointer syntax(s7_scheme *sc, const char *name, opcode_t op, s7_pointer min_args, s7_pointer max_args, const char *doc)
+{
+  s7_int len = safe_strlen(name);
+  uint64_t hash = raw_string_hash((const uint8_t *)name, len);
+  uint32_t loc = hash % SYMBOL_TABLE_SIZE;
+  s7_pointer x = new_symbol(sc, name, len, hash, loc);
+  s7_pointer syn = alloc_pointer(sc);
+
+  set_full_type(syn, T_SYNTAX | T_SYNTACTIC | T_DONT_EVAL_ARGS | T_UNHEAP);
+  syntax_opcode(syn) = op;
+  syntax_set_symbol(syn, x);
+  syntax_min_args(syn) = integer(min_args);
+  syntax_max_args(syn) = ((max_args == max_arity) ? -1 : integer(max_args));
+  syntax_documentation(syn) = doc;
+  set_global_slot(x, make_semipermanent_slot(sc, x, syn));
+  set_initial_value(x, syn);  /* set_local_slot(x, global_slot(x)); */
+  add_to_unlet(sc, x);
+  set_type_bit(x, T_SYMBOL | T_SYNTACTIC | T_UNHEAP);
+  symbol_set_local_slot_unchecked(x, 0LL, sc->nil);
+  symbol_clear_ctr(x);
+  return(x);
+}
+
+static s7_pointer definer_syntax(s7_scheme *sc, const char *name, opcode_t op, s7_pointer min_args, s7_pointer max_args, const char *doc)
+{
+  s7_pointer x = syntax(sc, name, op, min_args, max_args, doc);
+  set_syntax_is_definer(x);
+  return(x);
+}
+
+static s7_pointer binder_syntax(s7_scheme *sc, const char *name, opcode_t op, s7_pointer min_args, s7_pointer max_args, const char *doc)
+{
+  s7_pointer x = syntax(sc, name, op, min_args, max_args, doc);
+  set_syntax_is_binder(x);
+  return(x);
+}
+
+static s7_pointer copy_args_syntax(s7_scheme *sc, const char *name, opcode_t op, s7_pointer min_args, s7_pointer max_args, const char *doc)
+{
+  s7_pointer x = syntax(sc, name, op, min_args, max_args, doc);
+  s7_pointer p = global_value(x);
+  full_type(p) |= T_COPY_ARGS;
+  return(x);
+}
+
+static s7_pointer make_unique(s7_scheme *sc, const char* name, uint64_t typ)
+{
+  s7_pointer p = alloc_pointer(sc);
+  set_full_type(p, typ | T_IMMUTABLE | T_UNHEAP);
+  if (typ != T_UNUSED) set_optimize_op(p, OP_CONSTANT);
+  if (typ == T_UNDEFINED) /* sc->undefined here to avoid the undefined_constant_warning */
+    {
+      undefined_set_name_length(p, safe_strlen(name));
+      undefined_name(p) = copy_string_with_length(name, undefined_name_length(p));
+    }
+  else
+    {
+      unique_name_length(p) = safe_strlen(name);
+      unique_name(p) = copy_string_with_length(name, unique_name_length(p));
+      add_saved_pointer(sc, (void *)unique_name(p));
+    }
+  return(p);
+}
+
+static s7_pointer symbol_set_1(s7_scheme *sc, s7_pointer sym, s7_pointer val)
+{
+  s7_pointer slot = s7_slot(sc, sym);
+  if (!is_slot(slot))
+    error_nr(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, wrap_string(sc, "set!: '~S is unbound", 20), sym));
+  if (is_immutable_slot(slot))
+    immutable_object_error_nr(sc, set_elist_3(sc, immutable_error_string, sc->symbol_symbol, sym));
+  slot_set_value(slot, val);
+  return(val);
+}
+
+static s7_pointer g_symbol_set(s7_scheme *sc, s7_pointer args) /* (set! (symbol <lst>) <val>) */
+{
+  s7_int i = 0, len;
+  s7_pointer lst, val;
+  if (is_null(cddr(args)))
+    return(symbol_set_1(sc, g_symbol(sc, set_plist_1(sc, car(args))), cadr(args)));
+  len = proper_list_length(args) - 1;
+  lst = safe_list_if_possible(sc, len);
+  if (in_heap(lst)) gc_protect_via_stack(sc, lst);
+  for (s7_pointer ap = args, lp = lst; i < len; ap = cdr(ap), lp = cdr(lp), i++) set_car(lp, car(ap));
+  val = symbol_set_1(sc, g_symbol(sc, lst), s7_list_ref(sc, args, len));
+  if (in_heap(lst)) unstack_gc_protect(sc); else clear_list_in_use(lst);
+  return(val);
+}
+
+static void init_setters(s7_scheme *sc)
+{
+  sc->vector_set_function = global_value(sc->vector_set_symbol);
+  set_is_setter(sc->vector_set_symbol);
+  /* not float-vector-set! here */
+
+  sc->list_set_function = global_value(sc->list_set_symbol);
+  set_is_setter(sc->list_set_symbol);
+
+  sc->hash_table_set_function = global_value(sc->hash_table_set_symbol);
+  set_is_setter(sc->hash_table_set_symbol);
+
+  sc->let_set_function = global_value(sc->let_set_symbol);
+  set_is_setter(sc->let_set_symbol);
+
+  sc->string_set_function = global_value(sc->string_set_symbol);
+  set_is_setter(sc->string_set_symbol);
+
+  set_is_setter(sc->byte_vector_set_symbol);
+  set_is_setter(sc->set_car_symbol);
+  set_is_setter(sc->set_cdr_symbol);
+  set_is_safe_setter(sc->byte_vector_set_symbol);
+  set_is_safe_setter(sc->int_vector_set_symbol);
+  set_is_safe_setter(sc->float_vector_set_symbol);
+  set_is_safe_setter(sc->string_set_symbol);
+
+#if (WITH_PURE_S7)
+  /* we need to be able at least to set (current-output-port) to #f */
+  c_function_set_setter(global_value(sc->current_input_port_symbol),
+			s7_make_safe_function(sc, "#<set-*stdin*>", g_set_current_input_port, 1, 0, false, "*stdin* setter"));
+  c_function_set_setter(global_value(sc->current_output_port_symbol),
+			s7_make_safe_function(sc, "#<set-*stdout*>", g_set_current_output_port, 1, 0, false, "*stdout* setter"));
+#else
+  set_is_setter(sc->set_current_input_port_symbol);
+  set_is_setter(sc->set_current_output_port_symbol);
+  c_function_set_setter(global_value(sc->current_input_port_symbol),  global_value(sc->set_current_input_port_symbol));
+  c_function_set_setter(global_value(sc->current_output_port_symbol), global_value(sc->set_current_output_port_symbol));
+#endif
+
+  set_is_setter(sc->set_current_error_port_symbol);
+  c_function_set_setter(global_value(sc->current_error_port_symbol), global_value(sc->set_current_error_port_symbol));
+  /* despite the similar names, current-error-port is different from the other two, and a setter is needed
+   *    in scheme because error and warn send output to it by default.  It is not a "dynamic variable".
+   */
+
+  c_function_set_setter(global_value(sc->car_symbol),              global_value(sc->set_car_symbol));
+  c_function_set_setter(global_value(sc->cdr_symbol),              global_value(sc->set_cdr_symbol));
+  c_function_set_setter(global_value(sc->hash_table_ref_symbol),   global_value(sc->hash_table_set_symbol));
+  c_function_set_setter(global_value(sc->vector_ref_symbol),       global_value(sc->vector_set_symbol));
+  c_function_set_setter(global_value(sc->float_vector_ref_symbol), global_value(sc->float_vector_set_symbol));
+  c_function_set_setter(global_value(sc->int_vector_ref_symbol),   global_value(sc->int_vector_set_symbol));
+  c_function_set_setter(global_value(sc->byte_vector_ref_symbol),  global_value(sc->byte_vector_set_symbol));
+  c_function_set_setter(global_value(sc->list_ref_symbol),         global_value(sc->list_set_symbol));
+  c_function_set_setter(global_value(sc->let_ref_symbol),          global_value(sc->let_set_symbol));
+  c_function_set_setter(global_value(sc->string_ref_symbol),       global_value(sc->string_set_symbol));
+  c_function_set_setter(global_value(sc->outlet_symbol),
+			s7_make_safe_function(sc, "#<set-outlet>", g_set_outlet, 2, 0, false, "outlet setter"));
+  c_function_set_setter(global_value(sc->port_line_number_symbol),
+			s7_make_safe_function(sc, "#<set-port-line-number>", g_set_port_line_number, 1, 1, false, "port-line setter"));
+  c_function_set_setter(global_value(sc->port_string_symbol),
+			s7_make_safe_function(sc, "#<set-port-string>", g_set_port_string, 2, 0, false, "port-string setter"));
+  c_function_set_setter(global_value(sc->port_position_symbol),
+			s7_make_safe_function(sc, "#<set-port-position>", g_set_port_position, 2, 0, false, "port-position setter"));
+  c_function_set_setter(global_value(sc->vector_typer_symbol),
+			s7_make_safe_function(sc, "#<set-vector-typer>", g_set_vector_typer, 2, 0, false, "vector-typer setter"));
+  c_function_set_setter(global_value(sc->hash_table_key_typer_symbol),
+			s7_make_safe_function(sc, "#<set-hash-table-key-typer>", g_set_hash_table_key_typer, 2, 0, false, "hash-table-key-typer setter"));
+  c_function_set_setter(global_value(sc->hash_table_value_typer_symbol),
+			s7_make_safe_function(sc, "#<set-hash-table-value-typer>", g_set_hash_table_value_typer, 2, 0, false, "hash-table-value-typer setter"));
+  c_function_set_setter(global_value(sc->symbol_symbol),
+			s7_make_safe_function(sc, "#<symbol-set>", g_symbol_set, 2, 0, true, "symbol setter"));
+  c_function_set_setter(global_value(sc->symbol_initial_value_symbol),
+			s7_make_safe_function(sc, "#<symbol-set-initial-value>", g_symbol_set_initial_value, 2, 0, false, "symbol-initial-value setter"));
+
+}
+
+static void init_syntax(s7_scheme *sc)
+{
+  #define H_quote             "(quote obj) returns obj unevaluated.  'obj is an abbreviation for (quote obj)."
+  #define H_if                "(if expr true-stuff optional-false-stuff) evaluates expr, then if it is true, evaluates true-stuff; otherwise, \
+if optional-false-stuff exists, it is evaluated."
+  #define H_when              "(when expr ...) evaluates expr, and if it is true, evaluates each form in its body, returning the value of the last"
+  #define H_unless            "(unless expr ...) evaluates expr, and if it is false, evaluates each form in its body, returning the value of the last"
+  #define H_begin             "(begin ...) evaluates each form in its body, returning the value of the last one"
+  #define H_set               "(set! variable value) sets the value of variable to value."
+  #define H_let               "(let ((var val)...) ...) binds each variable to its initial value, then evaluates its body,\
+returning the value of the last form.  The let variables are local to it, and are not available for use until all have been initialized."
+  #define H_let_star          "(let* ((var val)...) ...) binds each variable to its initial value, then evaluates its body, \
+returning the value of the last form.  The let* variables are local to it, and are available immediately."
+  #define H_letrec            "(letrec ((var (lambda ...)))...) is like let, but var can refer to itself in its value \
+(i.e. you can define local recursive functions)"
+  #define H_letrec_star       "(letrec* ((var val))...) is like letrec, but successive bindings are handled as in let*"
+  #define H_cond              "(cond (expr clause...)...) is like if..then.  Each expr is evaluated in order, and if one is not #f, \
+the associated clauses are evaluated, whereupon cond returns."
+  #define H_and               "(and expr expr ...) evaluates each of its arguments in order, quitting (and returning #f) \
+as soon as one of them returns #f.  If all are non-#f, it returns the last value."
+  #define H_or                "(or expr expr ...) evaluates each of its arguments in order, quitting as soon as one of them is not #f.  \
+If all are #f, or returns #f."
+  #define H_case              "(case val ((key...) clause...)...) looks for val in the various lists of keys, and if a \
+match is found (via eqv?), the associated clauses are evaluated, and case returns."
+  #define H_do                "(do (vars...) (loop control and return value) ...) is a do-loop."
+  #define H_lambda            "(lambda args ...) returns a function."
+  #define H_lambda_star       "(lambda* args ...) returns a function; the args list can have default values, \
+the parameters themselves can be accessed via keywords."
+  #define H_define            "(define var val) assigns val to the variable (symbol) var.  (define (func args) ...) is \
+shorthand for (define func (lambda args ...))"
+  #define H_define_star       "(define* (func args) ...) defines a function with optional/keyword arguments."
+  #define H_define_constant   "(define-constant var val) defines var to be a constant (it can't be set or bound), with the value val."
+  #define H_define_macro      "(define-macro (mac args) ...) defines mac to be a macro."
+  #define H_define_macro_star "(define-macro* (mac args) ...) defines mac to be a macro with optional/keyword arguments."
+  #define H_macro             "(macro args ...) defines an unnamed macro."
+  #define H_macro_star        "(macro* args ...) defines an unnamed macro with optional/keyword arguments."
+  #define H_define_expansion  "(define-expansion (mac args) ...) defines mac to be a read-time macro."
+  #define H_define_expansion_star "(define-expansion* (mac args) ...) defines mac to be a read-time macro*."
+  #define H_define_bacro      "(define-bacro (mac args) ...) defines mac to be a bacro."
+  #define H_define_bacro_star "(define-bacro* (mac args) ...) defines mac to be a bacro with optional/keyword arguments."
+  #define H_bacro             "(bacro args ...) defines an unnamed bacro."
+  #define H_bacro_star        "(bacro* args ...) defines an unnamed bacro with optional/keyword arguments."
+  #define H_with_baffle       "(with-baffle ...) evaluates its body in a context that blocks re-entry via call/cc."
+  #define H_macroexpand       "(macroexpand macro-call) returns the result of the expansion phase of evaluating the macro call."
+  #define H_with_let          "(with-let let ...) evaluates its body in the environment let."
+  #define H_let_temporarily   "(let-temporarily ((var value)...) . body) sets each var to its new value, evals body, \
+then returns each var to its original value."
+
+  sc->quote_symbol =             syntax(sc, "quote",                   OP_QUOTE,             int_one,  int_one,    H_quote);
+  sc->quote_function = initial_value(sc->quote_symbol);
+  sc->if_symbol =                syntax(sc, "if",                      OP_IF,                int_two,  int_three,  H_if);
+  sc->when_symbol =              syntax(sc, "when",                    OP_WHEN,              int_two,  max_arity,  H_when);
+  sc->unless_symbol =            syntax(sc, "unless",                  OP_UNLESS,            int_two,  max_arity,  H_unless);
+  sc->begin_symbol =             syntax(sc, "begin",                   OP_BEGIN,             int_zero, max_arity,  H_begin);      /* (begin) is () */
+  sc->set_symbol =               syntax(sc, "set!",                    OP_SET,               int_two,  int_two,    H_set);
+  set_is_setter(sc->set_symbol); /* ? 26-Jan-24 */
+  sc->cond_symbol =              copy_args_syntax(sc, "cond",          OP_COND,              int_one,  max_arity,  H_cond);
+  sc->and_symbol =               copy_args_syntax(sc, "and",           OP_AND,               int_zero, max_arity,  H_and);
+  sc->or_symbol =                copy_args_syntax(sc, "or",            OP_OR,                int_zero, max_arity,  H_or);
+  sc->case_symbol =              syntax(sc, "case",                    OP_CASE,              int_two,  max_arity,  H_case);
+  sc->macroexpand_symbol =       syntax(sc, "macroexpand",             OP_MACROEXPAND,       int_one,  int_one,    H_macroexpand);
+  sc->let_temporarily_symbol =   syntax(sc, "let-temporarily",         OP_LET_TEMPORARILY,   int_two,  max_arity,  H_let_temporarily);
+  sc->define_symbol =            definer_syntax(sc, "define",          OP_DEFINE,            int_two,  max_arity,  H_define);
+  sc->define_star_symbol =       definer_syntax(sc, "define*",         OP_DEFINE_STAR,       int_two,  max_arity,  H_define_star);
+  sc->define_constant_symbol =   definer_syntax(sc, "define-constant", OP_DEFINE_CONSTANT,   int_two,  max_arity,  H_define_constant);
+  sc->define_macro_symbol =      definer_syntax(sc, "define-macro",    OP_DEFINE_MACRO,      int_two,  max_arity,  H_define_macro);
+  sc->define_macro_star_symbol = definer_syntax(sc, "define-macro*",   OP_DEFINE_MACRO_STAR, int_two,  max_arity,  H_define_macro_star);
+  sc->define_expansion_symbol =  definer_syntax(sc, "define-expansion",OP_DEFINE_EXPANSION,  int_two,  max_arity,  H_define_expansion);
+  sc->define_expansion_star_symbol = definer_syntax(sc, "define-expansion*",OP_DEFINE_EXPANSION_STAR, int_two, max_arity, H_define_expansion_star);
+  sc->define_bacro_symbol =      definer_syntax(sc, "define-bacro",    OP_DEFINE_BACRO,      int_two,  max_arity,  H_define_bacro);
+  sc->define_bacro_star_symbol = definer_syntax(sc, "define-bacro*",   OP_DEFINE_BACRO_STAR, int_two,  max_arity,  H_define_bacro_star);
+  sc->let_symbol =               binder_syntax(sc, "let",              OP_LET,               int_two,  max_arity,  H_let);
+  sc->let_star_symbol =          binder_syntax(sc, "let*",             OP_LET_STAR,          int_two,  max_arity,  H_let_star);
+  sc->letrec_symbol =            binder_syntax(sc, "letrec",           OP_LETREC,            int_two,  max_arity,  H_letrec);
+  sc->letrec_star_symbol =       binder_syntax(sc, "letrec*",          OP_LETREC_STAR,       int_two,  max_arity,  H_letrec_star);
+  sc->do_symbol =                binder_syntax(sc, "do",               OP_DO,                int_two,  max_arity,  H_do); /* 2 because body can be null */
+  sc->lambda_symbol =            binder_syntax(sc, "lambda",           OP_LAMBDA,            int_two,  max_arity,  H_lambda);
+  sc->lambda_star_symbol =       binder_syntax(sc, "lambda*",          OP_LAMBDA_STAR,       int_two,  max_arity,  H_lambda_star);
+  sc->macro_symbol =             binder_syntax(sc, "macro",            OP_MACRO,             int_two,  max_arity,  H_macro);
+  sc->macro_star_symbol =        binder_syntax(sc, "macro*",           OP_MACRO_STAR,        int_two,  max_arity,  H_macro_star);
+  sc->bacro_symbol =             binder_syntax(sc, "bacro",            OP_BACRO,             int_two,  max_arity,  H_bacro);
+  sc->bacro_star_symbol =        binder_syntax(sc, "bacro*",           OP_BACRO_STAR,        int_two,  max_arity,  H_bacro_star);
+  sc->with_let_symbol =          binder_syntax(sc, "with-let",         OP_WITH_LET,          int_one,  max_arity,  H_with_let);
+  sc->with_baffle_symbol =       binder_syntax(sc, "with-baffle",      OP_WITH_BAFFLE,       int_zero, max_arity,  H_with_baffle); /* (with-baffle) is () */
+  set_local_slot(sc->with_let_symbol, global_slot(sc->with_let_symbol)); /* for set_locals */
+  set_immutable(sc->with_let_symbol);
+  set_immutable_slot(global_slot(sc->with_let_symbol));
+  sc->setter_symbol = make_symbol(sc, "setter", 6);
+
+  sc->feed_to_symbol =              make_symbol(sc, "=>", 2);
+  sc->body_symbol =                 make_symbol(sc, "body", 4);
+  sc->read_error_symbol =           make_symbol(sc, "read-error", 10);
+  sc->string_read_error_symbol =    make_symbol(sc, "string-read-error", 17);
+  sc->syntax_error_symbol =         make_symbol(sc, "syntax-error", 12);
+  sc->unbound_variable_symbol =     make_symbol(sc, "unbound-variable", 16);
+  sc->wrong_type_arg_symbol =       make_symbol(sc, "wrong-type-arg", 14);
+  sc->wrong_number_of_args_symbol = make_symbol(sc, "wrong-number-of-args", 20);
+  sc->format_error_symbol =         make_symbol(sc, "format-error", 12);
+  sc->autoload_error_symbol =       make_symbol(sc, "autoload-error", 14);
+  sc->out_of_range_symbol =         make_symbol(sc, "out-of-range", 12);
+  sc->out_of_memory_symbol =        make_symbol(sc, "out-of-memory", 13);
+  sc->io_error_symbol =             make_symbol(sc, "io-error", 8);
+  sc->missing_method_symbol =       make_symbol(sc, "missing-method", 14);
+  sc->number_to_real_symbol =       make_symbol(sc, "number_to_real", 14);
+  sc->invalid_exit_function_symbol = make_symbol(sc, "invalid-exit-function", 21);
+  sc->immutable_error_symbol =      make_symbol(sc, "immutable-error", 15);
+  sc->division_by_zero_symbol =     make_symbol(sc, "division-by-zero", 16);
+  sc->bad_result_symbol =           make_symbol(sc, "bad-result", 10);
+  sc->no_setter_symbol =            make_symbol(sc, "no-setter", 9);
+  sc->baffled_symbol =              make_symbol(sc, "baffled!", 8);
+  sc->value_symbol =                make_symbol(sc, "value", 5);
+  sc->type_symbol =                 make_symbol(sc, "type", 4);
+  sc->position_symbol =             make_symbol(sc, "position", 8);
+  sc->file_symbol =                 make_symbol(sc, "file", 4);
+  sc->line_symbol =                 make_symbol(sc, "line", 4);
+  sc->function_symbol =             make_symbol(sc, "function", 8);
+
+  sc->else_symbol =                 make_symbol(sc, "else", 4);
+  s7_make_slot(sc, sc->rootlet, sc->else_symbol, sc->else_symbol);
+  set_initial_value(sc->else_symbol, s7_make_keyword(sc, "else")); /* 3-Oct-23 was #t */
+  /* if we set #_else to 'else, it can pick up a local else value: (let ((else #f)) (cond (#_else 2)...)) -- #_* is read-time */
+
+  sc->allow_other_keys_keyword =    s7_make_keyword(sc, "allow-other-keys");
+  sc->rest_keyword =                s7_make_keyword(sc, "rest");
+  sc->if_keyword =                  s7_make_keyword(sc, "if");       /* internal optimizer local-let marker */
+  sc->readable_keyword =            s7_make_keyword(sc, "readable");
+  sc->display_keyword =             s7_make_keyword(sc, "display");
+  sc->write_keyword =               s7_make_keyword(sc, "write");
+}
+
+static void init_rootlet(s7_scheme *sc)
+{
+  /* most of init_rootlet (the built-in  functions for example), could be shared by all s7 instances.
+   *   currently, each s7_init call allocates room for them, then s7_free frees it -- kinda wasteful.
+   */
+  s7_pointer sym;
+  init_syntax(sc);
+
+  sc->owlet = init_owlet(sc);
+
+  sc->wrong_type_arg_info = semipermanent_list(sc, 6);
+  set_car(sc->wrong_type_arg_info, s7_make_semipermanent_string(sc, "~A ~:D argument, ~S, is ~A but should be ~A"));
+
+  sc->sole_arg_wrong_type_info = semipermanent_list(sc, 5);
+  set_car(sc->sole_arg_wrong_type_info, s7_make_semipermanent_string(sc, "~A argument, ~S, is ~A but should be ~A"));
+
+  sc->out_of_range_info = semipermanent_list(sc, 5);
+  set_car(sc->out_of_range_info, s7_make_semipermanent_string(sc, "~A ~:D argument, ~S, is out of range (~A)"));
+
+  sc->sole_arg_out_of_range_info = semipermanent_list(sc, 4);
+  set_car(sc->sole_arg_out_of_range_info, s7_make_semipermanent_string(sc, "~A argument, ~S, is out of range (~A)"));
+
+  sc->gc_off = false;
+
+  #define defun(Scheme_Name, C_Name, Req, Opt, Rst) \
+    s7_define_typed_function(sc, Scheme_Name, g_ ## C_Name, Req, Opt, Rst, H_ ## C_Name, Q_ ## C_Name)
+
+  #define unsafe_defun(Scheme_Name, C_Name, Req, Opt, Rst) \
+    s7_define_unsafe_typed_function(sc, Scheme_Name, g_ ## C_Name, Req, Opt, Rst, H_ ## C_Name, Q_ ## C_Name)
+
+  #define semisafe_defun(Scheme_Name, C_Name, Req, Opt, Rst) \
+    s7_define_semisafe_typed_function(sc, Scheme_Name, g_ ## C_Name, Req, Opt, Rst, H_ ## C_Name, Q_ ## C_Name)
+
+  #define bool_defun(Scheme_Name, C_Name, Opt, SymId, Marker, Simple) \
+    define_bool_function(sc, Scheme_Name, g_ ## C_Name, Opt, H_ ## C_Name, Q_ ## C_Name, SymId, Marker, Simple, b_ ## C_Name ## _setter)
+
+  /* we need the sc->is_* symbols first for the procedure signature lists */
+  sc->is_boolean_symbol = make_symbol(sc, "boolean?", 8);
+  sc->pl_bt = s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->T);
+
+  sc->is_symbol_symbol =          bool_defun("symbol?",	         is_symbol,	     0, T_SYMBOL,       mark_symbol_vector, true);
+  sc->is_syntax_symbol =          bool_defun("syntax?",	         is_syntax,	     0, T_SYNTAX,       just_mark_vector,   true);
+  sc->is_gensym_symbol =          bool_defun("gensym?",	         is_gensym,	     0, T_FREE,         mark_symbol_vector, true);
+  sc->is_keyword_symbol =         bool_defun("keyword?",         is_keyword,	     0, T_FREE,         just_mark_vector,   true);
+  sc->is_let_symbol =             bool_defun("let?",	         is_let,	     0, T_LET,          mark_vector_1,      false);
+  sc->is_openlet_symbol =         bool_defun("openlet?",         is_openlet,	     0, T_FREE,         mark_vector_1,      false);
+  sc->is_iterator_symbol =        bool_defun("iterator?",        is_iterator,	     0, T_ITERATOR,     mark_vector_1,      false);
+  sc->is_macro_symbol =           bool_defun("macro?",	         is_macro,	     0, T_FREE,         mark_vector_1,      false);
+  sc->is_c_pointer_symbol =       bool_defun("c-pointer?",       is_c_pointer,	     1, T_C_POINTER,    mark_vector_1,      false);
+  sc->is_input_port_symbol =      bool_defun("input-port?",      is_input_port,	     0, T_INPUT_PORT,   mark_vector_1,      true);
+  sc->is_output_port_symbol =     bool_defun("output-port?",     is_output_port,     0, T_OUTPUT_PORT,  mark_simple_vector, true);
+  sc->is_eof_object_symbol =      bool_defun("eof-object?",      is_eof_object,	     0, T_EOF,          just_mark_vector,   true);
+  sc->is_integer_symbol =         bool_defun("integer?",         is_integer,	     0, (WITH_GMP) ? T_FREE : T_INTEGER, mark_simple_vector, true);
+  sc->is_byte_symbol =            bool_defun("byte?",	         is_byte,	     0, T_FREE,         mark_simple_vector, true);
+  sc->is_number_symbol =          bool_defun("number?",	         is_number,	     0, T_FREE,         mark_simple_vector, true);
+  sc->is_real_symbol =            bool_defun("real?",	         is_real,	     0, T_FREE,         mark_simple_vector, true);
+  sc->is_float_symbol =           bool_defun("float?",           is_float,           0, T_FREE,         mark_simple_vector, true);
+  sc->is_complex_symbol =         bool_defun("complex?",         is_complex,	     0, T_FREE,         mark_simple_vector, true);
+  sc->is_rational_symbol =        bool_defun("rational?",        is_rational,	     0, T_FREE,         mark_simple_vector, true);
+  sc->is_random_state_symbol =    bool_defun("random-state?",    is_random_state,    0, T_RANDOM_STATE, mark_simple_vector, true);
+  sc->is_char_symbol =            bool_defun("char?",	         is_char,	     0, T_CHARACTER,    just_mark_vector,   true);
+  sc->is_string_symbol =          bool_defun("string?",	         is_string,	     0, T_STRING,       mark_simple_vector, true);
+  sc->is_list_symbol =            bool_defun("list?",	         is_list,	     0, T_FREE,         mark_vector_1,      false);
+  sc->is_pair_symbol =            bool_defun("pair?",	         is_pair,	     0, T_PAIR,         mark_vector_1,      false);
+  sc->is_vector_symbol =          bool_defun("vector?",	         is_vector,	     0, T_FREE,         mark_vector_1,      false);
+  sc->is_float_vector_symbol =    bool_defun("float-vector?",    is_float_vector,    0, T_FLOAT_VECTOR, mark_simple_vector, true);
+  sc->is_int_vector_symbol =      bool_defun("int-vector?",      is_int_vector,	     0, T_INT_VECTOR,   mark_simple_vector, true);
+  sc->is_byte_vector_symbol =     bool_defun("byte-vector?",     is_byte_vector,     0, T_BYTE_VECTOR,  mark_simple_vector, true);
+  sc->is_hash_table_symbol =      bool_defun("hash-table?",      is_hash_table,      0, T_HASH_TABLE,   mark_vector_1,      false);
+  sc->is_continuation_symbol =    bool_defun("continuation?",    is_continuation,    0, T_CONTINUATION, mark_vector_1,      false);
+  sc->is_procedure_symbol =       bool_defun("procedure?",       is_procedure,	     0, T_FREE,         mark_vector_1,      false);
+  sc->is_dilambda_symbol =        bool_defun("dilambda?",        is_dilambda,	     0, T_FREE,         mark_vector_1,      false);
+  /* set above */                 bool_defun("boolean?",         is_boolean,	     0, T_BOOLEAN,      just_mark_vector,   true);
+  sc->is_proper_list_symbol =     bool_defun("proper-list?",     is_proper_list,     0, T_FREE,         mark_vector_1,      false);
+  sc->is_sequence_symbol =        bool_defun("sequence?",        is_sequence,	     0, T_FREE,         mark_vector_1,      false);
+  sc->is_null_symbol =            bool_defun("null?",	         is_null,	     0, T_NIL,          just_mark_vector,   true);
+  sc->is_undefined_symbol =       bool_defun("undefined?",       is_undefined,       0, T_UNDEFINED,    just_mark_vector,   true);
+  sc->is_unspecified_symbol =     bool_defun("unspecified?",     is_unspecified,     0, T_UNSPECIFIED,  just_mark_vector,   true);
+  sc->is_c_object_symbol =        bool_defun("c-object?",        is_c_object,	     0, T_C_OBJECT,     mark_vector_1,      false);
+  sc->is_subvector_symbol =       bool_defun("subvector?",       is_subvector,	     0, T_FREE,         mark_vector_1,      false);
+  sc->is_weak_hash_table_symbol = bool_defun("weak-hash-table?", is_weak_hash_table, 0, T_FREE,         mark_vector_1,      false);
+  sc->is_goto_symbol =            bool_defun("goto?",	         is_goto,            0, T_GOTO,         mark_vector_1,      true);
+
+  /* these are for signatures */
+  sc->not_symbol = defun("not",	not, 1, 0, false);
+  sc->is_integer_or_real_at_end_symbol = make_symbol(sc, "integer:real?", 13);
+  sc->is_integer_or_any_at_end_symbol =  make_symbol(sc, "integer:any?", 12);
+
+  sc->pl_p =   s7_make_signature(sc, 2, sc->T, sc->is_pair_symbol);
+  sc->pl_tl =  s7_make_signature(sc, 3,
+		  s7_make_signature(sc, 2, sc->is_pair_symbol, sc->not_symbol), sc->T, sc->is_list_symbol); /* memq and memv signature */
+  sc->pl_bc =  s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_char_symbol);
+  sc->pl_bn =  s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_number_symbol);
+  sc->pl_nn =  s7_make_signature(sc, 2, sc->is_number_symbol, sc->is_number_symbol);
+  sc->pl_sf =  s7_make_signature(sc, 3, sc->T, sc->is_string_symbol, s7_make_signature(sc, 2, sc->is_procedure_symbol, sc->is_macro_symbol));
+  sc->pcl_bt = s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->T);
+  sc->pcl_bc = s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_char_symbol);
+  sc->pcl_bs = s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_string_symbol);
+  sc->pcl_i =  s7_make_circular_signature(sc, 0, 1, sc->is_integer_symbol);
+  sc->pcl_r =  s7_make_circular_signature(sc, 0, 1, sc->is_real_symbol);
+  sc->pcl_f =  s7_make_circular_signature(sc, 0, 1, sc->is_rational_symbol);
+  sc->pcl_n =  s7_make_circular_signature(sc, 0, 1, sc->is_number_symbol);
+  sc->pcl_s =  s7_make_circular_signature(sc, 0, 1, sc->is_string_symbol);
+  sc->pcl_v =  s7_make_circular_signature(sc, 0, 1, sc->is_vector_symbol);
+  sc->pcl_c =  s7_make_circular_signature(sc, 0, 1, sc->is_char_symbol);
+  sc->pcl_e =  s7_make_circular_signature(sc, 0, 1,
+                  s7_make_signature(sc, 4, sc->is_let_symbol, sc->is_procedure_symbol, sc->is_macro_symbol, sc->is_c_object_symbol));
+
+  sc->values_symbol = make_symbol(sc, "values", 6);
+
+  sc->is_bignum_symbol =             defun("bignum?",           is_bignum,              1, 0, false);
+  sc->bignum_symbol =                defun("bignum",            bignum,                 1, 1, false);
+
+  sc->gensym_symbol =                defun("gensym",		gensym,			0, 1, false);
+  sc->symbol_table_symbol =          defun("symbol-table",	symbol_table,		0, 0, false);
+  sc->symbol_to_string_symbol =      defun("symbol->string",	symbol_to_string,	1, 0, false);
+  sc->string_to_symbol_symbol =      defun("string->symbol",	string_to_symbol,	1, 0, false);
+  sc->symbol_symbol =                defun("symbol",		symbol,			1, 0, true);
+  sc->symbol_to_value_symbol =       defun("symbol->value",	symbol_to_value,	1, 1, false);
+  sc->symbol_to_dynamic_value_symbol = defun("symbol->dynamic-value", symbol_to_dynamic_value, 1, 0, false);
+  sc->symbol_initial_value_symbol =  defun("symbol-initial-value", symbol_initial_value, 1, 0, false);
+  sc->immutable_symbol =             unsafe_defun("immutable!",	immutable,		1, 1, false); /* unsafe 11-Oct-23, added let arg 13-Oct-23 */
+  set_func_is_definer(sc->immutable_symbol);
+  sc->is_immutable_symbol =          defun("immutable?",	is_immutable,		1, 1, false); /* added optional let arg 13-Oct-23 */
+  sc->is_constant_symbol =           defun("constant?",	        is_constant,		1, 0, false);
+  sc->string_to_keyword_symbol =     defun("string->keyword",	string_to_keyword,      1, 0, false); /* keyword->string is symbol->string */
+  sc->symbol_to_keyword_symbol =     defun("symbol->keyword",	symbol_to_keyword,	1, 0, false);
+  sc->keyword_to_symbol_symbol =     defun("keyword->symbol",	keyword_to_symbol,	1, 0, false);
+
+  sc->outlet_symbol =                defun("outlet",	        outlet,		        1, 0, false);
+  sc->rootlet_symbol =               defun("rootlet",           rootlet,		0, 0, false);
+  sc->curlet_symbol =                unsafe_defun("curlet",     curlet,			0, 0, false); /* (define (f a) (curlet)) exports the funclet, see s7test 50215 */
+  set_func_is_definer(sc->curlet_symbol);
+  sc->unlet_symbol =                 defun("unlet",		unlet,			0, 0, false);
+  set_local_slot(sc->unlet_symbol, global_slot(sc->unlet_symbol)); /* for set_locals */
+  set_immutable(sc->unlet_symbol);
+  set_immutable_slot(global_slot(sc->unlet_symbol));
+  /* unlet (and with-let) don't actually need to be immutable, but s7.html says they are... */
+  sc->is_funclet_symbol =            defun("funclet?",          is_funclet,             1, 0, false);
+  sc->sublet_symbol =                defun("sublet",		sublet,			1, 0, true);
+  sc->varlet_symbol =                semisafe_defun("varlet",	varlet,			2, 0, true); /* was 1,0 13-Aug-22 */
+  set_func_is_definer(sc->varlet_symbol);
+  sc->cutlet_symbol =                semisafe_defun("cutlet",	cutlet,			2, 0, true); /* was 1,0 13-Aug-22 */
+  set_func_is_definer(sc->cutlet_symbol);
+  sc->inlet_symbol =                 defun("inlet",		inlet,			0, 0, true);
+  sc->owlet_symbol =                 defun("owlet",		owlet,			0, 0, false);
+  sc->coverlet_symbol =              defun("coverlet",		coverlet,		1, 0, false);
+  sc->openlet_symbol =               unsafe_defun("openlet",	openlet,		1, 0, false);
+  /* unsafe here because otherwise it can be optimized, whereupon our gc_protect_via_stack becomes unreliable:
+   *   we can't assume the current top-of-stack is the gc_protect in fx_c_aa (for example): if fn_proc hits an openlet method redirect to map or for-each,
+   *   the stack will have that operator awaiting the next spin through eval: (define (f) (write (vector 1.0) (openlet (inlet 'write for-each)))) (f)
+   *   the "f" function is needed to get the optimizer to call fx_c_aa.  This affects fx/opt cases throughout!
+   */
+  sc->let_ref_symbol =               defun("let-ref",		let_ref,		2, 0, false);
+  set_immutable(sc->let_ref_symbol);  /* 16-Sep-19 */
+  set_immutable_slot(global_slot(sc->let_ref_symbol));
+  sc->let_set_symbol =               defun("let-set!",		let_set,		3, 0, false);
+  set_immutable(sc->let_set_symbol);
+  set_immutable_slot(global_slot(sc->let_set_symbol));
+  sc->let_ref_fallback_symbol = make_symbol(sc, "let-ref-fallback", 16);
+  sc->let_set_fallback_symbol = make_symbol(sc, "let-set-fallback", 16); /* was let-set!-fallback until 9-Oct-17 */
+
+  sc->make_iterator_symbol =         defun("make-iterator",	make_iterator,		1, 1, false);
+  sc->iterate_symbol =               defun("iterate",		iterate,		1, 0, false);
+  sc->iterator_sequence_symbol =     defun("iterator-sequence", iterator_sequence,	1, 0, false);
+  sc->iterator_is_at_end_symbol =    defun("iterator-at-end?",  iterator_is_at_end,	1, 0, false);
+
+  sc->is_provided_symbol =           defun("provided?",	        is_provided,		1, 0, false);
+  sc->provide_symbol =               semisafe_defun("provide",	provide,		1, 0, false); /* can add *features* to curlet */
+  set_func_is_definer(sc->provide_symbol);
+  sc->is_defined_symbol =            defun("defined?",		is_defined,		1, 2, false);
+
+  sc->c_object_type_symbol =         defun("c-object-type",     c_object_type,		1, 0, false);
+  sc->c_pointer_symbol =             defun("c-pointer",	        c_pointer,		1, 4, false);
+  sc->c_pointer_info_symbol =        defun("c-pointer-info",    c_pointer_info,		1, 0, false);
+  sc->c_pointer_type_symbol =        defun("c-pointer-type",    c_pointer_type,		1, 0, false);
+  sc->c_pointer_weak1_symbol =       defun("c-pointer-weak1",   c_pointer_weak1,	1, 0, false);
+  sc->c_pointer_weak2_symbol =       defun("c-pointer-weak2",   c_pointer_weak2,	1, 0, false);
+  sc->c_pointer_to_list_symbol =     defun("c-pointer->list",   c_pointer_to_list,      1, 0, false);
+
+  sc->port_string_symbol =           defun("port-string",       port_string,		1, 0, false);
+  sc->port_file_symbol =             defun("port-file",	        port_file,		1, 0, false);
+  sc->port_position_symbol =         defun("port-position",	port_position,		1, 0, false);
+  sc->port_line_number_symbol =      defun("port-line-number",  port_line_number,	0, 1, false);
+  sc->port_filename_symbol =         defun("port-filename",	port_filename,		0, 1, false);
+  sc->pair_line_number_symbol =      defun("pair-line-number",  pair_line_number,	1, 0, false);
+  sc->pair_filename_symbol =         defun("pair-filename",     pair_filename,	        1, 0, false);
+  sc->is_port_closed_symbol =        defun("port-closed?",	is_port_closed,		1, 0, false);
+
+  sc->current_input_port_symbol =    defun("current-input-port",  current_input_port,  0, 0, false);
+  sc->current_output_port_symbol =   defun("current-output-port", current_output_port, 0, 0, false);
+  sc->current_error_port_symbol =    defun("current-error-port", current_error_port,    0, 0, false);
+  sc->set_current_error_port_symbol = defun("set-current-error-port", set_current_error_port, 1, 0, false);
+#if (!WITH_PURE_S7)
+  sc->let_to_list_symbol =           defun("let->list",	         let_to_list,		1, 0, false);
+  sc->set_current_input_port_symbol = defun("set-current-input-port", set_current_input_port, 1, 0, false);
+  sc->set_current_output_port_symbol = defun("set-current-output-port", set_current_output_port, 1, 0, false);
+  sc->is_char_ready_symbol =         defun("char-ready?",	is_char_ready,		0, 1, false); /* the least-used scheme function */
+#endif
+
+  sc->close_input_port_symbol =      defun("close-input-port",   close_input_port,	1, 0, false);
+  sc->close_output_port_symbol =     defun("close-output-port",  close_output_port,	1, 0, false);
+  sc->flush_output_port_symbol =     defun("flush-output-port",  flush_output_port,	0, 1, false);
+  sc->open_input_file_symbol =       defun("open-input-file",    open_input_file,	1, 1, false);
+  sc->open_output_file_symbol =      defun("open-output-file",   open_output_file,	1, 1, false);
+  sc->open_input_string_symbol =     defun("open-input-string",  open_input_string,	1, 0, false);
+  sc->open_output_string_symbol =    defun("open-output-string", open_output_string,	0, 0, false);
+  sc->get_output_string_symbol =     defun("get-output-string",  get_output_string,	1, 1, false);
+  sc->get_output_string_uncopied =   s7_make_safe_function(sc, "get-output-string", g_get_output_string_uncopied, 1, 1, false, NULL);
+  sc->open_input_function_symbol =   defun("open-input-function",open_input_function,	1, 0, false);
+  sc->open_output_function_symbol =  defun("open-output-function",open_output_function,	1, 0, false);
+
+  sc->closed_input_function = s7_make_safe_function(sc, "closed-input-function", g_closed_input_function_port, 2, 0, false, "input-function error"),
+  sc->closed_output_function = s7_make_safe_function(sc, "closed-output-function", g_closed_output_function_port, 1, 0, false, "output-function error"),
+
+  sc->newline_symbol =               defun("newline",		newline,		0, 1, false);
+  sc->write_symbol =                 defun("write",		write,			1, 1, false);
+  sc->display_symbol =               defun("display",		display,		1, 1, false);
+  sc->read_char_symbol =             defun("read-char",	        read_char,		0, 1, false);
+  sc->peek_char_symbol =             defun("peek-char",	        peek_char,		0, 1, false);
+  sc->write_char_symbol =            defun("write-char",	write_char,		1, 1, false);
+  sc->write_string_symbol =          defun("write-string",	write_string,		1, 3, false);
+  sc->read_byte_symbol =             defun("read-byte",	        read_byte,		0, 1, false);
+  sc->write_byte_symbol =            defun("write-byte",	write_byte,		1, 1, false);
+  sc->read_line_symbol =             defun("read-line",	        read_line,		0, 2, false);
+  sc->read_string_symbol =           defun("read-string",	read_string,		1, 1, false);
+  sc->read_symbol =                  semisafe_defun("read",	read,			0, 1, false);
+  /* read can't be safe because it messes with the stack, expecting to be all by itself in the call sequence
+   *   (not embedded in OP_SAFE_C_opSq for example) -- that is, it pushes OP_READ_INTERNAL, then returns
+   *   expecting continue (goto top-of-eval-loop), which would be nonsense if arg=fn|x_proc(read) -> fn|x_proc(arg).
+   *   a safe procedure leaves its argument list alone, does not push anything on the stack,
+   *   and leaves sc->code|args unscathed (fx_call assumes that is the case).  The stack part can
+   *   be hidden: if a c_function calls s7_apply_function (lambda passed as arg as in some clm gens)
+   *   then is called with args that use fx*, and the lambda func does the same, the two calls
+   *   can step on each other.
+   */
+
+  sc->call_with_input_string_symbol = semisafe_defun("call-with-input-string", call_with_input_string, 2, 0, false); /* body unsafe if func=read */
+  sc->call_with_input_file_symbol =   semisafe_defun("call-with-input-file",   call_with_input_file,   2, 0, false);
+  sc->with_input_from_string_symbol = semisafe_defun("with-input-from-string", with_input_from_string, 2, 0, false);
+  sc->with_input_from_file_symbol =   semisafe_defun("with-input-from-file",   with_input_from_file,   2, 0, false);
+
+  sc->call_with_output_string_symbol = semisafe_defun("call-with-output-string", call_with_output_string, 1, 0, false);
+  sc->call_with_output_file_symbol =   semisafe_defun("call-with-output-file",   call_with_output_file,   2, 0, false);
+  sc->with_output_to_string_symbol =   semisafe_defun("with-output-to-string",   with_output_to_string,   1, 0, false);
+  sc->with_output_to_file_symbol =     semisafe_defun("with-output-to-file",     with_output_to_file,     2, 0, false);
+
+#if WITH_SYSTEM_EXTRAS
+  sc->is_directory_symbol =          defun("directory?",	is_directory,		1, 0, false);
+  sc->file_exists_symbol =           defun("file-exists?",	file_exists,		1, 0, false);
+  sc->delete_file_symbol =           defun("delete-file",	delete_file,		1, 0, false);
+  sc->getenv_symbol =                defun("getenv",		getenv,			1, 0, false);
+  sc->system_symbol =                defun("system",		system,			1, 1, false);
+  sc->directory_to_list_symbol =     defun("directory->list",   directory_to_list,	1, 0, false);
+#if (!MS_WINDOWS)
+  sc->file_mtime_symbol =            defun("file-mtime",	file_mtime,		1, 0, false);
+#endif
+#endif
+
+  sc->real_part_symbol =             defun("real-part",	        real_part,		1, 0, false);
+  sc->imag_part_symbol =             defun("imag-part",	        imag_part,		1, 0, false);
+  sc->numerator_symbol =             defun("numerator",	        numerator,		1, 0, false);
+  sc->denominator_symbol =           defun("denominator",	denominator,		1, 0, false);
+  sc->is_even_symbol =               defun("even?",		is_even,		1, 0, false);
+  sc->is_odd_symbol =                defun("odd?",		is_odd,			1, 0, false);
+  sc->is_zero_symbol =               defun("zero?",		is_zero,		1, 0, false);
+  sc->is_positive_symbol =           defun("positive?",	        is_positive,		1, 0, false);
+  sc->is_negative_symbol =           defun("negative?",	        is_negative,		1, 0, false);
+  sc->is_infinite_symbol =           defun("infinite?",	        is_infinite,		1, 0, false);
+  sc->is_nan_symbol =                defun("nan?",		is_nan,			1, 0, false);
+  sc->complex_symbol =               defun("complex",	        complex,	        2, 0, false);
+
+  sc->add_symbol =                   defun("+",		        add,			0, 0, true); set_all_integer_and_float(sc->add_symbol);
+  sc->subtract_symbol =              defun("-",		        subtract,		1, 0, true); set_all_integer_and_float(sc->subtract_symbol);
+  sc->multiply_symbol =              defun("*",		        multiply,		0, 0, true); set_all_integer_and_float(sc->multiply_symbol);
+  sc->divide_symbol =                defun("/",		        divide,			1, 0, true); set_all_float(sc->divide_symbol);
+  sc->min_symbol =                   defun("min",		min,			1, 0, true); set_all_integer_and_float(sc->min_symbol);
+  sc->max_symbol =                   defun("max",		max,			1, 0, true); set_all_integer_and_float(sc->max_symbol);
+
+  sc->quotient_symbol =              defun("quotient",		quotient,		2, 0, false); set_all_integer(sc->quotient_symbol);
+  sc->remainder_symbol =             defun("remainder",	        remainder,		2, 0, false); set_all_integer(sc->remainder_symbol);
+  sc->modulo_symbol =                defun("modulo",		modulo,			2, 0, false); set_all_integer(sc->modulo_symbol);
+  sc->num_eq_symbol =                defun("=",		        num_eq,			2, 0, true);
+  sc->lt_symbol =                    defun("<",		        less,			2, 0, true);
+  sc->gt_symbol =                    defun(">",		        greater,		2, 0, true);
+  sc->leq_symbol =                   defun("<=",		less_or_equal,		2, 0, true);
+  sc->geq_symbol =                   defun(">=",		greater_or_equal,	2, 0, true);
+  sc->gcd_symbol =                   defun("gcd",		gcd,			0, 0, true);
+  sc->lcm_symbol =                   defun("lcm",		lcm,			0, 0, true);
+  sc->rationalize_symbol =           defun("rationalize",	rationalize,		1, 1, false);
+  sc->random_symbol =                defun("random",		random,			1, 1, false); set_all_integer_and_float(sc->random_symbol);
+  sc->random_state_symbol =          defun("random-state",      random_state,	        0, (WITH_GMP) ? 1 : 2, false);
+  sc->expt_symbol =                  defun("expt",		expt,			2, 0, false);
+  sc->log_symbol =                   defun("log",		log,			1, 1, false);
+  sc->ash_symbol =                   defun("ash",		ash,			2, 0, false);
+  sc->exp_symbol =                   defun("exp",		exp,			1, 0, false); set_all_float(sc->exp_symbol);
+  sc->abs_symbol =                   defun("abs",		abs,			1, 0, false); set_all_integer_and_float(sc->abs_symbol);
+  sc->magnitude_symbol =             defun("magnitude",	        magnitude,		1, 0, false); set_all_integer_and_float(sc->magnitude_symbol);
+  sc->angle_symbol =                 defun("angle",		angle,			1, 0, false);
+  sc->sin_symbol =                   defun("sin",		sin,			1, 0, false); set_all_float(sc->sin_symbol);
+  sc->cos_symbol =                   defun("cos",		cos,			1, 0, false); set_all_float(sc->cos_symbol);
+  sc->tan_symbol =                   defun("tan",		tan,			1, 0, false); set_all_float(sc->tan_symbol);
+  sc->sinh_symbol =                  defun("sinh",		sinh,			1, 0, false); set_all_float(sc->sinh_symbol);
+  sc->cosh_symbol =                  defun("cosh",		cosh,			1, 0, false); set_all_float(sc->cosh_symbol);
+  sc->tanh_symbol =                  defun("tanh",		tanh,			1, 0, false); set_all_float(sc->tanh_symbol);
+  sc->asin_symbol =                  defun("asin",		asin,			1, 0, false);
+  sc->acos_symbol =                  defun("acos",		acos,			1, 0, false);
+  sc->atan_symbol =                  defun("atan",		atan,			1, 1, false);
+  sc->asinh_symbol =                 defun("asinh",		asinh,			1, 0, false);
+  sc->acosh_symbol =                 defun("acosh",		acosh,			1, 0, false);
+  sc->atanh_symbol =                 defun("atanh",		atanh,			1, 0, false);
+  sc->sqrt_symbol =                  defun("sqrt",		sqrt,			1, 0, false);
+  sc->floor_symbol =                 defun("floor",		floor,			1, 0, false);
+  sc->ceiling_symbol =               defun("ceiling",		ceiling,		1, 0, false);
+  sc->truncate_symbol =              defun("truncate",		truncate,		1, 0, false);
+  sc->round_symbol =                 defun("round",		round,			1, 0, false);
+  sc->logand_symbol =                defun("logand",		logand,			0, 0, true);
+  sc->logior_symbol =                defun("logior",		logior,			0, 0, true);
+  sc->logxor_symbol =                defun("logxor",		logxor,			0, 0, true);
+  sc->lognot_symbol =                defun("lognot",		lognot,			1, 0, false);
+  sc->logbit_symbol =                defun("logbit?",		logbit,			2, 0, false);
+  sc->integer_decode_float_symbol =  defun("integer-decode-float", integer_decode_float, 1, 0, false);
+  sc->nan_symbol =                   defun("nan",               nan,                    0, 1, false); /* (nan) -> +nan.0, (nan 123) -> +nan.123 */
+  sc->nan_payload_symbol =           defun("nan-payload",       nan_payload,            1, 0, false);
+
+#if (!WITH_PURE_S7)
+  sc->integer_length_symbol =        defun("integer-length",	integer_length,		1, 0, false);
+  sc->inexact_to_exact_symbol =      defun("inexact->exact",	inexact_to_exact,	1, 0, false);
+  sc->exact_to_inexact_symbol =      defun("exact->inexact",	exact_to_inexact,	1, 0, false);
+  sc->is_exact_symbol =              defun("exact?",		is_exact,		1, 0, false);
+  sc->is_inexact_symbol =            defun("inexact?",		is_inexact,		1, 0, false);
+#endif
+  sc->random_state_to_list_symbol =  defun("random-state->list", random_state_to_list,  0, 1, false);
+  sc->number_to_string_symbol =      defun("number->string",	number_to_string,	1, 1, false);
+  sc->string_to_number_symbol =      defun("string->number",	string_to_number,	1, 1, false);
+
+  sc->char_upcase_symbol =           defun("char-upcase",	char_upcase,		1, 0, false);
+  sc->char_downcase_symbol =         defun("char-downcase",	char_downcase,		1, 0, false);
+  sc->char_to_integer_symbol =       defun("char->integer",	char_to_integer,	1, 0, false);
+  sc->integer_to_char_symbol =       defun("integer->char",	integer_to_char,	1, 0, false);
+
+  sc->is_char_upper_case_symbol =    defun("char-upper-case?",  is_char_upper_case,	1, 0, false);
+  sc->is_char_lower_case_symbol =    defun("char-lower-case?",  is_char_lower_case,	1, 0, false);
+  sc->is_char_alphabetic_symbol =    defun("char-alphabetic?",  is_char_alphabetic,	1, 0, false);
+  sc->is_char_numeric_symbol =       defun("char-numeric?",	is_char_numeric,	1, 0, false);
+  sc->is_char_whitespace_symbol =    defun("char-whitespace?",  is_char_whitespace,	1, 0, false);
+
+  sc->char_eq_symbol =               defun("char=?",		chars_are_equal,	2, 0, true);
+  sc->char_lt_symbol =               defun("char<?",		chars_are_less,		2, 0, true);
+  sc->char_gt_symbol =               defun("char>?",		chars_are_greater,	2, 0, true);
+  sc->char_leq_symbol =              defun("char<=?",		chars_are_leq,		2, 0, true);
+  sc->char_geq_symbol =              defun("char>=?",		chars_are_geq,		2, 0, true);
+  sc->char_position_symbol =         defun("char-position",	char_position,		2, 1, false);
+  sc->string_position_symbol =       defun("string-position",	string_position,	2, 1, false);
+
+  sc->make_string_symbol =           defun("make-string",	make_string,		1, 1, false);
+  sc->string_ref_symbol =            defun("string-ref",	string_ref,		2, 0, false);
+  sc->string_set_symbol =            defun("string-set!",	string_set,		3, 0, false);
+
+  sc->string_eq_symbol =             defun("string=?",		strings_are_equal,	2, 0, true);
+  sc->string_lt_symbol =             defun("string<?",		strings_are_less,	2, 0, true);
+  sc->string_gt_symbol =             defun("string>?",		strings_are_greater,	2, 0, true);
+  sc->string_leq_symbol =            defun("string<=?",	        strings_are_leq,	2, 0, true);
+  sc->string_geq_symbol =            defun("string>=?",	        strings_are_geq,	2, 0, true);
+
+#if (!WITH_PURE_S7)
+  sc->char_ci_eq_symbol =            defun("char-ci=?",	        chars_are_ci_equal,	2, 0, true);
+  sc->char_ci_lt_symbol =            defun("char-ci<?",	        chars_are_ci_less,	2, 0, true);
+  sc->char_ci_gt_symbol =            defun("char-ci>?",	        chars_are_ci_greater,	2, 0, true);
+  sc->char_ci_leq_symbol =           defun("char-ci<=?",	chars_are_ci_leq,	2, 0, true);
+  sc->char_ci_geq_symbol =           defun("char-ci>=?",	chars_are_ci_geq,	2, 0, true);
+  sc->string_ci_eq_symbol =          defun("string-ci=?",	strings_are_ci_equal,	2, 0, true);
+  sc->string_ci_lt_symbol =          defun("string-ci<?",	strings_are_ci_less,	2, 0, true);
+  sc->string_ci_gt_symbol =          defun("string-ci>?",	strings_are_ci_greater, 2, 0, true);
+  sc->string_ci_leq_symbol =         defun("string-ci<=?",	strings_are_ci_leq,	2, 0, true);
+  sc->string_ci_geq_symbol =         defun("string-ci>=?",	strings_are_ci_geq,	2, 0, true);
+  sc->string_fill_symbol =           defun("string-fill!",	string_fill,		2, 2, false);
+  sc->list_to_string_symbol =        defun("list->string",	list_to_string,		1, 0, false);
+  sc->string_length_symbol =         defun("string-length",	string_length,		1, 0, false);
+  sc->string_to_list_symbol =        defun("string->list",	string_to_list,		1, 2, false);
+#endif
+  sc->string_copy_symbol =           defun("string-copy",	string_copy,		1, 3, false);
+
+  sc->string_downcase_symbol =       defun("string-downcase",	string_downcase,	1, 0, false);
+  sc->string_upcase_symbol =         defun("string-upcase",	string_upcase,		1, 0, false);
+  sc->string_append_symbol =         defun("string-append",	string_append,		0, 0, true);
+  sc->substring_symbol =             defun("substring",	        substring,		1, 2, false);
+  sc->substring_uncopied_symbol =    defun("substring-uncopied",substring_uncopied,	1, 2, false);
+  sc->string_symbol =                defun("string",		string,			0, 0, true);
+  sc->object_to_string_symbol =      defun("object->string",	object_to_string,	1, 2, false);
+  sc->format_symbol =                defun("format",		format,			2, 0, true);
+  sc->object_to_let_symbol =         defun("object->let",	object_to_let,	        1, 0, false);
+
+  sc->cons_symbol =                  defun("cons",		cons,			2, 0, false);
+  sc->car_symbol =                   defun("car",		car,			1, 0, false);
+  sc->cdr_symbol =                   defun("cdr",		cdr,			1, 0, false);
+  sc->set_car_symbol =               defun("set-car!",		set_car,		2, 0, false);
+  sc->set_cdr_symbol =               defun("set-cdr!",	        set_cdr,		2, 0, false);
+  sc->caar_symbol =                  defun("caar",		caar,			1, 0, false);
+  sc->cadr_symbol =                  defun("cadr",		cadr,			1, 0, false);
+  sc->cdar_symbol =                  defun("cdar",		cdar,			1, 0, false);
+  sc->cddr_symbol =                  defun("cddr",		cddr,			1, 0, false);
+  sc->caaar_symbol =                 defun("caaar",		caaar,			1, 0, false);
+  sc->caadr_symbol =                 defun("caadr",		caadr,			1, 0, false);
+  sc->cadar_symbol =                 defun("cadar",		cadar,			1, 0, false);
+  sc->cdaar_symbol =                 defun("cdaar",		cdaar,			1, 0, false);
+  sc->caddr_symbol =                 defun("caddr",		caddr,			1, 0, false);
+  sc->cdddr_symbol =                 defun("cdddr",		cdddr,			1, 0, false);
+  sc->cdadr_symbol =                 defun("cdadr",		cdadr,			1, 0, false);
+  sc->cddar_symbol =                 defun("cddar",		cddar,			1, 0, false);
+  sc->caaaar_symbol =                defun("caaaar",		caaaar,			1, 0, false);
+  sc->caaadr_symbol =                defun("caaadr",		caaadr,			1, 0, false);
+  sc->caadar_symbol =                defun("caadar",		caadar,			1, 0, false);
+  sc->cadaar_symbol =                defun("cadaar",		cadaar,			1, 0, false);
+  sc->caaddr_symbol =                defun("caaddr",		caaddr,			1, 0, false);
+  sc->cadddr_symbol =                defun("cadddr",		cadddr,			1, 0, false);
+  sc->cadadr_symbol =                defun("cadadr",		cadadr,			1, 0, false);
+  sc->caddar_symbol =                defun("caddar",		caddar,			1, 0, false);
+  sc->cdaaar_symbol =                defun("cdaaar",		cdaaar,			1, 0, false);
+  sc->cdaadr_symbol =                defun("cdaadr",		cdaadr,			1, 0, false);
+  sc->cdadar_symbol =                defun("cdadar",		cdadar,			1, 0, false);
+  sc->cddaar_symbol =                defun("cddaar",		cddaar,			1, 0, false);
+  sc->cdaddr_symbol =                defun("cdaddr",		cdaddr,			1, 0, false);
+  sc->cddddr_symbol =                defun("cddddr",		cddddr,			1, 0, false);
+  sc->cddadr_symbol =                defun("cddadr",		cddadr,			1, 0, false);
+  sc->cdddar_symbol =                defun("cdddar",		cdddar,			1, 0, false);
+
+  sc->assq_symbol =                  defun("assq",		assq,			2, 0, false);
+  sc->assv_symbol =                  defun("assv",		assv,			2, 0, false);
+  sc->assoc_symbol =                 semisafe_defun("assoc",	assoc,			2, 1, false);
+  sc->memq_symbol =                  defun("memq",		memq,			2, 0, false);
+  sc->memv_symbol =                  defun("memv",		memv,			2, 0, false);
+  sc->member_symbol =                semisafe_defun("member",	member,			2, 1, false);
+
+  sc->list_symbol =                  defun("list",		list,			0, 0, true);
+  sc->list_ref_symbol =              defun("list-ref",		list_ref,		2, 0, true);
+  sc->list_set_symbol =              defun("list-set!",	        list_set,		3, 0, true);
+  sc->list_tail_symbol =             defun("list-tail",	        list_tail,		2, 0, false);
+  sc->make_list_symbol =             defun("make-list",  	make_list,		1, 1, false);
+
+  sc->length_symbol =                defun("length",		length,			1, 0, false);
+  sc->copy_symbol =                  defun("copy",		copy,			1, 3, false);
+  /* set_is_definer(sc->copy_symbol); */ /* (copy (inlet 'a 1) (curlet)), but this check needs to be smarter */
+  sc->fill_symbol =                  defun("fill!",		fill,			2, 2, false);
+  sc->reverse_symbol =               defun("reverse",		reverse,		1, 0, false);
+  sc->reverseb_symbol =              defun("reverse!",		reverse_in_place,	1, 0, false);
+  sc->sort_symbol =                  unsafe_defun("sort!",      sort, 	                2, 0, false); /* not semisafe! */
+  sc->append_symbol =                defun("append",		append,			0, 0, true);
+
+#if (!WITH_PURE_S7)
+  sc->vector_append_symbol =         defun("vector-append",	vector_append,		0, 0, true);
+  sc->list_to_vector_symbol =        defun("list->vector",	list_to_vector,		1, 0, false);
+  sc->vector_fill_symbol =           defun("vector-fill!",	vector_fill,		2, 2, false);
+  sc->vector_length_symbol =         defun("vector-length",	vector_length,		1, 0, false);
+  sc->vector_to_list_symbol =        defun("vector->list",	vector_to_list,		1, 2, false);
+#else
+  sc->vector_append_symbol = sc->append_symbol;
+  sc->vector_fill_symbol = sc->fill_symbol;
+  sc->string_fill_symbol = sc->fill_symbol;
+#endif
+  sc->vector_ref_symbol =            defun("vector-ref",	vector_ref,		2, 0, true);
+  sc->vector_set_symbol =            defun("vector-set!",	vector_set,		3, 0, true);
+  sc->vector_dimension_symbol =      defun("vector-dimension",  vector_dimension,	2, 0, false);
+  sc->vector_dimensions_symbol =     defun("vector-dimensions", vector_dimensions,	1, 0, false);
+  sc->vector_rank_symbol =           defun("vector-rank",       vector_rank,	        1, 0, false);
+  sc->make_vector_symbol =           defun("make-vector",	make_vector,		1, 2, false);
+  sc->vector_symbol =                defun("vector",		vector,			0, 0, true);
+  set_is_setter(sc->vector_symbol); /* like cons, I guess */
+  sc->vector_typer_symbol =          defun("vector-typer",      vector_typer,	        1, 0, false);
+
+  sc->subvector_symbol =             defun("subvector",         subvector,	        1, 3, false);
+  sc->subvector_position_symbol =    defun("subvector-position", subvector_position,    1, 0, false);
+  sc->subvector_vector_symbol =      defun("subvector-vector",  subvector_vector,       1, 0, false);
+
+  sc->float_vector_symbol =          defun("float-vector",	float_vector,		0, 0, true);
+  sc->make_float_vector_symbol =     defun("make-float-vector", make_float_vector,	1, 1, false);
+  sc->float_vector_set_symbol =      defun("float-vector-set!", float_vector_set,	3, 0, true);
+  sc->float_vector_ref_symbol =      defun("float-vector-ref",  float_vector_ref,	2, 0, true);
+
+  sc->int_vector_symbol =            defun("int-vector",	int_vector,		0, 0, true);
+  sc->make_int_vector_symbol =       defun("make-int-vector",	make_int_vector,	1, 1, false);
+  sc->int_vector_set_symbol =        defun("int-vector-set!",	int_vector_set,		3, 0, true);
+  sc->int_vector_ref_symbol =        defun("int-vector-ref",	int_vector_ref,		2, 0, true);
+
+  sc->byte_vector_symbol =           defun("byte-vector",	byte_vector,		0, 0, true);
+  sc->make_byte_vector_symbol =      defun("make-byte-vector",  make_byte_vector,	1, 1, false);
+  sc->byte_vector_ref_symbol =       defun("byte-vector-ref",	byte_vector_ref,        2, 0, true);
+  sc->byte_vector_set_symbol =       defun("byte-vector-set!",	byte_vector_set,	3, 0, true);
+  sc->string_to_byte_vector_symbol = defun("string->byte-vector", string_to_byte_vector, 1, 0, false);
+  sc->byte_vector_to_string_symbol = defun("byte-vector->string", byte_vector_to_string, 1, 0, false);
+
+  sc->hash_table_symbol =            defun("hash-table",	hash_table,		0, 0, true);
+  sc->make_hash_table_symbol =       defun("make-hash-table",	make_hash_table,	0, 3, false);
+  sc->make_weak_hash_table_symbol =  defun("make-weak-hash-table", make_weak_hash_table,0, 3, false);
+  sc->weak_hash_table_symbol =       defun("weak-hash-table",   weak_hash_table,        0, 0, true);
+  sc->hash_table_ref_symbol =        defun("hash-table-ref",	hash_table_ref,		2, 0, true);
+  sc->hash_table_set_symbol =        defun("hash-table-set!",	hash_table_set,		3, 0, false);
+  sc->hash_table_entries_symbol =    defun("hash-table-entries", hash_table_entries,	1, 0, false);
+  sc->hash_code_symbol =             defun("hash-code",         hash_code,              1, 1, false);
+  sc->dummy_equal_hash_table = make_dummy_hash_table(sc);
+  sc->hash_table_key_typer_symbol =  defun("hash-table-key-typer", hash_table_key_typer, 1, 0, false);
+  sc->hash_table_value_typer_symbol = defun("hash-table-value-typer", hash_table_value_typer, 1, 0, false);
+
+  sc->cyclic_sequences_symbol =      defun("cyclic-sequences",  cyclic_sequences,	1, 0, false);
+  sc->call_cc_symbol =               semisafe_defun("call/cc",	call_cc,		1, 0, false);
+  sc->call_with_current_continuation_symbol = semisafe_defun("call-with-current-continuation", call_cc, 1, 0, false);
+  sc->call_with_exit_symbol =        semisafe_defun("call-with-exit", call_with_exit,     1, 0, false);
+
+  sc->load_symbol =                  semisafe_defun("load",	load,			1, 1, false);
+  sc->autoload_symbol =              defun("autoload",	        autoload,		2, 0, false);
+  sc->eval_symbol =                  semisafe_defun("eval",	eval,			1, 1, false);
+  set_func_is_definer(sc->eval_symbol);
+  sc->eval_string_symbol =           semisafe_defun("eval-string", eval_string,		1, 1, false);
+  set_func_is_definer(sc->eval_string_symbol);
+  sc->apply_symbol =                 unsafe_defun("apply",    apply,			1, 0, true); /* not semisafe */
+  set_func_is_definer(sc->apply_symbol);
+  /* yow... (apply (inlet) (f)) in do body where (f) returns '(define...) -- see s7test.scm under apply
+   *   perhaps better: if closure returns a definer in some way set its name as a definer? even this is not fool-proof
+   */
+
+  sc->for_each_symbol =              semisafe_defun("for-each",	for_each,		2, 0, true);
+  sc->map_symbol =                   semisafe_defun("map",	map,			2, 0, true);
+  sc->dynamic_wind_symbol =          semisafe_defun("dynamic-wind", dynamic_wind,       3, 0, false);
+  sc->dynamic_unwind_symbol =        semisafe_defun("dynamic-unwind", dynamic_unwind,   2, 0, false);
+  sc->catch_symbol =                 semisafe_defun("catch",	catch,			3, 0, false);
+  sc->throw_symbol =                 unsafe_defun("throw",	throw,			1, 0, true);
+  sc->error_symbol =                 unsafe_defun("error",	error,			1, 0, true); /* was 0,0 -- 1-Aug-22 */
+  /* unsafe example: catch if macro as error handler, (define-macro (m . args) `(apply ,(car args) ',(cadr args))) (catch #t (lambda () (error abs -1)) m) */
+  sc->stacktrace_symbol =            defun("stacktrace",	stacktrace,		0, 5, false);
+
+  /* sc->values_symbol = */          unsafe_defun("values",	values,			0, 0, true); /* values_symbol set above for signatures, not semisafe! */
+  /* set_immutable(c_function_setter(global_value(sc->values_symbol))); */ /* not needed, I think */
+
+  /* quasiquote helper funcs */
+#if WITH_IMMUTABLE_UNQUOTE
+  sc->unquote_symbol =               make_symbol(sc, "<unquote>", 9);
+  set_immutable(sc->unquote_symbol);
+#else
+  sc->unquote_symbol =               make_symbol(sc, "unquote", 7);
+#endif
+  sc->qq_append_symbol =             defun("<list*>",           qq_append,		2, 0, false); /* occurs via quasiquote only as #_<list*> */
+#if (!DISABLE_DEPRECATED)
+  defun("[list*]", qq_append, 2, 0, false);
+#endif
+  sc->apply_values_symbol =          unsafe_defun("apply-values", apply_values,         0, 1, false);
+  sc->list_values_symbol =           defun("list-values",       list_values,            0, 0, true);
+
+  sc->documentation_symbol =         defun("documentation",     documentation,          1, 0, false);
+  sc->signature_symbol =             defun("signature",         signature,	        1, 0, false);
+  sc->help_symbol =                  defun("help",		help,			1, 0, false);
+  sc->procedure_source_symbol =      defun("procedure-source",  procedure_source,	1, 0, false);
+  sc->procedure_arglist_symbol =     defun("procedure-arglist", procedure_arglist,      1, 0, false);
+  sc->funclet_symbol =               defun("funclet",		funclet,		1, 0, false);
+  sc->_function__symbol =            defun("*function*",        function,	        0, 2, false);
+  sc->dilambda_symbol =              defun("dilambda",          dilambda,               2, 0, false);
+  {
+    s7_pointer get_func;
+    get_func = s7_typed_dilambda(sc, "setter", g_setter, 1, 1, g_set_setter, 2, 1, H_setter, Q_setter, NULL);
+    set_immutable(c_function_setter(get_func));
+  }
+  sc->arity_symbol =                 defun("arity",		arity,			1, 0, false);
+  sc->is_aritable_symbol =           defun("aritable?",	        is_aritable,		2, 0, false);
+
+  sc->is_eq_symbol =                 defun("eq?",		is_eq,			2, 0, false);
+  sc->is_eqv_symbol =                defun("eqv?",		is_eqv,			2, 0, false);
+  sc->is_equal_symbol =              defun("equal?",		is_equal,		2, 0, false);
+  sc->is_equivalent_symbol =         defun("equivalent?",	is_equivalent,	2, 0, false);
+  sc->type_of_symbol =               defun("type-of",		type_of,		1, 0, false);
+
+  sc->gc_symbol =                    semisafe_defun("gc",	gc,			0, 1, false);
+                                     defun("emergency-exit",	emergency_exit,		0, 1, false);
+  sc->exit_symbol =                  defun("exit",		exit,			0, 1, false);
+
+#if WITH_GCC
+  s7_define_function(sc, "abort", g_abort, 0, 0, false, "drop into gdb I hope");
+#endif
+#if S7_DEBUGGING
+  defun("heap-scan", heap_scan, 1, 0, false);
+  defun("heap-analyze", heap_analyze, 0, 0, false);
+  defun("heap-holder", heap_holder, 1, 0, false);
+  defun("heap-holders", heap_holders, 1, 0, false);
+
+  defun("show-stack", show_stack, 0, 1, false);
+  defun("show-op-stack", show_op_stack, 0, 0, false);
+  defun("op-stack?", is_op_stack, 0, 0, false);
+#endif
+  s7_define_function(sc, "s7-optimize", g_optimize, 1, 0, false, "short-term debugging aid");
+  sc->c_object_set_function = s7_make_safe_function(sc, "#<c-object-setter>", g_c_object_set, 1, 0, true, "c-object setter");
+  /* c_function_signature(sc->c_object_set_function) = s7_make_circular_signature(sc, 2, 3, sc->T, sc->is_c_object_symbol, sc->T); */
+
+  set_scope_safe(global_value(sc->call_with_input_string_symbol));
+  set_scope_safe(global_value(sc->call_with_input_file_symbol));
+  set_scope_safe(global_value(sc->call_with_output_string_symbol));
+  set_scope_safe(global_value(sc->call_with_output_file_symbol));
+  set_scope_safe(global_value(sc->with_input_from_string_symbol));
+  set_scope_safe(global_value(sc->with_input_from_file_symbol));
+  set_scope_safe(global_value(sc->with_output_to_string_symbol));
+  set_scope_safe(global_value(sc->with_output_to_file_symbol));
+  set_maybe_safe(global_value(sc->assoc_symbol));
+  set_scope_safe(global_value(sc->assoc_symbol));
+  set_maybe_safe(global_value(sc->member_symbol));
+  set_scope_safe(global_value(sc->member_symbol));
+  set_scope_safe(global_value(sc->sort_symbol));
+  set_scope_safe(global_value(sc->call_with_exit_symbol));
+  set_scope_safe(global_value(sc->for_each_symbol));
+  set_maybe_safe(global_value(sc->for_each_symbol));
+  set_scope_safe(global_value(sc->map_symbol));
+  set_maybe_safe(global_value(sc->map_symbol));
+  set_scope_safe(global_value(sc->dynamic_wind_symbol));
+  set_scope_safe(global_value(sc->catch_symbol));
+  set_scope_safe(global_value(sc->throw_symbol));
+  set_scope_safe(global_value(sc->error_symbol));
+  set_scope_safe(global_value(sc->apply_values_symbol));
+
+  sc->tree_leaves_symbol =    defun("tree-leaves",   tree_leaves,    1, 0, false);
+  sc->tree_memq_symbol =      defun("tree-memq",     tree_memq,      2, 0, false);
+  sc->tree_set_memq_symbol =  defun("tree-set-memq", tree_set_memq,  2, 0, false);
+  sc->tree_count_symbol =     defun("tree-count",    tree_count,     2, 1, false);
+  sc->tree_is_cyclic_symbol = defun("tree-cyclic?",  tree_is_cyclic, 1, 0, false);
+
+  sc->quasiquote_symbol = s7_define_macro(sc, "quasiquote", g_quasiquote, 1, 0, false, H_quasiquote); /* is this considered syntax? r7rs says yes; also unquote */
+  sc->quasiquote_function = initial_value(sc->quasiquote_symbol);
+  sc->profile_in_symbol = unsafe_defun("profile-in", profile_in, 2, 0, false); /* calls dynamic-unwind */
+  sc->profile_out = NULL;
+
+  /* -------- *features* -------- */
+  sc->features_symbol = s7_define_variable_with_documentation(sc, "*features*", sc->nil, "list of currently available features ('complex-numbers, etc)");
+  s7_set_setter(sc, sc->features_symbol, sc->features_setter = s7_make_safe_function(sc, "#<set-*features*>", g_features_set, 2, 0, false, "*features* setter"));
+
+  /* -------- *load-path* -------- */
+  sc->load_path_symbol = s7_define_variable_with_documentation(sc, "*load-path*", sc->nil, /* list_1(sc, make_string_with_length(sc, ".", 1)), */ /* not plist! */
+			   "*load-path* is a list of directories (strings) that the load function searches if it is passed an incomplete file name");
+  s7_set_setter(sc, sc->load_path_symbol, s7_make_safe_function(sc, "#<set-*load-path*>", g_load_path_set, 2, 0, false, "*load-path* setter"));
+
+#ifdef CLOAD_DIR
+  sc->cload_directory_symbol = s7_define_variable(sc, "*cload-directory*", s7_make_string(sc, (char *)CLOAD_DIR));
+  s7_add_to_load_path(sc, (const char *)CLOAD_DIR);
+#else
+  sc->cload_directory_symbol = s7_define_variable(sc, "*cload-directory*", nil_string);
+#endif
+  s7_set_setter(sc, sc->cload_directory_symbol,
+		s7_make_safe_function(sc, "#<set-*cload-directory*>", g_cload_directory_set, 2, 0, false, "*cload-directory* setter"));
+
+  /* -------- *autoload* -------- this pretends to be a hash-table or environment, but it's actually a function */
+  sc->autoloader_symbol = s7_define_typed_function(sc, "*autoload*", g_autoloader, 1, 0, false, H_autoloader, Q_autoloader);
+  c_function_set_setter(global_value(sc->autoloader_symbol), global_value(sc->autoload_symbol)); /* (set! (*autoload* x) y) */
+
+  sc->libraries_symbol = s7_define_variable_with_documentation(sc, "*libraries*", sc->nil, "list of currently loaded libraries (libc.scm, etc)");
+  s7_set_setter(sc, sc->libraries_symbol, s7_make_safe_function(sc, "#<set-*libraries*>", g_libraries_set, 2, 0, false, "*libraries* setter"));
+
+  s7_autoload(sc, make_symbol(sc, "cload.scm", 9),        s7_make_semipermanent_string(sc, "cload.scm"));
+  s7_autoload(sc, make_symbol(sc, "lint.scm", 8),         s7_make_semipermanent_string(sc, "lint.scm"));
+  s7_autoload(sc, make_symbol(sc, "stuff.scm", 9),        s7_make_semipermanent_string(sc, "stuff.scm"));
+  s7_autoload(sc, make_symbol(sc, "mockery.scm", 11),     s7_make_semipermanent_string(sc, "mockery.scm"));
+  s7_autoload(sc, make_symbol(sc, "write.scm", 9),        s7_make_semipermanent_string(sc, "write.scm"));
+  s7_autoload(sc, make_symbol(sc, "reactive.scm", 12),    s7_make_semipermanent_string(sc, "reactive.scm"));
+  s7_autoload(sc, make_symbol(sc, "repl.scm", 8),         s7_make_semipermanent_string(sc, "repl.scm"));
+  s7_autoload(sc, make_symbol(sc, "r7rs.scm", 8),         s7_make_semipermanent_string(sc, "r7rs.scm"));
+  s7_autoload(sc, make_symbol(sc, "profile.scm", 11),     s7_make_semipermanent_string(sc, "profile.scm"));
+  s7_autoload(sc, make_symbol(sc, "debug.scm", 9),        s7_make_semipermanent_string(sc, "debug.scm"));
+  s7_autoload(sc, make_symbol(sc, "case.scm", 8),         s7_make_semipermanent_string(sc, "case.scm"));
+
+  s7_autoload(sc, make_symbol(sc, "libc.scm", 8),         s7_make_semipermanent_string(sc, "libc.scm"));
+  s7_autoload(sc, make_symbol(sc, "libm.scm", 8),         s7_make_semipermanent_string(sc, "libm.scm"));    /* repl.scm adds *libm* */
+  s7_autoload(sc, make_symbol(sc, "libdl.scm", 9),        s7_make_semipermanent_string(sc, "libdl.scm"));
+  s7_autoload(sc, make_symbol(sc, "libgsl.scm", 10),      s7_make_semipermanent_string(sc, "libgsl.scm"));  /* repl.scm adds *libgsl* */
+  s7_autoload(sc, make_symbol(sc, "libgdbm.scm", 11),     s7_make_semipermanent_string(sc, "libgdbm.scm"));
+  s7_autoload(sc, make_symbol(sc, "libutf8proc.scm", 15), s7_make_semipermanent_string(sc, "libutf8proc.scm"));
+
+  sc->require_symbol = s7_define_macro(sc, "require", g_require, 1, 0, true, H_require);
+  sc->stacktrace_defaults = s7_list(sc, 5, int_three, small_int(45), small_int(80), small_int(45), sc->T); /* assume NUM_SMALL_INTS >= NUM_CHARS == 256 */
+
+  /* -------- *#readers* -------- */
+  sym = s7_define_variable_with_documentation(sc, "*#readers*", sc->nil, "list of current reader macros");
+  sc->sharp_readers = global_slot(sym);
+  s7_set_setter(sc, sym, s7_make_safe_function(sc, "#<set-*#readers*>", g_sharp_readers_set, 2, 0, false, "*#readers* setter"));
+
+  sc->local_documentation_symbol = make_symbol(sc, "+documentation+", 15);
+  sc->local_signature_symbol =     make_symbol(sc, "+signature+", 11);
+  sc->local_setter_symbol =        make_symbol(sc, "+setter+", 8);
+  sc->local_iterator_symbol =      make_symbol(sc, "+iterator+", 10);
+
+  init_features(sc);
+  init_setters(sc);
+}
+
+#if (!MS_WINDOWS)
+static pthread_mutex_t init_lock = PTHREAD_MUTEX_INITIALIZER;
+#endif
+
+s7_scheme *s7_init(void)
+{
+  int32_t i;
+  s7_scheme *sc;
+  static bool already_inited = false;
+
+#if (!MS_WINDOWS)
+  setlocale(LC_NUMERIC, "C"); /* use decimal point in floats */
+  pthread_mutex_lock(&init_lock);
+#endif
+
+  if (!already_inited)
+    {
+      init_types();
+      init_ctables();
+      init_mark_functions();
+      init_display_functions();
+      init_length_functions();
+      init_equals();
+      init_hash_maps();
+      init_pows();
+      init_int_limits();
+      init_small_ints();
+      init_uppers();
+      init_chars();
+      init_strings();
+      init_fx_function();
+      init_catchers();
+      init_s7_starlet_immutable_field();
+      already_inited = true;
+    }
+#if S7_DEBUGGING
+  init_never_unheaped();
+#endif
+#if (!MS_WINDOWS)
+  pthread_mutex_unlock(&init_lock);
+#endif
+  sc = (s7_scheme *)Calloc(1, sizeof(s7_scheme)); /* not malloc! */
+  cur_sc = sc;                                    /* for gdb/debugging */
+  sc->gc_off = true;                              /* sc->args and so on are not set yet, so a gc during init -> segfault */
+  sc->gc_in_progress = false;
+  sc->gc_stats = 0;
+
+  sc->saved_pointers = (void **)Malloc(INITIAL_SAVED_POINTERS_SIZE * sizeof(void *));
+  sc->saved_pointers_loc = 0;
+  sc->saved_pointers_size = INITIAL_SAVED_POINTERS_SIZE;
+
+  init_gc_caches(sc);
+  sc->semipermanent_cells = 0;
+  sc->alloc_pointer_k = ALLOC_POINTER_SIZE;
+  sc->alloc_pointer_cells = NULL;
+  sc->alloc_big_pointer_k = ALLOC_BIG_POINTER_SIZE;
+  sc->alloc_big_pointer_cells = NULL;
+  sc->alloc_function_k = ALLOC_FUNCTION_SIZE;
+  sc->alloc_function_cells = NULL;
+  sc->alloc_symbol_k = ALLOC_SYMBOL_SIZE;
+  sc->alloc_symbol_cells = NULL;
+  sc->num_to_str_size = -1;
+  sc->num_to_str = NULL;
+  init_block_lists(sc);
+  sc->alloc_string_k = ALLOC_STRING_SIZE;
+  sc->alloc_string_cells = NULL;
+  sc->alloc_opt_func_cells = NULL;
+  sc->alloc_opt_func_k = ALLOC_FUNCTION_SIZE;
+  sc->longjmp_ok = false;
+  sc->setjmp_loc = NO_SET_JUMP;
+  sc->max_vector_length = (1LL << 32);
+  sc->max_string_length = 1073741824; /* 1 << 30 */
+  sc->max_format_length = 10000;
+  sc->max_list_length = 1073741824;
+  sc->max_vector_dimensions = 512;
+  sc->strbuf_size = INITIAL_STRBUF_SIZE;
+  sc->strbuf = (char *)Calloc(sc->strbuf_size, 1);
+  sc->print_width = sc->max_string_length;
+  sc->short_print = false;
+  sc->in_with_let = false;
+  sc->object_out_locked = false;
+  sc->has_openlets = true;
+  sc->is_expanding = true;
+  sc->accept_all_keyword_arguments = false;
+  sc->muffle_warnings = false;
+  sc->symbol_quote = false;
+  sc->initial_string_port_length = 128;
+  sc->format_depth = -1;
+  sc->singletons = (s7_pointer *)Calloc(256, sizeof(s7_pointer));
+  add_saved_pointer(sc, sc->singletons);
+  sc->read_line_buf = NULL;
+  sc->read_line_buf_size = 0;
+  sc->stop_at_error = true;
+
+  sc->nil =         make_unique(sc, "()",             T_NIL);
+  sc->unused =      make_unique(sc, "#<unused>",      T_UNUSED);
+  sc->T =           make_unique(sc, "#t",             T_BOOLEAN);
+  sc->F =           make_unique(sc, "#f",             T_BOOLEAN);
+  sc->undefined =   make_unique(sc, "#<undefined>",   T_UNDEFINED);
+  sc->unspecified = make_unique(sc, "#<unspecified>", T_UNSPECIFIED);
+  sc->no_value =    make_unique(sc, (SHOW_EVAL_OPS) ? "#<no-value>" : "#<unspecified>", T_UNSPECIFIED);
+
+  unique_car(sc->nil) = sc->unspecified; /* see op_if1 */
+  unique_cdr(sc->nil) = sc->unspecified;
+  unique_cdr(sc->unspecified) = sc->unspecified;
+
+  sc->t1_1 = semipermanent_cons(sc, sc->unused, sc->nil,  T_PAIR | T_IMMUTABLE);
+  sc->t2_2 = semipermanent_cons(sc, sc->unused, sc->nil,  T_PAIR | T_IMMUTABLE);
+  sc->t2_1 = semipermanent_cons(sc, sc->unused, sc->t2_2, T_PAIR | T_IMMUTABLE);
+  sc->t3_3 = semipermanent_cons(sc, sc->unused, sc->nil,  T_PAIR | T_IMMUTABLE);
+  sc->t3_2 = semipermanent_cons(sc, sc->unused, sc->t3_3, T_PAIR | T_IMMUTABLE);
+  sc->t3_1 = semipermanent_cons(sc, sc->unused, sc->t3_2, T_PAIR | T_IMMUTABLE);
+  sc->t4_1 = semipermanent_cons(sc, sc->unused, sc->t3_1, T_PAIR | T_IMMUTABLE);
+  sc->u1_1 = semipermanent_cons(sc, sc->unused, sc->nil,  T_PAIR | T_IMMUTABLE); /* ulist */
+
+  sc->safe_lists[0] = sc->nil;
+  for (i = 1; i < NUM_SAFE_PRELISTS; i++)
+    sc->safe_lists[i] = semipermanent_list(sc, i);
+  for (i = NUM_SAFE_PRELISTS; i < NUM_SAFE_LISTS; i++)
+    sc->safe_lists[i] = sc->nil;
+  sc->current_safe_list = 0;
+#if S7_DEBUGGING
+  local_memset((void *)(sc->safe_list_uses), 0, NUM_SAFE_LISTS);
+#endif
+
+  sc->input_port_stack_size = INPUT_PORT_STACK_INITIAL_SIZE;
+  sc->input_port_stack = (s7_pointer *)Malloc(sc->input_port_stack_size * sizeof(s7_pointer));
+  sc->input_port_stack_loc = 0;
+
+  sc->code = sc->nil;
+#if WITH_HISTORY
+  sc->eval_history1 = semipermanent_list(sc, DEFAULT_HISTORY_SIZE);
+  sc->eval_history2 = semipermanent_list(sc, DEFAULT_HISTORY_SIZE);
+  sc->history_pairs = semipermanent_list(sc, DEFAULT_HISTORY_SIZE);
+  sc->history_sink = semipermanent_list(sc, 1);
+  unchecked_set_cdr(sc->history_sink, sc->history_sink);
+  {
+    s7_pointer p1, p2, p3;
+    for (p3 = sc->history_pairs; is_pair(cdr(p3)); p3 = cdr(p3)) set_car(p3, semipermanent_list(sc, 1));
+    set_car(p3, semipermanent_list(sc, 1));
+    unchecked_set_cdr(p3, sc->history_pairs);
+    for (p1 = sc->eval_history1, p2 = sc->eval_history2; is_pair(cdr(p1)); p1 = cdr(p1), p2 = cdr(p2));
+    unchecked_set_cdr(p1, sc->eval_history1);
+    unchecked_set_cdr(p2, sc->eval_history2);
+    sc->cur_code = sc->eval_history1;
+    sc->using_history1 = true;
+    sc->old_cur_code = sc->cur_code;
+  }
+#else
+  sc->cur_code = sc->F;
+#endif
+  sc->args = sc->nil;
+  sc->value = sc->nil;
+  sc->w = sc->unused;
+  sc->x = sc->unused;
+  sc->y = sc->unused;
+  sc->z = sc->unused;
+  sc->temp1 = sc->unused;
+  sc->temp2 = sc->unused;
+  sc->temp3 = sc->unused;
+  sc->temp4 = sc->unused;
+  sc->temp5 = sc->unused;
+  sc->temp6 = sc->unused;
+  sc->temp7 = sc->unused;
+  sc->temp8 = sc->unused;
+  sc->temp9 = sc->unused;
+  sc->temp10 = sc->unused;
+  sc->rec_p1 = sc->unused;
+  sc->rec_p2 = sc->unused;
+
+  sc->begin_hook = NULL;
+  sc->autoload_table = sc->nil;
+  sc->autoload_names = NULL;
+  sc->autoload_names_sizes = NULL;
+  sc->autoloaded_already = NULL;
+  sc->autoload_names_loc = 0;
+#if DISABLE_AUTOLOAD /* might not be defined, so we can't play games */
+  sc->is_autoloading = false;
+#else
+  sc->is_autoloading = true;
+#endif
+  sc->rec_stack = NULL;
+  sc->show_stack_limit = 20;
+
+  sc->heap_size = INITIAL_HEAP_SIZE;
+  if ((sc->heap_size % 32) != 0)
+    sc->heap_size = 32 * (int64_t)ceil((double)(sc->heap_size) / 32.0);
+  sc->heap = (s7_pointer *)Malloc(sc->heap_size * sizeof(s7_pointer));
+  sc->free_heap = (s7_cell **)Malloc(sc->heap_size * sizeof(s7_cell *));
+  sc->free_heap_top = (s7_cell **)(sc->free_heap + INITIAL_HEAP_SIZE);
+  sc->free_heap_trigger = (s7_cell **)(sc->free_heap + GC_TRIGGER_SIZE);
+  sc->previous_free_heap_top = sc->free_heap_top;
+  {
+    s7_cell *cells = (s7_cell *)Malloc(INITIAL_HEAP_SIZE * sizeof(s7_cell)); /* was calloc 14-Apr-22 */
+    add_saved_pointer(sc, (void *)cells);
+    for (i = 0; i < INITIAL_HEAP_SIZE; i++)       /* LOOP_4 here is slower! */
+      {
+	sc->heap[i] = &cells[i];
+ 	sc->free_heap[i] = sc->heap[i];
+#if S7_DEBUGGING
+	sc->heap[i]->debugger_bits = 0; sc->heap[i]->gc_line = 0; sc->heap[i]->gc_func = NULL;
+#endif
+	clear_type(sc->heap[i]);                  /* type(sc->heap[i]) = T_FREE */
+	i++;
+	sc->heap[i] = &cells[i];
+ 	sc->free_heap[i] = sc->heap[i];
+#if S7_DEBUGGING
+	sc->heap[i]->debugger_bits = 0; sc->heap[i]->gc_line = 0; sc->heap[i]->gc_func = NULL;
+#endif
+	clear_type(sc->heap[i]);
+     }
+    /* memcpy((void *)(sc->free_heap), (const void *)(sc->heap), sizeof(s7_pointer) * INITIAL_HEAP_SIZE); */
+    /*   weird that this memcpy (without the equivalent sets above) is much slower */
+    sc->heap_blocks = (heap_block_t *)Malloc(sizeof(heap_block_t));
+    sc->heap_blocks->start = (intptr_t)cells;
+    sc->heap_blocks->end = (intptr_t)cells + (sc->heap_size * sizeof(s7_cell));
+    sc->heap_blocks->offset = 0;
+    sc->heap_blocks->next = NULL;
+  }
+  sc->gc_temps_size = GC_TEMPS_SIZE;
+  sc->gc_resize_heap_fraction = GC_RESIZE_HEAP_FRACTION;
+  sc->gc_resize_heap_by_4_fraction = GC_RESIZE_HEAP_BY_4_FRACTION;
+  sc->max_heap_size = (1LL << 45);
+  sc->gc_calls = 0;
+  sc->gc_total_time = 0;
+  /* unvectorize free-heap?  t_free obj nxt -> next in list, free_heap_top|length; get free: obj=free_heap_top; top=nxt; len--
+   *   push: cur->nxt=top, top=cur len++; trigger when len<trigger; can still do batch alloc/free setting len at end;
+   *   how to gc sweep tmps -- seems to require a back pointer (2-way list) but there's no room; no need to realloc when heap grows, but do
+   *   need to place new cells on the free list; no malloc needed, but we need to make the initial list; saves 1/8 of heap-related space.
+   *   maybe a circular list (vector?) for tmps
+   */
+
+  sc->max_port_data_size = (1LL << 45);
+#ifndef OUTPUT_FILE_PORT_DATA_SIZE
+  #define OUTPUT_FILE_PORT_DATA_SIZE 2048
+#endif
+  sc->output_file_port_data_size = OUTPUT_FILE_PORT_DATA_SIZE;
+
+  /* this has to precede s7_make_* allocations */
+  sc->protected_setters_size = INITIAL_PROTECTED_OBJECTS_SIZE;
+  sc->protected_setters_loc = 0;
+  sc->protected_setters = make_vector_1(sc, INITIAL_PROTECTED_OBJECTS_SIZE, FILLED, T_VECTOR);
+  sc->protected_setter_symbols = make_vector_1(sc, INITIAL_PROTECTED_OBJECTS_SIZE, FILLED, T_VECTOR);
+
+  sc->protected_objects_size = INITIAL_PROTECTED_OBJECTS_SIZE;
+  sc->protected_objects_free_list = (s7_int *)Malloc(INITIAL_PROTECTED_OBJECTS_SIZE * sizeof(s7_int));
+  sc->protected_objects_free_list_loc = INITIAL_PROTECTED_OBJECTS_SIZE - 1;
+  sc->protected_objects = make_vector_1(sc, INITIAL_PROTECTED_OBJECTS_SIZE, FILLED, T_VECTOR);
+  for (i = 0; i < INITIAL_PROTECTED_OBJECTS_SIZE; i++) /* using #<unused> as the not-set indicator here lets that value leak out! */
+    {
+      vector_element(sc->protected_objects, i) = sc->unused;
+      vector_element(sc->protected_setters, i) = sc->unused;
+      vector_element(sc->protected_setter_symbols, i) = sc->unused;
+      sc->protected_objects_free_list[i] = i;
+    }
+
+  sc->stack = make_vector_1(sc, INITIAL_STACK_SIZE, FILLED, T_VECTOR);
+  /* if not_filled, segfault in gc_mark in mark_stack_1 after size check? probably unfilled OP_BARRIER etc? */
+  sc->stack_start = vector_elements(sc->stack); /* stack type set below */
+  sc->stack_end = sc->stack_start;
+  if (STACK_RESIZE_TRIGGER <= (INITIAL_STACK_SIZE / 2))
+    sc->stack_size = INITIAL_STACK_SIZE;
+  else sc->stack_size = STACK_RESIZE_TRIGGER * 2;
+  sc->stack_resize_trigger = (s7_pointer *)(sc->stack_start + (INITIAL_STACK_SIZE - STACK_RESIZE_TRIGGER));
+
+  set_full_type(sc->stack, T_STACK);
+  sc->max_stack_size = (1 << 30);
+  stack_clear_flags(sc->stack);
+  initialize_op_stack(sc);
+
+  /* keep the symbol table out of the heap */
+  sc->symbol_table = (s7_pointer)Malloc(sizeof(s7_cell)); /* was calloc 14-Apr-22 */
+  full_type(sc->symbol_table) = T_VECTOR | T_UNHEAP | T_SYMBOL_TABLE;
+  vector_length(sc->symbol_table) = SYMBOL_TABLE_SIZE;
+  vector_elements(sc->symbol_table) = (s7_pointer *)Malloc(SYMBOL_TABLE_SIZE * sizeof(s7_pointer));
+  vector_getter(sc->symbol_table) = t_vector_getter;
+  vector_setter(sc->symbol_table) = t_vector_setter;
+  t_vector_fill(sc->symbol_table, sc->nil);
+
+  { /* sc->opts */
+    opt_info *os = (opt_info *)Malloc(OPTS_SIZE * sizeof(opt_info)); /* was calloc, 17-Oct-21 */
+    add_saved_pointer(sc, os);
+    for (i = 0; i < OPTS_SIZE; i++)
+      {
+	opt_info *o = &os[i];
+	sc->opts[i] = o;
+	o->sc = sc;
+      }}
+
+  for (i = 0; i < NUM_TYPES; i++)
+    sc->type_names[i] = s7_make_semipermanent_string(sc, (const char *)type_name_from_type(i, INDEFINITE_ARTICLE));
+
+#if WITH_MULTITHREAD_CHECKS
+  sc->lock_count = 0;
+  {
+    pthread_mutexattr_t attr;
+    pthread_mutexattr_init(&attr);
+    pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE);
+    pthread_mutex_init(&sc->lock, &attr);
+  }
+#endif
+
+  sc->c_object_types = NULL;
+  sc->c_object_types_size = 0;
+  sc->num_c_object_types = 0;
+  sc->typnam = NULL;
+  sc->typnam_len = 0;
+  sc->default_rationalize_error = 1.0e-12;
+  sc->hash_table_float_epsilon = 1.0e-12;
+  sc->equivalent_float_epsilon = 1.0e-15;
+  sc->float_format_precision = WRITE_REAL_PRECISION;
+  sc->number_separator = '\0';
+  sc->default_hash_table_length = 8;
+  sc->gensym_counter = 0;
+  sc->capture_let_counter = 0;
+  sc->continuation_counter = 0;
+  sc->f_class = 0;
+  sc->add_class = 0;
+  sc->num_eq_class = 0;
+  sc->let_number = 0;
+  sc->format_column = 0;
+  sc->format_ports = NULL;
+  sc->file_names = NULL;
+  sc->file_names_size = 0;
+  sc->file_names_top = -1;
+  sc->s7_call_line = 0;
+  sc->s7_call_file = NULL;
+  sc->s7_call_name = NULL;
+  sc->safety = NO_SAFETY;
+  sc->debug = 0;
+  sc->profile = 0;
+  sc->profile_position = 0;
+  sc->debug_or_profile = false;
+  sc->profiling_gensyms = false;
+  sc->profile_data = NULL;
+  sc->profile_prefix = sc->F;
+  sc->print_length = DEFAULT_PRINT_LENGTH;
+  sc->history_size = DEFAULT_HISTORY_SIZE;
+  sc->true_history_size = DEFAULT_HISTORY_SIZE;
+  sc->baffle_ctr = 0;
+  sc->map_call_ctr = 0;
+  sc->syms_tag = 0;
+  sc->syms_tag2 = 0;
+  sc->symbol_printer = sc->F;
+  sc->class_name_symbol = make_symbol(sc, "class-name", 10);
+  sc->name_symbol = make_symbol(sc, "name", 4);
+  sc->trace_in_symbol = make_symbol(sc, "trace-in", 8);
+  sc->size_symbol = make_symbol(sc, "size", 4);
+  sc->is_mutable_symbol = make_symbol(sc, "mutable?", 8);
+  sc->file__symbol = make_symbol(sc, "FILE*", 5);
+  sc->circle_info = make_shared_info(sc);
+  sc->fdats = (format_data_t **)Calloc(8, sizeof(format_data_t *));
+  sc->num_fdats = 8;
+  sc->mlist_1 = semipermanent_list(sc, 1);
+  sc->mlist_2 = semipermanent_list(sc, 2);
+  sc->plist_1 = semipermanent_list(sc, 1);
+  sc->plist_2 = semipermanent_list(sc, 2);
+  sc->plist_2_2 = cdr(sc->plist_2);
+  sc->plist_3 = semipermanent_list(sc, 3);
+  sc->plist_4 = semipermanent_cons(sc, sc->unused, sc->plist_3, T_PAIR | T_IMMUTABLE);
+  sc->qlist_2 = semipermanent_list(sc, 2);
+  sc->qlist_3 = semipermanent_cons(sc, sc->unused, sc->qlist_2, T_PAIR | T_IMMUTABLE);
+  sc->clist_1 = semipermanent_list(sc, 1);
+  sc->clist_2 = semipermanent_list(sc, 2);
+  sc->dlist_1 = semipermanent_list(sc, 1);
+  sc->elist_1 = semipermanent_cons(sc, sc->unused, sc->nil, T_PAIR | T_IMMUTABLE | T_IS_ELIST);
+  sc->elist_2 = semipermanent_list(sc, 2); set_is_elist(sc->elist_2);
+  sc->elist_3 = semipermanent_list(sc, 3); set_is_elist(sc->elist_3);
+  sc->elist_4 = semipermanent_cons(sc, sc->unused, sc->elist_3, T_PAIR | T_IMMUTABLE | T_IS_ELIST);
+  sc->elist_5 = semipermanent_cons(sc, sc->unused, sc->elist_4, T_PAIR | T_IMMUTABLE | T_IS_ELIST);
+  sc->elist_6 = semipermanent_cons(sc, sc->unused, sc->elist_5, T_PAIR | T_IMMUTABLE | T_IS_ELIST);
+  sc->elist_7 = semipermanent_cons(sc, sc->unused, sc->elist_6, T_PAIR | T_IMMUTABLE | T_IS_ELIST);
+  sc->undefined_identifier_warnings = false;
+  sc->undefined_constant_warnings = false;
+  sc->wrap_only = make_wrap_only(sc);
+  sc->unentry = (hash_entry_t *)Malloc(sizeof(hash_entry_t));
+  hash_entry_set_value(sc->unentry, sc->F);
+  sc->begin_op = OP_BEGIN_NO_HOOK;
+  /* we used to laboriously set various other fields to null, but the calloc takes care of that */
+  sc->tree_pointers = NULL;
+  sc->tree_pointers_size = 0;
+  sc->tree_pointers_top = 0;
+  sc->objstr_max_len = S7_INT64_MAX;
+  sc->let_temp_hook = sc->nil;
+
+  sc->rootlet = alloc_pointer(sc);
+  set_full_type(sc->rootlet, T_LET | T_SAFE_PROCEDURE | T_UNHEAP);
+  let_set_id(sc->rootlet, -1);
+  let_set_outlet(sc->rootlet, NULL);
+  let_set_slots(sc->rootlet, slot_end);
+  add_semipermanent_let_or_slot(sc, sc->rootlet);
+
+  sc->rootlet_slots = slot_end;
+  set_curlet(sc, sc->rootlet);
+  sc->shadow_rootlet = sc->rootlet;
+  sc->unlet_entries = NULL;
+
+  init_wrappers(sc);
+  init_standard_ports(sc);
+  init_rootlet(sc);
+  init_open_input_function_choices(sc);
+
+  {
+    s7_pointer p;
+    new_cell(sc, p, T_RANDOM_STATE); /* s7_set_default_random_state might set sc->default_random_state, so this shouldn't be permanent */
+    sc->default_random_state = p;
+#if WITH_GMP
+    mpz_set_ui(sc->mpz_1, (uint64_t)my_clock());
+    gmp_randinit_default(random_gmp_state(p));
+    gmp_randseed(random_gmp_state(p), sc->mpz_1);
+#else
+    random_seed(p) = (uint64_t)my_clock(); /* used to be time(NULL), but that means separate threads can get the same random number sequence */
+    random_carry(p) = 1675393560;
+#endif
+  }
+
+  sc->bignum_precision = DEFAULT_BIGNUM_PRECISION;
+#if WITH_GMP
+  sc->bigints = NULL;
+  sc->bigrats = NULL;
+  sc->bigflts = NULL;
+  sc->bigcmps = NULL;
+
+  mpfr_set_default_prec((mp_prec_t)DEFAULT_BIGNUM_PRECISION);
+  mpc_set_default_precision((mp_prec_t)DEFAULT_BIGNUM_PRECISION);
+  mpz_inits(sc->mpz_1, sc->mpz_2, sc->mpz_3, sc->mpz_4, NULL);
+  mpq_inits(sc->mpq_1, sc->mpq_2, sc->mpq_3, NULL);
+  mpfr_inits2(DEFAULT_BIGNUM_PRECISION, sc->mpfr_1, sc->mpfr_2, sc->mpfr_3, NULL);
+  mpc_init(sc->mpc_1);
+  mpc_init(sc->mpc_2);
+
+  sc->pi_symbol = s7_define_constant(sc, "pi", big_pi(sc)); /* not actually a constant because it changes with bignum-precision */
+  s7_provide(sc, "gmp");
+#else
+  sc->pi_symbol = s7_define_constant(sc, "pi", real_pi);
+#endif
+
+  for (i = 0; i < 10; i++) sc->singletons[(uint8_t)'0' + i] = small_int(i);
+  sc->singletons[(uint8_t)'+'] = sc->add_symbol;
+  sc->singletons[(uint8_t)'-'] = sc->subtract_symbol;
+  sc->singletons[(uint8_t)'*'] = sc->multiply_symbol;
+  sc->singletons[(uint8_t)'/'] = sc->divide_symbol;
+  sc->singletons[(uint8_t)'<'] = sc->lt_symbol;
+  sc->singletons[(uint8_t)'>'] = sc->gt_symbol;
+  sc->singletons[(uint8_t)'='] = sc->num_eq_symbol;
+
+  init_choosers(sc);
+  init_typers(sc);
+  init_opt_functions(sc);
+  s7_set_history_enabled(sc, false);
+#if S7_DEBUGGING
+  init_tc_rec(sc);
+#endif
+
+  init_signatures(sc);      /* depends on procedure symbols */
+  sc->s7_starlet = make_s7_starlet(sc);
+  s7_set_history_enabled(sc, true);
+
+  s7_eval_c_string(sc, "(define make-hook                                                                 \n\
+                          (let ((+documentation+ \"(make-hook . pars) returns a new hook (a function) that passes the parameters to each function in its function list.\")) \n\
+                            (lambda hook-args                                                             \n\
+                              (let ((body ()))                                                            \n\
+                                (apply lambda* hook-args                                                  \n\
+                                  `((let ((result #<unspecified>))                                        \n\
+                                      (let ((hook (openlet (sublet (curlet) 'let-ref-fallback (lambda (e sym) #<undefined>))))) \n\
+                                        (for-each (lambda (hook-function) (hook-function hook)) body)     \n\
+                                        result))))))))");
+  /* (procedure-source (make-hook 'x 'y)): (lambda* (x y) (let ((result #<unspecified>)) ... result)), see stuff.scm for commentary */
+
+  s7_eval_c_string(sc, "(define hook-functions                                                            \n\
+                          (let ((+signature+ '(#t procedure?))                                            \n\
+                                (+documentation+ \"(hook-functions hook) gets or sets the list of functions associated with the hook\")) \n\
+                            (dilambda                                                                     \n\
+                              (lambda (hook)                                                              \n\
+                                (when (or (not (procedure? hook)) (continuation? hook) (goto? hook))      \n\
+                                  (error 'wrong-type-arg \"hook-functions hook must be a procedure created by make-hook: ~S\" hook)) \n\
+                                ((funclet hook) 'body))                                                   \n\
+                              (lambda (hook lst)                                                          \n\
+                                (when (or (not (procedure? hook)) (continuation? hook) (goto? hook))      \n\
+		                  (error 'wrong-type-arg \"hook-functions hook must be a procedure created by make-hook: ~S\" hook)) \n\
+                                (if (do ((p lst (cdr p)))                                                 \n\
+                                        ((not (and (pair? p)                                              \n\
+                                                   (procedure? (car p))                                   \n\
+                                                   (aritable? (car p) 1)))                                \n\
+                                         (null? p)))                                                      \n\
+                                    (set! ((funclet hook) 'body) lst)                                     \n\
+                                    (error 'wrong-type-arg \"hook-functions must be a list of functions, each accepting one argument: ~S\" lst))))))");
+
+  /* -------- *unbound-variable-hook* -------- */
+  sc->unbound_variable_hook = s7_eval_c_string(sc, "(make-hook 'variable)");
+  s7_define_constant_with_documentation(sc, "*unbound-variable-hook*", sc->unbound_variable_hook,
+					"*unbound-variable-hook* functions are called when an unbound variable is encountered, passed (hook 'variable).");
+
+  /* -------- *missing-close-paren-hook* -------- */
+  sc->missing_close_paren_hook = s7_eval_c_string(sc, "(make-hook)");
+  s7_define_constant_with_documentation(sc, "*missing-close-paren-hook*", sc->missing_close_paren_hook,
+					"*missing-close-paren-hook* functions are called when the reader thinks a close paren is missing");
+
+  /* -------- *load-hook* -------- */
+  sc->load_hook = s7_eval_c_string(sc, "(make-hook 'name)");
+  s7_define_constant_with_documentation(sc, "*load-hook*", sc->load_hook,
+					"*load-hook* functions are invoked by load, passing the to-be-loaded filename as (hook 'name)");
+
+  /* -------- *autoload-hook* -------- */
+  sc->autoload_hook = s7_eval_c_string(sc, "(make-hook 'name 'file)");
+  s7_define_constant_with_documentation(sc, "*autoload-hook*", sc->autoload_hook,
+					"*autoload-hook* functions are invoked by autoload, passing the to-be-autoloaded filename as (hook 'name) and (hook 'file))");
+
+  /* -------- *error-hook* -------- */
+  sc->error_hook = s7_eval_c_string(sc, "(make-hook 'type 'data)");
+  s7_define_constant_with_documentation(sc, "*error-hook*", sc->error_hook,
+					"*error-hook* functions are called in the error handler, passed (hook 'type) and (hook 'data).");
+
+  /* -------- *read-error-hook* -------- */
+  sc->read_error_hook = s7_eval_c_string(sc, "(make-hook 'type 'data)");
+  s7_define_constant_with_documentation(sc, "*read-error-hook*", sc->read_error_hook,
+					"*read-error-hook* functions are called by the reader if it is unhappy, passing the current program string as (hook 'data).");
+
+  /* -------- *rootlet-redefinition-hook* -------- */
+  sc->rootlet_redefinition_hook = s7_eval_c_string(sc, "(make-hook 'name 'value)");
+  s7_define_constant_with_documentation(sc, "*rootlet-redefinition-hook*", sc->rootlet_redefinition_hook,
+					"*rootlet-redefinition-hook* functions are called when a top-level variable's value is changed, (hook 'name 'value).");
+
+  sc->let_temp_hook = s7_eval_c_string(sc, "(make-hook 'type 'data)");
+
+  s7_eval_c_string(sc, "(define-expansion (reader-cond . clauses)                                         \n\
+                          (if (null? clauses)                                                             \n\
+                              (error 'syntax-error \"reader-cond: no clauses?\"))                         \n\
+                          (call-with-exit                                                                 \n\
+                            (lambda (return)                                                              \n\
+                              (for-each                                                                   \n\
+                                (lambda (clause)                                                          \n\
+                                  (if (not (pair? clause))                                                \n\
+                                      (error 'syntax-error \"reader-cond: clause is not a pair, ~S\" clause)) \n\
+	                          (let ((val (eval (car clause))))                                        \n\
+                                    (when val                                                             \n\
+                                      (return                                                             \n\
+                                        (cond ((null? (cdr clause)) val)                                  \n\
+                                              ((eq? (cadr clause) '=>) ((eval (caddr clause)) val))       \n\
+                                              ((null? (cddr clause)) (cadr clause))                       \n\
+                                              (else (apply values (cdr clause))))))))                     \n\
+                                clauses)                                                                  \n\
+                              (values))))"); /* this is not redundant */  /* map above ignores trailing cdr if improper */
+  /*   was (return `(values ,@(cdr clause))) snd-14, begin snd-13, snd-23 (else (apply values (map quote (cdr clause)))) */
+  /* we need "values" (not "begin") to make sure all entries are plugged in at the source location? but that's not how "cond" works */
+  /*   maybe a better name: reader-cond-values? or reader-values or splicing-cond? */
+
+#if (!WITH_PURE_S7)
+  {
+    s7_pointer rs = s7_define_variable(sc, "make-rectangular", global_value(sc->complex_symbol));
+    set_initial_value(rs, global_value(sc->complex_symbol)); /* for #_make-rectangular */
+  }
+  s7_eval_c_string(sc, "(define make-polar                                                                \n\
+                          (let ((+signature+ '(number? real? real?)))                                     \n\
+                            (lambda (mag ang)                                                             \n\
+                              (if (and (real? mag) (real? ang))                                           \n\
+                                  (complex (* mag (cos ang)) (* mag (sin ang)))                           \n\
+                                  (error 'wrong-type-arg \"make-polar arguments should be real\")))))");
+
+  s7_eval_c_string(sc, "(define (call-with-values producer consumer) (apply consumer (list (producer))))");
+  /* (consumer (producer)) will work in any "normal" context.  If consumer is syntax and then subsequently not syntax, there is confusion */
+
+  s7_eval_c_string(sc, "(define-macro (multiple-value-bind vars expression . body)                        \n\
+                          (list (cons 'lambda (cons vars body)) expression))");
+
+  s7_eval_c_string(sc, "(define-macro (cond-expand . clauses)                                             \n\
+                          (if (null? clauses)                                                             \n\
+                              (error 'syntax-error \"cond-expand: no clauses?\"))                         \n\
+                          (letrec ((traverse (lambda (tree)                                               \n\
+		                               (if (pair? tree)                                           \n\
+			                           (cons (traverse (car tree))                            \n\
+				                         (case (cdr tree) ((())) (else => traverse)))     \n\
+			                           (if (memq tree '(and or not else)) tree                \n\
+			                               (and (symbol? tree) (provided? tree)))))))         \n\
+                            (cons 'cond (map (lambda (clause)                                             \n\
+		                               (if (pair? clause)                                         \n\
+                                                   (cons (traverse (car clause))                          \n\
+			                                 (case (cdr clause) ((()) '(#f)) (else)))         \n\
+                                                   (error 'syntax-error \"cond-expand: clause is not a pair, ~S\" clause))) \n\
+		                             clauses))))");
+  /* cond-expand should expand into an expansion (or inline macro?) so that if there's no else clause, we can add (else (values))
+   *   r7rs says: "If none of the <feature requirement>s evaluate to #t, then if there is an else clause, its <expression>s are included.
+   *   Otherwise, the cond-expand has no effect."  The code above returns #<unspecified>, but I read that prose to say that
+   *   (begin 23 (cond-expand (surreals 1) (foonly 2))) should evaluate to 23.
+   */
+  /* make-polar, call-with-values, make-hook, hook-functions, multiple-value-bind, cond-expand, and reader-cond can't
+   *   set the initial_value to the global_value so that #_... can be used because the global_value is not semipermanent.
+   *   but could it be made so?
+   */
+#endif
+
+#if S7_DEBUGGING
+  s7_define_function(sc, "report-missed-calls", g_report_missed_calls, 0, 0, false, NULL); /* tc/recur tests in s7test.scm */
+  if (strcmp(op_names[HOP_SAFE_C_PP], "h_safe_c_pp") != 0) fprintf(stderr, "c op_name: %s\n", op_names[HOP_SAFE_C_PP]);
+  if (strcmp(op_names[OP_SET_WITH_LET_2], "set_with_let_2") != 0) fprintf(stderr, "set op_name: %s\n", op_names[OP_SET_WITH_LET_2]);
+  if (NUM_OPS != 929) fprintf(stderr, "size: cell: %d, block: %d, max op: %d, opt: %d\n", (int)sizeof(s7_cell), (int)sizeof(block_t), NUM_OPS, (int)sizeof(opt_info));
+  /* cell size: 48, 120 if debugging, block size: 40, opt: 128 or 280 */
+  if (false) gdb_break();
+#endif
+  return(sc);
+}
+
+
+/* -------------------------------- s7_free -------------------------------- */
+static void gc_list_free(gc_list_t *g)
+{
+  free(g->list);
+  free(g);
+}
+
+static void big_block_free(s7_scheme *sc, block_t *block)
+{
+  if ((block_index(block) == TOP_BLOCK_LIST) && (block_data(block)))
+    {
+      free(block_data(block));
+      block_data(block) = NULL;
+    }
+}
+
+void s7_free(s7_scheme *sc)
+{
+  /* free the memory associated with sc (not globals since we might have multiple s7 interpreters running)
+   *   most pointers are in the saved_pointers table, but any that might be realloc'd need to be handled explicitly
+   * valgrind --leak-check=full --show-reachable=no --suppressions=/home/bil/cl/free.supp repl s7test.scm
+   * valgrind --leak-check=full --show-reachable=yes --gen-suppressions=all --error-limit=no --log-file=raw.log repl s7test.scm
+   */
+  s7_int i;
+  gc_list_t *gp;
+
+  /* g_gc(sc, sc->nil); */ /* probably not needed (my simple tests work fine if the gc call is omitted) */ /* removed 14-Apr-22 */
+  /* s7_quit(sc);       */ /* not always needed -- will clean up the C stack if we haven't returned to the top level */
+
+  gp = sc->c_objects;  /* do this first since they might involve gc_unprotect etc */
+  for (i = 0; i < gp->loc; i++)
+    {
+      s7_pointer s1 = gp->list[i];
+      if (c_object_gc_free(sc, s1))
+        (*(c_object_gc_free(sc, s1)))(sc, s1);
+      else (*(c_object_free(sc, s1)))(c_object_value(s1));
+    }
+  gc_list_free(gp);
+
+  gp = sc->vectors;
+  for (i = 0; i < gp->loc; i++)
+    if (block_index(unchecked_vector_block(gp->list[i])) == TOP_BLOCK_LIST)
+      free(block_data(unchecked_vector_block(gp->list[i])));
+  gc_list_free(gp);
+  gc_list_free(sc->multivectors); /* I assume vector_dimension_info won't need 131072 bytes */
+
+  gp = sc->strings;
+  for (i = 0; i < gp->loc; i++)
+    if (block_index(unchecked_string_block(gp->list[i])) == TOP_BLOCK_LIST)
+      free(block_data(unchecked_string_block(gp->list[i])));
+  gc_list_free(gp);
+
+  gp = sc->output_ports;
+  for (i = 0; i < gp->loc; i++)
+    {
+      if ((unchecked_port_data_block(gp->list[i])) &&
+	  (block_index(unchecked_port_data_block(gp->list[i])) == TOP_BLOCK_LIST))
+	free(block_data(unchecked_port_data_block(gp->list[i])));   /* the file contents, port_block is other stuff */
+      if ((is_file_port(gp->list[i])) &&
+	  (!port_is_closed(gp->list[i])))
+	fclose(port_file(gp->list[i]));
+    }
+  gc_list_free(gp);
+
+  gp = sc->input_ports;
+  for (i = 0; i < gp->loc; i++)
+    if ((unchecked_port_data_block(gp->list[i])) &&
+	(block_index(unchecked_port_data_block(gp->list[i])) == TOP_BLOCK_LIST))
+      free(block_data(unchecked_port_data_block(gp->list[i])));    /* the file contents, port_block is other stuff */
+  gc_list_free(gp);
+  gc_list_free(sc->input_string_ports); /* port_data_block is null, port_block is the const char* data, so I assume it is handled elsewhere */
+
+  gp = sc->hash_tables;
+  for (i = 0; i < gp->loc; i++)
+    if (block_index(unchecked_hash_table_block(gp->list[i])) == TOP_BLOCK_LIST)
+      free(block_data(unchecked_hash_table_block(gp->list[i])));
+  gc_list_free(gp);
+
+#if WITH_GMP
+  /* free lists */
+  {bigint *p, *np; for (p = sc->bigints; p; p = np) {mpz_clear(p->n); np = p->nxt; free(p);}}
+  {bigrat *p, *np; for (p = sc->bigrats; p; p = np) {mpq_clear(p->q); np = p->nxt; free(p);}}
+  {bigflt *p, *np; for (p = sc->bigflts; p; p = np) {mpfr_clear(p->x); np = p->nxt; free(p);}}
+  {bigcmp *p, *np; for (p = sc->bigcmps; p; p = np) {mpc_clear(p->z); np = p->nxt; free(p);}}
+
+  gp = sc->big_integers;
+  for (i = 0; i < gp->loc; i++) {bigint *p; p = big_integer_bgi(gp->list[i]); mpz_clear(p->n); free(p);}
+  gc_list_free(gp);
+
+  gp = sc->big_ratios;
+  for (i = 0; i < gp->loc; i++) {bigrat *p; p = big_ratio_bgr(gp->list[i]); mpq_clear(p->q); free(p);}
+  gc_list_free(gp);
+
+  gp = sc->big_reals;
+  for (i = 0; i < gp->loc; i++) {bigflt *p; p = big_real_bgf(gp->list[i]); mpfr_clear(p->x); free(p);}
+  gc_list_free(gp);
+
+  gp = sc->big_complexes;
+  for (i = 0; i < gp->loc; i++) {bigcmp *p; p = big_complex_bgc(gp->list[i]); mpc_clear(p->z); free(p);}
+  gc_list_free(gp);
+
+  gp = sc->big_random_states;
+  for (i = 0; i < gp->loc; i++) gmp_randclear(random_gmp_state(gp->list[i]));
+  gc_list_free(gp);
+
+  gmp_randclear(random_gmp_state(sc->default_random_state));
+
+  /* temps */
+  if (sc->ratloc) free_rat_locals(sc);
+  mpz_clears(sc->mpz_1, sc->mpz_2, sc->mpz_3, sc->mpz_4, NULL);
+  mpq_clears(sc->mpq_1, sc->mpq_2, sc->mpq_3, NULL);
+  mpfr_clears(sc->mpfr_1, sc->mpfr_2, sc->mpfr_3, NULL);
+  mpc_clear(sc->mpc_1);
+  mpc_clear(sc->mpc_2);
+  /* I claim the leftovers (864 bytes, all from mpfr_cosh) are gmp's fault */
+#endif
+
+  free(undefined_name(sc->undefined));
+  gp = sc->undefineds;
+  for (i = 0; i < gp->loc; i++)
+    free(undefined_name(gp->list[i]));
+  gc_list_free(gp);
+
+  gc_list_free(sc->gensyms);
+  gc_list_free(sc->continuations);  /* stack is simple vector (handled above) */
+  gc_list_free(sc->weak_refs);
+  gc_list_free(sc->weak_hash_iterators);
+  gc_list_free(sc->opt1_funcs);
+
+  free(port_port(sc->standard_output));
+  free(port_port(sc->standard_error));
+  free(port_port(sc->standard_input));
+
+  if (sc->autoload_names) free(sc->autoload_names);
+  if (sc->autoload_names_sizes) free(sc->autoload_names_sizes);
+  if (sc->autoloaded_already)
+    {
+      for (i = 0; i < sc->autoload_names_loc; i++)
+	if (sc->autoloaded_already[i]) free(sc->autoloaded_already[i]);
+      free(sc->autoloaded_already);
+    }
+  for (block_t *top = sc->block_lists[TOP_BLOCK_LIST]; top; top = block_next(top))
+    if (block_data(top))
+      free(block_data(top));
+
+  big_block_free(sc, stack_block(sc->stack));
+  big_block_free(sc, vector_block(sc->protected_objects));
+  for (i = 0; i < sc->saved_pointers_loc; i++)
+    free(sc->saved_pointers[i]);
+  free(sc->saved_pointers);
+
+  {
+    gc_obj_t *g, *gnxt;
+    heap_block_t *hpnxt;
+    for (g = sc->semipermanent_lets; g; g = gnxt)    {gnxt = g->nxt; free(g);}
+    for (g = sc->semipermanent_objects; g; g = gnxt) {gnxt = g->nxt; free(g);}
+    for (heap_block_t *hp = sc->heap_blocks; hp; hp = hpnxt) {hpnxt = hp->next; free(hp);}
+  }
+
+  free(sc->heap);
+  free(sc->free_heap);
+  free(vector_elements(sc->symbol_table)); /* alloc'd directly, not via block */
+  free(sc->symbol_table);
+  free(sc->setters);
+  free(sc->op_stack);
+  if (sc->tree_pointers) free(sc->tree_pointers);
+  free(sc->num_to_str);
+  free(sc->protected_objects_free_list);
+  if (sc->read_line_buf) free(sc->read_line_buf);
+  free(sc->strbuf);
+  free_shared_info(sc->circle_info);
+  if (sc->file_names) free(sc->file_names);
+  free(sc->unentry);
+  free(sc->input_port_stack);
+  if (sc->typnam) free(sc->typnam);
+
+  for (i = 0; i < sc->num_fdats; i++)
+    if (sc->fdats[i])                 /* init val is NULL */
+      {
+	if (sc->fdats[i]->curly_str)
+	  free(sc->fdats[i]->curly_str);
+	free(sc->fdats[i]);
+      }
+  free(sc->fdats);
+
+  if (sc->profile_data)
+    {
+      free(sc->profile_data->funcs);
+      free(sc->profile_data->let_names);
+      free(sc->profile_data->files);
+      free(sc->profile_data->lines);
+      free(sc->profile_data->excl);
+      free(sc->profile_data->timing_data);
+      free(sc->profile_data);
+    }
+  if (sc->c_object_types)
+    {
+      for (i = 0; i < sc->num_c_object_types; i++)
+	{
+	  c_object_t *c_type = sc->c_object_types[i];
+	  if (c_type->scheme_name) {free(c_type->scheme_name); c_type->scheme_name = NULL;}
+	  free(c_type);
+	}
+      free(sc->c_object_types);
+    }
+  free(sc);
+}
+
+
+/* -------------------------------- repl -------------------------------- */
+#ifndef USE_SND
+  #define USE_SND 0
+#endif
+#ifndef WITH_MAIN
+  #define WITH_MAIN 0
+#endif
+
+#if WITH_MAIN && WITH_NOTCURSES
+  #include "nrepl.c"
+  /* gcc -o nrepl s7.c -O2 -I. -Wl,-export-dynamic -lm -ldl -DWITH_MAIN -DWITH_NOTCURSES -lnotcurses-core */
+#else
+
+static void dumb_repl(s7_scheme *sc)
+{
+  while (true)
+    {
+      char buffer[512];
+      fprintf(stdout, "\n> ");
+      if (!fgets(buffer, 512, stdin)) break;  /* error or ctrl-D */
+      if (((buffer[0] != '\n') || (strlen(buffer) > 1)))
+	{
+	  char response[1024];
+	  snprintf(response, 1024, "(write %s)", buffer);
+	  s7_eval_c_string(sc, response);
+	}}
+  fprintf(stdout, "\n");
+  if (ferror(stdin))
+    fprintf(stderr, "read error on stdin\n");
+}
+
+void s7_repl(s7_scheme *sc)
+{
+#if (!WITH_C_LOADER)
+  dumb_repl(sc);
+#else
+#if WITH_NOTCURSES
+  s7_load(sc, "nrepl.scm");
+#else
+  /* try to get lib_s7.so from the repl's directory, and set *libc*.
+   *   otherwise repl.scm will try to load libc.scm which will try to build libc_s7.so locally, but that requires s7.h
+   */
+  bool repl_loaded = false;
+  s7_pointer e = s7_inlet(sc, set_clist_2(sc, make_symbol(sc, "init_func", 9), make_symbol(sc, "libc_s7_init", 12)));
+  s7_int gc_loc = gc_protect_1(sc, e);
+  s7_pointer old_e = s7_set_curlet(sc, e);   /* e is now (curlet) so loaded names from libc will be placed there, not in (rootlet) */
+  s7_pointer val = s7_load_with_environment(sc, "libc_s7.so", e);
+  if (val)
+    {
+      s7_pointer libs = global_slot(sc->libraries_symbol);
+      uint64_t hash = raw_string_hash((const uint8_t *)"*libc*", 6);  /* hack around an idiotic gcc 10.2.1 warning */
+      s7_define(sc, sc->rootlet, new_symbol(sc, "*libc*", 6, hash, hash % SYMBOL_TABLE_SIZE), e);
+      slot_set_value(libs, cons(sc, cons(sc, s7_make_semipermanent_string(sc, "libc.scm"), e), slot_value(libs)));
+    }
+
+  s7_set_curlet(sc, old_e);       /* restore incoming (curlet) */
+  s7_gc_unprotect_at(sc, gc_loc);
+
+  if (!val) /* s7_load was unable to find/load libc_s7.so */
+    dumb_repl(sc);
+  else
+    {
+#if S7_DEBUGGING
+      s7_autoload(sc, make_symbol(sc, "compare-calls", 13), s7_make_string(sc, "compare-calls.scm"));
+      s7_autoload(sc, make_symbol(sc, "get-overheads", 13), s7_make_string(sc, "compare-calls.scm"));
+#endif
+      s7_provide(sc, "libc.scm");
+      if (!repl_loaded) s7_load(sc, "repl.scm");
+      s7_eval_c_string(sc, "((*repl* 'run))");
+    }
+#endif
+#endif
+}
+
+#if WITH_MAIN && (!USE_SND)
+
+#if (!MS_WINDOWS) && WITH_C_LOADER
+static char *realdir(const char *filename) /* this code courtesy Lassi Kortela 4-Nov-19 */
+{
+  char *path;
+  char *p;
+  /* s7_repl wants to load libc_s7.o (for tcsetattr et al), but if it is started in a directory other than the libc_s7.so
+   *   directory, it fails (it tries to build the library but that requires s7.h and libc.scm).  So here we are trying to
+   *   guess the libc_s7 directory from the command line program name.  This can't work in general, but it works often
+   *   enough to be worth the effort.  If S7_LOAD_PATH is set, it is used instead.
+   */
+  if (!strchr(filename, '/'))
+    return(NULL);
+
+  if (!(path = realpath(filename, NULL))) /* in Windows maybe GetModuleFileName(NULL, buffer, buffer_size) */
+    {
+      fprintf(stderr, "%s: %s\n", strerror(errno), filename);
+      exit(2);
+    }
+  if (!(p = strrchr(path, '/')))
+    {
+      free(path);
+      fprintf(stderr, "please provide the full pathname for %s\n", filename);
+      exit(2);
+    }
+  if (p > path) *p = '\0'; else p[1] = 0;
+  return(path);
+}
+#endif
+
+int main(int argc, char **argv)
+{
+  s7_scheme *sc = s7_init();
+  fprintf(stderr, "s7: %s\n", S7_DATE);
+
+  if (argc == 2)
+    {
+      fprintf(stderr, "load %s\n", argv[1]);
+      if (!s7_load(sc, argv[1]))
+	{
+	  fprintf(stderr, "can't load %s\n", argv[1]);
+	  return(2);
+	}}
+  else
+    {
+#if (MS_WINDOWS) || (!WITH_C_LOADER) || ((defined(__linux__)) && (!defined(__GLIBC__))) /* musl? */
+      dumb_repl(sc);
+#else
+#ifdef S7_LOAD_PATH
+      s7_add_to_load_path(sc, S7_LOAD_PATH);
+#else
+      char *dir = realdir(argv[0]);
+      if (dir)
+	{
+	  s7_add_to_load_path(sc, dir);
+	  free(dir);
+	}
+#endif
+      s7_repl(sc);
+#endif
+    }
+  return(0);
+}
+
+/* in Linux:  gcc s7.c -o repl -DWITH_MAIN -I. -O2 -g -ldl -lm -Wl,-export-dynamic ; also need libc.scm cload.scm repl.scm to get a decent repl
+ * in *BSD:   gcc s7.c -o repl -DWITH_MAIN -I. -O2 -g -lm -Wl,-export-dynamic
+ * in OSX:    gcc s7.c -o repl -DWITH_MAIN -I. -O2 -g -lm
+ *   (clang also needs LDFLAGS="-Wl,-export-dynamic" in Linux and "-fPIC")
+ * in msys2:  gcc s7.c -o s7 -DWITH_MAIN -I. -O2 -g -ldl -lm -Wl,-export-all-symbols,--out-implib,s7.lib
+ * for tcc:   tcc -o s7 s7.c -I. -lm -DWITH_MAIN -ldl -rdynamic -DWITH_C_LOADER
+ *
+ * for nrepl: gcc s7.c -o repl -DWITH_MAIN -DWITH_NOTCURSES -I. -O2 -g -lnotcurses-core -ldl -lm -Wl,-export-dynamic
+ *
+ * (s7.c compile time 27-Oct-22 49 secs)
+ * musl works, but there is some problem in libgsl.scm with gsl/gsl_blas.h I think
+ *
+ * valgrind --leak-check=full --show-reachable=no --suppressions=/home/bil/cl/free.supp repl s7test.scm
+ */
+#endif
+#endif
+
+/* --------------------------------------------------------------
+ *           19.0   21.0   22.0   23.0   24.0   24.4
+ * --------------------------------------------------------------
+ * tpeak      148    114    108    105    102    103
+ * tref      1081    687    463    459    464    410
+ * index            1016    973    967    972    971
+ * tmock            1165   1057   1019   1032   1025
+ * tvect     3408   2464   1772   1669   1497   1454
+ * tauto                   2562   2048   1729   1731
+ * texit     1884   1950   1778   1741   1770   1770
+ * s7test           1831   1818   1829   1830   1875
+ * lt        2222   2172   2150   2185   1950   1950
+ * dup              3788   2492   2239   2097   2003
+ * thook     7651          2590   2030   2046   2009
+ * tread            2421   2419   2408   2405   2260
+ * tcopy            5546   2539   2375   2386   2341
+ * titer     3657   2842   2641   2509   2449   2443
+ * trclo     8031   2574   2454   2445   2449   2453
+ * tmat             3042   2524   2578   2590   2515
+ * tload                   3046   2404   2566   2534
+ * fbench    2933   2583   2460   2430   2478   2573
+ * tsort     3683   3104   2856   2804   2858   2858
+ * tio              3752   3683   3620   3583   3127
+ * tobj             3970   3828   3577   3508   3452
+ * teq              4045   3536   3486   3544   3595
+ * tmac             3873   3033   3677   3677   3683
+ * tclo      6362   4735   4390   4384   4474   4345
+ * tcase            4793   4439   4430   4439   4430
+ * tlet      11.0   6974   5609   5980   5965   4500
+ * tfft             7729   4755   4476   4536   4544
+ * tstar            5923   5519   4449   4550   4535
+ * tmap             8774   4489   4541   4586   4590
+ * tshoot           5447   5183   5055   5034   5060
+ * tform            5348   5307   5316   5084   5098
+ * tstr      10.0   6342   5488   5162   5180   5195
+ * tnum             6013   5433   5396   5409   5432
+ * tgsl             7802   6373   6282   6208   6181
+ * tari      15.0   12.7   6827   6543   6278   6184
+ * tlist     9219   7546   6558   6240   6300   6306
+ * tset                           6260   6364   6308
+ * trec      19.5   6922   6521   6588   6583   6584
+ * tleft     11.1   10.2   7657   7479   7627   7615
+ * tmisc                          8142   7631   7694
+ * tlamb                          8003   7941   7956
+ * tgc              11.1   8177   7857   7986   8012
+ * thash            11.7   9734   9479   9526   9256
+ * cb        12.9   11.0   9658   9564   9609   9654
+ * tmap-hash                    1671.0 1467.0   10.3
+ * tgen             11.4   12.0   12.1   12.2   12.3
+ * tall      15.9   15.6   15.6   15.6   15.1   15.1
+ * timp             24.4   20.0   19.6   19.7   15.6
+ * tmv              21.9   21.1   20.7   20.6   17.4
+ * calls            37.5   37.0   37.5   37.1   37.2
+ * sg                      55.9   55.8   55.4   55.4
+ * tbig            175.8  156.5  148.1  146.2  146.1
+ * --------------------------------------------------------------
+ *
+ * snd-region|select: (since we can't check for consistency when set), should there be more elaborate writable checks for default-output-header|sample-type?
+ * fx_chooser can't depend on is_global because it sees args before possible local bindings, get rid of these if possible, lots of is_global(sc->quote_symbol)
+ * (define print-length (list 1 2)) (define (f) (with-let *s7* (+ print-length 1))) (display (f)) (newline) -- need a placeholder-let (or actual let) for *s7*?
+ *   so (with-let *s7* ...) would make a let with whatever *s7* entries are needed? -> (let ((print-length (*s7* 'print-length))) ...)
+ *   currently sc->s7_starlet is a let (make_s7_starlet) using g_s7_let_ref_fallback, so it assumes print-length above is undefined
+ * need some print-length/print-elements distinction for vector/pair etc [which to choose if both set?]
+ * 73317 vars_opt_ok problem
+ * if closure signature exists, add some way to have arg types checked by s7? (*s7* :check-signature?)
+ * opt_p_fx_any, clo_na_to_na, tmv: clo+values etc
+ */
diff --git a/s7/s7.h b/s7/s7.h
new file mode 100644
index 0000000..1ffd3a2
--- /dev/null
+++ b/s7/s7.h
@@ -0,0 +1,1251 @@
+#ifndef S7_H
+#define S7_H
+
+#define S7_VERSION "10.11"
+#define S7_DATE "10-June-2024"
+#define S7_MAJOR_VERSION 10
+#define S7_MINOR_VERSION 11
+
+#include <stdint.h>           /* for int64_t */
+
+typedef int64_t s7_int;
+typedef double s7_double;
+
+#ifndef __cplusplus
+#ifndef _MSC_VER
+  #include <stdbool.h>
+#else
+#ifndef true
+  #define bool	unsigned char
+  #define true	1
+  #define false	0
+#endif
+#endif
+#endif
+
+#if WITH_GMP
+  /* in g++ these includes need to be outside the extern "C" business */
+  #include <gmp.h>
+  #include <mpfr.h>
+  #include <mpc.h>
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+typedef struct s7_scheme s7_scheme;
+typedef struct s7_cell *s7_pointer;
+
+s7_scheme *s7_init(void);
+  /* s7_scheme is our interpreter
+   * s7_pointer is a Scheme object of any (Scheme) type
+   * s7_init creates the interpreter.
+   */
+void s7_free(s7_scheme *sc);
+
+typedef s7_pointer (*s7_function)(s7_scheme *sc, s7_pointer args);   /* that is, obj = func(s7, args) -- args is a list of arguments */
+typedef s7_pointer (*s7_pfunc)(s7_scheme *sc);
+
+s7_pointer s7_f(s7_scheme *sc);                                      /* #f */
+s7_pointer s7_t(s7_scheme *sc);                                      /* #t */
+s7_pointer s7_nil(s7_scheme *sc);                                    /* () */
+s7_pointer s7_undefined(s7_scheme *sc);                              /* #<undefined> */
+s7_pointer s7_unspecified(s7_scheme *sc);                            /* #<unspecified> */
+bool s7_is_unspecified(s7_scheme *sc, s7_pointer val);               /*     returns true if val is #<unspecified> */
+s7_pointer s7_eof_object(s7_scheme *sc);                             /* #<eof> */
+bool s7_is_null(s7_scheme *sc, s7_pointer p);                        /* null? */
+
+  /* these are the Scheme constants; they do not change in value during a run,
+   *   so they can be safely assigned to C global variables if desired.
+   */
+
+bool s7_is_valid(s7_scheme *sc, s7_pointer arg);                     /* does 'arg' look like an s7 object? */
+bool s7_is_c_pointer(s7_pointer arg);                                /* (c-pointer? arg) */
+bool s7_is_c_pointer_of_type(s7_pointer arg, s7_pointer type);
+void *s7_c_pointer(s7_pointer p);
+void *s7_c_pointer_with_type(s7_scheme *sc, s7_pointer p, s7_pointer expected_type, const char *caller, s7_int argnum);
+s7_pointer s7_c_pointer_type(s7_pointer p);
+s7_pointer s7_make_c_pointer(s7_scheme *sc, void *ptr);              /* these are for passing uninterpreted C pointers through Scheme */
+s7_pointer s7_make_c_pointer_with_type(s7_scheme *sc, void *ptr, s7_pointer type, s7_pointer info);
+s7_pointer s7_make_c_pointer_wrapper_with_type(s7_scheme *sc, void *ptr, s7_pointer type, s7_pointer info);
+
+s7_pointer s7_eval_c_string(s7_scheme *sc, const char *str);         /* (eval-string str) */
+s7_pointer s7_eval_c_string_with_environment(s7_scheme *sc, const char *str, s7_pointer e);
+s7_pointer s7_object_to_string(s7_scheme *sc, s7_pointer arg, bool use_write);
+                                                                     /* (object->string obj) */
+char *s7_object_to_c_string(s7_scheme *sc, s7_pointer obj);          /* same as object->string but returns a C char* directly */
+                                                                     /*   the returned value should be freed by the caller */
+
+s7_pointer s7_load(s7_scheme *sc, const char *file);                 /* (load file) */
+s7_pointer s7_load_with_environment(s7_scheme *sc, const char *filename, s7_pointer e);
+s7_pointer s7_load_c_string(s7_scheme *sc, const char *content, s7_int bytes);
+s7_pointer s7_load_c_string_with_environment(s7_scheme *sc, const char *content, s7_int bytes, s7_pointer e);
+s7_pointer s7_load_path(s7_scheme *sc);                              /* *load-path* */
+s7_pointer s7_add_to_load_path(s7_scheme *sc, const char *dir);      /* (set! *load-path* (cons dir *load-path*)) */
+s7_pointer s7_autoload(s7_scheme *sc, s7_pointer symbol, s7_pointer file_or_function);  /* (autoload symbol file-or-function) */
+void s7_autoload_set_names(s7_scheme *sc, const char **names, s7_int size);
+
+  /* the load path is a list of directories to search if load can't find the file passed as its argument.
+   *
+   *   s7_load and s7_load_with_environment can load shared object files as well as scheme code.
+   *   The scheme (load "somelib.so" (inlet 'init_func 'somelib_init)) is equivalent to
+   *     s7_load_with_environment(s7, "somelib.so", s7_inlet(s7, s7_list(s7, 2, s7_make_symbol(s7, "init_func"), s7_make_symbol(s7, "somelib_init"))))
+   *   s7_load_with_environment returns NULL if it can't load the file.
+   */
+void s7_quit(s7_scheme *sc);
+  /* this tries to break out of the current evaluation, leaving everything else intact */
+
+void (*s7_begin_hook(s7_scheme *sc))(s7_scheme *sc, bool *val);
+void s7_set_begin_hook(s7_scheme *sc, void (*hook)(s7_scheme *sc, bool *val));
+  /* call "hook" at the start of any block; use NULL to cancel.
+   *   s7_begin_hook returns the current begin_hook function or NULL.
+   */
+
+s7_pointer s7_eval(s7_scheme *sc, s7_pointer code, s7_pointer e);    /* (eval code e) -- e is the optional environment */
+s7_pointer s7_eval_with_location(s7_scheme *sc, s7_pointer code, s7_pointer e, const char *caller, const char *file, s7_int line);
+void s7_provide(s7_scheme *sc, const char *feature);                 /* add feature (as a symbol) to the *features* list */
+bool s7_is_provided(s7_scheme *sc, const char *feature);             /* (provided? feature) */
+void s7_repl(s7_scheme *sc);
+
+s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info);
+s7_pointer s7_wrong_type_arg_error(s7_scheme *sc, const char *caller, s7_int arg_n, s7_pointer arg, const char *descr);
+s7_pointer s7_wrong_type_error(s7_scheme *sc, s7_pointer caller, s7_int arg_n, s7_pointer arg, s7_pointer descr);
+  /* set arg_n to 0 to indicate that caller takes only one argument (so the argument number need not be reported */
+s7_pointer s7_out_of_range_error(s7_scheme *sc, const char *caller, s7_int arg_n, s7_pointer arg, const char *descr);
+s7_pointer s7_wrong_number_of_args_error(s7_scheme *sc, const char *caller, s7_pointer args);
+
+  /* these are equivalent to (error ...) in Scheme
+   *   the first argument to s7_error is a symbol that can be caught (via (catch tag ...))
+   *   the rest of the arguments are passed to the error handler (if in catch)
+   *   or printed out (in the default case).  If the first element of the list
+   *   of args ("info") is a string, the default error handler treats it as
+   *   a format control string, and passes it to format with the rest of the
+   *   info list as the format function arguments.
+   *
+   *   s7_wrong_type_arg_error is equivalent to s7_error with a type of 'wrong-type-arg
+   *   and similarly s7_out_of_range_error with type 'out-of-range.
+   *
+   * catch in Scheme is taken from Guile:
+   *
+   *  (catch tag thunk handler)
+   *
+   *  evaluates 'thunk'.  If an error occurs, and the type matches 'tag' (or if 'tag' is #t),
+   *  the handler is called, passing it the arguments (including the type) passed to the
+   *  error function.  If no handler is found, the default error handler is called,
+   *  normally printing the error arguments to current-error-port.
+   */
+
+s7_pointer s7_stacktrace(s7_scheme *sc);
+s7_pointer s7_history(s7_scheme *sc);                                /* the current (circular backwards) history buffer */
+s7_pointer s7_add_to_history(s7_scheme *sc, s7_pointer entry);       /* add entry to the history buffer */
+bool s7_history_enabled(s7_scheme *sc);
+bool s7_set_history_enabled(s7_scheme *sc, bool enabled);
+
+s7_pointer s7_gc_on(s7_scheme *sc, bool on);                         /* (gc on) */
+
+s7_int s7_gc_protect(s7_scheme *sc, s7_pointer x);
+void s7_gc_unprotect_at(s7_scheme *sc, s7_int loc);
+s7_pointer s7_gc_protected_at(s7_scheme *sc, s7_int loc);
+s7_pointer s7_gc_protect_via_stack(s7_scheme *sc, s7_pointer x);
+s7_pointer s7_gc_protect_2_via_stack(s7_scheme *sc, s7_pointer x, s7_pointer y);
+s7_pointer s7_gc_unprotect_via_stack(s7_scheme *sc, s7_pointer x);
+s7_pointer s7_gc_protect_via_location(s7_scheme *sc, s7_pointer x, s7_int loc);
+s7_pointer s7_gc_unprotect_via_location(s7_scheme *sc, s7_int loc);
+
+  /* any s7_pointer object held in C (as a local variable for example) needs to be
+   *   protected from garbage collection if there is any chance the GC may run without
+   *   an existing Scheme-level reference to that object.  s7_gc_protect places the
+   *   object in a vector that the GC always checks, returning the object's location
+   *   in that table.  s7_gc_unprotect_at unprotects the object (removes it from the
+   *   vector) using the location passed to it.  s7_gc_protected_at returns the object
+   *   at the given location.
+   *
+   * You can turn the GC on and off via s7_gc_on.
+   *
+   * There is a built-in lag between the creation of a new object and its first possible GC
+   *    (the lag time is set indirectly by GC_TEMPS_SIZE in s7.c), so you don't need to worry about
+   *    very short term temps such as the arguments to s7_cons in:
+   *
+   *    s7_cons(s7, s7_make_real(s7, 3.14),
+   *                s7_cons(s7, s7_make_integer(s7, 123), s7_nil(s7)));
+   */
+
+bool s7_is_eq(s7_pointer a, s7_pointer b);                                   /* (eq? a b) */
+bool s7_is_eqv(s7_scheme *sc, s7_pointer a, s7_pointer b);                   /* (eqv? a b) */
+bool s7_is_equal(s7_scheme *sc, s7_pointer a, s7_pointer b);                 /* (equal? a b) */
+bool s7_is_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y);            /* (equivalent? x y) */
+
+bool s7_is_boolean(s7_pointer x);                                            /* (boolean? x) */
+bool s7_boolean(s7_scheme *sc, s7_pointer x);                                /* Scheme boolean -> C bool */
+s7_pointer s7_make_boolean(s7_scheme *sc, bool x);                           /* C bool -> Scheme boolean */
+
+  /* for each Scheme type (boolean, integer, string, etc), there are three
+   *   functions: s7_<type>(...), s7_make_<type>(...), and s7_is_<type>(...):
+   *
+   *   s7_boolean(s7, obj) returns the C bool corresponding to the value of 'obj' (#f -> false)
+   *   s7_make_boolean(s7, false|true) returns the s7 boolean corresponding to the C bool argument (false -> #f)
+   *   s7_is_boolean(s7, obj) returns true if 'obj' has a boolean value (#f or #t).
+   */
+
+
+bool s7_is_pair(s7_pointer p);                                               /* (pair? p) */
+s7_pointer s7_cons(s7_scheme *sc, s7_pointer a, s7_pointer b);               /* (cons a b) */
+
+s7_pointer s7_car(s7_pointer p);                                             /* (car p) */
+s7_pointer s7_cdr(s7_pointer p);                                             /* (cdr p) */
+
+s7_pointer s7_set_car(s7_pointer p, s7_pointer q);                           /* (set-car! p q) */
+s7_pointer s7_set_cdr(s7_pointer p, s7_pointer q);                           /* (set-cdr! p q) */
+
+s7_pointer s7_cadr(s7_pointer p);                                            /* (cadr p) */
+s7_pointer s7_cddr(s7_pointer p);                                            /* (cddr p) */
+s7_pointer s7_cdar(s7_pointer p);                                            /* (cdar p) */
+s7_pointer s7_caar(s7_pointer p);                                            /* (caar p) */
+
+s7_pointer s7_caadr(s7_pointer p);                                           /* etc */
+s7_pointer s7_caddr(s7_pointer p);
+s7_pointer s7_cadar(s7_pointer p);
+s7_pointer s7_caaar(s7_pointer p);
+s7_pointer s7_cdadr(s7_pointer p);
+s7_pointer s7_cdddr(s7_pointer p);
+s7_pointer s7_cddar(s7_pointer p);
+s7_pointer s7_cdaar(s7_pointer p);
+
+s7_pointer s7_caaadr(s7_pointer p);
+s7_pointer s7_caaddr(s7_pointer p);
+s7_pointer s7_caadar(s7_pointer p);
+s7_pointer s7_caaaar(s7_pointer p);
+s7_pointer s7_cadadr(s7_pointer p);
+s7_pointer s7_cadddr(s7_pointer p);
+s7_pointer s7_caddar(s7_pointer p);
+s7_pointer s7_cadaar(s7_pointer p);
+s7_pointer s7_cdaadr(s7_pointer p);
+s7_pointer s7_cdaddr(s7_pointer p);
+s7_pointer s7_cdadar(s7_pointer p);
+s7_pointer s7_cdaaar(s7_pointer p);
+s7_pointer s7_cddadr(s7_pointer p);
+s7_pointer s7_cddddr(s7_pointer p);
+s7_pointer s7_cdddar(s7_pointer p);
+s7_pointer s7_cddaar(s7_pointer p);
+
+bool s7_is_list(s7_scheme *sc, s7_pointer p);                                /* (list? p) -> (or (pair? p) (null? p)) */
+bool s7_is_proper_list(s7_scheme *sc, s7_pointer p);                         /* (proper-list? p) */
+s7_int s7_list_length(s7_scheme *sc, s7_pointer a);                          /* (length a) */
+s7_pointer s7_make_list(s7_scheme *sc, s7_int len, s7_pointer init);         /* (make-list len init) */
+s7_pointer s7_list(s7_scheme *sc, s7_int num_values, ...);                   /* (list ...) */
+s7_pointer s7_list_nl(s7_scheme *sc, s7_int num_values, ...);                /* (list ...) arglist should be NULL terminated (more error checks than s7_list) */
+s7_pointer s7_array_to_list(s7_scheme *sc, s7_int num_values, s7_pointer *array); /* array contents -> list */
+void s7_list_to_array(s7_scheme *sc, s7_pointer list, s7_pointer *array, int32_t len); /* list -> array (intended for old code) */
+s7_pointer s7_reverse(s7_scheme *sc, s7_pointer a);                          /* (reverse a) */
+s7_pointer s7_append(s7_scheme *sc, s7_pointer a, s7_pointer b);             /* (append a b) */
+s7_pointer s7_list_ref(s7_scheme *sc, s7_pointer lst, s7_int num);           /* (list-ref lst num) */
+s7_pointer s7_list_set(s7_scheme *sc, s7_pointer lst, s7_int num, s7_pointer val); /* (list-set! lst num val) */
+s7_pointer s7_assoc(s7_scheme *sc, s7_pointer obj, s7_pointer lst);          /* (assoc obj lst) */
+s7_pointer s7_assq(s7_scheme *sc, s7_pointer obj, s7_pointer x);             /* (assq obj lst) */
+s7_pointer s7_member(s7_scheme *sc, s7_pointer obj, s7_pointer lst);         /* (member obj lst) */
+s7_pointer s7_memq(s7_scheme *sc, s7_pointer obj, s7_pointer x);             /* (memq obj lst) */
+bool s7_tree_memq(s7_scheme *sc, s7_pointer sym, s7_pointer tree);           /* (tree-memq sym tree) */
+
+
+bool s7_is_string(s7_pointer p);                                             /* (string? p) */
+const char *s7_string(s7_pointer p);                                         /* Scheme string -> C string (do not free the string) */
+s7_pointer s7_make_string(s7_scheme *sc, const char *str);                   /* C string -> Scheme string (str is copied) */
+s7_pointer s7_make_string_with_length(s7_scheme *sc, const char *str, s7_int len);  /* same as s7_make_string, but provides strlen */
+s7_pointer s7_make_string_wrapper(s7_scheme *sc, const char *str);
+s7_pointer s7_make_string_wrapper_with_length(s7_scheme *sc, const char *str, s7_int len);
+s7_pointer s7_make_permanent_string(s7_scheme *sc, const char *str);         /* make a string that will never be GC'd */
+s7_pointer s7_make_semipermanent_string(s7_scheme *sc, const char *str);     /* for (s7) string permanent within one s7 instance (freed upon s7_free) */
+s7_int s7_string_length(s7_pointer str);                                     /* (string-length str) */
+
+
+bool s7_is_character(s7_pointer p);                                          /* (character? p) */
+uint8_t s7_character(s7_pointer p);                                          /* Scheme character -> unsigned C char */
+s7_pointer s7_make_character(s7_scheme *sc, uint8_t c);                      /* unsigned C char -> Scheme character */
+
+
+bool s7_is_number(s7_pointer p);                                             /* (number? p) */
+bool s7_is_integer(s7_pointer p);                                            /* (integer? p) */
+s7_int s7_integer(s7_pointer p);                                             /* Scheme integer -> C integer (s7_int) */
+s7_pointer s7_make_integer(s7_scheme *sc, s7_int num);                       /* C s7_int -> Scheme integer */
+
+bool s7_is_real(s7_pointer p);                                               /* (real? p) */
+s7_double s7_real(s7_pointer p);                                             /* Scheme real -> C double */
+s7_pointer s7_make_real(s7_scheme *sc, s7_double num);                       /* C double -> Scheme real */
+s7_pointer s7_make_mutable_real(s7_scheme *sc, s7_double n);
+s7_double s7_number_to_real(s7_scheme *sc, s7_pointer x);                    /* x can be any kind of number */
+s7_double s7_number_to_real_with_caller(s7_scheme *sc, s7_pointer x, const char *caller);
+s7_double s7_number_to_real_with_location(s7_scheme *sc, s7_pointer x, s7_pointer caller);
+s7_int s7_number_to_integer(s7_scheme *sc, s7_pointer x);
+s7_int s7_number_to_integer_with_caller(s7_scheme *sc, s7_pointer x, const char *caller);
+
+bool s7_is_rational(s7_pointer arg);                                        /* (rational? arg) -- integer or ratio */
+bool s7_is_ratio(s7_pointer arg);                                           /* true if arg is a ratio, not an integer */
+s7_pointer s7_make_ratio(s7_scheme *sc, s7_int a, s7_int b);                /* returns the Scheme object a/b */
+s7_pointer s7_rationalize(s7_scheme *sc, s7_double x, s7_double error);     /* (rationalize x error) */
+s7_int s7_numerator(s7_pointer x);                                          /* (numerator x) */
+s7_int s7_denominator(s7_pointer x);                                        /* (denominator x) */
+s7_double s7_random(s7_scheme *sc, s7_pointer state);                       /* (random x) */
+s7_pointer s7_random_state(s7_scheme *sc, s7_pointer seed);                 /* (random-state seed) */
+s7_pointer s7_random_state_to_list(s7_scheme *sc, s7_pointer args);         /* (random-state->list r) */
+void s7_set_default_random_state(s7_scheme *sc, s7_int seed, s7_int carry);
+bool s7_is_random_state(s7_pointer p);                                      /* (random-state? p) */
+
+bool s7_is_complex(s7_pointer arg);                                         /* (complex? arg) */
+s7_pointer s7_make_complex(s7_scheme *sc, s7_double a, s7_double b);        /* returns the Scheme object a+bi */
+s7_double s7_real_part(s7_pointer z);                                       /* (real-part z) */
+s7_double s7_imag_part(s7_pointer z);                                       /* (imag-part z) */
+char *s7_number_to_string(s7_scheme *sc, s7_pointer obj, s7_int radix);     /* (number->string obj radix) */
+
+bool s7_is_vector(s7_pointer p);                                            /* (vector? p) */
+s7_int s7_vector_length(s7_pointer vec);                                    /* (vector-length vec) */
+s7_int s7_vector_rank(s7_pointer vect);                                     /* number of dimensions in vect */
+s7_int s7_vector_dimension(s7_pointer vec, s7_int dim);
+s7_pointer *s7_vector_elements(s7_pointer vec);                             /* a pointer to the array of s7_pointers */
+s7_int *s7_int_vector_elements(s7_pointer vec);
+uint8_t *s7_byte_vector_elements(s7_pointer vec);
+s7_double *s7_float_vector_elements(s7_pointer vec);
+bool s7_is_float_vector(s7_pointer p);                                      /* (float-vector? p) */
+bool s7_is_int_vector(s7_pointer p);                                        /* (int-vector? p) */
+bool s7_is_byte_vector(s7_pointer p);                                       /* (byte-vector? p) */
+
+s7_pointer s7_vector_ref(s7_scheme *sc, s7_pointer vec, s7_int index);                            /* (vector-ref vec index) */
+s7_pointer s7_vector_set(s7_scheme *sc, s7_pointer vec, s7_int index, s7_pointer a);              /* (vector-set! vec index a) */
+s7_pointer s7_vector_ref_n(s7_scheme *sc, s7_pointer vector, s7_int indices, ...);                   /* multidimensional vector-ref */
+s7_pointer s7_vector_set_n(s7_scheme *sc, s7_pointer vector, s7_pointer value, s7_int indices, ...); /* multidimensional vector-set! */
+s7_int s7_vector_dimensions(s7_pointer vec, s7_int *dims, s7_int dims_size); /* vector dimensions */
+s7_int s7_vector_offsets(s7_pointer vec, s7_int *offs, s7_int offs_size);
+
+s7_int s7_int_vector_ref(s7_pointer vec, s7_int index);
+s7_int s7_int_vector_set(s7_pointer vec, s7_int index, s7_int value);
+uint8_t s7_byte_vector_ref(s7_pointer vec, s7_int index);
+uint8_t s7_byte_vector_set(s7_pointer vec, s7_int index, uint8_t value);
+s7_double s7_float_vector_ref(s7_pointer vec, s7_int index);
+s7_double s7_float_vector_set(s7_pointer vec, s7_int index, s7_double value);
+
+s7_pointer s7_make_vector(s7_scheme *sc, s7_int len);                                 /* (make-vector len) */
+s7_pointer s7_make_int_vector(s7_scheme *sc, s7_int len, s7_int dims, s7_int *dim_info);
+s7_pointer s7_make_byte_vector(s7_scheme *sc, s7_int len, s7_int dims, s7_int *dim_info);
+s7_pointer s7_make_float_vector(s7_scheme *sc, s7_int len, s7_int dims, s7_int *dim_info);
+s7_pointer s7_make_normal_vector(s7_scheme *sc, s7_int len, s7_int dims, s7_int *dim_info); /* make-vector but possibly multidimensional */
+s7_pointer s7_make_float_vector_wrapper(s7_scheme *sc, s7_int len, s7_double *data, s7_int dims, s7_int *dim_info, bool free_data);
+s7_pointer s7_make_and_fill_vector(s7_scheme *sc, s7_int len, s7_pointer fill);       /* (make-vector len fill) */
+
+void s7_vector_fill(s7_scheme *sc, s7_pointer vec, s7_pointer obj);                   /* (vector-fill! vec obj) */
+s7_pointer s7_vector_copy(s7_scheme *sc, s7_pointer old_vect);
+s7_pointer s7_vector_to_list(s7_scheme *sc, s7_pointer vect);                         /* (vector->list vec) */
+  /*
+   *  (vect i) is the same as (vector-ref vect i)
+   *  (set! (vect i) x) is the same as (vector-set! vect i x)
+   *  (vect i j k) accesses the 3-dimensional vect
+   *  (set! (vect i j k) x) sets that element (vector-ref and vector-set! can also be used)
+   *  (make-vector (list 2 3 4)) returns a 3-dimensional vector with the given dimension sizes
+   *  (make-vector '(2 3) 1.0) returns a 2-dim vector with all elements set to 1.0
+   */
+
+bool s7_is_hash_table(s7_pointer p);                                        /* (hash-table? p) */
+s7_pointer s7_make_hash_table(s7_scheme *sc, s7_int size);                  /* (make-hash-table size) */
+s7_pointer s7_hash_table_ref(s7_scheme *sc, s7_pointer table, s7_pointer key);
+                                                                            /* (hash-table-ref table key) */
+s7_pointer s7_hash_table_set(s7_scheme *sc, s7_pointer table, s7_pointer key, s7_pointer value);
+                                                                            /* (hash-table-set! table key value) */
+s7_int s7_hash_code(s7_scheme *sc, s7_pointer obj, s7_pointer eqfunc);      /* (hash-code obj [eqfunc]) */
+
+s7_pointer s7_hook_functions(s7_scheme *sc, s7_pointer hook);                              /* (hook-functions hook) */
+s7_pointer s7_hook_set_functions(s7_scheme *sc, s7_pointer hook, s7_pointer functions);    /* (set! (hook-functions hook) ...) */
+
+
+bool s7_is_input_port(s7_scheme *sc, s7_pointer p);                         /* (input-port? p) */
+bool s7_is_output_port(s7_scheme *sc, s7_pointer p);                        /* (output-port? p) */
+const char *s7_port_filename(s7_scheme *sc, s7_pointer x);                  /* (port-filename p) */
+s7_int s7_port_line_number(s7_scheme *sc, s7_pointer p);                    /* (port-line-number p) */
+
+s7_pointer s7_current_input_port(s7_scheme *sc);                            /* (current-input-port) */
+s7_pointer s7_set_current_input_port(s7_scheme *sc, s7_pointer p);          /* (set-current-input-port) */
+s7_pointer s7_current_output_port(s7_scheme *sc);                           /* (current-output-port) */
+s7_pointer s7_set_current_output_port(s7_scheme *sc, s7_pointer p);         /* (set-current-output-port) */
+s7_pointer s7_current_error_port(s7_scheme *sc);                            /* (current-error-port) */
+s7_pointer s7_set_current_error_port(s7_scheme *sc, s7_pointer port);       /* (set-current-error-port port) */
+void s7_close_input_port(s7_scheme *sc, s7_pointer p);                      /* (close-input-port p) */
+void s7_close_output_port(s7_scheme *sc, s7_pointer p);                     /* (close-output-port p) */
+s7_pointer s7_open_input_file(s7_scheme *sc, const char *name, const char *mode);
+                                                                            /* (open-input-file name mode) */
+s7_pointer s7_open_output_file(s7_scheme *sc, const char *name, const char *mode);
+                                                                            /* (open-output-file name mode) */
+  /* mode here is an optional C style flag, "a" for "alter", etc ("r" is the input default, "w" is the output default) */
+s7_pointer s7_open_input_string(s7_scheme *sc, const char *input_string);
+                                                                            /* (open-input-string str) */
+s7_pointer s7_open_output_string(s7_scheme *sc);                            /* (open-output-string) */
+const char *s7_get_output_string(s7_scheme *sc, s7_pointer out_port);       /* (get-output-string port) -- current contents of output string */
+  /*    don't free the string */
+s7_pointer s7_output_string(s7_scheme *sc, s7_pointer p);                   /*    same but returns an s7 string */
+bool s7_flush_output_port(s7_scheme *sc, s7_pointer p);                     /* (flush-output-port port) */
+
+typedef enum {S7_READ, S7_READ_CHAR, S7_READ_LINE, S7_PEEK_CHAR, S7_IS_CHAR_READY, S7_NUM_READ_CHOICES} s7_read_t;
+s7_pointer s7_open_output_function(s7_scheme *sc, void (*function)(s7_scheme *sc, uint8_t c, s7_pointer port));
+s7_pointer s7_open_input_function(s7_scheme *sc, s7_pointer (*function)(s7_scheme *sc, s7_read_t read_choice, s7_pointer port));
+
+s7_pointer s7_read_char(s7_scheme *sc, s7_pointer port);                    /* (read-char port) */
+s7_pointer s7_peek_char(s7_scheme *sc, s7_pointer port);                    /* (peek-char port) */
+s7_pointer s7_read(s7_scheme *sc, s7_pointer port);                         /* (read port) */
+void s7_newline(s7_scheme *sc, s7_pointer port);                            /* (newline port) */
+s7_pointer s7_write_char(s7_scheme *sc, s7_pointer c, s7_pointer port);     /* (write-char c port) */
+s7_pointer s7_write(s7_scheme *sc, s7_pointer obj, s7_pointer port);        /* (write obj port) */
+s7_pointer s7_display(s7_scheme *sc, s7_pointer obj, s7_pointer port);      /* (display obj port) */
+const char *s7_format(s7_scheme *sc, s7_pointer args);                      /* (format ... */
+
+
+bool s7_is_syntax(s7_pointer p);                                            /* (syntax? p) */
+bool s7_is_symbol(s7_pointer p);                                            /* (symbol? p) */
+const char *s7_symbol_name(s7_pointer p);                                   /* (symbol->string p) -- don't free the string */
+s7_pointer s7_make_symbol(s7_scheme *sc, const char *name);                 /* (string->symbol name) */
+s7_pointer s7_gensym(s7_scheme *sc, const char *prefix);                    /* (gensym prefix) */
+
+bool s7_is_keyword(s7_pointer obj);                                         /* (keyword? obj) */
+s7_pointer s7_make_keyword(s7_scheme *sc, const char *key);                 /* (string->keyword key) */
+s7_pointer s7_keyword_to_symbol(s7_scheme *sc, s7_pointer key);             /* (keyword->symbol key) */
+
+s7_pointer s7_rootlet(s7_scheme *sc);                                       /* (rootlet) */
+s7_pointer s7_shadow_rootlet(s7_scheme *sc);
+s7_pointer s7_set_shadow_rootlet(s7_scheme *sc, s7_pointer let);
+s7_pointer s7_curlet(s7_scheme *sc);                                        /* (curlet) */
+s7_pointer s7_set_curlet(s7_scheme *sc, s7_pointer e);                      /* returns previous curlet */
+s7_pointer s7_outlet(s7_scheme *sc, s7_pointer e);                          /* (outlet e) */
+s7_pointer s7_sublet(s7_scheme *sc, s7_pointer env, s7_pointer bindings);   /* (sublet e ...) */
+s7_pointer s7_inlet(s7_scheme *sc, s7_pointer bindings);                    /* (inlet ...) */
+s7_pointer s7_varlet(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value); /* (varlet env symbol value) */
+s7_pointer s7_let_to_list(s7_scheme *sc, s7_pointer env);                   /* (let->list env) */
+bool s7_is_let(s7_pointer e);                                               /* )let? e) */
+s7_pointer s7_let_ref(s7_scheme *sc, s7_pointer env, s7_pointer sym);       /* (let-ref e sym) */
+s7_pointer s7_let_set(s7_scheme *sc, s7_pointer env, s7_pointer sym, s7_pointer val); /* (let-set! e sym val) */
+s7_pointer s7_openlet(s7_scheme *sc, s7_pointer e);                         /* (openlet e) */
+bool s7_is_openlet(s7_pointer e);                                           /* (openlet? e) */
+s7_pointer s7_method(s7_scheme *sc, s7_pointer obj, s7_pointer method);
+
+/* *s7* */
+/* these renamed because "s7_let_field" seems the same as "s7_let", but here we're referring to *s7*, not any let */
+s7_pointer s7_let_field_ref(s7_scheme *sc, s7_pointer sym);               /* (*s7* sym) */
+s7_pointer s7_let_field_set(s7_scheme *sc, s7_pointer sym, s7_pointer new_value); /* (set! (*s7* sym) new_value) */
+/* new names */
+s7_pointer s7_starlet_ref(s7_scheme *sc, s7_pointer sym);                   /* (*s7* sym) */
+s7_pointer s7_starlet_set(s7_scheme *sc, s7_pointer sym, s7_pointer new_value); /* (set! (*s7* sym) new_value) */
+
+s7_pointer s7_name_to_value(s7_scheme *sc, const char *name);               /* name's value in the current environment (after turning name into a symbol) */
+s7_pointer s7_symbol_table_find_name(s7_scheme *sc, const char *name);
+s7_pointer s7_symbol_value(s7_scheme *sc, s7_pointer sym);
+s7_pointer s7_symbol_set_value(s7_scheme *sc, s7_pointer sym, s7_pointer val);
+s7_pointer s7_symbol_local_value(s7_scheme *sc, s7_pointer sym, s7_pointer local_env);
+s7_pointer s7_symbol_initial_value(s7_pointer symbol);                      /* #_symbol's value */
+s7_pointer s7_symbol_set_initial_value(s7_scheme *sc, s7_pointer symbol, s7_pointer value);
+
+bool s7_for_each_symbol_name(s7_scheme *sc, bool (*symbol_func)(const char *symbol_name, void *data), void *data);
+bool s7_for_each_symbol(s7_scheme *sc, bool (*symbol_func)(const char *symbol_name, void *data), void *data);
+
+  /* these access the current environment and symbol table, providing
+   *   a symbol's current binding (s7_name_to_value takes the symbol name as a char*,
+   *   s7_symbol_value takes the symbol itself, s7_symbol_set_value changes the
+   *   current binding, and s7_symbol_local_value uses the environment passed
+   *   as its third argument).
+   *
+   * To iterate over the complete symbol table, use s7_for_each_symbol_name,
+   *   and s7_for_each_symbol.  Both call 'symbol_func' on each symbol, passing it
+   *   the symbol or symbol name, and the uninterpreted 'data' pointer.
+   *   the current binding. The for-each loop stops if the symbol_func returns true,
+   *   or at the end of the table.
+   */
+
+s7_pointer s7_dynamic_wind(s7_scheme *sc, s7_pointer init, s7_pointer body, s7_pointer finish);
+
+bool s7_is_immutable(s7_pointer p);
+s7_pointer s7_immutable(s7_pointer p);
+
+void s7_define(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value);
+bool s7_is_defined(s7_scheme *sc, const char *name);
+s7_pointer s7_define_variable(s7_scheme *sc, const char *name, s7_pointer value);
+s7_pointer s7_define_variable_with_documentation(s7_scheme *sc, const char *name, s7_pointer value, const char *help);
+s7_pointer s7_define_constant(s7_scheme *sc, const char *name, s7_pointer value);
+s7_pointer s7_define_constant_with_documentation(s7_scheme *sc, const char *name, s7_pointer value, const char *help);
+s7_pointer s7_define_constant_with_environment(s7_scheme *sc, s7_pointer envir, const char *name, s7_pointer value);
+  /* These functions add a symbol and its binding to either the top-level environment
+   *    or the 'env' passed as the second argument to s7_define.  Except for s7_define, they return
+   *    the name as a symbol.
+   *
+   *    s7_define_variable(sc, "*features*", s7_nil(sc));
+   *
+   * in s7.c is equivalent to the top level form
+   *
+   *    (define *features* ())
+   *
+   * s7_define_variable is simply s7_define with string->symbol and the global environment.
+   * s7_define_constant is s7_define but makes its "definee" immutable.
+   * s7_define is equivalent to define in Scheme, except that it does not return the value.
+   */
+
+bool s7_is_function(s7_pointer p);
+bool s7_is_procedure(s7_pointer x);                                         /* (procedure? x) */
+bool s7_is_macro(s7_scheme *sc, s7_pointer x);                              /* (macro? x) */
+s7_pointer s7_closure_body(s7_scheme *sc, s7_pointer p);
+s7_pointer s7_closure_let(s7_scheme *sc, s7_pointer p);
+s7_pointer s7_closure_args(s7_scheme *sc, s7_pointer p);
+s7_pointer s7_funclet(s7_scheme *sc, s7_pointer p);                         /* (funclet x) */
+bool s7_is_aritable(s7_scheme *sc, s7_pointer x, s7_int args);              /* (aritable? x args) */
+s7_pointer s7_arity(s7_scheme *sc, s7_pointer x);                           /* (arity x) */
+const char *s7_help(s7_scheme *sc, s7_pointer obj);                         /* (help obj) */
+s7_pointer s7_make_continuation(s7_scheme *sc);                             /* call/cc... (see example below) */
+
+const char *s7_documentation(s7_scheme *sc, s7_pointer p);                  /* (documentation x) if any (don't free the string) */
+const char *s7_set_documentation(s7_scheme *sc, s7_pointer p, const char *new_doc);
+s7_pointer s7_setter(s7_scheme *sc, s7_pointer obj);                        /* (setter obj) */
+s7_pointer s7_set_setter(s7_scheme *sc, s7_pointer p, s7_pointer setter);   /* (set! (setter p) setter) */
+s7_pointer s7_signature(s7_scheme *sc, s7_pointer func);                    /* (signature obj) */
+s7_pointer s7_make_signature(s7_scheme *sc, s7_int len, ...);               /* procedure-signature data */
+s7_pointer s7_make_circular_signature(s7_scheme *sc, s7_int cycle_point, s7_int len, ...);
+
+/* possibly unsafe functions: */
+s7_pointer s7_make_function(s7_scheme *sc, const char *name, s7_function fnc, s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc);
+
+/* safe functions: */
+s7_pointer s7_make_safe_function(s7_scheme *sc, const char *name, s7_function fnc, s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc);
+s7_pointer s7_make_typed_function(s7_scheme *sc, const char *name, s7_function f,
+				  s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc, s7_pointer signature);
+
+/* arglist or body possibly unsafe: */
+s7_pointer s7_define_function(s7_scheme *sc, const char *name, s7_function fnc, s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc);
+
+/* arglist and body safe: */
+s7_pointer s7_define_safe_function(s7_scheme *sc, const char *name, s7_function fnc, s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc);
+s7_pointer s7_define_typed_function(s7_scheme *sc, const char *name, s7_function fnc,
+				    s7_int required_args, s7_int optional_args, bool rest_arg,
+				    const char *doc, s7_pointer signature);
+
+/* arglist unsafe or body unsafe: */
+s7_pointer s7_define_unsafe_typed_function(s7_scheme *sc, const char *name, s7_function fnc,
+					   s7_int required_args, s7_int optional_args, bool rest_arg,
+					   const char *doc, s7_pointer signature);
+
+/* arglist safe, body possibly unsafe: */
+s7_pointer s7_define_semisafe_typed_function(s7_scheme *sc, const char *name, s7_function fnc,
+					     s7_int required_args, s7_int optional_args, bool rest_arg,
+					     const char *doc, s7_pointer signature);
+
+s7_pointer s7_make_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc);
+s7_pointer s7_make_safe_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc);
+void s7_define_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc);
+void s7_define_safe_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc);
+void s7_define_typed_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc, s7_pointer signature);
+s7_pointer s7_define_macro(s7_scheme *sc, const char *name, s7_function fnc, s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc);
+
+  /* s7_make_function creates a Scheme function object from the s7_function 'fnc'.
+   *   Its name (for s7_describe_object) is 'name', it requires 'required_args' arguments,
+   *   can accept 'optional_args' other arguments, and if 'rest_arg' is true, it accepts
+   *   a "rest" argument (a list of all the trailing arguments).  The function's documentation
+   *   is 'doc'.  The s7_make_functions return the new function, but the s7_define_function (and macro)
+   *   procedures return the name as a symbol (a desire for backwards compatibility brought about this split).
+   *
+   * s7_define_function is the same as s7_make_function, but it also adds 'name' (as a symbol) to the
+   *   global (top-level) environment, with the function as its value (and returns the symbol, not the function).
+   *   For example, the Scheme function 'car' is essentially:
+   *
+   *     s7_pointer g_car(s7_scheme *sc, s7_pointer args) {return(s7_car(s7_car(args)));}
+   *
+   *   then bound to the name "car":
+   *
+   *     s7_define_function(sc, "car", g_car, 1, 0, false, "(car obj)");
+   *                                          ^ one required arg, no optional arg, no "rest" arg
+   *
+   * s7_is_function returns true if its argument is a function defined in this manner.
+   * s7_apply_function applies the function (the result of s7_make_function) to the arguments.
+   *
+   * s7_define_macro defines a Scheme macro; its arguments are not evaluated (unlike a function),
+   *   but the macro's returned value (assumed to be some sort of Scheme expression) is evaluated.
+   *   s7_define_macro returns the name as a symbol.
+   *
+   * Use the "unsafe" definer if the function might call the evaluator itself in some way (s7_apply_function for example),
+   *   or messes with s7's stack.
+   */
+
+  /* In s7, (define* (name . args) body) or (define name (lambda* args body))
+   *   define a function that takes optional (keyword) named arguments.
+   *   The "args" is a list that can contain either names (normal arguments),
+   *   or lists of the form (name default-value), in any order.  When called,
+   *   the names are bound to their default values (or #f), then the function's
+   *   current arglist is scanned.  Any name that occurs as a keyword (":name")
+   *   precedes that argument's new value.  Otherwise, as values occur, they
+   *   are plugged into the environment based on their position in the arglist
+   *   (as normal for a function).  So,
+   *
+   *   (define* (hi a (b 32) (c "hi")) (list a b c))
+   *     (hi 1) -> '(1 32 "hi")
+   *     (hi :b 2 :a 3) -> '(3 2 "hi")
+   *     (hi 3 2 1) -> '(3 2 1)
+   *
+   *   :rest causes its argument to be bound to the rest of the arguments at that point.
+   *
+   * The C connection to this takes the function name, the C function to call, the argument
+   *   list as written in Scheme, and the documentation string.  s7 makes sure the arguments
+   *   are ordered correctly and have the specified defaults before calling the C function.
+   *     s7_define_function_star(sc, "a-func", a_func, "arg1 (arg2 32)", "an example of C define*");
+   *   Now (a-func :arg1 2) calls the C function a_func(2, 32). See the example program in s7.html.
+   *
+   * In s7 Scheme, define* can be used just for its optional arguments feature, but that is
+   *   included in s7_define_function.  s7_define_function_star implements keyword arguments
+   *   for C-level functions (as well as optional/rest arguments).
+   */
+
+s7_pointer s7_apply_function(s7_scheme *sc, s7_pointer fnc, s7_pointer args);
+s7_pointer s7_apply_function_star(s7_scheme *sc, s7_pointer fnc, s7_pointer args);
+
+s7_pointer s7_call(s7_scheme *sc, s7_pointer func, s7_pointer args);
+s7_pointer s7_call_with_location(s7_scheme *sc, s7_pointer func, s7_pointer args, const char *caller, const char *file, s7_int line);
+s7_pointer s7_call_with_catch(s7_scheme *sc, s7_pointer tag, s7_pointer body, s7_pointer error_handler);
+
+  /* s7_call takes a Scheme function and applies it to 'args' (a list of arguments) returning the result.
+   *   s7_pointer kar;
+   *   kar = s7_make_function(sc, "car", g_car, 1, 0, false, "(car obj)");
+   *   s7_integer(s7_call(sc, kar, s7_cons(sc, s7_cons(sc, s7_make_integer(sc, 123), s7_nil(sc)), s7_nil(sc))));
+   *   returns 123.
+   *
+   * s7_call_with_location passes some information to the error handler.
+   * s7_call makes sure some sort of catch exists if an error occurs during the call, but
+   *   s7_apply_function does not -- it assumes the catch has been set up already.
+   * s7_call_with_catch wraps an explicit catch around a function call ("body" above);
+   *   s7_call_with_catch(sc, tag, body, err) is equivalent to (catch tag body err).
+   */
+
+bool s7_is_dilambda(s7_pointer obj);
+s7_pointer s7_dilambda(s7_scheme *sc,
+		       const char *name,
+		       s7_pointer (*getter)(s7_scheme *sc, s7_pointer args),
+		       s7_int get_req_args, s7_int get_opt_args,
+		       s7_pointer (*setter)(s7_scheme *sc, s7_pointer args),
+		       s7_int set_req_args, s7_int set_opt_args,
+		       const char *documentation);
+s7_pointer s7_typed_dilambda(s7_scheme *sc,
+		       const char *name,
+		       s7_pointer (*getter)(s7_scheme *sc, s7_pointer args),
+		       s7_int get_req_args, s7_int get_opt_args,
+		       s7_pointer (*setter)(s7_scheme *sc, s7_pointer args),
+		       s7_int set_req_args, s7_int set_opt_args,
+		       const char *documentation,
+ 		       s7_pointer get_sig, s7_pointer set_sig);
+s7_pointer s7_dilambda_with_environment(s7_scheme *sc, s7_pointer envir,
+					const char *name,
+					s7_pointer (*getter)(s7_scheme *sc, s7_pointer args),
+					s7_int get_req_args, s7_int get_opt_args,
+					s7_pointer (*setter)(s7_scheme *sc, s7_pointer args),
+					s7_int set_req_args, s7_int set_opt_args,
+					const char *documentation);
+
+s7_pointer s7_values(s7_scheme *sc, s7_pointer args);          /* (values ...) */
+bool s7_is_multiple_value(s7_pointer obj);                     /*    is obj the results of (values ...) */
+
+s7_pointer s7_make_iterator(s7_scheme *sc, s7_pointer e);      /* (make-iterator e) */
+bool s7_is_iterator(s7_pointer obj);                           /* (iterator? obj) */
+bool s7_iterator_is_at_end(s7_scheme *sc, s7_pointer obj);     /* (iterator-at-end? obj) */
+s7_pointer s7_iterate(s7_scheme *sc, s7_pointer iter);         /* (iterate iter) */
+
+s7_pointer s7_copy(s7_scheme *sc, s7_pointer args);            /* (copy ...) */
+s7_pointer s7_fill(s7_scheme *sc, s7_pointer args);            /* (fill! ...) */
+s7_pointer s7_type_of(s7_scheme *sc, s7_pointer arg);          /* (type-of arg) */
+
+
+
+/* -------------------------------------------------------------------------------- */
+/* c types/objects */
+
+void s7_mark(s7_pointer p);
+
+bool s7_is_c_object(s7_pointer p);
+s7_int s7_c_object_type(s7_pointer obj);
+void *s7_c_object_value(s7_pointer obj);
+void *s7_c_object_value_checked(s7_pointer obj, s7_int type);
+s7_pointer s7_make_c_object(s7_scheme *sc, s7_int type, void *value);
+s7_pointer s7_make_c_object_with_let(s7_scheme *sc, s7_int type, void *value, s7_pointer let);
+s7_pointer s7_make_c_object_without_gc(s7_scheme *sc, s7_int type, void *value);
+s7_pointer s7_c_object_let(s7_pointer obj);
+s7_pointer s7_c_object_set_let(s7_scheme *sc, s7_pointer obj, s7_pointer e);
+/* the "let" in s7_make_c_object_with_let and s7_c_object_set_let needs to be GC protected by marking it in the c_object's mark function */
+
+s7_int s7_make_c_type(s7_scheme *sc, const char *name);     /* create a new c_object type */
+
+/* old style free/mark/equal */
+void s7_c_type_set_free         (s7_scheme *sc, s7_int tag, void (*gc_free)(void *value));
+void s7_c_type_set_mark         (s7_scheme *sc, s7_int tag, void (*mark)(void *value));
+void s7_c_type_set_equal        (s7_scheme *sc, s7_int tag, bool (*equal)(void *value1, void *value2));
+
+/* new style free/mark/equal and equivalent */
+void s7_c_type_set_gc_free      (s7_scheme *sc, s7_int tag, s7_pointer (*gc_free)   (s7_scheme *sc, s7_pointer obj)); /* free c_object function, new style*/
+void s7_c_type_set_gc_mark      (s7_scheme *sc, s7_int tag, s7_pointer (*mark)      (s7_scheme *sc, s7_pointer obj)); /* mark function, new style */
+void s7_c_type_set_is_equal     (s7_scheme *sc, s7_int tag, s7_pointer (*is_equal)  (s7_scheme *sc, s7_pointer args));
+void s7_c_type_set_is_equivalent(s7_scheme *sc, s7_int tag, s7_pointer (*is_equivalent)(s7_scheme *sc, s7_pointer args));
+
+void s7_c_type_set_ref          (s7_scheme *sc, s7_int tag, s7_pointer (*ref)       (s7_scheme *sc, s7_pointer args));
+void s7_c_type_set_set          (s7_scheme *sc, s7_int tag, s7_pointer (*set)       (s7_scheme *sc, s7_pointer args));
+void s7_c_type_set_length       (s7_scheme *sc, s7_int tag, s7_pointer (*length)    (s7_scheme *sc, s7_pointer args));
+void s7_c_type_set_copy         (s7_scheme *sc, s7_int tag, s7_pointer (*copy)      (s7_scheme *sc, s7_pointer args));
+void s7_c_type_set_fill         (s7_scheme *sc, s7_int tag, s7_pointer (*fill)      (s7_scheme *sc, s7_pointer args));
+void s7_c_type_set_reverse      (s7_scheme *sc, s7_int tag, s7_pointer (*reverse)   (s7_scheme *sc, s7_pointer args));
+void s7_c_type_set_to_list      (s7_scheme *sc, s7_int tag, s7_pointer (*to_list)   (s7_scheme *sc, s7_pointer args));
+void s7_c_type_set_to_string    (s7_scheme *sc, s7_int tag, s7_pointer (*to_string) (s7_scheme *sc, s7_pointer args));
+void s7_c_type_set_getter       (s7_scheme *sc, s7_int tag, s7_pointer getter);
+void s7_c_type_set_setter       (s7_scheme *sc, s7_int tag, s7_pointer setter);
+/* For the copy function, either the first or second argument can be a c-object of the given type. */
+
+  /* These functions create a new Scheme object type.  There is a simple example in s7.html.
+   *
+   * s7_make_c_type creates a new C-based type for Scheme.  It returns an s7_int "tag" used to indentify this type elsewhere.
+   *   The functions associated with this type are set via s7_c_type_set*:
+   *
+   *   free:          the function called when an object of this type is about to be garbage collected
+   *   mark:          called during the GC mark pass -- you should call s7_mark
+   *                  on any embedded s7_pointer associated with the object (including its "let") to protect if from the GC.
+   *   gc_mark and gc_free are new forms of mark and free, taking the c_object s7_pointer rather than its void* value
+   *   equal:         compare two objects of this type; (equal? obj1 obj2) -- this is the old form
+   *   is_equal:      compare objects as in equal? -- this is the new form of equal?
+   *   is_equivalent: compare objects as in equivalent?
+   *   ref:           a function that is called whenever an object of this type
+   *                  occurs in the function position (at the car of a list; the rest of the list
+   *                  is passed to the ref function as the arguments: (obj ...))
+   *   set:           a function that is called whenever an object of this type occurs as
+   *                  the target of a generalized set! (set! (obj ...) val)
+   *   length:        the function called when the object is asked what its length is.
+   *   copy:          the function called when a copy of the object is needed.
+   *   fill:          the function called to fill the object with some value.
+   *   reverse:       similarly...
+   *   to_string:     object->string for an object of this type
+   *   getter/setter: these help the optimizer handle applicable c-objects (see s7test.scm for an example)
+   *
+   * s7_is_c_object returns true if 'p' is a c_object
+   * s7_c_object_type returns the c_object's type (the s7_int passed to s7_make_c_object)
+   * s7_c_object_value returns the value bound to that c_object (the void *value of s7_make_c_object)
+   * s7_make_c_object creates a new Scheme entity of the given type with the given (uninterpreted) value
+   * s7_mark marks any Scheme c_object as in-use (use this in the mark function to mark
+   *    any embedded s7_pointer variables).
+   */
+
+/* -------------------------------------------------------------------------------- */
+/* the new clm optimizer!  this time for sure!
+ *    d=double, i=integer, v=c_object, p=s7_pointer
+ *    first return type, then arg types, d_vd -> returns double takes c_object and double (i.e. a standard clm generator)
+ *
+ * It is possible to tell s7 to call a foreign function directly, without any scheme-related
+ *   overhead.  The call needs to take the form of one of the s7_*_t functions in s7.h.  For example,
+ *   one way to call + is to pass it two s7_double arguments and get an s7_double back.  This is the
+ *   s7_d_dd_t function (the first letter gives the return type, the rest give successive argument types).
+ *   We tell s7 about it via s7_set_d_dd_function.  Whenever s7's optimizer encounters + with two arguments
+ *   that it (the optimizer) knows are s7_doubles, in a context where an s7_double result is expected,
+ *   s7 calls the s7_d_dd_t function directly without consing a list of arguments, and without
+ *   wrapping up the result as a scheme cell.
+ */
+
+s7_pfunc s7_optimize(s7_scheme *sc, s7_pointer expr);
+
+typedef s7_double (*s7_float_function)(s7_scheme *sc);
+s7_float_function s7_float_optimize(s7_scheme *sc, s7_pointer expr);
+
+typedef s7_double (*s7_d_t)(void);
+void s7_set_d_function(s7_scheme *sc, s7_pointer f, s7_d_t df);
+s7_d_t s7_d_function(s7_pointer f);
+
+typedef s7_double (*s7_d_d_t)(s7_double x);
+void s7_set_d_d_function(s7_scheme *sc, s7_pointer f, s7_d_d_t df);
+s7_d_d_t s7_d_d_function(s7_pointer f);
+
+typedef s7_double (*s7_d_dd_t)(s7_double x1, s7_double x2);
+void s7_set_d_dd_function(s7_scheme *sc, s7_pointer f, s7_d_dd_t df);
+s7_d_dd_t s7_d_dd_function(s7_pointer f);
+
+typedef s7_double (*s7_d_ddd_t)(s7_double x1, s7_double x2, s7_double x3);
+void s7_set_d_ddd_function(s7_scheme *sc, s7_pointer f, s7_d_ddd_t df);
+s7_d_ddd_t s7_d_ddd_function(s7_pointer f);
+
+typedef s7_double (*s7_d_dddd_t)(s7_double x1, s7_double x2, s7_double x3, s7_double x4);
+void s7_set_d_dddd_function(s7_scheme *sc, s7_pointer f, s7_d_dddd_t df);
+s7_d_dddd_t s7_d_dddd_function(s7_pointer f);
+
+typedef s7_double (*s7_d_v_t)(void *v);
+void s7_set_d_v_function(s7_scheme *sc, s7_pointer f, s7_d_v_t df);
+s7_d_v_t s7_d_v_function(s7_pointer f);
+
+typedef s7_double (*s7_d_vd_t)(void *v, s7_double d);
+void s7_set_d_vd_function(s7_scheme *sc, s7_pointer f, s7_d_vd_t df);
+s7_d_vd_t s7_d_vd_function(s7_pointer f);
+
+typedef s7_double (*s7_d_vdd_t)(void *v, s7_double x1, s7_double x2);
+void s7_set_d_vdd_function(s7_scheme *sc, s7_pointer f, s7_d_vdd_t df);
+s7_d_vdd_t s7_d_vdd_function(s7_pointer f);
+
+typedef s7_double (*s7_d_vid_t)(void *v, s7_int i, s7_double d);
+void s7_set_d_vid_function(s7_scheme *sc, s7_pointer f, s7_d_vid_t df);
+s7_d_vid_t s7_d_vid_function(s7_pointer f);
+
+typedef s7_double (*s7_d_p_t)(s7_pointer p);
+void s7_set_d_p_function(s7_scheme *sc, s7_pointer f, s7_d_p_t df);
+s7_d_p_t s7_d_p_function(s7_pointer f);
+
+typedef s7_double (*s7_d_pd_t)(s7_pointer v, s7_double x);
+void s7_set_d_pd_function(s7_scheme *sc, s7_pointer f, s7_d_pd_t df);
+s7_d_pd_t s7_d_pd_function(s7_pointer f);
+
+typedef s7_double (*s7_d_7pi_t)(s7_scheme *sc, s7_pointer v, s7_int i);
+void s7_set_d_7pi_function(s7_scheme *sc, s7_pointer f, s7_d_7pi_t df);
+s7_d_7pi_t s7_d_7pi_function(s7_pointer f);
+
+typedef s7_double (*s7_d_7pid_t)(s7_scheme *sc, s7_pointer v, s7_int i, s7_double d);
+void s7_set_d_7pid_function(s7_scheme *sc, s7_pointer f, s7_d_7pid_t df);
+s7_d_7pid_t s7_d_7pid_function(s7_pointer f);
+
+typedef s7_double (*s7_d_id_t)(s7_int i, s7_double d);
+void s7_set_d_id_function(s7_scheme *sc, s7_pointer f, s7_d_id_t df);
+s7_d_id_t s7_d_id_function(s7_pointer f);
+
+typedef s7_double (*s7_d_ip_t)(s7_int i, s7_pointer p);
+void s7_set_d_ip_function(s7_scheme *sc, s7_pointer f, s7_d_ip_t df);
+s7_d_ip_t s7_d_ip_function(s7_pointer f);
+
+typedef s7_int (*s7_i_i_t)(s7_int x);
+void s7_set_i_i_function(s7_scheme *sc, s7_pointer f, s7_i_i_t df);
+s7_i_i_t s7_i_i_function(s7_pointer f);
+
+typedef s7_int (*s7_i_7d_t)(s7_scheme *sc, s7_double x);
+void s7_set_i_7d_function(s7_scheme *sc, s7_pointer f, s7_i_7d_t df);
+s7_i_7d_t s7_i_7d_function(s7_pointer f);
+
+typedef s7_int (*s7_i_ii_t)(s7_int i1, s7_int i2);
+void s7_set_i_ii_function(s7_scheme *sc, s7_pointer f, s7_i_ii_t df);
+s7_i_ii_t s7_i_ii_function(s7_pointer f);
+
+typedef s7_int (*s7_i_7p_t)(s7_scheme *sc, s7_pointer p);
+void s7_set_i_7p_function(s7_scheme *sc, s7_pointer f, s7_i_7p_t df);
+s7_i_7p_t s7_i_7p_function(s7_pointer f);
+
+typedef bool (*s7_b_p_t)(s7_pointer p);
+void s7_set_b_p_function(s7_scheme *sc, s7_pointer f, s7_b_p_t df);
+s7_b_p_t s7_b_p_function(s7_pointer f);
+
+typedef s7_pointer (*s7_p_d_t)(s7_scheme *sc, s7_double x);
+void s7_set_p_d_function(s7_scheme *sc, s7_pointer f, s7_p_d_t df);
+s7_p_d_t s7_p_d_function(s7_pointer f);
+
+typedef s7_pointer (*s7_p_p_t)(s7_scheme *sc, s7_pointer p);
+void s7_set_p_p_function(s7_scheme *sc, s7_pointer f, s7_p_p_t df);
+s7_p_p_t s7_p_p_function(s7_pointer f);
+
+typedef s7_pointer (*s7_p_pp_t)(s7_scheme *sc, s7_pointer p1, s7_pointer p2);
+void s7_set_p_pp_function(s7_scheme *sc, s7_pointer f, s7_p_pp_t df);
+s7_p_pp_t s7_p_pp_function(s7_pointer f);
+
+typedef s7_pointer (*s7_p_ppp_t)(s7_scheme *sc, s7_pointer p1, s7_pointer p2, s7_pointer p3);
+void s7_set_p_ppp_function(s7_scheme *sc, s7_pointer f, s7_p_ppp_t df);
+s7_p_ppp_t s7_p_ppp_function(s7_pointer f);
+
+/* Here is an example of using these functions; more extensive examples are in clm2xen.c in sndlib, and in s7.c.
+ * (This example comes from a HackerNews discussion):
+ * plus.c:
+ * --------
+ * #include "s7.h"
+ *
+ * s7_pointer g_plusone(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, s7_integer(s7_car(args)) + 1));}
+ * s7_int plusone(s7_int x) {return(x + 1);}
+ *
+ * void plusone_init(s7_scheme *sc)
+ * {
+ *   s7_define_safe_function(sc, "plusone", g_plusone, 1, 0, false, "");
+ *   s7_set_i_i_function(sc, s7_name_to_value(sc, "plusone"), plusone);
+ * }
+ * --------
+ * gcc -c plus.c -fPIC -O2 -lm
+ * gcc plus.o -shared -o plus.so -ldl -lm -Wl,-export-dynamic
+ * repl
+ * <1> (load "plus.so" (inlet 'init_func 'plusone_init))
+ * --------
+ */
+
+/* -------------------------------------------------------------------------------- */
+
+/* maybe remove these? */
+s7_pointer s7_slot(s7_scheme *sc, s7_pointer symbol);
+s7_pointer s7_slot_value(s7_pointer slot);
+s7_pointer s7_slot_set_value(s7_scheme *sc, s7_pointer slot, s7_pointer value);
+s7_pointer s7_make_slot(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value);
+void s7_slot_set_real_value(s7_scheme *sc, s7_pointer slot, s7_double value);
+
+/* -------------------------------------------------------------------------------- */
+
+#if (!DISABLE_DEPRECATED)
+typedef s7_int s7_Int;
+typedef s7_double s7_Double;
+
+#define s7_is_object          s7_is_c_object
+#define s7_object_type        s7_c_object_type
+#define s7_object_value       s7_c_object_value
+#define s7_make_object        s7_make_c_object
+#define s7_mark_object        s7_mark
+#define s7_UNSPECIFIED(Sc)    s7_unspecified(Sc)
+#endif
+
+
+bool s7_is_bignum(s7_pointer obj);
+#if WITH_GMP
+  mpfr_t *s7_big_real(s7_pointer x);
+  mpz_t  *s7_big_integer(s7_pointer x);
+  mpq_t  *s7_big_ratio(s7_pointer x);
+  mpc_t  *s7_big_complex(s7_pointer x);
+
+  bool s7_is_big_real(s7_pointer x);
+  bool s7_is_big_integer(s7_pointer x);
+  bool s7_is_big_ratio(s7_pointer x);
+  bool s7_is_big_complex(s7_pointer x);
+
+  s7_pointer s7_make_big_real(s7_scheme *sc, mpfr_t *val);
+  s7_pointer s7_make_big_integer(s7_scheme *sc, mpz_t *val);
+  s7_pointer s7_make_big_ratio(s7_scheme *sc, mpq_t *val);
+  s7_pointer s7_make_big_complex(s7_scheme *sc, mpc_t *val);
+#endif
+
+
+/* --------------------------------------------------------------------------------
+ *
+ *        s7 changes
+ *
+ * 31-May:    *s7* 'symbol-printer and 'symbol-quote?.
+ * 24-May:    symbol-initial-value, s7_symbol_initial_value, and setters.
+ * 24-Apr:    port-string.
+ * 8-Jan-23:  s7_gc_protect_2_via_stack.
+ * --------
+ * 15-Nov:    s7_make_c_pointer_wrapper_with_type.
+ * 17-Mar-23: moved s7_is_bignum declaration outside WITH_GMP.
+ * --------
+ * 9-Nov:     nan, nan-payload, +nan.<int>.
+ * 19-Oct:    s7_let_field* synonyms: s7_starlet_ref|set.
+ * 16-Sep:    s7_number_to_real_with_location. s7_wrong_type_error. s7_make_string_wrapper_with_length. s7_make_semipermanent_string.
+ * 21-Apr:    s7_is_multiple_value.
+ * 11-Apr:    removed s7_apply_*.
+ * 22-Mar:    s7_eval_with_location.
+ * 16-Mar:    s7_list_to_array for the s7_apply_* changes.
+ * 8-Mar-22:  moved s7_apply_* to xen.h if DISABLE_DEPRECATED.
+ * --------
+ * 24-Nov:    moved s7_p_p_t and friends into s7.h.
+ * 23-Sep:    s7_make_byte_vector, s7_is_byte_vector, s7_byte_vector_ref|set|elements.
+ * 25-Aug:    s7_output_string (like s7_get_output_string, but returns an s7 string).
+ * 19-Jul:    s7_is_random_state, s7_make_normal_vector. s7_array_to_list.
+ * 12-Apr:    s7_optimize now returns an s7_pfunc, not an s7_function.
+ * 7-Apr:     removed the "args" parameter from s7_float_function. added s7_make_c_object_without_gc.
+ * 31-Mar:    vector-rank, vector-dimension.
+ * 17-Mar:    removed deprecated nan.0 and inf.0 due to compiler stupidity.
+ * 25-Jan:    s7_define_semisafe_typed_function.
+ * 6-Jan-21:  s7_hash_code.
+ * --------
+ * 14-Oct:    s7_load_c_string and s7_load_c_string_with_environment.
+ * 10-Sep:    s7_free.
+ * 5-Aug:     s7_make_list.
+ * 31-July:   s7_define_constant_with_environment and s7_dilambda_with_environment.
+ * 29-July:   open-input|output-function. add S7_NUM_READ_CHOICES to s7_read_t enum and remove (unused) S7_READ_BYTE.
+ * 20-July:   s7_c_pointer_with_type. notcurses_s7.c and nrepl.scm. *autoload-hook*.
+ * 8-July:    s7_int|float_vector_ref|set. subvector parameter order changed.
+ * 17-June:   removed deprecated *s7* accessors.
+ * 20-May:    libarb_s7.c.
+ * 12-May:    s7_is_big*.
+ * 6-May:     added s7_scheme* initial arguments to s7_set_* opt_func calls (s7_set_d_d_function for example).
+ * 23-Apr:    added s7_scheme* initial argument to s7_is_eqv.
+ * 9-Mar:     move openlets to (*s7* 'openlets), s7-version to (*s7* 'version), deprecate nan.0 and inf.0.
+ * 17-Feb:    s7_let_field_ref|set for *s7* access. *function* to replace __func__.
+ *            deprecate __func__, s7_print_length, s7_float_format_precision, s7_set_gc_stats.
+ * 31-Jan:    macro(*) and bacro(*) -- unnamed macros analogous to lambda(*).
+ * 20-Jan:    debug.scm and (*s7* 'debug), trace-in, dynamic-unwind.
+ *            remove coverlets (openlets is now a dilambda).
+ * 10-Jan:    s7_c_type_set_gc_free and s7_c_type_set_gc_mark.
+ * 2-Jan-20:  s7_c_type_set_is_equal and s7_c_type_set_is_equivalent.
+ * --------
+ * 2-Nov:     s7_repl.
+ * 30-Oct:    change S7_DATE format, and start updating it to reflect s7.c.
+ * 30-Jul:    define-expansion*.
+ * 12-Jul:    s7_call_with_catch, s7_load now returns NULL if file not found (rather than raise an error).
+ * 8-July:    most-positive-fixnum and most-negative-fixnum moved to *s7*.
+ * 23-May:    added s7_scheme argument to s7_c_object_set_let.
+ * 19-May:    s7_gc_stats renamed s7_set_gc_stats.
+ * 7-May:     s7_gc_unprotect_via_stack and s7_gc_(un)protect_via_location.
+ * 22-Mar:    s7_float_format_precision. port-position. port-file.
+ * 4-Jan-19:  morally-equal? -> equivalent?
+ * --------
+ * 29-Dec:    s7_c_type_set_getter|setter (implicit c-object access).
+ * 23-Dec:    remove hash-table, rename hash-table* to hash-table. add weak-hash-table.
+ * 3-Dec:     deprecate s7_gc_unprotect (use s7_gc_unprotect_at).
+ * 21-Nov:    added s7_history_enabled and s7_set_history_enabled.
+ * 3-Nov:     removed the "value" argument from s7_for_each_symbol.
+ * 22-Sep:    s7_list_nl.
+ * 12-Sep:    byte-vectors can be multidimensional; homogenous vectors of any built-in type. typed hash-tables.
+ * 29-Jul:    symbol-setter deprecated (use setter). s7_symbol_documentation (and setter) folded into s7_documentation.
+ * 12-Jul:    changed s7_vector_dimensions|offsets.
+ *            Added s7_scheme* arg to make_permanent_string and several of the optimizer functions.
+ * 3-Jul:     changed make-shared-vector to subvector.
+ * 20-May:    s7_keyword_to_symbol.
+ * 6-May:     s7_mark_c_object -> s7_mark.
+ * 26-Apr:    s7_c_type_set_to_list|string, s7_c_type_set_apply -> s7_c_type_set_ref, removed s7_c_type_set_set|apply_direct
+ *            c_type length|set|ref are now s7_functions (args, not obj, etc).
+ * 23-Mar:    s7_peek_char and s7_read_char now return s7_pointer, s7_write_char takes s7_pointer, not int32_t c
+ *            s7_gc_protect and friends now return/take s7_int location, not uint32_t.
+ *            removed s7_new_type_x.
+ * 19-Mar:    int32_t -> s7_int in various functions.
+ * 17-Mar:    deprecate s7_ulong and s7_ulong_long functions.
+ * 26-Jan-18: s7_set_setter.
+ * --------
+ * 11-Dec:    s7_gc_protect_via_stack
+ * 3-Oct:     renamed procedure-signature -> signature, procedure-documentation -> documentation, and procedure-setter -> setter.
+ * 18-Sep:    s7_immutable, s7_is_immutable. define-constant follows lexical scope now.
+ *            s7_symbol_access -> s7_symbol_setter, symbol-access -> symbol-setter.
+ * 3-Aug:     object->c_object name changes.
+ * 28-Jul:    s7_make_c_pointer_with_type and s7_c_pointer_type.
+ * 24-Jul:    int64_t rather than long long int, and various related changes.
+ * 18-Jul:    s7_make_object_with_let.
+ * 8-July:    s7_define_typed_function_star, s7_make_function_star. s7_apply_function_star.
+ * 27-June:   s7_make_string_wrapper.
+ * 22-May:    lambda* keyword arg handling changed slightly.
+ * 9-May:     s7_history, s7_add_to_history.
+ * 20-Apr:    s7_tree_memq (for Snd), s7_type_of, many changes for new clm optimizer.
+ * 10-Apr:    added s7_scheme first argument to s7_iterator_is_at_end.
+ * 28-Mar:    removed the "rf", "pf" and "if" clm optimization functions.
+ *            s7_optimize, s7_float_optimize, s7_procedure_signature.
+ * 22-Feb:    removed the "gf" clm optimization functions.
+ * 11-Feb:    #e, #i, #d removed. #i(...) is an int-vector constant, #r(...) a float-vector.
+ * 2-Jan-17:  {apply_values} -> apply-values, {list} -> list-values, and {append} -> append.
+ * --------
+ * 23-Sep:    make-keyword -> string->keyword.
+ * 9-Aug:     s7_varlet.
+ * 29-Jul:    s7_define_unsafe_typed_function.
+ * 30-May:    symbol takes any number of args.  make-vector no longer takes an optional fourth argument.
+ * 24-May:    let-ref/set! check rootlet now if let is not an open let; setter for with-let.
+ * 20-Feb:    removed last vestiges of quasiquoted vector support.
+ * 3-Feb:     *cload-directory*.
+ * 14-Jan:    profile.scm. Moved multiple-value-set! to stuff.scm. Setter for port-line-number.
+ * 7-Jan:     s7_load_with_environment.
+ *            s7_eval_c_string takes only one statement now (use begin to handle multiple statements)
+ * 4-Jan-16:  remove s7_eval_form, change s7_eval to take its place.
+ * --------
+ * 11-Dec:    owlet error-history field if WITH_HISTORY=1
+ * 6-Nov:     removed :key and :optional.
+ * 16-Oct:    s7_make_random_state -> s7_random_state.
+ * 16-Aug:    remove s7_define_integer_function, s7_function_set_removes_temp,
+ *              add s7_define_typed_function, s7_make_signature.
+ * 5-Aug:     added s7_scheme* arg to s7_openlet and s7_outlet.
+ * 3-Jul:     s7_Double -> s7_double, s7_Int -> s7_int. Removed function_chooser_data.
+ * 27-Jun:    s7_rf_t, s7_rp_t etc.
+ * 19-Jun:    removed the ex_parser stuff, set_step_safe, s7_ex_fallback.
+ * 5-May:     s7_make_iterator and friends.
+ * 16-Apr:    added s7_fill, changed arg interpretation of s7_copy, s7_dynamic_wind.
+ * 30-Mar:    s7_eval_c_string_with_environment (repl experiment).
+ * 19-Mar:    repl.scm.
+ * 28-Feb:    s7_vector_print_length -> s7_print_length, set case also.
+ * 25-Feb:    s7_closure_* funcs to replace clumsy (deprecated) s7_procedure_source.
+ * 29-Jan:    changed args to s7_new_type_x (added s7_scheme arg, fill! takes s7_function).
+ * 14-Jan-15: make-iterator, iterator?
+ * --------
+ * 26-Dec:    s7_arity replaces s7_procedure_arity.  s7_define_integer_function. deprecate s7_procedure_name.
+ * 5-Nov:     s7_shadow_rootlet and s7_set_shadow_rootlet.
+ * 30-Aug:    s7_make_safe_function (for cload.scm).
+ * 25-July:   define and friends now return the value, not the symbol.
+ *            procedure_with_setter -> dilambda.
+ *            environment -> let.  All the replaced names are deprecated.
+ * 30-June:   s7_method.
+ * 16-June:   remove unoptimize and s7_unoptimize.
+ * 14-May:    s7_define_safe_function_star.  Removed s7_catch_all.
+ * 22-Apr:    remove s7_apply_n_10, s7_is_valid_pointer, s7_keyword_eq_p.
+ * 5-Mar-14:  s7_heap_size, s7_gc_freed (subsequently removed).
+ * --------
+ * 8-Nov:     s7_symbol_documentation, s7_define_constant_with_documentation.
+ * 17-Oct:    bignum-precision (procedure-with-setter) is now an integer variable named *bignum-precision*.
+ * 28-Aug:    s7_int|float_vector_elements (homogeneous vectors), libc.scm.
+ * 16-Aug:    ~W directive in format, make-shared-vector.
+ * 23-Jul:    s7_autoload_set_names, libm.scm, libdl.scm, libgdbm.scm, r7rs.scm, s7libtest.scm.
+ * 21-Jul:    s7_is_valid (replaces deprecated s7_is_valid_pointer).
+ * 24-Jun:    some bool-related changes for Windows Visual C++, including change to s7_begin_hook.
+ * 3-June:    s7_autoload.
+ * 28-May:    export s7_is_provided.  Added s7_scheme* arg to s7_procedure_environment.
+ * 21-May:    equality predicate optional arg in make-hash-table.
+ * 14-May:    glistener.c, glistener.h, s7_symbol_table_find_name (for glistener).
+ * 2-May:     r7rs changes: flush-output-port, vector-append, read|write-string, boolean=?, symbol=?.
+ *              start/end args for string-fill!, vector-fill!, string->list, vector->list, and copy.
+ *              exit, emergency-exit.
+ * 7-Apr:     removed s7_scheme* arg from s7_slot_value, added s7_is_local_variable.
+ * 25-Mar:    char-position, string-position, environment-ref, environment-set! added to the scheme side.
+ * 9-Jan-13:  s7_cos, s7_sin, other optimization changes.
+ * --------
+ * 24-Dec:    s7_set_object_array_info and other such changes.
+ * 20-Nov:    removed s7_set_error_exiter and s7_error_and_exit which I think have never been used.
+ * 22-Oct:    changed args to s7_function_class and s7_function_set_class.
+ * 22-Aug:    symbol->dynamic-value.
+ * 10-Aug:    exported s7_outer_environment.
+ * 6-Aug:     removed WITH_OPTIMIZATION.
+ * 25-July:   environment (in scheme). s7_vector_ref_n and s7_vector_set_n. s7_copy.
+ *              added s7_scheme arg to s7_number_to_real|integer.
+ * 16-July:   s7_function_returns_temp (an experiment).
+ * 2-July:    s7_object_set_* functions.
+ * 11-June:   throw.
+ * 4-June.    s7_object_environment.
+ * 31-May:    added s7_scheme argument to all the optimizer chooser functions.
+ * 24-May:    open-environment?
+ * 17-May:    arity, aritable?
+ *            removed trace and untrace.
+ * 14-May:    s7_list. s7_procedure_set_setter.  Removed s7_procedure_getter.
+ *              procedure-setter is settable: removed most of procedure-with-setter.
+ *            make-type replaced by open-environment.
+ * 11-May:    s7 2.0: hook implementation changed completely.
+ *            s7_environment_ref|set.
+ * 4-May:     *error-info* replaced by error-environment, and stacktrace has changed.
+ * 22-Apr:    #_<name> = startup (built-in) value of name
+ * 17-Apr:    with-baffle.
+ * 14-Apr:    WITH_SYSTEM_EXTRAS (default 0) has additional OS and IO functions:
+ *              directory? file-exists? delete-file getenv directory->list system
+ * 26-Mar:    "@" as exponent, WITH_AT_SIGN_AS_EXPONENT switch (default is 1).
+ * 18-Mar:    removed *trace-hook*.
+ * 6-Feb:     random-state?, hash-table-iterator?, and morally-equal?
+ * 18-Jan:    s7_environment_to_list and environment->list return just the local environment's bindings.
+ *            outer-environment returns the environment enclosing its argument (an environment).
+ *            environments are now applicable objects.
+ *            added the object system example to s7.html.
+ * 12-Jan:    added reverse argument to s7_new_type_x.  This is needed because an object might implement
+ *              the apply and set methods, but they might refer to different things.
+ * 6-Jan-12:  added (scheme side) logbit?.
+ * --------
+ * 21-Dec:    s7_eval, s7_make_slot, s7_slot_set_value.
+ *            changed s7_symbol_slot to s7_slot, and s7_symbol_slot_value to s7_slot_value.
+ * 26-Oct:    s7_procedure_name.
+ * 6-Oct:     changed s7_make_closure args: split the code argument in two (args and body).
+ *               s7_make_closure(... code ...) is now s7_make_closure(... car(code), cdr(code) ...)
+ *            s7_is_environment.
+ * 19-Aug:    s7_function_chooser_data.
+ * 11-Aug:    s7_symbol_accessor functions. s7_cxxxxr.
+ * 9-Aug:     s7_function_chooser, s7_function_choice, s7_function_choice_set_direct.
+ * 20-Jul:    s7_function_class, s7_function_set_class, and s7_function_set_chooser.
+ * 14-Jul:    removed thread and profiling support.
+ * 5-June:    s7_define_safe_function and s7_unoptimize exported; added unoptimize function in scheme.
+ * 30-May:    environment->list and s7_environment_to_list since environments are no longer alists internally.
+ * 26-May:    added s7_scheme argument to s7_procedure_setter and getter (old names had "with_setter_").
+ * 28-Apr:    s7_help.
+ * 5-Apr:     pair-line-number.
+ * 14-Mar:    s7_make_random_state, optional state argument to s7_random, random-state->list, s7_random_state_to_list.
+ * 10-Feb:    s7_vector_print_length, s7_set_vector_print_length.
+ * 7-Feb:     s7_begin_hook, s7_set_begin_hook.
+ * 25-Jan:    s7_is_thread, s7_thread, s7_make_thread, s7_thread_s7, s7_thread_data.
+ *               s7_is_lock, s7_make_lock, s7_lock.
+ *               changed s7_thread_variable_value to s7_thread_variable.
+ * 23-Jan:    removed (scheme-level) quit.
+ * 17-Jan-11: make-hash-table-iterator.
+ *            map and for-each accept any applicable object as the first argument.
+ *            format's ~{...~} directive can handle any applicable object.
+ * --------
+ * 17-Dec:    removed unquote-splicing; replaced by (unquote (apply values ...)).
+ * 12-Dec:    environment?
+ * 7-Dec:     member and assoc have an optional third arg, the comparison function.
+ * 1-Dec:     *gc-stats* in Scheme, s7_gc_stats in C.
+ *            gmp and gtk-repl examples in s7.html.
+ * 21-Nov:    Load C module example in s7.html.
+ * 12-Nov:    *trace-hook*, *load-hook*, *error-hook*, and *unbound-variable-hook* are now s7 hooks.
+ * 9-Nov:     hooks: C side: s7_is_hook, s7_make_hook, s7_hook_apply, s7_hook_functions, s7_hook_arity, s7_hook_documentation.
+ *                   s7 side: hook?, make-hook, hook, hook-apply, hook-functions, hook-arity, hook-documentation.
+ * 8-Nov:     Closure defined in C example in s7.html.
+ * 23-Oct:    s7_call_with_location for better error reporting.
+ * 19-Oct:    *stdin*, *stdout*, *stderr* for default IO ports (rather than nil which is ambiguous).
+ * 14-Oct:    removed special variable support.
+ * 30-Sep:    setters for current-input-port, current-output-port, and current-error-port.
+ * 30-Aug:    :allow-other-keys in define*.
+ * 10-Aug:    added boolean argument use_write to s7_object_to_string (true=write, false=display).
+ * 30-July:   special macro for access to dynamic binding.
+ *            s7_symbol_special_value for C-side access to dynamic bindings.
+ *            s7_is_macro.
+ *            port-closed? returns #t if its argument (a port) is closed.
+ * 22-July:   s7_make_character takes uint32_t, rather than int.
+ *            added symbol function for funny symbol names.
+ * 12-July:   initial-environment.
+ * 7-July:    removed force and delay: use slib.
+ * 3-July:    new backquote implementation.
+ * 28-June:   syntactic keywords (e.g. lambda) are applicable.
+ * 7-June:    changed key arg in s7_hash_table_ref|set to be s7_pointer, not const char*.
+ *            hash-tables can now handle any s7 object as the key.
+ *            map and for-each now pass a hash-table entry to the function, rather than an internal alist.
+ *            reverse of a hash-table reverses the keys and values (i.e. old value becomes new key, etc).
+ * 2-June:    removed procedure-with-setter-setter-arity and folded that info into procedure-arity (use cdddr).
+ * 22-May:    multidimensional vectors are no longer optional.
+ * 9-May:     s7_read_char and s7_peek_char have to return an int, not a char (<eof>=-1, but 255 is a legit char).
+ *            s7_write_char and s7_open_output_function have similar changes.
+ * 3-May:     *#readers* to customize #... reading.  Also nan? and infinite?.
+ *            multidimensional vector constants using #nD(...): (#2D((1 2 3) (4 5 6)) 0 0) -> 1.
+ * 13-Apr:    removed hash-table|vector|string-for-each -- these are handled by for-each.
+ *            also removed vector-map -- map is generic, but always returns a list.
+ * 12-Apr:    removed immutable constant checks -- see s7.html.
+ * 7-Apr:     *unbound-variable-hook*.
+ *            augment-environment and s7_augment_environment.
+ * 29-Mar:    symbol-access, s7_symbol_access, s7_symbol_set_access.
+ *            C example of notification in s7.html.
+ * 25-Mar:    make-type.  s7_is_equal now includes an s7_scheme pointer as its first argument.
+ * 24-Mar:    s7_is_defined.
+ * 19-Mar:    removed encapsulation mechanism and s7_define_set_function.
+ * 18-Mar:    added macro?.
+ * 27-Feb:    removed r4rs-style macro syntax.
+ * 17-Feb:    s7_number_to_integer.
+ * 20-Jan-10: removed the stack function.
+ * --------
+ * 16-Dec:    hash-table-for-each.
+ * 1-Dec:     mpc versions before 0.8.0 are no longer supported.
+ * 24-Nov:    define-macro* and defmacro*.
+ *            force and delay included only if WITH_FORCE set, promise? removed.
+ * 17-Nov:    s7_is_boolean no longer takes the s7_scheme argument.
+ * 7-Nov:     s7_vector_dimensions, s7_vector_offsets, example of use.
+ * 3-Nov:     s7_vector_rank.
+ * 30-Oct:    *trace-hook*.
+ * 12-Oct:    s7_port_filename.
+ * 5-Oct:     s7_c_pointer and friends.
+ * 14-Sep:    s7_values, s7_make_continuation, and a better interrupt example.
+ *            vector-for-each, vector-map, string-for-each.
+ * 7-Sep:     s7_open_input_function. with-environment. receive.
+ * 3-Sep:     s7.html, s7-slib-init.scm.
+ *            s7_stacktrace in s7.h.
+ * 27-Aug:    vector and hash-table sizes are now s7_ints, rather than ints.
+ * 20-Aug:    s7_remove_from_heap.
+ * 17-Aug:    *error-info*.
+ * 7-Aug:     s7_define_function_with_setter.
+ *            s7_quit and example of signal handling.
+ * 6-Aug:     encapsulation.  s7_define_set_function.  s7_new_type_x.
+ *            generic function: copy, and length is generic.
+ * 1-Aug:     lower-case versions of s7_T and friends.
+ *            s7_define_macro. macroexpand.
+ *            strings are set-applicable (like vectors).
+ * 31-Jul:    *error-hook*.
+ * 30-Jul:    changed backtrace handling: removed backtrace stuff, added stacktrace.
+ *            removed gc-verbose and load-verbose replaced by *load-hook*.
+ * 23-Jul:    __func__.
+ * 20-Jul:    trace and untrace.
+ * 14-Jul:    replaced s7_make_closure_star with s7_define_function_star.
+ * 29-Jun:    s7_format declaration.
+ * 12-May:    s7_is_constant.
+ * 20-Apr:    changed rationalize to be both r5rs-acceptable and fast.
+ * 6-Apr:     added s7_make_permanent_string.
+ * 14-Mar:    removed s7_local_gc_protect and s7_local_gc_unprotect.
+ * 4-Mar:     multidimensional and applicable vectors.
+ * 1-Mar:     s7_random added to s7.h.
+ * 29-Jan:    s7_is_bignum and friends.
+ * 26-Jan:    added s7_scheme arg to s7_vector_fill.
+ * 16-Jan:    s7_is_ulong_long and friends for C pointers in 64-bit situations.
+ * 9-Jan-09   multiprecision arithmetic (gmp, mpfr, mpc) on the WITH_GMP switch
+ * --------
+ * 29-Dec:    "+" specialization example, s7_apply_function.
+ * 3-Dec:     s7_open_output_function.
+ * 30-Nov:    s7_wrong_number_of_args_error.
+ * 24-Nov:    changed s7_make_counted_string to s7_make_string_with_length.
+ *              also added built-in format and define*
+ * 10-Nov:    s7_define_constant,
+ *              built-in (scheme-side) pi, most-positive-fixnum, most-negative-fixnum
+ * 7-Nov:     removed s7_is_immutable and friends, s7_reverse_in_place.
+ *              removed the s7_pointer arg to s7_gc_on.
+ *              added s7_UNSPECIFIED
+ * 25-Oct:    added name arg to s7_make_procedure_with_setter,
+ *              and s7_scheme arg to new_type print func.
+ * 1-Oct-08   version 1.0
+ */
+
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif
diff --git a/s7/s7.html b/s7/s7.html
new file mode 100644
index 0000000..e9e00da
--- /dev/null
+++ b/s7/s7.html
@@ -0,0 +1,11298 @@
+<!DOCTYPE html>
+
+<html lang="en">
+<!-- documentation for s7 -->
+
+<head>
+<meta http-equiv="Content-Type" content="text/html;charset=utf-8" >
+
+<title>s7</title>
+
+<style type="text/css">
+	EM.red {color:red; font-style:normal}
+	EM.normal {font-style:normal}
+	EM.redb {color:red; font-weight: bold; font-style: normal}
+        EM.error {color:chocolate; font-style:normal}
+	EM.emdef {font-weight: bold; font-style: normal}
+	EM.green {color:green; font-style:normal}
+	EM.gray {color:#505050; font-style:normal}
+	EM.big {font-size: 20px; font-style: normal;}
+	EM.bigger {font-size: 30px; font-style: normal;}
+        EM.def {font-style: normal}
+
+	H1 {text-align: center}
+	UL {list-style-type: none}
+
+	A {text-decoration:none}
+	A:hover {text-decoration:underline}
+
+	A.def {font-weight: bold; 
+	       font-style: normal; 
+	       text-decoration:none; 
+	       text-color:black;
+	       }
+
+        PRE.indented {padding-left: 1.0cm;}
+
+	DIV.indented {background-color: #F8F8F0; 
+	              padding-left: 0.5cm; 
+	              padding-right: 0.5cm; 
+		      padding-top: 0.5cm; 
+		      padding-bottom: 0.5cm;
+		      margin-bottom: 0.5cm;
+		      border: 1px solid gray;
+		      border-radius: 20px;
+		      -moz-border-radius: 20px;
+		      -webkit-border-radius: 20px;
+		      }
+        DIV.small {font-size: small;
+	              padding-left: 0.5cm; 
+	              padding-right: 0.5cm; 
+		      padding-bottom: 0.5cm;
+                  }		      
+        DIV.header {margin-top: 60px;
+	            margin-bottom: 30px;
+	            border: 4px solid #00ff00; /* green */
+		    background-color: #eefdee; /* lightgreen */
+		    padding-left: 30px;
+	           }
+        DIV.shortheader {margin-top: 30px;
+	            margin-bottom: 10px;
+	            border: 4px solid #00ff00; /* green */
+		    background-color: #f5f5dc;
+		    padding-left: 30px;
+		    padding-top: 5px;
+		    padding-bottom: 5px;
+		    width: 20%;
+	           }
+        DIV.topheader {margin-top: 10px;
+	            margin-bottom: 40px;
+	            border: 4px solid #00ff00; /* green */
+		    background-color: #f5f5dc; /* beige */
+		    font-family: 'Helvetica';
+		    font-size: 30px;
+		    text-align: center;
+		    padding-top: 10px;
+		    padding-bottom: 10px;
+	           }
+        DIV.separator {margin-top: 30px;
+	               margin-bottom: 10px;
+	               border: 2px solid #00ff00; /* green */
+		       background-color: #f5f5dc; /* beige */
+		       padding-top: 4px;
+		       width: 30%;
+		      border-radius: 4px;
+		      -moz-border-radius: 4px;
+		      -webkit-border-radius: 4px;
+		      } 
+        DIV.smallseparator {margin-top: 10px;
+	               margin-bottom: 10px;
+	               border: 2px solid #00ff00; /* green */
+		       background-color: #f5f5dc; /* beige */
+		       padding-top: 4px;
+		       width: 20%;
+		      border-radius: 4px;
+		      -moz-border-radius: 4px;
+		      -webkit-border-radius: 4px;
+		      text-align: center;
+		      } 
+        BODY.body {background-color: #ffffff;    /* white */
+	           margin-right: 20px;
+	           margin-left: 20px; 
+                   }
+        DIV.listener {background-color: #f0f8ff;
+	              font-family: 'Monospace';
+		   padding-left: 6px;
+		   padding-right: 6px;
+		   padding-bottom: 4px;
+		   margin-left: 1.0cm;
+		   margin-right: 4.0cm;
+	              border: 2px solid #a0a0a0;
+		      }
+        LI.li_header {padding-top: 20px;}
+
+</style>
+</head>
+<body class="body">
+
+<!-- INDEX s7doc:s7 scheme -->
+
+
+<div class="topheader" id="s7doc">s7
+</div>
+
+
+<p>s7 is a Scheme interpreter intended as an extension language for other applications.
+It exists as just two files, s7.c and
+s7.h, that want only to disappear into someone else's source tree.  There are no libraries,
+no run-time init files, and no configuration scripts.
+It can be built as a stand-alone
+interpreter (see <a href="#repl">below</a>).  s7test.scm is a regression test for s7.
+A tarball is available: <a href="https://ccrma.stanford.edu/software/s7/s7.tar.gz">s7 tarball</a>.
+There is an svn repository at sourceforge (the Snd project): <a href="https://sourceforge.net/p/snd/svn1/">Snd</a>,
+and a git repository (just s7): git@cm-gitlab.stanford.edu:bil/s7.git <a href="https://cm-gitlab.stanford.edu/bil/s7.git">s7.git</a>.
+Please ignore all other "s7" github sites.  Christos Vagias created a web-assembly site with
+a repl: https://github.com/actonDev/s7-playground/.
+</p>
+
+<p>
+s7 is an extension language of Snd and sndlib (<a href="http://ccrma.stanford.edu/software/snd/index.html">snd</a>),
+Rick Taube's Common Music (commonmusic at sourceforge), Kjetil Matheussen's Radium music editor, and Iain Duncan's Scheme for Max (or Pd).
+There are X, Motif, and openGL bindings
+in libxm in the Snd tarball, or at ftp://ccrma-ftp.stanford.edu/pub/Lisp/libxm.tar.gz.
+</p>
+
+<p>Although it is a descendant of tinyScheme, s7 is closest as a Scheme dialect to Guile 1.8.
+I believe it is compatible with <a href="#s7vsr5rs">r5rs</a> and <a href="#r7rs">r7rs</a>:  you can just ignore all the additions discussed in this file.
+It has continuations, 
+ratios, complex numbers,
+macros, keywords, hash-tables, 
+multiprecision arithmetic,
+generalized set!, unicode, and so on.
+It does not have syntax-rules or any of
+its friends, and it thinks there is no such thing
+as an inexact integer.  
+</p>
+
+<p>This file assumes you know about Scheme and all its problems,
+and want a quick tour of where s7 is different.  (Well, it was quick once upon a time).
+The main difference: if it's in s7, it's a first-class citizen of s7, and that includes
+macros, environments, and syntactic values.
+</p>
+
+<br>
+<blockquote>
+<div class="indented">
+<p>I originally used a small font for scholia, but now I have to squint
+to read that tiny text, so less-than-vital commentaries are shown in the normal font, but 
+indented and on a sort of brownish background.
+</p>
+</div>
+</blockquote>
+<br>
+
+<ul>
+  <li><a href="#multiprecision">arbitrary precision arithmetic</a>
+  <li><a href="#math">math functions</a>
+  <li><a href="#define*">define*, named let*</a>
+  <li><a href="#macros">define-macro</a>
+  <li><a href="#pws">setter</a>
+  <li><a href="#generalizedset">generic functions, generalized set!</a>
+  <li><a href="#multidimensionalvectors">multidimensional vectors</a>
+  <li><a href="#hashtables">hash tables</a>
+  <li><a href="#environments">environments</a>
+  <li><a href="#multiplevalues">multiple-values</a>
+  <li><a href="#callwithexit1">call-with-exit</a>
+  <li><a href="#format1">format</a>
+  <li><a href="#hooks">hooks</a>
+  <li><a href="#variableinfo">variable info</a>
+  <li><a href="#evalstring">eval</a>
+  <li><a href="#IO">IO and other OS functions</a>
+  <li><a href="#errors">errors</a>
+  <li><a href="#autoload">autoload</a>
+  <li><a href="#constants">define-constant</a>
+  <li><a href="#miscellanea">marvels and curiousities:</a> 
+
+  <ul>
+    <li><a href="#loadpath">*load-path*</a>, <a href="#featureslist">*features*</a>, <a href="#sharpreaders">*#readers*</a>,
+    <li><a href="#makelist">make-list</a>, <a href="#charposition">char-position</a>, <a href="#keywords">keywords</a>
+    <li><a href="#symboltable">symbol-table</a>, <a href="#s7help">help</a>, <a href="#s7gc">gc</a>, <a href="#equivalentp">equivalent?</a>
+    <li><a href="#expansion">define-expansion</a>, <a href="#s7env">*s7*</a>, <a href="#s7vsr5rs">r5rs</a>, <a href="#r7rs">r7rs</a>, 
+    <li><a href="#profiling">profiling</a>, <a href="#legolambda">legolambda</a>, etc...
+    </ul>
+
+  <li class="li_header"><a href="#FFIexamples">FFI examples</a>
+  <ul>
+      <li><a href="#repl">read-eval-print loop (and emacs)</a>
+      <li><a href="#defun">define a function with arguments and a returned value, and define a variable </a>
+      <li><a href="#defvar">call a Scheme function from C, and get/set Scheme variable values in C</a>
+      <li><a href="#juce">C++ and Juce</a>
+      <li><a href="#sndlib">load sndlib using the Xen functions and macros</a>
+      <li><a href="#pwstype">add a new Scheme type and a procedure with a setter</a>
+      <li><a href="#functionportexample">redirect display output to a C procedure</a>
+      <li><a href="#extendop">extend a built-in operator ("+" in this case)</a>
+      <li><a href="#definestar1">C-side define* (s7_define_function_star)</a>
+      <li><a href="#definemacro1">C-side define-macro (s7_define_macro)</a>
+      <li><a href="#definegeneric">define a generic function in C</a>
+      <li><a href="#signal">signal handling (C-C to break out of an infinite loop)</a>
+      <li><a href="#notify">notification in C that a Scheme variable has been set!</a>
+      <li><a href="#namespace">Load C defined stuff into a separate namespace</a>
+      <li><a href="#Cerrors">Error handling in C</a>
+      <li><a href="#testhook">Hooks in C and Scheme</a>
+      <li><a href="#dload">Load a C module dynamically</a>
+      <li><a href="#gmpex">gmp and friends</a>
+      <li><a href="#gdb">gdb</a>
+      <li><a href="#webassembly">WASM</a>
+      <li><a href="#ffinotes">FFI notes</a>
+  </ul>
+
+  <li class="li_header"><a href="#s7examples">s7 examples</a>
+  <ul>
+      <li><a href="#cload">cload.scm</a>
+      <ul>
+           <li><a href="#libc">libc</a>
+           <li><a href="#libgsl">libgsl</a>
+           <li><a href="#libgdbm">libgdbm</a>
+      </ul>
+      <li><a href="#case">case.scm</a>
+      <li><a href="#debug">debug.scm</a>
+      <li><a href="#lint">lint.scm</a>
+      <li><a href="#schemerepl">repl.scm and nrepl.scm</a>
+  </ul>
+</ul>
+
+
+<div class="header" id="multiprecision"><h4>multiprecision arithmetic</h4></div>
+
+<p>All numeric types, integers, ratios, reals, and complex numbers are supported.
+The basic integer and real
+types are defined in s7.h, defaulting to int64_t and double.  
+A ratio consists of two integers, a complex number consists of two reals.
+pi is predefined.
+s7 can be built with multiprecision support 
+for all types,  using the gmp, mpfr, and mpc libraries (set WITH_GMP to 1 in s7.c).  
+If multiprecision arithmetic is
+enabled, the following functions are included: bignum, and bignum?, and the variable (*s7* 'bignum-precision).
+(*s7* 'bignum-precision) defaults to 128; it sets the number of bits each float takes.
+pi automatically reflects the current (*s7* 'bignum-precision):
+</p>
+
+<pre class="indented">
+&gt; pi
+<em class="gray">3.141592653589793238462643383279502884195E0</em>
+&gt; (*s7* 'bignum-precision)
+<em class="gray">128</em>
+&gt; (set! (*s7* 'bignum-precision) 256)
+<em class="gray">256</em>
+&gt; pi
+<em class="gray">3.141592653589793238462643383279502884197169399375105820974944592307816406286198E0</em>
+</pre>
+
+<p>
+<em class=def id="bignump">bignum?</em> returns #t if its argument is a big number of some type; I use "bignum" 
+for any big number, not just integers.  To create a big number,
+either include enough digits to overflow the default types, or use the <em class=def id="bignum">bignum</em> function.
+Its argument is either a number which it casts to a bignum, or a string representing the desired number:
+</p>
+
+<pre class="indented">
+&gt; (bignum "123456789123456789")
+<em class="gray">123456789123456789</em>
+&gt; (bignum "1.123123123123123123123123123")
+<em class="gray">1.12312312312312312312312312300000000009E0</em>
+</pre>
+
+<p>For read-time bignums:
+</p>
+<pre class="indented">
+(set! *#readers* 
+  (cons (cons #\B (lambda (str)
+	            (bignum (string-&gt;number (substring str 1)))))
+        *#readers*))
+</pre>
+
+<p>and now #B123 is the reader equivalent of (bignum 123).
+</p>
+
+<blockquote> 
+<div class="indented">
+
+<p>In the non-gmp case, if s7 is built using doubles (s7_double in s7.h), the float "epsilon" is
+around (expt 2 -53), or about 1e-16.  In the gmp case, it is around (expt 2 (- (*s7* 'bignum-precision))).
+So in the default case (precision = 128), using gmp:
+</p>
+
+<pre class="indented">
+&gt; (= 1.0 (+ 1.0 (expt 2.0 -128)))
+<em class="gray">#t</em>
+&gt; (= 1.0 (+ 1.0 (expt 2.0 -127)))
+<em class="gray">#f</em>
+</pre>
+
+<p>and in the non-gmp case:
+</p>
+
+<pre class="indented">
+&gt; (= 1.0 (+ 1.0 (expt 2 -53)))
+<em class="gray">#t</em>
+&gt; (= 1.0 (+ 1.0 (expt 2 -52)))
+<em class="gray">#f</em>
+</pre>
+
+<p>In the gmp case, integers and ratios are limited only by the size of memory,
+but reals are limited by (*s7* 'bignum-precision).  This means, for example, that
+</p>
+
+<pre class="indented">
+&gt; (floor 1e56) ; (*s7* 'bignum-precision) is 128
+<em class="gray">99999999999999999999999999999999999999927942405962072064</em>
+&gt; (set! (*s7* 'bignum-precision) 256)
+<em class="gray">256</em>
+&gt; (floor 1e56)
+<em class="gray">100000000000000000000000000000000000000000000000000000000</em>
+</pre>
+
+<p>The non-gmp case is similar, but it's easy to find the edge cases:
+</p>
+
+<pre class="indented">
+&gt; (floor (+ 0.9999999995 (expt 2.0 23)))
+<em class="gray">8388609</em>
+</pre>
+</div> 
+</blockquote>
+
+
+
+
+
+<div class="header" id="math"><h4>math functions</h4></div>
+
+
+<p>
+s7 includes:
+</p>
+
+<ul>
+<li>sinh, cosh, tanh, asinh, acosh, atanh
+<li>logior, logxor, logand, lognot, logbit?, ash, integer-decode-float
+<li>random
+<li>nan?, infinite?, nan, nan-payload
+</ul>
+
+<p>
+The random function can take any numeric argument, including 0.
+Other math-related differences between s7 and r5rs:
+</p>
+
+<ul style="list-style-type:disc;">
+<li>rational? and exact mean integer or ratio (i.e. not floating point), inexact means not exact.
+<li>floor, ceiling, truncate, and round return (exact) integer results.
+<li>"#" does not stand for an unknown digit.
+<li>the "@" complex number notation is not supported ("@" is an exponent marker in s7).
+<li>"+i" is not considered a number; include the real part.
+<li>modulo, remainder, and quotient take integer, ratio, or real arguments.
+<li>lcm and gcd can take integer or ratio arguments.
+<li>log takes an optional second argument, the base.
+<li>'.' and an exponent can occur in a number in any base.
+<li>rationalize returns a ratio! 
+<li>case is significant in numbers, as elsewhere: #b0 is 0, but #B0 is an error.
+</ul>
+
+<pre class="indented">
+&gt; (exact? 1.0)
+<em class="gray">#f</em>
+&gt; (rational? 1.5)
+<em class="gray">#f</em>
+&gt; (floor 1.4)
+<em class="gray">1</em>
+&gt; (remainder 2.4 1)
+<em class="gray">0.4</em>
+&gt; (modulo 1.4 1.0)
+<em class="gray">0.4</em>
+&gt; (lcm 3/4 1/6)
+<em class="gray">3/2</em>
+&gt; (log 8 2)
+<em class="gray">3</em>
+&gt; (number-&gt;string 0.5 2)
+<em class="gray">"0.1"</em>
+&gt; (string-&gt;number "0.1" 2)
+<em class="gray">0.5</em>
+&gt; (rationalize 1.5)
+<em class="gray">3/2</em>
+&gt; (complex 1/2 0)
+<em class="gray">1/2</em>
+&gt; (logbit? 6 1) ; argument order, (logbit? int index), follows gmp, not CL
+<em class="gray">#t</em>
+</pre>
+
+<p>See <a href="#libgsl">cload and libgsl.scm</a> for easy access to GSL,
+and similarly libm.scm for the C math library.
+</p>
+
+<blockquote>
+<div class="indented">
+
+<p>The exponent itself is always in base 10; this follows gmp usage.
+Scheme normally uses "@" for its useless polar notation, but that
+means <code>(string-&gt;number "1e1" 16)</code> is ambiguous &mdash; is the "e" a digit or an exponent marker?
+In s7, "@" is an exponent marker.
+</p>
+
+<pre class="indented">
+&gt; (string-&gt;number "1e9" 2)  ; (expt 2 9)
+<em class="gray">512.0</em>
+&gt; (string-&gt;number "1e1" 12) ; "e" is not a digit in base 12
+<em class="gray">#f</em>
+&gt; (string-&gt;number "1e1" 16) ; (+ (* 1 16 16) (* 14 16) 1)
+<em class="gray">481</em>
+&gt; (string-&gt;number "1.2e1" 3); (* 3 (+ 1 2/3))
+<em class="gray">5.0</em>
+</pre>
+</div>
+
+<div class="indented">
+<p>
+The functions <b>nan</b> and <b>nan-payload</b> refer to the "payload" that can be associated with a NaN.  s7's reader
+can read NaNs with these payloads: <code>+nan.123</code> is a NaN with payload 123.  s7 displays the NaN payload
+in the same way: +nan.123.  A NaN without any payload (or payload 0) is written +nan.0.
+</p>
+<pre class="indented">
+&gt; (nan 123)
+<em class="gray">+nan.123</em>
+&gt; (nan-payload (nan 123))
+<em class="gray">123</em>
+</pre>
+<p>
+The nan function (and s7's reader) always returns a positive NaN.
+</p>
+</div>
+
+<div class="indented">
+<p>
+What is <code>(/ 1.0 0.0)</code>?  s7 gives a "division by zero" error here, and also in <code>(/ 1 0)</code>.
+Guile returns +inf.0 in the first case, which seems reasonable, but a "numerical overflow" error in the second.
+Slightly weirder is <code>(expt 0.0 0+i)</code>.  Currently s7 returns 0.0, Guile returns +nan.0+nan.0i,
+Clisp and sbcl throw an error.  Everybody agrees that <code>(expt 0 0)</code> is 1, and Guile thinks
+that <code>(expt 0.0 0.0)</code> is 1.0.  But <code>(expt 0 0.0)</code> and <code>(expt 0.0 0)</code> return different
+results in Guile (1 and 1.0), both are 0.0 in s7, the first is an error in Clisp, but the second returns 1,
+and so on &mdash; what a mess!  This mess was made a lot worse than it needs to be when the IEEE decreed that
+0.0 equals -0.0, so we can't tell them apart, but that they produce different results:  
+</p>
+
+<pre class="indented">
+scheme@(guile-user)&gt; (= -0.0 0.0)
+<em class="gray">#t</em>
+scheme@(guile-user)&gt; (negative? -0.0)
+<em class="gray">#f</em>
+scheme@(guile-user)&gt; (= (/ 1.0 0.0) (/ 1.0 -0.0))
+<em class="gray">#f</em>
+scheme@(guile-user)&gt;  (&lt; (/ 1.0 -0.0) -1e100 1e100 (/ 1.0 0.0))
+<em class="gray">#t</em>
+</pre>
+
+<p>
+How can they be equal? In s7, the sign
+of -0.0 is ignored, and they really are equal.
+One other oddity: two floats can satisfy eq? and yet not be eqv?:
+<code>(eq? +nan.0 +nan.0)</code> might be #t (it is unspecified), but <code>(eqv? +nan.0 +nan.0)</code> is #f.
+The same problem afflicts memq and assq.  
+</p>
+</div>
+
+
+<div class="indented">
+
+<p>The <em class=def id="random">random</em> function takes a range and an optional state, and returns a number 
+between zero and the range, of the same type as the range.  It is perfectly reasonable
+to use a range of 0, in which case random returns 0.
+<em class=def id="randomstate">random-state</em> creates a new random state from a seed.  If no seed is passed,
+random-state returns the current state.
+If no state is passed to random,
+ir uses some default state initialized from the current time.  <em class=def id="randomstatep">random-state?</em> returns #t if passed a random state object.
+</p>
+
+<pre class="indented">
+&gt; (random 0)
+<em class="gray">0</em>
+&gt; (random 1.0)
+<em class="gray">0.86331198514245</em>
+&gt; (random 3/4)
+<em class="gray">654/1129</em>
+&gt; (random 1+i)
+<em class="gray">0.86300308872748+0.83601002730848i</em>
+&gt; (random -1.0)
+<em class="gray">-0.037691127513267</em>
+&gt; (define r0 (random-state 1234))
+<em class="gray">r0</em>
+&gt; (random 100 r0)
+<em class="gray">94</em>
+&gt; (random 100 r0)
+<em class="gray">19</em>
+&gt; (define r1 (random-state 1234))
+<em class="gray">r1</em>
+&gt; (random 100 r1)
+<em class="gray">94</em>
+&gt; (random 100 r1)
+<em class="gray">19</em>
+</pre>
+
+<p>copy the random-state to save a spot in a random number sequence, or save the random-state as a list via
+random-state-&gt;list, then to restart from that point, apply random-state to that list.
+</p>
+
+<p>In the gmp s7, random calls gmp's random number generator.  There are
+also many generators in GSL (see libgsl.scm).  In the non-gmp s7, we use Marsaglia's MWC algorithm
+which I think is a good compromise between quality and speed.  If you're calling it more than 
+a billion times, it is probably a good idea to reseed it.  The code I use for this in the auto-tester
+is:
+</p>
+<pre class="indented">
+(require libc.scm)
+(define (reseed)
+  (let ((seed (with-let *libc* 
+		(let ((res (clock_gettime CLOCK_MONOTONIC)))
+		  (+ (* 1000000000 (cadr res)) (caddr res)))))
+	(carry (#(1791398085 1929682203 1683268614 1965537969 1675393560 1967773755 1517746329 
+                  1447497129 1655692410 1606218150 2051013963 1075433238 1557985959 1781943330
+                  1893513180 1631296680 2131995753 2083801278 1873196400 1554115554)
+		(random 20))))
+    (random-state seed carry)))
+</pre>
+</div>
+
+
+<div class="indented">
+
+<p>I can't find the right tone for this section; this is the 400-th revision; I wish I were a better writer!
+</p>
+
+<p>In some Schemes,
+"rational" means "could possibly be
+expressed equally well as a ratio: floats are approximations".  In s7 it's: "is actually expressed (at the scheme level) as a ratio (or an integer of course)";
+otherwise "rational?" is the same as "real?":
+</p>
+
+<pre class="indented">
+(not-s7)&gt; (rational? (sqrt 2))
+<em class="gray">#t</em>
+</pre>
+
+<p>That 1.0 is represented at the IEEE-float level as a sort of
+ratio does not mean it has to be a scheme ratio; the two notions are independent.
+</p>
+
+<p>But that confusion is trivial compared to the completely nutty "inexact integer".
+As I understand it, "inexact" originally meant "floating point", and "exact" meant integer or ratio of integers.
+But words have a life of their own.
+0.0 somehow became an "inexact" integer (although it can be represented exactly in floating
+point).  
++inf.0 must be an integer &mdash;
+its fractional part is explicitly zero!  But +nan.0... 
+And then there's:
+</p>
+
+<pre class="indented">
+(not-s7)&gt; (integer? 9007199254740993.1)
+<em class="gray">#t</em>
+</pre>
+
+<p>
+When does this matter?  I often need to index into a vector, but the index is a float (a "real" in Scheme-speak: its
+fractional part can be non-zero).
+In one Scheme:
+</p>
+
+<pre class="indented">
+(not-s7)&gt; (vector-ref #(0) (floor 0.1))
+<em class="gray">ERROR: Wrong type (expecting exact integer): 0.0   </em>; [why?  "it's probably a programmer mistake"!]
+</pre>
+
+<p>Not to worry, I'll use inexact-&gt;exact:
+</p>
+
+<pre class="indented">
+(not-s7)&gt; (inexact-&gt;exact 0.1)
+<em class="gray">3602879701896397/36028797018963968                  </em>; [why? "floats are ratios"!]
+</pre>
+
+<p>So I end up using the verbose <code>(floor (inexact-&gt;exact ...))</code> everywhere, and even
+then I have no guarantee that I'll get a legal vector index. 
+I have never seen any use made of the exact/inexact distinction &mdash; just
+wild flailing to try get around it.
+I think the whole idea is confused and useless, and leads
+to verbose and buggy code.  
+If we discard it,
+we can maintain backwards compatibility via:
+</p>
+
+<pre class="indented">
+(define exact? rational?)
+(define (inexact? x) (not (rational? x)))
+(define inexact-&gt;exact rationalize) ; or floor
+(define (exact-&gt;inexact x) (* x 1.0))
+</pre>
+
+<p>Standard Scheme's #i and #e are also useless because you can
+have any number after, for example, #b:
+</p>
+
+<pre class="indented">
+&gt; #b1.1
+<em class="gray">1.5</em>
+&gt; #b1e2
+<em class="gray">4.0</em>
+&gt; #o17.5+i
+<em class="gray">15.625+1i</em>
+</pre>
+
+<p>s7 uses #i for int-vector and does not implement #e.
+Speaking of #b and friends, what should <code>(string-&gt;number "#xffff" 2)</code> return?
+</p>
+</div>
+
+</blockquote>
+
+
+
+
+<div class="header" id="define*"><h4>define*, lambda*</h4></div>
+
+
+<p><em class=def id="definestar">define*</em> and
+ <em class=def id="lambdastar">lambda*</em>
+are extensions of define and lambda that make it easier
+to deal with optional, keyword, and rest arguments.  
+The syntax is very simple: every parameter to define* has a default value
+and is automatically available as a keyword argument.  The default value
+is either #f if unspecified, or given in a list whose first member is
+the parameter name.
+The last parameter
+can be preceded by :rest or a dot to indicate that all other trailing arguments
+should be packaged as a list under that parameter's name.  A trailing or rest
+parameter's default value is () and can't be specified in the declaration.
+The rest parameter is not available as a keyword argument.
+</p>
+
+<pre class="indented">
+(<em class=red>define*</em> (hi a (b 32) (c "hi")) (list a b c))
+</pre>
+
+<p>Here the parameter "a" defaults to #f, "b" to 32, etc.
+When the function is called, 
+the parameter names are set from the values passed the function,
+then any unset parameters are bound to their default values, evaluated in left-to-right order.
+As the current argument list is scanned,  any name that occurs as a keyword, :arg for example where the parameter name is arg,
+sets that parameter's new value.  Otherwise, as values occur, they
+are plugged into the actual argument list based on their position, counting a keyword/value pair as one argument.
+This is called an optional-key list in CLM.  So, taking the function
+above as an example:
+</p>
+
+<pre class="indented">
+&gt; (hi 1) 
+<em class="gray">(1 32 "hi")</em>
+&gt; (hi :b 2 :a 3) 
+<em class="gray">(3 2 "hi")</em>
+&gt; (hi 3 2 1) 
+<em class="gray">(3 2 1)</em>
+</pre>
+
+<p>See s7test.scm for many examples.  (s7's define* is very close to srfi-89's define*).
+To mark an argument as required, set its default value to a call on the error function:
+</p>
+<pre class="indented">
+&gt; (define* (f a (b (error 'unset-arg "f's b parameter not set"))) (list a b))
+<em class="gray">f</em>
+&gt; (f 1 2)
+(1 2)
+&gt; (f 1)
+<em class=red>error</em><em class="gray">: f's b parameter not set</em>
+</pre>
+
+<blockquote>
+
+<div class="indented">
+<p>The combination of optional and keyword arguments is viewed with disfavor in the Lisp
+community, but the problem is in CL's implementation of the idea, not the idea itself.
+I've used the s7 style since around 1976, and have never found it confusing.  The mistake 
+in CL is to require the optional arguments if a keyword argument occurs, and to consider them as distinct from the
+keyword arguments.  So everyone forgets and puts a keyword where CL expects a required-optional
+argument.  CL then does something ridiculous, and the programmer stomps around shouting about keywords, but the fault lies with CL.
+If s7's way is considered too loose, one way to tighten it might be to insist that once a keyword
+is used, only keyword argument pairs can follow.  
+</p>
+</div>
+
+
+<div class="indented">
+<p>A natural companion of lambda* is named let*.  In named let, the implicit function's
+arguments have initial values, but thereafter, each call requires the full set of arguments.
+Why not treat the initial values as default values? 
+</p>
+
+<pre class="indented">
+&gt; (let* func ((i 1) (j 2)) 
+    (+ i j (if (&gt; i 0) (func (- i 1)) 0)))
+<em class="gray">5</em>
+&gt; (letrec ((func (lambda* ((i 1) (j 2)) 
+                   (+ i j (if (&gt; i 0) (func (- i 1)) 0)))))
+    (func))
+<em class="gray">5</em>
+</pre>
+
+<p>This is consistent with the lambda* arguments because their defaults are
+already set in left-to-right order, and as each parameter is set to its default value,
+the binding is added to the default value expression environment (just as if it were a let*).
+The let* name itself (the implicit function) is not defined until after the bindings
+have been evaluated (as in named let).
+</p>
+
+<p>In CL, keyword default values are handled in the same way:
+</p>
+
+<pre class="indented">
+&gt; (defun foo (&amp;key (a 0) (b (+ a 4)) (c (+ a 7))) (list a b c)) 
+<em class="gray">FOO </em>
+&gt; (foo :b 2 :a 60) 
+<em class="gray">(60 2 67) </em>
+</pre>
+
+<p>In s7, we'd use:
+</p>
+
+<pre class="indented">
+(define* (foo (a 0) (b (+ a 4)) (c (+ a 7))) (list a b c))
+</pre>
+<p>Also CL and s7 handle keywords as values in the same way:
+</p>
+<pre class="indented">
+&gt; (defun foo (&amp;key a) a)
+<em class="gray">FOO</em>
+&gt; (defvar x :a)
+<em class="gray">X</em>
+&gt; (foo x 1)
+<em class="gray">1</em>
+</pre>
+
+<pre class="indented">
+&gt; (define* (foo a) a)
+<em class="gray">foo</em>
+&gt; (define x :a)
+<em class="gray">:a</em>
+&gt; (foo x 1)
+<em class="gray">1</em>
+</pre>
+
+<p>Keywords (named arguments) also work in named let*:
+</p>
+<pre class="indented">
+&gt; (let* loop ((i 0) (j 0)) 
+      (if (> i 3)
+          (+ i j) 
+          (loop :j 2 :i (+ i 1))))
+<em class="gray">6</em>
+</pre>
+</div>
+
+
+<div class="indented">
+
+<p>To try to catch what I believe are usually mistakes, I added two
+error checks.  One is triggered if you set the same parameter twice
+in the same call, and the other if an unknown keyword is encountered
+in the key position.  To turn off these errors, add :allow-other-keys
+at the end of the parameter list.
+These problems arise in a case such as
+</p>
+
+<pre class="indented">
+(define* (f (a 1) (b 2)) (list a b))
+</pre>
+
+<p>You could do any of the following by accident:
+</p>
+
+<pre class="indented">
+(f 1 :a 2)  ; what is a?
+(f :b 1 2)  ; what is b?
+(f :c 3)    ; did you really want a to be :c and b to be 3?
+</pre>
+
+<p>In the last case, to pass a keyword deliberately, either include the
+argument keyword: <code>(f :a :c)</code>, or make the default value a keyword:
+<code>(define* (f (a :c) ...))</code>, or set <code>(*s7* 'accept-all-keyword-arguments)</code>
+to some true value.
+See s7test.scm for many examples.  
+</p>
+
+<p>What if two functions share a keyword argument,
+and one wants to call the other, passing both arguments to the wrapper?
+</p>
+
+<pre class="indented">
+(define* (f1 a) a)                         ; the wrappee
+(define* (f2 a :rest b <em class=red>:allow-other-keys</em>)  ; the wrapper
+  (+ a (apply f1 b)))
+(f2 :a 3 :a 4)                             ; 7, b='(:a 4)
+(let ((c :a)) 
+  (f2 c 3 c 4))                            ; also 7
+</pre>
+
+<p>Since named let* is a form of lambda*, the prohibition of repeated variable names makes it different
+from let*: <code>(let* ((a 1) (a 2)) a)</code> is 2, but <code>(let* loop ((a 1) (a 2)) a)</code> is an error.
+If let* and named let* agreed in this, we'd have an inconsistency with lambda*.  If all three allowed repeated
+variables, the decision as to which parameter is intended becomes messy: <code>((lambda* (a a) a) 2 :a 3)</code>,
+or <code>(let* loop ((a 1) (a 2)) (loop 2 :a 3))</code>.
+CL and standard scheme accept repeated variables in let*, so I think the current
+choice is the least surprising.
+</p>
+
+</div>
+
+
+<div class="indented">
+
+<p>s7's lambda* arglist handling is not the same as CL's lambda-list.  First,
+you can have more than one :rest parameter:
+</p>
+
+<pre class="indented">
+&gt; ((lambda* (:rest a :rest b) (map + a b)) 1 2 3 4 5) 
+<em class="gray">'(3 5 7 9)</em>
+</pre>
+
+<p>and second, the rest parameter, if any, takes up an argument slot just like any other
+argument:
+</p>
+
+<pre class="indented">
+&gt; ((lambda* ((b 3) :rest x (c 1)) (list b c x)) 32)
+<em class="gray">(32 1 ())</em>
+&gt; ((lambda* ((b 3) :rest x (c 1)) (list b c x)) 1 2 3 4 5)
+<em class="gray">(1 3 (2 3 4 5))</em>
+</pre>
+
+<p>CL would agree with the first case if we used &amp;key for 'c', but would give an error in the second.
+Of course, the major difference is that s7 keyword arguments don't insist that the key be present.
+The :rest argument is needed in cases like these because we can't use an expression
+such as:
+</p>
+
+<pre class="indented">
+&gt; ((lambda* ((a 3) . b c) (list a b c)) 1 2 3 4 5)
+<em class="red">error</em><em class="gray">: stray dot?</em>
+&gt; ((lambda* (a . (b 1)) b) 1 2) ; the reader turns the arglist into (a b 1)
+<em class="red">error</em><em class="gray">: lambda* parameter '1 is a constant</em>
+</pre>
+
+<p>Yet another nit: the :rest argument is not considered a keyword argument, so
+</p>
+
+<pre class="indented">
+&gt; (define* (f :rest a) a)
+<em class="gray">f</em>
+&gt; (f :a 1)
+<em class="gray">(:a 1)</em>
+</pre>
+</div>
+
+
+<!--
+unknown key handling is not good, :allow-key-values?
+
+(define* (f1 a) (list a))
+(f1 :hi) -> (:hi)
+(f1 ':hi) -> (:hi)
+(f1 :a :hi) -> (:hi)
+
+(define* (f2 a :allow-other-keys) (list a))
+(f2 :hi) -> (:hi)
+
+(define* (f3 a b :allow-other-keys) (list a b))
+(f3 :hi 0) -> (#f #f)
+(f3 :hi) => (:hi #f)
+
+(define* (f4 a) (list (symbol->keyword a))) ; or string->keyword
+(f4 'hi) -> (:hi)
+
+(define* (f5 a)
+  ((lambda* (hi) (list hi)) (symbol->keyword a) 32)) ; -> ((lambda* (hi) (list hi)) :hi 32) -> '(32)
+(f5 'hi) -> (32)
+
+(define* (f6 a b)
+  ((lambda* (hi) (list hi)) a b))
+(f6 :hi 1) -> unknown key :hi -> (unknown to f6)
+
+(define* (f7 a b) (list a b))
+(f7 :hi) -> (:hi #f)
+(f7 0 :hi) -> (0 :hi)
+(f7 :hi 0) -> unknown key
+(f7 :a :hi) -> (:hi #f)
+(f7 :a :hi 32) -> (:hi 32)
+
+(define* (f8 a b)
+  ((lambda* (hi ho) (list hi ho)) (symbol->keyword a) b))
+(f8 'hi 32) -> (32 #f)
+(f8 'ho 32) -> (#f 32)
+
+
+another amusing lambda* case:
+(call/cc 
+ (lambda* (a (b (call/cc (lambda (c) c)))) ; even with-baffle still a loop (legit)
+   (b (call/cc (lambda (d) d)))))
+
+;; equivalent to:
+(let ((c (call/cc (lambda (c) c))))
+  (call/cc (lambda (a)
+	     (c (call/cc (lambda (d) d))))))
+-->
+
+</blockquote>
+
+
+
+<div class="header" id="macros"><h4>macros</h4></div>
+
+
+<p>
+<em class=def id="definemacro">define-macro</em>, 
+<em class=def id="definemacrostar">define-macro*</em>, 
+<em class=def id="definebacro">define-bacro</em>, 
+<em class=def id="definebacrostar">define-bacro*</em>, 
+<em class=def id="macroexpand">macroexpand</em>,
+<em class=def id="gensym">gensym</em>, 
+<em class=def id="gensym?">gensym?</em>, and 
+<em class=def id="macrop">macro?</em>
+implement the standard old-time macros.  
+The anonymous versions (analogous to lambda and lambda*) are
+macro, macro*, bacro, and bacro*.
+See s7test.scm for many examples of macros including such perennial favorites as
+loop, dotimes, do*, enum, pushnew, and defstruct.
+</p>
+
+<pre class="indented">
+&gt; (define-macro (and-let* vars . body)
+    `(let () 
+       (and ,@(map (lambda (v) 
+                     `(define ,@v))
+                   vars)
+            (begin ,@body))))
+</pre>
+
+<p>macroexpand can help debug a macro.  I always forget that it
+wants an expression:
+</p>
+
+<pre class="indented">
+&gt; (define-macro (add-1 arg) `(+ 1 ,arg))
+<em class="gray">add-1</em>
+&gt; (macroexpand (add-1 32))
+<em class="gray">(+ 1 32)</em>
+</pre>
+
+<p>gensym returns a symbol that is guaranteed to be unique.  It takes an optional string argument
+giving the new symbol name's prefix.  gensym? returns #t if its argument is a symbol created by gensym.
+</p>
+
+<pre class="indented">
+(define-macro (pop! sym)
+  (let ((v (<em class=red>gensym</em>)))
+    `(let ((,v (car ,sym)))
+       (set! ,sym (cdr ,sym))
+       ,v)))
+</pre>
+
+<p>As in define*, the starred forms give optional and keyword arguments:
+</p>
+
+<pre class="indented">
+&gt; (define-macro* (add-2 a (b 2)) `(+ ,a ,b))
+<em class="gray">add-2</em>
+&gt; (add-2 1 3)
+<em class="gray">4</em>
+&gt; (add-2 1)
+<em class="gray">3</em>
+&gt; (add-2 :b 3 :a 1)
+<em class="gray">4</em>
+</pre>
+
+<blockquote>
+<div class="indented">
+
+<p>A macro is a first-class citizen of s7.  You can
+pass it as a function argument, apply it to a list, return it from a function,
+call it recursively, 
+and assign it to a variable.  You can even set its setter!
+</p>
+
+<pre class="indented">
+&gt; (define-macro (hi a) `(+ ,a 1))
+<em class="gray">hi</em>
+&gt; (apply hi '(4))
+<em class="gray">5</em>
+&gt; (define (fmac mac) (apply mac '(4)))
+<em class="gray">fmac</em>
+&gt; (fmac hi)
+<em class="gray">5</em>
+&gt; (define (fmac mac) (mac 4))
+<em class="gray">fmac</em>
+&gt; (fmac hi)
+<em class="gray">5</em>
+&gt; (define (make-mac)
+    (define-macro (hi a) `(+ ,a 1)))
+<em class="gray">make-mac</em>
+&gt; (let ((x (make-mac)))
+    (x 2))
+<em class="gray">3</em>
+&gt; (define-macro (ref v i) `(vector-ref ,v ,i))
+<em class="gray">ref</em>
+&gt; (define-macro (set v i x) `(vector-set! ,v ,i ,x))
+<em class="gray">set</em>
+&gt; (set! (setter ref) set)
+<em class="gray">set</em>
+&gt; (let ((v (vector 1 2 3))) (set! (ref v 0) 32) v)
+<em class="gray">#(32 2 3)</em>
+</pre>
+
+<p>To expand all the macros in a piece of code:
+</p>
+<pre class="indented">
+(define-macro (fully-macroexpand form)
+  (list 'quote
+    (let expand ((form form))
+      (cond ((not (pair? form)) form)
+            ((and (symbol? (car form))
+                  (macro? (symbol-&gt;value (car form))))
+             (expand (apply macroexpand (list form))))
+            ((and (eq? (car form) 'set!)  ; look for (set! (mac ...) ...) and use mac's setter
+                  (pair? (cdr form))
+                  (pair? (cadr form))
+                  (macro? (symbol-&gt;value (caadr form))))
+	     (expand (apply macroexpand (list (cons (setter (symbol-&gt;value (caadr form))) 
+							 (append (cdadr form) (copy (cddr form))))))))
+            (else (cons (expand (car form)) (expand (cdr form))))))))
+</pre>
+<p>This does not always handle bacros correctly because their expansion can depend on the run-time 
+state.
+</p>
+</div>
+
+
+<div class="indented">
+
+<p>A bacro is a macro that expands its body and evaluates
+the result in the calling environment. 
+</p>
+
+<pre class="indented">
+(define setf
+  (let ((args (gensym))
+        (name (gensym)))
+     (apply <em class=red>define-bacro</em> `((,name . ,args)        
+			   (unless (null? ,args)
+			     (apply set! (car ,args) (cadr ,args) ())
+			     (apply setf (cddr ,args)))))))
+</pre>
+
+
+<p>
+The setf argument is a gensym (created when setf is defined) so that its name does not shadow any existing
+variable.  Bacros expand in the calling environment, and a normal argument name
+might shadow something in that environment while the bacro is being expanded.
+Similarly, if you introduce bindings in the bacro expansion code, you need to
+keep track of which environment you want things to happen in.  Use with-let
+and gensym liberally.  
+stuff.scm has bacro-shaker which can find inadvertent name collisions,
+but it is flighty and easily confused.
+The calling environment itself is (outlet (curlet)) from within a bacro, so
+</p>
+
+<pre class="indented">
+(define-bacro (holler)
+  `(format *stderr* "(~S~{ ~S ~S~^~})~%" 
+	   (let ((f (*function*)))
+	     (if (pair? f) (car f) f))
+	   (map (lambda (slot)
+		  (values (symbol-&gt;keyword (car slot)) (cdr slot)))		  
+		(map values ,(outlet (curlet))))))
+
+(define (f1 a b)
+  (holler)
+  (+ a b))
+
+(f1 2 3) ; prints out "(f1 :a 2 :b 3)" and returns 5
+</pre>
+
+<p>
+Since a bacro (normally) sheds its define-time environment:
+</p>
+
+<pre class="indented">
+(define call-bac
+  (let ((<em class=red>x</em> 2))
+    (define-bacro (m a) `(+ ,a ,<em class=red>x</em>))))
+
+&gt; (call-bac 1) 
+<em class="red">error</em><em class="gray">: x: unbound variable</em>
+</pre>
+<p>
+A macro here returns 3.  The bacro can get its define-time environment (its closure)
+via funclet, so define-macro is a special case of define-bacro!  We can define
+macros that work in all four ways: the expansion can happen in either the definition or calling environment,
+as can the evaluation of that expansion.  In a bacro, both happen in the calling environment
+if we take no other action, and in a normal macro (define-macro), the expansion happens in the definition
+environment, and the evaluation in the calling environment.
+Here's a brief example of all four:
+</p>
+
+<pre class="indented">
+(let ((x 1) (y 2)) 
+  (define-bacro (bac1 a) 
+     `(+ ,x y ,a))        ; expand and eval in calling env
+  (let ((x 32) (y 64)) 
+    (bac1 3)))            ; (with-let (inlet 'x 32 'y 64) (+ 32 y 3))
+-&gt; 99                     ;  with-let and inlet refer to <a href="#environments">environments</a>
+
+(let ((x 1) (y 2))        ; this is like define-macro
+  (define-bacro (bac2 a) 
+    (with-let (sublet (funclet bac2) :a a)
+      `(+ ,x y ,a)))      ; expand in definition env, eval in calling env
+  (let ((x 32) (y 64)) 
+    (bac2 3)))            ; (with-let (inlet 'x 32 'y 64) (+ 1 y 3))
+-&gt; 68
+
+(let ((x 1) (y 2))
+  (define-bacro (bac3 a) 
+    (let ((e (with-let (sublet (funclet bac3) :a a)
+	       `(+ ,x y ,a))))
+      `(with-let ,(sublet (funclet bac3) :a a)
+	 ,e)))           ; expand and eval in definition env 
+  (let ((x 32) (y 64)) 
+    (bac3 3)))           ; (with-let (inlet 'x 1 'y 2) (+ 1 y 3))
+-&gt; 6
+
+(let ((x 1) (y 2))
+  (define-bacro (bac4 a) 
+    (let ((e `(+ ,x y ,a)))
+      `(with-let ,(sublet (funclet bac4) :a a)
+	 ,e)))           ; expand in calling env, eval in definition env
+  (let ((x 32) (y 64))     
+    (bac4 3)))           ; (with-let (inlet 'x 1 'y 2) (+ 32 y 3))
+-&gt; 37
+</pre>
+</div>
+
+
+<div class="indented">
+
+<p>Backquote (quasiquote) in s7 is almost trivial.  Constants are unchanged, symbols are quoted,
+",arg" becomes "arg", and ",@arg" becomes "(apply values arg)" &mdash; hooray for real multiple values!
+It's almost as easy to write the actual macro body as the backquoted version of it. 
+</p>
+
+<pre class="indented">
+&gt; (define-macro (hi a) `(+ 1 ,a))
+<em class="gray">hi</em>
+&gt; (procedure-source hi)
+<em class="gray">(lambda (a) (list-values '+ 1 a))</em>
+
+&gt; (define-macro (hi a) `(+ 1 ,@a))
+<em class="gray">hi</em>
+&gt; (procedure-source hi)
+<em class="gray">(lambda (a) (list-values '+ 1 (apply-values a)))</em>
+</pre>
+
+<p>list-values and apply-values are quasiquote helper functions described <a href="#listvalues">below</a>.
+There is no unquote-splicing
+macro in s7;  ",@(...)" becomes "(unquote (apply-values ...))" at read-time.  There shouldn't be any unquote
+either.  In Scheme the reader turns ,x into (unquote x), so:
+</p>
+
+<pre>
+&gt; (let (,'a) unquote)
+<em class="gray">a</em>
+&gt; (let (, (lambda (x) (+ x 1))) ,,,,'3)
+<em class="gray">7</em>
+</pre>
+<p>comma becomes a sort of symbol macro! I think I'll remove unquote; ,x and ,@x will still work
+as expected, but there will not be any "unquote" or "unquote-splicing" in the resultant source code.
+</p>
+</div>
+</blockquote>
+
+<div class="smallseparator"><h4>hygienic macros</h4></div>
+
+<div class="indented">
+tldr: To make a macro hygienic, in the expanded code replace the names of things with the things themselves.  For built-in values, use "#_",
+e.g. "#_abs" rather than "abs".  For macro-definition-time variables, use ",abs" rather than "abs".  If possible, replace other names with gensyms.
+As a last resort, use the explicit environment functions like let-ref and with-let.
+</div>
+
+<p>s7 macros are not hygienic.  For example,
+</p>
+
+<pre class="indented">
+&gt; (define-macro (mac b) 
+    `(let ((a 12)) 
+       (+ a ,b)))
+<em class="gray">mac</em>
+&gt; (let ((a 1) (+ *)) (mac a))
+<em class="gray">144</em>
+</pre>
+
+<p>This returns 144 because '+' has turned into '*', and 'a' is the internal 'a',
+not the argument 'a'.  We get <code>(* 12 12)</code> where we might have expected
+<code>(+ 12 1)</code>.  
+Starting with the '+' problem, 
+as long as the redefinition of '+' is local (that is, it happens after the macro definition), we can unquote the +:
+</p>
+
+<pre class="indented">
+&gt; (define-macro (mac b) 
+    `(let ((a 12)) 
+       (,+ a ,b))) ; ,+ picks up the definition-time +
+<em class="gray">mac</em>
+&gt; (let ((a 1) (+ *)) (mac a))
+<em class="gray">24                 ; (+ a a) where a is 12</em>
+</pre>
+
+<p>But the unquote trick won't work if we have previously loaded some file that redefined '+'
+at the top-level (so at macro definition time, + is *, but we want the built-in +).
+Although this example is silly, the problem is real in Scheme
+because Scheme has no reserved words and only one name space.
+</p>
+
+<pre class="indented">
+&gt; (define + *)
+<em class="gray">+</em>
+&gt; (define (add a b) (+ a b))
+<em class="gray">add</em>
+&gt; (add 2 3)
+<em class="gray">6</em>
+&gt; (define (divide a b) (/ a b))
+<em class="gray">divide</em>
+&gt; (divide 2 3)
+<em class="gray">2/3</em>
+&gt; (set! / -) ; a bad idea &mdash; this turns off s7's optimizer
+<em class="gray">-</em>
+&gt; (divide 2 3)
+<em class="gray">-1</em>
+</pre>
+
+<p>Obviously macros are not the problem here.  Since 
+we might be loading
+code written by others, it's sometimes hard to tell what names
+that code depends on or redefines.
+We need a way to get the pristine (start-up, built-in) value of '+'.
+One long-winded way in s7 uses <a href="#unlet">unlet</a>:
+</p>
+
+<pre class="indented">
+&gt; (define + *)
+<em class="gray">+</em>
+&gt; (define (add a b) (with-let (unlet) (+ a b)))
+<em class="gray">add</em>
+&gt; (add 2 3)
+<em class="gray">5</em>
+</pre>
+
+<p>But this is hard to read, and we might want all three
+values of a symbol, the start-up value, the definition-time value, and the
+current value.  The latter can be accessed with the bare symbol, the definition-time
+value with unquote (','), and the start-up value with either unlet
+or #_&lt;name&gt;.  That is, #_+ is a reader macro for <code>(with-let (unlet) +)</code>.
+</p>
+
+<pre class="indented">
+&gt; (define-macro (mac b) 
+    `(<em class=red>#_let</em> ((a 12)) 
+       (<em class=red>#_+</em> a ,b))) ; #_+ and #_let are start-up values
+<em class="gray">mac</em>
+&gt; (let ((a 1) (+ *)) (mac a))
+<em class="gray">24                 ; (+ a a) where a is 12 and + is the start-up +</em>
+
+;;; make + generic (there's a similar C-based example below)
+&gt; (define (+ . args) 
+    (if (null? args) 0 
+        (apply (if (number? (car args)) <em class=red>#_+ #_string-append</em>) args)))
+<em class="gray">+</em>
+&gt; (+ 1 2)
+<em class="gray">3</em>
+&gt; (+ "hi" "ho")
+<em class="gray">"hiho"</em>
+</pre>
+
+<blockquote>
+<div class="indented">
+<p>Conceptually, #_&lt;name&gt; could be implemented via *#readers*:
+</p>
+<pre class="indented">
+(set! *#readers*
+  (cons (cons #\_ (lambda (str)
+		    (with-let (unlet)
+                      (string-&gt;symbol (substring str 1)))))
+	*#readers*))
+</pre>
+<p>but s7 doesn't let you change the meaning of #\_;  otherwise:
+</p>
+<pre class="indented">
+(set! *#readers* (list (cons #\_ (lambda (str) (string-&gt;symbol (substring str 1))))))
+</pre>
+<p>and now #_ provides no protection:
+</p>
+<pre>
+&gt; (let ((+ -)) (#_+ 1 2))
+<em class="gray">-1</em>
+</pre>
+<p>#t and #f (along with their stupid r7rs cousins #true and #false) are also not settable.
+</p>
+</div>
+</blockquote>
+
+<p>
+So, now we have only the variable capture problem ('a' has been captured in the preceding examples).
+This is the only thing that the gigantic "hygienic macro" systems actually deal with:
+a microscopic problem that you'd think, from the hype, was up there with malaria and the
+national debt.  gensym is the standard approach:
+</p>
+
+<pre class="indented">
+&gt; (define-macro (mac b) 
+    (let ((var (<em class=red>gensym</em>))) 
+      `(#_let ((,var 12))
+         (#_+ ,var ,b))))
+<em class="gray">mac</em>
+&gt; (let ((a 1) (+ *)) (mac a))
+<em class="gray">13</em>
+
+;; or use lambda:
+&gt; (define-macro (mac b) 
+  `((lambda (b) (let ((a 12)) (#_+ a b))) ,b))
+<em class="gray">mac</em>
+&gt; (let ((a 1) (+ *)) (mac a))
+<em class="gray">13</em>
+</pre>
+
+<p>I think syntax-rules and its friends try to conjure up gensyms automatically, but
+the real problem is not name collisions, but unspecified environments.
+In s7 we have first-class environments, so you have complete
+control over the environment at any point:
+</p>
+
+<pre>
+(define-macro (mac b)
+  `(with-let (inlet 'b ,b)
+     (let ((a 12))
+       (+ a b))))
+
+&gt; (let ((a 1) (+ *)) (mac a))
+<em class="gray">13</em>
+
+(define-macro (mac1 . b)         ; originally `(let ((a 12)) (+ a ,@b ,@b))
+  `(with-let (inlet 'e (curlet)) ; this 'e will not collide with the calling env
+     (let ((a 12))               ;   nor will 'a (so no gensyms are needed etc)
+       (+ a (with-let e ,@b) (with-let e ,@b)))))
+
+&gt; (let ((a 1) (e 2)) (mac1 (display a) (+ a e)))
+<em class="gray">18</em>  ; (and it displays "11")
+
+(define-macro (mac2 x)           ; this will use mac2's definition environment for its body
+  `(with-let (sublet (funclet mac2) :x ,x)
+     (let ((a 12))
+       (+ a b x))))              ; a is always 12, b is whatever b happens to be in mac2's env
+
+&gt; (define b 10)                  ; this is mac2's b
+<em class="gray">10</em>
+&gt; (let ((+ *) (a 1) (b 15)) (mac2 (+ a b)))
+<em class="gray">37</em>                               ; mac2 uses its own a (12), b (10), and + (+)
+                                 ;   but (+ a b) is 15 because at that point + is *: (* 1 15)
+</pre>
+
+<p>Hygienic macros are trivial!  Who needs syntax-rules?
+Here's an example of the while macro in stuff.scm before and after 
+hygienification (using "exit" rather than "break"):
+</p>
+
+<pre>
+(define-macro (innocent-while test . body)
+  `(call-with-exit
+    (lambda (exit)
+      (let loop ()
+	(call-with-exit
+	 (lambda (continue)
+	   (do () ((not ,test) (exit))
+	     ,@body)))
+	(loop)))))
+
+(define-macro (cynical-while test . body)
+  (let ((loop (gensym)))
+    `(#_call-with-exit
+       (#_lambda (exit)
+         (#_let ,loop ()
+           (#_call-with-exit
+	     (#_lambda (continue)
+	       (#_do () ((#_not ,test) (exit))
+	         ,@body)))
+	   (,loop))))))
+</pre>
+<p>There are many more examples in s7test.scm (see especially the "or" macros
+toward the end of s7test.scm).
+</p>
+
+<blockquote>
+<div class="indented">
+<pre>
+(define-macro (swap a b) ; assume a and b are symbols
+  `(with-let (inlet 'e (curlet) 'tmp ,a)
+     (set! (e ',a) (e ',b))
+     (set! (e ',b) tmp)))
+
+&gt; (let ((b 1) (tmp 2)) (swap b tmp) (list b tmp))
+<em class="gray">(2 1)</em>
+
+(define-macro (swap a b) ; here a and b can be any settable expressions
+  `(set! ,b (with-let (inlet 'e (curlet) 'tmp ,a) 
+	      (with-let e (set! ,a ,b))
+	      tmp)))
+
+&gt; (let ((v (vector 1 2))) (swap (v 0) (v 1)) v)
+<em class="gray">#(2 1)</em>
+&gt; (let ((tmp (cons 1 2))) (swap (car tmp) (cdr tmp)) tmp)
+<em class="gray">(2 . 1)</em>
+
+(set! (setter swap) (define-macro (set-swap a b c) `(set! ,b ,c)))
+
+&gt; (let ((a 1) (b 2) (c 3) (d 4)) (swap a (swap b (swap c d))) (list a b c d))
+<em class="gray">(2 3 4 1)</em>
+
+;;; but this is simpler:
+(define-macro (rotate! . args)
+  `(set! ,(args (- (length args) 1))
+         (with-let (inlet 'e (curlet) 'tmp ,(car args))
+	   (with-let e 
+	     ,@(map (lambda (a b) `(set! ,a ,b)) args (cdr args)))
+	   tmp)))
+
+&gt; (let ((a 1) (b 2) (c 3)) (rotate! a b c) (list a b c))
+<em class="gray">(2 3 1)</em>
+</pre>
+</div>
+</blockquote>
+
+<!--
+<br>
+<p>
+If you want the macro's expanded result
+to be evaluated in its definition environment:
+</p>
+<pre>
+(let ((a 3))
+  (define-macro (mac b)
+    `(with-let (inlet 'b ,b (funclet mac))
+       (+ a b)))       ; definition-time "a", call-time "b"
+  (define-macro (mac-1 b)
+    `(+ a ,b))         ; call-time "a" and "b"
+  (let ((a 32))
+    (list (mac 1) 
+	  (mac-1 1))))
+</pre>
+-->
+
+<!--
+<blockquote>
+<div class="indented">
+<p>Here are some variations on "unless", inspired by the wikipedia hygienic macro page:
+</p>
+<pre>
+(define-macro (my-unless condition . body)
+ `(with-let (inlet (unlet) :condition ,condition) ; here unlet protects body (format below)
+    (if (not condition) (begin ,@body))))
+
+(let ((not (lambda (x) x))
+      (begin 32)
+      (if +)
+      (format abs))
+  (my-unless #t (format #t "This should not be printed!\n"))
+  (my-unless #f (format #t "This should be printed!\n")))
+
+(set! format abs)
+(let ((not (lambda (x) x)))
+  (my-unless #t (format #t "This should not be printed!\n"))
+  (my-unless #f (format #t "This should be printed!\n")))
+
+(define (user-defined-operator x) (not x))
+
+(define-macro (my-unless-1 condition . body)
+ `(with-let (inlet (unlet) :condition ,condition)
+    (if (user-defined-operator condition) (begin ,@body))))
+
+(let ((user-defined-operator (lambda (x) x)))
+  (my-unless-1 #t (format #t "This should not be printed!\n"))
+  (my-unless-1 #f (format #t "This should be printed!\n")))
+
+(define my-unless-2
+  (let ((op1 (lambda (x) (not x))))
+    (define-macro (_ condition . body)
+      `(with-let (inlet (unlet) (funclet my-unless-2) :condition ,condition) 
+         ;; funclet above to get my-unless-2's version of op1
+	 (if (op1 condition) (begin ,@body))))))
+
+(let ((op1 (lambda (x) x)))
+  (my-unless-2 #t (format #t "This should not be printed!\n"))
+  (my-unless-2 #f (format #t "This should be printed!\n")))
+      
+(define my-unless-3
+  (let ((op1 (lambda (x) x)))
+    (define-macro (_ condition . body)
+      `(with-let (inlet (unlet) :condition ,condition :local-env (curlet)) 
+         ;; curlet to get run-time local version of op1
+	 (if ((with-let local-env op1) condition) (begin ,@body))))))
+
+(let ((op1 (lambda (x) (not x))))
+  (my-unless-3 #t (format #t "This should not be printed!\n"))
+  (my-unless-3 #f (format #t "This should be printed!\n")))
+</pre>
+</div>
+</blockquote>      
+-->
+
+
+<!--
+(define (tree-quote tree args)
+  (if (pair? tree)
+      (if (eq? (car tree) 'quote)
+	  tree
+	  (cons (tree-quote (car tree) args)
+		(tree-quote (cdr tree) args)))
+      (if (memq tree args)
+	  (list 'quote tree)
+	  tree)))
+
+(define-macro (define-hacro name-and-args . body)
+  (let ((name (car name-and-args))
+	(args (cdr name-and-args)))
+    `(define-macro ,name-and-args
+       (list 'with-let 
+	     (list 'inlet ,@(map (lambda (arg)
+				   (values (symbol-&gt;keyword arg) arg))
+				 args))
+	     ,@(tree-quote body args)))))
+
+; (define-hacro (mac a b) `(+ ,a ,b))
+; (macroexpand (mac 2 3))
+; (with-let (inlet :a 2 :b 3) (+ a b))
+; (procedure-source mac)
+; (lambda (a b) (list 'with-let (list 'inlet :a a :b b) (list-values '+ 'a 'b)))
+-->
+
+<blockquote>
+<div class="indented">
+<p>On the subject of *#readers*, say we have:
+</p>
+<pre>
+(set! *#readers* (list (cons #\o (lambda (str) 42))  ; #o... -&gt; 42
+                       (cons #\x (lambda (str) 3)))) ; #x... -&gt; 3
+</pre>
+<p>Now we load a file with:
+</p>
+<pre>
+(define (oct) #o123)
+
+(let-temporarily ((*#readers* ()))
+  (eval (with-input-from-string "(define (hex) #x123)" read)))
+
+(define-constant old-readers *#readers*)
+(set! *#readers* ())
+
+(define (oct1) #o123)
+(define (hex1) #x123)
+
+(set! *#readers* old-readers)
+
+(define (oct2) #o123)
+(define (hex2) #x123)
+</pre>
+<p>Now we evaluate these functions, and get:
+</p>
+<pre>
+(oct): 42   ; oct is not read-time hygienic so #o123 -&gt; 42
+(oct1): 83  ; oct1 is protected by the top-level set, #o123 -&gt; 83
+(oct2): 42  ; same as oct
+(hex): 291  ; hex is protected by let-temporarily + read
+(hex1): 291 ; hex1 is like oct1
+(hex2): 3   ; hex2 is like oct
+</pre>
+
+</div>
+</blockquote>
+
+
+<blockquote>
+<div class="indented">
+
+<p>Here is Peter Seibel's wonderful once-only macro:
+</p>
+
+<pre class="indented">
+(define-macro (once-only names . body)
+  (let ((gensyms (map (lambda (n) (gensym)) names)))
+    `(let (,@(map (lambda (g) (list g '(gensym))) gensyms))
+       `(let (,,@(map (lambda (g n) (list list g n)) gensyms names))
+          ,(let (,@(map list names gensyms))
+             ,@body)))))
+</pre>
+
+<!-- this was:
+(define-macro (once-only names . body)
+  (let ((gensyms (map (lambda (n) (gensym)) names)))
+    `(let (,@(map (lambda (g) `(,g (gensym))) gensyms))
+       `(let (,,@(map (lambda (g n) ``(,,g ,,n)) gensyms names))
+          ,(let (,@(map (lambda (n g) `(,n ,g)) names gensyms))
+             ,@body)))))
+-->
+
+<p>From the land of sparkling bacros:
+</p>
+
+<pre class="indented">
+(define once-only
+  (let ((names (gensym))
+	(body (gensym)))
+    (apply define-bacro `((,(gensym) ,names . ,body)
+      `(let (,@(map (lambda (name) `(,name ,(eval name))) ,names))
+	 ,@,body)))))
+</pre>
+<p>Sadly, with-let is simpler.
+</p>
+</div>
+</blockquote>
+
+
+
+<div class="header" id="pws"><h4>setter</h4></div>
+
+<pre class="indented">
+(<em class=def>setter</em> proc)
+(<em class=def id="dilambda">dilambda</em> proc setter)
+</pre>
+
+<p>There are several kinds of setters, reflecting the many ways that set! can be called.
+First are the symbol setters: 
+</p>
+
+<pre class="indented">
+&gt; (let ((x 1))
+    (set! (setter 'x) (lambda (name new-value) (* new-value 2)))
+    (set! x 2)
+    x)
+<em class="gray">4</em>
+</pre>
+
+<p>Here the setter is a function that is called before the variable is set. 
+It can take two or three arguments.  In the two argument case shown above,
+the first is the variable name (a symbol), and the second is the new-value.
+The variable is set to the value returned by the setter function.
+When s7 sees <code>(set! x 2)</code> above, it calls the setter which returns 4.
+So x is set to 4.  
+</p>
+<p>In some cases you need the environment that the variable lives in (to get its
+current value for example), so you can include that in the setter function parameter list:
+</p>
+
+<pre class="indented">
+&gt; (let ((x 1))
+    (set! (setter 'x) (lambda (name new-value enviroment) (* new-value 2)))
+    (set! x 2)
+    x)
+<em class="gray">4</em>
+
+(define-macro (watch var) ; notification if 'var is set!
+  `(set! (setter ',var) 
+      (lambda (s v e)
+	(format *stderr* "~S set! to ~S~A~%" s v 
+                (let ((func (with-let e (*function*))))
+                  (if (eq? func #&lt;undefined&gt;) "" (format #f ", ~S" func))))
+	v)))
+</pre>
+
+<p>Since symbol setters are often implementing type restrictions, you can use
+the built-in type checking functions such as integer? as a short-hand
+for a setter that insists the new value be an integer:
+</p>
+
+<pre class="indented">
+&gt; (let ((x 1)) 
+    (set! (setter 'x) integer?)
+    (set! x 3.14))
+<em class="red">error</em><em class="gray">: set! x: 3.14, is a real but should be an integer</em>
+
+;;; use typed-let from stuff.scm to do the same thing:
+&gt; (typed-let ((x 3 integer?))
+    (set! x 3.14))
+<em class="red">error</em><em class="gray">: set! x: 3.14, is a real but should be an integer</em>
+</pre>
+
+<p>C-side symbol setters go through s7_set_setter. There is an example <a href="#notify">below</a>.
+</p>
+
+
+<p>The second case is a function setter.  Almost any function or macro can
+have an associated setter that is invoked when the function is the target of set!.
+In this case, the setter function does the set! itself (unlike a symbol setter):
+</p>
+
+<pre class="indented">
+&gt; (setter cadr)
+<em class="gray">#f</em>         ; by default cadr has no setter so (set! (cadr p) x) is an error
+&gt; (set! (setter cadr)  ; add a setter to cadr
+        (lambda (lst val) 
+          (set! (car (cdr lst)) val)))
+<em class="gray">#&lt;lambda (lst val)&gt;</em>
+&gt; (procedure-source (setter cadr))
+<em class="gray">(lambda (lst val) (set! (car (cdr lst)) val))</em>
+&gt; (let ((lst (list 1 2 3))) 
+    (set! (cadr lst) 4)
+    lst)
+<em class="gray">(1 4 3)</em>
+</pre>
+
+<p>In some cases, the setter needs to be a macro:
+</p>
+
+<pre class="indented">
+&gt; (set! (setter logbit?)
+          (define-macro (m var index on) ; here we want to set "var", so we need a macro
+	    `(if ,on
+	         (set! ,var (logior ,var (ash 1 ,index)))
+	         (set! ,var (logand ,var (lognot (ash 1 ,index)))))))
+<em class="gray">m</em>
+&gt; (define (mingle a b)
+    (let ((r 0))
+      (do ((i 0 (+ i 1)))
+          ((= i 31) r)
+        (set! (logbit? r (* 2 i)) (logbit? a i))
+        (set! (logbit? r (+ (* 2 i) 1)) (logbit? b i)))))
+<em class="gray">mingle</em>
+&gt; (mingle 6 3) ; the INTERCAL mingle operator?
+<em class="gray">30</em>
+</pre>
+
+<p>dilambda defines a function (or macro) and its setter without having to set! the setter by hand:
+</p>
+
+<pre class="indented">
+&gt; (define f (let ((x 123))
+                 (dilambda (lambda () 
+                             x)
+		           (lambda (new-value) 
+                             (set! x new-value)))))
+<em class="gray">f</em>
+&gt; (f)
+<em class="gray">123</em> ; x = 123 
+&gt; (set! (f) 32)
+<em class="gray">32</em>  ; now x = 32
+&gt; (f)
+<em class="gray">32</em>
+</pre>
+
+
+<div class="indented">
+
+<p>Here is a pretty example of dilambda:
+</p>
+
+<pre class="indented">
+(define-macro (c?r path)
+  ;; "path" is a list and "X" marks the spot in it that we are trying to access
+  ;; (a (b ((c X)))) &mdash; anything after the X is ignored, other symbols are just placeholders
+  ;; c?r returns a dilambda that gets/sets X
+
+  (define (X-marks-the-spot accessor tree)
+    (if (eq? tree 'X)
+        accessor
+        (and (pair? tree)
+	     (or (X-marks-the-spot (cons 'car accessor) (car tree))
+	         (X-marks-the-spot (cons 'cdr accessor) (cdr tree))))))
+
+  (let ((body 'lst))
+    (for-each
+     (lambda (f)
+       (set! body (list f body)))
+     (reverse (X-marks-the-spot () path)))
+
+    `(<em class=red>dilambda</em>
+      (lambda (lst) 
+	,body)
+      (lambda (lst val)
+	(set! ,body val)))))
+
+&gt; ((c?r (a b (X))) '(1 2 (3 4) 5))
+<em class="gray">3</em>
+&gt; (let ((lst (list 1 2 (list 3 4) 5))) 
+   (set! ((c?r (a b (X))) lst) 32)
+   lst)
+<em class="gray">(1 2 (32 4) 5)</em>
+&gt; (procedure-source (c?r (a b (X))))
+<em class="gray">(lambda (lst) (car (car (cdr (cdr lst)))))</em>
+&gt; ((c?r (a b . X)) '(1 2 (3 4) 5))
+<em class="gray">((3 4) 5)</em>
+&gt; (let ((lst (list 1 2 (list 3 4) 5))) 
+   (set! ((c?r (a b . X)) lst) '(32))
+   lst)
+<em class="gray">(1 2 32)</em>
+&gt; (procedure-source (c?r (a b . X)))
+<em class="gray">(lambda (lst) (cdr (cdr lst)))</em>
+&gt; ((c?r (((((a (b (c (d (e X)))))))))) '(((((1 (2 (3 (4 (5 6)))))))))) 
+<em class="gray">6</em>
+&gt; (let ((lst '(((((1 (2 (3 (4 (5 6))))))))))) 
+    (set! ((c?r (((((a (b (c (d (e X)))))))))) lst) 32) 
+    lst)
+<em class="gray">(((((1 (2 (3 (4 (5 32)))))))))</em>
+&gt; (procedure-source (c?r (((((a (b (c (d (e X)))))))))))
+<em class="gray">(lambda (lst) (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (car (car (car lst)))))))))))))))</em>
+</pre>	
+</div>
+
+<p>I may remove dilambda and dilambda? someday; they are trivial:
+</p>
+
+<pre class="indented">
+(define (dilambda get set) (set! (setter get) set) get)
+(define dilambda? setter)
+</pre>
+
+<p>When a function setter is called, <code>(set! (func ...) val)</code> is
+evaluated by s7 as <code>((setter func) ... val)</code>, so the setter function
+needs to handle both the inner arguments to the function and the new value.
+</p>
+
+<pre class="indented">
+(let ((x 123))
+  (define (f a b) (+ x a b))
+  (set! (setter f) (lambda (a b val) (set! x val)))
+  (display (f 1 2)) (newline) ; "126"
+  (set! (f 1 2) 32)
+  (display (f 1 2)) (newline)) ; "35"
+</pre>
+
+<p>A third type of setter handles vector element type and hash-table key and value types.
+These are described under <a href="#typedvectors">typed vectors</a> and 
+<a href="#typedhash">typed hash-tables</a>.
+</p>
+
+
+<br>
+<blockquote>
+<div class="indented">
+<p>Speaking of INTERCAL, COME-FROM:
+</p>
+
+<pre class="indented">
+(define-macro (define-with-goto-and-come-from name-and-args . body)
+  (let ((labels ())
+	(gotos ())
+	(come-froms ()))
+
+    (let collect-jumps ((tree body))
+      (when (pair? tree)
+	(when (pair? (car tree))
+	  (case (caar tree)
+	    ((label)     (set! labels (cons tree labels)))
+	    ((goto)      (set! gotos (cons tree gotos)))
+	    ((come-from) (set! come-froms (cons tree come-froms)))
+	    (else (collect-jumps (car tree)))))
+	(collect-jumps (cdr tree))))
+
+    (for-each
+     (lambda (goto)
+       (let* ((name (cadr (cadar goto)))
+	      (label (member name labels (lambda (a b) (eq? a (cadr (cadar b)))))))
+	 (if label
+	     (set-cdr! goto (car label))
+	     (error 'bad-goto "can't find label: ~S" name))))
+     gotos)
+    
+    (for-each
+     (lambda (from)
+       (let* ((name (cadr (cadar from)))
+	      (label (member name labels (lambda (a b) (eq? a (cadr (cadar b)))))))
+	 (if label
+	     (set-cdr! (car label) from)
+	     (error 'bad-come-from "can't find label: ~S" name))))
+     come-froms)
+
+    `(define ,name-and-args
+       (let ((label (lambda (name) #f))
+	     (goto (lambda (name) #f))
+	     (come-from (lambda (name) #f)))
+	 ,@body))))
+</pre>
+</div>
+</blockquote>
+
+<!-- (define-macro (please . args) args) -->
+
+
+
+
+<div class="header" id="generalizedset"><h4>applicable objects, generalized set!, generic functions</h4></div>
+
+
+<p>A procedure with a setter can be viewed as one generalization of set!.  Another
+treats objects as having predefined get and set functions.  In s7
+lists, strings, vectors, hash-tables, environments, and any cooperating C or Scheme-defined objects
+are both applicable and settable.  newLisp calls this implicit indexing, Kawa has it, Gauche implements it
+via object-apply, Guile via procedure-with-setter; CL's funcallable instance might be the same idea.
+</p>
+
+<p>
+In <code>(vector-ref #(1 2) 0)</code>, for example, vector-ref is just a type
+declaration.  But in Scheme, type declarations are unnecessary, so we get exactly
+the same result from <code>(#(1 2) 0)</code>.  Similarly, <code>(lst 1)</code> is the
+same as <code>(list-ref lst 1)</code>, and <code>(set! (lst 1) 2)</code> is the same
+as <code>(list-set! lst 1 2)</code>.
+I like this syntax:  the less noise, the better!
+</p>
+
+<blockquote>
+
+<div class="indented">
+
+<p>Well, maybe applicable strings look weird: <code>("hi" 1)</code> is #\i, but worse,
+so is <code>(cond (1 =&gt; "hi"))</code>!  Even though a string, list, or vector is "applicable", it is
+not currently considered to be a procedure, so <code>(procedure? "hi")</code> is #f.  map and for-each, however,
+accept anything that apply can handle, so
+<code>(map #(0 1) '(1 0))</code> is '(1 0).  (On the first call to map in this case, you get the result of
+<code>(#(0 1) 1)</code> and so on).
+string-&gt;list, vector-&gt;list, and let-&gt;list are <code>(map values object)</code>.
+Their inverses are (and always have been) equally trivial.
+</p>
+
+
+<p>The applicable object syntax makes it easy to write generic functions.
+For example, s7test.scm has implementations of Common Lisp's sequence functions.
+length, copy, reverse, fill!, iterate, map and for-each are generic in this sense (map always returns a list).
+</p>
+
+<pre class="indented">
+&gt; (map (lambda (a b) (- a b)) (list 1 2) (vector 3 4))
+<em class="gray">(5 -3 9)</em>
+&gt; (length "hi")
+<em class="gray">2</em>
+</pre>
+
+<p>
+Here's a generic FFT:
+</p>
+
+<pre class="indented">
+(define* (cfft data n (dir 1)) ; complex data
+  (unless n (set! n (length data)))
+  (do ((i 0 (+ i 1))
+       (j 0))
+      ((= i n))
+    (if (&gt; j i)
+	(let ((temp (data j)))
+	  (set! (data j) (data i))
+	  (set! (data i) temp)))
+    (do ((m (/ n 2) (/ m 2)))
+        ((not (&lt;= 2 m j))
+         (set! j (+ j m)))
+     (set! j (- j m))))
+  (do ((ipow (floor (log n 2)))
+       (prev 1)
+       (lg 0 (+ lg 1))
+       (mmax 2 (* mmax 2))
+       (pow (/ n 2) (/ pow 2))
+       (theta (complex 0.0 (* pi dir)) (* theta 0.5)))
+      ((= lg ipow))
+    (do ((wpc (exp theta))
+         (wc 1.0)
+         (ii 0 (+ ii 1)))
+	((= ii prev)
+	 (set! prev mmax))
+      (do ((jj 0 (+ jj 1))
+           (i ii (+ i mmax))
+           (j (+ ii prev) (+ j mmax)))
+          ((&gt;= jj pow)
+	   (set! wc (* wc wpc)))
+        (let ((tc (* wc (data j))))
+          (set! (data j) (- (data i) tc))
+          (set! (data i) (+ (data i) tc))))))
+  data)
+
+&gt; (cfft (list 0.0 1+i 0.0 0.0))
+<em class="gray">(1+1i -1+1i -1-1i 1-1i)</em>
+&gt; (cfft (vector 0.0 1+i 0.0 0.0))
+<em class="gray">#(1+1i -1+1i -1-1i 1-1i)</em>
+</pre>
+
+<p>And a generic function that copies one sequence's elements into another sequence:
+</p>
+<pre class="indented">
+(define (copy-into source dest) ; this is equivalent to (copy source dest)
+  (do ((i 0 (+ i 1))) 
+      ((= i (min (length source) (length dest))) 
+       dest)
+    (set! (dest i) (source i))))
+</pre>
+
+<p>but that is already built-in as the two-argument version of the copy function.
+</p>
+</div>
+
+
+<div class="indented">
+
+<p>There is one place where list-set! and friends are not the same as set!: the former
+evaluate their first argument, but set! does not (with a quibble; see below):
+</p>
+
+<pre class="indented">
+&gt; (let ((str "hi")) (string-set! (let () str) 1 #\a) str)
+<em class="gray">"ha"</em>
+&gt; (let ((str "hi")) (set! (let () str) 1 #\a) str)
+<em class="gray">;((let () str) 1 #\a): too many arguments to set!</em>
+&gt; (let ((str "hi")) (set! ((let () str) 1) #\a) str)
+<em class="gray">"ha"</em>
+&gt; (let ((str "hi")) (set! (str 1) #\a) str)
+<em class="gray">"ha"</em>
+</pre>
+
+<p>set! looks at its first argument to decide what to set.
+If it's a symbol, no problem.  If it's a pair, set! looks at its car to see if it is
+some object that has a setter.  If the car is itself a list, set! evaluates the internal
+expression, and tries again.  So the second case above is the only one that won't work.
+And of course:
+</p>
+
+<pre class="indented">
+&gt; (let ((x (list 1 2))) 
+    (set! ((((lambda () (list x))) 0) 0) 3) 
+    x) 
+<em class="gray">(3 2)</em>
+</pre>
+</div>
+
+
+<div class="indented">
+
+<p>By my count, around 20 of the Scheme built-in functions are already generic in the sense
+that they accept arguments of many types (leaving aside the numeric and type checking functions, take for example equal?, display,
+member, assoc, apply, eval, quasiquote, and values).  s7 extends that list with map, for-each, reverse,
+and length, and adds a few others such as copy, fill!, sort!, object-&gt;string, object-&gt;let, and append.
+newLisp takes a more radical approach than s7: it extends operators such as '&gt;' 
+to compare strings and lists, as well as numbers.  In map and for-each, however, you can mix the argument
+types, so I'm not as attracted to making '&gt;' generic; you can't, for example, <code>(&gt; "hi" 32.1)</code>,
+or even <code>(&gt; 1 0+i)</code>.
+</p>
+</div>
+</blockquote>
+
+<div class="separator"></div>
+
+<p>The somewhat non-standard generic sequence functions in s7 are:
+</p>
+
+<pre class="indented">
+(<em class=def id="sortb">sort!</em> sequence less?)
+(<em class=def id="reverseb">reverse!</em> sequence) and (reverse sequence)
+(<em class=def id="fillb">fill!</em> sequence value (start 0) end)
+(<em class=def id="s7copy">copy</em> obj) and (copy source destination (start 0) end)
+(<em class=def>object-&gt;string</em> obj)
+(object-&gt;let obj)
+(length obj)
+(append . sequences)
+(map func . sequences) and (for-each func . sequences)
+(<a href="#equivalentp">equivalent?</a> obj1 obj2)
+</pre>
+
+<p><b>copy</b> returns a (shallow) copy of its argument.  If a destination is provided,
+it need not match the source in size or type.  The start and end indices refer to the source.
+</p>
+<pre class="indented">
+&gt; (copy '(1 2 3 4) (make-list 2))
+<em class="gray">(1 2)</em>
+&gt; (copy #(1 2 3 4) (make-list 5) 1) ; start at 1 in the source
+<em class="gray">(2 3 4 #f #f)</em>
+&gt; (copy "1234" (make-vector 2))
+<em class="gray">#(#\1 #\2)</em>
+&gt; (define lst (list 1 2 3 4 5))
+<em class="gray">(1 2 3 4 5)</em>
+&gt; (copy #(8 9) (cddr lst))
+<em class="gray">(8 9 5)</em>
+&gt; lst
+<em class="gray">(1 2 8 9 5)</em>
+</pre>
+
+<p><b>reverse!</b> is an in-place version of reverse.  That is, 
+it modifies the sequence passed to it in the process of reversing its contents.  
+If the sequence is a list, remember to use set!:
+<code>(set! p (reverse! p))</code>.  This is somewhat inconsistent with other cases,
+but historically, lisp programmers have treated the in-place reverse as the fast
+version, so s7 follows suit.
+</p>
+<pre class="indented">
+&gt; (define lst (list 1 2 3))
+<em class="gray">(1 2 3)</em>
+&gt; (reverse! lst)
+<em class="gray">(3 2 1)</em>
+&gt; lst
+<em class="gray">(1)</em>
+</pre>
+
+<p>Leaving aside the weird list case,
+<b>append</b> returns a sequence of the same type as its first argument.
+</p>
+
+<pre class="indented">
+&gt; (append #(1 2) '(3 4))
+<em class="gray">#(1 2 3 4)</em>
+&gt; (append (float-vector) '(1 2) (byte-vector 3 4))
+<em class="gray">(float-vector 1.0 2.0 3.0 4.0)</em>
+</pre>
+
+<p>
+<b>sort!</b> sorts a sequence using the
+function passed as its second argument:
+</p>
+
+<pre class="indented">
+&gt; (sort! (list 3 4 8 2 0 1 5 9 7 6) &lt;)
+<em class="gray">(0 1 2 3 4 5 6 7 8 9)</em>
+</pre>
+
+<p>sort! calls qsort or qsort_r; if the sequence is large (more than 1024 elements?), qsort_r may allocate an internal array;
+if the comparison function raises an error, this internal array will probably not be freed.
+</p>
+
+<p>Underlying some of these functions are generic iterators, also built-into s7:
+</p>
+
+<pre class="indented">
+(<em class=def id="makeiterator">make-iterator</em> sequence)
+(<em class=def id="iteratorp">iterator?</em> obj)
+(<em class=def id="iterate">iterate</em> iterator)
+(<em class=def id="iteratorsequence">iterator-sequence</em> iterator)
+(<em class=def id="iteratoratend">iterator-at-end?</em> iterator)
+</pre>
+
+<p><b>make-iterator</b> takes a sequence argument and returns an iterator object that traverses
+that sequence as it is called.  The iterator itself can be treated as a function of no arguments,
+or (for code clarity) it can be the argument to <b>iterate</b>, which does the same thing.
+That is <code>(iter)</code> is the same as <code>(iterate iter)</code>.  The sequence that an iterator is traversing
+is <b>iterator-sequence</b>.
+</p>
+<p>
+If the sequence is a hash-table or let, the iterator normally returns a cons of the key and value.
+There are many cases where this overhead is objectionable, so make-iterator takes a third optional
+argument, the cons to use (changing its car and cdr directly on each call).
+</p>
+
+<p>When an iterator reaches the end of its sequence, it returns #&lt;eof&gt;.  It used to
+return nil; I can't decide whether this change is an improvement.  If an iterator over a
+list notices that its list is circular, it returns #&lt;eof&gt;.  map and for-each use
+iterators, so if you pass a circular list to either, it will stop eventually.  (An
+arcane consequence for method writers: specialize make-iterator, not map or for-each).
+</p>
+
+<pre class="indented">
+(define (find-if f sequence)
+  (let ((iter (make-iterator sequence)))
+    (do ((x (iter) (iter)))
+	((or (eof-object? x) (f x))
+	 (and (not (eof-object? x)) x)))))
+</pre>
+
+<p>But of course a sequence might contain #&lt;eof&gt;! So to be really safe, use iterator-at-end? 
+instead of eof-object?.
+</p>
+
+<p>The argument to make-iterator can also be a function or macro.  
+In this case, to be acceptable to iterate, the closure's environment must have a
+variable named '+iterator+ with a non-#f value:
+</p>
+<pre class="indented">
+(define (make-circular-iterator obj)
+  (let ((iter (make-iterator obj)))
+    (make-iterator 
+     (let ((+iterator+ #t))
+       (lambda ()
+         (case (iter) 
+           ((#&lt;eof&gt;) ((set! iter (make-iterator obj))))
+           (else)))))))
+</pre>
+<p>The +iterator+ variable is similar to the '+documentation+ variable used by documentation.
+It gives make-iterator some hope of catching inadvertent bogus function arguments that would
+otherwise cause an infinite loop.  But unfortunately it can escape and infect 
+other functions:
+</p>
+<pre class="indented">
+(with-let (let ((<em class="red">+iterator+</em> #t)) 
+            (lambda () #&lt;eof&gt;))             ; we intended this to be our iterator
+  (concatenate vector (lambda a (copy a)))) ; from stuff.scm
+  ;; (lambda a (copy a)) is also considered an iterator by map (in sequences-&gt;list) because 
+  ;; the local +iterator+ is #t. "a" is () because there are no further arguments to
+  ;; concatenate, so (lambda a (copy a)) is generating infinitely many ()'s and this 
+  ;; code eventually dies with a heap overflow!
+</pre>
+
+
+
+<div class="header" id="multidimensionalvectors"><h4>multidimensional vectors</h4></div>
+
+
+<p>
+s7 supports
+vectors with any number of dimensions.  It is here, in particular, that generalized
+set! shines.  make-vector's first argument can be a list of dimensions, rather than
+an integer as in the one dimensional case:
+</p>
+
+<pre class="indented">
+(make-vector (list 2 3 4))
+(make-vector '(2 3) 1.0)
+(vector-dimensions (make-vector '(2 3 4))) -&gt; (2 3 4)
+</pre>
+
+<p>The second example includes the optional initial element.
+<code>(vect i ...)</code> or <code>(vector-ref vect i ...)</code> return the given
+element, and <code>(set! (vect i ...) value)</code> and <code>(vector-set! vect i ... value)</code>
+set it.  vector-length (or just length) returns the total number of elements.
+vector-dimensions returns a list of the dimensions; vector-rank returns the length of this list, 
+and vector-dimension returns the nth member of the list (the size of the nth dimension).
+</p>
+
+<pre class="indented">
+&gt; (define v (make-vector '(2 3) 1.0))
+<em class="gray">#2d((1.0 1.0 1.0) (1.0 1.0 1.0))</em>
+&gt; (set! (v 0 1) 2.0)
+<em class="gray">#2d((1.0 2.0 1.0) (1.0 1.0 1.0))</em>
+&gt; (v 0 1)
+<em class="gray">2.0</em>
+&gt; (vector-length v)
+<em class="gray">6</em>
+</pre>
+
+<p>This function initializes each element of a multidimensional vector:
+</p>
+
+<pre class="indented">
+(define (make-array dims . inits)
+  (subvector (apply vector (flatten inits)) 0 (apply * dims) dims))
+
+&gt; (make-array '(3 3) '(1 1 1) '(2 2 2) '(3 3 3))
+<em class="gray">#2d((1 1 1) (2 2 2) (3 3 3))</em>
+</pre>
+
+<p>make-int-vector, make-float-vector, and make-byte-vector produce homogeneous vectors holding
+s7_ints, s7_doubles, or unsigned bytes.
+</p>
+
+<pre class="indented">
+(<em class=def id="makevector">make-vector</em> length-or-list-of-dimensions initial-value element-type-function)
+(<em class=def id="vectordimensions">vector-dimensions</em> vect)
+(<em class=def id="vectordimension">vector-dimension</em> vect n)
+(<em class=def id="vectorrank">vector-rank</em> obj)
+(<em class=def id="vectortyper">vector-typer</em> obj)
+
+(<em class=def>float-vector?</em> obj)
+(<em class=def>float-vector</em> . args)
+(<em class=def>make-float-vector</em> len (init 0.0))
+(<em class=def>float-vector-ref</em> obj . indices)
+(<em class=def>float-vector-set!</em> obj indices[...] value)
+
+(<em class=def id="intvectorp">int-vector?</em> obj)
+(<em class=def id="intvector">int-vector</em> . args)
+(<em class=def id="makeintvector">make-int-vector</em> len (init 0))
+(<em class=def id="intvectorref">int-vector-ref</em> obj . indices)
+(<em class=def id="intvectorset">int-vector-set!</em> obj indices[...] value)
+
+(<em class=def id="bytevectorp">byte-vector?</em> obj)
+(<em class=def id="bytevector">byte-vector</em> . args)
+(<em class=def id="makebytevector">make-byte-vector</em> len (init 0))
+(<em class=def id="bytevectorref">byte-vector-ref</em> obj . indices)
+(<em class=def id="bytevectorset">byte-vector-set!</em> obj indices[...] byte)
+(<em class=def id="bytep">byte?</em> obj)
+
+(<em class=def id="stringtobytevector">string-&gt;byte-vector</em> str)
+(<em class=def id="bytevectortostring">byte-vector-&gt;string</em> str)
+
+(<em class=def id="subvector">subvector</em> vector start end dimensions)
+(<em class=def id="subvectorp">subvector?</em> obj) 
+(<em class=def id="subvectorvector">subvector-vector</em> obj) 
+(<em class=def id="subvectorposition">subvector-position</em> obj)
+</pre>
+
+<p id="typedvectors">In addition to the dimension list mentioned above, make-vector accepts
+optional arguments giving the initial element and the element type. If the
+type is given, every attempt to set an element of the vector first calls
+the type function on the new value.  
+If the type function is omitted (or set to #t),
+no type checking is performed.
+If the type function is a closure (rather than a C-defined or built-in function),
+its name must be accessible; it can't be an anonymous lambda (the signature and
+error handlers need this name).  <a href="#vectortyper">vector-typer</a> returns or sets this type function;
+when set via vector-typer, there is no automatic check that the vector's current contents
+match that type function.
+</p>
+
+<pre class="indented">
+&gt; (define v (make-vector 3 'x symbol?)) ; initial element: 'x, elements must be symbols
+<em class="gray">#(x x x)</em>
+&gt; (vector-set! v 0 123)
+<em class="red">error</em><em class="gray">: vector-set! argument 3, 123, is an integer but should be a symbol?</em>
+&gt; (define (10|12? val) (memv val '(10 12)))
+<em class="gray">10|12?</em>
+&gt; (define v1 (make-vector 3 10 10|12?)) ; only allow values 10 or 12 (initially 10)
+<em class="gray">#(10 10 10)</em>
+&gt; (set! (v1 0) 12)
+<em class="gray">12</em>
+&gt; v1
+<em class="gray">#(12 10 10)</em>
+&gt; (set! (v1 1) 32)
+<em class="red">error</em><em class="gray">: vector-set! argument 3, 32, is an integer but should be a 10|12?</em>
+</pre>
+
+<p>To access a vector's elements with different dimensions than the original had, use 
+<code>(subvector original-vector 0 (length original-vector) new-dimensions)</code>:
+</p>
+
+<pre class="indented">
+&gt; (let ((v1 #2d((1 2 3) (4 5 6)))) 
+    (let ((v2 (subvector v1))) ; flatten the original (1D is the default)
+      v2))
+<em class="gray">#(1 2 3 4 5 6)</em>
+&gt; (let ((v1 #(1 2 3 4 5 6))) 
+    (let ((v2 (subvector v1 0 6 '(3 2)))) 
+      v2))
+<em class="gray">#2d((1 2) (3 4) (5 6))</em>
+</pre>
+<p>A subvector is a window onto some other vector's data.  The data is not copied, just accessed differently.
+The new-dimensions parameter is a list giving the lengths of the dimensions.  The start and
+end parameters refer to positions in the original vector.
+subvector-vector returns
+the underlying vector, and subvector-position returns the starting point of the subvector
+in the underlying data.
+</p>
+
+<!--
+<div class="small">
+<p>subvector's parameter list changed 8-Jul-2020. It was <code>(subvector vect new-length-or-dimension-list start)</code>,
+but that conflicts with substring, and is confusing (the start position follows the length).  To translate from
+the old subvector to the new:
+</p>
+<pre class="indented">
+(define* (old-subvector vect len (offset 0))
+  (if (pair? len)
+      (subvector vect offset (+ offset (apply * len)) len)
+      (if (not len)
+          (subvector vect offset (length vect))
+          (subvector vect offset (+ offset len)))))
+</pre>
+</div>
+-->
+<blockquote>
+
+<div class="indented">
+
+<p>matrix multiplication:
+</p>
+
+<pre>
+(define (matrix-multiply A B)
+  ;; assume square matrices and so on for simplicity
+  (let ((size (car (vector-dimensions A))))
+    (do ((C (make-vector (list size size) 0))
+         (i 0 (+ i 1)))
+	((= i size) C)
+      (do ((j 0 (+ j 1)))
+	  ((= j size))
+	(do ((sum 0)
+             (k 0 (+ k 1)))
+	    ((= k size)
+             (set! (C i j) sum))
+	  (set! sum (+ sum (* (A i k) (B k j)))))))))
+</pre>
+</div>
+
+
+<div class="indented">
+
+<p>Conway's game of Life:
+</p>
+
+<pre>
+(define* (life (width 40) (height 40))
+  (let ((state0 (make-vector (list width height) 0))
+	(state1 (make-vector (list width height) 0)))
+
+    ;; initialize with some random pattern
+    (do ((x 0 (+ x 1)))
+	((= x width))
+      (do ((y 0 (+ y 1)))
+	  ((= y height))
+	(set! (state0 x y) (if (&lt; (random 100) 15) 1 0))))
+
+    (do () ()
+      ;; show current state (using terminal escape sequences, borrowed from the Rosetta C code)
+      (format *stderr* "~C[H" #\escape)           ; ESC H = tab set
+      (do ((y 0 (+ y 1)))
+	  ((= y height))
+	(do ((x 0 (+ x 1)))
+	    ((= x width))
+	  (format *stderr*
+                  (if (zero? (state0 x y))
+	              "  "                        ; ESC 07m below = inverse
+	              (values "~C[07m  ~C[m" #\escape #\escape))))
+	(format *stderr* "~C[E" #\escape))        ; ESC E = next line
+
+      ;; get the next state
+      (do ((x 1 (+ x 1)))
+	  ((= x (- width 1)))
+	(do ((y 1 (+ y 1)))
+	    ((= y (- height 1)))
+	  (let ((n (+ (state0 (- x 1) (- y 1))
+		      (state0    x    (- y 1))
+		      (state0 (+ x 1) (- y 1))
+		      (state0 (- x 1)    y)      
+		      (state0 (+ x 1)    y)      
+		      (state0 (- x 1) (+ y 1))
+		      (state0    x    (+ y 1))
+		      (state0 (+ x 1) (+ y 1)))))
+	    (set! (state1 x y) 
+		  (if (or (= n 3) 
+			  (and (= n 2)
+			       (not (zero? (state0 x y)))))
+		      1 0)))))
+      (copy state1 state0))))
+</pre>
+</div>
+
+
+<div class="indented">
+
+<p>Multidimensional vector constant syntax is modelled after CL: #nd(...)
+signals that the lists specify the elements of an 'n' dimensional vector: <code>#2d((1 2 3) (4 5 6))</code>
+int-vector constants use #i, float-vectors use #r.  I wanted to use #f, but that is already taken.
+Append the "nd" business after the type indication: <code>#i2d((1 2) (3 4))</code>.  This syntax
+collides with the r7rs byte-vector notation "#u8"; s7 uses "#u" for byte-vectors.  "#u2d(...)" is a two-dimensional byte-vector.
+For backwards compatibility, you can use "#u8" for one-dimensional byte-vectors.
+</p>
+
+<pre class="indented">
+&gt; (vector-ref #2d((1 2 3) (4 5 6)) 1 2)
+<em class="gray">6</em>
+&gt; (matrix-multiply #2d((-1 0) (0 -1)) #2d((2 0) (-2 2)))
+<em class="gray">#2d((-2 0) (2 -2))</em>
+&gt; (int-vector 1 2 3)
+<em class="gray">#i(1 2 3)</em>
+&gt; (make-float-vector '(2 3) 1.0)
+<em class="gray">#r2d((1.0 1.0 1.0) (1.0 1.0 1.0))</em>
+&gt; (vector (vector 1 2) (int-vector 1 2) (float-vector 1 2))
+<em class="gray">#(#(1 2) #i(1 2) #r(1.0 2.0))</em>
+</pre>
+
+<p>If any dimension has 0 length, you get an n-dimensional empty vector.  It is not
+equal to a 1-dimensional empty vector.
+</p>
+
+<pre class="indented">
+&gt; (make-vector '(10 0 3))
+<em class="gray">#3d()</em>
+&gt; (equal? #() #3d())
+<em class="gray">#f</em>
+</pre>
+</div>
+
+
+<div class="indented">
+
+<p>To save on costly parentheses, and make it easier to write generic multidimensional sequence functions,
+you can use this same syntax with lists.
+</p>
+
+<pre class="indented">
+&gt; (let ((L '((1 2 3) (4 5 6))))
+    (L 1 0))              ; same as (list-ref (list-ref L 1) 0) or ((L 1) 0)
+<em class="gray">4</em>
+&gt; (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) 
+    (set! (L 1 0 2) 32)   ; same as (list-set! (list-ref (list-ref L 1) 0) 2 32) which is unreadable!
+    L)
+<em class="gray">(((1 2 3) (4 5 6)) ((7 8 32) (10 11 12)))</em>
+</pre>
+
+<p>Or with vectors of vectors, of course:
+</p>
+
+<pre class="indented">
+&gt; (let ((V #(#(1 2 3) #(4 5 6)))) 
+    (V 1 2))              ; same as (vector-ref (vector-ref V 1) 2) or ((V 1) 2)
+<em class="gray">6</em>
+&gt; (let ((V #2d((1 2 3) (4 5 6))))
+    (V 0))
+<em class="gray">#(1 2 3)</em>
+</pre>
+
+<p>There's one difference between a vector-of-vectors and a multidimensional vector:
+in the latter case, you can't clobber one of the inner vectors. 
+</p>
+
+<pre class="indented">
+&gt; (let ((V #(#(1 2 3) #(4 5 6)))) (set! (V 1) 32) V)
+<em class="gray">#(#(1 2 3) 32)</em>
+&gt; (let ((V #2d((1 2 3) (4 5 6)))) (set! (V 1) 32) V)
+<em class="gray">;not enough arguments for vector-set!: (#2d((1 2 3) (4 5 6)) 1 32)</em>
+</pre>
+</div>
+
+
+
+<div class="indented">
+
+<p>Using lists to display the inner vectors may not be optimal, especially when the elements are also lists:
+</p>
+
+<pre class="indented">
+#2d(((0) (0) ((0))) ((0) 0 ((0))))
+</pre>
+
+<p>The "#()" notation is no better (the elements can be vectors), and I'm not a fan of "[]" parentheses.
+Perhaps we could use different colors?  Or different size parentheses?
+</p>
+
+<pre class="indented">
+#2D<em class=green>(</em><em class=red>(</em>(0) (0) ((0))<em class=red>)</em> <em class=red>(</em>(0) 0 ((0))<em class=red>)</em><em class=green>)</em>
+#2D<em class="bigger">(</em><em class="big">(</em>(0) (0) ((0))<em class="big">)</em> <em class="big">(</em>(0) 0 ((0))<em class="big">)</em><em class="bigger">)</em>
+</pre>
+
+</div>
+
+
+
+<div class="indented">
+
+<p>I'm not sure how to handle vector-&gt;list and list-&gt;vector in the multidimensional case.
+Currently, vector-&gt;list flattens the vector, and list-&gt;vector always returns a
+one dimensional vector, so the two are not inverses.
+</p>
+
+<pre class="indented">
+&gt; (vector-&gt;list #2d((1 2) (3 4)))
+<em class="gray">(1 2 3 4)</em>             ; should this be '((1 2) (3 4)) or '(#(1 2) #(3 4))?
+&gt; (list-&gt;vector '(#(1 2) #(3 4))) ; what about '((1 2) (3 4))?
+<em class="gray">#(#(1 2) #(3 4))      </em>
+</pre>
+
+<p>
+This also affects format and sort!:
+</p>
+
+<pre class="indented">
+&gt; (format #f "~{~A~^ ~}" #2d((1 2) (3 4)))
+<em class="gray">"1 2 3 4"</em>
+&gt; (sort! #2d((1 4) (3 2)) &gt;) 
+<em class="gray">#2d((4 3) (2 1))</em>
+</pre>
+
+<p>Perhaps subvector can help:
+</p>
+
+<pre class="indented">
+&gt;(subvector (list-&gt;vector '(1 2 3 4)) 0 4 '(2 2))
+<em class="gray">#2d((1 2) (3 4))</em>
+&gt; (let ((a #2d((1 2) (3 4)))
+        (b #2d((5 6) (7 8))))
+  (list (subvector (append a b) 0 8 '(2 4))
+	(subvector (append a b) 0 8 '(4 2))
+	(subvector (append (a 0) (b 0) (a 1) (b 1)) 0 8 '(2 4))
+	(subvector (append (a 0) (b 0) (a 1) (b 1)) 0 8 '(4 2))))
+<em class="gray">(#2d((1 2 3 4) (5 6 7 8)) 
+ #2d((1 2) (3 4) (5 6) (7 8)) 
+ #2d((1 2 5 6) (3 4 7 8)) 
+ #2d((1 2) (5 6) (3 4) (7 8)))</em>
+</pre>
+
+</div>
+
+<div class="indented">
+
+<p>Another question: should we accept the multi-index syntax in a case such as <code>
+(#("abc" "def") 0 2)</code>?
+My first thought was that the indices should all refer to the same
+type of object, so s7 would complain in a mixed case like that.
+If we can nest any applicable objects and apply the whole thing to
+an arbitrary list of indices, ambiguities arise:
+</p>
+
+<pre class="indented">
+((lambda (x) x) "hi" 0) 
+((lambda (x) (lambda (y) (+ x y))) 1 2)
+</pre>
+
+<p>I think these should complain that the function got too many arguments,
+but from the implicit indexing point of view, they could be interpreted
+as:
+</p>
+
+<pre class="indented">
+(string-ref ((lambda (x) x) "hi") 0) ; i.e. (((lambda (x) x) "hi") 0)
+(((lambda (x) (lambda (y) (+ x y))) 1) 2)
+</pre>
+
+<p>Add optional and rest arguments, and you can't tell who is supposed to
+take which arguments.  
+Currently, you can mix types with implicit indices, but if you implicitly
+call an element of a sequence that is a function
+that is not known to be "safe" (unproblematic) you'll get an error.
+To insist that all objects are of the same type, use an explicit getter:
+</p>
+
+<pre class="indented">
+&gt; (list-ref (list 1 (list 2 3)) 1 0) ; same as ((list 1 (list 2 3)) 1 0)
+<em class="gray">2</em>
+&gt; ((list 1 (vector 2 3)) 1 0)
+<em class="gray">2</em>
+&gt; (list-ref (list 1 (vector 2 3)) 1 0)
+<em class="red">error</em><em class="gray">: list-ref argument 1, #(2 3), is a vector but should be a proper list</em>
+</pre>
+</div>
+
+</blockquote>
+
+
+
+<div class="header" id="hashtables"><h4>hash-tables</h4></div>
+
+
+<ul>
+<li>(<em class=def id="makehashtable">make-hash-table</em> (size 8) eq-func typers)
+<li>(<em class=def id="makeweakhashtable">make-weak-hash-table</em> (size 8) eq-func typers)
+<li>(<em class=def id="hashtable">hash-table</em> ...)
+<li>(<em class=def id="weakhashtable">weak-hash-table</em> ...)
+<li>(<em class=def id="hashtablep">hash-table?</em> obj)
+<li>(<em class=def id="weakhashtablep">weak-hash-table?</em> obj)
+<li>(<em class=def id="hashtableref">hash-table-ref</em> ht key)
+<li>(<em class=def id="hashtableset">hash-table-set!</em> ht key value)
+<li>(<em class=def id="hashtableentries">hash-table-entries</em> ht)
+<li>(<em class=def id="hashtablekeytyper">hash-table-key-typer</em> obj)
+<li>(<em class=def id="hashtablevaluetyper">hash-table-value-typer</em> obj)
+<li>(<em class=def id="hashcode">hash-code</em> obj eqfunc)
+</ul>
+
+<p>
+Each hash-table keeps track of the keys it contains, optimizing the search wherever possible.
+Any s7 object can be the key or the key's value.
+If you pass a table size that is not a power of 2, make-hash-table rounds it up to the next power of 2.
+The table grows as needed.  length returns the current size.
+If a key is not in the table, hash-table-ref returns #f.  To remove a key,
+set its value to #f; to remove all keys, <code>(fill! table #f)</code>.
+</p>
+
+<pre class="indented">
+&gt; (let ((ht (make-hash-table)))
+    (set! (ht "hi") 123)
+    (ht "hi"))
+<em class="gray">123</em>
+</pre>
+
+<p>hash-table (the function) parallels the functions vector, list, and string.  
+Its arguments are
+the keys and values: <code>(hash-table 'a 1 'b 2)</code>.
+Implicit indexing gives multilevel hashes:
+</p>
+
+<pre class="indented">
+&gt; (let ((h (hash-table 'a (hash-table 'b 2 'c 3)))) (h 'a 'b))
+<em class="gray">2</em>
+&gt; (let ((h (hash-table 'a (hash-table 'b 2 'c 3)))) (set! (h 'a 'b) 4) (h 'a 'b))
+<em class="gray">4</em>
+</pre>
+
+<p>hash-code is like Common Lisp's sxhash.  It returns an integer that can be associated with
+an s7 object when implementing your own hash-tables.  s7test.scm has an example using vectors.
+In this case the eqfunc argument is ignored (hash-code assumes equal? is in use).
+</p>
+
+
+<blockquote>
+
+<div class="indented">
+
+<p>Since hash-tables accept the same applicable-object syntax that vectors use, we can 
+treat a hash-table as, for example, a sparse array:
+</p>
+
+<pre class="indented">
+&gt; (define make-sparse-array make-hash-table)
+<em class="gray">make-sparse-array</em>
+&gt; (let ((arr (make-sparse-array)))
+   (set! (arr 1032) "1032")
+   (set! (arr -23) "-23")
+   (list (arr 1032) (arr -23)))
+<em class="gray">("1032" "-23")</em>
+</pre>
+</div>
+
+
+<div class="indented">
+
+<p>map and for-each accept hash-table arguments. On each iteration, the map or for-each function is passed
+an entry, <code>'(key . value)</code>, in whatever order the entries are encountered in the table. 
+</p>
+
+<pre class="indented">
+(define (hash-table-&gt;alist table)
+  (map values table))
+</pre>
+
+<p>reverse of a hash-table returns a new table with the keys and values reversed.
+fill! sets all the values.
+Two hash-tables are equal if they have the same keys with the same values.  This is independent
+of the table sizes, or the order in which the key/value pairs were added.
+</p>
+</div>
+
+<div class="indented">
+<p>The second argument to make-hash-table (eq-func) is slightly complicated.  If it is omitted (or #f),
+s7 chooses the hashing equality and mapping functions based on the keys in the hash-table.
+There are times when you know
+in advance what equality function you want.  If it's one of the built-in s7 equality
+functions, eq?, eqv?, equal?, equivalent?, =, string=?, string-ci=?, char=?, or char-ci=?,
+you can pass that function as the second argument.  In any other case, you need to
+give s7 both the equality function and the mapping function. The latter takes any object
+and returns the hash-table location for it (an integer).  The problem here is that
+for the arbitrary equality function to work, objects that are equal according to that
+function have to be mapped to the same hash-table location.  There's no way for s7 to intuit
+what this mapping should be except in the built-in cases.  So to specify some arbitrary function, the second
+argument is a cons: '(equality-checker mapper).
+</p>
+
+<p>Here's a brief example.  In CLM, we have c-objects of type mus-generator (from s7's point of view),
+and we want to hash them using equal? (which will call the generator-specific equality function).
+But s7 doesn't realize that the mus-generator type covers 40 or 50 internal types, so as the mapper we pass mus-type:
+<code>(make-hash-table 64 (cons equal? mus-type))</code>.
+</p>
+</div>
+
+<div class="indented">
+<p>If the hash key is a float (a non-rational number), hash-table-ref uses <a href="#equivalentp">equivalent?</a>.
+Otherwise, for example, you could use NaN as a key, but then never be able to access it!
+</p>
+</div>
+
+<div class="indented">
+<p>To implement read-time hash-tables using #h(...):
+</p>
+<pre>
+(set! *#readers* 
+      (cons (cons #\h (lambda (str)
+			(and (string=? str "h") ; #h(...)
+			     (apply hash-table (read)))))
+	    *#readers*))
+
+(display #h(:a 1)) (newline)
+(display #h(:a 1 :b "str")) (newline)
+</pre>
+<p>These can be made immutable by <code>(immutable! (apply...))</code>, or even better,
+</p>
+<pre>
+(let ((h (apply hash-table (read)))) 
+  (if (&gt; (*s7* 'safety) 1) (immutable! h) h))
+</pre>
+</div>		  
+
+
+<div class="indented">
+<pre>
+(define-macro (define-memoized name&amp;arg . body)
+  (let ((arg (cadr name&amp;arg))
+	(memo (gensym "memo")))
+    `(define ,(car name&amp;arg)
+       (let ((,memo (<em class=red>make-hash-table</em>)))
+	 (lambda (,arg)
+	   (or (,memo ,arg)                             ; check for saved value
+	       (set! (,memo ,arg) (begin ,@body)))))))) ; set! returns the new value
+
+&gt; (define (fib n) 
+  (if (&lt; n 2) n (+ (fib (- n 1)) (fib (- n 2)))))
+<em class="gray">fib</em>
+&gt; (define-memoized 
+   (memo-fib n) 
+     (if (&lt; n 2) n (+ (memo-fib (- n 1)) (memo-fib (- n 2)))))
+<em class="gray">memo-fib</em>
+&gt; (time (fib 34))         ; un-memoized time
+<em class="gray">1.168</em>                        ;   0.70 on ccrma's i7-3930 machines
+&gt; (time (memo-fib 34))    ; memoized time
+<em class="gray">3.200e-05</em>
+&gt; (outlet (funclet memo-fib))
+<em class="gray">(inlet '{memo}-18 (hash-table 
+    '(0 . 0) '(1 . 1) '(2 . 1) '(3 . 2) '(4 . 3) '(5 . 5) 
+    '(6 . 8) '(7 . 13) '(8 . 21) '(9 . 34) '(10 . 55) '(11 . 89) 
+    '(12 . 144) '(13 . 233) '(14 . 377) '(15 . 610) '(16 . 987) 
+    '(17 . 1597) '(18 . 2584) '(19 . 4181) '(20 . 6765) '(21 . 10946) 
+    '(22 . 17711) '(23 . 28657) '(24 . 46368) '(25 . 75025) '(26 . 121393) 
+    '(27 . 196418) '(28 . 317811) '(29 . 514229) '(30 . 832040) '(31 . 1346269) 
+    '(32 . 2178309) '(33 . 3524578) '(34 . 5702887)))</em>
+</pre>
+<p>but the tail recursive version of fib is simpler and almost as fast as the memoized version,
+and the iterative version beats both.
+</p>
+</div>
+
+<p id="typedhash">The third argument, typers, sets type checkers for the keys and values in the table,
+much like the third argument to make-vector.
+It is a cons of the type functions,
+<code>(cons symbol? integer?)</code> for example. This says that all the keys must
+be symbols and all the values integers.
+<a href="#hashtablekeytyper">hash-table-key-typer</a> and
+<a href="#hashtablevaluetyper">hash-table-value-typer</a>
+return or set these functions.
+</p>
+
+<pre class="indented">
+&gt; (define (10|12? val) (memv val '(10 12)))
+<em class="gray">10|12?</em>
+&gt; (define hash (make-hash-table 8 #f (cons #t 10|12?))) ; any key is ok, but all values must be 10 or 12
+<em class="gray">(hash-table)</em>
+&gt; (set! (hash 'a) 10)
+<em class="gray">10</em>
+&gt; hash
+<em class="gray">(hash-table 'a 10)</em>
+&gt; (set! (hash 'b) 32)
+<em class="red">error</em><em class="gray">: hash-table-set! value argument 3, 32, is an integer but should be a 10|12?</em>
+</pre>
+
+<div class="indented">
+<pre>
+(define H (hash-table 'v1 1 'v2 2 'v3 3))
+(let ((last-key #f))
+  (define (valtyp val)
+    (or (not last-key)
+        (eq? last-key 'v1)
+	(and (eq? last-key 'v2)
+             (integer? val)
+	     (&lt;= 0 val 32))))
+  (define (keytyp key)
+    (set! last-key key)
+    #t)
+  (set! (<em class=red>hash-table-key-typer</em> H) keytyp)
+  (set! (<em class=red>hash-table-value-typer</em> H) valtyp))
+  
+;; now (H 'v1) can be set to anything
+;;     (H 'v2) must be an integer between 0 and 32
+;;     (H 'v3) is immutable (but setting it to #f will remove it from H)
+  
+&gt; (hash-table-set! H 'v1 11)
+11
+&gt;(hash-table-set! H 'v2 12)
+12
+&gt; (hash-table-set! H 'v3 13)
+<em class=red>error</em>: hash-table-set! third argument 13, is an integer, but the hash-table's value type checker, valtyp, rejects it
+&gt; (hash-table-set! H 'v2 112)
+<em class=red>error</em>: hash-table-set! third argument 112, is an integer, but the hash-table's value type checker, valtyp, rejects it
+</pre>
+</div>
+
+</blockquote>
+
+
+
+
+
+<div class="header" id="environments"><h4>environments</h4></div>
+
+
+<p>An environment holds symbols and their values.  The global environment, for example,
+holds all the variables that are defined at the top level.
+Environments are first class (and applicable) objects in s7.  
+</p>
+
+<pre class="indented">
+(<em class=def id="rootlet">rootlet</em>)               the top-level (global) environment
+(<em class=def id="curlet">curlet</em>)                the current (innermost) environment
+(<em class=def id="funclet">funclet</em> proc)          the environment at the time when proc was defined
+(<em class=def id="isfunclet">funclet?</em> env)          #t if env is a funclet
+(owlet)                 the environment at the point of the last error
+(<em class=def id="unlet">unlet</em>)                 a let with built-in functions with their original value
+
+(<em class=def id="letref">let-ref</em> env sym)       get value of sym in env, same as (env sym)
+(<em class=def id="letset">let-set!</em> env sym val)  set value of sym in env to val, same as (set! (env sym) val)
+
+(<em class=def id="inlet">inlet</em> . bindings)       make a new environment with the given bindings
+(<em class=def id="sublet">sublet</em> env . bindings)  same as inlet, but the new environment is local to env
+(<em class=def id="varlet">varlet</em> env . bindings)  add new bindings directly to env
+(<em class=def id="cutlet">cutlet</em> env . fields)    remove bindings from env
+
+(<em class=def id="letp">let?</em> obj)               #t if obj is an environment
+(<em class=def id="with-let">with-let</em> env . body)    evaluate body in the environment env 
+(<em class=def id="outlet">outlet</em> env)             the environment that encloses the environment env (settable)
+(<em class=def id="lettolist">let-&gt;list</em> env)          return the environment bindings as a list of (symbol . value) cons's
+
+(<em class=def id="openlet">openlet</em> env)            mark env as open (see below)
+(<em class=def id="openletp">openlet?</em> env)           #t is env is open
+(<em class=def id="coverlet">coverlet</em> env)           mark env as closed (undo an earlier openlet)
+
+(<em class=def id="objecttolet">object-&gt;let</em> obj)        return an environment containing information about obj 
+(<em class=def id="lettemporarily">let-temporarily</em> vars . body)
+</pre>
+
+
+<blockquote>
+<pre class="indented">
+&gt; (inlet 'a 1 'b 2)
+<em class="gray">(inlet 'a 1 'b 2)</em>
+&gt; (let ((a 1) (b 2)) (curlet))
+<em class="gray">(inlet 'a 1 'b 2)</em>
+&gt; (let ((x (inlet :a 1 :b 2))) (x 'a))
+<em class="gray">1</em>
+&gt; (with-let (inlet 'a 1 'b 2) (+ a b))
+<em class="gray">3</em>
+&gt; (let ((x (inlet :a 1 :b 2))) (set! (x 'a) 4) x)
+<em class="gray">(inlet 'a 4 'b 2)</em>
+&gt; (let ((x (inlet))) (varlet x 'a 1) x)
+<em class="gray">(inlet 'a 1)</em>
+&gt; (let ((a 1)) (let ((b 2)) (outlet (curlet))))
+<em class="gray">(inlet 'a 1)</em>
+&gt; (let ((e (inlet 'a (inlet 'b 1 'c 2)))) (e 'a 'b)) ; in C terms, e-&gt;a-&gt;b 
+<em class="gray">1</em>  
+&gt; (let ((e (inlet 'a (inlet 'b 1 'c 2)))) (set! (e 'a 'b) 3) (e 'a 'b))
+<em class="gray">3</em>
+&gt; (define* (make-let (a 1) (b 2)) (sublet (rootlet) (curlet)))
+<em class="gray">make-let</em>
+&gt; (make-let :b 32)
+<em class="gray">(inlet 'a 1 'b 32)</em>
+</pre>
+</blockquote>
+
+<p>As the names suggest, in s7 an environment is viewed as a disembodied let.  Environments are equal if they
+contain the same symbols with the same values leaving aside shadowing, and taking into account the environment
+chain up to the rootlet.  That is, two environments are equal if any local variable of either has the same value in both.
+</p>
+
+<p><b>let-ref</b> and <b>let-set!</b> return #&lt;undefined&gt; if the first argument is not
+defined in the environment or its parents.  To search just the given environment (ignoring its outlet chain),
+use defined? with the third argument #t before calling let-ref or let-set!:
+</p>
+
+<pre class="indented">
+&gt; (defined? 'car (inlet 'a 1) #t)
+<em class="gray">#f</em>
+&gt; (defined? 'car (inlet 'a 1))
+<em class="gray">#t</em>
+</pre>
+
+<p>This matters in let-set!: <code>(let-set! (inlet 'a 1) 'car #f)</code>
+is the same as <code>(set! car #f)</code>!
+</p>
+
+<p>
+<b>with-let</b> evaluates its body in the given environment, so
+<code>(with-let e . body)</code> is equivalent to
+<code>(eval `(begin ,@body) e)</code>, but probably faster.
+Similarly, <code>(let bindings . body)</code> is equivalent to
+<code>(eval `(begin ,@body) (apply inlet (flatten bindings)))</code>,
+ignoring the outer (enclosing) environment (the default outer environment
+of inlet is rootlet).
+Or better,
+</p>
+<pre class="indented">
+(define-macro (with-environs e . body) 
+  `(apply let (map (lambda (a) (list (car a) (cdr a))) ,e) '(,@body)))
+</pre>
+<p>Or turning it around,</p>
+<pre>
+(define-macro (Let vars . body)
+  `(with-let (sublet (curlet) 
+	       ,@(map (lambda (var)
+			(values (symbol-&gt;keyword (car var)) (cadr var)))
+		      vars))
+     ,@body))
+
+(Let ((c 4))
+  (Let ((a 2)
+        (b (+ c 2)))
+  (+ a b c)))
+</pre>
+<p>It is faster to use <code>(biglet 'a-function)</code> than <code>(with-let biglet a-function)</code>.
+</p>
+
+<p><b>let-temporarily</b> is somewhat similar to fluid-let in other Schemes.
+Its syntax looks like
+let, but it first saves the current value, then sets the
+variable to the new value (via set!), calls the body, and finally restores the
+original value.  It can handle anything settable:
+</p>
+<pre class="indented">
+(let-temporarily (((*s7* 'print-length) 8)) (display x))
+</pre>
+<p>This sets s7's print-length variable to 8 while displaying x, then
+puts it back to its original value.
+</p>
+<pre class="indented">
+&gt; (define ourlet
+    (let ((x 1))
+      (define (a-func) x)
+      (define b-func (let ((y 1))
+		       (lambda ()
+		         (+ x y))))
+    (curlet)))
+<em class="gray">(inlet 'x 1 'a-func a-func 'b-func b-func)</em>
+&gt; (ourlet 'x)
+<em class="gray">1</em>
+&gt; (let-temporarily (((ourlet 'x) 2))
+    ((ourlet 'a-func)))
+<em class="gray">2</em>
+&gt; ((funclet (ourlet 'b-func)) 'y)
+<em class="gray">1</em>
+&gt; (let-temporarily ((((funclet (ourlet 'b-func)) 'y) 3))
+    ((ourlet 'b-func)))
+<em class="gray">4</em>
+</pre>
+<p>Despite the name, no new environment is created by let-temporarily:
+<code>(let () (let-temporarily () (define x 2)) (+ x 1))</code> is 3.
+</p>
+
+<p>
+<b>sublet</b> makes a new let with the bindings passed to it, then sets the new environment's outlet to the 'env' argument.
+This is similar to a let form inside another let.
+</p>
+<pre class="indented">
+&gt; (sublet (curlet) 'b 2)
+<em class="gray">(inlet 'b 2)</em>
+&gt; (let ((a 1)) (with-let (sublet (curlet) 'b 2) (+ a b)))
+<em class="gray">3</em>
+</pre>
+<p>
+To add the bindings directly to the environment,
+use <b>varlet</b>.  
+Both accept environment other than the first as well as individual bindings,
+adding all the argument's bindings to the new environment.
+<b>inlet</b> is very similar, but normally omits the environment argument.
+The arguments to sublet and inlet can be passed as
+symbol/value pairs, as a cons, or using keywords as if in define*.
+inlet can also be used to copy an environment without accidentally invoking
+that environment's copy method.
+</p>
+
+<p>To implement read-time lets using #let(...):
+</p>
+<pre>
+(set! *#readers* 
+      (cons (cons #\l (lambda (str)
+			(and (string=? str "let") ; #let(...)
+			     (apply inlet (read)))))
+	    *#readers*))
+
+(display #let(:a 1)) (newline)
+(display #let(:a 1 :b "str")) (newline)
+</pre>
+
+<p>Here's an example of varlet: we want to define two functions that share a
+local variable:
+</p>
+
+<pre class="indented">
+(varlet (curlet)            ; import f1 and f2 into the current environment
+  (let ((x 1))              ; x is our local variable
+    (define (f1 a) (+ a x)) 
+    (define (f2 b) (* b x)) 
+    (inlet 'f1 f1 'f2 f2))) ; export f1 and f2
+</pre>
+
+<p>One way to add reader and writer functions to an individual environment slot is:
+</p>
+
+<pre class="indented">
+(define e (inlet 
+            'x (let ((local-x 3)) ; x's initial value
+		 (dilambda
+		   (lambda () local-x)
+		   (lambda (val) (set! local-x (max 0 (min val 100))))))))
+&gt; ((e 'x))
+<em class="gray">3</em>
+&gt; (set! ((e 'x)) 123)
+<em class="gray">100</em>
+</pre>
+
+<p><b>funclet</b> returns a function's local environment.  Here's an example that
+keeps a circular buffer of the calls to that function:
+</p>
+
+<pre class="indented">
+(define func (let ((history (let ((lst (make-list 8 #f)))
+			      (set-cdr! (list-tail lst 7) lst))))
+	       (lambda (x y)
+		 (let ((result (+ x y)))
+		   (set-car! history (list result x y))
+		   (set! history (cdr history))
+		   result))))
+
+&gt; (func 1 2)
+<em class="gray">3</em>
+&gt; (func 3 4)
+<em class="gray">7</em>
+&gt; ((funclet func) 'history)
+<em class="gray">#1=(#f #f #f #f #f #f (3 1 2) (7 3 4) . #1#)</em>
+</pre>
+
+
+<p>It is possible in Scheme to redefine built-in functions such as car.
+To ensure that some code sees the original built-in function definitions,
+wrap it in <code>(with-let (unlet) ...)</code>:
+</p>
+<pre class="indented">
+&gt; (let ((caar 123)) 
+    (+ caar (with-let (unlet) 
+              (caar '((2) 3)))))
+<em class="gray">125</em>
+</pre>
+<p>Or perhaps better, to keep the current environment intact except for the 
+changed built-ins:
+</p>
+<pre class="indented">
+&gt; (let ((x 1) 
+        (display 3))
+    (with-let (sublet (curlet) (unlet)) ; (curlet) picks up 'x, (unlet) the original 'display
+      (display x)))
+<em class="gray">1</em>
+</pre>
+
+<p>
+with-let and unlet are constants, so you can
+use them in any context without worrying about whether they've been redefined.
+As mentioned in the macro section, #_&lt;name&gt; is a built-in reader macro
+for <code>(with-let (unlet) &lt;name&gt;)</code>,
+so for example, #_+ is the built-in + function, no matter what.
+(The environment of built-in functions
+that unlet accesses is not accessible from scheme code, so there's no way 
+that those values can be clobbered).
+</p>
+
+<p><b>cutlet</b> removes bindings from an environment.  If the environment is
+part of the outlet chain of a function, you'll probably get a segfault.
+Don't, for example, <code>(cutlet (outlet (funclet func) 'x))</code>
+where func refers to x in its body.  Similarly, don't mess up the
+outlet chain of a function (via (set! (outlet...))), and still 
+expect that function to do something reasonable. (I may remove cutlet someday).
+</p>
+<br>
+
+<div class="indented">
+
+<p>
+I think these functions can implement the notions of libraries,
+separate namespaces, or modules.  
+Here's one way: first the library writer just writes his library.
+The normal user simply loads it.  The abnormal user worries about everything,
+so first he loads the library in a local let to make sure no bindings escape 
+to pollute his code, and then he
+uses unlet to
+make sure that none of his bindings pollute the library code:
+</p>
+
+<pre class="indented">
+(let ()
+  (with-let (unlet)
+    (load "any-library.scm" (curlet)) 
+    ;; by default load puts stuff in the global environment
+    ...))
+</pre>
+
+<p>Now Abnormal User can do what he wants with the library entities.
+Say he wants to use "lognor" under the name "bitwise-not-or", and
+all the other functions are of no interest:
+</p>
+
+<pre class="indented">
+(varlet (curlet)
+  'bitwise-not-or (with-let (unlet)
+                    (load "any-library.scm" (curlet))
+                    lognor)) ; lognor is presumably defined in "any-library.scm"
+</pre>
+
+<p>Say he wants to make sure the library is cleanly loaded, but all
+its top-level bindings are imported into the current environment:
+</p>
+
+<pre class="indented">
+(varlet (curlet)
+  (with-let (unlet)
+    (let ()
+      (load "any-library.scm" (curlet))
+      (curlet)))) ; these are the bindings introduced by loading the library
+</pre>
+
+<p>To do the same thing, but prepend "library:" to each name:
+</p>
+
+<pre class="indented">
+(apply varlet (curlet)
+  (with-let (unlet)
+    (let ()
+      (load "any-library.scm" (curlet))
+      (map (lambda (binding)
+	     (cons (symbol "library:" (symbol-&gt;string (car binding)))
+		   (cdr binding)))
+	    (curlet)))))
+</pre>
+
+<p>That's all there is to it!  Here is the same idea as a macro:
+</p>
+
+<pre>
+(define-macro (let! init end . body)
+  ;; syntax mimics 'do: (let! (vars&amp;values) ((exported-names) result) body)
+  ;;   (let! ((a 1)) ((hiho)) (define (hiho x) (+ a x)))
+  `(let ,init
+     ,@body
+     (varlet (outlet (curlet))
+       ,@(map (lambda (export)
+		`(cons ',export ,export))
+	      (car end)))
+     ,@(cdr end)))
+</pre>
+
+<!--
+(define-macro (safe-let! init end . body)
+  `(with-let (#_inlet (unlet)
+	,@(#_map (#_lambda (b) 
+		 `(#_cons ',(#_car b) ,(#_cadr b)))
+	       init))
+     ,@body
+     (#_varlet (#_outlet (#_curlet))
+	,@(#_map (#_lambda (export)
+		 `(#_cons ',export ,export))
+	       (#_car end)))
+     ,@(#_cdr end)))
+-->
+
+</div>
+
+<div class="indented">
+<p>Well, almost, darn it.  If the loaded library file sets (via set!) a global value
+such as abs, we need to put it back to its original form:
+</p>
+
+<pre>
+(define (safe-load file)
+  (let ((e (with-let (unlet)         ; save the environment before loading
+	     (let-&gt;list (curlet)))))
+    (<em class=red>load</em> file (curlet))
+    (let ((new-e (with-let (unlet)   ; get the environment after loading
+		   (let-&gt;list (curlet)))))
+      (for-each                       ; see if any built-in functions were stepped on
+       (lambda (sym)
+	 (unless (assoc (car sym) e)
+	   (format () "~S clobbered ~A~%" file (car sym))
+	   (apply set! (car sym) (list (cdr sym)))))
+       new-e))))
+
+;; say libtest.scm has the line (set! abs odd?)
+
+&gt; (safe-load "libtest.scm")
+<em class="gray">"libtest.scm" clobbered abs</em>
+&gt; (abs -2)
+<em class="gray">2</em>
+</pre>
+
+</div>
+
+
+<p><b>openlet</b> marks its argument, either an environment, a closure, a c-object, or a c-pointer
+as open; <b>coverlet</b> as closed.  I need better terminology here!  An open object is one that the
+built-in s7 functions handle specially.  If they encounter one in their
+argument list, they look in the object for their own name, and call that
+function if it exists.  A bare-bones example:
+</p>
+
+<pre class="indented">
+&gt; (abs (openlet (inlet 'abs (lambda (x) 47))))
+<em class="gray">47</em>
+&gt; (define* (f1 (a 1)) (if (real? a) (abs a) ((a 'f1) a)))
+<em class="gray">f1</em>
+&gt; (f1 :a (openlet (inlet 'f1 (lambda (e) 47))))
+<em class="gray">47</em>
+</pre>
+
+<p>In CLOS, we'd declare a class and a method, and call make-instance,
+and then discover that it wouldn't work anyway.
+Here we have, in effect, an anonymous instance of an anonymous class.
+I think this is called a "prototype system"; javascript is apparently similar.
+A slightly more complex example:
+</p>
+
+<pre class="indented">
+(let* ((e1 (openlet 
+	   (inlet 
+	    'x 3
+	    '* (lambda args
+		 (apply * (if (number? (car args))
+		     	      (values (car args) ((cadr args) 'x) (cddr args))
+		              (values ((car args) 'x) (cdr args))))))))
+       (e2 (copy e1)))
+  (set! (e2 'x) 4)
+  (* 2 e1 e2)) ; (* 2 3 4) =&gt; 24
+</pre>
+
+<p>Perhaps these names would be better: openlet -&gt; with-methods, coverlet -&gt; without-methods,
+and openlet? -&gt; methods?.
+</p>
+
+<blockquote>
+
+<div class="indented">
+<p>let-ref and let-set! are problematic as methods.  It is very easy to get into an infinite
+loop, especially with let-ref, since any reference to the let within the method body probably
+calls let-ref, which calls the let-ref method.  We used to recommend coverlet here, but
+even that is not enough, so now let-ref and let-set! are immutable; they can't be used
+as methods.
+Use let-ref-fallback and let-set-fallback instead, if possible.
+</p>
+
+</div>
+</blockquote>
+
+
+<p><b>object-&gt;let</b> returns an environment (more of a dictionary really) that
+contains details about its argument.  It
+is intended as a debugging aid, underlying a debugger's "inspect" for example. 
+</p>
+
+<pre class="indented">
+&gt; (let ((iter (make-iterator "1234")))
+    (iter)
+    (iter)
+    (object-&gt;let iter))
+<em class="gray">(inlet 'value #&lt;iterator: string&gt; 'type iterator? 'at-end #f 'sequence "1234" 'length 4 'position 2)</em>
+</pre>
+
+<p>A c-object (in the sense of s7_make_c_type), can add its own info to this namespace via an object-&gt;let
+method in its local environment.  snd-marks.c has a simple example using a class-wide environment (g_mark_methods),
+holding as the value of its 'object-&gt;let field the function s7_mark_to_let.  The latter uses s7_varlet to
+add information to the namespace created by <code>(object-&gt;let mark)</code>.
+</p>
+
+
+<div class="indented">
+<pre>
+(define-macro (value-&gt;symbol expr)
+  `(let ((val ,expr)
+	 (e1 (curlet)))
+     (call-with-exit
+      (lambda (return)
+	(do ((e e1 (outlet e))) ()
+	  (for-each 
+	   (lambda (slot)
+	     (if (equal? val (cdr slot))
+		 (return (car slot))))
+	   e)
+	  (if (eq? e (rootlet))
+	      (return #f)))))))
+
+&gt; (let ((a 1) (b "hi")) 
+    (value-&gt;symbol "hi"))
+<em class="gray">b</em>
+</pre>
+</div>
+
+
+<div class="indented">
+<p>openlet alerts the rest of s7 that the environment has methods.
+</p>
+
+<pre>
+(begin
+  (define fvector? #f)
+  (define make-fvector #f)
+  (let ((type (gensym))
+	(-&gt;float (lambda (x)
+		   (if (real? x)
+		       (* x 1.0)
+		       (error 'wrong-type-arg "fvector new value is not a real: ~A" x)))))
+    (set! make-fvector
+	  (lambda* (len (init 0.0)) 
+	    (<em class=red>openlet</em>
+	     (inlet :v (make-vector len (-&gt;float init))
+	            :type type
+	   	    :length (lambda (f) len)
+		    :object-&gt;string (lambda (f . args) "#&lt;fvector&gt;")
+		    :let-set! (lambda (fv i val) (#_vector-set! (fv 'v) i (-&gt;float val)))
+		    :let-ref-fallback (lambda (fv i) (#_vector-ref (fv 'v) i))))))
+    (set! fvector? (lambda (p)
+		     (and (let? p)
+			  (eq? (p 'type) type))))))
+  
+&gt; (define fv (make-fvector 32))
+<em class="gray">fv</em>
+&gt; fv
+<em class="gray">#&lt;fvector&gt;</em>
+&gt; (length fv)
+<em class="gray">32</em>
+&gt; (set! (fv 0) 123)
+<em class="gray">123.0</em>
+&gt; (fv 0)
+<em class="gray">123.0</em>
+</pre>
+
+<p>Normally, every let's outlet chain goes back to the rootlet.  If we want to
+create a let that breaks that chain, we can use let-ref-fallback:
+</p>
+
+<pre>
+(define lt (<em class=red>openlet</em> (inlet 'a 1
+                           'let-ref-fallback (lambda (e sym) 
+			                       ;; any other symbol is undefined
+					       #&lt;undefined&gt;))))
+&gt; (lt 'abs)
+<em class="gray">#&lt;undefined&gt;</em>
+</pre>
+
+</div>
+
+
+
+<div class="indented">
+<p>If an s7 function ignores the type of an argument, as in cons or vector for example,
+then that argument won't be treated as having any methods.
+</p>
+
+<p>
+Since outlet is settable, there are two ways an environment can
+become circular.  One is to include the current environment as the value of one of its variables.
+The other is: <code>(let () (set! (outlet (curlet)) (curlet)))</code>.
+</p>
+
+<p>If you want to hide an environment's fields from any part of s7 that does not
+know the field names in advance,
+</p>
+<pre class="indented">
+(openlet  ; make it appear to be empty to the rest of s7
+  (inlet 'object-&gt;string  (lambda args "#&lt;let&gt;")
+         'map             (lambda args ())
+         'for-each        (lambda args #&lt;unspecified&gt;)
+  	 'let-&gt;list       (lambda args ())
+         'length          (lambda args 0)
+	 'copy            (lambda args (inlet))
+ 	 'open #t
+	 'coverlet        (lambda (e) (set! (e 'open) #f) e)
+	 'openlet         (lambda (e) (set! (e 'open) #t) e)
+	 'openlet?        (lambda (e) (e 'open))
+         ;; your secret data here
+         ))
+</pre>
+<p>(There are still at least two ways to tell that something is fishy).
+</p>
+<!-- add a field and it disappears, or sublet and read back -->
+</div>
+
+
+<div class="indented">
+<p>Here's one way to add a method to a closure:
+</p>
+<pre class="indented">
+(define sf (openlet (let ((object-&gt;string (lambda (obj . arg) 
+				            "#&lt;secret function!&gt;")))
+	              (lambda (x) 
+			(+ x 1)))))
+&gt; sf
+<em class="gray">#&lt;secret function!&gt;</em>
+</pre>
+</div>
+
+
+
+<div class="header" id="multiplevalues"><h4>multiple-values</h4></div>
+
+<p>
+In s7, multiple values are spliced directly into the caller's argument list.
+</p>
+
+<pre class="indented">
+&gt; (+ (values 1 2 3) 4)
+<em class="gray">10</em>
+&gt; (string-ref ((lambda () (values "abcd" 2))))
+<em class="gray">#\c</em>
+&gt; ((lambda (a b) (+ a b)) ((lambda () (values 1 2))))
+<em class="gray">3</em>
+&gt; (+ (call/cc (lambda (ret) (ret 1 2 3))) 4) ; call/cc has an implicit "values"
+<em class="gray">10</em>
+&gt; ((lambda* ((a 1) (b 2)) (list a b)) (values :a 3))
+<em class="gray">(3 2)</em>
+
+(define-macro (call-with-values producer consumer) 
+  `(,consumer (,producer)))
+
+(define-macro (multiple-value-bind vars expr . body)
+  `((lambda ,vars ,@body) ,expr))
+
+(define-macro (define-values vars expression)
+  `(if (not (null? ',vars))
+       (varlet (curlet) ((lambda ,vars (curlet)) ,expression))))
+
+(define (curry function . args)
+  (if (null? args)
+      function
+      (lambda more-args
+        (if (null? more-args)
+            (apply function args)
+            (function (apply values args) (apply values more-args))))))
+</pre>
+
+
+
+<blockquote>
+
+<div class="indented">
+
+<p>multiple-values are useful in several situations.  For example,
+<code>(if test (+ a b c) (+ a b d e))</code> can be written
+<code>(+ a b (if test c (values d e)))</code>. 
+There are a few special uses of multiple-values.
+First, you can use the values function to return any number of values, including 0,
+from map's function application:
+</p>
+
+<pre class="indented">
+&gt; (map (lambda (x) (if (odd? x) (values x (* x 20)) (values))) (list 1 2 3))
+<em class="gray">(1 20 3 60)</em>
+&gt; (map values (list 1 2 3) (list 4 5 6))
+<em class="gray">(1 4 2 5 3 6)</em>
+
+(define (remove-if func lst) 
+  (map (lambda (x) (if (func x) (values) x)) lst))
+
+(define (pick-mappings func lst)          
+  (map (lambda (x) (or (func x) (values))) lst))
+
+(define (shuffle . args) 
+  (apply map values args))
+
+&gt; (shuffle '(1 2 3) #(4 5 6) '(7 8 9))
+<em class="gray">(1 4 7 2 5 8 3 6 9)</em>
+
+(define (concatenate . args)
+  (apply append (map (lambda (arg) (map values arg)) args)))
+</pre>
+
+<p>Second, a macro can return multiple values; these are evaluated and spliced,
+exactly like a normal macro,
+so you can use <code>(values '(define a 1) '(define b 2))</code> to
+splice multiple definitions at the macro invocation point.  
+If an expansion returns (values), nothing is spliced in.  This is
+mostly useful in <a href="#readercond">reader-cond</a> and the #; reader, but
+unfortunately, it is tricky to use.  The reader only knows about things globally defined
+when it encounters them, and a locally defined expansion is handled as a normal macro,
+so:
+</p>
+
+<pre class="indented">
+&gt; (define-expansion (comment str) (values)) ; this must be at the top-level
+<em class="gray">comment</em>
+&gt; (+ 1 (comment "one") 2 (comment "two"))
+<em class="gray">3</em>
+</pre>
+
+<p>At the top-level (in the REPL), since there's nothing to splice into, you simply get your values back:
+</p>
+
+<pre class="indented">
+&gt; (values 1 (list 1 2) (+ 3 4 5))
+<em class="gray">(values 1 (1 2) 12)</em>
+</pre>
+
+<p>But this printout is just trying to be informative.  There is no multiple-values object
+in s7.  You can't <code>(set! x (values 1 2))</code>, for example.  The values function
+tells s7 that its arguments should be handled in a special way, and the multiple-value indication goes away
+as soon as the arguments are spliced into some caller's arguments.  
+</p>
+
+<p id="listvalues">There are two helper functions for multiple values, apply-values and list-values,
+both intended primarily for quasiquote where (apply-values ...) implements what other schemes call unquote-splicing (",@...").
+(apply-values lst) is like (apply values lst),
+and (list-values ...) is like (list ...) except in one special case.  It is common in writing macros
+to create some piece of code to be spliced into the output, but if that code is nil, the resulting
+macro code should contain nothing (not nil).  apply-values and list-values cooperate with quasiquote to implement
+this.  As an example:
+</p>
+<pre class="indented">
+&gt; (list-values 1 2 (apply-values) 3)
+<em class="gray">(1 2 3)</em>
+&gt; (define (supply . args) (apply-values args))
+<em class="gray">supply</em>
+&gt; (define (consume f . args) (apply f (apply list-values args)))
+<em class="gray">consume</em>
+&gt; (consume + (supply 1 2) (supply 3 4 5) (supply))
+<em class="gray">15</em>
+&gt; (consume + (supply))
+<em class="gray">0</em>
+</pre>
+
+<p>It might seem simpler to return "nothing" from (values), rather than #&lt;unspecified&gt;,
+but that has drawbacks.  First, <code>(abs -1 (values))</code>, or worse <code>(abs (f x) (f y))</code>
+is no longer an error at the level of the program text; you lose the ability to see at a glance that
+a normal function has the right number of arguments.  Second, a lot of code currently assumes that
+(values) returns #&lt;unspecified&gt;, and that implies that <code>(apply values ())</code> does as well.
+But it would be nice if <code>((lambda* ((x 1)) x) (values))</code> returned 1!
+<!--
+Is <code>(apply apply func arglist)</code> the same as <code>(apply func (apply values arglist))</code>,
+or (leaving aside <code>'(()))</code>, <code>(func (apply values (apply values arglist)))</code>?
+-->
+</p>
+</div>
+
+
+<div class="indented">
+
+<p>Since set! does not evaluate its first argument, and
+there is no setter for "values", <code>(set! (values x) ...)</code> is not
+the same as <code>(set! x ...)</code>.  <code>(string-set! (values string) ...)</code>
+works because string-set! does evaluate its first argument.  <code>((values + 1 2) (values 3 4) 5)</code>
+is 15, as anyone would expect.
+</p>
+</div>
+
+<p>One problem with this way of handling multiple values involves cases where you can't
+tell whether an expression will return multiple values.  Then you have, for example, <code>(let ((val (expr)))...)</code>
+and need to accept either a normal single value from <code>expr</code>, or one member of the
+possible set of multiple values.  In lint.scm, I'm currently handling this with lambda:
+<code>(let ((val ((lambda args (car args)) (expr))))...)</code>, but this feels kludgey.
+CL has nth-value which appears to do "the right thing" in this context; perhaps s7 needs
+it too.
+</p>
+<p>A similar difficulty arises in <code>(if (expr) ...)</code> where <code>(expr)</code> might
+return multiple values. CL (or sbcl anyway) treats this as if it were wrapped in <code>(nth-value 0 (expr))</code>.
+Splicing the values in, on the other hand, could lead to disaster: there would be no way to tell from the code
+that the if statement
+was valid, or which branch would be taken!  So, in those cases where a syntactic form evaluates
+an argument, s7 follows CL, and uses only the first of the values (this affects if, when, unless, cond, and case).
+</p>
+
+</blockquote>
+
+
+
+
+<div class="header" id="callwithexit1"><h4>call-with-exit, with-baffle and continuation?</h4></div>
+
+
+<p><b><em class=def id="callwithexit">call-with-exit</em></b> is call/cc without the ability to jump back into the original context,
+similar to "return" in C.  This 
+is cleaner than call/cc, and much faster. 
+</p>
+
+<pre class="indented">
+(define-macro (block . body) 
+  ;; borrowed loosely from CL &mdash; predefine "return" as an escape
+  `(<em class=red>call-with-exit</em> (lambda (return) ,@body)))
+
+(define-macro (while test . body)      ; while loop with predefined break and continue
+  `(<em class=red>call-with-exit</em>
+    (lambda (break) 
+      (let continue ()
+	(if (let () ,test)
+	    (begin 
+	      (let () ,@body)
+	      (continue))
+	    (break))))))
+
+(define-macro (switch selector . clauses) ; C-style case (branches fall through unless break called)
+  `(<em class=red>call-with-exit</em>
+    (lambda (break)
+      (case ,selector
+	,@(do ((clause clauses (cdr clause))
+	       (new-clauses ()))
+	      ((null? clause) (reverse new-clauses))
+	    (set! new-clauses (cons `(,(caar clause) 
+				      ,@(cdar clause)
+				      ,@(map (lambda (nc)
+					       (apply values (cdr nc))) ; doubly spliced!
+					     (if (pair? clause) (cdr clause) ())))
+				    new-clauses)))))))
+
+(define (and-for-each func . args)
+  ;; apply func to the first member of each arg, stopping if it returns #f
+  (<em class=red>call-with-exit</em>
+   (lambda (quit)
+     (apply for-each (lambda arglist
+		       (if (not (apply func arglist))
+			   (quit #&lt;unspecified&gt;))) 
+	    args))))
+
+(define (find-if f . args)  ; generic position-if is very similar
+  (<em class=red>call-with-exit</em>
+   (lambda (return) 
+     (apply for-each (lambda main-args 
+		       (if (apply f main-args) 
+			   (apply return main-args)))
+	    args))))
+
+&gt; (find-if even? #(1 3 5 2))
+<em class="gray">2</em>
+&gt; (* (find-if > #(1 3 5 2) '(2 2 2 3)))
+<em class="gray">6</em>
+</pre>
+
+<p>
+The call-with-exit function's argument (the "continuation") is only valid
+within the call-with-exit function.  In call/cc, you can save it, then call it later
+to jump back, but if you try that with call-with-exit (from outside the call-with-exit function's body), you'll get an error.
+This is similar to trying to read from a closed input port. 
+</p>
+
+
+<p>The other side, so to speak, of call-with-exit, is <em class=def id="withbaffle">with-baffle</em>.
+Sometimes we need a normal call/cc, but want to make sure it is active
+only within a given block of code.  
+Normally, if a continuation gets away, there's no telling when it might wreak havoc on us.
+with-baffle blocks that &mdash; no continuation can jump into its body:
+</p>
+
+<pre class="indented">
+(let ((what's-for-breakfast ())
+      (bad-dog 'fido))        ; bad-dog wonders what's for breakfast?
+  (<em class=red>with-baffle</em>                ; the syntax is (with-baffle . body)         
+   (set! what's-for-breakfast
+	 (call/cc
+	  (lambda (biscuit?)
+	    (set! bad-dog biscuit?) ; bad-dog smells a biscuit!
+	    'biscuit!))))
+  (if (eq? what's-for-breakfast 'biscuit!) 
+      (bad-dog 'biscuit!))     ; now, outside the baffled block, bad-dog wants that biscuit!
+  what's-for-breakfast)        ;   but s7 says "No!": baffled! ("continuation can't jump into with-baffle")
+</pre>
+
+<br>
+<p><em class=def id="continuationp">continuation?</em> returns #t if its argument is a continuation,
+as opposed to a normal procedure.  I don't know why Scheme hasn't had this function from
+the very beginning, but it's needed if you want to write a continuable error
+handler.  Here is a sketch of the situation:
+</p>
+
+<pre class="indented">
+(catch #t
+       (lambda ()
+         (let ((res (call/cc 
+                      (lambda (ok) 
+                        (error 'cerror "an error" ok)))))
+           (display res) (newline)))
+       (lambda args
+         (when (and (eq? (car args) 'cerror)
+                    (<em class=red>continuation?</em> (cadadr args)))
+           (display "continuing...")
+           ((cadadr args) 2))
+         (display "oops")))
+</pre>
+
+<p>In a more general case, the error handler is separate from the
+catch body, and needs a way to distinguish a real continuation
+from a simple procedure.  
+</p>
+
+<pre class="indented">
+(define (continuable-error . args)
+  (call/cc 
+   (lambda (continue)
+     (apply error args))))
+
+(define (continue-from-error)
+  (if (<em class=red>continuation?</em> ((owlet) 'continue)) ; might be #&lt;undefined&gt; or a function as in the while macro
+      (((owlet) 'continue))
+      'bummer))
+</pre>
+
+<!--
+(define-macro (call-with-exit func)
+  (let ((tag (caadr func)))
+    `(catch ',tag
+       (lambda ()
+	 (define-macro (,tag . body) 
+	   `(throw ',',tag ,@body))
+	 ,@(cddr func))
+       (lambda (type info)
+	 (car info)))))
+-->
+
+
+
+
+<div class="header" id="format1"><h4>format, object-&gt;string</h4></div>
+
+<pre class="indented">
+(<em class=def id="objecttostring">object-&gt;string</em> obj (write #t) (max-len (*s7* 'most-positive-fixnum)))
+(<em class=def id="format">format</em> output-choice control-string . arguments)
+</pre>
+
+<p>object-&gt;string returns the string representation of its first argument.  Its optional second argument
+can be #f or :display (use display), #t or :write (the default, use write), or :readable.  In the latter case, object-&gt;string
+tries to produce a string that can be evaluated via eval-string to return an object equal to the
+original.  The optional third argument sets the maximum desired string length; if object-&gt;string
+notices it has exceeded this limit, it returns the partial string.
+</p>
+
+<pre class="indented">
+&gt; (object-&gt;string "hiho")
+<em class="gray">"\"hiho\""</em>
+&gt; (format #f "~S" "hiho")
+<em class="gray">"\"hiho\""</em>
+</pre>
+
+<p>s7's format function is very close to CL's and that in srfi-48.
+</p>
+
+<pre class="indented">
+&gt; (format #f "~A ~D ~F" 'hi 123 3.14)
+<em class="gray">"hi 123 3.140000"</em>
+</pre>
+
+
+<p>The format directives (tilde chars) are:</p>
+<pre class="indented">
+~%        insert newline
+~&amp;        insert newline if preceding char was not newline
+~~        insert tilde
+~\n       (tilde followed by newline): trim white space
+~{        begin iteration (take arguments from a list, string, vector, or any other applicable object)
+~}        end iteration
+~^ ~|     jump out of iteration
+~*        ignore the current argument
+~C        print character (numeric argument = how many times to print it)
+~P        insert 's' if current argument is not 1 or 1.0 (use ~@P for "ies" or "y")
+~A        object-&gt;string as in display
+~S        object-&gt;string as in write
+~B        number-&gt;string in base 2
+~O        number-&gt;string in base 8
+~D        number-&gt;string in base 10 (~:D for ordinal)
+~X        number-&gt;string in base 16
+~E        float to string, (format #f "~E" 100.1) -&gt; "1.001000e+02", (%e in C)
+~F        float to string, (format #f "~F" 100.1) -&gt; "100.100000",   (%f in C)
+~G        float to string, (format #f "~G" 100.1) -&gt; "100.1",        (%g in C)
+~T        insert spaces (padding)
+~N        get numeric argument from argument list (similar to ~V in CL)
+~W        object-&gt;string with :readable (write readably: "serialization"; s7 is the intended reader)
+</pre>
+
+<p>The eight directives before ~W take the usual numeric arguments to specify field width and precision.
+These can also be ~N or ~n in which case the numeric argument is read from the list of arguments:
+</p>
+<pre class="indented">
+(format #f "~ND" 20 1234) ; =&gt; (format "~20D" 1234)
+<em class="gray">"                1234"</em>
+</pre>
+
+<p>
+<code>(format #f ...)</code> simply returns the formatted string; <code>(format #t ...)</code>
+also sends the string to the current-output-port.  <code>(format () ...)</code> sends the output to 
+the current-output-port without returning the string (this mimics the other IO routines
+such as display and newline).  Other built-in port choices are *stdout* and *stderr*.
+</p>
+
+<blockquote>
+
+<div class="indented">
+
+<p>Floats can occur in any base, so:
+</p>
+
+<pre class="indented">
+&gt; #xf.c
+<em class="gray">15.75</em>
+</pre>
+
+<p>This also affects format.  In most Schemes, <code>(format #f "~X" 1.25)</code> is
+an error.  In CL, it is equivalent to using ~A which is perverse.  But 
+</p>
+
+<pre class="indented">
+&gt; (number-&gt;string 1.25 16)
+<em class="gray">"1.4"</em>
+</pre>
+
+<p>and there's no obvious way to get the same effect from format unless we accept
+floats in the "~X" case.  So in s7, 
+</p>
+
+<pre class="indented">
+&gt; (format #f "~X" 21)
+<em class="gray">"15"</em>
+&gt; (format #f "~X" 1.25)
+<em class="gray">"1.4"</em>
+&gt; (format #f "~X" 1.25+i)
+<em class="gray">"1.4+1.0i"</em>
+&gt; (format #f "~X" 21/4)
+<em class="gray">"15/4"</em>
+</pre>
+
+<p>That is, the output choice matches the argument.  A case that came up in the Guile mailing lists is:
+<code>(format #f "~F" 1/3)</code>.  s7 currently returns "1/3", but Clisp returns "0.33333334".
+</p>
+
+<p>The curly bracket directive applies to anything you can map over, not just lists:
+</p>
+
+<pre class="indented">
+&gt; (format #f "~{~C~^ ~}" "hiho")
+<em class="gray">"h i h o"</em>
+&gt; (format #f "~{~{~C~^ ~}~^...~}" (list "hiho" "test"))
+<em class="gray">"h i h o...t e s t"</em>
+&gt; (with-input-from-string (format #f "(~{~C~^ ~})" (format #f "~B" 1367)) read) ; integer-&gt;list
+<em class="gray">(1 0 1 0 1 0 1 0 1 1 1)</em>
+</pre>
+
+<p>Since any sequence can be passed to ~{~}, we need a way to truncate output and represent
+the rest of the sequence with "...", but ~^ only stops at the end of the sequence.  ~|
+is like ~^ but it also stops after it handles (*s7* 'print-length) elements and prints
+"...".  So, <code>(format #f "~{~A~| ~}" #(0 1 2 3 4))</code> returns "0 1 2 ..."
+if (*s7* 'print-length) is 3.
+</p>
+
+</div>
+</blockquote>
+
+
+<blockquote>
+
+<div class="indented">
+
+<p>I added object-&gt;string to s7 before deciding to include format.  format excites a
+vague disquiet &mdash; why do we need this ancient unlispy thing?
+We can almost replace it with:
+</p>
+
+<pre class="indented">
+(define (objects-&gt;string . objects)
+  (apply string-append (map (lambda (obj) (object-&gt;string obj #f)) objects)))
+</pre>
+
+<p>But how to handle lists (~{...~} in format), or columnized output (~T)?
+I wonder whether formatted string output still matters outside a REPL.  Even in that context,
+a modern GUI leaves formatting decisions to a text or table widget.
+</p>
+
+<pre class="indented">
+(define-macro (string-&gt;objects str . objs)
+  `(with-input-from-string ,str
+     (lambda ()
+       ,@(map (lambda (obj)
+		`(set! ,obj (eval (read))))
+	      objs))))
+</pre>
+</div>
+
+<div class="indented">
+<p>format is a mess.  It is trying to cram two different choices into its first ("port") argument.
+Perhaps it should be split into format-&gt;string and format-&gt;port.  format-&gt;string has no
+port argument and returns a string.  format-&gt;port writes to its port argument (which must be an output
+port, not a boolean), and returns an empty string.  Then:
+</p>
+<pre>
+(format #f ...) -&gt; (format-&gt;string ...)
+(format () ...) -&gt; (format-&gt;port (current-output-port) ...)
+(format #t ...) -&gt; (display (format-&gt;string ...))
+(format port ...) -&gt; (display (format-&gt;string ...) port)
+</pre>
+<p>and the currently unavailable choice, format to port without creating a string:
+<code>(format-&gt;port port ...)</code>.
+</p>
+</div>
+<!--
+
+:(objects->string "int: " 32 ", string: " "hi")
+"int: 32, string: hi"
+
+(define (cycle->string . objs)
+  (call-with-exit
+   (lambda (return)
+     (for-each
+      (lambda (obj)
+	(if (pair? obj)
+	    (return
+	     (string-append 
+	      (apply objects->string 
+		     (map (lambda (obj)
+			    (if (pair? obj)
+				(car obj)
+				obj))
+			  objs))
+	      (apply cycle->string 
+		     (map (lambda (obj)
+			    (if (pair? obj)
+				(cdr obj)
+				obj))
+			  objs))))))
+      objs)
+     "")))
+
+;;; (cycle->string ": " (list 1 2 3) " |")
+:(objects->string "int: " 32 ", list with spaces: (" (cycle->string (list 1 2 3) " ") "), string: " "hi")
+"int: 32, list with spaces: (1 2 3 ), string: hi"
+
+:(let ((x 0) (y 0)) (string->objects "1 2" x y) (list x y))
+(1 2)
+
+-->
+
+</blockquote>
+
+
+
+<div class="header" id="hooks"><h4>hooks</h4></div>
+
+<pre class="indented">
+(<em class=def id="makehook">make-hook</em> . fields)           ; make a new hook
+(<em class=def id="hookfunctions">hook-functions</em> hook)          ; the hook's list of 'body' functions
+</pre>
+
+<p>A hook is a function created by make-hook, and called (normally from C) when something interesting happens.
+In GUI toolkits hooks are called callback-lists, in CL conditions,
+in other contexts watchpoints or signals.  s7 itself has several
+hooks: <a href="#errorhook">*error-hook*</a>, <a href="#readerrorhook">*read-error-hook*</a>,
+<a href="#unboundvariablehook">*unbound-variable-hook*</a>, *missing-close-paren-hook*, *rootlet-redefinition-hook*,
+<a href="#loadhook">*load-hook*</a>, and *autoload-hook*.
+make-hook is:
+</p>
+
+<pre class="indented">
+(define (make-hook . args)
+  (let ((body ()))
+    (apply lambda* args
+      '(let ((result #&lt;unspecified&gt;))
+         (let ((e (curlet)))
+	   (for-each (lambda (f) (f e)) body) 
+           result))
+       ())))
+</pre>
+
+<p>So the result of calling make-hook is a function (the lambda* that is applied to args above) that
+contains a list of functions, 'body.  
+Each function in that list takes one argument, the hook.
+Each time the hook itself is called, each of the body functions is called, and the value of 'result is returned.
+That variable, and each of the hook's arguments are accessible to the hook's internal
+functions by going through the environment passed to the internal functions.  This is a bit circuitous; 
+here's a sketch:
+</p>
+
+<pre class="indented">
+&gt; (define h (make-hook '(a 32) 'b))     ; h is a function: (lambda* ((a 32) b) ...)
+<em class="gray">h</em>
+&gt; (set! (hook-functions h)              ; this sets ((funclet h) 'body)
+           (list (lambda (hook) 	; each hook internal function takes one argument, the environment
+                   (set! (hook 'result) ; this is the "result" variable above 
+                         (format #f "a: ~S, b: ~S" (hook 'a) (hook 'b))))))
+<em class="gray">(#&lt;lambda (hook)&gt;)</em>
+&gt; (h 1 2)                               ; this calls the hook's internal functions (just one in this case)
+<em class="gray">"a: 1, b: 2"                            ; we set "result" to this string, so it is returned as the hook application result</em>
+&gt; (h)
+<em class="gray">"a: 32, b: #f"</em>
+</pre>
+
+<p>In C, to make a hook:
+</p>
+
+<pre class="indented">
+hook = s7_eval_c_string("(make-hook '(a 32) 'b)");
+s7_gc_protect(s7, hook);
+</pre>
+
+<p>And call it:
+</p>
+
+<pre class="indented">
+result = s7_call(s7, hook, s7_list(s7, 2, s7_make_integer(s7, 1), s7_make_integer(s7, 2)));
+</pre>
+
+<div class="indented">
+<pre>
+(define-macro (hook . body)  ; return a new hook with "body" as its body, setting "result"
+  `(let ((h (make-hook)))
+     (set! (hook-functions h) (list (lambda (h) (set! (h 'result) (begin ,@body)))))
+     h))
+</pre>
+</div>
+
+
+
+
+
+<div class="header" id="variableinfo"><h4>variable info</h4></div>
+
+
+<pre class="indented">
+(<em class=def id="documentation">documentation</em> obj)
+(<em class=def id="signature">signature</em> obj)
+(<em class=def id="setter">setter</em> obj)
+(<em class=def id="arity">arity</em> obj)
+(<em class=def id="aritablep">aritable?</em> obj num-args)
+(funclet proc)
+(<em class=def id="proceduresource">procedure-source</em> proc)
+(<em class=def id="procedurearglist">procedure-arglist</em> proc)
+</pre>
+
+<p>
+<b>funclet</b> returns
+a procedure's environment.
+</p>
+<pre class="indented">
+&gt; (funclet (let ((b 32)) (lambda (a) (+ a b))))
+<em class="gray">(inlet 'b 32)</em>
+&gt; (funclet abs)
+<em class="gray">(rootlet)</em>
+</pre>
+
+<p>
+<b>setter</b> returns or sets the setter function associated with a procedure (set-car! with car, for example).
+</p>
+
+<p>
+<b>procedure-source</b> returns the procedure source (a list):
+</p>
+<pre class="indented">
+(define (procedure-arglist f) (cadr (procedure-source f)))
+</pre>
+<p><b>procedure-arglist</b> returns the procedure's argument list.
+"procedure" here refers to functions and macros defined in s7, not built-in procedures.
+</p>
+
+<p>
+<b>documentation</b> returns the documentation string associated with a procedure.  This is normally
+provided via the '+documentation+ variable in the function's environment.  If you'd rather, 
+you can treat the initial string in the function's body as documentation.
+</p>
+<pre class="indented">
+(define func 
+  (let ((+documentation+ "helpful info"))
+     (lambda (a) a)))
+
+&gt; (documentation func)
+<em class="gray">"helpful info"</em>
+
+(define (cl-func) 
+  "this is documentation"
+  123)
+
+&gt; (documentation cl-func)
+<em class="gray">"this is documentation"</em>
+</pre>
+<p>Since documentation is a method, a function's documentation can be computed at run-time:
+</p>
+<pre class="indented">
+(define func
+  (let ((documentation (lambda (f) (format #f "this is func's funclet: ~S" (funclet f)))))
+    (lambda (x)
+      (+ x 1))))
+
+&gt; (documentation func)
+<em class="gray">"this is func's funclet: (inlet 'x ())"</em>
+</pre>
+
+<p>
+<b>arity</b> takes any object and returns either #f if that object is not applicable,
+or a cons containing the minimum and maximum number of arguments acceptable.  If the maximum reported
+is a really big number, that means any number of arguments is ok.
+<b>aritable?</b> takes two arguments, an object and an integer, and returns #t if the object can be
+applied to that many arguments.  (For define* and friends, a key+value pair is considered to be one argument).
+</p>
+
+<pre class="indented">
+&gt; (define* (add-2 a (b 32)) (+ a b))
+<em class="gray">add-2</em>
+&gt; (procedure-source add-2)
+<em class="gray">(lambda* (a (b 32)) (+ a b))</em>
+&gt; (arity add-2)
+<em class="gray">(0 . 2)</em>
+&gt; (aritable? add-2 1)
+<em class="gray">#t</em>
+&gt; (aritable? add-2 2)
+<em class="gray">#t</em>
+&gt; (aritable? add-2 3) ; we can call (add-2 1 :b 2), but
+<em class="gray">#f</em> ;   as mentioned above, the key+value pair is one argument
+</pre>
+
+<p>
+<b>signature</b> is a list describing the argument types and returned value type
+of the function.  The first entry in the list is the return type, and the rest are
+argument types.  #t means any type is possible, and 'values means the function returns multiple values.
+</p>
+
+<pre class="indented">
+&gt; (signature round)
+<em class="gray">(integer? real?)</em>                   ; round takes a real argument, returns an integer
+&gt; (signature vector-ref)
+<em class="gray">(#t vector? . #1=(integer? . #1#))</em> ; trailing args are all integers (indices)
+</pre>
+
+<p>If an entry is a list, any of the listed types can occur:
+</p>
+
+<pre class="indented">
+&gt; (signature char-position)
+<em class="gray">((boolean? integer?) (char? string?) string? integer?)</em>
+</pre>
+
+<p>which says that the first argument to char-position can be a string or a character,
+and the return type can be either boolean or an integer.  To specify the types returned
+if multiple values are returned, use (values type1 ..).  So the function:
+</p>
+<code>(define (f int) (case ((0) (values 0 1)) ((1) ((values 'a 1)) (else 0))))</code>
+<p>could declare its signature to be
+</p>
+<code>(((values integer? integer?) (values symbol? integer?) integer?) integer?)</code>
+;; or would it be better to omit the 'values and just have a list of types?
+<p>
+If the function is defined in scheme, its signature is the value of the '+signature+ variable
+in its closure:
+</p>
+
+<pre class="indented">
+&gt; (define f1 (let ((+documentation+ "helpful info") 
+                   (+signature+ '(boolean? real?)))
+                (lambda (x) 
+                  (positive? x))))
+<em class="gray">f1</em>
+&gt; (documentation f1)
+<em class="gray">"helpful info"</em>
+&gt; (signature f1)
+<em class="gray">(boolean? real?)</em>
+</pre>
+
+<p>We can do the same thing using methods:
+</p>
+
+<pre class="indented">
+&gt; (define f1 (let ((documentation (lambda (f) "helpful info"))
+                   (signature (lambda (f) '(boolean? real?))))
+                (<em class=red>openlet</em>  ; openlet alerts s7 that f1 has methods
+                  (lambda (x) 
+                    (positive? x)))))
+&gt; (documentation f1)
+<em class="gray">"helpful info"</em>
+&gt; (signature f1)
+<em class="gray">(boolean? real?)</em>
+</pre>
+
+<p>signature can also be used to implement CL's 'the:
+</p>
+<pre class="indented">
+(define-macro (the value-type form)
+  `((let ((+signature+ (list ,value-type)))
+      (lambda ()
+	,form))))
+
+(display (+ 1 (<em class="red">the</em> integer? (+ 2 3))))
+</pre>
+
+<p>but the optimizer currently doesn't know how to take advantage of this pattern.
+</p>
+
+<p>You can obviously add your own methods:
+</p>
+
+<pre class="indented">
+(define my-add
+  (let ((<em class="red">tester</em> (lambda ()
+		  (if (not (= (my-add 2 3) 5))
+		      (format #t "oops: (myadd 2 3) -&gt; ~A~%" 
+			      (my-add 2 3))))))
+    (lambda (x y)
+      (- x y))))
+
+(define (auto-test) ; scan the symbol table for procedures with testers
+  (let ((st (symbol-table)))
+    (for-each (lambda (f)
+		(let* ((fv (and (defined? f)
+			       (symbol-&gt;value f)))
+		       (testf (and (procedure? fv)
+				   ((funclet fv) '<em class="red">tester</em>))))
+		  (when (procedure? testf)  ; found one!
+		    (testf)))) 
+	      st)))
+
+&gt; (auto-test)
+<em class="gray">oops: (myadd 2 3) -&gt; -1</em>
+</pre>
+
+<p>Even the setter can be set this way:
+</p>
+<pre class="indented">
+(define flocals
+  (let ((x 1))
+    (let ((+setter+ (lambda (val) (set! x val))))
+      (lambda ()
+	x))))
+
+&gt; (flocals)
+<em class="gray">1</em>
+&gt; (setter flocals)
+<em class="gray">#&lt;lambda (val)&gt;</em>
+&gt; (set! (flocals) 32)
+<em class="gray">32</em>
+&gt; (flocals)
+<em class="gray">32</em>
+</pre>
+
+<blockquote>
+<br>
+
+<div class="indented">
+
+<pre>
+(define (for-each-subset func args)
+  ;; form each subset of args, apply func to the subsets that fit its arity
+  (let subset ((source args)
+               (dest ())
+               (len 0))
+    (if (null? source)
+        (if (<em class=red>aritable?</em> func len)   ; does this subset fit?
+            (apply func dest))
+        (begin
+          (subset (cdr source) (cons (car source) dest) (+ len 1))
+          (subset (cdr source) dest len)))))
+</pre>
+</div>
+</blockquote>
+
+
+<div class="header" id="evalstring"><h4>eval</h4></div>
+
+<p>
+<b>eval</b> evaluates its argument, a list representing a piece of code.  It takes an optional
+second argument, the environment in which the evaluation should take place.  <b>eval-string</b>
+is similar, but its argument is a string.
+</p>
+
+<pre class="indented">
+&gt; (eval '(+ 1 2))
+<em class="gray">3</em>
+&gt; (eval-string "(+ 1 2)")
+<em class="gray">3</em>
+</pre>
+
+<p>Leaving aside a few special cases, eval-string could be defined:
+</p>
+<pre class="indented">
+(define-macro* (eval-string x e)
+  `(eval (with-input-from-string ,x read) (or ,e (curlet))))
+</pre>
+
+
+
+<div class="header" id="IO"><h4>IO and other OS functions</h4></div>
+
+<p>Besides files, ports can also represent strings and functions.  The string port functions
+are:
+</p>
+
+<pre class="indented">
+(with-output-to-string thunk)         ; open a string port as current-output-port, call thunk, return string
+(with-input-from-string string thunk) ; open string as current-input-port, call thunk
+(call-with-output-string proc)        ; open a string port, apply proc to it, return string
+(call-with-input-string string proc)  ; open string as current-input-port, apply proc to it
+(open-output-string)                  ; open a string output port
+(get-output-string port clear)        ; return output accumulated in the string output port
+(open-input-string string)            ; open a string input port reading string
+(<em class=def id="openinputfunction">open-input-function</em> function)        ; open a function input port
+(<em class=def id="openoutputfunction">open-output-function</em> function)       ; open a function output port
+</pre>
+
+<pre class="indented">
+&gt; (let ((result #f) 
+        (p (<em class=red>open-output-string</em>)))
+    (format p "this ~A ~C test ~D" "is" #\a 3)
+    (set! result (<em class=red>get-output-string</em> p))
+    (close-output-port p)
+    result)
+<em class="gray">"this is a test 3"</em>
+</pre>
+
+<p>In get-output-string, if the optional 'clear' argument is #t, the port is cleared (the default in r7rs I think).
+Other functions:
+</p>
+
+<ul>
+<li>read-byte and write-byte: binary IO
+<li>read-line: line-at-a-time reads, optional second argument #t to include the newline
+<li>read-string (r7rs)
+<li>current-error-port, set-current-error-port
+<li><em class=def id="portfilename">port-filename</em> and 
+    <em class=def id="portlinenumber">port-line-number</em> (input ports)
+<li><em class=def id="portposition">port-position</em> (input port, settable)
+<li><em class=def id="portstring">port-string</em> (string port, settable)
+<li><em class=def id="portfile">port-file</em> 
+</ul>
+
+<p>Use length to get the length in bytes of an input port's file or string.
+port-line-number is settable (for fancy *#readers*). 
+<b>port-position</b> is the position in bytes of the reader in the port. It is settable.
+<b>port-string</b> is the string contents of a string port. It is also settable.
+<b>port-file</b> is intended for use with the *libc* library.  It returns a c-pointer
+containing the FILE* pointer associated with the file port (except in Windows):
+</p>
+<pre class="indented">
+(call-with-input-file "s7test.scm"
+  (lambda (p)
+    (with-let (sublet *libc* :file (<em class=red>port-file</em> p))
+      (fseek file 1000 SEEK_SET))))
+</pre>
+
+<p>The variable (*s7* 'print-length) sets
+the upper limit on how many elements of a sequence are printed by object-&gt;string and format.
+When running s7 behind a GUI, you often want input to come from and output to go to
+arbitrary widgets. The function ports provide a way to redirect IO in C.  See <a href="#functionportexample">below</a>
+for an example.
+</p>
+
+<p>The function ports call a function rather than reading or writing the data to a string or file.
+See nrepl.scm and s7test.scm for examples.  The function-port function is accessible as
+<code>((object-&gt;let function-port) 'function)</code>.  These ports are even more esoteric than
+their C-side cousins.  An example that traps current-ouput-port output:
+</p>
+<pre class="indented">
+(let* ((str ())
+       (stdout-wrapper (open-output-function
+			 (lambda (c)
+			   (set! str (cons c str))))))
+  (let-temporarily (((current-output-port) stdout-wrapper))
+    (write-char #\a)
+    ...))
+</pre>
+<blockquote>
+
+<div class="indented">
+<p>
+The end-of-file object is #&lt;eof&gt;.
+When the read function encounters the constant #&lt;eof&gt; it returns #&lt;eof&gt;.
+This is neither inconsistent nor unusual: read returns either a form or
+#&lt;eof&gt;.  If read encounters a form that contains #&lt;eof&gt;, it returns a
+form containing #&lt;eof&gt;, just as with any other constant.
+</p>
+
+<pre class="indented">
+&gt; (with-input-from-string "(or x #&lt;eof&gt;)" read)
+<em class="gray">(or x #&lt;eof&gt;)</em>
+&gt; (eof-object? (with-input-from-string "'#&lt;eof&gt;" read))
+<em class="gray">#f</em>
+</pre>
+
+<p>If read hits the end of
+the input while reading a form, it raises an error (e.g. "missing close paren").
+If it encounters
+#&lt;eof&gt; all by itself at the top level (this never happens),
+it returns that #&lt;eof&gt;.  But this is specific to read, not (for example) load:
+</p>
+<pre class="indented">
+;; say we have "t234.scm" with:
+(display "line 1") (newline)
+#&lt;eof&gt;
+(display "line 2") (newline)
+;; end of t234.scm
+
+&gt; (load "t234.scm")
+<em class="gray">line 1
+line 2</em>
+
+(with-input-from-file "t234.scm" 
+  (lambda () 
+    (do ((c (read) (read))) 
+	((eof-object? c)) 
+      (eval c))))
+<em class="gray">line 1</em>
+</pre>
+
+<p>
+Built-in #&lt;eof&gt; has lots of
+uses, and as far as I can see, no drawbacks.  For example,
+it is common to call
+read (or one of its friends) in a loop which first checks for #&lt;eof&gt;, then falls into
+a case statement.  In s7, we can dispense with the extra if (and let), and include
+the #&lt;eof&gt; in the case statement: <code>(case (read-char) ((#&lt;eof&gt;) (quit-reading)) ((#\a)...))</code>.
+Another example: <code>(or (eof-object? x) (eqv x 24)...)</code> can be instead: <code>(memv x '(#&lt;eof&gt; 24 ...)</code>.
+(All the discussions online that I've seen of #&lt;eof&gt; or its equivalent confuse the thing (end of file indication) with its name (#&lt;eof&gt;).
+</p>
+</div>
+
+
+<div class="indented">
+
+<p>
+The default IO ports are *stdin*, *stdout*, and *stderr*.
+*stderr* is useful if you want to make sure output is flushed out immediately.
+The default output port is *stdout* which buffers output until a newline is seen.
+</p>
+
+</div>
+
+
+<div class="indented">
+<p>An environment can be treated as an IO port, providing what Guile calls a "soft port":
+</p>
+
+<pre class="indented">
+(define (call-with-input-vector v proc)
+  (let ((i -1))
+    (proc (openlet (inlet 'read (lambda (p) (v (set! i (+ i 1)))))))))
+</pre>
+
+<p>Here the IO port is an open environment that redefines the "read" function so that it
+returns the next element of a vector.  See stuff.scm for call-with-output-vector.
+The "proc" argument above can also be a macro, giving you a kludgey way to get around
+the dumb "lambda".  Here are more useful examples:
+</p>
+<pre class="indented">
+(openlet          ; a soft port for format that sends its output to *stderr* and returns the string
+  (inlet 'format (lambda (port str . args)
+ 	           (apply format *stderr* str args))))
+
+(define (open-output-log name)
+  ;; return a soft output port that does not hold its output file open
+  (define (logit name str)
+    (let ((p (open-output-file name "a")))
+      (display str p)
+      (close-output-port p)))
+  (openlet 
+   (inlet :name name
+	  :format (lambda (p str . args) (logit (p 'name) (apply format #f str args)))
+	  :write (lambda (obj p)         (logit (p 'name) (object-&gt;string obj #t)))
+	  :display (lambda (obj p)       (logit (p 'name) (object-&gt;string obj #f)))
+	  :write-string (lambda (str p)  (logit (p 'name) str))
+	  :write-char (lambda (ch p)     (logit (p 'name) (string ch)))
+	  :newline (lambda (p)           (logit (p 'name) (string #\newline)))
+	  :output-port? (lambda (p) #t)
+	  :close-output-port (lambda (p) #f)
+	  :flush-output-port (lambda (p) #f))))
+
+(let ((p (open-output-log "logit.data")))
+  (format p "this is a test~%")
+  (format p "line: ~A~%" 2))
+</pre>
+</div>
+
+
+<div class="indented">
+
+<p>binary-io.scm in the Snd package has functions that read and write integers and floats in
+both endian choices in a variety of sizes.
+</p>
+
+</div>
+</blockquote>
+
+<p>If the compile time switch WITH_SYSTEM_EXTRAS is 1, several additional OS-related and
+file-related functions are built-in.  This is work in progress; currently this switch
+adds:
+</p>
+
+<pre class="indented">
+(directory? str)         ; return #t if str is the name of a directory
+(file-exists? str)       ; return #t if str names an existing file
+(delete-file str)        ; try to delete the file, return 0 is successful, else -1
+(getenv var)             ; return the value of an environment variable: (getenv "HOME")
+(directory-&gt;list dir)    ; return contents of directory as a list of strings (if HAVE_DIRENT_H)
+(system command)         ; execute command, if optional second arg is #t output is returned as a string
+</pre>
+
+<p>But maybe this is not needed; see <a href="#cload">cload.scm</a> below for
+a more direct approach.
+</p>
+
+
+
+
+
+<div class="header" id="errors"><h4>error handling</h4></div>
+
+<pre class="indented">
+(error tag . info)           ; signal an error of type tag with addition information
+(catch tag body err)         ; if error of type tag signalled in body (a thunk), call err with tag and info
+(throw tag . info)           ; jump to corresponding catch
+</pre>
+
+<p>s7's error handling mimics that of Guile.  An error is signalled
+via the error function, and can be trapped and dealt with via <em class=def id="catch">catch</em>.
+</p>
+
+<pre class="indented">
+&gt; (<em class=red>catch</em> 'wrong-number-of-args
+    (lambda ()     ; code protected by the catch
+      (abs 1 2))
+    (lambda args   ; the error handler
+      (apply format #t (cadr args))))
+<em class="gray">"abs: too many arguments: (1 2)"</em>
+&gt; (<em class=red>catch</em> 'division-by-zero
+    (lambda () (/ 1.0 0.0))
+    (lambda args (string-&gt;number "+inf.0")))
+<em class="gray">+inf.0</em>
+
+(define-macro (catch-all . body)
+  `(<em class=red>catch</em> #t (lambda () ,@body) (lambda args args)))
+</pre>
+
+<p>
+catch has 3 arguments: a tag indicating what error to catch (#t = anything),
+the code, a thunk, that the catch is protecting, and the function to call
+if a matching error occurs during the evaluation of the thunk.  
+The tag is matched to the error type with eq?.
+The error handler
+takes a rest argument which will hold whatever the error function chooses to pass it.
+The error function itself takes at least 2 arguments, the error type, a symbol,
+and the error message.  There may also be other arguments describing the error.
+The default action, in the absence of any catch, is to treat the message as
+a format control string, apply format to it and the other arguments, and
+send that info to the current-error-port:
+</p>
+
+<pre class="indented">
+(catch #t
+  (lambda ()
+    (error 'oops))
+  (lambda args
+    (format (current-error-port) "~A: ~A~%~A[~A]:~%~A~%" 
+      (car args)                        ; the error type
+      (apply format #f (cadr args))     ; the error info
+      (port-filename) (port-line-number); error file location
+      (stacktrace))))                   ; and a stacktrace
+</pre>
+
+<blockquote>
+<div class="indented">
+<p>Normally when reading a file, we have to check for #&lt;eof&gt;, but we can let s7
+do that:
+</p>
+
+<pre>
+(define (copy-file infile outfile)
+  (call-with-input-file infile
+    (lambda (in)
+      (call-with-output-file outfile
+	(lambda (out)
+	  (<em class=red>catch</em> 'wrong-type-arg   ; s7 raises this error if write-char gets #&lt;eof&gt;
+	    (lambda () 
+	      (do () ()            ; read/write until #&lt;eof&gt;
+		(write-char (read-char in) out)))
+	    (lambda err 
+	      outfile)))))))
+</pre>
+
+<p>catch is not limited to error handling:
+</p>
+
+<pre class="indented">
+(define (map-with-exit func . args)
+  ;; map, but if early exit taken, return the accumulated partial result
+  ;;   func takes escape thunk, then args
+  (let* ((result ())
+	 (escape-tag (gensym))
+	 (escape (lambda () (throw escape-tag))))
+    (<em class=red>catch</em> escape-tag
+      (lambda ()
+	(let ((len (apply max (map length args))))
+	  (do ((ctr 0 (+ ctr 1)))
+	      ((= ctr len) (reverse result))      ; return the full result if no throw
+	    (let ((val (apply func escape (map (lambda (x) (x ctr)) args))))
+	      (set! result (cons val result))))))
+      (lambda args
+	(reverse result))))) ; if we catch escape-tag, return the partial result
+
+(define (truncate-if func lst)
+  (map-with-exit (lambda (escape x) (if (func x) (escape) x)) lst))
+
+&gt; (truncate-if even? #(1 3 5 -1 4 6 7 8))
+<em class="gray">(1 3 5 -1)</em>
+</pre>
+
+<p>But this is less useful than map (it can't map over a hash-table for example),
+and is mostly reimplementing built-in code.  Perhaps s7 should have an extension
+of map (and more usefully, for-each) that is patterned after dynamic-wind:
+<code>(dynamic-for-each init-func main-func end-func . args)</code> where init-func
+is called with one argument, the length of the shortest sequence argument (for-each
+and map know this in advance); main-func takes n arguments where n matches
+the number of sequences passed; and end-func is called even if a jump out of main-func
+occurs (like dynamic-wind in this regard).  In the dynamic-map case, the end-func
+takes one argument, the current, possibly partial, result list.  dynamic-for-each
+then could easily (but maybe not efficiently) implement generic functions such as -&gt;list, -&gt;vector, and
+-&gt;string (converting any sequence into a sequence of some other type).
+map-with-exit would be
+</p>
+<pre class="indented">
+(define (map-with-exit func . args) 
+  (let ((result ()))
+    (call-with-exit
+      (lambda (quit)
+        (apply dynamic-map #f ; no init-func in this case
+               (lambda main-args 
+                 (apply func quit main-args)) 
+               (lambda (res) 
+                 (set! result res))
+               args)))
+    result))
+</pre>
+</div>
+
+<div class="indented">
+<p>With all the lambda boilerplate, nested catches are hard to read:
+</p>
+<pre class="indented">
+(catch #t
+  (lambda ()
+    (catch 'division-by-zero
+      (lambda ()
+	(catch 'wrong-type-arg
+	  (lambda () 
+	    (abs -1))
+	  (lambda args (format () "got a bad arg~%") -1)))
+      (lambda args 0)))
+  (lambda args 123))
+</pre>
+
+<p>Perhaps we need a macro:
+</p>
+
+<pre class="indented">
+(define-macro (catch-case clauses . body)
+  (let ((base (cons 'lambda (cons () body))))
+    (for-each (lambda (clause)
+	        (let ((tag (car clause)))
+	          (set! base `(lambda () 
+			        (catch ',(or (eq? tag 'else) tag)
+			          ,base 
+			          ,@(cdr clause))))))
+	      clauses)
+    (caddr base)))
+
+;;; the code above becomes:
+(catch-case ((wrong-type-arg   (lambda args (format () "got a bad arg~%") -1))
+	     (division-by-zero (lambda args 0))
+	     (else             (lambda args 123)))
+  (abs -1))
+</pre>
+
+<p>This is similar to r7rs scheme's "guard", but I don't want a pointless thunk for the body of the catch.
+Along the same lines:
+</p>
+<pre class="indented">
+(define (catch-if test func err)
+  (catch #t
+    func
+    (lambda args
+      (apply (if (test (car args)) err throw) args)))) ; if not caught, re-raise the error via throw
+
+(define (catch-member lst func err)
+  (catch-if (lambda (tag) (member tag lst)) func err))
+
+(define-macro (catch* clauses . error) 
+  ;; try each clause until one evaluates without error, else error:
+  ;;    (macroexpand (catch* ((+ 1 2) (- 3 4)) 'error))
+  ;;    (catch #t (lambda () (+ 1 2)) (lambda args (catch #t (lambda () (- 3 4)) (lambda args 'error))))
+  (define (builder lst)
+    (if (null? lst)
+	(apply values error)
+	`(catch #t (lambda () ,(car lst)) (lambda args ,(builder (cdr lst))))))
+  (builder clauses))
+</pre>
+</div>
+
+<!--
+(define (or-catch . funks)
+  (call-with-exit
+   (lambda (return)
+     (for-each
+      (lambda (f)
+	(catch #t
+	  (lambda ()
+	    (return (f)))
+	  (lambda args
+	    (case (car args)
+	      ((wrong-type-arg) ...)
+	      (...)
+	      (else (apply throw args))))))
+      funks))))
+-->       
+
+</blockquote>
+
+<p>When an error is encountered, and when s7 is interrupted via <a href="#beginhook">begin_hook</a>, 
+(<em class=def id="owlet">owlet</em>) returns an environment that contains
+additional info about that error:
+</p>
+
+<ul>
+<li>error-type: the error type or tag, e.g. 'division-by-zero
+<li>error-data: the message or information passed by the error function
+<li>error-code: the code that s7 thinks triggered the error
+<li>error-line: the line number of that code
+<li>error-file: the file name of that code
+<li>error-history: previous evaluations leading to the error (a circular list)
+</ul>
+
+<p>The error-history field depends on the compiler flag WITH_HISTORY.  See ow! in
+stuff.scm for one way to display this data.  The *s7* field 'history-size sets the size of the buffer.
+</p>
+
+<blockquote>
+
+
+<div class="indented">
+
+<p>To find a variable's value at the point of the error: <code>((owlet) var)</code>.
+To list all the local bindings from the error outward:
+</p>
+
+<pre class="indented">
+(do ((e (outlet (owlet)) (outlet e))) 
+    ((eq? e (rootlet))) 
+  (format () "~{~A ~}~%" e))
+</pre>
+
+<p>To see the current s7 stack, <code>(stacktrace)</code>.
+To evaluate the error handler in the environment of the error:
+</p>
+
+<pre class="indented">
+(let ((x 1))
+  (catch #t
+    (lambda ()
+      (let ((y 2))
+        (error 'oops)))
+    (lambda args
+      (with-let (sublet (owlet) :args args)    ; add the error handler args
+        (list args x y)))))    ; we have access to 'y'
+</pre>
+
+<p>To limit the maximum size of the stack, set (*s7* 'max-stack-size).
+</p>
+</div>
+
+
+</blockquote>
+
+
+<p>The hook <em class=def id="errorhook">*error-hook*</em> provides a way to specialize error reporting.
+Its arguments are named 'type and 'data.  It is called if there are no catches.
+</p>
+
+<pre class="indented">
+(set! (hook-functions *error-hook*) 
+      (list (lambda (hook) 
+              (apply format *stderr* (hook 'data)) 
+              (newline *stderr*))))
+</pre>
+
+<p><em class=def id="readerrorhook">*read-error-hook*</em> provides two hooks into the reader.
+A major problem when reading code written for other Schemes is that each Scheme provides
+a plethora of idiosyncratic #-names (even special character names), and \ escapes in string
+constants.  *read-error-hook* provides a way to handle these weird cases.  If a #-name
+is encountered that s7 can't deal with, *read-error-hook* is called with two arguments,
+#t and the string representing the constant.  If you set (hook 'result), that result is
+returned to the reader.  Otherwise a 'read-error is raised and you drop into the error handler.
+Similarly, if some bizarre \ use occurs, *read-error-hook* is called with two arguments,
+#f and the offending character.  If you return a character, it is passed to the reader;
+otherwise you get an error.  lint.scm has an example.
+</p>
+
+<p><em class=def id="rootletredefinitionhook">*rootlet-redefinition-hook*</em> is called when
+a top-level variable is redefined (via define and friends, not set!). 
+</p>
+<pre class="indented">
+(set! (hook-functions *rootlet-redefinition-hook*) 
+      (list (lambda (hook) 
+              (format *stderr* "~A ~A~%" (hook 'name) (hook 'value)))))
+</pre>
+<p>will print out the variable's name and the new value.
+</p>
+
+
+<div class="indented">
+<p>The s7-built-in catch tags are 'wrong-type-arg, 'syntax-error, 'read-error, 'unbound-variable,
+'out-of-memory, 'wrong-number-of-args, 'format-error, 'out-of-range, 'division-by-zero, 'io-error, and 'bignum-error.  
+</p>
+</div>
+
+
+
+<div class="header" id="autoload"><h4>autoload</h4></div>
+
+<!-- INDEX autoload:autoload -->
+<p>
+If s7 encounters an unbound variable, it first looks to see if it has any autoload information about it.
+This info can be declared via <em class=def>autoload</em>, a function of two arguments, the
+symbol that triggers the autoload, and either a filename or a function.  If a filename, s7
+loads that file; if a function, it is called with one argument, the current (calling) environment.
+</p>
+
+<pre class="indented">
+(autoload 'channel-distance "dsp.scm") 
+;; now if we subsequently call channel-distance but forget to load "dsp.scm" first,
+;;   s7 loads "dsp.scm" itself, and uses its definition of channel-distance.
+;;   The C-side equivalent is s7_autoload.
+
+;; here is the cload.scm case, loading j0 from the math library if it is called:
+(autoload 'j0
+	  (lambda (e)
+	    (unless (provided? 'cload.scm)
+	      (load "cload.scm"))
+	    (c-define '(double j0 (double)) "" "math.h")
+	    (varlet e 'j0 j0)))
+</pre>
+
+<p>The entity (hash-table or environment probably) that holds the autoload info is named *autoload*.
+If after checking autoload, the symbol is still unbound, s7 calls
+<em class=def id="unboundvariablehook">*unbound-variable-hook*</em>.
+The offending symbol is named 'variable in the hook environment.
+If after running *unbound-variable-hook*, the symbol is still unbound,
+s7 calls the error handler.
+</p>
+
+<p>The autoloader knows about s7 environments used as libraries, so, for example,
+you can <code>(autoload 'j0 "libm.scm")</code>, then use j0 in scheme code. The first
+time s7 encounters j0, j0 is undefined, so
+s7 loads libm.scm.  That load returns the C math library as the environment *libm*.
+s7 then automatically looks for j0 in *libm*, and defines it for you.
+So the result is the same as if you had defined j0 yourself in C code.
+You can use the r7rs library mechanism here, or with-let, or
+whatever you want! (In Snd, libc, libm, libdl, and libgdbm are automatically
+tied into s7 via autoload, so if you call, for example, frexp, libm.scm
+is loaded, and frexp is exported from the *libm* environment, then the
+evaluator soldiers on, as if frexp had always been defined in s7).
+You can also import all of (say) gsl into the current environment
+via <code>(varlet (curlet) *libgsl*)</code>.
+</p>
+
+
+<div class="header" id="constants"><h4>define-constant</h4></div>
+
+<p>
+<b><em class=def id="defineconstant">define-constant</em></b> defines a symbol whose value is always the same (within the current lexical scope),
+<b><em class=def id="constantp">constant?</em></b> returns #t if its argument is a constant,
+<b><em class=def id="immutableb">immutable!</em></b> declares a sequence to be immutable (its elements can't be changed), and
+<b><em class=def id="immutablep">immutable?</em></b> returns #t if its argument is immutable.
+</p>
+
+<pre class="indented">
+&gt; (define v (immutable! (vector 1 2 3)))
+<em class="gray">#(1 2 3)</em>
+&gt; (vector-set! v 0 23)
+<em class="red">error</em><em class="gray">: can't vector-set! #(1 2 3) (it is immutable)</em>
+&gt; (immutable? v)
+<em class="gray">#t</em>
+
+&gt; (define-constant var 32)
+<em class="gray">var</em>
+&gt; (set! var 1)
+<em class="gray">;set!: can't alter immutable object: var</em>
+&gt; (let ((var 1)) var)
+<em class="gray">;can't bind or set an immutable object: var, line 1</em>
+</pre>
+
+<p>There is one complication here.  <code>(immutable! let)</code> closes the let in the sense
+that you can't add locals to or delete locals from the let.  You can still set! the locals.  To make
+the locals themselves immutable:
+</p>
+<pre class="indented">
+(define (vars-immutable! L)
+  (with-let L 
+    (for-each (lambda (f)
+                (immutable! (car f)))
+              (curlet)))
+  L)
+</pre>
+<p>Now <code>(vars-immutable! let)</code> makes it an error to set! any of the locals, but you
+can add locals to the let.  
+You can speed up evaluation by doing this because it tells the optimizer that the current entries in the let will not change.
+To completely petrify the let, <code>(immutable! (vars-immutable! let))</code>.
+To make a function's documentation immutable: <code>(with-let (funclet 'f2) (immutable! '+documentation+))</code>,
+and similarly for other function closure entries.
+</p>
+
+
+<p>define-constant blocks any attempt to set! or shadow the constant (lexically speaking of course),
+so local constants behave as you'd expect:
+</p>
+
+<pre class="indented">
+&gt; (let () (define-constant x 3) (let ((x 32)) x))
+<em class="red">error</em><em class="gray">: can't bind an immutable object: ((x 32))</em>
+&gt; (let ((x 3)) (set! x (let () (define-constant x 32) x))) ; outer x is not a constant
+32
+</pre>
+<p>But watch out for deferred bindings:
+</p>
+
+<pre class="indented">
+&gt; (define (func a) (let ((cvar (+ a 1))) cvar))
+<em class="gray">func</em>
+&gt; (define-constant cvar 23) ; cvar is now globally constant so it can't be shadowed
+<em class="gray">23</em>
+&gt; (func 1)                  ; here we're trying to shadow cvar
+<em class="red">error</em><em class="gray">: can't bind an immutable object: ((cvar (+ a 1)))</em>
+&gt; (let ((x 1)) 
+     (define z (let ()
+                 (define-constant x 3) 
+                 (lambda (y) 
+                   (let ((x y))  ; this x is the inner constant x
+                     x)))) 
+     (z 1))  ; so this is an error even though the outer x is not a constant
+<em class="red">error</em><em class="gray">: can't bind an immutable object: ((x y))</em>
+</pre>
+
+<p>
+A function can also be a constant.  In some cases, the optimizer can take advantage
+of this information to speed up function calls.
+</p>
+
+<p>Constants are very similar to things such as keywords (no set, always return itself as its value),
+variable trace (informative function upon set or keeping a history of past values), typed variables (restricting a
+variable's values or doing automatic conversions upon set), and notification upon set (either in Scheme
+or in C; I wanted this many years ago in Snd).  The notification function is especially useful if
+you have a Scheme variable and want to reflect any change in its value immediately in C (see <a href="#notify">below</a>).
+In s7, setter sets this function.
+</p>
+
+<p>Each environment is a set of symbols and their associated values.  setter places a function (or macro) between a symbol
+and its value in a given environment.  The setter function takes two arguments, the symbol and the new value, and
+returns the value that is actually set.  If the setter function accepts a third argument, the current (symbol-relative) environment
+is also passed (the weird argument order is an historical artifact).
+</p>
+
+<pre class="indented">
+(define e      ; save environment for use below
+  (let ((x 3)  ; will always be an integer
+	(y 3)  ; will always keep its initial value
+	(z 3)) ; will report set!
+
+    (set! (setter 'x) (lambda (s v) (if (integer? v) v x)))
+    (set! (setter 'y) (lambda (s v) y))
+    (set! (setter 'z) (lambda (s v) (format *stderr* "z ~A -&gt; ~A~%" z v) v))
+  
+    (set! x 3.3) ; x does not change because 3.3 is not an integer
+    (set! y 3.3) ; y does not change
+    (set! z 3.3) ; prints "z 3 -&gt; 3.3" 
+    (curlet)))
+
+&gt; e
+<em class="gray">(inlet 'x 3 'y 3 'z 3.3)</em>
+&gt;(begin (set! (e 'x) 123) (set! (e 'y) #()) (set! (e 'z) #f))
+;; prints "z 3.3 -&gt; #f"
+&gt; e
+<em class="gray">(inlet 'x 123 'y 3 'z #f)</em>
+&gt; (define-macro (reflective-let vars . body)
+    `(let ,vars
+       ,@(map (lambda (vr)
+	        `(set! (setter ',(car vr))
+		       (lambda (s v)
+		         (format *stderr* "~S -&gt; ~S~%" s v)
+		         v)))
+	      vars)
+       ,@body))
+<em class="gray">reflective-let</em>
+&gt; (reflective-let ((a 1)) (set! a 2))
+<em class="gray">2</em>     ; prints "a -&gt; 2"
+&gt;(let ((a 0))
+     (set! (setter 'a)
+      (let ((history (make-vector 3 0))
+	    (position 0))
+	(lambda (s v)
+	  (set! (history position) v)
+	  (set! position (+ position 1))
+	  (if (= position 3) (set! position 0))
+	  v)))
+     (set! a 1)
+     (set! a 2)
+     ((funclet (setter 'a)) 'history))
+<em class="gray">#(1 2 0)</em>
+</pre>
+
+<p>See also typed-let in stuff.scm.
+define-constant is more restrictive than a setter that raises an error: the latter
+does not block nested (possibly non-constant) bindings of the symbol.  The setters
+are kind of ugly.  Here's a macro that lets you put the let variable's setter after
+the initial value:
+</p>
+
+<pre class="indented">
+(define-macro (let/setter vars . body)
+  ;; (let/setter ((name value [setter])...) ...)
+  (let ((setters (map (lambda (binding)
+			 (and (pair? (cddr binding))
+			      (caddr binding)))
+		       vars))
+	(gsetters (gensym)))
+    `(let ((,gsetters (list ,@setters))
+	   ,@(map (lambda (binding)
+		    (list (car binding) (cadr binding)))
+		  vars))
+       ,@(do ((s setters (cdr s))
+	      (var vars (cdr var))
+	      (i 0 (+ i 1))
+	      (result ()))
+	     ((null? s)
+	      (reverse result))
+	   (if (car s)
+	       (set! result (cons `(set! (setter (quote ,(caar var))) (list-ref ,gsetters ,i)) result))))
+       ,@body)))
+
+(let ((a 3))
+  (let/setter ((a 1)
+	       (b 2 (lambda (s v)
+		      (+ v a)))) ; this is the outer "a"
+   (set! a (+ a 1))
+   (set! b (+ a b))
+   (display (list a b)) (newline)))
+</pre>
+
+
+
+<div class="header" id="miscellanea"><h4>marvels and curiousities</h4></div>
+
+<p>
+<b><em class=def id="loadpath">*load-path*</em></b> is a list of directories to search when loading a file.
+<b><em class=def id="loadhook">*load-hook*</em></b> is a hook whose functions are called just before a file is loaded.  
+The hook function argument, named 'name, is the filename.
+While loading, port-filename and 
+port-line-number of the current-input-port can tell you
+where you are in the file.  This data is also available after loading via <em class=def id="pairlinenumber">pair-line-number</em>
+and <em class=def id="pairfilename">pair-filename</em>.
+</p>
+
+<pre class="indented">
+(set! (hook-functions *load-hook*)
+       (list (lambda (hook) 
+               (format () "loading ~S...~%" (hook 'name)))))
+
+(set! (hook-functions *load-hook*) 
+      (cons (lambda (hook) 
+              (format *stderr* "~A~%" 
+                (system (string-append "./snd lint.scm -e '(begin (lint \"" (hook 'name) "\") (exit))'") #t)))
+            (hook-functions *load-hook*)))
+</pre>
+
+<p>Here's a *load-hook* function that adds the loaded file's directory
+to the *load-path* variable so that subsequent loads don't need to specify
+the directory:
+</p>
+
+<pre class="indented">
+(set! (hook-functions <em class=red>*load-hook*</em>)
+  (list (lambda (hook)
+          (let ((pos -1)
+                (filename (hook 'name)))
+            (do ((len (length filename))
+                 (i 0 (+ i 1)))
+	        ((= i len))
+	      (if (char=? (filename i) #\/)
+	          (set! pos i)))
+            (if (positive? pos)
+	        (let ((directory-name (substring filename 0 pos)))
+	          (if (not (member directory-name <em class=red>*load-path*</em>))
+		      (set! <em class=red>*load-path*</em> (cons directory-name *load-path*)))))))))
+</pre>
+
+
+<div class="separator"></div>
+
+<p>As in Common Lisp, <b><em class=def id="featureslist">*features*</em></b> is a list describing what is currently loaded into s7.  You can
+check it with the <b>provided?</b> function, or add something to it with <b>provide</b>.  In my version of Snd,
+at startup *features* is:
+</p>
+
+<pre class="indented">
+&gt; *features*
+<em class="gray">(snd-20.0 snd20 snd audio snd-s7 snd-motif gsl alsa xm clm6 clm sndlib linux 
+autoload dlopen history complex-numbers system-extras overflow-checks ratio s7-8.11 s7)</em>
+&gt; (provided? 'gsl)
+<em class="gray">#t</em>
+</pre>
+
+<p>The other side of <code>provide</code> is <em class=def id="requires7">require</em>.
+<code>(require . things)</code> finds each thing
+(via <a href="#autoload">autoload</a>), and if that thing has not already been loaded,
+loads the associated file.  <code>(require integrate-envelope)</code>
+loads "env.scm", for example; in this case it is equivalent to
+simply using integrate-envelope, but if placed at the start of
+a file, it documents that you're using that function.
+In the more normal use, <code>(require snd-ws.scm)</code>
+looks for the file that has <code>(provide 'snd-ws.scm)</code>
+and if it hasn't already been loaded, loads it ("ws.scm" in this case).
+To add your own files to this mechanism, add the provided symbol via <a href="#autoload">autoload</a>.
+Since load can take an environment argument, *features* and its friends follow block structure.
+So, for example, (let () (require stuff.scm) ...) loads "stuff.scm" into the local environment,
+not globally.
+</p>
+
+<div class="indented">
+<p>*features* is an odd variable: it is spread out across the chain of environments, and
+can hold features in an intermediate environment that aren't in subsequent (nested) values.
+One simple way this can happen is to load a file in a let, but cause the load to happen
+at the top level.  The provided entities get added to the top-level *features* value,
+not the current let's value, but they are actually accessible locally.  So *features*
+is a merge of all its currently accessible values, vaguely like call-next-method in
+CLOS.  We can mimic this behavior:
+</p>
+<pre class="indented">
+(let ((x '(a)))
+  (let ((x '(b)))
+    (define (transparent-memq sym var e)
+      (let ((val (symbol-&gt;value var e)))
+	(or (and (pair? val)
+		 (memq sym val))
+	    (and (not (eq? e (rootlet)))
+		 (transparent-memq sym var (outlet e))))))
+    (let ((ce (curlet)))
+      (list (transparent-memq 'a 'x ce)
+	    (transparent-memq 'b 'x ce)
+	    (transparent-memq 'c 'x ce)))))
+
+'((a) (b) #f)
+</pre>    
+</div>
+
+<!--
+(let ((spread-function (lambda (x e) (+ x 1))))
+  (let ((spread-function (lambda (x e) (+ x 2))))
+    (let ((x 3))
+      (define (spread-function x e)
+	(let ((val x))
+	  (do ((e1 e (outlet e1)))
+	      ((eq? e1 (rootlet)) val)
+	    (let ((f (symbol->value 'spread-function e1)))
+	      (if (procedure? f)
+		  (set! val (f val (rootlet))))))))
+      (spread-function x (curlet)))))
+ 6
+-->
+
+
+<div class="separator"></div>
+
+<p>Multi-line and in-line comments can be enclosed in #| and |#.
+<code>(+ #| add |# 1 2)</code>.
+</p>
+
+<div class="indented">
+<p>Leaving aside this case and the booleans, #f and #t, you can specify your own handlers for 
+tokens that start with "#".  <b><em class=def id="sharpreaders">*#readers*</em></b> is a list of pairs: <code>(char . func)</code>.
+"char" refers to the first character after the sharp sign (#). "func" is a function of
+one argument, the string that follows the #-sign up to the next delimiter.  "func" is called
+when #&lt;char&gt; is encountered.  If it returns something other than #f, the #-expression
+is replaced with that value.  Scheme has several predefined #-readers for cases such
+as #b1, #\a, and so on, but you can override these if you like.  If the string
+passed in is not the complete #-expression, the function can use read-char or read to get the
+rest.  Say we'd like #t&lt;number&gt; to interpret the number in base 12:
+</p>
+
+<pre class="indented">
+(set! *#readers* (cons (cons #\t (lambda (str) (string-&gt;number (substring str 1) 12))) *#readers*))
+
+&gt; #tb
+<em class="gray">11</em>
+&gt; #t11.3
+<em class="gray">13.25</em>
+</pre>
+
+<p>Or have #c(real imag) be read as a complex number:
+</p>
+
+<pre class="indented">
+(set! *#readers* (cons (cons #\c (lambda (str) (apply complex (read)))) *#readers*))
+
+&gt; #c(1 2)
+<em class="gray">1+2i</em>
+</pre>
+
+<p>Here's a reader macro for read-time evaluation:
+</p>
+
+<pre class="indented">
+(set! *#readers*
+  (cons (cons #\. (lambda (str)
+		    (and (string=? str ".") (eval (read)))))
+	*#readers*))
+
+&gt; '(1 2 #.(* 3 4) 5)
+<em class="gray">(1 2 12 5)</em>
+</pre>
+
+
+<p>And a reader that implements #[...]# for literal hash-tables:
+</p>
+
+<pre class="indented">
+&gt; (set! *#readers* 
+    (list (cons #\[ (lambda (str)
+		      (let ((h (make-hash-table)))
+		        (do ((c (read) (read)))
+		            ((eq? c ']#) h) ; ]# is a symbol from the reader's point of view
+		          (set! (h (car c)) (cdr c))))))))
+<em class="gray">((#\[ . #&lt;lambda (str)&gt;))</em>
+&gt; #[(a . 1) (b . #[(c . 3)]#)]#
+<em class="gray">(hash-table '(b . (hash-table '(c . 3))) '(a . 1))</em>
+</pre>
+
+
+<p>To return no value from a reader, use <code>(values)</code>.
+</p>
+<pre class="indented">
+&gt; (set! *#readers* (cons (cons #\; (lambda (str) (if (string=? str ";") (read)) (values))) *#readers*))
+<em class="gray">((#\; . #&lt;lambda (str)&gt;))</em>
+&gt; (+ 1 #;(* 2 3) 4)
+<em class="gray">5</em>
+</pre>
+<p>Here is CL's #+ reader:
+</p>
+<pre class="indented">
+(define (sharp-plus str)
+  ;; str here is "+", we assume either a symbol or an expression involving symbols follows
+  (let ((e (if (string=? str "+")
+		(read)                                ; must be #+(...)
+		(string-&gt;symbol (substring str 1))))  ; #+feature
+	(expr (read)))  ; this is the expression following #+
+    (if (symbol? e)
+        (if (provided? e)
+	    expr
+	    (values))
+	(if (not (pair? e))
+	    (error 'wrong-type-arg "strange #+ chooser: ~S~%" e)
+	    (begin      ; evaluate the #+(...) expression as in cond-expand
+	      (define (traverse tree)
+		(if (pair? tree)                                             
+		    (cons (traverse (car tree))                             
+			  (case (cdr tree) ((())) (else =&gt; traverse)))
+		    (if (memq tree '(and or not)) tree                 
+			(and (symbol? tree) (provided? tree)))))
+	      (if (eval (traverse e))
+		  expr
+		  (values)))))))
+</pre>
+<p>See also the <a href="#circularlistreader">#n=</a> reader below.</p>
+</div>
+
+<div class="separator"></div>
+
+<p id="makelist">(<b>make-list</b> length (initial-element #f)) returns a list of 'length' elements defaulting to 'initial-element'.
+</p>
+
+<div class="separator"></div>
+
+<pre class="indented">
+(<em class=def id="charposition">char-position</em> char-or-string searched-string (start 0))
+(<em class=def id="stringposition">string-position</em> substring searched-string (start 0))
+</pre>
+
+<p>
+<b>char-position</b> and <b>string-position</b> search a string for the occurrence of a character,
+any of a set of characters, or a string.  They return either #f if none is found, or the position
+within the searched string of the first occurrence.  The optional third argument sets where the
+search starts in the second argument.
+</p>
+
+<p>If char-position's first argument is a string, it is treated as a set of characters, and
+char-position looks for the first occurrence of any member of that set.
+Currently, the strings involved are assumed to be C strings (don't expect embedded nulls
+to work right in this context).
+</p>
+
+
+
+<pre class="indented">
+(call-with-input-file "s7.c" ; report any lines with "static " but no following open paren
+  (lambda (file)
+    (let loop ((line (read-line file #t)))
+      (or (eof-object? line)
+	  (let ((pos (<em class=red>string-position</em> "static " line)))
+	    (if (and pos
+		     (not (<em class=red>char-position</em> #\( (substring line pos))))
+ 	        (if (&gt; (length line) 80)
+		    (begin (display (substring line 0 80)) (newline))
+		    (display line))))
+	    (loop (read-line file #t)))))))
+</pre>
+
+
+<div class="separator"></div>
+
+<pre class="indented">
+(<em class=def id="substringuncopied">substring-uncopied</em> str (start 0) end)
+</pre>
+<p>
+<b>substring-uncopied</b> exists because there are cases where you want substring, but don't need a copy made
+of the string.  <code>substring-uncopied</code> does not GC protect the original string, but obviously depends on it; it is intended
+for very brief uses where there is no chance that the GC will be called.  Normally the optimizer can
+find these cases, so for example, there's no need to use <code>substring-uncopied</code> in <code>(string-length (substring str 1))</code>.
+</p>
+
+<div class="separator"></div>
+
+<p id="keywords">
+Keywords exist mainly for define*'s benefit.  The keyword functions are:
+<b>keyword?</b>, <b>string-&gt;keyword</b>, <b>symbol-&gt;keyword</b>, and <b>keyword-&gt;symbol</b>.
+A keyword is a symbol that starts or ends with a colon. The colon
+is considered to be a part of the symbol name.  A keyword is a constant that evaluates to itself.
+</p>
+
+
+
+<div class="separator"></div>
+
+<pre class="indented">
+(<em class=def id="symboltable">symbol-table</em>)
+(<em class=def id="symboltovalue">symbol-&gt;value</em> sym (env (curlet)))
+(<em class=def id="symboltodynamicvalue">symbol-&gt;dynamic-value</em> sym)
+(<em class=def id="symbolinitialvalue">symbol-initial-value</em> sym) ; settable
+(<em class=def id="definedp">defined?</em> sym (env (curlet)) ignore-rootlet)
+</pre>
+
+<p>
+<code>defined?</code> returns #t if the symbol is defined in the environment:
+</p>
+
+<pre class="indented">
+(define-macro (defvar name value) 
+  `(unless (defined? ',name)
+     (define ,name ,value)))
+</pre>
+
+<p>If ignore-rootlet is #t, the search is confined to the given environment.
+</p>
+<p>
+<code>symbol-&gt;value</code> returns the value (lexically) bound to the symbol, whereas <code>symbol-&gt;dynamic-value</code>
+returns the value dynamically bound to it.
+</p>
+<p>
+<code>symbol-initial-value</code> is normally the built-in (start up) value of a function, accessed via #_abs for example.
+For other symbols this value can only be set once, and the value should be protected from the GC (s7 does not protect it).
+</p>
+<p>
+<code>symbol-table</code> returns a vector containing the symbols currently in the symbol-table.
+Here we scan the symbol table looking for any function that doesn't have documentation:
+</p>
+
+<pre class="indented">
+(for-each 
+   (lambda (sym)
+     (if (<em class=red>defined?</em> sym)
+         (let ((val (<em class=red>symbol-&gt;value</em> sym)))
+           (if (and (procedure? val)
+                    (string=? "" (documentation val)))
+               (format *stderr* "~S " sym)))))
+  (<em class=red>symbol-table</em>))
+</pre>
+
+<p>Or get a list of gensyms:</p>
+<pre>
+(map (lambda (sym) (if (gensym? sym) sym (values))) (<em class=red>symbol-table</em>))
+</pre>
+
+<div class="indented">
+
+<p>An automatic software tester (see also tauto.scm and auto-tester.scm in the tools directory):
+</p>
+
+<pre class="indented">
+(for-each 
+  (lambda (sym)
+    (if (<em class=red>defined?</em> sym)
+	(let ((val (<em class=red>symbol-&gt;value</em> sym)))
+          (if (procedure? val)
+	      (let ((max-args (cdr (arity val))))
+	        (if (or (&gt; max-args 4)
+	   	        (memq sym '(exit abort)))
+		    (format () ";skip ~S for now~%" sym)
+		    (begin
+		      (format () ";whack on ~S...~%" sym)
+                      (let ((constants (list #f #t pi () 1 1.5 3/2 1.5+i)))
+                        (let autotest ((args ()) (args-left max-args))
+                          (catch #t (lambda () (apply func args)) (lambda any #f))
+                          (if (&gt; args-left 0)
+ 	                      (for-each
+	                        (lambda (c)
+	                          (autotest (cons c args) (- args-left 1)))
+	                        constants)))))))))))
+  (<em class=red>symbol-table</em>))
+</pre>
+</div>
+
+
+<div class="separator"></div>
+
+<p id="s7help"><b>help</b> tries to find information about its argument.
+</p>
+
+<pre class="indented">
+&gt; (help 'caadar)
+<em class="gray">"(caadar lst) returns (car (car (cdr (car lst)))): (caadar '((1 (2 3)))) -&gt; 2"</em>
+</pre>
+
+
+
+<div class="separator"></div>
+
+<p id="s7gc"><b>gc</b> calls the garbage collector.  <code>(gc #f)</code> turns off the GC, and <code>(gc #t)</code> turns it on.
+</p>
+
+<p>If you get an error complaining about a "free cell", this is usually a sign that the GC freed some object
+that it should have left alone.  In straight scheme code, it's an s7 bug; please send me mail about it!
+In foreign code, it probably indicates that you need to protect some s7_pointer with s7_gc_protect.
+</p>
+
+
+<div class="separator"></div>
+
+<pre class="indented">
+(<b><em class=def id="equivalentp">equivalent?</em></b> x y)
+</pre>
+
+<p>
+Say we want to check that two different computations came to the same result, and that result might
+involve circular structures.  Will equal? be our friend?
+</p>
+
+<pre class="indented">
+&gt; (equal? 2 2.0)
+<em class="gray">#f</em>
+&gt; (let ((x +nan.0)) (equal? x x))
+<em class="gray">#f</em>
+&gt; (equal? .1 1/10)
+<em class="gray">#f    </em>
+&gt; (= .1 1/10)
+<em class="gray">#f</em>
+&gt; (= 0.0 0+1e-300i)
+<em class="gray">#f</em>
+</pre>
+
+<p>No! We need an equality check that ignores epsilonic differences in real and
+complex numbers, and knows that NaNs are equal for all practical purposes.
+Leaving aside numbers, 
+closed ports are not equal, yet nothing can be done with them.
+#() is not equal to #2d().  And two closures are never equal, even if their
+arguments, environments, and bodies are equal.
+Since there might be circles, it is not easy to write
+a replacement for equal? in Scheme.
+So, in s7, if one thing is basically the same as
+some other thing, they satisfy the function equivalent?.
+</p>
+
+<pre class="indented">
+&gt; (equivalent? 2 2.0)
+<em class="gray">#t</em>
+&gt; (equivalent? 1/0 1/0)         ; NaN
+<em class="gray">#t</em>
+&gt; (equivalent? .1 1/10)
+<em class="gray">#t</em>                              ; floating-point epsilon here is 1.0e-15 or thereabouts
+&gt; (equivalent? 0.0 1e-300)
+<em class="gray">#t</em>
+&gt; (equivalent? 0.0 1e-14)
+<em class="gray">#f</em>                              ; its not always #t!
+&gt; (equivalent? (lambda () #f) (lambda () #f))
+<em class="gray">#t</em>
+</pre>
+
+<p>The *s7* field equivalent-float-epsilon sets the floating-point fudge factor.
+I can't decide how bignums should interact with equivalent?.  Currently,
+if a bignum is involved, either here or in a hash-table, s7 uses equal?.
+Finally, if either argument is an environment with an 'equivalent? method,
+that method is invoked.
+</p>
+
+
+<div class="separator"></div>
+
+<p>
+<b><em class=def id="expansion">define-expansion</em></b> defines a macro that expands at read-time.
+It has the same syntax as
+define-macro, and (in normal use) the same result, but it is much faster because it expands only once.
+Similarly, <b>define-expansion*</b> defines a read-time macro*.
+(See also define-with-macros in s7test.scm for a way to expand macros in a function body at definition time).
+Since the reader knows almost nothing
+about the code it is reading, 
+you need to make sure the expansion is defined at the top level and that its name is unique.
+The reader does know about global variables, so:
+</p>
+
+<pre class="indented">
+(define *debugging* #t)
+
+(define-expansion (assert assertion)
+  (if *debugging*          ; or maybe better, (eq? (symbol-&gt;value '*debugging*) #t)
+      `(unless ,assertion
+	 (format *stderr* "~A: ~A failed~%" (*function*) ',assertion))
+      (values)))
+</pre>
+
+<p>Now the assertion code is only present in the function body (or wherever)
+if *debugging* is #t; otherwise assert expands into nothing.  Another very handy
+use is to embed a source file line number into a message; see for example lint-format
+in lint.scm.
+Leaving aside
+read-time expansion and splicing, the real difference between define-macro and define-expansion
+is that the expansion's result is not evaluated.
+I'm no historian, but I believe that means that define-expansion creates
+a (gasp!) f*xpr.  In fact:
+</p>
+
+<pre>
+(define-macro (define-f*xpr name-and-args . body)
+  `(define ,(car name-and-args)
+     (apply define-expansion 
+       (append (list (append (list (gensym)) ',(cdr name-and-args))) ',body))))
+
+&gt; (define-f*xpr (mac a) `(+ ,a 1))
+<em class="gray">mac</em>
+&gt; (mac (* 2 3))
+<em class="gray">(+ (* 2 3) 1)</em>
+</pre>
+
+<p>
+You can do something similar with a normal macro, or make the indirection explicit:
+</p>
+
+<pre class="indented">
+&gt; (define-macro (fx x) `'(+ 1 ,x)) ; quote result to avoid evaluation
+<em class="gray">fx</em>
+&gt; (let ((a 3)) (fx a))
+<em class="gray">(+ 1 a)</em>
+&gt; (define-expansion (ex x) `(+ 1 ,x))
+<em class="gray">ex</em>
+&gt; (let ((x ex) (a 3)) (x a))       ; avoid read-time splicing
+<em class="gray">(+ 1 a)</em>
+&gt; (let ((a 3)) (ex a))             ; spliced in at read-time
+<em class="gray">4</em>
+</pre>
+
+<p>As this example shows, the reader knows nothing about the program context,
+so if it does not see a list whose first element is a expansion name, it does
+not do anything special.  In the <code>(x a)</code> case above, the
+expansion happens when the code is evaluated, and the expansion result
+is simply returned, unevaluated.  
+</p>
+
+<p>You can also use macroexpand to cancel the evaluation of a macro's expansion:
+</p>
+<pre>
+(define-macro (rmac . args)
+  (if (null? args)
+      ()
+      (if (null? (cdr args))
+	  `(display ',(car args))
+	  (list 'begin
+                `(display ',(car args))
+		(apply macroexpand (list (cons 'rmac (cdr args))))))))
+
+&gt; (macroexpand (rmac a b c))
+<em class="gray">(begin (display 'a) (begin (display 'b) (display 'c)))</em>
+&gt; (begin (rmac a b c d) (newline))
+<em class="gray">abcd</em>
+</pre>
+
+<p>The main built-in expansion is <b><em class=def id="readercond">reader-cond</em></b>.  The syntax is based on cond:
+the car of each clause is evaluated (in the read-time context), and if it is not false,
+the remainder of that clause is spliced into the code as if you had typed it from the start.
+</p>
+
+<pre class="indented">
+&gt; '(1 2 (reader-cond ((> 1 0) 3) (else 4)) 5 6)
+<em class="gray">(1 2 3 5 6)</em>
+&gt; ((reader-cond ((> 1 0) list 1 2) (else cons)) 5 6)
+<em class="gray">(1 2 5 6)</em>
+</pre>
+
+<p>Here is reader-if:
+</p>
+<pre>
+(define-expansion (reader-if test true . false)
+  (let ((test-val (eval test)))
+    (if test-val 
+	true 
+	(and (pair? false)
+	     (car false)))))
+</pre>
+
+
+<!-- from kanren
+(define-syntax conj*
+  (syntax-rules ()
+    ((conj*) succeed)
+    ((conj* g) g)
+    ((conj* g gs ...)
+      (conj g (lambda (s) ((conj* gs ...) s))))))
+
+is the same (in that context) as:
+
+(define-macro (conj* . args)
+  (if (null? args)
+      succeed
+      (if (null? (cdr args))
+	  (car args)
+	  `(conj ,(car args)
+		 (lambda (s) ((conj* ,@(cdr args)) s))))))
+-->
+
+
+<div class="separator"></div>
+<p id="profiling">
+Whenever (*s7* 'profile) is positive, profiling is turned on.
+As the program runs, the profiler collects data about each function it can identify.
+At any time, you can call show-profile to see that data.  The first timing is inclusive
+(it includes the time spent in any nested calls), the second is exclusive (it is the time
+spent just in the current function).  In Linux and *BSD, we use clock_gettime() which is reasonably
+fast, but there is some profiler overhead.  In other systems, we use clock() which is
+amazingly slow.  The optimizer sometimes recasts tail recursion and similar cases as while loops,
+so the number of calls listed may be less than you'd expect, but the overall time should be
+correct.  To clear out the current data, call clear-profile.
+</p>
+
+
+<div class="separator"></div>
+<p id="s7env"><b>*s7*</b> is a let that gives access to some of s7's internal
+state: 
+</p>
+<pre class="indented">
+version                       a string describing the current s7: e.g. "s7 10.0, 13-Jan-2022"
+major-version                 an integer (10 in the example above)
+minor-version                 an integer (0 in the example above)
+
+print-length                  number of elements to print of a non-string sequence
+max-string-length             maximum size arg to make-string and read-string
+max-format-length             maximum size arg to ~N or the width and precision fields for floats in format
+max-list-length               maximum size arg to make-list
+max-port-data-size            maximum size of a port data buffer
+max-vector-length             maximum size arg to make-vector and make-hash-table
+max-vector-dimensions         make-vector dimensions limit
+default-hash-table-length     default size for make-hash-table (8, tables resize as needed)
+initial-string-port-length    128, initial size of a input string port's buffer
+output-port-data-size         2048, size of an output port's buffer
+
+history			      a circular buffer of recent eval entries stored backwards (use set! to add an entry)
+history-size                  eval history buffer size if s7 built WITH_HISTORY=1
+history-enabled               is history buffer receiving additions (if WITH_HISTORY=1 as above)
+debug                         determines debugging level (see debug.scm), default=0
+profile                       profile switch (0=default, 1=gather profiling info)
+profile-info                  the current profiling data; see profile.scm
+profile-prefix                name (a symbol) used to identify the current environment in profile data
+
+default-rationalize-error     1e-12
+equivalent-float-epsilon      1e-15
+hash-table-float-epsilon      1e-12 (currently limited to less than 1e-3).
+bignum-precision              bits for bignum floats (128)
+float-format-precision        digits to print for floats (16)
+default-random-state          the default arg for random
+most-positive-fixnum          if not using gmp, the most positive integer ("fixnum" comes from CL)
+most-negative-fixnum          as above, but negative
+number-separator              #\null
+symbol-quote?                 #f, so in (quote x) "quote" is a #_quote (a c-function); set to #t to get quote as a symbol
+symbol-printer                #f, a function to print symbols whose names contain unusual character
+
+safety                        0 (see below)
+undefined-identifier-warnings #f 
+undefined-constant-warnings   #f 
+accept-all-keyword-arguments  #f 
+autoloading?                  #t
+openlets                      #t, whether any let can be open globally (this overrides all openlets)
+expansions?                   #t, whether expansions are handled at read-time
+muffle-warnings?              #f, if #t s7_warn does not output anything
+
+cpu-time                      run time so far (proportional to cpu cycles consumed, not wall-clock seconds)
+file-names or filenames       currently loaded files (a list)
+catches                       a list of the currently active catch tags
+c-types                       a list of c-object type names (from s7_make_c_type, etc)
+
+stack			      the current stack entries
+stack-top                     current stack location
+stack-size                    current stack size
+max-stack-size                maximum stack size
+stacktrace-defaults           stacktrace formatting info for error handler
+
+rootlet-size                  the number of globals
+heap-size                     total cells currently available
+max-heap-size                 maximum heap size
+free-heap-size                the number of currently unused cells
+gc-stats                      0 (or #f), 1: show GC activity, 2: heap, 4: stack, 8: protected_objects, #t = 1
+gc-freed                      number of cells freed by the last GC pass
+gc-total-freed                number of cells freed so far by the GC; the total allocated is probably close to
+                                (with-let *s7* (+ (- heap-size free-heap-size) gc-total-freed))
+gc-info                       a list: calls total-time ticks-per-second (see profile.scm)
+gc-temps-size                 number of cells just allocated that are protected from the GC (256)
+gc-resize-heap-fraction       when to resize the heap (0.8); these two are aimed at GC experiments
+gc-resize-heap-by-4-fraction  when to get panicky about resizing the heap
+gc-protected-objects          vector of the objects permanently protected from the GC
+memory-usage                  a let (environment) describing current s7 memory allocations
+</pre>
+
+<p>
+Use the standard environment syntax to access these fields:
+<code>(*s7* 'stack-top)</code>.  stuff.scm has the function
+*s7*-&gt;list that returns most of these fields in a list.
+</p>
+<p>The compile-time defaults for some of these fields can be set:
+</p>
+<pre class="indented">
+heap-size:               INITIAL_HEAP_SIZE        (64000)
+stack-size:              INITIAL_STACK_SIZE       (4096)
+gc-temps-size:           GC_TEMPS_SIZE            (256)
+bignum-precision:        DEFAULT_BIGNUM_PRECISION (128)
+history-size:            DEFAULT_HISTORY_SIZE     (8)
+print-length:            DEFAULT_PRINT_LENGTH     (12)
+gc-resize-heap-fraction: GC_RESIZE_HEAP_FRACTION  (0.8)
+output-port-data-size:   OUTPUT_PORT_DATA_SIZE    (2048)
+
+See also WITH_WARNINGS, S7_ALIGNED, and GC_TRIGGER_SIZE.
+</pre>
+
+<p><code>(set! (*s7* 'autoloading) #f)</code> turns off the autoloader.
+</p>
+
+<p>The 'safety variable is an integer. Currently:
+</p>
+<pre class="indented">
+0: default.
+1: no remove_from_heap (a GC optimization)
+   infinite loop check in eval, sort! and some iterators
+   immutable object check in reverse!, sort!, and fill!
+   more info in (*s7* 'history) for s7_apply_function, s7_call and s7_eval
+   less aggressive optimization in with-let and lambda
+   warnings about syntax redefinition
+   incoming s7_pointer checks in some FFI functions
+   bignum int to s7_int conversion checks
+2: vector, string, and pair constants are immutable (but checks for this are currently sparse)
+</pre>
+
+<p>The debug variable controls where <a href="#debug">debug.scm</a> is active.  If it is (if debug &gt; 0), it inserts
+trace calls in functions and so on.  It uses <em class=def id="dynamicunwind">dynamic-unwind</em>
+to establish a catcher for the return value.  <code>(dynamic-unwind function arg)</code> causes
+<code>function</code> to be called after the traced function has returned, passing it <code>arg</code>
+and the returned value.
+</p>
+
+
+<p><code>(*s7* 'stacktrace-defaults)</code> is a list of four integers and a boolean that tell the error
+handler how to format stacktrace information.  The four integers are: 
+how many frames to display, 
+how many columns are devoted to code display,
+how many columns are available for a line of data,
+and where to place comments.
+The boolean sets whether the entire output should be displayed as a comment.
+The defaults are '(3 45 80 45 #t).
+</p>
+
+<p>This will display s7 memory usage sort of like the top program:
+</p>
+<pre class="indented">
+(format *stderr* "~C[~D;~DH" #\escape 0 0)
+(format *stderr* "~C[J" #\escape)
+(display (with-output-to-string (lambda() (<em class="red">*s7* 'memory-usage</em>))))
+</pre>
+<p>(Ideally we'd only redisplay the changed fields).
+</p>
+
+<p>The standard time macro:</p>
+
+<pre class="indented">
+(define-macro (time expr) 
+  `(let ((start (<em class="red">*s7* 'cpu-time</em>)))
+     (let ((res (list ,expr))) ; expr might return multiple values
+       (list (car res)
+	     (- (<em class="red">*s7* 'cpu-time</em>) start)))))
+</pre>
+
+<p>Add automatic log10 recalculation to (*s7* 'bignum-precision):</p>
+
+<pre class="indented">
+(define log10 (log (bignum 10)))
+(define bignum-precision (dilambda (lambda () 
+				     (<em class="red">*s7* 'bignum-precision</em>)) 
+				   (lambda (val)
+				     (set! (<em class="red">*s7* 'bignum-precision</em>) val)
+				     (set! log10 (log (bignum 10)))
+				     val)))
+</pre>
+
+<p>The stack, history and gc-protected-objects fields are intended for debugging.  Don't keep 
+these hanging around and expect good things to happen!
+</p>
+
+<p>The *s7* field 'number-separator refers to what some languages call "numeric literal separator",
+a character that can appear in a number as a separator to make it more readable:  "123,321"
+as opposed to "123321".  If the compile time flag WITH_NUMBER_SEPARATOR is set, and 
+(*s7* 'number-separator) is not #\null (the default), then that character can appear anywhere
+in a number (as long as it is between two digits), and the reader will ignore it.  The *features*
+list will have the entry 'number-separator if s7 was compiled with WITH_NUMBER_SEPARATOR defined.
+(Number separators don't work with bignums).
+</p>
+
+<p>(*s7* 'symbol-printer) is invoked by object-&gt;string when it has to print a symbol whose
+name can normally only be handled by the <a href="#weirdsymbols">symbol</a> function.
+</p>
+
+
+<div class="separator"></div>
+<pre class="indented">
+(<em class=def id="cobject">c-object?</em> obj)
+(<em class=def id="cobjecttypew">c-object-type</em> obj)
+
+(<em class=def id="cpointer">c-pointer?</em> obj)
+(<em class=def id="cpoint">c-pointer</em> int type info weak1 weak2)
+(<em class=def id="cpointtype">c-pointer-type</em> obj)
+(<em class=def id="cpointinfo">c-pointer-info</em> obj)
+(<em class=def id="cpointweak1">c-pointer-weak1</em> obj) ; also weak2
+(<em class=def id="cpointertolist">c-pointer-&gt;list</em> obj)
+</pre>
+
+<p>
+c-object? returns #t is its argument is a c-object. 
+c-object-type returns the object's type tag (otherwise #f of course).  This tag is also the position
+of the object's type in the (*s7* 'c-types) list. 
+(*s7* 'c-types) returns a list of the types created by s7_make_c_type.
+</p>
+<p>
+You can wrap up raw C pointers and
+pass them around in s7 code. The function c-pointer returns a wrapped pointer,
+and c-pointer? returns #t if passed one.  <code>(define NULL (c-pointer 0))</code>.
+If the type field is a symbol, it is used to check types in s7_c_pointer with_type.
+If the 'info field of a c-pointer is a let, that pointer can participate in 
+the generic functions mechanism, much like a c-object:
+</p>
+<pre class="indented">
+&gt; (let ((ptr (c-pointer 1 'abc 
+                (inlet 'object-&gt;string 
+		  (lambda (obj . args)
+		    (let ((lt (object-&gt;let obj)))
+		      (format #f "I am pointer ~A of type '~A!" 
+			      (lt 'c-pointer)        ; we need c-pointer-type etc
+			      (lt 'c-type))))))))
+    (openlet ptr)
+    (object-&gt;string ptr))
+<em class="gray">"I am pointer 1 of type 'abc!"</em>
+</pre>
+<p>c-pointer-&gt;list returns (list pointer-as-int type info).
+The "weak1" and "weak2" fields are intended for custom "weak" references. The weak
+fields values are not marked during the GC sweep, much like a key in a weak-hash-table.
+If either value is GC'd, that field is set to #f by the GC.  The weak fields are
+ignored by equal? and equivalent? when comparing c-pointers, and by object-&gt;string
+of a c-pointer even if :readable is specified.
+</p>
+
+
+<div class="separator"></div>
+
+<p>There are several tree-oriented functions currently built into s7:
+</p>
+<pre class="indented">
+(<em class=def id="treecyclic">tree-cyclic?</em> tree) returns #t if tree contains a cycle.
+(<em class=def id="treeleaves">tree-leaves</em> tree) returns the number of leaves in tree.
+(<em class=def id="treememq">tree-memq</em> obj tree) returns #t if obj is in tree (using eq?).
+(<em class=def id="treesetmemq">tree-set-memq</em> set tree) returns #t if any member of the set (using eq?) is in tree.
+(<em class=def id="treecount">tree-count</em> obj tree) returns how many times obj is in tree.
+</pre>
+
+
+<div class="separator"></div>
+
+<p>s7 originally had Scheme-level multithreading support, but I removed it in August, 2011.
+It turned out to be less useful than I hoped,
+mainly because s7 threads shared the heap and therefore had to coordinate
+all cell allocations.  It was faster and simpler to use multiple
+processes each running a separate s7 interpreter, rather than one s7
+running multiple s7 threads.  In CLM, there was also contention for access
+to the output stream.  In GUI-related situations,
+threads were not useful mainly because the GUI toolkits are not thread safe.
+Last but not least, the effort to make the non-threaded
+s7 faster messed up parts of the threaded version.  Rather than
+waste a lot of time fixing this, I chose to flush multithreading.
+s7 is thread-safe:
+</p>
+
+<blockquote>
+<div class="indented">
+<pre>
+#include &lt;stdio.h&gt;
+#include &lt;stdlib.h&gt;
+#include &lt;pthread.h&gt;
+#include "s7.h"
+
+#define NUM_THREADS 16
+static pthread_t threads[NUM_THREADS];
+static pthread_mutex_t lock = PTHREAD_MUTEX_INITIALIZER;
+
+static void *run_thread(void *obj)
+{
+  s7_scheme *sc = (s7_scheme *)obj;
+  const char *str = s7_object_to_c_string(sc, s7_make_integer(sc, 123));
+  s7_eval_c_string(sc, "(let () \
+                          (define (f) \
+                            (do ((i 0 (+ i 1))) ((= i 10)) \
+                              (do ((k 0 (+ k 1))) ((= k 1000000))) \
+                              (format *stderr* \"~D \" i))) \
+                          (f))");
+  pthread_mutex_lock(&amp;lock);
+  fprintf(stderr, "%s\n", str);
+  pthread_mutex_unlock(&amp;lock);
+}
+
+int main(int argc, char **argv)
+{
+  for (int32_t i = 0; i &lt; NUM_THREADS; i++)
+    pthread_create(&amp;threads[i], NULL, run_thread, (void *)s7_init());
+  for (int32_t i = 0; i &lt; NUM_THREADS; i++)
+    pthread_join(threads[i], NULL);
+  exit(0);
+}
+
+/* linux: gcc -o threads threads.c s7.o -Wl,-export-dynamic -pthread -lm -I. -ldl
+ * mac: clang -o threads threads.c s7.o -pthread -lm -I. -ldl
+ */
+</pre>
+</div>
+</blockquote>
+
+
+
+<div class="separator"></div>
+
+<blockquote>
+
+<div class="indented">
+<p id="s7vsr5rs">Some other differences from r5rs:
+</p>
+
+<ul style="list-style-type:disc;">
+<li>no force or delay (see <a href="#r7rs">below</a>).
+<li>no syntax-rules or any of its friends.
+<li>no scheme-report-environment, null-environment, or interaction-environment (use curlet).
+<li>no transcript-on or transcript-off.
+<li>begin returns the value of the last form; it can contain both definitions and other statements.
+<li>#&lt;unspecified&gt;, #&lt;eof&gt;, and #&lt;undefined&gt; are first-class objects.
+<li>for-each and map accept different length arguments; the operation stops when any argument reaches its end.
+<li>for-each and map accept any applicable object as the first argument, and any sequence or iterator as a trailing argument.
+<li>letrec*, but without conviction.
+<li>set! and *-set! return the new value (modulo setter), not #&lt;unspecified&gt;.
+<li>define and its friends return the new value.
+<li>port-closed? 
+<li>list? means "pair or null", proper-list? is r5rs list?, float? = real and not rational, sequence? = length, byte? = unsigned byte.
+<!-- a vector can be a member of itself, and yet vector? returns #t, why is list? different; we even call it a circular list! -->
+<li>the default IO ports are named *stdin*, *stdout*, and *stderr*.
+<li>#f as an output port means nothing is output (#f is /dev/null, I guess).
+<li>member and assoc accept an optional third argument, the comparison function (equal? is the default).
+<li>case accepts =&gt; much like cond (the function argument is the selector).
+<li>if WITH_SYSTEM_EXTRAS is 1, the following are built-in: directory?, file-exists?, delete-file, system, directory-&gt;list, getenv.
+<li>s7 is case sensitive.
+<li>when and unless (for r7rs), returning the value of the last form.
+<li>the "d", "f", "s", and "l" exponent markers are not supported by default (use "e", "E", or "@").
+<li>quasiquoted vector constants are not supported (read-time expansions can be used here; see s7test.scm).
+<li><em class=def id="typeof">type-of</em> returns a type indicator for its argument.
+<li>'&lt;datum&gt; is (#_quote &lt;datum&gt;), see <a href="#quotediff">below</a>.
+<li>s7 symbol names can begin with a digit: <code>(define (1+ x) (+ x 1))</code>.
+</ul>
+
+<p>In s7 if a built-in function like gcd is referred to in a function
+body, the optimizer is free to replace it with #_function.  That is, <code>(gcd ...)</code> can be changed
+to <code>(#_gcd ...)</code> at s7's whim, if gcd has its original value at the time the optimizer
+sees the expression using it.  A subsequent <code>(set! gcd +)</code> does not affect this optimized call.
+I think I could wave my hands and mumble about "aggressive lexical scope" or something, but actually the
+choice here is that speed trumps that ol' hobgoblin consistency.  If you want to change gcd to +, do it before
+loading code that calls gcd.  
+I think most Schemes handle macros this way: the macro call is replaced by its expansion using its current
+definition, and a later redefinition does not affect earlier uses.
+Guile behaves like s7:
+</p>
+<pre class="indented">
+(define (add1 x) (+ x 1))
+(set! + -)
+(display (add1 3))) ; 4 in both s7 and Guile 3.0.4
+</pre>
+<p>But if a Scheme function is involved, things get messy:
+</p>
+<pre class="indented">
+(define (fib n) (if (&lt; n 2) n (+ (fib (- n 1)) (fib (- n 2)))))
+(define oldfib fib)
+(set! fib 32)
+(display (oldfib 10))) ; s7 says 55, Guile says "wrong type to apply: 32"
+</pre>
+<p>I can't decide which way is correct: s7 looks more consistent,
+but:
+</p>
+<pre class="indented">
+(define (fib n) 32)
+(set! fib (lambda (n) (if (&lt; n 2) n (+ (fib (- n 1)) (fib (- n 2))))))
+(define oldfib fib)
+(set! fib 32)
+(display (oldfib 10)) ; "attempt to apply an integer 32 to..."
+</pre>
+<p>So s7 is inconsistent too! (Actually this was consistent until Jan 2021 when I suddenly thought it was
+a mistake and "fixed" it; now I'm having second thoughts).
+</p>
+
+<!-- (eq? (if #f #f) (apply values ())) is #t, but memq and assq don't treat them as equal -->
+
+</div>
+
+
+<div class="indented">
+
+<p>Here are some changes I'd make to s7 if I didn't care about compatibility with other Schemes:
+</p>
+
+<ul style="list-style-type:disc;">
+<li>remove the exact/inexact distinction including #i and #e (done! #i means int-vector constant).
+<li>remove call-with-values and its friends
+<li>remove char-ready?
+<li>change eof-object? to eof? or just omit it (you can use eq? #&lt;eof&gt;)
+<li>change make-rectangular to complex (done!), and remove make-polar.
+<li>remove unquote (the name, not the functionality).
+<li>remove cond-expand.
+<li>remove *-ci functions
+<li>remove #d (done!)
+</ul>
+
+<p>(most of these are removed if you set the compiler flag WITH_PURE_S7), and perhaps:
+</p>
+
+<ul style="list-style-type:disc;">
+<li>remove even? and odd?, gcd and lcm.
+<li>remove string-length and vector-length.
+<!-- <li>remove list-ref, list-set!, string-ref, string-set!, vector-ref, vector-set!, hash-table-ref, hash-table-set!, set-car!, set-cdr!, and set-current-*-port. -->
+<li>change file-exists? to file? (or omit it and assume the use of libc.scm &mdash; why reinvent the wheel?).
+<li>remove all the conversion and copy functions like vector-&gt;list and vector-copy (use copy or map).
+<li>change string-&gt;symbol to symbol (what to do with symbol-&gt;string in that case?)
+<li>change with-output-to-* and with-input-from-* to omit the pointless lambda.
+<li>remove the with-* IO functions (e.g. with-input-from-string), keeping the call-with-* versions (call-with-input-string).
+<li>remove assq, assv, memq, and memv (these are pointless now that assoc and member can be passed eq? and eqv?).
+<li>move all the "*var*" names to *s7*: *load-hook* becomes (*s7* 'load-hook) for example.
+</ul>
+
+<p>Currently WITH_PURE_S7:
+</p>
+<ul style="list-style-type:disc;">
+<li>places 'pure-s7 in *features*
+<li>omits char-ready, char-ci*, string-ci*
+<li>omits string-fill!, vector-fill!, vector-append
+<li>omits list-&gt;string, list-&gt;vector, string-&gt;list, vector-&gt;list, let-&gt;list
+<li>omits string-length and vector-length
+<li>omits cond-expand, multiple-values-bind|set!, call-with-values
+<li>omits unquote (the name)
+<li>omits d/f/s/l exponents
+<li>omits make-polar and make-rectangular (use complex)
+<li>omits exact?, inexact?, exact-&gt;inexact, inexact-&gt;exact
+<li>omits set-current-output-port and set-current-input-port
+</ul>
+
+<p>With the move to s7_setter and s7_set_setter (setter in Scheme), 
+dilambda and dilambda? have been reduced to trivial conveniences, so perhaps they can also be
+removed.
+</p>
+
+<p>string-copy has 3 extra arguments to allow strings to be copied directly into other strings.
+In vectors, we can use subvector, but substring returns a new string (copying its argument) unless
+the optimizer notices that the copy is not needed.  Copy almost works, but its start and end arguments
+refer to the source, not the destination.  substring should be like subvector, but that is not backwards compatible.
+</p>
+
+<p>There are several less-than-ideal names.  
+get-output-string should be current-output-string. write-char behaves like display, not write.
+provided? should be feature? or *features* should be *provisions*.
+list-ref, list-set!, and list-tail actually only apply to pairs.
+let-temporarily should be templet, set-temporarily, or maybe just "with".  define-expansion should be define-reader-macro, but
+that name collides with reader macros in Common Lisp.  *cload-directory* should be *cload-path*.
+There should not be two names for the same thing: call/cc and call-with-current-continuation: flush the latter!
+The CL-inspired "log*" names such as logand look very old-fashioned.  Standard scheme opts
+for the name "bitwise*"; why not "integerwise" or "bytevectorwise"?  The "wise" business is just noise; are they thinking of The Hobbit?
+<code>(define & logand) (define | logior) (define ~ lognot)</code>, but ^ for logxor
+(as in C) is not ideal; ^ should be expt.  Finally, I think the notion of a current input or output port is
+a mistake: the IO functions should always get an explicit port.  
+</p>
+
+<p>
+cond-expand is dumb and its name is dumber.
+Take libgsl.scm; different versions of the GSL library have different functions.  We need to know
+when we're building the FFI what GSL version we're dealing with.  It would be nuts to start pushing and checking dozens
+of library version symbols when all we actually want is <code>(&gt; version 23.19)</code>. 
+In place of cond-expand, s7 uses <a href="#readercond">reader-cond</a>,
+so the read-time decision involves normal Scheme evaluation.
+</p>
+
+
+<blockquote>
+<div class="indented">
+<p>In the section about cond-expand, the r7rs spec says "If none of the &lt;feature requirement&gt;s evaluate to #t, 
+then if there is an else clause, its &lt;expression&gt;s are included. Otherwise, the cond-expand has no effect."
+I read that to mean that <code>(begin 23 (cond-expand (surreals 1)))</code> should evaluate to 23,
+and <code>(abs -1 (cond-expand (surreals 1)))</code> should be 1.  Currently s7 returns #&lt;unspecified&gt; for the
+first, and an error, "abs: too many arguments: (abs -1 #&lt;unspecified&gt;)" for the second. 
+reader-cond behaves in a way that fits the r7rs spec: <code>(begin 23 (reader-cond ((provided? 'surreals) 1)))</code>
+returns 23, and <code>(abs -1 (reader-cond ((provided? 'surreals) 1)))</code> returns 1, but these examples make
+me unhappy.  Even worse: <code>(define (f a (reader-cond ((provided? 'surreals) b))) a)</code> which adds
+the argument "b" if surreals are provided.
+Maybe reader-cond (and expansions in general) should not magically evaporate in such cases.
+
+(I just noticed that the corrected r7rs.pdf says that the result in cond-expand is unspecified).
+</p>
+<!--
+There's no statement in the r7rs spec that cond-expand can only happen at top-level, and in s7 you can load a
+file into any environment, so there's no way to tell if some code is being spliced in at the top-level, even if
+it's at the top level of the file's code, so it doesn't help to try to restrict reader-cond in that way.
+-->
+</div>
+</blockquote>
+
+<p>Then there's the case case: a case clause without a result appears to be an error in r7rs.
+But the notation used to indicate that is the same as that used for begin,
+so if we allow <code>(begin)</code>, we should allow case clauses to have no explicit result.
+In cond,
+the "implicit progn" (in CL terminology) includes the test expression, so a clause without a result returns
+the test result (if true of course).  In the case case, s7 returns the selector.
+<code>(case x ((0 1)))</code> is equivalent to <code>(case x ((0 1) =&gt; values))</code>, 
+just as <code>(cond (A))</code> is equivalent to <code>(cond (A =&gt; values))</code>.
+One application is method lookup: <code>((case (obj 'abs) ((#&lt;undefined&gt;) abs) (else)) ...)</code>;
+we would otherwise have to save the lookup result or do it twice.
+This choice has a ripple
+effect on do: if no result is specified for do, s7 returns the test result.
+It also affects 
+hash-tables.  Currently hash-table-ref returns #f if the key is not in the table,
+mimicking assoc and aimed at cond with =&gt;, but if we also use case and #&lt;undefined&gt;,
+it seems more useful and maybe intuitive to mimic let-ref instead.  But if hash-table-ref returns
+#&lt;undefined&gt;, it's harder to use hash-tables as sets.  Hmm.
+In any case,
+the fall-through value of case should be (and is in s7)
+#&lt;unspecified&gt;: case is a form of if, so
+<code>(if #f #f)</code>, <code>(cond (#f #f))</code>, and <code>(case #t ((#f) #f))</code> should be equal.
+</p>
+
+
+<p>
+Better ideas are always welcome!
+</p>
+
+<p>Here are the built-in s7 variables:
+</p>
+<ul>
+<li>*features*        ; a list of symbols
+<li>*libraries*       ; a list of (filename . let) pairs
+<li>*load-path*       ; a list of directories
+<li>*cload-directory* ; directory for cload output
+<li>*autoload*        ; autoload info
+<li>*#readers*        ; a list of (char . handler) pairs
+</ul>
+
+<p>And the built-in constants:
+</p>
+<ul style="list-style-type:disc;">
+<li>pi
+<li>*stdin* *stdout* *stderr*
+<li>*s7*
+<li>+nan.0 -nan.0 +inf.0 -inf.0 (what crappy names! +nan.0 is a positive inexact integer that is not a number?)
+<li>*unbound-variable-hook* *missing-close-paren-hook* *load-hook* *autoload-hook*
+<li>*error-hook* *read-error-hook* *rootlet-redefinition-hook*
+</ul>
+
+<p>Is it odd that the "+" in +nan.0 can't be omitted, but as used in a complex number, someone drops a "+": 1+nan.0i?
+</p>
+
+<p>(<b><em class=def id="currentfunction">*function*</em></b>) returns the name (or name and location) of the function currently being called.
+<code>(define (example) (*function*))</code> returns <code>'example</code>.
+Here is an example using a bacro (to access the call-time environment) and an openlet to implement a probe; 
+it reports any operation that the probe participates in, using *function* to get the calling function name:
+</p>
+<pre class="indented">
+(define (probe-eval val)
+  (let ((all-let (inlet)))
+    (for-each
+     (lambda (sym)
+       (unless (immutable? sym) ; apply-values etc
+	 (let ((func (symbol-&gt;value sym (rootlet))))
+	   (when (procedure? func)
+	     (varlet all-let sym
+		     (apply <em class=red>bacro</em> 'args
+		       `((let-temporarily (((*s7* 'openlets) #f))
+			   (let ((clean-args (map (lambda (arg)
+						    (if (eq? arg probe-eval)
+							(probe-eval 'value)
+							arg))
+						  args)))
+			   (format *stderr* "(~S ~{~S~^ ~}) ; ~S~%" 
+                                   ,sym clean-args 
+                                   (<em class=red>*function*</em> (outlet (outlet (curlet)))))
+			   (apply ,func clean-args))))))))))
+     (symbol-table))
+    (varlet all-let 'value val)
+    (<em class=red>openlet</em> all-let)))
+
+(define (call-any x)
+  (+ x 21))
+
+(call-any (probe-eval 42)) ; prints "(+ 42 21) ; call-any", returns 63
+</pre>
+<p>
+The second argument to *function* is the let from which to start searching for a function. 
+In the example above, we start the search from the let outside the bacro, since we hope to find the bacro's caller.
+As a convenience, *function* takes an optional third argument specifying what information you want 
+about the current function. An example: <code>(*function* (curlet) 'name)</code>.
+<code>name</code> returns the name (a symbol) of the current function.
+<code>line</code> returns the function's definition line number.
+<code>file</code> returns the function's definition file.
+Other possibilities are <code>signature</code>, <code>documentation</code>,
+<code>arity</code>, <code>arglist</code>, <code>value</code>, and <code>source</code>.
+<code>funclet</code> returns the current function's funclet.
+</p>
+
+</div>
+
+
+
+<div class="indented">
+
+<p>Schemes vary in their treatment of ().  s7 considers it a constant that evaluates to itself,
+so you don't need to quote it.  <code>(eq? () '())</code> is #t.
+This is consistent with, for example,
+<code>(eq? #f '#f)</code> which is also #t.
+The standard says "the empty list is a special object of its own type", so surely either choice is
+acceptable in that regard (but, sigh, the standard stupidly goes on to deny that () can evaluate to itself).
+(I'm told that "is an error" means "is not portable" in the standard's weasely abuse of English; if
+they mean "is not portable" why not say that?).
+Some of the confusion appears to be caused by the word "list".  I would describe the evaluator: "if it gets a
+constant (and () is a constant) it returns that constant; if a symbol, it returns the value
+associated with that symbol; if a pair, it looks at the pair's
+car to decide what to do".
+</p>
+
+<!--
+One place where the quote matters is in a case statement; the selector is
+evaluated but the key is not:
+</p>
+
+<pre class="indented">
+&gt; (case '() ((()) 2) (else 1)) ; in s7 this is the same as (case () ((()) 2) (else 1))
+<em class="gray">2</em>
+&gt; (case '() (('()) 2) (else 1)) ; (eqv? '() ''()) is #f
+<em class="gray">1</em>
+;;; which parallels #f (or a number such as 2 etc):
+&gt; (case '#f ((#f) 2) (else 1))
+<em class="gray">2</em>
+&gt; (case '#f (('#f) 2) (else 1)) ; (eqv? '#f ''#f) is #f
+<em class="gray">1</em>
+</pre>
+-->
+
+<p>Similarly, in s7, vector constants do not have to be quoted.  A list constant is quoted
+to keep it from being evaluated, but
+#(1 2 3) is as unproblematic as "123" or 123. 
+</p>
+
+<!-- there's another sense in which () is a constant: you can't apply it to anything. (() 0) -> error
+-->
+
+<p>These examples bring up another odd corner of scheme: else.  In <code>(cond (else 1))</code>
+the 'else is evaluated (like any cond test), so its value might be #f; in <code>(case 0 (else 1))</code>
+it is not evaluated (like any case key), so it's just a symbol.  
+Since setters are local in s7, 
+someone can <code>(let ((else #f)) (cond (else 1)))</code> even if we protect the rootlet 'else.
+Of course, in scheme this kind of trouble is pervasive, so rather than make 'else a constant
+I think the best path is to use unlet:
+<code>(let ((else #f)) (cond (#_else 1)))</code>.  This is 1 (not ()) because the initial value of 'else
+can't be changed.
+</p>
+</div>
+
+
+<div class="indented">
+<p id="quotediff">s7 treats <code>'&lt;datum&gt;</code> as <code>(#_quote &lt;datum&gt;)</code> which is not the same as the r7rs standard <code>(quote &lt;datum&gt;)</code>.
+The name 'quote' can be captured by the local context, whereas the function #_quote can't.  Apostrophe should be
+something that does not require you to worry about name capture; the form <code>'a</code> does not contain
+the name 'quote', so it is annoying that its result can be altered by redefining 'quote'.  Here are a few examples
+of the difference (I'm using guile because it is available on this machine):
+</p>
+<pre class="indented">
+(let (' 1) quote)                  ; guile 1, s7 error (#_quote is not a symbol)
+(let ((quote 32)) (length '(1 2))) ; guile error Wrong type to apply: 1, s7 2
+(let ((quote cos)) '0)             ; guile 1, s7 0
+(let ((quote -) (x 1)) 'x)         ; guile -1, s7 x
+(let ('(lambda (x) (+ x 1))) '1)   ; guile 2, s7 error (#_quote is not a symbol)
+((lambda 'x (+ 'x 1)) cos 0)       ; guile 2, s7 error (lambda parameter #_quote is a constant)
+(define-macro (m x) `(length ',x)) (let ((quote 32)) (m (1 2 3))) ; guile "wrong type to apply: 1", s7 3
+</pre>
+<p>
+Perhaps these simple examples will clarify s7's way of handling the apostrophe.
+</p>
+<pre class="indented">
+(syntax? #_quote) -> #t
+(syntax? 'quote) -> #f      ; the symbol quote 
+(equal? quote #_quote) -> #t
+(equal? 'quote quote) -> #f ; quote is not self-evaluating
+(equal? 'quote #_quote) -> #f
+(equal? '#f (quote #f)) -> #t
+</pre>
+</div>
+
+
+<div class="indented">
+
+<p>s7 handles circular lists and vectors and dotted lists with its customary aplomb.  
+You can pass them to memq, or print them, for example; you can even evaluate them.  
+The print syntax is borrowed from CL:
+</p>
+
+<pre class="indented">
+&gt; (let ((lst (list 1 2 3))) 
+    (set! (cdr (cdr (cdr lst))) lst) 
+    lst)
+<em class="gray">#1=(1 2 3 . #1#)</em>
+&gt; (let* ((x (cons 1 2)) 
+         (y (cons 3 x))) 
+    (list x y))
+<em class="gray">(#1=(1 . 2) (3 . #1#))</em>
+</pre>
+
+<p id="circularlistreader">
+But should this syntax be readable as well?  I'm inclined to say no because
+then it is part of the language, and it doesn't look like the rest of the language.
+(I think it's kind of ugly).  Perhaps we could implement it via *#readers*:
+</p>
+
+<pre>
+(define circular-list-reader
+  (let ((known-vals #f)
+	(top-n -1))
+    (lambda (str)
+
+      (define (replace-syms lst)
+	;; walk through the new list, replacing our special keywords 
+        ;;   with the associated locations
+
+	(define (replace-sym tree getter)
+	  (if (keyword? (getter tree))
+	      (let ((n (string-&gt;number (symbol-&gt;string (keyword-&gt;symbol (getter tree))))))
+		(if (integer? n)
+		    (let ((lst (assoc n known-vals)))
+		      (if lst
+			  (set! (getter tree) (cdr lst))
+			  (format *stderr* "#~D# is not defined~%" n)))))))
+
+	(let walk-tree ((tree (cdr lst)))
+	  (if (pair? tree)
+	      (begin
+		(if (pair? (car tree)) (walk-tree (car tree)) (replace-sym tree car))
+		(if (pair? (cdr tree)) (walk-tree (cdr tree)) (replace-sym tree cdr))))
+	  tree))
+
+      ;; str is whatever followed the #, first char is a digit
+      (let* ((len (length str))
+	     (last-char (str (- len 1))))
+	(and (memv last-char '(#\= #\#))             ; is it #n= or #n#?
+	    (let ((n (string-&gt;number (substring str 0 (- len 1)))))
+	      (and (integer? n)
+		  (begin
+		    (if (not known-vals)            ; save n so we know when we're done
+			(begin
+			  (set! known-vals ())
+			  (set! top-n n))) 
+
+		    (if (char=? last-char #\=)      ; #n=
+			(and (eqv? (peek-char) #\() ; eqv? since peek-char can return #&lt;eof&gt;
+			    (let ((cur-val (assoc n known-vals)))
+			      ;; associate the number and the list it points to
+			      ;;    if cur-val, perhaps complain? (#n# redefined)
+			      (let ((lst (catch #t 
+					   read
+					   (lambda args             ; a read error
+					     (set! known-vals #f)   ;   so clear our state
+					     (apply throw args))))) ;   and pass the error on up
+				(if cur-val
+                                    (set! (cdr cur-val) lst)
+				    (set! known-vals 
+					  (cons (set! cur-val (cons n lst)) known-vals))))
+
+			      (if (= n top-n)            ; replace our special keywords
+				  (let ((result (replace-syms cur-val)))
+				    (set! known-vals #f) ; '#1=(#+gsl #1#) -&gt; '(:1)!
+				    result)
+				  (cdr cur-val))))
+			                         ; #n=&lt;not a list&gt;?
+			;; else it's #n# &mdash; set a marker for now since we may not 
+			;;   have its associated value yet.  We use a symbol name that 
+                        ;;   string-&gt;number accepts.
+			(symbol-&gt;keyword 
+                          (symbol (number-&gt;string n) (string #\null) " "))))))
+		                                 ; #n&lt;not an integer&gt;?
+	    )))))                                ; #n&lt;something else&gt;?
+
+(do ((i 0 (+ i 1)))
+    ((= i 10))
+  ;; load up all the #n cases
+  (set! *#readers* 
+    (cons (cons (integer-&gt;char (+ i (char-&gt;integer #\0))) circular-list-reader)
+          *#readers*)))
+<!-- ) -->
+&gt; '#1=(1 2 . #1#)
+<em class="gray">#1=(1 2 . #1#)</em>
+&gt; '#1=(1 #2=(2 . #2#) . #1#)
+<em class="gray">#2=(1 #1=(2 . #1#) . #2#)</em>
+</pre>
+
+<p>And of course, we can treat these as labels:
+</p>
+
+<pre class="indented">
+(let ((ctr 0)) #1=(begin (format () "~D " ctr) (set! ctr (+ ctr 1)) (if (&lt; ctr 4) #1# (newline))))
+</pre>
+
+<p>which prints "0 1 2 3" and a newline.
+</p>
+
+<br>
+
+
+<p>Length returns +inf.0 if passed a circular list, and returns a negative
+number if passed a dotted list.  In the dotted case, the absolute value of the length is the list length not counting
+the final cdr.  <code>(define (circular? lst) (infinite? (length lst)))</code>.
+</p>
+
+<p>
+<em class=def id="cyclicsequences">cyclic-sequences</em> returns a list of the cyclic
+sequences in its argument, or nil.
+<code>(define (cyclic? obj) (pair? (cyclic-sequences obj)))</code>.
+</p>
+
+<p>Here's an amusing use of circular lists:
+</p>
+
+<pre class="indented">
+(define (for-each-permutation func vals)
+  ;; apply func to every permutation of vals: 
+  ;;   (for-each-permutation (lambda args (format () "~{~A~^ ~}~%" args)) '(1 2 3))
+  (define (pinner cur nvals len)
+    (if (= len 1)
+        (apply func (car nvals) cur)
+        (do ((i 0 (+ i 1)))                       ; I suppose a named let would be more Schemish
+            ((= i len))
+          (let ((start nvals))
+            (set! nvals (cdr nvals))
+            (let ((cur1 (cons (car nvals) cur)))  ; add (car nvals) to our arg list
+              (set! (cdr start) (cdr nvals))      ; splice out that element and 
+              (pinner cur1 (cdr start) (- len 1)) ;   pass a smaller circle on down, "wheels within wheels"
+              (set! (cdr start) nvals))))))       ; restore original circle
+  (let ((len (length vals)))
+    (set-cdr! (list-tail vals (- len 1)) vals)    ; make vals into a circle
+    (pinner () vals len)
+    (set-cdr! (list-tail vals (- len 1)) ())))    ; restore its original shape
+</pre>
+</div>
+
+
+<div id="weirdsymbols" class="indented">
+
+<p>s7 and Snd use "*" in a variable name, *features* for example, to indicate
+that the variable is predefined.  It may occur unprotected in a macro, for
+example.  The "*" doesn't mean that the variable is special in the CL sense of dynamic scope,
+but some clear marker is needed for a global variable so that the programmer
+doesn't accidentally step on it.  
+</p>
+
+<p>Although a variable name's first character is more restricted, currently
+only #\null, #\newline, #\tab, #\space, #\), #\(, #\", and #\; can't
+occur within the name.  I did not originally include double-quote in this set, so wild stuff like
+<code>(let ((nam""e 1)) nam""e)</code>
+would work, but that means that <code>'(1 ."hi")</code> is parsed as a 1 and the
+symbol <code>."hi"</code>, and <code>(string-set! x"hi")</code> is an error.
+The first character should not be #\#, #\', #\`, #\,, #\:, or any of those mentioned above,
+and some characters can't occur by themselves.  For example, "." is not a legal variable
+name, but ".." is. 
+These weird symbols have to be printed sometimes:
+</p>
+
+<pre class="indented">
+&gt; (list 1 (string-&gt;symbol (string #\; #\" #\\)) 2)
+<em class="gray">(1 ;"\ 2)</em>            <!-- " -->
+&gt; (list 1 (string-&gt;symbol (string #\.)) 2)
+<em class="gray">(1 . 2)</em>
+</pre>
+
+<p>which is a mess.  Guile prints the first as <code>(1 #{\;\"\\}# 2)</code>.
+In CL and some Schemes:
+</p>
+
+<pre class="indented">
+[1]&gt; (list 1 (intern (coerce (list #\; #\" #\\) 'string)) 2) ; thanks to Rob Warnock
+<em class="gray">(1 |;"\\| 2)</em>        <!-- " -->
+[2]&gt; (equalp 'A '|A|) ; in CL case matters here
+<em class="gray">T</em>
+</pre>
+
+<p>This is clean, and has the weight of tradition behind it, but 
+I think I'll use "symbol" instead:
+</p>
+
+<pre class="indented">
+&gt; (list 1 (string-&gt;symbol (string #\; #\" #\\)) 2)
+<em class="gray">(1 (symbol ";\"\\") 2)</em>       <!-- " -->
+</pre>
+
+<p>
+This output is readable, and does not eat up perfectly good
+characters like vertical bar, but it means we can't easily use
+variable names like "| e t c |".  We could allow a name to
+contain any characters if it starts and ends with "|",
+but then one vertical bar is trouble.  We can define a reader
+that turns <code>#symbol&lt;...&gt;</code> into <code>(symbol "...")</code>,
+making it possible to use odd names more widely:
+</p>
+
+<pre class="indented">
+(set! *#readers* 
+      (list (cons #\s 
+		  (lambda (str)
+		    (let ((len (length str)))
+		      (and (string=? (substring str 0 7) "symbol<")
+			   (if (char=? (str (- len 1)) #\&gt;) ; pointless use of #symbol!
+			       (symbol (substring str 7 (- len 1)))
+			       (do ((sym (substring str 7))
+				    (c (read-char) (read-char)))
+				   ((memq c (list #\&gt; #&lt;eof&gt;))
+				    (string-&gt;symbol sym))
+				 (set! sym (string-append sym (string c)))))))))))
+
+&gt; (let ((#symbol&lt;a b c&gt; 32)) (+ #symbol&lt;a b c&gt; 1))
+<em class="gray">33</em>
+</pre>
+
+<p>But there's a problem: if we try to call object-&gt;string with :readable
+on these symbol tokens, it does not know that we want it to use our "#symbol&lt;...&gt;"
+reader-macro.  We need to set the *s7* field <code>'symbol-printer</code>:
+</p>
+
+<pre class="indented">
+&gt; (define f (apply lambda (list () (list 'let (list (list (symbol "a b") 3)) (symbol "a b")))))
+<em class="gray">f</em>
+&gt; (f)
+<em class="gray">3</em>
+&gt; (object-&gt;string f :readable)
+<em class="gray">"(lambda () (let (((symbol \"a b\") 3)) (symbol \"a b\")))"</em> ; not actually readable!
+&gt; (set! (*s7* 'symbol-printer) (lambda (obj) (string-append "#symbol&lt;" (symbol-&gt;string obj) "&gt;")))
+<em class="gray">#&lt;lambda (obj)&gt;</em>
+&gt; (object-&gt;string f :readable)
+<em class="gray">"(lambda () (let ((#symbol&lt;a b&gt; 3)) #symbol&lt;a b&gt;))"</em>
+</pre>
+
+
+<p>
+The <code>symbol</code> function
+accepts any number of string arguments which it concatenates
+to form the new symbol name.
+</p>
+
+<p>
+These symbols are not just an optimization of string comparison:
+</p>
+
+<pre class="indented">
+&gt; (define-macro (hi a) 
+  (let ((funny-name (string-&gt;symbol ";")))
+    `(let ((,funny-name ,a)) (+ 1 ,funny-name))))
+<em class="gray">hi</em>
+&gt; (hi 2)
+<em class="gray">3</em>
+&gt; (macroexpand (hi 2))
+<em class="gray">(let ((; 2)) (+ 1 ;))</em>    ; for a good time, try (string #\")
+
+&gt; (define-macro (hi a) 
+  (let ((funny-name (string-&gt;symbol "| e t c |")))
+    `(let ((,funny-name ,a)) (+ 1 ,funny-name))))
+<em class="gray">hi</em>
+&gt; (hi 2)
+<em class="gray">3</em>
+&gt; (macroexpand (hi 2))
+<em class="gray">(let ((| e t c | 2)) (+ 1 | e t c |))</em>
+&gt; (let ((funny-name (string-&gt;symbol "| e t c |"))) ; now use it as a keyword arg to a function
+    (apply define* `((func (,funny-name 32)) (+ ,funny-name 1)))
+    ;; (procedure-source func) is (lambda* ((| e t c | 32)) (+ | e t c | 1))
+    (apply func (list (symbol-&gt;keyword funny-name) 2)))
+<em class="gray">3</em>
+</pre>
+
+<p>I hope that makes you as happy as it makes me!
+</p>
+</div>
+
+
+<div class="indented">
+
+<p id="legolambda">The built-in syntactic forms, such as "begin", are almost first-class citizens.
+</p>
+
+<pre class="indented">
+&gt; (let ((progn begin)) 
+    (progn 
+      (define x 1) 
+      (set! x 3) 
+      (+ x 4)))
+<em class="gray">7</em>
+&gt; (let ((function lambda)) 
+    ((function (a b) (list a b)) 3 4))
+<em class="gray">(3 4)</em>
+&gt; (apply begin '((define x 3) (+ x 2)))
+<em class="gray">5</em>
+&gt; ((lambda (n) (apply n '(((x 1)) (+ x 2)))) let)
+<em class="gray">3</em>
+
+(define-macro (symbol-set! var val) ; like CL's set
+  `(apply set! ,var ',val ()))      ; trailing nil is just to make apply happy &mdash; apply*?
+
+(define-macro (progv vars vals . body)
+ `(apply (apply lambda ,vars ',body) ,vals))
+
+&gt; (let ((s '(one two)) (v '(1 2))) (progv s v (+ one two)))
+<em class="gray">3</em>
+</pre>
+
+<p>We can snap together program fragments ("look Ma, no macros!"):
+</p>
+
+<pre class="indented">
+(let* ((x 3) 
+       (arg '(x)) 
+       (body `((+ ,x x 1)))) 
+  ((apply lambda arg body) 12)) ; "legolambda"?
+
+(define (engulph form)
+  (let ((body `(let ((L ()))
+		 (do ((i 0 (+ i 1)))
+		     ((= i 10) (reverse L))
+		   (set! L (cons ,form L))))))
+    (define function (apply lambda () (list (copy body))))
+    (function)))
+
+(let ()
+  (define (hi a) (+ a x))
+  ((apply let '((x 32)) (list (procedure-source hi))) 12)) ; one function, many closures?
+
+(let ((ctr -1))  ; (enum zero one two) but without using a macro
+  (apply begin 
+    (map (lambda (symbol) 
+           (set! ctr (+ ctr 1)) 
+           (list 'define symbol ctr)) ; e.g. '(define zero 0) 
+         '(zero one two)))
+  (+ zero one two))
+</pre>
+
+<p>But there's a prettier way to implement enum ("transparent-for-each"):
+</p>
+
+<pre class="indented">
+&gt; (define-macro (enum . args)
+    `(for-each define ',args (iota (length ',args))))
+<em class="gray">enum</em>
+&gt; (enum a b c) 
+<em class="gray">#&lt;unspecified&gt;</em>
+&gt; b
+<em class="gray">1</em>
+</pre>
+
+<p>Now we notice that <code>(case 0.0 ((0.0) 1) (else 0))</code> is 1, but
+how to get pi into a key list?
+</p>
+<pre class="indented">
+&gt; (apply case 'pi `(((,pi) 1) (else 0)))
+<em class="gray">1</em>
+&gt; (let ((lst '(1 2))) (apply case 'lst `(((,lst) 1) (else 0))))
+<em class="gray">1</em>         ; same trick puts a list in the keys
+&gt; (apply case '+nan.0 `(((,+nan.0) 1) (else 0)))
+<em class="gray">0</em>         ; (eqv? +nan.0 +nan.0) is #f
+</pre>
+
+<p><code>(apply define ...)</code> is similar to CL's set.
+</p>
+
+<pre class="indented">
+&gt; ((apply define-macro '((m a) `(+ 1 ,a))) 3)
+<em class="gray">4</em>
+&gt; ((apply define '((hi a) (+ a 1))) 3)
+<em class="gray">4</em>
+</pre>
+
+<p>Apply let is very similar to eval:
+</p>
+<pre>
+&gt; (apply let '((a 2) (b 3)) '((+ a b)))
+<em class="gray">5</em>
+&gt; (eval '(+ a b) (inlet 'a 2 'b 3))
+<em class="gray">5</em>
+&gt; ((apply lambda '(a b) '((+ a b))) 2 3)
+<em class="gray">5</em>
+&gt; (apply let '((a 2) (b 3)) '((list + a b))) ; a -&gt; 2, b -&gt; 3
+<em class="gray">(+ 2 3)</em>
+</pre>
+<p>The redundant-looking double lists are for apply's benefit.  We could
+use a trailing null instead (mimicking apply* in some ancient lisps):
+</p>
+<pre>
+&gt; (apply let '((a 2) (b 3)) '(list + a b) ())
+<em class="gray">(+ 2 3)</em>
+</pre>
+
+<p>Scheme claims that it evaluates the car of an expression, then calls the
+result with the rest of the expression.  So <code>((if x + -) y z)</code> calls either 
+<code>(+ y z)</code> or <code>(- y z)</code> depending on x.  
+But only s7, as far as I know, handles <code>((if x or and) y z)</code>.
+</p>
+
+<p>catch, dynamic-wind, and many of the other functions that take function
+arguments in standard Scheme, accept macros in s7, and dynamic-wind accepts
+#f as the initial and final entries.
+</p>
+
+<p>
+Currently, you can't set! a built-in syntactic keyword to some new value:
+<code>(set! if 3)</code>.
+let-temporarily uses set!, so <code>(let-temporarily ((if 3))...)</code>
+is also unlikely to work.
+</p>
+</div>
+
+
+<div class="indented">
+<p>Speaking of speed... It is widely believed
+that a Scheme with first class everything can't hope to compete with any
+"real" Scheme.  Humph I say.  Take this little example (which is not 
+so misleading that I feel guilty about it):
+</p>
+<pre class="indented">
+(define (do-loop n)
+  (do ((i 0 (+ i 1)))
+      ((= i n))
+    (if (zero? (modulo i 1000))
+	(display ".")))
+  (newline))
+
+(for-each do-loop (list 1000 1000000 10000000))
+</pre>
+
+<p>In s7, that takes 0.09 seconds on my home machine.  In tinyScheme, from
+whence we sprang, it takes 85 seconds.  In the chicken interpreter, 5.3
+seconds, and after compilation (using -O2) of the chicken compiler output,
+0.75 seconds.  So, s7 is comparable to chicken in speed, even though chicken
+is compiling to C. I think Guile 2.0.9 takes about 1 second.
+The equivalent in CL:
+clisp interpreted 9.3 seconds, compiled 0.85 seconds; sbcl 0.21 seconds.
+Similarly, s7 computes (fib 40) in 0.8 seconds, approximately the same as sbcl.
+Guile 2.2.3 takes 7 seconds.
+</p>
+
+<div class="small">
+<p>
+s7's timing tests are in its tools directory.  The script
+valcall.scm runs them through callgrind.  The results
+can be found at the end of s7.c.
+If you're interested in the standard Scheme benchmarks, it
+is possible to add s7 to that package.  First, s7-prelude.scm
+and s7-postlude.scm need to be added to the benchmarks src directory.
+s7-postlude.scm can be empty.  My version of s7-prelude.scm is:
+</p>
+<pre>
+(define (this-scheme-implementation-name) "s7")
+(define exact-integer? integer?)	
+(define (exact-integer-sqrt i) (let ((sq (floor (sqrt i)))) (values sq (- i (* sq sq)))))
+(define inexact exact-&gt;inexact)
+(define exact inexact-&gt;exact)
+(define (square x) (* x x))
+(define (vector-map f v) (copy v)) ; for quicksort.scm
+(define-macro (import . args) #f)
+(define (jiffies-per-second) 1000)
+(define (current-jiffy) (round (* (jiffies-per-second) (*s7* 'cpu-time))))
+(define (current-second) (floor (*s7* 'cpu-time)))
+(define make-bytevector make-byte-vector)
+(define bytevector-u8-set! byte-vector-set!)
+(set! (*s7* 'symbol-quote?) #t)
+</pre>
+<p>
+If you want to run gcbench, add the define-record-type macro from r7rs.scm.
+Here are the diffs for the bench script:
+</p>
+<pre>
+141a142
+&gt;     S7=${S7:-"/home/bil/motif-snd/repl"}
+187a189
+&gt;   s7               for s7
+406a409,421
+&gt; # Definitions specific to s7
+&gt; 
+&gt; s7_comp ()
+&gt; {
+&gt;     :
+&gt; }
+&gt; 
+&gt; s7_exec ()
+&gt; {
+&gt;     time ${S7} "$1" &lt; "$2"
+&gt; }
+&gt; 
+&gt; # -----------------------------------------------------------------------------
+940a957,966
+&gt; 
+&gt;         s7)    NAME='s7'
+&gt;                COMP=s7_comp
+&gt;                EXEC=s7_exec
+&gt;                COMPOPTS=""
+&gt;                EXTENSION="scm"
+&gt;                EXTENSIONCOMP="scm"
+&gt;                COMPCOMMANDS=""
+&gt;                EXECCOMMANDS=""
+&gt;                ;;
+</pre>
+<p>
+I call the standalone version of s7 "repl", so its path
+is /home/bil/motif-snd/repl.  To build repl, get s7.tar.gz
+from https://ccrma.stanford.edu/software/s7/s7.tar.gz;
+if not using gcc or clang, add the empty file mus-config.h to the tarball's contents,
+then (in Linux):
+</p>
+<pre>
+gcc s7.c -o repl -DWITH_MAIN -I. -O2 -g -ldl -lm -Wl,-export-dynamic
+;; tcc -o s7 s7.c -I. -lm -DWITH_MAIN -ldl -rdynamic -DWITH_C_LOADER
+</pre>
+<p>For timing tests, I add "-fomit-frame-pointer -funroll-loops -march=native".
+mus-config.h normally has 
+</p>
+<pre>
+#define HAVE_COMPLEX_NUMBERS 1
+#define HAVE_COMPLEX_TRIG 1
+</pre>
+<p>
+but s7.c has defaults, so mus-config.h can be empty, or absent.
+Finally, go back to the benchmarks directory and
+</p>
+<pre>
+bench s7 all
+</pre>
+
+<p>
+The benchmark compiler.scm assumes that small
+integers can be compared with eq? (via assq), which is incorrect.
+pi.scm and chudnovsky.scm need the gmp version of s7.
+As of 24-Oct-23, s7 treats '&lt;&gt; as (#_quote &lt;&gt;) so dynamic.scm doesn't run, and peval.scm gets the wrong result.
+I ran the bench script on an AMD 3950X machine, and got these results (in seconds):
+ack: 6.6, array1: 6.4, browse: 11.2, bv2string: 4.1, cat: 0.4,
+compiler: 16.9, conform: 30.0, cpstak: 42.8, ctak: 16.6, deriv: 9.7,
+destruc: 8.6, diviter: 3.7, divrec: 4.6, dynamic: 12.6, earley: 25.5,
+equal: 0.3, fft: 12.5, fib: 6.1, fibc: 8.6, fibfp: 1.1, gcbench: 12.9,
+graphs: 72.5, lattice: 63.4, matrix: 21.0, maze: 11.4, mazefun: 9.8,
+mbrot: 12.6, mbrotZ: 8.0, mperm: 18.9, nboyer: 20.1, nqueens: 27.0,
+ntakl: 8.0, nucleic: 8.3, paraffins: 4.4, parsing: 20.7, peval: 15.2,
+pnpoly: 9.8, primes: 10.2, puzzle: 10.2, quicksort: 40.0, ray: 8.3,
+read1: 0.2, sboyer: 19.1, scheme: 29.5, simplex: 26.9, slatex: 4.2,
+string: 0.3, sum1: 0.2, sum: 4.1, sumfp: 2.2, tail: 0.1, tak: 7.1,
+takl: 8.1, triangl: 16.4, wc: 4.9.  In the gmp case, chudnovsky: 0.017, pi: .01.
+</p>
+</div>
+</div>
+
+
+<div class="indented">
+
+<p>In s7, there is only one kind of begin statement,
+and it can contain both definitions and expressions.  These are evaluated in the order
+in which they occur, and in the environment at the point of the evaluation.  I think
+of it as being a little REPL.  begin does not introduce a new frame in
+the current environment, so defines happen in the enclosing environment.
+Finally, begin, explicit or otherwise, does not pretend to emulate letrec*.
+</p>
+
+<p>If we allow defines anywhere, the notion of "lexical scope" becomes problematic.
+Scheme is already a mess in that regard: take
+</p>
+
+<pre class="indented">
+(let ((x 1))
+  (do ((y x x)
+       (x 3))
+      ((> y 1) y)))
+</pre>
+
+<p>In <code>(y x x)</code> the first x is the outer one, and the second is the
+following do variable, so this returns 3!  But sticking to define, in
+</p>
+
+<pre class="indented">
+(let ((x 1))
+  (define y x)
+  (define x 2)
+  y)
+</pre>
+
+<p>s7 returns 1 even though technically the second x is in y's environment.
+Since we treat this as a REPL, y gets its value from the only x defined at
+the point it is defined.  However,
+</p>
+
+<pre class="indented">
+(let ((x 1))
+  (define y (lambda () x))
+  (define x 2)
+  (y))
+</pre>
+
+<p>returns 2 in s7 because the x in y's function body is not evaluated
+until after the second x is defined.  
+The define propagates backwards, but:
+<code>(list x (define x 0))</code>, or <code>(list x (begin (define x 0) x))</code>.
+</p>
+</div>
+
+
+<div class="indented">
+
+<p id="r7rs">The r7rs compatibility code is in r7rs.scm. I used to include it here, but
+as r7rs grew, this section got too large.  In general, all the conversion routines in
+r7rs are handled in s7 via generic functions, records are classes, and so on. 
+</p>
+</div>
+
+
+<div class="indented">
+
+<p>"Life", a poem.
+</p>
+
+<pre class="indented">
+(+(*(+))(*)(+(+)(+)(*)))
+(((((lambda () (lambda () (lambda () (lambda () 1))))))))
+(+ (((lambda () values)) 1 2 3))
+(map apply (list map) (list map) (list (list *)) '((((1 2)) ((3 4 5)))))
+(do ((do do do)) (do do do))
+(*(*)(*) (+)(+) 1)
+</pre>
+
+</div>
+
+</blockquote>
+<br><br>
+
+
+
+<div class="topheader" id="FFIexamples">FFI examples</div>
+
+<p>s7 exists only to serve as an extension of some other application, so
+it is primarily a foreign function interface.  s7.h has lots of comments about the individual
+functions.  Here I'll collect some complete examples.  s7.c depends on the following
+compile-time flags:
+</p>
+
+<pre class="indented">
+SIZEOF_VOID_P                  8 (default) or 4.
+WITH_GMP                       1 if you want multiprecision arithmetic (requires gmp, mpfr, and mpc, default is 0)
+HAVE_COMPLEX_NUMBERS           1 if your compiler supports complex numbers
+HAVE_COMPLEX_TRIG              1 if your math library has complex versions of the trig functions
+DISABLE_DEPRECATED             1 if you want to make sure you're not using any deprecated s7 stuff (default is 0)
+
+WITH_IMMUTATBLE_UNQUOTE        1 if you want "unquote" omitted (default is 0)
+WITH_EXTRA_EXPONENT_MARKERS    1 if you want "d", "f", "l", and "s" in addition to "e" as exponent markers (default is 0)
+                                   if someone defends these exponent markers, ask him to read 1l11+11l1i
+                                   (in 2 million lines of open-source Scheme, there is not one use of these silly things)
+WITH_SYSTEM_EXTRAS             1 if you want some additional OS-related functions built-in (default is 0)
+WITH_MAIN                      1 if you want s7.c to include a main program section that runs a REPL.
+WITH_C_LOADER		       1 if you want to be able to load shared object files with load.
+</pre>
+
+<p>See the comment at the start of s7.c for more information about these switches.
+s7.h defines the two main number types: s7_int and s7_double.
+The examples that follow show:
+</p>
+
+<ul>
+<li><a href="#repl">read-eval-print loop (and emacs)</a>
+<li><a href="#defun">define a function with arguments and a returned value, and define a variable </a>
+<li><a href="#defvar">call a Scheme function from C, and get/set Scheme variable values in C</a>
+<li><a href="#juce">C++ and Juce</a>
+<li><a href="#sndlib">load sndlib using the Xen functions and macros</a>
+<li><a href="#pwstype">add a new Scheme type and a procedure with a setter</a>
+<li><a href="#functionportexample">redirect display output to a C procedure</a>
+<li><a href="#extendop">extend a built-in operator ("+" in this case)</a>
+<li><a href="#definestar1">C-side define* (s7_define_function_star)</a>
+<li><a href="#definemacro1">C-side define-macro (s7_define_macro)</a>
+<li><a href="#definegeneric">define a generic function in C</a>
+<li><a href="#signal">signal handling (C-C to break out of an infinite loop)</a>
+<li><a href="#notify">notification in C that a Scheme variable has been set!</a>
+<li><a href="#namespace">Load C defined stuff into a separate namespace</a>
+<li><a href="#Cerrors">Error handling in C</a>
+<li><a href="#testhook">Hooks in C and Scheme</a>
+<li><a href="#dload">Load a C module dynamically</a>
+<li><a href="#gmpex">gmp and friends</a>
+<li><a href="#gdb">gdb</a>
+<li><a href="#webassembly">WASM</a>
+</ul>
+
+
+
+
+<div class="header" id="repl"><h4>A simple listener</h4></div>
+
+
+<div class="indented">
+<pre>
+#include &lt;stdlib.h&gt;
+#include &lt;stdio.h&gt;
+#include &lt;string.h&gt;
+#include "s7.h"
+
+int main(int argc, char **argv)
+{
+  s7_scheme *s7 = <em class=red>s7_init</em>();      /* initialize the interpreter */
+  while (1)                       /* fire up a read-eval-print loop */
+    {
+      char buffer[512];
+      fprintf(stdout, "\n&gt; ");    /* prompt for input */
+      fgets(buffer, 512, stdin);
+      if ((buffer[0] != '\n') || 
+	  (strlen(buffer) &gt; 1))
+	{                         /* evaluate the input and print the result */
+          char response[1024];
+	  snprintf(response, 1024, "(write %s)", buffer);
+	  <em class=red>s7_eval_c_string</em>(s7, response); 
+	}}
+}
+
+/* if not using gcc or clang, make mus-config.h (it can be empty), then
+ *
+ *   gcc -c s7.c -I.
+ *   gcc -o repl repl.c s7.o -lm -I. -ldl
+ *
+ * run it:
+ *
+ *    repl
+ *    &gt; (+ 1 2)
+ *    <em class="gray">3</em>
+ *    &gt; (define (add1 x) (+ 1 x))
+ *    <em class="gray">add1</em>
+ *    &gt; (add1 2)
+ *    <em class="gray">3</em>
+ *    &gt; (exit)
+ *
+ * for long-term happiness in linux use:
+ *   gcc -o repl repl.c s7.o -Wl,-export-dynamic -lm -I. -ldl
+ *   clang also needs -fPIC I think
+ * freebsd:
+ *   gcc -o repl repl.c s7.o -Wl,-export-dynamic -lm -I.
+ * osx:
+ *   gcc -o repl repl.c s7.o -lm -I.
+ * openbsd:
+ *   clang -o repl repl.c s7.o -I. -fPIC -Wl,-export-dynamic -lm
+ */
+</pre>
+</div>
+
+
+<p>Since this reads stdin and writes stdout, it can be run as a Scheme subjob of emacs.
+One (inconvenient) way to do this is to set the emacs variable scheme-program-name to
+the name of the exectuable created above ("repl"), then call the emacs function run-scheme:
+M-x eval-expression in emacs, followed by (setq scheme-program-name "repl"), then
+M-x run-scheme, and you're talking to s7 in emacs.  Of course, this connection can be
+customized indefinitely.  See, for example, inf-snd.el in the Snd package.
+</p>
+
+<p>Here are the not-always-built-in indentations I use in emacs:
+</p>
+<pre class="indented">
+(put 'with-let 'scheme-indent-function 1)
+(put 'with-baffle 'scheme-indent-function 0)
+(put 'with-sound 'scheme-indent-function 1)
+(put 'catch 'scheme-indent-function 1)
+(put 'lambda* 'scheme-indent-function 1)
+(put 'when 'scheme-indent-function 1)
+(put 'let-temporarily 'scheme-indent-function 1)
+(put 'let*-temporarily 'scheme-indent-function 1)
+(put 'call-with-input-string 'scheme-indent-function 1)
+(put 'unless 'scheme-indent-function 1)
+(put 'letrec* 'scheme-indent-function 1)
+(put 'sublet 'scheme-indent-function 1)
+(put 'varlet 'scheme-indent-function 1)
+(put 'case* 'scheme-indent-function 1)
+</pre>
+
+<p>To read stdin while working in a GUI-based program is trickier.  In glib, you can use
+something like this:
+</p>
+
+<blockquote>
+<div class="indented">
+<pre>
+static gboolean read_stdin(GIOChannel *source, GIOCondition condition, gpointer data)
+{
+  /* here read from g_io_channel_unix_get_fd(source) and call s7_eval_string */
+  return(true);
+}
+
+/* ... during initialization ... */
+
+GIOChannel *channel;
+channel = g_io_channel_unix_new(STDIN_FILENO);  /* watch stdin */
+stdin_id = g_io_add_watch_full(channel,         /* and call read_stdin above if input is noticed */
+			       G_PRIORITY_DEFAULT, 
+			       (GIOCondition)(G_IO_IN | G_IO_HUP | G_IO_ERR), 
+			       <em class=red>read_stdin</em>, NULL, NULL);
+g_io_channel_unref(channel);
+</pre></div>
+</blockquote>
+
+
+<p>Here's a version that uses libtecla for the line editor:
+</p>
+
+<blockquote>
+<div class="indented">
+<pre>
+#include &lt;stdlib.h&gt;
+#include &lt;stdio.h&gt;
+#include &lt;string.h&gt;
+#include &lt;libtecla.h&gt;
+#include "s7.h"
+
+int main(int argc, char **argv)
+{
+  GetLine *gl = new_GetLine(500, 5000); /* The tecla line editor */
+  s7_scheme *s7 = s7_init();  
+  while (1) 
+    {
+      char *buffer;
+      buffer = gl_get_line(gl, "&gt; ", NULL, 0);
+      if ((buffer[0] != '\n') || 
+	  (strlen(buffer) &gt; 1))
+	{                            
+          char response[1024];
+	  snprintf(response, 1024, "(write %s)", buffer);
+	  s7_eval_c_string(s7, response);
+	  fprintf(stdout, "\n");
+	}}
+  gl = del_GetLine(gl);
+}
+
+/* 
+ *   gcc -c s7.c -I. -O2 -g3
+ *   gcc -o ex1 ex1.c s7.o -lm -I. -ltecla -ldl
+ */
+</pre></div>
+</blockquote>
+
+
+<p>A repl (based on repl.scm or nrepl.scm) is built into s7.  Include the compiler flag -DWITH_MAIN:
+</p>
+
+<pre class="indented">
+gcc -o nrepl s7.c -O2 -I. -Wl,-export-dynamic -lm -ldl -DWITH_MAIN -DWITH_NOTCURSES -lnotcurses-core
+</pre>
+
+
+<p id="beginhook">
+Common Lisp has something called "evalhook" that makes it possible
+to insert your own function into the eval loop.  In s7, we have a "begin_hook" which sits at the opening of many begin blocks
+(implicit or explicit).  begin_hook is a (C) function; 
+if it sets its bool argument to true, 
+s7 interrupts the current evaluation. 
+Here is a version of the REPL in which begin_hook watches for C-g to interrupt
+some long computation:
+</p>
+
+<blockquote>
+<div class="indented">
+<pre>
+/* terminal-based REPL, 
+ *    an expansion of the <a href="#repl">read-eval-print loop</a> program above.
+ * type C-g to interrupt an evaluation.
+ */
+#include &lt;stdlib.h&gt;
+#include &lt;stdio.h&gt;
+#include &lt;string.h&gt;
+#include &lt;termios.h&gt;
+#include &lt;signal.h&gt;
+
+#include "s7.h"
+
+static struct termios save_buf, buf;
+
+static void sigcatch(int n)
+{
+  /* put things back the way they were */
+  tcsetattr(fileno(stdin), TCSAFLUSH, &amp;save_buf);
+  exit(0);
+}
+
+static char buffer[512];
+static int type_ahead_point = 0;
+
+static void <em class=red>watch_for_c_g</em>(s7_scheme *sc, bool *all_done)
+{
+  char c;
+  /* watch for C-g without blocking, save other chars as type-ahead */
+  tcsetattr(fileno(stdin), TCSAFLUSH, &amp;buf);
+  if (read(fileno(stdin), &amp;c, 1) == 1)
+    {
+      if (c == 7) /* C-g */
+	{
+	  *all_done = true;
+	  type_ahead_point = 0;
+	}
+      else buffer[type_ahead_point++] = c;
+    }
+  tcsetattr(fileno(stdin), TCSAFLUSH, &amp;save_buf);
+}
+
+int main(int argc, char **argv)
+{
+  s7_scheme *s7;
+  bool use_begin_hook = (tcgetattr(fileno(stdin), &amp;save_buf) &gt;= 0);
+  if (use_begin_hook)
+    {
+      buf = save_buf;
+      buf.c_lflag &amp;= ~ICANON;
+      buf.c_cc[VMIN] = 0;
+      buf.c_cc[VTIME] = 0;
+
+      signal(SIGINT, sigcatch);
+      signal(SIGQUIT, sigcatch);
+      signal(SIGTERM, sigcatch);
+    }
+  s7 = s7_init();  
+
+  if (argc == 2)
+    {
+      fprintf(stderr, "load %s\n", argv[1]);
+      if (!s7_load(s7, argv[1]))
+        fprintf(stderr, "can't find %s\n", argv[1]);
+    }
+  else
+    {
+      while (1) 
+	{
+	  fprintf(stdout, "\n&gt; ");
+	  fgets((char *)(buffer + type_ahead_point), 512 - type_ahead_point, stdin);
+	  type_ahead_point = 0;
+
+	  if ((buffer[0] != '\n') || 
+	      (strlen(buffer) &gt; 1))
+	    {                            
+              char response[1024];
+	      snprintf(response, 1024, "(write %s)", buffer);
+
+	      if (use_begin_hook)
+		<em class=red>s7_set_begin_hook</em>(s7, watch_for_c_g);
+	      s7_eval_c_string(s7, response);
+	      if (use_begin_hook)
+		<em class=red>s7_set_begin_hook</em>(s7, NULL);
+	    }}}
+  if (use_begin_hook)
+    tcsetattr(fileno(stdin), TCSAFLUSH, &amp;save_buf);
+}
+</pre></div>
+</blockquote>
+
+
+
+
+<div class="header" id="defun"><h4>Define a function with arguments and a returned value, and a variable</h4></div>
+
+
+<div class="indented">
+<pre>
+#include &lt;stdlib.h&gt;
+#include &lt;stdio.h&gt;
+#include &lt;string.h&gt;
+
+#include "s7.h"
+
+static s7_pointer add1(s7_scheme *sc, s7_pointer args)
+{
+  /* all added functions have this form, args is a list, 
+   *    s7_car(args) is the first arg, etc 
+   */
+  if (<em class=red>s7_is_integer</em>(s7_car(args)))
+    return(<em class=red>s7_make_integer</em>(sc, 1 + <em class=red>s7_integer</em>(s7_car(args))));
+  return(s7_wrong_type_arg_error(sc, "add1", 1, s7_car(args), "an integer"));
+}
+
+int main(int argc, char **argv)
+{
+  s7_scheme *s7 = s7_init();
+  s7_define_function(s7, "add1", add1, 1, 0, false, "(add1 int) adds 1 to int");
+                                      /* add the function "add1" to the interpreter.
+                                       *   1, 0, false -&gt; one required arg,
+				       *                  no optional args,
+				       *                  no "rest" arg
+				       */
+ <em class=red>s7_define_variable</em>(s7, "my-pi", <em class=red>s7_make_real</em>(s7, 3.14159265));
+
+  while (1)                           /* fire up a "repl" */
+    {
+      char buffer[512];
+      fprintf(stdout, "\n&gt; ");        /* prompt for input */
+      fgets(buffer, 512, stdin);
+      if ((buffer[0] != '\n') || 
+	  (strlen(buffer) &gt; 1))
+	{                            
+          char response[1024];
+	  snprintf(response, 1024, "(write %s)", buffer);
+	  s7_eval_c_string(s7, response); /* evaluate input and write the result */
+	}}
+}
+
+/*    doc7
+ *    &gt; my-pi
+ *    <em class="gray">3.14159265</em>
+ *    &gt; (+ 1 (add1 1))
+ *    <em class="gray">3</em>
+ *    &gt; (exit)
+ */
+</pre></div>
+
+
+
+
+<div class="header" id="defvar"><h4>Call a Scheme-defined function from C, and get/set Scheme variable values in C</h4></div>
+
+
+<div class="indented">
+<pre>
+#include &lt;stdlib.h&gt;
+#include &lt;stdio.h&gt;
+#include &lt;string.h&gt;
+
+#include "s7.h"
+
+int main(int argc, char **argv)
+{
+  s7_scheme *s7 = s7_init();
+
+  s7_define_variable(s7, "an-integer", s7_make_integer(s7, 1));
+  s7_eval_c_string(s7, "(define (add1 a) (+ a 1))");
+  
+  fprintf(stderr, "an-integer: %lld\n", 
+	  s7_integer(<em class=red>s7_name_to_value</em>(s7, "an-integer")));
+
+  <em class=red>s7_symbol_set_value</em>(s7, <em class=red>s7_make_symbol</em>(s7, "an-integer"), s7_make_integer(s7, 32));
+
+  fprintf(stderr, "now an-integer: %lld\n", 
+	  s7_integer(<em class=red>s7_name_to_value</em>(s7, "an-integer")));
+
+  fprintf(stderr, "(add1 2): %lld\n", 
+	  s7_integer(<em class=red>s7_call</em>(s7, 
+			     s7_name_to_value(s7, "add1"), 
+			     s7_cons(s7, s7_make_integer(s7, 2), s7_nil(s7)))));
+}
+
+/*
+ *    doc7
+ *    an-integer: 1
+ *    now an-integer: 32
+ *    (add1 2): 3
+ */
+</pre>
+
+<p>In more complicated cases, it is probably easier use s7_eval_c_string_with_environment.
+As an example, say we want to have a C procedure that calls the pretty printer function pp
+in write.scm, returning a string to C.  We need to make sure pp is loaded, and catch
+any errors that come up.  And we need to pass the C-level s7 object to pp.  So...
+</p>
+<pre>
+static const char *pp(s7_scheme *sc, s7_pointer obj) /* (pp obj) */
+{
+  return(s7_string(
+          <em class=red>s7_eval_c_string_with_environment</em>(sc,
+            "(catch #t                         \
+               (lambda ()                      \
+                 (unless (defined? 'pp)        \
+                   (load \"write.scm\"))       \
+                 (<em class=red>pp</em> obj))                     \
+               (lambda (type info)             \
+                 (apply format #f info)))",
+	   <em class=red>s7_inlet</em>(sc, s7_list(sc, 1, s7_cons(sc, s7_make_symbol(sc, "obj"), obj))))));
+}
+</pre>
+<p>and now when we want a pretty-printed representation of something: pp(sc, obj);
+The s7_inlet call is creating a local environment with the object "obj" bound
+in scheme to the name "obj" so that (pp obj) will find the "obj" that actually
+lives in C.  You may need to give the full filename for write.scm, or add its path
+to the <a href="#loadpath">load-path list</a>.  In the latter case, <code>(require write.scm)</code> could
+replace <code>(unless (defined?...))</code>.
+</p>
+</div>
+
+
+
+<div class="header" id="juce"><h4>C++ and Juce, from Rick Taube</h4></div>
+
+
+<div class="indented">
+<pre>
+int main(int argc, const char* argv[]) 
+{ 
+  initialiseJuce_NonGUI(); 
+
+  s7_scheme *s7 = s7_init(); 
+  if (!s7) 
+    { 
+      std::cout &lt;&lt;  "Can't start S7!\n"; 
+      return -1; 
+    } 
+
+  while (true) 
+    { 
+      s7_pointer val; 
+      std::string str; 
+      std::cout &lt;&lt; "\ns7&gt; "; 
+      std::getline(std::cin, str); 
+      val = s7_eval_c_string(s7, str.c_str()); 
+      std::cout &lt;&lt; s7_object_to_c_string(s7, val); 
+    } 
+
+  free(s7); 
+  std::cout &lt;&lt; "Bye!\n"; 
+  return 0; 
+} 
+</pre></div>
+
+
+
+
+
+<div class="header" id="sndlib"><h4>Load sndlib into an s7 repl</h4></div>
+
+
+<div class="indented">
+<pre>
+#include &lt;stdlib.h&gt;
+#include &lt;stdio.h&gt;
+#include &lt;string.h&gt;
+#include &lt;unistd.h&gt;
+
+/* assume we've configured and built sndlib, so it has created a mus-config.h file.
+ * also assume we've built s7 with WITH_SYSTEM_EXTRAS set, so we have file-exists? and delete-file
+ */
+
+#include "mus-config.h"
+#include "s7.h"
+#include "xen.h"
+#include "clm.h"
+#include "clm2xen.h"
+
+/* we need to redirect clm's mus_error calls to s7_error */
+
+static void mus_error_to_s7(int type, char *msg)
+{
+  s7_error(s7,                               /* s7 is declared in xen.h, defined in xen.c */
+	   s7_make_symbol(s7, "mus-error"),
+	   s7_cons(s7, s7_make_string(s7, msg), s7_nil(s7)));
+}
+
+int main(int argc, char **argv)
+{
+  s7 = s7_init();                     /* initialize the interpreter */
+  s7_xen_initialize(s7);              /* initialize the xen stuff (hooks and the xen s7 FFI used by sndlib) */
+  Init_sndlib();                      /* initialize sndlib with all the functions linked into s7 */  
+
+  mus_error_set_handler(mus_error_to_s7); /* catch low-level errors and pass them to s7-error */
+
+  while (1)                           /* fire up a "repl" */
+    {
+      char buffer[512];
+      fprintf(stdout, "\n&gt; ");        /* prompt for input */
+      fgets(buffer, 512, stdin);
+      if ((buffer[0] != '\n') || 
+	  (strlen(buffer) &gt; 1))
+	{                            
+          char response[1024];
+	  snprintf(response, 1024, "(write %s)", buffer);
+	  s7_eval_c_string(s7, response); /* evaluate input and write the result */
+	}}
+}
+
+/* gcc -o doc7 doc7.c -lm -I. /usr/local/lib/libsndlib.a -lasound -ldl
+ *
+ *   (load "sndlib-ws.scm")
+ *   (with-sound () (outa 10 .1))
+ *   (load "v.scm")
+ *   (with-sound () (fm-violin 0 .1 440 .1))
+ *
+ * you might also need -lgsl -lgslcblas -lfftw3
+ */
+</pre>
+</div>
+
+<p>If you built libsndlib.so, it is possible to use it directly in the s7 repl:
+</p>
+<pre>
+repl          ; this is a bare s7 running repl.scm via -DWITH_MAIN=1
+loading libc_s7.so
+&gt; (load "/home/bil/test/sndlib/libsndlib.so" (inlet 'init_func 's7_init_sndlib))
+#t            ; s7_init_sndlib ties all the sndlib functions and variables into s7
+&gt; (load "sndlib-ws.scm")
+tmpnam
+&gt; (set! *clm-player* (lambda (file) (system (format #f "sndplay ~A" file))))
+&gt; (load "v.scm")
+fm-violin
+&gt; (with-sound (:play #t) (fm-violin 0 1 440 .1))
+"test.snd"
+</pre>
+
+<p>You can use autoload to load libsndlib when needed:
+</p>
+
+<pre class="indented">
+(define (find-library name)
+  (if (or (file-exists? name)
+	  (char=? (name 0) #\/))
+      name
+      (call-with-exit
+       (lambda (return)
+	 (for-each
+	  (lambda (path)
+	    (let ((new-name (string-append path "/" name)))
+	      (if (file-exists? new-name)
+		  (return new-name))))
+	  *load-path*)
+	 (let ((libs (getenv "LD_LIBRARY_PATH")) ; colon separated directory names
+	       (start 0))
+	   (do ((colon (char-position #\: libs) (char-position #\: libs start)))
+	       ((or (not colon)
+		    (let ((new-name (string-append (substring libs start colon) "/" name)))
+		      (and (file-exists? new-name)
+			   (return new-name)))))
+	     (set! start (+ colon 1))))
+	 name))))
+
+(<em class=red>autoload</em> 'clm 
+  (lambda (e)
+    (load (find-library "libsndlib.so") (inlet '(init_func . s7_init_sndlib)))
+    (set! *features* (cons 'clm *features*))
+    (with-let (rootlet) (define clm #t))
+    (load "sndlib-ws.scm")
+    (set! *clm-player* (lambda (file) (system (format #f "sndplay ~A" file))))))
+</pre>
+
+<p>and use the repl's vt100 stuff to (for example) post the current begin time
+as a note list computes:
+</p>
+
+<pre class="indented">
+(define (clm-notehook . args)
+  ;; assume second arg is begin time (first is instrument name)
+  (when (and (pair? args) 
+	     (pair? (cdr args)) 
+	     (number? (cadr args)))
+    (with-let (sublet (*repl* 'repl-let) :begin-time (cadr args))
+      (let ((coords (cursor-coords))
+	    (col (floor (/ last-col 2))))
+	(let ((str (number-&gt;string begin-time)))
+	  (format *stderr* "~C[~D;~DH" #\escape prompt-row col)
+	  (format *stderr* "~C[K~A"  #\escape (if (&gt; (length str) col) (substring str 0 (- col 1)) str)))
+	(format *stderr* "~C[~D;~DH"   #\escape (cdr coords) (car coords))))))
+
+(set! *clm-notehook* clm-notehook)
+</pre>
+
+
+
+
+
+<div class="header" id="pwstype"><h4>Add a new Scheme type and a procedure with a setter</h4></div>
+
+
+<div class="indented">
+<pre>
+#include &lt;stdlib.h&gt;
+#include &lt;stdio.h&gt;
+#include &lt;string.h&gt;
+
+#include "s7.h"
+
+/* define *listener-prompt* in scheme, add two accessors for C get/set */
+
+static const char *listener_prompt(s7_scheme *sc)
+{
+  return(s7_string(s7_name_to_value(sc, "*listener-prompt*")));
+}
+
+static void set_listener_prompt(s7_scheme *sc, const char *new_prompt)
+{
+  s7_symbol_set_value(sc, s7_make_symbol(sc, "*listener-prompt*"), s7_make_string(sc, new_prompt));
+}
+
+/* now add a new type, a struct named "dax" with two fields, a real "x" and a list "data" */
+/*   since the data field is an s7 object, we'll need to mark it to protect it from the GC */
+
+typedef struct {
+  s7_double x;
+  s7_pointer data;
+} dax;
+
+static int dax_type_tag = 0;
+
+static s7_pointer dax_to_string(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer result;
+  dax *o = (dax *)s7_c_object_value(s7_car(args));
+  char *data_str = s7_object_to_c_string(sc, o-&gt;data);
+  int data_str_len = strlen(data_str);
+  char *str = (char *)calloc(data_str_len + 32, sizeof(char));
+  snprintf(str, data_str_len + 32, "&lt;dax %.3f %s&gt;", o-&gt;x, data_str);
+  free(data_str);
+  result = s7_make_string(sc, str);
+  free(str);
+  return(result);
+}
+
+static s7_pointer free_dax(s7_scheme *sc, s7_pointer obj)
+{
+  free(s7_c_object_value(obj));
+  return(NULL);
+}
+
+static s7_pointer mark_dax(s7_scheme *sc, s7_pointer obj)
+{
+  dax *o = (dax *)s7_c_object_value(obj);
+  s7_mark(o-&gt;data);
+  return(NULL);
+}
+
+static s7_pointer make_dax(s7_scheme *sc, s7_pointer args)
+{
+  dax *o = (dax *)malloc(sizeof(dax));
+  o-&gt;x = s7_real(s7_car(args));
+  if (s7_cdr(args) != s7_nil(sc))
+    o-&gt;data = s7_cadr(args);
+  else o-&gt;data = s7_nil(sc);
+  return(<em class=red>s7_make_c_object</em>(sc, dax_type_tag, (void *)o));
+}
+
+static s7_pointer is_dax(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_boolean(sc, 
+			 <em class=red>s7_is_c_object</em>(s7_car(args)) &amp;&amp;
+			 <em class=red>s7_c_object_type</em>(s7_car(args)) == dax_type_tag));
+}
+
+static s7_pointer dax_x(s7_scheme *sc, s7_pointer args)
+{
+  dax *o = (dax *)<em class=red>s7_c_object_value</em>(s7_car(args));
+  return(s7_make_real(sc, o-&gt;x));
+}
+
+static s7_pointer set_dax_x(s7_scheme *sc, s7_pointer args)
+{
+  dax *o = (dax *)s7_c_object_value(s7_car(args));
+  o-&gt;x = s7_real(s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer dax_data(s7_scheme *sc, s7_pointer args)
+{
+  dax *o = (dax *)s7_c_object_value(s7_car(args));
+  return(o-&gt;data);
+}
+
+static s7_pointer set_dax_data(s7_scheme *sc, s7_pointer args)
+{
+  dax *o = (dax *)s7_c_object_value(s7_car(args));
+  o-&gt;data = s7_cadr(args);
+  return(o-&gt;data);
+}
+
+static s7_pointer dax_is_equal(s7_scheme *sc, s7_pointer args) 
+{
+  dax *d1, *d2;
+  s7_pointer p1 = s7_car(args);
+  s7_pointer p2 = s7_cadr(args);
+  if (p1 == p2) 
+    return(s7_t(sc));
+  if ((!s7_is_c_object(p2)) ||
+      (s7_c_object_type(p2) != dax_type_tag))
+    return(s7_f(sc));
+  d1 = (dax *)s7_c_object_value(p1);
+  d2 = (dax *)s7_c_object_value(p2);
+  return(s7_make_boolean(sc,
+			 (d1-&gt;x == d2-&gt;x) &amp;&amp;
+			 (s7_is_equal(sc, d1-&gt;data, d2-&gt;data))));
+}
+
+int main(int argc, char **argv)
+{
+  s7_scheme *s7 = s7_init();
+  s7_define_variable(s7, "*listener-prompt*", s7_make_string(s7, "&gt;"));
+
+  dax_type_tag = <em class=red>s7_make_c_type</em>(s7, "dax");
+  s7_c_type_set_gc_free(s7, dax_type_tag, free_dax);
+  s7_c_type_set_gc_mark(s7, dax_type_tag, mark_dax);
+  s7_c_type_set_is_equal(s7, dax_type_tag, dax_is_equal);
+  s7_c_type_set_to_string(s7, dax_type_tag, dax_to_string);
+  
+  s7_define_function(s7, "make-dax", make_dax, 2, 0, false, "(make-dax x data) makes a new dax");
+  s7_define_function(s7, "dax?", is_dax, 1, 0, false, "(dax? anything) returns #t if its argument is a dax object");
+
+  s7_define_variable(s7, "dax-x", 
+                     <em class=red>s7_dilambda</em>(s7, "dax-x", dax_x, 1, 0, set_dax_x, 2, 0, "dax x field"));
+
+  s7_define_variable(s7, "dax-data", 
+                     <em class=red>s7_dilambda</em>(s7, "dax-data", dax_data, 1, 0, set_dax_data, 2, 0, "dax data field"));
+
+  while (1)
+    {
+      char buffer[512];
+      fprintf(stdout, "\n%s ", listener_prompt(s7));
+      fgets(buffer, 512, stdin);
+      if ((buffer[0] != '\n') || 
+	  (strlen(buffer) &gt; 1))
+	{                            
+          char response[1024];
+	  snprintf(response, 1024, "(write %s)", buffer);
+	  s7_eval_c_string(s7, response); /* evaluate input and write the result */
+	}}
+}
+
+/* (in Linux);
+ *    gcc dax.c -o dax -I. -O2 -g s7.o -ldl -lm -Wl,-export-dynamic -Wno-stringop-overflow
+ *    dax
+ *    &gt; *listener-prompt*
+ *    <em class="gray">"&gt;"</em>
+ *    &gt; (set! *listener-prompt* ":")
+ *    <em class="gray">":"</em>
+ *    : (define obj (make-dax 1.0 (list 1 2 3)))
+ *    <em class="gray">obj</em>
+ *    : obj
+ *    <em class="gray">#&lt;dax 1.000 (1 2 3)&gt;</em>
+ *    : (dax-x obj)
+ *    <em class="gray">1.0</em>
+ *    : (dax-data obj)
+ *    <em class="gray">(1 2 3)</em>
+ *    : (set! (dax-x obj) 123.0)
+ *    <em class="gray">123.0</em>
+ *    : obj
+ *    <em class="gray">#&lt;dax 123.000 (1 2 3)&gt;</em>
+ *    : (dax? obj)
+ *    <em class="gray">#t</em>
+ *    : (exit)
+ */
+</pre></div>
+
+
+
+
+
+<div class="header" id="functionportexample"><h4>Redirect output (and input) to a C procedure</h4></div>
+
+
+<div class="indented">
+<pre>
+#include &lt;stdlib.h&gt;
+#include &lt;stdio.h&gt;
+#include &lt;string.h&gt;
+
+#include "s7.h"
+
+static void my_print(s7_scheme *sc, uint8_t c, s7_pointer port)
+{
+  fprintf(stderr, "[%c] ", c);
+}
+
+static s7_pointer my_read(s7_scheme *sc, s7_read_t peek, s7_pointer port)
+{
+  return(<em class=red>s7_make_character</em>(sc, fgetc(stdin)));
+}
+
+int main(int argc, char **argv)
+{
+  s7_scheme *s7 = s7_init();  
+
+  <em class=red>s7_set_current_output_port</em>(s7, <em class=red>s7_open_output_function</em>(s7, my_print));
+  s7_define_variable(s7, "io-port", <em class=red>s7_open_input_function</em>(s7, my_read));
+
+  while (1) 
+    {
+      char buffer[512];
+      fprintf(stdout, "\n&gt; ");
+      fgets(buffer, 512, stdin);
+      if ((buffer[0] != '\n') || 
+	  (strlen(buffer) &gt; 1))
+	{                            
+          char response[1024];
+	  snprintf(response, 1024, "(write %s)", buffer);
+	  s7_eval_c_string(s7, response);
+	}}
+}
+
+/* 
+ *    &gt; (+ 1 2)
+ *    <em class="gray">[3]</em>
+ *    &gt; (display "hiho")
+ *    <em class="gray">[h] [i] [h] [o] [#] [&lt;] [u] [n] [s] [p] [e] [c] [i] [f] [i] [e] [d] [&gt;] </em>
+ *    &gt; (define (add1 x) (+ 1 x))
+ *    <em class="gray">[a] [d] [d] [1] </em>
+ *    &gt; (add1 123)
+ *    <em class="gray">[1] [2] [4] </em>
+ *    &gt; (read-char io-port)
+ *    a                             ; here I typed "a" in the shell
+ *    <em class="gray">[#] [\] [a] </em>
+ */
+</pre>
+</div>
+
+<p>In Snd, we want debug.scm (*debug-port*) output to go to the Snd listener text widget.  The Snd function listener_append
+adds a string to that widget's text, so we define:
+</p>
+<pre class="indented">
+static void (listener_write)(s7_scheme *sc, uint8_t c, s7_pointer port)
+{
+  char buf[2];
+  buf[0] = c;
+  buf[1] = '\0';
+  listener_append(buf);
+}
+</pre>
+<p>
+Then we define a Scheme-side variable, *listener-port*, to be a function port:
+</p>
+<pre class="indented">
+s7_define_variable_with_documentation(s7, "*listener-port*", 
+  s7_open_output_function(s7, listener_write), "port to write to Snd's listener");
+</pre>
+<p>
+And tie it into *debug-port* via
+<code>(set! ((funclet trace-in) '*debug-port*) *listener-port*)</code>.
+</p>
+
+
+
+
+<div class="header" id="extendop"><h4>Extend a built-in operator ("+" in this case)</h4></div>
+
+<p>There are several ways to do this.  In the first example, we save the original function,
+and replace it with ours, calling the original whenever possible:
+</p>
+
+<div class="indented">
+<pre>
+#include &lt;stdlib.h&gt;
+#include &lt;stdio.h&gt;
+#include &lt;string.h&gt;
+
+#include "s7.h"
+
+static s7_pointer old_add;           /* the original "+" function for non-string cases */
+static s7_pointer old_string_append; /* same, for "string-append" */
+
+static s7_pointer our_add(s7_scheme *sc, s7_pointer args)
+{
+  /* this will replace the built-in "+" operator, extending it to include strings:
+   *   (+ "hi" "ho") -&gt; "hiho" and  (+ 3 4) -&gt; 7
+   */
+  if ((s7_is_pair(args)) &amp;&amp;
+      (s7_is_string(s7_car(args))))
+    return(<em class=red>s7_apply_function</em>(sc, old_string_append, args));
+  return(s7_apply_function(sc, old_add, args));
+}
+
+int main(int argc, char **argv)
+{
+  s7_scheme *s7 = s7_init();
+
+  /* get built-in + and string-append */
+  old_add = s7_name_to_value(s7, "+");      
+  old_string_append = s7_name_to_value(s7, "string-append");
+
+  /* redefine "+" */
+  s7_define_function(s7, "+", our_add, 0, 0, true, "(+ ...) adds or appends its arguments");
+
+  while (1)
+    {
+      char buffer[512];
+      fprintf(stdout, "\n&gt; ");
+      fgets(buffer, 512, stdin);
+      if ((buffer[0] != '\n') || 
+	  (strlen(buffer) &gt; 1))
+	{                            
+          char response[1024];
+	  snprintf(response, 1024, "(write %s)", buffer);
+	  s7_eval_c_string(s7, response);
+	}}
+}
+
+/*    &gt; (+ 1 2)
+ *    <em class="gray">3</em>
+ *    &gt; (+ "hi" "ho")
+ *    <em class="gray">"hiho"</em>
+ */
+</pre></div>
+
+<p>In the next example, we use the method (inlet) machinery:
+</p>
+
+<div class="indented">
+<pre>
+#include &lt;stdlib.h&gt;
+#include &lt;stdio.h&gt;
+#include &lt;string.h&gt;
+#include &lt;math.h&gt;
+
+#include "s7.h"
+
+static s7_pointer our_abs(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer x = s7_car(args);
+  if (!s7_is_number(x))
+    {
+      s7_pointer method = <em class=red>s7_method</em>(sc, x, s7_make_symbol(sc, "abs"));
+      if (method == s7_undefined(sc))                       /* no method found, so raise an error */
+	s7_wrong_type_arg_error(sc, "abs", 1, x, "a real"); 
+      return(s7_apply_function(sc, method, args));          /*   else apply the method to the args */
+    }
+  return(s7_make_real(sc, (s7_double)fabs(s7_number_to_real(sc, x))));
+}
+
+int main(int argc, char **argv)
+{
+  s7_scheme *s7 = s7_init();
+  s7_define_function(s7, "our-abs", our_abs, 1, 0, false, "abs replacement");
+
+  while (1)
+    {
+      char buffer[512];
+      fprintf(stdout, "\n&gt; ");
+      fgets(buffer, 512, stdin);
+      if ((buffer[0] != '\n') || 
+	  (strlen(buffer) &gt; 1))
+	{                            
+          char response[1024];
+	  snprintf(response, 1024, "(write %s)", buffer);
+	  s7_eval_c_string(s7, response);
+	}}
+}
+
+/*    &gt; (our-abs -1)
+ *    <em class="gray">1.0</em>
+ *    &gt; (our-abs (openlet (inlet 'value -3.0 'abs (lambda (x) (abs (x 'value))))))
+ *    <em class="gray">3.0</em>
+ */
+
+</pre>
+</div>
+
+
+
+<div class="header" id="definestar1"><h4>C-side define* (s7_define_function_star)</h4></div>
+
+
+<div class="indented">
+<pre>
+#include &lt;stdlib.h&gt;
+#include &lt;stdio.h&gt;
+#include &lt;string.h&gt;
+
+#include "s7.h"
+
+static s7_pointer plus(s7_scheme *sc, s7_pointer args)
+{
+  /* (define* (plus (red 32) blue) (+ (* 2 red) blue)) */
+  return(s7_make_integer(sc, 2 * s7_integer(s7_car(args)) + s7_integer(s7_cadr(args))));
+}
+
+int main(int argc, char **argv)
+{
+  s7_scheme *s7 = s7_init();
+  <em class=red>s7_define_function_star</em>(s7, "plus", plus, "(red 32) blue", "an example of define* from C");
+
+  while (1)
+    {
+      char buffer[512];
+      fprintf(stdout, "\n&gt; ");
+      fgets(buffer, 512, stdin);
+      if ((buffer[0] != '\n') || 
+	  (strlen(buffer) &gt; 1))
+	{                            
+          char response[1024];
+	  snprintf(response, 1024, "(write %s)", buffer);
+	  s7_eval_c_string(s7, response);
+	}}
+}
+
+/* 
+ *    &gt; (plus 2 3)
+ *    <em class="gray">7</em>
+ *    &gt; (plus :blue 3)
+ *    <em class="gray">67</em>
+ *    &gt; (plus :blue 1 :red 4)
+ *    <em class="gray">9</em>
+ *    &gt; (plus 2 :blue 3)
+ *    <em class="gray">7</em>
+ *    &gt; (plus :blue 3 :red 1)
+ *    <em class="gray">5</em>
+ */
+</pre></div>
+
+
+
+
+
+<div class="header" id="definemacro1"><h4>C-side define-macro (s7_define_macro)</h4></div>
+
+
+<div class="indented">
+<pre>
+#include &lt;stdlib.h&gt;
+#include &lt;stdio.h&gt;
+#include &lt;string.h&gt;
+
+#include "s7.h"
+
+static s7_pointer plus(s7_scheme *sc, s7_pointer args)
+{
+  /* (define-macro (plus a b) `(+ ,a ,b)) */
+  s7_pointer a = s7_car(args);
+  s7_pointer b = s7_cadr(args);
+  return(s7_list(sc, 3, s7_make_symbol(sc, "+"),  a, b));
+}
+
+int main(int argc, char **argv)
+{
+  s7_scheme *s7 = s7_init();
+  <em class=red>s7_define_macro</em>(s7, "plus", plus, 2, 0, false, "plus adds its two arguments");
+
+  while (1)
+    {
+      char buffer[512];
+      fprintf(stdout, "\n&gt; ");
+      fgets(buffer, 512, stdin);
+      if ((buffer[0] != '\n') || 
+	  (strlen(buffer) &gt; 1))
+	{                            
+          char response[1024];
+	  snprintf(response, 1024, "(write %s)", buffer);
+	  s7_eval_c_string(s7, response);
+	}}
+}
+
+/* 
+ *    &gt; (plus 2 3)
+ *    <em class="gray">5</em>
+ */
+</pre></div>
+
+
+
+<div class="header" id="definegeneric"><h4>define a generic function in C</h4></div>
+
+<p>In scheme, a function becomes generic simply by <code>(apply ((car args) 'func) args)</code>.
+To accomplish the same thing in C, we use s7_method and s7_apply_function:
+</p>
+
+<div class="indented">
+<pre>
+#include &lt;stdlib.h&gt;
+#include &lt;stdio.h&gt;
+#include &lt;string.h&gt;
+
+#include "s7.h"
+
+static s7_pointer plus(s7_scheme *sc, s7_pointer args)
+{
+  #define plus_help "(plus obj ...) applies obj's plus method to obj and any trailing arguments."
+  s7_pointer obj = s7_car(args);
+  s7_pointer method = <em class=red>s7_method</em>(sc, obj, s7_make_symbol(sc, "plus"));
+  if (s7_is_procedure(method))
+    return(<em class=red>s7_apply_function</em>(sc, method, args));
+  return(s7_f(sc));
+}
+
+int main(int argc, char **argv)
+{
+  s7_scheme *s7 = s7_init();
+  s7_define_function(s7, "plus", plus, 1, 0, true, plus_help);
+  while (1)
+    {
+      char buffer[512];
+      fprintf(stdout, "\n&gt; ");
+      fgets(buffer, 512, stdin);
+      if ((buffer[0] != '\n') || 
+	  (strlen(buffer) &gt; 1))
+	{                            
+          char response[1024];
+	  snprintf(response, 1024, "(write %s)", buffer);
+	  s7_eval_c_string(s7, response);
+	}}
+}
+
+/* gcc -c s7.c -I.
+ * gcc -o ex15 ex15.c s7.o -I. -lm -ldl
+ *
+ *     &gt; (plus 1 2)
+ *     <em class="gray">#f</em>
+ *     &gt; (define obj (openlet (inlet 'plus (lambda args (apply + 1 (cdr args))))))
+ *     <em class="gray">obj</em>
+ *     &gt; (plus obj 2 3)
+ *     <em class="gray">6</em>
+ */
+</pre>
+</div>
+
+
+
+<div class="header" id="signal"><h4>Signal handling and continuations</h4></div>
+
+
+<div class="indented">
+<pre>
+#include &lt;stdlib.h&gt;
+#include &lt;stdio.h&gt;
+#include &lt;string.h&gt;
+#include &lt;signal.h&gt;
+
+#include "s7.h"
+
+static s7_scheme *s7;
+struct sigaction new_act, old_act;  
+  
+static void handle_sigint(int ignored)  
+{  
+  fprintf(stderr, "interrupted!\n");
+  s7_symbol_set_value(s7, s7_make_symbol(s7, "*interrupt*"), <em class=red>s7_make_continuation</em>(s7)); /* save where we were interrupted */
+  sigaction(SIGINT, &amp;new_act, NULL);  
+  s7_quit(s7);                             /* get out of the eval loop if possible */
+}  
+
+static s7_pointer our_sleep(s7_scheme *sc, s7_pointer args)
+{
+  /* slow down our infinite loop for demo purposes */
+  sleep(1);
+  return(s7_f(sc));
+}
+
+int main(int argc, char **argv)
+{
+  s7 = s7_init();
+  s7_define_function(s7, "sleep", our_sleep, 0, 0, false, "(sleep) sleeps");
+  s7_define_variable(s7, "*interrupt*", s7_f(s7)); 
+  /* Scheme variable *interrupt* holds the continuation at the point of the interrupt */
+
+  sigaction(SIGINT, NULL, &amp;old_act);
+  if (old_act.sa_handler != SIG_IGN)
+    {
+      memset(&amp;new_act, 0, sizeof(new_act));  
+      new_act.sa_handler = &amp;handle_sigint;  
+      sigaction(SIGINT, &amp;new_act, NULL);  
+    }
+
+  while (1)
+    {
+      char buffer[512];
+      fprintf(stderr, "\n&gt; ");
+      fgets(buffer, 512, stdin);
+      if ((buffer[0] != '\n') || 
+	  (strlen(buffer) &gt; 1))
+	{                            
+          char response[1024];
+	  snprintf(response, 1024, "(write %s)", buffer);
+	  s7_eval_c_string(s7, response);
+	}}
+}
+
+/*
+ *    &gt; (do ((i 0 (+ i 1))) ((= i -1)) (format () "~D " i) (sleep))
+ *      ;;; now type C-C to break out of this loop
+ *    0 1 2 ^Cinterrupted!
+ *      ;;; call the continuation to continue from where we were interrupted
+ *    &gt; (*interrupt*)
+ *    3 4 5 ^Cinterrupted!
+ *    &gt; *interrupt*
+ *    #&lt;continuation&gt;
+ *    &gt; (+ 1 2)
+ *    3
+ */
+</pre></div>
+
+
+
+<div class="header" id="notify"><h4>Notification from Scheme that a given Scheme variable has been set</h4></div>
+
+
+<div class="indented">
+<pre>
+#include &lt;stdlib.h&gt;
+#include &lt;stdio.h&gt;
+#include &lt;string.h&gt;
+
+#include "s7.h"
+
+static s7_pointer scheme_set_notification(s7_scheme *sc, s7_pointer args)
+{
+  /* this function is called when the Scheme variable is set! */
+  fprintf(stderr, "%s set to %s\n",
+	  s7_object_to_c_string(sc, s7_car(args)),
+	  s7_object_to_c_string(sc, s7_cadr(args)));
+  return(s7_cadr(args));
+}
+
+int main(int argc, char **argv)
+{
+  s7_scheme *s7 = s7_init();  
+
+  s7_define_function(s7, "notify-C", scheme_set_notification, 2, 0, false, "called if notified-var is set!");
+  s7_define_variable(s7, "notified-var", s7_make_integer(s7, 0));
+  <em class=red>s7_set_setter</em>(s7, s7_make_symbol(s7, "notified-var"), s7_name_to_value(s7, "notify-C"));
+
+  if (argc == 2)
+    {
+      fprintf(stderr, "load %s\n", argv[1]);
+      if (!s7_load(s7, argv[1]))
+        fprintf(stderr, "can't find %s\n", argv[1]);
+    }
+  else
+    {
+      while (1) 
+	{
+          char buffer[512];
+	  fprintf(stdout, "\n&gt; ");
+	  fgets(buffer, 512, stdin);
+	  
+	  if ((buffer[0] != '\n') || 
+	      (strlen(buffer) &gt; 1))
+	    {                            
+              char response[1024];
+	      snprintf(response, 1024, "(write %s)", buffer);
+	      s7_eval_c_string(s7, response);
+	    }}}
+}
+
+/*    &gt; notified-var
+ *    <em class="gray">0</em>
+ *    &gt; (set! notified-var 32)
+ *    <em class="gray">notified-var set to 32</em>
+ *    <em class="gray">32</em>
+ */
+</pre></div>
+
+
+
+
+
+<div class="header" id="namespace"><h4>Load C defined stuff into a separate namespace</h4></div>
+
+
+<div class="indented">
+<pre>
+#include &lt;stdlib.h&gt;
+#include &lt;stdio.h&gt;
+#include &lt;string.h&gt;
+
+#include "s7.h"
+
+static s7_pointer func1(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, s7_integer(s7_car(args)) + 1));
+}
+
+int main(int argc, char **argv)
+{
+  s7_scheme *s7 = s7_init();  
+  /* "func1" and "var1" will be placed in an anonymous environment,
+   *   accessible from Scheme via the global variable "lib-exports"
+   */
+  s7_pointer new_env = <em class=red>s7_inlet</em>(s7, s7_curlet(s7), s7_nil(s7));
+  /* make a private environment for func1 and var1 below (this is our "namespace") */
+  s7_gc_protect(s7, new_env);
+
+  s7_define(s7, <em class=red>new_env</em>, 
+	    s7_make_symbol(s7, "func1"),
+	    <em class=red>s7_make_function</em>(s7, "func1", func1, 1, 0, false, "func1 adds 1 to its argument"));
+  
+  s7_define(s7, <em class=red>new_env</em>, s7_make_symbol(s7, "var1"), s7_make_integer(s7, 32));
+  /* those two symbols are now defined in the new environment */
+
+  /* add "lib-exports" to the global environment */
+  s7_define_variable(s7, "lib-exports", <em class=red>s7_let_to_list</em>(s7, new_env));
+
+  if (argc == 2)
+    {
+      fprintf(stderr, "load %s\n", argv[1]);
+      if (!s7_load(s7, argv[1]))
+        fprintf(stderr, "can't find %s\n", argv[1]);
+    }
+  else
+    {
+      while (1) 
+	{
+          char buffer[512];
+	  fprintf(stdout, "\n&gt; ");
+	  fgets(buffer, 512, stdin);
+	  
+	  if ((buffer[0] != '\n') || 
+	      (strlen(buffer) &gt; 1))
+	    {                            
+              char response[1024];
+	      snprintf(response, 1024, "(write %s)", buffer);
+	      s7_eval_c_string(s7, response);
+	    }}}
+}
+
+/*     &gt; func1
+ *     <em class="gray">;func1: unbound variable, line 1</em>
+ *     &gt; lib-exports
+ *     <em class="gray">((var1 . 32) (func1 . func1))</em>
+ *     ;; so lib-exports has the C-defined names and values
+ *     ;; we can use these directly:
+ *
+ *     &gt; (define lib-env (apply <em class=red>sublet</em> (curlet) lib-exports))
+ *     <em class="gray">lib-env</em>
+ *     &gt; (<em class=red>with-let</em> lib-env (func1 var1))
+ *     <em class="gray">33</em>
+ *
+ *     ;; or rename them to prepend "lib:"
+ *     &gt; (define lib-env (apply sublet 
+                                (curlet) 
+                                (map (lambda (binding) 
+                                       (cons (string-&gt;symbol 
+                                               (string-append "lib:" (symbol-&gt;string (car binding)))) 
+                                             (cdr binding))) 
+                                     lib-exports)))
+ *     <em class="gray">lib-env</em>
+ *     &gt; (with-let lib-env (lib:func1 lib:var1))
+ *     <em class="gray">33</em>
+ *
+ *     ;;; now for convenience, place "func1" in the global environment under the name "func2"
+ *     &gt; (define func2 (cdadr lib-exports)) 
+ *     <em class="gray">func2</em>
+ *     &gt; (func2 1)  
+ *     <em class="gray">2</em>
+ */
+</pre></div>
+
+
+
+
+
+<div class="header" id="Cerrors"><h4>Handle scheme errors in C</h4></div>
+
+
+<div class="indented">
+<pre>
+#include &lt;stdlib.h&gt;
+#include &lt;stdio.h&gt;
+#include &lt;string.h&gt;
+
+#include "s7.h"
+
+static s7_pointer error_handler(s7_scheme *sc, s7_pointer args)
+{
+  fprintf(stdout, "error: %s\n", s7_string(s7_car(args)));
+  return(s7_f(sc));
+}
+
+int main(int argc, char **argv)
+{
+  s7_scheme *s7 = s7_init();  
+  bool with_error_hook = false;
+  s7_define_function(s7, "error-handler", error_handler, 1, 0, false, "our error handler");
+
+  if (with_error_hook)
+    s7_eval_c_string(s7, "(set! (hook-functions *error-hook*)                    \n\
+                            (list (lambda (hook)                                 \n\
+                                    (error-handler                               \n\
+                                      (apply format #f (hook 'data)))            \n\
+                                    (set! (hook 'result) 'our-error))))");
+  while (1) 
+    {
+      char buffer[512];
+      fprintf(stdout, "\n&gt; ");
+      fgets(buffer, 512, stdin);
+	  
+      if ((buffer[0] != '\n') || 
+	  (strlen(buffer) &gt; 1))
+	{                            
+	  s7_pointer result;
+	  int gc_loc = -1;
+	  const char *errmsg = NULL;
+
+	  /* trap error messages */
+	  s7_pointer old_port = s7_set_current_error_port(s7, s7_open_output_string(s7));
+	  if (old_port != s7_nil(s7))
+	    gc_loc = s7_gc_protect(s7, old_port);
+
+	  /* evaluate the input string */
+	  result = s7_eval_c_string(s7, buffer);
+
+	  /* print out the value wrapped in "{}" so we can tell it from other IO paths */
+	  fprintf(stdout, "{%s}", s7_object_to_c_string(s7, result));
+
+	  /* look for error messages */
+	  errmsg = s7_get_output_string(s7, s7_current_error_port(s7));
+
+	  /* if we got something, wrap it in "[]" */
+	  if ((errmsg) &amp;&amp; (*errmsg))
+	    fprintf(stdout, "[%s]", errmsg); 
+
+	  s7_close_output_port(s7, s7_current_error_port(s7));
+	  s7_set_current_error_port(s7, old_port);
+	  if (gc_loc != -1)
+	    s7_gc_unprotect_at(s7, gc_loc);
+	}}
+}
+
+/* 
+ *   gcc -c s7.c -I. -g3
+ *   gcc -o ex3 ex3.c s7.o -lm -I. -ldl
+ *
+ * if with_error_hook is false,
+ *
+ *   &gt; (+ 1 2)
+ *   <em class="gray">{3}</em>
+ *   &gt; (+ 1 #\c)
+ *   <em class="gray">{wrong-type-arg}[</em>
+ *   <em class="gray">;+ argument 2, #\c, is character but should be a number, line 1</em>
+ *   ]
+ *
+ * so s7 by default prepends ";" to the error message, and appends "\n",
+ *   sending that to current-error-port, and the error type ('wrong-type-arg here)
+ *   is returned.
+ *
+ * if with_error_hook is true,
+ *
+ *   &gt; (+ 1 2)
+ *   <em class="gray">{3}</em>
+ *   &gt; (+ 1 #\c)
+ *   <em class="red">error</em><em class="gray">: + argument 2, #\c, is character but should be a number</em>
+ *   <em class="gray">{our-error}</em>
+ *
+ * so now the *error-hook* code handles both the error reporting and
+ *   the value returned ('our-error in this case).
+ */
+</pre></div>
+
+
+
+<div class="header" id="testhook"><h4>C and Scheme hooks</h4></div>
+
+
+<div class="indented">
+<pre>
+#include &lt;stdlib.h&gt;
+#include &lt;stdio.h&gt;
+#include &lt;string.h&gt;
+
+#include "s7.h"
+
+static s7_pointer my_hook_function(s7_scheme *sc, s7_pointer args)
+{
+  fprintf(stderr, "a is %s\n", s7_object_to_c_string(sc, s7_symbol_local_value(sc, s7_make_symbol(sc, "a"), s7_car(args))));
+  return(s7_car(args));
+}
+
+int main(int argc, char **argv)
+{
+  s7_scheme *s7 = s7_init();  
+
+  /* define test_hook in C, test-hook in Scheme, arguments are named a and b */
+  s7_pointer test_hook = <em class=red>s7_eval_c_string</em>(s7, "(make-hook 'a 'b)");
+  s7_define_constant(s7, "test-hook", test_hook); 
+
+  /* add my_hook_function to the test_hook function list */
+  <em class=red>s7_hook_set_functions</em>(s7, test_hook, 
+			s7_cons(s7, 
+				s7_make_function(s7, "my-hook-function", my_hook_function, 1, 0, false, "my hook-function"), 
+				s7_hook_functions(s7, test_hook)));
+  while (1) 
+    {
+      char buffer[512];
+      fprintf(stdout, "\n&gt; ");
+      fgets(buffer, 512, stdin);
+	  
+      if ((buffer[0] != '\n') || 
+	  (strlen(buffer) &gt; 1))
+	{                            
+          char response[1024];
+	  snprintf(response, 1024, "(write %s)", buffer);
+	  s7_eval_c_string(s7, response);
+	}}
+}
+
+/* 
+ *    &gt; test-hook
+ *    <em class="gray">#&lt;lambda (hook)&gt;</em>
+ *    &gt; (hook-functions test-hook)
+ *    <em class="gray">(my-hook-function)</em>
+ *    &gt; (test-hook 1 2)
+ *    <em class="gray">a is 1</em>
+ *    <em class="gray">#&lt;unspecified&gt;</em>
+ */
+</pre></div>
+
+
+
+
+
+<div class="header" id="dload"><h4>Load a shared library</h4></div>
+
+<p>We can use dlopen to load a shared library, and dlsym to initialize
+that library in our main program.  The tricky part is to conjure up the right
+compiler and loader flags.
+First we define a module that defines a new s7 function, add-1 that we'll tie
+into s7 explicitly, and another
+function that we'll try to call by waving a wand.
+</p>
+
+
+<div class="indented">
+<pre>
+#include &lt;stdlib.h&gt;
+#include &lt;stdio.h&gt;
+#include &lt;string.h&gt;
+
+#include "s7.h"
+
+double a_function(double an_arg);
+double a_function(double an_arg)
+{
+  return(an_arg + 1.0);
+}
+
+static s7_pointer add_1(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, s7_integer(s7_car(args)) + 1)); 
+}
+
+void init_ex(s7_scheme *sc);
+void init_ex(s7_scheme *sc)  /* this needs to be globally accessible (not "static") */
+{
+  /* tell s7 about add-1, but leave a_function hidden */
+  s7_define_function(sc, "add-1", add_1, 1, 0, false, "(add-1 x) adds 1 to x");
+}
+
+</pre></div>
+
+
+<p>And here is our main program:
+</p>
+
+
+<div class="indented">
+<pre>
+#include &lt;stdlib.h&gt;
+#include &lt;stdio.h&gt;
+#include &lt;string.h&gt;
+
+#include "s7.h"
+#include &lt;dlfcn.h&gt;
+
+static void *library = NULL;
+
+static s7_pointer try(s7_scheme *sc, s7_pointer args)
+{
+  /* try tries to call an arbitrary function in the shared library */
+  void *func = <em class=red>dlsym</em>(library, s7_string(s7_car(args)));
+  if (func)
+    {
+      /* we'll assume double f(double) */
+      typedef double (*dl_func)(double arg);
+      return(s7_make_real(sc, ((dl_func)<em class=red>func</em>)(s7_real(s7_cadr(args)))));
+    }
+  return(s7_error(sc, s7_make_symbol(sc, "can't find function"), 
+		  s7_list(sc, 2, s7_make_string(sc, "loader error: ~S"), 
+			         s7_make_string(sc, dlerror()))));
+}
+
+static s7_pointer cload(s7_scheme *sc, s7_pointer args)
+{
+  /* cload loads a shared library */
+  #define CLOAD_HELP "(cload so-file-name) loads the module"
+  library = dlopen(s7_string(s7_car(args)), RTLD_LAZY);
+  if (library)
+    {
+      /* call our init func to define add-1 in s7 */
+      void *init_func = <em class=red>dlsym</em>(library, s7_string(s7_cadr(args)));
+      if (init_func)
+	{
+	  typedef void *(*dl_func)(s7_scheme *sc);
+	  ((dl_func)<em class=red>init_func</em>)(sc);  /* call the initialization function (init_ex above) */
+	  return(s7_t(sc));
+	}}
+  return(s7_error(sc, s7_make_symbol(sc, "load-error"), 
+		      s7_list(sc, 2, s7_make_string(sc, "loader error: ~S"), 
+			             s7_make_string(sc, dlerror()))));
+}
+
+int main(int argc, char **argv)
+{
+  s7_scheme *s7 = s7_init();  
+  s7_define_function(s7, "cload", cload, 2, 0, false, CLOAD_HELP);
+  s7_define_function(s7, "try", try, 2, 0, false, 
+                         "(try name num) tries to call name in the shared library with the argument num.");
+
+  while (1) 
+    {
+      char buffer[512];
+      fprintf(stdout, "\n&gt; ");
+      fgets(buffer, 512, stdin);
+	  
+      if ((buffer[0] != '\n') || 
+	  (strlen(buffer) &gt; 1))
+	{                            
+          char response[1024];
+	  snprintf(response, 1024, "(write %s)", buffer);
+	  s7_eval_c_string(s7, response);
+	}}
+}
+
+/* Put the module in the file ex3a.c and the main program in ex3.c, then
+ *
+ * in Linux:
+ *   gcc -c -fPIC ex3a.c
+ *   gcc ex3a.o -shared -o ex3a.so
+ *   gcc -c s7.c -I. -fPIC -shared
+ *   gcc -o ex3 ex3.c s7.o -lm -ldl -I. -Wl,-export-dynamic
+ *   # omit -ldl in freeBSD
+ *
+ * in Mac OSX:
+ *   gcc -c ex3a.c
+ *   gcc ex3a.o -o ex3a.so -dynamic -bundle -undefined suppress -flat_namespace
+ *   gcc -c s7.c -I. -dynamic -bundle -undefined suppress -flat_namespace
+ *   gcc -o ex3 ex3.c s7.o -lm -ldl -I.
+ *
+ * and run it:
+ *   ex3
+ *   &gt; (cload "/home/bil/snd-18/ex3a.so" "init_ex")
+ *   <em class="gray">#t</em>
+ *   &gt; (add-1 2)
+ *   <em class="gray">3</em>
+ *   &gt; (try "a_function" 2.5)
+ *   <em class="gray">3.5</em>
+ */
+</pre></div>
+
+<p>All of this is just boring boilerplate, so with a little support from s7,
+we can write a script to do the entire linkage.  The s7 side is an extension
+to "load" that loads a shared object file if its extension is "so", and
+runs an initialization function whose name is defined in the load
+environment (the optional second argument to load).  An example of the scheme side is cload.scm,
+included in the s7 tarball.  It defines a function that can be
+called:
+</p>
+
+<pre class="indented">
+(c-define '(double j0 (double)) "m" "math.h")
+</pre>
+
+<p>This links the s7 function m:j0 to the math library
+function j0.  See <a href="#cload">cload.scm</a> for more details.
+</p>
+
+
+<p>Here's a shorter example:
+</p>
+<div class="indented">
+<pre>
+add1.c:
+
+#include &lt;stdlib.h&gt;
+#include "s7.h"
+
+static s7_pointer add1(s7_scheme *sc, s7_pointer args)
+{
+  if (s7_is_integer(s7_car(args)))
+    return(s7_make_integer(sc, 1 + s7_integer(s7_car(args))));
+  return(s7_wrong_type_arg_error(sc, "add1", 1, s7_car(args), "an integer"));
+}
+
+void add1_init(s7_scheme *sc);
+void add1_init(s7_scheme *sc)
+{
+  s7_define_function(sc, "add1", add1, 1, 0, false, "(add1 int) adds 1 to int");
+}
+
+/* gcc -fpic -c add1.c
+ * gcc -shared -Wl,-soname,libadd1.so -o libadd1.so add1.o -lm -lc
+ * gcc s7.c -o repl -fpic -DWITH_MAIN -I. -ldl -lm -Wl,-export-dynamic -DUSE_SND=0
+ * repl
+ *   (load "libadd1.so" (inlet 'init_func 'add1_init))
+ *   (add1 2)
+ */
+</pre>
+</div>
+
+
+
+<div class="header" id="gmpex"><h4>Bignums in C</h4></div>
+
+<p>Bignum support depends on gmp, mpfr, and mpc.  In this example, we define "add-1" which adds
+1 to any kind of number.  The s7_big_* functions return the underlying gmp/mpfr/mpc pointer.
+</p>
+
+
+<div class="indented">
+<pre>
+#include &lt;stdlib.h&gt;
+#include &lt;stdio.h&gt;
+#include &lt;string.h&gt;
+
+#include &lt;gmp.h&gt;
+#include &lt;mpfr.h&gt;
+#include &lt;mpc.h&gt;
+
+#include "s7.h"
+
+static s7_pointer big_add_1(s7_scheme *sc, s7_pointer args)
+{
+  /* add 1 to either a normal number or a bignum */
+  s7_pointer n;
+  s7_pointer x = s7_car(args);
+  if (s7_is_big_integer(x))
+    {
+      mpz_t big_n;
+      mpz_init_set(big_n, *s7_big_integer(x));
+      mpz_add_ui(big_n, big_n, 1);
+      n = s7_make_big_integer(sc, &amp;big_n);
+      mpz_clear(big_n);
+      return(n);
+    }
+  if (s7_is_big_ratio(x))
+    {
+      mpq_t big_q;
+      mpq_init(big_q);
+      mpq_set_si(big_q, 1, 1);
+      mpq_add(big_q, *s7_big_ratio(x), big_q);
+      mpq_canonicalize(big_q);
+      n = s7_make_big_ratio(sc, &amp;big_q);
+      mpq_clear(big_q);
+      return(n);
+    }
+  if (s7_is_big_real(x))
+    {
+      mpfr_t big_x;
+      mpfr_init_set(big_x, *s7_big_real(x), MPFR_RNDN);
+      mpfr_add_ui(big_x, big_x, 1, MPFR_RNDN);
+      n = s7_make_big_real(sc, &amp;big_x);
+      mpfr_clear(big_x);
+      return(n);
+    }
+  if (s7_is_big_complex(x))
+    {
+      mpc_t big_z;
+      mpc_init2(big_z, mpc_get_prec(*s7_big_complex(x)));
+      mpc_add_ui(big_z, *s7_big_complex(x), 1, MPC_RNDNN);
+      n = s7_make_big_complex(sc, &amp;big_z);
+      mpc_clear(big_z);
+      return(n);
+    }
+  if (s7_is_integer(x))
+    return(s7_make_integer(sc, 1 + s7_integer(x)));
+  if (s7_is_rational(x))
+    return(s7_make_ratio(sc, s7_numerator(x) + s7_denominator(x), s7_denominator(x)));
+  if (s7_is_real(x))
+    return(s7_make_real(sc, 1.0 + s7_real(x)));
+  if (s7_is_complex(x))
+    return(s7_make_complex(sc, 1.0 + s7_real_part(x), s7_imag_part(x)));
+  return(s7_wrong_type_arg_error(sc, "add-1", 0, x, "a number"));
+}
+
+int main(int argc, char **argv)
+{
+  s7_scheme *s7 = s7_init();  
+  s7_define_function(s7, "add-1", big_add_1, 1, 0, false, "(add-1 num) adds 1 to num");
+
+  while (1) 
+    {
+      char buffer[512];
+      fprintf(stdout, "\n&gt; ");
+      fgets(buffer, 512, stdin);
+      if ((buffer[0] != '\n') || 
+	  (strlen(buffer) &gt; 1))
+	{                            
+          char response[1024];
+	  snprintf(response, 1024, "(write %s)", buffer);
+	  s7_eval_c_string(s7, response);
+	}}
+}
+
+/* 
+ *   gcc -DWITH_GMP=1 -c s7.c -I. -O2 -g3
+ *   gcc -DWITH_GMP=1 -o gmpex gmpex.c s7.o -I. -O2 -lm -ldl -lgmp -lmpfr -lmpc
+ *
+ *   gmpex
+ *   &gt; (add-1 1)   
+ *   2
+ *   &gt; (add-1 2/3)
+ *   5/3
+ *   &gt; (add-1 1.4) 
+ *   2.4
+ *   &gt; (add-1 1.5+i)
+ *   2.5+1i
+ *   &gt; (add-1 (bignum 3))
+ *   4
+ *   &gt; (add-1 (bignum 3/4))
+ *   7/4
+ *   &gt; (add-1 (bignum 2.5))
+ *   3.500E0
+ *   &gt; (add-1 (bignum 1.5+i))
+ *   2.500E0+1.000E0i
+ */
+</pre>
+</div>
+
+
+<p>To tie mpfr's bessel-j0 into s7 at run-time:
+</p>
+
+<div class="indented">
+<pre>
+/* libgmp_s7.c */
+
+#include &lt;gmp.h&gt;
+#include &lt;mpfr.h&gt;
+#include &lt;mpc.h&gt;
+
+#define WITH_GMP 1
+#include "s7.h"
+
+static s7_pointer gmp_bessel_j0(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer x, result;
+  mpfr_t mp;
+
+  mpfr_init2(mp, s7_integer(s7_starlet_ref(sc, s7_make_symbol(sc, "bignum-precision"))));
+  /* initialize the mpfr variable mp to the current s7 bignum-precision */
+
+  x = s7_car(args);
+  if (s7_is_big_real(x))
+    <em class=red>mpfr_j0</em>(mp, *s7_big_real(x), MPFR_RNDN);
+  else
+    {
+      if (s7_is_real(x))
+	{
+	  mpfr_set_d(mp, s7_real(x), MPFR_RNDN);
+	  <em class=red>mpfr_j0</em>(mp, mp, MPFR_RNDN);
+	}
+      else return(s7_wrong_type_arg_error(sc, "gmp_bessel_j0", 1, x, "real"));
+    }
+
+  result = s7_make_big_real(sc, &amp;mp);
+  mpfr_clear(mp);
+  return(result);
+}
+
+void libgmp_s7_init(s7_scheme *sc);
+void libgmp_s7_init(s7_scheme *sc)
+{
+  s7_define_function(sc, "bessel-j0", gmp_bessel_j0, 1, 0, false, "(bessel-j0 x) returns j0(x)");
+}
+</pre>
+</div>
+
+<p>libarb_s7.c provides some extensions of the multiprecision math: Bessel functions and the like.  It is based on
+the Flint and Arb libraries, flintlib.org and arblib.org.  In Linux:
+</p>
+
+<pre class="indented">
+gcc -fPIC -c libarb_s7.c
+gcc libarb_s7.o -shared -o libarb_s7.so -lflint
+repl
+  &gt; (load "libarb_s7.so" (inlet 'init_func 'libarb_s7_init))
+  <em class="gray">#f</em>
+  &gt; (acb_bessel_j 0 1.0)
+  <em class="gray">7.651976865579665514497175261026632209096E-1</em>
+</pre>
+<p>As of January 2024, libarb has been absorbed into libflint 3.0.
+</p>
+
+
+<div class="header" id="gdb"><h4>gdb</h4></div>
+
+<p>
+gdbinit has some debugging commands, intended for your ~/.gdbinit file.
+</p>
+
+<pre class="indented">
+s7print interprets its argument as an s7 value and displays it
+s7eval evals its argument (a string)
+s7stack displays the current s7 stack (nested lets)
+s7value prints the value of the variable passed by its print name: s7v "*features*"
+s7let shows all non-global variables that are currently accessible
+s7history shows the history entries (if enabled)
+</pre>
+
+<p>gdbinit also has two backtrace
+decoders: s7bt and s7btfull.  The bt replacements print the gdb backtrace info,
+replacing bare pointer numbers with their s7 value, wherever possible:
+</p>
+
+<pre class="indented">
+(gdb) s7bt
+#0  0x000055555567f7ca in check_cell (p=<b>#&lt;lambda (lst ind)&gt;</b>, 
+    func=0x5555559106e0 &lt;__FUNCTION__.10273&gt; "mark_slot", line=3976) at s7.c:28494
+#1  0x000055555567f84d in check_nref (p=<b>#&lt;lambda (lst ind)&gt;</b>, 
+    func=0x5555559106e0 &lt;__FUNCTION__.10273&gt; "mark_slot", line=3976) at s7.c:28507
+#2  0x0000555555563201 in mark_slot (p=<b>'list-ref #&lt;lambda (lst ind)&gt;</b>) at s7.c:3976
+#3  0x0000555555564ce0 in mark_let (env=<b>#&lt;mock-number-class&gt;</b>) at s7.c:4506
+#4  0x0000555555563239 in mark_slot (p=<b>'mock-number-class #&lt;mock-number-class&gt;</b>) at s7.c:3976
+#5  0x0000555555564ce0 in mark_let (env=<b>(inlet 'mock-number-class #&lt;mock-number-class&gt; 'mock-number mock-number)</b>) at s7.c:4506
+#6  0x0000555555563239 in mark_slot (p=<b>'*mock-number* (inlet 'mock-number-class #&lt;mock-number-class&gt; 'mock-number...)</b>) at s7.c:3976
+#7  0x0000555555564ce0 in mark_let (env=<b>(inlet '*features* (mockery.scm stuff.scm linux autoload dlopen...))</b>) at s7.c:4506
+#8  0x0000555555565697 in mark_closure (p=<b>reactive-vector</b>) at s7.c:4590
+#9  0x0000555555566872 in mark_rootlet (sc=0x555555b41eb0) at s7.c:4813
+#10 0x0000555555566a2f in gc (sc=0x555555b41eb0) at s7.c:4897
+#11 0x000055555558e903 in copy_stack (sc=0x555555b41eb0, old_v=<b>[sc-&gt;stack] #&lt;stack&gt;</b>) at s7.c:9024
+</pre>
+
+
+<div class="header" id="webassembly"><h4>WASM</h4></div>
+
+<p>s7 can be compiled to web assembly.  There are instructions at
+<a href="https://github.com/actonDev/s7-playground/">s7-playground (Christos Vagias)</a>
+and
+<a href="https://github.com/iainctduncan/s7-wasm">s7-wasm (Iain Duncan)</a>.
+</p>
+
+
+
+<div class="header" id="ffinotes"><h4>FFI notes</h4></div>
+
+<ul>
+  <li><a href="#cerrors">Errors</a>
+  <li><a href="#cgcprotection">GC protection</a>
+  <li><a href="#ccload">Load</a>
+  <li><a href="#cevalapply">Eval and Apply</a>
+  <li><a href="#cdefine">Define</a>
+  <li><a href="#cfunctioninfo">Function info</a>
+  <li><a href="#ccobjects">C-objects</a>
+  <li><a href="#cio">IO</a>
+  <li><a href="#clets">Lets</a>
+  <li><a href="#csymbols">Symbols</a>
+  <li><a href="#cnumbers">Numbers</a>
+  <li><a href="#clists">Lists</a>
+  <li><a href="#cvectors">Vectors</a>
+  <li><a href="#ccpointers">C-pointers</a>
+  <li><a href="#cstrings">Strings</a>
+  <li><a href="#ccharacters">Characters</a>
+  <li><a href="#chashtables">Hash-tables</a>
+  <li><a href="#citerators">Iterators</a>
+  <li><a href="#chooks">Hooks</a>
+  <li><a href="#cconstants">Constants</a>
+  <li><a href="#coptimizations">Optimization</a>
+  <li><a href="#candsoon">And so on...</a>
+</ul>
+
+<div class="shortheader" id="cerrors">Errors</div>
+
+<p>Most of the s7.h functions do little, if any, error checking.  s7_car, for example,
+does not check that its argument is a pair.  Partly this is a matter of speed; partly
+of simplicity.  If we had elaborate error checks, we'd need some convention
+for passing error information back to the caller, and of course separate versions
+of each function for cases where all those checks are redundant.  You can easily
+make your own C version of s7_car that includes error checks:
+</p>
+<pre class="indented">
+static s7_pointer my_car(s7_scheme *sc, s7_pointer lst)
+{
+  if (s7_is_pair(lst))
+    return(s7_car(lst));
+  return(<em class="red">s7_wrong_type_arg_error</em>(sc, "my_car", 0, "a pair"));
+}
+</pre>
+
+<p>The s7.h error functions are:
+</p>
+
+<pre class="indented">
+s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info);
+
+s7_pointer s7_wrong_type_arg_error(s7_scheme *sc, const char *caller, s7_int arg_n, s7_pointer arg, const char *descr);
+s7_pointer s7_wrong_type_error(s7_scheme *sc, s7_pointer caller, s7_int arg_n, s7_pointer arg, s7_pointer descr);
+s7_pointer s7_out_of_range_error(s7_scheme *sc, const char *caller, s7_int arg_n, s7_pointer arg, const char *descr);
+s7_pointer s7_wrong_number_of_args_error(s7_scheme *sc, const char *caller, s7_pointer args);
+
+s7_pointer s7_current_error_port(s7_scheme *sc);
+s7_pointer s7_set_current_error_port(s7_scheme *sc, s7_pointer port);
+</pre>
+
+<p>s7_error is equivalent to the scheme error function, and like the latter, it takes two arguments:
+a symbol giving the error type, and a list giving the error data.  In s7, all of the data lists
+are organized so that you can <code>(apply format #f data)</code> to get an error string.
+If you're using catch to handle errors, the error type is what catch looks for.  So, the
+s7_wrong_type_arg_error call above could be:
+</p>
+<pre class="indented">
+s7_error(sc, s7_make_symbol(sc, "wrong-type-arg"), 
+             s7_list(sc, 3, s7_make_string(sc, "~S is a ~S, but should be a pair"), 
+                            s7_car(lst), 
+                            s7_type_of(sc, s7_car(lst))));
+</pre>
+<p>s7_wrong_type_arg_error takes the name of the caller, the argument number, the argument itself,
+and a description of the type expected.  If the argument number is 0, that info is left out of the
+error message (that is, the caller takes only one argument).  s7_out_of_range_error is similar.
+s7_wrong_number_of_args_error takes the caller's name and the offending arg list.  The corresponding
+error types are 'wrong-type-arg, 'wrong-number-of-args, and 'out-of-range.
+A faster version is s7_wrong_type_error; here the caller is an s7 symbol or string, and the
+description is an s7 string.
+</p>
+
+<p>Normally, s7_error sends its error message
+to the current error-port which defaults to stderr. In GUI-based apps,
+you may need to redirect the output to your interface.  One method,
+used in Snd's snd-motif.c, captures the error output in an output string:
+</p>
+<pre class="indented">
+old_port = s7_set_current_error_port(s7, s7_open_output_string(s7));
+...
+result = s7_eval_c_string(s7, text);
+errmsg = s7_get_output_string(s7, s7_current_error_port(s7));
+s7_close_output_port(s7, s7_current_error_port(s7));
+s7_set_current_error_port(s7, old_port);
+...
+</pre>
+<p>and if errmsg is not NULL, it posts it somewhere.
+(You'll also want to GC-protect the old port while it is idle).
+</p>
+<p>s7_error does not return; its s7_pointer return type is just a convenience.  It unwinds the
+scheme stack, closing files, handling dynamic-winds, looking for a catch that matches its type argument
+and so on, then longjmps to unwind the C stack.  If a catch is found, its error handler becomes the new point
+of execution.
+</p>
+
+<p>s7 has an internal debugger that checks everything for consistency.  If you're writing C code that
+calls the s7.h functions a lot, it is sometimes helpful to turn on this debugger by adding the
+-DS7_DEBUGGING=1 compiler flag.  s7 will run 10 to 20 times slower, but it will complain loudly
+about anything it doesn't expect.  
+The internal debugger normally calls abort whenever it detects some error, so it's most convenient
+to run s7 in gdb if this flag is on.
+S7_DEBUGGING also provides various debugging functions that
+can be called from gdb.  By far the most useful is display.  It takes two arguments, the s7_scheme
+pointer to the currently running interpreter, and the object you want to display.  For much more
+detail, there is object_to_let_p_p.  If you're trying to look at a scheme object and have only
+its name in scheme code, use s7_name_to_value.  heap_scan, heap_analyze, and heap holders provide
+a view of the heap.  The scheme function (*s7* 'memory-usage) might also be useful in
+this context.
+s7_show_stack returns a brief list of the current Scheme stack.
+Due to tail calls and whatnot, the s7 stack is not as informative as the equivalent C stack would be.
+The s7 file <a href="#gdb">gdbinit</a> has a few gdb functions that might be helpful.  See also
+(*s7* 'history).
+</p>
+
+
+<div class="shortheader" id="cgcprotection">GC protection</div>
+
+<p>If you save an s7_pointer value in C, you may need to protect it from the garbage collector.  In the example above,
+the first "..." is:
+</p>
+<pre class="indented">
+gc_loc = s7_gc_protect(s7, old_port);
+</pre>
+<p>where gc_loc is (or should be) an s7_int.  Since we're subsequently
+calling s7_eval_c_string, we need to GC protect old_port beforehand.  After the evaluation,
+</p>
+<pre class="indented">
+s7_close_output_port(s7, s7_current_error_port(s7));
+s7_set_current_error_port(s7, old_port);
+s7_gc_unprotect_at(s7, gc_loc);
+</pre>
+<p>The full set of GC protection functions is:
+</p>
+<pre class="indented">
+s7_int s7_gc_protect(s7_scheme *sc, s7_pointer x);
+void s7_gc_unprotect_at(s7_scheme *sc, s7_int loc);
+s7_pointer s7_gc_protected_at(s7_scheme *sc, s7_int loc);
+
+s7_pointer s7_gc_protect_via_stack(s7_scheme *sc, s7_pointer x);
+s7_pointer s7_gc_protect_2_via_stack(s7_scheme *sc, s7_pointer x, s7_pointer y);
+s7_pointer s7_gc_unprotect_via_stack(s7_scheme *sc, s7_pointer x);
+
+s7_pointer s7_gc_protect_via_location(s7_scheme *sc, s7_pointer x, s7_int loc);
+s7_pointer s7_gc_unprotect_via_location(s7_scheme *sc, s7_int loc);
+
+s7_pointer s7_gc_on(s7_scheme *sc, bool on);
+</pre>
+
+<p>If you create an s7 object in C, that object
+needs to be
+GC protected if there is any chance the GC might run without
+an existing Scheme-level reference to it.  s7_gc_protect places the
+object in a vector that the GC always checks, returning the object's location
+in that table.  s7_gc_unprotect_at unprotects the object (removes it from the
+vector) using the location passed to it.  s7_gc_protected_at returns the object 
+at the given location.
+There is a built-in lag between the creation of a new object and its first possible GC
+(the lag time is set indirectly by GC_TEMPS_SIZE in s7.c), so you don't need to worry about
+very short term temps such as the arguments to s7_cons in:
+</p>
+<pre class="indented">
+s7_cons(s7, s7_make_real(s7, 3.14), 
+            s7_cons(s7, s7_make_integer(s7, 123), s7_nil(s7)));
+</pre>
+<p>The protect_via_stack functions place the object on the s7 stack where it is
+protected until the stack unwinds past that point.  Besides speed, this provides
+a way to be sure an object is unprotected even in some complicated situation where
+error handling may bypass an explicit s7_gc_unprotect_at call.  s7_gc_protect_2_via_stack
+protects two objects in one stack location, saving stack space.
+The protect_via_location are intended for cases where you have a location already
+(from s7_gc_protect), and want to reuse it for a different object.
+s7_gc_on turns the GC on or off.  Objects can be created at a blistering pace,
+so don't leave the GC off for a long time!
+</p>
+
+<div class="shortheader" id="ccload">Load</div>
+
+<pre class="indented">
+s7_pointer s7_load(s7_scheme *sc, const char *file);
+s7_pointer s7_load_with_environment(s7_scheme *sc, const char *filename, s7_pointer e);
+s7_pointer s7_load_c_string(s7_scheme *sc, const char *content, s7_int bytes);
+s7_pointer s7_load_c_string_with_environment(s7_scheme *sc, const char *content, s7_int bytes, s7_pointer e);
+s7_pointer s7_load_path(s7_scheme *sc);
+s7_pointer s7_add_to_load_path(s7_scheme *sc, const char *dir);
+s7_pointer s7_autoload(s7_scheme *sc, s7_pointer symbol, s7_pointer file_or_function);
+void s7_autoload_set_names(s7_scheme *sc, const char **names, s7_int size); snd-xref.c
+</pre>
+<p>s7_load is similar to the scheme-side load function.  Its argument is a file name, and optionally (via s7_load_with_environment) an environment
+in which to place top-level objects.  Normally the file contains scheme code, but if WITH_C_LOADER is set when s7 is built, you can
+also load shared-object files.  If you load a shared-object file (a dynamically loadable library), the environment argument
+provides a way to pass in the initialization function (named 'init_func).  For example, the repl in s7.c needs access to
+libc's tcsetattr, so it looks for libc_s7.so (created by libc.scm).  If found, 
+</p>
+<pre class="indented">
+  s7_load_with_environment(sc, "libc_s7.so", 
+    s7_inlet(sc, s7_list(sc, 2, s7_make_symbol(sc, "init_func"), 
+                                s7_make_symbol(sc, "libc_s7_init")));
+</pre>
+<p>You can also include an 'init_args field to pass arguments to init_func.  Here's an example that
+includes init_args:
+</p>
+<pre class="indented">
+/* tlib.c */
+#include &lt;stdio.h&gt;
+#include &lt;stdlib.h&gt;
+#include "s7.h"
+
+static s7_pointer a_function(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_car(args));
+}
+
+s7_pointer tlib_init(s7_scheme *sc, s7_pointer args); /* void tlib_init(s7_scheme *sc) if no init_args */
+s7_pointer tlib_init(s7_scheme *sc, s7_pointer args)
+{
+  fprintf(stderr, "tlib_init: %s\n", s7_object_to_c_string(sc, args));
+  s7_define_function(sc, "a-function", a_function, 1, 0, true, "");
+  return(s7_car(args));
+}
+
+/* in Linux:
+   gcc -fPIC -c tlib.c
+   gcc tlib.o -shared -o tlib.so -ldl -lm -Wl,-export-dynamic
+
+   /home/bil/cl/ repl
+   &lt;1&gt; (load "tlib.so" (inlet 'init_func 'tlib_init 'init_args (list 1 2 3)))
+   tlib_init: (1 2 3)
+   1
+   &lt;2&gt; (a-function 1 2 3)
+   1
+*/
+</pre>
+<p>
+s7_load returns the last value produced during the load; so given "test.scm" with the contents: 
+</p>
+<pre class="indented">
+define (f x) (+ x 1)) 
+32
+</pre>
+<p>when we call s7_load:</p>
+<pre class="indented">
+s7_pointer val;
+val = s7_load_with_environment(sc, "test.scm", s7_curlet(sc));
+</pre>
+<p>val is set to 32 (as a scheme object), and f is placed in the current environment.
+If "test.scm" is not in the current directory, s7 looks at the entries in its <a href="#loadpath">*load-path*</a> variable,
+trying each in turn until it finds the file.  If it fails, it returns NULL.
+s7_load_path returns this list, and s7_add_to_load_path adds a directory name to the list.
+</p>
+<p>
+s7_load_c_string takes an array of bytes representing some scheme code (xxd -i file.scm can generate these arrays),
+and treats it as if it were the contents of a file of scheme code.  So, unlike s7_eval_c_string, it can handle
+multiple statements, and things like double-quote don't need to be quoted.  nrepl.c for example
+embeds the contents of nrepl.scm at compile time, then calls s7_load_c_string at program startup.  It also
+includes notcurses_s7.c.  The end result is a stand-alone program that doesn't need to load either nrepl.scm
+or notcurses_s7.so.  The "content" argument should be a null-terminated C string. The "bytes" argument 
+is the contents length, not including the trailing null, as in strlen.  There are simple examples in ffitest.c.
+</p>
+
+<blockquote>
+<div class="indented">
+<p>xxd is not ideal in this context because diffs become enormous.  I use this code to turn nrepl.scm
+into nrepl-bits.h, following the original code's layout to minimize diffs:
+</p>
+<pre class="indented">
+(call-with-output-file "nrepl-bits.h"
+  (lambda (op)
+    (call-with-input-file "nrepl.scm"
+      (lambda (ip)
+	(format op "unsigned char nrepl_scm[] = {~%  ")
+	(do ((c (read-char ip) (read-char ip))
+	     (i 0 (+ i 1)))
+	    ((eof-object? c)
+	     (format op "0};~%unsigned int nrepl_scm_len = ~D;~%" (+ i 1)))
+	  (format op "0x~X, " (char-&gt;integer c))
+	  (if (char=? c #\newline)
+	      (format op "~%  ")))))))
+</pre>
+<p>Then in nrepl.c:
+</p>
+<pre class="indented">
+      #include "nrepl-bits.h"
+      s7_load_c_string(sc, (const char *)nrepl_scm, nrepl_scm_len);
+</pre>
+<p>which replaces <code>s7_load(sc, "nrepl.scm")</code>.
+</p>
+</div>
+</blockquote>
+
+
+<p>
+s7_autoload adds a symbol to the <a href="#autoload">autoload table</a>.  As a convenience,
+s7_autoload_set_names adds an array of names+files.  The array should be sorted alphabetically
+by string&lt;? acting on the symbol names (not the file names), and the size argument is the number
+of symbol names (half the actual array size).
+snd-xref.c in Snd has more than 5000 such
+names:
+</p>
+<pre>
+static const char *snd_names[11848] = {
+    "*clm-array-print-length*", "ws.scm", /* each pair of entries is entity name + file name */
+    "*clm-channels*", "ws.scm",           /*   so clm-channels is defined in ws.scm */
+    ...
+    "zone-tailed-hawk", "animals.scm",
+    "zoom-spectrum", "examp.scm",
+};
+
+s7_autoload_set_names(sc, snd_names, 5924);
+</pre>
+
+<div class="shortheader" id="cevalapply">Eval and Apply</div>
+
+<pre class="indented">
+s7_pointer s7_eval(s7_scheme *sc, s7_pointer code, s7_pointer e);
+s7_pointer s7_eval_with_location(s7_scheme *sc, s7_pointer code, s7_pointer e, const char *caller, const char *file, s7_int line);
+s7_pointer s7_eval_c_string(s7_scheme *sc, const char *str);
+s7_pointer s7_eval_c_string_with_environment(s7_scheme *sc, const char *str, s7_pointer e);
+
+s7_pointer s7_apply_function(s7_scheme *sc, s7_pointer fnc, s7_pointer args);
+s7_pointer s7_apply_function_star(s7_scheme *sc, s7_pointer fnc, s7_pointer args);
+
+s7_pointer s7_call(s7_scheme *sc, s7_pointer func, s7_pointer args);
+s7_pointer s7_call_with_location(s7_scheme *sc, s7_pointer func, s7_pointer args, const char *caller, const char *file, s7_int line);
+s7_pointer s7_call_with_catch(s7_scheme *sc, s7_pointer tag, s7_pointer body, s7_pointer error_handler);
+
+s7_pointer s7_apply_1(s7_scheme *sc, s7_pointer args, s7_pointer (*f1)(s7_pointer a1)); 
+s7_pointer s7_apply_n_1(s7_scheme *sc, s7_pointer args, s7_pointer (*f1)(s7_pointer a1));
+/* and many more passing 2 to 9 arguments */
+</pre>
+<p>These functions evaluate Scheme expressions, and call Scheme functions (which might be defined in C originally).
+s7_eval evaluates a list that represents Scheme code.  That is, 
+</p>
+<pre class="indented">
+s7_eval(sc, s7_cons(sc, s7_make_symbol(sc, "+"),
+               s7_cons(sc, s7_make_integer(sc, 1),
+                  s7_cons(sc, s7_make_integer(sc, 2), s7_nil(sc)))),
+            s7_rootlet(sc));
+</pre>
+<p>returns 3 (as a Scheme integer).  This may look ridiculous, but see snd-sig.c for an actual use.
+s7_eval_c_string evaluates a Scheme expression presented to it as a C string; it combines read and
+eval, whereas s7_eval is just the eval portion.
+</p>
+<pre class="indented">
+s7_eval_c_string(sc, "(+ 1 2)");
+</pre>
+<p>also returns 3.  The expression is evaluated in rootlet (the global environment).  To specify the
+environment, use s7_eval_c_string_with_environment.
+</p>
+<p>s7_apply_function and s7_apply_function_star take an s7_function and apply it to a list of arguments.
+These two functions are the low-level versions of the s7_call functions.  The latter set up various
+catches so that error handling is safe, whereas s7_apply_function assumes you have a catch already somewhere.
+</p>
+<p>
+s7_call_with_location passes some information to the error handler, and
+s7_call_with_catch wraps an explicit catch around a function call:
+s7_call_with_catch(sc, tag, body, err) is equivalent to (catch tag body err).
+There are many examples of these functions in clm2xen.c, ffitest.c, etc.
+</p>
+<p>The s7_apply_1 functions and its many friends are left over from long ago.  I hope to
+deprecate them someday, but currently Snd uses them to excess.  Each applies its function
+to the arguments.
+</p>
+
+<div class="shortheader" id="cdefine">Define</div>
+
+<pre class="indented">
+void s7_define(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value);
+bool s7_is_defined(s7_scheme *sc, const char *name);
+
+/* these s7_define* functions return a symbol */
+s7_pointer s7_define_variable(s7_scheme *sc, const char *name, s7_pointer value);
+s7_pointer s7_define_variable_with_documentation(s7_scheme *sc, const char *name, s7_pointer value, const char *help);
+
+s7_pointer s7_define_constant(s7_scheme *sc, const char *name, s7_pointer value);
+s7_pointer s7_define_constant_with_documentation(s7_scheme *sc, const char *name, s7_pointer value, const char *help);
+s7_pointer s7_define_constant_with_environment(s7_scheme *sc, s7_pointer envir, const char *name, s7_pointer value);
+
+s7_pointer s7_define_function(s7_scheme *sc, const char *name, s7_function fnc, 
+                              s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc);
+s7_pointer s7_define_safe_function(s7_scheme *sc, const char *name, s7_function fnc, 
+                                   s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc);
+s7_pointer s7_define_typed_function(s7_scheme *sc, const char *name, s7_function fnc,
+				    s7_int required_args, s7_int optional_args, bool rest_arg, 
+				    const char *doc, s7_pointer signature);
+s7_pointer s7_define_unsafe_typed_function(s7_scheme *sc, const char *name, s7_function fnc,
+					   s7_int required_args, s7_int optional_args, bool rest_arg, 
+					   const char *doc, s7_pointer signature);
+s7_pointer s7_define_semisafe_typed_function(s7_scheme *sc, const char *name, s7_function fnc,
+					     s7_int required_args, s7_int optional_args, bool rest_arg,
+					     const char *doc, s7_pointer signature);
+
+void s7_define_function_star(s7_scheme *sc, const char *name, s7_function fnc, 
+                             const char *arglist, const char *doc);
+void s7_define_safe_function_star(s7_scheme *sc, const char *name, s7_function fnc, 
+                                  const char *arglist, const char *doc);
+void s7_define_typed_function_star(s7_scheme *sc, const char *name, s7_function fnc, 
+                                   const char *arglist, const char *doc, s7_pointer signature);
+
+s7_pointer s7_define_macro(s7_scheme *sc, const char *name, s7_function fnc, 
+                           s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc);
+
+/* s7_make* functions return a function */
+s7_pointer s7_make_function(s7_scheme *sc, const char *name, s7_function fnc, 
+                            s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc);
+s7_pointer s7_make_safe_function(s7_scheme *sc, const char *name, s7_function fnc, 
+                                 s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc);
+s7_pointer s7_make_typed_function(s7_scheme *sc, const char *name, s7_function f, 
+				  s7_int required_args, s7_int optional_args, bool rest_arg, 
+                                  const char *doc, s7_pointer signature);
+
+s7_pointer s7_make_function_star(s7_scheme *sc, const char *name, s7_function fnc, 
+                                 const char *arglist, const char *doc);
+s7_pointer s7_make_safe_function_star(s7_scheme *sc, const char *name, s7_function fnc, 
+                                 const char *arglist, const char *doc);
+
+bool s7_is_dilambda(s7_pointer obj);
+s7_pointer s7_dilambda(s7_scheme *sc, 
+		       const char *name,
+		       s7_pointer (*getter)(s7_scheme *sc, s7_pointer args), 
+		       s7_int get_req_args, s7_int get_opt_args,
+		       s7_pointer (*setter)(s7_scheme *sc, s7_pointer args),
+		       s7_int set_req_args, s7_int set_opt_args,
+		       const char *documentation);
+s7_pointer s7_typed_dilambda(s7_scheme *sc, 
+		       const char *name,
+		       s7_pointer (*getter)(s7_scheme *sc, s7_pointer args), 
+		       s7_int get_req_args, s7_int get_opt_args,
+		       s7_pointer (*setter)(s7_scheme *sc, s7_pointer args),
+		       s7_int set_req_args, s7_int set_opt_args,
+		       const char *documentation,
+ 		       s7_pointer get_sig, s7_pointer set_sig);
+s7_pointer s7_dilambda_with_environment(s7_scheme *sc, s7_pointer envir,
+		       const char *name,
+		       s7_pointer (*getter)(s7_scheme *sc, s7_pointer args),
+		       s7_int get_req_args, s7_int get_opt_args,
+		       s7_pointer (*setter)(s7_scheme *sc, s7_pointer args),
+	               s7_int set_req_args, s7_int set_opt_args,
+		       const char *documentation);
+</pre>
+<p>The s7_define* functions add a symbol and its binding to either the top-level (global) environment
+or, in s7_define, the 'env' passed as the second argument.  Use s7_set_shadow_rootlet to
+import the current let into rootlet.
+</p>
+<pre class="indented">
+s7_define(s7, s7_curlet(s7), s7_make_symbol(s7, "var"), s7_make_integer(s7, 123));
+</pre>
+<p>adds the variable named var to the current environment with the value 123.
+Scheme code can then refer to var just as if we had said <code>(define var 123)</code>
+in Scheme.
+</p>
+<p>s7_define_variable is a wrapper for s7_define; the code above could be:
+</p>
+<pre class="indented">
+s7_define_variable(s7, "var", s7_make_integer(s7, 123)); /* (define var 123) */
+</pre>
+<p>except that s7_define_variable assumes you want var in rootlet.
+</p>
+<p>s7_define_constant is another wrapper for s7_define; it makes the variable immutable:
+</p>
+<pre class="indented">
+s7_define_constant(sc, "var", s7_f(sc));  /* (define-constant var 123) */
+</pre>
+<p>Most of the s7_define* functions return the name as a symbol; this reflects the way
+define worked in s7 until 2014.  Backwards compatibility...
+</p>
+
+<p>The rest of the functions in this section deal with tieing C functions into Scheme.
+s7_make_function creates (and returns) a Scheme function object from the s7_function 'fnc'.
+An s7_function is a C function of the form <code>s7_pointer func(s7_scheme *sc, s7_pointer args)</code>.
+The new function's name is 'name', it requires 'required_args' arguments,
+it can accept 'optional_args' other arguments, and if 'rest_arg' is true, it accepts
+a "rest" argument (a list of all the trailing arguments).  
+The function's documentation is 'doc'.
+</p>
+<p>Leaving aside the value returned, s7_define_function is the same as s7_make_function, but it also adds 'name' (as a symbol) to the
+global environment, with the function as its value.  For example, the Scheme
+function 'car' is essentially:
+</p>
+<pre class="indented">
+s7_pointer g_car(s7_scheme *sc, s7_pointer args) {return(s7_car(s7_car(args)));} /* args is a list of args */
+</pre>
+<p>It is bound to the name "car":
+</p>
+<pre class="indented">
+s7_define_function(sc, "car", g_car, 1, 0, false, "(car obj)");
+</pre>
+<p>which says that car has one required argument, no optional arguments, and no "rest" argument.
+</p>
+<p>s7_define_macro defines a Scheme macro; its arguments are not evaluated (unlike a function),
+but its returned value (assumed to be some sort of Scheme expression) is evaluated.  It returns a symbol.
+</p>
+<p>The "safe" and "unsafe" versions of these functions refer to the s7 optimizer.
+If it knows a function is safe, it can more thoroughly optimize the expression it is in.
+"Safe" here means the function does not call the evaluator itself (via s7_apply_function for example)
+and does not mess with s7's stack.
+</p>
+<p>The "typed" versions refer to the function's signature. Since "car" is safe, and has a signature,
+it is defined in s7.c:
+</p>
+<pre class="indented">
+s7_define_typed_function(sc, "car", g_car, 1, 0, false, H_car, Q_car);
+</pre>
+<p>Here unless you use s7_define_unsafe_typed_function, the function is assumed to be safe.
+We've given it the Scheme name "car", which invokes the C function g_car.  It takes one
+required argument, and no optional or rest arguments.  Its documentation is H_car, and
+its signature is Q_car.  The latter is <code>s7_make_signature(sc, 2, sc-&gt;T, sc-&gt;is_pair_symbol)</code>
+which says that car takes a pair argument, and returns any type object.
+</p>
+<p>The function_star functions are similar, but in this case we pass the argument list
+as a string, as it would appear in Scheme.
+s7 makes sure the arguments  are ordered correctly and have the specified defaults before calling the C function.
+</p>
+<pre class="indented">
+s7_define_function_star(sc, "a-func", a_func, "arg1 (arg2 32)", "an example of C define*");
+</pre>
+<p>Now in Scheme, (a-func :arg1 2) calls the C function a_func with the arguments 2 and 32.
+</p>
+<p>Finally, the dilambda function define Scheme dilambda, just as the Scheme dilambda function does.
+The dax example above gives read/write access to its x field via:
+</p>
+<pre class="indented">
+s7_define_variable(s7, "dax-x", s7_dilambda(s7, "dax-x", dax_x, 1, 0, set_dax_x, 2, 0, "dax x field"));
+</pre>
+
+
+
+<div class="shortheader" id="cfunctioninfo">Function info</div>
+
+<pre class="indented">
+const char *s7_documentation(s7_scheme *sc, s7_pointer p);
+const char *s7_set_documentation(s7_scheme *sc, s7_pointer symbol, const char *new_doc);
+const char *s7_help(s7_scheme *sc, s7_pointer obj);
+
+s7_pointer s7_arity(s7_scheme *sc, s7_pointer obj);
+bool s7_is_aritable(s7_scheme *sc, s7_pointer obj, s7_int args);
+
+s7_pointer s7_setter(s7_scheme *sc, s7_pointer obj);
+s7_pointer s7_set_setter(s7_scheme *sc, s7_pointer obj, s7_pointer setter);
+
+s7_pointer s7_signature(s7_scheme *sc, s7_pointer func);
+s7_pointer s7_make_signature(s7_scheme *sc, s7_int len, ...);
+s7_pointer s7_make_circular_signature(s7_scheme *sc, s7_int cycle_point, s7_int len, ...);
+
+s7_pointer s7_closure_body(s7_scheme *sc, s7_pointer p);
+s7_pointer s7_closure_let(s7_scheme *sc, s7_pointer p);
+s7_pointer s7_closure_args(s7_scheme *sc, s7_pointer p);
+s7_pointer s7_funclet(s7_scheme *sc, s7_pointer p);
+</pre>
+<p>These functions pertain mostly to functions, both those defined in Scheme and those in C.
+s7_help and s7_documentation return the documentation string associated with their argument.
+I find "documentation" tedious to type, and Snd uses "help", but other than the name,
+there isn't much difference between them.  s7_set_documentation sets the documentation string, if it can.
+</p>
+
+<p>s7_arity returns an object's arity, a cons of the number of required arguments, and the total acceptable arguments.
+s7_is_aritable returns true if the object can accept that number of args.
+</p>
+
+<p>s7_setter is the object's <a href="#pws">setter</a>, and s7_set_setter sets it, if possible.
+</p>
+
+<p>s7_signature is the object's <a href="#signature">signature</a>, a list of types (symbols like 'integer?) giving return and argument types.
+For a function defined in C, s7_make_signature and s7_make_circular_signature create the signature that is then 
+associated with the function via s7_define_typed_function and its friends.
+In s7.c g_is_zero (the function that implements zero?) uses:
+</p>
+<pre class="indented">
+s7_make_signature(sc, 2, sc-&gt;is_boolean_symbol, sc-&gt;is_number_symbol); /* return a boolean, argument is a number */
+</pre>
+<p>Similarly, g_add is:
+</p>
+<pre class="indented">
+s7_make_circular_signature(sc, 0, 1, sc-&gt;is_number_symbol); /* returns a number, takes any number of numbers */
+</pre>
+<p>The two numeric arguments set the cycle start point (0-based) and the number of type symbols passed as arguments to it.
+So, char=? is:
+</p>
+<pre class="indented">
+s7_make_circular_signature(sc, 1, 2, sc-&gt;is_boolean_symbol, sc-&gt;is_char_symbol);
+</pre>
+<p>which says there are two type entries (the "2"), and the cycle starts at the second (the "1" -- it's 0-based).
+</p>
+
+<p>The s7_closure functions only apply to functions defined in Scheme.  They return the closure body (s7_closure_body, a list),
+its definition environment (s7_closure_let), and its argument list (s7_closure_args).  If the function is of the form
+<code>(define (f . args) ...)</code>, s7_closure_args returns the symbol ('args in this case).
+s7_funclet returns the top let within the function (the let containing the argument names).
+</p>
+
+
+<div class="shortheader" id="ccobjects">C-objects</div>
+
+<pre class="indented">
+bool s7_is_c_object(s7_pointer p);
+s7_pointer s7_make_c_object(s7_scheme *sc, s7_int type, void *value);
+s7_pointer s7_make_c_object_without_gc(s7_scheme *sc, s7_int type, void *value);
+s7_pointer s7_make_c_object_with_let(s7_scheme *sc, s7_int type, void *value, s7_pointer let);
+
+s7_int s7_c_object_type(s7_pointer obj);
+void *s7_c_object_value(s7_pointer obj);
+void *s7_c_object_value_checked(s7_pointer obj, s7_int type);
+s7_pointer s7_c_object_let(s7_pointer obj);
+s7_pointer s7_c_object_set_let(s7_scheme *sc, s7_pointer obj, s7_pointer e);
+
+s7_int s7_make_c_type(s7_scheme *sc, const char *name);
+void s7_c_type_set_gc_free      (s7_scheme *sc, s7_int type, s7_pointer (*gc_free)   (s7_scheme *sc, s7_pointer obj));
+void s7_c_type_set_gc_mark      (s7_scheme *sc, s7_int type, s7_pointer (*mark)      (s7_scheme *sc, s7_pointer obj));
+void s7_c_type_set_is_equal     (s7_scheme *sc, s7_int type, s7_pointer (*is_equal)  (s7_scheme *sc, s7_pointer args));
+void s7_c_type_set_is_equivalent(s7_scheme *sc, s7_int type, s7_pointer (*is_equivalent)(s7_scheme *sc, s7_pointer args));
+void s7_c_type_set_ref          (s7_scheme *sc, s7_int type, s7_pointer (*ref)       (s7_scheme *sc, s7_pointer args));
+void s7_c_type_set_set          (s7_scheme *sc, s7_int type, s7_pointer (*set)       (s7_scheme *sc, s7_pointer args));
+void s7_c_type_set_length       (s7_scheme *sc, s7_int type, s7_pointer (*length)    (s7_scheme *sc, s7_pointer args));
+void s7_c_type_set_copy         (s7_scheme *sc, s7_int type, s7_pointer (*copy)      (s7_scheme *sc, s7_pointer args));
+void s7_c_type_set_fill         (s7_scheme *sc, s7_int type, s7_pointer (*fill)      (s7_scheme *sc, s7_pointer args));
+void s7_c_type_set_reverse      (s7_scheme *sc, s7_int type, s7_pointer (*reverse)   (s7_scheme *sc, s7_pointer args));
+void s7_c_type_set_to_list      (s7_scheme *sc, s7_int type, s7_pointer (*to_list)   (s7_scheme *sc, s7_pointer args));
+void s7_c_type_set_to_string    (s7_scheme *sc, s7_int type, s7_pointer (*to_string) (s7_scheme *sc, s7_pointer args));
+void s7_c_type_set_getter       (s7_scheme *sc, s7_int type, s7_pointer getter);
+void s7_c_type_set_setter       (s7_scheme *sc, s7_int type, s7_pointer setter);
+
+void s7_mark(s7_pointer p);
+</pre>
+
+<p>These functions create a new Scheme object type.  See <a href="#pwstype">dax</a> above for a simple example,
+and s7test.scm for several progressively more complicated examples.
+C-objects in Scheme usually correspond to an instance of a struct in C which you want to access from Scheme.
+The normal sequence is: define a new c-type via s7_make_c_type, call s7_c_type_set* to specialize its behavior,
+then to wrap a C object, call s7_make_c_object. 
+s7_make_c_type takes an arbitrary name, used in object-&gt;string to identify the object, and returns an s7_int, the "type"
+mentioned in many of the other functions. 
+</p>
+<p>s7_c_type_set_free sets the function that is called by the GC when a Scheme c-object is garbage-collected.
+You normally use this to free the associated C value (the instance of the struct).  To get that value,
+call s7_c_object_value.  It returns the void* pointer that you originally passed to s7_make_c_object.
+See free_dax in the <a href="#pwstype">dax</a> example.
+</p>
+<p>s7_c_type_set_mark sets the function that is called by the GC during its marking phase.  Any s7_pointer
+value local to your C struct should be marked explicitly at this time, or the GC will free it.  Use s7_mark
+for this (see mark_dax).  Don't allocate any s7 objects in the mark function (otherwise you'll get a recursive call of the GC).
+</p>
+<p>s7_c_type_set_equal and s7_c_type_set_equivalent set the function called when s7 sees a c-object of the
+current type as an argument to equal? or equivalent?.  When called, these functions can assume that the
+first argument is a c-object of the current type, but the second argument can be anything (see dax_is_equal).
+</p>
+<p>s7_c_type_set_ref and s7_c_type_set_set are called when the c-object is treated as an applicable object
+in Scheme.  That is, <code>(object ...)</code> in Scheme calls the function set as the "ref" function, and
+<code>(set! (object ...) new-value)</code> calls the "set" function.  The arguments in the set! form are
+passed as a flattened list.
+</p>
+<p>The rest of the s7_c_type_set* functions set the functions called when the c-object is an argument to
+length (s7_c_type_set_length), copy (s7_c_type_set_copy), fill! (s7_c_type_set_fill), reverse (s7_c_type_set_reverse),
+object-&gt;string (s7_c_type_set_to_string), and internally by map and a few other cases, s7_c_type_set_to_list.
+For the copy function, either the first or second argument can be a c-object of the given type.
+The getter and setter functions are optimizer helpers.
+</p>
+<p>s7_c_object_value_checked is like s7_c_object, but it first checks that the object type matches the given type.
+</p>
+<p>s7_c_object_let and s7_c_object_set_let manage the c-object's local environment.
+These two functions need to check that they are passed the correct number of arguments.
+See the block object in s7test.scm.  The c_object_let provides methods normally.
+In Snd, marks can be passed into Scheme; the setup code is:
+</p>
+<pre class="indented">
+  static s7_pointer g_mark_methods;
+  ...
+  g_mark_methods = s7_openlet(s7, 
+                     s7_inlet(s7, s7_list(s7, 2, s7_make_symbol(s7, "object-&gt;let"), 
+                                                 mark_to_let_func)));
+  s7_gc_protect(s7, g_mark_methods);
+  xen_mark_tag = s7_make_c_type(s7, "&lt;mark&gt;");
+  s7_c_type_set_gc_free(s7, xen_mark_tag, s7_xen_mark_free);
+  s7_c_type_set_is_equal(s7, xen_mark_tag, s7_xen_mark_is_equal);
+  s7_c_type_set_copy(s7, xen_mark_tag, s7_xen_mark_copy);
+  s7_c_type_set_to_string(s7, xen_mark_tag, g_xen_mark_to_string);
+</pre>
+<p>The mark object's let (g_mark_methods) has a method for object-&gt;let.
+It is tied into each mark object:
+</p>
+<pre class="indented">
+s7_pointer m;
+m = s7_make_c_object(s7, xen_mark_tag, mx);  /* mx is the C-side value */
+s7_c_object_set_let(s7, m, g_mark_methods);
+</pre>
+<p>and now if you type (object-&gt;let mark) in Snd's listener (where "mark" is
+an appropriate mark of course), object-&gt;let calls the object's object-&gt;let method.
+Don't forget to GC-protect the let!
+</p>
+<p>s7_make_c_object_without_gc makes a c-object of the given type, but the gc_free function
+won't be called when the s7_cell that holds the C data is freed for reuse.
+</p>
+
+<div class="shortheader" id="cio">IO</div>
+<pre class="indented">
+bool s7_is_input_port(s7_scheme *sc, s7_pointer p);
+bool s7_is_output_port(s7_scheme *sc, s7_pointer p);
+void s7_close_input_port(s7_scheme *sc, s7_pointer p);
+void s7_close_output_port(s7_scheme *sc, s7_pointer p);
+bool s7_flush_output_port(s7_scheme *sc, s7_pointer p); /* false=flush lost data */
+const char *s7_port_filename(s7_scheme *sc, s7_pointer x);
+s7_int s7_port_line_number(s7_scheme *sc, s7_pointer p);
+
+s7_pointer s7_open_input_file(s7_scheme *sc, const char *name, const char *mode);  
+s7_pointer s7_open_output_file(s7_scheme *sc, const char *name, const char *mode); 
+
+s7_pointer s7_open_input_string(s7_scheme *sc, const char *input_string);  
+s7_pointer s7_open_output_string(s7_scheme *sc);
+const char *s7_get_output_string(s7_scheme *sc, s7_pointer out_port);
+s7_pointer s7_output_string(s7_scheme *sc, s7_pointer out_port);
+
+typedef enum {S7_READ, S7_READ_CHAR, S7_READ_LINE, S7_PEEK_CHAR, S7_IS_CHAR_READY, S7_NUM_READ_CHOICES} s7_read_t;
+s7_pointer s7_open_output_function(s7_scheme *sc, void (*function)(s7_scheme *sc, uint8_t c, s7_pointer port));  
+s7_pointer s7_open_input_function(s7_scheme *sc, s7_pointer (*function)(s7_scheme *sc, s7_read_t read_choice, s7_pointer port));
+
+s7_pointer s7_read_char(s7_scheme *sc, s7_pointer port);
+s7_pointer s7_peek_char(s7_scheme *sc, s7_pointer port);
+s7_pointer s7_write_char(s7_scheme *sc, s7_pointer c, s7_pointer port);
+s7_pointer s7_write(s7_scheme *sc, s7_pointer obj, s7_pointer port);
+s7_pointer s7_display(s7_scheme *sc, s7_pointer obj, s7_pointer port);
+void s7_newline(s7_scheme *sc, s7_pointer port);
+const char *s7_format(s7_scheme *sc, s7_pointer args);
+s7_pointer s7_object_to_string(s7_scheme *sc, s7_pointer arg, bool use_write);       
+char *s7_object_to_c_string(s7_scheme *sc, s7_pointer obj);
+
+s7_pointer s7_current_input_port(s7_scheme *sc);
+s7_pointer s7_set_current_input_port(s7_scheme *sc, s7_pointer p);
+s7_pointer s7_current_output_port(s7_scheme *sc);
+s7_pointer s7_set_current_output_port(s7_scheme *sc, s7_pointer p);
+s7_pointer s7_current_error_port(s7_scheme *sc);
+s7_pointer s7_set_current_error_port(s7_scheme *sc, s7_pointer port);
+
+s7_pointer s7_read(s7_scheme *sc, s7_pointer port);
+</pre>
+<p>Most of these correspond closely to the similarly named scheme function.  s7_port_filename
+returns the file associated with a file port.  s7_port_line_number returns position of the
+reader in an input file port.  The "use_write" parameter to s7_object_to_string refers
+to the write/display choice in scheme.  The string returned by s7_object_to_c_string
+should be freed by the caller.
+s7_output_string is the same as s7_get_output_string except that it returns an s7 string,
+not a C string.
+</p>
+<p>s7_open_input_function and s7_open_output_function
+call their "function" argument when input or output is requested.  The "read_choice"
+argument specifies to that function which of the input scheme functions called it.
+The intent of these two input functions is to give you complete control over IO.
+In the case of an input_function:
+</p>
+<pre class="indented">
+static s7_pointer my_read(s7_scheme *sc, s7_read_t peek, s7_pointer port)
+{
+  /* this function should handle input according to the peek choice */
+  return(s7_make_character(sc, '0'));
+}
+
+s7_pointer port;
+s7_int gc_loc;
+uint8_t c;
+port = s7_open_input_function(sc, my_read);
+gc_loc = s7_gc_protect(sc, port);
+c = s7_character(s7_read_char(sc, p1)); /* my_read "peek" == S7_READ_CHAR */
+if (last_c != '0') 
+   fprintf(stderr, "c: %c\n", c);
+s7_gc_unprotect_at(sc, gc_loc);
+</pre>
+
+
+<div class="shortheader" id="clets">Lets</div>
+<pre class="indented">
+s7_pointer s7_rootlet(s7_scheme *sc);
+s7_pointer s7_shadow_rootlet(s7_scheme *sc);
+s7_pointer s7_set_shadow_rootlet(s7_scheme *sc, s7_pointer let);
+
+s7_pointer s7_curlet(s7_scheme *sc);
+s7_pointer s7_set_curlet(s7_scheme *sc, s7_pointer e);
+
+s7_pointer s7_outlet(s7_scheme *sc, s7_pointer e);
+s7_pointer s7_sublet(s7_scheme *sc, s7_pointer let, s7_pointer bindings);
+s7_pointer s7_inlet(s7_scheme *sc, s7_pointer bindings);
+s7_pointer s7_varlet(s7_scheme *sc, s7_pointer let, s7_pointer symbol, s7_pointer value);
+
+s7_pointer s7_let_to_list(s7_scheme *sc, s7_pointer let);
+bool s7_is_let(s7_pointer e);
+s7_pointer s7_let_ref(s7_scheme *sc, s7_pointer let, s7_pointer symbol);
+s7_pointer s7_let_set(s7_scheme *sc, s7_pointer let, s7_pointer symbol, s7_pointer val);
+
+s7_pointer s7_starlet_ref(s7_scheme *sc, s7_pointer sym);
+s7_pointer s7_starlet_set(s7_scheme *sc, s7_pointer sym, s7_pointer new_value);
+/* the old confusing names for the same functions: */
+  s7_pointer s7_let_field_ref(s7_scheme *sc, s7_pointer symbol);
+  s7_pointer s7_let_field_set(s7_scheme *sc, s7_pointer symbol, s7_pointer new_value);
+
+s7_pointer s7_openlet(s7_scheme *sc, s7_pointer e);
+bool s7_is_openlet(s7_pointer e);
+s7_pointer s7_method(s7_scheme *sc, s7_pointer object, s7_pointer method);
+
+/* these might go away someday */
+s7_pointer s7_slot(s7_scheme *sc, s7_pointer symbol);
+s7_pointer s7_slot_value(s7_pointer slot);
+s7_pointer s7_slot_set_value(s7_scheme *sc, s7_pointer slot, s7_pointer value);
+s7_pointer s7_make_slot(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value);
+void s7_slot_set_real_value(s7_scheme *sc, s7_pointer slot, s7_double value);
+</pre>
+<p>Many of these are the same as the corresponding scheme function: s7_rootlet, s7_curlet, s7_outlet,
+s7_sublet, s7_inlet, s7_varlet, s7_let_to_list, s7_is_let, s7_let_ref, s7_let_set, s7_openlet,
+and s7_is_openlet.
+</p>
+<p>s7_starlet_ref and s7_starlet_set refer to *s7*, the let that holds various s7 settings.
+To get the current default print-length,
+</p>
+<pre class="indented">
+s7_integer(s7_starlet_ref(s7, s7_make_symbol(s7, "print-length")))
+</pre>
+<p>s7_method looks for a field in "object" with the name "method", a symbol.
+For example, in clm2xen.c, if mus-copy is called on an object that Snd does not
+immediately recognize (i.e. a generator), it looks for a mus-copy method, and
+if found, Snd calls it:
+</p>
+<pre class="indented">
+s7_pointer func; 
+func = s7_method(s7, gen, s7_make_symbol(s7, "mus-copy"));
+if (func != s7_undefined(s7))
+  return(s7_apply_function(s7, func, s7_list(s7, 1, gen))); 
+</pre>
+<p>The object searched can be anything that has an associated let: a c-object,
+a function or macro, a c-pointer, or of course a let.
+</p>
+<p>s7_set_curlet and the slot functions might go away someday.  They are currently used
+in Snd.  For the adventurous however, here's a sketchy description.
+A slot in s7 is a location in a let (a variable binding in an environment to use more standard terminology).
+s7_make_slot creates a slot in "env" with the given symbol and value.  s7_slot_value returns the value;
+s7_slot_set_value sets the value; s7_slot_set_real_value sets the mutable real value's numerical value.
+s7_slot takes a symbol and tries to find its currently active slot.  s7_set_curlet sets curlet, returning
+the previous curlet.
+</p>
+<p>s7_shadow_rootlet and s7_set_shadow_rootlet make it easier to import a let into rootlet.  This is also aimed
+at code that is defining lots of functions and variables, using the default functions like s7_define_variable
+that place things in the rootlet, but the code actually wants all those objects stored
+in a let other than rootlet.  
+</p>
+<pre class="indented">
+s7_pointer cur_env, old_shadow;
+cur_env = s7_curlet(sc);
+old_shadow = s7_set_shadow_rootlet(sc, cur_env);
+/* define everything here */
+s7_set_shadow_rootlet(sc, old_shadow);
+</pre>
+<p>s7_set_shadow_rootlet returns the previous shadow rootlet,
+so this turns the current environment into a shadow rootlet while defining functions, then restores
+the old rootlet. 
+Similarly notcurses_s7.c places everything in the *notcurses* let,
+but uses s7_set_shadow_rootlet to make these available in scheme as if they were in the rootlet:
+</p>
+<pre class="indented">
+  s7_pointer notcurses_let, old_shadow;
+  s7_define_constant(sc, "*notcurses*", notcurses_let = s7_inlet(sc, s7_nil(sc)));
+  old_shadow = s7_set_shadow_rootlet(sc, notcurses_let);
+  /* ... here we have all the s7_defines ... */
+  s7_set_shadow_rootlet(sc, old_shadow);
+</pre>
+
+<div class="shortheader" id="csymbols">Symbols</div>
+<pre class="indented">
+bool s7_is_symbol(s7_pointer p);
+const char *s7_symbol_name(s7_pointer p);
+s7_pointer s7_make_symbol(s7_scheme *sc, const char *name);
+s7_pointer s7_gensym(s7_scheme *sc, const char *prefix);
+
+bool s7_is_keyword(s7_pointer obj);
+s7_pointer s7_make_keyword(s7_scheme *sc, const char *key);
+s7_pointer s7_keyword_to_symbol(s7_scheme *sc, s7_pointer key);
+
+s7_pointer s7_name_to_value(s7_scheme *sc, const char *name);
+s7_pointer s7_symbol_value(s7_scheme *sc, s7_pointer sym);
+s7_pointer s7_symbol_set_value(s7_scheme *sc, s7_pointer sym, s7_pointer val);
+s7_pointer s7_symbol_local_value(s7_scheme *sc, s7_pointer sym, s7_pointer local_env);
+s7_pointer s7_symbol_initial_value(s7_pointer symbol); /* #_symbol's value */
+s7_pointer s7_symbol_set_initial_value(s7_scheme *sc, s7_pointer symbol, s7_pointer value);
+
+s7_pointer s7_symbol_table_find_name(s7_scheme *sc, const char *name);
+bool s7_for_each_symbol_name(s7_scheme *sc, bool (*symbol_func)(const char *symbol_name, void *data), void *data);
+bool s7_for_each_symbol(s7_scheme *sc,      bool (*symbol_func)(const char *symbol_name, void *data), void *data);
+</pre>
+<p>s7_is_symbol corresponds to scheme's symbol?, s7_symbol_name to symbol-&gt;string,
+s7_make_symbol is string-&gt;symbol,
+s7_gensym to gensym.  The gensym prefix is the optional argument to gensym in scheme.
+By default the prefix is "gensym", so the gensym-created symbols are of the form {gensym}-nnn
+where nnn is some number. s7_is_keyword is keyword?, s7_make_keyword is string-&gt;keyword,
+and s7_keyword_to_symbol is keyword-&gt;symbol.
+</p>
+<p>Normal symbols, and keywords do not need to be garbage-protected, but gensyms do.
+</p>
+<p>s7_symbol_to_value finds the current binding of the symbol (using its string name),
+and returns its value, similar to symbol-&gt;value.  To specify the environment in which to
+lookup the symbol, use s7_symbol_local_value.  s7_symbol_set_value sets the value of the
+symbol in its current binding.
+</p>
+<p>s7_symbol_table_find_name finds the symbol given its name.  s7_make_symbol is the same
+if the symbol already exists, but s7_symbol_find_by_name returns NULL if there isn't any
+symbol by that name.
+s7_for_each_symbol_name and s7_for_each_symbol traverse the symbol
+table, calling "symbol_func" on each symbol.  symbol_func is a boolean function that
+takes as arguments the symbol name and the void* data pointer.  The latter can carry
+along whatever state your function needs.  s7_for_each_symbol_name also includes some
+s7 constants like #f. 
+</p>
+<p>The C declaration above says s7_for_each_symbol is a C function that returns a boolean,
+and takes three arguments, an s7_scheme* pointer, a function (symbol_func), and a void* pointer
+(data).  The function passed (symbol_func) also returns a boolean, and takes two arguments, a char* (name),
+and the same void* pointer that was passed to s7_symbol_for_each.  If symbol_func returns true,
+the outer function immediately returns true, ending the symbol table traversal.
+Sketched in scheme, it might be:
+</p>
+<pre class="indented">
+(define (s7_for_each_symbol s7 symbol_func data)
+  (call-with-exit 
+    (lambda (return)
+      (for-each 
+        (lambda (symbol-name)
+          (if (symbol_func symbol-name data)
+              (return #t)))
+        (symbol-table))
+      #f)))
+</pre>            
+<p>An example is snd-completion.c.
+</p>
+
+
+<div class="shortheader" id="cnumbers">Numbers</div>
+<pre class="indented">
+bool s7_is_number(s7_pointer p);
+char *s7_number_to_string(s7_scheme *sc, s7_pointer obj, s7_int radix);
+
+bool s7_is_integer(s7_pointer p);
+s7_int s7_integer(s7_pointer p);
+s7_pointer s7_make_integer(s7_scheme *sc, s7_int num);
+s7_int s7_number_to_integer(s7_scheme *sc, s7_pointer x);
+s7_int s7_number_to_integer_with_caller(s7_scheme *sc, s7_pointer x, const char *caller);
+
+bool s7_is_real(s7_pointer p);
+s7_double s7_real(s7_pointer p);
+s7_pointer s7_make_real(s7_scheme *sc, s7_double num);
+s7_pointer s7_make_mutable_real(s7_scheme *sc, s7_double n);
+s7_double s7_number_to_real(s7_scheme *sc, s7_pointer x);
+s7_double s7_number_to_real_with_caller(s7_scheme *sc, s7_pointer x, const char *caller);
+s7_double s7_number_to_real_with_location(s7_scheme *sc, s7_pointer x, s7_pointer caller);
+
+bool s7_is_rational(s7_pointer arg);
+bool s7_is_ratio(s7_pointer arg);
+s7_pointer s7_make_ratio(s7_scheme *sc, s7_int a, s7_int b);
+s7_pointer s7_rationalize(s7_scheme *sc, s7_double x, s7_double error);
+s7_int s7_numerator(s7_pointer x);
+s7_int s7_denominator(s7_pointer x);
+
+bool s7_is_complex(s7_pointer arg);
+s7_pointer s7_make_complex(s7_scheme *sc, s7_double a, s7_double b);
+s7_double s7_real_part(s7_pointer z);
+s7_double s7_imag_part(s7_pointer z);
+
+s7_double s7_random(s7_scheme *sc, s7_pointer state);
+s7_pointer s7_random_state(s7_scheme *sc, s7_pointer seed);
+bool s7_is_random_state(s7_pointer p);
+s7_pointer s7_random_state_to_list(s7_scheme *sc, s7_pointer args);
+void s7_set_default_random_state(s7_scheme *sc, s7_int seed, s7_int carry);
+
+bool s7_is_bignum(s7_pointer obj);
+mpfr_t *s7_big_real(s7_pointer x);
+mpz_t *s7_big_integer(s7_pointer x);
+mpq_t *s7_big_ratio(s7_pointer x);
+mpc_t *s7_big_complex(s7_pointer x);
+s7_pointer s7_make_big_integer(s7_scheme *sc, mpz_t *val);
+s7_pointer s7_make_big_ratio(s7_scheme *sc, mpq_t *val);
+s7_pointer s7_make_big_real(s7_scheme *sc, mpfr_t *val);
+s7_pointer s7_make_big_complex(s7_scheme *sc, mpc_t *val);
+</pre>
+<p>Most of these correspond to the obvious scheme functions, so I'll 
+only touch on the less-obvious cases.
+s7_make_mutable_real returns a real number object whose value can be changed directly.
+In snd-sig.c, for example, we have a C procedure that applies a scheme function to
+every sound sample in an audio file.  We do not want to create a new object for the
+scheme function's argument list on every call!  So, we start by creating the mutable real:
+</p>
+<pre class="indented">
+yp = s7_make_slot(s7, e, arg, s7_make_mutable_real(s7, 1.5));
+</pre>
+<p>"e" is the let for the evaluation, "arg" is the real's name as a symbol in that let,
+and we make its initial value 1.5 (for no particular reason). Then on every sample, we
+call the function:
+</p>
+<pre class="indented">
+s7_slot_set_real_value(s7, yp, data[kp]); /* set yp's value to data[kp] */
+data[kp] = opt_func(s7, res);             /* call opt_func */
+</pre>
+<p>s7_number_to_real returns any real number as an s7_double.  If it can't
+convert its argument, it signals an error, which is annoying because it doesn't
+know where that error occured in scheme.  So s7_number_to_real_with_caller gives
+you a way to tell it at least the caller's name.  s7_number_to_real_with_location
+is the same function, but the caller argument is a s7 symbol or string (this is much faster
+than using a char*).
+</p>
+<p>For the bignum functions, see <a href="#gmpex">Bignums in C</a>.
+</p>
+
+
+<div class="shortheader" id="clists">Lists</div>
+<pre class="indented">
+bool s7_is_pair(s7_pointer p);
+s7_pointer s7_cons(s7_scheme *sc, s7_pointer a, s7_pointer b);
+
+s7_pointer s7_car(s7_pointer p);
+s7_pointer s7_cdr(s7_pointer p);
+s7_pointer s7_set_car(s7_pointer p, s7_pointer q);
+s7_pointer s7_set_cdr(s7_pointer p, s7_pointer q);
+s7_pointer s7_cadr(s7_pointer p);
+etc...
+
+bool s7_is_list(s7_scheme *sc, s7_pointer p);
+bool s7_is_proper_list(s7_scheme *sc, s7_pointer p);
+s7_pointer s7_make_list(s7_scheme *sc, s7_int length, s7_pointer initial_value);
+s7_int s7_list_length(s7_scheme *sc, s7_pointer a);
+s7_pointer s7_list(s7_scheme *sc, s7_int num_values, ...);
+s7_pointer s7_list_nl(s7_scheme *sc, s7_int num_values, ...);
+s7_pointer s7_array_to_list(s7_scheme *sc, s7_int num_values, s7_pointer *array);
+s7_pointer s7_list_ref(s7_scheme *sc, s7_pointer lst, s7_int num);
+s7_pointer s7_list_set(s7_scheme *sc, s7_pointer lst, s7_int num, s7_pointer val);
+
+s7_pointer s7_reverse(s7_scheme *sc, s7_pointer a);
+s7_pointer s7_append(s7_scheme *sc, s7_pointer a, s7_pointer b);
+s7_pointer s7_assoc(s7_scheme *sc, s7_pointer obj, s7_pointer lst);
+s7_pointer s7_assq(s7_scheme *sc, s7_pointer obj, s7_pointer x);
+s7_pointer s7_member(s7_scheme *sc, s7_pointer obj, s7_pointer lst);
+s7_pointer s7_memq(s7_scheme *sc, s7_pointer obj, s7_pointer x);
+bool s7_tree_memq(s7_scheme *sc, s7_pointer sym, s7_pointer tree);
+</pre>
+<p>These functions are mostly obvious: s7_car corresponds to scheme car, etc.
+s7_list_nl is a version of s7_list. s7_list will accept a list of arguments that does
+not fill the list (that is, "num_values" does not match the actual number of values),
+leaving null pointers that will later wreak havoc.  The list of arguments to s7_list_nl on the other hand must be
+null-terminated, and must match "num_values", or you'll get an error.
+s7_tree_memq is like s7_memq, but searches
+an entire tree structure. not just the top-level list.  s7_array_to_list takes
+an array of s7_pointers and returns a list of them (similar to s7_vector_to_list).
+</p>
+
+
+<div class="shortheader" id="cvectors">Vectors</div>
+<pre class="indented">
+s7_pointer s7_make_vector(s7_scheme *sc, s7_int len);
+s7_pointer s7_make_and_fill_vector(s7_scheme *sc, s7_int len, s7_pointer fill);
+s7_pointer s7_make_normal_vector(s7_scheme *sc, s7_int len, s7_int dims, s7_int *dim_info);
+bool s7_is_vector(s7_pointer p);
+
+s7_int s7_vector_length(s7_pointer vec);
+s7_int s7_vector_rank(s7_pointer vect);
+s7_int s7_vector_dimension(s7_pointer vec, s7_int dim);
+s7_pointer *s7_vector_elements(s7_pointer vec);
+s7_int s7_vector_dimensions(s7_pointer vec, s7_int *dims, s7_int dims_size);
+s7_int s7_vector_offsets(s7_pointer vec, s7_int *offs, s7_int offs_size);   
+ 
+void s7_vector_fill(s7_scheme *sc, s7_pointer vec, s7_pointer obj);
+s7_pointer s7_vector_copy(s7_scheme *sc, s7_pointer old_vect);
+s7_pointer s7_vector_to_list(s7_scheme *sc, s7_pointer vect);
+
+s7_pointer s7_make_int_vector(s7_scheme *sc, s7_int len, s7_int dims, s7_int *dim_info);
+s7_int *s7_int_vector_elements(s7_pointer vec);
+bool s7_is_int_vector(s7_pointer p);
+s7_int s7_int_vector_ref(s7_pointer vec, s7_int index);
+s7_int s7_int_vector_set(s7_pointer vec, s7_int index, s7_int value);
+
+s7_pointer s7_make_float_vector(s7_scheme *sc, s7_int len, s7_int dims, s7_int *dim_info);
+s7_pointer s7_make_float_vector_wrapper(s7_scheme *sc, s7_int len, s7_double *data, s7_int dims, s7_int *dim_info, bool free_data);
+s7_double *s7_float_vector_elements(s7_pointer vec);
+bool s7_is_float_vector(s7_pointer p);
+s7_double s7_float_vector_ref(s7_pointer vec, s7_int index);
+s7_double s7_float_vector_set(s7_pointer vec, s7_int index, s7_double value);
+
+s7_pointer s7_vector_ref(s7_scheme *sc, s7_pointer vec, s7_int index);
+s7_pointer s7_vector_set(s7_scheme *sc, s7_pointer vec, s7_int index, s7_pointer a);
+s7_pointer s7_vector_ref_n(s7_scheme *sc, s7_pointer vector, s7_int indices, ...);
+s7_pointer s7_vector_set_n(s7_scheme *sc, s7_pointer vector, s7_pointer value, s7_int indices, ...);
+</pre>
+<p>s7_make_vector returns a one-dimensional vector of the given length; its elements are initialized to the empty list, ().
+s7_make_and_fill_vector is similar, but the initial element is set by the "fill" parameter.  This value
+is simply placed in every vector location, not copied, so if you pass a cons, then change its car,
+that change is reflected in every element of the vector.
+s7_make_normal_vector returns a possibly multidimensional inhomogenous vector (a "normal" vector, as opposed to an int-vector or a float-vector).
+</p>
+<p>s7_is_vector is the same as vector?, s7_vector_length is length.
+s7_vector_rank returns the number of dimensions in a vector, and s7_vector_dimension returns
+the size of the given dimension. s7_vector_elements returns the s7_pointer array that holds
+that vector's elements.
+s7_vector_dimensions fills "dims" with the lengths of the corresponding dimensions.
+s7_vector_offsets does the same for the successive dimensional offsets.
+In a multidimensional vector, you can get the s7_vector_elements index by summing each index * offset[dimension].
+s7_vector_to_list is vector-&gt;list.  s7_vector_fill is fill! (as applied to a vector of course), and s7_vector_copy is copy.
+</p>
+<p>s7_make_int_vector returns an int-vector.  Its elements are s7_ints (int64_t), and the array of s7_ints can be accessed
+via s7_int_vector_elements.  Similarly for float-vectors (the elements are s7_doubles which
+are C doubles).  s7_make_float_vector_wrapper provides a way to pass a C array of doubles
+through scheme; it wraps up the array as a scheme float-vector.  Both s7_make_int_vector
+and s7_make_float_vector can return multidimensional vectors.  The "dims" parameter specifies
+the number of dimensions, and the "dim_info" parameter the individual dimensions.  If dims
+is 1, dim_info can be NULL.  If the s7_make_float_vector_wrapper "free_data" parameter is true, s7 will free the "data"
+array when the float-vector is garbage-collected. In ffitest.c, the g_block example calls:
+</p>
+<pre class="indented">
+v1 = s7_make_float_vector_wrapper(sc, len, g1-&gt;data, 1, NULL, false);
+</pre>
+<p>when checking if two blocks are equivalent.  Since this data is actually being shared
+with a block object, we don't want s7 to free it when the g_blocks_are_equivalent function
+is done.  g1-&gt;data is freed by g_block_free when the c-object is garbage collected.
+</p>
+<p>s7_vector_ref and s7_vector_set apply to one-dimensional vectors; the "_n" cases
+apply to multidimensional cases.  All four functions can be used on any type of vector.
+</p>
+
+
+<div class="shortheader" id="ccpointers">C-pointers</div>
+<pre class="indented">
+bool s7_is_c_pointer(s7_pointer arg);
+bool s7_is_c_pointer_of_type(s7_pointer arg, s7_pointer type);
+void *s7_c_pointer(s7_pointer p);
+void *s7_c_pointer_with_type(s7_scheme *sc, s7_pointer p, s7_pointer expected_type, const char *caller, s7_int argnum);
+s7_pointer s7_make_c_pointer(s7_scheme *sc, void *ptr);
+s7_pointer s7_make_c_pointer_with_type(s7_scheme *sc, void *ptr, s7_pointer type, s7_pointer info);
+s7_pointer s7_make_c_pointer_wrapper_with_type(s7_scheme *sc, void *ptr, s7_pointer type, s7_pointer info);
+s7_pointer s7_c_pointer_type(s7_pointer p);
+</pre>
+<p>These functions are equivalent to s7's c-pointer?, c-pointer, and c-pointer-type.
+C-pointers in s7 are aimed primarily at passing uninterpreted C pointers through
+s7 from one C function to another.  
+The "type" field can hold a type
+indication, useful in debugging.  s7_c_pointer_of_type checks that the c-pointer's
+type field matches the type passed as the second argument. As a convenience, 
+s7_c_pointer_with_type combines s7_c_pointer with s7_is_c_pointer_of_type,
+calling s7_error if the types don't match.
+Nothing else in s7 assumes the type field is actually a type symbol, so you
+can use the type and info fields for any purpose.
+s7_make_c_pointer_wrapper_with_type is akin to s7_make_string_wrapper (see below).
+It creates a temporary c_pointer object outside the heap and GC.
+</p>
+
+
+<div class="shortheader" id="cstrings">Strings</div>
+
+<pre class="indented">
+bool s7_is_string(s7_pointer p);
+const char *s7_string(s7_pointer p);
+s7_pointer s7_make_string(s7_scheme *sc, const char *str);
+s7_pointer s7_make_string_with_length(s7_scheme *sc, const char *str, s7_int len);
+s7_pointer s7_make_string_wrapper(s7_scheme *sc, const char *str);
+s7_pointer s7_make_string_wrapper_with_length(s7_scheme *sc, const char *str, s7_int len);
+s7_pointer s7_make_permanent_string(s7_scheme *sc, const char *str);
+s7_pointer s7_make_semipermanent_string(s7_scheme *sc, const char *str);
+s7_int s7_string_length(s7_pointer str);
+</pre>
+<p>These handle s7 strings.  s7_is_string corresponds to scheme's string?, 
+and s7_string_length to scheme's string-length. s7_string returns the scheme string's value as a C string.
+Don't free the returned string!  s7_make_string takes a C string, and returns its scheme
+equivalent.  s7_make_string_with_length is the same, but it is faster because you pass the
+new string's length (s7_make_string has to use strlen).  
+s7_make_permanent_string returns a scheme string that is not in the heap; it will never be GC'd or freed by s7.
+s7_make_semipermanent_string is similar, but the string will be freed if you call s7_free.
+s7_make_string_wrapper creates a temporary string.  This saves the overhead of getting a free cell
+from the heap and later GC-ing it, but the string may be reused at any time.  It is useful as
+an argument to s7_call and similar functions where you know no other strings will be needed
+during that call.  s7_make_string_wrapper_with_length is the same but passes in the string length.
+</p>
+
+
+<div class="shortheader" id="ccharacters">Characters</div>
+
+<pre class="indented">
+bool s7_is_character(s7_pointer p);
+uint8_t s7_character(s7_pointer p);
+s7_pointer s7_make_character(s7_scheme *sc, uint8_t c);
+</pre>
+
+<p>s7_is_character is equivalent to character?.  s7_character returns the unsigned char held by the s7 object p, 
+and s7_make_character returns an s7 object holding the unsigned char c.
+</p>
+
+
+<div class="shortheader" id="chashtables">Hash-tables</div>
+
+<pre class="indented">
+bool s7_is_hash_table(s7_pointer p);
+s7_pointer s7_make_hash_table(s7_scheme *sc, s7_int size);
+s7_pointer s7_hash_table_ref(s7_scheme *sc, s7_pointer table, s7_pointer key);   
+s7_pointer s7_hash_table_set(s7_scheme *sc, s7_pointer table, s7_pointer key, s7_pointer value);  
+</pre>
+<p>These functions are the C-side equivalent of hash-table?, make-hash-table, hash-table-ref,
+and hash-table-set!.
+</p>
+
+
+<div class="shortheader" id="citerators">Iterators</div>
+
+<pre class="indented">
+s7_pointer s7_make_iterator(s7_scheme *sc, s7_pointer e);
+bool s7_is_iterator(s7_pointer obj);
+bool s7_iterator_is_at_end(s7_scheme *sc, s7_pointer iter);
+s7_pointer s7_iterate(s7_scheme *sc, s7_pointer iter);
+</pre>
+<p>These are the C equivalents of make-iterator, iterator?, iterator-at-end?, and iterate.
+</p>
+
+
+<div class="shortheader" id="chooks">Hooks</div>
+<pre class="indented">
+s7_pointer s7_hook_functions(s7_scheme *sc, s7_pointer hook);
+s7_pointer s7_hook_set_functions(s7_scheme *sc, s7_pointer hook, s7_pointer functions);
+</pre>
+<p>These access the list of functions associated with a hook.  See <a href="#hooks">hooks</a>
+for a discussion of hooks, and <a href="#testhook">C and Scheme Hooks</a> for a short example.
+The scheme equivalent is hook-functions (a dilambda).
+</p>
+
+
+<div class="shortheader" id="cconstants">Constants</div>
+<pre class="indented">
+s7_pointer s7_f(s7_scheme *sc);
+s7_pointer s7_t(s7_scheme *sc);
+s7_pointer s7_nil(s7_scheme *sc);
+s7_pointer s7_undefined(s7_scheme *sc);
+s7_pointer s7_unspecified(s7_scheme *sc);
+s7_pointer s7_eof_object(s7_scheme *sc);
+
+bool s7_is_unspecified(s7_scheme *sc, s7_pointer val);
+bool s7_is_null(s7_scheme *sc, s7_pointer p);
+bool s7_is_boolean(s7_pointer x);
+
+bool s7_boolean(s7_scheme *sc, s7_pointer x);
+s7_pointer s7_make_boolean(s7_scheme *sc, bool x);
+
+bool s7_is_immutable(s7_pointer p);
+s7_pointer s7_immutable(s7_pointer p);
+</pre>
+<p>These return the standard scheme or s7 constants: #f, #t, (), #&lt;undefined&gt;, #&lt;unspecified&gt;, and #&lt;eof&gt;.
+Also the s7 function unspecified?, and the scheme functions null?, and boolean?.  s7_make_boolean
+returns #t or #f depending on its argument.
+</p>
+<p>s7_immutable makes its argument immutable, and s7_is_immutable returns true if its argument is immutable.
+They parallel s7's immutable! and immutable?.
+</p>
+
+
+<div class="shortheader" id="coptimizations">Optimization</div>
+
+<pre class="indented">
+typedef s7_double (*s7_d_t)(void);
+void s7_set_d_function(s7_scheme *sc, s7_pointer f, s7_d_t df);
+s7_d_t s7_d_function(s7_pointer f);
+etc...
+
+s7_pfunc s7_optimize(s7_scheme *sc, s7_pointer expr);
+</pre>
+
+<p>
+These functions tell s7 to call a foreign function directly, without any scheme-related
+overhead.  The function to be called in this manner needs to take the form of one of the s7_*_t functions in s7.h.  
+For example,
+one way to call + is to pass it two s7_double arguments and get an s7_double back.  This is the
+s7_d_dd_t function (the first letter gives the return type, the rest give successive argument types,
+d=double, i=integer, v=c_object, p=s7_pointer).
+We tell s7 about it via s7_set_d_dd_function.  Whenever s7's optimizer encounters + with two arguments
+that it (the optimizer) knows are s7_doubles, in a context where an s7_double result is expected,
+s7 calls the associated s7_d_dd_t function directly without preparing a list of arguments, and without
+wrapping up the result as an s7 object.
+</p>
+
+<p>Here is an example of using these functions; more extensive examples are in clm2xen.c in sndlib, and in s7.c.
+</p>
+<pre class="indented">
+static s7_pointer g_plus_one(s7_scheme *sc, s7_pointer args) 
+{
+  return(s7_make_integer(sc, s7_integer(s7_car(args)) + 1));
+}
+
+static s7_int plus_one(s7_int x) {return(x + 1);}
+
+s7_define_safe_function(sc, "plus1", g_plus_one, 1, 0, false, "");
+s7_set_i_i_function(sc, s7_name_to_value(sc, "plus1"), plus_one);
+</pre>
+<p>s7_define_safe_function defines a Scheme function "plus1",
+telling the optimizer that this function is safe.  
+A safe function does not push anything on the s7 stack, and treats the arglist 
+passed to it as immutable and temporary (that is, it just grabs the arguments from 
+the list).  A few s7_* functions are unsafe, and that makes anything that calls 
+them also unsafe.  If the optimizer knows a function is safe, it can use prebuilt
+lists to pass the arguments (saving in the GC), and can combine it in various 
+ways with other stuff.  If an unsafe function handles its argument list safely,
+declare it with s7_define_semisafe_typed_function.
+If the safe function knows its return and argument
+types, there is another level of optimization that can call it without 
+setting up an arglist or "unboxing" values, basically a direct call in C.
+In this example, the s7_set_i_i_function call
+tells the optimizer that if plus1 is seen in a context where the optimizer
+knows it is receiving an s7_int argument, and is expected to return
+an s7_int result, it can call plus_one directly, rather than g_plus_one.
+</p>
+
+<p>There are more of these functions in s7.c that could be exported via s7.h
+if you need them.
+</p>
+<p>By the way, to optimize scheme code (for speed), first use functions: the optimizer
+ignores anything else at the top level.  Then perhaps check lint.scm and the profiler.
+Don't use something dumb like call/cc.  Avoid append.  Use iteration, not recursion.
+Perhaps take the hot spot and do it in C.  callgrind might also be helpful, but it 
+can be hard to map from callgrind output to the original scheme code.
+</p>
+<p>s7_optimize is the third-level optimizer.  It is a bit hard to explain,
+but basically you pass it some scheme code, and it returns either NULL or a function that can be called
+to evaluate that code.  There are several examples in snd-sig.c.
+Here's an example where we want to call <code>(list 1 2 3)</code> a bazillion times:
+</p>
+<pre class="indented">
+#include &lt;stdlib.h&gt;
+#include &lt;stdio.h&gt;
+#include &lt;string.h&gt;
+#include "s7.h"
+int main(int argc, char **argv)
+{
+  s7_scheme *s = s7_init();
+  s7_pfunc f;
+  s7_pointer body;
+  s7_int gc_loc;
+  int i;
+  body = s7_list_nl(s, 4, s7_make_symbol(s, "list"),
+	                  s7_make_integer(s, 1),
+	                  s7_make_integer(s, 2),
+	                  s7_make_integer(s, 3),
+	                  NULL);
+  gc_loc = s7_gc_protect(s, body);
+  f = <em class="red">s7_optimize</em>(s, s7_list(s, 1, body));
+  if (!f) fprintf(stderr, "oops\n");
+  else
+    for (i = 0; i &lt; 2000000; i++)
+      <em class="red">f</em>(s);
+  s7_gc_unprotect_at(s, gc_loc);
+}
+</pre>
+<p>
+s7_optimize can also be used to take advantage of the direct
+C function calls mentioned above:
+</p>
+<pre class="indented">
+static s7_pointer g_d_func(s7_scheme *sc, s7_pointer args) 
+{
+  /* a normal C-defined s7 function that simply returns (scheme) 1.0 */
+  return(s7_make_real(sc, 1.0));
+}
+static s7_double opt_d_func(void) 
+{
+  /* a version of g_d_func that returns (C) 1.0 */
+  return(1.0);
+}
+
+/* now make it possible to call opt_d_func in place of g_d_func */
+s7_float_function func;
+s7_pointer symbol;
+
+symbol = s7_define_safe_function(sc, "d-func", g_d_func, 0, 0, false, "opt func");
+s7_set_d_function(sc, s7_name_to_value(sc, "d-func"), opt_d_func);
+
+/* and try it (this saves creating an s7 real, accessing its value, and GC-ing it eventually) */
+func = s7_float_optimize(sc, s7_list(sc, 1, s7_list(sc, 1, symbol)));
+fprintf(stderr, "%f\n", func(sc));
+</pre>
+
+
+<div class="shortheader" id="candsoon">And so on...</div>
+
+<pre class="indented">
+s7_scheme *s7_init(void);
+void s7_quit(s7_scheme *sc);
+void s7_free(s7_scheme *sc);
+void s7_repl(s7_scheme *sc);
+
+bool s7_is_eq(s7_pointer a, s7_pointer b);
+bool s7_is_eqv(s7_scheme *sc, s7_pointer a, s7_pointer b);
+bool s7_is_equal(s7_scheme *sc, s7_pointer a, s7_pointer b);
+bool s7_is_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y);
+
+void s7_provide(s7_scheme *sc, const char *feature);
+bool s7_is_provided(s7_scheme *sc, const char *feature);
+
+s7_pointer s7_stacktrace(s7_scheme *sc);
+
+s7_pointer s7_history(s7_scheme *sc);
+s7_pointer s7_add_to_history(s7_scheme *sc, s7_pointer entry);
+bool s7_history_enabled(s7_scheme *sc);
+bool s7_set_history_enabled(s7_scheme *sc, bool enabled);
+
+s7_pointer s7_dynamic_wind(s7_scheme *sc, s7_pointer init, s7_pointer body, s7_pointer finish);
+s7_pointer s7_make_continuation(s7_scheme *sc);
+s7_pointer s7_values(s7_scheme *sc, s7_pointer args);
+bool s7_is_multiple_value(s7_pointer obj);
+s7_pointer s7_copy(s7_scheme *sc, s7_pointer args);
+s7_pointer s7_fill(s7_scheme *sc, s7_pointer args);
+s7_pointer s7_type_of(s7_scheme *sc, s7_pointer arg);
+bool s7_is_syntax(s7_pointer p);
+bool s7_is_valid(s7_scheme *sc, s7_pointer arg);
+
+void (*s7_begin_hook(s7_scheme *sc))(s7_scheme *sc, bool *val);
+void s7_set_begin_hook(s7_scheme *sc, void (*hook)(s7_scheme *sc, bool *val));
+</pre>
+
+<p>s7_init creates a scheme interpreter.  The returned value is the s7_scheme* used by many of the FFI functions.
+s7_quit exits the interpreter.  The memory allocated for it by s7_init is not freed unless you call s7_free.
+(s7_free also frees its s7_scheme* argument, you may need to call s7_quit before s7_free to clean up the C stack,
+and as in multithreaded cases, global variables may need to be reinitialized after calling s7_free).
+s7_repl fires up a REPL.
+s7_is_eq and friends correspond to scheme's eq?, eqv?, equal?, and equivalent?.  s7_provide and s7_is_provided
+add a symbol to the *features* list, or check for its presence there.
+</p>
+<p>s7_stacktrace is like stacktrace; it currently ignores (*s7* 'stacktrace).
+The s7_history functions deal with the (*s7* 'history) buffer.
+s7_dynamic_wind is dynamic-wind in C.  The parameters "init", "body", and "finish" are
+the same as in scheme (i.e. #f or a thunk).  s7_make_continuation is call/cc; there
+is an <a href="#signal">example</a> above.
+s7_values is values, s7_copy is copy, s7_fill is fill!, s7_type_of is type-of, s7_is_syntax
+is syntax?. 
+</p>
+<p>s7_is_multiple_value returns true if its argument (a list) is the result of
+calling values or s7_values.  (values) returns a special object that is eq? to 
+#&lt;unspecified&gt; but not C == to it (that is, there are two things in s7 that
+represent the unspecified object, one being the result of calling values with no
+arguments).  (values obj) returns obj, which is not considered a multiple-value.
+Don't use s7_values in the new code portion of a C-side scheme macro definition
+(one from s7_define_macro).  Use the symbol 'values instead.
+</p>
+<p>s7_is_valid is a debugging aid; it tries to tell if an arbitrary value is pointing to
+an s7 object.  Set the compile-time switch TRAP_SEGFAULT to 1 before using this function!
+</p>
+<p>
+Finally, the begin_hook
+functions are explained <a href="#beginhook">above</a>.
+</p>
+
+<p>An example of s7_values:
+</p>
+<pre class="indented">
+static s7_pointer vals(s7_scheme *s, s7_pointer args)
+{
+  return(s7_values(s, args));
+}
+
+int main(int argc, char **argv) 
+{
+  s7_scheme *s = s7_init();
+  s7_define_function(s, "vals", vals, 0, 0, true, NULL);
+  s7_pointer e = s7_eval_c_string(s, "(+ (vals 1 2 3))");
+  s7_display(s, e, s7_current_output_port(s));
+  s7_newline(s, s7_current_output_port(s));
+}
+</pre>
+
+<br><br>
+
+
+
+<div class="topheader" id="s7examples">s7 examples</div>
+
+<p>The s7 tarball includes several scheme files:
+</p>
+<ul>
+  <li>case.scm provides case*, an extension of case for pattern matching
+  <li>cload.scm is a wrapper for the FFI stuff described above
+  <li>debug.scm provides various debugging aids such as trace, break, and watch
+  <li>json.scm is a JSON reader/writer, but I got side-tracked
+  <li>lint.scm is the s7 equivalent of the ancient C program named lint (modern equivalent: cppcheck)
+  <li>loop.scm is Rick Taube's CL loop macro
+  <li>mockery.scm has mock data libraries (openlets masquerading as various data types)
+  <li>profile.scm is a profiler
+  <li>r7rs.scm implements some of r7rs-small
+  <li>reactive.scm implements some reactive programming macros (set!, let)
+  <li>repl.scm is a vt-100 based repl
+  <li>nrepl.scm is a notcurses based repl
+  <li>s7test.scm is a regression test for s7
+  <li>stuff.scm is just some arbitrary stuff
+  <li>write.scm has a pretty printer
+</ul>
+<p>
+libc.scm, libgsl.scm, libm.scm, libdl.scm, notcurses_s7.c, libutf8proc.scm, and libgdbm.scm tie the associated
+libraries into s7.
+gdbinit has some gdb commands for s7. 
+</p>
+
+
+<div class="header" id="cload"><h4>cload.scm</h4></div>
+
+<p>cload.scm defines the macro c-define that reduces the overhead
+involved in (dynamically) linking C entities into s7.
+</p>
+
+<pre class="indented">
+(<em class=def id="definecfunction">c-define</em> c-info (prefix "") (headers ()) (cflags "") (ldflags "") output-name)
+</pre>
+
+<p>For example, <code>(c-define '(double j0 (double)) "m" "math.h")</code>
+links the C math library function j0 into s7 under the name m:j0, 
+passing it a double argument and getting a double result (a real in s7).
+</p>
+
+<p><em>prefix</em> is some arbitrary prefix that you want prepended to various names.
+</p>
+
+<p><em>headers</em> is a list of headers (as strings) that the c-info relies on, (("math.h") for example).
+</p>
+
+<p><em>cflags</em> are any special C compiler flags that are needed ("-I." in particular), and
+<em>ldflags</em> is the similar case for the loader.  <em>output-name</em> is the name of the
+output C file and associated library.  It defaults to "temp-s7-output" followed by a number.
+In libm.scm, it is set to "libm_s7" to protect it across cload calls.  If cload finds an
+up-to-date output C file and shared library, it simply loads the library, rather than
+going through all the trouble of writing and compling it.
+</p>
+
+<p><em>c-info</em> is a list that describes the C entities that you want to load into s7.
+It can be either one list describing one entity, or a list of such lists.
+Each description has the form:
+</p>
+
+<pre class="indented">
+(return-type entity-name-in-C (argument-type...))
+</pre>
+
+<p>where each entry is a symbol, and C names are used throughout.  So, in the j0
+example above, <code>(double j0 (double))</code> says we want access to j0, it returns
+a C double, and it takes one argument, also a C double.  s7 tries to figure out 
+what the corresponding s7 type is, but in tricky cases, you should tell it
+by replacing the bare type name with a list: <code>(C-type underlying-C-type)</code>.  For example,
+the Snd function set_graph_style takes an (enum) argument of type graph_style_t.
+This is actually an int, so we use <code>(graph_style_t int)</code> as the type:
+</p>
+
+<pre class="indented">
+(void set_graph_style ((graph_style_t int)))
+</pre>
+
+<p>If the C entity is a constant, then the descriptor list has just two entries,
+the C-type and the entity name: <code>(int F_OK)</code> for example. The entity name can also be a list:
+</p>
+
+<pre class="indented">
+((graph_style_t int) (GRAPH_LINES GRAPH_DOTS GRAPH_FILLED GRAPH_DOTS_AND_LINES GRAPH_LOLLIPOPS))
+</pre>
+
+<p>This defines all the names in the list as integers.
+If the C type has a space ("struct tm*"), use <code>(symbol "struct tm*")</code>
+to construct the corresponding symbol.
+</p>
+
+<p>The entity is placed in the current s7 environment under the name <code>(string-append prefix ":" name)</code>
+where the ":" is omitted if the prefix is null.  So in the j0 example, we get in s7 the function m:j0.
+c-define returns #t if it thinks the load worked, and #f otherwise.
+</p>
+
+<p>There are times when the only straightforward approach is to write the desired
+C code directly.  To insert C code on the fly, use (in-C "code..."). Two more such
+cases that come up all the time: C-function for linkage to functions written
+directly in s7 style using in-C, and C-macro for macros in the C header file that
+need to be wrapped in #ifdefs.
+Here are some examples:
+</p>
+
+<pre class="indented">
+;;; various math library functions
+(c-define '((double j0 (double)) 
+            (double j1 (double)) 
+            (double erf (double)) 
+            (double erfc (double))
+            (double lgamma (double)))
+          "m" "math.h")
+
+
+;;; getenv and setenv
+(c-define '(char* getenv (char*)))
+(c-define '(int setenv (char* char* int)))
+
+
+;;; file-exists? and delete-file
+(define file-exists? (let () ; define F_OK and access only within this let
+                       (c-define '((int F_OK) (int access (char* int))) "" "unistd.h") 
+                       (lambda (arg) (= (access arg F_OK) 0))))
+
+(define delete-file (let () 
+                      (c-define '(int unlink (char*)) "" "unistd.h") 
+                      (lambda (file) (= (unlink file) 0)))) ; 0=success
+
+
+;;; examples from Snd:
+(c-define '(char* version_info ()) "" "snd.h" "-I.")
+
+(c-define '(mus_float_t mus_degrees_to_radians (mus_float_t)) "" "snd.h" "-I.")
+
+(c-define '(snd_info* any_selected_sound ()) "" "snd.h" "-I.")
+(c-define '(void select_channel (snd_info* int)) "" "snd.h" "-I.")
+
+(c-define '(((graph_style_t int) (GRAPH_LINES GRAPH_DOTS GRAPH_FILLED GRAPH_DOTS_AND_LINES GRAPH_LOLLIPOPS)) 
+            (void set_graph_style ((graph_style_t int)))) 
+          "" "snd.h" "-I.")
+   
+
+;;; getcwd, strftime
+(c-define '(char* getcwd (char* size_t)) "" "unistd.h")
+
+(c-define (list '(void* calloc (size_t size_t))
+	        '(void free (void*))
+	        '(void time (time_t*)) ; ignore returned value
+	        (list (symbol "struct tm*") 'localtime '(time_t*))
+                (list 'size_t 'strftime (list 'char* 'size_t 'char* (symbol "struct tm*"))))
+          "" "time.h")
+
+&gt; (let ((p (calloc 1 8)) 
+        (str (make-string 32)))
+    (time p) 
+    (strftime str 32 "%a %d-%b-%Y %H:%M %Z" (localtime p))
+    (free p) 
+    str)
+<em class="gray">"Sat 11-Aug-2012 08:55 PDT\x00      "</em>
+
+
+;;; opendir, read_dir, closedir
+(c-define '((int closedir (DIR*))
+	    (DIR* opendir (char*))
+	    (in-C "static char *read_dir(DIR *p)  \
+                   {                              \
+                     struct dirent *dirp;          \
+                     dirp = readdir(p);            \
+                     if (!dirp) return(NULL);      \
+                     return(dirp-&gt;d_name);         \
+                   }")
+	    (char* read_dir (DIR*)))
+  "" '("sys/types.h" "dirent.h"))
+</pre>
+
+<p>C-init inserts its string argument into the initialization section of
+the module.  In libgsl.scm, for example,
+</p>
+<pre class="inserted">
+(C-init "gsl_set_error_handler(g_gsl_error);")
+</pre>
+<p>inserts that string (as C code) into libgsl_s7.c toward the beginning of the
+libgsl_s7_init function (line 42346 or so).
+</p>
+
+<p>When compiling, for the simple cases above, include "-ldl -Wl,-export-dynamic" in the gcc command.  So the first
+FFI example is built (this is in Linux):
+</p>
+
+<pre class="indented">
+gcc -c s7.c -I.
+gcc -o ex1 ex1.c s7.o -lm -I. -ldl -Wl,-export-dynamic
+ex1
+&gt; (load "cload.scm")
+<em class="gray">c-define-1</em>
+&gt; (c-define '(double j0 (double)) "m" "math.h")
+<em class="gray">#t</em>
+&gt; (m:j0 0.5)
+<em class="gray">0.93846980724081</em>
+</pre>
+
+<p>See also r7rs.scm, libc.scm, libgsl.scm, libm.scm, libdl.scm, and libgdbm.scm.
+libutf8proc.scm exists, but I have not tested it at all.
+</p>
+
+<p>The default in the lib*.scm files is to use the C name as the Scheme name.
+This collides with (for example) the widespread use of "-", rather than "_" in Scheme, but
+I have found it much more straightforward to stick with one name.  In cases like
+libgsl there are thousands of names, all documented at great length
+by the C name. Anyone who wants to use these functions has to start with the C name.
+If they are forced to fuss with some annoying Schemely translation of it, 
+the only sane response is: "forget it! I'll do it in C".
+</p>
+
+<div class="indented" id="libc">
+<pre>
+(require libc.scm)
+
+(define (copy-file in-file out-file)
+  (with-let (sublet *libc* :in-file in-file :out-file out-file)
+
+    ;; the rest of the function body exists in the *libc* environment, with the
+    ;;   function parameters in-file and out-file imported, so, for example,
+    ;;   (open ...) below calls the libc function open.  
+
+    (let ((infd (open in-file O_RDONLY 0)))
+      (if (= infd -1)
+	  (error 'io-error "can't find ~S~%" in-file)
+	  (let ((outfd (creat out-file #o666)))
+	    (if (= outfd -1)
+		(begin
+		  (close infd)
+		  (error 'io-error "can't open ~S~%" out-file))
+		(let* ((BUF_SIZE 1024)
+                       (buf (malloc BUF_SIZE)))
+		  (do ((num (read infd buf BUF_SIZE) (read infd buf BUF_SIZE)))
+		      ((or (&lt;= num 0)
+			   (not (= (write outfd buf num) num)))))
+		  (close outfd)
+		  (close infd)
+		  (free buf)
+		  out-file)))))))
+
+(define (glob-&gt;list pattern)
+  (with-let (sublet *libc* :pattern pattern)
+    (let ((g (glob.make))) 
+      (glob pattern 0 g) 
+      (let ((res (glob.gl_pathv g))) 
+	(globfree g) 
+	res))))
+
+;; now (load "*.scm") is (for-each load (glob-&gt;list "*.scm")) 
+
+;; a couple regular expression examples
+(with-let (sublet *libc*)
+  (define rg (regex.make))
+  (regcomp rg "a.b" 0)
+  (display (regexec rg "acb" 0 0)) (newline) ; 0 = match
+  (regfree rg))
+
+(with-let (sublet *libc*)
+  (define rg (regex.make))
+  (let ((res (regcomp rg "colou\\?r" 0)))
+    (if (not (zero? res))
+	(error 'regex-error "~S: ~S~%" "colou\\?r" (regerror res rg)))
+    (set! res (regexec rg "The color green" 1 0))
+    (display res) (newline)                ; #i(4 9) = match start/end
+    (regfree rg)))
+</pre>
+</div>
+
+
+<div class="indented" id="libgsl">
+<pre>
+(require libgsl.scm)
+
+(define (eigenvalues M)
+  (with-let (sublet *libgsl* :M M)
+    (let* ((len (sqrt (length M)))
+	   (gm (gsl_matrix_alloc len len))
+	   (m (float-vector-&gt;gsl_matrix M gm))
+	   (evl (gsl_vector_complex_alloc len))
+	   (evc (gsl_matrix_complex_alloc len len))
+	   (w (gsl_eigen_nonsymmv_alloc len)))
+      
+      (gsl_eigen_nonsymmv m evl evc w)
+      (gsl_eigen_nonsymmv_free w)
+      (gsl_eigen_nonsymmv_sort evl evc GSL_EIGEN_SORT_ABS_DESC)
+      
+      (let ((vals (make-vector len)))
+	(do ((i 0 (+ i 1)))
+	    ((= i len))
+	  (set! (vals i) (gsl_vector_complex_get evl i)))
+	(gsl_matrix_free gm)
+	(gsl_vector_complex_free evl)
+	(gsl_matrix_complex_free evc)
+	vals))))
+</pre>
+</div>
+
+<p>We can use gdbm (or better yet, mdb), the :readable argument to object-&gt;string, and
+the fallback methods in the environments to create name-spaces (lets) with billions of 
+thread-safe local variables, which can be saved and communicated between s7 runs:
+</p>
+<div class="indented" id="libgdbm">
+<pre>
+(require libgdbm.scm)
+
+(with-let *libgdbm*
+
+  (define *db* 
+    (openlet 
+     (inlet :file (gdbm_open "test.gdbm" 1024 GDBM_NEWDB #o664 
+		    (lambda (str) (format *stderr* "gdbm error: ~S~%" str)))
+
+	    :let-ref-fallback (lambda (obj sym)
+				(eval-string (gdbm_fetch (obj 'file) (symbol-&gt;string sym))))
+	    
+	    :let-set-fallback (lambda (obj sym val)
+				 (gdbm_store (obj 'file)
+					     (symbol-&gt;string sym)
+					     (object-&gt;string val :readable)
+					     GDBM_REPLACE)
+				 val)
+	    
+	    :make-iterator (lambda (obj)
+			     (let ((key #f)
+				   (length (lambda (obj) (expt 2 20))))
+			       (#_make-iterator
+                                (let ((+iterator+ #t))
+				  (openlet 
+				   (lambda ()
+				     (if key
+				         (set! key (gdbm_nextkey (obj 'file) (cdr key)))
+				         (set! key (gdbm_firstkey (obj 'file))))
+				     (if (pair? key)
+				         (cons (string-&gt;symbol (car key))
+					       (eval-string (gdbm_fetch (obj 'file) (car key))))
+				         key))))))))))
+
+  (set! (*db* 'str) "123") ; add a variable named 'str with the value "123"
+  (set! (*db* 'int) 432)
+
+  (with-let *db* 
+    (+ int (length str)))    ; -&gt; 435
+  (map values *db*)          ; -&gt; '((str . "123") (int . 432))
+
+  (gdbm_close (*db* 'file)))
+</pre>
+
+<!-- the overhead of using a data-base is not negligible, although libgdbm is probably not the fastest.
+     A bare set/ref 200000 times is .002 secs, via let-ref is .005, but via the data-base is .184.
+     Presumably thread globals won't be in inner loops, so even this looks ok, say 1 million / second.
+-->
+</div>
+
+
+
+<div class="header" id="case"><h4>case.scm</h4></div>
+
+<p>case.scm has case*, a compatible extension of case that includes pattern matching.
+<code>(case* selector ((target...) body) ...)</code> uses equivalent? to match the
+selector to the targets, evaluating the body associated with the first matching target.
+If a target is a list or vector, the elements are checked item by item.
+Each target, or element of a list or vector can be a pattern.  Patterns
+are of the form #&lt;whatever&gt; (undefined constants from s7's pointer of view).
+A pattern can be:
+</p>
+<pre>
+<ul>
+<li>#&lt;&gt;               any expr matches
+<li>#&lt;func&gt;           expr matches if (func expr)
+<li>#&lt;label:func&gt;     expr matches as above, expr is saved under "label"
+<li>#&lt;label:&gt;         any expr matches, and is saved under "label"
+<li>#&lt;label&gt;          expr must match the value saved under "label"
+<li>#&lt;...&gt;            skip exprs covered by the ellipsis
+<li>#&lt;label:...&gt;      skip as above, saved skipped exprs under "label" as a quoted list.
+<li>                  a pattern can have any number of labelled ellipses overall, 
+<li>                  but just one unnamed ellipsis, and only one ellipsis per pair or vector
+<li>#&lt;label,func:...&gt; a labelled ellipsis which matches if (func expr); expr is the ellipsis list,
+<li>                  label is not optional in this case
+<li>#&lt;"regexp"&gt;       pattern is a regular expression to be matched against a string
+<li>#&lt;label:"regexp"&gt; a labelled regular expression
+</ul>
+</pre>
+
+<p>If a label occurs in the result body, the expression it labelled is substituted for it.
+</p>
+
+<pre class="indented">
+(case* x ((3.14) 'pi))                ; returns 'pi if x is 3.14
+
+(case* x ((#&lt;symbol?&gt;)))              ; returns #t if x is a symbol
+
+(case* x (((+ 1 #&lt;symbol?&gt;))))        ; matches any list of the form '(+ 1 x) or any symbol in place of "x"
+
+(case* x (((#&lt;symbol?&gt; #&lt;e1:...&gt; (+ #&lt;e2:...&gt;)))
+          (append #&lt;e1&gt; #&lt;e2&gt;)))      ;  passed '(a b c d (+ 1 2)), returns '(b c d 1 2)
+
+(case* x ((#&lt;"a.b"&gt;)))                ; matches if x is a string "a.b" where "." matches anything
+
+(define (palindrome? x)
+  (case* x
+    ((() (#&lt;&gt;)) 
+     #t)
+    (((#&lt;start:&gt; #&lt;middle:...&gt; #&lt;start&gt;)) 
+     (palindrome? #&lt;middle&gt;))
+    (else #f)))
+</pre>
+
+<p>case*'s matching function can be used anywhere.
+</p>
+
+<pre class="indented">
+(let ((match? ((funclet 'case*) 'case*-match?))) ; this is case*'s matcher
+  (match? x '(+ #&lt;symbol?&gt; 1)))                  ; returns #t if x is of the form '(+ x 1), x any symbol
+
+(define match+
+  (let ((match? ((funclet 'case*) 'case*-match?))
+	(labels ((funclet 'case*) 'case*-labels))) ; these are the labels and their values
+    (macro (arg)
+      (cond ((null? arg) ())
+	    ((match? arg '(+ #&lt;a:&gt; (+ #&lt;b:...&gt;))) `(+ ,(labels 'a) ,@(cadr (labels 'b))))
+	    ((match? arg '(+ #&lt;&gt; #&lt;&gt;)) `(+ ,@(cdr arg)))
+	    (else #f)))))
+
+  ;; (match+ (+ 1 (+ 2 3))) -&gt; 6
+</pre>
+
+<p>See case.scm and s7test.scm for many more examples, including let and hash-table matching.
+</p>
+
+
+<div class="header" id="debug"><h4>debug.scm</h4></div>
+
+<p>debug.scm has various debugging aids, including trace, break, watch, and a C-style stacktrace.
+The *s7* field 'debug controls when these are active, and to what extent.
+</p>
+
+<p>(<em class="emdef">trace</em> func) adds a tracepoint to the start of the function or macro func.
+(trace) adds such tracing to every subsequently defined function or macro.
+(<em class="emdef">untrace</em>) turns off tracing; (untrace func) turns off tracing in func.
+Similarly (<em class="emdef">break</em> func) places a breakpoint at the start of func,
+(<em class="emdef">unbreak</em> func) removes it.  (unbreak) removes all breakpoints. 
+When a breakpoint is encountered, you are placed in a repl at
+that point; type C-q to continue.  To trace a variable, use
+(<em class="emdef">watch</em> var). watch reports whenever var is set! and
+(<em class="emdef">unwatch</em> var) removes the watchpoint.
+</p>
+
+<p>
+These trace, break and watchpoints are active
+only if <em class="emdef">(*s7* 'debug)</em> is positive.  If 'debug is 1, existing traces
+and breaks are active, but no new ones are added by s7.  If 'debug
+is 2, s7 adds tracepoints to any subsequently defined (i.e. named) functions and macros.
+If (*s7* 'debug) is 3, unnamed functions are also traced.
+If any tracing is enabled, you can get a C-style stacktrace by
+setting (<em class="emdef">debug-stack</em>) to a vector, then
+call (<em class="emdef">show-debug-stack</em>) to see the calls. 
+</p>
+
+<p>
+Besides debug-stack, debug.scm also defines the convenience functions
+<em class="emdef">debug-function</em>, <em class="emdef">debug-port</em>, and 
+<em class="emdef">debug-repl</em>.  debug-port is the debugger's
+output port, debug-repl drops into a repl at a breakpoint, and debug-function
+provides a way to customize the debugger's behavior.
+The function <em class="emdef">debug-frame</em> provides a way to examine local variables.
+</p>
+
+<pre class="indented">
+&gt; (define (g1 x) (+ x 1))
+<em class="gray">g1</em>
+&gt; (trace g1)   ; this loads debug.scm unless it's already loaded, and sets (*s7* 'debug) to 1
+<em class="gray">g1</em>
+&gt; (procedure-source g1) ; you can add trace-in explicitly (rather than call trace)
+<em class="gray">(lambda (x) (trace-in (curlet)) (+ x 1))</em>
+&gt; (g1 2)
+<em class="gray">(g1 2)</em>         ; file/line info is included if relevant
+<em class="gray">  -> 3
+3</em>
+&gt; (break g1)
+<em class="gray">g1</em>
+&gt; (g1 3)
+<em class="gray">break: (g1 3), C-q to exit break
+break> x</em>       ; this is a repl started at the breakpoint
+<em class="gray">3</em>
+break>  -> 4   ; C-q typed to exit the break
+<em class="gray">4</em>
+&gt; (define var 1)
+<em class="gray">1</em>
+&gt; (watch var)
+<em class="gray">#&lt;lambda (s v ...)&gt;</em>  ; this is the new setter for 'var
+&gt; (set! var 3)
+<em class="gray">var set! to 3
+3</em>
+&gt; (define lt (inlet 'a 3))
+<em class="gray">(inlet 'a 3)</em>
+&gt; (watch (lt 'a))
+<em class="gray">#&lt;lambda (s v ...)&gt;</em>
+&gt; (set! (lt 'a) 12)
+<em class="gray">let-set! a to 12
+12</em>
+</pre>
+
+<p>s7test.scm has more examples</p>
+
+
+
+<div class="header" id="lint"><h4>lint.scm</h4></div>
+
+<p>lint tries to find errors or infelicities in your scheme code.
+To try  it:
+</p>
+
+<pre class="indented">
+(load "lint.scm")
+(lint "some-code.scm")
+</pre>
+
+
+<p>
+There are several
+variables at the start of lint.scm to control additional output:
+</p>
+
+
+<pre class="indented">
+*report-unused-parameters*
+*report-unused-top-level-functions*
+*report-shadowed-variables*
+*report-undefined-identifiers*
+*report-multiply-defined-top-level-functions*
+*report-nested-if*
+*report-short-branch*
+*report-one-armed-if*
+*report-loaded-files*
+*report-any-!-as-setter*
+*report-doc-strings*
+*report-func-as-arg-arity-mismatch*
+*report-bad-variable-names*
+*report-built-in-functions-used-as-variables*
+*report-forward-functions*
+*report-sloppy-assoc*
+*report-bloated-arg*
+*report-clobbered-function-return-value*
+*report-boolean-functions-misbehaving*
+*report-repeated-code-fragments*
+*report-quasiquote-rewrites*
+*report-combinable-lets*
+</pre>
+
+<p>See lint.scm for more about these switches.  You can also extend lint by adding your own code,
+or adding your functions to lint's tables, or most simply by defining signatures for your functions.
+snd-lint.scm performs these tasks for Snd.  (lint exports its innards via *lint*).
+lint is not smart about functions defined outside the current file, so *report-undefined-variables*
+sometimes gets confused. You'll sometimes get a recommendation from lint that is less than helpful; nobody's perfect.
+If it's actually wrong, and not just wrong-headed, please let me know.
+Also in lint.scm are html-lint and C-lint.  html-lint reads an HTML file looking for
+Scheme code.  If any is found, it runs s7 and then lint over it, reporting troubles.
+Similarly C-lint reads a C file looking for s7_eval_c_string and running lint over its string.
+</p>
+
+<div class="header" id="schemerepl"><h4>repl.scm and nrepl.scm</h4></div>
+
+<p>There are three or four repls included with s7.
+repl.scm is a textual interface based on vt-100 codes, and nrepl.scm is an
+improvement of repl.scm based on the notcurses-core library.
+I'll treat repl.scm first, then discuss how nrepl differs from it.
+</p>
+
+<div class="separator"></div>
+
+<p>repl.scm implements a repl using vt100 codes and libc.scm.  It includes
+symbol and filename completion, a history buffer, paren matching,
+indentation, multi-line edits, and a debugger window.  
+To move around in the history buffer, use M-p, M-n or M-. (C-p and C-n are used to move the cursor in the current expression).  
+You can change the keymap or the prompt; all the repl functions are
+accessible through the *repl* environment.  One field is 'repl-let which
+gives you access to all the repl's internal variables and functions.
+Another is 'top-level-let, normally (sublet (rootlet)), which is the environment in
+which the repl's evaluation takes place.  You can reset the repl back to its
+starting point with: <code>(set! (*repl* 'top-level-let) (sublet (rootlet)))</code>.
+You can save the current repl state via <code>((*repl* 'save-repl))</code>, and
+restore it later via <code>((*repl* 'restore-repl))</code>.  The repl's saved state
+is in the file save.repl, or the filename can be passed as an argument to save-repl and restore-repl.
+</p>
+
+<p>There is one annoying consequence of using (sublet (rootlet)) for the top-level let:
+if you define something in the repl, then load a file that expects to find that thing
+in rootlet, it won't:
+</p>
+<pre class="indented">
+&lt;1&gt; (define (func x) (+ x 1)) ; func is in (sublet (rootlet))
+<em class="gray">func</em>
+&lt;2&gt; (load "use-func.scm") ; file contents: (display (func 3))
+<em class="red">error</em><em class="gray">: unbound variable func</em>
+</pre>
+<p>To get around this, either load the file into curlet: <code>(load "use-func.scm" (curlet))</code>,
+or use with-let to place the definition in rootlet: <code>(with-let (curlet) (define (func x) (+ x 1)))</code>.
+</p>
+
+<p>Meta keys are a problem on the Mac.  You can use ESC instead, but that requires
+super-human capacities.  I stared at replacement control keys, and nothing seemed
+right.  If you can think of something, it's easy to define replacements: see repl.scm
+which has a small table of mappings.
+</p>
+
+<p>To run the repl, either build s7 with the compiler flag -DWITH_MAIN,
+or conjure up a wrapper:
+</p>
+
+<pre class="indented">
+#include "s7.h"
+
+int main(int argc, char **argv)
+{
+  s7_scheme *sc = s7_init();
+  s7_load(sc, "repl.scm");
+  s7_eval_c_string(sc, "((*repl* 'run))");
+  return(0);
+}
+
+/* gcc -o r r.c s7.o -Wl,-export-dynamic -lm -I. -ldl
+ */
+</pre>
+
+<p>Besides evaluating s7 expressions, like any repl,
+you can also type shell commands just as in a shell:
+</p>
+
+<pre class="indented">
+&lt;1&gt; pwd
+<em class="gray">/home/bil/cl</em>
+&lt;2&gt; cd ..
+<em class="gray">/home/bil</em>
+&lt;3&gt; date
+<em class="gray">Wed 15-Apr-2015 17:32:24 PDT</em>
+</pre>
+
+<p>In most cases, these are handled through *unbound-variable-hook*, checked using "command -v", then passed
+to the underlying shell via the system function. 
+</p>
+
+<p>The prompt is set by the function (*repl* 'prompt).  It gets one argument,
+the current line number, and should set the prompt string and its length.
+</p>
+<pre class="indented">
+(set! (*repl* 'prompt) (lambda (num) 
+			 (with-let (*repl* 'repl-let)
+			   (set! prompt-string "scheme&gt; ") 
+			   (set! prompt-length (length prompt-string)))))
+</pre>
+<p>or, to use the red lambda example mentioned earlier:
+</p>
+<pre class="indented">
+(set! (*repl* 'prompt)
+      (lambda (num)
+	(with-let (*repl* 'repl-let)
+	  (set! prompt-string (bold (red (string #\xce #\xbb #\&gt; #\space))))
+	  (set! prompt-length 3)))) ; until we get unicode length calc
+</pre>
+
+<p>The line number provides a quick way to move around in the history buffer.
+To get a previous line without laboriously typing M-p over and over,
+simply type the line number (without control or meta bits), then M-.
+In some CL repls, the special variable '* holds the last value computed.
+In repl.scm, each value is retained in variables of the form '&lt;n&gt; where n
+is the number shown in the prompt.
+</p>
+
+<pre class="indented">
+&lt;1&gt; (+ 1 2)
+<em class="gray">3</em>
+&lt;2&gt; (* &lt;1&gt; 2)
+<em class="gray">6</em>
+</pre>
+
+<p>Here is an example of adding to the keymap:
+</p>
+<pre class="indented">
+(set! ((*repl* 'keymap) (integer-&gt;char 17)) ; C-q to quit and return to caller
+      (lambda (c)
+	(set! ((*repl* 'repl-let) 'all-done) #t)))
+</pre>
+
+<p>To access the meta keys (in the keymap), use a string:
+<code>((*repl* 'keymap) (string #\escape #\p))</code>; this is Meta-p which normally accesses
+the history buffer.  
+</p>
+
+<p>You can call the repl from other code, poke around in the current environment (or whatever),
+then return to the caller:
+</p>
+
+<pre class="indented">
+(load "repl.scm")
+
+(define (drop-into-repl e)
+  (let ((C-q (integer-&gt;char 17)))              ; we'll use the C-q example above to get out
+    (let ((old-C-q ((*repl* 'keymap) C-q))
+	  (old-top-level (*repl* 'top-level-let)))
+      (dynamic-wind
+	  (lambda ()
+	    (set! (*repl* 'top-level-let) e)
+	    (set! ((*repl* 'keymap) C-q)       
+		  (lambda (c)
+		    (set! ((*repl* 'repl-let) 'all-done) #t))))
+	  (lambda ()
+	    ((<em class=red>*repl* 'run</em>)))                   ; run the repl
+	  (lambda ()
+	    (set! (*repl* 'top-level-let) old-top-level)
+	    (set! ((*repl* 'keymap) C-q) old-C-q))))))
+
+(let ((x 32))
+  (format *stderr* "x: ~A~%" x)
+  (<em class=red>drop-into-repl</em> (curlet))
+  (format *stderr* "now x: ~A~%" x))
+</pre>
+
+<p>Now load that code and:
+</p>
+
+<pre class="indented">
+x: 32
+&lt;1&gt; x
+<em class="gray">32</em>
+&lt;2&gt; (set! x 91)
+<em class="gray">91</em>
+&lt;3&gt; x
+<em class="gray">91</em>
+&lt;4&gt; now x: 91  ; here I typed C-q at the prompt
+</pre>
+
+<p>Another possibility:
+</p>
+<pre class="indented">
+(set! (hook-functions *error-hook*) 
+      (list (lambda (hook) 
+              (apply format *stderr* (hook 'data)) 
+              (newline *stderr*)
+	      (drop-into-repl (owlet)))))
+</pre>
+
+<p>See the end of repl.scm for more examples.  See nrepl.scm for a better version of repl.scm.
+Eventually I'll probably retire repl.scm.
+</p>
+
+<!--
+(load "/home/bil/test/sndlib/libsndlib.so" (inlet 'init_func 's7_init_sndlib))
+-->
+
+
+<div class="separator"></div>
+
+<p>Unlike repl, nrepl has support for the mouse, traversable, scrollable, and resizable panes, built-in ties to
+lint.scm, debug.scm, and profile.scm, and various other enhancements.
+Since it includes all the libc, notcurses FFI code, and nrepl.scm at compile-time, there
+are no problems running it anywhere.  To build nrepl:
+</p>
+<pre class="indented">
+gcc -o nrepl s7.c -O2 -I. -Wl,-export-dynamic -lm -ldl -DWITH_MAIN -DWITH_NOTCURSES -lnotcurses-core
+</pre>
+<p>If that is too easy, try:
+</p>
+<pre class="indented">
+gcc -c s7.c -O2 -I. -Wl,-export-dynamic -lm -ldl
+gcc -o nrepl nrepl.c s7.o -lnotcurses-core -lm -I. -ldl
+</pre>
+<p>notcurses_s7.c needs version 2.1.6 or later of the notcurses-core library.
+</p>
+
+<p>When nrepl starts up, you have a prompt at the top of the terminal, and a status box
+at the bottom.  You can move around the pane via C-p and C-n (no need for repl.scm's M-p and M-n),
+or use the mouse, or the arrow keys.  If you set and hit a break point, a new pane is
+opened in the context of the break.  C-q exits the break.  At the top pane, C-q exits
+nrepl.  C-g gives you another prompt (handy if you're caught in a messed up expression).
+If you're in an infinite loop, C-c interrupts it.  Otherwise C-c exits nrepl.
+</p>
+
+<p>If you set up a watcher (via watch from debug.scm), the action is displayed in
+a separate box in the upper right corner.  The status box displays all sorts of
+informative and helpful messages, or at least that is the intent.  lint.scm
+checks each expression you type, and various hooks let you know when things
+are happening in the background.  Function signatures are posted there as well.
+</p>
+
+<p>You can customize nrepl in basically the same ways as described above for repl.scm.
+You can also place these in a file named ".nrepl"; if nrepl finds such a file, it
+loads it automatically at startup.
+</p>
+
+<br>
+<blockquote>
+<div class="indented">
+<p>After months of intense typing,
+Insanely declares his labors complete.  "Ship it!" says Mr Big, and hands
+him a million stock options. Meanwhile, in the basement behind an old door
+with the eldritch sign "eep Ou", in a labyrinth of pounding pipes and fluorescent lights,
+a forgotten shadow types <code>(lint "insanely-great.scm")</code>...
+</p>
+</div>
+</blockquote>
+
+
+</body>
+</html>
diff --git a/s7/s7test.scm b/s7/s7test.scm
new file mode 100644
index 0000000..bfee226
--- /dev/null
+++ b/s7/s7test.scm
@@ -0,0 +1,111174 @@
+;;; s7 test suite
+;;;
+;;; sources include
+;;;   clisp test suite
+;;;   sbcl test suite
+;;;   Paul Dietz's CL test suite (gcl/ansi-tests/*)
+;;;   R Kelsey, W Clinger, and J Rees r5rs.html (and r7rs.html)
+;;;   A Jaffer's r4rstest.scm (the inspiration for this...)
+;;;   guile test suite
+;;;   gauche test suite
+;;;   sacla test suite
+;;;   Kent Dybvig's "The Scheme Programming Language"
+;;;   Brad Lucier and Peter Bex
+;;;   GSL tests
+;;;   Abramowitz and Stegun, "Handbook of Mathematical Functions"
+;;;   the arprec package of David Bailey et al
+;;;   Maxima, William Schelter et al
+;;;   N Higham, "Accuracy and Stability of Numerical Algorithms"
+;;;   various mailing lists and websites (see individual cases below)
+
+(unless (defined? 'full-s7test)         ; snd-test has a variable named full-test, and includes this file
+  (define full-s7test #f))              ; this includes some time-consuming stuff
+(define with-bignums (provided? 'gmp))  ; scheme number has any number of bits
+					; we assume s7_double is double, and s7_int is int64_t
+                                        ;   a few of the bignum tests assume the default bignum-precision is 128
+					;   using a different default affects number->string primarily
+(define with-complex (provided? 'complex-numbers))
+(define with-windows (provided? 'windows))
+(define immutable-unquote (provided? 'immutable-unquote))
+
+(unless (defined? 's7test-exits)
+  (define s7test-exits #t)) ; use (with-let (rootlet) (define s7test-exits #f)) if using repl
+(unless (defined? 'asan-flags)
+  (define asan-flags ""))
+
+(define username (getenv "USER"))
+
+(unless (defined? 'most-positive-fixnum)
+  (define-constant most-positive-fixnum (*s7* 'most-positive-fixnum))
+  (define-constant most-negative-fixnum (*s7* 'most-negative-fixnum)))
+
+(set! (*s7* 'print-length) 32) ; old default, changed to 12 to match Snd, 23-Jul-21
+
+;(set! (hook-functions *load-hook*) (list (lambda (hook) (format () "loading ~S...~%" (hook 'name)))))
+
+;;; to loop s7test under gdb until it crashes:
+#|
+gdb repl
+set pagination off
+break _exit
+commands
+run
+end
+;;; repl.c can randomize *s7* parameters before calling s7_load
+|#
+
+;;; ---------------- pure-s7 ----------------
+(define pure-s7 (provided? 'pure-s7))
+(when pure-s7
+  (define (make-polar mag ang)
+    (if (and (real? mag) (real? ang))
+	(complex (* mag (cos ang)) (* mag (sin ang)))
+	(error 'wrong-type-arg "make-polar args should be real")))
+  (define make-rectangular complex)
+
+  (define (char-ci=? . chars) (apply char=? (map char-upcase chars)))
+  (define (char-ci<=? . chars) (apply char<=? (map char-upcase chars)))
+  (define (char-ci>=? . chars) (apply char>=? (map char-upcase chars)))
+  (define (char-ci<? . chars) (apply char<? (map char-upcase chars)))
+  (define (char-ci>? . chars) (apply char>? (map char-upcase chars)))
+
+  (define (string-ci=? . strs) (apply string=? (map string-upcase strs)))
+  (define (string-ci<=? . strs) (apply string<=? (map string-upcase strs)))
+  (define (string-ci>=? . strs) (apply string>=? (map string-upcase strs)))
+  (define (string-ci<? . strs) (apply string<? (map string-upcase strs)))
+  (define (string-ci>? . strs) (apply string>? (map string-upcase strs)))
+
+  (define (list->string lst) (apply string lst))
+  (define (list->vector lst) (apply vector lst))
+
+  (define (let->list e)
+    (if (let? e)
+	(reverse! (map values e))
+	(error 'wrong-type-arg "let->list argument should be an environment: ~A" str)))
+
+  (define* (string->list str (start 0) end)
+    (if (and (string? str)
+	     (integer? start)
+	     (not (negative? start))
+	     (or (not end)
+		 (and (integer? end)
+		      (>= end start))))
+	(map values (substring str start (or end (length str))))
+	(error 'wrong-type-arg "string->list argument should be a string: ~A" str)))
+
+  (define (string-length str)
+    (if (string? str)
+	(length str)
+	(if (and (openlet? str)
+		 (defined? 'string-length str #t))
+	    ((let-ref str 'string-length) str)
+	    (error 'wrong-type-arg "string-length argument should be a string: ~A" str))))
+
+  (define (string-fill! str chr . args)
+    (if (string? str)
+	(apply fill! str chr args)
+	(if (and (openlet? str)
+		 (defined? 'string-fill str #t))
+	    (apply (let-ref str 'string-fill!) str chr args)
+	    (error 'wrong-type-arg "string-fill! argument should be a string: ~A" str))))
+
+  (define* (vector->list vect (start 0) end) ; this ignores (*s7* 'max-list-length)
+    (if (and (vector? vect)
+	     (integer? start)
+	     (not (negative? start))
+	     (or (not end)
+		 (and (integer? end)
+		      (>= end start))))
+	(if start
+	    (let ((stop (or end (length vect))))
+	      (if (= start stop)
+		  ()
+		  (map values (subvector vect start stop))))
+	    (map values vect))
+	(error 'wrong-type-arg "vector->list argument should be a vector: ~A" vect)))
+
+  (define (vector-length vect)
+    (if (vector? vect)
+	(length vect)
+	(error 'wrong-type-arg "vector-length argument should be a vector: ~A" vect)))
+
+  (define (vector-fill! vect val . args)
+    (if (vector? vect)
+	(apply fill! vect val args)
+	(error 'wrong-type-arg "vector-fill! argument should be a vector: ~A" str)))
+
+  (define (vector-append . args)
+    (if (null? args)
+	#()
+	(if (vector? (car args))
+	    (apply append args)
+	    (error 'wrong-type-arg "vector-append arguments should be vectors: ~A" args))))
+
+  (define* (char-ready? p)
+    (and p (not (input-port? p))
+	 (error 'wrong-type-arg "char-ready? arg should be an input port")))
+
+  (define (set-current-output-port port) (error 'undefined-function "set-current-output-port is not in pure-s7"))
+  (define (set-current-input-port port) (error 'undefined-function "set-current-input-port is not in pure-s7"))
+
+  (define (exact? n)
+    (if (number? n)
+	(rational? n)
+	(if (and (openlet? n)
+		 (defined? 'exact? n #t))
+	    ((let-ref n 'exact?) n)
+	    (error 'wrong-type-arg "exact? argument should be a number: ~A" n))))
+
+  (define (inexact? x)
+    (if (number? x)
+	(not (rational? x))
+	(if (and (openlet? n)
+		 (defined? 'inexact? n #t))
+	    ((let-ref n 'inexact?) n)
+	    (error 'wrong-type-arg "inexact? argument should be a number: ~A" x))))
+
+  (define (inexact->exact x)
+    (if (not (number? x))
+	(error 'wrong-type-arg "inexact->exact argument should be a number: ~A" x)
+	(if (rational? x)
+	    x
+	    (rationalize x))))
+
+  (define (exact->inexact x)
+    (if (number? x)
+	(* x 1.0)
+	(error 'wrong-type-arg "exact->inexact argument should be a number: ~A" x)))
+
+  (define (integer-length i)
+    (if (integer? i)
+	(if (memv i '(9223372036854775807 -9223372036854775808))
+	    63
+	    (ceiling (log (if (< i 0) (- i) (+ i 1)) 2)))
+	(if (and (openlet? i)
+		 (defined? 'integer-length i #t))
+	    ((let-ref i 'integer-length) i)
+	    (error 'wrong-type-arg "integer-length argument should be an integer: ~A" x))))
+
+  (define-macro (call-with-values producer consumer) `(,consumer (,producer)))
+
+  (define-macro (multiple-value-bind vars expression . body)   ; named "receive" in srfi-8 which strikes me as perverse
+    (if (or (symbol? vars) (negative? (length vars)))
+	`((lambda ,vars ,@body) ,expression)
+	`((lambda* (,@vars . ,(gensym)) ,@body) ,expression)))
+
+  (define-macro (multiple-value-set! vars expr . body)
+    (let ((local-vars (map (lambda (n) (gensym)) vars)))
+      `((lambda* (,@local-vars . ,(gensym))
+	  ,@(map (lambda (n ln) `(set! ,n ,ln)) vars local-vars)
+	  ,@body)
+	,expr)))
+
+  (define-macro (cond-expand . clauses)
+    (letrec ((traverse (lambda (tree)
+			 (if (pair? tree)
+			     (cons (traverse (car tree))
+				   (if (null? (cdr tree)) () (traverse (cdr tree))))
+			     (if (memq tree '(and or not else))
+				 tree
+				 (and (symbol? tree) (provided? tree)))))))
+      `(cond ,@(map (lambda (clause)
+		      (cons (traverse (car clause))
+			    (if (null? (cdr clause)) '(#f) (cdr clause))))
+		    clauses))))
+  )
+;;; ---------------- end pure-s7 ----------------
+
+(define-macro (defmacro name args . body) `(define-macro ,(cons name args) ,@body))
+(define-macro (defmacro* name args . body) `(define-macro* ,(cons name args) ,@body))
+
+(define tmp-output-file "tmp1.r5rs")
+(define tmp-data-file "test.dat")
+(define bold-text (format #f "~C[1m" #\escape))
+(define unbold-text (format #f "~C[22m" #\escape))
+(set! (hook-functions *unbound-variable-hook*) ())
+(set! (hook-functions *missing-close-paren-hook*) ())
+(define s7test-output #f) ; if a string, it's treated as a logfile
+
+;(set! (*s7* 'gc-stats) 4) ; 4=stack
+;(set! (*s7* 'undefined-identifier-warnings) #t)
+
+;(set! (*s7* 'debug) 2)
+;(set! ((funclet trace-in) '*debug-port*) #f)
+;(set! (*s7* 'profile) 1)
+
+(define old-stdin *stdin*)
+(define old-stdout *stdout*)
+(define old-stderr *stderr*)
+(define *max-arity* #x20000000)
+
+(define (-s7-stack-top-) (*s7* 'stack-top))
+
+(when full-s7test
+  (system "rm libc_s7.*")
+  (system "rm libgdbm_s7.*")
+  (system "rm libgsl_s7.*")
+  (system "rm libm_s7.*"))
+
+
+;;; --------------------------------------------------------------------------------
+
+(if (and (defined? 'current-time) ; in Snd
+	 (defined? 'mus-rand-seed))
+    (set! (mus-rand-seed) (current-time)))
+
+(define (ok? otst ola oexp)
+  (let ((result (catch #t ola
+		       (lambda (type info)
+			 (if (not (eq? oexp 'error))
+			     (begin (apply format #t info) (newline)))
+			 'error))))
+    (if (not (equal? result oexp))
+	(format #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) otst result oexp))))
+
+(define original-test-macro #f)
+
+(unless (defined? 'test)
+  (set! original-test-macro #t)
+  (define-macro (test tst expected) ;(display tst *stderr*) (newline *stderr*)
+    ;; `(ok? ',tst (lambda () (eval-string (format #f "~S" ',tst))) ,expected))
+    ;; `(ok? ',tst (lambda () (eval ',tst)) ,expected))
+    ;; `(ok? ',tst (lambda () ,tst) ,expected))
+    ;; `(ok? ',tst (lambda () (eval-string (object->string ,tst :readable))) ,expected))
+    ;; `(ok? ',tst (let () (define (_s7_) ,tst)) ,expected))
+    ;; `(ok? ',tst (lambda () (let ((_s7_ #f)) (set! _s7_ ,tst))) ,expected))
+    ;; `(ok? ',tst (lambda () (let ((_s7_ ,tst)) _s7_)) ,expected))
+    ;; `(ok? ',tst (catch #t (lambda () (lambda* ((_a_ ,tst)) _a_)) (lambda any (lambda () 'error))) ,expected))
+    ;; `(ok? ',tst (lambda () (do ((_a_ ,tst)) (#t _a_))) ,expected))
+    ;; `(ok? ',tst (lambda () (call-with-exit (lambda (_a_) (_a_ ,tst)))) ,expected))
+    ;; `(ok? ',tst (lambda () (values ,tst)) ,expected))
+    ;; `(ok? ',tst (lambda () (define (_s7_ _a_) _a_) (_s7_ ,tst)) ,expected))
+    ;; `(ok? ',tst (lambda () (define* (_s7_ (_a_ #f)) (or _a_)) (_s7_ ,tst)) ,expected))
+    ;; `(ok? ',tst (lambda () (caadr (catch 'receive (lambda () (throw 'receive ,tst)) (lambda any any)))) ,expected))
+    ;; `(ok? ',tst (lambda () (stacktrace (- (random 100) 50) (- (random 100) 50) (- (random 100) 50) (- (random 100) 50) (> (random 100) 50)) ,tst) ,expected))
+    (list 'ok? (list quote tst) (list-values lambda () tst) expected))
+#|
+      `(let ((_result_ #f))
+	 (define (stest) (set! _result_ ,tst))
+	 (catch #t stest
+		(lambda args
+		  (set! _result_ 'error)))
+	 (if (not (equal? _result_ ,expected))
+	     (format #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) ',tst _result_ ,expected))))
+|#
+    )
+
+(define (tok? otst ola)
+  (let* ((data #f)
+	 (result (catch #t ola
+			(lambda args
+			 (set! data args)
+			 'error))))
+    (if (or (not result)
+	    (eq? result 'error))
+	(format #t "~A: ~A got ~S ~A~%~%" (port-line-number) otst result (or data "")))))
+
+(define-macro (test-t tst) ;(display tst *stderr*) (newline *stderr*)
+  `(tok? ',tst (lambda () ,tst)))
+
+(define-macro (test-e tst op arg) ;(display tst *stderr*) (newline *stderr*)
+  `(let ((result (catch #t (lambda () ,tst)
+			(lambda args
+			 'error))))
+     (if (not (eq? result 'error))
+	 (format #t "~A: (~A ~S) got ~S but expected 'error~%~%" (port-line-number) ,op ,arg result))))
+
+
+(define (op-error op result expected)
+  (case op
+    ((acosh)
+     (/ (magnitude (- (cosh result) (cosh expected)))
+	(max 0.001 (magnitude (cosh expected)))))
+    ((asin)
+     (/ (min (magnitude (- (sin result) (sin expected)))
+	     (magnitude (- result expected)))
+	(max 0.001 (* 10 (magnitude (sin expected))))))
+    ((acos)
+     (/ (min (magnitude (- (cos result) (cos expected)))
+	     (magnitude (- result expected)))
+	(max 0.001 (magnitude (cos expected)))))
+    ((asinh)
+     (/ (magnitude (- (sinh result) (sinh expected)))
+	(max 0.001 (magnitude (sinh expected)))))
+    ((atanh)
+     (/ (min (magnitude (- (tanh result) (tanh expected)))
+	     (magnitude (- result expected)))
+	(max 0.001 (magnitude (tanh expected)))))
+    ((atan)
+     (/ (min (magnitude (- (tan result) (tan expected)))
+	     (magnitude (- result expected)))
+	(max 0.001 (magnitude (tan expected)))))
+    ((cosh)
+     (/ (min (magnitude (- result expected))
+	     (magnitude (+ result expected)))
+	(max 0.001 (magnitude expected))))
+    (else (/ (magnitude (- result expected)) (max 0.001 (magnitude expected))))))
+
+
+;;; relative error (/ (abs (- x res) (abs x)))
+
+(define (number-ok? tst result expected)
+  (unless (eqv? result expected)
+    (if (or (not (number? result))
+	    (not (eq? (nan? expected) (nan? result)))
+	    (and (pair? tst)
+		 (> (/ (magnitude (- result expected)) (max 0.001 (magnitude expected))) 1e-5)
+		 (> (op-error (car tst) result expected) 1e-5)))
+      (format #t "~A: ~A got ~A~Abut expected ~A~%~%"
+		     (port-line-number) tst result
+		     (if (and (rational? result) (not (rational? expected)))
+			 (format #f " (~A) " (* 1.0 result))
+			 " ")
+		     expected))))
+
+(define (nok? otst ola oexp)
+  (let ((result (catch #t ola
+		       (lambda args
+			 'error))))
+    (number-ok? otst result oexp)))
+
+(if (not (defined? 'num-test))
+    (define-macro (num-test tst expected) ;(display tst *stderr*) (newline *stderr*)
+      ;; `(nok? ',tst  (lambda () ,tst) ,expected))
+      ;; `(nok? ',tst (let () (define (_s7_) ,tst)) ,expected))
+      (list-values 'nok? (list-values quote tst) (list-values lambda () tst) expected)))
+
+(define-macro (num-test-1 proc val tst expected)
+  `(let ((result (catch #t (lambda () ,tst)
+			(lambda args
+			 'error))))
+     (number-ok? (list ,proc ,val) result ,expected)))
+
+(define-macro (num-test-2 proc val1 val2 tst expected)
+  `(let ((result (catch #t (lambda () ,tst)
+			(lambda args
+			 'error))))
+     (number-ok? (list ,proc ,val1 ,val2) result ,expected)))
+
+(define (string-wi=? s1 s2) ; string=? ignoring white-space
+  (let ((iter1 (make-iterator s1))
+	(iter2 (make-iterator s2)))
+    (let wi-loop ((i1 (iterate iter1)) (i2 (iterate iter2)))
+      (if (eq? i1 i2)
+	  (or (eq? i1 #<eof>)
+	      (wi-loop (iterate iter1) (iterate iter2)))
+	  (if (and (char? i1)
+		   (char-whitespace? i1))
+	      (wi-loop (iterate iter1) i2)
+	      (and (char? i2)
+		   (char-whitespace? i2)
+		   (wi-loop i1 (iterate iter2))))))))
+
+(test (string-wi=? "" "") #t)
+(test (string-wi=? "" " ") #t)
+(test (string-wi=? "" " a") #f)
+(test (string-wi=? "a" " a") #t)
+(test (string-wi=? "a " " a") #t)
+(test (string-wi=? " a " "a") #t)
+(test (string-wi=? " a " " a") #t)
+(test (string-wi=? "\n a\n " "a") #t)
+(test (string-wi=? "aa" " a") #f)
+(test (string-wi=? "aa" " a a ") #t)
+(test (string-wi=? "aa" "aa ") #t)
+
+;; ----------------
+
+(define-macro (test-wi tst res)
+  `(let ((val ,tst))
+     (unless (string-wi=? val ,res)
+       (format *stderr* "~A: ~S got ~S but expected ~S~%" (port-line-number) ',tst val ,res))))
+
+;; ----------------
+
+(define (reinvert n op1 op2 arg)
+  (let ((body (op2 (op1 arg))))
+    (do ((i3 1 (+ i3 1)))
+	((= i3 n) body)
+      (set! body (op2 (op1 body))))))
+
+(define (recompose n op arg)
+  (define (recompose-1 n)
+    (if (= n 1)
+	(op arg)
+	(op (recompose-1 (- n 1)))))
+  (recompose-1 n))
+
+(if (setter 'val) (set! (setter 'val) #f)) ; might get here from snd-test
+
+(define _ht_ (make-hash-table))
+(define _undef_ (car (with-input-from-string "(#_asdf 1 2)" read)))
+
+
+;;; --------------------------------------------------------------------------------
+;;; some coverage tests that are bolixed-up by methods below (these tests actually belong elsewhere)
+;;;   vector_set_p_pip always goes to unchecked or vector_set_p_ppp?
+
+(let ()
+  (define (h1 size) ; vector_ref_p_pi from tvect, put here since 'vector-ref is methodized below
+    (let ((v (make-vector size)))
+      (do ((i 0 (+ i 1)))
+	  ((= i size) (vector-ref v 0))
+	(vector-set! v i 2))))
+  (test (h1 2) 2))
+
+(let () ; g_dynamic_wind_init from texit
+  (define (dwfib n)
+    (dynamic-wind
+	(lambda ()
+	  (if (negative? n) (display "oops")))
+	(lambda ()
+	  (if (<= n 2)
+	      n
+	      (+ (dwfib (- n 1))
+		 (dwfib (- n 2)))))
+	#f))
+  (test (dwfib 5) 8))
+
+(let () ; g_dynamic_wind_body
+  (define (dw size)
+    (do ((i 0 (+ i 1))
+	 (x 0))
+	((= i size) x)
+      (dynamic-wind #f (lambda () (set! x i)) #f)))
+  (test (dw 2) 1))
+
+(let () ; stop_is_safe from tfft
+  (define (f)
+    (let ((i 0) (n 2))
+      (do ((k 0 (+ k 1))) ((= k 1) i)
+        (do () ((>= i n)) (set! i (+ i 1))))))
+  (test (f) 2))
+
+(let ()
+  (define (cpy1 x y) ; opt_dox, copy_if_end_ok tcopy
+    (do ((i 0 (+ i 1))
+	 (len (length x)))
+	((= i len) y)
+      (int-vector-set! y i (int-vector-ref x i))))
+  (let ((x (make-int-vector 1 123))
+	(y (make-int-vector 1 0)))
+    (cpy1 x y)
+    (test y (make-int-vector 1 123))))
+
+(let () ; list_increment_p_pip_unchecked tref
+  (define (ft7)
+    (let ((size 4))
+      (let ((v (make-list size 0)))
+	(do ((i 0 (+ i 1)))
+	    ((= i 1))
+	  (do ((j 0 (+ j 1)))
+	      ((= j size))
+	    (set! (v j) (+ (v j) 1))))
+	v)))
+  (test (ft7) (list 1 1 1 1)))
+
+(let ((v #2d((3 2 1) (6 5 4))) (b1 1) (b2 0)) ; vector_ref_p_pii
+  (define (f) (do ((val 0) (i 0 (+ i 1))) ((= i 1) val) (set! val (real-part (v b1 b2)))))
+  (test (f) 6))
+
+(let ((v #2d((3 2 1) (6 5 4))) (b1 0) (b2 0)) ; vector_ref_p_pii_direct
+  (define (f) (do ((val 0) (i 0 (+ i 1))) ((= i 1) val) (set! val (real-part (v (+ b1 1) b2)))))
+  (test (f) 6))
+
+(test (eval-string "#2d(1 2)") 'error) ;reading constant vector, we need a list that fully specifies the vector's elements: (1 2)
+
+(let ()
+  (define (f coeffs rmp0) ; g_fv_set_unchecked
+    (float-vector-set! coeffs 0 (+ (float-vector-ref coeffs 0) rmp0))
+    coeffs)
+  (test (f (float-vector 0 1 2) .5) #r(0.5 1.0 2.0)))
+
+(let () ; typed_normal_vector_set_p_pip_direct, tvect
+  (define (h6)
+    (let ((v (make-vector 3 #(1 0) vector?)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) (vector-ref v 0 0))
+	(vector-set! v i #(2 3)))))
+  (test (h6) 2))
+
+(let () ;typed_vector_set_p_pip_unchecked, tmisc
+  (define (f)
+    (let ((v0 (make-vector 3 'x symbol?)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) v0)
+	(set! (v0 0) 'a))))
+  (test (f) #(a x x)))
+
+(let ()
+  (define (sum-i1111) ; int_vector_ref_i_7piii, tvect
+    (let ((sum 0)
+	  (v (make-int-vector (list 3 3 3) 3)))
+      (do ((k 0 (+ k 1)))
+	  ((= k 1) sum)
+	(do ((i 0 (+ i 1)))
+	    ((= i 1))
+	  (do ((n 0 (+ n 1)))
+	      ((= n 3))
+	    (set! sum (+ sum (int-vector-ref v k i n))))))))
+  (test (sum-i1111) 9))
+
+(let ()
+  (define (j11) ; vector_set_p_piip_direct tvect
+    (let ((v (make-vector (list 3 3))))
+      (do ((k 0 (+ k 1)))
+	  ((= k 3) (v 0 0))
+	(do ((i 0 (+ i 1)))
+	    ((= i 3))
+	  (set! (v k i) 21)))))
+  (test (j11) 21))
+
+(let () ;byte_vector_ref_i_7pi
+  (define (f)
+    (let ((imbv (immutable! (byte-vector 0 1 2))))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) (imbv 0))
+	(imbv 0))))
+  (test (f) 0))
+
+;;; op_let_opassq_old -- this needs to be top-level
+(define (_f_aq p e) (let ((op (assq p e))) (list op)))
+(define (_g_aq) (let ((p 1) (e '((1 a) (2 b)))) (_f_aq p e)))
+(_g_aq)
+(test (_g_aq) '((1 a)))
+
+
+;;; --------------------------------------------------------------------------------
+;;; before starting, make a test c-object
+
+(unless (defined? 'with-block)
+  (define with-block (not (provided? 'windows))))
+
+(if with-block
+    (begin
+      (call-with-output-file "s7test-block.c"
+	(lambda (p)
+	  (format p "
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <math.h>
+
+#include \"s7.h\"
+static s7_scheme *s7;
+
+/* c-object tests */
+typedef struct {
+  size_t size;
+  double *data;
+} g_block;
+
+static s7_int g_block_type = 0, g_simple_block_type = 0, g_c_tag_type = 0, g_c_tag1_type = 0, g_cycle_type = 0, block_gc_loc = 0;
+static s7_pointer g_block_methods, g_tag1_methods;
+
+static s7_pointer g_block_let(s7_scheme *sc, s7_pointer args)
+{
+  #define g_block_let_help \"(block-let block) returns the block'e let.\"
+  if (s7_c_object_type(s7_car(args)) != g_block_type)
+    return(s7_wrong_type_arg_error(sc, \"block-let\", 1, s7_car(args), \"a block\"));
+  return(s7_c_object_let(s7_car(args)));
+}
+
+static s7_int max_vector_length = 0;
+static s7_pointer make_block_1(s7_scheme *sc, s7_int size, bool cleared)
+{
+  g_block *g;
+  s7_pointer new_g;
+  if ((size < 0) ||
+      (size > max_vector_length))
+     return(s7_out_of_range_error(sc, \"make-block\", 1, s7_make_integer(sc, size), \"it should be positive and less than (*s7* 'max-vector-length)\"));
+  g = (cleared) ? (g_block *)calloc(1, sizeof(g_block) + (size * sizeof(double))) : (g_block *)malloc(sizeof(g_block) + (size * sizeof(double)));
+  g->size = (size_t)size;
+  if (g->size > 0)
+    g->data = (double *)((void *)g + sizeof(g_block));
+  else g->data = NULL;
+  new_g = s7_make_c_object(sc, g_block_type, (void *)g);
+  s7_c_object_set_let(sc, new_g, g_block_methods);
+  s7_openlet(sc, new_g);
+  return(new_g);
+}
+
+static s7_pointer make_block(s7_scheme *sc, s7_int size) {return(make_block_1(sc, size, true));}
+static s7_pointer make_block_raw(s7_scheme *sc, s7_int size) {return(make_block_1(sc, size, false));}
+
+static s7_pointer g_make_block(s7_scheme *sc, s7_pointer args)
+{
+  #define g_make_block_help \"(make-block size) returns a new block of the given size\"
+  s7_pointer arg1 = s7_car(args);
+  if (!s7_is_integer(arg1))
+    return(s7_wrong_type_arg_error(sc, \"make-block\", 1, arg1, \"an integer\"));
+  return(make_block(sc, s7_integer(arg1)));
+}
+
+static s7_pointer g_make_simple_block(s7_scheme *sc, s7_pointer args)
+{
+  #define g_make_simple_block_help \"(make-simple-block size) returns a new simple-block of the given size\"
+  g_block *g;
+  s7_pointer new_g;
+  s7_int size;
+  s7_pointer arg1 = s7_car(args);
+  if (!s7_is_integer(arg1))
+    return(s7_wrong_type_arg_error(sc, \"make-simple-block\", 1, arg1, \"an integer\"));
+  size = s7_integer(arg1);
+  if ((size < 0) ||
+      (size > max_vector_length))
+     return(s7_out_of_range_error(sc, \"make-simple-block\", 1, arg1, \"it should be positive and less than (*s7* 'max-vector-length)\"));
+  g = (g_block *)calloc(1, sizeof(g_block) + (size * sizeof(double)));
+  g->size = (size_t)size;
+  if (g->size > 0)
+    g->data = (double *)((void *)g + sizeof(g_block));
+  else g->data = NULL;
+  new_g = s7_make_c_object(sc, g_simple_block_type, (void *)g);
+  return(new_g);
+}
+
+static s7_pointer g_make_c_tag(s7_scheme *sc, s7_pointer args)
+{
+  s7_int *tag = malloc(sizeof(s7_int));
+  *tag = 23;
+  return(s7_make_c_object(sc, g_c_tag_type, (void *)tag));
+}
+
+static void g_c_tag_free(void *val)
+{
+  free(val);
+}
+
+static s7_pointer g_make_c_tag1(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer new_tag1;
+  s7_int *tag = malloc(sizeof(s7_int));
+  *tag = 23;
+  new_tag1 = s7_make_c_object(sc, g_c_tag1_type, (void *)tag);
+  s7_c_object_set_let(sc, new_tag1, g_tag1_methods);
+  s7_openlet(sc, new_tag1);
+  return(new_tag1);
+}
+
+
+typedef struct {s7_pointer obj;} g_cycle;
+static s7_pointer g_make_cycle(s7_scheme *sc, s7_pointer args)
+{
+  g_cycle *g = (g_cycle *)malloc(sizeof(g_cycle));
+  g->obj = s7_car(args);
+  return(s7_make_c_object(sc, g_cycle_type, (void *)g));
+}
+
+static s7_pointer g_cycle_ref(s7_scheme *sc, s7_pointer args)
+{
+  g_cycle *g;
+  if (s7_list_length(sc, args) != 1)
+    return(s7_wrong_number_of_args_error(sc, \"cycle-ref takes 1 argument: ~~S\", args));
+  g = (g_cycle *)s7_c_object_value_checked(s7_car(args), g_cycle_type);
+  if (!g)
+    s7_error(sc, s7_make_symbol(sc, \"wrong-type-arg\"),
+             s7_list(sc, 1, s7_make_string_wrapper(sc, \"object passed to cycle-ref is not a cycle object\")));
+  return(g->obj);
+}
+
+static s7_pointer g_cycle_to_list(s7_scheme *sc, s7_pointer args)
+{
+  g_cycle *g = (g_cycle *)s7_c_object_value_checked(s7_car(args), g_cycle_type);
+  if (!g)
+    s7_error(sc, s7_make_symbol(sc, \"wrong-type-arg\"),
+             s7_list(sc, 1, s7_make_string_wrapper(sc, \"object passed to cycle->list is not a cycle object\")));
+  return(s7_cons(sc, g->obj, s7_nil(sc)));
+}
+
+static s7_pointer g_cycle_set(s7_scheme *sc, s7_pointer args)
+{
+  g_cycle *g = (g_cycle *)s7_c_object_value_checked(s7_car(args), g_cycle_type);
+  if (!g)
+    s7_error(sc, s7_make_symbol(sc, \"wrong-type-arg\"),
+             s7_list(sc, 1, s7_make_string_wrapper(sc, \"object passed to cycle-set! is not a cycle object\")));
+  g->obj = s7_cadr(args);
+  return(g->obj);
+}
+
+static s7_pointer g_cycle_implicit_set(s7_scheme *sc, s7_pointer args)
+{
+  g_cycle *g;
+  s7_pointer val;
+  s7_int index;
+  if (s7_list_length(sc, args) != 3)
+    return(s7_wrong_number_of_args_error(sc, \"cycle-set! takes 3 arguments: ~~S\", args));
+  g = (g_cycle *)s7_c_object_value_checked(s7_car(args), g_cycle_type);
+  if (!g)
+    s7_error(sc, s7_make_symbol(sc, \"wrong-type-arg\"),
+             s7_list(sc, 1, s7_make_string_wrapper(sc, \"object passed to implicit cycle-set! is not a cycle object\")));
+  if ((!s7_is_integer(s7_cadr(args))) ||
+      (s7_integer(s7_cadr(args)) != 0))
+    return(s7_out_of_range_error(sc, \"implicit cycle-set!\", 2, s7_cadr(args), \"it should be 0\"));
+  g->obj = s7_caddr(args);
+  return(g->obj);
+}
+
+static s7_pointer g_cycle_copy(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer obj = s7_car(args);
+  g_cycle *g;
+  g = (g_cycle *)s7_c_object_value_checked(s7_car(args), g_cycle_type);
+  if (!g) return(s7_f(sc));   /* obj might not be a cycle object if destination is one */
+  return(g_make_cycle(sc, s7_list(sc, 1, g->obj)));
+}
+
+static void g_cycle_mark(void *val)
+{
+  s7_mark(((g_cycle *)val)->obj);
+}
+
+static void g_cycle_free(void *val)
+{
+  free(val);
+}
+
+static s7_pointer g_to_block(s7_scheme *sc, s7_pointer args)
+{
+  #define g_block_help \"(block ...) returns a block c-object with the arguments as its contents.\"
+  #define g_block_sig s7_make_circular_signature(sc, 1, 2, s7_make_symbol(sc, \"block?\"), s7_make_symbol(sc, \"real?\"))
+  s7_pointer p = args, b;
+  size_t len = s7_list_length(sc, args);
+  g_block *g = (g_block *)malloc(sizeof(g_block) + (len * sizeof(double)));
+  g->size = (size_t)len;
+  if (g->size > 0)
+    g->data = (double *)((void *)g + sizeof(g_block));
+  else g->data = NULL;
+  b = s7_make_c_object(sc, g_block_type, (void *)g);
+  s7_c_object_set_let(sc, b, g_block_methods);
+  s7_openlet(sc, b);
+  for (size_t i = 0; i < len; i++, p = s7_cdr(p))
+    g->data[i] = s7_number_to_real(sc, s7_car(p));
+  /* if (s7_is_openlet(s7_car(p))) g->data[i] = s7_number_to_real(sc, s7_let_ref(sc, p, s7_make_symbol(sc, \"value\"))) */
+  return(b);
+}
+
+static s7_pointer block_p_d(s7_scheme *sc, s7_double x)
+{
+  g_block *g = (g_block *)malloc(sizeof(g_block) + sizeof(double));
+  s7_pointer new_g;
+  g->size = 1;
+  g->data = (double *)((void *)g + sizeof(g_block));
+  g->data[0] = x;
+  new_g = s7_make_c_object(sc, g_block_type, (void *)g);
+  s7_c_object_set_let(sc, new_g, g_block_methods);
+  s7_openlet(sc, new_g);
+  return(new_g);
+}
+
+static bool is_NaN(s7_double x) {return(x != x);}
+#if __cplusplus
+  #define is_inf(x) std::isinf(x)
+#else
+  #define is_inf(x) isinf(x)
+#endif
+
+static char *g_block_display(s7_scheme *sc, void *value)
+{
+  s7_pointer ffp = NULL, pl = NULL, oom = NULL; /* can't be static if threads or multiple s7's -- maybe add initializer? */
+  g_block *b = (g_block *)value;
+  s7_int i, len, old_len, loc, bytes, prec;
+  char *buf;
+
+  ffp = s7_make_symbol(sc, \"float-format-precision\");
+  pl = s7_make_symbol(sc, \"print-length\");
+  oom = s7_make_symbol(sc, \"out-of-memory\");
+
+  prec = s7_integer(s7_starlet_ref(sc, ffp));
+  if (prec >= 16) prec = 3;
+  len = b->size;
+  old_len = s7_integer(s7_starlet_ref(sc, pl));
+  if (len > old_len) len = old_len;
+  buf = (char *)malloc((len + 1) * 64);
+  if (!buf) s7_error(sc, oom, s7_list(sc, 1, s7_make_string_wrapper(sc, \"unable to allocate string to display block\")));
+  buf[0] = (char)0;
+  loc = snprintf(buf, (len + 1) * 64, \"(block\");
+  for (i = 0; i < len; i++)
+    {
+      char *flt = (char *)(buf + loc);
+      if (is_NaN(b->data[i]))
+        bytes = snprintf(flt, 64, \" +nan.0\");
+      else
+        if (is_inf(b->data[i]))
+          bytes = snprintf(flt, 64, \" %cinf.0\", (b->data[i] >= 0.0) ? '+' : '-');
+        else bytes = snprintf(flt, 64, \" %.*f\", (int)prec, b->data[i]);
+      loc += (bytes > 64) ? 64 : bytes;
+    }
+  if (b->size > old_len) {buf[loc++] = ' '; buf[loc++] = '.'; buf[loc++] = '.'; buf[loc++] = '.';}
+  buf[loc] = ')';
+  buf[loc + 1] = 0;
+  return(buf);
+}
+
+static char *g_block_display_readably(s7_scheme *sc, void *value)
+{
+  s7_int i, loc, bytes;
+  g_block *b = (g_block *)value;
+  s7_int len = b->size;
+  char *buf = (char *)malloc((len + 1) * 64);
+  buf[0] = (char)0;
+  loc = snprintf(buf, (len + 1) * 64, \"(block\");
+  for (i = 0; i < len; i++)
+    {
+      char *flt = (char *)(buf + loc);
+      if (is_NaN(b->data[i]))
+        bytes = snprintf(flt, 64, \" +nan.0\");
+      else
+        if (is_inf(b->data[i]))
+          bytes = snprintf(flt, 64, \" %cinf.0\", (b->data[i] >= 0.0) ? '+' : '-');
+        else bytes = snprintf(flt, 64, \" %.16g\", b->data[i]);
+      loc += (bytes > 64) ? 64 : bytes;
+    }
+  buf[loc] = ')';
+  buf[loc + 1] = 0;
+  return(buf);
+}
+
+static s7_pointer g_block_to_string(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer obj = s7_car(args);
+  s7_pointer choice;
+  char *descr;
+
+  if (s7_is_pair(s7_cdr(args)))
+    choice = s7_cadr(args);
+  else choice = s7_t(sc);
+  if (choice == s7_make_keyword(sc, \"readable\"))
+    descr = g_block_display_readably(sc, s7_c_object_value(obj));
+  else descr = g_block_display(sc, s7_c_object_value(obj));
+  obj = s7_make_string(sc, descr);
+  free(descr);
+  return(obj);
+}
+
+static s7_pointer g_block_gc_free(s7_scheme *sc, s7_pointer obj)
+{
+  free(s7_c_object_value(obj));
+  return(NULL);
+}
+
+static bool g_blocks_are_eql(void *val1, void *val2)
+{
+  s7_int i, len;
+  g_block *b1 = (g_block *)val1;
+  g_block *b2 = (g_block *)val2;
+  if (val1 == val2) return(true);
+  len = b1->size;
+  if (len != b2->size) return(false);
+  if ((len & 1) == 0)
+    for (i = 0; i < len; i++)
+      {
+        if (b1->data[i] != b2->data[i]) return(false); i++;
+        if (b1->data[i] != b2->data[i]) return(false);
+      }
+  else
+    for (i = 0; i < len; i++)
+      if (b1->data[i] != b2->data[i]) return(false);
+  return(true);
+}
+
+static s7_pointer g_blocks_are_equal(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_boolean(sc, g_blocks_are_eql((void *)s7_c_object_value(s7_car(args)), (void *)s7_c_object_value(s7_cadr(args)))));
+}
+
+static s7_pointer g_block_gc_mark(s7_scheme *sc, s7_pointer p)
+{
+  /* nothing to mark because we protect g_block_methods below, and all blocks get the same let */
+  return(p);
+}
+
+static s7_pointer g_is_block(s7_scheme *sc, s7_pointer args)
+{
+  #define g_is_block_help \"(block? obj) returns #t if obj is a block.\"
+  #define g_is_block_sig s7_make_signature(sc, 2, s7_make_symbol(sc, \"boolean?\"), s7_t(sc))
+  return(s7_make_boolean(sc, s7_c_object_type(s7_car(args)) == g_block_type));
+}
+
+static s7_pointer g_is_simple_block(s7_scheme *sc, s7_pointer args)
+{
+  #define g_is_simple_block_help \"(simple-block? obj) returns #t if obj is a simple-block.\"
+  return(s7_make_boolean(sc, s7_c_object_type(s7_car(args)) == g_simple_block_type));
+}
+
+static s7_pointer block_ref_p_pp(s7_scheme *sc, s7_pointer obj, s7_pointer ind)
+{
+  g_block *g;
+  size_t index;
+  g = (g_block *)s7_c_object_value_checked(obj, g_block_type);
+  if (!g)
+    {
+      g = (g_block *)s7_c_object_value_checked(obj, g_simple_block_type);
+      if (!g) s7_wrong_type_arg_error(sc, \"block-ref\", 1, obj, \"a block\");
+    }
+  if (s7_is_integer(ind))
+    index = (size_t)s7_integer(ind);
+  else
+    {
+      if (s7_is_symbol(ind)) /* ((block 'empty) b) etc (i.e. block method access) */
+	{
+          s7_pointer val = s7_symbol_local_value(sc, ind, g_block_methods);
+          if ((!s7_is_eq(s7_undefined(sc), val)) && (ind != val)) /* else! */
+            return(val);
+	}
+      return(s7_wrong_type_arg_error(sc, \"block-ref\", 2, ind, \"an integer\"));
+    }
+  if (index < g->size)
+    return(s7_make_real(sc, g->data[index]));
+  return(s7_out_of_range_error(sc, \"(implicit) block-ref\", 2, ind, \"it should be less than block length\"));
+}
+
+static s7_pointer g_block_ref(s7_scheme *sc, s7_pointer args)
+{
+  #define g_block_ref_help \"(block-ref b i) returns the block value at index i.\"
+  #define g_block_ref_sig s7_make_signature(sc, 3, s7_t(sc), s7_make_symbol(sc, \"block?\"), s7_make_symbol(sc, \"integer?\"))
+  if (s7_list_length(sc, args) != 2)
+    return(s7_wrong_number_of_args_error(sc, \"block-ref takes 2 arguments: ~~S\", args));
+  return(block_ref_p_pp(sc, s7_car(args), s7_cadr(args)));
+}
+
+static s7_double block_ref_d_7pi(s7_scheme *sc, s7_pointer p, s7_int index)
+{
+  g_block *g;
+  g = (g_block *)s7_c_object_value_checked(p, g_block_type);
+  if (!g)
+    {
+      g = (g_block *)s7_c_object_value_checked(p, g_simple_block_type);
+      if (!g) s7_wrong_type_arg_error(sc, \"block-ref\", 1, p, \"a block\");
+    }
+  if ((index < 0) || (index >= g->size))
+     s7_out_of_range_error(sc, \"block-ref\", 2, s7_make_integer(sc, index), (index >= 0) ? \"it should be less than block length\" : \"it should be non-negative\");
+  return(g->data[index]);
+}
+
+static s7_pointer block_set_p_ppp(s7_scheme *sc, s7_pointer obj, s7_pointer ind, s7_pointer val)
+{
+  g_block *g;
+  s7_int index;
+  if (s7_is_immutable(obj))
+    return(s7_wrong_type_arg_error(sc, \"block-set!\", 1, obj, \"a mutable block\"));
+  g = (g_block *)s7_c_object_value_checked(obj, g_block_type);
+  if (!g)
+    {
+      g = (g_block *)s7_c_object_value_checked(obj, g_simple_block_type);
+      if (!g) s7_wrong_type_arg_error(sc, \"block-ref\", 1, obj, \"a block\");
+    }
+  if (!s7_is_integer(ind))
+    return(s7_wrong_type_arg_error(sc, \"block-set!\", 2, ind, \"an integer\"));
+  index = s7_integer(ind);
+  if ((index >= 0) && (index < g->size))
+    {
+      g->data[index] = s7_number_to_real(sc, val);
+      return(val);
+    }
+  return(s7_out_of_range_error(sc, \"block-set\", 2, ind, \"it should be less than block length\"));
+}
+
+static s7_pointer g_block_set(s7_scheme *sc, s7_pointer args)
+{
+  #define g_block_set_help \"(block-set! b i x) sets the block value at index i to x.\"
+  #define g_block_set_sig s7_make_signature(sc, 4, s7_make_symbol(sc, \"real?\"), s7_make_symbol(sc, \"block?\"), s7_make_symbol(sc, \"integer?\"), s7_make_symbol(sc, \"float?\"))
+  /* real? as return type, not float? because we return caddr(args) below, not the floatified version of it */
+  /* c_object_set functions need to check that they have been passed the correct number of arguments */
+  if (s7_list_length(sc, args) != 3)
+    return(s7_wrong_number_of_args_error(sc, \"block-set! takes 3 arguments: ~~S\", args));
+  return(block_set_p_ppp(sc, s7_car(args), s7_cadr(args), s7_caddr(args)));
+}
+
+static s7_double block_set_d_7pid(s7_scheme *sc, s7_pointer p, s7_int index, s7_double x)
+{
+  g_block *g;
+  if (s7_is_immutable(p))
+    s7_wrong_type_arg_error(sc, \"block-set!\", 1, p, \"a mutable block\");
+  g = (g_block *)s7_c_object_value_checked(p, g_block_type);
+  if (!g)
+    {
+      g = (g_block *)s7_c_object_value_checked(p, g_simple_block_type);
+      if (!g) s7_wrong_type_arg_error(sc, \"block-ref\", 1, p, \"a block\");
+    }
+  if ((index < 0) || (index >= g->size))
+    s7_out_of_range_error(sc, \"block-set!\", 2, s7_make_integer(sc, index), (index >= 0) ? \"it should be less than block length\" : \"it should be non-negative\");
+  g->data[index] = x;
+  return(x);
+}
+
+static s7_pointer g_block_length(s7_scheme *sc, s7_pointer args)
+{
+  g_block *g = (g_block *)s7_c_object_value(s7_car(args));
+  return(s7_make_integer(sc, g->size));
+}
+
+static s7_int get_start_and_end(s7_scheme *sc, s7_pointer args, s7_int *start, s7_int end)
+{
+  if (s7_is_pair(s7_cdr(args)))
+    {
+      s7_pointer p = s7_cadr(args);
+      if (s7_is_integer(p))
+        {
+          s7_int nstart = s7_integer(p);
+          if ((nstart < 0) || (nstart >= end))
+            {s7_out_of_range_error(sc, \"subblock\", 2, p, \"it should be less than block length\"); return(0);}
+          *start = nstart;
+        }
+      if (s7_is_pair(s7_cddr(args)))
+        {
+          p = s7_caddr(args);
+          if (s7_is_integer(p))
+            {
+              s7_int nend = s7_integer(p);
+              if (nend <= *start)
+                {s7_out_of_range_error(sc, \"subblock\", 3, p, \"it should be greater than the start point\"); return(0);}
+              if (nend < end) end = nend;
+            }}}
+  return(end - *start);
+}
+
+static s7_pointer g_block_copy(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer new_g;
+  g_block *g, *g1;
+  size_t len;
+  s7_int start = 0;
+  s7_pointer obj = s7_car(args);
+  if (s7_c_object_type(obj) != g_block_type)   /* obj might not be a block object if destination is one */
+    {
+      if (s7_is_float_vector(obj))
+        {
+          s7_pointer v;
+          s7_pointer dest = s7_cadr(args);
+          g = (g_block *)s7_c_object_value(dest);
+          len = g->size;
+	  if (s7_is_null(sc, s7_cddr(args)))
+  	    {
+              if (len > s7_vector_length(obj)) len = s7_vector_length(obj);
+	      memcpy((void *)(g->data), (void *)(s7_float_vector_elements(obj)), len * sizeof(s7_double));
+              return(dest);
+	    }
+	  v = s7_make_float_vector_wrapper(sc, len, g->data, 1, NULL, false);
+	  s7_gc_protect_via_stack(sc, v);
+          s7_copy(sc, s7_cons(sc, obj, s7_cons(sc, v, s7_cddr(args))));
+	  s7_gc_unprotect_via_stack(sc, v);
+	  return(dest);
+        }
+      return(s7_f(sc));
+    }
+  g = (g_block *)s7_c_object_value(obj);
+  len = g->size;
+  if (s7_is_pair(s7_cdr(args)))
+    {
+      new_g = s7_cadr(args);
+      if (s7_is_immutable(new_g))
+        return(s7_wrong_type_arg_error(sc, \"block-copy!\", 0, new_g, \"a mutable block\"));
+      if (s7_c_object_type(new_g) != g_block_type) /* fall back on the float-vector code using a wrapper */
+        {
+          s7_pointer v = s7_make_float_vector_wrapper(sc, len, g->data, 1, NULL, false);
+	  s7_gc_protect_via_stack(sc, v);
+          new_g = s7_copy(sc, s7_cons(sc, v, s7_cdr(args)));
+	  s7_gc_unprotect_via_stack(sc, v);
+          return(new_g);
+        }
+      if (s7_is_pair(s7_cddr(args)))
+        len = get_start_and_end(sc, s7_cdr(args), &start, len);
+    }
+  else new_g = make_block_raw(sc, len);
+  g1 = (g_block *)s7_c_object_value(new_g);
+  if (g1->size < len) len = g1->size;
+  memcpy((void *)(g1->data), (void *)(g->data + start), len * sizeof(double));
+  return(new_g);
+}
+
+static s7_pointer g_blocks_are_equivalent(s7_scheme *sc, s7_pointer args)
+{
+  #define g_blocks_are_equivalent_help \"(equivalent? block1 block2)\"
+  s7_pointer v1, v2;
+  g_block *g1, *g2;
+  bool result;
+  size_t len;
+  s7_pointer arg1 = s7_car(args);
+  s7_pointer arg2 = s7_cadr(args);
+  if (!s7_is_c_object(arg2))
+    return(s7_f(sc));
+  if (arg1 == arg2)
+    return(s7_make_boolean(sc, true));
+  if (s7_is_let(arg1))                     /* (block-let (block)) */
+    return(s7_make_boolean(sc, false));    /* checked == above */
+  g1 = (g_block *)s7_c_object_value(arg1);
+  g2 = (g_block *)s7_c_object_value_checked(arg2, g_block_type);
+  if (!g2) return(s7_make_boolean(sc, false));
+  len = g1->size;
+  if (len != g2->size)
+    return(s7_make_boolean(sc, false));
+  v1 = s7_make_float_vector_wrapper(sc, len, g1->data, 1, NULL, false);
+  s7_gc_protect_via_stack(sc, v1);
+  v2 = s7_make_float_vector_wrapper(sc, len, g2->data, 1, NULL, false);
+  s7_gc_protect_via_stack(sc, v2);
+  result = s7_is_equivalent(sc, v1, v2);
+  s7_gc_unprotect_via_stack(sc, v1);
+  s7_gc_unprotect_via_stack(sc, v2);
+  return(s7_make_boolean(sc, result));
+}
+
+static s7_pointer g_block_append(s7_scheme *sc, s7_pointer args)
+{
+  #define g_block_append_help \"(append block...) returns a new block containing the argument blocks concatenated.\"
+  s7_int i, len = 0;
+  s7_pointer p, new_g;
+  g_block *g;
+  if (s7_is_null(sc, args)) return(s7_nil(sc)); /* (with-let <block...> (append)) ?! */
+  for (i = 1, p = args; s7_is_pair(p); p = s7_cdr(p), i++)
+    {
+      g_block *g1;
+      g1 = (g_block *)s7_c_object_value_checked(s7_car(p), g_block_type);
+      if (!g1) return(s7_wrong_type_arg_error(sc, \"block-append\", i, s7_car(p), \"a block\"));
+      len += g1->size;
+    }
+  new_g = make_block_raw(sc, len);
+  g = (g_block *)s7_c_object_value(new_g);
+  for (i = 0, p = args; s7_is_pair(p); p = s7_cdr(p))
+    {
+      g_block *g1;
+      g1 = (g_block *)s7_c_object_value(s7_car(p));
+      memcpy((void *)(g->data + i), (void *)(g1->data), g1->size * sizeof(double));
+      i += g1->size;
+    }
+  return(new_g);
+}
+
+#if (((defined(SIZEOF_VOID_P)) && (SIZEOF_VOID_P == 4)) || ((defined(__SIZEOF_POINTER__)) && (__SIZEOF_POINTER__ == 4)) || (!defined(__LP64__)))
+  #define Vectorized
+#else
+#if (defined(__GNUC__) && __GNUC__ >= 5)
+  #define Vectorized __attribute__((optimize(\"tree-vectorize\")))
+#else
+  #define Vectorized
+#endif
+#endif
+
+static s7_pointer g_block_reverse(s7_scheme *sc, s7_pointer args)
+{
+  size_t i, j;
+  g_block *g, *g1;
+  s7_pointer new_g;
+  if (!s7_is_null(sc, s7_cdr(args)))
+    return(s7_wrong_number_of_args_error(sc, \"(block-)reverse\", args));
+  g = (g_block *)s7_c_object_value(s7_car(args));
+  new_g = make_block_raw(sc, g->size);
+  g1 = (g_block *)s7_c_object_value(new_g);
+  for (i = 0, j = g->size - 1; i < g->size; i++, j--)
+    g1->data[i] = g->data[j];
+  return(new_g);
+}
+
+#define LOOP_8(Code) do {Code; Code; Code; Code; Code; Code; Code; Code;} while (0)
+
+static s7_pointer g_block_reverse_in_place(s7_scheme *sc, s7_pointer args) /* Vectorized is slower */
+{
+  #define g_block_reverse_in_place_help \"(block-reverse! block) returns block with its data reversed.\"
+  size_t i, j;
+  g_block *g;
+  double *d1, *d2;
+  s7_pointer obj = s7_car(args);
+  if (s7_is_immutable(obj))
+    return(s7_wrong_type_arg_error(sc, \"block-reverse!\", 0, obj, \"a mutable block\"));
+  g = (g_block *)s7_c_object_value_checked(obj, g_block_type);
+  if (!g) return(s7_wrong_type_arg_error(sc, \"block-reverse!\", 0, obj, \"a block\"));
+  if (g->size < 2) return(obj);
+  d1 = g->data;
+  d2 = (double *)(d1 + g->size - 1);
+  if ((g->size & 0x3f) == 0) /* need even number of 32's (we're moving two at a time) */
+    {
+      while (d1 < d2)
+       {
+	 s7_double c;
+         LOOP_8(c = *d1; *d1++ = *d2; *d2-- = c);
+         LOOP_8(c = *d1; *d1++ = *d2; *d2-- = c);
+         LOOP_8(c = *d1; *d1++ = *d2; *d2-- = c);
+         LOOP_8(c = *d1; *d1++ = *d2; *d2-- = c);
+       }}
+  else
+    if ((g->size & 0xf) == 0)
+      {
+        while (d1 < d2)
+         {
+	   s7_double c;
+           LOOP_8(c = *d1; *d1++ = *d2; *d2-- = c);
+         }}
+    else
+      while (d1 < d2) {s7_double c; c = *d1; *d1++ = *d2; *d2-- = c;}
+
+  return(obj);
+}
+
+static Vectorized void block_memclr64(double *data, size_t bytes)
+{
+  size_t i;
+  for (i = 0; i < bytes; )
+    {
+      LOOP_8(data[i++] = 0.0);
+    }
+}
+
+static s7_pointer g_block_fill(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer obj = s7_car(args);
+  s7_pointer val;
+  size_t i, len;
+  s7_int start = 0;
+  double fill_val;
+  g_block *g;
+  double *data;
+
+  if (s7_is_immutable(obj))
+    return(s7_wrong_type_arg_error(sc, \"block-fill!\", 0, obj, \"a mutable block\"));
+  val = s7_cadr(args);
+  g = (g_block *)s7_c_object_value(obj);
+  fill_val = s7_number_to_real(sc, val);
+  len = g->size;
+  if (s7_is_pair(s7_cddr(args)))
+    len = get_start_and_end(sc, s7_cdr(args), &start, len);
+  data = (double *)(g->data + start);
+  if (fill_val == 0.0)
+    {
+      if ((g->size & 0x7) == 0)
+        block_memclr64(data, len);
+      else memset((void *)data, 0, len * sizeof(double));
+    }
+  else
+    if ((g->size & 0x3) == 0)
+      for (i = 0; i < len; ) {data[i++] = fill_val; data[i++] = fill_val; data[i++] = fill_val; data[i++] = fill_val;}
+    else
+      for (i = 0; i < len; i++) data[i] = fill_val;
+  return(obj);
+}
+
+static s7_pointer g_blocks(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_copy(sc, s7_list(sc, 1, args)));
+}
+
+static s7_pointer g_2_values(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_values(sc, s7_list(sc, 2, s7_car(args), s7_cadr(args))));
+}
+
+static s7_pointer g_subblock(s7_scheme *sc, s7_pointer args)
+{
+  #define g_subblock_help \"(subblock block (start 0) end) returns a portion of the block.\"
+  s7_pointer p, new_g;
+  s7_pointer obj = s7_car(args);
+  s7_int start = 0, new_len, i;
+  g_block *g, *g1;
+  g = (g_block *)s7_c_object_value_checked(obj, g_block_type);
+  if (!g) return(s7_wrong_type_arg_error(sc, \"subblock\", 1, obj, \"a block\"));
+  new_len = get_start_and_end(sc, args, &start, g->size);
+  new_g = make_block_raw(sc, new_len);
+  g1 = (g_block *)s7_c_object_value(new_g);
+  memcpy((void *)(g1->data), (void *)(g->data + start), new_len * sizeof(double));
+  return(new_g);
+}
+
+static s7_pointer g_block_release_methods(s7_scheme *sc, s7_pointer args)
+{
+  s7_gc_unprotect_at(sc, block_gc_loc);
+  return(s7_f(sc));
+}
+
+
+/* function port tests */
+static unsigned char *fout = NULL;
+static unsigned int fout_size = 0, fout_loc = 0;
+static void foutput(s7_scheme *sc, unsigned char c, s7_pointer port)
+{
+  if (fout_size == fout_loc)
+    {
+      if (fout_size == 0)
+        {
+          fout_size = 128;
+          fout = (unsigned char *)malloc(fout_size * sizeof(unsigned char));
+        }
+      else
+        {
+          fout_size += 128;
+          fout = (unsigned char *)realloc(fout, fout_size * sizeof(unsigned char));
+        }}
+  fout[fout_loc++] = c;
+}
+
+static s7_pointer fout_open(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_open_output_function(sc, foutput));
+}
+
+static s7_pointer fout_get_output(s7_scheme *sc, s7_pointer args)
+{
+  foutput(sc, 0, s7_car(args)); /* make sure it's null-terminated */
+  return(s7_make_string_with_length(sc, (const char *)fout, fout_loc - 1));
+}
+
+static s7_pointer fout_close(s7_scheme *sc, s7_pointer args)
+{
+  fout_loc = 0;
+  return(s7_car(args));
+}
+
+static const char *fin = NULL;
+static unsigned int fin_size = 0, fin_loc = 0;
+static s7_pointer finput(s7_scheme *sc, s7_read_t peek, s7_pointer port)
+{
+  switch (peek)
+    {
+      case S7_READ_CHAR:
+        return(s7_make_character(sc, fin[fin_loc++]));
+      case S7_PEEK_CHAR:
+        return(s7_make_character(sc, fin[fin_loc]));
+      case S7_READ_LINE:
+        {
+          unsigned int i;
+          s7_pointer result;
+          for (i = fin_loc; (i < fin_size) && (fin[i] != '\\n'); i++);
+          result = s7_make_string_with_length(sc, (char *)(fin + fin_loc), i - fin_loc);
+          fin_loc = i + 1;
+          return(result);
+        }
+      case S7_IS_CHAR_READY:
+        return(s7_make_boolean(sc, fin_loc < fin_size));
+      case S7_READ:
+        return(s7_error(sc, s7_make_symbol(sc, \"read-error\"), s7_make_string_wrapper(sc, \"can't read yet!\")));
+      default:
+        return(s7_error(sc, s7_make_symbol(sc, \"read-error\"), s7_make_string_wrapper(sc, \"unknown s7_input_function choice\")));
+    }
+}
+
+static s7_pointer fin_open(s7_scheme *sc, s7_pointer args)
+{
+  /* arg = string to read */
+  s7_pointer str;
+  fin_loc = 0;
+  str = s7_car(args);
+  if (!s7_is_string(str))
+    return(s7_wrong_type_arg_error(sc, \"fin_open\", 1, s7_car(args), \"a string\"));
+  fin = s7_string(str); /* assume caller will GC protect the string */
+  fin_size = s7_string_length(str);
+  return(s7_open_input_function(sc, finput));
+}
+
+/* values-from-C tests */
+static s7_pointer g_cvals(s7_scheme *sc, s7_pointer args) {return(s7_values(sc, args));}
+static s7_pointer g_mvals(s7_scheme *sc, s7_pointer args) {return(s7_cons(sc, s7_make_symbol(sc, \"values\"), args));}
+
+/* dilambda test */
+static s7_pointer g_dilambda_test(s7_scheme *sc, s7_pointer args) {return(s7_f(sc));}
+static s7_pointer g_set_dilambda_test(s7_scheme *sc, s7_pointer args) {return(s7_car(args));}
+
+/* hash-table tests */
+static s7_pointer g_hloc(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, 0));}
+static s7_pointer g_heq(s7_scheme *sc, s7_pointer args) {return(s7_make_boolean(sc, s7_is_eq(s7_car(args), s7_cadr(args))));}
+
+/* optimizer tests */
+static s7_pointer g_cf00(s7_scheme *sc, s7_pointer args) {return(s7_f(sc));}
+static s7_pointer g_cf10(s7_scheme *sc, s7_pointer args) {return(s7_car(args));}
+static s7_pointer g_cf11(s7_scheme *sc, s7_pointer args) {return(s7_car(args));}
+static s7_pointer g_cs11(s7_scheme *sc, s7_pointer args) {return(s7_car(args));}
+
+static s7_pointer g_cf20(s7_scheme *sc, s7_pointer args) {return(s7_car(args));}
+static s7_pointer g_cf21(s7_scheme *sc, s7_pointer args) {return(s7_car(args));}
+static s7_pointer g_cf22(s7_scheme *sc, s7_pointer args) {return(s7_cadr(args));}
+
+static s7_pointer g_cf30(s7_scheme *sc, s7_pointer args) {return(s7_car(args));}
+static s7_pointer g_cf31(s7_scheme *sc, s7_pointer args) {return(s7_car(args));}
+static s7_pointer g_cf32(s7_scheme *sc, s7_pointer args) {return(s7_cadr(args));}
+static s7_pointer g_cf33(s7_scheme *sc, s7_pointer args) {return(s7_caddr(args));}
+
+static s7_pointer g_cf41(s7_scheme *sc, s7_pointer args) {return(s7_car(args));}
+static s7_pointer g_cf42(s7_scheme *sc, s7_pointer args) {return(s7_cadr(args));}
+static s7_pointer g_cf43(s7_scheme *sc, s7_pointer args) {return(s7_caddr(args));}
+static s7_pointer g_cf44(s7_scheme *sc, s7_pointer args) {return(s7_cadddr(args));}
+static s7_pointer g_rs11(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, s7_integer(s7_car(args)) + 1));}
+
+static s7_pointer g_cf51(s7_scheme *sc, s7_pointer args) {return(s7_car(args));}
+
+static s7_pointer sload(s7_scheme *sc, s7_pointer args)
+{
+  if (s7_is_string(s7_car(args)))
+    {
+      if (s7_is_pair(s7_cdr(args)))
+	 {
+	   if (s7_is_let(s7_cadr(args)))
+             return(s7_load_with_environment(sc, s7_string(s7_car(args)), s7_cadr(args)));
+           return(s7_wrong_type_arg_error(sc, \"load\", 2, s7_cadr(args), \"an environment\"));
+         }
+      return(s7_load(sc, s7_string(s7_car(args))));
+    }
+  return(s7_wrong_type_arg_error(sc, \"load\", 1, s7_car(args), \"file name\"));
+}
+static s7_pointer scall(s7_scheme *sc, s7_pointer args) {return(s7_call(sc, s7_car(args), s7_cadr(args)));}
+static s7_pointer sread(s7_scheme *sc, s7_pointer args)
+{
+  if (s7_is_pair(args))
+    return(s7_read(sc, s7_car(args)));
+  return(s7_read(sc, s7_current_input_port(sc)));
+}
+static s7_pointer swind(s7_scheme *sc, s7_pointer args) {return(s7_dynamic_wind(sc, s7_car(args), s7_cadr(args), s7_caddr(args)));}
+static s7_pointer seval(s7_scheme *sc, s7_pointer args)
+{
+  if (s7_is_pair(s7_cdr(args)))
+    return(s7_eval(sc, s7_car(args), s7_cadr(args)));
+  return(s7_eval(sc, s7_car(args), s7_curlet(sc)));
+}
+static s7_pointer sevalstr(s7_scheme *sc, s7_pointer args)
+{
+  if (s7_is_string(s7_car(args)))
+    {
+      if (s7_is_pair(s7_cdr(args)))
+	 {
+	   if (s7_is_let(s7_cadr(args)))
+             return(s7_eval_c_string_with_environment(sc, s7_string(s7_car(args)), s7_cadr(args)));
+           return(s7_wrong_type_arg_error(sc, \"eval-string\", 2, s7_cadr(args), \"an environment\"));
+	 }
+      return(s7_eval_c_string_with_environment(sc, s7_string(s7_car(args)), s7_curlet(sc)));
+    }
+  return(s7_wrong_type_arg_error(sc, \"eval-string\", 1, s7_car(args), \"string of code\"));
+}
+
+void block_init(s7_scheme *sc);
+void block_init(s7_scheme *sc)
+{
+  s7_pointer cur_env, meq_func, bref;
+  max_vector_length = s7_integer(s7_let_ref(sc, s7_symbol_value(sc, s7_make_symbol(sc, \"*s7*\")), s7_make_symbol(sc, \"max-vector-length\")));
+  cur_env = s7_outlet(sc, s7_curlet(sc));
+
+  g_block_type = s7_make_c_type(sc, \"<block>\");
+  s7_c_type_set_gc_free(sc, g_block_type, g_block_gc_free);
+  s7_c_type_set_equal(sc, g_block_type, g_blocks_are_eql);
+  s7_c_type_set_is_equal(sc, g_block_type, g_blocks_are_equal);
+  s7_c_type_set_is_equivalent(sc, g_block_type, g_blocks_are_equivalent);
+  s7_c_type_set_gc_mark(sc, g_block_type, g_block_gc_mark);
+  s7_c_type_set_ref(sc, g_block_type, g_block_ref);
+  s7_c_type_set_set(sc, g_block_type, g_block_set);
+  s7_c_type_set_length(sc, g_block_type, g_block_length);
+  s7_c_type_set_copy(sc, g_block_type, g_block_copy);
+  s7_c_type_set_reverse(sc, g_block_type, g_block_reverse);
+  s7_c_type_set_fill(sc, g_block_type, g_block_fill);
+  s7_c_type_set_to_string(sc, g_block_type, g_block_to_string);
+
+  s7_define_safe_function(sc, \"make-block\", g_make_block, 1, 0, false, g_make_block_help);
+  s7_define_typed_function(sc, \"block\", g_to_block, 0, 0, true, g_block_help, g_block_sig);
+  bref = s7_define_typed_function(sc, \"block-ref\", g_block_ref, 2, 0, false, g_block_ref_help, g_block_ref_sig);
+  s7_c_type_set_getter(sc, g_block_type, s7_name_to_value(sc, \"block-ref\"));
+  s7_symbol_set_initial_value(sc, bref, s7_symbol_value(sc, bref));
+  s7_define_typed_function(sc, \"block-set!\", g_block_set, 3, 0, false, g_block_set_help, g_block_set_sig);
+  s7_c_type_set_setter(sc, g_block_type, s7_name_to_value(sc, \"block-set!\"));
+  s7_define_safe_function(sc, \"block-let\", g_block_let, 1, 0, false, g_block_let_help);
+  s7_define_safe_function(sc, \"subblock\", g_subblock, 1, 0, true, g_subblock_help);
+  s7_define_safe_function(sc, \"block-append\", g_block_append, 0, 0, true, g_block_append_help);
+  s7_define_safe_function(sc, \"block-reverse!\", g_block_reverse_in_place, 1, 0, false, g_block_reverse_in_place_help);
+  s7_define_typed_function(sc, \"block?\", g_is_block, 1, 0, false, g_is_block_help, g_is_block_sig);
+  s7_define_safe_function_star(sc, \"values2\", g_2_values, \"arg1 arg2\", \"values test for function*\");
+  s7_define_function_star(sc, \"unsafe-values2\", g_2_values, \"arg1 arg2\", \"values test for function*\");
+  s7_define_safe_function_star(sc, \"blocks1\", g_blocks, \"(frequency 4)\", \"test for function*\");
+  s7_define_safe_function_star(sc, \"blocks\", g_blocks, \"(frequency 4) (scaler 1)\", \"test for function*\");
+  s7_define_safe_function_star(sc, \"blocks3\", g_blocks, \"(frequency 4) (scaler 1) (asdf 32)\", \"test for function*\");
+  s7_define_safe_function_star(sc, \"blocks4\", g_blocks, \"(frequency 4) (scaler 1) (asdf 32) etc\", \"test for function*\");
+  s7_define_function_star(sc, \"unsafe-blocks1\", g_blocks, \"(frequency 4)\", \"test for function*\");
+  s7_define_function_star(sc, \"unsafe-blocks\", g_blocks, \"(frequency 4) (scaler 1)\", \"test for function*\");
+  s7_define_function_star(sc, \"unsafe-blocks3\", g_blocks, \"(frequency 4) (scaler 1) (asdf 32)\", \"test for function*\");
+  s7_define_function_star(sc, \"unsafe-blocks4\", g_blocks, \"(frequency 4) (scaler 1) (asdf 32) etc\", \"test for function*\");
+  s7_define_safe_function_star(sc, \"blocks5\", g_blocks, \"(frequency 4) :allow-other-keys\", \"test for function*\");
+  g_block_methods = s7_eval_c_string(sc, \"(openlet (immutable! (inlet 'float-vector? (lambda (p) #t) \\\n\
+								      'signature (lambda (p) (list #t 'block? 'integer?)) \\\n\
+								      'arity (lambda (p) (cons 1 1)) \\\n\
+								      'aritable? (lambda (p args) (= args 1)) \\\n\
+								      'vector-dimensions (lambda (p) (list (length p))) \\\n\
+						                      'empty (lambda (p) (zero? (length p))) \\\n\
+								      'vector-ref block-ref \\\n\
+								      'vector-set! block-set! \\\n\
+                                                                      'subsequence subblock \\\n\
+						                      'append block-append \\\n\
+						                      'reverse! block-reverse!)))\");
+  block_gc_loc = s7_gc_protect(sc, g_block_methods);
+  s7_define_safe_function(sc, \"block-release-methods\", g_block_release_methods, 0, 0, false, NULL);
+
+  g_simple_block_type = s7_make_c_type(sc, \"<simple-block>\");
+  s7_define_safe_function(sc, \"make-simple-block\", g_make_simple_block, 1, 0, false, g_make_simple_block_help);
+  s7_c_type_set_gc_free(sc, g_simple_block_type, g_block_gc_free);
+  s7_c_type_set_gc_mark(sc, g_simple_block_type, g_block_gc_mark);
+  s7_c_type_set_length(sc, g_simple_block_type, g_block_length);
+  s7_c_type_set_ref(sc, g_simple_block_type, g_block_ref);
+  s7_c_type_set_getter(sc, g_simple_block_type, s7_name_to_value(sc, \"block-ref\"));
+  s7_c_type_set_set(sc, g_simple_block_type, g_block_set);
+  s7_c_type_set_setter(sc, g_simple_block_type, s7_name_to_value(sc, \"block-set!\"));
+  s7_define_safe_function(sc, \"simple-block?\", g_is_simple_block, 1, 0, false, g_is_simple_block_help);
+
+  s7_set_p_d_function(sc, s7_name_to_value(sc, \"block\"), block_p_d);
+  s7_set_d_7pi_function(sc, s7_name_to_value(sc, \"block-ref\"), block_ref_d_7pi);
+  s7_set_d_7pid_function(sc, s7_name_to_value(sc, \"block-set!\"), block_set_d_7pid);
+  s7_set_p_pp_function(sc, s7_name_to_value(sc, \"block-ref\"), block_ref_p_pp);
+  s7_set_p_ppp_function(sc, s7_name_to_value(sc, \"block-set!\"), block_set_p_ppp);
+
+  g_c_tag_type = s7_make_c_type(sc, \"c-tag\");
+  s7_define_safe_function(sc, \"make-c-tag\", g_make_c_tag, 0, 0, false, \"no help here\");
+  s7_c_type_set_free(sc, g_c_tag_type, g_c_tag_free);
+
+  g_c_tag1_type = s7_make_c_type(sc, \"c-tag1\");
+  s7_define_safe_function(sc, \"make-c-tag1\", g_make_c_tag1, 0, 0, false, \"no help here\");
+  s7_c_type_set_free(sc, g_c_tag1_type, g_c_tag_free);
+  s7_c_type_set_equal(sc, g_c_tag1_type, NULL);
+  s7_c_type_set_is_equal(sc, g_c_tag1_type, NULL);
+  s7_c_type_set_is_equivalent(sc, g_c_tag1_type, NULL);
+  s7_c_type_set_ref(sc, g_c_tag1_type, NULL);
+  s7_c_type_set_set(sc, g_c_tag1_type, NULL);
+  s7_c_type_set_length(sc, g_c_tag1_type, NULL);
+  s7_c_type_set_copy(sc, g_c_tag1_type, NULL);
+  s7_c_type_set_fill(sc, g_c_tag1_type, NULL);
+  s7_c_type_set_reverse(sc, g_c_tag1_type, NULL);
+  s7_c_type_set_to_list(sc, g_c_tag1_type, NULL);
+  s7_c_type_set_to_string(sc, g_c_tag1_type, NULL);
+  s7_c_type_set_getter(sc, g_c_tag1_type, NULL);
+  s7_c_type_set_setter(sc, g_c_tag1_type, NULL);
+  g_tag1_methods = s7_eval_c_string(sc, \"(openlet (immutable! (inlet 'copy (lambda (src dest) 123))))\");
+  s7_gc_protect(sc, g_tag1_methods);
+
+  g_cycle_type = s7_make_c_type(sc, \"<cycle>\");
+  s7_define_safe_function(sc, \"make-cycle\", g_make_cycle, 1, 0, false, \"no help here\");
+  s7_define_safe_function(sc, \"<cycle>\", g_make_cycle, 1, 0, false, \"no help here\"); /* for print readably */
+  s7_c_type_set_mark(sc, g_cycle_type, g_cycle_mark);
+  s7_c_type_set_free(sc, g_cycle_type, g_cycle_free);
+  s7_c_type_set_to_list(sc, g_cycle_type, g_cycle_to_list);
+  s7_c_type_set_copy(sc, g_cycle_type, g_cycle_copy);
+  s7_c_type_set_ref(sc, g_cycle_type, g_cycle_ref);
+  s7_c_type_set_set(sc, g_cycle_type, g_cycle_implicit_set);
+  s7_define_safe_function(sc, \"cycle-ref\", g_cycle_ref, 1, 0, false, \"no help here\");
+  s7_define_safe_function(sc, \"cycle-set!\", g_cycle_set, 2, 0, false, \"no help here\");
+
+  s7_define_safe_function(sc, \"function-open-output\", fout_open, 0, 0, false, \"\");
+  s7_define_safe_function(sc, \"function-get-output\", fout_get_output, 1, 0, false, \"\");
+  s7_define_safe_function(sc, \"function-close-output\", fout_close, 1, 0, false, \"\");
+  s7_define_safe_function(sc, \"function-open-input\", fin_open, 1, 0, false, \"\");
+
+  s7_define_safe_function(sc, \"hash_heq\", g_heq, 2, 0, false, \"hash-table test\");
+  s7_define_safe_function(sc, \"hash_hloc\", g_hloc, 1, 0, false, \"hash-table test\");
+
+  s7_define_safe_function(sc, \"cf00\", g_cf00, 0, 0, false, \"\");
+  s7_define_safe_function(sc, \"cf10\", g_cf10, 1, 0, false, \"\");
+  s7_define_safe_function(sc, \"cf11\", g_cf11, 1, 0, false, \"\");
+  s7_define_safe_function(sc, \"cs11\", g_cs11, 1, 0, false, \"\");
+  s7_define_safe_function(sc, \"rs11\", g_rs11, 1, 0, false, \"\");
+
+  s7_define_safe_function(sc, \"cf20\", g_cf20, 2, 0, false, \"\");
+  s7_define_safe_function(sc, \"cf21\", g_cf21, 2, 0, false, \"\");
+  s7_define_safe_function(sc, \"cf22\", g_cf22, 2, 0, false, \"\");
+
+  s7_define_safe_function(sc, \"cf30\", g_cf30, 3, 0, false, \"\");
+  s7_define_safe_function(sc, \"cf31\", g_cf31, 3, 0, false, \"\");
+  s7_define_safe_function(sc, \"cf32\", g_cf32, 3, 0, false, \"\");
+  s7_define_safe_function(sc, \"cf33\", g_cf33, 3, 0, false, \"\");
+
+  s7_define_safe_function(sc, \"cf41\", g_cf41, 4, 0, false, \"\");
+  s7_define_safe_function(sc, \"cf42\", g_cf42, 4, 0, false, \"\");
+  s7_define_safe_function(sc, \"cf43\", g_cf43, 4, 0, false, \"\");
+  s7_define_safe_function(sc, \"cf44\", g_cf44, 4, 0, false, \"\");
+
+  s7_define_safe_function(sc, \"cf51\", g_cf51, 5, 0, false, \"\");
+
+  s7_define_function(sc, \"sload\",  sload,        1, 1, false, \"test s7_load\");
+  s7_define_function(sc, \"scall\",  scall,        2, 0, false, \"test s7_call\");
+  s7_define_function(sc, \"sread\",  sread,        0, 1, false, \"test s7_read\");
+  s7_define_function(sc, \"swind\",  swind,        3, 0, false, \"test s7_dynamic_wind\");
+  s7_define_function(sc, \"seval\",  seval,        1, 1, false, \"test s7_eval\");
+  s7_define_function(sc, \"sevalstr\",  sevalstr,  1, 1, false, \"test s7_eval_c_string\");
+
+  s7_define_safe_function(sc, \"dilambda_test\", g_dilambda_test, 0, 0, false, \"\");
+  s7_define_safe_function(sc, \"set_dilambda_test\", g_set_dilambda_test, 1, 0, false, \"\");
+  s7_set_setter(sc, s7_name_to_value(sc, \"dilambda_test\"), s7_name_to_value(sc, \"set_dilambda_test\"));
+
+  s7_define_macro(sc, \"c-macro-with-values\", g_mvals, 0, 0, true, \"c-macro values test\");
+  s7_define_function(sc, \"c-function-with-values\",  g_cvals,  0, 0, true, \"c-function values test\");
+  s7_define_function(sc, \"safe-c-function-with-2-values\",  g_cvals,  2, 0, false, \"c-function values test\");
+}
+")))
+
+  (let ((flags (if (provided? 'debugging) "-g3" "-g -O2")))
+    (cond ((provided? 'osx)
+	   (system (string-append "gcc -c s7test-block.c " flags))
+	   (system "gcc s7test-block.o -o s7test-block.so -dynamic -bundle -undefined suppress -flat_namespace"))
+
+	  ((or (provided? 'freebsd)
+	       (provided? 'netbsd))
+	   (system (string-append "cc -fPIC -c s7test-block.c " flags))
+	   (system "cc s7test-block.o -shared -o s7test-block.so -lm -lc"))
+
+	  ((provided? 'openbsd)
+	   (system (string-append "clang -fPIC -c s7test-block.c " flags))
+	   (system "clang s7test-block.o -shared -o s7test-block.so -lm -lc"))
+
+	  ((provided? 'solaris)
+	   (system "gcc -fPIC -c s7test-block.c")
+	   (system "gcc s7test-block.o -shared -o s7test-block.so -G -ldl -lm"))
+
+	  (else
+	   (system (string-append "gcc -fPIC -c s7test-block.c " flags))
+	   (system "gcc s7test-block.o -shared -o s7test-block.so -ldl -lm -Wl,-export-dynamic"))))
+
+  (let ((e (sublet (curlet) (cons 'init_func 'block_init)))) (load "s7test-block.so" e))
+
+  (define _c_obj_ (make-block 16))
+  (unless (immutable? (block-let _c_obj_)) (format *stderr* "~S's let is mutable~%" _c_obj_))) ; with-block
+  ;; else...
+  (define _c_obj_ (c-pointer 0))) ; not with-block
+(define _null_ (c-pointer 0))
+
+(when (provided? 'linux)
+  (if (and (provided? 'system-extras)
+	   (not (file-exists? "ffitest.c"))
+	   (file-exists? "tools/ffitest.c"))
+      (system "cp tools/ffitest.c ."))
+  (if (provided? 'gmp)
+      (system (string-append (if (provided? 'clang) "clang" "gcc") " -o ffitest ffitest.c -g3 -Wall -fPIC s7.o -DWITH_GMP -lgmp -lmpfr -lmpc " asan-flags " -lm -I. -ldl -Wl,-export-dynamic"))
+      (system (string-append (if (provided? 'clang) "clang" "gcc") " -o ffitest ffitest.c -g3 -Wall -fPIC s7.o " asan-flags " -lm -I. -ldl -Wl,-export-dynamic")))
+  (system "ffitest"))
+
+#|
+(define (ok1? otst ola oexp)
+  (let ((result (catch 'all-done ola
+		       (lambda args
+			 (if (not (eq? oexp 'error))
+			     (begin (display args) (newline)))
+			 'error))))
+    (if (not (equal? result oexp))
+	(format #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) otst result oexp))))
+
+(define-macro (test tst expected)
+  `(ok1? ',tst (lambda ()
+		 (if (null? (hook-functions *error-hook*))
+		     (set! (hook-functions *error-hook*)
+			   (list (lambda (hook)
+				   (apply format *stderr* (hook 'data))
+				   (newline *stderr*)
+				   (set! (hook 'result) 'error)
+				   (throw 'all-done)))))
+		 ,tst)
+	 ,expected))
+|#
+
+
+;;; --------------------------------------------------------------------------------
+;;; eq?
+
+(test (eq? 'a 3) #f)
+(test (eq? #t 't) #f)
+(test (eq? "abs" 'abc) #f)
+(test (eq? "hi" '(hi)) #f)
+(test (eq? "hi" "hi") #f)
+(test (eq? "()" ()) #f)
+(test (eq? '(1) '(1)) #f)
+(test (eq? '(#f) '(#f)) #f)
+(test (eq? #\a #\b) #f)
+(test (eq? #t #t) #t)
+(test (eq? #f #f) #t)
+(test (eq? #f #t) #f)
+(test (eq? (null? ()) #t) #t)
+(test (eq? (null? '(a)) #f) #t)
+(test (eq? (cdr '(a)) ()) #t)
+(test (eq? 'a 'a) #t)
+(test (eq? 'a 'b) #f)
+(test (eq? 'a (string->symbol "a")) #t)
+(test (eq? (symbol "a") (string->symbol "a")) #t)
+(test (eq? :a :a) #t)
+(test (eq? :a 'a) #f)
+(test (eq? ':a 'a) #f)
+(test (eq? ':a ':a) #t)
+(test (eq? :a a:) #f)
+(test (eq? ':a 'a:) #f)
+(test (eq? 'a: 'a:) #t)
+(test (eq? ':a: 'a:) #f)
+(test (eq? 'a (symbol "a")) #t)
+(test (eq? :: '::) #t)
+(test (eq? ':a (symbol->keyword (symbol "a"))) #t) ; but not a:
+(test (eq? '(a) '(b)) #f)
+(test (let ((x '(a . b))) (eq? x x)) #t)
+(test (let ((x (cons 'a 'b))) (eq? x x)) #t)
+(test (eq? (cons 'a 'b) (cons 'a 'b)) #f)
+(test (eq? "abc" "cba") #f)
+(test (let ((x "hi")) (eq? x x)) #t)
+(test (eq? (string #\h #\i) (string #\h #\i)) #f)
+(test (eq? #(a) #(b)) #f)
+(test (let ((x (vector 'a))) (eq? x x)) #t)
+(test (eq? (vector 'a) (vector 'a)) #f)
+(test (eq? car car) #t)
+(test (eq? car cdr) #f)
+(test (let ((x (lambda () 1))) (eq? x x)) #t)
+(test (let ((x (lambda () 1))) (let ((y x)) (eq? x y))) #t)
+(test (let ((x (lambda () 1))) (let ((y (lambda () 1))) (eq? x y))) #f)
+(test (eq? 'abc 'abc) #t)
+(test (eq? eq? eq?) #t)
+(test (eq? (if #f 1) 1) #f)
+(test (eq? () '(#||#)) #t)
+(test (eq? () '(#|@%$&|#)) #t)
+(test (eq? '#||#hi 'hi) #t) ; ??
+(test (eq? '; a comment
+         hi 'hi) #t) ; similar:
+    (test (cadr '#| a comment |#(+ 1 2)) 1)
+    (test `(+ 1 ,@#||#(list 2 3)) '(+ 1 2 3))
+    (test `(+ 1 ,#||#(+ 3 4)) '(+ 1 7))
+    ;; but not splitting the ",@" or splitting a number:
+    (test (+ 1 2.0+#||#3i) 'error)
+    (test `(+ 1 ,#||#@(list 2 3)) 'error)
+(test (eq? #||# (#|%%|# append #|^|#) #|?|# (#|+|# list #|<>|#) #||#) #t)
+(test (eq? '() ;a comment
+	   '()) #t)
+(test (eq? 3/4 3) #f)
+(test (eq? '() '()) #t)
+(test (eq? '() '(  )) #t)
+(test (eq? '()'()) #t)
+(test (eq? '()(list)) #t)
+(test (eq? () (list)) #t)
+(test (eq? (begin) (append)) #t)
+(test (let ((lst (list 1 2 3))) (eq? lst (apply list lst))) #f) ; changed 26-Sep-11
+
+;(test (eq? 1/0 1/0) #f)
+;(test (let ((+nan.0 1/0)) (eq? +nan.0 +nan.0)) #f)
+;; these are "unspecified" so any boolean value is ok
+
+(test (eq? ''2 '2) #f)
+(test (eq? '2 '2) #t) ; unspecified??
+(test (eq? '2 2) #t)
+(test (eq? ''2 ''2) #f)
+(test (eq? ''#\a '#\a) #f)
+(test (eq? '#\a #\a) #t) ; was #f
+(test (eq? 'car car) #f)
+(test (eq? '()()) #t)
+(test (eq? ''() '()) #f)
+(test (eq? '   () '
+()) #t)
+(test (eq? '#f #f) #t)
+(test (eq? '#f '#f) #t)
+(test (eq? #f '  #f) #t)
+(test (eq? '()'()) #t) ; no space
+(test (#||# eq? #||# #f #||# #f #||#) #t)
+(test (eq? (current-input-port) (current-input-port)) #t)
+(test (let ((f (lambda () (quote (1 . "H"))))) (eq? (f) (f))) #t)
+(test (let ((f (lambda () (cons 1 (string #\H))))) (eq? (f) (f))) #f)
+(test (eq? *stdin* *stdin*) #t)
+(test (eq? *stdout* *stderr*) #f)
+(test (eq? *stdin* *stderr*) #f)
+(test (eq? else else) #t)
+(test (eq? :else else) #f)
+(test (eq? :else 'else) #f)
+(test (eq? :if if) #f)
+(test (eq? 'if 'if) #t)
+(test (eq? :if :if) #t)
+
+(test (eq? (string) (string)) #t) ; was #f
+(test (eq? (string) "") #t) ; was #f -- changed 29-Jun-21
+(test (eq? (vector) (vector)) #f)
+(test (eq? (vector) #()) #f)
+(test (eq? (list) (list)) #t)
+(test (eq? (list) ()) #t)
+(test (eq? (hash-table) (hash-table)) #f)
+(test (eq? (curlet) (curlet)) #t)
+(test (eq? (rootlet) (rootlet)) #t)
+(test (eq? (funclet abs) (funclet abs)) #t) ; or any other built-in...
+(test (eq? letrec* letrec*) #t)
+
+(test (eq? (current-input-port) (current-input-port)) #t)
+(test (eq? (current-error-port) (current-error-port)) #t)
+(test (eq? (current-output-port) (current-output-port)) #t)
+(test (eq? (current-input-port) (current-output-port)) #f)
+
+(test (eq? (string #\a) (string #\a)) #f)
+(test (eq? "a" "a") #f)
+(test (eq? #(1) #(1)) #f)
+(test (let ((a "hello") (b "hello")) (eq? a b)) #f)
+(test (let ((a "foo")) (eq? a (copy a))) #f)
+(test (let ((p (c-pointer 0))) (eq? p (copy p))) #f)
+(test (let ((p (c-pointer 0))) (let ((p1 p)) (eq? p p1))) #t)
+(test (let () (define (g x) x) (define (u x) g) (define (f) (eq? g (u g))) (f)) #t) ; guile mailing list
+
+(begin #| ; |# (display ""))
+(newline)
+
+(test (;
+       eq? ';!
+       (;)()#
+	);((")";
+       ;"#|)#""
+       '#|";"|#(#|;|#); ;#
+	 ;\;"#"#f
+	       )#t)
+
+(test (+ #| this is a comment |# 2 #| and this is another |# 3) 5)
+(test (eq? #| a comment |# #f #f) #t)
+(test (eq? #| a comment |##f #f) #t)  ; ??
+(test (eq? #| a comment | ##f|##f #f) #t) ; ??
+(test (eq? #||##||##|a comment| ##f|##f #f) #t)
+
+(test (+ ;#|
+            3 ;|#
+            4)
+      7)
+(test (+ #| ; |# 3
+		 4)
+      7)
+#!
+(format *stderr* "#! ignored?~%")
+!#
+#|
+(format *stderr* "#| ignored?~%")
+|#
+
+(test (eq? (if #f #t) (if #f 3)) #t)
+
+(test (eq?) 'error)           ; "this comment is missing a double-quote
+(test (eq? #t) 'error)        #| "this comment is missing a double-quote |#
+(test (eq? #t #t #t) 'error)  #| and this has redundant starts #| #| |#
+(test (eq? #f . 1) 'error)
+(test (eq #f #f) 'error)
+
+(define (feq)
+  (let ((things (vector #t #f #\space () "" 0 1 3/4 1+i 1.5 '(1 .2) #() (vector) (vector 1) (list 1) 'f 't #\t)))
+    (let ((len (length things)))
+      (do ((i 0 (+ i 1)))
+	  ((= i (- len 1)))
+        (do ((j (+ i 1) (+ j 1)))
+	    ((= j len))
+  	  (if (eq? (vector-ref things i) (vector-ref things j))
+	      (format #t ";feq: (eq? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j))))))))
+(feq)
+
+;;; these are defined at user-level in s7 -- why are other schemes so coy about them?
+(test (eq? (if #f #f) #<unspecified>) #t)
+(test (eq? (symbol->value '_?__undefined__?_) #<undefined>) #t)
+(test (eq? #<eof> #<eof>) #t)
+(test (eq? #<undefined> #<undefined>) #t)
+(test (eq? #<unspecified> #<unspecified>) #t)
+(test (eq? #<eof> #<undefined>) #f)
+(test (eq? #<eof> ()) #f)
+(test (eq? #<undefined> _undef_) #f)
+(test (eq? _undef_ _undef_) #t)
+
+(test (procedure? #_abs) #t)  ; #_abs evaluates to itself, a procedure
+(test (procedure? '#_abs) #t) ; #_abs is a procedure (the value, not its name, just as '32 is 32 and both are integers)
+(test (procedure? 'abs) #f)
+(test (eq? abs #_abs) #t)
+(test (eq? 'abs '#_abs) #f)
+(test (eq? #_abs '#_abs) #t)
+
+(test (let () (define-macro (hi a) `(+ 1 ,a)) (eq? hi hi)) #t)
+(test (let () (define (hi a) (+ 1 a)) (eq? hi hi)) #t)
+(test (let ((x (lambda* (hi (a 1)) (+ 1 a)))) (eq? x x)) #t)
+
+(test (eq? quasiquote quasiquote) #t)
+(test (eq? `quasiquote 'quasiquote) #t)
+(test (eq? 'if (keyword->symbol :if)) #t)
+(test (eq? 'if (string->symbol "if")) #t)
+(test (eq? (copy lambda) (copy 'lambda)) #f)
+(test (eq? if 'if) #f)
+(test (eq? if `if) #f)
+(test (eq? if (keyword->symbol :if)) #f)
+(test (eq? if (string->symbol "if")) #f)
+(test (eq? lambda and) #f)
+(test (eq? let let*) #f)
+(test (eq? quote quote) #t)
+(test (eq? '"hi" '"hi") #f) ; guile also
+;(test (eq? '"" "") #f)
+;(test (eq? '"" '"") #f)
+;(test (eq? "" "") #f)
+(test (eq? #() #()) #f)
+(test (eq? '#() #()) #f)
+(test (eq? '#() '#()) #f)
+(test (let ((v #())) (eq? v #())) #f)
+(test (let ((v #())) (eq? v v)) #t)
+(test (call/cc (lambda (return) (return (eq? return return)))) #t)
+(test (let ((r #f)) (call/cc (lambda (return) (set! r return) #f)) (eq? r r)) #t)
+(test (eq? _unbound_variable_ #f) 'error)
+
+(when with-block
+  (let ((b (make-block 4)))
+    (test (eq? b b) #t)
+    (test (equal? b b) #t)
+    (test (block? b) #t)
+    (test (block? #()) #f)
+    (test (block? #f) #f)
+    (set! (b 0) 32)
+    (test (b 0) 32.0)
+    (let () (define (hi b i) (b i)) (test (hi b 0) 32.0))
+    (let () (define (hi b) (b 0)) (test (hi b) 32.0))
+    (let () (define (hi b) (b)) (test (hi b) 'error)) ;was 32!?
+    (test b (block 32.0 0.0 0.0 0.0))
+    (test (let? (block-let b)) #t)
+    (test (((block-let b) 'float-vector?) b) #t)
+    (test (object->string b) "(block 32.000 0.000 0.000 0.000)")
+    (let ((b1 (make-block 4)))
+      (test (eq? b b1) #f))
+    (let ((b (block 1 2)))
+      (test (vector-ref b 0) 1.0)
+      (test (vector-set! b 0 3) 3)
+      (test b (block 3 2)))
+    (test (map abs b) (list 32.0 0.0 0.0 0.0)))
+  (let ((b (block 1 2 3)))
+    (test (reverse b) (block 3 2 1))
+    (test b (block 1 2 3))
+    (test (reverse b 1) 'error)
+    (test (reverse! b) (block 3 2 1))
+    (test (reverse! b 1) 'error)
+    (test b (block 3 2 1))
+    (test (b 'a) 'error)
+    (test (b) 'error)
+    (test (procedure? (b 'empty)) #t)
+    (test (b 'empty #f) 'error)
+    (test ((b 'empty) b) #f)
+    (test ((b 'empty)) 'error)
+    (test ((b 'empty) b 123) 'error)
+    (test ((b 'empty) 123) 'error)
+    (test ((block) 'a) 'error))
+
+  (when full-s7test
+    (define (iota-block len)
+      (let ((b (make-block len)))
+        (do ((i 0 (+ i 1)))
+            ((= i len) b)
+          (block-set! b i i))))
+    (do ((i 0 (+ i 1)))
+        ((= i 512))
+      (let* ((b (iota-block i))
+             (b1 (reverse b))
+             (b2 (reverse! b)))
+        (unless (equal? b1 b2)
+          (format *stderr* "reverse iota-block ~D: ~A~%    ~A~%" i b1 b2)))))
+
+  ;; check map/for-each
+  (test (let () (define (func) ((lambda () (map (vector 0 1 2) '(1))))) (func)) '(1))
+  (let ((b (block 1 2 3)))
+    (test ((lambda () (map b '(1)))) '(2.0))
+    (test (let () (define (func) ((lambda () (for-each b '(1))))) (func)) #<unspecified>)
+    (test (let () (define (func) ((lambda () (map b '(1))))) (func)) '(2.0))
+    (test (let () (define (func) ((lambda () (map b '(xyx 1))))) (func)) 'error)
+    (test (let () (define (func) ((lambda () (map (vector 1 2) '(xyx 1))))) (func)) 'error)
+    (test (let () (define (func) ((lambda () (map b '(3 1))))) (func)) 'error)
+    (test (let () (define (func) ((lambda () (map b '(#(1) 1))))) (func)) 'error))
+
+  (test (object->string (block +nan.0)) "(block +nan.0)")
+  (test (object->string (block +inf.0)) "(block +inf.0)")
+  (test (object->string (block -inf.0)) "(block -inf.0)")
+  (test (object->string (block pi)) "(block 3.142)")
+  (test (object->string (block +nan.0) :readable) "(block +nan.0)")
+  (test (object->string (block +inf.0) :readable) "(block +inf.0)")
+  (test (object->string (block -inf.0) :readable) "(block -inf.0)")
+  (test (object->string (block pi) :readable) "(block 3.141592653589793)") ; (block pi) would be better
+  (let-temporarily (((*s7* 'float-format-precision) 8))
+    (test (object->string (block pi)) "(block 3.14159265)"))
+
+  (let ((v (make-vector 2 (block 1.0) block?)))
+    (test (block? (v 0)) #t)
+    (vector-set! v 0 (block 2.0))
+    (test (block-ref (vector-ref v 0) 0) 2.0)
+    (test (#_block-ref (vector-ref v 0) 0) 2.0)
+    (test (vector-set! v 0 #f) 'error)
+    (test (signature v) (let ((lst (list 'block? 'vector? 'integer?))) (set-cdr! (cddr lst) (cddr lst)) lst)))
+
+  (let ((h (make-hash-table 8 #f (cons symbol? block?))))
+    (hash-table-set! h 'a (block 1.0))
+    (test (block? (h 'a)) #t)
+    (test (block-ref (h 'a) 0) 1.0)
+    (test (hash-table-set! h 'b 'asdf) 'error)
+    (test (hash-table-set! h "b" (block)) 'error)
+    (test (signature h) '(block? hash-table? symbol?)))
+
+  (let ((h (make-hash-table 8 #f (cons #t block?))))
+    (hash-table-set! h 'a (block 2.0))
+    (test (block? (h 'a)) #t)
+    (test (block-ref (h 'a) 0) 2.0)
+    (test (hash-table-set! h 'b 'asdf) 'error)
+    (test (hash-table-set! h "b" (block)) (block))
+    (test (signature h) '(block? hash-table? #t)))
+
+  (let ((h (make-hash-table 8 #f (cons symbol? #t))))
+    (hash-table-set! h 'a (block 2.0))
+    (test (block? (h 'a)) #t)
+    (test (block-ref (h 'a) 0) 2.0)
+    (test (hash-table-set! h 'b 'asdf) 'asdf)
+    (test (hash-table-set! h "b" (block)) 'error)
+    (test (signature h) '(#t hash-table? symbol?))
+    (test (block-ref (block 1.0 2.0 3.0) else) 'error))
+
+  (test (make-hash-table 8 #f (cons #t #f)) 'error)
+  (test (make-hash-table 8 #f ()) 'error)
+
+  (let ((sig (list #t 'hash-table? #t)))
+    (set-cdr! (cddr sig) (cddr sig))
+    (test (signature (make-hash-table 8 #f (cons #t #t))) sig)) ; same as (signature (make-hash-table 8 #f [#f]))
+
+  (test (blocks) (list 4 1))
+  (test (blocks :frequency 2) (list 2 1))
+  (let ((freq :frequency)) (test (blocks freq 2) (list 2 1)))
+  (let ((freq :scaler)) (test (blocks freq 2) (list 4 2)))
+  (let ((c #f)) (test (blocks (if c 100 :frequency) 10) (list 10 1)))
+  (test (blocks :scaler 3 :frequency 2) (list 2 3))
+  (test (blocks :scaler 3 :phase 1) 'error)
+  (test (map blocks '(1 2 3)) '((1 1) (2 1) (3 1)))
+  (test (map blocks '( 1 2 3) '(4 5 6)) '((1 4) (2 5) (3 6)))
+  (test (documentation blocks) "test for function*")
+  (test (apply blocks '(:frequency 5 :scaler 4)) '(5 4))
+  (test (let () (define (b1) (blocks 100)) (b1)) '(100 1))
+  (test (let () (define (b1) (blocks 10 2)) (b1)) '(10 2))
+  (test (procedure? blocks) #t)
+  (unless (or with-bignums (> (*s7* 'debug) 0)) ; debug turns off s7-optimize
+    (test (s7-optimize '((block-append (make-block 2) (block)))) (block 0 0))) ; segfault due to plist overuse
+
+  (let ((b1 (block 1)) (b2 (block 2)) (x1 2.0) (x2 3.0) (i 0) (j 0) (x 0.0))
+    (define (g1) ; opt_d_dd_fff_rev
+      (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (+ (* x1 (block-ref b1 i)) (* x2 (block-ref b2 j))))))
+    (test (g1) 8.0)
+    (define (g2) ; opt_d_dd_fff
+      (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (+ (* (block-ref b1 i) x1) (* (block-ref b2 j) x2)))))
+    (test (g2) 8.0))
+
+  (test (unsafe-blocks) (list 4 1))
+  (test (unsafe-blocks :frequency 2) (list 2 1))
+  (test (unsafe-blocks :scaler 3 :frequency 2) (list 2 3))
+  (test (unsafe-blocks :scaler 3 :phase 1) 'error)
+  (test (map unsafe-blocks '(1 2 3)) '((1 1) (2 1) (3 1)))
+  (test (map unsafe-blocks '( 1 2 3) '(4 5 6)) '((1 4) (2 5) (3 6)))
+  (test (documentation unsafe-blocks) "test for function*")
+  (test (apply unsafe-blocks '(:frequency 5 :scaler 4)) '(5 4))
+  (test (let () (define (b1) (unsafe-blocks 100)) (b1)) '(100 1))
+  (test (let () (define (b1) (unsafe-blocks 10 2)) (b1)) '(10 2))
+  (test (procedure? unsafe-blocks) #t)
+
+  (test (blocks3 (car (list :a))) 'error)
+  (test (let () (define (func) (blocks3 (car (list :a)))) (func)) 'error)
+
+  (test (let () (define (func) (unsafe-blocks :asdf)) (func)) 'error)   ; hop_safe_c_function_star_a bug
+  (test (unsafe-blocks 3 :asdf) 'error)
+  (test (let () (define (func) (unsafe-blocks 3 :asdf)) (func)) 'error) ; hop_c_aa bug
+
+  (test (let () (define (func) (unsafe-blocks1 :asdf)) (func)) 'error) ; ??
+  (test (let () (define (func) (unsafe-blocks1 :fdsa)) (func)) 'error) ; ??
+  (test (unsafe-blocks1 3 :asdf) 'error)
+  (test (let () (define (func) (unsafe-blocks1 3 :asdf)) (func)) 'error)
+  (test (let () (define (func) (unsafe-blocks3 :asdf)) (func)) 'error)
+  (test (unsafe-blocks3 3 :asdf) 'error)
+  (test (catch #t (lambda () (blocks3 1 2 3)) (lambda (t i) (apply format *stderr* i))) '(1 2 3))
+  (test (let () (define (func) (unsafe-blocks3 3 :asdf)) (func)) 'error)
+
+  (test (let () (define (func) (unsafe-blocks3 1 3 :asdf)) (func)) 'error)  ; ?? all 6
+  (test (unsafe-blocks3 1 3 :asdf) 'error)
+  (test (let () (define (func) (unsafe-blocks3 1 3 :asdf)) (func)) 'error)
+  (test (let () (define (func) (unsafe-blocks3 1 3 :fdsa)) (func)) 'error)
+  (test (unsafe-blocks3 1 3 :fdsa) 'error)
+  (test (let () (define (func) (unsafe-blocks3 1 3 :fdsa)) (func)) 'error)
+
+  (test (let () (define (func) (unsafe-blocks1 :asdf)) (func)) 'error)  ; h_c_a
+  (test (let () (define (func) (unsafe-blocks1 :fdsa)) (func)) 'error)
+
+  (test (let () (define (func) (unsafe-blocks3 1 3 :asdf)) (func)) 'error)  ; h_c_fx
+  (test (unsafe-blocks3 1 3 :asdf) 'error)
+
+  (test (let () (define (func) (unsafe-blocks3 1 3 :asdf)) (func)) 'error)
+  (test (let () (define (func) (unsafe-blocks3 1 3 :fdsa)) (func)) 'error)
+  (test (unsafe-blocks3 1 3 :fdsa) 'error)
+  (test (let () (define (func) (unsafe-blocks3 1 3 :fdsa)) (func)) 'error)
+
+  (test (let () (define (func) (blocks :asdf)) (func)) 'error)
+  (test (blocks 3 :asdf) 'error)
+  (test (let () (define (func) (blocks 3 :asdf)) (func)) 'error)
+
+  (test (blocks1 :asdf) 'error)
+  (test (let () (define (func) (blocks1 :asdf)) (func)) 'error)   ; h_safe_c_d
+  (test (let () (define (func) (blocks1 :fdsa)) (func)) 'error)
+  (test (let ((sk :rest)) (define (func) (blocks1  sk)) (func)) 'error)
+
+  (test (blocks1 3 :asdf) 'error)
+  (test (let () (define (func) (blocks1 3 :asdf)) (func)) 'error)
+  (test (let () (define (func) (blocks3 :asdf)) (func)) 'error)
+  (test (blocks3 3 :asdf) 'error)
+  (test (let () (define (func) (blocks3 3 :asdf)) (func)) 'error)
+  (test (let () (define (func) (blocks3 1 3 :asdf)) (func)) 'error)
+  (test (blocks3 1 3 :asdf) 'error)
+
+  (test (let () (define (func) (blocks3 1 3 :asdf)) (func)) 'error)  ; h_safe_c_d
+  (test (let () (define (func) (blocks3 1 3 :fdsa)) (func)) 'error)
+  (test (blocks3 1 3 :fdsa) 'error)
+
+  (test (let () (define (func) (blocks4 :asdf)) (func)) 'error)
+  (test (blocks4 1 2 3 :etc) 'error)
+  (test (let () (define (func) (blocks4 3 :asdf)) (func)) 'error)
+  (test (let () (define (func) (blocks4 1 2 3 :etc)) (func)) 'error)
+  (test (blocks4 1 3 :fdsa) 'error)
+  (test (let () (define (func) (blocks4 1 2 3 :fdsa)) (func)) 'error)
+  (test (blocks4 1 2 3 :fdsa) 'error)
+
+  (test (blocks5) '(4))
+  (test (blocks5 :frequency 440) '(440))
+  (test (blocks5 :frequency 440 :amplitude 1.0) '(440))
+  (test (blocks5 1) '(1))
+  (test (blocks5 1 2) 'error) ; error: blocks5: too many arguments: (1 2)
+  (test (blocks5 :a 1 :b 2) '(4))
+  (test (blocks5 :a 1 :b 2 :frequency 440 :c 3) '(440))
+  (test (let () (define (f) (blocks5 :a 1 :frequency 440)) (f)) '(440))
+  (test (blocks5 :x) 'error) ; value missing
+  (test (let () (define (f) (object->string (blocks5 (values :ho)))) (f)) 'error)
+  (test (let () (define (f) (object->string (blocks5 (car (list :ho))))) (f)) 'error)
+  (test (let () (define (f) (object->string (blocks4 (car (list :ho))))) (f)) 'error)
+  (test (let () (define (f) (blocks5 :ho)) (f)) 'error)
+  (test (let () (define (f) (blocks5 (symbol->keyword 'oops))) (f)) 'error)
+  (test (let () (define (f) (blocks5 (string->keyword 'oops))) (f)) 'error)
+  (test (blocks5 frequency: 440) '(440))
+  (test (blocks5 frequency: 440 amplitude: 1.0) '(440))
+  (test (blocks5 a: 1 :b 2) '(4))
+  (test (blocks5 :a 1 b: 2 frequency: 440 :c 3) '(440))
+
+  (test (call/cc (setter (block))) 'error)
+  (test (call-with-exit (setter (block))) 'error)
+  (test (call-with-input-string "123" (setter (block))) 'error)
+
+  (let ((b (make-simple-block 4)))
+    (test (eq? b b) #t)
+    (test (equal? b b) #t)
+    (test (simple-block? b) #t)
+    (test (simple-block? #()) #f)
+    (test (simple-block? #f) #f)
+    (set! (b 0) 32)
+    (test (b 0) 32.0)
+    (test (length b) 4)
+    (test (substring (object->string b) 0 17) "#<<simple-block> ")
+    (test (substring (object->string b :readable) 0 17) "#<<simple-block> ")
+    (let ((iter (make-iterator b)))
+      (test (iterate iter) 32.0)
+      (test (iter) 0.0)
+      (test (object->string iter) "#<iterator: <simple-block>>"))
+    (test (copy b) 'error)
+    (test (reverse b) 'error)
+    (test (reverse! b) 'error)
+    (test (fill! b) 'error)
+    (let ((b1 (make-simple-block 4)))
+      (copy b b1)
+      (test (equal? b b1) #f)
+      (test (b1 0) 32.0)
+      (test (append b b1) 'error))
+    (s7-optimize '((b 0))))
+
+  (test (make-vector 12 "ho" simple-block?) 'error)
+  (test (signature (make-vector 12 (make-simple-block 1) simple-block?))
+	(let ((L (list 'simple-block? 'vector? 'integer?)))
+	  (set-cdr! (cddr L) (cddr L))
+	  L))
+  (test (make-vector 12 "ho" block?) 'error)
+  (test (signature (make-vector 12 (make-block 1) block?))
+	(let ((L (list 'block? 'vector? 'integer?)))
+	  (set-cdr! (cddr L) (cddr L))
+	  L))
+  (test (make-vector 12 "ho" c-tag?) 'error)
+  (test (signature (make-vector 12 (make-c-tag) c-tag?)) 'error)
+
+  (test (let ((h (make-hash-table 8 #f (cons symbol? simple-block?)))) (hash-table-set! h 'a 1234)) 'error)
+  (test (let ((h (make-hash-table 8 #f (cons symbol? simple-block?)))) (signature h)) '(simple-block? hash-table? symbol?))
+  (test (let ((h (make-hash-table 8 #f (cons simple-block? symbol?)))) (hash-table-set! h (make-simple-block 1) 'a)) 'a)
+  (test (let ((h (make-hash-table 8 #f (cons simple-block? symbol?)))) (signature h)) '(symbol? hash-table? simple-block?))
+
+  (let ((g (make-cycle "123")))
+    (test (cycle-ref g) "123")
+    (test (substring (object->string g) 0 10) "#<<cycle> ")
+    (test (object->string g :readable) "(<cycle> \"123\")")
+    (test (cycle-set! g "321") "321")
+    (test (cycle-ref g) "321")
+    (test (equal? g 21) #f)
+    (test (equal? g g) #t)
+    (test (equal? g (make-cycle #\a)) #f)
+    (test (equal? g (make-cycle "321")) #t)
+    (test (equal? g (<cycle> "321")) #t)
+    (test (set! (g 0) 1) 1)
+    (test (set! (g 0 1) 2) 'error)
+    (cycle-set! g g)
+    (let ((g1 (make-cycle g)))
+      (test (equal? g g1) #t))
+    (set! (g 0) #f)
+    (test (cycle-ref g) #f)
+    (set! (g 0) g)
+    (test (substring (object->string g) 0 13) "#1=#<<cycle> ")
+    (test-wi (object->string g :readable) "(let ((<1> (<cycle> #f))) (set! (<1> 0) <1>) <1>)")
+    (let ((L (list 1)))
+      (cycle-set! g L)
+      (set! (L 0) g)
+      (test-wi (object->string g :readable)
+	       "(let ((<1> (<cycle> #f)))
+                  (set! (<1> 0) (let ((<L> (list #f)))
+                                  (set-car! <L> <1>)
+                                  <L>))
+                  <1>)"))
+    (let ((g2 (make-cycle g)))
+      (test (equal? g g2) #f))
+    (let ((L (list 1)))
+      (set-cdr! L L)
+      (test-wi (object->string (make-cycle L) :readable) "(let ((<2> (<cycle> #f)) (<1> (list 1))) (set! (<2> 0) <1>) (set-cdr! <1> <1>) <2>)"))
+    (let ((L (list (<cycle> 2) 3)))
+      (set-cdr! (cdr L) L)
+      (test-wi (object->string L :readable) "(let ((<1> (list (<cycle> 2) 3))) (set-cdr! (cdr <1>) <1>) <1>)"))
+    (let ((L2 (make-list 3 #f))
+	  (C (<cycle> #f))
+	  (V1 (make-vector 3 #f)))
+      (set! (L2 0) V1)
+      (set! (V1 0) C)
+      (set! (C 0) C)
+      (set! (V1 1) L2)
+      (test-wi (object->string L2 :readable)
+	       "(let ((<3> (list #f #f #f))
+                      (<2> (vector #f #f #f))
+                      (<1> (<cycle> #f)))
+                  (set-car! <3> <2>)
+                  (set! (<2> 0) <1>)
+                  (set! (<2> 1) <3>)
+                  (set! (<1> 0) <1>)
+                  <3>)"))
+    (let ((L (list #f))
+	  (C (make-cycle #f)))
+      (set! (L 0) C)
+      (let ((IT (make-iterator L)))
+	(set! (C 0) IT)
+	(test-wi (object->string IT :readable)
+		 "(let ((<1> #f)
+                        (<3> (list #f))
+                        (<2> (<cycle> #f)))
+                    (set! <1> (make-iterator <3>))
+                    (set-car! <3> <2>)
+                    (set! (<2> 0) <1>)
+                    <1>)")))
+    (let ((cy (make-cycle #f))
+	  (it (make-iterator (make-list 3 #f)))
+	  (cp (c-pointer 1 (make-list 3 #f))))
+      (set! (((object->let cp) 'c-type) 1) cy)
+      (set! ((iterator-sequence it) 1) it)
+      (set! (cy 0) it)
+      (test-wi (object->string cp :readable)
+	       "(let ((<4> (list #f #f #f))
+                      (<3> (<cycle> #f))
+                      (<1> #f)
+                      (<2> (list #f #f #f)))
+                  (set! <1> (make-iterator <2>))
+                  (set! (<4> 1) <3>)
+                  (set! (<3> 0) <1>)
+                  (set! (<2> 1) <1>)
+                  (c-pointer 1 <4> #f))")))
+  (test (let->list (make-cycle 1)) (list (rootlet)))
+
+  (let ((b (make-c-tag)))
+    (test (eq? b b) #t)
+    (test (equal? b b) #t)
+    (test (b 0) 'error)
+    (test (length b) #f)
+    (test (substring (object->string b :readable) 0 8) "#<c-tag ")
+    (let ((str (object->string b)))
+      (test (substring str 0 8) "#<c-tag ")
+      (test (str (- (length str) 1)) #\>))
+    (let ((iter (make-iterator b)))
+      (test (iterate iter) #<eof>)
+      (test (object->string iter) "#<iterator: c-tag>"))
+    (test (copy b) 'error)
+    (test (reverse b) 'error)
+    (test (reverse! b) 'error)
+    (test (fill! b) 'error)
+    (let ((b1 (make-c-tag)))
+      (copy b b1)
+      (test (equal? b b1) #f)
+      (test (append b b1) 'error))
+    (test (setter (make-c-tag)) #f))
+
+  (let ((b (make-c-tag1))) ; checking NULL fields
+    (test (eq? b b) #t)
+    (test (equal? b b) #t)
+    (test (b 0) 'error)
+    (test (length b) #f)
+    (test (substring (object->string b :readable) 0 8) "#<c-tag1")
+    (let ((str (object->string b)))
+      (test (substring str 0 8) "#<c-tag1")
+      (test (str (- (length str) 1)) #\>))
+    (let ((iter (make-iterator b)))
+      (test (iterate iter) #<eof>)
+      (test (object->string iter) "#<iterator: c-tag1>"))
+    (test (copy b) 'error)
+    (test (reverse b) 'error)
+    (test (reverse! b) 'error)
+    (test (fill! b) 'error)
+    (let ((b1 (make-c-tag)))
+      (copy b b1)
+      (test (equal? b b1) #f)
+      (test (append b b1) 'error))
+    (test (setter (make-c-tag1)) #f))
+
+  (define (fv32)
+    (let ((b (block 1 2 3 4))
+	  (f (make-float-vector 4)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 4) f)
+	(set! (f i) (+ (b i) 1.0)))))
+  (test (fv32) (float-vector 2.0 3.0 4.0 5.0))
+
+  (define (fv33)
+    (let ((b (block 1 2 3 4))
+	  (f (make-block 4)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 4) f)
+	(set! (f i) (+ (b i) 1.0)))))
+  (test (fv33) (block 2.0 3.0 4.0 5.0))
+
+  (define (fv34)
+    (let ((b (block 1 2 3 4))
+	  (f (make-vector 4)))
+      (do ((k 0 (+ k 1)))
+	  ((= k 1) f)
+	(do ((i 0 (+ i 1)))
+	    ((= i 4))
+	  (set! (f i) (b i))))))
+  (test (fv34) (vector 1.0 2.0 3.0 4.0)))
+
+(when with-block
+  (test (pair? (*s7* 'c-types)) #t))
+
+;;; a ridiculous optimizer typo...
+(test (let ((sym 'a)) (define (hi a) (eq? (cdr a) sym)) (hi '(a a))) #f)
+(test (let ((sym 'a)) (define (hi a) (eq? (cdr a) sym)) (hi '(a . a))) #t)
+(test (let ((sym 'a)) (define (hi a) (eq? (cdr a) sym)) (hi '(a . b))) #f)
+
+(for-each
+ (lambda (arg)
+   (let ((x arg)
+	 (y arg))
+     (if (not (eq? x x))
+	 (format #t ";(eq? x x) of ~A -> #f?~%" x))
+     (if (not (eq? x arg))
+	 (format #t ";(eq? x arg) of ~A ~A -> #f?~%" x arg))
+     (if (not (eq? x y))
+	 (format #t ";(eq? x y) of ~A ~A -> #f?~%" x y))))
+ ;; actually I hear that #f is ok here for numbers
+ (list "hi" '(1 2) (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3/4 #\f (lambda (a) (+ a 1)) :hi (if #f #f) #<eof> #<undefined>))
+;; this used to include 3.14 and 1+i but that means the (eq? x x) case differs from the (eq? 3.14 3.14) case
+
+(define comment-start (port-line-number))
+#|
+:'(1(1))
+(1 (1))
+:'(1#(1))
+(1# (1))
+|#
+(if (not (= (- (port-line-number) comment-start) 7)) (format *stderr* ";block comment newline counter: ~D ~D~%" comment-start (port-line-number)))
+(test (eval-string "|#") 'error)
+
+;;; this comes from G Sussman
+(let ()
+  (define (counter count)
+    (lambda ()
+      (set! count (+ 1 count))
+      count))
+
+  (define c1 (counter 0))
+  (define c2 (counter 0))
+
+  (test (eq? c1 c2) #f)
+  (test (eq? c1 c1) #t)
+  (test (eq? c2 c2) #t)
+
+  (test (let ((p (lambda (x) x))) (eqv? p p)) #t)
+  (for-each
+   (lambda (arg)
+     (if (not ((lambda (p) (eq? p p)) arg))
+	 (format #t "~A not eq? to itself?~%" arg)))
+   (list "hi" '(1 2) (integer->char 65) 1 'a-symbol (make-vector 3) abs quasiquote macroexpand 1/0 (log 0)
+	 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi (if #f #f) #<eof> #<undefined> '(1 2 . 3)
+	 (let ((lst (list 1 2)))
+	   (set! (cdr (cdr lst)) lst)
+	   lst)
+	 (vector) (string) (list)
+	 (let ((x 3))
+	   (lambda (y) (+ x y))))))
+
+;;; this for r7rs
+(test (eq? #t #true) #t)
+(test (eq? #f #false) #t)
+(test (eq? () (map values ())) #t)
+
+(let () (define (f2) f2) (test (eq? f2 (f2)) #t))
+(letrec ((f2 (lambda () f2))) (test (eq? f2 (f2)) #t))
+
+
+;;; --------------------------------------------------------------------------------
+;;; eqv?
+
+(test (eqv? 'a 3) #f)
+(test (eqv? #t 't) #f)
+(test (eqv? "abs" 'abc) #f)
+(test (eqv? "hi" '(hi)) #f)
+(test (eqv? "()" ()) #f)
+(test (eqv? '(1) '(1)) #f)
+(test (eqv? '(#f) '(#f)) #f)
+(test (eqv? #\a #\b) #f)
+(test (eqv? #\a #\a) #t)
+(test (eqv? (integer->char 255) (string-ref (string #\x (integer->char 255) #\x) 1)) #t)
+(test (eqv? (integer->char #xf0) (integer->char #x70)) #f)
+(test (eqv? #\space #\space) #t)
+(test (let ((x (string-ref "hi" 0))) (eqv? x x)) #t)
+(test (eqv? #t #t) #t)
+(test (eqv? #f #f) #t)
+(test (eqv? #f #t) #f)
+(test (eqv? (null? ()) #t) #t)
+(test (eqv? (null? '(a)) #f) #t)
+(test (eqv? (cdr '(a)) '()) #t)
+(test (eqv? 'a 'a) #t)
+(test (eqv? 'a 'b) #f)
+(test (eqv? 'a (string->symbol "a")) #t)
+(test (eqv? '(a) '(b)) #f)
+(test (let ((x '(a . b))) (eqv? x x)) #t)
+(test (let ((x (cons 'a 'b))) (eqv? x x)) #t)
+(test (eqv? (cons 'a 'b) (cons 'a 'b)) #f)
+(test (eqv? "abc" "cba") #f)
+(test (let ((x "hi")) (eqv? x x)) #t)
+(test (eqv? (string #\h #\i) (string #\h #\i)) #f)
+(test (eqv? #(a) #(b)) #f)
+(test (let ((x (vector 'a))) (eqv? x x)) #t)
+(test (eqv? (vector 'a) (vector 'a)) #f)
+(test (eqv? car car) #t)
+(test (eqv? car cdr) #f)
+(test (let ((x (lambda () 1))) (eqv? x x)) #t)
+(test (eqv? (lambda () 1) (lambda () 1)) #f)
+(test (let () (define (make-adder x) (lambda (y) (+ x y))) (eqv? (make-adder 1) (make-adder 1))) #f)
+(test (eqv? 9/2 9/2) #t)
+(test (eqv? quote quote) #t)
+(test (eqv? () ()) #t)
+(test (eqv? () '()) #t)
+;(test (eqv? "" "") #f)
+(test (eqv? "hi" "hi") #f) ; unspecified
+(test (eqv? #() #()) #f)   ; unspecified, but in s7 (eqv? () ()) is #t
+(test (eqv? (vector) (vector)) #f)
+
+(let ((c1 (let ((x 32))
+	    (lambda () x)))
+      (c2 (let ((x 123))
+	    (lambda () x))))
+  (test (eqv? c1 c2) #f)
+  (test (eqv? c1 c1) #t))
+
+(test (eqv? most-positive-fixnum most-positive-fixnum) #t)
+(test (eqv? most-positive-fixnum most-negative-fixnum) #f)
+(test (eqv? 9223372036854775807 9223372036854775806) #f)
+(test (eqv? 9223372036854775807 -9223372036854775808) #f)
+(test (eqv? -9223372036854775808 -9223372036854775808) #t)
+(test (eqv? 123456789/2 123456789/2) #t)
+(test (eqv? 123456789/2 123456787/2) #f)
+(test (eqv? -123456789/2 -123456789/2) #t)
+(test (eqv? 2/123456789 2/123456789) #t)
+(test (eqv? -2/123456789 -2/123456789) #t)
+(test (eqv? 2147483647/2147483646 2147483647/2147483646) #t)
+(test (eqv? 3/4 12/16) #t)
+(test (eqv? 1/1 1) #t)
+(test (eqv? 312689/99532 833719/265381) #f)
+(test (let ((x 3.141)) (eqv? x x)) #t)
+(test (let ((x 1+i)) (eqv? x x)) #t)
+(test (let* ((x 3.141) (y x)) (eqv? x y)) #t)
+(test (let* ((x 1+i) (y x)) (eqv? x y)) #t)
+(test (let* ((x 3/4) (y x)) (eqv? x y)) #t)
+(test (eqv? 1.0 1.0) #t)
+(test (eqv? 0.6 0.6) #t)
+(test (eqv? 0.6 0.60) #t)
+(test (eqv? 1+i 1+i) #t)
+(test (eqv? -3.14 -3.14) #t)
+(test (eqv? 1e2 1e2) #t)
+(test (eqv? 1 1.0) #f)
+(test (eqv? 1/2 0.5) #f)
+(test (eqv? 1 1/1) #t)
+(test (eqv? 0.5 5e-1) #t)
+(test (eqv? 1/0 1/0) #f)
+(test (eqv? +nan.0 +nan.0) #f)
+
+(test (eqv? (cons 'a 'b) (cons 'a 'c)) #f)
+(test (eqv? eqv? eqv?) #t)
+(test (eqv? #(1) #(1)) #f)
+(test (eqv? '(1) '(1)) #f)
+(test (eqv? '() '()) #t)
+(test (eqv? '() (list)) #t)
+(test (eqv? '(()) '(())) #f)
+(test (eqv? (list 'abs 'cons) '(abs cons)) #f)
+
+(define (feqv)
+  (let ((things (vector #t #f #\space '() "" 0 1 3/4 1+i 1.5 '(1 .2) #() (vector) (vector 1) (list 1) 'f 't #\t)))
+    (let ((len (length things)))
+      (do ((i 0 (+ i 1)))
+	  ((= i (- len 1)))
+        (do ((j (+ i 1) (+ j 1)))
+	    ((= j len))
+	  (if (eqv? (vector-ref things i) (vector-ref things j))
+	      (format #t ";(eqv? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j))))))))
+(feqv)
+
+(test (eqv?) 'error)
+(test (eqv? #t) 'error)
+(test (eqv? #t #t #t) 'error)
+(test (eqv #f #f) 'error)
+
+(test (eqv? ''2 '2) #f)
+(test (eqv? '2 '2) #t)
+(test (eqv? '2 2) #t)
+(test (eqv? ''2 ''2) #f)
+(test (eqv? ''#\a '#\a) #f)
+(test (eqv? '#\a #\a) #t)
+(test (eqv? 'car car) #f)
+(test (eqv? ''() '()) #f)
+(test (eqv? '#f #f) #t)
+(test (eqv? '#f '#f) #t)
+(test (eqv? #<eof> #<eof>) #t)
+(test (eqv? #<undefined> #<undefined>) #t)
+(test (eqv? #<unspecified> #<unspecified>) #t)
+(test (eqv? (if #f #f) #<unspecified>) #t)
+(test (eqv? #<eof> #<undefined>) #f)
+(test (eqv? #<eof> '()) #f)
+(test (let () (define-macro (hi a) `(+ 1 ,a)) (eqv? hi hi)) #t)
+(test (let () (define (hi a) (+ 1 a)) (eqv? hi hi)) #t)
+(test (let ((x (lambda* (hi (a 1)) (+ 1 a)))) (eqv? x x)) #t)
+(test (eqv? else else) #t)
+(test (let ((p (lambda (x) x))) (eqv? p p)) #t)
+(test (eqv? #<undefined> _undef_) #f)
+(test (eqv? _undef_ _undef_) #t)
+
+(test (eqv? :a 'a) #f)
+(test (eqv? :a a:) #f)
+(test (eqv? :a :a) #t)
+
+(when with-bignums
+  (test (eqv? (bignum "1+i") (bignum "1+i")) #t)
+  (test (eqv? (bignum "1+i") 1+i) #t)
+  (test (eqv? 1+i (bignum "1+i")) #t)
+  (test (eqv? (bignum "2.0") (bignum "2.0")) #t)
+  (test (eqv? (bignum "2.0") (bignum "1.0")) #f)
+  (test (eqv? (bignum +nan.0) (bignum 2.0)) #f)
+  (test (eqv? (bignum +nan.0) 2.0) #f)
+  (test (eqv? (bignum +nan.0) +nan.0) #f)
+  (test (eqv? (complex +nan.0 1.0) (bignum (complex +nan.0 1.0))) #f))
+
+;; from M Weaver:
+(test (list (eqv? +0.0 -0.0)
+	    (eqv? (complex +0.0  1.0)
+		  (complex -0.0  1.0))
+	    (eqv? (complex  1.0 +0.0)
+		  (complex  1.0 -0.0)))
+      '(#t #t #t))
+(test (list ;(eq? +0.0 -0.0)
+        (eq? (complex  +0.0  1.0)
+              (complex -0.0  1.0))
+        (eq? (complex   1.0 +0.0)
+              (complex  1.0 -0.0)))
+      '(#f #f))
+(test (list (eq? +0 -0)
+        (eq? (complex  +0  1)
+              (complex -0  1))
+        (eq? (complex   1 +0)
+              (complex  1 -0)))
+      '(#t #f #t))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; equal?
+
+(test (equal? 'a 3) #f)
+(test (equal? #t 't) #f)
+(test (equal? "abs" 'abc) #f)
+(test (equal? "hi" '(hi)) #f)
+(test (equal? "()" '()) #f)
+(test (equal? '(1) '(1)) #t)
+(test (equal? '(#f) '(#f)) #t)
+(test (equal? '(()) '(() . ())) #t)
+(test (equal? #\a #\b) #f)
+(test (equal? #\a #\a) #t)
+(test (let ((x (string-ref "hi" 0))) (equal? x x)) #t)
+(test (equal? #t #t) #t)
+(test (equal? #f #f) #t)
+(test (equal? #f #t) #f)
+(test (equal? (null? '()) #t) #t)
+(test (equal? (null? '(a)) #f) #t)
+(test (equal? (cdr '(a)) '()) #t)
+(test (equal? 'a 'a) #t)
+(test (equal? 'a 'b) #f)
+(test (equal? 'a (string->symbol "a")) #t)
+(test (equal? '(a) '(b)) #f)
+(test (equal? '(a) '(a)) #t)
+(test (let ((x '(a . b))) (equal? x x)) #t)
+(test (let ((x (cons 'a 'b))) (equal? x x)) #t)
+(test (equal? (cons 'a 'b) (cons 'a 'b)) #t)
+(test (equal?(cons 'a 'b)(cons 'a 'b)) #t) ; no space
+(test (equal? "abc" "cba") #f)
+(test (equal? "abc" "abc") #t)
+(test (let ((x "hi")) (equal? x x)) #t)
+(test (equal? (string #\h #\i) (string #\h #\i)) #t)
+(test (equal? #(a) #(b)) #f)
+(test (equal? #(a) #(a)) #t)
+(test (let ((x (vector 'a))) (equal? x x)) #t)
+(test (equal? (vector 'a) (vector 'a)) #t)
+(test (equal? #(1 2) (vector 1 2)) #t)
+(test (equal? #(1.0 2/3) (vector 1.0 2/3)) #t)
+(test (equal? #(1 2) (vector 1 2.0)) #f) ; 2 not equal 2.0!
+(test (equal? '(1 . 2) (cons 1 2)) #t)
+(test (equal? '(1 #||# . #||# 2) (cons 1 2)) #t)
+(test (- '#||#1) -1) ; hmm
+(test (equal? #(1 "hi" #\a) (vector 1 "hi" #\a)) #t)
+(test (equal? #((1 . 2)) (vector (cons 1 2))) #t)
+(test (equal? #(1 "hi" #\a (1 . 2)) (vector 1 "hi" #\a (cons 1 2))) #t)
+(test (equal? #(#f hi (1 2) 1 "hi" #\a (1 . 2)) (vector #f 'hi (list 1 2) 1 "hi" #\a (cons 1 2))) #t)
+(test (equal? #(#(1) #(1)) (vector (vector 1) (vector 1))) #t)
+(test (equal? #(()) (vector '())) #t)
+(test (equal? #("hi" "ho") (vector "hi" '"ho")) #t)
+(test (equal? `#(1) #(1)) #t)
+(test (equal? ``#(1) #(1)) #t)
+(test (equal? '`#(1) #(1)) #t)
+(test (equal? ''#(1) #(1)) #f)
+(test (equal? ''#(1) '#(1)) #f)
+(test (equal? '(1) '        (   1    )) #t)
+(test (equal? (list 1 "hi" #\a) '(1 "hi" #\a)) #t)
+(test (equal? (list 1.0 2/3) '(1.0 2/3)) #t)
+(test (equal? (list 1 2) '(1 2.0)) #f)
+(test (equal? #(1.0+1.0i) (vector 1.0+1.0i)) #t)
+(test (equal? (list 1.0+1.0i) '(1.0+1.0i)) #t)
+(test (equal? '((())) (list (list (list)))) #t)
+(test (equal? '((())) (cons (cons () ()) ())) #t)
+(test (equal? car car) #t)
+(test (equal? car cdr) #f)
+(test (let ((x (lambda () 1))) (equal? x x)) #t)
+(test (equal? (lambda () 1) (lambda () 1)) #f)
+(test (equal? 9/2 9/2) #t)
+(test (equal? #((())) #((()))) #t)
+(test (equal? "123""123") #t);no space
+(test (equal? """") #t)#|nospace|#
+(test (equal? #()#()) #t)
+(test (equal? #()()) #f)
+(test (equal? ()"") #f)
+(test (equal? "hi""hi") #t)
+(test (equal? #<eof> #<eof>) #t)
+(test (equal? #<undefined> #<undefined>) #t)
+(test (equal? #<unspecified> #<unspecified>) #t)
+(test (equal? (if #f #f) #<unspecified>) #t)
+(test (equal? #<eof> #<undefined>) #f)
+(test (equal? (values) #<eof>) #f)
+(test (equal? (values) (values)) #t)
+(test (equal? #<eof> #<unspecified>) #f)
+(test (equal? (values) #<unspecified>) #t)
+(test (equal? #<unspecified> (values)) #t)
+(test (equal? #<eof> ()) #f)
+(test (let () (define-macro (hi a) `(+ 1 ,a)) (equal? hi hi)) #t)
+(test (let () (define (hi a) (+ 1 a)) (equal? hi hi)) #t)
+(test (let ((x (lambda* (hi (a 1)) (+ 1 a)))) (equal? x x)) #t)
+(test (equal? ``"" '"") #t)
+(test (let ((pws (dilambda (lambda () 1) (lambda (x) x)))) (equal? pws pws)) #t)
+(test (equal? if :if) #f)
+(test (equal? (list 'abs 'cons) '(abs cons)) #t)
+(test (equal? '(1) '(list 1)) #f)
+(test (equal? #<undefined> _undef_) #f)
+(test (equal? _undef_ _undef_) #t)
+(test (equal? (list (values)) (list #<unspecified>)) #t)
+
+(test (equal? most-positive-fixnum most-positive-fixnum) #t)
+(test (equal? most-positive-fixnum most-negative-fixnum) #f)
+(test (equal? pi pi) #t)
+(test (equal? 9223372036854775807 9223372036854775806) #f)
+(test (equal? 9223372036854775807 -9223372036854775808) #f)
+(test (equal? -9223372036854775808 -9223372036854775808) #t)
+(test (equal? 123456789/2 123456789/2) #t)
+(test (equal? 123456789/2 123456787/2) #f)
+(test (equal? -123456789/2 -123456789/2) #t)
+(test (equal? 2/123456789 2/123456789) #t)
+(test (equal? -2/123456789 -2/123456789) #t)
+(test (equal? 2147483647/2147483646 2147483647/2147483646) #t)
+(test (equal? 3/4 12/16) #t)
+(test (equal? 1/1 1) #t)
+(test (equal? 312689/99532 833719/265381) #f)
+(test (let ((x 3.141)) (equal? x x)) #t)
+(test (let ((x 1+i)) (equal? x x)) #t)
+(test (let* ((x 3.141) (y x)) (equal? x y)) #t)
+(test (let* ((x 1+i) (y x)) (equal? x y)) #t)
+(test (let* ((x 3/4) (y x)) (equal? x y)) #t)
+(test (equal? '(+ '1) '(+ 1)) #f) ; !?
+
+(test (equal? '(1/0) '(1/0)) #f)
+(test (equal? '1/0 '1/0) #f)
+(test (+ '1 '2) 3)
+(test (equal? '(+nan.0) '(+nan.0)) #f)
+(test (equal? (list +nan.0) (list +nan.0)) #f)
+(test (equal? (vector +nan.0) (vector +nan.0)) #f)
+(test (let ((V (vector +nan.0))) (equal? V (copy V))) #f) ; sigh...
+(test (let ((V (vector +nan.0))) (equal? V V)) #t)
+(test (equal? #(1/0) #(1/0)) #f)
+(test (equal? #r(0.0) #r(-0.0)) #t)
+(test (equal? (float-vector) (int-vector)) #t)
+(test (equal? (vector) (byte-vector)) #t)
+(test (equal? (string) (byte-vector)) #f)
+(test (equal? (make-vector 0 #f) (make-float-vector 0 1.0)) #t)
+(test (equal? (make-vector 0 #f boolean?) (make-float-vector 0 1.0)) #t)
+(test (equal? (make-vector '(0 1) #f boolean?) (make-float-vector 0 1.0)) #f)
+(test (equal? (make-vector '(0 1) #f boolean?) (make-float-vector '(0 1) 1.0)) #t)
+(let ((it1 (make-iterator (int-vector 1 2 3)))
+      (it2 (make-iterator (int-vector 1 2 3))))
+  (test (equal? it1 it2) #t))
+(let ((it1 (make-iterator (int-vector 1 2 3)))
+      (it2 (make-iterator (vector pi))))
+  (test (equal? it1 it2) #f))
+(let ((it1 (make-iterator (int-vector 1 2 3)))
+      (it2 (make-iterator (int-vector 1 2 3))))
+  (test (equivalent? it1 it2) #t))
+(let ((it1 (make-iterator (int-vector 1 2 3)))
+      (it2 (make-iterator (vector 1.0 2.0 3.0))))
+  (test (equivalent? it1 it2) #t))
+
+(test (equal? 3 3) #t)
+(test (equal? 3 3.0) #f)
+(test (equal? 3.0 3.0) #t)
+(test (equal? 3-4i 3-4i) #t)
+(test (equal? (string #\c) "c") #t)
+(test (equal? equal? equal?) #t)
+(test (equal? (cons 1 (cons 2 3)) '(1 2 . 3)) #t)
+(test (equal? '() '()) #t)
+(test (equal? '() (list)) #t)
+(test (equal? '   a 'a) #t)
+(test (equal? "\n" "\n") #t)
+(test (equal? #f ((lambda () #f))) #t)
+(test (equal? (+) 0) #t)
+(test (equal? (recompose 32 list '(1)) (recompose 32 list (list 1))) #t)
+(test (equal? (recompose 100 list '(1)) (recompose 100 list (list 1))) #t)
+(test (equal? (recompose 32 vector 1) (recompose 32 vector 1)) #t)
+(test (equal? (reinvert 32 list vector 1) (reinvert 32 list vector 1)) #t)
+(test (equal? (recompose 32 (lambda (a) (cons 1 a)) ()) (recompose 32 (lambda (a) (cons 1 a)) ())) #t)
+(test (equal? (recompose 32 (lambda (a) (list 1 a)) ()) (recompose 32 (lambda (a) (list 1 a)) ())) #t)
+
+(test (equal? "asd""asd") #t) ; is this the norm?
+(let ((streq (lambda (a b) (equal? a b)))) (test (streq "asd""asd") #t))
+
+(define (fequal)
+  (let ((things (vector #t #f #\space () "" 0 1 3/4 1+i 1.5 '(1 .2) #() (vector 1) (list 1) 'f 't #\t)))
+    (let ((len (length things)))
+      (do ((i 0 (+ i 1)))
+	  ((= i (- len 1)))
+        (do ((j (+ i 1) (+ j 1)))
+	    ((= j len))
+	  (if (equal? (vector-ref things i) (vector-ref things j))
+	      (format #t ";(equal? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j))))))))
+(fequal)
+
+(test (equal?) 'error)
+(test (equal? #t) 'error)
+(test (equal? #t #t #t) 'error)
+(test (equal #t #t) 'error)
+
+(when with-block
+  (let ((b (make-block 4)))
+    (test (equal? b b) #t)
+    (let ((b1 (make-block 4)))
+      (test (equal? b b1) #t)
+      (set! (b 1) 1.0)
+      (test (equal? b b1) #f))))
+(test (let ((p (c-pointer 0))) (equal? p (copy p))) #t)
+
+(test (call-with-exit (lambda (return) (return (equal? return return)))) #t)
+(test (call-with-exit (lambda (return) (call-with-exit (lambda (quit) (return (equal? return quit)))))) #f)
+(test (call/cc (lambda (return) (return (equal? return return)))) #t)
+(test (let hiho ((i 0)) (equal? hiho hiho)) #t)
+(test (let hiho ((i 0)) (let hoho ((i 0)) (equal? hiho hoho))) #f)
+(test (equal? + *) #f)
+(test (equal? lambda lambda) #t)
+(test (equal? lambda lambda*) #f)
+(test (equal? let let) #t)
+(test (equal? let letrec) #f)
+(test (equal? define define) #t)
+(test (equal? + ((lambda (a) a) +)) #t)
+(test (let ((x "hi")) (define (hi) x) (equal? (hi) (hi))) #t)
+
+;; so (eq? 3/4 3/4) is #f, (eqv? 3/4 3/4) is #t,
+;;    (eqv? #(1) #(1)) is #f, (equal? #(1) #(1)) is #t
+;;    (equal? 3 3.0) is #f, (= 3 3.0) is #t
+;; in s7
+;;    (eq? 0.0 0.0) is #t,
+;;    (eq? 2.0 2.0) is #f
+(test (equal? .0 0.) #t)
+(test (equal?
+       (list "hi" (integer->char 65) 1 'a-symbol (make-vector 3) (list) (cons 1 2) abs quasiquote 3 3/4 1.0+1.0i #\f (if #f #f) #<eof> #<undefined>)
+       (list "hi" (integer->char 65) 1 'a-symbol (make-vector 3) (list) (cons 1 2) abs quasiquote 3 3/4 1.0+1.0i #\f (if #f #f) #<eof> #<undefined>))
+      #t)
+(test (equal?
+       (vector "hi" (integer->char 65) 1 'a-symbol (make-vector 3) abs quasiquote 3 3/4 1.0+1.0i #\f (if #f #f) #<eof> #<undefined>)
+       (vector "hi" (integer->char 65) 1 'a-symbol (make-vector 3) abs quasiquote 3 3/4 1.0+1.0i #\f (if #f #f) #<eof> #<undefined>))
+      #t)
+(test (equal? (make-string 3 #\null) (make-string 3 #\null)) #t)
+(test (equal? (make-list 3) (make-list 3)) #t)
+(test (equal? (make-vector 3) (make-vector 3)) #t)
+(unless with-bignums (test (equal? (random-state 100) (random-state 100)) #t))
+
+(test (equal? (list 1) (immutable! (list 1))) #t) ; we also ignore shared lists, and if safety>1, list constants via quote shouldn't change equal?
+(test (equal? (list 1) '(1)) #t)
+
+(test (equal? (current-input-port) (current-input-port)) #t)
+(test (equal? (current-input-port) (current-output-port)) #f)
+(test (equal? *stdin* *stderr*) #f)
+(test (let ((l1 (list 'a 'b))
+	    (l2 (list 'a 'b 'a 'b)))
+	(set! (cdr (cdr l1)) l1)
+	(set! (cdr (cdr (cdr (cdr l2)))) l2)
+	(equal? l1 l2))
+      #t)
+(test (let ((l1 (list 'a 'b))
+	    (l2 (list 'a 'b 'a)))
+	(set! (cdr (cdr l1)) l1)
+	(set! (cdr (cdr (cdr l2))) l2)
+	(equal? l1 l2))
+      #f)
+(test (let ((v1 (vector 1 2 3))
+	    (v2 (vector 1 2 3)))
+	(set! (v1 1) v1)
+	(set! (v2 1) v2)
+	(equal? v1 v2))
+      #t)
+(test (let ((v1 (vector 1 2 3))
+	    (v2 (vector 1 2 4)))
+	(set! (v1 1) v1)
+	(set! (v2 1) v2)
+	(equal? v1 v2))
+      #f)
+
+(when with-bignums
+  (test (equal? (/ (* 5 most-positive-fixnum) (* 3 most-negative-fixnum)) -46116860184273879035/27670116110564327424) #t)
+  (test (equal? +nan.0 (bignum 2.0)) #f)
+  (test (equal? +nan.0 (bignum 2)) #f)
+  (test (equal? +nan.0 (bignum 1/2)) #f)
+  (test (equal? +nan.0 (bignum 2.0+i)) #f)
+  (test (equal? (bignum 2.0) +nan.0) #f)
+  (test (equivalent? (bignum 2.0) +nan.0) #f)
+  (test (equivalent? +nan.0 (bignum 2.0)) #f)
+  (test (equal? 2.0 (bignum 2.0)) #t)
+  (test (equal? 2 (bignum 2)) #t)
+  (test (eqv? 2 (bignum 2)) #t)
+  (test (= 2 (bignum 2)) #t)
+  (test (equal? (bignum 2.0) 2.0) #t)
+  (test (equal? (bignum 2) 2) #t)
+  (test (eqv? (bignum 2) 2) #t)
+  (test (= (bignum 2) 2) #t))
+
+;;; cyclic hash key tests
+(let* ((H1 (hash-table))
+       (I1 (inlet 'a H1)))
+  (set! (H1 'a) I1)
+  (let* ((H2 (hash-table))
+	 (I2 (inlet 'a H2)))
+    (set! (H2 'a) I2)
+    (test (equal? H1 H2) #t)
+    (test (equivalent? H1 H2) #t)))
+
+(let* ((H1 (hash-table))
+       (I1 (immutable! (openlet (inlet 'a H1)))))
+  (set! (H1 'a) I1)
+  (let* ((H2 (hash-table))
+	 (I2 (immutable! (openlet (inlet 'a H2)))))
+    (set! (H2 'a) I2)
+    (test (equal? H1 H2) #t)
+    (test (equivalent? H1 H2) #t)))
+
+(let* ((H1 (hash-table))
+       (I1 (inlet 'a H1)))
+  (set! (H1 I1) I1)
+  (let* ((H2 (hash-table))
+	 (I2 (inlet 'a H2)))
+    (set! (H2 I2) I2)
+    (test (equal? H1 H2) #t)
+    (test (equivalent? H1 H2) #t)))
+
+(let* ((H1 (hash-table))
+       (I1 (inlet 'a H1))
+       (V1 (make-vector 4 I1)))
+  (set! (H1 V1) I1)
+  (let* ((H2 (hash-table))
+	 (I2 (inlet 'a H2))
+	 (V2 (make-vector 4 I2)))
+    (set! (H2 V2) I2)
+    (test (equal? H1 H2) #t)
+    (test (equivalent? H1 H2) #t)))
+
+(let ((H1 (list 1))
+      (H2 (list 1)))
+  (let ((V1 (vector H1))
+	(V2 (vector H2)))
+    (set! (H2 0) V2)
+    (set! (H1 0) V1)
+    (test (equal? H1 H2) #t)
+    (test (equivalent? H1 H2) #t)
+    (test (object->string H1) "#1=(#(#1#))")))
+
+(let ((H1 (inlet 'a 1))
+      (H2 (inlet 'a 1)))
+  (let ((V1 (vector H1))
+	(V2 (vector H2)))
+    (set! (H2 'a) V2)
+    (set! (H1 'a) V1)
+    (test (equal? H1 H2) #t)
+    (test (equivalent? H1 H2) #t)
+    (test (object->string H1) "#1=(inlet 'a #(#1#))")))
+
+(let ((H1 (hash-table))
+      (H2 (hash-table))
+      (H3 (hash-table)))
+  (let ((V1 (vector H1))
+	(V2 (vector H2)))
+    (set! (H2 V2) H2)
+    (set! (H1 V1) H1)
+    (set! (H3 H1) 2)
+    (test (H3 H2) 2)))
+
+(let ((H1 (hash-table))
+      (H2 (hash-table)))
+  (let ((V1 (vector H1))
+	(V2 (vector H2)))
+    (set! (H2 V2) H2)
+    (set! (H1 V1) H1)
+    (test (object->string V1) "#1=#(#2=(hash-table #1# #2#))")
+    (test (equal? V1 V2) #t)
+    (test (equivalent? V1 V2) #t)))
+
+(let ((H1 (hash-table))
+      (H2 (hash-table)))
+  (let ((V1 (vector H1))
+	(V2 (vector H2)))
+    (set! (H2 V2) H2)
+    (set! (H1 V1) H1)
+    (test (object->string H1) "#1=(hash-table #(#1#) #1#)")
+    (test (equal? H1 H2) #t)
+    (test (equivalent? H1 H2) #t)))
+
+
+;;; --------------------------------------------------------------------------------
+;;; equivalent?
+
+(test (equivalent? 'a 3) #f)
+(test (equivalent? #t 't) #f)
+(test (equivalent? "abs" 'abc) #f)
+(test (equivalent? "hi" '(hi)) #f)
+(test (equivalent? "()" '()) #f)
+(test (equivalent? '(1) '(1)) #t)
+(test (equivalent? '(#f) '(#f)) #t)
+(test (equivalent? '(()) '(() . ())) #t)
+(test (equivalent? #\a #\b) #f)
+(test (equivalent? #\a #\a) #t)
+(test (let ((x (string-ref "hi" 0))) (equivalent? x x)) #t)
+(test (equivalent? #t #t) #t)
+(test (equivalent? #f #f) #t)
+(test (equivalent? #f #t) #f)
+(test (equivalent? (null? '()) #t) #t)
+(test (equivalent? (null? '(a)) #f) #t)
+(test (equivalent? (cdr '(a)) '()) #t)
+(test (equivalent? 'a 'a) #t)
+(test (equivalent? 'a 'b) #f)
+(test (equivalent? :a a:) #t)
+(test (equivalent? :a 123) #f)
+(test (equivalent? :a 'a) #f)
+(test (equivalent? 'a :a) #f)
+(test (equivalent? 'a (string->symbol "a")) #t)
+(test (equivalent? '(a) '(b)) #f)
+(test (equivalent? '(a) '(a)) #t)
+(test (let ((x '(a . b))) (equivalent? x x)) #t)
+(test (let ((x (cons 'a 'b))) (equivalent? x x)) #t)
+(test (equivalent? (cons 'a 'b) (cons 'a 'b)) #t)
+(test (equivalent?(cons 'a 'b)(cons 'a 'b)) #t) ; no space
+(test (equivalent? "abc" "cba") #f)
+(test (equivalent? "abc" "abc") #t)
+(test (let ((x "hi")) (equivalent? x x)) #t)
+(test (equivalent? (string #\h #\i) (string #\h #\i)) #t)
+(test (equivalent? #(a) #(b)) #f)
+(test (equivalent? #(a) #(a)) #t)
+(test (let ((x (vector 'a))) (equivalent? x x)) #t)
+(test (equivalent? (vector 'a) (vector 'a)) #t)
+(test (equivalent? #(1 2) (vector 1 2)) #t)
+(test (equivalent? #(1.0 2/3) (vector 1.0 2/3)) #t)
+(test (equivalent? #(1 2) (vector 1 2.0)) #t)
+(test (equivalent? '(1 . 2) (cons 1 2)) #t)
+(test (equivalent? '(1 #||# . #||# 2) (cons 1 2)) #t)
+(test (- '#||#1) -1) ; hmm
+(test (equivalent? #(1 "hi" #\a) (vector 1 "hi" #\a)) #t)
+(test (equivalent? #((1 . 2)) (vector (cons 1 2))) #t)
+(test (equivalent? #(1 "hi" #\a (1 . 2)) (vector 1 "hi" #\a (cons 1 2))) #t)
+(test (equivalent? #(#f hi (1 2) 1 "hi" #\a (1 . 2)) (vector #f 'hi (list 1 2) 1 "hi" #\a (cons 1 2))) #t)
+(test (equivalent? #(#(1) #(1)) (vector (vector 1) (vector 1))) #t)
+(test (equivalent? #(()) (vector '())) #t)
+(test (equivalent? #("hi" "ho") (vector "hi" '"ho")) #t)
+(test (equivalent? `#(1) #(1)) #t)
+(test (equivalent? ``#(1) #(1)) #t)
+(test (equivalent? '`#(1) #(1)) #t)
+(test (equivalent? ''#(1) #(1)) #f)
+(test (equivalent? ''#(1) '#(1)) #f)
+(test (equivalent? (list 1 "hi" #\a) '(1 "hi" #\a)) #t)
+(test (equivalent? (list 1.0 2/3) '(1.0 2/3)) #t)
+(test (equivalent? (list 1 2) '(1 2.0)) #t)
+(test (equivalent? #(1.0+1.0i) (vector 1.0+1.0i)) #t)
+(test (equivalent? (list 1.0+1.0i) '(1.0+1.0i)) #t)
+(test (equivalent? '((())) (list (list (list)))) #t)
+(test (equivalent? car car) #t)
+(test (equivalent? car cdr) #f)
+(test (let ((x (lambda () 1))) (equivalent? x x)) #t)
+(test (equivalent? (lambda () 1) (lambda () 1)) #t)
+(test (equivalent? 9/2 9/2) #t)
+(test (equivalent? #((())) #((()))) #t)
+(test (equivalent? "123""123") #t);no space
+(test (equivalent? """") #t)#|nospace|#
+(test (equivalent? #()#()) #t)
+(test (equivalent? #()()) #f)
+(test (equivalent? ()"") #f)
+(test (equivalent? "hi""hi") #t)
+(test (equivalent? #<eof> #<eof>) #t)
+(test (equivalent? #<undefined> #<undefined>) #t)
+(test (equivalent? #<unspecified> #<unspecified>) #t)
+(test (equivalent? (if #f #f) #<unspecified>) #t)
+(test (equivalent? #<eof> #<undefined>) #f)
+(test (equivalent? #<eof> '()) #f)
+(test (equivalent? (values) #<eof>) #f)
+(test (equivalent? #<eof> (values)) #f)
+(test (equivalent? (values) (values)) #t)
+(test (equivalent? #<eof> #<unspecified>) #f)
+(test (equivalent? (values) #<unspecified>) #t)
+(test (equivalent? #<unspecified> (values)) #t)
+(test (equivalent? #<undefined> _undef_) #f)
+(test (equivalent? _undef_ _undef_) #t)
+(test (let () (define-macro (hi a) `(+ 1 ,a)) (equivalent? hi hi)) #t)
+(test (let () (define (hi a) (+ 1 a)) (equivalent? hi hi)) #t)
+(test (let ((x (lambda* (hi (a 1)) (+ 1 a)))) (equivalent? x x)) #t)
+(test (equivalent? ``"" '"") #t)
+(test (let ((pws (dilambda (lambda () 1) (lambda (x) x)))) (equivalent? pws pws)) #t)
+(test (equivalent? if :if) #f)
+(test (equivalent? (list 'abs 'cons) '(abs cons)) #t)
+(test (equivalent? (make-int-vector 2 0) (vector 0 0)) #t)
+(test (equivalent? (make-int-vector 2 0) (make-vector 2 0)) #t)
+(test (equivalent? (make-int-vector 2 0) (make-int-vector 2 0)) #t)
+(test (equivalent? (make-int-vector 2 0) (make-float-vector 2)) #t)
+(test (equivalent? (vector 0.0 0) (make-float-vector 2 0.0)) #t)
+(test (equivalent? (make-int-vector 2 0) (vector 0 1.0)) #f)
+(test (equivalent? (make-float-vector 1 +nan.0) (make-float-vector 1 +nan.0)) #t)
+(test (call-with-input-file "s7test.scm"
+	(lambda (port)
+	  (equivalent? (call-with-input-file "s7test.scm" (lambda (p) p)) port)))
+      #f)
+
+(test (equivalent? (make-iterator "") (make-iterator "")) #t)
+(test (equivalent? (make-iterator "1") (make-iterator "1" (cons 1 1))) #t)
+(test (equivalent? (make-iterator "1" (cons 3 4)) (make-iterator "1" (cons 1 1))) #t)
+(test (equivalent? (make-iterator #()) (make-iterator #())) #t)
+(test (equivalent? (make-iterator '(1 2 3)) (make-iterator '(1 2 3))) #t)
+(test (equivalent? (make-iterator '(1 2 3)) (make-iterator '(1 2 3 4))) #f)
+
+(test (equivalent? (int-vector 1 2) (byte-vector 1 2)) #t)
+(test (equivalent? (vector 1 2) (byte-vector 1 2)) #t)       ; but (equivalent? (vector #\a) "a") -> #f
+(test (equivalent? (float-vector 1 2) (byte-vector 1 2)) #t) ; (equivalent? 1 1.0) -> #t
+
+(let ((str "123"))
+  (let ((i1 (make-iterator str))
+	(i2 (make-iterator str)))
+    (test (equal? i1 i2) #t)
+    (test (equivalent? i1 i2) #t)
+    (iterate i1)
+    (test (equal? i1 i2) #f)
+    (test (equivalent? i1 i2) #f)
+    (iterate i2)
+    (test (equal? i1 i2) #t)
+    (test (equivalent? i1 i2) #t)))
+
+(let ((i1 (make-iterator "123"))
+      (i2 (make-iterator "123")))
+  (test (equivalent? i1 i2) #t)
+  (iterate i1)
+  (test (equivalent? i1 i2) #f)
+  (iterate i2)
+  (test (equivalent? i1 i2) #t))
+
+(let ((i1 (make-iterator (vector 1 2 3)))
+      (i2 (make-iterator (int-vector 1 2 3))))
+  (test (equivalent? i1 i2) #t)
+  (iterate i1)
+  (test (equivalent? i1 i2) #f)
+  (iterate i2)
+  (test (equivalent? i1 i2) #t))
+
+(let ((i1 (make-iterator (vector 1 2 3)))
+      (i2 (make-iterator (vector 1 2 3))))
+  (test (equal? i1 i2) #t)
+  (test (equivalent? i1 i2) #t)
+  (iterate i1)
+  (test (equal? i1 i2) #f)
+  (test (equivalent? i1 i2) #f)
+  (iterate i2)
+  (test (equal? i1 i2) #t)
+  (test (equivalent? i1 i2) #t))
+
+(let ((str (hash-table 'a 1 'b 2)))
+  (let ((i1 (make-iterator str))
+	(i2 (make-iterator str)))
+    (test (equal? i1 i2) #t)
+    (test (equivalent? i1 i2) #t)
+    (iterate i1)
+    (test (equal? i1 i2) #f)
+    (test (equivalent? i1 i2) #f)
+    (iterate i2)
+    (test (equal? i1 i2) #t)
+    (test (equivalent? i1 i2) #t)))
+
+(let ((i1 (make-iterator (list 1 2 3)))
+      (i2 (make-iterator (list 1 2 3))))
+  (test (equivalent? i1 i2) #t)
+  (iterate i1)
+  (test (equivalent? i1 i2) #f)
+  (iterate i2)
+  (test (equivalent? i1 i2) #t))
+
+;;; opt bug
+(test (equivalent? ''(1) (list 1)) #f)
+(test (equivalent? ''(1+i) '(1+i)) #f)
+(test (equivalent? '(1) (list 1)) #t)
+(test (equivalent? '(1) ''(1)) #f)
+(test (equivalent? (list 1) ''(1)) #f)
+(test (equivalent? (list 1) '(1)) #t)
+(test (equivalent? ''(1) ''(1)) #t)
+(test (equivalent? '''(1) ''(1)) #f)
+
+(let ()
+  (define-macro (mac a) `(+ 1 ,a))
+  (define-macro (mac1 a) `(+ 1 ,a))
+  (define-macro (mac2 a) `(+ 2 ,a))
+  (define-macro (mac3 a b) `(+ ,b ,a))
+  (test (equivalent? mac mac1) #t)
+  (test (equivalent? mac mac2) #f)
+  (test (equivalent? mac1 mac3) #f)
+  (test (equivalent? mac3 mac3) #t)
+  (let ()
+    (define-macro (mac4 a) `(+ 1 ,a))
+    (test (equivalent? mac mac4) #t)) ; was #f
+  (define-bacro (mac5 a) `(+ 1 ,a))
+  (test (equivalent? mac mac5) #f)
+  (define-bacro (mac6 a) `(+ 1 ,a))
+  (test (equivalent? mac5 mac6) #t))
+
+(test (equivalent? most-positive-fixnum most-positive-fixnum) #t)
+(test (equivalent? most-positive-fixnum most-negative-fixnum) #f)
+(test (equivalent? pi pi) #t)
+(test (equivalent? 9223372036854775807 9223372036854775806) #f)
+(test (equivalent? 9223372036854775807 -9223372036854775808) #f)
+(test (equivalent? -9223372036854775808 -9223372036854775808) #t)
+(test (equivalent? 123456789/2 123456789/2) #t)
+(test (equivalent? 123456789/2 123456787/2) #f)
+(test (equivalent? -123456789/2 -123456789/2) #t)
+(test (equivalent? 2/123456789 2/123456789) #t)
+(test (equivalent? -2/123456789 -2/123456789) #t)
+(test (equivalent? 2147483647/2147483646 2147483647/2147483646) #t)
+(test (equivalent? 3/4 12/16) #t)
+(test (equivalent? 1/1 1) #t)
+(test (equivalent? 312689/99532 833719/265381) #f)
+(test (let ((x 3.141)) (equivalent? x x)) #t)
+(test (let ((x 1+i)) (equivalent? x x)) #t)
+(test (let* ((x 3.141) (y x)) (equivalent? x y)) #t)
+(test (let* ((x 1+i) (y x)) (equivalent? x y)) #t)
+(test (let* ((x 3/4) (y x)) (equivalent? x y)) #t)
+(test (equivalent? .1 1/10) #t)
+(test (equivalent? pi '(1 2)) #f)
+(if with-bignums
+    (test (equivalent? (cosh (bignum "128")) 1.943854202997297546111336844178739036366E55) #t)
+    (test (equivalent? (cosh 128) 1.943854202997297e+55) #f))
+(test (equivalent? (float-vector (cosh 128)) (float-vector 1.943854202997297e+55)) #f) ; can't decide about this -- see floats_are_equivalent
+;;; here (* (*s7* 'equivalent-float-epsilon) (cosh 128)) = 1.943854202997298e+40
+;;;                    (- (cosh 128) 1.943854202997297e+55) = 2.722258935367508e+39
+(when with-block
+  (test (equivalent? (block (cosh 128)) (block 1.943854202997297e+55)) #f)
+  (test (equivalent? (block) (inlet 'a 1)) #f))
+
+(test (let ((x 3.141)) (equivalent? x x)) #t)
+(test (equivalent? 3 3) #t)
+(test (equivalent? 3 3.0) #t)
+(test (equivalent? 3.0 3.0) #t)
+(test (equivalent? 3-4i 3-4i) #t)
+(test (equivalent? 1/0 0/0) #t)
+(test (equivalent? 1/0 (- 1/0)) #t) ; but they print as +nan.0 (this is C based I think), and equal? here is #f
+(test (equivalent? (real-part (log 0)) (- (real-part (log 0)))) #f)
+(test (equivalent? (log 0) (log 0)) #t)
+(test (equivalent? 0/0+i 0/0+i) #t)
+(test (equivalent? 0/0+i 0/0-i) #f)
+
+(test (equivalent? (list 3) (list 3.0)) #t)
+(test (equivalent? (list 3.0) (list 3.0)) #t)
+(test (equivalent? (list 3-4i) (list 3-4i)) #t)
+(test (equivalent? (list 1/0) (list 0/0)) #t)
+(test (equivalent? (list (log 0)) (list (log 0))) #t)
+(test (equivalent? (list 0/0+i) (list 0/0+i)) #t)
+
+(test (equivalent? (vector 3) (vector 3.0)) #t)
+(test (equivalent? (vector 3.0) (vector 3.0)) #t)
+(test (equivalent? (vector 3-4i) (vector 3-4i)) #t)
+(test (equivalent? (vector 1/0) (vector 0/0)) #t)
+(test (equivalent? (vector (log 0)) (vector (log 0))) #t)
+(test (equivalent? (vector 0/0+i) (vector 0/0+i)) #t)
+
+(test (equivalent? (string #\c) "c") #t)
+(test (equivalent? equivalent? equivalent?) #t)
+(test (equivalent? (cons 1 (cons 2 3)) '(1 2 . 3)) #t)
+(test (equivalent? '() '()) #t)
+(test (equivalent? '() (list)) #t)
+(test (equivalent? '    a 'a) #t)
+(test (equivalent? "\n" "\n") #t)
+(test (equivalent? #f ((lambda () #f))) #t)
+(test (equivalent? (+) 0) #t)
+(test (equivalent? (recompose 32 list '(1)) (recompose 32 list (list 1))) #t)
+(test (equivalent? (recompose 100 list '(1)) (recompose 100 list (list 1))) #t)
+(test (equivalent? (recompose 32 vector 1) (recompose 32 vector 1)) #t)
+(test (equivalent? (reinvert 32 list vector 1) (reinvert 32 list vector 1)) #t)
+(test (equivalent? (recompose 32 (lambda (a) (cons 1 a)) ()) (recompose 32 (lambda (a) (cons 1 a)) ())) #t)
+(test (equivalent? (recompose 32 (lambda (a) (list 1 a)) ()) (recompose 32 (lambda (a) (list 1 a)) ())) #t)
+
+(test (equivalent? "asd""asd") #t) ; is this the norm?
+(let ((streq (lambda (a b) (equivalent? a b)))) (test (streq "asd""asd") #t))
+
+(let ((things (vector #t #f #\space () "" 0 1 3/4 1+i 1.5 '(1 .2) #() (vector 1) (list 1) 'f 't #\t)))
+  (let ((len (length things)))
+    (do ((i 0 (+ i 1)))
+	((= i (- len 1)))
+      (do ((j (+ i 1) (+ j 1)))
+	  ((= j len))
+	(if (equivalent? (vector-ref things i) (vector-ref things j))
+	    (format #t ";(equivalent? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j)))))))
+
+(test (equivalent?) 'error)
+(test (equivalent? #t) 'error)
+(test (equivalent? #t #t #t) 'error)
+(test (equal #t #t) 'error)
+
+(test (call-with-exit (lambda (return) (return (equivalent? return return)))) #t)
+(test (call-with-exit (lambda (return) (call-with-exit (lambda (quit) (return (equivalent? return quit)))))) #f)
+(test (call/cc (lambda (return) (return (equivalent? return return)))) #t)
+(test (let hiho ((i 0)) (equivalent? hiho hiho)) #t)
+(test (let hiho ((i 0)) (let hoho ((i 0)) (equivalent? hiho hoho))) #f)
+(test (equivalent? + *) #f)
+(test (equivalent? lambda lambda) #t)
+(test (equivalent? lambda lambda*) #f)
+(test (equivalent? let let) #t)
+(test (equivalent? let letrec) #f)
+(test (equivalent? define define) #t)
+(test (equivalent? + ((lambda (a) a) +)) #t)
+(test (let ((x "hi")) (define (hi) x) (equivalent? (hi) (hi))) #t)
+
+(test (equivalent?
+       (list "hi" (integer->char 65) 1 'a-symbol (make-vector 3) (list) (cons 1 2) abs quasiquote 3 3/4 1.0+1.0i #\f (if #f #f) #<eof> #<undefined>)
+       (list "hi" (integer->char 65) 1 'a-symbol (make-vector 3) (list) (cons 1 2) abs quasiquote 3 3/4 1.0+1.0i #\f (if #f #f) #<eof> #<undefined>))
+      #t)
+(test (equivalent?
+       (vector "hi" (integer->char 65) 1 'a-symbol (make-vector 3) abs quasiquote 3 3/4 1.0+1.0i #\f (if #f #f) #<eof> #<undefined>)
+       (vector "hi" (integer->char 65) 1 'a-symbol (make-vector 3) abs quasiquote 3 3/4 1.0+1.0i #\f (if #f #f) #<eof> #<undefined>))
+      #t)
+(test (equivalent? (make-string 3 #\null) (make-string 3 #\null)) #t)
+(test (equivalent? (make-list 3) (make-list 3)) #t)
+(test (equivalent? (make-vector 3) (make-vector 3)) #t)
+(test (equivalent? (make-float-vector 3 1.0) (vector 1 1 1)) #t)
+(test (equivalent? (int-vector 1) (int-vector 2)) #f)
+(test (equivalent? (int-vector 1) (int-vector 1)) #t)
+(test (equivalent? (float-vector 0.0) (float-vector +nan.0)) #f)
+(test (equivalent? (float-vector +nan.0) (float-vector +nan.0)) #t)
+(let-temporarily (((*s7* 'equivalent-float-epsilon) 0.0))
+  (test (equivalent? (float-vector 0.0) (float-vector +nan.0)) #f)
+  (test (equivalent? (float-vector +nan.0) (float-vector +nan.0)) #t)
+  (test (equivalent? (float-vector 0.0) (float-vector 0.0)) #t)
+  (test (equivalent? (float-vector 0.0) (float-vector 1e-15)) #f)
+  (set! (*s7* 'equivalent-float-epsilon) 0.01)
+  (test (equivalent? (float-vector 0.0) (float-vector 1e-15)) #t)
+  (test (equivalent? (float-vector 0.0) (float-vector 0.005)) #t)
+  (test (equivalent? (float-vector 0.0) (float-vector 0.02)) #f))
+(test (equivalent? (float-vector 1) (float-vector 1)) #t)
+(test (equivalent? (float-vector 1) (float-vector 0)) #f)
+(test (equivalent? (float-vector 1 2 3 4 5 6) (float-vector 1 2 3 4 5 6)) #t)
+(test (equivalent? (float-vector 1 2 3 4 5 6) (float-vector 1 2 0 4 5 6)) #f)
+(let ()
+  (define (fvequiv)
+    (do ((i 1 (+ i 1)))
+	((= i 20))
+      (let ((v1 (make-float-vector i))
+	    (v2 (make-float-vector i))
+	    (v3 (make-float-vector i)))
+	(do ((j 0 (+ j 1)))
+	    ((= j i)
+	     (set! (v3 (random i)) 32)
+	     (unless (equivalent? v1 v2) (format *stderr* "~S != ~S~%" v1 v2))
+	     (when (equivalent? v1 v3) (format *stderr* "~S == ~S~%" v1 v3)))
+	  (set! (v1 j) j)
+	  (set! (v2 j) j)
+	  (set! (v3 j) j)))))
+  (fvequiv))
+
+(unless with-bignums (test (equivalent? (random-state 100) (random-state 100)) #t))
+
+(test (equivalent? (current-input-port) (current-input-port)) #t)
+(test (equivalent? (current-input-port) (current-output-port)) #f)
+(test (equivalent? *stdin* *stderr*) #f)
+
+(test (equivalent?
+       (let ()
+	 (define-macro* (a_func (an_arg (lambda () #t)))
+	   `,an_arg)
+	 (a_func))
+       (let ()
+	 (define-macro (a_func an_arg)
+	   `,an_arg)
+	 (a_func (lambda () #t))))
+      #t) ; was #f
+
+(test (equivalent? (- 4/3 1 -63.0) 190/3) #t)
+(test (equivalent? 190/3 (- 4/3 1 -63.0)) #t)
+(test (equivalent? (+ -1 4/3 63.0) 190/3) #t)
+
+(unless with-bignums
+  (set! (*s7* 'equivalent-float-epsilon) 1e-15) ; just in case
+  (test (equivalent? (+ 5e-16 +nan.0) +nan.0) #t)
+  (test (equivalent? (+ 0+5e-16i +nan.0) +nan.0) #t)
+  (test (equivalent? (+ 1/0 0+5e-16i) 1/0) #t)
+  (test (equivalent? 1/0 (+ 1/0 0+5e-16i)) #t)
+  (test (equivalent? 0 (+ 0 5e-16)) #t)
+  (test (equivalent? 0 (- 0 1/1428571428571429)) #t)
+  (test (equivalent? 0 (+ 0 0+5e-16i)) #t)
+  (test (equivalent? 0 (+ 0 0-1/1428571428571429i)) #t)
+  (test (equivalent? 0 (+ 0 1e-11)) #f)
+  (test (equivalent? 0 0) #t)
+  (test (equivalent? 0 1/1000) #f)
+  (test (equivalent? 0 0.0) #t)
+  (test (equivalent? 0 1e-16) #t)
+  (test (equivalent? 0 0+i) #f)
+  (test (equivalent? 0 1e-16+i) #f)
+  (test (equivalent? 0 0+1e-16i) #t)
+  (test (equivalent? 0 1e-300) #t)
+  (test (equivalent? 0 0+1e-300i) #t)
+  (test (equivalent? 0 1/0) #f)
+  (test (equivalent? 0 (- 0/0)) #f)
+  (test (equivalent? 0 (log 0)) #f)
+  (test (equivalent? 1 (+ 1 5e-16)) #t)
+  (test (equivalent? 1 (- 1 1/1428571428571429)) #t)
+  (test (equivalent? 1 (+ 1 0+5e-16i)) #t)
+  (test (equivalent? 1 (+ 1 0-1/1428571428571429i)) #t)
+  (test (equivalent? 1 (+ 1 1e-11)) #f)
+  (test (equivalent? 1 1) #t)
+  (test (equivalent? 1 1.0) #t)
+  (test (equivalent? 1 1e-16) #f)
+  (test (equivalent? 1 1e4) #f)
+  (test (equivalent? 1 0+i) #f)
+  (test (equivalent? 1 1e-16+i) #f)
+  (test (equivalent? 1 (complex 1 1/0)) #f)
+  (test (equivalent? 1 (complex (real-part (log 0)) 1)) #f)
+  (test (equivalent? 1 (complex 1 (real-part (log 0)))) #f)
+  (test (equivalent? 1000 (+ 1000 5e-16)) #t)
+  (test (equivalent? 1000 (- 1000 1/1428571428571429)) #t)
+  (test (equivalent? 1000 (+ 1000 0+5e-16i)) #t)
+  (test (equivalent? 1000 (+ 1000 0-1/1428571428571429i)) #t)
+  (test (equivalent? 1000 (+ 1000 1e-11)) #f)
+  (test (equivalent? 1000 (+ 1000 1e-14)) #t)
+  (test (equivalent? 1000 1000) #t)
+  (test (equivalent? 1000 1/1000) #f)
+  (test (equivalent? 1000 1e4) #f)
+  (test (equivalent? 1/1000 (+ 1/1000 5e-16)) #t)
+  (test (equivalent? 1/1000 (- 1/1000 1/1428571428571429)) #t)
+  (test (equivalent? 1/1000 (+ 1/1000 0+5e-16i)) #t)
+  (test (equivalent? 1/1000 (+ 1/1000 0-1/1428571428571429i)) #t)
+  (test (equivalent? 1/1000 (+ 1/1000 1e-11)) #f)
+  (test (equivalent? 1/1000 0) #f)
+  (test (equivalent? 1/1000 1/1000) #t)
+  (test (equivalent? 1/1000 0.0) #f)
+  (test (equivalent? 1/1000 1e-16) #f)
+  (test (equivalent? 1/1000 1e-16+i) #f)
+  (test (equivalent? 1/1000 0+1e-16i) #f)
+  (test (equivalent? 1/1000 1e-300) #f)
+  (test (equivalent? 1/1000 0+1e-300i) #f)
+  (test (equivalent? 1/1000 1/0) #f)
+  (test (equivalent? 0.0 (+ 0.0 5e-16)) #t)
+  (test (equivalent? 0.0 (- 0.0 1/1428571428571429)) #t)
+  (test (equivalent? 0.0 (+ 0.0 0+5e-16i)) #t)
+  (test (equivalent? 0.0 (+ 0.0 0-1/1428571428571429i)) #t)
+  (test (equivalent? 0.0 (+ 0.0 1e-11)) #f)
+  (test (equivalent? 0.0 0) #t)
+  (test (equivalent? 0.0 1/1000) #f)
+  (test (equivalent? 0.0 0.0) #t)
+  (test (equivalent? 0.0 1e-16) #t)
+  (test (equivalent? 0.0 0+i) #f)
+  (test (equivalent? 0.0 1+i) #f)
+  (test (equivalent? 0.0 1e-16+i) #f)
+  (test (equivalent? 0.0 0+1e-16i) #t)
+  (test (equivalent? 0.0 1e-300) #t)
+  (test (equivalent? 0.0 0+1e-300i) #t)
+  (test (equivalent? 0.0 1/0) #f)
+  (test (equivalent? 0.0 (real-part (log 0))) #f)
+  (test (equivalent? 0.0 (- (real-part (log 0)))) #f)
+  (test (equivalent? 0.0 (- 0/0)) #f)
+  (test (equivalent? 0.0 (log 0)) #f)
+  (test (equivalent? 1.0 (+ 1.0 5e-16)) #t)
+  (test (equivalent? 1.0 (- 1.0 1/1428571428571429)) #t)
+  (test (equivalent? 1.0 (+ 1.0 0+5e-16i)) #t)
+  (test (equivalent? 1.0 (+ 1.0 0-1/1428571428571429i)) #t)
+  (test (equivalent? 1.0 (+ 1.0 1e-11)) #f)
+  (test (equivalent? 1.0 1) #t)
+  (test (equivalent? 1.0 1.0) #t)
+  (test (equivalent? 1.0 1e-16+i) #f)
+  (test (equivalent? 1.0 0+1e-16i) #f)
+  (test (equivalent? 1.0 1e-300) #f)
+  (test (equivalent? 1.0 0+1e-300i) #f)
+  (test (equivalent? 1.0 1/0) #f)
+  (test (equivalent? 1.0 (- 0/0)) #f)
+  (test (equivalent? 1.0 (complex 1/0 1)) #f)
+  (test (equivalent? 1.0 (complex 1 1/0)) #f)
+  (test (equivalent? 1.0 (complex 1 (real-part (log 0)))) #f)
+  (test (equivalent? 1e-16 (+ 1e-16 5e-16)) #t)
+  (test (equivalent? 1e-16 (- 1e-16 1/1428571428571429)) #t)
+  (test (equivalent? 1e-16 (+ 1e-16 0+5e-16i)) #t)
+  (test (equivalent? 1e-16 (+ 1e-16 0-1/1428571428571429i)) #t)
+  (test (equivalent? 1e-16 (+ 1e-16 1e-11)) #f)
+  (test (equivalent? 1e-16 0) #t)
+  (test (equivalent? 1e-16 1/1000) #f)
+  (test (equivalent? 1e-16 0.0) #t)
+  (test (equivalent? 1e-16 1e-16) #t)
+  (test (equivalent? 1e-16 1e-16+i) #f)
+  (test (equivalent? 1e-16 0+1e-16i) #t)
+  (test (equivalent? 1e-16 1e-300) #t)
+  (test (equivalent? 1e-16 0+1e-300i) #t)
+  (test (equivalent? 1e-16 1/0) #f)
+  (test (equivalent? 1e4 (+ 1e4 5e-16)) #t)
+  (test (equivalent? 1e4 (- 1e4 1/1428571428571429)) #t)
+  (test (equivalent? 1e4 (+ 1e4 0+5e-16i)) #t)
+  (test (equivalent? 1e4 (+ 1e4 0-1/1428571428571429i)) #t)
+  (test (equivalent? 1e4 (+ 1e4 1e-11)) #f)
+  (test (equivalent? 1e4 1000) #f)
+  (test (equivalent? 1e4 1/1000) #f)
+  (test (equivalent? 1e4 1e-16) #f)
+  (test (equivalent? 1e4 1e4) #t)
+  (test (equivalent? 1e4 1e-16+i) #f)
+  (test (equivalent? 1e4 0+1e-16i) #f)
+  (test (equivalent? 1e4 1e-300) #f)
+  (test (equivalent? 1e4 0+1e-300i) #f)
+  (test (equivalent? 1e4 1/0) #f)
+  (test (equivalent? 0+i (+ 0+i 5e-16)) #t)
+  (test (equivalent? 0+i (- 0+i 1/1428571428571429)) #t)
+  (test (equivalent? 0+i (+ 0+i 0+5e-16i)) #t)
+  (test (equivalent? 0+i (+ 0+i 0-1/1428571428571429i)) #t)
+  (test (equivalent? 0+i (+ 0+i 1e-11)) #f)
+  (test (equivalent? 0+i 0) #f)
+  (test (equivalent? 0+i 1/1000) #f)
+  (test (equivalent? 0+i 0.0) #f)
+  (test (equivalent? 0+i 1e-16) #f)
+  (test (equivalent? 0+i 0+i) #t)
+  (test (equivalent? 0+i 1+i) #f)
+  (test (equivalent? 0+i 1e-16+i) #t)
+  (test (equivalent? 0+i 0+1e-16i) #f)
+  (test (equivalent? 0+i 1e-300) #f)
+  (test (equivalent? 0+i 0+1e-300i) #f)
+  (test (equivalent? 0+i 1/0) #f)
+  (test (equivalent? 0+i (real-part (log 0))) #f)
+  (test (equivalent? 0+i (- (real-part (log 0)))) #f)
+  (test (equivalent? 0+i (- 0/0)) #f)
+  (test (equivalent? 0+i (log 0)) #f)
+  (test (equivalent? 0+i (complex 1/0 1)) #f)
+  (test (equivalent? 0+i (complex 1 1/0)) #f)
+  (test (equivalent? 0+i (complex 1/0 1/0)) #f)
+  (test (equivalent? 0+i (complex (real-part (log 0)) 1/0)) #f)
+  (test (equivalent? 1+i (+ 1+i 5e-16)) #t)
+  (test (equivalent? 1+i (- 1+i 1/1428571428571429)) #t)
+  (test (equivalent? 1+i (+ 1+i 0+5e-16i)) #t)
+  (test (equivalent? 1+i (+ 1+i 0-1/1428571428571429i)) #t)
+  (test (equivalent? 1+i (+ 1+i 1e-11)) #f)
+  (test (equivalent? 1+i 0+i) #f)
+  (test (equivalent? 1+i 1+i) #t)
+  (test (equivalent? 1+i 1e-16+i) #f)
+  (test (equivalent? 1+i 0+1e-16i) #f)
+  (test (equivalent? 1+i 1e-300) #f)
+  (test (equivalent? 1+i 0+1e-300i) #f)
+  (test (equivalent? 1e-16+i (+ 1e-16+i 5e-16)) #t)
+  (test (equivalent? 1e-16+i (- 1e-16+i 1/1428571428571429)) #t)
+  (test (equivalent? 1e-16+i (+ 1e-16+i 0+5e-16i)) #t)
+  (test (equivalent? 1e-16+i (+ 1e-16+i 0-1/1428571428571429i)) #t)
+  (test (equivalent? 1e-16+i (+ 1e-16+i 1e-11)) #f)
+  (test (equivalent? 1e-16+i 0) #f)
+  (test (equivalent? 1e-16+i 1e-16) #f)
+  (test (equivalent? 1e-16+i 1e4) #f)
+  (test (equivalent? 1e-16+i 0+i) #t)
+  (test (equivalent? 1e-16+i 1+i) #f)
+  (test (equivalent? 1e-16+i 1e-16+i) #t)
+  (test (equivalent? 1e-16+i 0+1e-16i) #f)
+  (test (equivalent? 1e-16+i 1e-300) #f)
+  (test (equivalent? 1e-16+i 0+1e-300i) #f)
+  (test (equivalent? 1e-16+i 1/0) #f)
+  (test (equivalent? 1e-16+i (real-part (log 0))) #f)
+  (test (equivalent? 1e-16+i (- (real-part (log 0)))) #f)
+  (test (equivalent? 1e-16+i (- 0/0)) #f)
+  (test (equivalent? 1e-16+i (log 0)) #f)
+  (test (equivalent? 1e-16+i (complex 1/0 1)) #f)
+  (test (equivalent? 1e-16+i (complex 1 1/0)) #f)
+  (test (equivalent? 1e-16+i (complex 1/0 1/0)) #f)
+  (test (equivalent? 1e-16+i (complex (real-part (log 0)) 1/0)) #f)
+  (test (equivalent? 0+1e-16i (+ 0+1e-16i 5e-16)) #t)
+  (test (equivalent? 0+1e-16i (- 0+1e-16i 1/1428571428571429)) #t)
+  (test (equivalent? 0+1e-16i (+ 0+1e-16i 0+5e-16i)) #t)
+  (test (equivalent? 0+1e-16i (+ 0+1e-16i 0-1/1428571428571429i)) #t)
+  (test (equivalent? 0+1e-16i (+ 0+1e-16i 1e-11)) #f)
+  (test (equivalent? 0+1e-16i 0) #t)
+  (test (equivalent? 0+1e-16i 1/1000) #f)
+  (test (equivalent? 0+1e-16i 0.0) #t)
+  (test (equivalent? 0+1e-16i 1e-16) #t)
+  (test (equivalent? 0+1e-16i 0+i) #f)
+  (test (equivalent? 0+1e-16i 1+i) #f)
+  (test (equivalent? 0+1e-16i 1e-16+i) #f)
+  (test (equivalent? 0+1e-16i 0+1e-16i) #t)
+  (test (equivalent? 0+1e-16i 1e-300) #t)
+  (test (equivalent? 0+1e-16i 0+1e-300i) #t)
+  (test (equivalent? 0+1e-16i 1/0) #f)
+  (test (equivalent? 0+1e-16i (real-part (log 0))) #f)
+  (test (equivalent? 0+1e-16i (- (real-part (log 0)))) #f)
+  (test (equivalent? 0+1e-16i (- 0/0)) #f)
+  (test (equivalent? 0+1e-16i (log 0)) #f)
+  (test (equivalent? 1e-300 (+ 1e-300 5e-16)) #t)
+  (test (equivalent? 1e-300 (- 1e-300 1/1428571428571429)) #t)
+  (test (equivalent? 1e-300 (+ 1e-300 0+5e-16i)) #t)
+  (test (equivalent? 1e-300 (+ 1e-300 0-1/1428571428571429i)) #t)
+  (test (equivalent? 1e-300 (+ 1e-300 1e-11)) #f)
+  (test (equivalent? 1e-300 0) #t)
+  (test (equivalent? 1e-300 1/1000) #f)
+  (test (equivalent? 1e-300 0.0) #t)
+  (test (equivalent? 1e-300 1e-16) #t)
+  (test (equivalent? 1e-300 1e-16+i) #f)
+  (test (equivalent? 1e-300 0+1e-16i) #t)
+  (test (equivalent? 1e-300 1e-300) #t)
+  (test (equivalent? 1e-300 0+1e-300i) #t)
+  (test (equivalent? 1e-300 1/0) #f)
+  (test (equivalent? 1e-300 (- 0/0)) #f)
+  (test (equivalent? 1e-300 (log 0)) #f)
+  (test (equivalent? 0+1e-300i (+ 0+1e-300i 5e-16)) #t)
+  (test (equivalent? 0+1e-300i (- 0+1e-300i 1/1428571428571429)) #t)
+  (test (equivalent? 0+1e-300i (+ 0+1e-300i 0+5e-16i)) #t)
+  (test (equivalent? 0+1e-300i (+ 0+1e-300i 0-1/1428571428571429i)) #t)
+  (test (equivalent? 0+1e-300i (+ 0+1e-300i 1e-11)) #f)
+  (test (equivalent? 0+1e-300i 0) #t)
+  (test (equivalent? 0+1e-300i 1000) #f)
+  (test (equivalent? 0+1e-300i 1/1000) #f)
+  (test (equivalent? 0+1e-300i 0.0) #t)
+  (test (equivalent? 0+1e-300i 1e-16) #t)
+  (test (equivalent? 0+1e-300i 0+i) #f)
+  (test (equivalent? 0+1e-300i 1e-16+i) #f)
+  (test (equivalent? 0+1e-300i 0+1e-16i) #t)
+  (test (equivalent? 0+1e-300i 1e-300) #t)
+  (test (equivalent? 0+1e-300i 0+1e-300i) #t)
+  (test (equivalent? 0+1e-300i 1/0) #f)
+  (test (equivalent? 0+1e-300i (- 0/0)) #f)
+  (test (equivalent? 1/0 (+ 1/0 5e-16)) #t)
+  (test (equivalent? 1/0 (- 1/0 1/1428571428571429)) #t)
+  (test (equivalent? 1/0 (+ 1/0 0+5e-16i)) #t)
+  (test (equivalent? 1/0 (+ 1/0 0-1/1428571428571429i)) #t)
+  (test (equivalent? 1/0 0) #f)
+  (test (equivalent? 1/0 1/0) #t)
+  (test (equivalent? 1/0 (real-part (log 0))) #f)
+  (test (equivalent? 1/0 (- (real-part (log 0)))) #f)
+  (test (equivalent? 1/0 (- 0/0)) #t)
+  (test (equivalent? 1/0 (log 0)) #f)
+  (test (equivalent? 1/0 (complex 1/0 1)) #f)
+  (test (equivalent? 1/0 (complex 1 1/0)) #f)
+  (test (equivalent? 1/0 (complex 1/0 1/0)) #f)
+  (test (equivalent? 1/0 (complex (real-part (log 0)) 1/0)) #f)
+  (test (equivalent? 1/0 (complex 1/0 (real-part (log 0)))) #f)
+  (test (equivalent? 1/0 (complex (real-part (log 0)) (real-part (log 0)))) #f)
+  (test (equivalent? 1/0 (complex (real-part (log 0)) 1)) #f)
+  (test (equivalent? 1/0 (complex 1 (real-part (log 0)))) #f)
+  (test (equivalent? (real-part (log 0)) (+ (real-part (log 0)) 5e-16)) #t)
+  (test (equivalent? (real-part (log 0)) (- (real-part (log 0)) 1/1428571428571429)) #t)
+  (test (equivalent? (real-part (log 0)) (+ (real-part (log 0)) 0+5e-16i)) #t)
+  (test (equivalent? (real-part (log 0)) (+ (real-part (log 0)) 0-1/1428571428571429i)) #t)
+  (test (equivalent? (real-part (log 0)) 0) #f)
+  (test (equivalent? (real-part (log 0)) 1e-16+i) #f)
+  (test (equivalent? (real-part (log 0)) 0+1e-16i) #f)
+  (test (equivalent? (real-part (log 0)) 1e-300) #f)
+  (test (equivalent? (real-part (log 0)) 0+1e-300i) #f)
+  (test (equivalent? (real-part (log 0)) 1/0) #f)
+  (test (equivalent? (real-part (log 0)) (real-part (log 0))) #t)
+  (test (equivalent? (real-part (log 0)) (- (real-part (log 0)))) #f)
+  (test (equivalent? (real-part (log 0)) (- 0/0)) #f)
+  (test (equivalent? (real-part (log 0)) (log 0)) #f)
+  (test (equivalent? (real-part (log 0)) (complex 1/0 1)) #f)
+  (test (equivalent? (real-part (log 0)) (complex 1 1/0)) #f)
+  (test (equivalent? (real-part (log 0)) (complex 1/0 1/0)) #f)
+  (test (equivalent? (real-part (log 0)) (complex (real-part (log 0)) 1/0)) #f)
+  (test (equivalent? (real-part (log 0)) (complex 1/0 (real-part (log 0)))) #f)
+  (test (equivalent? (real-part (log 0)) (complex (real-part (log 0)) (real-part (log 0)))) #f)
+  (test (equivalent? (real-part (log 0)) (complex (real-part (log 0)) 1)) #f)
+  (test (equivalent? (real-part (log 0)) (complex 1 (real-part (log 0)))) #f)
+  (test (equivalent? (- (real-part (log 0))) (+ (- (real-part (log 0))) 5e-16)) #t)
+  (test (equivalent? (- (real-part (log 0))) (- (- (real-part (log 0))) 1/1428571428571429)) #t)
+  (test (equivalent? (- (real-part (log 0))) (+ (- (real-part (log 0))) 0+5e-16i)) #t)
+  (test (equivalent? (- (real-part (log 0))) (+ (- (real-part (log 0))) 0-1/1428571428571429i)) #t)
+  (test (equivalent? (- (real-part (log 0))) 1e-16+i) #f)
+  (test (equivalent? (- (real-part (log 0))) 0+1e-16i) #f)
+  (test (equivalent? (- (real-part (log 0))) 1e-300) #f)
+  (test (equivalent? (- (real-part (log 0))) 0+1e-300i) #f)
+  (test (equivalent? (- (real-part (log 0))) 1/0) #f)
+  (test (equivalent? (- (real-part (log 0))) (real-part (log 0))) #f)
+  (test (equivalent? (- (real-part (log 0))) (- (real-part (log 0)))) #t)
+  (test (equivalent? (- (real-part (log 0))) (- 0/0)) #f)
+  (test (equivalent? (- (real-part (log 0))) (log 0)) #f)
+  (test (equivalent? (- (real-part (log 0))) (complex 1/0 1)) #f)
+  (test (equivalent? (- (real-part (log 0))) (complex 1 1/0)) #f)
+  (test (equivalent? (- (real-part (log 0))) (complex 1/0 1/0)) #f)
+  (test (equivalent? (- (real-part (log 0))) (complex (real-part (log 0)) 1/0)) #f)
+  (test (equivalent? (- (real-part (log 0))) (complex 1/0 (real-part (log 0)))) #f)
+  (test (equivalent? (- (real-part (log 0))) (complex (real-part (log 0)) (real-part (log 0)))) #f)
+  (test (equivalent? (- (real-part (log 0))) (complex (real-part (log 0)) 1)) #f)
+  (test (equivalent? (- (real-part (log 0))) (complex 1 (real-part (log 0)))) #f)
+  (test (equivalent? (- 0/0) (+ (- 0/0) 5e-16)) #t)
+  (test (equivalent? (- 0/0) (- (- 0/0) 1/1428571428571429)) #t)
+  (test (equivalent? (- 0/0) (+ (- 0/0) 0+5e-16i)) #t)
+  (test (equivalent? (- 0/0) (+ (- 0/0) 0-1/1428571428571429i)) #t)
+  (test (equivalent? (- 0/0) 0) #f)
+  (test (equivalent? (- 0/0) 1e-300) #f)
+  (test (equivalent? (- 0/0) 0+1e-300i) #f)
+  (test (equivalent? (- 0/0) 1/0) #t)
+  (test (equivalent? (- 0/0) (real-part (log 0))) #f)
+  (test (equivalent? (- 0/0) (- (real-part (log 0)))) #f)
+  (test (equivalent? (- 0/0) (- 0/0)) #t)
+  (test (equivalent? (- 0/0) (log 0)) #f)
+  (test (equivalent? (- 0/0) (complex 1/0 1)) #f)
+  (test (equivalent? (- 0/0) (complex 1 1/0)) #f)
+  (test (equivalent? (- 0/0) (complex 1/0 1/0)) #f)
+  (test (equivalent? (- 0/0) (complex (real-part (log 0)) 1/0)) #f)
+  (test (equivalent? (- 0/0) (complex 1/0 (real-part (log 0)))) #f)
+  (test (equivalent? (- 0/0) (complex (real-part (log 0)) (real-part (log 0)))) #f)
+  (test (equivalent? (- 0/0) (complex (real-part (log 0)) 1)) #f)
+  (test (equivalent? (- 0/0) (complex 1 (real-part (log 0)))) #f)
+  (test (equivalent? (log 0) (+ (log 0) 5e-16)) #t)
+  (test (equivalent? (log 0) (- (log 0) 1/1428571428571429)) #t)
+  (test (equivalent? (log 0) (+ (log 0) 0+5e-16i)) #t)
+  (test (equivalent? (log 0) (+ (log 0) 0-1/1428571428571429i)) #t)
+  (test (equivalent? (log 0) 0) #f)
+  (test (equivalent? (log 0) 1/0) #f)
+  (test (equivalent? (log 0) (real-part (log 0))) #f)
+  (test (equivalent? (log 0) (- (real-part (log 0)))) #f)
+  (test (equivalent? (log 0) (- 0/0)) #f)
+  (test (equivalent? (log 0) (log 0)) #t)
+  (test (equivalent? (log 0) (complex 1/0 1)) #f)
+  (test (equivalent? (log 0) (complex 1 1/0)) #f)
+  (test (equivalent? (log 0) (complex 1/0 1/0)) #f)
+  (test (equivalent? (log 0) (complex (real-part (log 0)) 1/0)) #f)
+  (test (equivalent? (log 0) (complex 1/0 (real-part (log 0)))) #f)
+  (test (equivalent? (log 0) (complex (real-part (log 0)) (real-part (log 0)))) #f)
+  (test (equivalent? (log 0) (complex (real-part (log 0)) 1)) #f)
+  (test (equivalent? (log 0) (complex 1 (real-part (log 0)))) #f)
+  (test (equivalent? (complex 1/0 1) (+ (complex 1/0 1) 5e-16)) #t)
+  (test (equivalent? (complex 1/0 1) (- (complex 1/0 1) 1/1428571428571429)) #t)
+  (test (equivalent? (complex 1/0 1) (+ (complex 1/0 1) 0+5e-16i)) #t)
+  (test (equivalent? (complex 1/0 1) (+ (complex 1/0 1) 0-1/1428571428571429i)) #t)
+  (test (equivalent? (complex 1/0 1) 0) #f)
+  (test (equivalent? (complex 1/0 1) 1) #f)
+  (test (equivalent? (complex 1/0 1) 1e-16+i) #f)
+  (test (equivalent? (complex 1/0 1) 0+1e-16i) #f)
+  (test (equivalent? (complex 1/0 1) 1e-300) #f)
+  (test (equivalent? (complex 1/0 1) 0+1e-300i) #f)
+  (test (equivalent? (complex 1/0 1) 1/0) #f)
+  (test (equivalent? (complex 1/0 1) (real-part (log 0))) #f)
+  (test (equivalent? (complex 1/0 1) (- (real-part (log 0)))) #f)
+  (test (equivalent? (complex 1/0 1) (- 0/0)) #f)
+  (test (equivalent? (complex 1/0 1) (log 0)) #f)
+  (test (equivalent? (complex 1/0 1) (complex 1/0 1)) #t)
+  (test (equivalent? (complex 1/0 1) (complex 1 1/0)) #f)
+  (test (equivalent? (complex 1/0 1) (complex 1/0 1/0)) #f)
+  (test (equivalent? (complex 1/0 1) (complex (real-part (log 0)) 1/0)) #f)
+  (test (equivalent? (complex 1/0 1) (complex 1/0 (real-part (log 0)))) #f)
+  (test (equivalent? (complex 1/0 1) (complex (real-part (log 0)) (real-part (log 0)))) #f)
+  (test (equivalent? (complex 1/0 1) (complex (real-part (log 0)) 1)) #f)
+  (test (equivalent? (complex 1/0 1) (complex 1 (real-part (log 0)))) #f)
+  (test (equivalent? (complex 1 1/0) (+ (complex 1 1/0) 5e-16)) #t)
+  (test (equivalent? (complex 1 1/0) (- (complex 1 1/0) 1/1428571428571429)) #t)
+  (test (equivalent? (complex 1 1/0) (+ (complex 1 1/0) 0+5e-16i)) #t)
+  (test (equivalent? (complex 1 1/0) (+ (complex 1 1/0) 0-1/1428571428571429i)) #t)
+  (test (equivalent? (complex 1 1/0) 0) #f)
+  (test (equivalent? (complex 1 1/0) 1) #f)
+  (test (equivalent? (complex 1 1/0) 1e-300) #f)
+  (test (equivalent? (complex 1 1/0) 0+1e-300i) #f)
+  (test (equivalent? (complex 1 1/0) 1/0) #f)
+  (test (equivalent? (complex 1 1/0) (real-part (log 0))) #f)
+  (test (equivalent? (complex 1 1/0) (- (real-part (log 0)))) #f)
+  (test (equivalent? (complex 1 1/0) (- 0/0)) #f)
+  (test (equivalent? (complex 1 1/0) (log 0)) #f)
+  (test (equivalent? (complex 1 1/0) (complex 1/0 1)) #f)
+  (test (equivalent? (complex 1 1/0) (complex 1 1/0)) #t)
+  (test (equivalent? (complex 1 1/0) (complex 1/0 1/0)) #f)
+  (test (equivalent? (complex 1 1/0) (complex (real-part (log 0)) 1/0)) #f)
+  (test (equivalent? (complex 1 1/0) (complex 1/0 (real-part (log 0)))) #f)
+  (test (equivalent? (complex 1 1/0) (complex (real-part (log 0)) (real-part (log 0)))) #f)
+  (test (equivalent? (complex 1 1/0) (complex (real-part (log 0)) 1)) #f)
+  (test (equivalent? (complex 1 1/0) (complex 1 (real-part (log 0)))) #f)
+  (test (equivalent? (complex 1/0 1/0) (+ (complex 1/0 1/0) 5e-16)) #t)
+  (test (equivalent? (complex 1/0 1/0) (- (complex 1/0 1/0) 1/1428571428571429)) #t)
+  (test (equivalent? (complex 1/0 1/0) (+ (complex 1/0 1/0) 0+5e-16i)) #t)
+  (test (equivalent? (complex 1/0 1/0) (+ (complex 1/0 1/0) 0-1/1428571428571429i)) #t)
+  (test (equivalent? (complex 1/0 1/0) 0) #f)
+  (test (equivalent? (complex 1/0 1/0) 1/0) #f)
+  (test (equivalent? (complex 1/0 1/0) (real-part (log 0))) #f)
+  (test (equivalent? (complex 1/0 1/0) (- (real-part (log 0)))) #f)
+  (test (equivalent? (complex 1/0 1/0) (- 0/0)) #f)
+  (test (equivalent? (complex 1/0 1/0) (log 0)) #f)
+  (test (equivalent? (complex 1/0 1/0) (complex 1/0 1)) #f)
+  (test (equivalent? (complex 1/0 1/0) (complex 1 1/0)) #f)
+  (test (equivalent? (complex 1/0 1/0) (complex 1/0 1/0)) #t)
+  (test (equivalent? (complex 1/0 1/0) (complex (real-part (log 0)) 1/0)) #f)
+  (test (equivalent? (complex 1/0 1/0) (complex 1/0 (real-part (log 0)))) #f)
+  (test (equivalent? (complex 1/0 1/0) (complex (real-part (log 0)) (real-part (log 0)))) #f)
+  (test (equivalent? (complex 1/0 1/0) (complex (real-part (log 0)) 1)) #f)
+  (test (equivalent? (complex 1/0 1/0) (complex 1 (real-part (log 0)))) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) (+ (complex (real-part (log 0)) 1/0) 5e-16)) #t)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) (- (complex (real-part (log 0)) 1/0) 1/1428571428571429)) #t)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) (+ (complex (real-part (log 0)) 1/0) 0+5e-16i)) #t)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) (+ (complex (real-part (log 0)) 1/0) 0-1/1428571428571429i)) #t)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) 0) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) 1) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) 1000) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) 1/1000) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) 0.0) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) 1.0) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) 1e-16) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) 1e4) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) 1/0) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) (real-part (log 0))) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) (- (real-part (log 0)))) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) (- 0/0)) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) (log 0)) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) (complex 1/0 1)) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) (complex 1 1/0)) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) (complex 1/0 1/0)) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) (complex (real-part (log 0)) 1/0)) #t)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) (complex 1/0 (real-part (log 0)))) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) (complex (real-part (log 0)) (real-part (log 0)))) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) (complex (real-part (log 0)) 1)) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1/0) (complex 1 (real-part (log 0)))) #f)
+  (test (equivalent? (complex 1/0 (real-part (log 0))) (+ (complex 1/0 (real-part (log 0))) 5e-16)) #t)
+  (test (equivalent? (complex 1/0 (real-part (log 0))) (- (complex 1/0 (real-part (log 0))) 1/1428571428571429)) #t)
+  (test (equivalent? (complex 1/0 (real-part (log 0))) (+ (complex 1/0 (real-part (log 0))) 0+5e-16i)) #t)
+  (test (equivalent? (complex 1/0 (real-part (log 0))) (+ (complex 1/0 (real-part (log 0))) 0-1/1428571428571429i)) #t)
+  (test (equivalent? (complex 1/0 (real-part (log 0))) (real-part (log 0))) #f)
+  (test (equivalent? (complex 1/0 (real-part (log 0))) (- (real-part (log 0)))) #f)
+  (test (equivalent? (complex 1/0 (real-part (log 0))) (- 0/0)) #f)
+  (test (equivalent? (complex 1/0 (real-part (log 0))) (log 0)) #f)
+  (test (equivalent? (complex 1/0 (real-part (log 0))) (complex 1/0 1)) #f)
+  (test (equivalent? (complex 1/0 (real-part (log 0))) (complex 1 1/0)) #f)
+  (test (equivalent? (complex 1/0 (real-part (log 0))) (complex 1/0 1/0)) #f)
+  (test (equivalent? (complex 1/0 (real-part (log 0))) (complex (real-part (log 0)) 1/0)) #f)
+  (test (equivalent? (complex 1/0 (real-part (log 0))) (complex 1/0 (real-part (log 0)))) #t)
+  (test (equivalent? (complex 1/0 (real-part (log 0))) (complex (real-part (log 0)) (real-part (log 0)))) #f)
+  (test (equivalent? (complex 1/0 (real-part (log 0))) (complex (real-part (log 0)) 1)) #f)
+  (test (equivalent? (complex 1/0 (real-part (log 0))) (complex 1 (real-part (log 0)))) #f)
+  (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (+ (complex (real-part (log 0)) (real-part (log 0))) 5e-16)) #t)
+  (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (- (complex (real-part (log 0)) (real-part (log 0))) 1/1428571428571429)) #t)
+  (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (+ (complex (real-part (log 0)) (real-part (log 0))) 0+5e-16i)) #t)
+  (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (+ (complex (real-part (log 0)) (real-part (log 0))) 0-1/1428571428571429i)) #t)
+  (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) 0) #f)
+  (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) 1/0) #f)
+  (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (real-part (log 0))) #f)
+  (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (- (real-part (log 0)))) #f)
+  (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (- 0/0)) #f)
+  (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (log 0)) #f)
+  (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (complex 1/0 1)) #f)
+  (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (complex 1 1/0)) #f)
+  (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (complex 1/0 1/0)) #f)
+  (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (complex (real-part (log 0)) 1/0)) #f)
+  (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (complex 1/0 (real-part (log 0)))) #f)
+  (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (complex (real-part (log 0)) (real-part (log 0)))) #t)
+  (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (complex (real-part (log 0)) 1)) #f)
+  (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (complex 1 (real-part (log 0)))) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1) (+ (complex (real-part (log 0)) 1) 5e-16)) #t)
+  (test (equivalent? (complex (real-part (log 0)) 1) (- (complex (real-part (log 0)) 1) 1/1428571428571429)) #t)
+  (test (equivalent? (complex (real-part (log 0)) 1) (+ (complex (real-part (log 0)) 1) 0+5e-16i)) #t)
+  (test (equivalent? (complex (real-part (log 0)) 1) (+ (complex (real-part (log 0)) 1) 0-1/1428571428571429i)) #t)
+  (test (equivalent? (complex (real-part (log 0)) 1) 0) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1) 1) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1) 0+1e-300i) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1) 1/0) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1) (real-part (log 0))) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1) (- (real-part (log 0)))) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1) (- 0/0)) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1) (log 0)) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1) (complex 1/0 1)) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1) (complex 1 1/0)) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1) (complex 1/0 1/0)) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1) (complex (real-part (log 0)) 1/0)) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1) (complex 1/0 (real-part (log 0)))) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1) (complex (real-part (log 0)) (real-part (log 0)))) #f)
+  (test (equivalent? (complex (real-part (log 0)) 1) (complex (real-part (log 0)) 1)) #t)
+  (test (equivalent? (complex (real-part (log 0)) 1) (complex 1 (real-part (log 0)))) #f)
+  (test (equivalent? (complex 1 (real-part (log 0))) (+ (complex 1 (real-part (log 0))) 5e-16)) #t)
+  (test (equivalent? (complex 1 (real-part (log 0))) (- (complex 1 (real-part (log 0))) 1/1428571428571429)) #t)
+  (test (equivalent? (complex 1 (real-part (log 0))) (+ (complex 1 (real-part (log 0))) 0+5e-16i)) #t)
+  (test (equivalent? (complex 1 (real-part (log 0))) (+ (complex 1 (real-part (log 0))) 0-1/1428571428571429i)) #t)
+  (test (equivalent? (complex 1 (real-part (log 0))) (real-part (log 0))) #f)
+  (test (equivalent? (complex 1 (real-part (log 0))) (- (real-part (log 0)))) #f)
+  (test (equivalent? (complex 1 (real-part (log 0))) (- 0/0)) #f)
+  (test (equivalent? (complex 1 (real-part (log 0))) (log 0)) #f)
+  (test (equivalent? (complex 1 (real-part (log 0))) (complex 1/0 1)) #f)
+  (test (equivalent? (complex 1 (real-part (log 0))) (complex 1 1/0)) #f)
+  (test (equivalent? (complex 1 (real-part (log 0))) (complex 1/0 1/0)) #f)
+  (test (equivalent? (complex 1 (real-part (log 0))) (complex (real-part (log 0)) 1/0)) #f)
+  (test (equivalent? (complex 1 (real-part (log 0))) (complex 1/0 (real-part (log 0)))) #f)
+  (test (equivalent? (complex 1 (real-part (log 0))) (complex (real-part (log 0)) (real-part (log 0)))) #f)
+  (test (equivalent? (complex 1 (real-part (log 0))) (complex (real-part (log 0)) 1)) #f)
+  (test (equivalent? (complex 1 (real-part (log 0))) (complex 1 (real-part (log 0)))) #t)) ; end with-bignums
+
+(test (equivalent? 1.0e10 (+ 1.0e10 1.0e-6)) #f)
+(test (equivalent? (open-input-file "s7test.scm") (open-input-file "s7test.scm")) #t)
+(test (equivalent? (make-iterator (hash-table 'a 1)) (make-iterator (hash-table 'a 1))) #t)
+(let ((i1 (make-iterator (hash-table 'a 1 'b 2)))
+      (i2 (make-iterator (hash-table 'a 1 'b 2))))
+  (i1) (i2)
+  (test (equivalent? i1 i2) #t))
+(let ((i1 (make-iterator (hash-table 'a 1 'b 2)))
+      (i2 (make-iterator (hash-table 'a 1 'b 2))))
+  (i1)
+  (test (equivalent? i1 i2) #f))
+(test (equivalent? (make-iterator (inlet 'a 1)) (make-iterator (inlet 'a 1))) #t)
+(let ((i1 (make-iterator (inlet 'a 1 'b 2)))
+      (i2 (make-iterator (inlet 'a 1 'b 2))))
+  (test (equivalent? i1 i2) #t)
+  (i1)
+  (test (equivalent? i1 i2) #f)
+  (i2)
+  (test (equivalent? i1 i2) #t)
+  (i2)
+  (test (equivalent? i1 i2) #f))
+(test (equivalent? (make-iterator (list unless 1+i 0/0+i #u())) (make-iterator (list unless 1+i 0/0+i #u()))) #t)
+(let ((i1 (make-iterator (list +nan.0 +inf.0)))
+      (i2 (make-iterator (list +nan.0 +inf.0))))
+  (test (equivalent? i1 i2) #t)
+  (i1)
+  (test (equivalent? i1 i2) #f))
+
+(when with-block
+  (let-temporarily (((*s7* 'equivalent-float-epsilon) 1e-6))
+    (test (equivalent? (make-iterator (block (/ pi 2))) (make-iterator (block 1.570796326794897))) #t)))
+
+(when with-bignums
+  (test (equivalent? (bignum +nan.0) 0/0+0/0i) #f)
+  (test (equivalent? (bignum 0) 0+0/0i) #f)
+  (test (equivalent? +nan.0 (bignum 0/0+0/0i)) #f)
+  (test (equivalent? 0 (bignum 0+0/0i)) #f)
+  (test (equivalent? 1/2 (bignum 1/2+0/0i)) #f)
+  (test (equivalent? (bignum 1/2) 1/2+0/0i) #f)
+  (test (equivalent? (bignum 1/2+0/0i) 1/2+0/0i) #t)
+  (test (equivalent? (vector 1) (vector (bignum 1))) #t)
+  (test (equivalent? (list 1.0) (list (bignum 1.0))) #t)
+  (test (equivalent? (hash-table 'a 1/2) (hash-table 'a (bignum 1/2))) #t)
+  (test (equivalent? (inlet 'a 1+i) (inlet 'a (bignum 1+i))) #t))
+
+(let ((h1 (make-hash-table 8 equivalent?)))
+  (set! (h1 (complex 0.0 +inf.0)) 1)
+  (test (h1 (complex 0.0 +inf.0)) 1)
+  (let ((h2 (make-hash-table 8 equivalent?)))
+    (set! (h2 (complex 0.0 +inf.0)) 1)
+    (test (equivalent? h1 h2) #t)
+    (let ((h3 (copy h1)))
+      (test (equivalent? h1 h3) #t)
+      (set! (h3 (complex +nan.0 +inf.0)) 2)
+      (set! (h1 (complex +nan.0 +inf.0)) 2)
+      (test (equivalent? h1 h3) #t)
+      (set! (h2 (complex +nan.0 0.0)) 2)
+      (test (equivalent? h1 h2) #f)
+      )))
+(test (equivalent? (let ((h (make-hash-table 8 equivalent?))) (set! (h #_abs) (log 0)) h)
+	           (eval-string (object->string (let ((h (make-hash-table 8 equivalent?))) (set! (h #_abs) (log 0)) h) :readable)))
+  #t)
+
+
+;;; ----------------
+;;; try a bunch of combinations
+
+(define-expansion (format-with-line port str . args)
+  `(format ,port ,str ,(port-line-number) ,@args))
+
+(let ((lst1 ())
+      (lst2 ()))
+  (if (not (eq? lst1 lst2)) (format-with-line #t ";~A: nils are not eq?~%"))
+  (if (not (eqv? lst1 lst2)) (format-with-line #t ";~A: nils are not eqv?~%"))
+  (if (not (equal? lst1 lst2)) (format-with-line #t ";~A: nils are not equal?~%"))
+
+  (let ((v1 (make-vector 100 #f))
+	(v2 (make-vector 100 #f)))
+    (if (not (equal? v1 v2)) (format-with-line #t ";~A: base vectors are not equal?~%"))
+
+    (let ((h1 (make-hash-table))
+	  (h2 (make-hash-table)))
+      (if (not (equal? h1 h2)) (format-with-line #t ";~A: base hash-tables are not equal?~%"))
+
+      (let ((e1 (sublet (curlet)))
+	    (e2 (sublet (curlet))))
+	(if (not (equal? e1 e2)) (format-with-line #t ";~A: base environments are not equal?~%"))
+
+	(let ((ctr 0))
+	  (for-each
+	   (lambda (arg1 arg2)
+	     ;; make sure the args are eq? to themselves
+	     ;; if equal? and equal to copy place in lst1, place copy in lst2, check that they are still equal
+	     ;;     similarly for vector, hash-table, envs
+	   (let ((a1 arg1)
+		 (a2 arg2))
+	     (if (not (eq? a1 arg1))
+		 (format-with-line #t ";~A: ~A is not eq? to itself? ~A~%" arg1 a1))
+	     (if (and (eq? a1 a2) (not (eqv? a1 a2)))
+		 (format-with-line #t ";~A: ~A is eq? but not eqv? ~A~%" a1 a2))
+
+	     (if (equal? a1 a2)
+		 (begin
+		   (if (and (eq? a1 a2) (not (eqv? a1 a2)))
+		       (format-with-line #t ";~A: ~A is eq? and equal? but not eqv?? ~A~%" a1 a2))
+		   (if (not (equivalent? a1 a2))
+		       (format-with-line #t ";~A: ~A is equal? but not equivalent? ~A~%" a1 a2))
+		   (set! lst1 (cons a1 lst1))
+		   (set! lst2 (cons a2 lst2))
+		   (set! (v1 ctr) a1)
+		   (set! (v2 ctr) a2)
+		   (let* ((sym1 (symbol "symbol-" (number->string ctr)))
+			  (sym2 (copy sym1)))
+		     (set! (h1 sym1) a1)
+		     (set! (h2 sym2) a2)
+		     (varlet e1 (cons sym1 a1))
+		     (varlet e2 (cons sym2 a2))
+
+		     (if (not (equal? lst1 lst2))
+			 (begin
+			   (format-with-line #t ";~A: add ~A to lists, now not equal?~%" a1)
+			   (set! lst1 (cdr lst1))
+			   (set! lst2 (cdr lst2))))
+		     (if (not (equal? v1 v2))
+			 (begin
+			   (format-with-line #t ";~A: add ~A to vectors, now not equal?~%" a1)
+			   (set! (v1 ctr) #f)
+			   (set! (v2 ctr) #f)))
+		     (if (not (equal? h1 h2))
+			 (begin
+			   (format-with-line #t ";~A: add ~A to hash-tables, now not equal?~%" a1)
+			   (set! (h1 sym1) #f)
+			   (set! (h2 sym2) #f)))
+		     (if (not (equal? e1 e2))
+			 (begin
+			   (format-with-line #t ";~A: add ~A to environments, now not equal?~% ~A~% ~A~%" a1 e1 e2)
+			   (eval `(set! ,sym1 #f) e1)
+			   (eval `(set! ,sym2 #f) e2)))
+		     ))
+		 (begin
+		   (if (eq? a1 arg1) (format-with-line #t ";~A: ~A is eq? but not equal? ~A~%" a1 a2))
+		   (if (eqv? a1 arg1) (format-with-line #t ";~A: ~A is eqv? but not equal? ~A~%" a1 a2))
+		   (format-with-line #t ";~A: ~A is not equal to ~A~%" a1 a2)))
+
+	     (set! ctr (+ ctr 1))))
+
+	 (list "hi" ""
+	       (integer->char 65) #\space #\newline #\null
+	       1 3/4
+	       ;; 1.0 1+i pi (real-part (log 0)) 1e18
+	       most-negative-fixnum most-positive-fixnum
+	       'a-symbol
+	       (make-vector 3 #f) #() #2d((1 2) (3 4))
+	       abs quasiquote macroexpand (log 0)
+	       (hash-table 'a 1 'b 2) (hash-table)
+	       (sublet (curlet) 'a 1) (rootlet)
+	       #f #t :hi
+	       #<eof> #<undefined> #<unspecified>
+	       (cons 1 2) () '(1) (list (cons 1 2)) '(1 2 . 3)
+	       (let ((lst (cons 1 2))) (set-cdr! lst lst) lst)
+	       )
+	 (list (string #\h #\i) (string)
+	       #\A #\space #\newline (integer->char 0)
+	       (- 2 1) (/ 3 4)
+	       ;; 1.0 1+i pi (real-part (log 0)) 1e18
+	       -9223372036854775808 9223372036854775807
+	       (string->symbol "a-symbol")
+	       (vector #f #f #f) (vector)  #2d((1 2) (3 4))
+	       abs quasiquote macroexpand (log 0)
+	       (let ((h (make-hash-table 31))) (set! (h 'a) 1) (set! (h 'b) 2) h) (make-hash-table 123)
+	       (sublet (curlet) '(a . 1)) (rootlet)
+	       #f #t :hi
+	       #<eof> #<undefined> (if #f #f)
+	       '(1 . 2) (list) (list 1) (list (cons 1 2)) '(1 2 . 3)
+	       (let ((lst (cons 1 2))) (set-cdr! lst lst) lst)
+	       ))
+
+	  (set! (v1 ctr) lst1)
+	  (set! (v2 ctr) lst2)
+	  (set! ctr (+ ctr 1))
+	  (if (not (equal? v1 v2))
+	      (format-with-line #t ";~A: add lists to vectors, now vectors not equal?~%")
+	      (begin
+		(set! lst1 (cons v1 lst1))
+		(set! lst2 (cons v2 lst2))
+		(if (not (equal? lst1 lst2))
+		    (begin
+		      (format-with-line #t ";~A: add vectors to lists, now lists not equal?~%")
+		      (set! (h1 'lst1) lst1)
+		      (set! (h2 'lst2) lst2)
+		      (if (not (equal? h1 h2))
+			  (format-with-line #t ";~A: add lists to hash-tables, not hash-tables not equal?~%")
+			  (begin
+			    (set! (v1 ctr) v1)
+			    (set! (v2 ctr) v2)
+			    (set! ctr (+ ctr 1))
+			    (if (not (equal? v1 v2))
+				(format-with-line #t ";~A: add vectors to themselves, now vectors not equal?~%"))
+			    (if (not (equal? lst1 lst2))
+				(format-with-line #t ";~A: add vectors to themselves, now lists not equal?~%"))
+			    (set! (h1 'h1) h1)
+			    (set! (h2 'h2) h2)
+			    (if (not (equal? h1 h2))
+				(format-with-line #t ";~A: add hash-tables to themselves, not hash-tables not equal?~%"))
+			    )))))))))))
+
+(define old-readers *#readers*)
+(set! *#readers* (cons (cons #\u (lambda (str) (string->number (substring str 1)))) ()))
+(test (eval (with-input-from-string "(+ 10 #u12)" read)) 22)
+(test (eval (with-input-from-string "(+ 10 #u87)" read)) 97)
+
+(set! *#readers*
+  (list (cons #\[
+	      (lambda (str)
+		(let ((h (make-hash-table)))
+		  (do ((c (read) (read)))
+		      ((eq? c ']#) h)
+		    (set! (h (car c)) (cdr c))))))))
+
+(eval-string "(let ((table #[(a . 1) (b . #[(c . 3)]#)]#))
+  (test (hash-table? table) #t)
+  (test (table 'a) 1)
+  (test (hash-table? (table 'b)) #t)
+  (test ((table 'b) 'c) 3))" (curlet))
+
+(set! *#readers* old-readers)
+
+(when with-block
+  (let ((b (make-block 4)))
+    (test (equivalent? b b) #t)
+    (let ((b1 (make-block 4)))
+      (test (equivalent? b b1) #t)
+      (set! (b 1) 1.0)
+      (test (equivalent? b b1) #f))))
+(test (let ((p (c-pointer 0))) (equivalent? p (copy p))) #t)
+
+
+;;; --------------------------------------------------------------------------------
+;;; some clm opt coverage tests
+;;; move these!
+
+(let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (quotient i 3)))) (num-test (fc) (quotient 9 3)))
+(let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (ash 3 3)))) (num-test (fc) (ash 3 3)))
+(let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (ash 3 i)))) (num-test (fc) (ash 3 9)))
+(let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (ash 3 (+ i 1))))) (num-test (fc) (ash 3 10)))
+(let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (ash i (+ i 1))))) (num-test (fc) (ash 9 10)))
+(let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (ash (+ i 1) (- i 1))))) (num-test (fc) (ash 10 8)))
+(let () (define (fc) (do ((count 0) (j 3) (i 7 (+ i 1))) ((= i 10) count) (set! count (quotient i j)))) (num-test (fc) (quotient 9 3)))
+(let () (define (fc) (do ((count 0.0) (i 7.0 (+ 1.0 i))) ((>= i 10.0) count) (set! count (quotient i 3.0)))) (num-test (fc) (quotient 9.0 3.0))) ; fx_add_ft
+(let () (define (fc) (do ((count 0.0) (i 7.0 (+ i 1.0))) ((>= i 10.0) count) (set! count (quotient i 3.0)))) (num-test (fc) (quotient 9.0 3.0)))
+(let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (remainder i 3)))) (test (fc) (remainder 9 3)))
+(let () (define (fc) (do ((count 0.0) (i 7.0 (+ i 1.0))) ((>= i 10.0) count) (set! count (remainder i 3.0)))) (test (fc) (remainder 9.0 3.0)))
+(let () (define (fc) (do ((count 0) (j 3) (i 7 (+ i 1))) ((= i 10) count) (set! count (remainder i j)))) (test (fc) (remainder 9 3)))
+(let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (modulo i 3)))) (test (fc) (modulo 9 3)))
+(let () (define (fc) (do ((count 0.0) (i 7.0 (+ i 1.0))) ((>= i 10.0) count) (set! count (modulo i 3.0)))) (test (fc) (modulo 9.0 3.0)))
+(let () (define (fc) (do ((count 0) (j 3) (i 7 (+ i 1))) ((= i 10) count) (set! count (modulo i j)))) (test (fc) (modulo 9 3)))
+(let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (max i 3)))) (test (fc) (max 9 3)))
+(let () (define (fc) (do ((count 0.0) (i 7.0 (+ i 1.0))) ((>= i 10.0) count) (set! count (max i 3.0)))) (test (fc) (max 9.0 3.0)))
+(let () (define (fc) (do ((count 0) (j 3) (i 7 (+ i 1))) ((= i 10) count) (set! count (max i j)))) (test (fc) (max 9 3)))
+(let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (min i 3)))) (test (fc) (min 9 3)))
+(let () (define (fc) (do ((count 0.0) (i 7.0 (+ i 1.0))) ((>= i 10.0) count) (set! count (min i 3.0)))) (test (fc) (min 9.0 3.0)))
+(let () (define (fc) (do ((count 0) (j 3) (i 7 (+ i 1))) ((= i 10) count) (set! count (min i j)))) (test (fc) (min 9 3)))
+(let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (logior i 3)))) (test (fc) (logior 9 3)))
+(let () (define (fc) (do ((count 0) (j 3) (i 7 (+ i 1))) ((= i 10) count) (set! count (logior i j)))) (test (fc) (logior 9 3)))
+(let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (logand i 3)))) (test (fc) (logand 9 3)))
+(let () (define (fc) (do ((count 0) (j 3) (i 7 (+ i 1))) ((= i 10) count) (set! count (logand i j)))) (test (fc) (logand 9 3)))
+(let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (logxor i 3)))) (test (fc) (logxor 9 3)))
+(let () (define (fc) (do ((count 0) (j 3) (i 7 (+ i 1))) ((= i 10) count) (set! count (logxor i j)))) (test (fc) (logxor 9 3)))
+(let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (lognot i)))) (test (fc) (lognot 9)))
+(let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (ash i 3)))) (test (fc) (ash 9 3)))
+(let () (define (fc) (do ((count 0) (j 3) (i 7 (+ i 1))) ((= i 10) count) (set! count (ash i j)))) (test (fc) (ash 9 3)))
+(let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (ash i -3)))) (test (fc) (ash 9 -3)))
+(let ((lt (inlet 'a 10))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) (let-ref lt 'a)) (let-set! lt 'a i))) (test (fc) 0))
+(let ((lt (inlet 'a 10)) (sym 'a)) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) (let-ref lt 'a)) (let-set! lt sym i))) (test (fc) 0))
+(let ((dfn (vector #f))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (if (defined? 'abs) (vector-set! dfn 0 #t)))) (test (fc) #(#t)))
+(let ((dfn (vector #f))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (if (defined? 'abs (curlet)) (vector-set! dfn 0 #t)))) (test (fc) #(#t)))
+(let ((dfn (vector ""))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (vector-set! dfn 0 (number->string i)))) (test (fc) (vector (number->string 0))))
+(let ((dfn (vector ""))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (vector-set! dfn 0 (number->string i 8)))) (test (fc) (vector (number->string 0 8))))
+(let ((dfn (float-vector 0.0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (magnitude i)))) (test (fc) (float-vector (magnitude 0.0))))
+(let ((dfn (float-vector 0.0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (angle i)))) (test (fc) (float-vector (angle 0.0))))
+(let ((dfn (vector 0.0))) (define (fc) (do ((i 0 (+ i 1))) ((>= i 1) dfn) (vector-set! dfn 0 (complex i i)))) (test (fc) (vector 0)))
+(let ((dfn (float-vector 0.0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (sin i)))) (test (fc) (float-vector (sin 0.0))))
+(let ((dfn (float-vector 0.0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (cos i)))) (test (fc) (float-vector (cos 0.0))))
+(let ((dfn (float-vector 0.0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (tan i)))) (test (fc) (float-vector (tan 0.0))))
+(let ((dfn (float-vector 0.0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (atan i i)))) (test (fc) (float-vector (atan 0.0 0.0))))
+(let ((dfn (float-vector 0.0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (sinh i)))) (test (fc) (float-vector (sinh 0.0))))
+(let ((dfn (float-vector 0.0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (cosh i)))) (test (fc) (float-vector (cosh 0.0))))
+(let ((dfn (float-vector 0.0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (tanh i)))) (test (fc) (float-vector (tanh 0.0))))
+(let ((dfn (float-vector 0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (floor i)))) (test (fc) (float-vector (floor 0.0))))
+(let ((dfn (int-vector 0))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (int-vector-set! dfn 0 (floor (sqrt i))))) (test (fc) (int-vector (sqrt 0))))
+(let ((dfn (float-vector 0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (ceiling i)))) (test (fc) (float-vector (ceiling 0.0))))
+(let ((dfn (int-vector 0))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (int-vector-set! dfn 0 (ceiling (sqrt i))))) (test (fc) (int-vector (ceiling (sqrt 0.0)))))
+(let ((dfn (int-vector 0))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (int-vector-set! dfn 0 (ceiling i)))) (test (fc) (int-vector (ceiling 0))))
+(let ((dfn (int-vector 0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (int-vector-set! dfn 0 (ceiling i)))) (test (fc) (int-vector (ceiling 0.0))))
+(let ((dfn (float-vector 0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (round i)))) (test (fc) (float-vector (round 0.0))))
+(let ((dfn (int-vector 0))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (int-vector-set! dfn 0 (round (sqrt i))))) (test (fc) (int-vector (round (sqrt 0)))))
+(let ((dfn (int-vector 0))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (int-vector-set! dfn 0 (round i)))) (test (fc) (int-vector (round 0))))
+(let ((dfn (int-vector 0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (int-vector-set! dfn 0 (round i)))) (test (fc) (int-vector (round 0.0))))
+(let ((dfn (int-vector 0))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (int-vector-set! dfn 0 (truncate i)))) (test (fc) (int-vector (truncate 0))))
+(let ((dfn (vector #f))) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (vector-set! dfn 0 (= i count)))) (test (fc) #(#t))) ;equal_p_ii
+(let ((dfn (vector #f))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (vector-set! dfn 0 (= i 0.0)))) (test (fc) #(#t))) ;equal_p_dd
+(let ((dfn #f)) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (set! dfn (= i 0)))) (test (fc) #t)) ;equal_p_pp
+(let ((dfn #f)) (define (fc) (do ((count '(0)) (i 0 (+ i 1))) ((= i 1) dfn) (set! dfn (= (car count) 0)))) (test (fc) #t)) ;equal_p_pi
+(let ((dfn (vector #f))) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (vector-set! dfn 0 (>= i count)))) (test (fc) #(#t)))
+(let ((dfn (vector #f))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (vector-set! dfn 0 (>= i 0.0)))) (test (fc) #(#t)))
+(let ((dfn (vector #f))) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (vector-set! dfn 0 (<= i count)))) (test (fc) #(#t)))
+(let ((dfn (vector #f))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (vector-set! dfn 0 (<= i 0.0)))) (test (fc) #(#t)))
+(let ((dfn (vector #f))) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (vector-set! dfn 0 (> i count)))) (test (fc) #(#f)))
+(let ((dfn (vector #f))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (vector-set! dfn 0 (> i 0.0)))) (test (fc) #(#f)))
+(let ((dfn (vector #f))) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (vector-set! dfn 0 (< i count)))) (test (fc) #(#f)))
+(let ((dfn (vector #f))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (vector-set! dfn 0 (< i 0.0)))) (test (fc) #(#f)))
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (<= i (sqrt count)) (set! dfn #t)))) (test (fc) #t)) ;leq_b_pp
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (>= i (sqrt count)) (set! dfn #t))))  (test (fc) #t))
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (> i (sqrt count)) (set! dfn #t))))  (test (fc) #f))
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (< i (sqrt count)) (set! dfn #t))))  (test (fc) #f))
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (>= i count) (set! dfn #t)))) (test (fc) #t))
+(let ((dfn #f)) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (if (>= i 0.0) (set! dfn #t)))) (test (fc) #t))
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (<= i count) (set! dfn #t)))) (test (fc) #t))
+(let ((dfn #f)) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (if (<= i 0.0) (set! dfn #t)))) (test (fc) #t))
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (> i count) (set! dfn #t)))) (test (fc) #f))
+(let ((dfn #f)) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (if (> i 0.0) (set! dfn #t)))) (test (fc) #f))
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (< i count) (set! dfn #t)))) (test (fc) #f))
+(let ((dfn #f)) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (if (< i 0.0) (set! dfn #t)))) (test (fc) #f))
+(let ((d #f)) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char=? #\b c) (set! d #t)))) (test (fc) #t)) ;char_eq_b_direct
+(let ((d #f) (e "b")) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char=? (string-ref e 0) c) (set! d #t)))) (test (fc) #t)) ;char_eq_b
+(let ((d #f)) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char<=? #\b c) (set! d #t)))) (test (fc) #t))
+(let ((d #f) (e "b")) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char<=? (string-ref e 0) c) (set! d #t)))) (test (fc) #t))
+(let ((d #f)) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char>=? #\b c) (set! d #t)))) (test (fc) #t))
+(let ((d #f) (e "b")) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char>=? (string-ref e 0) c) (set! d #t)))) (test (fc) #t))
+(let ((d #f)) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char<? #\b c) (set! d #t)))) (test (fc) #f))
+(let ((d #f) (e "b")) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char<? (string-ref e 0) c) (set! d #t)))) (test (fc) #f))
+(let ((d #f)) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char>? #\b c) (set! d #t)))) (test (fc) #f))
+(let ((d #f) (e "b")) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char>? (string-ref e 0) c) (set! d #t)))) (test (fc) #f))
+(let ((d #f)) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char-ci=? #\b c) (set! d #t)))) (test (fc) #t))
+(let ((d #f) (e "b")) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char-ci=? (string-ref e 0) c) (set! d #t)))) (test (fc) #t))
+(let ((d #f)) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char-ci<=? #\b c) (set! d #t)))) (test (fc) #t))
+(let ((d #f) (e "b")) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char-ci<=? (string-ref e 0) c) (set! d #t)))) (test (fc) #t))
+(let ((d #f)) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char-ci>=? #\b c) (set! d #t)))) (test (fc) #t))
+(let ((d #f) (e "b")) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char-ci>=? (string-ref e 0) c) (set! d #t)))) (test (fc) #t))
+(let ((d #f)) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char-ci<? #\b c) (set! d #t)))) (test (fc) #f))
+(let ((d #f) (e "b")) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char-ci<? (string-ref e 0) c) (set! d #t)))) (test (fc) #f))
+(let ((d #f)) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char-ci>? #\b c) (set! d #t)))) (test (fc) #f))
+(let ((d #f) (e "b")) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char-ci>? (string-ref e 0) c) (set! d #t)))) (test (fc) #f))
+(let ((d #f)) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string=? "b" c) (set! d #t)))) (test (fc) #t))
+(let ((d #f) (e #("b"))) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string=? (vector-ref e 0) c) (set! d #t)))) (test (fc) #t))
+(let ((d #f)) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string<=? "b" c) (set! d #t)))) (test (fc) #t))
+(let ((d #f) (e #("b"))) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string<=? (vector-ref e 0) c) (set! d #t)))) (test (fc) #t))
+(let ((d #f)) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string>=? "b" c) (set! d #t)))) (test (fc) #t))
+(let ((d #f) (e #("b"))) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string>=? (vector-ref e 0) c) (set! d #t)))) (test (fc) #t))
+(let ((d #f)) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string<? "b" c) (set! d #t)))) (test (fc) #f))
+(let ((d #f) (e #("b"))) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string<? (vector-ref e 0) c) (set! d #t)))) (test (fc) #f))
+(let ((d #f)) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string>? "b" c) (set! d #t)))) (test (fc) #f))
+(let ((d #f) (e #("b"))) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string>? (vector-ref e 0) c) (set! d #t)))) (test (fc) #f))
+(let ((d #f)) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string-ci=? "b" c) (set! d #t)))) (test (fc) #t))
+(let ((d #f) (e #("b"))) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string-ci=? (vector-ref e 0) c) (set! d #t)))) (test (fc) #t))
+(let ((d #f)) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string-ci<=? "b" c) (set! d #t)))) (test (fc) #t))
+(let ((d #f) (e #("b"))) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string-ci<=? (vector-ref e 0) c) (set! d #t)))) (test (fc) #t))
+(let ((d #f)) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string-ci>=? "b" c) (set! d #t)))) (test (fc) #t))
+(let ((d #f) (e #("b"))) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string-ci>=? (vector-ref e 0) c) (set! d #t)))) (test (fc) #t))
+(let ((d #f)) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string-ci<? "b" c) (set! d #t)))) (test (fc) #f))
+(let ((d #f) (e #("b"))) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string-ci<? (vector-ref e 0) c) (set! d #t)))) (test (fc) #f))
+(let ((d #f)) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string-ci>? "b" c) (set! d #t)))) (test (fc) #f))
+(let ((d #f) (e #("b"))) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string-ci>? (vector-ref e 0) c) (set! d #t)))) (test (fc) #f))
+(let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (+ i)))) (test (fc) 2.0)) ;add_d_d
+(let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (magnitude (+ i 1.0))))) (test (fc) 3.0)) ;add_p_dd
+(let () (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 3) count) (set! count (- i)))) (test (fc) -2)) ;subtract_i_i
+(let () (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 3) count) (set! count (- i i i)))) (test (fc) -2)) ;subtract_i_iii
+(let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (- i)))) (test (fc) -2.0)) ;subtract_d_d
+(let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (- i i)))) (test (fc) 0.0)) ;subtract_d_dd
+(let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (- i i i)))) (test (fc) -2.0)) ;subtract_d_ddd
+(let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (- i i i i)))) (test (fc) -4.0)) ;subtract_d_dddd
+(let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (magnitude (- i 1.0))))) (test (fc) 1.0)) ;sub_p_dd
+(let ((fv #r(1.0)))
+  (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (magnitude (- i (* 0.5 (float-vector-ref fv 0))))))) (test (fc) 1.5)) ;subtract_p_pp
+(let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (* i)))) (test (fc) 2.0)) ;multiply_d_d
+(let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (* i i)))) (test (fc) 4.0)) ;multiply_d_dd
+(let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (* i i i)))) (test (fc) 8.0)) ;multiply_d_ddd
+(let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (* i i i i)))) (test (fc) 16.0)) ;multiply_d_dddd
+(let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (magnitude (* i 1.0))))) (test (fc) 2.0)) ;mul_p_dd
+(let ((fv #r(1.0)))
+  (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (magnitude (* i (* 0.5 (float-vector-ref fv 0))))))) (test (fc) 1.0)) ;multiply_p_pp
+(let () (define (fc) (do ((count 0.0) (i 1.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (/ i)))) (test (fc) 0.5)) ;divide_d_d
+(let () (define (fc) (do ((count 0.0) (i 1.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (/ i i)))) (test (fc) 1.0)) ;divide_d_dd
+(let () (define (fc) (do ((count 0.0) (i 1.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (/ i i i)))) (test (fc) 0.5)) ;divide_d_ddd
+(let () (define (fc) (do ((count 0.0) (i 1.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (/ i i i i)))) (test (fc) 0.25)) ;divide_d_dddd
+(let () (define (fc) (do ((count 0) (i 1 (+ i 1))) ((= i 3) count) (set! count (magnitude (/ i i))))) (test (fc) 1))
+(let () (define (fc) (do ((count 0) (i 1 (+ i 1))) ((= i 3) count) (set! count (abs (/ i i))))) (test (fc) 1))
+(let () (define (fc) (do ((count 0.0) (i 1 (+ i 1))) ((= i 3) count) (set! count (magnitude (/ i i))))) (test (fc) 1.0))
+(let () (define (fc) (do ((count 0.0) (i 1 (+ i 1))) ((= i 3) count) (set! count (abs (/ i i))))) (test (fc) 1.0))
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (set! dfn (<= i (sqrt count))))) (test (fc) #t)) ;leq_p_pp
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (set! dfn (<= (sqrt count) 1)))) (test (fc) #t)) ;leq_p_pi
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (set! dfn (< (sqrt count) 1)))) (test (fc) #t)) ;lt_p_pi
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (set! dfn (>= (sqrt count) 1)))) (test (fc) #f)) ;geq_p_pi
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (set! dfn (> (sqrt count) 1)))) (test (fc) #f)) ;gt_p_pi
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (<= (sqrt count) 1) (set! dfn #t)))) (test (fc) #t)) ;leq_b_pi
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (< (sqrt count) 1) (set! dfn #t)))) (test (fc) #t)) ;lt_b_pi
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (>= (sqrt count) 1) (set! dfn #t)))) (test (fc) #f)) ;geq_b_pi
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (> (sqrt count) 1) (set! dfn #t)))) (test (fc) #f)) ;gt_b_pi
+(let () (define (fc) (do ((count 0.0) (i 1.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (imag-part (complex i i))))) (test (fc) 2.0)) ;imag_part_d_p
+(let () (define (fc) (do ((count 0.0) (i 1.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (real-part (complex i i))))) (test (fc) 2.0)) ;real_part_d_p
+(let () (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) count) (set! count (numerator (/ i 2))))) (test (fc) 0)) ;numerator_i
+(let () (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) count) (set! count (denominator (/ i 2))))) (test (fc) 1)) ;denominator_i
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (nan? i) (set! dfn #t)))) (test (fc) #f)) ;is_nan_b
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (infinite? i) (set! dfn #t)))) (test (fc) #f)) ;is_infinite_b
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (even? i) (set! dfn #t)))) (test (fc) #t)) ;is_even_i
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (odd? i) (set! dfn #t)))) (test (fc) #f)) ;is_odd_i
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (even? (magnitude i)) (set! dfn #t)))) (test (fc) #t)) ;is_even_b
+(let ((dfn #f))  (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (odd? (magnitude i)) (set! dfn #t)))) (test (fc) #f)) ;is_odd_b
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (zero? i) (set! dfn #t)))) (test (fc) #t)) ;is_zero_i
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (zero? (magnitude i)) (set! dfn #t)))) (test (fc) #t)) ;is_zero_d
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (zero? (sqrt i)) (set! dfn #t)))) (test (fc) #t)) ;is_zero_b
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (negative? i) (set! dfn #t)))) (test (fc) #f)) ;is_negative_i
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (negative? (magnitude i)) (set! dfn #t)))) (test (fc) #f)) ;is_negative_d
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (negative? (sqrt i)) (set! dfn #t)))) (test (fc) #f)) ;is_negative_b
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (positive? i) (set! dfn #t)))) (test (fc) #f)) ;is_positive_i
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (positive? (magnitude i)) (set! dfn #t)))) (test (fc) #f)) ;is_positive_d
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (positive? (sqrt i)) (set! dfn #t)))) (test (fc) #f)) ;is_positive_b
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (exact? (sqrt i)) (set! dfn #t)))) (test (fc) #t)) ;is_exact_b
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (inexact? (sqrt i)) (set! dfn #t)))) (test (fc) #f)) ;is_inexact_b
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) count) (set! count (integer-length i)))) (test (fc) 0)) ;integer_length_i_i
+(let () (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) count) (set! count (random i)))) (test (fc) 0)) ;random_i_i
+(let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 1.0) count) (set! count (random i)))) (test (fc) 0.0)) ;random_d_d
+(let () (define (fc) (do ((count (complex 1 1)) (i 0 (+ i 1))) ((= i 1) count) (set! count (random (complex i i))))) (test (fc) 0)) ;random_p_p
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (random-state? i) (set! dfn #t)))) (test (fc) #f)) ;is_random_state_b
+(let ((str "123qasde")) (define (fc) (do ((i 0 (+ i 1))) ((= i 1)) (char-position #\a str 0))) (test (fc) #t)) ;char_position_p_ppi
+(let ((str "123qasde")) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) count) (set! count (string-length str)))) (test (fc) 8)) ;string_length_i
+(let ((str #("123qasde")))
+  (define (fc) (catch #t (lambda () (do ((count #\a) (i 0 (+ i 1))) ((= i 1) count) (set! count (string-ref str i)))) (lambda args 'error))) (test (fc) 'error)) ;string_ref_p_pi
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (macro? i) (set! dfn #t)))) (test (fc) #f)) ;is_macro_b
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (float? i) (set! dfn #t)))) (test (fc) #f)) ;is_float_b
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (port-closed? *stdout*) (set! dfn #t)))) (test (fc) #f)) ;is_port_closed_b
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (directory? "s7test.scm") (set! dfn #t)))) (test (fc) #f)) ;is_directory_b
+(let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (sequence? i) (set! dfn #t)))) (test (fc) #f)) ;is_sequence_b
+(let ((p '(1 2 (3 4)))) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) count) (set! count (tree-leaves p)))) (test (fc) 4)) ; tree_leaves_i
+(let () (define (fc) (do ((i 0 (+ i 1))) ((= i 1)) (newline))) (let-temporarily (((current-output-port) #f)) (test (fc) #t)))
+(let () (define (fc) (do ((i 0 (+ i 1))) ((= i 1)) (newline #f))) (test (fc) #t))
+(let () (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1)) (set! count (port-line-number (current-input-port))))) (test (fc) #t)) ; port_line_number_i_p
+(let ((dfn #f)) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (if (provided? 'asdf) (set! dfn #t)))) (test (fc) #f)) ; is_provided_b
+(let ((str #u(1 2 3))) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) count) (set! count (byte-vector-ref str i)))) (test (fc) 1)) ; byte_vector_ref_i
+(let ((str #u(1 2 3))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) (str 0)) (byte-vector-set! str i 4))) (test (fc) 4)) ; byte_vector_set_i
+
+(let () (define (f1) (let ((dfn #f)) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (logbit? i count) (set! dfn #t))))) (test (f1) #f)) ; opt_b_ii_ss
+(let () (define (f2) (let ((dfn #f)) (do ((i 0 (+ i 1))) ((= i 1) dfn) (if (logbit? i 0) (set! dfn #t))))) (test (f2) #f)) ; opt_b_ii_sc_bit
+(let () (define (f3) (let ((dfn #f)) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((= i 1.0) dfn) (if (> i count) (set! dfn #t))))) (test (f3) #f)) ; opt_b_dd_ss_gt
+(let () (define (f4) (let ((dfn #f)) (do ((count 1.0) (i 0.0 (+ i 1.0))) ((= i 1.0) dfn) (if (< i count) (set! dfn #t))))) (test (f4) #t)) ; opt_b_dd_ss_lt
+(let () (define (f5) (let ((dfn #f)) (do ((count 1.0) (i 0.0 (+ i 1.0))) ((= i 1.0) dfn) (if (< i 1.0) (set! dfn #t))))) (test (f5) #t)) ; opt_b_dd_sc_lt
+(let () (define (f6) (let ((dfn #f)) (do ((count 1.0) (i 0.0 (+ i 1.0))) ((= i 1.0) dfn) (if (>= i 0.0) (set! dfn #t))))) (test (f6) #t)) ; opt_b_dd_sc_geq
+(let () (define (f7) (let ((dfn #f)) (do ((count 1.0) (i 0.0 (+ i 1.0))) ((= i 1.0) dfn) (if (<= i 1.0) (set! dfn #t))))) (test (f7) #t)) ; opt_b_dd_sc
+(let () (define (f8) (let ((dfn #f)) (do ((count 1.0) (i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (if (= i 1.0) (set! dfn #t))))) (test (f8) #f)) ; opt_b_dd_sc_eq
+(let () (define (f9) (let ((dfn #f)) (do ((count 1.0) (i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (if (= i (+ count 1.0)) (set! dfn #t))))) (test (f9) #f)) ; opt_b_dd_sf
+(let () (define (f10) (let ((dfn #f)) (do ((count 1.0) (i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (if (= (+ i 1.0) (+ count 1.0)) (set! dfn #t))))) (test (f10) #f)) ; opt_b_dd_ff
+(let () (define (f11) (do ((x 1.0) (i 0 (+ i 1))) ((= i 1)) (if (negative? (+ x 1.0)) (* x 2) (- x 3)))) (test (f11) #t)) ; opt_b_d_f
+(let () (define (f12) (let ((dfn #\c)) (do ((i 0 (+ i 1))) ((= i 1) dfn) (if (char=? dfn #\a) (set! dfn #\b))))) (test (f12) #\c)) ; opt_b_7pp_sc
+(let () (define (f13) (let ((dfn #\c)) (do ((i 0 (+ i 1))) ((= i 1) dfn) (if (eq? dfn #\a) (set! dfn #\b))))) (test (f13) #\c)) ; opt_b_pp_sc
+
+(let () (define (f14) (let ((dfn #f)) (do ((count 0) (i 0 (+ i 1))) ((= i 1) count) (set! count (random 1))))) (test (f14) 0)) ; opt_i_7i_c
+(let () (define (f15) (let ((dfn #f)) (do ((count 0) (i 0 (+ i 1))) ((= i 1) count) (set! count (ash (+ i 1) 3))))) (test (f15) 8)) ; opt_i_7ii_fc
+
+;;; coverage for op_let_a_fx_old -- why does it have to be at top level?
+(define (___f fv) (let ((fv-copy (copy fv))) (reverse! fv) (reverse! fv))) (___f (int-vector 1 2 3)) (test (___f (int-vector 1 2 3)) #i(1 2 3))
+
+;;; fx coverage
+(define _gfx_ 3)
+(define _vfx_ (vector (vector 0)))
+(define _vfxi_ (vector 0))
+(let () ; fx_* coverage
+  (define (f1 x) (and (pair? (cddr x)) (symbol? (cadr x))))
+  (test (f1 (list 1 2 3)) #f)
+  (test (f1 (list 1 'a 3)) #t)
+  (test (f1 (list 1 'a)) #f)
+
+  (define (f2 x) (and (not (null? x)) (pair? (car x))))
+  (test (f2 (list 1 2)) #f)
+  (test (f2 (list (list 1) 2)) #t)
+  (test (f2 (list)) #f)
+
+  (define (f3 x y) (or (< x y) (<= x y)))
+  (test (f3 3 2) #f)
+  (test (f3 3 3) #t)
+  (test (f3 1 2) #t)
+
+  (define (f4 x y) (or (>= x y) (> x _gfx_)))
+  (test (f4 4 5) #t)
+  (test (f4 3 3) #t)
+  (test (f4 2 3) #f)
+
+  (define (f5 fv z) (let ((x (vector-ref fv 0))) (when (< x z) (vector-set! fv 0 (+ x 1)) (f5 fv z))))
+  (test (f5 (vector 0) 2) #<unspecified>)
+
+  (define (f6 fv z) (let ((x (length fv))) (when (eqv? x z) (f6 (cons x fv) z))))
+  (test (f6 (list 0) 2) #<unspecified>)
+
+  (define (f7 x y) (let ((z x)) (if (zero? z) (f7 (- x 1) (cons z y)))))
+  (test (f7 2 ()) #<unspecified>)
+
+  (define (f8 x y z) (or (proper-list? z) (hash-table? x) (integer? z)))
+  (test (f8 0 0 (list 1)) #t)
+  (test (f8 0 0 1) #t)
+  (test (f8 0 0 (vector 1)) #f)
+
+  (define (f9 x y) (or (vector? x) (not x) (vector? y)))
+  (test (f9 #f 0) #t)
+  (test (f9 #(0) 0) #t)
+  (test (f9 () ()) #f)
+
+  (define (f10 x) (or (= x _gfx_) (eqv? x _gfx_)))
+  (test (f10 1) #f)
+  (test (f10 _gfx_) #t)
+
+  (define (f11 x y z) (or (not (eq? (car z) 'a)) (null? (cddr z)) (eqv? x y)))
+  (test (f11 1 2 (list 1 2)) #t)
+  (test (f11 1 1 (list 'a 2)) #t)
+
+  (define (f12 x y) (if (not (> y x)) (not (eqv? y x))))
+  (test (f12 1 2) #<unspecified>)
+  (test (f12 1 1) #f)
+
+  (define (f13 x y q r) (if (zero? (- (* q r) (* r q))) 32 12) (if (< (- q r) (- r q)) 32 12))
+  (test (f13 1 2 3 4) 32)
+
+  (define (f14 x y) (let ((z (+ x y))) (cond ((= z 0) pi) ((< z 0) 'oops) (else (f14 (- x 1) (- y 1))))))
+  (test (f14 1 2) 'oops)
+
+  (define (f15 lst) (let loop ((p lst) (sum 0)) (if (null? p) sum (loop (cdr p) (+ sum (car p))))))
+  (test (f15 (list 0 1 2)) 3)
+
+  (define (f16 x y z) (+ (* 3.0 x) (- 3.0 x) (- z 3.0)))
+  (test (f16 3 4 5) 11.0)
+
+  (define (f17 x y z) (let ((v (vector 'a))) (if (eq? z (vector-ref v x)) 0 1)))
+  (test (f17 0 0 'a) 0)
+
+  (define (f18 x y z) (let ((v (vector 0))) (if (>= z (vector-ref v x)) 0 1)))
+  (test (f18 0 0 0) 0)
+
+  (define (f19 x y z) (let ((v (vector 0))) (if (> (vector-ref v x) z) 0 1)))
+  (test (f19 0 0 0) 1)
+
+  (define (f20 x y z) (let ((v (vector 0))) (+ (* z (vector-ref v x)) (- z (vector-ref v y)))))
+  (test (f20 0 0 0) 0)
+
+  (define (f21 x y z) (let ((v (vector 0))) (if (> (+ z (vector-ref v x)) 1) 0 1)))
+  (test (f21 0 0 0) 1)
+
+  (define (len=2? x) (and (pair? x) (pair? (cdr x)) (null? (cddr x))))
+  (define (f22 x) (and (list? x) (len=2? x)))
+  (test (f22 (list 1 2)) #t)
+
+  (define (len>2? x) (and (pair? x) (pair? (cdr x)) (pair? (cddr x))))
+  (define (f23 x) (and (list? x) (len>2? x)))
+  (test (f23 (list 1 2 3)) #t)
+
+  (define (f24 x) (let ((h (hash-table))) (hash-table-set! h x (+ (or (hash-table-ref h x) 0) 1))))
+  (test (f24 'a) 1)
+
+  (define (f25 x) (if (or (not (symbol? x)) (keyword? x)) 1 0))
+  (test (f25 'a) 0)
+  (test (f25 :a) 1)
+  (test (f25 #f) 1)
+
+  (define (f26 x)  (if (> (+ _gfx_ (* x 2) 32) 0) 1 0))
+  (test (f26 3) 1)
+
+  (define (f27 x) (let ((y 3)) (if (zero? (remainder x y)) 0 1)))
+  (test (f27 4) 1)
+  (test (f27 6) 0)
+
+  (define (f28 x y) (if (= (remainder (car y) x) 0) 0 (f28 (- x 1) y)))
+  (test (f28 2 '(3)) 0)
+  (test (f28 3 '(3)) 0)
+
+  (define (f29) (let ((v (vector 1 2)) (i 0) (j 1)) (if (zero? (- (vector-ref v i) (vector-ref v j))) 0 1)))
+  (test (f29) 1)
+
+  (define (f30 x) (if (eq? (string-ref (symbol->string (car x)) 0) #\a) 0 1))
+  (test (f30 '(abc)) 0)
+  (test (f30 '(bcd)) 1)
+
+  (define (f31 x) (do ((y 3 (+ y 1))) ((or (zero? x) (>= y x)) 0)))
+  (test (f31 4) 0)
+  (test (f31 0) 0)
+
+  (define (f32 x y z) (if (vector-ref x (+ y z)) 1 0))
+  (test (f32 (vector #f #t) 1 0) 1)
+
+  (define (f33 x y) (if (string? (number->string (+ 1 (car x) (car x)) y)) 1 0))
+  (test (f33 '(0) 10) 1)
+
+  (define (f34 x y q r) (eqv? (vector-ref (vector-ref q r) y) 0))
+  (test (f34 0 0 (vector (vector 1)) 0) #f)
+  (test (f34 0 0 (vector (vector 0)) 0) #t)
+
+  (define (f35 x y q r) (eqv? (vector-ref (vector-ref x y) q) 0))
+  (test (f35 (vector (vector 1)) 0 0 0) #f)
+  (test (f35 (vector (vector 0)) 0 0 0) #t)
+
+  (define (f36 x y) (eqv? (vector-ref (vector-ref _vfx_ y) x) 0))
+  (test (f36 0 0) #t)
+  (test (f36 0 1) 'error)
+
+  (define (f37 x) (eqv? (vector-ref _vfx_ (vector-ref _vfxi_ x)) 0))
+  (test (f37 0) #f)
+
+  (define (f38 x y) (eqv? (+ (* x x) (* y y)) 1))
+  (test (f38 1 2) #f)
+  (test (f38 1 0) #t)
+
+  (define (f39 x y z) (eqv? (vector-ref (vector-ref x y) z) 0))
+  (test (f39 (vector (vector 0)) 0 0) #t)
+  (test (f39 (vector (vector 1)) 0 0) #f)
+
+  (define (f40 items sequence)
+    (cond ((not (pair? sequence)) sequence) ((memq (car sequence) items) (f40 items (cdr sequence))) (else (cons (car sequence) (f40 items (cdr sequence))))))
+  (test (f40 '(a b c) '(a d f e b c)) '(d f e))
+
+  (define (f41 row dist placed) (or (null? placed) (and (not (= (car placed) (+ row dist))) (not (= (car placed) (- row dist))) (f41 row (+ dist 1) (cdr placed)))))
+  (test (f41 0 0 '(0 1 2)) #f)
+  (test (f41 0 1 '(0 1 2)) #t)
+
+  (define (f42 v i j y)
+    (if (and (or (> (vector-ref v i) y)
+                 (>= y (vector-ref v j)))
+             (or (> (vector-ref v j) y)
+                 (>= y (vector-ref v i))))
+	0 1))
+  (test (f42 (vector 1 2 3 4) 1 2 3) 0)
+  (test (f42 (vector 1 2 3 4) 1 2 2) 1)
+
+  (define-constant (f43 x)
+    (and (pair? x) (pair? (cdr x))))
+  (define (g)
+    (let ((x (list 1 2)))
+      (if (f43 x) 0 1)))
+  (test (g) 0)
+
+  (define (f44 fv z)
+    (let ((x (vector-ref fv 0)))
+      (when (< x 30)
+	(vector-set! fv 0 z)
+	(f44 fv (+ z 1)))))
+  (test (f44 (vector 0) 0) #<unspecified>)
+
+  (define (f45 x y z q)
+    (zero? (* x (hash-table-ref y (vector-ref z q)))))
+  (test (f45 2.0 (hash-table 'a 3.0) (vector 'a) 0) #f)
+
+  (define (f46 x y z)
+    (zero? (- (string->number (vector-ref x y)) z)))
+  (test (f46 (vector "3.0") 0 1.0) #f)
+
+  (define (f47 x y)
+    (if (number? y)
+        (or (positive? y)
+            (/ 3.5 y))
+        (cddr y)))
+  (test (f47 0 1) #t)
+  (test (f47 0 -1) -3.5)
+  (test (f47 -1 (list 1 2)) ())
+
+  (let () ; tshoot
+    (define (palindrome? string)
+      (or (< (string-length string) 2)
+	  (and (char=? (string-ref string 0)
+		       (string-ref string (- (string-length string) 1)))
+  	       (palindrome? (substring string 1 (- (string-length string) 1))))))
+    (define (pal-test) (test (palindrome? "abcdefgfedcba") #t))
+    (pal-test))
+
+  (let () ; primes.scm benchmark
+    (define  (iotar m n) (if (> m n) () (cons m (iotar (+ 1 m) n))))
+    (define (erat l)
+      (letrec ((only-p (lambda (n l)
+		         (if (null? l) ()
+			     (if (= (remainder (car l) n) 0)
+			         (only-p n (cdr l))
+			         (cons (car l) (only-p n (cdr l))))))))
+        (if (null? l) () (cons (car l) (erat (only-p (car l) (cdr l)))))))
+    (define (f49) (erat (iotar 2 20)))
+    (test (f49) '(2 3 5 7 11 13 17 19)))
+)
+
+(let ()
+  ;; unknown_g
+  (define (f3 f x) (f x))
+  (define (f2 x) (+ x 1))
+  (define (f4 x) (list x) (+ x 2))
+  (define (f5 x) (call-with-exit (lambda (return) (return (+ x 1)))))
+  (define f6 (vector 1 2 3))
+  (define f7 "123")
+  (test (f3 f2 1) 2)
+  (test (f3 f4 1) 3)
+  (test (f3 f5 1) 2)
+  (test (f3 f6 1) 2)
+  (test (f3 f7 1) #\2)
+
+  (define (f8 g x) (g x))
+  (test (f8 f2 1) 2)
+  (test (f8 (lambda (x) (+ x 1)) 1) 2)
+  (test (f8 abs -1) 1)
+  (test (f8 + 1) 1)
+  (test (f8 (list 1 2 3) 1) 2)
+
+  ;; unknown_ss
+  (define (f9 g x y) (g x y))
+  (define (f10 x y) (+ x y))
+  (define (f11 x y) (list x y) (+ x y))
+  (define (f12 x y) (call-with-exit (lambda (return) (return (+ x y)))))
+  (define f13 #2r((1 2 3 4 5 6 7) (8 9 10 11 12 13 14)))
+  (define-macro (f14 x y) `(+ ,x ,y))
+  (test (f9 f10 1 2) 3)
+  (test (f9 f11 3 4) 7)
+  (test (f9 f12 3 4) 7)
+  (test (f9 f13 1 2) 10.0)
+  (test (f9 f14 7 8) 15)
+
+  ;; unknown_a
+  (define (f13 f x) (f (* x 3)))
+  (define (f12 x) (+ x 1))
+  (define (f14 x) (list x) (+ x 2))
+  (define (f15 x) (call-with-exit (lambda (return) (return (+ x 1)))))
+  (define f16 (vector 1 2 3 4 5 6))
+  (define f17 "123456")
+  (test (f13 f12 1) 4)
+  (test (f13 f14 1) 5)
+  (test (f13 f15 1) 4)
+  (test (f13 f16 1) 4)
+  (test (f13 f17 1) #\4)
+
+  (define (f18 g x) (g (* 3 x)))
+  (test (f18 f12 1) 4)
+  (test (f18 (lambda (x) (+ x 1)) 1) 4)
+  (test (f18 abs -1) 3)
+  (test (f18 + 1) 3)
+  (test (f18 (list 1 2 3 4 5 6) 1) 4))
+
+;; -------- unknown:
+(test (let ((e-1 (lambda (x) (x)))) (e-1 +)) 0)
+(test (let ((e-1 (lambda (x) (x)))) (e-1 (lambda () 3))) 3)
+(test (let ((e-1 (lambda (x) (x)))) (e-1 (lambda* ((d 32)) d))) 32)
+(test (let ((e-1 (lambda (x) (x)))) (call-with-exit (lambda (return) (e-1 return) 123))) ())
+(test (let ((e-1 (lambda (x) (x)))) (e-1 (macro () `(+ 1 2)))) 3)
+(test (let ((e-1 (lambda (x) (x)))) (e-1 (macro* ((d 32)) `(+ 1 ,d)))) 33)
+(test (let ((e-1 (lambda (x) (x)))) (let ((iter (make-iterator '(1 2 3)))) (e-1 iter))) 1)
+
+;; -------- unknown_g:
+(test (let ((f-1 (lambda (x a) (x a)))) (f-1 abs 2)) 2)
+(test (let ((f-1 (lambda (x a) (x a)))) (f-1 / 2)) 1/2)
+(test (let ((f-1 (lambda (x a) (x a)))) (f-1 #(0 1 2 3) 2)) 2)
+(test (let ((f-1 (lambda (x a) (x a)))) (f-1 #r(1 2 3 4) 2)) 3.0)
+(test (let ((f-1 (lambda (x a) (x a)))) (f-1 (lambda (b) (+ b 1)) 2)) 3)
+(test (let ((f-1 (lambda (x a) (x a)))) (f-1 (lambda* (b (d 3)) (+ b d)) 2)) 5)
+(test (let ((f-1 (lambda (x a) (x a)))) (f-1 (macro (x) `(+ ,x 10)) 2)) 12)
+(test (let ((f-1 (lambda (x a) (x a)))) (f-1 (macro* (x (d 10)) `(+ ,x ,d)) 2)) 12)
+(test (let ((f-1 (lambda (x a) (x a)))) (f-1 (list 1 2 3 4) 2)) 3)
+(test (let ((f-1 (lambda (x a) (x a)))) (f-1 (hash-table 1 2 2 4) 2)) 4)
+(test (let ((f-1 (lambda (x a) (x a)))) (f-1 "asdf" 2)) #\d)
+(test (let ((f-1 (lambda (x a) (x a)))) (f-1 (block 1 2 3 4) 2)) 3.0)
+(test (let ((f-1 (lambda (x a) (x a)))) (f-1 (bacro (x) `(+ ,x 10)) 2)) 12) ; no fixup [-> op_s_s in this case]
+(test (let ((f-1 (lambda (x a) (x a)))) (f-1 abs 2)) 2) ; op_s_s
+(test (let ((f-1 (lambda (x a) (x a)))) (call-with-exit (lambda (return) (f-1 return 32) 2))) 32)
+(test (let ((f-1 (lambda (x a) (x a)))) (call/cc (lambda (return) (f-1 return 32) 2))) 32)
+(test (let ((f-1 (lambda (x a) (x a)))) (f-1 (inlet 'a 1 'b 2) 'b)) 2)
+
+;;; -------- unknown_gg:
+(test (let ((g-1 (lambda (x a b) (x a b)))) (g-1 + 2 3)) 5)
+(test (let ((g-1 (lambda (x a b) (x a b)))) (g-1 / 2 3)) 2/3)
+(test (let ((g-1 (lambda (x a b) (x a b)))) (g-1 #2d((0 1 2 3) (4 5 6 7)) 1 2)) 6)
+(test (let ((g-1 (lambda (x a b) (x a b)))) (g-1 (lambda (b c) (+ b c)) 2 3)) 5)
+(test (let ((g-1 (lambda (x a b) (x a b)))) (g-1 (lambda* (b (d 3)) (+ b d)) 2 1)) 3)
+(test (let ((g-1 (lambda (x a b) (x a b)))) (g-1 (macro (x y) `(+ ,x ,y)) 2 3)) 5)
+(test (let ((g-1 (lambda (x a b) (x a b)))) (g-1 (macro* (x (d 10)) `(+ ,x ,d)) 2 1)) 3)
+
+;; -------- unknown_a:
+(test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 abs 2)) 3)
+(test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 / 2)) 1/3)
+(test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 #(0 1 2 3) 2)) 3)
+(test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 #r(1 2 3 4) 2)) 4.0)
+(test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 (lambda (b) (+ b 1)) 2)) 4)
+(test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 (lambda* (b (d 3)) (+ b d)) 2)) 6)
+(test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 (macro (x) `(+ ,x 10)) 2)) 13)
+(test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 (macro* (x (d 10)) `(+ ,x ,d)) 2)) 13)
+(test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 (list 1 2 3 4) 2)) 4)
+(test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 (hash-table 1 2 3 4) 2)) 4)
+(test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 "asdf" 2)) #\f)
+(test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 (block 1 2 3 4) 2)) 4.0)
+(test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 (bacro (x) `(+ ,x 10)) 2)) 13) ; no fixup [-> op_s_s in this case]
+(test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 abs 2)) 3) ; op_s_s
+(test (let ((f-1 (lambda (x a) (x (+ a 1))))) (call-with-exit (lambda (return) (f-1 return 32) 2))) 33)
+(test (let ((f-1 (lambda (x a) (x (+ a 1))))) (call/cc (lambda (return) (f-1 return 32) 2))) 33)
+(test (let ((f-1 (lambda (x a) (x (car '(a)))))) (f-1 (inlet 'a 1 'b 2) 'b)) 1)
+
+;;; -------- unknown_aa:
+(test (let ((g-1 (lambda (x a b) (x (+ a 1) (- b 1))))) (g-1 + 2 3)) 5)
+(test (let ((g-1 (lambda (x a b) (x (+ a 1) (- b 1))))) (g-1 / 2 3)) 3/2)
+(test (let ((g-1 (lambda (x a b) (x (+ a 1) (- b 1))))) (g-1 #2d((0 1 2 3) (4 5 6 7)) 0 3)) 6)
+(test (let ((g-1 (lambda (x a b) (x (+ a 1) (- b 1))))) (g-1 (lambda (b c) (+ b c)) 2 3)) 5)
+(test (let ((g-1 (lambda (x a b) (x (+ a 1) (- b 1))))) (g-1 (lambda* (b (d 3)) (+ b d)) 2 1)) 3)
+(test (let ((g-1 (lambda (x a b) (x (+ a 1) (- b 1))))) (g-1 (macro (x y) `(+ ,x ,y)) 2 3)) 5)
+(test (let ((g-1 (lambda (x a b) (x (+ a 1) (- b 1))))) (g-1 (macro* (x (d 10)) `(+ ,x ,d)) 2 1)) 3)
+
+;;; -------- unknown_all_s:
+(test (let ((g-1 (lambda (x a b c) (x a b c)))) (g-1 + 2 3 -1)) 4)
+(test (let ((g-1 (lambda (x a b c) (x a b c)))) (g-1 / 2 3 2)) 1/3)
+(test (let ((g-1 (lambda (x a b c) (x a b c)))) (g-1 (lambda (b c d) (+ b c d)) 2 3 1)) 6)
+(test (let ((g-1 (lambda (x a b c) (x a b c)))) (g-1 (lambda* (b (d 3) (e 0)) (+ b d e)) 2 1 3)) 6)
+(test (let ((g-1 (lambda (x a b c) (x a b c)))) (g-1 (macro (x y z) `(+ ,x ,y ,z)) 2 3 4)) 9)
+(test (let ((g-1 (lambda (x a b c) (x a b c)))) (g-1 (macro* (x (d 10) (e 0)) `(+ ,x ,d ,e)) 2 1 3)) 6)
+
+;;; -------- unknown_all_a:
+(test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) (* c 2))))) (g-1 + 2 3 5)) 15)
+(test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) (* c 2))))) (g-1 / 2 3 4)) 3/16)
+(test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) (* c 2))))) (g-1 (lambda (b c d) (+ b c d)) 2 3 5)) 15)
+(test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) (* c 2))))) (g-1 (lambda* (b (d 3) (e 0)) (+ b d e)) 2 1 3)) 9)
+(test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) (* c 2))))) (g-1 (macro (x y z) `(+ ,x ,y ,z)) 2 3 5)) 15)
+(test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) (* c 2))))) (g-1 (macro* (x (d 10) (e 0)) `(+ ,x ,d ,e)) 2 1 3)) 9)
+
+;;; -------- unknown_all_fp:
+(test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) (values c 2))))) (g-1 + 2 3 5)) 12)
+(test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) (values c 2))))) (g-1 / 2 3 4)) 3/16)
+(test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) (values c 2))))) (g-1 (lambda (b c d e) (+ b c d e)) 2 3 5)) 12)
+(test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) (values c 2))))) (g-1 (lambda* (b c (d 3) (e 0)) (+ b c d e)) 2 3 5)) 12)
+(test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) 2 (values c 2))))) (g-1 (macro (x y z w) `(+ ,x ,y ,z ,w)) 2 3 5)) 14)
+(test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) 2 (values c 2))))) (g-1 (macro* (x c (d 10) (e 0)) `(+ ,x ,c ,d ,e)) 2 1 3)) 10)
+
+(test (let (([] 3)) (+ [] 1)) 4)
+
+
+;;; --------------------------------------------------------------------------------
+;;; c-object?
+;;; c-object-type
+;;; c-pointer
+;;; c-pointer?
+;;; c-pointer->list
+;;; c-pointer-info
+;;; c-pointer-type
+;;; c-pointer-weak1|2
+
+(when with-block
+  (test (c-object? (block)) #t)
+  (test (integer? (c-object-type (block))) #t)
+  (test ((*s7* 'c-types) (c-object-type (block))) "<block>")) ; perhaps return block? instead?
+
+(test (c-pointer? 0) #f)
+(test (c-pointer? _null_) #t)
+(test (c-pointer->list (c-pointer 0 1 2)) '(0 1 2))
+(if with-block
+    (test (c-object? _c_obj_) #t)
+    (test (c-pointer? _c_obj_) #t))
+
+(for-each
+ (lambda (arg)
+   (test (c-pointer? arg) #f)
+   (test (c-object? arg) #f)
+   (test (c-object-type arg) 'error)
+   (test (c-pointer arg) 'error)
+   (test (c-pointer-info arg) 'error)
+   (test (c-pointer-type arg) 'error)
+   (test (c-pointer->list arg) 'error))
+ (list "hi" () (integer->char 65) #f #t 0+i '(1 2) _ht_ _undef_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(test (c-pointer?) 'error)
+(test (c-object?) 'error)
+(test (c-pointer? _c_obj_ 2 3) 'error)
+(test (c-object? _c_obj_ 2) 'error)
+(test (c-pointer 1 2 3 4 5 6) 'error)
+(test (c-pointer? (openlet (inlet 'c-pointer? (lambda (p) #t)))) #t)
+(test (c-pointer? (c-pointer 2 'integer?) 'integer?) #t)
+(test (c-pointer? (c-pointer 2 'integer?) 'symbol?) #f)
+
+(test (c-pointer->list (c-pointer 0)) '(0 #f #f))
+(test (c-pointer->list (c-pointer 123 'null?)) '(123 null? #f))
+(test (c-pointer-info (copy (c-pointer 1 2 3 4 5))) 3)
+(test (c-pointer-weak1 (copy (c-pointer 1 2 3 4 5))) 4)
+(test (c-pointer-weak2 (copy (c-pointer 1 2 3 4 5))) 5)
+
+(test (equal? (c-pointer 1) 1) #f)
+(test (equal? (c-pointer 1) (c-pointer 1)) #t)
+(test (equal? (c-pointer 1) (c-pointer 0)) #f)
+(test (equal? (c-pointer 1 (vector)) (c-pointer 1 (vector))) #t)
+(test (equal? (c-pointer 1 (vector)) (c-pointer 1 (vector 0))) #f)
+(test (equal? (c-pointer 1 vector? (vector)) (c-pointer 1 vector? (vector))) #t)
+(test (equal? (c-pointer 1 vector? (vector)) (c-pointer 1 vector? (vector 0))) #f)
+(test (equal? (c-pointer 1 +nan.0) (c-pointer 1 +nan.0)) #t) ; nan's are eq?
+(test (equivalent? (c-pointer 1) 1) #f)
+(test (equivalent? (c-pointer 1) (c-pointer 1)) #t)
+(test (equivalent? (c-pointer 1) (c-pointer 0)) #f)
+(test (equivalent? (c-pointer 1 (vector)) (c-pointer 1 (vector))) #t)
+(test (equivalent? (c-pointer 1 (vector)) (c-pointer 1 (vector 0))) #f)
+(test (equivalent? (c-pointer 1 vector? (vector)) (c-pointer 1 vector? (vector))) #t)
+(test (equivalent? (c-pointer 1 vector? (vector)) (c-pointer 1 vector? (vector 0))) #f)
+(test (equivalent? (c-pointer 1 +nan.0) (c-pointer 1 +nan.0)) #t)
+(test (equivalent? (c-pointer 1 +nan.0) (c-pointer 1 +inf.0)) #f)
+(test (equal? (copy (c-pointer 0 vector?)) (c-pointer 0 vector?)) #t)
+
+(test (object->string (c-pointer 1 (vector)) :readable) "(c-pointer 1 #() #f)")
+(test (object->string (c-pointer 1 (vector))) "#<c_pointer 0x1>") ; ??
+(test (object->string (copy (c-pointer 1 2 3 4 5)) :readable) "(c-pointer 1 2 3)") ; see s7.html, same for equal? and equivalent?
+
+(test (c-pointer-info) 'error)
+(test (c-pointer-info #f) 'error)
+(test (c-pointer-info (c-pointer 0)) #f)
+(test (c-pointer-info (c-pointer 0) #f) 'error)
+(test (c-pointer-info (c-pointer 0)) #f)
+(test (c-pointer-info (c-pointer 0 1 2)) 2)
+
+(test (c-pointer-type) 'error)
+(test (c-pointer-type #f) 'error)
+(test (c-pointer-type (c-pointer 0)) #f)
+(test (c-pointer-type (c-pointer 0) #f) 'error)
+(test (c-pointer-type (c-pointer 0)) #f)
+(test (c-pointer-type (c-pointer 0 1 2)) 1)
+
+(test (object->string (c-pointer 123123123 (symbol (make-string 130 #\a)))) "#<c_pointer 0x756b5b3>")
+
+(test (type-of (c-pointer-weak1 (c-pointer 1))) 'boolean?)
+(test (c-pointer-weak1 (copy (let ((<1> #f) (<2> (list #f (hash-table 'a 1 'c 3 'b 2) #f))) (set! <1> (c-pointer 1 <2> #f)) (set-car! <2> <1>) <1>))) #f)
+
+(when with-bignums
+  (test (c-pointer? (c-pointer (bignum "12341234"))) #t)
+  (test (c-pointer (bignum "1.4")) 'error))
+
+(let ((ptr (c-pointer 1 'abc (inlet 'object->string
+				  (lambda (obj . args)
+				    (let ((lt (object->let obj)))
+				      (format #f "I am pointer ~A of type '~A!"
+					      (lt 'pointer)
+					      (lt 'c-type))))))))
+  (openlet ptr)
+  (test (object->string ptr) "I am pointer 1 of type 'abc!"))
+
+(test (openlet (c-pointer #b101 (setter car) (rootlet))) 'error)
+(test (abs (openlet (c-pointer 3 'asdf (inlet 'abs (lambda (val) 12))))) 12)
+(test (with-let (c-pointer 3 'asdf (openlet (inlet 'abs (lambda (val) 12)))) (abs 32)) 12)
+(test (with-let (c-pointer 3 'asdf (openlet (sublet (inlet) 'let-ref-fallback (lambda (lt sym) 12)))) asdf) 12)
+
+
+;;; --------------------------------------------------------------------------------
+;;; type-of
+
+(test (type-of) 'error)
+(test (type-of 1 2) 'error)
+(test (type-of #f) 'boolean?)
+(test (type-of ()) 'null?)
+(test (type-of (list 1)) 'pair?)
+(test (type-of 1) 'integer?)
+(test (type-of 1/2) 'rational?)
+(test (type-of 1.0) 'float?)
+(test (type-of 1+i) 'complex?)
+(test (type-of #<unspecified>) 'unspecified?)
+(test (type-of (values)) 'unspecified?)
+(test (type-of #<undefined>) 'undefined?)
+(test (type-of _undef_) 'undefined?)
+(test (type-of #<eof>) 'eof-object?)
+(test (type-of (hash-table)) 'hash-table?)
+(test (type-of (weak-hash-table)) 'hash-table?)
+(test (type-of #(1)) 'vector?)
+(test (type-of #r(1.0)) 'float-vector?)
+(test (type-of #i(1)) 'int-vector?)
+(test (type-of (byte-vector 1 2)) 'byte-vector?)
+(test (type-of "") 'string?)
+(test (type-of #\a) 'char?)
+(test (type-of 'a) 'symbol?)
+(test (type-of :a) 'symbol?)
+(test (type-of (gensym)) 'symbol?)
+(test (type-of (inlet 'a 1)) 'let?)
+(test (type-of *stderr*) 'output-port?)
+(test (type-of *stdin*) 'input-port?)
+(test (type-of abs) 'procedure?)
+(test (type-of +) 'procedure?)
+(test (type-of (lambda () 1)) 'procedure?)
+(test (type-of (lambda* ((a 1)) a)) 'procedure?)
+(test (type-of quasiquote) 'macro?)
+(test (type-of (define-bacro (_b_ x) `(+ ,x 1))) 'macro?) ; bacro? undefined
+(test (type-of (c-pointer 0)) 'c-pointer?)
+(test (type-of (random-state 123)) 'random-state?)
+(test (type-of lambda) 'syntax?)
+(test (type-of (call-with-exit (lambda (g) g))) 'goto?)
+(test (type-of (call/cc (lambda (g) g))) 'continuation?)
+(test (type-of (make-iterator '(1 2))) 'iterator?)
+(when with-block
+  (test (type-of (block)) 'c-object?))
+
+(let ()
+  (define (remove obj seq) ; remove-all?
+    (case (type-of seq)
+
+      ((pair?)
+       (if (proper-list? seq)
+	   (let loop ((lst seq) (res ()))
+	     (if (null? lst)
+		 (reverse! res)
+		 (loop (cdr lst)
+		       (if (equal? obj (car lst))
+			   res
+			   (cons (car lst) res)))))
+	   seq))
+
+      ((string? vector? float-vector? int-vector? byte-vector?)
+       (let ((len (length seq)))
+	 (if (zero? len)
+	     seq
+	     (do ((v (copy seq))
+		  (j -1)
+		  (i 0 (+ i 1)))
+		 ((= i len)
+		  (if (string? seq)
+		      (copy v (make-string (+ j 1)))
+		      (if (byte-vector? seq)
+			  (copy v (make-byte-vector (+ j 1)))
+			  (subvector v 0 (+ j 1)))))
+	       (if (not (equal? obj (seq i)))
+		   (set! (v (set! j (+ j 1))) (seq i)))))))
+
+      ((hash-table?)
+       (let ((ht (copy seq)))
+	 (hash-table-set! ht obj #f)
+	 ht))
+
+      ((let?)
+       (let ((lt (copy seq)))
+	 (if (and (openlet? lt)
+		  (let-ref lt 'remove))
+	     ((let-ref lt 'remove) obj lt)
+	     (cutlet lt obj))
+	 lt))
+
+      (else seq)))
+
+  (test (remove #\a "abcdabcd") "bcdbcd")
+  (test (remove 1 (vector 0 1 2 1 1)) #(0 2))
+  (test (remove 1 (vector 1)) #())
+  (test (remove 1 (byte-vector 0 1 2 1 1)) #u(0 2))
+  (test (remove 1 (int-vector 1 2 1 3 4 1 5)) #i(2 3 4 5))
+  (test (remove 1.0 (float-vector 1.0 3.0 1.0)) #r(3.0))
+  (test (remove 1 '(1 2 3 4 1)) '(2 3 4))
+  (test (remove 'a (hash-table 'a 1 'b 2)) (hash-table 'b 2))
+  (test (remove 'a (inlet 'a 1 'b 2)) (inlet 'b 2))
+  (let ((lt1 (remove 'a (openlet (inlet 'a 1 'b 2
+					'remove (lambda (obj lt)
+						  (set! (lt 'b) 3)
+						  (cutlet lt obj)))))))
+    (test (lt1 'b) 3))
+  (test (remove 1 (vector)) #())
+
+  (define (hi)
+    (let ((v (byte-vector 1 2 3))
+	  (sv (make-vector 3)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) sv)
+	(set! (sv i) (v i)))))
+  (test (hi) #(1 2 3))
+
+  (define (hi)
+    (let ((v (byte-vector 1 2 3))
+	  (sv (make-byte-vector 3)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) sv)
+	(set! (sv i) (v i)))))
+  (test (hi) #u(1 2 3)))
+
+(let ()
+  (define (the type expr)
+    (if (eq? type (symbol->value (type-of expr)))
+	expr
+	(error 'bad-type "~S is ~S but should be ~S in (the ~S ~S)" expr (type-of expr) type type expr)))
+  (test (+ 1 (the integer? 3)) 4)
+  (test (+ 1 (the integer? 3.0)) 'error))
+
+
+;;; --------------------------------------------------------------------------------
+;;; boolean?
+
+(test (boolean? #f) #t)
+(test (boolean? #t) #t)
+(test (boolean? 0) #f)
+(test (boolean? 1) #f)
+(test (boolean? "") #f)
+(test (boolean? #\0) #f)
+(test (boolean? ()) #f)
+(test (boolean? #()) #f)
+(test (boolean? 't) #f)
+(test (boolean? (list)) #f)
+(test ( boolean? #t) #t)
+(test (boolean? boolean?) #f)
+(test (boolean? or) #f)
+(test (   ; a comment
+       boolean?  ;;; and another
+       #t
+       )
+      #t)
+
+(for-each
+ (lambda (arg)
+   (if (boolean? arg)
+       (format #t ";(boolean? ~A) -> #t?~%" arg)))
+ (list "hi" '(1 2) (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi (if #f #f) #<eof> #<undefined>))
+
+(test (recompose 12 boolean? #f) #t)
+
+(test (boolean?) 'error)
+(test (boolean? #f #t) 'error)
+(test (boolean #f) 'error)
+(test (boolean? (lambda (x) #f)) #f)
+(test (boolean? and) #f)
+(test (boolean? if) #f)
+(test (boolean? (values)) #f)
+;(test (boolean? else) #f) ; this could also be an error -> unbound variable, like (symbol? else)
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; not
+
+(test (not #f) #t)
+(test (not #t) #f)
+(test (not (not #t)) #t)
+(test (not 0) #f)
+(test (not 1) #f)
+(test (not ()) #f)
+(test (not 't) #f)
+(test (not (list)) #f)
+(test (not (list 3)) #f)
+(test (not 'nil) #f)
+(test (not not) #f)
+(test (not "") #f)
+(test (not lambda) #f)
+(test (not quote) #f)
+
+(for-each
+ (lambda (arg)
+   (if (not arg)
+       (format #t ";(not ~A) -> #t?~%" arg)))
+ (list "hi" (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi #<eof> #<undefined> (if #f #f)))
+
+(test (recompose 12 not #f) #f)
+
+(test (not) 'error)
+(test (not #f #t) 'error)
+(test (not and) #f)
+(test (not case) #f)
+
+(let () ; check some optimizer branches
+  (define (f1 sym) (not (symbol? sym))) (test (f1 'hi) #f) (test (f1 "hi") #t)
+  (define (f2 sym) (not (integer? sym))) (test (f2 2) #f) (test (f2 'hi) #t)
+  (define (f3 sym) (not (char? sym))) (test (f3 2) #t) (test (f3 #\a) #f)
+  (define (f4 sym) (not (list? sym))) (test (f4 2) #t) (test (f4 '(1 2 3)) #f)
+  (define (f5 sym) (not (boolean? sym))) (test (f5 2) #t) (test (f5 #f) #f)
+  (define (f6 sym) (not (eof-object? sym))) (test (f6 2) #t) (test (f6 #<eof>) #f)
+  (define (f7 sym) (not (pair? (car sym)))) (test (f7 '(hi)) #t) (test (f7 '((1))) #f)
+  (define (f8 sym) (not (eq? sym 'q))) (test (f8 'a) #t) (test (f8 'q) #f)
+  (define (f9 sym) (pair? (cadr sym))) (test (f9 '(1 2 3)) #f) (test (f9 '(1 (2 3) 4)) #t)
+  (define (f10 lst val) (eq? (car lst) val)) (test (f10 '(#f) #f) #t) (test (f10 '(a) 32) #f)
+  (define (f11 lst) (eq? (caar lst) 'q)) (test (f11 '((a))) #f) (test (f11 '((q))) #t)
+  (define (f12 lst) (= (length lst) 2)) (test (f12 '(1 2)) #t) (test (f12 '(1 2 3)) #f)
+  (define (f13 lst) (< (length lst) 2)) (test (f13 '(1 2)) #f) (test (f13 '(1)) #t)
+  (define (f14 lst) (negative? (length lst))) (test (f14 '(1 2)) #f) (test (f14 '(1 . 3)) #t)
+  (define (f15 lst) (memq (car lst) '(a b c))) (test (f15 '(a)) '(a b c)) (test (f15 '(d)) #f)
+  (define (f16 a b) (if a (begin (+ b a) (format #f "~A" a) (+ a a)))) (test (f16 1 2) 2)
+  (define (f17 a) (aritable? a 1)) (test (f17 abs) #t)
+  (define (f22) (begin (display ":") (display (object->string 2)) (display ":"))) (test (with-output-to-string (lambda () (f22))) ":2:")
+  (define (f23 a b) (list a b))
+  (define (f24 x y) (f23 (car x) (car y)))
+  (define (f25 x y) (f23 (cdr x) (cdr y)))
+  (test (f24 '(1 2) '(3 4)) '(1 3)) (test (f25 '(1 2) '(3 4)) '((2) (4)))
+  (define (f24a s1 s2 s3) (+ (* s1 s2) (* (- 1.0 s1) s3))) (test (f24a 2.0 3.0 4.0) 2.0)
+  (let () (define (a b) (define c 1) (+ b c)) (define (tst) (a 2)) (tst) (test (tst) 3))
+  (define (f25)
+    (let ((x 0.0) (y 1.0))
+      (call-with-exit
+       (lambda (return)
+	 (do ((i y (+ i 1))) ((= i 6))
+	   (do ((i i (+ i 1))) ((>= i 7))
+	     (set! x (+ x i))
+	     (if (> x 123.0) (return x))))))
+      x))
+  (test (f25) 85.0)
+  )
+(let ()
+  (test (let () (define (ho a) (+ a 2)) (define (hi) (+ (ho 1) (ho 2))) (hi)) 7)
+  (test (let () (define (ho a) (+ a 2)) (define (hi) (+ (ho 1) (values 3 4))) (hi)) 10)
+  (test (let () (define (ho a) (+ a 2)) (define (hi) (+ (values 3 4) (ho 1))) (hi)) 10)
+  (test (let () (define (hi) (+ (values 1 2) (values 3 4))) (hi)) 10)
+  (test (let () (define (ho a) (values a 1)) (define (hi) (- (ho 2))) (hi)) 1)
+  (test (let () (define (ho1) (*s7* 'version)) (define (ho2) (ho1)) (string? (ho2))) #t)
+  (test (let () (define (hi) (vector 0)) (define (ho) (hi)) (ho)) #(0)))
+(let ()
+  (define (make-it . names) (apply vector names))
+  (define (hi) (make-it pi pi pi pi))
+  (test (hi) (vector pi pi pi pi)))
+(test (let () (define (hi a b c d) (+ a (* (- b c) d))) (define (ho) (hi 1 2 3 4)) (ho)) -3)
+(test (let () (define (hi a b c d) (+ a (* d (- b c)))) (define (ho) (hi 1 2 3 4)) (ho)) -3)
+(test (let () (define (hi) (let ((x (values 1 2))) (if x (list x)))) (define (ho) (hi)) (catch #t (lambda () (ho)) (lambda args #f)) (ho)) 'error) ; let_one_p_new
+(test (let () (define (hi) (let ((x (values 1 2))) (display x) (if x (list x)))) (define (ho) (hi)) (catch #t (lambda () (ho)) (lambda args #f)) (ho)) 'error) ; let_one_new
+(test (let () (define (hi a b) (- (+ a (abs b)))) (define (ho) (hi 1 -2)) (ho)) -3)
+
+(let () (define (e1) (((lambda () list)) 'a 'b 'c)) (define (e2) (e1)) (e2) (test (e2) '(a b c)))
+(let () (define (c1 s i) (case (string-ref s i) ((#\a) 1) (else 2))) (define (c3 s i) (c1 s i)) (c3 "hiho" 1) (test (c3 "hiho" 1) 2))
+(let () (define (c1 s i) (case (string-ref s i) ((#\a) 1) ((#\i) 2))) (define (c3 s i) (c1 s i)) (c3 "hiho" 1) (test (c3 "hiho" 1) 2))
+(let () (define (c1 s i) (case (string-ref s i) ((#\a #\h) 1) ((#\i #\o) 2))) (define (c3 s i) (c1 s i)) (c3 "hiho" 1) (test (c3 "hiho" 1) 2))
+(let () (define (c1 s i) (case (string-ref s i) ((#\a #\h) 1) (else 2))) (define (c3 s i) (c1 s i)) (c3 "hiho" 1) (test (c3 "hiho" 1) 2))
+(let () (define (d1) (do ((lst () (cons i lst)) (i 0 (+ i 1))) ((> i 6) (reverse lst)))) (define (d2) (d1)) (d2) (test (d2) '(0 1 2 3 4 5 6)))
+(let () (define (d3) ((define (hi a) (+ a 1)) 2)) (define (d4) (d3)) (d4) (test (d4) 3))
+(let () (define (fif) (if (< 2 3) (quote . -1))) (catch #t fif (lambda args 'error)) (test (catch #t fif (lambda args 'error)) 'error))
+;(let () (define (fcond) (cond ((< 2 3) ((lambda (x) x 1 . 5) 2)))) (catch #t fcond (lambda args 'error)) (test (fcond) 'error))
+;(let () (define (fcond1) (cond ((< 2 3) ((lambda* (x) x . 5) 2)))) (catch #t fcond1 (lambda args 'error)) (test (fcond1) 'error))
+; those aren't what they appear to be: the catch does the stray dot check/error, then a call simply does what it can
+(let () (define (incsaa k i) (let ((sum 1)) (set! sum (+ sum (expt k i) (expt (- k) i))) sum)) (define (f1) (incsaa 3 2)) (test (f1) 19))
+(let () (define (unks v1 i) (let ((x 0)) (set! x (v1 i)) x)) (define (f1) (unks (vector 1 2 3) 2)) (test (f1) 3))
+
+(test (let () (define (func) (catch #t (lambda () (when (not abs cond) #f)) (lambda args 'err))) (define (hi) (func) (func)) (hi) (hi)) 'err) ; set_if_opts
+
+
+;;; --------------------------------------------------------------------------------
+;;; symbol?
+
+(test (symbol? 't) #t)
+(test (symbol? "t") #f)
+(test (symbol? '(t)) #f)
+(test (symbol? #t) #f)
+(test (symbol? 4) #f)
+(test (symbol? 'foo) #t)
+(test (symbol? (car '(a b))) #t)
+(test (symbol? 'nil) #t)
+(test (symbol? ()) #f)
+(test (symbol? #()) #f)
+(test (symbol? #f) #f)
+(test (symbol? 'car) #t)
+(test (symbol? car) #f)
+(test (symbol? '#f) #f)
+(test (symbol? #()) #f)
+(test (symbol? :hi) #t)
+(test (symbol? hi:) #t)
+(test (symbol? :hi:) #t)
+(test (symbol? '::) #t)
+(test (symbol? ':) #t)
+(test (symbol? '|) #t)
+(test (symbol? '|') #t)
+(test (symbol? '@) #t)
+;(test (symbol? '#:) #t) ; confusable given guile-style keywords
+(test (symbol? #b1) #f)
+(test (symbol? 'sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789) #t) ;M Gran
+(test (symbol? (vector-ref #(1 a 34) 1)) #t)
+(test (if (symbol? '1+) (symbol? '0e) #t) #t)
+(test (symbol? 'begin) #t)
+(test (symbol? 'if) #t)
+(test (symbol? (keyword->symbol :if)) #t)
+(test (symbol? (string->symbol "if")) #t)
+(test (symbol? if) #f)
+(test (symbol? quote) #f)
+(test (symbol? '(AB\c () xyz)) #f)
+(test (symbol? '.i) #t)
+
+(for-each
+ (lambda (arg)
+   (if (symbol? arg)
+       (format #t ";(symbol? ~A) -> #t?~%" arg)))
+ (list "hi" (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) #<eof> #<undefined>))
+
+(test (symbol?) 'error)
+(test (symbol? 'hi 'ho) 'error)
+(test (symbol? 'hi 3) 'error)
+(test (symbol? 3 3) 'error)
+(test (symbol? 3 'hi) 'error)
+(test (symbol 'hi) 'error) ; symbol takes a string
+
+;;; "Returns #t if obj is a symbol, otherwise returns #f" (r5|6rs.html)
+(test (symbol? begin) #f) ; this is an error in Guile, it was #t in s7
+(test (symbol? expt) #f)
+(test (symbol? if) #f)
+(test (symbol? and) #f)
+(test (symbol? lambda) #f)
+(test (symbol? 'let) #t)
+(test (symbol? call/cc) #f)
+(test (symbol? '1.2.3) #t)
+(test (symbol? '1.2) #f)
+(test (symbol? ''1.2) #f)
+(test (symbol? '"hi") #f)
+
+(test (let ((sym000000000000000000000 3))
+	(let ((sym000000000000000000001 4))
+	  (+ sym000000000000000000000 sym000000000000000000001)))
+      7)
+(test (let ((11-1 10)
+	    (2012-4-19 21)
+	    (1+the-road 18)
+	    (-1+2 1)
+	    (1e. 2)
+	    (0+i' 3)
+	    (0.. 4))
+	(+ 11-1 2012-4-19 1+the-road -1+2 1e. 0+i' 0..))
+      59)
+
+(test (let ((name "hiho"))
+	(string-set! name 2 #\null)
+	(symbol? (string->symbol name)))
+      #t)
+
+
+;;; syntax?
+(test (syntax? 'lambda) #f)
+(test (syntax? lambda) #t)
+(test (syntax? if) #t)
+(test (syntax? macroexpand) #t)
+(test (syntax? 1) #f)
+(for-each
+ (lambda (arg)
+   (if (syntax? arg)
+       (format #t ";(syntax? ~A) -> #t?~%" arg)))
+ (list "hi" (integer->char 65) (list 1 2) '#t '3 (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) #<eof> #<undefined>))
+(test (syntax?) 'error)
+(test (syntax? 'hi 'ho) 'error)
+(test (syntax? 'hi 3) 'error)
+(test (syntax? 3 3) 'error)
+(test (syntax? 3 'hi) 'error)
+(test (syntax? 'else) #f)
+(test (syntax? '=>) #f)
+(test (syntax? else) #f)
+(let ()
+  (define (syntactic x)
+    (if x (case x ((1) 1) (else 2))))
+  (syntactic 1)
+  (let ((source (procedure-source syntactic)))
+    (test (syntax? (car source)) #f))) ; 'lambda from (lambda (x) (if x (case x ((1) 1) (else 2))))
+
+(for-each
+  (lambda (x)
+    (test (syntax? x) #t))
+  (list define with-baffle define-bacro letrec* unless define-macro* let-temporarily lambda define-macro define* let* macroexpand when bacro macro lambda* cond bacro* macro* set! letrec with-let if define-constant do or case define-expansion* define-expansion define-bacro* let begin quote and))
+
+(for-each
+  (lambda (x)
+    (test (syntax? x) #f))
+  '(define with-baffle define-bacro letrec* unless define-macro* let-temporarily lambda define-macro define* let* macroexpand when bacro macro lambda* cond bacro* macro* set! letrec with-let if define-constant do or case define-expansion* define-expansion define-bacro* let begin quote and))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; procedure?
+
+(test (procedure? car) #t)
+(test (procedure? procedure?) #t)
+(test (procedure? 'car) #f)
+(test (procedure? (lambda (x) x)) #t)
+(test (procedure? '(lambda (x) x)) #f)
+(test (call/cc procedure?) #t)
+(test (let ((a (lambda (x) x)))	(procedure? a)) #t)
+(test (letrec ((a (lambda () (procedure? a)))) (a)) #t)
+(test (let ((a 1)) (let ((a (lambda () (procedure? a)))) (a))) #f)
+(test (let () (define (hi) 1) (procedure? hi)) #t)
+(test (let () (define-macro (hi a) `(+ ,a 1)) (procedure? hi)) #f)
+(test (procedure? begin) #f)
+(test (procedure? lambda) #f)
+(test (procedure? (lambda* ((a 1)) a)) #t)
+(test (procedure? and) #f)
+(test (procedure? 'let) #f)
+(test (procedure? (dilambda (lambda () 1) (lambda (x) x))) #t)
+(if with-bignums (test (procedure? (bignum "1e100")) #f))
+(test (procedure? quasiquote) #f)
+(let () (define-macro (hi a) `(+ ,a 1)) (test (procedure? hi) #f))
+(test (procedure? (random-state 1234)) #f)
+(test (procedure? pi) #f)
+(test (procedure? cond) #f)
+(test (procedure? do) #f)
+(test (procedure? set!) #f)
+
+(for-each
+ (lambda (arg)
+   (if (procedure? arg)
+       (format #t ";(procedure? ~A) -> #t?~%" arg)))
+ (list "hi" _ht_ _undef_ _null_ :hi (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f #() (if #f #f)))
+
+(test (procedure?) 'error)
+(test (procedure? abs car) 'error)
+(test (procedure abs) 'error)
+
+;; these are questionable -- an applicable object is a procedure(?)
+(test (procedure? "hi") #f)
+(test (procedure? '(1 2)) #f)
+(test (procedure? #(1 2)) #f)
+(when with-block (test (procedure? (block)) #t))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; CHARACTERS
+;;; --------------------------------------------------------------------------------
+
+(test (eqv? '#\  #\space) #t)
+(test (eqv? #\newline '#\newline) #t)
+
+;;; --------------------------------------------------------------------------------
+;;; char?
+
+(test (char? #\a) #t)
+(test (char? #\() #t)
+(test (char? #\space) #t)
+(test (char? '#\newline) #t)
+(test (char? #\1) #t)
+(test (char? #\$) #t)
+(test (char? #\.) #t)
+(test (char? #\\) #t)
+(test (char? #\)) #t)
+(test (char? #\%) #t)
+(test (char? '#\space) #t)
+(test (char? '#\ ) #t)
+(test (char? '#\newline) #t)
+(test (char? '#\a) #t)
+(test (char? '#\8) #t)
+(test (char? #\-) #t)
+(test (char? #\n) #t)
+(test (char? #\() #t)
+(test (char? #\#) #t)
+(test (char? #\x) #t)
+(test (char? #\o) #t)
+(test (char? #\b) #t)
+(test (char? #b101) #f)
+(test (char? #o73) #f)
+(test (char? #x73) #f)
+(test (char? 'a) #f)
+(test (char? 97) #f)
+(test (char? "a") #f)
+(test (char? (string-ref "hi" 0)) #t)
+(test (char? (string-ref (make-string 1) 0)) #t)
+(test (char? #\") #t)
+(test (char? #\') #t)
+(test (char? #\`) #t)
+(test (char? #\@) #t)
+(test (char? #<eof>) #f)
+(test (char? '1e311) #f)
+
+(for-each
+ (lambda (arg)
+   (if (char? arg)
+       (format #t ";(char? ~A) -> #t?~%" arg)))
+ (list "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #f #t (if #f #f) :hi (lambda (a) (+ a 1))))
+
+(test (char? begin) #f)
+
+(do ((i 0 (+ i 1)))
+    ((= i 256))
+  (if (not (char? (integer->char i)))
+      (format #t ";(char? (integer->char ~A)) -> #f?~%" i)))
+
+(test (char?) 'error)
+(test (char? #\a #\b) 'error)
+(test (char #\a) 'error)
+
+(test (char? #\x65) #t)
+(test (char? #\x000000000065) #t)
+(test (char? #\x0) #t)
+(test (char=? #\x000 #\null) #t)
+(test (char=? #\x08 #\x8) #t)
+(test (char=? #\x0e #\xe) #t) ; Guile thinks both of these names are bogus
+(test (char=? #\x00e #\xe) #t)
+(test (char=? #\x0000e #\xe) #t)
+(test (char=? #\x00000000e #\xe) #t) ; hmmm -- surely this is a bug
+(test (char? #\xff) #t)
+;; any larger number is a reader error
+
+;(test (eval-string "(char? #\xbdca2cbec)") 'error) ; needs 2 \\
+(test (eval-string "(char? #\\xbdca2cbec)") #f)
+(test (eval-string "(char? #\\100)") #f)
+(test (eval-string "(char? #\\x-65)") #f)
+(test (eval-string "(char? #\\x6.5)") #f)
+(test (eval-string "(char? #\\x6/5)") #f)
+(test (eval-string "(char? #\\x6/3)") #f)
+(test (eval-string "(char? #\\x6+i)") #f)
+(test (eval-string "(char? #\\x6asd)") #f)
+(test (eval-string "(char? #\\x6#)") #f)
+(test (eval-string "(char? #\\x#b0)") #f)
+(test (eval-string "(char? #\\x#b0") 'error) ; missing )
+(test (eval-string "(char? #\\x-0)") #f)
+(test (eval-string "(char? #\\x1.4)") #f)
+(test (eval-string "(char? #\\x#b0)") #f)
+(test (eval-string "(char? #\\x-0)") #f)
+(test (eval-string "(char? #\\x1.4)") #f)
+
+(test (char=? #\x6a #\j) #t)
+
+(test (char? #\return) #t)
+(test (char? #\null) #t)
+(test (char? #\nul) #t)
+(test (char? #\linefeed) #t)
+(test (char? #\tab) #t)
+(test (char? #\space) #t)
+(test (char=? #\null #\nul) #t)
+(test (char=? #\newline #\linefeed) #t)
+(test (char=? #\return #\xd) #t)
+(test (char=? #\nul #\x0) #t)
+;(test (char? #\ÿ) #t) ; this seems to involve unwanted translations in emacs?
+(test (eval-string (string-append "(char? " (format #f "#\\~C" (integer->char 255)) ")")) #t)
+(test (eval-string (string-append "(char? " (format #f "#\\~C" (integer->char 127)) ")")) #t)
+(test (apply char? (list (integer->char 255))) #t)
+
+(test (char? #\escape) #t)
+(test (char? #\alarm) #t)
+(test (char? #\backspace) #t)
+(test (char? #\delete) #t)
+(test (char=? #\delete #\backspace) #f)
+
+(num-test (let ((str (make-string 258 #\space)))
+	    (do ((i 1 (+ i 1)))
+		((= i 256))
+	      (string-set! str i (integer->char i)))
+	    (string-set! str 257 (integer->char 0))
+	    (string-length str))
+	  258)
+
+
+(let ((a-to-z (list #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\x #\y #\z))
+      (cap-a-to-z (list #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\X #\Y #\Z))
+      (mixed-a-to-z (list #\a #\B #\c #\D #\e #\F #\g #\H #\I #\j #\K #\L #\m #\n #\O #\p #\Q #\R #\s #\t #\U #\v #\X #\y #\Z))
+      (digits (list #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)))
+
+;;; --------------------------------------------------------------------------------
+;;; char-upper-case?
+
+  (test (char-upper-case? #\a) #f)
+  (test (char-upper-case? #\A) #t)
+
+  (for-each
+   (lambda (arg)
+     (if (not (char-upper-case? arg))
+	 (format #t ";(char-upper-case? ~A) -> #f?~%" arg)))
+   cap-a-to-z)
+
+  (for-each
+   (lambda (arg)
+     (if (char-upper-case? arg)
+	 (format #t ";(char-upper-case? ~A) -> #t?~%" arg)))
+   a-to-z)
+
+  (test (char-upper-case? (integer->char 192)) #t) ; 192..208 for unicode
+  ;; non-alpha chars are "unspecified" here
+
+  (test (char-upper-case? 1) 'error)
+  (test (char-upper-case?) 'error)
+  (test (char-upper-case? 1) 'error)
+  (test (char-upper-case?) 'error)
+  (test (char-upper-case? #\a #\b) 'error)
+  (test (char-upper-case #\a) 'error)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; char-lower-case?
+
+  (test (char-lower-case? #\A) #f)
+  (test (char-lower-case? #\a) #t)
+
+  (for-each
+   (lambda (arg)
+     (if (not (char-lower-case? arg))
+	 (format #t ";(char-lower-case? ~A) -> #f?~%" arg)))
+   a-to-z)
+
+  (for-each
+   (lambda (arg)
+     (if (char-lower-case? arg)
+	 (format #t ";(char-lower-case? ~A) -> #t?~%" arg)))
+   cap-a-to-z)
+
+  (test (char-lower-case? 1) 'error)
+  (test (char-lower-case?) 'error)
+  (test (char-lower-case? 1) 'error)
+  (test (char-lower-case?) 'error)
+  (test (char-lower-case? #\a #\b) 'error)
+  (test (char-lower-case #\a) 'error)
+
+;;  (test (char-lower-case? #\xb5) #t)  ; what is this?  in Snd it's #t, in ex1 it's #f -- is this a locale choice?
+  (test (char-lower-case? #\xb6) #f)
+
+  (for-each
+   (lambda (c)
+     (test (and (not (char-upper-case? c))
+		(not (char-lower-case? c))) #t))
+   (map integer->char (list 0 1 2 3 32 33 34 170 182 247)))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; char-upcase
+
+  (test (char-upcase #\A) #\A)
+  (test (char-upcase #\a) #\A)
+  (test (char-upcase #\?) #\?)
+  (test (char-upcase #\$) #\$)
+  (test (char-upcase #\.) #\.)
+  (test (char-upcase #\\) #\\)
+  (test (char-upcase #\5) #\5)
+  (test (char-upcase #\)) #\))
+  (test (char-upcase #\%) #\%)
+  (test (char-upcase #\0) #\0)
+  (test (char-upcase #\_) #\_)
+  (test (char-upcase #\?) #\?)
+  (test (char-upcase #\space) #\space)
+  (test (char-upcase #\newline) #\newline)
+  (test (char-upcase #\null) #\null)
+  (test (char-upper-case? (char-upcase #\?)) #f) ; !
+  (test (char-lower-case? (char-downcase #\?)) #f)
+  (test (char-upper-case? (char-upcase #\_)) #f)
+  (test (or (char-upper-case? #\?) (char-lower-case? #\?)) #f)
+
+  (for-each
+   (lambda (arg1 arg2)
+     (if (not (char=? (char-upcase arg1) arg2))
+	 (format #t ";(char-upcase ~A) != ~A?~%" arg1 arg2)))
+   a-to-z
+   cap-a-to-z)
+
+  (do ((i 1 (+ i 1)))
+      ((= i 256))
+    (if (and (not (char=? (integer->char i) (char-upcase (integer->char i))))
+	     (not (char-alphabetic? (integer->char i))))
+	(format #t ";(char-upcase ~A) -> ~A but not alphabetic?~%" (integer->char i) (char-upcase (integer->char i)))))
+
+  (test (recompose 12 char-upcase #\a) #\A)
+  (test (reinvert 12 char-upcase char-downcase #\a) #\a)
+
+  (test (char-upcase) 'error)
+  (test (char-upcase #\a #\b) 'error)
+  (test (char-upcase #<eof>) 'error)
+  (test (char-upcase #f) 'error)
+  (test (char-upcase (list)) 'error)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; char-downcase
+
+  (test (char-downcase #\A) #\a)
+  (test (char-downcase #\a) #\a)
+  (test (char-downcase #\?) #\?)
+  (test (char-downcase #\$) #\$)
+  (test (char-downcase #\.) #\.)
+  (test (char-downcase #\_) #\_)
+  (test (char-downcase #\\) #\\)
+  (test (char-downcase #\5) #\5)
+  (test (char-downcase #\)) #\))
+  (test (char-downcase #\%) #\%)
+  (test (char-downcase #\0) #\0)
+  (test (char-downcase #\space) #\space)
+
+  (for-each
+   (lambda (arg1 arg2)
+     (if (not (char=? (char-downcase arg1) arg2))
+	 (format #t ";(char-downcase ~A) != ~A?~%" arg1 arg2)))
+   cap-a-to-z
+   a-to-z)
+
+  (test (recompose 12 char-downcase #\A) #\a)
+
+  (test (char-downcase) 'error)
+  (test (char-downcase #\a #\b) 'error)
+
+
+;;; --------------------------------------------------------------------------------
+;;; char-numeric?
+
+  (test (char-numeric? #\a) #f)
+  (test (char-numeric? #\5) #t)
+  (test (char-numeric? #\A) #f)
+  (test (char-numeric? #\z) #f)
+  (test (char-numeric? #\Z) #f)
+  (test (char-numeric? #\0) #t)
+  (test (char-numeric? #\9) #t)
+  (test (char-numeric? #\space) #f)
+  (test (char-numeric? #\;) #f)
+  (test (char-numeric? #\.) #f)
+  (test (char-numeric? #\-) #f)
+  (test (char-numeric? (integer->char 200)) #f)
+  (test (char-numeric? (integer->char 128)) #f)
+  (test (char-numeric? (integer->char 216)) #f) ; 0 slash
+  (test (char-numeric? (integer->char 189)) #f) ; 1/2
+
+  (for-each
+   (lambda (arg)
+     (if (char-numeric? arg)
+	 (format #t ";(char-numeric? ~A) -> #t?~%" arg)))
+   cap-a-to-z)
+
+  (for-each
+   (lambda (arg)
+     (if (char-numeric? arg)
+	 (format #t ";(char-numeric? ~A) -> #t?~%" arg)))
+   a-to-z)
+
+  (test (char-numeric?) 'error)
+  (test (char-numeric? #\a #\b) 'error)
+
+
+;;; --------------------------------------------------------------------------------
+;;; char-whitespace?
+
+  (test (char-whitespace? #\a) #f)
+  (test (char-whitespace? #\A) #f)
+  (test (char-whitespace? #\z) #f)
+  (test (char-whitespace? #\Z) #f)
+  (test (char-whitespace? #\0) #f)
+  (test (char-whitespace? #\9) #f)
+  (test (char-whitespace? #\space) #t)
+  (test (char-whitespace? #\tab) #t)
+  (test (char-whitespace? #\newline) #t)
+  (test (char-whitespace? #\return) #t)
+  (test (char-whitespace? #\linefeed) #t)
+  (test (char-whitespace? #\null) #f)
+  (test (char-whitespace? #\;) #f)
+  (test (char-whitespace? #\xb) #t)
+  (test (char-whitespace? #\x0b) #t)
+  (test (char-whitespace? #\xc) #t)
+  (test (char-whitespace? #\xd) #t) ; #\return
+  (test (char-whitespace? #\xe) #f)
+
+  ;; unicode whitespace apparently:
+  (test (char-whitespace? (integer->char 9)) #t)
+  (test (char-whitespace? (integer->char 10)) #t)
+  (test (char-whitespace? (integer->char 11)) #t)
+  (test (char-whitespace? (integer->char 12)) #t)
+  (test (char-whitespace? (integer->char 13)) #t)
+  (test (char-whitespace? (integer->char 32)) #t)
+  (test (char-whitespace? (integer->char 133)) #t)
+  (test (char-whitespace? (integer->char 160)) #t)
+
+  (for-each
+   (lambda (arg)
+     (if (char-whitespace? arg)
+	 (format #t ";(char-whitespace? ~A) -> #t?~%" arg)))
+   mixed-a-to-z)
+
+  (for-each
+   (lambda (arg)
+     (if (char-whitespace? arg)
+	 (format #t ";(char-whitespace? ~A) -> #t?~%" arg)))
+   digits)
+
+  (test (char-whitespace?) 'error)
+  (test (char-whitespace? #\a #\b) 'error)
+
+
+;;; --------------------------------------------------------------------------------
+;;; char-alphabetic?
+
+  (test (char-alphabetic? #\a) #t)
+  (test (char-alphabetic? #\$) #f)
+  (test (char-alphabetic? #\A) #t)
+  (test (char-alphabetic? #\z) #t)
+  (test (char-alphabetic? #\Z) #t)
+  (test (char-alphabetic? #\0) #f)
+  (test (char-alphabetic? #\9) #f)
+  (test (char-alphabetic? #\space) #f)
+  (test (char-alphabetic? #\;) #f)
+  (test (char-alphabetic? #\.) #f)
+  (test (char-alphabetic? #\-) #f)
+  (test (char-alphabetic? #\_) #f)
+  (test (char-alphabetic? #\^) #f)
+  (test (char-alphabetic? #\[) #f)
+
+  ;(test (char-alphabetic? (integer->char 200)) #t) ; ??
+  (test (char-alphabetic? (integer->char 127)) #f)  ; backspace
+
+  (for-each
+   (lambda (arg)
+     (if (char-alphabetic? arg)
+	 (format #t ";(char-alphabetic? ~A) -> #t?~%" arg)))
+   digits)
+
+  (for-each
+   (lambda (arg)
+     (if (not (char-alphabetic? arg))
+	 (format #t ";(char-alphabetic? ~A) -> #f?~%" arg)))
+   mixed-a-to-z)
+
+  (test (char-alphabetic?) 'error)
+  (test (char-alphabetic? #\a #\b) 'error)
+
+  (for-each
+   (lambda (op)
+     (for-each
+      (lambda (arg)
+	(test (op arg) 'error))
+      (list "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+	    3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
+   (list char-upper-case? char-lower-case? char-upcase char-downcase char-numeric? char-whitespace? char-alphabetic?))
+
+  (test
+   (let ((unhappy ()))
+     (do ((i 0 (+ i 1)))
+	 ((= i 256))
+       (let* ((ch (integer->char i))
+	      (chu (char-upcase ch))
+	      (chd (char-downcase ch)))
+
+	 (if (and (not (char=? ch chu))
+		  (not (char-upper-case? chu)))
+	     (format #t ";(char-upper-case? (char-upcase ~C)) is #f~%" ch))
+
+	 (if (and (not (char=? ch chd))
+		  (not (char-lower-case? chd)))
+	     (format #t ";(char-lower-case? (char-downcase ~C)) is #f~%" ch))
+
+	 (if (or (and (not (char=? ch chu))
+		      (not (char=? ch (char-downcase chu))))
+		 (and (not (char=? ch chd))
+		      (not (char=? ch (char-upcase chd))))
+		 (and (not (char=? ch chd))
+		      (not (char=? ch chu)))
+		 (not (char-ci=? chu chd))
+		 (not (char-ci=? ch chu))
+		 (and (char-alphabetic? ch)
+		      (or (not (char-alphabetic? chd))
+			  (not (char-alphabetic? chu))))
+		 (and (char-numeric? ch)
+		      (or (not (char-numeric? chd))
+			  (not (char-numeric? chu))))
+		 (and (char-whitespace? ch)
+		      (or (not (char-whitespace? chd))
+			  (not (char-whitespace? chu))))
+		 (and (char-alphabetic? ch)
+		      (char-whitespace? ch))
+		 (and (char-numeric? ch)
+		      (char-whitespace? ch))
+		 (and (char-alphabetic? ch)
+		      (char-numeric? ch)))
+	     ;; there are characters that are alphabetic but the result of char-upcase is not an upper-case character
+	     ;; 223 for example, or 186 for lower case
+	     (set! unhappy (cons (format #f "~C: ~C ~C (~D)~%" ch chu chd i) unhappy)))))
+     unhappy)
+   ())
+
+  (for-each
+   (lambda (op)
+     (for-each
+      (lambda (arg)
+	(test (op #\a arg) 'error))
+      (list "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+	    3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
+   (list char=? char<? char<=? char>? char>=? char-ci=? char-ci<? char-ci<=? char-ci>? char-ci>=?))
+
+  (for-each
+   (lambda (op)
+     (for-each
+      (lambda (arg)
+	(test (op arg #\a) 'error))
+      (list "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+	    3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
+   (list char=? char<? char<=? char>? char>=? char-ci=? char-ci<? char-ci<=? char-ci>? char-ci>=?))
+
+  (let () ; check direct opts
+    (define (fc str)
+      (let ((len (length str))
+	    (count 0))
+	(do ((i 0 (+ i 1)))
+	    ((= i len) count)
+	  (if (char-whitespace? (string-ref str i))
+	      (set! count (+ count 1)))
+	  (if (char-alphabetic? (string-ref str i))
+	      (set! count (+ count 1)))
+	  (if (char-numeric? (string-ref str i))
+	      (set! count (+ count 1)))
+	  (if (char-lower-case? (string-ref str i))
+	      (set! count (+ count 1)))
+	  (if (char-upper-case? (string-ref str i))
+	      (set! count (+ count 1))))))
+    (test (fc "123 4Ab.2") 10))
+
+
+;;; --------------------------------------------------------------------------------
+;;; char=?
+
+  (test (char=? #\d #\d) #t)
+  (test (char=? #\A #\a) #f)
+  (test (char=? #\d #\x) #f)
+  (test (char=? #\d #\D) #f)
+  (test (char=? #\a #\a) #t)
+  (test (char=? #\A #\B) #f)
+  (test (char=? #\a #\b) #f)
+  (test (char=? #\9 #\0) #f)
+  (test (char=? #\A #\A) #t)
+  (test (char=? #\  #\space) #t)
+  (let ((i (char->integer #\space)))
+    (test (char=? (integer->char i) #\space) #t))
+  (test (char=? (integer->char (char->integer #\")) #\") #t)
+  (test (char=? #\x65 #\e) #t)
+
+  (test (char=? #\d #\d #\d #\d) #t)
+  (test (char=? #\d #\d #\x #\d) #f)
+  (test (char=? #\d #\y #\x #\c) #f)
+  (test (apply char=? cap-a-to-z) #f)
+  (test (apply char=? mixed-a-to-z) #f)
+  (test (apply char=? digits) #f)
+  (test (char=? #\d #\c #\d) #f)
+
+  (test (char=? #\a) 'error)
+  (test (char=?) 'error)
+  (test (char=? #\a 0) 'error)
+  (test (char=? #\a #\b 0) 'error)
+  (test (char=? 90 (integer->char 90)) 'error)
+  (test (char=? 90 #\Z) 'error)
+  (test (char=? #\Z 90) 'error)
+  (test (char=? 1 1) 'error)
+
+
+;;; --------------------------------------------------------------------------------
+;;; char<?
+
+  (test (char<? #\z #\0) #f)
+  (test (char<? #\d #\x) #t)
+  (test (char<? #\d #\d) #f)
+  (test (char<? #\d #\x) #t)
+  (test (char<? #\A #\B) #t)
+  (test (char<? #\a #\b) #t)
+  (test (char<? #\9 #\0) #f)
+  (test (char<? #\A #\A) #f)
+  (test (char<? #\space #\space) #f)
+
+  (test (char<? #\a #\e #\y #\z) #t)
+  (test (char<? #\a #\e #\e #\y) #f)
+  (test (apply char<? a-to-z) #t)
+  (test (apply char<? cap-a-to-z) #t)
+  (test (apply char<? mixed-a-to-z) #f)
+  (test (apply char<? digits) #t)
+  (test (apply char<? (reverse a-to-z)) #f)
+  (test (apply char<? (reverse cap-a-to-z)) #f)
+  (test (apply char<? (reverse mixed-a-to-z)) #f)
+  (test (apply char<? (reverse digits)) #f)
+  (test (char<? #\b #\c #\a) #f)
+  (test (char<? #\B #\B #\A) #f)
+  (test (char<? #\b #\c #\e) #t)
+  (test (char<? (integer->char #xf0) (integer->char #x70)) #f)
+
+  (test (char<?) 'error)
+  (test (char<? #\b #\a "hi") 'error)
+  (test (char<? #\b #\a 0) 'error)
+  (test (char<? (integer->char 0) (integer->char 255)) #t)
+  (test (char<? 90 (integer->char 90)) 'error)
+  (test (char<? 90 #\Z) 'error)
+  (test (char<? #\Z 90) 'error)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; char<=?
+
+  (test (char<=? #\d #\x) #t)
+  (test (char<=? #\d #\d) #t)
+
+  (test (char<=? #\a #\e #\y #\z) #t)
+  (test (char<=? #\a #\e #\e #\y) #t)
+  (test (char<=? #\A #\B) #t)
+  (test (char<=? #\a #\b) #t)
+  (test (char<=? #\9 #\0) #f)
+  (test (char<=? #\A #\A) #t)
+  (test (char<=? #\space #\space) #t)
+
+  (test (char<=? #\a #\e #\y #\z) #t)
+  (test (char<=? #\a #\e #\e #\y) #t)
+  (test (char<=? #\e #\e #\d #\y) #f)
+  (test (apply char<=? a-to-z) #t)
+  (test (apply char<=? cap-a-to-z) #t)
+  (test (apply char<=? mixed-a-to-z) #f)
+  (test (apply char<=? digits) #t)
+  (test (apply char<=? (reverse a-to-z)) #f)
+  (test (apply char<=? (reverse cap-a-to-z)) #f)
+  (test (apply char<=? (reverse mixed-a-to-z)) #f)
+  (test (apply char<=? (reverse digits)) #f)
+  (test (char<=? #\b #\c #\a) #f)
+  (test (char<=? #\B #\B #\A) #f)
+  (test (char<=? #\b #\c #\e) #t)
+
+  (test (char<=? #\b #\a "hi") 'error)
+  (test (char<=? #\b #\a 0) 'error)
+  (test (char<=?) 'error)
+  (test (char<=? 90 (integer->char 90)) 'error)
+  (test (char<=? 90 #\Z) 'error)
+  (test (char<=? #\Z 90) 'error)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; char>?
+
+  (test (char>? #\e #\d) #t)
+  (test (char>? #\z #\a) #t)
+  (test (char>? #\A #\B) #f)
+  (test (char>? #\a #\b) #f)
+  (test (char>? #\9 #\0) #t)
+  (test (char>? #\A #\A) #f)
+  (test (char>? #\space #\space) #f)
+
+  (test (char>? #\d #\c #\b #\a) #t)
+  (test (char>? #\d #\d #\c #\a) #f)
+  (test (char>? #\e #\d #\b #\c #\a) #f)
+  (test (apply char>? a-to-z) #f)
+  (test (apply char>? cap-a-to-z) #f)
+  (test (apply char>? mixed-a-to-z) #f)
+  (test (apply char>? digits) #f)
+  (test (apply char>? (reverse a-to-z)) #t)
+  (test (apply char>? (reverse cap-a-to-z)) #t)
+  (test (apply char>? (reverse mixed-a-to-z)) #f)
+  (test (apply char>? (reverse digits)) #t)
+  (test (char>? #\d #\c #\a) #t)
+  (test (char>? #\d #\c #\c) #f)
+  (test (char>? #\B #\B #\C) #f)
+  (test (char>? #\b #\c #\e) #f)
+  (test (char>? (integer->char #xf0) (integer->char #x70)) #t)
+
+  (test (char>? #\a #\b "hi") 'error)
+  (test (char>? #\a #\b 0) 'error)
+  (test (char>?) 'error)
+  (test (char>? 90 (integer->char 90)) 'error)
+  (test (char>? 90 #\Z) 'error)
+  (test (char>? #\Z 90) 'error)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; char>=?
+
+  (test (char>=? #\e #\d) #t)
+  (test (char>=? #\A #\B) #f)
+  (test (char>=? #\a #\b) #f)
+  (test (char>=? #\9 #\0) #t)
+  (test (char>=? #\A #\A) #t)
+  (test (char>=? #\space #\space) #t)
+
+  (test (char>=? #\d #\c #\b #\a) #t)
+  (test (char>=? #\d #\d #\c #\a) #t)
+  (test (char>=? #\e #\d #\b #\c #\a) #f)
+  (test (apply char>=? a-to-z) #f)
+  (test (apply char>=? cap-a-to-z) #f)
+  (test (apply char>=? mixed-a-to-z) #f)
+  (test (apply char>=? digits) #f)
+  (test (apply char>=? (reverse a-to-z)) #t)
+  (test (apply char>=? (reverse cap-a-to-z)) #t)
+  (test (apply char>=? (reverse mixed-a-to-z)) #f)
+  (test (apply char>=? (reverse digits)) #t)
+  (test (char>=? #\d #\c #\a) #t)
+  (test (char>=? #\d #\c #\c) #t)
+  (test (char>=? #\B #\B #\C) #f)
+  (test (char>=? #\b #\c #\e) #f)
+
+  (test (char>=? #\a #\b "hi") 'error)
+  (test (char>=? #\a #\b 0) 'error)
+  (test (char>=?) 'error)
+  (test (char>=? 90 (integer->char 90)) 'error)
+  (test (char>=? 90 #\Z) 'error)
+  (test (char>=? #\Z 90) 'error)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; char-ci=?
+
+  (test (char-ci=? #\A #\B) #f)
+  (test (char-ci=? #\a #\B) #f)
+  (test (char-ci=? #\A #\b) #f)
+  (test (char-ci=? #\a #\b) #f)
+  (test (char-ci=? #\9 #\0) #f)
+  (test (char-ci=? #\A #\A) #t)
+  (test (char-ci=? #\A #\a) #t)
+  (test (char-ci=? #\a #\A) #t)
+  (test (char-ci=? #\space #\space) #t)
+
+  (test (char-ci=? #\d #\D #\d #\d) #t)
+  (test (char-ci=? #\d #\d #\X #\d) #f)
+  (test (char-ci=? #\d #\Y #\x #\c) #f)
+  (test (apply char-ci=? cap-a-to-z) #f)
+  (test (apply char-ci=? mixed-a-to-z) #f)
+  (test (apply char-ci=? digits) #f)
+  (test (char-ci=? #\d #\c #\d) #f)
+
+  (test (char-ci=?) 'error)
+  (test (char-ci=? #\a #\b 0) 'error)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; char-ci<?
+
+  (test (char-ci<? #\A #\B) #t)
+  (test (char-ci<? #\a #\B) #t)
+  (test (char-ci<? #\A #\b) #t)
+  (test (char-ci<? #\a #\b) #t)
+  (test (char-ci<? #\9 #\0) #f)
+  (test (char-ci<? #\0 #\9) #t)
+  (test (char-ci<? #\A #\A) #f)
+  (test (char-ci<? #\A #\a) #f)
+  (test (char-ci<? #\Y #\_) #t)
+  (test (char-ci<? #\\ #\J) #f)
+  (test (char-ci<? #\_ #\e) #f)
+  (test (char-ci<? #\t #\_) #t)
+  (test (char-ci<? #\a #\]) #t)
+  (test (char-ci<? #\z #\^) #t)
+
+  (test (char-ci<? #\b #\a "hi") 'error)
+  (test (char-ci<? #\b #\a 0) 'error)
+  (test (char-ci>? (integer->char #xf0) (integer->char #x70)) #t)
+
+#|
+    ;; this tries them all:
+    (do ((i 0 (+ i 1)))
+	((= i 256))
+      (do ((k 0 (+ k 1)))
+	  ((= k 256))
+	(let ((c1 (integer->char i))
+	      (c2 (integer->char k)))
+	  (for-each
+	   (lambda (op1 op2)
+	     (if (not (eq? (op1 c1 c2) (op2 (string c1) (string c2))))
+		 (format #t ";(~A|~A ~A ~A) -> ~A|~A~%" op1 op2 c1 c2 (op1 c1 c2) (op2 (string c1) (string c2)))))
+	   (list char=? char<? char<=? char>? char>=? char-ci=? char-ci<? char-ci<=? char-ci>? char-ci>=?)
+	   (list string=? string<? string<=? string>? string>=? string-ci=? string-ci<? string-ci<=? string-ci>? string-ci>=?)))))
+|#
+
+  (test (char-ci<? #\d #\D #\d #\d) #f)
+  (test (char-ci<? #\d #\d #\X #\d) #f)
+  (test (char-ci<? #\d #\Y #\x #\c) #f)
+  (test (apply char-ci<? cap-a-to-z) #t)
+  (test (apply char-ci<? mixed-a-to-z) #t)
+  (test (apply char-ci<? digits) #t)
+  (test (char-ci<? #\d #\c #\d) #f)
+  (test (char-ci<? #\b #\c #\a) #f)
+  (test (char-ci<? #\b #\C #\e) #t)
+  (test (char-ci<? #\3 #\? #\Z #\[) #t)
+
+  (test (char-ci>? #\a #\b "hi") 'error)
+  (test (char-ci>? #\a #\b 0) 'error)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; char-ci>?
+
+  (test (char-ci>? #\A #\B) #f)
+  (test (char-ci>? #\a #\B) #f)
+  (test (char-ci>? #\A #\b) #f)
+  (test (char-ci>? #\a #\b) #f)
+  (test (char-ci>? #\9 #\0) #t)
+  (test (char-ci>? #\A #\A) #f)
+  (test (char-ci>? #\A #\a) #f)
+  (test (char-ci>? #\^ #\a) #t)
+  (test (char-ci>? #\_ #\e) #t)
+  (test (char-ci>? #\[ #\S) #t)
+  (test (char-ci>? #\\ #\l) #t)
+  (test (char-ci>? #\t #\_) #f)
+  (test (char-ci>? #\a #\]) #f)
+  (test (char-ci>? #\z #\^) #f)
+  (test (char-ci>? #\] #\X) #t)
+
+  (test (char-ci>? #\d #\D #\d #\d) #f)
+  (test (char-ci>? #\d #\d #\X #\d) #f)
+  (test (char-ci>? #\d #\Y #\x #\c) #f)
+  (test (apply char-ci>? cap-a-to-z) #f)
+  (test (apply char-ci>? mixed-a-to-z) #f)
+  (test (apply char-ci>? (reverse mixed-a-to-z)) #t)
+  (test (apply char-ci>? digits) #f)
+  (test (char-ci>? #\d #\c #\d) #f)
+  (test (char-ci>? #\b #\c #\a) #f)
+  (test (char-ci>? #\d #\C #\a) #t)
+
+
+;;; --------------------------------------------------------------------------------
+;;; char-ci<=?
+
+  (test (char-ci<=? #\A #\B) #t)
+  (test (char-ci<=? #\a #\B) #t)
+  (test (char-ci<=? #\A #\b) #t)
+  (test (char-ci<=? #\a #\b) #t)
+  (test (char-ci<=? #\9 #\0) #f)
+  (test (char-ci<=? #\A #\A) #t)
+  (test (char-ci<=? #\A #\a) #t)
+  (test (char-ci<=? #\` #\H) #f)
+  (test (char-ci<=? #\[ #\m) #f)
+  (test (char-ci<=? #\j #\`) #t)
+  (test (char-ci<=? #\\ #\E) #f)
+  (test (char-ci<=? #\t #\_) #t)
+  (test (char-ci<=? #\a #\]) #t)
+  (test (char-ci<=? #\z #\^) #t)
+
+  (test (char-ci<=? #\d #\D #\d #\d) #t)
+  (test (char-ci<=? #\d #\d #\X #\d) #f)
+  (test (char-ci<=? #\d #\Y #\x #\c) #f)
+  (test (apply char-ci<=? cap-a-to-z) #t)
+  (test (apply char-ci<=? mixed-a-to-z) #t)
+  (test (apply char-ci<=? digits) #t)
+  (test (char-ci<=? #\d #\c #\d) #f)
+  (test (char-ci<=? #\b #\c #\a) #f)
+  (test (char-ci<=? #\b #\c #\C) #t)
+  (test (char-ci<=? #\b #\C #\e) #t)
+
+  (test (char-ci<=? #\b #\a "hi") 'error)
+  (test (char-ci<=? #\b #\a 0) 'error)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; char-ci>=?
+
+  (test (char-ci>=? #\A #\B) #f)
+  (test (char-ci>=? #\a #\B) #f)
+  (test (char-ci>=? #\A #\b) #f)
+  (test (char-ci>=? #\a #\b) #f)
+  (test (char-ci>=? #\9 #\0) #t)
+  (test (char-ci>=? #\A #\A) #t)
+  (test (char-ci>=? #\A #\a) #t)
+  (test (char-ci>=? #\Y #\_) #f)
+  (test (char-ci>=? #\` #\S) #t)
+  (test (char-ci>=? #\[ #\Y) #t)
+  (test (char-ci>=? #\t #\_) #f)
+  (test (char-ci>=? #\a #\]) #f)
+  (test (char-ci>=? #\z #\^) #f)
+
+  (test (char-ci>=? #\d #\D #\d #\d) #t)
+  (test (char-ci>=? #\d #\d #\X #\d) #f)
+  (test (char-ci>=? #\d #\Y #\x #\c) #f)
+  (test (apply char-ci>=? cap-a-to-z) #f)
+  (test (apply char-ci>=? mixed-a-to-z) #f)
+  (test (apply char-ci>=? (reverse mixed-a-to-z)) #t)
+  (test (apply char-ci>=? (reverse mixed-a-to-z)) #t)
+  (test (apply char-ci>=? digits) #f)
+  (test (char-ci>=? #\d #\c #\d) #f)
+  (test (char-ci>=? #\b #\c #\a) #f)
+  (test (char-ci>=? #\d #\D #\a) #t)
+  (test (char-ci>=? #\\ #\J #\+) #t)
+
+  (test (char-ci>=? #\a #\b "hi") 'error)
+  (test (char-ci>=? #\a #\b 0) 'error)
+
+  ) ; end let with a-to-z
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; integer->char
+;;; char->integer
+
+(test (integer->char (char->integer #\.)) #\.)
+(test (integer->char (char->integer #\A)) #\A)
+(test (integer->char (char->integer #\a)) #\a)
+(test (integer->char (char->integer #\space)) #\space)
+(test (char->integer (integer->char #xf0)) #xf0)
+
+(do ((i 0 (+ i 1)))
+    ((= i 256))
+  (if (not (= (char->integer (integer->char i)) i))
+      (format #t ";char->integer ~D ~A != ~A~%" i (integer->char i) (char->integer (integer->char i)))))
+
+(test (reinvert 12 integer->char char->integer 60) 60)
+
+(test (char->integer 33) 'error)
+(test (char->integer) 'error)
+(test (integer->char) 'error)
+(test (integer->char (expt 2 31)) 'error)
+(test (integer->char (expt 2 32)) 'error)
+(test (integer->char 12 14) 'error)
+(test (char->integer #\a #\b) 'error)
+;(test (char->integer #\ÿ) 255) ; emacs confusion?
+(test (eval-string (string-append "(char->integer " (format #f "#\\~C" (integer->char 255)) ")")) 255)
+
+(for-each
+ (lambda (arg)
+   (test (char->integer arg) 'error))
+ (list -1 1 0 123456789 "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+   (test (integer->char arg) 'error))
+ (list -1 257 123456789 -123456789 #\a "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi most-positive-fixnum 1/0 (if #f #f) (lambda (a) (+ a 1))))
+
+(test (#\a) 'error)
+(test (#\newline 1) 'error)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; STRINGS
+;;; --------------------------------------------------------------------------------
+
+;;; --------------------------------------------------------------------------------
+;;; string?
+
+(test (string? "abc") #t)
+(test (string? ':+*/-) #f)
+(test (string? "das ist einer der teststrings") #t)
+(test (string? '(das ist natuerlich falsch)) #f)
+(test (string? "aaaaaa") #t)
+(test (string? #\a) #f)
+(test (string? "\"\\\"") #t)
+(test (string? lambda) #f)
+(test (string? format) #f)
+
+(for-each
+ (lambda (arg)
+   (test (string? arg) #f))
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (string?) 'error)
+(test (string? "hi" "ho") 'error)
+(test (string? #\null) #f)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; string=?
+
+(test (string=? "foo" "foo") #t)
+(test (string=? "foo" "FOO") #f)
+(test (string=? "foo" "bar") #f)
+(test (string=? "FOO" "FOO") #t)
+(test (string=? "A" "B") #f)
+(test (string=? "a" "b") #f)
+(test (string=? "9" "0") #f)
+(test (string=? "A" "A") #t)
+(test (string=? "" "") #t)
+(test (string=? (string #\newline) (string #\newline)) #t)
+
+(test (string=? "A" "B" "a") #f)
+(test (string=? "A" "A" "a") #f)
+(test (string=? "A" "A" "A") #t)
+(test (string=? "foo" "foo" "foo") #t)
+(test (string=? "foo" "foo" "") #f)
+(test (string=? "foo" "foo" "fOo") #f)
+
+(test (string=? "foo" "FOO" 1.0) 'error)
+(let ((str "01234567"))
+  (test (length str) 8)
+  (set! str (reverse! str))
+  (test (string=? "76543210" str) #t) ; checking the bswap case in s7
+  (set! str "012345670123456701234567012345670123456701234567")
+  (test (length str) 48)
+  (set! str (reverse! str))
+  (string=? str "765432107654321076543210765432107654321076543210")
+  (set! str "0123456")
+  (set! str (reverse! str))
+  (test (string=? "6543210" str) #t))
+
+(test (let ((str (string #\" #\1 #\\ #\2 #\")))	(string=? str "\"1\\2\"")) #t)
+(test (let ((str (string #\\ #\\ #\\)))	(string=? str "\\\\\\")) #t)
+(test (let ((str (string #\")))	(string=? str "\"")) #t)
+(test (let ((str (string #\\ #\"))) (string=? str "\\\"")) #t)
+(test (let ((str (string #\space #\? #\)))) (string=? str " ?)")) #t)
+(test (let ((str (string #\# #\\ #\t))) (string=? str "#\\t")) #t)
+(test (string=? (string #\x (integer->char #xf0) #\x) (string #\x (integer->char #x70) #\x)) #f)
+(test (string=? (string #\x (integer->char #xf0) #\x) (string #\x (integer->char #xf0) #\x)) #t)
+(test (string=? "\x65;\x65;" "ee") #t)
+(test (string=? "\"\\\n\t\r\/\b\f\x65;\"" "\x22;\x5c;\xa;\x09;\xd;\x2f;\x8;\xc;e\x22;") #t)
+
+(test (string=? (string) "") #t)
+(test (string=? (string) (make-string 0)) #t)
+(test (string=? (string-copy (string)) (make-string 0)) #t)
+(test (string=? "" (make-string 0)) #t)
+(test (string=? "" (string-append)) #t)
+(test (string=? (string #\space #\newline) " \n") #t)
+
+(test (string=? "......" "...\
+...") #t)
+(test (string=? "\n" (string #\newline)) #t)
+(test (string=? "\
+\
+\
+\
+" "") #t)
+(test (string=? "" (string #\null)) #f)
+(test (string=? (string #\null #\null) (string #\null)) #f)
+(test (string=? "" "asd") #f)
+(test (string=? "asd" "") #f)
+(test (string=? "xx" (make-string 2 #\x) (string #\x #\x) (list->string (list #\x #\x)) (substring "axxb" 1 3) (string-append "x" "x")) #t)
+(test (let ((s1 "1234") (s2 "1245")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string=? s1 s2)) #f)
+(test (let ((s1 "1234") (s2 "1234")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string=? s1 s2)) #t)
+(test (let ((s1 "1234") (s2 "124")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string=? s1 s2)) #f)
+(test (string=? (make-string 3 #\space) (let ((s (make-string 4 #\space))) (set! (s 3) #\null) s)) #f)
+(test "\x3012;" "0\x12;") ; \x30 = 48 = #\0
+
+(for-each
+ (lambda (arg)
+   (test (string=? "hi" arg) 'error)
+   (test (string=? arg "hi") 'error))
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+
+;; this strikes me as highly dubious
+(test (call-with-input-string "1\n2" (lambda (p) (read p))) 1)
+(test (call-with-input-string "1\\ \n2" (lambda (p) (read p))) (symbol "1\\"))
+
+(test (eval (with-input-from-string "(symbol \"(\\\")\")" read)) (symbol "(\")"))
+
+(test (call-with-input-string "1\
+2" (lambda (p) (read p))) 12)
+
+;; do we guarantee that read takes place in the current environment? no...
+(test (call-with-input-string "fl\
+oor" read) 'floor)
+
+(test (call-with-input-string "p\
+i" (lambda (p) (eval (read p)))) pi)
+
+(test (call-with-input-string "(+ 1;\
+ this is presumably a comment
+ 1)" (lambda (p) (eval (read p)))) 2)
+
+(test (call-with-input-string "(+ 1;\
+ this is presumably a comment;\
+ and more commentary
+ 1)" (lambda (p) (eval (read p)))) 2)
+
+(test (string=? (string #\1) (byte-vector 2)) 'error) ; changed 18-June-18
+(let () (define (func) (let ((x #f) (i 0)) (if (not x) (string=? (immutable! "asdf") :frequency)))) (test (func) 'error))
+
+
+;;; --------------------------------------------------------------------------------
+;;; string<?
+
+(test (string<? "aaaa" "aaab") #t)
+(test (string<? "aaaa" "aaaaa") #t)
+(test (string<? "" "abcdefgh") #t)
+(test (string<? "a" "abcdefgh") #t)
+(test (string<? "abc" "abcdefgh") #t)
+(test (string<? "cabc" "abcdefgh") #f)
+(test (string<? "abcdefgh" "abcdefgh") #f)
+(test (string<? "xyzabc" "abcdefgh") #f)
+(test (string<? "abc" "xyzabcdefgh") #t)
+(test (string<? "abcdefgh" "") #f)
+(test (string<? "abcdefgh" "a") #f)
+(test (string<? "abcdefgh" "abc") #f)
+(test (string<? "abcdefgh" "cabc") #t)
+(test (string<? "abcdefgh" "xyzabc") #t)
+(test (string<? "xyzabcdefgh" "abc") #f)
+(test (string<? "abcdef" "bcdefgh") #t)
+(test (string<? "" "") #f)
+(test (string<? "A" "B") #t)
+(test (string<? "a" "b") #t)
+(test (string<? "9" "0") #f)
+(test (string<? "A" "A") #f)
+
+(test (string<? "A" "B" "A") #f)
+(test (string<? "A" "A" "B") #f)
+(test (string<? "A" "A" "A") #f)
+(test (string<? "B" "B" "C") #f)
+(test (string<? "foo" "foo" "foo") #f)
+(test (string<? "foo" "foo" "") #f)
+(test (string<? "foo" "foo" "fOo") #f)
+
+(test (string<? "foo" "fo" 1.0) 'error)
+(test (let ((s1 "1234") (s2 "1245")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string<? s1 s2)) #t)
+(test (let ((s1 "1234") (s2 "123")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string<? s1 s2)) #f)
+(test (let ((s1 "123") (s2 "1234")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string<? s1 s2)) #t)
+(test (not (string<? "foo\x0a;" "foo\x0a;")) #t)
+(test (string<? "foo\x0a;" "foo\x0b;") #t)
+
+(test (string<? (string (integer->char #xf0)) (string (integer->char #x70))) #f)
+
+(for-each
+ (lambda (arg)
+   (test (string<? "hi" arg) 'error)
+   (test (string<? arg "hi") 'error))
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; string>?
+
+(test (string>? "aaab" "aaaa") #t)
+(test (string>? "aaaaa" "aaaa") #t)
+(test (string>? "" "abcdefgh") #f)
+(test (string>? "a" "abcdefgh") #f)
+(test (string>? "abc" "abcdefgh") #f)
+(test (string>? "cabc" "abcdefgh") #t)
+(test (string>? "abcdefgh" "abcdefgh") #f)
+(test (string>? "xyzabc" "abcdefgh") #t)
+(test (string>? "abc" "xyzabcdefgh") #f)
+(test (string>? "abcdefgh" "") #t)
+(test (string>? "abcdefgh" "a") #t)
+(test (string>? "abcdefgh" "abc") #t)
+(test (string>? "abcdefgh" "cabc") #f)
+(test (string>? "abcdefgh" "xyzabc") #f)
+(test (string>? "xyzabcdefgh" "abc") #t)
+(test (string>? "abcde" "bc") #f)
+(test (string>? "bcdef" "abcde") #t)
+(test (string>? "bcdef" "abcdef") #t)
+(test (string>? "" "") #f)
+(test (string>? "A" "B") #f)
+(test (string>? "a" "b") #f)
+(test (string>? "9" "0") #t)
+(test (string>? "A" "A") #f)
+
+(test (string>? "A" "B" "a") #f)
+(test (string>? "C" "B" "A") #t)
+(test (string>? "A" "A" "A") #f)
+(test (string>? "B" "B" "A") #f)
+(test (string>? "foo" "foo" "foo") #f)
+(test (string>? "foo" "foo" "") #f)
+(test (string>? "foo" "foo" "fOo") #f)
+
+(test (string>? "foo" "fooo" 1.0) 'error)
+(test (let ((s1 "1234") (s2 "1245")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string>? s1 s2)) #f)
+(test (let ((s1 "1234") (s2 "123")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string>? s1 s2)) #t)
+(test (let ((s1 "123") (s2 "1234")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string>? s1 s2)) #f)
+
+(test (string>? (string (integer->char #xf0)) (string (integer->char #x70))) #t) ; ??
+
+(for-each
+ (lambda (arg)
+   (test (string>? "hi" arg) 'error)
+   (test (string>? arg "hi") 'error))
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; string<=?
+
+(test (string<=? "aaa" "aaaa") #t)
+(test (string<=? "aaaaa" "aaaa") #f)
+(test (string<=? "a" "abcdefgh") #t)
+(test (string<=? "abc" "abcdefgh") #t)
+(test (string<=? "aaabce" "aaabcdefgh") #f)
+(test (string<=? "cabc" "abcdefgh") #f)
+(test (string<=? "abcdefgh" "abcdefgh") #t)
+(test (string<=? "xyzabc" "abcdefgh") #f)
+(test (string<=? "abc" "xyzabcdefgh") #t)
+(test (string<=? "abcdefgh" "") #f)
+(test (string<=? "abcdefgh" "a") #f)
+(test (string<=? "abcdefgh" "abc") #f)
+(test (string<=? "abcdefgh" "cabc") #t)
+(test (string<=? "abcdefgh" "xyzabc") #t)
+(test (string<=? "xyzabcdefgh" "abc") #f)
+(test (string<=? "abcdef" "bcdefgh") #t)
+(test (string<=? "" "") #t)
+(test (string<=? "A" "B") #t)
+(test (string<=? "a" "b") #t)
+(test (string<=? "9" "0") #f)
+(test (string<=? "A" "A") #t)
+
+(test (string<=? "A" "B" "C") #t)
+(test (string<=? "C" "B" "A") #f)
+(test (string<=? "A" "B" "B") #t)
+(test (string<=? "A" "A" "A") #t)
+(test (string<=? "B" "B" "A") #f)
+(test (string<=? "foo" "foo" "foo") #t)
+(test (string<=? "foo" "foo" "") #f)
+(test (string<=? "foo" "foo" "fooo") #t)
+
+(test (string<=? "foo" "fo" 1.0) 'error)
+(test (let ((s1 "1234") (s2 "1245")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string<=? s1 s2)) #t)
+(test (let ((s1 "1234") (s2 "123")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string<=? s1 s2)) #f)
+(test (let ((s1 "123") (s2 "1234")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string<=? s1 s2)) #t)
+(test (let ((s1 "1234") (s2 "1234")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string<=? s1 s2)) #t)
+
+(for-each
+ (lambda (arg)
+   (test (string<=? "hi" arg) 'error)
+   (test (string<=? arg "hi") 'error))
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; string>=?
+
+(test (string>=? "aaaaa" "aaaa") #t)
+(test (string>=? "aaaa" "aaaa") #t)
+(test (string>=? "aaa" "aaaa") #f)
+(test (string>=? "" "abcdefgh") #f)
+(test (string>=? "a" "abcdefgh") #f)
+(test (string>=? "abc" "abcdefgh") #f)
+(test (string>=? "cabc" "abcdefgh") #t)
+(test (string>=? "abcdefgh" "abcdefgh") #t)
+(test (string>=? "xyzabc" "abcdefgh") #t)
+(test (string>=? "abc" "xyzabcdefgh") #f)
+(test (string>=? "abcdefgh" "") #t)
+(test (string>=? "abcdefgh" "a") #t)
+(test (string>=? "abcdefgh" "abc") #t)
+(test (string>=? "abcdefgh" "cabc") #f)
+(test (string>=? "abcdefgh" "xyzabc") #f)
+(test (string>=? "xyzabcdefgh" "abc") #t)
+(test (string>=? "bcdef" "abcdef") #t)
+(test (string>=? "A" "B") #f)
+(test (string>=? "a" "b") #f)
+(test (string>=? "9" "0") #t)
+(test (string>=? "A" "A") #t)
+(test (string>=? "" "") #t)
+
+(test (string>=? "A" "B" "C") #f)
+(test (string>=? "C" "B" "A") #t)
+(test (string>=? "C" "B" "B") #t)
+(test (string>=? "A" "B" "B") #f)
+(test (string>=? "A" "A" "A") #t)
+(test (string>=? "B" "B" "A") #t)
+(test (string>=? "B" "B" "C") #f)
+(test (string>=? "foo" "foo" "foo") #t)
+(test (string>=? "foo" "foo" "") #t)
+(test (string>=? "foo" "foo" "fo") #t)
+
+(test (string>=? "fo" "foo" 1.0) 'error)
+(test (let ((s1 "1234") (s2 "1245")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string>=? s1 s2)) #f)
+(test (let ((s1 "1234") (s2 "123")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string>=? s1 s2)) #t)
+(test (let ((s1 "123") (s2 "1234")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string>=? s1 s2)) #f)
+(test (let ((s1 "1234") (s2 "1234")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string>=? s1 s2)) #t)
+
+(for-each
+ (lambda (arg)
+   (test (string>=? "hi" arg) 'error)
+   (test (string>=? arg "hi") 'error))
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; string-ci=?
+
+(test (string-ci=? "A" "B") #f)
+(test (string-ci=? "a" "B") #f)
+(test (string-ci=? "A" "b") #f)
+(test (string-ci=? "a" "b") #f)
+(test (string-ci=? "9" "0") #f)
+(test (string-ci=? "A" "A") #t)
+(test (string-ci=? "A" "a") #t)
+(test (string-ci=? "" "") #t)
+(test (string-ci=? "aaaa" "AAAA") #t)
+(test (string-ci=? "aaaa" "Aaaa") #t)
+
+(test (string-ci=? "A" "B" "a") #f)
+(test (string-ci=? "A" "A" "a") #t)
+(test (string-ci=? "A" "A" "a") #t)
+(test (string-ci=? "foo" "foo" "foo") #t)
+(test (string-ci=? "foo" "foo" "") #f)
+(test (string-ci=? "foo" "Foo" "fOo") #t)
+
+(test (string-ci=? "foo" "GOO" 1.0) 'error)
+(test (let ((s1 "1234") (s2 "1245")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci=? s1 s2)) #f)
+(test (let ((s1 "1234") (s2 "1234")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci=? s1 s2)) #t)
+(test (let ((s1 "1234") (s2 "124")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci=? s1 s2)) #f)
+(test (let ((s1 "abcd") (s2 "ABCD")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci=? s1 s2)) #t)
+(test (let ((s1 "abcd") (s2 "ABCE")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci=? s1 s2)) #f)
+(test (let ((s1 "abcd") (s2 "ABC")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci=? s1 s2)) #f)
+
+(for-each
+ (lambda (arg)
+   (test (string-ci=? "hi" arg) 'error)
+   (test (string-ci=? arg "hi") 'error))
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+
+(when full-s7test
+  (let ((size 15)
+	(tries 10000))
+    (let ((str1 (make-string size))
+	  (str2 (make-string size)))
+      (do ((i 0 (+ i 1)))
+	  ((= i tries))
+	(do ((k 0 (+ k 1)))
+	    ((= k size))
+	  (set! (str1 k) (integer->char (random 128)))
+	  (if (> (random 10) 4)
+	      (set! (str2 k) (char-upcase (str1 k)))
+	      (set! (str2 k) (char-downcase (str1 k)))))
+	(if (not (string-ci=? str1 str2))
+	    (format #t "not =: ~S ~S~%" str1 str2))
+	(if (and (string-ci<? str1 str2)
+		 (string-ci>=? str1 str2))
+	    (format #t "< : ~S ~S~%" str1 str2))
+	(if (and (string-ci>? str1 str2)
+		 (string-ci<=? str1 str2))
+	    (format #t "> : ~S ~S~%" str1 str2))))))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; string-ci<?
+
+(test (string-ci<? "a" "Aa") #t)
+(test (string-ci<? "A" "B") #t)
+(test (string-ci<? "a" "B") #t)
+(test (string-ci<? "A" "b") #t)
+(test (string-ci<? "a" "b") #t)
+(test (string-ci<? "9" "0") #f)
+(test (string-ci<? "0" "9") #t)
+(test (string-ci<? "A" "A") #f)
+(test (string-ci<? "A" "a") #f)
+(test (string-ci<? "" "") #f)
+
+(test (string-ci<? "t" "_") #t)
+(test (string-ci<? "a" "]") #t)
+(test (string-ci<? "z" "^") #t)
+(test (string-ci<? "]4.jVKo\\\\^:\\A9Z4" "MImKA[mNv1`") #f)
+
+(test (string-ci<? "A" "B" "A") #f)
+(test (string-ci<? "A" "A" "B") #f)
+(test (string-ci<? "A" "A" "A") #f)
+(test (string-ci<? "B" "B" "C") #f)
+(test (string-ci<? "B" "b" "C") #f)
+(test (string-ci<? "foo" "foo" "foo") #f)
+(test (string-ci<? "foo" "foo" "") #f)
+(test (string-ci<? "foo" "foo" "fOo") #f)
+(test (string-ci<? "34ZsfQD<obff33FBPFl" "7o" "9l7OM" "FC?M63=" "rLM5*J") #t)
+(test (string-ci<? "NX7" "-;h>P" "DMhk3Bg") #f)
+(test (string-ci<? "+\\mZl" "bE7\\e(HaW5CDXbPi@U_" "B_") #t)
+
+(if (char-ci<? (integer->char #xf0) (integer->char #x70))
+    (test (string-ci<? (string (integer->char #xf0)) (string (integer->char #x70))) #t))
+
+(test (string-ci<? "foo" "fo" 1.0) 'error)
+(test (let ((s1 "1234") (s2 "1245")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci<? s1 s2)) #t)
+(test (let ((s1 "1234") (s2 "1234")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci<? s1 s2)) #f)
+(test (let ((s1 "1234") (s2 "124")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci<? s1 s2)) #t)
+(test (let ((s1 "123") (s2 "12")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci<? s1 s2)) #f)
+(test (let ((s1 "abcd") (s2 "ABCD")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci<? s1 s2)) #f)
+(test (let ((s1 "abcd") (s2 "ABCE")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci<? s1 s2)) #t)
+(test (let ((s1 "abcd") (s2 "ABC")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci<? s1 s2)) #f)
+(test (let ((s1 "abc") (s2 "ABCD")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci<? s1 s2)) #t)
+
+(for-each
+ (lambda (arg)
+   (test (string-ci<? "hi" arg) 'error)
+   (test (string-ci<? arg "hi") 'error))
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+;;; from scheme bboard
+(test (string-ci<=? "test" "tes") #f)
+(test (string-ci<? "test" "tes") #f)
+(test (string-ci>=? "test" "tes") #t)
+(test (string-ci>? "test" "tes") #t)
+(test (string-ci<=? "tes" "test") #t)
+(test (string-ci<? "tes" "test") #t)
+(test (string-ci>=? "tes" "test") #f)
+(test (string-ci>? "tes" "test") #f)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; string-ci>?
+
+(test (string-ci>? "Aaa" "AA") #t)
+(test (string-ci>? "A" "B") #f)
+(test (string-ci>? "a" "B") #f)
+(test (string-ci>? "A" "b") #f)
+(test (string-ci>? "a" "b") #f)
+(test (string-ci>? "9" "0") #t)
+(test (string-ci>? "A" "A") #f)
+(test (string-ci>? "A" "a") #f)
+(test (string-ci>? "" "") #f)
+(test (string-ci>? "Z" "DjNTl0") #t)
+(test (string-ci>? "2399dt7BVN[,A" "^KHboHV") #f)
+
+(test (string-ci>? "t" "_") #f)
+(test (string-ci>? "a" "]") #f)
+(test (string-ci>? "z" "^") #f)
+(test (string-ci>? "R*95oG.k;?" "`2?J6LBbLG^alB[fMD") #f)
+(test (string-ci>? "]" "X") #t)
+
+(test (string-ci>? "A" "B" "a") #f)
+(test (string-ci>? "C" "b" "A") #t)
+(test (string-ci>? "a" "A" "A") #f)
+(test (string-ci>? "B" "B" "A") #f)
+(test (string-ci>? "foo" "foo" "foo") #f)
+(test (string-ci>? "foo" "foo" "") #f)
+(test (string-ci>? "foo" "foo" "fOo") #f)
+(test (string-ci>? "ZNiuEa@/V" "KGbKliYMY" "9=69q3ica" ":]") #f)
+(test (string-ci>? "^" "aN@di;iEO" "7*9q6uPmX9)PaY,6J" "15vH") #t)
+
+(test (string-ci>? "foo" "fooo" 1.0) 'error)
+(test (let ((s1 "abcd") (s2 "ABCD")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci>? s1 s2)) #f)
+(test (let ((s1 "abcd") (s2 "ABCE")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci>? s1 s2)) #f)
+(test (let ((s1 "abcd") (s2 "ABC")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci>? s1 s2)) #t)
+(test (let ((s1 "abc") (s2 "ABCD")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci>? s1 s2)) #f)
+
+(for-each
+ (lambda (arg)
+   (test (string-ci>? "hi" arg) 'error)
+   (test (string-ci>? arg "hi") 'error))
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; string-ci<=?
+
+(test (string-ci<=? "A" "B") #t)
+(test (string-ci<=? "a" "B") #t)
+(test (string-ci<=? "A" "b") #t)
+(test (string-ci<=? "a" "b") #t)
+(test (string-ci<=? "9" "0") #f)
+(test (string-ci<=? "A" "A") #t)
+(test (string-ci<=? "A" "a") #t)
+(test (string-ci<=? "" "") #t)
+(test (string-ci<=? ":LPC`" ",O0>affA?(") #f)
+
+(test (string-ci<=? "t" "_") #t)
+(test (string-ci<=? "a" "]") #t)
+(test (string-ci<=? "z" "^") #t)
+(test (string-ci<=? "G888E>beF)*mwCNnagP" "`2uTd?h") #t)
+
+(test (string-ci<=? "A" "b" "C") #t)
+(test (string-ci<=? "c" "B" "A") #f)
+(test (string-ci<=? "A" "B" "B") #t)
+(test (string-ci<=? "a" "A" "A") #t)
+(test (string-ci<=? "B" "b" "A") #f)
+(test (string-ci<=? "foo" "foo" "foo") #t)
+(test (string-ci<=? "foo" "foo" "") #f)
+(test (string-ci<=? "FOO" "fOo" "fooo") #t)
+(test (string-ci<=? "78mdL82*" "EFaCrIdm@_D+" "eMu\\@dSSY") #t)
+(test (string-ci<=? "`5pNuFc3PM<rNs" "e\\Su_raVNk6HD" "vXnuN7?S0?S(w+M?p") #f)
+
+(test (string-ci<=? "fOo" "fo" 1.0) 'error)
+(test (let ((s1 "abcd") (s2 "ABCD")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci<=? s1 s2)) #t)
+(test (let ((s1 "abcd") (s2 "ABCE")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci<=? s1 s2)) #t)
+(test (let ((s1 "abcd") (s2 "ABC")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci<=? s1 s2)) #f)
+(test (let ((s1 "abc") (s2 "ABCD")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci<=? s1 s2)) #t)
+
+(for-each
+ (lambda (arg)
+   (test (string-ci<=? "hi" arg) 'error)
+   (test (string-ci<=? arg "hi") 'error))
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; string-ci>=?
+
+(test (string-ci>=? "A" "B") #f)
+(test (string-ci>=? "a" "B") #f)
+(test (string-ci>=? "A" "b") #f)
+(test (string-ci>=? "a" "b") #f)
+(test (string-ci>=? "9" "0") #t)
+(test (string-ci>=? "A" "A") #t)
+(test (string-ci>=? "A" "a") #t)
+(test (string-ci>=? "" "") #t)
+(test (string-ci>=? "5d7?[o[:hop=ktv;9)" "p^r9;TAXO=^") #f)
+
+(test (string-ci>=? "t" "_") #f)
+(test (string-ci>=? "a" "]") #f)
+(test (string-ci>=? "z" "^") #f)
+(test (string-ci>=? "jBS" "`<+s[[:`l") #f)
+
+(test (string-ci>=? "A" "b" "C") #f)
+(test (string-ci>=? "C" "B" "A") #t)
+(test (string-ci>=? "C" "B" "b") #t)
+(test (string-ci>=? "a" "B" "B") #f)
+(test (string-ci>=? "A" "A" "A") #t)
+(test (string-ci>=? "B" "B" "A") #t)
+(test (string-ci>=? "B" "b" "C") #f)
+(test (string-ci>=? "foo" "foo" "foo") #t)
+(test (string-ci>=? "foo" "foo" "") #t)
+(test (string-ci>=? "foo" "foo" "fo") #t)
+(test (string-ci>=? "tF?8`Sa" "NIkMd7" "f`" "1td-Z?teE" "-ik1SK)hh)Nq].>") #t)
+(test (string-ci>=? "Z6a8P" "^/VpmWwt):?o[a9\\_N" "8[^h)<KX?[utsc") #f)
+
+(test (string-ci>=? "fo" "foo" 1.0) 'error)
+(test (let ((s1 "abcd") (s2 "ABCD")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci>=? s1 s2)) #t)
+(test (let ((s1 "abcd") (s2 "ABCE")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci>=? s1 s2)) #f)
+(test (let ((s1 "abcd") (s2 "ABC")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci>=? s1 s2)) #t)
+(test (let ((s1 "abc") (s2 "ABCD")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci>=? s1 s2)) #f)
+
+(for-each
+ (lambda (arg)
+   (test (string-ci>=? "hi" arg) 'error)
+   (test (string-ci>=? arg "hi") 'error))
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; string-length
+
+(test (string-length "abc") 3)
+(test (string-length "") 0)
+(test (string-length (string)) 0)
+(test (string-length "\"\\\"") 3)
+(test (string-length (string #\newline)) 1)
+(test (string-length "hi there") 8)
+(test (string-length "\"") 1)
+(test (string-length "\\") 1)
+(test (string-length "\n") 1)
+(test (string-length (make-string 100 #\a)) 100)
+(test (string-length "1\\2") 3)
+(test (string-length "1\\") 2)
+(test (string-length "hi\\") 3)
+(test (string-length "\\\\\\\"") 4)
+(test (string-length "A ; comment") 11)
+(test (string-length "#| comment |#") 13)
+(test (string-length "'123") 4)
+(test (string-length '"'123") 4)
+(test (let ((str (string #\# #\\ #\t))) (string-length str)) 3)
+
+(test (string-length "#\\(") 3)
+(test (string-length ")()") 3)
+(test (string-length "(()") 3)
+(test (string-length "(string #\\( #\\+ #\\space #\\1 #\\space #\\3 #\\))") 44)
+(test (string-length) 'error)
+(test (string-length "hi" "ho") 'error)
+(test (string-length (string #\null)) 1) ; ?
+(test (string-length (string #\null #\null)) 2) ; ?
+(test (string-length (string #\null #\newline)) 2) ; ?
+(test (string-length ``"hi") 2) ; ?? and in s7 ,"hi" is "hi" as with numbers
+
+(test (string-length ";~S ~S") 6)
+(test (string-length "\n;~S ~S") 7)
+(test (string-length "\n\t") 2)
+(test (string-length "#\newline") 8)
+(test (string-length "#\tab") 4)
+(test (string-length "a\x00;b") 3)
+
+(test (string-length "123\
+456") 6)
+(test (string-length"123\n
+456") 8)
+(test (string-length"123\n\
+456") 7)
+
+(for-each
+ (lambda (arg)
+   (test (string-length arg) 'error))
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+
+(test (string? "[a-zA-Z_\x7f-\xff][a-zA-Z0-9_\x7f-\xff]*") #t)
+(test (format #f "\x7f;~a" 1) (string #\delete #\1))
+(test (format #f "\x00;~a\xff;" 1) (string #\null #\1 #\xff))
+(test (format #f "\x44;") "D")
+(test (format #f "\x44") "D")
+(test (format #f "\x44;o") "Do")
+(test (format #f "\x9") (string #\tab))
+
+(test (string? "\x7") #t)
+(test (string? "\x7f") #t)
+(test (string? "\x7ff") #t)
+(test (string? "\x7fff") #t)
+(test (string? "\x7fff") #t)
+;(test (string? "\xH") 'error)
+;(string? "\x7H") ; an error in Guile
+(test (string? "\x7fH") #t)
+(test (string? "\x7ffH") #t)
+(test (string? "\x7fffH") #t)
+(test (string? "\x7fffH") #t)
+
+;;; what is correct here? r7rs seems to say the semicolon is needed if we're in a string constant??
+;;;    tests changed to include semicolon 1-Mar-22
+
+
+;;; --------------------------------------------------------------------------------
+;;; string
+
+(for-each
+ (lambda (arg)
+   (test (string #\a arg) 'error)
+   (test (string #\a #\null arg) 'error)
+   (test (string arg) 'error))
+ (list () (list 1) '(1 . 2) "a" #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (string) "")
+(test (string #\a #\b #\c) "abc")
+(test (string #\a) "a")
+(test (map string '(#\a #\b)) '("a" "b"))
+(test (map string '(#\a #\b) '(#\c #\d)) '("ac" "bd"))
+(test (map string '(#\a #\b #\c) '(#\d #\e #\f) '(#\g #\h #\i)) '("adg" "beh" "cfi"))
+(test (map string "abc" "def" "ghi") '("adg" "beh" "cfi"))
+(test (string #\" #\# #\") "\"#\"")
+(test (string #\\ #\\ #\# #\\ #\# #\#) "\\\\#\\##")
+(test (string #\' #\' #\` #\") '"''`\"")
+;;; some schemes accept \' and other such sequences in a string, but the spec only mentions \\ and \"
+(test (string ()) 'error)
+(test (string "j" #\a) 'error)
+(test (string (values #\a #\b #\c)) "abc")
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; make-string
+
+(test (make-string 0) "")
+(test (make-string 3 #\a) "aaa")
+(test (make-string 0 #\a) "")
+(test (make-string 3 #\space) "   ")
+(test (let ((hi (make-string 3 #\newline))) (string-length hi)) 3)
+(test (make-string (* 8796093022208 8796093022208)) 'error)
+(test (make-string 8796093022208) 'error)
+
+(test (make-string -1) 'error)
+(test (make-string -0) "")
+(test (make-string 2 #\a #\b) 'error)
+(test (make-string) 'error)
+(test (make-string most-positive-fixnum) 'error)
+(test (make-string most-negative-fixnum) 'error)
+(let () (define (hi size) (make-string size (integer->char (+ 1 (random 255))))) (string? (hi 3)))
+
+(for-each
+ (lambda (arg)
+   (test (make-string 3 arg) 'error))
+ (list "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+   (test (make-string arg #\a) 'error))
+ (list #\a "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+   (test (make-string arg) 'error))
+ (list #\a "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (make-string 0 #f) 'error)
+
+(let ((strs (vector "a"))) ; make_string_p_i from tbig
+  (define (string-sorter)
+    (do ((i 0 (+ i 1)))
+	((= i 1) strs)
+      (copy (vector-ref strs i) (make-string 1))
+      (copy (vector-ref strs i) (make-string 0))))
+  (string-sorter))
+
+
+;;; --------------------------------------------------------------------------------
+;;; string-ref
+
+(test (string-ref "abcdef-dg1ndh" 0) #\a)
+(test (string-ref "abcdef-dg1ndh" 1) #\b)
+(test (string-ref "abcdef-dg1ndh" 6) #\-)
+(test (string-ref "\"\\\"" 1) #\\)
+(test (string-ref "\"\\\"" 2) #\")
+
+(test (let ((str (make-string 3 #\x))) (set! (string-ref str 1) #\a) str) "xax")
+
+(test (string-ref "abcdef-dg1ndh" 20) 'error)
+(test (string-ref "abcdef-dg1ndh") 'error)
+(test (string-ref "abcdef-dg1ndh" -3) 'error)
+(test (string-ref) 'error)
+(test (string-ref 2) 'error)
+(test (string-ref "\"\\\"" 3) 'error)
+(test (string-ref "" 0) 'error)
+(test (string-ref "" 1) 'error)
+(test (string-ref "hiho" (expt 2 32)) 'error)
+(test (char=? (string-ref (string #\null) 0) #\null) #t)
+(test (char=? (string-ref (string #\1 #\null #\2) 1) #\null) #t)
+(test (char=? ("1\x002;" 1) #\null) #t)
+(test (char=? (string-ref (string #\newline) 0) #\newline) #t)
+(test (char=? (string-ref (string #\space) 0) #\space) #t)
+
+(for-each
+ (lambda (arg)
+   (test (string-ref arg 0) 'error))
+ (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+   (test (string-ref "hiho" arg) 'error))
+ (list #\a -1 123 4 "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test ("hi" 1) #\i)
+(test (("hi" 1) 0) 'error)
+(test ("hi" 1 2) 'error)
+(test ("" 0) 'error)
+(test (set! ("" 0) #\a) 'error)
+(test (set! ("hi" 1 2) #\a) 'error)
+(test (set! ("hi" 1) #\a #\b) 'error)
+(test ("hi") 'error)
+(test ("") 'error)
+(test ((let () "hi")) 'error)
+(test ((let () "hi") 0) #\h)
+
+(test ("abs" most-negative-fixnum) 'error)
+(test (string-ref "abs" most-negative-fixnum) 'error)
+(test ("abs" (+ 1 most-negative-fixnum)) 'error)
+(test ("abs" most-positive-fixnum) 'error)
+(test (catch #t (lambda () ("hi" 1 2)) (lambda (t i) (apply format #f i)))  "string ref: too many indices: (\"hi\" 1 2)")
+
+(let ((strs (vector "abc")) ; string_ref_p_pi
+      (str #f))
+  (define (string-sorter)
+    (do ((i 0 (+ i 1)))
+	((= i 1) str)
+      (set! str (string (string-ref strs i)))))
+  (test (string-sorter) 'error))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; string-copy
+
+(test (let ((hi (string-copy "hi"))) (string-set! hi 0 #\H) hi) "Hi")
+(test (let ((hi (string-copy "hi"))) (string-set! hi 1 #\H) hi) "hH")
+(test (let ((hi (string-copy "\"\\\""))) (string-set! hi 0 #\a) hi) "a\\\"")
+(test (let ((hi (string-copy "\"\\\""))) (string-set! hi 1 #\a) hi) "\"a\"")
+(test (let ((hi (string #\a #\newline #\b))) (string-set! hi 1 #\c) hi) "acb")
+(test (string-copy "ab") "ab")
+(test (string-copy "") "")
+(test (string-copy "\"\\\"") "\"\\\"")
+(test (let ((hi "abc")) (eq? hi (string-copy hi))) #f)
+(test (let ((hi (string-copy (make-string 8 (integer->char 0))))) (string-fill! hi #\a) hi) "aaaaaaaa")
+(test (string-copy (string-copy (string-copy "a"))) "a")
+(test (string-copy (string-copy (string-copy ""))) "")
+(test (string-copy "a\x00;b") "a\x00;b") ; prints normally as "a" however
+(test (string-copy (string #\1 #\null #\2)) (string #\1 #\null #\2))
+(test (string-copy) 'error)
+(test (string-copy "hi" (immutable! "ho")) 'error)
+(test (string-copy "hi" (make-string 4 #\.) 0) "hi..")
+(test (string-copy "hi" (make-string 4 #\.) 1) ".hi.")
+(test (string-copy "hi" (make-string 4 #\.) 2) "..hi")
+(test (string-copy "hi" (make-string 4 #\.) 3) "...h")
+(test (string-copy "hi" (make-string 4 #\.) 4) "....")
+(test (string-copy "hi" (make-string 4 #\.) 1 1) "....")
+(test (string-copy "hi" (make-string 4 #\.) 1 2) ".h..")
+(test (string-copy "hi" (make-string 4 #\.) 1 3) ".hi.")
+(test (string-copy "hi" (make-string 4 #\.) 1 4) ".hi.")
+(test (string-copy "hi" "asdf") "hidf")
+(test (string-copy "" (make-string 4 #\.)) "....")
+(test (string-copy "ho" "") "")
+(test (string-copy "ho" ".") "h")
+(test (let () (define (func) (string-copy "abc" (substring "0123" 1))) (func)) "abc") ; string_substring_chooser incorrectly from string_copy
+
+(for-each
+ (lambda (arg)
+   (test (string-copy arg) 'error)
+   (test (string-copy "hi" arg) 'error))
+ (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (length (string-copy (string #\null))) 1)
+(test (string-copy "hi" (make-string 4 #\.) "ho") 'error)
+(test (string-copy "hi" (make-string 4 #\.) 1 "ho") 'error)
+
+
+;;; --------------------------------------------------------------------------------
+;;; string-set!
+
+(let ((str (make-string 10 #\x)))
+  (string-set! str 3 (integer->char 0))
+  (test (string=? str "xxx") #f)
+  (test (char=? (string-ref str 4) #\x) #t)
+  (string-set! str 4 #\a)
+  (test (string=? str "xxx") #f)
+  (test (char=? (string-ref str 4) #\a) #t)
+  (string-set! str 3 #\x)
+  (test (string=? str "xxxxaxxxxx") #t))
+
+(test (string-set! "hiho" 1 #\c) #\c)
+(test (set! ("hi" 1 2) #\i) 'error)
+(test (set! ("hi" 1) "ho") 'error)
+(test (set! ("hi") #\i) 'error)
+(test (let ((x "hi") (y 'x)) (string-set! y 0 #\x) x) 'error)
+(test (let ((str "ABS")) (set! (str 0) #\a)) #\a)
+(test (let ((str "ABS")) (string-set! str 0 #\a)) #\a)
+(test (let ((str "ABS")) (set! (string-ref str 0) #\a)) #\a)
+
+(test (let ((hi (make-string 3 #\a)))
+	(string-set! hi 1 (let ((ho (make-string 4 #\x)))
+			    (string-set! ho 1 #\b)
+			    (string-ref ho 0)))
+	hi)
+      "axa")
+
+(test (string-set! "hiho" (expt 2 32) #\a) 'error)
+
+(test (let ((hi (string-copy "hi"))) (string-set! hi 2 #\H) hi) 'error)
+(test (let ((hi (string-copy "hi"))) (string-set! hi -1 #\H) hi) 'error)
+(test (let ((g (lambda () "***"))) (string-set! (g) 0 #\?)) #\?)
+(test (string-set! "" 0 #\a) 'error)
+(test (string-set! "" 1 #\a) 'error)
+(test (string-set! (string) 0 #\a) 'error)
+(test (string-set! (symbol->string 'lambda) 0 #\a) #\a)
+(test (let ((ho (make-string 0 #\x))) (string-set! ho 0 #\a) ho) 'error)
+(test (let ((str "hi")) (string-set! (let () str) 1 #\a) str) "ha") ; (also in Guile)
+(test (let ((x 2) (str "hi")) (string-set! (let () (set! x 3) str) 1 #\a) (list x str)) '(3 "ha"))
+(test (let ((str "hi")) (set! ((let () str) 1) #\b) str) "hb")
+(test (let ((str "hi")) (string-set! (let () (string-set! (let () str) 0 #\x) str) 1 #\x) str) "xx")
+(test (let ((str "hi")) (string-set! (let () (set! str "hiho") str) 3 #\x) str) "hihx") ; ! (this works in Guile also)
+
+(for-each
+ (lambda (arg)
+   (test (string-set! arg 0 #\a) 'error))
+ (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+   (test (string-set! "hiho" arg #\a) 'error))
+ (list #\a -1 123 4 "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+   (test (string-set! "hiho" 0 arg) 'error))
+ (list 1 "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (equal? (let ((str "hiho")) (string-set! str 2 #\null) str) "hi") #f)
+(test (string=? (let ((str "hiho")) (string-set! str 2 #\null) str) "hi") #f)
+(test (let* ((s1 "hi") (s2 s1)) (string-set! s2 1 #\x) s1) "hx")
+(test (let* ((s1 "hi") (s2 (copy s1))) (string-set! s2 1 #\x) s1) "hi")
+
+(test (eq? (car (catch #t (lambda () (set! ("hi") #\a)) (lambda args args))) 'wrong-number-of-args) #t)
+(test (eq? (car (catch #t (lambda () (set! ("hi" 0 0) #\a)) (lambda args args))) 'wrong-number-of-args) #t) ; (vector-set! 1 ...)
+(test (eq? (car (catch #t (lambda () (set! (("hi" 0) 0) #\a)) (lambda args args))) 'no-setter) #t) ; (set! (1 ...))
+
+(test (let ((s "012345")) (set! (apply s 2) #\a) s) 'error)
+(test (string-set! #u(0 1 0) 0 -9223372036854775808) 'error)
+
+(let () (define (hi) (let ((str "123")) (set! (str 0) (values #\a #\b)) str)) (test (begin (hi) (hi)) 'error))
+(let () (define (hi) (let ((str "123")) (set! (str 0) (values #\a #\b)) str)) (test (begin (catch #t hi (lambda a a)) (hi)) 'error))
+(test (let ((str "asdf")) (define (func) (set! (str) "asdf")) (catch #t func (lambda args #f)) (func)) 'error)
+(test (let ((v "asdf")) (define (func) (set! (v) "asdf" #\a)) (catch #t func (lambda args #f)) (func)) 'error)
+
+;; similar tests for other types
+(test (let ((v (vector 1 2))) (define (func) (set! (v) 1)) (catch #t func (lambda args #f)) (func)) 'error)
+(test (let ((v (vector 1 2))) (define (func) (set! (v) #(0) 1)) (catch #t func (lambda args #f)) (func)) 'error)
+(test (let ((v (int-vector 1 2))) (define (func) (set! (v) #(0) 1)) (catch #t func (lambda args #f)) (func)) 'error)
+(test (let ((v (int-vector 1 2))) (define (func) (set! (v) #(0))) (catch #t func (lambda args #f)) (func)) 'error)
+(test (let ((v (float-vector 1 2))) (define (func) (set! (v) #(0) 1)) (catch #t func (lambda args #f)) (func)) 'error)
+(test (let ((v (float-vector 1 2))) (define (func) (set! (v) #(0))) (catch #t func (lambda args #f)) (func)) 'error)
+(test (let ((v (hash-table 'a 1))) (define (func) (set! (v) 'a 1)) (catch #t func (lambda args #f)) (func)) 'error)
+(test (let ((v (hash-table 'a 1))) (define (func) (set! (v) 1)) (catch #t func (lambda args #f)) (func)) 'error)
+(test (let ((v (hash-table 'a 1))) (define (func) (set! (v) (hash-table 'b 1) 1)) (catch #t func (lambda args #f)) (func)) 'error)
+(when with-block (test (let ((v (block 1))) (define (func) (set! (v) (block 1))) (catch #t func (lambda args #f)) (func)) 'error))
+(when with-block (test (let ((v (block 1))) (define (func) (set! (v) (block 1) 1)) (catch #t func (lambda args #f)) (func)) 'error))
+(test (let ((v (inlet 'a 1))) (define (func) (set! (v) (inlet 'b 2))) (catch #t func (lambda args #f)) (func)) 'error)
+(test (let ((v (inlet 'a 1))) (define (func) (set! (v) (inlet 'b 2) 2)) (catch #t func (lambda args #f)) (func)) 'error)
+(test (let ((v (list 1 2))) (define (func) (set! (v) (list 1))) (catch #t func (lambda args #f)) (func)) 'error)
+(test (let ((v (hash-table 'a 1))) (define (func) (set! (v) (hash-table 'b 1))) (catch #t func (lambda args #f)) (func)) 'error)
+
+(when with-block
+  (let ((B (block 1 2 3))) ; c_obj_to_list
+    (define (f2) (format #f "~{~S ~}" B))
+    (test (f2) "1.0 2.0 3.0 "))
+  (let ((B (make-c-tag1))) ; s7_copy_1 if obj has 'copy method in method list, but not built-in copy
+    (define (f3) (copy B (vector 0 0 0)))
+    (test (f3) 123))
+  (let ((B (make-simple-block 3))) ; s7_copy_1 if obj has no methods or built-in copy -> c_object_getter (will need ref/set funcs)
+    (define (f4) (copy B (vector 0 0 0)))
+    (test (f4) #(0.0 0.0 0.0))))
+
+
+;;; --------------------------------------------------------------------------------
+;;; string-fill!
+
+(test (string-fill! "hiho" #\c) #\c)
+(test (string-fill! "" #\a) #\a)
+(test (string-fill! "hiho" #\a) #\a)
+(test (let ((g (lambda () "***"))) (string-fill! (g) #\?)) #\?)
+(test (string-fill!) 'error)
+(test (string-fill! "hiho" #\a #\b) 'error)
+
+(test (let ((hi (string-copy "hi"))) (string-fill! hi #\s) hi) "ss")
+(test (let ((hi (string-copy ""))) (string-fill! hi #\x) hi) "")
+(test (let ((str (make-string 0))) (string-fill! str #\a) str) "")
+(test (let ((hi (make-string 8 (integer->char 0)))) (string-fill! hi #\a) hi) "aaaaaaaa") ; is this result widely accepted?
+(test (recompose 12 string-copy "xax") "xax")
+(test (let ((hi (make-string 3 #\x))) (recompose 12 (lambda (a) (string-fill! a #\a) a) hi)) "aaa")
+(test (let ((hi (make-string 3 #\x))) (recompose 12 (lambda (a) (string-fill! hi a)) #\a) hi) "aaa")
+(test (let ((str (string #\null #\null))) (fill! str #\x) str) "xx")
+
+(for-each
+ (lambda (arg)
+   (test (let ((hiho "hiho")) (string-fill! hiho arg) hiho) 'error))
+ (list 1 "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+   (test (string-fill! arg #\a) 'error))
+ (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (let ((str "1234567890")) (string-fill! str #\a 0) str) "aaaaaaaaaa")
+(test (let ((str "1234567890")) (string-fill! str #\a 0 10) str) "aaaaaaaaaa")
+(test (let ((str "1234567890")) (string-fill! str #\a 0 0) str) "1234567890")
+(test (let ((str "1234567890")) (string-fill! str #\a 4 4) str) "1234567890")
+(test (let ((str "1234567890")) (string-fill! str #\a 10 10) str) "1234567890")
+(test (let ((str "1234567890")) (string-fill! str #\a 0 4) str) "aaaa567890")
+(test (let ((str "1234567890")) (string-fill! str #\a 3 4) str) "123a567890")
+(test (let ((str "1234567890")) (string-fill! str #\a 1 9) str) "1aaaaaaaa0")
+(test (let ((str "1234567890")) (string-fill! str #\a 8) str) "12345678aa")
+(test (let ((str "1234567890")) (string-fill! str #\a 1 9 0) str) 'error)
+(test (let ((str "1234567890")) (string-fill! str #\a 1 0) str) 'error)
+(test (let ((str "1234567890")) (string-fill! str #\a 11) str) 'error)
+(test (let ((str "1234567890")) (string-fill! str #\a 9 11) str) 'error)
+(test (string-fill! "" 0 "hi") 'error)
+(test (string-fill! "" 0 -1 3) 'error)
+(test (string-fill! "" 0 1) 'error)
+(test (string-fill! "" 0 0 4/3) 'error)
+(test (string-fill! "aaa" #\b #f) 'error)
+(test (string-fill! "aaa" #\b 1 #f) 'error)
+(test (string-fill! "aaa" #\b #f 1) 'error)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; string-upcase
+;;; string-downcase
+
+(test (string-downcase "") "")
+(test (string-downcase "a") "a")
+(test (string-downcase "A") "a")
+(test (string-downcase "AbC") "abc")
+(test (string-downcase "\"\\\"") "\"\\\"")
+(test (let ((hi "abc")) (eq? hi (string-downcase hi))) #f)
+(test (string-downcase (string-upcase (string-downcase "a"))) "a")
+(test (string-downcase "a\x00;b") "a\x00;b")
+(test (string-downcase (string #\1 #\null #\2)) (string #\1 #\null #\2))
+(test (string-downcase) 'error)
+(test (string-downcase "hi" "ho") 'error)
+
+(test (string-upcase "") "")
+(test (string-upcase "a") "A")
+(test (string-upcase "A") "A")
+(test (string-upcase "AbC") "ABC")
+(test (string-upcase "\"\\\"") "\"\\\"")
+(test (let ((hi "ABC")) (eq? hi (string-upcase hi))) #f)
+(test (string-upcase (string-downcase (string-upcase "a"))) "A")
+(test (string-upcase "a\x00;b") "A\x00;B")
+(test (string-upcase (string #\1 #\null #\2)) (string #\1 #\null #\2))
+(test (string-upcase) 'error)
+ (test (string-upcase "hi" "ho") 'error)
+
+(for-each
+ (lambda (arg)
+   (test (string-downcase arg) 'error)
+   (test (string-upcase arg) 'error))
+ (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (string-upcase (make-string 132 #\a)) (make-string 132 #\A)) ; loop limit in g_string_upcase
+(test (string-downcase (make-string 132 #\A)) (make-string 132 #\a)) ; loop limit in g_string_downcase
+
+;;; for r7rs, these need to be unicode-aware
+
+;;; --------------------------------------------------------------------------------
+;;; substring
+;;; substring-uncopied
+
+(test (substring "ab") "ab")
+(test (substring "ab" 0 0) "")
+(test (substring "ab" 1 1) "")
+(test (substring "ab" 2 2) "")
+(test (substring "ab" 0 1) "a")
+(test (substring "ab" 1 2) "b")
+(test (substring "ab" 0 2) "ab")
+(test (substring "hi there" 3 6) "the")
+(test (substring "hi there" 0 (string-length "hi there")) "hi there")
+(test (substring "" 0 0) "")
+(let ((str "012345"))
+  (let ((str1 (substring str 2 4)))
+    (string-set! str1 1 #\x)
+    (test (string=? str "012345") #t)
+    (let ((str2 (substring str1 1)))
+      (set! (str2 0) #\z)
+      (test (string=? str "012345") #t)
+      (test (string=? str1 "2x") #t)
+      (test (string=? str2 "z") #t))))
+(test (substring (substring "hiho" 0 2) 1) "i")
+(test (substring (substring "hiho" 0 2) 2) "")
+(test (substring (substring "hiho" 0 2) 0 1) "h")
+(test (substring "hi\nho" 3 5) "ho")
+(test (substring (substring "hi\nho" 1 4) 2) "h")
+(test (substring (substring "hi\nho" 3 5) 1 2) "o")
+(test (substring "hi\"ho" 3 5) "ho")
+(test (substring (substring "hi\"ho" 1 4) 2) "h")
+(test (substring (substring "hi\"ho" 3 5) 1 2) "o")
+(test (let* ((s1 "0123456789") (s2 (substring s1 1 3))) (string-set! s2 1 #\x) s1) "0123456789")
+(test (substring (substring "" 0 0) 0 0) "")
+(test (substring (format #f "") 0 0) "")
+(test (string=? (substring (substring (substring "01234567" 1) 1) 1) "34567") #t)
+(let ()
+  (define (hi) (string=? (substring (substring (substring "01234567" 1) 1) 1) "34567"))
+  (define (ho) (hi)) (ho)
+  (test (ho) #t))
+
+(test (substring "012" 3) "")
+(test (substring "012" 10) 'error)
+(test (substring "012" most-positive-fixnum) 'error)
+(test (substring "012" -1) 'error)
+(test (substring "012" 3 3) "")
+(test (substring "012" 3 4) 'error)
+(test (substring "012" 3 2) 'error)
+(test (substring "012" 3 -2) 'error)
+(test (substring "012" 3 0) 'error)
+(test (substring "012" 0) "012")
+(test (substring "012" 2) "2")
+(test (substring "" 0) "")
+
+(test (recompose 12 (lambda (a) (substring a 0 3)) "12345") "123")
+(test (reinvert 12 (lambda (a) (substring a 0 3)) (lambda (a) (string-append a "45")) "12345") "12345")
+
+(test (substring "ab" 0 3) 'error)
+(test (substring "ab" 3 3) 'error)
+(test (substring "ab" 2 3) 'error)
+(test (substring "" 0 1) 'error)
+(test (substring "" -1 0) 'error)
+(test (substring "abc" -1 0) 'error)
+(test (substring "hiho" (expt 2 32) (+ 2 (expt 2 32))) 'error)
+(test (substring) 'error)
+(test (substring "hiho" 0 1 2) 'error)
+(test (substring "1234" -1 -1) 'error)
+(test (substring "1234" 1 0) 'error)
+(test (substring "" most-positive-fixnum 1) 'error)
+
+(let ((str "0123456789"))
+  (string-set! str 5 #\null)
+  (test (substring str 6) "6789")
+  (test (substring str 5 5) "")
+  (test (substring str 4 5) "4")
+  (test (substring str 5 6) "\x00;")
+  (test (substring str 5 7) "\x00;6")
+  (test (substring str 4 7) "4\x00;6"))
+
+(for-each
+ (lambda (arg)
+   (test (substring "hiho" arg 0) 'error))
+ (list "hi" #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+   (test (substring "0123" arg) 'error)
+   (test (substring "hiho" 1 arg) 'error))
+ (list "hi" #\a -1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+   (test (substring arg 1 2) 'error))
+ (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(define (substring? pattern target) ; taken from net somewhere (umich?) with changes for s7 (which now has string-position, so this is unneeded)
+  (define (build-shift-vector pattern)
+    (let* ((pat-len (length pattern))
+	   (shift-vec (make-vector 256 (+ pat-len 1)))
+	   (max-pat-index (- pat-len 1)))
+      (let loop ((index 0))
+	(set! (shift-vec (char->integer (pattern index))) (- pat-len index))
+	(if (< index max-pat-index)
+	    (loop (+ index 1))
+	    shift-vec))))
+  (if (or (not (string? pattern))
+	  (not (string? target)))
+      (error 'wrong-type-arg "substring? args should be strings: ~S ~S" pattern target)
+      (let ((pat-len (length pattern)))
+	(if (zero? pat-len)
+	    0
+	    (let ((shift-vec (build-shift-vector pattern)))
+	      (let* ((tar-len (length target))
+		     (max-tar-index (- tar-len 1))
+		     (max-pat-index (- pat-len 1)))
+		(let outer ((start-index 0))
+		  (and (<= (+ pat-len start-index) tar-len)
+		       (let inner ((p-ind 0) (t-ind start-index))
+			 (cond
+			  ((> p-ind max-pat-index) #f)           ; nothing left to check
+			  ((char=? (pattern p-ind) (target t-ind))
+			   (if (= p-ind max-pat-index)
+			       start-index                       ; success -- return start index of match
+			       (inner (+ p-ind 1) (+ t-ind 1)))) ; keep checking
+			  ((> (+ pat-len start-index) max-tar-index) #f) ; fail
+			  (else (outer (+ start-index (shift-vec (char->integer (target (+ start-index pat-len)))))))))))))))))
+
+(test (substring? "hiho" "test hiho test") 5)
+(test (substring? "hiho" "test hihptest") #f)
+(test (substring? "hiho" "test hih") #f)
+(test (substring? "hiho" "") #f)
+(test (substring? "hiho" "hiho") 0)
+(test (substring? "" "hiho") 0)
+(test (substring? "abc" 'abc) 'error)
+(test (substring "123345" (ash 1 32)) 'error)
+(test (substring "123345" 0 (ash 1 32)) 'error)
+(test (substring "123345" 8796093022208) 'error)
+
+(let ((str (string #\a #\b #\c)))
+  (test (substring-uncopied str) str)
+  (test (substring-uncopied str 1) "bc")
+  (let ((str1 (substring-uncopied str 1)))
+    (test str1 "bc")
+    (test (set! (str1 0) #\d) 'error))) ; wrap_string wrappers are immutable
+
+
+;;; --------------------------------------------------------------------------------
+;;; string-append
+
+(test (string-append "hi" "ho") "hiho")
+(test (string-append "hi") "hi")
+(test (string-append "hi" "") "hi")
+(test (string-append "hi" "" "ho") "hiho")
+(test (string-append "" "hi") "hi")
+(test (string-append) "")
+(test (string-append "a" (string-append (string-append "b" "c") "d") "e") "abcde")
+(test (string-append "a" "b" "c" "d" "e") "abcde")
+(test (string-append (string-append) (string-append (string-append))) "")
+(test (let ((hi "hi")) (let ((ho (string-append hi))) (eq? hi ho))) #f)
+(test (let ((hi "hi")) (let ((ho (string-append hi))) (string-set! ho 0 #\a) hi)) "hi")
+(test (let ((hi "hi")) (set! hi (string-append hi hi hi hi)) hi) "hihihihi")
+(test (string-append ()) 'error)
+(test (string=? (string-append "012" (string #\null) "456")
+		(let ((str "0123456")) (string-set! str 3 #\null) str))
+      #t)
+(test (string=? (string-append "012" (string #\null) "356")
+		(let ((str "0123456")) (string-set! str 3 #\null) str))
+      #f)
+(test (string-append """hi""ho""") "hiho")
+(test (let* ((s1 "hi") (s2 (string-append s1 s1))) (string-set! s2 1 #\x) s1) "hi")
+(test (let* ((s1 "hi") (s2 (string-append s1))) (string-set! s2 1 #\x) s1) "hi")
+(test (length (string-append (string #\x #\y (integer->char 127) #\z) (string #\a (integer->char 0) #\b #\c))) 8)
+
+(test (length (string-append "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc")) 915)
+(test (length (string-append (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c))) 915)
+
+
+(num-test (letrec ((hi (lambda (str n)
+			 (if (= n 0)
+			     str
+			     (hi (string-append str "a") (- n 1))))))
+	    (string-length (hi "" 100)))
+	  100)
+
+(test (let* ((str "hiho")
+	     (str1 "ha")
+	     (str2 (string-append str1 str)))
+	(string-set! str2 1 #\x)
+	(string-set! str2 4 #\x)
+	(and (string=? str "hiho")
+	     (string=? str1 "ha")
+	     (string=? str2 "hxhixo")))
+      #t)
+(test (let* ((str (string-copy "hiho"))
+	     (str1 (string-copy "ha"))
+	     (str2 (string-append str1 str)))
+	(string-set! str1 1 #\x)
+	(string-set! str 2 #\x)
+	(and (string=? str "hixo")
+	     (string=? str1 "hx")
+	     (string=? str2 "hahiho")))
+      #t)
+
+(let ((s1 (string #\x #\null #\y))
+      (s2 (string #\z #\null)))
+  (test (string=? (string-append s1 s2) (string #\x #\null #\y #\z #\null)) #t)
+  (test (string=? (string-append s2 s1) (string #\z #\null #\x #\null #\y)) #t))
+
+(test (recompose 12 string-append "x") "x")
+(test (recompose 12 (lambda (a) (string-append a "x")) "a") "axxxxxxxxxxxx")
+(test (recompose 12 (lambda (a) (string-append "x" a)) "a") "xxxxxxxxxxxxa")
+
+(test (length (string-append "\\?" "hi")) 4)
+(test (string-append "hi" 1) 'error)
+(test (eval-string "(string-append \"\\?\")") 'error) ; guile mailing list
+(test (eval-string "(string-append \"\\?\" \"hi\")") 'error) ; guile mailing list
+(for-each
+ (lambda (arg)
+   (test (string-append "hiho" arg) 'error)
+   (test (string-append arg "hi") 'error)
+   (test (string-append "a" "b" arg) 'error))
+ (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(let ()
+  (define (f) (string-append (string-append (string))))
+  (test (byte-vector? (f)) #f)
+  (test (byte-vector? (f)) #f))
+
+(let ()
+  (define (f) (string-append (string-append (string #\a #\b))))
+  (test (byte-vector? (f)) #f)
+  (test (byte-vector? (f)) #f))
+
+(test (append #u(0 1 2 3) #u(4 5 6)) #u(0 1 2 3 4 5 6))
+
+
+
+;;; --------------------------------
+(test (let ((str (make-string 4 #\x))
+	    (ctr 0))
+	(for-each
+	 (lambda (c)
+	   (string-set! str ctr c)
+	   (set! ctr (+ ctr 1)))
+	 "1234")
+	str)
+      "1234")
+
+(test (let ((str (make-string 8 #\x))
+	    (ctr 0))
+	(for-each
+	 (lambda (c1 c2)
+	   (string-set! str ctr c1)
+	   (string-set! str (+ ctr 1) c2)
+	   (set! ctr (+ ctr 2)))
+	 "1234"
+	 "hiho")
+	str)
+      "1h2i3h4o")
+
+#|
+(let ((size 1024))
+  (let ((str (make-string size)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (set! (str i) (integer->char (+ 1 (modulo i 255)))))
+    (let ((str1 (string-copy str)))
+      (test (string? str1) #t)
+      (test (string-length str1) 1024)
+      (test (string-ref str1 556) (string-ref str 556))
+      (test (string=? str str1) #t)
+      (test (string<=? str str1) #t)
+      (test (string>=? str str1) #t)
+      (test (string-ci=? str str1) #t)
+      (test (string-ci<=? str str1) #t)
+      (test (string-ci>=? str str1) #t)
+      (test (string<? str str1) #f)
+      (test (string>? str str1) #f)
+      (test (string-ci<? str str1) #f)
+      (test (string-ci>? str str1) #f)
+      (test (substring str 123 321) (substring str1 123 321))
+
+      (string-set! str1 1000 #\space)
+      (test (string=? str str1) #f)
+      (test (string<=? str str1) #f)
+      (test (string>=? str str1) #t)
+      (test (string-ci=? str str1) #f)
+      (test (string-ci<=? str str1) #f)
+      (test (string-ci>=? str str1) #t)
+      (test (string<? str str1) #f)
+      (test (string>? str str1) #t)
+      (test (string-ci<? str str1) #f)
+      (test (string-ci>? str str1) #t)
+
+      (test (string-length (string-append str str1)) 2048)
+      ))))
+|#
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; string->list
+;;; list->string
+
+(test (string->list "abc") (list #\a #\b #\c))
+(test (string->list "") ())
+(test (string->list (make-string 0)) ())
+(test (string->list (string #\null)) '(#\null))
+(test (string->list (string)) ())
+(test (string->list (substring "hi" 0 0)) ())
+(test (string->list (list->string (list #\a #\b #\c))) (list #\a #\b #\c))
+(test (string->list (list->string ())) ())
+(test (list->string (string->list "abc")) "abc")
+(test (list->string (string->list "hi there")) "hi there")
+(test (list->string (string->list "&*#%^@%$)~@")) "&*#%^@%$)~@")
+(test (list->string (string->list "")) "")
+(test (let* ((str "abc")
+	     (lst (string->list str)))
+	(and (string=? str "abc")
+	     (equal? lst (list #\a #\b #\c))))
+      #t)
+(test (list->string ()) "")
+
+(test (list->string (list #\a #\b #\c)) "abc")
+(test (list->string (list)) "")
+
+(test (list->string (list #\" #\# #\")) "\"#\"")
+(test (list->string (list #\\ #\\ #\# #\\ #\# #\#)) "\\\\#\\##")
+(test (list->string (list #\' #\' #\` #\")) '"''`\"")
+
+(test (reinvert 12 string->list list->string "12345") "12345")
+
+(test (string->list) 'error)
+(test (list->string) 'error)
+(test (string->list "hi" "ho") 'error)
+(test (list->string () '(1 2)) 'error)
+(test (apply list->string '(#\a . #\b)) 'error)
+(test (list->string #\a . #\b) 'error)
+(test (let ((lst (cons #\a #\b))) (list->string lst)) 'error)
+(test (string->list " hi ") '(#\space #\h #\i #\space))
+(test (string->list (string (integer->char #xf0) (integer->char #x70))) (list (integer->char #xf0) (integer->char #x70)))
+
+(for-each
+ (lambda (arg)
+   (test (string->list arg) 'error))
+ (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (let ((x (cons #\a #\b))) (set-cdr! x x) (list->string x)) 'error)
+(test (let ((lst (list #\a #\b))) (set! (cdr (cdr lst)) lst) (list->string lst)) 'error)
+(test (let ((lst (list #\a #\b))) (set! (cdr (cdr lst)) lst) (apply string lst)) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (list->string arg) 'error))
+ (list "hi" #\a 1 ''foo '(1 . 2) (cons #\a #\b) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(let ((str (list->string '(#\x #\space #\null #\x))))
+  (test (length str) 4)
+  (test (str 1) #\space)
+  (test (str 2) #\null)
+  (test (str 3) #\x)
+  (test (object->string str) "\"x \\x00;x\"")
+  (let ((lst (string->list str)))
+    (test lst '(#\x #\space #\null #\x))))
+
+(let ((strlen 8))
+  (let ((str (make-string strlen)))
+    (do ((i 0 (+ i 1)))
+	((= i 10))
+      (do ((k 0 (+ k 1)))
+	  ((= k strlen))
+	(set! (str k) (integer->char (random 256))))
+      (let ((lst (string->list str)))
+	(let ((newstr (list->string lst)))
+	  (let ((lstlen (length lst))
+		(newstrlen (length newstr)))
+	    (if (or (not (= lstlen strlen newstrlen))
+		    (not (string=? newstr str)))
+		(format #t ";string->list->string: ~S -> ~A -> ~S~%" str lst newstr))))))))
+
+(when full-s7test
+  (let ()
+    (define (all-strs len file)
+      (let* ((funny-chars (list #\` #\# #\, #\@ #\' #\" #\. #\( #\) #\\))
+	     (num-chars (length funny-chars)))
+	(let ((ctrs (make-vector len 0)))
+
+	  (do ((i 0 (+ i 1)))
+	      ((= i (expt num-chars len)))
+	    (let ((carry #t))
+	      (do ((k 0 (+ k 1)))
+		  ((or (= k len)
+		       (not carry)))
+		(vector-set! ctrs k (+ 1 (vector-ref ctrs k)))
+		(if (= (vector-ref ctrs k) num-chars)
+		    (vector-set! ctrs k 0)
+		    (set! carry #f)))
+
+	      (let ((strlst ()))
+		(do ((k 0 (+ k 1)))
+		    ((= k len))
+		  (let ((c (list-ref funny-chars (vector-ref ctrs k))))
+		    (set! strlst (cons c strlst))))
+
+		(let ((str (list->string strlst)))
+		  (format file "(test (and (string=? ~S (string ~{#\\~C~^ ~})) (equal? '~A (string->list ~S))) #t)~%" str strlst strlst str))))))))
+
+    (call-with-output-file "strtst.scm"
+      (lambda (p)
+	(do ((len 3 (+ len 1)))
+	    ((= len 5))
+	  (all-strs len p))))
+
+    (load "strtst.scm")))
+
+
+(test (and (string=? "\"" (string #\")) (equal? '(#\") (string->list "\""))) #t)
+(test (and (string=? "#\\" (string #\# #\\)) (equal? '(#\# #\\) (string->list "#\\"))) #t)
+(test (and (string=? "#(" (string #\# #\()) (equal? '(#\# #\() (string->list "#("))) #t)
+(test (and (string=? "\"@" (string #\" #\@)) (equal? '(#\" #\@) (string->list "\"@"))) #t)
+(test (and (string=? "\";" (string #\" #\;)) (equal? '(#\" #\;) (string->list "\";"))) #t)
+(test (and (string=? ")(" (string #\) #\()) (equal? '(#\) #\() (string->list ")("))) #t)
+(test (and (string=? "`)#" (string #\` #\) #\#)) (equal? '(#\` #\) #\#) (string->list "`)#"))) #t)
+(test (and (string=? "##\\" (string #\# #\# #\\)) (equal? '(#\# #\# #\\) (string->list "##\\"))) #t)
+(test (and (string=? "#\"(" (string #\# #\" #\()) (equal? '(#\# #\" #\() (string->list "#\"("))) #t)
+(test (and (string=? "#.@" (string #\# #\. #\@)) (equal? '(#\# #\. #\@) (string->list "#.@"))) #t)
+(test (and (string=? ",`@" (string #\, #\` #\@)) (equal? '(#\, #\` #\@) (string->list ",`@"))) #t)
+(test (and (string=? "',@" (string #\' #\, #\@)) (equal? '(#\' #\, #\@) (string->list "',@"))) #t)
+(test (and (string=? "\"#@" (string #\" #\# #\@)) (equal? '(#\" #\# #\@) (string->list "\"#@"))) #t)
+(test (and (string=? "\")\"" (string #\" #\) #\")) (equal? '(#\" #\) #\") (string->list "\")\""))) #t)
+(test (and (string=? ")#(" (string #\) #\# #\()) (equal? '(#\) #\# #\() (string->list ")#("))) #t)
+(test (and (string=? "`(,@" (string #\` #\( #\, #\@)) (equal? '(#\` #\( #\, #\@) (string->list "`(,@"))) #t)
+(test (and (string=? "`)#\"" (string #\` #\) #\# #\")) (equal? '(#\` #\) #\# #\") (string->list "`)#\""))) #t)
+(test (and (string=? "#\"'#" (string #\# #\" #\' #\#)) (equal? '(#\# #\" #\' #\#) (string->list "#\"'#"))) #t)
+(test (and (string=? "#(@\\" (string #\# #\( #\@ #\\)) (equal? '(#\# #\( #\@ #\\) (string->list "#(@\\"))) #t)
+(test (and (string=? "#(\\\\" (string #\# #\( #\\ #\\)) (equal? '(#\# #\( #\\ #\\) (string->list "#(\\\\"))) #t)
+(test (and (string=? ",,.@" (string #\, #\, #\. #\@)) (equal? '(#\, #\, #\. #\@) (string->list ",,.@"))) #t)
+(test (and (string=? ",@`\"" (string #\, #\@ #\` #\")) (equal? '(#\, #\@ #\` #\") (string->list ",@`\""))) #t)
+(test (and (string=? "\"'\")" (string #\" #\' #\" #\))) (equal? '(#\" #\' #\" #\)) (string->list "\"'\")"))) #t)
+(test (and (string=? "\")#\"" (string #\" #\) #\# #\")) (equal? '(#\" #\) #\# #\") (string->list "\")#\""))) #t)
+(test (and (string=? "(\\`)" (string #\( #\\ #\` #\))) (equal? '(#\( #\\ #\` #\)) (string->list "(\\`)"))) #t)
+(test (and (string=? "))\"'" (string #\) #\) #\" #\')) (equal? '(#\) #\) #\" #\') (string->list "))\"'"))) #t)
+(test (and (string=? "\\,\\\"" (string #\\ #\, #\\ #\")) (equal? '(#\\ #\, #\\ #\") (string->list "\\,\\\""))) #t)
+(test (and (string=? "\\\"`\"" (string #\\ #\" #\` #\")) (equal? '(#\\ #\" #\` #\") (string->list "\\\"`\""))) #t)
+(test (and (string=? "\\\\#\"" (string #\\ #\\ #\# #\")) (equal? '(#\\ #\\ #\# #\") (string->list "\\\\#\""))) #t)
+
+(test (string->list "" 0 10) 'error)
+(test (string->list "1" 0 2) 'error)
+(test (string->list "" 0 0) ())
+(test (string->list "1" 1) ())
+(test (string->list "1" 0) '(#\1))
+(test (string->list "" #\null) 'error)
+(test (string->list "" 0 #\null) 'error)
+(test (string->list "" -1) 'error)
+(test (string->list "1" -1) 'error)
+(test (string->list "1" 0 -1) 'error)
+(test (string->list "1" -2 -1) 'error)
+(test (string->list "1" most-negative-fixnum) 'error)
+(test (string->list "1" 2) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (string->list "012345" arg) 'error)
+   (test (string->list "012345" 1 arg) 'error))
+ (list #\a "hi" () (list 1) '(1 . 2) 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (string->list "12345" 0) '(#\1 #\2 #\3 #\4 #\5))
+(test (string->list "12345" 0 5) '(#\1 #\2 #\3 #\4 #\5))
+(test (string->list "12345" 5 5) ())
+(test (string->list "12345" 4 5) '(#\5))
+(test (string->list "12345" 2 4) '(#\3 #\4))
+(test (string->list "12345" 2 1) 'error)
+(test (string->list "12345" 2 3 4) 'error)
+(test (string->list (make-string 3 #\null) 2 3) '(#\null))
+
+(test (catch #t
+        (lambda ()
+          (let-temporarily (((*s7* 'max-list-length) 3))
+            (string->list "12345")))
+        (lambda (type info)
+          (apply format #f info)))
+      "string->list length 5, (- 5 0), is greater than (*s7* 'max-list-length), 3")
+
+
+;;; --------------------------------------------------------------------------------
+;;; char-position
+;;; string-position
+
+(test (char-position) 'error)
+(test (char-position #\a) 'error)
+(test (char-position #\a "abc" #\0) 'error)
+(test (char-position #\a "abc" 0 1) 'error)
+(test (string-position) 'error)
+(test (string-position #\a) 'error)
+(test (string-position "a" "abc" #\0) 'error)
+(test (string-position "a" "abc" 0 1) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (string-position arg "abc") 'error)
+   (test (char-position arg "abc") 'error)
+   (test (string-position "a" arg) 'error)
+   (test (char-position #\a arg) 'error)
+   (test (string-position "a" "abc" arg) 'error)
+   (test (char-position #\a "abc" arg) 'error))
+ (list () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 -1 most-negative-fixnum 1.0+1.0i :hi (if #f #f) (lambda (a) (+ a 1))))
+(test (char-position #\a "abc" most-positive-fixnum) #f)
+(test (char-position "a" "abc" most-positive-fixnum) #f)
+(test (string-position "a" "abc" most-positive-fixnum) #f)
+
+(test (char-position #\b "abc") 1)
+(test (char-position #\b "abc" 0) 1)
+(test (char-position #\b "abc" 1) 1)
+(test (char-position "b" "abc") 1)
+(test (char-position "b" "abc" 1) 1)
+(test (char-position "b" "abc") 1)
+(test (string-position "b" "abc") 1)
+(test (string-position "b" "abc" 1) 1)
+(test (string-position "b" "abc" 2) #f)
+(test (string-position "b" "abc" 3) #f)
+(test (char-position "b" "abc" 2) #f)
+(test (char-position "b" "abc" 3) #f)
+(test (char-position #\b "abc" 2) #f)
+(test (char-position #\b "abc" 3) #f)
+(test (char-position "ab" "abcd") 0)
+(test (char-position "ab" "ffbcd") 2)
+(test (char-position "ab" "ffacd") 2)
+(test (string-position "ab" "ffacd") #f)
+(test (string-position "ab" "ffabd") 2)
+(test (string-position "ab" "ffabab" 2) 2)
+(test (string-position "ab" "ffabab" 3) 4)
+(test (string-position "ab" "ffabab" 4) 4)
+(test (string-position "ab" "ffabab" 5) #f)
+(test (string-position "abc" "ab") #f)
+(test (string-position "abc" "") #f)
+(test (string-position "" "") #f)
+(test (char-position "\"" "a") #f)
+(test (char-position "\"" "a\"b") 1)
+(test (char-position #\" "a\"b") 1)
+(test (string-position "\"hiho\"" "hiho") #f)
+(test (string-position "\"hiho\"" "\"\"hiho\"") 1)
+
+(test (string-position "" "a") #f) ; this is a deliberate choice in s7.c
+(test (char-position "" "a") #f)
+(test (char-position #\null "a") 1)  ; ??
+(test (char-position #\null "") #f)  ; ??
+(test (string-position (string #\null) "a") 0) ; ??
+(test (string-position (string #\null) "") #f) ; ??
+(test (char-position #\null (string #\null)) 0) ; ??
+(test (char-position #\null (string #\a #\null #\n)) 1)
+(test (char-position "" (string #\a #\null #\n)) #f)
+;(test (char-position #\n (string #\a #\null #\n)) 2)   ; ?? returns #f due to assumption of C-style strings
+;(test (char-position "n" (string #\a #\null #\n)) 1)   ; oops!
+;(test (string-position "n" (string #\a #\null #\n)) 2) ; oops!
+(test (char-position "" (string #\a #\n)) #f)
+(test (char-position #(1) "asdasd" 63) 'error)
+(test (let ((i 0)) (sort! (vector 3 2 4 5 1) (lambda (a b) (+ (char-position #\xff abs (+ i 1))) (> a b)))) 'error)
+
+;; if "" as string-pos first, -> #f so same for char-pos, even if string contains a null
+
+(let ()
+  ;; actually more of a string-append/temp substring test
+  (define (fixit str)
+    (let ((pos (char-position #\& str)))
+      (if (not pos)
+	  str
+	  (string-append (substring str 0 pos)
+			 (let ((epos (char-position #\; str pos)))
+			   (let ((substr (substring str (+ pos 1) epos)))
+			     (let ((replacement (cond ((string=? substr "gt") ">")
+						      ((string=? substr "lt") "<")
+						      ((string=? substr "mdash") "-")
+						      (else (format #t "unknown: ~A~%" substr)))))
+			       (string-append replacement
+					      (fixit (substring str (+ epos 1)))))))))))
+  (test (fixit "(let ((f (hz-&gt;radians 100)) (g (hz-&gt;radians 200))) (&lt; f g))")
+	"(let ((f (hz->radians 100)) (g (hz->radians 200))) (< f g))"))
+
+;;; opt bug
+(test (apply char-position '(#\a #u() #f)) 'error)
+(test (let () (define (f1) (do ((i 0 (+ i 1))) ((= i 1) (char-position #\a #u() #f)) (char-position #\a #u() #f))) (f1)) 'error)
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; symbol->string
+;;; string->symbol
+;;; symbol
+
+(test (symbol->string 'hi) "hi")
+(test (string->symbol (symbol->string 'hi)) 'hi)
+(test (eq? (string->symbol "hi") 'hi) #t)
+(test (eq? (string->symbol "hi") (string->symbol "hi")) #t)
+
+(test (string->symbol "hi") 'hi)
+
+(test (let ((str (symbol->string 'hi)))
+	(catch #t (lambda () (string-set! str 1 #\x)) (lambda args 'error)) ; can be disallowed
+	(symbol->string 'hi))
+      "hi")
+
+(test (symbol->string 'sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789)
+      "sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789")
+(test (string->symbol "sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789")
+      'sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789)
+(test (let ((sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789 32))
+	(+ sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789 1))
+      33)
+
+(test (symbol->string (string->symbol "hi there")) "hi there")
+(test (symbol->string (string->symbol "Hi There")) "Hi There")
+(test (symbol->string (string->symbol "HI THERE")) "HI THERE")
+(test (symbol->string (string->symbol "")) 'error) ; this fluctuates
+(test (symbol? (string->symbol "(weird name for a symbol!)")) #t)
+(test (symbol->string (string->symbol "()")) "()")
+(test (symbol->string (string->symbol (string #\"))) "\"")
+(test (symbol->string 'quote) "quote")
+(test (symbol->string if) 'error)
+(test (symbol->string quote) 'error)
+
+(test (symbol? (string->symbol "0")) #t)
+(test (symbol? (symbol "0")) #t)
+(test (symbol? (symbol ".")) #t) ; hmmm
+(test (let () (define |.| 1) (+ |.| 2)) 3)
+(test (string->symbol "0e") '0e)
+(test (string->symbol "1+") '1+)
+(test (symbol? (string->symbol "1+i")) #t)
+(test (string->symbol ":0") ':0)
+(test (symbol? (string->symbol " hi")) #t)
+(test (symbol? (string->symbol "hi ")) #t)
+(test (keyword? (string->symbol ":asdf")) #t)
+(test (symbol->string 'a'b) "a'b")
+(test (string->symbol "a\"b") (symbol "a\"b"))
+(test (symbol->string (symbol "a\"b")) "a\"b")
+(test (symbol->string (symbol "a" (string #\") "b")) "a\"b") ; r7rs spec says no escapes -- how is it a legal string?
+(test (string->symbol (string #\a #\" #\b)) (symbol "a\"b"))
+
+(test (reinvert 12 string->symbol symbol->string "hiho") "hiho")
+
+(test (symbol->string) 'error)
+(test (string->symbol) 'error)
+(test (symbol->string 'hi 'ho) 'error)
+(test (string->symbol "hi" "ho") 'error)
+
+(test (symbol? (string->symbol (string #\x (integer->char 255) #\x))) #t)
+(test (symbol? (string->symbol (string #\x (integer->char 8) #\x))) #t)
+(test (symbol? (string->symbol (string #\x (integer->char 128) #\x))) #t)
+(test (symbol? (string->symbol (string #\x (integer->char 200) #\x))) #t)
+(test (symbol? (string->symbol (string #\x (integer->char 255) #\x))) #t)
+(test (symbol? (string->symbol (string #\x (integer->char 20) #\x))) #t)
+(test (symbol? (string->symbol (string #\x (integer->char 2) #\x))) #t)
+(test (symbol? (string->symbol (string #\x (integer->char 7) #\x))) #t)
+(test (symbol? (string->symbol (string #\x (integer->char 17) #\x))) #t)
+(test (symbol? (string->symbol (string #\x (integer->char 170) #\x))) #t)
+(test (symbol? (string->symbol (string #\x (integer->char 0) #\x))) #t)       ; but the symbol's name here is "x"
+;(test (eq? (string->symbol (string #\x (integer->char 0) #\x)) 'x) #t)        ;   hmmm...
+(test (symbol? (string->symbol (string #\x #\y (integer->char 127) #\z))) #t) ; xy(backspace)z
+(test (let ((abc 12)) (symbol->value (symbol "abc"))) 12)
+
+(test (symbol "abc" ()) 'error)
+(test (symbol () "abc") 'error)
+(test (symbol "a" #(#\a)) 'error)
+(test (symbol "a" "" "b") 'ab)
+(test (symbol "" ()) 'error)
+
+(test (symbol? (string->symbol (string #\; #\" #\)))) #t)
+(test (let (((symbol ";")) 3) (symbol ";")) 'error)
+(test ((lambda () (do ((__i__ 0 (+ __i__ 1))) ((= __i__ 1) 3) (let (((symbol ";")) 3) (symbol ";"))))) 'error)
+(test (symbol "") 'error)
+(test (symbol "" "") 'error)
+(test (symbol "" "" "") 'error)
+(test (symbol (string #\null) "ho") (symbol "\x00;ho"))
+(test (let () (define (func) (symbol (string #\null) "ho")) (define (hi) (func) (func)) (hi) (hi)) (symbol "\x00;ho"))
+(test (symbol "a" (string #\null) "b") (symbol "a\x00;b"))
+
+(test (object->string (symbol "(ab)")) "(symbol \"(ab)\")")
+(test (object->string (symbol "(ab")) "(symbol \"(ab\")")
+(test (object->string (symbol "()")) "(symbol \"()\")")
+(test (object->string (symbol (string #\return))) "(symbol \"\\r\")")
+(test (object->string (symbol (string #\return #\a #\tab))) "(symbol \"\\ra\\t\")")
+(test (object->string (symbol (string #\return #\tab))) "(symbol \"\\r\\t\")")
+(test (object->string (symbol (string #\a #\b #\return #\tab))) "(symbol \"ab\\r\\t\")")
+(test (object->string (symbol (string #\return #\tab #\a #\b))) "(symbol \"\\r\\tab\")")
+(test (object->string (symbol (string #\return #\tab #\a #\null))) "(symbol \"\\r\\ta\\x00;\")")
+
+(test (symbol->string (openlet (inlet 'symbol->string (lambda (s) "a symbol")))) "a symbol")
+(test (let () (apply define (list (symbol "#g")) (list 1)) (eval (list (symbol "#g")))) 1)
+
+(let ()
+  (apply define (list (symbol "[#]") 0))
+  (test (symbol->value (symbol "[#]")) 0)
+  (set! (symbol "[#]") 32)
+  (test (symbol->value (symbol "[#]")) 32)
+  (apply define (list (symbol "a" "b" "c") 12))
+  (set! (symbol "a" "b" "c") -1)
+  (test (symbol->value (symbol "a" "b" "c")) -1)
+  (apply set! (list (symbol "[#]") -2))
+  (test (symbol->value (symbol "[#]")) -2)
+  (let-temporarily (((symbol "[#]") 101))
+    (test (symbol->value (symbol "[#]")) 101))
+  (test (symbol->value (symbol "[#]")) -2)
+  (test (let-temporarily (((symbol ":asdf") 32)) :asdf) 'error))
+
+(let ((s1 "as")
+      (s2 "df"))
+  (apply define (list (symbol s1 s2) 0))
+  (set! (symbol s1 s2) 123)
+  (test (symbol->value (symbol s1 s2)) 123)
+  (test asdf 123))
+
+(for-each
+ (lambda (arg)
+   (test (symbol->string arg) 'error))
+ (list #\a 1 "hi" () (list 1) '(1 . 2) #f (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+   (test (string->symbol arg) 'error)
+   (test (symbol arg) 'error)
+   (test (symbol "a" arg) 'error))
+ (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+   (test (symbol? (string->symbol (string arg))) #t)
+   (test (symbol? (symbol (string arg))) #t))
+ (list #\; #\, #\. #\) #\( #\" #\' #\` #\x33 #\xff #\x7f #\# #\]))
+
+(test (symbol) 'error)
+(test (symbol "hi" "ho") 'hiho)
+
+(let ()
+  (define-macro (string-case selector . clauses)
+    `(case (symbol ,selector)
+       ,@(map (lambda (clause)
+		(if (pair? (car clause))
+		    `(,(map symbol (car clause)) ,@(cdr clause))
+		    clause))
+	      clauses)))
+
+  (test (let ((str "hi"))
+	  (string-case str
+            (("hi" "ho") 1 2 3)
+	    (("hiho") 2)
+	    (else 4)))
+	3))
+
+(let ()
+  (apply define (list (symbol "(#)") 3))
+  (test (eval (symbol "(#)") (curlet)) 3))
+
+(let ()
+  (define (immutabl obj) (string->symbol (object->string obj :readable)))
+  (define (symbol->object sym) (eval-string (symbol->string sym)))
+  (test (symbol->object (immutabl (list 1 2 3))) (list 1 2 3))
+  (test (symbol->object (immutabl "hi")) "hi"))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; symbol->value
+;;; symbol->dynamic-value
+;;; symbol-initial-value
+
+(let ((sym 0))
+  (test (symbol->value 'sym) 0)
+  (test (symbol->dynamic-value 'sym) 0)
+  (for-each
+   (lambda (arg)
+     (set! sym arg)
+     (test (symbol->value 'sym) arg)
+     (test (symbol->dynamic-value 'sym) arg))
+   (list #\a 1 () (list 1) '(1 . 2) #f (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0)
+	 3.14 3/4 1.0+1.0i #t (if #f #f) #<eof> (lambda (a) (+ a 1)))))
+
+(for-each
+ (lambda (arg)
+   (test (symbol->value arg) 'error)
+   (test (symbol->value 'abs arg) 'error)
+   (test (symbol->dynamic-value arg) 'error)
+   (test (symbol->dynamic-value 'abs arg) 'error))
+ (list #\a 1 () (list 1) "hi" '(1 . 2) #f (make-vector 3) _ht_ _undef_ 1/0 (log 0) 3.14 3/4 1.0+1.0i #t (if #f #f) #<eof>))
+
+(test (symbol->value) 'error)
+(test (symbol->value 'hi 'ho) 'error)
+(test (symbol->dynamic-value) 'error)
+(test (symbol->dynamic-value 'hi 'ho) 'error)
+
+(test (symbol->value 'abs (unlet)) abs)
+(test (symbol->value 'abs (rootlet)) abs)
+(test (symbol->value 'lambda) lambda)
+(test (symbol->value 'do) do)
+(test (symbol->value do) 'error)
+(test (symbol->value 'macroexpand) macroexpand)
+(test (symbol->value 'quasiquote) quasiquote)
+(test (symbol->value 'else) else)
+(test (symbol->value :hi) :hi)
+(test (symbol->value hi:) hi:)
+(test (symbol->value :hi 123) 'error)
+(test (symbol->value :hi abs) :hi)
+(test (symbol->value  :readable (lambda a (copy a))) :readable)
+
+(test (symbol->dynamic-value 'lambda) lambda)
+(test (symbol->dynamic-value 'do) do)
+(test (symbol->dynamic-value do) 'error)
+(test (symbol->dynamic-value 'macroexpand) macroexpand)
+(test (symbol->dynamic-value 'quasiquote) quasiquote)
+(test (symbol->dynamic-value 'else) else)
+(test (symbol->dynamic-value :hi) :hi)
+(test (symbol->dynamic-value hi:) hi:)
+
+(test (symbol->value '#<eof>) 'error) ; because it's not a symbol:
+(test (symbol? '#<eof>) #f)
+(test (let ((a1 32)) (let () (symbol->value 'a1 (curlet)))) 32)
+(test (let ((a1 32)) (let ((a1 0)) (symbol->value 'a1 (curlet)))) 0)
+(test (let ((a1 32)) (let ((a1 0)) (symbol->value 'b1 (curlet)))) #<undefined>)
+(test (symbol->value 'abs ()) 'error)
+(test (let ((a1 (let ((b1 32)) (lambda () b1)))) (symbol->value 'b1 (funclet a1))) 32)
+(test (let ((x #f)) (set! x (let ((a1 (let ((b1 32)) (lambda () b1)))) a1)) (symbol->value 'b1 (funclet x))) 32)
+(test (symbol->value 'if) if)
+(test (symbol->value if) 'error)
+(test ((define (hi a) (+ a 1)) 2) 3)
+(test ((define-macro (hi a) `(+ ,a 1)) 2) 3)
+(test (let ((mac (define-macro (hi a) `(+ ,a 1)))) (mac 3)) 4)
+
+(test (eq? #_abs (symbol->value 'abs (unlet))) #t)
+(test (eq? #_lambda (symbol->value 'lambda (unlet))) #t)
+(test (eq? #_case case) #t)
+(test (eq? #_cond #_if) #f)
+(test (let ((b 2)) (let ((e (curlet))) (let ((a 1)) (symbol->value 'a e)))) #<undefined>)
+(test (let ((a 2)) (let ((e (curlet))) (let ((a 1)) (symbol->value 'a e)))) 2)
+(test (let ((a 2)) (let ((e (curlet))) (let ((a 1)) (symbol->value 'a)))) 1)
+(test (let ((asdf 32)) (symbol->value 'asdf (rootlet))) #<undefined>)
+(test (let ((asdf 32)) (symbol->value 'asdf (unlet))) #<undefined>)
+(test (let ((asdf 32)) (symbol->value 'asdf)) 32)
+
+(let ()
+  (define *ds* 0)
+  (define (get-ds) (list *ds* (symbol->dynamic-value '*ds*)))
+  (test (get-ds) '(0 0))
+  (let ((*ds* 32))
+    (test (values (get-ds)) '(0 32)))
+  (let ((*ds* 3))
+    (define (gds) (list *ds* (symbol->dynamic-value '*ds*)))
+    (test (list (get-ds) (gds)) '((0 3) (3 3)))
+    (let ((*ds* 123))
+      (test (list (get-ds) (gds)) '((0 123) (3 123)))))
+  (let ((*ds* 3))
+    (define (gds) (list *ds* (symbol->dynamic-value '*ds*)))
+    (let ((*ds* 123))
+      (set! *ds* 321)
+      (test (list (get-ds) (gds)) '((0 321) (3 321))))))
+
+(test (symbol->dynamic-value 'asdasfasdasfg) #<undefined>)
+
+(let ((x 32))
+  (define (gx) (symbol->dynamic-value 'x))
+  (let ((x 12))
+    (test (values (gx)) 12)))
+
+(let ((x "hi")
+      (y 0)
+      (z '(1 2 3)))
+  (define (gx) (+ (symbol->dynamic-value 'x) (symbol->dynamic-value 'z)))
+  (let ((x 32)
+	(z (+ 123 (car z))))
+    (test (values (gx)) 156)))
+
+(let ((x 32))
+  (define (gx) (symbol->dynamic-value 'x))
+  (let ((x 100))
+    (let ((x 12))
+      (test (values (gx)) 12))))
+
+(let ((x 32))
+  (define (gx) ; return both bindings of 'x
+    (list x (symbol->value 'x) (symbol->dynamic-value 'x)))
+  (let ((x 100))
+    (let ((x 12))
+      (test (values (gx)) '(32 32 12)))))
+
+(test (let () (define (func) (int-vector-set! (subvector #i2d((1 2) (3 4)) 0 4) 1 2 (arity (symbol->dynamic-value (gensym "g_123"))))) (define (hi) (func)) (hi)) 'error)
+(test (let () (define (func) (list (string-append) 42 (integer->char 255) (symbol->dynamic-value (gensym)))) (define (hi) (func)) (hi)) (list "" 42 #\xff #<undefined>))
+
+(let ((bindings ()))
+  ;; taken from the MIT_Scheme documentation (changing fluid-let to let)
+
+  (define (write-line v)
+    (set! bindings (cons v bindings)))
+
+  (define (complicated-dynamic-binding)
+    (let ((variable 1)
+	  (inside-continuation #f))
+      (write-line variable)
+      (call-with-current-continuation
+       (lambda (outside-continuation)
+	 (let ((variable 2))
+	   (write-line variable)
+	   (set! variable 3)
+	   (call-with-current-continuation
+	    (lambda (k)
+	      (set! inside-continuation k)
+	      (outside-continuation #t)))
+	   (write-line variable)
+	   (set! inside-continuation #f))))
+      (write-line variable)
+      (if inside-continuation
+	  (begin
+	    (set! variable 4)
+	    (inside-continuation #f)))))
+
+  (complicated-dynamic-binding)
+  (test (reverse bindings) '(1 2 1 3 4)))
+
+;;; (define (func x) (call-with-output-file "/dev/null" (symbol->dynamic-value (*function* (curlet)))))
+;;;    gets either stack overflow or error: open-output-file: Too many open files "/dev/null"
+;;;    because (symbol->dynamic-value (*function* (curlet))) is the calling function (func) so we have
+;;;    an infinite recursion.
+
+(when with-block
+  (test (defined? 'subsequence (block) #t) #t)
+  (test ((block) 'subsequence) subblock)
+  (test (let-ref (block) 'subsequence) subblock)
+  (test (with-let (block) subsequence) subblock)
+  (test (symbol->value 'subsequence (block)) subblock)
+  (let () (define (func) (do () (#t (with-let (block 1.0 2.0 3.0) (subsequence abs abs abs))))) (test (func) 'error))
+  (let () (define (func) (do () (#t (with-let (block 1.0 2.0 3.0) (subsequence 0-i abs abs))))) (test (func) 'error))
+  (let () (define (func) (do () (#t (with-let (block 1.0 2.0 3.0) (subsequence abs 0-i abs))))) (test (func) 'error))
+  (let () (define (func) (do () (#t (with-let (block 1.0 2.0 3.0) (subsequence abs abs 0-i))))) (test (func) 'error))
+  (let () (define (func) (do () (#t (with-let (block 1.0 2.0 3.0) (subsequence 0-i 0-i 0-i))))) (test (func) 'error))
+  (let () (define (func) (do () (#t (with-let (block 1.0 2.0 3.0) (subsequence 0-i 0-i abs))))) (test (func) 'error))
+  (let () (define (func) (do () (#t (with-let (block 1.0 2.0 3.0) (subsequence 0-i abs 0-i))))) (test (func) 'error))
+  (let () (define (func) (do () (#t (with-let (block 1.0 2.0 3.0) (subsequence abs 0-i 0-i))))) (test (func) 'error))
+
+  (let ()
+    (define-constant imb12 (immutable! (block 0.0 1.0 2.0)))
+    (define (func) (do ((var #f) (i 0 (+ i 1))) ((= i 1) var) (set! var (symbol->value :allow-other-keys imb12))))
+    (test (func) :allow-other-keys)))
+
+;;; symbol-initial-value
+
+(test (eq? (symbol-initial-value 'abs) #_abs) #t)
+(test (eq? (symbol-initial-value 'abs) abs) #t) ; (if global=initial)
+(test (eq? (symbol-initial-value 'abs) #_abs) #t)
+(test (set! (symbol-initial-value 'abs) 321) 'error) ; error: can't set! (symbol-initial-value 'abs); it is immutable
+(define (__init_f_ x) (+ x 1))
+(test (symbol-initial-value '__init_f_) #<undefined>)
+(test (set! (symbol-initial-value '__init_f_) __init_f_) __init_f_)
+(test (symbol-initial-value '__init_f_) __init_f_)
+(test (set! (symbol-initial-value '__init_f_) abs) 'error)
+(test (set! (symbol-initial-value :hi) abs) abs)
+(test (#_:hi -1) 1) ; yow
+(test (hi -1) 'error)
+(test (:hi -1) 'error)
+(test (symbol-initial-value :hi) abs) ; ???
+(let ((g (gensym)))
+  (test (symbol-initial-value g) #<undefined>)
+  (test (set! (symbol-initial-value g) abs) abs)
+  (test (symbol-initial-value g) abs))
+
+(for-each
+ (lambda (arg)
+   (test (symbol-initial-value arg) 'error)
+   (test (set! (symbol-initial-value arg) 123) 'error))
+  (list "hi" '(1 2) (integer->char 65) 1 (make-vector 3) _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+        3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) (if #f #f) #<eof> #<undefined>))
+
+(test (symbol-initial-value 'quasiquote) #_quasiquote)
+
+
+;;; --------------------------------------------------------------------------------
+;;; BYTE-VECTORS
+;;; --------------------------------------------------------------------------------
+
+(let ((bv #u(1 0 3)))
+  (test bv #u(1 0 3))
+  (test (object->string bv) "#u(1 0 3)")
+  (test (equal? bv #u(1 0 3)) #t)
+  (test (eq? bv bv) #t)
+  (test (eqv? bv bv) #t)
+  (test (equal? (byte-vector 1 0 3) #u(1 0 3)) #t)
+  (test (byte-vector? bv) #t)
+  (test (equal? (make-byte-vector 3 0) #u(0 0 0)) #t)
+  (test (string-ref #u(64 65 66) 1) 'error)
+  (test (byte-vector-ref #u(64 65 66) 1) 65)
+  (test (let ((nbv (copy bv))) (equal? nbv bv)) #t)
+  (test (let ((rbv (reverse bv))) (equal? rbv #u(3 0 1))) #t)
+  (test (length bv) 3)
+  )
+
+(test (eval-string "#u(-1)") 'error)
+(test (eval-string "#u(1.0)") 'error)
+(test (eval-string "#u(3/2)") 'error)
+(test (eval-string "#u(1+i)") 'error)
+(test (eval-string "#u((32))") 'error)
+(test (eval-string "#u(#\\a)") 'error)
+(test (eval-string "#u(256)") 'error)
+(test (eval-string "#u(1/0)") 'error)
+(test (eval-string "#u(9223372036854775807)") 'error)
+(test (eval-string "#u(-9223372036854775808)") 'error)
+(test #u(#b11 #x8) #u(3 8))
+(test (eval-string "#u(1 2 . 3)") 'error)
+
+(test #u(255) (byte-vector 255))
+(test (byte-vector 256) 'error)
+(test (byte-vector -1) 'error)
+(test (object->string #u()) "#u()")
+(test (object->string #u(255)) "#u(255)")
+(test (object->string #u(255 255)) "#u(255 255)")
+(test (object->string #u(128)) "#u(128)")
+(test (object->string #u(128 128)) "#u(128 128)")
+
+(test (length #u(0)) 1)
+(test (length #u(0 0)) 2)
+(test (length #u()) 0)
+(test (length (byte-vector)) 0)
+(test (byte-vector? #u()) #t)
+(test (equal? (let ((bv #u(1 0 3))) (set! (bv 2) 64) bv) #u(1 0 64)) #t)
+(test (let ((bv #u(1 0 3))) (map values bv)) '(1 0 3))
+(test (let ((bv #u(1 0 3)) (lst ())) (for-each (lambda (x) (set! lst (cons x lst))) bv) lst) '(3 0 1))
+(test (let ((bv #u(1 2 3))) (bv 1)) 2)
+(test (let ((bv #u(1 2 3))) (reverse bv)) #u(3 2 1))
+(test (let ((bv #u(1 2 3))) (object->string (reverse bv))) "#u(3 2 1)")
+(test (let ((bv #u(1 2 3))) (copy bv)) #u(1 2 3))
+(test (#u(1 2 3) 2) 3)
+(test (let ((v #u(0 1 2))) (let ((v1 (reverse! v))) (eq? v v1))) #t)
+(test (let ((v #u(0 1 2))) (reverse! v)) #u(2 1 0))
+;; should (vector? #u(1 2)) be #t?
+(test (format #f "~{~A ~}" (byte-vector 255 0)) "255 0 ")
+
+;;; string->byte-vector -- why is this needed? -- why not use copy instead?
+(test (byte-vector? (string->byte-vector (string #\0))) #t)
+(test (byte-vector? (string->byte-vector "")) #t)
+(test (byte-vector? (string->byte-vector "1230")) #t)
+(test (byte-vector? (string->byte-vector (string->byte-vector (string #\0)))) 'error)
+(test (byte-vector? (string->byte-vector (string))) #t)
+(test (byte-vector? (string->byte-vector #u(1 2))) 'error)
+(test (byte-vector? (string->byte-vector #u())) 'error)
+(test (byte-vector? (string->byte-vector #(1 2))) 'error)
+(for-each
+ (lambda (arg)
+   (test (string->byte-vector arg) 'error)
+   (test (byte-vector? arg) #f))
+ (list #\a () (list 1) '(1 . 2) #f (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t (if #f #f) #<eof> (lambda (a) (+ a 1))))
+
+(test (string->byte-vector #x010203) 'error)
+(test (string->byte-vector (immutable! "123")) #u(49 50 51))
+(let ((str (immutable! "123")))
+  (string->byte-vector str)
+  (test str "123")
+  (test (immutable? str) #t))
+
+(test (let ((str "123")) (string->byte-vector str) (byte-vector? str)) #f)
+(test (let ((str (string #\a))) (string->byte-vector str) (byte-vector? str)) #f)
+(test (let () (define (func) (string->byte-vector "ho")) (define (hi) (func) (func)) (hi) (hi)) #u(104 111))
+(test (let () (define (func) (byte-vector->string #u(65))) (define (hi) (func) (func)) (hi) (hi)) "A")
+
+;;; byte-vector->string
+(test (string? (byte-vector->string #u(0))) #t)
+(test (string? (byte-vector->string #u())) #t)
+(test (string? (byte-vector->string #u(1 2 3))) #t)
+(test (string? (byte-vector->string (string->byte-vector (string #\0)))) #t)
+(test (string? (byte-vector->string (byte-vector))) #t)
+(test (string? (byte-vector->string "asd")) 'error)
+(test (string? (byte-vector->string "")) 'error)
+(test (string? (byte-vector->string #(1 2))) 'error)
+(for-each
+ (lambda (arg)
+   (test (byte-vector->string arg) 'error))
+ (list #\a () (list 1) '(1 . 2) #f (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t (if #f #f) #<eof> (lambda (a) (+ a 1))))
+
+(test (byte-vector->string #x010203) 'error)
+(test (byte-vector->string (immutable! #u(49 50 51))) "123")
+(let ((bv (immutable! #u(49 50 51))))
+  (byte-vector->string bv)
+  (test bv #u(49 50 51))
+  (test (immutable? bv) #t))
+
+
+;;; make-byte-vector
+(test (equal? (make-byte-vector 0) #u()) #t)
+(test (equal? (make-byte-vector 0 32) #u()) #t)
+(test (equal? (make-byte-vector 1 32) #u(32)) #t)
+(test (make-byte-vector 0 -32) 'error)
+(test (make-byte-vector 1 -32) 'error)
+(test (make-byte-vector 1 256) 'error)
+(test (make-byte-vector 1 3.0) 'error)
+(test (make-byte-vector 2) #u(0 0)) ; make sure it's init is 0 -- g_make_byte_vector bug
+(test (make-byte-vector 1) #u(0))
+(for-each
+ (lambda (arg)
+   (if (not (eq? 'error (catch #t (lambda () (make-byte-vector arg)) (lambda args 'error))))
+       (format *stderr* ";(make-byte-vector ~S) returns a byte-vector?\n" arg))
+   (if (not (eq? 'error (catch #t (lambda () (make-byte-vector 1 arg)) (lambda args 'error))))
+       (format *stderr* ";(make-byte-vector 1 ~S) returns a byte-vector?\n" arg)))
+ (list #\a () '(1 . 2) #f (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t (if #f #f) #<eof> (lambda (a) (+ a 1))))
+
+(test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (make-byte-vector most-positive-fixnum 0))) (f)) 'error)
+
+;;; byte-vector
+(test (byte-vector) #u())
+(test (byte-vector 32) (make-byte-vector 1 32))
+(test (byte-vector 0 256) 'error)
+(test (byte-vector -1) 'error)
+(for-each
+ (lambda (arg)
+   (test (byte-vector arg) 'error))
+ (list #\a () (list 1)  '(1 . 2) #f (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t (if #f #f) #<eof> (lambda (a) (+ a 1))))
+
+(test (map append #u(0 1 2)) '(0 1 2))
+(test (format #f "~{#x~X~| ~}" #u(49 50 51)) "#x31 #x32 #x33")
+(test (format #f "~{~D~| ~}" (string->byte-vector "abcd")) "97 98 99 100")
+(test (let ((lst ())) (for-each (lambda (c) (set! lst (cons c lst))) #u(90 91 92)) (reverse lst)) '(90 91 92))
+(test (integer? (#u(1 2 3) 0)) #t)
+(test (integer? ((string->byte-vector "abc") 1)) #t)
+
+(test ((vector (byte-vector 1)) 0 0) 1) ; i.e. not a character
+(test (let () (define (f) (or (#_byte-vector 1) (#_documentation cons))) (f)) #u(1)) ; optimizer bug
+#|
+(test (byte-vector 0
+		   (openlet
+		    (inlet 'byte-vector (lambda args
+					  (append #u(1) (apply #_byte-vector (cdr args))))))
+		   2)
+      #u(0 1 2))
+|#
+(let ((bv (byte-vector 0 1 2 3)))
+  (fill! bv 4)
+  (test bv #u(4 4 4 4))
+  (fill! bv 1 1 3)
+  (test bv #u(4 1 1 4))
+  (let ((bv1 (copy bv)))
+    (test bv1 #u(4 1 1 4))
+    (fill! bv 1)
+    (copy bv bv1)
+    (test bv1 #u(1 1 1 1))
+    (fill! bv 255)
+    (copy bv bv1 1 3)
+    (test bv1 #u(255 255 1 1)))) ; copy and fill do not interpret their indices in the same way (one is source, the other destination)
+
+(test (equal? (byte-vector (char->integer #\a)) (string #\a)) #f)
+(test (equivalent? (byte-vector (char->integer #\a)) (string #\a)) #f)
+
+(test (byte-vector? (copy "12")) #f)
+(test (byte-vector? (copy #u(0))) #t)
+(test (byte-vector? (reverse (byte-vector 0 1))) #t)
+(test (let ((v (byte-vector 0))) (fill! v #\a)) 'error)
+(test (let ((v (byte-vector 0))) (fill! v 1) v) #u(1))
+(test (byte-vector? (append #u(0 1) (byte-vector 2 3))) #t)
+
+;;; should string->byte-vector insist on string (not bv) arg?  similarly for string-ref et al?
+
+;;; byte-vector-ref
+;;; byte-vector-set!
+
+(test (let ((str "123")) (byte-vector-ref str 0)) 'error)
+(test (let ((str "123")) (byte-vector-set! str 0 1)) 'error)
+(test (let ((str "123")) (byte-vector-set! str 0 #\1)) 'error)
+(test (let ((str (byte-vector 0 1 2))) (byte-vector-ref str 0)) 0)
+(test (let ((str (byte-vector 0 1 2))) (char? (byte-vector-ref str 0))) #f)
+(test (let ((str (byte-vector 0 1 2))) (byte-vector-set! str 0 1)) 1)
+(test (let ((str (byte-vector 0 1 2))) (byte-vector-set! str 0 #\1)) 'error)
+(test (byte-vector-ref #u(0 1 2)) 'error)
+(test (byte-vector-ref) 'error)
+(test (byte-vector-ref #u(0 1 2) 1 1) 'error)
+(test (byte-vector-ref #u(0 1 2) -1) 'error)
+(test (byte-vector-set! #u(0 1 2)) 'error)
+(test (byte-vector-set! #u(0 1 2) 0) 'error)
+(test (byte-vector-set!) 'error)
+(test (byte-vector-set! #u(0 1 2) 1 1 2) 'error)
+(test (byte-vector-set! #u(0 1 2) -1 1) 'error)
+(test (let ((iv #i2d((0 1) (2 3)))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (byte-vector-set! iv 1 0)))) (func)) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (byte-vector-ref arg 0) 'error)
+   (test (byte-vector-set! arg 0 0) 'error)
+   (test (byte-vector-ref #u(0 1 2) arg) 'error)
+   (test (byte-vector-set! #u(0 1 2) arg 0) 'error)
+   (test (byte-vector-set! #u(0 1 2) 0 arg) 'error)
+   (test (let ((v #u(0 1 2))) (v arg)) 'error)
+   (test (let ((v #u(0 1 2))) (set! (v arg) 0)) 'error))
+ (list #\a () (list 1) "str" "" '(1 . 2) #f (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t (if #f #f) #<eof> (lambda (a) (+ a 1))))
+
+(test (let ((v #u(0 1 2))) (v 1)) 1)
+(test (let ((v (byte-vector 0 1 2))) (set! (v 1) 3) v) #u(0 3 2))
+
+(test (let ((bv (byte-vector #\1))) bv) 'error)
+(test (let ((bv (string 1))) bv) 'error)
+(let ((bv #u(0 1))) (test (string->byte-vector (byte-vector->string bv)) bv))
+(test (let ((bv (byte-vector 1))) (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (byte-vector-set! bv 0 #\1))) (f)) 'error)
+(test (let ((bc #u(0 1))) (set! (bc 0) #\1)) 'error)
+(test (let ((bc #u(0 1))) (byte-vector-set! bc 0 #\1)) 'error)
+(test (let ((bc #u(0 1))) (string-set! bc 0 #\1)) 'error)
+(test (let ((bc "123")) (set! (bc 0) 1)) 'error)
+(test (let ((bc "123")) (string-set! bc 0 1)) 'error)
+(test (let ((bc "123")) (byte-vector-set! bc 0 1)) 'error)
+(test (let ((bv (byte-vector 1))) (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (set! (bv 0) #\1))) (f)) 'error)
+(test (let ((bv (string #\1))) (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (set! (bv 0) 1))) (f)) 'error)
+(test (let ((bv (string #\1))) (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (string-set! bv 0 1))) (f)) 'error)
+(test (let () (define (hi) (do ((i 0 (+ i 1))) ((= i 1)) (char-alphabetic? (string-ref #u(0 1) 1)))) (hi)) 'error)
+
+(let ((fv (byte-vector 0 1)))
+  (test (byte-vector-ref fv 0 0) 'error)
+  (test (vector-ref fv 0 0) 'error)
+  (test (fv 0 0) 'error))
+(let ((fv #i2d((1 2) (3 4))))
+  (test (byte-vector-ref fv 0 0 0) 'error)
+  (test (byte-vector-ref fv 0 0 0 0) 'error)
+  (test (vector-ref fv 0 0 0) 'error)
+  (test (fv 0 0 0) 'error))
+
+(let ((bv (byte-vector 0 1 2)))
+  (test (byte-vector-ref bv bv) 'error)
+  (test (bv bv)	'error)
+  (test (call-with-input-file (apply bv bv (list))) 'error))
+
+(let ((bv (make-byte-vector '(2 3))))
+  (test (vector-length bv) 6)
+  (test (length bv) 6)
+  (test (vector-dimensions bv) '(2 3))
+  (byte-vector-set! bv 0 0 32)
+  (test (byte-vector-ref bv 0 0) 32)
+  (set! (bv 0 1) 33)
+  (test (bv 0 1) 33)
+  (fill! bv 1)
+  (test bv (make-byte-vector '(2 3) 1))
+  (test (bv 0) #u(1 1 1))
+  (set! (bv 0 0) 2)
+  (test (copy bv (make-byte-vector 4)) #u(2 1 1 1)))
+
+(let ((bv #u(1 2 3)))
+  (test (fill! bv #\a) 'error)
+  (test (vector-fill! bv #\a) 'error)
+  (test (fill! bv -1) 'error)
+  (test (vector-fill! bv 256) 'error)
+  (test (bv 3) 'error)
+  (test (vector-ref bv 3) 'error)
+  (test (vector-ref bv 0) 1)
+  (vector-set! bv 1 32)
+  (test (bv 1) 32)
+  (test (copy #i(1 2 321) (make-byte-vector 3)) 'error))
+
+(test (copy #i(31 32 321) (make-string 3)) 'error)
+(test (copy #(31 32 321) (make-byte-vector 3)) 'error)
+(test (copy '(31 32 321) (make-byte-vector 3)) 'error)
+(test (copy #(31 32 321) (make-string 3)) 'error)
+(test (copy '(31 32 321) (make-string 3)) 'error)
+
+(let ((bv (make-byte-vector '(2 3) 95)))
+  (test (byte-vector->string bv) "______")
+  (test (vector->list bv) '(95 95 95 95 95 95)))
+
+(let ((bv #u(0 1 2 3 4 5)))
+  (test (subvector bv 0 2) #u(0 1))
+  (test (subvector bv 2 4) #u(2 3))
+  (test (subvector bv 0 4 '(2 2)) (let ((b (make-byte-vector '(2 2)))) (copy bv b) b))
+  (test (vector-append bv #i(6 7)) #u(0 1 2 3 4 5 6 7))
+  (test (append bv #i(6 7)) #u(0 1 2 3 4 5 6 7)))
+
+(test ((make-byte-vector '(2 3) 1) 1) #u(1 1 1))
+(test ((make-byte-vector '(2 4) 1) 1) #u(1 1 1 1))
+(test ((make-byte-vector '(2 3) 1) 0) #u(1 1 1))
+(test ((make-byte-vector '(2 4) 12) 0) #u(12 12 12 12))
+(test ((make-byte-vector '(3 2) 12) 1) #u(12 12))
+(test ((make-byte-vector '(3 2) 12) 2) #u(12 12))
+(test (byte-vector-ref (make-byte-vector '(3 2) 12) 2) #u(12 12))
+
+(test (let ((bv (make-byte-vector '(2 3) 0))) (copy #u(1 2 3 4 5 6) bv) (subvector bv 2 6)) #u(3 4 5 6))
+(test (object->string #u2d((1 2) (3 4))) "#u2d((1 2) (3 4))")
+(test (object->string #u8(1 2)) "#u(1 2)")
+(let ((x #u2d((1 2) (3 4))) (lst ()))
+  (test (do ((iter (make-iterator x)) (lst ())) ((iterator-at-end? iter) (reverse lst)) (set! lst (cons (iter) lst))) '(1 2 3 4 #<eof>)))
+
+(test (equal? #i(1) #u(1)) #t)
+(test (equivalent? #i(1) #u(1)) #t)
+(test (equal? #u(1) #i(1)) #t)
+(test (equivalent? #u(1) #i(1)) #t)
+(test (equal? #u(1 2 3 4) #u2d((1 2) (3 4))) #f)
+(test (equal? #i(1 2 3 4) #i2d((1 2) (3 4))) #f)
+(test (equivalent? #u(1 2 3 4) #u2d((1 2) (3 4))) #f)
+(test (subvector #u(1 2 3 4) 0 3) #u(1 2 3))
+(test (equivalent? #u2d((1 2) (3 4)) #i2d((1 2) (3 4))) #t)
+
+
+;;; --------------------------------------------------------------------------------
+;;; LISTS
+;;; --------------------------------------------------------------------------------
+
+
+;;; --------------------------------------------------------------------------------
+;;; cons
+
+(test (cons 'a ()) '(a))
+(test (cons '(a) '(b c d)) '((a) b c d))
+(test (cons "a" '(b c)) '("a" b c))
+(test (cons 'a 3) '(a . 3))
+(test (cons '(a b) 'c) '((a b) . c))
+(test (cons () ()) '(()))
+(test (cons () 1) '(() . 1))
+(test (cons 1 2) '(1 . 2))
+(test (cons 1 ()) '(1))
+(test (cons () 2) '(() . 2))
+(test (cons 1 (cons 2 (cons 3 (cons 4 ())))) '(1 2 3 4))
+(test (cons 'a 'b) '(a . b))
+(test (cons 'a (cons 'b (cons 'c ()))) '(a b c))
+(test (cons 'a (list 'b 'c 'd)) '(a b c d))
+(test (cons 'a (cons 'b (cons 'c 'd))) '(a b c . d))
+(test '(a b c d e) '(a . (b . (c . (d . (e . ()))))))
+(test (cons (cons 1 2) (cons 3 4)) '((1 . 2) 3 . 4))
+(test (list (cons 1 2) (cons 3 4)) '((1 . 2) (3 . 4)))
+(test (cons (cons 1 (cons 2 3)) 4) '((1 . (2 . 3)) . 4))
+(test (cons (cons 1 (cons 2 ())) (cons 1 2)) '((1 2) . (1 . 2)))
+(test (let ((lst (list 1 2))) (list (apply cons lst) lst)) '((1 . 2) (1 2)))
+(test (let ((lst (list 1 2))) (list lst (apply cons lst))) '((1 2) (1 . 2)))
+(test (cdadr (let ((lst (list 1 2))) (list (apply cons lst) lst))) '(2))
+(test (cons '+ '=) '(+ . =))
+(test (cons .(cadddr 10)) (cons cadddr 10))
+(test (#_cons 1 2) '(1 . 2))
+(test (cons 1 ()) '(
+                      1
+		       ))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; car
+
+(test (car (list 1 2 3)) 1)
+(test (car (cons 1 2)) 1)
+(test (car (list 1)) 1)
+(test (car '(1 2 3)) 1)
+(test (car '(1)) 1)
+(test (car '(1 . 2)) 1)
+(test (car '((1 2) 3)) '(1 2))
+(test (car '(((1 . 2) . 3) 4)) '((1 . 2) . 3))
+(test (car (list (list) (list 1 2))) ())
+(test (car '(a b c)) 'a)
+(test (car '((a) b c d)) '(a))
+(test (car (reverse (list 1 2 3 4))) 4)
+(test (car (list 'a 'b 'c 'd 'e 'f 'g)) 'a)
+(test (car '(a b c d e f g)) 'a)
+(test (car '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '((((1 2 3) 4) 5) (6 7)))
+(test (car '(a)) 'a)
+(test (car '(1 ^ 2)) 1)
+(test (car '(1 .. 2)) 1)
+(test (car ''foo) #_quote)
+(test (car '(1 2 . 3)) 1)
+(test (car (cons 1 ())) 1)
+(test (car (if #f #f)) 'error)
+(test (car ()) 'error)
+(test (car #(1 2)) 'error)
+(test (car #(1 2)) 'error)
+(let ((L (list 1 2 3))) (set! (car L) 32) (test L '(32 2 3)))
+(let ((L (list 1 2 3))) (set! (#_car L) 12) (test L '(12 2 3)))
+
+(for-each
+ (lambda (arg)
+   (if (not (equal? (car (cons arg ())) arg))
+       (format #t ";(car '(~A)) returned ~A?~%" arg (car (cons arg ()))))
+   (test (car arg) 'error))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0)
+       3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (reinvert 12 car (lambda (a) (cons a ())) '(1)) '(1))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; cdr
+
+(test (cdr (list 1 2 3)) '(2 3))
+(test (cdr (cons 1 2)) 2)
+(test (cdr (list 1)) ())
+(test (cdr '(1 2 3)) '(2 3))
+(test (cdr '(1)) ())
+(test (cdr '(1 . 2)) 2)
+(test (cdr '((1 2) 3)) '(3))
+(test (cdr '(((1 . 2) . 3) 4)) '(4))
+(test (cdr (list (list) (list 1 2))) '((1 2)))
+(test (cdr '(a b c)) '(b c))
+(test (cdr '((a) b c d)) '(b c d))
+(test (equal? (cdr (reverse (list 1 2 3 4))) 4) #f)
+(test (equal? (cdr (list 'a 'b 'c 'd 'e 'f 'g)) 'a) #f)
+(test (cdr '((((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f) g)) '(g))
+(test (cdr '(a)) ())
+(test (cdr '(a b c d e f g)) '(b c d e f g))
+(test (cdr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '((((u v w) x) y) ((q w e) r) (a b c) e f g))
+(test (cdr ''foo) '(foo))
+(test (cdr (cons (cons 1 2) (cons 3 4))) '(3 . 4))
+(test (cdr '(1 2 . 3)) '(2 . 3))
+(test (cdr (if #f #f)) 'error)
+(test (cdr ()) 'error)
+
+(for-each
+ (lambda (arg)
+   (if (not (equal? (cdr (cons () arg)) arg))
+       (format #t ";(cdr '(() ~A) -> ~A?~%" arg (cdr (cons () arg))))
+   (test (cdr arg) 'error))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0)
+       3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(let* ((a (list 1 2 3))
+       (b a))
+  (set! (car a) (cadr a))
+  (set! (cdr a) (cddr a))
+  (test a (list 2 3))
+  (test b a))
+
+(define (cons-r a b n) (if (= 0 n) (cons a b) (cons (cons-r (+ a 1) (+ b 1) (- n 1)) (cons-r (- a 1) (- b 1) (- n 1)))))
+(define (list-r a b n) (if (= 0 n) (list a b) (list (list-r (+ a 1) (+ b 1) (- n 1)) (list-r (- a 1) (- b 1) (- n 1)))))
+
+(define lists (list (list 1 2 3)
+		    (cons 1 2)
+		    (list 1)
+		    (list)
+		    (list (list 1 2) (list 3 4))
+		    (list (list 1 2) 3)
+		    '(1 . 2)
+		    '(a b c)
+		    '((a) b (c))
+		    '((1 2) (3 4))
+		    '((1 2 3) (4 5 6) (7 8 9))
+		    '(((1) (2) (3)) ((4) (5) (6)) ((7) (8) (9)))
+		    '((((1 123) (2 124) (3 125) (4 126)) ((5) (6) (7) (8)) ((9) (10) (11) (12)) ((13) (14) (15) (16)))
+		      (((21 127) (22 128) (23 129) (24 130)) ((25) (26) (27) (28)) ((29) (30) (31) (32)) ((33) (34) (35) (36)))
+		      (((41 131) (42 132) (43 133) (44 134)) ((45) (46) (47) (48)) ((49) (50) (51) (52)) ((53) (54) (55) (56)))
+		      (((61 135) (62 136) (63 137) (64 138)) ((65) (66) (67) (68)) ((69) (70) (71) (72)) ((73) (74) (75) (76)))
+		      321)
+		    (cons 1 (cons 2 (cons 3 4)))
+		    (cons (cons 2 (cons 3 4)) 5)
+		    (cons () 1)
+		    (cons 1 ())
+		    (cons () ())
+		    (list 1 2 (cons 3 4) 5 (list (list 6) 7))
+		    (cons-r 0 0 4)
+		    (cons-r 0 0 5)
+		    (cons-r 0 0 10)
+		    (list-r 0 0 3)
+		    (list-r 0 0 7)
+		    (list-r 0 0 11)
+		    ''a
+		    ))
+
+
+;;; --------------------------------------------------------------------------------
+;;; cxr
+
+(define (caar-1 x) (car (car x)))
+(define (cadr-1 x) (car (cdr x)))
+(define (cdar-1 x) (cdr (car x)))
+(define (cddr-1 x) (cdr (cdr x)))
+(define (caaar-1 x) (car (car (car x))))
+(define (caadr-1 x) (car (car (cdr x))))
+(define (cadar-1 x) (car (cdr (car x))))
+(define (caddr-1 x) (car (cdr (cdr x))))
+(define (cdaar-1 x) (cdr (car (car x))))
+(define (cdadr-1 x) (cdr (car (cdr x))))
+(define (cddar-1 x) (cdr (cdr (car x))))
+(define (cdddr-1 x) (cdr (cdr (cdr x))))
+(define (caaaar-1 x) (car (car (car (car x)))))
+(define (caaadr-1 x) (car (car (car (cdr x)))))
+(define (caadar-1 x) (car (car (cdr (car x)))))
+(define (caaddr-1 x) (car (car (cdr (cdr x)))))
+(define (cadaar-1 x) (car (cdr (car (car x)))))
+(define (cadadr-1 x) (car (cdr (car (cdr x)))))
+(define (caddar-1 x) (car (cdr (cdr (car x)))))
+(define (cadddr-1 x) (car (cdr (cdr (cdr x)))))
+(define (cdaaar-1 x) (cdr (car (car (car x)))))
+(define (cdaadr-1 x) (cdr (car (car (cdr x)))))
+(define (cdadar-1 x) (cdr (car (cdr (car x)))))
+(define (cdaddr-1 x) (cdr (car (cdr (cdr x)))))
+(define (cddaar-1 x) (cdr (cdr (car (car x)))))
+(define (cddadr-1 x) (cdr (cdr (car (cdr x)))))
+(define (cdddar-1 x) (cdr (cdr (cdr (car x)))))
+(define (cddddr-1 x) (cdr (cdr (cdr (cdr x)))))
+
+(for-each
+ (lambda (name op1 op2)
+   (for-each
+    (lambda (lst)
+      (let ((val1 (catch #t (lambda () (op1 lst)) (lambda args 'error)))
+	    (val2 (catch #t (lambda () (op2 lst)) (lambda args 'error))))
+	(if (not (equal? val1 val2))
+	    (format #t ";(~A ~S) -> ~S, (~A-1): ~S?~%" name lst val1 name val2))))
+    lists))
+ (list 'caar 'cadr 'cdar 'cddr 'caaar 'caadr 'cadar 'cdaar 'caddr 'cdddr 'cdadr 'cddar
+       'caaaar 'caaadr 'caadar 'cadaar 'caaddr 'cadddr 'cadadr 'caddar 'cdaaar
+       'cdaadr 'cdadar 'cddaar 'cdaddr 'cddddr 'cddadr 'cdddar)
+
+ (list caar cadr cdar cddr caaar caadr cadar cdaar caddr cdddr cdadr cddar
+       caaaar caaadr caadar cadaar caaddr cadddr cadadr caddar cdaaar
+       cdaadr cdadar cddaar cdaddr cddddr cddadr cdddar)
+
+ (list caar-1 cadr-1 cdar-1 cddr-1 caaar-1 caadr-1 cadar-1 cdaar-1 caddr-1 cdddr-1 cdadr-1 cddar-1
+       caaaar-1 caaadr-1 caadar-1 cadaar-1 caaddr-1 cadddr-1 cadadr-1 caddar-1 cdaaar-1
+       cdaadr-1 cdadar-1 cddaar-1 cdaddr-1 cddddr-1 cddadr-1 cdddar-1))
+
+(test (equal? (cadr (list 'a 'b 'c 'd 'e 'f 'g)) 'b) #t)
+(test (equal? (cddr (list 'a 'b 'c 'd 'e 'f 'g)) '(c d e f g)) #t)
+(test (equal? (caddr (list 'a 'b 'c 'd 'e 'f 'g)) 'c) #t)
+(test (equal? (cdddr (list 'a 'b 'c 'd 'e 'f 'g)) '(d e f g)) #t)
+(test (equal? (cadddr (list 'a 'b 'c 'd 'e 'f 'g)) 'd) #t)
+(test (equal? (cddddr (list 'a 'b 'c 'd 'e 'f 'g)) '(e f g)) #t)
+(test (equal? (caadr (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '((u v w) x)) #t)
+(test (equal? (cadar (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '(6 7)) #t)
+(test (equal? (cdaar (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '(5)) #t)
+(test (equal? (cdadr (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '(y)) #t)
+(test (equal? (cddar (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) ()) #t)
+(test (equal? (caaaar (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '(1 2 3)) #t)
+(test (equal? (caadar (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) 6) #t)
+(test (equal? (caaddr (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '(q w e)) #t)
+(test (equal? (cadaar (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) 5) #t)
+(test (equal? (cadadr (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) 'y) #t)
+(test (equal? (caddar (list (list (list (list (list 1 2 3) 4) 5) 1 6 (list 5 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) 6) #t)
+(test (equal? (cadddr (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '(a b c)) #t)
+(test (equal? (cdaaar (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '(4)) #t)
+(test (equal? (cdaadr (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '(x)) #t)
+(test (equal? (cdadar (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '(7)) #t)
+
+(test (caar '((a) b c d e f g)) 'a)
+(test (cadr '(a b c d e f g)) 'b)
+(test (cdar '((a b) c d e f g)) '(b))
+(test (cddr '(a b c d e f g)) '(c d e f g))
+(test (caaar '(((a)) b c d e f g)) 'a)
+(test (caadr '(a (b) c d e f g)) 'b)
+(test (cadar '((a b) c d e f g)) 'b)
+(test (caddr '(a b c d e f g)) 'c)
+(test (cdaar '(((a b)) c d e f g)) '(b))
+(test (cdadr '(a (b c) d e f g)) '(c))
+(test (cddar '((a b c) d e f g)) '(c))
+(test (cdddr '(a b c d e f g)) '(d e f g))
+(test (caaaar '((((a))) b c d e f g)) 'a)
+(test (caaadr '(a ((b)) c d e f g)) 'b)
+(test (caadar '((a (b)) c d e f g)) 'b)
+(test (caaddr '(a b (c) d e f g)) 'c)
+(test (cadaar '(((a b)) c d e f g)) 'b)
+(test (cadadr '(a (b c) d e f g)) 'c)
+(test (caddar '((a b c) d e f g)) 'c)
+(test (cadddr '(a b c d e f g)) 'd)
+(test (cdaaar '((((a b))) c d e f g)) '(b))
+(test (cdaadr '(a ((b c)) d e f g)) '(c))
+(test (cdadar '((a (b c)) d e f g)) '(c))
+(test (cdaddr '(a b (c d) e f g)) '(d))
+(test (cddaar '(((a b c)) d e f g)) '(c))
+(test (cddadr '(a (b c d) e f g)) '(d))
+(test (cdddar '((a b c d) e f g)) '(d))
+(test (cddddr '(a b c d e f g)) '(e f g))
+(test (cadr '(1 2 . 3)) 2)
+(test (cddr '(1 2 . 3)) 3)
+(test (cadadr '''1) 1)
+(test (cdadr '''1) '(1))
+
+;; sacla
+(test (caar '((a) b c)) 'a)
+(test (cadr '(a b c)) 'b)
+(test (cdar '((a . aa) b c)) 'aa)
+(test (cddr '(a b . c)) 'c)
+(test (caaar '(((a)) b c)) 'a)
+(test (caadr '(a (b) c)) 'b)
+(test (cadar '((a aa) b c)) 'aa)
+(test (caddr '(a b c)) 'c)
+(test (cdaar '(((a . aa)) b c)) 'aa)
+(test (cdadr '(a (b . bb) c)) 'bb)
+(test (cddar '((a aa . aaa) b c)) 'aaa)
+(test (cdddr '(a b c . d)) 'd)
+(test (caaaar '((((a))) b c)) 'a)
+(test (caaadr '(a ((b)) c)) 'b)
+(test (caadar '((a (aa)) b c)) 'aa)
+(test (caaddr '(a b (c))) 'c)
+(test (cadaar '(((a aa)) b c)) 'aa)
+(test (cadadr '(a (b bb) c)) 'bb)
+(test (caddar '((a aa aaa) b c)) 'aaa)
+(test (cadddr '(a b c d)) 'd)
+(test (cdaaar '((((a . aa))) b c)) 'aa)
+(test (cdaadr '(a ((b . bb)) c)) 'bb)
+(test (cdadar '((a (aa . aaa)) b c)) 'aaa)
+(test (cdaddr '(a b (c . cc))) 'cc)
+(test (cddaar '(((a aa . aaa)) b c)) 'aaa)
+(test (cddadr '(a (b bb . bbb) c)) 'bbb)
+(test (cdddar '((a aa aaa . aaaa) b c)) 'aaaa)
+(test (cddddr '(a b c d . e)) 'e)
+
+(test (caar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(((1 2 3) 4) 5))
+(test (cadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(((u v w) x) y))
+(test (cdar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '((6 7)))
+(test (cddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(((q w e) r) (a b c) e f g))
+(test (caaar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '((1 2 3) 4))
+(test (caadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '((u v w) x))
+(test (cadar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(6 7))
+(test (caddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '((q w e) r))
+(test (cdaar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(5))
+(test (cdadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(y))
+(test (cddar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) ())
+(test (cdddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '((a b c) e f g))
+(test (caaaar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(1 2 3))
+(test (caaadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(u v w))
+(test (caadar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) 6)
+(test (caaddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(q w e))
+(test (cadaar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) 5)
+(test (cadadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) 'y)
+(test (cadddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(a b c))
+(test (cdaaar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(4))
+(test (cdaadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(x))
+(test (cdadar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(7))
+(test (cdaddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(r))
+(test (cddaar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) ())
+(test (cddadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) ())
+(test (cddddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(e f g))
+
+(test (cadr '(a b c d e f g)) 'b)
+(test (cddr '(a b c d e f g)) '(c d e f g))
+(test (caddr '(a b c d e f g)) 'c)
+(test (cdddr '(a b c d e f g)) '(d e f g))
+(test (cadddr '(a b c d e f g)) 'd)
+(test (cddddr '(a b c d e f g)) '(e f g))
+
+(test (caar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) '((a . b) c . d))
+(test (caar '(((a . b) c . d) (e . f) g . h)) '(a . b))
+(test (caar '((a . b) c . d)) 'a)
+(test (cadr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) '((i . j) k . l))
+(test (cadr '(((a . b) c . d) (e . f) g . h)) '(e . f))
+(test (cadr '((a . b) c . d)) 'c)
+(test (cdar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) '((e . f) g . h))
+(test (cdar '(((a . b) c . d) (e . f) g . h)) '(c . d))
+(test (cdar '((a . b) c . d)) 'b)
+(test (cddr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) '((m . n) o . p))
+(test (cddr '(((a . b) c . d) (e . f) g . h)) '(g . h))
+(test (cddr '((a . b) c . d)) 'd)
+(test (caaar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) '(a . b))
+(test (caaar '(((a . b) c . d) (e . f) g . h)) 'a)
+(test (caadr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) '(i . j))
+(test (caadr '(((a . b) c . d) (e . f) g . h)) 'e)
+(test (cddar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) '(g . h))
+(test (cddar '(((a . b) c . d) (e . f) g . h)) 'd)
+(test (cdddr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) '(o . p))
+(test (cdddr '(((a . b) c . d) (e . f) g . h)) 'h)
+(test (caaaar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) 'a)
+(test (caaadr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) 'i)
+(test (caddar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) 'g)
+(test (cadddr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) 'o)
+(test (cdaaar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) 'b)
+(test (cdaadr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) 'j)
+(test (cdddar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) 'h)
+(test (cddddr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) 'p)
+(test (cadr ''foo) 'foo)
+
+(let ((lst '((((A . B) C . D) (E . F) G . H) ((I . J) K . L) (M . N) O . P))) ; from comp.lang.lisp I think
+  (test (car lst) '(((A . B) C . D) (E . F) G . H))
+  (test (cdr lst) '(((I . J) K . L) (M . N) O . P))
+  (test (caar lst) '((A . B) C . D))
+  (test (cadr lst) '((I . J) K . L))
+  (test (cdar lst) '((E . F) G . H))
+  (test (cddr lst) '((M . N) O . P))
+  (test (caaar lst) '(A . B))
+  (test (caadr lst) '(I . J))
+  (test (cadar lst) '(E . F))
+  (test (caddr lst) '(M . N))
+  (test (cdaar lst) '(C . D))
+  (test (cdadr lst) '(K . L))
+  (test (cddar lst) '(G . H))
+  (test (cdddr lst) '(O . P))
+  (test (caaaar lst) 'A)
+  (test (caaadr lst) 'I)
+  (test (caadar lst) 'E)
+  (test (caaddr lst) 'M)
+  (test (cadaar lst) 'C)
+  (test (cadadr lst) 'K)
+  (test (caddar lst) 'G)
+  (test (cadddr lst) 'O)
+  (test (cdaaar lst) 'B)
+  (test (cdaadr lst) 'J)
+  (test (cdadar lst) 'F)
+  (test (cdaddr lst) 'N)
+  (test (cddaar lst) 'D)
+  (test (cddadr lst) 'L)
+  (test (cdddar lst) 'H)
+  (test (cddddr lst) 'P))
+
+(test (recompose 10 cdr '(1 2 3 4 5 6 7 8 9 10 11 12)) '(11 12))
+(test (recompose 10 car '(((((((((((1 2 3)))))))))))) '(1 2 3))
+
+(test (cons 1 . 2) 'error)
+(test (eval-string "(1 . 2 . 3)") 'error)
+(test (car (list)) 'error)
+(test (car ()) 'error)
+(test (cdr (list)) 'error)
+(test (cdr ()) 'error)
+(test (caddar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) 'error)
+(test (cdddar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) 'error)
+(test (caar '(a b c d e f g)) 'error)
+(test (cdar '(a b c d e f g)) 'error)
+(test (caaar '(a b c d e f g)) 'error)
+(test (caadr '(a b c d e f g)) 'error)
+(test (cadar '(a b c d e f g)) 'error)
+(test (cdaar '(a b c d e f g)) 'error)
+(test (cdadr '(a b c d e f g)) 'error)
+(test (cddar '(a b c d e f g)) 'error)
+(test (caaaar '(a b c d e f g)) 'error)
+(test (caaadr '(a b c d e f g)) 'error)
+(test (caadar '(a b c d e f g)) 'error)
+(test (caaddr '(a b c d e f g)) 'error)
+(test (cadaar '(a b c d e f g)) 'error)
+(test (cadadr '(a b c d e f g)) 'error)
+(test (caddar '(a b c d e f g)) 'error)
+(test (cdaaar '(a b c d e f g)) 'error)
+(test (cdaadr '(a b c d e f g)) 'error)
+(test (cdadar '(a b c d e f g)) 'error)
+(test (cdaddr '(a b c d e f g)) 'error)
+(test (cddaar '(a b c d e f g)) 'error)
+(test (cddadr '(a b c d e f g)) 'error)
+(test (cdddar '(a b c d e f g)) 'error)
+(test (caar 'a) 'error)
+(test (caar '(a)) 'error)
+(test (cadr 'a) 'error)
+(test (cadr '(a . b)) 'error)
+(test (cdar 'a) 'error)
+(test (cdar '(a . b)) 'error)
+(test (cddr 'a) 'error)
+(test (cddr '(a . b)) 'error)
+(test (caaar 'a) 'error)
+(test (caaar '(a)) 'error)
+(test (caaar '((a))) 'error)
+(test (caadr 'a) 'error)
+(test (caadr '(a . b)) 'error)
+(test (caadr '(a b)) 'error)
+(test (cadar 'a) 'error)
+(test (cadar '(a . b)) 'error)
+(test (cadar '((a . c) . b)) 'error)
+(test (caddr 'a) 'error)
+(test (caddr '(a . b)) 'error)
+(test (caddr '(a c . b)) 'error)
+(test (cdaar 'a) 'error)
+(test (cdaar '(a)) 'error)
+(test (cdaar '((a . b))) 'error)
+(test (cdadr 'a) 'error)
+(test (cdadr '(a . b)) 'error)
+(test (cdadr '(a b . c)) 'error)
+(test (cddar 'a) 'error)
+(test (cddar '(a . b)) 'error)
+(test (cddar '((a . b) . b)) 'error)
+(test (cdddr 'a) 'error)
+(test (cdddr '(a . b)) 'error)
+(test (cdddr '(a c . b)) 'error)
+(test (caaaar 'a) 'error)
+(test (caaaar '(a)) 'error)
+(test (caaaar '((a))) 'error)
+(test (caaaar '(((a)))) 'error)
+(test (caaadr 'a) 'error)
+(test (caaadr '(a . b)) 'error)
+(test (caaadr '(a b)) 'error)
+(test (caaadr '(a (b))) 'error)
+(test (caadar 'a) 'error)
+(test (caadar '(a . b)) 'error)
+(test (caadar '((a . c) . b)) 'error)
+(test (caadar '((a c) . b)) 'error)
+(test (caaddr 'a) 'error)
+(test (caaddr '(a . b)) 'error)
+(test (caaddr '(a c . b)) 'error)
+(test (caaddr '(a c b)) 'error)
+(test (cadaar 'a) 'error)
+(test (cadaar '(a)) 'error)
+(test (cadaar '((a . b))) 'error)
+(test (cadaar '((a b))) 'error)
+(test (cadadr 'a) 'error)
+(test (cadadr '(a . b)) 'error)
+(test (cadadr '(a b . c)) 'error)
+(test (cadadr '(a (b . e) . c)) 'error)
+(test (caddar 'a) 'error)
+(test (caddar '(a . b)) 'error)
+(test (caddar '((a . b) . b)) 'error)
+(test (caddar '((a b . c) . b)) 'error)
+(test (cadddr 'a) 'error)
+(test (cadddr '(a . b)) 'error)
+(test (cadddr '(a c . b)) 'error)
+(test (cadddr '(a c e . b)) 'error)
+(test (cdaaar 'a) 'error)
+(test (cdaaar '(a)) 'error)
+(test (cdaaar '((a))) 'error)
+(test (cdaaar '(((a . b)))) 'error)
+(test (cdaadr 'a) 'error)
+(test (cdaadr '(a . b)) 'error)
+(test (cdaadr '(a b)) 'error)
+(test (cdaadr '(a (b . c))) 'error)
+(test (cdadar 'a) 'error)
+(test (cdadar '(a . b)) 'error)
+(test (cdadar '((a . c) . b)) 'error)
+(test (cdadar '((a c . d) . b)) 'error)
+(test (cdaddr 'a) 'error)
+(test (cdaddr '(a . b)) 'error)
+(test (cdaddr '(a c . b)) 'error)
+(test (cdaddr '(a c b . d)) 'error)
+(test (cddaar 'a) 'error)
+(test (cddaar '(a)) 'error)
+(test (cddaar '((a . b))) 'error)
+(test (cddaar '((a b))) 'error)
+(test (cddadr 'a) 'error)
+(test (cddadr '(a . b)) 'error)
+(test (cddadr '(a b . c)) 'error)
+(test (cddadr '(a (b . e) . c)) 'error)
+(test (cdddar 'a) 'error)
+(test (cdddar '(a . b)) 'error)
+(test (cdddar '((a . b) . b)) 'error)
+(test (cdddar '((a b . c) . b)) 'error)
+(test (cddddr 'a) 'error)
+(test (cddddr '(a . b)) 'error)
+(test (cddddr '(a c . b)) 'error)
+(test (cddddr '(a c e . b)) 'error)
+
+(test (caar '((1))) 1)
+(test (cadr '(1 2)) 2)
+(test (cdar '((1 . 2))) 2)
+(test (cddr '(1 2 . 3)) 3)
+(test (caaar '(((1)))) 1)
+(test (caadr '(1 (2))) 2)
+(test (cadar '((1 2))) 2)
+(test (cdaar '(((1 . 2)))) 2)
+(test (caddr '(1 2 3)) 3)
+(test (cdddr '(1 2 3 . 4)) 4)
+(test (cdadr '(1 (2 . 3))) 3)
+(test (cddar '((1 2 . 3))) 3)
+(test (caaaar '((((1))))) 1)
+(test (caaadr '(1 ((2)))) 2)
+(test (caadar '((1 (2)))) 2)
+(test (cadaar '(((1 2)))) 2)
+(test (caaddr '(1 2 (3))) 3)
+(test (cadddr '(1 2 3 4)) 4)
+(test (cadadr '(1 (2 3))) 3)
+(test (caddar '((1 2 3))) 3)
+(test (cdaaar '((((1 . 2))))) 2)
+(test (cdaadr '(1 ((2 . 3)))) 3)
+(test (cdadar '((1 (2 . 3)))) 3)
+(test (cddaar '(((1 2 . 3)))) 3)
+(test (cdaddr '(1 2 (3 . 4))) 4)
+(test (cddddr '(1 2 3 4 . 5)) 5)
+(test (cddadr '(1 (2 3 . 4))) 4)
+(test (cdddar '((1 2 3 . 4))) 4)
+
+(let () (define (f1 x) (eq? (car x) 'y)) (let ((z 1)) (test (f1 z) 'error)))
+(let () (define (f1 x) (eq? (cdr x) 'y)) (let ((z 1)) (test (f1 z) 'error)))
+(let () (define (f1 x) (eq? (caar x) 'y)) (let ((z (list 1 2))) (test (f1 z) 'error)))
+(let () (define (f1 x) (eq? (cadr x) 'y)) (let ((z (cons 1 2))) (test (f1 z) 'error)))
+(let () (define (f1 x) (eq? (cdar x) 'y)) (let ((z (list 1 2))) (test (f1 z) 'error)))
+(let () (define (f1 x) (eq? (cddr x) 'y)) (let ((z (cons 1 2))) (test (f1 z) 'error)))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; length
+
+(test (length (list 'a 'b 'c 'd 'e 'f)) 6)
+(test (length (list 'a 'b 'c 'd)) 4)
+(test (length (list 'a (list 'b 'c) 'd)) 3)
+(test (length ()) 0)
+(test (length '(this-that)) 1)
+(test (length '(this - that)) 3)
+(test (length '(a b)) 2)
+(test (length '(a b c)) 3)
+(test (length '(a (b) (c d e))) 3)
+(test (length (list 1 (cons 1 2))) 2)
+(test (length (list 1 (cons 1 ()))) 2)
+
+(for-each
+ (lambda (arg)
+   (test (length arg) #f))
+ (list (integer->char 65) #f 'a-symbol abs quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (length 'x) #f)
+(test (length (cons 1 2)) -1)
+(let ((x (list 1 2)))
+  (set-cdr! x x)
+  (test (infinite? (length x)) #t))
+(test (length '(1 2 . 3)) -2)
+(test (length) 'error)
+(test (length '(1 2 3) #(1 2 3)) 'error)
+(test (integer? (length (funclet cons))) #t)
+(test (> (length (rootlet)) 200) #t)
+
+(test (length '((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((0))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) 1)
+
+(test (let ((f (lambda (a) (values a (+ a 1)))))
+	(define (f1 x)
+	  (hash-table-entries (and (< (length x) 100) x)))
+	(f1 f))
+      'error)
+(test (let ((f (lambda (a) (values a (+ a 1)))))
+	(define (f1 x)
+	  (hash-table-entries (and (= (length x) 100) x)))
+	(f1 f))
+      'error)
+
+(test (call-with-input-string "01234" (lambda (p) (length p))) 5)
+(test (call-with-input-file "s7test.scm" (lambda (p) (> (length p) 5000000))) #t)
+(unless pure-s7
+  (test (length (call-with-input-file "s7test.scm" (dilambda (lambda* (a b) a) (lambda* (a b c) c)))) #f)) ; (length <closed-port>)
+(test (let ((len 0)) (call-with-output-string (lambda (p) (display "0123" p) (set! len (length p)))) len) 4)
+
+
+;;; --------------------------------------------------------------------------------
+;;; reverse
+
+(test (reverse '(a b c d)) '(d c b a))
+(test (reverse '(a b c))  '(c b a))
+(test (reverse '(a (b c) d (e (f))))  '((e (f)) d (b c) a))
+(test (reverse ()) ())
+(test (reverse (list 1 2 3)) '(3 2 1))
+(test (reverse (list 1)) '(1))
+(test (reverse (list)) (list))
+(test (reverse '(1 2 3)) (list 3 2 1))
+(test (reverse '(1)) '(1))
+(test (reverse '((1 2) 3)) '(3 (1 2)))
+(test (reverse '(((1 . 2) . 3) 4)) '(4 ((1 . 2) . 3)))
+(test (reverse (list (list) (list 1 2))) '((1 2) ()))
+(test (reverse '((a) b c d)) '(d c b (a)))
+(test (reverse (reverse (list 1 2 3 4))) (list 1 2 3 4))
+(test (reverse ''foo) '(foo #_quote))
+(test (let ((x (list 1 2 3 4)))
+	(let ((y (reverse x)))
+	  (and (equal? x (list 1 2 3 4))
+	       (equal? y (list 4 3 2 1)))))
+      #t)
+(test (letrec ((hi (lambda (lst n)
+		     (if (= n 0)
+			 lst
+			 (hi (reverse lst) (- n 1))))))
+	(hi (list 1 2 3) 100))
+      (list 1 2 3))
+(test (let ((var (list 1 2 3))) (reverse (cdr var)) var) (list 1 2 3))
+(test (let ((var '(1 2 3))) (reverse (cdr var)) var) '(1 2 3))
+(test (let ((var (list 1 (list 2 3)))) (reverse (cdr var)) var) (list 1 (list 2 3)))
+(test (let ((var '(1 (2 3)))) (reverse (cdr var)) var) '(1 (2 3)))
+(test (let ((var (list (list 1 2) (list 3 4 5)))) (reverse (car var)) var) '((1 2) (3 4 5)))
+(test (let ((x '(1 2 3))) (list (reverse x) x)) '((3 2 1) (1 2 3)))
+(test (reverse '(1 2)) '(2 1))
+(test (reverse '(1 2 3)) '(3 2 1))
+(test (reverse '(1 2 3 4)) '(4 3 2 1))
+
+(when with-block
+  (test (block? (reverse _c_obj_)) #t)
+  (let ((b (block 1 2 3 4)))
+    (let ((b1 (reverse b)))
+      (test b1 (block 4 3 2 1))
+      (test b (block 1 2 3 4)))))
+
+(for-each
+ (lambda (lst)
+   (if (proper-list? lst)
+       (if (not (equal? lst (reverse (reverse lst))))
+	   (format #t ";(reverse (reverse ~A)) -> ~A?~%" lst (reverse (reverse lst))))))
+ lists)
+
+(for-each
+ (lambda (lst)
+   (if (proper-list? lst)
+       (if (not (equal? lst (reverse (reverse (reverse (reverse lst))))))
+	   (format #t ";(reverse...(4x) ~A) -> ~A?~%" lst (reverse (reverse (reverse (reverse lst))))))))
+ lists)
+
+(test (let ((x (list 1 2 3))) (list (recompose 32 reverse x) x)) '((1 2 3) (1 2 3)))
+(test (let ((x (list 1 2 3))) (list (recompose 31 reverse x) x)) '((3 2 1) (1 2 3)))
+
+(test (reverse (cons 1 2)) '(2 . 1))
+(test (reverse '(1 . 2)) '(2 . 1))
+(test (reverse '(1 2 . 3)) '(3 2 1))
+(test (reverse) 'error)
+(test (reverse '(1 2 3) '(3 2 1)) 'error)
+(test (reverse (subvector (make-int-vector '(2 3) 0) 0 6 '(6))) (make-int-vector 6 0))
+(test (reverse (make-float-vector 6 0.0)) (make-float-vector 6 0.0))
+
+(for-each
+ (lambda (arg)
+   (test (reverse arg) 'error))
+ (list (integer->char 65) #f 'a-symbol abs quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (reverse "hi") "ih")
+(test (reverse "") "")
+(test (reverse "123") "321")
+(test (reverse "1234") "4321")
+(test (reverse "12") "21")
+(test (reverse "a\x00;b") "b\x00;a")
+(test (reverse #()) #())
+(test (reverse #(1)) #(1))
+(test (reverse #(1 2)) #(2 1))
+(test (reverse #(1 2 3)) #(3 2 1))
+(test (reverse #(1 2 3 4)) #(4 3 2 1))
+(test (reverse #2d((1 2) (3 4))) #2d((4 3) (2 1)))
+(test (reverse (string #\a #\null #\b)) "b\x00;a")
+(test (reverse abs) 'error)
+(test (vector->list (reverse (let ((v (make-int-vector 3))) (set! (v 1) 1) (set! (v 2) 2) v))) '(2 1 0))
+(test (reverse (int-vector)) #())
+(test (reverse (int-vector 1)) (int-vector 1))
+(test (reverse (int-vector 1 2)) (int-vector 2 1))
+(test (reverse (int-vector 1 2 3)) (int-vector 3 2 1))
+(test (reverse (int-vector 1 2 3 4)) (int-vector 4 3 2 1))
+(test (reverse (float-vector)) #())
+(test (reverse (float-vector 1)) (float-vector 1))
+(test (reverse (float-vector 1 2)) (float-vector 2 1))
+(test (reverse (float-vector 1 2 3)) (float-vector 3 2 1))
+(test (reverse (float-vector 1 2 3 4)) (float-vector 4 3 2 1))
+(test (let ((v #(1 2 3))) (reverse v) v) #(1 2 3))
+(test (reverse #u(1 2 3)) #u(3 2 1))
+(test (reverse #u(1 2)) #u(2 1))
+(test (reverse #u(1 2 3 4)) #u(4 3 2 1))
+
+(test (vector-typer (reverse (make-vector 3 'a symbol?))) symbol?) ; integer? -> int-vector
+(let ((V (make-vector 4 'a symbol?)))
+  (test (object->string V :readable) "(let ((<v> (vector 'a 'a 'a 'a))) (set! (vector-typer <v>) symbol?) <v>)"))
+(let ((V (make-vector 4 'a symbol?)))
+  (test (object->string (reverse V) :readable) "(let ((<v> (vector 'a 'a 'a 'a))) (set! (vector-typer <v>) symbol?) <v>)"))
+
+(when with-block
+  (let ((b (block 1.0 2.0 3.0)))
+    (set! (b 1) 32.0)
+    (test (b 1) 32.0)
+    (let ((b1 (reverse b)))
+      (test b1 (block 3.0 32.0 1.0)))))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; reverse!
+
+(test (reverse! '(1 . 2)) 'error)
+(test (reverse! (cons 1 2)) 'error)
+(test (reverse! (cons 1 (cons 2 3))) 'error)
+(test (reverse!) 'error)
+(test (reverse! '(1 2 3) '(3 2 1)) 'error)
+
+(test (reverse! '(a b c d)) '(d c b a))
+(test (reverse! '(a b c))  '(c b a))
+(test (reverse! '(a (b c) d (e (f))))  '((e (f)) d (b c) a))
+(test (reverse! ()) ())
+(test (reverse! (list 1 2 3)) '(3 2 1))
+(test (reverse! (list 1)) '(1))
+(test (reverse! (list)) (list))
+(test (reverse! '(1 2 3)) (list 3 2 1))
+(test (reverse! '(1)) '(1))
+(test (reverse! '((1 2) 3)) '(3 (1 2)))
+(test (reverse! '(((1 . 2) . 3) 4)) '(4 ((1 . 2) . 3)))
+(test (reverse! (list (list) (list 1 2))) '((1 2) ()))
+(test (reverse! '((a) b c d)) '(d c b (a)))
+(test (reverse! (reverse! (list 1 2 3 4))) (list 1 2 3 4))
+(test (reverse! (reverse! (sort! (list 1 2 3 4) >))) (sort! (list 1 2 3 4) >))
+(test (reverse! ''foo) '(foo #_quote))
+(test (reverse (reverse! (list 1 2 3))) (list 1 2 3))
+(test (reverse (reverse! (reverse! (reverse (list 1 2 3))))) (list 1 2 3))
+(test (reverse! "") "")
+(test (reverse! #()) #())
+(test (reverse! #i()) #i())
+(test (reverse! #r()) #r())
+(test (reverse! #u()) #u())
+(test (reverse! (immutable! #(1))) #(1))
+(test (reverse! #i(1)) #i(1))
+
+;; check dumb optimization oversight
+(when with-block
+  (let ((b (block 0 1 2 3 4 5 6 7)))
+    (set! b (reverse! b))
+    (test b (block 7 6 5 4 3 2 1 0))))
+(test (reverse! #r(0 1 2 3 4 5 6 7)) #r(7 6 5 4 3 2 1 0))
+(test (reverse! #i(0 1 2 3 4 5 6 7)) #i(7 6 5 4 3 2 1 0))
+(test (reverse! #(0 1 2 3 4 5 6 7)) #(7 6 5 4 3 2 1 0))
+(test (reverse! #u(0 1 2 3 4 5 6 7)) #u(7 6 5 4 3 2 1 0))
+(test (reverse! "01234567") "76543210")
+
+(do ((i 0 (+ i 1)))
+    ((= i 33))
+  (let ((b (make-vector i))
+	(s (make-string i)))
+    (do ((j 0 (+ j 1)))
+	((= i j))
+      (set! (b j) j)
+      (set! (s j) (integer->char (+ 32 j))))
+    (set! b (reverse! b))
+    (set! s (reverse! s))
+    (do ((j 0 (+ j 1)))
+	((= i j))
+      (if (not (= (b j) (- i j 1)))
+	  (format *stderr* "~A at ~A ~A~%" b i j))
+      (if (not (char=? (s j) (integer->char (+ 32 (- i j 1)))))
+	  (format *stderr* "~S at ~A ~A~%" s i j)))))
+
+
+(test (let ((x (list 1 2 3))) (recompose 31 reverse! x)) '(3 2 1))
+(test (reverse! '(1 2 . 3)) 'error)
+
+(let* ((lst1 (list 1 2 3))
+       (lst2 (apply list '(4 5 6)))
+       (lst3 (sort! (reverse! (append lst1 lst2)) <)))
+  (test lst3 '(1 2 3 4 5 6))
+  (define (lt . args)
+    args)
+  (set! lst3 (sort! (apply reverse! (lt lst3)) >))
+  (test lst3 '(6 5 4 3 2 1)))
+
+(for-each
+ (lambda (arg)
+   (test (reverse! arg) 'error))
+ (list (integer->char 65) #f 'a-symbol abs _ht_ _undef_ _null_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
+
+(test (let ((str "1234")) (reverse! str) str) "4321")
+(test (let ((str "123")) (reverse! str) str) "321")
+(test (let ((str "")) (reverse! str) str) "")
+(test (let ((v #(1 2 3))) (reverse! v) v) #(3 2 1))
+(test (let ((v #(1 2 3 4))) (reverse! v) v) #(4 3 2 1))
+(test (let ((v #())) (reverse! v) v) #())
+(test (let ((v (float-vector 1.0 2.0 3.0))) (reverse! v) v) (float-vector 3.0 2.0 1.0))
+(test (let ((v (float-vector 1.0 2.0 3.0 4.0))) (reverse! v) v) (float-vector 4.0 3.0 2.0 1.0))
+(test (let ((v (float-vector))) (reverse! v) v) #())
+(test (let ((v (int-vector 1 2 3))) (reverse! v) v) (int-vector 3 2 1))
+(test (let ((v (int-vector 1 2 3 4))) (reverse! v) v) (int-vector 4 3 2 1))
+(test (let ((v (int-vector))) (reverse! v) v) #())
+(when with-block
+  (test (block? (reverse! _c_obj_)) #t)
+  (let ((b (block 1 2 3 4)))
+    (reverse! b)
+    (test b (block 4 3 2 1)))
+  (let ((b (block 1 2 3 4 5 6 7 8 9)))
+    (set! b (reverse! b))
+    (test b (block 9 8 7 6 5 4 3 2 1))))
+(test (let ((v (make-int-vector 3 1))) (set! (v 1) 2) (set! (v 2) 3) (reverse! v) v) (let ((v (make-int-vector 3 3))) (set! (v 1) 2) (set! (v 2) 1) v))
+
+(when full-s7test
+  (let ()
+    ;; some sequence tests
+
+    (define (fv-tst len)
+      (let ((fv (make-float-vector len)))
+	(if (not (= (length fv) len))
+	    (format *stderr* "float-vector length ~A: ~A~%" fv (length fv)))
+	(fill! fv 0.0)
+	(let ((fv-orig (copy fv)))
+	  (do ((i 0 (+ i 1)))
+	      ((= i len))
+	    (set! (fv i) (- (random 1000.0) 500.0)))
+	  (let ((fv-ran (copy fv))
+		(fv-ran1 (copy fv)))
+	    (sort! fv <)
+	    (call-with-exit
+	     (lambda (quit)
+	       (do ((i 1 (+ i 1)))
+		   ((= i len))
+		 (when (> (fv (- i 1)) (fv i))
+		   (format *stderr* "float-vector: ~A > ~A at ~D~%" (fv (- i 1)) (fv i) i)
+		   (quit)))))
+	    (sort! fv-ran (lambda (a b) (< a b)))
+	    (if (not (equivalent? fv fv-ran))
+		(format *stderr* "float-vector closure not equal~%"))
+	    (sort! fv-ran1 (lambda (a b) (cond ((< a b) #t) (#t #f))))
+	    (if (not (equivalent? fv fv-ran1))
+		(format *stderr* "float-vector cond closure not equal~%")))
+
+	  (let ((fv-copy (copy fv)))
+	    (reverse! fv)
+	    (if (and (not (equivalent? fv-copy fv))
+		     (equivalent? fv fv-orig))
+		(format *stderr* "float-vector reverse!: ~A ~A~%" fv fv-orig))
+	    (reverse! fv)
+	    (if (not (equivalent? fv-copy fv))
+		(format *stderr* "float-vector reverse! twice: ~A ~A~%" fv fv-copy))
+	    (let ((fv1 (apply float-vector (make-list len 1.0))))
+	      (if (or (not (= (length fv1) len))
+		      (not (= (fv1 (- len 1)) 1.0)))
+		  (format *stderr* "float-vector apply: ~A ~A~%" len (fv (- len 1)))))
+	    ))))
+
+    (define (iv-tst len)
+      (let ((fv (make-int-vector len 0)))
+	(if (not (= (length fv) len))
+	    (format *stderr* "int-vector length ~A: ~A~%" fv (length fv)))
+	(fill! fv 0)
+	(let ((fv-orig (copy fv)))
+	  (do ((i 0 (+ i 1)))
+	      ((= i len))
+	    (set! (fv i) (- (random 1000000) 500000)))
+	  (let ((fv-ran (copy fv))
+		(fv-ran1 (copy fv)))
+	    (sort! fv <)
+	    (call-with-exit
+	     (lambda (quit)
+	       (do ((i 1 (+ i 1)))
+		   ((= i len))
+		 (when (> (fv (- i 1)) (fv i))
+		   (format *stderr* "int-vector: ~A > ~A at ~D~%" (fv (- i 1)) (fv i) i)
+		   (quit)))))
+	    (sort! fv-ran (lambda (a b) (< a b)))
+	    (if (not (equivalent? fv fv-ran))
+		(format *stderr* "int-vector closure not equal~%"))
+	    (sort! fv-ran1 (lambda (a b) (cond ((< a b) #t) (#t #f))))
+	    (if (not (equivalent? fv fv-ran1))
+		(format *stderr* "int-vector cond closure not equal~%")))
+
+	  (let ((fv-copy (copy fv)))
+	    (reverse! fv)
+	    (if (and (not (equivalent? fv-copy fv))
+		     (equivalent? fv fv-orig))
+		(format *stderr* "int-vector reverse!: ~A ~A~%" fv fv-orig))
+	    (reverse! fv)
+	    (if (not (equivalent? fv-copy fv))
+		(format *stderr* "int-vector reverse! twice: ~A ~A~%" fv fv-copy))
+	    ))))
+
+    (define (v-tst len)
+      (let ((fv (make-vector len)))
+	(if (not (= (length fv) len))
+	    (format *stderr* "vector length ~A: ~A~%" fv (length fv)))
+	(fill! fv 0)
+	(let ((fv-orig (copy fv)))
+	  (do ((i 0 (+ i 1)))
+	      ((= i len))
+	    (set! (fv i) (- (random 1000000) 500000)))
+	  (let ((fv-ran (copy fv))
+		(fv-ran1 (copy fv)))
+	    (sort! fv <)
+	    (call-with-exit
+	     (lambda (quit)
+	       (do ((i 1 (+ i 1)))
+		   ((= i len))
+		 (when (> (fv (- i 1)) (fv i))
+		   (format *stderr* "vector: ~A > ~A at ~D~%" (fv (- i 1)) (fv i) i)
+		   (quit)))))
+	    (sort! fv-ran (lambda (a b) (< a b)))
+	    (if (not (equivalent? fv fv-ran))
+		(format *stderr* "vector closure not equal~%"))
+	    (sort! fv-ran1 (lambda (a b) (cond ((< a b) #t) (#t #f))))
+	    (if (not (equivalent? fv fv-ran1))
+		(format *stderr* "vector cond closure not equal~%")))
+
+	  (let ((fv-copy (copy fv)))
+	    (reverse! fv)
+	    (if (and (not (equivalent? fv-copy fv))
+		     (equivalent? fv fv-orig))
+		(format *stderr* "vector reverse!: ~A ~A~%" fv fv-orig))
+	    (reverse! fv)
+	    (if (not (equivalent? fv-copy fv))
+		(format *stderr* "vector reverse! twice: ~A ~A~%" fv fv-copy))
+	    (let ((fv1 (apply vector (make-list len 1))))
+	      (if (or (not (= (length fv1) len))
+		      (not (= (fv1 (- len 1)) 1)))
+		  (format *stderr* "vector apply: ~A ~A~%" len (fv (- len 1)))))
+	    ))))
+
+    (define (s-tst len)
+      (let ((fv (make-string len)))
+	(if (not (= (length fv) len))
+	    (format *stderr* "string length ~A: ~A~%" fv (length fv)))
+	(fill! fv #\a)
+	(let ((fv-orig (copy fv)))
+	  (do ((i 0 (+ i 1)))
+	      ((= i len))
+	    (set! (fv i) (integer->char (+ 20 (random 100)))))
+	  (let ((fv-ran (copy fv))
+		(fv-ran1 (copy fv)))
+	    (sort! fv char<?)
+	    (call-with-exit
+	     (lambda (quit)
+	       (do ((i 1 (+ i 1)))
+		   ((= i len))
+		 (when (char>? (fv (- i 1)) (fv i))
+		   (format *stderr* "string: ~A > ~A at ~D~%" (fv (- i 1)) (fv i) i)
+		   (quit)))))
+	    (sort! fv-ran (lambda (a b) (char<? a b)))
+	    (if (not (equivalent? fv fv-ran))
+		(format *stderr* "string closure not equal~%"))
+	    (sort! fv-ran1 (lambda (a b) (cond ((char<? a b) #t) (#t #f))))
+	    (if (not (equivalent? fv fv-ran))
+		(format *stderr* "string cond closure not equal~%")))
+
+	  (let ((fv-copy (copy fv)))
+	    (reverse! fv)
+	    (if (and (not (equivalent? fv-copy fv))
+		     (equivalent? fv fv-orig))
+		(format *stderr* "string reverse!: ~A ~A~%" fv fv-orig))
+	    (reverse! fv)
+	    (if (not (equivalent? fv-copy fv))
+		(format *stderr* "string reverse! twice: ~A ~A~%" fv fv-copy))
+	    (let ((fv1 (apply string (make-list len #\a))))
+	      (if (or (not (= (length fv1) len))
+		      (not (char=? (fv1 (- len 1)) #\a)))
+		  (format *stderr* "string apply: ~A ~A~%" len (fv (- len 1)))))
+	    ))))
+
+    (define (p-tst len)
+      (let ((fv (make-list len)))
+	(if (not (= (length fv) len))
+	    (format *stderr* "list length ~A: ~A~%" fv (length fv)))
+	(fill! fv 0)
+	(let ((fv-orig (copy fv)))
+	  (do ((p fv (cdr p)))
+	      ((null? p))
+	    (set-car! p (- (random 100000) 50000)))
+	  (let ((fv-ran (copy fv)))
+	    (sort! fv <)
+	    (call-with-exit
+	     (lambda (quit)
+	       (do ((p0 fv (cdr p0))
+		    (p1 (cdr fv) (cdr p1))
+		    (i 1 (+ i 1)))
+		   ((null? p1))
+		 (when (> (car p0) (car p1))
+		   (format *stderr* "list: ~A > ~A at ~D~%" (car p0) (car p1) i)
+		   (quit)))))
+	    (sort! fv-ran (lambda (a b) (< a b)))
+	    (if (not (equivalent? fv fv-ran))
+		(format *stderr* "pair closure not equal~%")))
+
+	  (let ((fv-copy (copy fv)))
+	    (set! fv (reverse! fv))
+	    (if (and (not (equivalent? fv-copy fv))
+		     (equivalent? fv fv-orig))
+		(format *stderr* "list reverse!: ~A ~A~%" fv fv-orig))
+	    (set! fv (reverse! fv))
+	    (if (not (equivalent? fv-copy fv))
+		(format *stderr* "list reverse! twice: ~A ~A~%" fv fv-copy))
+	    ))))
+
+    (for-each
+     (lambda (b p)
+       (do ((k 0 (+ k 1)))
+	   ((= k 1000))
+	 (fv-tst b)
+	 (iv-tst b)
+	 (v-tst b)
+	 (s-tst b)
+	 (p-tst b))
+       (do ((i 0 (+ i 1)))
+	   ((= i p))
+	 (format *stderr* "~D fv " (expt b i))
+	 (fv-tst (expt b i))
+	 (format *stderr* "iv ")
+	 (iv-tst (expt b i))
+	 (format *stderr* "v ")
+	 (v-tst (expt b i))
+	 (format *stderr* "s ")
+	 (s-tst (expt b i))
+	 (format *stderr* "p ")
+	 (p-tst (expt b i))
+	 (newline *stderr*)
+	 ))
+     (list 2 3 4 7 10)
+     (list 12 4 3 6 6))
+    ))
+
+(test (let ((v (vector 1 2 3 4))) (let ((sv (subvector v 0 3))) (reverse! sv) v)) #(3 2 1 4))
+(test (let ((v (vector 1 2 3 4))) (let ((sv (subvector v 1 4))) (reverse! sv) v)) #(1 4 3 2))
+(test (let ((v (vector 1 2 3 4))) (let ((sv (subvector v 1 4))) (fill! sv 5) v)) #(1 5 5 5))
+(test (let ((v (vector 1 2 3 4))) (let ((sv (subvector v 1 4))) (reverse sv) v)) #(1 2 3 4))
+(test (let ((v (vector 1 2 3 4))) (let ((sv (subvector v 1 4))) (sort! sv >) v)) #(1 4 3 2))
+(test (let ((v (make-int-vector '(3 3) 1))) (let ((sv (v 1))) (fill! sv 2) v)) (subvector (int-vector 1 1 1 2 2 2 1 1 1) 0 9 '(3 3)))
+(test (immutable? (subvector (immutable! (vector 1 2 3 4)) 0 4 '(2 2))) #t)
+
+(test (let ((v (make-int-vector '(3 3) 1)))
+	(do ((i 0 (+ i 1)))
+	    ((= i 3))
+	  (do ((j 0 (+ j 1)))
+	      ((= j 3))
+	    (set! (v i j) (+ j (* i 3)))))
+	(let ((sv (v 1)))
+	  (fill! sv 2)
+	  v))
+      (subvector (int-vector 0 1 2 2 2 2 6 7 8) 0 9 '(3 3)))
+
+(test (let ((v (make-int-vector '(3 3) 1)))
+	(do ((i 0 (+ i 1)))
+	    ((= i 3))
+	  (do ((j 0 (+ j 1)))
+	      ((= j 3))
+	    (set! (v i j) (+ j (* i 3)))))
+	(let ((sv (v 1)))
+	  (sort! sv >)
+	  v))
+      (subvector (int-vector 0 1 2 5 4 3 6 7 8) 0 9 '(3 3)))
+
+(test (let ((v (make-int-vector '(3 3) 1)))
+	(do ((i 0 (+ i 1)))
+	    ((= i 3))
+	  (do ((j 0 (+ j 1)))
+	      ((= j 3))
+	    (set! (v i j) (+ j (* i 3)))))
+	(let ((sv (v 1)))
+	  (reverse! sv)
+	  v))
+      (subvector (int-vector 0 1 2 5 4 3 6 7 8) 0 9 '(3 3)))
+
+(test (catch #t
+	(lambda ()
+	  (reverse! (catch #t 1 cons))
+	  (reverse! (catch #t 1 cons))) ; this will clobber sc->wrong_type_arg_info if not caught
+	(lambda args 'error))
+      'error)
+(test (reverse! `((1) . x)) 'error)
+(if with-block (test (reverse! (immutable! (block 0 0))) 'error))
+
+(when full-s7test
+  (let ()
+    (define (revstr size)
+      (let ((str (make-string size)))
+	(do ((i 0 (+ i 1)))
+	    ((= i size))
+	  (string-set! str i (integer->char (+ i 20))))
+	(let ((rstr (reverse! str)))
+	  (do ((i 0 (+ i 1))
+	       (j (- size 1) (- j 1)))
+	      ((= i size))
+	    (unless (char=? (string-ref str j) (integer->char (+ i 20)))
+	      (format *stderr* "revstr ~D: ~A ~A~%" i (string-ref str j) (integer->char (+ i 20))))))))
+
+    (do ((i 1 (+ i 1)))
+	((= i 8))
+      (revstr (expt 2 i)))
+
+    (define (revint size)
+      (let ((str (make-int-vector size)))
+	(do ((i 0 (+ i 1)))
+	    ((= i size))
+	  (int-vector-set! str i i))
+	(let ((rstr (reverse! str)))
+	  (do ((i 0 (+ i 1))
+	       (j (- size 1) (- j 1)))
+	      ((= i size))
+	    (unless (= (int-vector-ref str j) i)
+	      (format *stderr* "revint ~D: ~A ~A~%" i (int-vector-ref str j) i))))))
+
+    (do ((i 3 (+ i 1)))
+	((= i 10))
+      (revint (expt 2 i)))
+    ))
+
+
+;;; --------------------------------------------------------------------------------
+;;; pair?
+
+(test (pair? 'a) #f)
+(test (pair? '()) #f)
+(test (pair? ()) #f)
+(test (pair? '(a b c)) #t)
+(test (pair? (cons 1 2)) #t)
+(test (pair? ''()) #t)
+(test (pair? #f) #f)
+(test (pair? (make-vector 6)) #f)
+(test (pair? #t) #f)
+(test (pair? '(a . b)) #t)
+(test (pair? #(a b))  #f)
+(test (pair? (list 1 2)) #t)
+(test (pair? (list)) #f)
+(test (pair? ''foo) #t)
+(test (pair? (list 'a 'b 'c 'd 'e 'f)) #t)
+(test (pair? '(this-that)) #t)
+(test (pair? '(this - that)) #t)
+(let ((x (list 1 2)))
+  (set-cdr! x x)
+  (test (pair? x) #t))
+(test (pair? (list 1 (cons 1 2))) #t)
+(test (pair? (list 1 (cons 1 ()))) #t)
+(test (pair? (cons 1 ())) #t)
+(test (pair? (cons () ())) #t)
+(test (pair? (cons () 1)) #t)
+(test (pair? (list (list))) #t)
+(test (pair? '(())) #t)
+(test (pair? (cons 1 (cons 2 3))) #t)
+(test (pair?) 'error)
+(test (pair? `'1) #t)
+(test (pair? begin) #f)
+(test (pair? 'begin) #f)
+(test (pair? ''begin) #t)
+(test (pair? list) #f)
+
+(for-each
+ (lambda (arg)
+   (if (pair? arg)
+       (format #t ";(pair? ~A) -> #t?~%" arg)))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+
+;;; pair-line-number
+
+(test (pair-line-number) 'error)
+(test (pair-line-number () ()) 'error)
+(for-each
+ (lambda (arg)
+   (test (pair-line-number arg) 'error))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+;; pair-filename
+
+(test (pair-filename) 'error)
+(test (pair-filename () ()) 'error)
+(for-each
+ (lambda (arg)
+   (test (pair-filename arg) 'error))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(let ()
+  (call-with-output-file "t559.scm"
+    (lambda (p)
+      (format p "~%~%~%(define (pair-fl-test)~%  (+ 1 2))~%~%(list (port-line-number) (port-filename))~%~%")))
+  (let ((loc (load "t559.scm" (curlet))))
+    (test loc (list 7 "t559.scm")))
+  (let ((s (procedure-source pair-fl-test)))
+    (if (pair? s)
+        (begin
+          (test (pair-filename (cddr s)) "t559.scm")
+          (test (pair-line-number (cddr s)) 4))
+        (format *stderr* "t559.scm no source~%"))))
+
+
+;;; --------------------------------------------------------------------------------
+;;; list?
+
+(test (list? 'a) #f)
+(test (list? ()) #t)
+(test (list? '(a b c)) #t)
+(test (list? (cons 1 2)) #t)
+(test (list? ''()) #t)
+(test (list? #f) #f)
+(test (list? (make-vector 6)) #f)
+(test (list? #t) #f)
+(test (list? '(a . b)) #t)
+(test (list? #(a b))  #f)
+(test (list? (list 1 2)) #t)
+(test (list? (list)) #t)
+(test (list? ''foo) #t)
+(test (list? ''2) #t)
+(test (list? (list 'a 'b 'c 'd 'e 'f)) #t)
+(test (list? '(this-that)) #t)
+(test (list? '(this - that)) #t)
+(let ((x (list 1 2)))
+  (set-cdr! x x)
+  (test (proper-list? x) #f)
+  (test (list? x) #t))
+(test (list? (list 1 (cons 1 2))) #t)
+(test (list? (list 1 (cons 1 ()))) #t)
+(test (list? (cons 1 ())) #t)
+(test (list? (cons () ())) #t)
+(test (list? (cons () 1)) #t)
+(test (list? (list (list))) #t)
+(test (list? '(())) #t)
+(test (list? '(1 2 . 3)) #t)
+(test (list? (cons 1 (cons 2 3))) #t)
+(test (list? '(1 . ())) #t)
+
+(test (list? '(1 2) ()) 'error)
+(test (list?) 'error)
+(for-each
+ (lambda (arg)
+   (if (list? arg)
+       (format #t ";(list? ~A) -> #t?~%" arg)))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+
+;;; proper-list?
+
+(test (proper-list? 'a) #f)
+(test (proper-list? ()) #t)
+(test (proper-list? '(a b c)) #t)
+(test (proper-list? (cons 1 2)) #f)
+(test (proper-list? ''()) #t)
+(test (proper-list? #f) #f)
+(test (proper-list? (make-vector 6)) #f)
+(test (proper-list? #t) #f)
+(test (proper-list? '(a . b)) #f)
+(test (proper-list? #(a b))  #f)
+(test (proper-list? (list 1 2)) #t)
+(test (proper-list? (list)) #t)
+(test (proper-list? ''foo) #t)
+(test (proper-list? ''2) #t)
+(test (proper-list? (list 'a 'b 'c 'd 'e 'f)) #t)
+(test (proper-list? '(this-that)) #t)
+(test (proper-list? '(this - that)) #t)
+(let ((x (list 1 2)))
+  (set-cdr! x x)
+  (test (proper-list? x) #f))
+(test (proper-list? (list 1 (cons 1 2))) #t)
+(test (proper-list? (list 1 (cons 1 ()))) #t)
+(test (proper-list? (cons 1 ())) #t)
+(test (proper-list? (cons () ())) #t)
+(test (proper-list? (cons () 1)) #f)
+(test (proper-list? (list (list))) #t)
+(test (proper-list? '(())) #t)
+(test (proper-list? '(1 2 . 3)) #f)
+(test (proper-list? (cons 1 (cons 2 3))) #f)
+(test (proper-list? '(1 . ())) #t)
+
+(test (proper-list? (let ((lst (list 1))) (set-cdr! lst lst) lst)) #f)
+(test (proper-list? (let ((lst (list 1 2))) (set-cdr! (cdr lst) lst) lst)) #f)
+(test (proper-list? (let ((lst (list 1 2 3))) (set-cdr! (cddr lst) lst) lst)) #f)
+(test (proper-list? (let ((lst (list 1 2 3 4))) (set-cdr! (cdddr lst) lst) lst)) #f)
+(test (proper-list? (let ((lst (list 1 2 3 4 5))) (set-cdr! (cdr (cdddr lst)) lst) lst)) #f)
+
+(test (proper-list? '(1 2) ()) 'error)
+(test (proper-list?) 'error)
+(for-each
+ (lambda (arg)
+   (if (proper-list? arg)
+       (format #t ";(list? ~A) -> #t?~%" arg)))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+
+;;; --------------------------------------------------------------------------------
+;;; null?
+
+(test (null? 'a) '#f)
+(test (null? ()) #t)
+(test (null? ()) #t)
+(test (null? '(a b c)) #f)
+(test (null? (cons 1 2)) #f)
+(test (null? ''()) #f)
+(test (null? #f) #f)
+(test (null? (make-vector 6)) #f)
+(test (null? #t) #f)
+(test (null? '(a . b)) #f)
+(test (null? #(a b))  #f)
+(test (null? (list 1 2)) #f)
+(test (null? (list)) #t)
+(test (null? ''foo) #f)
+(test (null? (list 'a 'b 'c 'd 'e 'f)) #f)
+(test (null? '(this-that)) #f)
+(test (null? '(this - that)) #f)
+(let ((x (list 1 2)))
+  (set-cdr! x x)
+  (test (null? x) #f))
+(test (null? (list 1 (cons 1 2))) #f)
+(test (null? (list 1 (cons 1 ()))) #f)
+(test (null? (cons 1 ())) #f)
+(test (null? (cons () ())) #f)
+(test (null? (cons () 1)) #f)
+(test (null? (list (list))) #f)
+(test (null? '(())) #f)
+(test (null? #()) #f)
+(test (null? (make-vector '(2 0 3))) #f)
+(test (null? "") #f)
+(test (null? lambda) #f)
+(test (null? cons) #f)
+(test (null? (begin)) #t)
+(test (null? (cdr (list 1))) #t)
+(test (null? (cdr (cons () '(())))) #f)
+
+(test (null? () ()) 'error)
+(test (null?) 'error)
+
+(for-each
+ (lambda (arg)
+   (if (null? arg)
+       (format #t ";(null? ~A) -> #t?~%" arg)))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #\f #t (if #f #f) :hi #<eof> #<undefined> (values) (lambda (a) (+ a 1))))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; set-car!
+
+(test (let ((x (cons 1 2))) (set-car! x 3) x) (cons 3 2))
+(test (let ((x (list 1 2))) (set-car! x 3) x) (list 3 2))
+(test (let ((x (list (list 1 2) 3))) (set-car! x 22) x) (list 22 3))
+(test (let ((x (cons 1 2))) (set-car! x ()) x) (cons () 2))
+(test (let ((x (list 1 (list 2 3 4)))) (set-car! x (list 5 (list 6))) x) (list (list 5 (list 6)) (list 2 3 4)))
+(test (let ((x '(((1) 2) (3)))) (set-car! x '((2) 1)) x) '(((2) 1) (3)))
+(test (let ((x ''foo)) (set-car! x "hi") x) (list "hi" 'foo))
+(test (let ((x '((1 . 2) . 3))) (set-car! x 4) x) '(4 . 3))
+(test (let ((x '(1 . 2))) (set-car! x (cdr x)) x) '(2 . 2))
+(test (let ((x '(1 . 2))) (set-car! x x) (proper-list? x)) #f)
+(test (let ((x (list 1))) (set-car! x ()) x) '(()))
+(test (let ((x '(((1 2) . 3) 4))) (set-car! x 1) x) '(1 4))
+(test (let ((lst (cons 1 (cons 2 3)))) (set-car! (cdr lst) 4) lst) (cons 1 (cons 4 3)))
+(test (let ((lst (cons 1 (cons 2 3)))) (set-car! lst 4) lst) (cons 4 (cons 2 3)))
+(test (let ((x (list 1 2))) (set! (car x) 0) x) (list 0 2))
+(test (let ((x (cons 1 2))) (set! (cdr x) 0) x) (cons 1 0))
+(test (let ((x (list 1 2))) (set-car! x (list 3 4)) x) '((3 4) 2))
+(test (let ((x (cons 1 2))) (set-car! x (list 3 4)) x) '((3 4) . 2))
+(test (let ((x (cons (list 1 2) 3))) (set-car! (car x) (list 3 4)) x) '(((3 4) 2) . 3))
+(test (let ((lst (list 1 2 3))) (set! (car lst) 32) lst) '(32 2 3))
+
+(test (set-car! '() 32) 'error)
+(test (set-car! () 32) 'error)
+(test (set-car! (list) 32) 'error)
+(test (set-car! 'x 32) 'error)
+(test (set-car! #f 32) 'error)
+(test (set-car!) 'error)
+(test (set-car! '(1 2) 1 2) 'error)
+(test (set-car! '(1 . 2) 3) 3) ; from bug-guile
+(test (let ((lst (list 1 2))) (set-car! lst (values 2 3)) lst) 'error)
+(test (let ((lst '(1 2))) (set-car! lst 32)) 32)
+(test (let ((lst '(1 2))) (set! (car lst) 32)) 32)
+
+(test (let ((c (cons 1 2))) (set-car! c #\a) (car c)) #\a)
+(test (let ((c (cons 1 2))) (set-car! c #()) (car c)) #())
+(test (let ((c (cons 1 2))) (set-car! c #f) (car c)) #f)
+(test (let ((c (cons 1 2))) (set-car! c _ht_) (car c)) _ht_)
+
+;;; these have apparently caused a segfault in guile for more than 10 years
+(test (let ((xs '(1))) (set-car! xs 0)) 0)
+(test (let ((xs '(1 2))) (set-car! (cdr xs) 0)) 0)
+(test (set-car! '(0 . ()) 1) 1)
+
+(test (let ((C (cons 1 2))) (set! (car C) 3) C) '(3 . 2))
+(test (let ((C (cons 1 2))) (set! (#_car C) 3) C) '(3 . 2))
+
+
+;;; --------------------------------------------------------------------------------
+;;; set-cdr!
+
+(test (let ((x (cons 1 2))) (set-cdr! x 3) x) (cons 1 3))
+(test (let ((x (list 1 2))) (set-cdr! x 3) x) (cons 1 3))
+(test (let ((x (list (list 1 2) 3))) (set-cdr! x 22) x) '((1 2) . 22))
+(test (let ((x (cons 1 2))) (set-cdr! x '()) x) (list 1))
+(test (let ((x (list 1 (list 2 3 4)))) (set-cdr! x (list 5 (list 6))) x) '(1 5 (6)))
+(test (let ((x '(((1) 2) (3)))) (set-cdr! x '((2) 1)) x) '(((1) 2) (2) 1))
+(test (let ((x ''foo)) (set-cdr! x "hi") x) (cons #_quote "hi"))
+(test (let ((x '((1 . 2) . 3))) (set-cdr! x 4) x) '((1 . 2) . 4))
+(test (let ((x '(1 . 2))) (set-cdr! x (cdr x)) x) '(1 . 2))
+(test (let ((x '(1 . 2))) (set-cdr! x x) (proper-list? x)) #f)
+(test (let ((x (list 1))) (set-cdr! x '()) x) (list 1))
+(test (let ((x '(1 . (2 . (3 (4 5)))))) (set-cdr! x 4) x) '(1 . 4))
+(test (let ((lst (cons 1 (cons 2 3)))) (set-cdr! (cdr lst) 4) lst) (cons 1 (cons 2 4)))
+(test (let ((x (cons (list 1 2) 3))) (set-cdr! (car x) (list 3 4)) x) '((1 3 4) . 3))
+(test (let ((x (list 1 2))) (set-cdr! x (list 4 5)) x) '(1 4 5))
+(test (let ((x (cons 1 2))) (set-cdr! x (list 4 5)) x) '(1 4 5)) ;!
+(test (let ((x (cons 1 2))) (set-cdr! x (cons 4 5)) x) '(1 4 . 5))
+(test (let ((lst (list 1 2 3))) (set! (cdr lst) 32) lst) (cons 1 32))
+
+(test (set-cdr! '() 32) 'error)
+(test (set-cdr! () 32) 'error)
+(test (set-cdr! (list) 32) 'error)
+(test (set-cdr! 'x 32) 'error)
+(test (set-cdr! #f 32) 'error)
+(test (set-cdr!) 'error)
+(test (set-cdr! '(1 2) 1 2) 'error)
+(test (let ((lst '(1 2))) (set-cdr! lst 32)) 32)
+(test (let ((lst '(1 2))) (set! (cdr lst) 32)) 32)
+
+(test (let ((c (cons 1 2))) (set-cdr! c #\a) (cdr c)) #\a)
+(test (let ((c (cons 1 2))) (set-cdr! c #()) (cdr c)) #())
+(test (let ((c (cons 1 2))) (set-cdr! c #f) (cdr c)) #f)
+(test (let ((c (cons 1 2))) (set-cdr! c _ht_) (cdr c)) _ht_)
+(test (let ((c (cons 1 2))) (set-cdr! c (list 3)) c) '(1 3))
+
+
+;;; --------------------------------------------------------------------------------
+;;; list-ref
+
+(test (list-ref (list 1 2) 1) 2)
+(test (list-ref '(a b c d) 2) 'c)
+(test (list-ref (cons 1 2) 0) 1)
+(test (list-ref ''foo 0) #_quote)
+(test (list-ref '((1 2) (3 4)) 1) '(3 4))
+(test (list-ref (list-ref (list (list 1 2) (list 3 4)) 1) 1) 4)
+(test (let ((x (list 1 2 3))) (list-ref x (list-ref x 1))) 3)
+(test (list-ref '(1 2 . 3) 1) 2)
+(test (list-ref '(1 2 . 3) 2) 'error)
+(test ('(1 2 . 3) 0) 1)
+(test ('(1 . 2) 0) 1)
+
+(test (let ((lst (list 1 2))) (set! (list-ref lst 1) 0) lst) (list 1 0))
+(test (((lambda () list)) 'a 'b 'c) '(a b c))
+(test (apply ((lambda () list)) (list 'a 'b 'c) (list 'c 'd 'e)) '((a b c) c d e))
+(test (((lambda () (values list))) 1 2 3) '(1 2 3))
+(test (apply list 'a 'b '(c)) '(a b c))
+
+(for-each
+ (lambda (name op1 op2)
+   (for-each
+    (lambda (lst)
+      (let ((val1 (catch #t (lambda () (op1 lst)) (lambda args 'error)))
+	    (val2 (catch #t (lambda () (op2 lst)) (lambda args 'error))))
+	(if (not (equal? val1 val2))
+	    (format #t ";(~A ~A) -> ~A ~A?~%" name lst val1 val2))))
+    lists))
+ (list 'list-ref:0 'list-ref:1 'list-ref:2 'list-ref:3)
+ (list car cadr caddr cadddr)
+ (list (lambda (l) (list-ref l 0)) (lambda (l) (list-ref l 1)) (lambda (l) (list-ref l 2)) (lambda (l) (list-ref l 3))))
+
+(for-each
+ (lambda (arg)
+   (test (list-ref (list 1 arg) 1) arg))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0)
+       3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (let ((x '(1 . 2))) (set-cdr! x x) (list-ref x 0)) 1)
+(test (let ((x '(1 . 2))) (set-cdr! x x) (list-ref x 1)) 1)
+(test (let ((x '(1 . 2))) (set-cdr! x x) (list-ref x 100)) 1)
+
+(test (list-ref '((1 2 3) (4 5 6)) 1) '(4 5 6))
+(test (list-ref '((1 2 3) (4 5 6)) 1 2) 6)
+(test (list-ref '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) 1) '((7 8 9) (10 11 12)))
+(test (list-ref '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) 1 0) '(7 8 9))
+(test (list-ref '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) 1 0 2) 9)
+(test (list-ref '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) 1 0 3) 'error)
+(test (list-ref '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) 1 0 2 0) 'error)
+
+(test ('((1 2 3) (4 5 6)) 1) '(4 5 6))
+(test ('((1 2 3) (4 5 6)) 1 2) 6)
+(test ('(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) 1) '((7 8 9) (10 11 12)))
+(test ('(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) 1 0) '(7 8 9))
+(test ('(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) 1 0 2) 9)
+(test ('(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) 1 0 3) 'error)
+(test ('(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) 1 0 2 0) 'error)
+
+(test (let ((L '((1 2 3) (4 5 6)))) (L 1)) '(4 5 6))
+(test (let ((L '((1 2 3) (4 5 6)))) (L 1 2)) 6)
+(test (let ((L '((1 2 3) (4 5 6)))) (L 1 2 3)) 'error)
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (L 1)) '((7 8 9) (10 11 12)))
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (L 1 0)) '(7 8 9))
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (L 1 0 2)) 9)
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (L 1 0 2 3)) 'error)
+
+(test (let ((L '((1 2 3) (4 5 6)))) ((L 1) 2)) 6)
+(test (let ((L '((1 2 3) (4 5 6)))) (((L 1) 2) 3)) 'error)
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) ((L 1) 0)) '(7 8 9))
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (((L 1) 0) 2)) 9)
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) ((L 1 0) 2)) 9)
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) ((L 1) 0 2)) 9)
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) ((((L 1) 0) 2) 3)) 'error)
+
+(test (let ((L '((1 2 3) (4 5 6)))) (list-ref (L 1) 2)) 6)
+(test (let ((L '((1 2 3) (4 5 6)))) (list-ref ((L 1) 2) 3)) 'error)
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (list-ref (L 1) 0)) '(7 8 9))
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) ((list-ref (L 1) 0) 2)) 9)
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (list-ref (((L 1) 0) 2) 3)) 'error)
+
+(let ((zero 0)
+      (one 1)
+      (two 2)
+      (three 3))
+  (test (list-ref '((1 2 3) (4 5 6)) one) '(4 5 6))
+  (test (list-ref '((1 2 3) (4 5 6)) 1 two) 6)
+  (test (list-ref '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) one) '((7 8 9) (10 11 12)))
+  (test (list-ref '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) one zero) '(7 8 9))
+  (test (list-ref '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) one zero two) 9)
+  (test (list-ref '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) one zero three) 'error)
+
+  (test ('((1 2 3) (4 5 6)) one) '(4 5 6))
+  (test ('((1 2 3) (4 5 6)) 1 two) 6)
+  (test ('(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) one) '((7 8 9) (10 11 12)))
+  (test ('(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) one zero) '(7 8 9))
+  (test ('(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) one zero two) 9)
+  (test ('(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) one zero three) 'error)
+
+  (test (let ((L '((1 2 3) (4 5 6)))) (L one)) '(4 5 6))
+  (test (let ((L '((1 2 3) (4 5 6)))) (L 1 two)) 6)
+  (test (let ((L '((1 2 3) (4 5 6)))) (L 1 2 3)) 'error)
+  (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (L one)) '((7 8 9) (10 11 12)))
+  (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (L one zero)) '(7 8 9))
+  (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (L one zero two)) 9)
+
+  (test (let ((L '((1 2 3) (4 5 6)))) ((L one) two)) 6)
+  (test (let ((L '((1 2 3) (4 5 6)))) (((L one) two) 3)) 'error)
+  (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) ((L one) zero)) '(7 8 9))
+  (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (((L one) zero) two)) 9)
+  (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) ((L one zero) two)) 9)
+  (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) ((L one) 0 two)) 9)
+
+  (test (let ((L '((1 2 3) (4 5 6)))) (list-ref (L one) two)) 6)
+  (test (let ((L '((1 2 3) (4 5 6)))) (list-ref ((L one) two) 3)) 'error)
+  (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (list-ref (L one) zero)) '(7 8 9))
+  (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) ((list-ref (L one) zero) two)) 9))
+
+
+(test (list-ref () 0) 'error)
+(test (list-ref (list 1 2) 2) 'error)
+(test (list-ref (list 1 2) -1) 'error)
+(test (list-ref (list 1 2) 1.3) 'error)
+(test (list-ref (list 1 2) 1/3) 'error)
+(test (list-ref (list 1 2) 1+2.0i) 'error)
+(test (list-ref (cons 1 2) 1) 'error)
+(test (list-ref (cons 1 2) 2) 'error)
+(test (list-ref (list 1 2 3) (expt 2 32)) 'error)
+(test (list-ref '(1 2 3) 1 2) 'error)
+(test (list-ref) 'error)
+(test (list-ref '(1 2)) 'error)
+(test ('(0)) 'error)
+(test ((0)) 'error)
+(test (list-ref '((1 2) (3 4)) 1 1) 4)
+(test ('(1 2 3) 1) 2)
+(test ((list 1 2 3) 2) 3)
+(test ((list)) 'error)
+(test ((list 1) 0 0) 'error)
+(test ((list 1 (list 2 3)) 1 1) 3)
+(test ((append '(3) () '(1 2)) 0) 3)
+(test ((append '(3) () 1) 0) 3)
+(test ((append '(3) () 1) 1) 'error)
+;; this works with 0 because:
+(test ((cons 1 2) 0) 1)
+(test (list-ref (cons 1 2) 0) 1)
+(test (((list (list 1 2 3)) 0) 0) 1)
+(test (((list (list 1 2 3)) 0) 1) 2)
+(test (((list (list 1 2 3)) 0 1)) 'error) ; see below
+(test (let ((lst (list (list 1 2 3)))) (lst 0 1)) 2)
+(test ((list (list 1 2 3)) 0 1) 2)
+(test (list-ref (list (list 1 2)) 0 ()) 'error)
+(test (((list +) 0) 1 2 3) 6)
+
+
+(let ((lst (list 1 2)))
+  (for-each
+   (lambda (arg)
+     (test (list-ref (list 1 2) arg) 'error)
+     (test ((list 1 2) arg) 'error)
+     (test (lst arg) 'error))
+   (list "hi" (integer->char 65) #f '(1 2) () 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+	 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; list-set!
+
+(test (let ((x (list 1))) (list-set! x 0 2) x) (list 2))
+(test (let ((x (cons 1 2))) (list-set! x 0 3) x) '(3 . 2))
+(test (let ((x (cons 1 2))) (list-set! x 1 3) x) 'error)
+(test (let ((x '((1) 2))) (list-set! x 0 1) x) '(1 2))
+(test (let ((x '(1 2))) (list-set! x 1 (list 3 4)) x) '(1 (3 4)))
+(test (let ((x ''foo)) (list-set! x 0 "hi") x ) '("hi" foo))
+(test (let ((x (list 1 2))) (list-set! x 0 x) (list? x)) #t)
+(test (let ((x (list 1 2))) (list-set! x 1 x) (list? x)) #t)
+(test (let ((x 2) (lst '(1 2))) (list-set! (let () (set! x 3) lst) 1 23) (list x lst)) '(3 (1 23)))
+(test (apply list-set! '((1 2) (3 2)) 1 '(1 2)) 2)
+
+(test (list-set! '(1 2 3) 1 4) 4)
+(test (set-car! '(1 2) 4) 4)
+(test (set-cdr! '(1 2) 4) 4)
+(test (fill! (list 1 2) 4) 4)
+(test (fill! () 1) 1)
+(test (list-set! '(1 2 . 3) 1 23) 23)
+(test (list-set! '(1 2 . 3) 2 23) 'error)
+(test (set! ('(1 2 . 3) 1) 23) 23)
+(test (let ((lst '(1 2 3))) (list-set! lst 0 32)) 32)
+(test (let ((lst '(1 2 3))) (set! (lst 0) 32)) 32)
+(test (let ((lst '(1 2 3))) (set! (list-ref lst 0) 32)) 32)
+
+(for-each
+ (lambda (arg)
+   (test (let ((x (list 1 2))) (list-set! x 0 arg) (list-ref x 0)) arg))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0)
+       3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (let ((L '((1 2 3) (4 5 6)))) (list-set! L 1 32) L) '((1 2 3) 32))
+(test (let ((L '((1 2 3) (4 5 6)))) (list-set! L 1 0 32) L) '((1 2 3) (32 5 6)))
+(test (let ((L '((1 2 3) (4 5 6)))) (list-set! L 1 0 2 32) L) 'error)
+(test (let ((L '((1 2 3) (4 5 6)))) (list-set! L 1 3 32) L) 'error)
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (list-set! L 1 32) L) '(((1 2 3) (4 5 6)) 32))
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (list-set! L 1 0 32) L) '(((1 2 3) (4 5 6)) (32 (10 11 12))))
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (list-set! L 1 0 2 32) L) '(((1 2 3) (4 5 6)) ((7 8 32) (10 11 12))))
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (list-set! L 1 0 2 1 32) L) 'error)
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (list-set! L 1 4 2 32) L) 'error)
+
+(test (let ((L '((1 2 3) (4 5 6)))) (set! (L 1) 32) L) '((1 2 3) 32))
+(test (let ((L '((1 2 3) (4 5 6)))) (set! (L 1 0) 32) L) '((1 2 3) (32 5 6)))
+(test (let ((L '((1 2 3) (4 5 6)))) (set! (L 1 0 2) 32) L) 'error)
+(test (let ((L '((1 2 3) (4 5 6)))) (set! (L 1 3) 32) L) 'error)
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (L 1) 32) L) '(((1 2 3) (4 5 6)) 32))
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (L 1 0) 32) L) '(((1 2 3) (4 5 6)) (32 (10 11 12))))
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (L 1 0 2) 32) L) '(((1 2 3) (4 5 6)) ((7 8 32) (10 11 12))))
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (L 1 0 2 1) 32) L) 'error)
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (L 1 4 2) 32) L) 'error)
+
+(test (let ((L '((1 2 3) (4 5 6)))) (set! ((L 1) 0) 32) L) '((1 2 3) (32 5 6)))
+(test (let ((L '((1 2 3) (4 5 6)))) (set! (((L 1) 0) 2) 32) L) 'error)
+(test (let ((L '((1 2 3) (4 5 6)))) (set! ((L 1) 3) 32) L) 'error)
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! ((L 1) 0) 32) L) '(((1 2 3) (4 5 6)) (32 (10 11 12))))
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (((L 1) 0) 2) 32) L) '(((1 2 3) (4 5 6)) ((7 8 32) (10 11 12))))
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! ((((L 1) 0) 2) 1) 32) L) 'error)
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (((L 1) 4) 2) 32) L) 'error)
+(test (let ((L '(((1 2 3))))) (set! ((L 0) 0 1) 32) L) '(((1 32 3))))
+(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! ((L 1 0) 2) 32) L) '(((1 2 3) (4 5 6)) ((7 8 32) (10 11 12))))
+(test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! (L 0 0 1) 32) L) '((((1 2 3) 32) ((7 8 9) (10 11 12))) (13 14 15)))
+(test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! ((L 0) 0 1 2) 32) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15)))
+(test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! ((L 0 0) 1 2) 32) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15)))
+(test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! ((L 0 0 1) 2) 32) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15)))
+(test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! (((L 0) 0) 1 2) 32) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15)))
+(test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! (((L 0 0) 1) 2) 32) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15)))
+(test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! ((((L 0) 0) 1) 2) 32) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15)))
+(test (let ((L '(1 2 3))) (let ((L1 (list L))) (set! ((car L1) 1) 32) L)) '(1 32 3))
+
+(let ((zero 0)
+      (one 1)
+      (two 2)
+      (three 3)
+      (thirty-two 32))
+  (test (let ((L '((1 2 3) (4 5 6)))) (list-set! L one thirty-two) L) '((1 2 3) 32))
+  (test (let ((L '((1 2 3) (4 5 6)))) (list-set! L one zero thirty-two) L) '((1 2 3) (32 5 6)))
+  (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (list-set! L one thirty-two) L) '(((1 2 3) (4 5 6)) 32))
+  (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (list-set! L one zero thirty-two) L) '(((1 2 3) (4 5 6)) (32 (10 11 12))))
+  (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (list-set! L one zero two thirty-two) L) '(((1 2 3) (4 5 6)) ((7 8 32) (10 11 12))))
+
+  (test (let ((L '((1 2 3) (4 5 6)))) (set! (L one) thirty-two) L) '((1 2 3) 32))
+  (test (let ((L '((1 2 3) (4 5 6)))) (set! (L one zero) thirty-two) L) '((1 2 3) (32 5 6)))
+  (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (L one) thirty-two) L) '(((1 2 3) (4 5 6)) 32))
+  (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (L one zero) thirty-two) L) '(((1 2 3) (4 5 6)) (32 (10 11 12))))
+  (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (L one zero two) thirty-two) L) '(((1 2 3) (4 5 6)) ((7 8 32) (10 11 12))))
+
+  (test (let ((L '((1 2 3) (4 5 6)))) (set! ((L one) zero) thirty-two) L) '((1 2 3) (32 5 6)))
+  (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! ((L one) zero) thirty-two) L) '(((1 2 3) (4 5 6)) (32 (10 11 12))))
+  (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (((L one) zero) two) thirty-two) L) '(((1 2 3) (4 5 6)) ((7 8 32) (10 11 12))))
+  (test (let ((L '(((1 2 3))))) (set! ((L zero) zero one) thirty-two) L) '(((1 32 3))))
+  (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! ((L one zero) two) thirty-two) L) '(((1 2 3) (4 5 6)) ((7 8 32) (10 11 12))))
+  (test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! (L zero zero one) thirty-two) L) '((((1 2 3) 32) ((7 8 9) (10 11 12))) (13 14 15)))
+  (test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! ((L zero) zero one two) thirty-two) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15)))
+  (test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! ((L zero zero) one two) thirty-two) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15)))
+  (test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! ((L zero 0 one) two) thirty-two) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15)))
+  (test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! (((L zero) zero) one two) thirty-two) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15)))
+  (test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! (((L zero zero) one) two) thirty-two) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15)))
+  (test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! ((((L zero) zero) one) two) thirty-two) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15)))
+  (test (let ((L '(1 2 3))) (let ((L1 (list L))) (set! ((car L1) one) thirty-two) L)) '(1 32 3)))
+
+(test (let ((x '(1)) (y '(2))) (set! ((if #t x y) 0) 32) (list x y)) '((32) (2)))
+
+(test (list-set! () 0 1) 'error)
+(test (list-set! () -1 1) 'error)
+(test (list-set! '(1) 1 2) 'error)
+(test (list-set! '(1 2 3) -1 2) 'error)
+(test (list-set! '(1) 1.5 2) 'error)
+(test (list-set! '(1) 3/2 2) 'error)
+(test (list-set! '(1) 1+3i 2) 'error)
+(test (list-set! '(1 2 3) 1 2 3) 'error)
+(test (list-set! (list 1 2 3) (expt 2 32)  0) 'error)
+(test (list-set! (list 1 2) () 1) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (list-set! (list 1 2) arg arg) 'error)
+   (test (list-set! arg 1 2) 'error)
+   (test (list-set! (list 1 2) arg 1) 'error))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (catch #t
+       (lambda () (let ((L1 (list 1))) (list-set! L1 3 0)))
+       (lambda (type info) (apply format #f info)))
+      "list-set! second argument, 3, is out of range (it is too large)")
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; list
+
+(test (let ((tree1 (list 1 (list 1 2) (list (list 1 2 3)) (list (list (list 1 2 3 4)))))) tree1) '(1 (1 2) ((1 2 3)) (((1 2 3 4)))))
+(test (let ((tree2 (list "one" (list "one" "two") (list (list "one" "two" "three"))))) tree2) '("one" ("one" "two") (("one" "two" "three"))))
+(test (let ((tree1 (list 1 (list 1 2) (list 1 2 3) (list 1 2 3 4)))) tree1) '(1 (1 2) (1 2 3) (1 2 3 4)))
+(test (let ((tree1 (list 1 (list 1 2))) (tree2 (list 1 (list 1 2)))) tree2) '(1 (1 2)))
+(test (let ((tree1 (list 1 (list 1 2))) (tree2 (list 1 (list 1 2)))) (eqv? tree1 tree2)) #f)
+(test (let ((tree1 (list ''a (list ''b ''c))) (tree2 (list ''a (list ''b ''c)))) tree2) '('a ('b 'c)))
+(test (let ((lst (list 1 (list 2 3)))) lst) '(1 (2 3)))
+(test (let* ((lst (list 1 (list 2 3))) (slst lst)) slst) '(1 (2 3)))
+(test (list 1) '(1))
+(test (let ((a 1)) (list a 2)) '(1 2))
+(test (let ((a 1)) (list 'a '2)) '(a 2))
+(test (let ((a 1)) (list 'a 2)) '(a 2))
+(test (list) ())
+(test (let ((a (list 1 2))) a) '(1 2))
+(test (let ((a (list 1 2))) (list 3 4 'a (car (cons 'b 'c)) (+ 6 -2))) '(3 4 a b 4))
+(test (list) ())
+(test (length (list quote do map call/cc lambda define if begin set! let let* cond and or for-each)) 15)
+(test (list 1(list 2)) '(1(2)))
+(test (list 1 2 . 3) 'error)
+;(test (list 1 2 , 3) 'error) ; ,3 -> 3 in the reader now
+(test (list 1 2 ,@ 3) 'error)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; list-tail
+
+(test (list-tail '(1 2 3) 0) '(1 2 3))
+(test (list-tail '(1 2 3) 2) '(3))
+(test (list-tail '(1 2 3) 3) ())
+(test (list-tail '(1 2 3 . 4) 2) '(3 . 4))
+(test (list-tail '(1 2 3 . 4) 3) 4)
+(test (let ((x (list 1 2 3))) (eq? (list-tail x 2) (cddr x))) #t)
+(test (list-tail () 0) ())
+(test (list-tail () 1) 'error)
+(test (list-tail '(1 2 3) 4) 'error)
+(test (list-tail () -1) 'error)
+(test (list-tail (list 1 2) 2) ())
+(test (list-tail (cons 1 2) 0) '(1 . 2))
+(test (list-tail (cons 1 2) 1) 2)
+(test (list-tail (cons 1 2) 2) 'error)
+(test (list-tail (cons 1 2) -1) 'error)
+(test (list-tail ''foo 1) '(foo))
+(test (list-tail '((1 2) (3 4)) 1) '((3 4)))
+(test (list-tail (list-tail '(1 2 3) 1) 1) '(3))
+(test (list-tail (list-tail (list-tail '(1 2 3 4) 1) 1) 1) '(4))
+(test (list-tail '(1 2) (list-tail '(0 . 1) 1)) '(2))
+
+(let ((x '(1 . 2))) (set-cdr! x x) (test (list-tail x 0) x))
+(let ((x '(1 . 2))) (set-cdr! x x) (test (list-tail x 1) (cdr x)))
+(let ((x '(1 . 2))) (set-cdr! x x) (test (list-tail x 100) x))
+
+(let ((x (list 1 2 3)))
+  (let ((y (list-tail x 1)))
+    (set! (y 1) 32)
+    (test (equal? y '(2 32)) #t)
+    (test (equal? x '(1 2 32)) #t))) ; list-tail is not like substring
+
+(for-each
+ (lambda (name op1 op2)
+   (for-each
+    (lambda (lst)
+      (let ((val1 (catch #t (lambda () (op1 lst)) (lambda args 'error)))
+	    (val2 (catch #t (lambda () (op2 lst)) (lambda args 'error))))
+	(if (not (equal? val1 val2))
+	    (format #t ";(~A ~A) -> ~A ~A?~%" name lst val1 val2))))
+    lists))
+ (list 'list-tail:0 'list-tail:1 'list-tail:2 'list-tail:3 'list-tail:4)
+ (list (lambda (l) l) cdr cddr cdddr cddddr)
+ (list (lambda (l) (list-tail l 0)) (lambda (l) (list-tail l 1)) (lambda (l) (list-tail l 2)) (lambda (l) (list-tail l 3)) (lambda (l) (list-tail l 4))))
+
+(test (list-tail (list 1 2) 3) 'error)
+(test (list-tail (list 1 2) -1) 'error)
+(test (list-tail (list 1 2) 1.3) 'error)
+(test (list-tail (list 1 2) 1/3) 'error)
+(test (list-tail (list 1 2) 1+2.0i) 'error)
+(test (list-tail '(1 2 . 3)) 'error)
+(test (list-tail '(1 2 . 3) 1) '(2 . 3))
+(test (list-tail '(1 2 . 3) 0) '(1 2 . 3))
+(test (list-tail (list 1 2 3) (+ 1 (expt 2 32))) 'error)
+(test (list-tail) 'error)
+(test (list-tail '(1)) 'error)
+(test (list-tail '(1) 1 2) 'error)
+(test (set! (list-tail (list 1 2 3)) '(32)) 'error) ; should this work?
+
+(for-each
+ (lambda (arg)
+   (test (list-tail (list 1 2) arg) 'error)
+   (test (list-tail arg 0) 'error))
+ (list "hi" -1 3 most-negative-fixnum most-positive-fixnum
+       (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #\f #t (if #f #f) #<eof> #() #(1 2 3) (lambda (a) (+ a 1))))
+
+
+;;; --------------------------------------------------------------------------------
+;;; make-list
+
+(test (make-list 0) ())
+(test (make-list 0 123) ())
+(test (make-list 1) '(#f))
+(test (make-list 1 123) '(123))
+(test (make-list 1 ()) '(()))
+(test (make-list 2) '(#f #f))
+(test (make-list 2 1) '(1 1))
+(test (make-list 2/1 1) '(1 1))
+(test (make-list 2 (make-list 1 1)) '((1) (1)))
+(test (make-list -1) 'error)
+(test (make-list -0) ())
+(test (make-list most-negative-fixnum) 'error)
+(test (make-list most-positive-fixnum) 'error)
+(test (make-list (* 8796093022208 8796093022208)) 'error)
+(test (make-list 8796093022208) 'error)
+(test (make-list 0 #\a) ())
+(test (make-list 1 #\a) '(#\a))
+(test (let-temporarily (((*s7* 'max-list-length 32))) (make-list 64)) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (make-list arg) 'error))
+ (list #\a #(1 2 3) 3.14 3/4 1.0+1.0i 0.0 1.0 () #t 'hi #(()) (list 1 2 3) '(1 . 2) "hi" (- (real-part (log 0.0)))))
+
+(for-each
+ (lambda (arg)
+   (test ((make-list 1 arg) 0) arg))
+ (list #\a #(1 2 3) 3.14 3/4 1.0+1.0i () #f 'hi #(()) (list 1 2 3) '(1 . 2) "hi"))
+
+(test (make-list) 'error)
+(test (make-list 1 2 3) 'error)
+(test (let ((lst (make-list 2 (make-list 1 0)))) (eq? (lst 0) (lst 1))) #t)
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; assq
+
+(let ((e '((a 1) (b 2) (c 3))))
+  (test (assq 'a e) '(a 1))
+  (test (assq 'b e) '(b 2))
+  (test (assq 'd e) #f))
+(test (assq (list 'a) '(((a)) ((b)) ((c))))  #f)
+
+(let ((xcons (cons 1 2))
+      (xvect (vector 1 2))
+      (xlambda (lambda () 1))
+      (xstr "abs"))
+  (let ((e (list (list #t 1) (list #f 2) (list 'a 3) (list xcons 4) (list xvect 5) (list xlambda 6) (list xstr 7) (list car 8))))
+    (test (assq #t e) (list #t 1))
+    (test (assq #f e) (list #f 2))
+    (test (assq 'a e) (list 'a 3))
+    (test (assq xcons e) (list xcons 4))
+    (test (assq xvect e) (list xvect 5))
+    (test (assq xlambda e) (list xlambda 6))
+    (test (assq xstr e) (list xstr 7))
+    (test (assq car e) (list car 8))))
+
+(let ((e '((1+i 1) (3.0 2) (5/3 3))))
+  (test (assq 1+i e) #f)
+  (test (assq 3.0 e) #f)
+  (test (assq 5/3 e) #f))
+
+(test (assq 'x (cdr (assq 'a '((b . 32) (a . ((a . 12) (b . 32) (x . 1))) (c . 1))))) '(x . 1))
+
+(test (assq #f '(#f 2 . 3)) #f)
+(test (assq #f '((#f 2) . 3)) '(#f 2))
+(test (assq () '((() 1) (#f 2))) '(() 1))
+(test (assq () '((1) (#f 2))) #f)
+(test (assq #() '((#f 1) (() 2) (#() 3))) #f)  ; (eq? #() #()) -> #f
+
+(test (assq 'b '((a . 1) (b . 2) () (c . 3) #f)) '(b . 2))
+(test (assq 'c '((a . 1) (b . 2) () (c . 3) #f)) '(c . 3))
+(test (assq 'b '((a . 1) (b . 2) () (c . 3) . 4)) '(b . 2))
+(test (assq 'c '((a . 1) (b . 2) () (c . 3) . 4)) '(c . 3))
+(test (assq 'b (list '(a . 1) '(b . 2) () '(c . 3) #f)) '(b . 2))
+(test (assq 'asdf (list '(a . 1) '(b . 2) () '(c . 3) #f)) #f)
+(test (assq "" (list '("a" . 1) '("" . 2) '(#() . 3))) '("" . 2)) ; was #f
+(test (assq 'a '((a . 1) (a . 2) (a . 3))) '(a . 1)) ; is this specified?
+(test (assq 'a '((b . 1) (a . 2) (a . 3))) '(a . 2))
+
+;; check the even/odd cases
+(let ((odd '((3 . 1) (a . 2) (3.0 . 3) (b . 4) (3/4 . 5) (c . 6) (#(1) . 7) (d . 8)))
+      (even '((e . 1) (3 . 2) (a . 3) (3.0 . 4) (b . 5) (3/4 . 6) (c . 7) (#(1) . 8) (d . 9))))
+  (test (assq 'a odd) '(a . 2))
+  (test (assq 'a even) '(a . 3))
+  (test (assq 3/4 odd) #f)
+  (test (assq 3/4 even) #f)
+  (test (assq 3.0 odd) #f)
+  (test (assq 3.0 even) #f)
+  (test (assq #(1) odd) #f)
+  (test (assq #(1) even) #f))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; assv
+
+(test (assv 1 '(1 2 . 3)) #f)
+(test (assv 1 '((1 2) . 3)) '(1 2))
+
+(let ((e '((a 1) (b 2) (c 3))))
+  (test (assv 'a e) '(a 1))
+  (test (assv 'b e) '(b 2))
+  (test (assv 'd e) #f))
+(test (assv (list 'a) '(((a)) ((b)) ((c))))  #f)
+
+(let ((xcons (cons 1 2))
+      (xvect (vector 1 2))
+      (xlambda (lambda () 1))
+      (xstr "abs"))
+  (let ((e (list (list #t 1) (list #f 2) (list 'a 3) (list xcons 4) (list xvect 5) (list xlambda 6) (list xstr 7) (list car 8))))
+    (test (assv #t e) (list #t 1))
+    (test (assv #f e) (list #f 2))
+    (test (assv 'a e) (list 'a 3))
+    (test (assv xcons e) (list xcons 4))
+    (test (assv xvect e) (list xvect 5))
+    (test (assv xlambda e) (list xlambda 6))
+    (test (assv xstr e) (list xstr 7))
+    (test (assv car e) (list car 8))))
+
+(let ((e '((1+i 1) (3.0 2) (5/3 3) (#\a 4) ("hiho" 5))))
+  (test (assv 1+i e) '(1+i 1))
+  (test (assv 3.0 e) '(3.0 2))
+  (test (assv 5/3 e) '(5/3 3))
+  (test (assv #\a e) '(#\a 4))
+  (test (assv "hiho" e) #f))
+
+(let ((e '(((a) 1) (#(a) 2) ("c" 3))))
+  (test (assv '(a) e) #f)
+  (test (assv #(a) e) #f)
+  (test (assv (string #\c) e) #f))
+
+(let ((lst '((2 . a) (3 . b))))
+  (set-cdr! (assv 3 lst) 'c)
+  (test lst '((2 . a) (3 . c))))
+
+(test (assv () '((() 1) (#f 2))) '(() 1))
+(test (assv () '((1) (#f 2))) #f)
+(test (assv #() '((#f 1) (() 2) (#() 3))) #f)  ; (eqv? #() #()) -> #f ??
+
+(test (assv 'b '((a . 1) (b . 2) () (c . 3) #f)) '(b . 2))
+(test (assv 'c '((a . 1) (b . 2) () (c . 3) #f)) '(c . 3))
+(test (assv 'b '((a . 1) (b . 2) () (c . 3) . 4)) '(b . 2))
+(test (assv 'c '((a . 1) (b . 2) () (c . 3) . 4)) '(c . 3))
+(test (assv 'asdf '((a . 1) (b . 2) () (c . 3) . 4)) #f)
+(test (assv 'd '((a . 1) (b . 2) () (c . 3) (d . 5))) '(d . 5))
+(test (assv 'a '((a . 1) (a . 2) (a . 3))) '(a . 1)) ; is this specified?
+(test (assv 'a '((b . 1) (a . 2) (a . 3))) '(a . 2))
+
+(let ((odd '((3 . 1) (a . 2) (3.0 . 3) (b . 4) (3/4 . 5) (c . 6) (#(1) . 7) (d . 8)))
+      (even '((e . 1) (3 . 2) (a . 3) (3.0 . 4) (b . 5) (3/4 . 6) (c . 7) (#(1) . 8) (d . 9))))
+  (test (assv 'a odd) '(a . 2))
+  (test (assv 'a even) '(a . 3))
+  (test (assv 3 odd) '(3 . 1))
+  (test (assv 3 even) '(3 . 2))
+  (test (assv 3/4 odd) '(3/4 . 5))
+  (test (assv 3/4 even) '(3/4 . 6))
+  (test (assv 3.0 odd) '(3.0 . 3))
+  (test (assv 3.0 even) '(3.0 . 4))
+  (test (assv #(1) odd) #f)
+  (test (assv #(1) even) #f))
+
+(test (assv 1/0 '((1/0 . 1) (1.0 . 3))) #f)
+(test (pair? (assv (real-part (log 0)) (list (cons 1/0 1) (cons (real-part (log 0)) 2) (cons -1 3)))) #t)
+(test (pair? (assv (- (real-part (log 0))) (list (cons 1/0 1) (cons (real-part (log 0)) 2) (cons -1 3)))) #f)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; assoc
+
+(let ((e '((a 1) (b 2) (c 3))))
+  (test (assoc 'a e) '(a 1))
+  (test (assoc 'b e) '(b 2))
+  (test (assoc 'd e) #f))
+(test (assoc (list 'a) '(((a)) ((b)) ((c))))  '((a)))
+
+(let ((xcons (cons 1 2))
+      (xvect (vector 1 2))
+      (xlambda (lambda () 1))
+      (xstr "abs"))
+  (let ((e (list (list #t 1) (list #f 2) (list 'a 3) (list xcons 4) (list xvect 5) (list xlambda 6) (list xstr 7) (list car 8))))
+    (test (assoc #t e) (list #t 1))
+    (test (assoc #f e) (list #f 2))
+    (test (assoc 'a e) (list 'a 3))
+    (test (assoc xcons e) (list xcons 4))
+    (test (assoc xvect e) (list xvect 5))
+    (test (assoc xlambda e) (list xlambda 6))
+    (test (assoc xstr e) (list xstr 7))
+    (test (assoc car e) (list car 8))))
+
+(let ((e '((1+i 1) (3.0 2) (5/3 3) (#\a 4) ("hiho" 5))))
+  (test (assoc 1+i e) '(1+i 1))
+  (test (assoc 3.0 e) '(3.0 2))
+  (test (assoc 5/3 e) '(5/3 3))
+  (test (assoc #\a e) '(#\a 4))
+  (test (assoc "hiho" e) '("hiho" 5)))
+
+(let ((e '(((a) 1) (#(a) 2) ("c" 3))))
+  (test (assoc '(a) e) '((a) 1))
+  (test (assoc #(a) e) '(#(a) 2))
+  (test (assoc (string #\c) e) '("c" 3)))
+
+(test (assoc 'a '((b c) (a u) (a i))) '(a u))
+(test (assoc 'a '((b c) ((a) u) (a i))) '(a i))
+(test (assoc (list 'a) '(((a)) ((b)) ((c))))  '((a)))
+(test (assoc 5 '((2 3) (5 7) (11 13))) '(5 7))
+(test (assoc 'key ()) #f)
+(test (assoc 'key '(() ())) 'error)
+(test (assoc () ()) #f)
+(test (assoc 1 '((1 (2)) (((3) 4)))) '(1 (2)))
+(test (assoc #f () 1/9223372036854775807) 'error)
+
+(test (assoc () 1) 'error)
+(test (assoc (cons 1 2) 1) 'error)
+(test (assoc (let ((x (cons 1 2))) (set-cdr! x x)) 1) 'error)
+(test (assoc '((1 2) .3) 1) 'error)
+(test (assoc ''foo quote) 'error)
+(test (assoc 3 '((a . 3)) abs =) 'error)
+(test (assoc 1 '(1 2 . 3)) 'error)
+(test (assoc 1 '((1 2) . 3)) '(1 2))
+(test (assoc 1 '((1) (1 3) (1 . 2))) '(1))
+(test (assoc 1 '((1 2 . 3) (1 . 2))) '(1 2 . 3))
+(test (assoc '(((1 2))) '((1 2) ((1 2) 3) (((1 2) 3) 4) ((((1 2) 3) 4) 5))) #f)
+(test (assoc '(((1 2))) '((1 2) ((1 2)) (((1 2))) ((((1 2)))))) '((((1 2)))))
+(test (assoc 'a '((a . 1) (a . 2) (a . 3))) '(a . 1)) ; is this specified?
+(test (assoc 'a '((b . 1) (a . 2) (a . 3))) '(a . 2))
+
+(test (assoc () '((() 1) (#f 2))) '(() 1))
+(test (assoc () '((1) (#f 2))) #f)
+(test (assoc #() '((#f 1) (() 2) (#() 3))) '(#() 3))
+(test (assoc #<unspecified> (list (cons (apply values ()) #f))) '(#<unspecified> . #f))
+(test (assoc #<a> '((1 2) (#<a> 3))) '(#<a> 3))
+(test (assoc #<...> '((1 x) (#<...> 4)) equivalent?) '(#<...> 4))
+(test (assoc #<> '((1 2) (#<> 3))) '(#<> 3))
+(test (assoc #<a> '((1 2) (#<b> 3))) #f)
+(test (assoc #<undefined> '((#<undefined> 3))) '(#<undefined> 3))
+(test (assoc #<eof> '((1 2) (#<eof> 3))) '(#<eof> 3))
+
+(for-each
+ (lambda (arg)
+   (test (assoc arg (list (list 1 2) (list arg 3))) (list arg 3)))
+ (list "hi" (integer->char 65) #f 'a-symbol #() abs 3/4 #\f #t (if #f #f)))
+
+(test (assoc 'b '((a . 1) (b . 2) () (c . 3) #f)) '(b . 2))
+(test (assoc 'c '((a . 1) (b . 2) () (c . 3) #f)) '(c . 3))
+(test (assoc 'b '((a . 1) (b . 2) () (c . 3) . 4)) '(b . 2))
+(test (assoc 'c '((a . 1) (b . 2) () (c . 3) . 4)) '(c . 3))
+(test (assoc 'c '((a . 1) (b . 2) () (c . 3) (c . 4) . 4)) '(c . 3))
+(test (assoc 'asdf '((a . 1) (b . 2) () (c . 3) (c . 4) . 4)) #f)
+(test (assoc "" (list '("a" . 1) '("" . 2) '(#() . 3))) '("" . 2))
+(test (assoc assoc (list (cons abs 1) (cons assoc 2) (cons + 3))) (cons assoc 2))
+
+(let ((odd '((3 . 1) (a . 2) (3.0 . 3) (b . 4) (3/4 . 5) (c . 6) (#(1) . 7) (d . 8)))
+      (even '((e . 1) (3 . 2) (a . 3) (3.0 . 4) (b . 5) (3/4 . 6) (c . 7) (#(1) . 8) (d . 9))))
+  (test (assoc 'a odd) '(a . 2))
+  (test (assoc 'a even) '(a . 3))
+  (test (assoc 3 odd) '(3 . 1))
+  (test (assoc 3 even) '(3 . 2))
+  (test (assoc 3/4 odd) '(3/4 . 5))
+  (test (assoc 3/4 even) '(3/4 . 6))
+  (test (assoc 3.0 odd =) '(3 . 1))
+  (test (assoc 3.0 odd) '(3.0 . 3))
+  (test (assoc 3.0 even) '(3.0 . 4))
+  (test (assoc #(1) odd) '(#(1) . 7))
+  (test (assoc #(1) even) '(#(1) . 8)))
+
+(test (assoc 3 '((1 . a) (2 . b) (3 . c) (4 . d)) =) '(3 . c))
+(test (assoc 3 '((1 . a) (2 . b) (31 . c) (4 . d)) =) #f)
+(test (assoc 3 () =) #f)
+(test (assoc 3.0 '((1 . a) (2 . b) (3 . c) (4 . d)) =) '(3 . c))
+(test (assoc #\a '((#\A . 1) (#\b . 2)) char=?) #f)
+(test (assoc #\a '((#\A . 1) (#\b . 2)) char-ci=?) '(#\A . 1))
+(test (assoc #\a '((#\A . 1) (#\b . 2)) (lambda (a b) (char-ci=? a b))) '(#\A . 1))
+(test (assoc 3 '((1 . a) (2 . b) (3 . c) (4 . d)) #(1)) 'error)
+(test (assoc 3 '((1 . a) (2 . b) (3 . c) (4 . d)) abs) 'error)
+(test (assoc 3 '((1 . a) (2 . b) (3 . c) (4 . d)) quasiquote) 'error)
+(test (assoc 3 '((1 . a) (2 . b) (3 . c) (4 . d)) (lambda (a b c) (= a b))) 'error)
+(test (assoc 3.0 '((1 . a) (2 . b) (3 . c) (4 . d)) (lambda* (a b c) (= a b))) '(3 . c))
+(test (assoc 3 '((1 . a) (2 . b) (3 . c) (4 . d)) (lambda (a) (= a 1))) 'error)
+(test (assoc 4.0 '((1 . a) (2 . b) (3 . c) (4 . d)) (dilambda = =)) '(4 . d))
+(test (catch #t (lambda () (assoc 4.0 '((1 . a) (2 . b) (3 . c) (4 . d)) (lambda (a b) (error 'assoc a)))) (lambda args (car args))) 'assoc)
+(test (call-with-exit (lambda (go) (assoc 4.0 '((1 . a) (2 . b) (3 . c) (4 . d)) (lambda (a b) (go 'assoc))))) 'assoc)
+(test (assoc 3 '((#\a . 3) (#() . 2) (3.0 . 1) ("3" . 0))) #f)
+(test (assoc 3 '((#\a . 3) (#() . 2) (3.0 . 1) ("3" . 0)) (lambda (a b) (= a b))) 'error)
+(test (assoc 3 '((#\a . 3) (#() . 2) (3.0 . 1) ("3" . 0)) (lambda (a b) (and (number? b) (= a b)))) '(3.0 . 1)) ; is this order specified?
+(test (let ((lst (list (cons 1 2) (cons 3 4) (cons 5 6)))) (set! (cdr (cdr lst)) lst) (assoc 3 lst)) '(3 . 4))
+(test (let ((lst '((1 . 2) (3 . 4) . 5))) (assoc 3 lst)) '(3 . 4))
+(test (let ((lst '((1 . 2) (3 . 4) . 5))) (assoc 5 lst)) #f)
+(test (let ((lst '((1 . 2) (3 . 4) . 5))) (assoc 3 lst =)) '(3 . 4))
+(test (let ((lst '((1 . 2) (3 . 4) . 5))) (assoc 5 lst =)) #f)
+(test (assoc 3 '((1 . 2) . 3)) #f)
+(test (assoc 1 '((1 . 2) . 3)) '(1 . 2))
+(test (assoc 3 '((1 . 2) . 3) =) #f)
+(test (assoc 1 '((1 . 2) . 3) =) '(1 . 2))
+(test (let ((lst (list (cons 1 2) (cons 2 3) (cons 3 4)))) (and (assoc 2 lst =) lst)) '((1 . 2) (2 . 3) (3 . 4)))
+(test (let ((lst (list (cons 1 2) (cons 2 3) (cons 3 4)))) (set! (cdr (cdr lst)) lst) (assoc 2 lst)) '(2 . 3))
+(test (let ((lst (list (cons 1 2) (cons 2 3) (cons 3 4)))) (set! (cdr (cdr lst)) lst) (assoc 2 lst =)) '(2 . 3))
+(test (let ((lst (list (cons 1 2) (cons 2 3) (cons 3 4)))) (set! (cdr (cdr lst)) lst) (assoc 4 lst)) #f)
+(test (let ((lst (list (cons 1 2) (cons 2 3) (cons 3 4)))) (set! (cdr (cdr lst)) lst) (assoc 4 lst =)) #f)
+(test (let ((lst (list (cons 1 2) (cons 2 3) (cons 3 4)))) (set! (cdr (cdr (cdr lst))) lst) (assoc 3 lst =)) '(3 . 4))
+(test (assoc '(1 2) '((a . 3) ((1 2) . 4))) '((1 2) . 4))
+(test (assoc '(1 2) '((a . 3) ((1 2) . (3 4)))) '((1 2) 3 4))
+(test (assoc '(1 2) '((a . 3) ((1 2) . (3 . 4)))) '((1 2) 3 . 4))
+(test (cdr (assoc '(1 2) '((a . 3) ((1 2) . (3 . 4))))) (cons 3 4))
+
+(test (assoc #t (list 1 2) #()) 'error)
+(test (assoc #t (list 1 2) (integer->char 127)) 'error)
+(test (assoc #t (list 1 2) (lambda (x y) (+ x 1))) 'error) ; (+ #t 1)
+(test (assoc #t (list 1 2) abs) 'error)
+(test (assoc #t (list 1 2) (lambda args args)) 'error)
+(test (assoc 1 '((3 . 2) 3) =) 'error)
+(test (assoc 1 '((1 . 2) 3) =) '(1 . 2)) ; this is like other trailing error unchecked cases -- should we check?
+
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda (a) (eq? a b))) 'error)
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda (a b) (eq? a b))) '(a 1))
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda (a b c) (eq? a b))) 'error)
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda (a b c . d) (eq? a b))) 'error)
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda (a b . c) (eq? a b))) '(a 1))
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda a (apply eq? a))) '(a 1))
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda (a . b) (eq? a (car b)))) '(a 1))
+
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a) (eq? a b))) 'error)
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a b) (eq? a b))) '(a 1))
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a b c) (eq? a b))) '(a 1))
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a b c . d) (eq? a b))) '(a 1))
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a b . c) (eq? a b))) '(a 1))
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* a (apply eq? a))) '(a 1))
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a . b) (eq? a (car b)))) '(a 1))
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a :rest b) (eq? a (car b)))) '(a 1))
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a :rest b :rest c) (eq? a (car b)))) '(a 1))
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (:rest a) (apply eq? a))) '(a 1))
+(test (assoc 'a '((a 1) (b 2) (c 3)) (define-macro (_m_ a b) `(eq? ',a ',b))) '(a 1))
+(test (assoc 'c '((a 1) (b 2) (c 3)) (define-macro (_m_ a b) `(eq? ',a ',b))) '(c 3))
+
+(when with-bignums
+  (test (assoc 1 (list (list (bignum 1) 2))) '(1 2))
+  (test (assoc 1 (list (list (bignum 1) 2)) =) '(1 2))
+  (test (assoc 1 (list (list (bignum 1) 2)) eqv?) '(1 2))
+  (test (assoc 1 (list (list (bignum 1) 2)) equivalent?) '(1 2))
+  (test (assv 1 (list (list (bignum 1) 2))) '(1 2))
+  (test (assv (bignum 1) (list (list 1 3))) '(1 3)))
+
+(let ()
+  (define (atest a b)
+    (eq? a b))
+  (atest 1 1)
+  (let ((lst (list (cons 'a 1) (cons 'b 2))))
+    (test (assoc 'b lst atest) '(b . 2))))
+
+(for-each
+  (lambda (arg lst)
+    (test (assoc arg lst eq?) (assq arg lst))
+    (test (assoc arg lst eqv?) (assv arg lst))
+    (test (assoc arg lst equal?) (assoc arg lst)))
+  (list 'a #f (list 'a) 'a 1 3/4 #(1) "hi")
+  (list '((a . 1) (b . 2) (c . 3)) '((1 . 1) ("hi" . 2) (#t . 4) (#f . 5) (2 . 3))
+	'((b . 1) ((a) . 2) (c . 3)) '((d . 1) (a . 2) (b . 4) . (c . 3))
+	'((1 . 1) (3/4 . 2) (23 . 3)) '((a . 1) (1 . 2) (#(1) . 4) (23 . 3))
+	'((1 . 1) ("hi" . 2) (23 . 3))))
+
+(test (catch #t (lambda () (assoc 1 (list (list 3 2) (list 2)) (lambda (a b) (catch #t 1 cons)))) (lambda args 'error)) 'error)
+(test (catch #t (lambda () (member 1 (list 3 2) (lambda (a b) (catch #t 1 cons)))) (lambda args 'error)) 'error)
+
+
+;;; --------------------------------------------------------------------------------
+;;; memq
+
+(test (memq 'a '(a b c)) '(a b c))
+(test (memq 'a (list 'a 'b 'c)) '(a b c))
+(test (memq 'b '(a b c)) '(b c))
+(test (memq 'a '(b c d)) #f)
+(test (memq (list 'a) '(b (a) c))  #f)
+(test (memq 'a '(b a c a d a)) '(a c a d a))
+(let ((v (vector 'a))) (test (memq v (list 'a 1.2 v "hi")) (list v "hi")))
+(test (memq #f '(1 a #t "hi" #f 2)) '(#f 2))
+(test (memq eq? (list 2 eqv? 1 eq?)) (list eq?))
+(test (memq eq? (list 2 eqv? 2)) #f)
+(test (memq 6 (memq 5 (memq 4 (memq 3 (memq 2 (memq 1 '(1 2 3 4 5 6))))))) '(6))
+(test (memq 1/2 (list (/ 2.0) .5 1/2)) #f)
+(test (memq 'a (cons 'a 'b)) '(a . b))
+(test (memq) 'error)
+(test (memq 'a) 'error)
+(test (memq 'a 'b) 'error)
+(test (memq 'a '(a b . c)) '(a b . c))
+(test (memq 'b '(a b . c)) '(b . c))
+(test (memq 'c '(a b . c)) #f) ; or should it be 'c?
+(test (memq () '(1 () 3)) '(() 3))
+(test (memq () '(1 2)) #f)
+(test (memq 'a '(c d a b c)) '(a b c))
+(test (memq 'a '(c d f b c)) #f)
+(test (memq 'a ()) #f)
+(test (memq 'a '(c d a b . c)) '(a b . c))
+(test (memq 'a '(c d f b . c)) #f)
+(test (memq #f '(1 "hi" #t)) #f)
+(test (memq () ()) #f)
+(test (memq () (list)) #f)
+(test (memq () (list ())) '(()))
+(test (let ((x (cons 1 2))) (memq x (list x (cons 3 4)))) '((1 . 2) (3 . 4)))
+(test (pair? (let ((x (lambda () 1))) (memq x (list 1 2 x 3)))) #t)
+(test (memq memq (list abs + memq car)) (list memq car))
+(test (memq 'a '(a a a)) '(a a a)) ;?
+(test (memq 'a '(b a a)) '(a a))
+(test (memq "hi" '(1 "hi" 2)) #f)
+(test (let ((str "hi")) (memq str (list 1 str 2))) '("hi" 2))
+(test (memq #\a '(1 #f #\a 2)) '(#\a 2))
+
+(test (let* ((x (vector 1 2 3)) (lst (list 1 "hi" x (vector 1 2)))) (memq x lst)) '(#(1 2 3) #(1 2)))
+(test (let* ((x (vector 1 2 3)) (lst (list 1 "hi" (vector 1 2 3)))) (memq x lst)) #f)
+
+(let ((odd '(3 a 3.0 b 3/4 c #(1) d))
+      (even '(e 3 a 3.0 b 3/4 c #(1) d)))
+  (test (memq 'a odd) '(a 3.0 b 3/4 c #(1) d))
+  (test (memq 'a even) '(a 3.0 b 3/4 c #(1) d))
+  (test (memq 3/4 odd) #f)
+  (test (memq 3/4 even) #f)
+  (test (memq 3.0 odd) #f)
+  (test (memq 3.0 even) #f)
+  (test (memq #(1) odd) #f)
+  (test (memq #(1) even) #f))
+
+;;; but (memq pi (list 1 pi 2)) -> '(3.1415926535898 2)
+
+(test (memq (values #\a '(#\A 97 a))) #f)
+(test (memq (values #\a '(#\A 97 #\a))) '(#\a))
+(test (memq #\a (values #\a '(#\A 97 #\a))) 'error)
+(test (memq #\a (values '(#\A 97 #\a))) '(#\a))
+(test (memq #\a '(1 2) (values)) 'error) ; hmmm
+(test ((values memq (values #\a '(#\A 97 #\a)))) '(#\a))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; memv
+
+(test (memv 101 '(100 101 102)) '(101 102))
+(test (memv 101 (list 100 101 102)) '(101 102))
+(test (memv 3.4 '(1.2 2.3 3.4 4.5)) '(3.4 4.5))
+(test (memv 3.4 '(1.3 2.5 3.7 4.9)) #f)
+(test (memv 1/2 (list (/ 2.0) .5 1/2)) '(1/2))
+(test (memv 1.0 '(1 2 3)) #f)
+(test (memv 1/0 '(1/0 1.0 3)) #f)
+(test (pair? (memv (real-part (log 0)) (list 1/0 (real-part (log 0)) -1))) #t)
+(test (pair? (memv (- (real-part (log 0))) (list 1/0 (real-part (log 0)) -1))) #f)
+
+(let ((ls (list 'a 'b 'c)))
+  (set-car! (memv 'b ls) 'z)
+  (test ls '(a z c)))
+(test (memv 1 (cons 1 2)) '(1 . 2))
+(test (memv 'a (list 'a 'b . 'c)) 'error)
+(test (memv 'a '(a b . c)) '(a b . c))
+(test (memv 'asdf '(a b . c)) #f)
+(test (memv) 'error)
+(test (memv 'a) 'error)
+(test (memv 'a 'b) 'error)
+(test (memv 'c '(a b c)) '(c))
+(test (memv 'c '(a b . c)) #f)
+(test (memv ''a '('a b c)) #f)
+(test (let ((x (cons 1 2))) (memv x (list (cons 1 2) (cons 3 4)))) #f)
+(test (let ((x (cons 1 2))) (memv x (list x (cons 3 4)))) '((1 . 2) (3 . 4)))
+(test (memv 'a '(a a a)) '(a a a)) ;?
+(test (memv 'a '(b a a)) '(a a))
+(test (memv "hi" '(1 "hi" 2)) #f)
+(test (memv #\a '(1 #f #\a 2)) '(#\a 2))
+(test (memv cons (list car cdr cons +)) (list cons +))
+(test (memv (apply values ()) (list #<unspecified>)) (list #<unspecified>))
+
+(let ((odd '(3 a 3.0 b 3/4 c #(1) d))
+      (even '(e 3 a 3.0 b 3/4 c #(1) d)))
+  (test (memv 'a odd) '(a 3.0 b 3/4 c #(1) d))
+  (test (memv 'a even) '(a 3.0 b 3/4 c #(1) d))
+  (test (memv 3/4 odd) '(3/4 c #(1) d))
+  (test (memv 3/4 even) '(3/4 c #(1) d))
+  (test (memv 3.0 odd) '(3.0 b 3/4 c #(1) d))
+  (test (memv 3.0 even) '(3.0 b 3/4 c #(1) d))
+  (test (memv #(1) odd) #f)
+  (test (memv #(1) even) #f))
+(test (memv #(1) '(1 #(1) 2)) #f)
+(test (memv () '(1 () 2)) '(() 2))
+(test (let* ((x (vector 1 2 3)) (lst (list 1 "hi" x (vector 1 2)))) (memv x lst)) '(#(1 2 3) #(1 2)))
+(test (let* ((x (vector 1 2 3)) (lst (list 1 "hi" (vector 1 2 3)))) (memv x lst)) #f)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; member
+
+(test (member (list 'a) '(b (a) c)) '((a) c))
+(test (member "b" '("a" "c" "b")) '("b"))
+(test (member 1 '(3 2 1 4)) '(1 4))
+(test (member 1 (list 3 2 1 4)) '(1 4))
+(test (member car (list abs car modulo)) (list car modulo))
+(test (member do (list quote map do)) (list do))
+(test (member 5/2 (list 1/3 2/4 5/2)) '(5/2))
+(test (member 'a '(a b c d)) '(a b c d))
+(test (member 'b '(a b c d)) '(b c d))
+(test (member 'c '(a b c d)) '(c d))
+(test (member 'd '(a b c d)) '(d))
+(test (member 'e '(a b c d)) #f)
+(test (member 1 (cons 1 2)) '(1 . 2))
+(test (member 1 '(1 2 . 3)) '(1 2 . 3))
+(test (member 2 '(1 2 . 3)) '(2 . 3))
+(test (member 3 '(1 2 . 3)) #f)
+(test (member 4 '(1 2 . 3)) #f)
+(test (member 1/2 (list (/ 2.0) .5 1/2)) '(1/2))
+(test (member) 'error)
+(test (member 'a) 'error)
+(test (member 'a 'b) 'error)
+(test (member () '(1 2 3)) #f)
+(test (member () '(1 2 ())) '(()))
+(test (member #() '(1 () 2 #() 3)) '(#() 3))
+(test (member #2d((1 2) (3 4)) '(1 #() #2d((1 2) (1 2)))) #f)
+(test (member #2d((1 2) (3 4)) '(1 #() #2d((1 2) (3 4)))) '(#2d((1 2) (3 4))))
+(test (let ((x (cons 1 2))) (member x (list (cons 1 2) (cons 3 4)))) '((1 . 2) (3 . 4)))
+(test (let ((x (list 1 2))) (member x (list (cons 1 2) (list 1 2)))) '((1 2)))
+(test (member ''a '('a b c)) '('a b c))
+(test (member 'a '(a a a)) '(a a a)) ;?
+(test (member 'a '(b a a)) '(a a))
+(test (member (member 3 '(1 2 3 4)) '((1 2) (2 3) (3 4) (4 5))) '((3 4) (4 5)))
+(test (member "hi" '(1 "hi" 2)) '("hi" 2))
+(test (member #\a '(1 #f #\a 2)) '(#\a 2))
+(test (let* ((x (vector 1 2 3)) (lst (list 1 "hi" x (vector 1 2)))) (member x lst)) '(#(1 2 3) #(1 2)))
+(test (let* ((x (vector 1 2 3)) (lst (list 1 "hi" (vector 1 2 3)))) (member x lst)) '(#(1 2 3)))
+(test (member #<a> '(1 2 #<a> 3)) '(#<a> 3))
+(test (member #<...> '(1 x #<...> 4 5) equivalent?) '(#<...> 4 5))
+(test (member #<> '(1 2 #<>)) '(#<>))
+(test (member #<a> '(1 #<b> 2)) #f)
+(test (member #<undefined> '(1 #<undefined> 3)) '(#<undefined> 3))
+(test (member #<eof> '(1 #<eof> 3)) '(#<eof> 3))
+(test (member #<unspecified> '(1 #<unspecified> 3)) '(#<unspecified> 3))
+
+(for-each
+ (lambda (arg)
+   (test (member arg (list 1 2 arg 3)) (list arg 3)))
+ (list "hi" (integer->char 65) #f 'a-symbol abs 3/4 #\f #t (if #f #f) '(1 2 (3 (4))) most-positive-fixnum))
+
+(test (member 3 . (1 '(2 3))) 'error)
+(test (member 3 '(1 2 3) = =) 'error)
+(test (member 3 . ('(1 2 3))) '(3))
+(test (member 3 . ('(1 2 3 . 4))) '(3 . 4))
+(test (member . (3 '(1 2 3))) '(3))
+(test (member '(1 2) '(1 2)) #f)
+(test (member '(1 2) '((1 2))) '((1 2)))
+(test (member . '(quote . ((quote)))) #f)
+(test (member . '(quote . ((quote) .()))) #f)
+(test (member '(((1))) '((((1).()).()).())) '((((1)))))
+(test (member '((1)) '(1 (1) ((1)) (((1))))) '(((1)) (((1)))))
+(test (member member (list abs car memq member +)) (list member +))
+(test (member () () "") 'error)
+
+(let ((odd '(3 a 3.0 b 3/4 c #(1) d))
+      (even '(e 3 a 3.0 b 3/4 c #(1) d)))
+  (test (member 'a odd) '(a 3.0 b 3/4 c #(1) d))
+  (test (member 'a even) '(a 3.0 b 3/4 c #(1) d))
+  (test (member 3/4 odd) '(3/4 c #(1) d))
+  (test (member 3/4 even) '(3/4 c #(1) d))
+  (test (member 3.0 odd) '(3.0 b 3/4 c #(1) d))
+  (test (member 3.0 even) '(3.0 b 3/4 c #(1) d))
+  (test (member #(1) odd) '(#(1) d))
+  (test (member #(1) even) '(#(1) d)))
+
+(test (member 3 '(1 2 3 4) =) '(3 4))
+(test (member 3 () =) #f)
+(test (member 3 '(1 2 4 5) =) #f)
+(test (member 4.0 '(1 2 4 5) =) '(4 5))
+(test (member #\a '(#\b #\A #\c) char=?) #f)
+(test (member #\a '(#\b #\A #\c) char-ci=?) '(#\A #\c))
+(test (member #\a '(#\b #\A #\c) (lambda (a b) (char-ci=? a b))) '(#\A #\c))
+(test (char=? (car (member #\a '(#\b #\a))) #\a) #t)
+(test (char=? (car (member #\a '(#\b #\a) (lambda (a b) (char=? a b)))) #\a) #t)
+(test (member 3 '(1 2 3 4) <) '(4))
+(test (member 3 '((1 2) (3 4)) member) '((3 4)))
+(test (member 3 '(((1 . 2) (4 . 5)) ((3 . 4))) assoc) '(((3 . 4))))
+(test (member '(#f #f #t) '(0 1 2) list-ref) '(2))
+(test (let ((v (vector 1 2 3))) (member v (list 0 v) vector-fill!)) '(0 #(0 0 0)))
+
+(test (member 3 '(1 2 3) abs) 'error)
+(test (member 3 '(1 2 3) quasiquote) 'error)
+(test (member 3 '(1 2 3) (lambda (a b c) (= a b))) 'error)
+(test (member 3 '(1 2 3) (lambda* (a b c) (= a b))) '(3))
+(test (member 3 '(1 2 3 4) (dilambda = =)) '(3 4))
+(test (catch #t (lambda () (member 3 '(1 2 3) (lambda (a b) (error 'member a)))) (lambda args (car args))) 'member)
+(test (call-with-exit (lambda (go) (member 3 '(1 2 3) (lambda (a b) (go 'member))))) 'member)
+(test (member 'a '(a a a) eq?) '(a a a))
+(test (member 'a '(b a a) eqv?) '(a a))
+(test (member 3.0 '(1 #\a (3 . 3) abs #() 3+i)) #f)
+(test (member 3.0 '(1 #\a (3 . 3) abs #() 3+i) (lambda (a b) (= (real-part a) b))) 'error)
+(test (member 3.0 '(1 #\a (3 . 3) abs #() 3+i) (lambda (a b) (and (number? b) (= (real-part b) a)))) '(3+i))
+;; is it guaranteed that in the comparison function the value is first and the list member 2nd?
+(test (member 4 '((1 2 3) (4 5 6) (7 8 9)) member) '((4 5 6) (7 8 9)))
+(test (member 4 '(1 2 3) member) 'error)
+(test (member 4 '((1 2) (3 5) 7) (lambda (a b) (member a (map (lambda (c) (+ c 1)) b)))) '((3 5) 7))
+(test (member 4 '((1 2) (3 5) 7) (lambda (a b) (assoc a (map (lambda (c) (cons (+ c 1) c)) b)))) '((3 5) 7))
+(test (let ((f #f)) (member 'a '(a b c) (lambda (a b) (if (eq? b 'a) (set! f (lambda () b))) (eq? a 123))) (f)) 'a)
+(test (let ((i 0) (f (make-vector 3))) (member 'a '(a b c) (lambda (a b) (vector-set! f i b) (set! i (+ i 1)) (eq? a 123))) f) #(a b c))
+(test (member 1 '(0 1 2) (lambda (a b . c) (= a b))) '(1 2))
+(test (member 1 '(0 1 2) (lambda* (a b c) (= a b))) '(1 2))
+(test (member 1 '(0 1 2) (lambda (a) (= a b))) 'error)
+(test (member 1 '(0 1 2) (lambda a (= (car a) (cadr a)))) '(1 2))
+
+(test (member 'a '(c 3 a 1 b 2) (lambda (a) (eq? a b))) 'error)
+(test (member 'a '(c 3 a 1 b 2) (lambda (a b) (eq? a b))) '(a 1 b 2))
+(test (member 'a '(c 3 a 1 b 2) (lambda (a b c) (eq? a b))) 'error)
+(test (member 'a '(c 3 a 1 b 2) (lambda (a b c . d) (eq? a b))) 'error)
+(test (member 'a '(c 3 a 1 b 2) (lambda (a b . c) (eq? a b))) '(a 1 b 2))
+(test (member 'a '(c 3 a 1 b 2) (lambda a (apply eq? a))) '(a 1 b 2))
+(test (member 'a '(c 3 a 1 b 2) (lambda (a . b) (eq? a (car b)))) '(a 1 b 2))
+
+(test (member 'a '(c 3 a 1 b 2) (lambda* (a) (eq? a b))) 'error)
+(test (member 'a '(c 3 a 1 b 2) (lambda* (a b) (eq? a b))) '(a 1 b 2))
+(test (member 'a '(c 3 a 1 b 2) (lambda* (a b c) (eq? a b))) '(a 1 b 2))
+(test (member 'a '(c 3 a 1 b 2) (lambda* (a b c . d) (eq? a b))) '(a 1 b 2))
+(test (member 'a '(c 3 a 1 b 2) (lambda* (a b . c) (eq? a b))) '(a 1 b 2))
+(test (member 'a '(c 3 a 1 b 2) (lambda* a (apply eq? a))) '(a 1 b 2))
+(test (member 'a '(c 3 a 1 b 2) (lambda* (a . b) (eq? a (car b)))) '(a 1 b 2))
+(test (member 'a '(c 3 a 1 b 2) (lambda* (a :rest b) (eq? a (car b)))) '(a 1 b 2))
+(test (member 'a '(c 3 a 1 b 2) (lambda* (a :rest b :rest c) (eq? a (car b)))) '(a 1 b 2))
+(test (member 'a '(c 3 a 1 b 2) (lambda* (:rest a) (apply eq? a))) '(a 1 b 2))
+(test (member 'a '(a b c) (define-macro (_m_ a b) `(eq? ',a ',b))) '(a b c))
+(test (member 'c '(a b c) (define-macro (_m_ a b) `(eq? ',a ',b))) '(c))
+
+(test (member 4 '(1 2 3 4 . 5)) '(4 . 5))
+(test (member 4 '(1 2 3 4 . 5) =) '(4 . 5))
+(test (member 4 '(1 2 3 . 4)) #f)
+(test (member 4 '(1 2 3 . 4) =) #f)
+(test (let ((lst (list 1 2 3))) (and (member 2 lst =) lst)) '(1 2 3))
+(test (pair? (let ((lst (list 1 2 3))) (set! (cdr (cdr lst)) lst) (member 2 lst))) #t)
+(test (pair? (let ((lst (list 1 2 3))) (set! (cdr (cdr lst)) lst) (member 2 lst =))) #t)
+(test (let ((lst (list 1 2 3))) (set! (cdr (cdr lst)) lst) (member 4 lst)) #f)
+(test (let ((lst (list 1 2 3))) (set! (cdr (cdr lst)) lst) (member 4 lst =)) #f)
+(test (pair? (let ((lst (list 1 2 3))) (set! (cdr (cdr (cdr lst))) lst) (member 3 lst =))) #t)
+(test (pair? (let ((lst (list 1 2 3 4))) (set! (cdr (cdr (cdr lst))) (cdr (cdr lst))) (member 3 lst =))) #t)
+(test (let ((lst (list 1 2 3 4))) (set! (cdr (cdr (cdr lst))) (cdr (cdr lst))) (member 5 lst =)) #f)
+(test (let ((lst (list 1 2 3 4))) (set! (cdr (cdr (cdr lst))) (cdr lst)) (member 4 lst =)) #f)
+(test (let ((lst '(1 2 3 5 6 9 10))) (member 3 lst (let ((last (car lst))) (lambda (a b) (let ((result (= (- b last) a))) (set! last b) result))))) '(9 10))
+(test (let ((lst '(1 2 3 5 6 9 10))) (member 2 lst (let ((last (car lst))) (lambda (a b) (let ((result (= (- b last) a))) (set! last b) result))))) '(5 6 9 10))
+(test (member 1 () =) #f)
+(test (member 1 #(1) =) 'error)
+(test (member 3 '(5 4 3 2 1) >) '(2 1))
+(test (member 3 '(5 4 3 2 1) >=) '(3 2 1))
+(test (member '(1 2) '((1) (1 . 2) (1 2 . 3) (1 2 3) (1 2) 1 . 2)) '((1 2) 1 . 2))
+(test (member '(1 2 . 3) '((1) (1 . 2) (1 2 . 3) (1 2 3) (1 2) 1 . 2)) '((1 2 . 3) (1 2 3) (1 2) 1 . 2))
+
+(when with-bignums
+  (test (memv 1 (list (bignum 1))) '(1))
+  (test (memv (bignum 1) (list 1)) '(1))
+  (test (member 1 (list (bignum 1)) eqv?) '(1))
+  (test (member 1 (list (bignum 1)) =) '(1))
+  (test (member 1 (list (bignum 1))) '(1))
+  (test (member 1 (list (bignum 1)) equivalent?) '(1))
+  (test (member 1 (list (bignum 1)) equal?) '(1))
+  (test (member 1.0 (list (bignum 1)) equivalent?) '(1))
+  (test (member (+ 1.0 1e-15) (list (bignum 1)) equivalent?) #f)
+  (test (assoc 1 (list (list (bignum 1) 'ok))) '(1 ok))
+  (test (let-temporarily (((*s7* 'equivalent-float-epsilon) 1e-6)) (member (+ 1 1e-10) (list (bignum 1)) equivalent?)) '(1))
+  (test (let-temporarily (((*s7* 'equivalent-float-epsilon) 1e-6)) (member (+ 1 1e-10) (list (bignum 1)) =)) #f))
+
+(when with-block
+  (test (member 1 (list 2 3) (lambda (a b) (float-vector? (block)))) '(2 3)))
+
+(let ()
+  (define (sfind obj lst)
+    (member obj lst (lambda (a b)
+		      (catch #t
+			(lambda ()
+			  (and (equal? a b)
+			       (member obj lst (lambda (a b)
+						 (catch #t
+						   (lambda ()
+						     (error 'oops))
+						   (lambda args
+						     (equal? a b)))))))
+			(lambda args
+			  'oops)))))
+  (test (sfind 'a '(b c a d)) '(a d)))
+
+(let* ((records (list ; from Woody Douglass
+		 (inlet :person "oscar meyer")
+		 (inlet :person "howard johnson")
+		 (inlet :person "betty crocker")))
+       (match-record (lambda (name record)
+		       (display name #f) ;(format (current-error-port) "COMPARE '~A' '~A'~%" name (record 'person))
+		       (let ((vname (record 'person)))
+			 (equal? name (substring vname 0 (min (length name) (length vname)))))))
+       (find-record (lambda (name)
+		      (display name #f) ;(format (current-error-port) "FINDING ~A~%" name)
+		      (let* ((found (member name records match-record)))
+			(if found
+			    (car found)
+			    #f)))))
+  (test (find-record "betty") (inlet :person "betty crocker")))
+
+(let ()
+  (define-macro (do-list lst . body)
+    `(member #t ,(cadr lst) (lambda (a b)
+			      (let ((,(car lst) b))
+				,@body
+				#f))))
+  (let ((sum 0))
+    (do-list (x '(1 2 3)) (set! sum (+ sum x)))
+    (test (= sum 6) #t)))
+
+(let ()
+  (define (tree-member a lst)
+    (member a lst (lambda (c d)
+		    (if (pair? d)
+			(tree-member c d)
+			(equal? c d)))))
+  (test (tree-member 1 '(2 3 (4 1) 5)) '((4 1) 5))
+  (test (tree-member -1 '(2 3 (4 1) 5)) #f)
+  (test (tree-member 1 '(2 3 ((4 (1) 5)))) '(((4 (1) 5)))))
+
+(let ((lst (list 1 2 3)))
+  (set! (cdr (cdr (cdr lst))) lst)
+  (test (member 2 lst) (member 2 lst equal?)))
+
+(let ((lst (list 1 2 3)))
+  (set! (cdr (cdr (cdr lst))) lst)
+  (test (member 4 lst) (member 4 lst equal?)))
+
+(let ((lst (list 1 2 3 4)))
+  (set! (cdr (cdr (cdr (cdr lst)))) lst)
+  (test (member 4 lst) (member 4 lst equal?)))
+
+(let ((lst (list 1 2 3 4)))
+  (set! (cdr (cdr (cdr (cdr lst)))) (cdr lst))
+  (test (member 4 lst) (member 4 lst equal?)))
+
+(for-each
+  (lambda (arg lst)
+    (test (member arg lst eq?) (memq arg lst))
+    (test (member arg lst eqv?) (memv arg lst))
+    (test (member arg lst equal?) (member arg lst)))
+  (list 'a #f (list 'a) 'a 1 3/4 #(1) "hi")
+  (list '(a b c) '(1 "hi" #t #f 2) '(b (a) c) '(d a b . c) '(1 3/4 23) '(1 3/4 23) '(a 1 #(1) 23) '(1 "hi" 23)))
+
+(for-each
+ (lambda (op)
+   (test (op) 'error)
+   (for-each
+    (lambda (arg)
+      (let ((result (catch #t (lambda () (op arg)) (lambda args 'error))))
+	(if (not (eq? result 'error))
+	    (format #t ";(~A ~A) returned ~A?~%" op arg result))
+	(test (op arg () arg) 'error)
+	(test (op arg) 'error)))
+    (list () "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+	  3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
+ (list cons car cdr set-car! set-cdr! caar cadr cdar cddr caaar caadr cadar cdaar caddr cdddr cdadr cddar
+       caaaar caaadr caadar cadaar caaddr cadddr cadadr caddar cdaaar cdaadr cdadar cddaar cdaddr cddddr cddadr cdddar
+       assq assv memq memv list-ref list-tail))
+
+(for-each
+ (lambda (op)
+   (test (op '(1) '(2)) 'error))
+ (list reverse car cdr caar cadr cdar cddr caaar caadr cadar cdaar caddr cdddr cdadr cddar
+       caaaar caaadr caadar cadaar caaddr cadddr cadadr caddar cdaaar cdaadr cdadar cddaar cdaddr cddddr cddadr cdddar
+       list-ref list-tail list-set!))
+
+(for-each
+ (lambda (op)
+   (for-each
+    (lambda (arg)
+      (let ((result (catch #t (lambda () (op #f arg)) (lambda args 'error))))
+	(if (not (eq? result 'error))
+	    (format #t ";(~A #f ~A) returned ~A?~%" op arg result))))
+    (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+	  3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
+ (list assq assv assoc memq memv member))
+
+;; t_simple_p checks [except for member/assoc, only case uses is_simple]
+(test (equal? (inlet 'a 1 'b 2) (inlet 'a 1 'b 2)) #t)
+(test (member (inlet 'a 1 'b 2) (list (inlet 'a 1 'b 2))) (list (inlet 'a 1 'b 2)))
+(test (assoc (inlet 'a 1 'b 2) (list (cons (inlet 'a 1 'b 2) 1))) (cons (inlet 'a 1 'b 2) 1))
+(let ()
+  (define (fequal? a b) (equal? a b))
+  (define (f1) (equal? (inlet 'a 1 'b 2) (inlet 'a 1 'b 2))) (f1) (test (f1) #t)
+  (define (f2) (member (inlet 'a 1 'b 2) (list (inlet 'a 1 'b 2)))) (f2) (test (f2) (list (inlet 'a 1 'b 2)))
+  (define (f3) (member (inlet 'a 1 'b 2) (list (inlet 'a 1 'b 2)) fequal?)) (f3) (test (f3) (list (inlet 'a 1 'b 2)))
+  (define (f4) (assoc (inlet 'a 1 'b 2) (list (cons (inlet 'a 1 'b 2) 1)))) (f4) (test (f4) (cons (inlet 'a 1 'b 2) 1)))
+
+(let ((ip1 (open-input-string "asdf"))
+      (ip2 (open-input-string "asdf")))
+  (test (equal? ip1 ip2) #f)
+  (test (member ip1 (list ip2)) #f)
+  (test (assoc ip1 (list (cons ip2 1))) #f)
+  (close-input-port ip1)
+  (close-input-port ip2))
+
+(let ((ip1 #<undef1>)
+      (ip2 #<undef1>))
+  (test (equal? ip1 ip2) #t)
+  (test (member ip1 (list ip2)) (list ip2))
+  (test (assoc ip1 (list (cons ip2 1))) (cons ip2 1)))
+
+(let ((lt1 (inlet 'a 1)))
+  (test (apply case lt1 (list (list lt1) 1) (list (list 'else 2))) 1))
+(let () (define* (f a b) (eqv? a b)) (test (member 3 '(1 2 3) f) '(3)))
+
+;;; these need to be here because we methodize 'string? below!
+(let () ; opt_b_7p_s_iter_at_end
+  (define (find-if-d1 iter)
+    (do ((i 0 (+ i 1)))
+	((= i 1) (not (iterator-at-end? iter)))
+      (do () ((or (string? (iterate iter)) (iterator-at-end? iter))))))
+  (test (find-if-d1 (make-iterator (list 1 2))) #f))
+(let () ;  iterator_is_at_end_b_7p
+  (define (find-if-d2 iter)
+    (do ((i 0 (+ i 1)))
+	((= i 1) (not (iterator-at-end? iter)))
+      (do () ((or (string? (iterate iter)) (iterator-at-end? (car (list iter))))))))
+  (test (find-if-d2 (make-iterator (list 1 2))) #f))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; append
+
+(test (append '(a b c) ()) '(a b c))
+(test (append () '(a b c)) '(a b c))
+(test (append '(a b) '(c d)) '(a b c d))
+(test (append '(a b) 'c) '(a b . c))
+(test (equal? (append (list 'a 'b 'c) (list 'd 'e 'f) () '(g)) '(a b c d e f g)) #t)
+(test (append (list 'a 'b 'c) (list 'd 'e 'f) () (list 'g)) '(a b c d e f g))
+(test (append (list 'a 'b 'c) 'd) '(a b c . d))
+(test (append () ()) ())
+(test (append () (list 'a 'b 'c)) '(a b c))
+(test (append) ())
+(test (append () 1) 1)
+(test (append 'a) 'a)
+(test (append '(x) '(y))  '(x y))
+(test (append '(a) '(b c d)) '(a b c d))
+(test (append '(a (b)) '((c)))  '(a (b) (c)))
+(test (append '(a b) '(c . d))  '(a b c . d))
+(test (append () 'a)  'a)
+(test (append '(a b) (append (append '(c)) '(e) 'f)) '(a b c e . f))
+(test (append ''foo 'foo) (cons #_quote (cons 'foo 'foo)))
+(test (append () (cons 1 2)) '(1 . 2))
+(test (append () () ()) ())
+(test (append (cons 1 2)) '(1 . 2))
+(test (append (list 1) 2) '(1 . 2))
+
+(test (append #f) #f)
+(test (append () #f) #f)
+(test (append '(1 2) #f) '(1 2 . #f))
+(test (append () () #f) #f)
+(test (append () '(1 2) #f) '(1 2 . #f))
+(test (append '(1 2) () #f) '(1 2 . #f))
+(test (append '(1 2) '(3 4) #f) '(1 2 3 4 . #f))
+(test (append () () () #f) #f)
+(test (append '(1 2) '(3 4) '(5 6) #f) '(1 2 3 4 5 6 . #f))
+(test (append () () #()) #())
+(test (append () ((lambda () #f))) #f)
+
+(test (append (begin) do) do)
+(test (append if) if)
+(test (append quote) quote)
+(test (append 0) 0) ; is this correct?
+(test (append () 0) 0)
+(test (append () () 0) 0)
+(test (let* ((x '(1 2 3)) (y (append x ()))) (eq? x y)) #f) ; check that append returns a new list
+(test (let* ((x '(1 2 3)) (y (append x ()))) (equal? x y)) #t)
+(test (let* ((x (list 1 2 3)) (y (append x (list)))) (eq? x y)) #f)
+(test (append '(1) 2) '(1 . 2))
+(let ((x (list 1 2 3)))
+  (let ((y (append x ())))
+    (set-car! x 0)
+    (test (= (car y) 1) #t)))
+(let ((x (list 1 2 3)))
+  (let ((y (append x ())))
+    (set-cdr! x 0)
+    (test (and (= (car y) 1)
+	       (= (cadr y) 2)
+	       (= (caddr y) 3))
+	  #t)))
+
+(test (let ((xx (list 1 2))) (recompose 12 (lambda (x) (append (list (car x)) (cdr x))) xx)) '(1 2))
+
+(test (append 'a 'b) 'error)
+(test (append 'a ()) 'error)
+(test (append (cons 1 2) ()) 'error)
+(test (append '(1) 2 '(3)) 'error)
+(test (append '(1) 2 3) 'error)
+(test (let ((lst (list 1 2 3))) (append lst lst)) '(1 2 3 1 2 3))
+(test (append ''1 ''1) (list #_quote 1 #_quote 1))
+(test (append '(1 2 . 3) '(4)) 'error)
+(test (append '(1 2 . 3)) '(1 2 . 3))
+(test (append '(4) '(1 2 . 3)) '(4 1 2 . 3))
+(test (append () 12 . ()) 12)
+(test (append '(1) 12) '(1 . 12))
+(test (append '(1) 12 . ()) '(1 . 12))
+(test (append () () '(1) 12) '(1 . 12))
+(test (append '(1) '(2) '(3) 12) '(1 2 3 . 12))
+(test (append '(((1))) '(((2)))) '(((1)) ((2))))
+(test (append () . (2)) 2)
+(test (append . (2)) 2)
+(test (append ''() ()) ''())
+(test (let ((i 1)) (logior 123 (append i))) 123) ; !
+(test (let ((x "hi")) (eq? (append x "") x)) #f)
+(test (let ((x #(1 2 3))) (eq? (append x #()) x)) #f)
+(test (let ((x '(1 2 3))) (eq? (append x ()) x)) #f)
+(test (let ((x '(1 2 3))) (eq? (append x) x)) #t)
+(test (append (rootlet) #f) 'error) ; "append first argument, (rootlet), is a let but should be a sequence other than the rootlet"
+(test (append () (make-hash-table) (byte-vector)) #u())
+(test (append (append () (make-hash-table)) (byte-vector)) (hash-table))
+
+(for-each
+ (lambda (arg)
+   (test (append arg) arg)
+   (test (append () arg) arg)
+   (test (append () () () arg) arg))
+ (list "hi" #\a #f 'a-symbol _ht_ _undef_ _null_ (make-vector 3) abs 1 3.14 3/4 1.0+1.0i #t #<unspecified> #<eof> () #() (list 1 2) (cons 1 2) #(0) (lambda (a) (+ a 1))))
+(test (append not) not)
+
+(test (let ((l0 (list 0))
+	    (l1 (list 0)))
+	(let ((m0 (append '(2) l0))
+	      (m1 (append '(2) l1 '())))
+	  (and (equal? l0 l1)
+	       (equal? m0 m1)
+	       (let ()
+		 (list-set! m0 1 3)
+		 (list-set! m1 1 3)
+		 (list l0 l1)))))
+      '((3) (0)))
+
+;;; generic append
+(test (append "asdasd" '("asd")) 'error)
+(test (append "asdasd" #("asd")) 'error)
+(test (append (string->byte-vector "asdasd") '("asd")) 'error)
+(test (append (string->byte-vector "asdasd") #("asd")) 'error)
+
+(test (catch #t (lambda () (append  #r(1.0 2.0 3.0) #((a . 4)))) (lambda (type info) (apply format #f info))) "append argument, (a . 4), is a pair but should be a real")
+(test (catch #t (lambda () (append #i(1 2 3) #r(1.0 2.0 3.0))) (lambda (type info) (apply format #f info))) "can't append #r(1.0 2.0 3.0) to an int-vector")
+(test (append (inlet) (hash-table :readable 123)) 'error)
+
+(test (let ((h1 (hash-table 'a 1 'b 2)) (h2 (hash-table 'c 3))) (append h1 h2)) (hash-table 'c 3 'a 1 'b 2))
+(test (let ((i1 (inlet 'a 1)) (i2 (inlet 'b 2 'c 3))) (append i1 i2)) (inlet 'a 1 'c 3 'b 2))
+(test (let ((s1 "abc") (s2 "def")) (append s1 s2)) "abcdef")
+(test (let ((v1 #(0 1)) (v2 #(2 3))) (append v1 v2)) #(0 1 2 3))
+(test (let ((p1 '(1 2)) (p2 '(3 4))) (append p1 p2)) '(1 2 3 4))
+(test (vector? (append #())) #t)
+(test (float-vector? (append (float-vector))) #t)
+(test (int-vector? (append (int-vector))) #t)
+(test (append "12" '(1 . 2) "3") 'error)
+(for-each
+ (lambda (arg)
+   (test (append arg) arg)
+   (test (append () arg) arg))
+ (list "" #u() () #() (int-vector) (float-vector) (inlet) (hash-table)
+       "123" #u(101 102)
+       '(1 2 3) '((e . 5) (f . 6))
+       #(1 2 3) #((g . 8) (h . 9)) (int-vector 1 2 3) (float-vector 1 2 3)
+       (inlet 'a 1 'b 2)
+       (hash-table 'c 3 'd 4)))
+(test (append #u() (int-vector 1 2 3)) #u(1 2 3))
+(test (append #u() "123") #u(49 50 51))
+(test (append "" "123") "123")
+(test (append #() (hash-table)) #())
+(test (append #() #u(101 102)) #(101 102))
+(test (append (float-vector) #u(101 102)) (float-vector 101.0 102.0))
+(test (append (int-vector) #u(101 102)) (int-vector 101 102))
+(test (append (hash-table) '((e . 5) (f . 6))) (hash-table 'e 5 'f 6))
+(test (append (inlet) #((g . 8) (h . 9))) (inlet 'g 8 'h 9))
+(test (append '(1 2 3) #u()) '(1 2 3))
+(test (append '(1 2 3) #u() #(4 5)) '(1 2 3 4 5))
+(test (append '(1 2 3) #u(101 102)) '(1 2 3 101 102))
+(test (append '(1 2 3) #() (inlet 'a 1 'b 2)) '(1 2 3 (a . 1) (b . 2)))
+(test (let ((lst (append '((e . 5) (f . 6)) "" (hash-table 'c 3 'd 4))))
+	(or (equal? lst '((e . 5) (f . 6) (c . 3) (d . 4)))
+	    (equal? lst '((e . 5) (f . 6) (d . 4) (c . 3))))) #t)
+(test (append (list 1) "hi") '(1 #\h #\i))
+(test (append #(1 2 3) "123") #(1 2 3 #\1 #\2 #\3))
+(test (append (int-vector 1 2 3) #(1 2 3)) (int-vector 1 2 3 1 2 3))
+(test (append (int-vector 1 2 3) "123") (int-vector 1 2 3 49 50 51))
+(test (append (float-vector 1.0 2.0 3.0) (int-vector 1 2 3)) (float-vector 1.0 2.0 3.0 1.0 2.0 3.0))
+(test (append (int-vector 1 2 3) (float-vector 1.0 2.0 3.0)) 'error) ;(int-vector 1 2 3 1 2 3))
+(test (append (inlet 'a 1 'b 2) '((e . 5) (f . 6))) (inlet 'b 2 'a 1 'e 5 'f 6))
+(test (append (inlet 'a 1 'b 2) (hash-table 'c 3 'd 4)) (inlet 'b 2 'a 1 'c 3 'd 4))
+(test (append "" #() #u(101 102)) "ef")
+(test (append "" #u(101 102) (hash-table)) "ef")
+(test (append #u() #() #u(101 102)) #u(101 102))
+(test (append #u() (inlet) "") #u())
+(test (append #u() #u(101 102) "123") #u(101 102 49 50 51))
+(test (append () "" (int-vector 1 2 3)) (int-vector 1 2 3))
+(test (let ((v (append #() #u() (hash-table 'c 3 'd 4))))
+	(or (equal? v #((c . 3) (d . 4)))
+	    (equal? v #((d . 4) (c . 3))))) #t)
+(test (append #() #(1 2 3) (inlet)) #(1 2 3))
+(test (append #() (float-vector 1.0 2.0 3.0) ()) #(1.0 2.0 3.0))
+(test (append (float-vector) "" "123") (float-vector 49.0 50.0 51.0))
+(test (append (float-vector) (int-vector 1 2 3) #u(101 102)) (float-vector 1.0 2.0 3.0 101.0 102.0))
+(test (append (inlet) #() #((g . 8) (h . 9))) (inlet 'g 8 'h 9))
+(test (append (inlet) '((e . 5) (f . 6)) (hash-table 'c 3 'd 4)) (inlet 'e 5 'f 6 'c 3 'd 4))
+(test (append (hash-table) "" (inlet 'a 1 'b 2)) (hash-table 'b 2 'a 1))
+(test (append (hash-table) '((e . 5) (f . 6)) (inlet 'a 1 'b 2)) (hash-table 'b 2 'e 5 'f 6 'a 1))
+(test (append (hash-table) #((g . 8) (h . 9)) '((e . 5) (f . 6))) (hash-table 'e 5 'g 8 'f 6 'h 9))
+(test (append "123" #u(101 102) (hash-table)) "123ef")
+(test (append #u(101 102) #u() #u(101 102)) #u(101 102 101 102))
+(test (append #u(101 102) "123" (int-vector 1 2 3)) #u(101 102 49 50 51 1 2 3))
+(test (append #u(101 102) '(1 2 3) "") #u(101 102 1 2 3))
+(test (append '(1 2 3) #u(101 102) #(1 2 3)) '(1 2 3 101 102 1 2 3))
+(test (let ((lst (append '(1 2 3) (hash-table 'c 3 'd 4) "")))
+	(or (equal? lst '(1 2 3 (c . 3) (d . 4)))
+	    (equal? lst '(1 2 3 (d . 4) (c . 3))))) #t)
+(test (append (int-vector 1 2 3) #u(101 102) (float-vector 1.0 2.0 3.0)) 'error) ; (int-vector 1 2 3 101 102 1 2 3))
+(test (append (int-vector 1 2 3) '(1 2 3) #u(101 102)) (int-vector 1 2 3 1 2 3 101 102))
+(test (append (hash-table 'c 3 'd 4) (hash-table 'c 3 'd 4) '((e . 5) (f . 6))) (hash-table 'e 5 'f 6 'c 3 'd 4))
+(when with-block
+  (test (null? (with-let (block 1.0) (append))) #t)
+  (test (append (block 1 2) (block 3 4)) (block 1 2 3 4))
+  (test (let () (define (func) (append (list (list (list 1)) (setter car)) (vector-dimensions (block 0.0)))) (define (hi) (func)) (hi)) (list '((1)) set-car! 1))
+  (test (append #i2d((101 201) (3 4)) (make-block 2)) 'error) ; #i(101 201 3 4 0 0))
+  (test (let () (define (f1) (do ((i 0 (+ i 1))) ((= i 1)) (values (append "" (block)) 1))) (f1)) #t))
+
+(let ((vvv (let ((v (make-vector '(2 2)))) (set! (v 0 0) "asd") (set! (v 0 1) #r(4 5 6)) (set! (v 1 0) '(1 2 3)) (set! (v 1 1) 32) v)))
+(test (let ((x #f)) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (append vvv (byte-vector 255))))) #("asd" #r(4.0 5.0 6.0) (1 2 3) 32 255))
+(test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (append vvv (byte-vector 255))))) (func)) #("asd" #r(4.0 5.0 6.0) (1 2 3) 32 255))
+(test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (append vvv (byte-vector 255))))) (func)) #("asd" #r(4.0 5.0 6.0) (1 2 3) 32 255))
+(test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (append vvv (int-vector 255))))) (func)) #("asd" #r(4.0 5.0 6.0) (1 2 3) 32 255))
+(test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (append vvv (vector 255))))) (func)) #("asd" #r(4.0 5.0 6.0) (1 2 3) 32 255))
+(test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (append vvv (string #\a))))) (func)) #("asd" #r(4.0 5.0 6.0) (1 2 3) 32 #\a))
+(test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (append vvv (vector 1 2 3))))) (func)) #("asd" #r(4.0 5.0 6.0) (1 2 3) 32 1 2 3))
+(test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (append vvv vvv)))) (func)) #("asd" #r(4.0 5.0 6.0) (1 2 3) 32 "asd" #r(4.0 5.0 6.0) (1 2 3) 32))
+(test (let ((x #f)) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (append (vector 0) vvv (byte-vector 255))))) #(0 "asd" #r(4.0 5.0 6.0) (1 2 3) 32 255))
+(test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (append (vector 0) vvv (byte-vector 255))))) (func)) #(0 "asd" #r(4.0 5.0 6.0) (1 2 3) 32 255)))
+(when with-block
+  (test (char? (append (make-float-vector '(2 3) 1) (immutable! (block 0.0 1.0 2.0)))) #f))
+
+(test (let ((v1 #2d(((b . 2) (:rest . 123))))) (append (inlet :a 32) v1 ())) (inlet 'a 32 'b 2 'rest 123)) ; let_setter keyword check
+
+(test (random-state? (cdr (append '(1) (random-state 123)))) #t)
+(test (append '(1) (random-state 123) ()) 'error)
+(test (random-state? (append () (random-state 123))) #t)
+
+(letrec ((L (openlet (inlet 'value "123"
+                            'append (lambda args
+				      (if (eq? (car args) L)
+				          (apply #_append (let-ref (car args) 'value) (cdr args))
+				          (apply #_append (car args) (let-ref (cadr args) 'value) (cddr args))))))))
+  (test (append "asd" #u(90) L "456") "asdZ123456")
+  (test (append "asd" L #u(90) "456") "asd123Z456")
+  (test (append "asd" #u(90) "456" L) "asdZ456123")
+  (test (append L "asd" #u(90) "456") "123asdZ456")
+  (test (append L L "asd" #u(90) "456") "123123asdZ456")
+  (test (append "asd" L #u(90) L "456") "asd123Z123456"))
+
+(letrec ((L (openlet (inlet 'value "123"
+			    'string? (lambda (obj) #t)
+                            'string-append (lambda args
+					     (if (eq? (car args) L)
+						 (apply #_string-append (let-ref (car args) 'value) (cdr args))
+						 (apply #_string-append (car args) (let-ref (cadr args) 'value) (cddr args))))))))
+  (test (string-append "asd" #u(90) L "456") 'error)
+  (test (string-append "asd" "Z" L "456") "asdZ123456")
+  (test (string-append "asd" L "Z" "456") "asd123Z456")
+  (test (string-append "asd" "Z" "456" L) "asdZ456123")
+  (test (string-append L "asd" "Z" "456") "123asdZ456")
+  (test (string-append L L "asd" "Z" "456") "123123asdZ456")
+  (test (string-append "asd" L "Z" L "456") "asd123Z123456"))
+
+(when full-s7test
+  (let ((seqs (list "" #u() () #() (int-vector) (float-vector) (inlet) (hash-table)
+		    "123" #u(101 102)
+		    '(1 2 3) '((e . 5) (f . 6))
+		    #(1 2 3) #((g . 8) (h . 9)) (int-vector 1 2 3) (float-vector 1 2 3)
+		    (inlet 'a 1 'b 2)
+		    (hash-table 'c 3 'd 4)
+		    1 #f '(1 . 2) (let ((lst (list 1))) (set-cdr! lst lst)))))
+    (define (test-append)
+      (for-each
+       (lambda (s1)
+	 (catch #t
+	   (lambda ()
+	     (append s1)
+	     (for-each
+	      (lambda (s2)
+		(catch #t
+		  (lambda ()
+		    (append s1 s2)
+		    (for-each
+		     (lambda (s3)
+		       (catch #t
+			 (lambda ()
+			   (append s1 s2 s3)
+			   (for-each
+			    (lambda (s4)
+			      (catch #t
+				(lambda ()
+				  (append s1 s2 s3 s4)
+				  (for-each
+				   (lambda (s5)
+				     (catch #t (lambda ()
+						 (append s1 s2 s3 s4 s5))
+					    (lambda args 'error)))
+				   seqs))
+				(lambda args 'error)))
+			    seqs))
+			 (lambda args 'error)))
+		     seqs))
+		  (lambda args 'error)))
+	      seqs))
+	   (lambda args 'error)))
+       seqs))
+    (test-append)))
+
+(test (append (vector 1 2 3) (list 4 5 6)) #(1 2 3 4 5 6))
+(test (append (list 1 2 3) (vector 4 5 6)) '(1 2 3 4 5 6))
+(test (append (list) (vector 4 5 6)) #(4 5 6))
+(test (append (vector 1 2 3) (list)) #(1 2 3))
+(test (append (list 1 2 3) (vector)) '(1 2 3))
+(test (append (vector #\f) "abc") #(#\f #\a #\b #\c))
+(test (append "abc" (vector #\f)) "abcf")
+(test (append (list #\a) "bc") '(#\a #\b #\c))
+(test (append "ab" (list #\c)) "abc")
+(test (append (hash-table) #(1 2 3)) 'error)
+(test (append (hash-table 'a 1) #((b . 2))) (hash-table 'a 1 'b 2))
+(test (append "" #()) "")
+(test (append #() "") #())
+(test (append #i(1 2 3) "asdf") #i(1 2 3 97 115 100 102))
+(test (append "asdf" #i(90 91)) "asdfZ[")
+(test (append "asdf" ())  "asdf")
+(test (append "asdf" #()) "asdf")
+(test (append () "asdf") "asdf")
+(test (append #r(1.0 2.0 3.0) "asdf") #r(1.0 2.0 3.0 97.0 115.0 100.0 102.0))
+(test (append #r(1.0 2.0 3.0) "") #r(1.0 2.0 3.0))
+(test (append #r(1.0 2.0 3.0) (hash-table)) #r(1.0 2.0 3.0))
+(test (append (hash-table) "asdf") 'error)
+(test (append () "asdf" #()) '(#\a #\s #\d #\f))
+(test (append "asdf" "asdf" #()) "asdfasdf")
+(test (append (block) #r(1 2 3)) 'error)
+(test (append #r(1 2 3) (block)) #r(1.0 2.0 3.0))
+(test (append (block 1 2 3) #r()) 'error)
+(test (append (hash-table 'a 1) #((b . 2))) (hash-table 'a 1 'b 2))
+(test (append #((a . 1)) (hash-table 'b 2)) #((a . 1) (b . 2)))
+(test (append #((a . 1)) (hash-table 'b 2) (inlet 'c 3)) #((a . 1) (b . 2) (c . 3)))
+(test (append (hash-table 'a 1) #((b . 2)) (inlet 'c 3)) (hash-table 'c 3 'a 1 'b 2))
+(test (append (inlet 'c 3) (hash-table 'a 1) #((b . 2))) (inlet 'b 2 'a 1 'c 3))
+(test (append () (hash-table 'a 1)) (hash-table 'a 1))
+(test (append '((b . 2)) (hash-table 'a 1)) '((b . 2) (a . 1)))
+(test (append (hash-table 'a 1) '((b . 2))) (hash-table 'a 1 'b 2))
+(test (append '((a . 1)) (inlet 'b 2)) '((a . 1) (b . 2)))
+(test (append '(1 2) #i(3 4)) '(1 2 3 4))
+(test (append '(1 2) (inlet 'a 1)) '(1 2 (a . 1)))
+(test (append '(1 2) (hash-table 'a 1)) '(1 2 (a . 1)))
+(test (append () (hash-table 'a 1)) (hash-table 'a 1))
+(test (append (list 1 2) #(3) 4) '(1 2 3 . 4))
+(let ((L (list 1))) (set-cdr! L L) (test (append (list 2) L) (cons 2 L)))
+(test (append "" #() (list #\a) () (inlet) "b" (hash-table) #(#\c)) "abc")
+(test (append (hash-table 'a 1) (hash-table 'a 2)) (hash-table 'a 2))
+(test (append (hash-table 'a 1) (inlet 'a 2)) (hash-table 'a 2))
+(test (append "asdf" (list #\a)) "asdfa")
+
+
+;;; tree-cyclic --------
+(test (tree-cyclic? '(1 2)) #f)
+(test (tree-cyclic? 1) #f)
+(test (tree-cyclic? (let ((lst (list 1))) (set-cdr! lst lst))) #t)
+(test (tree-cyclic? (let ((lst (list 1))) (set-car! lst lst))) #t)
+(test (tree-cyclic? (let ((lst (list 1 2))) (set-cdr! (cdr lst) lst))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 3) 2))) (set-cdr! (car lst) lst))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 3) 2))) (set-car! (car lst) lst))) #t)
+(test (tree-cyclic? (let ((lst (list 1 (list 1 3) 2))) (set-car! (cdr lst) lst))) #t)
+(test (tree-cyclic? (let ((lst (list 1 (list 1 3) 2))) (set-cdr! (cdr lst) lst))) #t)
+(test (tree-cyclic? (let ((lst (list 1 (list 1 3) 2))) (set-cdr! (cddr lst) lst))) #t)
+(test (tree-cyclic? '(1 2 (3 4))) #f)
+(test (tree-cyclic? '(1 . 2)) #f)
+(test (tree-cyclic? '(1 2 . 3)) #f)
+(test (tree-cyclic? (let ((lst (list 1 (list 1 3) 2))) (set-cdr! (cddr lst) lst) (list 1 lst))) #t)
+(test (tree-cyclic? (let ((lst (list 1 (list 1 3) 2))) (set-cdr! (cddr lst) lst) (list 1 (cdr lst)))) #t)
+(test (tree-cyclic? (let ((lst (list (cons 1 3) 2))) (set-cdr! (cdr lst) lst))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 4) (cons 2 3)))) (set-cdr! (car lst) lst))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 4) (cons 2 3)))) (set-cdr! (cadr lst) lst))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-car! (car lst) lst))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-car! (cdar lst) lst))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-cdr! (car lst) lst))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-cdr! (cdar lst) lst))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-car! (cadr lst) lst))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-cdr! (cadr lst) lst))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-car! (cadr lst) (cdr lst)))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-cdr! (cadr lst) (cdr lst)))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-car! (caddr lst) lst))) #t)
+(test (tree-cyclic? (let ((lst (list (list (list (list 4 5 6)))))) (set-car! (caaar lst) lst))) #t)
+(test (tree-cyclic? (let ((lst (list (list (list (list (list 4 5 6))))))) (set-car! (caaaar lst) lst))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-cdr! (caddr lst) lst))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-car! (caddr lst) (cdr lst)))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-cdr! (caddr lst) (cdr lst)))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-car! (caddr lst) (cddr lst)))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-cdr! (caddr lst) (cddr lst)))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-car! (cdaddr lst) lst))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-cdr! (cdaddr lst) lst))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-car! (cdaddr lst) (cdr lst)))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-cdr! (cdaddr lst) (cdr lst)))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-car! (cdaddr lst) (cddr lst)))) #t)
+(test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-cdr! (cdaddr lst) (cddr lst)))) #t)
+
+(let-temporarily (((*s7* 'safety) 1))
+  (test (for-each
+	 (define-bacro (_b1_ a) `(* ,a 2))
+	 (let ((<1> (list #f)))
+	   (set-cdr! <1> <1>)
+	   (vector (let ((<L> (list #f #f)))
+		     (set-cdr! (cdr <L>) <1>)
+		     <L>)
+		   #f #f)))
+	'error))
+
+(let ()
+  (let* ((end '(2)) (tree (list end end))) (test (tree-cyclic? tree) #f))
+  (test (let ((L (list 1 (list 6 7) 3))
+	      (L1 (list 4 5 3)))
+	  (set-car! (cdr L1) L)
+	  (set-car! (cadr L) L1)
+	  (tree-cyclic? (list 1 L 2)))
+	#t)
+
+  (define (setf top L)
+    (if (pair? top)
+	(begin
+	  (if (not (car top))
+	      (set-car! top L)
+	      (setf (car top) L))
+	  (setf (cdr top) L))))
+
+  (test (let ((L1 (list (list #f))))
+	  (let ((L2 (list (list 0) (list #f))))
+	    (setf L1 L2)
+	    (setf L2 L2)
+	    (tree-cyclic? L1)))
+	#t)
+
+  (test (let ((L1 (list 1 2)))
+	  (let ((L2 (cons L1 (cons L1 L1))))
+	    (tree-cyclic? L2)))
+	#f)
+
+  (test (let ((L1 (list 1 2)))
+	  (let ((L2 (cons (cons 1 L1) (cons 1 L1))))
+	    (tree-cyclic? L2)))
+	#f)
+)
+
+;;; changed these 9-Nov-23 to insist that the "tree" be a list
+;;; tree-leaves --------
+(test (tree-leaves '(lambda () 1)) 3)
+(test (tree-leaves ()) 0)
+(test (tree-leaves 1) 'error)
+(test (tree-leaves '(a . b)) 2)
+(test (tree-leaves '(1 (2 3) (4 (5 . 6) . 7))) 7)
+(test (tree-leaves '((() (1) (())))) 3)
+(test (tree-leaves '(1 (2 (3 (4)) (5 . 6)) 7)) 7)
+
+(let-temporarily (((*s7* 'safety) 1))
+  (test (tree-leaves (let ((cp (list 1))) (set-cdr! cp cp) (list '+ 1 (list 'quote cp)))) 3)) ; infinite loop #_quote
+
+;;; tree-memq --------
+(test (tree-memq 'a '(a b c)) #t)
+(test (tree-memq 'a '(b c . a)) #t)
+(test (tree-memq 'a '(b c . e)) #f)
+(test (tree-memq 'a '(c b c)) #f)
+(test (tree-memq 'a '(b c ((b a)))) #t)
+(test (tree-memq 3 '(b c ((b 3)))) #t) ; actually this should be tree-memv
+(test (tree-memq #\a '(a b ((c (#\a))))) #t)
+(test (tree-memq #\a '(a b ((c (#\A))))) #f)
+(test (tree-memq :a '(a b ((c)))) #f)
+(test (tree-memq :a '(a b :a)) #t)
+(test (tree-memq () '(a b)) #t)
+(test (tree-memq 'a ()) #f)
+(test (tree-memq 'a :a) 'error)
+(test (tree-memq 'a (hash-table 'a 1)) 'error)
+
+;;; tree-count --------
+(test (tree-count 'x '(a b c)) 0)
+(test (tree-count 'x '(a x c)) 1)
+(test (tree-count 'x '(a x x)) 2)
+(test (tree-count 'x '(a x x) 1) 1)
+(test (tree-count 'x '(x x x) 2) 2)
+(test (tree-count 'x 'x) 'error)
+(test (tree-count 'x 'x 'x) 'error)
+(test (tree-count 'x '(a x x x) 1) 1)
+(when with-bignums
+  (test (tree-count 'x '(a x c) (bignum 10)) 1)
+  (test (tree-count 'x () (bignum 10)) 0))
+
+;; tree-count uses eq? which means these two can be different:
+;;                        (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (tree-count 0 x)))
+;;  (begin (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (tree-count 0 x)))) (func))
+
+;;; tree-set-memq --------
+;;; changed 9-Nov-23 to allow set to include anything that tree-memq can handle
+
+(test (tree-set-memq '(a b) '(1 (2 3 a) 4)) #t)
+(test (tree-set-memq '(a b) '(1 (2 3 b) 4)) #t)
+(test (tree-set-memq '(a b) '(1 (2 3 c) 4)) #f)
+(test (tree-set-memq '(a) ()) #f)
+(test (tree-set-memq '(#\a) '(1 #\a 2)) #t)
+(test (tree-set-memq '(a #\a) '(1 2 a)) #t)
+(test (tree-set-memq '(a) 32) 'error)
+(test (tree-set-memq 32 ()) 'error)
+(test (tree-set-memq () '(a b c)) #f)
+
+(let-temporarily (((*s7* 'safety) 1))
+  (test (tree-count 'a (let ((lst (list 1))) (set-cdr! lst lst))) 'error)
+  (test (tree-leaves (let ((lst (list 1))) (set-cdr! lst lst))) 'error)
+  (test (tree-memq 'a (let ((lst (list 1))) (set-cdr! lst lst))) 'error)
+  (test (tree-set-memq '(a b c) (let ((lst (list 1))) (set-cdr! lst lst))) 'error)
+  (test (tree-set-memq (let ((<1> (list #f))) (set-cdr! <1> <1>) (let ((<L> (list #f #f))) (set-cdr! (cdr <L>) <1>)  <L>)) ((lambda* ((a 1)) (+ a 1)) 1)) 'error)
+  (test (let () (define (func) (tree-leaves (signature float-vector))) (define (hi) (func)) (hi)) 'error)
+
+  ;; these two check that tree-cyclic? ignores quoted circular lists
+  (test (member 1 (list 2 3) (lambda (a b) `(x ,(let ((lst (list 1))) (set-cdr! lst lst))) #f)) #f)
+  (test (member 1 (list 3 2) (lambda (a b) (set-cdr! '(x) (let ((lst (list 1))) (set-cdr! lst lst))) (or))) #f))
+
+(let-temporarily (((*s7* 'safety) 1))
+  (let ((lst (list 1 2)))
+    (set-cdr! (cdr lst) lst)
+    (test (tree-leaves lst) 'error)
+    (test (tree-memq 'a lst) 'error)
+    (test (tree-set-memq '(a b c) lst) 'error)
+    (test (tree-count 'a lst) 'error)))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; VECTORS
+;;; --------------------------------------------------------------------------------
+
+
+;;; --------------------------------------------------------------------------------
+;;; vector?
+
+(test (vector? (make-vector 6)) #t)
+(test (vector? (make-vector 6 #\a)) #t)
+(test (vector? (make-vector 0)) #t)
+;; (test (vector? #*1011) #f)
+(test (vector? #(0 (2 2 2 2) "Anna")) #t)
+(test (vector? #()) #t)
+(test (vector? #("hi")) #t)
+(test (vector? (vector 1)) #t)
+(test (let ((v (vector 1 2 3))) (vector? v)) #t)
+
+(for-each
+ (lambda (arg)
+   (test (vector? arg) #f))
+ (list #\a 1 () (list 1) '(1 . 2) #f "hi" 'a-symbol abs _ht_ _undef_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (vector?) 'error)
+(test (vector? #() #(1)) 'error)
+(test (vector? begin) #f)
+(test (vector? vector?) #f)
+
+;;; make a shared ref -- we'll check it later after enough has happened that an intervening GC is likely
+
+(define check-subvector-after-gc #f)
+(let ((avect (make-vector '(6 6) 32)))
+  (do ((i 0 (+ i 1)))
+      ((= i 6))
+    (do ((j 0 (+ j 1)))
+	((= j 6))
+      (set! (avect i j) (cons i j))))
+  (set! check-subvector-after-gc (avect 3)))
+
+(if (not with-bignums)
+    (test (vector? (make-float-vector 3 pi)) #t))
+(test (vector? (make-vector 3 pi)) #t)
+(test (vector? (subvector (make-int-vector '(2 3)) 0 6 '(3 2))) #t)
+(test (vector? #r(+nan.0)) #t)
+(test (vector? #r(+inf.0)) #t)
+(test (vector? #(-nan.0 -inf.0)) #t)
+
+
+;;; --------------------------------------------------------------------------------
+;;; make-vector
+
+(test (let ((v (make-vector 3 #f))) (and (vector? v) (= (vector-length v) 3) (eq? (vector-ref v 1) #f))) #t)
+(test (let ((v (make-vector 1 1))) (and (vector? v) (= (vector-length v) 1) (vector-ref v 0))) 1)
+(test (let ((v (make-vector 0 1))) (and (vector? v) (= (vector-length v) 0))) #t)
+(test (do ((vec (make-vector 5)) (i 0 (+ i 1))) ((= i 5) vec) (vector-set! vec i i)) #(0 1 2 3 4))
+(test (let ((v (make-vector 5))) (for-each (lambda (i) (vector-set! v i (* i i))) '(0 1 2 3 4)) v) #(0 1 4 9 16))
+(test (make-vector 2 'hi) #(hi hi))
+(test (make-vector 0) #())
+(test (make-vector -0) #())
+(test (make-vector 0 'hi) #())
+(test (make-vector 3 (make-vector 1 'hi)) #(#(hi) #(hi) #(hi)))
+(test (make-vector 3 #(hi)) #(#(hi) #(hi) #(hi)))
+(test (make-vector 9/3 (list)) #(() () ()))
+(test (make-vector 3/1 (make-vector 1 (make-vector 1 'hi))) #(#(#(hi)) #(#(hi)) #(#(hi))))
+(test (make-float-vector 0 0.0) #())
+(test (make-vector 0 0.0) #())
+
+(test (let ((v (make-vector 3 0))) (set! (vector-ref v 1) 32) v) #(0 32 0))
+(test (let ((v (make-int-vector 3))) (set! (vector-ref v 1) 0) v) (make-int-vector 3 0))
+
+(for-each
+ (lambda (arg)
+   (test (vector-ref (make-vector 1 arg) 0) arg))
+ (list #\a 1 () (list 1) '(1 . 2) #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0)
+       3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1))))
+
+(test (make-vector) 'error)
+;(test (make-vector 1 #f #t) 'error)
+(test (make-vector 1 2 3) 'error)
+(test (make-vector most-positive-fixnum) 'error)
+(test (make-vector most-negative-fixnum) 'error)
+(test (make-vector '(2 -2)) 'error)
+(test (make-vector (list 2 -2 -3)) 'error)
+(test (make-vector (cons 2 3)) 'error)
+(test (make-vector '(2 3 . 4)) 'error)
+(test (make-vector '(2 (3))) 'error)
+(test (make-vector most-negative-fixnum) 'error)
+(test (make-vector 3 0 #f 1) 'error)
+(test (with-input-from-string "#0d()" read) 'error) ; in sbcl #0() -> #(), guile gives a confused error "too few elements", but #1() -> #()!
+(test (make-vector 0) #())
+(test (make-vector '(0)) #())
+(test (make-vector ()) 'error)                      ; see above (in sbcl (make-array '()) -> #0A0)
+(test (make-vector (list 8796093022208 8796093022208)) 'error)
+(test (make-vector (list 8796093022208 2)) 'error)
+(test (make-vector (list 8796093022208 -8796093022208)) 'error)
+
+(test (make-vector 3 1 byte?) #u(1 1 1))
+(test (make-vector 3 1 integer?) #i(1 1 1))
+(test (make-vector 3 1 float?) #r(1 1 1))
+(test (make-vector 3 1 #t) #(1 1 1))
+
+(test (make-vector 3 #\a byte?) 'error)
+(test (make-vector 3 256 byte?) 'error)
+(test (make-vector 3 1.5 integer?) 'error)
+(test (make-vector 3 1+i float?) 'error)
+
+(let ((fv (make-vector 3 1.0 float?)))
+  (test (vector-set! fv 0 1+i) 'error)
+  (test (set! (fv 0) #\a) 'error)
+  (copy #r(0 1 2) fv)
+  (test fv #r(0 1 2))
+  (test (sort! fv char<?) 'error)
+  (set! fv (sort! fv >))
+  (test fv #r(2 1 0))
+  (test (float-vector? fv) #t)
+  (float-vector-set! fv 0 32.0)
+  (test (float-vector-ref fv 0) 32.0)
+  (test (int-vector-ref fv 0) 'error))
+
+(test (make-float-vector 0 1.0) #r())
+(test (make-vector 0 1.0 float?) #r())
+(test (make-vector 0 1+i float?) 'error)
+(test (make-vector 0 1+i integer?) 'error)
+(test (make-vector 0 1+i byte?) 'error)
+(test (make-vector 0 1 cons) 'error)
+
+(test (make-vector 1 1.0 symbol?) 'error)
+(test (make-vector 1 'a symbol?) #(a))
+(test (signature (make-vector 1 'a symbol?)) (cons 'symbol? (cons 'vector? (let ((L (list 'integer?))) (set-cdr! L L)))))
+(test ((object->let (make-vector 1 'a symbol?)) 'signature) (signature (make-vector 1 'a symbol?)))
+(test (arity (make-vector '(2 3) 'a symbol?)) '(1 . 2))
+(test (arity (make-vector 0 'a symbol?)) #f)
+(test (equal? (make-vector 1 'a symbol?) (make-vector 1 'a symbol?)) #t)
+(test (equal? (make-vector 1 'a symbol?) (make-vector 1 1 number?)) #f)
+(test (equivalent? (make-vector 1 'a symbol?) (make-vector 1 1 number?)) #f)
+
+(let ((v (make-vector 1 'a symbol?)))
+  (let ((v1 (copy v)))
+    (test (vector-set! v1 0 123) 'error)
+    (test (set! (v1 0) 123) 'error)
+    (test (signature v1) (signature v)))
+  (let ((sv (subvector v 0 1)))
+    (test (vector-set! sv 0 123) 'error)
+    (test (set! (sv 0) 123) 'error)
+    (test (signature sv) (signature v))))
+
+(let-temporarily (((*s7* 'safety) 1))
+  (let ((v (make-vector 1 'a symbol?)))
+    (vector-set! v 0 'b)
+    (test (v 0) 'b)
+    (test (vector-set! v 0 1.5) 'error))
+  (let ((v (make-vector '(2 3) 'a symbol?)))
+    (vector-set! v 0 0 'b)
+    (test (v 0 0) 'b)
+    (test (vector-set! v 0 0 1.5) 'error))
+  (let ((v (make-vector 1 'a symbol?)))
+    (define (fv)
+      (vector-set! v 0 'b))
+    (fv)
+    (test (v 0) 'b)
+    (test (let () (define (fv1) (vector-set! v 0 1.5)) (fv1)) 'error)
+    (test (let () (define (fv2) (set! (v 0) 1.5)) (fv2)) 'error)
+    (test (let () (define (fv1) (vector-set! v 0 'c)) (fv1) v) #(c))
+    (test (let () (define (fv2) (set! (v 0) 'd)) (fv2) v) #(d))
+    (test (let () (define (fv1) (vector-set! v 0 1.5)) (fv1) (fv1) v) 'error)
+    (test (let () (define (fv2) (set! (v 0) 1.5)) (fv2) (fv2) v) 'error)
+    (test (let () (define (fv1) (vector-set! v 0 'c)) (fv1) (fv1) v) #(c))
+    (test (let () (define (fv2) (set! (v 0) 'd)) (fv2) (fv2) v) #(d)))
+
+  (for-each (lambda (typ arg)
+	      (catch #t
+		(lambda ()
+		  (make-vector 1 arg typ))
+		(lambda (type info)
+		  (format *stderr* ";(make-vector 1 ~S ~S): ~A~%" arg typ (apply format #f info)))))
+	    (list undefined? unspecified? eof-object? boolean? gensym? syntax? symbol? let?
+		  openlet? keyword? continuation? number? integer? byte? real? complex? rational? random-state?
+		  char? string? input-port? output-port? iterator? null? pair? list? byte-vector? float-vector?
+		  int-vector? subvector? vector? hash-table? weak-hash-table? procedure? macro? dilambda?
+		  sequence? float? proper-list?)
+	    (list #<undefined> #<unspecified> #<eof> #t (gensym) when 'a (inlet 'a 1)
+		  (openlet (inlet 'a 1)) :key (call/cc (lambda (r) r)) 1 1 1 1 1+i 1/2 (random-state 1234)
+		  #\a "a" (current-input-port) (current-output-port) (make-iterator '(1 2)) () '(1) '(1) #u(1) #r(1)
+		  #i(1) (subvector #(1) 0 1) #(1) (hash-table 'a 1) (make-weak-hash-table) abs quasiquote (dilambda (lambda () 1) (lambda (val) val))
+		  '(1) 1.0 '(1)))
+
+;;; also bignum?
+
+  (test (let ((v (make-vector 2 1 integer?))) (fill! v 3) v) #i(3 3))
+  (test (let ((v (make-vector 2 1 integer?))) (fill! v 1/3) v) 'error)
+  (test (let () (define (f) (vector-fill! (make-byte-vector 256 1) (string (integer->char 255)))) (f)) 'error)
+  (test (let ((v (make-vector 3 1 integer?))) (copy #(1 2 3) v) v) #i(1 2 3))
+  (test (let ((v (make-vector 3 1 integer?))) (copy #u(1 2 3) v) v) #i(1 2 3))
+  (test (let ((v (make-vector 3 1 integer?))) (copy #(1 1/2 3) v) v) 'error)
+
+  (test (let ((v (make-vector 2 'a symbol?))) (fill! v 3) v) 'error)
+  (test (let ((v (make-vector 2 'a symbol?))) (fill! v 'b) v) #(b b))
+  (test (let ((v (make-vector 3 'a symbol?))) (copy #(1 2 3) v) v) 'error)
+  (test (let ((v (make-vector 3 'a symbol?))) (copy #(a b c) v) v) #(a b c))
+  (test (let ((v (make-vector 3 'a symbol?))) (copy '(1 2 3) v) v) 'error)
+  (test (let ((v (make-vector 3 'a symbol?))) (copy '(a b c) v) v) #(a b c))
+  (test (let ((v (make-vector 3 'a symbol?))) (copy "123" v) v) 'error)
+  (test (let ((v (make-vector 3 'a symbol?))) (copy (hash-table 'a 1) v) v) 'error)
+  (test (let ((v (make-vector 3 'a symbol?))) (copy (inlet 'a 1) v) v) 'error)
+  (test (let ((v (make-vector 3 'a symbol?))) (copy () v) v) #(a a a)) ; ??
+  (test (let ((v (make-vector 3 'a symbol?))) (copy 1 v) v) 'error)
+  (test (let ((v (make-vector 3 'a symbol?))) (copy #u(1 2 3) v) v) 'error)
+  (test (let ((v (make-vector 3 'a symbol?))) (copy #i(1 2 3) v) v) 'error)
+  (test (let ((v (make-vector 3 'a symbol?))) (copy #r(1 2 3) v) v) 'error)
+
+  (test (let ((v (make-vector 3 1.0 real?))) (copy #r(2.0 3.0 1.0) v) (sort! v <) v) #(1.0 2.0 3.0))
+
+  (test (let ((v (vector 1 2 3))) (+ (let-temporarily (((v 0) 4)) (v 0)) (v 1))) 6)
+  (test (let ((v (make-vector 3 0 number?))) (copy #i(1 2 3) v) (+ (let-temporarily (((v 0) 4)) (v 0)) (v 1))) 6)
+  (test (let ((v (make-vector 3 0 number?))) (let-temporarily (((v 0) #\a)) (v 0))) 'error)
+  ) ; let-temp safety=1
+
+(let ((x (make-vector 1 #() vector?)))
+  (test (vector-set! x 0 #(1)) #(1))
+  (test (vector-ref x 0) #(1))
+  (test (vector-set! x 0 #i(1)) #i(1))
+  (test (vector-ref x 0) #i(1)))
+
+(when full-s7test
+  (catch #t (lambda () (make-vector 1001 '(1) hash-table?)) (lambda args 'error))
+  (gc)
+
+  (for-each
+   (lambda (typ1 arg1)
+     (for-each
+      (lambda (typ2 arg2)
+	(catch #t
+	  (lambda ()
+	    (let ((v1 (make-vector 1 arg1 typ1))
+		  (v2 (make-vector 1 arg2 typ2)))
+	      (if (and (equal? v1 v2)
+		       (not (equal? (v1 0) (v2 0))))
+		  (format *stderr* ";(equal? ~S ~S ~S ~S): #t?~%" arg1 typ1 arg2 typ2)
+		  (if (and (not (equal? v1 v2))
+			   (equal? (v1 0) (v2 0)))
+		      (format *stderr* ";(equal? ~S ~S ~S ~S): #f?~%" arg1 typ1 arg2 typ2)))
+	      (if (and (equivalent? v1 v2)
+		       (not (equivalent? (v1 0) (v2 0))))
+		  (format *stderr* ";(equivalent? ~S ~S ~S ~S): #t?~%" arg1 typ1 arg2 typ2)
+		  (if (and (not (equivalent? v1 v2))
+			   (equivalent? (v1 0) (v2 0)))
+		      (format *stderr* ";(equivalent? ~S ~S ~S ~S): #f?~%" arg1 typ1 arg2 typ2)))))
+	  (lambda (type info)
+	    (format *stderr* ";equal? ~S ~S ~S ~S: ~A~%" arg1 typ1 arg2 typ2 (apply format #f info)))))
+
+      (list undefined? unspecified? eof-object? boolean? gensym? syntax? symbol? let?
+	    openlet? keyword? continuation? number? integer? byte? float? real? complex? rational? random-state?
+	    char? string? input-port? output-port? iterator? null? pair? list? byte-vector? float-vector?
+	    int-vector? subvector? vector? hash-table? weak-hash-table? procedure? macro? dilambda?
+	    sequence? proper-list?)
+      (list #<undefined> #<unspecified> #<eof> #t (gensym) when 'a (inlet 'a 1)
+	    (openlet (inlet 'a 1)) :key (call/cc (lambda (r) r)) 1 1 1 1 1 1 1 (random-state 1234)
+	    #\a "a" (current-input-port) (current-output-port) (make-iterator '(1)) () '(1) '(1) #u(1) #r(1)
+	    #i(1) (subvector #(1) 0 1) #(1) (hash-table 'a 1) (make-weak-hash-table) abs quasiquote
+	    (dilambda (lambda () 1) (lambda (val) val)) '(1) '(1))))
+
+   (list undefined? unspecified? eof-object? boolean? gensym? syntax? symbol? let?
+	 openlet? keyword? continuation? number? integer? byte? float? real? complex? rational? random-state?
+	 char? string? input-port? output-port? iterator? null? pair? list? byte-vector? float-vector?
+	 int-vector? subvector? vector? hash-table? weak-hash-table? procedure? macro? dilambda?
+	 sequence? proper-list?)
+   (list #<undefined> #<unspecified> #<eof> #t (gensym) when 'a (inlet 'a 1)
+	 (openlet (inlet 'a 1)) :key (call/cc (lambda (r) r)) 1 1 1 1 1 1 1 (random-state 1234)
+	 #\a "a" (current-input-port) (current-output-port) (make-iterator '(1)) () '(1) '(1) #u(1) #r(1)
+	 #i(1) (subvector #(1) 0 1) #(1) (hash-table 'a 1) (make-weak-hash-table) abs quasiquote
+	 (dilambda (lambda () 1) (lambda (val) val)) '(1) '(1))))
+
+;; --------
+(for-each
+ (lambda (arg)
+   (test (make-vector arg) 'error)
+   (test (make-vector (list 2 arg)) 'error))
+ (list #\a () -1 #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1))))
+
+(test (eval-string "#2147483649D()") 'error)
+(test (type-of (eval-string "#-9223372036854775808D()")) 'error)
+(test (eval-string "#922D()") 'error)
+(test (eval-string "#(1 2 . 3)") 'error)
+(test (eval-string "#(1 2 . ())") #(1 2))
+(test (eval-string "#i(1 2 . 3)") 'error)
+(test (eval-string "#i(1 2 3+i)") 'error)
+(test (eval-string "#i(1 2 ())") 'error)
+(test (eval-string "#i(1 2 1.5)") 'error)
+(test (eval-string "#i(1 2 1.0)") 'error)
+(test (eval-string "#u(1 2 . 3)") 'error)
+(test (eval-string "#r(1.0 2.0 . 3.0)") 'error)
+(test (eval-string "#r(1.0 2.0 3.0+i)") 'error)
+(test (eval-string "#r(1.0 2.0 ())") 'error)
+(test (eval-string "#r(1 2)") (float-vector 1.0 2.0))
+(test (eval-string "#2d((1 2) (3 4) . 5)") 'error)
+(test (eval-string "#2d((1 2) (3 . 4))") 'error)
+(test (eval-string "#2d((1 2) (3 4 . ()))") #2d((1 2) (3 4)))
+(test (eval-string "#(1 2 . (3 4))") #(1 2 3 4))
+
+;;; subvector
+(test (let ((v1 #2d((1 2 3) (4 5 6)))) (let ((v2 (subvector v1 0 6 '(6)))) v2)) #(1 2 3 4 5 6))
+(test (let ((v1 #(1 2 3 4 5 6))) (let ((v2 (subvector v1 0 6 '(3 2)))) v2)) #2d((1 2) (3 4) (5 6)))
+(test (subvector #2d() 0 0 '(0)) #())
+(test (subvector '(1) 0 1 '(1)) 'error)
+(test (subvector #(1) '(2)) 'error)
+(test (subvector #(1) 0 2 '(1 2)) 'error)
+(test (subvector #(1 2 3 4) ()) 'error)
+(test (subvector #(1 2 3 4) 0 most-positive-fixnum) 'error)
+(test (subvector #(1 2 3 4) 0 most-negative-fixnum) 'error)
+(test (subvector #(1 2 3 4) 0 -1) 'error)
+(test (subvector #(1 2 3 4) 0 5) 'error)
+(test (subvector #(1 2 3 4) 0 0) #())
+(test (subvector #(1 2 3 4) 0 2 '(2)) #(1 2))
+(test (subvector #(1 2 3 4) 0 2 '(2 1)) #2d((1) (2)))
+(test (subvector #(1 2 3 4) 0 0 '(0)) #())
+(test (subvector #() 1) 'error)
+(test (subvector #() 0) #())
+(test (subvector #(1) 0 0) #())
+(let ((v #(1))) (test (subvector-vector (subvector v 0 0)) v))
+(test (subvector #(1) 1 2) 'error)
+(test (subvector (make-vector 3) 1 most-positive-fixnum) 'error)
+(test (subvector (make-vector 3) 1 4) 'error)
+(test (subvector (make-vector 3) 0 4) 'error)
+(test (subvector (make-vector 3) -1 2) 'error)
+(test (subvector (vector 1 2 3 4 5 6) 0 3 '(3 2)) 'error)
+(test (subvector (vector 1 2 3 4 5 6) 0 6 '(2 2)) 'error)
+
+(test (subvector (make-vector 2 1) 0 (bignum 2)) #(1 1))
+(test (subvector (make-vector (list 2 3) #f) 0 (bignum 3)) #(#f #f #f))
+
+(test (subvector) 'error)
+(for-each
+ (lambda (arg)
+   (test (subvector arg) 'error)
+   (test (subvector #(1 2 3) arg) 'error))
+ (list #\a () -1 #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t (lambda (a) (+ a 1))))
+
+(let ((v #2d((1 2) (3 4))))
+  (test (subvector v 0 2 '((1 2) (3 4))) 'error)
+  (test (subvector v 0 0 ()) 'error)
+  (test (subvector v 0 1 '(1.4)) 'error)
+  (test (subvector v 0 2 '(14 15)) 'error)
+  (test (subvector v 0 4 (list most-positive-fixnum)) 'error)
+  (test (subvector v 0 4 '(-1 0)) 'error)
+  (test (subvector v most-positive-fixnum '(1)) 'error))
+
+(let ((v (float-vector 0.0 1.0 2.0)))
+  (let ((v1 (subvector v 0 3 (list 1 3))))
+    (test (float-vector? v1) #t)
+    (test (equivalent? (v 0) (v1 0 0)) #t)))
+
+(let ((v (vector 0.0 1.0 2.0)))
+  (let ((v1 (subvector v 0 3 (list 1 3))))
+    (test (vector? v1) #t)
+    (test (equivalent? (v 0) (v1 0 0)) #t)))
+
+(let ((v (int-vector 0 1 2)))
+  (let ((v1 (subvector v 0 3 (list 1 3))))
+    (test (int-vector? v1) #t)
+    (test (equivalent? (v 0) (v1 0 0)) #t)))
+
+(let ((v (byte-vector 0 1 2)))
+  (let ((v1 (subvector v 0 3 (list 1 3))))
+    (test (byte-vector? v1) #t)
+    (test (equivalent? (v 0) (v1 0 0)) #t)))
+
+(let ((v (make-int-vector 3)))
+  (set! (v 1) 1)
+  (set! (v 2) 2)
+  (let ((v1 (subvector v 0 3 (list 1 3))))
+    (test (float-vector? v1) #f)
+    (test (int-vector? v1) #t)
+    (test (integer? (v1 0 2)) #t)
+    (test (= (v 2) (v1 0 2)) #t)))
+
+(let ((v (vector 0 1 2 3 4 5 6 7 8)))
+  (test (subvector v 1 7 (list 3 2)) #2d((1 2) (3 4) (5 6)))
+  (test (subvector v 2 8 (list 3 2)) #2d((2 3) (4 5) (6 7)))
+  (test (subvector v 2 5 (list 3)) #(2 3 4))
+  (test (subvector v 0 3 (list 3)) (subvector v 0 3 (list 3)))
+  (test (subvector v -1 3 (list 3)) 'error)
+  (test (subvector v 10 3 (list 3)) 'error)
+  (test (subvector v 3.2 3 (list 3)) 'error)
+  (test (subvector v "0" 3 (list 3)) 'error)
+  )
+
+(test (subvector #() 1) 'error)
+(test (subvector #() 0 1) 'error)
+(test (subvector #(1) 1 2) 'error)
+(test (subvector #(1) 0 1) #(1))
+
+(let ((a (vector 1 2 3))
+      (b (vector 4 5 6)))
+  (test (subvector (append a b) 0 6 '(2 3)) #2d((1 2 3) (4 5 6))))
+
+(let ((a #2d((1 2) (3 4)))
+      (b #2d((5 6) (7 8))))
+  (test (subvector (append a b) 0 8 '(2 4))                     #2d((1 2 3 4) (5 6 7 8)))
+  (test (subvector (append a b) 0 8 '(4 2))                     #2d((1 2) (3 4) (5 6) (7 8)))
+  (test (subvector (append (a 0) (b 0) (a 1) (b 1)) 0 8 '(2 4)) #2d((1 2 5 6) (3 4 7 8)))
+  (test (subvector (append (a 0) (b 0) (a 1) (b 1)) 0 8 '(4 2)) #2d((1 2) (5 6) (3 4) (7 8))))
+
+(test (subvector (subvector (float-vector 1.0 2.0 3.0 4.0) 0 4 '(2 2)) 0 0 '(0)) #())
+(test (subvector (subvector (float-vector 1.0 2.0 3.0 4.0) 0 4 '(2 2)) 0 1 '(1)) (float-vector 1.0))
+(test ((subvector (subvector (float-vector 1.0 2.0 3.0 4.0) 0 4 '(2 2)) 0 4 '(4 1)) 2 0) 3.0)
+
+(let ((v (subvector (float-vector 1 2 3) 0 3)))
+  (test (copy v) (subvector (float-vector 1 2 3) 0 3))
+  (test (length v) 3)
+  (test (reverse v) (float-vector 3 2 1))
+  (test v #r(1 2 3))
+  (set! v (reverse! v))
+  (test v #r(3 2 1)))
+
+(let () (define (f) (let* ((fv #r(1 2 3 4 5)) (sv (subvector fv 1 5))) fv)) (f) (f)) ; unheap transfer bug
+
+;;; subvector?
+(let ((v (vector 0 1 2 3 4 5 6 7 8)))
+  (test (subvector? (subvector v 1 3)) #t)
+  (test (subvector? v) #f))
+(for-each
+ (lambda (arg)
+   (test (subvector? arg) #f)
+   (test (subvector-position arg) 'error)
+   (test (subvector-vector arg) 'error))
+ (list #\a () -1 #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1))))
+(test (subvector?) 'error)
+(test (subvector? (subvector-vector (subvector #(1) 0 1))) #f)
+(test (vector? (subvector-vector (subvector #(1) 0 1))) #t)
+
+;;; subvector-position
+(let ((v (vector 0 1 2 3 4 5 6 7 8)))
+  (test (subvector-position (subvector v 1 3)) 1)
+  (test (subvector-position (subvector v 0 1)) 0)
+  (test (subvector-position (subvector v 1 5 '(2 2))) 1))
+
+(let ((b (make-byte-vector '(2 3))))
+  (do ((i 0 (+ i 1)))
+      ((= i 2))
+    (do ((j 0 (+ j 1)))
+	((= j 3))
+      (set! (b i j) (+ (* i 3) j))))
+  (test b #u2d((0 1 2) (3 4 5)))
+  (let ((b1 (byte-vector-ref b 1)))
+    (test b1 #u(3 4 5))
+    (test (subvector? b1) #t)
+    (test (subvector-vector b1) b)
+    (test (subvector-position (byte-vector-ref b 0)) 0)
+    (test (subvector-position b1) 3)))
+
+(test (subvector-position (vector-ref #2d((1 2 3) (4 5 6)) 1)) 3)
+(test (subvector-position (float-vector-ref #r2d((1 2 3) (4 5 6)) 1)) 3)
+(test (subvector-position (int-vector-ref #i2d((1 2 3) (4 5 6)) 1)) 3)
+
+(test (subvector-position v) 'error)
+(test (subvector-position) 'error)
+(test (subvector-position (subvector #(1 2 3) 1 2)) 1) ; 2 = new dims, 1 = offset
+(test (subvector-position (subvector #(0 1 2 3) 2 3)) 2)
+(test (subvector-position (subvector #r(0 1 2 3) 2 2)) 2)
+(test (subvector-position (subvector #i(0 1 2 3) 2 3)) 2)
+(test (subvector-position (subvector #u(0 1 2 3) 2 3)) 2)
+(test (subvector-position (subvector #2d() 0)) 0)
+(test (subvector-position (subvector #u() 0)) 0)
+
+;;; subvector-vector
+(let ((v (vector 0 1 2 3 4 5 6 7 8)))
+  (test (subvector-vector (subvector v 0 2)) v)
+  (test (subvector-vector v) 'error))
+(let ((v (int-vector 0 1 2 3 4 5 6 7 8))) (test (subvector-vector (subvector v 0 2)) v))
+(let ((v (float-vector 0 1 2 3 4 5 6 7 8))) (test (subvector-vector (subvector v 0 2)) v))
+(let ((v (byte-vector 0 1 2 3 4 5 6 7 8))) (test (subvector-vector (subvector v 0 2)) v))
+(let ((v (subvector #u() 0))) (test (subvector-vector v) #u()))
+
+(let ((v #(3 1 2 4 0)))
+  (sort! (subvector v 2 5) <)
+  (test v #(3 1 0 2 4)))
+
+(when full-s7test
+  ;; this hits a gc mark bug (now fixed)
+  (let ((v (subvector (make-int-vector '(2 3)) 0 6))) (gc) (gc) (object->let v)))
+
+
+
+;;; --------
+(let-temporarily (((*s7* 'print-length) 123123123))
+  (test (object->string (make-vector 2048 #f)) "(make-vector 2048 #f)")
+  (test (object->string (make-vector '(12 2048) #<unspecified>)) "(make-vector '(12 2048) #<unspecified>)")
+  (test (object->string (make-float-vector 2048 1.0)) "(make-float-vector 2048 1)")
+  (test (object->string (make-int-vector 2048 32)) "(make-int-vector 2048 32)")
+  (test (object->string (make-int-vector '(12 2048) 2)) "(make-int-vector '(12 2048) 2)")
+  (test (object->string (make-string 20000 #\space)) "(make-string 20000 #\\space)")
+  (test (object->string (make-byte-vector 2000 12)) "(make-byte-vector 2000 12)"))
+
+(when with-bignums
+  (let ((v (float-vector (bignum "1.0") (bignum "2.0"))))
+    (test (float-vector? v) #t)
+    (test (v 0) 1.0)))
+
+(test (vector? (float-vector)) #t)
+(test (vector? (int-vector)) #t)
+(when with-block (test (float-vector? _c_obj_) #t))
+(test (float-vector? 1 2) 'error)
+(test (float-vector?) 'error)
+(test (int-vector? 1 2) 'error)
+(test (int-vector?) 'error)
+(for-each
+ (lambda (arg)
+   (if (float-vector? arg) (format *stderr* ";~A is a float-vector?~%" arg))
+   (test (float-vector arg) 'error)
+   (if (int-vector? arg) (format *stderr* ";~A is an int-vector?~%" arg))
+   (test (int-vector arg) 'error))
+ (list #\a () #f "hi" 'a-symbol abs _ht_ _undef_ _null_ quasiquote macroexpand #() #t (vector 1 2 3) (lambda (a) (+ a 1))))
+
+
+;;; make-float-vector
+(test (float-vector? (make-float-vector 3)) #t)
+(test (float-vector? (make-float-vector 3 pi)) #t)
+(test ((make-float-vector 3) 1) 0.0)
+(test (float-vector? (float-vector)) #t)
+(test (float-vector? (make-float-vector 0)) #t)
+(test (float-vector? (int-vector)) #f)
+(test (equal? (float-vector) (int-vector)) #t)
+(test (equal? (vector) (int-vector)) #t)
+
+(test (equal? (make-float-vector 3 1.0) (float-vector 1.0 1.0 1.0)) #t)
+(test (equal? (make-float-vector 3 1/2) (float-vector 0.5 0.5 0.5)) #t)
+(test ((make-float-vector '(2 3) 2.0) 1 2) 2.0)
+(test (nan? ((make-float-vector 3 1/0) 0)) #t)
+(for-each
+ (lambda (arg)
+   (test (make-float-vector arg) 'error)
+   (test (make-float-vector 3 arg) 'error))
+ (list #\a () #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0) 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1))))
+(test (equal? (vector) (float-vector)) #t)
+(test (float-vector? (make-float-vector 3 0)) #t)
+(test (float-vector? (make-float-vector 3 1/2)) #t)
+(test (float-vector? #r(1.0)) #t)
+(let ((v (make-vector 1 2.0 float?)))
+  (test (float-vector? v) #t)
+  (test (float-vector-ref v 0) 2.0))
+(test (make-float-vector -12) 'error)
+(test (make-float-vector -12 1.0) 'error)
+(test (make-float-vector 4294967298) 'error)
+(test (make-float-vector 4294967298 1.0) 'error)
+(unless with-bignums
+  (test (s7-optimize '((float-vector-ref (make-float-vector 4294967298 1.0) 0))) 'error) ; try to hit make_float_vector_p_pp
+  (test (s7-optimize '((float-vector-ref (make-float-vector -8 1.0) 0))) 'error))
+
+;; from tvect for op_let_3a_old(!)
+(define (tvmax+loc vect) ; has to be global to hit the code
+  (let ((len (length vect))
+	(mx 0.0)
+	(loc 0))
+    (do ((i 0 (+ i 1)))
+	((= i len)
+	 (list mx loc))
+      (when (> (abs (vect i)) mx)
+	(set! mx (vect i))
+	(set! loc i)))))
+(define (tvf111)
+  (let ((v (make-int-vector 1))
+	(a #f))
+    (set! (v 0) 1)
+    (tvmax+loc v)
+    (do ((i 0 (+ i 1))) ((= i 1)) (set! a (tvmax+loc v)))
+    (test a '(1 0))))
+(tvf111)
+
+(let () ; thash for float_vector_p_d
+  (define (f size)
+    (let ((vct-hash (make-hash-table size equal?)))
+      (do ((i 0 (+ i 1)))
+	  ((= i size))
+        (hash-table-set! vct-hash (float-vector i) i))
+      (do ((i 0 (+ i 1)))
+	  ((= i size))
+        (unless (= (hash-table-ref vct-hash (float-vector i)) i)
+	  (display "oops")))
+      (set! vct-hash #f)))
+  (f 8))
+
+;;; make-int-vector
+(test (int-vector? (make-int-vector 3)) #t)
+(test (int-vector? (make-int-vector 3 2)) #t)
+(test ((make-int-vector 3) 1) 0)
+(test (int-vector? (int-vector)) #t)
+(test (int-vector? (make-int-vector 0)) #t)
+(test (int-vector? (float-vector)) #f)
+(test (int-vector? (vector)) #f)
+(test (int-vector? #i(1)) #t)
+(unless with-bignums
+  (let ((v (make-vector 1 2 integer?))) ; this is big-integer in gmp case
+    (test (int-vector? v) #t)
+    (test (int-vector-ref v 0) 2)))
+(when with-bignums
+  (let ((v (make-int-vector (bignum "1"))))
+    (test (int-vector? v) #t)
+    (test (length v) 1)
+    (test (make-int-vector 3 (bignum "1")) #i(1 1 1))
+    (test (make-int-vector (bignum "3") 1) #i(1 1 1))
+    (test (make-int-vector (bignum "3") (bignum "1")) #i(1 1 1))
+    (test (make-float-vector (bignum "2") 1.0) #r(1.0 1.0))
+    (test (make-float-vector 3 (bignum "1.0")) #r(1.0 1.0 1.0))
+    (test (make-float-vector (bignum "3") 1.0) #r(1.0 1.0 1.0))
+    (test (make-float-vector (bignum "3") (bignum "1.0")) #r(1.0 1.0 1.0))
+    (test (make-byte-vector 3 (bignum "1")) #u(1 1 1))
+    (test (make-byte-vector (bignum "3") 1) #u(1 1 1))
+    (test (make-byte-vector (bignum "3") (bignum "1")) #u(1 1 1))
+    (set! v (make-byte-vector 3))
+    (fill! v (bignum "1"))))
+
+(test ((lambda () (make-vector (call-with-exit (lambda (return) (let ((x 1) (y 2)) (return x y)))) (vector? (make-float-vector '(2 3) 1))))) #(2))
+(when with-block
+  (test ((lambda () (list (call-with-exit (lambda (return) (let ((x 1) (y 2)) (return x y)))) (append (block) (block))))) (list 1 2 (block))))
+
+(test (equal? (make-int-vector 3 1) (int-vector 1 1 1)) #t)
+(test ((make-int-vector '(2 3) 2) 1 2) 2)
+
+(test (make-int-vector -3) 'error)
+(test (make-float-vector -3) 'error)
+(test (make-vector -3) 'error)
+(test (make-byte-vector -3) 'error)
+(test (make-vector (list 1 pi)) 'error)
+(test (eval-string "#r2d((1 2) (3 #\\a))") 'error)
+(test (eval-string "#i2d((1 2) (3 #\\a))") 'error)
+(let ((v (make-vector 1 2 byte?)))
+  (test (byte-vector? v) #t)
+  (test (byte-vector-ref v 0) 2))
+(test (make-int-vector 1 integer?) 'error)
+(test (make-int-vector 1 0 integer?) 'error)
+(test (make-int-vector -12) 'error)
+(test (make-int-vector -12 1.0) 'error)
+(test (make-int-vector 4294967298) 'error)
+(test (make-int-vector 4294967298 1.0) 'error)
+(unless with-bignums
+  (test (s7-optimize '((int-vector-ref (make-int-vector 4294967298 1.0) 0))) 'error)
+  (test (s7-optimize '((int-vector-ref (make-int-vector -8 1.0) 0))) 'error))
+
+(for-each
+ (lambda (arg)
+   (test (make-int-vector arg) 'error)
+   (test (make-int-vector 3 arg) 'error))
+ (list #\a () #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0) 1.0+1.0i 1/2 pi #t (vector 1 2 3) (lambda (a) (+ a 1))))
+(test (equal? (vector) (int-vector)) #t)
+
+(test (catch #t
+	(lambda () (make-float-vector 3.0))
+	(lambda args
+	  (let ((type (car args))
+		(errmsg (apply format #f (cadr args))))
+	    (list type errmsg))))
+      '(wrong-type-arg "make-float-vector first argument, 3.0, is a real but should be an integer or a list of integers"))
+
+(test (catch #t
+	(lambda () (make-int-vector 3.0))
+	(lambda args
+	  (let ((type (car args))
+		(errmsg (apply format #f (cadr args))))
+	    (list type errmsg))))
+      '(wrong-type-arg "make-int-vector first argument, 3.0, is a real but should be an integer or a list of integers"))
+
+(test (catch #t
+	(lambda () (make-vector 3.0))
+	(lambda args
+	  (let ((type (car args))
+		(errmsg (apply format #f (cadr args))))
+	    (list type errmsg))))
+      '(wrong-type-arg "make-vector first argument, 3.0, is a real but should be an integer or a list of integers"))
+
+(test (eval-string "#(0 1 . 2)") 'error)
+(test (eval-string "#r(0 1 . 2)") 'error)
+(test (eval-string "#i(0 1 . 2)") 'error)
+
+;;; float-vector-ref
+;;; float-vector-set!
+
+(test (float-vector-ref (float-vector 1.0 2.0) 1) 2.0)
+(for-each
+ (lambda (arg)
+   (test (float-vector-ref arg 0) 'error)
+   (test (float-vector-ref (float-vector 1.0) arg) 'error))
+ (list #\a () #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0) 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1))))
+(let ((v (make-float-vector (list 2 3) 1.0))
+      (v1 (make-float-vector 3)))
+  (set! (v 1 1) 2.0)
+  (test (v 1 1) 2.0)
+  (test (v 0 1) 1.0)
+  (test (float-vector-ref v 1 1) 2.0)
+  (test (float-vector-ref #r2d((1 2) (3 4)) 1 1) 4.0)
+  (test (float-vector-ref v 0) (float-vector 1.0 1.0 1.0))
+  (test (float-vector-set! v 0 0 3.0) 3.0)
+  (test (float-vector-ref v 0 0) 3.0)
+  (test (float-vector-ref v1 3) 'error)
+  (test (float-vector-ref v 1 3) 'error)
+  (test (float-vector-ref v 2 2) 'error)
+  (test (float-vector-ref v1 most-positive-fixnum) 'error)
+  (test (float-vector-ref v1 most-negative-fixnum) 'error)
+  (test (float-vector-set! v1 3 0.0) 'error)
+  (test (float-vector-set! v 1 3 0.0) 'error)
+  (test (float-vector-set! v 2 2 0.0) 'error)
+  (test (float-vector-set! v1 most-positive-fixnum 0.0) 'error)
+  (test (float-vector-set! v1 most-negative-fixnum 0.0) 'error)
+  (test (float-vector-set! v1 0 0+i) 'error)
+  (for-each
+   (lambda (arg)
+     (test (float-vector-ref v 0 arg) 'error)
+     (test (float-vector-set! arg 0 1.0) 'error)
+     (test (float-vector-set! v1 arg) 'error)
+     (test (float-vector-set! v1 0 arg) 'error)
+     (test (float-vector-set! v 0 arg 1.0) 'error))
+   (list #\a () #f "hi" 1+i 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand #t (vector 1 2 3) (lambda (a) (+ a 1))))
+  (test (float-vector-ref v) 'error)
+  (test (float-vector-set! v) 'error)
+  (test (float-vector-ref v1 0 1) 'error)
+  (test (float-vector-ref v 0 1 0) 'error)
+  (test (float-vector-ref v1 -1) 'error)
+  (float-vector-set! v1 0 2/5)
+  (test (float-vector-ref v1 0) 0.4)
+  (test (float-vector-set! v1 1 4.0) 4.0)
+  (test (float-vector-ref v1 1) 4.0)
+  (test (float-vector-ref v 3 0) 'error)
+  (test (float-vector-ref v 1 3) 'error)
+  (test (fill! v 0.0) 0.0))
+(test (float-vector-ref (float-vector) 0) 'error)
+(let ((v (float-vector 1 2 3)))
+  (set! (float-vector-ref v 1) 32)
+  (test v (float-vector 1 32 3))
+  (set! (v 0) 64)
+  (test v (float-vector 64 32 3))
+  (test (float-vector-set! v 2 (float-vector-set! v 1 0.0)) 0.0)
+  (test v (float-vector 64 0 0)))
+(let ((v0 (make-float-vector '(3 0)))
+      (v1 (make-float-vector '(0 3)))
+      (v2 (make-float-vector '(2 3)))
+      (v3 (make-float-vector '(1 3)))
+      (v4 (make-float-vector '(3 1))))
+  (test (float-vector? v0) #t)
+  (test (float-vector-ref v0 0 0) 'error)
+  (test (vector? v0) #t)
+  (test (vector-ref v0 0 0) 'error)
+  (test (v0 0 0) 'error)
+  (test (float-vector? v1) #t)
+  (test (float-vector-ref v1 0 0) 'error)
+  (test (vector? v1) #t)
+  (test (vector-ref v1 0 0) 'error)
+  (test (v1 0 0) 'error)
+  (test (equal? v0 v1) #f)
+  (test (float-vector? (float-vector-ref v2 1)) #t)
+  (test (float-vector-set! v2 1 32.0) 'error)
+  (test (float-vector-set! (float-vector-ref v2 1) 1 32.0) 32.0)
+  (test (float-vector-ref v2 1 1) 32.0)
+  (test (float-vector-ref v3 0) (float-vector 0 0 0))
+  (test (float-vector-ref v4 0) (float-vector 0))
+  )
+(let ()
+  (define (hi) (let ((v2 (make-float-vector '(2 3)))) (float-vector-set! v2 1 12.0) v2))
+  (test (hi) 'error))
+
+(let ()
+  (define (f1) ; opt_d_7piid_sfff
+    (let ((fv (make-float-vector '(2 3))))
+      (do ((i 0 (+ i 1)))
+	  ((= i 2) fv)
+        (float-vector-set! fv (+ i 0) (+ i 1) (* 2.0 3.0)))))
+  (test (f1) #r2d((0.0 6.0 0.0) (0.0 0.0 6.0)))
+
+  (define (f2) ; opt_d_7pii_sff
+    (let ((iv (make-float-vector '(2 3) 1.0))
+   	  (sum 0.0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 2) sum)
+        (set! sum (+ sum (iv (- (+ i 1) 1) (+ i 1)))))))
+  (test (f2) 2.0)
+
+  (define (f3) ; opt_d_7pii_sff
+    (let ((iv (make-float-vector '(2 3) 1.0))
+  	  (sum 0.0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 2) sum)
+        (set! sum (+ sum (float-vector-ref iv (- (+ i 1) 1) (+ i 1)))))))
+  (test (f3) 2.0))
+
+(let () ; regression test for optimizer safe_c_opcq_opcq bug
+  (define (fx n x y)
+    (make-float-vector (if x (+ n 1) n)
+		       (if y 0 (/ pi 2))))
+  (test (equivalent? (fx 3 #f #f) (make-float-vector 3 (/ pi 2))) #t)
+  (test (equivalent? (fx 3 #f #t) (make-float-vector 3)) #t)
+  (test (equivalent? (fx 3 #t #f) (make-float-vector 4 (/ pi 2))) #t)
+  (test (equivalent? (fx 3 #t #t) (make-float-vector 4)) #t)
+
+  (define (fx1 n x y)
+    (make-float-vector (if x (+ n 1) (- n 1))
+		       (if y (* pi 2) (/ pi 2))))
+  (test (equivalent? (fx1 3 #f #f) (make-float-vector 2 (/ pi 2))) #t)
+  (test (equivalent? (fx1 3 #f #t) (make-float-vector 2 (* pi 2))) #t)
+  (test (equivalent? (fx1 3 #t #f) (make-float-vector 4 (/ pi 2))) #t)
+  (test (equivalent? (fx1 3 #t #t) (make-float-vector 4 (* pi 2))) #t)
+
+  (define (fx2 n x y)
+    (make-float-vector (if x (+ n 1) n)
+		       (if y (* pi 2) 0.0)))
+  (test (equivalent? (fx2 3 #f #f) (make-float-vector 3)) #t)
+  (test (equivalent? (fx2 3 #f #t) (make-float-vector 3 (* pi 2))) #t)
+  (test (equivalent? (fx2 3 #t #f) (make-float-vector 4)) #t)
+  (test (equivalent? (fx2 3 #t #t) (make-float-vector 4 (* pi 2))) #t)
+
+  (define (fx3 n y) ; same for safe_c_opssq_opcq
+    (make-float-vector (+ n n)
+		       (if y 0.0 (/ pi 2))))
+  (test (equivalent? (fx3 3 #f) (make-float-vector 6 (/ pi 2))) #t)
+  (test (equivalent? (fx3 3 #t) (make-float-vector 6)) #t)
+
+  (let ((v (make-float-vector 6))) (test (equivalent? (fx3 3 #t) v) #t))
+  )
+
+(let ((fv (make-float-vector 10))
+      (ten 10))
+  (define (fvf)
+    (do ((i 0 (+ i 1)))
+	((= i ten))
+      (float-vector-set! fv i 1.0)))
+  (fvf)
+  (test fv #r(1 1 1 1 1 1 1 1 1 1))
+  (define (fzf)
+    (do ((i 3 (+ i 1)))
+	((= i 8))
+      (float-vector-set! fv i 0)))
+  (fzf)
+  (test fv #r(1 1 1 0 0 0 0 0 1 1)))
+
+(let () ; optimizer type check
+  (define (f1)
+    (let ((v (float-vector 1 2 3))
+	  (s "asdf"))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) v)
+	(float-vector-set! v i 123)
+	(set! v s))))
+  (test (f1) 'error)
+
+  (define (f2)
+    (let ((v (float-vector 1 2 3)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) v)
+	(float-vector-set! v i 123)
+	(set! v "asdf"))))
+  (test (f2) 'error)
+
+  (define (f3)
+    (let ((v (float-vector 1 2 3)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) v)
+	(float-vector-set! v i 123)
+	(set! v (substring "asdfg" 0 4)))))
+  (test (f3) 'error))
+
+(let ((rv #r(.0 ; a comment
+	     +inf.0 #| another |# 1e5 #xa.a)))
+  (test (equivalent? rv (float-vector 0.0 +inf.0 100000.0 10.625)) #t))
+(let ((iv #i(9223372036854775807 -0 0000)))
+  (test iv (int-vector most-positive-fixnum 0 0)))
+
+(let ((fv (float-vector 0 1)))
+  (test (float-vector-ref fv 0 0) 'error)
+  (test (vector-ref fv 0 0) 'error)
+  (test (fv 0 0) 'error))
+(let ((fv #r2d((1 2) (3 4))))
+  (test (float-vector-ref fv 0 0 0) 'error)
+  (test (float-vector-ref fv 0 0 0 0) 'error)
+  (test (vector-ref fv 0 0 0) 'error)
+  (test (fv 0 0 0) 'error))
+
+(let ()
+  (define (h14)
+    (let ((v (make-float-vector (list 10 10)))
+	  (v1 (make-vector 10)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 10) v1)
+	(vector-set! v1 0 (float-vector-set! v 0 0 2.0))))) ; cell_optimize d_7piid d_to_p fixup */
+  (let ((v (h14))) (test (v 0) 2.0)))
+
+
+(test (let ((v #r(1 2 3)) (tf9 set!)) (define (func) (catch #t (lambda () (tf9 (v) #r())) (lambda (type info) 'error))) (func) (func)) 'error)
+(test (let ((v #i(1 2 3)) (tf9 set!)) (define (func) (catch #t (lambda () (tf9 (v) #i())) (lambda (type info) 'error))) (func) (func)) 'error)
+
+(unless with-bignums
+  (test (let ((alias float-vector-ref)) (s7-optimize (list (list 'alias (list 'hash-table) 'x)))) #<undefined>))
+
+
+;;; int-vector-ref
+;;; int-vector-set!
+
+(test (int-vector-ref (int-vector 1 2) 1) 2)
+(for-each
+ (lambda (arg)
+   (test (int-vector-ref arg 0) 'error)
+   (test (int-vector-ref (int-vector 1) arg) 'error))
+ (list #\a () #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0) 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1))))
+(let ((v (make-int-vector (list 2 3) 1))
+      (v1 (make-int-vector 3)))
+  (set! (v 1 1) 2)
+  (test (v 1 1) 2)
+  (test (v 0 1) 1)
+  (test (int-vector-ref v 1 1) 2)
+  (test (int-vector-ref #i2d((1 2) (3 4)) 1 1) 4)
+  (test (int-vector-ref v 0) (int-vector 1 1 1))
+  (test (int-vector-set! v 0 0 3) 3)
+  (test (int-vector-ref v 0 0) 3)
+  (test (int-vector-ref v1 3) 'error)
+  (test (int-vector-ref v 1 3) 'error)
+  (test (int-vector-ref v 2 2) 'error)
+  (test (int-vector-ref v1 most-positive-fixnum) 'error)
+  (test (int-vector-ref v1 most-negative-fixnum) 'error)
+  (test (int-vector-set! v1 3 0) 'error)
+  (test (int-vector-set! v 1 3 0) 'error)
+  (test (int-vector-set! v 2 2 0) 'error)
+  (test (int-vector-set! v1 most-positive-fixnum 0) 'error)
+  (test (int-vector-set! v1 most-negative-fixnum 0) 'error)
+  (test (int-vector-set! v1 0 0+i) 'error)
+  (for-each
+   (lambda (arg)
+     (test (int-vector-ref v 0 arg) 'error)
+     (test (int-vector-set! arg 0 1) 'error)
+     (test (int-vector-set! v1 arg) 'error)
+     (test (int-vector-set! v1 0 arg) 'error)
+     (test (int-vector-set! v 0 arg 1) 'error))
+   (list #\a () #f "hi" 1+i 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand #t (vector 1 2 3) (lambda (a) (+ a 1))))
+  (test (int-vector-ref v) 'error)
+  (test (int-vector-set! v) 'error)
+  (test (int-vector-ref v1 0 1) 'error)
+  (test (int-vector-ref v 0 1 0) 'error)
+  (test (int-vector-ref v1 -1) 'error)
+  (int-vector-set! v1 0 2)
+  (test (int-vector-ref v1 0) 2)
+  (test (int-vector-set! v1 1 4) 4)
+  (test (int-vector-ref v1 1) 4)
+  (test (int-vector-ref v 3 0) 'error)
+  (test (int-vector-ref v 1 3) 'error)
+  (test (fill! v 0) 0))
+(test (int-vector-ref (int-vector) 0) 'error)
+(let ((v (int-vector 1 2 3)))
+  (set! (int-vector-ref v 1) 32)
+  (test v (int-vector 1 32 3))
+  (set! (v 0) 64)
+  (test v (int-vector 64 32 3))
+  (test (int-vector-set! v 2 (int-vector-set! v 1 0)) 0)
+  (test v (int-vector 64 0 0)))
+(let ((v0 (make-int-vector '(3 0)))
+      (v1 (make-int-vector '(0 3)))
+      (v2 (make-int-vector '(2 3)))
+      (v3 (make-int-vector '(1 3)))
+      (v4 (make-int-vector '(3 1))))
+  (test (int-vector? v0) #t)
+  (test (int-vector-ref v0 0 0) 'error)
+  (test (vector? v0) #t)
+  (test (vector-ref v0 0 0) 'error)
+  (test (v0 0 0) 'error)
+  (test (int-vector? v1) #t)
+  (test (int-vector-ref v1 0 0) 'error)
+  (test (vector? v1) #t)
+  (test (vector-ref v1 0 0) 'error)
+  (test (v1 0 0) 'error)
+  (test (equal? v0 v1) #f)
+  (test (int-vector? (int-vector-ref v2 1)) #t)
+  (test (int-vector-set! v2 1 32) 'error)
+  (test (int-vector-set! (int-vector-ref v2 1) 1 32) 32)
+  (test (int-vector-ref v2 1 1) 32)
+  (test (int-vector-ref v3 0) (int-vector 0 0 0))
+  (test (int-vector-ref v4 0) (int-vector 0))
+  )
+(let ((fv (int-vector 0 1)))
+  (test (int-vector-ref fv 0 0) 'error)
+  (test (vector-ref fv 0 0) 'error)
+  (test (fv 0 0) 'error))
+(let ((fv #i2d((1 2) (3 4))))
+  (test (int-vector-ref fv 0 0 0) 'error)
+  (test (int-vector-ref fv 0 0 0 0) 'error)
+  (test (vector-ref fv 0 0 0) 'error)
+  (test (fv 0 0 0) 'error))
+(let ()
+  (define (hi) (let ((v2 (make-int-vector '(2 3)))) (int-vector-set! v2 1 12) v2))
+  (test (hi) 'error))
+
+(let ()
+  (define (f1)
+    (let ((x (float-vector 0.0)))
+      (set! (x 0) (complex 1 2))))
+  (test (let ((x (float-vector 0.0))) (set! (x 0) 1+i)) 'error)
+  (test (f1) 'error)
+
+  (define (f2)
+    (let ((x (int-vector 0)))
+      (int-vector-set! x 0 (complex 1 2))))
+  (test (let ((x (int-vector 0))) (set! (x 0) 0+i)) 'error)
+  (test (f2) 'error)
+
+  (define (f3)
+    (let ((x (float-vector 0.0)))
+      (float-vector-set! x 0 (complex 1 2))))
+  (test (f3) 'error)
+
+  (define (f4)
+    (let ((x (int-vector 0)))
+      (set! (x 0) (complex 1 2))))
+  (test (f4) 'error))
+
+(when with-bignums
+  (test (int-vector 1 (bignum "2")) #i(1 2))
+  (test (float-vector 1.0 (bignum "2.0")) #r(1.0 2.0)))
+
+(let ((iv (make-int-vector 10))
+      (ten 10))
+  (define (ivf)
+    (do ((i 0 (+ i 1)))
+	((= i ten))
+      (int-vector-set! iv i 1)))
+  (ivf)
+  (test iv #i(1 1 1 1 1 1 1 1 1 1))
+  (define (izf)
+    (do ((i 3 (+ i 1)))
+	((= i 8))
+      (int-vector-set! iv i 0)))
+  (izf)
+  (test iv #i(1 1 1 0 0 0 0 0 1 1)))
+
+(let ()
+  (define (f) ; opt_i_7pii_sff
+    (let ((iv (make-int-vector '(2 3) 1))
+	  (sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 2) sum)
+        (set! sum (+ sum (iv (- (+ i 1) 1) (+ i 1)))))))
+  (test (f) 2)
+
+  (define (g) ; opt_i_7pii_sff
+    (let ((iv (make-byte-vector '(2 3) 1))
+  	(sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 2) sum)
+        (set! sum (+ sum (iv (- (+ i 1) 1) (+ i 1)))))))
+  (test (g) 2))
+
+(let ()
+  (define (f1) ; vector_length_i_7p
+    (let ((v (vector (vector 1) (vector 2 3) (vector 4 5 6)))
+	  (sum 0)
+	  (size 3))
+      (do ((i 0 (+ i 1)))
+	  ((= i size) sum)
+	(set! sum (+ sum (vector-length (vector-ref v i)))))))
+  (test (f1) 6))
+
+(let ((iv (make-int-vector (list 2 3) 1)) ; optimizer bug
+      (c 3))
+  (define (f1) (let ((v (vector #f))) (do ((i 0 (+ i 1))) ((= i 1) (vector-ref v 0)) (vector-set! v 0 (int-vector-set! iv 0 0 c)))))
+  (define (f2) (let ((v (vector #f))) (do ((i 0 (+ i 1))) ((= i 1) (vector-ref v 0)) (vector-set! v 0 (int-vector-set! iv 0 0 3)))))
+  (test (f1) 3)
+  (test (f2) 3))
+
+(let ()
+  (define fvref float-vector-ref)
+  (define ivref int-vector-ref)
+  (define bvref byte-vector-ref)
+  (define vref vector-ref)
+  (test (let ((a7 (subvector #i2d((1 2) (3 4)) 1 3 '(2 1)))) (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (ivref a7 0)))) (func)) #i(2))
+  (test (let ((a7 (subvector #u2d((1 2) (3 4)) 1 3 '(2 1)))) (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (bvref a7 0)))) (func)) #u(2))
+  (test (let ((a7 (subvector #r2d((1 2) (3 4)) 1 3 '(2 1)))) (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (fvref a7 0)))) (func)) #r(2))
+  (test (let ((a7 (subvector #2d((1 2) (3 4)) 1 3 '(2 1)))) (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (vref a7 0)))) (func)) #(2)))
+
+  (when full-s7test
+    (define (iota-iv len)
+      (let ((b (make-int-vector len)))
+        (do ((i 0 (+ i 1)))
+            ((= i len) b)
+          (int-vector-set! b i i))))
+    (do ((i 0 (+ i 1)))
+        ((= i 512))
+      (let* ((b (iota-iv i))
+             (b1 (reverse b))
+             (b2 (reverse! b)))
+        (unless (equal? b1 b2)
+          (format *stderr* "reverse iota-iv ~D: ~A~%    ~A~%" i b1 b2)))))
+
+  (when full-s7test
+    (define (iota-fv len)
+      (let ((b (make-float-vector len)))
+        (do ((i 0 (+ i 1))
+             (x 0.0 (+ x 1.0)))
+            ((= i len) b)
+          (float-vector-set! b i x))))
+    (do ((i 0 (+ i 1)))
+        ((= i 512))
+      (let* ((b (iota-fv i))
+             (b1 (reverse b))
+             (b2 (reverse! b)))
+        (unless (equal? b1 b2)
+          (format *stderr* "reverse iota-fv ~D: ~A~%    ~A~%" i b1 b2)))))
+
+  (when full-s7test
+    (define (iota-v len)
+      (let ((b (make-vector len)))
+        (do ((i 0 (+ i 1)))
+            ((= i len) b)
+          (vector-set! b i i))))
+    (do ((i 0 (+ i 1)))
+        ((= i 512))
+      (let* ((b (iota-v i))
+             (b1 (reverse b))
+             (b2 (reverse! b)))
+        (unless (equal? b1 b2)
+          (format *stderr* "reverse iota-v ~D: ~A~%    ~A~%" i b1 b2)))))
+
+  (when full-s7test
+    (define (iota-bv len)
+      (let ((b (make-byte-vector len)))
+        (do ((i 0 (+ i 1)))
+            ((= i len) b)
+          (byte-vector-set! b i (modulo i 256)))))
+    (do ((i 0 (+ i 1)))
+        ((= i 512))
+      (let* ((b (iota-bv i))
+             (b1 (reverse b))
+             (b2 (reverse! b)))
+        (unless (equal? b1 b2)
+          (format *stderr* "reverse iota-bv ~D: ~A~%    ~A~%" i b1 b2)))))
+
+(let ((ivset int-vector-set!)) ; int_vector_set_p_ppp error case
+  (define (f)
+    (do ((i 0 (+ i 1)))
+	((= i 1))
+      (ivset catch (make-byte-vector '(2 3) 1) (symbol "a" "b"))))
+  (test (f) 'error))
+(let ((x 0))                   ; same but at index check
+  (define (f)
+    (do ((i 0 (+ i 1)))
+	((= i 1))
+      (int-vector-set! #i() `(x 1) (abs x))))
+  (test (f) 'error))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; vector
+
+(test (vector 1 2 3) #(1 2 3))
+(test (vector 1 '(2) 3) #(1 (2) 3))
+(test (vector) #())
+(test (vector (vector (vector))) #(#(#())))
+(test (vector (vector) (vector) (vector)) #(#() #() #()))
+(test (vector (list)) #(()))
+(test #(1 #\a "hi" hi) (vector 1 #\a "hi" 'hi))
+(test (let ((v (make-vector 4 "hi")))
+	(vector-set! v 0 1)
+	(vector-set! v 1 #\a)
+	(vector-set! v 3 'hi)
+	v)
+      #(1 #\a "hi" hi))
+(let ((x 34))
+  (test (vector x 'x) #(34 x)))
+
+(for-each
+ (lambda (arg)
+   (test (vector-ref (vector arg) 0) arg))
+ (list #\a 1 () (list 1) '(1 . 2) #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0)
+       3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1))))
+(test (vector 1 . 2) 'error)
+(test (apply vector (cons 1 2)) 'error)
+
+(when with-bignums
+  (test (append #(922337203685477580123123) #(2)) (vector 922337203685477580123123 2)))
+
+
+;;; --------------------------------------------------------------------------------
+;;; vector->list
+;;; list->vector
+
+(test (vector->list #(0)) (list 0))
+(test (vector->list (vector)) ())
+(test (vector->list #(a b c)) '(a b c))
+(test (vector->list #(#(0) #(1))) '(#(0) #(1)))
+(test (vector? (list-ref (let ((v (vector 1 2))) (vector-set! v 1 v) (vector->list v)) 1)) #t)
+(test (vector->list #i(1 2)) '(1 2))
+
+(test (list->vector ()) #())
+(test (list->vector '(a b c)) #(a b c))
+(test (list->vector (list (list 1 2) (list 3 4))) #((1 2) (3 4)))
+(test (list->vector ''foo) #(#_quote foo))
+(test (list->vector (list)) #())
+(test (list->vector (list 1)) #(1))
+(test (list->vector (list (list))) #(()))
+(test (list->vector (list 1 #\a "hi" 'hi)) #(1 #\a "hi" hi))
+(test (list->vector ''1) #(#_quote 1))
+(test (list->vector '''1) #(#_quote '1))
+
+(for-each
+ (lambda (arg)
+   (if (proper-list? arg)
+       (test (vector->list (list->vector arg)) arg)))
+ lists)
+(set! lists ())
+
+(test (list->vector (vector->list (vector))) #())
+(test (list->vector (vector->list (vector 1))) #(1))
+(test (vector->list (list->vector (list))) ())
+(test (vector->list (list->vector (list 1))) '(1))
+
+(test (reinvert 12 vector->list list->vector #(1 2 3)) #(1 2 3))
+
+(test (vector->list) 'error)
+(test (list->vector) 'error)
+(test (vector->list #(1) #(2)) 'error)
+(test (list->vector '(1) '(2)) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (vector->list arg) 'error))
+ (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol "hi" abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (let ((x (cons #\a #\b))) (set-cdr! x x) (list->vector x)) 'error)
+(test (list->vector (cons 1 2)) 'error)
+(test (list->vector '(1 2 . 3)) 'error)
+(test (let ((lst (list #\a #\b))) (set! (cdr (cdr lst)) lst) (list->vector lst)) 'error)
+(test (let ((lst (list #\a #\b))) (set! (cdr (cdr lst)) lst) (apply vector lst)) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (list->vector arg) 'error))
+ (list "hi" #\a 1 '(1 . 2) (cons #\a #\b) 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (vector->list #(1 2 3 4) 0) '(1 2 3 4))
+(test (vector->list #(1 2 3 4) 2) '(3 4))
+(test (vector->list #(1 2 3 4) 0 4) '(1 2 3 4))
+(test (vector->list #(1 2 3 4) 4 4) ())
+(test (vector->list #(1 2 3 4) 1 2) '(2))
+
+(test (vector->list #(1 2 3 4) -1 4) 'error)
+(test (vector->list #(1 2 3 4) 1 0) 'error)
+(test (vector->list #(1 2 3 4) 5) 'error)
+(test (vector->list #(1 2 3 4) 1 5) 'error)
+(test (vector->list #(1 2 3 4) 1 2 3) 'error)
+(unless pure-s7 (test (vector->list #(1 2 3 4) 1 #f) 'error))
+(test (vector->list #(1 2 3 4) #f) 'error)
+(test (vector->list #(1 2 3 4) #f 1) 'error)
+
+(test (vector->list #() 0 10) 'error)
+(test (vector->list #(1) 0 2) 'error)
+(test (vector->list #() 0 0) ())
+(test (vector->list #(1) 1) ())
+(test (vector->list #(1) 0) '(1))
+(test (vector->list #() #\null) 'error)
+(test (vector->list #() 0 #\null) 'error)
+(test (vector->list #() -1) 'error)
+(test (vector->list #(1) -1) 'error)
+(test (vector->list #(1) 0 -1) 'error)
+(test (vector->list #(1) -2 -1) 'error)
+(test (vector->list #(1) most-negative-fixnum) 'error)
+(test (vector->list #(1) 2) 'error)
+
+(test (vector->list (make-int-vector 3)) '(0 0 0))
+(test (vector->list (make-float-vector 3)) '(0.0 0.0 0.0))
+
+(for-each
+ (lambda (arg)
+   (test (vector->list #(0 1 2 3 4 5) arg) 'error)
+   (test (vector->list #(0 1 2 3 4 5) 1 arg) 'error))
+ (list #\a "hi" () (list 1) '(1 . 2) 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(let () ; vector_to_list_p_p
+  (define (f)
+    (let ((v (vector 1 2 3)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 1) v)
+        (vector-set! v 0 (vector->list #()))
+        (vector-set! v 1 (vector->list #(4 5 6))))))
+  (test (f) #(() (4 5 6) 3)))
+
+(when full-s7test ; GC checks
+  (let ()
+    (define (func) (map values (vector->list (make-int-vector '(4 128) 100000)))) ; check GC protection
+    (do ((i 0 (+ i 1))) ((= i 1000)) (func)))
+  (let ()
+    (define (func)
+      (with-output-to-string
+        (lambda ()
+          (do ((i 0 (+ i 1)))
+	      ((= i 1))
+	    (display (make-float-vector '(128 3) (/ pi 2)))))))
+    (do ((i 0 (+ i 1)))
+        ((= i 10000))
+      (func)))
+  (let () ; GC protection in fx_cons_ac
+    (define (f) (do ((i 0 (+ i 1))) ((= i 10000))
+      (let () (define (func) (let () (apply values (cons (vector 0 1 2 3 (make-list 256 1)) ())))) (func) (func))))
+    (f))
+  (let () ; GC protection in list_p_p
+    (define (f) (do ((i 0 (+ i 1))) ((= i 10000))
+      (let () (define (func) (let () (apply values (list (vector -inf.0 case (symbol "(\")") 0+i (make-list 256 1)))))) (func) (func))))
+    (f))
+  (let () ; GC protection in list_ppp_p
+    (define (f) (do ((i 0 (+ i 1))) ((= i 10000))
+      (let () (define (func) (let () (apply values (list 1 (vector -inf.0 case (symbol "(\")") 0+i (make-list 256 1)) 2)))) (func) (func))))
+    (f))
+  (let () ; fx_cons_aa
+    (define (f) (do ((i 0 (+ i 1))) ((= i 10000))
+      (let () (define (func) (let () (apply values (cons (vector 0 1 2 3 4) (make-list 256))))) (func) (func))))
+    (f))
+  (let ()
+    (define (f) ; fx_cons_as
+      (define (func) (let ((L (list 32))) (apply values (cons (vector 0 1 2 3 (make-list 256 1)) L))))
+      (do ((i 0 (+ i 1))) ((= i 10000)) (func) (func)))
+    (f))
+  (let ()
+    (define (f) (do ((i 0 (+ i 1))) ((= i 10000))
+      (let () (define (func) (let () (apply values (cons (cons (vector -inf.0 case (symbol "(\")") 0+i (make-list 256 1)) ()) ())))) (func) (func))))
+    (f))
+  (let ()
+    (define (func x) (do ((j 0 (+ j 1))) ((= j 1)) (do ((i 0 (+ i 1))) ((= i 10000)) (list x (make-int-vector '(2 3) 1) (make-list 256 1)))))
+    (func 2)) ; opt_p_ppp_sff
+  (let () ; make_closure_unchecked bug
+    (define (func)
+      (do ((j 0 (+ j 1))) ((= j 100))
+        (do ((i 0 (+ i 1))) ((= i 1000))
+	  (char? (lambda (a) (values a (+ a 1)))))))
+    (func))
+
+   (let () ; opt_p_pp_ff
+     (define (func)
+       (do ((j 0 (+ j 1)))
+	   ((= j 1))
+	 (do ((i 0 (+ i 1)))
+	     ((= i 10000))
+	   (let ((x #f))
+	     (sort! (vector 3 2 4 5 1)
+		    (lambda (a b)
+		      (let-temporarily ((x (list (logand) (list-ref (make-list 512) (logior)))))
+			(> a b))))))))
+     (func))
+
+   (let ()
+     (define* (sym5 a :rest b) (cons a (copy b)))
+     (define (f1) (do ((i 0 (+ i 1))) ((= i 10000)) (sym5 '(()) (string #\c #\null #\b) (make-list 512)))) ; 1M is a better limit
+     (f1))
+
+   (test (let () (define (func) (do ((j 0 (+ j 1))) ((= j 1)) (do ((i 0 (+ i 1))) ((= i 10000)) (write (make-float-vector '(128 3) pi) (open-output-string))))) (func)) #t)
+   ;; this doesn't hit the GC problem in this context, but maybe it's useful -- opt_p_pp_ff
+
+   (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 10000)) (#_vector (apply-values (make-list 512)) #f))) (func) (func)) #t) ; pair_append
+
+  (let () ; g_sort float_vector (data is the free cell, not vec)
+    (define (f)
+      (let ((x #f) (i 0))
+        (do ((j 0 (+ j 1)))
+	    ((= j 1))
+ 	  (do ((i 0 (+ i 1)))
+	      ((= i 100))
+            (apply values (sort! (make-float-vector '(128 3) pi) (lambda a (copy a))) ())))))
+    (f))
+
+  (do ((i 0 (+ i 1)))
+      ((= i 100))
+    (let () (define (func) (let ((x #f) (i 0)) (do ((j 0 (+ j 1))) ((= j 1)) (do ((i 0 (+ i 1))) ((= i 100)) (apply values (inlet ) (make-list 512)  ()))))) (func) (func))
+    (let () (define (func) (let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 100)) (apply values (#_open-output-string )    (make-list 512) #\\\\7  ())))) (func) (func)))
+  (let ((H_4 (make-hash-table 8 (let ((eqf (lambda (a b) (equal? a b)))
+				      (mapf (lambda (a) (hash-code a))))
+                                  (cons eqf mapf)))))
+    (do ((i 0 (+ i 1)))
+        ((= i 10))
+      (let () (define (func) (let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 100)) (copy (hash-table +nan.0 1) H_4)))) (func) (func))))
+
+  (test (let ()
+          (define* (sym6 a b :rest c) (list a b (copy c)))
+          (define (func) (do ((i 0 (+ i 1))) ((= i 100)) (sym6 (values 1.0 letrec* (cons i i) (log 1.0) (log 2.0) (log 3.0) (log 4.0) (log 5.0) (make-list 512)))))
+          (func))
+        #t)
+
+  (let () ;elist_5 protect copy_any_list in no_setter_error_nr
+    (define (_fnc12_ x) (- x 1))
+    (define (f)
+      (do ((i 0 (+ i 1)))
+	  ((= i 50)) ; doesn't hit the error in this context even with 1000!
+        (catch #t (lambda ()
+		    (define (func)
+		      ((lambda (a) #f)
+		       (set! (values 512 0 0 1 1 0 0 0 0 1 0 0 0 1 0 0 1 0 0 1 1 0 0 1 1 1 0 1 1 1 0 0 1 1 1 0 0 1 1 1 0 1 0 0 0 0 1 1 1 0 0 1 0 0 1 1 0 0 1 0 0 0 1 0 1 1 1 0 1 0 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 0 0 0 0 1 0 0 0 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 0 0 0 0 0 0 1 1 1 0 0 1 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 1 0 1 1 0 0 1 1 1 0 0 1 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 0 0 1 0 0 1 0 0 0 1 0 1 1 0 0 0 1 1 1 0 0 0 0 1 1 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 0 0 1 1 1 0 0 0 0 0 0 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 0 1 1 1 0 0 1 0 1 1 1 1 0 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 1 0 0 1 1 1 1 0 0 0 1 0 0 0 1 1 1 0 0 1 0 0 0 0 0 0 1 1 0 0 0 0 0 0 1 0 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 1 1 0 1 0 1 1 1 1 0 1 0 1 0 1 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 1 1 0 1 0 1 1 0 0 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 0 0 0 0 1 1 0 0 0 0 1 0 1 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 1 0 1 1 0 1 1 1 0 0 1 1 1 1 1 0 0 0 0 1 1 0 0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 1 1 1 0 0 0 0 0 1 0 1)
+			     (_fnc12_))))
+                 (func))
+	       (lambda args #f))))
+    (test (f) #t))
+)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; vector-length
+
+(test (vector-length (vector)) 0)
+(test (vector-length (vector 1)) 1)
+(test (vector-length (make-vector 128)) 128)
+(test (vector-length #(a b c d e f)) 6)
+(test (vector-length #()) 0)
+(test (vector-length (vector #\a (list 1 2) (vector 1 2))) 3)
+(test (vector-length #(#(#(hi)) #(#(hi)) #(#(hi)))) 3)
+(test (vector-length (vector 1 2 3 4)) 4)
+(test (vector-length (let ((v (vector 1 2))) (vector-set! v 1 v) v)) 2)
+(test (vector-length (let ((v (vector 1 2))) (vector-set! v 1 v) (vector-ref v 1))) 2)
+(test (vector-length (make-int-vector 3 0)) 3)
+(if (not with-bignums) (test (vector-length (make-float-vector 3 pi)) 3))
+(if (not with-bignums) (test (vector-length (make-float-vector '(2 3) pi)) 6))
+(test (vector-length #r(1 2)) 2)
+
+(test (vector-length) 'error)
+(test (vector-length #(1) #(2)) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (vector-length arg) 'error))
+ (list "hi" #\a 1 () '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(let ((ivals (make-int-vector 3))) ; vector_length_p_p
+  (define (unzero v)
+    (let ((v1 (copy v)))
+      (do ((i 0 (+ i 1)))
+	  ((= i (vector-length v1)) v1)
+	(if (zero? (v1 i))
+	    (set! (v1 i) 1)))))
+  (test (unzero ivals) #i(1 1 1)))
+
+
+;;; --------------------------------------------------------------------------------
+;;; vector-rank
+;;; vector-dimension
+;;; vector-dimensions
+
+(test (vector-rank #()) 1)
+(test (vector-dimensions #()) '(0))
+(test (vector-dimension #() 0) 0)
+(test (vector-dimension #() 0 0) 'error)
+(test (vector-dimension #() 1) 'error)
+(test (vector-dimension #()) 'error)
+(test (vector-rank #(1 2)) 1)
+(test (vector-dimensions #(1 2)) '(2))
+(test (vector-dimension #(1 2) 0) 2)
+(test (vector-dimension #(1 2) -1) 'error)
+(test (vector-dimension #(1 2) 1) 'error)
+(test (vector-rank (make-vector '(2 3))) 2)
+(test (vector-dimensions (make-vector '(2 3))) '(2 3))
+(test (vector-dimension (make-vector '(2 3)) 0) 2)
+(test (vector-dimension (make-vector '(2 3)) 1) 3)
+(test (vector-rank (make-vector '(2 1 3))) 3)
+(test (vector-dimensions (make-vector '(2 1 3))) '(2 1 3))
+(test (vector-rank (make-vector '(2 0 3))) 3)
+(test (vector-dimensions (make-vector '(2 0 3))) '(2 0 3))
+(test (vector-dimension (make-vector '(2 0 3)) 1) 0)
+(test (vector-dimension (make-vector '(2 0 3)) 2) 3)
+(test (vector-rank (make-vector 0)) 1)
+(test (vector-dimensions (make-vector 0)) '(0))
+(test (vector-dimensions _c_obj_) '(16))
+(let ((v (make-vector 24)))
+  (test (vector-rank (subvector v 0 24 '(3 8))) 2)
+  (test (vector-rank (subvector v 2 10 '(2 2 2))) 3))
+
+(for-each
+ (lambda (arg)
+   (test (vector-rank arg) 'error)
+   (test (vector-dimension arg 0) 'error)
+   (test (vector-dimensions arg) 'error))
+ (list "hi" #\a 1 () '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _undef_ _null_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (vector-rank (make-int-vector '(2 3))) 2)
+(test (vector-dimensions (make-int-vector '(2 3))) '(2 3))
+(test (vector-dimension (make-int-vector '(2 3)) 1) 3)
+(test (vector-rank (make-byte-vector '(2 3))) 2)
+(test (vector-dimensions (make-byte-vector '(2 3))) '(2 3))
+(test (vector-dimension (make-byte-vector '(2 3)) 0) 2)
+(test (vector-dimension (make-byte-vector '(2 3)) 1) 3)
+(test (vector-rank (make-float-vector '(2 3))) 2)
+(test (vector-dimensions (make-float-vector '(2 3))) '(2 3))
+
+(test (vector-dimensions) 'error)
+(test (vector-dimensions #() #()) 'error)
+(test (vector-dimensions (vector)) '(0))
+(test (vector-dimensions (vector 0)) '(1))
+(test (vector-dimensions (vector-ref #2d((1 2 3) (3 4 5)) 0)) '(3))
+(test (vector-dimensions (vector-ref #3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2))) 0)) '(2 3))
+(test (vector-dimensions (vector-ref #3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2))) 0 1)) '(3))
+(test (set! (vector-dimensions #(1 2)) 1) 'error)
+(test (let ((v #(1 2 3))) (set! (car (vector-dimensions v)) 0) v) #(1 2 3))
+(test (hash-table 1 (vector-dimensions (block))) (hash-table 1 '(0)))
+
+
+;;; --------------------------------------------------------------------------------
+;;; vector-typer
+
+(let ((v #(1 2)))
+  (for-each
+   (lambda (arg)
+     (test (vector-typer arg) 'error)
+     (test (set! (vector-typer arg) integer?) 'error)
+     (test (set! (vector-typer v) arg) 'error))
+   (list "hi" #\a 1 () '(1 . 2) (cons #\a #\b) 'a-symbol abs _ht_ _undef_ _null_ quasiquote macroexpand 1/0 (log 0)
+         3.14 3/4 1.0+1.0i :hi (if #f #f) (lambda (a) (+ a 1)))))
+
+(let ()
+  (define (typer x) (symbol? x))
+  (define v (make-vector 9 'a typer))
+  (define v1 (make-vector 3 1))
+
+  (test (equal? typer (vector-typer v)) #t)
+  (test (vector-typer (make-int-vector 3)) integer?)
+  (test (vector-typer (make-vector 9 1 integer?)) integer?)
+  (test (let ((L (subvector (make-vector 3 'a symbol?)))) (vector-typer L)) symbol?)
+
+  (test (vector-typer v1) #f)
+  (test (set! (vector-typer v1) integer?) integer?)
+  (test (vector-typer v1) integer?)
+  (test (set! (v1 0) pi) 'error) ; vector-set! third argument 3.141592653589793, is a real, but the vector's element type checker, integer?, rejects it
+
+  (test (set! (vector-typer (int-vector 1 2 3)) integer?) integer?)
+  (test (catch #t (lambda () (set! (vector-typer (int-vector 1 2 3)) (lambda (x) (float? x)))) (lambda (t i) (apply format #f i)))
+        "vector-typer can't set #i(1 2 3) typer to #<lambda (x)>")
+  (test (catch #t (lambda () (set! (vector-typer (vector 1 2 3)) (lambda (x) (float? x)))) (lambda (t i) (apply format #f i)))
+        "vector-typer second argument, #<lambda (x)>, is a function but should be a named function")
+  (test (catch #t (lambda () (set! (vector-typer (vector 1)) (macro (mac a) `(+ 1 ,a)))) (lambda (t i) (apply format #f i)))
+        "vector-typer second argument, #<macro (mac a)>, is a macro but should be a built-in procedure, a closure, #f or #t")
+  (test (catch #t (lambda () (set! (vector-typer (vector 1)) (lambda (a) #f))) (lambda (t i) (apply format #f i)))
+        "vector-typer second argument, #<lambda (a)>, is a function but should be a named function")
+  (test (catch #t (lambda () (set! (vector-typer (vector 1 2 3)) abs)) (lambda (t i) (apply format #f i)))
+        "vector-typer second argument, abs, is a c-function but should be a boolean procedure")
+  (test (set! (vector-typer (vector 1 2 3)) typer) typer)  ; current contents are not checked
+  )
+
+(let ()
+  (define (vector-type v)
+    (let* ((data (object->let v))
+	   (sig (and (defined? 'signature data #t)
+		     (let-ref data 'signature))))
+      (and (pair? sig)
+	   (car sig))))
+
+  (define (vtyper v) #t)
+  (let ((V1 (make-vector 3 1 vtyper)))
+    (set! (V1 0) 0)
+    (test (object->string V1 :readable) "(let ((<v> (vector 0 1 1))) (set! (vector-typer <v>) vtyper) <v>)")
+    (test (vector-type V1) 'vtyper))
+
+  (test (vector-type (make-vector 3 'a symbol?)) 'symbol?)
+  (test (vector-type (vector 0 1)) #f))
+
+(let ()
+  (define (vtyper v) #t)
+  (let ((V1 (make-vector 1024 #f vtyper)))
+    (test (object->string V1 :readable) "(make-vector 1024 #f vtyper)")))
+
+(test (object->string (make-int-vector 1024 1) :readable) "(make-int-vector 1024 1)")
+(test (let ((v (make-vector 3 'a symbol?))) (object->string v :readable)) "(let ((<v> (vector 'a 'a 'a))) (set! (vector-typer <v>) symbol?) <v>)")
+(let ((v (immutable! (make-vector '(2 3) 'a symbol?))))
+  (test (object->string v :readable) "(let ((<v> (subvector (immutable! (vector 'a 'a 'a 'a 'a 'a)) 0 6 '(2 3)))) (set! (vector-typer <v>) symbol?) <v>)"))
+
+
+(let ()
+  ;; typers expect s7 to raise error
+  (define (vtyper val) (or (integer? val) (boolean? val)))
+  (define v (make-vector 3 0 vtyper))
+  (set! (v 0) #f)
+  (test v #(#f 0 0))
+  (set! (v 1) 21)
+  (test v #(#f 21 0))
+  (test (catch #t (lambda () (set! (v 2) "asdf")) (lambda (typ info) (apply format #f info)))
+	"vector-set! third argument \"asdf\", is a string, but the vector's element type checker, vtyper, rejects it")
+
+  (define h (make-hash-table 3 #f (cons vtyper vtyper)))
+  (set! (h 0) #t)
+  (test h (hash-table 0 #t))
+  (set! (h 1) 21)
+  (test h (hash-table 0 #t 1 21))
+  (test (catch #t (lambda () (set! (h 2) "asdf")) (lambda (typ info) (apply format #f info)))
+	"hash-table-set! third argument \"asdf\", is a string, but the hash-table's value type checker, vtyper, rejects it")
+  (test (catch #t (lambda () (set! (h "asdf") 2)) (lambda (typ info) (apply format #f info)))
+	"hash-table-set! second argument \"asdf\", is a string, but the hash-table's key type checker, vtyper, rejects it")
+  (set! (h 0) #f)
+  (test h (hash-table 1 21))
+
+  ;; symbol setters handle errors themselves
+  (define int #t)
+  (set! (setter 'int) boolean?)
+  (set! int #f)
+  (test int #f)
+  (test (catch #t (lambda () (set! int 21)) (lambda (t info) (apply format #f info))) "set! int, 21 is an integer but should be boolean")
+  (set! (setter 'int) (lambda (s v)
+			(if (or (boolean? v) (integer? v))
+			    v
+			    (error 'wrong-type-arg "can't set! ~S to ~S" s v))))
+  (set! int #f)
+  (test int #f)
+  (set! int 21)
+  (test int 21)
+  (test (catch #t (lambda () (set! int "asdf")) (lambda (typ info) (apply format #f info))) "can't set! int to \"asdf\"")
+
+  ;; function setters also handle errors themselves
+  (define f1 (dilambda (lambda () 3) (lambda (v) 32)))
+  (test (f1) 3)
+  (test (set! (f1) 12) 32)
+  (set! (setter f1) #f)
+  (test (catch #t (lambda () (set! (f1) 12)) (lambda (typ info) (apply format #f info))) "f1 (a function) does not have a setter: (set! (f1) 12)"))
+
+(let ((V (make-vector 2 'a symbol?)))
+  (let ((S1 (subvector V 0 1))
+	(S2 (subvector V 1 2)))
+    (set! (vector-typer S1) (define (S1-typer e) (and (symbol? e) (memq e '(a b c)))))
+    (set! (vector-typer S2) (define (S2-typer e) (and (symbol? e) (memq e '(d e f)))))
+    (set! (S1 0) 'b)
+    (set! (S2 0) 'e)
+    (test V #(b e))
+    (test (set! (S1 0) 'z) 'error) ; vector-set! third argument 'z, is a symbol, but the vector's element type checker, S1-typer, rejects it
+    (test (set! (S2 0) 'z) 'error) ; vector-set! third argument 'z, is a symbol, but the vector's element type checker, S2-typer, rejects it
+    (test V #(b e))))
+
+(test (vector-typer (append (make-vector 1 'a symbol?) (make-vector 2 'b symbol?))) symbol?)
+(test (vector-typer (append (make-vector 1 'a symbol?) (make-vector 2))) #f)
+(test (vector-typer (append (make-vector 1 'a symbol?) (list 1 2))) #f)
+
+(let () ; check that has_simple_elements bit is cleared if typer reset to #f or non-simple c-func
+  (define-constant V_A (let ((v (make-vector 8))) (set! (vector-typer v) symbol?) v))
+  (set! (vector-typer V_A) #f)
+  (fill! V_A V_A)
+  (test (format #f "~A" V_A) "#1=#(#1# #1# #1# #1# #1# #1# #1# #1#)")
+  (test (string-wi=? (format #f "~W" V_A)
+                     "(let ((<1> (vector #f #f #f #f #f #f #f #f)))
+                        (set! (<1> 0) <1>)   (set! (<1> 1) <1>)   (set! (<1> 2) <1>)   (set! (<1> 3) <1>)
+                        (set! (<1> 4) <1>)   (set! (<1> 5) <1>)   (set! (<1> 6) <1>)   (set! (<1> 7) <1>)
+                        <1>)") #t))
+(let ()
+  (define-constant V_B (let ((v (make-vector 8))) (set! (vector-typer v) symbol?) v))
+  (set! (vector-typer V_B) vector?)
+  (fill! V_B V_B)
+  (test (format #f "~S" V_B) "#1=#(#1# #1# #1# #1# #1# #1# #1# #1#)"))
+
+(let ((v (make-vector 8)))
+  (set! (vector-typer v) symbol?)
+  (immutable! v)
+  (test (set! (vector-typer v) integer?) 'error)
+  (test (set! (vector-typer v) #t) 'error))
+(let ((v (make-vector 8)))
+  (immutable! v)
+  (test (set! (vector-typer v) integer?) 'error)
+  (test (set! (vector-typer v) #t) 'error))
+
+
+;;; --------------------------------------------------------------------------------
+;;; vector-ref
+
+(test (vector-ref #(1 1 2 3 5 8 13 21) 5) 8)
+(test (vector-ref #(1 1 2 3 5 8 13 21) (let ((i (round (* 2 (acos -1))))) (if (inexact? i) (inexact->exact i)  i))) 13)
+(test (let ((v (make-vector 1 0))) (vector-ref v 0)) 0)
+(test (let ((v (vector 1 (list 2) (make-vector 3 #\a)))) (vector-ref v 1)) (list 2))
+(test (let ((v (vector 1 (list 2) (make-vector 3 #\a)))) (vector-ref v 2)) #(#\a #\a #\a))
+(test (let ((v (vector 1 (list 2) (make-vector 3 #\a)))) (vector-ref (vector-ref v 2) 1)) #\a)
+(test (vector-ref #(a b c) 1) 'b)
+(test (vector-ref #(()) 0) ())
+(test (vector-ref #(#()) 0) #())
+(test (vector-ref (vector-ref (vector-ref #(1 (2) #(3 (4) #(5))) 2) 2) 0) 5)
+(test (let ((v (vector 1 2))) (vector-set! v 1 v) (eq? (vector-ref v 1) v)) #t)
+(test (let ((v (make-int-vector 3))) (vector-ref v 1)) 0)
+(test (let ((v (make-vector 3 0))) (vector-ref v 1)) 0)
+(test (let ((v (make-float-vector 3 1.0))) (vector-ref v 1)) 1.0)
+(test (let ((v (make-int-vector 6 0))) (vector-set! v 3 32) (let ((v1 (subvector v 0 6 '(2 3)))) (vector-ref v1 1 0))) 32)
+
+(test (vector-ref) 'error)
+(test (vector-ref #(1)) 'error)
+(test (vector-ref #(1) 0 0) 'error)
+(test (vector-ref () 0) 'error)
+(test (vector-ref #(1) 1) 'error)
+(test (vector-ref #2d((1 2) (3 4)) 3 0) 'error)
+(test (vector-ref #2d((1 2) (3 4)) 0 3) 'error)
+(test (vector-ref #2d((1 2) (3 4)) 0 0 0) 'error)
+
+(test (let ((v (make-vector 1 0))) (vector-ref v 1)) 'error)
+(test (let ((v (make-vector 1 0))) (vector-ref v -1)) 'error)
+(test (let ((v (vector 1 (list 2) (make-vector 3 #\a)))) (vector-ref (vector-ref v 2) 3)) 'error)
+(test (let ((v (vector 1 (list 2) (make-vector 3 #\a)))) (vector-ref (vector-ref v 3) 0)) 'error)
+(test (vector-ref (vector) 0) 'error)
+(test (vector-ref #() 0) 'error)
+(test (vector-ref #() -1) 'error)
+(test (vector-ref #() 1) 'error)
+(test (vector-ref #(1 2 3) (floor .1)) 1)
+(test (vector-ref #(1 2 3) (floor 0+0i)) 1)
+(test (vector-ref #10d((((((((((0 1)))))))))) 0 0 0 0 0 0 0 0 0 1) 1)
+
+(test (#(1 2) 1) 2)
+(test (#(1 2) 1 2) 'error)
+(test ((#("hi" "ho") 0) 1) #\i)
+(test (((vector (list 1 2) (cons 3 4)) 0) 1) 2)
+(test ((#(#(1 2) #(3 4)) 0) 1) 2)
+(test ((((vector (vector (vector 1 2) 0) 0) 0) 0) 0) 1)
+(test ((((list (list (list 1 2) 0) 0) 0) 0) 0) 1)
+(test ((((list (list (list 1 2) 0) 0) 0) 0) ((((vector (vector (vector 1 2) 0) 0) 0) 0) 0)) 2)
+(test (#(1 2) -1) 'error)
+(test (#()) 'error)
+(test (#(1)) 'error)
+(test (#2d((1 2) (3 4))) 'error)
+(test (apply (make-vector '(1 2))) 'error)
+
+(test (type-of (eval-string "#2/3d(1 2)")) 'error)
+(test (type-of (eval-string "#2.1d(1 2)")) 'error)
+(test (eval-string "#(1 2 . 3)") 'error)
+(test (#(#(#(#t))) 0 0 0) #t)
+(test (let ((v (make-vector 3 0 #t))) (v 0 0)) 'error)
+(test (let ((v (make-int-vector '(2 2)))) (v 0 0 0)) 'error)
+(test (let ((v (make-float-vector 3))) (vector-ref v 0 0)) 'error)
+(test (let ((v (make-vector '(2 2) 0.0 #t))) (vector-ref v 0 0 0)) 'error)
+(test (let ((v (make-vector 3 0))) (v 0 0)) 'error)
+(test (let ((v (make-vector '(2 2) 0))) (v 0 0 0)) 'error)
+
+(let ((v #(1 2 3)))
+  (for-each
+   (lambda (arg)
+     ; (format *stderr* "~A~%" arg)
+     (test (vector-ref arg 0) 'error)
+     (test (v arg) 'error)
+     (test (v arg 0) 'error)
+     (test (vector-ref v arg) 'error)
+     (test (vector-ref v arg 0) 'error)
+     (test (vector-ref #2d((1 2) (3 4)) 0 arg) 'error))
+   (list "hi" () #() #\a -1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _undef_ _null_ quasiquote macroexpand 1/0 (log 0)
+	 3.14 3/4 1.0+1.0i #t (lambda (a) (+ a 1)) (make-hash-table))))
+
+
+(test (vector-ref #(#(1 2 3) #(4 5 6)) 1) #(4 5 6))
+(test (vector-ref #(#(1 2 3) #(4 5 6)) 1 2) 6)
+(test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1) #(#(7 8 9) #(10 11 12)))
+(test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0) #(7 8 9))
+(test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 2) 9)
+(test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 3) 'error)
+(test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 2 0) 'error)
+
+(test (#(#(1 2 3) #(4 5 6)) 1) #(4 5 6))
+(test (#(#(1 2 3) #(4 5 6)) 1 2) 6)
+(test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1) #(#(7 8 9) #(10 11 12)))
+(test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0) #(7 8 9))
+(test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 2) 9)
+(test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 3) 'error)
+(test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 2 0) 'error)
+
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (L 1)) #(4 5 6))
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (L 1 2)) 6)
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (L 1 2 3)) 'error)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L 1)) #(#(7 8 9) #(10 11 12)))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L 1 0)) #(7 8 9))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L 1 0 2)) 9)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L 1 0 2 3)) 'error)
+
+(test (let ((L #(#(1 2 3) #(4 5 6)))) ((L 1) 2)) 6)
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (((L 1) 2) 3)) 'error)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L 1) 0)) #(7 8 9))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (((L 1) 0) 2)) 9)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L 1 0) 2)) 9)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L 1) 0 2)) 9)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((((L 1) 0) 2) 3)) 'error)
+
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (vector-ref (L 1) 2)) 6)
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (vector-ref ((L 1) 2) 3)) 'error)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-ref (L 1) 0)) #(7 8 9))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((vector-ref (L 1) 0) 2)) 9)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-ref (((L 1) 0) 2) 3)) 'error)
+
+
+(let ((zero 0)
+      (one 1)
+      (two 2)
+      (three 3)
+      (thirty-two 32))
+  (test (vector-ref #(#(1 2 3) #(4 5 6)) one) #(4 5 6))
+  (test (vector-ref #(#(1 2 3) #(4 5 6)) one two) 6)
+  (test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one) #(#(7 8 9) #(10 11 12)))
+  (test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one zero) #(7 8 9))
+  (test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one zero two) 9)
+
+  (test (#(#(1 2 3) #(4 5 6)) one) #(4 5 6))
+  (test (#(#(1 2 3) #(4 5 6)) one two) 6)
+  (test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one) #(#(7 8 9) #(10 11 12)))
+  (test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one zero) #(7 8 9))
+  (test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one zero two) 9)
+
+  (test (let ((L #(#(1 2 3) #(4 5 6)))) (L one)) #(4 5 6))
+  (test (let ((L #(#(1 2 3) #(4 5 6)))) (L one two)) 6)
+  (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L one)) #(#(7 8 9) #(10 11 12)))
+  (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L one zero)) #(7 8 9))
+  (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L one zero two)) 9)
+
+  (test (let ((L #(#(1 2 3) #(4 5 6)))) ((L one) two)) 6)
+  (test (let ((L #(#(1 2 3) #(4 5 6)))) (((L one) two) 3)) 'error)
+  (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L one) zero)) #(7 8 9))
+  (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (((L one) zero) two)) 9)
+  (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L one zero) two)) 9)
+  (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L one) zero two)) 9)
+
+  (test (let ((L #(#(1 2 3) #(4 5 6)))) (vector-ref (L one) two)) 6)
+  (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-ref (L one) zero)) #(7 8 9))
+  (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((vector-ref (L one) zero) two)) 9))
+
+(test ((#(#(:hi) #\a (3)) (#("hi" 2) 1)) (#2d((#() ()) (0 #(0))) 1 ('(cons 0) 1))) 3)
+(test (#(1 2 3) (#(1 2 3) 1)) 3)
+(test ((#(#(1 2)) (#(1 0) 1)) (#(3 2 1 0) 2)) 2)
+(test (apply min (#(1 #\a (3)) (#(1 2) 1))) 3) ; i.e vector ref here 2 levels -- (#(1 2) 1) is 2 and (#(1 #\a (3)) 2) is (3)
+
+;;; vector-ref optimizer checks
+(define global_vector (vector 1 2 3))
+(let ()
+  (define (hi i) (vector-ref global_vector i))
+  (test (hi 1) 2))
+(let ()
+  (define (hi i) (vector-ref global_vector (vector-ref global_vector i)))
+  (test (hi 0) 2))
+
+(test (let ((v #(0 1 2 3 4 5))) (define (f1) (v 4/3)) (f1)) 'error)
+(test (let ((v "012345")) (define (f1) (v 4/3)) (f1)) 'error)
+(test (let ((v (list 0 1 2 3 4 5))) (define (f1) (v 4/3)) (f1)) 'error)
+
+(define-constant -a-global-vector- (vector 1 2 3))
+(let ()
+  (define (fg a) (vector-ref -a-global-vector- a))
+  (test (fg 0) 1))
+
+(let ()
+  (define (f1)
+    (let ((v (vector #f)) (X #2d((1 2) (3 4))))
+      (do ((i 0 (+ i 1))) ((= i 1) v)
+	(vector-set! v 0 (vector-ref X 1)))))
+  (test (f1) #(#(3 4))))
+
+(let ()
+  (define (f1)
+    (let ((v (vector #f)) (X #2d((1 2) (3 4))))
+      (do ((i 0 (+ i 1))) ((= i 1) v)
+	(vector-set! v 0 (vector-ref X 2)))))
+  (test (f1) 'error))
+
+(let ()
+  (define (f1)
+    (let ((I 0) (v (vector #f)) (X #2d((1 2) (3 4))))
+      (do ((i 0 (+ i 1))) ((= i 1) v)
+	(vector-set! v 0 (vector-ref X (+ I 1))))))
+  (test (f1) #(#(3 4))))
+
+(let ()
+  (define (f1)
+    (let ((I 1) (v (vector #f)) (X #2d((1 2) (3 4))))
+      (do ((i 0 (+ i 1))) ((= i 1) v)
+	(vector-set! v 0 (vector-ref X (+ I 1))))))
+  (test (f1) 'error))
+
+(set! global_vector #2d((1 2) (3 4)))
+(let ()
+  (define (f1)
+    (let ((I 1) (v (vector #f)))
+      (do ((i 0 (+ i 1))) ((= i 1) v)
+	(vector-set! v 0 (vector-ref global_vector I)))))
+  (test (f1) #(#(3 4))))
+
+(let ()
+  (define (f1)
+    (let ((I 2) (v (vector #f)))
+      (do ((i 0 (+ i 1))) ((= i 1) v)
+	(vector-set! v 0 (vector-ref global_vector I)))))
+  (test (f1) 'error))
+
+(test (#("asdf") 0 1) #\s)
+(test (#("asdf") 0 1 0) 'error)
+
+(test (let () (define (px x) (vector-ref x 0)) (define (fpx x y) (+ (px x) (px y))) (define (tfpx) (let ((v1 #(1 2 3)) (v2 #(2 3 1))) (fpx v1 v2))) (tfpx)) 3) ; fx_c_ff
+(test (let ((v #2d((3 2 1) (6 5 4))) (b1 123) (b2 0)) (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (imag-part (v b1 b2)))) (f)) 'error) ; opt_p_pii_sss bug
+
+(let ()
+;; coverage tests (not otherwise hit in this file)
+  (define (f1)
+    (let ((v1 (list (list (list 1)) (list (list 2)) (list (list 3)) (list (list 4))))
+	  (sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 4) sum)
+	(set! sum (+ sum (v1 i 0 0))))))
+  (test (f1) 10)
+
+  (define (f2)
+    (let ((v2 (make-vector '(10 2 2) 1.0))
+	  (sum 0.0))
+      (set! (v2 1 0 0) 2.0)
+      (set! (v2 2 0 0) 3.0)
+      (set! (v2 3 0 0) 4.0)
+      (do ((i 0 (+ i 1)))
+	  ((= i 4) sum)
+	(set! sum (+ sum (v2 i 0 0))))))
+  (test (f2) 10.0)
+
+  (define (f3)
+    (let ((v3 (make-float-vector '(10 2 2) 1.0))
+	  (sum 0.0))
+      (set! (v3 1 0 0) 2.0)
+      (set! (v3 2 0 0) 3.0)
+      (set! (v3 3 0 0) 4.0)
+      (do ((i 0 (+ i 1)))
+	  ((= i 4) sum)
+	(set! sum (+ sum (v3 i 0 0))))))
+  (test (f3) 10.0)
+
+  (define (f4)
+    (let ((v4 (make-int-vector '(10 2 2) 1))
+	  (sum 0))
+      (set! (v4 1 0 0) 2)
+      (set! (v4 2 0 0) 3)
+      (set! (v4 3 0 0) 4)
+      (do ((i 0 (+ i 1)))
+	  ((= i 4) sum)
+	(set! sum (+ sum (v4 i 0 0))))))
+  (test (f4) 10)
+
+  (define (fi)
+    (let ((v4 (make-int-vector (expt 2 9)))
+	  (sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 9))
+	(vector-set! v4 (expt 2 i) i))
+      (let ((v4a (subvector v4 0 (length v4) (make-list 9 2))))
+	(do ((i 1 (+ i 1)))
+	    ((= i 2) sum)
+	  (set! sum (+ sum
+		       (v4a i 0 0 0  0 0 0 0  0)
+		       (v4a 0 i 0 0  0 0 0 0  0)
+		       (v4a 0 0 i 0  0 0 0 0  0)
+		       (v4a 0 0 0 i  0 0 0 0  0)))))))
+  (test (fi) 26)
+
+  (define (f5)
+    (let ((v5 (make-byte-vector '(10 2 2) 1))
+	  (sum 0))
+      (set! (v5 1 0 0) 2)
+      (set! (v5 2 0 0) 3)
+      (set! (v5 3 0 0) 4)
+      (do ((i 0 (+ i 1)))
+	  ((= i 4) sum)
+	(set! sum (+ sum (v5 i 0 0))))))
+  (test (f5) 10)
+
+  (define (f6)
+    (let ((v6 (hash-table 0 (list (list 1)) 1 (list (list 2)) 2 (list (list 3)) 3 (list (list 4))))
+	  (sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 4) sum)
+	(set! sum (+ sum (v6 i 0 0))))))
+  (test (f6) 10))
+
+;;; some error checks
+(let ((arr (make-vector '(2 3 4) #f)))
+  (test (vector-ref arr 1 1 4) 'error)
+  (test (vector-ref arr 1 3 1) 'error)
+  (test (vector-ref arr 2 0 0) 'error)
+  (test (vector-set! arr 1 1 4 #t) 'error)
+  (test (vector-set! arr 1 3 1 #t) 'error)
+  (test (vector-set! arr 2 0 0 #t) 'error))
+
+
+;;; --------------------------------------------------------------------------------
+;;; vector-set!
+
+(test (let ((vec (vector 0 '(2 2 2 2) "Anna"))) (vector-set! vec 1 '("Sue" "Sue")) vec) #(0 ("Sue" "Sue") "Anna"))
+(test (let ((v (vector 1 2 3))) (vector-set! v 1 32) v) #(1 32 3))
+(let ((v (make-vector 8 #f)))
+  (for-each
+   (lambda (arg)
+     (vector-set! v 1 arg)
+     (test (vector-ref v 1) arg))
+   (list #\a 1 () (list 1) '(1 . 2) #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0)
+	 3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1)))))
+(test (let ((v (vector 1 2 3))) (vector-set! v 1 0) v) #(1 0 3))
+(test (let ((v (vector #f))) (vector-set! v 0 (vector)) v) #(#()))
+(test (let ((v (vector 1 (list 2) (vector 1 2 3)))) (vector-set! (vector-ref v 2) 0 21) v) #(1 (2) #(21 2 3)))
+(test (let ((v (make-int-vector 3))) (vector-set! v 1 32) (vector->list v)) '(0 32 0))
+(test (let ((v (make-int-vector 3 0))) (set! (v 1) 32) (vector->list v)) '(0 32 0))
+
+(test (vector-set! (vector 1 2) 0 4) 4)
+(test (vector-set!) 'error)
+(test (vector-set! #(1)) 'error)
+(test (vector-set! #(1) 0) 'error)
+(test (vector-set! #(1) 0 0 1) 'error)
+(test (vector-set! #(1) 0 0 1 2 3) 'error)
+(test (vector-set! #(1) #(0) 1) 'error)
+(test (vector-set! #(1 2) 0 2) 2)
+(test (let ((x 2) (v (vector 1 2))) (vector-set! (let () (set! x 3) v) 1 23) (list x v)) '(3 #(1 23)))
+(test (let ((v #(1 2))) (vector-set! v 0 32)) 32)
+(test (let ((v #(1 2))) (set! (v 0) 32)) 32)
+(test (let ((v #(1 2))) (set! (vector-ref v 0) 32)) 32)
+(test (let ((v (make-vector '(2 3) 0))) (set! (v (values 0 1)) 23) v) #2d((0 23 0) (0 0 0)))
+
+(for-each
+ (lambda (arg)
+   (test (vector-set! arg 0 0) 'error))
+ (list "hi" () #\a -1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _undef_ _null_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t (lambda (a) (+ a 1)) (make-hash-table)))
+
+(let ((v (vector 1 2 3)))
+  (for-each
+   (lambda (arg)
+     (test (vector-set! v arg 0) 'error))
+   (list "hi" () #() #\a -1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+	 3.14 3/4 1.0+1.0i #t (make-vector 3) (lambda (a) (+ a 1)))))
+
+(for-each
+ (lambda (arg)
+   (test (vector-set! arg 0 0) 'error))
+ (list "hi" () #\a 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _undef_ _null_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(let ((v #(#(0 1) #(2 3))))
+  (vector-set! (vector-ref v 1) 1 4)
+  (test (v 1 1) 4)
+  (set! ((vector-ref v 1) 1) 5)
+  (test (v 1 1) 5)
+  (set! ((v 1) 1) 6)
+  (test (v 1 1) 6)
+  (vector-set! (v 1) 1 7)
+  (test (v 1 1) 7)
+  (set! (v 1 1) 8)
+  (test (v 1 1) 8))
+
+(let ((v (vector)))
+  (test (vector-set! v 0 0) 'error)
+  (test (vector-set! v 1 0) 'error)
+  (test (vector-set! v -1 0) 'error))
+(test (vector-set! #() 0 123) 'error)
+(test (vector-set! #(1 2 3) 0 123) 123)
+(test (let ((v #(1 2 3))) (set! (v 0) '(+ 1 2)) v) #((+ 1 2) 2 3))
+(test (let ((v #(1 2 3))) (set! (v '(+ 1 1)) 2) v) 'error)
+(test (let ((v #(1 2 3))) (set! (v (+ 1 1)) 2) v) #(1 2 2))
+
+(test (let ((g (lambda () #(1 2 3)))) (vector-set! (g) 0 #\?) (g)) #(#\? 2 3))
+(test (let ((g (lambda () '(1 . 2)))) (set-car! (g) 123) (g)) '(123 . 2))
+(test (let ((g (lambda () '(1 2)))) (list-set! (g) 0 123) (g)) '(123 2))
+(test (let ((g (lambda () (symbol->string 'hi)))) (string-set! (g) 1 #\a) (symbol->string 'hi)) "hi")
+
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (vector-set! L 1 32) L) #(#(1 2 3) 32))
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (vector-set! L 1 0 32) L) #(#(1 2 3) #(32 5 6)))
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (vector-set! L 1 0 2 32) L) 'error)
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (vector-set! L 1 3 32) L) 'error)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-set! L 1 32) L) #(#(#(1 2 3) #(4 5 6)) 32))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-set! L 1 0 32) L) #(#(#(1 2 3) #(4 5 6)) #(32 #(10 11 12))))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-set! L 1 0 2 32) L) #(#(#(1 2 3) #(4 5 6)) #(#(7 8 32) #(10 11 12))))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-set! L 1 0 2 1 32) L) 'error)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-set! L 1 4 2 32) L) 'error)
+
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (set! (L 1) 32) L) #(#(1 2 3) 32))
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (set! (L 1 0) 32) L) #(#(1 2 3) #(32 5 6)))
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (set! (L 1 0 2) 32) L) 'error)
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (set! (L 1 3) 32) L) 'error)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (L 1) 32) L) #(#(#(1 2 3) #(4 5 6)) 32))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (L 1 0) 32) L) #(#(#(1 2 3) #(4 5 6)) #(32 #(10 11 12))))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (L 1 0 2) 32) L) #(#(#(1 2 3) #(4 5 6)) #(#(7 8 32) #(10 11 12))))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (L 1 0 2 1) 32) L) 'error)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (L 1 4 2) 32) L) 'error)
+
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (set! ((L 1) 0) 32) L) #(#(1 2 3) #(32 5 6)))
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (set! (((L 1) 0) 2) 32) L) 'error)
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (set! ((L 1) 3) 32) L) 'error)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! ((L 1) 0) 32) L) #(#(#(1 2 3) #(4 5 6)) #(32 #(10 11 12))))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (((L 1) 0) 2) 32) L) #(#(#(1 2 3) #(4 5 6)) #(#(7 8 32) #(10 11 12))))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! ((((L 1) 0) 2) 1) 32) L) 'error)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (((L 1) 4) 2) 32) L) 'error)
+(test (let ((L #(#(#(1 2 3))))) (set! ((L 0) 0 1) 32) L) #(#(#(1 32 3))))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! ((L 1 0) 2) 32) L) #(#(#(1 2 3) #(4 5 6)) #(#(7 8 32) #(10 11 12))))
+
+(test (let ((L #(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15))))
+	(set! (L 0 0 1) 32)
+	L)
+      #(#(#(#(1 2 3) 32) #(#(7 8 9) #(10 11 12))) #(13 14 15)))
+(test (let ((L #(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15))))
+	(set! ((L 0) 0 1 2) 32)
+	L)
+      #(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))
+(test (let ((L #(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15))))
+	(set! ((L 0 0) 1 2) 32)
+	L)
+      #(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))
+(test (let ((L #(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15))))
+	(set! ((L 0 0 1) 2) 32)
+	L)
+      #(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))
+(test (let ((L #(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15))))
+	(set! (((L 0) 0) 1 2) 32)
+	L)
+      #(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))
+(test (let ((L #(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15))))
+	(set! (((L 0 0) 1) 2) 32)
+	L)
+      #(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))
+(test (let ((L #(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15))))
+	(set! ((((L 0) 0) 1) 2) 32)
+	L)
+      #(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))
+
+
+(test (eq? (car (catch #t (lambda () (set! (#(1)) 2)) (lambda args args))) 'wrong-number-of-args) #t)
+(test (eq? (car (catch #t (lambda () (set! (#(1) 0 0) 2)) (lambda args args))) 'no-setter) #t)
+(test (eq? (car (catch #t (lambda () (set! ((#(1) 0) 0) 2)) (lambda args args))) 'no-setter) #t) ; (set! (1 ...))
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (eq? (car (catch #t (lambda () (set! ((L) 1) 32) L) (lambda args args))) 'wrong-number-of-args)) #t)
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (eq? (car (catch #t (lambda () (set! ((L)) 32) L) (lambda args args))) 'wrong-number-of-args)) #t)
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (eq? (car (catch #t (lambda () (set! ((L 1) 2)) L) (lambda args args))) 'syntax-error)) #t)
+
+(let ((v #(1 2 3))) (define (vr v a) (vector-ref v (+ a 1))) (test (vr v 1) 3))
+(let () (define (fillv) (let ((v (make-vector 10))) (do ((i 0 (+ i 1))) ((= i 10) v) (vector-set! v i i)))) (test (fillv) #(0 1 2 3 4 5 6 7 8 9)))
+(let () (define (fillv) (let ((v (make-vector 10))) (do ((i -10 (+ i 1))) ((= i 0) v) (vector-set! v (+ i 10) i)))) (test (fillv) #(-10 -9 -8 -7 -6 -5 -4 -3 -2 -1)))
+(let () (define (vv) (let ((v #(0 1)) (i 0) (x 2)) (vector-set! v i (+ (vector-ref v i) x)))) (test (vv) 2))
+(let () (define (hi) (let ((v1 #(0 1)) (i 0) (j 1)) (vector-set! v1 i (vector-ref v1 j)))) (hi) 1)
+(let ()
+  (define (fillv) (let ((v (make-vector '(3 3) #f boolean?))) (do ((i 0 (+ i 1))) ((= i 3) v) (vector-set! v i i #t))))
+  (test (fillv) #2d((#t #f #f) (#f #t #f) (#f #f #t))))
+(let ()
+  (define (fillv) (let ((v (make-vector '(3 3) '- symbol?))) (do ((i 0 (+ i 1))) ((= i 3) v) (vector-set! v i i '+))))
+  (test (fillv) #2d((+ - -) (- + -) (- - +))))
+(let ()
+  (define (h111)
+    (let ((v (make-vector (list 3 3))))
+      (do ((k 0 (+ k 1)))
+	  ((= k 3) v)
+	(do ((i 0 (+ i 1)))
+	    ((= i 3))
+	  (vector-set! v k i (+ i (* k 3)))))))
+  (test (h111) #2d((0 1 2) (3 4 5) (6 7 8))))
+
+(test (let ((v (immutable! (make-vector '(2 2) 0)))) (define (func) (vector-set! v 1 0 1)) (func)) 'error)
+
+;; check that we can back out when a type changes
+(let ((v (make-vector 10 1))
+      (s (make-string 10 #\a)))
+  (define (f x)
+    (set! (x 0) #\b)
+    (set! (x 1) #\b)
+    x)
+  (test (f v) #(#\b #\b 1 1 1 1 1 1 1 1)) ; unopt -> op_vector_set_3
+  (test (f v) #(#\b #\b 1 1 1 1 1 1 1 1)) ; op_vector_set_3
+  (test (f s) "bbaaaaaaaa"))              ; op_vector_set_3 -> set_unchecked -> implicit_set
+
+(let ((v (make-vector '(2 4) 1))          ; same but op_vector_set_4
+      (s (hash-table 0 #(0 0) 1 #(0 0))))
+  (define (f x)
+    (set! (x 0 0) #\b)
+    (set! (x 1 0) #\b)
+    x)
+  (test (f v) #2d((#\b 1 1 1) (#\b 1 1 1)))
+  (test (f v) #2d((#\b 1 1 1) (#\b 1 1 1)))
+  (test (f s) (hash-table 0 #(#\b 0) 1 #(#\b 0))))
+
+(test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 2)) (set! (#(a 0 (3)) 1) 0))) (f)) #t)
+(test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 2)) (let ((v (make-vector 1 'a symbol?))) (define (fv2) (set! (v 0) 'd)) (fv2) v))) (f))#t)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (vector-set! #i(1) i begin))) (func)) 'error)
+(test (let () (define-constant a51 #i(1 2 3 4)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (vector-set! a51 i begin))) (func)) 'error)
+(test (let () (define-constant a51 #i(1 2 3 4)) (define (func) (vector-set! a51 0 begin)) (func)) 'error)
+(test (let () (define-constant a51 #i(1 2 3 4)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (vector-set! a51 i begin))) (func)) 'error)
+(test (let () (define-constant a51 #i(1 2 3 4)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (int-vector-set! a51 i begin))) (func)) 'error)
+(test (let () (define-constant a51 #r(1 2 3 4)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (vector-set! a51 i begin))) (func)) 'error)
+(test (let () (define-constant a51 #u(1 2 3 4)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (vector-set! a51 i begin))) (func)) 'error)
+
+(test (let () ; vector_set_p_pip!
+        (define-constant aa4 (subvector #i2d((1 2) (3 4))))
+        (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (subvector #i(0 1 2) (vector-set! aa4 1 -1))))
+        (f))
+      'error)
+
+
+;;; --------------------------------------------------------------------------------
+;;; vector-fill!
+
+(test (fill! (vector 1 2) 4) 4)
+
+(test (let ((v (vector 1 2 3))) (vector-fill! v 0) v) #(0 0 0))
+(test (let ((v (vector))) (vector-fill! v #f) v) #())
+(let ((v (make-vector 8 #f)))
+  (for-each
+   (lambda (arg)
+     (vector-fill! v arg)
+     (test (vector-ref v 1) arg))
+   (list #\a 1 () (list 1) '(1 . 2) #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0)
+	 3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1)))))
+
+(test (let ((str "hi") (v (make-vector 3))) (vector-fill! v str) (string-set! (vector-ref v 0) 1 #\a) str) "ha")
+(test (let ((lst (list 1 2)) (v (make-vector 3))) (vector-fill! v lst) (list-set! (vector-ref v 0) 1 #\a) lst) '(1 #\a))
+
+(test (let ((v (vector 1 2 3))) (vector-set! v -1 0)) 'error)
+(test (let ((v (vector 1 2 3))) (vector-set! v 3 0)) 'error)
+(test (vector-fill! #(1 2) 2) 2)
+(test (vector-fill! #() 0) 0)
+(test (vector-fill! (vector) 0) 0)
+(test (let ((v (vector 1))) (vector-fill! v 32) (v 0)) 32)
+(test (let ((v (make-vector 11 0))) (vector-fill! v 32) (v 10)) 32)
+(test (let ((v (make-vector 16 0))) (vector-fill! v 32) (v 15)) 32)
+(test (let ((v (make-vector 3 0))) (vector-fill! v 32) (v 1)) 32)
+(test (let ((v (make-vector 3 0))) (fill! v 32) (v 1)) 32)
+(test (let ((v #2d((1 2 3) (4 5 6)))) (vector-fill! (v 1) 12) v) #2d((1 2 3) (12 12 12)))
+(test (let ((v #i(1 2))) (fill! v 3) v) #i(3 3))
+
+(for-each
+ (lambda (arg)
+   (test (vector-fill! arg 0) 'error))
+ (list "hi" #\a () 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(when with-bignums
+  (let ((v (make-vector 2 0.0)))
+    (vector-fill! v 1180591620717411303424)
+    (num-test (v 1) (expt 2 70))
+    (vector-fill! v 3/1180591620717411303424)
+    (num-test (v 0) 3/1180591620717411303424)
+    (vector-fill! v 1180591620717411303424.0)
+    (num-test (v 1) 1180591620717411303424.0)
+    (vector-fill! v (complex (expt 2 70) 1.0))
+    (num-test (v 0) (complex (expt 2 70) 1.0))
+    (set! v (float-vector 1.0))
+    (vector-fill! v (bignum "2.0"))
+    (num-test (v 0) 2.0)
+    (vector-fill! v pi)
+    (num-test (v 0) pi)
+    (set! v (float-vector 0.0 0.0 0.0))
+    (vector-fill! v (bignum "2.0") 1 2)
+    (num-test (v 0) 0.0)
+    (num-test (v 1) 2.0)
+    (set! v (make-int-vector 1))
+    (vector-fill! v (bignum "2"))
+    (num-test (v 0) 2)
+    (set! v (make-int-vector 3 0))
+    (vector-fill! v (bignum "2") 1 2)
+    (num-test (v 0) 0)
+    (num-test (v 1) 2))
+  (test (let () (define (func) (vector-fill! (make-vector 3 'a symbol?) (bignum 1/3))) (func)) 'error))
+
+(let ((v (make-vector 3)))
+  (vector-fill! v v)
+  (test (v 0) v)
+  (set! (v 1) 32)
+  (test ((v 0) 1) 32))
+
+(test (let ((v (vector 1 2 3 4 5))) (vector-fill! v 21 0) v) #(21 21 21 21 21))
+(test (let ((v (vector 1 2 3 4 5))) (vector-fill! v 21 0 5) v) #(21 21 21 21 21))
+(test (let ((v (vector 1 2 3 4 5))) (vector-fill! v 21 0 3) v) #(21 21 21 4 5))
+(test (let ((v (vector 1 2 3 4 5))) (vector-fill! v 21 2 3) v) #(1 2 21 4 5))
+(test (let ((v (vector 1 2 3 4 5))) (vector-fill! v 21 3 3) v) #(1 2 3 4 5))
+
+(if (not with-bignums) (test (let ((v (make-float-vector 3 pi))) (vector-fill! v 0.0) (vector->list v)) '(0.0 0.0 0.0)))
+(test (let ((v (make-int-vector 3 1))) (vector-fill! v "2.5")) 'error)
+(test (let ((v (make-float-vector 3 pi))) (vector-fill! v #\a)) 'error)
+(test (let ((v (make-float-vector 3))) (vector-fill! v 1+i) v) 'error)
+(test (let ((v (make-float-vector 3 0.0))) (vector-fill! v 3/4) (vector->list v)) '(0.75 0.75 0.75))
+(test (let ((v (make-float-vector 3 0.0))) (vector-fill! v 3) (vector->list v)) '(3.0 3.0 3.0))
+(test (let ((v (make-int-vector 3))) (vector-fill! v 1+i) v) 'error)
+(test (let ((v (make-int-vector 3 0))) (vector-fill! v 3/4) v) 'error)
+(test (let ((v (make-int-vector 3 0))) (vector-fill! v 3.0) v) 'error)
+
+(test (let ((v (make-int-vector 3 1))) (vector-fill! v 2 1) (vector->list v)) '(1 2 2))
+(test (let ((v (make-int-vector 3 1))) (vector-fill! v 2 1 1) (vector->list v)) '(1 1 1))
+(test (let ((v (make-int-vector 3 1))) (vector-fill! v 2 1 2) (vector->list v)) '(1 2 1))
+(test (let ((v (make-int-vector 3 1))) (vector-fill! v 2 1 3) (vector->list v)) '(1 2 2))
+(test (let ((v (make-int-vector 3 1))) (vector-fill! v 2 0 3) (vector->list v)) '(2 2 2))
+(test (let ((v (make-int-vector 3 1))) (vector-fill! v 2 1 4) (vector->list v)) 'error)
+(test (let ((v (make-int-vector 3 1))) (vector-fill! v 2 -1) (vector->list v)) 'error)
+(test (let ((v (make-float-vector 3 0.0))) (vector-fill! v 1.0 1) (vector->list v)) '(0.0 1.0 1.0))
+(test (let ((v (make-int-vector 3 1))) (vector-fill! v "2.5" 1)) 'error)
+(test (let ((v (make-float-vector 3 pi))) (vector-fill! v #\a 0 1)) 'error)
+(test (let ((v (make-float-vector 3 0.0))) (vector-fill! v 1+i 1) v) 'error)
+(test (let ((v (make-float-vector 3 0.0))) (vector-fill! v 3/4 1) (vector->list v)) '(0.0 0.75 0.75))
+(test (let ((v (make-float-vector 3))) (vector-fill! v 3 2) (vector->list v)) '(0.0 0.0 3.0))
+(test (let ((v (make-int-vector 3 0))) (vector-fill! v 1+i 2) v) 'error)
+(test (let ((v (make-int-vector 3 0))) (vector-fill! v 3/4 0 1) v) 'error)
+(test (let ((v (make-int-vector 3))) (vector-fill! v 3.0 2) v) 'error)
+(test (vector-fill! #() 0 "hi") 'error)
+(test (vector-fill! #() 0 -1 3) 'error)
+(test (vector-fill! #() 0 1) 'error)
+(test (vector-fill! #() 0 0 4/3) 'error)
+(test (vector-fill! (float-vector 1 2) 1+i) 'error)
+(test (vector-fill! (int-vector 1 2) 1+i) 'error)
+(test (let ((v1 (make-float-vector 20 0.0)) (v2 (make-float-vector 20 1.0))) (vector-fill! v1 1.0) (equivalent? v1 v2)) #t)
+
+(let ()
+  (define (boolean|integer? x)
+    (or (boolean? x)
+	(integer? x)))
+  (let ((v (make-vector 3 #f boolean|integer?)))
+    (vector-set! v 0 #t)
+    (test v #(#t #f #f))
+    (vector-set! v 1 1)
+    (test v #(#t 1 #f))
+    (test (vector-set! v 0 #\a) 'error)
+    (test v #(#t 1 #f))
+    (test (signature v) (let ((L (list 'boolean|integer? 'vector? 'integer?)))
+			  (set-cdr! (cddr L) (cddr L))
+			  L))
+    (fill! v 1)
+    (test v #(1 1 1))
+    (test (fill! v #\a) 'error)
+    (let ((v1 (make-vector 3)))
+      (copy v v1)
+      (test v1 #(1 1 1))
+    (let ((v2 (make-int-vector 3 3)))
+      (copy v2 v)
+      (test v #(3 3 3))
+    (let ((v3 (make-float-vector 3 3.0)))
+      (test (copy v3 v) 'error))))))
+
+(let ()
+  (define (vtype? x)
+    (and (symbol? x)
+         (char=? ((symbol->string x) 0) #\a)))
+  (let ((v (make-vector 3 'a vtype?)))
+    (test v #(a a a))
+    (set! (v 0) 'a1)
+    (test v #(a1 a a))
+    (test (set! (v 1) :a2) 'error) ; first char is #\:
+    (test (vector-set! v 2 'b) 'error)
+    (test (fill! v 123) 'error)))
+
+
+;;; --------------------------------------------------------------------------------
+;;; vector-append
+
+(test (vector-append #() #2d()) #())
+(test (vector-append) #())
+(test (vector-append #()) #())
+(test (vector-append #(1 2)) #(1 2))
+(test (vector-append #(1) #(2 3) #() #(4)) #(1 2 3 4))
+(test (vector-append #(1) #2d((2 3) (4 5)) #3d()) #(1 2 3 4 5))
+(test (vector-append #2d((1 2) (3 4)) #3d(((5 6) (7 8)) ((9 10) (11 12)))) #(1 2 3 4 5 6 7 8 9 10 11 12))
+
+(test (vector-append (vector 1 2) (make-int-vector 1 3) #(4)) #(1 2 3 4))
+(test (vector-append (vector 1 2) (make-float-vector 1) #(4)) #(1 2 0.0 4))
+(test (vector->list (vector-append (make-int-vector 1 3) (make-int-vector 2 1))) '(3 1 1))
+(test (vector->list (vector-append (make-float-vector 1 0.0) (make-float-vector 2 1.0))) '(0.0 1.0 1.0))
+
+(test (vector-append (byte-vector 0) (vector 1)) #u(0 1))
+(unless pure-s7 (test (vector-append (vector 1) (openlet (inlet 'vector-append (lambda args (#_vector-append (car args) #(2 3)))))) #(1 2 3)))
+
+(unless pure-s7
+  (for-each
+   (lambda (arg)
+     (test (vector-append arg) 'error)
+     (test (vector-append #(1 2) arg) 'error))
+   (list "hi" #\a () 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+	 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))))
+
+(test (equal? (make-vector 3 1) (make-int-vector 3 1)) #t)
+
+(let ((iv (make-int-vector 3 1))
+      (fv (make-float-vector 3 2.0))
+      (vv (make-vector 3 #f)))
+  (test (equal? (vector-append iv iv iv) (make-int-vector 9 1)) #t)
+  (test (vector-append iv iv vv) 'error)
+  (test (vector-append iv fv iv) 'error) ;(int-vector 1 1 1 2 2 2 1 1 1))
+  (test (vector-append iv fv fv) 'error) ;(int-vector 1 1 1 2 2 2 2 2 2))
+  (test (vector-append iv fv vv) 'error)
+  (test (vector-append iv vv iv) 'error)
+  (test (vector-append fv iv iv) (float-vector 2.0 2.0 2.0 1 1 1 1 1 1))       ; #(2.0 2.0 2.0 1 1 1 1 1 1))
+  (test (vector-append fv iv fv) (float-vector 2.0 2.0 2.0 1 1 1 2.0 2.0 2.0)) ; #(2.0 2.0 2.0 1 1 1 2.0 2.0 2.0))
+  (test (vector-append fv fv iv) (float-vector 2.0 2.0 2.0 2.0 2.0 2.0 1 1 1)) ; #(2.0 2.0 2.0 2.0 2.0 2.0 1 1 1))
+  (test (vector-append fv fv fv) (make-float-vector 9 2.0))
+  (test (vector-append fv fv vv) 'error)
+  (test (vector-append vv iv iv) #(#f #f #f 1 1 1 1 1 1))
+  (test (vector-append vv iv fv) #(#f #f #f 1 1 1 2.0 2.0 2.0))
+  (test (vector-append vv iv vv) #(#f #f #f 1 1 1 #f #f #f))
+  (test (vector-append vv fv iv) #(#f #f #f 2.0 2.0 2.0 1 1 1))
+  (test (vector-append vv fv fv) #(#f #f #f 2.0 2.0 2.0 2.0 2.0 2.0))
+  (test (vector-append vv fv vv) #(#f #f #f 2.0 2.0 2.0 #f #f #f))
+  (test (vector-append vv vv iv) #(#f #f #f #f #f #f 1 1 1))
+  (test (vector-append vv vv fv) #(#f #f #f #f #f #f 2.0 2.0 2.0))
+  (test (vector-append vv vv vv) #(#f #f #f #f #f #f #f #f #f)))
+
+(test (equal? (vector-append (float-vector 1 2 3) #()) (float-vector 1 2 3)) #t)
+(test (equal? (vector-append (float-vector) #(1 2 3) #() (make-int-vector 0 0)) (float-vector 1 2 3)) #t)
+(test (equal? (float-vector) (vector-append (float-vector))) #t)
+(test (equal? (vector-append #() (float-vector) (make-int-vector 3 1) (vector)) (make-vector 3 1)) #t)
+(test (equal? (vector-append (int-vector 1 2 3) #()) (int-vector 1 2 3)) #t)
+(test (equal? (vector-append (int-vector) #(1 2 3) #() (make-int-vector 0 0)) (int-vector 1 2 3)) #t)
+(test (equal? (int-vector) (vector-append (int-vector))) #t)
+(test (equal? (vector-append #() (int-vector) (make-int-vector 3 1) (vector)) (make-vector 3 1)) #t)
+
+(when full-s7test
+  (define (test-append size)
+    (let ((strs ())
+	  (vecs ())
+	  (fvecs ())
+	  (ivecs ())
+	  (ifvecs ())
+	  (allvecs ())
+	  (bvecs ())
+	  (lsts ()))
+      (do ((i 0 (+ i 1)))
+	  ((= i size))
+	(set! strs (cons (make-string size (integer->char (+ 1 (random 255)))) strs))
+	(set! bvecs (cons (string->byte-vector (make-string size (integer->char (random 256)))) bvecs))
+	(set! vecs (cons (make-vector size i) vecs))
+	(set! ivecs (cons (make-int-vector size i) ivecs))
+	(set! fvecs (cons (make-float-vector size (* i 1.0)) fvecs))
+	(set! ifvecs (cons (make-vector size (if (even? i) (* i 1.0) i)) ifvecs))
+	(set! allvecs (cons (make-vector size (if (even? i) (* i 1.0) i)) allvecs))
+	(set! lsts (cons (make-list size i) lsts)))
+      (let ((lst (apply append lsts))
+	    (vec (apply vector-append vecs))
+	    (fvec (apply vector-append fvecs))
+	    (ivec (apply vector-append ivecs))
+	    (ifvec (apply vector-append ifvecs))
+	    (allvec (apply vector-append allvecs))
+	    (str (apply string-append strs))
+	    (bvec (apply append bvecs)))
+	(test (vector? vec) #t)
+	(test (length vec) (* size size))
+	(test (float-vector? fvec) #t)
+	(test (length fvec) (* size size))
+	(test (int-vector? ivec) #t)
+	(test (length ivec) (* size size))
+	(test (vector? allvec) #t)
+	(test (length allvec) (* size size))
+	(test (vector? ifvec) #t)
+	(test (length ifvec) (* size size))
+	(test (pair? lst) #t)
+	(test (length lst) (* size size))
+	(test (string? str) #t)
+	(test (length str) (* size size))
+	(test (byte-vector? bvec) #t)
+	(test (length bvec) (* size size))
+	)))
+
+  (do ((i 1 (* i 10)))
+      ((> i 1000))
+    (test-append i)))
+
+(test (vector-append #i(2 1) #(2 1) #r(2.0 1.5)) 'error)
+
+(let ()
+  (define (f2)
+    (let ((x #f))
+      (do ((i 0 (+ i 1)))
+	  ((= i 1) x)
+	(set! x (vector-append (vector 0 1) (vector 2))))))
+  (test (f2) #(0 1 2)) ; vector_append_p_pp
+
+  (define (f3)
+    (let ((x #f))
+      (do ((i 0 (+ i 1)))
+	  ((= i 1) x)
+	(set! x (vector-append (vector 0 1) (vector 2) (vector 3 4))))))
+  (test (f3) #(0 1 2 3 4))) ; vector_append_p_ppp
+
+
+;;; --------------------------------------------------------------------------------
+;;; miscellaneous vectors
+
+(test (let ((sum 0)) (for-each (lambda (n) (set! sum (+ sum n))) (vector 1 2 3)) sum) 6)
+(test (let ((sum 0)) (for-each (lambda (n m) (set! sum (+ sum n (- m)))) (vector 1 2 3) (vector 4 5 6)) sum) -9)
+(test (let () (for-each (lambda (n) (error 'wrong-type-arg "oops")) (vector)) #f) #f)
+(test (let ((sum 0)) (for-each (lambda (n m p) (set! sum (+ sum n (- m) (* 2 p)))) (vector 1 2 3) (vector 4 5 6) (vector 6 7 8)) sum) 33)
+(test (let ((sum 0)) (for-each (lambda (n) (for-each (lambda (m) (set! sum (+ sum (* m n)))) (vector 1 2 3))) (vector 4 5 6)) sum) 90)
+(test (call/cc (lambda (return) (for-each (lambda (n) (return "oops")) (vector 1 2 3)))) "oops")
+(test (call/cc (lambda (return) (for-each (lambda (n) (if (even? n) (return n))) (vector 1 3 8 7 9 10)))) 8)
+
+(for-each
+ (lambda (data)
+   (let ((v data)
+	 (c #f)
+	 (y 0))
+
+     (do ((i 0 (+ i 1)))
+	 ((= i 10))
+       (set! (v i) i))
+
+     (let ((tag
+	    (call/cc
+	     (lambda (exit)
+
+	       (for-each
+		(lambda (x)
+
+		  (call/cc
+		   (lambda (return)
+		     (set! c return)))
+
+		  (if (and (even? (inexact->exact x))
+			   (> x y)
+			   (< x 10))
+		      (begin
+			(set! (v (inexact->exact y)) 100)
+			(set! y x)
+			(exit x))
+		      (set! y x)))
+		v)))))
+
+       (if (and (number? tag) (< tag 10))
+	   (c)))
+
+     (let ((correct (vector 0 100 2 100 4 100 6 100 8 9)))
+       (do ((i 0 (+ i 1)))
+	   ((= i (length v)))
+	 (if (not (= (correct i) (inexact->exact (v i))))
+	     (format #t ";for-each call/cc data: ~A~%" v))))))
+
+ (list (make-vector 10)
+       (make-list 10)))
+
+(test (map (lambda (n) (+ 1 n)) (vector 1 2 3)) '(2 3 4))
+(test (map (lambda (n m) (- n m)) (vector 1 2 3) (vector 4 5 6)) '(-3 -3 -3))
+(test (map (lambda (n m p) (+ n m p)) (vector 1 2 3) (vector 4 5 6) (vector 6 7 8)) '(11 14 17))
+(test (map (lambda (n) (map (lambda (m) (* m n)) (vector 1 2 3))) (vector 4 5 6)) '((4 8 12) (5 10 15) (6 12 18)))
+(test (call/cc (lambda (return) (map (lambda (n) (return "oops")) (vector 1 2 3)))) "oops")
+(test (call/cc (lambda (return) (map (lambda (n) (if (even? n) (return n))) (vector 1 3 8 7 9 10)))) 8)
+
+(test (map (lambda (x) x) (make-int-vector 3 0)) '(0 0 0))
+(test (map (lambda (x) x) (let ((v (make-int-vector 3 0))) (set! (v 1) 1) (set! (v 2) 2) v)) '(0 1 2))
+(test (map (lambda (x) x) (make-float-vector 3 0.0)) '(0.0 0.0 0.0))
+(test (let ((lst ())) (for-each (lambda (n) (set! lst (cons n lst))) (let ((v (make-int-vector 3 0))) (set! (v 1) 1) v)) lst) '(0 1 0))
+
+(test (vector? (symbol-table)) #t)
+
+(let ((v (make-vector 3 (vector 1 2))))
+  (test (equal? (v 0) (v 1)) #t)
+  (test (eq? (v 0) (v 1)) #t)
+  (test (eqv? (v 0) (v 1)) #t))
+
+(let ((v (vector (vector 1 2) (vector 1 2) (vector 1 2))))
+  (test (equal? (v 0) (v 1)) #t)
+  (test (eq? (v 0) (v 1)) #f)
+  (test (eqv? (v 0) (v 1)) #f))
+
+(let ((v (vector (vector (vector (vector 1 2) 3) 4) 5)))
+  (test (v 0) #(#(#(1 2) 3) 4))
+  (test (v 1) 5)
+  (test (((v 0) 0) 1) 3)
+  (test ((((v 0) 0) 0) 1) 2))
+
+(test (make-vector 1 (make-vector 1 (make-vector 1 0))) #(#(#(0))))
+(test (vector->list (let ((v (make-int-vector 3 0))) (set! (v 0) 32) (set! (v 1) -1) (set! (v 2) 2) (sort! v <))) '(-1 2 32))
+
+(let ((v1 (make-vector 3 1)))
+  (num-test (v1 1) 1)
+  (set! (v1 1) 2)
+  (num-test (v1 1) 2)
+  (let ((i0 0)
+	(i2 2))
+    (num-test (v1 i0) 1)
+    (num-test (vector-ref v1 i2) 1)
+    (set! (v1 i0) 0)
+    (num-test (v1 0) 0)
+    (set! (v1 i0) i2)
+    (num-test (v1 i0) i2))
+  (test (vector-dimensions v1) '(3))
+  (set! v1 (make-vector '(3 2)))
+  (test (vector-dimensions v1) '(3 2))
+  (vector-set! v1 1 1 0)
+  (num-test (vector-ref v1 1 1) 0)
+  (let ((i0 1)
+	(i1 1)
+	(i2 32))
+    (set! (v1 i0 i1) i2)
+    (num-test (vector-ref v1 1 1) 32)
+    (num-test (v1 i0 i1) i2)
+    (vector-set! v1 0 1 3)
+    (num-test (v1 0 1) 3)
+    (num-test (v1 1 1) 32))
+  (set! v1 (make-vector '(2 4 3) 1))
+  (test (vector-dimensions v1) '(2 4 3))
+  (num-test (vector-ref v1 1 1 1) 1)
+  (vector-set! v1 0 0 0 32)
+  (num-test (v1 0 0 0) 32)
+  (set! (v1 0 1 1) 3)
+  (num-test (v1 0 1 1) 3))
+
+(let-temporarily (((*s7* 'print-length) 32))
+  (let ((vect1 #3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2))))
+	(vect2 #2d((1 2 3 4 5 6) (7 8 9 10 11 12)))
+	(vect3 #(1 2 3 4 5 6 7 8 9 10 11 12 13 14))
+	(vect4 #3d(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12))))
+	(vect1t (make-int-vector '(2 2 3) 0)))
+    (let ((v (subvector vect1t 0 12 '(12))))
+      (set! (v 0) 1) (set! (v 1) 2) (set! (v 2) 3) (set! (v 3) 3) (set! (v 4) 4) (set! (v 5) 5)
+      (set! (v 6) 5) (set! (v 7) 6) (set! (v 8) 1) (set! (v 9) 7) (set! (v 10) 8) (set! (v 11) 2))
+    (do ((i 1 (+ i 1)))
+	((= i 15))
+      (set! (*s7* 'print-length) i)
+      (let ((str (object->string vect1)))
+	(test str (case i
+		    ((1) "#3d(((1 ...)...)...)")
+		    ((2) "#3d(((1 2 ...)...)...)")
+		    ((3) "#3d(((1 2 3)...)...)")
+		    ((4) "#3d(((1 2 3) (3 ...))...)")
+		    ((5) "#3d(((1 2 3) (3 4 ...))...)")
+		    ((6) "#3d(((1 2 3) (3 4 5))...)")
+		    ((7) "#3d(((1 2 3) (3 4 5)) ((5 ...)...))")
+		    ((8) "#3d(((1 2 3) (3 4 5)) ((5 6 ...)...))")
+		    ((9) "#3d(((1 2 3) (3 4 5)) ((5 6 1)...))")
+		    ((10) "#3d(((1 2 3) (3 4 5)) ((5 6 1) (7 ...)))")
+		    ((11) "#3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 ...)))")
+		    ((12) "#3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2)))")
+		    ((13) "#3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2)))")
+		    ((14) "#3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2)))"))))
+
+      (let ((str (object->string vect1t)))
+	(test str (case i
+		    ((1) "#i3d(((1 ...)...)...)")
+		    ((2) "#i3d(((1 2 ...)...)...)")
+		    ((3) "#i3d(((1 2 3)...)...)")
+		    ((4) "#i3d(((1 2 3) (3 ...))...)")
+		    ((5) "#i3d(((1 2 3) (3 4 ...))...)")
+		    ((6) "#i3d(((1 2 3) (3 4 5))...)")
+		    ((7) "#i3d(((1 2 3) (3 4 5)) ((5 ...)...))")
+		    ((8) "#i3d(((1 2 3) (3 4 5)) ((5 6 ...)...))")
+		    ((9) "#i3d(((1 2 3) (3 4 5)) ((5 6 1)...))")
+		    ((10) "#i3d(((1 2 3) (3 4 5)) ((5 6 1) (7 ...)))")
+		    ((11) "#i3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 ...)))")
+		    ((12) "#i3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2)))")
+		    ((13) "#i3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2)))")
+		    ((14) "#i3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2)))"))))
+
+      (let ((str (object->string vect4)))
+	(test str (case i
+		    ((1) "#3d(((1 ...)...)...)")
+		    ((2) "#3d(((1 2)...)...)")
+		    ((3) "#3d(((1 2) (3 ...)...)...)")
+		    ((4) "#3d(((1 2) (3 4)...)...)")
+		    ((5) "#3d(((1 2) (3 4) (5 ...))...)")
+		    ((6) "#3d(((1 2) (3 4) (5 6))...)")
+		    ((7) "#3d(((1 2) (3 4) (5 6)) ((7 ...)...))")
+		    ((8) "#3d(((1 2) (3 4) (5 6)) ((7 8)...))")
+		    ((9) "#3d(((1 2) (3 4) (5 6)) ((7 8) (9 ...)...))")
+		    ((10) "#3d(((1 2) (3 4) (5 6)) ((7 8) (9 10)...))")
+		    ((11) "#3d(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 ...)))")
+		    ((12) "#3d(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12)))")
+		    ((13) "#3d(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12)))")
+		    ((14) "#3d(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12)))"))))
+
+      (let ((str (object->string vect2)))
+	(test str (case i
+		    ((1) "#2d((1 ...)...)")
+		    ((2) "#2d((1 2 ...)...)")
+		    ((3) "#2d((1 2 3 ...)...)")
+		    ((4) "#2d((1 2 3 4 ...)...)")
+		    ((5) "#2d((1 2 3 4 5 ...)...)")
+		    ((6) "#2d((1 2 3 4 5 6)...)")
+		    ((7) "#2d((1 2 3 4 5 6) (7 ...))")
+		    ((8) "#2d((1 2 3 4 5 6) (7 8 ...))")
+		    ((9) "#2d((1 2 3 4 5 6) (7 8 9 ...))")
+		    ((10) "#2d((1 2 3 4 5 6) (7 8 9 10 ...))")
+		    ((11) "#2d((1 2 3 4 5 6) (7 8 9 10 11 ...))")
+		    ((12) "#2d((1 2 3 4 5 6) (7 8 9 10 11 12))")
+		    ((13) "#2d((1 2 3 4 5 6) (7 8 9 10 11 12))")
+		    ((14) "#2d((1 2 3 4 5 6) (7 8 9 10 11 12))"))))
+
+      (let ((str (object->string vect3)))
+	(test str (case i
+		    ((1) "#(1 ...)")
+		    ((2) "#(1 2 ...)")
+		    ((3) "#(1 2 3 ...)")
+		    ((4) "#(1 2 3 4 ...)")
+		    ((5) "#(1 2 3 4 5 ...)")
+		    ((6) "#(1 2 3 4 5 6 ...)")
+		    ((7) "#(1 2 3 4 5 6 7 ...)")
+		    ((8) "#(1 2 3 4 5 6 7 8 ...)")
+		    ((9) "#(1 2 3 4 5 6 7 8 9 ...)")
+		    ((10) "#(1 2 3 4 5 6 7 8 9 10 ...)")
+		    ((11) "#(1 2 3 4 5 6 7 8 9 10 11 ...)")
+		    ((12) "#(1 2 3 4 5 6 7 8 9 10 11 12 ...)")
+		    ((13) "#(1 2 3 4 5 6 7 8 9 10 11 12 13 ...)")
+		    ((14) "#(1 2 3 4 5 6 7 8 9 10 11 12 13 14)")))))
+
+    (let ((vect5 (make-vector '(2 3))))
+      (set! (vect5 0 0) vect1)
+      (set! (vect5 0 1) vect2)
+      (set! (vect5 0 2) vect3)
+      (set! (vect5 1 0) vect4)
+      (set! (vect5 1 1) (vector 1 2 3))
+      (set! (vect5 1 2) #2d())
+
+      (do ((i 1 (+ i 1)))
+	  ((= i 15))
+	(set! (*s7* 'print-length) i)
+	(let ((str (object->string vect5)))
+	  (test str (case i
+		      ((1) "#2d((#3d(((1 ...)...)...) ...)...)")
+		      ((2) "#2d((#3d(((1 2 ...)...)...) #2d((1 2 ...)...) ...)...)")
+		      ((3) "#2d((#3d(((1 2 3)...)...) #2d((1 2 3 ...)...) #(1 2 3 ...))...)")
+		      ((4) "#2d((#3d(((1 2 3) (3 ...))...) #2d((1 2 3 4 ...)...) #(1 2 3 4 ...)) (#3d(((1 2) (3 4)...)...) ...))")
+		      ((5) "#2d((#3d(((1 2 3) (3 4 ...))...) #2d((1 2 3 4 5 ...)...) #(1 2 3 4 5 ...)) (#3d(((1 2) (3 4) (5 ...))...) #(1 2 3) ...))")
+		      ((6) "#2d((#3d(((1 2 3) (3 4 5))...) #2d((1 2 3 4 5 6)...) #(1 2 3 4 5 6 ...)) (#3d(((1 2) (3 4) (5 6))...) #(1 2 3) #2d()))")
+		      ((7) "#2d((#3d(((1 2 3) (3 4 5)) ((5 ...)...)) #2d((1 2 3 4 5 6) (7 ...)) #(1 2 3 4 5 6 7 ...)) (#3d(((1 2) (3 4) (5 6)) ((7 ...)...)) #(1 2 3) #2d()))")
+		      ((8) "#2d((#3d(((1 2 3) (3 4 5)) ((5 6 ...)...)) #2d((1 2 3 4 5 6) (7 8 ...)) #(1 2 3 4 5 6 7 8 ...)) (#3d(((1 2) (3 4) (5 6)) ((7 8)...)) #(1 2 3) #2d()))")
+		      ((9) "#2d((#3d(((1 2 3) (3 4 5)) ((5 6 1)...)) #2d((1 2 3 4 5 6) (7 8 9 ...)) #(1 2 3 4 5 6 7 8 9 ...)) (#3d(((1 2) (3 4) (5 6)) ((7 8) (9 ...)...)) #(1 2 3) #2d()))")
+		      ((10) "#2d((#3d(((1 2 3) (3 4 5)) ((5 6 1) (7 ...))) #2d((1 2 3 4 5 6) (7 8 9 10 ...)) #(1 2 3 4 5 6 7 8 9 10 ...)) (#3d(((1 2) (3 4) (5 6)) ((7 8) (9 10)...)) #(1 2 3) #2d()))")
+		      ((11) "#2d((#3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 ...))) #2d((1 2 3 4 5 6) (7 8 9 10 11 ...)) #(1 2 3 4 5 6 7 8 9 10 11 ...)) (#3d(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 ...))) #(1 2 3) #2d()))")
+		      ((12) "#2d((#3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2))) #2d((1 2 3 4 5 6) (7 8 9 10 11 12)) #(1 2 3 4 5 6 7 8 9 10 11 12 ...)) (#3d(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12))) #(1 2 3) #2d()))")
+		      ((13) "#2d((#3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2))) #2d((1 2 3 4 5 6) (7 8 9 10 11 12)) #(1 2 3 4 5 6 7 8 9 10 11 12 13 ...)) (#3d(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12))) #(1 2 3) #2d()))")
+		      ((14) "#2d((#3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2))) #2d((1 2 3 4 5 6) (7 8 9 10 11 12)) #(1 2 3 4 5 6 7 8 9 10 11 12 13 14)) (#3d(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12))) #(1 2 3) #2d()))"))))))))
+(set! (*s7* 'print-length) 32)
+
+(test (object->string (make-int-vector 3 0)) "#i(0 0 0)")
+
+(let ((v (make-vector '(2 2))))
+  (set! (v 0 0) 1)
+  (set! (v 0 1) 2)
+  (set! (v 1 0) 3)
+  (set! (v 1 1) 4)
+  (set! (v 0 1) #2d((1 2) (3 4)))
+  (test (object->string v) "#2d((1 #2d((1 2) (3 4))) (3 4))"))
+
+(let ((v (make-int-vector '(2 2))))
+  (set! (v 0 0) 1)
+  (set! (v 0 1) 2)
+  (set! (v 1 0) 3)
+  (set! (v 1 1) 4)
+  (test (object->string v) "#i2d((1 2) (3 4))"))
+
+(let ((v #2d((1 2) (3 4))))
+  (set! (v 0 1) #2d((1 2) (3 4)))
+  (test (object->string v) "#2d((1 #2d((1 2) (3 4))) (3 4))"))
+
+(let ((v (make-vector '(2 3))))
+  (do ((i 0 (+ i 1)))
+      ((= i 2))
+    (do ((j 0 (+ j 1)))
+	((= j 3))
+      (set! (v i j) (list i j))))
+  (test (v 0 0) '(0 0))
+  (test ((v 1 2) 0) 1)
+  (test (v 1 2 0) 1)
+  (test (v 1 2 0 0) 'error)
+  (test (object->string v) "#2d(((0 0) (0 1) (0 2)) ((1 0) (1 1) (1 2)))"))
+
+(test (object->string (make-float-vector 3 1.0)) "#r(1.0 1.0 1.0)")
+(test (object->string (make-float-vector 3 -1.5)) "#r(-1.5 -1.5 -1.5)")
+(test (object->string (make-int-vector 3 1)) "#i(1 1 1)")
+(test (object->string (make-int-vector 3 -1)) "#i(-1 -1 -1)")
+(test (object->string (make-int-vector 0 0)) "#i()")
+(test (object->string #r()) "#r()")
+(test (object->string (make-float-vector '(3 2 0) 0.0)) "#r3d()")
+
+(test (let ((v1 (make-vector '(3 2) 1))
+	    (v2 (make-vector '(3 2) 2))
+	    (sum 0))
+	(for-each (lambda (n m) (set! sum (+ sum n m))) v1 v2)
+	sum)
+      18)
+(test (vector->list (make-vector '(2 3) 1)) '(1 1 1 1 1 1))
+(test (vector->list #2d((1 2) (3 4))) '(1 2 3 4))
+(test (list->vector '((1 2) (3 4))) #((1 2) (3 4)))
+(test (vector->list (make-vector (list 2 0))) ())
+(test (vector-dimensions #2d((1 2 3))) '(1 3))
+
+(test (#2d((1 2 3) (4 5 6)) 0 0) 1)
+(test (#2d((1 2 3) (4 5 6)) 0 1) 2)
+(test (#2d((1 2 3) (4 5 6)) 1 1) 5)
+(test (#3d(((1 2) (3 4)) ((5 6) (7 8))) 0 0 0) 1)
+(test (#3d(((1 2) (3 4)) ((5 6) (7 8))) 1 1 0) 7)
+(test (#4d((((1) (2)) ((3) (4)) ((5) (6)))) 0 0 0 0) 1)
+(test (vector? #2d((1 2) (3 4))) #t)
+(test ((#2d((1 #2d((2 3) (4 5))) (6 7)) 0 1) 1 0) 4)
+(test ((((((((((#10d((((((((((1) (1))) (((1) (1))))) (((((1) (1))) (((1) (1))))))) (((((((1) (1))) (((1) (1))))) (((((1) (1))) (((1) (1))))))))) (((((((((1) (1))) (((1) (1))))) (((((1) (1))) (((1) (1))))))) (((((((1) (1))) (((1) (1))))) (((((1) (1))) (((1) (1)))))))))) 0) 0) 0) 0) 0) 0) 0) 0) 0) 0) 1)
+(test (#10d((((((((((1) (1))) (((1) (1))))) (((((1) (1))) (((1) (1))))))) (((((((1) (1))) (((1) (1))))) (((((1) (1))) (((1) (1))))))))) (((((((((1) (1))) (((1) (1))))) (((((1) (1))) (((1) (1))))))) (((((((1) (1))) (((1) (1))))) (((((1) (1))) (((1) (1)))))))))) 0 0 0 0 0 0 0 0 0 0) 1)
+(let ((v (make-vector (make-list 100 1) 0)))
+  (test (equal? v #100d((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((0))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) #t)
+  (test (apply v (make-list 100 0)) 0)
+  (test (v 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) 0))
+
+;; eval-string here else these are read errors
+(test (eval-string "#3d(((1 2) (3 4)) ((5 6) (7)))") 'error)
+(test (eval-string "#3d(((1 2) (3 4)) ((5) (7 8)))") 'error)
+(test (eval-string "#3d(((1 2) (3 4)) (() (7 8)))") 'error)
+(test (eval-string "#3d(((1 2) (3 4)) ((5 6) (7 8 9)))") 'error)
+(test (eval-string "#3d(((1 2) (3 4)) (5 (7 8 9)))") 'error)
+(test (eval-string "#3d(((1 2) (3 4)) ((5 6) (7 . 8)))") 'error)
+(test (eval-string "#3d(((1 2) (3 4)) ((5 6) (7 8 . 9)))") 'error)
+(test (eval-string "#3d(((1 2) (3 4)) ((5 6) ()))") 'error)
+(test (eval-string "#3d(((1 2) (3 4)) ((5 6)))") 'error)
+
+(test (vector-dimensions #3d(((1 2) (3 4)) ((5 6) (7 8)))) '(2 2 2))
+(test (vector-dimensions #2d((1 2 3) (4 5 6))) '(2 3))
+(test (vector-dimensions #4d((((1) (2)) ((3) (4)) ((5) (6))))) '(1 3 2 1))
+
+(test (vector-length #3d(((1 2) (3 4)) ((5 6) (7 8)))) 8)
+(test (length #2d((1 2 3) (4 5 6))) 6)
+
+(test (#2d((1 (2) 3) (4 () 6)) 0 1) '(2))
+(test (#2d((1 (2) 3) (4 () 6)) 1 1) ())
+(test (#2d((1 (2) 3) (4 6 ())) 1 2) ())
+(test (#2d((() (2) ()) (4 5 6)) 0 2) ())
+
+(test (equal? (make-vector 0) (make-vector '(0))) #t)
+(test (equal? #() (make-vector '(0))) #t)
+
+(test (equal? #2d((1 2) (3 4)) #2d((1 2) (3 4))) #t)
+(test (eq? #2d((1 2) (3 4)) #2d((1 2) (3 4))) #f)
+(test (eqv? #2d((1 2) (3 4)) #2d((1 2) (3 4))) #f)
+(test (make-vector (1 . 2) "hi") 'error)
+(test (make-vector (cons 1 2) "hi") 'error)
+(test (equal? (make-vector 0) (vector)) #t)
+(test (equal? #() (vector)) #t)
+(test (equal? (make-int-vector 0 0) (make-int-vector 0 0)) #t)
+(test (equal? #() (make-int-vector 0 0)) #t)
+(test (equal? (make-vector '(2 0)) (make-int-vector '(2 0) 0)) #t)
+(test (equal? (make-vector '(2 0)) (make-int-vector '(0 2) 0)) #f)
+
+(let ((v (make-vector '(2 3) 0)))
+  (num-test (vector-length v) 6)
+  (test (vector-dimensions v) '(2 3))
+  (num-test (v 0 0) 0)
+  (num-test (v 1 2) 0)
+  (test (v 2 2) 'error)
+  (test (v 2 -1) 'error)
+  (test (v 2 0) 'error)
+  (set! (v 0 1) 1)
+  (num-test (v 0 1) 1)
+  (num-test (v 1 0) 0)
+  (set! (v 1 2) 2)
+  (num-test (v 1 2) 2)
+  (test (set! (v 2 2) 32) 'error)
+  (test (set! (v 1 -1) 0) 'error)
+  (test (set! (v 2 0) 0) 'error)
+  (num-test (vector-ref v 0 1) 1)
+  (num-test (vector-ref v 1 2) 2)
+  (test (vector-ref v 2 2) 'error)
+  (test (vector-ref v 1 -1) 'error)
+  (vector-set! v 1 1 64)
+  (num-test (vector-ref v 1 1) 64)
+  (num-test (vector-ref v 0 0) 0)
+  (test (vector-ref v 1 2 3) 'error)
+  (test (vector-set! v 1 2 3 4) 'error)
+  (test (v 1 1 1) 'error)
+  (test (set! (v 1 1 1) 1) 'error))
+
+
+(let ((v1 (make-vector '(3 2) 0))
+      (v2 (make-vector '(2 3) 0))
+      (v3 (make-vector '(2 3 4) 0))
+      (v4 (make-vector 6 0))
+      (v5 (make-vector '(2 3) 0)))
+  (test (equal? v1 v2) #f)
+  (test (equal? v1 v3) #f)
+  (test (equal? v1 v4) #f)
+  (test (equal? v2 v2) #t)
+  (test (equal? v3 v2) #f)
+  (test (equal? v4 v2) #f)
+  (test (equal? v5 v2) #t)
+  (test (equal? v4 v3) #f)
+  (test (vector-dimensions v3) '(2 3 4))
+  (test (vector-dimensions v4) '(6))
+  (num-test (v3 1 2 3) 0)
+  (set! (v3 1 2 3) 32)
+  (num-test (v3 1 2 3) 32)
+  (num-test (vector-length v3) 24)
+  (num-test (vector-ref v3 1 2 3) 32)
+  (vector-set! v3 1 2 3 -32)
+  (num-test (v3 1 2 3) -32)
+  (test (v3 1 2) #(0 0 0 -32))
+  (test (set! (v3 1 2) 3) 'error)
+  (test (vector-ref v3 1 2) #(0 0 0 -32))
+  (test (vector-set! v3 1 2 32) 'error))
+
+(test (let ((v #2d((1 2) (3 4)))) (vector-fill! v #t) v) #2d((#t #t) (#t #t)))
+
+(test (eval-string "#2d((1 2) #2d((3 4) 5 6))") 'error)
+(test (string=? (object->string #2d((1 2) (3 #2d((3 4) (5 6))))) "#2d((1 2) (3 #2d((3 4) (5 6))))") #t)
+(test (string=? (object->string #3d(((#2d((1 2) (3 4)) #(1)) (#3d(((1))) 6)))) "#3d(((#2d((1 2) (3 4)) #(1)) (#3d(((1))) 6)))") #t)
+
+(test (make-vector '(2 -2)) 'error)
+(test (make-vector '(2 1/2)) 'error)
+(test (make-vector '(2 1.2)) 'error)
+(test (make-vector '(2 2+i)) 'error)
+(test (make-vector '(2 "hi")) 'error)
+
+(let ((v (make-vector '(1 1 1) 32)))
+  (test (vector? v) #t)
+  (test (equal? v #()) #f)
+  (test (vector->list v) '(32))
+  (test (vector-ref v 0) '#2d((32)))
+  (test (vector-set! v 0 0) 'error)
+  (test (vector-ref v 0 0) #(32))
+  (test (vector-set! v 0 0 0) 'error)
+  (test (vector-ref v 0 0 0) 32)
+  (test (let () (vector-set! v 0 0 0 31) (vector-ref v 0 0 0)) 31)
+  (test (vector-length v) 1)
+  (test (vector-dimensions v) '(1 1 1))
+  (test (object->string v) "#3d(((31)))")
+  )
+
+(test (vector? #3d(((32)))) #t)
+(test (equal? #3d(((32))) #()) #f)
+(test (vector->list #3d(((32)))) '(32))
+(test (#3d(((32))) 0) '#2d((32)))
+(test (set! (#3d(((32))) 0) 0) 'error)
+(test (#3d(((32))) 0 0) #(32))
+(test (set! (#3d(((32))) 0 0) 0) 'error)
+(test (#3d(((32))) 0 0 0) 32)
+(test (vector-length #3d(((32)))) 1)
+(test (vector-dimensions #3d(((32)))) '(1 1 1))
+(test (object->string #3d(((32)))) "#3d(((32)))")
+
+
+(let ((v1 (make-vector '(1 0))))
+  (test (vector? v1) #t)
+  (test (equal? v1 #()) #f)
+  (test (vector->list v1) ())
+  (test (vector-ref v1 0) 'error)
+  (test (vector-set! v1 0 0) 'error)
+  (test (vector-ref v1 0 0) 'error)
+  (test (vector-set! v1 0 0 0) 'error)
+  (test (vector-length v1) 0)
+  (test (vector-dimensions v1) '(1 0))
+  (test (object->string v1) "#2d()")
+  )
+
+(let ((v2 (make-vector '(10 3 0))))
+  (test (vector? v2) #t)
+  (test (equal? v2 #()) #f)
+  (test (vector->list v2) ())
+  (test (vector-ref v2) 'error)
+  (test (vector-set! v2 0) 'error)
+  (test (vector-ref v2 0) 'error)
+  (test (vector-set! v2 0 0) 'error)
+  (test (vector-ref v2 0 0) 'error)
+  (test (vector-set! v2 0 0 0) 'error)
+  (test (vector-ref v2 1 2 0) 'error)
+  (test (vector-set! v2 1 2 0 0) 'error)
+  (test (vector-length v2) 0)
+  (test (vector-dimensions v2) '(10 3 0))
+  (test (object->string v2) "#3d()")
+  )
+
+(let ((v3 (make-vector '(10 0 3))))
+  (test (vector? v3) #t)
+  (test (equal? v3 #()) #f)
+  (test (vector->list v3) ())
+  (test (vector-ref v3) 'error)
+  (test (vector-set! v3 0) 'error)
+  (test (vector-ref v3 0) 'error)
+  (test (vector-set! v3 0 0) 'error)
+  (test (vector-ref v3 0 0) 'error)
+  (test (vector-set! v3 0 0 0) 'error)
+  (test (vector-ref v3 1 0 2) 'error)
+  (test (vector-set! v3 1 0 2 0) 'error)
+  (test (vector-length v3) 0)
+  (test (vector-dimensions v3) '(10 0 3))
+  (test (object->string v3) "#3d()")
+  )
+
+(test (((#(("hi") ("ho")) 0) 0) 1) #\i)
+(test (string-ref (list-ref (vector-ref #(("hi") ("ho")) 0) 0) 1) #\i)
+
+(test (equal? #2d() (make-vector '(0 0))) #t)
+(test (equal? #2d() (make-vector '(1 0))) #f)
+(test (equal? (make-vector '(2 2) 2) #2d((2 2) (2 2))) #t)
+(test (equal? (make-vector '(2 2) 2) #2d((2 2) (1 2))) #f)
+(test (equal? (make-vector '(1 2 3) 0) (make-vector '(1 2 3) 0)) #t)
+(test (equal? (make-vector '(1 2 3) 0) (make-vector '(1 3 2) 0)) #f)
+(test (make-vector '1 2 3) 'error)
+
+(test (set! (vector) 1) 'error)
+(test (set! (make-vector 1) 1) 'error)
+(test (equal? (make-vector 10 ()) (make-hash-table 10)) #f)
+(test (equal? #() (copy #())) #t)
+(test (equal? #2d() (copy #2d())) #t)
+(test (fill! #() 1) 1)
+(test (fill! #2d() 1) 1)
+
+(test (equal? #2d((1 2) (3 4)) (copy #2d((1 2) (3 4)))) #t)
+(test (equal? #3d() #3d(((())))) #f)
+(test (equal? #3d() #3d()) #t)
+(test (equal? #1d() #1d()) #t)
+(test (equal? #3d() #2d()) #f)
+(test (equal? #3d() (copy #3d())) #t)
+(test (equal? #2d((1) (2)) #2d((1) (3))) #f)
+(test (equal? #2d((1) (2)) (copy #2d((1) (2)))) #t)
+(test (equal? (make-vector '(3 0 1)) (make-vector '(3 0 2))) #f)
+(test (eval-string "#0d()") 'error)
+
+(let ((v #2d((1 2 3) (4 5 6))))
+  (let ((v1 (v 0))
+	(v2 (v 1)))
+    (if (not (equal? v1 #(1 2 3)))
+	(format #t ";(v 0) subvector: ~A~%" v1))
+    (if (not (equal? v2 #(4 5 6)))
+	(format #t ";(v 1) subvector: ~A~%" v2))
+    (let ((v3 (copy v1)))
+      (if (not (equal? v3 #(1 2 3)))
+	  (format #t ";(v 0) copied subvector: ~A~%" v3))
+      (if (not (= (length v3) 3))
+	  (format #t ";(v 0) copied length: ~A~%" (length v3)))
+      (if (not (equal? v3 (copy (v 0))))
+	  (format #t ";(v 0) copied subvectors: ~A ~A~%" v3 (copy (v 0)))))))
+
+(let ((v1 (make-vector '(3 2 1) #f))
+      (v2 (make-vector '(3 2 1) #f)))
+  (test (equal? v1 v2) #t)
+  (set! (v2 0 0 0) 1)
+  (test (equal? v1 v2) #f))
+(test (equal? (make-vector '(3 2 1) #f) (make-vector '(1 2 3) #f)) #f)
+
+(test (map (lambda (n) n) #2d((1 2) (3 4))) '(1 2 3 4))
+(test (let ((vals ())) (for-each (lambda (n) (set! vals (cons n vals))) #2d((1 2) (3 4))) vals) '(4 3 2 1))
+(test (map (lambda (x y) (+ x y)) #2d((1 2) (3 4)) #1d(4 3 2 1)) '(5 5 5 5))
+(test (let ((vals ())) (for-each (lambda (x y) (set! vals (cons (+ x y) vals))) #2d((1 2) (3 4)) #1d(4 3 2 1)) vals) '(5 5 5 5))
+
+(let ((v #2d((#(1 2) #(3 4)) (#2d((5 6) (7 8)) #2d((9 10 11) (12 13 14))))))
+  (test (v 0 0) #(1 2))
+  (test (v 0 1) #(3 4))
+  (test (v 1 0) #2d((5 6) (7 8)))
+  (test (v 1 1) #2d((9 10 11) (12 13 14)))
+  (test ((v 1 0) 0 1) 6)
+  (test ((v 0 1) 1) 4)
+  (test ((v 1 1) 1 2) 14))
+
+(let ((v #2d((#((1) #(2)) #(#(3) (4))) (#2d(((5) #(6)) (#(7) #(8))) #2d((#2d((9 10) (11 12)) (13)) (14 15))))))
+  (test (v 0 0) #((1) #(2)))
+  (test (v 0 1) #(#(3) (4)))
+  (test (v 1 0) #2d(((5) #(6)) (#(7) #(8))))
+  (test (v 1 1) #2d((#2d((9 10) (11 12)) (13)) (14 15)))
+  (test ((v 1 0) 0 1) #(6))
+  (test (((v 1 0) 0 1) 0) 6)
+  (test ((v 0 1) 1) '(4))
+  (test (((v 1 1) 0 0) 1 0) 11))
+
+
+(test (let ((V #2d((1 2 3) (4 5 6)))) (V 0)) #(1 2 3))
+(test (let ((V #2d((1 2 3) (4 5 6)))) (V 1)) #(4 5 6))
+(test (let ((V #2d((1 2 3) (4 5 6)))) (V 2)) 'error)
+(test (let ((V #2d((1 2 3) (4 5 6)))) (set! (V 1) 0)) 'error)
+(test (let ((V #2d((1 2 3) (4 5 6)))) (let ((V1 (V 0))) (set! (V1 1) 32) V)) '#2d((1 32 3) (4 5 6)))
+(test (let ((V #2d((1 2 3) (4 5 6)))) (let ((V1 (V 0))) (set! (V1 3) 32) V)) 'error)
+
+(test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (V 1)) '#2d((7 8 9) (10 11 12)))
+(test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (V 1 1)) #(10 11 12))
+(test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (V 0 1)) #(4 5 6))
+(test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (V 2 1)) 'error)
+(test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) ((V 0) 1)) #(4 5 6))
+(test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (((V 0) 1) 1) 32) V) '#3d(((1 2 3) (4 32 6)) ((7 8 9) (10 11 12))))
+(test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (vector-set! V 0 1 1 32) V) '#3d(((1 2 3) (4 32 6)) ((7 8 9) (10 11 12))))
+(test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (vector-set! V 1 1 0 32) V) '#3d(((1 2 3) (4 5 6)) ((7 8 9) (32 11 12))))
+(test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (vector-length (V 1))) 6)
+(test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (vector-dimensions (V 1))) '(2 3))
+(test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (vector-length (V 0 1))) 3)
+(test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (vector-dimensions (V 0 1))) '(3))
+(test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12)))) (one 1) (zero 0))
+	(let ((V1 (V one zero))
+	      (sum 0))
+	  (for-each (lambda (n) (set! sum (+ sum n))) V1)
+	  sum))
+      24) ; 7 8 9
+(test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12)))) (two 2) (one 1) (zero 0))
+	(let ((V10 (V one zero))
+	      (V00 (V zero zero))
+	      (V01 (V zero one))
+	      (V11 (V one one))
+	      (sum 0))
+	  (for-each (lambda (n0 n1 n2 n3) (set! sum (+ sum n0 n1 n2 n3))) V00 V01 V10 V11)
+	  sum))
+      78)
+
+(let-temporarily (((*s7* 'print-length) 32))
+  (test (object->string (make-vector '(8 8) 0)) "#2d((0 0 0 0 0 0 0 0) (0 0 0 0 0 0 0 0) (0 0 0 0 0 0 0 0) (0 0 0 0 0 0 0 0)...)")
+  (test (object->string (make-vector 64 0)) "#(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ...)")
+  (test (object->string (make-vector 32 0)) "#(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)")
+  (test (object->string (make-vector 33 0)) "#(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ...)")
+  (test (object->string (make-vector '(8 4) 0)) "#2d((0 0 0 0) (0 0 0 0) (0 0 0 0) (0 0 0 0) (0 0 0 0) (0 0 0 0) (0 0 0 0) (0 0 0 0))"))
+
+(let-temporarily (((*s7* 'print-length) 1024))
+  (test (object->string (make-vector '(2 1 2 1 2 1 2 1 2 1 2 1 2 1) 0)) "#14d((((((((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))) (((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))))) (((((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))) (((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))))))) (((((((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))) (((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))))) (((((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))) (((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))))))))")
+
+  (test (object->string (make-vector '(16 1 1 1 1 1 1 1 1 1 1 1 1 1) 0)) "#14d((((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))))")
+
+;;; now see if our shared vector has survived...
+  (test (and (vector? check-subvector-after-gc)
+	     (= (length check-subvector-after-gc) 6)
+	     (do ((i 0 (+ i 1))
+		  (happy #t))
+		 ((= i 6) happy)
+	       (if (or (not (pair? (check-subvector-after-gc i)))
+		       (not (equal? (check-subvector-after-gc i) (cons 3 i))))
+		   (set! happy #f))))
+	#t)
+  (set! check-subvector-after-gc #f))
+
+
+
+;;; -------- circular structures -------
+
+;;; here's an oddity:
+
+(let ((l1 (make-list 1 #f))
+      (l2 (make-list 3 #f)))
+  (set-cdr! l1 l1)
+  (set-cdr! (list-tail l2 2) l2)
+  (test (equal? l1 l2) #t))  ; but (eq? l1 (cdr l1)): #t, and (eq? l2 (cdr l2)): #f
+
+(let ((l1 (make-list 1 #f))
+      (l2 (make-list 3 #f)))
+  (set-car! l1 #t)
+  (set-car! l2 #t)
+  (set-cdr! l1 l1)
+  (set-cdr! (list-tail l2 2) l2)
+  (test (equal? l1 l2) #f))
+
+;;; Guile agrees on the first, but hangs on the second
+;;; CL says the first is false, but hangs on the second
+;;; r7rs agrees with s7 here, to my dismay.
+
+;;; other cases:
+(let ((l1 (list #f #f))
+      (l2 (list #f #f)))
+  (set-cdr! l1 l1)
+  (set-cdr! (cdr l2) l2)
+  (test (equal? l1 l2) #t))
+
+(let ((l1 (list #f #f #f))
+      (l2 (list #f #f #f)))
+  (set-cdr! (cdr l1) l1)
+  (set-cdr! (cddr l2) l2)
+  (test (equal? l1 l2) #t)) ; r7rs says #t I think, this was #f until 16-Jan-20
+
+(let ((l1 (list #f #f #f))
+      (l2 (list #f #f #f)))
+  (set-cdr! (cdr l1) l1)
+  (set-cdr! (cddr l2) (cdr l2))
+  (test (equal? l1 l2) #t))
+
+;;; Gauche says #t #f #t #t #t, as does chibi
+;;; Guile-2.0 hangs on all, as does Chicken
+
+(let ((l1 (list #t #f #f))
+      (l2 (list #t #f #t)))
+  (set-cdr! (cdr l1) l1)
+  (set-cdr! (cddr l2) (cdr l2))
+  (test (equal? l1 l2) #t))
+
+(let ((l1 (list #t #f #f))
+      (l2 (list #t #f #f #t)))
+  (set-cdr! (cddr l1) l1)
+  (set-cdr! (cdddr l2) (cdr l2))
+  (test (equal? l1 l2) #t))
+
+
+;;; cyclic-sequences
+
+(define* (make-circular-list n init)
+  (let ((l (make-list n init)))
+    (set-cdr! (list-tail l (- n 1)) l)))
+
+(define (cyclic? obj) (not (null? (cyclic-sequences obj))))
+
+(for-each
+ (lambda (arg)
+   (test (cyclic? arg) #f))
+  (list "hi" "" #\null #\a () #() 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))
+       (let ((x '(1 2))) (list x x))
+       (let ((x #(1 2))) (vector x x))
+       (let ((x "a")) (list (vector x) x))
+       (let ((x (hash-table 'a 1))) (vector x (list x x) (inlet 'b x)))
+       (let ((x '(1))) (let ((y (list x))) (list x (list y))))))
+
+(test (cyclic-sequences) 'error)
+(test (cyclic-sequences (list 1 2) (list 3 4)) 'error)
+
+(test (let ((y (make-circular-list 3))) (let ((x (cyclic-sequences y))) (list (length x) (eq? (car x) y)))) '(1 #t))
+(test (let ((y (make-circular-list 3))) (let ((x (cyclic-sequences (vector y)))) (list (length x) (eq? (car x) y)))) '(1 #t))
+(test (let ((y (make-circular-list 3))) (let ((x (cyclic-sequences (list y (vector y))))) (list (length x) (eq? (car x) y)))) '(1 #t))
+(test (let* ((y (list 1)) (x (vector y))) (set! (y 0) x) (eq? x (car (cyclic-sequences x)))) #t)
+(test (let ((x (hash-table 'a (make-circular-list 1)))) (eq? (car (cyclic-sequences x)) (x 'a))) #t)
+(test (let ((x (list (make-circular-list 1) (make-circular-list 2)))) (length (cyclic-sequences x))) 2)
+(test (let ((l1 '(1))) (let ((l2 (cons l1 l1))) (cyclic-sequences l2))) ())
+(test (let ((l1 '(1))) (let ((l2 (list l1 l1))) (cyclic-sequences l2))) ())
+(test (let ((y '(1)))
+	(let ((x (list (make-circular-list 1) y y)))
+	  (set-cdr! (cddr x) (cdr x))
+	  (let ((z (cyclic-sequences x)))
+	    (list (length z) (and (memq (cdr x) z) #t))))) ; "and" here just to make the result easier to check
+      '(2 #t))
+(test (let ((z (vector 1 2)))
+	(let ((y (list 1 z 2)))
+	  (let ((x (hash-table 'x y)))
+	    (set! (z 1) x)
+	    (length (cyclic-sequences z)))))
+      1)
+(test (let ((x '(1 2)))
+	(let ((y (list x x)))
+	  (let ((z (vector x y)))
+	    (null? (cyclic-sequences z)))))
+      #t)
+(test (let ((v (vector 1 2 3 4)))
+	(let ((lst (list 1 2)))
+	  (set-cdr! (cdr lst) lst)
+	  (set! (v 0) v)
+	  (set! (v 3) lst)
+	  (length (cyclic-sequences v))))
+      2)
+
+(test (infinite? (length (make-circular-list 3))) #t)
+(test (object->string (make-circular-list 3)) "#1=(#f #f #f . #1#)")
+
+(let ((lst (list 1 2 3)))
+   (set! (cdr (cddr lst)) lst)
+   (test (apply + lst) 'error)
+   (test (cyclic? lst) #t)
+   (test (eq? (car (cyclic-sequences lst)) lst) #t))
+
+(let ((l1 (list 1)))
+  (test (object->string (list l1 1 l1)) "((1) 1 (1))") ; was "(#1=(1) 1 #1#)"
+  (test (cyclic? (list l1 1 l1)) #f))
+
+(let ((lst (list 1 2)))
+   (set! (cdr (cdr lst)) (cdr lst))
+   (test (object->string lst) "(1 . #1=(2 . #1#))")
+   (test-wi (object->string lst :readable)
+	 "(let ((<1> (list 2)))
+            (set-cdr! <1> <1>)
+            (let ((<L> (list 1)))
+              (set-cdr! <L> <1>)
+              <L>))"))       ; (1 . #1=(2 . #1#))
+
+(let ((lst (list 1 2 3)))
+   (set! (cdr (cddr lst)) lst)
+   (test (object->string (append '(1) lst)) "(1 . #1=(1 2 3 . #1#))"))
+(let ((lst (list 1 2 3)))
+   (set! (cdr (cddr lst)) lst)
+   (test (append lst ()) 'error))
+
+(let ((lst (list 1 2 3)))
+   (set! (cdr (cddr lst)) lst)
+   (test (sort! lst <) 'error))
+
+(let ((lst (list 1 2 3)))
+   (set! (cdr (cddr lst)) lst)
+   (test (object->string (list lst)) "(#1=(1 2 3 . #1#))"))
+
+(let ((lst (list 1 2 3)))
+   (set! (cdr (cddr lst)) lst)
+   (test (object->string (make-list 4 lst)) "(#1=(1 2 3 . #1#) #1# #1# #1#)"))
+
+(let ((lst (list 1 2 3)))
+   (set! (cdr (cddr lst)) lst)
+   (test (object->string (vector lst lst)) "#(#1=(1 2 3 . #1#) #1#)"))
+
+(let ((lst `(+ 1 2 3)))
+   (set! (cdr (cdddr lst)) (cddr lst))
+   (test (object->string lst) "(+ 1 . #1=(2 3 . #1#))"))
+
+
+(let ((x (list 1 2)))
+  (test (equal? x x) #t)
+  (test (equal? x (cdr x)) #f)
+  (test (equal? x ()) #f))
+(let ((x (list 1 (list 2 3) (list (list 4 (list 5)))))
+      (y (list 1 (list 2 3) (list (list 4 (list 5))))))
+  (test (equal? x y) #t))
+(let ((x (list 1 (list 2 3) (list (list 4 (list 5)))))
+      (y (list 1 (list 2 3) (list (list 4 (list 5) 6)))))
+  (test (equal? x y) #f))
+
+(test (length ()) 0)
+(test (length (cons 1 2)) -1)
+(test (length '(1 2 3)) 3)
+
+(let ((lst1 (list 1 2)))
+  (test (length lst1) 2)
+  (list-set! lst1 0 lst1)
+  (test (length lst1) 2) ; its car is a circular list, but it isn't
+  (test (eq? ((cyclic-sequences lst1) 0) lst1) #t)
+  (test (list->string lst1) 'error)
+  (let ((lst2 (list 1 2)))
+    (set-car! lst2 lst2)
+    (test (equal? lst1 lst2) #t)
+    (test (equivalent? lst1 lst2) #t)
+    (test (eq? lst1 lst2) #f)
+    (test (eqv? lst1 lst2) #f)
+    (test (pair? lst1) #t)
+    (test (null? lst1) #f)
+    (test (car lst2) lst2)
+    (test (car lst1) lst1)
+    (test (let ()
+	    (fill! lst1 32)
+	    lst1)
+	  '(32 32))))
+
+(let ((lst1 (list 1)))
+  (test (length lst1) 1)
+  (set-cdr! lst1 lst1)
+  (test (infinite? (length lst1)) #t)
+  (test (eq? (cdr ((cyclic-sequences lst1) 0)) lst1) #t)
+  (test (null? lst1) #f)
+  (test (pair? lst1) #t)
+  (let ((lst2 (cons 1 ())))
+    (set-cdr! lst2 lst2)
+    (test (equal? lst1 lst2) #t)
+    (test (equivalent? lst1 lst2) #t)
+    (set-car! lst2 0)
+    (test (equal? lst1 lst2) #f)
+    (test (equivalent? lst1 lst2) #f)
+    (test (infinite? (length lst2)) #t)))
+
+(let ((lst1 (list 1)))
+  (set-cdr! lst1 lst1)
+  (test (list-tail lst1 0) lst1)
+  (test (list-tail lst1 3) lst1)
+  (test (list-tail lst1 10) lst1))
+
+(let ((lst1 (let ((lst (list 'a)))
+	      (set-cdr! lst lst)
+	      lst)))
+  (test (apply lambda lst1 (list 1)) 'error)) ; lambda parameter 'a is used twice in the lambda argument list !
+
+(let ((lst1 (list 1))
+      (lst2 (list 1)))
+  (set-car! lst1 lst2)
+  (set-car! lst2 lst1)
+  (test (equal? lst1 lst2) #t)
+  (test (equivalent? lst1 lst2) #t)
+  (test (length lst1) 1)
+  (let ((lst3 (list 1)))
+    (test (equal? lst1 lst3) #f)
+    (test (equivalent? lst1 lst3) #f)
+    (set-cdr! lst3 lst3)
+    (test (equal? lst1 lst3) #f)
+    (test (equivalent? lst1 lst3) #f)))
+
+(let ((lst1 (list 'a 'b 'c)))
+  (set! (cdr (cddr lst1)) lst1)
+  (test (infinite? (length lst1)) #t)
+  (test (memq 'd lst1) #f)
+  (test (memq 'a lst1) lst1)
+  (test (memq 'b lst1) (cdr lst1)))
+
+(let ((lst1 (list 1 2 3)))
+  (list-set! lst1 1 lst1)
+  (test (object->string lst1) "#1=(1 #1# 3)"))
+
+(let ((lst1 (let ((lst (list 1)))
+	      (set-cdr! lst lst)
+	      lst)))
+  (test (list-ref lst1 9223372036854775807) 'error)
+  (test (list-set! lst1 9223372036854775807 2) 'error)
+  (test (list-tail lst1 9223372036854775807) 'error)
+  (test (make-vector lst1 9223372036854775807) 'error)
+  (let-temporarily (((*s7* 'safety) 1))
+    (test (not (member (map (lambda (x) x) lst1) '(() (1)))) #f) (newline) ; geez -- just want to allow two possible ok results, so "not" makes it boolean
+    (test (not (member (map (lambda (x y) x) lst1 lst1) '(() (1)))) #f)
+    (test (for-each (lambda (x) x) lst1) #<unspecified>) ; was 'error
+    (test (for-each (lambda (x y) x) lst1 lst1) #<unspecified>) ; was 'error
+    (test (not (member (map (lambda (x y) (+ x y)) lst1 '(1 2 3)) (list () '(2)))) #f)))
+
+(test (map abs (let ((lst (list 0))) (set! (cdr lst) lst))) '(0))
+(test (map (lambda (x) x) (let ((lst (list 0))) (set! (cdr lst) lst))) '(0))
+(test (map abs (let ((lst (list 0 1))) (set-cdr! (cdr lst) lst))) '(0 1 0))
+(test (map (lambda (x) x) (let ((lst (list 0 1))) (set-cdr! (cdr lst) lst))) '(0 1))
+
+(let ((lst1 (list 1 -1)))
+  (set-cdr! (cdr lst1) lst1)
+  (let ((vals (map * '(1 2 3 4) lst1)))
+    (test vals '(1 -2 3)))) ; was '(1 -2 3 -4), then later (1 -2) -- as in other cases above, map/for-each stop when a cycle is encountered
+
+(test (let ((lst '(a b c)))
+	(set! (cdr (cddr lst)) lst)
+	(map cons lst '(0 1 2 3 4 5)))
+      '((a . 0) (b . 1) (c . 2) (a . 3) (b . 4))) ; as above
+
+(test (object->string (let ((l1 (list 0 1))) (set! (l1 1) l1) (copy l1))) "(0 #1=(0 #1#))")
+
+;;; this changed 11-Mar-15
+;;;(test (object->string (let ((lst (list 1 2))) (set! (cdr lst) lst) (copy lst))) "(1 . #1=(1 . #1#))")
+(test (object->string (let ((lst (list 1 2))) (set! (cdr lst) lst) (copy lst))) "#1=(1 . #1#)")
+(test (object->string (let ((lst (list 1 2))) (set! (cdr lst) lst) lst))        "#1=(1 . #1#)")
+
+(test (object->string (let ((l1 (list 1 2))) (copy (list l1 4 l1)))) "((1 2) 4 (1 2))") ; was "(#1=(1 2) 4 #1#)"
+;;;(test (object->string (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) (cdr lst)) (copy lst))) "(1 2 3 . #1=(2 3 . #1#))")
+(test (object->string (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) (cdr lst)) (copy lst))) "(1 . #1=(2 3 . #1#))")
+(test (object->string (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) (cdr lst)) lst))        "(1 . #1=(2 3 . #1#))")
+
+(test (object->string (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) (cddr lst)) (copy lst))) "(1 2 . #1=(3 . #1#))")
+(test (object->string (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) (cddr lst)) lst))        "(1 2 . #1=(3 . #1#))")
+
+;;;(test (object->string (let ((lst (list 1 2 3 4))) (set! (cdr (cdddr lst)) (cddr lst)) (copy lst))) "(1 2 3 4 . #1=(3 4 . #1#))")
+(test (object->string (let ((lst (list 1 2 3 4))) (set! (cdr (cdddr lst)) (cddr lst)) (copy lst))) "(1 2 . #1=(3 4 . #1#))")
+(test (object->string (let ((lst (list 1 2 3 4))) (set! (cdr (cdddr lst)) (cddr lst)) lst))        "(1 2 . #1=(3 4 . #1#))")
+
+;;;(test (object->string (let ((lst (list 1 2 3 4))) (set! (cdr (cdddr lst)) (cdr lst)) (copy lst))) "(1 2 3 4 . #1=(2 3 4 . #1#))")
+(test (object->string (let ((lst (list 1 2 3 4))) (set! (cdr (cdddr lst)) (cdr lst)) (copy lst))) "(1 . #1=(2 3 4 . #1#))")
+(test (object->string (let ((lst (list 1 2 3 4))) (set! (cdr (cdddr lst)) (cdr lst)) lst))        "(1 . #1=(2 3 4 . #1#))")
+
+(test (object->string (vector (let ((lst (list 1))) (set-cdr! lst lst)))) "#(#1=(1 . #1#))")
+(test (object->string (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (set! (car lst) (vector lst)) lst)) "#1=(#(#1#) 2 . #1#)")
+
+(test-wi (object->string (vector (let ((lst (list 1))) (set-cdr! lst lst))) :readable) ; #(#1=(1 . #1#))
+      "(let ((<1> (list 1)))
+         (set-cdr! <1> <1>)
+         (vector <1>))")  ; #(#1=(1 . #1#))
+
+(test-wi (object->string (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (set! (car lst) (vector lst)) lst) :readable) ; #1=(#(#1#) 2 . #1#)
+      "(let ((<1> (list #f 2)))
+         (set-car! <1> (vector <1>))
+         (set-cdr! (cdr <1>) <1>)
+         <1>)")  ;  #1=(#(#1#) 2 . #1#)
+
+(test-wi (let ((v (vector 1 2))) (set! (v 0) v) (object->string v :readable)) ; #1=#(#1# 2)
+      "(let ((<1> (vector #f 2)))
+         (set! (<1> 0) <1>)
+         <1>)")  ;  #1=#(#1# 2)
+
+(test-wi (let ((v (make-vector '(2 2) 0))) (set! (v 1 1) v) (object->string v :readable)) ; #1=#2d((0 0) (0 #1#))
+      "(let ((<1> (subvector (vector 0 0 0 #f) 0 4 '(2 2))))
+         (set! (<1> 1 1) <1>)
+         <1>)")  ;  #1=#2d((0 0) (0 #1#))
+
+(test (reverse '(1 2 (3 4))) '((3 4) 2 1))
+(test (reverse '(1 2 3)) '(3 2 1))
+(test (reverse ()) ())
+(test (let ((lst (list 1 2 3))) (set! (lst 2) lst) (object->string (reverse lst))) "(#1=(1 2 #1#) 2 1)")
+(test (let ((l1 (cons 1 ()))) (set-cdr! l1 l1) (object->string (reverse l1))) "(#1=(1 . #1#) 1 1 1)")
+
+
+(test (equal? (vector 0) (vector 0)) #t)
+(test (equal? (vector 0 #\a "hi" (list 1 2 3)) (vector 0 #\a "hi" (list 1 2 3))) #t)
+(test (let ((v (vector 0))) (equal? (vector v) (vector v))) #t)
+
+(let ((v1 (make-vector 1 0)))
+  (set! (v1 0) v1)
+  (test (vector? v1) #t)
+  (let ((v2 (vector 0)))
+    (vector-set! v2 0 v2)
+    (test (vector-length v1) 1)
+    (test (equal? v1 v2) #t)
+    (test (equal? (vector-ref v1 0) v1) #t)
+    (test (equal? (vector->list v1) (list v1)) #t)
+    (vector-fill! v1 0)
+    (test (equal? v1 (vector 0)) #t)
+    (let ((v3 (copy v2)))
+      (test (equal? v2 v3) #t)
+      (vector-set! v3 0 0)
+      (test (equal? v3 (vector 0)) #t))
+    ))
+
+(let ((v1 (make-vector 1 0))
+      (v2 (vector 0)))
+  (set! (v1 0) v2)
+  (set! (v2 0) v1)
+  (test (equal? v1 v2) #t))
+
+(test (vector? (let ((v (vector 0))) (set! (v 0) v) (v 0 0 0 0))) #t) ; ?
+
+(let* ((l1 (list 1 2))
+       (v1 (vector 1 2))
+       (l2 (list 1 l1 2))
+       (v2 (vector l1 v1 l2)))
+  (vector-set! v1 0 v2)
+  (list-set! l1 1 l2)
+  (test (equal? v1 v2) #f))
+
+(let ((v1 (make-vector 1 0)))
+  (set! (v1 0) v1)
+  (let ((v2 (vector 0)))
+    (vector-set! v2 0 v2)
+    (test (equal? v1 v2) #t)))
+
+(let ((v1 (make-vector 1 0)))
+  (set! (v1 0) v1)
+  (test (eq? ((cyclic-sequences v1) 0) v1) #t)
+  (test (object->string v1) "#1=#(#1#)"))
+
+(let ((l1 (cons 0 ())))
+  (set-cdr! l1 l1)
+  (test (list->vector l1) 'error))
+
+(let ((lst (list "nothing" "can" "go" "wrong")))
+  (let ((slst (cddr lst))
+	(result ()))
+    (set! (cdr (cdddr lst)) slst)
+    (test (do ((i 0 (+ i 1))
+	       (l lst (cdr l)))
+	      ((or (null? l) (= i 12))
+	       (reverse result))
+	    (set! result (cons (car l) result)))
+	  '("nothing" "can" "go" "wrong" "go" "wrong" "go" "wrong" "go" "wrong" "go" "wrong"))))
+
+#|
+;;; here is a circular function
+(let ()
+  (define (cfunc)
+    (begin
+      (display "cfunc! ")
+      #f))
+
+  (let ((clst (procedure-source cfunc)))
+    (set! (cdr (cdr (car (cdr (cdr clst)))))
+	  (cdr (car (cdr (cdr clst))))))
+
+  (cfunc))
+|#
+
+(test (let ((l (list 1 2)))
+	(list-set! l 0 l)
+	(string=? (object->string l) "#1=(#1# 2)"))
+      #t)
+(test (let ((lst (list 1)))
+	(set! (car lst) lst)
+	(set! (cdr lst) lst)
+	(string=? (object->string lst) "#1=(#1# . #1#)"))
+      #t)
+(test (let ((lst (list 1)))
+	(set! (car lst) lst)
+	(set! (cdr lst) lst)
+	(equal? (car lst) (cdr lst)))
+      #t)
+(test (let ((lst (cons 1 2)))
+	(set-cdr! lst lst)
+	(string=? (object->string lst) "#1=(1 . #1#)"))
+      #t)
+(test (let ((lst (cons 1 2)))
+	(set-car! lst lst)
+	(string=? (object->string lst) "#1=(#1# . 2)"))
+      #t)
+(test (let ((lst (cons (cons 1 2) 3)))
+	(set-car! (car lst) lst)
+	(string=? (object->string lst) "#1=((#1# . 2) . 3)"))
+      #t)
+(test (let ((v (vector 1 2)))
+	(vector-set! v 0 v)
+	(string=? (object->string v) "#1=#(#1# 2)"))
+      #t)
+(test (let* ((l1 (list 1 2)) (l2 (list l1)))
+	(list-set! l1 0 l1)
+	(string=? (object->string l2) "(#1=(#1# 2))"))
+      #t)
+
+(test (let ((lst (list 1 2 3))) (set! (cdr (cdr (cdr lst))) lst) (object->string lst)) "#1=(1 2 3 . #1#)")
+(test (let ((lst (list 1 2 3))) (set! (cdr (cdr (cdr lst))) (cdr lst)) (object->string lst)) "(1 . #1=(2 3 . #1#))")
+(test (let ((lst (list 1 2 3))) (set! (cdr (cdr (cdr lst))) (cdr (cdr lst))) (object->string lst)) "(1 2 . #1=(3 . #1#))")
+(test (let ((lst (list 1 2 3))) (set! (car lst) (cdr lst)) (object->string lst)) "((2 3) 2 3)") ; was "(#1=(2 3) . #1#)"
+(test (let ((lst (list 1 2 3))) (set! (car (cdr lst)) (cdr lst)) (object->string lst)) "(1 . #1=(#1# 3))")
+(test (let ((lst (list 1 2 3))) (set! (car (cdr lst)) lst) (object->string lst)) "#1=(1 #1# 3)")
+(test (let ((l1 (list 1))) (let ((l2 (list l1 l1))) (object->string l2))) "((1) (1))") ; was "(#1=(1) #1#)"
+
+(let ((v (vector #f)))
+  (vector-set! v 0 v)
+  (test (with-output-to-string
+	  (lambda ()
+	    (display v)
+	    (newline)
+	    (display (subvector v 0 1))
+	    (newline)))
+	"#1=#(#1#)\n#(#1=#(#1#))\n"))
+
+(let ((v (make-vector '(2 2) #f)))
+  (fill! v v)
+  (test (with-output-to-string
+	  (lambda ()
+	    (display v)
+	    (newline)
+	    (display (subvector v 0 4))
+	    (newline)))
+	"#1=#2d((#1# #1#) (#1# #1#))\n#(#1=#2d((#1# #1#) (#1# #1#)) #1# #1# #1#)\n"))
+
+(test (let* ((v1 (vector 1 2)) (v2 (vector v1)))
+	(vector-set! v1 1 v1)
+	(string=? (object->string v2) "#(#1=#(1 #1#))"))
+      #t)
+(test (let ((v1 (make-vector 3 1)))
+	(vector-set! v1 0 (cons 3 v1))
+	(string=? (object->string v1) "#1=#((3 . #1#) 1 1)"))
+      #t)
+(test (let ((h1 (make-hash-table 11))
+	    (old-print-length (*s7* 'print-length)))
+	(set! (*s7* 'print-length) 32)
+	(hash-table-set! h1 "hi" h1)
+	(let ((result (object->string h1)))
+	  (set! (*s7* 'print-length) old-print-length)
+	  (let ((val (string=? result "#1=(hash-table \"hi\" #1#)")))
+	    (unless val
+	      (format #t ";hash display:~%  ~A~%" result))
+	    val)))
+      #t)
+
+(test (let* ((l1 (list 1 2))
+	     (v1 (vector 1 2))
+	     (l2 (list 1 l1 2))
+	     (v2 (vector l1 v1 l2)))
+	(vector-set! v1 0 v2)
+	(list-set! l1 1 l2)
+	(string=? (object->string v2) "#2=#(#1=(1 #3=(1 #1# 2)) #(#2# 2) #3#)"))
+      #t)
+
+(test (let ((l1 (list 1 2))
+	    (l2 (list 1 2)))
+	(set! (car l1) l2)
+	(set! (car l2) l1)
+	(object->string (list l1 l2)))
+      "(#1=(#2=(#1# 2) 2) #2#)")
+
+(test (let* ((l1 (list 1 2))
+	     (l2 (list 3 4))
+	     (l3 (list 5 l1 6 l2 7)))
+	(set! (cdr (cdr l1)) l1)
+	(set! (cdr (cdr l2)) l2)
+	(string=? (object->string l3) "(5 #1=(1 2 . #1#) 6 #2=(3 4 . #2#) 7)"))
+      #t)
+(test (let* ((lst1 (list 1 2))
+	     (lst2 (list (list (list 1 (list (list (list 2 (list (list (list 3 (list (list (list 4 lst1 5))))))))))))))
+	(set! (cdr (cdr lst1)) lst1)
+	(string=? (object->string lst2) "(((1 (((2 (((3 (((4 #1=(1 2 . #1#) 5))))))))))))"))
+      #t)
+
+
+(test (equal? '(a) (list 'a)) #t)
+(test (equal? '(a b . c) '(a b . c)) #t)
+(test (equal? '(a b (c . d)) '(a b (c . d))) #t)
+(test (equal? (list "hi" "hi" "hi") '("hi" "hi" "hi")) #t)
+(let ((l1 (list "hi" "hi" "hi"))
+      (l2 (list "hi" "hi" "hi")))
+  (fill! l1 "ho")
+  (test (equal? l1 l2) #f)
+  (fill! l2 (car l1))
+  (test (equal? l1 l2) #t))
+(let ((lst (list 1 2 3 4)))
+  (fill! lst "hi")
+  (test (equal? lst '("hi" "hi" "hi" "hi")) #t))
+(let ((vect (vector 1 2 3 4)))
+  (fill! vect "hi")
+  (test (equal? vect #("hi" "hi" "hi" "hi")) #t))
+(let ((lst (list 1 2 (list 3 4) (list (list 5) 6))))
+  (test (equal? lst '(1 2 (3 4) ((5) 6))) #t)
+  (fill! lst #f)
+  (test (equal? lst '(#f #f #f #f)) #t))
+(let ((lst (list 1 2 3 4)))
+  (set! (cdr (cdddr lst)) lst)
+  (test (equal? lst lst) #t)
+  (test (eq? lst lst) #t)
+  (test (eqv? lst lst) #t)
+  (fill! lst #f)
+  (test (object->string lst) "#1=(#f #f #f #f . #1#)")
+  (let ((l1 (copy lst)))
+    (test (equal? lst l1) #t)
+    (test (eq? lst l1) #f)
+    (test (eqv? lst l1) #f)))
+
+
+(let ((lst '(#\( #\) #\* #\+ #\, #\- #\. #\/ #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\: #\; #\< #\= #\> #\? #\@ #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z #\[ #\\ #\] #\^ #\_ #\` #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z #\{ #\| #\} #\~)))
+  (let ((str (apply string lst)))
+    (let ((lstr (list->string lst)))
+      (let ((strl (string->list str)))
+	(test (eq? str str) #t)
+	(test (eq? str lstr) #f)
+	(test (eqv? str str) #t)
+	(test (eqv? str lstr) #f)
+	(test (equal? str lstr) #t)
+	(test (equal? str str) #t)
+	(test (eq? lst strl) #f)
+	(test (eqv? lst strl) #f)
+	(test (equal? lst strl) #t)
+	(let ((l2 (copy lst))
+	      (s2 (copy str)))
+	  (test (eq? l2 lst) #f)
+	  (test (eq? s2 str) #f)
+	  (test (eqv? l2 lst) #f)
+	  (test (eqv? s2 str) #f)
+	  (test (equal? l2 lst) #t)
+	  (test (equal? s2 str) #t))))))
+
+
+(let ((vect #(#\( #\) #\* #\+ #\, #\- #\. #\/ #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\: #\; #\< #\= #\> #\? #\@ #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z #\[ #\\ #\] #\^ #\_ #\` #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z #\{ #\| #\} #\~)))
+  (let ((lst (vector->list vect)))
+    (let ((vect1 (list->vector lst)))
+	(test (eq? lst lst) #t)
+	(test (eq? lst vect) #f)
+	(test (eqv? lst lst) #t)
+	(test (eqv? lst vect) #f)
+	(test (equal? vect1 vect) #t)
+	(test (equal? lst lst) #t)
+	(test (eq? vect vect1) #f)
+	(test (eqv? vect vect1) #f)
+	(test (equal? vect vect1) #t)
+	(let ((l2 (copy vect))
+	      (s2 (copy lst)))
+	  (test (eq? l2 vect) #f)
+	  (test (eq? s2 lst) #f)
+	  (test (eqv? l2 vect) #f)
+	  (test (eqv? s2 lst) #f)
+	  (test (equal? l2 vect) #t)
+	  (test (equal? s2 lst) #t)))))
+
+(let* ((vals (list "hi" #\A 1 'a #(1) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0)
+		   3.14 3/4 1.0+1.0i #\f '(1 . 2)))
+       (vlen (length vals)))
+  (define (fillv size vect)
+    (do ((n 0 (+ n 1)))
+	((= n size))
+      (let ((choice (random 4))
+	    (len (random 4)))
+	(if (= choice 0)
+	    (let ((v (make-vector len)))
+	      (do ((k 0 (+ k 1)))
+		  ((= k len))
+		(vector-set! v k (list-ref vals (random vlen))))
+	      (vector-set! vect n v))
+	    (if (= choice 1)
+		(let ((lst (make-list len #f)))
+		  (do ((k 0 (+ k 1)))
+		      ((= k len))
+		    (list-set! lst k (list-ref vals (random vlen))))
+		  (vector-set! vect n lst))
+		(vector-set! vect n (list-ref vals (random vlen))))))))
+  (do ((i 0 (+ i 1)))
+      ((= i 20))
+    (let* ((size (max 1 (random 20)))
+	   (vect (make-vector size ())))
+      (fillv size vect)
+      (test (eq? vect vect) #t)
+      (test (eqv? vect vect) #t)
+      (test (equal? vect vect) #t)
+      (let ((lst1 (vector->list vect)))
+	(let ((lst2 (copy lst1)))
+	  (test (eq? lst1 lst2) #f)
+	  (test (eqv? lst1 lst2) #f)
+	  (test (equal? lst1 lst2) #t))))))
+
+(let* ((lst1 (list 1 2 3))
+       (vec1 (vector 1 2 lst1)))
+  (list-set! lst1 2 vec1)
+  (let* ((lst2 (list 1 2 3))
+	 (vec2 (vector 1 2 lst2)))
+    (list-set! lst2 2 vec2)
+    (test (equal? lst1 lst2) #t)
+    (test (equal? vec1 vec2) #t)
+    (vector-set! vec1 1 vec1)
+    (test (equal? lst1 lst2) #f)
+    (test (equal? vec1 vec2) #f)
+    ))
+
+(let* ((base (list #f))
+       (lst1 (list 1 2 3))
+       (vec1 (vector 1 2 base)))
+  (list-set! lst1 2 vec1)
+  (let* ((lst2 (list 1 2 3))
+	 (vec2 (vector 1 2 base)))
+    (list-set! lst2 2 vec2)
+    (set! (car lst1) lst1)
+    (set! (car lst2) lst2)
+    (set! (cdr (cddr lst1)) base)
+    (set! (cdr (cddr lst2)) base)
+    (test (length (cyclic-sequences lst2)) 1)
+    (test (equal? lst1 lst2) #t)
+    (test (equal? vec1 vec2) #t)
+    (test (object->string lst1) "#1=(#1# 2 #(1 2 (#f)) #f)"))) ; was "#1=(#1# 2 #(1 2 #2=(#f)) . #2#)"
+
+(let ((base (list 0 #f)))
+  (let ((lst1 (list 1 base 2))
+	(lst2 (list 1 base 2)))
+    (set! (cdr (cdr base)) base)
+    (test (equal? lst1 lst2) #t)))
+
+(let ((base1 (list 0 #f))
+      (base2 (list 0 #f)))
+  (let ((lst1 (list 1 base1 2))
+	(lst2 (list 1 base2 2)))
+    (set! (cdr (cdr base1)) lst2)
+    (set! (cdr (cdr base2)) lst1)
+    (test (equal? lst1 lst2) #t)
+    (test (object->string lst1) "#1=(1 (0 #f 1 (0 #f . #1#) 2) 2)")))
+
+(let ()
+  (define-macro (c?r path)
+
+    (define (X-marks-the-spot accessor tree)
+      (if (eq? tree 'X)
+          accessor
+          (and (pair? tree)
+	       (or (X-marks-the-spot (cons 'car accessor) (car tree))
+	           (X-marks-the-spot (cons 'cdr accessor) (cdr tree))))))
+
+    (let ((body 'lst))
+      (for-each
+       (lambda (f)
+	 (set! body (list f body)))
+       (reverse (X-marks-the-spot () path)))
+
+      `(dilambda
+	(lambda (lst)
+	  ,body)
+	(lambda (lst val)
+	  (set! ,body val)))))
+
+  (define (copy-tree lis)
+    (if (pair? lis)
+	(cons (copy-tree (car lis))
+	      (copy-tree (cdr lis)))
+	lis))
+
+  (let* ((l1 '(0 (1 (2 (3 (4 (5 (6 (7 (8))))))))))
+	 (l2 (list 0 (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 (list 7 (list 8))))))))))
+	 (l3 (copy-tree l1))
+	 (cxr (c?r (0 (1 (2 (3 (4 (5 (6 (7 (X))))))))))))
+    (set! (cxr l1) 3)
+    (set! (cxr l2) 4)
+    (test (equal? l1 l2) #f)
+    (test (equal? l1 l3) #f)
+    (set! (cxr l2) 3)
+    (test (cxr l2) 3)
+    (test (cxr l1) 3)
+    (test (cxr l3) 8)
+    (test (equal? l1 l2) #t)
+    (test (equal? l2 l3) #f))
+
+  (let* ((l1 '(0 (1 (2 (3 (4 (5 (6 (7 (8))))))))))
+	 (l2 (list 0 (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 (list 7 (list 8))))))))))
+	 (l3 (copy-tree l1))
+	 (cxr (c?r (0 (1 (2 (3 (4 (5 (6 (7 (8 . X))))))))))))
+    (set! (cxr l1) l1)
+    (set! (cxr l2) l2)
+    (test (equal? l1 l2) #t)
+    (test (equal? l1 l3) #f)
+    (test (object->string l2) "#1=(0 (1 (2 (3 (4 (5 (6 (7 (8 . #1#)))))))))"))
+
+  (let* ((l1 '(0 ((((((1))))))))
+	 (l2 (copy-tree l1))
+	 (cxr (c?r (0 ((((((1 . X))))))))))
+    (set! (cxr l1) l2)
+    (set! (cxr l2) l1)
+    (test (equal? l1 l2) #t))
+
+  (let* ((l1 '(0 1 (2 3) 4 5))
+	 (cxr (c?r (0 1 (2 3 . X) 4 5))))
+    (set! (cxr l1) (cdr l1))
+    (test (object->string l1) "(0 . #1=(1 (2 3 . #1#) 4 5))"))
+
+  (let* ((l1 '(0 1 (2 3) 4 5))
+	 (l2 '(6 (7 8 9) 10))
+	 (cxr1 (c?r (0 1 (2 3 . X) 4 5)))
+	 (cxr2 (c?r (6 . X)))
+	 (cxr3 (c?r (6 (7 8 9) 10 . X)))
+	 (cxr4 (c?r (0 . X))))
+    (set! (cxr1 l1) (cxr2 l2))
+    (set! (cxr3 l2) (cxr4 l1))
+    (test (object->string l1) "(0 . #1=(1 (2 3 (7 8 9) 10 . #1#) 4 5))")
+    (test (cadr l1) 1)
+    (test (cadddr l1) 4)
+    )
+
+  (let ((l1 '((a . 2) (b . 3) (c . 4)))
+	(cxr (c?r ((a . 2) (b . 3) (c . 4) . X))))
+    (set! (cxr l1) (cdr l1))
+    (test (assq 'a l1) '(a . 2))
+    (test (assv 'b l1) '(b . 3))
+    (test (assoc 'c l1) '(c . 4))
+    (test (object->string l1) "((a . 2) . #1=((b . 3) (c . 4) . #1#))")
+    (test (assq 'asdf l1) #f)
+    (test (assv 'asdf l1) #f)
+    (test (assoc 'asdf l1) #f)
+    )
+
+  (let ((l1 '(a b c d e))
+	(cxr (c?r (a b c d e . X))))
+    (set! (cxr l1) (cddr l1))
+    (test (memq 'b l1) (cdr l1))
+    (test (memv 'c l1) (cddr l1))
+    (test (member 'd l1) (cdddr l1))
+    (test (object->string l1) "(a b . #1=(c d e . #1#))")
+    (test (memq 'asdf l1) #f)
+    (test (memv 'asdf l1) #f)
+    (test (member 'asdf l1) #f)
+    (test (pair? (member 'd l1)) #t) ; #1=(d e c . #1#)
+    )
+
+  (let ((x 0))
+    (let ((lst `(call-with-exit (lambda (return) (set! x (+ x 1)) (if (> x 10) (return x) 0)))))
+      (let ((acc1 (c?r (call-with-exit (lambda (return) . X))))
+	    (acc2 (c?r (call-with-exit (lambda (return) (set! x (+ x 1)) (if (> x 10) (return x) 0) . X)))))
+	(set! (acc2 lst) (acc1 lst))
+	(test (eval lst (curlet)) 11))))
+  )
+
+
+(let ()
+  ;; anonymous recursion...
+  (define (fc?r path)
+    (define (X-marks-the-spot accessor tree)
+      (if (pair? tree)
+	  (or (X-marks-the-spot (cons 'car accessor) (car tree))
+	      (X-marks-the-spot (cons 'cdr accessor) (cdr tree)))
+	  (if (eq? tree 'X) accessor #f)))
+    (let ((body 'lst))
+      (for-each
+       (lambda (f)
+	 (set! body (list f body)))
+       (reverse (X-marks-the-spot () path)))
+      (let ((getr (apply lambda '(lst) body ()))
+	    (setr (apply lambda '(lst val) `(set! ,body val) ())))
+	(dilambda getr setr))))
+
+  (let ((body '(if (not (pair? (cdr lst))) lst (begin (set! lst (cdr lst)) X)))) ; X is where we jump back to the start
+    (let ((recurse (fc?r body)))
+      (set! (recurse body) body)
+      (test ((apply lambda '(lst) body ()) '(1 2 3)) '(3)))))
+
+
+(let ((v #2d((1 2) (3 4))))
+  (set! (v 1 0) v)
+  (test (object->string v) "#1=#2d((1 2) (#1# 4))")
+  (test (length v) 4)
+  (test ((((v 1 0) 1 0) 1 0) 0 0) 1))
+
+(let ((lst (list 1 2 3)))
+  (set! (cdr (cddr lst)) lst)
+  (test (lst 100) 2)
+  (test ((cdddr (cdddr (cdddr lst))) 100) 2)
+  (set! (lst 100) 32)
+  (test (object->string lst) "#1=(1 32 3 . #1#)"))
+
+(let* ((l1 (list 1 2))
+       (l2 (list l1 l1)))
+  (set! (l1 0) 32)
+  (test (equal? l2 '((32 2) (32 2))) #t))
+
+(let ((q (list 1 2 3 4)))
+  (set! (cdr (cdddr q)) q)
+  (test (car q) 1)
+  (set! (car q) 5)
+  (set! q (cdr q))
+  (test (car q) 2)
+  (test (object->string q) "#1=(2 3 4 5 . #1#)"))
+
+(let ()
+  (define make-node vector)
+  (define prev (dilambda (lambda (node) (node 0)) (lambda (node val) (set! (node 0) val))))
+  (define next (dilambda (lambda (node) (node 2)) (lambda (node val) (set! (node 2) val))))
+  (define data (dilambda (lambda (node) (node 1)) (lambda (node val) (set! (node 1) val))))
+  (let* ((head (make-node () 0 ()))
+	 (cur head))
+    (do ((i 1 (+ i 1)))
+	((= i 8))
+      (let ((next-node (make-node cur i ())))
+	(set! (next cur) next-node)
+	(set! cur (next cur))))
+    (set! (next cur) head)
+    (set! (prev head) cur)
+    (test (object->string head) "#1=#(#7=#(#6=#(#5=#(#4=#(#3=#(#2=#(#8=#(#1# 1 #2#) 2 #3#) 3 #4#) 4 #5#) 5 #6#) 6 #7#) 7 #1#) 0 #8#)")
+#|
+    ;; in CL:
+    (let* ((head (vector nil 0 nil))
+	   (cur head))
+      (do ((i 1 (+ i 1)))
+	  ((= i 8))
+	(let ((node (vector nil i nil)))
+	  (setf (aref node 0) cur)
+	  (setf (aref cur 2) node)
+	  (setf cur node)))
+      (setf (aref head 0) cur)
+      (setf (aref cur 2) head)
+      (format t "~A~%" head)) -> "#1=#(#2=#(#3=#(#4=#(#5=#(#6=#(#7=#(#8=#(#1# 1 #7#) 2 #6#) 3 #5#) 4 #4#) 5 #3#) 6 #2#) 7 #1#) 0 #8#)"
+|#
+    (let ((ahead (do ((cur head (next cur))
+		      (dat () (cons (data cur) dat)))
+		     ((member (data cur) dat)
+		      (reverse dat)))))
+      (let ((behind (do ((cur (prev head) (prev cur))
+			 (dat () (cons (data cur) dat)))
+			((member (data cur) dat)
+			 dat))))
+	(test (equal? ahead behind) #t)))))
+
+(let ()
+  (define make-node list)
+  (define prev (dilambda (lambda (node) (node 0)) (lambda (node val) (set! (node 0) val))))
+  (define next (dilambda (lambda (node) (node 2)) (lambda (node val) (set! (node 2) val))))
+  (define data (dilambda (lambda (node) (node 1)) (lambda (node val) (set! (node 1) val))))
+  (let* ((head (make-node () 0 ()))
+	 (cur head))
+    (do ((i 1 (+ i 1)))
+	((= i 8))
+      (let ((next-node (make-node cur i ())))
+	(set! (next cur) next-node)
+	(set! cur (next cur))))
+    (set! (next cur) head)
+    (set! (prev head) cur)
+    (test (object->string head) "#1=(#7=(#6=(#5=(#4=(#3=(#2=(#8=(#1# 1 #2#) 2 #3#) 3 #4#) 4 #5#) 5 #6#) 6 #7#) 7 #1#) 0 #8#)")
+    (let ((ahead (do ((cur head (next cur))
+		      (dat () (cons (data cur) dat)))
+		     ((member (data cur) dat)
+		      (reverse dat)))))
+      (let ((behind (do ((cur (prev head) (prev cur))
+			 (dat () (cons (data cur) dat)))
+			((member (data cur) dat)
+			 dat))))
+	(test (equal? ahead behind) #t))))
+  (let* ((head (make-node () 0 ()))
+	 (cur head))
+    (do ((i 1 (+ i 1)))
+	((= i 32))
+      (let ((next-node (make-node cur i ())))
+	(set! (next cur) next-node)
+	(set! cur (next cur))))
+    (set! (next cur) head)
+    (set! (prev head) cur)
+    (let-temporarily (((*s7* 'print-length) 128))
+      (test (object->string head) "#1=(#31=(#30=(#29=(#28=(#27=(#26=(#25=(#24=(#23=(#22=(#21=(#20=(#19=(#18=(#17=(#16=(#15=(#14=(#13=(#12=(#11=(#10=(#9=(#8=(#7=(#6=(#5=(#4=(#3=(#2=(#32=(#1# 1 #2#) 2 #3#) 3 #4#) 4 #5#) 5 #6#) 6 #7#) 7 #8#) 8 #9#) 9 #10#) 10 #11#) 11 #12#) 12 #13#) 13 #14#) 14 #15#) 15 #16#) 16 #17#) 17 #18#) 18 #19#) 19 #20#) 20 #21#) 21 #22#) 22 #23#) 23 #24#) 24 #25#) 25 #26#) 26 #27#) 27 #28#) 28 #29#) 29 #30#) 30 #31#) 31 #1#) 0 #32#)"))))
+
+(let ((x (list '+ 1)))
+  (set-cdr! (cdr x) x)
+  (do ((i 0 (+ i 1)))
+      ((= i 6))
+    (set! x (cons x x)))
+  (test (object->string x) "(#6=(#5=(#4=(#3=(#2=(#1=(+ 1 . #1#) . #1#) . #2#) . #3#) . #4#) . #5#) . #6#)"))
+
+(test (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (append lst lst ())) 'error)
+(test (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (object->string (append (list lst) (list lst) ()))) "(#1=(1 2 3 . #1#) #1#)")
+
+(let ((ht (make-hash-table 3)))
+  (set! (ht "hi") ht)
+  (test (object->string ht) "#1=(hash-table \"hi\" #1#)")
+  (test (equal? (ht "hi") ht) #t))
+
+(let ((l1 '(0)) (l2 '(0)))
+  (set! (car l1) l1) (set! (cdr l1) l1) (set! (car l2) l2) (set! (cdr l2) l2)
+  (test (object->string l1) "#1=(#1# . #1#)")
+  (test (equal? l1 l2) #t)
+  (set! (cdr l1) l2)
+  (test (object->string l1) "#1=(#1# . #2=(#2# . #2#))")
+  (test (equal? l1 l2) #t)
+  (set! (cdr l1) ())
+  (test (equal? l1 l2) #f))
+
+(let ((lst (list 1 2 3)))
+  (set! (cdr (cddr lst)) lst)
+  (test (map (lambda (a b)
+	       (+ a b))
+	     (list 4 5 6)
+	     lst)
+	'(5 7 9)))
+(test (let ((lst (list 1 2 3))
+	    (result ()))
+	(set! (cdr (cddr lst)) lst)
+	(for-each (lambda (a b)
+		    (set! result (cons (+ a b) result)))
+		  (list 4 5 6)
+		  lst)
+	result)
+      '(9 7 5))
+(let ((lst (list 1 2 3)))
+  (set! (cdr (cddr lst)) lst)
+  (test (map (lambda (a b)
+	       (+ a b))
+	     (vector 4 5 6)
+	     lst)
+	'(5 7 9)))
+(test (let ((lst (list 1 2 3)))
+	(set! (cdr (cddr lst)) lst)
+	(map (lambda (a b)
+	       (+ a b))
+	     (vector 4 5 6 7 8 9 10)
+	     lst))
+      '(5 7 9 8)) ; this now quits when it sees the cycle
+(test (map (lambda (a) a) '(0 1 2 . 3)) '(0 1 2))
+(test (let ((ctr 0)) (for-each (lambda (a) (set! ctr (+ ctr a))) '(1 2 . 3)) ctr) 3)
+(let ((lst (list 1 2 3)))
+  (set! (cdr (cddr lst)) lst)
+  (test (map (lambda (a b)
+	       (+ a b))
+	     ()
+	     lst)
+	()))
+(test (let ((lst (list 1 2 3))
+	    (ctr 0))
+	(set! (cdr (cddr lst)) lst)
+	(for-each (lambda (a b)
+		    (set! ctr (+ ctr (+ a b))))
+		  lst ())
+	ctr)
+      0)
+
+(test (let ((lst (list 1))) (set! (cdr lst) (car lst)) (object->string lst)) "(1 . 1)")
+(test (let ((lst (list 1))) (set! (car lst) (cdr lst)) (object->string lst)) "(())")
+
+(let ((ctr 0) (lst `(let ((x 3)) (set! ctr (+ ctr 1)) (set! (cdr (cddr lst)) `((+ x ctr))) (+ x 1))))
+  (test (eval lst) 4)
+  (test (eval lst) 5)
+  (test (eval lst) 6))
+
+(when (= (*s7* 'debug) 0) ; fact assumes below that procedure-source is unaltered
+  (let ()
+    (define fact          ; Reini Urban, http://autocad.xarch.at/lisp/self-mod.lsp.txt
+      (let ((old ())
+	    (result ()))
+
+	(define (last lst)
+	  (list-tail lst (- (length lst) 1)))
+
+	(define (butlast lis)
+	  (let ((len (length lis)))
+	    (if (<= len 1) ()
+		(let ((result ()))
+		  (do ((i 0 (+ i 1))
+		       (lst lis (cdr lst)))
+		      ((= i (- len 1)) (reverse result))
+		    (set! result (cons (car lst) result)))))))
+
+	(lambda (n)
+	  (cond ((zero? n) 1)
+		(#t
+		 (set! old (procedure-source fact))
+		 (set! fact (apply lambda '(n)
+				   `((cond
+				      ,@(butlast (cdr (car (cdr (cdr old)))))
+				      ((= n ,n) ,(let ()
+						   (set! result (* n (fact (- n 1))))
+						   result))
+				      ,@(last (cdr (car (cdr (cdr old)))))))))
+		 result)))))
+
+    (test (fact 3) 6)
+    (test (fact 5) 120)
+    (test (fact 2) 2)))
+
+(test (let ((f #f))
+	(set! f (lambda ()
+		  (let* ((code (procedure-source f))
+			 (pos (- (length code) 1)))
+		    (set! (code pos) (+ (code pos) 1)))
+		  1))
+	(f) (f) (f))
+      4)
+
+(let* ((x (list 1 2 3)) ; from Lambda the Ultimate I think -- I lost the reference
+       (y (list 4 5))
+       (z (cons (car x) (cdr y)))
+       (w (append y z))
+       (v (cons (cdr x) (cdr y))))
+  (set-car! x 6)
+  (set-car! y 7)
+  (set-cdr! (cdr x) (list 8))
+  (test (object->string (list x y z w v)) "((6 2 8) (7 5) (1 5) (4 5 1 5) ((2 8) 5))"))
+;; was "((6 . #3=(2 8)) (7 . #1=(5)) #2=(1 . #1#) (4 5 . #2#) (#3# . #1#))"
+
+;; circular eval
+(test (let ((e (list (list '+ 1)))) (set-cdr! (car e) e) (eval e)) 'error)
+(test (let ((e (list (list '+ 1 2)))) (set-cdr! (cdar e) e) (eval e)) 'error)
+(test (let ((e (list (list '+ 1 2) 3))) (set-cdr! (cdar e) e) (eval e)) 'error)
+(test (let ((e (list (list '+ 1) 3 4))) (set-cdr! (cdar e) e) (eval e)) 'error)
+(test (let ((x '(1 2 3)))
+	(set! (x 0) (cons x 2))
+	(eval (list-values 'let () (list-values 'define '(f1) (list-values 'list-set! x 0 (list-values 'cons x 2))) '(catch #t f1 (lambda a 'error)))))
+      'error)
+(test (let ((x '(car (list 1 2 3))))
+	(set! (x 0) x)
+	(eval (list-values 'let () (list-values 'define '(f1) x) '(catch #t f1 (lambda a 'error)))))
+      'error)
+
+#|
+(define (for-each-permutation func vals)          ; for-each-combination -- use for-each-subset below
+  "(for-each-permutation func vals) applies func to every permutation of vals"
+  ;;   (for-each-permutation (lambda args (format #t "~{~A~^ ~}~%" args)) '(1 2 3))
+  (define (pinner cur nvals len)
+    (if (= len 1)
+	(apply func (cons (car nvals) cur))
+	(do ((i 0 (+ i 1)))                       ; I suppose a named let would be more Schemish
+	    ((= i len))
+	  (let ((start nvals))
+	    (set! nvals (cdr nvals))
+	    (let ((cur1 (cons (car nvals) cur)))  ; add (car nvals) to our arg list
+	      (set! (cdr start) (cdr nvals))      ; splice out that element and
+	      (pinner cur1 (cdr start) (- len 1)) ;   pass a smaller circle on down
+	      (set! (cdr start) nvals))))))       ; restore original circle
+  (let ((len (length vals)))
+    (set-cdr! (list-tail vals (- len 1)) vals)    ; make vals into a circle
+    (pinner () vals len)
+    (set-cdr! (list-tail vals (- len 1)) ())))   ; restore its original shape
+
+;; a slightly faster version (avoids consing and some recursion)
+(define (for-each-permutation func vals)          ; for-each-combination -- use for-each-subset below
+  "(for-each-permutation func vals) applies func to every permutation of vals"
+  ;;   (for-each-permutation (lambda args (format #t "~A~%" args)) '(1 2 3))
+  (let ((cur (make-list (length vals))))
+
+    (define (pinner nvals len)
+      (if (= len 2)
+	  (begin
+	    (set! (cur 0) (car nvals))
+	    (set! (cur 1) (cadr nvals))
+	    (apply func cur)
+	    (set! (cur 1) (car nvals))
+	    (set! (cur 0) (cadr nvals))
+	    (apply func cur))
+
+	(do ((i 0 (+ i 1)))
+	    ((= i len))
+	  (let ((start nvals))
+	    (set! nvals (cdr nvals))
+	    (set! (cur (- len 1)) (car nvals))
+	    (set! (cdr start) (cdr nvals))        ; splice out that element and
+	    (pinner (cdr start) (- len 1))        ;   pass a smaller circle on down
+	    (set! (cdr start) nvals)))))          ; restore original circle
+
+  (let ((len (length vals)))
+    (set-cdr! (list-tail vals (- len 1)) vals)    ; make vals into a circle
+    (pinner vals len)
+    (set-cdr! (list-tail vals (- len 1)) ()))))  ; restore its original shape
+|#
+
+;; and continuing down that line...
+(define (for-each-permutation func vals)          ; for-each-combination -- use for-each-subset below
+  "(for-each-permutation func vals) applies func to every permutation of vals"
+  ;;   (for-each-permutation (lambda args (format #t "~A~%" args)) '(1 2 3))
+  (let ((cur (make-list (length vals))))
+
+    (define (pinner nvals len)
+      (if (= len 3)
+	  (let ((a0 (car nvals))
+		(a1 (cadr nvals))
+		(a2 (caddr nvals))
+		(c1 (cdr cur))
+		(c2 (cddr cur)))
+	    (set-car! cur a2)
+	    (set-car! c1 a0)
+	    (set-car! c2 a1)
+	    (apply func cur)
+	    (set-car! cur a0)
+	    (set-car! c1 a2)
+	    ;(set-car! c2 a1)
+	    (apply func cur)
+	    ;(set-car! cur a0)
+	    (set-car! c1 a1)
+	    (set-car! c2 a2)
+	    (apply func cur)
+	    (set-car! cur a1)
+	    (set-car! c1 a0)
+	    ;(set-car! c2 a2)
+	    (apply func cur)
+	    ;(set-car! cur a1)
+	    (set-car! c1 a2)
+	    (set-car! c2 a0)
+	    (apply func cur)
+	    (set-car! cur a2)
+	    (set-car! c1 a1)
+	    ;(set-car! c2 a0)
+	    (apply func cur)
+	    )
+
+	(do ((i 0 (+ i 1)))
+	    ((= i len))
+	  (let ((start nvals))
+	    (set! nvals (cdr nvals))
+	    (list-set! cur (- len 1) (car nvals))
+	    (set-cdr! start (cdr nvals))        ; splice out that element and
+	    (pinner (cdr start) (- len 1))      ;   pass a smaller circle on down
+	    (set-cdr! start nvals)))))          ; restore original circle
+
+  (let ((len (length vals)))
+    (if (< len 2)
+	(apply func vals)
+	(if (= len 2)
+	    (let ((c1 (cdr cur)))
+	      (set-car! cur (car vals))
+	      (set-car! c1 (cadr vals))
+	      (apply func cur)
+	      (set-car! c1 (car vals))
+	      (set-car! cur (cadr vals))
+	      (apply func cur))
+	    (begin
+	      (set-cdr! (list-tail vals (- len 1)) vals)    ; make vals into a circle
+	      (pinner vals len)
+	      (set-cdr! (list-tail vals (- len 1)) ())))))))  ; restore its original shape
+
+#|
+;; much slower:
+(define (for-each-permutation func vals)
+  (define (heap-permutation size n)
+    (if (= size 1)
+	(apply func vals)
+	(do ((i 0 (+ i 1)))
+	    ((= i size))
+	  (heap-permutation (- size 1) n)
+	  (if (odd? size)
+	      (let ((temp (vals 0)))
+		(set! (vals 0) (vals (- size 1)))
+		(set! (vals (- size 1)) temp))
+	      (let ((temp (vals i)))
+		(set! (vals i) (vals (- size 1)))
+		(set! (vals (- size 1)) temp))))))
+  (heap-permutation (length vals) (length vals)))
+|#
+
+(when full-s7test
+  (let()
+    (define ops '(+ *))
+    (define args '(1 pi 1+i 2/3 x y))
+
+    (define (listify lst)
+      ((if (memq (car lst) ops) list
+	   (if (null? (cdr lst)) append values))
+       (if (null? (cdr lst))
+	   (car lst)
+	   (values (car lst) (listify (cdr lst))))))
+
+    (call-with-output-file "t923.scm"
+      (lambda (p)
+        (format p "(define t923-old-eps (*s7* 'equivalent-float-epsilon))~%(set! (*s7* 'equivalent-float-epsilon) 1e-15)~%~%")
+        ;; 1e-15 here depends on add_p_ppp order -- it needs to mimic g_add, (+ (+ x y) z), else limit needs to be 1e-14
+	(let ((fctr 0))
+	  (for-each-permutation
+	   (lambda lst
+	     (let ((expr (list (listify lst))))
+	       (format p "(define (f~D x y) ~{~^~S ~})~%" fctr expr)
+	       (format p "(let ((e1 (f~D 3 4)))~%" fctr)
+	       (format p "  (let ((e2 (let ((x 3) (y 4)) ~{~^~S ~})))~%" expr)
+	       (format p "    (unless (equivalent? e1 e2)~%      (format *stderr* \"~{~^~S ~}: ~~A ~~A~~%\" e1 e2))))~%~%" expr))
+	     (set! fctr (+ fctr 1)))
+	   (append ops args)))
+         (format p "(set! (*s7* 'equivalent-float-epsilon) t923-old-eps)~%")))
+
+    (load "t923.scm")))
+
+  ;; t224 also applies this to +/*
+
+(let ((perms '((3 1 2) (1 3 2) (1 2 3) (2 1 3) (2 3 1) (3 2 1)))
+      (pos ()))
+  (for-each-permutation
+   (lambda args
+     (call-with-exit
+      (lambda (ok)
+	(let ((ctr 0))
+	  (for-each
+	   (lambda (a)
+	     (if (equal? a args)
+		 (begin
+		   (set! pos (cons ctr pos))
+		   (ok)))
+	     (set! ctr (+ ctr 1)))
+	   perms)))))
+   '(1 2 3))
+  (test pos '(5 4 3 2 1 0)))
+
+(test (let ((v1 (make-vector 16 0))
+	    (v2 (make-vector 16 0)))
+	(set! (v2 12) v2)
+	(set! (v1 12) v1)
+	(equal? v1 v2))        ; hmmm -- not sure this is correct
+      #t)
+(test (let ((lst1 (list 1))
+	    (lst2 (list 1)))
+	(set-cdr! lst1 lst1)
+	(set-cdr! lst2 lst2)
+	(equal? lst1 lst2))
+      #t)
+
+
+(test (let ((hi 3))
+	(let ((e (curlet)))
+	  (set! hi (curlet))
+	  (object->string e)))
+      "#1=(inlet 'hi #2=(inlet 'e #1#))") ; was "#1=(inlet 'hi (inlet 'e #1#))")
+(let ((e (inlet 'a 0 'b 1)))
+  (let ((e1 (inlet 'a e)))
+    (set! (e 'b) e1)
+    (test (equal? e (copy e)) #t)
+    (test (object->string e) "#1=(inlet 'a 0 'b (inlet 'a #1#))")))
+
+;; eval circles -- there are many more of these that will cause stack overflow
+(test (let ((x '(1 2 3))) (set! (x 0) (cons x 2)) (eval `(let () (define (f1) (list-set! ,x 0 (cons ,x 2))) (catch #t f1 (lambda a 'error))))) 'error)
+(test (let ((x '(car (list 1 2 3)))) (set! (x 0) x) (eval `(let () (define (f1) ,x) (catch #t f1 (lambda a 'error))))) 'error)
+
+
+(test (apply + (cons 1 2)) 'error)
+(test (let ((L (list 0))) (set-cdr! L L) (apply + L)) 'error)
+(test (let ((L (list 0))) (set-cdr! L L) (format #f "(~S~{~^ ~S~})~%" '+ L)) "(+ 0)\n") ; 28-Nov-18
+(test (apply + (list (let ((L (list 0 1))) (set-cdr! L L) L))) 'error)
+(test (apply + (let ((L (list 0 1))) (set-cdr! L L) L)) 'error)
+(test (length (let ((E (inlet 'value 0))) (varlet E 'self E))) 2)
+;(test (apply case 2 (list (let ((L (list (list 0 1)))) (set-cdr! L L) L))) 'error)
+;(test (apply cond (list (let ((L (list 0 1))) (set-cdr! L L) L))) 'error)
+;(test (apply quote (let ((L (list 0 1))) (set-car! L L) L)) 'error)
+;(test (apply letrec (hash-table) (let ((L (list 0 1))) (set-car! L L) L)) 'error)
+;I now think the caller should check for these, not s7
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; HOOKS
+;;; make-hook
+;;; hook-functions
+;;; --------------------------------------------------------------------------------
+
+(let-temporarily (((hook-functions *error-hook*) ())
+		  ((hook-functions *load-hook*) ())
+		  ((hook-functions *unbound-variable-hook*) ())
+		  ((hook-functions *missing-close-paren-hook*) ()))
+  (for-each
+   (lambda (arg)
+     (test (set! *unbound-variable-hook* arg) 'error)
+     (test (set! *missing-close-paren-hook* arg) 'error)
+     (test (set! *load-hook* arg) 'error)
+
+     (test (set! (hook-functions *unbound-variable-hook*) arg) 'error)
+     (test (set! (hook-functions *missing-close-paren-hook*) arg) 'error)
+     (test (set! (hook-functions *error-hook*) arg) 'error)
+     (test (set! (hook-functions *load-hook*) arg) 'error)
+
+     (test (set! (hook-functions *unbound-variable-hook*) (list arg)) 'error)
+     (test (set! (hook-functions *missing-close-paren-hook*) (list arg)) 'error)
+     (test (set! (hook-functions *error-hook*) (list arg)) 'error)
+     (test (set! (hook-functions *load-hook*) (list arg)) 'error))
+   (list -1 #\a #(1 2 3) 3.14 3/4 1.0+1.0i 'hi :hi #<eof> #(1 2 3) #(()) "hi" '(1 . 2) '(1 2 3))))
+
+(let ((hook-val #f))
+  (let-temporarily (((hook-functions *unbound-variable-hook*)
+		     (list (lambda (hook)
+			     (set! hook-val (hook 'variable))
+			     (set! (hook 'result) 123)))))
+    (let ((val (catch #t
+		 (lambda ()
+		   (+ 1 one-two-three))
+		 (lambda args
+		   (apply format *stderr* (cadr args))
+		   'error))))
+      (test val 124))
+    (test (equal? one-two-three 123) #t)
+    (test (equal? hook-val 'one-two-three) #t)))
+
+(let-temporarily (((hook-functions *unbound-variable-hook*) (list (lambda (hook)
+								    (set! (hook 'result) 32)))))
+  (let ((val (+ 1 _an_undefined_variable_i_hope_)))
+    (test val 33))
+  (let ((val (+ 1 _an_undefined_variable_i_hope_)))
+    (test (call/cc (lambda (_a_) (_a_ val))) 33))
+  (let ((val (* _an_undefined_variable_i_hope_ _an_undefined_variable_i_hope_)))
+    (test val 1024)))
+
+(let ((x #f))
+  (let-temporarily (((hook-functions *unbound-variable-hook*)
+		     (list (lambda (hook)
+			     (set! x 0)
+			     (set! (hook 'result) #<undefined>))
+			   (lambda (hook)
+			     (set! (hook 'result) 32))
+			   (lambda (hook)
+			     (if (not (number? (hook 'result)))
+				 (format *stderr* "oops -- *unbound-variable-hook* func called incorrectly~%"))))))
+    (let ((val (+ 1 _an_undefined_variable_i_hope_)))
+      (test val 33))
+    (test x 0)
+    (test (+ 1 _an_undefined_variable_i_hope_) 33)))
+
+(define (-a-rootlet-entry- x) (- x (abs x)))
+(define -a-rootlet-entry-value- #f)
+
+(define old-r-hook (hook-functions *rootlet-redefinition-hook*))
+(set! (hook-functions *rootlet-redefinition-hook*)
+      (list (lambda (hook)
+	      (set! -a-rootlet-entry-value- (hook 'value)))))
+(define (-a-rootlet-entry- x) (+ x (abs x)))
+(unless (and (procedure? -a-rootlet-entry-value-)
+             (equal? (procedure-source -a-rootlet-entry-value-)
+                     (if (positive? (*s7* 'debug))
+                         '(lambda (x) (trace-in (curlet)) (+ x (abs x)))
+                         '(lambda (x) (+ x (abs x))))))
+    (format *stderr* "rootlet redef: ~W~%" -a-rootlet-entry-value-))
+(set! (hook-functions *rootlet-redefinition-hook*) old-r-hook)
+
+;;; optimizer bug involving unbound variable
+(let ()
+  (define (opt1)
+    (let ((val (let ()
+		 (define (hi x y) (let ((m (memq x y)) (loc (and m (- x (length m))))) loc))
+		 (hi 'a '(a b c)))))
+      (format #t "~A: opt1 got ~S but expected 'error~%~%" (port-line-number) val)))
+  (catch #t opt1
+	 (lambda (type info)
+	   (if (not (eq? type 'unbound-variable))
+	       (format *stderr* "opt1 type: ~A, info: ~A~%" type info))
+	   'error)))
+(let ()
+  (define (opt2)
+    (let ((val (let ()
+		 (define (hi x y) (let* ((n (memq x y)) (loc (and m (- x (length m)))) (m (+ n 1))) loc))
+		 (hi 'a '(a b c)))))
+      (format #t "~A: opt2 got ~S but expected 'error~%~%" (port-line-number) val)))
+  (catch #t opt2
+	 (lambda (type info)
+	   (if (not (eq? type 'unbound-variable))
+	       (format *stderr* "opt2 type: ~A, info: ~A~%" type info))
+	   'error)))
+
+(let ()
+  (define (opt3)
+    (let ((val (let ()
+		 (define (hi x y) (do ((m (memq x y) 0) (loc (and m (- x (length m))) 0)) (loc #t)))
+		 (hi 'a '(a b c)))))
+      (format #t "~A: opt3 got ~S but expected 'error~%~%" (port-line-number) val)))
+  (catch #t opt3
+	 (lambda (type info)
+	   (if (not (eq? type 'unbound-variable))
+	       (format *stderr* "opt3 type: ~A, info: ~A~%" type info))
+	   'error)))
+
+(let ()
+  (define (opt4)
+    (let ()
+      (define (hi x y) (letrec ((m (memq x y)) (loc (and m (length m)))) loc))
+      (hi 'a '(a b c))))
+  (catch #t opt4
+	 (lambda (type info)
+	   'error)))
+
+(let ()
+  (define (opt5)
+    (let ((val (let ()
+		 (define (hi x y) (letrec* ((n (memq x y)) (loc (and m (- x (length m)))) (m (+ n 1))) loc))
+		 (hi 'a '(a b c)))))
+      (format #t "~A: opt5 got ~S but expected 'error~%~%" (port-line-number) val)))
+  (catch #t opt5
+	 (lambda (type info)
+	   'error)))
+
+(let ()
+  (define (opt6)
+    (let ((val (let ()
+		 (define (hi x) (let ((m (memq n x)) (loc (and m (- x (length m))))) (define n 1) loc))
+		 (hi '(a b c)))))
+      (format #t "~A: opt6 got ~S but expected 'error~%~%" (port-line-number) val)))
+  (catch #t opt6
+	 (lambda (type info)
+	   (if (not (eq? type 'unbound-variable))
+	       (format *stderr* "opt6 type: ~A, info: ~A~%" type info))
+	   'error)))
+
+(let ()
+  (define (opt7)
+    (let ((val (let ()
+		 (define* (f1 (a (+ m 1)) (m (+ a 1))) (+ a m))
+		 (f1))))
+      (format #t "~A: opt7 got ~S but expected 'error~%~%" (port-line-number) val)))
+  (catch #t opt7
+	 (lambda (type info)
+	   'error)))
+
+(let ()
+  (define (opt8)
+    (let ((val (let ()
+		 (let ((x 1))
+		   (set! x (+ m 1))
+		   (define m 2)
+		   x))))
+      (format #t "~A: opt8 got ~S but expected 'error~%~%" (port-line-number) val)))
+  (catch #t opt8
+	 (lambda (type info)
+	   (if (not (eq? type 'unbound-variable))
+	       (format *stderr* "opt8 type: ~A, info: ~A~%" type info))
+	   'error)))
+
+(let ()
+  (define (opt9)
+    (let ((val (let ()
+		 (let ((x 1)) (set! x (and m (length m))) (define m 2) x))))
+      (format #t "~A: opt9 got ~S but expected 'error~%~%" (port-line-number) val)))
+  (catch #t opt9
+	 (lambda (type info)
+	   (if (not (eq? type 'unbound-variable))
+	       (format *stderr* "opt9 type: ~A, info: ~A~%" type info))
+	   'error)))
+
+(let ()
+  (define (opt10)
+    (let ()
+      (define* (f1 (a (and m (length m))) (m 1)) (+ a m))
+      (f1))) ; but not unbound var error!  isn't this a bug?
+  (catch #t opt10
+	 (lambda (type info)
+	   'error)))
+
+(let ()
+  (define (makel depth)
+    (if (= depth 10)
+	(list depth)
+	(set! ___lst (list (makel (+ depth 1))))))
+  (test (makel 0) 'error))
+
+
+(let ((val #f))
+  (let-temporarily (((hook-functions *load-hook*) (list (lambda (hook)
+							  (if (or val
+								  (defined? 'load-hook-test))
+							      (format #t ";*load-hook*: ~A ~A?~%" val load-hook-test))
+							  (set! val (hook 'name))))))
+    (with-output-to-file "load-hook-test.scm"
+      (lambda ()
+	(format #t "(define (load-hook-test val) (+ val 1))")))
+    (load "load-hook-test.scm")
+    (if (or (not (string? val))
+	    (not (string=? val "load-hook-test.scm")))
+	(format #t ";*load-hook-test* file: ~S~%" val))
+    (if (not (defined? 'load-hook-test))
+	(format #t ";load-hook-test function not defined?~%")
+	(if (not (= (load-hook-test 1) 2))
+	    (format #t ";load-hook-test: ~A~%" (load-hook-test 1))))))
+
+(let-temporarily (((hook-functions *error-hook*) ()))
+  (test (hook-functions *error-hook*) ())
+  (set! (hook-functions *error-hook*) (list (lambda (hook) #f)))
+  (test (list? (hook-functions *error-hook*)) #t))
+
+(let-temporarily (((hook-functions *missing-close-paren-hook*) (list (lambda (h) (set! (h 'result) 'incomplete-expr)))))
+  (test (catch #t (lambda () (eval-string "(+ 1 2")) (lambda args (car args))) 'incomplete-expr)
+  (test (catch #t (lambda () (eval-string "(")) (lambda args (car args))) 'incomplete-expr)
+  (test (catch #t (lambda () (eval-string "(abs ")) (lambda args (car args))) 'incomplete-expr))
+
+(let ((h (make-hook 'x)))
+  (test (procedure? h) #t)
+  (test (eq? h h) #t)
+  (test (eqv? h h) #t)
+  (test (equal? h h) #t)
+  (test (equivalent? h h) #t)
+  (test (arity h) (cons 0 1))
+  (let ((h1 (copy h)))
+    (test (eq? h h1) #f) ; fluctutates...
+    (test (equivalent? h h1) #t))
+  (test (hook-functions h) ())
+  (test (h) #<unspecified>)
+  (test (h 1) #<unspecified>)
+  (test (h 1 2) 'error)
+  (let ((f1 (lambda (hook) (set! (hook 'result) (hook 'x)))))
+    (set! (hook-functions h) (list f1))
+    (test (member f1 (hook-functions h)) (list f1))
+    (test (hook-functions h) (list f1))
+    (test (h 1) 1)
+    (set! (hook-functions h) ())
+    (test (hook-functions h) ())
+    (let ((f2 (lambda* args (set! ((car args) 'result) ((car args) 'x)))))
+      (set! (hook-functions h) (list f2))
+      (test (hook-functions h) (list f2))
+      (test (h 1) 1)))
+  (for-each
+   (lambda (arg)
+     (test (set! (hook-functions h) arg) 'error))
+   (list "hi" #f (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f :hi #<eof> #<undefined> #<unspecified>))
+  (set! (hook-functions h) (list (lambda (hk) (set! (hk 'result) (hk 'xyzzy)))))
+  (test (h 123) #<undefined>))
+
+(let ((h (make-hook)))
+  (test (procedure? h) #t)
+  (test (documentation h) "")
+  (test (hook-functions h) ())
+  (test (h) #<unspecified>)
+  (test (arity h) (cons 0 0))
+  (test (h 1) 'error)
+  (let ((f1 (lambda (hook) (set! (hook 'result) 123))))
+    (set! (hook-functions h) (list f1))
+    (test (member f1 (hook-functions h)) (list f1))
+    (test (hook-functions h) (list f1))
+    (test (h) 123)
+    (set! (hook-functions h) ())
+    (test (hook-functions h) ())
+    (let ((f2 (lambda* args (set! ((car args) 'result) 321))))
+      (set! (hook-functions h) (list f2))
+      (test (hook-functions h) (list f2))
+      (test (h) 321))))
+
+(let ((h (make-hook '(a 32) 'b)))
+  (test (procedure? h) #t)
+  (test (hook-functions h) ())
+  (test (arity h) (cons 0 2))
+  (test (h) #<unspecified>)
+  (test (h 1) #<unspecified>)
+  (test (h 1 2) #<unspecified>)
+  (test (h 1 2 3) 'error)
+  (let ((f1 (lambda (hook) (set! (hook 'result) (+ (hook 'a) (or (hook 'b) 0))))))
+    (set! (hook-functions h) (list f1))
+    (test (member f1 (hook-functions h)) (list f1))
+    (test (hook-functions h) (list f1))
+    (test (h) 32)
+    (test (h 1) 1)
+    (test (h 1 2) 3)
+    (set! (hook-functions h) ())
+    (test (hook-functions h) ())))
+
+(test (let () (define h (make-hook 'x)) (set! (hook-functions h) (list (lambda (hk) (set! (hk 'result) (hk 'abs))))) (h 123)) #<undefined>) ; new version of make-hook
+
+(let-temporarily (((*s7* 'safety) 1))
+  (test (format #f "~W" (make-hook (cons 'ho (list (values (list (let ((<1> (hash-table))) (set! (<1> 'a) <1>) <1>))))))) ; segfault if not checked
+        "#<write_closure_readably: arglist is cyclic>"))
+
+(let ()
+  (for-each
+   (lambda (arg)
+     (test (make-hook arg) 'error))
+   (list "hi" #f 1 (list 1 2) '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f :hi #<eof> #<undefined> #<unspecified>)))
+
+(let ((h (make-hook)))
+  (let ((f1 (lambda (hook) (if (number? (hook 'result)) (set! (hook 'result) (+ (hook 'result) 1)) (set! (hook 'result) 0)))))
+    (test (h) #<unspecified>)
+    (set! (hook-functions h) (list f1))
+    (test (h) 0)
+    (set! (hook-functions h) (list f1 f1 f1))
+    (test (h) 2)))
+
+(if (not (defined? 'hook-push))
+    (define (hook-push hook func)
+      (set! (hook-functions hook) (cons func (hook-functions hook)))))
+
+(let ((h (make-hook)))
+  (hook-push h (lambda (hook) (set! (hook 'result) 32)))
+;  (test (dynamic-wind h h h) 32)
+  (test (catch h h h) 32)
+  )
+
+(let ((h (make-hook 'x)))
+  (hook-push h (lambda (hook) (set! (hook 'result) (hook 'x))))
+  (test (continuation? (call/cc h)) #t)
+  (set! (hook-functions h) (list (lambda (hook) (set! (hook 'result) (+ 1 (hook 'x))))))
+  (test (map h '(1 2 3)) '(2 3 4))
+  )
+
+(let ()
+  (define-macro (hook . body)
+    `(let ((h (make-hook)))
+       (set! (hook-functions h)
+	     (list (lambda (h)
+		     (set! (h 'result) (begin ,@body)))))
+       h))
+  (let ((x 0))
+    (define hi (hook (set! x 32) (+ 2 3 1)))
+    (test (hi) 6)
+    (test x 32)))
+
+(let ()
+  (define-macro (hooked-catch hook . body)
+    `(catch #t
+       (lambda ()
+	 ,@body)
+       (lambda args
+	 (let ((val (apply ,hook args)))
+	   (if (eq? val #<unspecified>) ; hook did not do anything
+	       (apply error args)       ; so re-raise the error
+	       val)))))
+
+ (let ((a-hook (make-hook 'error-type :rest 'error-info)))
+   (set! (hook-functions a-hook)
+         (list (lambda (hook)
+		 ;(format #t "hooked-catch: ~A~%" (apply format #t (car (hook 'error-info))))
+		 (set! (hook 'result) 32))))
+   (test (hooked-catch a-hook (abs "hi")) 32)
+
+   (set! (hook-functions a-hook) ())
+
+   (test (catch #t
+	   (lambda ()
+	     (hooked-catch a-hook (abs "hi")))
+	   (lambda args
+	     123))
+	 123)
+   ))
+
+(when (provided? 'autoload)
+  (let ((loaded #f))
+  (let-temporarily (((hook-functions *autoload-hook*)
+                      (list (lambda (h) (set! loaded (cons (h 'name) (h 'file)))))))
+    (autoload 'pp "write.scm")
+    (pp '(1 2))
+    (test loaded (cons 'pp "write.scm")))))
+
+(let ()
+  (define *breaklet* #f)
+  (define *step-hook* (make-hook 'code 'e))
+
+  (define-macro* (trace/break code . break-points)
+    (define (caller tree)
+      (if (pair? tree)
+	  (cons
+	   (if (pair? (car tree))
+	       (if (and (symbol? (caar tree))
+			(procedure? (symbol->value (caar tree))))
+		   (if (member (car tree) break-points)
+		       `(__break__ ,(caller (car tree)))
+		       `(__call__ ,(caller (car tree))))
+		   (caller (car tree)))
+	       (car tree))
+	   (caller (cdr tree)))
+	  tree))
+    `(call-with-exit (lambda (__top__) ,(caller code))))
+
+  (define (go . args)
+    (and (let? *breaklet*)
+	 (apply (*breaklet* 'go) args)))
+
+  (define (clear-break)
+    (set! *breaklet* #f))
+
+  (define-macro (__call__ code)
+    `(*step-hook* ',code (curlet)))
+
+  (define-macro (__break__ code)
+    `(begin
+       (call/cc
+	(lambda (go)
+	  (set! *breaklet* (curlet))
+	  (__top__ (format #f "break at: ~A~%" ',code))))
+       ,code))
+
+  (set! (hook-functions *step-hook*)
+	(list (lambda (hook)
+		(set! (hook 'result) (eval (hook 'code) (hook 'e))))
+	      (lambda (hook)
+		(define (uncaller tree)
+		  (if (pair? tree)
+		      (cons
+		       (if (and (pair? (car tree))
+				(memq (caar tree) '(__call__ __break__)))
+			   (uncaller (cadar tree))
+			   (uncaller (car tree)))
+		       (uncaller (cdr tree)))
+		      tree))
+		(format (current-output-port) ": ~A -> ~A~40T~A~%"
+			(uncaller (hook 'code))
+			(hook 'result)
+			(if (and (not (eq? (hook 'e) (rootlet)))
+				 (not (defined? '__top__ (hook 'e))))
+			    (map values (hook 'e))
+			    "")))))
+
+  (let ((str (with-output-to-string
+	       (lambda ()
+		 (trace/break (let ((a (+ 3 1)) (b 2)) (if (> (* 2 a) b) 2 3)))))))
+    (test (or (string-wi=? str ": (+ 3 1) -> 4
+: (* 2 a) -> 8                         ((a . 4) (b . 2))
+: (> (* 2 a) b) -> #t                  ((a . 4) (b . 2))
+")
+	      (string-wi=? str ": (+ 3 1) -> 4
+: (* 2 a) -> 8                         ((b . 2) (a . 4))
+: (> (* 2 a) b) -> #t                  ((b . 2) (a . 4))
+")) #t)))
+
+
+;;; #_ stuff
+(test ((lambda () (if (#_round pi) #f))) #f)
+(test ((lambda () (when (#_round pi) #f))) #f)
+(test ((lambda () (#_cond (* 1)))) 1)
+(test (let () (define (f1) (abs (#_logand))) (f1)) 1)
+(test ((lambda () (abs (#_logand)))) 1)
+(test ((lambda () (abs (#_logand 2 3)))) 2)
+(test (call-with-exit (lambda (g) (abs (#_logand)))) 1)
+(test (let () (define (func) (append (#_begin (tree-cyclic?)))) (func)) 'error)
+(test (let () (define (func) (do ((x 0.0 (+ x 0.1)) (i 0 (+ i 1))) ((>= x .1) (#_with-baffle (inlet (values 1 2) (symbol? x)))))) (func)) 'error)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (#_provide :readable))) (func)) #t)
+(test (pair? (let ()
+               (define (func)
+                 (list-values (#_quasiquote (odd?)) (let ((<1> (list 1 #f))) (set! (<1> 1) (let ((<L> (list #f 3))) (set-car! <L> <1>) <L>)) <1>)))
+               (func)))
+      #t)
+(test (let () (define (hi) (let ((x 0) (i 3)) (do ((i i (+ i 1))) ((= i 6)) (do ((i i (+ i 1))) ((= i 7)) (set! x (+ x i)))) x)) (hi)) 44)
+
+;;; *error-hook* + let-temporarily
+
+(catch #t
+  (lambda ()
+    (let-temporarily (((hook-functions *error-hook*) (list (lambda (hook) 'hook))))
+      (+ 1 #())
+      322))
+  (lambda (type info)
+    'catch?))
+
+(test (catch #t
+        (lambda ()
+          (let-temporarily (((*s7* 'print-length) 123123))
+            (+ 1 #())
+            323))
+        (lambda (type info) 'catch1))
+      'catch1)
+
+(test (let-temporarily (((hook-functions *error-hook*) (list (lambda (hook) 'hook))))
+        (catch #t
+          (lambda ()
+            (+ 1 #())
+            324)
+          (lambda (type info)
+            'catch2)))
+      'catch2)
+
+(let ((x (let-temporarily (((hook-functions *error-hook*) (list (lambda (hook) 'hook))))
+	   (catch #t
+	     (lambda ()
+	       (+ 1 #())
+	       325)
+	     (lambda (type info)
+	       'catch3)))))
+  (test x 'catch3)
+  (test (hook-functions *error-hook*) ()))
+
+(test (hook-functions *error-hook*) ())
+
+(test (catch #t
+	(lambda ()
+	  (let-temporarily (((hook-functions *error-hook*)
+			     (list (lambda (hook)
+				     (+ 1 #\a))))) ; not called: error-hook is not triggered
+	    322))
+	(lambda (type info)
+	  'catch4))
+      322)
+
+(test (catch #t
+	(lambda ()
+	  (let-temporarily (((hook-functions *error-hook*)
+			     (list (lambda (hook)
+				     (+ 1 #\a))))) ; this goes to the catch -- error-hook is not enabled within its body to avoid infinite recursion
+	    (+ 1 #\b) ; this triggers error-hook, but the error is: "+ second argument, #\a, is a character but should be a number"
+	    322))
+	(lambda (type info)
+	  (apply format #f info)))
+      "+ second argument, #\\a, is a character but should be a number")
+
+;;; *read-error-hook*
+
+(test (hook-functions *read-error-hook*) ())
+
+(let ()
+  (define (reader-hooks h)
+    (let ((type (h 'type))
+	  (data (h 'data)))
+      (if type
+	  (set! (h 'result)
+		(case (data 0)
+		  ((#\T)
+		   (and (string=? data "T")
+			;(format #t "#T should be #t~%")
+			#t))
+		  ((#\F)
+		   (and (string=? data "F")
+			;(format #t "#F should be #f~%")
+			''#f)))))))
+
+  (set! (hook-functions *read-error-hook*) (list reader-hooks))
+  (test (eval-string "#T") #t)
+  (test (eval-string "(list #F)") '(#f))
+  (set! (hook-functions *read-error-hook*) ())
+
+  (let-temporarily (((hook-functions *read-error-hook*) (list reader-hooks)))
+    (test (eval-string "#T") #t))
+
+  (test (hook-functions *read-error-hook*) ()))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; HASH-TABLES
+;;; --------------------------------------------------------------------------------
+;;; make-hash-table
+;;; make-weak-hash-table
+;;; hash-table
+;;; weak-hash-table
+;;; hash-table?
+;;; weak-hash-table?
+;;; hash-table-entries
+;;; hash-table-ref
+;;; hash-table-set!
+;;; hash-code
+;;; hash-table-key-typer
+;;; hash-table-value-typer
+
+(let ((ht (make-hash-table)))
+  (test (hash-table? ht) #t)
+  (test (equal? ht ht) #t)
+  (test (let () (hash-table-set! ht 'key 3.14) (hash-table-ref ht 'key)) 3.14)
+  (test (let () (hash-table-set! ht "ky" 3.14) (hash-table-ref ht "ky")) 3.14)
+  (test (let () (hash-table-set! ht 123 "hiho") (hash-table-ref ht 123)) "hiho")
+  (test (let () (hash-table-set! ht 3.14 "hi") (hash-table-ref ht 3.14)) "hi")
+  (test (let () (hash-table-set! ht pi "hiho") (hash-table-ref ht pi)) "hiho")
+  (test (hash-table-ref ht "123") #f)
+  (let ((ht1 (copy ht)))
+    (test (hash-table? ht1) #t)
+    (test (iterator? ht1) #f)
+    (test (iterator? (make-iterator ht1)) #t)
+    (test (= (length ht) (length ht1)) #t)
+    (test (equal? ht ht1) #t)
+    (test (eq? ht ht) #t)
+    (test (eqv? ht ht) #t)
+    (set! (ht 'key) 32)
+    (set! (ht1 'key) 123)
+    (test (and (= (ht 'key) 32) (= (ht1 'key) 123)) #t)
+    (set! (ht "key") 321)
+    (test (ht "key") 321)
+    (test (ht 'key) 32)
+    (set! (ht 123) 43)
+    (set! (ht "123") 45)
+    (test (ht 123) 43)
+    (test (ht "123") 45)
+    (test (hash-table-set! ht "1" 1) 1)
+    (test (set! (ht "2") 1) 1)
+    (test (set! (hash-table-ref ht "3") 1) 1)
+    (test (hash-table-ref ht "3") 1))
+  (test (let () (set! (hash-table-ref ht 'key) 32) (hash-table-ref ht 'key)) 32)
+
+  (for-each
+   (lambda (arg)
+     (test (let () (hash-table-set! ht 'key arg) (hash-table-ref ht 'key)) arg))
+   (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))))
+
+(for-each
+ (lambda (arg)
+   (test (hash-table-set! arg 'key 32) 'error))
+ (list "hi" () -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(for-each
+ (lambda (arg)
+   (test (integer? (hash-code arg)) #t))
+ (list "hi" () -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2) '(1 2) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       #f (lambda (a) (+ a 1)) (macro (a) `(+ ,a 1)) :hi (if #f #f) #<eof> #<undefined>))
+
+(for-each
+ (lambda (arg)
+   (test (hash-code 123 arg) 'error))
+ (list "hi" () -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2) '(1 2) _ht_ quasiquote macroexpand 1/0 (log 0)
+       #f (macro (a) `(+ ,a 1)) :hi (if #f #f) #<eof> #<undefined>))
+
+(test (hash-code) 'error)
+(test (hash-code (cosh 128)) 0)
+(test (hash-code +nan.0) 0)
+(test (hash-code +inf.0) 0)
+(test (hash-code 1.0e17) 0)
+(test (hash-code -1.0e17) 0)
+(test (hash-code 1.0e15) 1000000000000000)
+
+(test (catch #t (lambda () (hash-table-ref (hash-table 'a 1) 'b 2)) (lambda (typ info) (apply format #f info)))
+      "(hash-table-ref (hash-table 'a 1) 'b 2) becomes (#f 2), but #f can't take arguments")
+
+(test (catch #t (lambda () (let ((h (hash-table 'b 1))) (h 'a 'asdf))) (lambda (typ info) (apply format #f info)))
+      "((hash-table 'b 1) 'a 'asdf) becomes (#f 'asdf), but #f can't take arguments")
+
+(test (catch #t (lambda () (let ((h (hash-table 'a (hash-table 'b 1)))) (h 'a 'c 'd))) (lambda (typ info) (apply format #f info)))
+      "((hash-table 'b 1) 'c 'd) becomes (#f 'd), but #f can't take arguments")
+
+(test (catch #t (lambda () (let ((h (hash-table))) (hash-table-ref h 'a 'asdf))) (lambda (typ info) (apply format #f info)))
+      "(hash-table-ref (hash-table) 'a 'asdf) becomes (#f 'asdf), but #f can't take arguments")
+
+(test (catch #t (lambda () (let ((L (list 1))) (list-ref L 0 2))) (lambda (typ info) (apply format #f info)))
+      "(list-ref (1) 0 2) becomes (1 2), but 1 can't take arguments")
+
+(test (catch #t (lambda () (let ((L (list 1))) (L 0 2))) (lambda (typ info) (apply format #f info)))
+      "((1) 0 2) becomes (1 2), but 1 can't take arguments")
+
+(test (catch #t (lambda () (let ((L (list (list 0)))) (L 0 0 2))) (lambda (typ info) (apply format #f info)))
+      "((0) 0 2) becomes (0 2), but 0 can't take arguments")
+
+(test (catch #t (lambda () (let ((V (vector 1 2))) (V 0 1))) (lambda (typ info) (apply format #f info)))
+      "(#(1 2) 0 1) becomes (1 1), but 1 can't take arguments")
+
+(test (catch #t (lambda () (let ((V (vector 1 2))) (vector-ref V 0 1))) (lambda (typ info) (apply format #f info)))
+      "(#(1 2) 0 1) becomes (1 1), but 1 can't take arguments")
+
+(test (catch #t (lambda () (let ((V (vector (vector 0 12)))) (V 0 1 0))) (lambda (typ info) (apply format #f info)))
+      "(#(0 12) 1 0) becomes (12 0), but 12 can't take arguments")
+
+(test (catch #t (lambda () (let ((V (int-vector 1 2))) (V 0 1))) (lambda (typ info) (apply format #f info)))
+      "vector-ref: too many indices: (0 1)")
+
+(test (catch #t (lambda () (let ((L (inlet))) (L 'a :asdf))) (lambda (typ info) (apply format #f info)))
+      "((inlet) 'a :asdf) becomes (#<undefined> :asdf), but #<undefined> can't take arguments")
+
+(test (catch #t (lambda () (let ((L (inlet 'a (inlet 'b 1)))) (L 'a 'b 'c))) (lambda (typ info) (apply format #f info)))
+      "((inlet 'b 1) 'b 'c) becomes (1 'c), but 1 can't take arguments")
+
+(test (catch #t (lambda () (let ((L (list 1))) (set! (L 0 2) 32))) (lambda (typ info) (apply format #f info)))
+      "in (set! (L 0 2) 32), ((1) 0) is 1 which can't take arguments")
+
+(test (catch #t (lambda () (let ((L (list (list 0)))) (set! (L 0 0 2) 32))) (lambda (typ info) (apply format #f info)))
+      "in (set! (L 0 0 2) 32), ((0) 0) is 0 which can't take arguments")
+
+(test (catch #t (lambda () (let ((h (hash-table 'b 1))) (set! (h 'a 'asdf) 32))) (lambda (typ info) (apply format #f info)))
+      "in (set! (h 'a 'asdf) 32), 'a does not exist in (hash-table 'b 1)")
+
+(test (catch #t (lambda () (let ((h (hash-table 'b 1))) (set! (h 'b 'asdf) 32))) (lambda (typ info) (apply format #f info)))
+      "in (set! (h 'b 'asdf) 32), ((hash-table 'b 1) 'b) is 1 which can't take arguments")
+
+(test (catch #t (lambda () (let ((h (hash-table 'a (hash-table 'b 1)))) (set! (h 'a 'c 'd) 32))) (lambda (typ info) (apply format #f info)))
+      "in (set! (h 'a 'c 'd) 32), 'c does not exist in (hash-table 'b 1)")
+
+(test (catch #t (lambda () (let ((v (hash-table 'a (list 1 2)))) (set! (v 'a 1) 5))) (lambda (typ info) (apply format #f info)))
+      5)
+
+(test (catch #t (lambda () (let ((v (hash-table 'a (hash-table 'b 1)))) (set! (v 'a 'b 'b) 32) v)) (lambda (typ info) (apply format #f info)))
+      "in (set! (v 'a 'b 'b) 32), ((hash-table 'b 1) 'b) is 1 which can't take arguments")
+
+(test (catch #t (lambda () (let ((L (inlet 'a (inlet 'b 1)))) (set! (L 'a 'b 'c) 32))) (lambda (typ info) (apply format #f info)))
+      "in (set! (L 'a 'b 'c) 32), ((inlet 'b 1) 'b) is 1 which can't take arguments")
+
+(test (catch #t (lambda () (let ((L (inlet))) (set! (L 'a :asdf) 32))) (lambda (typ info) (apply format #f info)))
+      "in (set! (L 'a :asdf) 32), ((inlet) 'a) is #<undefined> which can't take arguments")
+
+(test (catch #t (lambda () (set! (abs 1) 2)) (lambda (typ info) (apply format #f info)))
+      "abs (a c-function) does not have a setter: (set! (abs 1) 2)")
+
+(test (catch #t (lambda () (set! (when #t 3) 21) ) (lambda (type info) (apply format #f info)))
+      "when (syntactic) does not have a setter: (set! (when #t 3) 21)")
+
+(test (catch #t (lambda () (call-with-exit (lambda (go) (set! (go 1) 2)))) (lambda (type info) (apply format #f info)))
+      "go (a goto (from call-with-exit)) does not have a setter: (set! (go 1) 2)")
+
+(test (catch #t (lambda () (eval '(call/cc (lambda (go) (set! (go 1) 2))))) (lambda (type info) (apply format #f info)))
+      "go (a continuation) does not have a setter: (set! (go 1) 2)")
+
+(test (catch #t (lambda () (let ((L (inlet))) (let-ref L 'a :asdf))) (lambda (type info) (apply format #f info)))
+      "let-ref: too many arguments: (let-ref (inlet) a :asdf)")
+
+(test (catch #t (lambda () (let ((V (vector 1 2))) (set! (vector-ref V 0 1) 32))) (lambda (type info) (apply format #f info)))
+      "too many arguments for vector-set!: (#(1 2) 0 1 32)")
+
+(test (catch #t (lambda () (let ((V (vector 1 2))) (vector-set! V 0 1 32))) (lambda (type info) (apply format #f info)))
+      "too many arguments for vector-set!: (#(1 2) 0 1 32)")
+
+(test (catch #t (lambda () (let ((V (vector 1 2))) (set! (V 0 1) 32))) (lambda (type info) (apply format #f info)))
+      "in (set! (V 0 1) 32), (#(1 2) 0) is 1 which can't take arguments")
+
+(test (catch #t (lambda () (set! (:asdf 3) 2)) (lambda (type info) (apply format #f info)))
+      "in (set! (:asdf 3) 2), :asdf has no setter")
+
+(test (catch #t (lambda () (set! (_asdf_ 3) 3)) (lambda (type info) (apply format #f info))) "unbound variable _asdf_ in (set! (_asdf_ 3) 3)")
+
+(test (catch #t (lambda () (make-hash-table 8 eq? #t)) (lambda (type info) (apply format #f info)))
+        "make-hash-table third argument, #t, is boolean but should be either #f or (cons key-type-check value-type-check)")
+
+(test (catch #t (lambda () (make-hash-table 8 eq? (cons integer? ()))) (lambda (type info) (apply format #f info)))
+        "make-hash-table third argument, (integer?), is a pair but should be (key-type . value-type)")
+
+(test (catch #t (lambda () (make-hash-table 8 eq? (cons (lambda (x) x) integer?))) (lambda (type info) (apply format #f info)))
+        "make-hash-table: in the third argument, (#<lambda (x)> . integer?), (the key/value type checkers) the first function is anonymous")
+
+(test (catch #t (lambda () (make-hash-table 8 eq? (cons integer? (lambda (x) x)))) (lambda (type info) (apply format #f info)))
+        "make-hash-table: in the third argument, (integer? . #<lambda (x)>), (the key/value type checkers) the second function is anonymous")
+
+(test (catch #t (lambda () (make-hash-table 8 eq? (cons (lambda (a b) a) integer?))) (lambda (type info) (apply format #f info)))
+        "make-hash-table: in the third argument, (#<lambda (a b)> . integer?), (the key/value type checkers) both functions should take one argument")
+
+(test (catch #t (lambda () (make-hash-table 8 eq? (cons integer? (lambda (a b) a)))) (lambda (type info) (apply format #f info)))
+        "make-hash-table: in the third argument, (integer? . #<lambda (a b)>), (the key/value type checkers) both functions should take one argument")
+
+(test (catch #t (lambda () (make-hash-table 8 eq? (cons expt integer?))) (lambda (type info) (apply format #f info)))
+        "make-hash-table: in the third argument, (expt . integer?), (the key/value type checkers) both functions should take one argument")
+
+(test (catch #t (lambda () (make-hash-table 8 eq? (cons integer? expt))) (lambda (type info) (apply format #f info)))
+        "make-hash-table: in the third argument, (integer? . expt), (the key/value type checkers) both functions should take one argument")
+
+(test (catch #t (lambda () (make-hash-table 8 string=? (cons symbol? symbol?))) (lambda (type info) (apply format #f info)))
+        "make-hash-table: in the third argument, the key type function is not compatible with the equality function: (symbol? . symbol?)")
+
+(define (hash-table-equalizer h)
+  (let ((data (object->let h)))
+    (and (defined? 'function data #t)
+	 (let-ref data 'function))))
+
+(define (hash-table-key/value-types h)
+  (let* ((data (object->let h))
+	 (sig (and (defined? 'signature data #t)
+		   (let-ref data 'signature))))
+    (and (pair? sig)
+	 (list (caddr sig)
+	       (car sig)))))
+
+(test (hash-table-equalizer (make-hash-table 8 eq? (cons symbol? integer?))) 'eq?)
+(test (hash-table-key/value-types (make-hash-table 8 eq? (cons symbol? integer?))) '(symbol? integer?))
+
+(test (let ((H (hash-table 'a (hash-table 'b 1)))) (apply H (list 'a 'b))) 1)
+
+(let ((ht1 (make-hash-table 31))
+      (ht2 (make-hash-table 31)))
+  (if (not (equal? ht1 ht2))
+      (format #t ";ht1 and ht2 are empty, but not equal??~%"))
+
+      ;; these first tests take advantage of s7's hashing function
+  (hash-table-set! ht1 'abc 1)
+  (hash-table-set! ht1 'abcabc 2)
+  (hash-table-set! ht1 'abcabcabc 3)
+  (hash-table-set! ht2 'abcabcabc 3)
+  (hash-table-set! ht2 'abcabc 2)
+  (hash-table-set! ht2 'abc 1)
+  (if (not (equal? ht1 ht2))
+      (format #t ";ht1 and ht2 have the same key value pairs, but are not equal??~%"))
+
+  (test (make-hash-table 1 (call-with-exit (lambda (goto) goto))) 'error)
+  (test (make-hash-table 1 atan) 'error)
+
+  (set! ht2 (make-hash-table 31))
+  (hash-table-set! ht2 'abc 1)
+  (hash-table-set! ht2 'abcabc 2)
+  (hash-table-set! ht2 'abcabcabc 3)
+  (if (not (equal? ht1 ht2))
+      (format #t ";ht1 and ht2 have the same key value pairs in the same order, but are not equal??~%"))
+
+  (hash-table-set! ht2 'abc "1")
+  (if (equal? ht1 ht2)
+      (format #t ";ht1 and ht2 are equal but values are not~%"))
+  (hash-table-set! ht2 'abc 1)
+  (if (not (equal? ht1 ht2))
+      (format #t ";after reset ht1 and ht2 have the same key value pairs in the same order, but are not equal??~%"))
+  (hash-table-set! ht2 1 'abc)
+  (if (equal? ht1 ht2)
+      (format #t ";ht1 and ht2 are equal but entries are not~%"))
+  (hash-table-set! ht1 1 'abc)
+  (if (not (equal? ht1 ht2))
+      (format #t ";after add ht1 and ht2 have the same key value pairs, but are not equal??~%"))
+
+      ;; these should force chaining in any case
+  (set! ht1 (make-hash-table 31))
+  (set! ht2 (make-hash-table 60))
+  (do ((i 0 (+ i 1)))
+      ((= i 100))
+    (hash-table-set! ht1 i (* i 2))
+    (hash-table-set! ht2 i (* i 2)))
+  (if (not (equal? ht1 ht2))
+      (format #t ";ht1 and ht2 have the same (integer) key value pairs in the same order, but are not equal??~%"))
+
+  (let ((h1 (hash-table "a" 1))
+          (h2 (hash-table 'a 1)))
+     (set! (h2 "a") 1)
+     (set! (h2 'a) #f)
+     test (equal? h1 h2) #t)
+
+  (let ((ht (make-hash-table)))
+    (set! (ht (expt 2 40)) 40)
+    (set! (ht (expt 2 50)) 50)
+    (set! (ht (- (expt 2 60))) -60) ; these all hash into 0 unfortunately -- maybe fold halves?
+    (test (ht (expt 2 40)) 40)
+    (test (ht (expt 2 50)) 50)
+    (test (ht (expt 2 60)) #f)
+    (test (ht (- (expt 2 60))) -60)
+    (test (ht (expt 2 41)) #f))
+
+  (set! ht2 (make-hash-table 31))
+  (do ((i 99 (- i 1)))
+      ((< i 0))
+    (hash-table-set! ht2 i (* i 2)))
+  (test (hash-table-entries ht2) 100)
+  (if (not (equal? ht1 ht2))
+      (format #t ";ht1 and ht2 have the same (integer) key value pairs, but are not equal??~%"))
+
+  (fill! ht1 ())
+  (test (hash-table-entries ht1) 100)
+  (test (ht1 32) ()))
+
+(let ((h (make-hash-table)))
+  (test (hash-table-entries h) 0)
+  (set! (h 'a) 1)
+  (test (hash-table-entries h) 1)
+  (set! (h 'a) #f)
+  (test (hash-table-entries h) 0)
+  (set! (h 'a) 'b)
+  (test (h 'a) 'b))
+
+(let ()
+  (define (f1) ; hash_table_entries_i_7p
+    (let ((H (list (hash-table 'a 1 'b 2)))
+	  (sum 0)
+	  (size 3))
+      (do ((i 0 (+ i 1)))
+	  ((= i size) sum)
+	(set! sum (+ sum (hash-table-entries (car H)))))))
+  (test (f1) 6))
+
+(let ((h (make-hash-table)))
+  (define (f t) (set! (t 'a) 'b))
+  (f h)
+  (f h)
+  (test (h 'a) 'b))
+
+(let ((ht (make-hash-table))
+      (l1 '(x y z))
+      (l2 '(y x z)))
+  (set! (hash-table-ref ht 'x) 123)
+  (define (hi)
+    (hash-table-ref ht (cadr l1))) ; 123
+  (test (hi) #f))
+
+(let () ; hash-code
+  (define (make-hash size)
+    (make-vector size ()))
+
+  (define (hash-ref table key)
+    (let ((loc (modulo (hash-code key) (length table))))
+      (cond ((assoc key (table loc)) => cdr)
+	    (else #f))))
+
+  (define (hash-set! table key value)
+    (let ((loc (modulo (hash-code key) (length table))))
+      (cond ((assoc key (table loc)) => (lambda (key/value)
+					  (set-cdr! key/value value)))
+	    (else (set! (table loc) (cons (cons key value) (table loc)))))))
+
+  (let ((h (make-hash 8)))
+    (hash-set! h 'abc 1)
+    (test (hash-ref h 'abc) 1)
+    (hash-set! h "cba" #\c)
+    (test (hash-ref h "cba") #\c)
+    (do ((i 0 (+ i 1)))
+	((= i 12))
+      (hash-set! h i (* i 2)))
+    (test (hash-ref h 3) 6)
+    (test (hash-ref h 'abc) 1)
+    (test (hash-ref h "asdf") #f)))
+
+(test (make-hash-table most-positive-fixnum) 'error)
+;(test (make-hash-table (+ 1 (expt 2 31))) 'error)  ; out-of-memory error except in clang
+(test (make-hash-table most-negative-fixnum) 'error)
+(test (make-hash-table (* 8796093022208 8796093022208)) 'error)
+(test (make-hash-table 8796093022208) 'error)
+(test (make-hash-table 21 eq? 12) 'error)
+(test (make-hash-table 21 12) 'error)
+(test (make-hash-table 21 eq? #f 12) 'error)
+(test (hash-table? (make-hash-table 8 #f #f)) #t)
+(test (make-hash-table eq? eq?) 'error)
+(test (make-hash-table eq? eq? 12) 'error)
+(test (make-hash-table ()) 'error)
+(test (make-hash-table 3 ()) 'error)
+(test (make-hash-table eq? ()) 'error)
+(test (make-hash-table 0) 'error)
+(test (make-hash-table -4) 'error)
+(test (make-hash-table (ash 1 32)) 'error)
+(test (let ((imh (immutable! (hash-table 'a 1 'b 2))))
+	(define (func) (do ((j 0 (+ j 1))) ((= j 1)) (hash-table-set! (or imh) 't 1)))
+	(define (hi) (func)) (hi))
+      'error)
+
+(test (let ((h (hash-table 'a (hash-table 'b 2)))) (h 'a 'b)) 2)
+(let ((h (hash-table)))
+  (hash-table-set! h 'a (+ (or (hash-table-ref h 'a) 0) 1))
+  (test (hash-table-ref h 'a) 1)
+  (hash-table-set! h 'a (+ (or (hash-table-ref h 'a) 0) 1))
+  (test (hash-table-ref h 'a) 2))
+(let ((h (hash-table)))
+  (define (hash-inc)
+    (hash-table-set! h 'a (+ 1 (or (hash-table-ref h 'a) 0)))
+    (hash-table-set! h 'a (+ (or (hash-table-ref h 'a) 0) 1)))
+  (hash-inc)
+  (test (hash-table-ref h 'a) 2))
+
+(let ()
+  (define (f8) ; this shows why hash_ref -> entry_ref can't work
+    (let ((H (hash-table 'x 1))
+	  (sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 30) sum)
+	(set! sum (+ sum (H 'x)))
+	(hash-table-set! H 'x #f)   ; release 'x entry
+	(hash-table-set! H 'y -1)   ; grab 'x entry for 'y
+	(hash-table-set! H 'x 2)))) ; change 'x value
+  (test (f8) 59))
+
+(for-each
+ (lambda (arg)
+   (test (make-hash-table arg) 'error))
+ (list "hi" #\a 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(test (catch 'wrong-type-arg
+	(lambda () (make-hash-table 8 (cons 32 symbol?)))
+	(lambda (type info) (apply format #f info)))
+      "make-hash-table: first entry of type info, 32, is an integer, but should be a function")
+(test (catch 'wrong-type-arg
+	(lambda () (make-hash-table 8 (cons symbol? 32)))
+	(lambda (type info) (apply format #f info)))
+      "make-hash-table: second entry of type info, 32, is an integer, but should be a function")
+(test (catch 'wrong-type-arg
+	(lambda () (make-hash-table 8 (cons symbol? symbol?)))
+	(lambda (type info) (apply format #f info)))
+      "make-hash-table's equality function, symbol?, (car of the second argument) should be a function of two arguments")
+(test (catch 'wrong-type-arg
+	(lambda () (make-hash-table 8 (cons eq? symbol?)))
+	(lambda (type info) (apply format #f info)))
+      "make-hash-table mapper function, symbol?, should return an integer")
+(test (catch 'wrong-type-arg
+	(lambda () (make-hash-table 8 (cons string-ref symbol?)))
+	(lambda (type info) (apply format #f info)))
+      "make-hash-table checker function, string-ref, should return a boolean value")
+(test (catch 'wrong-type-arg
+	(lambda () (make-hash-table 8 (cons equal? equal?)))
+	(lambda (type info) (apply format #f info)))
+      "make-hash-table's mapping function, equal?, (cdr of the second argument) should be a function of one argument")
+(test (copy (inlet 'a 1) (make-hash-table 8 #f (cons symbol? cons))) 'error)
+(test (copy (inlet 'a 1) (make-hash-table 8 #f (cons cons symbol?))) 'error)
+
+(let ((h (hash-table)))
+  (hash-table-set! h 0/0 1)
+  (test (object->string h) "(hash-table +nan.0 1)")
+  (hash-table-set! h 0/0 #f)
+  (test (object->string h) "(hash-table +nan.0 1)"))
+(let ((h (hash-table +nan.0 1)))
+  (test (h +nan.0) #f))
+
+(let ((ht (hash-table :a 1/0)))
+  (test (nan? (ht :a)) #t)
+  (set! (ht 1/0) :a)
+  (test (ht 1/0) #f)) ; NaNs aren't equal?
+
+(let ()
+  (define nan1 +nan.0)
+  (define nan2 -nan.0)
+
+  (let ((H (hash-table)))
+    (set! (H nan1) 1)
+    (test (H nan1) #f)
+    (test (H nan2) #f)
+    (set! (H nan2) 2)
+    (test (object->string H) "(hash-table +nan.0 2 +nan.0 1)")
+    (test (H nan1) #f)
+    (test (H nan2) #f)
+    (test (H +nan.0) #f)
+    (test (H -nan.0) #f)
+    (set! (H -nan.0) 3)
+    (test (object->string H) "(hash-table +nan.0 3 +nan.0 2 +nan.0 1)"))
+
+  (define vn1 (float-vector +nan.0))
+  (define vn2 (float-vector -nan.0))
+
+  (let ((H (hash-table)))
+    (set! (H vn1) 1)
+    (test (H vn1) 1)
+    (set! (H vn2) 2)
+    (test (object->string H) "(hash-table #r(+nan.0) 2 #r(+nan.0) 1)")
+    (test (equal? vn1 vn1) #t)) ; see below
+
+  (let ((H (hash-table)))
+    (set! (H #(0)) 1)
+    (test (H #(0)) 1)
+    (test (H #(0.0)) #f)
+    (test (H (vector 0)) 1))
+
+  (let ((H (hash-table))
+	(L1 (list +nan.0))
+	(L2 (list +nan.0)))
+    (set! (H L1) 1)
+    (test (H L1) 1)
+    (test (H L2) #f)
+    (test (equal? (list +nan.0) (list +nan.0)) #f)
+    (test (equal? L1 L1) #t))
+    ;; is this inconsistent? It's the same object, so its contents aren't relevant??
+    ;;   otherwise anything with a NaN in it can't be equal? even to itself -- seems perverse.
+
+  ;; guile:
+  ;; scheme@(guile-user)> (equal? (vector +nan.0) (vector +nan.0))
+  ;; $1 = #t
+  ;; s7:
+  ;; <1> (equal? (vector +nan.0) (vector +nan.0))
+  ;; #f
+  ;; <2> (equal? (float-vector +nan.0) (float-vector +nan.0))
+  ;; #f
+  ;; <3> (equivalent? (float-vector +nan.0) (float-vector +nan.0))
+  ;; #t
+
+  (let ((typed-hash  (make-hash-table 8 eq? (cons symbol? integer?))))
+    (define (f) (do ((i 0 (+ i 1))) ((= i 3)) (char-upcase (string-ref typed-hash else))))
+    (test (f) 'error)) ; opt_p_pp_sf_href problem
+  (let ((imfv2 #r2d((1 2 3) (4 5 6)))
+        (V_2 (let ((v (make-vector 1))) (set! (v 0) v) v)))
+    (define (f) (do ((i 0 (+ i 1))) ((= i 3)) (imfv2 V_2 (hash-table-ref or call-with-exit))))
+    (test (f) 'error)) ; and another!
+  (let ()
+    (define (func) (let ((lt (inlet 'a 1))) (do ((i 0 (+ i 1))) ((= i 2)) (lt or))))
+    (test (func) 'error)) ; and another!!
+
+  (let ((H (make-hash-table 8 equivalent?)))
+    (set! (H nan1) 1)
+    (test (H nan1) 1)
+    (test (H nan2) 1)
+    (set! (H nan2) 2)
+    (test (object->string H) "(hash-table +nan.0 2)")
+    (test (H nan1) 2)
+    (test (H nan2) 2)
+    (test (H +nan.0) 2)
+    (test (H -nan.0) 2)
+    (set! (H -nan.0) 3)
+    (test (object->string H) "(hash-table +nan.0 3)"))
+
+  (let ((H (make-hash-table 8 equivalent?)))
+    (set! (H vn1) 1)
+    (test (H vn1) 1)
+    (set! (H vn2) 2)
+    (test (object->string H) "(hash-table #r(+nan.0) 2)")))
+
+(test (hash-table 'a #f 'b 1) (hash-table 'b 1))
+(test (hash-table 'a #f) (hash-table))
+
+(let ((ht (make-hash-table)))
+  (define (f1) (do ((i 0 (+ i 1))) ((= i 100)) (hash-table-set! ht i #t)))
+  (f1)
+  (test (hash-table-entries ht) 100)
+  (set! ht (make-hash-table))
+  (define (f2) (do ((i 0 (+ i 1))) ((= i 100)) (hash-table-set! ht i 0)))
+  (f2)
+  (test (hash-table-entries ht) 100)
+  (set! ht (make-hash-table))
+  (define (f3) (do ((i 0 (+ i 1))) ((= i 100)) (hash-table-set! ht i i)))
+  (f3)
+  (test (hash-table-entries ht) 100))
+
+(let ((ht (make-hash-table)))
+  (define (f1) (do ((i 0 (+ i 1))) ((= i 1000)) (hash-table-set! ht i #t)))
+  (f1)
+  (test (hash-table-entries ht) 1000))
+
+(let ((hi (make-hash-table 7)))
+  (test (object->string hi) "(hash-table)")
+  (set! (hi 1) "1")
+  (test (object->string hi) "(hash-table 1 \"1\")")
+  (set! (hi -1) "-1")
+
+  (test (or (string=? (object->string hi) "(hash-table -1 \"-1\" 1 \"1\")")
+	    (string=? (object->string hi) "(hash-table 1 \"1\" -1 \"-1\")"))
+	#t)
+  (set! (hi 9) "9")
+  (test (or (string=? (object->string hi) "(hash-table 9 \"9\" -1 \"-1\" 1 \"1\")")
+	    (string=? (object->string hi) "(hash-table 9 \"9\" 1 \"1\" -1 \"-1\")"))
+	#t)
+  (set! (hi -9) "-9")
+  (test (or (string=? (object->string hi) "(hash-table -9 \"-9\" 9 \"9\" -1 \"-1\" 1 \"1\")")
+	    (string=? (object->string hi) "(hash-table 9 \"9\" 1 \"1\" -9 \"-9\" -1 \"-1\")"))
+	#t)
+  (test (hi 1) "1")
+  (test (hi -1) "-1")
+  (test (hi -9) "-9")
+  (set! (hi 2) "2")
+  (test (or (string=? (object->string hi) "(hash-table -9 \"-9\" 9 \"9\" -1 \"-1\" 1 \"1\" 2 \"2\")")
+	    (string=? (object->string hi) "(hash-table 9 \"9\" 1 \"1\" 2 \"2\" -9 \"-9\" -1 \"-1\")"))
+	#t)
+  (let-temporarily (((*s7* 'print-length) 3))
+    (test (or (string=? (object->string hi) "(hash-table -9 \"-9\" 9 \"9\" -1 \"-1\" ...)")
+	      (string=? (object->string hi) "(hash-table 9 \"9\" 1 \"1\" 2 \"2\" ...)"))
+	  #t)
+    (set! (*s7* 'print-length) 0)
+    (test (object->string hi) "(hash-table ...)")
+    (test (object->string (hash-table)) "(hash-table)")))
+
+(let ((ht (make-hash-table 277)))
+  (test (hash-table? ht) #t)
+  (test (>= (length ht) 277) #t)
+  (test (hash-table-entries ht) 0)
+  (test (let () (hash-table-set! ht 'key 3.14) (hash-table-ref ht 'key)) 3.14)
+  (test (let () (hash-table-set! ht "ky" 3.14) (hash-table-ref ht "ky")) 3.14)
+  (for-each
+   (lambda (arg)
+     (test (let () (hash-table-set! ht 'key arg) (hash-table-ref ht 'key)) arg))
+   (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))))
+
+(for-each
+ (lambda (arg)
+   (test (hash-table? arg) #f))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2)))
+
+(test (hash-table? (make-vector 3 ())) #f)
+(test (let ((ht (make-hash-table))) (set! (ht 'a) 123) (map values ht)) '((a . 123)))
+
+(let ((ht (make-hash-table)))
+  (test (hash-table-ref ht 'not-a-key) #f)
+  (test (hash-table-ref ht "not-a-key") #f)
+  (hash-table-set! ht 'key 3/4)
+  (hash-table-set! ht "key" "hi")
+  (test (hash-table-ref ht "key") "hi")
+  (test (hash-table-ref ht 'key) 3/4)
+
+  (hash-table-set! ht 'asd 'hiho)
+  (test (hash-table-ref ht 'asd) 'hiho)
+  (hash-table-set! ht 'asd 1234)
+  (test (hash-table-ref ht 'asd) 1234))
+
+(let ((ht (make-hash-table)))
+  (define (ht-add h)
+    (+ (h 1) (h 2)))
+  (hash-table-set! ht 1 2)
+  (hash-table-set! ht 2 3)
+  (test (ht-add ht) 5))
+
+(let ()
+  (define h4 (make-hash-table 8 =))
+  (test (set! (h4 'a) 3) (if (> (*s7* 'safety) 0) 'error 3))
+  (define h5 (make-hash-table 8 string=?))
+  (test (set! (h5 'a) 3) (if (> (*s7* 'safety) 0) 'error 3))
+  (define h6 (make-hash-table 8 eq?))
+  (test (set! (h6 21) 3) (if (> (*s7* 'safety) 0) 'error 3))
+  (test (make-hash-table 8 >) 'error))
+
+(let ((let1 (inlet 'a 1))
+      (let2 (inlet 'a 1))
+      (let3 (inlet 'a 2))
+      (let4 (inlet 'b 1))
+      (let5 (inlet 'a 1 'a 2)))
+  (test (equal? let1 let2) #t)
+  (test (equal? let1 let3) #f)
+  (test (equal? let1 let5) #t)
+  (let ((hash1 (hash-table let1 32)))
+    (test (integer? (hash1 let1)) #t)
+    (test (integer? (hash1 let2)) #t)
+    (test (integer? (hash1 let3)) #f)
+    (test (integer? (hash1 let4)) #f)
+    (test (integer? (hash1 let5)) #t)))
+
+(test ((hash-table 1.5 #t #f #t) #f) #t) ; this is checking hash_float if debugging
+(test ((hash-table 1.5 #t 1 #t) 1) #t)
+
+(let ((let1 (inlet 'a 1 'b 2))
+      (let2 (inlet 'b 2 'a 1))
+      (let3 (inlet 'a 1 'b 1)))
+  (test (equal? let1 let2) #t)
+  (let ((hash1 (hash-table let1 32)))
+    (test (integer? (hash1 let1)) #t)
+    (test (integer? (hash1 let2)) #t)
+    (test (integer? (hash1 let3)) #f)))
+
+(let ((hash1 (hash-table 'a 1 'b 2))
+      (hash2 (hash-table 'b 2 'a 1)))
+  (test (equal? hash1 hash2) #t)
+  (let ((hash3 (hash-table hash1 32)))
+    (test (integer? (hash3 hash1)) #t)
+    (test (integer? (hash3 hash2)) #t)))
+
+(let ((hash1 (hash-table 'b 2 'a 1)))
+  (let ((hash2 (make-hash-table (* (length hash1) 2))))
+    (set! (hash2 'a) 1)
+    (set! (hash2 'b) 2)
+    (test (equal? hash1 hash2) #t)
+    (let ((hash3 (make-hash-table (* 2 (length hash2)))))
+      (set! (hash3 hash1) 32)
+      (test (integer? (hash3 hash1)) #t)
+      (test (integer? (hash3 hash2)) #t))))
+
+(for-each
+ (lambda (arg)
+   (test (hash-table-ref arg 'key) 'error))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(let ((ht1 (make-hash-table 653))
+      (ht2 (make-hash-table 277)))
+  (test (equal? ht1 ht2) #t) ; equal? because both are empty
+  (hash-table-set! ht1 'key 'hiho)
+  (hash-table-set! ht2 (hash-table-ref ht1 'key) 3.14)
+  (test (>= (length ht1) 653) #t)
+  (test (hash-table-ref ht2 'hiho) 3.14)
+  (test (hash-table-ref ht2 (hash-table-ref ht1 'key)) 3.14))
+
+(let ((ht1 (make-hash-table)))
+   (set! (ht1 1) 'hi)
+   (let ((ht2 (make-hash-table)))
+      (set! (ht2 1) ht1)
+      (test ((ht2 1) 1) 'hi)))
+
+(let ((ht1 (make-hash-table)))
+   (set! (ht1 1/0) "NaN!")
+   (let ((nan 1/0))
+      (test (ht1 nan) #f)
+      (set! (ht1 nan) 0)
+      (test (ht1 nan) #f)
+      (if (not with-windows)
+	  (test (object->string ht1) "(hash-table +nan.0 0 +nan.0 \"NaN!\")"))))
+(let ((h (make-hash-table 8 eqv?)))
+  (set! (h +nan.0) 'ok)
+  (test (h +nan.0) #f))
+
+(let ((h1 (make-hash-table 8 equivalent?))
+      (h2 (make-hash-table 8 equivalent?)))
+  (hash-table-set! h2 (let ((<1> (vector #f))) (set! (<1> 0) <1>) <1>) 1)
+  (test (object->string (append h1 h2)) "(hash-table #1=#(#1#) 1)"))
+
+(unless with-bignums
+  (let ((ht1 (make-hash-table)))
+    (set! (ht1 1) "1")
+    (set! (ht1 1.0) "1.0")
+    (test (ht1 1) "1")
+    (set! (ht1 1/0) "nan")
+    (test (ht1 0/0) #f)
+    (test (ht1 1/0) #f)
+    (set! (ht1 (/ (log 0) (log 0))) "nan-nani")
+    (test (ht1 (/ (log 0) (log 0))) #f)
+    (test (ht1 (- 0/0)) #f)
+    (test (ht1 (real-part (/ (log 0) (log 0)))) #f)
+    (test (ht1 (complex 0/0 1/0)) #f)
+    (set! (ht1 (real-part (log 0))) "-inf")
+    (test (ht1 (real-part (log 0))) "-inf")
+    (set! (ht1 (- (real-part (log 0)))) "inf")
+    (test (ht1 (- (real-part (log 0)))) "inf")
+    (set! (ht1 (log 0)) "log(0)")
+    (test (ht1 (log 0)) "log(0)")
+    (set! (ht1 (complex 80143857/25510582 1)) "pi+i")
+    (test (ht1 (complex pi (- 1.0 1e-16))) #f)))
+
+(when with-bignums
+  (test (hash-table-ref (let ((h (make-hash-table 8 eqv?))) (set! (h 1.0) 'a) (set! (h 2.0) 'b) (set! (h 3.0) 'c) h) (bignum 2.0)) 'b)
+  (test (hash-table-ref (let ((h (make-hash-table 8 eqv?))) (set! (h 1.0) 'a) (set! (h 2.0) 'b) h) (bignum 2.0)) 'b)
+  (test (hash-table-ref (hash-table 1.0 'a 2.0 'b 3.0 'c) 2.0) 'b)
+  (test (hash-table-ref (hash-table 1.0 'a (bignum 2.0) 'b 3.0 'c) 2.0) 'b)
+  (test (hash-table-ref (hash-table 1.0 'a 2.0 'b 3.0 'c) (bignum 2.0)) 'b)
+  (test (hash-table-ref (hash-table 1 'a 2 'b 3 'c) (bignum 2)) 'b)
+  (test (hash-table-ref (hash-table 1/3 'a 2/3 'b 3/2 'c) (bignum 2/3)) 'b)
+  (test (hash-table-ref (hash-table 1+i 'a 2/3+i 'b 3+i 'c) (bignum 2/3+i)) 'b)
+  (test (hash-table-ref (hash-table (bignum 1) 'a (bignum 2) 'b (bignum 3) 'c) (bignum 2)) 'b)
+  (test (hash-table-ref (hash-table (bignum 1) 'a (bignum 2) 'b (bignum 3) 'c) 2) 'b)
+  (test (hash-table-ref (hash-table (bignum 1.0) 'a (bignum 2.0) 'b (bignum 3.0) 'c) (bignum 2.0)) 'b)
+  (test (hash-table-ref (hash-table (bignum 1.0) 'a (bignum 2.0) 'b (bignum 3.0) 'c) 2.0) 'b)
+  (test (hash-table-ref (let ((h (make-hash-table 8 =))) (set! (h 1.0) 'a) (set! (h 2.0) 'b) (set! (h 3.0) 'c) h) (bignum 2.0)) 'b)
+  (test (hash-table-ref (let ((h (make-hash-table 8 equal?))) (set! (h 1.0) 'a) (set! (h 2.0) 'b) (set! (h 3.0) 'c) h) (bignum 2.0)) 'b)
+  (test (hash-table-ref (let ((h (make-hash-table 8 eqv?))) (set! (h 1.0) 'a) (set! (h 2.0) 'b) (set! (h 3.0) 'c) h) (bignum 2.0)) 'b)
+  (test (hash-table-ref (let ((h (make-hash-table 8 eqv?))) (set! (h 1.0) 'a) (set! (h 2.0) 'b) h) (bignum 2.0)) 'b)
+  (test (hash-table-ref (let ((h (make-hash-table 8 equivalent?))) (set! (h 1.0) 'a) (set! (h 2.0) 'b) (set! (h 3.0) 'c) h) (bignum 2.0)) 'b))
+
+(test (hash-table-ref (let ((h (make-hash-table 8 equivalent?))) (set! (h 10000000001/10000000000) 'a) h) 1) #f)
+(let-temporarily (((*s7* 'hash-table-float-epsilon) 1.0e-9))
+  (test (hash-table-ref (let ((h (make-hash-table 8 equivalent?))) (set! (h 10000000001/10000000000) 'a) h) 1) 'a)
+  (test (hash-table-ref (let ((h (make-hash-table 8 equivalent?))) (set! (h 10000000001/10000000000) 'a) h) 1.0) 'a)
+  (test (hash-table-ref (let ((h (make-hash-table 8 equivalent?))) (set! (h 10000000001/10000000000) 'a) h) 1.0+1.0e-10i) 'a))
+(let-temporarily (((*s7* 'hash-table-float-epsilon) 1.0e-9))
+  (test (hash-table-ref (let ((h (make-hash-table 8 equivalent?))) (set! (h -10000000001/10000000000) 'a) h) -1) 'a)
+  (test (hash-table-ref (let ((h (make-hash-table 8 equivalent?))) (set! (h -10000000001/10000000000) 'a) h) -1.0) 'a)
+  (test (hash-table-ref (let ((h (make-hash-table 8 equivalent?))) (set! (h -10000000001/10000000000) 'a) h) -1.0+1.0e-10i) 'a))
+(let-temporarily (((*s7* 'hash-table-float-epsilon) 1.0e-9))
+  (test (hash-table-ref (let ((h (make-hash-table 8 equivalent?))) (set! (h 1+1.0e-10i) 'a) h) 1) 'a)
+  (test (hash-table-ref (let ((h (make-hash-table 8 equivalent?))) (set! (h 1+1.0e-10i) 'a) h) 1.0) 'a)
+  (test (hash-table-ref (let ((h (make-hash-table 8 equivalent?))) (set! (h 1+1.0e-10i) 'a) h) 1.0-1.0e-10i) 'a))
+
+(let-temporarily (((*s7* 'hash-table-float-epsilon) 1.0e-9))
+  (let ((eps5 5.0e-10)
+	(eps1 1.0e-10)
+	(eps9 9.0e-10)
+	(eps10 1.0001e-9)
+	(h (make-hash-table 8 equivalent?))
+	(keys (list 0 1.0 2.0 -2.0 1/2 7/2 1.5 2.5 3 (+ 1.0 5.0e-8) -1.0e-8 -11/2 0+i 1-i 8-1.0e-10i)))
+    (for-each
+     (lambda (key)
+       (hash-table-set! h key (number->string key)))
+     keys)
+    (for-each
+     (lambda (key)
+       (let ((val (number->string key)))
+	 (test (hash-table-ref h key) val)
+         (when (real? key)
+  	   (test (hash-table-ref h (inexact->exact key)) val)
+	   (test (hash-table-ref h (exact->inexact key)) val))
+	 (test (hash-table-ref h (+ key eps1)) val)
+	 (test (hash-table-ref h (+ key eps5)) val)
+	 (test (hash-table-ref h (+ key eps9)) val)
+	 (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f)
+	 (test (hash-table-ref h (- key eps1)) val)
+	 (test (hash-table-ref h (- key eps5)) val)
+	 (test (hash-table-ref h (- key eps9)) val)
+	 (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f)))
+     keys)
+    (set! h (make-hash-table 8 =))
+    (for-each
+     (lambda (key)
+       (hash-table-set! h key (number->string key)))
+     keys)
+    (for-each
+     (lambda (key)
+       (let ((val (number->string key)))
+	 (test (hash-table-ref h key) val)
+         (when (real? key)
+	   (test (hash-table-ref h (inexact->exact key)) (and (= key (inexact->exact key)) val))
+	   (test (hash-table-ref h (exact->inexact key)) (and (= key (exact->inexact key)) val)))
+	 (test (hash-table-ref h (+ key eps1)) #f)
+	 (test (hash-table-ref h (+ key eps5)) #f)
+	 (test (hash-table-ref h (+ key eps9)) #f)
+	 (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f)
+	 (test (hash-table-ref h (- key eps1)) #f)
+	 (test (hash-table-ref h (- key eps5)) #f)
+	 (test (hash-table-ref h (- key eps9)) #f)
+	 (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f)))
+     keys)
+    (set! h (make-hash-table 8 eqv?))
+    (for-each
+     (lambda (key)
+       (hash-table-set! h key (number->string key)))
+     keys)
+    (for-each
+     (lambda (key)
+       (let ((val (number->string key)))
+	 (test (hash-table-ref h key) val)
+         (when (real? key)
+	   (test (hash-table-ref h (inexact->exact key)) (and (exact? key) val))
+	   (test (hash-table-ref h (exact->inexact key)) (and (inexact? key) val)))
+	 (test (hash-table-ref h (+ key eps1)) #f)
+	 (test (hash-table-ref h (+ key eps5)) #f)
+	 (test (hash-table-ref h (+ key eps9)) #f)
+	 (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f)
+	 (test (hash-table-ref h (- key eps1)) #f)
+	 (test (hash-table-ref h (- key eps5)) #f)
+	 (test (hash-table-ref h (- key eps9)) #f)
+	 (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f)))
+     keys)
+    (set! h (make-hash-table 8 equal?)) ; like eqv?
+    (for-each
+     (lambda (key)
+       (hash-table-set! h key (number->string key)))
+     keys)
+    (for-each
+     (lambda (key)
+       (let ((val (number->string key)))
+	 (test (hash-table-ref h key) val)
+         (when (real? key)
+	   (test (hash-table-ref h (inexact->exact key)) (and (exact? key) val))
+	   (test (hash-table-ref h (exact->inexact key)) (and (inexact? key) val)))
+	 (test (hash-table-ref h (+ key eps1)) #f)
+	 (test (hash-table-ref h (+ key eps5)) #f)
+	 (test (hash-table-ref h (+ key eps9)) #f)
+	 (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f)
+	 (test (hash-table-ref h (- key eps1)) #f)
+	 (test (hash-table-ref h (- key eps5)) #f)
+	 (test (hash-table-ref h (- key eps9)) #f)
+	 (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f)))
+     keys)))
+
+(when with-bignums
+  (let-temporarily (((*s7* 'hash-table-float-epsilon) 1.0e-9))
+    (let ((eps5 5.0e-10)
+	  (eps1 1.0e-10)
+	  (eps9 9.0e-10)
+	  (eps10 1.0001e-9)
+	  (h (make-hash-table 8 equivalent?))
+	  (keys (map bignum (list 0 1.0 2.0 -2.0 1/2 7/2 1.5 2.5 3 (+ 1.0 5.0e-8) -1.0e-8 -11/2 0+i 1-i))))
+      (for-each
+       (lambda (key)
+	 (hash-table-set! h key (number->string key)))
+       keys)
+      (for-each
+       (lambda (key)
+	 (let ((val (number->string key)))
+	   (test (hash-table-ref h key) val)
+	   (when (real? key)
+	     (test (hash-table-ref h (inexact->exact key)) val)
+	     (test (hash-table-ref h (exact->inexact key)) val))
+	   (test (hash-table-ref h (+ key eps1)) val)
+	   (test (hash-table-ref h (+ key eps5)) val)
+	   (test (hash-table-ref h (+ key eps9)) val)
+	   (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f)
+	   (test (hash-table-ref h (- key eps1)) val)
+	   (test (hash-table-ref h (- key eps5)) val)
+	   (test (hash-table-ref h (- key eps9)) val)
+	   (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f)))
+       keys)
+
+      (set! h (make-hash-table 8 =))
+      (for-each
+       (lambda (key)
+	 (hash-table-set! h key (number->string key)))
+       keys)
+      (for-each
+       (lambda (key)
+	 (let ((val (number->string key)))
+	   (test (hash-table-ref h key) val)
+	   (when (real? key)
+	     (test (hash-table-ref h (inexact->exact key)) (and (= key (inexact->exact key)) val))
+	     (test (hash-table-ref h (exact->inexact key)) (and (= key (exact->inexact key)) val)))
+	   (test (hash-table-ref h (+ key eps1)) #f)
+	   (test (hash-table-ref h (+ key eps5)) #f)
+	   (test (hash-table-ref h (+ key eps9)) #f)
+	   (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f)
+	   (test (hash-table-ref h (- key eps1)) #f)
+	   (test (hash-table-ref h (- key eps5)) #f)
+	   (test (hash-table-ref h (- key eps9)) #f)
+	   (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f)))
+       keys)
+      (set! h (make-hash-table 8 eqv?))
+      (for-each
+       (lambda (key)
+	 (hash-table-set! h key (number->string key)))
+       keys)
+      (for-each
+       (lambda (key)
+	 (let ((val (number->string key)))
+	   (test (hash-table-ref h key) val)
+	   (when (real? key)
+	     (test (hash-table-ref h (inexact->exact key)) (and (exact? key) val))
+	     (test (hash-table-ref h (exact->inexact key)) (and (inexact? key) val)))
+	   (test (hash-table-ref h (+ key eps1)) #f)
+	   (test (hash-table-ref h (+ key eps5)) #f)
+	   (test (hash-table-ref h (+ key eps9)) #f)
+	   (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f)
+	   (test (hash-table-ref h (- key eps1)) #f)
+	   (test (hash-table-ref h (- key eps5)) #f)
+	   (test (hash-table-ref h (- key eps9)) #f)
+	   (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f)))
+       keys)
+      (set! h (make-hash-table 8 equal?)) ; like eqv?
+      (for-each
+       (lambda (key)
+	 (hash-table-set! h key (number->string key)))
+       keys)
+      (for-each
+       (lambda (key)
+	 (let ((val (number->string key)))
+	   (test (hash-table-ref h key) val)
+	   (when (real? key)
+	     (test (hash-table-ref h (inexact->exact key)) (and (exact? key) val))
+	     (test (hash-table-ref h (exact->inexact key)) (and (inexact? key) val)))
+	   (test (hash-table-ref h (+ key eps1)) #f)
+	   (test (hash-table-ref h (+ key eps5)) #f)
+	   (test (hash-table-ref h (+ key eps9)) #f)
+	   (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f)
+	   (test (hash-table-ref h (- key eps1)) #f)
+	   (test (hash-table-ref h (- key eps5)) #f)
+	   (test (hash-table-ref h (- key eps9)) #f)
+	   (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f)))
+       keys)))
+
+
+  (define (big-hash-table-ref table key)
+    (hash-table-ref table (bignum key)))
+
+  (let-temporarily (((*s7* 'hash-table-float-epsilon) 1.0e-9))
+    (let ((eps5 5.0e-10)
+	  (eps1 1.0e-10)
+	  (eps9 9.0e-10)
+	  (eps10 1.0001e-9)
+	  (h (make-hash-table 8 equivalent?))
+	  (keys (list 0 1.0 2.0 -2.0 1/2 7/2 1.5 2.5 3 (+ 1.0 5.0e-8) -1.0e-8 -11/2 0+i 1-i)))
+      (for-each
+       (lambda (key)
+	 (hash-table-set! h key (number->string key)))
+       keys)
+      (for-each
+       (lambda (key)
+	 (let ((val (number->string key)))
+	   (test (hash-table-ref h key) val)
+	   (when (real? key)
+	     (test (big-hash-table-ref h (inexact->exact key)) val)
+	     (test (big-hash-table-ref h (exact->inexact key)) val))
+	   (test (big-hash-table-ref h (+ key eps1)) val)
+	   (test (big-hash-table-ref h (+ key eps5)) val)
+	   (test (big-hash-table-ref h (+ key eps9)) val)
+	   (test (big-hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f)
+	   (test (big-hash-table-ref h (- key eps1)) val)
+	   (test (big-hash-table-ref h (- key eps5)) val)
+	   (test (big-hash-table-ref h (- key eps9)) val)
+	   (test (big-hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f)))
+       keys)
+      (set! h (make-hash-table 8 =))
+      (for-each
+       (lambda (key)
+	 (hash-table-set! h key (number->string key)))
+       keys)
+      (for-each
+       (lambda (key)
+	 (let ((val (number->string key)))
+	   (test (hash-table-ref h key) val)
+	   (when (real? key)
+	     (test (big-hash-table-ref h (inexact->exact key)) (and (= key (inexact->exact key)) val))
+	     (test (big-hash-table-ref h (exact->inexact key)) (and (= key (exact->inexact key)) val)))
+	   (test (big-hash-table-ref h (+ key eps1)) #f)
+	   (test (big-hash-table-ref h (+ key eps5)) #f)
+	   (test (big-hash-table-ref h (+ key eps9)) #f)
+	   (test (big-hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f)
+	   (test (big-hash-table-ref h (- key eps1)) #f)
+	   (test (big-hash-table-ref h (- key eps5)) #f)
+	   (test (big-hash-table-ref h (- key eps9)) #f)
+	   (test (big-hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f)))
+       keys)
+      (set! h (make-hash-table 8 eqv?))
+      (for-each
+       (lambda (key)
+	 (hash-table-set! h key (number->string key)))
+       keys)
+      (for-each
+       (lambda (key)
+	 (let ((val (number->string key)))
+	   (test (hash-table-ref h key) val)
+	   (when (real? key)
+	     (test (big-hash-table-ref h (inexact->exact key)) (and (exact? key) val))
+	     (test (big-hash-table-ref h (exact->inexact key)) (and (inexact? key) val)))
+	   (test (big-hash-table-ref h (+ key eps1)) #f)
+	   (test (big-hash-table-ref h (+ key eps5)) #f)
+	   (test (big-hash-table-ref h (+ key eps9)) #f)
+	   (test (big-hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f)
+	   (test (big-hash-table-ref h (- key eps1)) #f)
+	   (test (big-hash-table-ref h (- key eps5)) #f)
+	   (test (big-hash-table-ref h (- key eps9)) #f)
+	   (test (big-hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f)))
+       keys)
+      (set! h (make-hash-table 8 equal?)) ; like eqv?
+      (for-each
+       (lambda (key)
+	 (hash-table-set! h key (number->string key)))
+       keys)
+      (for-each
+       (lambda (key)
+	 (let ((val (number->string key)))
+	   (test (hash-table-ref h key) val)
+	   (when (real? key)
+	     (test (big-hash-table-ref h (inexact->exact key)) (and (exact? key) val))
+	     (test (big-hash-table-ref h (exact->inexact key)) (and (inexact? key) val)))
+	   (test (big-hash-table-ref h (+ key eps1)) #f)
+	   (test (big-hash-table-ref h (+ key eps5)) #f)
+	   (test (big-hash-table-ref h (+ key eps9)) #f)
+	   (test (big-hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f)
+	   (test (big-hash-table-ref h (- key eps1)) #f)
+	   (test (big-hash-table-ref h (- key eps5)) #f)
+	   (test (big-hash-table-ref h (- key eps9)) #f)
+	   (test (big-hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f)))
+       keys)))
+
+  (let-temporarily (((*s7* 'hash-table-float-epsilon) 1.0e-9))
+    (let ((eps5 5.0e-10)
+	  (eps1 1.0e-10)
+	  (eps9 9.0e-10)
+	  (eps10 1.0001e-9)
+	  (h (make-hash-table 8 equivalent?))
+	  (keys (list 0 1.0 2.0 -2.0 1/2 7/2 1.5 2.5 3 (+ 1.0 5.0e-8) -1.0e-8 -11/2 0+i 1-i)))
+      (for-each
+       (lambda (key)
+	 (hash-table-set! h (bignum key) (number->string (bignum key))))
+       keys)
+      (for-each
+       (lambda (key)
+	 (let ((val (number->string (bignum key))))
+	   (test (hash-table-ref h key) val)
+	   (when (real? key)
+	     (test (hash-table-ref h (inexact->exact key)) val)
+	     (test (hash-table-ref h (exact->inexact key)) val))
+	   (test (hash-table-ref h (+ key eps1)) val)
+	   (test (hash-table-ref h (+ key eps5)) val)
+	   (test (hash-table-ref h (+ key eps9)) val)
+	   (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f)
+	   (test (hash-table-ref h (- key eps1)) val)
+	   (test (hash-table-ref h (- key eps5)) val)
+	   (test (hash-table-ref h (- key eps9)) val)
+	   (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f)))
+       keys)
+      (set! h (make-hash-table 8 =))
+      (for-each
+       (lambda (key)
+	 (hash-table-set! h (bignum key) (number->string (bignum key))))
+       keys)
+      (for-each
+       (lambda (key)
+	 (let ((val (number->string (bignum key))))
+	   (test (hash-table-ref h key) val)
+	   (when (real? key)
+	     (test (hash-table-ref h (inexact->exact key)) (and (= key (inexact->exact key)) val))
+	     (test (hash-table-ref h (exact->inexact key)) (and (= key (exact->inexact key)) val)))
+	   (test (hash-table-ref h (+ key eps1)) #f)
+	   (test (hash-table-ref h (+ key eps5)) #f)
+	   (test (hash-table-ref h (+ key eps9)) #f)
+	   (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f)
+	   (test (hash-table-ref h (- key eps1)) #f)
+	   (test (hash-table-ref h (- key eps5)) #f)
+	   (test (hash-table-ref h (- key eps9)) #f)
+	   (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f)))
+       keys)
+      (set! h (make-hash-table 8 eqv?))
+      (for-each
+       (lambda (key)
+	 (hash-table-set! h (bignum key) (number->string (bignum key))))
+       keys)
+      (for-each
+       (lambda (key)
+	 (let ((val (number->string (bignum key))))
+	   (test (hash-table-ref h key) val)
+	   (when (real? key)
+	     (test (hash-table-ref h (inexact->exact key)) (and (exact? key) val))
+	     (test (hash-table-ref h (exact->inexact key)) (and (inexact? key) val)))
+	   (test (hash-table-ref h (+ key eps1)) #f)
+	   (test (hash-table-ref h (+ key eps5)) #f)
+	   (test (hash-table-ref h (+ key eps9)) #f)
+	   (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f)
+	   (test (hash-table-ref h (- key eps1)) #f)
+	   (test (hash-table-ref h (- key eps5)) #f)
+	   (test (hash-table-ref h (- key eps9)) #f)
+	   (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f)))
+       keys)
+      (set! h (make-hash-table 8 equal?)) ; like eqv?
+      (for-each
+       (lambda (key)
+	 (hash-table-set! h (bignum key) (number->string (bignum key))))
+       keys)
+      (for-each
+       (lambda (key)
+	 (let ((val (number->string (bignum key))))
+	   (test (hash-table-ref h key) val)
+	   (when (real? key)
+	     (test (hash-table-ref h (inexact->exact key)) (and (exact? key) val))
+	     (test (hash-table-ref h (exact->inexact key)) (and (inexact? key) val)))
+	   (test (hash-table-ref h (+ key eps1)) #f)
+	   (test (hash-table-ref h (+ key eps5)) #f)
+	   (test (hash-table-ref h (+ key eps9)) #f)
+	   (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f)
+	   (test (hash-table-ref h (- key eps1)) #f)
+	   (test (hash-table-ref h (- key eps5)) #f)
+	   (test (hash-table-ref h (- key eps9)) #f)
+	   (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f)))
+       keys))))
+
+(let-temporarily (((*s7* 'hash-table-float-epsilon) 1.0e-9))
+  (let ((eps5 5.0e-10)
+	(eps1 1.0e-10)
+	(eps9 9.0e-10)
+	(eps10 1.0001e-9)
+	(h (make-hash-table 8 equivalent?))
+	(keys (list +inf.0 -inf.0 +nan.0 -nan.0 +inf.0+i 1-inf.0i)))
+    (for-each
+     (lambda (key)
+       (hash-table-set! h key (number->string key)))
+     keys)
+    (for-each
+     (lambda (key)
+       (let ((val (number->string key)))
+	 (test (hash-table-ref h key) val)
+	 (test (hash-table-ref h (+ key eps1)) val)
+	 (test (hash-table-ref h (+ key eps5)) val)
+	 (test (hash-table-ref h (+ key eps9)) val)
+	 (test (hash-table-ref h (- key eps1)) val)
+	 (test (hash-table-ref h (- key eps5)) val)
+	 (test (hash-table-ref h (- key eps9)) val)
+	 ))
+     keys)
+    (set! h (make-hash-table 8 =)) ; infinities are =: (= +inf.0 (+ +inf.0 1.0e-10))
+    (for-each
+     (lambda (key)
+       (hash-table-set! h key (number->string key)))
+     keys)
+    (for-each
+     (lambda (key)
+       (let ((val (and (not (nan? key)) (number->string key))))
+	 (test (hash-table-ref h key) val)
+	 (test (hash-table-ref h (+ key eps1)) (and (infinite? (real-part key)) val)) ; eps is applied to real part
+	 (test (hash-table-ref h (+ key eps5)) (and (infinite? (real-part key)) val))
+	 (test (hash-table-ref h (+ key eps9)) (and (infinite? (real-part key)) val))
+	 (test (hash-table-ref h (- key eps1)) (and (infinite? (real-part key)) val))
+	 (test (hash-table-ref h (- key eps5)) (and (infinite? (real-part key)) val))
+	 (test (hash-table-ref h (- key eps9)) (and (infinite? (real-part key)) val))
+	 ))
+     keys)))
+
+(when with-bignums
+ (let-temporarily (((*s7* 'hash-table-float-epsilon) 1.0e-9))
+  (let ((eps5 5.0e-10)
+	(eps1 1.0e-10)
+	(eps9 9.0e-10)
+	(eps10 1.0001e-9)
+	(h (make-hash-table 8 equivalent?))
+	(keys (list
+	            18446744073709551614
+		    18446744073709551614/3
+		    18446744073709551615.0
+		    18446744073709551614+i
+		    -18446744073709551616
+		    -18446744073709551616/3
+		    -18446744073709551617.0
+		    -18446744073709551616-18446744073709551614i
+		    9223372036854775807
+		    -9223372036854775807
+		    9007199254740992
+		    9223372036854775800.1
+		    -9223372036854775800.1+i
+		    92233720368547758/19
+		    92233720368547758/5
+		    )))
+    (for-each
+     (lambda (key)
+       (hash-table-set! h key (number->string key)))
+     keys)
+    (for-each
+     (lambda (key)
+       (let ((val (number->string key)))
+	 (test (hash-table-ref h key) val)
+         (when (real? key)
+  	   (test (hash-table-ref h (inexact->exact key)) val)
+	   (test (hash-table-ref h (exact->inexact key)) val))
+	 (test (hash-table-ref h (+ key eps1)) val)
+	 (test (hash-table-ref h (+ key eps5)) val)
+	 (test (hash-table-ref h (+ key eps9)) val)
+	 (test (hash-table-ref h (- key eps1)) val)
+	 (test (hash-table-ref h (- key eps5)) val)
+	 (test (hash-table-ref h (- key eps9)) val)
+	 ))
+     keys)
+    (set! h (make-hash-table 8 =))
+    (for-each
+     (lambda (key)
+       (hash-table-set! h key (number->string key)))
+     keys)
+    (for-each
+     (lambda (key)
+       (let ((val (number->string key)))
+	 (test (hash-table-ref h key) val)
+         (when (real? key)
+  	   (test (hash-table-ref h (inexact->exact key)) (and (= key (inexact->exact key)) val))
+	   (test (hash-table-ref h (exact->inexact key)) (and (= key (exact->inexact key)) val)))
+	 (test (hash-table-ref h (+ key eps1)) #f)
+	 (test (hash-table-ref h (+ key eps5)) #f)
+	 (test (hash-table-ref h (+ key eps9)) #f)
+	 (test (hash-table-ref h (- key eps1)) #f)
+	 (test (hash-table-ref h (- key eps5)) #f)
+	 (test (hash-table-ref h (- key eps9)) #f)
+	 ))
+     keys)
+    (set! h (make-hash-table 8))
+    (for-each
+     (lambda (key)
+       (hash-table-set! h key (number->string key)))
+     keys)
+    (for-each
+     (lambda (key)
+       (let ((val (number->string key)))
+	 (test (hash-table-ref h key) val)
+         (when (real? key)
+  	   (test (hash-table-ref h (inexact->exact key)) (and (exact? key) val))
+	   (test (hash-table-ref h (exact->inexact key)) (and (inexact? key) val)))
+	 (test (hash-table-ref h (+ key eps1)) #f)
+	 (test (hash-table-ref h (+ key eps5)) #f)
+	 (test (hash-table-ref h (+ key eps9)) #f)
+	 (test (hash-table-ref h (- key eps1)) #f)
+	 (test (hash-table-ref h (- key eps5)) #f)
+	 (test (hash-table-ref h (- key eps9)) #f)
+	 ))
+     keys)
+    )))
+
+(let ((ht (make-hash-table)))
+  (set! (ht (string #\a #\null #\b)) 1)
+  (test (ht (string #\a #\null #\b)) 1)
+  (test (ht (string #\a)) #f)
+  (set! (ht (string #\a #\null #\b)) 12)
+  (test (ht (string #\a #\null #\b)) 12)
+  (fill! ht #f)
+  (test (hash-table-entries ht) 0)
+  (set! (ht #u(3 0 21)) 1)
+  (test (ht #u(3 0 21)) 1))
+
+(let ((hash (make-hash-table)))
+  (hash-table-set! hash "01234567" 1)
+  (hash-table-set! hash "012345678" 2)
+  (hash-table-set! hash "12345678" 3)
+  (hash-table-set! hash "012345670" 4)
+  (hash-table-set! hash "0123456701234567" 5)
+  (hash-table-set! hash "0123456" 6)
+  (hash-table-set! hash "012345" 7)
+  (hash-table-set! hash "01234" 8)
+  (hash-table-set! hash "0123" 9)
+  (hash-table-set! hash "012" 10)
+  (hash-table-set! hash "01235" 11)
+  (test (hash-table-ref hash "01234567") 1)
+  (test (hash-table-ref hash "012345678") 2)
+  (test (hash-table-ref hash "12345678") 3)
+  (test (hash-table-ref hash "012345670") 4)
+  (test (hash-table-ref hash "0123456701234567") 5)
+  (test (hash-table-ref hash "0123456") 6)
+  (test (hash-table-ref hash "012345") 7)
+  (test (hash-table-ref hash "01234") 8)
+  (test (hash-table-ref hash "0123") 9)
+  (test (hash-table-ref hash "012") 10)
+  (test (hash-table-ref hash "01235") 11))
+
+(let ((ht (hash-table 'a #t)))
+  (test (hash-table-entries ht) 1)
+  (do ((i 0 (+ i 1))) ((= i 10)) (set! (ht 'a) #f) (set! (ht 'a) #t))
+  (test (hash-table-entries ht) 1))
+
+(when with-bignums
+  (let ((ht (make-hash-table)))
+    (set! (ht pi) 1)
+    (test (ht pi) 1)
+    (set! (ht (bignum "1")) 32)
+    (test (ht (bignum "1")) 32)
+    (set! (ht (/ (bignum "11") (bignum "3"))) 12)
+    (test (ht (/ (bignum "11") (bignum "3"))) 12)
+    (set! (ht (bignum "1+i")) -1)
+    (test (ht (bignum "1+i")) -1)
+    (set! (ht 3) 2)
+    (test (ht 3) 2)
+    (set! (ht 3.0) 3)
+    (test (ht 3.0) 3)))
+
+(test (hash-table?) 'error)
+(test (hash-table? 1 2) 'error)
+
+(test (make-hash-table most-positive-fixnum) 'error)
+(test (make-hash-table most-negative-fixnum) 'error)
+(test (make-hash-table 10 1) 'error)
+
+(let () ; size bug noticed by K.M. -- libasan reports it
+  (define hash (make-hash-table 1)) ;; Size must be 1.
+  (set! (hash :hello) "a50")
+  (gc))
+
+(let ((ht (make-hash-table)))
+  (test (hash-table? ht ht) 'error)
+  (test (hash-table-ref ht #\a #\b) 'error)
+  (test (hash-table-ref ht) 'error)
+  (test (hash-table-ref) 'error)
+  (test (hash-table-set!) 'error)
+  (test (hash-table-set! ht) 'error)
+  (test (hash-table-set! ht #\a) 'error)
+  (test (hash-table-set! ht #\a #\b #\c) 'error)
+  (set! (ht 'key) 32)
+  (test (fill! ht 123) 123)
+  (test (ht 'key) 123)
+  (set! (ht 'key) 32)
+  (test (ht 'key) 32)
+  (set! (ht :key) 123)
+  (test (ht 'key) 32)
+  (test (ht :key) 123)
+  (fill! ht ())
+  (test (ht 'key) ()))
+
+(let ((H (hash-table)))
+  (test (set! (H (inlet 'a 1 'b 2 'c 3)) 1) 1)
+  (test (H (inlet 'a 1 'b 2 'c 3)) 1)
+  (test (set! (H (inlet 'b 2 'c 3 'a 1)) 2) 2)
+  (test (H (inlet 'a 1 'b 2 'c 3)) 2)
+  (test (equal? (inlet 'b 2 'c 3 'a 1) (inlet 'a 1 'b 2 'c 3)) #t)
+  (test H (hash-table (inlet 'a 1 'b 2 'c 3) 2)))
+
+(let ((H (hash-table)))
+  (test (set! (H (c-pointer 0)) 1) 1)
+  (test (H (c-pointer 0)) 1)
+  (test (set! (H (c-pointer 0)) 2) 2)
+  (test (H (c-pointer 0)) 2)
+  (test (set! (H (c-pointer 1)) 3) 3)
+  (test (hash-table-entries H) 2)
+  (test (H (c-pointer 1)) 3)
+  (test (equal? (c-pointer 0) (c-pointer 0)) #t)
+  (test (eq? (c-pointer 0) (c-pointer 0)) #f))
+
+(let ((H (hash-table)))
+  (test (hash-table-set! H #asdf 1) 1)
+  (test (hash-table-ref H #asdf) 1)
+  (test (set! (H #<undefined>) 2) 2)
+  (test (H #<undefined>) 2))
+
+(let ((ht (make-hash-table)))
+  (test (hash-table-set! ht #\a 'key) 'key)
+  (for-each
+   (lambda (arg)
+     (test (hash-table-set! ht arg 3.14) 3.14))
+   (list #\a #(1 2 3) 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+  (for-each
+   (lambda (arg)
+     (test (hash-table-ref ht arg) 3.14))
+   (list #\a #(1 2 3) 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+  (test (length ht 123) 'error))
+
+(for-each
+ (lambda (arg)
+   (test (make-hash-table arg) 'error))
+ (list "hi" -1 0 #\a 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(let ((lst (list 1 2)))
+  (set-cdr! (cdr lst) lst)
+  (test (object->string (hash-table 'a lst)) "(hash-table 'a #1=(1 2 . #1#))")
+  (test (object->string (hash-table lst lst)) "(hash-table #1=(1 2 . #1#) #1#)")
+  (test (object->string (hash-table lst 1)) "(hash-table #1=(1 2 . #1#) 1)"))
+
+(let ()
+ (define ht (make-hash-table))
+ (set! (ht 123) "123")
+ (set! (ht 456) "456")
+ (define hti (make-iterator ht))
+ (test (iterator? hti) #t)
+ (test (object->string hti) "#<iterator: hash-table>")
+ (test (equal? hti hti) #t)
+ (test (eq? hti hti) #t)
+ (test (eqv? hti hti) #t)
+ (test (equivalent? hti hti) #t)
+
+ (let ((hti2 hti))
+   (test (equal? hti2 hti) #t)
+   (test (equivalent? hti2 hti) #t)
+   (set! hti2 (copy hti))
+   (test (equal? hti2 hti) #t)
+   (test (equivalent? hti2 hti) #t)
+   (test (let ((val (hti2))) (or (equal? val '(123 . "123")) (equal? val '(456 . "456")))) #t) ; order depends on table size
+   (test (equal? hti2 hti) #f)
+   (test (equivalent? hti2 hti) #f)
+   )
+
+ (let ((vals (list (hti) (hti))))
+   (if (not (equal? (sort! vals (lambda (a b) (< (car a) (car b)))) '((123 . "123") (456 . "456"))))
+       (format #t ";iterator: ~A~%" vals))
+   (let ((val (hti)))
+     (if (not (eof-object? val))
+	 (format #t ";iterator at end: ~A~%" val)))
+   (let ((val (hti)))
+     (if (not (eof-object? val))
+	 (format #t ";iterator at end (2): ~A~%" val)))))
+
+(test (make-iterator) 'error)
+(test (make-iterator (make-hash-table) 1) 'error)
+(test (iterator?) 'error)
+(test (iterator? 1 2) 'error)
+
+(let ()
+  (define (get-iter)
+    (let ((ht (hash-table 'a 1 'b 2)))
+      (test (hash-table-entries ht) 2)
+      (make-iterator ht)))
+  (let ((hti (get-iter)))
+    (gc)
+    (let ((a (hti)))
+      (let ((b (hti)))
+	(let ((c (hti)))
+	  (test (let ((lst (list a b c)))
+		  (or (equal? lst '((a . 1) (b . 2) #<eof>))
+		      (equal? lst '((b . 2) (a . 1) #<eof>))))
+		#t))))))
+
+(let ((ht1 (make-hash-table))
+      (ht2 (make-hash-table)))
+  (test (equal? ht1 ht2) #t)
+  (test (equal? ht1 (make-vector (length ht1) ())) #f)
+  (hash-table-set! ht1 'key 'hiho)
+  (test (equal? ht1 ht2) #f)
+  (hash-table-set! ht2 'key 'hiho)
+  (test (equal? ht1 ht2) #t)
+
+  (hash-table-set! ht1 'a ())
+  (test (ht1 'a) ())
+  )
+
+(let ((ht (make-hash-table 1)))
+  (test (>= (length ht) 1) #t)
+  (set! (ht 1) 32)
+  (test (>= (length ht) 1) #t))
+
+(let ((ht (hash-table "hi" 32 "ho" 1)))
+  (test (hash-table-entries ht) 2)
+  (test (ht "hi") 32)
+  (test (ht "ho") 1))
+
+(let ((ht (hash-table "hi" 32 "ho" 1)))
+  (test (hash-table-entries ht) 2)
+  (test (ht "hi") 32)
+  (test (ht "ho") 1))
+
+(let ((ht (hash-table)))
+  (test (hash-table? ht) #t)
+  (test (>= (length ht) 1) #t)
+  (test (ht 1) #f))
+
+(let ((ht (hash-table)))
+  (test (hash-table? ht) #t)
+  (test (>= (length ht) 1) #t)
+  (test (ht 1) #f))
+
+(test (let () (define gakk (make-hash-table 10 (cons equal? (lambda (x) #t)))) (gakk #f)) 'error)
+(test (let ((h (make-hash-table 8 (cons equal? (lambda (x) pi))))) (hash-table-set! h 'a 0)) 'error)
+(test (set! ((hash-table 'a 1.5)) 32) 'error) ; no key for (implicit) hash-table-set!
+
+(for-each
+ (lambda (arg)
+   (test (hash-table arg) 'error)
+   (test ((hash-table 'a arg) 'a) arg)
+   (test ((hash-table arg 'a) arg) 'a))
+ (list "hi" -1 0 #\a 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t abs #<eof> #<unspecified> (lambda () 1)))
+
+(let ((ht (make-hash-table))
+      (lst (list 1)))
+  (set-cdr! lst lst)
+  (set! (ht lst) lst)
+  (let ((lst1 (list 1 2)))
+    (set-cdr! (cdr lst1) lst1)
+    (set! (ht lst1) lst1)
+    (test (ht lst) lst)
+    (test (ht lst1) lst1)
+    (test (or (string=? (object->string ht) "(hash-table #1=(1 2 . #1#) #1# #2=(1 . #2#) #2#)")
+	      (string=? (object->string ht) "(hash-table #1=(1 . #1#) #1# #2=(1 2 . #2#) #2#)"))
+	  #t)))
+
+(test (set! (hash-table) 1) 'error)
+(test (set! (hash-table) 1) 'error)
+(test (set! (make-hash-table) 1) 'error)
+
+(let ((ht (make-hash-table)))
+  (test (map (lambda (x) x) ht) ())
+  (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht) ctr) 0)
+  (test (map (lambda (x y) (cons x y)) (list 1 2 3) ht) ())
+  ;(test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) #(1 2 3) ht) ctr) 0) ; this is now an error 15-Jan-15
+  (test (map (lambda (x y) (cons x y)) ht "123") ())
+  (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht ()) ctr) 'error) ; 2 args
+
+  (let ((rt (reverse ht)))
+    (test (map (lambda (x) x) rt) ())
+    (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) rt) ctr) 0))
+
+  (set! (ht 1) 32)
+  ;; these need to be independent of entry order
+
+  (test (sort! (map (lambda (x) (cdr x)) ht) <) '(32))
+  (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht) ctr) 1)
+  (test (map (lambda (x y) (cons x y)) () ht) ())
+  (test (let ((ctr 0)) (for-each (lambda (x y) (set! ctr (+ ctr 1))) ht "") ctr) 0)
+  (test (sort! (map (lambda (x y) (max (cdr x) y)) ht (list 1 2 3)) <) '(32))
+  (test (let ((ctr 0)) (for-each (lambda (x y) (set! ctr (max (cdr x) y))) ht #(1 2 3)) ctr) 32)
+
+  (let ((rt (reverse ht)))
+    (test (equal? (rt 32) 1) #t)
+    (test (equal? (rt 1) #f) #t)
+    (test (ht (rt 32)) 32)
+    (test (sort! (map (lambda (x) (cdr x)) rt) <) '(1))
+    (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) rt) ctr) 1)
+    (for-each (lambda (x) (test (ht (rt (cdr x))) (cdr x)) (test (rt (ht (car x))) (car x))) ht)
+    (set! (rt 32) 123)
+    (test (rt 32) 123)
+    (test (ht 32) #f)
+    (test (ht 1) 32))
+
+  (set! (ht 2) 1)
+  (test (ht (ht 2)) 32)
+  (test (sort! (map (lambda (x) (cdr x)) ht) <) '(1 32))
+  (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht) ctr) 2)
+  (set! (ht 3) 123)
+  (test (sort! (map (lambda (x) (cdr x)) ht) <) '(1 32 123))
+  (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht) ctr) 3)
+  (test (let ((ctr 0)) (for-each (lambda (x y) (set! ctr (+ ctr 1))) ht '(1)) ctr) 1)
+  (test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr 1))) "12" ht '(1)) ctr) 1)
+  (test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr 1))) "12" ht '(1 2)) ctr) 2)
+  (test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr 1))) "12345" ht '(1 2 3 4 5 6)) ctr) 3)
+
+  (test (sort! (map (lambda (x y) (max x (cdr y))) (list -1 -2 -3 -4) ht) <) '(1 32 123))
+  (test (let ((sum 0)) (for-each (lambda (x y) (set! sum (+ sum x (cdr y)))) #(10 20 30) ht) sum) 216)
+
+
+  (let ((rt (reverse ht)))
+    (for-each (lambda (x) (test (ht (rt (cdr x))) (cdr x)) (test (rt (ht (car x))) (car x))) ht))
+
+  (set! (ht (list 1 2 3)) "hi")
+  (test (ht '(1 2 3)) "hi")
+  (test (ht 2) 1)
+  (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht) ctr) 4)
+  (set! (ht "hi") 2)
+  (test (ht "hi") 2)
+  (test (ht (ht (ht "hi"))) 32)
+
+  (let ((rt (reverse ht)))
+    (test (rt "hi") '(1 2 3))
+    (test (rt 2) "hi")
+    (for-each (lambda (x) (test (ht (rt (cdr x))) (cdr x)) (test (rt (ht (car x))) (car x))) ht)
+    (set! (rt 2) "ho")
+    (test (rt 2) "ho")
+    (test (ht '(1 2 3)) "hi")
+    (set! (rt 123) 321)
+    (test (rt 123) 321)
+    (test (ht 3) 123))
+
+  (fill! ht 0)
+  (set! (ht "hi") 1)
+  (set! (ht "hoi") 2)
+  (test (sort! (map (lambda (x) (cdr x)) ht) <) '(0 0 0 0 1 2))
+  (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht) ctr) 6)
+
+  (let ((rt (reverse ht)))
+    (test (rt 2) "hoi")
+    (set! (rt 2) "ha")
+    (test (ht "hoi") 2))
+
+  (set! (ht #\a) #\b)
+  (test (ht #\a) #\b)
+  (test (ht "hi") 1)
+
+  (set! ht (hash-table))
+  (set! (ht #(1)) #(2))
+  (test (ht #(1)) #(2))
+  (set! (ht '(1)) '(3))
+  (set! (ht "1") "4")
+  ;(set! (ht ht) "5")
+  ;(test (ht ht) "5")
+  (test (ht '(1)) '(3))
+  (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht) ctr) 3)
+
+  (let ((rt (reverse ht)))
+    ;(test (rt "5") ht)
+    (test (rt "4") "1")
+    (for-each (lambda (x)
+		(test (ht (rt (cdr x))) (cdr x))
+		(test (rt (ht (car x))) (car x)))
+	      ht))
+  )
+
+(let ((ht (make-hash-table)))
+  (let ((str (string (integer->char 255)))
+	(u8 #u(254 0))
+	(rl 1e18)
+	(int most-negative-fixnum)
+	(rat (/ 1 most-negative-fixnum)))
+    (set! (ht str) 1)
+    (set! (ht u8) 2)
+    (set! (ht rl) 3)
+    (set! (ht int) 4)
+    (set! (ht rat) 5)
+    (test (ht str) 1)
+    (test (ht u8) 2)
+    (test (ht rl) 3)
+    (test (ht int) 4)
+    (test (ht rat) 5)))
+
+(let ((ht1 (make-hash-table 32))
+      (ht2 (make-hash-table 1024)))
+  (do ((i 0 (+ i 1)))
+      ((= i 256))
+    (let ((str (number->string i)))
+      (set! (ht1 str) i)
+      (set! (ht2 i) str)))
+
+  (let ((cases 0))
+    (for-each
+     (lambda (a b)
+       (if (not (equal? (string->number (car a)) (cdr a)))
+	   (format #t ";hash-table for-each (str . i): ~A?~%" a))
+       (if (not (equal? (number->string (car b)) (cdr b)))
+	   (format #t ";hash-table for-each (i . str): ~A?~%" b))
+       (set! cases (+ cases 1)))
+     ht1 ht2)
+    (if (not (= cases 256))
+	(format #t ";hash-table for-each cases: ~A~%" cases)))
+
+  (let ((iter1 (make-iterator ht1))
+	(iter2 (make-iterator ht2)))
+    (test (equal? iter1 iter2) #f)
+    (test (equivalent? iter1 iter2) #f)
+    (test (iterator? iter2) #t)
+    (let ((cases 0))
+      (do ((a (iter1) (iter1))
+	   (b (iter2) (iter2)))
+	  ((or (eof-object? a)
+	       (eof-object? b)))
+	(if (not (equal? (string->number (car a)) (cdr a)))
+	    (format #t ";hash-table iter1 (str . i): ~A?~%" a))
+	(if (not (equal? (number->string (car b)) (cdr b)))
+	    (format #t ";hash-table iter2 (i . str): ~A?~%" b))
+	(set! cases (+ cases 1)))
+      (if (not (= cases 256))
+	  (format #t ";hash-table iter1/2 cases: ~A~%" cases)))))
+
+(let ((ht (make-hash-table 31)))
+  (let ((ht1 (make-hash-table 31)))
+    (set! (ht1 'a1) 'b1)
+    (set! (ht 'a0) ht1)
+    (test ((ht 'a0) 'a1) 'b1)
+    (test (hash-table-ref ht 'a0 'a1) 'b1)
+    (test (ht 'a0 'a1) 'b1)))
+
+(let ((ht (make-hash-table 31))
+      (e (curlet)))
+  (define (a-func a) (+ a 1))
+  (define-macro (a-macro a) `(+ 1 , a))
+  (define (any-func a) (let ((x a)) (lambda () x)))
+
+  (set! (ht abs) 1)
+  (set! (ht begin) 2)
+  (set! (ht quasiquote) 3)
+  (set! (ht a-func) 4)
+  (set! (ht a-macro) 5)
+  (set! (ht (any-func 6)) 6)
+  (set! (ht e) 7)
+  (test (ht e) 7)
+  (set! (ht (rootlet)) 8)
+  (test (ht abs) 1)
+  (test (ht round) #f)
+  (test (ht quasiquote) 3)
+  (test (ht begin) 2)
+  (test (ht lambda) #f)
+  (test (ht a-func) 4)
+  (test (ht a-macro) 5)
+  (test (ht (any-func 6)) #f)
+  (test (ht (rootlet)) 8)
+  (call-with-exit
+   (lambda (return)
+     (set! (ht return) 9)
+     (test (ht return) 9)))
+  ;(set! (ht ht) 10)
+  ;(test (ht ht) 10)
+  )
+
+;;; weak-hash-table?
+(for-each
+ (lambda (arg)
+   (test (weak-hash-table? arg) #f))
+ (list "hi" () -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(test (weak-hash-table? (hash-table)) #f)
+(test (weak-hash-table? (make-weak-hash-table)) #t)
+(test (weak-hash-table? (append (weak-hash-table 'a 1) (weak-hash-table 'b 2))) #t)
+(test (weak-hash-table? (append (hash-table 'a 1) (weak-hash-table 'b 2))) #f)
+(test (weak-hash-table? (append (weak-hash-table 'a 1) (hash-table 'b 2))) #t)
+(test (weak-hash-table? (append (weak-hash-table 'a 1) (vector (cons 'b 2)))) #t)
+(test (reverse (weak-hash-table 'a 1 'b 2)) (weak-hash-table 1 'a 2 'b))
+(test (weak-hash-table? (reverse (weak-hash-table 'a 1))) #t)
+
+(test (let ((h (make-weak-hash-table))) (set! (h 'a) 1) (object->string h :readable)) "(weak-hash-table 'a 1)")
+(test (equal? (weak-hash-table 'a 1) (weak-hash-table 'a 1)) #t)
+(test (object->string (weak-hash-table)) "(weak-hash-table)")
+(test (object->string (make-iterator (weak-hash-table 'a 1))) "#<iterator: weak-hash-table>")
+(test (object->string (make-iterator (weak-hash-table 'a 1)) :readable) "(make-iterator (weak-hash-table 'a 1))")
+(test (object->string (immutable! (weak-hash-table)) :readable) "(immutable! (weak-hash-table))")
+(test (object->string (reverse (weak-hash-table 'a 1 'b 2))) "(weak-hash-table 1 a 2 b)")
+
+(when full-s7test
+  (do ((z 0 (+ z 1)))
+      ((= z 10))
+    (let ((keys (make-vector 100))
+	  (wht (make-weak-hash-table)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 100))
+	(set! (keys i) (list (random 100) (random 100)))
+	(set! (wht (keys i)) i))
+      (do ((i 0 (+ i 1)))
+	  ((= i 10000))
+	(let ((key (random 100)))
+	  (set! (keys key) (list (random 100) (random 100)))
+	  (if (> (random 100) 50)
+	      (set! (wht (keys key)) i)
+	      (if (> (random 100) 90)
+		  (do ((k 0 (+ k 1)))
+		      ((= k 100))
+		    (set! (wht (keys k)) k)))))
+	(when (zero? (hash-table-entries wht))
+	  (do ((k 0 (+ k 1)))
+	      ((= k 100))
+	    (set! (wht (keys k)) k))))))
+  (let ((wht (make-weak-hash-table)))
+    (do ((i 0 (+ i 1)))
+	((= i 1000))
+      (set! (wht (list i)) i))
+    (do ((i 0 (+ i 1)))
+	((= i 1000))
+      (for-each
+       (lambda (p)
+	 (unless (pair? p)
+	   (format *stderr* "p: ~S~%" p)))
+       wht))))
+
+(test (let ((h1 (hash-table 'a 1 'b 2)) (h2 (make-hash-table 31))) (set! (h2 'a) 1) (set! (h2 'b) 2.0) (equivalent? h1 h2)) #t)
+(test (let ((h1 (hash-table 'a 1 'b 2)) (h2 (make-hash-table 31))) (set! (h2 'a) 1.0) (set! (h2 'b) 2) (equivalent? (list h1) (list h2))) #t)
+
+;(test (let ((ht (make-hash-table))) (hash-table-set! ht ht 1) (ht ht)) #f)
+; this is #f now because the old ht is not equal to the new one (different number of entries)
+;(test (let ((ht (make-hash-table))) (hash-table-set! ht ht ht) (equal? (ht ht) ht)) #t)
+
+(test (let ((ht (make-hash-table))) (hash-table-set! ht 'a ht) (object->string ht)) "#1=(hash-table 'a #1#)")
+(test (let ((h1 (make-hash-table))) (hash-table-set! h1 "hi" h1) (object->string h1)) "#1=(hash-table \"hi\" #1#)")
+(test (let ((ht (make-hash-table))) (hash-table-set! ht 'a ht) (equivalent? ht (copy ht))) #t)
+(test (let ((ht (make-hash-table))) (hash-table-set! ht 'a ht) (equal? ht (copy ht))) #t)
+
+(test (hash-table 'a 1 'b) 'error)
+
+;; there's no real need for multidim hashes:
+
+(let ((ht (make-hash-table)))
+   (set! (ht (cons 'a 1)) 'b)
+   (set! (ht (cons 'a 2)) 'c)
+   (set! (ht (cons 'b 1)) 'd)
+   (test (ht '(a . 1)) 'b)
+   (test (ht '(b . 1)) 'd)
+   (set! (ht '(a . 2)) 32)
+   (test (ht '(a . 2)) 32)
+   (let ((lst1 (list 1))
+	 (lst2 (list 1)))
+     (set-car! lst1 lst2)
+     (set-car! lst2 lst1)
+     (set! (ht lst1) 32)
+     (set! (ht lst2) 3)
+     (test (equal? lst1 lst2) #t)
+     (test (ht lst1) 3)
+     (test (ht lst2) 3)))
+
+(let ((ht (make-hash-table)))
+  (set! (ht 1.0) 'a)
+  (set! (ht 2.0) 'b)
+  (set! (ht 3.0) 'c)
+  (test (ht 2.0) 'b)
+  (set! (ht 2.0) 'd)
+  (test (ht 2.0) 'd)
+  (test (ht 0.0) #f)
+  (test (ht 1.0) 'a))
+
+(let ((ht (make-hash-table)))
+  (test (ht) 'error)
+  (test (ht 0 1) 'error))
+
+(let ((h (hash-table 'a (hash-table 'b 2 'c 3)
+		      'b (hash-table 'b 3 'c 4))))
+  (test (h 'a 'b) 2)
+  (test (h 'b 'b) 3)
+  (test (h 'a 'c) 3))
+
+(let ()
+  (define-macro (memoize f)
+    `(define ,f (let ((ht (make-hash-table))
+		      (old-f ,f))
+		  (lambda args
+		    (or (ht args)
+			(let ((new-val (apply old-f args)))
+			  (set! (ht args) new-val)
+			  new-val))))))
+
+  (define (our-abs num) (abs num))
+  (memoize our-abs)
+  (num-test (our-abs -1) 1)
+  (with-let (funclet our-abs)
+    (test (ht '(-1)) 1)))
+
+(let ()
+  (define-macro (define-memoized name&arg . body)
+    (let ((arg (cadr name&arg))
+	  (memo (gensym "memo")))
+      `(define ,(car name&arg)
+	 (let ((,memo (make-hash-table)))
+	   (lambda (,arg)
+	     (or (,memo ,arg)
+		 (set! (,memo ,arg) (begin ,@body))))))))
+
+  (define-memoized (f1 abc) (+ abc 2))
+  (test (f1 3) 5)
+  (test (f1 3) 5)
+  (test (f1 2) 4)
+  (let ((ht (call-with-exit
+	     (lambda (return)
+	       (for-each (lambda (x)
+			   (if (hash-table? (cdr x))
+			       (return (cdr x))))
+			 (outlet (funclet f1)))
+	       #f))))
+    (if (not (hash-table? ht))
+	(format #t ";can't find memo? ~A~%" (let->list (outlet (funclet f1))))
+	(test (length (map (lambda (x) x) ht)) 2))))
+
+(let ()
+  (define-macro (define-memoized name&args . body)
+    (let ((args (cdr name&args))
+	  (memo (gensym "memo")))
+      `(define ,(car name&args)
+	 (let ((,memo (make-hash-table)))
+	   (lambda ,args
+	     (or (,memo (list ,@args))
+		 (set! (,memo (list ,@args)) (begin ,@body))))))))
+
+  (define (ack m n)
+    (cond ((= m 0) (+ n 1))
+	  ((= n 0) (ack (- m 1) 1))
+	  (else (ack (- m 1) (ack m (- n 1))))))
+
+  (define-memoized (ack1 m n)
+    (cond ((= m 0) (+ n 1))
+	  ((= n 0) (ack1 (- m 1) 1))
+	  (else (ack1 (- m 1)
+		      (ack1 m (- n 1))))))
+
+  (test (ack 2 3) (ack1 2 3)))
+
+
+(let ((ht (make-hash-table)))
+  (test (eq? (car (catch #t (lambda () (set! (ht) 2)) (lambda args args))) 'wrong-number-of-args) #t)
+  ;;(test (eq? (car (catch #t (lambda () (set! (ht 0 0) 2)) (lambda args args))) 'syntax-error) #t)
+  (test (eq? (car (catch #t (lambda () (set! ((ht 0) 0) 2)) (lambda args args))) 'no-setter) #t))
+
+(let ()
+  (define merge-hash-tables append)
+  (let ((ht (merge-hash-tables (hash-table 'a 1 'b 2) (hash-table 'c 3))))
+    (test (ht 'c) 3))
+  (test ((append (hash-table 'a 1 'b 2) (hash-table 'c 3)) 'c) 3))
+
+;;; test the eq-func business
+(test (make-hash-table 8 '(atan abs)) 'error)
+(test (make-hash-table 8 (cons atan abs)) 'error)
+(test (make-hash-table 8 (cons eq? sqrt)) 'error)
+
+(let ((ht (make-hash-table 8 eq?)))
+  (test (hash-table-ref ht 'a) #f)
+  (hash-table-set! ht 'a 1)
+  (hash-table-set! ht 'c 'd)
+  (test (hash-table-ref ht 'a) 1)
+  (hash-table-set! ht "hi" 3)
+  (test (hash-table-ref ht "hi") #f)
+  (set! (ht '(a . 1)) "ho")
+  (test (ht '(a . 1)) #f)
+  (let ((ht1 (copy ht)))
+    (test (ht1 'a) 1)
+    (test (ht1 "hi") #f)
+    (set! (ht1 #\a) #\b)
+    (test (ht1 #\a) #\b)
+    (test (ht #\a) #f)
+    (let ((ht2 (reverse ht1)))
+      (test (ht1 #\a) #\b)
+      (test (ht2 #\b) #\a)
+      (test (ht2 'd) 'c)))
+  (do ((i 0 (+ i 1)))
+      ((= i 32))
+    (set! (ht (symbol "g" (number->string i))) i))
+  (test (ht 'a) 1)
+  (test (ht 'g3) 3)
+  (set! (ht ht) 123)
+  (test (ht ht) 123))
+
+(let ((ht (make-hash-table 31 string=?)))
+  (test (length ht) 32)
+  (set! (ht "hi") 'a)
+  (test (ht "hi") 'a)
+  (test (ht "Hi") #f)
+  (test (set! (ht 32) 'b) (if (> (*s7* 'safety) 0) 'error 'b))
+  (test (ht 32) #f)
+  )
+
+(let ((ht (make-hash-table 8 string=?)))
+  (set! (ht "a string longer than 8 chars") 32)
+  (test (ht "a string longer than 8 chars") 32)
+  (set! (ht "") 3)
+  (test (ht "") 3)
+  (set! (ht "") #f)
+  (test (ht "") #f))
+
+(let ((ht (make-hash-table 31 char=?)))
+  (test (length ht) 32)
+  (set! (ht #\a) 'a)
+  (test (ht #\a) 'a)
+  (test (ht #\A) #f)
+  (test (set! (ht 32) 'b) (if (> (*s7* 'safety) 0) 'error 'b))
+  (test (ht 32) #f)
+  )
+
+(unless pure-s7
+  (let ((ht (make-hash-table 31 string-ci=?)))
+    (test (length ht) 32)
+    (set! (ht "hi") 'a)
+    (test (ht "hi") 'a)
+    (test (ht "Hi") 'a)
+    (test (ht "HI") 'a)
+    (test (set! (ht 32) 'b) (if (> (*s7* 'safety) 0) 'error 'b))
+    (test (ht 32) #f)
+    )
+
+  (let ((ht (make-hash-table 31 char-ci=?)))
+    (test (length ht) 32)
+    (set! (ht #\a) 'a)
+    (test (ht #\a) 'a)
+    (test (ht #\A) 'a)
+    (test (set! (ht 32) 'b) (if (> (*s7* 'safety) 0) 'error 'b))
+    (test (ht 32) #f)
+    ))
+
+(let ((ht (make-hash-table 31 =)))
+  (test (length ht) 32)
+  (set! (ht 1) 'a)
+  (test (ht 1.0) 'a)
+  (test (ht 1+i) #f)
+  (set! (ht 32) 'b)
+  (test (ht 32) 'b)
+  (set! (ht 1/2) 'c)
+  (test (ht 0.5) 'c)
+  )
+
+(let ((ht (make-hash-table 31 eqv?)))
+  (test (length ht) 32)
+  (set! (ht 1) 'a)
+  (test (ht 1.0) #f)
+  (set! (ht 2.0) 'b)
+  (test (ht 2.0) 'b)
+  (set! (ht 32) 'b)
+  (test (ht 32) 'b)
+  (set! (ht #\a) 1)
+  (test (ht #\a) 1)
+  (set! (ht ()) 2)
+  (test (ht ()) 2)
+  (set! (ht abs) 3)
+  (test (ht abs) 3)
+  )
+
+(let ((ht (make-hash-table 8 (cons string=? (lambda (a) (string-length a))))))
+  (set! (ht "a") 'a)
+  (test (ht "a") 'a)
+  (set! (ht "abc") 'abc)
+  (test (ht "abc") 'abc))
+
+(let ((ht (make-hash-table 8 (cons eq? (lambda (a) (hash-table-ref a a))))))
+  (test (set! (ht ht) 1) 'error)) ; ;hash-table mapper called recursively
+
+(let ((ht (make-hash-table 8 (cons (lambda (a b) (string=? a b)) string-length))))
+  (set! (ht "a") 'a)
+  (test (ht "a") 'a)
+  (set! (ht "abc") 'abc)
+  (test (ht "abc") 'abc))
+
+(let ((ht (make-hash-table 8 (cons (lambda (a b) (string=? a b)) (lambda (a) (string-length a))))))
+  (set! (ht "a") 'a)
+  (test (ht "a") 'a)
+  (set! (ht "abc") 'abc)
+  (test (ht "abc") 'abc))
+
+(let ((ht (make-hash-table 8 (cons string=? string-length))))
+  (set! (ht "a") 'a)
+  (test (ht "a") 'a)
+  (set! (ht "abc") 'abc)
+  (test (ht "abc") 'abc))
+
+(let-temporarily (((*s7* 'equivalent-float-epsilon) 1e-15))
+  (let ((h (make-hash-table 8 equal?)))
+    (set! (h (make-int-vector 3 0)) 3)
+    (test (h (make-int-vector 3 0)) 3)
+    (test (h (make-vector 3 0)) 3) ; vector equality changed 19-Sep-18
+    (test (h (make-float-vector 3 0)) #f)
+    (let ((x 1.0)
+	  (y (+ 1.0 (* 0.5 (*s7* 'equivalent-float-epsilon))))
+	  (z (+ 1.0 (* 1000 (*s7* 'equivalent-float-epsilon))))) ; !
+      (set! (h x) 12)
+      (test (h x) 12)
+      (test (h y) #f)
+      (test (h z) #f))))
+
+(let ((h (make-hash-table 8 equivalent?)))
+  (set! (h (make-int-vector 3 0)) 3)
+  (test (h (make-int-vector 3 0)) 3)
+  (test (h (make-vector 3 0)) 3)
+  (test (h (make-float-vector 3 0)) 3)
+  (let ((x 1.0)
+	(y (+ 1.0 (* 0.5 (*s7* 'hash-table-float-epsilon))))
+	(z (+ 1.0 (* 2 (*s7* 'hash-table-float-epsilon)))))
+    (set! (h x) 12)
+    (test (h x) 12)
+    (test (h y) 12)
+    (test (h z) #f)
+    (set! (h 1/10) 3)
+    (test (h 0.1) 3)
+    (set! (h #(1 2.0)) 4)
+    (test (h (vector 1 2)) 4)
+    (set! (h 1.0) 5)
+    (test (h 1) 5)
+    (set! (h (list 3)) 6)
+    (test (h (list 3.0)) 6)
+    ))
+
+(when with-block
+  (let ((ht (make-hash-table 31 (cons hash_heq hash_hloc))))
+    (test (length ht) 32)
+    (set! (ht 'a) 'b)
+    (test (ht 'a) 'b)
+    (test (ht 1) #f)
+    (let ((ht1 (reverse ht)))
+      (test (ht1 'b) 'a)))
+  (let () ; Radium op_x_aa needs_copied_args bugs (collides with c_object equal test)
+    (define (f h b ind)
+      (h b ind))
+    (define (ftest)
+      (let ((h1 (make-hash-table 8 equal?)))
+        (let ((b1 (block 0 1 2))
+	      (b2 (block 3 4 5)))
+	  (hash-table-set! h1 b1 (hash-table :a 1))
+ 	  (hash-table-set! h1 b2 (inlet :a 2))
+ 	  (test (f h1 b1 :a) 1) ; #f if bug
+	  (test (f h1 b2 :a) 2))))
+    (ftest)))
+
+(let ((ht (make-hash-table 31 equivalent?))
+      (ht1 (make-hash-table 31)))
+  (test (length ht) 32)
+  (test (equal? ht ht1) #t)
+  (set! (ht 3) 1)
+  (test (ht 3) 1)
+  (set! (ht1 3) 1)
+  (test (equal? ht ht1) #f)
+  (set! (ht 3.14) 'a)
+  (test (ht 3.14) 'a)
+  (set! (ht "hi") 123)
+  (test (ht "hi") 123)
+  (set! (ht 1/0) #<eof>)
+  (test (ht 1/0) #<eof>))
+
+(let ((ht (make-hash-table 31 (cons (lambda (a b) (eq? a b)) (lambda (a) 0)))))
+  (test (hash-table-ref ht 'a) #f)
+  (hash-table-set! ht 'a 1)
+  (hash-table-set! ht 'c 'd)
+  (test (hash-table-ref ht 'a) 1)
+  (hash-table-set! ht "hi" 3)
+  (test (hash-table-ref ht "hi") #f)
+  (set! (ht '(a . 1)) "ho")
+  (test (ht '(a . 1)) #f)
+  (let ((ht1 (copy ht)))
+    (test (ht1 'a) 1)
+    (test (ht1 "hi") #f)
+    (test (equal? ht ht1) #t)
+    (test (equal? ht1 ht) #t)
+    (test (equivalent? ht ht1) #t)
+    (test (equivalent? ht1 ht) #t)
+    (set! (ht1 #\a) #\b)
+    (test (ht1 #\a) #\b)
+    (test (ht #\a) #f)))
+
+(when (provided? 'snd)
+  (let ((ht (make-hash-table 31 (cons equal? mus-type))))
+    (let ((g1 (make-oscil 100))
+	  (g2 (make-oscil 100)))
+      (set! (ht g1) 32)
+      (test (ht g1) 32)
+      (test (ht g2) 32)
+      (test (equal? g1 g2) #t))))
+
+;;; hash-table typers
+
+(test ((object->let (make-hash-table 8 #f (cons symbol? integer?))) 'signature) '(integer? hash-table? symbol?))
+(let ((x (copy (make-hash-table 8 #f (cons symbol? integer?))))) (test ((object->let x) 'signature) '(integer? hash-table? symbol?)))
+(test (let ((h (make-hash-table 3 #f (list symbol? integer?)))) (set! (h 'a) 1) (fill! h #\a) h) 'error)
+(test (let ((h (make-hash-table 3 #f (cons symbol? integer?)))) (set! (h 'a) 1) (fill! h #\a) h) 'error)
+(test (let ((h (make-hash-table 3 #f (cons symbol? integer?)))) (set! (h 'a) 1) (fill! h #f) h) (hash-table))
+(test (hash-table? (make-hash-table 8 eqv? (cons #t integer?))) #t)
+(test (hash-table? (make-hash-table 8 = (cons #t integer?))) #t)
+(test (make-hash-table 8 = (cons char? symbol?)) 'error)
+(test (make-hash-table 8 string=? (cons char? symbol?)) 'error)
+(test (hash-table? (make-hash-table 8 equal? (cons char? symbol?))) #t)
+
+(let ((ht (make-hash-table 8 #f (cons symbol? integer?))))
+  (test (hash-table-set! ht 'a 1) 1)
+  (test (hash-table-ref ht 'a) 1)
+  (test (fill! ht 32) 32)
+  (test (hash-table-ref ht 'a) 32)
+  (test (fill! ht 1/2) 'error)
+  (test (hash-table-ref ht 'a) 32)
+  (test (fill! ht #f) #f)
+  (test (hash-table-ref ht 'a) #f)
+  (test (hash-table-set! ht 'a 1) 1)
+  (let-temporarily (((ht 'a) 2))
+    (test (ht 'a) 2))
+  (test (ht 'a) 1)
+  (test (let-temporarily (((ht 'a) 1/2)) 21) 'error)
+  (test (ht 'a) 1)
+  (test (hash-table-set! ht 'a 1/2) 'error)
+  (test (hash-table-set! ht 123 1) 'error)
+  (test (ht 'a) 1)
+  (let ((ht1 (hash-table 'a 2)))
+    (test (copy ht1 ht) ht)
+    (test (ht 'a) 2))
+  (let ((ht1 (hash-table 'a 1/2)))
+    (test (copy ht1 ht) 'error)
+    (test (ht 'a) 2))
+  (let ((ht1 (hash-table 123 1)))
+    (test (copy ht1 ht) 'error)
+    (test (ht 'a) 2))
+  (test (set! (ht 'a) 1/2) 'error)
+  (test (set! (ht "a") 1) 'error)
+  (test (ht 'a) 2)
+  (test (set! (ht 'a) 3) 3)
+  (test (ht 'a) 3)
+  (let ()
+    (define (st)
+      (hash-table-set! ht 'a 4))
+    (st) (st)
+    (test (ht 'a) 4)
+    (define (st1)
+      (hash-table-set! ht 'a 1/2))
+    (test (st1) 'error)
+    (test (st1) 'error)
+    (test (ht 'a) 4)))
+
+(let ()
+  (define (boolean-or-integer? x)
+    (or (boolean? x)
+	(integer? x)))
+  (let ((ht (make-hash-table 8 #f (cons symbol? boolean-or-integer?))))
+    (test (signature ht) '(boolean-or-integer? hash-table? symbol?))
+    (test (hash-table-set! ht 'a 21) 21)
+    (test (hash-table-set! ht 'b #t) #t)
+    (test (hash-table-set! ht 'c pi) 'error)
+    (test (fill! ht 1) 1)
+    (test (hash-table-ref ht 'a) 1)
+    (test (fill! ht #\a) 'error)
+    (let ((ht1 (copy ht)))
+      (test (hash-table-set! ht1 'a #\a) 'error)
+      (test (signature ht1) '(boolean-or-integer? hash-table? symbol?))))
+
+  (define (symbol-or-pi? x)
+    (or (symbol? x)
+	(eq? x pi)))
+  (let ((ht (make-hash-table 8 #f (cons symbol-or-pi? boolean-or-integer?))))
+    (test (signature ht) '(boolean-or-integer? hash-table? symbol-or-pi?))
+    (test (hash-table-set! ht 'a 21) 21)
+    (test (hash-table-set! ht 'b #t) #t)
+    (test (hash-table-set! ht 'c pi) 'error)
+    (test (hash-table-set! ht pi 0) 0)
+    (test (fill! ht 1) 1)
+    (test (hash-table-ref ht 'a) 1)
+    (test (fill! ht #\a) 'error)
+    (let ((ht1 (copy ht)))
+      (test (hash-table-set! ht1 'a #\a) 'error)
+      (test (signature ht1) '(boolean-or-integer? hash-table? symbol-or-pi?)))))
+
+#|
+(define constants (vector 1)) ; etc -- see tauto.scm
+(define ops (list eq? eqv? equal? equivalent? = char=? string=? char-ci=? string-ci=?
+		  (cons string=? (lambda (a) (string-length a)))
+		  (cons (lambda (a b) (string=? a b)) string-length)))
+(for-each
+ (lambda (op)
+   (for-each
+    (lambda (val)
+      (let ((h (make-hash-table 8 op)))
+	(catch #t
+	  (lambda ()
+	    (set! (h val) #t)
+	    (if (not (eq? (h val) (op val val)))
+		(format *stderr* "~A ~A: ~A ~A~%" op val (h val) (op val val))))
+	  (lambda any #f))))
+    constants))
+ ops)
+|#
+
+(let ((H1 (make-hash-table)))
+  (set! (H1 H1) H1)
+  (let ((H2 (hash-table H1 H1)))
+    (test (string-wi=? (object->string (append H2 (make-hash-table 8 #f (cons symbol? integer?))) :readable)
+                       "(let ((<1> (hash-table))) (set! (<1> <1>) <1>) (hash-table <1> <1>))")
+          #t)
+    (test (object->string (append H2 (hash-table))) "(hash-table #1=(hash-table #1# #1#) #1#)")))
+
+(let ()
+  (let ((ht (make-hash-table 31 (cons (lambda (a b) (eq? a b)) (lambda (a) 0)))))
+    (hash-table-set! ht 'a 1)
+    (test (ht 'a) 1))
+  (let ((ht (make-hash-table 31 (cons (lambda* (a b) (eq? a b)) (lambda (a) 0)))))
+    (hash-table-set! ht 'a 1)
+    (test (ht 'a) 1))
+  (let ((ht (make-hash-table 31 (cons (lambda* (a (b 0)) (eq? a b)) (lambda (a) 0)))))
+    (hash-table-set! ht 'a 1)
+    (test (ht 'a) 1))
+  (test (let ((ht (make-hash-table 31 (list (eq? a b)))))
+	  (hash-table-set! ht 'a 1)
+	  (ht 'a))
+	'error)
+  (test (let ((ht (make-hash-table 31 (cons abs +))))
+	  (hash-table-set! ht 'a 1)
+	  (ht 'a))
+	'error)
+  (test (let ((ht (make-hash-table 31 (cons eq? float-vector-ref))))
+	  (hash-table-set! ht 'a 1)
+	  (ht 'a))
+	'error)
+  (test (let ((ht (make-hash-table 31 (dilambda (lambda (a) (eq? a b)) (lambda (a) 0)))))
+	  (hash-table-set! ht 'a 1)
+	  (ht 'a))
+	'error)
+  (test (let ((ht (make-hash-table 31 (lambda a (eq? car a) (cadr s)))))
+	  (hash-table-set! ht 'a 1)
+	  (ht 'a))
+	'error)
+  (test (let ((ht (make-hash-table 31 (cons (lambda (a b c) (eq? a b)) (lambda (a) 0)))))
+	  (hash-table-set! ht 'a 1)
+	  (ht 'a))
+	'error)
+  (test (let ((ht (make-hash-table 31 (define-macro (_m_ . args) #f))))
+	  (hash-table-set! ht 'a 1)
+	  (ht 'a))
+	'error)
+  (test (let ((ht (make-hash-table 31 abs)))
+	  (hash-table-set! ht 'a 1)
+	  (ht 'a))
+	'error)
+  (test (let ((ht (make-hash-table 31 list-set!)))
+	  (hash-table-set! ht 'a 1)
+	  (ht 'a))
+	'error))
+
+(let ()
+  (define (test-hash size)
+    (let ((c #t))
+      (let ((int-hash (make-hash-table (max size 511) (cons (lambda (a b) (= a b)) (lambda (a) a)))))
+	(do ((i 0 (+ i 1)))
+	    ((= i size))
+	  (hash-table-set! int-hash i i))
+	(do ((i 0 (+ i 1)))
+	    ((= i size))
+	  (let ((x (hash-table-ref int-hash i)))
+	    (if (not (= x i)) (format *stderr* ";test-hash(0) ~D -> ~D~%" i x)))))
+      (let ((int-hash (make-hash-table (max size 511) (cons (lambda (a b) (and c (= a b))) (lambda (a) a)))))
+	(do ((i 0 (+ i 1)))
+	    ((= i size))
+	  (hash-table-set! int-hash i i))
+	(do ((i 0 (+ i 1)))
+	    ((= i size))
+	  (let ((x (hash-table-ref int-hash i)))
+	    (if (not (= x i)) (format *stderr* ";test-hash(1) ~D -> ~D~%" i x)))))
+      (let ((int-hash (make-hash-table (max size 511) (let ((c #f)) (cons (lambda (a b) (and (not c) (= a b))) (lambda (a) a))))))
+	(do ((i 0 (+ i 1)))
+	    ((= i size))
+	  (hash-table-set! int-hash i i))
+	(do ((i 0 (+ i 1)))
+	    ((= i size))
+	  (let ((x (hash-table-ref int-hash i)))
+	    (if (not (= x i)) (format *stderr* ";test-hash(2) ~D -> ~D~%" i x)))))
+      ))
+
+  (test-hash 10))
+
+(let () ; check hash-table-increment internals
+  (define (g word)
+    (let ((ht (hash-table)))
+      (hash-table-set! ht word (+ (or (hash-table-ref ht word) 0) 1))
+      (let ((x (hash-table-ref ht word)))
+        (do ((i 3 (+ i 1)))
+  	    ((= i 6))
+  	  (set! x i))
+        (hash-table-ref ht word))))
+  (test (g 'i) 1)
+  (define (g1 word)
+    (let ((ht (hash-table)))
+      (hash-table-set! ht word (+ (or (hash-table-ref ht word) 0) 1))
+      (let ((x (hash-table-ref ht word)))
+        (hash-table-set! ht word (+ (or (hash-table-ref ht word) 0) 1))
+        x)))
+  (test (g1 'i) 1))
+
+#|
+;; another problem
+(let ((ht (make-hash-table))
+      (lst (list 1)))
+  (set! (ht lst) 32)
+  (let ((v1 (ht '(1)))
+	(v2 (ht '(2))))
+    (set-car! lst 2)        ; can't copy key unless equal?
+    (let ((v3 (ht '(1)))
+	  (v4 (ht '(2))))
+      (list v1 v2 v3 v4)))) ; 32 #f #f #f
+
+(let ((ht (make-hash-table))
+      (lst (list 1)))
+  (set! (ht (copy lst)) 32)
+  (let ((v1 (ht '(1)))
+	(v2 (ht '(2))))
+    (set-car! lst 2)
+    (let ((v3 (ht '(1)))
+	  (v4 (ht '(2))))
+      (list v1 v2 v3 v4)))) ; 32 #f 32 #f
+|#
+
+(test (hash-table-set! (copy (make-hash-table 8 equivalent? (cons symbol? #t))) #\A (inlet 'a (inlet 'b 1))) 'error)
+
+(let ((source (hash-table #() "asdf"))
+      (dest (make-hash-table 8 #f (cons symbol? integer?))))
+  (test (copy source dest) 'error))
+
+(let ((H_3 (make-hash-table 8 (cons equal? hash-code)))
+      (H_4 (make-hash-table 8 (let ((eqf (lambda (a b) (equal? a b)))
+				    (mapf (lambda (a) (hash-code a))))
+				(cons eqf mapf)))))
+  (test (hash-table-set! H_3 #<unspecified> ()) ())
+  (test (hash-table? (copy H_3 H_4)) #t)
+  (test (hash-table-set! H_4 'a 1) 1))
+
+;;; hash-table-key|value-typer
+
+(let ((h (hash-table 'a 1)))
+  (for-each
+   (lambda (arg)
+     (test (hash-table-key-typer arg) 'error)
+     (test (hash-table-value-typer arg) 'error)
+     (test (set! (hash-table-key-typer arg) integer?) 'error)
+     (test (set! (hash-table-key-typer h) arg) 'error)
+     (test (set! (hash-table-value-typer h) arg) 'error))
+   (list "hi" #\a 1 () '(1 . 2) (cons #\a #\b) 'a-symbol #(1 2) _undef_ _null_ quasiquote macroexpand 1/0 (log 0)
+         3.14 3/4 1.0+1.0i :hi (if #f #f))))
+
+(test (hash-table-key-typer (hash-table)) #f)
+(test (hash-table-key-typer (make-hash-table 8 eq? (cons symbol? integer?))) symbol?)
+(test (hash-table-value-typer (make-hash-table 8 eq? (cons symbol? integer?))) integer?)
+(test (hash-table-value-typer (hash-table)) #f)
+(let ()
+  (define H (make-hash-table 8 eq? (cons symbol? integer?)))
+  (test (set! (hash-table-key-typer H) integer?) integer?)
+  (test (hash-table-key-typer H) integer?)
+  (test (set! (hash-table-key-typer H) #f) #f)
+  (test (hash-table-key-typer H) #t)
+  (test (set! (hash-table-key-typer H) symbol?) symbol?)
+  (test (hash-table-key-typer H) symbol?)
+  (test (set! (hash-table-value-typer H) integer?) integer?)
+  (test (hash-table-value-typer H) integer?)
+  (test (hash-table-key-typer H) symbol?))
+
+(let ((h (make-hash-table 8 eq? (cons symbol? integer?))))
+  (immutable! h)
+  (test (set! (hash-table-key-typer H) integer?) 'error))
+(let ((h (make-hash-table 8)))
+  (immutable! h)
+  (test (set! (hash-table-key-typer H) integer?) 'error))
+
+(let ((h (make-hash-table 8 eq? (cons symbol? integer?))))
+  (immutable! h)
+  (test (set! (hash-table-value-typer H) real?) 'error))
+(let ((h (make-hash-table 8)))
+  (immutable! h)
+  (test (set! (hash-table-value-typer H) real?) 'error))
+
+(let ((H (make-hash-table 8 eq? (cons symbol? integer?))))
+  (define (cf h) (lambda (h) #t))
+  (set! (hash-table-key-typer H) cf)
+  (test (hash-table-set! H #t ()) 'error)
+  (set! (hash-table-value-typer H) #t)
+  (set! (hash-table-key-typer H) #t)
+  (test (hash-table-set! H #t ()) ()))
+
+(let () ; check_hash_table_checker
+  (define (f)
+    (let ((H (make-hash-table 8 eq? (cons symbol? integer?))))
+      (let-temporarily (((*s7* 'safety) 1))
+        (hash-table-set! H 'a 123))))
+  (test (f) 123))
+
+(let ()
+  (define (typer x) (symbol? x))
+  (define h (make-hash-table 8 eq? (cons typer typer)))
+  (test (equal? typer (hash-table-key-typer h)) #t)
+  (test (catch #t (lambda () (set! (h 'a) 32)) (lambda (t i) (apply format #f i)))
+        "hash-table-set! third argument 32, is an integer, but the hash-table's value type checker, typer, rejects it")
+  (test (set! (hash-table-value-typer h) #f) #f)
+  (test (catch #t (lambda () (set! (h 'a) 32)) (lambda (t i) (apply format #f i))) 32))
+
+(test (hash-table-key-typer (append (let ((H (make-hash-table 4 eq? (cons symbol? integer?)))) (set! (H 'a) 1) H)
+                                    (let ((H (make-hash-table 4 eq? (cons symbol? integer?)))) (set! (H 'b) 2) H)))
+       symbol?)
+
+(test (object->string (hash-table) :readable) "(hash-table)")
+(test (object->string (make-hash-table 31 eqv?) :readable) "(make-hash-table 32 eqv?)")
+
+(test (let ((H (make-hash-table 8 eq?))) (object->string H :readable)) "(make-hash-table 8 eq?)")
+(test (let ((H (make-hash-table 8 eq? (cons symbol? integer?)))) (object->string H :readable)) "(make-hash-table 8 eq? (cons symbol? integer?))")
+(test (let ((H (make-hash-table 8 eq?))) (set! (H 'a) 1) (object->string H :readable))
+      "(let ((<h> (make-hash-table 8 eq?))) (copy (hash-table 'a 1) <h>))")
+(test (let ((H (make-hash-table 8 eq? (cons symbol? integer?)))) (set! (H 'a) 1) (object->string H :readable))
+      "(let ((<h> (make-hash-table 8 eq? (cons symbol? integer?)))) (copy (hash-table 'a 1) <h>))")
+(test (let ((H1 (immutable! (hash-table 'a 1)))) (object->string H1 :readable))  "(immutable! (hash-table 'a 1))")
+(test (let () (define (10-12? val) (memv val '(10 12))) (object->string (make-hash-table 16 #f (cons #t 10-12?)) :readable))
+      "(make-hash-table 16 #f (cons #t 10-12?))")
+(let ((H (make-hash-table 8 eq? (cons symbol? integer?))))
+  (test (object->string H :readable) "(make-hash-table 8 eq? (cons symbol? integer?))"))
+(let ((H (make-hash-table 8 eqv? (cons symbol? integer?))))
+  (test (object->string H :readable) "(make-hash-table 8 eqv? (cons symbol? integer?))"))
+(let ((H (make-hash-table 8 (cons (lambda (a b) (eq? a b)) (lambda (a) 0)))))
+  (test (object->string H :readable) "(make-hash-table 8 (cons (lambda (a b) (eq? a b)) (lambda (a) 0)))"))
+(let ((H (make-hash-table 8 (cons (lambda (a b) (eq? a b)) (lambda (a) 0)) (cons symbol? integer?))))
+  (test (object->string H :readable) "(make-hash-table 8 (cons (lambda (a b) (eq? a b)) (lambda (a) 0)) (cons symbol? integer?))"))
+(let ((H (make-hash-table 8 (cons (lambda (a b) (eqv? a b)) (lambda (a) 0)) (cons symbol? integer?))))
+  (test (object->string H :readable) "(make-hash-table 8 (cons (lambda (a b) (eqv? a b)) (lambda (a) 0)) (cons symbol? integer?))"))
+(let ((H (make-hash-table 8 eqv? (cons integer? integer?))))
+  (test (object->string H :readable) "(make-hash-table 8 eqv? (cons integer? integer?))"))
+(let ((H (make-hash-table 8 eqv?))) (test (object->string H :readable) "(make-hash-table 8 eqv?)"))
+(let ()
+  (define (10-12? val) (memv val '(10 12)))
+  (define hash (make-hash-table 8 #f (cons #t 10-12?)))
+  (test (object->string hash :readable) "(make-hash-table 8 #f (cons #t 10-12?))"))
+(let ()
+  (define (10-12? val) (memv val '(10 12)))
+  (define hash (make-hash-table 8 = (cons #t 10-12?)))
+  (test (object->string hash :readable) "(make-hash-table 8 = (cons #t 10-12?))"))
+(test (object->string (make-hash-table 8 (cons string=? string-length)) :readable) "(make-hash-table 8 (cons string=? string-length))")
+
+(let ((H2 (make-hash-table 8 #f (cons string? integer?))))
+  (test (object->string H2 :readable) "(make-hash-table 8 #f (cons string? integer?))"))
+(let ((H2 (make-hash-table 8 equivalent? (cons string? integer?))))
+  (test (object->string H2 :readable) "(make-hash-table 8 equivalent? (cons string? integer?))"))
+(let ((H2 (make-hash-table 8 (cons string=? string-length) (cons string? integer?))))
+  (test (object->string H2 :readable) "(make-hash-table 8 (cons string=? string-length) (cons string? integer?))"))
+(let ((H2 (make-hash-table 8 (cons string=? string-length))))
+  (test (object->string H2 :readable) "(make-hash-table 8 (cons string=? string-length))"))
+(let ((H2 (make-hash-table 8 #f)))
+  (test (object->string H2 :readable) "(hash-table)"))
+
+(let ((H2 (immutable! (make-hash-table 8 #f (cons string? integer?)))))
+  (test (object->string H2 :readable) "(immutable! (make-hash-table 8 #f (cons string? integer?)))"))
+(let ((H2 (immutable! (make-hash-table 8 equivalent? (cons string? integer?)))))
+  (test (object->string H2 :readable) "(immutable! (make-hash-table 8 equivalent? (cons string? integer?)))"))
+(let ((H2 (immutable! (make-hash-table 8 (cons string=? string-length) (cons string? integer?)))))
+  (test (object->string H2 :readable) "(immutable! (make-hash-table 8 (cons string=? string-length) (cons string? integer?)))"))
+(let ((H2 (immutable! (make-hash-table 8 (cons string=? string-length)))))
+  (test (object->string H2 :readable) "(immutable! (make-hash-table 8 (cons string=? string-length)))"))
+(let ((H2 (immutable! (make-hash-table 8 #f))))
+  (test (object->string H2 :readable) "(immutable! (hash-table))"))
+
+(let ((H2 (make-hash-table 8 (cons (lambda (a b) (eq? a b)) (lambda (a) 0)))))
+  (test (object->string H2 :readable) "(make-hash-table 8 (cons (lambda (a b) (eq? a b)) (lambda (a) 0)))"))
+(let ((H2 (make-hash-table 8 (cons eq? (lambda (a) 0)))))
+  (test (object->string H2 :readable) "(make-hash-table 8 (cons eq? (lambda (a) 0)))"))
+(let ((H2 (make-hash-table 8 (cons (lambda (a b) (eq? a b)) hash-code))))
+  (test (object->string H2 :readable) "(make-hash-table 8 (cons (lambda (a b) (eq? a b)) hash-code))"))
+
+(test (object->string (immutable! (hash-table))) "(hash-table)")
+(test (object->string (immutable! (hash-table)) :readable) "(immutable! (hash-table))")
+(test (object->string (immutable! (hash-table 'a 1)) :readable) "(immutable! (hash-table 'a 1))")
+
+(test (string-wi=? (object->string (immutable! (let ((H (hash-table))) (set! (H 'a) H) H)) :readable)
+		   "(let ((<1> (hash-table))) (set! (<1> 'a) <1>) (immutable! <1>))")
+      #t)
+
+(test (object->string (make-hash-table 8 #f #f) :readable) "(hash-table)")
+(test (immutable? (copy (immutable! (hash-table 'a 1)))) #f)
+
+(let ((H (make-hash-table 32 (cons string=? string-length))))
+  (test (object->string H :readable) "(make-hash-table 32 (cons string=? string-length))")
+
+  (let ((H1 (copy H)))
+    (test (object->string H1 :readable) "(make-hash-table 32 (cons string=? string-length))"))
+
+  (let ((H2 (make-hash-table 32)))
+    (copy H H2)
+    (test (object->string H2 :readable) "(hash-table)"))
+
+  (set! (H "a") 32)
+  (test (object->string H :readable) "(let ((<h> (make-hash-table 32 (cons string=? string-length)))) (copy (hash-table \"a\" 32) <h>))")
+
+  (let ((H1 (copy H)))
+    (test (object->string H1 :readable) "(let ((<h> (make-hash-table 32 (cons string=? string-length)))) (copy (hash-table \"a\" 32) <h>))")
+    (test (set! (H1 'a) "asdf") 'error))
+
+  (let ((H2 (make-hash-table 32)))
+    (copy H H2)
+    (test (object->string H2 :readable) "(hash-table \"a\" 32)"))
+
+  (set! H (make-hash-table 8 #f (cons symbol? integer?)))
+  (test (object->string H :readable) "(make-hash-table 8 #f (cons symbol? integer?))")
+
+  (let ((H1 (copy H)))
+    (test (object->string H1 :readable) "(make-hash-table 8 #f (cons symbol? integer?))"))
+
+  (let ((H2 (make-hash-table 32)))
+    (copy H H2)
+    (test (object->string H2 :readable) "(hash-table)"))
+
+  (set! (H 'a) 32)
+
+  (let ((H1 (copy H)))
+    (test (object->string H1 :readable) "(let ((<h> (make-hash-table 8 #f (cons symbol? integer?)))) (copy (hash-table 'a 32) <h>))"))
+
+  (let ((H2 (make-hash-table 32)))
+    (copy H H2)
+    (test (object->string H2 :readable) "(hash-table 'a 32)"))
+
+  (set! H (make-hash-table 8 (cons eq? hash-code) (cons symbol? integer?)))
+  (test (object->string H :readable) "(make-hash-table 8 (cons eq? hash-code) (cons symbol? integer?))")
+
+  (let ((H1 (copy H)))
+    (test (object->string H1 :readable) "(make-hash-table 8 (cons eq? hash-code) (cons symbol? integer?))"))
+
+  (let ((H2 (make-hash-table 32)))
+    (copy H H2)
+    (test (object->string H2 :readable) "(hash-table)"))
+
+  (set! (H 'a) 32)
+
+  (let ((H1 (copy H)))
+    (test (hash-table-key-typer H1) symbol?)
+    (test (object->string H1 :readable) "(let ((<h> (make-hash-table 8 (cons eq? hash-code) (cons symbol? integer?)))) (copy (hash-table 'a 32) <h>))"))
+
+  (let ((H2 (make-hash-table 32)))
+    (copy H H2)
+    (test (object->string H2 :readable) "(hash-table 'a 32)"))
+
+  (let ((H1 (make-hash-table)))
+    (set! (hash-table-value-typer H1) integer?)
+    (test (object->string H1 :readable) "(make-hash-table 8 #f (cons #t integer?))"))
+
+  (let ((H1 (make-hash-table)))
+    (set! (H1 'a) 1)
+    (set! (hash-table-value-typer H1) integer?)
+    (set! (H1 'b) 2)
+    (let ((str (object->string H1 :readable)))
+      (test (or (string-wi=? str "(let ((<h> (make-hash-table 8 #f (cons #t integer?)))) (copy (hash-table 'a 1 'b 2) <h>))")
+                (string-wi=? str "(let ((<h> (make-hash-table 8 #f (cons #t integer?)))) (copy (hash-table 'b 2 'a 1) <h>))"))
+            #t)))
+
+  (set! H (make-hash-table 8))
+  (let ((H1 (make-hash-table 32 (cons string=? string-length))))
+    (copy H H1)
+    (test (object->string H1 :readable) "(make-hash-table 32 (cons string=? string-length))"))
+
+  (let ((H2 (make-hash-table 8 #f (cons string? integer?))))
+    (test (hash-table-value-typer H2) integer?)
+    (copy H H2)
+    (test (object->string H2 :readable) "(make-hash-table 8 #f (cons string? integer?))"))
+
+  (set! (H "a") 32)
+  (let ((H1 (make-hash-table 32 (cons string=? string-length))))
+    (copy H H1)
+    (test (object->string H1 :readable) "(let ((<h> (make-hash-table 32 (cons string=? string-length)))) (copy (hash-table \"a\" 32) <h>))"))
+
+  (let ((H2 (make-hash-table 8 #f (cons string? integer?))))
+    (copy H H2)
+    (test (object->string H2 :readable) "(let ((<h> (make-hash-table 8 string=? (cons string? integer?)))) (copy (hash-table \"a\" 32) <h>))"))
+
+  (test (string-wi=? (let ((H (hash-table))) (set! (H 'a) H) (object->string H :readable)) "(let ((<1> (hash-table))) (set! (<1> 'a) <1>) <1>)") #t)
+
+  (test (let ((H (make-hash-table 8 eq? (cons symbol? integer?)))) (set! (H 'a) 1) (object->string H :readable))
+	"(let ((<h> (make-hash-table 8 eq? (cons symbol? integer?)))) (copy (hash-table 'a 1) <h>))")
+
+  (test (let ((H (make-hash-table 8 eq?))) (set! (H 'a) 1) (object->string H :readable))
+	"(let ((<h> (make-hash-table 8 eq?))) (copy (hash-table 'a 1) <h>))")
+
+  (set! H (make-hash-table 8 eq?))
+  (set! (H 'a) H)
+  (test (string-wi=? (object->string H :readable) "(let ((<1> (let ((<h> (make-hash-table 8 eq?))) <h>))) (set! (<1> 'a) <1>) <1>)") #t)
+
+  (set! H (make-hash-table 8 (cons eq? hash-code) (cons symbol? hash-table?)))
+  (set! (H 'a) H)
+  (test (string-wi=? (object->string H :readable)
+		     "(let ((<1> (let ((<h> (make-hash-table 8 (cons eq? hash-code) (cons symbol? hash-table?))))
+                                   <h>)))
+                        (set! (<1> 'a) <1>)
+                        <1>)") #t)
+
+  (let ((H1 (copy H)))
+    (test (or (procedure? (hash-table-key-typer H1)) (procedure? (hash-table-value-typer H1))) #t)
+    (test (string-wi=? (object->string H :readable)
+		     "(let ((<1> (let ((<h> (make-hash-table 8 (cons eq? hash-code) (cons symbol? hash-table?))))
+                                   <h>)))
+                        (set! (<1> 'a) <1>)
+                        <1>)") #t))
+
+  (let ((H2 (make-hash-table 32)))
+    (copy H H2)
+    (test (or (procedure? (hash-table-key-typer H2)) (procedure? (hash-table-value-typer H2))) #f)
+    (test (string-wi=? (object->string H2 :readable)
+		       "(let ((<1> (let ((<h> (make-hash-table 8 (cons eq? hash-code) (cons symbol? hash-table?)))) <h>)))
+                          (set! (<1> 'a) <1>)
+                          (hash-table 'a <1>))")
+	  #t))
+
+  (set! H (make-hash-table 8 (cons equivalent? hash-code) (cons symbol? #t)))
+  (set! (H 'a) H) (set! (H 'b) 2) (set! (H 'c) (list H)) (set! (H 'd) "hi")
+  (let ((str (object->string H :readable)))
+    (test H (eval-string str)))
+  )
+
+(let ()
+  (define H (hash-table 'a 1 'b 2 'c 3))
+
+  (let ((last-key #f))
+
+    (define (valtyp val)
+      (or (not last-key)
+	  (eq? last-key 'a)
+	  (and (eq? last-key 'b)
+	       (<= 0 val 32))))
+
+    (define (keytyp key)
+      (set! last-key key)
+      #t)
+
+    (set! (hash-table-key-typer H) keytyp)
+    (set! (hash-table-value-typer H) valtyp))
+
+  ;; now a can be set but b must between 0..32 and c is immutable
+
+  (test H (hash-table 'a 1 'b 2 'c 3))
+
+  (test (catch #t (lambda () (hash-table-set! H 'a 11)) (lambda (t i) (apply format #f i))) 11)
+  (test (catch #t (lambda () (hash-table-set! H 'b 12)) (lambda (t i) (apply format #f i))) 12)
+  (test (catch #t (lambda () (hash-table-set! H 'c 13)) (lambda (t i) (apply format #f i)))
+	"hash-table-set! third argument 13, is an integer, but the hash-table's value type checker, valtyp, rejects it")
+
+  (test H (hash-table 'a 11 'b 12 'c 3))
+
+  (test (catch #t (lambda () (hash-table-set! H 'a 111)) (lambda (t i) (apply format #f i))) 111)
+  (test (catch #t (lambda () (hash-table-set! H 'b 112)) (lambda (t i) (apply format #f i)))
+	"hash-table-set! third argument 112, is an integer, but the hash-table's value type checker, valtyp, rejects it")
+  (test (catch #t (lambda () (hash-table-set! H 'c 113)) (lambda (t i) (apply format #f i)))
+	"hash-table-set! third argument 113, is an integer, but the hash-table's value type checker, valtyp, rejects it")
+
+  (test H (hash-table 'a 111 'b 12 'c 3))
+
+  (set! (H 'c) #f)
+  (test H (hash-table 'a 111 'b 12)))
+
+(let ()
+  (define H_2 (make-hash-table 8 (cons equal? hash-code)))
+  (set! (H_2 'a) 32)
+  (test (H_2 'a) 32)
+  (set! (H_2 'a) 12)
+  (test (H_2 'a) 12)
+  (set! (H_2 ()) #(1))
+  (test (H_2 ()) #(1))
+
+  (define H_3 (make-hash-table 8
+			       (let ((eqf (lambda (a b) (equal? a b)))
+				     (mapf (lambda (a) (hash-code a))))
+				 (cons eqf mapf))))
+  (set! (H_3 'a) 32)
+  (test (H_3 'a) 32)
+  (set! (H_3 'a) 12)
+  (test (H_3 'a) 12)
+  (set! (H_3 ()) #(1))
+  (test (H_3 ()) #(1))
+
+  (let ((H_4 (make-hash-table 8
+			      (let ((eqf (lambda (a b) (equal? a b)))
+				    (mapf (lambda (a) (hash-code a))))
+				(cons eqf mapf))))
+	(last-key #f))
+    (define (valtyp val)
+      (or (not last-key)
+	  (eq? last-key 'v1)
+	  (and (eq? last-key 'v2)
+	       (<= 0 val 32))))
+    (define (keytyp key)
+      (set! last-key key)
+      #t)
+    (set! (hash-table-key-typer H_4) keytyp)
+    (set! (hash-table-value-typer H_4) valtyp)
+
+    (set! (H_4 'v1) "asdf")
+    (set! (H_4 'v2) 12)
+    (test (catch #t (lambda () (set! (H_4 'v3) 0)) (lambda (t i) (apply format #f i)))
+          "hash-table-set! third argument 0, is an integer, but the hash-table's value type checker, valtyp, rejects it")))
+
+(let ((L (openlet (inlet 'hash-table-key-typer (lambda (h) 123)
+			 'hash-table-value-typer (lambda (h) 321)
+			 'vector-typer (lambda (v) 231)))))
+  (test (hash-table-key-typer L) 123)
+  (test (hash-table-value-typer L) 321)
+  (test (vector-typer L) 231))
+
+(unless (provided? 'debug.scm)
+  (let ((H_4 (make-hash-table 8
+	       (let ((eqf (lambda (a b) (equal? a b)))
+	             (mapf (lambda (a) (hash-code a))))
+			     (cons eqf mapf)))))
+    (hash-table-set! H_4 #\7 begin)
+    ;; (H_4 #\7) -> begin, (begin 0) -> 0! but this clobbered sc->args in implicit_index
+    (let ()
+      (define (func)
+        (let ((x #f) (i 0))
+  	  (let ((x (list (hash-table-ref H_4 #\7 (logxor))))) x)))
+      (func)))) ; reuse permanent let in op_let1
+
+(let ((H_2 (make-hash-table 8 eq? (cons symbol? integer?)))) (define (func) (copy (hash-table 'a 1) H_2)) (func) (func)
+  (test (and (= (hash-table-entries H_2) 1) (eqv? (hash-table-ref H_2 'a) 1)) #t))
+
+(let ()
+  (define (valtyp val) (integer? val))
+  (define (keytyp key) (string? key))
+  (define H (make-hash-table 8 (cons string=? string-length)))
+  (set! (hash-table-key-typer H) keytyp)
+  (set! (hash-table-value-typer H) valtyp)
+  (hash-table-set! H "a" 1)
+  (let ((HL (object->let H)))
+    (test (HL 'signature) '(valtyp hash-table? keytyp))
+    (test (HL 'function) (list string=? string-length)))
+  (test (object->string H :readable)
+	"(let ((<h> (make-hash-table 8 (cons string=? string-length) (cons keytyp valtyp)))) (copy (hash-table \"a\" 1) <h>))")
+  (test (hash-table-key-typer H) keytyp)
+  (test (hash-table-value-typer H) valtyp))
+
+(let ()
+  (define H (make-hash-table 8 eqv? (cons string? integer?)))
+  (hash-table-set! H "a" 1)
+  (let ((HL (object->let H)))
+    (test (HL 'signature) '(integer? hash-table? string?))
+    (test (HL 'function) 'eqv?))
+  (test (object->string H :readable)
+	"(let ((<h> (make-hash-table 8 eqv? (cons string? integer?)))) (copy (hash-table \"a\" 1) <h>))")
+  (test (hash-table-key-typer H) string?)
+  (test (hash-table-value-typer H) integer?))
+
+(let ()
+  (define H (make-hash-table 8 string=? (cons string? integer?)))
+  (hash-table-set! H "a" 1)
+  (let ((HL (object->let H)))
+    (test (HL 'signature) '(integer? hash-table? string?))
+    (test (HL 'function) 'string=?))
+  (test (object->string H :readable)
+        "(let ((<h> (make-hash-table 8 string=? (cons string? integer?)))) (copy (hash-table \"a\" 1) <h>))")
+  (test (hash-table-key-typer H) string?)
+  (test (hash-table-value-typer H) integer?))
+
+(let ()
+  (define H (make-hash-table))
+  (define (keytyp key) (string? key))
+  (set! (hash-table-key-typer H) keytyp)
+  (hash-table-set! H "a" 1)
+  (let ((HL (object->let H)))
+    (test (HL 'signature) '(#t hash-table? keytyp))
+    (test (HL 'function) 'string=?))
+  (test (object->string H :readable)
+	"(let ((<h> (make-hash-table 8 string=? (cons keytyp #t)))) (copy (hash-table \"a\" 1) <h>))")
+  (test (hash-table-key-typer H) keytyp)
+  (test (hash-table-value-typer H) #t))
+
+(let ()
+  (define H (make-hash-table 8 #f (cons integer? integer?)))
+  (hash-table-set! H 0 1)
+  (let ((HL (object->let H)))
+    (test (HL 'signature) '(integer? hash-table? integer?))
+    (test (HL 'function) '=))
+  (test (object->string H :readable)
+	"(let ((<h> (make-hash-table 8 #f (cons integer? integer?)))) (copy (hash-table 0 1) <h>))")
+  (test (hash-table-key-typer H) integer?)
+  (test (hash-table-value-typer H) integer?))
+
+(let-temporarily ((*#readers*
+		   (cons (cons #\h (lambda (str)
+				     (and (string=? str "h") ; #h(...)
+					  (if (> (*s7* 'safety) 0)
+					      (immutable! (apply hash-table (read)))
+					      (apply hash-table (read))))))
+			 *#readers*)))
+  (test (eval-string "#h(:a 1)") (hash-table :a 1))
+  (test (eval-string "#h(:a 1 :b \"asdf\")") (hash-table :a 1 :b "asdf"))
+  (test (eval-string "#h(a 1 b 2)") (hash-table 'a 1 'b 2)) ; 'a and :a are different keys in hash-tables:
+  (test ((hash-table 'a 1) 'a) 1) ; but...
+  (test ((hash-table :a 1) 'a) #f) ; (equal? 'a :a) is #f
+  (test (eval-string "#h(:a #h(:b 2))") (hash-table :a (hash-table :b 2)))
+  (test (eval-string "#h(:a #h(:b #i(2)))") (hash-table :a (hash-table :b (int-vector 2)))))
+
+
+;;; --------------------------------------------------------------------------------
+;;; some implicit index tests
+
+(test (#(#(1 2) #(3 4)) 1 1) 4)
+(test (#("12" "34") 0 1) #\2)
+(test (#((1 2) (3 4)) 1 0) 3)
+(test (#((1 (2 3))) 0 1 0) 2)
+(test ((vector (hash-table 'a 1 'b 2)) 0 'a) 1)
+(test ((list (lambda (x) x)) 0 "hi") 'error) ; "hi")
+(test (let ((lst '("12" "34"))) (lst 0 1)) #\2)
+(test (let ((lst (list #(1 2) #(3 4)))) (lst 0 1)) 2)
+(test (#2d(("hi" "ho") ("ha" "hu")) 1 1 0) #\h)
+(test ((list (lambda (a) (+ a 1)) (lambda (b) (* b 2))) 1 2) 'error) ; 4)
+(test ((lambda (arg) arg) "hi" 0) 'error)
+
+(let ((L1 (list 1 2 3))
+      (V1 (vector 1 2 3))
+      (M1 #2d((1 2 3) (4 5 6) (7 8 9)))
+      (S1 "123")
+      (H1 (hash-table 1 1 2 2 3 3)))
+  (let ((L2 (list L1 V1 M1 S1 H1))
+	(V2 (vector L1 V1 M1 S1 H1))
+	(H2 (hash-table 0 L1 1 V1 2 M1 3 S1 4 H1))
+	(M2 (let ((v (make-vector '(3 3))))
+	      (set! (v 0 0) L1)
+	      (set! (v 0 1) V1)
+	      (set! (v 0 2) M1)
+	      (set! (v 1 0) S1)
+	      (set! (v 1 1) H1)
+	      (set! (v 1 2) L1)
+	      (set! (v 2 0) S1)
+	      (set! (v 2 1) H1)
+	      (set! (v 2 2) L1)
+	      v)))
+#|
+    ;; this code generates the tests below
+    (for-each
+     (lambda (arg)
+       (let* ((val (symbol->value arg))
+	      (len (min 5 (length val))))
+	 (do ((i 0 (+ i 1)))
+	     ((= i len))
+	   (format *stderr* "(test (~S ~S) ~S)~%" arg i
+		   (catch #t (lambda () (val i)) (lambda args 'error)))
+	   (let ((len1 (catch #t (lambda () (min 5 (length (val i)))) (lambda args 0))))
+	     (if (> len1 0)
+		 (do ((k 0 (+ k 1)))
+		     ((= k len1))
+		   (format *stderr* "(test (~S ~S ~S) ~S)~%" arg i k
+			   (catch #t (lambda () (val i k)) (lambda args 'error)))
+		   (let ((len2 (catch #t (lambda () (min 5 (length (val i k)))) (lambda args 0))))
+		     (if (> len2 0)
+			 (do ((m 0 (+ m 1)))
+			     ((= m len2))
+			   (format *stderr* "(test (~S ~S ~S ~S) ~S)~%" arg i k m
+				   (catch #t (lambda () (val i k m)) (lambda args 'error)))
+			   (let ((len3 (catch #t (lambda () (min 5 (length (val i k m)))) (lambda args 0))))
+			     (if (> len3 0)
+				 (do ((n 0 (+ n 1)))
+				     ((= n len3))
+				   (format *stderr* "(test (~S ~S ~S ~S ~S) ~S)~%" arg i k m n
+					   (catch #t (lambda () (val i k m n)) (lambda args 'error)))))))))))))))
+     (list 'L2 'V2 'M2 'H2))
+|#
+
+    (test (L2 0) '(1 2 3))
+    (test (L2 0 0) 1)
+    (test (L2 0 1) 2)
+    (test (L2 0 2) 3)
+    (test (L2 1) #(1 2 3))
+    (test (L2 1 0) 1)
+    (test (L2 1 1) 2)
+    (test (L2 1 2) 3)
+    (test (L2 2) #2d((1 2 3) (4 5 6) (7 8 9)))
+    (test (L2 2 0) #(1 2 3))
+    (test (L2 2 0 0) 1)
+    (test (L2 2 0 1) 2)
+    (test (L2 2 0 2) 3)
+    (test (L2 2 1) #(4 5 6))
+    (test (L2 2 1 0) 4)
+    (test (L2 2 1 1) 5)
+    (test (L2 2 1 2) 6)
+    (test (L2 2 2) #(7 8 9))
+    (test (L2 2 2 0) 7)
+    (test (L2 2 2 1) 8)
+    (test (L2 2 2 2) 9)
+    (test (L2 2 3) 'error)
+    (test (L2 2 4) 'error)
+    (test (L2 3) "123")
+    (test (L2 3 0) #\1)
+    (test (L2 3 1) #\2)
+    (test (L2 3 2) #\3)
+    (test (L2 4) H1)
+    (test (L2 4 0) #f)
+    (test (L2 4 1) 1)
+    (test (L2 4 2) 2)
+    (test (L2 4 3) 3)
+    (test (L2 4 4) #f)
+    (test (V2 0) '(1 2 3))
+    (test (V2 0 0) 1)
+    (test (V2 0 1) 2)
+    (test (V2 0 2) 3)
+    (test (V2 1) #(1 2 3))
+    (test (V2 1 0) 1)
+    (test (V2 1 1) 2)
+    (test (V2 1 2) 3)
+    (test (V2 2) #2d((1 2 3) (4 5 6) (7 8 9)))
+    (test (V2 2 0) #(1 2 3))
+    (test (V2 2 0 0) 1)
+    (test (V2 2 0 1) 2)
+    (test (V2 2 0 2) 3)
+    (test (V2 2 1) #(4 5 6))
+    (test (V2 2 1 0) 4)
+    (test (V2 2 1 1) 5)
+    (test (V2 2 1 2) 6)
+    (test (V2 2 2) #(7 8 9))
+    (test (V2 2 2 0) 7)
+    (test (V2 2 2 1) 8)
+    (test (V2 2 2 2) 9)
+    (test (V2 2 3) 'error)
+    (test (V2 2 4) 'error)
+    (test (V2 3) "123")
+    (test (V2 3 0) #\1)
+    (test (V2 3 1) #\2)
+    (test (V2 3 2) #\3)
+    (test (V2 4) H1)
+    (test (V2 4 0) #f)
+    (test (V2 4 1) 1)
+    (test (V2 4 2) 2)
+    (test (V2 4 3) 3)
+    (test (V2 4 4) #f)
+    (test (M2 0) #((1 2 3) #(1 2 3) #2d((1 2 3) (4 5 6) (7 8 9))))
+    (test (M2 0 0) '(1 2 3))
+    (test (M2 0 0 0) 1)
+    (test (M2 0 0 1) 2)
+    (test (M2 0 0 2) 3)
+    (test (M2 0 1) #(1 2 3))
+    (test (M2 0 1 0) 1)
+    (test (M2 0 1 1) 2)
+    (test (M2 0 1 2) 3)
+    (test (M2 0 2) #2d((1 2 3) (4 5 6) (7 8 9)))
+    (test (M2 0 2 0) #(1 2 3))
+    (test (M2 0 2 0 0) 1)
+    (test (M2 0 2 0 1) 2)
+    (test (M2 0 2 0 2) 3)
+    (test (M2 0 2 1) #(4 5 6))
+    (test (M2 0 2 1 0) 4)
+    (test (M2 0 2 1 1) 5)
+    (test (M2 0 2 1 2) 6)
+    (test (M2 0 2 2) #(7 8 9))
+    (test (M2 0 2 2 0) 7)
+    (test (M2 0 2 2 1) 8)
+    (test (M2 0 2 2 2) 9)
+    (test (M2 0 2 3) 'error)
+    (test (M2 0 2 4) 'error)
+    (test (M2 1) (vector "123" H1 '(1 2 3)))
+    (test (M2 1 0) "123")
+    (test (M2 1 0 0) #\1)
+    (test (M2 1 0 1) #\2)
+    (test (M2 1 0 2) #\3)
+    (test (M2 1 1) H1)
+    (test (M2 1 1 0) #f)
+    (test (M2 1 1 1) 1)
+    (test (M2 1 1 2) 2)
+    (test (M2 1 1 3) 3)
+    (test (M2 1 1 4) #f)
+    (test (M2 1 2) '(1 2 3))
+    (test (M2 1 2 0) 1)
+    (test (M2 1 2 1) 2)
+    (test (M2 1 2 2) 3)
+    (test (M2 2) (vector "123" H1 '(1 2 3)))
+    (test (M2 2 0) "123")
+    (test (M2 2 0 0) #\1)
+    (test (M2 2 0 1) #\2)
+    (test (M2 2 0 2) #\3)
+    (test (M2 2 1) H1)
+    (test (M2 2 1 0) #f)
+    (test (M2 2 1 1) 1)
+    (test (M2 2 1 2) 2)
+    (test (M2 2 1 3) 3)
+    (test (M2 2 1 4) #f)
+    (test (M2 2 2) '(1 2 3))
+    (test (M2 2 2 0) 1)
+    (test (M2 2 2 1) 2)
+    (test (M2 2 2 2) 3)
+    (test (M2 3) 'error)
+    (test (M2 4) 'error)
+    (test (H2 0) '(1 2 3))
+    (test (H2 0 0) 1)
+    (test (H2 0 1) 2)
+    (test (H2 0 2) 3)
+    (test (H2 1) #(1 2 3))
+    (test (H2 1 0) 1)
+    (test (H2 1 1) 2)
+    (test (H2 1 2) 3)
+    (test (H2 2) #2d((1 2 3) (4 5 6) (7 8 9)))
+    (test (H2 2 0) #(1 2 3))
+    (test (H2 2 0 0) 1)
+    (test (H2 2 0 1) 2)
+    (test (H2 2 0 2) 3)
+    (test (H2 2 1) #(4 5 6))
+    (test (H2 2 1 0) 4)
+    (test (H2 2 1 1) 5)
+    (test (H2 2 1 2) 6)
+    (test (H2 2 2) #(7 8 9))
+    (test (H2 2 2 0) 7)
+    (test (H2 2 2 1) 8)
+    (test (H2 2 2 2) 9)
+    (test (H2 2 3) 'error)
+    (test (H2 2 4) 'error)
+    (test (H2 3) "123")
+    (test (H2 3 0) #\1)
+    (test (H2 3 1) #\2)
+    (test (H2 3 2) #\3)
+    (test (H2 4) H1)
+    (test (H2 4 0) #f)
+    (test (H2 4 1) 1)
+    (test (H2 4 2) 2)
+    (test (H2 4 3) 3)
+    (test (H2 4 4) #f)
+     ))
+
+(let* ((L1 (cons 1 2))
+       (L2 (list L1 3)))
+  (test (L1 0) 1)
+  (test (L1 1) 'error)
+  (test (L1 2) 'error)
+  (test (L2 0 0) 1)
+  (test (L2 0 1) 'error)
+  (test ((cons "123" 0) 0 1) #\2))
+
+(let ((L1 (list "123" "456" "789")))
+  (set-cdr! (cdr L1) L1)
+  (test (L1 0 1) #\2)
+  (test (L1 1 1) #\5)
+  (test (L1 2 1) #\2)
+  (test (L1 12 0) #\1))
+
+(let ((L1 (list "123" "456" "789")))
+  (set-car! (cdr L1) L1)
+  (test (L1 1 1 1 1 1 0 0) #\1))
+
+(test ((list (list) "") 1 0) 'error)
+(test ((list (list) "") 0 0) 'error)
+(test (#(1 2) 0 0) 'error)
+(test (#(1 #()) 1 0) 'error)
+
+(test ('(((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((12))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) 12)
+
+;;; implicit index as expression (_A cases)
+
+(let ((L1 (list 1 2 3))
+      (V1 (vector 1 2 3))
+      (S1 "123")
+      (H1 (hash-table 1 1 2 2 3 3))
+      (E1 (inlet :a 1 :b 2)))
+  (define (f1 i s L V S H E)
+    (vector (L (+ i 1)) (V (+ i 1)) (S (+ i 1)) (H (+ i 1)) (E (string->symbol s))))
+  (test (f1 0 "a" L1 V1 S1 H1 E1) (vector 2 2 #\2 1 1))
+  (test (f1 1 "b" L1 V1 S1 H1 E1) (vector 3 3 #\3 2 2))
+  (define (f2 i s L V S H E)
+    (vector (L (abs i)) (V (abs i)) (S (abs i)) (H (abs i)) (E (vector-ref s 0))))
+  (test (f2 -2 #(b a) L1 V1 S1 H1 E1) (vector 3 3 #\3 2 2)))
+
+(when with-block
+  (define (f3 B i) (B (+ i 1)))
+  (define (f4 B i) (B (abs i)))
+  (let ((b (make-block 4)))
+    (set! (b 0) 1.0)
+    (set! (b 1) 2.0)
+    (test (f3 b -1) 1.0)
+    (test (f4 b -1) 2.0)))
+
+(let ((v1 #(0 1 2 3 4 5 6 7))
+      (v2 #2d((0 1 2 3) (4 5 6 7)))
+      (e1 (inlet :a 1))
+      (p1 (list 0 1 2 3))
+      (s1 "0123")
+      )
+  (define (call-1 func arg1 arg2) (func arg1 arg2))
+  (define (call-2 func arg1 arg2) (func arg1 arg2))
+  (define (call-3 func arg1 arg2) (func arg1 arg2))
+  (define (call-4 func arg1 arg2) (func arg1 arg2))
+  (define (call-5 func arg1 arg2) (func arg1 arg2))
+  (define (call-6 func) (func 'a))
+  (define (call-7 func) (func 'a))
+  (define (call-8 func arg) (func (* 2 (+ arg 1))))
+  (define (call-9 func arg) (func (* 2 (+ arg 1))))
+  (define (call-10 func arg) (func arg))
+  (define (call-11 func arg) (func arg))
+  (define (call-12 func) (func 0))
+  (define (call-13 func) (func 0))
+  (define (call-14 func arg) (func arg 2))
+  (define (call-15 func arg) (func 2 arg))
+
+  (define (f+ x y) (+ x y))
+  (define (f- x y) (- x y))
+  (define* (f++ (x 0) y) (+ x y))
+  (define* (f-- x (y 0)) (- x y))
+  (define (fabs x) (abs x))
+  (define-macro (m+ x y) `(+ ,x ,y))
+
+  (test (call-1 + 5 2) 7)
+  (test (call-1 f- 5 2) 3)
+  (test (call-2 f+ 5 2) 7)
+  (test (call-2 - 5 2) 3)
+  (test (call-3 v2 0 3) 3)
+  (test (call-3 list 0 3) (list 0 3))
+  (test (call-4 f++ 5 2) 7)
+  (test (call-4 f-- 5 2) 3)
+  (test (call-5 m+ 5 2) 7)
+  (test (call-5 - 5 2) 3)
+  (test (call-6 e1) 1)
+  (test (call-6 symbol?) #t)
+  (test (call-7 symbol?) #t)
+  (test (call-7 list) (list 'a))
+  (test (call-8 abs -3) 4)
+  (test (call-8 f-- 10) 22)
+  (test (call-9 fabs -3) 4)
+  (test (call-9 list -3) (list -4))
+  (test (call-10 e1 'a) 1)
+  (test (call-10 list 'a) (list 'a))
+  (test (call-11 symbol? 'a) #t)
+  (test (call-11 e1 'a) 1)
+  (test (call-12 p1) 0)
+  (test (call-12 s1) #\0)
+  (test (call-13 v1) 0)
+  (test (call-13 (lambda (x) (+ x 1))) 1)
+  (test (call-14 * 3) 6)
+  (test (call-14 (lambda (x y) (- x y)) 3) 1)
+  (test (call-15 (lambda (x y) (- x y)) 3) -1)
+  (test (call-15 - 3) -1)
+  )
+
+;; multi-index get/set
+(let ((v (vector (hash-table 'a 1 'b 2)))) (test (v 0 'a) 1) (set! (v 0 'a) 5) (test (v 0 'a) 5))
+(let ((v (vector (inlet 'a 1 'b 2)))) (test (v 0 'a) 1) (set! (v 0 'a) 5) (test (v 0 'a) 5))
+(let ((v (vector (list 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5))
+(let ((v (vector (string #\1 #\2)))) (test (v 0 1) #\2) (set! (v 0 1) #\5) (test (v 0 1) #\5))
+(let ((v (vector (vector 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5))
+(let ((v (vector (byte-vector 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5))
+(when with-block (let ((v (vector (block 1 2)))) (test (v 0 1) 2.0) (set! (v 0 1) 5) (test (v 0 1) 5.0)))
+(let ((v (vector (float-vector 1 2)))) (test (v 0 1) 2.0) (set! (v 0 1) 5) (test (v 0 1) 5.0))
+(let ((v (vector (int-vector 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5))
+(let ((v (list (hash-table 'a 1 'b 2)))) (test (v 0 'a) 1) (set! (v 0 'a) 5) (test (v 0 'a) 5))
+(let ((v (list (inlet 'a 1 'b 2)))) (test (v 0 'a) 1) (set! (v 0 'a) 5) (test (v 0 'a) 5))
+(let ((v (list (list 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5))
+(let ((v (list (string #\1 #\2)))) (test (v 0 1) #\2) (set! (v 0 1) #\5) (test (v 0 1) #\5))
+(let ((v (list (vector 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5))
+(let ((v (list (byte-vector 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5))
+(when with-block (let ((v (list (block 1 2)))) (test (v 0 1) 2.0) (set! (v 0 1) 5) (test (v 0 1) 5.0)))
+(let ((v (list (float-vector 1 2)))) (test (v 0 1) 2.0) (set! (v 0 1) 5) (test (v 0 1) 5.0))
+(let ((v (list (int-vector 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5))
+(let ((v (hash-table 'a (hash-table 'a 1 'b 2)))) (test (v 'a 'a) 1) (set! (v 'a 'a) 5) (test (v 'a 'a) 5))
+(let ((v (hash-table 'a (inlet 'a 1 'b 2)))) (test (v 'a 'a) 1) (set! (v 'a 'a) 5) (test (v 'a 'a) 5))
+(let ((v (hash-table 'a (list 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5))
+(let ((v (hash-table 'a (string #\1 #\2)))) (test (v 'a 1) #\2) (set! (v 'a 1) #\5) (test (v 'a 1) #\5))
+(let ((v (hash-table 'a (vector 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5))
+(let ((v (hash-table 'a (byte-vector 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5))
+(when with-block (let ((v (hash-table 'a (block 1 2)))) (test (v 'a 1) 2.0) (set! (v 'a 1) 5) (test (v 'a 1) 5.0)))
+(let ((v (hash-table 'a (float-vector 1 2)))) (test (v 'a 1) 2.0) (set! (v 'a 1) 5) (test (v 'a 1) 5.0))
+(let ((v (hash-table 'a (int-vector 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5))
+(let ((v (inlet 'a (hash-table 'a 1 'b 2)))) (test (v 'a 'a) 1) (set! (v 'a 'a) 5) (test (v 'a 'a) 5))
+(let ((v (inlet 'a (inlet 'a 1 'b 2)))) (test (v 'a 'a) 1) (set! (v 'a 'a) 5) (test (v 'a 'a) 5))
+(let ((v (inlet 'a (list 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5))
+(let ((v (inlet 'a (string #\1 #\2)))) (test (v 'a 1) #\2) (set! (v 'a 1) #\5) (test (v 'a 1) #\5))
+(let ((v (inlet 'a (vector 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5))
+(let ((v (inlet 'a (byte-vector 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5))
+(when with-block (let ((v (inlet 'a (block 1 2)))) (test (v 'a 1) 2.0) (set! (v 'a 1) 5) (test (v 'a 1) 5.0)))
+(let ((v (inlet 'a (float-vector 1 2)))) (test (v 'a 1) 2.0) (set! (v 'a 1) 5) (test (v 'a 1) 5.0))
+(let ((v (inlet 'a (int-vector 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5))
+
+(let ((v (vector (list 1 2)))) (set! (v 0 0) 12) (test v #((12 2))))
+(let ((v (vector (vector (list 1 2))))) (set! (v 0 0 0) 12) (test v #(#((12 2)))))
+(let ((v (vector (list 1 2 3) #f))) (set! (v 0 1) 121) (test v #((1 121 3) #f)))
+(let ((v (make-vector '(2 2) #f))) (set! (v 0 0) (list 1 2 3)) (set! ((v 0 0) 1) 32) (test (v 0 0 1) 32) (set! (v 0 0 1) 12) (test v #2d(((1 12 3) #f) (#f #f))))
+
+(test (let ((L (list 1 2 3))) (set! (L (- 4 3 1)) 2) L) '(2 2 3))
+(test (let ((L (list 1 2 3)) (zero 0)) (set! (L zero) 2) L) '(2 2 3))
+(test (let ((L (list (list 1 2 3)))) (set! (L (- (length L) 1) 2) 0) L) '((1 2 0)))
+(test (let ((L (list 1 2 3))) (set! (L) 1)) 'error) ; no index for list-set!: (set! (L) 1)
+(test (let ((L (hash-table 'b (hash-table 'a 1)))) (set! (L (symbol "b") (symbol "a")) 0) L) (hash-table 'b (hash-table 'a 0)))
+(test (let ((L (inlet 'b (inlet 'a 1)))) (set! (L (symbol "b") (symbol "a")) 0) L) (inlet 'b (inlet 'a 0)))
+(test (let ((L (inlet 'b (inlet 'a 1)))) (set! (L) 0) L) 'error)
+(test (let ((v (make-vector '(2 2) 1))) (set! (v 0 1+i) 61)) 'error)
+(test (let ((H (hash-table 'a (inlet 'a (list 1 2 3))))) (set! (H 'a 'a 1) 12) (H 'a 'a 1)) 12)
+
+(let ((ind 0) (sym 'a) (v (vector (hash-table 'a 1 'b 2)))) (test (v ind sym) 1) (set! (v (+ ind ind) sym) (+ ind 5)) (test (v 0 'a) 5))
+(let ((v (vector (hash-table 'a "123" 'b 2)))) (test (v 0 'a 1) #\2) (set! (v 0 'a 1) #\5) (test (v 0 'a) "153"))
+
+(let ((iv (make-vector '(2 2))))
+  (set! (iv 1 0) 2)
+  (set! (iv 1 1) 4)
+  (let ((v (vector iv)))
+    (test (v 0 1 0) 2)
+    (set! (v 0 1 0) 5)
+    (test (v 0 1) #(5 4))))
+
+(let ((ov (make-vector '(2 2)))
+      (iv (make-vector '(2 2))))
+  (set! (ov 1 0) iv)
+  (set! (iv 0 1) 3)
+  (test (ov 1 0 0 1) 3)
+  (set! (ov 1 0 0 1) 5)
+  (test (ov 1 0 0 1) 5))
+
+(test (let () (define (func) (abs ((list #f #r(1 2 3)) 1 0))) (define (hi) (func)) (hi)) 1.0)
+(test (let () (define (func) (abs ((list #f #i(1 2 3)) 1 0))) (define (hi) (func)) (hi)) 1)
+(test (let () (define (func) (abs ((list #f #(1 2 3)) 1 0))) (define (hi) (func)) (hi)) 1)
+(test (let () (define (func) (abs ((list #f #u(1 2 3)) 1 0))) (define (hi) (func)) (hi)) 1)
+(test (let () (define (func) (char->integer ((list #f "123") 1 0))) (define (hi) (func)) (hi)) (char->integer #\1))
+(test (let () (define (func) (abs ((list #f (lambda (x) (+ x 10))) 1 0))) (define (hi) (func)) (hi)) 'error) ; 10)
+(test (let () (define (func) (abs ((list #f ceiling) 1 1.1))) (define (hi) (func)) (hi)) 2)
+(test (let () (define (func) (abs ((list #f quasiquote) 1 2))) (define (hi) (func)) (hi)) 2)
+(test (let () (define (func) (abs ((list #f (define-macro (_m_ x) `(+ ,x 1))) 1 2))) (define (hi) (func)) (hi)) 3)
+(test (let () (define (func) (abs ((list #f (inlet 'a -2)) 1 :a))) (define (hi) (func)) (hi)) 2)
+(test (let () (define (func) (abs ((list #f (inlet :a -2)) 1 :a))) (define (hi) (func)) (hi)) 2)
+(test (let () (define (func) (abs ((list #f (inlet 'a -2)) 1 'a))) (define (hi) (func)) (hi)) 2)
+(test (let () (define (func) (abs ((list #f (inlet :a -2)) 1 'a))) (define (hi) (func)) (hi)) 2)
+(test (let () (define (func) (abs ((list #f (hash-table :a -2)) 1 :a))) (define (hi) (func)) (hi)) 2)
+(test (let () (define (func) (abs ((list #f (hash-table 'a -2)) 1 'a))) (define (hi) (func)) (hi)) 2)
+(test (let () (define (func) (abs ((list #f begin) 1 3))) (define (hi) (func)) (hi)) 3)
+(test (let () (define (func) (abs ((list #f when) 1 #t 4))) (define (hi) (func)) (hi)) 4)
+(test (let () (define (func) (abs (list-ref (list #f (list #i(1 2 3))) 1 0 0))) (define (hi) (func)) (hi)) 1) ; 'error -- implicit_index
+(test (let () (define (func) (abs (list-ref (list #f #i(1 2 3)) 1 0))) (define (hi) (func)) (hi)) 1)          ;  'error -- same
+(test (let () (define (func) (abs (vector-ref (vector #f '(1 2 3)) 1 0))) (define (hi) (func)) (hi)) 1)       ; same
+(test (let () (define (func) (abs ((inlet 'a (inlet 'b 2)) 'a 'b))) (define (hi) (func)) (hi)) 2)
+(test (let () (define (func) (abs ((inlet 'a (vector 1 2 3)) 'a 1))) (define (hi) (func)) (hi)) 2)
+(test (let () (define (func) (abs (hash-table-ref (hash-table 'a (hash-table 'b 2)) 'a 'b))) (define (hi) (func)) (hi)) 2)
+(test (let () (define (func) (abs ((hash-table 'a (hash-table 'b 2)) 'a 'b))) (define (hi) (func)) (hi)) 2)
+(test (let () (define (func) (abs ((hash-table 'a (vector 1 2 3)) 'a 1))) (define (hi) (func)) (hi)) 2)
+
+;;; (hash-table 'a 1) is different from (hash-table :a 1):
+(test (let () (define (func) (abs ((list #f (hash-table 'a -2)) 1 :a))) (define (hi) (func)) (hi)) 'error)
+(test (let () (define (func) (abs ((list #f (hash-table :a -2)) 1 'a))) (define (hi) (func)) (hi)) 'error)
+
+(test (let () (define (func) (abs (let-ref (inlet 'a (inlet 'b 2)) 'a 'b))) (define (hi) (func)) (hi)) 'error)
+(test (let () (define (func) (abs (hash-table-ref (hash-table 'a (vector 1 2 3)) 'a 1))) (define (hi) (func)) (hi)) 2) ; see above 'error
+
+(when with-block
+  (test (let ((B (block 0 1 2)) (I 1)) (set! (B (- I 1)) 32) B) (block 32 1 2))
+  (test (let ((B (block 0 1 2)) (I 1)) (set! (B I) (* 12 I)) B) (block 0 12 2)))
+
+
+;;; --------------------------------------------------------------------------------
+;;; PORTS
+;;; --------------------------------------------------------------------------------
+
+;;; with-output-to-string
+;;; with-output-to-file
+;;; call-with-output-string
+;;; call-with-output-file
+;;; with-input-from-string
+;;; with-input-from-file
+;;; call-with-input-string
+;;; call-with-input-file
+;;; read-char
+;;; peek-char
+;;; close-input-port
+;;; close-output-port
+;;; flush-output-port
+;;; open-input-file
+;;; open-output-file
+;;; open-input-string
+;;; open-output-string
+;;; get-output-string
+;;; open-input-function
+;;; open-output-function
+;;; write-char
+;;; write-string
+;;; read-byte
+;;; write-byte
+;;; read-line
+;;; read-string
+;;; read
+;;; write
+;;; display
+
+(define start-input-port (current-input-port))
+(define start-output-port (current-output-port))
+
+(test (input-port? (current-input-port)) #t)
+(test (input-port? *stdin*) #t)
+(test (input-port? (current-output-port)) #f)
+(test (input-port? *stdout*) #f)
+(test (input-port? (current-error-port)) #f)
+(test (input-port? *stderr*) #f)
+
+(for-each
+ (lambda (arg)
+   (if (input-port? arg)
+       (format #t ";(input-port? ~A) -> #t?~%" arg)))
+ (list "hi" #f (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f :hi #<eof> #<undefined> #<unspecified>))
+
+(test (call-with-input-file "s7test.scm" input-port?) #t)
+(if (not (eq? start-input-port (current-input-port)))
+    (format #t "call-with-input-file did not restore current-input-port? ~A from ~A~%" start-input-port (current-input-port)))
+
+(test (let ((this-file (open-input-file "s7test.scm"))) (let ((res (input-port? this-file))) (close-input-port this-file) res)) #t)
+(if (not (eq? start-input-port (current-input-port)))
+    (format #t "open-input-file clobbered current-input-port? ~A from ~A~%" start-input-port (current-input-port)))
+
+(test (call-with-input-string "(+ 1 2)" input-port?) #t)
+(test (let ((this-file (open-input-string "(+ 1 2)"))) (let ((res (input-port? this-file))) (close-input-port this-file) res)) #t)
+(test (let ((this-file (open-input-string "(+ 1 2)"))) (let ((len (length this-file))) (close-input-port this-file) len)) 7)
+
+;;; (test (let ((str "1234567890")) (let ((p (open-input-string str))) (string-set! str 0 #\a) (let ((c (read-char p))) (close-input-port p) c))) #\1)
+;;; is that result demanded by the scheme spec? perhaps make str immutable if so?
+
+(test (+ 100 (call-with-input-string "123" (lambda (p) (values (read p) 1)))) 224)
+
+(test (catch #t (lambda () (with-input-from-string "asdf" #(0 1 2))) (lambda (typ info) (apply format #f info)))
+      "with-input-from-string second argument, #(0 1 2), is a vector but should be a thunk")
+(test (catch #t (lambda () (with-input-from-string "asdf" abs)) (lambda (typ info) (apply format #f info)))
+      "abs requires 1 argument, but with-input-from-string's second argument should be a thunk")
+(test (catch #t (lambda () (with-input-from-string "asdf" (lambda (x y z) z))) (lambda (typ info) (apply format #f info)))
+      "#<lambda (x y ...)> requires 3 arguments, but with-input-from-string's second argument should be a thunk")
+
+(test (catch #t (lambda () (with-input-from-file "s7test.scm" #(0 1 2))) (lambda (typ info) (apply format #f info)))
+      "with-input-from-file second argument, #(0 1 2), is a vector but should be a thunk")
+(test (catch #t (lambda () (with-input-from-file "s7test.scm" (macro (x z) x))) (lambda (typ info) (apply format #f info)))
+      "#<macro (x z)> requires 2 arguments, but with-input-from-file's second argument should be a thunk")
+(test (catch #t (lambda () (with-input-from-file "s7test.scm" quasiquote)) (lambda (typ info) (apply format #f info)))
+      "#_quasiquote requires 1 argument, but with-input-from-file's second argument should be a thunk")
+
+(test (catch #t (lambda () (with-output-to-string #(0 1 2))) (lambda (typ info) (apply format #f info)))
+      "with-output-to-string first argument, #(0 1 2), is a vector but should be a thunk")
+(test (catch #t (lambda () (with-output-to-string (lambda (x . z) x))) (lambda (typ info) (apply format #f info)))
+       "#<lambda (x . z)> requires 1 argument, but with-output-to-string's first argument should be a thunk")
+
+(test (catch #t (lambda () (with-output-to-file "hi" #i(0 1 2))) (lambda (typ info) (apply format #f info)))
+      "with-output-to-file second argument, #i(0 1 2), is an int-vector but should be a thunk")
+(test (catch #t (lambda () (with-output-to-file "hi" (bacro (x y . z) x))) (lambda (typ info) (apply format #f info)))
+      "#<bacro (x y ...)> requires 2 arguments, but with-output-to-file's second argument should be a thunk")
+
+(let ((p (open-input-string "asdf")))
+  (test (display pi p) 'error)
+  (test (write pi p) 'error)
+  (test (close-output-port p) 'error)
+  (test (flush-output-port p) 'error)
+  (close-input-port p)
+  (test (read p) 'error))
+(let ((p (open-output-string)))
+  (test (read-char p) 'error)
+  (test (read-byte p) 'error)
+  (test (read-line p) 'error)
+  (test (read-string 1 p) 'error)
+  (test (read-line p) 'error)
+  (test (close-input-port p) 'error)
+  (close-output-port p)
+  (test (display pi p) 'error)
+  (test (write pi p) 'error))
+
+(let () ; write_p_p
+  (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (write (floor pi))))
+  (test (with-output-to-string f) "3"))
+
+(test (call-with-input-string
+       "1234567890"
+       (lambda (p)
+	 (call-with-input-string
+	  "0987654321"
+	  (lambda (q)
+            (+ (read p) (read q))))))
+      2222222211)
+
+(test (call-with-input-string
+       "12345 67890"
+       (lambda (p)
+	 (call-with-input-string
+	  "09876 54321"
+	  (lambda (q)
+            (- (+ (read p) (read q)) (read p) (read q))))))
+      -99990)
+
+(call-with-output-file "empty-file" (lambda (p) #f))
+(test (call-with-input-file "empty-file" (lambda (p) (eof-object? (read-char p)))) #t)
+(test (call-with-input-file "empty-file" (lambda (p) (eof-object? (read p)))) #t)
+(test (call-with-input-file "empty-file" (lambda (p) (eof-object? (read-byte p)))) #t)
+(test (call-with-input-file "empty-file" (lambda (p) (eof-object? (read-line p)))) #t)
+(test (load "empty-file") #<unspecified>)
+(test (call-with-input-file "empty-file" (lambda (p) (port-closed? p))) #f)
+(test (eof-object? (call-with-input-string "" (lambda (p) (read p)))) #t)
+(test (eof-object? #<eof>) #t)
+(test (let () (define (hi a) (eof-object? a)) (hi #<eof>)) #t)
+
+(let ()
+  (define (io-func) (lambda (p) (eof-object? (read-line p))))
+  (test (call-with-input-file (let () "empty-file") (io-func)) #t))
+
+(let ((p1 #f))
+  (call-with-output-file "empty-file" (lambda (p) (set! p1 p) (write-char #\a p)))
+  (test (port-closed? p1) #t))
+(test (call-with-input-file "empty-file" (lambda (p) (and (char=? (read-char p) #\a) (eof-object? (read-char p))))) #t)
+(test (call-with-input-file "empty-file" (lambda (p) (and (string=? (symbol->string (read p)) "a") (eof-object? (read p))))) #t) ; Guile also returns a symbol here
+(test (call-with-input-file "empty-file" (lambda (p) (and (char=? (integer->char (read-byte p)) #\a) (eof-object? (read-byte p))))) #t)
+(test (call-with-input-file "empty-file" (lambda (p) (and (string=? (read-line p) "a") (eof-object? (read-line p))))) #t)
+
+(test (call-with-input-string "(lambda (a) (+ a 1))" (lambda (p) (let ((f (eval (read p)))) (f 123)))) 124)
+(test (call-with-input-string "(let ((x 21)) (+ x 1))" (lambda (p) (eval (read p)))) 22)
+(test (call-with-input-string "(1 2 3) (4 5 6)" (lambda (p) (list (read p) (read p)))) '((1 2 3) (4 5 6)))
+
+(test (let ()
+	(call-with-output-file "empty-file" (lambda (p) (write '(lambda (a) (+ a 1)) p)))
+	(call-with-input-file "empty-file" (lambda (p) (let ((f (eval (read p)))) (f 123)))))
+      124)
+(test (let ()
+	(call-with-output-file "empty-file" (lambda (p) (write '(let ((x 21)) (+ x 1)) p)))
+	(call-with-input-file "empty-file" (lambda (p) (eval (read p)))))
+      22)
+(test (let ()
+	(call-with-output-file "empty-file" (lambda (p) (write '(1 2 3) p) (write '(4 5 6) p)))
+	(call-with-input-file "empty-file" (lambda (p) (list (read p) (read p)))))
+      '((1 2 3) (4 5 6)))
+
+(call-with-output-file "empty-file" (lambda (p) (for-each (lambda (c) (write-char c p)) "#b11")))
+(test (call-with-input-file "empty-file" (lambda (p)
+					   (and (char=? (read-char p) #\#)
+						(char=? (read-char p) #\b)
+						(char=? (read-char p) #\1)
+						(char=? (read-char p) #\1)
+						(eof-object? (read-char p)))))
+      #t)
+(test (call-with-input-file "empty-file" (lambda (p)
+					   (and (= (read p) 3)
+						(eof-object? (read p)))))
+      #t)
+(test (call-with-input-file "empty-file" (lambda (p)
+					   (and (= (read-byte p) (char->integer #\#))
+						(= (read-byte p) (char->integer #\b))
+						(= (read-byte p) (char->integer #\1))
+						(= (read-byte p) (char->integer #\1))
+						(eof-object? (read-byte p)))))
+      #t)
+(test (call-with-input-file "empty-file" (lambda (p)
+					   (and (string=? (read-line p) "#b11")
+						(eof-object? (read-line p)))))
+      #t)
+(test (load "empty-file") 3)
+(let ((p1 (dilambda (lambda (p) (and (= (read p) 3) (eof-object? (read p)))) (lambda (p x) #f))))
+  (test (call-with-input-file "empty-file" p1) #t))
+
+(let ((port #f))
+  (let ((val (call-with-exit
+	      (lambda (return)
+		(call-with-input-string "asdf"
+		  (lambda (p)
+		    (set! port p)
+		    (return 32)))))))
+    (test (list val (port-closed? port)) '(32 #t))))
+
+(let ((port #f))
+  (let ((val (call/cc
+	      (lambda (return)
+		(call-with-input-string "asdf"
+		  (lambda (p)
+		    (set! port p)
+		    (return 32)))))))
+    (test (list val (port-closed? port)) '(32 #f))))
+
+(let ((port #f))
+  (let ((val (catch #t
+	      (lambda ()
+		(call-with-input-string "asdf"
+		  (lambda (p)
+		    (set! port p)
+		    (throw #t 32))))
+	      (lambda (type info)
+		(car info)))))
+    (test (list val (port-closed? port)) '(32 #t))))
+
+(let ((port #f))
+  (let ((val (catch #t
+	      (lambda ()
+		(call-with-input-string "asdf"
+		  (lambda (p)
+		    (set! port p)
+		    (error 'oops 32))))
+	      (lambda (type info)
+		(car info)))))
+    (test (list val (port-closed? port)) '(32 #t))))
+
+(let ((port #f))
+  (let ((val (dynamic-wind
+		 (lambda ()
+		   (set! port (open-input-string "asdf")))
+		 (lambda ()
+		   32)
+		 (lambda ()
+		   (close-input-port port)))))
+    (test (list val (port-closed? port)) '(32 #t))))
+
+(let ((port #f))
+  (let ((val (call-with-exit
+	      (lambda (return)
+		(let-temporarily ((port 12))
+		  (return 32))))))
+    (test (list val (eqv? port #f)) '(32 #t))))
+
+(let ((port #f))
+  (let ((val (call-with-exit
+	      (lambda (return)
+		(let-temporarily (((*s7* 'print-length) 8))
+		  (call-with-input-string "asdf"
+		    (lambda (p)
+		      (set! port p)
+		      (return 32))))))))
+    (test (list val (port-closed? port)) '(32 #t))))
+
+(let ((port #f))
+  (define (reporter a b) (list a (port-closed? b)))
+  (define (f)
+    (dynamic-unwind reporter 32)
+    (call-with-exit
+     (lambda (return)
+       (call-with-input-string "asdf"
+	 (lambda (p)
+	   (set! port p)
+	   (return port))))))
+  (test (f) '(32 #t)))
+
+
+;;; load
+(for-each
+ (lambda (arg)
+   (test (load arg) 'error)
+   (test (load "empty-file" arg) 'error))
+ (list () (list 1) '(1 . 2) #f #\a 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+(test (load) 'error)
+(test (load "empty-file" (curlet) 1) 'error)
+(test (load "not a file") 'error)
+(test (load "") 'error)
+(test (load (append "/home/" username "/cl")) 'error)
+(test (call-with-input-string "(display (+ 1 2))" load) 'error)
+(test (let () (define (func) (#_call-with-input-string (make-vector 3 'a symbol?) (lambda (x) x))) (func)) 'error)
+(test (let () (define (func) (#_call-with-input-file (openlet (inlet 'a 1)) (lambda (x) x))) (func)) 'error)
+
+(test (catch #t (lambda () (display 123 #t)) (lambda (t i) (apply format #f i)))
+      "display second argument, #t, is boolean but should be an output port or #f")
+(test (catch #t (lambda () (write 123 #t)) (lambda (t i) (apply format #f i)))
+      "write second argument, #t, is boolean but should be an output port or #f")
+
+(call-with-output-file "empty-file" (lambda (p) (write '(+ 1 2 3) p)))
+(let ((x 4))
+  (test (+ x (load "empty-file")) 10))
+
+(call-with-output-file "empty-file" (lambda (p) (write '(list 1 2 3) p)))
+(let ((x 4))
+  (test (cons x (load "empty-file")) '(4 1 2 3)))
+
+(call-with-output-file "empty-file" (lambda (p) (write '(values 1 2 3) p)))
+(let ((x 4))
+  (test (+ x (load "empty-file")) 10))
+(test (+ 4 (eval (call-with-input-file "empty-file" (lambda (p) (read p))))) 10)
+
+(call-with-output-file "empty-file" (lambda (p) (write '(+ x 1) p)))
+(let ((x 2))
+  (test (load "empty-file" (curlet)) 3))
+
+(call-with-output-file "empty-file" (lambda (p) (write '(set! x 1) p)))
+(let ((x 2))
+  (load "empty-file" (curlet))
+  (test x 1))
+
+(call-with-output-file "empty-file" (lambda (p) (write '(define (hi a) (values a 2)) p) (write '(hi x) p)))
+(let ((x 4))
+  (test (+ x (load "empty-file" (curlet))) 10))
+
+(let ((x 1)
+      (e #f))
+  (set! e (curlet))
+  (let ((x 4))
+    (test (+ x (load "empty-file" e)) 7)))
+
+(let ()
+  (let ()
+    (call-with-output-file "empty-file" (lambda (p) (write '(define (load_hi a) (+ a 1)) p)))
+    (load "empty-file" (curlet))
+    (test (load_hi 2) 3))
+  (test (defined? 'load_hi) #f))
+
+(let ()
+  (apply load '("empty-file"))
+  (test (load_hi 2) 3))
+
+(call-with-output-file "empty-file" (lambda (p) (display "\"empty-file\"" p)))
+(test (load (load "empty-file")) "empty-file")
+
+;;; *cload-directory*
+(test (set! *cload-directory* 123) 'error)
+(let ((old-dir *cload-directory*))
+  (set! *cload-directory* (append "/home/" username "/cl/"))
+  (test *cload-directory* (append "/home/" username "/cl/"))
+  (set! *cload-directory* old-dir))
+
+;;; autoload
+(when (provided? 'autoload)
+  (test (autoload) 'error)
+  (test (autoload 'abs) 'error)
+  (test (autoload :abs "dsp.scm") 'error)
+  (for-each
+   (lambda (arg)
+     (test (autoload arg "dsp.scm") 'error)
+     (test (autoload 'hi arg) 'error))
+   (list #f () (integer->char 65) 1 (list 1 2) _ht_ _undef_ _null_ _c_obj_ '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f))
+  (test (autoload 'abs "dsp.scm" 123) 'error)
+  (test (autoload "" "dsp.scm") 'error)
+
+  (autoload 'auto_test_var "empty-file")
+  (test (defined? 'auto_test_var) #f)
+  (call-with-output-file "empty-file" (lambda (p) (format p "(define auto_test_var 123)~%")))
+  (load "empty-file")
+  (test (+ 1 auto_test_var) 124)
+
+  (autoload 'auto_test_var_2 (lambda (e) (varlet e (cons 'auto_test_var_2 1))))
+  (test (let () (+ 1 auto_test_var_2)) 2)
+
+  (autoload 'auto_test_var_3 (lambda (e) (varlet e (cons 'auto_test_var_3 1))))
+  (autoload 'auto_test_var_4 (lambda (e) (varlet e (cons 'auto_test_var_4 (+ auto_test_var_3 1)))))
+  (test (let () (+ auto_test_var_4 1)) 3)
+
+  (test (autoload 'auto_test_var_1 (lambda () #f)) 'error)
+  (test (autoload 'auto_test_var_1 (lambda (a b) #f)) 'error)
+
+  (let ()
+    (test (defined? 'j0) #f)
+    (test (autoload 'j0 "libm.scm") "libm.scm")
+    (test (j0 0.0) 1.0))
+  ;(test (defined? 'j0) #f) ; this changes -- currently autoload always defines its symbol globally
+
+  (let ()
+    (test (autoload 'ho "s7test.scm") "s7test.scm")
+    (test (*autoload* 'ho) "s7test.scm")
+    (set! (*autoload* 'ho) "dsp.scm")
+    (test (*autoload* 'ho) "dsp.scm")
+    (test (*autoload* 123) 'error)))
+
+(let ((str3 #f))
+  ;; IO tests mainly
+
+  (set! str3 "0123456789")
+  (set! str3 (string-append str3 str3 str3 str3 str3 str3 str3 str3 str3 str3))
+  (set! str3 (string-append str3 str3 str3 str3 str3 str3 str3 str3 str3 str3))
+  (set! str3 (string-append str3 str3 str3))
+
+  (call-with-output-file "test.scm"
+    (lambda (p)
+      (format p "(define (big-string)~%")
+      (format p "  \"")
+      (display str3 p)
+      (format p "\\\n") ; this becomes \<newline> in the midst of a string which we ignore
+      (display str3 p)
+      (format p "\"")
+      (format p ")~%")))
+
+  (load "test.scm")
+  (let ((str (big-string)))
+    (test (length str) 6000))
+
+  (let ((big-string (eval (call-with-input-string
+			   (call-with-output-string
+			    (lambda (p)
+			      (format p "(lambda ()~%")
+			      (format p "  \"")
+			      (display str3 p)
+			      (format p "\\\n") ; this becomes \<newline> in the midst of a string which we ignore
+			      (display str3 p)
+			      (format p "\"")
+			      (format p ")~%")))
+			   read))))
+    (let ((str (big-string)))
+      (test (length str) 6000)))
+
+  (call-with-output-file "test.scm"
+    (lambda (p)
+      (format p "(define (big-string)~%")
+      (format p "  \"")
+      (display str3 p)
+      (format p "\\\"")
+      (display str3 p)
+      (format p "\"")
+      (format p ")~%")))
+
+  (load "test.scm")
+  (let ((str (big-string)))
+    (test (length str) 6001))
+
+  (let ((big-string (eval (call-with-input-string
+			   (call-with-output-string
+			    (lambda (p)
+			      (format p "(lambda ()~%")
+			      (format p "  \"")
+			      (display str3 p)
+			      (format p "\\\"")
+			      (display str3 p)
+			      (format p "\"")
+			      (format p ")~%")))
+			   read))))
+    (let ((str (big-string)))
+      (test (length str) 6001)))
+
+  (call-with-output-file "test.scm"
+    (lambda (p)
+      (format p "")))
+  (load "test.scm") ; #<unspecified>
+
+  (let ()
+    (define (write-stuff p)
+      (format p ";")
+      (do ((i 0 (+ i 1)))
+	  ((= i 3000))
+	(let ((c (integer->char (random 128))))
+	  (if (char<? c #\space)
+	      (display #\space p)
+	      (display c p))))
+      (format p "~%32~%"))
+    (call-with-output-file "test.scm" write-stuff)
+    (test (load "test.scm") 32))
+
+  (let ()
+    (define (write-stuff p)
+      (format p "(define (big-list)~%  (list ")
+      (do ((i 0 (+ i 1)))
+	  ((= i 2000))
+	(format p "~D " i))
+      (format p "))~%"))
+    (call-with-output-file "test.scm" write-stuff)
+    (load "test.scm")
+    (let ((lst (big-list)))
+      (test (length lst) 2000)))
+
+  (let ()
+    (define (write-stuff p)
+      (format p "(define (big-list)~%  ")
+      (do ((i 0 (+ i 1)))
+	  ((= i 2000))
+	(format p "(cons ~D " i))
+      (format p "()")
+      (do ((i 0 (+ i 1)))
+	  ((= i 2000))
+	(format p ")"))
+      (format p ")~%"))
+  (call-with-output-file "test.scm" write-stuff)
+  (load "test.scm")
+  (let ((lst (big-list)))
+    (test (length lst) 2000)))
+
+  (call-with-output-file "test.scm"
+    (lambda (p)
+      (format p "(define (a-char)~%  #\\a)~%")))
+
+  (load "test.scm")
+  (test (a-char) #\a)
+
+  (call-with-output-file "test.scm"
+    (lambda (p)
+      (let ((a (char->integer #\a)))
+	(format p "(define (big-char)~%  (string ")
+	(do ((i 0 (+ i 1)))
+	    ((= i 2000))
+	  (format p "#\\~C " (integer->char (+ a (modulo i 26)))))
+	(format p "))~%"))))
+
+  (load "test.scm")
+  (let ((chars (big-char)))
+    (test (length chars) 2000))
+
+  (call-with-output-file "test.scm"
+    (lambda (p)
+      (let ((a (char->integer #\a)))
+	(format p "(define (big-xchar)~%  (string ")
+	(do ((i 0 (+ i 1)))
+	    ((= i 2000))
+	  (format p "#\\x~X " (+ a (modulo i 26))))
+	(format p "))~%"))))
+
+  (load "test.scm")
+  (let ((chars (big-xchar)))
+    (test (length chars) 2000))
+
+  (call-with-output-file "test.scm"
+    (lambda (p)
+      (format p "(define (ychar) #\\~C)" (integer->char 255))))
+  (load "test.scm")
+  (test (ychar) (integer->char 255))
+
+  (let ()
+    (define (write-stuff p)
+      (do ((i 0 (+ i 1)))
+	  ((= i 1000))
+	(format p "~D" i))
+      (format p "~%")
+      (do ((i 0 (+ i 1)))
+	  ((= i 1000))
+	(format p "~D" i)))
+    (call-with-output-file "test.scm" write-stuff))
+
+  (call-with-input-file "test.scm"
+    (lambda (p)
+      (let ((s1 (read-line p))
+	    (s2 (read-line p)))
+	(test (and (string=? s1 s2)
+		   (= (length s1) 2890))
+	      #t))))
+
+  (call-with-output-file "test.scm"
+    (lambda (p)
+      (format p "(define (big-int)~%")
+      (do ((i 0 (+ i 1)))
+	  ((= i 3000))
+	(format p "0"))
+      (format p "123)~%")))
+
+  (load "test.scm")
+  (test (big-int) 123)
+
+  (call-with-output-file "test.scm"
+    (lambda (p)
+      (format p "(define (big-rat)~%")
+      (do ((i 0 (+ i 1)))
+	  ((= i 3000))
+	(format p "0"))
+      (format p "123/")
+      (do ((i 0 (+ i 1)))
+	  ((= i 3000))
+	(format p "0"))
+      (format p "2)~%")))
+
+  (load "test.scm")
+  (test (big-rat) 123/2)
+
+  (call-with-output-file "test.scm"
+    (lambda (p)
+      (format p "(define (big-hash)~%  (hash-table ")
+      (do ((i 0 (+ i 1)))
+	  ((= i 2000))
+	(format p "~D ~D " i (+ i 1)))
+      (format p "))~%")))
+
+  (load "test.scm")
+  (let ((ht (big-hash)))
+    (let ((entries 0))
+      (for-each
+       (lambda (htv)
+	 (set! entries (+ entries 1))
+	 (if (not (= (+ (car htv) 1) (cdr htv)))
+	     (format *stderr* ";hashed: ~A~%" htv)))
+       ht)
+      (test entries 2000)))
+
+  (call-with-output-file "test.scm"
+    (lambda (p)
+      (format p "(define (big-hash)~%  (apply hash-table (list ")
+      (do ((i 0 (+ i 1)))
+	  ((= i 2000))
+	(format p "~D ~D " i (+ i 1)))
+      (format p ")))~%")))
+
+  (load "test.scm")
+  (let ((ht (big-hash)))
+    (let ((entries 0))
+      (for-each
+       (lambda (htv)
+	 (set! entries (+ entries 1))
+	 (if (not (= (+ (car htv) 1) (cdr htv)))
+	     (format *stderr* ";hashed: ~A~%" htv)))
+       ht)
+      (test entries 2000)))
+
+  (call-with-output-file "test.scm"
+    (lambda (p)
+      (let ((a (char->integer #\a)))
+	(format p "(define (big-env)~%  (inlet ")
+	(do ((i 0 (+ i 1)))
+	    ((= i 2000))
+	  (format p "'(~A . ~D) "
+		  (string (integer->char (+ a (modulo i 26)))
+			  (integer->char (+ a (modulo (floor (/ i 26)) 26)))
+			  (integer->char (+ a (modulo (floor (/ i (* 26 26))) 26))))
+		  i))
+	(format p "))~%"))))
+
+  (load "test.scm")
+  (let ((E (big-env))
+	(a (char->integer #\a)))
+    (do ((i 0 (+ i 1)))
+	((= i 2000))
+      (let ((sym (string->symbol
+		  (string (integer->char (+ a (modulo i 26)))
+			  (integer->char (+ a (modulo (floor (/ i 26)) 26)))
+			  (integer->char (+ a (modulo (floor (/ i (* 26 26))) 26)))))))
+	(let ((val (E sym)))
+	  (if (not (equal? val i))
+	      (format *stderr* ";env: ~A -> ~A, not ~D~%" sym val i))))))
+
+  (call-with-output-file "test.scm"
+    (lambda (p)
+      (format p "")))
+
+  (let ((val (call-with-input-file "test.scm"
+	       (lambda (p)
+		 (read p)))))
+    (if (not (eof-object? val))
+	(format *stderr* ";read empty file: ~A~%" val)))
+
+  (call-with-output-file "test.scm"
+    (lambda (p)
+      (format p " ;")
+      (do ((i 0 (+ i 1)))
+	  ((= i 3000))
+	(let ((c (integer->char (random 128))))
+	  (if (char<? c #\space)
+	      (display #\space p)
+	      (display c p))))
+      (format p "~%")))
+
+  (let ((val (call-with-input-file "test.scm"
+	       (lambda (p)
+		 (read p)))))
+    (if (not (eof-object? val))
+	(format *stderr* ";read comment file: ~A~%" val)))
+
+  (call-with-output-file "test.scm"
+    (lambda (p)
+      (format p "\"~3001TT\"~%")))
+
+  (let ((str (call-with-input-file "test.scm" read)))
+    (test (length str) 3000)))
+
+(if (defined? 'big-list)
+    (set! big-list #f))
+#|
+(let ((c #f)
+      (i 0)
+      (e #f))
+  (set! e (curlet))
+  (call-with-output-file "empty-file" (lambda (p) (write '(call/cc (lambda (c1) (set! c c1) (set! i (+ i 1)))) p)))
+  (load "empty-file" e)
+  (test (c) 'error)) ; ;read-error ("our input port got clobbered!")
+|#
+
+(let ()
+  (define (func)
+    (catch #t (lambda ()
+                (call-with-exit (lambda (goto) (goto (display (make-list 512 '(1)) (open-output-function Hk)))))) ; fx_c_aa GC trouble
+              (lambda args
+                'error)))
+  (define (f) (do ((i 0 (+ i 1))) ((= i 10)) (func))) ; GC -> free cell, either lst in pair_to_port, or port in display
+  (test (f) #t))
+
+(let ((stdin-wrapper (open-input-function
+		       (lambda (choice)
+			 (case choice
+			   ((read peek-char) #\?)
+			   ((char-ready?) #f)
+			   ((read-char) #\a)
+			   ((read-line) "a line"))))))
+  (test (port-filename stdin-wrapper) "")
+  (test (port-line-number stdin-wrapper) 0)
+  (let-temporarily (((current-input-port) stdin-wrapper))
+    (test (read-char) #\a)
+    ;(test (read-byte) 65)
+    (test (read-line) "a line")
+    (test (char-ready?) #f)
+    (test (read) #\?)
+    (test (peek-char) #\?)
+    (test (object->string (current-input-port)) "#<input-function-port>")
+    (test (object->string
+            (object->let (current-input-port)))
+          "(inlet 'function #<lambda (choice)> 'value #<input-function-port> 'type input-port? 'port-type function 'closed #f 'mutable? #t)")
+    (test (input-port? (current-input-port)) #t)
+    (test (reverse (current-input-port)) 'error)
+    (test (fill! (current-input-port)) 'error)
+    (test (length (current-input-port)) #f))
+  (test (port-closed? stdin-wrapper) #f)
+  (close-input-port stdin-wrapper)
+  (test (read-char stdin-wrapper) 'error)
+  (test (port-closed? stdin-wrapper) #t))
+
+(let ((str ()))
+  (let ((stdout-wrapper (open-output-function
+			 (lambda (c)
+			   (set! str (cons (integer->char c) str))))))
+    (write-string "a line" stdout-wrapper)
+    (test (list->string (reverse str)) "a line")
+    (close-output-port stdout-wrapper)))
+
+(let ((str ()))
+  (let ((stdout-wrapper (open-output-function
+			 (lambda (c)
+			   (values c (set! str (cons (integer->char c) str)))))))
+    (test (write-char #\a stdout-wrapper) 'error) ;"function-port should not return multiple-values"
+    (close-output-port stdout-wrapper)))
+
+(let ((str ())
+      (obj #f))
+  (let ((stdout-wrapper (open-output-function
+			 (lambda (c)
+			   (set! str (cons c str))))))
+    (let-temporarily (((current-output-port) stdout-wrapper))
+      (write-char #\a)
+      (display #\b)
+      (write-byte 123)
+      (write-string "a line")
+      (newline)
+      (test (object->string (current-output-port)) "#<output-function-port>")
+      (set! obj (object->let (current-output-port)))
+      (test (output-port? (current-output-port)) #t))
+    (test (reverse str) '(97 98 123 97 32 108 105 110 101 10))
+    (close-output-port stdout-wrapper)
+    (test (write "a test" stdout-wrapper) 'error)
+    (test (object->string obj)
+          "(inlet 'function #<lambda (c)> 'value #<output-function-port:closed> 'type output-port? 'port-type function 'closed #f 'mutable? #t)")))
+
+(test (read-char (open-input-function vector)) 'error)
+;; (write-char #\a (open-output-function list)) -> a?? but string: error: string argument 1, 97, is an integer but should be a character
+(test (peek-char (open-input-function cons)) 'error)
+(test (write-char #\a (open-output-function cons)) 'error)
+(test (open-input-function (vector)) 'error)
+(test (open-output-function (vector)) 'error)
+
+(unless pure-s7
+  (test ((lambda (w) 1) (char-ready? (open-input-function (lambda (x) (values 1 2 3 4 5 6 7))))) 'error))
+(test ((lambda (w) 1) (read-char (open-input-function (lambda (x) (values 1 2 3 4 5 6 7))))) 'error)
+(test ((lambda (w) 1) (read-line (open-input-function (lambda (x) (values 1 2 3 4 5 6 7))))) 'error)
+(test ((lambda (w) 1) (read (open-input-function (lambda (x) (values 1 2 3 4 5 6 7))))) 'error)
+
+(test (reverse *stdin*) 'error)
+(test (fill! (current-output-port)) 'error)
+(test (length *stderr*) #f)
+
+(test (output-port? (current-input-port)) #f)
+(test (output-port? *stdin*) #f)
+(test (output-port? (current-output-port)) #t)
+(test (output-port? *stdout*) #t)
+(test (output-port? (current-error-port)) #t)
+(test (output-port? *stderr*) #t)
+
+;(write-char #\space (current-output-port))
+;(write " " (current-output-port))
+(newline (current-output-port))
+(for-each
+ (lambda (p)
+   (test (write-char #\a p) 'error)
+   (test (write-byte 0 p) 'error)
+   (test (write-string "a" p) 'error)
+   (test (write "a" p) 'error)
+   (test (display "a" p) 'error)
+   (test (format p "~a" 2) 'error))
+ (list *stdin* (current-input-port)
+       (call-with-output-string (lambda (p) p))))
+
+(for-each
+ (lambda (p)
+   (test (read-char p) 'error)
+   (test (read-byte p) 'error)
+   (test (read-line p) 'error)
+   (test (read-string 5 p) 'error)
+   (test (read p) 'error))
+ (list *stdout* #f (current-output-port)
+       (call-with-input-file "s7test.scm" (lambda (p) p))
+       (call-with-input-string "0123456" (lambda (p) p))))
+
+(call-with-output-string
+  (lambda (p)
+    (test (read-char p) 'error)
+    (test (read-byte p) 'error)
+    (test (read-line p) 'error)
+    (test (read-string 5 p) 'error)
+    (test (read p) 'error)))
+
+(call-with-input-string "asdf"
+  (lambda (p)
+    (test (write-char #\a p) 'error)
+    (test (write-byte 0 p) 'error)
+    (test (write-string "a" p) 'error)
+    (test (write "a" p) 'error)
+    (test (display "a" p) 'error)
+    (test (format p "~a" 2) 'error)))
+
+(test (write #\1 *stdin*) 'error)
+(test (write-char #\1 *stdin*) 'error)
+(test (write-byte 1 *stdin*) 'error)
+(test (write-string "123" *stdin*) 'error)
+(test (display #\1 *stdin*) 'error)
+
+(for-each
+ (lambda (p)
+   (test (write-char #\a p) 'error)
+   (test (write-byte 0 p) 'error)
+   (test (write-string "a" p) 'error)
+   (test (write "a" p) 'error)
+   (test (display "a" p) 'error)
+   (test (format p "~a" 2) 'error)
+   (test (read-char p) 'error)
+   (test (read-byte p) 'error)
+   (test (read-line p) 'error)
+   (test (read-string p) 'error)
+   (test (read p) 'error))
+ (list (let ((p (open-output-string))) (close-output-port p) p)
+       (let ((p (open-input-string "123"))) (close-input-port p) p)))
+
+(for-each
+ (lambda (arg)
+   (if (output-port? arg)
+       (format #t ";(output-port? ~A) -> #t?~%" arg)))
+ (list "hi" #f () 'hi (integer->char 65) 1 (list 1 2) _ht_ _undef_ _null_ _c_obj_ '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f))
+
+(for-each
+ (lambda (arg)
+   (test (read-line () arg) 'error)
+   (test (read-line arg) 'error))
+ (list "hi" (integer->char 65) 1 #f _ht_ _undef_ _null_ _c_obj_ (list) (cons 1 2) (list 1 2) (make-vector 3) 3.14 3/4 1.0+1.0i #\f))
+
+(test (call-with-output-file tmp-output-file output-port?) #t)
+(if (not (eq? start-output-port (current-output-port)))
+    (format #t "call-with-output-file did not restore current-output-port? ~A from ~A~%" start-output-port (current-output-port)))
+
+(test (let ((this-file (open-output-file tmp-output-file))) (let ((res (output-port? this-file))) (close-output-port this-file) res)) #t)
+(if (not (eq? start-output-port (current-output-port)))
+    (format #t "open-output-file clobbered current-output-port? ~A from ~A~%" start-output-port (current-output-port)))
+
+(let () ; write_string_p_pp
+  (define (string-join2 lst delimiter)
+    (call-with-output-string
+     (lambda (out)
+       (for-each (lambda (item)
+                   (write-string delimiter out)
+                   (write-string item out))
+		 lst)
+       (get-output-string out))))
+  (test (string-join2 '("foo" "bar") ":") ":foo:bar"))
+
+(test (let ((val #f)) (call-with-output-string (lambda (p) (set! val (output-port? p)))) val) #t)
+(test (let ((res #f)) (let ((this-file (open-output-string))) (set! res (output-port? this-file)) (close-output-port this-file) res)) #t)
+
+(test (with-output-to-string (lambda () (display _undef_))) "#_asdf")
+(test (with-output-to-string (lambda () (write _undef_))) "#_asdf")
+(test (with-output-to-string (lambda () (make-string (+ (*s7* 'max-string-length) 10)))) 'error)
+
+(test (open-input-file "tools") 'error)
+(when (file-exists? "/home/bil/cl/tools/dup.scm") ; check "~" handling in file name, shouldn't file-exists? accept these names?
+  (let ((p (open-input-file "~/cl/tools/dup.scm")))
+    (test (read-line p) ";;; dup.scm")
+    (close-input-port p)))
+
+(let ()
+  (call-with-output-file "tmp.r5rs"
+    (lambda (p)
+      (format p "(values 2 3 4)")))
+  (test (+ 1 (load "tmp.r5rs") 5) 15))
+
+(for-each
+ (lambda (arg)
+   (if (eof-object? arg)
+       (format #t ";(eof-object? ~A) -> #t?~%" arg)))
+ (list "hi" () '(1 2) -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #f #t (if #f #f) #<undefined> (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+   (let ((val (catch #t
+		     (lambda () (port-closed? arg))
+		     (lambda args 'error))))
+     (if (not (eq? val 'error))
+	 (format #t ";(port-closed? ~A) -> ~S?~%" arg val))))
+ (list "hi" '(1 2) -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #f #t (if #f #f) #<undefined> #<eof> (lambda (a) (+ a 1))))
+
+(test (port-closed?) 'error)
+(test (port-closed? (current-input-port) (current-output-port)) 'error)
+(test (let-temporarily (((current-output-port) #f)) (port-closed? (current-output-port))) #f)
+
+
+;;; port-string
+(test (port-string) 'error)
+(let ((P (open-input-string "asdf")))
+  (test (port-string P) "asdf")
+  (test (port-string P #f) 'error)
+  (close-input-port P))
+(for-each
+ (lambda (arg)
+   (test (port-string arg) 'error))
+ (list "hi" () '(1 2) -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #f #t (if #f #f) #<undefined> (lambda (a) (+ a 1))))
+(test (call-with-input-string "0123456789" (lambda (p) (port-string p))) "0123456789")
+
+(let ((P (open-input-string "asdf")))
+  (test (port-string P) "asdf")
+  (set! (port-string P) "123")
+  (test (port-string P) "123")
+  (test (read-char P) #\1)
+  (test (read-char P) #\2)
+  (test (read-char P) #\3)
+  (test (read-char P) #<eof>)
+  (set! (port-string P) "0123456789")
+  (test (port-string P) "0123456789")
+  (test (read-char P) #\0)
+  (close-input-port P))
+
+(let ((P (open-output-string)))
+  (test (port-string P) "")
+  (display "asdf" P)
+  (test (port-string P) "asdf")
+  (set! (port-string P) "12345")
+  (test (get-output-string P) "12345")
+  (set! (port-string P) (make-string 512 #\a))
+  (test (string=? (get-output-string P) (make-string 512 #\a)) #t)  ; force reallocate?
+  (close-output-port P))
+
+(let ((ssize 3))
+  (define (call-wis1)
+    (let ((p (open-input-string "asdf")))
+      (do ((i 0 (+ i 1))) ((= i ssize))
+	(set! (port-string p) "asdf")
+	(unless (char=? (read-char p) #\a)  (format *stderr* "read-char trouble 1\n"))
+	(set! p 123))
+      (close-input-port p)))
+  (test (call-wis1) 'error) ; set! port-string first argument, 123, is an integer but should be an input or output port
+
+  (define (call-wis2)
+    (let ((p (open-input-string "asdf")))
+      (do ((i 0 (+ i 1))) ((= i ssize))
+	(set! (port-string p) "asdf")
+	(unless (char=? (read-char p) #\a)  (format *stderr* "read-char trouble 4\n"))
+	(set! p (open-output-string)))
+      (close-output-port p)))
+  (test (call-wis2) 'error) ; read-char argument, #<output-string-port>, is an output port but should be an input port
+
+  (define (call-wis21) ; this is dangerous! if error check is omitted in set_port_string, the file will be clobbered
+    (let ((p (open-input-string "asdf")))
+      (do ((i 0 (+ i 1))) ((= i ssize))
+	(set! (port-string p) "asdf")
+	(unless (char=? (read-char p) #\a)  (format *stderr* "read-char trouble 4\n"))
+	(set! p (open-output-file tmp-output-file)))
+      (close-output-port p)))
+  (test (call-wis21) 'error)
+
+  (define (call-wis3)
+    (let ((p (open-input-string "asdf")))
+      (do ((i 0 (+ i 1))) ((= i ssize))
+	(set! (port-string p) "asdf")
+	(unless (char=? (read-char p) #\a)  (format *stderr* "read-char trouble 7\n"))
+	(close-input-port p))))
+  (test (call-wis3) 'error) ; set! port-string first argument, #<input-string-port :closed>, is an input port but should be an open port
+
+  (define (call-wis4)
+    (let ((str "asdf"))
+      (let ((p (open-input-string str)))
+	(do ((i 0 (+ i 1))) ((= i ssize) str)
+	  (set! (port-string p) "asdf")
+	  (unless (char=? (read-char p) #\a)  (format *stderr* "read-char trouble 13\n")))
+	(close-input-port p))))
+  (test (call-wis4) #<unspecified>) ; from close-input-port
+
+  (define (call-wis5)
+    (let ((str "asdf"))
+      (let ((p (open-input-string str)))
+	(do ((i 0 (+ i 1))) ((= i ssize))
+	  (set! (port-string p) str)
+	  (unless (char=? (read-char p) #\a)  (format *stderr* "read-char trouble 16\n"))
+	  (set! str 123))
+	(close-input-port p))))
+  (test (call-wis5) 'error) ; set! port-string second argument, 123, is an integer but should be a string
+
+  (define (call-wis7)
+    (let ((str "asdf"))
+      (let ((p (open-input-string str)))
+	(do ((i 0 (+ i 1))) ((= i ssize))
+	  (set! (port-string p) str)
+	  (unless (char=? (read-char p) #\a)  (format *stderr* "read-char trouble 19\n"))
+	  (set! p (open-input-function (lambda (choice) #\a))))
+	(close-input-port p))))
+  (test (call-wis6) 'error) ; set! port-string first argument, #<input-function-port>, is an input port but should be a string port
+  )
+
+;;; port-position
+(test (port-position) 'error)
+(test (port-position (current-output-port)) 'error)
+(test (port-position (current-error-port)) 'error)
+(test (integer? (port-position (current-input-port))) #t)
+(test (port-position (current-input-port) #f) 'error)
+(test (call-with-output-file "asdf" (lambda (p) (port-position p))) 'error)
+(test (call-with-output-string (lambda (p) (port-position p))) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (port-position arg) 'error))
+ (list "hi" () '(1 2) -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #f #t (if #f #f) #<undefined> (lambda (a) (+ a 1))))
+
+(test (call-with-input-string "0123456789" (lambda (p) (set! (port-position p) 3) (list (read-char p) (port-position p)))) '(#\3 4))
+(test (call-with-input-file "s7test.scm" (lambda (p) (set! (port-position p) 88) (list (read-string 10 p) (port-position p)))) '(";;   Paul " 98))
+(test (call-with-input-string "0123456789" (lambda (p) (set! (port-position p) -3))) 'error)
+(test (port-position (call-with-input-file (string #\c #\null #\b) quasiquote)) 'error) ; closed port
+(test (call-with-input-string "" (lambda (p) (set! (port-position p) 2) (port-position p))) 0)
+(test (call-with-input-string "123" (lambda (p) (set! (port-position p) 12) (port-position p))) 3)
+
+(let ()
+  (define (pos1)
+    (let* ((in (open-input-string "#xff"))
+           (val (read in))
+	   (pos (port-position in)))
+      (close-input-port in)
+      pos))
+  (test (pos1) 4)
+
+  (define (pos2)
+    (let* ((in (open-input-string "#xff "))
+           (val (read in))
+	   (pos (port-position in)))
+      (close-input-port in)
+      pos))
+  (test (pos2) 4)
+
+  (define (pos3)
+    (let* ((in (open-input-string "(+ 1 xyz)"))
+           (val (read in))
+	   (pos (port-position in)))
+      (close-input-port in)
+      pos))
+  (test (pos3) 9)
+
+  (define (pos4)
+    (let* ((in (open-input-string "(+ 1 xyz) ; a comment"))
+           (val (read in))
+	   (pos (port-position in)))
+      (close-input-port in)
+      pos))
+  (test (pos4) 9)
+
+  (define (pos5)
+    (let* ((in (open-input-string " xyz"))
+           (val (read in))
+	   (pos (port-position in)))
+      (close-input-port in)
+      pos))
+  (test (pos5) 4)
+
+  (define (pos6)
+    (let* ((in (open-input-string " xyz "))
+           (val (read in))
+	   (pos (port-position in)))
+      (close-input-port in)
+      pos))
+  (test (pos6) 4)
+
+  (define (pos7)
+    (let* ((in (open-input-string (format #f "1234~%5678")))
+           (val1 (read-line in))
+	   (pos1 (port-position in))
+           (val2 (read-line in))
+	   (pos2 (port-position in)))
+      (close-input-port in)
+      (list pos1 pos2)))
+  (test (pos7) '(5 9))
+
+  (define (pos8)
+    (let* ((in (open-input-string "12345678"))
+           (val1 (read-string 4 in))
+	   (pos1 (port-position in))
+           (val11 (read-string 0 in))
+	   (pos11 (port-position in))
+           (val2 (read-string 5 in))
+	   (pos2 (port-position in))
+           (val3 (read-string 1 in))
+	   (pos3 (port-position in)))
+      (close-input-port in)
+      (list pos1 pos11 pos2 pos3)))
+  (test (pos8) '(4 4 8 8))
+
+  (define (pos9)
+    (let* ((in (open-input-string "123456789"))
+	   (vals ()))
+      (do ((i 0 (+ i 3))
+	   (k 1 (+ k 2)))
+	  ((>= i 9))
+	(set! vals (cons (read-string 3 in) vals))
+	(set! (port-position in) k)
+	(test (port-position in) k))
+      (close-input-port in)
+      (reverse vals)))
+  (test (pos9) '("123" "234" "456"))
+
+  (define (pos10)
+    (let ((f (open-output-file "hi")))
+      (display "1234567879" f)
+      (flush-output-port f)
+      (close-output-port f)
+      (let* ((in (open-input-file "hi"))
+             (vals ()))
+        (do ((i 0 (+ i 3))
+	     (k 1 (+ k 2)))
+	    ((>= i 9))
+	  (set! vals (cons (read-string 3 in) vals))
+	  (set! (port-position in) k)
+	  (test (port-position in) k))
+        (close-input-port in)
+        (reverse vals))))
+  (test (pos10) '("123" "234" "456")))
+
+(test (call-with-input-file "s7test.scm" (lambda (p) (c-pointer? (port-file p)))) #t)
+
+(call-with-output-file tmp-output-file (lambda (p) (display "3.14" p)))
+(test (call-with-input-file tmp-output-file (lambda (p) (read p) (let ((val (read p))) (eof-object? val)))) #t)
+
+(test (call-with-input-file tmp-output-file (lambda (p) (read-char p))) #\3)
+(test (call-with-input-file tmp-output-file (lambda (p) (peek-char p))) #\3)
+(test (call-with-input-file tmp-output-file (lambda (p) (peek-char p) (read-char p))) #\3)
+(test (call-with-input-file tmp-output-file (lambda (p) (list->string (list (read-char p) (read-char p) (read-char p) (read-char p))))) "3.14")
+(test (call-with-input-file tmp-output-file (lambda (p) (list->string (list (read-char p) (peek-char p) (read-char p) (read-char p) (peek-char p) (read-char p))))) "3..144")
+
+(for-each
+ (lambda (arg)
+   (call-with-output-file tmp-output-file (lambda (p) (write arg p)))
+   (if (not (equivalent? (call-with-input-file tmp-output-file (lambda (p) (read p))) arg))
+       (format *stderr* "~A different after write~%" arg)))
+ (list "hi" -1 #\a 1 'a-symbol (make-vector 3 0) 3.14 3/4 .6 1.0+1.0i #f #t (list 1 2 3) (cons 1 2)
+       '(1 2 . 3) () '((1 2) (3 . 4)) '(()) (list (list 'a "hi") #\b 3/4) ''a
+       (string #\a #\null #\b) "" "\"hi\""
+       (integer->char 128) (integer->char 127) (integer->char 255) #\space #\null #\newline #\tab
+       #() #2d((1 2) (3 4)) #3d()
+       :hi #<eof> #<undefined> #<unspecified>
+       most-negative-fixnum
+       (if with-bignums 1239223372036854775808 123)
+       (if with-bignums 144580536300674537151081081515762353325831/229154728370723013560448485454219755525522 11/10)
+       (if with-bignums 221529797579218180403518826416685087012.0 1000.1)
+       (if with-bignums 1239223372036854775808+1239223372036854775808i 1000.1-1234i)))
+
+(for-each
+ (lambda (arg)
+   (call-with-output-file tmp-output-file (lambda (p) (write arg p)))
+   (test (call-with-input-file tmp-output-file (lambda (p) (eval (read p)))) arg)) ; so read -> symbol?
+ (list *stdout* *stdin* *stderr*
+       abs + quasiquote
+
+;       (hash-table 'a 1 'b 2) (hash-table)
+;       0/0 (real-part (log 0))
+;;; for these we need nan? and infinite? since equal? might be #f
+;       (lambda (a) (+ a 1))
+; pws?
+;       (current-output-port)
+;       (random-state 1234)
+;       (symbol ":\"")
+; (let () (define-macro (hi1 a) `(+ ,a 1)) hi1)
+;;; and how could a continuation work in general?
+       ))
+
+;;; (call-with-input-file tmp-output-file (lambda (p) (read p))) got (symbol ":\"") but expected (symbol ":\"")
+
+
+;;; r4rstest
+(let* ((write-test-obj '(#t #f a () 9739 -3 . #((test) "te \" \" st" "" test #() b c)))
+       (load-test-obj (list 'define 'foo (list '#_quote write-test-obj))))
+
+  (define (check-test-file name)
+    (let ((val (call-with-input-file
+		   name
+		 (lambda (test-file)
+		   (test (read test-file) load-test-obj)
+		   (test (eof-object? (peek-char test-file)) #t)
+		   (test (eof-object? (read-char test-file)) #t)
+		   (input-port? test-file)))))
+      (if (not (eq? val #t))
+	  (format #t "input-port? in call-with-input-file? returned ~A from ~A~%" val name))))
+
+  (test (call-with-output-file
+	    tmp-output-file
+	  (lambda (test-file)
+	    (write-char #\; test-file)
+	    (display #\; test-file)
+	    (display ";" test-file)
+	    (write write-test-obj test-file)
+	    (newline test-file)
+	    (write load-test-obj test-file)
+	    (output-port? test-file))) #t)
+  (check-test-file tmp-output-file)
+
+  (let ((test-file (open-output-file "tmp2.r5rs")))
+    (test (port-closed? test-file) #f)
+    (write-char #\; test-file)
+    (display #\; test-file)
+    (display ";" test-file)
+    (write write-test-obj test-file)
+    (newline test-file)
+    (write load-test-obj test-file)
+    (test (output-port? test-file) #t)
+    (close-output-port test-file)
+    (check-test-file "tmp2.r5rs")))
+
+(test (with-input-from-string "" read) #<eof>) ; ?
+
+(call-with-output-file tmp-output-file (lambda (p) (display "3.14" p)))
+(test (with-input-from-file tmp-output-file read) 3.14)
+(if (not (eq? start-input-port (current-input-port)))
+    (format #t "with-input-from-file did not restore current-input-port? ~A from ~A~%" start-input-port (current-input-port)))
+
+(test (with-input-from-file tmp-output-file (lambda () (eq? (current-input-port) start-input-port))) #f)
+(test (char->integer ((with-input-from-string (string (integer->char 255))(lambda () (read-string 1))) 0)) 255)
+
+(test (with-output-to-file tmp-output-file (lambda () (eq? (current-output-port) start-output-port))) #f)
+(if (not (eq? start-output-port (current-output-port)))
+    (format #t "with-output-to-file did not restore current-output-port? ~A from ~A~%" start-output-port (current-output-port)))
+
+
+(let ((newly-found-sonnet-probably-by-shakespeare
+       "This is the story, a sad tale but true \
+        Of a programmer who had far too little to do.\
+        One day as he sat in his hut swilling stew, \
+        He cried \"CLM takes forever, it's stuck in a slough!,\
+        Its C code is slow, too slow by a few.\
+        Why, with just a small effort, say one line or two,\
+        It could outpace a no-op, you could scarcely say 'boo'\"!\
+        So he sat in his kitchen and worked like a dog.\
+        He typed and he typed 'til his mind was a fog. \
+        Now 6000 lines later, what wonders we see!  \
+        CLM is much faster, and faster still it will be!\
+        In fact, for most cases, C beats the DSP!  \
+        But bummed is our coder; he grumbles at night.  \
+        That DSP code took him a year to write.  \
+        He was paid many dollars, and spent them with glee,\
+        But his employer might mutter, this result were he to see."))
+
+  (call-with-output-file tmp-output-file
+    (lambda (p)
+      (write newly-found-sonnet-probably-by-shakespeare p)))
+
+  (let ((sonnet (with-input-from-file tmp-output-file
+		  (lambda ()
+		    (read)))))
+    (if (or (not (string? sonnet))
+	    (not (string=? sonnet newly-found-sonnet-probably-by-shakespeare)))
+	(format #t "write/read long string returned: ~A~%" sonnet)))
+
+  (let ((file (open-output-file tmp-output-file)))
+    (let ((len (string-length newly-found-sonnet-probably-by-shakespeare)))
+      (write-char #\" file)
+      (do ((i 0 (+ i 1)))
+	  ((= i len))
+	(let ((chr (string-ref newly-found-sonnet-probably-by-shakespeare i)))
+	  (if (char=? chr #\")
+	      (write-char #\\ file))
+	  (write-char chr file)))
+      (write-char #\" file)
+      (close-output-port file)))
+
+  (let ((file (open-input-file tmp-output-file)))
+    (let ((sonnet (read file)))
+      (close-input-port file)
+      (if (or (not (string? sonnet))
+	      (not (string=? sonnet newly-found-sonnet-probably-by-shakespeare)))
+	  (format #t "write-char/read long string returned: ~A~%" sonnet)))))
+
+(test (let () (define (func) (vector (call-with-output-file "/dev/null" quasiquote))) (define (hi) (func)) (vector? (hi))) #t)
+
+(let ((file (open-output-file tmp-output-file)))
+  (for-each
+   (lambda (arg)
+     (write arg file)
+     (write-char #\space file))
+   (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2)))
+  (close-output-port file))
+
+(let ((file (open-input-file tmp-output-file)))
+  (for-each
+   (lambda (arg)
+     (let ((val (read file)))
+       (if (not (equal? val arg))
+	   (format #t "read/write ~A returned ~A~%" arg val))))
+   (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2)))
+  (close-input-port file))
+
+(with-output-to-file tmp-output-file
+  (lambda ()
+    (write lists)))
+
+(let ((val (with-input-from-file tmp-output-file
+	     (lambda ()
+	       (read)))))
+  (if (not (equal? val lists))
+      (format #t "read/write lists returned ~A~%" val)))
+
+(if (not (string=? "" (with-output-to-string (lambda () (display "")))))
+    (format #t "with-output-to-string null string?"))
+
+(let ((str (with-output-to-string
+	     (lambda ()
+	       (with-input-from-string "hiho123"
+		 (lambda ()
+		   (do ((c (read-char) (read-char)))
+		       ((eof-object? c))
+		     (display c))))))))
+  (if (not (string=? str "hiho123"))
+      (format #t "with string ports 0: ~S?~%" str)))
+
+(let ((str1 (let ((x #f)) (with-output-to-string (lambda () (display `(+ x 1)) (display (object->string '(1 2 3) #f 1)))))))
+  (let ((str2 (let ((x #f)) (with-output-to-string (lambda () (display `(+ x 1)) (display (object->string '(1 2 3) #f 1)))))))
+    (test str1 str2))) ; both "(+ x 1)..."
+
+(let ((p1 (open-input-string "123"))
+      (p2 (open-input-string "123")))
+  (test (equivalent? p1 p2) #t)
+  (read-char p1)
+  (test (equivalent? p1 p2) #f)
+  (read-char p2)
+  (test (equivalent? p1 p2) #t)
+  (close-input-port p1)
+  (close-input-port p2))
+
+(let ((p1 (open-input-string "1234"))
+      (p2 (open-input-string "123")))
+  (test (equivalent? p1 p2) #f)
+  (read-char p1)
+  (test (equivalent? p1 p2) #f)
+  (close-input-port p1)
+  (close-input-port p2))
+
+(let ((p1 (open-output-string))
+      (p2 (open-output-string)))
+  (test (equivalent? p1 p2) #t)
+  (write-char #\a p1)
+  (test (equivalent? p1 p2) #f)
+  (close-output-port p1)
+  (close-output-port p2))
+
+(let ()
+  (define* (f1 (b 123)) (display b))
+  (test (with-output-to-string f1) "123")
+  (define (f2) (display "123"))
+  (test (with-output-to-string f2) "123")
+  (define (f3 . args) (display 123))
+  (test (with-output-to-string f3) "123")
+  (define-macro (m1) `(write 123))
+  (test (with-output-to-string m1) "123")
+  (define-macro (m2) (write 123))
+  (test (with-output-to-string m2) "123")
+  (define (f4 a b) (display 123))
+  (test (with-output-to-string f4) 'error)
+  (test (with-output-to-string (lambda () (*s7* 'version))) "")) ; the output is a string -- not written to stdout or whatever
+
+(let ()
+  (define* (f1 a (b 123)) (display b a))
+  (test (call-with-output-string f1) "123")
+  (define (f2 a) (display "123" a))
+  (test (call-with-output-string f2) "123")
+  (define (f3 . args) (display 123 (car args)))
+  (test (call-with-output-string f3) "123")
+  (define-macro (m1 p) `(write 123 ,p))
+  (test (call-with-output-string m1) "123")
+  (define-macro* (m2 (p #f)) (write 123 p))
+  (test (call-with-output-string m2) "123")
+  (define (f4 a b) (display 123 a))
+  (test (call-with-output-string f4) 'error)
+  (test (call-with-output-string (lambda () (*s7* 'version))) 'error))
+
+(let ()
+  (define* (f1 (a #f)) (read))
+  (test (with-input-from-string "(+ 1 2 3)" f1) '(+ 1 2 3))
+  (define* (f2 . args) (read))
+  (test (with-input-from-string "(+ 1 2 3)" f2) '(+ 1 2 3))
+  (define f3 read)
+  (test (with-input-from-string "(+ 1 2 3)" f3) '(+ 1 2 3))
+  (define (f4) (read))
+  (test (with-input-from-string "(+ 1 2 3)" f4) '(+ 1 2 3))
+  (define-macro (m1) `(read))
+  (test (with-input-from-string "(+ 1 2 3)" m1) '(+ 1 2 3))
+  (define-macro (m2) (read))
+  (test (with-input-from-string "(+ 1 2 3)" m2) 6)
+  (define (f5 a) (read a))
+  (test (with-input-from-string "(+ 1 2 3)" f5) 'error)
+  (test (with-input-from-string "(+ 1 2 3)" (lambda () (*s7* 'version))) (*s7* 'version)))
+
+(let ()
+  (define* (f1 (a #f)) (read a))
+  (test (call-with-input-string "(+ 1 2 3)" f1) '(+ 1 2 3))
+  (define* (f2 . args) (read (car args)))
+  (test (call-with-input-string "(+ 1 2 3)" f2) '(+ 1 2 3))
+  (define f3 read)
+  (test (call-with-input-string "(+ 1 2 3)" f3) '(+ 1 2 3))
+  (define-macro (m1 p) `(read ,p))
+  (test (call-with-input-string "(+ 1 2 3)" m1) '(+ 1 2 3))
+  (define-macro* (m2 (p #f)) (read p))
+  (test (call-with-input-string "(+ 1 2 3)" m2) 6)
+  (define (f4) (read))
+  (test (call-with-input-string "(+ 1 2 3)" f4) 'error)
+  (test (call-with-input-string "(+ 1 2 3)" (lambda () (*s7* 'version))) 'error))
+
+
+(let ()
+  (with-output-to-file tmp-output-file
+    (lambda ()
+      (display "(+ 1 2 3)")))
+  (define* (f1 (a #f)) (read))
+  (test (with-input-from-file tmp-output-file f1) '(+ 1 2 3))
+  (define* (f2 . args) (read))
+  (test (with-input-from-file tmp-output-file f2) '(+ 1 2 3))
+  (define f3 read)
+  (test (with-input-from-file tmp-output-file f3) '(+ 1 2 3))
+  (define (f4) (read))
+  (test (with-input-from-file tmp-output-file f4) '(+ 1 2 3))
+  (define-macro (m1) `(read))
+  (test (with-input-from-file tmp-output-file m1) '(+ 1 2 3))
+  (define-macro (m2) (read))
+  (test (with-input-from-file tmp-output-file m2) 6)
+  (define (f5 a) (read a))
+  (test (with-input-from-file tmp-output-file f5) 'error)
+  (test (with-input-from-file tmp-output-file (lambda () (*s7* 'version))) (*s7* 'version)))
+
+(let ()
+  (define (eval-from-string-1 str)
+    (define-macro (m) (read))
+    (with-input-from-string str m))
+  (test (eval-from-string-1 "(+ 1 2 3)") 6)
+  (define (eval-from-string str)
+    (with-input-from-string str (define-macro (m) (read))))
+  (test (eval-from-string "(+ 1 2 3)") 6))
+
+(let ()
+  (define* (f1 (a #f)) (read a))
+  (test (call-with-input-file tmp-output-file f1) '(+ 1 2 3))
+  (define* (f2 . args) (read (car args)))
+  (test (call-with-input-file tmp-output-file f2) '(+ 1 2 3))
+  (define f3 read)
+  (test (call-with-input-file tmp-output-file f3) '(+ 1 2 3))
+  (define-macro (m1 p) `(read ,p))
+  (test (call-with-input-file tmp-output-file m1) '(+ 1 2 3))
+  (define-macro* (m2 (p #f)) (read p))
+  (test (call-with-input-file tmp-output-file m2) 6)
+  (define (f4) (read))
+  (test (call-with-input-file tmp-output-file f4) 'error)
+  (test (call-with-input-file tmp-output-file (lambda () (*s7* 'version))) 'error))
+
+(let ((ofile tmp-output-file))
+  (define (get-file-contents)
+    (with-input-from-file ofile read-line))
+
+  (define* (f1 (b 123)) (display b))
+  (test (let () (with-output-to-file ofile f1) (get-file-contents)) "123")
+  (define (f2) (display "123"))
+  (test (let () (with-output-to-file ofile f2) (get-file-contents)) "123")
+  (define (f3 . args) (display 123))
+  (test (let () (with-output-to-file ofile f3) (get-file-contents)) "123")
+  (define-macro (m1) `(write 123))
+  (test (let () (with-output-to-file ofile m1) (get-file-contents)) "123")
+  (define-macro (m2) (write 123))
+  (test (let () (with-output-to-file ofile m2) (get-file-contents)) "123")
+  (define (f4 a b) (display 123))
+  (test (let () (with-output-to-file ofile f4) (get-file-contents)) 'error)
+  (test (let () (with-output-to-file ofile (lambda () (*s7* 'version))) (get-file-contents)) #<eof>)
+
+  (define* (f11 a (b 123)) (display b a))
+  (test (let () (call-with-output-file ofile f11) (get-file-contents)) "123")
+  (define (f21 a) (display "123" a))
+  (test (let () (call-with-output-file ofile f21) (get-file-contents)) "123")
+  (define (f31 . args) (display 123 (car args)))
+  (test (let () (call-with-output-file ofile f31) (get-file-contents)) "123")
+  (define-macro (m3 p) `(write 123 ,p))
+  (test (let () (call-with-output-file ofile m3) (get-file-contents)) "123")
+  (define-bacro* (m2 (p 123)) `(write 123 ,p))
+  (test (let () (call-with-output-file ofile m2) (get-file-contents)) "123")
+  (define (f41 a b) (display 123 a))
+  (test (let () (call-with-output-file ofile f41) (get-file-contents)) 'error)
+  (test (let () (call-with-output-file ofile (lambda () (*s7* 'version))) (get-file-contents)) 'error))
+
+(if (not (eof-object? (with-input-from-string "" (lambda () (read-char)))))
+    (format #t ";input from null string not #<eof>?~%")
+    (let ((EOF (with-input-from-string "" (lambda () (read-char)))))
+      (if (not (eq? (with-input-from-string "" (lambda () (read-char)))
+		    (with-input-from-string "" (lambda () (read-char)))))
+	  (format #t "#<eof> is not eq? to itself?~%"))
+      (if (char? EOF)
+	  (do ((c 0 (+ c 1)))
+	      ((= c 256))
+	    (if (char=? EOF (integer->char c))
+		(format #t "#<eof> is char=? to ~C~%" (integer->char c)))))))
+
+(test (+ 100 (call-with-output-file "tmp.r5rs" (lambda (p) (write "1" p) (values 1 2)))) 103)
+(test (+ 100 (with-output-to-file "tmp.r5rs" (lambda () (write "2") (values 1 2)))) 103)
+
+(if (not pure-s7)
+    (let ((str (with-output-to-string
+		 (lambda ()
+		   (with-input-from-string "hiho123"
+		     (lambda ()
+		       (do ((c (read-char) (read-char)))
+			   ((or (not (char-ready?))
+				(eof-object? c)))
+			 (display c))))))))
+      (if (not (string=? str "hiho123"))
+	  (format #t "with string ports 1: ~S?~%" str))))
+
+(let ((str (with-output-to-string
+	     (lambda ()
+	       (with-input-from-string ""
+		 (lambda ()
+		   (do ((c (read-char) (read-char)))
+		       ((eof-object? c))
+		     (display c))))))))
+  (if (not (string=? str ""))
+      (format #t "with string ports and null string: ~S?~%" str)))
+
+(let ((str (with-output-to-string ; this is from the guile-user mailing list, I think -- don't know who wrote it
+	     (lambda ()
+	       (with-input-from-string "A2B5E3426FG0ZYW3210PQ89R."
+		 (lambda ()
+		   (call/cc
+		    (lambda (hlt)
+		      (define (nextchar)
+			(let ((c (read-char)))
+			  (if (eq? c #\space)
+			      (nextchar)
+			      c)))
+
+		      (define inx
+			(lambda()
+			  (let in1 ()
+			    (let ((c (nextchar)))
+			      (if (char-numeric? c)
+				  (let ((r (nextchar)))
+				    (let out*n ((n (- (char->integer c) (char->integer #\0))))
+				      (out r)
+				      (if (not (zero? n))
+					  (out*n (- n 1)))))
+				  (out c))
+			      (in1)))))
+
+		      (define (move-char c)
+			(write-char c)
+			(if (char=? c #\.)
+			    (begin (hlt))))
+
+		      (define outx
+			(lambda()
+			  (let out1 ()
+			    (let h1 ((n 16))
+			      (move-char (in))
+			      (move-char (in))
+			      (move-char (in))
+			      (if (= n 1)
+				  (begin (out1))
+				  (begin (write-char #\space) (h1 (- n 1))) )))))
+
+		      (define (in)
+			(call/cc (lambda(return)
+				   (set! outx return)
+				   (inx))))
+
+		      (define (out c)
+			(call/cc (lambda(return)
+				   (set! inx return)
+				   (outx c))))
+		      (outx)))))))))
+  (if (not (string=? str "ABB BEE EEE E44 446 66F GZY W22 220 0PQ 999 999 999 R."))
+      (format #t "call/cc with-input-from-string str: ~A~%" str)))
+
+(let ((badfile tmp-output-file))
+  (let ((p (open-output-file badfile)))
+    (close-output-port p))
+  (load badfile))
+
+(test (let ((str1 (let ((port #f))
+		    (dynamic-wind
+			(lambda ()
+			  (set! port (open-input-string (format #f "~S" (call-with-input-string "" and)))))
+			(lambda ()
+			  (read port))
+			(lambda ()
+			  (close-input-port port)))))
+	    (str2 (with-input-from-string
+		      (object->string (call-with-input-string "" and))
+		    read)))
+	(equivalent? str1 str2))
+      #t)
+
+(for-each
+ (lambda (str)
+   ;;(test (eval-string str) 'error)
+   ;; eval-string is confused somehow
+   (test (with-input-from-string str read) 'error))
+ (list "\"\\x" "\"\\x0" "`(+ ," "`(+ ,@" "#2d("))
+
+(let ((loadit tmp-output-file))
+  (let ((p1 (open-output-file loadit)))
+    (display "(define s7test-var 314) (define (s7test-func) 314) (define-macro (s7test-mac a) `(+ ,a 2))" p1)
+    (newline p1)
+    (close-output-port p1)
+    (load loadit)
+    (test (= s7test-var 314) #t)
+    (test (s7test-func) 314)
+    (test (s7test-mac 1) 3)
+    (let ((p2 (open-output-file loadit))) ; hopefully this starts a new file
+      (display "(define s7test-var 3) (define (s7test-func) 3) (define-macro (s7test-mac a) `(+ ,a 1))" p2)
+      (newline p2)
+      (close-output-port p2)
+      (load loadit)
+      (test (= s7test-var 3) #t)
+      (test (s7test-func) 3)
+      (test (s7test-mac 1) 2)
+      (test (equivalent? p1 p2) #t)))) ; undefined constants
+
+(test (+ 100 (with-input-from-string "123" (lambda () (values (read) 1)))) 224)
+
+(for-each
+ (lambda (op)
+   (for-each
+    (lambda (arg) ;(format #t ";(~A ~A)~%" op arg)
+      (test (op arg) 'error))
+    (list (integer->char 65) 1 0 -1 (list 1) (cons 1 2) 'a-symbol (make-vector 3) abs lambda with-let
+	  _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+	  3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
+ (list char-ready? set-current-output-port set-current-input-port set-current-error-port
+       close-input-port close-output-port open-input-file open-output-file
+       read-char peek-char read
+       (lambda (arg) (write-char #\a arg))
+       (lambda (arg) (write "hi" arg))
+       (lambda (arg) (display "hi" arg))
+       call-with-input-file with-input-from-file call-with-output-file with-output-to-file))
+
+(unless pure-s7 (test (char-ready? (open-input-string "")) #t)) ; humph
+(with-output-to-file tmp-output-file
+  (lambda ()
+    (display "this is a test")
+    (newline)))
+
+(test (call-with-input-file tmp-output-file (lambda (p) (integer->char (read-byte p)))) #\t)
+(test (with-input-from-string "123" (lambda () (read-byte))) 49)
+(test (nan? (with-input-from-string "1/0" read)) #t)
+
+(let ((bytes (vector #o000 #o000 #o000 #o034 #o000 #o001 #o215 #o030 #o000 #o000 #o000 #o022 #o000
+		     #o000 #o126 #o042 #o000 #o000 #o000 #o001 #o000 #o000 #o000 #o000 #o000 #o001)))
+  (with-output-to-file tmp-output-file
+    (lambda ()
+      (for-each
+       (lambda (b)
+	 (write-byte b))
+       bytes)))
+
+  (let ((ctr 0))
+    (call-with-input-file tmp-output-file
+      (lambda (p)
+	(if (not (string=? (port-filename p) tmp-output-file)) (display (port-filename p)))
+	(let loop ((val (read-byte p)))
+	  (if (eof-object? val)
+	      (if (not (= ctr 26))
+		  (format #t "read-byte done at ~A~%" ctr))
+	      (begin
+		(if (not (= (bytes ctr) val))
+		    (format #t "read-byte bytes[~D]: ~A ~A~%" ctr (bytes ctr) val))
+		(set! ctr (+ 1 ctr))
+		(loop (read-byte p))))))))
+
+  (let ((ctr 0))
+    (call-with-input-file tmp-output-file
+      (lambda (p)
+	(let loop ((val (read-char p)))
+	  (if (eof-object? val)
+	      (if (not (= ctr 26))
+		  (format #t "read-char done at ~A~%" ctr))
+	      (begin
+		(if (not (= (bytes ctr) (char->integer val)))
+		    (format #t "read-char bytes[~D]: ~A ~A~%" ctr (bytes ctr) (char->integer val)))
+		(set! ctr (+ 1 ctr))
+		(loop (read-char p))))))))
+  )
+
+(with-output-to-file tmp-output-file
+  (lambda ()
+    (if (not (string=? (port-filename (current-output-port)) tmp-output-file)) (display (port-filename (current-output-port))))
+    (display "(+ 1 2) 32")
+    (newline)
+    (display "#\\a  -1")))
+
+(with-input-from-file tmp-output-file
+  (lambda ()
+    (if (not (string=? (port-filename (current-input-port)) tmp-output-file)) (display (port-filename (current-input-port))))
+    (let ((val (read)))
+      (if (not (equal? val (list '+ 1 2)))
+	  (format #t ";file read +: ~A~%" val)))
+    (let ((val (read)))
+      (if (not (equal? val 32))
+	  (format #t "file read 32: ~A~%" val)))
+    (let ((val (read)))
+      (if (not (equal? val #\a))
+	  (format #t "file read a: ~A~%" val)))
+    (let ((val (read)))
+      (if (not (equal? val -1))
+	  (format #t "file read -1: ~A~%" val)))
+    (let ((val (read)))
+      (if (not (eof-object? val))
+	  (format #t "file read #<eof>: ~A~%" val)))
+    (let ((val (read)))
+      (if (not (eof-object? val))
+	  (format #t "file read #<eof> again: ~A~%" val)))))
+
+(let ()
+  (call-with-input-string "012"
+    (lambda (p)
+      (do ((i 0 (+ i 1)))
+	  ((= i 4))
+	(let ((c (peek-char p)))
+	  (let ((r (read-char p)))
+	    (if (not (equal? c r))
+		(format #t ";peek-char: ~A ~A~%" c r))))))))
+
+(let ((port #f))
+  (call-with-exit
+   (lambda (go)
+     (call-with-input-string "0123456789"
+       (lambda (p)
+	 (set! port p)
+	 (if (not (char=? (peek-char p) #\0))
+	     (format #t ";peek-char input-string: ~A~%" (peek-char p)))
+	 (go)))))
+  (if (not (input-port? port))
+      (format #t ";c/e-> c/is -> port? ~A~%" port)
+      (if (not (port-closed? port))
+	  (begin
+	    (format #t ";c/e -> c/is -> closed? ~A~%" port)
+	    (close-input-port port)))))
+
+(call-with-output-file tmp-output-file (lambda (p) (display "0123456789" p)))
+
+(let ((port #f))
+  (call-with-exit
+   (lambda (go)
+     (call-with-input-file tmp-output-file
+       (lambda (p)
+	 (set! port p)
+	 (if (not (char=? (peek-char p) #\0))
+	     (format #t ";peek-char input-file: ~A~%" (peek-char p)))
+	 (go)))))
+  (if (not (input-port? port))
+      (format #t ";c/e -> c/if -> port? ~A~%" port)
+      (if (not (port-closed? port))
+	  (begin
+	    (format #t ";c/e -> c/if -> closed? ~A~%" port)
+	    (close-input-port port)))))
+
+(let ((port #f))
+  (call-with-exit
+   (lambda (go)
+     (dynamic-wind
+	 (lambda () #f)
+	 (lambda ()
+	   (call-with-input-string "0123456789"
+             (lambda (p)
+	       (set! port p)
+	       (if (not (char=? (peek-char p) #\0))
+		   (format #t ";peek-char input-string 1: ~A~%" (peek-char p)))
+	       (go))))
+	 (lambda ()
+	   (close-input-port port)))))
+  (if (not (input-port? port))
+      (format #t ";c/e -> dw -> c/is -> port? ~A~%" port)
+      (if (not (port-closed? port))
+	  (begin
+	    (format #t ";c/e -> dw -> c/is -> closed? ~A~%" port)
+	    (close-input-port port)))))
+
+(let ((port #f))
+  (call-with-exit
+   (lambda (go)
+     (dynamic-wind
+	 (lambda () #f)
+	 (lambda ()
+	   (call-with-input-file tmp-output-file
+            (lambda (p)
+	      (set! port p)
+	      (if (not (char=? (peek-char p) #\0))
+		  (format #t ";peek-char input-file: ~A~%" (peek-char p)))
+	      (go))))
+	 (lambda ()
+	   (close-input-port port)))))
+  (if (not (input-port? port))
+      (format #t ";c/e -> dw -> c/if -> port? ~A~%" port)
+      (if (not (port-closed? port))
+	  (begin
+	    (format #t ";c/e -> dw -> c/if -> closed? ~A~%" port)
+	    (close-input-port port)))))
+
+(let ((port #f))
+  (catch #t
+    (lambda ()
+     (call-with-input-string "0123456789"
+       (lambda (p)
+	 (set! port p)
+	 (if (not (char=? (peek-char p) #\0))
+	     (format #t ";peek-char input-string: ~A~%" (peek-char p)))
+	 (error 'oops))))
+    (lambda args #f))
+  (if (not (input-port? port))
+      (format #t ";catch -> c/is -> error -> port? ~A~%" port)
+      (if (not (port-closed? port))
+	  (begin
+	    (format #t ";catch -> c/is -> error -> closed? ~A~%" port)
+	    (close-input-port port)))))
+
+(let ((port #f))
+  (catch #t
+    (lambda ()
+     (call-with-input-file tmp-output-file
+       (lambda (p)
+	 (set! port p)
+	 (if (not (char=? (peek-char p) #\0))
+	     (format #t ";peek-char input-file: ~A~%" (peek-char p)))
+	 (error 'oops))))
+    (lambda args #f))
+  (if (not (input-port? port))
+      (format #t ";catch -> c/if -> error -> port? ~A~%" port)
+      (if (not (port-closed? port))
+	  (begin
+	    (format #t ";catch -> c/if -> error -> closed? ~A~%" port)
+	    (close-input-port port)))))
+
+(test (with-output-to-string (lambda () (write (string (integer->char 4) (integer->char 8) (integer->char 20) (integer->char 30))))) "\"\\x04;\\b\\x14;\\x1e;\"")
+(test (string-length "\x04;\x08;\x14;\x1e;") 4)
+(test (char->integer (string-ref "\x0;" 0)) 0)
+(test (char->integer (string-ref "\x0e;" 0)) 14)
+(test (char->integer (string-ref "\x1e;" 0)) 30)
+(test (char->integer (string-ref "\xff;" 0)) 255)
+(test (string=? "\x61;\x42;\x63;" "aBc") #t)
+(test (string=? "\"\\x01;\\x02;\\x03;\\x04;\\x05;\\x06;\\x07;\\x08;\\x09;x\\x0b;\\x0c;\\x0d;\\x0e;\\x0f;\\x10;\\x11;\\x12;\\x13;\\x14;\\x15;\\x16;\\x17;\\x18;\\x19;\\x1a;\\x1b;\\x1c;\\x1d;\\x1e;\\x1f; !\\\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\\x7f;\\x80;\\x81;\\x82;\\x83;\\x84;\\x85;\\x86;\\x87;\\x88;\\x89;\\x8a;\\x8b;\\x8c;\\x8d;\\x8e;\\x8f;\\x90;\\x91;\\x92;\\x93;\\x94;\\x95;\\x96;\\x97;\\x98;\\x99;\\x9a;\\x9b;\\x9c;\\x9d;\\x9e;\\x9f;\\xa0¡¢£¤¥¦§¨©ª«¬\\xad®¯°±²³´µ¶·¸¹º»¼½¾¿Ã\x80;Ã\x81;Ã\x82;Ã\x83;Ã\x84;Ã\x85;Ã\x86;Ã\x87;Ã\x88;Ã\x89;Ã\x8a;Ã\x8b;Ã\x8c;Ã\x8d;Ã\x8e;Ã\x8f;Ã\x90;Ã\x91;Ã\x92;Ã\x93;Ã\x94;Ã\x95;Ã\x96;Ã\x97;Ã\x98;Ã\x99;Ã\x9a;Ã\x9b;Ã\x9c;Ã\x9d;Ã\x9e;Ã\x9f;àáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ\""
+		"\"\\x01;\\x02;\\x03;\\x04;\\x05;\\x06;\\x07;\\x08;\\x09;x\\x0b;\\x0c;\\x0d;\\x0e;\\x0f;\\x10;\\x11;\\x12;\\x13;\\x14;\\x15;\\x16;\\x17;\\x18;\\x19;\\x1a;\\x1b;\\x1c;\\x1d;\\x1e;\\x1f; !\\\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\\x7f;\\x80;\\x81;\\x82;\\x83;\\x84;\\x85;\\x86;\\x87;\\x88;\\x89;\\x8a;\\x8b;\\x8c;\\x8d;\\x8e;\\x8f;\\x90;\\x91;\\x92;\\x93;\\x94;\\x95;\\x96;\\x97;\\x98;\\x99;\\x9a;\\x9b;\\x9c;\\x9d;\\x9e;\\x9f;\\xa0¡¢£¤¥¦§¨©ª«¬\\xad®¯°±²³´µ¶·¸¹º»¼½¾¿Ã\x80;Ã\x81;Ã\x82;Ã\x83;Ã\x84;Ã\x85;Ã\x86;Ã\x87;Ã\x88;Ã\x89;Ã\x8a;Ã\x8b;Ã\x8c;Ã\x8d;Ã\x8e;Ã\x8f;Ã\x90;Ã\x91;Ã\x92;Ã\x93;Ã\x94;Ã\x95;Ã\x96;Ã\x97;Ã\x98;Ã\x99;Ã\x9a;Ã\x9b;Ã\x9c;Ã\x9d;Ã\x9e;Ã\x9f;àáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ\"") #t)
+
+(test (let (({ 3)) (+ { 1)) 4) ; from bug-guile
+(test (display #\{ #f) #\{)
+(test (display '{ #f) '{) ; returns arg
+(test (with-output-to-string (lambda () (display '{))) "{")
+(test (with-output-to-string (lambda () (write '{))) "{")
+(test (let (([ 3)) (+ [ 1)) 4)
+(test (with-output-to-string (lambda () (display '[))) "[")
+
+(when (provided? 'system-extras)
+  ;; directory?
+  (test (directory? tmp-output-file) #f)
+  (test (directory? ".") #t)
+  (test (directory?) 'error)
+  (test (directory? "." 0) 'error)
+  (test (directory? "~/cl") #t)
+  (test (directory? "~") #f)
+  (test (directory? "~/") #t)
+  (for-each
+   (lambda (arg)
+     (test (directory? arg) 'error))
+   (list -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+	 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+  ;; file-exists?
+  (test (file-exists? tmp-output-file) #t)
+  (test (file-exists? "not-a-file-I-hope") #f)
+  (test (file-exists? "~/cl/s7.c") #t)
+  (test (file-exists?) 'error)
+  (test (file-exists? tmp-output-file 0) 'error)
+  (for-each
+   (lambda (arg)
+     (test (file-exists? arg) 'error))
+   (list -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+	 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+  ;; delete-file
+  (test (delete-file tmp-output-file) 0)
+  (test (file-exists? tmp-output-file) #f)
+  (test (delete-file "not-a-file-I-hope") -1)
+  (test (delete-file) 'error)
+  (test (delete-file tmp-output-file 0) 'error)
+  (when (file-exists? "~/cl/dsp.scm")
+    (system (string-append "touch ~/cl/" tmp-output-file))
+    (test (file-exists? (string-append "~/cl/" tmp-output-file)) #t)
+    (test (delete-file (string-append "~/cl/" tmp-output-file)) 0)
+    (test (file-exists? (string-append "~/cl/" tmp-output-file)) #f))
+  (for-each
+   (lambda (arg)
+     (test (delete-file arg) 'error))
+   (list -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+	 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+  ;; getenv
+  (test (pair? (member (getenv "HOME") (list (append "/usr/home/" username)
+                                             (append "/Users/" username)
+                                             (append "/home/" username)) string=?)) #t)
+  (test (getenv "NO-ENV") #f) ; was ""
+  (test (getenv) 'error)
+  (test (getenv "HOME" #t) 'error)
+  (for-each
+   (lambda (arg)
+     (test (getenv arg) 'error))
+   (list -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+	 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+  ;; directory->list
+  (test (directory->list) 'error)
+  (test (directory->list "." 0) 'error)
+  (for-each
+   (lambda (arg)
+     (test (directory->list arg) 'error))
+   (list -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+	 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+  (test (pair? (directory->list "tools")) #t)
+  (test (pair? (directory->list "~/cl/tools")) #t)
+
+  ;; file-mtime
+  (test (integer? (file-mtime "s7test.scm")) #t)
+  (test (integer? (file-mtime "~/cl/s7test.scm")) #t)
+  (test (file-mtime "asdf.data") 'error)
+  (test (file-mtime #\a) 'error)
+  (test (file-mtime) 'error)
+  (test (file-mtime "asdf" "a") 'error)
+
+  ;; system
+  (test (system "test -f s7test.scm") 0)
+  (test (system) 'error)
+  (test (let ((str (system "man grep" #t)))
+	  (and (string? str)
+	       (> (length str) 10000))) ; osx: 14479, linux: 40761
+	#t)
+  (for-each
+   (lambda (arg)
+     (test (system arg) 'error))
+   (list -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+	 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
+
+(if (not pure-s7)
+    (for-each
+     (lambda (arg)
+       (test (char-ready? arg) 'error))
+     (list "hi" -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+	   3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
+
+;;; newline
+(test (newline 0) 'error)
+(test (newline *stdout* 0) 'error)
+(test (newline #f) #\newline)
+(test (with-output-to-string (lambda () (newline))) "\n")
+(test (with-output-to-string (lambda () (newline #f))) "")
+(test (call-with-output-string (lambda (p) (newline p))) "\n")
+(test (newline *stdin*) 'error)
+
+(test (display 0 0) 'error)
+(test (write 0 0) 'error)
+(test (write-char 0 0) 'error)
+(test (write-string 0 0) 'error)
+(test (write-line 0 0) 'error)
+(test (read-char 0) 'error)
+(test (read 0) 'error)
+(test (read-string 1 0) 'error)
+(test (read-line 0) 'error)
+
+
+;;; -------- format --------
+;;; format
+
+(test (format #f "hiho") "hiho")
+(test (format #f "") "")
+(test (format #f "" 1) 'error)
+(test (format #f "a") "a")
+;(test (format #f "a\x00;b") "a")
+
+(test (format #f "~~") "~") ; guile returns this, but clisp thinks it's an error
+(test (format #f "~~~~") "~~")
+(test (format #f "a~~") "a~")
+(test (format #f "~~a") "~a")
+(test (format #f "~A" "") "")
+(test (format #f "~{~^~A~}" ()) "")
+(test (format #f "~{~^~{~^~A~}~}" '(())) "")
+(test (format #f "~P" 1) "")
+(test (format #f "~P" #\a) 'error)
+(test (format #f "~0T") "")
+(test (format #f "") "")
+(test (format #f "~*~*" 1 2) "")
+(test (format #f "~20,'~D" 3) "~~~~~~~~~~~~~~~~~~~3")
+(test (format #f "~0D" 123) "123")
+(test (format #f "~{~S~}" ()) "")
+(test (format #f "~-1D" 123) 'error)
+(test (format #f "~+1D" 123) 'error)
+(test (format #f "~1.D" 123) 'error)
+(test (format #f "~1+iD" 123) 'error)
+(test (format #f "~1/2D" 123) 'error)
+(test (format #f "~1/1D" 123) 'error)
+(test (format #f "~20,'-1D" 123) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (format arg "~D" 1) 'error))
+ (list "hi" #\a 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (directive)
+   (for-each
+    (lambda (arg)
+      (test (format #f directive arg) 'error)
+      (test (format #f directive) 'error))
+    (list "hi" #\a 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand
+	  #f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
+ (list "~D" "~F" "~G" "~X" "~B" "~O" "~E" "~P"))
+
+(test (format #f "~,1" 123) 'error)
+;format "~,1" 123: numeric argument, but no directive!
+;    (format #f "~,1" 123)
+
+(test (format #f "~,123456789123456789123456789d" 1) 'error)
+;format "~,123456789123456789123456789d" 1: numeric argument too large
+;    (format #t "~,123456789123456789123456789d" 1)
+(test (format #f "~969424987x" 12) 'error)
+
+(test (format #f "~D" 1 2) 'error)
+;format: "~D" 1 2
+;           ^: too many arguments
+;    (format #f "~D" 1 2)
+
+(test (format #f "~D~" 1) 'error)
+;format: "~D~" 1
+;           ^: control string ends in tilde
+;    (format #f "~D~" 1)
+(test (format #f "~") 'error)
+(test (format #f " ~") 'error)
+(test (format #f "~~~") 'error)
+(test (format #f " ~~~") 'error)
+
+(test (format #f "~@D" 1) 'error)
+;format "~@D" 1: unknown '@' directive
+;    (format #f "~@D" 1)
+
+(test (format #f "~@p" #\a) 'error)
+;format "~@p" #\a: '@P' directive argument is not an integer
+;    (format #f "~@p" #\a)
+
+(test (format #f "~@p") 'error)
+;format "~@p": '@' directive argument missing
+
+(test (format #f "~P" 1+i) 'error)
+;format "~P" 1+1i: 'P' directive argument is not a real number
+;    (format #f "~P" 1+1i)
+
+(test (format #f "~P" (real-part (log 0))) "s")
+
+(test (format #f "~@p" 0+i) 'error)
+;format "~@p" 0+1i: '@P' directive argument is not a real number
+;    (format #f "~@p" 0+1i)
+
+(test (format #f "~{~}") 'error)
+;format "~{~}": missing argument
+;    (format #f "~{~}")
+
+(test (format #f "~{~a" '(1 2 3)) 'error)
+;format "~{~a" (1 2 3): '{' directive, but no matching '}'
+;    (format #f "~{~a" '(1 2 3))
+
+(test (format #f "~{~a~}" '(1 . 2)) 'error) ; changed 28-Nov-18, then again 11-Dec-18
+;format "~{~a~}" (1 . 2): '{' directive argument should be a proper list or something we can turn into a list
+;    (format #f "~{~a~}" '(1 . 2))
+
+(test (let ((lst (cons 1 2))) (set-cdr! lst lst) (format #f "~{~A~}" lst)) "1")
+;format "~{~A~}" #1=(1 . #1#): '{' directive argument should be a proper list or something we can turn into a list
+;    (format #f "~{~A~}" lst)
+
+(test (format #f "~{~a~}" 'asdf) 'error)
+;format "~{~a~}" asdf: '{' directive argument should be a proper list or something we can turn into a list
+;    (format #f "~{~a~}" 'asdf)
+
+(test (format #f "~{~a~}" ()) "")
+(test (format #f "~{asd~}" '(1 2 3)) 'error)
+;format: "~{asd~}" (1 2 3)
+;             ^: '{...}' doesn't consume any arguments!
+;    (format #f "~{asd~}" '(1 2 3))
+
+(test (format #f "~}" '(1 2 3)) 'error)
+;format "~}" (1 2 3): unmatched '}'
+;    (format #f "~}" '(1 2 3))
+
+(test (format #f "~C") 'error)
+;format "~C": ~C: missing argument
+;    (format #f "~C")
+
+(test (format #f "~A ~C" #\a) 'error)
+;format: "~A ~C" #\a
+;            ^: ~C: missing argument
+;    (format #f "~A ~C" #\a)
+
+(test (format #f "~C" 1) 'error)
+;format "~C" 1: 'C' directive requires a character argument
+;    (format #f "~C" 1)
+
+(test (format #f "~C" #<eof>) 'error)
+;format "~C" #<eof>: 'C' directive requires a character argument
+;    (format #f "~C" #<eof>)
+
+(test (format #f "~1,9223372036854775807f" 1) 'error)
+;format "~1,9223372036854775807f" 1: numeric argument too large
+;    (format #f "~1,9223372036854775807f" 1)
+
+(test (format #f "~1,2A" 1) 'error)
+;format "~1,2A" 1: extra numeric argument
+;    (format #f "~1,2A" 1)
+
+(test (format #f "~F" #\a) 'error)
+;format "~F" #\a: ~F: numeric argument required
+;    (format #f "~F" #\a)
+
+(test (format #f "~1,") 'error)
+;format "~1,": format directive does not take a numeric argument
+;    (format #f "~1,")
+
+(test (format #f "~-1,") 'error)
+;format "~-1,": unimplemented format directive
+;    (format #f "~-1,")
+
+(test (format #f "~L" 1) 'error)
+;format "~L" 1: unimplemented format directive
+;    (format #f "~L" 1)
+
+(test (format #f "~*") 'error)
+;format "~*": can't skip argument!
+
+(test (format #f "~*~A") 'error)
+(test (format #f "~*~*" 1) 'error)
+(test (format #f "~N") 'error)
+(test (format #f "~N" 2) 'error)
+(test (format #f "~N." 2) 'error)
+(test (format #f "~NT" 2.1) 'error)
+(test (format #f "~NT" #\a) 'error)
+(test (format #f "~N," 1) 'error)
+(test (format #f "~N,N" 1 2) 'error)
+(test (format #f "~N,N." 1 2) 'error)
+(test (format #f "~,N" 1) 'error)
+(test (format #f "~,N." 1) 'error)
+(test (format #f "~ND" 123456789) 'error)
+(test (format #f "~ND" -1) 'error)
+
+(test (format #f "~{~a~e~}" (cons 1 2)) 'error)
+;format: "~{~a~e~}" (1 . 2): ~{} argument is a dotted list
+
+(for-each
+ (lambda (c)
+   (test (apply format #f (string-append "~" (string c)) '(a)) 'error))
+ (list #\H #\I #\J #\K #\L #\M #\Q #\R #\U #\V #\Y #\Z
+       #\[ #\\ #\] #\_ #\` #\# #\! #\" #\' #\( #\) #\+ #\, #\- #\. #\/ #\< #\= #\> #\?
+       #\h #\i #\j #\k #\l #\m #\q #\r #\u #\v #\y #\z))
+
+(test (format #f "~A" 1 2) 'error)
+;format: "~A" 1 2
+;           ^: too many arguments
+;    (format #f "~A" 1 2)
+
+(test (format #f "hiho~%ha") (string-append "hiho" (string #\newline) "ha"))
+(test (format #f "~%") (string #\newline))
+(test (format #f "~%ha") (string-append (string #\newline) "ha"))
+(test (format #f "hiho~%") (string-append "hiho" (string #\newline)))
+
+(test (eq? #\tab ((format #f "\t") 0)) #t)
+(test (eq? #\newline ((format #f "\n") 0)) #t)
+(test (eq? #\\ ((format #f "\\") 0)) #t)
+(test (eq? #\" ((format #f "\"") 0)) #t)
+
+(for-each
+ (lambda (arg res)
+   (let ((val (catch #t (lambda () (format #f "~A" arg)) (lambda args 'error))))
+     (if (or (not (string? val))
+	     (not (string=? val res)))
+	 (begin (display "(format #f \"~A\" ") (display arg)
+		(display " returned \"") (display val)
+		(display "\" but expected \"") (display res) (display "\"")
+		(newline)))))
+ (list "hiho"  -1  #\a  1   #f   #t  #(1 2 3)   3.14   3/4  1.5+1.5i ()  #(())  (list 1 2 3) '(1 . 2) 'hi)
+ (list "hiho" "-1" "a" "1" "#f" "#t" "#(1 2 3)" "3.14" "3/4" "1.5+1.5i"   "()" "#(())" "(1 2 3)"    "(1 . 2)" "hi"))
+
+(test (format #f "hi ~A ho" 1) "hi 1 ho")
+(test (format #f "hi ~a ho" 1) "hi 1 ho")
+(test (format #f "~a~A~a" 1 2 3) "123")
+(test (format #f "~a~~~a" 1 3) "1~3")
+(test (format #f "~a~%~a" 1 3) (string-append "1" (string #\newline) "3"))
+
+(for-each
+ (lambda (arg res)
+   (let ((val (catch #t (lambda () (format #f "~S" arg)) (lambda args 'error))))
+     (if (or (not (string? val))
+	     (not (string=? val res)))
+	 (begin (display "(format #f \"~S\" ") (display arg)
+		(display " returned \"") (display val)
+		(display "\" but expected \"") (display res) (display "\"")
+		(newline)))))
+ (list "hiho"  -1  #\a  1   #f   #t  #(1 2 3)   3.14   3/4  1.5+1.5i ()  #(())  (list 1 2 3) '(1 . 2) 'hi)
+ (list "\"hiho\"" "-1" "#\\a" "1" "#f" "#t" "#(1 2 3)" "3.14" "3/4" "1.5+1.5i"   "()" "#(())" "(1 2 3)"    "(1 . 2)" "hi"))
+
+(test (format #f "hi ~S ho" 1) "hi 1 ho")
+(test (format #f "hi ~S ho" "abc") "hi \"abc\" ho")
+(test (format #f "~s~a" #\a #\b) "#\\ab")
+(test (format #f "~C~c~C" #\a #\b #\c) "abc")
+;(test (format #f "1 2~C 3 4" #\null) "1 2") ; ?? everyone does something different here
+;; s7 used to return "1 2 3 4" because it treated ~C as a string (empty in this case)
+(test  (format #f "1 2~C 3 4" #\null) "1 2\x00; 3 4")
+(test (format #f "~nc" 3 #\a) "aaa")
+(test (format #f "~nc" 0 #\a) "")
+(test (format #f "~0c" #\a) "")
+(test (format #f "~01c" #\a) "a")
+(test (format #f "~002c" #\a) "aa")
+(test (format #f "~nc" -1 #\a) 'error)
+(test (format #f "~nc" most-positive-fixnum #\a) 'error)
+(test (format #f "~nc" 1.0 #\a) 'error)
+(test (format #f "~n~nc" 1 2 #\a) 'error)
+(test (format #f "~na" 1 #\a) 'error)
+(test (format #f "[~NC]" 0 #\a) "[]")
+(test (format #f "[~NC]" -1 #\a) 'error)
+(test (format #f "[~NC]" 1 #\a) "[a]")
+
+(test (format #f "~{~A~}" '(1 2 3)) "123")
+(test (format #f "asb~{~A ~}asb" '(1 2 3 4)) "asb1 2 3 4 asb")
+(test (format #f "asb~{~A ~A.~}asb" '(1 2 3 4)) "asb1 2.3 4.asb")
+(test (format #f ".~{~A~}." ()) "..")
+
+(test (format #f "~{~A ~A ~}" '(1 "hi" 2 "ho")) "1 hi 2 ho ")
+(test (format #f "~{.~{+~A+~}.~}" (list (list 1 2 3) (list 4 5 6))) ".+1++2++3+..+4++5++6+.")
+(test (format #f "~{~s ~}" '(fred jerry jill)) "fred jerry jill ")
+(test (format #f "~{~s~^ ~}" '(fred jerry jill)) "fred jerry jill")
+(test (format #f "~{~s~^~^ ~}" '(fred jerry jill)) "fred jerry jill")
+(test (format #f "~{.~{~A~}+~{~A~}~}" '((1 2) (3 4 5) (6 7 8) (9))) ".12+345.678+9")
+(test (format #f "~{.~{+~{-~A~}~}~}" '(((1 2) (3 4 5)))) ".+-1-2+-3-4-5")
+(test (format #f "~{.~{+~{-~A~}~}~}" '(((1 2) (3 4 5)) ((6) (7 8 9)))) ".+-1-2+-3-4-5.+-6+-7-8-9")
+
+(test (format #f "~A ~* ~A" 1 2 3) "1  3")
+(test (format #f "~*" 1) "")
+(test (format #f "~{~* ~}" '(1 2 3)) "   ")
+(test (format #f "~A" catch) "catch")
+(test (format #f "this is a ~
+             sentence") "this is a sentence")
+(test (format #f "~{~C~}" "hi") "hi")
+(test (format #f "~{~C~}" #(#\h #\i)) "hi")
+(test (format #f "~S" #(a b)) "#(a b)")
+(test (format #f "~S" #(a 'b)) "#(a 'b)")
+
+(test (format #f "~{.~{~C+~}~}" '((#\h #\i) (#\h #\o))) ".h+i+.h+o+")
+(test (format #f "~{.~{~C+~}~}" '("hi" "ho")) ".h+i+.h+o+")
+(test (format #f "~{.~{~C+~}~}" #("hi" "ho")) ".h+i+.h+o+")
+(test (format #f "~{.~{~C+~}~}" #(#(#\h #\i) #(#\h #\o))) ".h+i+.h+o+")
+
+; (format #f "~{.~{~C~+~}~}" #2d((#\h #\i) (#\h #\o))) error?? -- this is documented...
+(test (format #f "~{~A~}" #2d((1 2) (3 4))) "1234") ; this seems inconsistent with:
+(test (format #f "~{~A~}" '((1 2) (3 4))) "(1 2)(3 4)")
+(test (format #f "~{~A ~}" #2d((1 2) (3 4))) "1 2 3 4 ")
+(test (format #f "1~\
+a2" 3) "132")
+(test (format #f "1~
+                 ~a2" 3) "132")
+
+(test (format #f "~{~{~C~^ ~}~^...~}" (list "hiho" "test")) "h i h o...t e s t")
+
+;; ~nT handling is a mess -- what are the defaults?  which is column 1? do we space up to or up to and including?
+
+(test (format #f "~A:~8T~A" 100 'a)   "100:   a")
+(test (format #f "~A:~nT~A" 100 8 'a)   "100:   a")
+(test (format #f "~A:~8T~A" 0 'a)     "0:     a")
+(test (format #f "~A:~8T~A" 10000 'a) "10000: a")
+(test (format #f "~8T~A" 'a)      "       a")
+(test (format #f "1212:~8T~A" 'a) "1212:  a")
+(test (format #f "~D:~8T~A" 100 'a)   "100:   a")
+(test (format #f "~D:~8T~A" 0 'a)     "0:     a")
+(test (format #f "~D:~8T~A" 10000 'a) "10000: a")
+(test (format #f "~a~10,7Tb" 1)     "1               b")
+(test (format #f "~a~10,7Tb" 10000) "10000           b")
+(test (format #f "~a~10,12Tb" 1)     "1                    b")
+(test (format #f "~a~10,12Tb" 10000) "10000                b")
+(test (format #f "~a~n,nTb" 10000 10 12) "10000                b")
+(test (format #f "~n,'xT" 8) "xxxxxxx")
+(test (format #f "~n,' T" 8) "       ")
+
+(test (length (format #f "~{~A~}~40T." '(1 2 3))) 40)
+(test (length (format #f "~{~A ~}~40T." '(1 2 3))) 40)
+(test (length (format #f "~{~,3F ~}~40T." '(1.0 2.0 3.0))) 40)
+(test (length (format #f "~S~40T." pi)) (if with-bignums 44 40))
+
+(test (format #f "asdh~20Thiho") "asdh               hiho")
+(test (format #f "asdh~2Thiho") "asdhhiho")
+(test (format #f "a~Tb") "ab")
+(test (format #f "0123456~4,8Tb") "0123456    b")
+(test (format #f "0123456~0,8Tb") "0123456b")
+(test (format #f "0123456~10,8Tb") "0123456          b")
+(test (format #f "0123456~1,0Tb") "0123456b")
+(test (format #f "0123456~1,Tb") "0123456b")
+(test (format #f "0123456~1,Tb") "0123456b")
+(test (format #f "0123456~,Tb") "0123456b")
+(test (format #f "0123456~7,10Tb") "0123456         b")
+(test (format #f "0123456~8,10tb") "0123456          b")
+(test (format #f "0123456~3,12tb") "0123456       b")
+(test (format #f "~40TX") "                                       X")
+(test (format #f "X~,8TX~,8TX") "X      X       X")
+(test (format #f "X~8,TX~8,TX") "X      XX")
+(test (format #f "X~8,10TX~8,10TX") "X                X         X")
+(test (format #f "X~8,0TX~8,0TX") "X      XX")
+(test (format #f "X~0,8TX~0,8TX") "X      X       X")
+(test (format #f "X~1,8TX~1,8TX") "X       X       X")
+(test (format #f "X~,8TX~,8TX") "X      X       X") ; ??
+(test (format #f "X~TX~TX") "XXX") ; clisp and sbcl say "X X X" here and similar differences elsewhere -- is it colnum or colinc as default if no comma?
+(test (format #f "X~2TX~4TX") "XX X")
+(test (format #f "X~0,0TX~0,0TX") "XXX")
+(test (format #f "X~0,TX~0,TX") "XXX")
+(test (format #f "X~,0TX~,0TX") "XXX")
+
+(test (format #f "~0D" 123) "123")
+(test (format #f "~0F" 123.123) "123.123000")
+(test (format #f "~,0D" 123) "123")
+(test (format #f "~,0F" 123.123) "123.0")
+(test (format #f "~,D" 123) "123")
+(test (format #f "~,F" 123.123) "123.123000")
+(test (format #f "~0,D" 123) "123")
+(test (format #f "~0,F" 123.123) "123.123000")
+(test (format #f "~0,0D" 123) "123")
+(test (format #f "~n,nD" 0 0 123) "123")
+(test (format #f "~0,0F" 123.123) "123.0")
+(test (format #f "~0,0,D" 123) 'error)
+(test (format #f "~n,n,D" 0 0 123) 'error)
+(test (format #f "~0,0,F" 123.123) 'error)
+
+(test (format #f "~,3F" 1+i) "1.000+1.000i")
+(test (format #f "~,nF" 3 1+i) "1.000+1.000i")
+(test (format #f "~,3G" 1+i) "1.0+1.0i")
+(test (format #f "~,3E" 1+i) "1.000e+00+1.000e+00i")
+(test (format #f "~,3F" 1-i) "1.000-1.000i")
+(test (format #f "~,3G" 1-i) "1.0-1.0i")
+(test (format #f "~,3E" 1-i) "1.000e+00-1.000e+00i")
+
+;; not sure about these:
+(test (format #f "~X" 1-i) "1.0-1.0i")
+(test (format #f "~,3D" 1-i) "1.000e+00-1.000e+00i")
+(test (format #f "~A" 1-i) "1.0-1.0i")
+
+(test (format #f "~W" 3) "3")
+(test (format #f "~W" 3/4) "3/4")
+(test (format #f "~W" 3.4) "3.4")
+(test (format #f "~W" 3+4i) "3.0+4.0i")
+(test (format #f "~W" 3-4i) "3.0-4.0i")
+(if with-bignums
+    (test (format #f "~W" pi) "3.141592653589793238462643383279502884195E0")
+    (test (format #f "~W" pi) "pi"))
+(unless with-bignums
+  (test (format #f "~W" (complex 1/0 0)) "+nan.0")
+  (test (format #f "~W" (complex 1/0 1)) "+nan.0+1.0i")
+  (test (format #f "~W" (complex +inf.0 1/0)) "+inf.0+nan.0i")
+  (test (format #f "~W" (log 0)) "-inf.0+3.141592653589793i"))
+
+(test (catch #t (lambda () (let () (define (c1 a b) (+ a b)) (c1 1))) (lambda (t i) (apply format #f i))) "c1: not enough arguments: ((lambda (a b) ...) 1)")
+(test (catch #t (lambda () (let () (define (c1 a b) (+ a b)) (c1 1 2 3))) (lambda (t i) (apply format #f i))) "c1: too many arguments: ((lambda (a b) ...) 1 2 3)")
+(test (catch #t (lambda () (let () (define-macro (m1 a b) (+ a b)) (m1 1))) (lambda (t i) (apply format #f i))) "m1: not enough arguments: ((macro (a b) ...) 1)")
+(test (catch #t (lambda () (let () (define-macro (m1 a b) (+ a b)) (m1 1 2 3))) (lambda (t i) (apply format #f i))) "m1: too many arguments: ((macro (a b) ...) 1 2 3)")
+(test (catch #t (lambda () (let () (define-bacro (m2 a b) (+ a b)) (m2 1))) (lambda (t i) (apply format #f i))) "m2: not enough arguments: ((bacro (a b) ...) 1)")
+(test (catch #t (lambda () (let () (define-bacro (m2 a b) (+ a b)) (m2 1 2 3))) (lambda (t i) (apply format #f i))) "m2: too many arguments: ((bacro (a b) ...) 1 2 3)")
+
+;; see also object->string with :readable
+
+(test (format #f "~000000000000000000000000000000000000000000003F" 123.123456789) "123.123457")
+(test (format #f "~922337203685477580F" 123.123) 'error)   ; numeric argument too large
+(test (format #f "~,922337203685477580F" 123.123) 'error)
+(test (format #f "~1,922337203685477580F" 123.123) 'error)
+(test (format #f "~1 ,2F" 123.456789) 'error)
+(test (format #f "~1, 2F" 123.456789) 'error)
+(test (format #f "~1, F" 123.456789) 'error)
+
+(if with-bignums
+    (begin
+      (test (format #f "~o" 1e19) "1.053071060221172E21")
+      (test (format #f "~o" -1e19) "-1.053071060221172E21")
+      (test (format #f "~x" 1e19) "8.ac7230489e8@15")
+      (test (format #f "~b" 1e19) "1.00010101100011100100011000001001000100111101E63")
+      (test (format #f "~o" 1e308) "1.071474702753621177617256074117252375235444E341")
+      (test (format #f "~o" -1e308) "-1.071474702753621177617256074117252375235444E341")
+      (test (format #f "~x" 1e308) "8.e679c2f5e44ff8f570f09eaa7ea7648@255")
+      (test (format #f "~x" 9.22e18) "7.ff405267d1a@15")
+      (test (format #f "~b" 1e308) "1.0001110011001111001110000101111010111100100010011111111100011110101011100001111000010011110101010100111111010100111011001001E1023")
+      (test (format #f "~,791o" 1e308) "1.071474702753621177617256074117252375235444E341")
+      (test (format #f "~1200,2g" 1e308) "                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   9.999999999999999999999999999999999999982E307")
+      (test (format #f "~o" 1e19-1e20i) "1.053071060221172E21-1.2657072742654304E22i")
+      (test (format #f "~x" 1e308+1e300i) "8.e679c2f5e44ff8f570f09eaa7ea7648@255+1.7e43c8800759ba59c08e14c7cd7aad86@249i"))
+    (begin
+      (test (format #f "~o" 1e19) "1.053071e21")
+      (test (format #f "~o" -1e19) "-1.053071e21")
+      (test (format #f "~x" 1e19) "8.ac723@15")
+      (test (format #f "~b" 1e19) "1.000101e63")
+      (test (format #f "~o" 1e308) "1.071474e341")
+      (test (format #f "~o" -1e308) "-1.071474e341")
+      (test (format #f "~x" 1e308) "8.e679c2@255")
+      (test (or (string=? (format #f "~x" 9.22e18) "7ff405267d1a0000.0")
+		(string=? (format #f "~x" 9.22e18) "7.ff4052@15"))
+	    #t) ; this depends on a cutoff point in s7.c, L8850, number_to_string_with_radix
+      (test (format #f "~b" 1e308) "1.000111e1023")
+      (test (format #f "~,791o" 1e308) "1.0714747027536212e341")
+      (test (format #f "~1200,2g" 1e308) "                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          1e+308")
+      (test (format #f "~o" 1e19-1e20i) "1.053071e21-1.265707e22i")
+      (test (format #f "~x" 1e308+1e300i) "8.e679c2@255+1.7e43c8@249i")))
+
+(test (= (length (substring (format #f "~%~10T.") 1)) (length (format #f "~10T."))) #t)
+(test (= (length (substring (format #f "~%-~10T.~%") 1)) (length (format #f "-~10T.~%"))) #t)
+(test (string=? (format #f "~%|0 1 2|~21T|5  8  3  2|~%~
+                              |1 2 3| |0 1 2 3|~21T|8 14  8  6|~%~
+                              |2 3 0| |1 2 3 0| = ~21T|3  8 13  6|~%~
+                              |3 0 1| |2 3 0 1|~21T|2  6  6 10|~%")
+		"
+|0 1 2|             |5  8  3  2|
+|1 2 3| |0 1 2 3|   |8 14  8  6|
+|2 3 0| |1 2 3 0| = |3  8 13  6|
+|3 0 1| |2 3 0 1|   |2  6  6 10|
+") #t)
+
+
+(if (not with-windows) (test (format #f "~S" '(+ 1/0 1/0)) "(+ +nan.0 +nan.0)")) ; !?
+(if (not with-windows) (test (format #f "~S" '(+ '1/0 1/0)) "(+ '+nan.0 +nan.0)")) ; !?
+(test (format #f "~S" '(+ 1/0 1.0/0.0)) (format #f "~S" (list '+ '1/0 '1.0/0.0)))
+(test (format #f "~S" (quote (+ '1 1))) "(+ '1 1)")
+
+
+(test (format #f "~12,''D" 1) "'''''''''''1")
+(test (let ((str "~12,'xD")) (set! (str 5) #\space) (format #f str 1)) "           1")
+(test (format #f "~12,' D" 1) "           1")
+(test (format #f "~12,'\\D" 1) "\\\\\\\\\\\\\\\\\\\\\\1")
+(test (format #f "~12,'\"D" 1) "\"\"\"\"\"\"\"\"\"\"\"1")
+(test (format #f "~12,'~D" 1) "~~~~~~~~~~~1")
+(test (format #f "~12,',d" 1) ",,,,,,,,,,,1")
+(test (format #f "~12,',,d" 1) 'error)
+(test (format #f "~12,,d" 1) 'error)
+(test (format #f "~n,,d" 12 1) 'error)
+(test (format #f "hiho~\n") "hiho")
+
+(test (string=? (format #f "~%~&" ) (string #\newline)) #t)
+(test (string=? (format #f "~%a~&" ) (string #\newline #\a #\newline)) #t)
+(test (string=? (format #f "~%~%") (string #\newline #\newline)) #t)
+(test (string=? (format #f "~10T~%~&~10T.") (format #f "~10T~&~&~10T.")) #t)
+(test (string=? (format #f "~10T~&~10T.") (format #f "~10T~%~&~&~&~&~10T.")) #t)
+(test (length (format #f "~%~&~%")) 2)
+(test (length (format #f "~%~&~&~&~&~%")) 2)
+(test (length (format #f "~&~%")) 1)
+
+(test (format #f "~2,1F" 0.5) "0.5")
+(test (format #f "~:2T") 'error)
+(test (format #f "~2,1,3F" 0.5) 'error)
+(test (format #f "~<~W~>" 'foo) 'error)
+(test (format #f "~{12") 'error)
+(test (format #f "~{}") 'error)
+(test (format #f "~{}" '(1 2)) 'error)
+(test (format #f "{~}" '(1 2)) 'error)
+(test (format #f "~{~{~}}" '(1 2)) 'error)
+(test (format #f "~}" ) 'error)
+;(test (format #f "#|~|#|") 'error) ; ~| is ~^+ now
+(test (format #f "~1.5F" 1.5) 'error)
+(test (format #f "~1+iF" 1.5) 'error)
+(test (format #f "~1,1iF" 1.5) 'error)
+(test (format #f "~0" 1) 'error)
+(test (format #f "~1") 'error)
+(test (format #f "~^" 1) 'error)
+(test (format #f "~.0F" 1.0) 'error)
+(test (format #f "~1.0F" 1.0) 'error)
+(test (format #f "~-1F" 1.0) 'error)
+(test (format #f "~^") "")
+(test (format #f "~A ~A~|this is not printed" 1 2) "1 2")
+(test (format #f "~^~A~^~A~^this is not printed" 1 2) "12")
+(test (format #f "~|") "")
+(test (format #f "~D~" 9) 'error)
+(test (format #f "~&" 9) 'error)
+(test (format #f "~D~100T~D" 1 1) "1                                                                                                  1")
+(test (format #f ".~P." 1) "..")
+(test (format #f ".~P." 1.0) "..")
+(test (format #f ".~P." 1.2) ".s.")
+(test (format #f ".~P." 2/3) ".s.")
+(test (format #f ".~P." 2) ".s.")
+(test (format #f ".~p." 1) "..")
+(test (format #f ".~p." 1.0) "..")
+(test (format #f ".~p." 1.2) ".s.")
+(test (format #f ".~p." 2) ".s.")
+(test (format #f ".~@P." 1) ".y.")
+(test (format #f ".~@P." 1.0) ".y.")
+(test (format #f ".~@P." 1.2) ".ies.")
+(test (format #f ".~@P." 2) ".ies.")
+(test (format #f ".~@p." 1) ".y.")
+(test (format #f ".~@p." 1.0) ".y.")
+(test (format #f ".~@p." 1.2) ".ies.")
+(test (format #f ".~@p." 2) ".ies.")
+(test (format #f ".~P." 1.0+i) 'error)
+(test (format #f ".~P." 1/0) ".s.")
+(test (format #f "~P" 1) "") ; Clisp does this
+(if (not with-windows) (test (format #f ".~P." (real-part (log 0))) ".s."))
+
+(test (format #f (string #\~ #\a) 1) "1")
+(test (format #f (format #f "~~a") 1) "1")
+(test (format #f (format #f "~~a") (format #f "~D" 1)) "1")
+(test (format #f "~A" (quasiquote quote)) "quote")
+
+(test (format #f "~f" (/ 1 3)) "1/3") ; hmmm -- should it call exact->inexact?
+(test (format #f "~f" 1) "1")
+(test (format #f "~F" most-positive-fixnum) "9223372036854775807")
+
+(test (format () "") "") ; changed 18-Mar-24, was #f
+(test (with-output-to-string (lambda () (display (format () "")))) "")
+(test (with-output-to-string (lambda () (display #f))) "#f")
+
+(unless with-bignums
+  (test (format #f "~,20F" 1e-20) "0.00000000000000000001")
+  (test (format #f "~,40F" 1e-40) "0.0000000000000000000000000000000000000001"))
+;; if with bignums, these needs more bits
+
+;;; the usual troubles here with big floats:
+;;; (format #f "~F" 922337203685477580.9) -> "922337203685477632.000000"
+;;; (format #f "~F" 9223372036854775.9) -> "9223372036854776.000000"
+;;; (format #f "~F" 1e25) -> "10000000000000000905969664.000000"
+;;; or small:
+;;; (format #f "~,30F" 1e-1) -> "0.100000000000000005551115123126"
+
+(when with-bignums
+  (test (format #f "~A" -7043009959286724629649270926654940933664689003233793014518979272497911394287216967075767325693021717277238746020477538876750544587281879084559996466844417586093291189295867052594478662802691926547232838591510540917276694295393715934079679531035912244103731582711556740654671309980075069010778644542022/670550434139267031632063192770201289106737062379324644110801846820471752716238484923370056920388400273070254958650831435834503195629325418985020030706879602898158806736813101434594805676212779217311897830937606064579213895527844045511878668289820732425014254579493444623868748969110751636786165152601) "-7043009959286724629649270926654940933664689003233793014518979272497911394287216967075767325693021717277238746020477538876750544587281879084559996466844417586093291189295867052594478662802691926547232838591510540917276694295393715934079679531035912244103731582711556740654671309980075069010778644542022/670550434139267031632063192770201289106737062379324644110801846820471752716238484923370056920388400273070254958650831435834503195629325418985020030706879602898158806736813101434594805676212779217311897830937606064579213895527844045511878668289820732425014254579493444623868748969110751636786165152601")
+  (test (format #f "~D" -7043009959286724629649270926654940933664689003233793014518979272497911394287216967075767325693021717277238746020477538876750544587281879084559996466844417586093291189295867052594478662802691926547232838591510540917276694295393715934079679531035912244103731582711556740654671309980075069010778644542022/670550434139267031632063192770201289106737062379324644110801846820471752716238484923370056920388400273070254958650831435834503195629325418985020030706879602898158806736813101434594805676212779217311897830937606064579213895527844045511878668289820732425014254579493444623868748969110751636786165152601) "-7043009959286724629649270926654940933664689003233793014518979272497911394287216967075767325693021717277238746020477538876750544587281879084559996466844417586093291189295867052594478662802691926547232838591510540917276694295393715934079679531035912244103731582711556740654671309980075069010778644542022/670550434139267031632063192770201289106737062379324644110801846820471752716238484923370056920388400273070254958650831435834503195629325418985020030706879602898158806736813101434594805676212779217311897830937606064579213895527844045511878668289820732425014254579493444623868748969110751636786165152601"))
+
+(unless with-bignums
+  (test (format #f "~,1024F" pi)
+        "3.1415926535897931159979634685441851615905761718750000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"))
+
+(test (format #f "~100,30000F" pi) 'error)
+(test (format #f "~N,1F" most-positive-fixnum pi) 'error) ; "~N value is too big"
+(test (format #f "~N,1F" (- most-positive-fixnum 1) pi) 'error) ; "~N value is too big"
+(test (format #f "~N,1F" most-negative-fixnum pi) 'error) ; "~N value is negative"
+(test (format #f "~NC" (ash 1 32) #\c) 'error) ; "~N value is too big"
+(test (format #f "~,9223272036854775807F" pi) 'error) ; "precision is too big"
+
+(test (format #f "~@F" 1.23) 'error)
+(test (format #f "~{testing ~D ~C ~}" (list 0 #\( 1 #\) 2 #\* 3 #\+ 4 #\, 5 #\- 6 #\. 7 #\/ 8 #\0 9 #\1 10 #\2 11 #\3 12 #\4 13 #\5 14 #\6 15 #\7 16 #\8 17 #\9 18 #\: 19 #\; 20 #\< 21 #\= 22 #\> 23 #\? 24 #\@ 25 #\A 26 #\B 27 #\C 28 #\D 29 #\E 30 #\F 31 #\G 32 #\H 33 #\I 34 #\J 35 #\K 36 #\L 37 #\M 38 #\N 39 #\O 40 #\P 41 #\Q 42 #\R 43 #\S 44 #\T 45 #\U 46 #\V 47 #\W 48 #\X 49 #\Y 50 #\( 51 #\) 52 #\* 53 #\+ 54 #\, 55 #\- 56 #\. 57 #\/ 58 #\0 59 #\1 60 #\2 61 #\3 62 #\4 63 #\5 64 #\6 65 #\7 66 #\8 67 #\9 68 #\: 69 #\; 70 #\< 71 #\= 72 #\> 73 #\? 74 #\@ 75 #\A 76 #\B 77 #\C 78 #\D 79 #\E 80 #\F 81 #\G 82 #\H 83 #\I 84 #\J 85 #\K 86 #\L 87 #\M 88 #\N 89 #\O 90 #\P 91 #\Q 92 #\R 93 #\S 94 #\T 95 #\U 96 #\V 97 #\W 98 #\X 99 #\Y))
+      "testing 0 ( testing 1 ) testing 2 * testing 3 + testing 4 , testing 5 - testing 6 . testing 7 / testing 8 0 testing 9 1 testing 10 2 testing 11 3 testing 12 4 testing 13 5 testing 14 6 testing 15 7 testing 16 8 testing 17 9 testing 18 : testing 19 ; testing 20 < testing 21 = testing 22 > testing 23 ? testing 24 @ testing 25 A testing 26 B testing 27 C testing 28 D testing 29 E testing 30 F testing 31 G testing 32 H testing 33 I testing 34 J testing 35 K testing 36 L testing 37 M testing 38 N testing 39 O testing 40 P testing 41 Q testing 42 R testing 43 S testing 44 T testing 45 U testing 46 V testing 47 W testing 48 X testing 49 Y testing 50 ( testing 51 ) testing 52 * testing 53 + testing 54 , testing 55 - testing 56 . testing 57 / testing 58 0 testing 59 1 testing 60 2 testing 61 3 testing 62 4 testing 63 5 testing 64 6 testing 65 7 testing 66 8 testing 67 9 testing 68 : testing 69 ; testing 70 < testing 71 = testing 72 > testing 73 ? testing 74 @ testing 75 A testing 76 B testing 77 C testing 78 D testing 79 E testing 80 F testing 81 G testing 82 H testing 83 I testing 84 J testing 85 K testing 86 L testing 87 M testing 88 N testing 89 O testing 90 P testing 91 Q testing 92 R testing 93 S testing 94 T testing 95 U testing 96 V testing 97 W testing 98 X testing 99 Y ")
+
+
+(let ((vect1 #3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2))))
+      (vect2 #2d((1 2 3 4 5 6) (7 8 9 10 11 12)))
+      (vect3 #(1 2 3 4 5 6 7 8 9 10 11 12 13 14))
+      (vect4 #3d(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12)))))
+  (do ((i 0 (+ i 2)))
+      ((>= i 10))
+    (set! (*s7* 'print-length) i)
+    (test (object->string vect1) (format #f "~A" vect1))
+    (test (object->string vect2) (format #f "~A" vect2))
+    (test (object->string vect3) (format #f "~A" vect3))
+    (test (object->string vect4) (format #f "~A" vect4))))
+
+(let-temporarily (((*s7* 'print-length) 0))
+  (test (format #f "~A" #()) "#()")
+  (test (format #f "~S" (list (cons 1 1))) "((...))"))
+
+(let-temporarily (((*s7* 'print-length) 3))
+  (let ((lst (list 1)))
+    (set-car! lst lst)
+    (let ((v (vector 1 1 1 1 1 1 1 1 1 lst)))
+      (let ((str (format #f "~A" v)))
+	(test (string=? str "#(1 1 1 ...)") #t)))))
+
+(let ()
+  (catch #t (lambda () (object->string (make-iterator "1234") :readable 3)) (lambda args #f))
+  (test (format #f "~S" (list (cons 1 1))) "((1 . 1))")) ; check that bogus object->string truncation doesn't affect subsequent output
+
+(test (format #f "~D" 123) "123")
+(test (format #f "~X" 123) "7b")
+(test (format #f "~B" 123) "1111011")
+(test (format #f "~O" 123) "173")
+
+(test (format #f "~10D" 123) "       123")
+(test (format #f "~nD" 10 123) "       123")
+(test (format #f "~10X" 123) "        7b")
+(test (format #f "~10B" 123) "   1111011")
+(test (format #f "~10O" 123) "       173")
+
+(test (format #f "~D" -123) "-123")
+(test (format #f "~X" -123) "-7b")
+(test (format #f "~B" -123) "-1111011")
+(test (format #f "~O" -123) "-173")
+
+(test (format #f "~10D" -123) "      -123")
+(test (format #f "~10X" -123) "       -7b")
+(test (format #f "~10B" -123) "  -1111011")
+(test (format #f "~10O" -123) "      -173")
+
+(test (format #f "~d" 123) "123")
+(test (format #f "~x" 123) "7b")
+(test (format #f "~b" 123) "1111011")
+(test (format #f "~o" 123) "173")
+
+(test (format #f "~10d" 123) "       123")
+(test (format #f "~10x" 123) "        7b")
+(test (format #f "~10b" 123) "   1111011")
+(test (format #f "~10o" 123) "       173")
+
+(test (format #f "~d" -123) "-123")
+(test (format #f "~x" -123) "-7b")
+(test (format #f "~b" -123) "-1111011")
+(test (format #f "~o" -123) "-173")
+
+(test (format #f "~10d" -123) "      -123")
+(test (format #f "~10x" -123) "       -7b")
+(test (format #f "~10b" -123) "  -1111011")
+(test (format #f "~10o" -123) "      -173")
+
+(test (format #f "~D" most-positive-fixnum) "9223372036854775807")
+(test (format #f "~D" (+ 1 most-negative-fixnum)) "-9223372036854775807")
+
+(test (format #f "~X" most-positive-fixnum) "7fffffffffffffff")
+(test (format #f "~X" (+ 1 most-negative-fixnum)) "-7fffffffffffffff")
+
+(test (format #f "~O" most-positive-fixnum) "777777777777777777777")
+(test (format #f "~O" (+ 1 most-negative-fixnum)) "-777777777777777777777")
+
+(test (format #f "~B" most-positive-fixnum) "111111111111111111111111111111111111111111111111111111111111111")
+(test (format #f "~B" (+ 1 most-negative-fixnum)) "-111111111111111111111111111111111111111111111111111111111111111")
+
+(num-test (inexact->exact most-positive-fixnum) most-positive-fixnum)
+
+(test (format #f "~0D" 123) "123")
+(test (format #f "~0X" 123) "7b")
+(test (format #f "~0B" 123) "1111011")
+(test (format #f "~0O" 123) "173")
+
+(test (format #f "" 1) 'error)
+(test (format #f "hiho" 1) 'error)
+(test (format #f "a~%" 1) 'error) ; some just ignore extra args
+
+(for-each
+ (lambda (arg)
+   (let ((result (catch #t (lambda () (format arg "hiho")) (lambda args 'error))))
+     (if (not (eq? result 'error))
+	 (begin (display "(format ") (display arg) (display " \"hiho\")")
+		(display " returned ") (display result)
+		(display " but expected 'error")
+		(newline)))))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i 'hi :hi #<eof> abs (lambda () 1) #(()) (list 1 2 3) '(1 . 2)))
+
+(for-each
+ (lambda (arg)
+   (let ((result (catch #t (lambda () (format #f arg)) (lambda args 'error))))
+     (if (not (eq? result 'error))
+	 (begin (display "(format #f ") (display arg) (display ")")
+		(display " returned ") (display result)
+		(display " but expected 'error")
+		(newline)))))
+ (list -1 #\a 1 #f #t #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi abs (lambda () 1) #(()) (list 1 2 3) '(1 . 2)))
+
+(test (format #f "hi ~A ho" 1 2) 'error)
+(test (format #f "hi ~A ho") 'error)
+(test (format #f "hi ~S ho") 'error)
+(test (format #f "hi ~S ho" 1 2) 'error)
+(test (format #f "~C" 1) 'error)
+(test (format #f "123 ~R 321" 1) 'error)
+(test (format #f "123 ~,3R 321" 1) 'error)
+(test (format #f "~,2,3,4D" 123) 'error)
+
+(test (format #f "hi ~Z ho") 'error)
+(test (format #f "hi ~+ ho") 'error)
+(test (format #f "hi ~# ho") 'error)
+(test (format #f "hi ~, ho") 'error)
+
+(test (format #f "hi ~} ho") 'error)
+(test (format #f "hi {ho~}") 'error)
+
+(test (format #f "asb~{~A asd" '(1 2 3)) 'error)
+(test (format #f "~{~A~}" 1 2 3) 'error)
+(test (format #f "asb~{~}asd" '(1 2 3)) 'error)
+(test (format #f "asb~{ ~}asd" '(1 2 3)) 'error)
+(test (format #f "asb~{ . ~}asd" '(1 2 3)) 'error)
+(test (format #f "asb~{ hiho~~~}asd" '(1 2 3)) 'error)
+
+(test (format #f "~12C" #\a) "aaaaaaaaaaaa")
+(test (format #f ".~0C." #\a) "..")
+(test (format #f "~10C" #\space) "          ")
+
+(test (format #f "~12P" #\a) 'error)
+(test (format #f "~12*" #\a) 'error)
+(test (format #f "~12%" #\a) 'error)
+(test (format #f "~12^" #\a) 'error)
+(test (format #f "~12{" #\a) 'error)
+(test (format #f "~12,2A" #\a) 'error)
+
+(test (format #f "~12,A" #\a) 'error) ; s7 misses padding errors such as (format #f "~12,' A" #\a)
+
+(for-each
+ (lambda (arg)
+   (test (format #f "~F" arg) 'error))
+ (list "hi" #\a 'a-symbol (make-vector 3) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+   (test (format #f "~D" arg) 'error))
+ (list "hi" #\a 'a-symbol (make-vector 3) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+   (test (format #f "~P" arg) 'error))
+ (list "hi" #\a 'a-symbol (make-vector 3) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+   (test (format #f "~X" arg) 'error))
+ (list "hi" #\a 'a-symbol (make-vector 3) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+   (test (format #f "~C" arg) 'error))
+ (list "hi" 1 1.0 1+i 2/3 'a-symbol (make-vector 3) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+   (test (format #f arg 123) 'error))
+ (list 1 1.0 1+i 2/3 'a-symbol (make-vector 3) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (format #f "~{~A ~A ~}" '(1 "hi" 2)) 'error)
+(for-each
+ (lambda (arg)
+   (let ((result (catch #t (lambda () (format #f "~F" arg)) (lambda args 'error))))
+     (if (not (eq? result 'error))
+	 (begin (display "(format #f \"~F\" ") (display arg)
+		(display ") returned ") (display result)
+		(display " but expected 'error")
+		(newline)))))
+ (list #\a #(1 2 3) "hi" () 'hi abs (lambda () 1) #(()) (list 1 2 3) '(1 . 2)))
+
+(test (format #f "~D") 'error)
+(test (format () "hi") "") ; not an error now -- will print "hi" also
+(test (format #f "~F" "hi") 'error)
+(test (format #f "~D" #\x) 'error)
+(test (format #f "~C" (list 1 2 3)) 'error)
+(test (format #f "~1/4F" 1.4) 'error)
+(test (format #f "~1.4F" 1.4) 'error)
+(test (format #f "~F" (real-part (log 0.0))) "-inf.0")
+(test (let ((val (format #f "~F" (/ (real-part (log 0.0)) (real-part (log 0.0)))))) (string=? val "+nan.0")) #t)
+(test (format #f "~1/4T~A" 1) 'error)
+(test (format #f "~T") "")
+(test (format #f "~@P~S" 1 '(1)) "y(1)")
+(test (format #f ".~A~*" 1 '(1)) ".1")
+(test (format #f "~*~*~T" 1 '(1)) "")
+
+(test (format #f "~A" 'AB\c) "(symbol \"AB\\\\c\")")
+(test (format #f "~S" 'AB\c) "(symbol \"AB\\\\c\")")
+(test (format #f "~A" '(AB\c () xyz)) "((symbol \"AB\\\\c\") () xyz)")
+(test (format #f "~,2f" 1234567.1234) "1234567.12")
+(test (format #f "~5D" 3) "    3")
+(test (format #f "~5,'0D" 3) "00003")
+(test (format #f "++~{-=~s=-~}++" (quote (1 2 3))) "++-=1=--=2=--=3=-++")
+
+(test (format) 'error)
+(for-each
+ (lambda (arg)
+   (test (format arg) 'error))
+ (list 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+(test (format "hi") 'error)
+(test (format "~A ~D" 1/3 2) 'error)
+(test (format "") 'error)
+
+(test (format #f "~:D" 23) "23rd")
+(test (format #f "~:D" 101) "101st")
+(test (format #f "~:D" 11) "11th")
+(test (format #f "~:D" 1) "first")
+(test (format #f "~:D" 8) "eighth")
+(test (format #f "~:D" 42) "42nd")
+(test (format #f "~:D" 2) "second")
+(test (format #f "~:D" -2) 'error)
+(test (format #f "~:D" #()) 'error)
+(test (format #f "~:F" pi) 'error)
+(test (format #f "~:" pi) 'error)
+
+;; from slib/formatst.scm
+(test (string=? (format #f "abc") "abc") #t)
+(test (string=? (format #f "~a" 10) "10") #t)
+(test (string=? (format #f "~a" -1.2) "-1.2") #t)
+(test (string=? (format #f "~a" 'a) "a") #t)
+(test (string=? (format #f "~a" #t) "#t") #t)
+(test (string=? (format #f "~a" #f) "#f") #t)
+(test (string=? (format #f "~a" "abc") "abc") #t)
+(test (string=? (format #f "~a" #(1 2 3)) "#(1 2 3)") #t)
+(test (string=? (format #f "~a" ()) "()") #t)
+(test (string=? (format #f "~a" '(a)) "(a)") #t)
+(test (string=? (format #f "~a" '(a b)) "(a b)") #t)
+(test (string=? (format #f "~a" '(a (b c) d)) "(a (b c) d)") #t)
+(test (string=? (format #f "~a" '(a . b)) "(a . b)") #t)
+(test (string=? (format #f "~a ~a" 10 20) "10 20") #t)
+(test (string=? (format #f "~a abc ~a def" 10 20) "10 abc 20 def") #t)
+(test (string=? (format #f "~d" 100) "100") #t)
+(test (string=? (format #f "~x" 100) "64") #t)
+(test (string=? (format #f "~o" 100) "144") #t)
+(test (string=? (format #f "~b" 100) "1100100") #t)
+(test (string=? (format #f "~10d" 100) "       100") #t)
+(test (string=? (format #f "~10,'*d" 100) "*******100") #t)
+(test (string=? (format #f "~c" #\a) "a") #t)
+(test (string=? (format #f "~c" #\space) " ") #t)
+(test (string=? (format #f "~C" #\x91) "\x91;") #t)
+(test (string=? (format #f "~C" #\x9) "\x09;") #t)
+(test (string=? (format #f "~C" #\~) "~") #t)
+(test (string=? (format #f "~A" #\x91) "\x91;") #t)
+(test (string=? (format #f "~S" #\x91) "#\\x91") #t)
+(test (string=? (format #f "~A" (string->symbol "hi")) "hi") #t)
+(test (string=? (format #f "~S" (string->symbol "hi")) "hi") #t)
+(test (string=? (format #f "~A" (string->symbol ";\\\";")) "(symbol \";\\\\\\\";\")") #t)
+(test (string=? (format #f "~S" (string->symbol ";\\\";")) "(symbol \";\\\\\\\";\")") #t)
+(test (string=? (format #f "~A" (string->symbol (string #\, #\. #\# #\; #\" #\\ #\' #\`))) "(symbol \",.#;\\\"\\\\'`\")") #t)
+
+(test (string=? (format #f "~~~~") "~~") #t)
+(test (string=? (format #f "~s" "abc") "\"abc\"") #t)
+(test (string=? (format #f "~s" "abc \\ abc") "\"abc \\\\ abc\"") #t)
+(test (string=? (format #f "~a" "abc \\ abc") "abc \\ abc") #t)
+(test (string=? (format #f "~s" "abc \" abc") "\"abc \\\" abc\"") #t)
+(test (string=? (format #f "~a" "abc \" abc") "abc \" abc") #t)
+(test (string=? (format #f "~s" #\space) "#\\space") #t)
+(test (string=? (format #f "~s" #\newline) "#\\newline") #t)
+(test (string=? (format #f "~s" #\a) "#\\a") #t)
+(test (string=? (format #f "~a" '(a "b" c)) "(a \"b\" c)") #t)
+(test (string=? (format #f "abc~
+         123") "abc123") #t)
+(test (string=? (format #f "abc~
+123") "abc123") #t)
+(test (string=? (format #f "abc~
+") "abc") #t)
+(test (string=? (format #f "~{ ~a ~}" '(a b c)) " a  b  c ") #t)
+(test (string=? (format #f "~{ ~a ~}" ()) "") #t)
+(test (string=? (format #f "~{ ~a ~}" "") "") #t)
+(test (string=? (format #f "~{ ~a ~}" #()) "") #t)
+(test (string=? (format #f "~{ ~a,~a ~}" '(a 1 b 2 c 3)) " a,1  b,2  c,3 ") #t)
+(test (string=? (format #f "abc ~^ xyz") "abc ") #t)
+(test (format (values #f "~A ~D" 1 2)) "1 2")
+(test (format #f "~A~^" 1) "1") ; clisp agrees here
+(test (format #f "~A~*~* ~A" (values 1 2 3 4)) "1 4")
+(test (format #f "~^~A~^~*~*~^ ~^~A~^" (values 1 2 3 4)) "1 4")
+
+(test (string=? (format #f "~B" 123) "1111011") #t)
+(test (string=? (format #f "~B" 123/25) "1111011/11001") #t)
+(test (string=? (format #f "~B" 123.25) "1111011.01") #t)
+(test (string=? (format #f "~B" 123+i) "1111011.0+1.0i") #t)
+
+(test (string=? (format #f "~D" 123) "123") #t)
+(test (string=? (format #f "~D" 123/25) "123/25") #t)
+
+(test (string=? (format #f "~O" 123) "173") #t)
+(test (string=? (format #f "~O" 123/25) "173/31") #t)
+(test (string=? (format #f "~O" 123.25) "173.2") #t)
+(test (string=? (format #f "~O" 123+i) "173.0+1.0i") #t)
+
+(test (string=? (format #f "~X" 123) "7b") #t)
+(test (string=? (format #f "~X" 123/25) "7b/19") #t)
+(test (string=? (format #f "~X" 123.25) "7b.4") #t)
+(test (string=? (format #f "~X" 123+i) "7b.0+1.0i") #t)
+
+(test (string=? (format #f "~A" "hi") (format #f "~S" "hi")) #f)
+(test (string=? (format #f "~A" #\a) (format #f "~S" #\a)) #f)
+(for-each
+ (lambda (arg)
+   (test (string=? (format #f "~A" arg) (format #f "~S" arg)) #t))
+ (list 1 1.0 #(1 2 3) '(1 2 3) '(1 . 2) () #f #t abs #<eof> #<unspecified> 'hi '\a))
+(test (length (format #f "~S" (string #\\))) 4)                  ; "\"\\\\\""
+(test (length (format #f "~S" (string #\a))) 3)                  ; "\"a\""
+(test (length (format #f "~S" (string #\null))) 7)               ; "\"\\x00;\""
+(test (length (format #f "~S" (string (integer->char #xf0)))) 3) ; "\"ð\""
+(test (length (format #f "~S" (string #\"))) 4)                  ; "\""
+
+(test (format #f "~F" 3.0) "3.000000")
+(test (format #f "~G" 3.0) "3.0")
+(test (format #f "~E" 3.0) (if (not with-windows) "3.000000e+00" "3.000000e+000"))
+(test (format #f "~F" 3.14159) "3.141590")
+(test (format #f "~G" 3.14159) "3.14159")
+(test (format #f "~E" 3.14159) (if (not with-windows) "3.141590e+00" "3.141590e+000"))
+(test (format #f "~,2F" 3.14159) "3.14")
+(test (format #f "~,2G" 3.14159) "3.1")
+(test (format #f "~,2E" 3.14159) (if (not with-windows) "3.14e+00" "3.14e+000"))
+(test (format #f "~12F" 3.14159) "    3.141590")
+(test (format #f "~12G" 3.14159) "     3.14159")
+(test (format #f "~12E" 3.14159) (if (not with-windows) "3.141590e+00" "3.141590e+000"))
+(test (format #f "~12,3F" 3.14159) "       3.142")
+(test (format #f "~n,nF" 12 3 3.14159) "       3.142")
+(test (format #f "~12,nF" 3 3.14159) "       3.142")
+(test (format #f "~12,3G" 3.14159) "        3.14")
+(test (format #f "~12,3E" 3.14159) (if (not with-windows) "   3.142e+00" "  3.142e+000"))
+(test (format #f "~12,'xD" 1) "xxxxxxxxxxx1")
+(test (format #f "~12,'xF" 3.14159) "xxxx3.141590")
+(test (format #f "~12,'xG" 3.14159) "xxxxx3.14159")
+(test (format #f "~12,'xE" 3.14159) (if (not with-windows) "3.141590e+00" "3.141590e+000"))
+(test (format #f "~12,'\\F" 3.14159) "\\\\\\\\3.141590")
+(test (format #f "~20,20G" 3.0) "                   3.0")
+(test (format #f "~20,20F" 3.0) "3.00000000000000000000")
+(test (format #f "~20,20E" 3.0) (if (not with-windows) "3.00000000000000000000e+00" "3.00000000000000000000e+000"))
+
+(test (format #f "~,3B" 0.99999) "0.111")
+(test (format #f "~,3O" 0.99999) "0.777")
+(test (format #f "~,3F" 0.99999) "1.000")
+(test (format #f "~,3X" 0.99999) "0.fff")
+
+(test (format #f "~-2F" 0.0) 'error)
+(test (format #f "~,-2F" 0.0) 'error)
+(test (format #f "~2/3F" 0.0) 'error)
+(test (format #f "~2.3F" 0.0) 'error)
+(test (format #f "~2,1,3,4F" 0.0) 'error)
+(test (format #f "~'xF" 0.0) 'error)
+(test (format #f "~3,3" pi) 'error)
+(test (format #f "~3," pi) 'error)
+(test (format #f "~3" pi) 'error)
+(test (format #f "~," pi) 'error)
+(test (format #f "~'," pi) 'error)
+(test (format #f "~'" pi) 'error)
+
+(test (format #f "~*" 1.0) "")
+(test (format #f "~D" 1.0) (if (not with-windows) "1.000000e+00" "1.000000e+000"))
+(test (format #f "~O" 1.0) "1.0")
+(test (format #f "~P" 1.0) "")
+(test (format #f "~P" '(1 2 3)) 'error)
+(test (format #f "~\x00;T") 'error)
+(test (format #f "~9,'(T") "((((((((")
+(test (format #f "~0F" 1+1i) "1.000000+1.000000i")
+(test (format #f "~9F" 1) "        1")
+(test (format #f "~,0F" 3.14) "3.0")
+(test (format #f "~,0F" 1+1i) "1.0+1.0i")
+(test (format #f "~,0X" 1+1i) "1.0+1.0i")
+(test (format #f "~,9g" 1+1i) "1.0+1.0i")
+(test (format #f "~,1e" 3.14) (if (not with-windows) "3.1e+00" "3.1e+000"))
+(test (format #f "~9,0F" 3.14) "        3.0")
+(test (format #f "~9,1F" 3.14) "      3.1")
+(test (format #f "~9,2F" 3.14) "     3.14")
+(test (format #f "~9,3F" 3.14) "    3.140")
+(test (format #f "~9,4F" 3.14) "   3.1400")
+(test (format #f "~n,4F" 9 3.14) "   3.1400")
+(test (format #f "~9,nF" 4 3.14) "   3.1400")
+(test (format #f "~n,nF" 9 4 3.14) "   3.1400")
+(test (format #f "~9,5F" 3.14) "  3.14000")
+(test (format #f "~9,6F" 3.14) " 3.140000")
+(test (format #f "~9,7F" 3.14) "3.1400000")
+(test (format #f "~9,8F" 3.14) "3.14000000")
+(test (format #f "~9,9F" 3.14) "3.140000000")
+(test (format #f "~9,9G" 1+1i) " 1.0+1.0i")
+(if (not with-windows)
+    (begin
+      (test (format #f "~9,0e" 1+1i) "1e+00+1e+00i")
+      (test (format #f "~9,1e" 1+1i) "1.0e+00+1.0e+00i")
+      (test (format #f "~9,2e" 1+1i) "1.00e+00+1.00e+00i")
+      (test (format #f "~9,3e" 1+1i) "1.000e+00+1.000e+00i")
+      (test (format #f "~9,4e" 1+1i) "1.0000e+00+1.0000e+00i")
+      (test (format #f "~9,5e" 1+1i) "1.00000e+00+1.00000e+00i")
+      (test (format #f "~9,6e" 1+1i) "1.000000e+00+1.000000e+00i")
+      (test (format #f "~9,7e" 1+1i) "1.0000000e+00+1.0000000e+00i")
+      (test (format #f "~9,8e" 1+1i) "1.00000000e+00+1.00000000e+00i")
+      (test (format #f "~9,9e" 1+1i) "1.000000000e+00+1.000000000e+00i"))
+    (begin
+      (test (format #f "~9,0e" 1+1i) "1e+000+1e+000i")
+      (test (format #f "~9,1e" 1+1i) "1.0e+000+1.0e+000i")
+      (test (format #f "~9,2e" 1+1i) "1.00e+000+1.00e+000i")
+      (test (format #f "~9,3e" 1+1i) "1.000e+000+1.000e+000i")
+      (test (format #f "~9,4e" 1+1i) "1.0000e+000+1.0000e+000i")
+      (test (format #f "~9,5e" 1+1i) "1.00000e+000+1.00000e+000i")
+      (test (format #f "~9,6e" 1+1i) "1.000000e+000+1.000000e+000i")
+      (test (format #f "~9,7e" 1+1i) "1.0000000e+000+1.0000000e+000i")
+      (test (format #f "~9,8e" 1+1i) "1.00000000e+000+1.00000000e+000i")
+      (test (format #f "~9,9e" 1+1i) "1.000000000e+000+1.000000000e+000i")))
+(test (format #f "~9,0x" 3.14) "      3.0")
+(test (format #f "~9,1x" 3.14) "      3.2")
+(test (format #f "~9,2x" 3.14) "     3.23")
+(test (format #f "~9,3x" 3.14) "    3.23d")
+(test (format #f "~9,4x" 3.14) "   3.23d7")
+(test (format #f "~9,5x" 3.14) "   3.23d7")
+(test (format #f "~9,6x" 3.14) " 3.23d70a")
+(test (format #f "~9,7x" 3.14) "3.23d70a3")
+(test (format #f "~9,8x" 3.14) "3.23d70a3d")
+(test (format #f "~9,9x" 3.14) "3.23d70a3d7")
+(test (format #f "~9,0b" 3.14) "     11.0")
+(test (format #f "~9,1b" 3.14) "     11.0")
+(test (format #f "~9,2b" 3.14) "     11.0")
+(test (format #f "~9,3b" 3.14) "   11.001")
+(test (format #f "~9,4b" 3.14) "   11.001")
+(test (format #f "~9,5b" 3.14) "   11.001")
+(test (format #f "~9,6b" 3.14) "   11.001")
+(test (format #f "~9,7b" 3.14) "11.0010001")
+(test (format #f "~9,8b" 3.14) "11.00100011")
+(test (format #f "~9,9b" 3.14) "11.001000111")
+(test (format #f "~0,'xf" 1) "1")
+(test (format #f "~1,'xf" 1) "1")
+(test (format #f "~2,'xf" 1) "x1")
+(test (format #f "~3,'xf" 1) "xx1")
+(test (format #f "~4,'xf" 1) "xxx1")
+(test (format #f "~5,'xf" 1) "xxxx1")
+(test (format #f "~6,'xf" 1) "xxxxx1")
+(test (format #f "~7,'xf" 1) "xxxxxx1")
+(test (format #f "~8,'xf" 1) "xxxxxxx1")
+(test (format #f "~9,'xf" 1) "xxxxxxxx1")
+(test (format #f "~11,'xf" 3.14) "xxx3.140000")
+(test (format #f "~12,'xf" 3.14) "xxxx3.140000")
+(test (format #f "~13,'xf" 3.14) "xxxxx3.140000")
+(test (format #f "~14,'xf" 3.14) "xxxxxx3.140000")
+(test (format #f "~15,'xf" 3.14) "xxxxxxx3.140000")
+(test (format #f "~16,'xf" 3.14) "xxxxxxxx3.140000")
+(test (format #f "~17,'xf" 3.14) "xxxxxxxxx3.140000")
+(test (format #f "~18,'xf" 3.14) "xxxxxxxxxx3.140000")
+(test (format #f "~19,'xf" 3.14) "xxxxxxxxxxx3.140000")
+(test (format #f "~,f" 1.0) "1.000000")
+(test (format #f "~,,f" 1.0) 'error)
+(test (format #f "~p" '(1 2 3)) 'error) ; these are not errors in CL
+(test (format #f "~p" #(())) 'error)
+(test (format #f "~p" 'hi) 'error)
+(test (format #f "~p" abs) 'error)
+(test (format #f "~p" 1+i) 'error)
+(test (format #f "~@p" '(1 2 3)) 'error)
+(test (format #f "~@p" #(())) 'error)
+(test (format #f "~@p" 'hi) 'error)
+(test (format #f "~@p" abs) 'error)
+(let-temporarily (((*s7* 'print-length) 3))
+  (test (format #f "~{~A~| ~}" '(1 2 3 4 5 6)) "1 2 3 ...")
+  (test (format #f "~{~A~| ~}" #(1 2 3 4 5 6)) "1 2 3 ...")
+  (test (format #f "~{~A~| ~}" #(1 2)) "1 2")
+  (test (format #f "~{~A~| ~}" #(1 2 3)) "1 2 3")
+  (test (format #f "~{~A~| ~}" #(1 2 3 4)) "1 2 3 ...")
+  (test (format #f "~{~A~| ~}" (inlet 'a 1 'b 2 'c 3 'd 4 'e 5)) "(a . 1) (b . 2) (c . 3) ...")
+  (test (format #f "~{~{~A~| ~}~}" '((1 2 3 4 5 6))) "1 2 3 ...")
+  (test (format #f "~{~{~A~| ~}~|~}" '((1 2) (3 4 5 6 7 8) (15) (16) ())) "1 23 4 5 ...15 ...")
+  (test (format #f "~{~|~|~|~A ~}" '(1 2 3 4 5)) "1 2 3  ...")
+  (test (format #f "~{~C~| ~}" "1234567") "1 2 3 ...")
+  (test (format #f "~{~{~A~|~} ~}" '((1 2) (3 4))) "12 34 ")
+  (test (format #f "~C ~^" #\a) "a ")
+  (test (format #f "~{~{~{~A~| ~}~| ~}~}" '(((1 2) (3 4)))) "1 2 3 4")
+  (test (format #f "~{~{~{~A~| ~}~| ~}~}" '((#(1 2) #(3 4)))) "1 2 3 4")
+  (test (format #f "~{~{~{~A~| ~}~| ~}~}" #(((1 2) (3 4)))) "1 2 3 4")
+  (test (format #f "~{~{~{~A~| ~}~| ~}~}" #(#((1 2) (3 4)))) "1 2 3 4")
+  (test (format #f "~{~{~C~| ~}~| ~}" (list "hiho" "xxx")) "h i h ... x x x"))
+(test (format #f "~{~{~A~^~} ~}" '((hi 1))) "hi1 ")
+(test (format #f "~{~{~A~^~} ~}" '((1 2) (3 4))) "12 34 ")
+(test (format #f "~{~{~A~} ~}" '((1 2) (3 4))) "12 34 ")
+(test (format #f "~{~{~A~} ~}" '(())) " ")
+(test (format #f "~{~{~A~} ~}" '((()))) "() ")
+(test (format #f "~{~{~F~} ~}" '(())) " ")
+(test (format #f "~{~{~C~} ~}" '(())) " ")
+(test (format #f "~{~C ~}" ()) "")
+(test (format #f "~C ~^" #\a) "a ") ; CL ignores pointless ~^
+(test (format #f "~^~A" #f) "#f")
+(test (format #f "~^~^~A" #f) "#f")
+(test (format #f "~*~*~A~*" 1 2 3 4) "3")
+(test (format #f "~{~*~A~}" '(1 2 3 4)) "24")
+(test (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (format #f "~A" lst)) "#1=(1 2 3 . #1#)")
+(test (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (format #f "~{~A~}" lst)) "12312")
+(test (format #f "~{~A~}" (cons 1 2)) 'error)
+(test (format #f "~{~A~}" '(1 2 3 . 4)) 'error)
+(test (format #f "~20,vF" 3.14) 'error)
+(test (format #f "~{~C~^ ~}" "hiho") "h i h o")
+(test (format #f "~{~{~C~^ ~}~}" (list "hiho")) "h i h o")
+(test (format #f "~{~A ~}" #(1 2 3 4)) "1 2 3 4 ")
+(test (let ((v (vector 1))) (set! (v 0) v) (format #f "~A" v)) "#1=#(#1#)")
+(test (let ((v (vector 1))) (set! (v 0) v) (format #f "~{~A~}" v)) "#1=#(#1#)")
+(test (format #f "~{~{~{~A~^ ~}~^ ~}~}" '(((1 2) (3 4)))) "1 2 3 4")
+(test (format #f "~{~{~{~A~^ ~}~^ ~}~}" '((#(1 2) #(3 4)))) "1 2 3 4")
+(test (format #f "~{~{~{~A~^ ~}~^ ~}~}" #(((1 2) (3 4)))) "1 2 3 4")
+(test (format #f "~{~{~{~A~^ ~}~^ ~}~}" #(#((1 2) (3 4)))) "1 2 3 4")
+(test (format #f "~{~{~{~A~^ ~}~^ ~}~}" #(#(#(1 2) (3 4)))) "1 2 3 4")
+(test (format #f "~{~{~{~A~^ ~}~^ ~}~}" #(#(#(1 2) #(3 4)))) "1 2 3 4")
+(test (format #f "~{~{~C~^ ~}~^ ~}" (list "hiho" "xxx")) "h i h o x x x")
+(test (format #f "~{~{~A~}~}" '((1 . 2) (3 . 4))) 'error)
+(test (format #f "~{~A~^ ~}" '((1 . 2) (3 . 4))) "(1 . 2) (3 . 4)")
+(test (format #f "~{~A ~}" (hash-table)) "")
+(test (format #f "~{~^~S ~}" (make-iterator '(1 2 3))) "1 2 3 ")
+(test (format #f "~{~^~S ~}" (make-iterator (let ((lst (list 1))) (set-cdr! lst lst)))) "1 ")
+(test (format #f "~{~^~S ~}" (make-iterator "")) "")
+(test (format #f "~{~^~S ~}" (make-iterator #(1 2 3))) "1 2 3 ")
+(test (format #f "~{~{~{~{~{~A~^ ~}~^ ~}~}~}~}" '(((((1 2) (3 4)))))) "1 2 3 4")
+(test (format #f "~{~{~{~{~{~{~{~{~A~^ ~}~^ ~}~}~}~}~}~}~}" '((((((((1 2) (3 4))))))))) "1 2 3 4")
+(test (format #f "~{~{~{~{~{~{~{~{~{~{~{~A~^ ~}~^ ~}~}~}~}~}~}~}~}~}~}" '(((((((((((1 2) (3 4)))))))))))) "1 2 3 4")
+
+(test (format #f "~10,'-T") "---------")
+(test (format #f "~10,'\\T") "\\\\\\\\\\\\\\\\\\")
+(test (format #f "~10,'\"T") "\"\"\"\"\"\"\"\"\"")
+(test (format #f "~10,'-T12345~20,'-T") "---------12345-----")
+(test (format #f "~10,')T") ")))))))))")
+
+(test (format #f "~,0F" 1.4) "1.0")
+(test (format #f "~,0F" 1.5) "2.0")
+(test (format #f "~,0F" 1.6) "2.0")
+(test (format #f "~,0F" 0.4) "0.0")
+(test (format #f "~,0F" 0.5) (if (not with-windows) "0.0" "1.0")) ; !!
+(test (format #f "~,0F" 0.6) "1.0")
+(test (format #f "~,-0F" 1.4) 'error)
+(test (format #f "~, 0F" 1.4) 'error)
+(test (format #f "~*1~*" 1) 'error)
+(test (format #f "~*1~A" 1) 'error)
+(test (format #f #u()) 'error)
+(test (format #f #u(65 90)) 'error)
+
+;; optimizer bug
+(test (let () (define (func) (format `((x)) "")) (define (hi) (func)) (hi)) 'error)
+(test (let () (define (func) (format (make-iterator #(10 20)) #u())) (define (hi) (func)) (hi)) 'error)
+(test (let () (define (func) (format (list 1 2) "")) (define (hi) (func)) (hi)) 'error)
+(test (format :rest "") 'error)
+
+(let* ((str1 #t) (str2 (with-output-to-string (lambda () (set! str1 (format () "~D" 1)))))) (test (and (equal? str1 "") (equal? str2 "1")) #t))
+
+(test (format #f "~,'") 'error)
+(if with-bignums
+    (begin
+      (test (format #f "~F" 1e300) "9.999999999999999999999999999999999999987E299")
+      (test (format #f "~F" 1e308) "9.999999999999999999999999999999999999982E307")
+      (test (format #f "~G" 1e308) "9.999999999999999999999999999999999999982E307")
+      (test (format #f "~E" 1e308)  "9.999999999999999999999999999999999999982E307")
+      (test (format #f "~E" 1e308+1e308i) "9.999999999999999999999999999999999999982E307+9.999999999999999999999999999999999999982E307i")
+      (test  (format #f "~F" 1e308+1e308i) "9.999999999999999999999999999999999999982E307+9.999999999999999999999999999999999999982E307i")
+      (test (format #f "~F" -1e308-1e308i) "-9.999999999999999999999999999999999999982E307-9.999999999999999999999999999999999999982E307i")
+      (test (format #f "~,32f" (/ 1.0 most-positive-fixnum)) "1.084202172485504434125002235952170462235E-19")
+      (test (format #f "~{~^~f ~}" (vector 1e308)) "9.999999999999999999999999999999999999982E307 ")
+      (test (object->string (vector 1e308)) "#(9.999999999999999999999999999999999999982E307)"))
+    (begin
+      (test (format #f "~F" 1e300) "1000000000000000052504760255204420248704468581108159154915854115511802457988908195786371375080447864043704443832883878176942523235360430575644792184786706982848387200926575803737830233794788090059368953234970799945081119038967640880074652742780142494579258788820056842838115669472196386865459400540160.000000")
+      (test (format #f "~F" 1e308) "100000000000000001097906362944045541740492309677311846336810682903157585404911491537163328978494688899061249669721172515611590283743140088328307009198146046031271664502933027185697489699588559043338384466165001178426897626212945177628091195786707458122783970171784415105291802893207873272974885715430223118336.000000")
+      (test (format #f "~G" 1e308) "1e+308")
+      (test (format #f "~E" 1e308) "1.000000e+308")
+      (test (format #f "~E" 1e308+1e308i) "1.000000e+308+1.000000e+308i")
+      (test  (format #f "~F" 1e308+1e308i) "100000000000000001097906362944045541740492309677311846336810682903157585404911491537163328978494688899061249669721172515611590283743140088328307009198146046031271664502933027185697489699588559043338384466165001178426897626212945177628091195786707458122783970171784415105291802893207873272974885715430223118336.000000+100000000000000001097906362944045541740492309677311846336810682903157585404911491537163328978494688899061249669721172515611590283743140088328307009198146046031271664502933027185697489699588559043338384466165001178426897626212945177628091195786707458122783970171784415105291802893207873272974885715430223118336.000000i")
+      (test (format #f "~F" -1e308-1e308i) "-100000000000000001097906362944045541740492309677311846336810682903157585404911491537163328978494688899061249669721172515611590283743140088328307009198146046031271664502933027185697489699588559043338384466165001178426897626212945177628091195786707458122783970171784415105291802893207873272974885715430223118336.000000-100000000000000001097906362944045541740492309677311846336810682903157585404911491537163328978494688899061249669721172515611590283743140088328307009198146046031271664502933027185697489699588559043338384466165001178426897626212945177628091195786707458122783970171784415105291802893207873272974885715430223118336.000000i")
+      (test (format #f "~,32f" (/ 1.0 most-positive-fixnum)) "0.00000000000000000010842021724855")
+      (test (format #f "~{~^~f ~}" (vector 1e308)) "100000000000000001097906362944045541740492309677311846336810682903157585404911491537163328978494688899061249669721172515611590283743140088328307009198146046031271664502933027185697489699588559043338384466165001178426897626212945177628091195786707458122783970171784415105291802893207873272974885715430223118336.000000 ")
+      (test (object->string (vector 1e308)) "#(1e+308)")))
+
+
+(when full-s7test
+  (let ()
+    (define ctrl-chars (vector ;#\A #\S #\C #\F #\E #\G #\O #\D #\B #\X #\W
+			#\, #\{ #\} #\@ #\P #\* #\< #\>
+			#\a #\s #\c #\f #\e #\g #\o #\d #\b #\x #\p #\n #\w
+			#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
+			#\~ #\T #\& #\% #\^ #\|
+			#\~ #\~ #\~ #\~
+			#\, #\, #\, #\, #\" #\" #\\ #\'
+			#\+ #\- #\@ #\. #\/ #\; #\:
+			))
+    (define ctrl-chars-len (length ctrl-chars))
+
+    (define (test-chars)
+      (do ((size 1 (+ size 1)))
+	  ((= size 7))
+	(let ((tries (* size size 10000)))
+	  (format *stderr* "~D " size)
+	  (let ((ctrl-str (make-string (+ size 1)))
+		(x 12)
+		(y '(1 2))
+		(z #\a))
+	    (string-set! ctrl-str 0 #\~)
+	    (do ((i 0 (+ i 1)))
+		((= i tries))
+	      (do ((j 1 (+ j 1)))
+		  ((> j size))
+		(string-set! ctrl-str j (vector-ref ctrl-chars (random ctrl-chars-len))))
+					;(format *stderr* "~S " ctrl-str)
+					;(catch #t (lambda () (format *stderr* "~S: ~A~%" ctrl-str (format #f ctrl-str))) (lambda arg 'error))
+					;(catch #t (lambda () (format *stderr* "~S ~A: ~A~%" ctrl-str x (format #f ctrl-str x))) (lambda arg 'error))
+					;(catch #t (lambda () (format *stderr* "~S ~A: ~A~%" ctrl-str y (format #f ctrl-str y))) (lambda arg 'error))
+					;(catch #t (lambda () (format *stderr* "~S ~A: ~A~%" ctrl-str z (format #f ctrl-str z))) (lambda arg 'error)))))
+	      (catch #t (lambda () (format #f ctrl-str)) (lambda arg 'error))
+	      (catch #t (lambda () (format #f ctrl-str x)) (lambda arg 'error))
+	      (catch #t (lambda () (format #f ctrl-str y)) (lambda arg 'error))
+	      (catch #t (lambda () (format #f ctrl-str z)) (lambda arg 'error))
+	      (catch #t (lambda () (format #f ctrl-str x x)) (lambda arg 'error))
+	      (catch #t (lambda () (format #f ctrl-str x y)) (lambda arg 'error))
+	      (catch #t (lambda () (format #f ctrl-str y z)) (lambda arg 'error))
+	      (catch #t (lambda () (format #f ctrl-str x y z)) (lambda arg 'error)))))
+	))
+    (test-chars)))
+
+
+(test (reverse (format #f "~{~A~}" '((1 2) (3 4)))) ")4 3()2 1(")
+(test (string->symbol (format #f "~A" '(1 2))) (symbol "(1 2)"))
+
+(test (string->number (format #f "~A" -1)) -1)
+(test (string->number (format #f "~S" -1)) -1)
+(test (string->number (format #f "~F" -1)) -1)
+(test (string->number (format #f "~D" -1)) -1)
+(test (string->number (format #f "~G" -1)) -1)
+(test (string->number (format #f "~E" -1)) -1)
+(test (string->number (format #f "~B" -1)) -1)
+(test (string->number (format #f "~X" -1)) -1)
+(test (string->number (format #f "~O" -1)) -1)
+(num-test (string->number (format #f "~A" 1.5)) 1.5)
+(num-test (string->number (format #f "~S" 1.5)) 1.5)
+(num-test (string->number (format #f "~F" 1.5)) 1.5)
+(num-test (string->number (format #f "~D" 1.5)) 1.5)
+(num-test (string->number (format #f "~G" 1.5)) 1.5)
+(num-test (string->number (format #f "~E" 1.5)) 1.5)
+(num-test (string->number (format #f "~B" 1.5)) 1.1)
+(num-test (string->number (format #f "~X" 1.5)) 1.8)
+(num-test (string->number (format #f "~O" 1.5)) 1.4)
+(num-test (string->number (format #f "~A" 1+1i)) 1+1i)
+(num-test (string->number (format #f "~S" 1+1i)) 1+1i)
+(num-test (string->number (format #f "~F" 1+1i)) 1+1i)
+(num-test (string->number (format #f "~D" 1+1i)) 1+1i)
+(num-test (string->number (format #f "~G" 1+1i)) 1+1i)
+(num-test (string->number (format #f "~E" 1+1i)) 1+1i)
+(num-test (string->number (format #f "~B" 1+1i)) 1+1i)
+(num-test (string->number (format #f "~X" 1+1i)) 1+1i)
+(num-test (string->number (format #f "~O" 1+1i)) 1+1i)
+(test (string->number (format #f "~A" 3/4)) 3/4)
+(test (string->number (format #f "~S" 3/4)) 3/4)
+(test (string->number (format #f "~F" 3/4)) 3/4)
+(test (string->number (format #f "~D" 3/4)) 3/4)
+(test (string->number (format #f "~G" 3/4)) 3/4)
+(test (string->number (format #f "~E" 3/4)) 3/4)
+(test (string->number (format #f "~B" 3/4)) 11/100)
+(test (string->number (format #f "~X" 3/4)) 3/4)
+(test (string->number (format #f "~O" 3/4)) 3/4)
+(num-test (string->number (format #f "~A" 0+1i)) 0+1i)
+(num-test (string->number (format #f "~S" 0+1i)) 0+1i)
+(num-test (string->number (format #f "~F" 0+1i)) 0+1i)
+(num-test (string->number (format #f "~D" 0+1i)) 0+1i)
+(num-test (string->number (format #f "~G" 0+1i)) 0+1i)
+(num-test (string->number (format #f "~E" 0+1i)) 0+1i)
+(num-test (string->number (format #f "~B" 0+1i)) 0+1i)
+(num-test (string->number (format #f "~X" 0+1i)) 0+1i)
+(num-test (string->number (format #f "~O" 0+1i)) 0+1i)
+
+(test (format #f "~P{T}'" 1) "{T}'")
+(test (format #f "~") 'error)
+(test (format #f "~B&B~X" 1.5 1.5) "1.1&B1.8")
+(test (format #f ",~~~A~*1" 1 1) ",~11")
+(test (format #f "~D~20B" 0 0) "0                   0")
+(test (format #f "~D~20B" 1 1) "1                   1")
+(test (format #f "~10B" 1) "         1")
+(test (format #f "~10B" 0) "         0")
+(test (format #f "~100B" 1) "                                                                                                   1")
+(test (length (format #f "~1000B" 1)) 1000)
+(test (format #f "~D~20D" 3/4 3/4) "3/4                 3/4")
+(test (length (format #f "~20D" 3/4)) 20)
+(test (format #f "~20B" 3/4) "              11/100")
+(test (length (format #f "~20B" 3/4)) 20)
+(test (format #f "~D~20B" 3/4 3/4) "3/4              11/100")
+(test (format #f "~X~20X" 21/33 21/33) "7/b                 7/b")
+(test (format #f "~D~20,'.B" 3/4 3/4) "3/4..............11/100")
+(test (format #f "~20g" 1+i) "            1.0+1.0i")
+(test (length (format #f "~20g" 1+i)) 20)
+(test (format #f "~20f" 1+i) "  1.000000+1.000000i")
+(test (length (format #f "~20f" 1+i)) 20)
+(test (format #f "~20x" 17+23i) "          11.0+17.0i")
+(test (length (format #f "~20x" 17+23i)) 20)
+
+(test (format #f "~{~{~A~^~} ~}" (hash-table '(a . 1) '((b . 2)))) "(a . 1)(b . 2) ")
+(test (format #f "~{~{~A~^~}~^~}" (hash-table '(a . 1) '((b . 2)))) "(a . 1)(b . 2)")
+(test (format #f "~{~{~A~^ ~}~^~}" (hash-table '(a . 1) '((b . 2)))) "(a . 1) (b . 2)")
+(test (format #f "~{~{~{~A~^~} ~}~}" #(())) "")
+(test (format #f "~{~{~{~P~^~} ~}~}" '((()))) " ")
+(test (format #f "~{~{~{~P~^~}~}~}" '(((2 3 4)))) "sss")
+(test (apply format #f "~T~~{~{~{~*~~0~1~*~}~@~}" '(())) "~{")
+(test (format #f "~{~S}%~}" '(a b c)) "a}%b}%c}%")
+(test (format #f "~&~^%~F." 0) "%0.")
+(test (format #f "1~^2") "1")
+(test (apply format #f "~P~d~B~~" '(1 2 3)) "211~")
+(test (format #f "~T1~~^~P" 0) "1~^s")
+(test (format #f "~S~^~{~^" '(+ x 1)) "(+ x 1)")
+(test (format #f "1~^~{2") "1")
+(test (format #f "~A~{~0~g~@~B~}" () ()) "()")
+(test (format #f "1~^~^~^2") "1")
+(test (format #f "~{~{~~}~~,~}~*" '(()) '(())) "~,")
+(test (format #f "~~S~S~T~~C~g~~" 0 0) "~S0~C0~")
+(test (format #f "~{~~e~}~~{~*~~" "" "") "~{~")
+
+(let ()
+  (define* (clean-string e (precision 3))
+    (format #f (format #f "(~~{~~,~DF~~^ ~~})" precision) e))
+  (test (clean-string '(1.123123 -2.31231323 3.141592653589 4/3) 1) "(1.1 -2.3 3.1 4/3)")
+  (test (clean-string '(1.123123 -2.31231323 3.141592653589 4/3)) "(1.123 -2.312 3.142 4/3)")
+  (test (clean-string '(1.123123 -2.31231323 3.141592653589 4/3) 6) "(1.123123 -2.312313 3.141593 4/3)"))
+
+(when with-bignums
+  (test (format #f "~P" (bignum "1")) "")
+  (test (format #f "~P" (bignum "1.0")) "")
+  (test (format #f "~P" (bignum "2")) "s")
+  (test (format #f "~P" (bignum "2.0")) "s")
+  (test (format #f "~10,' D" (bignum "1")) "         1")
+  (test (format #f "~10,' D" (bignum "3/4")) "       3/4")
+  (test (format #f "~10,'.D" (bignum "3/4")) ".......3/4")
+  (test (format #f "~10D" (bignum "3/4")) "       3/4")
+  (test (length (format #f "~100D" (bignum "34"))) 100)
+  (test (format #f "~50F" (bignum "12345678.7654321")) "                                1.23456787654321E7"))
+
+(test (format #f "~W" (float-vector +nan.0)) "#r(+nan.0)")
+(test (format #f "~W" (float-vector -3/4 +nan.0)) "#r(-0.75 +nan.0)")
+(test (format #f "~W" (float-vector -nan.0 +nan.0)) "#r(+nan.0 +nan.0)")
+(test (format #f "~W" (float-vector +nan.0 +inf.0)) "#r(+nan.0 +inf.0)")
+(test (format #f "~W" (float-vector +nan.0 -3/4)) "#r(+nan.0 -0.75)")
+(test (format #f "~W" (float-vector -inf.0 +inf.0)) "#r(-inf.0 +inf.0)")
+
+
+(call-with-output-file tmp-output-file (lambda (p) (format p "this ~A ~C test ~D" "is" #\a 3)))
+(let ((res (call-with-input-file tmp-output-file (lambda (p) (read-line p)))))
+  (if (not (string=? res "this is a test 3"))
+      (begin
+	(display "call-with-input-file + format to \"tmp1.r5rs\" ... expected \"this is a test 3\", but got \"")
+	(display res) (display "\"?") (newline))))
+
+(let ((val (format #f "line 1~%line 2~%line 3")))
+  (with-input-from-string val
+    (lambda ()
+      (let ((line1 (read-line)))
+	(test (string=? line1 "line 1") #t))
+      (let ((line2 (read-line)))
+	(test (string=? line2 "line 2") #t))
+      (let ((line3 (read-line)))
+	(test (string=? line3 "line 3") #t))
+      (let ((eof (read-line)))
+	(test (eof-object? eof) #t))
+      (let ((eof (read-line)))
+	(test (eof-object? eof) #t)))))
+
+(test (display 3 #f) 3)
+(test (write 3 #f) 3)
+
+(let ((val (format #f "line 1~%line 2~%line 3")))
+  (call-with-input-string val
+			  (lambda (p)
+			    (let ((line1 (read-line p #t)))
+			      (test (string=? line1 (string-append "line 1" (string #\newline))) #t))
+			    (let ((line2 (read-line p #t)))
+			      (test (string=? line2 (string-append "line 2" (string #\newline))) #t))
+			    (let ((line3 (read-line p #t)))
+			      (test (string=? line3 "line 3") #t))
+			    (let ((eof (read-line p #t)))
+			      (test (eof-object? eof) #t))
+			    (let ((eof (read-line p #t)))
+			      (test (eof-object? eof) #t)))))
+
+(let ((res1 #f)
+      (res2 #f))
+  (let ((this-file (open-output-string)))
+    (format this-file "this ~A ~C test ~D" "is" #\a 3)
+    (set! res1 (get-output-string this-file))
+    (set! res2 (port-string this-file))
+    (close-output-port this-file))
+  (unless (string=? res1 "this is a test 3")
+    (format #t "open-output-string + format + get-output-string expected ~S but got ~S\n" "this is a test 3" res1))
+  (unless (string=? res2 "this is a test 3")
+    (format #t "open-output-string + format + port-string expected ~S but got ~S\n" "this is a test 3" res2)))
+
+(test (with-output-to-string (lambda () (display 123) (flush-output-port))) "123")
+(test (with-output-to-string (lambda () (display 123) (flush-output-port) (display 124))) "123124")
+
+(when (provided? 'linux) ; gets "operation not permitted" in osx
+  (test (catch #t (lambda ()
+                    (call-with-output-file "/dev/full"
+                      (lambda (p) (display 123 p) (flush-output-port p))))
+                  (lambda (typ info)
+                    (apply format #f info)))
+        "flush-output-port: No space left on device \"/dev/full\""))
+
+(test (call-with-output-string
+       (lambda (p)
+	 (write 1 p)
+	 (display 2  p)
+	 (format p "~D" 3)
+	 (write-byte (char->integer #\4) p)
+	 (write-char #\5 p)
+	 (write-string "6" p)
+	 (write 1 #f)
+	 (display 2 #f)
+	 (format #f "~D" 3)
+	 (write-byte (char->integer #\4) #f)
+	 (write-char #\5 #f)
+	 (write-string "6" #f)))
+      "123456")
+
+(test (write-byte most-positive-fixnum #f) 'error)
+(test (write-byte -1 #f) 'error)
+(test (write-byte 256 #f) 'error)
+
+(let ((res #f))
+  (let ((this-file (open-output-string)))
+    (format this-file "this is a test")
+    (set! res (get-output-string this-file))
+    (if (not (string=? res "this is a test"))
+	(format #t "open-output-string + format expected \"this is a test\", but got ~S~%" res))
+    (flush-output-port this-file)
+    (set! res (get-output-string this-file))
+    (if (not (string=? res "this is a test"))
+	(format #t "flush-output-port of string port expected \"this is a test\", but got ~S~%" res))
+    (format this-file "this is a test")
+    (set! res (get-output-string this-file))
+    (if (not (string=? res "this is a testthis is a test"))
+	(format #t "open-output-string after flush expected \"this is a testthis is a test\", but got ~S~%" res))
+    (close-output-port this-file)
+    (test (flush-output-port this-file) this-file)))
+
+(test (flush-output-port "hiho") 'error)
+(test (flush-output-port *stdin*) 'error)
+
+(call-with-output-file tmp-output-file
+  (lambda (p)
+    (format p "123456~%")
+    (format p "67890~%")
+    (flush-output-port p)
+    (test (call-with-input-file tmp-output-file
+	    (lambda (p)
+	      (read-line p)))
+	  "123456")
+    (close-output-port p)))
+
+(let ((res1 #f)
+      (res2 #f)
+      (res3 #f))
+  (let ((p1 (open-output-string)))
+    (format p1 "~D" 0)
+    (let ((p2 (open-output-string)))
+      (format p2 "~D" 1)
+      (let ((p3 (open-output-string)))
+	(if (not (string=? (get-output-string p1) "0"))
+	    (format #t ";format to nested ports, p1: ~S~%" (get-output-string p1)))
+	(if (not (string=? (get-output-string p2) "1"))
+	    (format #t ";format to nested ports, p2: ~S~%" (get-output-string p2)))
+	(format p3 "~D" 2)
+	(format p2 "~D" 3)
+	(format p1 "~D" 4)
+	(format p3 "~D" 5)
+	(set! res3 (get-output-string p3))
+	(close-output-port p3)
+	(if (not (string=? (get-output-string p1) "04"))
+	    (format #t ";format to nested ports after close, p1: ~S~%" (get-output-string p1)))
+	(if (not (string=? (get-output-string p2) "13"))
+	    (format #t ";format to nested ports after close, p2: ~S~%" (get-output-string p2))))
+      (format (or p1 p3) "~D" 6)
+      (format (and p1 p2) "~D" 7)
+      (set! res1 (get-output-string p1))
+      (close-output-port p1)
+      (if (not (string=? (get-output-string p2) "137"))
+	  (format #t ";format to nested ports after 2nd close, p2: ~S~%" (get-output-string p2)))
+      (format p2 "~D" 8)
+      (set! res2 (get-output-string p2))
+      (test (get-output-string p1) 'error)
+      (test (get-output-string p2 "hi") 'error)
+      (close-output-port p2)))
+  (if (not (string=? res1 "046"))
+      (format #t ";format to nested ports, res1: ~S~%" res1))
+  (if (not (string=? res2 "1378"))
+      (format #t ";format to nested ports, res2: ~S~%" res2))
+  (if (not (string=? res3 "25"))
+      (format #t ";format to nested ports, res3: ~S~%" res3)))
+
+(test (call/cc (lambda (return)
+		 (let ((val (format #f "line 1~%line 2~%line 3")))
+		   (call-with-input-string val
+					   (lambda (p) (return "oops"))))))
+      "oops")
+
+(test (get-output-string #f 64) 'error)
+
+;(format #t "format #t: ~D" 1)
+;(format (current-output-port) " output-port: ~D! (this is testing output ports)~%" 2)
+
+(call-with-output-file tmp-output-file
+  (lambda (p)
+    (display 1 p)
+    (write 2 p)
+    (write-char #\3 p)
+    (format p "~D" 4)
+    (write-byte (char->integer #\5) p)
+    (call-with-output-file "tmp2.r5rs"
+      (lambda (p)
+	(display 6 p)
+	(write 7 p)
+	(write-char #\8 p)
+	(format p "~D" 9)
+	(write-byte (char->integer #\0) p)
+	(newline p)))
+    (call-with-input-file "tmp2.r5rs"
+      (lambda (pin)
+	(display (read-line pin) p)))
+    (newline p)))
+
+(test (call-with-input-file tmp-output-file
+	(lambda (p)
+	  (read-line p)))
+      "1234567890")
+
+(call-with-output-file tmp-output-file
+  (lambda (p)
+    (format p "12345~%")
+    (format p "67890~%")))
+
+(call-with-input-file tmp-output-file
+  (lambda (p)
+    (test (read-char p) #\1)
+    (test (read-byte p) (char->integer #\2))
+    (test (peek-char p) #\3)
+    (if (not pure-s7) (test (char-ready? p) #t))
+    (test (read-line p) "345")
+    (test (read-line p) "67890")))
+
+(call-with-output-file tmp-output-file
+  (lambda (p)
+    (write-string "123" p)
+    (write-string "" p)
+    (write-string "456\n789" p)))
+
+(call-with-input-file tmp-output-file
+  (lambda (p)
+    (test (read-line p) "123456")
+    (test (read-char p) #\7)
+    (test (read-char p) #\8)
+    (test (read-char p) #\9)
+    (test (eof-object? (read-char p)) #t)))
+
+(test (with-output-to-string
+	(lambda ()
+	  (write-string "123")
+	  (write-string "")
+	  (write-string "456")))
+      "123456")
+
+(test (with-output-to-string
+	(lambda ()
+	  (write-string "123" (current-output-port))
+	  (write-string "" (current-output-port))
+	  (write-string "456" (current-output-port))
+	  (write-string "678" (current-output-port) 1)
+	  (write-string "679" (current-output-port) 2 3)
+	  (write-string "079" (current-output-port) 0 1)
+	  (write-string "123" (current-output-port) 0 3)
+	  (write-string "123" (current-output-port) 3 3)
+	  (write-string "" (current-output-port) 0 0)
+	  (write-string "1423" (current-output-port) 1 1) ; 1.3.3: end is exclusive, if start=end, empty result
+	  (write-string "1423" (current-output-port) 1 4/2)
+	  (write-string "5423" (current-output-port) -0 1)))
+      "123456789012345")
+
+(test (write-string "12345" -1) 'error)
+(test (write-string "12345" 0 -1) 'error)
+(test (write-string "12345" 0 18) 'error)
+(test (write-string "12345" 18) 'error)
+(test (write-string "12345" 2 1) 'error)
+(test (write-string "12345" 5 5) 'error)
+(test (write-string "12345" 0.0 2) 'error)
+(test (write-string "12345" 0 2.0) 'error)
+(test (write-string "12345" 0 1+i) 'error)
+(test (write-string "12345" 0 2/3) 'error)
+(test (write-string "12345" 0 #\a) 'error)
+(test (write-string "12345" #\null) 'error)
+(test (write-string "12345" most-negative-fixnum) 'error)
+(test (write-string "12345" 0 most-positive-fixnum) 'error)
+(test (write-string "12345" 0 4294967296) 'error)
+(test (write-string "a" #f 1) "")
+(test (write-string "abc" #f 3) "")
+(test (write-string "ab" #f 1) "b")
+(test (write-string "ab" #f 2) "")
+(test (write-string "abc" #f 1 2) "b")
+(test (write-string "abc" #f 1 3) "bc")
+
+(test (with-input-from-string "12345" (lambda () (read-string 3))) "123")
+(test (with-input-from-string "" (lambda () (read-string 3))) #<eof>)
+(test (with-input-from-string "" (lambda () (read-string 0))) "")
+(test (with-input-from-string "1" (lambda () (read-string 0))) "")
+(test (with-input-from-string "1" (lambda () (read-string -1))) 'error)
+(test (with-input-from-string "1" (lambda () (read-string #f))) 'error)
+(test (with-input-from-string "123" (lambda () (read-string 10))) "123")
+(test (call-with-input-string "123" (lambda (p) (read-string 2 p))) "12")
+(test (call-with-input-string "123" (lambda (p) (read-string 2 #f))) 'error)
+(test (call-with-input-string "123" (lambda (p) (read-string 2 (current-output-port)))) 'error)
+(test (call-with-input-string "123" (lambda (p) (read-string 0 #<unspecified>))) 'error)
+(test (call-with-input-string "123" (lambda (p) (read-string 0 123))) 'error)
+
+(test (read-string most-positive-fixnum) 'error)
+(test (read-string -1) 'error)
+(test (read-string most-negative-fixnum) 'error)
+;(test (read-string 0) "")
+; (test (read-string 123) "")
+; s7 considers this file (during load) to be the current-input-file, so the above read-string ruins the load
+; the other choice is to hang (waiting for stdin)
+; perhaps this choice should be documented since it is specifically contrary to r7rs
+
+(test (write 1 (current-input-port)) 'error)
+(test (write-char #\a (current-input-port)) 'error)
+(test (write-byte 0 (current-input-port)) 'error)
+(test (read (current-output-port)) 'error)
+(test (read-char (current-output-port)) 'error)
+(test (read-byte (current-output-port)) 'error)
+(test (read-line (current-output-port)) 'error)
+(test (display 3) 3)
+(test (display 3 #f) 3)
+
+(unless pure-s7
+  (let ((op1 (set-current-output-port (open-output-file tmp-output-file))))
+    (display 1)
+    (write 2)
+    (write-char #\3)
+    (format #t "~D" 4) ; #t -> output port
+    (write-byte (char->integer #\5))
+    (let ((op2 (set-current-output-port (open-output-file "tmp2.r5rs"))))
+      (display 6)
+      (write 7)
+      (write-char #\8)
+      (format #t "~D" 9)
+      (write-byte (char->integer #\0))
+      (newline)
+      (close-output-port (current-output-port))
+      (set-current-output-port op2)
+      (let ((ip1 (set-current-input-port (open-input-file "tmp2.r5rs"))))
+	(display (read-line))
+	(close-input-port (current-input-port))
+	(set-current-input-port ip1))
+      (newline)
+      (close-output-port (current-output-port)))
+
+    (set-current-output-port #f)
+    (test (string? (format #t "~%")) #t)
+    (write "write: should not appear" #f) (newline #f)
+    (display "display: should not appear" #f) (newline #f)
+    (format #f "format: should not appear") (newline #f)
+    (write-string "write-string: should not appear" #f) (newline #f)
+    (write-char #\! #f)
+    (write-byte 123 #f)
+
+    (write "write: should not appear" (current-output-port)) (newline (current-output-port))
+    (display "display: should not appear" (current-output-port)) (newline (current-output-port))
+    (format (current-output-port) "format: should not appear") (newline (current-output-port))
+    (write-string "write-string: should not appear" (current-output-port)) (newline (current-output-port))
+    (write-char #\! (current-output-port))
+    (write-byte 123 (current-output-port))
+
+    (write "write: should not appear") (newline)
+    (display "display: should not appear") (newline)
+    (format #t "format: should not appear") (newline)
+    (write-string "write-string: should not appear") (newline)
+    (write-char #\!)
+    (write-byte 123)
+
+    (set-current-output-port op1))
+
+  (let ((op1 (open-output-file tmp-output-file)))
+    (let-temporarily (((current-output-port) op1))
+      (display 1)
+      (write 2)
+      (write-char #\3)
+      (format #t "~D" 4) ; #t -> output port
+      (write-byte (char->integer #\5))
+      (let ((op2 (open-output-file "tmp2.r5rs")))
+	(let-temporarily (((current-output-port) op2))
+	  (display 6)
+	  (write 7)
+	  (write-char #\8)
+	  (format #t "~D" 9)
+	  (write-byte (char->integer #\0))
+	  (newline)
+	  (close-output-port (current-output-port)))
+	(let ((ip1 (open-input-file "tmp2.r5rs")))
+	  (let-temporarily (((current-input-port) ip1))
+	    (display (read-line))
+	    (close-input-port (current-input-port))))
+	(newline)
+	(close-output-port (current-output-port)))))
+
+  (test (call-with-input-file tmp-output-file
+	  (lambda (p)
+	    (read-line p)))
+	"1234567890"))
+
+(for-each
+ (lambda (op)
+   (for-each
+    (lambda (arg)
+      (test (op arg display) 'error))
+    (list 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
+ (list call-with-output-file call-with-input-file
+       call-with-output-string call-with-input-string
+       with-input-from-string with-input-from-file
+       with-output-to-file))
+
+(for-each
+ (lambda (op)
+   (for-each
+    (lambda (arg)
+      (test (op arg) 'error))
+    (list 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
+ (list open-output-file open-input-file
+       open-input-string))
+
+(for-each
+ (lambda (op)
+   (for-each
+    (lambda (arg)
+      (test (op "hi" arg) 'error))
+    (list "hi" 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #t :hi (if #f #f) (lambda (a) (+ a 1)))))
+ (list write display write-byte newline write-char
+       read read-char read-byte peek-char char-ready? read-line))
+
+(for-each
+ (lambda (arg)
+   (test (write-char arg) 'error)
+   (test (write-byte arg) 'error)
+   (test (read-char arg) 'error)
+   (test (read-byte arg) 'error)
+   (test (peek-char arg) 'error)
+   (test (write-char #\a arg) 'error)
+   (test (write-byte 1 arg) 'error))
+ (list "hi" 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (write-byte -1) 'error)
+(test (write-byte most-positive-fixnum) 'error)
+(test (write-byte 300) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (write-string arg) 'error)
+   (test (write-string "hi" arg) 'error))
+ (list 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (with-output-to-string (lambda () (newline #f))) "")
+(test (with-output-to-string (lambda () (write-byte 95 #f))) "")
+(test (with-output-to-string (lambda () (write-char #\a #f))) "")
+(test (with-output-to-string (lambda () (write-string "a" #f))) "")
+(test (with-output-to-string (lambda () (write "hiho" #f))) "")
+(test (with-output-to-string (lambda () (display "hiho" #f))) "")
+(test (with-output-to-string (lambda () (format #f "hiho"))) "")
+
+(unless pure-s7
+  (test (with-output-to-string
+	  (lambda ()
+	    (set! (current-output-port) #f)
+	    (newline (current-output-port))
+	    (write-byte 95 (current-output-port))
+	    (write-char #\a (current-output-port))
+	    (write-string "a" (current-output-port))
+	    (write "hiho" (current-output-port))
+	    (display "hiho" (current-output-port))
+	    (format (current-output-port) "hiho")))
+	"")
+  (set! (current-output-port) *stdout*))
+
+(let-temporarily (((current-output-port) #f)
+                  ((*s7* 'max-string-length) 32))
+  (catch #t
+    (lambda ()
+      (with-output-to-string
+	(lambda ()
+	  (display
+	   (symbol
+	    (make-string (*s7* 'max-string-length)))))))
+    (lambda args
+      'error))
+  (when (current-output-port)
+    (format *stderr* "current-output-port is ~S~%" (current-output-port))))
+
+(for-each
+ (lambda (op)
+   (for-each
+    (lambda (arg)
+      (test (op arg) 'error))
+    (list "hi" 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs :hi (if #f #f) (lambda (a) (+ a 1)))))
+ (list set-current-input-port set-current-error-port set-current-output-port close-input-port close-output-port))
+
+(let ((hi (open-output-string)))
+  (test (get-output-string hi) "")
+  (close-output-port hi)
+  (test (get-output-string hi) 'error))
+
+(test (open-output-string "hiho") 'error)
+(test (with-output-to-string "hi") 'error)
+(test (call-with-output-string "hi") 'error)
+
+(test (get-output-string 1 2) 'error)
+(test (get-output-string) 'error)
+(for-each
+ (lambda (arg)
+   (test (get-output-string arg) 'error))
+ (list "hi" 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(let ((p (open-output-string)))
+  (write 123 p)
+  (test (get-output-string p) "123")
+  (write 124 p)
+  (test (get-output-string p #t) "123124")
+  (test (get-output-string p #t) "")
+  (write 123 p)
+  (test (get-output-string p) "123"))
+
+;; since read of closed port will generate garbage, it needs to be an error,
+;;   so I guess write of closed port should also be an error
+
+(let ((hi (open-output-string)))
+  (close-output-port hi)
+  (for-each
+   (lambda (op)
+     (test-e (op hi) (object->string op) 'closed-port))
+   (list (lambda (p) (display 1 p))
+	 (lambda (p) (write 1 p))
+	 (lambda (p) (write-char #\a p))
+	 (lambda (p) (write-byte 0 p))
+	 (lambda (p) (format p "hiho"))
+	 (if pure-s7 newline set-current-output-port)
+	 (if pure-s7 newline set-current-input-port)
+	 set-current-error-port
+	 newline)))
+
+(let ((hi (open-input-string "hiho")))
+  (test (get-output-string hi) 'error)
+  (close-input-port hi)
+  (for-each
+   (lambda (op)
+     (test-e (op hi) (object->string op) 'closed-port))
+   (list read read-char read-byte peek-char read-line
+	 port-filename port-line-number
+	 (if pure-s7 read-line char-ready?)
+	 (if pure-s7 read-line set-current-output-port)
+	 (if pure-s7 read-line set-current-input-port)
+	 set-current-error-port
+	 )))
+
+(test (close-output-port (open-input-string "hiho")) 'error)
+(test (close-input-port (open-output-string)) 'error)
+(test (set! (port-filename) "hiho") 'error)
+(test (set! (port-closed? (current-output-port)) "hiho") 'error)
+(test (begin (close-output-port *stderr*) (port-closed? *stderr*)) #f)
+(test (begin (close-output-port *stdout*) (port-closed? *stdout*)) #f)
+(test (begin (close-input-port *stdin*) (port-closed? *stdin*)) #f)
+
+(test (call-with-output-file "test.data" port-filename) "test.data")
+(test (call-with-input-file "s7test.scm" port-filename) "s7test.scm")
+(if (provided? 'linux) (test (with-input-from-file "/proc/cpuinfo" port-filename) "/proc/cpuinfo"))
+(test (call-with-output-file "/dev/null" port-filename) "/dev/null")
+(test (port-filename (open-output-string)) "") ; malloc garbage if not cleared in open_output_string
+
+(test (let ((str ""))
+	(with-input-from-string "1234567890" (lambda ()
+          (with-input-from-string "1234567890" (lambda ()
+            (with-input-from-string "1234567890" (lambda ()
+              (with-input-from-string "1234567890" (lambda ()
+                (with-input-from-string "1234567890" (lambda ()
+                  (with-input-from-string "1234567890" (lambda ()
+                    (with-input-from-string "1234567890" (lambda ()
+	              (set! str (string-append str (string (read-char))))))
+	            (set! str (string-append str (string (read-char) (read-char))))))
+	          (set! str (string-append str (string (read-char) (read-char) (read-char))))))
+	        (set! str (string-append str (string (read-char) (read-char) (read-char) (read-char))))))
+              (set! str (string-append str (string (read-char) (read-char) (read-char) (read-char) (read-char))))))
+            (set! str (string-append str (string (read-char) (read-char) (read-char) (read-char) (read-char) (read-char))))))
+          (set! str (string-append str (string (read-char) (read-char) (read-char) (read-char) (read-char) (read-char) (read-char))))))
+	  str)
+      "1121231234123451234561234567")
+
+(let* ((new-error-port (open-output-string))
+       (old-error-port (set-current-error-port new-error-port)))
+  (catch #t
+    (lambda ()
+      (format #f "~R" 123))
+    (lambda args
+      (format (current-error-port) "oops")))
+  (let ((str (get-output-string new-error-port)))
+    (set-current-error-port old-error-port)
+    (test str "oops")))
+
+(let ((hi (open-input-string "hiho")))
+  (for-each
+   (lambda (op)
+     (test-e (op hi) (object->string op) 'input-port))
+   (list (lambda (p) (display 1 p))
+	 (lambda (p) (write 1 p))
+	 (lambda (p) (write-char #\a p))
+	 (lambda (p) (write-byte 0 p))
+	 (lambda (p) (format p "hiho"))
+	 newline))
+  (close-input-port hi))
+
+(let ((hi (open-output-file tmp-output-file)))
+  (write-byte 1 hi)
+  (close-output-port hi)
+  (test (write-byte 1 hi) 'error))
+
+(let ((hi (open-output-string)))
+  (for-each
+   (lambda (op)
+     (test-e (op hi) (object->string op) 'output-port))
+   (list read read-char read-byte peek-char char-ready? read-line))
+  (close-output-port hi))
+
+(test (output-port? (current-error-port)) #t)
+(test (and (not (null? (current-error-port))) (input-port? (current-error-port))) #f)
+
+(call-with-output-file tmp-output-file
+  (lambda (p)
+    (test (get-output-string p) 'error)
+    (do ((i 0 (+ i 1)))
+	((= i 256))
+      (write-byte i p))))
+
+(call-with-input-file tmp-output-file
+  (lambda (p)
+    (test (get-output-string p) 'error)
+    (call-with-exit
+     (lambda (quit)
+       (do ((i 0 (+ i 1)))
+	   ((= i 256))
+	 (let ((b (read-byte p)))
+	   (if (or (not (number? b))
+		   (not (= b i)))
+	       (begin
+		 (format #t "read-byte got ~A, expected ~A~%" b i)
+		 (quit)))))))
+    (let ((eof (read-byte p)))
+      (if (not (eof-object? eof))
+	  (format #t "read-byte at end: ~A~%" eof)))
+    (let ((eof (read-byte p)))
+      (if (not (eof-object? eof))
+	  (format #t "read-byte at end: ~A~%" eof)))))
+
+(call-with-output-file tmp-output-file
+  (lambda (p)
+    (do ((i 0 (+ i 1)))
+	((= i 256))
+      (write-char (integer->char i) p))))
+
+(define our-eof #f)
+
+(call-with-input-file tmp-output-file
+  (lambda (p)
+    (call-with-exit
+     (lambda (quit)
+       (do ((i 0 (+ i 1)))
+	   ((= i 256))
+	 (let ((b (read-char p)))
+	   (if (or (not (char? b))
+		   (not (char=? b (integer->char i))))
+	       (begin
+		 (format #t "read-char got ~A, expected ~A (~D: char? ~A)~%" b (integer->char i) i (char? (integer->char i)))
+		 (quit)))))))
+    (let ((eof (read-char p)))
+      (if (not (eof-object? eof))
+	  (format #t "read-char at end: ~A~%" eof))
+      (set! our-eof eof))
+    (let ((eof (read-char p)))
+      (if (not (eof-object? eof))
+	  (format #t "read-char again at end: ~A~%" eof)))))
+
+(test (eof-object? (integer->char 255)) #f)
+(test (eof-object? our-eof) #t)
+(test (char->integer our-eof) 'error)
+(test (char? our-eof) #f)
+(test (eof-object? ((lambda () our-eof))) #t)
+
+(for-each
+ (lambda (op)
+   (test (op *stdout*) 'error)
+   (test (op *stderr*) 'error)
+   (test (op (current-output-port)) 'error)
+   (test (op (current-error-port)) 'error)
+   (test (op ()) 'error))
+ (list read read-line read-char read-byte peek-char char-ready?))
+
+(for-each
+ (lambda (op)
+   (test (op #\a *stdin*) 'error)
+   (test (op #\a (current-input-port)) 'error)
+   (test (op #\a ()) 'error))
+ (list write display write-char))
+
+(test (write-byte 0 *stdin*) 'error)
+(test (write-byte (char->integer #\space) *stdout*) (char->integer #\space))
+(test (write-byte (char->integer #\space) *stderr*) (char->integer #\space))
+(test (newline *stdin*) 'error)
+(test (format *stdin* "hiho") 'error)
+
+(test (port-filename *stdin*) "*stdin*")
+(test (port-filename *stdout*) "*stdout*")
+(test (port-filename *stderr*) "*stderr*")
+
+(test (input-port? *stdin*) #t)
+(test (output-port? *stdin*) #f)
+(test (port-closed? *stdin*) #f)
+(test (input-port? *stdout*) #f)
+(test (output-port? *stdout*) #t)
+(test (port-closed? *stdout*) #f)
+(test (input-port? *stderr*) #f)
+(test (output-port? *stderr*) #t)
+(test (port-closed? *stderr*) #f)
+
+(test (port-line-number *stdin*) 0)
+(test (port-line-number *stdout*) 'error)
+(test (port-line-number *stderr*) 'error)
+(test (port-line-number ()) 'error) ; this used to be *stdin*?
+
+(test (open-input-file "[*not-a-file!*]-") 'error)
+(test (call-with-input-file "[*not-a-file!*]-" (lambda (p) p)) 'error)
+(test (with-input-from-file "[*not-a-file!*]-" (lambda () #f)) 'error)
+
+(test (open-input-file "") 'error)
+(test (call-with-input-file "" (lambda (p) p)) 'error)
+(test (with-input-from-file "" (lambda () #f)) 'error)
+
+;(test (open-output-file "/bad-dir/badness/[*not-a-file!*]-") 'error)
+;(test (call-with-output-file "/bad-dir/badness/[*not-a-file!*]-" (lambda (p) p)) 'error)
+;(test (with-output-to-file "/bad-dir/badness/[*not-a-file!*]-" (lambda () #f)) 'error)
+
+(with-output-to-file "tmp.r5rs"
+  (lambda ()
+    (write-char #\a)
+    (with-output-to-file tmp-output-file
+      (lambda ()
+	(format #t "~C" #\b)
+	(with-output-to-file "tmp2.r5rs"
+	  (lambda ()
+	    (display #\c)))
+	(display (with-input-from-file "tmp2.r5rs"
+		   (lambda ()
+		     (read-char))))))
+    (with-input-from-file tmp-output-file
+      (lambda ()
+	(write-byte (read-byte))
+	(write-char (read-char))))))
+
+(with-input-from-file "tmp.r5rs"
+  (lambda ()
+    (test (read-line) "abc")))
+
+(with-input-from-file "tmp.r5rs" ; this assumes tmp.r5rs has "abc" as above
+  (lambda ()
+    (test (read-char) #\a)
+    (test (eval-string "(+ 1 2)") 3)
+    (test (read-char) #\b)
+    (with-input-from-string "(+ 3 4)"
+      (lambda ()
+	(test (read) '(+ 3 4))))
+    (test (read-char) #\c)))
+
+(test (eval-string (object->string (with-input-from-string "(+ 1 2)" read))) 3)
+(test (eval (eval-string "(with-input-from-string \"(+ 1 2)\" read)")) 3)
+(test (eval-string "(eval (with-input-from-string \"(+ 1 2)\" read))") 3)
+(test (eval-string (object->string (eval-string (format #f "(+ 1 2)")))) 3)
+
+(let-temporarily (((*s7* 'safety) 1))
+  ;; closure with quoted circular list in body
+  (test (object->string (list (apply lambda '(x) (let ((cp (list 1))) (set-cdr! cp cp) (list (list cp))))) :readable) 'error)
+  ;; apply #_lambda: body is circular: ((x) (#1=(1 . #1#)))
+  (test (format #f "~W" (list (apply lambda '(x) (let ((cp (list 1))) (set-cdr! cp cp) (list (list 'quote cp))))))
+        "(list (lambda (x) (quote #1=(1 . #1#))))")
+  (test (format #f "~W" (list (apply lambda* '(x) (let ((cp (list 1 2))) (set-cdr! (cdr cp) cp) (list (list 'quote cp))))))
+        "(list (lambda* (x) (quote #1=(1 2 . #1#))))")
+  (test (format #f "~W" (list (apply macro '(x) (let ((cp (list 1 2))) (set-cdr! (cdr cp) cp) (list (list quote cp))))))
+        "(list (macro (x) '#1=(1 2 . #1#)))")
+  (test (format #f "~W" (list (apply lambda '(x) (let ((cp (list 1))) (set-cdr! cp cp) (list 'quote cp))))) 'error)
+  ;;apply #_lambda: body is circular: ((x) quote #1=(1 . #1#))
+  (test (format #f "~W" (make-hook  (let ((cp (list 1))) (set-cdr! cp cp) (list 'quote cp)))) "#<write_closure_readably: arglist is cyclic>"))
+
+
+;;; -------- test that we can plow past errors --------
+
+(if (and (defined? 'file-exists?) ; (ifdef name ...)?
+	 (file-exists? "tests.data"))
+    (delete-file "tests.data"))
+
+(call-with-output-file "tests.data"
+  (lambda (p)
+    (format p "start ")
+    (catch #t
+      (lambda ()
+	(format p "next ") (abs "hi") (format p "oops "))
+      (lambda args
+	'error))
+    (format p "done\n")))
+
+(let ((str (call-with-input-file "tests.data"
+             (lambda (p)
+	       (read-line p)))))
+  (if (or (not (string? str))
+	  (not (string=? str "start next done")))
+      (format #t ";call-with-output-file + error -> ~S~%" str)))
+
+(let ((str (call-with-input-file "tests.data"
+             (lambda (p)
+	       (catch #t
+		      (lambda ()
+			(read-char p)
+			(abs "hi")
+			(read-char p))
+		      (lambda args "s"))))))
+  (if (or (not (string? str))
+	  (not (string=? str "s")))
+      (format #t ";call-with-input-file + error -> ~S~%" str)))
+
+(if (and (defined? 'file-exists?)
+	 (file-exists? "tests.data"))
+    (delete-file "tests.data"))
+
+(with-output-to-file "tests.data"
+  (lambda ()
+    (format #t "start ")
+    (catch #t
+      (lambda ()
+	(format #t "next ") (abs "hi") (format #t "oops "))
+      (lambda args
+	'error))
+    (format #t "done\n")))
+
+(let ((str (with-input-from-file "tests.data"
+             (lambda ()
+	       (read-line)))))
+  (if (or (not (string? str))
+	  (not (string=? str "start next done")))
+      (format #t ";with-output-to-file + error -> ~S~%" str)))
+
+(let ((str (with-input-from-file "tests.data"
+             (lambda ()
+	       (catch #t
+		      (lambda ()
+			(read-char)
+			(abs "hi")
+			(read-char))
+		      (lambda args "s"))))))
+  (if (or (not (string? str))
+	  (not (string=? str "s")))
+      (format #t ";with-input-from-file + error -> ~S~%" str)))
+
+(test (call-with-output-string newline) (string #\newline))
+(test (call-with-output-string append) "")
+
+(let ((str (call-with-output-string
+	    (lambda (p)
+	      (format p "start ")
+	      (catch #t
+		     (lambda ()
+		       (format p "next ") (abs "hi") (format p "oops "))
+		     (lambda args
+		       'error))
+	      (format p "done")))))
+  (if (or (not (string? str))
+	  (not (string=? str "start next done")))
+      (format #t ";call-with-output-string + error -> ~S~%" str)))
+
+(let ((str (with-output-to-string
+	    (lambda ()
+	      (format #t "start ")
+	      (catch #t
+		     (lambda ()
+		       (format #t "next ") (abs "hi") (format #t "oops "))
+		     (lambda args
+		       'error))
+	      (format #t "done")))))
+  (if (or (not (string? str))
+	  (not (string=? str "start next done")))
+      (format #t ";with-output-to-string + error -> ~S~%" str)))
+
+(test (with-output-to-string (lambda () (format (current-output-port) "a test ~D" 123))) "a test 123")
+;(test (with-output-to-string (lambda () (format *stdout* "a test ~D" 1234))) "a test 1234")
+
+(test (string=? (with-output-to-string (lambda () (write #\null))) "#\\null") #t)
+(test (string=? (with-output-to-string (lambda () (write #\space))) "#\\space") #t)
+(test (string=? (with-output-to-string (lambda () (write #\return))) "#\\return") #t)
+(test (string=? (with-output-to-string (lambda () (write #\escape))) "#\\escape") #t)
+(test (string=? (with-output-to-string (lambda () (write #\tab))) "#\\tab") #t)
+(test (string=? (with-output-to-string (lambda () (write #\newline))) "#\\newline") #t)
+(test (string=? (with-output-to-string (lambda () (write #\backspace))) "#\\backspace") #t)
+(test (string=? (with-output-to-string (lambda () (write #\alarm))) "#\\alarm") #t)
+(test (string=? (with-output-to-string (lambda () (write #\delete))) "#\\delete") #t)
+
+(test (string=? (with-output-to-string (lambda () (write-char #\space))) " ") #t)  ; weird -- the name is backwards
+(test (string=? (with-output-to-string (lambda () (display #\space))) " ") #t)
+
+(let ((str (call-with-input-string "12345"
+	    (lambda (p)
+	      (catch #t
+		     (lambda ()
+		       (read-char p)
+		       (abs "hi")
+		       (read-char p))
+		     (lambda args "s"))))))
+  (if (or (not (string? str))
+	  (not (string=? str "s")))
+      (format #t ";call-with-input-string + error -> ~S~%" str)))
+
+(let ((str (with-input-from-string "12345"
+	    (lambda ()
+	      (catch #t
+		     (lambda ()
+		       (read-char)
+		       (abs "hi")
+		       (read-char))
+		     (lambda args "s"))))))
+  (if (or (not (string? str))
+	  (not (string=? str "s")))
+      (format #t ";with-input-from-string + error -> ~S~%" str)))
+
+(for-each
+ (lambda (arg)
+   (test (port-line-number arg) 'error)
+   (test (port-filename arg) 'error))
+ (list "hi" -1 0 #\a 'a-symbol #(1 2 3) '(1 . 2) '(1 2 3) 3.14 3/4 1.0+1.0i #t abs #<eof> #<unspecified> (lambda () 1)))
+
+(test (string? (port-filename)) #t)
+(test (symbol? (string->symbol (port-filename))) #t)
+
+(for-each
+ (lambda (arg)
+   (test
+    (with-input-from-string (format #f "~A" arg)
+      (lambda ()
+	(read)))
+    arg))
+ (list 1 3/4 '(1 2) #(1 2) :hi #f #t))
+
+(num-test (with-input-from-string "3.14" read) 3.14)
+(num-test (with-input-from-string "3.14+2i" read) 3.14+2i)
+(num-test (with-input-from-string "#x2.1" read) 2.0625)
+(test (with-input-from-string "'hi" read) ''hi)
+(test (with-input-from-string "'(1 . 2)" read) ''(1 . 2))
+
+(test
+ (let ((cin #f)
+       (cerr #f))
+   (catch #t
+	  (lambda ()
+	    (with-input-from-string "123"
+	      (lambda ()
+		(set! cin (current-input-port))
+		(error 'testing "jump out"))))
+	  (lambda args
+	    (set! cerr #t)))
+   (format #f "~A ~A" cin cerr))
+ "#<input-string-port :closed> #t")
+
+;;; old form:  "<port string input (closed)> #t")
+
+(test
+ (let ((cp (current-output-port))
+       (cout #f)
+       (cerr #f))
+   (catch #t
+	  (lambda ()
+	    (with-output-to-string
+	      (lambda ()
+		(set! cout (current-output-port))
+		(error 'testing "jump out"))))
+	  (lambda args
+	    (set! cerr #t)))
+   (format #f "~A ~A" cout cerr))
+ "#<output-string-port:closed> #t")
+(if (not (eq? *stdout* old-stdout))
+    (format *stderr* ";~D: stdout clobbered~%" (port-line-number)))
+
+;;; old form:  "<port string output (closed)> #t")
+
+(test (open-input-file #u(115 55 116 101 115 116 46 115 99 109 0) #u(114 0 98)) 'error) ; "s7test.scm" "r\x00b"
+
+(call-with-output-file tmp-output-file
+  (lambda (p)
+    (display "1" p)
+    (newline p)
+    (newline p)
+    (display "2345" p)
+    (newline p)))
+
+(call-with-input-file tmp-output-file
+  (lambda (p)
+    (test (read-line p) "1")
+    (test (read-line p) "")
+    (test (read-line p) "2345")
+    (test (eof-object? (read-line p)) #t)))
+
+(let ((p (open-output-file tmp-output-file "a")))
+  (display "678" p)
+  (newline p)
+  (close-output-port p))
+
+(if (not with-windows) ; "xyzzy" is legit in windows??
+    (begin
+      (test (let ((p (open-output-file tmp-output-file "xyzzy"))) (close-output-port p)) 'error)
+      (test (let ((p (open-input-file tmp-output-file "xyzzy"))) (close-input-port p)) 'error)))
+
+(call-with-input-file tmp-output-file
+  (lambda (p)
+    (test (read-line p) "1")
+    (test (read-line p) "")
+    (test (read-line p) "2345")
+    (test (read-line p) "678")
+    (test (eof-object? (read-line p)) #t)))
+
+(test (let ((a 1))
+	(define-macro (m1) `(set! a (read)))
+	(with-input-from-string "123" m1)
+	a)
+      123)
+
+(test (let ((a 1))
+	(define-macro (m3 p) `(set! a (read ,p)))
+	(call-with-input-string "123" m3)
+	a)
+      123)
+
+(test (let ()
+	(define-macro (m1) `(define a (read)))
+	(with-input-from-string "123" m1)
+	a)
+      123)
+
+(test (let ()
+	(define-macro (m3 p) `(define a (read ,p)))
+	(call-with-input-string "123" m3)
+	a)
+      123)
+
+(for-each
+ (lambda (arg)
+   (test (open-input-file "s7test.scm" arg) 'error)
+   (test (open-output-file tmp-data-file arg) 'error))
+ (list -1 #\a 1 0 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t () (list 1 2 3) '(1 . 2)))
+
+(test (current-input-port ()) 'error)
+(test (current-output-port ()) 'error)
+(test (current-error-port ()) 'error)
+
+(for-each
+ (lambda (op)
+   (let ((tag (catch #t (lambda () (op)) (lambda args 'error))))
+     (if (not (eq? tag 'error))
+	 (format #t ";(~A) -> ~A (expected 'error)~%" op tag))))
+ (list set-current-input-port set-current-error-port set-current-output-port
+       close-input-port close-output-port
+       write display write-byte write-char format                     ; newline
+       ;read read-char read-byte peek-char char-ready? read-line      ; these can default to current input
+       call-with-output-file call-with-input-file
+       call-with-output-string call-with-input-string
+       with-input-from-string with-input-from-file
+       with-output-to-file
+       open-output-file open-input-file
+       open-input-string))
+
+(for-each
+ (lambda (op)
+   (let ((tag (catch #t (lambda () (op 1 2 3 4 5)) (lambda args 'error))))
+     (if (not (eq? tag 'error))
+	 (format #t ";(~A 1 2 3 4 5) -> ~A (expected 'error)~%" op tag))))
+ (list set-current-input-port set-current-error-port set-current-output-port
+       close-input-port close-output-port
+       write display write-byte write-char format newline
+       read read-char read-byte peek-char char-ready? read-line
+       call-with-output-file call-with-input-file
+       call-with-output-string call-with-input-string
+       with-input-from-string with-input-from-file
+       with-output-to-file
+       open-output-file open-input-file
+       open-input-string))
+
+;;; (string-set! (with-input-from-string "\"1234\"" read) 1 #\a)
+(test (with-input-from-string "(+ 1 2)" read) '(+ 1 2))
+
+(when (and (provided? 'system-extras)
+	   (file-exists? "gad1.data")) ; file too big to treat as in-core string
+  (let ((p (catch #t (lambda () (open-input-file "gad1.data")) (lambda (type info) #f))))
+    (when p
+      (test (port-filename p) "gad1.data")
+      (test (string? (read-line p)) #t)
+      (test (char? (read-char p)) #t)
+      (test (integer? (read-byte p)) #t)
+      (read p) ; could be symbol, number etc
+      (test (string? (read-string 10 p)) #t)
+      (close-input-port p))))
+
+(test (>= (length (with-output-to-string (lambda () (write (make-string 512 #\tab))))) 512) #t)
+(test (>= (length (with-output-to-string (lambda () (write (make-string 512 #\newline))))) 512) #t)
+(test (>= (length (with-output-to-string (lambda () (write (make-string 512 #\"))))) 512) #t)
+(test (>= (length (with-output-to-string (lambda () (write (make-string 512 #\x65))))) 512) #t)
+
+(if (and (defined? 'file-exists?)
+	 (file-exists? (append "/home/" username "/test")))
+    (let-temporarily ((*load-path* (cons (append "/home/" username "/test") *load-path*)))
+      (with-output-to-file (append "/home/" username "/test/load-path-test.scm")
+	(lambda ()
+	  (format #t "(define (load-path-test) *load-path*)~%")))
+      (load "load-path-test.scm")
+      (if (or (not (defined? 'load-path-test))
+	      (not (equal? *load-path* (load-path-test))))
+	  (format #t ";*load-path*: ~S, but ~S~%" *load-path* (load-path-test)))))
+
+;;; function ports
+(when with-block
+
+  (let ((p (function-open-output)))
+    (write-char #\a p)
+    (let ((val (function-get-output p)))
+      (function-close-output p)
+      (if (not (string=? val "a"))
+	  (format *stderr* ";function port write #\\a: ~S (~D, ~A)~%" val (length val) (string->vector val)))))
+
+  (let ((p (function-open-output)))
+    (display "123" p)
+    (format p "4~D6" 5)
+    (write-string "789" p)
+    (write-byte (char->integer #\0) p)
+    (newline p)
+    (let ((val (function-get-output p)))
+      (function-close-output p)
+      (close-output-port p)
+      (if (not (string=? val "1234567890\n"))
+	  (format *stderr* ";function port outputs: ~S (~D, ~A)~%" val (length val) (string->vector val)))))
+
+  (let ((str "0123"))
+    (let ((p (function-open-input str)))
+      (let ((val (read-char p)))
+	(if (not (char=? val #\0))
+	    (format *stderr* ";function port read #\\0: ~S~%" val)))))
+
+  (let ((str "0123\n45678"))
+    (let ((p (function-open-input str)))
+      (let ((val (read-line p)))
+	(if (not (string=? val "0123"))
+	    (format *stderr* ";function port read-line: ~S~%" val))
+	(set! val (read-byte p))
+	(if (not (= val (char->integer #\4)))
+	    (format *stderr* ";function port read-byte: ~S~%" val))
+	(set! val (peek-char p))
+	(if (not (char=? val #\5))
+	    (format *stderr* ";function port peek-char: ~S~%" val))
+	(set! val (read-string 2 p))
+	(if (not (string=? val "56"))
+	    (format *stderr* ";function port read-string: ~S~%" val))
+	(if (and (not pure-s7)
+		 (not (char-ready? p)))
+	    (format *stderr* ";function port has no char ready?~%"))
+	(close-input-port p)))))
+
+
+;;; run integer? code before integer? is localized below
+(test (let ((x 1)) ((if (integer? x) + -)  1  1/2 1234)) 2471/2)
+(test (let () (define (func) (let ((x 1)) ((if (integer? x) + -)  1  1/2 1234))) (func) (func)) 2471/2)
+(test (let ((x 1)) ((if (integer? x) + *))) 0)
+(test (let () (define (func) (let ((x 1)) ((if (integer? x) + *)))) (func) (func)) 0)
+
+
+;;; -------- poke at the reader --------
+
+(test (cdr '(1 ."a")) "a")
+(test '(1 .(2 3)) '(1 2 3))
+(test '(1 .(2 3)) '(1 . (2 3)))
+(test (+ .(2 .(3))) 5)
+(test (cadr '(1 '0,)) ''0,)
+(test (equal? 3 ' 3) #t)
+(test (equal? '
+	             3 3) #t)
+(test (equal? '"hi" ' "hi") #t)
+(test (equal? '#\a '    #\a) #t)
+(test (let ((nam()e 1)) 1) 'error)
+(test (let ((nam""e 1)) nam""e) 'error) ; this was 1 originally
+(test (cadr '(1 ']x)) '']x)
+(test `1 1)
+(test (equal? '(1 .(1 .())) '(1 1)) #t)
+(test (equal? '("hi"."ho") ' ("hi" . "ho")) #t)
+(test (equal? '("hi""ho") '("hi" "ho")) #t)
+(test '("""""") '("" "" ""))
+(test '(#|;"();|#) ())
+(test '(#||##\# #||##b1) '(#\# 1))
+(test (#|s'!'|#*) 1)
+(test (#|==|#) ())
+(test -#|==|#1 'error) ; unbound variable
+(test '((). '()) '(() #_quote ()))
+(test '(1. . .2) '(1.0 . 0.2))
+(test (equal? '(().()) '(())) #t)
+(test (equal? '(()()) '(() ())) #t)
+(test (equal? '(()..()) '(() .. ())) #t)
+(test '((().()).()) '((())))
+(test '(((().()).()).()) '(((()))))
+(test '((().(().())).()) '((() ())))
+(test '((()().(().()))) '((() () ())))
+(test '(1 .;
+	  2) '(1 . 2))
+(test (vector .(1 .(2))) #(1 2))
+(test (vector 0. .(.1)) #(0.0 0.1))
+(test '(a #|foo||# b) '(a b)) ; from bug-guile
+(test '(a #|foo|||# b) '(a b))
+(test '(a #|foo||||# b) '(a b))
+(test '(a #|foo|||||# b) '(a b))
+
+(test (let () (define (f' x) (+ x x)) (f' 10)) 20) ; from /r/scheme
+(test (let () (define (f'' a'b) (+ a'b a'b)) (f'' 10)) 20)
+(test (symbol? 'a'b) #t)
+
+(test (char? #\#) #t)
+(test (type-of (eval-string "'#<float-vector>")) 'undefined?)
+(test (type-of (eval-string "'(#<float-vector>)")) 'pair?)
+(test (car `(,.1e0)) .1)
+(test (car `(,.1E0)) .1)
+(test (let ((x "hi")) (set! x"asdf") x) "asdf")
+(test (let* ((x "hi") (y x)) (set! x "asdf") y) "hi")
+(test (let ((x 1)) (set! x(list 1 2)) x) '(1 2))
+(num-test (let ((x 1)) (set!;"
+			x;)
+			12.;(
+			);#|
+	       x) 12.0)
+(test (let ((\x00}< 1) (@:\t{ 2)) (+ \x00}< @:\t{)) 3)
+(test (let ((| 1) (|| 2) (||| 3)) (+ || | |||)) 6)
+(test (let ((|a#||#b| 1)) |a#||#b|) 1)
+(test (let ((@,@'[1] 1) (\,| 2)) (+ @,@'[1] \,|)) 3)
+(test (list"0"0()#()#\a"""1"'x(list)+(cons"""")#f) (list "0" 0 () #() #\a "" "1" 'x (list) + '("" . "") #f))
+(test (let ((x, 1)) x,) 1)
+(test (length (eval-string (string #\' #\( #\1 #\space #\. (integer->char 200) #\2 #\)))) 2) ; will be -1 if dot is for improper list, 3 if dot is a symbol
+(test (+ `,0(angle ```,`11)) 0)
+(test (map . (char->integer "123")) '(49 50 51))
+(test (map .(values "0'1")) '(#\0 #\' #\1))
+(test (map /""'(123)) ())
+(num-test (+ 1 .()) 1)
+(test (let () (define (x .()) (list .())) (x)) ())
+
+(test '(1 . ()) '(1))
+(test '(1 . (2)) '(1 2))
+(test '(1 . (2) 3) '(1 2 3)) ; Guile says "missing close paren", sbcl says "More than one object follows . in list.", clisp: "illegal end of dotted list"
+(test '(1 . (2 3) 4 5) '(1 2 3 4 5))
+(test '(1 . (2) (3)) '(1 2 (3)))
+(test '(1 2 . 'x 3) '(1 2 #_quote x 3))
+(test (eval-string "'(1 . 2 3)") 'error)  ; eval-string here wraps up the read-error
+(test '(1 . (2 . 3)) '(1 2 . 3))
+(test (eval-string "'(1 . . ((2 3)))") 'error)
+(test '((1 . 2) . (3 . 4)) '((1 . 2) 3 . 4))
+(test (eval-string "'(1 . () 2)") 'error)
+(test '(1 . (2) . (3)) '(1 2 3))
+(test '(1 . (2 . (3))) '(1 2 3))
+
+;; how is ...#(... parsed?
+;(test (eval-string "'(# (1))") 'error)
+(test (let ((lst (eval-string "'(#(1))"))) (and (= (length lst) 1) (vector? (car lst)))) #t)                     ; '(#(1))
+(test (let ((lst (eval-string "'(-#(1))"))) (and (= (length lst) 2) (symbol? (car lst)) (pair? (cadr lst)))) #t) ; '(-# (1))
+(test (let ((lst (eval-string "'(1#(1))"))) (and (= (length lst) 2) (symbol? (car lst)) (pair? (cadr lst)))) #t) ; '(1# (1))
+(test (let ((lst (eval-string "'('#(1))"))) (and (= (length lst) 1) (vector? (cadar lst)))) #t)                  ; '((quote #(1)))
+(test (let ((lst (eval-string "'(()#())"))) (and (= (length lst) 2) (null? (car lst)) (vector? (cadr lst)))) #t) ; '(() #())
+(test (let ((lst (eval-string "'(().())"))) (and (= (length lst) 1) (null? (car lst)))) #t)                      ; '(())
+(test (let ((lst (eval-string "'(()-())"))) (and (= (length lst) 3) (null? (car lst)) (null? (caddr lst)))) #t)  ; '(() - ())
+(test (let ((lst (eval-string "'(().#())"))) (and (= (length lst) 3) (null? (car lst)) (null? (caddr lst)))) #t) ; '(() .# ())
+(test (let ((lst (eval-string "'((). #())"))) (and (= (length lst) -1) (null? (car lst)) (vector? (cdr lst)))) #t) ; '(() . #())
+(test (let ((lst (eval-string "'(\"\"#())"))) (and (= (length lst) 2) (string? (car lst)) (vector? (cadr lst)))) #t) ; '("" #())
+(test (length (car '("#\\("))) 3)
+(test (length (car '("#\\\""))) 3)
+(test (char=? ((car '("#\\\"")) 2) #\") #t)
+(test (length '(()#\(())) 3)
+(test (length (eval-string "'(()#\\(())")) 3)
+(test (char=? ((eval-string "'(()#\\#())") 1) #\#) #t)
+(test (length (list""#t())) 3)
+(test (length (list""#())) 2)
+(test (length (eval-string "'(#xA(1))")) 2)
+(test (length '(#xA""#(1))) 3)
+(test (length (eval-string "'(#xA\"\"#(1))")) 3)
+(test (length (eval-string "'(1#f)")) 1)
+;(test (eval-string "'(#f#())") 'error)
+(test (length '(#f())) 2)
+(test (length '(#f"")) 2)
+(test (eq? #f (eval-string "#F")) #f)
+;(test (eval-string "'(#<eof>#<eof>)") 'error)
+;(test (eval-string "'(#<eof>#())") 'error)
+(test (equal? '('#()) '(#())) #f)
+(test (equal? (list #()) '(#())) #t)
+(test (equal? '(#()) '(#())) #t)
+(test (equal? '('#()) '(`#())) #f) ;  [guile agrees]
+(test (equal? '('()) '(`())) #f) ; '('()) -> ('()) but '(`()) -> (())
+(test (equal? '('(1)) '(`(1))) #t)
+(test (equal? '('#(1)) '(`#(1))) #f) ; [guile agrees]
+(test (equal? '('#()) '(#())) #f)
+(test (equal? '(`#()) '(`#())) #t)
+(test (equal? #() `#()) #t)
+(test (equal? (list #()) (list `#())) #t)
+(test (equal? (list #()) '(`#())) #t)
+(test (equal? '(`#()) '(#())) #t)
+(test (equal? `#() #()) #t) ; and also (1) () #(1) etc
+(test (equal? `#() '#()) #t) ; "
+(test (equal? '`#() ''#()) #f) ; it equals #() -- this is consistent -- see below
+(test (equal? '`#() ``#()) #t)
+
+(test (catch #t (lambda () (with-input-from-string "#0d()" read)) (lambda (type info) (apply format #f info)))
+         "#nD(...) dimensions, 0, should be 1 or more")
+(test (catch #t (lambda () (with-input-from-string "#1230d()" read)) (lambda (type info) (apply format #f info)))
+         "reading #1230...: 1230 is too large, (*s7* 'max-vector-dimensions): 512")
+
+(test (equal? '() '()) #t)
+(test (equal? (quote ()) '()) #t)
+(test (equal? '() (quote ())) #t)
+(test (equal? (quote ()) (quote ())) #t)
+(test (equal? `(1) '(1)) #t)
+(test (equal? (quasiquote (1)) '(1)) #t)
+(test (equal? `(1) (quote (1))) #t)
+(test (equal? (quasiquote (1)) (quote (1))) #t)
+(test (equal? ``''1 '``'1) #t)
+(test (equal? (quasiquote `(quote (quote 1))) '``'1) #f)
+(test (equal? ``''1 (quote ``(quote 1))) #f)
+(test (equal? (quasiquote `(quote (quote 1))) (quote ``(quote 1))) #f)
+(test (equal? '``'#f ```'#f) #t)
+(test (equal? (quote ``(quote #f)) ```'#f) #f)
+(test (equal? '``'#f (quasiquote ``(quote #f))) #f)
+(test (equal? (quote ``(quote #f)) (quasiquote ``(quote #f))) #t)
+;;; etc:
+
+#|
+(equal? (quote `1) (quote (quasiquote 1))) -> #f
+the reader sees `1 and turns it into 1 in the first case, but does not collapse the 2nd case to 1
+  (who knows, quasiquote might have been redefined in context... but ` can't be redefined):
+:(define (` a) a)
+;define: define a non-symbol? 'a
+;    (define ('a) a)
+
+this is different from guile which does not handle ` at read time except to expand it:
+
+guile> (quote `1)
+(quasiquote 1)
+
+:(quote `1)
+1
+
+so anything that quotes ` is not going to equal quote quasiquote
+
+(define (check-strs str1 str2)
+  (for-each
+   (lambda (arg)
+     (let ((expr (format #f "(equal? ~A~A ~A~A)" str1 arg str2 arg)))
+       (let ((val (catch #t
+			 (lambda () (eval-string expr))
+			 (lambda args 'error))))
+	 (format #t "--------~%~S -> ~S" expr val)
+	 (let* ((parens3 0)
+		(parens4 0)
+		(str3 (apply string-append (map (lambda (c)
+						 (if (char=? c #\`)
+						     (if (= parens3 0)
+							 (begin
+							   (set! parens3 (+ parens3 1))
+							   "(quasiquote ")
+							 "`")
+						     (if (char=? c #\')
+							 (begin
+							   (set! parens3 (+ parens3 1))
+							   "(quote ")
+							 (string c))))
+						str1)))
+		(str4 (apply string-append (map (lambda (c)
+						 (if (char=? c #\`)
+						     (if (= parens4 0)
+							 (begin
+							   (set! parens4 (+ parens4 1))
+							   "(quasiquote ")
+							 "`")
+						     (if (char=? c #\')
+							 (begin
+							   (set! parens4 (+ parens4 1))
+							   "(quote ")
+							 (string c))))
+						str2))))
+	   (let ((expr (format #f "(equal? ~A~A~A ~A~A)" str3 arg (make-string parens3 #\)) str2 arg)))
+	     (let* ((val1 (catch #t
+			       (lambda () (eval-string expr))
+			       (lambda args 'error)))
+		    (trouble (and (not (eq? val1 'error))
+				  (not (eq? val1 val)))))
+	       (if trouble
+		   (format #t "~%~8T~A~S -> ~S~A" bold-text expr val1 unbold-text)
+		   (format #t "~%~8T~S -> ~S" expr val1))))
+	   (let ((expr (format #f "(equal? ~A~A ~A~A~A)" str1 arg str4 arg (make-string parens4 #\)))))
+	     (let* ((val1 (catch #t
+			       (lambda () (eval-string expr))
+			       (lambda args 'error)))
+		    (trouble (and (not (eq? val1 'error))
+				  (not (eq? val1 val)))))
+	       (if trouble
+		   (format #t "~%~8T~A~S -> ~S~A" bold-text expr val1 unbold-text)
+		   (format #t "~%~8T~S -> ~S" expr val1))))
+	   (let ((expr (format #f "(equal? ~A~A~A ~A~A~A)" str3 arg (make-string parens3 #\)) str4 arg (make-string parens4 #\)))))
+	     (let* ((val1 (catch #t
+			       (lambda () (eval-string expr))
+			       (lambda args 'error)))
+		    (trouble (and (not (eq? val1 'error))
+				  (not (eq? val1 val)))))
+	       (if trouble
+		   (format #t "~%~8T~A~S -> ~S~A~%" bold-text expr val1 unbold-text)
+		   (format #t "~%~8T~S -> ~S~%" expr val1))))
+	   ))))
+   (list "()" "(1)" "#()" "#(1)" "1" "#f")))
+   ;; (list ",(+ 1 2)" "\"\"" "(())" "#\\1" "3/4" ",1")
+
+(check-strs "'" "'")
+(check-strs "`" "'")
+(check-strs "'" "`")
+(check-strs "`" "`")
+
+(let ((strs ()))
+  (do ((i 0 (+ i 1)))
+      ((= i 4))
+    (let ((c1 ((vector #\' #\` #\' #\`) i))
+	  (c2 ((vector #\' #\' #\` #\`) i)))
+      (do ((k 0 (+ k 1)))
+	  ((= k 4))
+	(let ((d1 ((vector #\' #\` #\' #\`) k))
+	      (d2 ((vector #\' #\' #\` #\`) k)))
+	  (let ((str1 (string c1 c2))
+		(str2 (string d1 d2)))
+	    (if (not (member (list str1 str2) strs))
+		(begin
+		  (check-strs str1 str2)
+		  (set! strs (cons (list str1 str2) strs))
+		  (set! strs (cons (list str2 str1) strs))))))))))
+
+(let ((strs ()))
+  (do ((i 0 (+ i 1)))
+      ((= i 8))
+    (let ((c1 ((vector #\' #\` #\' #\` #\' #\` #\' #\`) i))
+	  (c2 ((vector #\' #\' #\` #\` #\' #\' #\` #\`) i))
+	  (c3 ((vector #\' #\' #\' #\' #\` #\` #\` #\`) i)))
+      (do ((k 0 (+ k 1)))
+	  ((= k 8))
+	(let ((d1 ((vector #\' #\` #\' #\` #\' #\` #\' #\`) k))
+	      (d2 ((vector #\' #\' #\` #\` #\' #\' #\` #\`) k))
+	      (d3 ((vector #\' #\' #\' #\' #\` #\` #\` #\`) k)))
+	  (let ((str1 (string c1 c2 c3))
+		(str2 (string d1 d2 d3)))
+	    (if (not (member (list str1 str2) strs))
+		(begin
+		  (check-strs str1 str2)
+		  (set! strs (cons (list str1 str2) strs))
+		  (set! strs (cons (list str2 str1) strs))))))))))
+
+
+;;; --------------------------------
+
+(do ((i 0 (+ i 1)))
+    ((= i 256))
+  (if (and (not (= i (char->integer #\))))
+	   (not (= i (char->integer #\"))))
+      (let ((str (string #\' #\( #\1 #\space #\. (integer->char i) #\2 #\))))
+	(catch #t
+	       (lambda ()
+		 (let ((val (eval-string str)))
+		   (format #t "[~D] ~A -> ~S (~S ~S)~%" i str val (car val) (cdr val))))
+	       (lambda args
+		 (format #t "[~D] ~A -> ~A~%" i str args))))))
+
+(let ((chars (vector (integer->char 0) #\newline #\space #\tab #\. #\, #\@ #\= #\x #\b #\' #\`
+		     #\# #\] #\[ #\} #\{ #\( #\) #\1 #\i #\+ #\- #\e #\_ #\\ #\" #\: #\; #\> #\<)))
+  (let ((nchars (vector-length chars)))
+    (do ((len 2 (+ len 1)))
+	((= len 3))
+      (let ((str (make-string len))
+	    (ctrs (make-vector len 0)))
+
+	(do ((i 0 (+ i 1)))
+	    ((= i (expt nchars len)))
+
+	  (let ((carry #t))
+	    (do ((k 0 (+ k 1)))
+		((or (= k len)
+		     (not carry)))
+	      (vector-set! ctrs k (+ 1 (vector-ref ctrs k)))
+	      (if (= (vector-ref ctrs k) nchars)
+		  (vector-set! ctrs k 0)
+		  (set! carry #f)))
+	    (do ((k 0 (+ k 1)))
+		((= k len))
+	      (string-set! str k (vector-ref chars (vector-ref ctrs k)))))
+
+	  (format #t "~A -> " str)
+	  (catch #t
+		 (lambda ()
+		   (let ((val (eval-string str)))
+		     (format #t " ~S -> ~S~%" str val)))
+		 (lambda args
+		   ;(format #t " ~A~%" args)
+		   #f
+		   )))))))
+|#
+
+(let ((äåæéîå define)
+      (ìåîçôè length)
+      (äï do)
+      (ìåô* let*)
+      (éæ if)
+      (áâó abs)
+      (ìïç log)
+      (óåô! set!))
+
+  (äåæéîå (óòã-äõòáôéïî å)
+    (ìåô* ((ìåî (ìåîçôè å))
+           (åø0 (å 0))
+           (åø1 (å (- ìåî 2)))
+           (áìì-ø (- åø1 åø0))
+           (äõò 0.0))
+      (äï ((é 0 (+ é 2)))
+          ((>= é (- ìåî 2)) äõò)
+        (ìåô* ((ø0 (å é))
+               (ø1 (å (+ é 2)))
+               (ù0 (å (+ é 1))) ; 1/ø ø ðïéîôó
+               (ù1 (å (+ é 3)))
+               (áòåá (éæ (< (áâó (- ù0 ù1)) .0001)
+                         (/ (- ø1 ø0) (* ù0 áìì-ø))
+                         (* (/ (- (ìïç ù1) (ìïç ù0))
+                               (- ù1 ù0))
+                            (/ (- ø1 ø0) áìì-ø)))))
+         (óåô! äõò (+ äõò (áâó áòåá)))))))
+
+  (num-test (óòã-äõòáôéïî (list 0 1 1 2)) 0.69314718055995)
+  (num-test (óòã-äõòáôéïî (vector 0 1 1 2)) 0.69314718055995))
+
+(test (let ((ÿa 1)) ÿa) 1)
+(test (+ (let ((!a 1)) !a) (let (($a 1)) $a) (let ((%a 1)) %a) (let ((&a 1)) &a) (let ((*a 1)) *a) (let ((+a 1)) +a) (let ((-a 1)) -a) (let ((.a 1)) .a) (let ((/a 1)) /a) (let ((0a 1)) 0a) (let ((1a 1)) 1a) (let ((2a 1)) 2a) (let ((3a 1)) 3a) (let ((4a 1)) 4a) (let ((5a 1)) 5a) (let ((6a 1)) 6a) (let ((7a 1)) 7a) (let ((8a 1)) 8a) (let ((9a 1)) 9a) (let ((<a 1)) <a) (let ((=a 1)) =a) (let ((>a 1)) >a) (let ((?a 1)) ?a) (let ((@a 1)) @a) (let ((Aa 1)) Aa) (let ((Ba 1)) Ba) (let ((Ca 1)) Ca) (let ((Da 1)) Da) (let ((Ea 1)) Ea) (let ((Fa 1)) Fa) (let ((Ga 1)) Ga) (let ((Ha 1)) Ha) (let ((Ia 1)) Ia) (let ((Ja 1)) Ja) (let ((Ka 1)) Ka) (let ((La 1)) La) (let ((Ma 1)) Ma) (let ((Na 1)) Na) (let ((Oa 1)) Oa) (let ((Pa 1)) Pa) (let ((Qa 1)) Qa) (let ((Ra 1)) Ra) (let ((Sa 1)) Sa) (let ((Ta 1)) Ta) (let ((Ua 1)) Ua) (let ((Va 1)) Va) (let ((Wa 1)) Wa) (let ((Xa 1)) Xa) (let ((Ya 1)) Ya) (let ((Za 1)) Za) (let (([a 1)) [a) (let ((\a 1)) \a) (let ((]a 1)) ]a) (let ((^a 1)) ^a) (let ((_a 1)) _a) (let ((aa 1)) aa) (let ((ba 1)) ba) (let ((ca 1)) ca) (let ((da 1)) da) (let ((ea 1)) ea) (let ((fa 1)) fa) (let ((ga 1)) ga) (let ((ha 1)) ha) (let ((ia 1)) ia) (let ((ja 1)) ja) (let ((ka 1)) ka) (let ((la 1)) la) (let ((ma 1)) ma) (let ((na 1)) na) (let ((oa 1)) oa) (let ((pa 1)) pa) (let ((qa 1)) qa) (let ((ra 1)) ra) (let ((sa 1)) sa) (let ((ta 1)) ta) (let ((ua 1)) ua) (let ((va 1)) va) (let ((wa 1)) wa) (let ((xa 1)) xa) (let ((ya 1)) ya) (let ((za 1)) za) (let (({a 1)) {a) (let ((|a 1)) |a) (let ((}a 1)) }a) (let ((~a 1)) ~a) (let (( a 1))  a) (let ((¡a 1)) ¡a) (let ((¢a 1)) ¢a) (let ((£a 1)) £a) (let ((¤a 1)) ¤a) (let ((¥a 1)) ¥a) (let ((¦a 1)) ¦a) (let ((§a 1)) §a) (let ((¨a 1)) ¨a) (let ((©a 1)) ©a) (let ((ªa 1)) ªa) (let ((«a 1)) «a) (let ((¬a 1)) ¬a) (let ((­a 1)) ­a) (let ((®a 1)) ®a) (let ((¯a 1)) ¯a) (let ((°a 1)) °a) (let ((±a 1)) ±a) (let ((²a 1)) ²a) (let ((³a 1)) ³a) (let ((´a 1)) ´a) (let ((µa 1)) µa) (let ((¶a 1)) ¶a) (let ((·a 1)) ·a) (let ((¸a 1)) ¸a) (let ((¹a 1)) ¹a) (let ((ºa 1)) ºa) (let ((»a 1)) »a) (let ((¼a 1)) ¼a) (let ((½a 1)) ½a) (let ((¾a 1)) ¾a) (let ((¿a 1)) ¿a) (let ((Àa 1)) Àa) (let ((Áa 1)) Áa) (let ((Âa 1)) Âa) (let ((Ãa 1)) Ãa) (let ((Äa 1)) Äa) (let ((Åa 1)) Åa) (let ((Æa 1)) Æa) (let ((Ça 1)) Ça) (let ((Èa 1)) Èa) (let ((Éa 1)) Éa) (let ((Êa 1)) Êa) (let ((Ëa 1)) Ëa) (let ((Ìa 1)) Ìa) (let ((Ía 1)) Ía) (let ((Îa 1)) Îa) (let ((Ïa 1)) Ïa) (let ((Ða 1)) Ða) (let ((Ña 1)) Ña) (let ((Òa 1)) Òa) (let ((Óa 1)) Óa) (let ((Ôa 1)) Ôa) (let ((Õa 1)) Õa) (let ((Öa 1)) Öa) (let ((×a 1)) ×a) (let ((Øa 1)) Øa) (let ((Ùa 1)) Ùa) (let ((Úa 1)) Úa) (let ((Ûa 1)) Ûa) (let ((Üa 1)) Üa) (let ((Ýa 1)) Ýa) (let ((Þa 1)) Þa) (let ((ßa 1)) ßa) (let ((àa 1)) àa) (let ((áa 1)) áa) (let ((âa 1)) âa) (let ((ãa 1)) ãa) (let ((äa 1)) äa) (let ((åa 1)) åa) (let ((æa 1)) æa) (let ((ça 1)) ça) (let ((èa 1)) èa) (let ((éa 1)) éa) (let ((êa 1)) êa) (let ((ëa 1)) ëa) (let ((ìa 1)) ìa) (let ((ía 1)) ía) (let ((îa 1)) îa) (let ((ïa 1)) ïa) (let ((ða 1)) ða) (let ((ña 1)) ña) (let ((òa 1)) òa) (let ((óa 1)) óa) (let ((ôa 1)) ôa) (let ((õa 1)) õa) (let ((öa 1)) öa) (let ((÷a 1)) ÷a) (let ((øa 1)) øa) (let ((ùa 1)) ùa) (let ((úa 1)) úa) (let ((ûa 1)) ûa) (let ((üa 1)) üa) (let ((ýa 1)) ýa) (let ((þa 1)) þa) (let ((ÿa 1)) ÿa)) 181)
+
+;;; there are about 50 non-printing chars, some of which would probably work as well
+
+
+;; (eval-string "(eval-string ...)") is not what it appears to be -- the outer call
+;;    still sees the full string when it evaluates, not the string that results from
+;;    the inner call.
+
+
+(let () ; from scheme bboard
+  (define (maxlist list)
+    (define (maxlist' l max)
+      (if (null? l) max
+	  (if (> (car l) max)
+	      (maxlist' (cdr l) (car l))
+	      (maxlist' (cdr l) max))))
+    (if (null? list) 'undef
+	(maxlist' list (car list))))
+  (test (maxlist '(1 2 3)) 3) ; quote is ok in s7 if not the initial char (sort of like a number)
+
+  (let ((h'a 3))
+    (test h'a 3))
+  (let ((1'2 32))
+    (test 1'2 32))
+  (let ((1'`'2 32))
+    (test 1'`'2 32))
+  (let ((1'`,@2 32))
+    (test 1'`,@2 32))
+
+;  (test (define '3 32) 'error) ;define quote: syntactic keywords tend to behave badly if redefined
+  )
+
+(let ((|,``:,*|',## 1)
+      (0,,&:@'>>.<# 2)
+      (@.*0`#||\<,, 3)
+      (*&:`&'>#,*<` 4)
+      (*0,,`&|#*:`> 5)
+      (>:|<*.<@:\|` 6)
+      (*',>>:.'@,** 7)
+      (0|.'@<<:,##< 8)
+      (<>,\',\.>>#` 9)
+      (@#.>|&#&,\0* 10)
+      (0'.`&<','<<. 11)
+      (&@@*<*\'&|., 12)
+      (|0*&,':|0\** 13)
+      (<:'*@<>*,<&` 14)
+      (>@<@<|>,`&'. 15)
+      (@#,00:<:@*.\ 16)
+      (*&.`\>#&,&., 17)
+      (0|0|`,,..<@, 18)
+      (0@,'>\,,&.@# 19)
+      (>@@>,000`\#< 20)
+      (|>*'',<:&@., 21)
+      (|>,0>0|,@'|. 22)
+      (0,`'|'`,:`@` 23)
+      (<>#'>,,\'.'& 24)
+      (*..,|,.,&&@0 25))
+  (test (+ |,``:,*|',## 0,,&:@'>>.<# @.*0`#||\<,, *&:`&'>#,*<` *0,,`&|#*:`> >:|<*.<@:\|` *',>>:.'@,**
+	   0|.'@<<:,##< <>,\',\.>>#` @#.>|&#&,\0* 0'.`&<','<<.  &@@*<*\'&|., |0*&,':|0\** <:'*@<>*,<&`
+           >@<@<|>,`&'. @#,00:<:@*.\ *&.`\>#&,&., 0|0|`,,..<@, 0@,'>\,,&.@# >@@>,000`\#<
+           |>*'',<:&@., |>,0>0|,@'|. 0,`'|'`,:`@` <>#'>,,\'.'& *..,|,.,&&@0)
+	325))
+
+(when full-s7test
+  (let ((first-chars (list #\. #\0 #\@ #\! #\& #\| #\* #\< #\>))
+	(rest-chars (list #\. #\0 #\@ #\! #\| #\, #\# #\' #\\ #\` #\, #\: #\& #\* #\< #\>)))
+    (let ((first-len (length first-chars))
+	  (rest-len (length rest-chars)))
+      (let ((n 100)
+	    (size 12))
+	(let ((str (make-string size #\space)))
+	  (do ((i 0 (+ i 1)))
+	      ((= i n))
+	    (set! (str 0) (first-chars (random first-len)))
+	    (do ((k 1 (+ 1 k)))
+		((= k size))
+	      (set! (str k) (rest-chars (random rest-len))))
+	    (catch #t (lambda ()
+			(let ((val (eval-string (format #f "(let () (define ~A 3) ~A)" str str))))
+			  (format #f "~A -> ~A~%" str val)))
+		   (lambda args
+		     (format #f "~A error: ~A~%" str args)))))))))
+
+(let ((List 1)
+      (LIST 2)
+      (lIsT 3)
+      (-list 4)
+      (_list 5)
+      (+list 6))
+  (test (apply + (list List LIST lIsT -list _list +list)) 21))
+
+(let ()
+  (define (\ arg) (+ arg 1))
+  (test (+ 1 (\ 2)) 4)
+  (define (@\ arg) (+ arg 1))
+  (test (+ 1 (@\ 2)) 4)
+  (define (@,\ arg) (+ arg 1))
+  (test (+ 1 (@,\ 2)) 4)
+  (define (\,@\ arg) (+ arg 1))
+  (test (+ 1 (\,@\ 2)) 4)
+  )
+
+;;; these are from the r7rs discussions
+(test (let ((a'b 3)) a'b) 3) ; allow variable names like "can't-go-on" or "don't-ask"
+(test (symbol? 'a'b'c) #t)   ; these two from HN
+(test (let ((a 1)) (list #\)a)) (list #\) 1))
+(test (let () (define (f x y) (+ x y)) (let ((a 3) (b 4)) (f a, b))) 'error) ; unbound variable a,
+(test (let () (define (f x y) (+ x y)) (let ((a 3) (b 4)) (f a ,b))) 'error) ; unquote outside quasiquote
+
+(test (vector? (owlet 0. 3/4 #(reader-cond ))) 'error)
+(test (vector? #(reader-cond)) #t)
+
+
+;;; -------- object->string
+;;; object->string
+
+(test (string=? (object->string 32) "32") #t)
+(test (string=? (object->string 32.5) "32.5") #t)
+(test (string=? (object->string 32/5) "32/5") #t)
+(test (object->string 1+i) "1.0+1.0i")
+(test (string=? (object->string "hiho") "\"hiho\"") #t)
+(test (string=? (object->string 'symb) "symb") #t)
+(test (string=? (object->string (list 1 2 3)) "(1 2 3)") #t)
+(test (string=? (object->string (cons 1 2)) "(1 . 2)") #t)
+(test (string=? (object->string #(1 2 3)) "#(1 2 3)") #t)
+(test (string=? (object->string +) "+") #t)
+(test (object->string (object->string (object->string "123"))) "\"\\\"\\\\\\\"123\\\\\\\"\\\"\"")
+(test (object->string #<eof>) "#<eof>")
+(test (object->string (if #f #f)) "#<unspecified>")
+(test (object->string #<undefined>) "#<undefined>")
+(test (object->string _undef_) "#_asdf")
+(test (object->string #f) "#f")
+(test (object->string #t) "#t")
+(test (object->string ()) "()")
+(test (object->string #()) "#()")
+(test (object->string "") "\"\"")
+(test (object->string abs) "abs")
+(test (object->string :asdf) ":asdf")
+(test (object->string asdf:) "asdf:")
+(test (object->string lambda) "#_lambda")
+(test (object->string (lambda () a)) "#<lambda ()>")
+(test (object->string (lambda a a)) "#<lambda a>")
+(test (object->string (lambda (a) a)) "#<lambda (a)>")
+(test (object->string (lambda (a . b) a)) "#<lambda (a . b)>")
+(test (object->string (lambda (a b) a)) "#<lambda (a b)>")
+(test (object->string (lambda (a b c) a)) "#<lambda (a b ...)>")
+(test (object->string (lambda (a b . c) a)) "#<lambda (a b ...)>")
+(test (object->string (lambda* (a :rest b) a)) "#<lambda* (a :rest b)>")
+(test (object->string (lambda* (:rest a) a)) "#<lambda* (:rest a)>")
+(test (object->string (lambda* (a b :rest c) a)) "#<lambda* (a b ...)>")
+(let () (define-macro (mac a) a) (test (object->string mac) "mac"))
+(let ((m (macro (a) a))) (test (object->string m) "#<macro (a)>"))
+(let ((m (macro* (a) a))) (test (object->string m) "#<macro* (a)>"))
+(let ((m (bacro (a) a))) (test (object->string m) "#<bacro (a)>"))
+(let ((m (bacro* (a) a))) (test (object->string m) "#<bacro* (a)>"))
+(let ((_?_m (define-expansion (_?_mac a) a))) (test (object->string _?_m) "_?_mac"))
+(let ((_?_m1 (define-expansion* (_?_mac (a 0)) a))) (test (object->string _?_m1) "_?_mac"))
+(test (object->string +) "+")
+(test (object->string +) "+")
+(test (object->string '''2) "''2")
+(test (object->string (lambda () #f)) "#<lambda ()>") ;"#<closure>"
+(test (call-with-exit (lambda (return) (object->string return))) "#<goto return>")
+(test (call/cc (lambda (return) (object->string return))) "#<continuation return>")
+(test (let () (define-macro (hi a) `(+ 1 ,a)) (object->string hi)) "hi")
+(test (let () (define (hi a) (+ 1 a)) (object->string hi)) "hi")
+(test (let () (define* (hi a) (+ 1 a)) (object->string hi)) "hi")
+(test (object->string dynamic-wind) "dynamic-wind")
+(test (object->string (dilambda (lambda () 1) (lambda (val) val))) "#<lambda ()>") ;"#<closure>"
+(test (object->string object->string) "object->string")
+(test (object->string 'if) "if")
+(test (object->string begin) "#_begin")
+(test (object->string let) "#_let")
+
+(test (object->string #\n #f) "n")
+(test (object->string #\n) "#\\n")
+(test (object->string #\r) "#\\r")
+(test (object->string #\r #f) "r")
+(test (object->string #\t #f) "t")
+(test (object->string #\t) "#\\t")
+
+(test (object->string #\a) "#\\a")
+(test (object->string #\a #t) "#\\a")
+(test (object->string #\a :write) "#\\a")
+(test (object->string #\a #f) "a")
+(test (object->string #\a :display) "a")
+
+(test (object->string "a\x00;b" #t) "\"a\\x00;b\"")
+(test (object->string "a\x00;b" #f) "a\x00;b")
+
+(let-temporarily (((*s7* 'print-length) 3))
+  (test (object->string (inlet :a 1 :b 2 :c 3 :d 4)) "(inlet 'a 1 'b 2 'c 3 ...)")
+  (test (object->string (vector 1 2 3 4)) "#(1 2 3 ...)")
+  (test (object->string #r(1 2 3 4)) "#r(1.0 2.0 3.0 ...)")
+  (test (object->string #i(1 2 3 4)) "#i(1 2 3 ...)")
+  (test (object->string (list 1 2 3 4)) "(1 2 3 ...)")
+  (test (object->string (list (list 1 2 3 4 5 6)
+			      (list 1 2 3 4 5 6)
+			      (list 1 2 3 4 5 6)
+			      (list 1 2 3 4 5 6)
+			      (list 1 2 3 4 5 6)))
+	"((1 2 3 ...) (1 2 3 ...) (1 2 3 ...) ...)"))
+;;; hash-tables with entries>1 are hard to check -- order of entries is not known
+(test (object->string (hash-table 'a 1) :readable) "(hash-table 'a 1)")
+(test (object->string (hash-table) :readable) "(hash-table)")
+(test (let ((h (object->string (hash-table 'a 1 'b 2) :readable)))
+	(or (string=? h "(hash-table 'a 1 'b 2)")
+	    (string=? h "(hash-table 'b 2 'a 1)")))
+      #t)
+(test (object->string (make-float-vector '(2 3) 1)) "#r2d((1.0 1.0 1.0) (1.0 1.0 1.0))")
+(test (object->string (immutable! #r(0.0)) :readable) "(immutable! #r(0.0))")
+(test (object->string (immutable! #i(0 1)) :readable) "(immutable! #i(0 1))")
+(test (object->string (immutable! #u(0)) :readable) "(immutable! #u(0))")
+(test (let-temporarily (((*s7* 'print-length) 0)) (object->string #u(1 2 3))) "#u(...)")
+(test (object->string (immutable! (make-string 1001 #\space)) :readable) "(immutable! (make-string 1001 #\\space))")
+(test (object->string #r(1 2 3 4) :readable 4) 'error)
+(test (object->string #r(1 2 3 4) :readable -4) 'error)
+(test (object->string #r(1 2 3 4) :readable most-negative-fixnum) 'error)
+(test (object->string #r(1 2 3 4) :readable 40) "#r(1.0 2.0 3.0 4.0)")
+(test (object->string #r(1 2 3 4) :readable most-positive-fixnum) "#r(1.0 2.0 3.0 4.0)")
+(test (object->string #r(1 2 3 4) :readable "hi") 'error)
+(test (let ((s (immutable! "abc"))) (define (f) (object->string (string-append (substring s 3)) :readable)) (f)) "\"\"")
+
+#|
+(do ((i 0 (+ i 1)))
+    ((= i 256))
+  (let ((c (integer->char i)))
+    (let ((str (object->string c)))
+      (if (and (not (= (length str) 3))       ; "#\\a"
+	       (or (not (char=? (str 2) #\x))
+		   (not (= (length str) 5)))) ; "#\\xee"
+	  (format #t "(#t) ~C: ~S~%" c str))
+      (set! str (object->string c #f))
+      (if (not (= (length str) 1))
+	  (format #t "(#f) ~C: ~S~%" c str)))))
+this prints:
+(#t) : "#\\null"
+(#f) : ""
+(#t) : "#\\x1"
+(#t) : "#\\x2"
+(#t) : "#\\x3"
+(#t) : "#\\x4"
+(#t) : "#\\x5"
+(#t) : "#\\x6"
+(#t) : "#\\x7"
+(#t): "#\\x8"
+(#t) 	: "#\\tab"
+(#t)
+: "#\\newline"
+(#t)
+     : "#\\xb"
+(#t)
+     : "#\\xc"
+: "#\\return"
+(#t) : "#\\xe"
+(#t) : "#\\xf"
+(#t)  : "#\\space"
+|#
+
+(test (object->string #\x30) "#\\0")
+(test (object->string #\x91) "#\\x91")
+(test (object->string #\x10) "#\\x10")
+(test (object->string #\xff) "#\\xff")
+(test (object->string #\x55) "#\\U")
+(test (object->string #\x7e) "#\\~")
+(test (object->string #\newline) "#\\newline")
+(test (object->string #\return) "#\\return")
+(test (object->string #\tab) "#\\tab")
+(test (object->string #\null) "#\\null")
+(test (object->string #\space) "#\\space")
+(test (object->string (integer->char 8)) "#\\backspace")
+(test (object->string ''#\a) "'#\\a")
+(test (object->string (list 1 '.' 2)) "(1 .' 2)")
+(test (object->string (quote (quote))) "(quote)")
+(test (object->string (quote quote)) "quote")
+(test (object->string (quote (quote (quote)))) "(quote (quote))")
+
+(test (object->string) 'error)
+(test (object->string 1 2) 'error)
+(test (object->string 1 #f #t) 'error)
+;(test (object->string 1 #t -123) 'error)
+(test (object->string 1 #t pi) 'error)
+(test (object->string abs) "abs")
+(test(let ((val 0)) (cond (else (set! val (object->string else)) 1)) val) "else")
+(test (cond (else (object->string else))) "else")
+(test (object->string (string->symbol (string #\; #\" #\)))) "(symbol \";\\\")\")")
+
+(test (object->string "hi" #f) "hi")
+(test (object->string "h\\i" #f) "h\\i")
+(test (object->string -1.(list? -1e0)) "-1.0")
+
+(test (object->string catch) "catch")
+(test (object->string lambda) "#_lambda")
+(test (object->string dynamic-wind) "dynamic-wind")
+(test (object->string quasiquote) "#_quasiquote")
+;(test (object->string else) "else") ; this depends on previous code
+(test (object->string do) "#_do")
+
+(for-each
+ (lambda (arg)
+   (test (object->string 1 arg) 'error)
+   (test (object->string arg) (with-output-to-string (lambda () (write arg))))
+   (test (object->string arg #t) (with-output-to-string (lambda () (write arg))))
+   (test (object->string arg #f) (with-output-to-string (lambda () (display arg)))))
+ (list "hi" -1 #\a 1 0 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i () (list 1 2 3) '(1 . 2)))
+
+(test (string->symbol (object->string #(1 #\a (3)) #f)) (symbol "#(1 #\\a (3))"))
+(test (string->list (object->string #(1 2) #f)) '(#\# #\( #\1 #\space #\2 #\)))
+(test (string->list (object->string #(1 #\a (3)) #f)) '(#\# #\( #\1 #\space #\# #\\ #\a #\space #\( #\3 #\) #\)))
+(test (reverse (object->string #2d((1 2) (3 4)) #f))  "))4 3( )2 1((d2#")
+
+;; write readably (this affects ~W in format as well)
+;; :readable special things
+(for-each
+ (lambda (n)
+   (let ((str (object->string n :readable)))
+     (let ((obj (with-input-from-string str
+		  (lambda ()
+		    (eval (read))))))
+       (if (not (eq? n obj))
+	   (format *stderr* "~A not eq? ~A (~S)~%" n obj str)))))
+ (list #<eof> #<undefined> #<unspecified> #t #f #true #false else ()
+       lambda lambda* begin case if do quote set! let let* letrec
+       cond and or define define* define-constant define-macro
+       define-macro* define-bacro define-bacro*
+       with-baffle
+       *stdin* *stdout* *stderr*))
+
+;; :readable characters
+(do ((i 0 (+ i 1)))
+    ((= i 256))
+  (let ((c (integer->char i)))
+    (let ((str (object->string c :readable)))
+      (let ((nc (with-input-from-string str
+		  (lambda ()
+		    (eval (read)))))) ; no need for eval here or in some other cases, but might as well be consistent
+	(if (not (eq? c nc))
+	    (format *stderr* "~C (~D) != ~C (~S)~%" c i nc str))))))
+
+;; :readable integers
+(for-each
+ (lambda (n)
+   (let ((str (object->string n :readable)))
+     (let ((nn (with-input-from-string str
+		 (lambda ()
+		   (eval (read))))))
+       (if (or (not (integer? n))
+	       (not (integer? nn))
+	       (not (= n nn)))
+	   (format *stderr* "~D != ~D (~S)~%" n nn str)))))
+ (list 0 1 3 most-positive-fixnum -0 -1 -3 most-negative-fixnum
+       -9223372036854775808 9223372036854775807))
+;; but unless gmp at read end we'll fail with most-positive-fixnum+1
+;; -> check *features* at start of read
+
+;; :readable ratios
+(for-each
+ (lambda (n)
+   (let ((str (object->string n :readable)))
+     (let ((nn (with-input-from-string str
+		 (lambda ()
+		   (eval (read))))))
+       (if (or (not (rational? n))
+	       (not (rational? nn))
+	       (not (= n nn)))
+	   (format *stderr* "~A != ~A (~S)~%" n nn str)))))
+ (list 1/2 -1/2 123456789/2 -2/123456789 2147483647/2147483646 312689/99532
+       -9223372036854775808/3 9223372036854775807/2  1/1428571428571429 1/1152921504606846976))
+
+(unless (provided? 'solaris)
+  ;; :readable reals
+  (for-each
+   (lambda (n)
+     (let ((str (object->string n :readable)))
+       (let ((nn (with-input-from-string str
+		   (lambda ()
+		     (eval (read))))))
+	 (if (or (not (real? n))
+		 (not (real? nn))
+		 (not (equivalent? n nn)))
+	     (format *stderr* "~A != ~A (~S)~%" n nn str)))))
+   (list 1.0 0.0 -0.0 pi 0.1 -0.1 0.9999999995 9007199254740993.1 (sqrt 2) 1/100000000000
+	 1.5e-16 1.5e16 3.141592653589793238462643383279502884197169399375105820 1e-300 8.673617379884e-19
+	 1/0 (- 1/0) (real-part (log 0)) (- (real-part (log 0)))))
+
+  ;; :readable complex
+  (for-each
+   (lambda (n)
+     (let ((str (object->string n :readable)))
+       (let ((nn (with-input-from-string str
+		   (lambda ()
+		     (eval (read))))))
+	 (if (or (not (complex? n))
+		 (not (complex? nn))
+		 (not (equivalent? n nn)))
+	     (format *stderr* "~A != ~A (~S)~%" n nn str)))))
+   (list 0+i 0-i 1+i 1.4+i 3.0+1.5i
+;	 (log 0) (- (log 0))
+;	 (complex 1/0 1.0) (complex 1/0 1/0) (complex 1.0 1/0) ; default: nan+1i nannani 1nani!
+;	 (complex 1/0 (real-part (log 0))) (complex (real-part (log 0)) 1/0)
+	 1e-14+1e14i 0+1e-16i (complex pi pi))))
+
+
+;; :readable strings/byte-vectors
+(for-each
+ (lambda (n)
+   (let ((str (object->string n :readable)))
+     (let ((obj (with-input-from-string str
+		  (lambda ()
+		    (eval (read))))))
+       (if (or (not (string? n))
+	       (not (string? obj))
+	       (not (string=? n obj)))
+	   (format *stderr* "~S not string=? ~S (~S)~%" n obj str)))))
+ (list "" "abc" (string #\newline) "#<abc>" "a\"b\"c" "a\\b\nc" "aBc"
+       (let ((s (make-string 4 #\space))) (set! (s 3) #\null) s) ; writes as "   \x00"
+       "ab
+c"
+       (string #\a #\b #\null #\c #\escape #\newline)
+       (string #\x (integer->char #xf0) #\x)
+       (string #\null)
+       ;#u() #u(0 1 2 3)
+       (let ((str (make-string 256 #\null)))
+	 (do ((i 0 (+ i 1)))
+	     ((= i 256) str)
+	   (set! (str i) (integer->char i))))))
+
+;; :readable symbols/keywords
+(catch #t
+  (lambda()
+    (for-each
+     (lambda (n)
+       (let ((str (object->string n :readable)))
+	 (let ((obj (with-input-from-string str
+		      (lambda ()
+			(eval (read))))))
+	   (if (or (not (symbol? n))
+		   (not (symbol? obj))
+		   (not (eq? n obj)))
+	       (format *stderr* "~A not eq? ~A (~S)~%" n obj str)))))
+     (list 'abc :abc abc:
+	   (symbol "a") (symbol "#<>")
+	   (gensym "|") (gensym "#<>") (gensym "}")
+	   ':: ':abc
+	   (gensym "\\"))))
+  (lambda (type info)
+    (format *stderr* "readable symbols: ~A ~A~%" type info)))
+
+;; :readable environments
+(for-each
+ (lambda (n)
+   (let ((str (object->string n :readable)))
+     (let ((obj (with-input-from-string str
+		  (lambda ()
+		    (eval (read))))))
+       (if (or (not (let? n))
+	       (not (let? obj))
+	       (not (equal? n obj)))
+	   (format *stderr* "~A not equal?~%~A~%    (~S)~%" n obj str)))))
+ (list (inlet '(a . 1))
+       (inlet)
+       (rootlet)
+       (inlet (cons 't12 "12") (cons (symbol "#<") 12))
+       (inlet 'a 1 'a 2)))
+
+;(test (object->string (list (owlet)) :readable) "(list (owlet))")
+
+;; :readable hash-tables
+(for-each
+ (lambda (n)
+   (let ((str (object->string n :readable)))
+     (let ((obj (with-input-from-string str
+		  (lambda ()
+		    (eval (read))))))
+       (if (or (not (hash-table? n))
+	       (not (hash-table? obj))
+	       (not (equal? n obj)))
+	   (format *stderr* ";readable hash-tables, ~A not equal? ~A (~S)~%" n obj str)))))
+ (list (hash-table 'a 1)
+       (hash-table 'a 1 'b "hi")
+       (let ((ht (make-hash-table 31)))
+	 (set! (ht 1) 321)
+	 (set! (ht 2) 123)
+	 ht)
+       (let ((ht (make-hash-table)))
+	 (set! (ht 'b) 1)
+	 (set! (ht 'a) ht)
+	 ht)
+       ;(let ((ht (make-hash-table))) (set! (ht ht) 123) ht)
+       ;(let ((ht (make-hash-table))) (set! (ht ht) ht)  ht)
+       (hash-table)))
+
+;; :readable vectors
+(let-temporarily (((*s7* 'print-length) 8))
+  (for-each
+   (lambda (p)
+     (set! (*s7* 'print-length) p)
+     (for-each
+      (lambda (n)
+	(let ((str (object->string n :readable)))
+	  (let ((obj (with-input-from-string str
+		       (lambda ()
+			 (eval (read))))))
+	    (if (or (not (vector? n))
+		    (not (vector? obj))
+		    (not (equal? n obj)))
+		(format *stderr* ";readable vectors, ~A not equal? ~A (~S)~%" n obj str)))))
+      (list #() #(1) #(1 #(2)) #2d((1 2) (3 4))
+	    #3d(((1 2 3) (4 5 6) (7 8 9)) ((9 8 7) (6 5 4) (3 2 1)))
+	    #2d()
+	    #(1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0)
+	    (let ((v (vector 1 2 3))) (set! (v 1) v) v)
+	    (let ((v (vector 1 #(2) 3))) (set! ((v 1) 0) v) v)
+	    (let ((v #2d((1 2 3) (4 5 6)))) (set! (v 1 1) v) v)
+	    (make-int-vector 3 0)
+	    (make-float-vector 3 0.0)
+	    (make-int-vector '(2 3) 1))))
+   (list 8 2 1)))
+
+(test (object->string (vector 1 2 3) :readable) "(vector 1 2 3)")
+(let ((v (make-vector '(2 3) #f)))
+  (set! (v 1 0) (v 0))
+  (test (object->string v) "#2d((#f #f #f) (#(#f #f #f) #f #f))")
+  (set! (v 0 1) 3)
+  (test (object->string v) "#2d((#f 3 #f) (#(#f 3 #f) #f #f))"))
+
+;; :readable lists (circular, dotted)
+(for-each
+ (lambda (n)
+   (let ((str (object->string n :readable)))
+     (let ((obj (with-input-from-string str
+		  (lambda ()
+		    (eval (read))))))
+       (if (or (not (pair? n))
+	       (not (pair? obj))
+	       (not (equal? n obj)))
+	   (format *stderr* ";readable lists, ~A not equal? ~A (~S)~%" n obj str)))))
+ (list '(1) '(1 . 2) '((1 ()) 3) '((1 2) (3 4))
+       '(1 2 . 3) '(1 2 3 . 4) '(())
+       (let ((lst (cons 1 2))) (set-cdr! lst lst) lst)
+       (let ((lst (list 1 2 3))) (set-cdr! (cddr lst) lst) lst)
+       (let ((lst (list 1 2 3))) (set-car! (cddr lst) lst) lst)
+       ))
+
+;; :readable macros
+(let ()
+  (define-macro (mac1) `(+ 1 2))
+  (test ((eval-string (object->string mac1 :readable))) 3)
+  (define-macro (mac2 a) `(+ ,a 2))
+  (test ((eval-string (object->string mac2 :readable)) 1) 3)
+  (define-macro* (mac3 (a 1)) `(+ ,a 2))
+  (test ((eval-string (object->string mac3 :readable))) 3)
+  (define-macro (mac4 . a) `(+ ,@a 2))
+  (test ((eval-string (object->string mac4 :readable)) 1 3) 6)
+  (define-macro (mac5 a b . c) `(+ ,a ,b ,@c 2))
+  (test ((eval-string (object->string mac5 :readable)) 1 5 3 4) 15)
+  (define-macro (mac7 a) (let ((b (+ a 1))) `(+ ,b ,a)))
+  (test ((eval-string (object->string mac7 :readable)) 2) 5)
+  )
+
+;; :readable closures/functions/built-in (C) functions + the setters thereof
+(for-each
+ (lambda (n)
+   (let ((str (object->string n :readable)))
+     (let ((obj (with-input-from-string str
+		  (lambda ()
+		    (eval (read))))))
+       (if (or (not (procedure? n))
+	       (not (procedure? obj))
+	       (not (equal? (procedure-source n) (procedure-source obj))))
+	   (format *stderr* "'~A not equal? '~A (~S)~%" n obj str)))))
+ (list abs
+       (lambda () 1)
+       (lambda (a) (+ a 1))
+       (lambda args (display args) (cdr args))
+       (lambda* (a b) (or a b))
+       (let ((a 1)) (lambda (b) (+ a b)))
+       (let ((b 2)) (let ((a 1)) (lambda* (c . d) (display (+ a b c) *stdout*) d)))
+       (lambda* (:rest b) b)
+       ))
+
+(for-each
+ (lambda (n)
+   (let ((str (object->string n :readable)))
+     (test ((eval-string str) 21) (n 21))))
+ (list (lambda (a) (+ a 1))
+       (lambda args (cdr args))
+       (lambda* (a b) (or a b))
+       (let ((a 1)) (lambda (b) (+ a b)))
+       (let ((b 2)) (let ((a 1)) (lambda* (c . d) (+ a b c))))
+       (lambda* (:rest b) b)
+       ))
+
+(catch #t
+  (lambda ()
+    (let ()
+      (define* (f1 a :allow-other-keys) (+ a 1))
+      (let ((str (object->string f1 :readable)))
+	(let ((obj (with-input-from-string str
+		     (lambda ()
+		       (eval (read))))))
+	  (test (f1 2 :b 3) 3)
+	  (test (obj 2) 3)
+	  (test (obj 2 :b 3) 3))))) ; too many args
+  (lambda (type info)
+    (format *stderr* "f1 readable write: ~A ~A~%" type info)))
+
+(when (zero? (*s7* 'debug))
+  (test (format #f "~W" (lambda args args)) "(lambda args args)")
+  (test (format #f "~W" (lambda (a . b) a)) "(lambda (a . b) a)")
+  (test (format #f "~W" (lambda* (a b :rest c) a)) "(lambda* (a b :rest c) a)")
+  (test (format #f "~W" (lambda (a b . c) a)) "(lambda (a b . c) a)")
+  (test (format #f "~W" (lambda* (a . b) a)) "(lambda* (a . b) a)")
+  (test (format #f "~W" (dilambda (lambda () 1) (lambda (x) x))) "(dilambda (lambda () 1) (lambda (x) x))")
+  (test (format #f "~W" (dilambda (lambda (a . b) 1) (lambda (x) x))) "(dilambda (lambda (a . b) 1) (lambda (x) x))")
+  (test (let () (define (func args) args) (format #f "~W" func)) "(lambda (args) args)")
+  (test (let () (define func (lambda (a . b) a)) (format #f "~W" func)) "(lambda (a . b) a)")
+  (test (let () (define func (lambda args args)) (format #f "~W" func)) "(lambda args args)")
+  (test (format #f "~W" (define _definee_ (lambda args args))) "(lambda args args)")
+  (test (format #f "~W" (define _definee_ (dilambda (lambda args args) (lambda args args)))) "(dilambda (lambda args args) (lambda args args))")
+  (test (format #f "~W" (let () (define (func) (define _definee_ (dilambda (lambda args args) (lambda c c)))) (func))) "(dilambda (lambda args args) (lambda c c))"))
+
+(let ()
+  (define (f) (display #_:ho)) ; :hi initval set to abs somewhere earlier
+  (test (object->string f :readable) "(lambda () (display #_:ho))"))
+
+(let ()
+  (define f (apply lambda (list ()
+                     (list 'let (list (list (symbol "a b") 3))
+                       (symbol "a b")))))
+
+  (test (f) 3)
+  (test (object->string f :readable) "(lambda () (let (((symbol \"a b\") 3)) (symbol \"a b\")))")) ; which is not readable!
+
+(let ()
+  (apply define (list (symbol "a bc") 34))
+  (test (symbol->value (symbol "a bc")) 34))
+
+;; :readable ports
+(for-each
+ (lambda (n)
+   (let ((str (object->string n :readable)))
+     (let ((obj (with-input-from-string str
+		  (lambda ()
+		    (eval (read))))))
+       (if (or (not (input-port? n))
+	       (not (input-port? obj))
+	       (not (equal? (port-closed? n) (port-closed? obj))))
+	   (format *stderr* "~A not equal? ~A (~S)~%" n obj str)
+	   (if (and (not (port-closed? n))
+		    (not (eq? n *stdin*))
+		    (not (eq? n (current-input-port))))
+	       (let ((c1 (read-char n))
+		     (c2 (read-char obj)))
+		 (if (not (equal? c1 c2))
+		     (format *stderr* "read-char results ~A not equal? ~A (~S)~%" c1 c2 str)))))
+       (if (and (not (eq? n *stdin*))
+		(not (eq? n (current-input-port))))
+	   (begin
+	     (close-input-port n)
+	     (close-input-port obj))))))
+ (list *stdin*
+       (open-input-string "a test")
+       (call-with-input-string "a test" (lambda (p) p))
+       (let ((p (open-input-string "a test"))) (read-char p) p)
+       (call-with-input-file "s7test.scm" (lambda (p) p))
+       (open-input-file "write.scm")
+       (let ((p (open-input-file "write.scm"))) (read-char p) p)))
+
+;; :readable environments
+(catch #t
+  (lambda ()
+    (for-each
+     (lambda (n)
+       (let ((str (object->string n :readable)))
+	 (let ((obj (with-input-from-string str
+		      (lambda ()
+			(eval (read))))))
+	   (if (or (not (let? n))
+		   (not (let? obj))
+		   (not (equal? n obj)))
+	       (format *stderr* "~A not equal? ~A (~S)~%" n obj str)))))
+     (list (rootlet)
+	   (let ((a 1)) (curlet))
+	   (let ((a 1) (b 2)) (curlet)))))
+  (lambda (type info)
+    (format *stderr* "readable envs: ~A ~A~%" type info)))
+
+(when with-block
+  (let ((b (block 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0)))
+    (let-temporarily (((*s7* 'print-length) 2))
+      (test (format #f "~W" b) "(block 1 2 3 4 5 6 7 8)")
+      (test (format #f "~A" b) "(block 1.000 2.000 ...)"))))
+
+(when (zero? (*s7* 'debug))
+  (test (object->string (define (ex1 a b) (+ a  b)) :readable) "(lambda (a b) (+ a b))")
+  (test (object->string (let ((c 3)) (define (ex1 a b) (+ a c b))) :readable) "(let ((c 3)) (lambda (a b) (+ a c b)))")
+  (test (object->string (let ((c 3)) (define (ex1) (+ c 1))) :readable) "(let ((c 3)) (lambda () (+ c 1)))")
+  (test (object->string (define* (ex1 a (b 0)) (+ a  b)) :readable) "(lambda* (a (b 0)) (+ a b))")
+  ;(test (object->string (define (ex1 a . b) (+ a  b)) :readable) "(lambda (a . b) (+ a b))")
+
+  (let-temporarily (((*s7* 'print-length) 4))
+    (define (f1) (vector-ref #(0 1 2 3 4 5 6 7 8) 2))
+    (test (object->string f1 :readable) "(lambda () (vector-ref #(0 1 2 3 4 5 6 7 8) 2))")))
+
+(test (object->string (make-iterator #u(12 41 2)) :readable) "(make-iterator #u(12 41 2))")
+(test (object->string (let ((iter (make-iterator #u(12)))) (iter) (iter) iter) :readable) "(make-iterator #u())")
+(test (object->string (let ((iter (make-iterator "h"))) (iter) (iter) iter) :readable) "(make-iterator \"\")")
+(test (object->string (let ((iter (make-iterator #r(1)))) (iter) (iter) iter) :readable) "(make-iterator #r())")
+(test (object->string (let ((iter (make-iterator #i(1)))) (iter) (iter) iter) :readable) "(make-iterator #i())")
+(test (object->string (let ((iter (make-iterator #(1)))) (iter) (iter) iter) :readable) "(make-iterator #())")
+(test (object->string (let ((iter (make-iterator (hash-table)))) (iter) iter) :readable) "(make-iterator (hash-table))")
+(test (object->string (inlet) :readable) "(inlet)")
+(test (object->string (inlet 'a 1) :readable) "(inlet :a 1)")
+(test (object->string (inlet 'a 1 'b 2) :readable) "(inlet :a 1 :b 2)")
+(test (object->string (inlet 'a #\1) :readable) "(inlet :a #\\1)")
+(test (object->string (inlet 'a #\newline) :readable) "(inlet :a #\\newline)")
+(test (object->string (inlet 'a #\null) :readable) "(inlet :a #\\null)")
+(test (object->string (inlet 'a 3.0) :readable) "(inlet :a 3.0)")
+(test (object->string (inlet 'a 1/2) :readable) "(inlet :a 1/2)")
+(test (object->string (inlet 'a 1+i) :readable) "(inlet :a 1.0+1.0i)")
+(test (object->string (inlet 'a (log 0)) :readable) "(inlet :a -inf.0+3.141592653589793i)")
+(test (object->string (inlet 'a 1/0) :readable) "(inlet :a +nan.0)")
+(test (object->string (inlet 'a "1") :readable) "(inlet :a \"1\")")
+(test (object->string (inlet 'a "") :readable) "(inlet :a \"\")")
+(test (object->string (inlet 'a #<undefined>) :readable) "(inlet :a #<undefined>)")
+(test (object->string (inlet 'a #<unspecified>) :readable) "(inlet :a #<unspecified>)")
+(test (object->string (inlet 'a #<eof>) :readable) "(inlet :a (begin #<eof>))")
+(test (object->string (inlet 'a lambda) :readable) "(inlet :a #_lambda)")
+(test (object->string (inlet 'a 'b) :readable) "(inlet :a 'b)")
+(test (object->string (inlet 'a (symbol "( a b c )")) :readable) "(inlet :a (symbol \"( a b c )\"))")
+(test (object->string (inlet 'a else) :readable) "(inlet :a 'else)")
+(test (object->string (inlet 'a (cons 1 2)) :readable) "(inlet :a (cons 1 2))")
+(test (object->string (inlet 'a (list 1 2)) :readable) "(inlet :a (list 1 2))")
+(test (object->string (inlet 'a (list "hi")) :readable) "(inlet :a (list \"hi\"))")
+(test (object->string (inlet 'a ()) :readable) "(inlet :a ())")
+(test (object->string (inlet 'a '(1 2 . 3)) :readable) "(inlet :a (cons 1 (cons 2 3)))")
+(test (object->string (inlet 'a #t) :readable) "(inlet :a #t)")
+(test (object->string (inlet 'a #f) :readable) "(inlet :a #f)")
+(test (object->string (inlet 'a :b) :readable) "(inlet :a :b)")
+(test (object->string (inlet 'a (hash-table)) :readable) "(inlet :a (hash-table))")
+(test (object->string (inlet 'a (hash-table 'b 1))  :readable) "(inlet :a (hash-table 'b 1))")
+(test (object->string (inlet 'a (hash-table 'b "hi")) :readable) "(inlet :a (hash-table 'b \"hi\"))")
+(test (object->string (inlet 'a (hash-table 'b "h\"i")) :readable) "(inlet :a (hash-table 'b \"h\\\"i\"))")
+(test (object->string (inlet 'a #()) :readable) "(inlet :a #())")
+(test (object->string (inlet 'a #(1 2 3)) :readable) "(inlet :a (vector 1 2 3))")
+(test (object->string (inlet 'a (vector "hi" #\a 'b)) :readable) "(inlet :a (vector \"hi\" #\\a 'b))")
+(test (object->string (inlet 'a (float-vector 1 2 3)) :readable) "(inlet :a #r(1.0 2.0 3.0))")
+(test (object->string (inlet 'a (int-vector 1 2 3)) :readable) "(inlet :a #i(1 2 3))")
+(test (object->string (inlet 'a #2d((1 2 3) (4 5 6))) :readable) "(inlet :a (subvector (vector 1 2 3 4 5 6) 0 6 '(2 3)))")
+(test (or (equal? (object->string (inlet 'a abs) :readable) "(inlet :a abs)") (equal? (object->string (inlet 'a abs) :readable) "(inlet :a #_abs)")) #t)
+(when (zero? (*s7* 'debug))
+  (test (object->string (inlet 'a (lambda (b) (+ b 1))) :readable) "(inlet :a (lambda (b) (+ b 1)))")
+  (test (object->string (inlet 'a (lambda b (list b 1))) :readable) "(inlet :a (lambda b (list b 1)))")
+  (test (object->string (inlet 'a (lambda (a . b) (list a b))) :readable) "(inlet :a (lambda (a . b) (list a b)))")
+  (test (object->string (inlet 'a (define-macro (_m_ b) `(+ ,b 1))) :readable) "(inlet :a (macro (b) (list-values '+ b 1)))")
+  (test (object->string (inlet 'a (define-bacro (_m_ b) `(+ ,b 1))) :readable) "(inlet :a (bacro (b) (list-values '+ b 1)))")
+  (test (object->string (inlet 'a (macro () `(+ ,b 1))) :readable) "(inlet :a (macro () (list-values '+ b 1)))")
+  (test (object->string (inlet 'a (bacro () `(+ ,b 1))) :readable) "(inlet :a (bacro () (list-values '+ b 1)))")
+  (test (object->string (inlet 'a (lambda* ((b 1)) (+ b 1))) :readable) "(inlet :a (lambda* ((b 1)) (+ b 1)))")
+  (test (object->string (inlet 'a (lambda* a (list a))) :readable) "(inlet :a (lambda a (list a)))")  ; lambda* until 22-Jan-19
+  (test (object->string (inlet 'a (lambda* (a (b 1) c) (list a b c))) :readable) "(inlet :a (lambda* (a (b 1) c) (list a b c)))")
+  (test (object->string (inlet 'a (define-macro* (_m_ (b 1)) `(+ ,b 1))) :readable) "(inlet :a (macro* ((b 1)) (list-values '+ b 1)))")
+  (test (object->string (inlet 'a (define-bacro* (_m_ (b 1)) `(+ ,b 1))) :readable) "(inlet :a (bacro* ((b 1)) (list-values '+ b 1)))")
+  (test (object->string (inlet 'a (macro (x . y) `(+ ,x ,@y))) :readable) "(inlet :a (macro (x . y) (list-values '+ x (apply-values y))))")
+  (test (object->string (inlet 'a (bacro* (b :rest c) `(+ ,b ,@c))) :readable) "(inlet :a (bacro* (b :rest c) (list-values '+ b (apply-values c))))"))
+(when with-block
+  (test (object->string (inlet 'a (block)) :readable) "(inlet :a (block))")
+  (test (object->string (inlet 'a blocks) :readable) "(inlet :a blocks)")
+  (test (object->string (inlet 'a (block 1 2 3)) :readable) "(inlet :a (block 1 2 3))"))
+(test (object->string (inlet 'a (c-pointer 0)) :readable) "(inlet :a (c-pointer 0))")
+(test (object->string (inlet 'a (c-pointer 1)) :readable) "(inlet :a (c-pointer 1))")
+(test (object->string (inlet 'a quasiquote) :readable) "(inlet :a #_quasiquote)")
+(when (zero? (*s7* 'debug))
+  (test (object->string (inlet 'a (let ((b 1)) (lambda () b))) :readable) "(inlet :a (let ((b 1)) (lambda () b)))")
+  (test (object->string (inlet 'a (dilambda (lambda () 1) (lambda (x) x))) :readable) "(inlet :a (dilambda (lambda () 1) (lambda (x) x)))")
+  (test (object->string
+       (inlet 'a (let ((y 1)) (dilambda (lambda () y) (lambda (x) (set! y x))))) :readable)
+      "(inlet :a (let ((y 1)) (dilambda (lambda () y) (lambda (x) (set! y x)))))"))
+(test (object->string (inlet 'a (inlet 'b 1)) :readable) "(inlet :a (inlet :b 1))")
+(test (object->string (inlet 'a (open-input-string "123456")) :readable) "(inlet :a (open-input-string \"123456\"))")
+(test (object->string (inlet 'a (let ((p (open-input-string "123456"))) (read-char p) p)) :readable) "(inlet :a (open-input-string \"23456\"))")
+(test (object->string (inlet 'a (let ((p (open-input-string "1"))) (read-char p) p)) :readable) "(inlet :a (open-input-string \"\"))")
+(test (object->string (inlet 'a (let ((p (open-input-string "1"))) (read-char p) (read-char p) p)) :readable) "(inlet :a (open-input-string \"\"))")
+(test (object->string (inlet 'a (call-with-input-string "1" (lambda (p) p))) :readable) "(inlet :a (call-with-input-string \"\" (lambda (p) p)))")
+(test (object->string (inlet 'a (let ((p (open-input-string "1"))) (close-input-port p) p)) :readable) "(inlet :a (call-with-input-string \"\" (lambda (p) p)))")
+(test (object->string (inlet 'a *stdin*) :readable) "(inlet :a *stdin*)")
+(test (object->string (inlet 'a *stdout*) :readable) "(inlet :a *stdout*)")
+(test (object->string (inlet 'a *stderr*) :readable) "(inlet :a *stderr*)")
+(test (object->string
+       (inlet 'a (let ((p (open-output-string))) (close-output-port p) p)) :readable)
+      "(inlet :a (let ((p (open-output-string))) (close-output-port p) p))")
+(test (object->string (inlet 'a (open-output-string)) :readable) "(inlet :a (let ((p (open-output-string))) p))")
+(test (object->string
+       (inlet 'a (let ((p (open-output-string))) (display 32 p) p)) :readable)
+      "(inlet :a (let ((p (open-output-string))) (display \"32\" p) p))")
+(test (object->string (inlet 'a (open-output-file "test.test")) :readable) "(inlet :a (open-output-file \"test.test\" \"a\"))")
+(test (object->string (inlet 'a (open-input-file "test.test")) :readable) "(inlet :a (open-input-file \"test.test\"))")
+(test (object->string (inlet 'a (make-iterator "123")) :readable) "(inlet :a (make-iterator \"123\"))")
+(test (object->string (inlet 'a (let ((iter (make-iterator "123"))) (iter) iter)) :readable) "(inlet :a (make-iterator \"23\"))")
+(test (object->string (inlet 'a (make-iterator #(1 2 3))) :readable) "(inlet :a (make-iterator (vector 1 2 3)))")
+(test (object->string (inlet 'a (make-iterator '(1 2 3))) :readable) "(inlet :a (make-iterator (list 1 2 3)))")
+(test (object->string
+       (inlet 'a (let ((iter (make-iterator (float-vector 1 2 3)))) (iter) iter)) :readable)
+      "(inlet :a (let ((iter (make-iterator #r(1.0 2.0 3.0)))) (iter) iter))")
+
+(let ((ok #f))
+  (test (begin (set! ok (eq? (rootlet) (outlet (outlet (curlet))))) #f) #f)
+  (when (and ok (zero? (*s7* 'debug))) ; other test macros add layers here making these tests unhappy
+    (test (object->string (let () (define (f1) (+ a 1)) (curlet)) :readable)
+	   "(sublet (sublet (inlet :ok #t)) :f1 (lambda () (+ a 1)))")
+    (test (object->string (let () (define (f1) 1) (let () (define f2 f1) (curlet))) :readable)
+	  "(sublet (sublet (sublet (inlet :ok #t)) :f1 (lambda () 1)) :f2 (lambda () 1))")
+    (test (object->string
+	   (let ((a 1)) (define d (let ((b 1)) (lambda (c) (+ a b c)))) (curlet)) :readable)
+	  "(sublet (sublet (inlet :ok #t)) :d (let ((b 1) (a 1)) (lambda (c) (+ a b c))) :a 1)")
+    (test (object->string
+	   (let () (define a (let ((b 1) (c 2)) (lambda (d) (+ b c d)))) (curlet)) :readable)
+	  "(sublet (sublet (inlet :ok #t)) :a (let ((c 2) (b 1)) (lambda (d) (+ b c d))))")
+    (test (object->string (let ((a 1)) (define d (let ((b 1)) (let ((c b)) (lambda (e) (+ a b c e))))) (curlet)) :readable)
+	  "(sublet (sublet (inlet :ok #t)) :d (let ((c 1) (b 1) (a 1)) (lambda (e) (+ a b c e))) :a 1)")
+    (test (object->string (inlet 'a (let ((b 1)) (lambda () (+ b c)))) :readable) "(inlet :a (let ((b 1)) (lambda () (+ b c))))")
+    (test (object->string (inlet 'a (let ((b 1)) (lambda () (+ b pi)))) :readable) "(inlet :a (let ((b 1)) (lambda () (+ b pi))))")
+    (test (object->string (let* ((a 1) (b a)) (curlet)) :readable)
+	  ;; "(sublet (sublet (sublet (inlet :ok #t)) :a 1) :b 1)"
+          "(sublet (sublet (inlet :ok #t)) :a 1 :b 1)") ; depends on op_let_star1
+    (test (object->string (let ((a 1)) (define (b c) (+ c a)) (curlet)) :readable)
+	  "(sublet (sublet (inlet :ok #t)) :b (let ((a 1)) (lambda (c) (+ c a))) :a 1)")))
+
+(test (string? (object->string (let ((lst (list 1))) (set-cdr! lst lst) (make-iterator lst)) :readable)) #t)
+
+;;; these are not readable:
+(test (object->string (inlet 'a (call-with-exit (lambda (return) return))) :readable) "(inlet :a #<goto return>)")
+(test (object->string (inlet 'a (call/cc (lambda (return) return))) :readable) "(inlet :a #<continuation return>)")
+
+;;; these are incorrect:
+;(test (object->string (let () (define-constant a 32) (curlet)) :readable) "(inlet :a 32)")
+;(test (object->string #('1)) "(vector '1)")
+;(test (object->string (inlet 'a ''()) :readable) "(inlet :a '())")
+(test (object->string (c-pointer 1234) :readable) "(c-pointer 1234)")
+
+(test (string? (catch 'out-of-range
+		 (lambda ()
+		   (object->string (*s7* 'gc-protected-objects) :readable))
+		 (lambda (type info)
+		   "<unprintable>")))
+      #t)
+(test (object->string (*s7* 'c-objects) :readable) "#<undefined>")
+(test (string? (object->string (*s7* 'file-names) :readable)) #t)
+(test (string? (object->string (*s7* 'c-types) :readable)) #t)
+(test (string? (object->string (*s7* 'cpu-time) :readable)) #t)
+(test (string? (object->string (*s7* 'catches) :readable)) #t)
+(test (object->string (let ((car 1)) (list #_car (list 'car))) :readable) "(list #_car (list 'car))")
+
+(let ((ht (hash-table 'a 1))
+      (lt (inlet :b 1))
+      (lst (list 1)))
+  (set! (ht 'a) lst)
+  (set! (lst 0) lt)
+  (set! (lt 'b) ht)
+  (test (object->string ht) "#1=(hash-table 'a ((inlet 'b #1#)))"))
+
+(let ((ht (hash-table 'a 1)))
+  (fill! ht ht)
+  (test (object->string ht) "#1=(hash-table 'a #1#)"))
+
+(let ((ht (hash-table 'a 1)))
+  (set! (ht 'a) ht)
+  (fill! ht (list ht))
+  (test (object->string ht) "#1=(hash-table 'a (#1#))"))
+
+(let ((ht (hash-table 'a 1)))
+  (let ((lt (curlet)))
+    (set! (ht 'a) ht)
+    (fill! ht (list lt))
+    (test (object->string ht) "#1=(hash-table 'a ((inlet 'ht #1#)))")))
+
+(if (not with-bignums)
+    (begin
+      (test (object->string (random-state 123 321)) "#<random-state 123 321>")
+      (test (object->string (random-state 9223372036854775807 9223372036854775807)) "#<random-state 9223372036854775807 9223372036854775807>")
+      (test (object->string (random-state 123 321) :readable) "(random-state 123 321)")
+      (test (object->string (random-state 9223372036854775807 9223372036854775807) :readable) "(random-state 9223372036854775807 9223372036854775807)"))
+    (begin
+      (test (object->string (rootlet) #f (bignum "80")) "(rootlet)")
+      (test (substring (object->string (random-state 9223372036854775807)) 0 6) "#<rand")
+      (test (object->string (random-state 9223372036854775807) :readable) "#<bignum random-state>")))
+
+(let ((str (object->string   ; "stack smashing" bug if vector_to_port buf/indices are too small
+             (subvector (let ((<3> (vector #f #f #f))
+			      (<1> #f)
+			      (<2> (list #f #f #f)))
+			   (set! <1> (make-iterator <2>))
+			   (set! (<3> 0) <1>)
+			   (set! (<2> 2) <1>)
+			   <3>)
+			 0 1 (make-list 256 1))
+	    :readable)))
+  (test (string-wi=? str "(let ((<3> (subvector (vector #f) 0 1 '(1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)))
+      (<1> #f)
+      (<2> (list #f #f #f)))
+  (set! <1> (make-iterator <2>))
+  (set! (<3> 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) <1>)
+   (set! (<2> 2) <1>)
+  <3>)\n") #t))
+
+#|
+(when with-bignums ; and have libarb
+  (system "gcc -fPIC -c libarb_s7.c")
+  (system "gcc libarb_s7.o -shared -o libarb_s7.so -lflint -larb")
+  (load "libarb_s7.so" (inlet 'init_func 'libarb_s7_init))
+  (test (= (acb_bessel_j 0 1.0) 7.651976865579665514497175261026632209096E-1) #t)
+  (test (length *arb*) 86))
+|#
+
+(when full-s7test
+  (let ()
+    (define (testlet e)
+      (let ((data (cons #f #f)))
+	(let ((iter (make-iterator e data)))
+	  (do ((val (iterate iter) (iterate iter)))
+	      ((iterator-at-end? iter))
+	    (let ((sym (car val))
+		  (fnc (cdr val)))
+	      (if (procedure? fnc)
+		  (let ((sig (catch #t (lambda () (signature fnc)) (lambda args #f)))
+			(doc (catch #t (lambda () (documentation fnc)) (lambda args #f)))
+			(src (catch #t (lambda () (procedure-source fnc)) (lambda args #f)))
+			(ari (catch #t (lambda () (arity fnc)) (lambda args #f))))
+		    (let ((lst (list sym fnc sig doc src ari)))
+		      (object->string lst)
+		      (object->string lst :readable)))
+		  (begin
+		    (object->string val)
+		    (object->string val :readable))))))))
+
+    (testlet (rootlet))
+
+    (require libc.scm)
+    (testlet *libc*)
+
+    (require libm.scm)
+    (when (defined? '*libm*) (testlet *libm*))
+    (test (load (append "/home/" username "/cl/libm_s7.so") (inlet 'init_func 'libm_s7_init)) #f) ; check full-filename with absolute path
+
+    (require libgsl.scm)
+    (when (defined? '*libgsl*) (testlet *libgsl*))
+
+    (require libgdbm.scm)
+    (when (defined? '*libgdbm*) (testlet *libgdbm*))
+
+    (require libdl.scm)
+    (when (defined? '*libdl*) (testlet *libdl*))
+
+    (unless (provided? 'osx)
+      (require libutf8proc.scm)
+      (when (defined? '*libutf8proc*) (testlet *libutf8proc*)))))
+
+(let ((len 5))
+  (test (object->string (make-list 20) #f len) "(#...")
+  (test (object->string (list 1 (list 2 3 4 (list 5 6 7))) #f len) "(1...")
+  (test (object->string (make-string 20 #\a) #t len) "\"a...")
+  (test (object->string (make-string 20 #\space) #t len) "\" ...")
+  (test (object->string "0123456789" #f len) "01...")
+  (test (object->string (make-string 20 #\f) #f len) "ff...")
+  (test (object->string (make-byte-vector 20) #f len) "#u...")
+  (test (object->string (make-vector 20 #f) #f len) "#(...")
+  (test (object->string #2d((1 2 3) (4 5 6) (7 8 9) (10 11 12)) #f len) "#2...")
+  (test (object->string (make-int-vector 20) #f len) "#i...")
+  (test (object->string (make-float-vector 20) #f len) "#r...")
+  (test (object->string (hash-table 'a 1 'b 2 'c 3 'd 4 'e 5) #f len) "(h...")
+  (test (object->string (inlet 'a 1 'b 2 'c 3 'd 4 'e 5) #f len) "(i..."))
+
+(let ((len 0))
+  (test (object->string (make-list 20) #f len) "...")
+  (test (object->string (make-string 20 #\space) #t len) "...")
+  (test (object->string (make-byte-vector 20) #f len) "...")
+  (test (object->string (make-vector 20 #f) #f len) "...")
+  (test (object->string (hash-table 'a 1 'b 2 'c 3 'd 4 'e 5) #f len) "...")
+  (test (object->string (inlet 'a 1 'b 2 'c 3 'd 4 'e 5) #f len) "..."))
+
+(test (object->string (values) :readable) "#<unspecified>")
+
+(test (object->string pi :readable) (if with-bignums "3.141592653589793238462643383279502884195E0" "pi"))
+(test (object->string +inf.0 :readable) "+inf.0")
+(test (object->string -inf.0 :readable) "-inf.0")
+(test (object->string +nan.0 :readable) "+nan.0")
+(if with-block (test (object->string (block pi) :readable) "(block 3.141592653589793)"))
+(test (object->string (log 0) :readable) "-inf.0+3.141592653589793i")
+(unless with-bignums
+  (test (object->string 1/0 :readable) "+nan.0")
+  (test (object->string 1+1/0i :readable) "1.0+nan.0i")
+  (test (object->string -1/0-1/0i :readable) "+nan.0-nan.0i")
+  (test (object->string 0+0/0i :readable) "0.0+nan.0i"))
+(test (object->string (* (log 0) (log 0)) :readable) "+inf.0-inf.0i")
+(test (object->string (complex 1/0 (- (real-part (log 0))))) "+nan.0+inf.0i")
+
+(test (object->string (make-iterator ()) :readable) "(make-iterator ())")
+(test (object->string (make-iterator (float-vector)) :readable) "(make-iterator #r())")
+(test (object->string (make-iterator (inlet)) :readable) "(let ((iter (make-iterator (inlet)))) iter)")
+(test (object->string (make-iterator (hash-table)) :readable) "(make-iterator (hash-table))")
+(let ((iter (make-iterator #(1)))) (iter) (test (object->string iter :readable) "(let ((iter (make-iterator (vector 1)))) (iter) iter)"))
+(let ((iter (make-iterator "1"))) (iter) (test (object->string iter :readable) "(make-iterator \"\")"))
+(let ((iter (make-iterator (inlet)))) (iter) (test (object->string iter :readable) "(make-iterator (inlet))"))
+(test (object->string (make-iterator (inlet 'a 1 'b 2)) :readable)
+      "(let ((iter (make-iterator (inlet :a 1 :b 2)))) iter)")
+(test (let ((iter (make-iterator (inlet 'a 1 'b 2)))) (iter) (object->string iter :readable))
+      "(let ((iter (make-iterator (inlet :a 1 :b 2)))) (iter) iter)")
+(test (object->string (make-iterator (immutable! (inlet 'a 1 'b 1))) :readable)
+      "(let ((iter (make-iterator (immutable! (inlet :a 1 :b 1))))) iter)")
+(test (let ((iter (make-iterator (byte-vector 1 2 3)))) (object->string iter :readable)) "(make-iterator #u(1 2 3))")
+(test (let ((iter (make-iterator (byte-vector 1 2 3)))) (iter) (object->string iter :readable)) "(let ((iter (make-iterator #u(1 2 3)))) (iter) iter)")
+(test (equivalent? (make-iterator (object->string #\newline))
+		      (eval-string (object->string (make-iterator (object->string #\newline)) :readable)))
+      #t)
+(test (equivalent? (make-iterator (format #f "~S" #\xff))
+		      (eval-string (object->string (make-iterator (format #f "~S" #\xff)) :readable)))
+      #t)
+(test (equivalent? (make-iterator "1234") (eval-string (object->string (make-iterator "1234") :readable))) #t)
+
+(when (zero? (*s7* 'debug))
+  (test (let ((vect (vector (lambda (a) (+ a 1))))) (object->string vect :readable)) "(vector (lambda (a) (+ a 1)))")
+  (test (object->string (list (sublet (openlet (inlet 'abs (lambda (x) (- x)))) :allow-other-keys 1)) :readable)
+        "(list (openlet (sublet (openlet (inlet :abs (lambda (x) (- x)))) :allow-other-keys 1)))"))
+
+(test (> (length (object->string (copy '(x) (make-vector 1024 0)) :readable)) 1000) #t)
+(test (object->string (float-vector +nan.0) :readable) "#r(+nan.0)")
+(test (> (length (let ((fv (make-float-vector 1024))) (set! (fv 2) 1.0) (object->string fv :readable))) 1000) #t)
+
+(test (object->string (openlet (immutable! (inlet 'a 1))) :readable) "(openlet (immutable! (inlet :a 1)))")
+(test (object->string (sublet (inlet 'a 1)) :readable) "(sublet (inlet :a 1))")
+(test (object->string (sublet (inlet 'a 1) 'b 2) :readable) "(sublet (inlet :a 1) :b 2)")
+(test (object->string (sublet (sublet (inlet 'a 1) 'b 2) 'c 3) :readable)
+      "(sublet (sublet (inlet :a 1) :b 2) :c 3)")
+
+(test (object->string (quasiquote '2) :readable) "(list #_quote 2)")
+(test (object->string (quasiquote ''2) :readable) "(list #_quote (list #_quote 2))")
+(test (object->string (quasiquote (symbol->string 'x)) :readable) "(list 'symbol->string (list #_quote 'x))")
+(test (object->string (quasiquote (openlet? (list-ref -123 '#() (expt 2 32)))) :readable)
+      "(list 'openlet? (list 'list-ref -123 (list #_quote #()) (list 'expt 2 32)))")
+(test (format #f "~W" (list (list 'quote 2))) "(list (list 'quote 2))")
+(test (format #f "~W" (list 'quote 2)) "(list 'quote 2)")
+(test (format #f "~S" (list 'quote 2)) "(quote 2)")
+(test (format #f "~{~A ~}" (list 'quote 2)) "quote 2 ")
+(test (equal? ''2 (list #_quote 2)) #t)
+(test (equivalent? ''(vector #f) (list 'quote (vector #f))) #f)
+
+(when (zero? (*s7* 'debug))
+  (test (format #f "~W" (map (lambda (a b) (vector a b)) (quote (quote)) (inlet 'integer? (lambda (f) #f))))
+        "(list (vector 'quote (cons 'integer? (lambda (f) #f))))")
+  (test (format #f "~W" (list (list 'quote (cons 'integer? (lambda (y) #f))))) "(list (list 'quote (cons 'integer? (lambda (y) #f))))")
+  (test (let ((lst (list (lambda (y) #f)))) (format #f "~W" (list 'quote lst))) "(list 'quote (list (lambda (y) #f)))")
+  (test (let ((lst (list (lambda (y) #f)))) (format #f "~S" (list 'quote lst))) "(quote (#<lambda (y)>))")
+  (test (format #f "~W" (list 'quote (lambda () #f))) "(list 'quote (lambda () #f))")
+  (test (format #f "~W" (list 'quote 1 (lambda () #f))) "(list 'quote 1 (lambda () #f))")
+  (test (object->string (list (let ((local 1)) (lambda (x) (+ x local)))) :readable) "(list (let ((local 1)) (lambda (x) (+ x local))))"))
+
+(test (equivalent? ''(lambda () #f) (list 'quote (lambda () #f))) #f)
+(test (let ((lst (list 'quote (vector #f))))
+	(let ((nlst (eval-string (object->string lst :readable))))
+	  (equivalent? lst nlst)))
+      #t)
+(test (let ((lst (list 'quote (lambda () #f))))
+	(let ((nlst (eval-string (object->string lst :readable))))
+	  (equivalent? lst nlst)))
+      #t)
+
+(test (object->string (symbol "12") :readable) "(symbol \"12\")")
+(test (object->string (symbol "-1") :readable) "(symbol \"-1\")")
+(test (object->string (symbol "1.0") :readable) "(symbol \"1.0\")")
+(test (object->string (symbol "1+i") :readable) "(symbol \"1+i\")")
+(test (object->string (symbol "1+") :readable) "'1+")
+(test (object->string (symbol "1-") :readable) "'1-")
+(test (object->string (symbol (object->string ''2)) :readable) "(symbol \"'2\")")
+(test (object->string (symbol ",x") :readable) "(symbol \",x\")")
+
+(test (string-ref (eval-string (object->string (make-string 14766 (integer->char 255)) :readable)) 0) (integer->char 255))
+(test (string-ref (eval-string (object->string (make-string 14766 (integer->char 8)) :readable)) 0) (integer->char 8))
+(test (string-ref (eval-string (object->string (make-string 14766 (integer->char #x7f)) :readable)) 0) (integer->char #x7f))
+
+(test-wi (object->string (c-pointer 1 (signature +)) :readable)
+      "(let ((<1> (list 'number?)))
+         (set-cdr! <1> <1>)
+         (c-pointer 1 <1> #f))")
+
+(test (equivalent? (make-iterator (sublet (openlet (inlet 'abs (lambda (x) (- x))))))
+		   (eval-string (object->string (make-iterator (sublet (openlet (inlet 'abs (lambda (x) (- x)))))) :readable)))
+      #t)
+(test (equivalent? (inlet 'allow-other-keys #u(0 1)) (eval-string (object->string (inlet 'allow-other-keys #u(0 1)) :readable))) #t)
+
+(when (zero? (*s7* 'debug))
+(let ()
+  (define f1
+    (let ((+documentation+ "doc")
+	  (+signature+ '(#t pair?)))
+      (lambda (a)
+	(car a))))
+  (test (object->string f1 :readable) "(let ((+documentation+ \"doc\") (+signature+ (list #t 'pair?))) (lambda (a) (car a)))")
+
+  (define f2
+    (let ((+iterator+ #t)
+	  (+setter+ 'set-car!))
+      (lambda (a)
+	(car a))))
+  (test (object->string f2 :readable) "(let ((+iterator+ #t) (+setter+ 'set-car!)) (lambda (a) (car a)))")))
+
+#|
+;;; replace built-in object->string:
+(define (object->string . args)
+  (let ((obj (car args)))
+    (if (not (byte-vector? obj))
+	(apply #_object->string args)
+	(let ((len (length obj)))
+	  (if (zero? len)
+	      "#u()"
+	      (with-output-to-string
+		(lambda ()
+		  (display "#u(")
+		  (do ((i 0 (+ i 1)))
+		      ((= i (- len 1)))
+		    (format () "#o~O " (obj i)))
+		  (format () "#o~O)" (obj (- len 1))))))))))
+
+(display (object->string (byte-vector 10 14 18))) (newline)
+;; "#u(#o12 #o16 #o22)"
+;; but internal uses do not reflect this new definition
+|#
+
+(let ((v3 (make-vector '(2 2))))
+  (fill! v3 v3)
+  (test (object->string v3) "#1=#2d((#1# #1#) (#1# #1#))")
+  (test (let ()
+	  (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (display (vector-ref v3 0)))) ; -> subvector
+	  (define (hi) (func) (write-char #\space))
+	  (with-output-to-string (lambda () (hi) (hi))))
+	"#(#1=#2d((#1# #1#) (#1# #1#)) #1#) #(#1=#2d((#1# #1#) (#1# #1#)) #1#) "))
+
+(test (string? (object->string (make-list 100 (let ((<1> (list 1 #f))) (set! (<1> 1) (let ((<L> (list #f 3))) (set-car! <L> <1>) <L>)) <1>)) :readable)) #t)
+
+
+;;; ---------------- readable object->string of cyclic structures ----------------
+
+;;; ---------------- vectors ----------------
+(test-wi (let ((v (vector 1)))
+	(set! (v 0) v)
+	(object->string v :readable))
+      "(let ((<1> (vector #f)))
+         (set! (<1> 0) <1>)
+         <1>)")
+
+(test-wi (let ((v (vector 1 2 3)))
+	(set! (v 1) v)
+	(object->string v :readable))
+      "(let ((<1> (vector 1 #f 3)))
+         (set! (<1> 1) <1>)
+         <1>)")
+
+(test-wi (let ((v (vector 1 2 3)))
+	(set! (v 0) v)
+	(set! (v 2) v)
+	(object->string v :readable))
+      "(let ((<1> (vector #f 2 #f)))
+         (set! (<1> 0) <1>)
+         (set! (<1> 2) <1>)
+         <1>)")
+
+(test-wi (let ((v (vector 1)))
+	(set! (v 0) v)
+	(object->string (vector v) :readable))
+      "(let ((<1> (vector #f)))
+         (set! (<1> 0) <1>)
+         (vector <1>))")
+
+(test-wi (let ((v (vector 1 2 3)))
+	(set! (v 1) v)
+	(object->string (vector 1 2 v) :readable))
+      "(let ((<1> (vector 1 #f 3)))
+         (set! (<1> 1) <1>)
+         (vector 1 2 <1>))")
+
+(test-wi (let ((v1 (vector 1))
+	    (v2 (vector 2)))
+	(set! (v2 0) v1)
+	(set! (v1 0) v2)
+	(object->string v1 :readable))
+      "(let ((<1> (vector #f)))
+         (set! (<1> 0) (vector <1>))
+         <1>)")
+
+(test-wi (let ((v (vector #f)))
+	(set! (v 0) (vector v))
+	(object->string (vector 1 v 2) :readable))
+      "(let ((<1> (vector #f)))
+         (set! (<1> 0) (vector <1>))
+         (vector 1 <1> 2))")
+
+(test-wi (let ((v (vector #f)))
+	(set! (v 0) (vector 1 (vector v) 2))
+	(object->string v :readable))
+      "(let ((<1> (vector #f)))
+         (set! (<1> 0) (vector 1 (vector <1>) 2))
+         <1>)")
+
+(test-wi (let ((v (vector 1)))
+	(set! (v 0) v)
+	(object->string (immutable! v) :readable))
+      "(let ((<1> (vector #f)))
+         (set! (<1> 0) <1>)
+         (immutable! <1>))")
+
+(test-wi (let ((v (vector #f)))
+	(set! (v 0) (immutable! (vector v)))
+	(object->string (vector 1 v 2) :readable))
+      "(let ((<1> (vector #f)))
+         (set! (<1> 0) (immutable! (vector <1>)))
+         (vector 1 <1> 2))")
+
+(test-wi (let ((v1 (vector #f))
+	       (v2 (vector #f)))
+	   (set! (v1 0) v2)
+	   (set! (v2 0) v1)
+	   (object->string (vector v1 v2) :readable))
+	 "(let ((<1> (vector #f))
+                (<2> (vector #f)))
+            (set! (<1> 0) <2>)
+            (set! (<2> 0) <1>)
+            (vector <1> <2>))")
+
+(test-wi (let ((v1 (vector #f))
+	       (v2 (vector #f)))
+	   (set! (v1 0) v2)
+	   (set! (v2 0) v1)
+	   (object->string v1 :readable))
+	 "(let ((<1> (vector #f)))
+            (set! (<1> 0) (vector <1>))
+            <1>)")
+
+(test-wi (let ((v (vector 1 (vector 2))))
+	(set! (v 0) v)
+	(object->string v :readable))
+      "(let ((<1> (vector #f #f)))
+         (set! (<1> 0) <1>)
+         (set! (<1> 1) (vector 2))
+         <1>)")
+
+(test-wi (object->string (vector 1 (vector 2) 3) :readable) "(vector 1 (vector 2) 3)")
+
+(test-wi (let ((v (make-vector '(2 3) 1)))
+	   (set! (v 0 1) v)
+	   (object->string v :readable))
+	 "(let ((<1> (subvector (vector 1 #f 1 1 1 1) 0 6 '(2 3))))
+	   (set! (<1> 0 1) <1>)
+	   <1>)")
+
+
+;;; ---------------- lets ----------------
+(test-wi (let ((lt (inlet 'a 1)))
+	(set! (lt 'a) lt)
+	(object->string lt :readable))
+      "(let ((<1> (inlet :a #f)))
+         (set! (<1> :a) <1>)
+         <1>)")
+
+(test-wi (let ((lt (inlet 'a 1 'b 2)))
+	(set! (lt 'a) lt)
+	(object->string lt :readable))
+      "(let ((<1> (inlet :a #f :b 2)))
+         (set! (<1> :a) <1>)
+         <1>)")
+
+(test-wi (let ((lt (inlet 'a 1 'b 2)))
+	(set! (lt 'a) lt)
+	(object->string (vector lt) :readable))
+      "(let ((<1> (inlet :a #f :b 2)))
+         (set! (<1> :a) <1>)
+         (vector <1>))")
+
+(test-wi (let ((lt (inlet 'a 1 'b 2)))
+	(set! (lt 'a) lt)
+	(object->string (inlet 'c lt) :readable))
+      "(let ((<1> (inlet :a #f :b 2)))
+         (set! (<1> :a) <1>)
+         (inlet :c <1>))")
+
+(test-wi (let ((v (vector 1)))
+	(set! (v 0) (inlet 'a v))
+	(object->string v :readable))
+      "(let ((<1> (vector #f)))
+         (set! (<1> 0) (inlet :a <1>))
+         <1>)")
+
+(test-wi (let ((v (vector 1 2)))
+	(set! (v 0) (inlet 'a v))
+	(object->string (inlet 'c v 'd 4) :readable))
+      "(let ((<1> (vector #f 2)))
+         (set! (<1> 0) (inlet :a <1>))
+         (inlet :c <1> :d 4))")
+
+(test-wi (let ((lt (inlet 'a 1)))
+	(set! (lt 'a) lt)
+	(object->string (sublet lt) :readable))
+      "(let ((<1> (inlet :a #f)))
+         (set! (<1> :a) <1>)
+         (sublet <1>))")
+
+(test-wi (let ((lt (sublet (inlet 'b 2) 'a 1)))
+	(set! (lt 'a) lt)
+	(object->string lt :readable))
+      "(let ((<1> (inlet :a #f)))
+         (set! (outlet <1>) (inlet :b 2))
+         (set! (<1> :a) <1>)
+         <1>)")
+
+(test-wi (let ((lt (openlet (inlet 'a 1))))
+	(set! (lt 'a) lt)
+	(object->string (immutable! lt) :readable))
+      "(let ((<1> (openlet (inlet :a #f))))
+         (set! (<1> :a) <1>)
+         (immutable! <1>)
+         <1>)")
+
+(test-wi (let ((lt1 (inlet 'a 1))
+	       (lt2 (inlet 'b 1)))
+	   (set! (lt1 'a) lt2)
+	   (set! (lt2 'b) lt1)
+	   (object->string (vector lt1 lt2) :readable))
+	 "(let ((<1> (inlet :a #f))
+                (<2> (inlet :b #f)))
+            (set! (<1> :a) <2>)
+            (set! (<2> :b) <1>)
+            (vector <1> <2>))")
+
+(test-wi (object->string (inlet 'a (inlet 'b 1) 'b 2) :readable) "(inlet :a (inlet :b 1) :b 2)")
+(test-wi (object->string (inlet (symbol "(\")") 1) :readable) "(inlet (symbol \"(\\\")\") 1)")
+(test-wi (object->string (hash-table (symbol "(\")") 1) :readable) "(hash-table (symbol \"(\\\")\") 1)")
+(test-wi (object->string (vector (symbol "(\")") 1) :readable) "(vector (symbol \"(\\\")\") 1)")
+(test-wi (object->string (inlet (symbol "(\")") (symbol "(\")")) :readable) "(inlet (symbol \"(\\\")\") (symbol \"(\\\")\"))")
+
+(test-wi (object->string (let ((<1> (inlet :a #f))) (set! (<1> :a) (hash-table 'b <1>)) <1>) :readable)
+	 "(let ((<1> (inlet :a #f)))
+            (set! (<1> :a) (hash-table 'b <1>))
+            <1>)")
+
+(test-wi (object->string (let ((lt (inlet (symbol "(\")") 1))) (set! (lt (symbol "(\")")) lt) lt) :readable)
+	 "(let ((<1> (inlet (symbol \"(\\\")\") #f)))
+            (set! (<1> (symbol \"(\\\")\")) <1>)
+            <1>)")
+
+(test-wi (object->string (let ((<1> (inlet (symbol "(\")") #f))) (set! (<1> (symbol "(\")")) (hash-table 'b <1>)) <1>) :readable)
+	 "(let ((<1> (inlet (symbol \"(\\\")\") #f)))
+            (set! (<1> (symbol \"(\\\")\")) (hash-table 'b <1>))
+            <1>)")
+
+(test (object->string (inlet 'a 1) :readable) "(inlet :a 1)")
+(test (object->string (inlet 'a 1 'b 2) :readable) "(inlet :a 1 :b 2)")
+(let ((I1 (let ((a 1)) (immutable! 'a) (curlet)))) (test (object->string I1 :readable) "(let ((a 1)) (immutable! 'a) (curlet))"))
+(test (object->string (with-let (inlet 'a 1) (immutable! 'a) (curlet)) :readable) "(let ((a 1)) (immutable! 'a) (curlet))")
+(test (object->string (with-let (inlet 'a 1 'b 2) (immutable! 'a) (immutable! 'b) (curlet)) :readable) "(let ((a 1) (b 2)) (immutable! 'a) (immutable! 'b) (curlet))")
+
+(let ((I1 (openlet
+	   (immutable!
+	    (let ((a 1)
+		  (b 0))
+	      (immutable! 'a)
+	      (set! (setter 'b) (lambda (s v) (abs v)))
+	      (curlet))))))
+  (test (object->string I1 :readable)
+	"(openlet (immutable! (let ((a 1) (b 0)) (set! (setter 'b) (lambda (s v) (abs v))) (immutable! 'a) (curlet))))"))
+
+(let ((I1 (let ((a 1)
+		(b 0))
+	    (set! (setter 'a) (lambda (s v) (abs v)))
+	    (set! (setter 'b) (lambda (s v) (abs v)))
+	    (curlet))))
+  (test (object->string I1 :readable) "(let ((a 1) (b 0)) (set! (setter 'a) (lambda (s v) (abs v))) (set! (setter 'b) (lambda (s v) (abs v))) (curlet))"))
+
+(let ((I1 (let ((a (let ((L (list 1))) (set-cdr! L L)))) (immutable! 'a) (curlet))))
+  (test-wi (object->string I1 :readable) "(let ((<1> (list 1))) (set-cdr! <1> <1>) (let ((a <1>)) (immutable! 'a) (curlet)))"))
+
+(test-wi (let ((lt (inlet 'a 1))) (set! (lt 'a) lt) (object->string lt :readable)) "(let ((<1> (inlet :a #f))) (set! (<1> :a) <1>) <1>)")
+(test-wi (let ((lt (inlet 'a 1 'b 0))) (set! (lt 'a) lt) (object->string lt :readable)) "(let ((<1> (inlet :a #f :b 0))) (set! (<1> :a) <1>) <1>)")
+
+(test-wi (let ((lt (let ((a 1) (b 0)) (immutable! 'b) (curlet))))
+	   (set! (lt 'a) lt)
+	   (object->string lt :readable))
+	 "(let ((<1> (let ((a #f) (b 0)) (immutable! 'b) (curlet)))) (set! (<1> :a) <1>) <1>)")
+
+(test-wi (let ((lt (let ((a 1) (b 0)) (set! (setter 'a) let?) (immutable! 'b) (curlet))))
+	   (set! (lt 'a) lt)
+	   (object->string lt :readable))
+	 "(let ((<1> (let ((a #f) (b 0)) (set! (setter 'a) let?) (immutable! 'b) (curlet)))) (set! (<1> :a) <1>) <1>)")
+
+
+(let* ((H (hash-table))
+       (I (openlet (inlet 'a H)))
+       (V (make-vector 4 I)))
+  (set! (H (subvector V 0 4 '(2 2))) I)
+  (test-wi (format #f "~W~%" H) "(let ((<1> (hash-table))
+                                       (<2> (openlet (inlet :a #f))))
+                                   (set! (<1> (subvector (vector <2> <2> <2> <2>) 0 4 '(2 2))) <2>)
+                                   (set! (<2> :a) <1>)
+                                   <1>)"))
+(let* ((H (hash-table))
+       (I (immutable! (openlet (inlet 'a H))))
+       (V (make-vector 4 I)))
+  (set! (H (subvector V 0 4 '(2 2))) I)
+  (test-wi (format #f "~W~%" H) "(let ((<1> (hash-table))
+                                       (<2> (openlet (inlet :a #f))))
+                                   (set! (<1> (subvector (vector <2> <2> <2> <2>) 0 4 '(2 2))) <2>)
+                                   (set! (<2> :a) <1>)
+                                   (immutable! <2>)
+                                   <1>)")
+  (test (format #f "~S" (eval-string (format #f "~W" H))) (format #f "~S" H))
+  (test H (eval-string (format #f "~W" H))))
+
+(let* ((H (hash-table))
+       (I (immutable! (inlet 'a H)))
+       (V (make-vector 4 I)))
+  (set! (H (subvector V 0 4 '(2 2))) I)
+  (test-wi (format #f "~W~%" H) "(let ((<1> (hash-table))
+                                       (<2> (inlet :a #f)))
+                                   (set! (<1> (subvector (vector <2> <2> <2> <2>) 0 4 '(2 2))) <2>)
+                                   (set! (<2> :a) <1>)
+                                   (immutable! <2>)
+                                   <1>)"))
+(let* ((P (list 1))
+       (I (inlet 'a P))
+       (V (make-vector 4 I)))
+  (set-car! P (subvector V 0 4 '(2 2)))
+  (test-wi (format #f "~W~%" P) "(let ((<1> (list #f))
+                                       (<2> (inlet :a #f)))
+                                   (set-car! <1> (subvector (vector <2> <2> <2> <2>) 0 4 '(2 2)))
+                                   (set! (<2> :a) <1>)
+                                   <1>)"))
+(let* ((P (list 1))
+       (I (openlet (inlet 'a P)))
+       (V (make-vector 4 I)))
+  (set-car! P (subvector V 0 4 '(2 2)))
+  (test-wi (format #f "~W~%" P) "(let ((<1> (list #f))
+                                       (<2> (openlet (inlet :a #f))))
+                                   (set-car! <1> (subvector (vector <2> <2> <2> <2>) 0 4 '(2 2)))
+                                   (set! (<2> :a) <1>)
+                                   <1>)"))
+(let* ((P (list 1))
+       (I (immutable! (openlet (inlet 'a P))))
+       (V (immutable! (make-vector 4 I))))
+  (set-car! P (subvector V 0 4 '(2 2)))
+  (test-wi (format #f "~W~%" P) "(let ((<1> (list #f))
+                                       (<2> (openlet (inlet :a #f))))
+                                   (set-car! <1> (subvector (immutable! (vector <2> <2> <2> <2>)) 0 4 '(2 2)))
+                                   (set! (<2> :a) <1>)
+                                   (immutable! <2>)
+                                   <1>)"))
+
+(when (zero? (*s7* 'debug))
+  (test-wi (object->string (let ((i 0)) (set! (setter 'i) integer?) (curlet)) :readable)
+           "(let ((i 0)) (set! (setter 'i) #_integer?) (curlet))"))
+
+(let ((lt (let ((i 0) (inner #f)) (set! (setter 'i) integer?) (curlet))))
+  (set! (lt 'inner) lt)
+  (test-wi (object->string lt :readable)
+	   "(let ((<1> (let ((i 0) (inner #f)) (set! (setter 'i) #_integer?) (curlet))))
+              (set! (<1> :inner) <1>)
+              <1>)"))
+
+(let ((lt (let ((i 0) (inner #f)) (curlet))))
+  (set! (lt 'inner) lt)
+  (test-wi (object->string lt :readable)
+	   "(let ((<1> (inlet :i 0 :inner #f)))
+              (set! (<1> :inner) <1>)
+              <1>)"))
+
+(test-wi (object->string (let ((i 0) (inner #f)) (set! inner 32) (curlet)) :readable) "(inlet :i 0 :inner 32)")
+
+
+;;; ---------------- c-pointers ----------------
+(test-wi (let ((v (vector 1)))
+	   (let ((p (c-pointer 1 v)))
+	     (set! (v 0) p)
+	     (object->string p :readable)))
+	 "(let ((<1> #f)
+                (<2> (vector #f)))
+            (set! <1> (c-pointer 1 <2> #f))
+            (set! (<2> 0) <1>)
+            <1>)")
+
+(test-wi (let ((v (vector 1)))
+	   (let ((p (c-pointer 1 #f v)))
+	     (set! (v 0) p)
+	     (object->string p :readable)))
+	 "(let ((<1> #f)
+                (<2> (vector #f)))
+            (set! <1> (c-pointer 1 #f <2>))
+            (set! (<2> 0) <1>)
+            <1>)")
+
+(test-wi (let ((v (vector 1)))
+	   (let ((p (c-pointer 1 v v)))
+	     (set! (v 0) p)
+	     (object->string p :readable)))
+	 "(let ((<1> #f)
+                (<2> (vector #f)))
+            (set! <1> (c-pointer 1 <2> <2>))
+            (set! (<2> 0) <1>)
+            <1>)")
+
+(test-wi (object->string (c-pointer 1 (c-pointer 2)) :readable) "(c-pointer 1 (c-pointer 2) #f)")
+
+(test-wi (let ((v (vector 1))
+	       (i (inlet 'a 1)))
+	   (let ((p (c-pointer 0 v i)))
+	     (set! (v 0) p)
+	     (set! (i :a) p)
+	     (object->string p :readable)))
+	 "(let ((<1> #f)
+                (<2> (vector #f))
+                (<3> (inlet :a #f)))
+            (set! <1> (c-pointer 0 <2> <3>))
+            (set! (<2> 0) <1>)
+            (set! (<3> :a) <1>)
+            <1>)")
+
+(test-wi (let ((v (vector 1))
+	       (i (inlet 'a 1)))
+	   (set! (v 0) i)
+	   (set! (i :a) v)
+	   (object->string (c-pointer 0 v i) :readable))
+	 "(let ((<1> (vector #f))
+                (<2> (inlet :a #f)))
+            (set! (<1> 0) <2>)
+            (set! (<2> :a) <1>)
+            (c-pointer 0 <1> <2>))")
+
+
+;;; ---------------- hash-tables ----------------
+
+(test-wi (let ((ht (hash-table 'a 1)))
+	   (set! (ht 'a) ht)
+	   (object->string ht :readable))
+	 "(let ((<1> (hash-table)))
+            (set! (<1> 'a) <1>)
+            <1>)")
+
+(test-wi (let ((ht1 (hash-table 'a 1))
+	       (ht2 (hash-table 'b 1)))
+	   (set! (ht1 'a) ht2)
+	   (set! (ht2 'b) ht1)
+	   (object->string ht1 :readable))
+         "(let ((<1> (hash-table)))
+            (set! (<1> 'a) (hash-table 'b <1>))
+            <1>)")
+
+(test-wi (object->string (hash-table 'a (hash-table 'b 2)) :readable) "(hash-table 'a (hash-table 'b 2))")
+
+(test-wi (let ((ht (hash-table 'a (vector 1))))
+	   (set! ((ht 'a) 0) ht)
+	   (object->string ht :readable))
+	 "(let ((<1> (hash-table)))
+            (set! (<1> 'a) (vector <1>))
+            <1>)")
+
+(test-wi (let ((v (vector (hash-table 'a 1))))
+	   (set! ((v 0) 'a) v)
+	   (object->string v :readable))
+	 "(let ((<1> (vector #f)))
+            (set! (<1> 0) (hash-table 'a <1>))
+            <1>)")
+
+(test-wi (let ((h (hash-table 'a 1))
+	       (v (vector 1)))
+	   (set! (v 0) h)
+	   (set! (h 'a) v)
+	   (object->string h :readable))
+	 "(let ((<1> (hash-table)))
+            (set! (<1> 'a) (vector <1>))
+            <1>)")
+
+(test-wi (let ((h (hash-table 'a 1))
+	       (v (vector 1)))
+	   (set! (v 0) h)
+	   (set! (h 'a) v)
+	   (object->string v :readable))
+	 "(let ((<1> (vector #f)))
+            (set! (<1> 0) (hash-table 'a <1>))
+            <1>)")
+
+(test-wi (let ((h1 (hash-table 'a 1))
+	       (h2 (hash-table 'b 2))
+	       (v (vector 1)))
+	   (set! (v 0) h1)
+	   (set! (h1 'a) h2)
+	   (set! (h2 'b) v)
+	   (object->string v :readable))
+	 "(let ((<1> (vector #f)))
+            (set! (<1> 0) (hash-table 'a (hash-table 'b <1>)))
+            <1>)")
+
+(test-wi (let ((h1 (hash-table 'a 1))
+	       (h2 (hash-table 'b 2))
+	       (v (vector 1 2 3)))
+	   (set! (h1 'a) v)
+	   (set! (h2 'b) v)
+	   (set! (v 0) h1)
+	   (set! (v 1) h2)
+	   (set! (v 2) v)
+	   (object->string v :readable))
+         "(let ((<1> (vector #f #f #f)))
+            (set! (<1> 0) (hash-table 'a <1>))
+            (set! (<1> 1) (hash-table 'b <1>))
+            (set! (<1> 2) <1>)
+            <1>)")
+
+(test-wi (let ((v (vector 1)))
+	   (let ((h (hash-table v 1)))
+	     (set! (v 0) h)
+	     (object->string h :readable)))
+	 "(let ((<1> (hash-table)))
+            (set! (<1> (vector <1>)) 1)
+            <1>)")
+
+;;; ---------------- iterators ----------------
+
+(test-wi (let ((v (vector 1)))
+	   (let ((p (make-iterator v)))
+	     (set! (v 0) p)
+	     (object->string p :readable)))
+	 "(let ((<1> #f)
+                (<2> (vector #f)))
+            (set! <1> (make-iterator <2>))
+            (set! (<2> 0) <1>)
+            <1>)")
+
+(test-wi (let ((v (vector 1)))
+	   (let ((p (make-iterator v)))
+	     (set! (v 0) v)
+	     (object->string p :readable)))
+	 "(let ((<1> (vector #f)))
+            (set! (<1> 0) <1>)
+            (make-iterator <1>))")
+
+(test-wi (object->string (make-iterator (vector 1 2)) :readable) "(make-iterator (vector 1 2))")
+
+
+;;; ---------------- pairs ----------------
+
+(test-wi (let ((L (list 1)))
+	   (set-cdr! L L)
+	   (object->string L :readable))
+	 "(let ((<1> (list 1)))
+            (set-cdr! <1> <1>)
+             <1>)")
+
+(test-wi (let ((L (list 1 2)))
+	   (set-cdr! (cdr L) L)
+	   (object->string L :readable))
+	 "(let ((<1> (list 1 2)))
+            (set-cdr! (cdr <1>) <1>)
+             <1>)")
+
+(test-wi (let ((L (list 1)))
+	   (set-car! L L)
+	   (object->string L :readable))
+	 "(let ((<1> (list #f)))
+            (set-car! <1> <1>)
+            <1>)")
+
+(test-wi (let ((L (list 1)))
+	   (set-car! L L)
+	   (set-cdr! L L)
+	   (object->string L :readable))
+	 "(let ((<1> (list #f)))
+            (set-car! <1> <1>)
+            (set-cdr! <1> <1>)
+            <1>)")
+
+(test-wi (let ((L (list 1 (vector 2) 3)))
+	   (set-cdr! (cddr L) L)
+	   (object->string L :readable))
+	 "(let ((<1> (list 1 (vector 2) 3)))
+             (set-cdr! (list-tail <1> 2) <1>)
+             <1>)")
+
+(test-wi (let ((L (list (vector 1))))
+	   (set! (L 0 0) L)
+	   (object->string L :readable))
+	 "(let ((<1> (list #f)))
+            (set-car! <1> (vector <1>))
+            <1>)")
+
+(test-wi (let ((lst (list 1 2)))
+	   (set! (cdr (cdr lst)) (cdr lst))
+	   (object->string lst :readable))
+	 "(let ((<1> (list 2)))
+            (set-cdr! <1> <1>)
+            (let ((<L> (list 1)))
+              (set-cdr! <L> <1>)
+              <L>))")
+
+(test-wi (let ((L (list 1 2 3)))
+	   (set-cdr! (cddr L) (cdr L))
+	   (object->string L :readable))
+	 "(let ((<1> (list 2 3)))
+            (set-cdr! (cdr <1>) <1>)
+            (let ((<L> (list 1)))
+              (set-cdr! <L> <1>)
+              <L>))")
+
+(test-wi (let ((L (list 1 (list 2 3))))
+	   (set-car! L L)
+	   (object->string L :readable))
+	 "(let ((<1> (list #f (list 2 3))))
+            (set-car! <1> <1>)
+            <1>)")
+
+(test-wi (let ((L (list 1 (list 2 3))))
+	   (set-car! (cadr L) L)
+	   (object->string L :readable))
+	 "(let ((<1> (list 1 #f)))
+            (set! (<1> 1)
+                  (let ((<L> (list #f 3)))
+                    (set-car! <L> <1>)
+                    <L>))
+            <1>)")
+
+(test-wi (let ((L (cons 1 (cons 2 3))))
+	   (set-car! L L)
+	   (object->string L :readable))
+	 "(let ((<1> (list #f 2)))
+            (set-car! <1> <1>)
+            (set-cdr! (cdr <1>) 3)
+            <1>)")
+
+(test-wi (let ((L (cons 1 (cons 2 (cons 3 (cons 4 5)))))) ; #1=(#1# 2 3 4 . 5)
+	   (set-car! L L)
+	   (object->string L :readable))
+	 "(let ((<1> (list #f 2 3 4)))
+            (set-car! <1> <1>)
+            (set-cdr! (list-tail <1> 3) 5)
+            <1>)")
+
+(test-wi (let ((L (list 1 (list 2 (list 3 4))))) ; #1=(1 (#1# (#1# 4)))
+	   (set-car! (cadr L) L)
+	   (set-car! (cadadr L) L)
+	   (object->string L :readable))
+	 "(let ((<1> (list 1 #f)))
+            (set! (<1> 1)
+                  (let ((<L> (list #f #f)))
+                    (set-car! <L> <1>)
+                    (set! (<L> 1)
+                          (let ((<L> (list #f 4)))
+                            (set-car! <L> <1>)
+                            <L>))
+                    <L>))
+            <1>)")
+
+(test-wi (let ((vect (vector 1 2 3)))
+	   (let ((lst (list 1 vect 3)))
+	     (set! (vect 1) lst)
+	     (object->string lst :readable)))
+	 "(let ((<1> (list 1 #f 3)))
+            (set! (<1> 1) (vector 1 <1> 3))
+            <1>)")
+
+(test-wi (let ((L (list 1)))
+	   (set-cdr! L L)
+	   (object->string (immutable! L) :readable))
+	 "(let ((<1> (list 1)))
+            (set-cdr! <1> <1>)
+            (immutable! <1>))")
+
+(test-wi (object->string (immutable! (list 1)) :readable) "(immutable! (cons 1 ()))")
+
+(test-wi (let ((lst (list 1 2 3))
+	       (hash (hash-table 'a 1))
+	       (lt (inlet 'a 1 'b 2)))
+	   (set! (lst 0) lt)
+	   (set! (lt 'a) hash)
+	   (set! (lt 'b) lst)
+	   (set! (hash 'a) lst)
+	   (object->string lst :readable))
+	 "(let ((<1> (list #f 2 3)))
+            (set-car! <1> (inlet :a (hash-table 'a <1>) :b <1>))
+            <1>)")
+
+;;; ----------------
+(test-wi (let ((v (vector 1 2 3))
+	       (lt (inlet 'a 1 'c 2)))
+	   (set! (v 1) lt)
+	   (set! (v 2) v)
+	   (set! (lt 'c) lt)
+	   (object->string v :readable))
+	 "(let ((<2> (vector 1 #f #f))
+                (<1> (inlet :a 1 :c #f)))
+            (set! (<2> 1) <1>)
+            (set! (<2> 2) <2>)
+            (set! (<1> :c) <1>)
+            <2>)")
+
+(test-wi (let ((L (list 1 2 3))
+	       (V (vector 1 2 3)))
+	   (set-car! L L)
+	   (set! (V 1) V)
+	   (set! (L 2) V)
+	   (object->string L :readable))
+	 "(let ((<1> (list #f 2 #f))
+                (<2> (vector 1 #f 3)))
+            (set-car! <1> <1>)
+            (set! (<1> 2) <2>)
+            (set! (<2> 1) <2>)
+            <1>)")
+
+(test-wi (let ((v (vector (hash-table 'a 1) (signature ''2))))
+	   (object->string v :readable))
+	 "(let ((<1> (list 'integer?)))
+            (set-cdr! <1> <1>)
+            (vector (hash-table 'a 1)
+                    (let ((<L> (list #t 'pair?)))
+                      (set-cdr! (cdr <L>) <1>)
+                      <L>)))")
+(when (zero? (*s7* 'debug))
+  (test-wi (object->string (list-values (lambda (a) (values a (+ a 1))) (signature #i(0))) :readable) ; (#<lambda (a)> (integer? int-vector? . #1=(integer? . #1#)))
+	 "(let ((<1> (list 'integer?)))
+            (set-cdr! <1> <1>)
+            (let ((<L> (list (lambda (a) (values a (+ a 1))) #f)))
+              (set! (<L> 1)
+                    (let ((<L> (list 'integer? 'int-vector?)))
+                      (set-cdr! (cdr <L>) <1>)
+                      <L>))
+              <L>))"))  ;  (#<lambda (a)> (integer? int-vector? . #1=(integer? . #1#)))
+
+(test-wi (object->string (list '((1 (2)) (((3) 4))) (signature (make-vector '(2 3)))) :readable) ; (((1 (2)) (((3) 4))) (#t vector? . #1=(integer? . #1#)))
+	 "(let ((<1> (list 'integer?)))
+            (set-cdr! <1> <1>)
+            (let ((<L> (list (list (list 1 (list 2)) (list (list (list 3) 4))) #f)))
+              (set! (<L> 1)
+                    (let ((<L> (list #t 'vector?)))
+                      (set-cdr! (cdr <L>) <1>)
+                      <L>))
+              <L>))") ; (((1 (2)) (((3) 4))) (#t vector? . #1=(integer? . #1#)))
+
+(let ((str (object->string (let ((v (make-vector 3 #f))  ;  #1=#(#f (hash-table 'a 1 'c #2=(inlet 'a #1# 'b 2 'c 3) 'b #2#) #f)
+				 (h (hash-table 'b 2 'c 3))
+				 (e (inlet 'a 1)))
+			     (set! (h 'b) e)
+			     (set! (v 1) h)
+			     (set! (e :a) v)
+			     (set! (h 'c) e)
+			     v)
+			   :readable)))
+  (test (or (string-wi=? str "(let ((<1> (vector #f #f #f))
+                                    (<2> (inlet :a #f)))
+                                (set! (<1> 1) (hash-table 'c <2> 'b <2>))
+                                (set! (<2> :a) <1>)
+                                <1>)")                                ; #1=#(#f (hash-table 'a 1 'c #2=(inlet 'a #1#) 'b #2#) #f)
+	    (string-wi=? str "(let ((<1> (vector #f #f #f))
+                                    (<2> (inlet :a #f)))
+                                (set! (<1> 1) (hash-table 'b <2> 'c <2>))
+                                (set! (<2> :a) <1>)
+                                <1>)"))
+	#t))
+
+(let* ((obj (let ((v (make-vector 3 #f))
+		  (h (hash-table 'a 1 'b 2 'c 3))
+                  (e (inlet 'a 1 'b 2 'c 3)))
+	     (set! (e :c) h)
+	     (set! (e :a) v)
+	     (set! (v 0) e)
+	     (set! (h 'b) h)
+	     v))
+     (str (object->string obj :readable)))    ; #2=#((inlet 'a #2# 'b 2 'c #1=(hash-table 'a 1 'c 3 'b #1#)) #f #f)
+  (test obj (eval-string str)))
+
+(test-wi (object->string (list-values `(x . 1) (signature (int-vector 1))) :readable) ; ((x . 1) (integer? int-vector? . #1=(integer? . #1#)))
+	 "(let ((<1> (list 'integer?)))
+            (set-cdr! <1> <1>)
+            (let ((<L> (list (cons 'x 1) #f)))
+              (set! (<L> 1)
+                    (let ((<L> (list 'integer? 'int-vector?)))
+                      (set-cdr! (cdr <L>) <1>)
+                      <L>))
+              <L>))") ; ((x . 1) (integer? int-vector? . #1=(integer? . #1#)))
+
+(test-wi (object->string (let ((L (list (c-pointer 1) (vector 1) (inlet :a 1) (hash-table 'a 1) (make-iterator (list 1)))))
+			   (set-cdr! (list-tail L 4) L)
+			   L)
+			 :readable)
+	 "(let ((<1> (list (c-pointer 1) (vector 1) (inlet :a 1) (hash-table 'a 1) (make-iterator (list 1)))))
+            (set-cdr! (list-tail <1> 4) <1>)
+            <1>)")
+
+(let ((str (let ((p (make-list 3 #f))
+	       (h (hash-table 'a 1 'b 2))
+	       (it (make-iterator (make-list 3 #f)))
+	       (cp (c-pointer 1 (make-list 3 #f))))
+	   (set! (h 'a) cp)
+	   (set! (((object->let cp) 'c-type) 1) cp)
+	   (set! ((iterator-sequence it) 0) h)
+	   (object->string it :readable))))
+  (test (or (string-wi=? str
+         "(let ((<4> (list #f #f #f))
+                (<3> (hash-table))
+                (<1> #f)
+                (<2> (list #f #f #f)))
+            (set! <1> (c-pointer 1 <2> #f))
+            (set-car! <4> <3>)
+            (set! (<3> 'a) <1>)
+            (set! (<3> 'b) 2)
+            (set! (<2> 1) <1>)
+            (make-iterator <4>))")
+          (string-wi=? str
+        "(let ((<4> (list #f #f #f))
+               (<3> (hash-table))
+               (<1> #f)
+               (<2> (list #f #f #f)))
+           (set! <1> (c-pointer 1 <2> #f))
+           (set-car! <4> <3>)
+           (set! (<3> 'b) 2)
+           (set! (<3> 'a) <1>)
+           (set! (<2> 1) <1>)
+           (make-iterator <4>))"))
+      #t))
+
+(test-wi (let ((e (inlet 'a 1 'b 2 'c 3))
+	       (it (make-iterator (make-list 3 #f)))
+	       (cp (c-pointer 1 (make-list 3 #f))))
+	   (set! (((object->let cp) 'c-type) 1) cp)
+	   (set! (e :a) cp)
+	   (set! ((iterator-sequence it) 0) e)
+	   (object->string it :readable))
+	 "(let ((<4> (list #f #f #f))
+                (<3> (inlet :a #f :b 2 :c 3))
+                (<1> #f)
+                (<2> (list #f #f #f)))
+            (set! <1> (c-pointer 1 <2> #f))
+            (set-car! <4> <3>)
+            (set! (<3> :a) <1>)
+            (set! (<2> 1) <1>)
+            (make-iterator <4>))")
+
+(test-wi (let ((p (make-list 3 #f))
+	       (v (make-vector 3 #f))
+	       (h (hash-table 'a 1))
+	       (e (inlet 'a 1 'b 2))
+	       (it (make-iterator (make-list 3 #f)))
+	       (cp (c-pointer 1 (make-list 3 #f))))
+	   (set! (((object->let cp) 'c-type) 0) it)
+	   (set! ((iterator-sequence it) 0) e)
+	   (set! (e :a) h)
+	   (set! (h 'a) v)
+	   (set! (v 0) p)
+	   (set! (p 0) cp)
+	   (object->string p :readable))
+	 "(let ((<1> (list #f #f #f))
+                (<3> (list #f #f #f))
+                (<2> (list #f #f #f)))
+            (set-car! <1> (c-pointer 1 <3> #f))
+            (set-car! <3> (make-iterator <2>))
+            (set-car! <2> (inlet :a (hash-table 'a (vector <1> #f #f)) :b 2))
+            <1>)")
+
+(when (zero? (*s7* 'debug))
+  (test-wi (object->string (list (lambda (f) #f) (let ((<1> (vector #f))) (set! (<1> 0) <1>) <1>)) :readable)
+	 "(let ((<1> (vector #f)))
+            (set! (<1> 0) <1>)
+            (let ((<L> (list (lambda (f) #f) #f)))
+              (set! (<L> 1) <1>)
+              <L>))"))
+
+;; dotted cyclic lists
+(let ((L (cons #f #f)))
+  (let ((M (list L 2)))
+    (set-cdr! (cdr M) L)
+    (set-car! L M))
+  (test-wi (format #f "~W" L) "(let ((<1> (list #f)))
+                                 (set-car! <1> (let ((<L> (list #f 2)))
+                                                 (set-car! <L> <1>)
+                                                 (set-cdr! (cdr <L>) <1>)
+                                                 (set-cdr! (list-tail <L> 2) #f)
+                                                 <L>))
+                                 (set-cdr! <1> #f)
+                                 <1>)")
+  (test (format #f "~S" L) (format #f "~S" (eval-string (format #f "~W" L)))))
+
+(let ((L (cons #f (cons #f #f))))
+  (let ((M (list L 2)))
+    (set-cdr! (cdr M) L)
+    (set-car! L M))
+  (test (format #f "~S" L) (format #f "~S" (eval-string (format #f "~W" L)))))
+
+(let ((L (cons #f (cons #f (cons #f #f)))))
+  (let ((M (list L 2)))
+    (set-cdr! (cdr M) L)
+    (set-car! (cdr L) M))
+  (test (format #f "~S" L) (format #f "~S" (eval-string (format #f "~W" L)))))
+
+(let ((L (cons #f (cons #f (cons #f #f)))))
+  (let ((M (list L 2)))
+    (set-cdr! (cdr M) L)
+    (set-car! L M)
+    (set-car! (cdr L) M))
+  (test (format #f "~S" L) (format #f "~S" (eval-string (format #f "~W" L)))))
+
+(when (zero? (*s7* 'debug))
+  (test-wi (let ((v (vector #f)))
+	   (define (fv)
+	     (vector-ref v 0))
+	   (set! (v 0) fv)
+	   (object->string fv :readable))
+	 "(lambda () (vector-ref v 0))"))  ; wrong but at least it doesn't loop -- should we try to handle this?
+
+(test (let ((v (vector #f)))
+	(define (fv)
+	  (vector-ref v 0))
+	(define (fy)
+	  (vector-ref v 0))
+	(set! (v 0) fv)
+	(equivalent? fv fy))
+      #t)
+
+(let ()
+  (define sf (let ((object->string (lambda (obj . arg) "#<secret function!>")))
+	       (openlet (lambda (x) (+ x 1)))))
+  (test (sf 1) 2)
+  (test (object->string sf) "#<secret function!>"))
+
+(let ()
+  (define m1 (let ((object->string (lambda (obj . arg) "#<secret macro!>")))
+	     (openlet (macro (x) `(+ ,x 1)))))
+  (test (m1 1) 2)
+  (test (object->string m1) "#<secret macro!>"))
+
+(let ()
+  (define lt (let ((a 1)) (set! a (curlet)) a))
+  (test (object->string lt) "#1=(inlet 'a #1#)")
+  (test-wi (object->string lt :readable)  ; the outlet set below is probably not needed
+	   "(let ((<1> (inlet :a #f)))
+              (set! (outlet <1>) (inlet :lt <1>))
+              (set! (<1> :a) <1>)
+              <1>)"))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; CONTROL OPS
+;;; --------------------------------------------------------------------------------
+
+(define control-ops (list lambda define quote if begin set! let let* letrec cond case and or do
+			  call/cc eval apply for-each map values call-with-values dynamic-wind))
+(for-each
+ (lambda (op)
+   (if (not (eq? op op))
+       (format #t "~A not eq? to itself?~%" op)))
+ control-ops)
+
+(for-each
+ (lambda (op)
+   (if (not (eqv? op op))
+       (format #t "~A not eqv? to itself?~%" op)))
+ control-ops)
+
+(for-each
+ (lambda (op)
+   (if (not (equal? op op))
+       (format #t "~A not equal? to itself?~%" op)))
+ control-ops)
+
+(define question-ops (list boolean? eof-object? string?
+		           number? integer? real? rational? complex? char?
+			   list? vector? pair? null?))
+
+(for-each
+ (lambda (ques)
+   (for-each
+    (lambda (op)
+      (if (ques op)
+	  (format #t ";(~A ~A) returned #t?~%" ques op)))
+    control-ops))
+ question-ops)
+
+(let ((unspecified (if #f #f)))
+  (for-each
+   (lambda (op)
+     (if (op unspecified)
+	 (format #t ";(~A #<unspecified>) returned #t?~%" op)))
+   question-ops))
+
+(for-each
+ (lambda (s)
+   (if (not (symbol? s))
+       (format #t ";(symbol? ~A returned #f?~%" s)))
+ '(+ - ... !.. $.+ %.- &.! *.: /:. <-. =. >. ?. ~. _. ^.))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; if
+;;; --------------------------------------------------------------------------------
+
+(test ((if #f + *) 3 4) 12)
+(test (if (> 3 2) 'yes 'no) 'yes)
+(test (if (> 2 3) 'yes 'no) 'no)
+(test (if (> 3 2) (- 3 2) (+ 3 2)) 1)
+(test (if (> 3 2) 1) 1)
+(test (if '() 1 2) 1)
+(test (if 't 1 2) 1)
+(test (if #t 1 2) 1)
+(test (if #() 1 2) 1)
+(test (if 1 2 3) 2)
+(test (if 0 2 3) 2)
+(test (if (list) 2 3) 2)
+(test (if "" 2 3) 2)
+(test (eq? (if #f #f) (if #f #f)) #t) ; I assume there's only one #<unspecified>!
+(test (if . (1 2)) 2)
+(test (if (if #f #f) #f #t) #f)
+(test (if 1/0 0 1) 0)
+
+(test (let ((a #t) (b #f) (c #t) (d #f)) (if (if (if (if d d c) d b) d a) 'a 'd)) 'a)
+(test (let ((a #t) (b #f) (c #t) (d #f)) (if a (if b (if c (if d d c) c) 'b) 'a)) 'b)
+(test (let ((a #t) (b #f) (c #t) (d #f)) (if b (if a (if d 'gad) 'gad) (if d 'gad 'a))) 'a)
+
+(let ((a #t))
+  (for-each
+   (lambda (arg)
+     (test (if a arg 'gad) arg))
+   (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2))))
+
+(let ((a #t))
+  (for-each
+   (lambda (arg)
+     (test (if (not a) 'gad arg) arg))
+   (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2))))
+
+(test (let ((ctr 0) (a #t)) (if a (let ((b ctr)) (set! ctr (+ ctr 1)) (list b ctr)) (let ((c ctr)) (set! ctr (+ ctr 100)) (list c ctr)))) (list 0 1))
+
+(test (if if if if) if)
+(test (((if if if) if if) if if 'gad) if)
+(test (if if (if if if) if) if)
+(test ((car (list if)) #t 0 1) 0)
+(test (symbol->string 'if) "if")
+(test (if (and if (if if if)) if 'gad) if)
+(test (let ((ctr 0)) (if (let () (set! ctr (+ ctr 1)) (= ctr 1)) 0 1)) 0)
+(test (let ((ctr 0)) (if (let () (set! ctr (+ ctr 1)) (if (= ctr 1) (> 3 2) (< 3 2))) 0 1)) 0)
+(test (        if (> 3 2) 1 2) 1)
+(test (let ((alist (list (list map 1) (list car 2) (list if 3) (list do 4)))) (assoc if alist)) (list if 3))
+(test (let ((alist (list (list map 1) (list car 2) (list if 3) (list do 4)))) (assv if alist)) (list if 3))
+(test (let ((alist (list (list map 1) (list car 2) (list if 3) (list do 4)))) (assq if alist)) (list if 3))
+(test (let ((alist (list map car if do))) (member if alist)) (list if do))
+(test (let ((alist (list map car if do))) (memv if alist)) (list if do))
+(test (let ((alist (list map car if do))) (memq if alist)) (list if do))
+(test ((vector-ref (vector if) 0) #t 1 2) 1)
+(test ((vector-ref (make-vector 1 if) 0) #t 1 2) 1)
+(test ((if #t + -) 3 4) 7)
+(test (list (if 0 1 2)) (list 1))
+(test ((car (list if map)) #f 1 2) 2)
+(test (let ((ctr 0)) (if (= ctr 0) (let () (set! ctr (+ ctr 1)) (if (= ctr 1) 2 3)) (let () (set! ctr (+ ctr 1)) (if (= ctr 1) 4 5)))) 2)
+(test (let ((x (cons 1 2))) (set-cdr! x x) (if x 1 2)) 1)
+(test (let ((ctr 0)) (if (let ((ctr 123)) (set! ctr (+ ctr 1)) (= ctr 124)) (let () (set! ctr (+ ctr 100)) ctr) (let () (set! ctr (+ ctr 1000)) ctr)) ctr) 100)
+(test (let () (if #t (define (hi a) a)) (hi 1)) 1)
+(test (let () (if #f (define (hi a) (+ a 1)) (define (hi a) a)) (hi 1)) 1)
+(test (let ((oddp (lambda (a) (not (even? a))))) (define (hi a) (if (a 123) (a 321))) (hi oddp)) #t)
+
+(test (let ((ctr 0)) (call/cc (lambda (exit) (if (> 3 2) (let () (exit ctr) (set! ctr 100) ctr) #f)))) 0)
+(test (let ((ctr 0)) (call/cc (lambda (exit) (if (< 3 2) #f (let () (exit ctr) (set! ctr 100) ctr))))) 0)
+(test (let ((ctr 0)) (call/cc (lambda (exit) (if (let () (exit ctr) (set! ctr 100) ctr) 123 321)))) 0)
+(test (let ((ctr 0)) (if (> 3 2) (call/cc (lambda (exit) (set! ctr (+ ctr 1)) (exit ctr))) #f) ctr) 1)
+
+(test (let ((ctr 0))
+	(do ((x 0 (+ x 1)))
+	    ((= x 12))
+	  (if (> x 0)
+	      (if (> x 1)
+		  (if (> x 2)
+		      (if (> x 3)
+			  (if (> x 4)
+			      (if (> x 5)
+				  (if (> x 6)
+				      (if (> x 7)
+					  (if (> x 8)
+					      (if (> x 9)
+						  (if (> x 10)
+						      (set! ctr (+ ctr 1000))
+						      (set! ctr (- ctr 1)))
+						  (set! ctr (- ctr 2)))
+					      (set! ctr (- ctr 3)))
+					  (set! ctr (- ctr 4)))
+				      (set! ctr (- ctr 5)))
+				  (set! ctr (- ctr 6)))
+			      (set! ctr (- ctr 7)))
+			  (set! ctr (- ctr 8)))
+		      (set! ctr (- ctr 9)))
+		  (set! ctr (- ctr 10)))
+	      (set! ctr (- ctr 11))))
+	ctr)
+      934)
+
+(test (let ((ctr 0))
+	(do ((x 0 (+ x 1)))
+	    ((= x 12))
+	  (if (> x 0)
+	      (if (> x 1)
+		  (if (> x 2)
+		      (if (> x 3)
+			  (if (> x 4)
+			      (if (> x 5)
+				  (if (> x 6)
+				      (if (> x 7)
+					  (if (> x 8)
+					      (if (> x 9)
+						  (if (> x 10)
+						      (set! ctr (+ ctr 1000))
+						      (set! ctr (- ctr 1)))
+						  (set! ctr (- ctr 2)))
+					      (set! ctr (- ctr 3)))
+					  (set! ctr (- ctr 4))))))))
+		  (set! ctr (- ctr 10)))
+	      (set! ctr (- ctr 11))))
+	ctr)
+      969)
+
+(test (if #f) 'error)
+(test (if (< 2 3)) 'error)
+(test (if #f 1 2 3) 'error)
+(test (if 1 2 3 4) 'error)
+(test (if #f 1 else 2) 'error)
+(test (if) 'error)
+(test ('+ '1 '2) 'error)
+(test (if 1 . 2) 'error)
+(test (if 1 2 . 3) 'error)
+(test (if . 1) 'error)
+(test (if _no_var_ 1) 'error)
+(test (if (values) (values) (values) 1) 'error)
+(num-test (+ 1 (if #t (values 3 4) (values 5 6)) 2) 10)
+(let ()
+  (define (bad a) (if a 1 2 3))
+  (test (bad #f) 'error)
+  (test (bad #t) 'error))
+
+
+;;; when
+(test (when #f #f) #<unspecified>)
+(test (when #t #f) #f)
+(test (when) 'error)
+(test (when #t) 'error)
+(test (when . #t) 'error)
+(test (when #t . 1) 'error)
+(test (when when when) when)
+(test (symbol->string 'when) "when")
+(test (when #t 1 2 3) 3)
+(test (when #t (define a 1) (+ a 1)) 2)
+(test ((when #t +) 2 3) 5)
+(test (when #t (when #f #f)) #<unspecified>)
+(test (+ (when #t (values 2 3))) 5)
+(test (when (when #t #t) 2) 2)
+(test (apply when '(< 2 3) '((+ 2 1))) 3)
+
+(let ((x 0))
+  (define (t1 a) (when a (set! x (+ x 1)) x))
+  (test (t1 #t) 1)
+  (test (t1 #f) #<unspecified>)
+  (test (t1 #t) 2))
+
+(test ((let () when) #t 32) 32)
+(test ((let () when) #f 32) #<unspecified>)
+
+
+;;; unless
+(test (unless #t #f) #<unspecified>)
+(test (unless #f #f) #f)
+(test (unless) 'error)
+(test (unless #f) 'error)
+(test (unless . #t) 'error)
+(test (unless #f . 1) 'error)
+(test (unless (not unless) unless) unless)
+(test (symbol->string 'unless) "unless")
+(test (unless #f 1 2 3) 3)
+(test (unless #f (define a 1) (+ a 1)) 2)
+(test ((unless #f +) 2 3) 5)
+(test (unless #f (unless #t #f)) #<unspecified>)
+(test (+ (unless #f (values 2 3))) 5)
+(test (unless (unless #f #f) 2) 2)
+(test (apply unless '(= 2 3) '((+ 2 1))) 3)
+(test (unless x (display x) . 2) 'error)
+
+(let ((x 0))
+  (define (t1 a) (unless a (set! x (+ x 1)) x))
+  (test (t1 #f) 1)
+  (test (t1 #t) #<unspecified>)
+  (test (t1 #f) 2))
+
+(test (when (unless (= 2 3) #t) 1) 1)
+
+(let () ; opt_if_bp_ii_fc
+  (define (f)
+    (let ((sum 0))
+      (do ((i 0 (+ i 1))
+  	   (j 0 (+ j 2)))
+  	  ((= i 3) sum)
+        (if (> (+ i j) 0) (set! sum (+ sum i j))))))
+  (test (f) 9))
+
+(let () ; values in (not...) etc
+  (define* (v3 x) (values x x))
+  (define* (sym6 a b :rest c) (list a b (copy c)))
+
+  (test (let ()
+	  (define (func)
+	    (catch #t
+	      (lambda ()
+		(let ((x (when (not (v3)) (number? (sym6)))))
+		  x))
+	      (lambda (type info)
+		(apply format #f info))))
+	  (func) (func))
+	"too many arguments to not: (values #f #f)")
+
+  (test (let ()
+	  (define (func)
+	    (catch #t
+	      (lambda ()
+		(let ((x (unless (v3) (number? (sym6)))))
+		  x))
+	      (lambda (type info)
+		(apply format #f info))))
+	  (func) (func))
+	#f))
+
+
+;;; --------------------------------------------------------------------------------
+;;; quote
+;;; --------------------------------------------------------------------------------
+
+(test (quote a) 'a)
+(test 'a (quote a))
+(test '1 1)
+(test '1/4 1/4)
+(test '(+ 2 3) '(+ 2 3))
+(test '"hi" "hi")
+(test '#\a #\a)
+(test '#f #f)
+(test '#t #t)
+(test '#b1 1)
+(test '() '())
+(test '(1 . 2) (cons 1 2))
+(test #(1 2) #(1 2))
+(test (+ '1 '2) 3)
+(test (+ '1 '2) '3)
+(test (+ ' 1 '   2) '    3)
+(test (char? '#\a) #t)
+(test (string? '"hi") #t)
+(test (boolean? '#t) #t)
+(test (if '#f 2 3) 3)
+(test (if '#t 2 3) 2)
+(test (vector? #()) #t)
+(test (char? (quote #\a)) #t)
+(test (string? (quote "hi")) #t)
+(test (boolean? (quote #t)) #t)
+(test (if (quote #f) 2 3) 3)
+(test (if (quote #t) 2 3) 2)
+(test (vector? (quote #())) #t)
+(test (+ (quote 1) (quote 2)) (quote 3))
+(test (list? (quote ())) #t)
+(test (pair? (quote (1 . 2))) #t)
+(test (+ '1.0 '2.0) 3.0)
+(test (+ '1/2 '3/2) 2)
+(test (+ '1.0+1.0i '-2.0) -1.0+1.0i)
+(test (let ((hi 2)) (equal? hi 'hi)) #f)
+(test ''1 '(#_quote 1))
+(test ''a '(#_quote a))
+(test (symbol? '#f) #f)
+(test (symbol? '.') #t)
+(test ''quote '(#_quote quote))
+(test (+ (cadr ''3) (cadadr '''4) (cadr (cadr (cadr ''''5)))) 12)
+(test (+ (cadr ' '   3) (cadadr '
+  '    ' 4)) 7)
+(test (+ '#| a comment |#2 3) 5)
+(test (+ ' #| a comment |# 2 3) 5)
+(test (eq? lambda 'lambda) #f)
+(test (equal? + '+) #f)
+(test (eq? '() ()) #t) ; s7 specific
+
+(test (quote) 'error)
+(test (quote . -1) 'error)
+(test (quote 1 1) 'error)
+(test (quote . 1) 'error)
+(test (quote . (1 2)) 'error)
+(test (quote 1 . 2) 'error)
+(test (symbol? '1'1) #t)
+(test (apply '+ (list 1 2)) 'error)
+(test ((quote . #\h) (2 . #\i)) 'error)
+(test ((quote "hi") 1) #\i)
+
+(test (equal? '(1 2 '(3 4)) '(1 2 (3 4))) #f)
+(test (equal? '(1 2 '(3 4)) (quote (list 1 2 (quote (list 3 4))))) #f)
+(test (equal? (list-ref '(1 2 '(3 4)) 2) '(3 4)) #f)
+(test (equal? '(1 2 '(3 4)) (list 1 2 (list quote (list 3 4)))) #t)
+(test (equal? '(1 2 ''(3 4)) (list 1 2 (list quote (list quote (list 3 4))))) #t)
+(test (equal? '('3 4) (list (list quote 3) 4)) #t)
+(test (equal? '('3 4) (list 3 4)) #f)
+(test (equal? '('() 4) (list (list quote ()) 4)) #t)
+(test (equal? '('('4)) (list (list quote (list (list quote 4))))) #t)
+(test (equal? '('('4)) (list (list quote (list (list 'quote 4))))) #f)
+(test (equal? '('('4)) '((#_quote ((#_quote 4))))) #t)
+(test (equal? '1 ''1) #f)
+(test (equal? ''1 ''1) #t)
+(test (equal? '(1 '(1 . 2)) (list 1 (cons 1 2))) #f)
+(test (equal? #(1 #(2 3)) '#(1 '#(2 3))) #f)
+(test (equal? #(1) #('1)) #f)
+(test (equal? #(()) #('())) #f)
+(test (equal? cons 'cons) #f)
+
+(test (eqv? #\a (quote #\a)) #t)
+(test (eqv? 1 (quote 1)) #t)
+(test (eqv? 0 (quote 0)) #t)
+(test (equal? #(1 2 3) (quote #(1 2 3))) #t)
+(test (eqv? 3.14 (quote 3.14)) #t)
+(test (eqv? 3/4 (quote 3/4)) #t)
+(test (eqv? 1+1i (quote 1+1i)) #t)
+(test (eq? #f (quote #f)) #t)
+(test (eq? #t (quote #t)) #t)
+(test (eq? '() (quote ())) #t)
+(test (equal? '(1 2 3) (quote (1 2 3))) #t)
+(test (equal? '(1 . 2) (quote (1 . 2))) #t)
+(test ('abs -1) 'error)
+(test ('"hi" 0) #\h)
+
+(test (''begin 1) 'begin)
+(test (''let ((x 1)) ('set! x 3) x) 'error)
+(test ('and #f) 'error)
+(test ('and 1 #f) 'error)
+(test ('#_and #f) #f)
+(test ('#_abs -1) 1)
+(test ('#_+ 1 2 3) 6)
+(test ('begin 1) 'error)
+(test ('cond ('define '#f)) 'error)
+(test ('let ((x 1)) ('set! x 3) x) 'error)
+(test ('let* () ('define x 3) x) 'error)
+(test ('or #f) 'error)
+(test ('quote 3) 'error)
+(test ((copy quote) 1) 1)
+(test ((copy quote) quote) 'quote)
+(test ((lambda (q) (let ((x 1)) (q x))) quote) 'x)
+(test ((lambda (s c) (s c)) quote #f) 'c)
+;;; ((lambda (lambda) (lambda (else))) quote) -> '(else)
+(test ((quote and) #f) 'error)
+(test ((values quote) 1) 1)
+(test (for-each and ''2) #<unspecified>)
+(test (pair? (map or ''2)) #t)
+(test (for-each or '(+ x 1)) 'error)
+(test (do ((i 0 (+ i 1))) ((= i 1)) (string-downcase (for-each or ''2))) 'error)
+(test (let () (define-macro (m a) `(+ ,a 1)) (for-each m ''2)) 'error)
+(test (let () (define-macro (m a) `(+ ,a 1)) (for-each m '(1 2))) #<unspecified>)
+(test (let () (define-macro (m . a) `(+ ,a 1)) (for-each m ''2)) 'error)
+
+(test ((lambda () (define (_f_ $a$) $a$) (_f_ (quote 1 1)))) 'error)
+(test ((lambda () (define (_f_ $a$) $a$) (_f_ (quote 1 . 1)))) 'error)
+(test ((lambda () (define (_f_ $a$) $a$) (_f_ (quote . 1)))) 'error)
+
+(test (syntax? #_quote) #t)
+(test (syntax? 'quote) #f)      ; the symbol quote
+(test (equal? 'quote quote) #f) ; quote is not self-evaluating
+(test (syntax? quote) #t)
+(test (equal? 'quote #_quote) #f)
+(test (equal? quote #_quote) #t)
+(test (equal? '#f (quote #f)) #t)
+(test (equal? '(quote #f) '(#_quote #f)) #f)        ; symbol quote != #_quote
+(test (equal? (quote '#f) (quote (quote #f))) #f)   ; (quote (quote #f)) -> (list 'quote #f) [the symbol quote], but s7 uses #_quote for '#f
+(test (equal? (quote '#f) (quote (#_quote #f))) #t) ; ' -> #_quote
+(test (let ((quote 32)) '1) 1)                      ; '1 ignores local 'quote
+(test (let ((quote 32)) (quote 1)) 'error)          ; attempt to apply an integer 32 in (32 1)?
+;; in Guile (let ((quote 32)) '1) -> ice-9/boot-9.scm:1685:16: In procedure raise-exception: Wrong type to apply: 32
+;; r7rs.pdf says '(quote a) -> (quote a), ''a -> (quote a), so s7 ignores the spec in this case
+(test (let ((quote -)) (quote 32)) -32)
+
+;; see also quasiquote
+
+
+;;; --------------------------------------------------------------------------------
+;;; for-each
+;;; --------------------------------------------------------------------------------
+
+(test (let ((v (make-vector 5))) (for-each (lambda (i) (vector-set! v i (* i i))) '(0 1 2 3 4)) v) #(0 1 4 9 16))
+(test (let ((ctr 0) (v (make-vector 5))) (for-each (lambda (i) (vector-set! v ctr (* i i)) (set! ctr (+ ctr 1))) '(0 1 2 3 4)) v) #(0 1 4 9 16))
+(for-each (lambda (x) (display "for-each should not have called this")) ())
+(test (let ((ctr 0)) (for-each (lambda (x y) (if (= x y) (set! ctr (+ ctr 1)))) '(1 2 3 4 5 6) '(2 3 3 4 7 6)) ctr) 3)
+(test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr x y z))) '(0 1) '(2 3) '(4 5)) ctr) 15)
+(test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr x y z))) '(1) '(3) '(5)) ctr) 9)
+(test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr x y z))) () () ()) ctr) 0)
+(test (let () (for-each abs '(1 2)) 1) 1)
+(test (let ((ctr 0)) (for-each (lambda (a) (for-each (lambda (b) (set! ctr (+ ctr 1))) '(0 1))) '(2 3 4)) ctr) 6)
+(test (let ((sum 0)) (for-each (lambda args (set! sum (+ sum (apply + args)))) '(0 1 2) '(2 1 0) '(3 4 5) '(5 4 3) '(6 7 8) '(8 7 6)) sum) 72)
+(test (let ((sum 0)) (for-each (lambda (a b . args) (set! sum (+ sum a b (apply + args)))) '(0 1 2) '(2 1 0) '(3 4 5) '(5 4 3) '(6 7 8) '(8 7 6)) sum) 72)
+(test (let ((sum 0)) (for-each (lambda (a b . args) (set! sum (+ sum a b (apply + args)))) '(0 1 2) '(2 1 0)) sum) 6)
+(test (let () (for-each + '(0 1 2) '(2 1 0)) 0) 0)
+(test (let () () ()) ())
+(test (for-each + ()) #<unspecified>)
+(test (let ((sum 0)) (for-each (lambda a (set! sum (+ sum (apply + a)))) '(1 2 3)) sum) 6)
+(test (let ((sum 0)) (for-each (lambda* ((a 1)) (set! sum (+ sum a))) '(1 2 3)) sum) 6)
+(test (let ((sum 0)) (for-each (lambda (a . b) (set! sum (+ sum a))) '(1 2 3)) sum) 6)
+(test (let ((sum 0) (lst (list 1 2 3))) (for-each (lambda (a b c) (set! sum (+ sum a b c))) lst lst lst) sum) 18)
+(test (let ((sum 0) (lst (vector 1 2 3))) (for-each (lambda (a b c) (set! sum (+ sum a b c))) lst lst lst) sum) 18)
+(test (let ((v (vector 1 2 3))) (for-each vector-set! (list v v v) (list 0 1 2) (list 32 33 34)) v) #(32 33 34))
+(test (let () (define (hi) (for-each (lambda (x) (+ x 1)) (list 1 2 3))) (hi) (hi)) #<unspecified>)
+(test (let () (define (func) (for-each (let ((x 4)) (lambda (y) (+ x y))) (make-float-vector 8 0))) (define (hi) (func)) (hi)) #<unspecified>)
+(let () (define (f L) (for-each display L)) (test (with-output-to-string (lambda () (f '(1 2 3 4)))) "1234"))
+
+(test (let ((d 0))
+	(for-each (let ((a 0))
+		    (for-each (lambda (b) (set! a (+ a b))) (list 1 2))
+		    (lambda (c) (set! d (+ d c a))))
+		  (list 3 4 5))
+	d)
+      21)
+(test (let ((d 0))
+	(for-each (lambda (c)
+		    (let ((a 0))
+		      (for-each (lambda (b) (set! a (+ a b))) (list 1 2))
+		      (set! d (+ d a c))))
+		  (list 3 4 5))
+	d)
+      21)
+
+(test (let ((ctr 0))
+	(let ((val (call/cc
+		    (lambda (exit)
+		      (for-each (lambda (a)
+				  (if (> a 3) (exit a))
+				  (set! ctr (+ ctr 1)))
+				(list 0 1 2 3 4 5))))))
+	  (list ctr val)))
+      (list 4 4))
+
+(test (call-with-current-continuation
+       (lambda (exit)
+	 (for-each
+	  (lambda (x)
+	    (if (negative? x) (exit x)))
+	  '(54 0 37 -3 245 19))
+	 #t))
+      -3)
+
+(test (let ((ctr 0)
+	    (cont #f)
+	    (lst ()))
+	(let ((val (call/cc
+		    (lambda (exit)
+		      (for-each (lambda (a)
+				  (if (and (not cont) (= a 2))
+				      (exit a))
+				  (if (and cont (= a 5))
+				      (exit a))
+				  (call/cc (lambda (c) (set! cont c)))
+				  (set! lst (cons ctr lst))
+				  (set! ctr (+ ctr 1)))
+				(list 0 1 2 3 4 5))))))
+	  (if (< val 5)
+	      (cont))
+	  (list ctr val lst)))
+      (list 5 5 (list 4 3 2 1 0)))
+
+(test (let ((lst ()))
+	(for-each (lambda (a) (set! lst (cons a lst)))
+		  (let ((lst ()))
+		    (for-each (lambda (b) (set! lst (cons b lst)))
+			      (list 1 2 3))
+		    lst))
+	lst)
+      (list 1 2 3))
+
+(test (let ((v (vector 0 0 0))
+	    (iv #i(1 2 3))
+	    (ctr 0))
+	(for-each (lambda (i)
+		    (vector-set! v ctr i)
+		    (set! ctr (+ ctr 1)))
+		  iv)
+	v)
+      #(1 2 3))
+
+;;; this is an infinite loop?
+					; (let ((cont #f)) (call/cc (lambda (x) (set! cont x))) (for-each cont (list 1 2 3)))
+(test (call/cc (lambda (x) (for-each x (list 1 2 3)))) 1) ; map also gives 1 ... perhaps not actually legal?
+
+(let ((args (list 0 1 2))
+      (xx (list 4)))
+  (define (it1)
+    (for-each
+     (lambda (x)
+       (catch #t
+	 (lambda ()
+	   (set-car! xx x))
+	 (lambda any 'error)))
+     (cdr args))
+    (car xx))
+  (test (it1) 2))
+
+(let ((args (list 0 1 2))
+      (xx (list 4)))
+  (define (it1)
+    (for-each
+     (lambda (x)
+       (catch #t
+	 (lambda ()
+	   (set-car! xx x))
+	 (lambda any 'error))
+       (set-car! xx (+ (car xx) 32)))
+     (cdr args))
+    (car xx))
+  (test (it1) 34))
+
+(test (let ((ctr 0))
+	(for-each
+	 (lambda (x)
+	   (for-each
+	    (lambda (x y)
+	      (for-each
+	       (lambda (x y z)
+		 (set! ctr (+ x y z)))
+	       (list x (+ x 1))
+	       (list y (+ y 2))
+	       (list (+ x y) (- x y))))
+	    (list (+ x 3) (+ x 4) (+ x 5))
+	    (list (- x 3) (- x 4) (- x 5))))
+	 (list 1 2 3 4 5))
+	ctr)
+      23)
+
+(for-each
+ (lambda (a)
+   (if (not (string=? a "hi"))
+       (format #t "yow: ~S" a)))
+ (list "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi"))
+
+
+;; now some mixed cases
+(test (let ((sum 0)) (for-each (lambda (n m) (set! sum (+ sum n m))) (list 1 2) (vector 3 4)) sum) 10)
+(test (let ((sum 0)) (for-each (lambda (n m) (set! sum (+ sum n m))) (vector 1 2) (list 3 4)) sum) 10)
+(test (let ((sum 0)) (for-each (lambda (n m p) (set! sum (+ sum n m))) (vector 1 2) (list 3 4) (vector 5 6)) sum) 10)
+(test (let ((sum 0)) (for-each (lambda (n m p) (if (char=? p #\x) (set! sum (+ sum n m)))) (vector 1 2 3) (list 3 4 5) "xax") sum) 12)
+
+(test (let* ((x (list (list 1 2 3))) (y (apply for-each abs x))) x) '((1 2 3)))
+
+(test (for-each (lambda (x) (display "for-each should not have called this"))) 'error)
+(test (for-each (lambda () 1) ()) 'error) ; #<unspecified>
+(test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr x y z))) '(1) '(3) ()) ctr) 0)
+(test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr x y z))) '(0 1) '(2 3) '(4 5 6)) ctr) 15)
+(test (for-each (lambda (a b) (+ a b)) (list 1)) 'error)
+(test (for-each (lambda (a b) (+ a b)) (list 1) (list)) #<unspecified>)
+(test (for-each (lambda (a b) (+ a b)) (list 1)) 'error)
+(test (for-each (lambda (a b) (+ a b)) (list 1) (list 2) (list 3)) 'error)
+(test (for-each (lambda (a b) (+ a b)) (list 1) (list 1 2)) #<unspecified>)
+(test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1)) #<unspecified>)
+(test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1 2 3)) #<unspecified>)
+(test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1)) #<unspecified>)
+(test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1 2) (list)) 'error) ; #<unspecified>
+(test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1 2) (list 1 2)) 'error)
+(test (for-each (lambda (a b) (+ a b)) (list 1 2) (cons 1 2)) #<unspecified>)
+(test (for-each (lambda (a b) (+ a b)) (cons 1 2) (list 1 2)) #<unspecified>)
+(test (for-each (lambda (a) (+ a 1)) (list 1) (list 2)) 'error)
+(test (for-each (lambda (a) (+ a 1)) #\a) 'error)
+(test (for-each (lambda (a) (+ a 1)) (cons 1 2)) #<unspecified>)
+(test (for-each (lambda (x) x) (openlet (inlet 'make-iterator (lambda (v) v)))) 'error)
+(test (for-each (lambda (x) x) (openlet (inlet 'make-iterator (let ((+iterator+ #t)) (lambda (v) v))))) 'error)
+(test (let ((sum 0)) (for-each (lambda (a b . args) (set! sum (+ sum a b (apply + args)))) '(0 1 2)) sum) 'error)
+(test (for-each (lambda (a) a) '(1 2 . 3)) #<unspecified>)
+(test (for-each #(0 1 2) #(2 1 0)) #<unspecified>)
+(for-each
+ (lambda (arg)
+   (test (for-each arg (list 1)) #<unspecified>))
+ (list (list 1 2 3) #(1 2 3) "hi"))
+
+(for-each
+ (lambda (op)
+   (test (for-each op ()) 'error)
+   (test (for-each op "") 'error)
+   (test (for-each op #(1 2 3) ()) 'error)
+   (test (for-each op #() (list) (string)) 'error))
+ (list 0 () #f #t 'a-symbol :hi #\a #<eof> #<unspecified> #<undefined> 0.0 1+i 1/2 1/0 0/0 *stdout* (current-input-port)))
+(for-each
+ (lambda (arg)
+   (test (for-each arg (list 1)) 'error))
+ (list -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #f #t))
+(for-each
+ (lambda (arg)
+   (test (for-each (lambda (n m) n) (list 1) arg) 'error))
+ (list -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #f #t))
+(for-each
+ (lambda (arg)
+   (test (for-each (lambda (a) a) arg) 'error))
+ (list -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #f #t))
+
+(test (for-each) 'error)
+(test (for-each #t) 'error)
+(test (for-each map #t) 'error)
+
+(test (for-each abs () abs) 'error)
+(test (for-each abs '(1) #(1)) 'error)
+(test (let ((vals ())) (for-each for-each (list (lambda (a) (set! vals (cons (abs a) vals)))) (list (list -1 -2))) vals) '(2 1))
+(test (let ((c #f)) (for-each (lambda (x) (set! c x)) "a") c) #\a)
+(test (let ((c #f)) (for-each (lambda (x) (set! c x)) "") c) #f)
+(test (let ((c #f)) (for-each (lambda (x) (set! c x)) (string #\null)) c) #\null)
+(when full-s7test
+  (test (for-each (lambda (x) x) (apply-values (make-list 10000))) 'error)
+  (test (map (lambda (x) x) (apply-values (make-list 10000))) 'error))
+
+(test (let ((L (list 1 2 3 4 5)) (sum 0)) (for-each (lambda (x) (set-cdr! (cddr L) 5) (set! sum (+ sum x))) L) sum) 6)
+; map (below) has more tests along this line
+(test (let ((f #f)) (for-each (lambda (a) (if (eq? a 'a) (set! f (lambda () a)))) '(a b c)) (f)) 'a)
+(test (let ((i 0) (f (make-vector 3))) (for-each (lambda (b) (vector-set! f i b) (set! i (+ i 1))) '(a b c)) f) #(a b c))
+(test (let ((i 0) (f (make-vector 3)) (lst '(a b c))) (define (hi) (for-each (lambda (b) (vector-set! f i b) (set! i (+ i 1))) lst)) (hi) f) #(a b c))
+(test (let ((i 0) (f (make-vector 3)) (lst '(a b c))) (define (hi) (for-each (lambda (b) (let () (vector-set! f i b) (set! i (+ i 1)))) lst)) (hi) f) #(a b c))
+(test (let ((i 0) (f (make-vector 3)) (lst (list 1 2 3))) (define (hi) (for-each (lambda (b) (vector-set! f i (let ((b (+ b 1))) b)) (set! i (+ i 1))) lst)) (hi) f) #(2 3 4))
+(test (let ((i 0) (f (make-vector 3)) (lst (list 1 2 3))) (define (hi) (for-each (lambda (b) (let ((b (+ b 1))) (vector-set! f i (let ((b (+ b 1))) b)) (set! i (+ i 1)))) lst)) (hi) f) #(3 4 5))
+(test (let ((f #f)) (define (hi) (for-each (lambda (a) (if (eq? a 'a) (set! f (lambda () (let () a))))) '(a b c))) (hi) (f)) 'a)
+(test (let ((lst '((a b c) (1 2 3)))) (define (hi) (for-each (lambda (a) a) (apply values lst))) (hi)) 'error)
+(test (let ((lst ())) (for-each (lambda args (set! lst (cons args lst))) (values (list 1 2 3) '(4 5 6) (list 7 8 9))) lst) '((3 6 9) (2 5 8) (1 4 7)))
+
+(test (for-each ="") 'error) ; #<unspecified>
+(test (for-each =""=) 'error)
+(test (for-each = "" 123) 'error)
+(test (for-each = () 123) 'error)
+(test (for-each =()=) 'error)
+(test (for-each abs "") #<unspecified>)
+(test (for-each null? () #() "") 'error) ; #<unspecified>
+(test (for-each null? () #() 0 "") 'error)
+(test (for-each define '(a) '(3)) #<unspecified>)
+(test (let () (for-each define '(a b c) '(1 2 3)) (list a b c)) '(1 2 3))
+(test (let () (for-each define '(first second third fourth) '(car cadr caddr cadddr)) (third '(1 2 3 4 5))) 3)
+(test (for-each '(()) #()) #<unspecified>)
+(test (for-each '(1 2 . 3) '(1 . 2)) #<unspecified>)
+(test (for-each '(()) ()) #<unspecified>)
+(test (for-each #2d((1 2) (3 4)) '(1)) #<unspecified>)
+(test (for-each "a\x00;b" #(1 2)) #<unspecified>)
+(test (for-each #(1 (3)) '(1)) #<unspecified>)
+(test (for-each '((1 (2)) (((3) 4))) '(1)) #<unspecified>)
+(test (for-each "hi" '(1)) #<unspecified>)
+(test (for-each #() #()) 'error) ; #<unspecified>
+(test (for-each '(1 . 2) #()) #<unspecified>)
+(test (let ((ht (hash-table 'a 1 'b 2))) (for-each ht ht)) #<unspecified>)
+(test (let ((ht (hash-table 'a 1 'b 2))) (let ((sum 0)) (for-each (lambda (c) (set! sum (+ sum (cdr c)))) ht) sum)) 3)
+(test (let ((ht (hash-table 'a 1 'b 2))) (for-each ht '(a b))) #<unspecified>)
+(test (for-each ''2 '(1)) #<unspecified>)
+(let ((os (*s7* 'safety)))
+  (set! (*s7* 'safety) 1)
+  (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (test (for-each lst lst) #<unspecified>)) ; 'error
+  (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (test (for-each #() lst) 'error))
+  (set! (*s7* 'safety) os))
+(test (for-each 1 "hi" ()) 'error)
+(test (for-each 0 #() ()) 'error)
+(test (for-each #\a #(1 2) '(3 4) "") 'error)
+(test (for-each '2 ()) 'error)
+(test (let ((a 1) (b 2)) (for-each apply (list set! set!) '(a b) '((12) (32))) (list a b)) '(12 32))
+(test (let ((a 1) (b 2) (c 3)) (for-each apply (make-list 3 set!) '(a b c) '((12) (32) (0))) (list a b c)) '(12 32 0))
+(test (let ((a 1) (b 2) (c 3)) (for-each set! '(a b c) '(12 32 0)) (list a b c)) '(12 32 0))
+(test (for-each (macro (a . b) `(cons ,a ,b)) "ho" (list (list quasiquote +) -1)) 'error) ; macro + dotted arg bug (affected also sort/map)
+(test (do ((i 0 (+ i 1))) ((= i 100)) (for-each (macro a `(copy ,a)) '(- 1) (vector 0 1 2))) 'error)
+(let ()
+  (define-macro (msym1 . a) `(copy ,a))
+  (define (_fnc_ x) (+ x 1))
+  (define (func) (let () (for-each display (list ((let () msym1) cond (_fnc_ (c-pointer-weak1 0+0/0i))))))) ; cruel and unusual!
+  (test (func) 'error))
+
+(test (for-each (macro* (a . b) `(cons ,a ,b)) #(0 1) (list `+ -1)) #<unspecified>)          ; op_pair_sym initial (pair? (car code)) check
+(test (for-each (macro* (a . b) `(cons ,a ,b)) #(0 1) (list '(values +) -1)) #<unspecified>) ; op_pair_pair case
+(test (map (macro* (a . b) `(cons ,a ,b)) #(0 1) (list `+ -1)) 'error) ; attempt to apply an integer -1 in (-1)
+(test (map (lambda* (a . b) `(cons ,a ,b)) #(0 1) (list `+ -1)) '((cons 0 (+)) (cons 1 (-1))))
+
+(let ()
+  (define (hi)
+    (let ((lst '(1 2 3)))
+      (for-each
+       (lambda (x)
+	 (catch #t
+	   (lambda ()
+	     (if (defined? 'local-x)
+		 (format #t ";for-each catch local env not cleared: ~A~%" local-x))
+	     (define local-x x)
+	     local-x)
+	   (lambda args #f)))
+       lst)))
+  (hi)
+  (hi))
+
+;; this caught me -- Guile returns 6 3 also
+(test (let ((fnc #f))
+	(for-each
+	 (let ((ctr 0))
+	   (lambda (x)
+	     (if (= ctr 3)
+		 (set! fnc (lambda () ctr)))
+	     (set! ctr (+ ctr 1))))
+	 '(1 2 3 4 5 6))
+	(fnc))
+      6)
+
+(test (let ((fnc #f))
+	(for-each
+	 (let ((ctr 0))
+	   (lambda (x)
+	     (if (= ctr 3)
+		 (set! fnc (let ((local-ctr ctr))
+			     (lambda () local-ctr))))
+	     (set! ctr (+ ctr 1))))
+	 '(1 2 3 4 5 6))
+	(fnc))
+      3)
+
+(let ((x 0))
+  (let ((p1 (dilambda (lambda (a) (set! x (+ x a))) (lambda (a b) (+ a b)))))
+    (for-each p1 '(1 2 3))
+    (test x 6))
+  (set! x 0)
+  (for-each (lambda args (set! x (+ x (car args)))) '(1 2 3))
+  (test x 6)
+  (set! x 0)
+  (for-each (lambda* (a (b 2)) (set! x (+ x a))) '(1 2 3))
+  (test x 6)
+  (set! x 0)
+  (for-each (lambda args (set! x (+ x (car args) (cadr args)))) '(1 2 3) '(3 2 1))
+  (test x 12)
+  (set! x 0)
+  (for-each (lambda* (a (b 2)) (set! x (+ x a b))) '(1 2 3) '(3 2 1))
+  (test x 12)
+  (set! x 0)
+  (for-each (lambda* (a (b 2)) (set! x (+ x a b))) '(1 2 3))
+  (test x 12))
+
+(test (let ((lst '(1 2 3)) (sum 0)) (define-macro (hi a) `(set! sum (+ sum (+ 1 ,a)))) (for-each hi lst) sum) 9)
+(test (let ((lst '(1 2 3)) (sum 0)) (define-bacro (hi a) `(set! sum (+ sum (+ 1 ,a)))) (for-each hi lst) sum) 9)
+
+(let ((sum 0))
+  (define (and-for-each func . args)
+    ;; apply func to first of each arg, stopping if func returns #f
+    (call-with-exit
+     (lambda (quit)
+       (apply for-each
+	      (lambda arglist
+		(if (not (apply func arglist))
+		    (quit #<unspecified>)))
+	      args))))
+
+  (test (and-for-each (lambda (arg)
+			(and (not (null? arg))
+			     (set! sum (+ sum arg))))
+		      (list 1 2 () 3 4))
+	#<unspecified>)
+  (test sum 3)
+  (set! sum 0)
+
+  (and-for-each (lambda (arg)
+		  (and (not (null? arg))
+		       (set! sum (+ sum arg))))
+		(list 1 2 3 4))
+  (test sum 10)
+  (set! sum 0)
+
+  (and-for-each (lambda (arg1 arg2)
+		  (and (not (null? arg1))
+		       (not (null? arg2))
+		       (set! sum (+ sum arg1 arg2))))
+		(list 1 2 3 4)
+		(list 5 6 () 7 8))
+  (test sum 14))
+
+
+(define (and-map func . args) ; see stuff.scm for a better version
+  (call-with-exit
+   (lambda (quit)
+     (let ((result ()))
+       (apply for-each
+	      (lambda arglist
+		(let ((val (apply func arglist)))
+		  (if (not val)
+		      (quit (reverse result))
+		      (set! result (cons val result)))))
+	    args)
+       (reverse result)))))
+
+(test (and-map even? '(0 2 4 5 6)) '(#t #t #t))
+
+(define (find-if f . args)
+  (call-with-exit
+   (lambda (return)
+     (apply for-each (lambda main-args
+		       (if (apply f main-args)
+			   (apply return main-args)))
+	    args))))
+
+(test (find-if even? #(1 3 5 2)) 2)
+(test (* (find-if > #(1 3 5 2) '(2 2 2 3))) 6)
+
+(define (position-if f . args)
+  (let ((pos 0))
+    (call-with-exit
+     (lambda (return)
+       (apply for-each (lambda main-args
+			 (if (apply f main-args)
+			     (return pos))
+			 (set! pos (+ pos 1)))
+	    args)))))
+
+(test (position-if even? #(1 3 5 2)) 3)
+(test (position-if > #(1 3 5 2) '(2 2 2 3)) 1)
+
+(let ((summer (lambda (v)
+		(let ((sum 0))
+		  (do ((i 0 (+ i 1)))
+		      ((= i 10) sum)
+		    (set! sum (+ sum ((v i)))))))))
+
+  (test (let ((saved-args (make-vector 10))
+	      (i 0))
+	  (for-each
+	   (lambda (arg)
+	     (set! (saved-args i) arg)
+	     (set! i (+ i 1)))
+	   (list 0 1 2 3 4 5 6 7 8 9))
+	  (set! (saved-args 0) 32)
+	  saved-args)
+	#(32 1 2 3 4 5 6 7 8 9))
+
+  (test (let ((f #f))
+	  (for-each
+	   (lambda (i)
+	     (let ()
+	       (define (x) i)
+	       (if (= i 1) (set! f x))))
+	   (list 0 1 2 3))
+	  (f))
+	1)
+
+  (test (let ((saved-args (make-vector 10))
+	      (i 0))
+	  (for-each
+	   (lambda (arg)
+	     (set! (saved-args i) (lambda () arg))
+	     (set! i (+ i 1)))
+	   (list 0 1 2 3 4 5 6 7 8 9))
+	  (summer saved-args))
+	45)
+
+  (test (let ((saved-args (make-list 10))
+	      (i 0))
+	  (for-each
+	   (lambda (arg)
+	     (list-set! saved-args i (lambda () arg))
+	     (set! i (+ i 1)))
+	   (list 0 1 2 3 4 5 6 7 8 9))
+	  (summer saved-args))
+	45)
+
+;;; these are the same but use map
+  (test (let ((saved-args (make-vector 10))
+	      (i 0))
+	  (map
+	   (lambda (arg)
+	     (set! (saved-args i) arg)
+	     (set! i (+ i 1)))
+	   (list 0 1 2 3 4 5 6 7 8 9))
+	  (set! (saved-args 0) 32)
+	  saved-args)
+	#(32 1 2 3 4 5 6 7 8 9))
+
+  (test (let ((f #f))
+	  (map
+	   (lambda (i)
+	     (let ()
+	       (define (x) i)
+	       (if (= i 1) (set! f x))))
+	   (list 0 1 2 3))
+	  (f))
+	1)
+
+  (test (let ((saved-args (make-vector 10))
+	      (i 0))
+	  (map
+	   (lambda (arg)
+	     (set! (saved-args i) (lambda () arg))
+	     (set! i (+ i 1)))
+	   (list 0 1 2 3 4 5 6 7 8 9))
+	  (summer saved-args))
+	45)
+
+  ;; and again but with named let
+  (test (let ((saved-args (make-vector 10)))
+	  (let runner ((arg 0))
+	    (set! (saved-args arg) arg)
+	    (if (< arg 9)
+		(runner (+ arg 1))))
+	  (set! (saved-args 0) 32)
+	  saved-args)
+	#(32 1 2 3 4 5 6 7 8 9))
+
+  (test (let ((f #f))
+	  (let runner ((i 0))
+	    (let ()
+	      (define (x) i)
+	      (if (= i 1) (set! f x))
+	      (if (< i 3)
+		  (runner (+ i 1)))))
+	  (f))
+	1)
+
+  (test (let ((saved-args (make-vector 10)))
+	  (let runner ((i 0))
+	    (set! (saved-args i) (lambda () i))
+	    (if (< i 9)
+		(runner (+ i 1))))
+	  (summer saved-args))
+	45)
+
+
+;;; and recursion
+  (test (let ((saved-args (make-vector 10)))
+	  (define (runner arg)
+	    (set! (saved-args arg) arg)
+	    (if (< arg 9)
+		(runner (+ arg 1))))
+	  (runner 0)
+	  (set! (saved-args 0) 32)
+	  saved-args)
+	#(32 1 2 3 4 5 6 7 8 9))
+
+  (test (let ((f #f))
+	  (define (runner i)
+	    (let ()
+	      (define (x) i)
+	      (if (= i 1) (set! f x))
+	      (if (< i 3)
+		  (runner (+ i 1)))))
+	  (runner 0)
+	  (f))
+	1)
+
+  (test (let ((saved-args (make-vector 10)))
+	  (define (runner i)
+	    (set! (saved-args i) (lambda () i))
+	    (if (< i 9)
+		(runner (+ i 1))))
+	  (runner 0)
+	  (summer saved-args))
+	45)
+
+
+;;; and member/assoc
+  (test (let ((saved-args (make-vector 10)))
+	  (member 'a '(0 1 2 3 4 5 6 7 8 9)
+		  (lambda (a b)
+		    (set! (saved-args b) (lambda () b))
+		    #f))
+	  (summer saved-args))
+	45)
+
+  (test (let ((saved-args (make-vector 10)))
+	  (assoc 'a '((0 b) (1 b) (2 b) (3 b) (4 b) (5 b) (6 b) (7 b) (8 b) (9 b))
+		 (lambda (a b)
+		   (set! (saved-args b) (lambda () b))
+		   #f))
+	  (summer saved-args))
+	45)
+
+  (test (let ((saved-args (make-vector 10 #f)))
+	  (sort! '(3 2 1 4 6 5 9 8 7 0)
+		 (lambda (a b)
+		   (if (not (saved-args b))
+		       (set! (saved-args b) (lambda () b)))
+		   (< a b)))
+	  (summer saved-args))
+	45)
+
+;;; and do which has never worked in this way
+#|
+  (test (let ((saved-args (make-vector 10)))
+	  (do ((i 0 (+ i 1)))
+	      ((= i 10))
+	    (set! (saved-args i) (lambda () i)))
+	  (summer saved-args))
+	45)
+|#
+  )
+
+;; map/for-each + circular lists
+(let ()
+  (define L1 (let ((lst (list 1 2))) (set-cdr! (cdr lst) lst) lst))
+  (define L2 (let ((lst (list 1 2 3))) (set-cdr! (cddr lst) lst) lst))
+  (define V1 (make-vector 5 0))
+  (test (map cons L1 V1) '((1 . 0) (2 . 0))) ; perhaps it should be out to 5 (needs to be consistent with iterate)
+  (test (map cons L1 L2) '((1 . 1) (2 . 2) (1 . 3)))
+  (let ((L ()))
+    (for-each (lambda (p q)
+                (set! L (cons (cons p q) L)))
+              L1 V1)
+    (test L '((2 . 0) (1 . 0))))
+  (let ((L ()))
+    (for-each (lambda (p q)
+                (set! L (cons (cons p q) L)))
+  	      L1 L2)
+    (test L '((2 . 2) (1 . 1)))) ; depends on cycle detection point
+  (test (map (let ((L1 (let ((lst (list 1 2 3))) (set-cdr! (cddr lst) lst) lst)))
+		(lambda (p)
+		  (let ((result (cons (car L1) p)))
+		    (set! L1 (cdr L1))
+		    result)))
+	       V1)
+         '((1 . 0) (2 . 0) (3 . 0) (1 . 0) (2 . 0))))
+
+;;; originally for-each/map used old_frame_with_slot, but if the closure had
+;;;   a local define, the arg symbol was not updated (let_id), leading to segfaults
+;;;   if the optimizer thought checks were unneeded.  So...
+
+(let ()
+  (define (f1) (for-each (lambda (f3) (let ((x 0)) (if (> f3 x) (abs f3)))) (list 1 2))) (f1)
+  (define (f2) (for-each (lambda (f3) (define x 0) (if (> f3 x) (abs f3))) (list 1 2))) (f2)
+  (let ((f (let flet ((x 1)) (if (> x 0) (flet (- x 1))) flet))) (map f (list 1 2)))
+  (define (f4) (map (let flet ((x 1)) (if (> x 0) (flet (- x 1))) flet) (list 1 2))) (f4)
+  (define (f4a) (for-each (let flet ((x 1)) (if (> x 0) (flet (- x 1))) flet) (list 1 2))) (f4a)
+  (define (f4b) (for-each (let flet ((x 1)) (define y 0) (if (> x y) (flet (- x 1))) flet) (list 1 2))) (f4b)
+  (define (f5) (for-each (let () (define (f x) (if (> x 0) (f (- x 1)))) f) (list 1 2))) (f5)
+  (define (f5a) (for-each (let () (define (f x) (define y 0) (if (> x y) (f (- x 1)))) f) (list 1 2))) (f5a)
+  (define (f5b) (for-each (lambda (x) (define z 2) (define y 0) (if (> z x y) (display (- x 1)))) (list 1 2))) (f5b)
+  (define (f6) (map (let () (define (f x) (if (> x 0) (f (- x 1)) x)) f) (list 1 2))) (test (f6) '(0 0))
+  (define (f7) (map (let () (define (f x) (define y (+ x 1)) (if (> y 0) (f (- x 1)) x)) f) (list 1 2))) (test (f7) '(-1 -1))
+  )
+
+;;; another similar case (from Kjetil Matheussen):
+(let ()
+  (define (a-sub area data)
+    (for-each (lambda (raw-mouse-cycle)
+                (when (raw-mouse-cycle :is-active) (define data2 5)))
+	      (area :get-raw-mouse-cycles)))
+  (define (g)
+    (a-sub (lambda (x) (list (hash-table :is-active #t :data 123) (hash-table :is-active #t :data 123))) #t))
+  (test (g) #<unspecified>))
+
+
+;;; --------------------------------------------------------------------------------
+;;; map
+;;; --------------------------------------------------------------------------------
+
+(test (map cadr '((a b) (d e) (g h))) '(b e h))
+(test (map (lambda (n) (expt n n)) '(1 2 3 4 5)) '(1 4 27 256 3125))
+(test (map + '(1 2 3) '(4 5 6)) '(5 7 9))
+
+(test (apply vector (map (lambda (i) (* i i)) '(0 1 2 3 4))) #(0 1 4 9 16))
+(map (lambda (x) (display "map should not have called this")) ())
+(test (let ((ctr 0)) (map (lambda (x y) (if (= x y) (set! ctr (+ ctr 1))) ctr) '(1 2 3 4 5 6) '(2 3 3 4 7 6))) (list 0 0 1 2 2 3))
+(test (let ((ctr 0)) (map (lambda (x y z) (set! ctr (+ ctr x y z)) ctr) '(0 1) '(2 3) '(4 5))) (list 6 15))
+(test (let ((ctr 0)) (map (lambda (x y z) (set! ctr (+ ctr x y z)) ctr) '(1) '(3) '(5))) (list 9))
+(test (let ((ctr 0)) (map (lambda (x y z) (set! ctr (+ ctr x y z)) ctr) () () ())) ())
+(test (map (lambda (a b) (+ a b)) (list 1 2) (list 1 2)) (list 2 4))
+(test (map abs '(1 -2)) (list 1 2))
+(test (map + '(0 1 2) '(2 1 0) '(3 4 5) '(5 4 3) '(6 7 8) '(8 7 6)) (list 24 24 24))
+(test (map (lambda (a) (cons a (map (lambda (b) (+ b 1)) (list 0 1 2)))) (list 3 4 5)) '((3 1 2 3) (4 1 2 3) (5 1 2 3)))
+(test (map (lambda (a) (+ a 1)) (map (lambda (b) (+ b 1)) (map (lambda (c) (+ c 1)) (list 0 1 2)))) '(3 4 5))
+(test (map (lambda args (apply + args)) '(0 1 2) '(3 4 5) '(6 7 8) '(9 10 11) '(12 13 14)) '(30 35 40))
+(test (map (lambda (a b . args) (+ a b (apply + args))) '(0 1 2) '(3 4 5) '(6 7 8) '(9 10 11) '(12 13 14)) '(30 35 40))
+(test (map (lambda (a b . args) (+ a b (apply + args))) '(0 1 2) '(3 4 5)) '(3 5 7))
+(test (map (lambda args args) '(1 2 3)) '((1) (2) (3)))
+(test (map + () ()) ())
+(test (map + (#(#() #()) 1)) ())
+(test (map + #(1) #(1) #(1)) '(3))
+(test (map list '(a b c)) '((a) (b) (c)))
+(test (map (lambda (a b) (- a b)) (list 1 2) (vector 3 4)) '(-2 -2))
+(test (map (lambda (a b c) (if (char=? a #\a) (+ b c) (- b c))) "axa" (list 1 2 3) (vector 4 5 6)) '(5 -3 9))
+(test (map vector (memv 1 (list 1 2 3))) '(#(1) #(2) #(3)))
+(test (map append #(1 2 3)) '(1 2 3))
+(test (map eval '((+ 1 2) (* 3 4))) '(3 12))
+(test (map (map + (list 1 2 3)) (list 0 1 2)) '(1 2 3))
+(test (let ((a #t) (b #f) (c #t)) (map when '(a b c) '(12 32 0))) '(12 #<unspecified> 0))
+(test (let ((a #t) (b #f)) (map if '(a b) '(1 2) '(3 4))) '(1 4))
+(test (let ((a #t) (b #f)) (map unless '(a b) '(1 2))) '(#<unspecified> 2))
+(test (let ((a #t) (b #f)) (list (map set! '(a b) '(1 2)) a b)) '((1 2) 1 2))
+(test (let ((a #t) (b #f)) (map begin '(a b))) '(#t #f))
+(test (let () (map apply (map lambda '(a b) '((car a) (car b))) '((2) (3)))) '(2 3))
+(test (let () (map apply (map lambda* '(((a 1)) ((b 2))) '(a b)) '((3) ()))) '(3 2))
+(test (map + '(1 2 3) '(4 5 6) '(7 8 9)) '(12 15 18))
+(test (map (lambda (x) (vector->list x)) (list #(1 2) #(3 4))) '((1 2) (3 4)))
+
+(test (let* ((x (list (list 1 2 3))) (y (apply map abs x))) (list x y)) '(((1 2 3)) (1 2 3)))
+(test (let* ((x (quote ((1 2) (3 4)))) (y (apply map ash x))) (list x y)) '(((1 2) (3 4)) (8 32)))
+(test (let* ((x (quote ((1 2 3) (4 5 6) (7 8 9)))) (y (apply map + x))) (list x y)) '(((1 2 3) (4 5 6) (7 8 9)) (12 15 18)))
+(test (map * (map + '(1 2 3) '(4 5 6)) '(1 2 3)) '(5 14 27))
+(test (apply map * (apply map + '(1 2 3) '((4 5 6))) '((1 2 3))) '(5 14 27))
+(test (let* ((x (lambda () '(1 2 3))) (y (apply map - (list (x))))) (x)) '(1 2 3))
+
+;(test (map car (list (list 0) (list (values)) (list 2))) (map (lambda (x) (car x)) (list (list 0) (list (values)) (list 2))))
+(test (apply append (map list '((a . 1) (b . 2) #<eof>))) '((a . 1) (b . 2) #<eof>))
+(test (apply append (map list '(a b #<eof> d))) '(a b #<eof> d))
+(test (map values (vector 1 2 #<eof> 3)) '(1 2 #<eof> 3))
+(test (map (lambda (x) (values)) '(1 2 3)) ()) ; :)
+
+(let ()
+  (define (f) (map (lambda x x) (list 1 2 3)))
+  (define (g) (map (lambda (x . y) (cons x y)) (list 1 2 3)))
+  (test (equal? (f) (g)) #t))
+
+(let ()
+  (define (f lst)
+    (apply map (lambda* (a (b 1)) (* a b)) lst))
+  (test (f '((2 3))) '(2 3))
+  (test (f '((2 3) (4 5))) '(8 15)))
+(let ()
+  (define (f lsts)
+    (map (lambda* (a (b 1)) (* a b)) (apply values lsts)))
+  (test (f '((2 3))) '(2 3))
+  (test (f '((2 3) (4 5))) '(8 15)))
+
+(test (map (lambda (x) (set! x (* 2 x)) 2) '(1 2 3)) '(2 2 2))
+(test (map (lambda (x) x (set! x (* 2 x)) x) '(1 2 3)) '(2 4 6))
+(test (map (lambda (x) 1) '(1 2 3)) '(1 1 1))
+
+(test (let () (define (f) (map (let ((x 3)) (lambda (y) (+ x y))) '((x 1) (y . 2)))) (f)) 'error)
+(test (let () (define (f) (map (let ((x 3)) (lambda (y) (+ x y))) '(x 2))) (f)) 'error)
+(test (let () (define (f) (map (let ((x 3)) (lambda (y) (+ x y))) '(1 2))) (f)) '(4 5))
+(test (let () (define (f) (map (let ((x 3)) (let ((y 0)) (lambda (y) (+ x y)))) '(1 2))) (f)) '(4 5))
+(test (let () (define (func) (map (lambda (x) (if (>= x 0.0) x (- x))) (list (float-vector? (block))))) (define (hi) (func)) (hi)) 'error)
+(test (let () (define (f1) (let ((!x! (map (lambda (!a!) (inlet 'pi 1)) '(0)))) (car !x!))) (f1)) 'error)
+(test (let () (define (func) (map (lambda (call/cc (lambda (r) 123)) 123) (make-iterator #r()) 3/4)) (func)) 'error)
+(test (map (make-hash-table) (hash-table 'b 2)) '(#f))
+(test (let* ((H (make-hash-table))
+             (I (make-iterator H))
+             (R ()))
+        (hash-table-set! H 'a 1)
+        (for-each (lambda (obj) (set! R (cons obj R))) I)
+        R)
+  '((a . 1)))
+
+(let ()
+  (define* (feclo (a 0) (b 1)) (+ a b))
+  (define (tfeclo) (map feclo '(1 :b 3 :a 5) '(2 3 4 5 6)))
+  (test (tfeclo) '(3 3 7 6 11)))
+(let () ; testing lambda* arg to for_each_closure
+  (define* (fe1 (a 0)) (unless (integer? a) (error 'wrong-type-arg "for-each arg: ~S" a)))
+  (define (tfe1) (for-each fe1 '(1 2 3)))
+  (tfe1)
+  (define* (fe2 (a 0) (b 1)) (unless (= (+ a b) (+ a 1)) (error 'wrong-type-arg "for-each arg: ~S ~S" a b)))
+  (define (tfe2) (for-each fe2 '(1 2 3)))
+  (tfe2))
+
+
+(test (let ((d 0))
+	(map (let ((a 0))
+	       (map (lambda (b) (set! a (+ a b))) (list 1 2))
+	       (lambda (c) (set! d (+ d c a)) d))
+	     (list 3 4 5)))
+      (list 6 13 21))
+(test (let ((d 0))
+	(map (lambda (c)
+	       (let ((a 0))
+		 (map (lambda (b) (set! a (+ a b))) (list 1 2))
+		 (set! d (+ d a c))
+		 d))
+	     (list 3 4 5)))
+      (list 6 13 21))
+
+(test (let ((ctr 0))
+	(let ((val (call/cc
+		    (lambda (exit)
+		      (map (lambda (a)
+			     (if (> a 3) (exit a))
+			     (set! ctr (+ ctr 1))
+			     ctr)
+			   (list 0 1 2 3 4 5))))))
+	  (list ctr val)))
+      (list 4 4))
+
+(test (call-with-current-continuation
+       (lambda (exit)
+	 (map
+	  (lambda (x)
+	    (if (negative? x) (exit x))
+	    x)
+	  '(54 0 37 -3 245 19))))
+      -3)
+
+(test (let ((ctr 0)
+	    (cont #f)
+	    (lst ()))
+	(let ((val (call/cc
+		    (lambda (exit)
+		      (map (lambda (a)
+			     (if (and (not cont) (= a 2))
+				 (exit a))
+			     (if (and cont (= a 5))
+				 (exit a))
+			     (call/cc (lambda (c) (set! cont c)))
+			     (set! lst (cons ctr lst))
+			     (set! ctr (+ ctr 1))
+			     ctr)
+			   (list 0 1 2 3 4 5))))))
+	  (if (< val 5)
+	      (cont))
+	  (list ctr val lst)))
+      (list 5 5 (list 4 3 2 1 0)))
+
+(let ()
+  (define (tree-add x lst)
+    (define (tree-add-1 lst-1)
+      (map (lambda (a)
+	     (if (pair? a) (tree-add-1 a) (+ a x)))
+	   lst-1))
+    (tree-add-1 lst))
+  (test (tree-add 12 '((1 2) ((3)) 4 5)) '((13 14) ((15)) 16 17)))
+
+(test (map (lambda (a) a) (map (lambda (b) b) (list 1 2 3))) (list 1 2 3))
+(test (map cons '(a b c) '(() () ())) '((a) (b) (c)))
+(test (map (lambda a (list a)) '(1 2 3)) '(((1)) ((2)) ((3))))
+(test (map (lambda* a (list a)) '(1 2 3)) '(((1)) ((2)) ((3))))
+(test (map (lambda* (a) (list a)) '(1 2 3)) '((1) (2) (3)))
+(test (map (lambda* ((a 0)) (list a)) '(1 2 3)) '((1) (2) (3)))
+(test (map (lambda* ((a 0) (b 1)) (list a)) '(1 2 3)) '((1) (2) (3)))
+(test (map (lambda (a . b) (list a)) '(1 2 3)) '((1) (2) (3)))
+(test (map list '(1 2 3)) '((1) (2) (3)))
+(test (map (lambda a (apply list a)) '(1 2 3)) '((1) (2) (3)))
+(test (map (lambda a (apply values a)) '(1 2 3)) '(1 2 3))
+(test (map (lambda a (values a)) '(1 2 3)) '((1) (2) (3)))
+(test (map (lambda a (append a)) '(1 2 3)) '((1) (2) (3)))
+(test (map values '(1 2 3)) '(1 2 3))
+;(test ((lambda* ('a) quote) 1) 1)
+(test (procedure? (car (map lambda '(()) '((1))))) #t)
+(test (procedure? (car (map lambda '((x)) '(((+ x 1)))))) #t)
+(test (map #(0 1 2) #(2 1 0)) '(2 1 0))
+;(test (map quasiquote '((quasiquote 1) (quasiquote 2))) '(1 2)) -- this has changed (12-May-14)
+(test (map (lambda (a b) (a b)) (map lambda '((x) (y) (z)) '((+ x x) (* y y) (expt z z))) (list 1 2 3)) '(2 4 27))
+(test (map apply (map lambda '((x) (y) (z)) '((+ x x) (* y y) (expt z z))) '((1) (2) (3))) '(2 4 27))
+(test (let () (define (add-some x) (define (add-some x) (+ x 2)) (+ x 1)) (map add-some '(1 2 3 4))) '(2 3 4 5)) ; from some CL website -- kinda ridiculous
+(test (map gcd #(1 2)) '(1 2))
+(test (apply vector (map values #(1 2) #(3 4))) #(1 3 2 4))
+(test (map values '(1 2 3) '(4 5 6) '(7 8 9)) '(1 4 7 2 5 8 3 6 9))
+(test (map eval (list (+ 1 2) (+ 3 4))) '(3 7))
+(test (map apply (list + - * /) (list 1 2 3 4) '((5) (6) (7) (8))) '(6 -4 21 1/2))
+
+;;; (let ((val ())) (list (map (lambda a (set! val (cons a val)) a) '(1 2 3)) val)) -> ((#3=(1) #2=(2) #1=(3)) (#1# #2# #3#))
+(test (map if '(#f #f #t) '(0 1 2) '(3 4 5)) '(3 4 2))
+(test (map apply (map lambda '(() (a) (a b)) '(1 (+ a 1) (+ a b 1))) '(() (2) (3 4))) '(1 3 8))
+(test (map values (list 1 2 3) (list 4 5 6)) '(1 4 2 5 3 6))
+(test (map map (list values) '((1 2)) '((3 4))) '((1 3 2 4)))
+(test (map values '((1 2)) '((3 4))) '((1 2) (3 4)))
+(test (map map (list map) (list (list values)) '(((1 2))) '(((3 4)))) '(((1 3 2 4))))
+(test (map apply (list values) '(((1 2))) '(((3 4)))) (apply map values '(((1 2))) '(((3 4))))) ; !
+(test (let ((x '((1 2)))) (eval `(apply apply values x)) (object->string x)) "((1 2))") ; not "((values 1 2))" -- 24-Aug-12
+(test (map (lambda (x) x) #u(255)) (list 255))
+
+(let () (define (f) (let ((x (map (lambda (a) (vector-ref (vector abs log) 0 -1)) '(0)))) (car x))) (test (f) 1))
+(test (apply (list cons cons) '(1 2)) 'error)
+(test (apply (list cons cons) '(1 2 3)) '(2 . 3))
+
+(let ()
+  (define (shuffle . args)
+    (apply map values args))
+  (test (shuffle '(1 2 3) #(4 5 6) '(7 8 9)) '(1 4 7 2 5 8 3 6 9))
+  (test (shuffle '(1 2 3)) '(1 2 3))
+  (test (shuffle '(1 2 3) '(4)) '(1 4))
+  (test (shuffle '(1 2 3) ()) ())
+  )
+
+(test (map list "hi") '((#\h) (#\i)))
+(test (map string "hi") '("h" "i"))
+(test (map vector "hi") '(#(#\h) #(#\i)))
+(test (map char-upcase "hi") '(#\H #\I))
+(test (map append #(#() #())) '(#() #()))
+
+(test (map abs () abs) 'error)
+(test (map (lambda (x) (display "map should not have called this"))) 'error)
+(test (let ((ctr 0)) (map (lambda (x y z) (set! ctr (+ ctr x y z)) ctr) '(1) '(3) ())) ())
+(test (let ((ctr 0)) (map (lambda (x y z) (set! ctr (+ ctr x y z))) '(0 1) '(2 3) '(4 5 6))) '(6 15))
+
+(test (map (lambda (a b) (+ a b)) (list 1)) 'error)
+(test (map (lambda (a b) (+ a b)) (list 1) (list)) ())
+(test (map (lambda (a b) (+ a b)) (list 1) (list 2)) (list 3))
+(test (map (lambda (a b) (+ a b)) (list 1)) 'error)
+(test (map (lambda (a b) (+ a b)) (list 1) (list 2) (list 3)) 'error)
+(test (map (lambda (a b) (+ a b)) (list 1) (list 1 2)) '(2))
+(test (map (lambda (a b) (+ a b)) (list 1 2) (list 1)) '(2))
+(test (map (lambda (a b) (+ a b)) (list 1 2) (list 1 2 3)) '(2 4))
+(test (map (lambda (a b) (+ a b)) (list 1 2) (list 1)) '(2))
+(test (map (lambda (a b) (+ a b)) (list 1 2) (list 1 2) (list)) 'error) ; ()
+(test (map (lambda (a b) (+ a b)) (list 1 2) (list 1 2) (list 1 2)) 'error)
+(test (map (lambda (a b) (+ a b)) (list 1 2) (cons 1 2)) '(2))
+
+(test (map (lambda* (x . args) args) '(1 2 3)) '(() () ()))
+(test (map (lambda (x . args) args) '(1 2 3)) '(() () ()))
+(test (map (lambda* (x . args) (list x args)) '(1 2 3)) '((1 ()) (2 ()) (3 ())))
+(test (map (lambda (x . args) (list x args)) '(1 2 3)) '((1 ()) (2 ()) (3 ())))
+(test (map (lambda args args) '(1 2 3)) '((1) (2) (3)))
+(test (map (lambda* args args) '(1 2 3)) '((1) (2) (3)))
+(test (map (lambda (x y . args) args) '(1 2 3)) 'error)
+(test (map (lambda* (x y . args) args) '(1 2 3)) '(() () ())) ; all args are optional in lambda*
+(test (map (lambda (x y . args) args) '(1 2 3) '(4 5 6)) '(() () ()))
+(test (map (lambda* (x y . args) args) '(1 2 3) '(4 5 6)) '(() () ()))
+(test (map (lambda (x y . args) (list x y args)) '(1 2 3) '(4 5 6)) '((1 4 ()) (2 5 ()) (3 6 ())))
+(test (map (lambda* (x y . args) (list x y args)) '(1 2 3) '(4 5 6)) '((1 4 ()) (2 5 ()) (3 6 ())))
+(test (map (lambda (x y . args) (list x y args)) '(1 2 3) '(4 5 6) '(7 8 9)) '((1 4 (7)) (2 5 (8)) (3 6 (9))))
+(test (map (lambda* (x y . args) (list x y args)) '(1 2 3) '(4 5 6) '(7 8 9)) '((1 4 (7)) (2 5 (8)) (3 6 (9))))
+(test (map (lambda* (x y :rest args) (list x y args)) '(1 2 3) '(4 5 6) '(7 8 9)) '((1 4 (7)) (2 5 (8)) (3 6 (9))))
+
+(test (map (lambda a a) (list 1 2 3)) '((1) (2) (3)))
+(test (map (lambda (a . b) (cons a b)) (list 1 2 3)) '((1) (2) (3)))
+(test (map (lambda a a) (list 1 2 3) (list 4 5 6)) '((1 4) (2 5) (3 6)))
+(test (map (lambda (a . b) (cons a b)) (list 1 2 3) (list 4 5 6)) '((1 4) (2 5) (3 6)))
+(test (map (lambda (a b) (cons a b)) (list 1 2 3) (list 4 5 6)) '((1 . 4) (2 . 5) (3 . 6)))
+(test (map (macro (a) a) (list 1 2 3)) '(1 2 3))
+(let ((a 1) (b 2) (c 3)) (test (map (macro (a) a) '(a b c)) '(1 2 3)))
+(let ((a 1) (b 2) (c 3)) (test (map (lambda (a) a) '(a b c)) '(a b c)))
+(let ((a 1) (b 2) (c 3)) (test (map (macro a a) '(a b c)) 'error))
+(let ((a 1) (b 2) (c 3)) (test (map (lambda a a) '(a b c)) '((a) (b) (c))))
+
+(test (map (lambda . (x y z 8)) '(1 2 3))  'error) ; (y unbound) but other schemes ignore unused args
+(test (map (lambda . (x 8)) '(1 2)) '(8 8))
+
+(test (map (lambda (a) (+ a 1)) (list 1) (list 2)) 'error)
+(test (map (lambda (a) (+ a 1)) #\a) 'error)
+(test (map (lambda (a) (+ a 1)) (cons 1 2)) '(2))
+(test (map (lambda (a b . args) (+ a b (apply + args))) '(0 1 2)) 'error)
+(test (map (lambda (a) a) '(1 2 . 3)) '(1 2))
+(test (map) 'error)
+(test (map #t) 'error)
+(test (map set-cdr! '(1 2 3)) 'error)
+(test (map (lambda (a b) (set-cdr! a b) b) '((1) (2) (3)) '(4 5 6)) '(4 5 6))
+(test (let ((str "0123")) (set! (str 2) #\null) (map append str)) '(#\0 #\1 #\null #\3))
+
+(test (map ((lambda () abs)) '(-1 -2 -3)) '(1 2 3))
+(test (apply map ((lambda () abs)) (list (list -1 -2 -3))) '(1 2 3))
+(test (apply apply map ((lambda () abs)) (list (list (list -1 -2 -3)))) '(1 2 3))
+(test (apply apply apply map ((lambda () abs)) '((((-1 -2 -3))))) '(1 2 3))
+(test (apply apply apply (list (list map abs (list (list -1 -2 -3))))) '(1 2 3))
+(test (apply apply list 1 '((1 2) (3 4))) '(1 (1 2) 3 4))
+(test (apply + (apply apply apply (list (list map abs (list (list -1 -2 -3)))))) 6)
+(test (apply (apply apply lambda '(a) '(((+ a 1)))) '(14)) 15)
+(test (let ((a 14)) (apply apply quasiquote '(((+ ,a 1))))) '(+ 14 1))
+(test (apply map vector (values (list (vector 1 2)))) '(#(1) #(2)))
+(test (apply map string (list "123")) '("1" "2" "3"))
+(test (apply map string '("123" "456")) '("14" "25" "36"))
+(test (apply map list '((1 2) (3 4))) '((1 3) (2 4))) ; matrix transpose
+
+;;; Is <code>(apply apply func arglist)</code> the same as <code>(apply func (apply values arglist))</code>,
+;;; or (leaving aside <code>'(()))</code>, <code>(func (apply values (apply values arglist)))</code>?
+(test (apply apply + '((1 2 3))) (apply + (apply values '((1 2 3)))))
+(test (apply apply + '((1 2 3))) (+ (apply values (apply values '((1 2 3))))))
+
+(test (map string "123") '("1" "2" "3"))
+(test (map "hi" '(0 1)) '(#\h #\i))
+(test (map (list 2 3) '(0 1)) '(2 3))
+(test (map #(2 3) '(1 0)) '(3 2))
+(for-each
+ (lambda (arg)
+   (test (map arg (list 1)) 'error))
+ (list -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #f #t))
+(for-each
+ (lambda (arg)
+   (test (map (lambda (n m) n) (list 1) arg) 'error))
+ (list -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #f #t))
+(for-each
+ (lambda (arg)
+   (test (map (lambda (a) a) arg) 'error))
+ (list -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #f #t))
+
+(let ()
+  (define (concatenate . args)
+    (apply append (map (lambda (arg) (map values arg)) args)))
+  (test (concatenate "hi" #(#\h #\o)) '(#\h #\i #\h #\o))
+  (test (let ((lst (concatenate '(1 2) (let ((a 2) (b 3)) (curlet)) (hash-table 'c 4))))
+	  (or (equal? lst '(1 2 (b . 3) (a . 2) (c . 4)))
+	      (equal? lst '(1 2 (a . 2) (b . 3) (c . 4)))))
+	#t))
+
+(test (map (lambda (a1 a2 a3 a4 a5 a6 a7 a8 a9 a10)
+	     (max a1 a2 a3 a4 a5 a6 a7 a8 a9 a10))
+	   (list 6 7 8 9 10)
+	   (list 21 22 23 24 25)
+	   (list 16 17 18 19 20)
+	   (list 11 12 13 14 15)
+	   (list 26 27 28 29 30)
+	   (list 1 2 3 4 5)
+	   (list 36 37 38 39 40)
+	   (list 41 42 43 44 45)
+	   (list 46 47 48 49 50)
+	   (list 31 32 33 34 35))
+      (list 46 47 48 49 50))
+
+(test (map (lambda (a1 a2 a3 a4 a5 a6 a7 a8 a9 . a10)
+	     (apply max a1 a2 a3 a4 a5 a6 a7 a8 a9 a10))
+	   (list 6 7 8 9 10)
+	   (list 21 22 23 24 25)
+	   (list 16 17 18 19 20)
+	   (list 11 12 13 14 15)
+	   (list 26 27 28 29 30)
+	   (list 1 2 3 4 5)
+	   (list 36 37 38 39 40)
+	   (list 41 42 43 44 45)
+	   (list 46 47 48 49 50)
+	   (list 31 32 33 34 35))
+      (list 46 47 48 49 50))
+
+(test (map (lambda* (a1 a2 a3 . a10)
+	     (apply max a1 a2 a3 a10))
+	   (list 6 7 8 9 10)
+	   (list 21 22 23 24 25)
+	   (list 16 17 18 19 20)
+	   (list 11 12 13 14 15)
+	   (list 26 27 28 29 30)
+	   (list 1 2 3 4 5)
+	   (list 36 37 38 39 40)
+	   (list 41 42 43 44 45)
+	   (list 46 47 48 49 50)
+	   (list 31 32 33 34 35))
+      (list 46 47 48 49 50))
+
+(test (map (lambda args
+	     (apply max args))
+	   (list 6 7 8 9 10)
+	   (list 21 22 23 24 25)
+	   (list 16 17 18 19 20)
+	   (list 11 12 13 14 15)
+	   (list 26 27 28 29 30)
+	   (list 1 2 3 4 5)
+	   (list 36 37 38 39 40)
+	   (list 41 42 43 44 45)
+	   (list 46 47 48 49 50)
+	   (list 31 32 33 34 35))
+      (list 46 47 48 49 50))
+
+(test (map map (list abs) (list (list -1))) '((1)))
+(test (map map (list map) (list (list abs)) (list (list (list -1)))) '(((1))))
+(test (map map (list map) (list (list map)) (list (list (list abs))) (list (list (list (list -1 -3))))) '((((1 3)))))
+(test (map map (list lcm) (vector #(1 2))) '((1 2)))
+(test (map map (list integer?) (list (vector "hi" 1 2/3))) '((#f #t #f)))
+(test (map map (list char-lower-case?) (list "hAba")) '((#t #f #t #t)))
+(test (map map (list char-lower-case? char-upper-case?) (list "hAba" "HacDf")) '((#t #f #t #t) (#t #f #f #t #f)))
+(test (map map (list + -) (list (list 1 2) (list 3 4))) '((1 2) (-3 -4)))
+(test (map map (list map map) (list (list + -) (list - +)) '(((1 2) (3 4)) ((4 5) (6 7)))) '(((1 2) (-3 -4)) ((-4 -5) (6 7))))
+
+(test (map member (list 1 2 3) (list (list 1 2 3) (list 1 3 4) (list 3 4 5))) '((1 2 3) #f (3 4 5)))
+(test (map - (list 1 2 3) (list 1 2 3) (list 1 3 4) (list 3 4 5)) '(-4 -7 -9))
+(test (map - (list 1 2 3) (list 1 2 3 'hi) (list 1 3 4 #\a "hi") (list 3 4 5)) '(-4 -7 -9))
+(test (let () (define (mrec a b) (if (<= b 0) (list a) (map mrec (list a) (list (- b 1))))) (mrec (list 1 2) 5)) '(((((((1 2))))))))
+(test (map append '(3/4)) '(3/4))
+(test (map list '(1.5)) '((1.5)))
+(test (map vector '("hi")) '(#("hi")))
+(test (map object->string '(:hi (1 2) (()))) '(":hi" "(1 2)" "(())"))
+(test (map map (list for-each) (list (list abs)) (list (list (list 1 2 3)))) '((#<unspecified>)))
+(test (map map (list vector) '((#(1 #\a (3))))) '((#(#(1 #\a (3))))))
+(test (apply map map (list cdr) '((((1 2) (3 4 5))))) '(((2) (4 5))))
+(test (apply map map (list char-upcase) '(("hi"))) '((#\H #\I)))
+(test (apply map map (list *) '(((1 2)) ((3 4 5)))) '((3 8))) ; (* 1 3) (* 2 4)
+(test (map apply (list map) (list map) (list (list *)) '((((1 2)) ((3 4 5))))) '(((3 8))))
+(test (map map (list magnitude) '((1 . 2))) '((1))) ; magnitude is called once with arg 1
+(test (map magnitude '(1 . 2)) '(1))
+(test (map call/cc (list (lambda (r1) 1) (lambda (r2) (r2 2 3)) (lambda (r3) (values 4 5)))) '(1 2 3 4 5))
+(test (map call/cc (list number? continuation?)) '(#f #t))
+
+;; from scheme working group
+(test (let ((L (list 1 2 3 4 5))) (map (lambda (x) (set-cdr! (cddr L) 5) x) L)) '(1 2 3))
+(test (let ((L (list 1 2))) (map (lambda (x) (set! (cdr (cdr L)) L) x) L)) '(1 2))
+(test (let ((L (list 1 2))) (object->string (map (lambda (x) (set! (car (cdr L)) L) x) L))) "(1 #1=(1 #1#))")
+;;;(test (let ((L (list 1 2))) (map (lambda (x) (set-cdr! L L) x) L)) '(1 2)) ;?? this depends on when we cdr? infinite loop in Guile
+;;;(let ((L (list 1 2 3 4 5))) (map (lambda (x) (set-cdr! L ()) x) L)) ; another similar case -- s7 doesn't notice what happened
+;;;;  does that mean a GC during this map would leave us accessing freed memory?
+;;;  I think not because the original list is held by map (eval) locals that are protected
+;;;  we simply stepped on something after looking at it, similar to:
+(test (let ((L (list 1 2 3 4 5))) (map (lambda (x) (set-car! L 123) x) L)) '(1 2 3 4 5))
+(test (let ((L (list 1 2 3 4 5))) (map (lambda (x) (set-cdr! (cddr L) (list 6 7 8)) x) L)) '(1 2 3 6 7 8))
+;;; we could do something similar with strings:
+(test (let ((S "12345")) (map (lambda (x) (set! (S 2) #\null) x) S)) '(#\1 #\2 #\null #\4 #\5))
+;;; (length S) is still 5 even with the embedded null
+(test (let ((L (list 1 2 3))) (map (lambda (x) (set! L (list 6 7 8)) x) L)) '(1 2 3))
+(test (let ((L1 (list 1 2 3)) (L2 (list 4 5 6 7))) (map (lambda (x1 x2) (set-cdr! (cdr L1) ()) (cons x1 x2)) L1 L2)) '((1 . 4) (2 . 5)))
+(test (let ((L (list 1 2 3))) (map (lambda (x) (set-car! (cddr L) 32) x) L)) '(1 2 32))
+;;; should these notice the increased length?:
+(test (let ((L1 (list 1 2)) (L2 (list 6 7 8 9))) (map (lambda (x y) (set-cdr! (cdr L1) (list 10 11 12 13 14)) (cons x y)) L1 L2)) '((1 . 6) (2 . 7) (10 . 8) (11 . 9)))
+(test (let ((L1 (list 1)) (L2 (list 6 7 8))) (not (member (map (lambda (x y) (set-cdr! L1 (list 10 11 12)) (cons x y)) L1 L2) '(((1 . 6)) ((1 . 6) (10 . 7) (11 . 8)))))) #f)
+;;; op_map checks iterator_at_end before calling the function, whereas op_map_closure_2 checks afterwards so we get inconsistent results
+(test (let ((L1 (list 1 2))) (map (lambda (x) (set-cdr! (cdr L1) (list 10 11 12)) x) L1)) '(1 2 10 11 12))
+;;; a similar case could be made from hash-tables
+(test (let ((H (hash-table 'a 3 'b 4))) (pair? (map (lambda (x) (set! (H 'c) 32) (cdr x)) H))) #t)
+(test (let ((H (hash-table 'a 3 'b 4)))
+	(let ((L (map (lambda (x) (set! (H 'b) 32) (cdr x)) H)))
+	  (or (equal? L '(3 32))
+	      (equal? L '(4 3)))))
+      #t)
+;; in that first example, the set-cdr! is not the problem (map supposedly can treat its args in any order),
+;;   any set! will do:
+(test (let ((x 0)) (map (lambda (y) (set! x (+ x y)) x) '(1 2 3 4))) '(1 3 6 10))
+
+(test (map begin '(1 2 3)) '(1 2 3))
+(let ((funcs (map (lambda (lst) (eval `(lambda ,@lst))) '((() #f) ((arg) (+ arg 1))))))
+  (test ((car funcs)) #f)
+  (test ((cadr funcs) 2) 3))
+
+(test (map = #() =) 'error)
+(test (map ="") 'error)
+(test (map abs ()) ())
+(test (map abs "") ())
+(test (map abs "123" "") 'error)
+(test (map abs "123" "" #f) 'error)
+(test (map null? () #() "") 'error)
+(test (map null? () #() 0 "") 'error)
+(test (map '(()) #()) ())
+(test (map '(1 2 . 3) '(1 . 2)) '(2))
+(test (map '(()) ()) ())
+(test (map #2d((1 2) (3 4)) '(1)) '(#(3 4)))
+(test (map "a\x00;b" #(1 2)) '(#\null #\b))
+(test (map #(1 (3)) '(1)) '((3)))
+(test (map '((1 (2)) (((3) 4))) '(1)) '((((3) 4))))
+(test (map "hi" '(1)) '(#\i))
+(test (map #() #()) 'error)
+(test (map '(1 . 2) #()) ())
+(test (map ''2 '(1)) '(2))
+(test (((map lambda '((x)) '(1 2 . 3)) 0) 0) 1)
+(test (((map lambda '(()) #(1 2)) 0)) 1)
+(test (((map lambda '((x)) '((+ x 1))) 0) 32) 33)
+(test (map #() ()) 'error)
+(test (map () ()) 'error)
+(test (map "" "") 'error)
+(test (map (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) lst) '(0)) '(1))
+(let ((lst (list 1 2)) (os (*s7* 'safety))) (set! (*s7* 'safety) 1) (set! (cdr (cdr lst)) lst) (test (map lst lst) '(2 1)) (set! (*s7* 'safety) os))
+(test (map 1 "hi" ()) 'error)
+(test (map 0 #() ()) 'error)
+(test (map #\a #(1 2) '(3 4) "") 'error)
+(test (map or '(1 2 . 3)) '(1 2))
+(test (map or "a\x00;b") '(#\a #\null #\b))
+(test (map cond '((1 2) (3 4))) '(2 4)) ; (cond (1 2)) -> 2
+(test (map begin "hi") '(#\h #\i))
+(test (map quote "hi") '(#\h #\i))
+(test (map quote '(a b c)) '(a b c)) ; when are (map quote ...) and (map values ...) different?
+(test (map (begin #(1 (3))) '(1)) '((3)))
+(test (map (''2 0) ''2) ''2) ; we're mapping #_quote over ''2
+(test (map (apply lambda 'a '(-1)) '((1 2))) '(-1))
+(test (map (apply lambda 'a '(-1)) '(1 2)) '(-1 -1))
+(test (map do '(()) '((1 2))) '(2)) ; (list 2) because it's map, not just do
+(test (map case '(1) '(((-1 1) 2) 3)) '(2))
+(test (map let '(()) "a\x00;b") '(#\a))
+(test (map "hi" '(0 1) '(0 1)) 'error)
+(test (map '((1 2) (3 4)) '(0 1) '(0 1)) '(1 4))
+(test (map #2d((1 2) (3 4)) '(0 1) '(0 1)) '(1 4))
+(test (map #2d((1 2) (3 4)) '(0 1)) '(#(1 2) #(3 4)))
+(let ((os (*s7* 'safety)))
+  (set! (*s7* 'safety) 1)
+  (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (test (let ((L (map (lambda (a) a) lst))) (or (equal? L '(1 2 1)) (equal? L '(1 2)))) #t))
+  (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (test (map (lambda (a) a) lst lst) 'error))
+  (set! (*s7* 'safety) os))
+(test (map "hi" ('((1)) 0)) '(#\i))
+(test (map "hi" ('((1 0)) 0)) '(#\i #\h))
+(test (let ((ht (hash-table 'a 1 'b 2))) (map ht ht)) '(#f #f))
+(test (let ((ht (hash-table 'a 1 'b 2))) (let ((lst (map (lambda (c) (cdr c)) ht))) (or (equal? lst '(1 2)) (equal? lst '(2 1))))) #t)
+(test (let ((ht (hash-table 'a 1 'b 2))) (map ht '(a b))) '(1 2))
+
+(test (map '((1 2) (3 4)) #(1) #(1)) '(4))
+(test (map (quasiquote ((1 2) (3 4))) #(1) #(1 2)) '(4))
+
+(let ((pws (dilambda (lambda (a) a) (lambda (a b) b))))
+  (test (map append pws) 'error)
+  (test (map pws '(1 2 3)) '(1 2 3)))
+
+(test (map abs '(1 2 . 3)) '(1 2)) ;; ?? Guile says wrong type arg here
+(test (map + '(1) '(1 2 . 3)) '(2))
+(test (map abs '(1 . 2)) '(1))
+;; problematic because last thing is completely ignored:
+(test (map abs '(1 . "hi")) '(1))
+(test (map floor '(1 . "hi")) '(1))
+
+(for-each
+ (lambda (op)
+   (test (map op ()) 'error)
+   (test (map op "") 'error)
+   (test (map op #() (list) (string)) 'error))
+ (list 0 () #f #t 'a-symbol :hi #\a #<eof> #<unspecified> #<undefined> 0.0 1+i 1/2 1/0 0/0 *stdout* (current-input-port)))
+
+(test (map append (make-vector (list 2 0))) ())
+(let ((p1 (dilambda (lambda (a) (+ a 1)) (lambda (a b) (+ a b)))))
+  (test (map p1 '(1 2 3)) '(2 3 4)))
+(test (map (lambda args (+ (car args) 1)) '(1 2 3)) '(2 3 4))
+(test (map (lambda* (a (b 2)) (+ a 1)) '(1 2 3)) '(2 3 4))
+(let ((p1 (dilambda (lambda (a b) (+ a b)) (lambda (a b c) (+ a b c)))))
+  (test (map p1 '(1 2 3) '(3 2 1)) '(4 4 4)))
+(test (map (lambda args (+ (car args) (cadr args))) '(1 2 3) '(3 2 1)) '(4 4 4))
+(test (map (lambda* (a (b 2)) (+ a b)) '(1 2 3) '(3 2 1)) '(4 4 4))
+(test (map (lambda* (a (b 2)) (+ a b)) '(1 2 3)) '(3 4 5))
+(test (map (lambda* ((a 1) (b (map (lambda (c) (+ c 1)) (list 1 2)))) (+ a (apply + b))) (list 4 5 6)) '(9 10 11))
+(test (let ((lst (list 0 1 2))) (map (lambda* ((a 1) (b (for-each (lambda (c) (set! (lst c) (+ (lst c) 1))) (list 0 1 2)))) a) lst)) '(0 2 4))
+
+(test (let ((lst '(1 2 3))) (define-macro (hiho a) `(+ 1 ,a)) (map hiho lst)) '(2 3 4))
+(test (let ((lst '(1 2 3))) (define-bacro (hiho a) `(+ 1 ,a)) (map hiho lst)) '(2 3 4))
+(test (let ((lst '(1 2 3))) (define-macro (hiho a b) `(+ 1 ,a (* 2 ,b))) (map hiho lst lst)) '(4 7 10))
+(test (let ((lst '(1 2 3))) (define-macro (hi1 a) `(+ 1 ,a)) (define-macro (hiho a b) `(+ 1 ,a (* 2 ,b))) (map hiho lst (map hi1 lst))) '(6 9 12))
+(test (let ((lst '(1 2 3))) (define-macro (hiho a b) `(+ 1 ,a (* 2 ,b))) (map hiho lst (map (define-macro (hi1 a) `(+ 1 ,a)) lst))) '(6 9 12))
+(test (let ((lst '(1 2 3))) (define-macro (hi a) `(+ 1 ,a)) (define-macro (ho b) `(+ 1 (hi ,b))) (map ho lst)) '(3 4 5))
+(test (let ((lst '(1 2 3))) (define-macro* (hi a (b 2)) `(+ 1 ,a (* 2 ,b))) (map hi lst)) '(6 7 8))
+(test (let ((lst '(1 2 3))) (define-macro* (hi a (b 2)) `(+ 1 ,a (* 2 ,b))) (map hi lst (map hi lst))) '(14 17 20))
+
+(let ()
+  (define (hi)
+    (map (lambda (a) (a 0))
+	 (list (vector 1 2 3)
+	       (string #\a #\b #\c)
+	       (list 'e 'f 'g))))
+  (test (hi) '(1 #\a e)))
+
+(let ((ctr -1))
+  (apply begin (map (lambda (symbol)
+		      (set! ctr (+ ctr 1))
+		      (list 'define symbol ctr))
+		    '(_zero_ _one_ _two_)))
+  (+ _zero_ _one_ _two_))
+
+(let ()
+  (define (map-with-exit func . args)
+  ;; func takes escape thunk, then args
+  (let* ((result ())
+	 (escape-tag (gensym))
+	 (escape (lambda () (throw escape-tag))))
+    (catch escape-tag
+      (lambda ()
+	(let ((len (apply max (map length args))))
+	  (do ((ctr 0 (+ ctr 1)))
+	      ((= ctr len) (reverse result))      ; return the full result if no throw
+	    (let ((val (apply func escape (map (lambda (x) (x ctr)) args))))
+	      (set! result (cons val result))))))
+      (lambda args
+	(reverse result))))) ; if we catch escape-tag, return the partial result
+
+  (define (truncate-if func lst)
+    (map-with-exit (lambda (escape x) (if (func x) (escape) x)) lst))
+
+  (test (truncate-if even? #(1 3 5 -1 4 6 7 8)) '(1 3 5 -1))
+  (test (truncate-if negative? (truncate-if even? #(1 3 5 -1 4 6 7 8))) '(1 3 5))
+  )
+
+(let ()
+  (define-macro (cwe f) ; call-with-exit via catch/throw
+    (let* ((source (procedure-source (eval f)))
+ 	   (thrower (caadr source)))
+      `(catch 'throw
+         (lambda ()
+	   (let ((,thrower (lambda vals
+			     (apply throw 'throw vals))))
+	     ,@(cddr source)))
+         (lambda (type info)
+	   (apply values info)))))
+  (test (cwe (lambda (return) (return 2))) 2))
+
+;;; this is testing the one-liner unsafe closure optimizations
+(test (let ()
+	(define (fib n)
+	  (if (< n 2)
+	      n
+	      (+ (fib (- n 1))
+		 (fib (- n 2)))))
+	(let ((x 0)
+	      (ctr -1))
+	  (map
+	   (lambda (f)
+	     (let ((z 1))
+	       (set! ctr (+ ctr 1))
+	       (case ctr
+		 ((0 1 2 3) (f z))
+		 ((4 5) (f z z))
+		 ((6 7) (values (f (+ 1)) (f (+ 2)))))))
+	   (list
+	    (lambda (i)
+	      (set! x (list i)))
+	    (lambda (i)
+	      (set! x (list i))
+	      (set! x (list (+ i 1))))
+	    (vector 1 2 3)
+	    (list 3 2 1)
+	    (lambda (a b)
+	      (+ a b))
+	    (lambda (a b)
+	      (+ a b)
+	      (+ a b a))
+	    (lambda (a)
+	      (if (< a 2) a (+ (fib (- a 1)) (fib (- a 2)))))
+	    (lambda (a)
+	      (if (zero? a) a (list a))
+	      (list (+ a 10)))
+	    ))))
+      '((1) (2) 2 2 2 3 1 1 (11) (12)))
+;;; more along the same lines
+(test (let () (define (f2 a) (+ a 1)) (define (f1 a) (f2 a)) (define (f2 a) (- a)) (f1 12)) -12)
+(test (let () (define (f2 a) (+ a 1)) (define (f1 a) (f2 a 1)) (define (f2 a b) (- a b)) (f1 12)) 11)
+(test (let () (define (f2 a) (+ a 1)) (define (f1 a) (f2 a)) (define (f2 a) (- a 1)) (f1 12)) 11)
+
+(test (let () (define* (f2 a) (+ a 1)) (define (f1 a) (f2 a)) (define* (f2 a) (- a)) (f1 12)) -12)
+(test (let () (define* (f2 a) (+ a 1)) (define (f1 a) (f2 a 1)) (define* (f2 a b) (- a b)) (f1 12)) 11)
+(test (let () (define* (f2 a) (+ a 1)) (define (f1 a) (f2 a)) (define* (f2 a) (- a 1)) (f1 12)) 11)
+
+;;; (test (map symbol->value (let ((lst (list 'integer? 'boolean?))) (set-cdr! (cdr lst) lst) lst)) (list integer?))
+;;; I think this depends on when the list iterator notices the cycle
+
+(let () (define (f0) (for-each (lambda (x y) (display x)) (list 1 2 3) (list 4 5 6))) (test (with-output-to-string f0) "123"))
+(let () (define (f1) (for-each (lambda (x y) (display x)) (vector 1 2 3) (vector 4 5 6))) (test (with-output-to-string f1) "123"))
+(let () (define (f2) (for-each (lambda (x y) (display x)) "123" "456")) (test (with-output-to-string f2) "123"))
+(let () (define (f01) (for-each (lambda (x y) (display y)) (list 1 2 3) (list 4 5 6))) (test (with-output-to-string f01) "456"))
+(let () (define (f11) (for-each (lambda (x y) (display y)) (vector 1 2 3) (vector 4 5 6))) (test (with-output-to-string f11) "456"))
+(let () (define (f21) (for-each (lambda (x y) (display y)) "123" "456")) (test (with-output-to-string f21) "456"))
+(let () (define (f02) (map (lambda (x y) (+ x y)) (list 1 2 3) (list 4 5 6))) (test (f02) (list 5 7 9)))
+(let () (define (f12) (map (lambda (x y) (+ x y)) (vector 1 2 3) (vector 4 5 6))) (test (f12) (list 5 7 9)))
+(let () (define (f22) (map (lambda (x y) (cons x y)) "123" "456")) (test (f22) '((#\1 . #\4) (#\2 . #\5) (#\3 . #\6))))
+(let () (define (f03) (map (lambda (x y) (+ x y)) (list 1 2 3) (vector 4 5 6))) (test (f03) '(5 7 9)))
+(let () (define (f13) (map (lambda (x y) (+ x y)) (vector 1 2 3) (list 4 5 6))) (test (f13) '(5 7 9)))
+(let () (define (f23) (map (lambda (x y) (cons x y)) "123" (list 4 5 6))) (test (f23) '((#\1 . 4) (#\2 . 5) (#\3 . 6))))
+
+#|
+;;; this is from the r6rs comment site
+(let ((resume #f)
+       (results ()))
+   (set! results
+         (cons (map (lambda (x)
+                      (call/cc (lambda (k)
+                                 (if (not resume) (set! resume k))
+                                 0)))
+                    '(#f #f))
+               results ))
+   (display results) (newline)
+   (if resume
+       (let ((resume* resume))
+         (set! resume #f)
+         (resume* 1))))
+
+With a careful implementation of MAP, a new list is returned every
+time, so that the displayed results are
+
+   ((0 0))
+   ((1 0) (0 0))
+   ((1 1) (1 0) (0 0))
+
+in s7:
+((0 0))
+((1 0) (0 0))
+((0 . #1=(1 1)) #1# (0 0))
+
+|#
+
+;; from Doug Hoyte, Let Over Lambda
+(let ()
+  (define (batcher n)
+    (let* ((network ())
+	   (tee (ceiling (log n 2)))
+	   (p (ash 1 (- tee 1))))
+      (do ()
+	  ((= p 0) (reverse network))
+	(let ((q (ash 1 (- tee 1)))
+	      (r 0)
+	      (d p))
+	  (do ()
+	      ((= d 0))
+	    (do ((i 0 (+ i 1)))
+		((= i (- n d)))
+	      (if (= (logand i p) r)
+		  (set! network (cons (list i (+ i d)) network))))
+	    (set! d (- q p))
+	    (set! q (ash q -1))
+	    (set! r p)))
+	(set! p (ash p -1)))))
+
+  (define-macro (sortf comparator . places)
+    (let ((tmp (gensym))
+	  (net (batcher (length places))))
+      `(begin
+	 ,@(map (lambda (a b)
+		  `(if (,comparator ,a ,b) ; we're ignoring the fancy CL getf|setf business
+		       (let ((,tmp ,a))    ;   I suppose if it's a list, get setter?
+			 (set! ,a ,b)
+			 (set! ,b ,tmp))))
+		(map (lambda (ab) (places (car ab))) net)
+		(map (lambda (ab) (places (cadr ab))) net)))))
+
+  (test (let ((a 1) (b 3) (c 0))
+	  (sortf > a b c)
+	  (list a b c))
+	'(0 1 3))
+  (test (let ((a 1) (b 3) (c 0))
+	  (sortf < a b c)
+	  (list a b c))
+	'(3 1 0))
+  (test (let ((v #(1 3 2)))
+	  (sortf > (v 0) (v 1) (v 2))
+	  v)
+	#(1 2 3)))
+
+;;; fftf?
+
+(let ()
+  (define-macro (shiftf . places)
+    (let ((tmp (gensym)))
+      `(let ((,tmp ,(car places)))
+	 ,@(map (lambda (a b)
+		  `(set! ,a ,b))
+		places
+		(cdr places))
+	 ,tmp)))
+
+  (define-macro (rotatef . places)
+    (let ((tmp (gensym))
+	  (last (car (list-tail places (- (length places) 1)))))
+      `(let ((,tmp ,(car places)))
+	 ,@(map (lambda (a b)
+		  `(set! ,a ,b))
+		places
+		(cdr places))
+	 (set! ,last ,tmp))))
+
+  (test (let ((a 1) (b 2) (c 3))
+	  (rotatef a b c)
+	  (list a b c))
+	'(2 3 1))
+  (test (let ((a 1) (b 2) (c 3))
+	  (rotatef a b c)
+	  (rotatef a b c)
+	  (list a b c))
+	'(3 1 2))
+  (test (let ((v #(1 3 2)))
+	  (rotatef (v 0) (v 1) (v 2))
+	  v)
+	#(3 2 1))
+
+  (test (let ((a 1) (b 2) (c 3))
+	  (let ((d (shiftf a b c (+ 3 2))))
+	    (list a b c d)))
+	'(2 3 5 1))
+
+  (test (let ((a 1) (b 2) (c 3))
+	  (let ((d (shiftf a b c (shiftf a b c))))
+	    (list a b c d)))
+	'(3 3 2 1))
+  ;; this expands to:
+  ;; (let ((a 1) (b 2) (c 3))
+  ;;   (let (({gensym}-22 a))
+  ;;     (set! a b)
+  ;;     (set! b c)
+  ;;     (set! c (let (({gensym}-23 a))
+  ;; 	         (set! a b)
+  ;; 	         (set! b c)
+  ;; 	         (set! c (* 2 3))
+  ;; 	         {gensym}-23))
+  ;;     (list a b c {gensym}-22)))
+
+  (test (let ((v #(1 3 2)))
+	  (let ((d (shiftf (v 0) (v 1) (v 2) (* 4 3))))
+	    (list d v)))
+	'(1 #(3 2 12))))
+
+
+;;; --------------------------------------------------------------------------------
+;;; iterate
+;;; make-iterator
+;;; iterator?
+;;; iterator-sequence
+;;; iterator-at-end?
+;;; --------------------------------------------------------------------------------
+
+(test (iterate) 'error)
+(test (iterator?) 'error)
+(test (iterator-sequence) 'error)
+(test (iterator-at-end?) 'error)
+(test (make-iterator) 'error)
+(test (make-iterator "hi" "ho") 'error)
+(test (iterator? "hi" "ho") 'error)
+(test (iterator-sequence "hi" "ho") 'error)
+(test (iterator-at-end? "hi" "ho") 'error)
+(test (iterate "hi" "ho") 'error)
+(test (make-iterator (hash-table 'a 1) (immutable! (cons 0 0))) 'error)
+(test (make-iterator (inlet 'a 1) (immutable! (cons 0 0))) 'error)
+(test (make-iterator '(1 2 3) #(0)) 'error)
+(test (make-iterator (let ((+iterator+ #t)) (lambda (iter) 1))) 'error)
+(test (iterator? (make-iterator (let ((+iterator+ #t)) (lambda iter 1)))) #t)
+(test (make-iterator (curlet) 1) 'error)
+(test (iterator? 1 2) 'error)
+
+;; rogue iterator:
+;(with-let (let ((+iterator+ #t)) (curlet))
+;  (concatenate (make-int-vector '(2 3) 1) (lambda* (a . b) (cons a b)))) ; this becomes an iterator but only in with-let
+;heap has grown past (*s7* 'max-heap-size): 4194304 > 6553600
+;    (#<lambda* (a . b)>)
+;    t718.scm, line 20, position: 490
+; sequences->list: (#<lambda* (a . b)>)
+; sequences->list: (apply append (map (lamb... ; sequences: (#<lambda* (a . b)>)
+; concatenate: (apply type (apply sequences... ; type: #i2d((1 1 1) (1 ...))
+
+(for-each
+ (lambda (arg)
+   (if (iterator? arg)
+       (format #t ";~A: (iterator? ~A) -> #t?~%" (port-line-number) arg)))
+ (list "hi" '(1 2) (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi (if #f #f) #<eof> #<undefined>))
+
+(for-each
+ (lambda (arg)
+   (test (iterate arg) 'error)
+   (test (iterator-sequence arg) 'error)
+   (test (iterator-at-end? arg) 'error))
+ (list "hi" '(1 2) (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi (if #f #f) #<eof> #<undefined>))
+
+(for-each
+ (lambda (arg)
+   (test (make-iterator arg) 'error)
+   (test (make-iterator #(1 2) arg) 'error))
+ (list 1 'a-symbol quasiquote macroexpand 3.14 3/4 1.0+1.0i #\f :hi (if #f #f) #<eof> #<undefined>))
+
+(let ((str "12345"))
+  (let ((s1 (make-iterator str)))
+    (test (iterator? s1) #t)
+    (test (iterator? str) #f)
+    (test (make-iterator s1) 'error)
+    (test (iterator-sequence s1) str)
+    (test (iterator-at-end? s1) #f)
+    (test (iterate s1) #\1)
+    (test (iterate s1 s1) 'error)
+    (test (object->string s1) "#<iterator: string>")
+    (test (s1) #\2)
+    (test (list (s1) (s1) (s1)) (list #\3 #\4 #\5))
+    (test (s1) #<eof>)
+    (test (iterator-at-end? s1) #t)
+    (let ((s2 (copy s1)))
+      (test (equal? s1 s2) #t)
+      (test (equivalent? s1 s2) #t)
+      (test (eq? s1 s2) #f)
+      (test (eqv? s1 s2) #f))))
+
+(let ((str ""))
+  (let ((s1 (make-iterator str)))
+    (let ((s2 (copy s1)))
+      (test (equal? s1 s2) #t)
+      (test (iterator? s1) #t)
+      (test (iterator-sequence s1) str)
+      (test (s1) #<eof>)
+      (test (iterator-at-end? s1) #t)
+      (test (iterator? s1) #t))))
+
+(let ((s1 (make-iterator "1234")))
+  (test (iterator? s1) #t)
+  (test (s1) #\1))
+
+(let ((str (vector #\1 #\2 #\3 #\4 #\5)))
+  (let ((s1 (make-iterator str)))
+    (let ((s2 (copy s1)))
+      (test (equal? s1 s2) #t)
+      (test (iterator? s1) #t)
+      (test (iterator? str) #f)
+      (test (make-iterator s1) 'error)
+      (test (iterator-sequence s1) str)
+      (test (iterate s1) #\1)
+      (test (object->string s1) "#<iterator: vector>")
+      (test (equal? s1 s2) #f)
+      (s2)
+      (test (equal? s1 s2) #t)
+      (test (iterate s1 s1) 'error)
+      (test (s1) #\2)
+      (test (list (s1) (s1) (s1)) (list #\3 #\4 #\5))
+      (test (s1) #<eof>))))
+
+(let ((str #()))
+  (let ((s1 (make-iterator str)))
+    (test (iterator? s1) #t)
+    (test (iterator-sequence s1) str)
+    (test (s1) #<eof>)
+    (test (iterator-at-end? s1) #t)
+    (test (iterator? s1) #t)))
+
+(let ((lst ())
+      (iter (make-iterator '(1 2 3 #<eof> 4 5 6))))
+  (do ((val (iterate iter) (iterate iter)))
+      ((iterator-at-end? iter)
+       (test (reverse lst) '(1 2 3 #<eof> 4 5 6)))
+    (set! lst (cons val lst))))
+
+(let ((str #2d((1 2) (3 4))))
+  (let ((s1 (make-iterator str)))
+    (test (iterator-at-end? s1) #f)
+    (test (s1) 1)
+    (test (iterate s1) 2)
+    (test (s1) 3)))
+
+
+(let ((str (float-vector 1.0 2.0 3.0 4.0)))
+  (let ((s1 (make-iterator str)))
+    (test (iterator? s1) #t)
+    (test (iterator? str) #f)
+    (test (iterator-sequence s1) str)
+    (test (iterate s1) 1.0)
+    (test (s1) 2.0)
+    (test (list (s1) (s1)) (list 3.0 4.0))
+    (test (s1) #<eof>)))
+
+(let ((str (float-vector)))
+  (let ((s1 (make-iterator str)))
+    (test (iterator? s1) #t)
+    (test (iterator-sequence s1) str)
+    (test (s1) #<eof>)
+    (test (iterator-at-end? s1) #t)
+    (test (iterator? s1) #t)))
+
+(let ((str (make-int-vector 4 0)))
+  (do ((i 1 (+ i 1))) ((= i 4)) (set! (str i) i))
+  (let ((s1 (make-iterator str)))
+    (test (iterator? s1) #t)
+    (test (iterator-sequence s1) str)
+    (test (iterate s1) 0)
+    (test (s1) 1)
+    (test (list (s1) (s1) (s1)) (list 2 3 #<eof>))
+    (test (s1) #<eof>)))
+
+(let ((str (list 0 1 2 3)))
+  (let ((s1 (make-iterator str)))
+    (test (iterator? s1) #t)
+    (test (iterator-sequence s1) str)
+    (test (iterate s1) 0)
+    (test (s1) 1)
+    (test (s1 0) 'error)
+    (test (iterate s1 0) 'error)
+    (test (list (s1) (s1) (s1)) (list 2 3 #<eof>))
+    (test (s1) #<eof>)))
+
+(let ((str ()))
+  (test (iterator? (make-iterator str)) #t) ; changed 21-Feb-18
+  (test (length (iterator-sequence (make-iterator str))) 0))
+
+(let ((a1 (make-iterator ()))
+      (a2 (make-iterator ()))
+      (a3 (make-iterator '(1))))
+  (test (equal? a1 a2) #t)
+  (test (equivalent? a1 a2) #t)
+  (test (equal? a1 a3) #f)
+  (test (equivalent? a1 a3) #f)
+  (iterate a3)
+  (test (equal? a1 a3) #f)
+  (test (equivalent? a1 a3) #f)
+  (test (iterate a1) #<eof>))
+
+(test (map values (make-iterator ())) ()) ; infinite loop if iter_ok not cleared in make-iterator
+
+(test (equal? (make-iterator (hash-table)) (make-iterator (hash-table))) #t)
+(test (equal? (make-iterator (inlet)) (make-iterator (inlet))) #t)
+
+(when with-block
+  (let ((a1 (make-iterator (block)))
+	(a2 (make-iterator (block)))
+	(a3 (make-iterator (block 1.0))))
+    (test (equal? a1 a2) #t)
+    (test (equal? a1 a3) #f)
+    (test (a1) #<eof>)
+    (test (a3) 1.0)
+    (test (a3) #<eof>))
+
+  (let ((a1 (make-iterator (block 1 2 3)))
+	(a2 (make-iterator (block 1 2 3))))
+    (test (equal? a1 a2) #t)
+    (test (a1) 1.0)
+    (test (equal? a1 a2) #f)
+    (a2)
+    (test (equal? a1 a2) #t)))
+
+(let ((str '((1 2) (3 4))))
+  (let ((s1 (make-iterator str)))
+    (test (s1) '(1 2))
+    (test (iterate s1) '(3 4))
+    (test (s1) #<eof>)))
+
+(let ((str (list 0 1)))
+  (set! (cdr (cdr str)) str)
+  (let ((s1 (make-iterator str)))
+    (test (iterator? s1) #t)
+    (test (iterator-sequence s1) str)
+    (test (iterate s1) 0)
+    (test (s1) 1)
+    (test (s1) #<eof>)))
+
+(let ((p (cons #f #f))
+      (h (hash-table 'a 1 'b 2)))
+  (let ((iter (make-iterator h p)))
+    (let ((v (iter)))
+      (test (pair? v) #t)
+      (test (eq? v p) #t)
+      (test (pair? (memq (car v) '(a b))) #t)
+      (set! v (iter))
+      (test (pair? v) #t)
+      (test (eq? v p) #t)
+      (test (pair? (memq (car v) '(a b))) #t))))
+
+;; hash-table and let dealt with elsewhere
+
+(test (length (make-iterator (list 1 2 3))) 3)
+(test (length (make-iterator "123")) 3)
+(test (length (make-iterator #(1 2 3))) 3)
+(test (length (make-iterator (int-vector 1 2 3))) 3)
+(test (length (make-iterator (float-vector 1 2 3))) 3)
+(test (length (make-iterator (inlet 'a 1 'b 2))) 2)
+(test (length (make-iterator (hash-table 'a 1 'b 2))) 8)
+
+(when with-block
+  (test (length (make-iterator (block 1 2 3))) 3)
+  (let ((b (block 0.0 1.0 2.0)))
+    (let ((b1 (make-iterator b)))
+      (test (iterator? b1) #t)
+      ;(test (iterator-sequence b1) b) ; this is now a function
+      (test (b1) 0.0)
+      (test (iterate b1) 1.0)
+      (test (list (b1) (b1)) '(2.0 #<eof>)))))
+
+(let ((c1 (let ((+iterator+ #t) (a 0)) (lambda () (set! a (+ a 1))))))
+  (let ((iter (make-iterator c1)))
+    (test (iterate iter) 1)
+    (test (iterator? c1) #f)
+    (test (iterator? iter) #t)
+    (test (eq? (iterator-sequence iter) c1) #t)))
+
+(let ()
+  (define c1 #f)
+  (let ((length (lambda (x) 3))
+	(+iterator+ #t)
+	(x 0))
+    (set! c1 (openlet (lambda () (let ((res (* x 2))) (set! x (+ x 1)) res)))))
+  (let ((c2 (make-iterator c1)))
+    (test (iterator? c2) #t)
+    (test (iterator-sequence c2) c1)
+    (test (c2) 0)
+    (test (c2) 2)
+    (test (c2) 4)))
+
+(let ((lst (list 1))) (set-cdr! lst lst) (let ((i (make-iterator lst))) (test (map values i) '(1))))
+(let ((lst (list 1 2))) (set-cdr! (cdr lst) lst) (let ((i (make-iterator lst))) (test (map values i) '(1 2))))
+(let ((lst (list 1 2 3))) (set-cdr! (cddr lst) lst) (let ((i (make-iterator lst))) (test (> (length (map values i)) 2) #t))) ; '(1 2 3) ideally
+(let ((lst (list 1 2 3 4))) (set-cdr! (cdddr lst) lst) (let ((i (make-iterator lst))) (test (> (length (map values i)) 3) #t))) ; '(1 2 3 4)?
+
+(let ((a 1))
+  (let ((lti (make-iterator (curlet))))
+    (test (cdr (lti)) 1)
+    (test (lti) #<eof>)
+    (test (lti) #<eof>)))
+
+(let () (let ((lti (make-iterator (curlet)))) (test (lti) #<eof>)))
+(let ((lti (make-iterator (inlet 'a 1 'b 2))))
+  ;(test (length lti) #f)
+  (test (reverse lti) 'error)
+  (test (iterator? lti) #t)
+  (test (lti) '(a . 1))
+  (test (lti) '(b . 2))
+  (test (lti) #<eof>)
+  (test (set! (lti) 32) 'error))
+
+(let ((lti (make-iterator (rootlet))))
+  (test (defined? (car (lti))) #t)
+  (test (let ((b (lti))) (equal? (symbol->value (car b)) (cdr b))) #t))
+
+;;; test keyword-as-let-ref-arg -- this is an experiment, see let_ref_1 and let_set_1
+(let ((e (inlet :name 'hi)))
+  (test (e :name) 'hi)
+  (set! (e :name) 'ho)
+  (test (e :name) 'ho)
+  (test (let-ref e :name) 'ho)
+  (let-set! e :name 'ha)
+  (test (e 'name) 'ha))
+(test ((rootlet) :abs) abs)
+(test ((rootlet) :allow-other-keys) #<undefined>)
+;;; but this only works directly, not in with-let:
+(test (with-let (inlet :x 1 :y 2) (+ :x :y)) 'error) ; + argument 1, :x, is a symbol but should be a number
+;;; but that's actually parallel to (+ 'x 'y) so I think it's not a show-stopper
+(let ((y 12))
+  (test ((curlet) :y) 12)
+  (define f1 (let ((x 32)) (lambda (a) (+ a x))))
+  (test ((funclet f1) :x) 32))
+(let ((e (inlet :aaa 1)))
+  (varlet e :b 2)
+  (test (e 'b) 2)
+  (cutlet e :aaa)
+  (test (e 'aaa) #<undefined>))
+
+(let ((e (inlet 'a 1 'b 2 'c 3 'd 4)))
+  (test (object->string e) "(inlet 'a 1 'b 2 'c 3 'd 4)")
+  (let-temporarily (((*s7* 'print-length) 2))
+    (test (object->string e) "(inlet 'a 1 'b 2 ...)")
+    (set! (*s7* 'print-length) 4)
+    (test (object->string e) "(inlet 'a 1 'b 2 'c 3 'd 4)")
+    (set! (*s7* 'print-length) 3)
+    (test (object->string e) "(inlet 'a 1 'b 2 'c 3 ...)")))
+
+(test (format #f "~{~{[~A ~A]~}~}"
+	      (make-iterator
+	       (let ((lst '((a . 1) (b . 2) (c . 2)))
+		     (+iterator+ #t))
+		 (lambda ()
+		   (if (pair? lst)
+		       (let ((res (list (caar lst) (cdar lst))))
+			 (set! lst (cdr lst))
+			 res)
+		       #<eof>)))))
+      "[a 1][b 2][c 2]")
+(test (object->string (make-iterator (let ((lst '((a . 1) (b . 2) (c . 2)))
+			      (+iterator+ #t))
+			  (lambda ()
+			    (if (pair? lst)
+				(let ((res (list (caar lst) (cdar lst))))
+				  (set! lst (cdr lst)) res)
+				#<eof>)))))
+      "#<iterator: function>")
+(when (zero? (*s7* 'debug))
+  (test (object->string (make-iterator (let ((lst '((a . 1) (b . 2) (c . 2)))
+			      (+iterator+ #t))
+			  (lambda ()
+			    (if (pair? lst)
+				(let ((res (list (caar lst) (cdar lst))))
+				  (set! lst (cdr lst)) res)
+				#<eof>)))) :readable)
+      "(make-iterator (let ((+iterator+ #t) ) (lambda () (if (pair? lst) (let ((res (list (caar lst) (cdar lst)))) (set! lst (cdr lst)) res) #<eof>))))"))
+(let ((iterf (let ((lst '((a . 1) (b . 2) (c . 2)))
+		   (+iterator+ #t))
+	       (lambda () (if (pair? lst) (let ((res (list (caar lst) (cdar lst)))) (set! lst (cdr lst)) res) #<eof>)))))
+  (test (equivalent? (make-iterator iterf) (make-iterator iterf)) #t))
+
+(let ((iterf (let ((lst '((a . 1) (b . 2) (c . 2))))
+	       (lambda () (if (pair? lst) (let ((res (list (caar lst) (cdar lst)))) (set! lst (cdr lst)) res) #<eof>)))))
+  (test (make-iterator iterf) 'error))
+
+(let ((iterf (let ((lst '((a . 1) (b . 2) (c . 2)))
+		   (+iterator+ #f))
+	       (lambda () (if (pair? lst) (let ((res (list (caar lst) (cdar lst)))) (set! lst (cdr lst)) res) #<eof>)))))
+  (test (make-iterator iterf) 'error))
+
+(let ()
+  (define (make-diagonal-iterator matrix)
+    (if (or (= (vector-rank matrix) 1)
+	    (< (length matrix) 2))
+	(make-iterator matrix)
+	(make-iterator (let ((inds (vector-rank matrix))
+			     (len (apply min (vector-dimensions matrix))))
+			 (let ((length (lambda (obj) len))
+			       (+iterator+ #t)
+			       (pos 0))
+			   (openlet
+			    (lambda ()
+			      (if (>= pos len)
+				  #<eof>
+				  (let ((res (apply matrix (make-list inds pos))))
+				    (set! pos (+ pos 1))
+				    res)))))))))
+
+  (define v #2d((1 2 3 4) (5 6 7 8)))
+
+  (let ((iv (make-diagonal-iterator v)))
+    (let ((vals (map values iv)))
+      (test vals '(1 6)))))
+
+(test (let ((iter (make-iterator "123"))) (map values iter)) '(#\1 #\2 #\3))
+(test (let ((iter (make-iterator '(1 2 3))) (str "456") (vals ()))
+	(for-each (lambda (x y) (set! vals (cons (cons y x) vals))) iter str) vals)
+      '((#\6 . 3) (#\5 . 2) (#\4 . 1)))
+
+(let ()
+  (define* (make-full-let-iterator lt (stop (rootlet)))
+    (if (eq? stop lt)
+	(make-iterator #())
+	(let ((iter (make-iterator lt)))
+	  (if (eq? stop (outlet lt))
+	      iter
+	      (letrec ((iterloop
+			(let ((+iterator+ #t))
+			  (lambda ()
+			    (let ((result (iter)))
+			      (if (and (eof-object? result)
+				       (iterator-at-end? iter))
+				  (if (eq? stop (outlet (iterator-sequence iter)))
+				      result
+				      (begin
+					(set! iter (make-iterator (outlet (iterator-sequence iter))))
+					(iterloop)))
+				  (if (not (char=? ((symbol->string (car result)) 0) #\_))
+				      result
+				      (iterloop))))))))
+		(make-iterator iterloop))))))
+  (let ((stop #f))
+    (set! stop (curlet))
+    (test (let ((a 1)) (map values (make-full-let-iterator (curlet) stop))) '((a . 1))))
+  (let ((stop #f))
+    (set! stop (curlet))
+    (test (let ((b 2)) (let ((a 1)) (map values (make-full-let-iterator (curlet) stop)))) '((a . 1) (b . 2))))
+  (let ((stop #f))
+    (set! stop (curlet))
+    (test (let ((b 2) (c 3)) (let () (let ((a 1)) (map values (make-full-let-iterator (curlet) stop))))) '((a . 1) (b . 2) (c . 3))))
+  )
+
+(let ()
+  (define (make-range lo hi)
+    (make-iterator
+     (let ((+iterator+ #t)
+	   (now lo))
+       (lambda ()
+	 (if (> now hi)
+	     #<eof>
+	     (let ((result now))
+	       (set! now (+ now 1))
+	       result))))))
+  (test (map values (make-range 4 8)) '(4 5 6 7 8)))
+
+(let ()
+  (define (make-input-iterator port)
+    (make-iterator (let ((+iterator+ #t)) (lambda () (read-char port)))))
+
+  (test (let ((p (open-input-string "12345")))
+	  (let ((ip (make-input-iterator p)))
+	    (let ((res (map values ip)))
+	      (close-input-port p)
+	      res)))
+	'(#\1 #\2 #\3 #\4 #\5)))
+
+(let ()
+  (define (make-input-iterator port)
+    (make-iterator (let ((+iterator+ #t)) (define-macro (_m_) `(read-char ,port)))))
+
+  (test (let ((p (open-input-string "12345")))
+	  (let ((ip (make-input-iterator p)))
+	    (let ((res (map values ip)))
+	      (close-input-port p)
+	      res)))
+	'(#\1 #\2 #\3 #\4 #\5)))
+
+(let ((iter (make-iterator (let ((+iterator+ #t)
+				 (pos 0))
+			     (lambda ()
+			       (if (< pos 3)
+				   (let ((p pos))
+				     (set! pos (+ pos 1))
+				     (list p (* p 2)))
+				   #<eof>))))))
+  (test (map values iter) '((0 0) (1 2) (2 4))))
+
+(let ()
+  (define (make-row-iterator v)
+    (make-iterator (let ((+iterator+ #t)
+			 (col 0))
+		     (lambda ()
+		       (if (< col (car (vector-dimensions v)))
+			   (let ((c col))
+			     (set! col (+ col 1))
+			     (subvector v (* c (cadr (vector-dimensions v))) (* (+ c 1) (cadr (vector-dimensions v)))))
+			   #<eof>)))))
+
+  (let ((v #2d((0 1 2) (4 5 6))))
+    (let ((iter (make-row-iterator v)))
+      (test (map values iter) '(#(0 1 2) #(4 5 6))))))
+
+(let ()
+  (define (make-semi-complete-iterator obj)
+    (make-iterator
+     (let ((iters ())
+	   (iter (make-iterator obj)))
+       (define (iterloop)
+	 (let ((result (iter)))
+	   (if (length result) ; i.e. result is a sequence
+	       (begin
+		 (set! iters (cons iter iters))
+		 (set! iter (make-iterator result))
+		 result)       ; this returns the sequence before we descend into it
+			       ;   we could also call iterloop here to skip that step
+	       (if (eof-object? result)
+		   (if (null? iters)
+		       result  ; return #<eof>
+		       (begin
+			 (set! iter (car iters))
+			 (set! iters (cdr iters))
+			 (iterloop)))
+		   result))))
+       (let ((+iterator+ #t))
+	 (lambda ()
+	   (iterloop))))))
+
+  (test (let ((v '(1 2 (4 5)))) (let ((i (make-semi-complete-iterator v))) (map values i))) '(1 2 (4 5) 4 5))
+  (test (let ((v #(1 2 (4 5)))) (let ((i (make-semi-complete-iterator v))) (map values i))) '(1 2 (4 5) 4 5))
+  (test (let ((v '((1 2 (4 5))))) (let ((i (make-semi-complete-iterator v))) (map values i))) '((1 2 (4 5)) 1 2 (4 5) 4 5))
+  (test (let ((v '(1 2 #(4 5)))) (let ((i (make-semi-complete-iterator v))) (map values i))) '(1 2 #(4 5) 4 5))
+  (test (let ((v '(1 2 #(4 5) ("67")))) (let ((i (make-semi-complete-iterator v))) (map values i))) '(1 2 #(4 5) 4 5 ("67") "67" #\6 #\7)))
+
+(let ()
+  (define (make-settable-iterator obj)
+    (make-iterator (let ((+iterator+ #t)
+			 (pos 0))
+		     (dilambda (lambda ()
+				 (let ((res (obj pos)))
+				   (set! pos (+ pos 1))
+				   res))
+			       (lambda (val)
+				 (set! (obj pos) val))))))
+  (test (procedure? (setter (make-settable-iterator (vector 1 2 3)))) #t)
+  (let ((v (vector 1 2 3)))
+    (let ((iter (make-settable-iterator v)))
+      (set! (iter) 32)
+      (test v #(32 2 3))))
+
+  (let ((v (vector 1 2 3)))
+    (let ((iter (make-settable-iterator v)))
+      (test (catch #t (lambda () (set! (iter 0) 32)) (lambda (type info) (apply format #f info)))
+            "#<iterator: function> (an iterator): too many arguments: ((iter 0) 32)")))
+
+  (let ((v (vector 1 2 3)))
+    (let ((iter (make-settable-iterator v)))
+      (set! (iter) (iter))
+      (test (iter) 1)))
+
+  (let ((v "asdf"))
+    (let ((iter (make-settable-iterator v)))
+      (test (catch #t (lambda () (set! (iter) 32)) (lambda (type info) (apply format #f info)))
+            "string-set!: value must be a character: (set! (obj pos) val)")))
+
+  (let ((v "asdf"))
+    (let ((iter (make-settable-iterator v)))
+      (set! (iter) #\z)
+      (test v "zsdf")))
+
+  (let ((v (list 0)))
+    (let ((iter (make-settable-iterator v)))
+      (iter)
+      (test (catch #t (lambda () (set! (iter) #\z)) (lambda (type info) (apply format #f info)))
+            "list-set! second argument, 1, is out of range (it is too large)")
+      ;; should the error say "iterator is at eof?" or is this for the iterator function above?
+      v))
+
+  (let ((v (immutable! "asdf")))
+    (let ((iter (make-settable-iterator v)))
+      (test (catch #t (lambda () (set! (iter) #\z)) (lambda (type info) (apply format #f info)))
+            "can't string-set! \"asdf\" (it is immutable)")))
+
+  (let ((e (inlet :v (vector 1 2))))
+    (set! (with-let e (with-let (curlet) (v 0))) 32)
+    (test (e 'v) #(32 2)))
+
+  (let ((e (inlet :v (vector 1 2) :z 0)))
+    (set! (with-let e (v (with-let (curlet) z))) 12)
+    (test (e 'v) #(12 2))))
+
+(let ()
+  (define (make-settable-iterator1 obj)
+    (make-iterator (let ((+iterator+ #t)
+			 (pos 0))
+		     (dilambda (lambda ()
+				 (let ((res (obj pos)))
+				   (set! pos (+ pos 1))
+				   res))
+			       (macro (val)
+				 `(set! (,obj ,pos) ,val))))))
+
+  (let ((v (vector 1 2 3)))
+    (let ((iter (make-settable-iterator1 v)))
+      (set! (iter) 32)
+      (test (iter) 32)
+      (test v #(32 2 3)))))
+
+(let ()
+  (define (make-circular-iterator obj)
+    (let ((iter (make-iterator obj)))
+      (make-iterator
+       (let ((+iterator+ #t))
+	 (lambda ()
+	   (let ((result (iter)))
+	     (if (eof-object? result)
+		 ((set! iter (make-iterator obj)))
+		 result)))))))
+
+  (let ((iter (make-circular-iterator '(1 2 3)))
+	(lst ()))
+    (do ((i 0 (+ i 1)))
+	((= i 10)
+	 (test (reverse lst) '(1 2 3 1 2 3 1 2 3 1)))
+      (set! lst (cons (iter) lst))))
+
+  (let ((iter (make-circular-iterator (hash-table :a 1 :b 2)))
+	(lst ()))
+    (do ((i 0 (+ i 1)))
+	((= i 4)
+	 (test (let ((r (reverse lst)))
+		 (or (equal? r '((:a . 1) (:b . 2) (:a . 1) (:b . 2)))
+		     (equal? r '((:b . 2) (:a . 1) (:b . 2) (:a . 1)))))
+	       #t))
+      (set! lst (cons (iter) lst)))))
+
+
+(test (setter (make-iterator "123")) #f)
+(test (setter (make-iterator #(1))) #f)
+(test (setter (make-iterator '(1))) #f)
+(test (setter (make-iterator (float-vector pi))) #f)
+
+(test (copy (make-iterator '(1 2 3)) (vector 1)) 'error)
+
+(let ()
+  (define (make-file-iterator file)
+    ;; reads a text file, returning one word at a time
+    (let* ((port (open-input-file file))
+	   (line (read-line port #t))
+	   (pos -1)
+	   (new-pos 0)
+	   (eol (string #\space #\tab #\newline #\linefeed)))
+
+      (define (next-word)
+	(set! pos (char-position eol line (+ pos 1)))
+	(if (not pos)
+	    (begin
+	      (set! pos -1)
+              (set! new-pos 0)
+	      (set! line (read-line port #t))
+	      (if (eof-object? line)
+		  (begin
+		    (close-input-port port)
+		    line)
+		  (next-word)))
+	    (if (= new-pos pos)
+		(next-word)
+		(let ((start (do ((k new-pos (+ k 1)))
+				 ((or (= k pos)
+				      (char-alphabetic? (string-ref line k))
+				      (char-numeric? (string-ref line k)))
+				  k))))
+		  (if (< start pos)
+		      (let ((end (do ((k (- pos 1) (- k 1)))
+				     ((or (= k start)
+					  (char-alphabetic? (string-ref line k))
+					  (char-numeric? (string-ref line k)))
+				      (+ k 1)))))
+			(set! new-pos (+ pos 1))
+			(if (> end start)
+			    (substring line start end)
+			    (next-word)))
+		      (next-word))))))
+
+      (make-iterator
+       (let ((+iterator+ #t))
+	 (lambda* (p)
+	   (if (eq? p 'eof)
+	       (begin
+		 (close-input-port port)
+		 #<eof>)
+	       (next-word)))))))
+
+  (define iter (make-file-iterator "s7.c"))
+  (test (iter) "s7")
+  (test (iter) "a")
+  (test (iter) "Scheme")
+  (test (iter) "interpreter")
+  (test ((iterator-sequence iter) 'eof) #<eof>)
+  )
+
+(let ((olt (openlet (inlet 'make-iterator (lambda args (#_make-iterator "123"))))))
+  (let ((iter1 (make-iterator olt)))
+    (test (object->string iter1) "#<iterator: string>")
+    (test (object->string iter1 :readable) "(make-iterator \"123\")"))
+  (let ((iter2 (make-iterator olt (cons 1 2))))
+    (test (object->string iter2) "#<iterator: string>")
+    (test (object->string iter2 :readable) "(make-iterator \"123\")")))
+
+(let () ; catch_all_function
+  (define iter (make-iterator
+		(let ((+iterator+ #t))
+		  (lambda ()
+		    (catch #t
+		      (lambda ()
+			(abs 1 2))
+		      (lambda args
+			'error))))))
+  (test (iterate iter) 'error)
+  (let () ; catch #<unused temp11 from t101-18
+    (define (f)
+      (let ((x (map (lambda (a) (iterate iter)) '(0))))
+        (test x '(error))))
+    (f)))
+
+(let () ; catch_1_function
+  (define iter (make-iterator
+		(let ((+iterator+ #t))
+		  (define (fif) (if (< 2 3) (quote . -1)))
+		  (lambda ()
+		    (catch #t fif
+		      (lambda args
+			'error))))))
+  (test (iterate iter) 'error))
+
+(let ()
+  (define !f
+    (make-iterator (let ((+iterator+ #t))
+		     (lambda ()
+		       (eq? (car (catch #t
+				   (lambda ()
+				     (set! ("hi") #\a))
+				   (lambda args args)))
+			    'wrong-number-of-args)))))
+  (iterate !f))
+
+(let ()
+  (define iter (make-iterator
+		(let ((+iterator+ #t))
+		  (lambda ()
+		    (map (lambda (x)
+			   (display x #f)
+			   (display x #f)
+			   (vector->list x))
+			 (list #(1 2) #(3 4)))))))
+  (define (f)
+    (map (lambda (a) (iterate iter)) (list 0 1 2)))
+  (test (f) '(((1 2) (3 4)) ((1 2) (3 4)) ((1 2) (3 4)))))
+
+(let ()
+  (define iter (make-iterator
+		(let ((+iterator+ #t))
+		  (lambda ()
+		    (map (lambda (x)
+			   (vector->list x))
+			 (list #(1 2) #(3 4)))))))
+  (define (f)
+    (map (lambda (a) (iterate iter)) (list 0 1 2)))
+  (test (f) '(((1 2) (3 4)) ((1 2) (3 4)) ((1 2) (3 4)))))
+
+(let ()
+  (define iter (make-iterator
+		(let ((+iterator+ #t))
+		  (lambda ()
+		    (map (lambda (x)
+			   (catch #t
+			     (lambda ()
+			       (vector->list x))
+			     (lambda (t i) 'error)))
+			 (list #(1 2) #\a))))))
+  (define (f)
+    (map (lambda (a) (iterate iter)) (list 0 1 2)))
+  (test (f) '(((1 2) error) ((1 2) error) ((1 2) error))))
+
+(let ()
+  (define iter (make-iterator
+		(let ((+iterator+ #t))
+		  (lambda ()
+		    (map (lambda (x)
+			   (vector->list x))
+			 (list #(1 2) #\a))))))
+  (define (f)
+    (catch #t
+      (lambda ()
+	(map (lambda (a) (iterate iter)) (list 0 1 2)))
+      (lambda (t i) 'error)))
+  (test (f) 'error))
+
+(let ()
+  (define iter (make-iterator
+		(let ((+iterator+ #t))
+		  (lambda ()
+		    (map (lambda (x)
+			   (vector->list x))
+			 (list #(1 2) #(3 4)))))))
+  (test (iterate iter) '((1 2) (3 4))))
+
+(let ()
+  (define iter (make-iterator
+		(let ((+iterator+ #t))
+		  (lambda ()
+		    (map (lambda (x)
+			   (display x #f)
+			   (display x #f)
+			   (vector->list x))
+			 #(#(1 2) #(3 4)))))))
+  (define (f)
+    (map (lambda (a) (iterate iter)) #(-1 -2 -3)))
+  (test (f) '(((1 2) (3 4)) ((1 2) (3 4)) ((1 2) (3 4)))))
+
+(let ()
+  (define iter (make-iterator
+		(let ((+iterator+ #t))
+		  (lambda ()
+		    (map (lambda (x)
+			   (vector->list x))
+			 #(#(1 2) #(3 4)))))))
+  (define (f)
+    (map (lambda (a) (iterate iter)) #(-1 -2 -3)))
+  (test (f) '(((1 2) (3 4)) ((1 2) (3 4)) ((1 2) (3 4)))))
+
+(let ()
+  (define iter (make-iterator
+		(let ((+iterator+ #t))
+		  (lambda ()
+		    (map (lambda (x)
+			   (catch #t
+			     (lambda ()
+			       (string->list x))
+			     (lambda (t i) 'error)))
+			 #(#(1 2) #(3 4)))))))
+  (define (f)
+    (map (lambda (a) (iterate iter)) #(-1 -2 -3)))
+  (test (f) '((error error) (error error) (error error))))
+
+(let ()
+  (define iter (make-iterator
+		(let ((+iterator+ #t))
+		  (lambda ()
+		    (map (lambda (x)
+			   (string->list x))
+			 #(#(1 2) #(3 4)))))))
+  (define (f)
+    (catch #t
+      (lambda ()
+	(map (lambda (a) (iterate iter)) #(-1 -2 -3)))
+      (lambda (t i) 'error)))
+  (test (f) 'error))
+
+(let ()
+  (define iter (make-iterator
+		(let ((+iterator+ #t))
+		  (lambda ()
+		    (map (lambda (x)
+			   (catch #t
+			     (lambda ()
+			       (char->integer x))
+			     (lambda (t i) 'error)))
+			 "1234")))))
+  (define (f)
+    (map (lambda (a) (iterate iter)) "4321"))
+  (test (f) '((49 50 51 52) (49 50 51 52) (49 50 51 52) (49 50 51 52))))
+
+(let ()
+  (define iter (make-iterator
+		(let ((+iterator+ #t))
+		  (lambda ()
+		    (map (lambda (x)
+			   (abs x))
+			 "1234")))))
+  (define (f)
+    (catch #t
+      (lambda ()
+	(map (lambda (a) (iterate iter)) "1234"))
+      (lambda (t i) 'error)))
+  (test (f) 'error))
+
+(let ()
+  (define iter (make-iterator
+		(let ((+iterator+ #t))
+		  (lambda ()
+		    (map (lambda (x y)
+			   (display x #f)
+			   (display y #f)
+			   (list x y))
+			 '(1 2) '(3 4))))))
+  (define (f)
+    (map (lambda (a b) (iterate iter)) '(-1 -2) '(-3 -4)))
+  (test (f) '(((1 3) (2 4)) ((1 3) (2 4)))))
+
+(let ()
+  (define iter (make-iterator
+		(let ((+iterator+ #t))
+		  (lambda ()
+		    (map (lambda (x y)
+			   (list x y))
+			 '(1 2) '(3 4))))))
+  (define (f)
+    (map (lambda (a b) (iterate iter)) '(-1 -2) '(-3 -4)))
+  (test (f) '(((1 3) (2 4)) ((1 3) (2 4)))))
+
+(let ()
+  (define iter (make-iterator
+		(let ((+iterator+ #t))
+		  (lambda ()
+		    (map (lambda (x y)
+			   (catch #t
+			     (lambda ()
+			       (string->list x))
+			     (lambda (t i) 'error)))
+			 '(1 2) '(3 4))))))
+  (define (f)
+    (map (lambda (a b) (iterate iter)) '(-1 -2) '(-3 -4)))
+  (test (f) '((error error) (error error))))
+
+(let ()
+  (define iter (make-iterator
+		(let ((+iterator+ #t))
+		  (lambda ()
+		    (map (lambda (x y)
+			   (string->list x))
+			 '(1 2) '(3 4))))))
+  (define (f)
+    (catch #t
+      (lambda ()
+	(map (lambda (a b) (iterate iter)) '(-1 -2) '(-3 -4)))
+      (lambda (t i) 'error)))
+  (test (f) 'error))
+
+(let ()
+  (define iter (make-iterator
+		(let ((+iterator+ #t))
+		  (lambda ()
+		    (for-each (lambda (x)
+			   (vector->list x))
+			 #(#(1 2) #(3 4)))))))
+  (define (f)
+    (for-each (lambda (a) (iterate iter)) #(-1 -2 -3)))
+  (test (f) #<unspecified>))
+
+(let () ; iterate_p_p
+  (define (f) (let ((iter (make-iterator "asdf"))) (do ((i 0 (+ i 1))) ((= i 1) (iter)) (iterate (car (list iter))))))
+  (test (f) #\s))
+
+(let ()
+  (define (f1)
+    (let ((L1 (make-iterator "asdfasdf"))
+	  (L2 (make-iterator #(1 2 3 4)))
+	  (V1 (make-vector 4)))
+      (do ((L L1 L2)
+	   (i 0 (+ i 1)))
+	  ((= i 4) V1)
+	(vector-set! V1 i (iterate L))))) ; fx_c_opsq -> g_display(g_iterate)
+  (test (f1) #(#\a 1 2 3))
+
+  (define (f2)
+    (let ((L1 (make-iterator "asdfasdf"))
+	  (V1 (make-vector 4)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 4) V1)
+	(vector-set! V1 i (iterate L1))))) ; opt_p_p_s_iterate_unchecked from opt_p_p_f
+  (test (f2) #(#\a #\s #\d #\f))
+
+  (define (f5)
+    (let ((L1 (make-iterator "asdfasdf"))
+	  (L2 (make-iterator #(0 1 2 3 4)))
+	  (V1 (make-vector 4)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 4) V1)
+	(vector-set! V1 i (iterate L1)) ; opt_p_p_s_iterate_unchecked
+	(set! L1 L2))))
+  (test (f5) #(#\a 0 1 2)))
+
+
+;;; --------------------------------------------------------------------------------
+;;; do
+;;; --------------------------------------------------------------------------------
+
+(test (do () (#t 1)) 1)
+(for-each
+ (lambda (arg)
+   (test (do () (#t arg)) arg))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2)))
+
+(for-each
+ (lambda (arg)
+   (test (do ((i arg)) (#t i)) arg))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2)))
+
+(test (do ((i 0 (+ i 1))) ((= i 3) #f)) #f)
+(test (do ((i 0 (+ i 1))) ((= i 3) i)) 3)
+(test (do ((i 1/2 (+ i 1/8))) ((= i 2) i)) 2)
+(test (do ((i 1/2 (+ i 1/8))) ((> i 2) i)) 17/8)
+(test (do ((vec (make-vector 5)) (i 0 (+ i 1))) ((= i 5) vec) (vector-set! vec i i)) #(0 1 2 3 4))
+(test (let ((x '(1 3 5 7 9))) (do ((x x (cdr x)) (sum 0 (+ sum (car x))))  ((null? x) sum))) 25)
+(test (do ((i 4 (- i 1)) (a 1 (* a i))) ((zero? i) a)) 24)
+(test (do ((i 2 (+ i 1))) ((> i 0) 123)) 123)
+
+(test (do () (() ()) ()) ())
+(test (do () ('() ())) ())
+(test (do () ('())) ())
+(test (do () (())) ())
+(test (do) 'error)
+(test (do ((i 0 (+ i 1)) (i 0)) ((= i 0)) i) 'error)
+
+(test (let ((x 0) (y 0)) (set! y (do () (#t (set! x 32) 123))) (list x y)) (list 32 123))
+(test (let ((i 32)) (do ((i 0 (+ i 1)) (j i (+ j 1))) ((> j 33) i))) 2)
+(test (let ((i 0)) (do () ((> i 1)) (set! i (+ i 1))) i) 2)
+(test (let ((i 0) (j 0)) (do ((k #\a)) (#t i) (set! i (char->integer k)) (set! j (+ j i)))) 0)
+(test (let ((i 0) (j 0)) (do ((k #\a)) ((> i 1) j) (set! i (char->integer k)) (set! j (+ j i)))) (char->integer #\a))
+(test (let ((x 0)) (do ((i 0 (+ i 2)) (j 1 (* j 2))) ((= i 4) x) (set! x (+ x i j)))) 5)
+(test (let ((sum 0)) (do ((lst '(1 2 3 4) (cdr lst))) ((null? lst) sum) (set! sum (+ sum (car lst))))) 10)
+(test (do ((i 0 (+ 1 i))) ((= i 4) (do ((i 0 (+ i 2))) ((= i 10) i)))) 10)
+(test (let ((i 0)) (do ((i 1 (+ i 1))) ((= i 3) i))) 3)
+(test (let ((j 0)) (do ((i 0 (+ i 1))) ((= i 3) (+ i j)) (do ((j 0 (+ j i 1))) ((> j 3) j)))) 3)
+(test (let ((add1 (lambda (a) (+ a 1)))) (do ((i 0 (add1 i))) ((= i 10) (add1 i)))) 11)
+(test (do ((i 0 (do ((j 0 (+ j 1))) ((= j i) (+ i 1))))) ((= i 3) i)) 3)
+(test (do ((i 0 (do ((i 0 (+ i 1))) ((= i 3) i)))) ((= i 3) i)) 3)
+(test (let ((i 123)) (do ((i 0 (+ i 1)) (j i (+ j i))) ((> j 200) i))) 13)
+(test (do ((i 0 (+ i 1))) ((> i 3) i) (set! i (* i 10))) 11)
+(test (do ((i 123) (j 0 (+ j i))) ((= j 246) i)) 123)
+(test (do ((i 123 i) (j 0 (+ j i))) ((= j 246) i)) 123)
+(test (do ((i 0 i)) (i i)) 0)
+(test (do ((i 1 i)) (i i (+ i i) (+ i i i))) 3)
+(test (do ((i 1)) (#t 1) 123) 1)
+(test (do ((i 0 (+ i j)) (j 0 (+ j 1))) (#t 1)) 1)
+(test (do ((i 0 j) (j 0 (+ j 1))) ((= j 3) i)) 2) ; uh, lessee... lexical scoping...
+(test (do ((i 1 j) (j 0 k) (k 0 m) (m 0 (+ i j k))) ((> m 10) (list i j k m))) (list 4 5 8 11))
+(test (let ((i 10) (j 11) (k 12)) (do ((i i j) (j j k) (k k m) (m (+ i j k) (+ i j k))) ((> m 100) (list i j k m)))) (list 33 56 78 122))
+(test (let ((x 0) (i 3)) (do ((i i (+ i 1))) ((= i 6)) (do ((i i (+ i 1))) ((= i 7)) (set! x (+ x i)))) x) 44)
+(test (let () (define (hi) (let ((x 0) (i 3)) (do ((i i (+ i 1))) ((= i 6)) (do ((i i (+ i 1))) ((= i 7)) (set! x (+ x i)))) x)) (hi)) 44)
+(test (do ((i 0 (let () (set! j 3) (+ i 1))) (j 0 (+ j 1))) ((= i 3) j)) 4)
+(test (let ((i 0)) (do () ((= i 3) (* i 2)) (set! i (+ i 1)))) 6)
+(num-test (do ((i 0 (- i 1))) ((= i -3) i)) -3)
+(num-test (do ((i 1/2 (+ i 1/2))) ((> i 2) i)) 5/2)
+(num-test (do ((i 0.0 (+ i 0.1))) ((>= i 0.9999) i)) 1.0)
+(num-test (do ((i 0 (- i 1/2))) ((< i -2) i)) -5/2)
+(num-test (do ((i 0+i (+ i 0+i))) ((> (magnitude i) 2) i)) 0+3i)
+(test (let ((x 0))
+	(do ((i 0 (+ i 1)))
+	    ((> i 4) x)
+	  (set! x (+ x i))
+	  (set! i (+ i 0.5))))
+      4.5)
+(test (do ((i 0 1)) ((> i 0) i)) 1)
+(test (do ((i 1.0+i 3/4)) ((= i 3/4) i)) 3/4)
+(test (do ((i 0 "hi")) ((not (number? i)) i)) "hi")
+(test (do ((i "hi" 1)) ((number? i) i)) 1)
+(test (do ((i #\c "hi")) ((string? i) i)) "hi")
+(test (do ((i #\c +)) ((not (char? i)) i)) +)
+(test (let ((j 1)) (do ((i 0 j)) ((= i j) i))) 1)
+(test (let ((j 1)) (do ((i 0 j)) ((= i j) i) (set! j 2))) 2)
+(test (do ((j 1 2) (i 0 j)) ((= i j) i)) 2)
+(test (let ((old+ +) (j 0)) (do ((i 0 (old+ i 1))) ((or (< i -3) (> i 3))) (set! old+ -) (set! j (+ j i))) j) -6)
+(test (do ((i 0 (case i ((0) 1) ((1) "hi")))) ((string? i) i)) "hi")
+(test (do ((i if +)) ((equal? i +) i)) +)
+(test (let ((k 0)) (do ((j 0 (+ j 1)) (i 0 ((if (= i 0) + -) i 1))) ((= j 5)) (set! k (+ k i))) k) 2)
+(test (let ((j -10) (k 0)) (do ((i 0 (+ i j)) (j 2)) ((> i 4) k) (set! k (+ k i)))) 6)
+(test (let ((j -10) (k 0)) (do ((i j (+ i j)) (j 2)) ((> i 4) k) (set! k (+ k i)))) -24)
+(test (let ((j -10) (k 0)) (do ((i j (+ i j)) (j 2)) ((= i j) k) (set! k (+ k i)))) -30)
+(test (let ((j -10) (k 0)) (do ((i j (+ i j)) (j 2)) ((= i j) j) (set! k (+ k i)))) 2)
+(test (let ((equal =)) (do ((i 0 (+ i 1))) ((equal i 3) i))) 3)
+(test (let ((equal =)) (do ((i 0 (+ i 1))) ((equal i 3) i) (set! equal >))) 4)
+(test (do ((equal =) (i 0 (+ i 1))) ((equal i 3) i)) 3)
+(test (do ((equal = >) (i 0 (+ i 1))) ((equal i 3) i)) 4)
+(test (do ((j 0) (plus + -) (i 0 (plus i 1))) ((= i -1) j) (set! j (+ j 1))) 3)
+(test (let ((expr `(+ i 1))) (do ((j 0) (i 0 (eval expr))) ((= i 3) j) (set! j (+ j 1)))) 3)
+(test (let ((expr `(+ i 1))) (do ((j 0) (i 0 (eval expr))) ((= i -3) j) (set! j (+ j 1)) (if (= j 3) (set! expr `(- i 1))))) 7)
+(test (do ((i 0 (+ i 1))) ((or (= i 12) (not (number? i)) (> (expt 2 i) 32)) (expt 2 i))) 64)
+(test (let ((k 0)) (do ((i 0 (+ i 1))) ((let () (set! k (+ k 1)) (set! i (+ i 1)) (> k 3)) i))) 7)
+(num-test (do ((i 0 (+ i 1))) ((> i 3) i) (set! i (* .9 i))) 3.439)
+(test (let ((v #(0 0 0))) (do ((i 0 (+ i 1))) ((= i 3) v) (set! (v i) i))) #(0 1 2))
+(test (let ((v (list 0 0 0))) (do ((i 0 (+ i 1))) ((= i 3) v) (set! (v i) i))) '(0 1 2))
+(test (let ((sum 0)) ((do ((i 0 (+ i 1))) ((> i 64) (lambda () sum)) (set! sum (+ sum i))))) 2080)
+(test (do ((lst () (cons i lst)) (i 0 (+ i 1))) ((> i 6) (reverse lst))) '(0 1 2 3 4 5 6))
+(let ()
+  (define (d1) (do ((i 0 (+ i 1))) ((= i 10) i)))
+  (define (d2) (do ((i 0 (+ i 1))) ((= i 10) i) i))
+  (test (d1) 10)
+  (test (d1) (d2)))
+(test (+ 1 (do ((i 2 (+ i 1))) ((values i (+ i 1))))) 6)
+(test (+ 1 (do ((i 2 (+ i 1))) ((= i 3) (values i (+ i 1))))) 8)
+(test (let () (define (f) (+ 1 (do ((i 2 (+ i 1))) ((values i (+ i 1)))))) (f) (f)) 6)
+(test (let () (define (f) (+ 1 (do ((i 2 (+ i 1))) ((= i 3) (values i (+ i 1)))))) (f) (f)) 8)
+(test (list (do ((i 0 (+ i 1))) ((= i 1) (values #f 1)))) '(#f 1))
+(test (let ((lst '(1 2)))
+	(do ((p lst (cdr p)))
+	    ((or (not (pair? p)) (car p))
+	     => (lambda (val)
+		  (and (pair? p)
+		       val)))))
+      1)
+(let ()
+  (define (f lst)
+    (do ((p lst (cdr p)))
+	((or (not (pair? p)) (car p))
+	 => (lambda (val)
+	      (and (pair? p)
+		   val)))))
+  (test (f '(1 2)) 1)
+  (test (f '(2 3)) 2))
+(let ()
+  (define (f lst)
+    (do ((p lst (cdr p)))
+	((or (not (pair? p)) (car p))
+	 => car)))
+  (test (f '((1) 2)) 1)
+  (test (f '((2) 3)) 2))
+(let ()
+  (define (f lst)
+    (do ((p lst (cdr p)))
+	((if (pair? p)
+	     (apply values (car p))
+	     #t)
+	 => +)))
+  (test (f '((1 2) 2)) 3)
+  (test (f '((2 3 4) 3)) 9))
+(let ((size 10))
+  (define (f5)
+    (let ((v (make-vector size 1 integer?))
+	  (sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i size) sum)
+	(set! sum (+ sum (vector-ref v i))))))
+  (test (f5) size))
+
+(test (do () (1)) 1)
+(test (do () (1 2)) 2)
+(test (do () '2) 2)
+(test (do () (())) ())
+(test (do ((i 0 (+ i 1))) ((= i 2) (+ i j)) (define j i) j) 3) ; bizarre (Guile sez "bad define placement" from r6|7rs I guess)
+(test (do ((i 1 (+ i j))) ((>= i 2) (+ i j)) (define j i) j) 3)
+(test (do ((i 1 (+ i j))) ((>= i 2) (+ i j)) (define j (+ i 10)) j) 23)
+;(test (do ((i 1 (+ i j))) ((>= i 2) (+ i j)) (if (integer? i) (define j i)) j) 3)
+(test (do ((i 0 (+ i 1))) ((>= i 2) i) (define i 10) i) 11)
+(test (do ((x (values (substring "0123" 2) #b101))) (#t (vector))) 'error)
+(test (do ((x 0 (values 1 2))) ((= x 2)) (display x #f)) 'error)
+(test (do ((i 0 (+ i 1))) ((values #t #f) 21) (abs i)) 21)
+(test (+ 1 (do ((i 0 (+ i 1))) ((values (= i 1) 2 3) 4)) 5) 10)   ; (+ 1 (do (...) (#t 2 3 4)) 5) -> (+ 1 4 5)
+(test (+ 1 (do ((i 0 (+ i 1))) ((values (= i 1) 2 3))) 5) 'error) ; the #f gets spliced into + args
+(test (+ 1 (do ((i 0 (+ i 1))) ((values 2 3))) 5) 11)             ; (+ 1 2 3 5) -- hmmm.
+(test (let ((x (do ((i 0 (+ i 1))) (#t)))) x) #t) ; guile: #<unspecified>
+(test (let () (define (f lst) (do ((lst lst (cddr lst)) (a () (cons (car lst) a))) ((null? lst) a))) (f '(1 2 3 4))) '(3 1))
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (list func cond (quote (nan? "") (append (lambda*)))))) (func)) 'error)
+(test (let () (define (func) (let ((x #f) (i 0)) (do ((x 0.0 (+ x 0.1)) (i 0 (+ i 1))) ((>= x .1) (sqrt (* 2 2)))))) (func)) 2) ; tree_outer shadowed check
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (#_sqrt 2.0)))) (func)) #t) ; opt #_* change
+(test (let () (define (f) (do ((sum 0) (n 0 (+ n 1))) ((= n 3) sum) (do ((n 0 (+ n 1))) ((= n 4)) (set! sum (+ sum 1))))) (f) (f)) 12)
+(let () (define (f1) (do ((i 0 (+ i __unbound__))) ((= i 0) 32) (display "oops\n"))) (test (f1) 32))
+(let () (define (func) (let ((x #f)) (do () ((not false) (((vector msym4) 0) my-with-baffle (* 2 x 3.0 4)))))) (test (func) 'error)) ;fx_T in check_do ("false"=undef)
+(test (let () (define (f) (do ((x 0 (+ x 1)) (i 0 (+ i 1))) ((= i 1) x 3 4))) (f)) 4) ; op_dox_no_body_1
+(test (let () (define (f) (do ((x 0 (+ x 1)) (i 0 (+ i 1))) ((= i 1)))) (f)) #t)      ; op_dox_no_body_1
+
+(let () ; macroexpand in int-optimize bug
+  (define-macro (hi) (values 3 1.2))
+  (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (hi))) (test (func) #t))
+  (let () (define (func) (do ((i '(1) (cdr i))) ((null? i)) (hi))) (test (func) #t))
+  (let () (define (func) (do ((i '(1) (cdr i))) ((null? i)) 1 (hi))) (test (func) #t)))
+;;; do_loop_end slot arg bug
+(test (let ((__var2__ 3)) (define (func) (let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 100)) (let* () __var2__)))) (func) (func)) #t)
+
+(let ()
+  (define (strcop str) ; opt_dotimes >= case (coverage)
+    (let* ((len (length str))
+	   (new-str (make-string (+ len 3) #\a)))
+      (do ((i 0 (+ i 1)))
+	  ((>= i len) new-str)
+	(string-set! new-str i (string-ref str i)))))
+  (test (strcop "123") "123aaa"))
+
+(let ((dbac (bacro* (c) `(provide 'asdf)))) ; check fx_tree choice in op_dox portion of check_do
+  (define (func) (do ((x #f) (i 0 (+ i 1))) ((= i 1) x) (set! x (dbac))))
+  (test (func) 'asdf))
+
+(let () ; check fx_choose let choice
+  (define (frame1 n)
+    (do ((_p_ (curlet))
+         (out _p_)
+         (i 0 (+ i 1)))
+        ((or (= i n) (not (let? out)))
+         (format #t "frame1 _p_: ~S, out: ~S~%" _p_ out))))
+   (define (frame2) (frame1 1))
+   (catch #t
+     (lambda ()
+       (let ((result (frame1 1)))
+         (format *stderr* "frame1: ~S?\n" result)))
+     (lambda (type info)
+       (unless (and (eq? type 'unbound-variable)
+                    (string=? (substring (apply format #f info) 0 20) "unbound variable _p_"))
+         (format *stderr* "frame1: ~S ~S~%" type (apply format #f info)))))
+   (catch #t
+     (lambda ()
+       (let ((result (frame2)))
+         (format *stderr* "frame2: ~S?\n" result)))
+     (lambda (type info)
+       (unless (and (eq? type 'unbound-variable)
+                    (string=? (substring (apply format #f info) 0 20) "unbound variable _p_"))
+         (format *stderr* "frame2: ~S ~S~%" type (apply format #f info))))))
+
+(let ((y 0)) ; coverage test (do_no_body_fx_vars)
+  (define (end x) (set! y x) (= y 3))
+  (define (dot) (do ((i 0 (+ i 1)) (j 3)) ((or (< i 0) (end i)))))
+  (dot)
+  (test y 3))
+(let ()
+  (define (f1) (eval '(do ((i 0 j) (j 0 (+ j 1))) ((= j 3) i))))
+  (define (g) (catch #t f1 (lambda args #f)))
+  (test (g) 2))
+
+(let () ; int->real via set! after use as int in body: d_id_ok -> opt_d_id_sf bug
+  (define (f1)
+    (let ((x 0)
+	  (y 2.0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 2))
+        (set! x (* i y))
+        (cos (+ x (* y 2.0))))))
+  (test (f1) #t)
+
+  (define (f2)
+    (let ((x 0)
+	  (y 2.1))
+      (do ((i 0 (+ i 1))
+	   (j 0 (+ j 1)))
+	  ((= i 2) x)
+	(set! x (* i j))
+	(cos (+ x (* y 2.3))))))
+  (test (f2) 1)
+
+  (define (f3)
+    (let ((x 0)
+	  (y 2))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) x)
+	(set! x (* i y))
+	(set! y (* i 2.1))
+	(cos (+ x (* y 2.1))))))
+  (test (f3) 4.2)
+
+  (define (f4)
+    (let ((x 0)
+	  (y 2))
+      (do ((i 0 (+ i 1))
+	   (j 0 (+ j 1.1)))
+	  ((= i 3) x)
+	(set! x (* i j))
+	(cos (+ x (* y 2.1))))))
+  (test (f4) 4.4)
+
+  (define (f5)
+    (let ((x 0))
+      (do ((i 0 (+ i 1))
+	   (j 0 (+ j 1)))
+	  ((= i 3) x)
+	(set! x (max x (* i j))))))
+  (test (f5) 4)
+
+  (define (f5a)
+    (let ((x 0)
+	  (i 2.2)
+	  (j 2.1))
+      (do ((i 0 (+ i 1))
+	   (j 0 (+ j 1)))
+	  ((= i 3) x)
+	(set! x (max x (* i j))))))
+  (test (f5a) 4)
+
+  (define (f6)
+    (let ((sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 10) sum)
+	(do ((j 0 (+ j 1)))
+	    ((= j 3))
+	  (set! sum (+ sum i j))))))
+  (test (f6) 165))
+
+(test (let ((lst '(1 2 3))
+	    (v (vector 0 0 0)))
+	(do ((l lst (map (lambda (a) (+ a 1)) (cdr l))))
+	    ((null? l))
+	  (set! (v (- (length l) 1)) (apply + l)))
+	v)
+      #(5 7 6))
+
+(test (do ((i 0 (+ i 1)) (j 1 2)) ((= i 4) j) (set! j 3)) 2)
+(let ()
+  (define (iota n)
+    (do ((n n (- n 1))
+	 (lst () (cons (- n 1) lst)))
+	((= n 0) lst)))
+  (test (iota 10) '(0 1 2 3 4 5 6 7 8 9))) ; a test of shadowing detection in check_do
+
+(test (let ((lst '(1 2 3)))
+	(map (lambda (a)
+	       (let ((! 1))
+		 (do ((i 0 (+ i 1))
+		      (sum 0))
+		     ((= i a) sum)
+		   (set! sum (+ sum a)))))
+	     lst))
+      '(1 4 9))
+
+(let () ;; test that set! of stepper is ignored in step vals etc, Guile agrees except it says z is #<unspecified>, do is weird
+  (define (hash-ints1 calls)
+    (do ((i 0 (+ i 1))
+         (z 0 (set! i (- calls 1)))
+         (steps 0 (+ steps i)))
+        ((= i calls) (list i z steps))))
+  (test (hash-ints1 10) '(10 9 90)))
+
+(test (let ((sum 0)) (do ((i_0 0 (+ i_0 0))(i_1 1 (+ i_1 1))(i_2 2 (+ i_2 2))(i_3 3 (+ i_3 3))(i_4 4 (+ i_4 4))(i_5 5 (+ i_5 5))(i_6 6 (+ i_6 6))(i_7 7 (+ i_7 7))(i_8 8 (+ i_8 8))(i_9 9 (+ i_9 9))(i_10 10 (+ i_10 10))(i_11 11 (+ i_11 11))(i_12 12 (+ i_12 12))(i_13 13 (+ i_13 13))(i_14 14 (+ i_14 14))(i_15 15 (+ i_15 15))(i_16 16 (+ i_16 16))(i_17 17 (+ i_17 17))(i_18 18 (+ i_18 18))(i_19 19 (+ i_19 19))(i_20 20 (+ i_20 20))(i_21 21 (+ i_21 21))(i_22 22 (+ i_22 22))(i_23 23 (+ i_23 23))(i_24 24 (+ i_24 24))(i_25 25 (+ i_25 25))(i_26 26 (+ i_26 26))(i_27 27 (+ i_27 27))(i_28 28 (+ i_28 28))(i_29 29 (+ i_29 29))(i_30 30 (+ i_30 30))(i_31 31 (+ i_31 31))(i_32 32 (+ i_32 32))(i_33 33 (+ i_33 33))(i_34 34 (+ i_34 34))(i_35 35 (+ i_35 35))(i_36 36 (+ i_36 36))(i_37 37 (+ i_37 37))(i_38 38 (+ i_38 38))(i_39 39 (+ i_39 39)))
+    ((= i_1 10) sum)
+  (set! sum (+ sum i_0 i_1 i_2 i_3 i_4 i_5 i_6 i_7 i_8 i_9 i_10 i_11 i_12 i_13 i_14 i_15 i_16 i_17 i_18 i_19 i_20 i_21 i_22 i_23 i_24 i_25 i_26 i_27 i_28 i_29 i_30 i_31 i_32 i_33 i_34 i_35 i_36 i_37 i_38 i_39))))
+      35100)
+
+(let () (define (jtest) (let ((j 0)) (do ((i 0 (+ i 1))) ((= i 10) j) (if (= i 3) (set! j i))))) (test (jtest) 3))
+(let () (define (jtest1) (let ((j (vector 0))) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (set! (j 0) i))))) (test (jtest1) 3))
+(let () (define (jtest2) (let ((j (vector 0))) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (vector-set! j 0 i))))) (test (jtest2) 3))
+(let () (define (jtest3) (let ((j (vector 0))) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (set! (vector-ref j 0) i))))) (test (jtest3) 3))
+(let () (define (jtest4) (let ((j (list 0))) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (set! (j 0) i))))) (test (jtest4) 3))
+(let () (define (jtest5) (let ((j (list 0))) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (set! (car j) i))))) (test (jtest5) 3))
+(let () (define (jtest6) (let ((j (list 0))) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (set-car! j i))))) (test (jtest6) 3))
+(let () (define (jtest7) (let ((j (list 0))) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (list-set! j 0 i))))) (test (jtest7) 3))
+(let () (define (jtest8) (let ((j #f)) (do ((i 0 (+ i 1))) ((= i 10) (car j)) (if (= i 3) (set! j (list i)))))) (test (jtest8) 3))
+(let () (define (jtest9) (let ((j #f)) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (set! j (vector i)))))) (test (jtest9) 3))
+(let () (define (jtest10) (let ((j (cons 1 2))) (do ((i 0 (+ i 1))) ((= i 10) j) (if (= i 3) (set-car! j i))))) (test (jtest10) '(3 . 2)))
+(let () (define (jtest10a) (let ((j (cons 1 2))) (do ((i 0 (+ i 1))) ((= i 10) j) (if (= i 3) (list-set! j 0 i))))) (test (jtest10a) '(3 . 2)))
+(let () (define (jtest11) (let ((j (cons 1 2))) (do ((i 0 (+ i 1))) ((= i 10) j) (if (= i 3) (set! j (cons 0 i)))))) (test (jtest11) '(0 . 3)))
+;; (let ((f #f)) (define (jtest12) (do ((i 0 (+ i 1))) ((= i 10) (f)) (if (= i 3) (set! f (lambda () i))))) (test (jtest12) 3))
+;; this lambda business is a separate issue (s7 returns 10 here)
+
+;; kinda excessive...
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j :allow-other-keys)))) (func) (func)) 'error)
+(test (let () (define (func) (do ((j 0 (+ j 1))) ((= j 1)) (set! j :allow-other-keys))) (func)) 'error)
+(test (let ((v #r(1.0))) (define (func) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v))) (func)) 'error) ;opt_dotimes[82710]: not an integer, but a float-vector (type: 23)
+(test (let ((v "asdf")) (define (func) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v))) (func)) 'error)
+(test (let ((v #r(1.0))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func)) 'error) ;opt_i_ii_sc_add[59014]
+(test (let ((v '(1 2))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func))  'error)
+(test (let ((v ())) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func))  'error)
+(test (let ((v #i(2))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func))  'error)
+(test (let ((v #r(2))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func))  'error)
+(test (let ((v #u(2))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func))  'error)
+(test (let ((v (hash-table 'a 1))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func))  'error)
+(test (let ((v (inlet 'a 1))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func))  'error)
+(test (let ((v #<unspecified>)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func))  'error)
+(test (let ((v #<undefined>)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func))  'error)
+(test (let ((v #<eof>)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func))  'error)
+(test (let ((v #t)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func))  'error)
+(test (let ((v #\a)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func))  'error)
+(test (let ((v when)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func))  'error)
+(test (let ((v 'when)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func))  'error)
+(test (let ((v (make-iterator #(1)))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func))  'error)
+(test (let ((v (c-pointer 1234))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func))  'error)
+(test (let ((v (random-state 1234))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func))  'error)
+(test (let ((v quasiquote)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func))  'error)
+(test (let ((v abs)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func))  'error)
+;and the rest (i/o etc)
+(test (let ((v (block))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func))  'error) ; missing + method in <block>
+(test (let ((v (byte-vector-ref #u(0) 0))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((> j 0)) (set! j v)))) (func)) #t)
+(test (let ((v 1/2)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0.0 (+ j 1.0))) ((>= j 0.0)) (set! j v)))) (func)) #t) ;float != rational also
+(test (let ((v 1/2)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((> j 0)) (set! j v)))) (func)) #t)
+(test (let ((v 2.0)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((> j 0)) (set! j v)))) (func)) #t)
+(test (let ((v 2+i)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((> j 0)) (set! j v)))) (func)) 'error)
+(test (let ((v #(2))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((> j 0)) (set! j v)))) (func)) 'error)
+
+(let () ; opt_set_p_i|d_fm bug
+  (define (f1)
+    (let ((v (vector 0 0 0))
+	  (y 1))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) v)
+	(set! y (round (+ y 1)))
+	(vector-set! v i y))))
+  (test (f1) #(2 3 4))
+
+  (define (f2)
+    (let ((v (vector 0 0 0))
+	  (y 1.0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) v)
+	(set! y (+ y 1.0))
+	(vector-set! v i y))))
+  (test (f2) #(2.0 3.0 4.0)))
+
+(test (let () (define-constant _bg_ 0) (define (f) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (set! _bg_ x)))) (f)) 0) ; op_set1 s7_is_eqv
+
+(let () ; opt_dotimes coverage tests (some miss their target...)
+  (define (od1)
+    (let ((fv #2r((0 1 2) (2 3 4))))
+      (do ((i 0 (+ i 1))) ((= i 2) fv) (float-vector-set! fv (+ i 0) (+ i 1) (* 2.0 3.0)))))
+  (test (od1) #r2d((0.0 6.0 2.0) (2.0 3.0 6.0)))
+  (define (od2)
+    (let ((y 0) (z 0.0))
+      (do ((i 0 (+ i 1))) ((= i 3) y) (if (= (+ z 1) 2.2) (display (+ z 1))))))
+  (test (od2) 0)
+  (define (od3)
+    (let ((len 2) (lst '(0 1 2 3)))
+      (do ((i 0 (+ i 1))) ((= i len)) (if (not (= (list-ref lst i) i)) (display "oops")))))
+  (test (od3) #t)
+  (define (od4)
+    (let ((size 2) (vct-hash (hash-table #r(0.0) 0 #r(1.0) 1)))
+      (do ((i 0 (+ i 1))) ((= i size)) (unless (= (hash-table-ref vct-hash (float-vector i)) i) (display "oops")))))
+  (test (od4) #t)
+  (define (od5)
+    (let ((v (vector 0 1 2)) (size 2))
+      (do ((i 0 (+ i 1))) ((= i size) (vector-ref v 0)) (vector-set! v i 2))))
+  (test (od5) 2)
+  (define (od51)
+    (let ((v #u(0 1 2)) (size 2))
+      (do ((i 0 (+ i 1))) ((= i size) (byte-vector-ref v 0)) (byte-vector-set! v i 2))))
+  (test (od51) 2)
+  (define (od6)
+    (do ((i 0 (+ i 1))) ((= i 1)) (char-alphabetic? (string-ref "asdf" 1))))
+  (test (od6) #t)
+  (define (od7)
+    (let ((len 2) (mx 0) (loc 0) (vect #(0 1 2)))
+      (do ((i 0 (+ i 1))) ((= i len) (list mx loc)) (when (> (abs (vect i)) mx) (set! mx (vect i)) (set! loc i)))))
+  (test (od7) '(1 1))
+  (define (od8)
+    (let ((sum 0) (v #2d((0 0) (1 1) (2 2))) (size/10 1))
+      (do ((k 0 (+ k 1))) ((= k 1) sum) (do ((i 0 (+ i 1))) ((= i size/10)) (set! sum (+ sum (round (vector-ref v k i))))))))
+  (test (od8) 0)
+  (define (od9)
+    (let ((len 2) (mx 0) (loc 0) (vect #(0 1 2)))
+      (do ((i 0 (+ i 1))) ((= i len) (list mx loc)) (when (> (abs (vect i)) mx) (set! mx (vect i)) (set! loc i)))))
+  (test (od9) '(1 1))
+  (define (od10)
+    (let ((x 0.0) (x1 1.0) (x2 2.0) (b1 (block 1.0)) (b2 (block 2.0)) (j 0))
+      (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (+ (* x1 (block-ref b1 i)) (* x2 (block-ref b2 j)))))))
+  (test (od10) 5.0)
+  (define (od11)
+    (let ((sum 0) (v #r(1 2 3)) (size 3))
+      (do ((i 0 (+ i 1))) ((= i size) sum) (set! sum (+ sum (floor (vector-ref v i)))))))
+  (test (od11) 6)
+  (define (od12)
+    (let ((strs #("asdf")))
+      (do ((i 0 (+ i 1))) ((= i 1) strs) (copy (vector-ref strs i) (make-string 1)) (copy (vector-ref strs i) (make-string 0)))))
+  (test (od12) #("asdf"))
+  (define (od13)
+    (let ((j 0) (len2 1) (obj #(0 1)) (n 0) (seq2 '(0 1)))
+      (do ((k j (+ k 1))) ((= k len2) obj) (set! (obj n) (seq2 k)) (set! n (+ n 1)))))
+  (test (od13) #(0 1)))
+
+;; do_all_x:
+(let () (define (f1) (let ((v (vector 0 0 0))) (do ((i 0 (+ i 1))) ((= i 3) v) (vector-set! v i (abs i))))) (test (f1) #(0 1 2)))
+(let () (define (f1) (let ((v (vector 0 0 0)) (x #f)) (do ((i 0 (+ i 1))) ((= i 3) (set! x v) x) (vector-set! v i (abs i))))) (test (f1) #(0 1 2)))
+(let () (define (f1) (let ((end 3) (v (vector 0 0 0))) (vector (do ((i 0 (+ i 1))) ((= i end)) (vector-set! v i (abs i))) v))) (test (f1) #(#t #(0 1 2))))
+(let () (define (f1) (let ((v (vector 0 0 0))) (do ((i 0 (+ i 1))) ((= i 3) v) (display i #f) (vector-set! v i (abs i))))) (test (f1) #(0 1 2)))
+
+(let () ; op_dox gxable section (coverage)
+  (define (f2 x) (floor x))
+  (define (ftst2) (do ((i 1 (+ i 1)) (j 1.0 (+ j 0.21))) ((= i 10) (f2 j)) (f2 j)))
+  (test (ftst2) 2))
+
+(let () (define (f1) (let ((v (vector 0 0 0))) (do ((i 0 (+ i 1))) ((= i 0) v) (vector-set! v i (abs i))))) (test (f1) #(0 0 0)))
+
+(let () (define (safe-do-all-x)
+	  (let ((v1 (vector 1 2 3 4 5 6))
+		(v2 (vector 10 11 12 13 14 15)))
+	    (do ((i 0 (+ i 1)))
+		((= i 3))
+	      (vector-set! v1 i (vector-ref v2 (+ i 1))))
+	    v1))
+     (test (safe-do-all-x) (vector 11 12 13 4 5 6)))
+
+
+(test (let () (define (step-it a) (+ a 1)) (define (hi) (do ((i 0 (step-it i))) ((= i 3) i))) (hi) (hi)) 3)
+
+(test (call-with-exit (lambda (return) (do () () (if #t (return 123))))) 123)
+(test (call-with-exit (lambda (return) (do () (#f) (if #t (return 123))))) 123)
+(test (call-with-exit (lambda (return) (do ((i 0 (+ i 1))) () (if (= i 100) (return 123))))) 123)
+(test (call-with-exit (lambda (return) (do () ((return 123))))) 123)
+(test (call-with-exit (lambda (return) (do () (#t (return 123))))) 123)
+
+(test (do () (/ 0)) 0)
+(test (do () (+)) +)
+(test (do () (+ +) *) +)
+
+(when with-bignums
+  (num-test (do ((i 24444516448431392447461 (+ i 1))
+		 (j 0 (+ j 1)))
+		((>= i 24444516448431392447471) j))
+	    10)
+  (num-test (do ((i 0 (+ i 24444516448431392447461))
+		 (j 0 (+ j 1)))
+		((>= i 244445164484313924474610) j))
+	    10)
+  (num-test (do ((i 4096 (* i 2))
+		 (j 0 (+ j 1)))
+		((= i 4722366482869645213696) j))
+	    60))
+
+(test (do ((i 9223372036854775805 (+ i 1))
+	   (j 0 (+ j 1)))
+	  ((>= i 9223372036854775807) j))
+      2)
+(test (do ((i -9223372036854775805 (- i 1))
+	   (j 0 (+ j 1)))
+	  ((<= i -9223372036854775808) j))
+      3)
+
+(num-test (do ((x (list 1 2 3) (cdr x)) (j -1)) ((null? x) j) (set! j (car x))) 3)
+
+(test (let ((x 0))
+	(do ((i 0 (+ i 1)))
+	    ((= i (do ((j 0 (+ j 1))) ((= j 2) (+ j 1)))))
+	  (set! x (+ x i)))
+	x)
+      3)
+(test (let ((x 0))
+	(do ((i 0 (+ i (do ((j 0 (+ j 1))) ((= j 2) 1)))))
+	    ((= i 3) x)
+	  (set! x (+ x i))))
+      3)
+(test (let ((x 0))
+	(do ((i 0 (+ i (do ((j 0 (+ j 1))) ((= j 2) 1)))))
+	    ((= i 3) (do ((j 0 (+ j 1))) ((= j 5) x) (set! x j)))
+	  (set! x (+ x i))))
+      4)
+
+(let () (define (mk2 n) (do ((n n (- n 1)) (a () (cons () a))) ((= n 0) a))) (test (mk2 3) '(() () ())))
+
+(test (call-with-exit (lambda (exit) (do ((i 0 (+ i 1))) ((= i 100) i) (if (= i 2) (exit 321))))) 321)
+(test (call-with-exit (lambda (exit) (do ((i 0 (if (= i 3) (exit 321) (+ i 1)))) ((= i 100) i)))) 321)
+(test (call-with-exit (lambda (exit) (do ((i 0 (+ i 1))) ((= i 10) (exit 321))))) 321)
+(test (call-with-exit (lambda (exit) (do ((i 0 (+ i 1))) ((= i 10) i) (if (= i -2) (exit 321))))) 10)
+(test (do ((x 0 (+ x 1)) (y 0 (call/cc (lambda (c) c)))) ((> x 5) x) #f) 6)
+(test (let ((happy #f)) (do ((i 0 (+ i 1))) (happy happy) (if (> i 3) (set! happy i)))) 4)
+
+(test (+ (do ((i 0 (+ i 1))) ((= i 3) i)) (do ((j 0 (+ j 1))) ((= j 4) j))) 7)
+(test (do ((i (if #f #f))) (i i)) (if #f #f))
+(test (do ((i (if #f #f)) (j #f i)) (j j)) (if #f #f))
+
+(test (let ((cont #f)
+	    (j 0)
+	    (k 0))
+	(call/cc (lambda (exit)
+		   (do ((i 0 (+ i 1)))
+		       ((= i 100) i)
+		     (set! j i)
+		     (call/cc (lambda (r) (set! cont r)))
+		     (if (= j 2) (exit))
+		     (set! k i))))
+	(if (= j 2)
+	    (begin
+	      (set! j 3)
+	      (cont))
+	    (list j k)))
+      (list 99 99))
+
+(test (call/cc (lambda (r) (do () (#f) (r 1)))) 1)
+(test (let ((hi (lambda (x) (+ x 1)))) (do ((i 0 (hi i))) ((= i 3) i))) 3)
+(test (do ((i 0 (+ i 1))) (list 1) ((= i 3) #t)) 1) ; a typo originally -- Guile and Gauche are happy with it
+(test (do () (1 2) 3) 2)
+
+;; from sacla tests
+(test (let ((rev (lambda (list)
+		   (do ((x list (cdr x))
+			(reverse () (cons (car x) reverse)))
+		       ((null? x) reverse)))))
+	(and (null? (rev ()))
+	     (equal? (rev '(0 1 2 3 4)) '(4 3 2 1 0))))
+      #t)
+
+(test (let ((nrev (lambda (list)
+		    (do ((f1st (if (null? list) () (cdr list)) (if (null? f1st) () (cdr f1st)))
+			 (s2nd list f1st)
+			 (t3rd () s2nd))
+			((null? s2nd) t3rd)
+		      (set-cdr! s2nd t3rd)))))
+	(and (null? (nrev ()))
+	     (equal? (nrev (list 0 1 2 3 4)) '(4 3 2 1 0))))
+      #t)
+
+(test (do ((temp-one 1 (+ temp-one 1))
+	   (temp-two 0 (- temp-two 1)))
+	  ((> (- temp-one temp-two) 5) temp-one))
+      4)
+
+(test (do ((temp-one 1 (+ temp-one 1))
+	   (temp-two 0 (+ temp-one 1)))
+	  ((= 3 temp-two) temp-one))
+      3)
+
+(let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
+  (test (do ((i 0 (+ 1 i))
+	     (n #f)
+	     (j 9 (- j 1)))
+	    ((>= i j) vec)
+	  (set! n (vector-ref vec i))
+	  (vector-set! vec i (vector-ref vec j))
+	  (vector-set! vec j n))
+	#(9 8 7 6 5 4 3 2 1 0)))
+
+(test (do ((i 0 (+ i 1))) (#t i) (error 'syntax-error "do evaluated its body?")) 0)
+(test (do '() (#t 1)) 'error)
+(test (do . 1) 'error)
+(test (do ((i i i)) (i i)) 'error)
+(test (do ((i 0 i (+ i 1))) (i i)) 'error)
+(test (do ((i)) (#t i)) 'error)
+(test (do ((i 0 (+ i 1))) #t) 'error)
+(test (do 123 (#t 1)) 'error)
+(test (do ((i 1)) (#t . 1) 1) 'error)
+(test (do ((i 1) . 1) (#t 1) 1) 'error)
+(test (do ((i 1) ()) (= i 1)) 'error)
+(test (do ((i 0 . 1)) ((= i 1)) i) 'error)
+(test (do ((i 0 (+ i 1))) ((= i 3)) (set! i "hiho")) 'error)
+(test (let ((do+ +)) (do ((i 0 (do+ i 1))) ((= i 3)) (set! do+ abs))) 'error)
+(test (do () . 1) 'error)
+(test (do ((i)) (1 2)) 'error)
+(test (do (((i))) (1 2)) 'error)
+(test (do ((i 1) ((j))) (1 2)) 'error)
+(test (do (((1))) (1 2)) 'error)
+(test (do ((pi 1 2)) (#t pi)) 'error)
+(test (do ((1+i 2 3)) (#t #t)) 'error)
+(test (do ((1.2 2 3)) (#t #t)) 'error)
+(test (do (((1 . 2) "hi" (1 2))) (#t 1)) 'error)
+(test (do ((() () ())) (#t #t)) 'error)
+(test (do (("hi" "hi")) ("hi")) 'error)
+(test (do ((:hi 1 2)) (#t :hi)) 'error)
+(test (do ((i 0 (abs ()))) ((not (= i 0)) i)) 'error)
+(test (do ((i j) (j i)) (i i)) 'error)
+(test (do ((i 0 0) . ((j 0 j))) (#t j)) 0)
+(test (do ((i 0 1 . 2)) (#t i)) 'error)
+(test (do ((i 0 "hi")) ((string? i) . i)) 'error)
+(test (do ((i 0 j)) (#t i)) 0) ; guile also -- (do ((i 0 (abs "hi"))) (#t i)) etc (do ((i 0 1)) (#t i) (abs "hi"))
+(test (do ((i 0 1) . (j 0 0)) ((= i 1) i) i) 'error)
+(test (do ((i 0 1) ((j 0 0)) ((= i 1) i)) i) 'error)
+(test (do #f) 'error)
+(test (do () #f) 'error)
+(test (do () #()) 'error)
+(test (do '((i 1)) ()) 'error)
+(test (do #() ()) 'error)
+(test (do ((#() 1)) ()) 'error)
+(test (do ((1)) ()) 'error)
+(test (do ((i 1) . #(a 1)) ()) 'error)
+(test (do () ((3 4))) 'error)
+(test (do ((i 1)) '()) ())
+(test (do . (() (#t 1))) 1)
+(test (do () . ((#t 1))) 1)
+(test (do ((i 1 (+ i 1))) . ((() . ()))) ())
+(test (do ((a . 1) (b . 2)) () a) 'error)
+(let () (define (d1) (do ((i 0 (+ i 1))) ((= i 3) . i) (display i))) (test (d1) 'error))
+(let () (define (d1) (do ((i 0 (+ i 1))) ((= i 3) i) . i)) (test (d1) 'error))
+(test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 1) i) ((0 1) ()))) (f)) 'error)
+(test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 1) i) () (define-macro (_m1_ a) (list-values '+ a 1)))) (f)) 1)
+(test (let () (define (f) (do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 1) i) () (define-macro (_m1_ a) (list-values '+ a 1)))) (f)) 1)
+(test (let () (define (f) (do ((i 0 (+ i 1)) (x (provide ':allow-other-keys) (provide ':allow-other-keys))) ((= i 1) x))) (f)) :allow-other-keys)
+(test (let () (define-constant bigcmp1 1+2i) (define (func) (let ((_x_ 1)) (do ((i 0 (+ i _x_))) ((= i _x_)) (set! bigcmp1 (bignum 0+i))))) (func)) 'error) ; bigcmp1 constant
+(test (let () (define (func) (let ((x #f)) (do () ((not false) (abs x))))) (func) (func)) 'error) ; op_do_no_vars don't free inner let!
+
+(let () ; opt_cell_do test for expr as init
+  (define (f v x)
+    (let ((len (length v)) (sum 0))
+      (do ((j 0 (+ j 1))) ((= j 1) sum)
+	(do ((i (+ x 1) (+ i 1))) ((= i len))
+	  (set! sum (+ sum (int-vector-ref v i)))))))
+  (define v (make-int-vector 10))
+  (do ((i 0 (+ i 1))) ((= i 10)) (int-vector-set! v i i))
+  (test (f v 2) (+ 3 4 5 6 7 8 9)))
+
+(test (define-constant) 'error)
+(test (define-constant _asdf_ 2 3) 'error)
+(test (define-constant pi 3) 'error) ; except in Utah
+(test (define-constant pi . 3) 'error)
+(define-constant __do_step_var_check__ 1)
+(test (do ((__do_step_var_check__ 2 3)) (#t #t)) 'error)
+(test (let ((__do_step_var_check__ 2)) 1) 'error)
+(test (let () (set! __do_step_var_check__ 2)) 'error)
+(test (let ((__a_var__ 123))
+	(set! (setter '__a_var__) (lambda (val sym) 0))
+	(set! __a_var__ -1123))
+      0)
+(test (do ((hi #3d(((1 2) (3 4)) ((5 6) (7 8))) (hi 1))) ((equal? hi 8) hi)) 8)
+(test (do ((i 0 ('((1 2) (3 4)) 0 1))) ((not (= i 0)) i)) 2)
+(test (do () (#t (+ 1 2 3))) 6)
+(test (do ((f + *) (j 1 (+ j 1))) ((= j 2) (apply f (list j j)))) 4)
+(test (do ((f lambda) (j 1 (+ j 1))) ((= j 2) ((f (a) (+ a j)) 3))) 5)
+
+(let ()
+  (define-macro (add-1 x) `(+ ,x 1))
+  (test (do ((i 0 (add-1 i))) ((= i 3) i)) 3)
+  (test (do ((i 0 (add-1 i))) ((= i 3) (add-1 i))) 4))
+
+(test (let ((j #f))
+	(do ((i 0 (let ((x 0))
+		    (dynamic-wind
+			(lambda ()
+			  (set! x i))
+			(lambda ()
+			  (+ x 1))
+			(lambda ()
+			  (if (> x 3)
+			      (set! j #t)))))))
+	    (j i)))
+      5)
+(test (let ((j 0)) (do ((i 0 (eval-string "(+ j 1)"))) ((= i 4) j) (set! j i))) 3)
+(test (do ((i (do ((i (do ((i 0 (+ i 1)))
+			  ((= i 3) (+ i 1)))
+		      (do ((j 0 (+ j 1)))
+			  ((= j 3)) (+ j i))))
+		  ((> (do ((k 0 (+ k 1)))
+			  ((= k 2) (* k 4)))
+		      (do ((n 0 (+ n 1)))
+			  ((= n 3) n)))
+		   (do ((m 0 (+ m 1)))
+		       ((= m 3) (+ m i)))))
+	      i))
+	  ((> i 6) i))
+      7)
+
+(test (let ((L (list 1 2)))
+	(do ((sum 0 (+ sum (car lst)))
+	     (i 0 (+ i 1))
+	     (lst L (cdr lst)))
+	    ((or (null? lst)
+		 (> i 10))
+	     sum)
+	  (set-cdr! (cdr L) L)))
+      16)
+
+;;; optimizer checks
+(num-test (let ((x 0)) (do ((i 1.0 (+ i 1))) ((> i 3)) (set! x (+ x i))) x) 6.0)
+(num-test (let ((x 0)) (do ((i 1 4)) ((> i 3)) (set! x (+ x i))) x) 1)
+(num-test (let ((x 0)) (do ((i 1 ((if #t + -) i 1))) ((> i 3)) (set! x (+ x i))) x) 6)
+(num-test (let ((x 0)) (do ((i 1 (+))) ((> i 0)) (set! x (+ x i))) x) 0)
+(let () (define (f12345) (let ((x 0)) (do ((i 1 (+))) ((> i 0)) (set! x (+ x i))) x) 0) (f12345) (f12345))
+(num-test (let ((x 0)) (do ((i 1 (+ 1))) ((> i 0)) (set! x (+ x i))) x) 0)
+(num-test (let ((x 0)) (do ((i 1 (+ 1 i 2))) ((> i 10)) (set! x (+ x i))) x) 22)
+(num-test (let ((x 0)) (do ((i 1 (+ 1.0 i))) ((> i 3)) (set! x (+ x i))) x) 6.0)
+(num-test (let ((x 0)) (do ((i 1 (+ 1 pi))) ((> i 2)) (set! x (+ x i))) x) 1)
+(num-test (do ((i 0 (+ 1 pi))) ((> i 2) i)) (+ pi 1.0))
+(num-test (let ((x 0)) (do ((i 0 (+ i 8796093022208))) ((> i 0)) (set! x (+ x i))) x) 0)
+(num-test (let ((x 0)) (do ((i 0 (+ i 8796093022208))) ((> i 17592186044416)) (set! x (+ x i))) x) (+ (expt 2 44) (expt 2 43)))
+(num-test (let ((x 0)) (do ((i 1 (* i 2))) ((> i 10)) (set! x (+ x i))) x) 15)
+(num-test (do ((i 0 (+ i 1))) ((> i 2) i) (set! i (+ i 3.0))) 4.0)
+(num-test (let ((x 0)) (let ((add +)) (do ((i 0 (add i 1))) ((< i -2)) (set! add -) (set! x (+ x i)))) x) -3)
+(num-test (let ((equals =) (x 0)) (do ((i 0 (+ i 1))) ((equals i 3) x) (set! x (+ x i)))) 3)
+(num-test (let ((equals =) (x 0)) (do ((i 0 (+ i 1))) ((equals i 3) x) (set! x (+ x i)) (set! i (* i 1.0)))) 3.0)
+(num-test (let ((equals =) (x 0)) (do ((i 0 (+ i 1))) ((equals i 3) x) (set! x (+ x i)) (set! equals >))) 6)
+(num-test (let ((equals =) (x 0)) (do ((i 0 (+ i 1))) ((equals i 3) x) (set! x (+ x i)) (set! equals =))) 3)
+(num-test (let ((equals =) (x 0)) (do ((i 0 (+ i 1))) ((equals i 3) (set! x (+ x 1)) x) (set! x (+ x i)) (set! equals =))) 4)
+(num-test (do ((i 0 (+ i 1))) ((> i 3) i) (set! i (expt 2 60))) (+ 1 (expt 2 60)))
+(num-test (let ((x 0) (n 3)) (do ((i 0 (+ i 1))) ((= i n) x) (set! x (+ x i)))) 3)
+(num-test (let ((x 0) (n 3)) (do ((i 0 (+ i 1))) ((= 1 1) x) (set! x (+ x i)))) 0)
+(num-test (let ((x 0) (n (expt 2 50))) (do ((i 0 (+ i n))) ((= i (expt 2 51)) x) (set! x (+ x i)))) (expt 2 50))
+(num-test (let ((x 0) (n 31.0)) (do ((i 0 (+ i 1))) ((= i n) x) (set! x (+ x i)) (set! n 3))) 3)
+(num-test (let ((x 0)) (do ((i 0 (+ i 1/2))) ((= i 3) x) (set! x (+ x i)))) 15/2)
+(num-test (let ((x 0)) (do ((i 0 (+ i 1+i))) ((> (magnitude i) 3) x) (set! x (+ x i)))) 3+3i)
+(num-test (call-with-exit (lambda (r) (do () () (r 1)))) 1)
+(num-test (call-with-exit (lambda (r) (do () (#t 10 14) (r 1)))) 14)
+(num-test (do ((i 0 (+ i 1))) (#t 10 12)) 12)
+(num-test (do ((i 0 (+ i 1))) ((= i 3) i)) 3)
+(num-test (do ((i 0 (+ i 1))) ((> i 3) i)) 4)
+(num-test (do ((i 0 (+ i 1))) ((< i 3) i)) 0)
+(num-test (do ((i 0 (+ i 1))) ((<= i 3) i)) 0)
+(num-test (do ((i 0 (+ i 1))) ((>= i 3) i)) 3)
+(num-test (do ((i 0 (+ i 1))) ((>= 3 i) i)) 0)
+(num-test (do ((i 0 (+ i 1))) ((> 3 i) i)) 0)
+(num-test (do ((i 0 (+ i 1))) ((< 3 i) i)) 4)
+(num-test (do ((i 0 (+ i 1))) ((<= 3 i) i)) 3)
+(num-test (let ((n 3)) (do ((i 0 (+ i 1))) ((> i n) i))) 4)
+(num-test (let ((n 3)) (do ((i 0 (+ i 1))) ((< n i) i))) 4)
+(num-test (do ((i 10 (- i 1))) ((= i 0) i)) 0)
+(num-test (do ((i 10 (- 1 i))) ((< i 0) i)) -9)
+(num-test (do ((i 10 (- i 3))) ((< i 0) i)) -2)
+(let () (define (hi) (do ((i 1 (+ 1 i))) ((= i 1) i))) (hi) (test (hi) 1))
+(let () (define (hi) (do ((i 10 (+ i 1))) ((= i 10) i) (abs i))) (hi) (test (hi) 10))
+(let ((sum 0)) (define (hi) (do ((i 10 (+ i 1))) ((= i 10) i) (set! sum (+ sum i)))) (hi) (test (hi) 10))
+(let () (define (hi a) (do ((i a (+ i 1))) ((= i a) i) (+ a 1))) (hi 1) (test (hi 1) 1))
+(let () (define (lcopy x) (length x)) (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (lcopy '(1 2)))) (test (f) #t)) ; safe_dotimes_step_o
+(let ()
+  (define (fx)
+    (let ((iter (make-iterator #(1 2 3))))
+      (do () ((or (string? (iterate iter)) (iterator-at-end? iter)) (not (iterator-at-end? iter))))))
+  (test (fx) #f))
+(let ()
+  (define (fx1)
+    (let ((iter (make-iterator #(1 2 3))))
+      (do () ((or (= (iterate iter) 2) (iterator-at-end? iter)) (iterate iter)))))
+  (test (fx1) 3))
+(let ()
+  (define (fx2)
+    (let ((iter (make-iterator #(1 2 3))))
+      (do () ((= (iterate iter) 2) (iterate iter)))))
+  (test (fx2) 3))
+(let ()
+  (define (fdo1)
+    (let ((abs (lambda (x) (+ x 1)))
+	  (x '(1 2 3)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 1))
+	(if (not (equal? (map abs x) '(2 3 4)))
+	    (format () "fdo1 map case: ~S" (map abs x))))
+      (do ((i 0 (+ i 1)))
+	  ((= i 1))
+	(if (not (equal? (for-each abs x) #<unspecified>))
+	    (display "fdo1 for-each case")))))
+  (define (fdo2)
+    (let ((abs (lambda (x y) (= x y)))
+	  (x '(1 2 3)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 1))
+	(if (not (member 2 x abs))
+	    (display "fdo2 member case")))))
+  (define (fdo3)
+    (let ((abs (lambda (x y) (= x y)))
+	  (x '((1 a) (2 b) (3 c))))
+      (do ((i 0 (+ i 1)))
+	  ((= i 1))
+	(if (not (assoc 2 x abs))
+	    (display "fdo3 assoc case")))))
+  (define (fdo4)
+    (let ((abs (lambda (x y) (> x y)))
+	  (x (list 1 2 3)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 1))
+	(if (not (equal? (sort! x abs) '(3 2 1)))
+	    (display "fdo4 sort! case")))))
+  (fdo1)
+  (fdo2)
+  (fdo3)
+  (fdo4))
+
+;; next 7 are probing 2 bugs in opt_cell_do
+(let ()
+  (define (ho1)
+    (let ((x 0) (i 3))
+      (do ((i i (+ i 1))) ((= i 6))
+	(do ((z 12) (i i (+ i 1))) ((= i 7)) (set! x (+ x i))))
+      x))
+  (test (ho1) 44))
+
+(let ()
+  (define (ho2)
+    (let ((x 0) (i 3))
+      (do ((i i (+ i 1))) ((= i 6))
+	(do ((j i (+ j 1))) ((= j 7)) (set! x (+ x j))))
+      x))
+  (test (ho2) 44))
+
+(let ()
+  (define (ho3)
+    (let ((x 0) (k 3))
+      (do ((i k (+ i 1))) ((= i 6))
+	(do ((j i (+ j 1))) ((= j 7)) (set! x (+ x j))))
+      x))
+  (test (ho3) 44))
+
+(let ()
+  (define (ho4)
+    (let ((x (vector 0)) (k 3))
+      (do ((i k (+ i 1))) ((= i 6))
+	(do ((j i (+ j 1))) ((= j 7)) (vector-set! x 0 (+ (vector-ref x 0) j))))  ; also int-vector, list, but not car!
+      x))
+  (test (ho4) #(44)))
+
+(let ()
+  (define (ho5)
+    (let ((x (vector 0)) (k 3))
+      (let loop1 ((i k))
+	(when (< i 6) (do ((j i (+ j 1))) ((= j 7)) (vector-set! x 0 (+ (vector-ref x 0) j)))
+	  (loop1 (+ i 1))))
+      x))
+  (test (ho5) #(44)))
+
+(let ()
+  (define (ho6)
+    (let ((x (vector 0)) (k 3))
+      (let loop1 ((i k))
+	(when (< i 6)
+	  (let loop2 ((j i))
+	    (when (< j 7)
+	      (vector-set! x 0 (+ (vector-ref x 0) j))
+	      (loop2 (+ j 1))))
+	  (loop1 (+ i 1))))
+      x))
+  (test (ho6) #(44)))
+
+(let ()
+  (define (ho7)
+    (let ((x (list 0)) (k 3))
+      (do ((i k (+ i 1))) ((= i 6))
+	(do ((j i (+ j 1))) ((= j 7)) (set-car! x (+ (car x) j))))
+      x))
+  (test (ho7) '(44)))
+
+(let ()
+  (define (f6 x)
+    (let ((j 32))
+      (let ((k 20))
+        (if (= x 1) (define j 12))
+        (do ((i 0 (+ i 1)))
+  	    ((>= i 3) j)
+  	  (display i #f)))))
+  (test (f6 0) 32)
+  (test (f6 1) 12)) ; fx_W bug -> 32
+
+(let ()
+  ;; opt_do_any
+  (define (h1)
+    (let ((sum 0)
+	  (lsum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 10))
+	(do ((k 0 (+ k 1)))
+	    ((= k 8) (set! sum (+ sum lsum)))
+	  (set! lsum (+ lsum k))))
+      sum))
+  (test (h1) 1540)
+
+  (define (h2)
+    (let ((sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 10))
+	(do ((lsum 0)
+	     (k 0 (+ k 1)))
+	    ((= k 8) (set! sum (+ sum lsum)))
+	  (set! lsum (+ lsum k))))
+      sum))
+  (test (h2) 280)
+
+  (define (h3)
+    (do ((sum 0)
+	 (i 0 (+ i 1)))
+	((= i 10) sum)
+      (do ((lsum 0)
+	   (k 0 (+ k 1)))
+	  ((= k 8) (set! sum (+ sum lsum)))
+	(set! lsum (+ lsum k)))))
+  (test (h3) 280)
+
+  (define (h4)
+    (do ((sum 0)
+	 (i 0 (+ i 1)))
+	((= i 10) (set! sum (/ sum 2)) sum)
+      (do ((lsum 0)
+	   (k 0 (+ k 1)))
+	  ((= k 8) (set! sum (+ sum lsum)))
+	(set! lsum (+ lsum k)))))
+  (test (h4) 140)
+
+  (define (f1)
+    (let ((sum #i(0)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 10) sum)
+	(case (remainder i 3)
+	  ((0) (int-vector-set! sum 0 (+ (int-vector-ref sum 0) 1)))
+	  ((1) (int-vector-set! sum 0 (+ (int-vector-ref sum 0) 2)))
+	  (else (int-vector-set! sum 0 (+ (int-vector-ref sum 0) 3)))))))
+  (test (f1) #i(19))
+
+  (define (f2)
+    (let ((sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 10) sum)
+	(case (remainder i 3)
+	  ((0) (set! sum (+ sum 1)))
+	  ((1) (set! sum (+ sum 2)))
+	  (else (set! sum (+ sum 3))))))) ; 19
+  (test (f2) 19)
+
+  (define (f3)
+    (let ((sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 10) sum)
+	(case (remainder i 3)
+	  ((0) (set! sum (+ sum 2)) (set! sum (- sum 1)))
+	  ((1) (set! sum (+ sum 2)))
+	  (else (set! sum (+ sum 3))))))) ; 19
+  (test (f3) 19)
+
+  (define (f4)
+    (let ((sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 10) sum)
+	(case (remainder i 3)
+	  ((0) (set! sum (+ sum 1)))
+	  ((1) (set! sum (+ sum 2)))
+	  ((3) (set! sum (+ sum 3))))))) ; 10
+  (test (f4) 10)
+
+  (define (f41)
+    (let ((sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 10) sum)
+	(case (remainder i 3)
+	  ((0) (set! sum (+ sum 1)))
+	  ((1) (set! sum (+ sum 2)))
+	  ((2) (set! sum (+ sum 3))))))) ; 19
+  (test (f41) 19)
+
+  (define (f5)
+    (let ((res 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 10) res)
+	(case i
+	  ((0 1 2 3 4 5 6) (set! res 1))
+	  ((7 8 9) (set! res 123))))))  ; 123
+  (test (f5) 123)
+
+  (define (f6)
+    (let ((res 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 10) res)
+	(set! res (case i
+		    ((0 1 2 3 4 5 6) 1)
+		    ((7 8 9) 2))))))  ; 2
+  (test (f6) 2)
+
+  (define (f7)
+    (let ((res 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 10) res)
+	(set! res (case i
+		    ((0 1 2 3 4 5 6) 1)
+		    ((7 8) 2))))))  ; #<unspecified>
+  (test (f7) #<unspecified>)
+
+  (define (f8)
+    (let ((res 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 10) res)
+	(set! res (+ (case i
+		       ((0 1 2 3 4 5 6) 1)
+		       (else 2))
+		     123))))) ; 125
+  (test (f8) 125)
+
+  (let () ; opt_cond_1
+    (define (cd1)
+      (let ((v (make-vector 6 #f)))
+	(do ((i 0 (+ i 1)))
+	    ((= i 6) v)
+          (vector-set! v i (cond ((< i 3) (+ i 10)))))))
+    (test (cd1) #(10 11 12 #<unspecified> #<unspecified> #<unspecified>))
+
+    (define (cd2 x) ; opt_cond_2
+      (let ((y 0)
+	    (z 1.0))
+	(do ((i 0 (+ i 1)))
+	    ((= i 3) y)
+	  (cond ((= x z)
+		 (set! y (+ y 1)))
+		(else 3)))))
+    (test (cd2 1.0) 3)
+    (test (cd2 0.0) 0)
+
+    (define (cd3) ; opt_cond
+      (let ((v (make-vector 6 #f)))
+	(do ((i 0 (+ i 1)))
+	    ((= i 6) v)
+          (vector-set! v i (cond ((< i 3)
+				  (+ i 10))
+				 ((>= i 3)
+				  (- i 10)))))))
+    (test (cd3) #(10 11 12 -7 -6 -5))
+
+    (define (cd4) ; opt_cond
+      (let ((v (make-vector 6 #f)))
+	(do ((i 0 (+ i 1)))
+	    ((= i 6) v)
+          (vector-set! v i (cond ((< i 2)
+				  (+ i 10))
+				 ((= i 2)
+				  123)
+				 ((> i 3)
+				  (- i 10)))))))
+    (test (cd4) #(10 11 123 #<unspecified> -6 -5)))
+
+  (define (do1)
+    (let ((v (make-int-vector 10)))
+      (do ((k 0 (+ k 1)))
+	  ((= k 1)
+	   (int-vector-ref v 0))
+	(do ((i 0 (+ i 1))
+	     (j 0 (+ j 2)))
+	    ((= i 10)
+	     (set! j (* j 2))
+	     (int-vector-set! v 0 (+ i j)))
+	  (int-vector-set! v 1 1)
+	  (int-vector-set! v 0 0)))))
+  (test (do1) 50)
+
+  (define (do2)
+    (let ((v (make-int-vector 10)))
+      (do ((k 0 (+ k 1)))
+	  ((= k 1)
+	   (int-vector-ref v 0))
+	(do ((i 0 (+ i 1))
+	     (j 0 (+ j 2))
+	     (z 32))
+	    ((= i 10)
+	     (set! j (* j 2))
+	     (int-vector-set! v 0 (+ i j z)))
+	  (int-vector-set! v 1 1)
+	  (int-vector-set! v 0 0)))))
+  (test (do2) 82)
+
+  (define (do3)
+    (let ((v (make-int-vector 10)))
+      (do ((k 0 (+ k 1)))
+	  ((= k 1)
+	   (int-vector-ref v 0))
+	(do ((i 0 (+ i 1))
+	     (z 32)
+	     (j 0 (+ j 2)))
+	    ((= i 10)
+	     (set! j (* j 2))
+	     (int-vector-set! v 0 (+ i j z)))
+	  (int-vector-set! v 1 1)
+	  (int-vector-set! v 0 0)))))
+  (test (do3) 82))
+
+(let () (define (fdo5) (do ((si () '())) ((null? si) 'mi))) (test (fdo5) 'mi))
+(let () (define (fdo5) (do ((si '() '())) ((null? si) 'mi))) (test (fdo5) 'mi))
+(let () (define (fdo5) (do ((si () ())) ((null? si) 'mi))) (test (fdo5) 'mi))
+(let () (define (fdo5) (do ((si () ())) ((null? si) 'mi))) (test (fdo5) 'mi))
+
+(let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (if x (set! y (+ y 1)))))) (test (f1 #t) 3)) ; b_s -> if_bp
+(let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (if (not x) (set! y (+ y 1)))))) (test (f1 #f) 3)) ; b_s -> if_nbp
+(let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond (x (set! y (+ y 1))) (else 3))))) (test (f1 #t) 3)) ; b_s
+(let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((zero? x) (set! y (+ y 1))) (else 3))))) (test (f1 0) 3)) ; b_i_s and b_t
+(let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((positive? x) (set! y (+ y 1))) (else 3))))) (test (f1 1.0) 3)) ; b_d_s
+(let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((positive? (car x)) (set! y (+ y 1))) (else 3))))) (test (f1 '(1)) 3)) ; b_p_f
+(let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((= x 1) (set! y (+ y 1))) (else 3))))) (test (f1 1) 3)) ; b_ii_sc
+(let () (define (f1 x) (let ((y 0) (z 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((= x z) (set! y (+ y 1))) (else 3))))) (test (f1 0) 3)) ; b_ii_ss
+(let () (define (f1 x) (let ((y 0) (z '(0))) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((= x (car z)) (set! y (+ y 1))) (else 3))))) (test (f1 0) 3)) ; b_pp_sfo
+(let () (define (f1 x) (let ((y 0) (z '(0))) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((= (car z) x) (set! y (+ y 1))) (else 3))))) (test (f1 0) 3)) ; b_pi_fs
+(let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((= x 1.0) (set! y (+ y 1))) (else 3))))) (test (f1 1.0) 3)) ; b_dd_sc
+(let () (define (f1 x) (let ((y 0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((= x z) (set! y (+ y 1))) (else 3))))) (test (f1 1.0) 3)) ; b_dd_ss
+
+(let () (define (f1) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ y 1))))) (test (f1) 3)) ; i_ii_sc set_i_i_f
+(let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ y z))))) (test (f1) 3)) ; i_ii_ss
+(let () (define (f1) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y 1)))) (test (f1) 1)) ; i_c
+(let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y z)))) (test (f1) 1)) ; i_s
+(let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (floor z))))) (test (f1) 1)) ; i_i_s
+(let () (define (f1) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (floor 1.1))))) (test (f1) 1)) ; i_d_c
+(let () (define (f1) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (floor 1))))) (test (f1) 1)) ; i_i_c
+(let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (floor (* 1.2 z)))))) (test (f1) 1)) ; i_d_f
+(let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (floor (* 1 z)))))) (test (f1) 1)) ; i_ii_cs i_i_f set_i_i_f
+(let () (define (f1) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ 1 1))))) (test (f1) 2)) ; i_ii_cc
+(let () (define (f1) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ 1 (abs 1)))))) (test (f1) 2)) ; i_ii_cf
+(let () (define (f1) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ (abs 1) 1))))) (test (f1) 2)) ; i_ii_fc
+(let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ z (abs 1)))))) (test (f1) 2)) ; i_ii_sf
+(let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ (abs 1) (abs 1)))))) (test (f1) 2)) ; i_ii_ff
+(let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ z 1 z 1))))) (test (f1) 4)) ; i_add2
+(let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ z 1 z 1 z 1))))) (test (f1) 6)) ; i_add_any_f
+(let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (* z 1 z 1))))) (test (f1) 1)) ; i_mul2
+(let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (* z 1 z 1 z 1))))) (test (f1) 1)) ; i_multiply_any_f
+
+(let () (define (f1) (let ((y 0.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ y 1.0))))) (test (f1) 3.0))  ; d_dd_sc set_d_d_f
+(let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ y z))))) (test (f1) 3.0)) ; d_dd_ss
+(let () (define (f1) (let ((y 0.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y 1.0)))) (test (f1) 1.0)) ; d_c
+(let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y z)))) (test (f1) 1.0)) ; d_s
+(let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (abs z))))) (test (f1) 1.0)) ; d_d_s
+(let () (define (f1) (let ((y 0.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (abs 1.1))))) (test (f1) 1.1)) ; d_d_c
+(let () (define (f1) (let ((y 0.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (abs 1))))) (test (f1) 1.0)) ; d_d_c
+(let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (abs (* 1.2 z)))))) (test (f1) 1.2)) ;d_dd_cs
+(let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (abs (* 1 z)))))) (test (f1) 1.0)) ; d_dd_cs
+(let () (define (f1) (let ((y 0.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ 1.0 1.0))))) (test (f1) 2.0)) ; d_dd_cc
+(let () (define (f1) (let ((y 0.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ 1.0 (abs 1.0)))))) (test (f1) 2.0)) ; d_dd_cf
+(let () (define (f1) (let ((y 0.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ (abs 1.0) 1.0))))) (test (f1) 2.0)) ; d_d_c d_dd_fc
+(let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ z (abs 1.0)))))) (test (f1) 2.0)) ; d_dd_sf
+(let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ (abs 1.0) (abs 1.0)))))) (test (f1) 2.0)) ; d_dd_ff
+(let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ z 1.0 z 1.0))))) (test (f1) 4.0)) ; d_dddd_ffff
+(let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ z 1.0 z 1.0 z 1.0))))) (test (f1) 6.0)) ; d_add_any_f
+(let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (* z 1.0 z 1.0))))) (test (f1) 1.0)) ; d_dddd_ffff
+(let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (* z 1.0 z 1.0 z 1.0))))) (test (f1) 1.0)) ; d_multiply_any_f
+
+(let () (define (f1) (let ((y #\b)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y #\a)))) (test (f1) #\a))  ; p_c set_p_p_f
+(let () (define (f1) (let ((y #\b) (z 0)) (do ((i 0 (+ i 1))) ((= i 3) z) (set! z (char->integer y))))) (test (f1) 98))  ; p_s i_p_f set_i_i_f
+(let () (define (f1) (let ((y #\b) (z 98)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (integer->char z))))) (test (f1) #\b))  ; p_p_s
+(let () (define (f1) (let ((y (list 2)) (z '(1))) (do ((i 0 (+ i 1))) ((= i 3) y) (list-set! y 0 (car z))))) (test (f1) '(1)))  ; i_c p_pip_sff
+(let () (define (f1) (let ((y (list 2)) (z 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (list-set! y z (car '(1)))))) (test (f1) '(1)))  ; p_pip_ssf
+(let () (define (f1) (let ((y 2) (z 0) (x '(1))) (do ((i 0 (+ i 1))) ((= i 3) x) (set! x (list y z))))) (test (f1) '(2 0)))  ; p_cf_ss
+(let () (define (f1) (let ((y 2) (z 0) (x '(1))) (do ((i 0 (+ i 1))) ((= i 3) x) (set! x (list 0 0))))) (test (f1) '(0 0)))  ; p_cf_ff
+(let () (define (f1) (let ((y 2) (z 0) (x '(1))) (do ((i 0 (+ i 1))) ((= i 3) x) (set! x (list y 0))))) (test (f1) '(2 0)))  ; p_cf_sf
+(let () (define (f1) (let ((y 2) (z 0) (x '(1))) (do ((i 0 (+ i 1))) ((= i 3) x) (set! x (list 2 z))))) (test (f1) '(2 0)))  ; p_cf_fs
+
+(let () (define (f1) (let ((y 0) (z 1.1)) (do ((i 0 (+ i 1))) ((= i 3) y) (if (not (= (floor z) 1)) (display "oops"))))) (test (f1) 0)) ; b_ii_fc p_p_c if_nbp
+(let () (define (f1) (let ((y 0) (z 1.1)) (do ((i 0 (+ i 1))) ((= i 3) y) (if (not (= (+ z z) 2.2)) (display (+ z z)))))) (test (f1) 0)) ; p_p_f b_dd_fc d_dd_ss p_pp_ss
+(let () (define (f1) (let ((y 0) (z 1.1)) (do ((i 0 (+ i 1))) ((= i 3) y) (if (= (+ z 1) 2.2) (display (+ z 1)))))) (test (f1) 0)) ; if_bp p_pp_sc d_dd_sc
+(let () (define (f1) (let ((y 0) (z 1.1)) (do ((i 0 (+ i 1))) ((= i 3) y) (when (= (+ 1 z) z) (display (+ 1 z)))))) (test (f1) 0)) ; when_p p_pp_cs b_dd_fs
+(let () (define (f1) (let ((y 0) (z 1.1)) (do ((i 0 (+ i 1))) ((= i 3) y) (unless (= (+ z z 1) 3.2) (display (+ z z 1)))))) (test (f1) 0)) ; unless_p p_cf_ppp d_ddd_ssf
+(let () (define (f1) (let ((y 0) (z 1.1)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((= (+ z (- y)) 2.1) (display (+ z (- y)))))))) (test (f1) 0)) ; cond p_cf_s p_pp_sf
+
+;;; check an optimizer bug
+(define _do_call_cc_end_ 1)
+(define (call-cc-do-test)
+  (do ((i 0 (+ i 1)))
+      ((= i _do_call_cc_end_))
+    (let ((ctr 0))
+      (call/cc (lambda (exit)
+		 (if (> 3 2)
+		     (let ()
+		       (exit ctr)
+		       (set! ctr 100) ctr)
+		     #f)))))
+  (do ((i 0 (+ 1 i)))
+      ((= i _do_call_cc_end_))
+    (let ((ctr 0))
+      (call/cc (lambda (exit)
+		 (if (> 3 2)
+		     (let ()
+		       (exit ctr)
+		       (set! ctr 100) ctr)
+		     #f))))))
+
+(call-cc-do-test)
+
+;;; and another
+(let()
+  (define (hi)
+    (let ((checker (lambda (nlst v)
+		     (let ((chr (car nlst)))
+		       (if (not (char-alphabetic? chr))
+			   (if (not (char=? v chr))
+			       (format #t ";(char-downcase #\\~A) -> ~A" chr v))
+			   (if (and (not (char=? chr v))
+				    (not (char=? chr (char-upcase v))))
+			       (format #t ";(char-downcase #\\~A) -> ~A~%" chr v))))))
+	  (result 0))
+      (let ((try 0))
+	(do ((i 0 (+ i 1)))
+	    ((> i 10))
+	  (set! try i)
+	  (checker '(#\a) #\a)
+	  (checker '(#\a) #\a)))))
+  (test (hi) #t))
+
+
+(define (__a-func__ a)
+  (format #t ";oops called first a-func by mistake: ~A~%" a)
+  (if (> a 0)
+      (__a-func__ (- a 1))))
+
+(define (__a-func__ a)
+  (if (> a 0)
+      (__a-func__ (- a 1))))
+
+(__a-func__ 3)
+
+(define (__c-func__ a)
+  (format #t ";oops called first __c-func__ by mistake: ~A~%" a)
+  (if (> a 0)
+      (__c-func__ (- a 1))))
+
+(let ()
+  (define (__c-func__ a)
+    (if (> a 0)
+	(__c-func__ (- a 1))))
+
+  (__c-func__ 3))
+
+;;; more optimizer checks
+(let ()
+  (define (do-test-1) (do ((i 0 (+ i 1))) ((= i 10)) (display i)))
+  (test (with-output-to-string (lambda () (do-test-1))) "0123456789"))
+
+(let ()
+  (define (do-test-2) (do ((i 0 (+ 1 i))) ((= i 10)) (display i)))
+  (test (with-output-to-string (lambda () (do-test-2))) "0123456789"))
+
+(let ((start 0))
+  (define (do-test-3) (do ((i start (+ i 1))) ((= i 10)) (display i)))
+  (test (with-output-to-string (lambda () (do-test-3))) "0123456789"))
+
+(let ((start 0) (end 10))
+  (define (do-test-4) (do ((i start (+ i 1))) ((= i end)) (display i)))
+  (test (with-output-to-string (lambda () (do-test-4))) "0123456789"))
+
+(let ((start 0) (end 10))
+  (define (do-test-5) (do ((i start (+ i 1))) ((= end i)) (display i)))
+  (test (with-output-to-string (lambda () (do-test-5))) "0123456789"))
+
+(let ()
+  (define (do-test-6) (do ((i 0 (+ i 1))) ((= i 10)) (let ((k i)) (display k))))
+  (test (with-output-to-string (lambda () (do-test-6))) "0123456789"))
+
+(let ()
+  (define (do-test-7) (do ((i 0 (+ i 2))) ((= i 20)) (display (/ i 2))))
+  (test (with-output-to-string (lambda () (do-test-7))) "0123456789"))
+
+(let ()
+  (define (do-test-8) (do ((i 0 (+ i 1))) ((= i 10)) (let ((a (+ 1 2))) (display #\0))))
+  (test (with-output-to-string (lambda () (do-test-8))) "0000000000"))
+
+(let ()
+  (define (do-test-9) (do ((i 0 (+ i 1))) ((= i 10)) (let ((j 0)) (set! j i) (display j))))
+  (test (with-output-to-string (lambda () (do-test-9))) "0123456789"))
+
+(let ()
+  (define (do-test-10) (do ((i 0 (+ i 1))) ((= i 10)) (let ((j 0)) (display i))))
+  (test (with-output-to-string (lambda () (do-test-10))) "0123456789"))
+
+(let ()
+  (define (do-test-11) (do ((i 0 (+ i 1))) ((= i 10)) (let ((j 0)) (set! j 32) (display i))))
+  (test (with-output-to-string (lambda () (do-test-11))) "0123456789"))
+
+(let ()
+  (define (do-test-12) (do ((i 0 (+ i 1))) ((= i 10)) (let ((j i)) (display j))))
+  (test (with-output-to-string (lambda () (do-test-12))) "0123456789"))
+
+(let ()
+  (define (do-test-13) (do ((i 0 (+ i 1))) ((= i 5)) (let ((j (+ i 1))) (let ((i j)) (display (- i 1))))))
+  (test (with-output-to-string (lambda () (do-test-13))) "01234"))
+
+(let ()
+  (define (do-test-14) (do ((i 0 (+ i 1))) ((= i 10)) (set! i (+ i 1)) (display i)))
+  (test (with-output-to-string (lambda () (do-test-14))) "13579"))
+
+(let ((lst ()))
+  (define (do-test-15) (set! lst ()) (do ((i 0 (+ i 1))) ((= i 10)) (set! lst (cons i lst))) lst)
+  (test (do-test-15) '(9 8 7 6 5 4 3 2 1 0)))
+
+(let ((lst ()))
+  (define (do-test-15a) (set! lst ()) (do ((i 0 (+ i 1))) ((= i 10)) (set! lst (append (list i) lst))) lst)
+  (test (do-test-15a) '(9 8 7 6 5 4 3 2 1 0)))
+
+(let ((lst ()))
+  (define (do-test-15b) (set! lst ()) (do ((i 0 (+ i 1))) ((= i 10)) (set! lst (list i lst))) lst)
+  (test (do-test-15b) '(9 (8 (7 (6 (5 (4 (3 (2 (1 (0 ()))))))))))))
+
+(let ((lst (list 9 8 7 6 5 4 3 2 1 0)))
+  (define (do-test-16) (do ((i 0 (+ i 1))) ((= i 10)) (list-set! lst i i)) lst)
+  (test (do-test-16) '(0 1 2 3 4 5 6 7 8 9)))
+
+(let ((lst ()))
+  (define (do-test-17) (set! lst ()) (do ((i 0 (+ i 1))) ((= i 10)) (let ((j i)) (set! lst (cons j lst)))) lst)
+  (test (do-test-17) '(9 8 7 6 5 4 3 2 1 0)))
+
+(let ((lst ()))
+  (define (do-test-17a) (set! lst ()) (do ((i 0 (+ i 1))) ((= i 10)) (let ((j (min i 100))) (set! lst (cons j lst)))) lst)
+  (test (do-test-17a) '(9 8 7 6 5 4 3 2 1 0)))
+
+(let ()
+  (define (do-test-18) (do ((i 0 (+ i 1)) (j 0)) ((= i 10) j) (if (= i 3) (set! j i))))
+  (test (do-test-18) 3))
+
+(let ((end 10))
+  (define (do-test-19) (do ((i 0 (+ i 1))) ((= i end)) (display i)))
+  (test (with-output-to-string (lambda () (do-test-19))) "0123456789"))
+
+(let ((end 10))
+  (define (do-test-19A) (do ((i 0 (+ 1 i))) ((= end i)) (display i)))
+  (test (with-output-to-string (lambda () (do-test-19A))) "0123456789"))
+
+(let ((end 10))
+  (define (do-test-20) (do ((i 0 (+ i 1))) ((= i end)) (set! end 8) (display i)))
+  (test (with-output-to-string (lambda () (do-test-20))) "01234567"))
+
+(let ((end 10))
+  (define (do-test-20A) (do ((i 0 (+ 1 i))) ((= end i)) (set! end 8) (display i)))
+  (test (with-output-to-string (lambda () (do-test-20A))) "01234567"))
+
+(let ()
+  (define (do-test-21) (do ((i 0 (+ i 1))) ((= i 3)) (with-let (rootlet) (+ 1 2))))
+  (do-test-21))
+
+(let ((v (vector 0 0 0)))
+  (define (hi a) (do ((i 0 (+ i 1))) ((> i a)) (vector-set! v i 1))) (hi 2)
+  (test v (vector 1 1 1)))
+
+(let () ; dotimes_c_c case can't involve set so we use write-char
+  (define (hi a)
+    (do ((i 0 (+ i 1)))
+	((= i a))
+      (write-char #\a)))
+  (with-output-to-file tmp-output-file
+    (lambda ()
+      (hi 3)))
+  (let ((str (with-input-from-file tmp-output-file
+	       (lambda ()
+		 (read-line)))))
+    (test str "aaa")))
+
+(let ()
+  (define (do-test-22) (do ((i 0 (+ i 1))) ((= i 10)) (display i)))
+  (test (with-output-to-string (lambda () (do-test-22))) "0123456789"))
+
+(let ((v (make-list 10)))
+  (define (do-test-23) (do ((i 0 (+ i 1))) ((= i 10)) (list-set! v i i)))
+  (do-test-23)
+  (test v '(0 1 2 3 4 5 6 7 8 9)))
+
+;;; safe simple h_safe_c_s
+(let ()
+  (define (do-test-24) (do ((i 0 (+ i 1))) ((> i 10)) (display i)))
+  (test (with-output-to-string (lambda () (do-test-24))) "012345678910"))
+
+;;; safe simple h_safe_c_ss
+(let ()
+  (define (do-test-25 p) (do ((i 0 (+ i 1))) ((> i 10)) (display i p)))
+  (test (call-with-output-string (lambda (p) (do-test-25 p))) "012345678910"))
+
+;;; safe simple h_safe_c_c
+(let ()
+  (define (do-test-26) (do ((i 0 (+ i 1))) ((> i 10)) (display 0)))
+  (test (with-output-to-string (lambda () (do-test-26))) "00000000000"))
+
+;;; safe simple h_safe_c_opsq_s
+(let ()
+  (define (do-test-27 p) (do ((i 0 (+ i 1))) ((> i 10)) (display (- i) p)))
+  (test (call-with-output-string (lambda (p) (do-test-27 p))) "0-1-2-3-4-5-6-7-8-9-10"))
+
+(let ()
+  (define (do-test-22 i o) (catch #t (lambda () (do () () (write-char (read-char i) o))) (lambda err (get-output-string o))))
+  (test (call-with-output-string (lambda (out) (call-with-input-string "0123" (lambda (in) (do-test-22 in out))))) "0123"))
+
+;;; safe_dotimes_step coverage
+(let ()
+  (define (fv-test len) (let ((fv (make-float-vector len))) (if (not (= (length fv) len)) #f fv)))
+  (define (fv) (do ((k 0 (+ k 1))) ((= k 2)) (fv-test k) (fv-test k)))
+  (fv))
+
+;;; the do spec is ambiguous.  Guile and s7 disagree on:
+(let ((v (vector #f #f)))
+  (do ((i 0 (+ i 1)))
+      ((= i 2))
+    (vector-set! v i (lambda () i)))
+  (test ((vector-ref v 0)) 2)) ; s7 2, Guile 0
+;;; In s7, the lambda "i" is a delayed reference to the do "i" through
+;;;   the let chain.  In Guile, do has a new let on every iteration!
+(let ((v (vector #f #f)))
+  (do ((i 0))
+      ((>= i 2))
+    (vector-set! v i (lambda () i))
+    (set! i (+ i 1)))
+  (test ((vector-ref v 0)) 2)) ; s7 2, Guile 1
+;;; So the let is recreated at the start of the step section, I guess.
+;;; But Guile's interpretation is inconsistent with the rest of Scheme:
+(let ((v (vector #f #f))
+      (i 0))
+  (for-each (let ((i 0))
+	      (lambda (x)
+		(vector-set! v i (lambda () i))
+		(set! i (+ i 1))))
+	    (list 1 2))
+  (test ((vector-ref v 0)) 2)) ; Guile also 2!
+;;; This is independent of this situation:
+(let ((v (vector #f #f)))
+  (do ((i 0 (+ i 1)))
+      ((= i 2))
+    (vector-set! v i i))
+  (test (vector-ref v 0) 0)) ; 0 in both
+;;; To get Guile's behavior:
+(let ((v (vector #f #f)))
+  (do ((i 0 (+ i 1)))
+      ((= i 2))
+    (vector-set! v i (let ((i i)) (lambda () i))))
+  (test ((vector-ref v 0)) 0))
+
+
+;;; --------------------------------------------------------------------------------
+;;; set!
+;;; --------------------------------------------------------------------------------
+
+(test (let ((a 1)) (set! a 2) a) 2)
+(for-each
+ (lambda (arg)
+   (test (let ((a 0)) (set! a arg) a) arg))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2)))
+
+(test (let ((a 1)) (call/cc (lambda (r) (set! a (let () (if (= a 1) (r 123)) 321)))) a) 1)
+(test (let ((a (lambda (b) (+ b 1)))) (set! a (lambda (b) (+ b 2))) (a 3)) 5)
+(test (let ((a (lambda (x) (set! x 3) x))) (a 1)) 3)
+
+(test (let ((x (vector 1 2 3))) (set! (x 1) 32) x) #(1 32 3))
+(test (let* ((x (vector 1 2 3))
+	     (y (lambda () x)))
+	(set! ((y) 1) 32)
+	x)
+      #(1 32 3))
+(test (let* ((x (vector 1 2 3))
+	     (y (lambda () x))
+	     (z (lambda () y)))
+	(set! (((z)) 1) 32)
+	x)
+      #(1 32 3))
+
+(test (let ((a 1)) (set! a)) 'error)
+(test (let ((a 1)) (set! a 2 3)) 'error)
+(test (let ((a 1)) (set! a . 2)) 'error)
+(test (let ((a 1)) (set! a 1 . 2)) 'error)
+(test (let ((a 1)) (set! a a) a) 1)
+(test (set! "hi" 1) 'error)
+(test (set! 'a 1) 'error)
+(test (set! 1 1) 'error)
+(test (set! (list 1 2) 1) 'error)
+(test (set! (let () 'a) 1) 'error)
+(test (set!) 'error)
+(test (set! #t #f) 'error)
+(test (set! () #f) 'error)
+(test (set! #(1 2 3) 1) 'error)
+(test (set! (call/cc (lambda (a) a)) #f) 'error)
+(test (set! 3 1) 'error)
+(test (set! 3/4 1) 'error)
+(test (set! 3.14 1) 'error)
+(test (set! #\a 12) 'error)
+(test (set! (1 2) #t) 'error)
+(test (set! _not_a_var_ 1) 'error)
+(test (let ((x 3)) (set! _not_a_var5_ x)) 'error)
+(test (do ((i 0 (+ i 1))) ((= i 1)) (set! _not_a_var1_ 1)) 'error)
+(test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (set! _not_a_var4_ 1))) (f) (f)) 'error)
+(test (let () (define (f) (set! _not_a_var2_ 1)) (f)) 'error)
+(test (let () (define (f) (set! _not_a_var3_ 1)) (define (g) (f)) (g)) 'error)
+(test (set! (_not_a_var6_ 1) 2) 'error)
+(test (let ((_not_a_var7_ 1)) (with-let (rootlet) (set! _not_a_var7_ 2))) 'error)
+(test (let ((_not_a_var7_ 1)) (with-let (rootlet) (do ((i 0 (+ i 1))) ((= i 1)) (set! _not_a_var7_ 2)))) 'error)
+(test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (set! (x 0) 1))) (f _not_a_var8_)) 'error)
+(test (set! (_not_a_pws_) 1) 'error)
+(test (let ((x 1)) (set! ((lambda () 'x)) 3) x) 'error)
+(test (let ((x '(1 2 3))) (set! (((lambda () 'x)) 0) 3) x) '(3 2 3))
+(test (let ((x '(1 2 3))) (set! (((lambda () x)) 0) 3) x) '(3 2 3)) ; ??
+(test (let ((x '(1 2 3))) (set! ('x 0) 3) x) '(3 2 3)) ; ???  I suppose that's similar to
+(test (let ((x '((1 2 3)))) (set! ((car x) 0) 3) x) '((3 2 3)))
+(test (let ((x '((1 2 3)))) (set! ('(1 2 3) 0) 32) x) '((1 2 3))) ; this still looks wrong... (expands to (list-set! '(1 2 3) 0 3) I guess)
+
+(test (let ((a (lambda (x) (set! a 3) x))) (list (a 1) a)) 'error)
+(test (let ((a (let ((b 1)) (set! a 3) b))) a) 'error)
+(test (let ((a (lambda () "hi"))) (set! (a) "ho")) 'error)
+(test (let ((a (let ((b 1)) (set! a 3) b))) a) 'error)
+
+;;; (test (set! s7-autoloading 3) 'error) ; s7-autoloading is unbound in (set! s7-autoloading 3) op_set1 79803 (let-set-fallback check in rootlet)
+;;; but this doesn't test the bug -- how to do this in a catch without being in a catch? this doesn't work:
+;;; (let-temporarily (((hook-functions *error-hook*) (list (lambda (hook) (set! (hook 'result) #f))))) (set! s7-autoloading 3))
+;;; this hits it:
+(test (with-let (rootlet) (set! s7-auto #f)) 'error)
+
+(test (catch #t (lambda () (set! (_not_a_pws_) 1)) (lambda (typ info) (apply format #f info))) "unbound variable _not_a_pws_ in (set! (_not_a_pws_) 1)")
+
+(test (catch #t (lambda () (set! (lambda () 1) 4)) (lambda (typ info) (apply format #f info)))
+      "lambda (syntactic) does not have a setter: (set! (lambda () 1) 4)")
+
+(test (catch #t (lambda () (let ((lti (make-iterator (inlet 'a 1 'b 2)))) (set! (lti) 32))) (lambda (typ info) (apply format #f info)))
+      "lti (an iterator) does not have a setter: (set! (lti) 32)")
+
+(test (catch #t (lambda () (let ((x 0)) (define-macro (hi) 'x) (set! (hi) 3) x)) (lambda (typ info) (apply format #f info)))
+      "hi (a macro) does not have a setter: (set! (hi) 3)")
+
+(test (catch #t (lambda () (set! 'a 1)) (lambda (typ info) (apply format #f info)))
+      "#_quote (syntactic) does not have a setter: (set! 'a 1)")
+
+(let ((__asdf__ #f)) (set! __asdf__ if) (set! __asdf__ 3) (test __asdf__ 3)) ; make sure this doesn't get locked
+
+(test (set! . -1) 'error)
+(test (set!) 'error)
+(test (let ((x 1)) (set! x x x)) 'error)
+(test (let ((x 1)) (set! x x) x) 1)
+(test (set! (cons 1 2) 3) 'error)
+(test (let ((var 1) (val 2)) (set! var set!) (var val 3) val) 3)
+(test (let ((var 1) (val 2)) (set! var +) (var val 3)) 5)
+(test (let ((sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789 1)
+	    (sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456780 3))
+	(set! sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789 2)
+	sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789)
+      2)
+
+(test (let ((x '(1)) (y '(2))) (set! ((if #t x y) 0) 32) x) '(32))
+(test (let ((hi 0)) (set! hi 32)) 32)
+(test (let ((hi 0)) ((set! hi ('((1 2) (3 4)) 0)) 0)) 1)
+
+(test (set! #<undefined> 1) 'error)
+(test (set! #<eof> 1) 'error)
+(test (set! #<unspecified> 1) 'error)
+(test (let ((x 0)) (define-macro (hi) 'x) (set! (hi) 3) x) 'error)
+
+(test (set! ("hi" . 1) #\a) 'error)
+(test (set! (#(1 2) . 1) 0) 'error)
+(test (set! ((1 . 2)) 3) 'error)
+(test (let ((lst (list 1 2))) (set! (lst . 0) 3) lst) 'error)
+(test (let ((lst (list 1 2))) (set! (list-ref lst . 1) 2)) 'error)
+(test (let ((v #2d((1 2) (3 4)))) (set! (v 0 . 0) 2) v) 'error)
+(test (set! ('(1 2) . 0) 1) 'error)
+(test (set! ('(1 2) 0) 3) 3)
+(test (set! (''(1 . 2)) 3) 'error)
+(test (set! (''(1 2)) 3) 'error)
+(test (set! ('(1 . 2)) 3) 'error)
+(test (set! ('(1 2)) 3) 'error)
+(test (set! (''(1 2) 0 0) 3) 'error)
+(test (set! (#(1 2) 0 0) 3) 'error)
+(test (let ((x 1)) (set! (quasiquote . x) 2) x) 'error)
+(test (let ((x 1)) (set! (quasiquote x) 2) x) 'error)
+(test (set! `,(1) 3) 'error)
+(test (set! (1) 3) 'error)
+(test (set! `,@(1) 3) 'error)
+(test (let ((x 0)) (set! x 1 . 2)) 'error)
+(test (let ((x 0)) (apply set! x '(3))) 'error) ; ;set!: can't alter immutable object: 0
+(test (let ((x 0)) (apply set! 'x '(3)) x) 3)
+(test (set! (#(a 0 (3)) 1) 0) 0)
+(test (set! ('(a 0) 1) 0) 0)
+(test (apply set! (apply list (list ''(1 2 3) 1)) '(32)) 32)
+(test (set! (let ((x 1)) x) 3) 'error)
+(test (set! (lambda () 1) 4) 'error)
+(test (set! (with-baffle (display x)) 5) 'error)
+(test (set! (define x 3) 6) 'error)
+(test (let ((x 0)) (define (func) (catch #t (lambda () (let-temporarily ((x (set! => #<...>))) x)) (lambda (type info) 'error))) (func) (func)) 'error) ;op_set_s_c
+(test (let ((x 0)) (define (func) (catch #t (lambda () (let-temporarily ((x (set! => abs))) x)) (lambda (type info) 'error))) (func) (func)) 'error) ;op_set_s_s
+(test (let ((x 0)) (define (func) (catch #t (lambda () (let-temporarily ((x (set! => (+ 1 2)))) x)) (lambda (type info) 'error))) (func) (func)) 'error) ;op_set_s_a
+(test (let ((x #f)) (map set! '((set! x (+ x 1)) (* x 2)) (hash-table 'a 1))) 'error)
+(test (let ((x #f)) (map set! (hash-table 'a 1) '((set! x (+ x 1)) (* x 2)))) 'error)
+
+(let ()
+  (define-macro (symbol-set! var val) `(apply set! ,var (list ,val))) ; but this evals twice
+  (test (let ((x 32) (y 'x)) (symbol-set! y 123) (list x y)) '(123 x)))
+(let ()
+  (define-macro (symbol-set! var val) ; like CL's set
+    `(apply set! ,var ',val ()))
+  (test (let ((var '(+ 1 2)) (val 'var)) (symbol-set! val 3) (list var val)) '(3 var))
+  (test (let ((var '(+ 1 2)) (val 'var)) (symbol-set! val '(+ 1 3)) (list var val)) '((+ 1 3) var)))
+
+(test (set! ('(1 2) 1 . 2) 1) 'error)
+(test (set! ('((1 2) 1) () . 1) 1) 'error)
+(test (set! ('(1 1) () . 1) 1) 'error)
+
+(test (let () (define (hi) (let ((x 1000)) (set! x (+ x 1)) x)) (hi) (hi)) 1001)
+(test (let () (define (hi) (let ((x 1000.5)) (set! x (+ x 1)) x)) (hi) (hi)) 1001.5)
+(test (let () (define (hi) (let ((x 3/2)) (set! x (+ x 1)) x)) (hi) (hi)) 5/2)
+(test (let () (define (hi) (let ((x 3/2)) (set! x (- x 1)) x)) (hi) (hi)) 1/2)
+(test (let () (define (hi) (let ((x 3/2)) (set! x (- x 2)) x)) (hi) (hi)) -1/2)
+(test (let () (define (hi) (let ((x "asdf")) (set! x (+ x 1)) x)) (hi) (hi)) 'error)
+
+(let ()
+  ;; check an optimizer bug
+  (define (bad-increment a b)
+    (cons a b))
+
+  (define (use-bad-increment b)
+    (let ((x ()))
+      (set! x (bad-increment x b))
+      x))
+
+  (use-bad-increment 1)
+  (use-bad-increment 1)
+  (use-bad-increment 1))
+
+(when with-block
+  (let ((b (block 0.0 1.0)))
+    (define (f) (do ((i 0 (+ i 1))) ((= i 2)) (set! (b i) 3.0)))
+    (set! (b 0) 2.0)
+    (test b (block 2.0 1.0))
+    (test (b 0) 2.0)
+    (f)
+    (test b (block 3.0 3.0))
+    (immutable! b)
+    (test (set! (b 0) 4.0) 'error)
+    (test (f) 'error))
+  (test (set! ((block)) 1) 'error)
+  (test (make-vector 1 (append (block) (block)) (setter (block-append))) 'error)
+  (test ((block 1 2 3) 1 "abs") 'error)
+  (test ((block)) 'error)
+  (test ((block 1 2 3) 1 32) 'error)
+  (test ((block 1 2 3) 1 0) 'error))
+
+;;; set_pair_p_3 coverage
+(test (let ((i 0) (x (hash-table))) (define (func) (set! (x 'a) 1) (immutable! x) (x 'a)) (define (hi) (func)) (hi) (hi)) 'error)
+(test (let ((i #\b)) (define (func) (let ((x (string #\a))) (set! (x 0) i) (x 0))) (define (hi) (func)) (hi) (set! i pi) (hi)) 'error)
+(test (let ((i 0)) (define (func) (let ((x (byte-vector 0))) (set! (x 0) i) (x 0))) (define (hi) (func)) (hi) (set! i 300) (hi)) 'error)
+(test (let ((i 0)) (define (func) (let ((x (byte-vector 0))) (set! (x 0) i) (x 0))) (define (hi) (func)) (hi) (set! i #\b) (hi)) 'error)
+(test (let ((i 0)) (define (func) (let ((x (string #\a))) (set! (x i) #\b) (x 0))) (define (hi) (func)) (hi) (set! i -3) (hi)) 'error)
+(test (let ((i 0)) (define (func) (let ((x (string #\a))) (set! (x i) #\b) (x 0))) (define (hi) (func)) (hi) (set! i 3) (hi)) 'error)
+(test (let ((i 0) (x (int-vector 0))) (define (func) (set! (x i) 1) (immutable! x) (x 0)) (define (hi) (func)) (hi) (hi)) 'error)
+(test (let ((i 0)) (define (func) (let ((x (int-vector 0))) (set! (x i) 1) (x 0))) (define (hi) (func)) (hi) (set! i 3) (hi)) 'error)
+(test (let ((i 0)) (define (func) (let ((x (int-vector 0))) (set! (x i) 1) (x 0))) (define (hi) (func)) (hi) (set! i -1) (hi)) 'error)
+(test (let ((i 0)) (define (func) (let ((x (int-vector 0))) (set! (x i) 1) (x 0))) (define (hi) (func)) (hi) (set! i 0.0) (hi)) 'error)
+(test (let () (define (func) (let ((x (make-int-vector '(2 3) 0))) (set! (x 0 0) 1) (x 0 0))) (define (hi) (func)) (hi) (hi)) 1)
+(test (let () (define (func) (let ((x 32)) (set! (x 0) 1))) (define (hi) (func)) (hi) (hi)) 'error)
+
+;; optimizer (opt_p_pip_ssf etc)
+(test (let ((tf13 '(()))) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 letrec*) 0 )))) (f)) 'error)
+(test (let ((tf13 "asdf")) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 letrec*) (integer->char 96))))) (f)) 'error)
+(test (let ((tf13 #(0))) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 letrec*) (list 123))))) (f)) 'error)
+(test (let ((tf13 "asdf")) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 letrec*) #\0)))) (f)) 'error)
+(test (let ((tf13 #(1))) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 letrec*) 0)))) (f)) 'error)
+(test (let ((tf13 #())) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 letrec*) (car (list #\0)))))) (f)) 'error)
+(test (let ((tf13 '(()))) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 "asdf") 0)))) (f)) 'error)
+(test (let ((tf13 #(0)) (index "asdf")) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 index) 0)))) (f)) 'error)
+(test (let ((tf13 #(0)) (index 0.0)) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 index) #f)))) (f)) 'error)
+(test (let ((tf13 "asdf")) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 quasiquote) #\0)))) (f)) 'error)
+(test (let ((tf13 "asdf")) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 abs) #\0)))) (f)) 'error)
+(test (let ((tf13 "asdf")) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 tf13) #\0)))) (f)) 'error)
+(test (let ((tf13 "asdf") (index '(0))) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 index) 0)))) (f)) 'error)
+(test (let ((tf13 #u(0))) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 letrec*) 123)))) (f)) 'error)
+
+;;; amusements
+(test (let ((x 0)) (set! (x 0) (define x (list 1 2))) x) 'error)
+(test (procedure? (let ((x 0)) (set! x (define (x) 31)) x)) #t)
+(test (let ((x (list 1 2))) (set! x (define x 31)) x) 31)
+(test (let ((x (list 1 2))) (set! (x 0) (define x 31)) x) 31)
+(test (let ((x (list 1 2))) (set! (x 0) (define x #(2 3))) x) #(2 3))
+(test (let ((x (list 1 2))) (let ((y x)) (set! (x 0) (define x (list 2 3))) (list x y))) '((2 3) ((2 3) 2)))
+(test (let ((x (list 1 2))) (let ((y x)) (set! (x 0) (define x (vector 2 3))) (list x y))) '(#(2 3) (#(2 3) 2)))
+(test (let ((x (list 1 2))) (let ((y x)) (list-set! x 0 (define x (list 2 3))) (list x y))) '((2 3) ((2 3) 2)))
+(test (let ((x (list 1 2))) (let ((y x)) (vector-set! x 0 (define x (vector 2 3))) (list x y))) 'error)
+(test (let () (vector-set! x 0 (begin (define x (vector 2 3)))) x) 'error)
+(test (let ((f1 (lambda (x) "we're number 1"))) (f1 (let () (set! f1 (lambda (x) "we're number 2"))))) "we're number 1")
+
+(let() ; set_caller+catch+error bug, will cause early exit from s7test in older s7's
+  (define (fc in)
+    (catch 'wrong-type-arg
+      (lambda () (+ in 2))
+      (lambda (type info) type)))
+
+  (define state
+    (let ((file #f)
+	  (contents #f))
+      (set! (setter 'file)
+	    (lambda (s v)
+	      (set! contents (fc #\1))
+	      v))
+      (curlet)))
+
+  (set! (state 'file) 321)
+  (test (state 'file) 321)
+  (test (state 'contents) 'wrong-type-arg))
+
+;;; similar cases
+(test ((list (lambda (x) (catch 'wrong-type-arg (lambda () (+ 1 #\a)) (lambda (type info) x)))) 0 "hi") 'error) ; "hi")
+(test ((list (lambda* (x) (catch 'wrong-type-arg (lambda () (+ 1 #\a)) (lambda (type info) x)))) 0 "hi") 'error) ; "hi")
+(test (apply (inlet) '(define y (catch #t (lambda () (+ 1 #\a)) (lambda (type info) 32)))) 32)
+;; (apply (inlet) '(define y 32)) -> ((inlet) 'define 'y 32) -> (apply define '(y 32)) [because ((inlet) 'define) is define] -> 32!
+
+(let ((H (make-hash-table 8 (cons (lambda (a b) (eq? a b)) ; as above hash mapper
+				  (lambda (a) (catch #t (lambda () (+ 1 #\a)) (lambda (type info) 0)))))))
+  (set! (H 'a) 1)
+  (test (H 'a) 1))
+(let ((H (make-hash-table 8 (cons (lambda (a b) (catch #t (lambda () (+ 1 #\a)) (lambda (type info) (eq? a b))))
+				  (lambda (a) 0))))) ; as above hash-checker
+  (set! (H 'a) 1)
+  (test (H 'a) 1))
+
+(test (catch #t  ; t_c_function branch in implicit_index
+        (lambda () (apply (list cons cons) (catch #t (lambda () (+ 1 #\a)) (lambda (type info) (list 1 2)))))
+        (lambda (y i) y))
+  'wrong-number-of-args)
+(test (catch #t
+        (lambda () (apply (list cons cons) (catch #t (lambda () (+ 1 #\a)) (lambda (type info) (list 1 2 3)))))
+        (lambda (y i) y))
+  '(2 . 3))
+
+(let ()
+  (define (g a b) (+ a b))
+  (test (apply (list g g) (catch #t (lambda () (+ 1 #\a)) (lambda (type info) (list 1 2 3)))) 5))
+
+(let ((lt 3))
+  (let-temporarily ((lt (catch #t (lambda () (+ 1 #\a)) (lambda (t i) 43))))
+     (test lt 43))
+  (test lt 3))
+
+(let ((seq (vector 3 2 4 1 5)))
+  (sort! seq (lambda (a b)
+	       (catch #t (lambda () (< 1 #\a))
+	                 (lambda (t i) (> a b)))))
+  (test seq #(5 4 3 2 1)))
+
+(let ((ctr 0))
+  (let ((dw (dynamic-wind
+		(lambda ()
+		  (catch #t
+		    (lambda ()
+		      (+ 1 #\a))
+		    (lambda (type info)
+		      (set! ctr 1))))
+		(lambda ()
+		  (catch #t
+		    (lambda ()
+		      (+ 1 #\a))
+		    (lambda (type info)
+		      (set! ctr (+ ctr 1))))
+		  (set! ctr (+ ctr 9))) ; 11
+		(lambda ()
+		  (catch #t
+		    (lambda ()
+		      (+ 1 #\a))
+		    (lambda (type info)
+		      (set! ctr (+ ctr 1)))))))) ; 12
+    (test (+ dw ctr) 23)))
+
+(let ((ctr 0))
+  (let ((dw (call/cc
+	     (lambda (exit)
+	       (dynamic-wind
+		   (lambda ()
+		     (catch #t
+		       (lambda ()
+			 (+ 1 #\a))
+		       (lambda (type info)
+			 (set! ctr 1))))
+		   (lambda ()
+		     (catch #t
+		       (lambda ()
+			 (+ 1 #\a))
+		       (lambda (type info)
+			 (exit 33)
+			 (set! ctr 1)))
+		     (set! ctr (+ ctr 9)))
+		   (lambda ()
+		     (catch #t
+		       (lambda ()
+			 (+ 1 #\a))
+		       (lambda (type info)
+			 (set! ctr 1)))))))))
+    (test (list ctr dw) '(1 33))))
+
+(let ((ctr 0))
+  (let ((dw (call-with-exit
+	     (lambda (exit)
+	       (dynamic-wind
+		   (lambda ()
+		     (catch #t
+		       (lambda ()
+			 (+ 1 #\a))
+		       (lambda (type info)
+			 (set! ctr 1))))
+		   (lambda ()
+		     (catch #t
+		       (lambda ()
+			 (+ 1 #\a))
+		       (lambda (type info)
+			 (exit 33)
+			 (set! ctr 1)))
+		     (set! ctr (+ ctr 9)))
+		   (lambda ()
+		     (catch #t
+		       (lambda ()
+			 (+ 1 #\a))
+		       (lambda (type info)
+			 (set! ctr 1)))))))))
+    (test (list ctr dw) '(1 33))))
+
+(let ((ctr 0))
+  (define (ifn)
+    (catch #t
+      (lambda ()
+	(+ 1 #\a))
+      (lambda (type info)
+	(set! ctr (+ ctr 1))))
+    (set! ctr (+ ctr 1)))
+  (let ((dw (dynamic-wind ifn ifn ifn)))
+    (test (+ dw ctr) 10)))
+
+(test (let ((path ())
+            (c #f))
+	(let ((add (lambda (s)
+		     (set! path (cons s path)))))
+	  (dynamic-wind
+	      (lambda () (catch #t (lambda () (+ 1 #\a)) (lambda (t i) (add 'connect))))
+	      (lambda () (add (call-with-current-continuation
+			       (lambda (c0) (set! c c0) 'talk1))))
+	      (lambda () (catch #t (lambda () (+ 1 #\a)) (lambda (t i) (add 'disconnect)))))
+	  (if (< (length path) 4)
+	      (catch #t (lambda () (+ 1 #\a)) (lambda (t i) (c 'talk2)))
+	      (reverse path))))
+      '(connect talk1 disconnect  connect talk2 disconnect))
+
+(test (catch #t (lambda () (set! #_abs 32)) (lambda (t i) (apply format #f i))) "set! can't change #_abs (a c-function)")
+
+
+;;; --------------------------------------------------------------------------------
+;;; or
+;;; --------------------------------------------------------------------------------
+
+(test (or (= 2 2) (> 2 1)) #t)
+(test (or (= 2 2) (< 2 1)) #t)
+(test (or #f #f #f) #f)
+(test (or) #f)
+(test (or (memq 'b '(a b c)) (+ 3 0)) '(b c))
+(test (or 3 9) 3)
+(test (or #f 3 asdf) 3) ; "evaluation stops immediately"
+(test (or 3 (/ 1 0) (display "or is about to exit!") (exit)) 3)
+
+(for-each
+ (lambda (arg)
+   (test (or arg) arg)
+   (test (or #f arg) arg)
+   (test (or arg (error 'test-error "oops or ")) arg))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) #<eof> #<unspecified> '(1 . 2)))
+
+(test (call-with-input-file "s7test.scm"
+	(lambda (p)
+	  (let ((loc 0))
+	    (let loop ((val (read-char p)))
+	      (or (eof-object? val)
+		  (> loc 1000) ; try to avoid the read-error stuff
+		  (begin
+		    (set! loc (+ loc 1))
+		    (loop (read-char p)))))
+	    (> loc 1000))))
+      #t)
+
+(test (or (and (or (> 3 2) (> 3 4)) (> 2 3)) 4) 4)
+(test (or or) or)
+(test (or (or (or))) #f)
+(test (or (or (or) (and))) #t)
+(test (let ((a 1)) (or (let () (set! a 2) #f) (= a 1) (let () (set! a 3) #f) (and (= a 3) a) (let () (set! a 4) #f) a)) 3)
+(test (or '#f ()) ())
+(test (call/cc (lambda (r) (or #f (> 3 2) (r 123) 321))) #t)
+(test (call/cc (lambda (r) (or #f (< 3 2) (r 123) 321))) 123)
+(test (+ (or #f (not (null? ())) 3) (or (zero? 1) 2)) 5)
+(test (or 0) 0)
+(test (if (or) 1 2) 2)
+
+(test (or . 1) 'error)
+(test (or #f . 1) 'error)
+(test (or . (1 2)) 1)
+(test (or . ()) (or))
+; (test (or 1 . 2) 1) ; this fluctuates
+
+(test (let () (or (define (hi a) a)) (hi 1)) 1)
+(test (let () (or #t (define (hi a) a)) (hi 1)) 'error)
+(test (let () (and (define (hi a) a) (define (hi a) (+ a 1))) (hi 1)) 2) ; guile agrees with this
+(test ((lambda (arg) (arg #f 123)) or) 123)
+(test (let ((oar or)) (oar #f 43)) 43)
+(test (let ((oar #f)) (set! oar or) (oar #f #f 123)) 123)
+(test (member 1 (list 2 3) (lambda (a b) (negative? (or (call/cc (lambda (return) (let ((x 1) (y 2)) (return x y)))) (string->keyword))))) #f)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; and
+;;; --------------------------------------------------------------------------------
+
+(test (and (= 2 2) (> 2 1)) #t)
+(test (and (= 2 2) (< 2 1)) #f)
+(test (and 1 2 'c '(f g)) '(f g))
+(test (and) #t)
+(test (and . ()) (and))
+(test (and 3) 3)
+(test (and (memq 'b '(a b c)) (+ 3 0)) 3)
+(test (and 3 9) 9)
+(test (and #f 3 asdf) #f) ; "evaluation stops immediately"
+(test (and 3 (zero? 1) (/ 1 0) (display "and is about to exit!") (exit)) #f)
+(test (if (and) 1 2) 1)
+(test (if (+) 1 2) 1)
+(test (if (*) 1 2) 1)
+(test (and (if #f #f)) (if #f #f))
+(test (let ((x '(1))) (eq? (and x) x)) #t)
+
+(for-each
+ (lambda (arg)
+   (test (and arg) arg)
+   (test (and #t arg) arg)
+   (test (and arg #t) #t))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(test (call-with-input-file "s7test.scm"
+	(lambda (p)
+	  (let ((loc 0))
+	    (let loop ((val (read-char p)))
+	      (and (not (eof-object? val))
+		   (< loc 1000)
+		   (begin
+		     (set! loc (+ loc 1))
+		     (loop (read-char p)))))
+	    (>= loc 1000))))
+      #t)
+
+(test (and (or (and (> 3 2) (> 3 4)) (> 2 3)) 4) #f)
+(test (and and) and)
+(test (and (and (and))) #t)
+(test (and (and (and (and (or))))) #f)
+(test (let ((a 1)) (and (let () (set! a 2) #t) (= a 1) (let () (set! a 3) #f) (and (= a 3) a) (let () (set! a 4) #f) a)) #f)
+(test (and '#t ()) ())
+(test (call/cc (lambda (r) (and #t (> 3 2) (r 123) 321))) 123)
+(test (call/cc (lambda (r) (and #t (< 3 2) (r 123) 321))) #f)
+(test (+ (and (null? ()) 3) (and (zero? 0) 2)) 5)
+
+(test (and . #t) 'error)
+(test (and 1 . 2) 'error)
+(test (and . (1 2)) 2)
+
+(test (let () (and (define (hi a) a)) (hi 1)) 1)
+(test (let () (and #f (define (hi a) a)) (hi 1)) 'error)
+(test (+ 1 (and (define (hi a) a) (hi 2))) 3)
+
+;;; from some net site
+(let ()
+  (define (fold fn accum list)
+    (if (null? list)
+	accum
+	(fold fn
+	      (fn accum
+		  (car list))
+	      (cdr list))))
+  (test (fold and #t '(#t #f #t #t)) #f))
+
+(test (let ((and! and)) (and! #f (error 'test-error "oops"))) #f)
+(test (let ((and! #f)) (set! and! and) (and! #f (error 'test-error "oops"))) #f)
+(test (let () (define (try and!) (and! #f (error 'test-error "oops"))) (try and)) #f)
+
+;;; here are some tests from S. Lewis in the r7rs mailing list
+(let ()
+  (define myand and)
+  (test (myand #t (+ 1 2 3)) 6)
+  (define (return-op) and)
+  (define myop (return-op))
+  (test (myop #t (+ 1 2 3)) 6)
+  (test (and #t (+ 1 2 3)) 6)
+  (test ((return-op) #t (+ 1 2 3)) 6)
+  (test ((and and) #t (+ 1 2 3)) 6)
+  (define ops `(,* ,and))
+  (test ((car ops) 2 3) 6)
+  (test ((cadr ops) #t #f) #f)
+  (test (and #f never) #f)
+  (test (and #f and) #f)
+  (test ((and #t and) #t (+ 1 2 3)) 6))
+
+(test (let ((vf (vector abs))) (define (func) (do ((i 0 (+ i 1))) ((= i 100)) (and #f (vf (msym3))))) (func)) #t) ; not error -- s7_macroexpand
+(test (let ((vf (vector abs))) (define (func) (do ((i 0 (+ i 1))) ((= i 100)) (and #f (vf (msym3 i . i))))) (func)) #t)
+
+
+;;; --------------------------------------------------------------------------------
+;;; cond
+;;; --------------------------------------------------------------------------------
+
+(test (cond ('a)) 'a)
+(test (cond (3)) 3)
+(test (cond (#f 'a) ('b)) 'b)
+(test (cond (#t 'a) (#t 'b)) 'a)
+(test (cond (#t 'a) (else 'b)) 'a)
+(test (cond (else 'a) (else 'b)) 'a)
+(test (cond ((> 3 2) 'greater) ((< 3 2) 'less)) 'greater)
+(test (cond((> 3 2)'greater)((< 3 2)'less)) 'greater)
+(test (cond ((> 3 3) 'greater) ((< 3 3) 'less)  (else 'equal)) 'equal)
+(test (cond ((assv 'b '((a 1) (b 2))) => cadr)  (else #f)) 2)
+(test (cond (#f 2) (else 5)) 5)
+(test (cond (1 2) (else 5)) 2)
+(test (cond (1 => (lambda (x) (+ x 2))) (else 8)) 3)
+(test (cond ((+ 1 2))) 3)
+(test (cond ((zero? 1) 123) ((= 1 1) 321)) 321)
+(test (cond ('() 1)) 1)
+(test (let ((x 1)) (cond ((= 1 2) 3) (else (* x 2) (+ x 3)))) 4)
+(test (let((x 1))(cond((= 1 2)3)(else(* x 2)(+ x 3)))) 4)
+(test (let ((x 1)) (cond ((= x 1) (* x 2) (+ x 3)) (else 32))) 4)
+(test (let ((x 1)) (cond ((= x 1) (let () (set! x (* x 2))) (+ x 3)) (else 32))) 5)
+(test (let ((x 1)) (cond ((= x 2) (let () (set! x (* x 2))) (+ x 3)) (else 32))) 32)
+(test (let ((x 1)) (cond ((= x 2) 3) (else (let () (set! x (* x 2))) (+ x 3)))) 5)
+(test (cond ((= 1 2) 3) (else 4) (else 5)) 4) ; this should probably be an error
+(test (cond (1 2 3)) 3)
+(test (cond (1 2) (3 4)) 2)
+(test (cond ((= 1 2) 3) ((+ 3 4))) 7)
+(test (cond ((= 1 1) (abs -1) (+ 2 3) (* 10 2)) (else 123)) 20)
+(test (let ((a 1)) (cond ((= a 1) (set! a 2) (+ a 3)))) 5)
+(test (let ((a 1)) (cond ((= a 2) (+ a 2)) (else (set! a 3) (+ a 3)))) 6)
+(test (cond ((= 1 1))) #t)
+(test (cond ((= 1 2) #f) (#t)) #t)
+(test (cond ((+ 1 2))) 3)
+(test (cond ((cons 1 2))) '(1 . 2))
+(test (cond (#f #t) ((string-append "hi" "ho"))) "hiho")
+(test (cond ('() 3) (#t 4)) 3)
+(test (cond ((list) 3) (#t 4)) 3)
+;;; (cond (1 1) (asdf 3)) -- should this be an error?
+(test (cond (+ 0)) 0)
+(test (cond (lambda ())) ())
+(test (cond . ((1 2) ((3 4)))) 2)
+(test (cond (define #f)) #f)
+(test (let () (cond ((> 2 1) (define x 32) x) (#t 1)) x) 32) ; ? a bit strange
+(test (let ((x 1)) (+ x (cond ((> x 0) (define x 32) x)) x)) 65)
+(test (cond (("hi" 1))) #\i)
+(test (cond (()())) ())
+(test (let ((a 0)) (let ((b (lambda () (set! a 1) #f))) (cond ((> a 0) 3) ((b) 4) ((> a 0) 5) (#t 6)))) 5)
+(test (let ((a #t)) (let ((b (lambda () (set! a (not a)) a))) (cond ((b) 1) ((b) 2) (t 3)))) 2)
+(test (let ((otherwise else)) (cond ((= 1 2) 1) (otherwise 3))) 3)
+(test (let ((otherwise #t)) (cond ((= 1 2) 1) (otherwise 3))) 3) ; or actually anything... 12 for example
+(test (let ((else #f)) (cond ((= 1 2) 1) (else 3))) #<unspecified>)
+(test (let ((else #f)) (cond ((= 1 2) 1) (#_else 3))) 3)
+(test (let ((else 1)) (let ((otherwise else)) (case 0 (otherwise 1)))) 'error)
+(test (let ((x 1)) (cond ((< x 0) 1))) #<unspecified>)
+
+(test (let () (cond (#t (define x 7) x))) 7) ; from guile-user
+(test (let () (cond (else (define x 8) x))) 8)
+(test (let () (cond ((> 2 1) (define x 9)) (else (define x 10))) x) 9)
+(test (let () (cond ((< 2 1) (define x 11)) (else (define x 12))) x) 12)
+
+(for-each
+ (lambda (arg)
+   (test (cond ((or arg) => (lambda (x) x))) arg))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(set! (*s7* 'print-length) (max (*s7* 'print-length) 40))
+(test (catch #t (lambda () (cond () #f)) (lambda (t i) (apply format #f i))) "every clause in cond must be a pair: () in (cond () #f)")
+(test (cond ((< 2 1)) ((= 1 2)) (else #f)) (or (< 2 1) (= 1 2))) ; (cond (A) (B) (else #f)) is (or A B)
+
+(test (cond ((+ 1 2) => (lambda (x) (+ 1 x)))) 4)
+(test (cond ((cons 1 2) => car)) 1)
+(test (cond ((values 1 2) => +)) 1)
+(test (cond (1 2 => +)) 'error)
+(test (cond ((begin 1 2) => +)) 2)
+(test (cond ((values -1) => abs)) 1)
+(test (cond ((= 1 2) => +) (#t => not)) #f)
+(test (cond ((* 2 3) => (let () -))) -6)
+(test (cond ((* 2 3) => (cond ((+ 3 4) => (lambda (a) (lambda (b) (+ b a))))))) 13)
+(test (let ((x 1)) ((cond ((let () (set! x 2) #f) => boolean?) (lambda => (lambda (a) (apply a '((b) (+ b 123)))))) x)) 125)
+(test (cond ((values 1 2 3) => +)) 1)
+(test (cond ((values #f #f) => equal?)) #<unspecified>)
+(test (let () (cond (#t (define (hi a) a))) (hi 1)) 1)
+(test (let () (cond (#f (define (hi a) a))) (hi 1)) 'error)
+(test (let () (cond ((define (hi a) a) (hi 1)))) 1)
+(test (cond ((assq 'x '((x . 1) (y . 0))) => abs (display 'oops)) (else #f)) 'error)
+
+(test (cond (else 1)) 1)
+(test (call/cc (lambda (r) (cond ((r 4) 3) (else 1)))) 4)
+(test (cond ((cond (#t 1)))) 1)
+(test (symbol? (cond (else else))) #t)
+(test (equal? else (cond (else else))) #t)
+(test (cond (#f 2) ((cond (else else)) 1)) 1)
+(test (let ((x #f) (y #t)) (cond (x 1) (y 2))) 2)
+(test (cond ((- 3 2)) ((< 2 3))) (or (- 3 2) (< 3 2))) ; (cond (e) ...)) is the same as (or e ...)
+(test (let ((i 0)) (cond  ((null? i) i)  (else))) else)
+(test (let () (define (func) (let ((i 0)) (cond ((null? i) i) (else)))) (define (hi) (func) (func)) (hi) (hi)) else)
+
+(for-each
+ (lambda (arg)
+   (test (cond (#t arg)) arg))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(for-each
+ (lambda (arg)
+   (test (cond (arg)) arg))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(for-each
+ (lambda (arg)
+   (test (cond (#f 1) (else arg)) arg))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(for-each
+ (lambda (arg)
+   (test (cond (arg => (lambda (x) x))) arg))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(test (cond ((let () 1) => (let ((x 2)) (lambda (n) (+ n x))))) 3)
+(test (cond ((let () 1) => (let ((x 2)) (cond (3 => (let ((y 4)) (lambda (n) (lambda (m) (+ n m x y))))))))) 10)
+
+(test (let ((=> 3)) (cond (=> =>))) 3)
+(test (cond (cond 'cond)) 'cond)
+(test (cond (3 => (lambda args (car args)))) 3)
+(test (cond (3 => (lambda (a . b) a))) 3)
+(test (cond ((list 3 4) => (lambda (a . b) b))) ())
+(test (cond) 'error)
+(test (let () (define-macro (mac x) `(+ ,x 1)) (cond (1 => mac))) 2)
+					;(test (cond ((= 1 2) 3) (else 4) (4 5)) 'error) ; trailing ignored
+(test (cond ((+ 1 2) => (lambda (a b) (+ a b)))) 'error)
+(test (equal? (cond (else)) else) #t)
+(test (cond (#t => 'ok)) 'error)
+(test (cond (else =>)) 'error)
+(test (cond ((values -1) => => abs)) 'error)
+(test (cond ((values -1) =>)) 'error)
+(test (cond (cond (#t 1))) 'error)
+(test (cond 1) 'error)
+(test (cond) 'error)
+(test (cond (1 . 2) (else 3)) 'error)
+(test (cond (#f 2) (else . 4)) 'error)
+(test (cond #t) 'error)
+(test (cond 1 2) 'error)
+(test (cond 1 2 3) 'error)
+(test (cond 1 2 3 4) 'error)
+(test (cond (1 => (lambda (x y) #t))) 'error)
+(test (cond . 1) 'error)
+(test (cond ((1 2)) . 3) 'error)
+(test (cond (1 => + abs)) 'error)
+(test (cond (1 =>)) 'error)
+(test (cond (else => symbol?)) #t) ; (symbol? else) -> #t
+(test (eq? (cond (else => or)) else) #t)
+(test (let ((else 3)) (cond ((= else 3) 32) (#t 1))) 32)
+(test (let ((else #f)) (cond (else 32) (#t 1))) 1)
+(test (cond #((1 2))) 'error)
+(test (cond (/ 0)) 0) ; / is not #f, so return 0
+(test (cond (string-ref 2)) 2)
+
+(test (let ((=> 3)) (cond (1 =>))) 3)
+(test (let ((=> 3)) (cond (1 => abs))) abs)
+(test (let ((=> 3) (else 4)) (cond (else => abs))) abs)
+(test (let ((=> 3)) (cond (1 => "hi"))) "hi")
+
+(test (let ((=> 3)) (cond (12 => abs) (else #f))) abs)              ; guile/chicken/chibi agree
+(test (let ((else #f)) (cond ((< 2 1) 3) (else 4))) #<unspecified>) ;  same
+(test (let ((=> 3)) (case => ((3) => abs) (else #f))) abs)
+(test (let ((else #f)) (case 3 ((2 1) 3) (else 4))) 4)              ; chibi says #f (its choice for the unspecified value), Guile 4, chicken error
+(test (let ((else #f)) (cond ((< 2 1) 1) (else 3) (#t 4))) 4)       ; ! (same for chibi)
+;; to run chibi repl, goto /home/bil/test/chibi-scheme-master, setenv LD_LIBRARY_PATH /home/bil/test/chibi-scheme-master, chibi-scheme
+;; to run chicken, goto /home/bil/test/chicken-4.7.0.6/, csi
+
+(let ()
+  (define (cond-fx-2e-fx x) (cond ((= x 0) (+ x 1)) (else (+ x 2))))
+  (define (test-cond-fx-2e-fx)
+    (cond-fx-2e-fx 0) ; prime the pump
+    (test (cond-fx-2e-fx 0) 1)
+    (test (cond-fx-2e-fx 1) 3))
+  (test-cond-fx-2e-fx)
+
+  (define (cond-fx-3e-fx x) (cond ((= x 0) (+ x 1)) ((= x 1) (+ x 2)) (else (+ x 3))))
+  (define (test-cond-fx-3e-fx)
+    (cond-fx-3e-fx 0)
+    (test (cond-fx-3e-fx 0) 1)
+    (test (cond-fx-3e-fx 1) 3)
+    (test (cond-fx-3e-fx 2) 5))
+  (test-cond-fx-3e-fx)
+
+  (define (cond-fx-2e x) (cond ((= x 0) (+ x 1)) (else (call-with-exit (lambda (g) (+ x 2))))))
+  (define (test-cond-fx-2e)
+    (cond-fx-2e 0) ; prime the pump
+    (test (cond-fx-2e 0) 1)
+    (test (cond-fx-2e 1) 3))
+  (test-cond-fx-2e)
+
+  (define (cond-fx-3e x) (cond ((= x 0) (+ x 1)) ((= x 1) (call-with-exit (lambda (g) (+ x 2)))) (else (+ x 3))))
+  (define (test-cond-fx-3e)
+    (cond-fx-3e 0)
+    (test (cond-fx-3e 0) 1)
+    (test (cond-fx-3e 1) 3)
+    (test (cond-fx-3e 2) 5))
+  (test-cond-fx-3e))
+
+(let () ; check an optimizer typo
+  (define (f x g h)
+    (call-with-exit
+     (lambda (return)
+       (cond ((= x 0) (abs x) (set! x (+ x 1)) (+ x 1))
+	     ((g) (abs x) (set! x (+ x 2)) (+ x 2))
+	     (h)
+	     (else (abs x) (set! x (+ x 3)) (+ x 3))))))
+  (test (f 0 (lambda () #f) #f) 2)
+  (test (f 1 (lambda () #f) #f) 7)
+  (test (f 2 (lambda () #t) #f) 6)
+  (test (f 3 (lambda () #f) 4) 4))
+
+(test (let ((x 0))
+	(cond ((let ((y x)) (set! x 1) (= y 1)) 0)
+	      ((let ((y x)) (set! x 1) (= y 1)) 1)
+	      (#t 2)))
+      1)
+
+(let () ; opt_cond_1 as expr (for sc->pc check)
+  (define (cd)
+    (let ((v (make-vector 6 #f)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 6) v)
+        (vector-set! v i (cond ((< i 3) (+ i 10)))))))
+  (test (cd) #(10 11 12 #<unspecified> #<unspecified> #<unspecified>)))
+
+(let ((c1 #f)
+      (x 1))
+  (let ((y (cond ((let ()
+		    (call/cc
+		     (lambda (r)
+		       (set! c1 r)
+		       (r x))))
+		  => (lambda (n) (+ n 3)))
+		 (#t 123))))
+    (if (= y 4) (begin (set! x 2) (c1 321)))
+    (test (list x y) '(2 324))))
+
+(let ((c1 #f)
+      (x 1))
+  (let ((y (cond (x => (lambda (n)
+			 (call/cc
+			  (lambda (r)
+			    (set! c1 r)
+			    (r (+ 3 x))))))
+		 (#t 123))))
+    (if (= y 4) (begin (set! x 2) (c1 321)))
+    (test (list x y) '(2 321))))
+
+(let ((c1 #f) ; same with do
+      (x 1))
+  (do ((y (call/cc (lambda (r)
+		      (set! c1 r)
+		      (r (+ 3 x))))))
+      (#t
+       (when (= y 4)
+	 (set! x 2)
+	 (c1 321)))
+    (test (list x y) '(2 321))))
+
+;; opt_cell_cond size limits
+(let ()
+  (define (func)
+    (do ((i 0 (+ i 1)))
+	((= i 1))
+      (cond (else 1 2 3 4 5 6 7 8 9 10 11 12))))
+  (func) (func))
+
+(let ()
+  (define (func)
+    (do ((i 0 (+ i 1)))
+	((= i 1))
+      (cond (else 1 2 3 4 5 6 7 8 9 10))))
+  (func) (func))
+
+(let ()
+  (define (func)
+    (do ((i 0 (+ i 1)))
+	((= i 1))
+      (cond ((= i 0) i) ((= i 1) i) ((= i 2) i) ((= i 3) i) ((= i 4) i) ((= i 5) i) ((= i 6) i)
+	    ((= i 7) i) ((= i 8) i) ((= i 9) i) ((= i 10) i) ((= i 11) i) ((= i 12) i))))
+  (func) (func))
+
+(let ()
+  (define (func)
+    (do ((i 0 (+ i 1)))
+	((= i 1))
+      (cond ((= i 0) i) ((= i 1) i) ((= i 2) i) ((= i 3) i) ((= i 4) i) ((= i 5) i) ((= i 6) i)
+	    ((= i 7) i) ((= i 8) i) ((= i 9) i) ((= i 10) i) ((= i 11) i))))
+  (func) (func))
+
+
+
+;;; -------- cond-expand --------
+;;; cond-expand
+
+(test (let ()
+	(cond-expand (guile )
+		     (s7 (define (hi a) a)))
+	(hi 1))
+      1)
+(test (let ((x 0))
+	(cond-expand (guile (format #t ";oops~%"))
+		     (else (set! x 32)))
+	x)
+      32)
+(test (let ()
+	(cond-expand
+	 (guile
+	  (define (hi a) (+ a 1)))
+	 ((or common-lisp s7)
+	  (define (hi a) a)))
+	(hi 1))
+      1)
+(test (let ()
+	(cond-expand
+	 ((not guile)
+	  (define (hi a) a))
+	 (else
+	  (define (hi a) (+ a 1))))
+	(hi 1))
+      1)
+
+(test (let ()
+	(cond-expand
+	 ((and s7 dfls-exponents)
+	  (define (hi a) a))
+	 (else
+	  (define (hi a) (+ a 1))))
+	(hi 1))
+      (if (provided? 'dfls-exponents) 1 2))
+(test (let ()
+	(cond-expand
+	 ((or s7 guile)
+	  (define (hi a) a))
+	 (else
+	  (define (hi a) (+ a 1))))
+	(hi 1))
+      1)
+(test (let ()
+	(cond-expand
+	 ((and s7 dfls-exponents unlikely-feature)
+	  (define (hi a) a))
+	 (else
+	  (define (hi a) (+ a 1))))
+	(hi 1))
+      2)
+(test (let ()
+	(cond-expand
+	 ((and unlikely-feature (error 'oops "oops\n"))
+	  (define (hi a) a))
+	 (else
+	  (define (hi a) (+ a 1))))
+	(hi 1))
+      2)
+(test (let ()
+	(cond-expand
+	 ((and s7 (not s7)) 'oops)
+	 (else 1)))
+      1)
+(test (let ()
+	(cond-expand
+	 ("not a pair" 1)
+	 (2 2)
+	 (#t 3)
+	 ;((1 . 2) 4) ; ; attempt to evaluate (#f . #f)?
+	 (() 6)
+	 (list 7)
+	 (else 5)))
+      5)
+
+(test (when (> 2 1) 23 (cond-expand (ratios 3/4))) 3/4)
+(test (begin 23 (cond-expand (surreals 1) (foonly 2))) #<unspecified>) ; I think this should be 23, also (abs 23 (cond-expand (surreals 1)))
+(test (begin (cond-expand (s7 "s7") (else "not s7"))) "s7")
+(test (begin (cond-expand (s7 "s7"))) "s7")
+(test (if (> 1 2) 23 (cond-expand (s7 3 4))) 4) ; macroexpand -> (cond (#t 3 4))
+
+#|
+<1> (cond-expand (reader-cond (char-whitespace?)))))
+error: cond-expand: clause is not a pair, char-whitespace? [reader-cond is not a *feature* but it takes over at the reader level]
+
+<2> (cond-expand (#t (char-whitespace?))))) ; #t is not in *features* so this is like the guile case below (#f == #t!)
+#<unspecified>
+
+<3> (cond-expand (s7 (char-whitespace?)))))
+error: char-whitespace?: not enough arguments: (char-whitespace?) [this is ok]
+
+<4> (cond-expand (guile (char-whitespace?)))))
+#<unspecified>
+
+<6> (cond-expand ((reader-cond) (char-whitespace? 23)))))
+error: reader-cond: no clauses? [i.e. expansion as cond-expand "feature"]
+
+yow...
+|#
+
+
+;;; --------------------------------------------------------------------------------
+;;; case
+;;; --------------------------------------------------------------------------------
+
+(test (case (* 2 3) ((2 3 5 7) 'prime) ((1 4 6 8 9) 'composite))  'composite)
+(test (case (car '(c d)) ((a e i o u) 'vowel) ((w y) 'semivowel) (else 'consonant)) 'consonant)
+(test (case 3.1 ((1.3 2.4) 1) ((4.1 3.1 5.4) 2) (else 3)) 2)
+(test (case 3/2 ((3/4 1/2) 1) ((3/2) 2) (else 3)) 2)
+(test (case 3 ((1) 1 2 3) ((2) 2 3 4) ((3) 3 4 5)) 5)
+(test (case 1+i ((1) 1) ((1/2) 1/2) ((1.0) 1.0) ((1+i) 1+i)) 1+i)
+(test (case 'abs ((car cdr) 1) ((+ cond) 2) ((abs) 3) (else 4)) 3)
+(test (case #\a ((#\b) 1) ((#\a) 2) ((#\c) 3)) 2)
+(test (case (boolean? 1) ((#t) 2) ((#f) 1) (else 0)) 1)
+(test (case 1 ((1 2 3) (case 2 ((1 2 3) 3)))) 3)
+(test (case 1 ((1 2) 1) ((3.14 2/3) 2)) 1)
+(test (case 1 ((1 2) 1) ((#\a) 2)) 1)
+(test (case 1 ((1 2) 1) ((#\a) 2) ((car cdr) 3) ((#f #t) 4)) 1)
+(test (case #f ((1 2) 1) ((#\a) 2) ((car cdr) 3) ((#f #t) 4)) 4)
+(test (case 1 ((#t) 2) ((#f) 1) (else 0)) 0)
+(test (let ((x 1)) (case x ((x) "hi") (else "ho"))) "ho")
+(test (let ((x 1)) (case x ((1) "hi") (else "ho"))) "hi")
+(test (let ((x 1)) (case x (('x) "hi") (else "ho"))) "ho")
+(test (let ((x 1)) (case 'x ((x) "hi") (else "ho"))) "hi")
+(test (case () ((()) 1)) 1)
+(test (case #() ((#()) 1) (else 2)) 2)
+(test (let-temporarily (((*s7* 'safety) 0)) (let ((x '(1))) (eval `(case ',x ((,x) 1) (else 0))))) 1)    ; but we can overcome that! (also via apply)
+(test (let ((x #())) (eval `(case ',x ((,x) 1) (else 0)))) 1)
+(test (case ''2 (('2) 1) (else 0)) 0)
+(test (let ((otherwise else)) (case 1 ((0) 123) (otherwise 321))) 321)
+(test (case 1 ((0) 123) (#t 321)) 'error)
+;(test (eqv? "a" "a") (let ((x "a")) (let ((y x)) (eqv? x y))))     ; (eq? x y) here (even Guile agrees though it raises an error on the equivalent case statement)
+
+(test (case else ((#f) 2) ((#t) 3) ((else) 4) (else 5)) 4)          ; (eqv? 'else else) is #t (Guile says "unbound variable: else")
+(test (case #t ((#f) 2) ((else) 4) (else 5)) 5)                     ; else is a symbol here
+(test (equal? (case 0 ((0) else)) else) #t)
+(test (cond ((case 0 ((0) else)) 1)) 1)
+;(test (let () (case (define b 3) ((b) b))) 3) ; changed define 25-Jul-14
+
+(test (let ((x 1)) (case x ((2) 3) (else (* x 2) (+ x 3)))) 4)
+(test (let ((x 1)) (case x ((1) (* x 2) (+ x 3)) (else 32))) 4)
+(test (let ((x 1)) (case x ((1) (let () (set! x (* x 2))) (+ x 3)) (else 32))) 5)
+(test (let ((x 1)) (case x ((2) (let () (set! x (* x 2))) (+ x 3)) (else 32))) 32)
+(test (let ((x 1)) (case x ((2) 3) (else (let () (set! x (* x 2))) (+ x 3)))) 5)
+(test (let((x 1))(case x((2)3)(else(let()(set! x(* x 2)))(+ x 3)))) 5)
+(test (let ((x 1)) (case x ((2) 3) (else 4) (else 5))) 'error)
+
+(test (case () ((()) 2) (else 1)) 2)    ; car: (), value: (), eqv: 1, null: 1 1
+(test (case () (('()) 2) (else 1)) 1)   ; car: (quote ()), value: (), eqv: 0, null: 0 1
+(test (case () (('()) 2) (else 1)) 1)    ; car: (quote ()), value: (), eqv: 0, null: 0 1
+(test (case () ((()) 2) (else 1)) 2)     ; car: (), value: (), eqv: 1, null: 1 1
+
+;;; this is a difference between () and '() ?
+;;; (eqv? () ()) -> #t and (eqv? () '()) is #t so it's the lack of evaluation in the search case whereas the index is evaluated
+;;; equivalent to:
+
+(test (case 2 (('2) 3) (else 1)) 1)      ; car: (quote 2), value: 2, eqv: 0, null: 0 0
+(test (case '2 (('2) 3) (else 1)) 1)     ; car: (quote 2), value: 2, eqv: 0, null: 0 0
+(test (case '2 ((2) 3) (else 1)) 3)      ; car: 2, value: 2, eqv: 1, null: 0 0
+(test (case 2 ((2) 3) (else 1)) 3)       ; car: 2, value: 2, eqv: 1, null: 0 0
+
+(test (case '(()) ((()) 1) (((())) 2) (('()) 3) (('(())) 4) ((((()))) 5) (('((()))) 6) (else 7)) 7) ; (eqv? '(()) '(())) is #f
+
+(test (let ((x 1)) (case (+ 1 x) ((0 "hi" #f) 3/4) ((#\a 1+3i '(1 . 2)) "3") ((-1 'hi 2 2.0) #\f))) #\f)
+(test (case (case 1 ((0 2) 3) (else 2)) ((0 1) 2) ((4 2) 3) (else 45)) 3)
+(test (case 3/4 ((0 1.0 5/6) 1) (("hi" 'hi 3/4) 2) (else 3)) 2)
+(test (case (case (+ 1 2) (else 3)) ((3) (case (+ 2 2) ((2 3) 32) ((4) 33) ((5) 0)))) 33)
+(test (let ((x 1)) (case x ((0) (set! x 12)) ((2) (set! x 32))) x) 1)
+
+(test (case 1 (else #f)) #f)
+(test (let () (case 0 ((0) (define (hi a) a)) (else (define (hi a) (+ a 1)))) (hi 1)) 1)
+(test (let () (case 1 ((0) (define (hi a) a)) (else (define (hi a) (+ a 1)))) (hi 1)) 2)
+;(test (let () (case (define (hi a) a) ((hi) (hi 1)))) 1) ; 25-Jul-14
+(test (catch #t (lambda () (case 1 () ())) (lambda (t i) (apply format #f i))) "case clause is not a pair? (case 1 () ())")
+
+(for-each
+ (lambda (arg)
+   (test (case 1 ((0) 'gad) ((1 2 3) arg) (else 'gad)) arg))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(for-each
+ (lambda (arg)
+   (test (case arg ((0) 'gad) ((1 2 3) arg) (else 'gad)) 'gad))
+ (list "hi" -1 #\a 0 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(test (call/cc (lambda (r) (case 1 ((1) (r 123) #t) (else #f)))) 123)
+(test (call/cc (lambda (r) (case 1 ((0) 0) (else (r 123) #f)))) 123)
+
+(test (case () ((1) 1) ('() 2)) 2)
+(test (case (list) ((1) 1) ('() 2)) 2)
+(test (case () ((1) 1) ((()) 2)) 2)
+(test (case (list) ((1) 1) ((()) 2)) 2)
+(test (case #<eof> ((#<eof>) 1)) 1)
+(test (case #\newline ((#\newline) 1)) 1)
+(test (case 'c (else => (lambda (x) (symbol? x)))) #t)
+(test (case 1.0 ((1e0) 3) ((1.0) 4) (else 5)) 3)
+(test (let ((x :a)) (case x ((:b) 1) ((:a) 0) (else 3))) 0)
+
+(test (eval `(case ,+ ((,-) 0) ((,+) 1) (else 2))) 1)
+(test (case + ((#_-) 0) ((#_+) 2) (else 3)) 2)
+
+(define old-readers *#readers*)
+(set! *#readers* (cons (cons #\B
+                             (lambda (str)
+			       (bignum (string->number (substring str 1)))))
+			     *#readers*))
+(test (case (bignum 1) ((1) 2) (else #f)) 2)
+(test (case (bignum 1) ((#B1) 2) (else #f)) 2)
+(test (case 1 ((#B1) 2) (else #f)) 2)
+(set! *#readers* old-readers)
+
+;; check multiple-value selector
+(test (list (let ((x 1)) (case 1 ((1) (values 1 2 3)) (else 2)))) '(1 2 3))
+(test (list (dynamic-wind (lambda () #f) (lambda () (case (values 1 2 3) (else))) (lambda () #f))) '(1))
+(test (list ((lambda () (case (values 1 2 3) (else))))) '(1))
+(test (+ (case (call-with-exit (lambda (ret) (ret 1 2 3))) (else))) 1)
+(test (let ((m1 1)) (list (let-temporarily ((m1 1)) (values 1 2 3)))) '(1 2 3))
+(test (let ((m1 1)) (list (call-with-exit (lambda (r) (let-temporarily ((m1 1)) (r 1 2 3)))))) '(1 2 3))
+(test (let ((m1 1)) (list (call-with-exit (lambda (r) (let-temporarily ((m1 (r 1 2 3))) 4))))) '(1 2 3))
+
+(let ()
+  (define (c1 x)
+    (case x
+      ((3001) 1)
+      ((12345) 2)
+      ((8589934592) 3)
+      (else 4)))
+  (test (c1 3001) 1)
+  (test (c1 12345) 2)
+  (test (c1 8589934592) 3)
+  (test (c1 -1) 4)
+
+  (define (c2 x)
+    (case x
+      ((0 1 -1) 3)
+      ((9223372036854775807 -9223372036854775808) 4)
+      ((1.5) 5)
+      ((2/3 1+i) 6)))
+
+  (test (c2 -1) 3)
+  (test (c2 most-positive-fixnum) 4)
+  (test (c2 1.5) 5)
+  (test (c2 2/3) 6)
+  (test (c2 1+i) 6))
+
+(let ()
+  (define (f x)
+    (case x
+      ((0) 1)
+      ((0.0) 2)
+      (else 3)))
+  (test (f 0) 1)
+  (test (f 0.0) 2)
+  (test (f 1) 3))
+
+; case uses eqv? -- why not case-equal?
+(test (case "" (("") 1)) 1) ; was #<unspecified>
+(test (case abs ((abs) 1)) #<unspecified>)
+(test (case (if #f #f) ((1) 1) ((#<unspecified>) 2) (else 3)) 2)
+;;; if case falls through, it should return #<unspecified> (not #f for example):
+;;;   (case x ((a) 1)) should be equivalent to (if (eq? x 'a) 1)
+(let ((x 'b)) (test (case x ((a) 1)) (if (eq? x 'a) 1)))
+
+(test (case) 'error)
+(test (case 1) 'error)
+(test (case 1 . "hi") 'error)
+(test (case 1 ("hi")) 'error)
+(test (case 1 ("a" "b")) 'error)
+(test (case 1 (else #f) ((1) #t)) 'error)
+(test (case "hi" (("hi" "ho") 123) ("ha" 321)) 'error)
+(test (case) 'error)
+(test (case . 1) 'error)
+(test (case 1 . 1) 'error)
+(test (case 1 (#t #f) ((1) #t)) 'error)
+(test (case 1 (#t #f)) 'error)
+(test (case -1 ((-1) => abs)) 1)
+(test (case 1 (else =>)) 'error)
+(test (case 1 (else => + - *)) 'error)
+(test (case #t ((1 2) (3 4)) -1) 'error)
+(test (case 1 1) 'error)
+(test (case 1 ((2) 1) . 1) 'error)
+(test (case 1 (2 1) (1 1)) 'error)
+(test (case 1 (else)) 1)   ; case null 4-Jan-17
+(test (case () ((1 . 2) . 1) . 1) 'error)
+(test (case 1 ((1))) 1)                 ; case null
+(test (case 1 ((else))) #<unspecified>) ; case null -- unexpected but ...
+(test (case 1 ((2) 3) ((1))) 1)         ; case null
+(test (case 1 ((1)) 1 . 2) 'error)
+(test (case () ((()))) ())              ; case null
+(test (case 1 (else 3) . 1) 'error)
+(test (case 1 ((1 2)) (else 3)) 1)      ; case null
+(test (case 1 ('(1 2) 3) (else 4)) 4)
+(test (case 1 (('1 2) 3) (else 4)) 4)
+(test (case 1 ((1 . 2) 3) (else 4)) 'error) ; ?? in guile it's an error
+(test (case 1 ((1 2 . 3) 3) (else 4)) 'error)
+(test (case 1 (('1 . 2) 3) (else 4)) 'error)
+(test (case 1 ((1 . (2)) 3) (else 4)) 3)
+(test (case 1 ((1 2) . (3)) (else 4)) 3)
+(test (case 1 ((2) 3) (else)) 1)        ; case null
+(test (case 1 ((2) 3) ()) 'error)
+(test (case 1 ((2) 3) (() 2)) 'error) ; ?? in Guile this is #<unspecified>; our error is confusing: ;case clause key list () is not a list or 'else'
+(test (case () ('() 2)) 2)            ; ?? error??
+(test (case () ((()) 2)) 2)
+(test (case 1 else) 'error)
+(test (case 1 (((1) 1) 2) (else 3)) 2) ; the (1) can't be matched -- should it be an error?
+(test (case 1 ((1) . (else 3))) 3)     ; ?? guile says "unbound variable: else"
+(test (case . (1 ((2) 3) ((1) 2))) 2)
+(test (case 1 (#(1 2) 3)) 'error)
+(test (case 1 #((1 2) 3)) 'error)
+(test (case 1 ((2) 3) () ((1) 2)) 'error)
+(test (case 1 ((2) 3) (1 2) ((1) 2)) 'error)
+(test (case 1 ((2) 3) (1 . 2) ((1) 2)) 'error)
+(test (case 1 ((2) 3) (1) ((1) 2)) 'error)
+(test (case 1 ((2) 3) ((1)) ((1) 2)) 1)   ; case null
+(test (case 1 ((1) 2) ((1) 3)) 2) ; should this be an errror?
+(test (let () (define-macro (mac x) `(+ ,x 1)) (case 1 ((1) => mac))) 2)
+
+(test (let ((x 1)) (case x (else))) 1)
+(test (let ((x 1)) (case x ((0) 2) (else))) 1)
+(test (let ((x 1)) (case x ((1) 2) (else))) 2)
+(test (let ((x 1)) (case x ((0) 2))) #<unspecified>)
+(test (let ((x 1)) (case x ((1)) ((2) 0))) 1)
+(test (let ((x 1)) (case x ((lambda lambda*) (display "x") (+ 2 3)) ((case when) 3))) #<unspecified>)
+(test (let ((x 'lambda)) (case x ((lambda lambda*)) ((case when) (display "x") 3))) 'lambda)
+(test (let ((s "01234") (i 1)) (case (string-ref s i) ((#\3 #\4) 32) ((#\1 #\2)))) #\1)
+(test (let ((s "01234") (i 3)) (case (string-ref s i) ((#\3 #\4) 32) ((#\1 #\2)))) 32)
+(test (let ((head 'and)) (case head ((and if cond when)) ((or if2) (list 'not arg1)))) 'and)
+(test (let ((s "01234") (i 1)) (case (string-ref s i) ((#\1)) ((#\2) 32))) #\1)
+(test (let ((s "01234") (i 2)) (case (string-ref s i) ((#\1)) ((#\2) 32))) 32)
+(test (let ((x 'a)) (case x ((a)))) 'a)
+(test (case + ((-) 0) ((+)) (else 3)) 3)
+(test (case + ((-) 0) ((#_+)) (else 3)) +)
+
+;; check optimizer
+(let () (define (c1 s i) (case (string-ref s i) ((#\a) 1) ((#\i)))) (define (c3 s i) (c1 s i)) (c3 "hiho" 1) (test (c3 "hiho" 1) #\i))
+(let () (define (c1 s i) (case s (else))) (define (c3 s i) (c1 s i)) (c3 "hiho" 1) (test (c3 "hiho" 1) "hiho"))
+(let () (define (c1 s i) (case s (else))) (define (c3 s i) (c1 s i)) (c3 2 1) (test (c3 2 1) 2))
+(let () (define (c1 s i) (case s ((0) 2) (else))) (define (c3 s i) (c1 s i)) (c3 2 1) (test (c3 1 1) 1))
+(let () (define (c1 s i) (case s ((0) 2) (else))) (define (c3 s i) (c1 s i)) (c3 2 1) (test (c3 0 1) 2))
+(let () (define (c1 s i) (case s ((1) 2) (else))) (define (c3 s i) (c1 s i)) (c3 2 1) (test (c3 1 1) 2))
+(let () (define (c1 s i) (case s ((1) 2) (else))) (define (c3 s i) (c1 s i)) (c3 2 1) (test (c3 3 1) 3))
+(let () (define (c1 s i) (case s ((0) 2))) (define (c3 s i) (c1 s i)) (c3 2 1) (test (c3 1 1) #<unspecified>))
+(let () (define (c1 s i) (case s ((1)) ((2) 0))) (define (c3 s i) (c1 s i)) (c3 2 1) (test (c3 1 1) 1))
+(let () (define (c1 s i) (case s ((lambda lambda*)) ((case when) (display "x") 3))) (define (c3 s i) (c1 s i)) (c3 2 1) (test (c3 'lambda 1) 'lambda))
+(let () (define (c1 s i) (case (string-ref s i) ((#\3 #\4) 32) ((#\1 #\2)))) (define (c3 s i) (c1 s i)) (c3 "0123" 1) (test (c3 "01234" 1) #\1))
+(let () (define (c1 s i) (case s ((and if cond when)) ((or if2) (list 'not arg1)))) (define (c3 s i) (c1 s i)) (c3 2 1) (test (c3 'and 1) 'and))
+(let () (define (c1 s i) (case (string-ref s i) ((#\1)) ((#\2) 32))) (define (c3 s i) (c1 s i)) (c3 "0123" 1) (test (c3 "01234" 1) #\1))
+(let () (define (c1 s i) (case s ((a)))) (define (c3 s i) (c1 s i)) (c3 "0123" 1) (test (c3 'a 1) 'a))
+(let () (define (c1 s i) (case + ((-) 0) ((+)) ((#_+)) (else 3))) (define (c3 s i) (c1 s i)) (c3 "0123" 1) (test (c3 'a 1) +))
+(test (let () (define (f1) (let ((x 1)) (case 1 ((0) 0) ((1) 2) (else 3)))) (f1) (f1)) 2)
+(test (let () (define (f2) (let ((x 1)) (case x ((0) 0) ((1) 2) (else 3)))) (f2) (f2)) 2)
+(test (let () (define (f3) (let ((x 1)) (case (+ x (* x x) -1) ((0) 0) ((1) 2) (else 3)))) (f3) (f3)) 2)
+(test (let () (define (f11) (let ((x 2)) (case 2 ((0) 0) ((1) 2) (else 3)))) (f11) (f11)) 3)
+(test (let () (define (f12) (let ((x 2)) (case x ((0) 0) ((1) 2) (else 3)))) (f12) (f12)) 3)
+(test (let () (define (f13) (let ((x 2)) (case (+ x (abs (* x x))) ((0) 0) ((1) 2) (else 3)))) (f13) (f13)) 3)
+(test (let () (define (f21) (let ((x 2)) (case 2 ((0) 0) ((1) 2)))) (f21) (f21)) #<unspecified>)
+(test (let () (define (f22) (let ((x 2)) (case x ((0) 0) ((1) 2)))) (f22) (f22)) #<unspecified>)
+(test (let () (define (f23) (let ((x 2)) (case (+ x (abs (* x x))) ((0) 0) ((1) 2)))) (f23) (f23)) #<unspecified>)
+(test (let () (define (f31) (let ((x 'a)) (case x ((a) 0) ((b) 2) (else 3)))) (f31) (f31)) 0)
+(test (let () (define (f32) (let ((x '(a b))) (case (car x) ((a) 0) ((b) 2) (else 3)))) (f32) (f32)) 0)
+(test (let () (define (f33) (let ((x 'a)) (case (car (car (list (list x x)))) ((a) 0) ((b) 2) (else 3)))) (f33) (f33)) 0)
+(test (let () (define (f41) (let ((x 'c)) (case x ((a) 0) ((b) 2) (else 3)))) (f41) (f41)) 3)
+(test (let () (define (f42) (let ((x '(c b))) (case (car x) ((a) 0) ((b) 2) (else 3)))) (f42) (f42)) 3)
+(test (let () (define (f43) (let ((x 'c)) (case (car (car (list (list x x)))) ((a) 0) ((b) 2) (else 3)))) (f43) (f43)) 3)
+(test (let () (define (f51) (let ((x 'c)) (case x ((a) 0) ((b) 2)))) (f51) (f51)) #<unspecified>)
+(test (let () (define (f52) (let ((x '(c b))) (case (car x) ((a) 0) ((b) 2)))) (f52) (f52)) #<unspecified>)
+(test (let () (define (f53) (let ((x 'c)) (case (car (car (list (list x x)))) ((a) 0) ((b) 2)))) (f53) (f53)) #<unspecified>)
+(test (let () (define (f61) (let ((x 'a)) (case x ((a) 0) ((1) 2) (else 3)))) (f61) (f61)) 0)
+(test (let () (define (f62) (let ((x '(a b))) (case (car x) ((a) 0) ((1) 2) (else 3)))) (f62) (f62)) 0)
+(test (let () (define (f63) (let ((x 'a)) (case (car (car (list (list x x)))) ((a) 0) ((1) 2) (else 3)))) (f63) (f63)) 0)
+(test (let () (define (f71) (let ((x 'b)) (case x ((a) 0) ((1) 2) (else 3)))) (f71) (f71)) 3)
+(test (let () (define (f72) (let ((x '(b b))) (case (car x) ((a) 0) ((1) 2) (else 3)))) (f72) (f72)) 3)
+(test (let () (define (f73) (let ((x 'b)) (case (car (car (list (list x x)))) ((a) 0) ((1) 2) (else 3)))) (f73) (f73)) 3)
+(test (let () (define (f81) (let ((x 'b)) (case x ((a) 0) ((1) 2)))) (f81) (f81)) #<unspecified>)
+(test (let () (define (f82) (let ((x '(b b))) (case (car x) ((a) 0) ((1) 2)))) (f82) (f82)) #<unspecified>)
+(test (let () (define (f83) (let ((x 'b)) (case (car (car (list (list x x)))) ((a) 0) ((1) 2)))) (f83) (f83)) #<unspecified>)
+(test (let () (define (f91) (let ((x 'a)) (case x ((a) 0) ((b c) 2) (else 3)))) (f91) (f91)) 0)
+(test (let () (define (f92) (let ((x '(a b))) (case (car x) ((a) 0) ((b c) 2) (else 3)))) (f92) (f92)) 0)
+(test (let () (define (f93) (let ((x 'a)) (case (car (car (list (list x x)))) ((a) 0) ((b c) 2) (else 3)))) (f93) (f93)) 0)
+(test (let () (define (f101) (let ((x 'd)) (case x ((a) 0) ((b c) 2) (else 3)))) (f101) (f101)) 3)
+(test (let () (define (f102) (let ((x '(d b))) (case (car x) ((a) 0) ((b c) 2) (else 3)))) (f102) (f102)) 3)
+(test (let () (define (f103) (let ((x 'd)) (case (car (car (list (list x x)))) ((a) 0) ((b c) 2) (else 3)))) (f103) (f103)) 3)
+(test (let () (define (f111) (let ((x 'd)) (case x ((a) 0) ((b c) 2)))) (f111) (f111)) #<unspecified>)
+(test (let () (define (f112) (let ((x '(d b))) (case (car x) ((a) 0) ((b c) 2)))) (f112) (f112)) #<unspecified>)
+(test (let () (define (f113) (let ((x 'd)) (case (car (car (list (list x x)))) ((a) 0) ((b c) 2)))) (f113) (f113)) #<unspecified>)
+(test (let () (define (f121) (let ((x 'a)) (case x ((a) 0) ((b c 12) 2) (else 3)))) (f121) (f121)) 0)
+(test (let () (define (f122) (let ((x '(a b))) (case (car x) ((a) 0) ((b c 12) 2) (else 3)))) (f122) (f122)) 0)
+(test (let () (define (f123) (let ((x 'a)) (case (car (car (list (list x x)))) ((a) 0) ((b c 12) 2) (else 3)))) (f123) (f123)) 0)
+(test (let () (define (func) (let ((i 0)) (case #() ((null? i) i)))) (define (hi) (func) (func)) (hi) (hi)) #<unspecified>) ; case a_e_g not simple selector
+(when with-block (test (let ((i 0)) (let ((_f_ (lambda () (case (append (block) (block)) ((null? i) i))))) (_f_) (_f_))) #<unspecified>)) ; case p_e_g
+(test (let () (define (func) (let ((i 0)) ((lambda () (case (lambda sym-args sym-args) ((null? i) i)))))) (define (hi) (func) (func)) (hi) (hi)) #<unspecified>)
+
+(test (case 123 ((123) 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6)) 6)
+(unless with-bignums
+  (test (s7-optimize '((case 123 ((123) 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6)))) #<undefined>) ; check optimizer overflow bug
+  (test (s7-optimize '((case 123 ((123) 1 2 3 4 5 6 7 8 9 0 1)))) 1)
+  (test (s7-optimize '((case 123 ((123) 1 2 3 4 5 6 7 8 9 0 1 2)))) #<undefined>))
+
+;; newly optimized case
+(let ((lt (inlet 'a 1 'b 2)))
+  (define (c1 s) (case (let-ref lt s) ((#<undefined>) 3) (else)))
+  (define (c3 s) (c1 s)) (c3 'a)
+  (test (c3 'b) 2)
+  (test (c3 'a) 1)
+  (test (c3 'c) 3))
+(let ((lt (inlet 'a 1 'b 2)))
+  (define (c1 s) (case (let-ref lt s) ((#<eof> #<undefined>) 3) (else)))
+  (define (c3 s) (c1 s)) (c3 'a)
+  (test (c3 'b) 2)
+  (test (c3 'a) 1)
+  (test (c3 'c) 3))
+(let ((lt (inlet 'a 1 'b 2)))
+  (define (c1 s) (let ((x 1)) (case (let-ref lt s) ((#<undefined>) (set! x 2) (+ x 1)) (else))))
+  (define (c3 s) (c1 s))  (c3 'a)
+  (test (c3 'a) 1)
+  (test (c3 'c) 3))
+
+(let ()
+  (define (hi x) (case x ((a) 'a) ((b) 'b) (else 'c)))
+  (test (hi 'a) 'a)
+  (test (hi 'd) 'c))
+
+(test (case 'case ((case) 1) ((cond) 3)) 1)
+(test (case 101 ((0 1 2) 200) ((3 4 5 6) 600) ((7) 700) ((8) 800) ((9 10 11 12 13) 1300) ((14 15 16) 1600) ((17 18 19 20) 2000) ((21 22 23 24 25) 2500) ((26 27 28 29) 2900) ((30 31 32) 3200) ((33 34 35) 3500) ((36 37 38 39) 3900) ((40) 4000) ((41 42) 4200) ((43) 4300) ((44 45 46) 4600) ((47 48 49 50 51) 5100) ((52 53 54) 5400) ((55) 5500) ((56 57) 5700) ((58 59 60) 6000) ((61 62) 6200) ((63 64 65) 6500) ((66 67 68 69) 6900) ((70 71 72 73) 7300) ((74 75 76 77) 7700) ((78 79 80) 8000) ((81) 8100) ((82 83) 8300) ((84 85 86 87) 8700) ((88 89 90 91 92) 9200) ((93 94 95) 9500) ((96 97 98) 9800) ((99) 9900) ((100 101 102) 10200) ((103 104 105 106 107) 10700) ((108 109) 10900) ((110 111) 11100) ((112 113 114 115) 11500) ((116) 11600) ((117) 11700) ((118) 11800) ((119 120) 12000) ((121 122 123 124 125) 12500) ((126 127) 12700) ((128) 12800) ((129 130) 13000) ((131 132) 13200) ((133 134 135 136) 13600) ((137 138) 13800)) 10200)
+(test (case most-positive-fixnum ((-1231234) 0) ((9223372036854775807) 1) (else 2)) 1)
+(test (case most-negative-fixnum ((123123123) 0) ((-9223372036854775808) 1) (else 2)) 1)
+(test (case 0 ((3/4 "hi" #t) 0) ((#f #() -1) 2) ((#\a 0 #t) 3) (else 4)) 3)
+(test (case 3/4 ((3/4 "hi" #t) 0) ((#f #() hi) 2) ((#\a 0 #t) 3) (else 4)) 0)
+(test (case 'hi ((3/4 "hi" #t) 0) ((#f #() hi) 2) ((#\a 0 #t) 3) (else 4)) 2)
+(test (case #f ((3/4 "hi" #t) 0) ((#f #() hi) 2) ((#\a 0 #t) 3) (else 4)) 2)
+(test (case 3 ((3/4 "hi" #t) 0) ((#f #() hi) 2) ((#\a 0 #t) 3) (else 4)) 4)
+(test (case 0 ((values 0 1) 2) (else 3)) 2)
+(test (+ (case 0 ((0) (values 1 2 3))) 4) 10)
+(test (+ (case 1 ((0) (values 1 2 3)) (else (values 1 2))) 4) 7)
+
+(test (let ((else 3)) (case 0 ((1) 2) (else 3))) 3) ; changed my mind about this -- else is not evaluated here unless it's some other symbol
+(test (let ((otherwise else)) (case 0 ((1) 2) (otherwise 3))) 3) ; maybe this isn't a great idea...
+(test (let ((else 3)) (case else ((3) else))) 3)
+(test (case 0 ((1) 2) (else (let ((else 3)) else))) 3)
+(test (case 0 ((1) #t) ((2 else 3) #f) ((0) 0)) 0) ; should this be an error? (it isn't in Guile)
+(test (case 0 ((1) #t) ((else) #f) ((0) 0)) 0)
+(test (apply case 1 '(((0) -1) ((1) 2))) 2)
+(test (let ((x #(1))) (apply case x (list (list (list #()) 1) (list (list #(1)) 2) (list (list x) 3) (list 'else 4)))) 3)
+
+(let () ; opt_case tests
+  (define (tcase1)
+    (do ((v (int-vector 0))
+	 (i 0 (+ i 1))) ((= i 1) v)
+      (int-vector-set! v 0 (case 1 ((0) 0) ((1) 1) ((2) 2) (else 3)))))
+  (test (tcase1) #i(1))
+
+  (define (tcase2)
+    (do ((v (vector 'a 'b 'c 'd))
+	 (i 0 (+ i 1)))	((= i 1) v)
+      (vector-set! v 0 (case (v 1) ((a) 0) ((b) 1) ((c) 2) (else 3)))))
+  (test (tcase2) #(1 b c d)))
+
+(test (let ((x 0)) (let ((y (case 1 ((2) (set! x (+ x 3))) ((1) (set! x (+ x 4)) (+ x 2))))) (list x y))) '(4 6))
+(let ()
+  (define (hi a)
+    (case a
+      ((0) 1)
+      ((1) 2)
+      (else 3)))
+  (test (hi 1) 2)
+  (test (hi 2) 3)
+  (test (hi "hi") 3))
+
+(when with-bignums
+  (test (case 8819522415901031498123 ((1) 2) ((8819522415901031498123) 3) (else 4)) 3)
+  (test (case -9223372036854775809 ((1 9223372036854775807) 2) (else 3)) 3)
+  (let ()
+    (define (cgmp x) (case x ((0) 1) ((1) 2)))
+    (define (test-cgmp) (cgmp (bignum "1")))
+    (test (cgmp 0) 1)
+    (test (cgmp (bignum "1")) 2)
+    (test (cgmp (bignum "0")) 1)
+    (test (test-cgmp) 2)))
+
+;;; one thing that will hang case I think: circular key list
+
+;;; C-style case
+(define-macro (switch selector . clauses)
+  `(call-with-exit
+    (lambda (break)
+      (case ,selector
+	,@(do ((clause clauses (cdr clause))
+	       (new-clauses ()))
+	      ((null? clause) (reverse new-clauses))
+	    (set! new-clauses (cons `(,(caar clause)
+				      ,@(cdar clause)
+				      ,@(map (lambda (nc)
+					       (apply values (cdr nc)))
+					     (if (pair? clause) (cdr clause) ())))
+				    new-clauses)))))))
+
+(test (switch 1 ((1) (break 1)) ((2) 3) (else 4)) 1)
+(test (switch 2 ((1) (break 1)) ((2) 3) (else 4)) 4)
+(test (switch 4 ((1) (break 1)) ((2) 3) (else 4)) 4)
+
+(let ()
+  (call-with-output-file "test.scm"
+    (lambda (p)
+      (format p "(define (big-cond x)~%")
+      (format p "  (cond~%")
+      (do ((i 0 (+ i 1)))
+	  ((= i 1000))
+	(format p "    ((= x ~D) x)~%" i))
+      (format p "  ))~%~%")
+      (format p "(define (big-case x)~%")
+      (format p "  (case x~%")
+      (do ((i 0 (+ i 1)))
+	  ((= i 1000))
+	(format p "    ((~D) x)~%" i))
+      (format p "  ))~%~%")))
+  (load "test.scm" (curlet))
+  (test (big-cond 541) 541)
+  (test (big-case 541) 541))
+
+(let-temporarily (((*s7* 'safety) 1))
+  (test (apply case `(x . 1)
+	       (let ((<1> (list #f))
+		     (<2> (list #f #f)))
+		 (set-car! <1> <1>)
+		 (set-cdr! <1> <2>)
+		 (set-cdr! (cdr <2>) <2>)
+		 <1>)
+	       `((x . 1)))
+	'error))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; lambda
+;;; --------------------------------------------------------------------------------
+
+(test (procedure? (lambda (x) x)) #t)
+(test ((lambda (x) (+ x x)) 4) 8)
+(test (let ((reverse-subtract (lambda (x y) (- y x)))) (reverse-subtract 7 10)) 3)
+(test (let ((add4 (let ((x 4)) (lambda (y) (+ x y))))) (add4 6)) 10)
+(test ((lambda x x) 3 4 5 6) (list 3 4 5 6))
+(test ((lambda x x)) ())
+(test ((lambda (x y . z) z) 3 4 5 6) (list 5 6))
+(test ((lambda (a b c d e f) (+ a b c d e f)) 1 2 3 4 5 6) 21)
+(test (let ((foo (lambda () 9))) (+ (foo) 1)) 10)
+(test (let ((a 1)) (let ((f (lambda (x) (set! a x) a))) (let ((c (f 123))) (list c a)))) (list 123 123))
+(test (let ((a 1) (b (lambda (a) a))) (b 3)) 3)
+(test (let ((ctr 0)) (letrec ((f (lambda (x) (if (> x 0) (begin (set! ctr (+ ctr 1)) (f (- x 1))) 0)))) (f 10) ctr)) 10)
+(test (let ((f (lambda (x) (car x)))) (f '(4 5 6))) 4)
+(test ((lambda () ((lambda (x y) ((lambda (z) (* (car z) (cdr z))) (cons x y))) 3 4))) 12)
+(test (let ((ctr 0)) (define (f) (set! ctr (+ ctr 1)) ctr) (let ((x (f))) (let ((y (f))) (list x y ctr)))) (list 1 2 2))
+
+(test (let ((x 5)) (define foo (lambda (y) (bar x y))) (define bar (lambda (a b) (+ (* a b) a))) (foo (+ x 3))) 45)
+(test (let ((x 5)) (letrec ((foo (lambda (y) (bar x y))) (bar (lambda (a b) (+ (* a b) a)))) (foo (+ x 3)))) 45)
+
+(num-test (let () (define compose (lambda (f g) (lambda args (f (apply g args))))) ((compose sqrt *) 12 75))  30.0)
+(let ()
+  (define (compose . args) ; this just removes parens
+    (if (procedure? (car args))
+	(if (null? (cdr args))
+	    ((car args))
+	    ((car args) (apply compose (cdr args))))
+	(apply values args)))
+  (test (compose - + (lambda (a b c) (values a (* b c))) 2 3 4) -14)
+  (test (- (+ ((lambda (a b c) (values a (* b c))) 2 3 4))) -14)) ; I prefer this
+
+(test (let ((f (lambda () (lambda (x y) (+ x y))))) ((f) 1 2)) 3)
+(test ((lambda (x) (define y 4) (+ x y)) 1) 5)
+(test ((lambda(x)(define y 4)(+ x y))1) 5)
+(test ((lambda () (define (y x) (+ x 1)) (y 1))) 2)
+(test ((lambda (x) 123 (let ((a (+ x 1))) a)) 2) 3)
+(test ((lambda (x) "documentation" (let ((a (+ x 1))) a)) 2) 3)
+(test ((lambda (x) (x 1)) (lambda (y) (+ y 1))) 2)
+(test (let ((a 1)) (let ((b (lambda (x) (define y 1) (define z 2) (define a 3) (+ x y z a)))) (b a))) 7)
+(test ((lambda (f x) (f x x)) + 11) 22)
+(test ((lambda () (+ 2 3))) 5)
+(test (let ((x (let () (lambda () (+ 1 2))))) (x)) 3)
+(test (cond (0 => (lambda (x) x))) 0)
+(test ((lambda () "hiho")) "hiho")
+(test ((lambda()()))())
+(test ((lambda () _undef_)) _undef_)
+(when (zero? (*s7* 'debug)) (test (procedure-source (apply lambda (list) (list (list)))) '(lambda () ())))
+
+(test (letrec ((f (lambda (x) (g x)))
+	       (g (lambda (x) x)))
+	(let ((top (f 1)))
+	  (set! g (lambda (x) (- x)))
+	  (+ top (f 1))))
+      0)
+(let ()
+  (define (f8-1 x) (values (+ x 1) (+ x 2)))
+  (define (f8 a) ((lambda (w x y z) (+ w x y z)) (f8-1 a) (f8-1 (+ a 2))))
+  (test (f8 3) 22)
+
+  (define (err type info) 'error) ;(list type (apply format #f info)))
+
+  (define (f9) ((lambda () 32) 1))
+  (test (catch #t f9 err) 'error)
+  (test (catch #t f9 err) 'error)
+
+  (define (f10) ((lambda (x) x)))
+  (test (catch #t f10 err) 'error)
+  (test (catch #t f10 err) 'error)
+
+  (define (f11) ((lambda (x) x) 1 2))
+  (test (catch #t f11 err) 'error)
+  (test (catch #t f11 err) 'error)
+
+  (define (f12) ((lambda (x y) x) (values 1 2 3)))
+  (test (catch #t f12 err) 'error)
+  (test (catch #t f12 err) 'error)
+
+  (define (f13) ((lambda (x y) x) (values 3)))
+  (test (catch #t f13 err) 'error)
+  (test (catch #t f13 err) 'error))
+
+
+(for-each
+ (lambda (arg)
+   (test ((lambda (x) x) arg) arg))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(let ((list-length
+       (lambda (obj)
+	 (call-with-current-continuation
+	  (lambda (return)
+	    (letrec ((r (lambda (obj) (cond ((null? obj) 0)
+					    ((pair? obj) (+ (r (cdr obj)) 1))
+					    (else (return #f))))))
+	      (r obj)))))))
+  (test (list-length '(1 2 3 4)) 4)
+  (test (list-length '(a b . c)) #f))
+
+(test (let ((samples (vector 0 1 2 3 4 5 6 7 8 9 10)))
+	(let ((make-scaler
+	       (lambda (start end)
+		 (letrec ((ctr start)
+			  (us (lambda (them)
+				(vector-set! samples ctr (* 2 (vector-ref samples ctr)))
+				(set! ctr (+ ctr 2))
+				(if (<= ctr end)
+				    (them us)))))
+		   us))))
+	  ((make-scaler 0 11)
+	   (make-scaler 1 11)))
+	samples)
+      (vector 0 2 4 6 8 10 12 14 16 18 20))
+
+(test ((lambda (x . y) y) 1 2 '(3 . 4)) '(2 (3 . 4)))
+(test ((lambda (x . y) y) 1) ())
+(test ((lambda x x) ()) '(()))
+(test ((lambda x x)) ())
+(test ((lambda (x) x) ()) ())
+(test ((lambda (x) (+ x ((lambda (x) (+ x 1)) 2))) 3) 6)
+(test ((lambda (x) (define y 1) (+ x y)) 2) 3)
+(test ((lambda (a) "this is a doc string" a) 1) 1)
+(test ((lambda (a) "hiho" (define x 1) x) 2) 1)
+(test ((lambda (a) "hiho" (define x a) x) 2) 2)
+(test (let ((g (lambda () '3))) (= (g) 3)) #t)
+(test ((((lambda () lambda)) () 1)) 1)
+
+(test (let () ; PLP Scott p168
+	(define A
+	  (lambda ()
+	    (let* ((x 2)
+		   (C (lambda (P)
+			(let ((x 4))
+			  (P))))
+		   (D (lambda ()
+			x))
+		   (B (lambda ()
+			(let ((x 3))
+			  (C D)))))
+	      (B))))
+	(A))
+      2)
+
+#|
+;;; here s7 "do" uses set!
+(test (let ((funcs (make-vector 3 #f)))
+	(do ((i 0 (+ i 1)))
+	    ((= i 3))
+	  (vector-set! funcs i (lambda () (+ i 1))))
+	(+ ((vector-ref funcs 0))
+	   ((vector-ref funcs 1))
+	   ((vector-ref funcs 2))))
+      6)
+|#
+
+;;; the equivalent named let version:
+(test (let ((funcs (make-vector 3 #f)))
+	(let loop ((i 0))
+	  (if (< i 3)
+	      (begin
+		(vector-set! funcs i (lambda () (+ i 1)))
+		(loop (+ i 1)))))
+	(+ ((vector-ref funcs 0))
+	   ((vector-ref funcs 1))
+	   ((vector-ref funcs 2))))
+      6)
+
+(test (let ((i 1))
+	(let ((func1 (lambda () i)))
+	  (let ((i 2))
+	    (let ((func2 (lambda () i)))
+	      (+ (func1) (func2))))))
+      3)
+
+(test (let ((funcs (make-vector 3 #f)))
+	(map
+	 (lambda (i)
+	   (vector-set! funcs i (lambda () (+ i 1))))
+	 (list 0 1 2))
+	(+ ((vector-ref funcs 0))
+	   ((vector-ref funcs 1))
+	   ((vector-ref funcs 2))))
+      6)
+
+(test (let ((funcs (make-vector 3 #f)))
+	(for-each
+	 (lambda (i)
+	   (vector-set! funcs i (lambda () (+ i 1))))
+	 (list 0 1 2))
+	(+ ((vector-ref funcs 0))
+	   ((vector-ref funcs 1))
+	   ((vector-ref funcs 2))))
+      6)
+
+(test (let ((funcs (make-vector 3 #f)))
+	(sort! (list 0 1 2)
+	 (lambda (i j)
+	   (vector-set! funcs i (lambda () (+ i 1)))
+	   (> i j)))
+	(+ ((vector-ref funcs 0))
+	   ((vector-ref funcs 1))
+	   ((vector-ref funcs 2))))
+      6)
+
+(test (let ((funcs (make-vector 3 #f)))
+	(member 4 (list 0 1 2)
+	 (lambda (j i)
+	   (vector-set! funcs i (lambda () (+ i 1)))
+	   #f))
+	(+ ((vector-ref funcs 0))
+	   ((vector-ref funcs 1))
+	   ((vector-ref funcs 2))))
+      6)
+
+(test (let ((funcs (make-vector 3 #f)))
+	(assoc 4 (list (cons 0 0) (cons 1 0) (cons 2 0))
+	 (lambda (j i)
+	   (vector-set! funcs i (lambda () (+ i 1)))
+	   #f))
+	(+ ((vector-ref funcs 0))
+	   ((vector-ref funcs 1))
+	   ((vector-ref funcs 2))))
+      6)
+
+(test (let ((func #f))
+	(define (func1 x)
+	  (set! func (lambda () (+ x 1))))
+	(func1 1)
+	(+ (func)
+	   (let ()
+	     (func1 2)
+	     (func))))
+      5)
+
+(test (((lambda (x) (lambda () (+ x 1))) 32)) 33)
+
+(test (let ((func #f))
+	(define (func1 x)
+	  (set! func (lambda () (string-append x "-"))))
+	(func1 "hi")
+	(string-append (func)
+		       (let ()
+			 (func1 "ho")
+			 (func))))
+      "hi-ho-")
+
+(test (let ((func1 #f)
+	    (func2 #f))
+	(let ((x 1))
+	  (set! func1 (lambda () x))
+	  (set! func2 (lambda (y) (set! x y) y)))
+	(+ (func1)
+	   (let ()
+	     (func2 32)
+	     (func1))))
+      33)
+
+(test (let ((funcs (make-vector 3)))
+	(let ((hi (lambda (a) (vector-set! funcs (- a 1) (lambda () a)))))
+	  (hi 1) (hi 2) (hi 3)
+	  (+ ((vector-ref funcs 0))
+	     ((vector-ref funcs 1))
+	     ((vector-ref funcs 2)))))
+      6)
+
+(test (let ((hi (lambda (a) (+ a 1)))
+	    (ho (lambda (a) (a 32))))
+	(+ (hi (hi (hi 1)))
+	   (ho hi)))
+      37)
+
+(test (let ((x 0)
+	    (b 4)
+	    (f1 #f)
+	    (f2 #f))
+	(let ((x 1))
+	  (let ((x 2))
+	    (set! f1 (lambda (a) (+ a b x)))))
+	(let ((x 3))
+	  (let ((b 5))
+	    (set! f2 (lambda (a) (+ a b x)))))
+	(+ (f1 10) (f2 100)))  ; (+ 10 4 2) (+ 100 5 3)
+      124)
+
+(test ((if (> 3 2) + -) 3 2) 5)
+(test (let ((op +)) (op 3 2)) 5)
+(test (((lambda () +)) 3 2) 5)
+(test ((car (cons + -)) 3 2) 5)
+(test ((do ((i 0 (+ i 1))) ((= i 3) +) ) 3 2) 5)
+(test (((lambda (x) x) (lambda (x) x)) 3) 3)
+(test ((((lambda (x) x) (lambda (x) x)) (lambda (x) x)) 3) 3)
+(test (((lambda (x) (lambda (y) x)) 3) 4) 3)
+(test (((lambda (x) (lambda (x) x)) 3) 4) 4)
+(test (let ((x 32)) (((lambda (x) (lambda (y) x)) 3) x)) 3)
+(test ((call/cc (lambda (return) (return +))) 3 2) 5)
+(test ((call-with-values (lambda () (values +)) (lambda (x) x)) 3 2) 5)
+;(unless pure-s7 (test ((#_call-with-values (lambda () (values +)) (lambda (x) x)) 3 2) 5)) ; not semipermanent
+(test ((case '+ ((+) +)) 3 2) 5)
+(test ((case '+ ((-) -) (else +)) 3 2) 5)
+(test ((call/cc (lambda (return) (dynamic-wind (lambda () #f) (lambda () (return +)) (lambda () #f)))) 3 2) 5)
+(test (+ 1 ((call/cc (lambda (return) (dynamic-wind (lambda () #f) (lambda () (return +)) (lambda () #f)))) 3 2) 2) 8)
+(test (let ((lst (list + -))) ((car lst) 1 2 3)) 6)
+(test (let ((a +)) ((let ((b -)) (if (eq? a b) a *)) 2 3)) 6)
+(test ((list-ref (list + - * /) 0) 2 3) 5)
+(test (((if #t list-ref oops) (list + - * /) 0) 2 3) 5)
+(test ((((car (list car cdr)) (list car cdr)) (list + -)) 2 3) 5)
+(test (let ()
+	(define function lambda)
+	(define hiho (function (a) (+ a 1)))
+	(hiho 2))
+      3)
+(test ((lambda (a b c d e f g h i j k l m n o p q r s t u v x y z)
+	 (+ a b c d e f g h i j k l m n o p q r s t u v x y z))
+       1 2 3 4 5 6 7 8 9 11 12 13 14 15 16 17 18 19 21 22 23 24 25 26 27)
+      348)
+(test ((lambda (x) "a useless string" x) 32) 32)
+(test ((lambda (>< =0=? .arg.) (+ >< =0=? .arg.)) 1 2 3) 6)
+(test ((apply ((lambda () lambda)) ((lambda () (list 'a))) ((lambda () '((+ a 1))))) 3) 4)
+
+(define-constant (_?_3 a) #f)
+(let () (define (hi x) (_?_3 x)) (hi 1) (test (let ((x 1)) (hi x)) #f))
+(let () (define (_?_4 x y) x) (define (hi x) (_?_4 x (* x x (+ 1 x)))) (hi 1) (test (let ((x 1)) (hi x)) 1))
+(define-constant (_?_5 x) (if (zero? x) x (+ x (_?_5 (- x 1)))))
+(let () (define (hi x) (_?_5 x)) (hi 1) (test (let ((x 1)) (hi x)) 1))
+(let () (define (hi x) (_?_5 (_?_5 1))) (hi 1) (test (hi 1) 1))
+(let ((x 1)) (define (hi y) (set! x (* y y y))) (hi 1) (test (hi 1) 1))
+
+(let ((vvv1 (make-vector '(2 2)))) ; implicit closure call
+  (fill! vvv1 (lambda (a b . c) (list a b c)))
+  (define (func)
+    (let ((__x__ 1))
+      (do ((i 0 (+ i __x__)))
+	  ((= i __x__))
+	(vvv1 (+ i 1) 0 (make-vector 3 #f) ())
+	)))
+  (test (func) 'error)) ; #t))
+
+(let () ; from lisp bboard sasstat?
+  (define (last-elt lst)
+    (car (let no-tails ((cd lst))
+	   (if (pair? (cdr cd))
+	       (cdr (no-tails (cdr cd)))
+	       lst))))
+  (test (last-elt '(1 2 3)) 3))
+
+(let () ; from guile mailing list
+  (define (function-generator)
+    (let ((func #f))
+      (lambda () (set! func (let a () a)) func)))
+  (define x (function-generator))
+  (define y (function-generator))
+  (test (eq? (x) (y)) #f))
+
+(test
+ (let ()
+   (begin
+     (define f1 #f)
+     (define f2 #f)
+     (let ((lv 32))
+       (set! f1 (lambda (a) (+ a lv)))
+       (set! f2 (lambda (a) (- a lv)))))
+   (+ (f1 1) (f2 1)))
+ 2)
+
+(test ((lambda () => abs)) 'error)
+(test ((lambda () => => 3)) 'error)
+;; actually, both Guile and Gauche accept
+;; ((lambda () + 3)) and (begin + 3)
+;; but surely => is an undefined variable in this context?
+
+(test (lambda) 'error)
+(test (lambda (a) ) 'error)
+;; should this be an error: (lambda (a) (define x 1)) ?
+(test (lambda . 1) 'error)
+(test ((lambda . (x 1))) 1)
+(test ((lambda . ((x . y) 2)) 1) 2)
+(test ((lambda (x) . (x)) 1) 1)
+(test ((lambda . ((x) . (x))) 1) 1)
+(test ((lambda . (x . (x))) 1) '(1))
+(test ((lambda . ((x . ()) x)) 1) 1)
+(test (eval-string "((lambda . (x 1 . 3)) 1)") 'error)
+(test (let () (define x (lambda . 1))) 'error)
+
+(test (lambda 1) 'error)
+(test (lambda (x 1) x) 'error)
+(test (lambda "hi" 1) 'error)
+(test (lambda (x x) x) 'error)
+(test ((lambda (x x) x) 1 2) 'error)
+(test (lambda (x "a")) 'error)
+(test ((lambda (x y) (+ x y a)) 1 2) 'error)
+(test ((lambda ())) 'error)
+(test (lambda (x (y)) x) 'error)
+(test ((lambda (x) x . 5) 2) 'error)
+(test (lambda (1) #f) 'error)
+(test (eval-string "(lambda (x . y z) x)") 'error)
+(test ((lambda () 1) 1) 'error)
+(test ((lambda (()) 1) 1) 'error)
+(test ((lambda (x) x) 1 2) 'error)
+(test ((lambda (x) x)) 'error)
+(test ((lambda ("x") x)) 'error)
+(test ((lambda "x" x)) 'error)
+(test ((lambda (x . "hi") x)) 'error)
+(test (lambda ((:hi . "hi") . "hi") 1) 'error)
+(test ((lambda (x) (* quote ((x . 1) . 2))) 1) 'error)
+(test ((lambda* (a (quote . -1)) a)) 'error)
+(test (let () (define x (lambda (= i 0) i))) 'error)
+(test (let () (define x (lambda (arg)))) 'error)
+(test (let () (define (x (arg)))) 'error)
+
+(let-temporarily (((*s7* 'safety) 1)) ; not sure about these two -- cyclic bodies
+  (test (let ((lst (list '+ 1))) (set-cdr! (cdr lst) (cdr lst)) (apply lambda () lst ())) 'error)
+  (test (let ((lst (list '+ 1))) (set-cdr! (cdr lst) (cdr lst)) (apply lambda* () lst ())) 'error))
+
+(test (letrec ((f (lambda () f))) (object->string f :readable)) "(letrec ((f (lambda () f))) f)")
+(test (let ((f (lambda () f))) (object->string f :readable)) "(lambda () f)")
+(test (letrec ((f (let ((x 1)) (lambda () (f x))))) (object->string f :readable)) "(let ((x 1) ) (letrec ((f (lambda () (f x)))) f))") ; hmm
+
+(let ()
+  (define (fop11 a b c d e)
+    (abs a)
+    (floor b)
+    (+ a b c d e))
+  (define (tf12)
+    (let ((a 1) (b 2))
+      (fop11 a b (fop11 a b 1 2 3) (fop12) (fop12)))) ; hit op_any_closure_np_mv
+  (test (tf12) 'error))
+
+(let ()
+  ;; check that the set! below increments setfib's symbol_ctr so that closure_is_ok looks up setfib
+  (define setfib (lambda (n) #f))
+  (set! setfib (lambda (n) (if (< n 2) n (+ (setfib (- n 1)) (setfib (- n 2))))))
+  (test (setfib 10) 55))
+
+(test (let ((hi (lambda (a 0.0) (b 0.0) (+ a b)))) (hi)) 'error)
+(test (object->string
+       ((lambda (arg)
+	  (list arg
+		(list (quote quote)
+		      arg)))
+	(quote (lambda (arg)
+		 (list arg
+		       (list (quote quote)
+			     arg))))))
+      "((lambda (arg) (list arg (list (quote quote) arg))) (quote (lambda (arg) (list arg (list (quote quote) arg)))))")
+      ;; "((lambda (arg) (list arg (list 'quote arg))) '(lambda (arg) (list arg (list 'quote arg))))")
+      ;; was "(#1=(lambda (arg) (list arg (list 'quote arg))) '#1#)"
+
+(test ((apply lambda '((a) (+ a 1))) 2) 3)
+(test ((apply lambda '(() #f))) #f)
+(test ((apply lambda '(arg arg)) 3) '(3))
+(test ((apply lambda* '((a (b 1)) (+ a b))) 3 4) 7)
+(test ((apply lambda* '((a (b 1)) (+ a b))) 3) 4)
+
+(let ()
+  (define-macro (progv vars vals . body)
+    `(apply (apply lambda ,vars ',body) ,vals))
+  (test (let ((s '(one two)) (v '(1 2))) (progv s v (+ one two))) 3)
+  (test (progv '(one two) '(1 2) (+ one two)) 3))
+
+(test (lambda #(a b) a) 'error)
+(test (lambda* (#(a 1)) a) 'error)
+
+(test ((lambda (a) a) #<eof>) #<eof>)
+(test ((lambda () (let ((a #<undefined>)) a))) #<undefined>)
+
+(test (let () (define* (foo (a 0) (b (+ a 4)) (c (+ a 7))) (list a b c)) (foo :b 2 :a 60)) '(60 2 67))
+(test (let () (define* (f1 (a 0) (b (* 2 a))) (+ a b)) (f1 2)) 6) ; this used to be 2
+;; one oddness:
+(test (let () (define* (f1 (a (* b 2)) (b 3)) (list a b)) (f1 :b 1)) '(2 1))
+;; (f1) however would be an error?  or should we preset args if we can?
+
+(let ()
+  (define* (f1 (a (+ b 1)) (b (+ a 1))) (list a b))
+  (test (f1 1) '(1 2))
+  (test (f1 :b 1) '(2 1))
+  (test (f1 :b 0 :a 1) '(1 0))
+  (test (f1 :a 1) '(1 2))
+  (test (f1 2 3) '(2 3))
+  (test (f1) 'error))
+
+(let ()
+  (define* (f1 (a (if (number? b) (+ b 1) 3)) (b (+ a 1))) (list a b))
+  (test (f1) '(3 4)))
+
+(let ()
+  (define* (f1 (a 1) (b (+ a 1))) (+ a b))
+  (define* (f2 (a (f1))) a)
+  (test (f2) 3))
+
+(let ()
+  (define* (f1 (a 1) (b (+ a 1))) (+ a b))
+  (define* (f2 (a (f1)) (b (f1 2))) (list a b))
+  (test (f2) '(3 5)))
+
+#|
+(let () ; fx_tree special cases
+  (let () (define (func) (do ((x 0 (+ x 1)) (i 0 (+ i 1))) ((>= x 1) (#_let () (* 2 x 3 4))))) (test (func) 24))
+  (let () (define (func) (do ((x 0 (+ x 1)) (i 0 (+ i 1))) ((>= x 1) (((vector let) 0) () (* 2 x 3 4))))) (test (func) 24))
+  (let () (define (func) (do ((x 0 (+ x 1)) (i 0 (+ i 1))) ((>= x 1) ((let () letrec*) ((x 1234) (y 1/2)) (* 2 x 3 4))))) (test (func) 29616)))
+|#
+
+(let () ; bug-guile
+  (define (f . l)
+    (let lp2 ((i 0) (s 0) (l l))
+      (if (and (pair? l) (< i 64))
+          (lp2 (+ i 1)
+	       (if (car l)
+                   (logior (ash 1 i) s)
+                   s)
+               (cdr l))
+          s)))
+  (test (f #f 0 #f 0) 10))
+
+(let ((clet (immutable! (let () (define-constant a 1) (curlet))))) ; constant parameter op_f_np
+  (define (func)
+    (catch #t
+      (lambda ()
+	(with-let clet
+	  ((lambda (a) (+ a 1)) 2)
+	  0))
+      (lambda (type info)
+	(apply format #f info))))
+  (test (func) "lambda parameter a is a constant: (lambda (a) ...)")      ; check_lambda_args
+  (test (func) "lambda parameter a is a constant: ((lambda (a) ...) 2)")) ; op_f_np
+
+;;; --------------------------------------------------------------------------------
+;;; a bunch of tc/recur tests for the optimizer
+
+(let ()
+  ;; -------- OP_TC_IF_A_Z_LAA --------
+  (define (tc-if-a-z-laa-1 x y) (if (null? x) (begin (vector-set! y 0 32) y) (tc-if-a-z-laa-1 (cdr x) y)))
+  (test (tc-if-a-z-laa-1 '(1 2 3) #(1 2 3)) #(32 2 3))
+
+  (define (tc-if-a-z-laa-2 x y) (if (null? x) (copy y) (tc-if-a-z-laa-2 (cdr x) y)))
+  (test (tc-if-a-z-laa-2 '(1 2 3) #(1 2 3)) #(1 2 3))
+
+  (define (tc-if-a-z-laa-3 x y) (if (null? x) #f (tc-if-a-z-laa-3 (cdr x) y)))
+  (test (tc-if-a-z-laa-3 '(1 2 3) #(1 2 3)) #f)
+
+  (define (tc-if-a-z-laa-4 x y) (if (null? x) y (tc-if-a-z-laa-4 (cdr x) (+ y 1))))
+  (test (tc-if-a-z-laa-4 '(1 2 3) 0) 3)
+
+  (define (tc-if-a-z-laa-0-1 x y) (if (= x 0) y (tc-if-a-z-laa-0-1 (- x 1) (+ y 1))))
+  (test (tc-if-a-z-laa-0-1 10 0) 10)
+
+  (define (tc-if-a-z-laa-5 x y) (if (= x 0) y (tc-if-a-z-laa-5 (- x 1))))
+  (test (tc-if-a-z-laa-5 10 0) 'error)
+
+  (define (tc-if-a-z-laa-6 x y) (if (= x 0) y (tc-if-a-z-laa-6 (- x 1) (+ y 1) 0)))
+  (test (tc-if-a-z-laa-6 10 0) 'error)
+
+  (define (tc-if-a-z-laa-0-7 x y) (if (= x 0) y (tc-if-a-z-laa-0-7 (- x 1) (+ x 1))))
+  (test (tc-if-a-z-laa-0-7 10 0) 2)
+
+  (define (tc-if-a-z-laa-8 x y) (if (null? x) (begin (vector-set! y 0 32) (tc-if-a-z-laa-8 () 0)) (tc-if-a-z-laa-8 (cdr x) y)))
+  (test (tc-if-a-z-laa-8 '(1 2 3) #(1 2 3)) 'error)
+
+  (define (fx-tc-if-a-z-laa x y) (if (= x 0) y (fx-tc-if-a-z-laa (- x 1) (+ y 1))))
+  (test (let ((z 10)) (define (ftc-1 x) (+ x (fx-tc-if-a-z-laa 10 0))) (ftc-1 z)) 20)
+
+  ;; -------- OP_TC_IF_A_LAA_Z --------
+  (define (tc-if-a-laa-z-1 x y) (if (pair? x) (tc-if-a-laa-z-1 (cdr x) y) (begin (vector-set! y 0 32) y)))
+  (test (tc-if-a-laa-z-1 '(1 2 3) #(1 2 3)) #(32 2 3))
+
+  (define (tc-if-a-laa-z-2 x y) (if (pair? x) (tc-if-a-laa-z-2 (cdr x) y) (copy y)))
+  (test (tc-if-a-laa-z-2 '(1 2 3) #(1 2 3)) #(1 2 3))
+
+  (define (tc-if-a-laa-z-3 x y) (if (pair? x) (tc-if-a-laa-z-3 (cdr x) y) #f))
+  (test (tc-if-a-laa-z-3 '(1 2 3) #(1 2 3)) #f)
+
+  (define (tc-if-a-laa-z-4 x y) (if (pair? x) (tc-if-a-laa-z-4 (cdr x) (+ y 1)) y))
+  (test (tc-if-a-laa-z-4 '(1 2 3) 0) 3)
+
+  (define (tc-if-a-laa-z-0-1 x y) (if (> x 0) (tc-if-a-laa-z-0-1 (- x 1) (+ y 1)) y))
+  (test (tc-if-a-laa-z-0-1 10 0) 10)
+
+  (define (tc-if-a-laa-z-5 x y) (if (pair? x) (tc-if-a-laa-z-5 (cdr x)) y))
+  (test (tc-if-a-laa-z-5 '(1 2 3) 0) 'error)
+
+  (define (tc-if-a-laa-z-6 x y) (if (pair? x) (tc-if-a-laa-z-6) 0))
+  (test (tc-if-a-laa-z-6 '(1 2 3) 0) 'error)
+
+  (define (fx-tc-if-a-laa-z x y) (if (> x 0) (fx-tc-if-a-laa-z (- x 1) (+ y 1)) y))
+  (test (let ((z 10)) (define (ftc-2 x) (+ x (fx-tc-if-a-laa-z 10 0))) (ftc-2 z)) 20)
+
+  ;; -------- OP_TC_IF_A_Z_L3A --------
+  (define (tc-if-a-z-l3a-1 x y z) (if (null? x) (begin (vector-set! y 0 (+ z 32)) y) (tc-if-a-z-l3a-1 (cdr x) y (+ z 1))))
+  (test (tc-if-a-z-l3a-1 '(1 2 3) #(1 2 3) 1) #(36 2 3))
+
+  (define (tc-if-a-z-l3a-2 x y z) (if (null? x) (+ y z) (tc-if-a-z-l3a-2 (cdr x) y (+ z 1))))
+  (test (tc-if-a-z-l3a-2 '(1 2 3) 2 3) 8)
+
+  (define (tc-if-a-z-l3a-3 x y z) (if (null? x) (+ y z) (tc-if-a-z-l3a-3 (cdr x) y)))
+  (test (tc-if-a-z-l3a-3 '(1 2 3) #(1 2 3) 1) 'error)
+
+  (define (tc-if-a-z-l3a-4 x y z) (if (null? x) (+ y z) (tc-if-a-z-l3a-4 (cdr x) y z (+ z 1))))
+  (test (tc-if-a-z-l3a-4 '(1 2 3) #(1 2 3) 1) 'error)
+
+  ;; -------- OP_TC_IF_A_L3A_Z --------
+  (define (tc-if-a-l3a-z-1 x y z) (if (pair? x) (tc-if-a-l3a-z-1 (cdr x) y (+ z 1)) (begin (vector-set! y 0 (+ z 32)) y)))
+  (test (tc-if-a-l3a-z-1 '(1 2 3) #(1 2 3) 1) #(36 2 3))
+
+  ;; -------- OP_TC_IF_A_Z_IF_A_L3A_L3A --------
+  (define (l3a x y z) (if (> x y) z (if (< y z) (l3a x y (- z 1)) (l3a x (- y 1) z))))
+  (test (l3a 0 10 10) 0)
+
+  ;; -------- OP_TC_WHEN_LA --------
+  (define (when_la1 x)
+    (when (> x 0)
+      (when_la1 (- x 1))))
+  (test (when_la1 3) #<unspecified>)
+
+  (define (tc-when-la2 x) (when (> x 0) (tc-when-la2)))
+  (test (tc-when-la2 2) 'error)
+
+  (define (tc-when-la3 x) (when (> x 0) (tc-when-la3 (- x 1) 0 0)))
+  (test (tc-when-la3 2) 'error)
+
+  (define (tc-when-la4 x) (when (> x 0) (display x #f) (tc-when-la4 (- x 1))))
+  (test (tc-when-la4 2) #<unspecified>)
+
+  (define (tc-when-la5 x) (when (> x 0) (tc-when-la5 (- x 1) 0)))
+  (test (tc-when-la5 2) 'error)
+
+  ;; -------- OP_TC_WHEN_LAA --------
+  (define (when_laa1 x y)
+    (let loop ((x x) (y y))
+      (when (pair? x)
+        (set-car! y (car x))
+        (loop (cdr x) (cdr y))))
+    y)
+
+  (let ((x (make-list 20 #\a)) (y (make-list 20 #\b))) (when_laa1 x y) (test y (make-list 20 #\a)))
+
+  (define (tc-when-laa2 x y) (when (> x 0) (tc-when-laa2)))
+  (test (tc-when-laa2 2 0) 'error)
+
+  (define (tc-when-laa3 x y) (when (> x 0) (tc-when-laa3 (- x 1) y 0)))
+  (test (tc-when-laa3 2 0) 'error)
+
+  (define (tc-when-laa4 x y) (when (> x 0) (display x #f) (tc-when-laa4 (- x 1) y)))
+  (test (tc-when-laa4 2 0) #<unspecified>)
+
+  (define (tc-when-laa5 x y) (when (> x 0) (tc-when-laa5 (- x 1))))
+  (test (tc-when-laa5 2 0) 'error)
+
+  ;; -------- OP_TC_WHEN_L3A --------
+  (define (when_l3a x y z)
+    (when (> x 0)
+      (when_l3a (- x 1) (- y 2) (+ z 1))))
+  (test (when_l3a 1 2 3) #<unspecified>)
+
+  (define (tc-when-l3a2 x y z) (when (> x 0) (tc-when-l3a2)))
+  (test (tc-when-l3a2 2 0 0) 'error)
+
+  (define (tc-when-l3a3 x y z) (when (> x 0) (tc-when-l3a3 (- x 1) y 0 0)))
+  (test (tc-when-l3a3 2 0 0) 'error)
+
+  (define (tc-when-l3a4 x y z) (when (> x 0) (display x #f) (display y #f) (tc-when-l3a4 (- x 1) y z)))
+  (test (tc-when-l3a4 2 0 0) #<unspecified>)
+
+  (define (tc-when-l3a5 x y z) (when (> x 0) (tc-when-l3a5 (- x 1))))
+  (test (tc-when-l3a5 2 0 0) 'error)
+
+  ;; -------- OP_TC_IF_A_Z_LA --------
+  (define (tc-if-a-z-la-1 x) (if (zero? x) 3 (tc-if-a-z-la-1 (- x 1))))
+  (test (tc-if-a-z-la-1 10) 3)
+
+  (define (tc-if-a-z-la-2 x) (if (zero? x) (let ((z (+ x 1))) z) (tc-if-a-z-la-2 (- x 1))))
+  (test (tc-if-a-z-la-2 10) 1)
+
+  (define tc-if-a-z-la-3 (let ((y #(10))) (lambda (x) (if (zero? (vector-ref y 0)) y (tc-if-a-z-la-3 (vector-set! y 0 (- (vector-ref y 0) 1)))))))
+  (test (tc-if-a-z-la-3 10) #(0))
+
+  (define (tc-if-a-z-la-4 x) (if (zero? x) 3 (tc-if-a-z-la-4)))
+  (test (tc-if-a-z-la-4 10) 'error)
+
+  (define (tc-if-a-z-la x) (if (= x 0) 12 (tc-if-a-z-la (- x 1))))
+  (test (let ((z 10)) (define (ftc-2 x) (+ x (tc-if-a-z-la 10))) (ftc-2 z)) 22)
+
+  ;; -------- OP_TC_IF_A_LA_Z --------
+  (define (tc-if-a-la-z-1 x) (if (positive? x) (tc-if-a-la-z-1 (- x 1)) 3))
+  (test (tc-if-a-la-z-1 10) 3)
+
+  (define (tc-if-a-la-z-2 x) (if (positive? x) (tc-if-a-la-z-2 (- x 1)) (let ((z (+ x 1))) z)))
+  (test (tc-if-a-la-z-2 10) 1)
+
+  (define (tc-if-a-la-z-3 x) (if (positive? x) (tc-if-a-la-z-3 (- x 1) (+ y 1)) 3))
+  (test (tc-if-a-la-z-3 10) 'error)
+
+  (define (tc-if-a-la-z-4 x) (if (positive? x) (tc-if-a-la-z-4) 3))
+  (test (tc-if-a-la-z-4 10) 'error)
+
+  (define (fx-tc-if-a-la-z x) (if (> x 0) (fx-tc-if-a-la-z (- x 1)) 12))
+  (test (let ((z 10)) (define (ftc-3 x) (+ x (fx-tc-if-a-la-z 10))) (ftc-3 z)) 22)
+
+  ;; -------- OP_TC_COND_A_Z_LA --------
+  (define (tc-cond-a-z-la-1 x) (cond ((zero? x) 3) (else (tc-cond-a-z-la-1 (- x 1)))))
+  (test (tc-cond-a-z-la-1 10) 3)
+
+  (define (tc-cond-a-z-la-2 x) (cond ((zero? x) (let ((z (+ x 1))) z)) (else (tc-cond-a-z-la-2 (- x 1)))))
+  (test (tc-cond-a-z-la-2 10) 1)
+
+  (define tc-cond-a-z-la-3 (let ((y #(10))) (lambda (x) (cond ((zero? (vector-ref y 0)) y) (else (tc-cond-a-z-la-3 (vector-set! y 0 (- (vector-ref y 0) 1))))))))
+  (test (tc-cond-a-z-la-3 10) #(0))
+
+  (define (tc-cond-a-z-la-4 x) (cond ((zero? x) 3) (else (tc-cond-a-z-la-4))))
+  (test (tc-cond-a-z-la-4 10) 'error)
+
+  (define (tc-cond-a-z-la x) (cond ((= x 0) 12) (else (tc-cond-a-z-la (- x 1)))))
+  (test (let ((z 10)) (define (ftc-2 x) (+ x (tc-cond-a-z-la 10))) (ftc-2 z)) 22)
+
+  ;; -------- OP_TC_COND_A_LA_Z --------
+  (define (tc-cond-a-la-z-1 x) (cond ((positive? x) (tc-cond-a-la-z-1 (- x 1))) (else 3)))
+  (test (tc-cond-a-la-z-1 10) 3)
+
+  (define (tc-cond-a-la-z-2 x) (cond ((positive? x) (tc-cond-a-la-z-2 (- x 1))) (else (let ((z (+ x 1))) z))))
+  (test (tc-cond-a-la-z-2 10) 1)
+
+  (define (tc-cond-a-la-z-3 x) (cond ((positive? x) (tc-cond-a-la-z-3 (- x 1) (+ y 1))) (else 3)))
+  (test (tc-cond-a-la-z-3 10) 'error)
+
+  (define (tc-cond-a-la-z-4 x) (cond ((positive? x) (tc-cond-a-la-z-4)) (else 3)))
+  (test (tc-cond-a-la-z-4 10) 'error)
+
+  (define (fx-tc-cond-a-la-z x) (cond ((> x 0) (fx-tc-cond-a-la-z (- x 1))) (else 12)))
+  (test (let ((z 10)) (define (ftc-3 x) (+ x (fx-tc-cond-a-la-z 10))) (ftc-3 z)) 22)
+
+  (let ()
+    (define (if-a-z-la p)
+      (if (null? (cdr p))
+	  (car p)
+	  (if-a-z-la (cdr p))))
+
+    (define (cond-a-z-la p)
+      (cond ((null? (cdr p))
+	     (car p))
+	    (else (cond-a-z-la (cdr p)))))
+
+    (define (if-a-la-z p)
+      (if (pair? (cdr p))
+	  (if-a-la-z (cdr p))
+	  (car p)))
+
+    (define (cond-a-la-z p)
+      (cond ((pair? (cdr p))
+	     (cond-a-la-z (cdr p)))
+	    (else (car p))))
+
+    (define big-list (let ((L (make-list 5 0)))
+		       (set! (list-ref L 4) 1)
+		       L))
+
+    (define (f1)
+      (do ((i 0 (+ i 1))
+	   (sum 0))
+	  ((= i 2) sum)
+	(set! sum (+ sum (if-a-z-la big-list)))))
+
+    (define (f2)
+      (do ((i 0 (+ i 1))
+	   (sum 0))
+	  ((= i 2) sum)
+	(set! sum (+ sum (cond-a-z-la big-list)))))
+
+    (define (f3)
+      (do ((i 0 (+ i 1))
+	   (sum 0))
+	  ((= i 2) sum)
+	(set! sum (+ sum (if-a-la-z big-list)))))
+
+    (define (f4)
+      (do ((i 0 (+ i 1))
+	   (sum 0))
+	  ((= i 2) sum)
+	(set! sum (+ sum (cond-a-la-z big-list)))))
+
+    (test (f1) 2)
+    (test (f3) 2)
+    (test (f2) 2)
+    (test (f4) 2))
+
+  ;; -------- OP_TC_COND_A_Z_LAA --------
+  (define (tc-cond-a-z-laa-1 x q) (cond ((zero? x) q) (else (tc-cond-a-z-laa-1 (- x 1) (+ q 1)))))
+  (test (tc-cond-a-z-laa-1 10 0) 10)
+
+  (define (tc-cond-a-z-laa-2 x q) (cond ((zero? x) (let ((z (+ x q))) z)) (else (tc-cond-a-z-laa-2 (- x 1) (+ q 1)))))
+  (test (tc-cond-a-z-laa-2 10 0) 10)
+
+  (define tc-cond-a-z-laa-3 (let ((y #(10))) (lambda (x q) (cond ((zero? (vector-ref y 0)) q) (else (tc-cond-a-z-laa-3 (vector-set! y 0 (- (vector-ref y 0) 1)) (+ q 1)))))))
+  (test (tc-cond-a-z-laa-3 10 0) 10)
+
+  (define (tc-cond-a-z-laa-4 x q) (cond ((zero? x) q) (else (tc-cond-a-z-laa-4 x))))
+  (test (tc-cond-a-z-laa-4 10 0) 'error)
+
+  (define (tc-cond-a-z-laa-5 x q) (cond ((zero? x) q) (else (tc-cond-a-z-laa-5 x q q))))
+  (test (tc-cond-a-z-laa-5 10 0) 'error)
+
+  (define (tc-cond-a-z-laa-6 x q) (cond ((zero? x) q) (else (tc-cond-a-z-laa-6))))
+  (test (tc-cond-a-z-laa-6 10 0) 'error)
+
+  (define (tc-cond-a-z-laa x q) (cond ((= x 0) (+ q 2)) (else (tc-cond-a-z-laa (- x 1) (+ q 1)))))
+  (test (let ((z 10)) (define (ftc-2 x) (+ x (tc-cond-a-z-laa 10 0))) (ftc-2 z)) 22)
+
+  ;; -------- OP_TC_COND_A_LAA_Z --------
+  (define (tc-cond-a-laa-z-1 x q) (cond ((positive? x) (tc-cond-a-laa-z-1 (- x 1) (+ q 1))) (else q)))
+  (test (tc-cond-a-laa-z-1 10 0) 10)
+
+  (define (tc-cond-a-laa-z-2 x q) (cond ((positive? x) (tc-cond-a-laa-z-2 (- x 1) (+ q 1))) (else (let ((z (+ q x 1))) z))))
+  (test (tc-cond-a-laa-z-2 10 0) 11)
+
+  (define (tc-cond-a-laa-z-3 x q) (cond ((positive? x) (tc-cond-a-laa-z-3 (- x 1) (+ y 1) 1)) (else 3)))
+  (test (tc-cond-a-laa-z-3 10 0) 'error)
+
+  (define (tc-cond-a-laa-z-4 x q) (cond ((positive? x) (tc-cond-a-laa-z-4 x)) (else 3)))
+  (test (tc-cond-a-laa-z-4 10 0) 'error)
+
+  (define (fx-tc-cond-a-laa-z x q) (cond ((> x 0) (fx-tc-cond-a-laa-z (- x 1) (+ q 1))) (else (+ q 2))))
+  (test (let ((z 10)) (define (ftc-3 x) (+ x (fx-tc-cond-a-laa-z 10 0))) (ftc-3 z)) 22)
+
+  (let ()
+    (define (if-a-z-laa p q)
+      (if (null? p)
+	  q
+	  (if-a-z-laa (cdr p) (+ q (car p)))))
+
+    (define (cond-a-z-laa p q)
+      (cond ((null? p)
+	     q)
+	    (else (cond-a-z-laa (cdr p) (+ q (car p))))))
+
+    (define (if-a-laa-z p q)
+      (if (pair? p)
+	  (if-a-laa-z (cdr p) (+ q (car p)))
+	  q))
+
+    (define (cond-a-laa-z p q)
+      (cond ((pair? p)
+	     (cond-a-laa-z (cdr p) (+ q (car p))))
+	    (else q)))
+
+    (define big-list (let ((L (make-list 10 0)))
+		       (set! (list-ref L 9) 1)
+		       L))
+
+    (define (f1)
+      (do ((i 0 (+ i 1))
+	   (sum 0))
+	  ((= i 10) sum)
+	(set! sum (+ sum (if-a-z-laa big-list 0)))))
+
+    (define (f2)
+      (do ((i 0 (+ i 1))
+	   (sum 0))
+	  ((= i 10) sum)
+	(set! sum (+ sum (cond-a-z-laa big-list 0)))))
+
+    (define (f3)
+      (do ((i 0 (+ i 1))
+	   (sum 0))
+	  ((= i 10) sum)
+	(set! sum (+ sum (if-a-laa-z big-list 0)))))
+
+    (define (f4)
+      (do ((i 0 (+ i 1))
+	   (sum 0))
+	  ((= i 10) sum)
+	(set! sum (+ sum (cond-a-laa-z big-list 0)))))
+
+    (test (f1) 10)
+    (test (f3) 10)
+    (test (f2) 10)
+    (test (f4) 10))
+
+  ;; -------- OP_TC_IF_A_Z_IF_A_Z_LA --------
+  (define (tc-if-a-z-if-a-z-la-1 x) (if (zero? (modulo x 7)) x (if (zero? (modulo x 5)) x (tc-if-a-z-if-a-z-la-1 (+ x 1)))))
+  (test (tc-if-a-z-if-a-z-la-1 22) 25)
+  (test (tc-if-a-z-if-a-z-la-1 6) 7)
+
+  (define (tc-if-a-z-if-a-z-la-2 x) (if (zero? (modulo x 7)) x (if (zero? (modulo x 5)) x (tc-if-a-z-if-a-z-la-2))))
+  (test (tc-if-a-z-if-a-z-la-2 22) 'error)
+
+  (define (tc-if-a-z-if-a-z-la-3 x) (if (zero? (modulo x 7)) x (if (zero? (modulo x 5)) x (tc-if-a-z-if-a-z-la-3 x x))))
+  (test (tc-if-a-z-if-a-z-la-3 22) 'error)
+
+  (define (tc-if-a-z-if-a-z-la-4 x) (if (zero? (modulo x 7)) (begin (set! x (* 2 x)) x) (if (zero? (modulo x 5)) x (tc-if-a-z-if-a-z-la-4 (+ x 1)))))
+  (test (tc-if-a-z-if-a-z-la-4 6) 14)
+
+  (define (tc-if-a-z-if-a-z-la-5 x) (if (zero? (modulo x 7)) x (if (zero? (modulo x 5)) (let ((z (* 2 x))) z) (tc-if-a-z-if-a-z-la-5 (+ x 1)))))
+  (test (tc-if-a-z-if-a-z-la-5 22) 50)
+
+  (define (tc-if-a-z-if-a-z-la-6 x) (if (zero? (modulo x 7)) (- x 7) (if (negative? (modulo x 5)) (* x 2) (tc-if-a-z-if-a-z-la-6 (+ x 1)))))
+  (test (tc-if-a-z-if-a-z-la-6 22) 21)
+
+  ;; -------- OP_TC_AND_A_IF_A_Z_LA --------
+  (define (tc-and-a-if-a-z-la-1 x) (and (not (zero? (modulo x 17))) (if (zero? (modulo x 5)) x (tc-and-a-if-a-z-la-1 (+ x 1)))))
+  (test (tc-and-a-if-a-z-la-1 22) 25)
+  (test (tc-and-a-if-a-z-la-1 6) 10)
+
+  (define (tc-and-a-if-a-z-la-2 x) (and (not (zero? (modulo x 17))) (if (zero? (modulo x 5)) x (tc-and-a-if-a-z-la-2))))
+  (test (tc-and-a-if-a-z-la-2 22) 'error)
+
+  (define (tc-and-a-if-a-z-la-3 x) (and (not (zero? (modulo x 17))) (if (zero? (modulo x 5)) x (tc-and-a-if-a-z-la-3 x x))))
+  (test (tc-and-a-if-a-z-la-3 22) 'error)
+
+  (define (tc-and-a-if-a-z-la-4 x) (and (not (zero? (modulo x 17))) (if (zero? (modulo x 5)) x (tc-and-a-if-a-z-la-4 (+ x 1)))))
+  (test (tc-and-a-if-a-z-la-4 6) 10)
+
+  (define (tc-and-a-if-a-z-la-5 x) (and (not (zero? (modulo x 17))) (if (zero? (modulo x 5)) (let ((z (* 2 x))) z) (tc-and-a-if-a-z-la-5 (+ x 1)))))
+  (test (tc-and-a-if-a-z-la-5 22) 50)
+
+  (define (tc-and-a-if-a-z-la-6 x) (and (not (zero? (modulo x 17))) (if (zero? (modulo x 5)) (* x 2) (tc-and-a-if-a-z-la-6 (+ x 1)))))
+  (test (tc-and-a-if-a-z-la-6 22) 50)
+
+  (define (tc-and-a-if-a-z-la-7 x) (and (not (zero? (modulo x 17))) (if (zero? (modulo x 5)) (* x 2) (tc-and-a-if-a-z-la-7 (+ x 1)))))
+  (test (tc-and-a-if-a-z-la-7 17) #f)
+
+  ;; -------- OP_TC_AND_A_IF_A_LA_Z --------
+  (define (tc-and-a-if-a-la-z-1 x) (and (not (zero? (modulo x 17))) (if (positive? (modulo x 5)) (tc-and-a-if-a-la-z-1 (+ x 1)) x)))
+  (test (tc-and-a-if-a-la-z-1 22) 25)
+  (test (tc-and-a-if-a-la-z-1 6) 10)
+
+  (define (tc-and-a-if-a-la-z-2 x) (and (not (zero? (modulo x 17))) (if (positive? (modulo x 5)) (tc-and-a-if-a-la-z-2) x)))
+  (test (tc-and-a-if-a-la-z-2 22) 'error)
+
+  (define (tc-and-a-if-a-la-z-3 x) (and (not (zero? (modulo x 17))) (if (positive? (modulo x 5)) (tc-and-a-if-a-la-z-3 x x) x)))
+  (test (tc-and-a-if-a-la-z-3 22) 'error)
+
+  (define (tc-and-a-if-a-la-z-4 x) (and (not (zero? (modulo x 17))) (if (positive? (modulo x 5)) (tc-and-a-if-a-la-z-4 (+ x 1)) x)))
+  (test (tc-and-a-if-a-la-z-4 6) 10)
+
+  (define (tc-and-a-if-a-la-z-5 x) (and (not (zero? (modulo x 17))) (if (positive? (modulo x 5)) (tc-and-a-if-a-la-z-5 (+ x 1)) (let ((z (* 2 x))) z))))
+  (test (tc-and-a-if-a-la-z-5 22) 50)
+
+  (define (tc-and-a-if-a-la-z-6 x) (and (not (zero? (modulo x 17))) (if (positive? (modulo x 5)) (tc-and-a-if-a-la-z-6 (+ x 1)) (* x 2))))
+  (test (tc-and-a-if-a-la-z-6 22) 50)
+
+  (define (tc-and-a-if-a-la-z-7 x) (and (not (zero? (modulo x 17))) (if (positive? (modulo x 5)) (tc-and-a-if-a-la-z-7 (+ x 1))) (* x 2)))
+  (test (tc-and-a-if-a-la-z-7 17) #f)
+
+  ;; -------- OP_TC_COND_A_Z_A_Z_LA --------
+  (define (tc-cond-a-z-a-z-la-1 x) (cond ((zero? (modulo x 7)) x) ((zero? (modulo x 5)) x) (else (tc-cond-a-z-a-z-la-1 (+ x 1)))))
+  (test (tc-cond-a-z-a-z-la-1 22) 25)
+  (test (tc-cond-a-z-a-z-la-1 6) 7)
+
+  (define (tc-cond-a-z-a-z-la-2 x) (cond ((zero? (modulo x 7)) x) ((zero? (modulo x 5)) x) (else (tc-cond-a-z-a-z-la-2))))
+  (test (tc-cond-a-z-a-z-la-2 22) 'error)
+
+  (define (tc-cond-a-z-a-z-la-3 x) (cond ((zero? (modulo x 7)) x) ((zero? (modulo x 5)) x) (else (tc-cond-a-z-a-z-la-3 x x))))
+  (test (tc-cond-a-z-a-z-la-3 22) 'error)
+
+  (define (tc-cond-a-z-a-z-la-4 x) (cond ((zero? (modulo x 7)) (set! x (* 2 x)) x) ((zero? (modulo x 5)) x) (else (tc-cond-a-z-a-z-la-4 (+ x 1)))))
+  (test (tc-cond-a-z-a-z-la-4 6) 14)
+
+  (define (tc-cond-a-z-a-z-la-5 x) (cond ((zero? (modulo x 7)) x) ((zero? (modulo x 5)) (let ((z (* 2 x))) z)) (else (tc-cond-a-z-a-z-la-5 (+ x 1)))))
+  (test (tc-cond-a-z-a-z-la-5 22) 50)
+
+  (define (tc-cond-a-z-a-z-la-6 x) (cond ((zero? (modulo x 7)) (- x 7)) ((negative? (modulo x 5)) (* x 2)) (#t (tc-cond-a-z-a-z-la-6 (+ x 1)))))
+  (test (tc-cond-a-z-a-z-la-6 22) 21)
+
+  (let ((z (let ((zz (make-vector 30 0))) (do ((i 1 (+ i 1))) ((= i 30)) (vector-set! zz i i)) (vector-set! zz 10 #\space) zz)))
+    (define (tc-cond-a-z-a-z-la-7 x) (cond ((< 20 x 30) (+ (* x 2) 1)) ((> x 20) (* x 2)) (else (tc-cond-a-z-a-z-la-7 (vector-ref z (+ x 1))))))
+    (test (tc-cond-a-z-a-z-la-7 (vector-ref z 0)) 'error))
+
+  ;; -------- OP_TC_COND_A_Z_A_LA_Z --------
+  (define (tc-cond-a-z-a-la-z-1 x) (cond ((zero? (modulo x 17)) x) ((positive? (modulo x 5)) (tc-cond-a-z-a-la-z-1 (+ x 1))) (else x)))
+  (test (tc-cond-a-z-a-la-z-1 22) 25)
+  (test (tc-cond-a-z-a-la-z-1 6) 10)
+
+  (define (tc-cond-a-z-a-la-z-2 x) (cond ((zero? (modulo x 17)) x) ((positive? (modulo x 5)) (tc-cond-a-z-a-la-z-2)) (else x)))
+  (test (tc-cond-a-z-a-la-z-2 22) 'error)
+
+  (define (tc-cond-a-z-a-la-z-3 x) (cond ((zero? (modulo x 17)) x) ((positive? (modulo x 5)) (tc-cond-a-z-a-la-z-3 x x)) (else x)))
+  (test (tc-cond-a-z-a-la-z-3 22) 'error)
+
+  (define (tc-cond-a-z-a-la-z-4 x) (cond ((zero? (modulo x 17)) (set! x (* 2 x)) x) ((positive? (modulo x 5)) (tc-cond-a-z-a-la-z-4 (+ x 1))) (else x)))
+  (test (tc-cond-a-z-a-la-z-4 6) 10)
+
+  (define (tc-cond-a-z-a-la-z-5 x) (cond ((zero? (modulo x 17)) x) ((positive? (modulo x 5)) (tc-cond-a-z-a-la-z-5 (+ x 1))) (else (let ((z (* 2 x))) z))))
+  (test (tc-cond-a-z-a-la-z-5 22) 50)
+
+  (define (tc-cond-a-z-a-la-z-6 x) (cond ((zero? (modulo x 7)) (- x 7)) ((not (negative? (modulo x 5))) (tc-cond-a-z-a-la-z-6 (+ x 1))) (else (* x 2))))
+  (test (tc-cond-a-z-a-la-z-6 22) 21)
+
+  (define (tc-cond-a-z-a-la-z-7 x) (cond ((< 20 x 30) (let ((z (* x 2))) (+ z 1))) ((<= x 20)  (tc-cond-a-z-a-la-z-7 (+ x 1))) (else (* x 2))))
+  (test (tc-cond-a-z-a-la-z-7 0) 43)
+
+  (define (tc-cond-a-z-a-la-z-8 x) (cond ((and (< 20 x) (< x 30)) (let ((z (* x 2))) (+ z 1))) ((<= x 20)  (tc-cond-a-z-a-la-z-8 (+ x 1))) (else (* x 2))))
+  (test (tc-cond-a-z-a-la-z-8 0) 43)
+
+  (define (tc-cond-a-z-a-la-z-11 x) (cond ((let ((a x)) (< 20 a 30)) (let ((z (* x 2))) (+ z 1))) ((<= x 20) (tc-cond-a-z-a-la-z-11 (+ x 1))) (else (* x 2))))
+  (test (tc-cond-a-z-a-la-z-7 0) 43)
+
+  (define (tc-cond-a-z-a-la-z-12 x) (cond ((< 20 x 30) (let ((z (* x 2))) (+ z 1))) ((<= x 20) (tc-cond-a-z-a-la-z-12 (+ x 1))) (else (let ((a x)) (* a 2)))))
+  (test (tc-cond-a-z-a-la-z-12 0) 43)
+
+  (define (tc-cond-a-z-a-la-z-13 x) (cond ((< 20 x 30) (+ (* x 2) 1)) ((<= x 20) (tc-cond-a-z-a-la-z-13 (+ x 1))) (else (* x 2))))
+  (test (tc-cond-a-z-a-la-z-13 0) 43)
+
+  (define (tc-cond-a-z-a-la-z-14 x) (cond ((< 20 x 30) (+ (* x 2) 1)) ((<= x 20) (tc-cond-a-z-a-la-z-14 (+ x 1))) (else (* x 2))))
+  (test (tc-cond-a-z-a-la-z-14 3/4) 85/2)
+
+  (let ((z (let ((zz (make-vector 30 0))) (do ((i 1 (+ i 1))) ((= i 30)) (vector-set! zz i i)) (vector-set! zz 10 #\space) zz)))
+    (define (tc-cond-a-z-a-la-z-15 x) (cond ((< 20 x 30) (+ (* x 2) 1)) ((<= x 20) (tc-cond-a-z-a-la-z-15 (vector-ref z (+ x 1)))) (else (* x 2))))
+    (test (tc-cond-a-z-a-la-z-15 (vector-ref z 0)) 'error))
+
+  (define (tc-cond-a-z-a-la-z-16 x) (cond ((< 20 x 30) x) ((< x 20) (tc-cond-a-z-a-la-z-16 (+ x 1))) ((= x 20) 201) (else (* x 2))))
+  (test (tc-cond-a-z-a-la-z-16 0) 201)
+
+  ;; -------- OP_TC_IF_A_Z_IF_A_LA_Z --------
+  (define (tc-if-a-z-if-a-la-z-1 x) (if (zero? (modulo x 7)) x (if (positive? (modulo x 5)) (tc-if-a-z-if-a-la-z-1 (+ x 1)) x)))
+  (test (tc-if-a-z-if-a-la-z-1 22) 25)
+  (test (tc-if-a-z-if-a-la-z-1 6) 7)
+
+  (define (tc-if-a-z-if-a-la-z-2 x) (if (zero? (modulo x 7)) x (if (positive? (modulo x 5)) (tc-if-a-z-if-a-la-z-2) x)))
+  (test (tc-if-a-z-if-a-la-z-2 22) 'error)
+
+  (define (tc-if-a-z-if-a-la-z-3 x) (if (zero? (modulo x 7)) x (if (positive? (modulo x 5)) (tc-if-a-z-if-a-la-z-3 x x) x)))
+  (test (tc-if-a-z-if-a-la-z-3 22) 'error)
+
+  (define (tc-if-a-z-if-a-la-z-4 x) (if (zero? (modulo x 7)) (begin (set! x (* 2 x)) x) (if (positive? (modulo x 5)) (tc-if-a-z-if-a-la-z-4 (+ x 1)) x)))
+  (test (tc-if-a-z-if-a-la-z-4 6) 14)
+
+  (define (tc-if-a-z-if-a-la-z-5 x) (if (zero? (modulo x 7)) x (if (positive? (modulo x 5)) (tc-if-a-z-if-a-la-z-5 (+ x 1)) (let ((z (* 2 x))) z))))
+  (test (tc-if-a-z-if-a-la-z-5 22) 50)
+
+  (define (tc-if-a-z-if-a-la-z-6 x) (if (zero? (modulo x 7)) (- x 7) (if (positive? (modulo x 5)) (tc-if-a-z-if-a-la-z-6 (+ x 1)) (* x 2))))
+  (test (tc-if-a-z-if-a-la-z-6 22) 50)
+
+  ;; -------- OP_TC_IF_A_Z_IF_A_Z_LAA --------
+  (define (tc-if-a-z-if-a-z-laa-1 x y) (if (zero? (modulo x y)) x (if (zero? (modulo x 5)) x (tc-if-a-z-if-a-z-laa-1 (+ x 1) y))))
+  (test (tc-if-a-z-if-a-z-laa-1 22 7) 25)
+  (test (tc-if-a-z-if-a-z-laa-1 6 7) 7)
+
+  (define (tc-if-a-z-if-a-z-laa-2 x y) (if (zero? (modulo x y)) x (if (zero? (modulo x 5)) x (tc-if-a-z-if-a-z-laa-2))))
+  (test (tc-if-a-z-if-a-z-laa-2 22 7) 'error)
+
+  (define (tc-if-a-z-if-a-z-laa-3 x y) (if (zero? (modulo x y)) x (if (zero? (modulo x 5)) x (tc-if-a-z-if-a-z-laa-3 x))))
+  (test (tc-if-a-z-if-a-z-laa-3 22 7) 'error)
+
+  (define (tc-if-a-z-if-a-z-laa-4 x y) (if (zero? (modulo x y)) (begin (set! x (* 2 x)) x) (if (zero? (modulo x 5)) x (tc-if-a-z-if-a-z-laa-4 (+ x 1) y))))
+  (test (tc-if-a-z-if-a-z-laa-4 6 7) 14)
+
+  (define (tc-if-a-z-if-a-z-laa-5 x y) (if (zero? (modulo x y)) x (if (zero? (modulo x 5)) (let ((z (* 2 x))) z) (tc-if-a-z-if-a-z-laa-5 (+ x 1) y))))
+  (test (tc-if-a-z-if-a-z-laa-5 22 7) 50)
+
+  (define (tc-if-a-z-if-a-z-laa-6 x y) (if (zero? (modulo x y)) x (if (zero? (modulo x 5)) x (tc-if-a-z-if-a-z-laa-6 x y y))))
+  (test (tc-if-a-z-if-a-z-laa-6 22 7) 'error)
+
+  ;; -------- OP_TC_IF_A_Z_IF_A_LAA_Z --------
+  (define (tc-if-a-z-if-a-laa-z-1 x y) (if (zero? (modulo x y)) x (if (positive? (modulo x 5)) (tc-if-a-z-if-a-laa-z-1 (+ x 1) y) x)))
+  (test (tc-if-a-z-if-a-laa-z-1 22 7) 25)
+  (test (tc-if-a-z-if-a-laa-z-1 6 7) 7)
+
+  (define (tc-if-a-z-if-a-laa-z-2 x y) (if (zero? (modulo x y)) x (if (positive? (modulo x 5)) (tc-if-a-z-if-a-laa-z-2) x)))
+  (test (tc-if-a-z-if-a-laa-z-2 22 7) 'error)
+
+  (define (tc-if-a-z-if-a-laa-z-3 x y) (if (zero? (modulo x y)) x (if (positive? (modulo x 5)) (tc-if-a-z-if-a-laa-z-3 x) x)))
+  (test (tc-if-a-z-if-a-laa-z-3 22 7) 'error)
+
+  (define (tc-if-a-z-if-a-laa-z-4 x y) (if (zero? (modulo x y)) (begin (set! x (* 2 x)) x) (if (positive? (modulo x 5)) (tc-if-a-z-if-a-laa-z-4 (+ x 1) y) x)))
+  (test (tc-if-a-z-if-a-laa-z-4 6 7) 14)
+
+  (define (tc-if-a-z-if-a-laa-z-5 x y) (if (zero? (modulo x y)) x (if (positive? (modulo x 5)) (tc-if-a-z-if-a-laa-z-5 (+ x 1) y) (let ((z (* 2 x))) z))))
+  (test (tc-if-a-z-if-a-laa-z-5 22 7) 50)
+
+  (define (tc-if-a-z-if-a-laa-z-6 x y) (if (zero? (modulo x y)) x (if (positive? (modulo x 5)) (tc-if-a-z-if-a-laa-z-6 x y y) x)))
+  (test (tc-if-a-z-if-a-laa-z-6 22 7) 'error)
+
+  ;; -------- OP_TC_LET_IF_A_Z_LA --------
+
+  (define (tc-let-if-a-z-la-1 x) (let ((y (- x 1))) (if (<= y 0) 0 (tc-let-if-a-z-la-1 (- x 1)))))
+  (test (tc-let-if-a-z-la-1 3) 0)
+
+  (define (tc-let-if-a-z-la-2 x) (let ((y (- x 1))) (if (<= y 1) (let* ((z (* 2 x))) (+ z 1)) (tc-let-if-a-z-la-2 (- x 1)))))
+  (test (tc-let-if-a-z-la-2 3) 5)
+
+  (define (tc-let-if-a-z-la-3 x) (let ((y (- x 1))) (if (<= y 0) 0 (tc-let-if-a-z-la-3 (- x 1) 2))))
+  (test (tc-let-if-a-z-la-3 3) 'error)
+
+  (define (tc-let-if-a-z-la-4 x) (let ((y (- x 1))) (if (<= y 0) 0 (tc-let-if-a-z-la-4))))
+  (test (tc-let-if-a-z-la-4 3) 'error)
+
+  (define (tc-let-if-a-z-la-5 x) (let ((y (- x 1))) (if (<= y 0) (* x 12) (tc-let-if-a-z-la-5 (- x 1)))))
+  (test (tc-let-if-a-z-la-5 3) 12)
+
+  ;; -------- OP_TC_LET_IF_A_Z_LAA --------
+  (define (tc-let-if-a-z-laa-1 x y) (let ((z (+ y 1))) (if (null? x) z (tc-let-if-a-z-laa-1 (cdr x) (+ y 1)))))
+  (test (tc-let-if-a-z-laa-1 '(1 2 3) 0) 4)
+
+  (define (tc-let-if-a-z-laa-2 x y) (let ((z (+ y 1))) (if (null? x) z (tc-let-if-a-z-laa-2 (cdr x)))))
+  (test (tc-let-if-a-z-laa-2 '(1 2 3) 0) 'error)
+
+  (define (tc-let-if-a-z-laa-3 x y) (let ((z (+ y 1))) (if (null? x) z (tc-let-if-a-z-laa-3))))
+  (test (tc-let-if-a-z-laa-3 '(1 2 3) 0) 'error)
+
+  (define (tc-let-if-a-z-laa-4 x y) (let ((z (+ y 1))) (if (null? x) (let ((zz (* z 2))) (+ zz 1)) (tc-let-if-a-z-laa-4 (cdr x) (+ y 1)))))
+  (test (tc-let-if-a-z-laa-4 '(1 2 3) 0) 9)
+
+  ;; -------- OP_TC_IF_A_Z_LET_IF_A_Z_LAA --------
+  (define (tc-if-a-z-let-if-a-z-laa-1 x y) (if (> y 0) y (let* ((z (+ y 1))) (if (null? x) z (tc-if-a-z-let-if-a-z-laa-1 (cdr x) (+ y 1))))))
+  (test (tc-if-a-z-let-if-a-z-laa-1 '(1 2 3) -6) -2)
+
+  (define (tc-if-a-z-let-if-a-z-laa-2 x y) (if (> y 0) y (let* ((z (- y 1)) (zz (+ z 2))) (if (null? x) zz (tc-if-a-z-let-if-a-z-laa-2 (cdr x) (+ y 1))))))
+  (test (tc-if-a-z-let-if-a-z-laa-2 '(1 2 3) -6) -2)
+
+  (define (tc-if-a-z-let-if-a-z-laa-3 x y) (if (< y 0) (car (cons (values y x))) (let* ((z (- y 1)) (zz (+ z 2))) (if (null? x) zz (tc-if-a-z-let-if-a-z-laa-3 (cdr x) (+ y 1))))))
+  (test (tc-if-a-z-let-if-a-z-laa-3 '(1 2 3) -6) -6)
+
+  (define (tc-if-a-z-let-if-a-z-laa-4 x y) (if (> y 0) y (let* ((z (- y 1)) (zz (+ z 2))) (if (null? x) (car (cons (values zz z))) (tc-if-a-z-let-if-a-z-laa-4 (cdr x) (+ y 1))))))
+  (test (tc-if-a-z-let-if-a-z-laa-4 '(1 2 3) -6) -2)
+
+  (define (tc-if-a-z-let-if-a-z-laa-5 x y) (if (> y 0) y (let* ((z (+ y 1))) (if (null? x) z (tc-if-a-z-let-if-a-z-laa-5 (+ y 1))))))
+  (test (tc-if-a-z-let-if-a-z-laa-5 '(1 2 3) -6) 'error)
+
+  (define (tc-if-a-z-let-if-a-z-laa-6 x y) (if (> y 0) y (let* ((z (+ y 1))) (if (null? x) z (tc-if-a-z-let-if-a-z-laa-6)))))
+  (test (tc-if-a-z-let-if-a-z-laa-6 '(1 2 3) -6) 'error)
+
+  (let ((x 32) (y 32) (z 32) (zz 32))
+    (define (tc-if-a-z-let-if-a-z-laa-7 x y) (if (> y 0) y (let* ((z (- y 1)) (zz (+ z 2))) (if (null? x) zz (tc-if-a-z-let-if-a-z-laa-7 (cdr x) (+ y 1))))))
+    (test (tc-if-a-z-let-if-a-z-laa-7 '(1 2 3) -6) -2))
+
+  ;; -------- OP_TC_AND_A_OR_A_LA --------
+  (define (tc-and-a-or-a-la-1 x) (and (positive? x) (or (= x 10) (tc-and-a-or-a-la-1 (+ x 1)))))
+  (test (tc-and-a-or-a-la-1 1) #t)
+  (test (tc-and-a-or-a-la-1 -1) #f)
+
+  (define (tc-and-a-or-a-la-3 x) (and (positive? x) (or (= x 10) (tc-and-a-or-a-la-3 (- x 1)))))
+  (test (tc-and-a-or-a-la-3 9) #f)
+
+  (define (tc-and-a-or-a-la-4 x) (and (positive? x) (or (= x 10) (tc-and-a-or-a-la-4))))
+  (test (tc-and-a-or-a-la-4 9) 'error)
+
+  (define (tc-and-a-or-a-la-5 x) (and (positive? x) (or (= x 10) (tc-and-a-or-a-la-5 x x))))
+  (test (tc-and-a-or-a-la-5 9) 'error)
+
+  ;; -------- OP_TC_AND_A_OR_A_A_LA --------
+  (define (tc-and-a-or-a-a-la-1 x) (and (positive? x) (or (= x 10) (= x 9) (tc-and-a-or-a-a-la-1 (+ x 1)))))
+  (test (tc-and-a-or-a-a-la-1 1) #t)
+  (test (tc-and-a-or-a-a-la-1 -1) #f)
+
+  (define (tc-and-a-or-a-a-la-3 x) (and (positive? x) (or (= x 10) (= x 9) (tc-and-a-or-a-a-la-3 (- x 1)))))
+  (test (tc-and-a-or-a-a-la-3 8) #f)
+
+  (define (tc-and-a-or-a-a-la-4 x) (and (positive? x) (or (= x 10) (= x 9) (tc-and-a-or-a-a-la-4))))
+  (test (tc-and-a-or-a-a-la-4 8) 'error)
+
+  (define (tc-and-a-or-a-a-la-5 x) (and (positive? x) (or (= x 10) (= x 9) (tc-and-a-or-a-a-la-5 x x))))
+  (test (tc-and-a-or-a-a-la-5 8) 'error)
+
+  ;; -------- OP_TC_OR_A_AND_A_A_LA --------
+  (test (letrec ((symbols?
+	          (lambda (x)
+	            (or (null? x)
+		        (and (pair? x)
+		             (symbol? (car x))
+			     (symbols? (cdr x)))))))
+          (symbols? '(a b c))) #t)
+
+  (define (tc-or-a-and-a-a-la-1 x) (or (positive? x) (and (< x 10) (< x 9) (tc-or-a-and-a-a-la-1))))
+  (test (tc-or-a-and-a-a-la-1 -8) 'error)
+
+  ;; -------- OP_TC_OR_A_AND_A_LA --------
+  (define (tc-or-a-and-a-la-1 x) (or (null? x) (and (integer? (car x)) (tc-or-a-and-a-la-1 (cdr x)))))
+  (test (tc-or-a-and-a-la-1 '(1 2 3 4)) #t)
+  (test (tc-or-a-and-a-la-1 '(1 2 3.1 4)) #f)
+
+  (define (tc-or-a-and-a-la-2 x) (or (null? x) (and (integer? (car x)) (tc-or-a-and-a-la-2))))
+  (test (tc-or-a-and-a-la-2 '(1 2 3 4)) 'error)
+
+  (define (tc-or-a-and-a-la-3 x) (or (null? x) (and (integer? (car x)) (tc-or-a-and-a-la-3 #f #t))))
+  (test (tc-or-a-and-a-la-3 '(1 2 3 4)) 'error)
+
+  ;; -------- OP_TC_AND_A_OR_A_LAA --------
+  (define (tc-and-a-or-a-laa-1 x y) (and (pair? x) (or (= y (car x)) (tc-and-a-or-a-laa-1 (cdr x) y))))
+  (test (tc-and-a-or-a-laa-1 '(1 2 3 4) 3) #t)
+  (test (tc-and-a-or-a-laa-1 '(1 2 3 4) 0) #f)
+  (test (let () (define (ftc x) (and (pair? x) (tc-and-a-or-a-laa-1 '(1 2 3 4) 3))) (ftc '(1))) #t)
+
+  (define (tc-and-a-or-a-laa-2 x y) (and (pair? x) (or (= y (car x)) (tc-and-a-or-a-laa-2))))
+  (test (tc-and-a-or-a-laa-2 '(1 2 3 4) 3) 'error)
+
+  ;; -------- OP_TC_OR_A_AND_A_LAA --------
+  (define (tc-or-a-and-a-laa-1 x y) (or (null? x) (and (= y (car x)) (tc-or-a-and-a-laa-1 (cdr x) y))))
+  (test (tc-or-a-and-a-laa-1 '(1 1 1 1) 1) #t)
+  (test (tc-or-a-and-a-laa-1 '(1 1 2 1) 1) #f)
+
+  (define (tc-or-a-and-a-laa-2 x y) (or (null? x) (and (= y (car x)) (tc-or-a-and-a-laa-2 (cdr x)))))
+  (test (tc-or-a-and-a-laa-2 '(1 1 1 1) 1) 'error)
+
+  ;; -------- OP_TC_AND_A_OR_A_L3A --------
+  (define (tc-and-f6 x y z) (and (> x 0) (or (= y 0) (tc-and-f6 (- x 1) (- y 1) 0))))
+  (test (tc-and-f6 2 4 0) #f)
+  (test (tc-and-f6 2 4 0) #f)
+
+  (define (tc-and-a-or-a-l3a-1 x y z) (and (positive? x) (or (= x 10) (tc-and-a-or-a-l3a-1 (+ x 1) y z))))
+  (test (tc-and-a-or-a-l3a-1 1 0 0) #t)
+  (test (tc-and-a-or-a-l3a-1 -1 0 0) #f)
+
+  (define (tc-and-a-or-a-l3a-3 x y z) (and (positive? x) (or (= x 10) (tc-and-a-or-a-l3a-3 (- x 1) y z))))
+  (test (tc-and-a-or-a-l3a-3 9 0 0) #f)
+
+  (define (tc-and-a-or-a-l3a-4 x y z) (and (positive? x) (or (= x 10) (tc-and-a-or-a-l3a-4))))
+  (test (tc-and-a-or-a-l3a-4 9 0 0) 'error)
+
+  (define (tc-and-a-or-a-l3a-5 x y z) (and (positive? x) (or (= x 10) (tc-and-a-or-a-l3a-5 x x y z))))
+  (test (tc-and-a-or-a-l3a-5 9 0 0) 'error)
+
+  ;; -------- OP_TC_OR_A_AND_A_L3A --------
+  (define (tc-and-f7 x y z) (or (<= x 0) (and (> y 0) (tc-and-f7 (- x 1) (- y 1) 0))))
+  (test (tc-and-f7 2 4 0) #t)
+  (test (tc-and-f7 2 4 0) #t)
+
+  (define (tc-or-a-and-a-l3a-1 x y z) (or (null? x) (and (integer? (car x)) (tc-or-a-and-a-l3a-1 (cdr x) y z))))
+  (test (tc-or-a-and-a-l3a-1 '(1 2 3 4) 0 0) #t)
+  (test (tc-or-a-and-a-l3a-1 '(1 2 3.1 4) 0 0) #f)
+
+  (define (tc-or-a-and-a-l3a-2 x y z) (or (null? x) (and (integer? (car x)) (tc-or-a-and-a-l3a-2))))
+  (test (tc-or-a-and-a-l3a-2 '(1 2 3 4) 0 0) 'error)
+
+  (define (tc-or-a-and-a-l3a-3 x y z) (or (null? x) (and (integer? (car x)) (tc-or-a-and-a-l3a-3 #f #t y z))))
+  (test (tc-or-a-and-a-l3a-3 '(1 2 3 4) 0 0) 'error)
+
+  ;; -------- OP_TC_OR_A_A_AND_A_A-LA --------
+  (define (tc-or-a-a-and-a-a-la-1 x) (or (null? x) (number? x) (and (pair? x) (integer? (car x)) (tc-or-a-a-and-a-a-la-1 (cdr x)))))
+  (test (tc-or-a-a-and-a-a-la-1 '(1 2 3 4)) #t)
+  (test (tc-or-a-a-and-a-a-la-1 '(1 2 3.1 4)) #f)
+
+  (define (tc-or-a-a-and-a-a-la-2 x) (or (null? x) (number? x) (and (pair? x) (integer? (car x)) (tc-or-a-a-and-a-a-la-2))))
+  (test (tc-or-a-a-and-a-a-la-2 '(1 2 3 4)) 'error)
+
+  (define (tc-or-a-a-and-a-a-la-3 x) (or (null? x) (number? x) (and (pair? x) (integer? (car x)) (tc-or-a-a-and-a-a-la-3 #f #t))))
+  (test (tc-or-a-a-and-a-a-la-3 '(1 2 3 4)) 'error)
+
+  ;; -------- OP_TC_OR_A_AND_A_A_L3A --------
+  (define (tc-or-a-and-a-a-l3a-1 x y z) (or (= x 0) (and (> y 1) (> z 1) (tc-or-a-and-a-a-l3a-1 (- x 1) (- y 1) (- z 1)))))
+  (test (tc-or-a-and-a-a-l3a-1 2 3 4) #t)
+
+  (define (tc-or-a-and-a-a-l3a-2 x y z) (or (call-with-exit (lambda (cc) (= x 0))) (and (> y 1) (> z 1) (tc-or-a-and-a-a-l3a-2 (- x 1) (- y 1) (- z 1)))))
+  (test (tc-or-a-and-a-a-l3a-2 2 3 4) #t)
+
+  (define (tc-or-a-and-a-a-l3a-3 x y z) (or (= x 0) (and (> y 1) (> z 1) (tc-or-a-and-a-a-l3a-3 (- x 1) (- z 1)))))
+  (test (tc-or-a-and-a-a-l3a-3 2 3 4) 'error)
+
+  ;; -------- OP_TC_IF_A_T_AND_A_A_L3A --------
+  (define (tc-if-a-t-and-a-a-l3a-1 x y z) (if (= x 0) #t (and (> y 1) (> z 1) (tc-if-a-t-and-a-a-l3a-1 (- x 1) (- y 1) (- z 1)))))
+  (test (tc-if-a-t-and-a-a-l3a-1 2 3 4) #t)
+
+  ;; -------- OP_TC_LET_WHEN_LAA, OP_TC_LET_UNLESS_LAA --------
+  (define (tc-let-when-laa-1 x y) (let ((z (iterate x))) (when (and (integer? z) (> z y)) (tc-let-when-laa-1 x y))))
+  (test (let ((x (make-iterator '(1 2 3 4)))) (tc-let-when-laa-1 x 2) (iterate x)) 2)
+  (test (let ((x (make-iterator '(1 2 3 4)))) (tc-let-when-laa-1 x 0) (iterate x)) #<eof>)
+  (test (let ((x (make-iterator '(3 4 1 2)))) (tc-let-when-laa-1 x 2) (iterate x)) 2)
+
+  (define (tc-let-when-laa-2 x y) (let ((z (iterate x))) (when (and (integer? z) (> z y)) (tc-let-when-laa-2 x))))
+  (test (let ((x (make-iterator '(3 4 1 2)))) (tc-let-when-laa-2 x 2) (iterate x)) 'error)
+
+  (define (tc-let-unless-laa-1 x y) (let ((z (iterate x))) (unless (> z y) (tc-let-unless-laa-1 x y))))
+  (test (let ((x (make-iterator '(1 2 3 4)))) (tc-let-unless-laa-1 x 2) (iterate x)) 4)
+
+  (define (tc-let-unless-laa-2 x y) (let ((z (iterate x))) (unless (> z y) (tc-let-unless-laa-2))))
+  (test (let ((x (make-iterator '(1 2 3 4)))) (tc-let-unless-laa-2 x 2) (iterate x)) 'error)
+
+  (define (tc-let-unless-laa-3 x y) (let ((z (iterate x))) (unless (> z y) (tc-let-unless-laa-3 x y z))))
+  (test (let ((x (make-iterator '(1 2 3 4)))) (tc-let-unless-laa-3 x 2) (iterate x)) 'error)
+
+  (define (tc-let-unless-laa-4 x y) (let ((z (iterate x)) (zz (iterate x))) (unless (> z y) (tc-let-unless-laa-4 x y))))
+  (test (let ((x (make-iterator '(1 2 3 4 5 6)))) (tc-let-unless-laa-4 x 2) (iterate x)) 5)
+
+  ;; -------- OP_TC_COND_A_Z_A_Z_LAA --------
+  (define (tc-cond-a-z-a-z-laa-1 x y) (cond ((= x 0) y) ((= y 100) y) (else (tc-cond-a-z-a-z-laa-1 (- x 1) (+ y 1)))))
+  (test (tc-cond-a-z-a-z-laa-1 10 0) 10)
+
+  (define (tc-cond-a-z-a-z-laa-2 s i) (cond ((< i 0) #f) ((char=? (string-ref s i) #\a) i) (else (tc-cond-a-z-a-z-laa-2 s (- i 1)))))
+  (test (tc-cond-a-z-a-z-laa-2 "asdasdf" 6) 3)
+  (test (tc-cond-a-z-a-z-laa-2 "sdsdfsd" 6) #f)
+
+  (define (tc-cond-a-z-a-z-laa-3 s i) (cond ((< i 0) #f) ((char=? (string-ref s i) #\a) i) (else (tc-cond-a-z-a-z-laa-3 (- i 1)))))
+  (test (tc-cond-a-z-a-z-laa-3 "asdasdf" 6) 'error)
+
+  (define (tc-cond-a-z-a-z-laa-4 s i) (cond ((< i 0) #f) ((char=? (string-ref s i) #\a) i) (else (tc-cond-a-z-a-z-laa-4))))
+  (test (tc-cond-a-z-a-z-laa-4 "asdasdf" 6) 'error)
+
+  (define (tc-cond-a-z-a-z-laa-5 x y) (cond ((= x 0) y) ((= y 100) (+ y 1)) (else (tc-cond-a-z-a-z-laa-5 (- x 1) (+ x 1)))))
+  (test (tc-cond-a-z-a-z-laa-5 10 0) 2)
+  (test (tc-cond-a-z-a-z-laa-5 10 100) 101)
+
+  (define (tc-cond-a-z-a-z-laa-6 x y) (cond ((= x 0) (let ((z x)) (- y z))) ((= y 100) y) (else (tc-cond-a-z-a-z-laa-6 (- x 1) (+ x 1)))))
+  (test (tc-cond-a-z-a-z-laa-6 10 0) 2)
+
+  (define (tc-cond-a-z-a-z-laa-7 x y) (cond ((= x 0) y) ((= y 100) (let ((z (+ y 1))) (* z 2))) (else (tc-cond-a-z-a-z-laa-7 (- x 1) (+ x 1)))))
+  (test (tc-cond-a-z-a-z-laa-7 10 0) 2)
+  (test (tc-cond-a-z-a-z-laa-7 10 100) 202)
+
+  ;; -------- OP_TC_COND_A_Z_A_LAA_Z --------
+  (define (tc-cond-a-z-a-laa-z-1 x y) (cond ((= x 0) y) ((not (= y 100)) (tc-cond-a-z-a-laa-z-1 (- x 1) (+ y 1))) (else y)))
+  (test (tc-cond-a-z-a-laa-z-1 10 0) 10)
+
+  (define (tc-cond-a-z-a-laa-z-2 s i) (cond ((< i 0) #f) ((not (char=? (string-ref s i) #\a)) (tc-cond-a-z-a-laa-z-2 s (- i 1))) (else i)))
+  (test (tc-cond-a-z-a-laa-z-2 "asdasdf" 6) 3)
+  (test (tc-cond-a-z-a-laa-z-2 "sdsdfsd" 6) #f)
+
+  (define (tc-cond-a-z-a-laa-z-3 s i) (cond ((< i 0) #f) ((not (char=? (string-ref s i) #\a)) (tc-cond-a-z-a-laa-z-3 (- i 1))) (else i)))
+  (test (tc-cond-a-z-a-laa-z-3 "asdasdf" 6) 'error)
+
+  (define (tc-cond-a-z-a-laa-z-4 s i) (cond ((< i 0) #f) ((not (char=? (string-ref s i) #\a)) (tc-cond-a-z-a-laa-z-4)) (else i)))
+  (test (tc-cond-a-z-a-laa-z-4 "asdasdf" 6) 'error)
+
+  (define (tc-cond-a-z-a-laa-z-5 x y) (cond ((= x 0) y) ((not (= y 100)) (tc-cond-a-z-a-laa-z-5 (- x 1) (+ x 1))) (else (+ y 1))))
+  (test (tc-cond-a-z-a-laa-z-5 10 0) 2)
+  (test (tc-cond-a-z-a-laa-z-5 10 100) 101)
+
+  (define (tc-cond-a-z-a-laa-z-6 x y) (cond ((= x 0) (let ((z x)) (- y z))) ((not (= y 100)) (tc-cond-a-z-a-laa-z-6 (- x 1) (+ x 1))) (else y)))
+  (test (tc-cond-a-z-a-laa-z-6 10 0) 2)
+
+  (define (tc-cond-a-z-a-laa-z-7 x y) (cond ((= x 0) y) ((not (= y 100)) (tc-cond-a-z-a-laa-z-7 (- x 1) (+ x 1))) (else (let ((z (+ y 1))) (* z 2)))))
+  (test (tc-cond-a-z-a-laa-z-7 10 0) 2)
+  (test (tc-cond-a-z-a-laa-z-7 10 100) 202)
+
+  ;; -------- OP_TC_COND_A_Z_A_LAA_LAA --------
+  (define (tc-cond-a-z-a-laa-laa-1 x y) (cond ((= x 0) y)	((= y 100) (tc-cond-a-z-a-laa-laa-1 0 0)) (else (tc-cond-a-z-a-laa-laa-1 (- x 1) (+ y 1)))))
+  (test (tc-cond-a-z-a-laa-laa-1 10 0) 10)
+  (test (tc-cond-a-z-a-laa-laa-1 10 100) 0)
+
+  (define (tc-cond-a-z-a-laa-laa-2 x y) (cond ((= x 0) y)	((= y 100) (tc-cond-a-z-a-laa-laa-1 0 0)) (else (tc-cond-a-z-a-laa-laa-2 (- x 1)))))
+  (test (tc-cond-a-z-a-laa-laa-2 10 0) 'error)
+
+  (define (tc-cond-a-z-a-laa-laa-3 x y) (cond ((= x 0) y)	((= y 100) (tc-cond-a-z-a-laa-laa-3 0 0)) (else (tc-cond-a-z-a-laa-laa-3))))
+  (test (tc-cond-a-z-a-laa-laa-3 10 0) 'error)
+
+  (define (tc-cond-a-z-a-laa-laa-4 x y) (cond ((= x 0) y)	((= y 100) (tc-cond-a-z-a-laa-laa-1)) (else (tc-cond-a-z-a-laa-laa-1 (- x 1) (+ y 1)))))
+  (test (tc-cond-a-z-a-laa-laa-4 10 100) 'error)
+
+  ;; -------- OP_TC_LET_COND --------
+  (define (tc-let-cond-1 x) (let ((z (+ x 1))) (cond ((= x 0) z) ((tc-let-cond-1 (- x 1)))))) ; does not reach check_tc -- unsafe body
+  (test (tc-let-cond-1 10) 1) ; 1 because the recursive call is the test, and there's no result, so the test result is what we get! yikes...
+
+  (define (tc-let-cond-2 x) (let ((z (+ x 1))) (cond ((= x 0) z) (else (tc-let-cond-2)))))
+  (test (tc-let-cond-2 10) 'error)
+
+  (define (tc-let-cond-3 x) (let ((z (+ x 1))) (cond ((= x 0) z) (#t (tc-let-cond-3 (- x 1))))))
+  (test (tc-let-cond-3 10) 1)
+
+  (define (tc-let-cond-4 x) (let ((z (+ x 1))) (cond ((= x 0) (let ((v (+ z 1))) (* 2 v))) (#t (tc-let-cond-4 (- x 1))))))
+  (test (tc-let-cond-4 10) 4)
+
+  (define (tc-let-cond-5 x y) (let ((z (+ x y))) (cond ((= x 1) #\o) ((= y 1) #\O) ((= z 0) #\z) (else (tc-let-cond-5 (- x 1) (+ y 1))))))
+  (test (tc-let-cond-5 0 0) #\z)
+  (test (tc-let-cond-5 1 1) #\o)
+  (test (tc-let-cond-5 -1 -1) #\O)
+
+  ;; -------- OP_TC_CASE_LA --------
+  (define (tc-case-1 x)
+    (case (car x)
+      ((#\a) 1)
+      ((#\b) 2)
+      (else (tc-case-1 (cdr x)))))
+
+  (test (tc-case-1 '(1 #f #\a 95)) 1)
+  (test (tc-case-1 '(1 #f #\b #\a 95)) 2)
+
+  (define (tc-case-2 x)
+    (case (car x)
+      ((#\a) 1)
+      ((#\b) (tc-case-2 (cdr x)))
+      (else (tc-case-2 (cdr x)))))
+
+  (test (tc-case-2 '(1 #f #\b #\a 95)) 1)
+
+  (define (tc-case-3 x)
+    (case (car x)
+      ((#\a) (let ((a 1)) (+ a 1)))
+      ((#\b) (tc-case-3 (cdr x)))
+      (else 1)))
+
+  (test (tc-case-3 '(#\b #\b #\a 95)) 2)
+  (test (tc-case-3 '(#\b #\b 95 #\1)) 1)
+
+  (define (tc-case-4 x)
+    (case (car x)
+      ((#\a) 1)
+      ((#\b) 2)
+      ((integer?) (length (symbol->string (car x))))
+      (else (tc-case-4 (cdr x)))))
+
+  (test (tc-case-4 '(1 #f integer? #\b #\a 95)) 8)
+
+  (define (case-5 x)
+    (case (car x)
+      ((#\a) 1)
+      ((#\b))  ; not handled in tc_case
+      ((integer?) 3)
+      (else (case-5 (cdr x)))))
+
+  (test (case-5 '(1 #f #\b #\a 95)) #\b)
+
+  (define (case-6 x)
+    (case (car x)
+      ((#\a) 1)
+      ((#\b) => char->integer)  ; not handled in tc_case
+      ((integer?) 3)
+      (else (case-6 (cdr x)))))
+
+  (test (case-6 '(1 #f #\b #\a 95)) 98)
+
+  (define (case-7 x)
+    (let ((y 123))
+      (let tc-case-7 ((x x))
+	(case (car x)
+	  ((#\a) (set! y 124) (+ y 1))
+	  (else (tc-case-7 (cdr x)))))))
+
+  (test (case-7 '(1 #f #\a 95)) 125)
+
+  ;; -------- OP_RECUR_IF_A_A_opA_LAq --------
+  (define (recur-if-a-a-opa-laq-1 x) (if (= x 0) 0 (+ 1 (recur-if-a-a-opa-laq-1 (- x 1)))))
+  (test (recur-if-a-a-opa-laq-1 10) 10)
+
+  (define (recur-if-a-a-opa-laq-2 x) (if (= x 0) 0 (+ 1 (recur-if-a-a-opa-laq-2))))
+  (test (recur-if-a-a-opa-laq-2 10) 'error)
+
+  (define (recur-if-a-a-opa-laq-3 x) (if (= x 0) 0 (+ 1 (recur-if-a-a-opa-laq-3 (- x 1) 2))))
+  (test (recur-if-a-a-opa-laq-3 10) 'error)
+
+  (define (recur-if-a-a-opa-laq-4 x) (if (= x 0) (call-with-exit (lambda (cc) 0)) (+ 1 (recur-if-a-a-opa-laq-4 (- x 1)))))
+  (test (recur-if-a-a-opa-laq-4 10) 10)
+
+  (let ()
+    (define (copy-list-1 lis)
+      (if (not (pair? lis)) lis (cons (car lis) (copy-list-1 (cdr lis)))))
+    (define (ftc-4 lis) (copy-list-1 lis))
+    (test (ftc-4 '(1 2 3)) '(1 2 3)))
+
+  ;; -------- OP_RECUR_IF_A_A_opLA_Aq --------
+  (define (recur-if-a-a-opla-aq-1 x) (if (= x 0) 0 (+ (recur-if-a-a-opla-aq-1 (- x 1)) 1)))
+  (test (recur-if-a-a-opla-aq-1 10) 10)
+
+  (define (recur-if-a-a-opla-aq-2 x) (if (= x 0) 0 (+ (recur-if-a-a-opla-aq-2) 1)))
+  (test (recur-if-a-a-opla-aq-2 10) 'error)
+
+  (define (recur-if-a-a-opla-aq-3 x) (if (= x 0) 0 (+ (recur-if-a-a-opla-aq-3 (- x 1) 2) 1)))
+  (test (recur-if-a-a-opla-aq-3 10) 'error)
+
+  (define (recur-if-a-a-opla-aq-4 x) (if (= x 0) (call-with-exit (lambda (cc) 0)) (+ (recur-if-a-a-opla-aq-4 (- x 1)) 1)))
+  (test (recur-if-a-a-opla-aq-4 10) 10)
+
+  (let ()
+    (define (copy-list-2 lis)
+      (if (not (pair? lis)) lis (cons (copy-list-2 (cdr lis)) (car lis))))
+    (define (ftc-4a lis) (copy-list-2 lis))
+    (test (ftc-4a '(1 2 3)) '(((() . 3) . 2) . 1)))
+
+  ;; -------- OP_RECUR_IF_A_A_opA_LAAq --------
+  (define (recur-if-a-a-opa-laaq-1 x y) (if (= x 0) y (+ 1 (recur-if-a-a-opa-laaq-1 (- x 1) (+ y 1)))))
+  (test (recur-if-a-a-opa-laaq-1 10 0) 20)
+
+  (define (recur-if-a-a-opa-laaq-2 x y) (if (= x 0) y (+ 1 (recur-if-a-a-opa-laaq-2))))
+  (test (recur-if-a-a-opa-laaq-2 10 0) 'error)
+
+  (define (recur-if-a-a-opa-laaq-3 x y) (if (= x 0) y (+ 1 (recur-if-a-a-opa-laaq-3 (- x 1) (+ y 1) 2))))
+  (test (recur-if-a-a-opa-laaq-3 10 0) 'error)
+
+  (define (recur-if-a-a-opa-laaq-4 x y) (if (= x 0) (call-with-exit (lambda (cc) y)) (+ 1 (recur-if-a-a-opa-laaq-4 (- x 1) (+ y 1)))))
+  (test (recur-if-a-a-opa-laaq-4 10 0) 20)
+
+  ;; -------- OP_RECUR_IF_A_A_opA_L3Aq --------
+  (define (recur-if-a-a-opa-l3aq-1 x y z) (if (= x 0) y (+ 1 (recur-if-a-a-opa-l3aq-1 (- x 1) (+ y z) (+ z 1)))))
+  (test (recur-if-a-a-opa-l3aq-1 10 0 0) 55) ; z by 1 = 110/2
+
+  (define (recur-if-a-a-opa-l3aq-2 x y z) (if (= x 0) y (+ 1 (recur-if-a-a-opa-l3aq-2))))
+  (test (recur-if-a-a-opa-l3aq-2 10 0 0) 'error)
+
+  (define (recur-if-a-a-opa-l3aq-3 x y z) (if (= x 0) y (+ 1 (recur-if-a-a-opa-l3aq-3 (- x 1) (+ y 1) 2 1))))
+  (test (recur-if-a-a-opa-l3aq-3 10 0 0) 'error)
+
+  (define (wf3 lst i val) (if (= i 0) (cons val (cdr lst)) (cons (car lst) (wf3 (cdr lst) (- i 1) val))))
+  (test (wf3 (list 1 2 3 4) 3 5) '(1 2 3 5))
+  (test (wf3 (list 1 2 3 4) 2 5) '(1 2 5 4))
+  (test (wf3 (list 1 2 3 4) 1 5) '(1 5 3 4))
+
+  ;; -------- OP_RECUR_IF_A_A_opLA_LAq --------
+  (define (recur-if-a-a-opla-laq-1 x) (if (< x 2) x (+ (recur-if-a-a-opla-laq-1 (- x 1)) (recur-if-a-a-opla-laq-1 (- x 2)))))
+  (test (recur-if-a-a-opla-laq-1 10) 55)
+
+  (define (recur-if-a-a-opla-laq-2 x) (if (< x 2) x (+ (recur-if-a-a-opla-laq-2) (recur-if-a-a-opla-laq-2 (- x 2)))))
+  (test (recur-if-a-a-opla-laq-2 10) 'error)
+
+  (define (recur-if-a-a-opla-laq-3 x) (if (< x 2) x (+ (recur-if-a-a-opla-laq-3 (- x 1)) (recur-if-a-a-opla-laq-3))))
+  (test (recur-if-a-a-opla-laq-3 10) 'error)
+
+  (define (recur-if-a-a-opla-laq-4 x) (if (< x 2.0) x (+ (recur-if-a-a-opla-laq-4 (- x 1.0)) (recur-if-a-a-opla-laq-4 (- x 2.0)))))
+  (num-test (recur-if-a-a-opla-laq-4 10.0) 55.0)
+  (num-test (recur-if-a-a-opla-laq-4 10) 55.0)
+
+  (define (recur-if-a-a-opla-laq-5 x) (if (< x 2) (call-with-exit (lambda (cc) x)) (+ (recur-if-a-a-opla-laq-1 (- x 1)) (recur-if-a-a-opla-laq-5 (- x 2)))))
+  (test (recur-if-a-a-opla-laq-5 10) 55)
+
+  ;; -------- OP_RECUR_IF_A_A_opA_LA_LAq --------
+  (define (recur-if-a-a-opa-la-laq-1 n)
+    (if (< n 3) 1
+	(+ 1
+	   (recur-if-a-a-opa-la-laq-1 (- n 2))
+	   (recur-if-a-a-opa-la-laq-1 (- n 3)))))
+  (test (recur-if-a-a-opa-la-laq-1 10) 23)
+
+  (define (recur-if-a-a-opa-la-laq-2 n)
+    (if (< n 3) 1
+	(+ (- n 1)
+	   (recur-if-a-a-opa-la-laq-2 (- n 2))
+	   (recur-if-a-a-opa-la-laq-2 (- n 3)))))
+  (test (recur-if-a-a-opa-la-laq-2 10) 59)
+
+  (define (recur-if-a-a-opa-la-laq-3 n)
+    (if (< n 3) 1
+	(+ 1
+	   (recur-if-a-a-opa-la-laq-3)
+	   (recur-if-a-a-opa-la-laq-3 (- n 3)))))
+  (test (recur-if-a-a-opa-la-laq-3 10) 'error)
+
+  (define (recur-if-a-a-opa-la-laq-4 n)
+    (if (< n 3) 1
+	(- 1
+	   (recur-if-a-a-opa-la-laq-4 (- n 2))
+	   (recur-if-a-a-opa-la-laq-4))))
+  (test (recur-if-a-a-opa-la-laq-4 10) 'error)
+
+  (define (recur-if-a-a-opa-la-laq-5 n)
+    (if (< n 3) (call-with-exit (lambda (cc) 1))
+	(+ 1
+	   (recur-if-a-a-opa-la-laq-5 (- n 2))
+	   (recur-if-a-a-opa-la-laq-5 (- n 3)))))
+  (test (recur-if-a-a-opa-la-laq-5 10) 23)
+
+  ;; -------- OP_RECUR_IF_A_opA_LA_LAq_A --------
+  (define (recur-if-a-opa-la-laq-a-1 n)
+    (if (>= n 3)
+	(+ 1
+	   (recur-if-a-opa-la-laq-a-1 (- n 2))
+	   (recur-if-a-opa-la-laq-a-1 (- n 3)))
+	1))
+  (test (recur-if-a-opa-la-laq-a-1 10) 23)
+
+  (define (recur-if-a-opa-la-laq-a-2 n)
+    (if (>= n 3)
+	(+ (- n 1)
+	   (recur-if-a-opa-la-laq-a-2 (- n 2))
+	   (recur-if-a-opa-la-laq-a-2 (- n 3)))
+	1))
+  (test (recur-if-a-opa-la-laq-a-2 10) 59)
+
+  (define (recur-if-a-opa-la-laq-a-3 n)
+    (if (>= n 3)
+	(+ 1
+	   (recur-if-a-opa-la-laq-a-3)
+	   (recur-if-a-opa-la-laq-a-3 (- n 3)))
+	1))
+  (test (recur-if-a-opa-la-laq-a-3 10) 'error)
+
+  (define (recur-if-a-opa-la-laq-a-4 n)
+    (if (>= n 3)
+	(- 1
+	   (recur-if-a-opa-la-laq-a-4 (- n 2))
+	   (recur-if-a-opa-la-laq-a-4))
+	1))
+  (test (recur-if-a-opa-la-laq-a-4 10) 'error)
+
+  ;; -------- OP_RECUR_IF_A_A_opLA_LA_LAq --------
+  (define (recur-if-a-a-opla-la-laq-1 n)
+    (if (< n 3) 1
+	(+ (recur-if-a-a-opla-la-laq-1 (- n 1))
+	   (recur-if-a-a-opla-la-laq-1 (- n 2))
+	   (recur-if-a-a-opla-la-laq-1 (- n 3)))))
+  (test (recur-if-a-a-opla-la-laq-1 10) 193)
+
+  (define (recur-if-a-a-opla-la-laq-2 n)
+    (if (< n 3) 1
+	(+ (recur-if-a-a-opla-la-laq-2)
+	   (recur-if-a-a-opla-la-laq-2 (- n 2))
+	   (recur-if-a-a-opla-la-laq-2 (- n 3)))))
+  (test (recur-if-a-a-opla-la-laq-2 10) 'error)
+
+  (define (recur-if-a-a-opla-la-laq-3 n)
+    (if (< n 3) 1
+	(+ (recur-if-a-a-opla-la-laq-3 (- n 1))
+	   (recur-if-a-a-opla-la-laq-3)
+	   (recur-if-a-a-opla-la-laq-3 (- n 3)))))
+  (test (recur-if-a-a-opla-la-laq-3 10) 'error)
+
+  (define (recur-if-a-a-opla-la-laq-4 n)
+    (if (< n 3) 1
+	(+ (recur-if-a-a-opla-la-laq-4 (- n 1) (+ n 1))
+	   (recur-if-a-a-opla-la-laq-4 (- n 2))
+	   (recur-if-a-a-opla-la-laq-4 (- n 3)))))
+  (test (recur-if-a-a-opla-la-laq-4 10) 'error)
+
+  (define (recur-if-a-a-opla-la-laq-5 n)
+    (if (< n 3) 1
+	(- (recur-if-a-a-opla-la-laq-5 (- n 1))
+	   (recur-if-a-a-opla-la-laq-5 (- n 2))
+	   (recur-if-a-a-opla-la-laq-5 (- n 3)))))
+  (test (recur-if-a-a-opla-la-laq-5 10) -15)
+
+  (define (recur-if-a-a-opla-la-laq-6 n)
+    (if (< n 3) (call-with-exit (lambda (cc) 1))
+	(+ (recur-if-a-a-opla-la-laq-6 (- n 1))
+	   (recur-if-a-a-opla-la-laq-6 (- n 2))
+	   (recur-if-a-a-opla-la-laq-6 (- n 3)))))
+  (test (recur-if-a-a-opla-la-laq-6 10) 193)
+
+  ;; -------- OP_RECUR_IF_A_opA_LAq_A --------
+  (define (recur-if-a-opa-laq-a-1 x) (if (not (= x 0)) (+ 1 (recur-if-a-opa-laq-a-1 (- x 1))) 0))
+  (test (recur-if-a-opa-laq-a-1 10) 10)
+
+  (define (recur-if-a-opa-laq-a-2 x) (if (not (= x 0)) (+ 1 (recur-if-a-opa-laq-a-2)) 0))
+  (test (recur-if-a-opa-laq-a-2 10) 'error)
+
+  (define (recur-if-a-opa-laq-a-3 x) (if (not (= x 0)) (+ 1 (recur-if-a-opa-laq-a-3 (- x 1) 2)) 0))
+  (test (recur-if-a-opa-laq-a-3 10) 'error)
+
+  (let ()
+    (define (copy-list-2 lis)
+      (if (pair? lis) (cons (car lis) (copy-list-2 (cdr lis))) lis))
+    (define (ftc-5 lis) (copy-list-2 lis))
+    (test (ftc-5 '(1 2 3)) '(1 2 3)))
+
+  ;; -------- OP_RECUR_IF_A_opLA_Aq_A --------
+  (define (recur-if-a-opla-aq-a-1 x) (if (not (= x 0)) (+ (recur-if-a-opla-aq-a-1 (- x 1)) 1) 0))
+  (test (recur-if-a-opla-aq-a-1 10) 10)
+
+  (define (recur-if-a-opla-aq-a-2 x) (if (not (= x 0)) (+ (recur-if-a-opla-aq-a-2) 1) 0))
+  (test (recur-if-a-opla-aq-a-2 10) 'error)
+
+  (define (recur-if-a-opla-aq-a-3 x) (if (not (= x 0)) (+ (recur-if-a-opla-aq-a-3 (- x 1) 2) 1) 0))
+  (test (recur-if-a-opla-aq-a-3 10) 'error)
+
+  (let ()
+    (define (copy-list-3 lis)
+      (if (pair? lis) (cons (copy-list-3 (cdr lis)) (car lis)) lis))
+    (define (ftc-6 lis) (copy-list-3 lis))
+    (test (ftc-6 '(1 2 3)) '(((() . 3) . 2) . 1)))
+
+  ;; -------- OP_RECUR_IF_A_opA_LAAq_A --------
+  (define (recur-if-a-opa-laaq-a-1 x y) (if (not (= x 0)) (+ 1 (recur-if-a-opa-laaq-a-1 (- x 1) (+ y 1))) y))
+  (test (recur-if-a-opa-laaq-a-1 10 0) 20)
+
+  (define (recur-if-a-opa-laaq-a-2 x y) (if (not (= x 0)) (+ 1 (recur-if-a-opa-laaq-a-2)) y))
+  (test (recur-if-a-opa-laaq-a-2 10 0) 'error)
+
+  (define (recur-if-a-opa-laaq-a-3 x y) (if (not (= x 0)) (+ 1 (recur-if-a-opa-laaq-a-3 (- x 1) (+ y 1) 2)) y))
+  (test (recur-if-a-opa-laaq-a-3 10 0) 'error)
+
+  ;; -------- OP_RECUR_IF_A_opLA_LAq_A --------
+  (define (recur-if-a-opla-laq-a-1 x) (if (>= x 2) (+ (recur-if-a-opla-laq-a-1 (- x 1)) (recur-if-a-a-opla-laq-1 (- x 2))) x))
+  (test (recur-if-a-opla-laq-a-1 10) 55)
+
+  (define (recur-if-a-opla-laq-a-2 x) (if (>= x 2) (+ (recur-if-a-opla-laq-a-2) (recur-if-a-a-opla-laq-2 (- x 2))) x))
+  (test (recur-if-a-opla-laq-a-2 10) 'error)
+
+  (define (recur-if-a-opla-laq-a-3 x) (if (>= x 2) (+ (recur-if-a-opla-laq-a-3 (- x 1)) (recur-if-a-a-opla-laq-3)) x))
+  (test (recur-if-a-opla-laq-a-3 10) 'error)
+
+  (define (recur-if-a-opla-laq-a-4 x) (if (>= x 2.0) (+ (recur-if-a-a-opla-laq-4 (- x 1.0)) (recur-if-a-a-opla-laq-4 (- x 2.0))) x))
+  (num-test (recur-if-a-opla-laq-a-4 10) 55.0)
+
+  ;; -------- OP_RECUR_IF_A_A_IF_A_LAA_opA_LAAq --------
+  (define (recur-if-a-a-if-a-laa-opa-laaq-1 m n)
+    (if (= m 0)
+	(+ n 1)
+	(if (= n 0)
+	    (recur-if-a-a-if-a-laa-opa-laaq-1 (- m 1) 1)
+	    (+ (- m 1)
+	       (recur-if-a-a-if-a-laa-opa-laaq-1 m (- n 1))))))
+  (test (recur-if-a-a-if-a-laa-opa-laaq-1 2 3) 5)
+  (test (recur-if-a-a-if-a-laa-opa-laaq-1 4 2) 11)
+
+  (define (recur-if-a-a-if-a-laa-opa-laaq-2 m n)
+    (if (= m 0)
+	(+ n 1)
+	(if (= n 0)
+	    (recur-if-a-a-if-a-laa-opa-laaq-2 (- m 1) 1)
+	    (+ (- m 1)
+	       (recur-if-a-a-if-a-laa-opa-laaq-2 m)))))
+  (test (recur-if-a-a-if-a-laa-opa-laaq-2 2 3) 'error)
+
+  ;; -------- OP_RECUR_IF_A_A_AND_A_LAA_LAA --------
+  (define (tree-eq-1? a b)
+    (if (not (pair? a))
+	(eq? a b)
+	(and (pair? b)
+	     (tree-eq-1? (car a) (car b))
+	     (tree-eq-1? (cdr a) (cdr b)))))
+  (test (tree-eq-1? '(1 (b c 2) ((3))) '(1 (b c 2) ((3)))) #t)
+  (test (tree-eq-1? '(1 (b c 2) ((3))) '(1 (b c 2) (3))) #f)
+  (test (tree-eq-1? '(1 (b c) ((3))) '(1 (b c 2) ((3)))) #f)
+  (test (tree-eq-1? '(1 (b c 2) ((3))) '(1 (b c 2) ((4)))) #f)
+
+  (define (tree-eq-2? a b)
+    (if (not (pair? a))
+	(call-with-exit (lambda (cc) (eq? a b)))
+	(and (pair? b)
+	     (tree-eq-2? (car a) (car b))
+	     (tree-eq-2? (cdr a) (cdr b)))))
+  (test (tree-eq-2? '(1 (b c 2) ((3))) '(1 (b c 2) ((3)))) #t)
+
+  (define (tree-eq-3? a b)
+    (if (not (pair? a))
+	(eq? a b)
+	(and (pair? b)
+	     (tree-eq-3? (car a))
+	     (tree-eq-3? (cdr a) (cdr b)))))
+  (test (tree-eq-3? '(1 (b c 2) ((3))) '(1 (b c 2) ((3)))) 'error)
+
+  ;; -------- OP_RECUR_AND_A_OR_A_LAA_LAA --------
+  (define (tm1 sym tree)
+    (and (pair? tree)
+         (or (equal? (car tree) sym)
+             (tm1 sym (car tree))
+             (tm1 sym (cdr tree)))))
+  (test (tm1 1 '(2 4 (3 1) 2)) #t)
+  (test (tm1 1 '(2 4 (3 5) 2)) #f)
+  (test (tm1 '(+ x 2) '(abs (log (+ x 2)))) #t)
+
+  (define (tm2 sym tree)
+    (and (call-with-exit (lambda (return) (return (pair? tree))))
+         (or (equal? (car tree) sym)
+             (tm2 sym (car tree))
+             (tm2 sym (cdr tree)))))
+  (test (tm2 '(+ x 2) '(abs (log (+ x 2)))) #t)
+
+  (define (tm3 sym tree)
+    (and (pair? tree)
+         (or (call-with-exit (lambda (return) (return (equal? (car tree) sym))))
+             (tm3 sym (car tree))
+             (tm3 sym (cdr tree)))))
+  (test (tm3 '(+ x 2) '(abs (log (+ x 2)))) #t)
+
+  (define (tm4 sym tree)
+    (and (pair? tree)
+         (or (equal? (car tree) sym)
+             (tm4 sym (car tree))
+             (tm4 sym))))
+  (test (tm4 1 '(2 4 (3 1) 2)) 'error)
+
+  ;; -------- OP_RECUR_COND_A_A_opA_LAq --------
+  (define (recur-cond-a-a-opa-laq-1 x) (cond ((= x 0) 0) (else (+ 1 (recur-cond-a-a-opa-laq-1 (- x 1))))))
+  (test (recur-cond-a-a-opa-laq-1 10) 10)
+
+  (define (recur-cond-a-a-opa-laq-2 x) (cond ((= x 0) 0) (#t (+ 1 (recur-cond-a-a-opa-laq-2)))))
+  (test (recur-cond-a-a-opa-laq-2 10) 'error)
+
+  (define (recur-cond-a-a-opa-laq-3 x) (cond ((= x 0) 0) (else (+ 1 (recur-cond-a-a-opa-laq-3 (- x 1) 2)))))
+  (test (recur-cond-a-a-opa-laq-3 10) 'error)
+
+  ;; -------- OP_RECUR_COND_A_A_opLA_LAq --------
+  (define (recur-cond-a-a-opla-laq-1 x) (cond ((< x 2) x) (else (+ (recur-cond-a-a-opla-laq-1 (- x 1)) (recur-cond-a-a-opla-laq-1 (- x 2))))))
+  (test (recur-cond-a-a-opla-laq-1 10) 55)
+
+  (define (recur-cond-a-a-opla-laq-2 x) (cond ((< x 2) x) (else (+ (recur-cond-a-a-opla-laq-2) (recur-cond-a-a-opla-laq-2 (- x 2))))))
+  (test (recur-cond-a-a-opla-laq-2 10) 'error)
+
+  (define (recur-cond-a-a-opla-laq-3 x) (cond ((< x 2) x) (else (+ (recur-cond-a-a-opla-laq-3 (- x 1)) (recur-cond-a-a-opla-laq-3)))))
+  (test (recur-cond-a-a-opla-laq-3 10) 'error)
+
+  ;; -------- OP_RECUR_COND_A_A_opA_LAAq --------
+  (define (recur-cond-a-a-opa-laaq-1 x y) (cond ((= x 0) y) (else (+ 1 (recur-cond-a-a-opa-laaq-1 (- x 1) (+ y 1))))))
+  (test (recur-cond-a-a-opa-laaq-1 10 0) 20)
+  (test (recur-cond-a-a-opa-laaq-1 10 10) 30)
+
+  (define (recur-cond-a-a-opa-laaq-2 x y) (cond ((= x 0) y) (else (+ 1 (recur-cond-a-a-opa-laaq-2 (- x 1))))))
+  (test (recur-cond-a-a-opa-laaq-2 10 0) 'error)
+
+  (define (recur-cond-a-a-opa-laaq-3 x y) (cond ((= x 0) y) (else (+ 1 (recur-cond-a-a-opa-laaq-3)))))
+  (test (recur-cond-a-a-opa-laaq-3 10 0) 'error)
+
+  ;; -------- OP_RECUR_COND_A_A_A_A_opLAA_LAAq --------
+  (define (recur-cond-a-a-a-a-oplaa-laaq-1 x y)
+    (cond ((= x 0) y) ((negative? y) x) (else (+ (recur-cond-a-a-a-a-oplaa-laaq-1 (- x 1) (+ y 1)) (recur-cond-a-a-a-a-oplaa-laaq-1 (- x 1) (+ y 1))))))
+  (test (recur-cond-a-a-a-a-oplaa-laaq-1 10 0) 10240)
+  (test (recur-cond-a-a-a-a-oplaa-laaq-1 10 -1) 10)
+
+  (define (recur-cond-a-a-a-a-oplaa-laaq-2 x y)
+    (cond ((= x 0) y) ((negative? y) x) (else (+ (recur-cond-a-a-a-a-oplaa-laaq-2 (- x 1) (+ y 1)) (recur-cond-a-a-a-a-oplaa-laaq-2)))))
+  (test (recur-cond-a-a-a-a-oplaa-laaq-2 10 0) 'error)
+
+  (define (recur-cond-a-a-a-a-oplaa-laaq-3 x y)
+    (cond ((= x 0) y) ((negative? y) x) (else (+ (recur-cond-a-a-a-a-oplaa-laaq-1) (recur-cond-a-a-a-a-oplaa-laaq-3 (- x 1) (+ y 1))))))
+  (test (recur-cond-a-a-a-a-oplaa-laaq-3 10 0) 'error)
+
+  ;; -------- OP_RECUR_IF_A_A_IF_A_A_opLAA_LAAq --------
+  (define (recur-if-a-a-if-a-a-oplaa-laaq-1 x y)
+    (cond ((= x 0) y) ((negative? y) x) (else (+ (recur-if-a-a-if-a-a-oplaa-laaq-1 (- x 1) (+ y 1)) (recur-if-a-a-if-a-a-oplaa-laaq-1 (- x 1) (+ y 1))))))
+  (test (recur-if-a-a-if-a-a-oplaa-laaq-1 10 0) 10240)
+  (test (recur-if-a-a-if-a-a-oplaa-laaq-1 10 -1) 10)
+
+  (define (recur-if-a-a-if-a-a-oplaa-laaq-2 x y)
+    (cond ((= x 0) y) ((negative? y) x) (else (+ (recur-if-a-a-if-a-a-oplaa-laaq-2 (- x 1) (+ y 1)) (recur-if-a-a-if-a-a-oplaa-laaq-2)))))
+  (test (recur-if-a-a-if-a-a-oplaa-laaq-2 10 0) 'error)
+
+  (define (recur-if-a-a-if-a-a-oplaa-laaq-3 x y)
+    (cond ((= x 0) y) ((negative? y) x) (else (+ (recur-if-a-a-if-a-a-oplaa-laaq-1) (recur-if-a-a-if-a-a-oplaa-laaq-3 (- x 1) (+ y 1))))))
+  (test (recur-if-a-a-if-a-a-oplaa-laaq-3 10 0) 'error)
+
+  (define (tree-count1 sym tree)
+    (if (eq? sym tree) 1
+        (if (not (pair? tree)) 0
+	    (+ (tree-count1 sym (car tree)) (tree-count1 sym (cdr tree))))))
+  (test (tree-count1 'a '((a b) c () ((b a)))) 2)
+
+  ;; -------- OP_RECUR_COND_A_A_A_A_opA_LAAq--------
+  (define (recur-cond-a-a-a-a-opa-laaq-1 x y) (cond ((= x 0) y) ((negative? y) x) (else (+ 1 (recur-cond-a-a-a-a-opa-laaq-1 (- x 1) (+ y 1))))))
+  (test (recur-cond-a-a-a-a-opa-laaq-1 10 0) 20)
+  (test (recur-cond-a-a-a-a-opa-laaq-1 10 -10) 10)
+
+  (define (recur-cond-a-a-a-a-opa-laaq-2 x y) (cond ((= x 0) y) ((negative? y) x) (else (+ 1 (recur-cond-a-a-a-a-opa-laaq-2)))))
+  (test (recur-cond-a-a-a-a-opa-laaq-2 10 0) 'error)
+
+  (define (recur-cond-a-a-a-a-opa-laaq-3 x y) (cond ((= x 0) y) ((negative? y) x) (else (+ 1 (recur-cond-a-a-a-a-opa-laaq-3 (- x 1) (+ y 1) 12)))))
+  (test (recur-cond-a-a-a-a-opa-laaq-3 10 0) 'error)
+
+  ;; -------- OP_RECUR_COND_A_A_A_A_opLA_LAq --------
+  (define (recur-cond-a-a-a-a-opla-laq-1 x) (cond ((< x 2) x) ((< x 3) x) (else (+ (recur-cond-a-a-a-a-opla-laq-1 (- x 1)) (recur-cond-a-a-a-a-opla-laq-1 (- x 2))))))
+  (test (recur-cond-a-a-a-a-opla-laq-1 10) 89)
+
+  (define (recur-cond-a-a-a-a-opla-laq-2 x) (cond ((< x 2) x) ((< x 3) x) (else (+ (recur-cond-a-a-a-a-opla-laq-2) (recur-cond-a-a-a-a-opla-laq-2 (- x 2))))))
+  (test (recur-cond-a-a-a-a-opla-laq-2 10) 'error)
+
+  (define (recur-cond-a-a-a-a-opla-laq-3 x) (cond ((< x 2) x) ((< x 3) x) (else (+ (recur-cond-a-a-a-a-opla-laq-3 (- x 1)) (recur-cond-a-a-a-a-opla-laq-3)))))
+  (test (recur-cond-a-a-a-a-opla-laq-3 10) 'error)
+
+  (define (recur-cond-a-a-a-a-opla-laq-4 x) (cond ((< x 2) x) ((< x 3) x) (else (+ (recur-cond-a-a-a-a-opla-laq-4 (- x 1)) (recur-cond-a-a-a-a-opla-laq-4 (- x 2))))))
+  (define (ftc-6) (+ 10 (recur-cond-a-a-a-a-opla-laq-4 10))) ; fx case
+  (test (ftc-6) 99)
+
+  ;; -------- OP_RECUR_IF_A_A_IF_A_A_opLA_LAq --------
+  (define (recur-if-a-a-a-a-opla-laq-1 x) (if (< x 2) x (if (< x 3) x (+ (recur-if-a-a-a-a-opla-laq-1 (- x 1)) (recur-if-a-a-a-a-opla-laq-1 (- x 2))))))
+  (test (recur-if-a-a-a-a-opla-laq-1 10) 89)
+
+  (define (recur-if-a-a-a-a-opla-laq-2 x) (if (< x 2) x (if (< x 3) x (+ (recur-cond-a-a-a-a-opla-laq-2) (recur-cond-a-a-a-a-opla-laq-2 (- x 2))))))
+  (test (recur-if-a-a-a-a-opla-laq-2 10) 'error)
+
+  (define (recur-if-a-a-a-a-opla-laq-3 x) (if (< x 2) x (if (< x 3) x (+ (recur-cond-a-a-a-a-opla-laq-3 (- x 1)) (recur-cond-a-a-a-a-opla-laq-3)))))
+  (test (recur-if-a-a-a-a-opla-laq-3 10) 'error)
+
+  (define (recur-if-a-a-a-a-opla-laq-4 x) (if (< x 2) x (if (< x 3) x (+ (recur-cond-a-a-a-a-opla-laq-4 (- x 1)) (recur-cond-a-a-a-a-opla-laq-4 (- x 2))))))
+  (define (ftc-6) (+ 10 (recur-if-a-a-a-a-opla-laq-4 10))) ; fx case??
+  (test (ftc-6) 99)
+
+  ;; -------- OP_RECUR_COND_A_A_A_LAA_LopA_LAAq--------
+  (define (recur-cond-a-a-a-laa-lopa-laaq-1 m n)
+    (cond ((= m 0) (+ n 1))
+	  ((= n 0) (recur-cond-a-a-a-laa-lopa-laaq-1 (- m 1) 1))
+	  (else (recur-cond-a-a-a-laa-lopa-laaq-1 (- m 1) (recur-cond-a-a-a-laa-lopa-laaq-1 m (- n 1))))))
+  (test (recur-cond-a-a-a-laa-lopa-laaq-1 2 3) 9)
+
+  (define (recur-cond-a-a-a-laa-lopa-laaq-2 m n)
+    (cond ((= m 0) (+ n 1))
+	  ((= n 0) (recur-cond-a-a-a-laa-lopa-laaq-2 (- m 1) 1))
+	  (else (recur-cond-a-a-a-laa-lopa-laaq-2 (recur-cond-a-a-a-laa-lopa-laaq-2 m (- n 1))))))
+  (test (recur-cond-a-a-a-laa-lopa-laaq-2 2 3) 'error)
+
+  (define (recur-cond-a-a-a-laa-lopa-laaq-3 m n)
+    (cond ((= m 0) (+ n 1))
+	  ((= n 0) (recur-cond-a-a-a-laa-lopa-laaq-3 (- m 1)))
+	  (else (recur-cond-a-a-a-laa-lopa-laaq-3 (- m 1) (recur-cond-a-a-a-laa-lopa-laaq-2 m (- n 1))))))
+  (test (recur-cond-a-a-a-laa-lopa-laaq-3 2 3) 'error)
+
+  (define (recur-cond-a-a-a-laa-lopa-laaq-4 m n)
+    (cond ((= m 0) (+ n 1))
+	  ((= n 0) (recur-cond-a-a-a-laa-lopa-laaq-4 (- m 1) 1))
+	  (else (recur-cond-a-a-a-laa-lopa-laaq-4 (- m 1) (recur-cond-a-a-a-laa-lopa-laaq-4 m (- n 1) 12)))))
+  (test (recur-cond-a-a-a-laa-lopa-laaq-4 2 3) 'error)
+
+  (define (recur-cond-a-a-a-laa-lopa-laaq-5 m n)
+    (cond ((= m 0) (+ n 1))
+	  ((= n 0) (recur-cond-a-a-a-laa-lopa-laaq-5 (- m 1)))
+	  (else (recur-cond-a-a-a-laa-lopa-laaq-5 (- m 1) (recur-cond-a-a-a-laa-lopa-laaq-5 m)))))
+  (test (recur-cond-a-a-a-laa-lopa-laaq-5 2 3) 'error)
+
+  ;; -------- OP_RECUR_COND_A_A_A_LAA_opA_LAAq--------
+  (define (recur-cond-a-a-a-laa-opa-laaq-1 m n)
+    (cond ((= m 0) (+ n 1))
+	  ((= n 0) (recur-cond-a-a-a-laa-opa-laaq-1 (- m 1) 1))
+	  (else (+ (- m 1) (recur-cond-a-a-a-laa-opa-laaq-1 m (- n 1))))))
+  (test (recur-cond-a-a-a-laa-opa-laaq-1 2 3) 5)
+
+  (define (recur-cond-a-a-a-laa-opa-laaq-4 m n)
+    (cond ((= m 0) (+ n 1))
+	  ((= n 0) (recur-cond-a-a-a-laa-opa-laaq-4 (- m 1) 1))
+	  (else (+ (- m 1) (recur-cond-a-a-a-laa-opa-laaq-4 m (- n 1) 12)))))
+  (test (recur-cond-a-a-a-laa-opa-laaq-4 2 3) 'error)
+
+  (define (recur-cond-a-a-a-laa-opa-laaq-5 m n)
+    (cond ((= m 0) (+ n 1))
+	  ((= n 0) (recur-cond-a-a-a-laa-opa-laaq-5 (- m 1)))
+	  (else (+ (- m 1) (recur-cond-a-a-a-laa-opa-laaq-5 m)))))
+  (test (recur-cond-a-a-a-laa-opa-laaq-5 2 3) 'error)
+
+  ;; -------- OP_RECUR_IF_A_A_LopL3A_L3A_L3Aq --------
+  (define (tak x y z) (if (not (< y x)) z (tak (tak (- x 1) y z) (tak (- y 1) z x) (tak (- z 1) x y))))
+  (test (tak 10 5 1) 5)
+  ;(when full-s7test (test (tak 30 15 6) 15))
+
+  (define (tak-1 x y z) (if (not (< y x)) z (tak-1 (tak-1 (- x 1) y z) (tak-1 (- y 1) x) (tak-1 (- z 1) x y))))
+  (test (tak-1 10 5 1) 'error)
+
+  (define (tak-2 x y z) (if (not (< y x)) z (tak-2 (tak-2 (- x 1) y z) (tak-2 (- y 1) z x) (tak-2))))
+  (test (tak-2 10 5 1) 'error)
+
+  (define (tak-3 x y z) (if (not (< y x)) z (tak-3 (tak-3 (- x 1) y z) (tak-3 (- y 1) z x) (tak-3 (- z 1) x y) x)))
+  (test (tak-3 10 5 1) 'error)
+
+  (define (dly0 x y) (if (zero? x) y (dly0 (- x 1) (+ x y))))
+  (test (dly0 10 1)56)
+
+  (define (dly1 x y) (if (null? x) y (dly1 (cdr x) (cons (car x) y))))
+  (test (dly1 '(10 9 8 7 6 5 4 3 2 1 0) ()) '(0 1 2 3 4 5 6 7 8 9 10))
+
+  (define (dly2 x y) (and (list? x) (or (and (null? x) y) (dly2 (cdr x) (cons (car x) y)))))
+  (test (dly2 '(10 9 8 7 6 5 4 3 2 1 0) ()) '(0 1 2 3 4 5 6 7 8 9 10))
+
+  (define (dly3 x y) (or (and (null? x) y) (and (pair? x) (dly3 (cdr x) (cons (car x) y)))))
+  (test (dly3 '(10 9 8 7 6 5 4 3 2 1 0) ()) '(0 1 2 3 4 5 6 7 8 9 10))
+  )
+
+(let ()
+  (define (m . args)           ; [346] -> 318 (safe_thunk) but tmisc up 10 6341 if op_safe_thunk_any -> 313 (fx_is_null_t)
+    (if (null? args) 1 0))     ; fx_is_null_t if safe_thunk_any
+  (define (dom)
+    (do ((sum 0)               ; op_dox_step_o
+	 (i 0 (+ i 1)))        ; fx_add_t1
+	((= i 10) sum)         ; fx_num_eq_ti
+      (set! sum (+ sum (m))))) ; op_safe_c_sp + op_safe_thunk_any
+  (unless (= (dom) 10) (format *stderr* "dom: ~S~%" (dom)))
+
+  (define (m1 . args)
+    (unless (null? args) (display 'oops))
+    (set! args 1))
+  (define (dom1)
+    (do ((sum 0)
+	 (i 0 (+ i 1)))
+	((= i 10) sum)
+    (set! sum (+ sum (m1)))))
+  (unless (= (dom1) 10) (format *stderr* "dom1: ~S~%" (dom1)))
+
+  (define* (m2 . args)
+    (if (null? args) 1 0))
+  (define (dom2)
+    (do ((sum 0)
+	 (i 0 (+ i 1)))
+	((= i 10) sum)
+      (set! sum (+ sum (m)))))
+  (unless (= (dom2) 10) (format *stderr* "dom2: ~S~%" (dom2)))
+
+  (define m3 (lambda args
+	       (if (null? args) 1 0)))
+  (define (dom3)
+    (do ((sum 0)                ; op_dox_step_o
+	 (i 0 (+ i 1)))         ; fx_add_t1
+	((= i 10) sum)          ; fx_num_eq_ti
+      (set! sum (+ sum (m3))))) ; op_safe_c_sp + op_safe_thunk_any
+  (unless (= (dom3) 10) (format *stderr* "dom3: ~S~%" (dom3))))
+
+(when (provided? 'debugging)
+  (report-missed-calls))
+;;; end optimizer stuff
+
+(let () ; check let_id bug
+  (define (boolean|integer? x) (or (boolean? x) (integer? x)))
+  (define (_vals5_ x y z) (values x y z))
+  (define (func) (_vals5_ 1 (make-vector 3 #f boolean|integer?) 3))
+  (func))
+
+;;; coverage tests for closure_3p
+(let ()
+  (define (byte siz pos) (list pos siz))
+  (define (dpb integer bytespec into) (list integer bytespec into))
+  (define (lpb x integer bytespec into) (let ((v (list-values 0 integer bytespec into))) (set! (v 0) x) v))
+  (define (mpb x y) (values x y))
+  (define (mpb1 x) (values x))
+
+  (define (g)
+    (test (dpb 1 2 3) '(1 2 3))
+    (test (dpb 1 2 (byte 4 5)) '(1 2 (5 4)))
+    (test (dpb 1 (byte 4 5) 3) '(1 (5 4) 3))
+    (test (dpb (byte 4 5) 2 3) '((5 4) 2 3))
+    (test (dpb 1 (byte 4 5) (byte 6 7)) '(1 (5 4) (7 6)))
+    (test (dpb (byte 4 5) (byte 6 7) 3) '((5 4) (7 6) 3))
+    (test (dpb (byte 4 5) 2 (byte 6 7)) '((5 4) 2 (7 6)))
+    (test (dpb (byte 4 5) (byte 6 7) (byte 8 9)) '((5 4) (7 6) (9 8)))
+
+    (test (lpb -1 1 2 3) '(-1 1 2 3))
+    (test (lpb -1 1 2 (byte 4 5)) '(-1 1 2 (5 4)))
+    (test (lpb -1 1 (byte 4 5) 3) '(-1 1 (5 4) 3))
+    (test (lpb -1 (byte 4 5) 2 3) '(-1 (5 4) 2 3))
+    (test (lpb -1 1 (byte 4 5) (byte 6 7)) '(-1 1 (5 4) (7 6)))
+    (test (lpb -1 (byte 4 5) (byte 6 7) 3) '(-1 (5 4) (7 6) 3))
+    (test (lpb -1 (byte 4 5) 2 (byte 6 7)) '(-1 (5 4) 2 (7 6)))
+    (test (lpb -1 (byte 4 5) (byte 6 7) (byte 8 9)) '(-1 (5 4) (7 6) (9 8)))
+
+    (test (dpb (mpb 1 2) 3 4) 'error)
+    (test (dpb 1 2 (mpb 1 2)) 'error)
+    (test (dpb 1 (mpb 1 2) 3) 'error)
+    (test (dpb (mpb1 1) 3 4) '(1 3 4))
+    (test (dpb 1 2 (mpb1 3)) '(1 2 3))
+    (test (dpb 1 (mpb1 2) 3) '(1 2 3)))
+  (g))
+
+(let ()
+  (define (byte-1 siz pos)
+    (list siz pos))
+
+  (define (lpb-1 x integer byte-1spec into)
+    (let ((v (list-values 0 integer byte-1spec into)))
+      (set! (v 0) x)
+      v))
+
+  (define (test-1)
+    (test (lpb-1 0 1 2 (byte-1 3 4)) '(0 1 2 (3 4)))
+    (test (lpb-1 0 1 (byte-1 2 3) 4) '(0 1 (2 3) 4))
+    (test (lpb-1 0 (byte-1 1 2) 3 4) '(0 (1 2) 3 4))
+    (test (lpb-1 (byte-1 0 1) 2 3 4) '((0 1) 2 3 4))
+
+    (test (lpb-1 (byte-1 0 1) (byte-1 2 3) (byte-1 4 5) (byte-1 6 7)) '((0 1) (2 3) (4 5) (6 7)))
+
+    (test (lpb-1 1 (byte-1 2 3) (byte-1 4 5) (byte-1 6 7)) '(1 (2 3) (4 5) (6 7)))
+    (test (lpb-1 (byte-1 0 1) 2 (byte-1 4 5) (byte-1 6 7)) '((0 1) 2 (4 5) (6 7)))
+    (test (lpb-1 (byte-1 0 1) (byte-1 2 3) 4 (byte-1 6 7)) '((0 1) (2 3) 4 (6 7)))
+    (test (lpb-1 (byte-1 0 1) (byte-1 2 3) (byte-1 4 5) 6) '((0 1) (2 3) (4 5) 6))
+
+    (test (lpb-1 1 (byte-1 2 3) (byte-1 4 5) (byte-1 6 7)) '(1 (2 3) (4 5) (6 7)))
+    (test (lpb-1 1 2 (byte-1 4 5) (byte-1 6 7)) '(1 2 (4 5) (6 7)))
+    (test (lpb-1 1 (byte-1 2 3) 4 (byte-1 6 7)) '(1 (2 3) 4 (6 7)))
+    (test (lpb-1 1 (byte-1 2 3) (byte-1 4 5) 6) '(1 (2 3) (4 5) 6))
+
+    (test (lpb-1 (byte-1 0 1) 2 4 (byte-1 6 7)) '((0 1) 2 4 (6 7)))
+    (test (lpb-1 (byte-1 0 1) 2 (byte-1 4 5) 6) '((0 1) 2 (4 5) 6))
+
+    (test (lpb-1 (byte-1 0 1) (byte-1 2 3) 4 6) '((0 1) (2 3) 4 6))))
+
+
+;;; --------------------------------------------------------------------------------
+;;; begin
+;;; --------------------------------------------------------------------------------
+
+(test (begin) ()) ; I think Guile returns #<unspecified> here
+(test (begin (begin)) ())
+(test ((lambda () (begin))) ())
+(test (let () (begin) #f) #f)
+(test (let () (begin (begin (begin (begin)))) #f) #f)
+(test (let () (begin (define x 2) (define y 1)) (+ x y)) 3)
+(test (let () (begin (define x 0)) (begin (set! x 5) (+ x 1)))  6)
+(test (let () (begin (define first car)) (first '(1 2))) 1)
+(test (let () (begin (define x 3)) (begin (set! x 4) (+ x x))) 8)
+(test (let () (begin (define x 0) (define y x) (set! x 3) y)) 0)         ; the let's block confusing global defines
+(test (let () (begin (define x 0) (define y x) (begin (define x 3) y))) 0)
+(test (let () (begin (define y x) (define x 3) y)) 'error)               ; guile says 3
+(test (let ((x 12)) (begin (define y x) (define x 3) y)) 12)             ; guile says 3 which is letrec-style?
+(test (begin (define (x) y) (define y 4) (x)) 4)
+;; (let ((x 12)) (begin (define y x) y)) is 12
+(test (let ((x 3)) (begin x)) 3)
+(test (begin 3) 3)
+(test (begin . (1 2)) 2)
+(test (begin . ()) (begin))
+(test (begin . 1) 'error)
+(test (begin 1 . 2) 'error)
+(test (begin ("hi" 1)) #\i)
+
+(when (equal? (begin 1) 1)
+  (test (let () (begin (define x 0)) (set! x (begin (begin 5))) (begin ((begin +) (begin x) (begin (begin 1))))) 6)
+
+  (test (let ((x 5))
+	  (begin (begin (begin)
+			(begin (begin (begin) (define foo (lambda (y) (bar x y)))
+				      (begin)))
+			(begin))
+		 (begin)
+		 (begin)
+		 (begin (define bar (lambda (a b) (+ (* a b) a))))
+		 (begin))
+	  (begin)
+	  (begin (foo (+ x 3))))
+	45)
+
+  (for-each
+   (lambda (arg)
+     (test (begin arg) arg))
+   (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+  (test (if (= 1 1) (begin 2) (begin 3)) 2))
+
+(test ((lambda (x) (begin (set! x 1) (let ((a x)) (+ a 1)))) 2) 2)
+;;; apparently these can be considered errors or not (guile says error, stklos and gauche do not)
+(test (begin (define x 0) (+ x 1)) 1)
+(test ((lambda () (begin (define x 0) (+ x 1)))) 1)
+(test (let ((f (lambda () (begin (define x 0) (+ x 1))))) (f)) 1)
+
+(test ((lambda () (begin (define x 0)) (+ x 1))) 1)
+(test (let ((f (lambda () (begin (define x 0)) (+ x 1)))) (f)) 1)
+(test (let ((x 32)) (begin (define x 3)) x) 3)
+(test ((lambda (x) (begin (define x 3)) x) 32) 3)
+(test (let* ((x 32) (y x)) (define x 3) y) 32)
+
+(test (let ((z 0)) (begin (define x 32)) (begin (define y x)) (set! z y) z) 32)
+(test (let((z 0))(begin(define x 32))(begin(define y x))(set! z y)z) 32)
+(test (let ((z 0)) (begin (define x 32) (define y x)) (set! z y) z) 32)
+(test (let () (begin (define b 1) (begin (define a b) (define b 3)) a)) 1)
+(test (let () (begin (begin (define a1 1) (begin (define a1 b1) (define b1 3))) a1)) 'error)
+(test (let () (begin (begin (define (a3) 1)) (begin (define (a3) b3) (define b3 3)) (a3))) 3) ; yow
+(test (let () (begin (begin (define (a) 1)) (a))) 1)
+(test (let ((a 1)) (begin (define a 2)) a) 2)
+(test (+ 1 (begin (values 2 3)) 4) 10)
+(test (+ 1 (begin (values 5 6) (values 2 3)) 4) 10)
+(test (let ((hi 0)) (begin (values (define (hi b) (+ b 1))) (hi 2))) 3)
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; apply
+;;; --------------------------------------------------------------------------------
+
+(test (apply (lambda (a b) (+ a b)) (list 3 4)) 7)
+(test (apply + 10 (list 3 4)) 17)
+(test (apply list ()) ())
+(test (apply + '(1 2)) 3)
+(test (apply - '(1 2)) -1)
+(test (apply max 3 5 '(2 7 3)) 7)
+(test (apply cons '((+ 2 3) 4)) '((+ 2 3) . 4))
+(test (apply + ()) 0)
+(test (apply + (list 3 4)) 7)
+(test (apply + ()) 0)
+(test (apply + 2 '(3)) 5)
+(test (apply + 2 3 ()) 5)
+(test (apply + '(2 3)) 5)
+(test (apply list 1 '(2 3)) (list 1 2 3))
+(test (apply apply (list list 1 2 '(3))) (list 1 2 3))
+(test (vector? (apply make-vector '(1))) #t)
+(test (apply make-vector '(1 1)) #(1))
+(test (apply make-vector '((1) 1)) #(1))
+(test (let ((f +)) (apply f '(1 2))) 3)
+(test (apply min '(1 2 3 5 4 0 9)) 0)
+(test (apply min 1 2 4 3 '(4 0 9)) 0)
+(test (apply vector 1 2 '(3)) #(1 2 3))
+(test (apply vector ()) #())
+(test (()) 'error)
+(test (#()) 'error)
+(test (#(1 2)) 'error)
+(test (apply #() ()) 'error)
+(test (apply #r() ()) 'error)
+(test (apply (byte-vector) ()) 'error)
+(test (apply #(1 2) ()) 'error)
+(test (apply (lambda (x . y) x) (list 1 2 3)) 1)
+(test (apply * (list 2 (apply + 1 2 '(3)))) 12)
+(test (apply (if (> 3 2) + -) '(3 2)) 5)
+(test (let ((x (list 1 2))) (eq? x (append () x))) #t) ;; ?? guile says #t also
+(test (apply (lambda* args args) 1 2 3 '(4 5 6 (7))) '(1 2 3 4 5 6 (7))) ; from lisp bboard
+(test (apply (list 1 2) '(0)) 1)
+
+(test (apply (cons 1 2) '(0)) 1) ; ! (apply (cons 1 2) '(1)) is an error
+(test (procedure? apply) #t)
+(test (string? (help apply)) #t)
+(let ((lst (list 'values '(procedure? sequence?) #t))) ; values rather than #t since (+ (apply values '(1 2))) -> 3
+  (set-cdr! (cddr lst) (cddr lst))
+  (test (equal? lst (signature apply)) #t))
+
+(for-each
+ (lambda (arg)
+   (test (apply (lambda (x) x) (list arg)) arg))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(test (apply cadadr (list '''4)) 4)
+(test (apply string-ref "hi" '(0)) #\h)
+(test (let ((x (string-copy "hi"))) (apply string-set! x 0 '(#\c)) x) "ci")
+(test (apply apply (list + '(3  2))) 5)
+(test (apply apply apply apply (list (list (list + '(3  2))))) 5)
+(test (apply + 1 2 (list 3 4)) 10)
+(test ((apply cdr '((1 2) (3 4)) ()) 0) '(3 4))
+(test ((apply car '((1 2) (3 4)) ()) 1) 2)
+(test ((apply cadr '((1 2) (3 4)) ()) 1) 4)
+(test (apply append ()) ())
+(test (apply apply append ()) ())
+(test (apply apply apply append '(())) ())
+(test (apply apply + ()) 0)
+(test (apply apply * ()) 1)
+(test (apply apply not not () ()) #f)
+(test (apply apply apply eq? eq? eq? () () ()) #t)
+(test (apply apply apply list list list () () ()) (list list list))
+(test (apply apply vector cons (list '1 '2) ()) (vector cons 1 2))
+
+(test (let ((x '(((1 2)) ((3 4))))) (catch #t (lambda () (apply apply apply apply x)) (lambda args 'error)) x) '(((1 2)) ((3 4))))
+(test (let ((x '((1 2) (3 4)))) (catch #t (lambda () (apply apply apply apply x)) (lambda args 'error)) x) '((1 2) (3 4)))
+(test (let ((x '((1 2) 3 4))) (catch #t (lambda () (apply apply apply x)) (lambda args 'error)) x) '((1 2) 3 4))
+(test (let ((x '((1 2) (3 4)))) (catch #t (lambda () (apply apply apply not x)) (lambda args 'error)) x) '((1 2) (3 4)))
+
+(test (eq? (apply apply apply values '(())) #<unspecified>) #t)
+(test (eqv? (apply apply apply values '(())) #<unspecified>) #t)
+(test (equal? (apply apply apply values '(())) #<unspecified>) #t)
+
+(test (apply apply apply + '(((1)))) 1)
+(test (apply apply map + '(((1)))) '(1))
+(test (apply apply map quote '(((1)))) '(1))
+(test (apply apply map values '(((1)) ((2)))) '((1) 2))
+(test (apply apply map append '(((1)) ((2)))) '((1 . 2)))
+(test (apply apply apply quote '(((1)))) 1)
+(test (apply map cdr '(((1 2) (3 4)))) '((2) (4)))
+(test (apply apply + '((1 2))) 3)
+(test (apply apply cons '(((1 2) (3 4)))) '((1 2) 3 4))
+(test (apply apply append '(((1 2) (3 4)))) '(1 2 3 4))
+(test (apply map + '((1 2) (3 4))) '(4 6))
+(test (apply map reverse '(((1 2) (3 4)))) '((2 1) (4 3)))
+(test (apply apply map cons '(((1 2) (3 4)))) '((1 . 3) (2 . 4)))
+(test (apply apply map list-tail '(((1 2) (3 4))) '(((1)))) '(((3 4))))
+(test (apply apply map reverse '((1 2) (3 4)) '(())) '((2 1) (4 3)))
+(test (apply apply map values '(((1)) ((2))) '(((1 2) (3 4)))) '(((1)) 1 3 ((2)) 2 4))
+(test (apply apply map append '(((1 2) (3 4))) '(((1)) ((2)))) '(((1 2) (3 4) 1 . 2)))
+(test (apply apply map append '(()) '(((1)) ((2)))) '((1 . 2)))
+(test (apply apply map cdr '(((1 2) (3 4))) ()) '((2) (4)))
+(test (apply apply apply list-tail '((1 2) (3 4)) '(((1)))) '((3 4)))
+(test (apply apply apply reverse '(((1 2) (3 4))) '(())) '((3 4) (1 2)))
+(test (apply apply apply values '(1) '(())) 1)
+(test (apply apply apply values '(1) '((()))) '(1))
+(test (apply apply apply values '((1)) ()) 1)
+(test (apply apply apply values '((1)) '(())) '(1))
+(test (apply apply reverse '(((1 2) (3 4))) ()) '((3 4) (1 2)))
+(test (apply apply append () '(((1 2) (3 4)))) '(1 2 3 4))
+(test (apply apply length '(()) ()) 0)
+(test (apply apply let () '((1))) 1)
+(test (apply apply apply apply + '((()))) 0)
+(test (apply apply apply map reverse '((1 2) (3 4)) '((()))) '((2 1) (4 3)))
+(test (apply apply apply map values '(((1 2) (3 4))) ()) '(1 3 2 4))
+(test (apply apply apply apply + '(1) '((()))) 1)
+
+(test (apply apply apply append (reverse '(((1)) ((2))))) '((2) . 1))
+(test (apply apply map append (reverse '(((1)) ((2))))) '((2 . 1)))
+(test (apply quote (map reverse (reverse '((1 2))))) '(2 1))
+(test (map quote (apply map + '((1 2) (3 4)))) '(4 6))
+(test (map car (apply map quote '(((1 2) (3 4))))) '(1 3))
+(test (apply length (apply map append '(((1)) ((2))) '((1)))) -1)
+(test (apply append (apply map list-tail '(((1 2) (3 4))) '((1)))) '((3 4)))
+(test (apply append (apply map values '(((1)) ((2))) '(((1 2) (3 4))))) '((1) 1 2 (2) 3 4))
+(test (apply append (apply map values '((1 2) (3 4)) '(((1 2) (3 4))))) '(1 2 1 2 3 4 3 4))
+(test (apply append '((1) () (2 3 4) (5 6) ())) '(1 2 3 4 5 6))
+(test (apply append '((1) () (2 3 4) (5 6) 7)) '(1 2 3 4 5 6 . 7))
+
+(test (apply +) 0)
+(test (apply + #f) 'error)
+(test (apply #f '(2 3)) 'error)
+(test (apply make-vector '(1 2 3)) 'error)
+(test (apply + 1) 'error)
+(test (apply) 'error)
+(test (apply 1) 'error)
+(test (apply . 1) 'error)
+(test (apply car ''foo) 'error)
+(test (apply + '(1 . 2)) 'error)
+(test (apply + '(1 2 . 3)) 'error)
+(test (apply () ()) 'error)
+(test (apply list '(1 . 2) ()) '((1 . 2)))
+(test (apply (lambda (x) x) _ht_ _undef_ _null_ _c_obj_) 'error)
+(test (apply + #(1 2 3)) 'error)
+(test (apply (lambda (a b) (+ a b)) '(1 . 2)) 'error)
+(test (apply (lambda args (apply + args)) 1 2 3) 'error)
+(test (apply (lambda args (apply + args)) 1 2 #f) 'error)
+(test (apply (lambda args (apply list args)) 1 2 #f) 'error)
+(test (apply (lambda args (apply + args)) 1 2 ()) 3)
+(test (apply (lambda args (apply list args)) 1 2 ()) '(1 2))
+(test (apply (lambda args (apply list args)) 1 '(2)) '(1 2))
+(test (apply (lambda args (apply list args)) 1 '2) 'error)
+(test (apply (lambda args (apply list args)) 1 'abs) 'error)
+(test (apply (lambda args (apply list args)) 1 ''2) '(1 #_quote 2))
+(test (apply (lambda args (apply list args)) () ()) '(()))
+(test (apply (lambda args (apply list args)) () (cons 1 2)) 'error)
+(test (apply (lambda args (apply list args)) (cons 1 2)) 'error)
+(test (apply (apply lambda (signature +) '('x)) #i(1)) 'error)
+(test (let () (define (f x) (apply x ((if (> 3 2) list vector) 3 2))) (f +)) 5) ; optimizer bug
+(test (let () (define (f x) (apply x ((if (> 3 2) + -) 3 2))) (f abs)) 'error)
+
+(test (apply "hi" '(1 2)) 'error)
+(test ("hi" 1 2) 'error)
+(test (apply '(1 2) '(1 2)) 'error)
+(test ((list 1 2 3) 1 2) 'error)
+
+(test (apply "hi" '(1)) #\i)
+(test ("hi" 1) #\i)
+(test (apply '(1 2) '(1)) 2)
+(test ((list 1 2 3) 1) 2)
+
+(for-each
+ (lambda (arg)
+   (test (apply arg '(1)) 'error)
+   (test (apply abs arg) 'error))
+ (list -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #t))
+
+(test (apply "hi" '(1)) #\i)
+(test (apply '(1 2 3) '(1)) 2)
+(test (apply #(1 2 3) '(2)) 3)
+(test (apply #2d((1 2) (3 4)) 0 0 ()) 1)
+(test (apply '((1 2) (3 4)) 1 0 ()) 3)
+(test (let ((ht (make-hash-table))) (set! (ht "hi") 32) (apply ht '("hi"))) 32)
+
+(test (let ((x (list 1 2))) (set-cdr! x x) (apply + x)) 'error)
+(test (apply + '(1 2 . 3)) 'error)
+(test (apply + '(1 2) (list 3 4)) 'error)
+(test (let () (define (mrec a b) (if (<= b 0) (list a) (apply mrec (list a) (list (- b 1))))) (mrec (list 1 2) 5)) '(((((((1 2))))))))
+(test (apply (inlet) '(define y 32)) 32)
+(test (let ()
+	(define (rfunc) '(define y 32))
+	(define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (apply (inlet) (rfunc)))))
+	(func))
+      32)
+
+(let ((lst (list 1 2 3)))
+   (set! (cdr (cddr lst)) lst)
+   (test (apply + lst) 'error))
+
+(test (let ((lst '(1 2 3))) (let ((lst1 (apply list lst))) (set! (car lst1) 21) lst)) '(1 2 3))
+(test (let ((lst '(1 2))) (let ((lst1 (apply cons lst))) (set! (car lst1) 21) lst)) '(1 2))
+(test (let* ((x '(1 2 3)) (y (apply list x))) (eq? x y)) #f) ; this was #t until 26-Sep-11
+
+(test (apply values (values (cons 1 ()))) 1)
+(test (+ (apply values (values (list 1 2)))) 3)
+(test (port-filename) (apply port-filename (list)))
+(num-test (apply atan (#(1 #\a (3)) (max (values 1 2)))) 1.2490457723983)
+(test (apply #2d((1 2) (3 4)) (list (floor (acosh 1)))) #(1 2))
+(test ((apply values (list + 1 2)) 3) 6)
+(if with-complex (num-test (* 0-2i (acosh (asin 0.0))) pi))
+(test (apply truncate (lognot (min 1)) (list)) -2)
+(num-test (apply /(list 11 11)) 1)
+
+(test (apply dynamic-wind (list (lambda () #f) (lambda () 1) (lambda () #f))) 1)
+(test (apply call-with-exit (list (lambda (exit) 1))) 1)
+(test (apply call-with-exit (list (lambda (exit) (exit 1) 32))) 1)
+(test (apply catch (list #t (lambda () 1) (lambda args 'error))) 1)
+(test (apply eval '((+ 1 2))) 3)
+(test (apply eval ()) 'error) ; (eval) is an error -- should it be? (eval ()) is () so perhaps (following values), (eval) -> #<unspecified>?
+(test (apply eval '(())) ())
+(test (apply eval-string '("(+ 1 2)")) 3)
+(test (let () (apply begin '((define x 1) (define y x) (+ x y)))) 2)
+(test (apply begin ()) (begin))
+(test (apply if '(#f 1 2)) 2)
+(test (apply if '(#f)) 'error)
+(test (let ((x 1)) (apply set! '(x 3)) x) 3)
+(test (let ((x 3)) (apply set! (list (values 'x 32))) x) 32)
+(test (let ((x 1)) (apply cond '(((= x 2) 3) ((= x 1) 32)))) 32)
+(test (apply and '((= 1 1) (> 2 3))) #f)
+(test (apply and ()) (and))
+(test (apply or '((= 1 1) (> 2 3))) #t)
+(test (apply or ()) (or))
+(test (let () (apply define '(x 32)) x) 32)
+(test (let () (apply define* '((hi (a 1) (b 2)) (+ a b))) (hi 32)) 34)
+(test ((apply lambda '((n) (+ n 1))) 2) 3)
+(test ((apply lambda* '(((n 1)) (+ n 1)))) 2)
+(test (apply let '(((x 1)) (+ x 2))) 3)
+(test (apply let* '(((x 1) (y (* 2 x))) (+ x y))) 3)
+(test (equal? (apply let* '((a 2) (b (+ a 3))) '(list + a b) ()) (list + 2 5)) #t)
+(test (apply let 'func '((i 1) (j 2)) '((+ i j (if (> i 0) (func (- i 1) j) 0)))) 5)
+(test (let () (apply define-macro `((hiho a) `(+ ,a 1))) (hiho 2)) 3)
+;(test (let () (apply defmacro `(hiho (a) `(+ ,a 1))) (hiho 2)) 3)
+;(test (let () (apply defmacro* `(hiho ((a 2)) `(+ ,a 1))) (hiho)) 3)
+(test (let () (apply define-macro* `((hiho (a 2)) `(+ ,a 1))) (hiho)) 3)
+(test (apply do '(((i 0 (+ i 1))) ((= i 3) i))) 3)
+(test (apply case '(1 ((2 3) 4) ((1 5) 32))) 32)
+(test (+ (apply values '(1 2 3))) 6)
+(test (apply quote '(1)) 1)
+(test (apply quote ()) 'error) ; (quote) is an error
+(test (let () (apply letrec '(() (define x 9) x))) 9)
+(test ((lambda (n) (apply n '(((x 1)) (+ x 2)))) let) 3)
+(test ((apply lambda (list (apply let (list (list) (quote (list (apply case '(0 ((0 1) 'n))))))) (quasiquote (+ n 1)))) 2) 3)
+(test (apply let '((x 1)) '((+ x 1))) 2)
+(test ((apply dilambda (list (lambda (x) (+ x 1)) (lambda (x y) (+ x y)))) 23) 24)
+(test (apply (apply dilambda (list (lambda (x) (+ x 1)) (lambda (x y) (+ x y)))) '(23)) 24)
+(test (apply map list '((1 one) (2 two) (3 three))) '((1 2 3) (one two three))) ; from scheme bboard
+;;; so (define (unzip l) (apply values (apply map list l)))
+
+(test (apply 'begin) 'error)
+(test (apply and) #t)
+(test (apply begin) ())
+(test (apply if '((> 1 2) 3 4)) 4)
+(test (apply or) #f)
+(test (apply quote '(1)) 1)
+
+(let ()
+  (define (min-max arg . args)
+    (if (null? args)
+	(apply max arg)
+	(min (apply max arg)
+	     (apply min-max args))))
+
+  (test (min-max '(1 2 3) '(0 -1 4)) 3)
+  (test (min-max '(1 2 3) '(0 -1 4) '(1 2)) 2))
+
+(let () ; apply_sa picks up fop6 outlet where x and i are not defined while evaluating (vector i x)?!?
+  (define (fop6 x y) (apply x (cons y ())))
+  (define (func) (let ((x #f) (i 0)) (fop6 begin ((let () quasiquote) (vector i x)))))
+  (test (func) 'error))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; define
+;;; --------------------------------------------------------------------------------
+
+;;; trying to avoid top-level definitions here
+
+(let ()
+  (define x 2)
+  (test (+ x 1) 3)
+  (set! x 4)
+  (test (+ x 1) 5)
+  (let ()
+    (define (tprint x) #t)
+    (test (tprint 56) #t)
+    (let ()
+      (define first car)
+      (test (first '(1 2)) 1)
+      (let ()
+	(define foo (lambda () (define x 5) x))
+	(test (foo) 5)
+	(let ()
+	  (define (foo x) ((lambda () (define x 5) x)) x)
+	  (test (foo 88) 88))))))
+
+
+(test (letrec ((foo (lambda (arg) (or arg (and (procedure? foo) (foo 99)))))) (define bar (foo #f)) (foo #f)) 99)
+(test (letrec ((foo 77) (bar #f) (retfoo (lambda () foo))) (define baz (retfoo)) (retfoo)) 77)
+
+(test (let () (define .. 1) ..) 1)
+
+(test (let () (define (hi a) (+ a 1)) (hi 2)) 3)
+(test (let () (define (hi a . b) (+ a (cadr b) 1)) (hi 2 3 4)) 7)
+(test (let () (define (hi) 1) (hi)) 1)
+(test (let () (define (hi . a) (apply + a)) (hi 1 2 3)) 6)
+
+(for-each
+ (lambda (arg)
+   (test (let () (define x arg) x) arg))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(test ((lambda (x) (define (hi a) (+ a 1)) (hi x)) 1) 2)
+(test (let ((x 2)) (define f (lambda (y) (+ y x))) (f 3)) 5)
+(begin (define r5rstest-plus (lambda (x y) (+ x y))) (define r5rstest-x 32))
+(test (r5rstest-plus r5rstest-x 3) 35)
+(test (let ((x 2.0)) (define (hi a) (set! a 3.0)) (hi x) x) 2.0)
+
+(test (let () (define (asdf a) (define (asdf a) (+ a 1)) (+ a (asdf a))) (asdf 4)) 9)
+(test (let ((asdf 1)) (define (asdf a) (define (asdf a) (+ a 1)) (+ a (asdf a))) (asdf 4)) 9)
+(test (let () (define (a1 a) (define (a2 a) (define (a3 a) (define (a4 a) (+ a 1)) (+ (a4 a) 1)) (+ (a3 a) 1)) (+ (a2 a) 1)) (a1 0)) 4)
+
+(test (let () (define (hi1 a) (define (hi1 b) (+ b 1)) (hi1 a)) (hi1 1)) 2)
+(test (let () (define (hi1 a) (begin (define (hi1 b) (+ b 1))) (hi1 a)) (hi1 1)) 2)
+(test (let ((j 0) (k 0))
+	(define (hi1 a)
+	  (let ((hi1 (lambda (b)
+		       (set! k (+ k 1))
+		       (hi1 (- b 1)))))
+	    (if (<= a 0)
+		(list j k)
+		(begin
+		  (set! j (+ j 1))
+		  (hi1 (- a 1))))))
+	(hi1 3))
+      '(2 2))
+
+(test (procedure? (let () (define (a) a) (a))) #t)
+(let ((oddp (lambda (a) (not (even? a)))))
+   (define (hi a) (and (a 123) (a 321)))
+   (test (hi oddp) #t))
+
+(test (define) 'error)
+(test (define*) 'error)
+(test (define x) 'error)
+(test (define . x) 'error)
+(test (define x 1 2) 'error)
+(let-temporarily (((*s7* 'print-length) 1))
+  (test (define x 1 (make-list 10 #<unspecified>)) 'error)) ; try to force truncate_string call
+(test (define x x) 'error)
+(test (define x x x) 'error)
+(test (define x x . x) 'error)
+(test (let ((x 0)) (define x (x . x))) 'error)
+(test (define (x x) . x) 'error)
+(test (eval-string "(define (x .) 1)") 'error) ; need eval-string else a read error that halts our tests
+(test (eval-string "(define (x) (+ 1 .))") 'error)
+(test (define (x x) x . x) 'error)
+(test (let ()
+	(define (x x) x) ; sym_id case in define2_ex, let above is id=19, x is id=20 -- new_env (funclet) arg=x id=20
+	(x 0))
+      0)
+(test (define (x 1)) 'error)
+(test (define (x)) 'error)
+(test (define 1 2) 'error)
+(test (define "hi" 2) 'error)
+(test (define :hi 2) 'error)
+(test (define x 1 2) 'error)
+(test (define x 1 . 2) 'error)
+(test (define x . 1) 'error)
+(test (define x (lambda ())) 'error)
+(test (define #<eof> 3) 'error)
+(test (define (#<undefined>) 4) 'error)
+(test (define (:hi a) a) 'error)
+(test (define (hi: a) a) 'error)
+(test (define (#b1 a) a) 'error)
+(test (define (hi #b1) #b1) 'error)
+(test (define () 1) 'error)
+(test (let() (define #(hi a) a)) 'error)
+(test (let () (define hi (lambda args args)) (hi 1 . 2)) 'error)
+(test (let () (define . 1) 1) 'error)
+(test (let () (define func (do () (#t (lambda (y) 2)))) (func 1)) 2)
+(test (let () (define* x 3)) 'error)
+(test (let () (define (hi) 1 . 2)) 'error)
+(test (let () (define (hi) (1) . "hi")) 'error)
+(test (let () (define _definee_ (values))) #<unspecified>)
+(test (let () (define _definee_ (values 1))) 1)
+(test (let () (define _definee_ (values 1 2))) 'error)
+(test ((lambda () (define _definee_ (values 1 2)))) 'error)
+
+(test (let () (define (f . f) f) (f 1 2)) '(1 2))
+;(test (let () (define (f f) (define* (f1 (f f)) f) (f1)) (f 0)) 0)
+;(test (let () (define (f1 f) (define* (f (f f)) f) (f)) (procedure? (f1 0))) #f) ; either way is fine...
+;(test (let () (define (f f) (define* (f (f f)) f) (f)) (procedure? (f 0))) #f)
+(test (let ((f1 (define f2 32))) (+ f1 f2)) 64)
+(test (let () (define x (+ (define y 3) 2)) (list x y)) '(5 3))
+(test (let ((a 1) (b 2)) (define (f a b) (let ((a a) (b b)) (+ a b))) (f 4 3)) 7)
+(test (let () (define (f x . y) (if (> x 0) (f (- x 1) y) y)) (f 4 1)) '(((((1))))))
+(let () (define x (begin (define y 1) (+ y 1))) (test (+ x y) 3))
+(let () (test ((define (fact x) (if (< x 2) 1 (* x (fact (- x 1))))) 3) 6))
+(test (map (let () (define (fact x) (if (< x 2) 1 (* x (fact (- x 1)))))) '(3 5)) '(6 120))
+
+;;; --------
+;;; check envs
+(test (let () (do ((i 0 (+ i 1))) ((= i 3) (define xyz 37) i)) xyz) 'error)
+(test (let () (do ((i 0 (+ i 1))) ((= i 3)) (define xyz 37)) xyz) 'error)
+(test (let () (do ((i (begin (define xyz 37) 0) (+ i 1))) ((= i 3))) xyz) 37)
+(test (let () (do ((i 0 (begin (define xyz 37) (+ i 1)))) ((= i 3))) xyz) 'error)
+
+(test (let () (let ((i (begin (define xyz 37) 0))) i) xyz) 37)
+(test (let () (let ((i 0)) (define xyz 37) i) xyz) 'error)
+
+(test (let () (let* ((i (begin (define xyz 37) 0))) i) xyz) 37)
+(test (let () (let* ((i 0)) (define xyz 37) i) xyz) 'error)
+(test (let () (let* ((k 0) (i (begin (define xyz 37) 0))) i) xyz) 'error)
+
+(test (let () (letrec ((i (begin (define xyz 37) 0))) i) xyz) 'error)
+(test (let () (letrec ((i (begin (define xyz 37) 0))) xyz)) 37)
+(test (let () (letrec ((i 0)) (define xyz 37) i) xyz) 'error)
+
+(test (let () (letrec* ((i (begin (define xyz 37) 0))) i) xyz) 'error)
+(test (let () (letrec* ((i (begin (define xyz 37) 0))) xyz)) 37)
+(test (let () (letrec* ((i 0)) (define xyz 37) i) xyz) 'error)
+(test (let () (letrec* ((k 0) (i (begin (define xyz 37) 0))) i) xyz) 'error)
+
+(test (let () (cond ((define xyz 37) #f)) xyz) 37)
+(test (let () (cond ((> 2 1) (define xyz 37) #f)) xyz) 37)
+(test (let () (cond ((< 2 1) 0) (else (define xyz 37) #f)) xyz) 37)
+
+(test (let () (if (define xyz 37) 0 1) xyz) 37)
+(test (let () (if (> 2 1) (define xyz 37) 1) xyz) 37)
+(test (let () (if (< 2 1) 0 (define xyz 37)) xyz) 37)
+
+(test (let () (when (define xyz 37) #f) xyz) 37)
+(test (let () (when (> 2 1) (define xyz 37) #f) xyz) 37)
+(test (let () (unless (define xyz 37) #f) xyz) 37)
+(test (let () (unless (< 2 1) (define xyz 37) #f) xyz) 37)
+
+(test (let () (quote (define xyz 37)) xyz) 'error)
+(test (let () (begin (define xyz 37) 0) xyz) 37)
+(test (let () (and (define xyz 37) 0) xyz) 37)
+(test (let () (or (define xyz 37) 0) xyz) 37)
+(test (let ((x 0)) (set! x (define xyz 37)) xyz) 37)
+(test (let () (with-let (curlet) (define xyz 37)) xyz) 37)
+(test (let () (with-let (inlet 'a 1) (define xyz 37)) xyz) 'error)
+(test (let () (with-baffle (define xyz 37) 2) xyz) 'error)                      ; with-baffle introduces a new frame
+
+(test (let () (case (define xyz 37) ((0) 1) ((37) #t)) xyz) 37)
+(test (let () (case 1 ((1) (define xyz 37)) ((0) 1)) xyz) 37)
+(test (let () (case 1 ((0) 1) (else (define xyz 37) 2)) xyz) 37)
+
+(test (let () (lambda () (define xyz 37)) xyz) 'error)
+(test (let () (define* (fxyz (a (define xyz 37))) a) (fxyz) xyz) 'error)        ; ??? it's defined in fxyz!
+(test (let () (define* (fxyz (a (define xyz 37))) xyz) (fxyz)) 37)              ; !
+;;; --------
+
+(test (let () (define (f1 f1) (f1 1)) (f1 (lambda (x) (+ x 2)))) 3)
+(test (let () (define (f2 x f2) (if (= x 0) x (f2 (- x 1) f2))) (f2 2 (lambda (x f) x))) 1)
+(let () ; tc optimizer bug
+  (define (f2 x f2) (if (= x 0) x (f2 (- x 1) x)))
+  (test (f2 2 (lambda (x f) (+ x 12))) 13)
+  (define (f3 f3) (if (integer? f3) f3 (f3 32)))
+  (test (f3 (lambda (x) (+ x 12))) 44)
+  (define (f4 x f4) (if (= x 0) 10 (if (= x 1) 11 (f4 (- x 1) x))))
+  (test (f4 2 (lambda (x f) (+ x 12))) 13))
+
+(let ()
+  (define a#b 3)
+  (define a'b 4)
+  (define a,b 5)
+  (define a[b 6)
+  (define a@b 7)
+  (define a\b 8)
+  (define a|b 9)
+  (test (+ a#b a'b a,b a[b a@b a\b a|b) 42))
+
+(let ()
+  (define (make-func) (define (a-func a) (+ a 1)))
+  (test (procedure? (make-func)) #t))
+
+(let () (test (if (and (define x 3) (define y 4)) (+ x y)) 7))
+(let () (test (if (not (and (define x 2) (define y 4))) (+ x y) (if (define x 3) x)) 3))
+(let () (test (if (and (define x 2) (not (define y 4))) (+ x y) (- x y)) -2))
+(test (let () (define (f a) (lambda () a)) (+ ((f 1)) ((f 2)))) 3)
+(test (let () (define (hi) (let ((a 1)) (set! a 2) (define (ho) a) (set! a 3) (ho))) (hi)) 3)
+;;; (define-macro (make-lambda args . body) `(apply lambda* ',args '(,@body))): (make-lambda (a b) (+ a b))
+
+(test (length (let ((a 3)) (define a 4) (curlet))) 1)
+(test (length (let ((a 3)) (define (a) 4) (curlet))) 1)
+(test (length (let ((a 3)) (define (a) 4) (define (a) 5) (curlet))) 1)
+
+(let ((x1 32)) (set! x1 (define x2 12)) (test x1 12) (test x2 12))
+
+;; y combinator example from some CS website
+(let ()
+  (define Y
+    (lambda (X)
+      ((lambda (procedure)
+         (X (lambda (arg) ((procedure procedure) arg))))
+       (lambda (procedure)
+         (X (lambda (arg) ((procedure procedure) arg)))))))
+
+  (define M
+    (lambda (func-arg)
+      (lambda (l)
+        (if (null? l)
+            'no-list
+            (if (null? (cdr l))
+                (car l)
+                (max (car l) (func-arg (cdr l))))))))
+
+  (test ((Y M) '(4 5 6 3 4 8 6 2)) 8))
+
+(test (((lambda (X)
+	  ((lambda (procedure)
+	     (X (lambda (arg) ((procedure procedure) arg))))
+	   (lambda (procedure)
+	     (X (lambda (arg) ((procedure procedure) arg))))))
+	(lambda (func-arg)
+	  (lambda (n)
+	    (if (zero? n)
+		1
+		(* n (func-arg (- n 1)))))))
+       5)
+      120)
+
+;;; from a paper by Mayer Goldberg
+(let ()
+  (define curry-fps
+    (lambda fs
+      (let ((xs
+	     (map
+	      (lambda (fi)
+		(lambda xs
+		  (apply fi
+			 (map
+			  (lambda (xi)
+			    (lambda args
+			      (apply (apply xi xs) args)))
+			  xs))))
+	      fs)))
+	(map (lambda (xi)
+	       (apply xi xs)) xs))))
+
+  (define E
+    (lambda (even? odd?)
+      (lambda (n)
+        (if (zero? n) #t ; return Boolean True
+            (odd? (- n 1))))))
+
+  (define O
+    (lambda (even? odd?)
+      (lambda (n)
+        (if (zero? n) #f ; return Boolean False
+            (even? (- n 1))))))
+
+  (define list-even?-odd? (curry-fps E O))
+  (define new-even? (car list-even?-odd?))
+  (define new-odd? (cadr list-even?-odd?))
+
+  (test (new-even? 6) #t)
+  (test (new-odd? 6) #f))
+
+(let ()
+  (define (Cholesky:decomp P)
+    ;; from Marco Maggi based on a Scheme bboard post
+    ;; (Cholesky:decomp '((2 -2) (-2 5))) -> ((1.4142135623731 0) (-1.4142135623731 1.7320508075689))
+    (define (Cholesky:make-square L)
+      (define (zero-vector n)
+	(if (zero? n)
+	    ()
+	    (cons 0 (zero-vector (- n 1)))))
+      (map (lambda (v)
+	     (append v (zero-vector (- (length L) (length v)))))
+	   L))
+    (define (Cholesky:add-element P L i j)
+      (define (Cholesky:smaller P)
+	(if (null? (cdr P))
+	    ()
+	    (reverse (cdr (reverse P)))))
+      (define (Cholesky:last-row L)
+	(car (reverse L)))
+      (define (matrix:element A i j)
+	(list-ref (list-ref A i) j))
+      (define (Cholesky:make-element P L i j)
+	(define (Cholesky:partial-sum L i j)
+	  (let loop ((k j))
+	    (case k
+	      ((0) 0)
+	      ((1) (* (matrix:element L i 0)
+		      (matrix:element L j 0)))
+	      (else
+	       (+ (* (matrix:element L i k)
+		     (matrix:element L j k))
+		  (loop (- k 1)))))))
+	(let ((x (- (matrix:element P i j)
+		    (Cholesky:partial-sum L i j))))
+	  (if (= i j)
+	      (sqrt x)
+	      (/ x (matrix:element L j j)))))
+      (if (zero? j)
+	  (append L `((,(Cholesky:make-element P L i j))))
+	  (append (Cholesky:smaller L)
+		  (list (append
+			 (Cholesky:last-row L)
+			 (list (Cholesky:make-element P L i j)))))))
+    (Cholesky:make-square
+     (let iter ((i 0) (j 0) (L ()))
+       (if (>= i (length P))
+	   L
+	   (iter (if (= i j) (+ 1 i) i)
+		 (if (= i j) 0 (+ 1 j))
+		 (Cholesky:add-element P L i j))))))
+  (let* ((lst (Cholesky:decomp '((2 -2) (-2 5))))
+	 (lst0 (car lst))
+	 (lst1 (cadr lst)))
+    (if (or (> (abs (- (car lst0) (sqrt 2))) .0001)
+	    (not (= (cadr lst0) 0))
+	    (> (abs (+ (car lst1) (sqrt 2))) .0001)
+	    (> (abs (- (cadr lst1) (sqrt 3))) .0001))
+	(format #t ";cholesky decomp: ~A~%" lst))))
+
+(let ((vals #(1 0 -2 0 1 0 1 -1 -10 -30 -67 -138 -291 -642 -1446 -3250 -7244 -16065 -35601 -78985 -175416 -389695 -865609
+              -1922362 -4268854 -9479595 -21051458 -46750171 -103821058 -230560902 -512016658)))
+  ;; from Programming Praxis -- this is Donald Knuth's Algol compiler test, stack size becomes enormous...
+  (define (A k x1 x2 x3 x4 x5)
+    (define (B)
+      (set! k (- k 1))
+      (A k B x1 x2 x3 x4))
+    (if (<= k 0)
+	(+ (x4) (x5))
+	(B)))
+  (test (A 10 (lambda () 1) (lambda () -1) (lambda () -1) (lambda () 1) (lambda () 0)) (vals 10))
+
+  (when full-s7test
+    (define (test-A lim)
+      (do ((i 0 (+ i 1)))
+	  ((= i (min lim 24)))
+        (let ((val (A i (lambda () 1) (lambda () -1) (lambda () -1) (lambda () 1) (lambda () 0))))
+          (unless (= val (vals i))
+            (format *stderr* "test-A ~D: ~D (should be ~D)~%" i val (vals i))))))
+    (test-A 20)) ; for lim=24, s7 .33 Guile .34 but the timings are variable based on system allocation times
+
+  (define (A k x1 x2 x3 x4 x5 x6)
+    (define (B)
+      (set! k (- k 1))
+      (A k B x1 x2 x3 x4 x5))
+    (if (<= k 0)
+	(+ (x4) (x5) (x6))
+	(B)))
+  (test (A 10 (lambda () 1) (lambda () -1) (lambda () -1) (lambda () 1) (lambda () 0) (lambda () 0)) -109)
+
+  (define (A k x1 x2 x3 x4 x5 x6)
+    (define (B)
+      (set! k (- k 1))
+      (A k B x1 x2 x3 x4 x5))
+    (if (<= k 0)
+	(+ (x4) (x5) (x6))
+	(B)))
+  (test (A 10 (lambda () (define x1 1) x1)
+	      (lambda () (define (x1) -1) (x1))
+	      (lambda () (define x1 #(-1)) (x1 0))
+	      (lambda () (define* (x1 (x2 1)) x2) (x1))
+	      (lambda () (define x1 (list 0)) (x1 0))
+	      (lambda () 0))
+       -109)
+
+  ;; Jensen's test (from Rosetta CL code)
+  (define (%sum lo hi func)
+    (let ((sum 0.0))
+      (do ((i lo (+ i 1)))
+  	  ((> i hi) sum)
+        (set! sum (+ sum (func i))))))
+
+  (define-macro (sum i lo hi term)
+    `(%sum ,lo ,hi (lambda (,i) ,term)))
+
+  (num-test (sum x 1 100 (/ 1.0 x)) 5.187377517639621))
+
+(let ()
+  (define* (a1 (b (let ()
+		    (define* (a1 (b 32)) b)
+		    (a1))))
+    b)
+  (test (a1) 32)
+  (test (a1 1) 1))
+
+(test (let ((f1 (lambda (x) (+ x 1))))
+	(define f1 (lambda (y) (if (zero? y) y (f1 (- y 1)))))
+	(f1 3))
+      0)
+
+(test (let ((x 1)) (cond (else (define x 2))) x) 2)
+(test (let ((x 1)) (and (define x 2)) x) 2)
+(test (let () (begin 1)) 1)
+(test (let () (begin (define x 1) x)) 1)
+(test (let () (let ((lst (define abc 1))) #f) abc) 1)                  ; ??
+(test (let () (let ((lst (define abc 1))) abc)) 1)                     ; abcd is in the outer let
+(test (let () (letrec ((lst (define abcd 1))) #f) abcd) 'error)        ; abcd: unbound variable
+(test (let () (letrec ((lst (define abcd 1))) abcd)) 1)
+(test (let? (let () (letrec ((lst (define abcd 1))) (curlet)))) #t)
+(test (let () (letrec* ((lst (define abcd 1))) abcd)) 1)               ; unproblematic because no pending value
+;(test (let () (define (f a) (if (symbol? a) b 0)) (f (define b 3))) 3) ; 25-Jul-14
+(test (let () (+ (define b 1) (* b 2))) 3)
+(test (let () (if (define b 3) b)) 3)
+(test (let () (do ((i (define b 3)) (j 0 (+ j 1))) ((= j 0) b))) 3)
+(test (let () (define* (f (a (define b 3))) a) (f) b) 'error)          ; ?? where is b?
+(test (let () (define* (f (a (define b 3))) b) (f)) 3)                 ; inside the func apparently! 3 cases? let->outer letrec->cur, func->inner!
+;(test (let () (define* (f (a (define a 3))) a) (f)) 'a)                ; yow -- no duplicate id check! 25-Jul-14
+(test (let () (define* (f (a 1) (b (define a 3))) a) (f 2)) 3)
+(test (let () (define-macro* (f (a 1) (b (define a 3))) a) (f 2)) 2)   ; also bacro -- b is '(define a 3)!
+;(test (let () (letrec ((a (define a 3))) a)) 'a)                       ; letrec is the same (it checks normally) 25-Jul-14
+(test (let () (letrec ((a 1) (b (define a 3))) a)) 1)
+(test (let () (letrec* ((a 1) (b (define a 3))) a)) 3)                 ; same difference in let/let*
+(test (let () (letrec ((a 1) (b (set! a 3))) a)) 1)
+(test (let () (letrec* ((a 1) (b (set! a 3))) a)) 3)                   ; here the let case is an error, let* is 3
+;(test (let () (list (with-let (sublet (curlet) (cons 'b (define b 3))) b) ((curlet) 'b))) '(b 3)) ; 2 b's with 1 define
+;(test (let () (list (with-let (varlet (curlet) (cons 'b (define b 3))) b) ((curlet) 'b))) '(b b))
+
+(test (let () (define (f1 a) (+ a 123)) (define (f2 a) (f1 2 (+ a 1))) (define (f3 a b) (+ a b)) (set! f1 f3) (f2 4)) 7) ; this tricks lint
+
+(let ()
+  (define (f64 arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12 arg13 arg14 arg15 arg16 arg17 arg18 arg19 arg20 arg21 arg22 arg23 arg24 arg25 arg26 arg27 arg28 arg29 arg30 arg31 arg32 arg33 arg34 arg35 arg36 arg37 arg38 arg39 arg40 arg41 arg42 arg43 arg44 arg45 arg46 arg47 arg48 arg49 arg50 arg51 arg52 arg53 arg54 arg55 arg56 arg57 arg58 arg59 arg60 arg61 arg62 arg63 arg64)
+    (+ arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12 arg13 arg14 arg15 arg16 arg17 arg18 arg19 arg20 arg21 arg22 arg23 arg24 arg25 arg26 arg27 arg28 arg29 arg30 arg31 arg32 arg33 arg34 arg35 arg36 arg37 arg38 arg39 arg40 arg41 arg42 arg43 arg44 arg45 arg46 arg47 arg48 arg49 arg50 arg51 arg52 arg53 arg54 arg55 arg56 arg57 arg58 arg59 arg60 arg61 arg62 arg63 arg64))
+  (test (f64 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64)
+	2080))
+
+#|
+(let ((n 12))
+  (let ((nums (do ((lst () (cons i lst))
+		   (i 0 (+ i 1)))
+		  ((> i n) (reverse lst)))))
+    (format #t "(let ((f~D (lambda (~{arg~D~^ ~})~%    (+ ~{arg~D~^ ~}))))~%  (f~D ~{~D~^ ~}))~%" n nums nums n nums)))
+|#
+
+(test (let ((f128 (lambda (arg128 arg127 arg126 arg125 arg124 arg123 arg122 arg121 arg120 arg119 arg118 arg117 arg116 arg115 arg114 arg113 arg112 arg111 arg110 arg109 arg108 arg107 arg106 arg105 arg104 arg103 arg102 arg101 arg100 arg99 arg98 arg97 arg96 arg95 arg94 arg93 arg92 arg91 arg90 arg89 arg88 arg87 arg86 arg85 arg84 arg83 arg82 arg81 arg80 arg79 arg78 arg77 arg76 arg75 arg74 arg73 arg72 arg71 arg70 arg69 arg68 arg67 arg66 arg65 arg64 arg63 arg62 arg61 arg60 arg59 arg58 arg57 arg56 arg55 arg54 arg53 arg52 arg51 arg50 arg49 arg48 arg47 arg46 arg45 arg44 arg43 arg42 arg41 arg40 arg39 arg38 arg37 arg36 arg35 arg34 arg33 arg32 arg31 arg30 arg29 arg28 arg27 arg26 arg25 arg24 arg23 arg22 arg21 arg20 arg19 arg18 arg17 arg16 arg15 arg14 arg13 arg12 arg11 arg10 arg9 arg8 arg7 arg6 arg5 arg4 arg3 arg2 arg1 arg0)
+		    (+ arg128 arg127 arg126 arg125 arg124 arg123 arg122 arg121 arg120 arg119 arg118 arg117 arg116 arg115 arg114 arg113 arg112 arg111 arg110 arg109 arg108 arg107 arg106 arg105 arg104 arg103 arg102 arg101 arg100 arg99 arg98 arg97 arg96 arg95 arg94 arg93 arg92 arg91 arg90 arg89 arg88 arg87 arg86 arg85 arg84 arg83 arg82 arg81 arg80 arg79 arg78 arg77 arg76 arg75 arg74 arg73 arg72 arg71 arg70 arg69 arg68 arg67 arg66 arg65 arg64 arg63 arg62 arg61 arg60 arg59 arg58 arg57 arg56 arg55 arg54 arg53 arg52 arg51 arg50 arg49 arg48 arg47 arg46 arg45 arg44 arg43 arg42 arg41 arg40 arg39 arg38 arg37 arg36 arg35 arg34 arg33 arg32 arg31 arg30 arg29 arg28 arg27 arg26 arg25 arg24 arg23 arg22 arg21 arg20 arg19 arg18 arg17 arg16 arg15 arg14 arg13 arg12 arg11 arg10 arg9 arg8 arg7 arg6 arg5 arg4 arg3 arg2 arg1 arg0))))
+	(f128 128 127 126 125 124 123 122 121 120 119 118 117 116 115 114 113 112 111 110 109 108 107 106 105 104 103 102 101 100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0))
+      8256)
+
+(test (let ((f512 (lambda (arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12 arg13 arg14 arg15 arg16 arg17 arg18 arg19 arg20 arg21 arg22 arg23 arg24 arg25 arg26 arg27 arg28 arg29 arg30 arg31 arg32 arg33 arg34 arg35 arg36 arg37 arg38 arg39 arg40 arg41 arg42 arg43 arg44 arg45 arg46 arg47 arg48 arg49 arg50 arg51 arg52 arg53 arg54 arg55 arg56 arg57 arg58 arg59 arg60 arg61 arg62 arg63 arg64 arg65 arg66 arg67 arg68 arg69 arg70 arg71 arg72 arg73 arg74 arg75 arg76 arg77 arg78 arg79 arg80 arg81 arg82 arg83 arg84 arg85 arg86 arg87 arg88 arg89 arg90 arg91 arg92 arg93 arg94 arg95 arg96 arg97 arg98 arg99 arg100 arg101 arg102 arg103 arg104 arg105 arg106 arg107 arg108 arg109 arg110 arg111 arg112 arg113 arg114 arg115 arg116 arg117 arg118 arg119 arg120 arg121 arg122 arg123 arg124 arg125 arg126 arg127 arg128 arg129 arg130 arg131 arg132 arg133 arg134 arg135 arg136 arg137 arg138 arg139 arg140 arg141 arg142 arg143 arg144 arg145 arg146 arg147 arg148 arg149 arg150 arg151 arg152 arg153 arg154 arg155 arg156 arg157 arg158 arg159 arg160 arg161 arg162 arg163 arg164 arg165 arg166 arg167 arg168 arg169 arg170 arg171 arg172 arg173 arg174 arg175 arg176 arg177 arg178 arg179 arg180 arg181 arg182 arg183 arg184 arg185 arg186 arg187 arg188 arg189 arg190 arg191 arg192 arg193 arg194 arg195 arg196 arg197 arg198 arg199 arg200 arg201 arg202 arg203 arg204 arg205 arg206 arg207 arg208 arg209 arg210 arg211 arg212 arg213 arg214 arg215 arg216 arg217 arg218 arg219 arg220 arg221 arg222 arg223 arg224 arg225 arg226 arg227 arg228 arg229 arg230 arg231 arg232 arg233 arg234 arg235 arg236 arg237 arg238 arg239 arg240 arg241 arg242 arg243 arg244 arg245 arg246 arg247 arg248 arg249 arg250 arg251 arg252 arg253 arg254 arg255 arg256 arg257 arg258 arg259 arg260 arg261 arg262 arg263 arg264 arg265 arg266 arg267 arg268 arg269 arg270 arg271 arg272 arg273 arg274 arg275 arg276 arg277 arg278 arg279 arg280 arg281 arg282 arg283 arg284 arg285 arg286 arg287 arg288 arg289 arg290 arg291 arg292 arg293 arg294 arg295 arg296 arg297 arg298 arg299 arg300 arg301 arg302 arg303 arg304 arg305 arg306 arg307 arg308 arg309 arg310 arg311 arg312 arg313 arg314 arg315 arg316 arg317 arg318 arg319 arg320 arg321 arg322 arg323 arg324 arg325 arg326 arg327 arg328 arg329 arg330 arg331 arg332 arg333 arg334 arg335 arg336 arg337 arg338 arg339 arg340 arg341 arg342 arg343 arg344 arg345 arg346 arg347 arg348 arg349 arg350 arg351 arg352 arg353 arg354 arg355 arg356 arg357 arg358 arg359 arg360 arg361 arg362 arg363 arg364 arg365 arg366 arg367 arg368 arg369 arg370 arg371 arg372 arg373 arg374 arg375 arg376 arg377 arg378 arg379 arg380 arg381 arg382 arg383 arg384 arg385 arg386 arg387 arg388 arg389 arg390 arg391 arg392 arg393 arg394 arg395 arg396 arg397 arg398 arg399 arg400 arg401 arg402 arg403 arg404 arg405 arg406 arg407 arg408 arg409 arg410 arg411 arg412 arg413 arg414 arg415 arg416 arg417 arg418 arg419 arg420 arg421 arg422 arg423 arg424 arg425 arg426 arg427 arg428 arg429 arg430 arg431 arg432 arg433 arg434 arg435 arg436 arg437 arg438 arg439 arg440 arg441 arg442 arg443 arg444 arg445 arg446 arg447 arg448 arg449 arg450 arg451 arg452 arg453 arg454 arg455 arg456 arg457 arg458 arg459 arg460 arg461 arg462 arg463 arg464 arg465 arg466 arg467 arg468 arg469 arg470 arg471 arg472 arg473 arg474 arg475 arg476 arg477 arg478 arg479 arg480 arg481 arg482 arg483 arg484 arg485 arg486 arg487 arg488 arg489 arg490 arg491 arg492 arg493 arg494 arg495 arg496 arg497 arg498 arg499 arg500 arg501 arg502 arg503 arg504 arg505 arg506 arg507 arg508 arg509 arg510 arg511 arg512)
+    (+ arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12 arg13 arg14 arg15 arg16 arg17 arg18 arg19 arg20 arg21 arg22 arg23 arg24 arg25 arg26 arg27 arg28 arg29 arg30 arg31 arg32 arg33 arg34 arg35 arg36 arg37 arg38 arg39 arg40 arg41 arg42 arg43 arg44 arg45 arg46 arg47 arg48 arg49 arg50 arg51 arg52 arg53 arg54 arg55 arg56 arg57 arg58 arg59 arg60 arg61 arg62 arg63 arg64 arg65 arg66 arg67 arg68 arg69 arg70 arg71 arg72 arg73 arg74 arg75 arg76 arg77 arg78 arg79 arg80 arg81 arg82 arg83 arg84 arg85 arg86 arg87 arg88 arg89 arg90 arg91 arg92 arg93 arg94 arg95 arg96 arg97 arg98 arg99 arg100 arg101 arg102 arg103 arg104 arg105 arg106 arg107 arg108 arg109 arg110 arg111 arg112 arg113 arg114 arg115 arg116 arg117 arg118 arg119 arg120 arg121 arg122 arg123 arg124 arg125 arg126 arg127 arg128 arg129 arg130 arg131 arg132 arg133 arg134 arg135 arg136 arg137 arg138 arg139 arg140 arg141 arg142 arg143 arg144 arg145 arg146 arg147 arg148 arg149 arg150 arg151 arg152 arg153 arg154 arg155 arg156 arg157 arg158 arg159 arg160 arg161 arg162 arg163 arg164 arg165 arg166 arg167 arg168 arg169 arg170 arg171 arg172 arg173 arg174 arg175 arg176 arg177 arg178 arg179 arg180 arg181 arg182 arg183 arg184 arg185 arg186 arg187 arg188 arg189 arg190 arg191 arg192 arg193 arg194 arg195 arg196 arg197 arg198 arg199 arg200 arg201 arg202 arg203 arg204 arg205 arg206 arg207 arg208 arg209 arg210 arg211 arg212 arg213 arg214 arg215 arg216 arg217 arg218 arg219 arg220 arg221 arg222 arg223 arg224 arg225 arg226 arg227 arg228 arg229 arg230 arg231 arg232 arg233 arg234 arg235 arg236 arg237 arg238 arg239 arg240 arg241 arg242 arg243 arg244 arg245 arg246 arg247 arg248 arg249 arg250 arg251 arg252 arg253 arg254 arg255 arg256 arg257 arg258 arg259 arg260 arg261 arg262 arg263 arg264 arg265 arg266 arg267 arg268 arg269 arg270 arg271 arg272 arg273 arg274 arg275 arg276 arg277 arg278 arg279 arg280 arg281 arg282 arg283 arg284 arg285 arg286 arg287 arg288 arg289 arg290 arg291 arg292 arg293 arg294 arg295 arg296 arg297 arg298 arg299 arg300 arg301 arg302 arg303 arg304 arg305 arg306 arg307 arg308 arg309 arg310 arg311 arg312 arg313 arg314 arg315 arg316 arg317 arg318 arg319 arg320 arg321 arg322 arg323 arg324 arg325 arg326 arg327 arg328 arg329 arg330 arg331 arg332 arg333 arg334 arg335 arg336 arg337 arg338 arg339 arg340 arg341 arg342 arg343 arg344 arg345 arg346 arg347 arg348 arg349 arg350 arg351 arg352 arg353 arg354 arg355 arg356 arg357 arg358 arg359 arg360 arg361 arg362 arg363 arg364 arg365 arg366 arg367 arg368 arg369 arg370 arg371 arg372 arg373 arg374 arg375 arg376 arg377 arg378 arg379 arg380 arg381 arg382 arg383 arg384 arg385 arg386 arg387 arg388 arg389 arg390 arg391 arg392 arg393 arg394 arg395 arg396 arg397 arg398 arg399 arg400 arg401 arg402 arg403 arg404 arg405 arg406 arg407 arg408 arg409 arg410 arg411 arg412 arg413 arg414 arg415 arg416 arg417 arg418 arg419 arg420 arg421 arg422 arg423 arg424 arg425 arg426 arg427 arg428 arg429 arg430 arg431 arg432 arg433 arg434 arg435 arg436 arg437 arg438 arg439 arg440 arg441 arg442 arg443 arg444 arg445 arg446 arg447 arg448 arg449 arg450 arg451 arg452 arg453 arg454 arg455 arg456 arg457 arg458 arg459 arg460 arg461 arg462 arg463 arg464 arg465 arg466 arg467 arg468 arg469 arg470 arg471 arg472 arg473 arg474 arg475 arg476 arg477 arg478 arg479 arg480 arg481 arg482 arg483 arg484 arg485 arg486 arg487 arg488 arg489 arg490 arg491 arg492 arg493 arg494 arg495 arg496 arg497 arg498 arg499 arg500 arg501 arg502 arg503 arg504 arg505 arg506 arg507 arg508 arg509 arg510 arg511 arg512))))
+  (f512 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512))
+      131328)
+
+
+(let ((x 32))
+  (define (f1) x)
+  (define x 33)
+  (test (f1) 33))
+
+(let ()
+  (define (c-2)
+    (let ((v (vector 1 2 3)))
+      (define (c-1 a b) (+ (vector-ref a 0) (* b 32)))
+      (let ((c (c-1 v 1)))
+	(test c 33)
+	(set! c-1 vector-ref))
+      (let ((d (c-1 v 1)))
+	(test d 2))))
+  (c-2))
+
+(let ()
+  (define (c-2)
+    (let ((v (vector 1 2 3)))
+      (let ()
+	(define (c-1 a b) (+ (vector-ref a 0) (* b 32)))
+	(let ((c (c-1 v 1)))
+	  (set! c-1 vector-ref)))
+      (test (c-1 v 1) 'error)))
+  (c-2))
+(let ()
+  (define (f4 a b c d e) (list a b c d e))
+  (test (f4 1 2 3 4 5) '(1 2 3 4 5)))
+
+(let-temporarily (((*s7* 'safety) 1))
+  (define (redef-1 a) (+ a 1))
+  (define (use-redef-1 b) (+ (redef-1 b) 2))     ; [use-redef](+ [redef-1](+ b 1) 2)
+  (test (use-redef-1 3) 6)                       ; b=6
+  (define (redef-1 a) (+ a 4))
+  (test (use-redef-1 3) 9)                       ; [use-redef-1](+ [redef-1](+ a 4) 2), a=3
+  (let ()
+    (define (use-redef-2 c) (+ (redef-1 c) 5))   ; [use-redef-2](+ [redef-1](+ a 4) 5)
+    (test (use-redef-2 6) 15)                    ; a=6
+    (define (redef-1 a) (+ a 7))                 ; so use-redef-1 is still [use-redef-1](+ [redef-1](+ a 4) 2)
+    (test (use-redef-1 8) 14)                    ; a=8 -> 14
+    (test (use-redef-2 8) 20)))                  ; but use-redef-2 (same let as shadowing use-redef-1) is (+ [new redef-1](+ a 7) 5), a=8 -> 20
+
+(let ()
+  (define (redef-3 a) (+ a 1))
+  (test (redef-3 2) 3)
+  (define (redef-3 a) (abs a))
+  (test (redef-3 -2) 2))
+
+(test (let () (define (f1 x) (abs x)) (define (f2 x) (f1 x)) (f2 -1)) 1) ; just trying to hit a portion of the s7 code
+
+(when with-block
+  (let ()
+    (define (f1) ((lambda (x) (cf11 x)) 3)) (f1)
+    (define (f2) ((lambda () (cf21 3 4)))) (f2)
+    (define (f3) ((lambda () (cf11 3)))) (f3)
+    (define (f4) ((lambda (x) (cf11 'x)) 4)) (f4)
+
+    (define (f5) ((lambda (x) (cf21 x 4)) 3)) (f5)
+    (define (f6) ((lambda (x) (cf21 3 x)) 4)) (f6)
+    (define (f7) ((lambda (x) (cf21 3 4)) 4)) (f7)
+    (define (f8) ((lambda (x y) (cf21 x y)) 3 4)) (f8)
+
+    (define (f9) ((lambda (x) (cf21 x 'y)) 'x)) (f9)
+    (define (f10) ((lambda (x) (cf21 'y x)) 'x)) (f10)
+    (define (f11) ((lambda (x) (cf21 'y 'x)) 'x)) (f11)
+    (define (f12) ((lambda (x) (cf21 1 'x)) 'x)) (f12)
+    (define (f13) ((lambda (x) (cf21 'x 1)) 'x)) (f13)
+
+    (define (f14) ((lambda (x y z) (cf31 x y z)) 1 2 3)) (f14)
+    (define (f15) ((lambda (x y z) (cf31 x 2 z)) 1 2 3)) (f15)
+    (define (f16) ((lambda (x y z) (cf31 x y 2)) 1 2 3)) (f16)
+    (define (f17) ((lambda (x y z) (cf31 2 y z)) 1 2 3)) (f17)
+
+    (define (f18) ((lambda (w x y z) (cf41 w x y z)) 1 2 3 4)) (f18)
+    (define (f19) ((lambda (x y z) (cf31 x 'y z)) 1 2 3)) (f19)
+    (define (f20) ((lambda (x y z) (cf41 'q x y z)) 1 2 3)) (f20)
+    (define (f21) ((lambda (x y) (cf31 x y (+ x 6))) 1 2)) (f21)
+    (define (f22) ((lambda (x y) (cf31 1 y (+ x 6))) 1 2)) (f22)
+    (define (f23) ((lambda (x y) (cf31 x 1 (+ x 6))) 1 2)) (f23)
+    (define (f24) ((lambda (x y) (cf31 1 (+ x 6) y)) 1 2)) (f24)
+    (define (f25) ((lambda (x) (cf11 (cf11 'x))) 1)) (f25)
+
+    (define (f26) ((lambda (w x y z) (cf51 'q w x y z)) 1 2 3 4)) (f26)
+    (define (f27) ((lambda (w x y) (cf21 (cf21 (cf11 w) (cf11 x)) (cf11 y))) 1 2 3)) (f27)
+    (define (f28) ((lambda (w x y) (cf31 (cf21 w x) 2 y)) 1 2 3)) (f28)
+
+    (define (f29) ((lambda () (cf11 (cf11 0))))) (f29)
+    (define (f30) ((lambda (x) (cf11 (cf11 x))) 0)) (f30)
+    (define (f31) ((lambda (x) (cf11 (cf10 x))) 0)) (f31)
+    (define (f32) ((lambda (x) (cf11 (cf10 'x))) 1)) (f32)
+    (define (f33) ((lambda (w x y) (cf31 (cf20 w x) 2 y)) 1 2 3)) (f33)
+    (define (f34) ((lambda (w x y) (cf22 (cf21 (cf11 w) (cf11 x)) (cf10 y))) 1 2 3)) (f34)
+    (define (f35) ((lambda (w x y) (cf21 (cf20 (cf11 w) (cf11 x)) (cf11 y))) 1 2 3)) (f35)
+    (define (f36) ((lambda (w x y) (cf21 (cf21 (cf10 w) (cf11 x)) (cf11 y))) 1 2 3)) (f36)
+
+    (define (f37) ((lambda (x y) (cf33 x y (cf20 x 6))) 1 2)) (f37)
+    (define (f38) ((lambda (x y) (cf33 1 y (cf20 x 6))) 1 2)) (f38)
+    (define (f39) ((lambda (x y) (cf33 x 1 (cf20 x 6))) 1 2)) (f39)
+    (define (f40) ((lambda (x y) (cf32 1 (cf20 x 6) y)) 1 2)) (f40)
+
+    (define (f41) ((lambda (x y) (cf11 (cf21 x y))) 1 2)) (f41)
+    (define (f42) ((lambda (x y) (cf11 (cf21 x 2))) 1 2)) (f42)
+    (define (f43) ((lambda (x y) (cf11 (cf21 1 x))) 1 2)) (f43)
+    (define (f44) ((lambda (x y) (cf21 x (cf11 y))) 1 2)) (f44)
+    (define (f45) ((lambda (x y) (cf21 (cf11 x) y)) 1 2)) (f45)
+    (define (f46) ((lambda (x y) (cf21 (cf11 x) 2)) 1 2)) (f46)
+    (define (f47) ((lambda (x y) (cf21 (cf11 x) (cf11 y))) 1 2)) (f47)
+
+    (define (f48) ((lambda (x y) (cf11 (cf20 x y))) 1 2)) (f48)
+    (define (f49) ((lambda (x y) (cf11 (cf20 x 2))) 1 2)) (f49)
+    (define (f50) ((lambda (x y) (cf11 (cf20 1 x))) 1 2)) (f50)
+    (define (f51) ((lambda (x y) (cf22 x (cf10 y))) 1 2)) (f51)
+    (define (f52) ((lambda (x y) (cf21 (cf10 x) y)) 1 2)) (f52)
+    (define (f53) ((lambda (x y) (cf21 (cf10 x) 2)) 1 2)) (f53)
+    (define (f54) ((lambda (x y) (cf21 (cf10 x) (cf11 y))) 1 2)) (f54)
+    (define (f55) ((lambda (x y) (cf22 (cf11 x) (cf10 y))) 1 2)) (f55)
+
+    (define (f56) ((lambda (x y) (cf21 1 (cf11 y))) 1 2)) (f56)
+    (define (f57) ((lambda (x y) (cf22 1 (cf10 y))) 1 2)) (f57)
+    (define (f58) ((lambda (x y z) (cf21 x (cf21 y z))) 1 2 3)) (f58)
+    (define (f59) ((lambda (x y z) (cf22 x (cf20 y z))) 1 2 3)) (f59)
+    (define (f60) ((lambda (x y z) (cf21 x (cf21 2 z))) 1 2 3)) (f60)
+    (define (f61) ((lambda (x y z) (cf22 x (cf20 2 z))) 1 2 3)) (f61)
+    (define (f62) ((lambda (x y z) (cf21 x (cf21 y 3))) 1 2 3)) (f62)
+    (define (f63) ((lambda (x y z) (cf22 x (cf20 y 3))) 1 2 3)) (f63)
+    (define (f64) ((lambda (x y z) (cf21 1 (cf21 2 z))) 1 2 3)) (f64)
+    (define (f65) ((lambda (x y z) (cf22 1 (cf20 2 z))) 1 2 3)) (f65)
+    (define (f66) ((lambda (x y z) (cf21 1 (cf21 y 3))) 1 2 3)) (f66)
+    (define (f67) ((lambda (x y z) (cf22 1 (cf20 y 3))) 1 2 3)) (f67)
+
+    (define (f68) ((lambda (x) (cf21 (cf21 2 x) 3)) 1)) (f68)
+    (define (f69) ((lambda (x) (cf21 (cf20 2 x) 3)) 1)) (f69)
+    (define (f70) ((lambda (x y) (cf21 1 (cf21 x y))) 2 3)) (f70)
+    (define (f71) ((lambda (x y) (cf22 1 (cf20 x y))) 2 3)) (f71)
+    (define (f72) ((lambda (x y) (cf21 (cf21 x y) 3)) 1 2)) (f72)
+    (define (f73) ((lambda (x y) (cf21 (cf20 x y) 3)) 1 2)) (f73)
+
+    (define (f74) ((lambda (x) (cf11 (cf21 x 'y))) 1)) (f74)
+    (define (f75) ((lambda (x) (cf11 (cf20 x 'y))) 1)) (f75)
+    (define (f76) ((lambda (x) (cf21 x (cf11 2))) 1)) (f76)
+    (define (f77) ((lambda (x) (cf22 x (cf10 2))) 1)) (f77)
+    (define (f78) ((lambda (x) (cf21 1 (cf11 2))) 1)) (f78)
+    (define (f79) ((lambda (x) (cf22 1 (cf10 2))) 1)) (f79)
+    (define (f80) ((lambda (x) (cf21 (cf11 1) x)) 2)) (f80)
+    (define (f81) ((lambda (x) (cf21 (cf10 1) x)) 2)) (f81)
+    (define (f82) ((lambda (x y z) (cf21 (cf21 x y) z)) 1 2 3)) (f82)
+    (define (f83) ((lambda (x y z) (cf21 (cf20 x y) z)) 1 2 3)) (f83)
+    (define (f84) ((lambda (x y z) (cf21 (cf21 x 2) z)) 1 2 3)) (f84)
+    (define (f85) ((lambda (x y z) (cf21 (cf20 x 2) z)) 1 2 3)) (f85)
+    (define (f86) ((lambda (x y z) (cf21 (cf21 1 y) z)) 1 2 3)) (f86)
+    (define (f87) ((lambda (x y z) (cf21 (cf20 1 y) z)) 1 2 3)) (f87)
+    (define (f88) ((lambda (x y z) (cf21 (cf21 x 2) 3)) 1 2 3)) (f88)
+    (define (f89) ((lambda (x y z) (cf21 (cf20 x 2) 3)) 1 2 3)) (f89)
+    (define (f90) ((lambda (x) (cf21 (cf11 1) 2)) 2)) (f90)
+    (define (f91) ((lambda (x) (cf21 (cf10 1) 2)) 2)) (f91)
+
+    (define (f92) ((lambda (w x y z) (cf21 (cf21 w x) (cf21 y z))) 1 2 3 4)) (f92)
+    (define (f93) ((lambda (w x y z) (cf22 (cf21 w x) (cf20 y z))) 1 2 3 4)) (f93)
+    (define (f94) ((lambda (w x y z) (cf21 (cf20 w x) (cf21 y z))) 1 2 3 4)) (f94)
+    (define (f95) ((lambda (w x y z) (cf21 (cf21 w 2) (cf21 y 4))) 1 2 3 4)) (f95)
+    (define (f96) ((lambda (w x y z) (cf22 (cf21 w 2) (cf20 y 4))) 1 2 3 4)) (f96)
+    (define (f97) ((lambda (w x y z) (cf21 (cf20 w 2) (cf21 y 4))) 1 2 3 4)) (f97)
+    (define (f98) ((lambda (x y z) (cf21 (cf11 x) (cf21 y z))) 1 2 3)) (f98)
+    (define (f99) ((lambda (x y z) (cf22 (cf11 x) (cf20 y z))) 1 2 3)) (f99)
+    (define (f100) ((lambda (x y z) (cf21 (cf10 x) (cf21 y z))) 1 2 3)) (f100)
+    (define (f101) ((lambda (x y z) (cf21 (cf21 x y) (cf11 z))) 1 2 3)) (f101)
+    (define (f102) ((lambda (x y z) (cf22 (cf21 x y) (cf10 z))) 1 2 3)) (f102)
+    (define (f103) ((lambda (x y z) (cf21 (cf20 x y) (cf11 z))) 1 2 3)) (f103)
+    (define (f104) ((lambda (x y z) (cf21 (cf21 x y) (cf11 3))) 1 2 3)) (f104)
+    (define (f105) ((lambda (x y z) (cf22 (cf21 x y) (cf10 3))) 1 2 3)) (f105)
+    (define (f106) ((lambda (x y z) (cf21 (cf20 x y) (cf11 3))) 1 2 3)) (f106)
+    (define (f107) ((lambda (x y z) (cf21 (cf11 1) (cf21 y z))) 1 2 3)) (f107)
+    (define (f108) ((lambda (x y z) (cf22 (cf11 1) (cf20 y z))) 1 2 3)) (f108)
+    (define (f109) ((lambda (x y z) (cf21 (cf10 1) (cf21 y z))) 1 2 3)) (f109)
+    (define (f110) ((lambda () (cf21 (cf11 1) (cf11 2))))) (f110)
+    (define (f111) ((lambda () (cf22 (cf11 1) (cf10 2))))) (f111)
+    (define (f112) ((lambda () (cf21 (cf10 1) (cf11 2))))) (f112)
+
+    (define (f113) ((lambda (x) (cf11 (cf11 (cf11 x)))) 1)) (f113)
+    (define (f114) ((lambda (x) (cf11 (cf11 (cf10 x)))) 1)) (f114)
+    (define (f115) ((lambda (x) (cf11 (cf10 (cf11 x)))) 1)) (f115)
+    (define (f116) ((lambda (w x y z) (cf22 w (cf21 (cf21 x y) z))) 1 2 3 4)) (f116)
+    (define (f117) ((lambda (w x y z) (cf22 w (cf20 (cf21 x y) z))) 1 2 3 4)) (f117)
+    (define (f118) ((lambda (w x y z) (cf22 w (cf21 (cf20 x y) z))) 1 2 3 4)) (f118)
+
+    (define (f119) ((lambda (w x y z) (cf22 w (cf22 x (cf21 y z)))) 1 2 3 4)) (f119)
+    (define (f120) ((lambda (w x y z) (cf22 w (cf20 x (cf21 y z)))) 1 2 3 4)) (f120)
+    (define (f121) ((lambda (w x y z) (cf22 w (cf22 x (cf20 y z)))) 1 2 3 4)) (f121)
+
+    (define (f122) ((lambda (x y) (cf11 (cf32 1 (cf21 x y) 4))) 2 3)) (f122) ; c_z
+    (define (f123) ((lambda (x y) (cf11 (cf32 1 (cf20 x y) 4))) 2 3)) (f123)
+    (define (f124) ((lambda (x y) (cf11 (cf30 1 (cf21 x y) 4))) 2 3)) (f124)
+
+    (define (f125) ((lambda (x y) (cf21 (cf11 (cf21 x y)) 3)) 1 2)) (f125)
+    (define (f126) ((lambda (x y) (cf21 (cf10 (cf21 x y)) 3)) 1 2)) (f126)
+    (define (f127) ((lambda (x y) (cf21 (cf11 (cf20 x y)) 3)) 1 2)) (f127)
+
+    (define (f128) ((lambda (x) (cf22 1 (cf21 x (cf11 3)))) 2)) (f128)
+    (define (f129) ((lambda (x) (cf22 1 (cf20 x (cf11 3)))) 2)) (f129)
+    (define (f130) ((lambda (x) (cf22 1 (cf22 x (cf10 3)))) 2)) (f130)
+
+    (define (f131) ((lambda (x y z) (cf22 x (cf21 (cf21 y z) (cf21 z y)))) 1 2 3)) (f131)
+    (define (f132) ((lambda (x y z) (cf22 x (cf20 (cf21 y z) (cf21 z y)))) 1 2 3)) (f132)
+    (define (f133) ((lambda (x y z) (cf22 x (cf21 (cf20 y z) (cf21 z y)))) 1 2 3)) (f133)
+    (define (f134) ((lambda (x y z) (cf22 x (cf22 (cf21 y z) (cf20 z y)))) 1 2 3)) (f134)
+
+    (define (f135) ((lambda (x y z) (cf21 (cf21 x y) (cf11 (cf21 y z)))) 1 2 3)) (f135)
+    (define (f136) ((lambda (x y z) (cf21 (cf20 x y) (cf11 (cf21 y z)))) 1 2 3)) (f136)
+    (define (f137) ((lambda (x y z) (cf22 (cf21 x y) (cf10 (cf21 y z)))) 1 2 3)) (f137)
+    (define (f138) ((lambda (x y z) (cf22 (cf21 x y) (cf11 (cf20 y z)))) 1 2 3)) (f138)
+
+    (define (f139) ((lambda (x y z) (cf21 (cf21 (cf21 x y) z) (cf21 y z))) 1 2 3)) (f139)
+    (define (f140) ((lambda (x y z) (cf21 (cf20 (cf21 x y) z) (cf21 y z))) 1 2 3)) (f140)
+    (define (f141) ((lambda (x y z) (cf21 (cf21 (cf20 x y) z) (cf21 y z))) 1 2 3)) (f141)
+    (define (f142) ((lambda (x y z) (cf22 (cf21 (cf21 x y) z) (cf20 y z))) 1 2 3)) (f142)
+
+    (define (f143) ((lambda (x y z) (cf22 x (cf21 (cf11 (cf21 x y)) (cf11 (cf21 y z))))) 1 2 3)) (f143)
+    (define (f144) ((lambda (x y z) (cf22 x (cf20 (cf11 (cf21 x y)) (cf11 (cf21 y z))))) 1 2 3)) (f144)
+    (define (f145) ((lambda (x y z) (cf22 x (cf21 (cf10 (cf21 x y)) (cf11 (cf21 y z))))) 1 2 3)) (f145)
+    (define (f146) ((lambda (x y z) (cf22 x (cf21 (cf11 (cf20 x y)) (cf11 (cf21 y z))))) 1 2 3)) (f146)
+    (define (f147) ((lambda (x y z) (cf22 x (cf22 (cf11 (cf21 x y)) (cf10 (cf21 y z))))) 1 2 3)) (f147)
+    (define (f148) ((lambda (x y z) (cf22 x (cf22 (cf11 (cf21 x y)) (cf11 (cf20 y z))))) 1 2 3)) (f148)
+
+    (define (f149) ((lambda (x y z) (cf22 x (cf31 (cf11 y) (cf11 z) (cf11 z)))) 1 2 3)) (f149)
+    (define (f150) ((lambda (x y z) (cf22 x (cf30 (cf11 y) (cf11 z) (cf11 z)))) 1 2 3)) (f150)
+    (define (f151) ((lambda (x y z) (cf22 x (cf31 (cf10 y) (cf11 z) (cf11 z)))) 1 2 3)) (f151)
+    (define (f152) ((lambda (x y z) (cf22 x (cf32 (cf11 y) (cf10 z) (cf11 z)))) 1 2 3)) (f152)
+    (define (f153) ((lambda (x y z) (cf22 x (cf33 (cf11 y) (cf11 z) (cf10 z)))) 1 2 3)) (f153)
+
+    (define (f154) ((lambda (x y z) (cf21 (cf32 1 (cf21 x y) 4) (cf32 1 (cf21 y z) 4))) 1 2 3)) (f154)
+    (define (f155) ((lambda (x y z) (cf21 (cf32 1 (cf20 x y) 4) (cf32 1 (cf21 y z) 4))) 1 2 3)) (f155)
+    (define (f156) ((lambda (x y z) (cf22 (cf32 1 (cf21 x y) 4) (cf30 1 (cf21 y z) 4))) 1 2 3)) (f156)
+
+    (define (f157) ((lambda (x y z) (cf22 x (cf32 1 (cf21 y z) 4))) 1 2 3)) (f157)
+    (define (f158) ((lambda (x y z) (cf22 x (cf32 1 (cf20 y z) 4))) 1 2 3)) (f158)
+
+    (define (f159) ((lambda (x y z) (cf21 (cf32 1 (cf21 y z) 4) x)) 1 2 3)) (f159)
+    (define (f160) ((lambda (x y z) (cf21 (cf30 1 (cf20 y z) 4) x)) 1 2 3)) (f160)
+
+    (define (f161) ((lambda (x y z) (cf22 1 (cf32 1 (cf21 y z) 4))) 1 2 3)) (f161)
+    (define (f162) ((lambda (x y z) (cf22 1 (cf32 1 (cf20 y z) 4))) 1 2 3)) (f162)
+
+    (define (f163) ((lambda (x y z) (cf21 (cf32 1 (cf21 y z) 4) x)) 1 2 3)) (f163)
+    (define (f164) ((lambda (x y z) (cf21 (cf30 1 (cf20 y z) 4) x)) 1 2 3)) (f164)
+
+    ;; --------
+    (test (f1) 3) (test (f2) 3) (test (f3) 3) (test (f4) 'x) (test (f5) 3) (test (f6) 3) (test (f7) 3)
+    (test (f8) 3) (test (f9) 'x) (test (f10) 'y) (test (f11) 'y) (test (f12) 1) (test (f13) 'x) (test (f14) 1)
+    (test (f15) 1) (test (f16) 1) (test (f17) 2) (test (f18) 1) (test (f19) 1) (test (f20) 'q) (test (f21) 1)
+    (test (f22) 1) (test (f23) 1) (test (f24) 1) (test (f25) 'x) (test (f26) 'q) (test (f27) 1) (test (f28) 1)
+    (test (f29) 0) (test (f30) 0) (test (f31) 0) (test (f32) 'x) (test (f33) 1) (test (f34) 3) (test (f35) 1)
+    (test (f36) 1) (test (f37) 1) (test (f38) 1) (test (f39) 1) (test (f40) 1) (test (f41) 1) (test (f42) 1)
+    (test (f43) 1) (test (f44) 1) (test (f45) 1) (test (f46) 1) (test (f47) 1) (test (f48) 1) (test (f49) 1)
+    (test (f50) 1) (test (f51) 2) (test (f52) 1) (test (f53) 1) (test (f54) 1) (test (f55) 2) (test (f56) 1)
+    (test (f57) 2) (test (f58) 1) (test (f59) 2) (test (f60) 1) (test (f61) 2) (test (f62) 1) (test (f63) 2)
+    (test (f64) 1) (test (f65) 2) (test (f66) 1) (test (f67) 2) (test (f68) 2) (test (f69) 2) (test (f70) 1)
+    (test (f71) 2) (test (f72) 1) (test (f73) 1) (test (f74) 1) (test (f75) 1) (test (f76) 1) (test (f77) 2)
+    (test (f78) 1) (test (f79) 2) (test (f80) 1) (test (f81) 1) (test (f82) 1) (test (f83) 1) (test (f84) 1)
+    (test (f85) 1) (test (f86) 1) (test (f87) 1) (test (f88) 1) (test (f89) 1) (test (f90) 1) (test (f91) 1)
+    (test (f92) 1) (test (f93) 3) (test (f94) 1) (test (f95) 1) (test (f96) 3) (test (f97) 1) (test (f98) 1)
+    (test (f99) 2) (test (f100) 1) (test (f101) 1) (test (f102) 3) (test (f103) 1) (test (f104) 1) (test (f105) 3)
+    (test (f106) 1) (test (f107) 1) (test (f108) 2) (test (f109) 1) (test (f110) 1) (test (f111) 2) (test (f112) 1)
+    (test (f113) 1) (test (f114) 1) (test (f115) 1) (test (f116) 2) (test (f117) 2) (test (f118) 2)
+    (test (f119) 3) (test (f120) 2) (test (f121) 3) (test (f122) 2) (test (f123) 2) (test (f124) 1)
+    (test (f125) 1) (test (f126) 1) (test (f127) 1) (test (f128) 2) (test (f129) 2) (test (f130) 3)
+    (test (f131) 2) (test (f132) 2) (test (f133) 2) (test (f134) 3)
+    (test (f135) 1) (test (f136) 1) (test (f137) 2) (test (f138) 2)
+    (test (f139) 1) (test (f140) 1) (test (f141) 1) (test (f142) 2)
+    (test (f143) 1) (test (f144) 1) (test (f145) 1) (test (f146) 1) (test (f147) 2) (test (f148) 2)
+    (test (f149) 2) (test (f150) 2) (test (f151) 2) (test (f152) 3) (test (f153) 3)
+    (test (f154) 1) (test (f155) 1) (test (f156) 1) (test (f157) 2) (test (f158) 2) (test (f159) 2) (test (f160) 1)
+    (test (f161) 2) (test (f162) 2) (test (f163) 2) (test (f164) 1)
+    ))
+
+(when with-block
+  (let ()
+    (define (thunk1) 3)
+    (define (thunk2) 4)
+    (define (f1) ((lambda (x) (thunk1)) 0)) (f1)
+    (test (f1) 3)
+    (define thunk1 thunk2)
+    (test (f1) 4)
+
+    (define (thunk3) (*s7* 'max-stack-size) 5)
+    (define (thunk4) (*s7* 'max-stack-size) 6)
+    (define (f2) ((lambda (x) (thunk3)) 0)) (f2)
+    (test (f2) 5)
+    (define thunk3 thunk4)
+    (test (f2) 6)
+
+    (define (close1 x) (*s7* 'max-stack-size) (+ x 1))
+    (define (close2 x) (*s7* 'max-stack-size) (+ x 2))
+    (define (qclose1 x) (*s7* 'max-stack-size) (eq? x 'q))
+    (define (qclose2 x) (*s7* 'max-stack-size) (eq? x 'r))
+    (define (sclose1 x) (+ x 1))
+    (define (sclose2 x) (+ x 2))
+    (define (qsclose1 x) (eq? x 'q))
+    (define (qsclose2 x) (eq? x 'r))
+    (define* (s*close1 (x 1)) (+ x 1))
+    (define* (s*close2 (x 1)) (+ x 2))
+    (define* (u*close1 (x 1)) (*s7* 'max-stack-size) (+ x 1))
+    (define* (u*close2 (x 1)) (*s7* 'max-stack-size) (+ x 2))
+
+    (define (close3 x y) (*s7* 'max-stack-size) (+ x y))
+    (define (close4 x y) (*s7* 'max-stack-size) (+ x y 1))
+    (define (sclose3 x y) (+ x y))
+    (define (sclose4 x y) (+ x y 1))
+    (define* (s*close3 (x 1) (y 0.0)) (+ x y))
+    (define* (s*close4 (x 1) (y 0.0)) (+ x y 1))
+    (define* (u*close3 (x 1) (y 0)) (*s7* 'max-stack-size) (+ x y))
+    (define* (u*close4 (x 1) (y 0)) (*s7* 'max-stack-size) (+ x y 1))
+
+    (define (f3) (close1 1)) (f3)
+    (define (f4) (sclose1 1)) (f4)
+    (define (f5 x) (close1 x)) (f5 0)
+    (define (f6 x) (sclose1 x)) (f6 0)
+    (define (f7 x) (close1 ((lambda () (cs11 x))))) (f7 0)
+    (define (f8 x) (sclose1 ((lambda () (cs11 x))))) (f8 0)
+    (define (f9 x) (close1 ((lambda () (cs11 1))))) (f9 0)
+    (define (f10 x) (sclose1 ((lambda () (cs11 1))))) (f10 0)
+    (define (f11 x) (s*close1 x)) (f11 0)
+    (define (f12 x) (s*close1)) (f12 0)
+    (define (f13 x) (u*close1 x)) (f13 0)
+    (define (f14 x) (u*close1)) (f14 0)
+    (define (f15) (qclose1 'q)) (f15)
+    (define (f16) (qsclose1 'q)) (f16)
+    (define (f17 x) (close1 (cdr x))) (f17 '(0 . 0))
+    (define (f18) (close3 1 2)) (f18)
+    (define (f19) (sclose3 1 2)) (f19)
+    (define (f20) (s*close3 1 2)) (f20)
+    (define (f21) (u*close3 1 2)) (f21)
+    (define (f22 x) (close3 x 2)) (f22 0)
+    (define (f23 x) (sclose3 x 2)) (f23 0)
+    (define (f24 x) (s*close3 x 2)) (f24 0)
+    (define (f25 x) (u*close3 x 2)) (f25 0)
+    (define (f26 x) (close3 1 x)) (f26 0)
+    (define (f27 x) (sclose3 1 x)) (f27 0)
+    (define (f28 x) (s*close3 1 x)) (f28 0)
+    (define (f29 x) (u*close3 1 x)) (f29 0)
+    (define (f30 x y) (close3 x y)) (f30 0 0)
+    (define (f31 x y) (sclose3 x y)) (f31 0 0)
+    (define (f32 x y) (s*close3 x y)) (f32 0 0)
+    (define (f33 x y) (u*close3 x y)) (f33 0 0)
+
+    (test (f3) 2) (test (f4) 2) (test (f5 1) 2) (test (f6 1) 2) (test (f7 1) 2) (test (f8 1) 2) (test (f9 1) 2)
+    (test (f10 1) 2) (test (f11 1) 2) (test (f12 1) 2) (test (f13 1) 2) (test (f14 1) 2) (test (f15) #t)
+    (test (f16) #t) (test (f17 '(1 . 1)) 2) (test (f18) 3) (test (f19) 3) (test (f20) 3) (test (f21) 3)
+    (test (f22 1) 3) (test (f23 1) 3) (test (f24 1) 3) (test (f25 1) 3) (test (f26 2) 3) (test (f27 2) 3)
+    (test (f28 2) 3)
+    (test (f29 2) 3)
+    (test (f30 1 2) 3)
+    (test (f31 1 2) 3)
+    (test (f32 1 2) 3)
+    (test (f33 1 2) 3)
+
+    (define cs11 rs11)
+    ;;;(test (f7 1) 3) (test (f8 1) 3) (test (f9 1) 3) (test (f10 1) 3)
+
+    (define close1 close2)
+    (define close3 close4)
+    (define qclose1 qclose2)
+    (define sclose1 sclose2)
+    (define sclose3 sclose4)
+    (define qsclose1 qsclose2)
+    (define s*close1 s*close2)
+    (define s*close3 s*close4)
+    (define u*close1 u*close2)
+    (define u*close3 u*close4)
+
+    (define (f31 x y) (sclose3 x y))
+
+    (test (f3) 3) (test (f4) 3) (test (f5 1) 3) (test (f6 1) 3)
+    ;;; (test (f7 -1) 2) (test (f8 -1) 2) (test (f9 -1) 4) (test (f10 -1) 4)
+    (test (f11 1) 3) (test (f12 1) 3) (test (f13 1) 3) (test (f14 1) 3) (test (f15) #f)
+    (test (f16) #f) (test (f17 '(1 . 1)) 3) (test (f18) 4) (test (f19) 4) (test (f20) 4) (test (f21) 4)
+    (test (f22 1) 4) (test (f23 1) 4) (test (f24 1) 4) (test (f25 1) 4) (test (f26 2) 4) (test (f27 2) 4)
+    (test (f28 2) 4) (test (f29 2) 4) (test (f30 1 2) 4) (test (f31 1 2) 4)
+    (test (f32 1 2) 4) (test (f33 1 2) 4)
+    ))
+
+;;; global name opts (or lack thereof)
+;;; the funny names used here must be nonce words
+
+;;; op_unknown (thunk):
+(define *x1* #f) (define (test*x1*) (*x1*)) (define (set*x1* n) (set! *x1* (lambda () n))) (set*x1* 1) (test (test*x1*) 1) (set*x1* 2) (test (test*x1*) 2)
+(define *x2* #f) (define (test*x2*) (*x2*)) (define (set*x2* n) (set! *x2* (define* (_) n))) (set*x2* 1) (test (test*x2*) 1) (set*x2* 2) (test (test*x2*) 2)
+
+;;; op_unknown_q:
+(define *x3* #f) (define (test*x3*) (*x3* 'a)) (define (set*x3* n) (set! *x3* (lambda (x) n))) (set*x3* 1) (test (test*x3*) 1) (set*x3* 2) (test (test*x3*) 2)
+
+;;; op_unknown_s:
+(define *x4* #f) (define (test*x4* a) (*x4* a)) (define (set*x4* n) (set! *x4* (lambda (x) n))) (set*x4* 1) (test (test*x4* 0) 1) (set*x4* 2) (test (test*x4* 0) 2)
+(define *x5* #f) (define (test*x5* a) (*x5* a)) (define (set*x5* n) (set! *x5* (define* (_ __) n))) (set*x5* 1) (test (test*x5* 0) 1) (set*x5* 2) (test (test*x5* 0) 2)
+
+;;; op_unknown_c:
+(define *x6* #f) (define (test*x6*) (*x6* 0)) (define (set*x6* n) (set! *x6* (lambda (x) n))) (set*x6* 1) (test (test*x6*) 1) (set*x6* 2) (test (test*x6*) 2)
+
+;;; op_unknown_ss:
+(define *x7* #f) (define (test*x7* a b) (*x7* a b)) (define (set*x7* n) (set! *x7* (lambda (x y) n)))
+    (set*x7* 1) (test (test*x7* 0 0) 1) (set*x7* 2) (test (test*x7* 0 0) 2)
+(define *x8* #f) (define (test*x8* a b) (*x8* a b)) (define (set*x8* n) (set! *x8* (define* (_ x y) n)))
+    (set*x8* 1) (test (test*x8* 0 0) 1) (set*x8* 2) (test (test*x8* 0 0) 2)
+
+;;; op_unknown_sc:
+(define *x9* #f) (define (test*x9* a b) (*x9* a 0)) (define (set*x9* n) (set! *x9* (lambda (x y) n)))
+    (set*x9* 1) (test (test*x9* 0 0) 1) (set*x9* 2) (test (test*x9* 0 0) 2)
+(define *x10* #f) (define (test*x10* a b) (*x10* a 0)) (define (set*x10* n) (set! *x10* (define* (_ x y) n)))
+    (set*x10* 1) (test (test*x10* 0 0) 1) (set*x10* 2) (test (test*x10* 0 0) 2)
+
+;;; op_unknown_cs:
+(define *x11* #f) (define (test*x11* a b) (*x11* 0 b)) (define (set*x11* n) (set! *x11* (lambda (x y) n)))
+    (set*x11* 1) (test (test*x11* 0 0) 1) (set*x11* 2) (test (test*x11* 0 0) 2)
+(define *x12* #f) (define (test*x12* a b) (*x12* 0 b)) (define (set*x12* n) (set! *x12* (define* (_ x y) n)))
+    (set*x12* 1) (test (test*x12* 0 0) 1) (set*x12* 2) (test (test*x12* 0 0) 2)
+
+;;; globals
+(test (let () (define (call-func func arg1 arg2) (define (call) (func arg1 arg2)) (call)) (call-func + 1 2.5) (call-func - 5 2)) 3)
+(test (let () (define (call-func arg1 arg2) (let ((func (if (= arg1 1) + -))) (define (call) (func arg1 arg2)) (call))) (call-func 1 2.5) (call-func 5 2)) 3)
+
+;;; safe/unsafe troubles
+(let ()
+  (define (testit)
+    (define (f1 x y z) (car z))
+    (define (f2 lst) (cond ((null? lst) ()) (else (f1 lst (f2 (cdr lst)) lst))))
+    (test (f2 '(abs -1)) 'abs))
+  (testit))
+(let ()
+  (define (testit)
+    (define (f1 x y z) (car z))
+    (define (f2 lst) (cond ((null? lst) ()) (else (f1 (f2 (cdr lst)) (f2 (cdr lst)) lst))))
+    (test (f2 '(abs -1)) 'abs))
+  (testit))
+
+;;; changing a function's environment -- blocked now if function is safe
+(let ()
+  (let ((e (let ((a 1) (b 2)) (curlet))))
+    (define (f1 c)
+      (+ a b c))
+    (test (set! (outlet (funclet f1)) e) 'error))
+
+  (let ((e (let ((a 1) (b 2)) (curlet))))
+    (define f2 (let ((d 10))
+		 (lambda (c)
+		   (+ a b c d))))
+    (test (set! (outlet (outlet (funclet f2))) e) e)
+    (test (f2 4) 17))
+
+  (let ((e (let ((a 1) (b 2)) (curlet))))
+    (define f3
+      (with-let e
+	(lambda (c)
+	  (+ a b c))))
+    (test (f3 4) 7)))
+
+(let ()
+  ;; symbol id > let id at redefinition! from Kjetil Matheussen.
+  (define (seq)
+    (let ((fins (lambda ()
+		  (let ((paint 1))
+		    (lambda ()
+		      (display paint #f)))))
+	  (sub-area #f)
+	  (paint 2)
+	  (my-display display))
+      (define (paint-internal)
+	(my-display paint #f)
+	(sub-area))
+      (set! sub-area (fins))
+      (define (paint) 3)
+      paint-internal))
+  (test ((seq)) 1)) ; the first "paint"
+
+(let () ; similar to above
+  (define (f1)
+    (define (f2)
+      (define paint 1)
+      (define (_) (display paint #f)))
+    (define paint 2)
+    (define (f3) (sub))
+    (define sub (f2))
+    (define (paint) 3)
+    f3)
+  (test ((f1)) 1))
+
+(let () ; similar to above but hits the "add" not the "set" branch
+  (define (f1)
+    (define (f2)
+      (define paint 1)
+      (define (_) (display paint #f)))
+    (define (f3) (sub))
+    (define sub (f2))
+    (define (paint) 3)
+    f3)
+  (test ((f1)) 1))
+
+(let ()
+  (define (f1)
+    (define (f2)
+      (define (f4) (display paint #f))
+      (define paint f4))
+    (define (f3) (sub))
+    (define sub (f2))
+    (define (paint) 3)
+    f3)
+  (test (procedure? (((f1)))) #t))
+
+(let ()
+  (define (paint) 2)
+  (define (f3) (sub))
+  (define (sub) (paint)) ; here (define sub paint) is not the same as (define (sub) (paint)): closure delays decision??
+  (define (paint) 3)
+  (test (f3) 3))
+
+;; this hits the same code in define2_ex:
+;; (let () (define (f2) (define paint 1)) (f2) (define (paint) 3))
+
+(let ()
+  (define (f0) (define (f1) paint))
+  (define (f2) (define paint 1) (define (f3) paint))
+  (define f4 (f2))
+  (define f5 (f0))
+  (define paint 3)
+  (test (+ (f4) (f5)) 4))
+
+;; same problem but in define_funchecked:
+(let ()
+  (define (A k x1)
+    (define (f1) (define (B) #f) B)
+    (f1)
+    (define (B)
+      (set! k (- k 1))
+      (A k B))
+    (if (<= k 0) 0 (B)))
+  (test (A 10 (lambda () 1)) 0))
+
+(let ()
+  (define (ftc)
+    (define (safef x) (if x 3 2))
+    (test (safef 4) 3)
+    (test (varlet (funclet safef) 'y 1) 'error)
+    (test (safef 4) 3))
+  (catch #t ftc (lambda (type info) (apply format *stderr* info)))
+
+  (define (ftc1)
+    (define (safef1 x) (if x 3 2))
+    (test (safef1 4) 3)
+    (test (with-let (funclet safef1) (define y 1)) 'error)
+    (test (safef1 4) 3))
+  (catch #t ftc1 (lambda (type info) (apply format *stderr* info)))
+
+  (define (ftc2)
+    (define* (safef2 (x (define y 1))) (if x 3 2))
+    (test (safef2) 3)
+    (test (safef2) 3))
+  (catch #t ftc2 (lambda (type info) (apply format *stderr* info)))
+
+  (define (ftc3)
+    (define* (safef3 x (y (define z 3))) (if x y 2))
+    (test (safef3) 2)
+    (test (safef3) 2))
+  (catch #t ftc3 (lambda (type info) (apply format *stderr* info)))
+
+  (define (ftc4)
+    (let* safef4 ((x 1) (z (define y 1)))
+	  (if x 3 2)))
+  (test (ftc4) 3)
+
+  (define (ftc5)
+    (let safef5 ((x 1) (z (define y 1)))
+      (if x 3 2)))
+  (test (ftc5) 3)
+
+  (define (ftc6)
+    (define-macro (safef6 x) `(if ,x 3 2))
+    (test (safef6 4) 3)
+    (varlet (funclet safef6) 'y 1)
+    (test (safef6 4) 3))
+  (catch #t ftc6 (lambda (type info) (apply format *stderr* info)))
+  )
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; values
+;;; call-with-values
+;;; list-values
+;;; apply-values
+;;; multiple-value-bind
+;;; --------------------------------------------------------------------------------
+
+
+(test (call-with-values (lambda () (values 1 2 3)) +) 6)
+(test (call-with-values (lambda () (values 4 5)) (lambda (a b) b))  5)
+(test (call-with-values (lambda () (values 4 5)) (lambda (a b) (+ a b))) 9)
+(test (call-with-values * -) -1) ; yeah, right... (- (*))
+(test (values 1) 1)
+(test (call-with-values (lambda () (values 1 2 3 4)) list) (list 1 2 3 4))
+(test (+ (values 1) (values 2)) 3)
+(test (+ (values '1) (values '2)) 3)
+(test (if (values #t) 1 2) 1)
+(test (if (values '#t) 1 2) 1)
+(test (if (values #f) 1 2) 2)
+(test (if (values #f #f) 1 2) 2)
+(test (if (values #t #f) 1 2) 1)
+(test (if (values () 1) 3 4) 3)
+(test (if (values) 1 2) 1)
+(test (if ((lambda () (values #t #f))) 1 2) 1)
+(test (if (values #f #t) 1) #<unspecified>)
+(test (if (values #t 1) (list (values 2 3))) (list 2 3))
+(test (equal? (values #t #t)) #t)
+(test (call-with-values (lambda () 4) (lambda (x) x)) 4)
+(test (let () (values 1 2 3) 4) 4)
+(test (apply + (values ())) 0)
+(test (+ (values 1 2 3)) 6)
+(test (let ((f (lambda () (values 1 2 3)))) (+ (f))) 6)
+(num-test (log (values 8 2)) 3)
+(test (* (values 2 (values 3 4))) 24)
+(test (* (values (+ (values 1 2)) (- (values 3 4)))) -3)
+(test (list (values 1 2) (values 3) 4) '(1 2 3 4))
+(test (let ((f1 (lambda (x) (values x (+ x 1)))) (f2 (lambda () (values 2)))) (+ (f1 3) (* 2 (f2)))) 11)
+(test (+ (let () (values 1 2)) 3) 6)
+(test (let () (values 1 2) 4) 4)
+(test (let () + (values 1 2) 4) 4)
+(test (string-ref (values "hiho" 2)) #\h)
+(test (vector-ref (values (vector 1 2 3)) 1) 2)
+(test (+ (values (+ 1 (values 2 3)) 4) 5 (values 6) (values 7 8 (+ (values 9 10) 11))) 66)
+(test (+ (if (values) (values 1 2) (values 3 4)) (if (null? (values)) (values 5 6) (values 7 8))) 18) ; (values) is now #<unspecified> (sort of)
+(test (+ (cond (#f (values 1 2)) (#t (values 3 4))) 5) 12)
+(test (+ (cond (#t (values 1 2)) (#f (values 3 4))) 5) 8)
+(test (apply + (list (values 1 2))) 3)
+(test (apply + (list ((lambda (n) (values n (+ n 1))) 1))) 3)
+(test (+ (do ((i 0 (+ i 1))) ((= i 3) (values i (+ i 1))))) 7)
+(test (+ (with-input-from-string "(values 1 2 3)" (lambda () (eval (read)))) 2) 8)
+(test (< (values 1 2 3)) #t)
+(test (apply (values + 1 2) '(3)) 6)
+(test (let () (define-macro (hi a) `(+ 1 ,a)) (hi (values 1 2 3))) 7)
+(test (+ 1 (eval-string "(values 2 3 4)")) 10)
+(test (+ 1 (eval '(values 2 3 4))) 10)
+(test (or (values #t) #f) #t)
+(test (and (values #t) #f) #f)
+(test (let ((x 1)) (set! x (values 32)) x) 32)
+(test (let ((x #(32 33))) ((values x) 0)) 32)
+(test (let ((x #(32 33))) (set! ((values x) 0) 123) x) #(123 33))
+(test (list-ref '(1 (2 3)) (values 1 1)) 3)
+(test (list-ref (values '(1 (2 3)) 1 1)) 3)
+(test (list-ref ((lambda () (values '(1 (2 3)) 1 1)))) 3)
+(test (set! (values) 1) 'error)
+(test (+ (values (begin (values 1 2)) (let ((x 1)) (values x (+ x 1))))) 6)
+(test (vector 1 (values 2 3) 4) #(1 2 3 4))
+(test (vector (values 1 (values 2 3) (values (values 4)))) #(1 2 3 4))
+(test(+ 1 (values (values (values 2) 3) (values (values (values 4)) 5) 6) 7) 28)
+(test (map (values values #(1 2))) '(1 2))
+(test ((values values) (values 0)) 0)
+(test (((values values values) 0)) 0)
+(test ((apply (values values values '((1 2))))) '(1 2))
+(test (apply begin (values (list 1))) 1)
+(test (apply begin (values '(values "hi"))) (apply (values begin '(values "hi"))))
+(test ((object->string values) (abs 1)) #\a)
+(test (list? (values 1 2 3)) 'error)
+(test (list? (values 1)) #f)
+(test (list? (values (list 1 2 3))) #t)
+(test (let () (define (f) (and () (values #f 1 2) (vector 0))) (f) (f)) #f) ; and_safe_p2->and_safe_p_rest
+(test (let () (define (f) (and (values #f 1 2) 1 (vector 0))) (f) (f)) #f)  ; same p1
+(test (let () (define (f) (and (values #f 1 2) 1 (subvector (vector 0) 0 0))) (f) (f)) #f)
+(test (let () (define (fv) (let ((x (list-values (values)))) (null? x))) (fv)) #t)
+(test (let loop ((a 2) (b 0)) (if (zero? a) b (loop (values (- a 1) (+ b 1))))) 2)
+(test (begin (values 1 2 3) 4) 4)
+(test (+ 5 (begin (values 1 2 3) 4)) 9)
+(test (let () (define (f) (+ 5 (begin (values 1 2 3) 4))) (f)) 9)
+(test (values (values)) #<unspecified>)
+(test (values (values 1)) 1)
+(test (list (values (values 1 2 3))) '(1 2 3))
+(test (values (values 'one)) 'one)
+(test (list (c-macro-with-values 1 2 3)) '(1 2 3))
+(test (let () (define (f) (list (values (int-vector (values 1 2)) (int-vector (values 1 2))))) (f)) (list #i(1 2) #i(1 2)))
+(test (list (values2 1 2)) '(1 2))
+(test (list (unsafe-values2 1 2)) '(1 2))
+
+(let ((gb1 'gb2)
+      (gb2 'gb3)
+      (gb3 '(+ 1 2)))
+  ;; make sure values does not evaluate
+  (test gb1 'gb2)
+  (test (values gb1) 'gb2)
+  (test (list gb1 gb2 gb3) '(gb2 gb3 (+ 1 2)))
+  (test (list (values gb1 gb2 gb3)) '(gb2 gb3 (+ 1 2)))
+  (test (list (values (values gb1 gb2) gb3)) '(gb2 gb3 (+ 1 2)))
+
+  (test (eval gb1)'gb3) ; or symbol->value
+  (test (eval (eval gb1)) '(+ 1 2))
+  (test (eval (eval (eval gb1))) 3))
+
+(test (+ (call-with-exit (lambda (ret) (values 1 2 3)))) 6)
+(test (+ 4 (call-with-exit (lambda (ret) (values 1 2 3))) 5) 15)
+(test (+ (call-with-exit (lambda (ret) (ret 1 2 3)))) 6)
+(test (+ 4 (call-with-exit (lambda (ret) (ret 1 2 3))) 5) 15)
+(test (+ (call/cc (lambda (ret) (values 1 2 3)))) 6)
+(test (+ 4 (call/cc (lambda (ret) (values 1 2 3))) 5) 15)
+(test (+ (call/cc (lambda (ret) (ret 1 2 3)))) 6)
+(test (+ 4 (call/cc (lambda (ret) (ret 1 2 3))) 5) 15)
+(test (+ (dynamic-wind (lambda () (values 1 2)) (lambda () (values 3 4)) (lambda () (values 5 6)))) 7)
+(test (let ((g #f)) (+ (call-with-exit (lambda (ret) (set! g ret) (values 1 2 3)))) (g)) 'error)
+(test (+ (call-with-exit (lambda (ret) (ret (values 1 2 3))))) 6)
+(test (+ (call/cc (lambda (ret) (ret (values 1 2 3))))) 6)
+(test ((lambda () (format #f "~S" (car (list (list-values ((lambda (a) (values a (+ a 1))) 2) :rest) (make-vector 3 '(1) pair?)))))) "(2 3 :rest)")
+(test (newline (open-output-function (lambda (a) (values a (+ a 1))))) 'error)
+(test (let () (define (func) (copy  #<undefined> (newline (open-output-function (lambda (a) (values a (+ a 1))))))) (func)) 'error)
+(test (list ((list (lambda (a) (values a (+ a 1)))) 0 1)) 'error) ; '(1 2))
+(test (list (list-ref (list (lambda (a) (catch #t (lambda () (+ 1 #\a)) (lambda (type info) (values a (+ a 1)))))) 0 1)) 'error) ; '(1 2))
+
+(test (+ (with-input-from-string "123" (lambda () (values 1 2 3)))) 6)
+(test (+ (call-with-input-string "123" (lambda (p) (values 1 2 3)))) 6)
+(test (+ (eval-string "(values 1 2 3)")) 6)
+
+(let ((_d_ (values)))
+  (test (list-values _d_) ())
+  (test (let () (define (func) (list-values _d_)) (func)) ()))
+
+(let ()
+  (test (let ((x 1)) (set! x (apply values (signature (hash-table))))) 'error)
+  (test (signature (hash-table)) (let ((sig (list #t 'hash-table? #t))) (set-cdr! (cddr sig) (cddr sig)) sig)))
+
+(test (let ((x 1)) (set! x (values)) x) #<unspecified>)
+(test ((lambda () (let ((x 1)) (set! x (boolean? (values)))))) #f)
+(test (let ((x 1)) (set! x (values 1 2 3)) x) 'error)
+(test (let ((x 1)) (set! x (values 2)) x) 2)
+(test (let ((x 1)) (set! (values x) 2) x) 'error) ; (no generalized set for values, so (values x) is not the same as x
+(test (let ((x #(0 1))) (set! (values x 0 32)) x) 'error)
+(test (let ((var (values 1 2 3))) var) 'error)
+(test (let* ((var (values 1 2 3))) var) 'error)
+(test (letrec ((var (values 1 2 3))) var) 'error)
+(test (let ((x ((lambda () (values 1 2))))) x) 'error)
+(test (+ 1 ((lambda () ((lambda () (values 2 3)))))) 6)
+(test (let () (define (hi) (symbol? (values 1 2 3))) (hi)) 'error)
+(test (let () (define (hi) (symbol? (values))) (hi)) #f) ; this is consistent with earlier such cases: (boolean? (values))
+(test (let () (define (hi) (symbol? (values 'a))) (hi)) #t)
+(test (let () (define (hi) (symbol? (values 1))) (hi)) #f)
+(test (let () (define (hi a) (log (values 1 2) a)) (hi 2)) 'error)
+(test (let () (define (arg2 a) (let ((b 1)) (set! b (+ a b)) (values b a))) (define (hi c) (expt (abs c) (arg2 2))) (hi 2)) 'error)
+(test (let () (define (arg2 a) (let ((b 1)) (set! b (+ a b)) (values b))) (define (hi c) (expt (abs c) (arg2 2))) (hi 2)) 8)
+(test (let () (define (hi) (+ (values 1 2) (values 3 4))) (hi)) 10)
+(test (let () (define (func) (let ((i 0)) ((lambda (a) (sort! a >)) (list-values (values 1 2 3) (+ i 1))))) (func)) '(3 2 1 1)) ; list-value embedded immutable list bug
+
+(test (catch #t (lambda () (let ((x (values 1 2))) x)) (lambda (type info) (apply format #f info))) "let: can't bind x to (values 1 2)")
+(test (catch #t (lambda () (let ((y 1) (x (values 1 2))) x)) (lambda (type info) (apply format #f info))) "let: can't bind x to (values 1 2)")
+(test (catch #t (lambda () (let* ((x (values 1 2))) x)) (lambda (type info) (apply format #f info))) "let*: can't bind x to (values 1 2)")
+(test (catch #t (lambda () (let* ((y 1) (x (values 1 2))) x)) (lambda (type info) (apply format #f info))) "let*: can't bind x to (values 1 2)")
+(test (catch #t (lambda () (letrec ((x (values 1 2))) x)) (lambda (type info) (apply format #f info))) "letrec: can't bind x to (values 1 2)")
+(test (catch #t (lambda () (letrec ((y 1) (x (values 1 2))) x)) (lambda (type info) (apply format #f info))) "letrec: can't bind x to (values 1 2)")
+(test (catch #t (lambda () (letrec* ((x (values 1 2))) x)) (lambda (type info) (apply format #f info))) "letrec*: can't bind x to (values 1 2)")
+(test (catch #t (lambda () (letrec* ((y 1) (x (values 1 2))) x)) (lambda (type info) (apply format #f info))) "letrec*: can't bind x to (values 1 2)")
+(test (catch #t (lambda () (let ((x 1)) (let-temporarily ((x (values 1 2))) x))) (lambda (type info) (apply format #f info))) "set!: can't set x to (values 1 2)")
+(test (catch #t
+	(lambda ()
+	  (let-temporarily (((*s7* 'print-length) (values 1 2))) 1))
+	(lambda (type info)
+	  (apply format #f info)))
+      "let-set!: too many arguments: (let-set! *s7* print-length 1 2)")
+(test (catch #t (lambda () (let ((x 1)) (set! x (values 1 2)))) (lambda (type info) (apply format #f info))) "(set! x (values 1 2)): too many arguments to set!")
+(test (catch #t
+	(lambda ()
+	  (let ((x (vector 1)))
+	    (set! (x 0) (values 1 2))))
+	(lambda (type info)
+	  (apply format #f info)))
+      "(set! (x 0) (values 1 2)): too many arguments to set!")
+(test (catch #t (lambda () (with-let (values (curlet) 2) 3)) (lambda (type info) (apply format #f info))) 3)
+
+(let () (define (f1) (let ((ints (list 1 2 3))) (apply + (values 5 ints)))) (test (f1) 11))
+(let () (define (f2) (let ((ints (list 1 2 3))) (apply + (values 4 5 ints)))) (test (f2) 15))
+(let () (define (f3) (let ((ints (list 1 2 3))) (apply + (values 4 5 6 ints)))) (test (f3) 21))
+
+(test (let ((str "hi")) (string-set! (values str 0 #\x)) str) "xi")
+(test (values if) if)
+(test (values quote) quote)
+
+(test ((values '(1 (2 3)) 1 1)) 3)
+(test (let ((x #(32 33))) ((values x 0))) 32)
+(test (+ 1 (apply values '(2 3 4))) 10)
+(test (eq? (values) (apply values ())) #t)
+(test (+ 1 ((lambda args (apply values args)) 2 3 4)) 10)
+(test (apply begin '(1 2 3)) 3)
+(test (let ((x 1)) ((values set!) x 32) x) 32) ; values_p_p opt2_con?
+(let ((x 0)) (test (list (set! x 10)) (call-with-values (lambda () (set! x 10)) list))) ; from r7rs discussion
+
+(let ((v (vector 1)))
+  (catch #t
+    (lambda ()
+      (set! (v 0) (values 1 2))
+      (format *stderr* "(set! (v 0) (values 1 2)) -> no error?~%"))
+    (lambda (type info)
+      (if (not (eq? type 'syntax-error)) ; maybe should be 'wrong-number-of-args-error
+	  (format *stderr* "(set! (v 0) (values 1 2)): ~A ~A~%" type info)))))
+(let ((p (list 1)))
+  (catch #t
+    (lambda ()
+      (set! (p 0) (values 1 2))
+      (format *stderr* "(set! (p 0) (values 1 2)) -> no error?~%"))
+    (lambda (type info)
+      (if (not (eq? type 'syntax-error))  ; wrong number of args to set!
+	  (format *stderr* "(set! (p 0) (values 1 2)): ~A ~A~%" type info)))))
+(let ((h (hash-table 'a 1)))
+  (catch #t
+    (lambda ()
+      (set! (h 'b) (values 1 2))
+      (format *stderr* "(set! (h 'b) (values 1 2)) -> no error?~%"))
+    (lambda (type info)
+      (if (not (eq? type 'syntax-error)) ; wrong number of args to set!
+	  (format *stderr* "(set! (h 'b) (values 1 2)): ~A ~A~%" type info)))))
+;;; similarly string/int-vector/float-vector -- seem to be ok
+
+(let ()
+  (define (curry function . args)
+    (lambda more-args
+      (function (apply values args) (apply values more-args)))) ; unfortunately this doesn't handle 0 args
+  (test ((curry + 1 2) 3 4) 10))
+
+(let ()
+  (define (curry function . args)
+    (if (null? args)
+	function
+	(lambda more-args
+	  (if (null? more-args)
+	      (apply function args)
+	      (function (apply values args) (apply values more-args))))))
+  (test ((curry + 1 2) 3 4) 10)
+  (test ((curry + 2) 3 4) 9)
+  (test ((curry +) 3 4) 7)
+  (test ((curry +)) 0)
+  (test ((curry + 1 2)) 3)
+  (test ((curry + 1)) 1)
+  (test ((curry +) 1) 1))
+
+(test (or (values #t #f) #f) #t)
+(test (or (values #f #f) #f) #f)
+(test (or (values #f #t) #f) #t)
+(test (or (values #f #f) #t) #t)
+(test (or (values 1 2) #f) 1)
+(test (+ 1 (or (values 2 3) 4)) 3)
+(test (+ 1 (and 2 (values 3 4)) 5) 13)
+(test (and (values) 1) 1)
+(test (and (values 1 2 #f) 4) #f)
+(test (and (values 1 2 3) 4) 4)
+(test (length (values ())) 0)
+(test (length (values #(1 2 3 4))) 4)
+(test (vector? (values #())) #t)
+(test (map + (values '(1 2 3) #(1 2 3))) '(2 4 6))
+(test (map + (values '(1 2 3)) (values #(1 2 3))) '(2 4 6))
+(test (map + (values '(1 2 3) #(4 5 6)) (values '(7 8 9))) '(12 15 18))
+(test (catch 'oops (lambda () (error 'oops (let-temporarily () (values 1 2 3)))) (lambda (t i) 'error)) 'error) ; for sticky mv bit
+
+(test (let ((x 1))
+	(and (let () (set! x 2) #f)
+	     (let () (set! x 3) #f))
+	x) 2)
+(test (let ((x 1))
+	(and (values (let () (set! x 2) #f)
+		     (let () (set! x 3) #f)))
+	x) 3)
+
+(test (+ (values 1 2) 3) 6)
+(test (+ (values 1 (values 2))) 3)
+(test (list (values 1 2)) '(1 2))
+(test (+ 6 (values 1 (values 2 3) 4 ) 5) 21)
+(test (+ ((lambda (x) (values (+ 1 x))) 2) 3) 6)
+(test (list ((lambda (x) (values (+ 1 x))) 2)) '(3))
+(test (+ (begin (values 1 2))) 3)
+(test (+ 1 (let () (values 1 2))) 4)
+(test (apply (values + 1 2) (list 3)) 6)
+(test ((lambda* ((a 1) (b 2)) (list a b)) (values :a 3)) '(3 2))
+(test (+ (values (values 1 2) (values 4 5))) 12)
+(test (+ (begin 3 (values 1 2) 4)) 4)
+(test (map (lambda (x) (if #f x (values))) (list 1 2)) ())
+(test (map (lambda (x) (if #f x (begin (values)))) (list 1 2)) ())
+(test (map (lambda (x) (if (odd? x) (values x (* x 20)) (values))) (list 1 2 3 4)) '(1 20 3 60))
+(test (map (lambda (x) (if (odd? x) (values x (* x 20)) (if #f #f))) (list 1 2 3 4)) '(1 20 #<unspecified> 3 60 #<unspecified>))
+(test (map (lambda (x) (if (odd? x) (apply values '(1 2 3)) (values))) (list 1 2 3 4)) '(1 2 3 1 2 3))
+(test (object->string (map (lambda (x) (if (odd? x) (values x (* x 20)) (values))) (list 1 2 3 4))) "(1 20 3 60)") ; make sure no "values" floats through
+(test (map (lambda (x) (if (odd? x) (values x (* x 20) (cons x (+ x 1))) (values))) (list 1 2 3 4 5 6)) '(1 20 (1 . 2) 3 60 (3 . 4) 5 100 (5 . 6)))
+(test (* 2 (case 1 ((2) (values 3 4)) ((1) (values 5 6)))) 60)
+(test (* 2 (case 1 ((2) (values 3 4)) (else (values 5 6)))) 60)
+(test (* 2 (case 1 ((1) (values 3 4)) (else (values 5 6)))) 24)
+(test (+ (values (* 3 2) (abs (values -1)))) 7)
+(test (+ (let ((x 1)) (values x (+ x 1))) (if #f #f (values 2 3))) 8)
+
+;;; the test macro here causes the multiple values to evaporate, ruining the test
+(let ((s1 (object->string (let ((_vals_ (lambda () (values 1 2 3)))) (define (func) (vector #f (_vals_) (append))) (define (hi) (func)) (hi))))
+      (s2 (object->string (let () (define (func) (vector #f (values 1 2 3) (append))) (define (hi) (func)) (hi)))))
+  (unless (equal? s1 s2) (format *stderr* "unequal: ~S ~S~%" s1 s2)))
+
+(let ((s1 (object->string (let ((_vals_ (lambda () (values 1 2 3)))) (define (func) (vector (_vals_) (append))) (define (hi) (func)) (hi))))
+      (s2 (object->string (let () (define (func) (vector (values 1 2 3) (append))) (define (hi) (func)) (hi)))))
+  (unless (equal? s1 s2) (format *stderr* "unequal: ~S ~S~%" s1 s2)))
+
+(let ((s1 (object->string (let ((_vals_ (lambda () (values 1 2 3)))) (define (func) (vector #f (_vals_))) (define (hi) (func)) (hi))))
+      (s2 (object->string (let () (define (func) (vector #f (values 1 2 3))) (define (hi) (func)) (hi)))))
+  (unless (equal? s1 s2) (format *stderr* "unequal: ~S ~S~%" s1 s2)))
+
+(let ((s1 (object->string (let ((_vals_ (lambda () (values 1 2 3)))) (define (func) (vector (append) (_vals_) #f)) (define (hi) (func)) (hi))))
+      (s2 (object->string (let () (define (func) (vector (append) (values 1 2 3) #f)) (define (hi) (func)) (hi)))))
+  (unless (equal? s1 s2) (format *stderr* "unequal: ~S ~S~%" s1 s2)))
+
+(test (let ((sum 0)) (for-each (lambda (n m p) (set! sum (+ sum n m p))) (values (list 1 2 3) (list 4 5 6) (list 7 8 9))) sum) 45)
+(test (map (lambda (n m p) (+ n m p)) (values (list 1 2 3) (list 4 5 6) (list 7 8 9))) '(12 15 18))
+(test (string-append (values "123" "4" "5") "6" (values "78" "90")) "1234567890")
+(test (+ (dynamic-wind (lambda () #f) (lambda () (values 1 2 3)) (lambda () #f)) 4) 10)
+
+(when with-block
+  ;; op_safe_c_pa_mv plist bug
+  (test (format #f "~S~%" (list (list-values (values 1 2 3 4 5 6 7 8 9 10) (block 1.0 2.0 3.0)) (make-vector 3 :rest keyword?)))
+        (let ()
+          (define (func) (format #f "~S~%" (list (list-values (values 1 2 3 4 5 6 7 8 9 10) (block 1.0 2.0 3.0)) (make-vector 3 :rest keyword?))))
+          (define (hi) (func)) (hi)))
+  ;; list-values bug when args contains an immutable list
+  (test (list-values (vector (block 0.0)) (call-with-exit (lambda (return) (let ((x 1) (y 2)) (return x y)))))
+        (list (vector (block 0)) 1 2))
+  (test (let () (define (func) (list (vector (block 0.0)) (call-with-exit (lambda (return) (let ((x 1) (y 2)) (return x y)))))) (func))
+        (list (vector (block 0)) 1 2))
+  (test (let () (define (func) (list-values (vector (block 0.0)) (call-with-exit (lambda (return) (let ((x 1) (y 2)) (return x y)))))) (func))
+        (list (vector (block 0)) 1 2)))
+
+(let ((x 'y)
+      (y 32))
+ (define (f1) (values #f))
+ (test (if (values #f) x)               #<unspecified>)
+ (test (if (values #t) x)               'y)
+ (test (if (values #f) (values x))      #<unspecified>)
+ (test (if (values #t) (values x))      'y)
+ (test (if x (values x))                'y)
+ (test (list (values x))                '(y))
+ (test (list (values x y))              '(y 32))
+ (test (cond ((values x) => list))      '(y))
+ (test (cond ((values x y) => list))    '(y))
+ (test (cond ((values #f) => list))     #<unspecified>)
+ (test (cond ((values #t) => list))     '(#t))
+ (test (cond ((f1) => list))            #<unspecified>)
+ (test (list (cond ((values x))))       '(y))
+ (test (list (cond ((values x y))))     '(y))
+ (test (list (cond (#t (values x))))    '(y))
+ (test (list (cond (#t (values x y))))  '(y 32))
+ (test (cond ((values x) => (lambda args (apply list args))))    '(y))
+ (test (cond ((values x y) => (lambda args (apply list args))))  '(y)))
+
+;;; increment_sz_mv:
+(test (let () (define (func) (let ((x 0)) (set! x (float-vector x (values 1 2))))) (define (hi) (func) (func)) (hi) (hi)) #r(0 1 2))
+(test (let () (define (func) (let ((x #\a)) (set! x (string x (values #\b #\c))))) (define (hi) (func) (func)) (hi) (hi)) "abc")
+(test (let () (define (func) (let ((x 0)) (set! x (vector x (values 1 2))))) (define (hi) (func) (func)) (hi) (hi)) #(0 1 2))
+
+(for-each
+ (lambda (arg)
+   (test (values arg) arg))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(for-each
+ (lambda (arg)
+   (test (apply values arg) 'error)
+   (test (apply values (list arg)) arg))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t '(1 . 2)))
+
+(for-each
+ (lambda (arg)
+   (test (call-with-values (lambda () (values arg arg)) (lambda (a b) b)) arg))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(test (call-with-values (lambda () (values "hi" 1 3/2 'a)) (lambda (a b c d) (+ b c))) 5/2)
+					;(test (call-with-values values (lambda arg arg)) ())
+(test (string-ref (values "hi") 1) #\i)
+(test ((lambda (a b) (+ a b)) ((lambda () (values 1 2)))) 3)
+
+(test (list (letrec ((split (lambda (ls)
+			      (if (or (null? ls) (null? (cdr ls)))
+				  (values ls ())
+				  (call-with-values
+				      (lambda () (split (cddr ls)))
+				    (lambda (odds evens)
+				      (values (cons (car ls) odds)
+					      (cons (cadr ls) evens))))))))
+	      (split '(a b c d e f))))
+      '((a c e) (b d f)))
+
+(let ()
+  (define (f1 . args)
+    (apply values (+ (car args) (cadr args)) (cddr args)))
+  (test (* (f1 2 3 4)) 20)
+  (test (* (f1 2 3 4) (f1 1 2 3)) 180)
+  (test (- (f1 2 3 4) (f1 1 2 3)) -5))
+
+(test (call-with-values (lambda () (call/cc (lambda (k) (k 2 3)))) (lambda (x y) (list x y))) '(2 3))
+(test (+ (call/cc (lambda (return) (return (values 1 2 3)))) 4) 10)
+
+(test (let ((values 3)) (+ 2 values)) 5)
+(test (let ((a (values 1))) a) 1)
+
+(test (call-with-values (lambda () 2) (lambda (x) x)) 2)
+(test (call-with-values (lambda () -1) abs) 1)
+(test (call-with-values (lambda () (values -1)) abs) 1)
+(test (call-with-values (lambda () (values -1)) (lambda (a) (abs a))) 1)
+
+(test (call-with-values
+	  (lambda ()
+	    (values
+	     (call-with-values (lambda () (values 1 2 3)) +)
+	     (call-with-values (lambda () (values 1 2 3 4)) *)))
+	(lambda (a b)
+	  (- a b)))
+      -18)
+
+(test (call-with-values
+	  (lambda ()
+	    (values
+	     (call-with-values (lambda () (values 1 2 3)) +)
+	     (call-with-values (lambda () (values 1 2 3 4)) *)))
+	(lambda (a b)
+	  (+ (* a (call-with-values (lambda () (values 1 2 3)) +))
+	     (* b (call-with-values (lambda () (values 1 2 3 4)) *)))))
+      612)
+
+(test (call-with-values (lambda (x) (+ x 1)) (lambda (y) y)) 'error)
+(test (+ (values . 1)) 'error)
+(for-each
+ (lambda (arg)
+   (test (call-with-values arg arg) 'error))
+ (list "hi" -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+(test (call-with-values (lambda () (values -1 2)) abs) 'error)
+
+(test (multiple-value-bind (a b) (values 1 2) (+ a b)) 3)
+(test (multiple-value-bind (a) 1 a) 1)
+(test (multiple-value-bind (a . rest) (values 1 2 3) (+ a (apply + rest))) 6)
+(test (multiple-value-bind a (values 1 2 3) a) '(1 2 3))
+(test (multiple-value-bind (x y z) (values 1 2 3) (list z y x)) '(3 2 1))
+(test (multiple-value-bind (x y z) (values 1 2 3) (let ((x 4)) (list x y z))) '(4 2 3))
+(test (multiple-value-bind (x y) (values 1 2) (define z (+ x y)) (+ z 1)) 4)
+(unless pure-s7
+  (test (multiple-value-bind (x y z) (values 1 2 3 4 5 6) (list x y z)) 'error)                                     ; was '(1 2 3)) -- 25-Jan-16
+  (test (multiple-value-bind (x y z) (values 1 2) (list x y z)) 'error)                                             ; was '(1 2 #f))
+  (test (multiple-value-bind (x y z) (multiple-value-bind () (values 1 2) (values 'a 'b 'c)) (list x y z)) 'error)) ;was '(a b c))
+
+(test (let ((add (lambda (a b) (values (+ a 1) (+ b 1))))) (+ 1 (add 2 3))) 8)
+(test (min (values 1 2) (values 3 0)) 0)
+(test ((lambda* ((a 1) (b 2)) (list a b)) (values :b 231)) '(1 231))
+(test (cons (values 1 2) (values 3 4)) 'error)
+
+(test (cond ((values) 3) (#t 4)) 3)          ; an error in Guile "zero values returned"
+(test (cond ((values (values)) 3) (#t 4)) 3) ; same
+(test (+ (cond (#t (values 1 2)))) 3)        ; 1 in guile
+(test (+ 1 (values)) 'error)
+
+(test (case (values 1) ((1) 2) (else 3)) 2)
+(test (case (values 1 2) ((1) 2) (else 3)) 2)  ; was 3 until 17-Feb-18
+(test (case (values 1) (((values 1)) 2) (else 3)) 3)
+(test (case (values 1 2) (((values 1 2)) 2) (else 3)) 3)
+(test (let () (define (f) (values 1 2)) (define (g1) (case (f) ((1) 1) (else 2))) (g1) (g1)) 1)     ; splice case_i_s
+(test (let () (define (f1) (values 'a 'b)) (define (g1) (case (f1) ((a) 1) (else 2))) (g1) (g1)) 1) ;        case_e_s
+(test (let () (define (g1) (case (values 'a 'b) ((a) 1) ((2) 0) (else 2))) (g1) (g1)) 1)            ;        case_g_s
+(test (let () (define (g1) (case (values 'a 'b) ((a b) 1) ((c) 2) (else 3))) (g1) (g1)) 1)          ;        case_e_g
+(test (case (values 1 2) ((1) 0)) 0)
+
+(test ((values) 0) 'error)
+(test ((values "hi") 1) #\i)
+(test (string-ref (values "hi") 0) #\h)
+(test (string-ref (values "hi" "ho") 0) 'error)
+(test (let ((str "hi")) (set! ((values str) 0) #\x) str) "xi")
+(test (let ((str "hi")) (string-set! (values str) 0 #\x) str) "xi")
+(test (let ((str "hi")) (set! (values str 0) #\x) str) 'error)         ; values does not have a setter?
+(test (let ((str "hi")) (string-set! (values str 0) #\x) str) "xi")
+
+(test ((values 1 2 3) 0) 'error)
+(test ((values "hi" "ho") 1) 'error)
+(test ((values + 1 2 3)) 6)
+(test ((values + 1 2) 3) 6)
+(test ((values +) 1 2 3) 6)
+(test ((values "hi" 0)) #\h)
+(test ((values + 1) (values 2 3) 4) 10)
+(test ((values - 10)) -10)
+(test ((values - -10) 0) -10) ; looks odd but it's (- -10 0) that is (- a) != (- a 0)
+(test ((values - 2 3) 0) -1)
+(test ((values - 2 3) 1) -2)
+(test ((values - 2 3) 2) -3)  ; it's actually (- 2 3 2) -> -3
+
+(test (let ((str "hi")) (set! ((values str 0) 0) #\x) str) 'error)
+(test (let ((str "hi")) (set! ((values str) 0) #\x) str) "xi")
+(test (+ (let ((x 0)) (do ((i (values 0) (+ i 1))) (((values = i 10)) (values x 2 3)) (set! x (+ x i)))) 4) 54)
+(test    (let ((v #2d((1 2) (3 4)))) (set! ((values v) 1 0) 5) v) #2d((1 2) (5 4))) ; same as (let ((v #2d((1 2) (3 4)))) (set! (v 1 0) 5) v)
+;;; but: (let ((v #2d((1 2) (3 4)))) (set! ((values v) 1) 5) v): not enough args for vector-set!: (#2d((1 2) (3 4)) 1 5)
+;;;      (let ((v #2d((1 2) (3 4)))) (set! ((values v) 1) 0 5) v): (set! ((values v) 1) 0 5): too many arguments to set!
+;;;      (let ((v #2d((1 2) (3 4)))) (set! ((values v 1) 0) 5) v): (set! #2d((1 2) (3 4)) 1 0 5): too many arguments to set!
+;;; not sure this is consistent! or even makes any sense
+
+(let () ; these are testing values splicing across eval-done boundaries
+  (define (f1 x)
+    (+ 1
+       (with-input-from-string "asdf"
+	 (lambda ()
+	   (values x x x)))))
+  (test (f1 2) 7)
+
+  (define (f2 x)
+    (+ 1
+       (dynamic-wind
+	   (lambda () #f)
+	   (lambda ()
+	     (with-input-from-string "asdf"
+	       (lambda ()
+		 (values x x x))))
+	   (lambda () #f))))
+  (test (f2 2) 7)
+
+  (define (f3 x)
+    (+ 1
+       (let-temporarily ((x 2)
+			 ((*s7* 'print-length) 12))
+	 (with-input-from-string "asdf"
+	   (lambda ()
+	     (let ((L (openlet (inlet 'func (lambda () (values x x x))))))
+	       (with-let L (func))))))))
+  (test (f3 3) 7))
+
+(test (map values (list (values 1 2) (values 3 4))) '(1 2 3 4))
+(test (let () (define-macro (hi a) `(+ 1 ,a)) (hi (values 2 3 4))) 10)
+(test (let () (+ 4 (let () (values 1 2 3)) 5)) 15)
+(test (let* () (+ 4 (let () (values 1 2 3)) 5)) 15)
+(test (let () (+ 4 (let* () (values 1 2 3)) 5)) 15)
+(test (letrec () (+ 4 (let () (values 1 2 3)) 5)) 15)
+(test (let () (+ 4 (letrec () (values 1 2 3)) 5)) 15)
+(test (letrec* () (+ 4 (let () (values 1 2 3)) 5)) 15)
+(test (let* () (+ 4 (letrec* () (values 1 2 3)) 5)) 15)
+
+(test (cons (values 1 2)) '(1 . 2))
+(test (number->string (values 1 2)) "1")
+(test (object->string (values)) "#<unspecified>")
+(test (equal? (begin) (begin (values))) #f) ; () but #<unspecified>
+(test (map (lambda (x) (if #f x #<unspecified>)) (list 1 2)) '(#<unspecified> #<unspecified>))
+(test (equal? (values) (if #f #f)) #t)
+(test (substring (values "hi") (values 1 2)) "i")
+(test (cond (call-with-exit (values "hi"))) "hi")
+(test (values (begin (values "hi"))) "hi")
+(test (< (values (values 1 2))) #t)
+(test (apply-values (cdr (list-values (values)))) 'error)
+(test (apply values (cdr (list-values (values)))) 'error)
+(test (apply-values) #<unspecified>)
+(test (apply-values ()) #<unspecified>)
+(test (apply values) #<unspecified>)
+(test (apply values ()) #<unspecified>)
+(test (list-values (values)) ())
+(test (list-values (apply-values)) ())
+(test (list-values (apply-values) (values)) ())
+(test (list-values 1 (values) 2) '(1 2))
+(test (list-values 1 2 (values)) '(1 2))
+(test (list-values (values) 1 2) '(1 2))
+(test (let ((_y_ list-values )) (define (f x) (cyclic-sequences (x 1))) (define (g) (f _y_)) (g)) ())
+(test ((lambda (x) (cyclic-sequences  (x 1)  )) list-values) ())
+(test (let ((x list-values)) (cyclic-sequences (x 1))) ())
+(test (let () (define (f) ((lambda (a) (sort! a >)) (list-values ((let () quasiquote) (2 1))))) (f)) '((2 1)))
+
+(let () (define (func) (list (list-ref (list-values (lambda (a) (values a (+ a 1)))) 0 1))) (test (func) 'error)) ; '(1 2)))
+(let () (define (func) (list (list-ref (list (lambda (a) (values a (+ a 1)))) 0 1))) (test (func) 'error)) ; '(1 2)))
+(let () (define (func) (list ((lambda (a) (values a (+ a 1))) 0))) (test (func) '(0 1)))
+(let ((a 1)) (define (func x y) (list (list-ref (list (lambda (a) (values a (+ a 1)))) x y))) (test (func (+ a (- a)) (* a 1)) 'error)) ; '(1 2)))
+
+(test (let ((lst (list (values)))) (map values lst)) (list-values (values)))
+(test (let ((lst (list 1 (values) 2))) (map values lst)) (list-values 1 (values) 2))
+(test (map values (list (values (values (values))))) (list-values (values (values (values)))))
+(let ((seq (list 1 2 (values) 3)))
+  (test (let ((erg (apply list-values seq)))
+	  (let ((iter (if (iterator? erg) erg (make-iterator erg)))
+		(result ()))
+	    (do ((x (iter) (iter)))
+		((iterator-at-end? iter) (reverse result))
+	      (set! result (cons x result)))))
+	(map values seq)))
+
+(test (let ((lst (list 0)))
+	(set-cdr! lst lst)
+	(format (values #f "~A" lst)))
+      "#1=(0 . #1#)")
+
+(let ()
+  (define (mv n)
+    (define (mv-1 a)
+      (values a (+ a 1)))
+    (define (mv-2 b)
+      (values b (* b 2)))
+    (values n (mv-1 n) (mv-2 n)))
+  (test (list (mv 2)) '(2 2 3 2 4))
+  (test (+ (mv 1) (mv 3)) 26))
+
+(let ()
+  (define (fib n)
+    (define (1st a b)
+      a)
+    (define (fib-1 n)
+      (if (< n 3)
+	  (values 1 1)
+	  (values (+ (fib-1 (- n 1)))
+		  (1st (fib-1 (- n 1))))))
+    (1st (fib-1 n)))
+  (test (fib 8) 21)
+  (test (fib 13) 233))
+
+(let ()
+  (define (fib n)
+    (define (1st a b)
+      a)
+    (define (2nd a b)
+      (values (+ a b) a))
+    (define (fib-1 n)
+      (if (< n 3)
+	  (2nd 1 0)
+	  (2nd (fib-1 (- n 1)))))
+    (1st (fib-1 n)))
+
+  (define (real-fib n)
+    (let ((phi (/ (+ 1 (sqrt 5)) 2)))
+      (floor (real-part (/ (- (expt phi n)        ; "floor" to return an integer, real-part to guard against epsilonic imag-parts from expt
+			      (expt (- 1 phi) n))
+			   (sqrt 5))))))
+
+  (test (fib 8) (real-fib 8))
+  (test (fib 13) (real-fib 13)))
+
+(let ()
+  (define (cfib z) ; wikipedia "generalized fibonacci numbers"
+    (let ((phi (/ (+ 1 (sqrt 5)) 2)))
+      (/ (- (expt phi z)
+	    (* (expt phi (- z)) (cos (* pi z))))
+	 (sqrt 5))))
+
+  (num-test (cfib 3) 2.0)
+  (num-test (cfib 8) 21.0)
+  (num-test (cfib 3+4i) -5248.5113072837-14195.962288353i))
+
+(num-test (let ((f- -) (f+ +)) (define (fb n) (if (< n 2.0) n (f+ (fb (f- n 1.0)) (fb (f- n 2.0))))) (fb 12.0)) 144.0)
+
+(let ()
+  ;; -------- Ely Bandersky (translated from python) --------
+
+  (define (fib-tail n0)
+    (let fibber ((n n0)
+		 (ac1 1)
+		 (ac2 1))
+      (if (= n 0)
+	  ac1
+	  (fibber (- n 1) (+ ac1 ac2) ac1))))
+  (test (fib-tail 6) 21)
+
+  (define (fact-tail n0)
+    (let facter ((n n0)
+		 (result 1))
+      (if (= n 0)
+	  result
+	  (facter (- n 1) (* n result)))))
+  (test (fact-tail 6) 720)
+
+  (define (fib-iter n0)
+    (let ((ac1 1)
+	  (ac2 1))
+      (do ((n n0 (- n 1)))
+	  ((<= n 2)
+	   ac1)
+	(let ((ac11 ac1))
+	  (set! ac1 (+ ac1 ac2))
+	  (set! ac2 ac11)))))
+  (test (fib-iter 6) 8)
+
+  (define (fact-cps n cont)
+    (if (= n 0)
+	(cont 1)
+	(fact-cps (- n 1) (lambda (value)
+			    (cont (* n value))))))
+  (fact-cps 6 (lambda (n) (test n 720)))
+
+  (define (fib-cps n cont)
+    (if (< n 2)
+	(cont 1)
+	(fib-cps (- n 1) (lambda (value)
+			   (fib-cps (- n 2)
+				    (lambda (value2)
+				      (cont (+ value value2))))))))
+  (fib-cps 6 (lambda (n) (test n 13)))
+
+  (define (trampoline f . args)
+    (let ((v (apply f args)))
+      (do ()
+	  ((not (aritable? v 0))
+	   v)
+	(set! v (v)))))
+
+  (define (fact-cps-chunked n cont)
+    (if (= n 0)
+	(cont 1)
+	(lambda ()
+	  (fact-cps-chunked (- n 1)
+			    (lambda (value)
+			      (lambda ()
+				(cont (* n value))))))))
+  (fact-cps-chunked 6 (lambda (n) (test n 720))))
+
+(let ()
+  (define (flatten lst)
+    (map values (list (let flatten-1 ((lst lst))
+                        (cond ((null? lst) (values))
+                               ((not (pair? lst)) lst)
+                               (else (values (flatten-1 (car lst))
+                                             (flatten-1 (cdr lst)))))))))
+#|
+  ;; old form
+  (define (flatten lst) ; flatten via values and map
+    (define (flatten-1 lst)
+      (cond ((null? lst) (values))
+	    ((not (pair? lst)) lst)
+	    (#t (values (flatten-1 (car lst))
+			(flatten-1 (cdr lst))))))
+    (map values (list (flatten-1 lst))))
+
+  ;; another:
+  (define (flatten lst)
+    (let loop ((lst lst) (acc ()))
+      (cond ((null? lst) acc)
+            ((pair? lst) (loop (car lst) (loop (cdr lst) acc)))
+            (else (cons lst acc)))))
+|#
+
+  (test (flatten '(1 2 3)) '(1 2 3))
+  (test (flatten ()) ())
+  (test (flatten '((1) 2 (3 4) (6 (7)))) '(1 2 3 4 6 7))
+  (test (flatten '(1 ((((2)) 3)))) '(1 2 3))
+  (test (flatten '(1 () 2)) '(1 2))
+  (test (flatten '((1 () 2) ())) '(1 2))
+  (test (flatten '(() 1 ((2 (3)) () 4))) '(1 2 3 4))
+  (test (flatten '((1) 2 ((3 4) 5) ((())) (((6))) 7 8 ())) '(1 2 3 4 5 6 7 8))
+  (test (flatten '(() 1 () ((2 (1)) 4) (3 2) ())) '(1 2 1 4 3 2))
+  )
+
+(let ()
+  (define (flatten! lst) ; in-place flatten
+    (if (not (pair? lst))
+	lst
+	(let loop ((L lst))
+	  (if (pair? (car L))
+	      (let ((end (cdr L))
+		    (p (car L)))
+		(set! (car L) (car p))
+		(set! (cdr L) (cdr p))
+		(set! (cdr (list-tail L (- (length p) 1))) end)
+		(loop L))
+	      (if (not (null? (cdr L)))
+		  (if (null? (car L))
+		      (begin
+			(set! (car L) (cadr L))
+			(set! (cdr L) (cddr L))
+			(loop L))
+		      (loop (cdr L)))))
+	  (if (equal? lst '(()))
+	      ()
+	      (let ((len (length lst)))
+		(if (null? (car (list-tail lst (- len 1))))
+		    (set! (cdr (list-tail lst (- len 2))) ()))
+		lst)))))
+
+  (test (flatten! '(1 2 3)) '(1 2 3))
+  (test (flatten! ()) ())
+  (test (flatten! '((1) 2 (3 4) (6 (7)))) '(1 2 3 4 6 7))
+  (test (flatten! '(1 ((((2)) 3)))) '(1 2 3))
+  (test (flatten! '(1 () 2)) '(1 2))
+  (test (flatten! '((1 () 2) ())) '(1 2))
+  (test (flatten! '(() 1 ((2 (3)) () 4))) '(1 2 3 4))
+  (test (flatten! '((1) 2 ((3 4) 5) ((())) (((6))) 7 8 ())) '(1 2 3 4 5 6 7 8))
+  (test (flatten! '(() 1 () ((2 (1)) 4) (3 2) ())) '(1 2 1 4 3 2))
+  )
+
+(let ()
+  (define (flatten x) ; standard flatten
+    (cond ((null? x) ())
+          ((not (pair? x)) (list x))
+          (#t (append (flatten (car x))
+		      (flatten (cdr x))))))
+
+  (test (flatten '(1 2 3)) '(1 2 3))
+  (test (flatten ()) ())
+  (test (flatten '((1) 2 (3 4) (6 (7)))) '(1 2 3 4 6 7))
+  (test (flatten '(1 ((((2)) 3)))) '(1 2 3))
+  (test (flatten '(1 () 2)) '(1 2))
+  (test (flatten '((1 () 2) ())) '(1 2))
+  (test (flatten '(() 1 ((2 (3)) () 4))) '(1 2 3 4))
+  (test (flatten '((1) 2 ((3 4) 5) ((())) (((6))) 7 8 ())) '(1 2 3 4 5 6 7 8))
+  (test (flatten '(() 1 () ((2 (1)) 4) (3 2) ())) '(1 2 1 4 3 2))
+  )
+
+(test (let () (define (hi a) (+ (abs a) (values 1 2 3))) (hi -4)) 10)
+(let ()
+  (define (hi a)
+    (let ((x 0)
+	  (again #f))
+      (let ((y (+ (abs a) (call/cc (lambda (r) (set! again r) 1)))))
+	(set! x (+ x y))
+	(if (< x 3) (again 1))
+	x)))
+  (test (hi 0) 3))
+
+(let ()
+  (define-macro (define-values1 vars . body)
+    `(apply begin (map (lambda (var val) `(define ,var ,val)) ',vars (list (begin ,@body)))))
+
+  (define-macro (let*-values1 vars . body)
+    `(let ()
+       ,@(map (lambda (nvars . nbody)
+	        `(apply define-values1 ',nvars ',@nbody))
+	      (map car vars) (map cdr vars))
+       ,@body))
+
+  (let ()
+    (define-values1 (a b) (values 3 2))
+    (test (* a b) 6))
+
+  (let ()
+    (test (let*-values1 (((a b) (values 3 2))) (* a b)) 6)))
+
+(define __p__ 123)
+(define current-rootlet (curlet))
+
+(let ((__p__ 321))
+  (set! __p__ 432))
+
+(if (not (= __p__ 123)) (format #t "__p__: ~A~%" __p__))
+
+(let ()
+  (define (args) (values __p__ (* __p__ 2)))
+  (let ((__p__ 0)
+	(q 1))
+    (call-with-values args (lambda (a b) (set! __p__ a) (set! q b)))
+    (if (not (= __p__ 123)) (format #t "    local __p__: ~A~%" __p__))
+    (set! __p__ 432)
+    (call-with-values args (lambda (__p__ q) (set! __p__ 321)))
+    (if (not (= __p__ 432)) (format #t "    local __p__: ~A~%" __p__))))
+
+(if (not (= __p__ 123)) (format #t "__p__: ~A~%" __p__))
+
+(let ()
+  (define-macro (args a b) `(values ,a ,b))
+  (define (sp a b)
+    (set! a 121))
+  (define (pq __p__ q)
+    (set! __p__ q))
+  (sp (args __p__ __p__))
+  (pq (args __p__ 567)))
+
+(if (not (= __p__ 123)) (format #t "__p__: ~A~%" __p__))
+
+(let ((__p__ 321))
+  (eval '(set! __p__ 432) current-rootlet)
+  (if (not (= __p__ 321)) (format #t "    local __p__: ~A~%" __p__))
+  (eval '(set! __p__ 123))
+  (if (not (= __p__ 123)) (format #t "    local __p__: ~A~%" __p__)))
+
+(if (not (= __p__ 432)) (format #t "__p__: ~A~%" __p__))
+
+(let ()
+  (eval '(let ((__p__ 321)) (set! __p__ 456)) current-rootlet))
+
+(if (not (= __p__ 432)) (format #t "__p__: ~A~%" __p__))
+
+(let ((__p__ (values __p__)))
+  (if (not (= __p__ 432)) (format #t "    local __p__: ~A~%" __p__))
+  (set! __p__ 123))
+
+(if (not (= __p__ 432)) (format #t "__p__: ~A~%" __p__))
+
+(let ()
+  (define (sp __p__ q) (values __p__ q))
+  (call-with-values (lambda () (sp __p__ (* __p__ 2))) (let ((__p__ 1)) (lambda (a b) (set! __p__ a)))))
+
+(if (not (= __p__ 432)) (format #t "__p__: ~A~%" __p__))
+
+(let ((lst (list __p__ (* __p__ 2))))
+  (define-macro (sp a) `(set! __p__ ,a))
+  (let ((__p__ 0)
+	(q 1))
+    (define (pq a) (set! __p__ a))
+    (map sp (list __p__ q))
+    (if (not (= __p__ 1)) (format #t "    local __p__: ~A~%" __p__))
+    (for-each sp (list __p__ q))
+    (if (not (= __p__ 1)) (format #t "    local __p__: ~A~%" __p__))
+    (map sp lst)
+    (if (not (= __p__ (* 432 2))) (format #t "    local __p__: ~A~%" __p__))
+    (for-each sp lst)
+    (if (not (= __p__ (* 432 2))) (format #t "    local __p__: ~A~%" __p__))
+    (set! __p__ 0)
+    (set! q 1)
+    (map pq (list __p__ q))
+    (if (not (= __p__ 1)) (format #t "    local __p__: ~A~%" __p__))
+    (for-each pq (list __p__ q))
+    (if (not (= __p__ 1)) (format #t "    local __p__: ~A~%" __p__))
+    (map pq lst)
+    (if (not (= __p__ (* 432 2))) (format #t "    local __p__: ~A~%" __p__))
+    (for-each pq lst)
+    (if (not (= __p__ (* 432 2))) (format #t "    local __p__: ~A~%" __p__))))
+
+(if (not (= __p__ 432)) (format #t "__p__: ~A~%" __p__))
+
+(when (eq? (curlet) (rootlet))
+  (let ((__p__ 1))
+    (eval `(define (__p__ a) (+ a ,__p__)) current-rootlet)
+    (if (not (= __p__ 1)) (format #t "    local __p__: ~A~%" __p__)))
+
+  (if (not (procedure? __p__)) (format #t "__p__: ~A~%" __p__))
+  (if (not (= (__p__ 2) 3)) (format #t "(__p__ 2): ~A~%" (__p__ 2)))
+
+  (let ((__p__ 1))
+    (eval `(define __p__ 32))
+    (if (not (= __p__ 32)) (format #t "    local __p__: ~A~%" __p__)))
+
+  (if (not (procedure? __p__)) (format #t "__p__: ~A~%" __p__))
+  (if (not (= (__p__ 2) 3)) (format #t "(__p__ 2): ~A~%" (__p__ 2)))
+
+  (let ((__p__ 1))
+    (eval `(define __p__ 32) (curlet))
+    (if (not (= __p__ 32)) (format #t "    local __p__: ~A~%" __p__)))
+
+  (if (not (procedure? __p__)) (format #t "__p__: ~A~%" __p__))
+  (if (not (= (__p__ 2) 3)) (format #t "(__p__ 2): ~A~%" (__p__ 2))))
+
+(let ()
+  (define-macro (m1) (values))
+  (define-macro (m2) (values 2 3))
+  (define-macro (m3) (values '(+ 1 2) '(* 3 4)))
+  (define-macro (m4) (values '(define a 1) '(define b 2)))
+  (define-macro (m5 a b) (values `(define a ,a) `(define b (+ ,b 1))))
+
+  (test (begin (m1)) #<unspecified>)
+  (test (+ (m2)) 5)
+  (test (+ 1 (m3) 3) 19)
+  (test (let () (m4) (+ a b)) 3)
+  (test (let () (m5 1 2) (+ a b)) 4))
+
+(let ((lst (list 1)))
+  (define (sf x y) (and (pair? x) (list x y)))
+  (define (mv x) (values x x))
+  (define (testsf)
+    (test (sf lst lst) '((1) (1)))
+    (test (sf (mv lst)) '((1) (1)))
+    (test (sf lst (mv lst)) 'error)
+    (test (sf (mv lst) lst) 'error))
+  (testsf))
+
+(let ((lst (list 1)))
+  (define (sf x y) (and (pair? x) (pair? y)))
+  (define (mv x) (values x x))
+  (define (testsf)
+    (test (sf lst lst) #t)
+    (test (sf (mv lst)) #t)
+    (test (sf lst (mv lst)) 'error)
+    (test (sf (mv lst) lst) 'error))
+  (testsf))
+
+(let ((lst (list 1)))
+  (define (sf x) (and (pair? x) (list x x)))
+  (define (mv x) (values x x))
+  (define (testsf)
+    (test (sf lst) '((1) (1)))
+    (test (sf (mv lst)) 'error))
+  (testsf))
+
+(let ((lst (list 1)))
+  (define (sf x) (and (pair? x) (pair? x)))
+  (define (mv x) (values x x))
+  (define (testsf)
+    (test (sf lst) #t)
+    (test (sf (mv lst)) 'error))
+  (testsf))
+
+;;; bugs in optimizations of sequence with closure element returning values implicitly invoked
+(let ((L_3 (inlet 'a (lambda (a) (values a (+ a 1))))))
+  (test (procedure? (let-ref L_3 'a)) #t)
+  (test (let-ref L_3 'a 12) 'error)
+  (test (list (L_3 'a 12)) 'error) ; '(12 13))
+  (test (s7-optimize '((let-ref L_3 'a 12))) #<undefined>)
+  (test (s7-optimize '((L_3 'a 12))) #<undefined>))
+
+(let ((V_3 (vector (lambda (a) (values a (+ a 1))))))
+  (test (list (V_3 0 12)) 'error) ; '(12 13))
+  (test (vector (vector-ref V_3 0 12)) 'error) ; #(12 13))
+  (test (s7-optimize '((vector-ref V_3 0 12))) #<undefined>))
+
+(let ((V (vector (lambda (a) (values a 321)))))
+  (test (s7-optimize '((vector-ref V_3 0 'a))) #<undefined>))
+
+(let ((H_3 (make-hash-table)))
+  (hash-table-set! H_3 (make-hash-table) (lambda (a) (values a (+ a 1))))
+  (test (s7-optimize '((hash-table-ref H_3 (make-hash-table) 12))) #<undefined>))
+
+(let ((P_3 (list (lambda (a) (values a (+ a 1))))))
+  (test (list (P_3 0 12)) 'error) ; '(12 13))
+  (test (vector (list-ref P_3 0 12)) 'error) ; '(12 13))
+  (test (s7-optimize '((list-ref P_3 0 12))) #<undefined>))
+
+(let ((V (vector (lambda (a) (values a 321)))))
+  (test (vector (vector-ref V 0 'a)) 'error)) ; #(a 321)))
+
+(let ((P_3 (list (lambda (a) (values a (+ a 1))))))
+  (test (s7-optimize '((list-ref P_3 0 12))) #<undefined>))
+
+(let ((V_3 (vector (lambda (a) (values a 321)))))
+  (define (f)
+    (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (V_3 0 'a))))
+  (test (f) 'error)) ; #t))
+
+(let ((V_3 (vector (lambda (a) (values a 321)))))
+  (define (f1)
+    (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (V_3 0 'a))))
+  (test (f1) 'error)) ; #t))
+
+(let ((V_4 (let ((v (make-vector '(2 2))))
+	     (vector-set! v 0 0 (lambda (a) (values a 321)))
+	     v)))
+  (test (s7-optimize '((vector-ref V_3 0 'a))) #<undefined>)
+  (test (s7-optimize '((V_3 0 'a))) #<undefined>)
+  (test (s7-optimize '((vector-ref V_4 0 0 'a))) #<undefined>)
+  (test (s7-optimize '((V_4 0 0 'a))) #<undefined>))
+
+(let ((V_3 (vector (lambda (a) (values a 321)))))
+  (define (f11) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (vector-ref V_3 0 'a))))
+  (test (f11) 'error)) ;#t))
+
+(test (s7-optimize '((vector-ref => 0 'a))) #<undefined>) ; will be error afterwards
+
+(let ((V_4 (let ((v (make-vector '(2 2))))
+	     (vector-set! v 0 0 (lambda (a) (values a 321)))
+	     v)))
+  (define (f2) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (V_4 0 0 'a))))
+  (test (f2) 'error) ; #t)
+
+  (define (f22) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (vector-ref V_4 0 0 'a))))
+  (test (f22) 'error)) ;#t))
+
+(let ()
+  (define (fs5)
+    (let ((v (vector (inlet 'a 0))))
+      (set! (v 0 'a) (ictr))
+      (v 0 'a)))
+  (test (fs5) 'error)
+  (test (fs5) 'error))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; let
+;;; let*
+;;; letrec
+;;; letrec*
+;;; --------------------------------------------------------------------------------
+
+(test (let ((x 2) (y 3)) (* x y)) 6)
+(test (let ((x 32)) (let ((x 3) (y x)) y)) 32)
+(test (let ((x 32)) (let* ((x 3) (y x)) y)) 3)
+(test (let ((x 2) (y 3)) (let ((x 7) (z (+ x y))) (* z x))) 35)
+(test (let ((x 2) (y 3)) (let* ((x 7)  (z (+ x y))) (* z x))) 70)
+(test (letrec ((is-even (lambda (n)  (if (zero? n) #t (is-odd (- n 1))))) (is-odd (lambda (n)  (if (zero? n) #f (is-even (- n 1)))))) (is-even 88))  #t)
+(test (let loop ((numbers '(3 -2 1 6 -5))
+		 (nonneg ())
+		 (neg ()))
+	(cond ((null? numbers)
+	       (list nonneg neg))
+	      ((>= (car numbers) 0)
+	       (loop (cdr numbers) (cons (car numbers) nonneg)  neg))
+	      ((< (car numbers) 0)
+	       (loop (cdr numbers) nonneg (cons (car numbers) neg)))))
+      '((6 1 3) (-5 -2)))
+(test(let((i 1)(j 2))(+ i j))3)
+
+(test (let ((x 3)) (define x 5) x) 5)
+(test (let* () (define x 8) x) 8)
+(test (letrec () (define x 9) x) 9)
+(test (letrec ((x 3)) (define x 10) x) 10)
+(test (let foo () 1) 1)
+(test (let ((f -)) (let f ((n (f 1))) n)) -1)
+(test (let () 1 2 3 4) 4)
+(test (+ 3 (let () (+ 1 2))) 6)
+
+(test (let ((x 1)) (let ((x 32) (y x)) y)) 1)
+(test (let ((x 1)) (letrec ((y (if #f x 1)) (x 32)) 1)) 1)
+(test (let ((x 1)) (letrec ((y (lambda () (+ 1 x))) (x 32)) (y))) 33)
+(test (let ((x 1)) (letrec ((y (* 0 x)) (x 32)) y)) 'error)
+(test (let* ((x 1) (f (letrec ((y (lambda () (+ 1 x))) (x 32)) y))) (f)) 33)
+(test (letrec ((x 1) (y (let ((x 2)) x))) (+ x y)) 3)
+(test (letrec ((f (lambda () (+ x 3))) (x 2)) (f)) 5)
+(test (let* ((x 1) (x 2)) x) 2)
+(test (let* ((x 1) (y x)) y) 1)
+(test (let ((x 1)) (let ((x 32) (y x)) (+ x y))) 33)
+(test (let ((x 1)) (let* ((x 32) (y x)) (+ x y))) 64)
+(test (let ((x 'a) (y '(b c))) (cons x y)) '(a b c))
+(test (let ((x 0) (y 1)) (let ((x y) (y x)) (list x y))) (list 1 0))
+(test (let ((x 0) (y 1)) (let* ((x y) (y x)) (list x y))) (list 1 1))
+(test (letrec ((sum (lambda (x) (if (zero? x) 0 (+ x (sum (- x 1))))))) (sum 5)) 15)
+(test (let ((divisors (lambda (n) (let f ((i 2)) (cond ((>= i n) ()) ((integer? (/ n i)) (cons i (f (+ i 1)))) (else (f (+ i 1)))))))) (divisors 32)) '(2 4 8 16))
+(test (let ((a -1)) (let loop () (if (not (positive? a)) (begin (set! a (+ a 1)) (loop)))) a) 1)
+(test (let () (let () (let () ()))) ())
+(test (let ((x 1)) (let ((y 0)) (begin (let ((x (* 2 x))) (set! y x))) y)) 2)
+(test (let* ((x 1) (x (+ x 1)) (x (+ x 2))) x) 4)
+(test (let ((.. 2) (.... 4) (..... +)) (..... .. ....)) 6)
+(test (let ((\"a\"")) \) "a\"")
+(test (let* ((a 1) (b a) (a 2) (c a)) (list a b c)) '(2 1 2))
+(test (let* ((a 1) (b (let ((a 2)) a)) (c (+ a 3))) (list a b c)) '(1 2 4))
+(test (let* ((a 1) (b (let ((a 2)) a)) (c a) (a (+ a 4))) (list a b c)) '(5 2 1))
+
+(test (let () (begin (define x 1)) x) 1)
+(test (let ((y 1)) (begin (define x 1)) (+ x y)) 2)
+(test (let ((: 0)) (- :)) 0)
+(test (symbol? (with-input-from-string ":" read)) #t)
+(test (let ((: 3)) :) 3)
+(test (keyword? ':) #f)
+(test (symbol->keyword ':) '::) ; which is not a keyword!! -- '::: is -- this is getting ugly
+(test (let () (define : 3) :) 3)
+(test (let hi x 1) 'error)
+(test (letrec ((x)) 1) 'error)
+(test (letrec ((v (vector v))) v) #(#<undefined>)) ; Guile returns #(#<unspecified>) -- isn't this a reference to v which r7rs claims is an error? Chicken gives an error.
+(test (letrec* ((v1 (vector v2)) (v2 (vector v1))) (list v1 v2)) (list #(#<undefined>) #(#(#<undefined>)))) ; same as above?
+(test (let ((i (catch #t (lambda () 1) (lambda (t i) 'error))) (j 2)) (+ i j)) 3)
+(test (let ((j 2) (i (catch #t (lambda () 1) (lambda (t i) 'error)))) (+ i j)) 3)
+(test (let* loop ((i 0) (j 0)) (if (> i 3) (+ i j) (loop :j 2 :i (+ i 1)))) 6)
+
+;;; srfi 245 example
+(let ((x 0))
+  (set! x (+ x 2))
+  (define var1 (- x 1))
+  (set! x (+ x 1))
+  (set! x (+ x var1))
+  (define var2 (+ var1 x))
+  (define var3 (+ var2 var1))
+  (set! x (+ x var3))
+  (test x 10))
+
+(let ((x 0))
+  (letrec* ((var1 (begin (set! x 2) (- x 1)))
+  	    (var2 (begin (set! x (+ x 1)) (set! x (+ x var1)) (+ var1 x)))
+	    (var3 (+ var2 var1)))
+    (set! x (+ x var3))
+    (test x 10)))
+
+(test (let () (define x 1) (define x (+ x 1)) (curlet)) (inlet 'x 2))
+
+(let ((err (catch #t (lambda () (let ((x 1) (x 3)) x)) (lambda (type info) (apply format #f info)))))
+  (test err "duplicate identifier in let: x in (let ((x 1) (x 3)) x)"))
+
+;;; optimizer troubles
+(test (let () (define (f x) (let asd ())) (f 1)) 'error)
+(test (let () (define (f x) (let ())) (f 1)) 'error)
+
+(test (let ((pi 3)) pi) 'error)
+(test (let ((:key 1)) :key) 'error)
+(test (let () (define (f) (do ((__i__ 0 (+ __i__ 1))) ((= __i__ 1) 'error) (let ((:key 1)) :key))) (f)) 'error) ; do_let
+(test (let ((:3 1)) 1) 'error)
+(test (let ((3 1)) 1) 'error)
+(test (let ((3: 1)) 1) 'error)
+(test (let ((optional: 1)) 1) 'error)
+(test (let ((x_x_x 32)) (let () (define-constant x_x_x 3) x_x_x) (set! x_x_x 31) x_x_x) 31) ; changed 18-Sep-17
+(test (let ((x 1)) (+ (let ((a (begin (define x 2) x))) a) x)) 4)
+(test (let ((x 1)) (+ (letrec ((a (begin (define x 2) x))) a) x)) 3)
+(test (let ((a #<eof>)) (eof-object? a)) #t)
+(test (let ((a #<unspecified>)) (eq? a #<unspecified>)) #t)
+(test (let* ((x 1) (x (+ x 1))) x) 2) ; ??
+(test (object->string (let* ((a 1) (e (curlet)) (b (+ a 1))) e)) "(inlet 'a 1)")
+(let ()
+  (define (f) (let* ((a 1) (e (curlet)) (b (+ a 1))) e))
+  (define (g) (do ((v (vector #f)) (i 0 (+ i 1))) ((= i 1) (v 0)) (vector-set! v 0 (f))))
+  (test (object->string (g)) "(inlet 'a 1)"))
+
+(test (let _name_ ((x 1) (y (_name_ 2))) (+ x y)) 'error)
+(test (let* _name_ ((x 1) (y (_name_ 2))) (+ x y)) 'error)
+(let () (define (hi) (let* named-let ((i 0) (j (+ i 1))) j)) (hi) (test (hi) 1))
+
+(let () ; permanent let* opt
+  (define (fls) (let* ((a 1) (b (* 2 a))) (+ a b)))
+  (fls)
+  (test (fls) 3)
+  (test (fls) 3)
+  (define (fls1) (let* ((a 1) (b (* 2 a))) (let ((z (+ a b))) z)))
+  (fls1)
+  (test (fls1) 3)
+  (test (fls1) 3))
+
+(let ()
+  (define (f1 x) (let* ((a (+ x 1)) (a (* a 2)) (a ((lambda () (+ a 1)))) (a (- a))) a))
+  (test (f1 2) -7)
+  (test (f1 3) -9)
+  (define (f2 x) (let* ((a (+ x 1)) (a (* a 2)) (a1 (lambda () (+ a 1))) (a (* a 3)) (a2 (lambda () (+ a (a1))))) (+ a (a1) (a2))))
+  (test (f2 2) 50)
+  (define (f3 x) (let* ((a (+ x 1)) (a (* a 2)) (a1 (lambda () (+ a 1))) (a (* a 3)) (a1 (lambda () (+ a (a1))))) (+ a (a1))))
+  (test (f3 2) 43))
+
+;; from lisp bboard
+(test (let ((x 1) (y 2)) (let ((x y) (y x)) (let ((x y) (y x)) (let ((x y) (y x)) (+ (* x x) y))))) 5)
+
+(test (let* ((x 1) (fx (lambda () x)) (y (define x (* x 2))) (fy (lambda () (* x y)))) (list x y (fx) (fy))) '(2 2 1 4))
+
+;; from r7rs errata
+(let ()
+  (let ((ton '(3 (1 4))))
+    (letrec*
+	((mean
+	  (lambda (f g)
+	    (f (/ (sum g ton) n))))
+	 (sum
+	  (lambda (g ton)
+	    (if (null? ton)
+		(+)
+		(if (number? ton)
+		    (g ton)
+		    (+ (sum g (car ton))
+		       (sum g (cdr ton)))))))
+	 (n (sum (lambda (x) 1) ton)))
+      (num-test (mean values values) 8/3)
+      (num-test (mean exp log) 2.289428485106664)
+      (num-test (mean / /) 36/19))))
+
+(let () ; guile-user
+  (define (f x)
+    (letrec ((even (lambda (n) (if (= n 0) #t (odd (- n 1)))))
+             (odd  (lambda (n) (if (= n 0) #f (even (- n 1))))))
+      (cond ((even x) 20) ((odd x) 30) (else 40))))
+   (test (f 31) 30)
+   (test (f 30) 20))
+
+(test ((let ((x 2))
+	 (let ((x 3))
+	   (lambda (arg) (+ arg x))))
+       1)
+      4)
+
+(test ((let ((x 2))
+	 (define (inner arg) (+ arg x))
+	 (let ((x 32))
+	   (lambda (arg) (inner (+ arg x)))))
+       1)
+      35)
+
+(test ((let ((inner (lambda (arg) (+ arg 1))))
+	 (let ((inner (lambda (arg) (inner (+ arg 2)))))
+	   inner))
+       3)
+      6)
+
+(test ((let ()
+	 (define (inner arg) (+ arg 1))
+	 (let ((inner (lambda (arg) (inner (+ arg 2)))))
+	   inner))
+       3)
+      6)
+
+(test ((let ((x 11))
+	 (define (inner arg) (+ arg x))
+	 (let ((inner (lambda (arg) (inner (+ (* 2 arg) x)))))
+	   inner))
+       3)
+      28)
+
+(test ((let ((x 11))
+	 (define (inner arg) (+ arg x))
+	 (let ((x 2))
+	   (lambda (arg) (inner (+ (* 2 arg) x)))))
+       3)
+      19)
+
+(test (let ((f1 (lambda (arg) (+ arg 1))))
+	(let ((f1 (lambda (arg) (f1 (+ arg 2)))))
+	  (f1 1)))
+      4)
+
+(test (let ((f1 (lambda (arg) (+ arg 1))))
+	(let* ((f1 (lambda (arg) (f1 (+ arg 2)))))
+	  (f1 1)))
+      4)
+
+(test (let ((f1 (lambda (arg) (+ arg 1))))
+	(let* ((x 32)
+	       (f1 (lambda (arg) (f1 (+ x arg)))))
+	  (f1 1)))
+      34)
+
+(test ((let ((x 11))
+	 (define (inner arg) (+ arg x))
+	 (let ((x 2)
+	       (inner (lambda (arg) (inner (+ (* 2 arg) x)))))
+	   inner))
+       3)
+      28)
+
+(test ((let ((x 11))
+	 (define (inner arg) (+ arg x))
+	 (let* ((x 2)
+		(inner (lambda (arg) (inner (+ (* 2 arg) x)))))
+	   inner))
+       3)
+      19)
+
+(test (let ((x 1))
+	(let* ((f1 (lambda (arg) (+ x arg)))
+	       (x 32))
+	  (f1 1)))
+      2)
+
+(test (let ((inner (lambda (arg) (+ arg 1))))
+	(let ((inner (lambda (arg) (+ (inner arg) 1))))
+	  (inner 1)))
+      3)
+(test (let ((inner (lambda (arg) (+ arg 1))))
+	(let* ((inner (lambda (arg) (+ (inner arg) 1))))
+	  (inner 1)))
+      3)
+
+(test (let ((caller #f)) (let ((inner (lambda (arg) (+ arg 1)))) (set! caller inner)) (caller 1)) 2)
+(test (let ((caller #f)) (let ((x 11)) (define (inner arg) (+ arg x)) (set! caller inner)) (caller 1)) 12)
+
+(test (let ((caller #f))
+	(let ((x 11))
+	  (define (inner arg)
+	    (+ arg x))
+	  (let ((y 12))
+	    (let ((inner (lambda (arg)
+			   (+ (inner x) y arg)))) ; 11 + 11 + 12 + arg
+	      (set! caller inner))))
+	(caller 1))
+      35)
+
+(test (let ((caller #f))
+	(let ((x 11))
+	  (define (inner arg)
+	    (+ arg x))
+	  (let* ((y 12)
+		 (inner (lambda (arg)
+			  (+ (inner x) y arg)))) ; 11 + 11 + 12 + arg
+	    (set! caller inner)))
+	(caller 1))
+      35)
+
+(let ()
+  (define (f)
+    (let ((f1 (lambda (arg) (+ arg 1))))
+      (let* ((x 32)
+	     (f1 (lambda (arg) (f1 (+ x arg)))))
+	(f1 1))))
+  (test (f) 34))
+
+(test (let* ((f1 3) (f1 4)) f1) 4)
+(test (let ((f1 (lambda () 4))) (define (f1) 3) (f1)) 3)
+
+(test (let ((j -1)
+	    (k 0))
+	(do ((i 0 (+ i j))
+	     (j 1))
+	    ((= i 3) k)
+	  (set! k (+ k i))))
+      3)
+
+(test (let ((j (lambda () -1))
+	    (k 0))
+	(do ((i 0 (+ i (j)))
+	     (j (lambda () 1)))
+	    ((= i 3) k)
+	  (set! k (+ k i))))
+      3)
+
+
+(test (let ((j (lambda () 0))
+	    (k 0))
+	(do ((i (j) (j))
+	     (j (lambda () 1) (lambda () (+ i 1))))
+	    ((= i 3) k)
+	  (set! k (+ k i))))
+      3) ; 6 in Guile which follows the spec
+
+(test (let ((k 0)) (do ((i 0 (+ i 1)) (j 0 (+ j i))) ((= i 3) k) (set! k (+ k j)))) 1)
+
+#|
+(test (let ((j (lambda () 0))
+	    (i 2)
+	    (k 0))
+	(do ((i (j) (j))
+	     (j (lambda () i) (lambda () (+ i 1))))
+	    ((= i 3) k)
+	  (set! k (+ k i))))
+      3) ; or 2?
+
+(test (let ((f #f))
+	(do ((i 0 (+ i 1)))
+	    ((= i 3))
+	  (let ()
+	    (define (x) i)
+	    (if (= i 1) (set! f x))))
+	(f))
+      1)
+|#
+
+(test (let ((x 1))
+	(let ()
+	  (define (f) x)
+	  (let ((x 0))
+	    (define (g) (set! x 32) (f))
+	    (g))))
+      1)
+
+(test (let ((a 1))
+	(let ()
+	  (if (> a 1)
+	      (begin
+		(define a 2)))
+	  a))
+      1)
+
+(test (let ((a 1))
+	(let ()
+	  (if (= a 1)
+	      (begin
+		(define a 2)))
+	  a))
+      2)
+
+(let ((x 123))
+  (define (hi b) (+ b x))
+  (let ((x 321))
+    (test (hi 1) 124)
+    (set! x 322)
+    (test (hi 1) 124))
+  (set! x 124)
+  (test (hi 1) 125)
+  (let ((x 321)
+	(y (hi 1)))
+    (test y 125))
+  (let* ((x 321)
+	 (y (hi 1)))
+    (test y 125))
+  (test (hi 1) 125))
+
+(test (let ((j 0)
+	    (k 0))
+	(let xyz
+	    ((i 0))
+	  (let xyz
+	      ((i 0))
+	    (set! j (+ j 1))
+	    (if (< i 3)
+		(xyz (+ i 1))))
+	  (set! k (+ k 1))
+	  (if (< i 3)
+	      (xyz (+ i 1))))
+	(list j k))
+      (list 16 4))
+
+(test (let ((x 123)) (begin (define x 0)) x) 0) ; this strikes me as weird, since (let ((x 123) (x 0)) x) is illegal, so...
+(test (let ((x 0)) (define x 1) (define x 2) x) 2)
+(test (let ((x 123)) (begin (define (hi a) (+ x a)) (define x 0)) (hi 1)) 1) ; is non-lexical reference?
+(test (let ((x 123)) (define (hi a) (+ x a)) (define x 0) (hi 1)) 1)
+(test (let ((x 123) (y 0)) (define (hi a) (+ y a)) (define y x) (define x 0) (hi 1)) 124)
+(test (let () (define (sv x) x) (define (func) (let ((x -1) (i 0)) (sv (inlet  'x #f :ho (abs x))))) (func)) (inlet 'x #f 'ho 1)) ; fx_inlet_ca local_slot bug
+
+(let ()
+  (define (frame1 n)
+    (let ((_p_ (curlet))
+          (out _p_))
+       (format #t "frame1 (2) _p_: ~S, out: ~S~%" _p_ out))) ; frame1 above is do, this is let
+   (define (frame2) (frame1 1))
+   (catch #t
+     (lambda ()
+       (let ((result (frame1 1)))
+         (format *stderr* "frame1 (2): ~S?\n" result)))
+     (lambda (type info)
+       (unless (and (eq? type 'unbound-variable)
+                    (string=? (substring (apply format #f info) 0 20) "unbound variable _p_"))
+         (format *stderr* "frame1 (2): ~S ~S~%" type (apply format #f info)))))
+   (catch #t
+     (lambda ()
+       (let ((result (frame2)))
+         (format *stderr* "frame2 (2): ~S?\n" result)))
+     (lambda (type info)
+       (unless (and (eq? type 'unbound-variable)
+                    (string=? (substring (apply format #f info) 0 20) "unbound variable _p_"))
+         (format *stderr* "frame2 (2): ~S ~S~%" type (apply format #f info))))))
+
+(let () ; from scheme bboard
+  (define (make-accum n) (lambda* (m) (if m (set! n (+ n m)) n)))
+  (let ((x (make-accum 2)))
+    (test (x) 2) (test (x 1) 3) (test (x) 3)
+    (let ((y (make-accum 12))) (test (y) 12) (test (y 12) 24) (test (y) 24)
+      (test (x) 3))))
+
+(let () ; should hit fx_car_t rest out of date if debugging (from op_let_3a_new) from K Matheussen
+  (define (make-assoc-from-flat-list3 rest)
+    (if (null? rest) ()
+	(let ((A (car rest))
+              (B (cadr rest))
+              (Rest (cddr rest)))
+          (cons (list A B)
+		(make-assoc-from-flat-list3 Rest)))))
+  (make-assoc-from-flat-list3
+   (list "asdf"
+	 (list (lambda () 50) (lambda () 60))
+	 "---------- " (lambda x 70)
+	 "asd" (list (lambda () 80) (lambda () 90)))))
+
+(let ()
+  (define (f1) (let ((f #f)) (do ((i 0 (+ i 1))) ((= i 3)) (let ((x (+ i 1))) (if (= i 2) (set! f (lambda () x))))) (f)))
+  (test (f1) 3))
+(let ()
+  (define (f2) (let ((f #f)) (for-each (lambda (x) (if (= x 2) (set! f (lambda () (+ x 1))))) #(0 1 2 3)) (f)))
+  (test (f2) 3))
+(let ()
+  (define (f3) (let ((f #f)) (map (lambda (x) (if (= x 2) (set! f (lambda () (+ x 1)))) x) #(0 1 2 3)) (f)))
+  (test (f3) 3))
+(let ()
+  (define (f4)
+    (let ((f #f))
+      (define (f4a a b)
+	(if (and (= a 0) (= b 2))
+	    (set! f (lambda () (+ b 1))))
+	(+ (if (> a 0) (f4a (- a 1) b) 0)
+	   (if (> b 0) (f4a a (- b 1)) 0)))
+      (f4a 3 3)
+      (f)))
+  (test (f4) 3))
+
+(for-each
+ (lambda (arg)
+   (test (let ((x arg)) x) arg))
+ (list "hi" -1 #\a "" () #() (current-output-port) 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t abs (list 1 2 3) '(1 . 2)))
+
+(test (let ((x 1)) (= 1 (let ((y 2)) (set! x y) x)) (+ x 1)) 3)
+(test (let ((x 1)) (let ((xx (lambda (a) (set! x a) a))) (= 1 (xx 2))) (+ x 1)) 3)
+(test (let ((x 32)) (begin (define x 123) (define (hi a) (+ a 1))) (hi x)) 124)
+(test (let () (begin (define x 123) (define (hi a) (+ a 1))) (hi x)) 124)
+
+#|
+(let ((initial-chars "aA!$%&*/:<=>?^_~")
+      (subsequent-chars "9aA!$%&*+-./:<=>?@^_~")
+      (ctr 0))
+  (format #t ";(let (")
+  (do ((i 0 (+ i 1)))
+      ((= i (string-length initial-chars)))
+    (format #t ";(~A ~D) " (string (string-ref initial-chars i)) ctr)
+    (set! ctr (+ ctr 1)))
+
+  (do ((i 0 (+ i 1)))
+      ((= i (string-length initial-chars)))
+    (do ((k 0 (+ k 1)))
+	((= k (string-length subsequent-chars)))
+      (format #t ";(~A ~D) " (string (string-ref initial-chars i) (string-ref subsequent-chars k)) ctr)
+      (set! ctr (+ ctr 1))))
+
+  (format #t ")~%  (+ ")
+  (do ((i 0 (+ i 1)))
+      ((= i (string-length initial-chars)))
+    (format #t "~A " (string (string-ref initial-chars i))))
+
+  (do ((i 0 (+ i 1)))
+      ((= i (string-length initial-chars)))
+    (do ((k 0 (+ k 1)))
+	((= k (string-length subsequent-chars)))
+      (format #t "~A " (string (string-ref initial-chars i) (string-ref subsequent-chars k)))))
+  (format #t "))~%"))
+|#
+
+(num-test (let ((a 0) (A 1) (! 2) ($ 3) (% 4) (& 5) (| 8) (? 12) (^ 13) (_ 14) (~ 15) (a9 16) (aa 17) (aA 18) (a! 19) (a$ 20) (a% 21) (a& 22) (a* 23) (a+ 24) (a- 25) (a. 26) (a/ 27) (a| 28) (a< 29) (a= 30) (a> 31) (a? 32) (a@ 33) (a^ 34) (a_ 35) (a~ 36) (A9 37) (Aa 38) (AA 39) (A! 40) (A$ 41) (A% 42) (A& 43) (A* 44) (A+ 45) (A- 46) (A. 47) (A/ 48) (A| 49) (A< 50) (A= 51) (A> 52) (A? 53) (A@ 54) (A^ 55) (A_ 56) (A~ 57) (!9 58) (!a 59) (!A 60) (!! 61) (!$ 62) (!% 63) (!& 64) (!* 65) (!+ 66) (!- 67) (!. 68) (!/ 69) (!| 70) (!< 71) (!= 72) (!> 73) (!? 74) (!@ 75) (!^ 76) (!_ 77) (!~ 78) ($9 79) ($a 80) ($A 81) ($! 82) ($$ 83) ($% 84) ($& 85) ($* 86) ($+ 87) ($- 88) ($. 89) ($/ 90) ($| 91) ($< 92) ($= 93) ($> 94) ($? 95) ($@ 96) ($^ 97) ($_ 98) ($~ 99) (%9 100) (%a 101) (%A 102) (%! 103) (%$ 104) (%% 105) (%& 106) (%* 107) (%+ 108) (%- 109) (%. 110) (%/ 111) (%| 112) (%< 113) (%= 114) (%> 115) (%? 116) (%@ 117) (%^ 118) (%_ 119) (%~ 120) (&9 121) (&a 122) (&A 123) (&! 124) (&$ 125) (&% 126) (&& 127) (&* 128) (&+ 129) (&- 130) (&. 131) (&/ 132) (&| 133) (&< 134) (&= 135) (&> 136) (&? 137) (&@ 138) (&^ 139) (&_ 140) (&~ 141) (*9 142) (*a 143) (*A 144) (*! 145) (*$ 146) (*% 147) (*& 148) (** 149) (*+ 150) (*- 151) (*. 152) (*/ 153) (*| 154) (*< 155) (*= 156) (*> 157) (*? 158) (*@ 159) (*^ 160) (*_ 161) (*~ 162) (/9 163) (/a 164) (/A 165) (/! 166) (/$ 167) (/% 168) (/& 169) (/* 170) (/+ 171) (/- 172) (/. 173) (// 174) (/| 175) (/< 176) (/= 177) (/> 178) (/? 179) (/@ 180) (/^ 181) (/_ 182) (/~ 183) (|9 184) (ca 185) (CA 186) (|! 187) (|$ 188) (|% 189) (|& 190) (|* 191) (|+ 192) (|- 193) (|. 194) (|/ 195) (cc 196) (|< 197) (|= 198) (|> 199) (|? 200) (|@ 201) (|^ 202) (|_ 203) (|~ 204) (<9 205) (<a 206) (<A 207) (<! 208) (<$ 209) (<% 210) (<& 211) (<* 212) (<+ 213) (<- 214) (<. 215) (</ 216) (<| 217) (<< 218) (<> 220) (<? 221) (<@ 222) (<^ 223) (<_ 224) (<~ 225) (=9 226) (=a 227) (=A 228) (=! 229) (=$ 230) (=% 231) (=& 232) (=* 233) (=+ 234) (=- 235) (=. 236) (=/ 237) (=| 238) (=< 239) (== 240) (=> 241) (=? 242) (=@ 243) (=^ 244) (=_ 245) (=~ 246) (>9 247) (>a 248) (>A 249) (>! 250) (>$ 251) (>% 252) (>& 253) (>* 254) (>+ 255) (>- 256) (>. 257) (>/ 258) (>| 259) (>< 260) (>> 262) (>? 263) (>@ 264) (>^ 265) (>_ 266) (>~ 267) (?9 268) (?a 269) (?A 270) (?! 271) (?$ 272) (?% 273) (?& 274) (?* 275) (?+ 276) (?- 277) (?. 278) (?/ 279) (?| 280) (?< 281) (?= 282) (?> 283) (?? 284) (?@ 285) (?^ 286) (?_ 287) (?~ 288) (^9 289) (^a 290) (^A 291) (^! 292) (^$ 293) (^% 294) (^& 295) (^* 296) (^+ 297) (^- 298) (^. 299) (^/ 300) (^| 301) (^< 302) (^= 303) (^> 304) (^? 305) (^@ 306) (^^ 307) (^_ 308) (^~ 309) (_9 310) (_a 311) (_A 312) (_! 313) (_$ 314) (_% 315) (_& 316) (_* 317) (_+ 318) (_- 319) (_. 320) (_/ 321) (_| 322) (_< 323) (_= 324) (_> 325) (_? 326) (_@ 327) (_^ 328) (__ 329) (_~ 330) (~9 331) (~a 332) (~A 333) (~! 334) (~$ 335) (~% 336) (~& 337) (~* 338) (~+ 339) (~- 340) (~. 341) (~/ 342) (~| 343) (~< 344) (~= 345) (~> 346) (~? 347) (~@ 348) (~^ 349) (~_ 350) (~~ 351) )
+	    (+ a A ! $ % & | ? ^ _ ~ a9 aa aA a! a$ a% a& a* a+ a- a. a/ a| a< a= a> a? a@ a^ a_ a~ A9 Aa AA A! A$ A% A& A* A+ A- A. A/ A| A< A= A> A? A@ A^ A_ A~ !9 !a !A !! !$ !% !& !* !+ !- !. !/ !| !< != !> !? !@ !^ !_ !~ $9 $a $A $! $$ $% $& $* $+ $- $. $/ $| $< $= $> $? $@ $^ $_ $~ %9 %a %A %! %$ %% %& %* %+ %- %. %/ %| %< %= %> %? %@ %^ %_ %~ &9 &a &A &! &$ &% && &* &+ &- &. &/ &| &< &= &> &? &@ &^ &_ &~ *9 *a *A *! *$ *% *& ** *+ *- *. */ *| *< *= *> *? *@ *^ *_ *~ /9 /a /A /! /$ /% /& /* /+ /- /. // /| /< /= /> /? /@ /^ /_ /~ |9 ca CA |! |$ |% |& |* |+ |- |. |/ cc |< |= |> |? |@ |^ |_ |~ <9 <a <A <! <$ <% <& <* <+ <- <. </ <| << <> <? <@ <^ <_ <~ =9 =a =A =! =$ =% =& =* =+ =- =. =/ =| =< == => =? =@ =^ =_ =~ >9 >a >A >! >$ >% >& >* >+ >- >. >/ >| >< >> >? >@ >^ >_ >~ ?9 ?a ?A ?! ?$ ?% ?& ?* ?+ ?- ?. ?/ ?| ?< ?= ?> ?? ?@ ?^ ?_ ?~ ^9 ^a ^A ^! ^$ ^% ^& ^* ^+ ^- ^. ^/ ^| ^< ^= ^> ^? ^@ ^^ ^_ ^~ _9 _a _A _! _$ _% _& _* _+ _- _. _/ _| _< _= _> _? _@ _^ __ _~ ~9 ~a ~A ~! ~$ ~% ~& ~* ~+ ~- ~. ~/ ~| ~< ~= ~> ~? ~@ ~^ ~_ ~~ ))
+	  61253)
+
+(test (let ()(+ (let ((x 0) (y 1) (z 2) )(+ x y (let ((x 3) )(+ x (let ()(+ (let ()
+									      (+ (let ((x 0) (y 1) (z 2) )(+ x y z (let ((x 3) )(+ x (let ((x 4) (y 5) (z 6) )
+																       (+ x y z (let ()(+ (let ((x 7) )(+ x (let ()(+ (let ((x 8) (y 9) )
+																							(+ x (let ((x 10) (y 11) (z 12) )(+ x  ))))))))))))))))))))))))))
+      50)
+(test  (let* ((x 0) (y x) )(+ x y (let ()(+ (let ((x 2) )(+ x (let ()(+ (let ((x 4) )
+									  (+ x (let ((x 5) )(+ x (let ((x 6) (y x) (z y) )(+ x (let ((x 7) (y x) )
+																 (+ x (let ((x 8) (y x) )(+ x y (let ((x 9) (y x) (z y) )(+ x ))))))))))))))))))))
+       48)
+(test (let* ((x 0) (y x) )(+ x y (let* ()(+ (let* ((x 2) )(+ x (let* ()(+ (let* ((x 4) )
+									    (+ x (let* ((x 5) )(+ x (let* ((x 6) (y x) (z y) )(+ x (let* ((x 7) (y x) )
+																     (+ x (let* ((x 8) (y x) )(+ x y (let* ((x 9) (y x) (z y) )(+ x ))))))))))))))))))))
+      49)
+
+(test (let ((!@$%^&*~|}{?><.,/`_-+=:! 1)) (+ !@$%^&*~|}{?><.,/`_-+=:! 1)) 2)
+(test (let ((:hi 1)) :hi) 'error)
+(test (let ((:hi: 1)) :hi:) 'error)
+(test (let ((hi: 1)) hi) 'error)
+(let ((1.0+2j (lambda (a) (+ a 1.0+2i)))) (num-test (1.0+2j 3+i) 4.0+3i))
+(test (let ((*1.11* 3)) *1.11*) 3)
+(test (let ((1#2 12)) (+ 1#2 2)) 14)
+(test (let ((1:2 12)) (+ 1:2 2)) 14)
+(test (let ((1,2 12)) (+ 1,2 2)) 14)
+(test (let ((1'2 12)) (+ 1'2 2)) 14)
+(test (let ((1`2 12)) (+ 1`2 2)) 14)
+
+(test (let func ((a 1) (b 2)) (set! b a) (if (> b 0) (func (- a 1) b)) b) 1)
+(test (let func ((a 1) (b 2)) (set! b a) (if (> b 0) (func (- a 1) b) b)) 0)
+(test (let loop ((numbers '(3 -2 1 6 -5))
+		 (nonneg ())
+		 (neg ()))
+	(cond ((null? numbers) (list nonneg neg))
+	      ((>= (car numbers) 0)
+	       (loop (cdr numbers)
+		     (cons (car numbers) nonneg)
+		     neg))
+	      ((< (car numbers) 0)
+	       (loop (cdr numbers)
+		     nonneg
+		     (cons (car numbers) neg)))))
+      '((6 1 3) (-5 -2)))
+(test (let ((b '(1 2 3)))
+	(let* ((a b)
+	       (b (cons 0 a)))
+	  (let b ((a b))
+	    (if (null? a)
+		'done
+		(b (cdr a))))))
+      'done)
+(test (let lp ((x 100))
+	(if (positive? x)
+	    (lp (- x 1))
+	    x))
+      0)
+(test (let func ((a 1) (b 2) (c 3)) (+ a b c (if (> a 1) (func (- a 1) (- b 1) (- c 1)) 0))) 6)
+(test (let func ((a 1) (b 2) (c 3)) (+ a b c (if (> a 1) (func (- a 1) (- b 1)) 0))) 6) ; these work only because we don't try to call func -- maybe they should anyway?
+(test (let func ((a 1) (b 2) (c 3)) (+ a b c (if (> a 1) (func (- a 1)) 0))) 6)
+(test (let func ((a 1) (b 2) (c 3)) (+ a b c (if (> a 1) (func) 0))) 6)
+(test (let func ((a 1) (b 2) (c 3)) (+ a b c (if (> a 0) (func (- a 1) (- b 1) (- c 1)) 0))) 9)
+
+(test (let func ((a 1) (b 2) (c 3)) (+ a b c (if (> a 0) (func (- a 1) (- b 1)) 0))) 'error)
+(test (let func () 1) 1)
+(test (let ((a 1)) (let func () (if (> a 1) (begin (set! a (- a 1)) (func)) 0))) 0)
+(test (let func1 ((a 1)) (+ (let func2 ((a 2)) a) a)) 3)
+(test (let func1 ((a 1)) (+ (if (> a 0) (func1 (- a 1)) (let func2 ((a 2)) (if (> a 0) (func2 (- a 1)) 0))) a)) 1)
+(test (let func ((a (let func ((a 1)) a))) a) 1)
+(test (let ((i 3)) (let func () (set! i (- i 1)) (if (> i 0) (func))) i) 0)
+(test (let func ((a 1)) (define (func a) 2) (func 1)) 2)
+(test (let func ((a 1)) (define func (lambda (a) (func a))) (if (> a 1) (func (- a 1)) 0)) 0)
+(test (let loop ((i 0)) (let loop ((i 0)) (if (< i 1) (loop (+ i 1)))) i) 0)
+(test (let ((j 123)) (define (f g) (set! j 0) (g 0)) (let loop ((i 1)) (if (> i 0) (f loop))) j) 0)
+(test (procedure? (let loop () loop)) #t)
+(test (let loop1 ((func 0)) (let loop2 ((i 0)) (if (not (procedure? func)) (loop1 loop2)) func)) 0)
+(test (let ((k 0)) (let ((x (let xyz ((i 0)) (set! k (+ k 1)) xyz))) (x 0)) k) 2)
+(test (let ((hi' 3) (a'b 2)) (+ hi' a'b)) 5)
+(test (let ((hi''' 3) (a'''b 2)) (+ hi''' a'''b)) 5)
+(test (let ((f (let func ((i 0)) (if (= i 0) func (if (> i 1) (+ i (func (- i 1))) 1))))) (map f '(1 2 3))) '(1 3 6))
+(test (let ((x 0)) (let ((f (lambda (a) (+ a x)))) (map (let () (set! x (+ x 1)) f) '(1 2 3)))) '(2 3 4))
+(test (let x ((x (lambda (y) y))) (x 2)) 2)
+(test (let ((x 123)) (let x ((x x)) x)) 123)
+
+(test (let () (define (f4) (let loop ((i 0)) (set! loop 3) loop)) (f4)) 3)
+(test (let () (define (f5) (let loop ((i 0)) (set! loop (lambda () 2)) (loop))) (f5)) 2)
+(test (let () (define (f6) (let loop ((i 0)) (define (loop) 2) (loop))) (f6)) 2)
+
+(test (let ((f1 (lambda () (x)))) (define (x) 2) (f1)) 'error)
+(test (let ((f1 (lambda () (x))) (x (lambda () 2))) (f1)) 'error)
+(test (let () (define (f1) (x)) (define (x) 2) (f1)) 2)
+(test (let () (define (f1) x) (define x 2) (f1)) 2)
+(test (letrec ((f1 (lambda () (x))) (x (lambda () 2))) (f1)) 2)
+(test (letrec ((f1 (lambda () x)) (x 2)) (f1)) 2)
+(test (letrec* ((f1 (lambda () (x))) (x (lambda () 2))) (f1)) 2)
+(test (letrec* ((f1 (lambda () x)) (x 2)) (f1)) 2)
+(test (letrec ((f1 (lambda () (x)))) (define (x) 2) (f1)) 2)     ; Guile: x unbound
+(test (letrec* ((f1 (lambda () (x)))) (define (x) 2) (f1)) 2)    ; same
+(test (letrec ((f1 (lambda () x))) (define x 2) (f1)) 2)         ; same
+(test (letrec* ((f1 (lambda () x))) (define x 2) (f1)) 2)        ; same
+
+(test (let () (let ((a (lambda () x))) (let  ((b (define x 2))) (a)))) 'error)
+(test (let () (let* ((a (lambda () x)) (b (define x 2))) (a))) 'error)
+(test (let () (let ((a (lambda () x))) (define x 2) (a))) 'error)
+
+(let ((enter 0)
+      (exit 0)
+      (inner 0))
+  (define (j1)
+    (set! enter (+ enter 1))
+    (let ((result
+	   (let hiho
+	       ((i 0))
+	     (set! inner (+ inner 1))
+	     (if (< i 3)
+		 hiho
+		 i))))
+      (set! exit (+ exit 1))
+      result))
+
+  (let ((j2 (j1)))
+    (test (and (procedure? j2) (= enter 1) (= exit 1) (= inner 1)) #t)
+    (let ((result (j2 1)))
+      (test (and (procedure? result) (= enter 1) (= exit 1) (= inner 2)) #t)
+      (set! result (j2 3))
+      (test (and (= result 3) (= enter 1) (= exit 1) (= inner 3)) #t))))
+
+
+(let ()
+  (define (block-comment-test a b c)
+    (+ a b c))
+
+  (let ((val (block-comment-test
+#|
+	    a comment
+|#
+	    1 #| this is a |#
+#|
+            another comment
+|#
+ 2 #| this is b |# 3)))
+
+    (test val 6)))
+
+
+(test (letrec* ((p (lambda (x)
+		     (+ 1 (q (- x 1)))))
+		(q (lambda (y)
+		     (if (zero? y)
+			 0
+			 (+ 1 (p (- y 1))))))
+		(x (p 5))
+		(y x))
+	y)
+      5)
+(test (letrec ((p (lambda (x)
+		     (+ 1 (q (- x 1)))))
+	       (q (lambda (y)
+		    (if (zero? y)
+			0
+			(+ 1 (p (- y 1))))))
+	       (x (p 5))
+	       (y x))
+	y)
+      'error)
+(test (let* ((p (lambda (x)
+		     (+ 1 (q (- x 1)))))
+	     (q (lambda (y)
+		  (if (zero? y)
+		      0
+		      (+ 1 (p (- y 1))))))
+	     (x (p 5))
+	     (y x))
+	y)
+      'error)
+
+(test (let ((x 1) ((y 2))) x) 'error)
+(test (let ((x 1 2 3)) x) 'error)
+(test (let ((+ 1 2)) 2) 'error)
+(test (let* ((x 1 2)) x) 'error)
+(test (letrec ((x 1 2)) x) 'error)
+(test (letrec* ((x 1 2)) x) 'error)
+(test (let ((x 1 . 2)) x) 'error)
+(test (let ((x 1 , 2)) x) 'error)
+(test (let ((x . 1)) x) 'error)
+(test (let* ((x . 1)) x) 'error)
+(test (letrec ((x . 1)) x) 'error)
+(test (letrec* ((x . 1)) x) 'error)
+(test (let hi ()) 'error)
+(test (let* ((x -1) 2) 3) 'error)
+(test (let ((x -1) 2) 3) 'error)
+(test (letrec ((x -1) 2) 3) 'error)
+(test (let ((pi 3)) pi) 'error)
+(test (let* ((pi 3)) pi) 'error)
+(test (letrec ((pi 3)) pi) 'error)
+(test (let ((#_abs 3)) #_abs) 'error) ;"variable name #_abs in let is a function, not a symbol"
+
+(test (let ((a 1) (a 2)) a) 'error)
+(test (letrec ((a 1) (a 2)) a) 'error)
+(test (letrec* ((a 1) (a 2)) a) 'error)
+(test (let* ((a 1) (a (+ a 1))) a) 2) ; ??
+
+(test (let* hi () . =>) 'error)
+(test (let hi () . =>) 'error)
+
+(test (let hiho ((a 3) (hiho 4)) a) 3)
+(test (let hiho ((hiho 4)) hiho) 4)                ; guile=4
+(test (let hiho ((hiho hiho)) hiho) 'error)        ; guile sez error
+(test (let ((hiho 4) (hiho 5)) hiho) 'error)       ; guile sez error
+(test (let hiho ((a (hiho 1))) a) 'error)          ; guile sez error
+(test (let hiho ((hiho 3)) (hiho hiho)) 'error)    ; guile sez error
+
+(let () ; check that inner let is stable across optimization
+  (define (f)
+    (let func1 ()
+      (+ 1 2 (let* func2 ((a -1) (b (- a 1)))
+                (if (< a 0) (func2 (+ a 1) 0) b)))))
+  (test (f) 3))
+
+(test (let) 'error)
+(test (let*) 'error)
+(test (letrec) 'error)
+(test (let . 1) 'error)
+(test (let* (x)) 'error)
+(test (let (x) 1) 'error)
+(test (let ((x)) 3) 'error)
+(test (let ((x 1) y) x) 'error)
+(test (let* x ()) 'error)
+(test (let* ((1 2)) 3) 'error)
+(test (let () ) 'error)
+(test (let '() 3) 'error)
+(test (let* ((x 1))) 'error)
+(test (let ((x 1)) (letrec ((x 32) (y x)) (+ 1 y))) 'error) ; #<unspecified> seems reasonable if not the 1+
+(test (let ((x 1)) (letrec ((y x) (x 32)) (+ 1 y))) 'error)
+(test (let ((x 1)) (letrec ((y x) (x 32)) 1)) 1)
+(test (let ((x 1)) (letrec ((y (let () (+ x 1))) (x 32)) (+ 1 y))) 'error)
+(test (let ((x 1)) (letrec ((y (let ((xx (+ x 1))) xx)) (x 32)) (+ 1 y))) 'error)
+(test (let ((x 32)) (letrec ((y (apply list `(* ,x 2))) (x 1)) y)) '(* #<undefined> 2))
+(test (letrec) 'error)
+(test (letrec*) 'error)
+(test (let ((x . 1)) x) 'error)
+(test (letrec* ((and #2d((1 2) (3 4)) 3/4))) 'error)
+(test (letrec* ((hi "" #\a))) 'error)
+
+(let ()  ;; this hits op_letrec_star_unchecked independent of op_letrec_star
+  (define (f1)
+    (letrec* ((x (apply + (list 1 2)))
+	      (y (list-values x x)))
+      (catch #t
+	(lambda ()
+	  (+ x (apply * y)))
+	(lambda (type info)
+	  #f))))
+  (f1)
+  (test (f1) 12))
+
+(let ((f2 #<undefined>))
+  (letrec ((f1 (lambda (x)
+		 (if (positive? x)
+		     (f2 (- x 1))  ; this is a forward ref to f2 below, Guile (1.8.7)/Chicken say f2 unbound, s7/chibi are happy
+		     0))))
+    (define (f2 x)
+      (if (positive? x)
+	  (f1 (- x 1))
+	  0))
+    (test (f1 3) 0)))
+
+(let ((f2 #<undefined>))
+  (let ((f1 (lambda (x)
+	      (if (positive? x)
+		  (f2 (- x 1)) 0)))) ; unbound -- this is the outer env
+    (define (f2 x)
+      (if (positive? x)
+	  (f1 (- x 1)) 0))
+    (test (f1 3) 'error)))
+
+(let ((f2 #<undefined>))
+  (letrec ((f1 (lambda (x)            ; s7/Chicken/Guile/chibi happy
+		 (if (positive? x)
+		     (f2 (- x 1)) 0)))
+	   (f2 (lambda (x)
+		 (if (positive? x)
+		     (f1 (- x 1)) 0))))
+    (test (f1 3) 0)))
+
+(let ((f2 #<undefined>))
+  (letrec ((f1 (lambda (x)
+		 (if (positive? x)
+		     (f1 (- x f2)) 0)))) ; so anything subsequently added to this env is already here ?
+    (define f2 1)
+    (test (f1 3) 0)))
+
+(let ((f2 #<undefined>))
+  (letrec ((f1 (lambda (x)
+		 (if (positive? x)
+		     (f1 (- x f2)) 0))))
+    (test (f1 3) 'error)                ; nope -- depends on ordering
+    (define f2 1)))
+
+(let ((f2 0))
+  (letrec ((f1 (lambda () f2)))
+    (test (f1) 0)
+    (define f2 1)
+    (test (f1) 1)))                     ; s7: 0 1, Chicken: 0 0, chibi: 1 1, Guile 1.8: "bad define placement", Guile 2.0: define in expression context
+					;  Gauche also complains about define's placement, as does chibi (a warning)
+
+(let ((f2 0))                           ; s7 01, chibi #<undef>1, chicken/guile 1.8 no letrec*, Guile 2.0.13/Gauche: 00
+  (letrec* ((f1 (lambda () f2))
+	    (fx (begin (test (f1) 0) 3)))
+    (define f2 1)
+    (test (f1) 1)))
+
+(let ((f2 0))
+  (letrec ((f1 (lambda () f2)))
+    (letrec ((fx (begin (test (f1) 0) 3)))
+      (define f2 1)
+      (test (f1) 0))))                  ; s7 00, guile 1.8/2.0 00, chicken 00, chibi 00, gauche 00
+
+(let ((f2 0))
+  (letrec ((f1 (lambda () f2)))
+    (define f2 (let () (test (f1) 0) 1))
+    (test (f1) 1)))                     ; s7 01, guile 1.8/2.0 00, chicken 00, chibi #<undef>1, gauche 00
+
+(let ((f2 (lambda () 0)))
+  (letrec ((f1 (lambda () (f2))))
+    (define f2 (let () (test (f1) 0) (lambda () 1)))
+    (test (f1) 1)))                     ; s7 01, chicken/guile/gauche 00, chibi: error #<undef> application
+
+(let ((f2 0))
+  (letrec* ((f1 (lambda () f2))
+	    (f2 (let () (test (f1) #<undefined>) 1)))
+    (test (f1) 1)))                     ; all undefined/unspecified 1
+
+(let ((f2 (lambda () 0)))
+  (letrec* ((f1 (lambda () (f2)))
+	    (f2 (let () (test (f1) 'error) (lambda () 1)))) ; f2 undefined s7/chibi
+    (test (f1) 1)))
+
+(let ((f2 0))                           ; s7 01, guile 1.8/2.0 00, chicken no letrec*, chibi #<undef>1, gauche 00
+  (letrec* ((f1 (lambda () f2)))
+    (define f2 (let () (test (f1) 0) 1))
+    (test (f1) 1)))
+
+(let ((f2 0))                           ; all 00
+  (let ((f1 (lambda () f2)))
+    (define f2 (let () (test (f1) 0) 1))
+    (test (f1) 0)))
+
+(let ((f2 0))                           ; all 00
+  (let ((f1 (lambda () f2)))
+    ((lambda ()
+       (define f2 (let () (test (f1) 0) 1))
+       (test (f1) 0)))))
+
+(let ((f2 0))                           ; s7 01, guile 1.8/2.0 00, chicken 00, chibi #<undef>1, gauche 00
+  (letrec ((f1 (lambda () f2)))
+    (define f2 (let () (test (f1) 0) 1))
+    (test (f1) 1)))
+
+(let ((f2 0))                           ; all 00
+  (let ((f1 (lambda () f2)))
+    ((lambda ()
+       (letrec* ((f2 (let () (test (f1) 0) 1)))
+	 (test (f1) 0))))))
+
+(let ((f2 0))                           ; all 00
+  (letrec ((f1 (lambda () f2)))
+    (letrec* ((f2 (let () (test (f1) 0) 1)))
+      (test (f1) 0))))
+
+(let ((f1 0) (f2 1) (f3 2) (f4 3))
+  (letrec* ((f1 (lambda () f2))
+	    (f2 (let ()
+		  (test (f1) #<undefined>)
+		  4))
+	    (f3 (lambda () (f4)))
+	    (f4 (lambda () 5)))
+    (test (f1) 4)
+    (test (f3) 5)))
+
+(let ((f1 0) (f2 1) (f3 2) (f4 3))
+  (define (f1) f2)
+  (define f2 (let ()
+	       (test (f1) 1)
+	       4))
+  (define (f3) (f4))
+  (define f4 (lambda () 5))
+  (test (f1) 4)
+  (test (f3) 5))
+
+;;; s7/chibi do not treat a body as letrec*
+
+
+(test (let #((a 1)) a) 'error)
+(test (let* #((a 1)) a) 'error)
+(test (letrec #((a 1)) a) 'error)
+(test (letrec* #((a 1)) a) 'error)
+
+;; (let *((a 1)) a) -> 1 ; * is named let name?
+(test (letrec *((a 1)) a) 'error)
+(test (letrec* *((a 1)) a) 'error)
+(test (letrec* (((a 1) 2)) a) 'error)
+(test (letrec* (#(a 1) 2) a) 'error)
+(test (letrec* ((a a)) a) #<undefined>) ; hmm -- guile says Variable used before given a value: a
+(test (let . (((a 1)) a)) 1)
+(test (let '((a 1)) a) 'error)
+(test (let (((x 1)) 2) 3) 'error)
+(test (let ((#f 1)) #f) 'error)
+(test (let (()) #f) 'error)
+(test (let (lambda () ) #f) 'error)
+(test (let ((f1 3) (f1 4)) f1) 'error) ; not sure about this
+;;   (let () (define (f1) 3) (define (f1) 4) (f1))
+(test (let ((asdf (lambda (a) (if (> a 0) (asdf (- a 1)) 0)))) (asdf 3)) 'error)
+(test (let* ((asdf (lambda (a) (if (> a 0) (asdf (- a 1)) 0)))) (asdf 3)) 'error)
+(test (let (('a 3)) 1) 'error)
+(test (let ((#\a 3)) #\a) 'error)
+;;      (test (let ((#z1 2)) 1) 'error)
+(test (let 'a 1) 'error)
+(test (let* func ((a 1)) a) 1)
+(test (letrec func ((a 1)) a) 'error)
+(test (letrec* func ((a 1)) a) 'error)
+
+(test (let ((1 3)) 3) 'error)
+(test (let ((#t 3)) 3) 'error)
+(test (let ((() 3)) 3) 'error)
+(test (let ((#\c 3)) 3) 'error)
+(test (let (("hi" 3)) 3) 'error)
+(test (let ((:hi 3)) 3) 'error)
+
+(test (let 1 ((i 0)) i) 'error)
+(test (let #f ((i 0)) i) 'error)
+(test (let "hi" ((i 0)) i) 'error)
+(test (let #\c ((i 0)) i) 'error)
+(test (let :hi ((i 0)) i) 'error)
+(test (let pi () #f) 'error)
+
+(test (let func ((a 1) . b) a) 'error)
+(test (let func a . b) 'error)
+(test (let let func ((a 1)) func) 'error)
+(test (let func 1 ((x 1)) x) 'error)
+(test (let func ((a 1) . b) (if (> a 0) (func (- a 1) 2 3) b)) 'error)
+(test (let func ((a . 1)) a) 'error)
+(test (let func (a . 1) a) 'error)
+(test (let ((a 1) . b) a) 'error)
+(test (let* ((a 1) . b) a) 'error)
+(test (let func ((a func) (i 1)) i) 'error)
+(test (let func ((i 0)) (if (< i 1) (func))) 'error)
+(test (let func (let ((i 0)) (if (< i 1) (begin (set! i (+ i 1)) (func))))) 'error)
+(test (let ((x 0)) (set! x (+ x 1)) (begin (define y 1)) (+ x y)) 2)
+(test (let loop loop) 'error)
+(test (let loop (loop)) 'error)
+(test (let loop ((i 0) (loop 1)) i) 0) ; this used to be an error, Guile also returns 0
+
+(test (letrec ((cons 1 (quote ())) . #(1)) 1) 'error)
+(test (letrec ((a 1) . 2) 1) 'error)
+(test (let* ((a 1) (b . 2) . 1) (())) 'error)
+(test (let "" 1) 'error)
+(test (let "hi" 1) 'error)
+(test (let #(1) 1) 'error)
+(test (let __hi__ #t) 'error)
+(test (letrec (1 2) #t) 'error)
+(test (letrec* (1 2) #t) 'error)
+(test (let hi (()) 1) 'error)
+(test (let hi a 1) 'error)
+
+;;; opt typo tests
+(test (let ((s "123456")) (let loop ((i 5)) (cond ((< i 0) #f) ((char=? (string-ref s i) #\4) i) (else (loop (- i 1)))))) 3)
+(test (let leng ((l '(1 2 3)) (n 0)) (cond ((pair? l) (leng (cdr l) (+ n 1))) ((null? l) n) (else #f))) 3)
+
+;;; named let*
+(test (let* hi #t) 'error)
+(test (let* "hi" () #f) 'error)
+(test (let* hi ()) 'error)
+(test (let* pi () #f) 'error)
+(test (let* hi x 1) 'error)
+(test (let* hi (c) 1) 'error)
+(test (let* hi ((x . 1)) #f) 'error)
+;(test (let* hi . a 1) 'error) -- reader error in this context
+(test (let* hi ((a 1) . b) a) 'error)
+(test (let* hi ((a 1) :key b) a) 'error)
+(test (let* hi ((a 1) :allow-other-keys) a) 'error)
+(test (let* hi (a b) a) 'error)
+(test (let* x ((x 1)) #f) #f)
+(test (let* x ((x 1)) x) 1)
+(test (let* x ((x abs)) (x -1)) 1)
+(test (let ((x 123)) (let* x ((y x) (z y) (x 1)) x)) 1)
+
+(test (let* hi () 1) 1)
+(test (let* func ((i 1) (j 2)) (+ i j (if (> i 0) (func (- i 1)) 0))) 5)
+(test (let* func ((i 1) (j 2) (k (+ j 1))) (+ i j k (if (> i 0) (func (- i 1)) 0))) 11)
+(test (let* func ((i 1) (j 2) (k (+ j 1))) (+ i j k (let () (set! j -123) (if (> i 0) (func (- i 1)) 0)))) 11)
+(test (let* func1 ((a 1) (b 2)) (+ a b (let* func2 ((a -1) (b (- a 1))) (if (< a 0) (func2 (+ a 1)) b)))) 2) ; 2nd b is -1 -- this changed 8-Jan-14
+(test (procedure? (let* func ((i 1) (j 2) (k (+ j 1))) func)) #t)
+(test (let* func ((a 1) (b 2)) (+ a b (if (> a 0) (func (- a 1) (- b 1)) 0))) 4)
+(test (let* func ((a 1) (b 2)) (+ a b)) 3)
+(test (let* func ((a (+ 1 2)) (b (+ a 2))) (+ a b)) 8)
+(test (let* func ((a 1) (b 2)) (+ a b (if (> a 0) (func (- a 1) :b (- b 1)) 0))) 4)
+(test (let* func ((a 1) (b 2)) (+ a b (if (> a 0) (func :a (- a 1) :b (- b 1)) 0))) 4)
+(test (let* func ((a 1) (b 2)) (+ a b (if (> a 0) (func :b (- b 1) :a (- a 1)) 0))) 4)
+(test (let* func ((a 1) (b 2)) (+ a b (if (> a 0) (func :a (- a 1)) 0))) 5)
+
+(test (let* loop ((i 10) (j 1) (k 0)) (if (<= i 0) k (loop (- i j) :k (+ k 1)))) 10)
+(test (let* loop ((i 10) (j 1) (k 0)) (if (<= i 0) k (loop (- i j) :j 2 :k (+ k 1)))) 6)
+(test (let* loop ((i 10) (j 1) (k 0)) (if (<= i 0) k (loop (- i j)))) 0)
+
+;;; from the scheme wiki
+;;; http://community.schemewiki.org/?sieve-of-eratosthenes
+
+(let ((results '(2)))
+  (define (primes n)
+    (let ((pvector (make-vector (+ 1 n) #t))) ; if slot k then 2k+1 is a prime
+      (let loop ((p 3) ; Maintains invariant p = 2j + 1
+		 (q 4) ; Maintains invariant q = 2j + 2jj
+		 (j 1)
+		 (k ())
+		 (vec pvector))
+	(letrec ((lp (lambda (p q j k vec)
+		       (loop (+ 2 p)
+			     (+ q (- (* 2 (+ 2 p)) 2))
+			     (+ 1 j)
+			     k
+			     vec)))
+		 (eradicate (lambda (q p vec)
+			      (if (<= q n)
+				  (begin (vector-set! vec q #f)
+					 (eradicate (+ q p) p vec))
+				  vec))))
+          (if (<= j n)
+	      (if (eq? #t (vector-ref vec j))
+		  (begin (set! results (cons p results))
+			 (lp p q j q (eradicate q p vec)))
+		  (lp p q j k vec))
+	      (reverse results))))))
+  (test (primes 10) '(2 3 5 7 11 13 17 19)))
+
+(test (let ((gvar 32)) (define (hi1 a) (+ a gvar)) (let ((gvar 0)) (hi1 2))) 34)
+(test (let ((gvar 32)) (define-macro (hi2 b) `(* gvar ,b)) (define (hi1 a) (+ (hi2 a) gvar)) (let ((gvar 0)) (hi1 2))) 96)
+(test (let ((gvar 32)) (define-macro (hi2 b) `(* gvar ,b)) (define (hi1 a) (+ a gvar)) (let ((gvar 0)) (hi1 (hi2 2)))) 32)
+(test (let ((gvar 32)) (define-macro (hi2 b) `(* gvar ,b)) (define (hi1 a) (+ (a 2) gvar)) (let ((gvar 0)) (define (hi2 a) (* a 2)) (hi1 hi2))) 36)
+(test (let ((gvar 32)) (define-macro (hi2 b) `(* gvar ,b)) (define (hi1 a) (+ (a 2) gvar)) (let ((gvar 0) (hi2 (lambda (a) (hi2 a)))) (hi1 hi2))) 96)
+(test (let ((gvar 32)) (define-macro (hi2 b) `(* gvar ,b)) (define (hi1 a) (+ (a 2) gvar)) (let* ((gvar 0) (hi2 (lambda (a) (hi2 a)))) (hi1 hi2))) 32)
+(test (let () ((let ((gvar 32)) (define-macro (hi2 b) `(* gvar ,b)) (define (hi1 a) (+ (hi2 2) gvar)) hi1) 2)) 96)
+(test (let ((gvar 0)) ((let ((gvar 1)) (define-macro (hi2 b) `(+ gvar ,b)) (define (hi1 a) (let ((gvar 2)) (hi2 a))) hi1) 2)) 4)
+(test (let ((gvar 0)) (define-macro (hi2 b) `(+ gvar ,b)) ((let ((gvar 1)) (define (hi1 a) (let ((gvar 2)) (a 2))) hi1) hi2)) 4)
+(test (let ((gvar 0)) (define-macro (hi2 b) `(+ gvar ,b)) ((let ((gvar 1)) (define (hi1 a) (a 2)) hi1) hi2)) 3)
+(test (let () (define-macro (hi2 b) `(+ gvar ,b)) ((let ((gvar 1)) (define (hi1 a) (a 2)) hi1) hi2)) 3)
+(test (let ((y 1) (x (let ((y 2) (x (let ((y 3) (x 4)) (+ x y)))) (+ x y)))) (+ x y)) 10)
+(test (let ((x 0))
+	(+ (let ((x 1) (y (+ x 1)))
+	  (+ (let ((x 2) (y (+ x 1)))
+	    (+ (let ((x 3) (y (+ x 1)))
+	      (+ (let ((x 4) (y (+ x 1)))
+		(+ (let ((x 5) (y (+ x 1)))
+		  (+ (let ((x 6) (y (+ x 1)))
+		    (+ (let ((x 7) (y (+ x 1)))
+			 (+ x y)) x)) x)) x)) x)) x)) x)) x)) 35)
+
+(test (let loop ((lst (list 1 2))
+		 (i 0)
+		 (sum 0))
+	(if (or (null? lst)
+		(> i 10))
+	    sum
+	    (begin
+	      (set-cdr! (cdr lst) lst)
+	      (loop (cdr lst) (+ i 1) (+ sum (car lst))))))
+      16)
+
+;;; these are confusing:
+;(letrec ((if 0.0)) ((lambda () (if #t "hi")))) -> "hi"
+;(let ((let 0)) let) -> 0
+;(let* ((lambda 0)) ((lambda () 1.5))) -> 1.5 ; syntax error in Guile
+;(let* ((lambda 0)) lambda) -> 0
+
+;(define factorial #f)
+;; from test-submodel.scm, from MIT I think
+
+(test (letrec ((factorial
+		(lambda (n)
+		  (if (<= n 0) 1 (* n (factorial (- n 1)))))))
+	(factorial 3))
+      6)
+
+(test (letrec ((iter-fact
+		(lambda (n)
+		  (letrec
+		      ((helper (lambda (n p)
+				 (if (<= n 0) p (helper (- n 1) (* n p))))))
+		    (helper n 1)))))
+	(iter-fact 3))
+      6)
+
+(test (letrec ((y-factorial
+		(lambda (n)
+		  (letrec ((y
+			    (lambda (f)
+			      ((lambda (x)
+				 (f (lambda (z) ((x x) z))))
+			       (lambda (x)
+				 (f (lambda (z) ((x x) z)))))))
+			   (fact-def
+			    (lambda (fact)
+			      (lambda (n)
+				(if (<= n 0)
+				    1
+				    (* n (fact (- n 1))))))))
+		    ((y fact-def) n)))))
+	(y-factorial 3))
+      6)
+
+(let () ; more silliness
+  ;; from The Evolution of a Scheme Programmer
+  (define factorial-1
+    ((lambda (f)
+       ((lambda (g)
+          (f (lambda (x)
+               ((g g) x))))
+	(lambda (g)
+          (f (lambda (x)
+               ((g g) x))))))
+     (lambda (f)
+       (lambda (n)
+	 (if (zero? n)
+             1
+             (* n (f (- n 1))))))))
+  (test (factorial-1 6) 720)
+
+  (define (factorial-2 n)
+    (letrec ((f (lambda (n k)
+                  (if (= n 1)
+                      (k 1)
+                      (f (- n 1)
+			 (lambda (ret)
+                           (k (* n ret))))))))
+      (call-with-current-continuation
+       (lambda (k)
+	 (f n k)))))
+  (test (factorial-2 6) 720))
+
+(test (let ((x 1)) (let ((x 0) (y x)) (cons x y))) '(0 . 1))
+(test (let ((x 1)) (let* ((x 0) (y x)) (cons x y))) '(0 . 0))
+(test (let ((x 1)) (letrec ((x 0) (y x)) (cons x y))) '(0 . #<undefined>))
+(test (let ((x 1)) (letrec* ((x 0) (y x)) (cons x y))) '(0 . 0))
+
+(test (let ((x 1)) (let ((x 0) (y (let () (set! x 2) x))) (cons x y))) '(0 . 2))
+(test (let ((x 1)) (letrec ((x 0) (y (let () (set! x 2) x))) (cons x y))) '(0 . 2))
+(test (let ((x 1)) (let* ((x 0) (y (let () (set! x 2) x))) (cons x y))) '(2 . 2))
+(test (let ((x 1)) (letrec* ((x 0) (y (let () (set! x 2) x))) (cons x y))) '(2 . 2))
+
+(test (letrec ((x x)) x) #<undefined>) ; weird
+(test (letrec ((x y) (y x)) x) #<undefined>)
+
+(test (procedure? (letrec ((x (lambda () x))) x)) #t)
+(test (procedure? (letrec ((x (lambda () x))) (x))) #t)
+(test (letrec ((x (lambda () x))) (equal? x (x))) #t)  ; !
+(test (letrec ((x (lambda () x))) (equal? x ((x)))) #t)  ; !
+
+(test (letrec* ()) 'error)
+(test (letrec* ((x 1 x)) x) 'error)
+(test (letrec* ((x x)) x) #<undefined>) ;??
+(test (let ((x 1)) (letrec* ((x x)) x)) #<undefined>)
+(test (letrec ((x x)) x) #<undefined>)
+(test (let ((x 1)) (letrec ((x x)) x)) #<undefined>)
+;; here they are different:
+(test (let ((x 1)) (letrec* ((x 0) (y x)) y)) 0)
+(test (let ((x 1)) (letrec ((x 0) (y x)) y)) #<undefined>)
+;(test (letrec ((x (let () (set! y 1) y)) (y (let () (set! y (+ y 1)) y))) (list x y)) '(1 2)) ; ! this depends on letrec binding order
+
+(test (letrec ((x 1) (y x)) (list x y)) '(1 #<undefined>)) ; guile says '(1 1)
+(test (letrec ((y x) (x 1)) (list x y)) '(1 #<undefined>)) ; guile says '(1 1)
+(test (letrec ((x 1) (y (let () (set! x 2) x))) (list x y)) '(1 2))
+(test (letrec ((history (list 9))) ((lambda (n) (begin (set! history (cons history n)) history)) 8)) '((9) . 8))
+(test (((call/cc (lambda (k) k)) (lambda (x) x)) 'HEY!) 'HEY!)
+
+(let ((sequence ()))
+  ((call-with-current-continuation
+    (lambda (goto)
+      (letrec ((start
+		(lambda ()
+		  (set! sequence (cons 'start sequence))
+		  (goto next)))
+	       (froz
+		(lambda ()
+		  (set! sequence (cons 'froz sequence))
+		  (goto last)))
+	       (next
+		(lambda ()
+		  (set! sequence (cons 'next sequence))
+		  (goto froz)))
+	       (last
+		(lambda ()
+		  (set! sequence (cons 'last sequence))
+		  #f)))
+	start))))
+  (test (reverse sequence) '(start next froz last)))
+
+(let ()
+  (define thunk 'dummy-thunk)
+
+  (define (make-fringe-thunk tree)
+    (call-with-exit
+     (lambda (return-to-repl)
+       (cond ((pair? tree)
+	      (make-fringe-thunk (car tree))
+	      (make-fringe-thunk (cdr tree)))
+	     ((null? tree) (begin (set! thunk (lambda () 'done)) 'null))
+	     (else (call/cc
+		    (lambda (cc)
+		      (set! thunk
+			    (lambda ()
+			      (begin (display tree) (cc 'leaf))))
+		      (return-to-repl 'thunk-set!))))))))
+
+  (define tr '(() () (((1 (( (() 2 (3 4)) (((5))) )) ))) ))
+  (test (make-fringe-thunk tr) 'null)
+  (test (thunk) 'done))
+
+;;; evaluation order matters, but in s7 it's always left -> right
+(test (let ((x 1)) (+ x (let () (define x 2) x))) 3)
+(test (let ((x 1)) (+ (begin (define x 2) x) x)) 4)
+(test (let ((x 1)) (+ x (begin (define x 2) x))) 3)
+(test (let ((x 1)) (+ x (begin (set! x 2) x))) 3)
+(test (let ((x 1)) (+ (begin (set! x 2) x) x)) 4)
+(test (let ((x 1)) ((if (= x 1) + -) x (begin (set! x 2) x))) 3)
+
+(catch #t
+  (lambda ()
+    (let ()
+      (define-constant _letrec_x_ 32)
+      (test (letrec ((_letrec_x_ 1)) _letrec_x_) 'error))
+    (let ()
+      (define-constant _let_x_ 32)
+      (test (let ((_let_x_ 1)) _let_x_) 'error))
+    (let ()
+      (define-constant _let*_x_ 32)
+      (test (let* ((_let*_x_ 1)) _let*_x_) 'error)))
+  (lambda args 'error))
+
+
+#|
+;;; here is the old letrec* macro:
+(define-macro (letrec* bindings . body)
+  (if (null? body)
+      (error 'syntax-error "letrec* has no body")
+      (if (not (list? bindings))
+	  (error 'syntax-error "letrec* variables are messed up")
+	  `(let (,@(map (lambda (var&init)
+			  (list (car var&init) #<undefined>))
+			bindings))
+	     ,@(map (lambda (var&init)
+		      (if (not (null? (cddr var&init)))
+			  (error 'syntax-error "letrec* variable has more than one value"))
+		      (list 'set! (car var&init) (cadr var&init)))
+		    bindings)
+	     ,@body))))
+|#
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; call/cc
+;;; call-with-current-continuation
+;;; --------------------------------------------------------------------------------
+;;; some of these were originally from Al Petrovsky, Scott G Miller, Matthias Radestock, J H Brown, Dorai Sitaram,
+;;;   and probably others.
+
+(let ((calls (make-vector 3 #f))
+      (travels (make-vector 5 0))
+      (ctr 0))
+  (set! (travels 0) (+ (travels 0) 1))
+  (call/cc (lambda (c0) (set! (calls 0) c0)))
+  (set! (travels 1) (+ (travels 1) 1))
+  (call/cc (lambda (c1) (set! (calls 1) c1)))
+  (set! (travels 2) (+ (travels 2) 1))
+  (call/cc (lambda (c2) (set! (calls 2) c2)))
+  (set! (travels 3) (+ (travels 3) 1))
+  (let ((ctr1 ctr))
+    (set! ctr (+ ctr1 1))
+    (if (< ctr1 3)
+	((calls ctr1) ctr1)))
+  (set! (travels 4) (+ (travels 4) 1))
+  (test travels #(1 2 3 4 1)))
+
+(let ((calls (make-vector 5 #f))
+      (travels (make-vector 5 0))
+      (ctr2 0))
+  (let loop ((ctr 0))
+    (if (< ctr 3)
+	(begin
+	  (set! (travels ctr) (+ (travels ctr) 1))
+	  (call/cc (lambda (c0) (set! (calls ctr) c0)))
+	  (loop (+ ctr 1)))))
+  (set! (travels 3) (+ (travels 3) 1))
+  (let ((ctr1 ctr2))
+    (set! ctr2 (+ ctr1 1))
+    (if (< ctr1 3)
+	((calls ctr1) ctr1)))
+  (set! (travels 4) (+ (travels 4) 1))
+  (test travels #(1 2 3 4 1)))
+
+(let ((c1 #f)
+      (c2 #f)
+      (c3 #f)
+      (x0 0)
+      (x1 0)
+      (x2 0)
+      (x3 0))
+  (let ((x (+ 1
+	      (call/cc
+	       (lambda (r1)
+		 (set! c1 r1)
+		 (r1 2)))
+	      (call/cc
+	       (lambda (r2)
+		 (set! c2 r2)
+		 (r2 3)))
+	      (call/cc
+	       (lambda (r3)
+		 (set! c3 r3)
+		 (r3 4)))
+	      5)))
+    (if (= x0 0)
+	(set! x0 x)
+	(if (= x1 0)
+	    (set! x1 x)
+	    (if (= x2 0)
+		(set! x2 x)
+		(if (= x3 0)
+		    (set! x3 x)))))
+    (if (= x 15)
+	(c1 6))
+    (if (= x 19)
+	(c2 7))
+    (if (= x 23)
+	(c3 8))
+    (test (list x x0 x1 x2 x3) '(27 15 19 23 27))))
+
+(let ((c1 #f) (c2 #f) (c3 #f) (x0 0) (x1 0) (x2 0) (x3 0) (y1 0) (z0 0) (z1 0) (z2 0) (z3 0))
+  (let* ((y 101)
+	 (x (+ y
+	      (call/cc
+	       (lambda (r1)
+		 (set! c1 r1)
+		 (r1 2)))
+	      (call/cc
+	       (lambda (r2)
+		 (set! c2 r2)
+		 (r2 3)))
+	      (call/cc
+	       (lambda (r3)
+		 (set! c3 r3)
+		 (r3 4)))
+	      5))
+	 (z (+ x y)))
+    (set! y1 y)
+    (if (= x0 0)
+	(begin
+	  (set! x0 x)
+	  (set! z0 z))
+	(if (= x1 0)
+	    (begin
+	      (set! x1 x)
+	      (set! z1 z))
+	    (if (= x2 0)
+		(begin
+		  (set! x2 x)
+		  (set! z2 z))
+		(if (= x3 0)
+		    (begin
+		      (set! x3 x)
+		      (set! z3 z))))))
+    (if (= x 115)
+	(c1 6))
+    (if (= x 119)
+	(c2 7))
+    (if (= x 123)
+	(c3 8))
+    (test (list x x0 x1 x2 x3 y1 z0 z1 z2 z3) '(127 115 119 123 127 101 216 220 224 228))))
+
+(let ((c1 #f)
+      (c2 #f)
+      (c3 #f)
+      (x0 0)
+      (x1 0)
+      (x2 0)
+      (x3 0))
+  (let ((x (+ 1
+	      (call/cc
+	       (lambda (r1)
+		 (set! c1 r1)
+		 (r1 2)))
+	      (call/cc
+	       (lambda (r2)
+		 (set! c2 r2)
+		 (r2 3)))
+	      (call/cc
+	       (lambda (r3)
+		 (set! c3 r3)
+		 (r3 4)))
+	      5)))
+    (if (= x0 0)
+	(set! x0 x)
+	(if (= x1 0)
+	    (set! x1 x)
+	    (if (= x2 0)
+		(set! x2 x)
+		(if (= x3 0)
+		    (set! x3 x)))))
+    (if (= x 15)
+	(c1 6 1))
+    (if (= x 20)
+	(c2 7 2 3))
+    (if (= x 29)
+	(c3 8 3 4 5))
+    (test (list x x0 x1 x2 x3) '(45 15 20 29 45))))
+;; 45 = (+ 1 6 1 7 2 3 8 3 4 5 5)
+
+(let ((x 0)
+      (c1 #f)
+      (results ()))
+  (set! x (call/cc
+	   (lambda (r1)
+	     (set! c1 r1)
+	     (r1 2))))
+  (set! results (cons x results))
+  (if (= x 2) (c1 32))
+  (test results '(32 2)))
+
+(let ((x #(0))
+      (y #(0))
+      (c1 #f))
+  (set! ((call/cc
+	   (lambda (r1)
+	     (set! c1 r1)
+	     (r1 x)))
+	 0) 32)
+  (if (= (y 0) 0) (c1 y))
+  (test (and (equal? x #(32)) (equal? y #(32))) #t))
+
+(test (call/cc (lambda (k) ((call/cc (lambda (top) (k (+ 1 (call/cc (lambda (inner) (top inner))))))) 2))) 3)
+
+(let* ((next-leaf-generator (lambda (obj eot)
+			      (letrec ((return #f)
+				       (cont (lambda (x)
+					       (recur obj)
+					       (set! cont (lambda (x) (return eot)))
+					       (cont #f)))
+				       (recur (lambda (obj)
+						(if (pair? obj)
+						    (for-each recur obj)
+						    (call-with-current-continuation
+						     (lambda (c)
+						       (set! cont c)
+						       (return obj)))))))
+				(lambda () (call-with-current-continuation
+					    (lambda (ret) (set! return ret) (cont #f)))))))
+       (leaf-eq? (lambda (x y)
+		   (let* ((eot (list 'eot))
+			  (xf (next-leaf-generator x eot))
+			  (yf (next-leaf-generator y eot)))
+		     (letrec ((loop (lambda (x y)
+				      (cond ((not (eq? x y)) #f)
+					    ((eq? eot x) #t)
+					    (else (loop (xf) (yf)))))))
+		       (loop (xf) (yf)))))))
+
+  (test (leaf-eq? '(a (b (c))) '((a) b c)) #t)
+  (test (leaf-eq? '(a (b (c))) '((a) b c d)) #f)
+  (test (leaf-eq? '(a b (c)) '((a) b c)) #t))
+
+(test (let ((r #f)
+	    (a #f)
+	    (b #f)
+	    (c #f)
+	    (i 0))
+	(let ()
+	  (set! r (+ 1 (+ 2 (+ 3 (call/cc (lambda (k) (set! a k) 4))))
+		     (+ 5 (+ 6 (call/cc (lambda (k) (set! b k) 7))))))
+	  (if (not c)
+	      (set! c a))
+	  (set! i (+ i 1))
+	  (case i
+	    ((1) (a 5))
+	    ((2) (b 8))
+	    ((3) (a 6))
+	    ((4) (c 4)))
+	  r))
+      28)
+
+(test (let ((r #f)
+	    (a #f)
+	    (b #f)
+	    (c #f)
+	    (i 0))
+	(let ()
+	  (set! r (+ 1 (+ 2 (+ 3 (call/cc (lambda (k) (set! a k) 4))))
+		     (+ 5 (+ 6 (call/cc (lambda (k) (set! b k) 7))))))
+	  (if (not c)
+	      (set! c a))
+	  (set! i (+ i 1))
+	  (case i
+	    ((1) (b 8))
+	    ((2) (a 5))
+	    ((3) (b 7))
+	    ((4) (c 4)))
+	  r))
+      28)
+
+(test (let ((k1 #f)
+	    (k2 #f)
+	    (k3 #f)
+	    (state 0))
+	(define (identity x) x)
+	(define (fn)
+	  ((identity (if (= state 0)
+			 (call/cc (lambda (k) (set! k1 k) +))
+			 +))
+	   (identity (if (= state 0)
+			 (call/cc (lambda (k) (set! k2 k) 1))
+			 1))
+	   (identity (if (= state 0)
+			 (call/cc (lambda (k) (set! k3 k) 2))
+			 2))))
+	(define (check states)
+	  (set! state 0)
+	  (let* ((res ())
+		 (r (fn)))
+	    (set! res (cons r res))
+	    (if (null? states)
+		res
+		(begin (set! state (car states))
+		       (set! states (cdr states))
+		       (case state
+			 ((1) (k3 4))
+			 ((2) (k2 2))
+			 ((3) (k1 -)))))))
+	(map check '((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))))
+      '((-1 4 5 3) (4 -1 5 3) (-1 5 4 3) (5 -1 4 3) (4 5 -1 3) (5 4 -1 3)))
+
+(let () ; Matt Might perhaps or maybe Paul Hollingsworth?
+  (define (current-continuation)
+    (call/cc (lambda (cc) (cc cc))))
+  (define fail-stack ())
+  (define (fail)
+    (if (not (pair? fail-stack))
+	(error 'test-error "back-tracking stack exhausted!")
+	(begin
+	  (let ((back-track-point (car fail-stack)))
+	    (set! fail-stack (cdr fail-stack))
+	    (back-track-point back-track-point)))))
+  (define (amb choices)
+    (let ((cc (current-continuation)))
+      (cond
+       ((null? choices)      (fail))
+       ((pair? choices)      (let ((choice (car choices)))
+			       (set! choices (cdr choices))
+			       (set! fail-stack (cons cc fail-stack))
+			       choice)))))
+  (define (assert condition)
+    (if (not condition)
+	(fail)
+	#t))
+  (let ((a (amb (list 1 2 3 4 5 6 7)))
+	(b (amb (list 1 2 3 4 5 6 7)))
+	(c (amb (list 1 2 3 4 5 6 7))))
+    (assert (= (* c c) (+ (* a a) (* b b))))
+    (assert (< b a))
+    (test (list a b c) (list 4 3 5))))
+
+(let () ; a shorter version
+  (define (current-continuation)
+    (call/cc (lambda (cc) cc)))
+  (define fail-stack ())
+  (define (fail)
+    (if (not (pair? fail-stack))
+	(error 'test-error "back-tracking stack exhausted!")
+	(let ((back-track-point (car fail-stack)))
+	  (set! fail-stack (cdr fail-stack))
+	  (back-track-point back-track-point))))
+  (define (amb choices)
+    (let ((cc (current-continuation)))
+      (if (null? choices)
+	  (fail)
+	  (let ((choice (car choices)))
+	    (set! choices (cdr choices))
+	    (set! fail-stack (cons cc fail-stack))
+	    choice))))
+  (define (assert condition)
+    (or condition (fail)))
+  (let ((a (amb (list 1 2 3 4 5 6 7)))
+	(b (amb (list 1 2 3 4 5 6 7)))
+	(c (amb (list 1 2 3 4 5 6 7))))
+    (assert (= (* c c) (+ (* a a) (* b b))))
+    (assert (< b a))
+    (test (list a b c) (list 4 3 5))))
+
+(let ((c1 #f))
+  (let ((x ((call/cc (lambda (r1) (set! c1 r1) (r1 "hiho"))) 0)))
+    (if (char=? x #\h)
+	(c1 "asdf"))
+    (test x #\a)))
+
+(test (let ((x ())
+	    (y 0))
+	(call/cc
+	 (lambda (escape)
+	   (let* ((yin ((lambda (foo)
+			  (set! x (cons y x))
+			  (if (= y 10)
+			      (escape x)
+			      (begin
+				(set! y 0)
+				foo)))
+			(call/cc (lambda (bar) bar))))
+		  (yang ((lambda (foo)
+			   (set! y (+ y 1))
+			   foo)
+			 (call/cc (lambda (baz) baz)))))
+	     (yin yang)))))
+      '(10 9 8 7 6 5 4 3 2 1 0))
+
+(let ()
+  ;; taken from wikipedia
+  (define readyList ())
+
+  (define (i-run)
+    (if (not (null? readyList))
+	(let ((cont (car readyList)))
+	  (set! readyList (cdr readyList))
+	  (cont ()))))
+
+  (define (fork fn arg)
+    (set! readyList
+	  (append readyList
+		  (cons
+		   (lambda (x)
+		     (fn arg)
+		     (i-run))
+		   ()))))
+
+  (define (yield)
+    (call-with-current-continuation
+     (lambda (thisCont)
+       (set! readyList
+	     (append readyList
+		     (cons thisCont ())))
+       (let ((cont (car readyList)))
+	 (set! readyList (cdr readyList))
+	 (cont ())))))
+
+  (define data (make-vector 10 0))
+  (define data-loc 0)
+
+  (define (process arg)
+    (if (< data-loc 10)
+	(begin
+	  (set! (data data-loc) arg)
+	  (set! data-loc (+ data-loc 1))
+	  (yield)
+	  (process (+ arg 1)))
+	(i-run)))
+
+  (fork process 0)
+  (fork process 10)
+  (fork process 20)
+  (i-run)
+
+  (test data #(0 10 20 1 11 21 2 12 22 3)))
+
+(test (let ((c #f))
+	(let ((r ()))
+	  (let ((w (let ((v 1))
+		     (set! v (+ (call-with-current-continuation
+				 (lambda (c0) (set! c c0) v))
+				v))
+		     (set! r (cons v r))
+		     v)))
+	    (if (<= w 1024) (c w) r))))
+      '(2048 1024 512 256 128 64 32 16 8 4 2))
+
+(test (let ((c #f))
+	(let ((r ()))
+	  (let ((w (let ((v 1))
+		     (set! v (+ (values v (call-with-current-continuation
+				 (lambda (c0) (set! c c0) v)))
+				v))
+		     (set! r (cons v r))
+		     v)))
+	    (if (<= w 1024) (c w) r))))
+      '(2047 1023 511 255 127 63 31 15 7 3))
+
+;;; the first v is 1, the 3rd reflects the previous call/cc which reflects the
+;;;    env+slot that had the subsequent set! -- weird.
+
+(test (let ((cc #f)
+	    (r ()))
+	(let ((s (list 1 2 3 4 (call/cc (lambda (c) (set! cc c) 5)) 6 7 8)))
+	  (if (null? r)
+	      (begin (set! r s) (cc -1))
+	      (list r s))))
+      '((1 2 3 4 5 6 7 8) (1 2 3 4 -1 6 7 8)))
+
+(test (let ((count 0))
+        (let ((first-time? #t)
+              (k (call/cc values)))
+          (if first-time?
+              (begin
+                (set! first-time? #f)
+                (set! count (+ count 1))
+                (k values))
+	      ))
+        count)
+      2)
+
+(let ((H ((lambda ()
+	    (hash-table (call-with-exit
+			 (lambda (return)
+			   (let ((x 1) (y 2))
+			     (return x y))))
+			(call/cc (lambda (return)
+				   (return 'oops)))
+			1)))))
+  (test (H 1) 2))
+
+(let ((continuations ())) ; chicken mailing list
+  (define (push arg)
+    (set! continuations (cons arg continuations)))
+  (define (capture-from-map arg)
+    (call-with-current-continuation
+     (lambda (cc)
+       (push cc)
+       arg)))
+  (define numbers (map capture-from-map '(1 2 3)))
+  (test numbers '(1 2 3)))
+
+(let ((c #f)
+      (vals ()))
+  (let ((val (+ 1 2 (call/cc (lambda (r) (set! c r) (r 3))))))
+    (set! vals (cons val vals))
+    (if (< val 20) (c (+ val 1)))
+    (test vals '(22 18 14 10 6))))
+(let ((c #f)
+      (vals ()))
+  (let ((val (+ 1 2 (call/cc (lambda (r) (set! c r) (r 3))))))
+    (set! vals (cons val vals))
+    (if (< val 20) (apply c vals))
+    (test vals '(36 18 9 6))))
+(let ((c #f)
+      (vals ()))
+  (let ((val (+ 1 2 (call/cc (lambda (r) (set! c r) (r 3))))))
+    (set! vals (cons val vals))
+    (if (< val 20) (c (apply values vals)))
+    (test vals '(36 18 9 6))))
+
+(test (procedure? (call/cc call/cc)) #t)
+(test (call/cc (lambda (c) (0 (c 1)))) 1)
+(test (call/cc (lambda (k) (k "foo"))) "foo")
+(test (call/cc (lambda (k) "foo")) "foo")
+(test (call/cc (lambda (k) (k "foo") "oops")) "foo")
+(test (call/cc (lambda (return) (catch #t (lambda () (error 'hi "")) (lambda args (return "oops"))))) "oops")
+(test (call/cc (lambda (return) (catch #t (lambda () (return 1)) (lambda args (return "oops"))))) 1)
+(test (catch #t (lambda () (call/cc (lambda (return) (return "oops")))) (lambda arg 1)) "oops")
+(test (call/cc (if (< 2 1) (lambda (return) (return 1)) (lambda (return) (return 2) 3))) 2)
+(test (call/cc (let ((a 1)) (lambda (return) (set! a (+ a 1)) (return a)))) 2)
+(test (call/cc (lambda (return) (let ((hi return)) (hi 2) 3))) 2)
+(test (let () (define (hi) (call/cc func)) (define (func a) (a 1)) (hi)) 1)
+(test (((call/cc (call/cc call/cc)) call/cc) (lambda (a) 1)) 1)
+(test (+ 1 (eval-string "(+ 2 (call-with-exit (lambda (return) (return 3))) 4)") 5) 15)
+(test (+ 1 (eval '(+ 2 (call-with-exit (lambda (return) (return 3))) 4)) 5) 15)
+(test (call-with-exit) 'error)
+(test (call/cc) 'error)
+(test (call/cc (lambda () 1)) 'error)
+(test (call/cc (lambda (a b) (a 1))) 'error)
+(test (+ 1 (call/cc (lambda (k) (k #\a)))) 'error)
+(test (+ 1 (call-with-exit (lambda (k) (k #\a)))) 'error)
+(test ((call/cc (lambda (return) (call/cc (lambda (cont) (return cont))) list)) 1) '(1)) ; from Guile mailing list -- this strikes me as very strange
+(num-test (let () (define (func) (let ((x 1)) (max (call/cc (lambda (return) (return 1 2))) (log (* 2 x 3.0 4))))) (func)) (log 24.0))
+(test (let () (define (func) (sort! (cddar (list imp (call/cc (lambda (return) (return 'oops))))) >)) (func)) 'error) ; copy_stack_list_set_immutable bug
+
+(let ()
+  (define imp (immutable! (cons 0 (immutable! (cons 1 (immutable! (cons 2 ())))))))
+  (test (immutable? (list-tail imp (call/cc (lambda (cc) (cc 1))))) #t)
+  (test (let () (define (f) (list-tail imp (call/cc (lambda (cc) (cc 1))))) (immutable? (f))) #t))
+
+(test (call/cc begin) 'error)
+(test (call/cc quote) 'error)
+
+(let ((p1 (dilambda (lambda (k) (k 3)) (lambda (k a) (k a)))))
+  (test (call/cc p1) 3)
+  (test (call-with-exit p1) 3))
+
+;;; guile/s7 accept: (call/cc (lambda (a . b) (a 1))) -> 1
+;;; same:            (call/cc (lambda arg ((car arg) 1))) -> 1
+
+(test (let ((listindex (lambda (e l)
+			 (call/cc (lambda (not_found)
+				    (letrec ((loop
+					      (lambda (l)
+						(cond
+						 ((null? l) (not_found #f))
+						 ((equal? e (car l)) 0)
+						 (else (+ 1 (loop (cdr l))))))))
+				      (loop l)))))))
+	(listindex 1 '(0 3 2 4 8)))
+      #f)
+
+(test (let ((product (lambda (li)
+		       (call/cc (lambda (return)
+				  (let loop ((l li))
+				    (cond
+				     ((null? l) 1)
+				     ((= (car l) 0) (return 0))
+				     (else (* (car l) (loop (cdr l)))))))))))
+	(product '(1 2 3 0 4 5 6)))
+      0)
+
+(test (let ((lst ()))
+	((call/cc
+	  (lambda (goto)
+	    (letrec ((start (lambda () (set! lst (cons "start" lst)) (goto next)))
+		     (next  (lambda () (set! lst (cons "next" lst))  (goto last)))
+		     (last  (lambda () (set! lst (cons "last" lst)) (reverse lst))))
+	      start)))))
+      '("start" "next" "last"))
+
+(test (let ((cont #f)) ; Al Petrovsky
+	(letrec ((x (call-with-current-continuation (lambda (c) (set! cont c) 0)))
+		 (y (call-with-current-continuation (lambda (c) (set! cont c) 0))))
+	  (if cont
+	      (let ((c cont))
+		(set! cont #f)
+		(set! x 1)
+		(set! y 1)
+		(c 0))
+	      (+ x y))))
+      0)
+
+(test (letrec ((x (call-with-current-continuation
+		   (lambda (c)
+		     (list #t c)))))
+	(if (car x)
+	    ((cadr x) (list #f (lambda () x)))
+	    (eq? x ((cadr x)))))
+      #t)
+
+(test (call/cc (lambda (c) (0 (c 1)))) 1)
+
+(test (let ((membr (lambda (x ls)
+		      (call/cc
+		       (lambda (return)
+			 (do ((ls ls (cdr ls)))
+			     ((null? ls) #f)
+			   (if (equal? x (car ls))
+			       (return ls))))))))
+	(list (membr 'd '(a b c))
+	      (membr 'b '(a b c))))
+      '(#f (b c)))
+
+(test (list-values (values) (call/cc (lambda (return) (let ((x 1) (y 2)) (return x y))))) '(1 2))
+(test ((lambda x (list-values (values) (call/cc (lambda (return) (let ((x 1) (y 2)) (return x y))))))) '(1 2))
+(test (let () (define (func) (list-values (values) (call/cc (lambda (return) (let ((x 1) (y 2)) (return x y)))))) (define (hi) (func) (func)) (hi) (hi)) '(1 2))
+
+(let () ; from wikipedia
+  (define (f return) (return 2) 3)
+  (test (f (lambda (x) x)) 3)
+  (test (call/cc f) 2))
+
+(test (+ 2 (call/cc (lambda (k) (* 5 (k 4))))) 6)
+(test (+ 2 (call/cc (lambda (k) (* 5 (k 4 5 6))))) 17)
+(test (+ 2 (call/cc (lambda (k) (* 5 (k (values 4 5 6)))))) 17)
+(test (+ 2 (call/cc (lambda (k) (* 5 (k 1 (values 4 5 6)))))) 18)
+(test (+ 2 (call/cc (lambda (k) (* 5 (k 1 (values 4 5 6) 1))))) 19)
+(test ((call/cc (lambda (return) (return + 1 2 3)))) 6)
+(test (let () (define (func) (catch #t (lambda () 1) (lambda (with-let info) 1.0))) (func)) 'error)
+(test (let () (define (func) (call/cc (lambda (with-let) 1.0))) (func)) 'error)
+(test (call/cc (lambda (a . b) (a 1))) 1)
+(test (call/cc (lambda (x) (set! x abs) (x -1))) 1)
+
+
+;;; call-with-exit goto?
+(test (goto? (call-with-exit (lambda (g) g))) #t)
+(test (goto? (call/cc (lambda (g) g))) #f)
+(for-each
+ (lambda (arg)
+   (if (goto? arg)
+       (format #t ";(goto? ~A) -> #t?~%" arg)))
+ (list "hi" '(1 2) (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi (if #f #f) #<eof> #<undefined>))
+
+(test (+ 2 (call-with-exit (lambda (k) (* 5 (k 4))))) 6)
+(test (+ 2 (call-with-exit (lambda (k) (* 5 (k 4 5 6))))) 17)
+(test (+ 2 (call-with-exit (lambda (k) (* 5 (k (values 4 5 6)))))) 17)
+(test (+ 2 (call-with-exit (lambda (k) (* 5 (k 1 (values 4 5 6)))))) 18)
+(test (+ 2 (call-with-exit (lambda (k) (* 5 (k 1 (values 4 5 6) 1))))) 19)
+(test (+ 2 (call-with-exit (lambda* ((hi 1)) (hi 1)))) 3)
+(test (call-with-exit (lambda (hi) (((hi 1)) #t))) 1) ; !! (jumps out of list evaluation)
+(test (call-with-exit (lambda* args ((car args) 1))) 1)
+(test ((call-with-exit (lambda (return) (return + 1 2 3)))) 6)
+(test ((call-with-exit (lambda (return) (apply return (list + 1 2 3))))) 6)
+(test (+ 2 (call-with-exit (lambda (return) (let ((rtn (copy return))) (* 5 (rtn 4)))))) 6)
+(test (let () (define (f1) (+ (call-with-exit (lambda (return) (define (f2) (+ 1 (return 2))) (f2))) 3)) (f1)) 5)
+
+(test (+ 2 (values 3 (call-with-exit (lambda (k1) (k1 4))) 5)) 14)
+(test (+ 2 (call-with-exit (lambda (k1) (values 3 (k1 4) 5))) 8) 14)
+(test (+ 2 (call-with-exit (lambda (k1) (values 3 (k1 4 -3) 5))) 8) 11)
+(test (call-with-exit (lambda (pi) 1)) 'error)
+(test (let () (define (func) (call-with-exit (lambda (pi) 1))) (define (hi) (func) (func)) (hi) (hi)) 'error)
+(test (let () (define (func) (call-with-exit (lambda (with-let) 1.0))) (func)) 'error)
+
+(test (call-with-exit (let () (lambda (k1) (k1 2)))) 2)
+(test (+ 2 (call/cc (let () (call/cc (lambda (k1) (k1 (lambda (k2) (k2 3)))))))) 5)
+(test (+ 2 (call/cc (call/cc (lambda (k1) (k1 (lambda (k2) (k2 3))))))) 5)
+(test (call-with-exit (lambda arg ((car arg) 32))) 32)
+(test (call-with-exit (lambda arg ((car arg) 32)) "oops!") 'error)
+(test (call-with-exit (lambda (a b) a)) 'error)
+(test (call-with-exit (lambda (return) (apply return '(3)))) 3)
+(test (call-with-exit (lambda (return) (apply return (list  (cons 1 2))) (format #t "; call-with-exit: we shouldn't be here!"))) (cons 1 2))
+(test (call/cc (lambda (return) (apply return (list  (cons 1 2))) (format #t "; call/cc: we shouldn't be here!"))) (cons 1 2))
+(test (procedure? (call-with-exit (lambda (return) (call-with-exit return)))) #t)
+(test (call-with-exit (lambda (return) #f) 1) 'error)
+(test (+ (call-with-exit ((lambda () (lambda (k) (k 1 2 3)))))) 6)
+(test (let ((x 1)) (set! x (- (call-with-exit (lambda (go) (catch #t (lambda () (abs "hi") 3) (lambda (t i) (go 4 4) 6)) 5))))) 0)
+
+(test (call-with-exit (lambda (a . b) (a 1))) 1)
+(test (call-with-exit (lambda* (a b) (a 1))) 1)
+(test (call-with-exit (lambda args ((car args) 0) 1)) 0)
+
+(test (call-with-exit (lambda (c) (0 (c 1)))) 1)
+(test (call-with-exit (lambda (k) (k "foo"))) "foo")
+(test (call-with-exit (lambda (k) "foo")) "foo")
+(test (call-with-exit (lambda (k) (k "foo") "oops")) "foo")
+(test (call-with-exit (lambda (x) (set! x abs) (x -1))) 1)
+
+(test (call-with-exit (call-with-exit values)) 'error)
+(test (call-with-exit (call-with-exit (lambda (go) go))) 'error)
+(test (call-with-exit (call-with-exit (lambda (go) (go (lambda (gone) (gone 1)))))) 1)
+(test (call-with-exit cons) 'error) ; aritable?
+
+(test (apply call-with-exit (lambda (g) (g 123)) ()) 123)
+(test (apply call/cc (lambda (g) (g 123)) ()) 123)
+(test (call/cc call-with-exit) 'error)
+(test (call-with-exit call/cc) 'error) ; less than ideal error message here: call-with-exit escape procedure called outside its block
+(test (call-with-exit call-with-exit) 'error)
+(test (continuation? (call/cc call/cc)) #t) ; hmmm...
+
+(let ()
+  (define (f)
+    (let ((cc #f)
+	  (c2 0))
+      (call-with-exit
+       (lambda (c3) ; test call/exit re-entry
+	 (set! cc (call/cc (lambda (ret) ret)))
+	 (set! c2 (+ c2 1))
+	 (c3 3)
+	 (error 'oops "oops")))
+      (if (< c2 2)
+	  (cc 2)
+	  c2)))
+  (test (f) 2))
+
+(let ((x 1))
+  (define (outer g)
+    (g (+ x 32)))
+  (define (inner)
+    (call-with-exit
+     (lambda (return)
+       (set! x (+ x 1))
+       (outer return)
+       'error)))
+  (test (inner) 34))
+
+(test (let ((memb (lambda (x ls)
+		    (call-with-exit
+		     (lambda (break)
+		       (do ((ls ls (cdr ls)))
+			   ((null? ls) #f)
+			 (if (equal? x (car ls))
+			     (break ls))))))))
+	(list (memb 'd '(a b c))
+	      (memb 'b '(a b c))))
+      '(#f (b c)))
+
+(let* ((sum 0)
+       (val1 (call-with-exit
+	      (lambda (return)
+		(set! sum (+ sum 1))
+		(let ((val2 (call-with-exit
+			     (lambda (return)
+			       (set! sum (+ sum 1))
+			       (if #t (return sum))
+			       123))))
+		  (set! sum (+ sum val2))
+		  (return sum)
+		  32)))))
+  (test (list val1 sum) '(4 4)))
+
+(let ()
+  (define (fx ret)
+    (do ((n 0 (+ n 1)))
+	((= n 6) n)
+      (if (> n 3)
+	  (ret n))))
+  (test (call-with-exit fx) 4))
+
+(let ()
+  (define c #f)
+  (define (yow f)
+    (call-with-exit
+     (lambda (return)
+       (set! c return)
+       (f))))
+  (test (yow (lambda () (c 32))) 32))
+
+(let ((x 1))
+  (define y (call-with-exit (lambda (return) (set! x (return 32)))))
+  (test (and (= x 1) (= y 32)) #t)
+  (set! y (call-with-exit (lambda (return) ((lambda (a b c) (set! x a)) 1 2 (return 33)))))
+  (test (and (= x 1) (= y 33)) #t)
+  (set! y (call-with-exit (lambda (return) ((lambda (a b) (return a) (set! x b)) 2 3))))
+  (test (and (= x 1) (= y 2)) #t))
+
+(let ()
+  (define (f go)
+    (if (> 2 1) (go 32))
+    (display 'oops)
+    (newline))
+  (test (call-with-exit f) 32))
+
+(test (let ((x 0))
+	(define (quit z1) (z1 1) (set! x 1))
+	(call-with-exit
+	 (lambda (z)
+	   (set! x 2)
+	   (quit z)
+	   (set! x 3)))
+	x)
+      2)
+
+(let () ; this bug from K Matheussen
+  (define areas (list (lambda* (get-position) (get-position))))
+  (define (scroll! is-up)
+    (call-with-exit
+     (lambda (exit)
+       (define area (car areas))
+       (area :get-position
+	     (lambda ()
+	       (exit))))))
+  (test (scroll! #t) ())) ; will exit s7 if exit is marked global
+
+(test (let ((x (call/cc (lambda (k) k))))
+	(x (lambda (y) "hi")))
+      "hi")
+
+(test (((call/cc (lambda (k) k)) (lambda (x) x)) "hi") "hi")
+
+(test (let ((return #f)
+	    (lst ()))
+	(let ((val (+ 1 (call/cc
+			 (lambda (cont)
+			   (set! return cont)
+			   1)))))
+	  (set! lst (cons val lst)))
+	(if (= (length lst) 1)
+	    (return 10)
+	    (if (= (length lst) 2)
+		(return 20)))
+	(reverse lst))
+      '(2 11 21))
+
+(test (let ((r1 #f)
+	    (r2 #f)
+	    (lst ()))
+	(define (somefunc x y)
+	  (+ (* 2 (expt x 2)) (* 3 y) 1))
+	(let ((val (somefunc (call/cc
+			      (lambda (c1)
+				(set! r1 c1)
+				(c1 1)))
+			     (call/cc
+			      (lambda (c2)
+				(set! r2 c2)
+				(c2 1))))))
+	  (set! lst (cons val lst)))
+	(if (= (length lst) 1)
+	    (r1 2)
+	    (if (= (length lst) 2)
+		(r2 3)))
+	(reverse lst))
+      '(6 12 18))
+
+(let ((tree->generator
+       (lambda (tree)
+	 (let ((caller '*))
+	   (letrec
+	       ((generate-leaves
+		 (lambda ()
+		   (let loop ((tree tree))
+		     (cond ((null? tree) 'skip)
+			   ((pair? tree)
+			    (loop (car tree))
+			    (loop (cdr tree)))
+			   (else
+			    (call/cc
+			     (lambda (rest-of-tree)
+			       (set! generate-leaves
+				     (lambda ()
+				       (rest-of-tree 'resume)))
+			       (caller tree))))))
+		   (caller ()))))
+	     (lambda ()
+	       (call/cc
+		(lambda (k)
+		  (set! caller k)
+		  (generate-leaves)))))))))
+  (let ((same-fringe?
+	 (lambda (tree1 tree2)
+	   (let ((gen1 (tree->generator tree1))
+		 (gen2 (tree->generator tree2)))
+	     (let loop ()
+	       (let ((leaf1 (gen1))
+		     (leaf2 (gen2)))
+		 (if (eqv? leaf1 leaf2)
+		     (if (null? leaf1) #t (loop))
+		     #f)))))))
+
+    (test (same-fringe? '(1 (2 3)) '((1 2) 3)) #t)
+    (test (same-fringe? '(1 2 3) '(1 (3 2))) #f)))
+
+(let ()
+  (define (a-func)
+    (call-with-exit
+     (lambda (go)
+       (lambda ()
+	 (go + 32 1)))))
+
+  (define (b-func)
+    (call/cc
+     (lambda (go)
+       (lambda ()
+	 (go + 32 1)))))
+
+  (test ((a-func)) 'error) ;invalid-exit-function
+  (test ((b-func)) 33))
+
+#|
+(test ((call-with-exit
+	(lambda (go)
+	  (lambda ()
+	    (eval-string "(go + 32 1)")))))
+      'error)
+|#
+
+(test ((call/cc (lambda (go) (lambda () (eval-string "(go + 32 1)"))))) 33)
+
+(test ((call/cc
+	(lambda (go-1)
+	  (call/cc
+	   (lambda (go)
+	     (lambda ()
+	       (go (go-1 + 32 1))))))))
+      33)
+
+(for-each
+ (lambda (arg)
+   (test (let ((ctr 0))
+	   (let ((val (call/cc (lambda (exit)
+				 (do ((i 0 (+ i 1)))
+				     ((= i 10) 'gad)
+				   (set! ctr (+ ctr 1))
+				   (if (= i 1)
+				       (exit arg)))))))
+	     (and (equal? val arg)
+		  (= ctr 2))))
+	 #t))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(for-each
+ (lambda (arg)
+   (test (let ((ctr 0))
+	   (let ((val (call/cc (lambda (exit)
+				 (do ((i 0 (+ i 1)))
+				     ((= i 10) arg)
+				   (set! ctr (+ ctr 1))
+				   (if (= i 11)
+				       (exit 'gad)))))))
+	     (and (equal? val arg)
+		  (= ctr 10))))
+	 #t))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(test (let ((c #f)
+	    (r (string-copy "testing-hiho")))
+	(let ((v (call/cc (lambda (c0) (set! c c0) (list #\a 0)))))
+	  (let ((chr (car v))
+		(index (cadr v)))
+	    (string-set! r index chr)
+	    (set! index (+ index 1))
+	    (if (<= index 8)
+		(c (list (integer->char (+ 1 (char->integer chr))) index))
+		r))))
+      "abcdefghiiho")
+
+(test (let ((x 0)
+	    (again #f))
+	(call/cc (lambda (r) (set! again r)))
+	(set! x (+ x 1))
+	(if (< x 3) (again))
+	x)
+      3)
+
+(test (let* ((x 0)
+	     (again #f)
+	     (func (lambda (r) (set! again r))))
+	(call/cc func)
+	(set! x (+ x 1))
+	(if (< x 3) (again))
+	x)
+      3)
+
+(test (let* ((x 0)
+	     (again #f))
+	(call/cc (let ()
+		   (lambda (r) (set! again r))))
+	(set! x (+ x 1))
+	(if (< x 3) (again))
+	x)
+      3)
+
+(test (let ((x 0)
+	    (xx 0))
+	(let ((cont #f))
+	  (call/cc (lambda (c) (set! xx x) (set! cont c)))
+	  (set! x (+ x 1))
+	  (if (< x 3)	(cont))
+	  xx))
+      0)
+
+(test (call/cc procedure?) #t)
+(test (procedure? (call/cc (lambda (a) a))) #t)
+
+(for-each
+ (lambda (arg)
+   (test (call/cc (lambda (a) arg)) arg))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(let ((a (call/cc (lambda (a) a))))
+  (test (eq? a a) #t)
+  (test (eqv? a a) #t)
+  (test (equal? a a) #t)
+  (for-each
+   (lambda (ques)
+     (if (ques a)
+	 (format #t ";(~A ~A) returned #t?~%" ques a)))
+   question-ops))
+
+(test (let ((conts (make-vector 4 #f)))
+	(let ((lst ()))
+	  (set! lst (cons (+ (call/cc (lambda (a) (vector-set! conts 0 a) 0))
+			     (call/cc (lambda (a) (vector-set! conts 1 a) 0))
+			     (call/cc (lambda (a) (vector-set! conts 2 a) 0))
+			     (call/cc (lambda (a) (vector-set! conts 3 a) 0)))
+			  lst))
+	  (let ((len (length lst)))
+	    (if (< len 4)
+		((vector-ref conts (- len 1)) (+ len 1))
+		(reverse lst)))))
+      '(0 2 5 9))
+
+(test (let ((conts ()))
+	(let ((lst ()))
+	  (set! lst (cons (+ (call/cc (lambda (a) (if (< (length conts) 4) (set! conts (cons a conts))) 1))
+			     (* (call/cc (lambda (a) (if (< (length conts) 4) (set! conts (cons a conts))) 1))
+				(+ (call/cc (lambda (a) (if (< (length conts) 4) (set! conts (cons a conts))) 1))
+				   (* (call/cc (lambda (a) (if (< (length conts) 4) (set! conts (cons a conts))) 1)) 2))))
+			  lst))
+	  (let ((len (length lst)))
+	    (if (<= len 4)
+		((list-ref conts (- len 1)) (+ len 1))
+		(reverse lst)))))
+					; (+ 1 (* 1 (+ 1 (* 1 2)))) to start
+					; (+ 1 ...          2     )
+					; (+ 1 ...     3    [1]   )
+					; (+ 1 ...4    [1]        )
+					; (+ 5   [1]              )
+      '(4 6 6 13 8))
+
+(test (let ((conts (make-vector 4 #f)))
+	(let ((lst ()))
+	  (set! lst (cons (+ (call/cc (lambda (a) (if (not (vector-ref conts 0)) (vector-set! conts 0 a)) 0))
+			     (call/cc (lambda (a) (if (not (vector-ref conts 1)) (vector-set! conts 1 a)) 0))
+			     (call/cc (lambda (a) (if (not (vector-ref conts 2)) (vector-set! conts 2 a)) 0))
+			     (call/cc (lambda (a) (if (not (vector-ref conts 3)) (vector-set! conts 3 a)) 0)))
+			  lst))
+	  (let ((len (length lst)))
+	    (if (< len 4)
+		((vector-ref conts (- len 1)) (+ len 1))
+		(reverse lst)))))
+      '(0 2 3 4))
+
+(test (let ((conts ()))
+	(let ((lst ()))
+	  (set! lst (cons (+ (if (call/cc (lambda (a) (if (< (length conts) 4) (set! conts (cons a conts))) #f)) 1 0)
+			     (* (if (call/cc (lambda (a) (if (< (length conts) 4) (set! conts (cons a conts))) #f)) 2 1)
+				(+ (if (call/cc (lambda (a) (if (< (length conts) 4) (set! conts (cons a conts))) #f)) 1 0)
+				   (* (if (call/cc (lambda (a) (if (< (length conts) 4) (set! conts (cons a conts))) #f)) 2 1) 2))))
+			  lst))
+	  (let ((len (length lst)))
+	    (if (<= len 4)
+		((list-ref conts (- len 1)) #t)
+		(reverse lst)))))
+					; (+ 0 (* 1 (+ 0 (* 1 2)))) to start
+					; (+ 0 ...          2     )
+					; (+ 0 ...     1   [1]    )
+					; (+ 0 ...2   [0]         )
+					; (+ 1   [1]              )
+      '(2 4 3 4 3))
+
+(test (let ((call/cc 2)) (+ call/cc 1)) 3)
+(test (+ 1 (call/cc (lambda (r) (r 2 3 4))) 5) 15)
+(test (string-ref (call/cc (lambda (s) (s "hiho" 1)))) #\i)
+
+(let ((r5rs-ratify (lambda (ux err)
+		     (if (= ux 0.0)
+			 0
+			 (let ((tt 1)
+			       (a1 0)
+			       (b2 0)
+			       (a2 1)
+			       (b1 1)
+			       (a 0)
+			       (b 0)
+			       (ctr 0)
+			       (x (/ 1 ux)))
+			   (call-with-current-continuation
+			    (lambda (return)
+			      (do ()
+				  (#f)
+				(set! a (+ (* a1 tt) a2))
+				(set! b (+ (* tt b1) b2))
+					;(format #t "~A ~A~%" a (- b a))
+				(if (or (<= (abs (- ux (/ a b))) err)
+					(> ctr 1000))
+				    (return (/ a b)))
+				(set! ctr (+ 1 ctr))
+				(if (= x tt) (return))
+				(set! x (/ 1 (- x tt)))
+				(set! tt (floor x))
+				(set! a2 a1)
+				(set! b2 b1)
+				(set! a1 a)
+				(set! b1 b)))))))))
+
+  (test (r5rs-ratify (/ (log 2.0) (log 3.0)) 1/10000000) 665/1054)
+  (if (positive? 2147483648)
+      (test (r5rs-ratify (/ (log 2.0) (log 3.0)) 1/100000000000) 190537/301994)))
+
+#|
+(let ((max-diff 0.0)
+      (max-case 0.0)
+      (err 0.01)
+      (epsilon 1e-16))
+  (do ((i 1 (+ i 1)))
+      ((= i 100))
+    (let ((x (/ i 100.)))
+      (let ((vals (cr x err)))
+	(if (not (= (car vals) (cadr vals)))
+	    (let ((r1 (car vals))
+		  (r2 (cadr vals)))
+	      (let ((diff (abs (- r1 r2))))
+		(if (> diff max-diff)
+		    (begin
+		      (set! max-diff diff)
+		      (set! max-case x))))
+	      (if (> (abs (- r1 x)) (+ err epsilon))
+		(format #t "(rationalize ~A ~A) is off: ~A -> ~A~%" x err r1 (abs (- r1 x))))
+	      (if (> (abs (- r2 x)) (+ err epsilon))
+		(format #t "(ratify ~A ~A) is off: ~A -> ~A~%" x err r2 (abs (- r2 x))))
+	      (if (< (denominator r2) (denominator r1))
+		  (format #t "(ratify ~A ~A) is simpler? ~A ~A~%" x err r1 r2)))))))
+  (list max-case max-diff (cr max-case err)))
+|#
+
+(for-each
+ (lambda (arg)
+   (test (let ((ctr 0))
+	   (let ((val (call/cc
+		       (lambda (exit)
+			 (for-each (lambda (a)
+				     (if (equal? a arg) (exit arg))
+				     (set! ctr (+ ctr 1)))
+				   (list 0 1 2 3 arg 5))))))
+	     (list ctr val)))
+	 (list 4 arg)))
+ (list "hi" -1 #\a 11 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t '(1 . 2)))
+
+(test (+ 2 (call/cc (lambda (rtn) (+ 1 (let () (begin (define x (+ 1 (rtn 3)))) x))))) 5)
+
+
+;;; others from stackoverflow.com Paul Hollingsworth etc:
+
+(test (procedure? (call/cc (lambda (k) k))) #t)
+(test (call/cc (lambda (k) (+ 56 (k 3)))) 3)
+(test (apply
+       (lambda (k i)
+	 (if (> i 5)
+	     i
+	     (k (list k (* 2 i)))))
+       (call/cc (lambda (k) (list k 1))))
+      8)
+(test (apply
+       (lambda (k i n) (if (= i 0) n (k (list k (- i 1) (* i n)))))
+       (call/cc (lambda (k) (list k 6 1))))
+      720)
+(test (let* ((ka (call/cc (lambda (k) `(,k 1)))) (k (car ka)) (a (cadr ka)))
+	(if (< a 5) (k `(,k ,(* 2 a))) a))
+      8)
+
+(test (apply (lambda (k i n) (if (eq? i 0) n (k (list k (- i 1) (* i n))))) (call/cc (lambda (k) (list k 6 1)))) 720)
+(test ((call/cc (lambda (k) k)) (lambda (x) 5)) 5)
+
+(let ()
+  (define (generate-one-element-at-a-time a-list)
+    (define (generator)
+      (call/cc control-state))
+    (define (control-state return)
+      (for-each
+       (lambda (an-element-from-a-list)
+	 (set! return
+	       (call/cc
+		(lambda (resume-here)
+		  (set! control-state resume-here)
+		  (return an-element-from-a-list)))))
+       a-list)
+      (return 'you-fell-off-the-end-of-the-list))
+    generator)
+  (let ((gen (generate-one-element-at-a-time (list 3 2 1))))
+    (test (gen) 3)
+    (test (gen) 2)
+    (test (gen) 1)
+    (test (gen) 'you-fell-off-the-end-of-the-list)))
+
+;;; from Ferguson and Duego "call with current continuation patterns"
+(test (let ()
+	(define count-to-n
+	  (lambda (n)
+	    (let ((receiver
+		   (lambda (exit-procedure)
+		     (let ((count 0))
+		       (letrec ((infinite-loop
+				 (lambda ()
+				   (if (= count n)
+				       (exit-procedure count)
+				       (begin
+					 (set! count (+ count 1))
+					 (infinite-loop))))))
+			 (infinite-loop))))))
+	      (call/cc receiver))))
+	(count-to-n 10))
+      10)
+
+(test (let ()
+	(define product-list
+	  (lambda (nums)
+	    (let ((receiver
+		   (lambda (exit-on-zero)
+		     (letrec ((product
+			       (lambda (nums)
+				 (cond ((null? nums) 1)
+				       ((zero? (car nums)) (exit-on-zero 0))
+				       (else (* (car nums)
+						(product (cdr nums))))))))
+		       (product nums)))))
+	      (call/cc receiver))))
+	(product-list '(1 2 3 0 4 5)))
+      0)
+
+(begin
+  (define fact
+    ((lambda (f)
+       ((lambda (u) (u (lambda (x)
+			 (lambda (n) ((f (u x)) n)))))
+	(call/cc (call/cc (call/cc
+			   (call/cc (call/cc (lambda (x) x))))))))
+     (lambda (f) (lambda (n)
+		   (if (<= n 0) 1 (* n (f (- n 1))))))))
+  (test (map fact '(5 6 7)) '(120 720 5040)))
+
+;; http://okmij.org/ftp/Scheme/callcc-calc-page.html
+
+(test (let ()
+	(define product-list
+	  (lambda (nums)
+	    (let ((receiver
+		   (lambda (exit-on-zero)
+		     (letrec ((product
+			       (lambda (nums)
+				 (cond ((null? nums) 1)
+				       ((number? (car nums))
+					(if (zero? (car nums))
+					    (exit-on-zero 0)
+					    (* (car nums)
+					       (product (cdr nums)))))
+				       (else (* (product (car nums))
+						(product (cdr nums))))))))
+		       (product nums)))))
+	      (call/cc receiver))))
+	(product-list '(1 2 (3 4) ((5)))))
+      120)
+
+(test (call/cc (lambda () 0)) 'error)
+(test (call/cc (lambda (a) 0) 123) 'error)
+(test (call/cc (lambda (3) 9)) 'error)
+(test (call/cc (lambda arg 0)) 0)
+(test (call-with-exit (lambda arg 0)) 0)
+(test (call/cc) 'error)
+(test (call/cc abs) 'error)
+(for-each
+ (lambda (arg)
+   (test (call-with-exit arg) 'error)
+   (test (call-with-current-continuation arg) 'error)
+   (test (call/cc arg) 'error))
+ (list "hi" -1 () #(1 2) _ht_ _undef_ _null_ _c_obj_ #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(test (call/cc . 1) 'error)
+(test (call/cc abs) 'error)
+(test (+ 1 (call/cc (lambda (r1) (call/cc (lambda (r2) (r1 2 3))))) 4) 10)
+(test (+ 1 (call/cc (lambda (r1) (+ 5 (call/cc (lambda (r2) (r2 2 3)))))) 4) 15)
+
+;;; from Andy Wingo's Guile blog
+(let ()
+  (define (test1 get)
+    (let ((v (make-vector 2 #f)))
+      (vector-set! v 0 (get 0))
+      (vector-set! v 1 (get 1))
+      v))
+
+  (define (test2 get)
+    (let* ((a (get 0))
+	   (b (get 1)))
+      (vector a b)))
+
+  (define (discriminate f)
+    (let ((get-zero-cont #t)
+	  (first-result #f))
+      (define (get n)
+	(if (zero? n)
+	    (call/cc (lambda (k)
+		       (set! get-zero-cont k))))
+	n)
+      (let ((result (f get)))
+	(cond
+	 (first-result
+	  (eq? result first-result))
+	 (else
+	  (set! first-result result)
+	  (get-zero-cont))))))
+
+  (test (discriminate test1) #t)
+  (test (discriminate test2) #f)
+
+  (define (discriminate2 f)
+    (let ((get-zero-cont #f)
+	  (escape #f))
+      (define (get n)
+	(case n
+	  ((0) (call/cc (lambda (k)
+			  (set! get-zero-cont k)
+			  0)))
+	  ((1) (if escape
+		   (escape)
+		   1))))
+      (let ((result (f get)))
+	(call/cc
+	 (lambda (k)
+	   (set! escape k)
+	   (get-zero-cont 42)))
+	result)))
+
+  (test (discriminate2 test1) #(42 1))
+  (test (discriminate2 test2) #(0 1)))
+
+(let ()
+  (define (gotof x)
+    (x (cond ((continuation? x) 1)
+	     ((procedure? x) 2)
+	     ((macro? x) 3)
+	     ((sequence? x) 0)
+	     (else (throw 'oops 4)))))
+
+  (test (call/cc gotof) 1)
+  (test (call-with-exit gotof) 2)
+  (test (gotof abs) 2)
+  (test (gotof (define-macro (m1 a) `(+ ,a ))) 3)
+  (test (catch 'oops (lambda () (gotof 21)) (lambda (type info) (car info))) 4)
+  (test (gotof #(5 9 10 11 12)) 5))
+
+#|
+;;; from bug-guile
+(define k #f)
+(define result #f)
+(define results ())
+(set! result (map (lambda (x)
+                    (if x x (call/cc (lambda (c)
+                                       (set! k c)
+                                       1))))
+                  '(#t #f)))
+(set! results (cons result results))
+(write results)
+(newline)
+(if (< (cadr result) 5)
+    (k (+ 1 (cadr result))))
+(newline)
+
+the claim is that this should return
+
+((#t 1))
+((#t 2) (#t 1))
+((#t 3) (#t 2) (#t 1))
+((#t 4) (#t 3) (#t 2) (#t 1))
+((#t 5) (#t 4) (#t 3) (#t 2) (#t 1))
+
+but I think that depends on how we interpret the sequence of top-level statements.
+The test should be written:
+
+(let* ((k #f)
+       (results ()))
+  (let ((result (map (lambda (x)
+		       (if x x (call/cc (lambda (c)
+					  (set! k c)
+					  1))))
+		     '(#t #f))))
+    (set! results (cons result results))
+    (write results)
+    (newline)
+    (if (< (cadr result) 5)
+	(k (+ 1 (cadr result))))
+    (newline)))
+
+and then s7 is not following r6rs because it stops at
+
+((#t 1))
+((1 . #1=(#t 2)) #1#)
+
+saying cadr is not a number. I don't think this example is correct in any case --
+who says the continuation has to restart the map from the top?
+|#
+
+(let ((cont #f))
+  (let ((x (* (call/cc
+	       (lambda (return)
+		 (set! cont return)
+		 (return 3 4))))))
+    (if (= x 12)
+	(cont 5 6 7))
+    (test x 210)))
+
+;; Guile handles this very differently
+
+(test (let ((cont #f)) (call-with-exit (lambda (return) (set! cont return))) (cont 1)) 'error)
+(test (let ((cont #f)) (call-with-exit (lambda (return) (set! cont return))) (apply cont)) 'error)
+(test (let ((cont #f)) (call-with-exit (lambda (return) (set! cont return) (cont 1))) (apply cont)) 'error)
+(test (let ((cont #f)) (call-with-exit (lambda (return) (set! cont return) (cont 1))) (cont 1)) 'error)
+(test (procedure? (call-with-exit append)) #t)
+(test (procedure? (call-with-exit values)) #t)
+(test (procedure? (car (call-with-exit list))) #t)
+(test (call-with-exit (call-with-exit append)) 'error)
+(test (continuation? (call/cc (call/cc append))) #t)
+(test (procedure? (call-with-exit call-with-exit)) 'error) ; was #t until 9-Nov-20 -- now the inner call/exit returns an inactive goto
+(test (vector? (call-with-exit vector)) #t)
+(test (call-with-exit ((lambda args procedure?))) #t)
+(test (call-with-exit (let ((x 3)) (define (return y) (y x)) return)) 3)
+(test (call-with-exit (lambda (return) (with-input-from-string "hi" return))) ()) ; because thunk? -- does it close the port?
+(test (call-with-exit (lambda (return) (call-with-input-string "hi" return))) 'error)
+(test (call-with-exit (lambda (return) (set! (setter return) abs))) 'error)
+(test (call-with-exit (lambda (return) (dynamic-wind return (lambda () 1) (lambda () (error 'test-error "oops"))))) ())
+(test (call-with-exit (lambda (return) (map return '(1 2 3)))) 1)
+(test (call-with-exit (lambda (return) (dynamic-wind (lambda () 2) (lambda () 1) return))) ())                ; ?? is this a bug?
+(test (call-with-exit (lambda (return) (dynamic-wind (lambda () 2) (lambda () 1) (lambda () (return 3))))) 3) ; I guess not
+
+(test (let ((c1 #f)) (call-with-exit (lambda (c2) (call-with-exit (lambda (c3) (set! c1 c3) (c2))))) (c1)) 'error)
+(test (let ((c1 #f)) (call/cc (lambda (c2) (call-with-exit (lambda (c3) (set! c1 c3) (c2))))) (c1)) 'error)
+(test (let ((cont #f)) (catch #t (lambda () (call-with-exit (lambda (return) (set! cont return) (error 'testing " a test")))) (lambda args 'error)) (apply cont)) 'error)
+(test (let ((cont #f)) (catch #t (lambda () (call-with-exit (lambda (return) (set! cont return) (error 'testing " a test")))) (lambda args 'error)) (cont 1)) 'error)
+(test (let ((e (call-with-exit (lambda (go) (lambda () (go 1)))))) (e)) 'error)
+
+(test (let ((cc #f)
+	    (doit #t)
+	    (ctr 0))
+	(let ((ok (call-with-exit
+		   (lambda (c3)
+		     (call/cc (lambda (ret) (set! cc ret)))
+		     (c3 (let ((res doit)) (set! ctr (+ ctr 1)) (set! doit #f) res))))))
+	  (if ok (cc)))
+	ctr)
+      2)
+
+(test (let ((val (call-with-exit (lambda (ret) (let ((ret1 ret)) (ret1 2) 3))))) val) 2)
+(test (call-with-exit (lambda (return) (sort! '(3 2 1) return))) 'error) ; "sort! argument 2, #<goto>, is a goto ..."
+
+;;; this one from Rick
+(test (eval '(call/cc (lambda (go) (go 9) 0))) 9)
+(test (eval-string "(call/cc (lambda (go) (go 9) 0))") 9)
+(test (call-with-exit (lambda (return) (call/cc (lambda (go) (go 9) 0)) (return 1) 2)) 1)
+
+(num-test (/ 1 (call/cc (lambda (go) (go 9) 0))) 1/9)
+
+(test (call/cc (lambda (g) (call/cc (lambda (f) (f 1)) (g 2)))) 2) ; !! guile agrees! (evaluating the extraneous arg jumps)
+(test (call/cc (lambda (g) (abs -1 (g 2)))) 2)                     ; perhaps this should be an error
+(test (call/cc (lambda (g) (if #t #f #f (g 2)))) 'error)
+
+(test ((call-with-exit (lambda (go) (go go))) eval) 'error)
+(test ((call/cc (lambda (go) (go go))) eval) eval)
+(test (call-with-exit quasiquote) 'error)
+
+(test (call-with-exit (lambda (go) (if (go 1) (go 2) (go 3)))) 1)
+(test (call-with-exit (lambda (go) (set! (go 1) 2))) 'error)
+(test (call-with-exit (lambda (go) (let ((x 1) (y (go x))) #f))) 'error)
+(test (call-with-exit (lambda (go) (let* ((x 1) (y (go x))) #f))) 1)
+(test (call-with-exit (lambda (go) (letrec ((x 1) (y (go x))) #f))) #<undefined>)
+(test (call-with-exit (lambda (go) (letrec* ((x 1) (y (go x))) #f))) 1)
+(test (call-with-exit (lambda (go) (case (go 1) ((go 2) 3) (else 4)))) 1)
+(test (call-with-exit (lambda (go) (case go ((go 2) 3) (else 4)))) 4)
+(test (call-with-exit (lambda (go) (case 2 ((go 2) 3) (else 4)))) 3)
+(test (call-with-exit (lambda (go) (eq? go go))) #t)
+(test (call-with-exit (lambda (go) (case 'go ((go 2) 3) (else 4)))) 3)
+(test (call-with-exit (lambda (go) (go (go (go 1))))) 1)
+(test (call-with-exit (lambda (go) (quasiquote (go 1)))) '(go 1))
+
+;; these tests were messed up -- I forgot the outer parens
+(test (call-with-exit (lambda (go) ((lambda* ((a (go 1))) a) (go 2) 3))) 2)
+(test (call-with-exit (lambda (go) ((lambda* ((a (go 1))) a)))) 1)
+
+(test (call-with-exit (lambda (go) ((lambda (go) go) 1))) 1)
+(test (call-with-exit (lambda (go) (quote (go 1)) 2)) 2)
+(test (call-with-exit (lambda (go) (and (go 1) #f))) 1)
+(test (call-with-exit (lambda (go) (dynamic-wind (lambda () (go 1) 11) (lambda () (go 2) 12) (lambda () (go 3) 13)))) 1)
+
+(test (eval '(call/cc (lambda (go) (if (go 1) (go 2) (go 3))))) 1)
+(test (eval '(call/cc (lambda (go) (set! (go 1) 2)))) 'error)
+(test (eval '(call/cc (lambda (go) (let ((x 1) (y (go x))) #f)))) 'error)
+(test (eval '(call/cc (lambda (go) (let* ((x 1) (y (go x))) #f)))) 1)
+(test (eval '(call/cc (lambda (go) (letrec ((x 1) (y (go x))) #f)))) #<undefined>)
+(test (eval '(call/cc (lambda (go) (letrec* ((x 1) (y (go x))) #f)))) 1)
+(test (eval '(call/cc (lambda (go) (case (go 1) ((go 2) 3) (else 4))))) 1)
+(test (eval '(call/cc (lambda (go) (case go ((go 2) 3) (else 4))))) 4)
+(test (eval '(call/cc (lambda (go) (case 2 ((go 2) 3) (else 4))))) 3)
+(test (eval '(call/cc (lambda (go) (eq? go go)))) #t)
+(test (eval '(call/cc (lambda (go) (case 'go ((go 2) 3) (else 4))))) 3)
+(test (eval '(call/cc (lambda (go) (go (go (go 1)))))) 1)
+(test (eval '(call/cc (lambda (go) (quasiquote (go 1))))) '(go 1))
+(test (eval '(call/cc (lambda (go) ((lambda* (a (go 1)) a) (go 2))))) 2)
+(test (eval '(call/cc (lambda (go) ((lambda* (a (go 1)) a) 2)))) 2)
+(test (eval '(call/cc (lambda (go) ((lambda* (a (go 1)) a))))) #f)
+(test (eval '(call/cc (lambda (go) ((lambda (go) go) 1)))) 1)
+(test (eval '(call/cc (lambda (go) (quote (go 1)) 2))) 2)
+(test (eval '(call/cc (lambda (go) (and (go 1) #f)))) 1)
+(test (eval '(call/cc (lambda (go) (dynamic-wind (lambda () (go 1) 11) (lambda () (go 2) 12) (lambda () (go 3) 13))))) 1)
+
+(test (call-with-exit (lambda (go) (eval '(go 1)) 2)) 1)
+(test (call-with-exit (lambda (go) (eval-string "(go 1)") 2)) 1)
+(test (call-with-exit (lambda (go) `(,(go 1) 2))) 1)
+(test (call-with-exit (lambda (go) (case 0 ((0) (go 1) (go 2))))) 1)
+(test (call-with-exit (lambda (go) (cond (1 => go)) 2)) 1)
+(test (call-with-exit (lambda (go) (((cond ((go 1) => go)) 2)))) 1)
+(test (call-with-exit (lambda (go) (cond (1 => (go 2))))) 2)
+
+(test (call-with-exit (lambda (go) (go (eval '(go 1))) 2)) 1)
+(test (+ 10 (call-with-exit (lambda (go) (go (eval '(go 1))) 2))) 11)
+;(test (call-with-exit (lambda (go) (go (eval-string "(go 1)")) 2)) 1)
+;(test (call-with-exit (lambda (go) (eval-string "(go 1)") 2)) 1)
+(test (call-with-exit (lambda (go) ((eval 'go) 1) 2)) 1)
+(test (eval-string "(call/cc (lambda (go) (if (go 1) (go 2) (go 3))))") 1)
+(test (call-with-exit (lambda (quit) ((lambda* ((a (quit 32))) a)))) 32)
+(test ((call-with-exit (lambda (go) (go quasiquote))) go) 'go)
+
+(if original-test-macro
+  (let ((res #f))
+    (catch #t (lambda ()
+                (test (let ((y 2)) ((lambda () (let ((z 1)) (values y z))))) 'error)) ; binding result in test to the (values 2 1)
+              (lambda args (set! res 'error)))
+    (unless (eq? res 'error)
+      (format *stderr* "bind test result to (values 1 2) not an error?~%"))))
+
+(test (let ((x #f))
+	((lambda ()
+	   (let-temporarily ((x 1234))
+	     (call/cc (lambda (return) (let ((x 1) (y 2)) (return x y)))))
+	   (if x y) ; y unbound, so x better be #f
+	   3))) 3)
+
+(test (let ((x #f))
+	((lambda ()
+	   (call-with-exit
+	    (lambda (go)
+	      (let-temporarily ((x 1234))
+		(call/cc (lambda (return) (let ((x 1) (y 2)) (return x y)))))
+	      (if x y)
+	      (go 3)))))) 3)
+
+(test (let ((x #f))
+	((lambda ()
+	   (let-temporarily ((x 1234))
+	     (call-with-exit
+	      (lambda (go)
+		(call/cc (lambda (return) (let ((x 1) (y 2)) (return x y)))))))
+	   (if x y)
+	   3))) 3)
+
+(test (let ((x #f))
+	(dynamic-wind
+	    (lambda () #f)
+	    (lambda ()
+	      (let-temporarily ((x 1234))
+		(call/cc (lambda (return) (let ((x 1) (y 2)) (return x y)))))
+	      (if x y)
+	      3)
+	    (lambda () #f)))
+      3)
+
+(test (let ((c #f))
+	(let ((val -1))
+	  (set! val (call/cc
+		     (lambda (c1)
+		       (call-with-exit
+			(lambda (c2)
+			  (call-with-exit
+			   (lambda (c3)
+			     (call/cc
+			      (lambda (c4)
+				(set! c c4)
+				(c1 (c2 0)))))))))))
+	  (if (= val 0) (c 5))
+	  val))
+      5)
+
+(let ()
+  (define-macro (while test . body)      ; while loop with predefined break and continue
+    `(call-with-exit
+      (lambda (break)
+        (let loop ()
+	  (call-with-exit
+	   (lambda (continue)
+	     (do ()
+	         ((not ,test) (break))
+	       ,@body)))
+  	  (loop)))))
+
+  (test (+ (while #t (break 1 2 3))) 6)
+  (test (let ((sum 0)) (while (< sum 10) (set! sum (+ sum 1))) sum) 10)
+  (test (let ((sum 0)) (while (< sum 10) (set! sum (+ sum 1)) (continue) (break)) sum) 10)
+
+  (test (let ((i 0)
+              (sum 0))
+         (while (< i 10)
+          (set! sum (+ sum i))
+          (set! i (+ i 1))
+          (when (= i 6)
+            (continue)
+            (error 'oops "we reached the unreachable"))
+          (set! sum (+ sum i)))
+        sum)
+      94)
+
+  (test (let ((i 0)
+	      (sum 0)
+	      (break 32)
+	      (continue 48))
+	  (while (let ((break 10)
+                       (continue 0))
+		   (< i (+ break continue)))
+            (set! sum (+ sum 1))
+            (set! i (+ i 1))
+	    (if (< i 5) (continue))
+	    (set! sum (+ sum 10))
+	    (if (> i 7) (break))
+	    (set! sum (+ sum 100)))
+	  sum)
+	348))
+
+(test (call/cc (lambda (return)
+		 (let ((val (format #f "line 1~%line 2~%line 3")))
+		   (call-with-input-string val
+                     (lambda (p) (return "oops")))))) "oops")
+
+(test (call/cc (lambda (return)
+		 (let ((val (format #f "line 1~%line 2~%line 3")))
+		   (with-input-from-string val
+                     (lambda () (return "oops")))))) "oops")
+
+(test (call/cc (lambda (return)
+		 (let ((val (format #f "line 1~%line 2~%line 3")))
+		   (with-input-from-file "t923.scm"             ; on a new build, there won't be t923.scm unless we run full test first
+		     (lambda () (return "oops")))))) "oops")
+
+(test (call/cc (lambda (return)
+		 (let ((val (format #f "line 1~%line 2~%line 3")))
+		   (call-with-input-file "t923.scm"
+		     (lambda (p) (return "oops")))))) "oops")
+
+(test (call/cc (lambda (return) ; ok but no output?? (also below)
+		 (let ((val (format #f "line 1~%line 2~%line 3")))
+		   (with-output-to-string
+		     (lambda () (return "oops")))))) "oops")
+
+(test (call/cc (lambda (return) ; ok
+		 (let ((val (format #f "line 1~%line 2~%line 3")))
+		   (call-with-output-string
+		     (lambda (p) (return "oops")))))) "oops")
+
+(test (call/cc (lambda (return) ; ok
+		    (let ((val (format #f "line 1~%line 2~%line 3")))
+		      (call-with-output-file "t923.scm"
+		        (lambda (p) (return "oops")))))) "oops")
+
+(test (call/cc (lambda (return) ; ok
+		    (let ((val (format #f "line 1~%line 2~%line 3")))
+		      (with-output-to-file "t923.scm"
+		        (lambda () (return "oops")))))) "oops")
+
+(test (with-output-to-string (lambda () (display (memq (call/cc (lambda (return) (return 'a))) '(x a))))) "(a)")
+
+
+;;; --------------------------------------------------------------------------------
+;;; with-baffle
+
+(test (with-baffle) ())          ; ?? -- like begin I guess
+(test (apply with-baffle ()) ()) ;  again like begin
+(test (with-baffle 0) 0)
+(test (+ 1 (with-baffle (values 2 3)) 4) 10)
+(test (with-baffle . 1) 'error)
+(test (with-baffle 1 2 . 3) 'error)
+(test (let ((vals3t with-baffle)) (define (func) (do ((x 0.0 (+ x 0.1)) (i 0 (+ i 1))) ((= i 1) (vals3t (* 2 i 3 4))))) (func)) 24)
+
+(let ((b 0))
+  (define (f1) ; not baffled
+    (let ((a 1) (cc #f))
+      (call/cc (lambda (return) (set! cc return)))
+      (set! b (+ b a))
+      (if (< a 3) (begin (set! a (+ a 1)) cc) (lambda () #f))))
+  (define (g1) (let ((a 3)) ((f1))))
+  (test (g1) #f)
+  (test b 6)
+
+  (set! b 0)
+  (define (f2) ; baffled
+    (let ((a 1) (cc #f))
+      (with-baffle
+	(call/cc (lambda (return) (set! cc return)))
+	(set! b (+ b a))
+	(if (< a 3) (begin (set! a (+ a 1)) cc) (lambda () #f)))))
+  (define (g2) (let ((a 3)) (catch 'baffled! (lambda () ((f2))) (lambda (type info) (apply format #f info)))))
+  (test (g2) "continuation return can't jump into with-baffle")
+  (test b 1))
+
+(test (with-baffle
+       (let ((x 0)
+	     (c1 #f)
+	     (results ()))
+	 (set! x (call/cc
+		  (lambda (r1)
+		    (set! c1 r1)
+		    (r1 2))))
+	 (set! results (cons x results))
+	 (if (= x 2) (c1 32))
+	 results))
+      '(32 2))
+
+(test (let ((x 0)
+	    (c1 #f)
+	    (results ()))
+	(with-baffle
+	 (set! x (call/cc
+		  (lambda (r1)
+		    (set! c1 r1)
+		    (r1 2))))
+	 (set! results (cons x results)))
+	(if (= x 2) (c1 32))
+	results)
+      'error)
+
+(test (let ((what's-for-breakfast ())
+	    (bad-dog 'fido))        ; bad-dog wonders what's for breakfast?
+	(with-baffle                ; the syntax is (with-baffle . body)
+	  (set! what's-for-breakfast
+		(call/cc
+		 (lambda (biscuit?)
+		   (set! bad-dog biscuit?) ; bad-dog smells a biscuit!
+		   'biscuit!))))
+	(if (eq? what's-for-breakfast 'biscuit!)
+	    (bad-dog 'biscuit!))     ; now, outside the baffled block, bad-dog wants that biscuit!
+	what's-for-breakfast)        ;   but s7 says "No!": baffled! ("continuation can't jump into with-baffle")
+      'error)
+
+(test (+ (with-baffle (let ((c1 #f)) (call/cc (lambda (c2) (set! c1 c2) (c2 2))))) 1) 3)
+(test (+ (let ((c1 #f)) (with-baffle (call/cc (lambda (c2) (set! c1 c2) (c2 2)))) (c1 3)) 1) 'error)
+(test (let () (define (c3 a) (a 2)) (c3 (with-baffle (call/cc (lambda (c2) c2))))) 'error)
+(test (call-with-exit (lambda (return) (with-baffle (do () () (return 1))))) 1)
+(test (let () (define (hi) (null? (with-baffle))) (hi)) #t)
+(test (continuation? (with-baffle (call/cc (lambda (ret) ret)))) #t)
+(test (with-baffle (let ((cc #f)) (call/cc (lambda (r) (set! cc r))) (let ((c1 cc)) (if cc (begin (set! cc #f) (c1)) 32)))) 32)
+
+(let ((b 0))
+  (define (f2 x)
+    (let ((a x)
+	  (cc1 #f)
+	  (cc2 #f))
+	(with-baffle
+	  (with-baffle
+	    (call/cc (lambda (return1) (set! b (+ b 1)) (set! cc1 return))))
+	  (call/cc (lambda (return2) (set! b (+ b 2)) (set! cc2 return)))
+	  (set! b (+ b a)))
+      (if (= a 1)
+	  (begin
+	    (set! a (+ a 2))
+	    cc2)
+	  (if (< a 3)
+	      (begin
+		(set! a (+ a 1))
+		cc1)
+	      (lambda () #f)))))
+
+  (define (g2)
+    (let ((val (catch 'baffled!
+		 (lambda ()
+		   ((f2 0)))
+		 (lambda (type info)
+		   (apply format #f info)))))
+      (test val "continuation return1 can't jump into with-baffle"))
+    (test b 3)
+    (set! b 0)
+    (let ((val (catch 'baffled!
+                 (lambda ()
+ 	           ((f2 1)))
+                 (lambda (type info)
+	           (apply format #f info)))))
+      (test val "continuation return2 can't jump into with-baffle"))
+    (test b 4)))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; dynamic-wind
+;;; --------------------------------------------------------------------------------
+
+(test (let ((ctr1 0)
+	    (ctr2 0)
+	    (ctr3 0))
+	(let ((ctr4 (dynamic-wind
+			(lambda () (set! ctr1 (+ ctr1 1)))
+			(lambda () (set! ctr2 (+ ctr2 1)) (+ 1 ctr2))
+			(lambda () (set! ctr3 (+ ctr3 1))))))
+	  (= ctr1 ctr2 ctr3 (- ctr4 1) 1)))
+      #t)
+
+(test (let ((ctr1 0)
+	    (ctr2 0)
+	    (ctr3 0))
+	(let ((ctr4 (catch 'dw
+			   (lambda ()
+			     (dynamic-wind
+				 (lambda () (set! ctr1 (+ ctr1 1)))
+				 (lambda () (set! ctr2 (+ ctr2 1)) (error 'dw "dw-error") ctr2)
+				 (lambda () (set! ctr3 (+ ctr3 1)))))
+			   (lambda args (car args)))))
+	  (and (eq? ctr4 'dw)
+	       (= ctr1 1) (= ctr2 1) (= ctr3 1))))
+      #t)
+
+(test (let ((ctr1 0)
+	    (ctr2 0)
+	    (ctr3 0))
+	(let ((ctr4 (catch 'dw
+			   (lambda ()
+			     (dynamic-wind
+				 (lambda () (set! ctr1 (+ ctr1 1)))
+				 (lambda () (error 'dw "dw-error") (set! ctr2 (+ ctr2 1)) ctr2)
+				 (lambda () (set! ctr3 (+ ctr3 1)))))
+			   (lambda args (car args)))))
+	  (and (eq? ctr4 'dw)
+	       (= ctr1 1) (= ctr2 0) (= ctr3 1))))
+      #t)
+
+(test (let ((ctr1 0)
+	    (ctr2 0)
+	    (ctr3 0))
+	(let ((ctr4 (catch #t
+			   (lambda ()
+			     (dynamic-wind
+				 (lambda () (set! ctr1 (+ ctr1 1)) (error 'dw-init "dw-error"))
+				 (lambda () (set! ctr2 (+ ctr2 1)) (error 'dw "dw-error") ctr2)
+				 (lambda () (set! ctr3 (+ ctr3 1)))))
+			   (lambda args (car args)))))
+	  (and (eq? ctr4 'dw-init)
+	       (= ctr1 1) (= ctr2 0) (= ctr3 0))))
+      #t)
+
+(test (let ((ctr1 0)
+	    (ctr2 0)
+	    (ctr3 0))
+	(let ((ctr4 (catch #t
+			   (lambda ()
+			     (dynamic-wind
+				 (lambda () (set! ctr1 (+ ctr1 1)))
+				 (lambda () (set! ctr2 (+ ctr2 1)) ctr2)
+				 (lambda () (set! ctr3 (+ ctr3 1)) (error 'dw-final "dw-error"))))
+			   (lambda args (car args)))))
+	  (and (eq? ctr4 'dw-final)
+	       (= ctr1 1) (= ctr2 1) (= ctr3 1))))
+      #t)
+
+(test (let ((ctr1 0)
+	    (ctr2 0)
+	    (ctr3 0))
+	(let ((ctr4 (catch #t
+			   (lambda ()
+			     (dynamic-wind
+				 (lambda () (set! ctr1 (+ ctr1 1)))
+				 (lambda () (set! ctr2 (+ ctr2 1)) ctr2)
+				 (lambda () (error 'dw-final "dw-error") (set! ctr3 (+ ctr3 1)))))
+			   (lambda args (car args)))))
+	  (and (eq? ctr4 'dw-final)
+	       (= ctr1 1) (= ctr2 1) (= ctr3 0))))
+      #t)
+
+(test (let ((ctr1 0)
+	    (ctr2 0)
+	    (ctr3 0))
+	(let ((ctr4 (call/cc (lambda (exit)
+			       (dynamic-wind
+				   (lambda () (set! ctr1 (+ ctr1 1)))
+				   (lambda () (exit ctr2) (set! ctr2 (+ ctr2 1)) ctr2)
+				   (lambda () (set! ctr3 (+ ctr3 1)) 123))))))
+	  (and (= ctr1 ctr3 1)
+	       (= ctr2 ctr4 0))))
+      #t)
+
+(test (let ((ctr1 0)
+	    (ctr2 0)
+	    (ctr3 0))
+	(let ((ctr4 (call/cc (lambda (exit)
+			       (dynamic-wind
+				   (lambda () (exit ctr1) (set! ctr1 (+ ctr1 1)))
+				   (lambda () (set! ctr2 (+ ctr2 1)) ctr2)
+				   (lambda () (set! ctr3 (+ ctr3 1))))))))
+	  (= ctr1 ctr2 ctr3 ctr4 0)))
+      #t)
+
+(test (let ((ctr1 0)
+	    (ctr2 0)
+	    (ctr3 0))
+	(let ((ctr4 (call/cc (lambda (exit)
+			       (dynamic-wind
+				   (lambda () (set! ctr1 (+ ctr1 1)))
+				   (lambda () (set! ctr2 (+ ctr2 1)) ctr2)
+				   (lambda () (exit ctr3) (set! ctr3 (+ ctr3 1))))))))
+	  (and (= ctr1 ctr2 1)
+	       (= ctr3 ctr4 0))))
+      #t)
+
+(test (let ((path ())
+	    (c #f))
+	(let ((add (lambda (s)
+		     (set! path (cons s path)))))
+	  (dynamic-wind
+	      (lambda () (add 'connect))
+	      (lambda () (add (call-with-current-continuation
+			       (lambda (c0) (set! c c0) 'talk1))))
+	      (lambda () (add 'disconnect)))
+	  (if (< (length path) 4)
+	      (c 'talk2)
+	      (reverse path))))
+      '(connect talk1 disconnect  connect talk2 disconnect))
+
+
+(for-each
+ (lambda (arg)
+   (test (dynamic-wind (lambda () #f) (lambda () arg) (lambda () #f)) arg))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(test (dynamic-wind (lambda () #f) (lambda () #f) (lambda () #f)) #f)
+(test (+ 1 (dynamic-wind (lambda () #f) (lambda () (values 2 3 4)) (lambda () #f)) 5) 15)
+(test (let () (define-macro (makef val) `(lambda () ,val)) (dynamic-wind (lambda () #f) (makef 123) (lambda () #f))) 123)
+(test (dynamic-wind (lambda () #f) (define-macro (_m_) 32) (lambda () #f)) 32)
+(test (dynamic-wind (lambda () 123) #f (lambda () 321)) 'error) ; not sure about this
+
+(let ()
+  (define-macro (m) `(+ 1 2 3))
+  (test (dynamic-wind m m m) 6)
+  (test (dynamic-wind m (lambda () 123) m) 123)
+  (test (dynamic-wind (lambda () #f) m (lambda () #f)) 6)
+  (test (dynamic-wind (lambda () #f) m m) 6))
+;;; so... dynamic-wind init load quit would place the loaded defs in the current env -- transparent dw
+(let ()
+  (define-macro* (m (a 1)) `(define __asdf__ ,a))
+  (dynamic-wind (lambda () #f) m (lambda () #f))
+  (test __asdf__ 1))
+
+(test (let ((identity (lambda (a) a)))
+        (let ((x ())
+              (c #f))
+          (dynamic-wind
+	      (lambda () (set! x (cons 'a x)))
+	      (lambda ()
+		(dynamic-wind
+		    (lambda () (set! x (cons 'b x)))
+		    (lambda ()
+		      (dynamic-wind
+			  (lambda () (set! x (cons 'c x)))
+			  (lambda () (set! c (call/cc identity)))
+			  (lambda () (set! x (cons 'd x)))))
+		    (lambda () (set! x (cons 'e x))))
+		(dynamic-wind
+		    (lambda () (set! x (cons 'f x)))
+		    (lambda () (if c (c #f)))
+		    (lambda () (set! x (cons 'g x)))))
+	      (lambda () (set! x (cons 'h x))))
+          (reverse x)))
+      '(a b c d e f g b c d e f g h))
+
+#|
+(test (dynamic-wind
+	  (lambda args
+	    (if (not (null? args))
+		(format *stderr* "args: ~A~%": args)))
+	  (lambda args
+	    (if (not (null? args))
+		(format *stderr* "args: ~A~%": args))
+	    args)
+	  (lambda args
+	    (if (not (null? args))
+		(format *stderr* "args: ~A~%": args))))
+      ())
+|#
+
+(test (list (dynamic-wind
+		(lambda () #f)
+		(lambda () (values 'a 'b 'c))
+		(lambda () #f)))
+      (list 'a 'b 'c))
+
+(test (let ((ctr1 0)
+	    (ctr2 0)
+	    (ctr3 0))
+	(let ((val (dynamic-wind
+		       (lambda () #f)
+		       (lambda ()
+			 (set! ctr1 1)
+			 (call/cc
+			  (lambda (exit)
+			    (exit 123)
+			    (set! ctr2 2)
+			    321)))
+		       (lambda ()
+			 (set! ctr3 3)))))
+	  (and (= ctr1 1) (= ctr2 0) (= ctr3 3) (= val 123))))
+      #t)
+
+(test (let ((ctr1 0))
+	(let ((val (dynamic-wind
+		       (let ((a 1))
+			 (lambda ()
+			   (set! ctr1 a)))
+		       (let ((a 10))
+			 (lambda ()
+			   (set! ctr1 (+ ctr1 a))
+			   ctr1))
+		       (let ((a 100))
+			 (lambda ()
+			   (set! ctr1 (+ ctr1 a)))))))
+	  (and (= ctr1 111) (= val 11))))
+      #t)
+
+(test (let ((ctr1 0))
+	(let ((val (+ 3 (dynamic-wind
+			    (let ((a 1))
+			      (lambda ()
+				(set! ctr1 a)))
+			    (let ((a 10))
+			      (lambda ()
+				(set! ctr1 (+ ctr1 a))
+				ctr1))
+			    (let ((a 100))
+			      (lambda ()
+				(set! ctr1 (+ ctr1 a)))))
+		      1000)))
+	  (and (= ctr1 111) (= val 1014))))
+      #t)
+
+(test (let ((n 0))
+	(call-with-current-continuation
+	 (lambda (k)
+	   (dynamic-wind
+	       (lambda ()
+		 (set! n (+ n 1))
+		 (k))
+	       (lambda ()
+		 (set! n (+ n 2)))
+	       (lambda ()
+		 (set! n (+ n 4))))))
+	n)
+      1)
+
+(test (let ((n 0))
+	(call-with-current-continuation
+	 (lambda (k)
+	   (dynamic-wind
+	       (lambda () #f)
+	       (lambda ()
+		 (dynamic-wind
+		     (lambda () #f)
+		     (lambda ()
+		       (set! n (+ n 1))
+		       (k))
+		     (lambda ()
+		       (set! n (+ n 2))
+					;(k)
+		       )))
+	       (lambda ()
+		 (set! n (+ n 4))))))
+	n)
+      7)
+
+(test (let ((n 0))
+	(call-with-current-continuation
+	 (lambda (k)
+	   (dynamic-wind
+	       (lambda () #f)
+	       (lambda ()
+		 (dynamic-wind
+		     (lambda () #f)
+		     (lambda ()
+		       (dynamic-wind
+			   (lambda () #f)
+			   (lambda ()
+			     (set! n (+ n 1))
+			     (k))
+			   (lambda ()
+			     (if (= n 1)
+				 (set! n (+ n 2))))))
+		     (lambda ()
+		       (if (= n 3)
+			   (set! n (+ n 4))))))
+	       (lambda ()
+		 (if (= n 7)
+		     (set! n (+ n 8)))))))
+	n)
+      15)
+
+(test (dynamic-wind) 'error)
+(test (dynamic-wind (lambda () #f)) 'error)
+(test (dynamic-wind (lambda () #f) (lambda () #f)) 'error)
+(test (dynamic-wind (lambda (a) #f) (lambda () #f) (lambda () #f)) 'error)
+(test (dynamic-wind (lambda () #f) (lambda (a b) #f) (lambda () #f)) 'error)
+(test (dynamic-wind (lambda () #f) (lambda () #f) (lambda (a) #f)) 'error)
+(test (dynamic-wind (lambda () 1) #f (lambda () 2)) 'error)
+(test (dynamic-wind (lambda () #f) (lambda () 32) (lambda* (a b) a)) 'error)
+(test (dynamic-wind . 1) 'error)
+(test (dynamic-wind () () ()) 'error)
+(test (dynamic-wind () _ht_ _undef_ _null_ _c_obj_ ()) 'error)
+(test (dynamic-wind + + +) 0)
+(test (dynamic-wind (values + + +)) 0)
+(test (+ (dynamic-wind (lambda () (values 1 2 3)) (lambda () (values 4 5 6)) (lambda () (values 7 8 9)))) 15)
+(test (dynamic-wind #f (lambda () 32) #f) 32)
+(test (dynamic-wind #f (lambda () 32) #f #f) 'error)
+(test (let ((x 0)) (+ (dynamic-wind #f (lambda () 32) (lambda () (set! x 1))) x)) 33)
+
+(for-each
+ (lambda (arg)
+   (test (dynamic-wind arg (lambda () #f) (lambda () #f)) 'error)
+   (test (dynamic-wind (lambda () #f) arg (lambda () #f)) 'error)
+   (test (dynamic-wind (lambda () #f) (lambda () #f) arg) 'error))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(test (dynamic-wind (let ((x 1)) (lambda () x)) ((lambda () (lambda () 2))) (lambda () (*s7* 'version))) 2)
+(test (let ((x 0)) (dynamic-wind (lambda () (set! x 1)) ((lambda () (set! x 32) (lambda () x))) (let () (set! x 44) (lambda () x)))) 1)
+(test (let ((x 0)) (dynamic-wind (lambda () (set! x (+ x 1))) ((lambda () (set! x 32) (lambda () x))) (let () (set! x 44) (lambda () x)))) 45)
+(test (let ((x 0)) (dynamic-wind (lambda () (set! x (+ x 1))) ((lambda () (set! x 32) (lambda () x))) (let () (lambda () x)))) 33)
+(test (let ((x 0)) (dynamic-wind (lambda () (set! x (+ x 1))) ((lambda () (set! x (+ x 32)) (lambda () x))) (let () (lambda () (set! x (+ x 100)) x)))) 33)
+
+(test (let ((cc #f))
+	(dynamic-wind
+	  (lambda () (call/cc (lambda (r) (if (not cc) (set! cc r)) 32)))
+	  (lambda () (cc 33))
+	  (lambda () #f)))
+	'error)
+
+(test (let ((cc #f))
+        (dynamic-wind
+	  (lambda () (call/cc (lambda (r) (if (not cc) (set! cc r)) 32)))
+	  (lambda () #f)
+	  (lambda () (cc 33))))
+        'error)
+
+(test (let ((cc #f))
+        (dynamic-wind
+	  (lambda () (call/cc (lambda (r) (if (not cc) (set! cc r)) 32)))
+	  (lambda () #f)
+	  (lambda () #f))
+	  (cc 33))
+	'error)
+
+(let () ; call/cc copy_stack clears opt2_con, affected op_c_catch_all -> catch_all_function
+  (define (func)
+    (let ((x #f))
+      (define (ff) 1)
+      (catch #t
+	(lambda () (ff (call/cc (lambda (cc) (cc 1)))))
+	(lambda (type info) 'error)))) ; must be simple case to hit the bug
+  (test (func) 'error))
+
+(test (let ((cc #f))
+        (let ((result
+          (dynamic-wind
+	    (lambda () (call/cc (lambda (r) (if (not cc) (set! cc r)) 32)))
+	    (lambda () (cc 33))
+	    (lambda () (cc 34)))))
+	    (cc 35)))
+	'error)
+
+(test (let ((x 32)
+	    (cc #f))
+	(let ((clo (lambda () (call/cc (lambda (r) (if (not cc) (set! cc r)))) x)))
+	  (catch #t
+	    (lambda ()
+	      (let ((cc #f))
+		(dynamic-wind
+		    clo
+		    (lambda () (cc 33))
+		    (lambda () #f))))
+	    (lambda args
+	      (clo)))))
+      32)
+
+(test ((lambda ()
+	 (dynamic-wind
+	     (lambda () #f)
+	     (lambda ()
+	       (let ((!x #f)
+		     (_b_ 32))
+		 (dynamic-wind
+		     (lambda ()
+		       (set! !x (call/cc (lambda (_a_)
+					   (_a_ _b_)))))
+		     (lambda () !x)
+		     (lambda () (set! !x #f)))))
+	     (lambda () #f))))
+      32)
+
+(test (let-temporarily (((hook-functions *unbound-variable-hook*) (list (lambda (hook) (set! (hook 'result) 32)))))
+	(let ((!x #f))
+	  (dynamic-wind
+	      (lambda () (set! !x (call-with-exit (lambda (_a_) (_a_ _b_)))))
+	      (lambda () !x)
+	      (lambda () (set! !x #f))))) 32)
+
+(test (let-temporarily (((hook-functions *unbound-variable-hook*) (list (lambda (hook) (set! (hook 'result) 32)))))
+	(let ((!x #f))
+	  (dynamic-wind
+	      (lambda () (set! !x (call/cc (lambda (_a_) _b_))))
+	      (lambda () !x)
+	      (lambda () (set! !x #f))))) 32)
+
+(test (let ((!x #f)
+	    (_b_ 32))
+	(dynamic-wind
+	    (lambda () (set! !x (call/cc (lambda (_a_) (_a_ _b_)))))
+	    (lambda () !x)
+	    (lambda () (set! !x #f)))) 32)
+
+(test (let-temporarily (((hook-functions *unbound-variable-hook*) (list (lambda (hook) (set! (hook 'result) 32)))))
+	(let ((!x #f))
+	  (dynamic-wind
+	      (lambda () (set! !x (call/cc (lambda (_a_) (_a_ _b_)))))
+	      (lambda () !x)
+	      (lambda () (set! !x #f))))) 32)
+
+(test (let-temporarily (((hook-functions *unbound-variable-hook*) (list (lambda (hook) (set! (hook 'result) 32)))))
+	(let ((!x #f))
+	  (dynamic-wind
+	      (lambda () #f)
+	      (lambda () (set! !x (call/cc (lambda (_a_) (_a_ _b_)))) !y)
+	      (lambda () #f)))) 32)
+
+(test (let-temporarily (((hook-functions *unbound-variable-hook*) (list (lambda (hook) (set! (hook 'result) 32)))))
+	(let ((!x #f))
+	  (dynamic-wind
+	      (lambda () #f)
+	      (lambda () #f)
+	      (lambda () (set! !x (call/cc (lambda (_a_) (_a_ _b_)))))))) #f)
+
+(test (let ((!x #f)
+	    (_b_ 32))
+	(dynamic-wind
+	    (lambda () (let-temporarily ((_b_ 100)) (set! !x (call/cc (lambda (_a_) (_a_ _b_))))))
+	    (lambda () (cons !x _b_))
+	    (lambda () (set! !x #f)))) '(100 . 32))
+
+(test (let ((!x #f)
+	    (_b_ 32)
+	    (_c_ ()))
+	(set! _c_ (cons (let-temporarily ((_b_ 100))
+			  (call/cc (lambda (_a_) (unless !x (set! !x _a_)) (_a_ _b_) 123)))
+			_c_))
+	(set! _c_ (cons _b_ _c_))
+	(let ((!y !x))
+	  (set! !x #f)
+	  (if !y (!y 32)))
+	(reverse _c_))
+      '(100 32 32 32))
+
+(let ()
+  (define-macro (make-thunk val) `(lambda () ,val))
+  (test (dynamic-wind (make-thunk 0) (make-thunk 1) (make-thunk 2)) 1))
+
+(let ((jumps 4))
+
+  (define (test1 f)
+    (let ((c #f) (ctr 0))
+      (dynamic-wind
+	  (lambda () #f)
+	  (lambda () (when (not c) (call/cc (lambda (k) (set! c k)))) (set! ctr (+ ctr 1)))
+	  (lambda () #f))
+      (if (< ctr f) (c))
+      ctr))
+
+  (define (test2 f)
+    (let ((c #f) (ctr 0))
+      (dynamic-wind
+	  (lambda () #f)
+	  (lambda () (with-baffle (when (not c) (call/cc (lambda (k) (set! c k)))) (set! ctr (+ ctr 1))))
+	  (lambda () #f))
+      (if (< ctr f) (c))
+      ctr))
+
+  (test (test2 jumps) 'error)
+  (test (test1 jumps) 4)
+
+  (define (test3 f)
+    (let ((c #f) (ctr 0))
+      (dynamic-wind
+	  (lambda () #f)
+	  (lambda () #f)
+	  (lambda () (when (not c) (call/cc (lambda (k) (set! c k)))) (set! ctr (+ ctr 1))))
+      (if (< ctr f) (c))
+      ctr))
+
+  (define (test4 f)
+    (let ((c #f) (ctr 0))
+      (dynamic-wind
+	  (lambda () #f)
+	  (lambda () #f)
+	  (lambda () (with-baffle (when (not c) (call/cc (lambda (k) (set! c k)))) (set! ctr (+ ctr 1)))))
+      (if (< ctr f) (c))
+      ctr))
+
+  (test (test4 jumps) 'error)
+  (test (test3 jumps) 'error)
+
+  (define (test5 f)
+    (let ((c #f) (ctr 0))
+      (dynamic-wind
+	  (lambda () (when (not c) (call/cc (lambda (k) (set! c k)))) (set! ctr (+ ctr 1))) ; error now 12-Aug-18
+	  (lambda () #f)
+	  (lambda () #f))
+      (if (< ctr f) (c))
+      ctr))
+
+  (define (test6 f)
+    (let ((c #f) (ctr 0))
+      (dynamic-wind
+	  (lambda () (with-baffle (when (not c) (call/cc (lambda (k) (set! c k)))) (set! ctr (+ ctr 1))))
+	  (lambda () #f)
+	  (lambda () #f))
+      (if (< ctr f) (c))
+      ctr))
+
+  (test (test6 jumps) 'error)
+  (test (test5 jumps) 'error))
+#|
+;;; from scheme wiki
+;;; http://community.schemewiki.org/?hose-the-repl
+;;; jorgen-schafer
+
+(test (let loop ()
+	(call-with-exit
+	 (lambda (k)
+	   (dynamic-wind
+	       (lambda () #t)
+	       (lambda () (let loop () (loop)))
+	       k)))
+	(loop))
+      'error)
+;; that example calls to mind a bunch like it:
+(test (call-with-exit (lambda (k) (dynamic-wind (lambda () #t) (lambda () (let loop () (loop))) k))) 'error)
+(test (call-with-exit (lambda (k) (dynamic-wind (lambda () #t) k (lambda () #t)))) 'error)
+(test (call-with-exit (lambda (k) (dynamic-wind k (lambda () #f) (lambda () #t)))) 'error)
+|#
+
+
+;;; dynamic-unwind
+
+(test (dynamic-unwind 123 123) 'error)
+(let ()
+  (define (report-1 arg value) (list arg value))
+  (define (f x)
+    (dynamic-unwind report-1 x)
+    32) ; report-1 is called with x 32 -- 32 is the value returned by f
+  (test (f 12) '(12 32))
+
+  (define (f2 x y)
+    (dynamic-unwind report-1 (list x y))
+    32)
+  (test (f2 12 11) '((12 11) 32)))
+
+(let ()
+  (define (report-2 arg value other) (display arg) (display #\space) (display value) (display #\space) (display other))
+  (define (f3 x y) (dynamic-unwind report-2 (list x y)) 32)
+  (test (f3 12 11) 'error)
+
+  (define (report-3 . args) (display args))
+  (define (f4 x y) (dynamic-unwind report-3 (list x y)) 32)
+  (test (f4 12 11) 'error))
+
+
+(test (call-with-exit (lambda (k) (documentation k))) "")
+(test (call-with-exit (lambda (k) (procedure-source k))) ())
+
+(test (let ((pws (dilambda vector-ref vector-set!)))
+	(let ((pws1 (dilambda pws vector-set!)))
+	  (let ((v (vector 1 2)))
+	    (set! (pws1 v 1) 32)
+	    (pws1 v 1))))
+      32)
+(test (call-with-exit (lambda (k) (map k '(1 2 3)))) 1)
+(test (call-with-exit (lambda (k) (for-each k '(1 2 3)))) 1)
+(test (call-with-exit (lambda (k) (catch #t k k))) ()) ; was 'error until 14-May-14
+(test (call-with-exit (lambda (k) (catch #t (lambda () #f) k))) #f)
+;(test (call-with-exit (lambda (k) (catch #t (lambda () (error 'an-error)) k))) 'error) ; this seems like it could be either
+(test (call-with-exit (lambda (k) (sort! '(1 2 3) k))) 'error) ; "sort! argument 2, #<goto>, is a goto"
+(test (sort! '(1 2 3) (lambda () #f)) 'error)
+(test (sort! '(1 2 3) (lambda (a) #f)) 'error)
+(test (sort! '(1 2 3) (lambda (a b c) #f)) 'error)
+;(test (let () (define-macro (asdf a b) `(< ,a ,b)) (sort! '(1 2 3) asdf)) 'error)
+(test (let () (let asdf () (sort! '(1 2 3) asdf))) 'error)
+(test (let () (let asdf () (map asdf '(1 2 3)))) 'error)
+(test (let () (let asdf () (for-each asdf '(1 2 3)))) 'error)
+(test (sort! '(1 2 3) (define-macro (_m_ a b) `(> ,a ,b))) '(3 2 1))
+(test (sort! '(2 1 3) (define-macro (_m_ a b) `(< ,a ,b))) '(1 2 3))
+
+(test (let ((ctr 0))
+	(call-with-exit
+	 (lambda (exit)
+	   (let asdf
+	       ()
+	     (set! ctr (+ ctr 1))
+	     (if (> ctr 2)
+		 (exit ctr))
+	     (dynamic-wind
+		 (lambda () #f)
+		 (lambda () #f)
+		 asdf)))))
+      3)
+
+(test (let ((ctr 0))
+	(dynamic-wind
+	    (lambda () #f)
+	    (lambda ()
+	      (call-with-exit
+	       (lambda (exit)
+		 (catch #t
+			(lambda ()
+			  (error 'error))
+			(lambda args
+			  (exit 'error)))
+		 (set! ctr 1))))
+	    (lambda ()
+	      (set! ctr (+ ctr 2))))
+	ctr)
+      2)
+(test (call-with-exit (lambda (r1) (call-with-exit (lambda (r2) (call-with-exit (lambda (r3) (r1 12) (r2 1))) (r1 2))) 3)) 12)
+(test (call-with-exit (lambda (r1) (call-with-exit (lambda (r2) (call-with-exit (lambda (r3) (r2 12) (r2 1))) (r1 2))) 3)) 3)
+(test (call-with-exit (lambda (r1) (call-with-exit (lambda (r2) (call-with-exit (lambda (r3) (r3 12) (r2 1))) (r1 2))) 3)) 2)
+
+;; make sure call-with-exit closes ports
+(test (let ((p (call-with-exit (lambda (return)
+				 (call-with-input-file tmp-output-file
+				   (lambda (port)
+				     (return port)))))))
+	(port-closed? p))
+      #t)
+(test (let ((p (call-with-exit (lambda (return)
+				 (call-with-input-file tmp-output-file
+				   (lambda (port)
+				     (if (not (port-closed? port)) (return port))))))))
+	(port-closed? p))
+      #t)
+(test (let ((p (call-with-exit (lambda (return)
+				 (with-input-from-file tmp-output-file
+				   (lambda ()
+				     (return (current-input-port))))))))
+	(port-closed? p))
+      #t)
+(test (let ((p (call-with-exit (lambda (return)
+				 (with-output-to-file "empty-file"
+				   (lambda ()
+				     (return (current-output-port))))))))
+	(port-closed? p))
+      #t)
+(test (let ((p (call-with-exit (lambda (return)
+				 (call-with-output-file "empty-file"
+				   (lambda (port)
+				     (return port)))))))
+	(port-closed? p))
+      #t)
+(test (let ((p (call-with-exit (lambda (return)
+				 (call-with-input-string "this is a test"
+				   (lambda (port)
+				     (return port)))))))
+	(port-closed? p))
+      #t)
+(test (let ((p (call-with-exit (lambda (return)
+				 (call-with-output-string
+				   (lambda (port)
+				     (return port)))))))
+	(port-closed? p))
+      #t)
+
+(let ((p (current-input-port)))
+  (catch #t
+    (lambda () (with-input-from-string "asdf" (call/cc (lambda (cc) cc))))
+    (lambda (type info) 'error))
+  (test (eq? p (current-input-port)) #t)
+  (catch #t
+    (lambda () (define (func) (with-input-from-string "asdg" (call/cc (lambda (cc) cc)))) (define (hi) (func)) (hi))
+    (lambda (type info) 'error))
+  (test (eq? p (current-input-port)) #t))
+
+(let ((pws (dilambda < >))) (test (sort! '(2 3 1 4) pws) '(1 2 3 4)))
+(test (call-with-exit (lambda (k) (call-with-input-string "123" k))) 'error)
+(test (call-with-exit (lambda (k) (call-with-input-file tmp-output-file k))) 'error)
+(test (call-with-exit (lambda (k) (call-with-output-file tmp-output-file k))) 'error)
+(test (call-with-exit (lambda (k) (call-with-output-string k))) 'error)
+(test (call-with-output-string (hash-table 'b 2)) 'error)
+(test (call-with-output-string #(1 2)) 'error)
+(test (call-with-output-string (inlet 'a 1)) 'error)
+(test (call-with-output-file (hash-table 'b 2)) 'error)
+(test (call-with-output-file #(1 2)) 'error)
+(test (call-with-output-file (inlet 'a 1)) 'error)
+(test (call-with-output-file (call/cc (lambda (cc) cc))) 'error)
+(test (call-with-output-file (call-with-exit (lambda (goto) goto))) 'error)
+(let ((pws (dilambda (lambda (a) (+ a 1)) (lambda (a b) b))))
+  (test (procedure? pws) #t)
+  (test (map pws '(1 2 3)) '(2 3 4))
+  (test (apply pws '(1)) 2))
+(test (let ((ctr 0)) (call-with-exit (lambda (top-exit) (set! ctr (+ ctr 1)) (call-with-exit top-exit) (set! ctr (+ ctr 16)))) ctr) 1)
+
+(test (let () (+ 5 (call-with-exit (lambda (return) (return 1 2 3) 4)))) 11)
+(test (+ 5 (call-with-exit (lambda (return) (return 1)))) 6)
+(test (+ 5 (call-with-exit (lambda (return) (return)))) 'error)
+
+(test (let ((cur ()))
+	(define (step pos)
+	  (dynamic-wind
+	      (lambda ()
+		(set! cur (cons pos cur)))
+	      (lambda ()
+		(set! cur (cons (+ pos 1) cur))
+		(if (< pos 40)
+		    (step (+ pos 10)))
+		(set! cur (cons (+ pos 2) cur))
+		cur)
+	      (lambda ()
+		(set! cur (cons (+ pos 3) cur)))))
+	(reverse (step 0)))
+      '(0 1 10 11 20 21 30 31 40 41 42 43 32 33 22 23 12 13 2))
+
+
+(test (let ((cur ()))
+	(define (step pos)
+	  (dynamic-wind
+	      (lambda ()
+		(set! cur (cons pos cur)))
+	      (lambda ()
+		(set! cur (cons (+ pos 1) cur))
+		(if (< pos 40)
+		    (step (+ pos 10))
+		    (error 'all-done))
+		(set! cur (cons (+ pos 2) cur))
+		cur)
+	      (lambda ()
+		(set! cur (cons (+ pos 3) cur)))))
+	(catch 'all-done
+	       (lambda ()
+		 (reverse (step 0)))
+	       (lambda args (reverse cur))))
+      '(0 1 10 11 20 21 30 31 40 41 43 33 23 13 3))
+
+(test (let ((cur ()))
+	(define (step pos ret)
+	  (dynamic-wind
+	      (lambda ()
+		(set! cur (cons pos cur)))
+	      (lambda ()
+		(set! cur (cons (+ pos 1) cur))
+		(if (< pos 40)
+		    (step (+ pos 10) ret)
+		    (ret (reverse cur)))
+		(set! cur (cons (+ pos 2) cur))
+		cur)
+	      (lambda ()
+		(set! cur (cons (+ pos 3) cur)))))
+	(list (call-with-exit
+	       (lambda (ret)
+		 (step 0 ret)))
+	      (reverse cur)))
+      '((0 1 10 11 20 21 30 31 40 41) (0 1 10 11 20 21 30 31 40 41 43 33 23 13 3)))
+
+(test (let ()
+	(catch #t
+	       (lambda ()
+		 (eval-string "(error 'hi \"hi\")"))
+	       (lambda args
+		 'error)))
+      'error)
+(test (let ()
+	(catch #t
+	       (lambda ()
+		 (eval-string "(+ 1 #\\a)"))
+	       (lambda args
+		 'oops)))
+      'oops)
+#|
+(test (let ()
+	(call-with-exit
+	 (lambda (return)
+	   (eval-string "(return 3)"))))
+      3)
+
+(test (let ()
+	(call-with-exit
+	 (lambda (return)
+	   (eval-string "(abs (+ 1 (if #t (return 3))))"))))
+      3)
+|#
+(test (let ()
+	(call-with-exit
+	 (lambda (return)
+	   (eval '(return 3)))))
+      3)
+
+(test (let ()
+	(call-with-exit
+	 (lambda (return)
+	   (eval '(abs (+ 1 (if #t (return 3))))))))
+      3)
+(test (let ((val (catch #t
+			(lambda ()
+			  (eval-string "(catch 'a (lambda () (+ 1 __asdf__)) (lambda args 'oops))"))
+			(lambda args 'error))))
+	val)
+      'error)
+
+(test (let ((val (catch #t
+			(lambda ()
+			  (eval `(catch 'a (lambda () (+ 1 __asdf__)) (lambda args 'oops))))
+			(lambda args 'error))))
+	val)
+      'error)
+
+(test ((lambda* ((x 1) (y 2)) (+ x y)) (eval-string "(values 3 4)")) 7)
+
+(test (let ()
+	(call/cc
+	 (lambda (ret)
+	   (eval-string "(ret 3)"))))
+      3)
+
+(test (let ()
+	(call/cc
+	 (lambda (ret)
+	   (eval '(ret 3)))))
+      3)
+(test (let ()
+	(call/cc
+	 (lambda (ret)
+	   (ret 3))))
+      3)
+(test (let ()
+	(call-with-exit
+	 (lambda (ret)
+	   (eval-string "(ret 3)"))))
+      3)
+
+(let ((x 0)
+      (y 0)
+      (z 0))
+  (define (dw1 a c)
+    (dynamic-wind
+	(lambda ()
+	  (set! x (+ x 1)))
+	(lambda ()
+	  (set! y (+ y 1))
+	  (or (and (>= a c) a)
+	      (dw1 (+ a 1) c)))
+	(lambda ()
+	  (set! z (+ z 1))
+	  (set! y (- y 1)))))
+  (let ((val (dw1 0 8)))
+    (test (list val x y z) (list 8 9 0 9))))
+
+(let ((x 0)
+      (y 0)
+      (z 0))
+  (define (dw1 a c)
+    (catch #t
+	   (lambda ()
+	     (dynamic-wind
+		 (lambda ()
+		   (set! x (+ x 1)))
+		 (lambda ()
+		   (set! y (+ y 1))
+		   (or (and (>= a c) a)
+		       (dw1 (+ a 1) c)))
+		 (lambda ()
+		   (set! z (+ z 1))
+		   (set! y (= y 1))))) ; an error after the first call because we have (= #f 1)
+	   (lambda args 'error)))
+  (let ((val (dw1 0 4)))
+    (test val 'error)))
+
+(let ((x 0)
+      (y 0)
+      (z 0))
+  (define (dw1 a c)
+    (catch #t
+	   (lambda ()
+	     (dynamic-wind
+		 (lambda ()
+		   (set! x (+ x 1)))
+		 (lambda ()
+		   (set! y (= y 1)) ; an error after the first call because we have (= #f 1)
+		   (or (and (>= a c) a)
+		       (dw1 (+ a 1) c)))
+		 (lambda ()
+		   (set! z (+ z 1))
+		   (set! y (= y 1)))))
+	   (lambda args 'error)))
+  (let ((val (dw1 0 4)))
+    (test val 'error)))
+
+(let ((x 0)
+      (y 0)
+      (z 0))
+  (define (dw1 a c)
+    (catch #t
+	   (lambda ()
+	     (dynamic-wind
+		 (lambda ()
+		   (set! x (= x 1))) ; an error after the first call because we have (= #f 1)
+		 (lambda ()
+		   (set! y (= y 1))
+		   (or (and (>= a c) a)
+		       (dw1 (+ a 1) c)))
+		 (lambda ()
+		   (set! z (+ z 1))
+		   (set! y (= y 1)))))
+	   (lambda args 'error)))
+  (let ((val (dw1 0 4)))
+    (test val 'error)))
+
+(let ((x 0)
+      (y 0)
+      (z 0))
+  (let ((val (call-with-exit
+	      (lambda (r)
+		(catch #t
+		       (lambda ()
+			 (dynamic-wind
+			     (lambda ()
+			       (set! x (+ x 1)))
+			     (lambda ()
+			       (set! y (+ y 1))
+			       (r y))
+			     (lambda ()
+			       (set! z (+ z 1)))))
+		       (lambda args 'error))))))
+    (test (list val z) '(1 1))))
+
+(let ((x 0)
+      (y 0)
+      (z 0))
+  (let ((val (catch #t
+		    (lambda ()
+		      (dynamic-wind
+			  (lambda ()
+			    (set! x (+ x 1)))
+			  (lambda ()
+			    (call-with-exit
+			     (lambda (r)
+			       (set! y r)
+			       x)))
+			  (lambda ()
+			    (set! z (+ z 1))
+			    (y z))))
+		    (lambda args 'error))))
+    (test val 'error)))
+
+(test (dynamic-wind
+	  (lambda () (eq? (let ((lst (cons 1 2))) (set-cdr! lst lst) lst) (call/cc (lambda (k) k))))
+	  (lambda () #f)
+	  (lambda () #f))
+      #f)
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; quasiquote
+;;; --------------------------------------------------------------------------------
+
+(test `(1 2 3) '(1 2 3))
+(test `() ())
+(test `(list ,(+ 1 2) 4)  '(list 3 4))
+(test `(1 ,@(list 1 2) 4) '(1 1 2 4))
+(test `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b) '(a 3 4 5 6 b))
+(test `(a `(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f) '(a `(b ,(+ 1 2) ,(foo 4 d) e) f))
+;(test (let ((name1 'x) (name2 'y)) `(a `(b ,,name1 ,',name2 d) e)) '(a `(b ,x ,'y d) e)) ; list vs list-values confusion
+(test `(1 2 ,(* 9 9) 3 4) '(1 2 81 3 4))
+(test `(1 ,(+ 1 1) 3) '(1 2 3))
+(test `(,(+ 1 2)) '(3))
+(test `(,'a . ,'b) (cons 'a 'b))
+(test `(,@'() . foo) 'foo)
+(test `(1 , 2) '(1 2))
+(test `(1 , @(list 2 3)) 'error) ; ?? this is an error in Guile and Clisp
+(test `(1 ,@ (list 2 3)) '(1 2 3)) ; seems a bit arbitrary
+(test `(1 ,@(list)) '(1))
+(test `(1 ,@()) '(1))
+(test `(1 ,@'()) '(1))
+(test `(1 . ,()) '(1))
+(test `(1 , #|a comment|# 2) '(1 2))
+(test `(1 ,@ #|a comment|# (list 2 3)) '(1 2 3))
+(test `(1 , ;a comment
+                       2) '(1 2))
+(test `(1 #||#,2) '(1 2))
+(test `(1 #||#,@(list #||# 2 3 #||#)) '(1 2 3))
+(test (eval ``(+ 1 ,@,@'('(2 3)))) '(+ 1 2 3))
+(test (eval ``(+ 1   ,@ #||#  ,@   '('(2 3)))) '(+ 1 2 3))
+(test `(,1 ,1) '(1 1))
+(test `(,1 ,`,1) '(1 1))
+(test `(,1 ,`,@(list 1)) '(1 1))
+(test `(,1 ,`,`,1) '(1 1))
+(test `(,1 ,`,@'(1)) '(1 1))
+(test `(,1 ,`,@`(1)) '(1 1))
+(test `(,1 ,`,@`(,1)) '(1 1))
+(test `(,1 ,@`,@(list (list 1))) '(1 1))
+(test (eval ``(,,1 ,@,@(list (quote (list 1))))) '(1 1))
+(test (eval ``(,,1 ,@,@(list `(list 1)))) '(1 1))
+(test (eval (eval ```(,,,1 ,@,@,@(list '(list '(list 1)))))) '(1 1))
+(test (+ 1 (eval (eval ```,@,,@(list ''(list 2 3))))) 6)
+(test (+ 1 (eval (eval (eval ````,@,,,@(list '''(list 2 3)))))) 6)
+(test (apply + `(1 ,@`(2 ,@(list 3)))) 6)
+(test (eval `(- ,@()',1)) -1)
+(test (eval `(,- ,@()'1)) -1)
+;(test (eval (eval ``(- ,@,@'(,1())))) -1)
+;(test (eval (eval ``(,@,@'(- ,1())))) -1)
+;(test (eval (eval ``(,- ,@,@'(1())))) -1)
+(test (eval (eval ``(,- ,@'(,@()1)))) -1)
+(test (eval (eval ``(- ,@,@',().(1)))) -1)
+(test (quasiquote quote) 'quote)
+(test (eval (list quasiquote (list values #t))) (list values #t))
+(test (eval (let ((a 'outer)) `(let ((a 'inner)) `(list ,',a ,,'a)))) '(list outer inner)) ; from Gauche devlog
+(test (quasiquote (unquote (quote (1 2))))
+      (if immutable-unquote '(unquote (quote (1 2))) '(1 2)))
+(test (eq? (cadr `(a, b, c,)) 'b,) #t)
+(test (eq? (cadr '(a, b, c,)) 'b,) #t)
+(test (let ((b, 32)) `(a , b, c,)) '(a 32 c,))
+(test (let ((b, 32)) `(a, , b, c,)) '(a, 32 c,))
+(unless immutable-unquote
+  (test (equal? (let ((b, 32)) '(a, , b, c,)) '(a, (unquote b,) c,)) #t) ; comma by itself (no symbol) is an error
+  (test (equal? (let ((b, 32)) '(a, ,  , b, c,)) '(a, (unquote (unquote b,)) c,)) #t))
+(test (equal? (let ((b 32)) (let ((b, b)) ``(a, ,  , b, c,))) '(#_list-values 'a, 32 'c,)) #t)
+(unless (or pure-s7 immutable-unquote)
+  (test (let ((func abs)) (quasiquote (sym . (unquote func)))) (cons 'sym abs)) ; guile mailing list
+  (test (eval-string "`(+ (unquote 2 3))") 'error))
+(test (eval ``(,@,@())) ())
+(test (list (let ((x '(1 2))) `,@x)) '(1 2))
+(test (let ((x '(1))) `,@x) 1)
+(test (let ((x '(1 2))) (list `,@x)) '(1 2))
+(test `(1 . "hi") '(1 . "hi"))
+(test `(f . ,(string-append "h" "i")) '(f . "hi"))
+
+(if immutable-unquote
+    (begin
+      (test (let () (define* ,() (abs ))) 'error)
+      (test (let (,'a) unquote) 'error)
+      (test (let (, '1) unquote) 'error)
+      (test (let (, (lambda (x) (+ x 1))) ,,,,'3) 'error)
+      (test (let (,@ '(1)) unquote) 'error)
+      (test (let (,@ ()) ,2) 'error))
+    (begin
+      (test (let () (define* ,() (abs ))) 'error)
+      (test (let (,'a) unquote) 'a)
+      (test (let (, '1) unquote) 1)
+      (test (let (, (lambda (x) (+ x 1))) ,,,,'3) 7)
+      (test (let (,@ '(1)) unquote) 1)
+      (test (let (,@ ()) ,2) 2)))
+
+;; mostly from gauche
+(let ((quasi0 99)
+      (quasi1 101)
+      (quasi2 '(a b))
+      (quasi3 '(c d)))
+  (test `,quasi0 99)
+  (test `,quasi1 101)
+  (test `(,(cons 1 2)) '((1 . 2)))
+  (test `(,(cons 1 2) 3) '((1 . 2) 3))
+  (test `(,quasi0 3) '(99 3))
+  (test `(3 ,quasi0) '(3 99))
+  (test `(,(+ quasi0 1) 3) '(100 3))
+  (test `(3 ,(+ quasi0 1)) '(3 100))
+  (test `(,quasi1 3) '(101 3))
+  (test `(3 ,quasi1) '(3 101))
+  (test `(,(+ quasi1 1) 3) '(102 3))
+  (test `(3 ,(+ quasi1 1)) '(3 102))
+  (test `(1 ,@(list 2 3) 4) '(1 2 3 4))
+  (test `(1 2 ,@(list 3 4)) '(1 2 3 4))
+  (test `(,@quasi2 ,@quasi3) '(a b c d))
+  (test `(1 2 . ,(list 3 4)) '(1 2 3 4))
+  (test `(,@quasi2 . ,quasi3) '(a b c d))
+
+  (test `#() #())
+  (test `(,@(list 1 2) ,@(list 1 2)) '(1 2 1 2))
+  (test `(,@(list 1 2) a ,@(list 1 2)) '(1 2 a 1 2))
+  (test `(a ,@(list 1 2) ,@(list 1 2)) '(a 1 2 1 2))
+  (test `(,@(list 1 2) ,@(list 1 2) a) '(1 2 1 2 a))
+  (test `(,@(list 1 2) ,@(list 1 2) a b) '(1 2 1 2 a b))
+  (test `(,@(list 1 2) ,@(list 1 2) . a) '(1 2 1 2 . a))
+  (test `(,@(list 1 2) ,@(list 1 2) . ,(cons 1 2)) '(1 2 1 2 1 . 2))
+  (test `(,@(list 1 2) ,@(list 1 2) . ,quasi2) '(1 2 1 2 a b))
+  (test `(,@(list 1 2) ,@(list 1 2) a . ,(cons 1 2)) '(1 2 1 2 a 1 . 2))
+  (test `(,@(list 1 2) ,@(list 1 2) a . ,quasi3) '(1 2 1 2 a c d))
+;  (test `(1 `(1 ,2 ,,(+ 1 2)) 1) '(1 `(1 ,2 ,3) 1))
+;  (test `(1 `(1 ,,quasi0 ,,quasi1) 1) '(1 `(1 ,99 ,101) 1))
+  (test `(1 `(1 ,@2 ,@,(list 1 2))) '(1 `(1 ,@2 ,@(1 2))))
+  (test `(1 `(1 ,@,quasi2 ,@,quasi3)) '(1 `(1 ,@(a b) ,@(c d))))
+  (test `(1 `(1 ,(,@quasi2 x) ,(y ,@quasi3))) '(1 `(1 ,(a b x) ,(y c d))))
+  )
+
+(let ((x 3)
+      (y '(a b c)))
+  (test `(1 . ,2) '(1 . 2))
+  (test `(1 2 . ,3) '(1 2 . 3))
+  (test `(1 x . ,3) '(1 x . 3))
+  (test `(1 x . ,x) '(1 x . 3))
+  (test `(1 . ,(list 2 3)) '(1 2 3))
+  (test `(1 ,@(list 2 3)) '(1 2 3))
+;;;  (test `(1 . ,@('(2 3))) '(1 2 3))
+  (test `(1 ,(list 2 3)) '(1 (2 3)))
+  (test `(1 . (list 2 3)) '(1 list 2 3))
+  (test `(x . ,x) '(x . 3))
+  (test `(y . ,y) '(y a b c))
+  (test `(,x ,@y ,x) '(3 a b c 3))
+  (test `(,x ,@y . ,x) '(3 a b c . 3))
+  (test `(,y ,@y) '((a b c) a b c))
+  (test `(,@y . ,y) '(a b c a b c))
+
+  (test (object->string `(,y . ,y)) "((a b c) a b c)") ; was "(#1=(a b c) . #1#)"
+  (test (object->string `(y ,y ,@y ,y . y)) "(y (a b c) a b c (a b c) . y)") ; was "(y #1=(a b c) a b c #1# . y)"
+
+  (test (eval ``(1 . ,,2)) '(1 . 2))
+  (test (eval ``(y . ,,x)) '(y . 3))
+  (test (eval ``(,y . ,x)) '((a b c) . 3))
+  (test (eval ``(,@y . x)) '(a b c . x))
+  (test (eval ``(,x . ,y)) '(3 a b c))
+  (test (eval ``(,,x . y)) '(3 . y))
+  (test (eval ``(,,x ,@y)) '(3 a b c))  ;; in clisp `(,y . ,@(y)) -> *** - READ: the syntax `( ... . ,@form) is invalid
+  )
+
+(test (let ((.' '(1 2))) `(,@.')) '(1 2))
+
+(test (let ((hi (lambda (a) `(+ 1 ,a))))
+	(hi 2))
+      '(+ 1 2))
+
+(test (let ((hi (lambda (a) `(+ 1 ,@a))))
+	(hi (list 2 3)))
+      '(+ 1 2 3))
+
+(test (let ((hi (lambda (a) `(let ((b ,a)) ,(+ 1 a)))))
+	(hi 3))
+      '(let ((b 3)) 4))
+
+(test (let ((x '(a b c)))
+	`(x ,x ,@x foo ,(cadr x) bar ,(cdr x) baz ,@(cdr x)))
+      '(x (a b c) a b c foo b bar (b c) baz b c))
+
+(test (let ((x '(a b c)))
+	`(,(car `(,x))))
+      '((a b c)))
+
+(test (let ((x '(a b c)))
+	`(,@(car `(,x))))
+      '(a b c))
+
+(test (let ((x '(a b c)))
+	`(,(car `(,@x))))
+      '(a))
+
+(test (let ((x '(a b c)))
+	``,,x)
+      '(a b c))
+
+(test (let ((x '(a b c)))
+	`,(car `,x))
+      'a)
+
+(test (let ((x '(2 3)))
+	`(1 ,@x 4))
+      '(1 2 3 4))
+
+(test (let ((x '(2 3)))
+	`(1 ,@(map (lambda (a) (+ a 1)) x)))
+      '(1 3 4))
+
+;;; these are from the scheme bboard
+(test (let ((x '(1 2 3))) `(0 . ,x)) '(0 1 2 3))
+(test (let ((x '(1 2 3))) `(0 ,x)) '(0 (1 2 3)))
+
+;; unbound variable x, but (let ((x '(1 2 3))) (quasiquote #(0 . ,x))) -> #(0 unquote x)
+;; so ` and (quasiquote...) are not the same in the vector case
+
+(test (let () (define-macro (tryqv . lst) `(map abs ',lst)) (tryqv 1 2 3 -4 5)) '(1 2 3 4 5))
+(test (let () (define-macro (tryqv . lst) `(map abs '(,@lst))) (tryqv 1 2 3 -4 5)) '(1 2 3 4 5))
+(test (let () (define-macro (tryqv . lst) `(map abs (vector ,@lst))) (tryqv 1 2 3 -4 5)) '(1 2 3 4 5))
+
+(for-each
+ (lambda (str)
+   (let ((val (catch #t
+		     (lambda () (eval-string str))
+		     (lambda args 'error))))
+     (if (not (eqv? val -1))
+	 (format #t "~S = ~S?~%" str val))))
+ (list "( '(.1 -1)1)" "( - '`-00 1)" "( - .(,`1/1))" "( - .(`1) )" "( -(/ .(1)))" "( / 01 -1 )" "(' '` -1(/ ' 1))" "(' (-01 )0)"
+       "(' `'`` -1 1 01)" "(''-1 .(1))" "('(, -1 )0)" "('(,-1)'000)" "('(,-1)00)" "('(-1  -.0)0)" "('(-1 '1`)0)" "('(-1 .-/-)0)" "('(-1()),0)"
+       "('(-1) 0)" "('(10. -1 )1)" "(-  '`1)" "(-  `1 1 1)" "(- '  1)" "(- ' 1)" "(- '1 .())" "(- '` ,``1)" "(- '` 1)" "(- '`, `1)" "(- '`,`1)"
+       "(- '``1)" "(- (''1 1))" "(- (- ' 1 0))" "(- (-(- `1)))" "(- (`  (1)0))" "(- ,`, `1)" "(- ,`1 . ,())" "(- . ( 0 1))" "(- . ( `001))"
+       "(- .(', 01))" "(- .('`,1))" "(- .('``1))" "(- .(,,1))" "(- .(01))" "(- .(1))" "(- .(`,1))" "(- .(`,`1))" "(- .(`1))" "(- ` ,'1)"
+       "(- ` -0 '1)" "(- ` 1 )" "(- ` `1)" "(- `, 1)" "(- `,1)" "(- `,`,1)" "(- `,`1)" "(- ``,,1)" "(- ``,1)" "(- ``1 )" "(- ```,1)"
+       "(- ```1)" "(-(  / 1))" "(-( -  -1 ))" "(-( `,- 1 0))" "(-(' (1)0))" "(-('(,1)00))" "(-(- '`1) 0)" "(-(- -1))" "(-(/(/(/ 1))))"
+       "(-(`'1 '1))" "(-(`(,1 )'0))" "(-(`,/ ,1))" "(/ '-1 '1 )" "(/ ,, `,-1)" "(/ ,11 -11)" "(/ 01 (- '1))" "(/ `1 '`-1)"
+       "(/(- '1)  )" "(/(- '1)1)" "(/(- 001)1)" "(/(- 1),,1)" "(/(/ -1))" "(` ,- 1)" "(` `,(-1)0)" "(`' , -1 1)" "(/(- -001(+)))"
+       "(`' -1 '1/1)" "(`','-1 ,1)" "(`(,-1)-00)" "(`(-0 -1)1)" "(`(-1 -.')0)" "(`(-1 1')0)" "(`(` -1)'`0)" "(`, - 1)" "(`,- '1)" "(`,- .(1))"
+       "(`,- 1 )" "(`,- `,1)" "(`,- `1)" "(`,/ . (-1))" "(``,,- `01)" "('''-1 '1 '1)" "(/ `-1 1)" "(/ .( -1))" "(-(+(+)0)1)" "(/ ,`,`-1/1)"
+       "(-(*).())" "(*(- +1))" "(-(`,*))" "(-(+)'1)" "(+(-(*)))" "(-(+(*)))" "(-(+)(*))" "(-(/(*)))" "(*(-(*)))" "(-(*(*)))" "(/(-(*)))" "(-(+(*)))"
+       "(/ .(-1))" "(-(*))" "(- 000(*))" "(-(*(+ 1)))" "(- .((*)))" "(- +0/10(*))" "(-(`,/ .(1)))" "(+ .(' -01))" "(-(''1 01))" "(- -1/1 +0)"
+       "(- `,'0 `01)" "( - `,(+)'1)" "(+(- . (`1)))" "(* '`,``-1)" "(-(+ -0)1)" "(+ +0(-(*)))" "(+(- '+1 ))" "(+ '-01(+))" "(`, -(+)1)"
+       "(`,+ 0 -1)" "(-(/(/(*))))" "(`,* .( -1))" "(-(*(*(*))))" "(`,@(list +)-1)" "(* (- 1) )" "(`, - (* ))" "(/(- (* 1)))"
+       "(- -0/1(*))" "(`(,-1)0)" "(/(-(*).()))" "(* ````-1)" "(-(+(*)0))" "(-(* `,(*)))" "(- +1(*)1)" "(- (` ,* ))" "(/(-(+ )1))" "(`,* -1(*))"
+       "(` ,- .(1))" "(+(`,-( *)))" "( /(`,- 1))" "(`(1 -1)1)" "(*( -(/(*))))" "(- -1(-(+)))" "(* ``,,-1)" "(-(+(+))1)" "( +(*(-(*))))"
+       "(-(+)`0(*))" "(-(+(+(*))))" "(-(+ .(01)))" "(/(*(-(* ))))" "(/ (-(* 1)))" "( /(-(/(*))))" "(+ -1 0/1)" "(/(-( +(*))))" "(*( -(`,*)))"
+       "(* 1(/ 1)-1)" "(+ 0(- ',01))" "(+(-(-(+ -1))))" "(- 0(/(+(* ))))" "(-(+)( *)0)"
+       "(`,- '01/1)" "(`, - ',,1)"  "(/ .(`-1 1))"  "(- ``,,'`1)" "(- 10 0011)" "(-(- ``1 0))" "( -(/ 01/1))" "(-(- 1)`,0)" "(/(/ -1 .()))"
+       "(/ ,,``-1)" "( `,`, - 1)" "(- .(`1/01  ))" "('(-1) ',``0)" "('( ,/ -1 )1)" "(- ,,`,`0 +1)" "(`(-1) `,0)" "(+(* (-(*))))"
+       "(-(`,* ,,1))" "(+(+ 0)-1)" "(+(-(+ ,1)))" "(* ,`-01/1)" "(*(- '` `1))" "(-(*(* 1 1)))" "(-(*(/ .(1))))" "(-(- 1(*)-1))"
+       "(- -00 (* 1))" "(- (*(+ ,01)))" "(-(*), +1(* ))" "(- `,@'(1))" "`,@`(-1)" "(`'`-1 1)" "`,@(list `,@`(-1))"
+       ))
+
+#|
+(let ((chars (vector #\/ #\. #\0 #\1 #\- #\, #\( #\) #\' #\@ #\` #\space))
+      (size 14))
+  (let ((str (make-string size))
+	(clen (length chars)))
+    (do ((i 0 (+ i 1)))
+	((= i 10000000))
+      (let ((parens 0))
+	(do ((k 0 (+ k 1)))
+	    ((= k size))
+	  (set! (str k) (chars (random clen)))
+	  (if (char=? (str k) #\()
+	      (set! parens (+ parens 1))
+	      (if (char=? (str k) #\))
+		  (begin
+		    (set! parens (- parens 1))
+		    (if (negative? parens)
+			(begin
+			  (set! (str k) #\space)
+			  (set! parens 0)))))))
+	(let ((str1 str)
+	      (happy (char=? (str (- size 1)) #\))))
+	  (if (> parens 0)
+	      (begin
+		(set! str1 (make-string (+ size parens) #\)))
+		(set! happy #t)
+		(do ((k 0 (+ k 1)))
+		    ((= k size))
+		  (set! (str1 k) (str k)))))
+	  (if (and happy
+		   (not (char=? (str1 1) #\))))
+	      (catch #t
+		     (lambda ()
+		       (let ((num (eval-string str1)))
+			 (if (and (number? num)
+				  (eqv? num -1))
+			     (format *stderr* "~S ~%" str1))))
+		     (lambda args
+		       'error))))))))
+|#
+
+(test (= 1 '+1 `+1 '`1 `01 ``1) #t)
+(test (''- 1) '-)
+(test (`'- 1) '-)
+(test (``- 1) '-)
+(test ('`- 1) '-)
+(test (''1 '1) 1)
+(test ((quote (quote 1)) 1) 1) ; (quote (quote 1)) -> ''1 = (list 'quote 1), so ((list 'quote 1) 1) is 1!
+(test (list quote 1) ''1) ; guile says #t
+(test (list-ref ''1 1) 1)  ; same
+(test (''1 ```1) 1)
+(test (cond `'1) 1)
+(test ```1 1)
+(test ('''1 1 1) 1)
+(test (`',1 1) 1)
+(test (- `,-1) 1)
+;;; some weirder cases...
+(test (begin . `''1) ''1)
+					;(test (`,@''1) 1)
+					;  (syntax-error ("attempt to apply the ~A ~S to ~S?" "symbol" quote (1))) ??
+					;  ((apply-values ''values 1)) got error but expected 1
+					;(test (`,@ `'1) 1)
+					;  ((apply-values ''values 1)) got error but expected 1
+					;(test (`,@''.'.) '.'.)
+					;  ((apply-values ''values .'.)) got error but expected .'.
+(test (apply . `''1) 'error) ; '(quote quote 1)) ; (apply list-values 'quote (list-values 'quote 1)) -> ;quote: too many arguments '1
+(test (apply - 1( )) -1)               ; (apply - 1 ())
+(num-test (apply - 1.()) -1.0)
+(num-test (apply - .1()) -0.1)
+(num-test (apply - .1 .(())) -0.1)
+(num-test (apply - .1 .('(1))) -0.9)
+(test (apply - -1()) 1)                ; (apply - -1 ())
+(test (apply . `(())) 'error)             ; (apply list-values ())
+(test (apply . ''(1)) 1)               ; (apply quote '(1))
+(test (apply . '`(1)) 1)               ; (apply quote (list-values 1))
+(test (apply . `(,())) 'error)            ; (apply list-values ())
+(test (apply . `('())) 'error)           ; (apply list-values (list-values 'quote ()))
+(test (apply . `(`())) 'error)            ; (apply list-values ())
+(test (apply - `,1()) -1)              ; (apply - 1 ())
+(test (apply - ``1()) -1)              ; (apply - 1 ())
+(test (apply ''1 1()) 1)               ; (apply ''1 1 ())
+(test (apply .(- 1())) -1)             ; (apply - 1 ())
+(test (apply - .(1())) -1)             ; (apply - 1 ())
+(test (apply . `(1())) 'error)           ; (apply list-values 1 ())
+(test (apply . ''(())) ())
+(test (apply . `((()))) 'error)
+
+(test (catch #t  ; is_simple_code troubles (it's still slow)
+        (lambda ()
+	  (+((+(0((((((*(((((((*(`((``(`((`((`(`((`((``(`((`(( (((( ((`((`((`(((`((`((``(`(`((`((`(((`((`(`
+           ((`((``((`(`((`((``(`((`(( (((( ((`((`((`(((`((`((``(`(`((`((`((((*(`((`(( (((( ((`((`((`(((`((`(
+            (``(`(`((`(((((*(((``(`((``(`(((`((`((((*(`((`(`((((*(((``(`((``(`(((`((`(((*(((``(`((``(`(((`((`
+            ((((*(`((`((``(`((`(`(( (/(((*`(((`((`(((`((`((``()(
+		))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
+                ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
+        (lambda arg #f))
+      #f)
+
+;;; comp.lang.lisp (test (with-input-from-string "(a `(aaa ,(/ 0.9)))" read) '(a (list-values 'aaa (/ 0.9))))
+
+(test (defined? 'list-values) #t)
+(let ((old-list-values list-values))
+  (test (let () (set! list-values 2)) 2)
+  (test (let ((list-values 2)) list-values) 2)
+  (set! list-values old-list-values))
+
+(test (defined? 'apply-values) #t)
+(let ((old-apply-values apply-values))
+  (test (let () (set! apply-values 2)) 2) ; was 'error 9-Nov-23
+  (test (let ((apply-values 2)) apply-values) 2) ; 'error
+  (set! apply-values old-apply-values))
+
+;(test (defined? 'append) #t)
+;(test (let () (set! append 2)) 'error)
+;(test (let ((append 2)) append) 'error)
+(test (list-values 1 2 (apply-values) 3) '(1 2 3))
+(let ()
+  (define (consume f . args) (apply f (apply list-values args)))
+  (define (supply . args) (apply-values args))
+  (test (consume + (supply)) 0)
+  (test (consume + (supply 1 2) (supply 3 4 5) (supply)) 15)
+  (test (consume + (supply 1 2) (supply) (supply 3 4 5)) 15))
+
+(test (object->string (list 'quote 1 2)) "(quote 1 2)")
+(test (object->string (list 'quote 'quote 1)) "(quote quote 1)")
+(test (object->string (list 'quote 1 2 3)) "(quote 1 2 3)")
+(test (object->string (list 'quote 1)) "(quote 1)")
+(test (equal? (quote 1) '1) #t)
+(test (equal? (list 'quote 1) ''1) #f)
+(test (equal? (list 'quote 1) '''1) #f)
+;;; see comment s7.c in list_to_c_string -- we're following Clisp here
+(test (object->string (cons 'quote 1)) "(quote . 1)")
+(test (object->string (list 'quote)) "(quote)")
+(let ((lst (list 'quote 1)))
+  (set! (cdr (cdr lst)) lst)
+  (test (object->string lst) "#1=(quote 1 . #1#)"))
+(let ((lst (list 'quote)))
+  (set! (cdr lst) lst)
+  (test (object->string lst) "#1=(quote . #1#)"))
+
+;; from Guile mailing list -- just a bit strange, even confuses emacs!
+(if (not with-windows)
+    (test (let ((v '(\()))) ; i.e. '( (symbol "\\") ())
+	    (and (pair? v)
+		 (symbol? (car v)) ; \ -> (symbol "\\")
+		 (null? (cadr v)))) #t))
+
+(test #(,1) #(1))
+(test #(,,,1) #(1))
+(test #(`'`1) #((#_quote '1)))
+(test (',- 1) '-) ; this is implicit indexing
+
+#|
+(',,= 1) -> (unquote =)
+(test (equal? (car (',,= 1)) 'unquote) #t) ; but that's kinda horrible
+
+(',@1 1) -> (apply-values 1)
+#(,@1) -> #((unquote (apply-values 1)))
+(quasiquote #(,@(list 1 2 3))) -> #((unquote (apply-values (list 1 2 3))))
+
+(quote ,@(for-each)) -> (unquote (apply-values (for-each)))
+;;; when is (quote ...) not '...?
+|#
+
+(test (quasiquote) 'error)
+(test (quasiquote 1 2 3) 'error)
+(let ((d 1)) (test (quasiquote (a b c ,d)) '(a b c 1)))
+(test (let ((a 2)) (quasiquote (a ,a))) (let ((a 2)) `(a ,a)))
+(test (quasiquote 4) 4)
+(unless immutable-unquote (test (quasiquote (list (unquote (+ 1 2)) 4)) '(list 3 4)))
+(test (quasiquote (1 2 3)) '(1 2 3))
+(test (quasiquote ()) ())
+(test (quasiquote (list ,(+ 1 2) 4))  '(list 3 4))
+(test (quasiquote (1 ,@(list 1 2) 4)) '(1 1 2 4))
+(test (quasiquote (a ,(+ 1 2) ,@(map abs '(4 -5 6)) b)) '(a 3 4 5 6 b))
+(test (quasiquote (1 2 ,(* 9 9) 3 4)) '(1 2 81 3 4))
+(test (quasiquote (1 ,(+ 1 1) 3)) '(1 2 3))
+(test (quasiquote (,(+ 1 2))) '(3))
+(test (quasiquote (,@'() . foo)) 'foo)
+(test (quasiquote (1 , 2)) '(1 2))
+(test (quasiquote (,1 ,1)) '(1 1))
+(test (quasiquote (,1 ,(quasiquote ,1))) '(1 1))
+(test (quasiquote (,1 ,(quasiquote ,@(list 1)))) '(1 1))
+(test (quasiquote (,1 ,(quasiquote ,(quasiquote ,1)))) '(1 1))
+(test (quasiquote (,1 ,(quasiquote ,@'(1)))) '(1 1))
+(test (quasiquote (,1 ,(quasiquote ,@(quasiquote (1))))) '(1 1))
+(test (quasiquote (,1 ,(quasiquote ,@(quasiquote (,1))))) '(1 1))
+(test (quasiquote (,1 ,@(quasiquote ,@(list (list 1))))) '(1 1))
+(test `(+ ,(apply values '(1 2))) '(+ 1 2))
+(unless immutable-unquote (test `(apply + (unquote '(1 2))) '(apply + (1 2))))
+(test (eval (list (list quasiquote +) -1)) -1)
+
+(test (apply quasiquote '((1 2 3))) '(1 2 3))
+(test (quasiquote (',,= 1)) 'error)
+(test (quasiquote (',,@(1 2) 1)) 'error)
+(test (quasiquote 1.1 . -0) 'error)
+
+(test `(1 ,@2) 'error)
+(test `(1 ,@(2 . 3)) 'error)
+(test `(1 ,@(2 3)) 'error)
+(test `(1 , @ (list 2 3)) 'error) ; unbound @ ! (guile also)
+
+(test (call-with-exit quasiquote) 'error)
+(test (call-with-output-string quasiquote) "")
+(test (map quasiquote '(1 2 3)) '(1 2 3)) ; changed 12-May-14
+(test (for-each quasiquote '(1 2 3)) #<unspecified>)
+(test (sort! '(1 2 3) quasiquote) 'error)
+(test (quasiquote . 1) 'error)
+(test (let ((x 3)) (quasiquote . x)) 'error)
+(num-test `,,,-1 -1)
+(num-test `,``,1 1)
+(test (equal? ` 1 ' 1) #t)
+(test (+ ` 1 `  2) `   3)
+(test ` ( + ,(- 3 2) 2) '(+ 1 2))
+(test (quasiquote #(1)) `#(1))
+
+(test `(+ ,@(map sqrt '(1 4 9)) 2) '(+ 1 2 3 2))
+(test `(+ ,(sqrt 9) 4) '(+ 3 4))
+(test `(+ ,(apply values (map sqrt '(1 4 9))) 2) '(+ 1 2 3 2))
+
+;; here is the difference between ,@ and apply values:
+(test (let ((x ())) `(+ ,@x)) '(+))
+(test (let ((x ())) (+ (apply values x))) 'error) ; ;+ argument, #<unspecified>, is untyped
+(test (let ((x ())) (list + (apply values x))) (list + (values)))
+
+;; (apply + (list-values (apply-values ()))) -> 0 -- this is a special quasiquote list handling of ,@ that
+;;   is not the same as (apply + (list-values (apply values ()))) -> error. quasiquote turns list into list-values
+;;   and list-values treats (apply values...) specially.
+;;
+;;   (let ((x ())) `(+ ,@x)) -> (+)
+;;        via (+ (unquote (apply-values x))) -> (list-values '+ (apply-values x))
+;;
+;;   (let ((x ())) (list + (apply values x))) -> (+ #<unspecified>)
+;;        via (+ (apply values (unquote x))) -> (list-values '+ (list-values 'apply 'values x))
+;; because (values) -> #<unspecified> but everywhere else ,@x is the same as (apply values x)
+
+(test (make-hook (macroexpand (quasiquote (logeqv (blocks3 (imh)))))) 'error) ; qq #_quote used to avoid is_global check
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; keywords
+;;; --------------------------------------------------------------------------------
+
+;;; keyword?
+;;; string->keyword
+;;; keyword->symbol
+;;; symbol->keyword
+
+(for-each
+ (lambda (arg)
+   (test (keyword? arg) #f))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2)))
+
+(test (cond ((cond (())) ':)) ':)
+(test (keyword? :#t) #t)
+(test (eq? #t :#t) #f)
+;(test (keyword? '#:t) #f)  ; these 2 are fooled by the Guile-related #: business (which is still supported)
+;(test (keyword? '#:#t) #f)
+;#:1.0e8 is also a keyword(!)
+;#:# is also, so #:#() is interpreted as #:# ()
+
+(test (keyword? :-1) #t)
+(test (keyword? :0/0) #t)
+(test (keyword? :1+i) #t)
+(test (keyword? :1) #t)
+(test (keyword? 0/0:) #t)
+(test (keyword? 1+i:) #t)
+(test (keyword? 1:) #t)
+;;; bizarre...
+
+(test (keyword? (symbol ":#(1 #\\a (3))")) #t)
+(test (keyword? (string->keyword (object->string #(1 #\a (3)) #f))) #t)
+(test (keyword? begin) #f)
+(test (keyword? if) #f)
+
+(let ((kw (string->keyword "hiho")))
+  (test (keyword? kw) #t)
+  (test (keyword->symbol kw) 'hiho)
+  (test (symbol->keyword 'hiho) kw)
+  (test (keyword->symbol (symbol->keyword 'key)) 'key)
+  (test (symbol->keyword (keyword->symbol (string->keyword "hi"))) :hi)
+  (test (keyword? :a-key) #t)
+  (test (keyword? ':a-key) #t)
+  (test (keyword? ':a-key:) #t)
+  (test (keyword? 'a-key:) #t)
+  (test (symbol? (keyword->symbol :hi)) #t)
+  (test (keyword? (keyword->symbol :hi)) #f)
+  (test (symbol? (symbol->keyword 'hi)) #t)
+  (test (equal? kw :hiho) #t)
+  (test ((lambda (arg) (keyword? arg)) :hiho) #t)
+  (test ((lambda (arg) (keyword? arg)) 'hiho) #f)
+  (test ((lambda (arg) (keyword? arg)) kw) #t)
+  (test ((lambda (arg) (keyword? arg)) (symbol->keyword 'hiho)) #t)
+  (test (string->keyword "3") :3)
+  (test (keyword? :3) #t)
+  (test (keyword? ':3) #t)
+  (test (eq? (keyword->symbol :hi) (keyword->symbol hi:)) #t)
+  (test (equal? :3 3) #f)
+  (test (equal? (keyword->symbol :3) 3) #f)
+  (test (equal? (symbol->value (keyword->symbol :3)) 3) #f) ; 3 as a symbol has value #<undefined>
+
+  (test (keyword? (keyword->symbol :n:)) #t)
+  (test (keyword? (keyword->symbol (keyword->symbol :n:))) #f)
+  (test (symbol->keyword n:) :n:)
+  (test (keyword? (keyword->symbol ::a)) #t)
+  (test (keyword? (keyword->symbol a::)) #t)
+  (test (symbol->keyword a:) :a:)
+  (test (symbol->keyword :a) ::a)
+
+#|
+  (let ()
+    (apply define (symbol "3") '(32))
+    (test (symbol->value (symbol "3")) 32) ; hmmm
+    (apply define (list (symbol "3") (lambda () 32)))
+    (test (symbol->value (symbol "3")) 32)
+    (apply define (symbol ".") '(123))
+    (test (+ (symbol->value (symbol ".")) 321) 444))
+|#
+
+  (test (keyword? '3) #f)
+  (test (keyword? ':) #f)
+  (test (keyword? '::) #t)
+  (test (keyword? ::a) #t)
+  (test (eq? ::a ::a) #t)
+  (test (eq? (keyword->symbol ::a) :a) #t)
+  (test (eq? (symbol->keyword :a) ::a) #t) ; ?? -- :a is already a keyword
+  (test (symbol->string :asdf) ":asdf") ; keyword->string
+  (test (symbol->string ::a) "::a")
+  (test ((lambda* (:a 32) ::a) 0) 'error) ; :a is a constant
+  (test (eq? :::a::: :::a:::) #t)
+  (test (keyword? a::) #t)
+  (test (keyword->symbol '::) ':)
+  (test (symbol->string (keyword->symbol hi:)) "hi")
+  (test (symbol->string (keyword->symbol :hi)) "hi")
+  (test (keyword? (string->keyword (string #\x (integer->char 128) #\x))) #t)
+  (test (keyword? (string->keyword (string #\x (integer->char 200) #\x))) #t)
+  (test (keyword? (string->keyword (string #\x (integer->char 255) #\x))) #t)
+  (test (string->keyword ":") '::)
+  (test (string->keyword (string #\")) (symbol ":\""))
+  (test (keyword? (string->keyword (string #\"))) #t)
+  (test (keyword->symbol (string->keyword (string #\"))) (symbol "\""))
+  )
+
+(test (symbol->keyword (symbol "a b c")) (symbol ":a b c"))
+(test (keyword? (symbol->keyword (symbol "a b c"))) #t)
+(test (keyword? (symbol ":a b c")) #t)
+(test (string->keyword "a b") (symbol ":a b"))
+(test (keyword? : asdf) 'error)
+(test (keyword? asdf :) 'error)
+(test (string->keyword "") 'error)
+(test (keyword? (symbol ":a b")) #t)
+(test (symbol->keyword 'begin) :begin)
+(test (symbol->keyword 'quote) :quote)
+(test (symbol->keyword if) 'error)
+(test (symbol->keyword quote) 'error)
+(test (symbol->keyword :a) ::a)
+(test (keyword->symbol ::a) :a)
+(test (symbol->keyword (symbol "(a)")) (symbol ":(a)"))
+(test (keyword->symbol :0) (symbol "0"))
+(test (symbol->keyword (symbol "-1")) :-1)
+(test (keyword->symbol :+nan.0) (symbol "+nan.0"))
+(test (symbol->keyword (symbol "1.5+i")) :1.5+i)
+(test (keyword? (symbol ":(a)")) #t)
+(test (keyword? :|) #t)
+(test (keyword? :,) #t)
+(when full-s7test
+  (do ((i 1 (+ i 1)))  ; not #\null -- : by itself is not a keyword in s7
+      ((= i 128))
+    (if (not (keyword? (string->keyword (string (integer->char i)))))
+	(format *stderr* "not key: :~A~%" (integer->char i)))
+    (if (not (keyword? (symbol (string #\: (integer->char i)))))
+	(format *stderr* "not key: (symbol \":~A\")~%" (integer->char i)))
+    (if (not (keyword? (symbol (string (integer->char i) #\:))))
+	(format *stderr* "not key: (symbol \"~A:\")~%" (integer->char i)))))
+
+(test (let ((:hi 3)) :hi) 'error)
+(test (set! :hi 2) 'error)
+(test (define :hi 3) 'error)
+
+(let ((strlen 8))
+  (let ((str (make-string strlen)))
+    (do ((i 0 (+ i 1)))
+	((= i 10))
+      (do ((k 0 (+ k 1)))
+	  ((= k strlen))
+	(set! (str k) (integer->char (+ 1 (random 255)))))
+      (let ((key (string->keyword str)))
+	(let ((newstr (symbol->string (keyword->symbol key))))
+	  (if (not (string=? newstr str))
+	      (format #t ";string->keyword -> string: ~S -> ~A -> ~S~%" str key newstr)))))))
+
+(let ()
+  (define* (hi a b) (+ a b))
+  (test (hi 1 2) 3)
+  (test (hi :b 3 :a 1) 4)
+  (test (hi b: 3 a: 1) 4))
+
+(for-each
+ (lambda (arg)
+   (test (string->keyword arg) 'error))
+ (list -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2)))
+
+(for-each
+ (lambda (arg)
+   (test (keyword->symbol arg) 'error))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2)))
+
+(for-each
+ (lambda (arg)
+   (test (symbol->keyword arg) 'error))
+ (list "hi" -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2)))
+
+(test (keyword?) 'error)
+(test (keyword? 1 2) 'error)
+(test (string->keyword) 'error)
+(test (string->keyword 'hi 'ho) 'error)
+(test (keyword->symbol) 'error)
+(test (keyword->symbol :hi :ho) 'error)
+(test (symbol->keyword) 'error)
+(test (symbol->keyword 'hi 'ho) 'error)
+
+;;; troubles (: :: etc -- these need to be cleaned up somehow)
+(test (keyword->symbol :asd:) 'asd:)
+(test (keyword->symbol (keyword->symbol :asd:)) 'asd)
+(test (procedure? (let ((+signature+ '(:all 3 #<eof>))) (lambda (a) a))) #t) ; ?? this should be an error somewhere
+(test (keyword? ::) #t)
+(test (keyword? ':) #f)
+(test (keyword->symbol ':) 'error)
+(test (keyword? :::) #t)
+(test (keyword->symbol :::) '::)
+(test ((lambda* ((: 3)) (+ : 1)) :: 4) 5)
+(test ((lambda* ((:: 3)) (+ :: 1)) ::: 4) 'error)
+(test (let ((: 3)) :) 3)
+(test (let ((:: 3)) ::) 'error)
+(test (let ((::: 3)) :::) 'error)
+(test ((inlet ': 3) ':) 3)
+(test (keyword? (keyword->symbol ::asdf)) #t)
+(test (keyword? (symbol->keyword ':)) #t)
+(test (keyword? (symbol->keyword '::)) #t)
+(test (apply let (list (list (symbol "") 3)) (symbol "")) 'error) ; null symbol name
+(test ((lambda* ((asdf 4)) (+ 1 asdf)) :asdf: 5) 'error)
+(test (define-constant :rest :allow-other-keys) 'error)
+(test (define-constant :rest :rest) :rest)
+
+
+;;; --------------------------------------------------------------------------------
+;;; gensym
+(for-each
+ (lambda (arg)
+   (test (gensym arg) 'error))
+ (list -1 #\a 1 'hi _ht_ _undef_ _null_ _c_obj_ #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2)))
+
+(test (gensym "hi" "ho") 'error)
+
+(test (symbol? (gensym)) #t)
+(test (symbol? (gensym "temp")) #t)
+(test (eq? (gensym) (gensym)) #f)
+(test (eqv? (gensym) (gensym)) #f)
+(test (equal? (gensym) (gensym)) #f)
+(test (keyword? (gensym)) #f)
+(test (let* ((a (gensym)) (b a)) (eq? a b)) #t)
+(test (let* ((a (gensym)) (b a)) (eqv? a b)) #t)
+(test (keyword? (symbol->keyword (gensym))) #t)
+(test (let ((g (gensym))) (set! g 12) g) 12)
+;(test (string->byte-vector (substring (symbol->string (gensym #u(124 255 127))) 0 5)) #u(123 124 255 127 125))
+;(test (string->byte-vector (substring (symbol->string (gensym #u(124 0 127))) 0 3))   #u(123 124         125)) ; nul->end of symbol string
+(test (gensym? (string->symbol (symbol->string (gensym)))) #t)
+
+(let ((sym (gensym)))
+  (test (eval `(let ((,sym 32)) (+ ,sym 1))) 33))
+
+(let ((sym1 (gensym))
+      (sym2 (gensym)))
+  (test (eval `(let ((,sym1 32) (,sym2 1)) (+ ,sym1 ,sym2))) 33))
+(test (eval (let ((var (gensym "a b c"))) `(let ((,var 2)) (+ ,var 1)))) 3)
+(test (eval (let ((var (gensym ""))) `(let ((,var 2)) (+ ,var 1)))) 3)
+(test (eval (let ((var (gensym "."))) `(let ((,var 2)) (+ ,var 1)))) 3)
+(test (eval (let ((var (gensym "{"))) `(let ((,var 2)) (+ ,var 1)))) 3)
+(test (eval (let ((var (gensym "}"))) `(let ((,var 2)) (+ ,var 1)))) 3)
+(test (eval (let ((var (gensym (string #\newline)))) `(let ((,var 2)) (+ ,var 1)))) 3)
+
+(test (let ((hi (gensym))) (eq? hi (string->symbol (symbol->string hi)))) #t)
+(test (let () (define-macro (hi a) (let ((var (gensym ";"))) `(let ((,var ,a)) (+ 1 ,var)))) (hi 1)) 2)
+(test (let () (define-macro (hi a) (let ((funny-name (string->symbol (string #\;)))) `(let ((,funny-name ,a)) (+ 1 ,funny-name)))) (hi 1)) 2)
+(test (let () (define-macro (hi a) (let ((funny-name (string->symbol "| e t c |"))) `(let ((,funny-name ,a)) (+ 1 ,funny-name)))) (hi 2)) 3)
+
+(let ((funny-name (string->symbol "| e t c |")))
+  (define-macro (hi a)
+    `(define* (,a (,funny-name 32)) (+ ,funny-name 1)))
+  (hi func)
+  (test (func) 33)
+  (test (func 1) 2)
+  ;(procedure-source func) '(lambda* ((| e t c | 32)) (+ | e t c | 1))
+  (test (apply func (list (symbol->keyword funny-name) 2)) 3)
+  )
+
+(let ((funny-name (string->symbol "| e t c |")))
+  (apply define* `((func (,funny-name 32)) (+ ,funny-name 1)))
+  (test (apply func (list (symbol->keyword funny-name) 2)) 3))
+
+(let* ((g0 (gensym "g")) ; test that gensym returns unique symbol
+       (gnum0 (string->number (substring (symbol->string g0) 4))))
+  (let ((g1 (apply define (list (string->symbol (format #f "{g}-~D" (+ gnum0 1))) 1))))
+    (define g2 (gensym "g"))
+    (let ((gnum2 (string->number (substring (symbol->string g2) 4))))
+      ;; (list g0 g2 gnum2): ({g}-4 {g}-6 6)
+      (test gnum2 (+ gnum0 2))
+      (test (eq? g1 g2) #f)
+      (test (eq? g0 g1) #f)
+      (test (gensym? g1) #f))))
+
+;;; gensym?
+
+(for-each
+ (lambda (arg)
+   (test (gensym? arg) #f))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () car abs (lambda () 1) #2d((1 2) (3 4)) _ht_ _undef_ _null_ _c_obj_ #f 'hi #(()) (list 1 2 3) '(1 . 2) "hi"))
+(test (gensym?) 'error)
+(let ((g (gensym)))
+  (test (gensym? g) #t)
+  (test (gensym? g g) 'error))
+
+
+;;; --------------------------------------------------------------------------------
+;;; provided?
+;;; provide
+;;; require
+
+(test (provided?) 'error)
+(test (or (null? *features*) (pair? *features*)) #t)
+(test (provided? 1 2 3) 'error)
+(provide 's7test)
+(test (provided? 's7test) #t)
+(test (provided? 'not-provided!) #f)
+(test (provided? 'begin) #f)
+(test (provided? if) 'error)
+(test (provided? quote) 'error)
+
+(test (provide quote) 'error)
+(test (provide 1 2 3) 'error)
+(test (provide) 'error)
+(test (provide lambda) 'error)
+
+(test (require) 'error)
+(test (require 1) 'error)
+(test (require _asdf_) 'error)
+
+(provide 's7test) ; should be a no-op??
+(let ((count 0))
+  (for-each
+   (lambda (p)
+     (if (eq? p 's7test)
+	 (set! count (+ count 1)))
+     (if (not (provided? p))
+	 (format #t ";~A is in *features* but not provided? ~A~%" p *features*)))
+   *features*)
+  (if (not (= count 1))
+      (format #t ";*features* has ~D 's7test entries? ~A~%" count *features*)))
+
+(test (let ((*features* 123)) (provided? 's7)) #t)
+
+(for-each
+ (lambda (arg)
+   (test (provide arg) 'error))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2)))
+
+(for-each
+ (lambda (arg)
+   (test (provided? arg) 'error))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2)))
+
+(for-each
+ (lambda (arg)
+   (test (set! (*s7* 'gc-stats) arg) 'error))
+ (list #\a #(1 2 3) 3.14 3/4 1.0+1.0i () #(()) (list 1 2 3) '(1 . 2) 31))
+(test (*s7* 'gc-stats) 0)
+
+(let ((f (sort! (copy *features*) (lambda (a b) (string<? (object->string a #f) (object->string b #f))))))
+  (let ((last 'not-in-*features*))
+    (for-each
+     (lambda (p)
+       (if (eq? p last)
+	   (format #t ";*features has multiple ~A? ~A~%" p *features*))
+       (set! last p))
+     f)))
+
+(let ()
+  (provide 'locals)
+  (test (provided? 'locals) #t))
+(test (provided? 'locals) #f)
+
+(let ()
+  (provide 'local-stuff)
+  (call-with-output-file tmp-output-file
+    (lambda (p)
+      (format p "(provide 'tmp-output)~%(define (tmp-output-func a) a)~%")))
+  (load tmp-output-file)
+  (test (provided? 'tmp-output) #t))
+(test (provided? 'local-stuff) #f)
+(test (provided? 'tmp-output) #t)
+
+
+;;; ----------------
+;;; *features* *load-path* *libraries*
+(for-each
+ (lambda (arg)
+   (test (set! (*s7* 'safety) arg) 'error)
+   (test (set! *features* arg) 'error)
+   (test (set! *load-path* arg) 'error)
+   (test (set! *#readers* arg) 'error))
+ (list #\a #(1 2 3) 3.14 3/4 1.0+1.0i abs 'hi #t #f #(())))
+
+(test (let ((*features* 123)) *features*) 123)
+(test (set! *features* '(1 2 3)) 'error)
+(test (set! *features* '(a b . c)) 'error)
+(test (let-temporarily ((*features* #f)) *features*) 'error)
+
+(let () ; check that local *features* list has the correct setter
+  (provide 'asdf) ; this creates a local *features* list
+  (test (not (setter '*features*)) #f)
+  (test (set! *features* 123) 'error)
+  ;; (test (fill! *features* 123) 'error) ; yow! this wrecks the global *features* list??
+  )
+
+;; there's one bad case here:
+;; (test (let () (provide 'asdf) (fill! *features* 12)) 'error) ; or '(12 12 12...) -- how to recognize this case without an extra lookup every time?
+
+(test (set! *features* 123) 'error)
+(test (fill! *features* 'asdf) 'error)
+;; (let ((*features* (cons 0 (lambda (a b . c) a))))...) gets through because let doesn't check setters
+;;
+;; none of these raise an error:
+;;   (set! (car *features*) #2i((1 2) (3 4)))
+;;   (set-car! *features* #2i((1 2) (5 6)))
+;;   (set-cdr! *features* #(1 2))
+;;   (set! (cdr *features*) #(1 2))
+;;   (let ((*features* #(1 2))) *features*)
+;;   (copy '(1 2 3) *features*)
+;;   (reverse! *features*)
+;;   (list-set! *features* 1 123)
+;;   (sort! *features* (lambda (x y) (string<? (symbol->string x) (symbol->string y))))
+;;
+;; these raise an error:
+;;   (fill! *features* 1): error: can't fill! *features*
+;;   (set! *features* (cons 1 1)): error: can't set *features* to an improper or circular list (1 . 1)
+
+(when (pair? *libraries*)
+  (test (fill! *libraries* #f) 'error))
+(test (set! *libraries* #f) 'error)
+(test (set! *libraries* (list 1 2)) 'error)
+;(test (copy '(1 2 3) *features*) 'error) ; '(1 2 3 cload.scm write.scm gcc linux aligned ...)
+
+(test (set! pi 3) 'error)
+(test (let-temporarily ((pi 3)) pi) 'error)
+(test (set! ((rootlet) 'pi) 3) 'error)
+(test (let-set! (rootlet) 'pi 3) 'error)
+(test (copy '((pi . 3)) (rootlet)) 'error)
+(test ((lambda (pi) pi) 3) 'error)
+
+(test (set! *load-path* (list 1 2 3)) 'error)
+(test (set! *#readers* (list 32)) 'error)
+(test (set! *#readers* (list (list #\a 32))) 'error)
+(test  (set! *#readers* (list (list 32))) 'error)
+(set! *#readers* old-readers)
+
+(define old-safety (*s7* 'safety))
+(set! (*s7* 'safety) 2)
+
+  (let ((v #(1 2 3))
+	(iv #i(1 2 3))
+	(rv #r(1.0 2.0 3.0))
+	(str "123")
+	(pair '(1 2 3)))
+    (test (sort! v <) 'error)
+    (test (sort! iv <) 'error)
+    (test (sort! rv <) 'error)
+    (test (sort! str char<?) 'error)
+    (test (sort! pair <) 'error)
+    (test (reverse! v) 'error)
+    (test (reverse! iv) 'error)
+    (test (reverse! rv) 'error)
+    (test (reverse! str) 'error)
+    (test (reverse! pair) 'error)
+    (test (fill! v 0) 'error)
+    (test (fill! iv 0) 'error)
+    (test (fill! rv 0.0) 'error)
+    (test (fill! str #\a) 'error)
+    (test (fill! pair 0) 'error))
+
+(set! (*s7* 'safety) old-safety)
+
+;;; local *load-path*
+(when (and (defined? 'file-exists?)
+           (file-exists? "/home/bil/test"))
+  (define old-load-path *load-path*)
+  (call-with-output-file "test-load-1.scm"
+    (lambda (port)
+      (format port "(define (lt1) 111)\n(lt1)\n")))
+  (call-with-output-file "/home/bil/test/test-load-2.scm"
+    (lambda (port)
+      (format port "(define (lt2) 222)\n(lt2)\n")))
+  (call-with-output-file "/home/bil/test/test-load-1.scm"
+    (lambda (port)
+      (format port "(define (lt3) 333)\n(lt3)\n")))
+
+  (test (load "test-load-1.scm") 111)
+  (test (load "test-load-2.scm") 'error)
+
+  (set! *load-path* (cons "/home/bil/test/" *load-path*))
+  (test (load "test-load-1.scm") 111) ; local dir is always searched first
+  (test (load "test-load-2.scm") 222)
+
+  (set! *load-path* (list "/home/bil/test/"))
+  (test (load "test-load-1.scm") 111)
+  (test (load "test-load-2.scm") 222)
+
+  (set! *load-path* (list "."))
+  (let ((*load-path* (list "/home/bil/test/" ".")))
+    (test (load "test-load-1.scm" (curlet)) 111) ; if no env, curlet set to rootlet during load, so the *load-path* used is the rootlet version
+    (test (load "test-load-2.scm" (curlet)) 222))
+
+  (test (delete-file "test-load-1.scm") 0)
+  (test (load "test-load-1.scm") 'error)
+  (test (load "test-load-2.scm") 'error)
+
+  (let ((*load-path* (list "/home/bil/test/")))
+    (test (load "test-load-1.scm" (curlet)) 333)
+    (test (load "test-load-2.scm" (curlet)) 222))
+
+  (set! *load-path* old-load-path))
+;;; --------
+
+;;; (*s7* 'print-length)
+
+(test (integer? (*s7* 'print-length)) #t)
+(test (or (null? *#readers*) (pair? *#readers*)) #t)
+(test (or (null? *load-path*) (pair? *load-path*)) #t)
+
+(let-temporarily (((*s7* 'print-length) 32))
+  (for-each
+   (lambda (arg)
+     (test (set! (*s7* 'print-length) arg) 'error))
+   (list -1 #\a #(1 2 3) 3.14 3/4 1.0+1.0i abs 'hi () #t #f #(()) (list 1 2 3) '(1 . 2))))
+
+(let-temporarily (((*s7* 'print-length) 0))
+  (test (format #f "~A" #()) "#()")
+  (test (format #f "~A" #(1 2 3 4)) "#(...)")
+  (set! (*s7* 'print-length) 1)
+  (test (format #f "~A" #()) "#()")
+  (test (format #f "~A" #(1)) "#(1)")
+  (test (format #f "~A" #(1 2 3 4)) "#(1 ...)")
+  (set! (*s7* 'print-length) 2)
+  (test (format #f "~A" #(1 2 3 4)) "#(1 2 ...)"))
+
+(when with-bignums
+  (let-temporarily (((*s7* 'print-length) (bignum "0")))
+    (test (format #f "~A" #()) "#()")
+    (test (format #f "~A" #(1 2 3 4)) "#(...)")
+    (set! (*s7* 'print-length) (bignum "1"))
+    (test (format #f "~A" #()) "#()")
+    (test (format #f "~A" #(1)) "#(1)")
+    (test (format #f "~A" #(1 2 3 4)) "#(1 ...)")
+    (set! (*s7* 'print-length) (bignum "2"))
+    (test (format #f "~A" #(1 2 3 4)) "#(1 2 ...)")))
+
+(test (set! (*s7* 'safety) -5) 'error)
+(test (set! (*s7* 'safety) 5) 'error)
+
+
+;;; --------------------------------------------------------------------------------
+;;; sort!
+
+(test (sort! '(2 3) <) '(2 3))
+(test (sort! '(3 2) <) '(2 3))
+(test (sort! '(12 3) <) '(3 12))
+
+(test (sort! '(1 2 3) <) '(1 2 3))
+(test (sort! '(1 3 2) <) '(1 2 3))
+(test (sort! '(2 1 3) <) '(1 2 3))
+(test (sort! '(2 3 1) <) '(1 2 3))
+(test (sort! '(3 1 2) <) '(1 2 3))
+(test (sort! '(3 2 1) <) '(1 2 3))
+
+(test (sort! '(1 2 3) (lambda (a b) (> a b))) '(3 2 1))
+(test (sort! #(2 3) <) #(2 3))
+(test (sort! #(12 3) <) #(3 12))
+
+(test (sort! #(1 2 3) <) #(1 2 3))
+(test (sort! #(1 3 2) <) #(1 2 3))
+(test (sort! #(2 1 3) <) #(1 2 3))
+(test (sort! #(2 3 1) <) #(1 2 3))
+(test (sort! #(3 1 2) <) #(1 2 3))
+(test (sort! #(3 2 1) <) #(1 2 3))
+
+(test (sort! #(1 2 3 4) <) #(1 2 3 4))
+(test (sort! #(1 2 4 3) <) #(1 2 3 4))
+(test (sort! #(1 3 2 4) <) #(1 2 3 4))
+(test (sort! #(1 3 4 2) <) #(1 2 3 4))
+(test (sort! #(1 4 2 3) <) #(1 2 3 4))
+(test (sort! #(1 4 3 2) <) #(1 2 3 4))
+(test (sort! #(2 1 3 4) <) #(1 2 3 4))
+(test (sort! #(2 1 4 3) <) #(1 2 3 4))
+(test (sort! #(2 3 4 1) <) #(1 2 3 4))
+(test (sort! #(2 3 1 4) <) #(1 2 3 4))
+(test (sort! #(2 4 3 1) <) #(1 2 3 4))
+(test (sort! #(2 4 1 3) <) #(1 2 3 4))
+(test (sort! #(3 1 2 4) <) #(1 2 3 4))
+(test (sort! #(3 1 4 2) <) #(1 2 3 4))
+(test (sort! #(3 2 4 1) <) #(1 2 3 4))
+(test (sort! #(3 2 1 4) <) #(1 2 3 4))
+(test (sort! #(3 4 1 2) <) #(1 2 3 4))
+(test (sort! #(3 4 2 1) <) #(1 2 3 4))
+(test (sort! #(4 1 2 3) <) #(1 2 3 4))
+(test (sort! #(4 1 3 2) <) #(1 2 3 4))
+(test (sort! #(4 2 1 3) <) #(1 2 3 4))
+(test (sort! #(4 2 3 1) <) #(1 2 3 4))
+(test (sort! #(4 3 2 1) <) #(1 2 3 4))
+(test (sort! #(4 3 1 2) <) #(1 2 3 4))
+
+(let ((f (lambda (a b)
+	   (< (car a) (car b)))))
+  (test (sort! (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))
+  (test (sort! (list (cons 1 "1") (cons 2 "2") (cons 4 "4") (cons 3 "3")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))
+  (test (sort! (list (cons 1 "1") (cons 3 "3") (cons 2 "2") (cons 4 "4")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))
+  (test (sort! (list (cons 1 "1") (cons 3 "3") (cons 4 "4") (cons 2 "2")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))
+  (test (sort! (list (cons 1 "1") (cons 4 "4") (cons 2 "2") (cons 3 "3")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))
+  (test (sort! (list (cons 1 "1") (cons 4 "4") (cons 3 "3") (cons 2 "2")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))
+  (test (sort! (list (cons 2 "2") (cons 1 "1") (cons 3 "3") (cons 4 "4")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))
+  (test (sort! (list (cons 2 "2") (cons 1 "1") (cons 4 "4") (cons 3 "3")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))
+  (test (sort! (list (cons 2 "2") (cons 3 "3") (cons 4 "4") (cons 1 "1")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))
+  (test (sort! (list (cons 2 "2") (cons 3 "3") (cons 1 "1") (cons 4 "4")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))
+  (test (sort! (list (cons 2 "2") (cons 4 "4") (cons 3 "3") (cons 1 "1")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))
+  (test (sort! (list (cons 2 "2") (cons 4 "4") (cons 1 "1") (cons 3 "3")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))
+  (test (sort! (list (cons 3 "3") (cons 1 "1") (cons 2 "2") (cons 4 "4")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))
+  (test (sort! (list (cons 3 "3") (cons 1 "1") (cons 4 "4") (cons 2 "2")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))
+  (test (sort! (list (cons 3 "3") (cons 2 "2") (cons 4 "4") (cons 1 "1")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))
+  (test (sort! (list (cons 3 "3") (cons 2 "2") (cons 1 "1") (cons 4 "4")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))
+  (test (sort! (list (cons 3 "3") (cons 4 "4") (cons 1 "1") (cons 2 "2")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))
+  (test (sort! (list (cons 3 "3") (cons 4 "4") (cons 2 "2") (cons 1 "1")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))
+  (test (sort! (list (cons 4 "4") (cons 1 "1") (cons 2 "2") (cons 3 "3")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))
+  (test (sort! (list (cons 4 "4") (cons 1 "1") (cons 3 "3") (cons 2 "2")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))
+  (test (sort! (list (cons 4 "4") (cons 2 "2") (cons 1 "1") (cons 3 "3")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))
+  (test (sort! (list (cons 4 "4") (cons 2 "2") (cons 3 "3") (cons 1 "1")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))
+  (test (sort! (list (cons 4 "4") (cons 3 "3") (cons 2 "2") (cons 1 "1")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))
+  (test (sort! (list (cons 4 "4") (cons 3 "3") (cons 1 "1") (cons 2 "2")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))))
+
+(test (sort! #(5 1 2 3 4) <) #(1 2 3 4 5))
+(test (sort! #(5 1 2 4 3) <) #(1 2 3 4 5))
+(test (sort! #(5 1 3 2 4) <) #(1 2 3 4 5))
+(test (sort! #(5 1 3 4 2) <) #(1 2 3 4 5))
+(test (sort! #(5 1 4 2 3) <) #(1 2 3 4 5))
+(test (sort! #(5 1 4 3 2) <) #(1 2 3 4 5))
+(test (sort! #(5 2 1 3 4) <) #(1 2 3 4 5))
+(test (sort! #(5 2 1 4 3) <) #(1 2 3 4 5))
+(test (sort! #(5 2 3 4 1) <) #(1 2 3 4 5))
+(test (sort! #(5 2 3 1 4) <) #(1 2 3 4 5))
+(test (sort! #(5 2 4 3 1) <) #(1 2 3 4 5))
+(test (sort! #(5 2 4 1 3) <) #(1 2 3 4 5))
+(test (sort! #(5 3 1 2 4) <) #(1 2 3 4 5))
+(test (sort! #(5 3 1 4 2) <) #(1 2 3 4 5))
+(test (sort! #(5 3 2 4 1) <) #(1 2 3 4 5))
+(test (sort! #(5 3 2 1 4) <) #(1 2 3 4 5))
+(test (sort! #(5 3 4 1 2) <) #(1 2 3 4 5))
+(test (sort! #(5 3 4 2 1) <) #(1 2 3 4 5))
+(test (sort! #(5 4 1 2 3) <) #(1 2 3 4 5))
+(test (sort! #(5 4 1 3 2) <) #(1 2 3 4 5))
+(test (sort! #(5 4 2 1 3) <) #(1 2 3 4 5))
+(test (sort! #(5 4 2 3 1) <) #(1 2 3 4 5))
+(test (sort! #(5 4 3 2 1) <) #(1 2 3 4 5))
+(test (sort! #(5 4 3 1 2) <) #(1 2 3 4 5))
+(test (sort! #(1 5 2 3 4) <) #(1 2 3 4 5))
+(test (sort! #(1 5 2 4 3) <) #(1 2 3 4 5))
+(test (sort! #(1 5 3 2 4) <) #(1 2 3 4 5))
+(test (sort! #(1 5 3 4 2) <) #(1 2 3 4 5))
+(test (sort! #(1 5 4 2 3) <) #(1 2 3 4 5))
+(test (sort! #(1 5 4 3 2) <) #(1 2 3 4 5))
+(test (sort! #(2 5 1 3 4) <) #(1 2 3 4 5))
+(test (sort! #(2 5 1 4 3) <) #(1 2 3 4 5))
+(test (sort! #(2 5 3 4 1) <) #(1 2 3 4 5))
+(test (sort! #(2 5 3 1 4) <) #(1 2 3 4 5))
+(test (sort! #(2 5 4 3 1) <) #(1 2 3 4 5))
+(test (sort! #(2 5 4 1 3) <) #(1 2 3 4 5))
+(test (sort! #(3 5 1 2 4) <) #(1 2 3 4 5))
+(test (sort! #(3 5 1 4 2) <) #(1 2 3 4 5))
+(test (sort! #(3 5 2 4 1) <) #(1 2 3 4 5))
+(test (sort! #(3 5 2 1 4) <) #(1 2 3 4 5))
+(test (sort! #(3 5 4 1 2) <) #(1 2 3 4 5))
+(test (sort! #(3 5 4 2 1) <) #(1 2 3 4 5))
+(test (sort! #(4 5 1 2 3) <) #(1 2 3 4 5))
+(test (sort! #(4 5 1 3 2) <) #(1 2 3 4 5))
+(test (sort! #(4 5 2 1 3) <) #(1 2 3 4 5))
+(test (sort! #(4 5 2 3 1) <) #(1 2 3 4 5))
+(test (sort! #(4 5 3 2 1) <) #(1 2 3 4 5))
+(test (sort! #(4 5 3 1 2) <) #(1 2 3 4 5))
+(test (sort! #(1 2 5 3 4) <) #(1 2 3 4 5))
+(test (sort! #(1 2 5 4 3) <) #(1 2 3 4 5))
+(test (sort! #(1 3 5 2 4) <) #(1 2 3 4 5))
+(test (sort! #(1 3 5 4 2) <) #(1 2 3 4 5))
+(test (sort! #(1 4 5 2 3) <) #(1 2 3 4 5))
+(test (sort! #(1 4 5 3 2) <) #(1 2 3 4 5))
+(test (sort! #(2 1 5 3 4) <) #(1 2 3 4 5))
+(test (sort! #(2 1 5 4 3) <) #(1 2 3 4 5))
+(test (sort! #(2 3 5 4 1) <) #(1 2 3 4 5))
+(test (sort! #(2 3 5 1 4) <) #(1 2 3 4 5))
+(test (sort! #(2 4 5 3 1) <) #(1 2 3 4 5))
+(test (sort! #(2 4 5 1 3) <) #(1 2 3 4 5))
+(test (sort! #(3 1 5 2 4) <) #(1 2 3 4 5))
+(test (sort! #(3 1 5 4 2) <) #(1 2 3 4 5))
+(test (sort! #(3 2 5 4 1) <) #(1 2 3 4 5))
+(test (sort! #(3 2 5 1 4) <) #(1 2 3 4 5))
+(test (sort! #(3 4 5 1 2) <) #(1 2 3 4 5))
+(test (sort! #(3 4 5 2 1) <) #(1 2 3 4 5))
+(test (sort! #(4 1 5 2 3) <) #(1 2 3 4 5))
+(test (sort! #(4 1 5 3 2) <) #(1 2 3 4 5))
+(test (sort! #(4 2 5 1 3) <) #(1 2 3 4 5))
+(test (sort! #(4 2 5 3 1) <) #(1 2 3 4 5))
+(test (sort! #(4 3 5 2 1) <) #(1 2 3 4 5))
+(test (sort! #(4 3 5 1 2) <) #(1 2 3 4 5))
+(test (sort! #(1 2 3 5 4) <) #(1 2 3 4 5))
+(test (sort! #(1 2 4 5 3) <) #(1 2 3 4 5))
+(test (sort! #(1 3 2 5 4) <) #(1 2 3 4 5))
+(test (sort! #(1 3 4 5 2) <) #(1 2 3 4 5))
+(test (sort! #(1 4 2 5 3) <) #(1 2 3 4 5))
+(test (sort! #(1 4 3 5 2) <) #(1 2 3 4 5))
+(test (sort! #(2 1 3 5 4) <) #(1 2 3 4 5))
+(test (sort! #(2 1 4 5 3) <) #(1 2 3 4 5))
+(test (sort! #(2 3 4 5 1) <) #(1 2 3 4 5))
+(test (sort! #(2 3 1 5 4) <) #(1 2 3 4 5))
+(test (sort! #(2 4 3 5 1) <) #(1 2 3 4 5))
+(test (sort! #(2 4 1 5 3) <) #(1 2 3 4 5))
+(test (sort! #(3 1 2 5 4) <) #(1 2 3 4 5))
+(test (sort! #(3 1 4 5 2) <) #(1 2 3 4 5))
+(test (sort! #(3 2 4 5 1) <) #(1 2 3 4 5))
+(test (sort! #(3 2 1 5 4) <) #(1 2 3 4 5))
+(test (sort! #(3 4 1 5 2) <) #(1 2 3 4 5))
+(test (sort! #(3 4 2 5 1) <) #(1 2 3 4 5))
+(test (sort! #(4 1 2 5 3) <) #(1 2 3 4 5))
+(test (sort! #(4 1 3 5 2) <) #(1 2 3 4 5))
+(test (sort! #(4 2 1 5 3) <) #(1 2 3 4 5))
+(test (sort! #(4 2 3 5 1) <) #(1 2 3 4 5))
+(test (sort! #(4 3 2 5 1) <) #(1 2 3 4 5))
+(test (sort! #(4 3 1 5 2) <) #(1 2 3 4 5))
+(test (sort! #(1 2 3 4 5) <) #(1 2 3 4 5))
+(test (sort! #(1 2 4 3 5) <) #(1 2 3 4 5))
+(test (sort! #(1 3 2 4 5) <) #(1 2 3 4 5))
+(test (sort! #(1 3 4 2 5) <) #(1 2 3 4 5))
+(test (sort! #(1 4 2 3 5) <) #(1 2 3 4 5))
+(test (sort! #(1 4 3 2 5) <) #(1 2 3 4 5))
+(test (sort! #(2 1 3 4 5) <) #(1 2 3 4 5))
+(test (sort! #(2 1 4 3 5) <) #(1 2 3 4 5))
+(test (sort! #(2 3 4 1 5) <) #(1 2 3 4 5))
+(test (sort! #(2 3 1 4 5) <) #(1 2 3 4 5))
+(test (sort! #(2 4 3 1 5) <) #(1 2 3 4 5))
+(test (sort! #(2 4 1 3 5) <) #(1 2 3 4 5))
+(test (sort! #(3 1 2 4 5) <) #(1 2 3 4 5))
+(test (sort! #(3 1 4 2 5) <) #(1 2 3 4 5))
+(test (sort! #(3 2 4 1 5) <) #(1 2 3 4 5))
+(test (sort! #(3 2 1 4 5) <) #(1 2 3 4 5))
+(test (sort! #(3 4 1 2 5) <) #(1 2 3 4 5))
+(test (sort! #(3 4 2 1 5) <) #(1 2 3 4 5))
+(test (sort! #(4 1 2 3 5) <) #(1 2 3 4 5))
+(test (sort! #(4 1 3 2 5) <) #(1 2 3 4 5))
+(test (sort! #(4 2 1 3 5) <) #(1 2 3 4 5))
+(test (sort! #(4 2 3 1 5) <) #(1 2 3 4 5))
+(test (sort! #(4 3 2 1 5) <) #(1 2 3 4 5))
+(test (sort! #(4 3 1 2 5) <) #(1 2 3 4 5))
+
+(test (sort! #(3 1 2 1 4 1) <) #(1 1 1 2 3 4))
+(test (sort! #(1 1 1) <) #(1 1 1))
+(test (sort! #(1 2 3) (lambda (a b) (> a b))) #(3 2 1))
+(test (sort! #((1 . 3) (1 . 1) (1 . 2) (1 . 1) (1 . 4) (1 . 1)) (lambda (a b) (< (cdr a) (cdr b)))) #((1 . 1) (1 . 1) (1 . 1) (1 . 2) (1 . 3) (1 . 4)))
+
+(test (equal? (sort! (list 3 4 8 2 0 1 5 9 7 6) <) (list 0 1 2 3 4 5 6 7 8 9)) #t)
+(test (equal? (sort! (list 3 4 8 2 0 1 5 9 7 6) (lambda (a b) (< a b))) (list 0 1 2 3 4 5 6 7 8 9)) #t)
+(test (equal? (sort! (list) <) ()) #t)
+(test (equal? (sort! (list 1) <) '(1)) #t)
+(test (equal? (sort! (list 1 1 1) <) '(1 1 1)) #t)
+(test (equal? (sort! (list 0 1 2 3 4 5 6 7 8 9) <) '(0 1 2 3 4 5 6 7 8 9)) #t)
+(test (equal? (sort! (list #\a #\l #\o #\h #\a) char<?) '(#\a #\a #\h #\l #\o)) #t)
+(test (equal? (sort! (list "tic" "tac" "toe") string<?) '("tac" "tic" "toe")) #t)
+(test (equal? (sort! (list 3 4 8 2 0 1 5 9 7 6) >) (reverse (list 0 1 2 3 4 5 6 7 8 9))) #t)
+(test (equal? (sort! '((3 . 1) (2 . 8) (5 . 9) (4 . 7) (6 . 0)) (lambda (a b) (< (car a) (car b)))) '((2 . 8) (3 . 1) (4 . 7) (5 . 9) (6 . 0))) #t)
+(test (equal? (sort! '((3 . 1) (2 . 8) (5 . 9) (4 . 7) (6 . 0)) (lambda (a b) (< (cdr a) (cdr b)))) '((6 . 0) (3 . 1) (4 . 7) (2 . 8) (5 . 9))) #t)
+(test (equal? (sort! (list (list 1 2) (list 4 3 2) (list) (list 1 2 3 4)) (lambda (a b) (> (length a) (length b)))) '((1 2 3 4) (4 3 2) (1 2) ())) #t)
+(test (equal? (sort! '((1 2 3) (4 5 6) (7 8 9)) (lambda (a b) (> (car a) (car b)))) '((7 8 9) (4 5 6) (1 2 3))) #t)
+(test (equal? (sort! (list #\b #\A #\B #\a #\c #\C) char<?) '(#\A #\B #\C #\a #\b #\c)) #t)
+(test (equal? (sort! (list (list 'u 2) (list 'i 1) (list 'a 7) (list 'k 3) (list 'c 4) (list 'b 6))
+		     (lambda (a b) (< (cadr a) (cadr b))))
+	      '((i 1) (u 2) (k 3) (c 4) (b 6) (a 7)))
+      #t)
+(test (equal? (sort! (sort! '(1 2 3) >) <) '(1 2 3)) #t)
+(test (sort! #2d((1 2) (3 4)) >) #2d((4 3) (2 1))) ; ?!?
+(test (sort! #2d((1 4) (3 2)) >) #2d((4 3) (2 1))) ; ??!!?? this is not what anyone would expect
+(test (sort! '(3 2 1) (lambda (a b c) #f)) 'error)
+(test (sort! '(3 2 1) (lambda* (a b c) (< a b))) '(1 2 3))
+(test (sort! '(3 2 1) (lambda (a b . c) (< a b))) '(1 2 3))
+(test (sort! '(3 2 1) (lambda (a) #f)) 'error)
+(test (sort! '(3 2 1) (lambda* (a) #f)) 'error)
+(test (sort! '(3 1 2 4) (lambda args (< (car args) (cadr args)))) '(1 2 3 4))
+(test (sort! (rootlet) <) 'error)
+(test (sort! () #f) 'error)
+
+(test (equal? (sort! (vector 3 4 8 2 0 1 5 9 7 6) <) (vector 0 1 2 3 4 5 6 7 8 9)) #t)
+(test (equal? (sort! (make-int-vector 3 0) (lambda* (a b) (< a b))) (make-int-vector 3 0)) #t)
+(test (equal? (sort! (make-float-vector 3 1.0) >) (float-vector 1.0 1.0 1.0)) #t)
+(test (equivalent? (let ((v (make-int-vector 3 0))) (set! (v 1) 3) (set! (v 2) -1) (sort! v <)) #(-1 0 3)) #t)
+(test (equivalent? (let ((v (make-int-vector 3 0))) (set! (v 1) 3) (set! (v 2) -1) (sort! v (lambda (a b) (< a b)))) #(-1 0 3)) #t)
+(test (equivalent? (let ((v (make-int-vector 3 0))) (set! (v 1) 3) (set! (v 2) -1) (sort! v (lambda* (a b) (< a b)))) #(-1 0 3)) #t)
+
+(test (equal? (sort! #() <) #()) #t)
+(test (sort! '(1 2 . 3) <) 'error)
+(test (sort! #(1 3 8 7 5 6 4 2) (lambda (a b) (if (even? a) (or (odd? b) (< a b)) (and (odd? b) (< a b))))) #(2 4 6 8 1 3 5 7))
+(let ((ninf (real-part (log 0.0))) (pinf (- (real-part (log 0.0))))) (test (sort! (list pinf 0.0 ninf) <) (list ninf 0.0 pinf)))
+(test (sort! '(1 1 1) <) '(1 1 1))
+
+(test (call/cc (lambda (return) (sort! '(1 2 3) (lambda (a b) (return "oops"))))) "oops")
+(let ((p1 (dilambda (lambda (a b) (< a b)) (lambda (a b c) (error 'oops)))))
+  (test (sort! '(3 1 2 4) p1) '(1 2 3 4)))
+(let ((p1 (dilambda (lambda* (a (b 2)) (< a b)) (lambda (a b c) (error 'oops)))))
+  (test (sort! '(3 1 2 4) p1) '(1 2 3 4)))
+(let ((p1 (dilambda (lambda args (< (car args) (cadr args))) (lambda (a b) (error 'oops)))))
+  (test (sort! '(3 1 2 4) p1) '(1 2 3 4)))
+
+(let ((imploc (immutable! (cons 0 (immutable! (cons 1 (immutable! (cons 2 ()))))))))
+  (test (sort! (cons -1 imploc) >) 'error)
+  (test (sort! (cons -1 imploc) (lambda (a b) (not (<= a b)))) 'error)
+  (test (sort! (cons -1 imploc) (lambda (a b) (call-with-exit (lambda (return) (return (not (<= a b))))))) 'error)) ; vector_into_list
+
+(let () ; sort! bug, (x = y) where we intended (x == y)
+  (define (f1) (let ((cs (vector #\a #\f #\d #\c))) (do ((i 0 (+ i 1))) ((= i 1)) (sort! cs char<?)) cs))
+  (test (f1) #(#\a #\c #\d #\f))
+  (define (f2) (let ((cs (vector #\a #\f #\d #\c))) (do ((i 0 (+ i 1))) ((= i 1)) (sort! cs char>?)) cs))
+  (test (f2) #(#\f #\d #\c #\a)))
+
+(test (let ((v (make-float-vector 1000)))
+	(do ((i 0 (+ i 1)))
+	    ((= i 1000))
+	  (float-vector-set! v i (random 100.0)))
+	(set! v (sort! v >))
+	(call-with-exit
+	 (lambda (return)
+	   (do ((i 0 (+ i 1)))
+	       ((= i 999) #t)
+	     (if (< (v i) (v (+ i 1)))
+		 (begin
+		   (format #t "random vals after sort: ~A ~A~%" (v i) (v (+ i 1)))
+		   (return #f)))))))
+      #t)
+
+(let ((v ()))
+  (do ((i 0 (+ i 1)))
+      ((= i 1000))
+    (set! v (cons (random 100.0) v)))
+  (set! v (sort! v >))
+  (if (not (apply >= v))
+      (format #t ";sort!: v not sorted by >: ~A~%" )))
+
+
+(test (sort! (list 3 2 1) (lambda (m n) (let ((vals (sort! (list m n) <))) (< m n)))) '(1 2 3))
+
+(test (let ((lst ()))
+	(do ((i 0 (+ i 1)))
+	    ((= i 4))
+	  (set! lst (cons (random 1.0) lst)))
+	(let ((vals (sort! lst (lambda (m n)
+				 (let ((lst1 (list 1 2 3)))
+				   (sort! lst1 <))
+				 (< m n)))))
+	  (apply < vals)))
+      #t)
+
+
+(let ((v (make-vector 8)))
+  (do ((i 0 (+ i 1)))
+      ((= i 10))
+    (do ((k 0 (+ k 1)))
+	((= k 8))
+      (set! (v k) (- (random 1.0) 0.5)))
+    (let ((v1 (copy v)))
+      (sort! v <)
+      (if (not (apply < (vector->list v)))
+	  (format #t ";(sort! ~A <) -> ~A?" v1 v)))))
+
+(test (sort!) 'error)
+(test (sort! '(1 2 3) < '(3 2 1)) 'error)
+(test (sort! '(1 2 3)) 'error)
+(test (sort! '(1 2 3) 1) 'error)
+(test (sort! '(1 2 3) < <) 'error)
+(test (sort! (cons 3 2) <) 'error)
+(test (sort! (list 1 0+i) <) 'error)
+(test (sort! (list "hi" "ho") <) 'error)
+(test (sort! '(1 2 #t) <) 'error)
+(test (sort! '(1 2 . #t) <) 'error)
+(test (sort! '(#\c #\a #\b) <) 'error)
+(test (sort! (begin) if) 'error)
+
+(test (let ((v #(1 2 3))) (let ((v1 (sort! v >))) (eq? v v1))) #t)
+(test (let ((v (float-vector 1 2 3))) (let ((v1 (sort! v >))) (eq? v v1))) #t)
+(test (let ((v (make-int-vector 3 0))) (let ((v1 (sort! v >))) (eq? v v1))) #t)
+(test (let ((v #u(0 1 2))) (let ((v1 (sort! v >))) (eq? v v1))) #t)
+(test (let ((v (list 0 1 2))) (let ((v1 (sort! v >))) (eq? v v1))) #t)
+(test (let ((v "012")) (let ((v1 (sort! v char>?))) (eq? v v1))) #t)
+
+(test (let ((v "adcb")) (sort! v char>?) v) "dcba")
+(test (let ((v "adcb")) (sort! v <) v) 'error)
+(test (let ((v "adecb")) (sort! v char<?) v) "abcde")
+(test (let ((v "db")) (sort! v char<?)) "bd")
+(test (let ((v "d")) (sort! v char<?) v) "d")
+(test (let ((v "")) (sort! v char<?) v) "")
+(test (let ((v "adecfb")) (sort! v (lambda (a b) (char<? a b)))) "abcdef")
+
+(test (let ((v #u(3 0 1 2))) (sort! v <) v) #u(0 1 2 3))
+(test (let ((v #u(3 0 1 2))) (sort! v >)) #u(3 2 1 0))
+(test (let ((v #u(3 0 1 2))) (sort! v char>?) v) 'error)
+(test (let ((v #u(3))) (sort! v >) v) #u(3))
+(test (let ((v #u(3 1))) (sort! v <) v) #u(1 3))
+(test (let ((v #u())) (sort! v <) v) #u())
+(test (let ((v #u(1 4 3 2 0))) (sort! v (lambda (a b) (< a b)))) #u(0 1 2 3 4))
+(test (let ((v #("123" "321" "132" "432" "0103" "123"))) (sort! v string>?)) #("432" "321" "132" "123" "123" "0103"))
+
+(test (sort! (list) <) ())
+(test (sort! (vector) <) #())
+(test (sort! (string) char<?) (string))
+(test (sort! (list #\a) <) '(#\a)) ; I guess this is reasonable
+(test (sort! (list #("hi")) <) '(#("hi")))
+(test (sort! (append (sort! (append (sort! () <) ()) <) ()) <) ())
+(test (sort! (append (sort! (append (sort! '(1 2) <) '(1 2)) <) '(1 2)) <) '(1 1 1 2 2 2))
+(test (let ((lst (list 3 1 12 4 1)))
+      (sort! lst (lambda (a b)
+                   (let ((val (map (lambda (n) (+ n 1)) (list a b))))
+                     (apply < val)))))
+      '(1 1 3 4 12))
+(test (sort! '(#\c #\a #\b) (lambda (a b) (string<? (string a) (string b)))) '(#\a #\b #\c))
+(test (vector-typer (sort! (make-vector 3 1/2 rational?) <)) rational?)
+
+(test (let ((ov #(0 1 2)) (uv #(5 4 3 2 1))) (sort! uv (lambda (a b) (sort! ov >) (< a b))) ov) #(2 1 0))
+
+(for-each
+ (lambda (arg)
+   (test (sort! arg <) 'error)
+   (test (sort! () arg) 'error))
+ (list -1 #\a 1 0 "hiho" (make-hash-table) :hi 'a-symbol 3.14 3/4 1.0+1.0i #f #t))
+
+(for-each
+ (lambda (arg)
+   (test (sort! '(1 2 3) arg) 'error))
+ (list -1 #\a 1 0 'a-symbol 3.14 3/4 1.0+1.0i #f #t #(1) '(1) "hi" abs :hi))
+
+(test (sort! '(1 2 "hi" 3) <) 'error)
+(test (sort! '(1 -2 "hi" 3) (lambda (a b)
+			     (let ((a1 (if (number? a) a (length a)))
+				   (b1 (if (number? b) b (length b))))
+			       (< a1 b1))))
+      '(-2 1 "hi" 3))
+
+(let ((ok #f))
+  (catch #t
+	 (lambda ()
+	   (dynamic-wind
+	       (lambda () #f)
+	       (lambda () (sort! '(1 2 "hi" 3) <))
+	       (lambda () (set! ok #t))))
+	 (lambda args 'error))
+  (if (not ok) (format #t "dynamic-wind out of sort! skipped cleanup?~%")))
+
+(test (let ((v (float-vector 1 2 3))) (sort! v (lambda (a b) (call-with-exit (lambda (r) (> a b))))) v) (float-vector 3 2 1))
+(test (let ((v (int-vector 1 2 3))) (sort! v (lambda (a b) (call-with-exit (lambda (r) (> a b))))) v) (int-vector 3 2 1))
+(test (let ((v (list 1 2 3))) (sort! v (lambda (a b) (call-with-exit (lambda (r) (> a b))))) v) (list 3 2 1))
+(test (let ((v "123")) (sort! v (lambda (a b) (call-with-exit (lambda (r) (char>? a b))))) v) "321")
+(test (let ((v #u(1 2 3))) (sort! v (lambda (a b) (call-with-exit (lambda (r) (> a b))))) v) #u(3 2 1))
+
+(let ((lst (list 1 2 3 9 8 7)))
+  (let ((val (catch #t
+		    (lambda ()
+		      (sort! (copy lst)
+			     (lambda (a b)
+			       (if (< a b) (error 'sort-error "a < b"))
+			       #t)))
+		    (lambda args (car args)))))
+    (if (not (eq? val 'sort-error))
+	(format #t ";sort! with error: ~A~%" val)))
+
+  (let ((val (call-with-exit
+	      (lambda (return)
+		(sort! (copy lst)
+		       (lambda (a b)
+			 (if (< a b) (return 'sort-error))
+			 #t))))))
+    (if (not (eq? val 'sort-error))
+	(format #t ";sort! call-with-exit: ~A~%" val)))
+
+  (let ((val (call/cc
+	      (lambda (return)
+		(sort! (copy lst)
+		       (lambda (a b)
+			 (if (< a b) (return 'sort-error))
+			 #t))))))
+    (if (not (eq? val 'sort-error))
+	(format #t ";sort! call/cc: ~A~%" val))))
+
+(let-temporarily (((*s7* 'safety) 1))
+  (define (f1 x) (let ((y x)) y))
+  (define (_sort_)
+    (sort! #(1 2 3) (lambda (a b) (f1 (= a b)))))
+  (test (_sort_) 'error))
+
+(let ((size 100))
+
+  (define (less a b)
+    (< a b))
+  (define (car-less a b)
+    (< (car a) (car b)))
+  (define (cdr-less a b)
+    (< (cdr a) (cdr b)))
+
+  (define (check-numbers vc)
+    (do ((i 1 (+ i 1))
+	 (x (vc 0))
+	 (y (vc 1)))
+	((or (= i (- size 1))
+	     (and (> x y)
+		  (or (format *stderr* "~A > ~A?~%" x y) #t))))
+      (set! x y)
+      (set! y (vc (+ i 1)))))
+
+  (define (check-chars vc)
+    (do ((i 1 (+ i 1))
+	 (x (vc 0))
+	 (y (vc 1)))
+	((or (= i (- size 1))
+	     (and (char>? x y)
+		  (or (format *stderr* "~A > ~A?~%" x y) #t))))
+      (set! x y)
+      (set! y (vc (+ i 1)))))
+
+  (define (check-strings vc)
+    (do ((i 1 (+ i 1))
+	 (x (vc 0))
+	 (y (vc 1)))
+	((or (= i (- size 1))
+	     (and (string>? x y)
+		  (or (format *stderr* "~A > ~A?~%" x y) #t))))
+      (set! x y)
+      (set! y (vc (+ i 1)))))
+
+  (let ((v (make-vector size)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (vector-set! v i (random 1.0)))
+    (let ((vc (copy v)))
+      (sort! vc <)
+      (check-numbers vc))
+    (let ((vc (copy v)))
+      (sort! vc less)
+      (check-numbers vc))
+    (sort! v (lambda (a b) (< a b)))
+    (check-numbers v))
+
+  (let ((v (make-float-vector size)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (vector-set! v i (random 100.0)))
+    (let ((vc (copy v)))
+      (sort! vc <)
+      (check-numbers vc))
+    (let ((vc (copy v)))
+      (sort! vc less)
+      (check-numbers vc))
+    (sort! v (lambda (a b) (< a b)))
+    (check-numbers v))
+
+  (let ((v (make-int-vector size)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (vector-set! v i (random 10000000)))
+    (let ((vc (copy v)))
+      (sort! vc <)
+      (check-numbers vc))
+    (let ((vc (copy v)))
+      (sort! vc less)
+      (check-numbers vc))
+    (sort! v (lambda (a b) (< a b)))
+    (check-numbers v))
+
+  (let ((v (make-vector size)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (vector-set! v i (string (integer->char (random 256)) (integer->char (random 256)))))
+    (let ((vc (copy v)))
+      (sort! vc string<?)
+      (check-strings vc))
+    (sort! v (lambda (a b) (string<? a b)))
+    (check-strings v)
+
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (vector-set! v i (integer->char (random 256))))
+    (let ((vc (copy v)))
+      (sort! vc char<?)
+      (check-chars vc))
+    (sort! v (lambda (a b) (char<? a b)))
+    (check-chars v)
+
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (vector-set! v i (cons (random 1.0) (random 100000))))
+    (let ((vc (copy v)))
+      (sort! vc (lambda (a b) (< (car a) (car b))))
+      (do ((i 1 (+ i 1))
+	   (x (car (vc 0)))
+	   (y (car (vc 1))))
+	  ((or (= i (- size 1))
+	       (and (> x y)
+		    (or (format *stderr* "~A > ~A?~%" x y) #t))))
+	(set! x y)
+	(set! y (car (vc (+ i 1))))))
+    (let ((vc (copy v)))
+      (sort! vc car-less)
+      (do ((i 1 (+ i 1))
+	   (x (car (vc 0)))
+	   (y (car (vc 1))))
+	  ((or (= i (- size 1))
+	       (and (> x y)
+		    (or (format *stderr* "~A > ~A?~%" x y) #t))))
+	(set! x y)
+	(set! y (car (vc (+ i 1))))))
+    (sort! v (lambda (a b) (< (cdr a) (cdr b))))
+    (do ((i 1 (+ i 1))
+	 (x (cdr (v 0)))
+	 (y (cdr (v 1))))
+	((or (= i (- size 1))
+	     (and (> x y)
+		  (or (format *stderr* "~A > ~A?~%" x y) #t))))
+      (set! x y)
+      (set! y (cdr (v (+ i 1)))))
+    (let ((vc (copy v)))
+      (sort! vc cdr-less)
+      (do ((i 1 (+ i 1))
+	   (x (cdr (v 0)))
+	   (y (cdr (v 1))))
+	  ((or (= i (- size 1))
+	       (and (> x y)
+		    (or (format *stderr* "~A > ~A?~%" x y) #t))))
+	(set! x y)
+	(set! y (cdr (v (+ i 1))))))))
+
+;;; closure_sort coverage:
+(let ()
+  (define (f3 a b) (let ((x (+ a 1)) (y (+ b 1))) (< x y)))
+  (test (sort! '(1 3 2) f3) '(1 2 3)))
+;;; closure_sort_begin
+(let ()
+  (define (f4 a b) (display a #f) (let ((x (+ a 1)) (y (+ b 1))) (< x y)))
+  (test (sort! '(1 3 2) f4) '(1 2 3)))
+;;; opt_begin_bool_sort_b2
+(let ()
+  (define (f5 a b) (display a #f) (< a b))
+  (test (sort! '(1 3 2) f5) '(1 2 3)))
+;;; opt_begin_bool_sort_b
+(let ()
+  (define (f6 a b) (display a #f) (display b #f) (< a b))
+  (test (sort! '(1 3 2) f6) '(1 2 3)))
+;;; opt_begin_bool_sort_p
+(let ()
+  (define (f6 a b) (display a #f) (if (< a b) #t #f))
+  (test (sort! '(1 3 2) f6) '(1 2 3)))
+
+;;; op_closure_fa needs_copied_args bug
+(let ()
+  (define imp (immutable! (cons 0 (immutable! (cons 1 (immutable! (cons 2 ())))))))
+  (define (fop4 x y) (apply x y))
+  (test (let () ((lambda (a) (sort! a >)) (fop4 (lambda (a . b) (cons a b)) imp))) '(2 1 0))
+  (test (let () (define (func) (let () ((lambda (a) (sort! a >)) (fop4 (lambda (a . b) (cons a b)) imp)))) (func) (func)) '(2 1 0))
+  (test (let () ((lambda (a) (sort! a >)) (fop4 (lambda a (copy a)) imp))) '(2 1 0))
+  (test (let () (define (func) (let () ((lambda (a) (sort! a >)) (fop4 (lambda a (copy a)) imp)))) (func) (func)) '(2 1 0))
+  (test (let () ((lambda (a) (sort! a >)) (fop4 (lambda (a b . c) (cons a (cons b c))) imp))) '(2 1 0))
+  (test (let () (define (func) (let () ((lambda (a) (sort! a >)) (fop4 (lambda (a b . c) (cons a (cons b c))) imp)))) (func) (func)) '(2 1 0)))
+
+
+;;; --------------------------------------------------------------------------------
+;;; catch
+
+(define (catch-test sym)
+  (let ((errs ()))
+    (catch 'a1
+	 (lambda ()
+	   (catch 'a2
+		  (lambda ()
+		    (catch 'a3
+			   (lambda ()
+			     (catch 'a4
+				    (lambda ()
+				      (error sym "hit error!"))
+				    (lambda args
+				      (set! errs (cons 'a4 errs))
+				      'a4)))
+			   (lambda args
+			     (set! errs (cons 'a3 errs))
+			     'a3)))
+		  (lambda args
+		    (set! errs (cons 'a2 errs))
+		    'a2)))
+	 (lambda args
+	   (set! errs (cons 'a1 errs))
+	   'a1))
+    errs))
+
+(test (catch-test 'a1) '(a1))
+(test (catch-test 'a2) '(a2))
+(test (catch-test 'a3) '(a3))
+(test (catch-test 'a4) '(a4))
+
+(define (catch-test-1 sym)
+  (let ((errs ()))
+    (catch 'a1
+	 (lambda ()
+	   (catch 'a2
+		  (lambda ()
+		    (catch 'a3
+			   (lambda ()
+			     (catch 'a4
+				    (lambda ()
+				      (error sym "hit error!"))
+				    (lambda args
+				      (set! errs (cons 'a4 errs))
+				      (error 'a3)
+				      'a4)))
+			   (lambda args
+			     (set! errs (cons 'a3 errs))
+			     (error 'a2)
+			     'a3)))
+		  (lambda args
+		    (set! errs (cons 'a2 errs))
+		    (error 'a1)
+		    'a2)))
+	 (lambda args
+	   (set! errs (cons 'a1 errs))
+	   'a1))
+    errs))
+
+(test (catch-test-1 'a1) '(a1))
+(test (catch-test-1 'a2) '(a1 a2))
+(test (catch-test-1 'a3) '(a1 a2 a3))
+(test (catch-test-1 'a4) '(a1 a2 a3 a4))
+(test (procedure? (catch #t make-hook /)) #t)
+(test (catch #t (lambda* (:rest a) a) /) ())
+
+(test (catch #t (catch #t (lambda () (lambda () 1)) (lambda args 'oops)) (lambda args 'error)) 1)
+(test (catch #t (catch #t (lambda () (error 'oops)) (lambda args (lambda () 1))) (lambda args 'error)) 1)
+(test ((catch #t (lambda () (error 'oops)) (lambda args (lambda () 1)))) 1)
+(test ((catch #t (lambda () (error 'oops)) (catch #t (lambda () (lambda args (lambda () 1))) (lambda args 'error)))) 1)
+(test (catch #t (dynamic-wind (lambda () #f) (lambda () (lambda () 1)) (lambda () #f)) (lambda args 'error)) 1)
+(test (dynamic-wind (catch #t (lambda () (lambda () #f)) (lambda args 'error)) (lambda () 1) (lambda () #f)) 1)
+(test (dynamic-wind ((lambda () (lambda () #f))) (lambda () 1) (((lambda () (lambda () (lambda () #t)))))) 1)
+(test (catch #t ((lambda () (lambda () 1))) (lambda b a)) 1)
+(test (map (catch #t (lambda () abs) abs) '(-1 -2 -3)) '(1 2 3))
+(test (catch + (((lambda () lambda)) () 1) +) 1)
+;(test (catch #t + +) 'error) ; changed 12-May-14
+(test (string? (catch + (lambda () (*s7* 'version)) +)) #t)
+(test (string? (apply catch + (lambda () (*s7* 'version)) (list +))) #t)
+(test (catch #t (lambda () (catch '#t (lambda () (error '#t)) (lambda args 1))) (lambda args 2)) 1)
+(test (catch #t (lambda () (catch "hi" (lambda () (error "hi")) (lambda args 1))) (lambda args 2)) 2) ; guile agrees with this
+(test (let ((str (list 1 2))) (catch #t (lambda () (catch str (lambda () (error str)) (lambda args 1))) (lambda args 2))) 1)
+(test (let () (abs (catch #t (lambda () -1) (lambda args 0)))) 1)
+;(test (let ((e #f)) (catch #t (lambda () (+ 1 "asdf")) (lambda args (set! e (owlet)))) (eq? e (owlet))) #t)
+(test (+ (catch 'oops (lambda () (error 'oops)) (lambda args (values 1 2 3)))) 6)
+(test (catch #t (lambda () (error 1 2 3)) (lambda* ((a 2) (b 3) (c 4)) (list a b c))) '(1 (2 3) 4))
+(test (catch #t (lambda () (error 'oops)) require) 'error)
+(test (let ((x (list 1 2))) (catch #t (lambda () (catch x (lambda () (throw x)) (lambda args x))) (lambda () 'oops))) '(1 2))
+(test (let () (define (f) (catch #t (lambda () 1) (lambda (pi pj) #f))) (f)) 'error)
+(test (let () (define (f) (catch #t (lambda () 1) (lambda (pj pi) #f))) (f)) 'error)
+(test (catch #f (lambda () (error #f "oops")) (lambda (type info) type)) #f)
+(test (catch #<unspecified> (lambda () (error #<unspecified> "oops")) (lambda (type info) type)) #<unspecified>)
+(test (catch () (lambda () (error () "oops")) (lambda (type info) type)) ())
+
+(test (catch #t (lambda () (catch #t #(1 2) (lambda (a b) (apply format #f b)))) (lambda (typ info) (apply format #f info)))
+      "catch second argument, #(1 2), is a vector but should be a thunk")
+(test (catch #t (lambda () (catch #t (lambda (x . y) x) (lambda (a b) (apply format #f b)))) (lambda (typ info) (apply format #f info)))
+      "#<lambda (x . y)> requires 1 argument, but catch's second argument should be a thunk")
+
+(let ()
+  (define (f)
+    (let ((val (catch #t (lambda () (throw 'oops)) (lambda args #f)))) (if val (format *stderr* "~A should be #f~%" val)))
+    (let ((val (catch #t (lambda () (throw 'oops)) (lambda args 'a)))) (if (not (eq? val 'a)) (format *stderr* "~A should be 'a~%" val)))
+    (let ((val (catch #t (lambda () (throw 'oops)) (lambda args (car args))))) (if (not (eq? val 'oops)) (format *stderr* "~A should be 'oops~%" val)))
+    (let ((val (catch #t (lambda () (throw 'oops)) (lambda args (+ 1 2))))) (if (not (= val 3)) (format *stderr* "~A should be 3~%" val)))
+    (let ((val (catch #t (lambda () (throw 'oops)) (lambda args args)))) (if (not (equal? val '(oops ()))) (format *stderr* "~A should be '(oops ())~%" val)))
+    (let ((val (catch #t (lambda () (throw 'oops)) (lambda (type info) type)))) (if (not (eq? val 'oops)) (format *stderr* "~A should be 'oops~%" val)))
+    (let ((val (catch #t (lambda () (throw 'oops)) (lambda (type info) info)))) (if (not (null? val)) (format *stderr* "~A should be ()~%" val)))
+    (let ((val (catch #t (lambda () (throw 'oops)) (lambda (type info) #f)))) (if val (format *stderr* "~A should be #f~%" val)))
+
+    (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda args #f)))) (if val (format *stderr* "oops ~A should be #f~%" val)))
+    (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda args 'a)))) (if (not (eq? val 'a)) (format *stderr* "oops ~A should be 'a~%" val)))
+    (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda args (car args))))) (if (not (eq? val 'oops)) (format *stderr* "oops ~A should be 'oops~%" val)))
+    (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda args (+ 1 2))))) (if (not (= val 3)) (format *stderr* "oops ~A should be 3~%" val)))
+    (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda args args)))) (if (not (equal? val '(oops ()))) (format *stderr* "oops ~A should be '(oops ())~%" val)))
+    (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda (type info) type)))) (if (not (eq? val 'oops)) (format *stderr* "oops ~A should be 'oops~%" val)))
+    (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda (type info) info)))) (if (not (null? val)) (format *stderr* "oops ~A should be ()~%" val)))
+    (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda (type info) #f)))) (if val (format *stderr* "oops ~A should be #f~%" val))))
+  (f))
+
+;;; various catch macros from s7.html
+(let ()
+  (define-macro (catch-all . body)
+    `(catch #t (lambda () ,@body) (lambda args args)))
+  (let ((val (catch-all (+ 1 asdf))))
+    (test (car val) 'unbound-variable)
+    (let ((x 32))
+      (test (catch-all (set! x (+ x 1)) (* x 2)) 66)
+      (test (car (catch-all (string=? x "hi"))) 'wrong-type-arg))))
+
+(let ()
+  (define-macro (catch-case clauses . body)
+    (let ((base `(lambda () ,@body)))
+      (for-each (lambda (clause)
+		  (let ((tag (car clause)))
+		    (set! base `(lambda ()
+				  (catch ',(if (eq? tag 'else) #t tag)
+				    ,base
+				    ,@(cdr clause))))))
+		clauses)
+      (caddr base)))
+
+  (test (catch-case ((wrong-type-arg   (lambda args (format #t "got a bad arg~%") -1))
+		     (division-by-zero (lambda args 0))
+		     (else             (lambda args 123)))
+	  (abs -1))
+	1)
+  (test (catch-case ((wrong-type-arg   (lambda args (format #t "got a bad arg~%") -1))
+		     (division-by-zero (lambda args 0))
+		     (else             (lambda args 123)))
+	  (let ((x 0)) (/ 32 x)))
+	0)
+  (test (catch-case ((wrong-type-arg   (lambda args -1))
+		     (division-by-zero (lambda args 0))
+		     (else             (lambda args 123)))
+	  (abs "hi"))
+	-1)
+  (test (catch-case ((wrong-type-arg   (lambda args (format #t "got a bad arg~%") -1))
+		     (division-by-zero (lambda args 0))
+		     (else             (lambda args 123)))
+	  (throw 'oops -1))
+	123))
+
+(let ()
+  (define (catch-if test func err)
+    (catch #t
+      func
+      (lambda args
+	(if (test (car args))
+	    (apply err args)
+	    (apply throw args))))) ; if not caught, re-raise the error
+
+  (test (catch #t
+	  (lambda ()
+	    (catch-if
+	     (lambda (tag)
+	       (eq? tag 'oops))
+	     (lambda ()
+	       (error 'oops 123))
+	     (lambda args
+	       32)))
+	  (lambda args 47))
+	32)
+  (test (catch #t
+	  (lambda ()
+	    (catch-if
+	     (lambda (tag)
+	       (eq? tag 'oops))
+	     (lambda ()
+	       (error 'err 123))
+	     (lambda args
+	       32)))
+	  (lambda args (car args)))
+	'err)
+
+  (define (catch-member lst func err)
+    (catch-if (lambda (tag) (member tag lst)) func err))
+  (test (catch-member '(oops err)
+	  (lambda ()
+	    (error 'oops))
+	  (lambda args 47))
+	47))
+
+(let ()
+  (define-macro (catch* clauses . error)
+    (define (builder lst)
+      (if (null? lst)
+	  (apply values error)
+	  `(catch #t (lambda () ,(car lst)) (lambda args ,(builder (cdr lst))))))
+    (builder clauses))
+  (test (catch* ((+ 1 2) (- 3 4)) 'error) 3)
+  (test (catch* ((+ 1 "hi") (- 3 4)) 'error) -1)
+  (test (catch* ((+ 1 "hi") (- 3 #\a)) 'error) 'error))
+
+
+(multiple-value-bind (err-type err-data)
+  (call-with-exit
+   (lambda (return)
+     (catch #t
+       (lambda () _asdf_)
+       return)))
+  (test err-type 'unbound-variable))
+
+(test (catch #t (lambda () _asdf_) "asdf") 'error)
+(when with-block (test (car (catch #t (lambda () _asdf_) blocks)) 'unbound-variable))
+
+;;; since catch is a function, everything is evaluated:
+(test
+ (catch (#(0 #t 1) 1)
+   ((lambda (a)
+      (lambda ()
+	(+ a "asdf")))
+    1)
+   ((lambda (b)
+      (lambda args
+	(format #f "got: ~A" b)))
+    2))
+ "got: 2")
+
+(let ()
+  (define (hi c)
+    (catch c
+      ((lambda (a)
+	 (lambda ()
+	   (+ a "asdf")))
+       1)
+      ((lambda (b)
+	 (lambda args
+	   (format #f "got: ~A" b)))
+       2)))
+  (test (hi #t) "got: 2"))
+
+(test
+ (catch (#(0 #t 1) 1)
+   (values ((lambda (a)
+	      (lambda ()
+		(+ a "asdf")))
+	    1)
+	   ((lambda (b)
+	      (lambda args
+		(format #f "got: ~A" b)))
+	    2)))
+ "got: 2")
+
+(test (let ((x #t)) (define (f tag) (catch tag (lambda () (/ 1 0)) (lambda (type info) type))) (f x)) 'division-by-zero)
+(test (let ((x (list #t))) (catch (car x) (lambda () (/ 1 0)) (lambda (type info) type))) 'division-by-zero)
+
+(let ((x 0))
+  (catch #t
+	 (lambda ()
+	   (catch #t
+		  (lambda ()
+		    (+ 1 __asdf__))
+		  (lambda args
+		    (set! x (+ x 1))
+		    (+ 1 __asdf__))))
+	 (lambda args
+	   (set! x (+ x 1))))
+  (test x 2))
+
+(test (let ((x 0))
+	(catch 'a
+	     (lambda ()
+	       (catch 'b
+		      (lambda ()
+			(catch 'a
+			       (lambda ()
+				 (error 'a))
+			       (lambda args
+				 (set! x 1))))
+		      (lambda args
+			(set! x 2))))
+	     (lambda args
+	       (set! x 3)))
+	x)
+      1)
+
+(test (+ (catch #t (lambda () (values 3 4)) (lambda args (values 1 2 3)))) 7)
+
+(test (catch) 'error)
+(test (catch #t (lambda () (*s7* 'version))) 'error)
+(test (catch #t (lambda () (*s7* 'version)) + +) 'error)
+(let ()
+  (define* (f1 a) a)
+  (define (f2 . args) args)
+  (define* (f3) 1)
+  (define* (f4 (a 1) (b 2)) a)
+  (test (catch #t (lambda () (*s7* 'version)) f2) (*s7* 'version))
+  (test (catch #t f1 f2) #f)
+  (test (catch #t f3 f2) 1)
+  (test (catch #t f4 f2) 1)
+  (define (f5 a) a)
+  (test (catch #t f5 (lambda args 'local-error)) 'error))
+
+(test (let () (define-macro (m) `(+ 1 2)) (catch #t m (lambda any any)))  3)
+;(test (let () (define-macro (m) `(define __asdf__ 3)) (catch #t m (lambda any "__asdf__ must be a constant?"))) '__asdf__) ;25-Jul-14
+(test (let () (define-macro* (m (a 1) (b 2)) `(define __asdf__ (+ ,a ,b))) (catch #t m (lambda any any)) __asdf__) 3)
+;;; so this is useful where we want to call a macro that defines something in the current environment,
+;;;   but might hit some error that we want to catch.
+(test (let () (define-macro (m . args) `(display ,args)) (catch #t (lambda () #f) m)) #f)
+(test (let () (define-macro (m . args) (apply (car args) (cadr args))) (catch #t (lambda () (error abs -1)) m)) 1)
+(test (let () (define-macro (m . args) `(apply ,(car args) ',(cadr args))) (catch #t (lambda () (error abs -1)) m)) 1)
+
+;;; throw
+(test (catch 'xyzzy (lambda () (throw 'xyzzy 123)) (lambda args args)) '(xyzzy (123)))
+
+(define (catch-test sym)
+  (let ((errs ()))
+    (catch 'a1
+	 (lambda ()
+	   (catch 'a2
+		  (lambda ()
+		    (catch 'a3
+			   (lambda ()
+			     (catch 'a4
+				    (lambda ()
+				      (throw sym "hit error!"))
+				    (lambda args
+				      (set! errs (cons 'a4 errs))
+				      'a4)))
+			   (lambda args
+			     (set! errs (cons 'a3 errs))
+			     'a3)))
+		  (lambda args
+		    (set! errs (cons 'a2 errs))
+		    'a2)))
+	 (lambda args
+	   (set! errs (cons 'a1 errs))
+	   'a1))
+    errs))
+
+(test (catch-test 'a1) '(a1))
+(test (catch-test 'a2) '(a2))
+(test (catch-test 'a3) '(a3))
+(test (catch-test 'a4) '(a4))
+
+(define (catch-test-1 sym)
+  (let ((errs ()))
+    (catch 'a1
+	 (lambda ()
+	   (catch 'a2
+		  (lambda ()
+		    (catch 'a3
+			   (lambda ()
+			     (catch 'a4
+				    (lambda ()
+				      (throw sym "hit error!"))
+				    (lambda args
+				      (set! errs (cons 'a4 errs))
+				      (throw 'a3)
+				      'a4)))
+			   (lambda args
+			     (set! errs (cons 'a3 errs))
+			     (throw 'a2)
+			     'a3)))
+		  (lambda args
+		    (set! errs (cons 'a2 errs))
+		    (throw 'a1)
+		    'a2)))
+	 (lambda args
+	   (set! errs (cons 'a1 errs))
+	   'a1))
+    errs))
+
+(test (catch-test-1 'a1) '(a1))
+(test (catch-test-1 'a2) '(a1 a2))
+(test (catch-test-1 'a3) '(a1 a2 a3))
+(test (catch-test-1 'a4) '(a1 a2 a3 a4))
+
+(test (catch #t (catch #t (lambda () (throw 'oops)) (lambda args (lambda () 1))) (lambda args 'error)) 1)
+(test ((catch #t (lambda () (throw 'oops)) (lambda args (lambda () 1)))) 1)
+(test ((catch #t (lambda () (throw 'oops)) (catch #t (lambda () (lambda args (lambda () 1))) (lambda args 'error)))) 1)
+(test (catch #t (lambda () (catch '#t (lambda () (throw '#t)) (lambda args 1))) (lambda args 2)) 1)
+(test (catch #t (lambda () (catch "hi" (lambda () (throw "hi")) (lambda args 1))) (lambda args 2)) 2) ; guile agrees with this
+(test (let ((str (list 1 2))) (catch #t (lambda () (catch str (lambda () (throw str)) (lambda args 1))) (lambda args 2))) 1)
+
+(test (throw) 'error)
+(test (catch #f (lambda () (throw #f 1 2 3)) (lambda args (cadr args))) '(1 2 3))
+
+(for-each
+ (lambda (arg)
+   (catch #t
+     (lambda ()
+       (test (catch arg
+	       (lambda ()
+		 (throw arg 1 2 3))
+	       (lambda args (cadr args)))
+	     '(1 2 3)))
+     (lambda args
+       (format #t "~A not caught~%" (car args)))))
+ (list #\a 'a-symbol #f #t abs #<unspecified>))
+
+#|
+(test (let ((e #f))
+	(catch #t
+	  (lambda ()
+	    (catch #t
+	      (lambda () (+ 1 "asdf"))
+	      (lambda args (set! e (let->list (owlet))))))
+	  (lambda args #f))
+        (equal? (caddr e) '(error-file . "s7test.scm"))) ; depends on various compile-time options
+      #t)
+
+(let ((e 1))
+  (catch #t
+    (lambda ()
+      (catch #t
+	(lambda ()
+	  (error 'an-error "an-error"))
+	(lambda args
+	  (set! e (let->list (owlet)))))
+      (throw #t "not an error"))
+    (lambda args
+      #f))
+  (test (caddr e) '(error-file . "s7test.scm")))
+|#
+
+(let ()
+  (define (t1 x)
+    (catch #t
+      (lambda ()
+	(throw x))
+      (lambda args (car args))))
+  (define (tt)
+    (do ((i 0 (+ i 1)))
+	((= i 100) i)
+      (t1 'a)))
+  (test (tt) 100))
+
+(test (let ((x #f) (i 0)) (catch #t (lambda () (+ 1 #\a)) (lambda (+t+ +i+) (car)))) 'error)
+(test (let () (define (f) (let ((x #f) (i 0)) (catch #t (lambda () (+ 1 #\a)) (lambda (+t+ +i+) (car ))))) (f)) 'error)
+
+(let ()
+  (define g
+    (let ((tag (vector 'tag)))
+      (lambda ()
+	(catch tag
+	  (lambda ()
+	    (error tag "error: ~S" tag))
+	  (lambda (type info)
+	    (format #f "~S ~A" tag (apply format #f info)))))))
+  (test (string=? (g) "#(tag) error: #(tag)") #t))
+
+
+;;; --------------------------------------------------------------------------------
+;;; error
+
+(test (catch #t (lambda () (error 'oops 1)) (let () (lambda args (caadr args)))) 1)
+(test (catch #t (lambda () (error 'oops 1)) (let ((x 3)) (lambda args (+ x (caadr args))))) 4)
+(test (catch #t (let () (lambda () (error 'oops 1))) (let ((x 3)) (lambda args (+ x (caadr args))))) 4)
+(test (catch #t (let ((x 2)) (lambda () (error 'oops x))) (let ((x 3)) (lambda args (+ x (caadr args))))) 5)
+(test (catch #t (let ((x 2)) ((lambda () (lambda () (error 'oops x))))) (let ((x 3)) (lambda args (+ x (caadr args))))) 5)
+(test (catch #t (lambda () (error 1)) (lambda args #f)) #f)
+
+(test (let ((pws (dilambda (lambda () (+ 1 2)) (lambda (a) (+ a 2)))))
+	(catch #t pws (lambda (tag type) tag)))
+      3)
+(test (let ((pws (dilambda (lambda () (error 'pws 3) 4) (lambda (a) (+ a 2)))))
+	(catch #t pws (lambda (tag type) tag)))
+      'pws)
+(test (let ((pws (dilambda (lambda (a b) a) (lambda (a b c) (+ a 2)))))
+	(catch #t (lambda () (error 'pws-error 3)) pws))
+      'pws-error)
+
+(for-each
+ (lambda (tag)
+   (let ((val (catch tag (lambda () (error tag "an error") 123) (lambda args (car args)))))
+     (if (not (equal? tag val))
+	 (format #t ";catch ~A -> ~A~%" tag val))))
+ (list :hi () #() #<eof> #f #t #<unspecified> car #\a 32 9/2))
+
+(for-each
+ (lambda (tag)
+   (let ((val (catch #t (lambda () (error tag "an error") 123) (lambda args (car args)))))
+     (if (not (equal? tag val))
+	 (format #t ";catch #t (~A) -> ~A~%" tag val))))
+ (list :hi () #<eof> #f #t #<unspecified> car #\a 32 9/2 '(1 2 3) '(1 . 2) #(1 2 3) #()))
+
+(for-each
+ (lambda (tag)
+   (test (catch #t tag (lambda args 'local-error)) 'error)
+   (test (catch #t (lambda () #f) tag) 'error))
+ (list :hi () #<eof> #f #t #<unspecified> #\a 32 9/2)) ;'(1 2 3) '(1 . 2) #(1 2 3) #()
+
+;; (error <string>...) throws 'no-catch which makes it harder to check
+(let ((val (catch #t (lambda () (error "hi") 123) (lambda args (car args)))))
+  (if (not (eq? val 'no-catch))
+      (format #t ";catch #t, tag is string -> ~A~%" val)))
+
+(for-each
+ (lambda (tag)
+   (let ((val (catch tag (lambda () (error #t "an error") 123) (lambda args (car args)))))
+     (if (not (equal? #t val))
+	 (format #t ";catch ~A -> ~A (#t)~%" tag val))))
+ (list :hi () #<eof> #f #t #<unspecified> car #\a 32 9/2))
+
+(let ((tag 'tag)) (test (catch (let () 'tag) (lambda () (set! tag 123) (error 'tag "tag") tag) (lambda args (car args))) 'tag))
+
+(let ()
+  (define (check-reerror x)
+    (catch #t
+      (lambda ()
+	(define (our-func x)
+	  (case x
+	    ((0) (error 'zero))
+	    ((1) (error 'one))
+	    (else (error 'else))))
+	(catch #t
+  	  (lambda ()
+	    (our-func x))
+	  (lambda args
+	    (if (eq? (car args) 'one)
+		(our-func (+ x 1))
+		(apply error args)))))
+      (lambda args
+	(let ((type (car args)))
+	  (case type
+	    ((zero) 0)
+	    ((one) 1)
+	    (else 2))))))
+  (test (check-reerror 0) 0)
+  (test (check-reerror 1) 2)
+  (test (check-reerror 2) 2))
+
+(test (catch 'hiho
+	     (lambda ()
+	       (define (f1 a)
+		 (error 'hiho a))
+	       (* 2 (catch 'hiho
+			   (lambda ()
+			     (f1 3))
+			   (lambda args (caadr args)))))
+	     (lambda args (caadr args)))
+      6)
+
+(test (let ()
+	(define (f1 a)
+	  (error 'hiho a))
+	(catch 'hiho
+	       (lambda ()
+		 (* 2 (catch 'hiho
+			     (lambda ()
+			       (f1 3))
+			     (lambda args (caadr args)))))
+	       (lambda args (caadr args))))
+      6)
+
+(test (catch 'hiho
+	     (lambda ()
+	       (let ((f1 (catch 'hiho
+				(lambda ()
+				  (lambda (a) (error 'hiho 3)))
+				(lambda args args))))
+		 (f1 3)))
+	     (lambda args (caadr args)))
+      3)
+
+
+(test (error) 'error)
+(test (let ((x 1))
+	(let ((val (catch #\a
+			  (lambda ()
+			    (set! x 0)
+			    (error #\a "an error")
+			    (set! x 2))
+			  (lambda args
+			    (if (equal? (car args) #\a)
+				(set! x (+ x 3)))
+			    x))))
+	  (= x val 3)))
+      #t)
+(test (let ((x 1))
+	(let ((val (catch 32
+			   (lambda ()
+			     (catch #\a
+				    (lambda ()
+				      (set! x 0)
+				      (error #\a "an error: ~A" (error 32 "another error!"))
+				      (set! x 2))
+				    (lambda args
+				      (if (equal? (car args) #\a)
+					  (set! x (+ x 3)))
+				      x)))
+			   (lambda args
+			     (if (equal? (car args) 32)
+				 (set! x (+ x 30)))))))
+	  (= x val 30)))
+      #t)
+
+(test (list (catch #t (lambda () (call-with-exit (lambda (goto) (values 1 2 3)))) (lambda args 'err))) '(1 2 3))
+(test (let () (define (func) (list (catch #t (lambda () (call-with-exit (lambda (goto) (values 1 2 3)))) (lambda args 'err))) '(1 2 3)) (define (hi) (func)) (hi)) '(1 2 3))
+(test (list (catch #t (lambda () (call-with-exit (lambda (goto) (goto 1 2 3)))) (lambda args 'err))) '(1 2 3))
+(test (let () (define (func) (list (catch #t (lambda () (call-with-exit (lambda (goto) (goto 1 2 3)))) (lambda args 'err))) '(1 2 3)) (define (hi) (func)) (hi)) '(1 2 3))
+
+(when (provided? 'history)
+  (test (catch #t (lambda () (apply when '(asdf () #f))) (lambda (t i) (apply format #f i))) "unbound variable asdf in (#_when asdf () #f)")
+  (test (catch #t (lambda () (when asdf () #f)) (lambda (t i) (apply format #f i))) "unbound variable asdf in (when asdf () #f)")
+  (test (catch #t (lambda () (apply with-let '(asdf () #f))) (lambda (t i) (apply format #f i))) "unbound variable asdf in (#_with-let asdf () #f)")
+  (test (catch #t (lambda () (with-let asdf () #f)) (lambda (t i) (apply format #f i))) "unbound variable asdf in (with-let asdf () #f)")
+  (test (catch #t (lambda () (apply and '(asdf () #f))) (lambda (t i) (apply format #f i))) "unbound variable asdf in (#_and asdf () #f)")
+  (test (catch #t (lambda () (and asdf () #f)) (lambda (t i) (apply format #f i))) "unbound variable asdf in (and asdf () #f)")
+  (test (catch #t (lambda () (apply if '(asdf () #f))) (lambda (t i) (apply format #f i))) "unbound variable asdf in (#_if asdf () #f)")
+  (test (catch #t (lambda () (if asdf () #f)) (lambda (t i) (apply format #f i))) "unbound variable asdf in (if asdf () #f)")
+  (test (catch #t (lambda () (apply or '(asdf () #f))) (lambda (t i) (apply format #f i))) "unbound variable asdf in (#_or asdf () #f)")
+  (test (catch #t (lambda () (or asdf () #f)) (lambda (t i) (apply format #f i))) "unbound variable asdf in (or asdf () #f)"))
+
+
+;;; --------------------------------------------------------------------------------
+
+(define (last-pair l) ; needed also by loop below
+  (if (pair? (cdr l))
+      (last-pair (cdr l)) l))
+
+(let ()
+  ;; from guile-user I think
+  ;; (block LABEL FORMS...)
+  ;;
+  ;; Execute FORMS.  Within FORMS, a lexical binding named LABEL is
+  ;; visible that contains an escape function for the block.  Calling
+  ;; the function in LABEL with a single argument will immediatly stop
+  ;; the execution of FORMS and return the argument as the value of the
+  ;; block.  If the function in LABEL is not invoked, the value of the
+  ;; block is the value of the last form in FORMS.
+
+  (define-macro (block label . forms)
+    `(let ((body (lambda (,label) ,@forms))
+	   (tag (gensym "return-")))
+       (catch tag
+	      (lambda () (body (lambda (val) (throw tag val))))
+	      (lambda (tag val) val))))
+
+  ;; (with-return FORMS...)
+  ;;
+  ;; Equivalent to (block return FORMS...)
+
+  (define-macro (with-return . forms)
+    `(block return ,@forms))
+
+  ;; (tagbody TAGS-AND-FORMS...)
+  ;;
+  ;; TAGS-AND-FORMS is a list of either tags or forms.  A TAG is a
+  ;; symbol while a FORM is everything else.  Normally, the FORMS are
+  ;; executed sequentially.  However, control can be transferred to the
+  ;; forms following a TAG by invoking the tag as a function.  That is,
+  ;; within the FORMS, there is a lexical binding for each TAG with the
+  ;; symbol that is the tag as its name.  The bindings carry functions
+  ;; that will execute the FORMS following the respective TAG.
+  ;;
+  ;; The value of a tagbody is always `#f'.
+
+  (define (transform-tagbody forms)
+    (let ((start-tag (gensym "start-"))
+	  (block-tag (gensym "block-")))
+      (let loop ((cur-tag start-tag)
+		 (cur-code ())
+		 (tags-and-code ())
+		 (forms forms))
+	(cond
+	 ((null? forms)
+	  `(block ,block-tag
+		  (letrec ,(reverse! (cons (list cur-tag `(lambda () ,@(reverse! (cons `(,block-tag #f) cur-code)))) tags-and-code))
+		    (,start-tag))))
+	 ((symbol? (car forms))
+	  (loop (car forms)
+		'()
+		(cons (list cur-tag `(lambda () ,@(reverse! (cons `(,(car forms)) cur-code)))) tags-and-code)
+		(cdr forms)))
+	 (else
+	  (loop cur-tag
+		(cons (car forms) cur-code)
+		tags-and-code
+		(cdr forms)))))))
+
+  (define-macro (tagbody . forms)
+    (transform-tagbody forms))
+
+  (define (first_even l)
+    (with-return
+     (tagbody
+      continue
+      (if (not (not (null? l)))
+	  (break))
+      (let ((e (car l)))
+	(if (not (number? e))
+	    (break))
+	(if (even? e)
+	    (return e))
+	(set! l (cdr l)))
+      (continue)
+      break)
+     (return #f)))
+
+  (let ((val (first_even '(1 3 5 6 7 8 9))))
+    (if (not (equal? val (list 6)))
+	(format #t "first_even (tagbody, gensym, reverse!) (6): '~A~%" val)))
+  )
+
+#|
+so prog is something like (define-macro (prog vars . body) `(with-return (tagbody (let ,vars ,@body))))
+or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (tagbody (let ,vars ,@body)))))
+|#
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; define*
+;;; lambda*
+
+(let ((hi (lambda* (a) a)))
+  (test (hi 1) 1)
+  (test (hi) #f)          ; all args are optional
+  (test (hi :a 32) 32)    ; all args are keywords
+  (test (hi a: 32) 32)    ;   either style
+  (test (hi 1 2) 'error)  ; extra args
+
+  (for-each
+   (lambda (arg)
+     (test (hi arg) arg)
+     (test (hi :a arg) arg)
+     (test (hi a: arg) arg))
+   (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi abs #(()) (list 1 2 3) '(1 . 2)))
+
+  (test (hi :b 1) 'error))
+
+(let ()
+  (define* (f0) #f)
+  (test (f0) #f)
+  (test (f0 :a) 'error))
+
+(let ()
+  (define* (f00 a :allow-other-keys) a)
+  (test (f00) #f)
+  (test (f00 :a) 'error) ; key needs value
+  (test (f00 :a 1) 1)
+  (test (let ((x 0)) (f00 :b (set! x 1)) x) 1)
+  (test (f00 :a 1 :b :c :d 2) 1))
+
+(let ()
+  (define* (f000 :rest a) a) ; rest argname is not a keyword argname
+  (test (f000 :a) '(:a))
+  (test (f000 :a 1) 'error)
+  (test (f000 1) '(1))
+  (test (f000 1 :a 2) '(1 :a 2))) ; ?? error would be better?
+
+(test (let () (define* (f a :rest b) (list a b)) (f :a 1 :b 3))'error)
+(test (let () (define* (f a . b) (list a b)) (f :a 1 :b 3)) 'error)
+
+(let ()
+  (define* (f1 (a 0)) a)
+  ;;; (define (f2 x) (f1 x))
+  (test (f1) 0)
+  (test (f1 :a) 'error)
+  (test (f1 :a 1) 1)
+  (test (f1 :a :b) :b)
+  (test (f1 :a :a) :a)
+  (test (f1 :b) 'error)
+  (test (f1 :a 0 :a) 'error)
+  (test (f1 :a 0 :a 1) 'error)
+  (test (f1 0) 0)
+  (test (f1 0 :a) 'error)
+  (test (f1 0 :a 1) 'error)
+  (test (f1 'a) 'a)
+  (test (f1 ':a) 'error)
+  (test (f1 '':a) '':a)
+  (test (f1 ':a 0) 0)
+  (test (f1 a: 0) 0)
+  (let ((x :a))
+    (test (f1 x 0) 0)
+    (test (f1 x) 'error)
+    (test (apply f1 (list x 0)) 0)
+    (test (apply f1 '(x)) 'x)
+    (test (apply f1 '(:a)) 'error))
+  (let ((x :b))
+    (test (f1 x) 'error))
+  (let ((mk (lambda () :a)))
+    (test (f1 (mk)) 'error)
+    (test (f1 (mk) 0) 0)
+    (test (f1 (mk) (mk)) (mk)) ;!
+    (test (apply f1 (list (mk) 0)) 0)))
+
+(let ()
+  (define z 1)
+  (define* (f1* (x (log 32 2)) (y z)) (+ x y))
+  (test (f1*) 6)
+  (let ((a 1)) (test (f1* (+ a 1)) 3))
+  (let ((a 1)) (test (f1* :x (+ a 1)) 3))
+  (let ((a 1)) (test (f1* :y (+ a 1)) 7))
+  (let ((a 1)) (test (f1* (+ a 1) (- a 1)) 2))
+  (let ((a 1)) (test (f1* :x (+ a 1) :y (- a 1)) 2))
+
+  (define (g a z) (+ (f1*) (f1* (+ a 1)) (f1* :x (+ a 1)) (f1* :y (+ a 1)) (f1* (+ a 1) (- a 1)) (f1* :x (+ a 1) :y (- a 1))))
+  (test (g 1 2) 23)
+  (test (g 1 2) 23)
+
+  (define* (f2* (x (values 2)) (y (values))) (list-values x y))
+  (test (f2*) '(2))
+  (test (f2* :y 3) '(2 3))
+  (test (f2* :x 3) '(3))
+  (test (f2* (+ z 1) 3) '(2 3)))
+
+(let ()
+  (define* (f1u (a 0)) (car (member a (list a) (lambda (a b) a))))
+  ;;; (define (f2 x) (f1u x))
+  (test (f1u) 0)
+  (test (f1u :a) 'error)
+  (test (f1u :a 1) 1)
+  (test (f1u :a :b) :b)
+  (test (f1u :a :a) :a)
+  (test (f1u :b) 'error)
+  (test (f1u :a 0 :a) 'error)
+  (test (f1u :a 0 :a 1) 'error)
+  (test (f1u 0) 0)
+  (test (f1u 0 :a) 'error)
+  (test (f1u 0 :a 1) 'error)
+  (test (f1u 'a) 'a)
+  (test (f1u ':a) 'error)
+  (test (f1u '':a) '':a)
+  (test (f1u ':a 0) 0)
+  (test (f1u a: 0) 0)
+  (let ((x :a))
+    (test (f1u x 0) 0)
+    (test (f1u x) 'error)
+    (test (apply f1u (list x 0)) 0)
+    (test (apply f1u '(x)) 'x)
+    (test (apply f1u '(:a)) 'error))
+  (let ((x :b))
+    (test (f1u x) 'error))
+  (let ((mk (lambda () :a)))
+    (test (f1u (mk)) 'error)
+    (test (f1u (mk) 0) 0)
+    (test (f1u (mk) (mk)) (mk)) ;!
+    (test (apply f1u (list (mk) 0)) 0)))
+
+(let ((x 1))
+  (define fx (lambda* ((a (+ x 1)) (b (let ((y (+ x 1))) (+ y 1)))) (list a b)))
+  (define* (fy (a (* x 2)) (b (fx :a 1 :b 2))) (list a b))
+  (test (fx) '(2 3))
+  (test (fy) '(2 (1 2)))
+  (test (fy :a 0) '(0 (1 2))))
+
+(let ()
+  (define* (f a (b :c)) b)
+  (test (f :b 1 :d) 'error))
+
+(let ()
+  (define* (f1a (a :a)) a)
+  (test (f1a) :a))
+
+(test ((lambda* ((a (quote . -1))) quote)) 'error)
+(test ((lambda* ((a (quote 1 1))) a)) 'error)
+(test ((lambda* ((a (quote))) a)) 'error)
+(test ((lambda* ((e #<undefined>)) 1)) 1)
+(test ((lambda* ((d 1) (e #<undefined>)) 1)) 1)
+
+(let ()
+  (define* (f2 (a 0) (b 1)) (list a b))
+  (test (f2 :a) 'error)
+  (test (f2 :a 1 :b) 'error)
+  (test (f2 :a 1 :b 1 :c) 'error)
+  (test (f2 (car '(:a)) 2) '(2 1))
+  (test (f2 :b 2) '(0 2))
+  (test (f2 :a 2) '(2 1))
+  (test (f2 :a 1 :b 2) '(1 2))
+  (test (let ((x :a)) (f2 x 2)) '(2 1))
+  (test (let ((x :a)) (f2 x x)) '(:a 1)) ; (f2 :a :a) so a=:a b=1
+  (test (let ((x -1) (y :a)) (f2 y x)) '(-1 1))
+  (test (let ((x 3) (y :b)) (f2 y x)) '(0 3))
+  (test (let ((x 3) (y :c)) (f2 y x)) 'error)
+  (test (let ((x 3) (y :c)) (f2 x y)) 'error))
+
+(let ()
+  (define* (f3 (a :a) (b :a)) (list a b))
+  (test (f3 :a) 'error)
+  (test (f3) '(:a :a))
+  (test (f3 :b 1) '(:a 1))) ; default value is a value not a keyword-as-parameter-indicator
+
+(let ((hi (lambda* ((a 1)) a)))
+  (test (hi 2) 2)
+  (test (hi) 1)
+  (test (hi :a 2) 2)
+
+  (for-each
+   (lambda (arg)
+     (test (hi arg) arg)
+     (test (hi :a arg) arg))
+   (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi abs #(()) (list 1 2 3) '(1 . 2))))
+
+(let ((hi (lambda* (a (b "hi")) (list a b))))
+  (test (hi) (list #f "hi"))
+  (test (hi 1) (list 1 "hi"))
+  (test (hi 1 2) (list 1 2))
+  (test (hi :b 1) (list #f 1))
+  (test (hi :a 1) (list 1 "hi"))
+  (test (hi 1 :b 2) (list 1 2))
+  (test (hi :b 3 :a 1) (list 1 3))
+  (test (hi :a 3 :b 1) (list 3 1))
+  (test (hi 1 :a 3) 'error)
+  (test (hi 1 2 :a 3) 'error) ; trailing (extra) args
+  (test (hi :a 2 :c 1) 'error)
+  (test (hi 1 :c 2) 'error)
+
+  (for-each
+   (lambda (arg)
+     (test (hi :a 1 :b arg) (list 1 arg))
+     (test (hi :a arg) (list arg "hi"))
+     (test (hi :b arg) (list #f arg))
+     (test (hi arg arg) (list arg arg)))
+   (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi abs #(()) (list 1 2 3) '(1 . 2))))
+
+(let ()
+  (define* (f1 (allow-other-keys 32) (rest 4)) (+ rest allow-other-keys))
+  (test (f1) 36)
+  (test (f1 :rest 3) 35)
+  (test (f1 :allow-other-keys 3) 7)
+  (test (f1 :allow-other-keys 3 :rest 3) 6)
+  (define* (f2 readable) (+ readable 1))
+  (test (f2 :readable 2) 3))
+
+(let ((x :allow-other-keys)) (define (func) (blocks5 (values x))) (test (func) 'error)) ; no arg for key
+(let () (define* (f allow-other-keys) (+ allow-other-keys 1))
+  (test (f 2) 3)
+  (test (f :allow-other-keys 2) 3))
+(test (let () (define* (f :allow-other-keys :allow-other-keys) 32)) 'error)
+(let () (define* (f allow-other-keys :allow-other-keys) (+ allow-other-keys 2))
+  (test (f 2) 4)
+  (test (f 3 :a 1) 5)
+  (test (f 3 :allow-other-keys 32) 'error)) ; par set twice
+
+(let () ; wrapper sharing keyword arg with wrappee
+  (define* (f1 a) a)
+  (define* (f2 a :rest b :allow-other-keys)
+    (+ a (apply f1 b)))
+  (test (f2 :a 3 :a 4) 7)  ; b='(:a 4)
+  (let ((c :a))
+    (test (f2 c 3 c 4) 7)))
+
+(let ((hi (lambda* (a (b 3) c) (list a b c))))
+  (test (hi) (list #f 3 #f))
+  (test (hi 1) (list 1 3 #f))
+  (test (hi :c 32) (list #f 3 32))
+  (test (hi :c 32 :b 43 :a 54) (list 54 43 32))
+  (test (hi 1 2 3) (list 1 2 3))
+  (test (hi :b 32) (list #f 32 #f))
+  (test (hi 1 2 :c 32) (list 1 2 32)))
+
+(let ((hi (lambda* (a :rest b) (list a b))))
+  (test (hi 1 2 3) (list 1 (list 2 3)))
+  (test (hi) (list #f ()))
+  (test (hi :a 2) (list 2 ()))
+  (test (hi :b 3) 'error))
+
+(let ((hi (lambda* (a :rest b :rest c) (list a b c))))
+  (test (hi 1 2 3 4 5) (list 1 (list 2 3 4 5) (list 3 4 5))))
+
+(let ((hi (lambda* ((a 3) (b #t) (c pi) :rest d) (list a b c d))))
+  (test (hi) (list 3 #t pi ()))
+  (test (hi 1 2 3 4) (list 1 2 3 (list 4))))
+
+(let ((hi (lambda* ((a 'hi)) (equal? a 'hi))))
+  (test (hi) #t)
+  (test (hi 1) #f)
+  (test (hi 'hi) #t)
+  (test (hi :a 1) #f))
+
+(let* ((x 32)
+       (hi (lambda* (a (b x)) (list a b))))
+  (test (hi) (list #f 32))
+  (test (hi :a 1) (list 1 32)))
+
+(let ((hi (lambda* (a . b) (list a b))))
+  (test (hi 1 2 3) (list 1 (list 2 3)))
+  (test (hi) (list #f ()))
+  (test (hi :a 2) (list 2 ()))
+  (test (hi :b 3) 'error))
+
+(let ((hi (lambda* ((a 0.0) (b 0.0)) (+ a b))))
+  (num-test (hi 1.0) 1.0)
+  (num-test (hi 1.0 2.0) 3.0)
+  (num-test (hi) 0.0)
+  (num-test (+ (hi) (hi 1.0) (hi 1.0 2.0)) 4.0)
+  (num-test (+ (hi 1.0) (hi) (hi 1.0 2.0)) 4.0)
+  (num-test (+ (hi 1.0) (hi 1.0 2.0) (hi)) 4.0)
+  (num-test (+ (hi 1.0 2.0) (hi) (hi 1.0)) 4.0))
+
+(test (let ((hi (lambda*))) (hi)) 'error)
+(test (let ((hi (lambda* #f))) (hi)) 'error)
+(test (let ((hi (lambda* "hi" #f))) (hi)) 'error)
+(test (let ((hi (lambda* ("hi") #f))) (hi)) 'error)
+(test (let ((hi (lambda* (a 0.0) a))) (hi)) 'error)
+(test (let ((hi (lambda* (a . 0.0) a))) (hi)) 'error)
+(test (let ((hi (lambda* ((a . 0.0)) a))) (hi)) 'error)
+(test (let ((hi (lambda* ((a 0.0 "hi")) a))) (hi)) 'error)
+(test (let ((hi (lambda* ((a 0.0 . "hi")) a))) (hi)) 'error)
+(test (let ((hi (lambda* ((a)) a))) (hi)) 'error)
+(test (let ((hi (lambda* (a 0.0) (b 0.0) (+ a b)))) (hi)) 'error)
+(test (lambda (:key) 1) 'error)
+(test (let () (define hi (let ((x 1)) (lambda* ((y x)) y))) (hi)) 1)
+(test (let () (define hi (let ((x 1)) (lambda* ((y x)) y))) (let ((x 2)) (hi))) 1)
+(test ((lambda* (:key) 1)) 'error)
+(test (let ((akey :a) (bkey :b)) ((lambda* (a b) (list a b)) akey 32)) '(32 #f))
+(test (let ((akey :a) (bkey :b)) ((lambda* (a b) (list a b)) bkey 12 akey 43)) '(43 12))
+(test (let ((x 0)) (for-each (lambda* (a) (set! x (+ x a))) (list :a :a :a) (list 1 2 3)) x) 'error)
+
+(test (let () (define* (hi) 0) (hi)) 0)
+(test (let () (define* (hi) 0) (hi 1)) 'error)
+(test (let () (define* (hi a . b) b) (hi 1 2 3)) '(2 3))
+(test (let () (define* (hi a . b) b) (hi :a 1 2 3)) '(2 3))
+(test (let () (define* (hi a . b) b) (hi 1)) ())
+(test (let () (define* (hi a . b) b) (hi :a 1)) ())
+(test (let () (define* (hi a . b) b) (hi)) ())
+(test (let () (define* (hi a . a) a) (hi)) 'error)
+(test (let () (define* (hi (a 1) . a) a) (hi)) 'error)
+(test (let () (define* (hi (a 1) . b) b) (hi 2 3 4)) '(3 4))
+
+(test (let () (define* (hi a :rest b) b) (hi 1 2 3)) '(2 3))
+(test (let () (define* (hi a :rest b) b) (hi :a 1 2 3)) '(2 3))
+(test (let () (define* (hi a :rest b) b) (hi 1)) ())
+(test (let () (define* (hi a :rest b) b) (hi :a 1)) ())
+(test (let () (define* (hi a :rest b) b) (hi)) ())
+(test ((lambda* (a :rest b :rest c) (list a b c)) 1 2 3 4) '(1 (2 3 4) (3 4)))
+
+(test (let () (define* (hi (a 1) . b) b) (hi 1 2 3)) '(2 3))
+(test (let () (define* (hi a (b 22) . c) (list a b c)) (hi)) '(#f 22 ()))
+(test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :a 1)) '(1 22 ()))
+(test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :b 1)) '(#f 1 ()))
+(test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :c 1)) 'error) ; was '(#f 22 1))
+(test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :a 1 2)) '(1 2 ()))
+(test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :b 1 2 3)) 'error) ; b set twice
+(test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :c 1 2 3)) 'error) ; was '(#f 2 (3)))
+(test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :b 1 :a 2 3)) '(2 1 (3)))
+
+(test (let ((ksym :b)) ((lambda* (a b) (list a b)) ksym 2)) (list #f 2))
+(test (let ((ksym :b)) ((lambda* (a b) (list a b)) 1 ksym)) 'error)
+(test (let ((ksym (lambda () :b))) ((lambda* (a b) (list a b)) (ksym) 2)) (list #f 2))
+(test (let ((ksym :b)) ((lambda* (a b c) (list a b c)) 1 ksym 2)) (list 1 2 #f))
+(test (let ((ksym :b)) (define* (hi a b (c 3)) (list a b c)) (hi 1 ksym 2)) (list 1 2 3))
+(test (let ((ksym :b)) (define* (hi a b (c 5) d) (list a b c d)) (hi ksym 3 :d 4)) (list #f 3 5 4))
+
+(let ()
+  (define* (f a (b (error 'unset-arg "f's b parameter not set")))
+    (list a b))
+  (test (f 1 2) (list 1 2))
+  (test (f 1) 'error))
+
+(test (let () (define* (hi (a 1) :allow-other-keys) a) (hi)) 1)
+(test (let () (define* (hi (a 1) :allow-other-keys) a) (hi :b :a :a 3)) 3)
+(test (let () (define* (hi (a 1) :allow-other-keys) a) (hi :b 3)) 1)
+(test (let () (define* (hi (a 1) :allow-other-keys) a) (hi :a 3)) 3)
+(test (let () (define* (hi (a 1) :allow-other-keys) a) (hi a: 3)) 3)
+(test (let () (define* (hi (a 1) :allow-other-keys) a) (hi 3)) 3)
+(test (let () (define* (hi (a 1) :allow-other-keys) a) (hi 3 :b 2)) 3)
+(test (let () (define* (hi (a 1) :allow-other-keys) a) (hi :c 1 :a 3 :b 2)) 3)
+(test (let () (define* (hi :rest a :allow-other-keys) a) (hi :c 1 :a 3 :b 2)) '(:c 1 :a 3 :b 2))
+(test ((lambda* (a :allow-other-keys) a) 1 :a 2) 'error)
+(test ((lambda* (a :allow-other-keys) a) 1 :b 2) 1)
+
+(test (let () (define* (hi (a 1) (b 2) :allow-other-keys :allow-other-keys) a)) 'error)
+(test (let () (define* (hi (a 1) :allow-other-keys) a) (hi :a 2 32)) 'error)
+(test (let () (define* (hi (a 1) :allow-other-keys) a) (hi 2 32)) 'error)
+
+(test (let () (define* (hi (a 1) :rest c :allow-other-keys) (list a c)) (hi :a 3 :b 2)) '(3 (:b 2)))
+(test (let () (define* (hi (a 1) :rest c) (list a c)) (hi :a 3 :b 2)) '(3 (:b 2)))
+
+(test (let () (define* (hi (a 1) (b 2) :allow-other-keys) (list a b)) (hi :c 21 :b 2)) '(1 2))
+(test (let () (define hi (lambda* ((a 1) (b 2) :allow-other-keys) (list a b))) (hi :c 21 :b 2)) '(1 2))
+(test (let () (define-macro* (hi (a 1) (b 2) :allow-other-keys) `(list ,a ,b)) (hi :c 21 :b 2)) '(1 2))
+
+(test (let () (define* (f1 :allow-other-keys) 123) (f1 :a 1 :b 2)) 'error)
+(test (let ((f1 (lambda* (:allow-other-keys) 123))) (f1 :a 1 :b 2)) 'error)
+(let ()
+  (define* (f1 a :allow-other-keys) :allow-other-keys)
+  (test (keyword? (f1 3)) #t)
+  (test (eq? (f1) ':allow-other-keys) #t)
+  (test (keyword? :allow-other-keys) #t))
+(test (keyword? :allow-other-keys) #t)
+(test (eq? :allow-other-keys ':allow-other-keys) #t)
+(test (keyword? :rest) #t)
+(test (eq? :rest ':rest) #t)
+
+(test (let () (define* (f (a :b)) a) (list (f) (f 1) (f :a :c) (f :a 1) (f))) '(:b 1 :c 1 :b))
+(test (let () (define* (f a (b :c)) b) (f :b 1 :d)) 'error)
+(test ((lambda* (:rest (b 1)) b)) 'error) ; "lambda* :rest parameter can't have a default value." ?
+(test ((lambda* ((a 1) (b 2)) ((lambda* ((c (+ a (* b 3)))) c)))) 7)
+(test ((lambda* ((a 1) (b 2)) ((lambda* ((c (+ a (* b 3)))) c))) :b 3) 10)
+(test (let ((a 123)) ((lambda* ((a 1) (b 2)) ((lambda* ((c (+ a (* b 3)))) c))) :b a)) 370)
+(test (let ((a 123)) ((lambda* ((a 1) (b 2)) ((lambda* ((c (+ a (let ((a -2)) (* b a))))) c))))) -3)
+(test (let ((a 123)) ((lambda* ((a 1) (b 2)) ((lambda* ((c (+ (let ((a -2)) (* b a)) a))) c))))) -3)
+(test (let ((a 123)) ((lambda* ((a 1) (b 2)) ((lambda* ((c (+ (let ((a 0)) (/ b a)) a))) c))))) 'error)
+(test ((lambda* ((c (call/cc (lambda (return) (return 3))))) c)) 3)
+(test ((lambda* ((a (do ((i 0 (+ i 1)) (sum 0)) ((= i 3) sum) (set! sum (+ sum i))))) (+ a 100))) 103)
+(test ((lambda* ((a (do ((i 0 (+ i 1)) (sum 0)) ((= i 3) sum) (set! sum (+ sum i)))) b) (+ a b)) 1 2) 3)
+(test ((lambda* (a (b '(1 2))) (length b)) 1) 2)
+(test ((lambda* (a (b '(1 2))) (values (length b))) 1) 2)
+(test (let () (define* (f2 a (b '(1 2))) (let ((c b)) (+ (c 0) 1))) (define (g) (f2 1)) (g)) 2) ; closure_star_a
+(test (let () (define* (f2 a (b '(1 2))) (+ (list-ref b 0) a)) (define (g) (f2 :a 1)) (g)) 2)   ; safe_closure_star_aa
+(test (let () (define (func) (unsafe-blocks 0 (symbol->value :scaler))) (func)) 'error)
+(test (let () (define* (f a b (err (lambda () (+ a b)))) (or (eq? a b) (err))) (f 1 2)) 3) ; chicken-users mailing list
+(test (let ((f1 (lambda (b) 10))) (define* (f1 (a (f1 0))) (+ a 1)) (f1)) 2)
+
+;; some of these are questionable
+(test ((lambda* ((x (lambda () 1))) (x))) 1)
+(test ((lambda* ((x x) else) (+ x else)) 1 2) 3) ; this has fluctuated between 3 and 'error (unbound variable 'x)
+(test (symbol? ((lambda* ((y y)) y))) 'error) ; this used to be #t but now y is undefined
+(test ((lambda* (:allow-other-keys) 34) :a 32) 'error)
+(test ((lambda* ((y x) =>) (list y =>)) 1 2) '(1 2)) ; was also 'error
+(test ((lambda* (=> (y x)) (list y =>)) 1) 'error) ; used to be  '(x 1))
+(test ((lambda* ((y #2d((1 2) (3 4)))) (y 1 0))) 3)
+(test ((lambda* ((y (symbol "#(1 #\\a (3))")) x) -1)) -1)
+(test ((lambda* ((y (symbol "#(1 #\\a (3))")) x) y)) (symbol "#(1 #\\a (3))"))
+(test ((lambda* ((y #(1 #\a (3)))) (y 0))) 1)
+(test ((lambda* ((y ()) ()) y)) 'error)
+(test ((lambda* ((y ()) (x)) y)) 'error)
+(test ((lambda* ((=> "") else) else) else) #f)
+(test ((lambda* (x (y x)) y) 1) 1) ; was #f
+(test ((lambda* (x (y x)) (let ((x 32)) y)) 1) 1) ; was #f
+(test ((lambda* ((x 1) (y x)) y)) 1)
+(test ((lambda* ((x 1) (y (+ x 1))) y)) 2)
+(test ((lambda* ((x y) (y x)) y)) 'error) ; used to be 'y
+(test (let ((z 2)) ((lambda* ((x z) (y x)) y))) 2) ; hmmm
+(test (keyword? ((lambda* ((x :-)) x))) #t)
+(test ((apply lambda* (list (list (list (string->symbol "a") 1)) (string->symbol "a"))) (symbol->keyword (string->symbol "a")) 3) 3)
+(test ((lambda* (:allow-other-keys) 1) :a 321) 'error)
+(test ((lambda* (:rest (a 1)) a)) 'error)
+(test ((lambda* (:rest a) a)) ())
+(test ((lambda* (:rest (a 1)) 1)) 'error)
+(test (let ((b 2)) ((lambda* (:rest (a (let () (set! b 3) 4))) b))) 'error)
+(test (let ((b 2)) ((lambda* ((a (let () (set! b 3) 4))) b))) 3)
+(test ((lambda* (:rest hi :allow-other-keys (x x)) x)) 'error)
+(test ((lambda* (:rest x y) (list x y)) 1 2 3) '((1 2 3) 2))
+(test ((lambda* (:rest '((1 2) (3 4)) :rest (y 1)) 1)) 'error)
+(test ((lambda* (:rest (list (quote (1 2) (3 4))) :rest (y 1)) 1)) 'error)
+(test ((lambda* ((x ((list 1 2) 1))) x)) 2)
+(test ((lambda* ((y ("hi" 0))) y)) #\h)
+(test ((lambda* ((x ((lambda* ((x 1)) x)))) x)) 1)
+(test ((lambda* (:rest) 3)) 'error)
+(test ((lambda* (:rest 1) 3)) 'error)
+(test ((lambda* (:rest :rest) 3)) 'error)
+(test ((lambda* ((: 1)) :)) 1)                     ; but there's no keyword name for this parameter!
+(test ((lambda* ((a 1)) a) a: 21) 21)
+(test ((lambda* ((a 1)) a) :a: 21) 'error)
+(test (let ((func (let ((a 3)) (lambda* ((b (+ a 1))) b)))) (let ((a 21)) (func))) 4)
+(test (let ((a 21)) (let ((func (lambda* ((b (+ a 1))) b))) (let ((a 3)) (func)))) 22)
+(test (let ((a 21)) (begin (define-macro* (func (b (+ a 1))) b) (let ((a 3)) (func)))) 4)
+(test ((lambda* (:rest x :allow-other-keys y) x) 1) 'error)
+(test ((lambda* (:allow-other-keys x) x) 1) 'error)
+(test ((lambda* (:allow-other-keys . x) x) 1 2) 'error)
+(test ((lambda* (:rest . (x)) x) 1 2) '(1 2))
+(test ((lambda* (:rest . (x 1)) x) 1 2) 'error)
+(test ((lambda* (:rest . (x)) x)) ())
+(test ((lambda* x x) 1) '(1))
+(test (lambda* (((x) 1)) x) 'error)
+(test ((lambda* ((a: 3)) a:) :a: 4) 'error)
+(test ((lambda* ((a 3)) a) a: 4) 4)
+(test ((lambda* ((a (lambda* ((b 1)) (+ b 1)))) (a))) 2)
+;(define hi (call-with-exit (lambda (return) (lambda* ((a (return "hey I need an argument"))) a)))) -> error call goto outside block?
+(test (let () (define hi (with-let (inlet 'a 3) (lambda (b) (+ a b)))) (hi 2)) 5) ; but this blocks the local env chain:
+;(let ((y 2)) (define hi (with-let (inlet) (lambda (a) (+ a y)))) (hi 1)) -> error y unbound
+;quick circular env: (define* (hi (a (curlet))) a) (hi) -- need a lambda equivalent of bacro for defargs
+(test (let () (define hi (do ((i 0 (+ i 1))) ((= i 3) (lambda (a) (+ a i))))) (hi 1)) 4)
+
+(test ((lambda* a (list a)) 1 2 3) '((1 2 3)))
+(test ((lambda* () #f) 1 2 3) 'error)
+(test ((lambda* (a ) (list a)) 1) '(1))
+(test ((lambda* (a b ) (list a b)) 1 2) '(1 2))
+(test ((lambda* (a b :allow-other-keys ) (list a b)) 1 2 :c 3) '(1 2))
+(test ((lambda* (a  . b ) (list a b)) 1 2 3) '(1 (2 3)))
+(test ((lambda* (a :rest b ) (list a b)) 1 2 3) '(1 (2 3)))
+(test ((lambda* (a :rest b :allow-other-keys ) (list a b)) 1 2 :c 3) '(1 (2 :c 3)))
+(test ((lambda* (a b :allow-other-keys ) (list a b)) 1) '(1 #f))
+(test ((lambda* (a :allow-other-keys ) (list a)) :b 2) '(#f))
+(test ((lambda* (:rest a ) (list a)) 1 2 3) '((1 2 3)))
+(test ((lambda* (:rest a b ) (list a b)) 1 2 3) '((1 2 3) 2))
+(test ((lambda* (:rest a b :allow-other-keys ) (list a b)) :c 1 2 3) '((:c 1 2 3) 1)) ; seems inconsistent
+(test ((lambda* (:rest a  . b ) (list a b)) 1 2 3) '((1 2 3) (2 3)))
+(test ((lambda* (:rest a :rest b ) (list a b)) 1 2 3) '((1 2 3) (2 3)))
+(test ((lambda* (:rest a :rest b :allow-other-keys ) (list a b)) 1 2 3) '((1 2 3) (2 3)))
+(test ((lambda* (:rest a :allow-other-keys ) (list a)) 1 2 3) '((1 2 3)))
+(test ((lambda* (:allow-other-keys ) (list)) :a 1 :c 3) 'error)
+
+(test (let () (define (f) ((lambda (a b . c) c) (values 1 2 3 4))) (f) (f)) '(3 4))
+(test (let () (define (f) ((lambda (a b . c) c) (values 1 2 3) (values 1 2))) (f) (f)) '(3 1 2))
+(test (let () (define (f) ((lambda (a b . c) c) (values 1 2 3) 1 2)) (f) (f)) '(3 1 2))
+
+(let ()
+  (define* (bpar (lst '(0 1 2 3)))
+    (let ((res (copy lst)))
+      (set! (lst 2) (* 2 (lst 2)))
+      res))
+  (test (bpar) '(0 1 2 3))
+  (test (bpar) '(0 1 4 3))
+  (define* (bpar1 (lst '(0 1 2 3)))
+    (set! (lst 2) (* 2 (lst 2)))
+    lst)
+  (let ((lst (bpar1)))
+    (set! (lst 0) 123))
+  (test (bpar1) '(123 1 8 3)))
+
+(let ()
+  (define* (g1 a b) (list a b))
+  (let-temporarily (((*s7* 'accept-all-keyword-arguments) #t))
+    (test (g1 :x) '(:x #f))
+    (test (g1 1 :x) '(1 :x))
+    (test (g1 :x 1) '(:x 1))
+    (test (g1 :x :x) '(:x :x)))
+  (test (g1 :x) 'error)
+
+  (define* (g3 a b c) (list a b c))
+  (let-temporarily (((*s7* 'accept-all-keyword-arguments) #t))
+    (test (g3 :x) '(:x #f #f))
+    (test (g3 :x 1) '(:x 1 #f))
+    (test (g3 1 :x 1) '(1 :x 1))
+    (test (g3 :x 1 :y) '(:x 1 :y))
+    (test (g3 :x :y :z) '(:x :y :z))
+    (test (g3 1 1 :x) '(1 1 :x))))
+
+(test ((lambda* (:rest a :rest b) (map + a b)) 1 2 3 4 5) '(3 5 7 9))
+(test ((lambda* (:rest a c :rest b) (map (lambda (a b) (+ a b c)) a b)) 1 2 3 4 5) '(6 8 10))
+(test ((lambda* (a :rest (b 2)) (list a b)) 1 2 3 4) 'error)
+(test ((lambda* ((x (values 1 2))) (+ x 1))) 'error)
+(test ((lambda* (x) x) (values)) #<unspecified>)
+(let ()
+  (define* (f x) x)
+  (test (apply f (list (values))) #<unspecified>)
+  (test (apply f (list (values :x))) 'error)
+  (test (f :x (values)) #<unspecified>) ; these two should be the same, and (abs (values)) complains about #<unspecified> as its arg
+  (test (f (values)) #<unspecified>))
+(let ()
+  (define* (f2 a b) (cons a b))
+  (test (f2 (values)) (cons #<unspecified> #f))
+  (test (apply f2 (list (values))) (cons #<unspecified> #f))
+  (test (f2 :a 1 (values)) (cons 1 #<unspecified>))
+  (test (f2 :b (values)) (cons #f #<unspecified>)))
+
+(let ()
+  (define* (f1 (a 0) :allow-other-keys) (+ a 1))
+  (let ((f2 (copy f1)))
+    (test (f2 :a 1) 2)
+    (test (f2 :b 1) 1)))
+
+(let ()
+  (define (kw n) (case n ((0) :a) ((1) :b) (else :c)))
+  (define* (f1 a b c) (list a b c))
+  (test (f1 (kw 0) 1) '(1 #f #f))
+  (test (f1 (kw 1) 1) '(#f 1 #f))
+  (test (f1 (kw 2) 1) '(#f #f 1))
+
+  (define* (f2 (a 1) (b 2) (c 3)) (list a b c))
+  (test (f2 (kw 0) -1) '(-1 2 3))
+  (test (f2 (kw 1) -1) '(1 -1 3))
+  (test (f2 (kw 2) -1) '(1 2 -1))
+
+  (test (let ((a 123)) (let* ((a 1) (a (+ a 1))) a)) 2)
+  (test (let ((a 123)) (let* loop ((a 1) (a (+ a 1))) a)) 'error)
+  (test (let ((a 123)) (define* (loop (a 1) (a (+ a 1))) a)) 'error))
+
+;;; one place where :rest can't be handled by dotted list:
+(let ()
+  (define* (f1 :rest args :allow-other-keys) args)
+  (test (f1 :a 1 :b 2) '(:a 1 :b 2)))
+;;; but its :allow-other-keys isn't needed here anyway:
+(let ()
+  (define* (f1 . args) args)
+  (test (f1 :a 1 :b 2) '(:a 1 :b 2)))
+;;; but
+(let ()
+  (define* (f1 (c 0) . args) args)
+  (test (f1 :a 1 :b 2) 'error)    ; unknown key
+  (test (f1 :c 1 :b 2) '(:b 2)))
+
+(define* (-nxy- gen (fm 0.0))  ; optimizer test (safe_closure_star_s0)
+  (let-set! gen 'fm fm)
+  (with-let gen
+    fm))
+(let ((g (inlet 'fm 1.0)))
+  (test (-nxy- g) 0.0)
+  (test (-nxy- g) 0.0)
+  (test (-nxy- g 0.5) 0.5)
+  (test (-nxy- g) 0.0))
+
+(let ()
+  (define (fs0) 3)
+  (define (fp0) 3 4)
+  (define (fa0) (+ 1 2))
+  (define (fu0) (apply + ()))
+  (define (c0)
+    (fs0)
+    (fp0)
+    (fa0)
+    (fu0))
+  (test (c0) 0))
+
+(let ((ctr 1))
+  (define (f1)
+    (if (> ctr 0)
+	(begin
+	  (set! ctr (- ctr 1))
+	  (f1))
+	0))
+  (define (f2) (f1))
+  (test (f2) 0))
+
+(let ((ctr 1))
+  (define (f3)
+    (if (= ctr 0)
+	0
+	(begin
+	  (set! ctr (- ctr 1))
+	  (+ (f3) 1))))
+  (define (f4) (f3))
+  (test (f4) 1))
+
+(let ((ctr 1))
+  (define (f5)
+    (if (= ctr 0)
+	0
+	(begin
+	  (set! ctr (- ctr 1))
+	  (apply + (list (f5) 1)))))
+  (define (f6) (f5))
+  (test (f6) 1))
+
+(let ((ctr 1))
+  (define (f8)
+    (let f7 ()
+      (if (> 0 ctr)
+	  (begin
+	    (set! ctr (- ctr 1))
+	    (f7))
+	  0)))
+  (test (f8) 0))
+
+(let ((ctr 1))
+  (define (f10)
+    (let f9 ()
+      (if (= ctr 0)
+	  0
+	  (begin
+	    (set! ctr (- ctr 1))
+	    (+ (f9) 1)))))
+  (test (f10) 1))
+
+(let ((ctr 1))
+  (define (f12)
+    (let f11 ()
+      (if (= ctr 0)
+	  0
+	  (begin
+	    (set! ctr (- ctr 1))
+	    (apply + (list (f11) 1))))))
+  (test (f12) 1))
+
+(let ((ctr 1))
+  (define (f13)
+    (display "f13" #f)
+    (if (= ctr 0)
+	0
+	(begin
+	  (set! ctr (- ctr 1))
+	  (apply + (list (f13) 1)))))
+  (define (f14) (f13))
+  (test (f14) 1))
+
+(let ((ctr 1)) ; safe_thunk_l
+  (define (f15)
+    (display "f15" #f)
+    (if (> ctr 0)
+	(begin
+	  (set! ctr (- ctr 1))
+	  (f15))
+	0))
+  (define (f16) (f15))
+  (test (f16) 0))
+
+(test (let ((ctr 1))
+	(define (f17)
+	  (if (> ctr 0)
+	      (begin
+		(set! ctr (- ctr 1))
+		(f17)
+		(f17))
+	      (let ((f17 32))
+		7)))
+	(define (f18) (f17))
+	(f18)) 7)
+
+(define (f19 -a-weird-var-)
+  (+ -a-weird-var- 1))
+(test (f19 3) 4)
+
+(define ctr 1)
+(define (-a-weird-var-)
+  (if (> ctr 0)
+      (begin
+	(set! ctr (- ctr 1))
+	(-a-weird-var-))
+      0))
+(define (f20)
+  (-a-weird-var-))
+(test (f20) 0)
+
+(define (f22)
+  (let ((ctr 1))
+    (define (f21)
+      (if (> ctr 0)
+	  (begin
+	    (set! ctr (- ctr 1))
+	    (f21))
+	  0))
+    (f21)))
+(f22)
+(test (f22) 0)
+
+#|
+(let ()
+  ;; quoted arg default bug (from K Matheussen)
+  ;;   why is this sometimes an error and other times not??
+  (define make-event
+    (lambda* ((patternnum 'must-be-defined) (channel 'must-be-defined))
+      (if #f (throw "strange"))))
+  (define (call-make-event a b)
+    (make-event a b))
+  (call-make-event :a 0))
+|#
+
+(let ((x 1))
+  (define fx (lambda* ((a (+ x 1)) (b (let ((y (+ x 1))) (+ y 1)))) (list a b)))
+  (define* (fy (a (* x 2)) (b (fx :a 1 :b 2))) (list a b))
+  (test (fx) '(2 3))
+  (test (fy) '(2 (1 2)))
+  (test (fy :a 0) '(0 (1 2))))
+
+#|
+(let ((choices (list "a " "b " " . " ":rest " ":allow-other-keys "))
+      (args (list "1 " ":a " ":b " ":c ")))
+
+  (define-bacro (display-abc)
+    `(format #f "~A ~A" (if (defined? 'a) (symbol->value 'a) '?) (if (defined? 'b) (symbol->value 'b) '?)))
+
+  (define (next-arg str n)
+
+    (let ((expr (string-append str ")")))
+      (catch #t
+	(lambda ()
+	  (let ((val (eval-string expr)))
+	    (format #t "~A -> ~A~%" expr val)))
+	(lambda args
+	  ;(format #t "    ~A: ~A~%" expr (apply format #f (cadr args)))
+	  'error)))
+
+    (if (< n 6)
+	(for-each
+	 (lambda (arg)
+	   (next-arg (string-append str arg) (+ n 1)))
+	 args)))
+
+  (define (next-choice str n)
+    (next-arg (string-append str ") (display-abc)) ") 0)
+    (if (< n 4)
+	(for-each
+	 (lambda (choice)
+	   (next-choice (string-append str choice) (+ n 1)))
+	 choices)))
+
+  (for-each
+   (lambda (choice)
+     (next-arg (string-append "((lambda* " choice "(display-abc)) ") 0))
+   choices)
+
+  (next-choice "((lambda* (" 0))
+|#
+
+(let ()
+  (define* (s0-test gen (fm 0.0))
+    (let-set! gen 'fm fm)
+    (with-let gen
+      (+ fm 1.0)))
+  (define (tst)
+    (let ((g (inlet 'fm 0.0)))
+      (num-test (s0-test g) 1.0))
+    (let ((g (inlet 'fm 0.0)))
+      (num-test (s0-test g 0.0) 1.0)))
+  (tst))
+
+;;; here be bugs...
+(test ((lambda* a a) :a) '(:a))
+(test ((lambda* (a . b) (list a b)) :b 1) 'error)
+(test ((lambda* (a :rest b) (list a b)) :b 1) 'error)
+(test ((lambda* (:rest a) (list a)) :a 1) 'error)
+(test ((lambda* (a  . b) (list a b)) :b 1 1) 'error)
+
+(test ((lambda* (:rest a b ) (list a b)) 1 1) '((1 1) 1))
+(test ((lambda* (:rest a :rest b ) (list a b)) :a 1) 'error)
+(test ((lambda* (:allow-other-keys) #f) :c 1) 'error)
+(test ((lambda* (a :allow-other-keys) a) :a) 'error)
+(test ((lambda* (a) a) :a) 'error)
+(test ((lambda* (a :allow-other-keys) a) :a 1 :a 2) 'error)
+(test ((lambda* (a :allow-other-keys) a) :c :c :c :c) #f)
+(test ((lambda* (a :allow-other-keys) a) :c) 'error)
+(test ((lambda* (a b :allow-other-keys ) (list a b)) :b :a :c 1) '(#f :a))
+
+(test ((lambda* (a :allow-other-keys ) a) :c 1 1) 1) ; ??
+(test ((lambda* (:rest b (a 1)) (list a b))) '(1 ()))
+(test ((lambda* (:rest a b c) (list a b c)) 1 2 3 4) '((1 2 3 4) 2 3))
+
+(test (let ((x 3)) (define* (f (x x)) x) (let ((x 32)) (f))) 3)
+(test (let ((x 3)) (define-macro* (f (x x)) `,x) (let ((x 32)) (f))) 32)
+
+(test (let () (define (x x) x) (x 1)) 1)
+(test (procedure? (let () (define* (x (x #t)) x) (x x))) #t)
+(test (procedure? (let () (define* (x (x x)) x) (x (x x)))) #t)
+;(test (procedure? (let () (define* (x (x x)) x) (x))) #t)
+(test (apply + ((lambda* ((x (values 1 2 3))) x))) 'error) ; else mv plugged into every 'x in the body??
+(test (let () (define* (f (x (values 1 2))) (+ x 1)) (f)) 'error)
+(test ((lambda* ((x (lambda* ((y (+ 1 2))) y))) (x))) 3)
+
+;;; define-macro
+;;; define-macro*
+;;; define-bacro
+;;; define-bacro*
+;;; macro
+;;; macro*
+;;; bacro
+;;; bacro*
+
+(test (let ((x 0)) (define-macro* (hi (a (let () (set! x (+ x 1)) x))) `(+ 1 ,a)) (list (let ((x -1)) (list (hi) x)) x)) '((1 0) 0))
+(test (let ((x 0)) (define-bacro* (hi (a (let () (set! x (+ x 1)) x))) `(+ 1 ,a)) (list (let ((x -1)) (list (hi) x)) x)) '((1 0) 0))
+(test (let ((x 0)) (define-macro* (hi (a (let () (set! x (+ x 1)) x))) `(+ x ,a)) (list (let ((x -1)) (list (hi) x)) x)) '((-1 0) 0))
+(test (let ((x 0)) (define-bacro* (hi (a (let () (set! x (+ x 1)) x))) `(+ x ,a)) (list (let ((x -1)) (list (hi) x)) x)) '((-1 0) 0))
+
+(test (let ((x 0)) (define-macro* (hi (a (let () (set! x (+ x 1)) x))) `(let ((x -1)) (+ x ,a))) (list (hi) x)) '(-1 0))
+(test (let ((x 0)) (let ((x -1)) (+ x (let () (set! x (+ x 1)) x)))) -1)
+(test (let ((x 0)) (define-macro (hi a) `(let ((x -1)) (+ x ,a))) (list (hi (let () (set! x (+ x 1)) x)) x)) '(-1 0))
+(test (let () (define-macro (hi a) `(let ((b 1)) (+ ,a b))) (hi (+ 1 b))) 3)
+(test (let ((b 321)) (define-macro (hi a) `(let ((b 1)) (+ ,a b))) (hi b)) 2)
+(test (let ((b 321)) (define-macro* (hi (a b)) `(let ((b 1)) (+ ,a b))) (hi b)) 2)
+(test (let ((b 321)) (define-macro* (hi (a b)) `(let ((b 1)) (+ ,a b))) (hi)) 2) ; ???
+(test (let ((x 0)) (define-macro* (hi (a (let () (set! x (+ x 1)) x))) `(+ ,a ,a)) (hi)) 3) ; ??? -- default val is substituted directly
+;; but (let () (define-macro* (hi a (b a)) `(+ ,a ,b)) (hi 1)) -> "a: unbound variable" -- "a" itself is substituted, but does not exist at expansion(?)
+
+;; can we implement bacros via define-macro* default args?
+;;  I don't think so -- macro arguments can't be evaluated in that environment because
+;;  only the default values have been set (on the previous parameters).
+
+;; bacro ignores closure in expansion but macro does not:
+(test (let ((x 1)) (define-macro (ho a) `(+ ,x ,a)) (let ((x 32)) (ho 3))) 4)
+(test (let ((x 1)) (define-macro (ho a) `(+ x ,a)) (let ((x 32)) (ho 3))) 35)
+(test (let ((x 1)) (define-bacro (ho a) `(+ ,x ,a)) (let ((x 32)) (ho 3))) 35)
+(test (let ((x 1)) (define-bacro (ho a) `(+ x ,a)) (let ((x 32)) (ho 3))) 35)
+
+(test (let ((x 1)) (define-macro* (ho (a x)) `(+ ,x ,a)) (let ((x 32)) (ho))) 33)
+(test (let ((x 1)) (define-macro* (ho (a x)) `(+ x ,a)) (let ((x 32)) (ho))) 64)
+(test (let ((x 1)) (define-bacro* (ho (a x)) `(+ x ,a)) (let ((x 32)) (ho))) 64)
+(test (let ((x 1)) (define-bacro* (ho (a x)) `(+ ,x ,a)) (let ((x 32)) (ho))) 64)
+
+(test (let ((x 1)) (define-macro* (ho (a (+ x 0))) `(+ ,x ,a)) (let ((x 32)) (ho))) 33)  ;; (+ 32 (+ x 0)) !?! macroexpand is confusing?
+(test (let ((x 1)) (define-macro* (ho (a (+ x 0))) `(+ x ,a)) (let ((x 32)) (ho))) 64)   ;; (+ x (+ x 0))
+(test (let ((x 1)) (define-bacro* (ho (a (+ x 0))) `(+ x ,a)) (let ((x 32)) (ho))) 64 )
+(test (let ((x 1)) (define-bacro* (ho (a (+ x 0))) `(+ ,x ,a)) (let ((x 32)) (ho))) 64 )
+
+(test (let () (define-macro* (hi :rest a) `(list ,@a)) (hi)) ())
+(test (let () (define-macro* (hi :rest a) `(list ,@a)) (hi 1)) '(1))
+(test (let () (define-macro* (hi :rest a) `(list ,@a)) (hi 1 2 3)) '(1 2 3))
+(test (let () (define-macro* (hi a :rest b) `(list ,a ,@b)) (hi 1 2 3)) '(1 2 3))
+(test (let () (define-macro* (hi (a 1) :rest b) `(list ,a ,@b)) (hi)) '(1))
+(test (let () (define-macro* (hi (a 1) :rest b) `(list ,a ,@b)) (hi 2)) '(2))
+(test (let () (define-macro* (hi (a 1) :rest b) `(list ,a ,@b)) (hi :a 2)) '(2))
+(test (let () (define-macro* (hi (a 1) :rest b :allow-other-keys) `(list ,a ,@b)) (hi :a 2 :b 3)) 'error)
+(test (let () (define-macro* (mac1 a :rest b) `(,a ,@b)) (mac1 + 2 3 4)) 9)
+
+					;  (test (let () (define-macro ,@a 23)) 'error)
+					;  (test (let () (define-macro ,a 23)) 'error)
+					; maybe this isn't right
+(let ()
+  (define-bacro* (_bac*_ (x 1)) `(+ ,x 1))
+  (define (f1) (display (_bac*_ #<undefined>)))
+  (test (f1) 'error)) ; not segfault...
+
+(let ()
+  (define-macro (dw-fs x)
+    `(values (lambda () #f) (lambda () ,x) (lambda () #f)))
+  (test (dynamic-wind (dw-fs 3)) 3))
+
+(let ()
+  (define-macro (flam . args) `(apply format #f "~{~A~^ ~}" '(,args)))
+  (test (flam this is a test) "this is a test"))
+
+(test ((lambda* ((a 1) :allow-other-keys) a) :b 1 :a 3) 3)
+(test (let () (define-macro* (hi (a 1) :allow-other-keys) `(list ,a)) (hi :b 2 :a 3)) '(3))
+(test ((lambda* ((a 1) :rest b :allow-other-keys) b) :c 1 :a 3) ())
+(test ((lambda* ((a 1) :rest b :allow-other-keys) b) :b 1 :a 3) 'error)
+;; that is the rest arg is not settable via a keyword and it's an error to try to
+;;   do so, even if :allow-other-keys -- ??
+
+(test (let ((mac (macro (a) `(+ ,a `1)))) (macroexpand (mac . 3))) 'error)
+(test (for-each macroexpand (hash-table (macro (a) `(+ ,a 1)) #i(1 2))) 'error)
+
+(test (let ((x 1)) (define* (hi (a x)) a) (let ((x 32)) (hi))) 1)
+(test (let ((x 1)) (define* (hi (a (+ x 0))) a) (let ((x 32)) (hi))) 1)
+(test (let ((x 1)) (define* (hi (a (+ x "hi"))) a) (let ((x 32)) (hi))) 'error)
+(test (let ((x 1)) (define-macro* (ho (a (+ x "hi"))) `(+ x ,a)) (let ((x 32)) (ho))) 'error)
+(test (let ((x 1)) (define-macro (f1) `(+ x 1)) (f1)) 2)
+(test (let ((x 1)) (define-macro (add-1 y) `(+ ,y 1)) (add-1 (add-1 (add-1 x)))) 4)
+(let () ; wikipedia example of function composition using macros
+  (define-macro (sqrt-1 x) `(sqrt ,x))
+  (define-macro (negate-1 x) `(- ,x))
+  (define-macro (square-1 x) `(* ,x ,x))
+  (let ((val1 (sqrt-1 (negate-1 (square-1 5)))))
+    (define (compose . fs)
+      (if (null? fs)
+          (lambda (x) x)
+          (lambda (x)
+            ((car fs) ((apply compose (cdr fs)) x)))))
+    (test ((compose sqrt-1 negate-1 square-1) 5) val1)
+    (define-macro (compose-1 . fs)
+      `(if (null? ',fs)
+          (lambda (x) x)
+          (lambda (x)
+            ((symbol->value (car ',fs)) ((apply compose-1 (cdr ',fs)) x)))))
+    (test ((compose-1 sqrt-1 negate-1 square-1) 5) val1))
+  (test ((symbol->value 'negate-1) -4) 4))
+
+(let ()
+  (define-macro (until test . body) `(do () (,test) ,@body))
+  (test (let ((i 0) (sum 0)) (until (= i 4) (set! sum (+ sum i)) (set! i (+ i 1))) sum) 6))
+
+(let ()
+  (define-macro (glambda args) ; returns an anonymous macro that will return a function given a body
+    `(define-macro (,(gensym) . body)
+       `(lambda ,',args ,@body)))
+
+  (test (let ((gf (glambda (a b))))  ; gf is now ready for any body that involves arguments 'a and 'b
+	  ((gf (+ a b)) 1 2))        ; apply (lambda (a b) (+ a b)) to '(1 2)
+	3))
+
+(let ()
+  (define-macro (alambda pars . body)
+    `(letrec ((self (lambda* ,pars ,@body)))
+       self))
+
+  (test ((alambda (n) (if (<= n 0) () (cons n (self (- n 1))))) 9) '(9 8 7 6 5 4 3 2 1))
+
+  (define-macro* (aif test then (else #<unspecified>))
+    `(let ((it ,test))
+       (if it ,then ,else)))
+
+  (test (aif (+ 3 2) it) 5)
+  (test (aif (> 2 3) it) #<unspecified>)
+  (test (aif (> 2 3) #f it) #f)
+  )
+
+(let ()
+  (define-macro (enum . args)
+    `(for-each (let ((ctr -1))
+		 (define-macro (m a)
+		   (set! ctr (+ ctr 1))
+		   `(apply define ',a ,ctr ())))
+               ',args))
+
+  (enum a b c)
+  (test b 1)
+  (test (+ a b c) 3))
+
+(let ()
+  (define-macro (m0 . args) `(apply + ',args))
+  (apply define-macro '(m1 . args) '(`(+ ,@args)))
+  (test (procedure-source m0) '(macro args (#_list-values 'apply '+ (#_list-values #_quote args))))
+  (test (procedure-source m1) '(macro args (#_list-values (#_quote +) (#_apply-values args))))
+  (test (m0 1 2 3) 6)
+  (test (m1 1 2 3) 6))
+
+(let ()
+  (define-bacro* (m (a b)) a)
+  (test (let ((b 2)) (m)) 2)
+  (test (let ((b 2)) (let ((b 23)) (m))) 23))
+
+(let ()
+  (define-macro* (mac1 (x (+ y 1))) `(+ ,x 2))
+  (let ((y 12)) (test (mac1) 15))
+  (define-macro* (mac2 (x (+ y 1))) `(let ((y 5)) (+ ,x 2)))
+  (let ((y 12)) (test (mac2) 8)))
+
+(let ()
+  (let ((x 1) (y 2))
+    (define-bacro (bac1 a) `(+ ,x y ,a))
+    (let ((x 32) (y 64))
+      (test (bac1 3) 99)))
+
+  (let ((x 1) (y 2))
+    (define-bacro (bac2 a)
+      (with-let (sublet (funclet bac2) (cons 'a a))
+	`(+ ,x y ,a)))
+    (let ((x 32) (y 64))
+      (test (bac2 3) 68)))
+
+  (let ((x 1) (y 2))
+    (define-bacro (bac3 a)
+      (with-let (sublet (funclet bac3) (cons 'a a))
+	(eval `(+ ,x y ,a))))
+    (let ((x 32) (y 64))
+      (test (bac3 3) 6)))
+
+  (let ((x 1) (y 2))
+    (define-bacro (bac4 a)
+      (eval `(+ ,x y ,a) (sublet (funclet bac4) (cons 'a a))))
+    (let ((x 32) (y 64))
+      (test (bac4 3) 37)))
+
+  (let ((x 1) (y 2))
+    (define-bacro (bac1 a)
+      `(+ ,x y ,a))            ; -> (+ 32 y x)
+    (let ((x 32) (y 64))
+      (test (bac1 x) 128))) ; x=32
+
+  (let ((x 1) (y 2))
+    (define-bacro (bac2 a)
+      (with-let (sublet (funclet bac2) (cons 'a a))
+	`(+ ,x y ,a)))         ; (+ 1 y x)
+    (let ((x 32) (y 64))
+      (test (bac2 x) 97))) ; x=32
+
+  (let ((x 1) (y 2))
+    (define-bacro (bac3 a)
+      (with-let (sublet (funclet bac3) (cons 'a a))
+	(eval `(+ ,x y ,a))))  ; (eval (+ 1 2 1)) -> 4
+    (let ((x 32) (y 64))
+      (test (bac3 x) 4))) ; x=1
+
+  (let ((x 1) (y 2))
+    (define-bacro (bac4 a)
+      (eval `(+ ,x y ,a) (sublet (funclet bac4) (cons 'a a))))
+					; (eval (+ 32 2 1)) -> 35
+    (let ((x 32) (y 64))
+      (test (bac4 x) 35))) ; x=1
+
+  (let ((x 1) (y 2))
+    (define-bacro (bac3 a)
+      (let ((e (with-let (sublet (funclet bac3) (cons 'a a))
+		 `(+ ,x y ,a))))
+	`(with-let ,(sublet (funclet bac3) (cons 'a a))
+	   ,e)))
+    (let ((x 32) (y 64))
+      (test (bac3 3) 6)))
+
+  (let ((x 1) (y 2))
+    (define-bacro (bac4 a)
+      (let ((e `(+ ,x y ,a)))
+	`(with-let ,(sublet (funclet bac4) (cons 'a a))
+	   ,e)))
+    (let ((x 32) (y 64))
+      (test (bac4 3) 37)))
+
+  (let ()
+    (define (f4) (call-bac 1))
+    (define call-bac
+      (let ((x 2))
+        (define-bacro (m a) `(+ ,a ,x))))
+    (test (f4) 'error)))
+
+(let ()
+  (define (f1 a b)
+    (list (holler) (+ a b)))
+
+  (define-bacro (holler)
+    `(format #f "(~S~{ ~S ~S~^~})"
+	     (let ((f (*function*)))
+	       (if (pair? f) (car f) f))
+	     (map (lambda (slot)
+		    (values (symbol->keyword (car slot)) (cdr slot)))
+		  (map values ,(outlet (curlet))))))
+
+  (test (f1 2 3) '("(f1 :a 2 :b 3)" 5))
+
+  (define (f2 a b)
+    (list (holler1 a) (+ a b)))
+
+  (define-bacro (holler1 x)
+    `(format #f "(~S~{ ~S ~S~^~})"
+	     (let ((f (*function*)))
+	       (if (pair? f) (car f) f))
+	     (map (lambda (slot)
+		    (values (symbol->keyword (car slot)) (cdr slot)))
+		  (map values ,(outlet (curlet))))))
+
+  (test (let ((two 2)) (f2 two 3)) '("(f2 :a 2 :b 3)" 5))
+
+  (define (f3 a b)
+    (list (holler2 a b) (+ a b)))
+
+  (define-bacro (holler2 x y)
+    `(format #f "(~S~{ ~S ~S~^~})"
+	     (let ((f (*function*)))
+	       (if (pair? f) (car f) f))
+	     (map (lambda (slot)
+		    (values (symbol->keyword (car slot)) (cdr slot)))
+		  (map values ,(outlet (curlet))))))
+
+  (test (let ((two 2) (three 3)) (f3 two three)) '("(f3 :a 2 :b 3)" 5)))
+
+(let () ; need this, else the define-macro below leaks into rootlet
+  (let ((e (inlet
+	    'mac (apply define-macro
+			(list (list (gensym) 'a) '`(+ ,a 1))))))
+    (test ((e 'mac) 3) 4)))
+
+(let ()
+  (define mac ; macro with closure
+    (let ()
+      (define (mac-1 x) (+ x 1))
+      (macro (y)
+        `(+ ,y (((funclet mac) 'mac-1) ,y))))) ; funclet to get at mac closure
+  (test (mac 2) 5))
+
+(let ((x 0))
+  (define-macro (mac a) `(+ ,a 1))
+  (define (call-m m args) (apply m args))
+  (let ((x 123))
+    (test (call-m mac '((* x 2))) 1)
+    (test (apply mac '((* x 2))) 247)
+    (test (call-m mac `((* ,x 2))) 247) ;; qq sees inner x
+    (test (apply mac `((* ,x 2))) 247)))
+
+(test (with-output-to-string (lambda () (do ((i 0 (+ i 1))) ((= i 1)) (unless #t (/ (_mac_ 1 -1)))))) "") ; optimizer s7_macroexpand error
+
+(let ()
+  (define mac1 (dilambda
+		(macro (a) `(+ ,a 1))
+		(lambda (a b) b)))
+  (test (mac1 2) 3)
+  (test (set! (mac1 2) 32) 32)
+
+  (define mac2 (dilambda
+		(macro* (a (b 12)) `(+ ,a ,b))
+		(lambda* (a b c) (or c b))))
+  (test (mac2 2) 14)
+  (test (mac2 2 3) 5)
+  (test (set! (mac2 2) 32) 32)
+  (test (set! (mac2 2 3) 32) 32)
+
+  (let ((mac3 #f))
+    (define-macro (mac3 a) `(+ ,a 1))
+    (set! (setter mac3) (lambda (s v) v))
+    (test (set! (mac3 3) 32) 32)))
+
+(let () ; bacro = macro without one layer of quasiquote:
+  (define-macro (1+) `(+ x 1))
+  (define-bacro (1++) (+ x 1))  ; but returned value is evaluated
+  (define (call1) (let ((x 3)) (1+)))
+  (define (call2) (let ((x 3)) (1++)))
+  (test (call1) (call2)))
+
+(let ()
+  (define-macro (swap a b)
+    `(with-let (inlet :e (curlet) :tmp ,a)
+       (set! (e ',a) (e ',b))
+       (set! (e ',b) tmp)))
+
+  (let ((a 1) (b 2))   (swap b a)   (test (list a b)   '(2 1)))
+  (let ((tmp 1) (b 2)) (swap b tmp) (test (list tmp b) '(2 1)))
+  (let ((a 1) (tmp 2)) (swap a tmp) (test (list a tmp) '(2 1)))
+  (let ((tmp 1) (b 2)) (swap tmp b) (test (list tmp b) '(2 1)))
+  (let ((a 1) (tmp 2)) (swap tmp a) (test (list a tmp) '(2 1))))
+
+(let () ; a macro with a closure
+  (define mac (let ((counter 0))
+                (define-macro (mac x)
+		  (set! counter (+ counter 1))
+		  `(+ ,x ,counter))))
+  (test (mac 1) 2)
+  (test (mac 1) 3)
+  (test (format #f "~S" mac) "mac")
+  (test (macro? mac) #t)
+  (test (mac (mac 1)) 8)
+  (let ((counter 32))
+    (test (macroexpand (mac counter)) '(+ counter 5))
+    (test (mac counter) 38)))
+
+(let ()
+  (define-macro (swap a b)
+    `(set! ,b (with-let (inlet 'e (curlet) 'tmp ,a)
+		(with-let e (set! ,a ,b))
+		tmp)))
+
+  (test (let ((v (vector 1 2))) (swap (v 0) (v 1)) v) #(2 1))
+  (test (let ((tmp (cons 1 2))) (swap (car tmp) (cdr tmp)) tmp) '(2 . 1))
+
+  (define-macro (set-swap a b c) `(set! ,b ,c))
+  (set! (setter swap) set-swap)
+
+  (test (let ((a 1) (b 2) (c 3) (d 4)) (swap a (swap b (swap c d))) (list a b c d)) '(2 3 4 1))
+
+  (define-macro (rotate . args)
+    `(set! ,(args (- (length args) 1))
+	   (with-let (inlet 'e (curlet) 'tmp ,(car args))
+	     (with-let e
+	       ,@(map (lambda (a b) `(set! ,a ,b)) args (cdr args)))
+	     tmp)))
+
+  (test (let ((a 1) (b 2) (c 3)) (rotate a b c) (list a b c)) '(2 3 1))
+
+  (define-macro (mac a) `(+ ,a 1))
+  (define-macro* (mac1 (a 32)) `(+ ,a 1))
+
+  (define-macro (fm form)
+    (define (expand form)
+      (if (pair? form)
+	  (if (and (symbol? (car form))
+		   (macro? (symbol->value (car form))))
+	      (expand (apply macroexpand (list form)))
+	      (if (and (eq? (car form) 'set!)
+		       (pair? (cdr form))
+		       (pair? (cadr form))
+		       (macro? (symbol->value (caadr form))))
+		  (expand (apply macroexpand (list (cons (setter (symbol->value (caadr form)))
+							 (append (cdadr form) (copy (cddr form)))))))
+		  (cons (expand (car form))
+			(expand (cdr form)))))
+	  form))
+    (list 'quote (expand form)))
+
+  (test (fm (mac 2)) '(+ 2 1))
+  (test (fm (mac x)) '(+ x 1))
+  (test (fm (mac1 2)) '(+ 2 1))
+  (test (fm (mac1)) '(+ 32 1))
+  (test (fm (mac (mac1))) '(+ (+ 32 1) 1))
+  (test (fm (+ (mac x) (mac1 y))) '(+ (+ x 1) (+ y 1)))
+  (test (fm (swap a b)) '(set! b (with-let (inlet 'e (curlet) 'tmp a) (with-let e (set! a b)) tmp)))
+  (test (fm (swap a (swap b c)))
+	'(set! c (with-let (inlet 'e (curlet) 'tmp a)
+		   (with-let e (set! a (set! c (with-let (inlet 'e (curlet) 'tmp b)
+						 (with-let e (set! b c)) tmp)))) tmp)))
+  (test (fm (rotate a b c)) '(set! c (with-let (inlet 'e (curlet) 'tmp a) (with-let e (set! a b) (set! b c)) tmp)))
+  )
+
+#|
+;;; would this work in MIT-scheme?
+(define-macro (swap a b)
+  `(set! ,b (eval `(let ((e ,(the-environment)))
+		     (eval `(set! ,',',a ,',',b) e)
+		     tmp)
+		  (let ((e (the-environment))
+			(tmp ,a))
+		    (the-environment)))))
+|#
+
+(test ((macro (x) `(+ ,x 1)) 1) 2)
+(test (macro? (macro (x) `(+ ,x 1))) #t)
+(test ((macro (x) `(+ ,x 1)) (* 3 2)) 7)
+(test (object->string (procedure-source (macro (x) `(+ ,x 1)))) "(macro (x) (list-values '+ x 1))")
+
+(test ((macro* (x) `(+ ,x 1)) 1) 2)
+(test (macro? (macro* (x) `(+ ,x 1))) #t)
+(test ((macro* (x) `(+ ,x 1)) (* 3 2)) 7)
+(test (object->string (procedure-source (macro* (x) `(+ ,x 1)))) "(macro* (x) (list-values '+ x 1))")
+
+(test ((bacro (x) `(+ ,x 1)) 1) 2)
+(test (macro? (bacro (x) `(+ ,x 1))) #t)
+(test ((bacro (x) `(+ ,x 1)) (* 3 2)) 7)
+(test (object->string (procedure-source (bacro (x) `(+ ,x 1)))) "(bacro (x) (list-values '+ x 1))")
+
+(test ((bacro* (x) `(+ ,x 1)) 1) 2)
+(test (macro? (bacro* (x) `(+ ,x 1))) #t)
+(test ((bacro* (x) `(+ ,x 1)) (* 3 2)) 7)
+(test (object->string (procedure-source (bacro* (x) `(+ ,x 1)))) "(bacro* (x) (list-values '+ x 1))")
+
+(test (let ((y 10)) (+ 1 ((macro (x) `(+ ,x ,y)) (* 2 3)))) 17)
+(test (let ((y 10)) (+ 1 ((macro* (x) `(+ ,x ,y)) :x (* 2 3)))) 17)
+(test (let ((y 10)) (+ 1 ((bacro (x) `(+ ,x ,y)) (* 2 3)))) 17)
+(test (let ((y 10)) (+ 1 ((bacro* (x) `(+ ,x ,y)) :x (* 2 3)))) 17)
+
+(test ((macro () `(+ 1 2))) 3)
+
+(let ((dwm (let ((y 10)) (dilambda (macro () `(+ 1 ,y))
+				   (macro (x) `(+ 1 ,x ,y))))))
+  (test (dwm) 11)
+  (test (set! (dwm) 4) 15))
+
+(test ((macro x `(list ,@x)) 1 2 3) '(1 2 3))
+(test (object->string (macro (x y) `(+ ,x ,y))) "#<macro (x y)>")
+(test (object->string (macro* (x y) `(+ ,x ,y))) "#<macro* (x y)>")
+(test (object->string (bacro (x y) `(+ ,x ,y))) "#<bacro (x y)>")
+(test (object->string (bacro* (x y) `(+ ,x ,y))) "#<bacro* (x y)>")
+
+(let ((x (macro (x) `(+ ,x 1)))) (let ((y x)) (test (eq? x y) #t)))
+(let ((f (lambda (m x) (+ x (m x))))) (test (f (macro (y) `(* ,y 2)) 3) 9))
+(test (apply (macro (x) `(+ ,x 1)) '(2)) 3)
+
+(let ()
+  (define-macro (msym1 . a) `(copy ,a))
+  (define-macro (msym2 a . b) `(cons ,a (copy ,b))) ; these are confusing!
+  (define-macro* (msym4 :rest a) `(copy ,a))
+  (define-macro* (msym5 a :rest b) `(cons ,a (copy ,b)))
+  (define (fop4 x y) (apply x y)) ; appl_ss
+
+  (test (let () (define (func) (for-each values (list (msym1  (lambda (a b . c) (reverse! c)) (make-vector 3) (make-weak-hash-table))))) (func) (func)) #<unspecified>)
+  (test (let () (define (func) (let ((x #f) (i 0)) (msym5 3 (lambda (a . b) (cons a b)) (symbol? x)))) (func) (func)) '(3 #f))
+  ;; (3 #f) from (cons 3 (copy ((lambda (a . b) (cons a b)) (symbol? x)))) -> (3 #f)!
+  (test (let () (define (func) (msym5 1 (lambda (a . b) (cons a b)) 3 4 5)) (func) (func)) '(1 3 4 5))
+
+  (test (let ((x #f) (i 0)) (let ((+ -)) (block-set! (fop4  #_and (let ((L (list 1 2))) (set-cdr! (cdr L) L) L) )))) 'error)
+  (let () (define (func) (with-output-to-string (lambda () (msym1 (write #_and))))) (test (func) "#_and") (test (func) "#_and"))
+
+  (test (msym1) ())
+  (test (msym1 +) 0)
+  (test (msym1 + 2) 2)
+  (test (msym1 + . 2) 'error)
+  (let ((L (list 1 2))) (set-cdr! (cdr L) L) (test (msym1 L) 'error))
+
+  (test (msym4) ())
+  (test (msym4 +) 0)
+  (test (msym4 + 2) 2)
+  (test (msym4 + . 2) 'error)
+
+  (test (msym2) 'error)
+  (test (msym2 1) '(1))
+  (test (msym2 1 +) '(1 . 0))
+  (test (msym2 1 + 2) '(1 . 2))
+  (test (msym2 1 + . 2) 'error)
+
+  (test (msym5) '(#f))
+  (test (msym5 1) '(1))
+  (test (msym5 1 +) '(1 . 0))
+  (test (msym5 1 + 2) '(1 . 2))
+  (test (msym5 1 + . 2) 'error))
+
+(test (bacro) 'error)
+(test (bacro . 1) 'error)
+(test (bacro 1) 'error)
+(test (bacro ()) 'error)
+(test (bacro (a)) 'error)
+(test (bacro (a) . 1) 'error)
+(test (macro (a 1) 2) 'error)
+(test (macro* (a :b) 3) 'error)
+(test (macro (a :rest b) b) 'error)
+(test (let () (define-macro* (m1 a :rest b :rest c) `(list ,a ,@b ,@c)) (m1 1 2 3 4 5)) '(1 2 3 4 5 3 4 5))
+
+(test (arity (macro (a) `(+ ,a 1))) '(1 . 1))
+(test (signature (macro (a) `(+ ,a 1))) #f)
+(test (procedure? (macro (a) `(+ ,a 1))) #f)
+
+(test (macro? (copy (macro (a) `(+ ,a 1)))) #t)
+
+(test (catch #t (lambda () (macro)) (lambda (t i) (apply format #f i))) "macro: (macro) has no parameters or body?")
+(test (catch #t (lambda () (macro . 1)) (lambda (t i) (apply format #f i))) "macro: (macro . 1) has no parameters or body?")
+(test (catch #t (lambda () (macro (a))) (lambda (t i) (apply format #f i))) "macro: (macro (a)) has no body?")
+(test (catch #t (lambda () (macro (1) 1)) (lambda (t i) (apply format #f i))) "macro parameter name, 1, is not a symbol")
+(test (catch #t (lambda () (macro #(0) 1)) (lambda (t i) (apply format #f i))) "macro parameter list is #(0)?")
+(test (catch #t (lambda () (macro (a) 1 . 2)) (lambda (t i) (apply format #f i))) "macro: macro body messed up, (macro (a) 1 . 2)")
+
+(let () (define (g) ((macro (abs) (abs -1)) sin)) (test (g) 'error)) ; sin is a symbol (not evaluated)
+(let () (define (g) ((macro (abs) ((symbol->value abs) -1)) sin))
+  (if with-bignums
+    (num-test (g) -8.414709848078965066525023216302989996239E-1)
+    (num-test (g) -0.8414709848078965)))
+(let () (define-macro (m abs) ((symbol->value abs) -1)) (define (h) (m sin))
+  (if with-bignums
+    (num-test (h) -8.414709848078965066525023216302989996239E-1)
+    (num-test (h) -0.8414709848078965)))
+
+(test (with-output-to-string ((macro (a) `(lambda () (display 3))) 1)) "3")
+
+(test (let () (define (ceval x) (eval x)) (let ((i 0)) (ceval (list (define-bacro (_ . args) (null? i)))))) 'error)
+(test (let () (define (ceval x) (eval x)) (let ((i 0)) (ceval (list (bacro* args (null? i)))))) 'error)
+
+(let () ; from lisp bboard
+  (define-macro (circularize . forms) `(begin ,@(let loop ((p forms)) (if (pair? (cdr p)) (loop (cdr p)) (set-cdr! p forms)))))
+  (test (circularize (+ 1 2) (- 3 4)) 'error))
+
+(let ()
+  ;; how to protect a recursive macro call from being stepped on
+  ;; (define-macro (mac a b) `(if (> ,b 0) (let ((,a (- ,b 1))) (mac ,a (- ,b 1))) ,b))
+  ;; (mac mac 1)
+  ;; attempt to apply the integer 0 to (0 1)?
+  ;;    (mac mac 1)
+  (define-macro (mac a b)
+    (let ((gmac (gensym)))
+      (set! gmac mac)
+      `(if (> ,b 0)
+	   (let ((,a (- ,b 1)))
+	     (,gmac ,a (- ,b 1)))
+	   ,b)))
+  (test (mac mac 10) 0))
+
+(let ()
+  (define-bacro* (incf var (inc 1)) `(set! ,var (+ ,var ,inc)))
+  (define-bacro* (decf var (inc 1)) `(set! ,var (- ,var ,inc)))
+
+  (test (let ((x 0)) (incf x)) 1)
+  (test (let ((x 1.5)) (incf x 2.5) x) 4.0)
+  (test (let ((x 10)) (decf x (decf x 1)) x) 1)
+
+  ;; ! -- left to right order I think (let ((x 10)) (set! x (- x (set! x (- x 1))))) so the 3rd x is 10
+  ;; Clisp and sbcl return 0: (let ((x 10)) (decf x (decf x (decf x))) x) is also 0
+  ;; but in clisp (let ((x 10)) (setf x (- x (setf x (- x 1)))) x) is 1
+  ;; I didn't know these cases were different
+  ;; (let ((x 10)) (set! x (- x (let () (set! x (- x 1)) x))) x) 1, Guile also says 1
+  ;; cltl2 p 134ff is an unreadable discussion of this, but I think it says in this case CL goes right to left
+  ;; weird! in CL (decf x (decf x)) != (setf x (- x (setf x (- x 1))))
+  ;;   and (let ((x 10)) (let ((val (decf x))) (decf x val) x))?
+
+  (test (let ((x 1+i)) (decf x 0+i)) 1.0))
+
+(let ()
+
+  ;; (define-bacro* (incf var (inc 1)) (set! var (+ (eval var) (eval inc))))
+  ;; this form does not actually set the incoming variable (it sets the argument)
+  ;; at OP_SET we see set (var (+ (eval var) (eval inc)))
+  ;;                  set1 var 1
+  ;;                  which leaves x unset
+  ;; but below we see set (x 1)
+  ;;                  set1 x 1
+
+  (define-bacro* (incf var (inc 1)) (apply set! var (+ (eval var) (eval inc)) ()))
+  (define-bacro* (decf var (inc 1)) (apply set! var (- (eval var) (eval inc)) ()))
+
+  (test (let ((x 0)) (incf x)) 1)
+  (test (let ((x 1.5)) (incf x 2.5) x) 4.0)
+  (test (let ((x 10)) (decf x (decf x 1)) x) 1)
+  (test (let ((x 1+i)) (decf x 0+i)) 1.0))
+
+
+(let ()
+  (define-macro (and-call function . args)
+    ;; apply function to each arg, stopping if returned value is #f
+    `(and ,@(map (lambda (arg) `(,function ,arg)) args)))
+
+  (let ((lst ()))
+    (and-call (lambda (a) (and a (set! lst (cons a lst)))) (+ 1 2) #\a #f (format #t "oops!~%"))
+    (test lst (list #\a 3))))
+
+(let ()
+  (define-macro (add a . b)
+    `(if (null? ',b)
+	 ,a
+	 (+ ,a (add ,@b))))
+  (test (add 1 2 3) 6)
+  (test (add 1 (add 2 3) 4) 10))
+
+(let ()
+  (define mac (let ((var (gensym)))
+		(define-macro (mac-inner b)
+		  `(#_let ((,var 12)) (#_+ ,var ,b)))
+		mac-inner))
+  (test (mac 1) 13)
+  (test (let ((a 1)) (mac a)) 13))
+
+(test (eq? call/cc #_call/cc) #t)
+
+(let ((val #f))
+  (define-macro (add-1 var)
+    `(+ 1 (let ()
+	    (set! val ',var)
+	    ,var)))
+  (define (add-2 var)
+    (set! val var)
+    (+ 1 var))
+  (let ((free #t))
+    (let ((res ((if free add-1 add-2) (+ 1 2 3))))
+      (if (or (not (equal? val '(+ 1 2 3)))
+	      (not (= res 7)))
+	  (format #t ";mac/proc[#t]: ~A ~A~%" val res)))
+    (set! free #f)
+    (let ((res ((if free add-1 add-2) (+ 1 2 3))))
+      (if (or (not (equal? val '6))
+	      (not (= res 7)))
+	  (format #t ";mac/proc[#f]: ~A ~A~%" val res)))))
+
+;; define-macro* default arg expr does not see definition-time closure:
+(test (let ((mac #f))
+	(let ((a 32))
+	  (define-macro* (hi (b (+ a 1))) `(+ ,b 2))
+	  (set! mac hi))
+	(mac))
+      'error) ; ";a: unbound variable, line 4"
+
+(test ((lambda* ((x (let ()
+		      (define-macro (hi a)
+			`(+ ,a 1))
+		      (hi 2))))
+		(+ x 1)))
+      4)
+(test (let ()
+	(define-macro* (hi (x (let ()
+				(define-macro (hi a)
+				  `(+ ,a 1))
+				(hi 2))))
+	  `(+ ,x 1))
+	(hi))
+      4)
+
+(test (let () (define* (hi b) b) (procedure? hi)) #t)
+
+(test (let ()
+	(define (hi a) a)
+	(let ((tag (catch #t
+			  (lambda () (hi 1 2 3))
+			  (lambda args (car args)))))
+	  (eq? tag 'wrong-number-of-args)))
+      #t)
+
+(test (let ()
+	(define (hi a) a)
+	(let ((tag (catch #t
+			  (lambda () (hi))
+			  (lambda args (car args)))))
+	  (eq? tag 'wrong-number-of-args)))
+      #t)
+
+(test (let ()
+	(define* (hi a) a)
+	(let ((tag (catch #t
+			  (lambda () (hi 1 2 3))
+			  (lambda args (car args)))))
+	  (eq? tag 'wrong-number-of-args)))
+      #t)
+
+(let ()
+  ;; shouldn't this be let-if or let-if-and, not if-let?
+  ;;   and why not add short-circuiting to it (at the variable bindings point)?
+  ;;   not pretty, but we could do this via and-call + sublet
+  ;; maybe use and-let* instead
+  (define-macro* (if-let bindings true false)
+    (let* ((binding-list (if (and (pair? bindings) (symbol? (car bindings)))
+			     (list bindings)
+			     bindings))
+	   (variables (map car binding-list)))
+      `(let ,binding-list
+	 (if (and ,@variables)
+	     ,true
+	     ,false))))
+
+  (test (if-let ((a 1) (b 2)) (list a b) "oops") '(1 2)))
+
+(let ()
+  (define-macro (old-and-let* vars . body) ; from guile/1.8/ice-9/and-let-star.scm
+
+  (define (expand vars body)
+    (cond
+     ((null? vars)
+      (if (null? body)
+	  #t
+	  `(begin ,@body)))
+     ((pair? vars)
+      (let ((exp (car vars)))
+        (cond
+         ((pair? exp)
+          (cond
+           ((null? (cdr exp))
+            `(and ,(car exp) ,(expand (cdr vars) body)))
+           (else
+            (let ((var (car exp)))
+              `(let (,exp)
+                 (and ,var ,(expand (cdr vars) body)))))))
+         (else
+          `(and ,exp ,(expand (cdr vars) body))))))
+     (else
+      (error 'wrong-type-arg "not a proper list" vars))))
+
+  (expand vars body))
+
+  (test (old-and-let* ((hi 3) (ho #f)) (+ hi 1)) #f))
+
+(let ()
+  (define-macro (and-let* vars . body)      ; bind vars, if any is #f stop, else evaluate body with those bindings
+    `(let () (and ,@(map (lambda (v) `(define ,@v)) vars) (begin ,@body))))
+
+  (test (and-let* ((hi 3) (ho #f)) (+ hi 1)) #f)
+  (test (and-let* ((hi 3) (ho #t)) (+ hi 1)) 4))
+
+
+(let () ; from the pro CL mailing list
+  (define-macro (do-leaves var tree . body)
+    `(let ()
+       (define (rec ,var)
+	 (if (not (null? ,var))
+	     (if (pair? ,var)
+		 (begin
+		   (rec (car ,var))
+		   (rec (cdr ,var)))
+		 (begin
+		   ,@body))))
+       (rec ,tree)))
+
+  (test (let ((lst ()))
+	  (do-leaves hiho '(+ 1 (* 2 3))
+	    (set! lst (cons hiho lst)))
+	  (reverse lst))
+	'(+ 1 * 2 3)))
+
+(test (let () (define (hi :a) :a) (hi 1)) 'error)
+(test (let () (define* (hi :a) :a) (hi 1)) 'error)
+(test (let () (define* (hi (:a 2)) a) (hi 1)) 'error)
+(test (let () (define* (hi (a 1) (:a 2)) a) (hi 1)) 'error)
+(test (let () (define* (hi (pi 1)) pi) (hi 2)) 'error)
+(test (let () (define* (hi (:b 1) (:a 2)) a) (hi)) 'error)
+
+(test (let () (define* (hi (a 1) (a 2)) a) (hi 2)) 'error)
+(test (let () (define (hi a a) a) (hi 1 2)) 'error)
+(test (let () (define hi (lambda (a a) a)) (hi 1 1)) 'error)
+(test (let () (define hi (lambda* ((a 1) (a 2)) a)) (hi 1 2)) 'error)
+(test (let () (define (hi (a 1)) a) (hi 1)) 'error)
+
+(let ()
+  (define* (hi (a #2d((1 2) (3 4)))) (a 1 0))
+  (test (hi) 3)
+  (test (hi #2d((7 8) (9 10))) 9))
+
+(let () (define* (f :rest a) a) (test (f :a 1) 'error))
+(let () (define* (f :rest a :rest b) (list a b)) (test (f :a 1 :b 2) 'error))
+
+(test (lambda :hi 1) 'error)
+(test (lambda (:hi) 1) 'error)
+(test (lambda (:hi . :hi) 1) 'error)
+(test (lambda (i . i) 1 . 2) 'error)
+(test (lambda (i i i i) (i)) 'error)
+(test (lambda "hi" 1) 'error)
+(test (lambda* ((i 1) i i) i) 'error)
+(test (lambda* ((a 1 2)) a) 'error)
+(test (lambda* ((a . 1)) a) 'error)
+(test (lambda* ((0.0 1)) 0.0) 'error)
+
+(test ((lambda* ((b 3) :rest x (c 1)) (list b c x)) 32) '(32 1 ()))
+(test ((lambda* ((b 3) :rest x (c 1)) (list b c x)) 1 2 3 4 5) '(1 3 (2 3 4 5)))
+;; these are in s7.html
+(test ((lambda* ((a 1) :rest b :rest c) (list a b c)) 1 2 3 4 5) '(1 (2 3 4 5) (3 4 5)))
+(test (let () (define-macro (hi a a) `(+ ,a 1)) (hi 1 2)) 'error)
+(test (let ((c 1)) (define* (a (b c)) b) (set! c 2) (a)) 2)
+(test (let ((c 1)) (define* (a (b c)) b) (let ((c 32)) (a))) 1)
+(test (let ((c 1)) (define* (a (b (+ c 1))) b) (set! c 2) (a)) 3)
+(test (let ((c 1)) (define* (a (b (+ c 1))) b) (set! c 2) (let ((c 123)) (a))) 3)
+
+(test (let* ((cc 1)
+	     (c (lambda () (set! cc (+ cc 1)) cc)))
+	(define* (a (b (c))) b)
+	(list cc (a) cc))
+      (list 1 2 2))
+
+(let ()
+  (define* (func (val ((lambda (a) (+ a 1)) 2))) val)
+  (test (func) 3)
+  (test (func 1) 1))
+
+(let ()
+  (define-macro (mac-free-x y)
+    `(set! x ,y))
+
+  (define (mac-y1)
+    (let ((x .1))
+      (do ((i 0 (+ i 1))
+	   (y 0.5 (+ y x)))
+	  ((= i 10) y)
+	(if (= i 2)
+	    (mac-free-x 1.1)))))
+
+  (define (mac-y0)
+    (let ((x .1))
+      (do ((i 0 (+ i 1))
+	   (y 0.5 (+ y x)))
+	  ((= i 10) y)
+	(if (= i 2)
+	    (set! x 1.1)))))
+
+  (define-macro (mac-free-v)
+    `(v 1))
+
+  (define-macro (set-mac-free-v z)
+    `(vector-set! v 1 ,z))
+
+  (set! (setter mac-free-v) set-mac-free-v)
+
+  (define (mac-y2)
+    (let ((v (vector 1.0 0.1 1.2)))
+      (do ((i 0 (+ i 1))
+	   (y 0.5 (+ y (vector-ref v 1))))
+	  ((= i 10) y)
+	(if (= i 2)
+	    (set! (mac-free-v) 1.1)))))
+
+  (define (mac-y3)
+    (let ((v (vector 1.0 0.1 1.2)))
+      (do ((i 0 (+ i 1))
+	   (y 0.5 (+ y (vector-ref v 1))))
+	  ((= i 10) y)
+	(if (= i 2)
+	    (vector-set! v 1 1.1)))))
+
+  (let ((y0 (mac-y0))
+	(y1 (mac-y1))
+	(y2 (mac-y2))
+	(y3 (mac-y3)))
+    (if (not (equivalent? y0 y1))
+	(format #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) 'mac-y0 y0 y1))
+    (if (not (equivalent? y2 y3))
+	(format #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) 'mac-y2 y2 y3)))
+
+  (let ((y (+ (mac-y0) (mac-y1) (mac-y2) (mac-y3))))
+    (if (> (abs (- y (* 4 9.5))) 1e-9)
+	(format #t "(2) ~A: ~A got ~S but expected ~S~%~%" (port-line-number) 'mac-y0 y (* 4 9.5)))))
+
+(let ((val 0))
+  (let ()
+    (define (f x)
+      (+ x 1))
+    (let ()
+      (define-macro (m x)
+	`(f ,x))
+      (let ()
+	(define (f x)
+	  (* x x))
+	(let ()
+	  (set! val (m 2))))))
+  (test val 4))
+
+(let ((val 0))
+  (let ()
+    (define (f x)
+      (+ x 1))
+    (let ()
+      (define-macro (m x)
+	(with-let (inlet 'f f 'x x)
+	  `(,f ,x)))
+      (let ()
+	(define (f x)
+	  (* x x))
+	(let ()
+	  (set! val (m 2))))))
+  (test val 3))
+
+(define-macro (badmac tst) `(let loop ((x 1)) (if (> x 0) (loop (- x 1)) ,tst)))
+(badmac (vector 0))
+(badmac (let ((x (lambda () 1))) (eq? x x)))
+(define-macro (badmac1 tst) `(let () (define (badf x) (if (> x 0) (badf (- x 1)) ,tst)) (badf 1)))
+(badmac1 (vector 0))
+(badmac1 (let ((x (lambda () 1))) (eq? x x)))
+
+(let () (define-macro* (msym4 :rest a) `(copy ,a))
+  (test (let () (define (func) (with-output-to-string (lambda () (display (msym4 (write and)))))) (func) (func)) "#_and#t")) ; eval_args_no_eval_args bug
+
+(test (catch #t (lambda () (lambda :a 1)) (lambda (type info) (apply format #f info))) "lambda parameter is a constant: (lambda :a ...)")
+(test (catch #t (lambda () (define (f . :a) 1)) (lambda (type info) (apply format #f info))) "lambda parameter is a constant: (define (f . :a) ...)")
+(test (catch #t (lambda () (macro :a 1)) (lambda (type info) (apply format #f info))) "lambda parameter is a constant: (macro :a ...)")
+(test (catch #t (lambda () (bacro :a 1)) (lambda (type info) (apply format #f info))) "lambda parameter is a constant: (bacro :a ...)")
+(test (catch #t (lambda () (define-constant (f . :a) 1)) (lambda (type info) (apply format #f info))) "lambda parameter is a constant: (define-constant (f . :a) ...)")
+(test (catch #t (lambda () (define-macro (f . :a) 1)) (lambda (type info) (apply format #f info))) "lambda parameter is a constant: (define-macro (f . :a) ...)")
+
+(test (catch #t (lambda () (lambda* :a 1)) (lambda (type info) (apply format #f info))) "lambda* parameter is a constant: (lambda* :a ...)")
+(test (catch #t (lambda () (macro* :a 1)) (lambda (type info) (apply format #f info))) "lambda* parameter is a constant: (macro* :a ...)")
+(test (catch #t (lambda () (bacro* :a 1)) (lambda (type info) (apply format #f info))) "lambda* parameter is a constant: (bacro* :a ...)")
+(test (catch #t (lambda () (define-macro* (f . :a) 1)) (lambda (type info) (apply format #f info))) "lambda* parameter is a constant: (define-macro* (f . :a) ...)")
+
+(test (catch #t (lambda () (lambda (a :rest c) 1)) (lambda (type info) (apply format #f info)))  "lambda parameter is :rest? (lambda (a :rest c) ...), perhaps use lambda*")
+(test (catch #t (lambda () (lambda (a :b c) 1)) (lambda (type info) (apply format #f info))) "lambda parameter :b is a constant: (lambda (a :b c) ...)")
+(test (catch #t (lambda () (define (f a :b c) 1)) (lambda (type info) (apply format #f info))) "lambda parameter :b is a constant: (define (f a :b c) ...)")
+(test (catch #t (lambda () (define-macro (f a :b c) 1)) (lambda (type info) (apply format #f info))) "lambda parameter :b is a constant: (define-macro (f a :b c) ...)")
+(test (catch #t (lambda () (macro (f a :b c) 1)) (lambda (type info) (apply format #f info))) "lambda parameter :b is a constant: (macro (f a :b c) ...)")
+
+(test (catch #t (lambda () (lambda* (a :b c) 1)) (lambda (type info) (apply format #f info))) "lambda* parameter :b is a constant: (lambda* (a :b c) ...)")
+(test (catch #t (lambda () (define* (f a :b c) 1)) (lambda (type info) (apply format #f info))) "lambda* parameter :b is a constant: (define* (f a :b c) ...)")
+(test (catch #t (lambda () (define-macro* (f a :b c) 1)) (lambda (type info) (apply format #f info))) "lambda* parameter :b is a constant: (define-macro* (f a :b c) ...)")
+(test (catch #t (lambda () (macro* (f a :b c) 1)) (lambda (type info) (apply format #f info))) "lambda* parameter :b is a constant: (macro* (f a :b c) ...)")
+
+(test (catch #t (lambda () (lambda (a (b 2)) 1)) (lambda (type info) (apply format #f info)))
+      "lambda parameter (b 2) is a pair (perhaps use lambda*?): (lambda (a (b 2)) ...)")
+(test (catch #t (lambda () (lambda (a . a) 1)) (lambda (type info) (apply format #f info))) "lambda parameter a is used twice in the parameter list, (lambda (a . a) ...)")
+(test (catch #t (lambda () (lambda (a b a) 1)) (lambda (type info) (apply format #f info))) "lambda parameter a is used twice in the parameter list, (lambda (a b a) ...)")
+(test (catch #t (lambda () (lambda (a . :b) 1)) (lambda (type info) (apply format #f info))) "lambda :rest parameter :b is a constant in (lambda (a . :b) ...)")
+
+(test (catch #t (lambda () (lambda* ((:a 1)) 1)) (lambda (type info) (apply format #f info))) "lambda* parameter :a is a constant: (lambda* ((:a 1)) ...)")
+(test (catch #t (lambda () (lambda* ((a 1) a) 1)) (lambda (type info) (apply format #f info)))
+      "lambda* parameter a occurs twice in the argument list: (lambda* ((a 1) a) ...)")
+(test (catch #t (lambda () (lambda* ((a)) 1)) (lambda (type info) (apply format #f info))) "lambda* parameter (a) default value missing in (lambda* ((a)) ...)")
+(test (catch #t (lambda () (lambda* ((a . 0.0)) a)) (lambda (type info) (apply format #f info)))
+      "lambda* parameter (a . 0.0) is a dotted pair in (lambda* ((a . 0.0)) ...)")
+(test (catch #t (lambda () (lambda* ((a (quote . -1))) 1)) (lambda (type info) (apply format #f info)))
+      "lambda* parameter (a (quote . -1)) default value is not a proper list in (lambda* ((a (quote . -1))) ...)")
+(test (catch #t (lambda () (lambda* ((a 0.0 'hi)) a)) (lambda (type info) (apply format #f info)))
+      "lambda* parameter (a 0.0 'hi) has multiple default values in (lambda* ((a 0.0 'hi)) ...)")
+
+(test (catch #t (lambda () (lambda* (:allow-other-keys x) 1)) (lambda (type info) (apply format #f info)))
+      ":allow-other-keys should be the last parameter: (lambda* (:allow-other-keys x) ...)")
+(test (catch #t (lambda () (lambda* (:allow-other-keys) 1)) (lambda (type info) (apply format #f info)))
+      ":allow-other-keys can't be the only parameter: (lambda* (:allow-other-keys) ...)")
+(test (catch #t (lambda () (lambda* (pi) 1)) (lambda (type info) (apply format #f info))) "lambda* parameter pi is a constant: (lambda* (pi) ...)")
+(test (catch #t (lambda () (lambda (pi) 1)) (lambda (type info) (apply format #f info))) "lambda parameter pi is a constant: (lambda (pi) ...)")
+(test (catch #t (lambda () (lambda* (a a) 1)) (lambda (type info) (apply format #f info))) "lambda* parameter a is used twice in the parameter list: (lambda* (a a) ...)")
+(test (catch #t (lambda () (lambda* (a . a) 1)) (lambda (type info) (apply format #f info))) "lambda* parameter a is used twice in the parameter list: (lambda* (a . a) ...)")
+(test (catch #t (lambda () (lambda* (:rest) 1)) (lambda (type info) (apply format #f info))) "lambda* :rest parameter missing in (lambda* (:rest) ...)")
+(test (catch #t (lambda () (lambda* (:rest 1) 1)) (lambda (type info) (apply format #f info)))
+      "lambda* :rest parameter is not a symbol: (:rest 1) in (lambda* (:rest 1) ...)")
+(test (catch #t (lambda () (lambda* (:rest '(1 2)) 1)) (lambda (type info) (apply format #f info)))
+      "lambda* :rest parameter can't have a default value: (:rest '(1 2)) in (lambda* (:rest '(1 2)) ...)")
+(test (catch #t (lambda () (lambda* (a :rest pi) 1)) (lambda (type info) (apply format #f info)))
+      "lambda*: pi is immutable, so it can't be the :rest parameter name: (lambda* (a :rest pi) ...)")
+(test (catch #t (lambda () (lambda* (a . 0.0) 1)) (lambda (type info) (apply format #f info))) "lambda* :rest parameter 0.0 is a constant, (lambda* (a . 0.0) ...)")
+(test (catch #t (lambda () (lambda* (a . :b) 1)) (lambda (type info) (apply format #f info))) "lambda* :rest parameter :b is a constant, (lambda* (a . :b) ...)")
+(test (catch #t (lambda () (define f (lambda (a a) 1))) (lambda (type info) (apply format #f info)))
+      "lambda parameter a is used twice in the parameter list, (lambda (a a) ...)")
+(test (catch #t (lambda () (define f (lambda* (a a) 1))) (lambda (type info) (apply format #f info)))
+      "lambda* parameter a is used twice in the parameter list: (lambda* (a a) ...)")
+
+
+;;; --------------------------------------------------------------------------------
+;;; aritable?
+
+(for-each
+ (lambda (arg)
+   (if (aritable? arg 0)
+       (format #t ";(aritable? ~A) -> #t?~%" arg)))
+ (list :hi (integer->char 65) 1 #t 3.14 3/4 1.0+1.0i #\f #<eof> #<unspecified>))
+
+(for-each
+ (lambda (arg)
+   (let ((val (catch #t (lambda () (aritable? abs arg)) (lambda args 'error))))
+     (if (not (eq? val 'error))
+	 (format #t ";(aritable? abs ~A) -> ~A?~%" arg val))))
+ (list :hi (integer->char 65) -1 most-negative-fixnum macroexpand quasiquote (lambda () #f)
+       car #() "hi" (list 1 2) 3.14 3/4 1.0+1.0i #\f #<eof> #<unspecified>))
+
+(test (aritable?) 'error)
+(test (aritable? abs) 'error)
+
+(test (aritable? car 0) #f)
+(test (aritable? car 1) #t)
+(test (aritable? car 2) #f)
+(test (aritable? car 3) #f)
+(test (aritable? car most-negative-fixnum) 'error)
+(test (aritable? car most-positive-fixnum) #f)
+(test (aritable? + most-positive-fixnum) #t)
+(test (aritable? + 0) #t)
+(test (aritable? log 2) #t)
+(test (aritable? catch 2) #f)
+(test (aritable? set! 0) #f)
+(test (aritable? begin 0) #t)
+(test (aritable? (random-state 123) 0) #f)
+(test (aritable? hash-table 1) #f)
+(test (aritable? hash-table 4) #t)
+(test (aritable? weak-hash-table 0) #t)
+(test (aritable? weak-hash-table 2) #t)
+(test (aritable? weak-hash-table 1) #f) ; (weak-hash-table 'b)
+;;; more tests under arity
+
+(test (let () (define-macro (mac1 a b c) `(+ ,a ,b)) (aritable? mac1 2))   #f)
+(test (let () (define-macro (mac1 a b . c) `(+ ,a ,b)) (aritable? mac1 2)) #t)
+(test (let () (define-bacro (mac1 a b c) `(+ ,a ,b)) (aritable? mac1 1))   #f)
+(test (let () (define-bacro (mac1 a b . c) `(+ ,a ,b)) (aritable? mac1 3)) #t)
+;(test (let () (defmacro mac1 (a b c) `(+ ,a ,b)) (aritable? mac1 4))       #f)
+;(test (let () (defmacro mac1 (a b . c) `(+ ,a ,b)) (aritable? mac1 2))     #t)
+(test (let () (define-macro (mac1 a) `(+ 1 ,a)) (aritable? mac1 0))        #f)
+
+(test (let () (define-macro* (mac1 . a) `(+ ,a ,b)) (aritable? mac1 3))    #t)
+(test (let () (define-macro* (mac1 a) `(+ 1 ,a)) (aritable? mac1 0))       #t)
+
+(test (let () (define-macro* (mac1 a :rest b) `(+ 1 ,a)) (aritable? mac1 21)) #t)
+(test (let () (define-macro* (mac1 a . b) `(,a ,@b)) (aritable? mac1 4))   #t)
+(test (let () (define-macro* (mac1 a b c) `(+ ,a ,b)) (aritable? mac1 2))  #t)
+
+(test (aritable? "hiho" 0) #f)
+(test (aritable? "" 1) #f)
+(test (aritable? () 0) #f)
+(test (aritable? #() 1) #f)
+(test (aritable? #(1 2 3) 0) #f)
+(test (aritable? #(1 2 3) -1) 'error)
+(test (aritable? #(1 2 3) 1) #t)
+(test (aritable? #(1 2 3) 2) #f)
+(test (aritable? (hash-table 'a 1) 1) #t)
+(test (aritable? (hash-table 'a 1) 2) #f)
+(test (aritable? (curlet) 1) #t)
+(test (let () (call-with-exit (lambda (goto) (aritable? goto 1)))) #t)
+(test (aritable? (make-iterator (hash-table 'a 1)) 0) #t)
+(test (aritable? (make-iterator (hash-table 'a 1)) 1) #f)
+(test (aritable? "" 0) #f)
+(test (aritable? "12" 2) #f)
+(test (aritable? "12" 1) #t)
+(test (aritable? #() 0) #f) ; since (#() 0) or any other arg is an error
+(test (aritable? #2d((1 2) (3 4)) 0) #f)
+(test (aritable? #2d((1 2) (3 4)) 1) #t)
+(test (aritable? #2d((1 2) (3 4)) 2) #t)
+(test (aritable? #2d((1 2) (3 4)) 3) #f)
+(test (aritable? '((1 2) (3 4)) 2) #f)
+
+(test (aritable? '(1 2 . 3) 9223372036854775806) #f)
+(test (aritable? #2d((1 3) (2 4)) 9223372036854775807) #f)
+(test (aritable? '2 1) #f)
+(test (aritable? ''2 1) #t)
+(let () (define* (f a b) (eq? a b)) (test (aritable? f 2) #t) (test (aritable? f 3) #f)) ; num=args, key+value=1 arg
+
+
+;;; --------------------------------------------------------------------------------
+;;; arity
+
+(test (arity) 'error)
+(test (arity abs 1) 'error)
+
+(for-each
+ (lambda (arg)
+   (if (arity arg)
+       (format #t ";(arity ~A) -> ~A?~%" arg (arity arg))))
+ (list :hi (integer->char 65) 1 #t 3.14 3/4 1.0+1.0i #\f #<eof> #<unspecified> #<undefined> () 'a))
+
+
+#|
+(let ((choices (list "a " "b " " . " ":rest " ":allow-other-keys ")))
+  (define (next-arg expr)
+    (catch #t
+      (lambda ()
+	;(format #t "expr: ~A~%" expr)
+	(let ((func (eval-string expr)))
+	  (let ((min-max (arity func)))
+	    (format #t "(test (arity ~A) ~70T'~A)~%" expr min-max)
+	    (if (> (cdr min-max) 6)
+		(set! (cdr min-max) 6))
+	    (do ((i 0 (+ i 1)))
+		((= i (car min-max)))
+	      (if (aritable? func i)
+		  (format #t ";~A: arity: ~A, arg: ~A?~%" expr min-max i)))
+	    (do ((i (car min-max) (+ i 1)))
+		((> i (cdr min-max)))
+	      (if (not (aritable? func i))
+		  (format #t ";~A: arity: ~A, arg: ~A?~%" expr min-max i)))
+	    (do ((i (+ 1 (cdr min-max)) (+ i 1)))
+		((>= i 6))
+	      (if (aritable? func i)
+		  (format #t ";~A: arity: ~A, arg: ~A?~%" expr min-max i)))
+	    )))
+	(lambda args
+	  ;(format #t "    ~A: ~A~%" expr (apply format #f (cadr args)))
+	  'error)))
+
+  (define (next-choice str n)
+    (next-arg (string-append str ") #f)"))
+    (if (< n 6)
+	(for-each
+	 (lambda (choice)
+	   (next-choice (string-append str choice) (+ n 1)))
+	 choices)))
+
+  (for-each
+   (lambda (choice)
+     (next-arg (string-append "(lambda* " choice "#f)")))
+   choices)
+
+  (next-choice "(lambda* (" 0))
+|#
+
+(test (arity (lambda a a))                                           (cons 0 *max-arity*))
+(test (arity (define (_m_ . a) a))                                   (cons 0 *max-arity*))
+(test (arity (lambda (a . b) a))                                     (cons 1 *max-arity*))
+(test (arity (define (_m_ a . b) a))                                 (cons 1 *max-arity*))
+(test (arity (lambda (a b . c) a))                                   (cons 2 *max-arity*))
+(test (arity (define (_m_ a b . c) a))                               (cons 2 *max-arity*))
+(test (arity (define* (a b . c) a))                                  (cons 0 *max-arity*))
+(test (arity (define-macro (_m_ a . b) a))                           (cons 1 *max-arity*))
+
+(test (arity (lambda* a #f))                                         (cons 0 *max-arity*))
+(test (arity (lambda* () #f))                                        '(0 . 0))
+(test (arity (lambda* (a ) #f))                                      '(0 . 1))
+(test (arity (lambda* (a b ) #f))                                    '(0 . 2))
+(test (arity (lambda* (a b :allow-other-keys ) #f))                  (cons 0 *max-arity*))
+(test (arity (lambda* (a  . b ) #f))                                 (cons 0 *max-arity*))
+(test (arity (lambda* (a :rest b ) #f))                              (cons 0 *max-arity*))
+(test (arity (lambda* (a :rest b :allow-other-keys ) #f))            (cons 0 *max-arity*))
+(test (arity (lambda* (a :allow-other-keys ) #f))                    (cons 0 *max-arity*))
+(test (arity (lambda* (:rest a ) #f))                                (cons 0 *max-arity*))
+(test (arity (lambda* (:rest a b ) #f))                              (cons 0 *max-arity*))
+(test (arity (lambda* (:rest a b :allow-other-keys ) #f))            (cons 0 *max-arity*))
+(test (arity (lambda* (:rest a  . b ) #f))                           (cons 0 *max-arity*))
+(test (arity (lambda* (:rest a :rest b ) #f))                        (cons 0 *max-arity*))
+(test (arity (lambda* (:rest a :rest b :allow-other-keys ) #f))      (cons 0 *max-arity*))
+(test (arity (lambda* (:rest a :allow-other-keys ) #f))              (cons 0 *max-arity*))
+
+(test (arity (define* (__a_ . a) #f))                                (cons 0 *max-arity*))
+(test (arity (define* (__a_) #f))                                    '(0 . 0))
+(test (arity (define* (__a_ a) #f))                                  '(0 . 1))
+(test (arity (define* (__a_ a b) #f))                                '(0 . 2))
+(test (arity (define* (__a_ a b :allow-other-keys) #f))              (cons 0 *max-arity*))
+(test (arity (define* (__a_ a . b) #f))                              (cons 0 *max-arity*))
+(test (arity (define* (__a_ a :rest b) #f))                          (cons 0 *max-arity*))
+(test (arity (define* (__a_ a :rest b :allow-other-keys) #f))        (cons 0 *max-arity*))
+(test (arity (define* (__a_ a :allow-other-keys) #f))                (cons 0 *max-arity*))
+(test (arity (define* (__a_ :rest a) #f))                            (cons 0 *max-arity*))
+(test (arity (define* (__a_ :rest a b) #f))                          (cons 0 *max-arity*))
+(test (arity (define* (__a_ :rest a b :allow-other-keys) #f))        (cons 0 *max-arity*))
+(test (arity (define* (__a_ :rest a . b) #f))                        (cons 0 *max-arity*))
+(test (arity (define* (__a_ :rest a :rest b) #f))                    (cons 0 *max-arity*))
+(test (arity (define* (__a_ :rest a :rest b :allow-other-keys) #f))  (cons 0 *max-arity*))
+(test (arity (define* (__a_ :rest a :allow-other-keys) #f))          (cons 0 *max-arity*))
+
+#|
+(let ((st (symbol-table)))
+  (for-each
+       (lambda (sym)
+	 (if (defined? sym)
+	     (let ((func (symbol->value sym)))
+
+	       (catch #t
+		 (lambda ()
+		   (let ((min-max (arity func)))
+		     (format #t "(test (arity ~A) ~70T'~A)~%" sym min-max)
+		     (if min-max
+			 (begin
+			   (if (> (cdr min-max) 6)
+			       (set! (cdr min-max) 6))
+			   (do ((i 0 (+ i 1)))
+			       ((= i (car min-max)))
+			     (if (aritable? func i)
+				 (format #t ";~A: arity: ~A, arg: ~A?~%" sym min-max i)))
+			   (do ((i (car min-max) (+ i 1)))
+			       ((> i (cdr min-max)))
+			     (if (not (aritable? func i))
+				 (format #t ";~A: arity: ~A, arg: ~A?~%" sym min-max i)))
+			   (do ((i (+ 1 (cdr min-max)) (+ i 1)))
+			       ((>= i 6))
+			     (if (aritable? func i)
+				 (format #t ";~A: arity: ~A, arg: ~A?~%" sym min-max i)))
+			   ))))
+
+		 (lambda args
+		   (format #t "    ~A: ~A~%" sym (apply format #f (cadr args)))
+		   'error)))))
+	     st))
+|#
+
+(unless pure-s7
+  (test (arity set-current-input-port)          '(1 . 1))
+  (test (arity string-fill!)                    '(2 . 4))
+  (test (arity string->list)                    '(1 . 3))
+  (test (arity string-ci<=?)                    (cons 2 *max-arity*))
+  (test (arity string-ci>=?)                    (cons 2 *max-arity*))
+  (test (arity string-ci<?)                     (cons 2 *max-arity*))
+  (test (arity string-ci=?)                     (cons 2 *max-arity*))
+  (test (arity string-ci>?)                     (cons 2 *max-arity*))
+  (test (arity char-ci>?)                       (cons 2 *max-arity*))
+  (test (arity char-ci=?)                       (cons 2 *max-arity*))
+  (test (arity char-ci>=?)                      (cons 2 *max-arity*))
+  (test (arity char-ci<=?)                      (cons 2 *max-arity*))
+  (test (arity char-ci<?)                       (cons 2 *max-arity*))
+  (test (arity vector-fill!)                    '(2 . 4))
+  (test (arity vector->list)                    '(1 . 3)))
+
+(test (arity *)                                 (cons 0 *max-arity*))
+(when (provided? 'autoload)
+  (test (arity *autoload*)                        '(1 . 1))
+  (test (arity *autoload-hook*)                   '(0 . 2)))
+(test (arity *error-hook*)                      '(0 . 2))
+(test (arity *features*)                        (cons 1 *max-arity*))
+(test (arity *function*)                        '(0 . 2))
+(test (arity *load-hook*)                       '(0 . 1))
+(test (arity *missing-close-paren-hook*)        '(0 . 0))
+(test (arity *read-error-hook*)                 '(0 . 2))
+(test (arity *rootlet-redefinition-hook*)       '(0 . 2))
+(test (arity *stderr*)                          '#f)
+(test (arity *stdin*)                           '#f)
+(test (arity *unbound-variable-hook*)           '(0 . 1))
+(test (arity +)                                 (cons 0 *max-arity*))
+(test (arity -)                                 (cons 1 *max-arity*))
+(test (arity /)                                 (cons 1 *max-arity*))
+(test (arity :allow-other-keys)                 '#f)
+(test (arity :rest)                             '#f)
+(test (arity <)                                 (cons 2 *max-arity*))
+(test (arity <=)                                (cons 2 *max-arity*))
+(test (arity =)                                 (cons 2 *max-arity*))
+(test (arity >)                                 (cons 2 *max-arity*))
+(test (arity >=)                                (cons 2 *max-arity*))
+(test (arity abort)                             '(0 . 0))
+(test (arity abs)                               '(1 . 1))
+(test (arity acos)                              '(1 . 1))
+(test (arity acosh)                             '(1 . 1))
+(test (arity and)                               (cons 0 *max-arity*))
+(test (arity angle)                             '(1 . 1))
+(test (arity append)                            (cons 0 *max-arity*))
+(test (arity apply)                             (cons 1 *max-arity*))
+(test (arity apply-values)                      '(0 . 1))
+(test (arity aritable?)                         '(2 . 2))
+(test (arity arity)                             '(1 . 1))
+(test (arity ash)                               '(2 . 2))
+(test (arity asin)                              '(1 . 1))
+(test (arity asinh)                             '(1 . 1))
+(test (arity assoc)                             '(2 . 3))
+(test (arity assq)                              '(2 . 2))
+(test (arity assv)                              '(2 . 2))
+(test (arity atan)                              '(1 . 2))
+(test (arity atanh)                             '(1 . 1))
+(when (provided? 'autoload)
+  (test (arity autoload)                          '(2 . 2)))
+(test (arity begin)                             (cons 0 *max-arity*))
+(test (arity bignum)                            '(1 . 2))
+(test (arity bignum?)                           '(1 . 1))
+(test (arity boolean?)                          '(1 . 1))
+(test (arity byte-vector)                       (cons 0 *max-arity*))
+(test (arity byte-vector->string)               '(1 . 1))
+(test (arity byte-vector-ref)                   (cons 2 *max-arity*))
+(test (arity byte-vector-set!)                  (cons 3 *max-arity*))
+(test (arity byte-vector?)                      '(1 . 1))
+(test (arity byte?)                             '(1 . 1))
+(test (arity c-object-type)                     '(1 . 1))
+(test (arity c-object?)                         '(1 . 1))
+(test (arity c-pointer)                         '(1 . 5))
+(test (arity c-pointer->list)                   '(1 . 1))
+(test (arity c-pointer-info)                    '(1 . 1))
+(test (arity c-pointer-type)                    '(1 . 1))
+(test (arity c-pointer-weak1)                   '(1 . 1))
+(test (arity c-pointer-weak2)                   '(1 . 1))
+(test (arity c-pointer?)                        '(1 . 2))
+(test (arity caaaar)                            '(1 . 1))
+(test (arity caaadr)                            '(1 . 1))
+(test (arity caaar)                             '(1 . 1))
+(test (arity caadar)                            '(1 . 1))
+(test (arity caaddr)                            '(1 . 1))
+(test (arity caadr)                             '(1 . 1))
+(test (arity caar)                              '(1 . 1))
+(test (arity cadaar)                            '(1 . 1))
+(test (arity cadadr)                            '(1 . 1))
+(test (arity cadar)                             '(1 . 1))
+(test (arity caddar)                            '(1 . 1))
+(test (arity cadddr)                            '(1 . 1))
+(test (arity caddr)                             '(1 . 1))
+(test (arity cadr)                              '(1 . 1))
+(test (arity call-with-current-continuation)    '(1 . 1))
+(test (arity call-with-exit)                    '(1 . 1))
+(test (arity call-with-input-file)              '(2 . 2))
+(test (arity call-with-input-string)            '(2 . 2))
+(test (arity call-with-output-file)             '(2 . 2))
+(test (arity call-with-output-string)           '(1 . 1))
+(test (arity call-with-values)                  '(2 . 2))
+(test (arity call/cc)                           '(1 . 1))
+(test (arity car)                               '(1 . 1))
+(test (arity case)                              (cons 2 *max-arity*))
+(test (arity catch)                             '(3 . 3))
+(test (arity cdaaar)                            '(1 . 1))
+(test (arity cdaadr)                            '(1 . 1))
+(test (arity cdaar)                             '(1 . 1))
+(test (arity cdadar)                            '(1 . 1))
+(test (arity cdaddr)                            '(1 . 1))
+(test (arity cdadr)                             '(1 . 1))
+(test (arity cdar)                              '(1 . 1))
+(test (arity cddaar)                            '(1 . 1))
+(test (arity cddadr)                            '(1 . 1))
+(test (arity cddar)                             '(1 . 1))
+(test (arity cdddar)                            '(1 . 1))
+(test (arity cddddr)                            '(1 . 1))
+(test (arity cdddr)                             '(1 . 1))
+(test (arity cddr)                              '(1 . 1))
+(test (arity cdr)                               '(1 . 1))
+(test (arity ceiling)                           '(1 . 1))
+(test (arity char->integer)                     '(1 . 1))
+(test (arity char-alphabetic?)                  '(1 . 1))
+(test (arity char-downcase)                     '(1 . 1))
+(test (arity char-lower-case?)                  '(1 . 1))
+(test (arity char-numeric?)                     '(1 . 1))
+(test (arity char-position)                     '(2 . 3))
+(test (arity char-ready?)                       '(0 . 1))
+(test (arity char-upcase)                       '(1 . 1))
+(test (arity char-upper-case?)                  '(1 . 1))
+(test (arity char-whitespace?)                  '(1 . 1))
+(test (arity char<=?)                           (cons 2 *max-arity*))
+(test (arity char<?)                            (cons 2 *max-arity*))
+(test (arity char=?)                            (cons 2 *max-arity*))
+(test (arity char>=?)                           (cons 2 *max-arity*))
+(test (arity char>?)                            (cons 2 *max-arity*))
+(test (arity char?)                             '(1 . 1))
+(test (arity close-input-port)                  '(1 . 1))
+(test (arity close-output-port)                 '(1 . 1))
+(test (arity complex)                           '(2 . 2))
+(test (arity complex?)                          '(1 . 1))
+(test (arity cond)                              (cons 1 *max-arity*))
+(test (arity cond-expand)                       (cons 0 *max-arity*))
+(test (arity cons)                              '(2 . 2))
+(test (arity constant?)                         '(1 . 1))
+(test (arity continuation?)                     '(1 . 1))
+(test (arity copy)                              '(1 . 4))
+(test (arity cos)                               '(1 . 1))
+(test (arity cosh)                              '(1 . 1))
+(test (arity coverlet)                          '(1 . 1))
+(test (arity curlet)                            '(0 . 0))
+(test (arity current-error-port)                '(0 . 0))
+(test (arity current-input-port)                '(0 . 0))
+(test (arity current-output-port)               '(0 . 0))
+(test (arity cutlet)                            (cons 2 *max-arity*))
+(test (arity cyclic-sequences)                  '(1 . 1))
+(test (arity define)                            (cons 2 *max-arity*))
+(test (arity define*)                           (cons 2 *max-arity*))
+(test (arity define-bacro)                      (cons 2 *max-arity*))
+(test (arity define-bacro*)                     (cons 2 *max-arity*))
+(test (arity define-constant)                   (cons 2 *max-arity*))
+(test (arity define-expansion)                  (cons 2 *max-arity*))
+(test (arity define-expansion*)                 (cons 2 *max-arity*))
+(test (arity define-macro)                      (cons 2 *max-arity*))
+(test (arity define-macro*)                     (cons 2 *max-arity*))
+(test (arity defined?)                          '(1 . 3))
+(test (arity delete-file)                       '(1 . 1))
+(test (arity denominator)                       '(1 . 1))
+(test (arity dilambda)                          '(2 . 2))
+(test (arity dilambda?)                         '(1 . 1))
+(test (arity directory->list)                   '(1 . 1))
+(test (arity directory?)                        '(1 . 1))
+(test (arity display)                           '(1 . 2))
+(test (arity do)                                (cons 2 *max-arity*))
+(test (arity documentation)                     '(1 . 1))
+(test (arity dynamic-unwind)                    '(2 . 2))
+(test (arity dynamic-wind)                      '(3 . 3))
+(test (arity else)                              '#f)
+(test (arity emergency-exit)                    '(0 . 1))
+(test (arity eof-object?)                       '(1 . 1))
+(test (arity eq?)                               '(2 . 2))
+(test (arity equal?)                            '(2 . 2))
+(test (arity equivalent?)                       '(2 . 2))
+(test (arity eqv?)                              '(2 . 2))
+(test (arity error)                             (cons 1 *max-arity*))
+(test (arity eval)                              '(1 . 2))
+(test (arity eval-string)                       '(1 . 2))
+(test (arity even?)                             '(1 . 1))
+(test (arity exact->inexact)                    '(1 . 1))
+(test (arity exact?)                            '(1 . 1))
+(test (arity exit)                              '(0 . 1))
+(test (arity exp)                               '(1 . 1))
+(test (arity expt)                              '(2 . 2))
+(test (arity file-exists?)                      '(1 . 1))
+(test (arity file-mtime)                        '(1 . 1))
+(test (arity fill!)                             '(2 . 4))
+(test (arity float-vector)                      (cons 0 *max-arity*))
+(test (arity float-vector-ref)                  (cons 2 *max-arity*))
+(test (arity float-vector-set!)                 (cons 3 *max-arity*))
+(test (arity float-vector?)                     '(1 . 1))
+(test (arity float?)                            '(1 . 1))
+(test (arity floor)                             '(1 . 1))
+(test (arity flush-output-port)                 '(0 . 1))
+(test (arity for-each)                          (cons 2 *max-arity*))
+(test (arity format)                            (cons 2 *max-arity*))
+(test (arity funclet)                           '(1 . 1))
+(test (arity funclet?)                          '(1 . 1))
+(test (arity gc)                                '(0 . 1))
+(test (arity gcd)                               (cons 0 *max-arity*))
+(test (arity gensym)                            '(0 . 1))
+(test (arity gensym?)                           '(1 . 1))
+(test (arity get-output-string)                 '(1 . 2))
+(test (arity getenv)                            '(1 . 1))
+(test (arity goto?)                             '(1 . 1))
+(test (arity hash-code)                         '(1 . 2))
+(test (arity hash-table)                        (cons 0 *max-arity*))
+(test (arity hash-table-entries)                '(1 . 1))
+(test (arity hash-table-key-typer)              '(1 . 1))
+(test (arity hash-table-ref)                    (cons 2 *max-arity*))
+(test (arity hash-table-set!)                   '(3 . 3))
+(test (arity hash-table-value-typer)            '(1 . 1))
+(test (arity hash-table?)                       '(1 . 1))
+(test (arity help)                              '(1 . 1))
+(test (arity hook-functions)                    '(1 . 1))
+(test (arity if)                                '(2 . 3))
+(test (arity imag-part)                         '(1 . 1))
+(test (arity immutable!)                        '(1 . 2))
+(test (arity immutable?)                        '(1 . 2))
+(test (arity inexact->exact)                    '(1 . 1))
+(test (arity inexact?)                          '(1 . 1))
+(test (arity infinite?)                         '(1 . 1))
+(test (arity inlet)                             (cons 0 *max-arity*))
+(test (arity input-port?)                       '(1 . 1))
+(test (arity int-vector)                        (cons 0 *max-arity*))
+(test (arity int-vector-ref)                    (cons 2 *max-arity*))
+(test (arity int-vector-set!)                   (cons 3 *max-arity*))
+(test (arity int-vector?)                       '(1 . 1))
+(test (arity integer->char)                     '(1 . 1))
+(test (arity integer-decode-float)              '(1 . 1))
+(test (arity integer-length)                    '(1 . 1))
+(test (arity integer?)                          '(1 . 1))
+(test (arity iterate)                           '(1 . 1))
+(test (arity iterator-at-end?)                  '(1 . 1))
+(test (arity iterator-sequence)                 '(1 . 1))
+(test (arity iterator?)                         '(1 . 1))
+(test (arity keyword->symbol)                   '(1 . 1))
+(test (arity keyword?)                          '(1 . 1))
+(test (arity lambda)                            (cons 2 *max-arity*))
+(test (arity lambda*)                           (cons 2 *max-arity*))
+(test (arity lcm)                               (cons 0 *max-arity*))
+(test (arity length)                            '(1 . 1))
+(test (arity let)                               (cons 2 *max-arity*))
+(test (arity let*)                              (cons 2 *max-arity*))
+(test (arity let->list)                         '(1 . 1))
+(test (arity let-ref)                           '(2 . 2))
+(test (arity let-set!)                          '(3 . 3))
+(test (arity let?)                              '(1 . 1))
+(test (arity letrec)                            (cons 2 *max-arity*))
+(test (arity letrec*)                           (cons 2 *max-arity*))
+(test (arity list)                              (cons 0 *max-arity*))
+(test (arity list->string)                      '(1 . 1))
+(test (arity list->vector)                      '(1 . 1))
+(test (arity list-ref)                          (cons 2 *max-arity*))
+(test (arity list-set!)                         (cons 3 *max-arity*))
+(test (arity list-tail)                         '(2 . 2))
+(test (arity list-values)                       (cons 0 *max-arity*))
+(test (arity list?)                             '(1 . 1))
+(test (arity load)                              '(1 . 2))
+(test (arity log)                               '(1 . 2))
+(test (arity logand)                            (cons 0 *max-arity*))
+(test (arity logbit?)                           '(2 . 2))
+(test (arity logior)                            (cons 0 *max-arity*))
+(test (arity lognot)                            '(1 . 1))
+(test (arity logxor)                            (cons 0 *max-arity*))
+(test (arity macro?)                            '(1 . 1))
+(test (arity macroexpand)                       '(1 . 1))
+(test (arity magnitude)                         '(1 . 1))
+(test (arity make-byte-vector)                  '(1 . 2))
+(test (arity make-float-vector)                 '(1 . 2))
+(test (arity make-hash-table)                   '(0 . 3))
+(test (arity make-hook)                         (cons 0 *max-arity*))
+(test (arity make-int-vector)                   '(1 . 2))
+(test (arity make-iterator)                     '(1 . 2))
+(test (arity make-list)                         '(1 . 2))
+(test (arity make-polar)                        '(2 . 2))
+(test (arity make-rectangular)                  '(2 . 2))
+(test (arity make-string)                       '(1 . 2))
+(test (arity make-vector)                       '(1 . 3))
+(test (arity make-weak-hash-table)              '(0 . 3))
+(test (arity map)                               (cons 2 *max-arity*))
+(test (arity max)                               (cons 1 *max-arity*))
+(test (arity member)                            '(2 . 3))
+(test (arity memq)                              '(2 . 2))
+(test (arity memv)                              '(2 . 2))
+(test (arity min)                               (cons 1 *max-arity*))
+(test (arity modulo)                            '(2 . 2))
+(test (arity most-negative-fixnum)              '#f)
+(test (arity most-positive-fixnum)              '#f)
+(test (arity multiple-value-bind)               (cons 2 *max-arity*))
+(test (arity nan?)                              '(1 . 1))
+(test (arity negative?)                         '(1 . 1))
+(test (arity newline)                           '(0 . 1))
+(test (arity not)                               '(1 . 1))
+(test (arity null?)                             '(1 . 1))
+(test (arity number->string)                    '(1 . 2))
+(test (arity number?)                           '(1 . 1))
+(test (arity numerator)                         '(1 . 1))
+(test (arity object->let)                       '(1 . 1))
+(test (arity object->string)                    '(1 . 3))
+(test (arity odd?)                              '(1 . 1))
+(test (arity open-input-file)                   '(1 . 2))
+(test (arity open-input-function)               '(1 . 1))
+(test (arity open-input-string)                 '(1 . 1))
+(test (arity open-output-file)                  '(1 . 2))
+(test (arity open-output-function)              '(1 . 1))
+(test (arity open-output-string)                '(0 . 0))
+(test (arity openlet)                           '(1 . 1))
+(test (arity openlet?)                          '(1 . 1))
+(test (arity or)                                (cons 0 *max-arity*))
+(test (arity outlet)                            '(1 . 1))
+(test (arity output-port?)                      '(1 . 1))
+(test (arity owlet)                             '(0 . 0))
+(test (arity pair-filename)                     '(1 . 1))
+(test (arity pair-line-number)                  '(1 . 1))
+(test (arity pair?)                             '(1 . 1))
+(test (arity peek-char)                         '(0 . 1))
+(test (arity pi)                                '#f)
+(test (arity port-closed?)                      '(1 . 1))
+(test (arity port-file)                         '(1 . 1))
+(test (arity port-filename)                     '(0 . 1))
+(test (arity port-line-number)                  '(0 . 1))
+(test (arity port-string)                       '(1 . 1))
+(test (arity port-position)                     '(1 . 1))
+(test (arity positive?)                         '(1 . 1))
+(test (arity procedure-source)                  '(1 . 1))
+(test (arity procedure-arglist)                 '(1 . 1))
+(test (arity procedure?)                        '(1 . 1))
+(test (arity profile-in)                        '(2 . 2))
+(test (arity proper-list?)                      '(1 . 1))
+(test (arity provide)                           '(1 . 1))
+(test (arity provided?)                         '(1 . 1))
+(test (arity quasiquote)                        '(1 . 1))
+(test (arity quote)                             '(1 . 1))
+(test (arity quotient)                          '(2 . 2))
+(test (arity random)                            '(1 . 2))
+(test (arity random-state)                      (if with-bignums '(0 . 1) '(0 . 2)))
+(test (arity random-state->list)                '(0 . 1))
+(test (arity random-state?)                     '(1 . 1))
+(test (arity rational?)                         '(1 . 1))
+(test (arity rationalize)                       '(1 . 2))
+(test (arity read)                              '(0 . 1))
+(test (arity read-byte)                         '(0 . 1))
+(test (arity read-char)                         '(0 . 1))
+(test (arity read-line)                         '(0 . 2))
+(test (arity read-string)                       '(1 . 2))
+(test (arity reader-cond)                       (cons 0 *max-arity*))
+(test (arity real-part)                         '(1 . 1))
+(test (arity real?)                             '(1 . 1))
+(test (arity remainder)                         '(2 . 2))
+(test (arity require)                           (cons 1 *max-arity*))
+(test (arity reverse!)                          '(1 . 1))
+(test (arity reverse)                           '(1 . 1))
+(test (arity rootlet)                           '(0 . 0))
+(test (arity round)                             '(1 . 1))
+(test (arity s7-optimize)                       '(1 . 1))
+(test (arity sequence?)                         '(1 . 1))
+(test (arity set!)                              '(2 . 2))
+(test (arity set-car!)                          '(2 . 2))
+(test (arity set-cdr!)                          '(2 . 2))
+(test (arity set-current-error-port)            '(1 . 1))
+(test (arity set-current-output-port)           '(1 . 1))
+(test (arity setter)                            '(1 . 2))
+(test (arity signature)                         '(1 . 1))
+(test (arity sin)                               '(1 . 1))
+(test (arity sinh)                              '(1 . 1))
+(test (arity sort!)                             '(2 . 2))
+(test (arity sqrt)                              '(1 . 1))
+(test (arity stacktrace)                        '(0 . 5))
+(test (arity string)                            (cons 0 *max-arity*))
+(test (arity string->byte-vector)               '(1 . 1))
+(test (arity string->keyword)                   '(1 . 1))
+(test (arity string->number)                    '(1 . 2))
+(test (arity string->symbol)                    '(1 . 1))
+(test (arity string-append)                     (cons 0 *max-arity*))
+(test (arity string-copy)                       '(1 . 4))
+(test (arity string-downcase)                   '(1 . 1))
+(test (arity string-length)                     '(1 . 1))
+(test (arity string-position)                   '(2 . 3))
+(test (arity string-ref)                        '(2 . 2))
+(test (arity string-set!)                       '(3 . 3))
+(test (arity string-upcase)                     '(1 . 1))
+(test (arity string<=?)                         (cons 2 *max-arity*))
+(test (arity string<?)                          (cons 2 *max-arity*))
+(test (arity string=?)                          (cons 2 *max-arity*))
+(test (arity string>=?)                         (cons 2 *max-arity*))
+(test (arity string>?)                          (cons 2 *max-arity*))
+(test (arity string?)                           '(1 . 1))
+(test (arity sublet)                            (cons 1 *max-arity*))
+(test (arity substring)                         '(1 . 3))
+(test (arity substring-uncopied)                '(1 . 3))
+(test (arity subvector)                         '(1 . 4))
+(test (arity subvector-position)                '(1 . 1))
+(test (arity subvector-vector)                  '(1 . 1))
+(test (arity subvector?)                        '(1 . 1))
+(test (arity symbol)                            (cons 1 *max-arity*))
+(test (arity symbol->dynamic-value)             '(1 . 1))
+(test (arity symbol-initial-value)              '(1 . 1))
+(test (arity symbol->keyword)                   '(1 . 1))
+(test (arity symbol->string)                    '(1 . 1))
+(test (arity symbol->value)                     '(1 . 2))
+(test (arity symbol-table)                      '(0 . 0))
+(test (arity symbol?)                           '(1 . 1))
+(test (arity syntax?)                           '(1 . 1))
+(test (arity system)                            '(1 . 2))
+(test (arity tan)                               '(1 . 1))
+(test (arity tanh)                              '(1 . 1))
+(test (arity throw)                             (cons 1 *max-arity*))
+(test (arity tree-count)                        '(2 . 3))
+(test (arity tree-cyclic?)                      '(1 . 1))
+(test (arity tree-leaves)                       '(1 . 1))
+(test (arity tree-memq)                         '(2 . 2))
+(test (arity tree-set-memq)                     '(2 . 2))
+(test (arity truncate)                          '(1 . 1))
+(test (arity type-of)                           '(1 . 1))
+(test (arity undefined?)                        '(1 . 1))
+(test (arity unlet)                             '(0 . 0))
+(test (arity unspecified?)                      '(1 . 1))
+(test (arity values)                            (cons 0 *max-arity*))
+(test (arity varlet)                            (cons 2 *max-arity*))
+(test (arity vector)                            (cons 0 *max-arity*))
+(test (arity vector-append)                     (cons 0 *max-arity*))
+(test (arity vector-dimension)                  '(2 . 2))
+(test (arity vector-dimensions)                 '(1 . 1))
+(test (arity vector-length)                     '(1 . 1))
+(test (arity vector-rank)                       '(1 . 1))
+(test (arity vector-ref)                        (cons 2 *max-arity*))
+(test (arity vector-set!)                       (cons 3 *max-arity*))
+(test (arity vector-typer)                      '(1 . 1))
+(test (arity vector?)                           '(1 . 1))
+(test (arity weak-hash-table)                   (cons 0 *max-arity*))
+(test (arity weak-hash-table?)                  '(1 . 1))
+(test (arity with-baffle)                       (cons 0 *max-arity*)) ; (with-baffle) -> ()
+(test (arity with-input-from-file)              '(2 . 2))
+(test (arity with-input-from-string)            '(2 . 2))
+(test (arity with-let)                          (cons 1 *max-arity*))
+(test (arity with-output-to-file)               '(2 . 2))
+(test (arity with-output-to-string)             '(1 . 1))
+(test (arity write)                             '(1 . 2))
+(test (arity write-byte)                        '(1 . 2))
+(test (arity write-char)                        '(1 . 2))
+(test (arity write-string)                      '(1 . 4))
+(test (arity zero?)                             '(1 . 1))
+
+(test (let () (define-macro (mac1 a b c) `(+ ,a ,b)) (arity mac1))   '(3 . 3))
+(test (let () (define-macro (mac1 a b . c) `(+ ,a ,b)) (arity mac1)) (cons 2 *max-arity*))
+(test (let () (define-bacro (mac1 a b c) `(+ ,a ,b)) (arity mac1))   '(3 . 3))
+(test (let () (define-bacro (mac1 a b . c) `(+ ,a ,b)) (arity mac1)) (cons 2 *max-arity*))
+;(test (let () (defmacro mac1 (a b c) `(+ ,a ,b)) (arity mac1))       '(3 . 3))
+;(test (let () (defmacro mac1 (a b . c) `(+ ,a ,b)) (arity mac1))     (cons 2 *max-arity*))
+(test (let () (define-macro (mac1 a) `(+ 1 ,a)) (arity mac1))        '(1 . 1))
+
+(test (let () (define-macro* (mac1 . a) `(+ ,a ,b)) (arity mac1))    (cons 0 *max-arity*))
+(test (let () (define-macro* (mac1 a) `(+ 1 ,a)) (arity mac1))       '(0 . 1))
+
+(test (let () (define-macro* (mac1 a :rest b) `(+ 1 ,a)) (arity mac1)) (cons 0 *max-arity*))
+(test (let () (define-macro* (mac1 a . b) `(,a ,@b)) (arity mac1))   (cons 0 *max-arity*))
+(test (let () (define-macro* (mac1 a b c) `(+ ,a ,b)) (arity mac1))  '(0 . 3))
+
+(test (arity "hiho") '(1 . 1))
+(test (arity "") #f)
+(test (arity ()) #f)
+(test (arity #()) #f)
+(test (arity #i()) #f)
+(test (arity #(1 2 3)) (cons 1 *max-arity*))
+(test (arity #u(1 2 3)) (cons 1 1))
+(test (arity #r(1 2 3)) (cons 1 1))
+(test (arity #r2d((1 2) (3 4))) (cons 1 2))
+(test (arity (hash-table 'a 1)) (cons 1 *max-arity*))
+(test (arity (curlet)) '(1 . 1))
+(test (let () (call-with-exit (lambda (goto) (arity goto)))) (cons 0 *max-arity*))
+(test (arity (make-iterator (hash-table 'a 1))) (cons 0 0))
+(test (arity (let ((a 1)) (make-iterator (curlet)))) (cons 0 0))
+(test (arity (random-state 123)) #f)
+
+(when with-block
+  (test (procedure? _c_obj_) #t)
+  (test (procedure? (setter _c_obj_)) #t)
+  (test (signature _c_obj_) '(#t block? integer?))
+  (test (documentation _c_obj_) "")
+  (test (procedure-source _c_obj_) ())
+  (test (arity _c_obj_) (cons 1 1))
+  (test (aritable? _c_obj_ 1) #t)
+  (test (aritable? _c_obj_ 0) #f)
+  (test (aritable? _c_obj_ 2) #f))
+
+(define (for-each-subset func args)
+  (define (subset source dest len)
+    (if (null? source)
+	(if (aritable? func len)
+	    (apply func dest))
+	(begin
+	  (subset (cdr source) (cons (car source) dest) (+ len 1))
+	  (subset (cdr source) dest len))))
+    (subset args () 0))
+#|
+(define (for-each-subset func args)
+  (let ((subsets ()))
+    (define (subset source dest len)
+      (if (null? source)
+	  (begin
+	    (if (member dest subsets)
+		(format #t ";got ~S twice in for-each-subset: ~S~%" dest args))
+	    (set! subsets (cons dest subsets))
+	    (if (aritable? func len)
+		(apply func dest)))
+	  (begin
+	    (subset (cdr source) (cons (car source) dest) (+ len 1))
+	    (subset (cdr source) dest len))))
+    (subset args () 0)))
+|#
+
+(test (let ((ctr 0)) (for-each-subset (lambda args (set! ctr (+ ctr 1))) '(1 2 3 4)) ctr) 16)
+(test (let ((ctr 0)) (for-each-subset (lambda (arg) (set! ctr (+ ctr 1))) '(1 2 3 4)) ctr) 4)
+(test (let ((ctr 0)) (for-each-subset (lambda (arg1 arg2 arg3) (set! ctr (+ ctr 1))) '(1 2 3 4)) ctr) 4)
+(test (let ((ctr 0)) (for-each-subset (lambda* (arg1 arg2 arg3) (set! ctr (+ ctr 1))) '(1 2 3 4)) ctr) 15)
+(test (let ((ctr 0)) (for-each-subset (lambda () (set! ctr (+ ctr 1))) '(1 2 3 4)) ctr)  1)
+
+;; from stackoverflow scheme
+(let ()
+  (define (power-set set)
+    (if (null? set)
+        '(())
+        (let ((power-set-of-rest (power-set (cdr set))))
+	  (append power-set-of-rest
+		  (map (lambda (subset)
+		         (cons (car set) subset))
+		       power-set-of-rest)))))
+
+  (define (for-each-powerset f s)
+    (for-each (lambda (lst) (apply f lst)) (power-set s)))
+
+  (test (let ((sum 0)) (for-each-powerset (lambda args (set! sum (apply + sum args)))  '(1)) sum) 1)
+  (test (let ((sum 0)) (for-each-powerset (lambda args (set! sum (apply + sum args)))  '(1 2)) sum) 6)
+  (test (let ((sum 0)) (for-each-powerset (lambda args (set! sum (apply + sum args)))  '(1 2 3)) sum) 24))
+
+
+(define (snarf func lst)
+  ;; (snarf func lst) repeatedly applies func to as many elements of lst as func can take
+  (let ((arity (arity func)))
+    (if (> (cdr arity) 100)
+	(apply func lst)
+	(let ((n (cdr arity))
+	      (lst-len (length lst)))
+	  (if (< lst-len (car arity))
+	      (error 'wrong-number-of-args ";snarf func requires ~A args, but got ~A, ~A" (car arity) lst-len lst)
+	      (if (<= lst-len n)
+		  (apply func lst)
+		  (if (not (zero? (modulo (length lst) n)))
+		      (error 'wrong-number-of-args ";snarf will take ~A args at a time, but got ~A in ~A" n lst-len lst)
+		      ;; ideally this would accept partial lists (i.e. left-over < req),
+		      ;;   but then we also need to notice that case in the list-tail below
+		      (let ()
+
+			(define (snarf-1 len f args)
+			  (if (not (null? args))
+			      (let* ((last (list-tail args (- len 1)))
+				     (rest (cdr last)))
+				(dynamic-wind
+				    (lambda ()
+				      (set! (cdr last) ()))
+				    (lambda ()
+				      (apply func args))
+				    (lambda ()
+				      (set! (cdr last) rest)))
+				(snarf-1 len f rest))))
+
+			(snarf-1 n func lst)))))))))
+
+(test (let ((lst '(1 2 3 4))) (catch #t (lambda () (snarf (lambda (a b) (format #t "~A ~A~%" a b c)) lst)) (lambda args 'error)) lst) '(1 2 3 4))
+(test (snarf (lambda (a b) (format #t "~A ~A~%" a b)) '(1 2 3 4 5)) 'error)
+(test (snarf (lambda (a b) (format #t "~A ~A~%" a b)) '(1)) 'error)
+(test (let ((x 0)) (snarf (lambda (a) (set! x (+ x a))) '(1 2 3)) x) 6)
+(test (let ((x 0)) (snarf (lambda (a b) (set! x (+ x a b))) '(1 2 3 4)) x) 10)
+(test (let ((x 0)) (snarf (lambda* (a b) (set! x (+ x a b))) '(1 2 3 4)) x) 10)
+(test (let ((x 0)) (snarf (lambda a (set! x (apply + a))) '(1 2 3 4)) x) 10)
+(test (let ((x 0)) (snarf (lambda* (a b (c 0)) (set! x (+ x a b c))) '(1 2)) x) 3)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; procedure-arglist
+
+(for-each
+ (lambda (arg)
+   (test (procedure-arglist arg) 'error))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi :hi #(()) (list 1 2 3) '(1 . 2) "hi"))
+
+(test (procedure-arglist) 'error)
+(test (procedure-arglist abs abs) 'error)
+(test (procedure-arglist quasiquote) 'error)
+(test (procedure-arglist abs) 'error) ; should be fixed
+(test (procedure-arglist (lambda a a)) 'a)
+(test (procedure-arglist (lambda (a) a)) '(a))
+(test (procedure-arglist (lambda* (a (b 1)) a)) '(a (b 1)))
+(test (procedure-arglist (macro a a)) 'a)
+(test (procedure-arglist (macro (a) a)) '(a))
+(test (procedure-arglist (macro* (a (b 1)) a)) '(a (b 1)))
+(test (procedure-arglist (bacro a a)) 'a)
+(test (procedure-arglist (bacro (a) a)) '(a))
+(test (procedure-arglist (bacro* (a (b 1)) a)) '(a (b 1)))
+
+
+;;; --------------------------------------------------------------------------------
+;;; procedure-source
+
+(for-each
+ (lambda (arg)
+   (eval-string (format #f "(define (func) ~S)" arg))
+   (let ((source (procedure-source func)))
+     (let ((val (func)))
+       (test val arg))))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) ':hi "hi"))
+
+(for-each
+ (lambda (arg)
+   (test (procedure-source arg) 'error))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi :hi #(()) (list 1 2 3) '(1 . 2) "hi"))
+
+(when (zero? (*s7* 'debug)) (test (let ((hi (lambda (x) (+ x 1)))) (procedure-source hi)) '(lambda (x) (+ x 1))))
+(test (procedure-source) 'error)
+(test (procedure-source abs abs) 'error)
+(test (procedure-source quasiquote) ())
+(test (procedure-source abs) ())
+;(test (let () (define-macro (hi a) `(+ 1 ,a)) (cadr (caddr (procedure-source hi)))) '(lambda (a) (list-values '+ 1 a)))
+
+(let ()
+  (define (hi a) (+ a x))
+  (test ((apply let '((x 32)) (list (procedure-source hi))) 12) 44))
+;; i.e. make a closure from (let ((x 32)) <procedure-source hi>)
+
+(let ()
+  (define (arg-info f n)
+    ((procedure-source f) 1 n 1 0 2)) ; get the documentation string of f's n-th argument
+
+  (define* (add-1 (arg ((lambda () "arg should be an integer" 0))))
+    (+ arg 1))          ; the default value of arg is 0
+
+  (test (add-1) 1)
+  (test (add-1 1) 2)
+
+  (test (arg-info add-1 0) "arg should be an integer"))
+
+(test (object->string (procedure-source (lambda (a . b) (cons a b))))        "(lambda (a . b) (cons a b))")
+(test (object->string (procedure-source (lambda* ((a 3) (b 4)) (cons a b)))) "(lambda* ((a 3) (b 4)) (cons a b))")
+(test (object->string (procedure-source (macro (a . b) (cons a b))))         "(macro (a . b) (cons a b))")
+(test (object->string (procedure-source (macro* ((a 3) (b 4)) (cons a b))))  "(macro* ((a 3) (b 4)) (cons a b))")
+(test (object->string (procedure-source (bacro (a . b) (cons a b))))         "(bacro (a . b) (cons a b))")
+(test (object->string (procedure-source (bacro* ((a 3) (b 4)) (cons a b))))  "(bacro* ((a 3) (b 4)) (cons a b))")
+
+(test (catch #t (lambda () (apply (lambda (a) (+ a 1)) (list 1 2 3))) (lambda (t i) (apply format #f i)))
+      "(lambda (a) (+ a 1)): too many arguments: ((lambda (a) ...) 1 2 3)")
+(test (catch #t (lambda () (apply (macro (a) `(+ ,a 1)) (list 1 2 3))) (lambda (t i) (apply format #f i)))
+      "(macro (a) (list-values '+ a 1)): too many arguments: ((macro (a) ...) 1 2 3)")
+(test (catch #t (lambda () (apply (bacro (a) `(+ ,a 1)) (list 1 2 3))) (lambda (t i) (apply format #f i)))
+      "(bacro (a) (list-values '+ a 1)): too many arguments: ((bacro (a) ...) 1 2 3)")
+(test (catch #t (lambda () (apply (lambda* (a) (+ a 1)) (list 1 2 3))) (lambda (t i) (apply format #f i)))
+      "too many arguments: (lambda* (a) ...) 1 2 3)")
+(test (catch #t (lambda () (apply (macro* (a) `(+ ,a 1)) (list 1 2 3))) (lambda (t i) (apply format #f i)))
+      "too many arguments: (macro* (a) ...) 1 2 3)")
+(test (catch #t (lambda () (apply (bacro* (a) `(+ ,a 1)) (list 1 2 3))) (lambda (t i) (apply format #f i)))
+      "too many arguments: (bacro* (a) ...) 1 2 3)")
+(test (catch #t (lambda () (apply (lambda (a b) (+ a b)) (list 1))) (lambda (t i) (apply format #f i)))
+      "(lambda (a b) (+ a b)): not enough arguments: ((lambda (a b) ...) 1)")
+(test (catch #t (lambda () (apply (macro (a b) (+ a b)) (list 1))) (lambda (t i) (apply format #f i)))
+      "(macro (a b) (+ a b)): not enough arguments: ((macro (a b) ...) 1)")
+(test (catch #t (lambda () (apply (bacro (a b) (+ a b)) (list 1))) (lambda (t i) (apply format #f i)))
+      "(bacro (a b) (+ a b)): not enough arguments: ((bacro (a b) ...) 1)")
+
+
+;;; --------------------------------------------------------------------------------
+;;; setter
+
+(test (setter) 'error)
+(test (setter car cons) 'error)
+(test (setter car) set-car!)
+(test (setter vector-ref) vector-set!)
+(test (setter int-vector-ref) int-vector-set!)
+(test (setter float-vector-ref) float-vector-set!)
+(test (setter byte-vector-ref) byte-vector-set!)
+(test (setter make-string) #f)
+(test (setter quasiquote) #f)
+(test (setter cdr) set-cdr!)
+(test (setter hash-table-ref) hash-table-set!)
+(test (setter list-ref) list-set!)
+(test (setter let-ref) let-set!)
+(test (setter string-ref) string-set!)
+(test (set! (setter 'begin) (lambda args #f)) 'error)
+(test (set! (setter 'quasiquote) (lambda args #f)) 'error) ; special case (not syntax in s7)
+
+(unless pure-s7
+  (test (setter current-input-port) set-current-input-port)
+  (test (setter current-output-port) set-current-output-port))
+(test (setter current-error-port) set-current-error-port)
+(test (setter (call-with-exit (lambda (quit) quit))) #f)
+
+(for-each
+ (lambda (arg)
+   (test (setter arg) #f))
+ (list -1 #\a #f 1 3.14 3/4 1.0+1.0i ()))
+(test (setter :hi) #f) ; setter -> setter here
+(test (setter 'hi) #f)
+(let ((sym 3)) (set! (setter 'sym) (lambda (s x) x)) (test (procedure? (setter 'sym)) #t))
+(test (setter (symbol "a b") `((1))) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (set! (setter abs) arg) 'error))
+ (list -1 #\a #t _ht_ _undef_ 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi 'car "car" :hi #(()) (list 1 2 3) '(1 . 2) "hi"
+       (call/cc (lambda (cc) cc)) (call-with-exit (lambda (goto) goto))))
+
+(let ((dl (dilambda (lambda (x) 1) (lambda (x y) x))))
+  (define (fes)
+    (for-each
+     (lambda (n a)
+       (set! (n a) 0))
+     (list car (vector 0) dl)
+     (list (list 1) 0 0)))
+  (fes))
+
+(let ()
+  (define (hiho a) a)
+  (define-macro (hiha a) `(+ 1 ,a))
+  (define-bacro* (hoha a) `(+ 1 ,a))
+  (define pws (dilambda (lambda () 1) (lambda (x) x)))
+  (test (setter hiho) #f)
+  (test (setter hiha) #f)
+  (test (setter hoha) #f)
+  (test (procedure? (setter pws)) #t)
+  (test ((setter pws) 32) 32)
+  )
+
+(let ((f1 (let ((xx 0)) (lambda (x) (+ x xx)))))
+  (set! (setter f1) (lambda (x v) (* v 2)))
+  (test (set! (f1 3) 12) 24)
+  ;(test (set! (setter f1) (lambda (x v y) (+ x (* v 2)))) 'error) ; can't decide about this (more of these below)
+  (set! (f1 3) 5)
+  (test (f1 0) 0)                               ; so nothing got set!
+  (set! (setter f1) (lambda (v) (* v 2)))
+  (set! (f1) 3)
+  (test (f1 0) 0)
+  (test (set! (setter f1) (lambda () (* v 2))) 'error))
+
+;;; similarly:
+(let ()
+  (define f1 (let ((+setter+ 32)) (lambda () 3))) ; error??
+  (test (setter f1) 'error))                     ; g_setter raises this error
+
+(let ()
+  (set! (setter *) (lambda (a) a)) ;op_set_pws[79080]: not a c function, but a function (type: 39)
+  (define (ff) (set! (*) "asdf"))
+  (test (ff) "asdf")
+  (test (ff) "asdf"))
+
+(let ((xx 1))
+  (set! (setter 'xx) (lambda (s v) (* v 2)))
+  (set! xx 2)
+  (test xx 4)
+  (test (set! (setter 'xx) (lambda (v) (* v 2))) 'error)
+  (set! (setter 'xx) (lambda (s v l) (* v 3)))
+  (set! xx 5)
+  (test xx 15)
+  (test (set! (setter 'xx) (lambda (s v l n) (* v 3))) 'error)
+  (set! (setter 'xx) (define-macro (_m s v) `(* ,v 7)))
+  (set! xx 10)
+  (test xx 70)
+  (test (set! (setter xx) (lambda (s v) v)) 'error)
+  (set! (setter 'xx) #f)
+  (set! xx 1)
+  (test xx 1))
+
+(let ((x 123))
+  (define (f a b) (+ x a b))
+  (set! (setter f) (lambda (a b val) (set! x val)))
+  (test (f 1 2) 126)
+  (set! (f 1 2) 32)
+  (test (f 1 2) 35))
+
+(let ((x 1))
+  (set! (setter 'x) (lambda (name new-value enviroment) (* new-value 2)))
+  (define x 3)
+  (test x 6))
+
+(test (eq? (let ((x 0)) (set! (setter 'x) integer?) (setter 'x)) integer?) #t) ; tricky...
+(test (let ((x 0)) (set! (setter 'x) integer?) (make-vector (values 1 2) (setter 'x))) #i(2))
+
+(let ()
+  (define (f3)
+    (let ((x 128))
+      (set! (setter 'x) (lambda (s v)
+			  (if (and (integer? v)
+				   (<= 0 v 128))
+			      v
+			      (error 'wrong-type-arg "(set! ~A ~S) but ~S should be an integer between 0 and 128" s v v))))
+      (do ((i 0 (+ i 1))) ((= i 2) x)
+	(set! x (+ x i)))))
+  (test (f3) 'error)
+
+  (define (f4)
+    (let ((x 128.0))
+      (set! (setter 'x) (lambda (s v)
+			  (if (and (float? v)
+				   (<= 0.0 v 128.0))
+			      v
+			      (error 'wrong-type-arg "(set! ~A ~S) but ~S should be a float between 0.0 and 128.0" s v v))))
+      (do ((i 0 (+ i 1))) ((= i 2) x)
+        (set! x (+ x i)))))
+  (test (f4) 'error)
+
+  (define (f5)
+    (let ((x 'a))
+      (set! (setter 'x) symbol?)
+      (do ((i 0 (+ i 1))) ((= i 2) x)
+	(set! x #f))))
+  (test (f5) 'error))
+
+(test (let ((v #(1 2 3)))
+	((setter vector-ref) v 0 32)
+	v)
+      #(32 2 3))
+(test (let ((v #(1 2 3)))
+	((setter vector-ref) (let () v) 0 32)
+	v)
+      #(32 2 3))
+(let ()
+  (define (vref v i) (vector-ref v i))
+  (set! (setter vref) vector-set!)
+  (test (let ((v (vector 1 2 3))) (set! (vref v 1) 32) v) #(1 32 3)))
+
+(let-temporarily (((setter cadr)
+		   (lambda (lst val)
+		     (set! (car (cdr lst)) val))))
+  (test (let ((lst (list 1 2 3)))
+	  (set! (cadr lst) 4)
+	  lst)
+	'(1 4 3))
+  (test (procedure? (setter cadr)) #t)
+  (gc) (gc) ; lint.scm tests this exhaustively
+  (test (procedure? (setter cadr)) #t)
+  (if (not (procedure? (setter cadr)))
+      (format *stderr* "   setter: ~A~%" (setter cadr))))
+
+(let ()
+  (define-macro (vref v a) `(vector-ref ,v ,a))
+  (define-macro (vset! v a x) `(vector-set! ,v ,a ,x))
+  (set! (setter vref) vset!)
+
+  (let ((v (vector 1 2 3)))
+    (set! (vref v 1) 32)
+    (test v #(1 32 3)))
+
+  (define hi 0)
+  (define-macro (xx) `hi)
+  (define-macro (set-xx val) `(set! hi ,val))
+  (set! (setter xx) set-xx)
+
+  (set! (xx) 32)
+  (test hi 32))
+
+(let ()
+  (set! (setter logbit?)
+	(define-macro (m var index on) ; here we want to set "var", so we need a macro
+	    `(if ,on
+	         (set! ,var (logior ,var (ash 1 ,index)))
+	         (set! ,var (logand ,var (lognot (ash 1 ,index)))))))
+  (test (let ((int #b1010)) (set! (logbit? int 0) #t) int) 11))
+
+(let-temporarily (((setter <) <))
+  (test (set! (< 3 2) 3) #f)
+  (test (set! (< 1) 2) #t))
+
+(let ((x 1))                                                ; let-temp = (set! x new) ... (set! x old) so setter is called twice
+  (set! (setter 'x) (lambda (s v) (+ (symbol->value s) v))) ; x = x + v, x is 1, v is 3 below
+  (let ((res (let-temporarily ((x 3)) x)))                  ; x = 1 + 3, then on exit from let-temp, x = 4 + 1 ! (let-temp is trying to set x back to 1)
+    (set! (setter 'x) #f)
+    (test x 5)))
+
+(test (with-let (inlet 'a 1) (set! (setter 'a) (lambda (s v) 123)) (set! a 2) a) 123) ; won't work with *s7*
+
+(let ((old-setter (setter abs))) ; check gc protection
+  (set! (setter abs) (define-macro (_m1_ x y) `(+ ,x 1)))
+  (define-macro (_m1_ x) `(- ,x 1))
+  (gc)
+  (gc)
+  (test (macro? (setter abs)) #t)
+  (set! (setter abs) old-setter))
+
+(when with-block
+  (let ((b (make-block 3)))
+    ((setter b) b 0 1.0)
+    (test b (block 1.0 0.0 0.0))))
+
+(let ((str "123")) ((setter str) str 0 #\a) (test str "a23"))
+(let ((bv #u(0 1 2))) ((setter bv) bv 0 3) (test bv #u(3 1 2)))
+(let ((iv #i(0 1 2))) ((setter iv) iv 0 3) (test iv #i(3 1 2)))
+(let ((v #(0 1 2))) ((setter v) v 0 3) (test v #(3 1 2)))
+(let ((fv #r(0.0 1.0 2.0))) ((setter fv) fv 0 3.0) (test fv #r(3.0 1.0 2.0)))
+(let ((lst (list 0 1 2))) ((setter lst) lst 0 3) (test lst '(3 1 2)))
+(let ((lt (inlet 'a 3))) ((setter lt) lt 'a 4) (test lt (inlet 'a 4)))
+(let ((ht (hash-table 'a 3))) ((setter ht) ht 'a 4) (test ht (hash-table 'a 4)))
+(test (setter (make-iterator (list 1 2 3))) #f)
+(test (setter (inlet)) let-set!)
+(test (set! (setter (inlet) (lambda (lt sym val) val))) 'error)
+(test (setter (hash-table)) hash-table-set!)
+(test (let ((i 0)) (call/cc (lambda (cc) (set! (setter 'i) cc) i))) 'error)
+;(test (do ((i 0 (+ i 1))) ((= i 100)) (apply values (set! (setter 'i) (weak-hash-table? 1)) ())) #t)
+;   expr and setter collide here -- we need at least a warning, ideally a way to fix this
+
+(let ((x 0))
+  (set! (setter 'x)
+	(let ((+documentation+ "x is a variable"))
+	  (lambda (s v)
+	    v)))
+  (test (documentation (setter 'x)) "x is a variable"))
+
+(let ()
+  (define flocals
+    (let ((x 1))
+      (let ((+setter+ (lambda (val) (set! x val)))
+	    (+documentation+ (immutable! "this is a test"))
+	    (+signature+ '(#t procedure?)))
+	(lambda ()
+	  x))))
+
+  (test (flocals) 1)
+  (test (procedure? (setter flocals)) #t)
+  (set! (flocals) 32)
+  (test (flocals) 32)
+  (test (signature flocals) '(#t procedure?))
+  (test (documentation flocals) "this is a test"))
+
+(let ((_x_ 1))
+  (define fset (let ((+setter+ (lambda (x) (set! _x_ x)))) (lambda () _x_)))
+  (set! (fset) 2) ; make sure this is found even if we haven't previously looked for it (as above)
+  (if (not (= _x_ 2)) (format *stderr* "fset setter: ~A~%" _x_))
+  (define (fset1) _x_)
+  (if (setter fset1) (format *stderr* "fset1 setter: ~A~%" (setter fset1)))
+  (set! (setter fset1) (lambda (x) (set! _x_ x)))
+  (set! (fset1) 3)
+  (if (not (= _x_ 3)) (format *stderr* "fset1 setter: ~A~%" _x_))
+
+  (define fset3 (let ((+setter+ (lambda (x y) (set! _x_ (+ x y))))) (lambda (y) (+ _x_ y))))
+  (set! (fset3 3) 4)
+  (if (not (= _x_ 7)) (format *stderr* "fset3 setter: ~A~%" _x_))
+
+  (set! (setter fset3) #f)
+  (test (setter fset3) #f)
+  (test (set! (fset3 3) 4) 'error)
+  (set! (setter fset3) (lambda (x y) (set! _x_ (+ x y))))
+  (test (set! (fset3 3) 4) 7)
+  )
+
+(let ((p (open-output-string)))
+  (define e      ; save environment for use below
+    (let ((x 3)  ; always an integer
+	  (y 3)  ; always 3
+	  (z 3)) ; report set!
+      (set! (setter 'x) (lambda (s v) (if (integer? v) v x)))
+      (set! (setter 'y) (lambda (s v) y))
+      (set! (setter 'z) (lambda (s v) (format p "z ~A -> ~A~%" z v) v))
+      (set! x 3.3)
+      (set! y 3.3)
+      (set! z 3.3)
+      (curlet)))
+  (test (and (equal? (e 'x) 3) (equal? (e 'y) 3) (equal? (e 'z) 3.3)
+	     (string=? (get-output-string p) "z 3 -> 3.3\n"))
+	#t)
+  (close-output-port p))
+
+(for-each
+ (lambda (arg)
+   (test (setter arg) #f) ; was 'error 19-Oct-22
+   (test (set! (setter _int_) arg) 'error)
+   (let ((x 1))
+     (if (not (null? arg))
+	 (test (set! (setter 'x arg) (lambda (s v) 1)) 'error)))
+   (let ((_x_ 1))
+     (set! (setter '_x_) (lambda (s v) v))
+     (set! _x_ arg)
+     (test _x_ arg)))
+ (list -1 #\a 1 3.14 3/4 1.0+1.0i ()))
+
+(let ((_x_ 1))
+  (set! (setter '_x_) (lambda (s v) v))
+  (define _x_ 32)
+  (test _x_ 32)
+  (define (_x_) 32)
+  (test (_x_) 32)
+  (let ((_x_ 3))
+    (test _x_ 3))
+  (define (hi _x_) _x_)
+  (test (hi 4) 4)
+  (test (do ((_x_ 0 (+ _x_ 1))) ((= _x_ 2) _x_)) 2)
+  (test ((inlet '_x_ -1) '_x_) -1)
+  (set! _x_ 32)
+  (test _x_ 32))
+
+(let ((_x_ 1))
+  (set! (setter '_x_) (lambda (s v) #f))
+  (define _x_ 32) (test _x_ #f)
+  (test (set! _x_ 32) #f))
+
+(test (setter) 'error)
+(let ((xyzzy 1)
+      (_int_ 'xyzzy))
+  (test (setter 'xyzzy) #f)
+  (test (set! (setter _int_) ()) 'error)
+  (test (set! (setter _int_) '(#f)) 'error))
+
+(let ((_x1_ #f))
+  (set! (setter '_x1_) (lambda (x y) 'error))
+  (test (set! _x1_ 32) 'error))
+
+(let ((x 0))
+  (set! (setter 'x)
+	(lambda (_A _B)
+	  (let ((y 2)) ((lambda () (let ((z 1)) (values y z)))))))
+  (test (set! x 1) 'error)) ; mv from setter
+
+(let ((x 1))
+  (set! (setter 'x) (lambda (s v) x))
+  (let ((x 2))
+    (set! x 3)
+    (test x 3)
+    (set! (setter 'x (curlet)) (lambda (s v) 32))
+    (set! x 1)
+    (test x 32))
+  (test x 1)
+  (set! x 2)
+  (test x 1))
+
+(let ()
+  (define (f1 x)
+    (let ((a x)
+	  (b 2)
+	  (c 3))
+      (set! (setter 'b) (lambda (s v) (set! a (+ v c)) v))
+      (set! (setter 'c) (lambda (s v) (set! a (+ b v)) v))
+      (set! a (+ b c))
+      (set! b (+ b 1))
+      (set! c 5)
+      a))
+  (f1 0)
+  (test (f1 0) 8))
+
+(test (setter :rest) #f)
+(test (set! (setter :allow-other-keys) #f) 'error)
+
+(let ()
+  (define v_a_r 32)
+  (let ((x #(1 2 3)))
+    (set! (setter 'v_a_r)
+	  (lambda (sym val)
+	    (set! (x 1) val)
+	    (+ val 2))))
+  (do ((i 0 (+ i 1)))
+      ((= i 5))
+    (set! v_a_r (+ i 33))
+    (test v_a_r (+ i 33 2))
+    (gc)))
+
+(define v_a_r 32)
+(let ((x #(1 2 3)))
+  (set! (setter 'v_a_r)
+	(lambda (sym val)
+	  (set! (x 1) val)
+	  (+ val 1))))
+(do ((i 0 (+ i 1)))
+    ((= i 5))
+  (set! v_a_r (+ i 33))
+  (test v_a_r (+ i 33 1))
+  (gc))
+
+(let ((x (vector 1 2 3)))
+  (let ((y (list 4 5 6)))
+    (set! (setter 'v_a_r)
+	  (lambda (sym val)
+	    ;(format *stderr* "~A ~A~%" sym val)
+	    (+ (x val) (y val)))))
+  (set! v_a_r 1)
+  (test v_a_r 7))
+(set! v_a_r 0)
+(test v_a_r 5)
+(gc) (gc)
+(set! v_a_r 2)
+(test v_a_r 9)
+(gc) (gc)
+(let ((err #f))
+  (catch #t (lambda () (set! v_a_r 3)) (lambda args (set! err #t)))
+  (test v_a_r 9)
+  (if (not err) (format *stderr* "no error in symbol accessor!")))
+
+(define v_a_r_1 0)
+(let ((v_a_r_1 43)
+      (x #(1 2 3)))
+  (set! (setter 'v_a_r_1) (lambda (sym val) (x val)))
+  (set! v_a_r_1 0)
+  (test v_a_r_1 1))
+(catch #t (lambda () (set! v_a_r_1 2)) (lambda args (apply format *stderr* (cadr args))))
+(test v_a_r_1 2)
+
+(let ((x (vector 1 2 3)))
+  (let ((y 32))
+    (let ((e1 (curlet))
+	  (y 31))
+      (let ((e2 (curlet)))
+	(set! (setter 'y e1)
+	      (lambda (sym val)
+		(+ val (x 1)))))
+      (set! y 3)
+      (test y 3))
+    (set! y 2)
+    (test y 4)))
+
+(let ()
+  (define (symbol-documentation sym e)
+    (cond ((setter sym e) => documentation)
+	  (else #f)))
+
+  (define (symbol-signature sym e)
+    (cond ((setter sym e) => signature)
+	  (else #f))) ; or car?
+
+  (define (set sym val e)
+    (if (integer? val)
+	val
+	(symbol->value sym e)))
+
+  (let ((x 3))
+    (set! (setter 'x) set)
+    (set! x 4)
+    (test x 4))
+
+  (let ((x 5))
+    (define set
+      (let ((+signature+ '(integer? #t))
+	    (+documentation+ "x is an integer"))
+	(lambda (s v e)
+	  (if (integer? v)
+	      v
+	      (symbol->value s e)))))
+    (let ((x 6))
+      (set! (setter 'x) set)
+      (set! x 7)
+      (test x 7)
+      (test (symbol-documentation 'x (curlet)) "x is an integer")
+      (test (symbol-signature 'x (curlet)) '(integer? #t)))
+    (test x 5)))
+
+(let ((x (inlet :a 1 :b 2))
+      (set1 #f)
+      (set2 #f))
+  (set! (setter 'a x)
+	(lambda (s v e)
+	  (set! set1 v)
+	  (+ v 1)))
+  (set! (setter 'b x)
+	(lambda (s v e)
+	  (set! set2 v)
+	  (* v 2)))
+  (set! (x 'a) 32)
+  (set! (x 'b) (+ (x 'a) 1))
+  (test x (inlet :a 33 :b 68)))
+
+(let ((x 1)) (set! (setter 'x) integer?) (test x 1) (set! x 32) (test (set! x 3.14) 'error) (test x 32))
+(let ((x 'a)) (set! (setter 'x) symbol?) (test x 'a) (test (set! x 3.14) 'error) (test x 'a))
+(let ((x :a)) (set! (setter 'x) keyword?) (test x :a) (test (set! x 3.14) 'error) (test x :a))
+(let ((x #f)) (set! (setter 'x) boolean?) (test (set! x 3.14) 'error) (test x #f))
+(let ((x ())) (set! (setter 'x) proper-list?) (test (set! x 3.14) 'error) (test x ()))
+(unless with-bignums (let ((x (random-state 1234 4321))) (set! (setter 'x) random-state?) (test (set! x 123) 'error)))
+
+(test (let ((a (make-vector 3 'a symbol?))) (let ((b (copy a))) (vector-set! b 0 32))) 'error)
+(test (let ((a (let ((i 0)) (set! (setter 'i) integer?) (curlet)))) (let ((b (copy a))) (set! (b 'i) #\a))) 'error)
+(test (let ((a (let ((i 0)) (set! (setter 'i) integer?) (curlet)))) (object->string (copy a) :readable)) "(let ((i 0)) (set! (setter 'i) #_integer?) (curlet))")
+
+(let ((imv (immutable! (vector 0 1 2))))
+  (test ((lambda (x) (type-of (help (setter imv (vector x 0))))) 1) 'error)
+  (test ((lambda* ((x 1)) (type-of (help (setter imv (vector x 0)))))) 'error)
+  (test (let () (define (func) (let ((x 1)) (type-of (help (setter imv (vector 1 0)))))) (func) (func)) 'error))
+
+(let ((x 1))
+  (set! (setter 'x) integer?)
+  (let ((x 'a))
+    (set! (setter 'x) symbol?)
+    (let ((x :a))
+      (set! (setter 'x) keyword?)
+      (let ((x #f))
+	(set! (setter 'x) boolean?)
+	(let ((x ()))
+	  (set! (setter 'x) proper-list?)
+	  (test (set! x 3.14) 'error) (test x ()))
+	(test (set! x 3.14) 'error) (test x #f))
+      (test x :a) (test (set! x 3.14) 'error) (test x :a))
+    (test x 'a) (test (set! x 3.14) 'error) (test x 'a))
+  (test x 1) (set! x 32) (test (set! x 3.14) 'error) (test x 32))
+
+(test (set! (setter setter) car) 'error)
+(test (immutable? (setter setter)) #t)
+(test (set! (setter values) car) 'error)
+(test (setter values) #f) ; else we get (set! (values...)...) which is a mess */
+(test (immutable? (setter values)) #t)
+
+(let ((lst (list 1 2)))
+  (set! (setter (setter car)) (lambda (s v1 v2)	(list v1 v2)))
+  (test (set! (set-car! lst 32) 4) '(32 4))
+  (test lst '(1 2))
+  (set! (setter (setter car)) #f))
+
+(let ((x 4))
+  (set! (setter 'x)
+	(lambda (s v)
+	  (unless (and (integer? v)
+		       (< 2 v 6))
+	    (error 'wrong-type-arg "~S should be an integer between 2 and 6" s))
+	  v))
+  (test (set! x 3) 3)
+  (test (set! x 32) 'error))
+
+(test (let ((x 1)) (set! (setter 'x) integer?) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x pi))) 'error)
+(test (let ((x 1)) (set! (setter 'x) integer?) (define (f) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x pi))) (f)) 'error)
+(test (let ((x 1)) (set! (setter 'x) integer?) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x i))) 0)
+
+;; this can cause s7 to exit immediately (optimizer bug)
+(let ((x 1))
+  (set! (setter 'x)
+	(lambda (s v)
+	  (catch #t
+	    (lambda ()
+	      (asdf v))
+	    (lambda arg 'error))))
+  (set! x 0)
+  (test x 'error))
+
+(test (let ((x 3)) (set! (setter 'x) integer?) (set! (setter 'x) #f) (set! x 4.0)) 4.0)
+(test (let ((x 3)) (set! (setter 'x) integer?) (set! (setter 'x) #f) (let-temporarily ((x 4.0)) x) x) 3)
+(test (let ((x 3)) (set! (setter 'x) integer?) (let-temporarily (((setter 'x) #f)) (set! x 4.0)) x) 4.0)
+(test (let ((x 3)) (set! (setter 'x) integer?) (let-temporarily (((setter 'x) #f)) (set! x 4.0)) (set! x 8.0)) 'error)
+
+(let ()
+  (define-macro (with-immutable objs . body)
+    `(let-temporarily (,@(map (lambda (obj)
+				`((setter ',obj)
+                                  (lambda (s v)
+				    (error 'immutable-object-error "in with-immutable, can't set! ~A" ',obj))))
+			      objs))
+       ,@body))
+  ;; (display (macroexpand (with-immutable (x) (set! y x))))
+  ;;    (let-temporarily (((setter 'x) (lambda (s v) (error 'immutable-object-error "in with-immutable, can't set! ~A" 'x)))) (set! y x))
+  (test (let ((x 21)) (with-immutable (x) (set! x 3)) x) 'error)
+  (test (let ((x 21) (y 0)) (let-temporarily (((setter 'x) (lambda (s v) (error 'oops "nope")))) (set! y x) y)) 21)
+  (test (let ((x 21) (y 0)) (with-immutable (x) (set! y (+ x 1))) (list x y)) '(21 22))
+  (test (let ((x 21) (y 0)) (with-immutable (x y) (set! y (+ x 1)) (list x y))) 'error)
+  (test (do ((i -10 (+ i 1))) ((= i 0)) (with-immutable (i) 0)) #t) ; do stepper uses pending_value also for setter -- this just barely works...
+
+  (test (let loop ((x 21)) (with-immutable (x) (loop (set! x 2)))) 'error)
+  (test (let loop ((x 21)) (with-immutable (x) (set! x (- x 1)) (when (positive? x) (loop x)))) 'error)
+  (test (let loop ((x 2)) (set! x (- x 1)) (with-immutable (x) (if (positive? x) (loop x) 0))) 0)
+  (test (let* ((x 0) (y (with-immutable (x) (set! x 0)))) 2) 'error)
+  (test (letrec* ((x 0) (y (with-immutable (x) (set! x 0)))) 2) 'error)
+  (when (defined? 'x) (format *stderr* "x is defined: ~S~%" x))
+  (test (letrec ((x 0) (y (with-immutable (x) (set! x 0)))) 2) 'error) ; can't set! x
+  (test (let ((x 0) (y (with-immutable (x) (set! x 0)))) 2) 'error)    ; x is unbound
+  (test (letrec ((x 1) (y (begin (set! x 2)))) (+ x y)) 3)
+  (test (letrec ((x 1) (y (begin (set! x 2)))) (list x y)) '(1 2))
+  (test (letrec ((x 1) (y x)) (list x y)) '(1 #<undefined>))
+  (test (letrec ((x 1) (y (with-immutable (x) 2))) (list x y)) '(1 2))
+  ;; so x pending value is ok?  slot_value is #<undefined>, pending_value is 1, with-immutable returns it to 1
+  (test (letrec ((x 1) (y (begin (set! x 2) 3))) (list x y)) '(1 3)) ; Guile says '(2 3)
+  ;; r7rs: if it is not possible to evaluate each init without assigning or referring to the value of any variable, it is an error.
+  ;;   which in spec-speak means both Guile and s7 are correct.
+  )
+
+(test (catch #t (lambda () (set! (#_abs 1) 2)) (lambda (type info) (apply format #f info))) "#_abs (a c-function) does not have a setter: (set! (#_abs 1) 2)")
+(test (catch #t (lambda () (set! 3 2)) (lambda (type info) (apply format #f info))) "set! can't change 3 (an integer), (set! 3 2)")
+(let ()
+  (define (fset x) 1)
+  (test (catch #t (lambda () (set! (fset 1) 2)) (lambda (type info) (apply format #f info))) "fset (a function) does not have a setter: (set! (fset 1) 2)"))
+(test (catch #t (lambda () (set! (abs 1) 2)) (lambda (type info) (apply format #f info))) "abs (a c-function) does not have a setter: (set! (abs 1) 2)")
+
+(let ()
+  ;; (car (signature v)) is v's element type
+  (define (vtype v)
+    (and (integer? v)
+	 (>= 4 v 0)))
+
+  (define iv1 (make-vector 3 0 vtype))
+  (set! (setter 'iv1) ; if iv1 set, new value should be a vector length 3 of ints between 0 and 3 (element-type vtype)
+	(lambda (s v)
+	  (unless (vector? v)
+	    (error 'wrong-type-arg "set! ~S: ~S should be a vector" s v))
+	  (unless (= (length v) 3)
+	    (error 'wrong-type-arg "set! ~S: new value's length is ~S, not 3" s (length v)))
+	  (unless (eq? (car (signature v)) 'vtype)
+	    (error 'wrong-type-arg "set! ~S: ~S's element type should be vtype, but it's ~S" s v (car (signature v))))
+	  v))
+
+  (test (signature iv1) (let ((sig (list 'vtype 'vector? 'integer?))) ; (vtype vector? . #1=(integer? . #1#))
+			  (set-cdr! (cddr sig) (cddr sig))
+			  sig))
+  (test (catch #t (lambda () (set! (iv1 0) 'b)) (lambda (t info) (apply format #f info)))
+	"vector-set! third argument 'b, is a symbol, but the vector's element type checker, vtype, rejects it")
+  (define iv2 (make-vector 3 0 vtype))
+  (set! iv1 iv2) ; iv2 does't have any setter but it's iv1 that matters
+  (test (eq? iv1 iv2) #t)
+  (test (catch #t (lambda () (set! (iv1 0) 'b)) (lambda (t info) (apply format #f info)))
+	"vector-set! third argument 'b, is a symbol, but the vector's element type checker, vtype, rejects it")
+  (define iv3 (make-vector 3 'b))
+  (test (catch #t (lambda () (set! iv1 iv3)) (lambda (t info) (apply format #f info)))
+        "set! iv1: #(b b b)'s element type should be vtype, but it's #t")
+  (define iv4 (make-vector 4 0))
+  (test (catch #t (lambda () (set! iv1 iv4)) (lambda (t info) (apply format #f info)))
+         "set! iv1: new value's length is 4, not 3")
+  (define iv5 (make-int-vector 3 3))
+  (test (catch #t (lambda () (set! iv1 iv5)) (lambda (t info) (apply format #f info)))
+        "set! iv1: #i(3 3 3)'s element type should be vtype, but it's integer?")
+  (test (catch #t (lambda () (set! iv1 123)) (lambda (t info) (apply format #f info)))
+        "set! iv1: 123 should be a vector"))
+
+(let ()
+  (define (vtype v) (and (integer? v) (>= 4 v 0)))
+
+  (define h1 (make-hash-table 8 eq? (cons symbol? vtype)))
+  (test (catch #t (lambda () (hash-table-set! h1 "asdf" 1)) (lambda (t info) (apply format #f info)))
+	"hash-table-set! key second argument, \"asdf\", is a string but should be a symbol?")
+  (test (catch #t (lambda () (hash-table-set! h1 'asdf 3.1)) (lambda (t info) (apply format #f info)))
+	"hash-table-set! third argument 3.1, is a real, but the hash-table's value type checker, vtype, rejects it")
+
+  (define h2 (make-hash-table 8 eq? (cons vtype symbol?)))
+  (test (catch #t (lambda () (hash-table-set! h2 "asdf" 'a)) (lambda (t info) (apply format #f info)))
+        "hash-table-set! second argument \"asdf\", is a string, but the hash-table's key type checker, vtype, rejects it")
+  (test (catch #t (lambda () (hash-table-set! h2 1 3.1)) (lambda (t info) (apply format #f info)))
+	"hash-table-set! third argument, 3.1, is a real but should be a symbol?"))
+
+(let ()
+  (define ictr (let ((counter 0))
+		 (lambda ()
+		   (set! counter (+ counter 1)))))
+  (define (fs4)
+    (let ((v (vector (inlet 'a (list 0)))))
+      (set! (v 0 'a 0) (ictr))
+      (v 0 'a 0)))
+
+  (define (err t i) (apply format #f i))
+
+  (test (catch #t (lambda () (fs4)) err) 1)
+  (test (catch #t (lambda () (fs4)) err) 2)
+
+  (define (fs4a)
+    (let ((v (vector (inlet 'a (list 0)))))
+      (vector-set! v 0 'a 0 (ictr))
+      (vector-ref v 0 'a 0)))
+
+  (test (catch #t (lambda () (fs4a)) err) "too many arguments for vector-set!: (#((inlet 'a (0))) 0 a 0 3)")
+  (test (catch #t (lambda () (fs4a)) err) "too many arguments for vector-set!: (#((inlet 'a (0))) 0 a 0 4)")
+
+  (define (fs5)
+    (let ((v (vector (inlet 'a 0))))
+      (set! (v 0 'a) (ictr))
+      (v 0 'a)))
+
+  (test (catch #t (lambda () (fs5)) err) 5)
+  (test (catch #t (lambda () (fs5)) err) 6)
+
+  (define (fs5a)
+    (let ((v (vector (inlet 'a 0))))
+      (vector-set! v 0 'a (ictr))
+      (vector-ref v 0 'a)))
+
+  (test (catch #t (lambda () (fs5a)) err) "too many arguments for vector-set!: (#((inlet 'a 0)) 0 a 7)")
+  (test (catch #t (lambda () (fs5a)) err) "too many arguments for vector-set!: (#((inlet 'a 0)) 0 a 8)")
+
+  (define (fs6)
+    (let ((v (list (inlet 'a 0))))
+      (set! (v 0 'a) (ictr))
+      (v 0 'a)))
+
+  (test (catch #t (lambda () (fs6)) err) 9)
+  (test (catch #t (lambda () (fs6)) err) 10)
+
+  (define (fs6a)
+    (let ((v (list (inlet 'a 0))))
+      (list-set! v 0 'a (ictr))
+      (list-ref v 0 'a)))
+
+  (test (catch #t (lambda () (fs6a)) err) "too many arguments for list-set!: (0 a 11)")
+  (test (catch #t (lambda () (fs6a)) err) "too many arguments for list-set!: (0 a 12)")
+
+  (define (fs7)
+    (let ((v (inlet 'a (vector 0))))
+      (set! (v 'a 0) (ictr))
+      (v 'a 0)))
+
+  (test (catch #t (lambda () (fs7)) err) 13)
+  (test (catch #t (lambda () (fs7)) err) 14)
+
+  (define (fs7a)
+    (let ((v (inlet 'a (vector 0))))
+      (let-set! v 'a 0 (ictr))
+      (let-ref v 'a 0)))
+
+  (test (catch #t (lambda () (fs7a)) err) "let-set!: too many arguments: (let-set! (inlet 'a #(0)) a 0 15)")
+  (test (catch #t (lambda () (fs7a)) err) "let-set!: too many arguments: (let-set! (inlet 'a #(0)) a 0 16)")
+
+  (define (fs8)
+    (let ((v (hash-table 'a (vector 0))))
+      (set! (v 'a 0) (ictr))
+      (v 'a 0)))
+
+  (test (catch #t (lambda () (fs8)) err) 17)
+  (test (catch #t (lambda () (fs8)) err) 18)
+
+  (define (fs8a)
+    (let ((v (hash-table 'a (vector 0))))
+      (hash-table-set! v 'a 0 (ictr))
+      (hash-table-ref v 'a 0)))
+
+  (test (catch #t (lambda () (fs8a)) err) "hash-table-set!: too many arguments: (hash-table-set! (hash-table 'a #(0)) a 0 19)")
+  (test (catch #t (lambda () (fs8a)) err) "hash-table-set!: too many arguments: (hash-table-set! (hash-table 'a #(0)) a 0 20)")
+
+  (define (f1 a) a)
+  (set! (setter f1) (macro (a b) `(begin ',b)))
+  (test (set! (f1 0) (+ 1 2)) '(+ 1 2))
+  (test (set! (f1 0) (+ 1 2)) '(+ 1 2))
+
+  (define (f2) (set! (f1 0) (+ 1 2)))
+  (test (f2) '(+ 1 2))
+  (test (f2) '(+ 1 2))
+  )
+
+(do ((i 30 (+ i 1)))
+    ((begin
+       (set! (setter 'i) (lambda (s v) 32))
+       (= i 32)))
+  (test (< i 32) #t))
+
+(do ((i 30 (+ i 1))
+     (k (begin
+	  (set! (setter 'i) (lambda (s v) 32))
+	  0)))
+    ((= i 32))
+  (test (< i 32) #t))
+
+(do ((i 30 (+ i 1)))
+    ((= i 32))
+  (set! (setter 'i) (lambda (s v) 32))
+  (test (< i 32) #t))
+
+(do ((i 30 (+ i 1)))
+    ((>= i 32))
+  (set! (setter 'i) (lambda (s v) 32))
+  (test (< i 32) #t)
+  (set! i 0)
+  (test i 32))
+
+(letrec ((i 0)
+	 (k 1))
+  (set! (setter 'i) (lambda (s v) 12))
+  (set! i 0)
+  (test i 12)
+  (set! (setter 'i) #f)
+  (set! i 0)
+  (test i 0)
+  (set! (setter 'k) (lambda (s v e) (+ v 1)))
+  (set! k 2)
+  (test k 3))
+
+(letrec* ((i 0)
+	  (k 0))
+  (set! (setter 'i) (lambda (s v) 12))
+  (set! i 0)
+  (test i 12)
+  (set! (setter 'i) #f)
+  (set! i 0)
+  (test i 0)
+  (set! (setter 'k) (lambda (s v e) (+ v 1)))
+  (set! k 2)
+  (test k 3))
+
+(let ()
+  (define (f1 i)
+    (test i 123)
+    (set! i 0)
+    (test i 0)
+    (set! (setter 'i) (lambda (s v) (+ v 1)))
+    (set! i 0)
+    (test i 1)
+    (set! (setter 'i) #f)
+    (set! i 0)
+    (test i 0))
+  (f1 123)
+  (f1 123))
+
+(let ()
+  (define (f2)
+    (let ((i 123))
+    (test i 123)
+    (set! i 0)
+    (test i 0)
+    (set! (setter 'i) (lambda (s v) (+ v 1)))
+    (set! i 0)
+    (test i 1)
+    (set! (setter 'i) #f)
+    (set! i 0)
+    (test i 0)))
+  (f2)
+  (f2))
+
+(let ((i 0))
+  (define (f3)
+    (let ((i 123))
+      (set! (setter 'i) (lambda (s v) (+ v 1)))
+      (set! i 11)
+      (test i 12)))
+  (f3)
+  (set! i 11)
+  (test i 11))
+
+(let* ((i 0)
+       (k (begin
+	    (set! (setter 'i) (lambda (s v) (+ v 1)))
+	    1)))
+  (set! i 2)
+  (test i 3))
+
+(let ((i 123))
+  (let f1 ((i 0) (k (begin
+		      (set! (setter 'i) (lambda (s v) (+ v 1)))
+		      1)))
+    (set! i 2)
+    (test i 2)
+    (if (> k 0)
+	(f1 i (- k 1))))
+  (set! i 11)
+  (test i 12))
+
+(let ((i 123))
+  (let* f1 ((i 0) (k (begin
+		      (set! (setter 'i) (lambda (s v) (+ v 1)))
+		      1))
+	    (n 3))
+    (set! i 2)
+    (test i n)
+    (if (> k 0)
+	(f1 i (- k 1) 2)))
+  (set! i 11)
+  (test i 11))
+
+
+(let ((i 123))
+  (let* f1 ((n 1)
+	    (i 0)
+	    (k (begin
+		 (set! (setter 'i) (lambda (s v) (+ v 1)))
+		 1)))
+    (set! i 2)
+    (test i 3)
+    (if (> n 0)
+	(f1 (- n 1))))
+  (set! i 11)
+  (test i 11))
+
+(let ((x 1))
+  (set! (setter 'x) (lambda (s v) (+ v 1)))
+  (set! x 2)
+  (test x 3)
+  (set! (setter 'x) #f)
+  (set! x 2)
+  (test x 2)
+  (test (setter 'x) #f)
+
+  (define (f x) (+ x 1))
+  (set! (setter f) (lambda (a b) (+ b 1)))
+  (test (set! (f 1) 3) 4)
+  (set! (setter f) #f)
+  (test (setter f) #f)
+  (test (set! (f 1) 3) 'error)
+  (set! (setter 'f) (lambda (a b) (+ b 2)))
+  (test (set! (f 1) 2) 'error)
+  (set! f 2)
+  (test f 4)
+  (set! (setter 'f) #f)
+  (test (setter 'f) #f))
+
+(let-temporarily (((setter cons) abs))
+  (define (func)
+    (catch #t
+      (lambda () (set! (cons 1 2) 321))  ; set_pair4 safe c_func->safe c_func, but 3 args to abs "set!: three arguments? (abs 1 2 321), abs is (setter cons)"
+      (lambda (type info) 1)))
+  (func)
+  (test (func) 1))
+
+(let-temporarily (((setter cons) list))
+  (define (func)
+    (catch #t
+      (lambda () (set! (cons 1 2) 321))  ; set_pair4 c_func->c_func, no errors -> '(1 2 321)
+      (lambda (type info) 1)))
+  (func)
+  (test (func) '(1 2 321)))
+
+(let-temporarily (((setter cons) catch))
+  (define (func)
+    (list
+     (catch #t
+       (lambda () (set! (cons 1 +) *))  ; set_pair4 c_func->unsafe c_func, no errors -> #((0))
+       (lambda (type info) 1))))
+  (func)
+  (test (vector (func)) #((0))))
+
+(let-temporarily (((setter logand) abs))
+  (define (func)
+    (list (catch #t
+       (lambda () (set! (logand 11) 12))  ;set_pair3 safe->safe(c_func), 2 args to abs "set!: two arguments? (abs 11 12), abs is (setter logand)"
+       (lambda (type info) 10))))
+  (func)
+  (test (vector (func)) #((10))))
+
+(let-temporarily (((setter logand) catch))
+  (define (func)
+    (list (catch #t
+       (lambda () (set! (logand 11) 12))  ;set_pair3 safe->unsafe(c_func), 2 args to catch "catch: not enough arguments: (catch 11 12)"
+       (lambda (type info) 10))))
+  (func)
+  (test (vector (func)) #((10))))
+
+(let ()
+  (define (f1 x) (+ x 1))
+  (let-temporarily (((setter f1) abs))
+    (define (func)
+      (catch #t
+	(lambda () (set! (f1 2) 321))  ; clo->c_func -> error: "set!: two arguments? (abs 2 321), abs is (setter f1)"
+	(lambda (type info) 2)))
+  (func)
+  (test (func) 2)))
+
+(let ()
+  (let-temporarily (((setter +) expt))
+    (define (func)
+      (catch #t
+	(lambda () (set! (+) 321))
+	(lambda (type info) 2)))
+  (func)
+  (test (func) 2))) ; "set!: not enough arguments: (expt 321)"
+
+(let ()
+  (define (f2 x) (+ x 1))
+  (let-temporarily (((setter cons) f2))
+    (define (func)
+      (catch #t
+	(lambda () (set! (cons 1 2) 321))  ; set_pair4 safe cfunc -> clo; "f2: too many arguments: ((lambda (x) ...) 1 2 321)"
+	(lambda (type info) 1)))
+    (func)
+    (test (func) 1)))
+
+(test (let ((x #f)) (set! x (set! (setter 'x) values))) 'error) ; op_set1
+(test (let ((x #f)) (define (f) (set! x (set! (setter 'x) values))) (f)) 'error)
+(test (let ((x #f)) (define (g . args) (apply values args)) (set! x (set! (setter 'x) g))) 'error) ; splice_in_values etc
+
+(let ()
+  (define (f)
+    (let ((x 0))
+      (set! x (set! (setter 'x) (lambda a (copy a))))))
+
+  (test (list? (f)) #t)   ; #1=(x #<lambda a> (inlet 'x #1#)) -- new setter is called upon outer set! = copy args = (s v e)
+  (test (list? (f)) #t)   ; same
+
+  (define (f1)
+    (let ((x 0))
+      (set! x (set! (setter 'x) (lambda a (copy a))))
+      (setter 'x)))
+
+  (test (procedure? (f1)) #t)   ; #<lambda a>
+  (test (procedure? (f1)) #t)   ; same
+
+  (define (f2)
+    (let ((x 0))
+      (set! x (set! (setter 'x) (lambda a (copy a))))
+      x))
+
+  (test (list? (f2)) #t)   ; #1=(x #<lambda a> (inlet 'x #1#))
+  (test (list? (f2)) #t)   ; same
+  )
+
+;; -------- set! + setter + values --------
+
+(define a2 0)
+(test (set! (setter a2) (lambda (x y z) (list x y z))) 'error)
+
+(let ((a4 (lambda () 32)))
+  (set! (setter a4) (lambda (x) x))
+  (test (set! (a4) 12) 12)
+  (test (set! (a4 0) 12) 'error)
+  (test (set! (a4 (values 1 2)) 12) 'error)
+  (test (set! (a4) (values 1 2)) 'error)
+
+  (test (let () (define (f1) (set! (a4) (values 1 2))) (f1)) 'error)
+  (test (set! (a4) (c-function-with-values 1)) 1)
+  (test (set! (a4) (c-function-with-values 1 2)) 'error)
+  (test (set! (a4) (safe-c-function-with-2-values 1 2)) 'error)
+  (test (set! (a4) (c-macro-with-values 1)) 1)
+  (test (set! (a4) (c-macro-with-values 1 2)) 'error)
+
+  (set! (setter a4) (lambda (x . y) (cons x y)))
+  (test (set! (a4) 12) '(12))
+  (test (set! (a4 0) 12) '(0 12))               ; ?? not sure about these
+  (test (set! (a4 (values 1 2)) 12) '(1 2 12))  ; ??
+  (test (set! (a4) (values 1 2)) 'error))
+
+(let () ; use cf00 for safe-c-function
+  (set! (setter cf00) (lambda (x) x))
+  (test (set! (cf00) 12) 12)
+  (test (set! (cf00 0) 12) 'error)
+  (test (set! (cf00 (values 1 2)) 12) 'error)
+  (test (set! (cf00) (values 1 2)) 'error)
+
+  (set! (setter cf00) (lambda (x . y) (cons x y)))
+  (test (set! (cf00) 12) '(12))
+  (test (set! (cf00 0) 12) '(0 12))               ; ?? not sure about these
+  (test (set! (cf00 (values 1 2)) 12) '(1 2 12))  ; ??
+  (test (set! (cf00) (values 1 2)) 'error))
+
+(let ((a4 (lambda () 32)))
+  (set! (setter a4) (macro (x) `,x))
+  (test (set! (a4) 12) 12)
+  (test (set! (a4 0) 12) 'error)
+  (test (set! (a4 (values 1 2)) 12) 'error)
+  (test (set! (a4) (values 1 2)) 'error))
+
+(let ((m4 (macro (x) `(+ ,x 2))))
+  (set! (setter m4) (lambda (x) x))
+  (test (set! (m4) 12) 12)
+  (test (set! (m4 0) 12) 'error)
+  (test (set! (m4 (values 1 2)) 12) 'error)
+  (test (set! (m4) (values 1 2)) 'error)
+
+  (test (let () (define (f1) (set! (m4) (values 1 2))) (f1)) 'error)
+  (test (set! (m4) (c-function-with-values 1)) 1)
+  (test (set! (m4) (c-function-with-values 1 2)) 'error)
+  (test (set! (m4) (safe-c-function-with-2-values 1 2)) 'error)
+  (test (set! (m4) (c-macro-with-values 1)) 1)
+  (test (set! (m4) (c-macro-with-values 1 2)) 'error))
+
+(let ((a4 (lambda () 32)))
+  (set! (setter a4) (lambda (x) x))
+  (test (set! (a4) (call-with-exit (lambda (goto) (goto 1 2)))) 'error)
+  (test (set! (a4) (call/cc (lambda (goto) (goto 1 2)))) 'error)
+  (set! (setter a4) (lambda (a . b) (cons a b)))
+  (test (set! (a4) (call-with-exit (lambda (goto) (goto 1 2)))) 'error)
+  (test (set! (a4) (call/cc (lambda (goto) (goto 1 2)))) 'error))
+
+(let ((a3 (lambda (x) x)))
+  (set! (setter a3) (lambda (x y) (list x y)))
+  (test (set! (a3 1) 2) '(1 2))
+  (test (set! (a3 1) 2 3) 'error)
+  (test (set! (a3 1) (values 2 3)) 'error)
+  (test (set! (a3 1 2) 3) 'error)
+  (test (set! (a3 (values 1 21)) 3) 'error)
+  (test (set! (a3 1 2 3)) 'error)
+  (test (set! (a3 1 2 3) 4) 'error)
+  (test (set! (a3 1 2) (values 3 4)) 'error)
+  (test (set! (a3) (values 1 2)) 'error)
+
+  (set! (setter a3) (lambda (x . y) (cons x y)))
+  ;; but (setter 'a3) here says "a3 (a function) does not have a setter: (set! (a3 1 2) 3)" etc
+  (test (set! (a3 1) 2) '(1 2))
+  (test (set! (a3 1) 2 3) 'error)
+  (test (set! (a3 1) (values 2 3)) 'error)
+  (test (set! (a3 1 2) 3) '(1 2 3))
+  (test (set! (a3 (values 1 21)) 3) '(1 21 3))
+  (test (set! (a3 1 2 3)) 'error)
+  (test (set! (a3 1 2 3) 4) '(1 2 3 4))
+  (test (set! (a3 1 2) (values 3 4)) 'error)
+
+  (test (set! (a3 1) (call-with-exit (lambda (goto) (goto 1 2)))) 'error)
+  (test (set! (a3 1) (call/cc (lambda (goto) (goto 1 2)))) 'error))
+
+(let () ; use cf10 for safe-c-function
+  (set! (setter cf10) (lambda (x y) (list x y)))
+  (test (set! (cf10 11) 12) '(11 12))
+  (test (set! (cf10 0 1) 12) 'error)
+  (test (set! (cf10 (values 1 2)) 12) 'error)
+  (test (set! (cf10 1) (values 1 2)) 'error)
+  (test (set! (cf10 (values 1)) (values 2)) (list 1 2))
+  (test (set! (cf10) (values 1 2)) 'error)
+
+  (test (set! ((values 'cf10 1)) 2) '(1 2))
+
+  (set! (setter cf10) (lambda (x . y) (cons x y)))
+  (test (set! (cf10 1) 12) '(1 12))
+  (test (set! (cf10 0) 12) '(0 12))
+  (test (set! (cf10 (values 1 2)) 12) '(1 2 12))
+  (test (set! (cf10 1) (values 1 2)) 'error))
+
+(let ((a5 (lambda (x y) (list x y)))
+      (vals (lambda () (values 3 4))))
+  (set! (setter a5) (lambda (x y z) (list x y z)))
+  (test (set! (a5 1 2) 3) '(1 2 3))
+  (test (set! (a5 1 2) (vals)) 'error)
+  (test (set! (a5 1) (vals)) 'error)
+  (test (set! (a5 1) 2) 'error)
+  (test (set! (a5 (values 1 2)) 3) '(1 2 3))
+  (test (set! (a5 (vals)) (values 5)) '(3 4 5))
+  (set! (setter a5) (lambda (x . y) (cons x y)))
+  (test (set! (a5 1 2) (vals)) 'error))
+
+(let ((vals (lambda () (values 3 4))))
+  (set! (setter cf20) (lambda (x y z) (list x y z)))
+  (test (set! (cf20 10 11) 12) '(10 11 12))
+  (test (set! (cf20 0 1 2) 12) 'error)
+  (test (set! (cf20 (values 1 2)) 3) '(1 2 3))
+  (test (set! (cf20 (values 1 2 3)) 3) 'error)
+  (test (set! (cf20 1 2) (values 1 2)) 'error)
+  (test (set! (cf20 (values 1 2)) (values 3)) (list 1 2 3))
+  (test (set! (cf20) (values 1 2)) 'error)
+  (test (set! (cf20 1 2) (vals)) 'error)
+  (test (set! (cf20 (vals)) 5) '(3 4 5))
+  (test (set! ((values 'cf20 1 2)) 3) '(1 2 3))
+  (set! (setter cf20) (lambda (x . y) (cons x y)))
+  (test (set! (cf20 1 2) 12) '(1 2 12))
+  (test (set! (cf20 0) (vals)) 'error)
+  (test (set! (cf20 (values 1 2)) 12) '(1 2 12))
+  (test (set! (cf20 1) (values 1 2)) 'error))
+
+(test (let ((a1 (lambda () 32))) (set! (setter a1) (lambda (x . y) x)) (set! (a1) 2)) 2)
+(test (let ((vals2 (lambda () (values 5 6)))) (let ((a1 (lambda () 32))) (set! (setter a1) (lambda (x . y) x)) (set! (a1) (vals2)))) 'error)
+
+(let ((a3 (lambda (x) x)))
+  (set! (setter a3) (lambda (x . y) (cons x y)))
+  (let ((vals (lambda () (values 3 4))))
+    (let ((func (lambda () (set! (a3 1 2) (vals))))) ; 2 inner args
+      (test (func) 'error)
+      (test (func) 'error))
+    (let ((func (lambda () (set! (a3 1) (vals)))))
+      (test (func) 'error)
+      (test (func) 'error))))
+
+(test (let ((str "hi")) (set! (str 0 0) #\x) str) 'error)
+(test (let ((str "hi")) (set! ((values str 0) 0) #\x) str) 'error)
+
+(test (let ((a #(1)) (b #(2))) (set! ((if #t 'a 'b) 0) 3) a) #(3)) ; inner expr is evaluated:
+(test (let ((a #(1)) (b #(2))) (set! ((if #t a b) 0) 3) a) #(3))
+
+(test (let ((v #2d((0 1) (2 3)))) (set! ((values 'v 1 0)) 32) v) #2d((0 1) (32 3)))
+(test (let ((v #2d((0 1) (2 3)))) (set! ((values v 1 0)) 32) v) #2d((0 1) (32 3)))
+
+(test (let ((v #2d((0 1) (2 3)))) (set! ((v 1) 0) 32) v) #2d((0 1) (32 3)))
+;(test (let ((v #2d((0 1) (2 3)))) (set! ((values v 1) 0) 32) v) #2d((0 1) (32 3))) ; too many args
+
+(test (set! ((values #2d((0 1) (2 3)) 0 0)) 32) 32)
+(test (let ((v #2d((0 1) (2 3)))) (set! ((values 'v 0 0)) 32) v) #2d((32 1) (2 3)))
+;(test (set! ((values #2d((0 1) (2 3)) 0) 0) 33) 33) ; set!: too many arguments: (set! #2d((0 1) (2 3)) 0 0 33)
+
+(let ()
+  (define _d_ (dilambda (lambda (x) (+ x 1)) (lambda (x y) (+ x y))))
+  (test (set! (_d_ (apply values (make-list 3 1/2)) 2) 3) 'error))
+(let ()
+  (define _d_ (dilambda (lambda (x y z) (+ x y z)) (lambda (x y z w) (+ x y z w))))
+  (test (set! (_d_ (apply values (list 1 2)) 3) 4) 10))
+
+
+;;; --------------------------------------------------------------------------------
+;;; documentation
+
+(test (documentation 'tan) "(tan z) returns tan(z)")
+(test (let () (define hi  (let ((+documentation+ "this is a string")) (lambda () 1))) (documentation hi)) "this is a string")
+(test (let () (define hi  (let ((+documentation+ "this is a string")) (lambda () 1))) (help hi)) "this is a string")
+(test (let () (define hi (let ((+documentation+ "this is a string")) (lambda () 1))) (#_help hi)) "this is a string")
+(test (let ((documentation "oops")) (let () (define hi (lambda () 1)) (help hi))) #f)
+(test (let () (define hi (let ((+documentation+ "ok")) (lambda () 1))) (documentation hi)) "ok")
+(test (let ((documentation "oops")) (define hi (let () (lambda () 1))) (documentation hi)) 'error) ; it's a string here!
+(test (let () (define (hi) "this is a string") (hi)) "this is a string")
+(test (let () (define (hi) "this is a string") (documentation hi)) "this is a string")
+
+(test (set! (documentation abs) "X the unknown") 'error)
+(test (let ((str (documentation abs))) (set! ((documentation abs) 1) #\x) (equal? str (documentation abs))) #t)
+(test (let ((str (documentation abs))) (fill! (documentation abs) #\x) (equal? str (documentation abs))) #t)
+(test (let ()
+        (define f1 (let ((+documentation+ "f1's doc"))
+                     (lambda ()
+                       (define f2 (lambda () 2))
+                       (documentation f2))))
+        (f1)) "")
+(test (let ()
+        (define f1 (let ((+documentation+ "f1's doc"))
+                     (lambda ()
+                       (define f2
+                         (let ((+documentation+ "f2's doc"))
+                           (lambda () 2)))
+                       (documentation f2))))
+        (f1)) "f2's doc")
+(let ()
+  (define amac (let ((+documentation+ "this is a string")) (define-macro (_ a) `(+ ,a 1))))
+  (test-wi (documentation amac) "this is a string"))
+(let ()
+  (define amac (let ((+documentation+ "this is a string")) (define-macro* (_ (a 1)) `(+ ,a 1))))
+  (test-wi (documentation amac) "this is a string"))
+(let ()
+  (define amac (let ((+documentation+ "this is a string")) (define-bacro (_ a) `(+ ,a 1))))
+  (test-wi (documentation amac) "this is a string"))
+(let ()
+  (define amac (let ((+documentation+ "this is a string")) (define-bacro* (_ (a 1)) `(+ ,a 1))))
+  (test-wi (documentation amac) "this is a string"))
+(let ()
+  (define-macro (amac a) `(+ ,a 1))
+  (test (documentation amac) ""))
+(let ()
+  (define-bacro (amac a) ,a)
+  (test (documentation amac) ""))
+
+(test-wi (documentation abs) "(abs x) returns the absolute value of the real number x")
+(test-wi (#_help abs) "(abs x) returns the absolute value of the real number x")
+(test-wi (documentation 'abs) "(abs x) returns the absolute value of the real number x")
+(test (let ((hi (let ((+documentation+ "this is a test")) (lambda (x) (+ x 1)))))
+	(list (hi 1) (documentation hi)))
+      (list 2 "this is a test"))
+(test (documentation (let ((+documentation+ "docs")) (lambda* (a b) a))) "docs")
+(test (documentation (let ((+documentation+ "")) (lambda* (a b) a))) "")
+(test (documentation (let ((+documentation+ "args: (a b)")) (lambda* (a b) a))) "args: (a b)")
+(test (documentation (call-with-exit (lambda (c) c))) "")
+(test (documentation (call/cc (lambda (c) c))) "")
+(test (documentation) 'error)
+(test (documentation abs abs) 'error)
+(test (help begin) "(begin ...) evaluates each form in its body, returning the value of the last one")
+(test (help 'tan) "(tan z) returns tan(z)")
+(test (string? (documentation when)) #t)
+
+(if (not (provided? 'snd))
+    (for-each
+     (lambda (arg)
+       (test (documentation arg) "")
+       (test (help arg) #f))
+     (list -1 #\a #f _ht_ _undef_ 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi #(()) (list 1 2 3) '(1 . 2) "hi" :hi)))
+
+(let ((p (dilambda (lambda (a) (+ a 1)) (lambda (a b) (+ a b)))))
+  (when (zero? (*s7* 'debug)) (test (object->string (procedure-source p)) "(lambda (a) (+ a 1))"))
+  (let ((p1 p)
+	(p2 (dilambda (let ((+documentation+ "pws doc")) (lambda (a) (+ a 1))) (lambda (a b) (+ a b)))))
+    (test (equal? p p1) #t)
+    (test (equal? p1 p2) #f)
+    (test (documentation p2) "pws doc")
+    (test (apply p2 '(2)) 3)))
+
+(let ((func (eval '(let ((+documentation+ "this is from eval")) (lambda (a) (+ a 1))))))
+  (test (func 3) 4)
+  (test-wi (documentation func) "this is from eval"))
+(test (let ((e (inlet '(x . 3))))
+	(let ((func (eval '(lambda (a) (+ a x)) e)))
+	  (func 2)))
+      5)
+
+(unless (provided? 'snd)
+  (let ((e (openlet (inlet 'help (lambda (obj) "this is helpful")))))
+    (test-wi (help e) "this is helpful")))
+
+(let ()
+  (define fdoc (let ((+documentation+ "this is fdoc's doc")) (lambda (x) (+ x 1))))
+  (test-wi (documentation fdoc) "this is fdoc's doc")
+
+  (define fdoc* (let ((+documentation+ "this is fdoc*'s doc")) (lambda* ((x 0)) (+ x 1))))
+  (test-wi (documentation fdoc*) "this is fdoc*'s doc")
+
+  (define gdoc (let ((documentation (lambda (f) (format #f "this is gdoc's doc: ~S" (funclet f))))) (lambda (x) (+ x 1))))
+  (test-wi (documentation gdoc) "this is gdoc's doc: (inlet 'x ())")
+
+  (test-wi (documentation (let ((documentation (lambda (f) "this is lambda's doc"))) (lambda (x) (+ x 1)))) "this is lambda's doc")
+
+  (define mdoc (let ((+documentation+ "mdoc's doc")) (define-macro (_m_ x) `(+ 1 ,x))))
+  (test-wi (documentation mdoc) "mdoc's doc")
+
+  ;; there is no built-in setter for 'documentation
+  )
+
+
+;;; --------------------------------------------------------------------------------
+;;; signature
+
+(test (signature quasiquote) #f)
+(test (signature test) #f)
+
+(test (signature round abs) 'error)
+(test (signature) 'error)
+(test (signature :rest) #f)
+
+(for-each
+ (lambda (arg)
+   (test (signature arg) #f))
+ (list -1 #\a #f _undef_ 1 3.14 3/4 1.0+1.0i () 'hi :hi #<eof>))
+
+(let ((iter (make-iterator '(1 2))))
+  (test (make-iterator iter) 'error))
+
+(test (signature (make-iterator '(1 2))) '(#t))
+(test (signature (make-iterator #i(1 2))) '(integer?))
+(test (signature (make-iterator #r(1 2))) '(float?))
+(test (signature (make-iterator #u(1 2))) '(byte?))
+(test (signature (make-iterator #(1 2))) '(#t))
+(test (signature (make-iterator (inlet 'a 1))) '(pair?))
+(test (signature (make-iterator (hash-table 'a 1))) '(pair?))
+(test (signature (make-iterator "hi")) '(char?))
+(test (signature (make-iterator (let ((+signature+ '(integer? integer?)) (+iterator+ #t)) (lambda () 1)))) '(integer?))
+(test (signature (make-iterator (let ((+iterator+ #t)) (lambda () 1)))) '(#t))
+
+(test (signature "hi") '(char? string? integer?))
+(test (signature (c-pointer 0)) #f)
+(test (signature (hash-table 'a 1)) (let ((sig (list #t 'hash-table? #t))) (set-cdr! (cddr sig) (cddr sig)) sig))
+(test (equal? (let ((L (list 1 2 3))) (set-cdr! (cddr L) (cddr L)) L) (cons 1 (cons 2 (let ((L (list 3))) (set-cdr! L L))))) #t)
+(test (signature (list 1 2)) (cons #t (cons 'pair? (let ((L (list 'integer?))) (set-cdr! L L)))))
+(test (signature (vector 1 2)) (cons #t (cons 'vector? (let ((L (list 'integer?))) (set-cdr! L L)))))
+(test (signature (float-vector 1 2)) (cons 'float? (cons 'float-vector? (let ((L (list 'integer?))) (set-cdr! L L)))))
+(test (signature (int-vector 1 2)) (cons 'integer? (cons 'int-vector? (let ((L (list 'integer?))) (set-cdr! L L)))))
+(test (signature (byte-vector 1 2)) (cons 'byte? (cons 'byte-vector? (let ((L (list 'integer?))) (set-cdr! L L)))))
+(test (signature (inlet 'a 1)) (let ((sig (list #t 'let? 'symbol?))) (set-cdr! (cddr sig) (cddr sig)) sig))
+(test (signature #()) #f)
+(test (signature #i()) #f)
+(test (signature #r()) #f)
+(test (signature #u()) #f)
+
+(when with-block
+  (test (signature (block 1 2)) '(#t block? integer?))
+  (test (signature block-ref) '(#t block? integer?))
+  (test (signature block-set!) '(real? block? integer? float?))
+  (test (signature block?) '(boolean? #t)))
+
+(let ()
+  (define f1 (let ((+signature+ '(real? boolean?)))
+	       (lambda (x)
+		 (if x 1.0 2.0))))
+  (test (signature f1) '(real? boolean?))
+  (define f2 f1)
+  (test (signature f1) '(real? boolean?))
+  (test (signature f2) '(real? boolean?))
+  (test (f1 #t) (f2 #t))
+  (define f3 f1)
+  (test (signature f1) '(real? boolean?))
+  (test (signature f2) '(real? boolean?))
+  (define f4 f2)
+  (test (signature f1) '(real? boolean?))
+  (test (signature f2) '(real? boolean?)))
+
+(let ()
+  (define fsig (let ((+signature+ '(integer? integer?))) (lambda (x) (+ x 1))))
+  (test (signature fsig) '(integer? integer?))
+
+  (define fsig* (let ((+signature+ '(integer? integer?))) (lambda* ((x 0)) (+ x 1))))
+  (test (signature fsig*) '(integer? integer?))
+
+  (define gsig (let ((signature (lambda (f) (list 'integer? 'integer?)))) (lambda (x) (+ x 1))))
+  (test (signature gsig) '(integer? integer?))
+
+  (test (signature (let ((signature (lambda (f) (list 'integer? 'integer?)))) (lambda (x) (+ x 1)))) '(integer? integer?))
+
+  (define msig (let ((+signature+ '(number? #t))) (define-macro (_m_ x) `(+ 1 ,x))))
+  (test (signature msig) '(number? #t))
+
+  ;; there is no built-in setter for 'signature
+  )
+
+(unless pure-s7
+  (test (signature char-ci<=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+  (test (signature char-ci<?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+  (test (signature char-ci=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+  (test (signature char-ci>=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+  (test (signature char-ci>?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+  (test (signature char-ready?) '(boolean? input-port?))
+  (test (signature exact->inexact) '(number? number?))
+  (test (signature exact?) '(boolean? number?))
+  (test (signature inexact->exact) '(real? real?))
+  (test (signature inexact?) '(boolean? number?))
+  (test (signature integer-length) (let ((L (list 'integer?))) (set-cdr! L L) L))
+  (test (signature let->list) '(pair? let?))
+  (test (signature list->string) '(string? proper-list?))
+  (test (signature list->vector) '(vector? proper-list?))
+  (test (signature make-polar) '(number? real? real?))
+  (test (signature set-current-error-port) '((output-port? not) (output-port? not)))
+  (test (signature set-current-input-port) '(input-port? input-port?))
+  (test (signature set-current-output-port) '((output-port? not) (output-port? not)))
+  (test (signature string->list) (let ((L (list 'proper-list? 'string? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
+  (test (signature string-ci<=?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+  (test (signature string-ci<?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+  (test (signature string-ci=?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+  (test (signature string-ci>=?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+  (test (signature string-ci>?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+  (test (signature string-fill!) (list '(char? integer?) 'string? 'char? 'integer? 'integer?))
+  (test (signature string-length) '(integer? string?))
+  (test (signature vector->list) (list 'proper-list? 'vector? 'integer? 'integer?))
+  (test (signature vector-append) (let ((L (list 'vector?))) (set-cdr! L L) L))
+  (test (signature vector-fill!) (let ((L (list #t 'vector? #t 'integer?))) (set-cdr! (cdddr L) (cdddr L)) L))
+  (test (signature vector-length) '(integer? vector?))
+  )
+
+(test (signature boolean?) '(boolean? #t))
+(test (signature round) '(integer? real?))
+(test (signature #_exit) '(#t #t))
+(test (signature (symbol "(c-object set)")) #f)
+(test (signature *) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (signature +) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (signature -) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (signature /) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (signature <) (let ((L (list 'boolean? 'real?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature <=) (let ((L (list 'boolean? 'real?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature =) (let ((L (list 'boolean? 'number?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature >) (let ((L (list 'boolean? 'real?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature >=) (let ((L (list 'boolean? 'real?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature abs) '(real? real?))
+(test (signature acos) '(number? number?))
+(test (signature acosh) '(number? number?))
+(test (signature angle) '(real? number?))
+(test (signature append) (let ((L (list #t))) (set-cdr! L L) L))
+(test (signature apply) (let ((L (list 'values '(procedure? sequence?) #t))) (set-cdr! (cddr L) (cddr L)) L))
+(test (signature apply-values) '(#t list?))
+(test (signature aritable?) '(boolean? #t integer?))
+(test (signature arity) '((pair? not) #t))
+(test (signature ash) (let ((L (list 'integer?))) (set-cdr! L L) L))
+(test (signature asin) '(number? number?))
+(test (signature asinh) '(number? number?))
+(test (signature assoc) '((pair? boolean?) #t list? procedure?))
+(test (signature assq) '((pair? not) #t list?))
+(test (signature assv) '((pair? not) #t list?))
+(test (signature atan) '(number? number? real?))
+(test (signature atanh) '(number? number?))
+(when (provided? 'autoload)
+  (test (signature autoload) '(#t symbol? #t))
+  (test (signature *autoload*) '(#t symbol?)))
+(test (signature bignum) (if with-bignums '(bignum? (number? string?) integer?) '((number? not) (number? string?) integer?)))
+(test (signature boolean?) '(boolean? #t))
+(test (signature byte-vector) (let ((L (list 'byte-vector? 'byte?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature byte-vector-ref) (let ((L (list '(byte? byte-vector?) 'byte-vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
+(test (signature byte-vector-set!) (let ((L (list 'byte? 'byte-vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
+(test (signature byte-vector?) '(boolean? #t))
+(test (signature byte-vector->string) '(string? byte-vector?))
+(test (signature c-object?) '(boolean? #t))
+(test (signature c-object-type) '(integer? c-object?))
+(test (signature c-pointer) (let ((L (list 'c-pointer? 'integer? #t))) (set-cdr! (cddr L) (cddr L)) L))
+(test (signature c-pointer?) '(boolean? #t #t))
+(test (signature c-pointer-info) '(#t c-pointer?))
+(test (signature c-pointer-type) '(#t c-pointer?))
+(test (signature c-pointer-weak1) '(#t c-pointer?))
+(test (signature c-pointer-weak2) '(#t c-pointer?))
+(test (signature caaaar) '(#t pair?))
+(test (signature caaadr) '(#t pair?))
+(test (signature caaar) '(#t pair?))
+(test (signature caadar) '(#t pair?))
+(test (signature caaddr) '(#t pair?))
+(test (signature caadr) '(#t pair?))
+(test (signature caar) '(#t pair?))
+(test (signature cadaar) '(#t pair?))
+(test (signature cadadr) '(#t pair?))
+(test (signature cadar) '(#t pair?))
+(test (signature caddar) '(#t pair?))
+(test (signature cadddr) '(#t pair?))
+(test (signature caddr) '(#t pair?))
+(test (signature cadr) '(#t pair?))
+(test (signature call-with-current-continuation) '(#t procedure?))
+(test (signature call-with-exit) '(values procedure?))
+(test (signature call-with-input-file) '(#t string? (procedure? macro?)))
+(test (signature call-with-input-string) '(#t string? (procedure? macro?)))
+(test (signature call-with-output-file) '(#t string? (procedure? macro?)))
+(test (signature call-with-output-string) '(string? (procedure? macro?)))
+(test (signature call/cc) '(#t procedure?))
+(test (signature car) '(#t pair?))
+(test (signature catch) '(values (symbol? boolean?) procedure? procedure?))
+(test (signature cdaaar) '(#t pair?))
+(test (signature cdaadr) '(#t pair?))
+(test (signature cdaar) '(#t pair?))
+(test (signature cdadar) '(#t pair?))
+(test (signature cdaddr) '(#t pair?))
+(test (signature cdadr) '(#t pair?))
+(test (signature cdar) '(#t pair?))
+(test (signature cddaar) '(#t pair?))
+(test (signature cddadr) '(#t pair?))
+(test (signature cddar) '(#t pair?))
+(test (signature cdddar) '(#t pair?))
+(test (signature cddddr) '(#t pair?))
+(test (signature cdddr) '(#t pair?))
+(test (signature cddr) '(#t pair?))
+(test (signature cdr) '(#t pair?))
+(test (signature ceiling) '(integer? real?))
+(test (signature char->integer) '(integer? char?))
+(test (signature char-alphabetic?) '(boolean? char?))
+(test (signature char-downcase) (let ((L (list 'char?))) (set-cdr! L L) L))
+(test (signature char-lower-case?) '(boolean? char?))
+(test (signature char-numeric?) '(boolean? char?))
+(test (signature char-position) '((integer? not) (char? string?) string? integer?))
+(test (signature char-upcase) (let ((L (list 'char?))) (set-cdr! L L) L))
+(test (signature char-upper-case?) '(boolean? char?))
+(test (signature char-whitespace?) '(boolean? char?))
+(test (signature char<=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature char<?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature char=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature char>=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature char>?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature char?) '(boolean? #t))
+(test (signature close-input-port) '(unspecified? input-port?))
+(test (signature close-output-port) '(unspecified? (output-port? not)))
+(test (signature complex) '(number? real? real?))
+(test (signature complex?) '(boolean? #t))
+(test (signature cons) '(pair? #t #t))
+(test (signature continuation?) '(boolean? #t))
+(test (signature copy) (let ((L (list #t #t #t 'integer?))) (set-cdr! (cdddr L) (cdddr L)) L))
+(test (signature cos) '(number? number?))
+(test (signature cosh) '(number? number?))
+(test (signature coverlet) (let ((L (list (list 'let? 'procedure? 'macro? 'c-object?)))) (set-cdr! L L) L))
+(test (signature curlet) '(let?))
+(test (signature current-error-port) '((output-port? not)))
+(test (signature current-input-port) '(input-port?))
+(test (signature current-output-port) '((output-port? not)))
+(test (signature cutlet) (let ((L (list 'let? 'let? 'symbol?))) (set-cdr! (cddr L) (cddr L)) L))
+(test (signature cyclic-sequences) '(proper-list? #t))
+(test (signature defined?) '(boolean? symbol? (let? procedure? macro? c-object? c-pointer?) boolean?)) ; macro? includes bacro?
+(test (signature delete-file) '(integer? string?))
+(test (signature denominator) '(integer? rational?))
+(test (signature dilambda) '(procedure? procedure? procedure?))
+(test (signature dilambda?) '(boolean? #t))
+(test (signature directory->list) '(list? string?))
+(test (signature directory?) '(boolean? string?))
+(test (signature display) '(#t #t (output-port? not)))
+(test (signature dynamic-wind) '(values (procedure? not) procedure? (procedure? not)))
+(test (signature dynamic-unwind) '(procedure? procedure? #t))
+(test (signature emergency-exit) '(#t #t))
+(test (signature eof-object?) '(boolean? #t))
+(test (signature eq?) (let ((L (list 'boolean? #t))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature equal?) (let ((L (list 'boolean? #t))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature eqv?) (let ((L (list 'boolean? #t))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature error) (let ((L (list 'values #t))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature eval) '(values #t let?))
+(test (signature eval-string) '(values string? let?))
+(test (signature even?) '(boolean? integer?))
+(test (signature exp) '(number? number?))
+(test (signature expt) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (signature file-exists?) '(boolean? string?))
+(test (signature file-mtime) '(integer? string?))
+(test (signature fill!) (let ((L (list #t 'sequence? #t 'integer?))) (set-cdr! (cdddr L) (cdddr L)) L))
+(test (signature float-vector) (let ((L (list 'float-vector? 'real?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature float-vector-ref) (let ((L (list '(float? float-vector?) 'float-vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
+(test (signature float-vector-set!) (let ((L (list 'real? 'float-vector? 'integer? 'integer:real?))) (set-cdr! (cdddr L) (cdddr L)) L))
+(test (signature float-vector?) '(boolean? #t))
+(test (signature float?) '(boolean? #t))
+(test (signature floor) '(integer? real?))
+(test (signature flush-output-port) '(#t (output-port? not)))
+(test (signature for-each) (let ((L (list 'unspecified? 'procedure? 'sequence?))) (set-cdr! (cddr L) (cddr L)) L))
+(test (signature format) (let ((L (list 'string? '(output-port? boolean? null?) #t))) (set-cdr! (cddr L) (cddr L)) L)) ; changed 19-Mar-24
+(test (signature funclet) '((let? null?) (procedure? macro? symbol?)))
+(test (signature funclet?) '(boolean? #t))
+(test (signature gc) '(#t boolean?))
+(test (signature gcd) (let ((L (list 'rational?))) (set-cdr! L L) L))
+(test (signature gensym) '(gensym? string?))
+(test (signature gensym?) '(boolean? #t))
+(test (signature get-output-string) '(string? (output-port? not) boolean?))
+(test (signature getenv) '((string? not) string?))
+(test (signature hash-table) (let ((L (list 'hash-table? #t))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature hash-table-entries) '(integer? hash-table?))
+(test (signature hash-table-key-typer) '((not procedure?) hash-table?))
+(test (signature hash-table-ref) (let ((L (list #t 'hash-table? #t))) (set-cdr! (cddr L) (cddr L)) L))
+(test (signature hash-table-set!) '(#t hash-table? #t #t))
+(test (signature hash-table-value-typer) '((not procedure?) hash-table?))
+(test (signature hash-table?) '(boolean? #t))
+(test (signature imag-part) '(real? number?))
+(test (signature immutable!) '(#t #t let?))
+(test (signature immutable?) '(boolean? #t let?))
+(test (signature infinite?) '(boolean? #t)) ; was number? but we want to use this in signatures
+(test (signature inlet) (let ((L (list 'let? #t))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature input-port?) '(boolean? #t))
+(test (signature int-vector) (let ((L (list 'int-vector? 'integer?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature int-vector-ref) (let ((L (list '(integer? int-vector?) 'int-vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
+(test (signature int-vector-set!) (let ((L (list 'integer? 'int-vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
+(test (signature int-vector?) '(boolean? #t))
+(test (signature integer->char) '(char? integer?))
+(test (signature integer-decode-float) '(pair? float?))
+(test (signature integer?) '(boolean? #t))
+(test (signature iterate) '(#t iterator?))
+(test (signature iterator-at-end?) '(boolean? iterator?))
+(test (signature iterator-sequence) '(sequence? iterator?))
+(test (signature iterator?) '(boolean? #t))
+(test (signature keyword->symbol) '(symbol? keyword?))
+(test (signature keyword?) '(boolean? #t))
+(test (signature lcm) (let ((L (list 'rational?))) (set-cdr! L L) L))
+(test (signature length) '((integer? infinite? not) #t))
+(test (signature let-ref) '(#t let? symbol?))
+(test (signature let-set!) '(#t let? symbol? #t))
+(test (signature let?) '(boolean? #t))
+(test (signature list) (let ((L (list 'proper-list? #t))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature list-ref) (let ((L (list #t 'pair? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
+(test (signature list-set!) (let ((L (list #t 'pair? 'integer? 'integer:any?))) (set-cdr! (cdddr L) (cdddr L)) L))
+(test (signature list-tail) '(#t pair? integer?))
+(test (signature list?) '(boolean? #t))
+;(test (signature #<list*>) '(list? list? #t))
+(test (signature load) '(values string? let?))
+(test (signature log) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (signature logand) (let ((L (list 'integer?))) (set-cdr! L L) L))
+(test (signature logbit?) (let ((L (list 'boolean? 'integer?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature logior) (let ((L (list 'integer?))) (set-cdr! L L) L))
+(test (signature lognot) (let ((L (list 'integer?))) (set-cdr! L L) L))
+(test (signature logxor) (let ((L (list 'integer?))) (set-cdr! L L) L))
+(test (signature macro?) '(boolean? #t))
+(test (signature magnitude) '(real? number?))
+(test (signature make-byte-vector) '(byte-vector? (integer? pair?) byte?))
+(test (signature make-float-vector) '(float-vector? (integer? pair?) real?))
+(test (signature make-hash-table) '(hash-table? integer? (procedure? pair? not) (pair? not)))
+(test (signature make-weak-hash-table) '(weak-hash-table? integer? (procedure? pair? not) (pair? not)))
+(test (signature make-int-vector) '(int-vector? (integer? pair?) integer?))
+(test (signature make-iterator) '(iterator? sequence? pair?))
+(test (signature make-list) '(proper-list? integer? #t))
+(test (signature make-rectangular) '(number? real? real?))
+(test (signature make-string) '(string? integer? char?))
+(test (signature make-vector) '(vector? (integer? pair?) #t (procedure? boolean?))) ; boolean? here should be #t -- #f == #t currently
+(test (signature map) (let ((L (list 'proper-list? 'procedure? 'sequence?))) (set-cdr! (cddr L) (cddr L)) L))
+(test (signature max) (let ((L (list 'real?))) (set-cdr! L L) L))
+(test (signature member) '((pair? not) #t list? procedure?))
+(test (signature memq) '((pair? not) #t list?))
+(test (signature memv) '((pair? not) #t list?))
+(test (signature min) (let ((L (list 'real?))) (set-cdr! L L) L))
+(test (signature modulo) (let ((L (list 'real?))) (set-cdr! L L) L))
+(test (signature equivalent?) (let ((L (list 'boolean? #t))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature nan?) '(boolean? #t)) ; see infinite?
+(test (signature negative?) '(boolean? real?))
+(test (signature newline) '(char? (output-port? not)))
+(test (signature not) '(boolean? #t))
+(test (signature null?) '(boolean? #t))
+(test (signature number->string) '(string? number? integer?))
+(test (signature number?) '(boolean? #t))
+(test (signature numerator) '(integer? rational?))
+(test (signature object->string) '(string? #t (boolean? keyword?) integer?))
+(test (signature odd?) '(boolean? integer?))
+(test (signature open-input-file) '(input-port? string? string?))
+(test (signature open-input-function) '(input-port? (procedure? macro?)))
+(test (signature open-input-string) '(input-port? string?))
+(test (signature open-output-function) '(output-port? (procedure? macro?)))
+(test (signature open-output-file) '(output-port? string? string?))
+(test (signature open-output-string) '(output-port?))
+(test (signature openlet) (let ((L (list (list 'let? 'procedure? 'macro? 'c-object?)))) (set-cdr! L L) L))
+(test (signature openlet?) '(boolean? #t))
+(test (signature outlet) '(let? let?))
+(test (signature output-port?) '(boolean? #t))
+(test (signature owlet) '(let?))
+(test (signature pair-filename) '((string? not) pair?))
+(test (signature pair-line-number) '((integer? not) pair?))
+(test (signature pair?) '(boolean? #t))
+(test (signature peek-char) '((char? eof-object?) input-port?))
+(test (signature port-closed?) '(boolean? (input-port? output-port? not)))
+(test (signature port-file) '(c-pointer? (input-port? output-port?)))
+(test (signature port-filename) '(string? (input-port? output-port?)))
+(test (signature port-line-number) '(integer? input-port?))
+(test (signature port-string) '(string? (input-port? output-port?)))
+(test (signature port-position) '(integer? input-port?))
+(test (signature positive?) '(boolean? real?))
+(test (signature documentation) '(string? #t))
+(test (signature procedure-source) '(list? (procedure? macro?)))
+(test (signature procedure-arglist) '((list? symbol?) (procedure? macro?)))
+(test (signature procedure?) '(boolean? #t))
+(test (signature proper-list?) '(boolean? #t))
+(test (signature provide) '(symbol? symbol?))
+(test (signature provided?) '(boolean? symbol?))
+(test (signature quasiquote) #f)
+(test (signature quotient) (let ((L (list 'real?))) (set-cdr! L L) L))
+(test (signature random) '(number? number? random-state?))
+(test (signature random-state) (let ((L (list 'random-state? 'integer?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature random-state->list) (if with-bignums '(list? random-state?) '(pair? random-state?)))
+(test (signature random-state?) '(boolean? #t))
+(test (signature rational?) '(boolean? #t))
+(test (signature rationalize) '(rational? real? real?)) ; maybe return type: (real? boolean?) but I can't find a case for either
+(test (signature read) '(#t input-port?))
+(test (signature read-byte) '((byte? eof-object?) input-port?))
+(test (signature read-char) '((char? eof-object?) input-port?))
+(test (signature read-line) '((string? eof-object?) input-port? boolean?))
+(test (signature read-string) '((string? eof-object?) integer? input-port?))
+(test (signature real-part) '(real? number?))
+(test (signature real?) '(boolean? #t))
+(test (signature remainder) (let ((L (list 'real?))) (set-cdr! L L) L))
+(test (signature reverse!) '(sequence? sequence?))
+(test (signature reverse) '(sequence? sequence?))
+(test (signature rootlet) '(let?))
+(test (signature round) '(integer? real?))
+(test (signature *function*) '(#t let? symbol?))
+(test (signature sequence?) '(boolean? #t))
+(test (signature set-car!) '(#t pair? #t))
+(test (signature set-cdr!) '(#t pair? #t))
+(test (signature setter) '((not procedure?) #t (let? null?)))
+(test (signature signature) '((pair? boolean?) #t))
+(test (signature sin) '(number? number?))
+(test (signature sinh) '(number? number?))
+(test (signature sort!) '(sequence? sequence? procedure?))
+(test (signature sqrt) '(number? number?))
+(test (signature stacktrace) '(string? integer? integer? integer? integer? boolean?))
+(test (signature string) (let ((L (list 'string? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature string->byte-vector) '(byte-vector? string?))
+(test (signature string-copy) '(string? string? string? integer? integer?))
+(test (signature string->keyword) '(keyword? string?))
+(test (signature string->number) '((number? not) string? integer?))
+(test (signature string->symbol) '(symbol? string?))
+(test (signature string-append) (let ((L (list 'string?))) (set-cdr! L L) L))
+(test (signature string-downcase) (let ((L (list 'string?))) (set-cdr! L L) L))
+(test (signature string-position) '((integer? not) string? string? integer?))
+(test (signature string-ref) '(char? string? integer?))
+(test (signature string-set!) '(char? string? integer? char?))
+(test (signature string-upcase) (let ((L (list 'string?))) (set-cdr! L L) L))
+(test (signature string<=?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature string<?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature string=?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature string>=?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature string>?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature string?) '(boolean? #t))
+(test (signature sublet) (let ((L (list 'let? '(let? null?) '(pair? symbol? let?) #t))) (set-cdr! (cdddr L) (cddr L)) L))
+(test (signature substring) '(string? string? integer? integer?))
+(test (signature substring-uncopied) '(string? string? integer? integer?))
+(test (signature subvector) '(subvector? vector? integer? integer? pair?))
+(test (signature subvector?) '(boolean? #t))
+(test (signature subvector-position) '(integer? subvector?))
+(test (signature subvector-vector) '(vector? subvector?))
+(test (signature symbol) (let ((L (list 'symbol? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature symbol->dynamic-value) '(#t symbol?))
+(test (signature symbol-initial-value) '(#t symbol?))
+(test (signature symbol->keyword) '(keyword? symbol?))
+(test (signature symbol->string) '(string? symbol?))
+(test (signature symbol->value) '(#t symbol? (let? procedure? c-pointer? continuation? goto? macro?)))
+;(test (signature setter) '((boolean? procedure?) symbol? let?))
+(test (signature symbol-table) '(vector?))
+(test (signature symbol?) '(boolean? #t))
+(test (signature system) '((integer? string?) string? boolean?))
+(test (signature tan) '(number? number?))
+(test (signature tanh) '(number? number?))
+(test (signature throw) (let ((L (list 'values #t))) (set-cdr! (cdr L) (cdr L)) L)) ; was pcl_t
+(test (signature tree-count) '(integer? #t list? integer?))
+(test (signature tree-leaves) '(integer? list?))
+(test (signature tree-memq) '(boolean? #t list?))
+(test (signature tree-set-memq) '(boolean? list? list?))
+(test (signature tree-cyclic?) '(boolean? #t))
+(test (signature truncate) '(integer? real?))
+(test (signature type-of) '((symbol? not) #t))
+(test (signature unlet) '(let?))
+(test (signature values) (let ((L (list 'values #t))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature varlet) (let ((L (list 'let? '(let? null?) '(pair? symbol? let?) #t))) (set-cdr! (cdddr L) (cddr L)) L))
+(test (signature vector) (let ((L (list 'vector? #t))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature vector-dimensions) '(pair? vector?))
+(test (signature vector-dimension) '(integer? vector? integer?))
+(test (signature vector-rank) '(integer? vector?))
+(test (signature vector-ref) (let ((L (list #t 'vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
+(test (signature vector-set!) (let ((L (list #t 'vector? 'integer? 'integer:any?))) (set-cdr! (cdddr L) (cdddr L)) L))
+(test (signature vector-typer) '((not procedure?) vector?))
+(test (signature vector?) '(boolean? #t))
+(test (signature with-input-from-file) '(#t string? (procedure? macro?)))
+(test (signature with-input-from-string) '(#t string? (procedure? macro?)))
+(test (signature with-output-to-file) '(#t string? (procedure? macro?)))
+(test (signature with-output-to-string) '(string? (procedure? macro?)))
+(test (signature write) '(#t #t (output-port? not)))
+(test (signature write-byte) '(byte? byte? (output-port? not)))
+(test (signature write-char) '(char? char? (output-port? not)))
+(test (signature write-string) (let ((L (list 'string? 'string? '(output-port? not) 'integer?))) (set-cdr! (cdddr L) (cdddr L)) L))
+(test (signature zero?) '(boolean? number?))
+(test (signature object->let) '(let? #t))
+(test (signature undefined?) '(boolean? #t))
+(test (signature constant?) '(boolean? #t))
+(test (signature help) '((string? boolean?) #t))
+(test (signature profile-in) '(#t integer? let?))
+(test (signature unspecified?) '(boolean? #t))
+(test (signature c-pointer->list) '(pair? c-pointer?))
+(test (signature exit) '(#t #t))
+(test (signature bignum?) '(boolean? #t))
+(test (signature weak-hash-table?) '(boolean? #t))
+(test (signature weak-hash-table) (let ((L (list 'hash-table? #t))) (set-cdr! (cdr L) (cdr L)) L))
+(test (signature goto?) '(boolean? #t))
+(test (signature byte?) '(boolean? #t))
+(test (signature hash-code) '(integer? #t #t))
+(test (signature syntax?) '(boolean? #t))
+(test (signature list-values) (let ((L (list 'list? #t))) (set-cdr! (cdr L) (cdr L)) L))
+
+(test (signature make-hook) #f)
+(test (signature hook-functions) '(#t procedure?))
+
+(test (signature 'abs) #f)
+(test (signature #(1 2)) (let ((lst (list #t 'vector? 'integer?))) (set-cdr! (cddr lst) (cddr lst)) lst))
+(test (signature #i(1 2)) (let ((lst (list 'integer? 'int-vector? 'integer?))) (set-cdr! (cddr lst) (cddr lst)) lst))
+(test (signature #r(1.0 2.0)) (let ((lst (list 'float? 'float-vector? 'integer?))) (set-cdr! (cddr lst) (cddr lst)) lst))
+(test (signature #u(1 2)) (cons 'byte? (cons 'byte-vector? (let ((L (list 'integer?))) (set-cdr! L L)))))
+(test (signature "12") '(char? string? integer?))
+(test (signature '(1 2)) (let ((lst (list #t 'pair? 'integer?))) (set-cdr! (cddr lst) (cddr lst)) lst))
+(test (signature (hash-table 'a 1)) (let ((sig (list #t 'hash-table? #t))) (set-cdr! (cddr sig) (cddr sig)) sig))
+(test (signature (inlet 'a 1)) (let ((sig (list #t 'let? 'symbol?))) (set-cdr! (cddr sig) (cddr sig)) sig))
+(test (signature (openlet (inlet 'a 1 'signature (lambda (obj) (list 'integer? 'let? 'symbol?))))) '(integer? let? symbol?))
+(test (signature (make-hash-table 8 #f (cons symbol? integer?))) '(integer? hash-table? symbol?))
+
+(let ((var 1))
+  (set! (setter 'var) (let ((+signature+ '(integer?))) (lambda (s v) 1)))
+  (test (signature 'var) '(integer?)))
+(let ((var 1))
+  (set! (setter 'var) (let ((+signature+ '(integer?))) (lambda (s v) 1)))
+  (let ((var 2))
+    (test (signature 'var) #f)))
+
+(test (s7-optimize '((vector-ref +signature+ (make-byte-vector '(4 32) 255) (* 2 x 3.0 4) (car)))) #<undefined>)
+
+(define (symbol->value-anywhere sym)
+  (if (defined? sym)
+      (symbol->value sym)
+      (letrec ((libsearch
+		(lambda (sym libs)
+		  (if (pair? libs)
+		      (if (defined? sym (cdar libs))
+			  (symbol->value sym (cdar libs))
+			  (libsearch sym (cdr libs)))
+		      #<undefined>))))
+	(libsearch sym *libraries*))))
+
+(let ((st (symbol-table)))
+  (for-each (lambda (s)
+	      (catch #t
+		(lambda ()
+		  (let ((f (symbol->value-anywhere s)))
+		    (if (procedure? f)
+			(let ((sig (signature f))
+			      (ari (arity f)))
+			  (if (and sig (not (pair? sig)))
+			      (format *stderr* "signature ~A: ~A~%" s sig))
+			  (when (pair? sig)
+			    (if (and (pair? ari)
+				     (> (cdr ari) (- (length sig) 1))
+				     (or (< (cdr ari) 20)
+					 (< (length sig) 10))
+				     (not (eq? s 'make-hook)))
+				(format *stderr* "signature is missing arg type: ~A: ~A ~A~%~%" s ari sig))
+			    (when (and (pair? sig)
+				       (pair? (car sig))
+				       (or (null? (cdar sig))
+					   (memq #t (car sig))
+					   (let search ((lst (car sig)))
+					     (and (pair? lst)
+						  (or (memq (car lst) (cdr lst))
+						      (search (cdr lst)))))))
+			      (format *stderr* "arity/sig mismatch? ~A: ~A?~%" s sig)))))))
+		(lambda args #f)))
+	    st))
+
+
+;;; --------------------------------------------------------------------------------
+;;; funclet
+
+(let ((f1 (lambda (a) (+ a 1)))
+      (f2 (lambda* ((a 2)) (+ a 1))))
+  (define (hi a) (+ a 1))
+  (define* (ho (a 1)) (+ a 1))
+  (test (let? (funclet hi)) #t)
+  (test (let? (funclet ho)) #t)
+  (test (let? (funclet f1)) #t)
+  (test (let? (funclet f2)) #t)
+  (test (let? (funclet abs)) #t)
+  (test (> (length (funclet abs)) 100) #t)
+  (test (fill! (funclet abs) 0) 'error)
+  (test (reverse (funclet abs)) 'error) ; was rootlet 14-Feb-19
+  (test (fill! (funclet ho) 0) 'error)
+  (test (reverse (funclet ho)) 'error))  ; changed to error as above
+
+(test (funclet quasiquote) (rootlet))
+(test (funclet lambda) 'error)
+(test (funclet abs) (rootlet))
+(test (funclet cond-expand) (rootlet))
+
+(let ()
+  (define func (let ((lst (list 1 2 3)))
+		 (lambda (a)
+		   (((funclet func) 'lst) a))))
+  (test (func 1) 2))
+
+(let ()
+  (define func (let ((lst (list 1 2 3)))
+		 (lambda (a)
+		   ((funclet func) 'lst a))))
+  (test (func 1) 2))
+
+(let  ((lt (inlet 'a #(1 2 3))))
+  (test (lt 'a 1) 2))
+
+(let ()
+  (define func (let ((lst (list 1 2 3)))
+		 (lambda (a)
+		   ((list (funclet func)) 0 'lst))))
+  (test (func 1) '(1 2 3)))
+
+(let ()
+  (define f1 (let ((private-var 1)) (lambda () private-var)))
+  (define (f2) (+ ((funclet f1) 'private-var) 1))
+  (test (list (f1) (f2)) '(1 2)))
+(let ((f1 #f) (f2 #f))
+  (let ((private-var 1))
+    (set! f1 (lambda () private-var))
+    (set! f2 (lambda () (+ private-var 1))))
+  (test (list (f1) (f2)) '(1 2)))
+
+(for-each
+ (lambda (arg)
+   (test (funclet arg) 'error))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi #(()) (list 1 2 3) '(1 . 2) "hi"))
+
+(test (let ()
+	(define (hi a)
+	  (let ((func (*function* (curlet))))
+	    (list (if (symbol? func) func (car func))
+		  a)))
+	(hi 1))
+      (list 'hi 1))
+
+(set! (hook-functions *unbound-variable-hook*) ())
+(catch #t
+  (lambda ()
+    (let ()
+      (define (f1 e)
+	(with-let e
+	  (hash-table-set! ht :a (abs x))))
+      (f1 (inlet :ht (make-hash-table) :x -1))
+      (f1 (inlet :ht (make-hash-table) :x -1))
+      (test (f1 (inlet :ht (make-hash-table))) 'error)))
+  (lambda args #f))
+
+(catch #t
+  (lambda ()
+    (let ()
+      (let ((x 1))
+	(let ((ht (make-hash-table)))
+	  (define (f1)
+	    (hash-table-set! ht :a (abs x)))
+	  (f1)
+	  (set! (outlet (curlet)) (inlet))
+	  (test (f1) 'error)))))
+  (lambda args #f))
+
+(let ()
+  (define (f1)
+    (with-output-to-string
+      (lambda ()
+	(do ((i 0 (+ i 1)))
+	    ((= i 3))
+	  (with-let (inlet 'x 1)
+	    (display x))))))
+  (test (f1) "111"))
+
+(let ()
+  (define (f1 e)
+    (do ((i 0 (+ i 1)))
+	((= i 3))
+      (with-let e
+        (hash-table-set! ht :a (abs x)))))
+  (f1 (inlet :ht (make-hash-table) :x -1))
+  (test (f1 (inlet :ht (make-hash-table) :x -1)) #t))
+
+(test (let ()
+	(define hi (let ((a 32))
+		     (lambda (b)
+		       (+ a b))))
+	(define ho (with-let
+		    (funclet hi)
+		    (lambda (b)
+		      (+ a b))))
+	(list (hi 1) (ho 1)))
+      (list 33 33))
+
+(test (let ()
+	(define (hi a) (+ a 1))
+	(with-let (funclet hi)
+			  ((eval (procedure-source hi)) 2)))
+      3)
+
+(let ()
+  (define (where-is func)
+    (let ((addr (with-let (funclet func) (*function* (curlet)))))
+      (if (not (pair? addr))
+	  ""
+	  (list (format #f "~A[~D]" (cadr addr) (caddr addr))
+		addr))))
+  (let ((e (where-is ok?)))
+    (test (and (pair? (cadr e))
+	       (< ((cadr e) 2) 1000)) ; this depends on where ok? is in this file
+	  #t)
+    (test (and (pair? (cadr e))
+	       (string=? (symbol->string (car (cadr e))) "ok?"))
+	  #t)
+    (test (and (pair? (cadr e))
+	       (let ((name (cadr (cadr e))))
+		 (and (string? name)
+		      (call-with-exit
+		       (lambda (oops)
+			 (let ((len (length name)))
+			   (do ((i 0 (+ i 1)))
+			       ((= i len) #t)
+			     (if (and (not (char-alphabetic? (name i)))
+				      (not (char=? (name i) #\/))
+				      (not (char=? (name i) #\\))
+				      (not (char=? (name i) #\.))
+				      (not (char=? (name i) #\-))
+				      (not (char-numeric? (name i))))
+				 (begin
+				   (format #t "ok? file name: ~S~%" name)
+				   (oops #f))))))))))
+	  #t)))
+
+(test (let () (define (f1 a) (*function* (curlet))) (let ((fe (f1 1))) (if (pair? fe) (car fe) fe))) 'f1)
+(test (let () (define (f1 a)
+		(define (f2 b) (*function* (curlet)))
+		(f2 a))
+	   (let ((fe (f1 1))) (if (pair? fe) (car fe) fe)))
+      'f2)
+(test (let () (define (f1 a)
+		(define (f2 b)
+		  (define (f3 c) (*function* (curlet)))
+		  (f3 b))
+		(f2 a))
+	   (let ((fe (f1 2))) (if (pair? fe) (car fe) fe)))
+      'f3)
+(test (let () (define (f1 a)
+		(define (f2 b)
+		  (define (f3 c)
+		    (define (f4 d) (*function* (curlet)))
+		    (f4 c))
+		  (f3 b))
+		(f2 a))
+	   (let ((fe (f1 1)))
+	     (if (pair? fe) (car fe) fe)))
+      'f4)
+(test (let () (define (f1 a) (let () (define (f2 b) (*function* (curlet))) (f2 a))) (let ((fe (f1 1))) (if (pair? fe) (car fe) fe))) 'f2)
+(test (with-let (funclet abs) (*function* (curlet))) #f)
+(test (with-let (funclet quasiquote) (*function* (curlet))) #f)
+(test (with-let (funclet reader-cond) (*function* (curlet))) #f)
+(test (with-let (funclet *error-hook*) (*function*)) 'make-hook)
+
+(let ()
+  (define-macro (window func beg end . body)
+    `(call-with-exit
+      (lambda (quit)
+	(do ((notes ',body (cdr notes)))
+	    ((null? notes))
+	  (let* ((note (car notes))
+		 (note-beg (cadr note)))
+	    (if (<= ,beg note-beg)
+		(if (> note-beg (+ ,beg ,end))
+		    (quit)
+		    (,func note))))))))
+
+  (test
+   (let ((n 0))
+     (window (lambda (a-note) (set! n (+ n 1))) 0 1
+	     (fm-violin 0 1 440 .1)
+	     (fm-violin .5 1 550 .1)
+	     (fm-violin 3 1 330 .1))
+     n)
+   2)
+
+  (test
+   (let ((notes 0)
+	 (env #f))
+     (set! env (curlet))
+     (window (with-let env (lambda (n) (set! notes (+ notes 1)))) 0 1
+	     (fm-violin 0 1 440 .1)
+	     (fm-violin .5 1 550 .1)
+	     (fm-violin 3 1 330 .1))
+     notes)
+   2))
+
+(test (let ()
+	(define-macro (window func beg end . body)
+	  `(let ((e (curlet)))
+	     (call-with-exit
+	      (lambda (quit)
+		(do ((notes ',body (cdr notes)))
+		    ((null? notes))
+		  (let* ((note (car notes))
+			 (note-beg (cadr note)))
+		    (if (<= ,beg note-beg)
+			(if (> note-beg (+ ,beg ,end))
+			    (quit)
+			    ((with-let e ,func) note)))))))))
+
+	(let ((notes 0))
+	  (window (lambda (n) (set! notes (+ notes 1))) 0 1
+		  (fm-violin 0 1 440 .1)
+		  (fm-violin .5 1 550 .1)
+		  (fm-violin 3 1 330 .1))
+	  notes))
+      2)
+
+(let ()
+  (define ff
+    (let ((x 1))
+      (let ((y 2))
+	(let ((f (let ((z 3))
+		   (lambda (a)
+		     (+ a x y z)))))
+	  (set! (outlet (funclet f)) (inlet 'x 10 'y 11 'z 12))
+	  f))))
+
+  (test (ff 20) 44)) ; (funclet f): (inlet 'z 3), funclet can't be set
+
+#|
+;;; this checks existing procedures
+(let ((st (symbol-table))
+      (p (open-output-file "pinfo")))
+  (for-each
+       (lambda (sym)
+	 (if (defined? sym)
+	     (let ((val (symbol->value sym)))
+	       (format p "---------------- ~A ----------------~%" sym)
+	       (catch #t
+		      (lambda ()
+			(let ((str (documentation val))
+			      (sym-name (symbol->string sym)))
+			  (if (procedure? val)
+			      (if (= (length str) 0)
+				  (format p "~A: [no doc]~%" sym)
+				  (let ((pos (substring? sym-name str)))
+				    (if (and (not pos)
+					     (not (char-upper-case? (sym-name 0)))
+					     (not (char=? (sym-name 0) #\.))
+					     (not (char=? (sym-name 0) #\[)))
+					(format p "~A documentation [no matched name]: ~A~%" sym str)))))))
+		      (lambda args
+			(if (procedure? val)
+			    (format p "~A documentation: error: ~A~%" sym (apply format #f (cadr args))))))
+	       (catch #t
+		      (lambda ()
+			(let ((lst (procedure-source val)))
+			  (if (not lst)
+			      (if (procedure? val)
+				  (format p "~A: [no source]~%" sym))
+			      (if (and (not (pair? lst))
+				       (not (null? lst)))
+				  (format p "~A source: ~A~%" sym lst)))))
+		      (lambda args
+			(if (procedure? val)
+			    (format p "~A source: error: ~A~%" sym (apply format #f (cadr args))))))
+	       (catch #t
+		      (lambda ()
+			(let ((pe (funclet val)))
+			  (if (not pe)
+			      (if (procedure? val)
+				  (format p "~A: [no environment]~%" sym))
+			      (if (not (let? pe))
+				  (format p "~A environment:~%" sym pe)
+				  (if (not (eq? (rootlet) pe))
+				      (format p "~A env: ~A~%" sym (let->list pe)))))))
+		      (lambda args
+			(if (procedure? val)
+			    (format p "~A environment: error: ~A~%" sym (apply format #f (cadr args))))))
+	       )))
+       st)
+  (close-output-port p))
+|#
+
+
+;;; --------------------------------------------------------------------------------
+;;; funclet?
+
+(for-each
+ (lambda (arg)
+   (test (funclet? arg) #f))
+ (list -1 #\a 1 #f _ht_ _undef_ #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi abs #(()) (list 1 2 3) '(1 . 2) "hi" (lambda () 1)))
+
+(test (funclet?) 'error)
+(test (funclet? 1 2) 'error)
+(test (funclet? (rootlet)) #f)
+
+(let () (define (f) (funclet? (curlet))) (test (f) #f)) ; changed 24-Sep-21
+(let () (define (f) (funclet? (outlet (curlet)))) (test (f) #t))
+
+
+;;; --------------------------------------------------------------------------------
+;;; *function*
+
+(for-each
+ (lambda (arg)
+   (test (*function* arg) 'error))
+ (list -1 #\a 1 #f _ht_ _undef_ #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi abs #(()) (list 1 2 3) '(1 . 2) "hi" (lambda () 1)))
+
+(let () (define (f) (*function* (inlet 'a 1) #f)) (test (f) 'error))
+
+(unless (> (*s7* 'debug) 0)
+(let ()
+  (define (func x)
+    (*function* (curlet) x))
+
+  (test (func :name) 'func)
+  (test (func :arity) '(1 . 1))
+  (test (func :signature) #f)
+  (test (func :source) '(lambda (x) (*function* (curlet) x)))
+  (test (procedure? (func :value)) #t)
+  (test (func :arglist) '(x))
+  (test (integer? (func :line)) #t)
+  (test (string? (func :file)) #t)
+  (test (let? (func :funclet)) #t)
+  (test (func :documentation) "")
+
+  (define func1
+    (let ((+signature+ '(integer? integer? integer?))
+	  (+documentation+ "a function"))
+      (lambda (x y . z)
+	(list
+	 (*function* (curlet) :name)
+	 (*function* (curlet) :arity)
+	 (*function* (curlet) :signature)
+	 (*function* (curlet) :source)
+	 (procedure? (*function* (curlet) :value))
+	 (*function* (curlet) :arglist)
+	 (*function* (curlet) :documentation)
+	 (integer? (*function* (curlet) :line))
+	 (string? (*function* (curlet) :file))
+	 (let? (*function* (curlet) :funclet))))))
+
+  (test (func1 1 2 3 4)
+        (list 'func1 '(2 . 536870912) '(integer? integer? integer?)
+              '(lambda (x y . z)
+                 (list (*function* (curlet) :name)
+                       (*function* (curlet) :arity)
+                       (*function* (curlet) :signature)
+                       (*function* (curlet) :source)
+                       (procedure? (*function* (curlet) :value))
+                       (*function* (curlet) :arglist)
+                       (*function* (curlet) :documentation)
+                       (integer? (*function* (curlet) :line))
+                       (string? (*function* (curlet) :file))
+                       (let? (*function* (curlet) :funclet))))
+               #t '(x y . z) "a function" #t #t #t))
+
+  (test ((define f (lambda (a) (*function* (curlet) 'arglist))) 1) '(a))
+  (test ((define f (lambda (a) (*function* (curlet) 'name))) 1) 'f)
+  (test ((define f (lambda (a) (*function* (curlet) 'signature))) 1) #f)
+  (test ((define f (lambda (a) (*function* (curlet) 'arity))) 1) '(1 . 1))
+  (test ((define f (lambda (a) (*function* (curlet) 'documentation))) 1) "")
+  (test (let ((val ((define f (lambda (a) (*function* (curlet) 'line))) 1))) (integer? val)) #t)
+  (test ((define f (lambda (a) (*function* (curlet) 'file))) 1) "s7test.scm")
+  (test (let? ((define f (lambda (a) (*function* (curlet) 'funclet))) 1)) #t)
+  (test ((define f (lambda (a) (*function* (curlet) 'source))) 1) '(lambda (a) (*function* (curlet) 'source)))
+  (test((define f (lambda (a) (*function* (curlet) 'f))) 1) #f) ; perhaps #<undefined>?? or an error
+  ))
+
+;;; it's possible to fool *function*:
+(test ((lambda (a) (*function*)) 1) #f)
+(test (let ()
+        (define (f1 a)
+          ((lambda (b) (*function*)) a))
+        (let ((val (f1 1)))
+          (if (pair? val)
+              (car val)
+              val)))
+      'f1)
+
+
+;;; --------------------------------------------------------------------------------
+;;; continuation?
+
+(for-each
+ (lambda (arg)
+   (test (continuation? arg) #f))
+ (list -1 #\a 1 #f _ht_ _undef_ #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi abs #(()) (list 1 2 3) '(1 . 2) "hi" (lambda () 1)))
+
+(test (let ((cont #f))
+	(and (call/cc (lambda (x) (set! cont x) (continuation? x)))
+	     (continuation? cont)))
+      #t)
+(test (let ((cont #f))
+	(or (call-with-exit (lambda (x) (set! cont x) (continuation? x)))
+	    (continuation? cont)))
+      #f) ; x is not a continuation
+
+(test (continuation?) 'error)
+(test (continuation? 1 2) 'error)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; eval
+;;; eval-string
+
+;(test (eval-string "(list #b)") 'error)
+(test (eval-string "(char? #\\spaces)") #f)
+(test (eval-string "(car '( . 1))") 'error)
+(test (eval-string "(car '(. ))") 'error)
+(test (eval-string "(car '( . ))") 'error)
+(test (eval-string "(car '(. . . ))") 'error)
+(test (eval-string "#( . 1)") 'error)
+(test (eval-string "'(1 2 . )") 'error)
+(test (eval-string "#(1 2 . )") 'error)
+;(test (eval-string "#'(1 2)") 'error)
+;(test (eval-string "#`(1 2)") 'error)
+;(test (eval-string "#,(1 2)") 'error)
+;(test (eval-string "#`,(1 2)") 'error)
+;(test (eval-string "#1(2)") 'error)
+(test (eval-string "(+ 1 . . )") 'error)
+(test (eval-string "(car '(1 . ))") 'error)
+(test (eval-string "(car '(1 . . 2))") 'error)
+(test (eval-string "#( . )") 'error)
+(test (eval-string "#(1 . )") 'error)
+(test (eval-string "#(. . . )") 'error)
+(test (eval-string "#(1 . . 2)") 'error)
+(test (eval-string "'(. 1)") 'error)
+(test (eval-string "#(. 1)") 'error)
+(test (eval-string "'(. )") 'error)
+(test (eval-string "#(. )") 'error)
+(test (eval-string "(list 1 . 2)") 'error)
+(test (eval-string "(+ 1 . 2)") 'error)
+(test (eval-string "(car '@#`')") 'error)
+(test (eval-string "(list . )") 'error)
+(test (eval-string "#( .)") 'error)
+(test (eval-string "(car '( .))") 'error)
+(test (eval-string "(let ((. 3)) .)") 'error)
+(test (eval-string "`#0d()") 'error)
+;(test (eval-string "'#t:") 'error) ; guile interprets this as #t : and complains unbound variable :
+;(test (eval-string "#t1") 'error)  ;   similarly this is #t 1 in guile
+(test (eval-string "#(1 . 2)") 'error)
+(test (eval-string "#(1 2 . 3)") 'error)
+;(test (eval-string "'#'") 'error)
+;(test (eval-string "#b") 'error)
+(test (eval-string "(+ 123") 'error)
+(test (eval-string "(+ 123 0000000000") 'error)
+(test (eval-string "(+ 1 2) a mistake") 'error)
+(test (eval-string "(+ 1 2) ; a comment") 3)
+(test (eval-string "(+ 1 2) #| a block \n  comment |# ; a normal comment\n") 3)
+(test (eval-string "(+ 1 2) ()") 'error)
+(test (eval-string "(+ 1 2) ; a comment\n a mistake") 'error)
+(test (eval-string "(+ 1 2) ") 3)
+
+(unless with-bignums
+  (test (undefined? (eval-string "-922337203685477580121")) #t) ; check overflow flag is set
+  (test (undefined? (eval-string "922337203685477580121")) #t)
+  (test (undefined? (eval-string "-92233720368547758081")) #t)
+  (test (undefined? (eval-string "#xffffffffffffffff1")) #t))
+
+(test (undefined? (eval-string "#special#")) #t)
+(test (object->string (eval-string "#special#")) "#special#")
+(test (eq? (eval-string "#special#") (eval-string "#special#")) #f)
+(test (let ((x 2)) (eval-string "(+ x 1)")) 3)
+(test (let ((x 1)) (let ((x 2)) (eval-string "(+ x 1)"))) 3)
+(test (let ((x 2) (lt (inlet 'x 3))) (eval-string "(+ x 1)")) 3)
+(test (let ((x 2) (lt (inlet 'x 3))) (eval-string "(+ x 1)" lt)) 4)
+(test (let* ((x 2) (lt (inlet 'y x))) (let ((x 4)) (eval-string "(+ y 1)" lt))) 3)
+
+(test (eval-string "(+ 1 2)") 3)
+(test (eval '(+ 1 2)) 3)
+(test (eval `(,+ ,1 ,2)) 3)
+(test (eval (list + 1 2)) 3)
+(test (eval `(+ 1 (eval `(* 2 3)))) 7)
+(test (eval `(+ 1 (eval-string "(* 2 3)"))) 7)
+(test (eval-string "(+ 1 (eval-string \"(* 2 3)\"))") 7)
+(test (eval `(+ 1 2 . 3)) 'error)
+(test (eval-string) 'error)
+(test (eval) 'error) ; or #f in the repl
+(test (eval-string "") #f)
+(test (eval-string "(reader-cond ((provided? 'surreals) 1))") #f) ; op_eval_string as stack_top_op in op_finish_expansion
+(test (eval-string (object->string (with-input-from-string "(reader-cond ((provided? 'surreals) 123))" read))) #f) ; op_read_done
+(test (eval-string "'") #<eof>)
+(test (eval ()) ())
+(test (eval ()) ())
+(test (eval-string "1" () ()) 'error)
+(test (eval () () ()) 'error)
+(test (eval "1") "1")
+(test (eval-string #t) 'error)
+(test (eval #(+ 1 2)) #(+ 1 2))
+(test (+ 1 (values (eval-string "(catch #t (lambda () asdf) (lambda args 2))") (eval-string "(catch #t (lambda () asdf) (lambda args 3))"))) 6)
+(test (call-with-exit (lambda (go) (eval-string "(go 3)"))) 3)
+(test (let () (define (func) (eval-string (substring  "ho" 0 0))) (func)) #f)
+
+(let () (define e1 (let ((a 10)) (curlet))) (test (eval 'a e1) 10)) ; from andy wingo
+(let () (define e1 (let ((a 10)) (curlet))) (eval '(set! a 32) e1) (test (eval 'a e1) 32))
+
+(test (eval '(begin (define __eval_var__ 1) __eval_var__) (rootlet)) 1)
+(test (let () __eval_var__) 1)
+(test (eval-string "(begin (define __eval_var1__ 12) __eval_var1__)" (rootlet)) 12)
+(test (let () __eval_var1__) 12)
+(test (let () (eval '(begin (define __eval_var2__ 123) __eval_var__) (curlet)) __eval_var2__) 123)
+(test (let () __eval_var2__) 'error)
+(test (let ((x 1) (y 2)) (eval-string "(begin (set! x 3) (set! y 4))") (list x y)) '(3 4))
+(test (let () (define-macro (mac1 x) `(+ ,x 1)) ((lambda () (do ((__i__ 0 (+ __i__ 1))) ((= __i__ 1) 3) ((eval-string (object->string mac1 :readable)) 1))))) 3)
+
+;; from scheme wg
+(let ((x (list 'cons 1 2))
+      (y (list (list 'quote 'cons) 1 2)))
+  (set-car! x cons)
+  (set-car! (cdar y) cons)
+  (test (eval x) (eval y)))
+(test (eval (list 'cons 1 2)) (eval (list cons 1 2)))
+(let ((f (lambda (a) (+ a 1))))
+  (test (eval (list 'f 2)) (eval (list f 2))))
+
+(test (apply "hi" 1 ()) #\i)
+(test (eval ("hi" 1)) #\i)
+(test (apply + 1 1 (cons 1 (quote ()))) 3)
+(test (eq? (eval (quote (quote ()))) ()) #t)
+(test (apply (cons (quote cons) (cons 1 (quote ((quote ()))))) 1 ()) 1) ; essentially ((list 'cons 1 ...) 1) => 1
+(test (eval ((cons (quote cons) (cons 1 (quote ((quote ()))))) 1)) 1)
+(test (eval (eval (list '+ 1 2))) 3)
+
+(test (eval if) if)
+(test (eval quote) quote)
+(test (eval (eval (list define* #(1)))) 'error)
+(test (eval (eval (list lambda* ()))) 'error)
+(test (eval (eval (list letrec "hi"))) 'error)
+(test (eval (eval (cons define-macro 1))) 'error)
+(test (eval (eval (cons quote "hi"))) 'error)
+(test (eval (eval (list and "hi"))) "hi")
+
+(let-temporarily (((*s7* 'safety) 1))
+  (test (eval (cdr (signature /))) 'error))
+
+(test (apply + (+ 1) ()) 1)
+(test (apply #(1) (+) ()) 1)
+(test (apply + (+) ()) 0)
+(test (eval #()) #())
+(test (apply (lambda () #f)) #f)
+(test (eval '(if #f #f)) (if #f #f))
+(test (let ((ho 32)) (symbol? (eval (eval (eval (eval '''''ho)))))) #t)
+(test (eval '(case 0 ((1) 2) ((0) 1))) 1)
+(test (eval '(cond ((= 1 2) 3) (#t 4))) 4)
+
+(test (eval-string (string-append "(list 1 2 3)" (string #\newline) (string #\newline))) (list 1 2 3))
+(eval-string (string-append "(begin (define evalstr_1 32)" (string #\newline) "(define evalstr_2 2))"))
+(test (eval-string "(+ evalstr_1 evalstr_2)") 34)
+(eval-string (string-append "(begin (set! evalstr_1 3)" "(set! evalstr_2 12))"))
+(test (eval-string "(+ evalstr_1 evalstr_2)") 15)
+
+(test (+ (eval `(values 1 2 3)) 4) 10)
+(test (+ (eval-string "(values 1 2 3)") 4) 10)
+(test (+ 1 (eval-string "(+ 2 3)") 4) 10)
+(test ((eval-string "(lambda (a) (+ a 1))") 2) 3)
+(test (eval ((eval-string "(lambda (a) (list '+ a 1))") 2)) 3)
+(test (eval-string "(+ 1 (eval (list '+ 1 2)))") 4)
+(test (eval _undef_) _undef_)
+
+(test (eq? (eval-string "else") else) #t)
+(test (eq? (with-input-from-string "else" read) else) #t)
+(test (eq? (with-input-from-string "lambda" read) lambda) #f)
+(test (eq? (eval-string "lambda") lambda) #t)
+(test (((eval-string "lambda") () (+ 1 2))) 3)
+(test (symbol? (eval-string "lambda")) #f)
+(test (symbol? (with-input-from-string "lambda" read)) #t)
+(test (eq? (with-input-from-string "else" (lambda () (eval (read)))) else) #t)
+
+(test (eval-string "'___a ; b") '___a)
+(test (eval-string "'___a #| b |#") '___a)
+
+(for-each
+ (lambda (arg)
+   (test (eval-string arg) 'error))
+ (list -1 0 1 512 #\a #(1 2 3) 3.14 2/3 1.5+0.3i 1+i () 'hi :hi abs #(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+(for-each
+ (lambda (arg)
+   (test (eval-string "(+ 1 2)" arg) 'error))
+ (list -1 0 1 512 #\a #(1 2 3) 3.14 2/3 1.5+0.3i 1+i 'hi abs "hi" :hi #(()) (lambda () 1)))
+
+
+(test (let () (define-macro (hiho a) `(+ ,a 1)) (hiho 3)) 4)
+(test (let () (define-macro (hiho) `(+ 3 1)) (hiho)) 4)
+(test (let () (define-macro (hiho) `(+ 3 1)) (hiho 1)) 'error)
+(test (let () (define-macro (hi a) `(+ ,@a)) (hi (1 2 3))) 6)
+(test (let () (define-macro (hi a) `(+ ,a 1) #f) (hi 2)) #f)
+(test (let () (define-macro (mac1 a) `',a) (equal? (mac1 (+ 1 2)) '(+ 1 2))) #t)
+(test (let () (define-macro (hi . a) `,@a) (hi 1)) 1)
+
+(test (let () (define-macro (hi a) `(+ , a 1)) (hi 1)) 2)
+(test (let () (define-macro (hi a) `(eval `(+ ,,a 1))) (hi 1)) 2)
+(test (let () (define-macro (hi a) `(eval (let ((a 12)) `(+ ,,a 1)))) (hi 1)) 2)
+(test (let () (define-macro (hi a) `(eval (let ((a 12)) `(+ ,a 1)))) (hi 1)) 13)
+(test (let () (define-macro (hi a) `(eval (let ((a 12)) `(let ((a 100)) (+ ,a 1))))) (hi 1)) 13)
+(test (let () (define-macro (hi a) `(eval (let ((a 12)) `(let ((a 100)) (+ a 1))))) (hi 1)) 101)
+
+(test (let () (define-macro (hi q) ``(,,q)) (hi (* 2 3))) '(6))
+(test (let () (define-macro (hi q) `(let ((q 32)) `(,,q))) (hi (* 2 3))) '(6))
+(test (let () (define-macro (hi q) `(let ((q 32)) `(,q))) (hi (* 2 3))) '(32))
+(test (let () (define-macro (hi q) `(let () ,@(list q))) (hi (* 2 3))) 6)
+
+(test (let () (define-macro (tst a) ``(+ 1 ,,a)) (tst 2)) '(+ 1 2))
+(test (let () (define-macro (tst a) ```(+ 1 ,,,a)) (eval (tst 2))) '(+ 1 2))
+(test (let () (define-macro (tst a) ``(+ 1 ,,a)) (tst (+ 2 3))) '(+ 1 5))
+(test (let () (define-macro (tst a) ``(+ 1 ,@,a)) (tst '(2 3))) '(+ 1 2 3))
+(test (let () (define-macro (tst a) ``(+ 1 ,,@a)) (tst (2 3))) '(+ 1 2 3))
+(test (let () (define-macro (tst a) ```(+ 1 ,,,@a)) (eval (tst (2 3)))) '(+ 1 2 3))
+(test (let () (define-macro (tst a) ```(+ 1 ,,@,@a)) (eval (tst ('(2 3))))) '(+ 1 2 3))
+(test (let () (define-macro (tst a) ````(+ 1 ,,,,@a)) (eval (eval (eval (tst (2 3)))))) 6)
+(test (let () (define-macro (tst a) ``(+ 1 ,@,@a)) (tst ('(2 3)))) '(+ 1 2 3))
+(test (let () (define-macro (tst a b) `(+ 1 ,a (apply * `(2 ,,@b)))) (tst 3 (4 5))) 44)
+(test (let () (define-macro (tst . a) `(+ 1 ,@a)) (tst 2 3)) 6)
+(test (let () (define-macro (tst . a) `(+ 1 ,@a (apply * `(2 ,,@a)))) (tst 2 3)) 18)
+(test (let () (define-macro (tst a) ```(+ 1 ,@,@,@a)) (eval (tst ('('(2 3)))))) '(+ 1 2 3))
+
+(test (let () (define-macro (hi a) `(+ ,a 1)) (procedure? hi)) #f)
+(test (let () (define-macro (hi a) `(let ((@ 32)) (+ @ ,a))) (hi @)) 64)
+(test (let () (define-macro (hi @) `(+ 1 ,@@)) (hi (2 3))) 6) ; ,@ is ambiguous
+(test (let () (define-macro (tst a) `(+ 1 (if (> ,a 0) (tst (- ,a 1)) 0))) (tst 3)) 4)
+(test (let () (define-macro (hi a) (if (list? a) `(+ 1 ,@a) `(+ 1 ,a))) (* (hi 1) (hi (2 3)))) 12)
+
+(test (let ((x 1)) (eval `(+ 3 ,x))) 4)
+(test (let ((x 1)) (eval (eval `(let ((x 2)) `(+ 3 ,x ,,x))))) 6)
+(test (let ((x 1)) (eval (eval (eval `(let ((x 2)) `(let ((x 3)) `(+ 10 ,x ,,x ,,,x))))))) 16)
+(test (let ((x 1)) (eval (eval (eval (eval `(let ((x 2)) `(let ((x 3)) `(let ((x 30)) `(+ 100 ,x ,,x ,,,x ,,,,x))))))))) 136)
+
+(test (let () (define-bacro (hiho a) `(+ ,a 1)) (hiho 3)) 4)
+(test (let () (define-bacro (hiho) `(+ 3 1)) (hiho)) 4)
+(test (let () (define-bacro (hiho) `(+ 3 1)) (hiho 1)) 'error)
+(test (let () (define-bacro (hi a) `(+ ,@a)) (hi (1 2 3))) 6)
+(test (let () (define-bacro (hi a) `(+ ,a 1) #f) (hi 2)) #f)
+(test (let () (define-bacro (mac1 a) `',a) (equal? (mac1 (+ 1 2)) '(+ 1 2))) #t)
+(test (let () (define-bacro (tst a) ``(+ 1 ,,a)) (tst 2)) '(+ 1 2))
+(test (let () (define-bacro (tst a) ```(+ 1 ,,,a)) (eval (tst 2))) '(+ 1 2))
+(test (let () (define-bacro (tst a) ``(+ 1 ,,a)) (tst (+ 2 3))) '(+ 1 5))
+(test (let () (define-bacro (tst a) ``(+ 1 ,@,a)) (tst '(2 3))) '(+ 1 2 3))
+(test (let () (define-bacro (tst a) ``(+ 1 ,,@a)) (tst (2 3))) '(+ 1 2 3))
+(test (let () (define-bacro (tst a) ```(+ 1 ,,,@a)) (eval (tst (2 3)))) '(+ 1 2 3))
+(test (let () (define-bacro (tst a) ```(+ 1 ,,@,@a)) (eval (tst ('(2 3))))) '(+ 1 2 3))
+(test (let () (define-bacro (tst a) ````(+ 1 ,,,,@a)) (eval (eval (eval (tst (2 3)))))) 6)
+(test (let () (define-bacro (tst a) ``(+ 1 ,@,@a)) (tst ('(2 3)))) '(+ 1 2 3))
+(test (let () (define-bacro (tst a b) `(+ 1 ,a (apply * `(2 ,,@b)))) (tst 3 (4 5))) 44)
+(test (let () (define-bacro (tst . a) `(+ 1 ,@a)) (tst 2 3)) 6)
+(test (let () (define-bacro (tst . a) `(+ 1 ,@a (apply * `(2 ,,@a)))) (tst 2 3)) 18)
+(test (let () (define-bacro (tst a) ```(+ 1 ,@,@,@a)) (eval (tst ('('(2 3)))))) '(+ 1 2 3))
+(test (let () (define-bacro (hi a) `(+ ,a 1)) (procedure? hi)) #f)
+(test (let () (define-bacro (hi a) `(let ((@ 32)) (+ @ ,a))) (hi @)) 64)
+(test (let () (define-bacro (hi @) `(+ 1 ,@@)) (hi (2 3))) 6) ; ,@ is ambiguous
+(test (let () (define-bacro (tst a) `(+ 1 (if (> ,a 0) (tst (- ,a 1)) 0))) (tst 3)) 4)
+(test (let () (define-bacro (hi a) (if (list? a) `(+ 1 ,@a) `(+ 1 ,a))) (* (hi 1) (hi (2 3)))) 12)
+
+(test (let () (define-bacro (hiho a) `(+ ,a 1)) (macro? hiho)) #t)
+(test (let () (define-bacro* (hiho (a 1)) `(+ ,a 1)) (macro? hiho)) #t)
+(test (let () (define-macro (hiho a) `(+ ,a 1)) (macro? hiho)) #t)
+(test (let () (define-macro* (hiho (a 1)) `(+ ,a 1)) (macro? hiho)) #t)
+
+#|
+(define-macro (when2 test . body)
+  `((apply lambda (list '(test) '(if test (let () ,@body)))) ,test))
+
+(define-macro (when2 test . body)
+  `(if ,test (let () ,@body)))
+
+(define-macro (when2 test . body)
+  `((lambda (test) (if test (let () ,@body))) ,test))
+
+(define-macro (when2 test . body)
+  `(let ((func (apply lambda `(() ,,@body))))
+     (if ,test (func))))
+|#
+
+(test (define-macro) 'error)
+(test (define-macro 1) 'error)
+(test (define-macro . 1) 'error)
+(test (apply define-macro '(1)) 'error)
+(test (define-macro (1 2 3)) 'error)
+(test (define-macro (1 2) 3) 'error)
+(test (define-macro (a)) 'error)
+(test (define-macro (a)) 'error)
+(test (define-macro (a 1) 2) 'error)
+(test (define-macro . a) 'error)
+(test (define :hi 1) 'error)
+(test (define hi: 1) 'error)
+(test (define-macro (:hi a) `(+ ,a 1)) 'error)
+(test (define-macro (:hi a) `(+ ,a 1)) 'error)
+(test (define-macro (hi 1 . 2) 1) 'error)
+(test (define-macro (hi) 1 . 2) 'error)
+(test (define-macro (:) "" . #(1)) 'error)
+(test (define-macro hi ()) 'error)
+(test (define-macro (hi)) 'error)
+(test (define-macro (mac . 1) 1) 'error)
+(test (define-macro (mac 1) 1) 'error)
+(test (define-macro (a #()) 1) 'error)
+(test (define-macro (i 1) => (j 2)) 'error)
+(test (define hi 1 . 2) 'error)
+(test (define-macro (hi hi) . hi) 'error)
+(test (((lambda () (define-macro (hi a) `(+ 1 ,a)) hi)) 3) 4)
+
+(test (let () (define-macro (hi a b) `(list ,@a . ,@b)) (hi (1 2) ((2 3)))) '(1 2 2 3))
+(test (let () (define-macro (hi a b) `(list ,@a . ,b)) (hi (1 2) (2 3))) '(1 2 2 3))
+(test (let () (define-macro (hi a b) `(list ,@a ,@b)) (hi (1 2) (2 3))) '(1 2 2 3))
+
+
+(let ((vals #(0 0)))
+
+#|
+  (let ()
+      (define (hi a) (+ 1 a))
+      (define (use-hi b) (hi b))
+      (set! (vals 0) (use-hi 1))
+      (define (hi a) (+ 2 a))
+      (set! (vals 1) (use-hi 1))
+      (test vals #(2 3))) ; hmmm, or possibly #(2 2)... see comment above (line 13494 or thereabouts)
+|#
+
+  (let ()
+    (define-macro (hi a) `(+ 1 ,a))
+    (define (use-hi b) (hi b))
+    (set! (vals 0) (use-hi 1))
+    (define-macro (hi a) `(+ 2 ,a))
+    (set! (vals 1) (use-hi 1))
+    (test vals #(2 3)))
+  (let ()
+    (define (use-hi b) (hhi b))
+    (define-macro (hhi a) `(+ 1 ,a))
+    (set! (vals 0) (use-hi 1))
+    (define-macro (hhi a) `(+ 2 ,a))
+    (set! (vals 1) (use-hi 1))
+    (test vals #(2 3))))
+
+(test (let ()
+	(define-macro (hanger name-and-args)
+	  `(define ,(car name-and-args)
+	     (+ ,@(map (lambda (arg) arg) (cdr name-and-args)))))
+	(hanger (hi 1 2 3))
+	hi)
+      6)
+(test (let ()
+	(define-macro (hanger name-and-args)
+	  `(define-macro (,(car name-and-args))
+	     `(+ ,@(map (lambda (arg) arg) (cdr ',name-and-args)))))
+	(hanger (hi 1 2 3))
+	(hi))
+      6)
+
+(let ()
+  ;; inspired by Doug Hoyte, "Let Over Lambda"
+  (define (mcxr path lst)
+    (define (cxr-1 path lst)
+      (if (null? path)
+	  lst
+	  (if (char=? (car path) #\a)
+	      (cxr-1 (cdr path) (car lst))
+	      (cxr-1 (cdr path) (cdr lst)))))
+    (let ((p (string->list (symbol->string path))))
+      (if (char=? (car p) #\c)
+	  (set! p (cdr p)))
+      (let ((p (reverse p)))
+	(if (char=? (car p) #\r)
+	    (set! p (cdr p)))
+	(cxr-1 p lst))))
+
+  (test (mcxr 'cr '(1 2 3)) '(1 2 3))
+  (test (mcxr 'cadddddddr '(1 2 3 4 5 6 7 8)) 8)
+  (test (mcxr 'caadadadadadadadr '(1 (2 (3 (4 (5 (6 (7 (8))))))))) 8)
+
+  (define-macro (cxr path lst)
+    (let ((p (string->list (symbol->string path))))
+      (if (char=? (car p) #\c)
+	  (set! p (cdr p)))
+      (let ((p (reverse p)))
+	(if (char=? (car p) #\r)
+	    (set! p (cdr p)))
+	(let ((func 'arg))
+	  (for-each
+	   (lambda (f)
+	     (set! func (list (if (char=? f #\a) 'car 'cdr) func)))
+	   p)
+	  `((lambda (arg) ,func) ,lst)))))
+
+  (test (cxr car '(1 2 3)) 1)
+  (test (cxr cadddddddr '(1 2 3 4 5 6 7 8)) 8)
+  (test (cxr caadadadadadadadr '(1 (2 (3 (4 (5 (6 (7 (8))))))))) 8)
+  )
+
+;; this is the best of them!
+(let ()
+  (define-macro (c?r path)
+    ;; here "path" is a list and "X" marks the spot in it that we are trying to access
+    ;; (a (b ((c X)))) -- anything after the X is ignored, other symbols are just placeholders
+    ;; c?r returns a function that gets X
+
+    ;; maybe ... for cdr? (c?r (a ...);  right now it's using dot: (c?r (a . X)) -> cdr
+
+    ;; (c?r (a b X)) -> caddr,
+    ;; (c?r (a (b X))) -> cadadr
+    ;; ((c?r (a a a X)) '(1 2 3 4 5 6)) -> 4
+    ;; ((c?r (a (b c X))) '(1 (2 3 4))) -> 4
+    ;; ((c?r (((((a (b (c (d (e X)))))))))) '(((((1 (2 (3 (4 (5 6)))))))))) -> 6
+    ;; ((c?r (((((a (b (c (X (e f)))))))))) '(((((1 (2 (3 (4 (5 6)))))))))) -> 4
+    ;; (procedure-source (c?r (((((a (b (c (X (e f))))))))))) -> (lambda (lst) (car (car (cdr (car (cdr (car (cdr (car (car (car (car lst))))))))))))
+
+    (define (X-marks-the-spot accessor tree)
+      (if (pair? tree)
+	  (or (X-marks-the-spot (cons 'car accessor) (car tree))
+	      (X-marks-the-spot (cons 'cdr accessor) (cdr tree)))
+	  (if (eq? tree 'X)
+	      accessor
+	      #f)))
+
+    (let ((accessor (X-marks-the-spot () path)))
+      (if (not accessor)
+	  (error 'test-error "can't find the spot! ~A" path)
+	  (let ((len (length accessor)))
+	    (if (< len 5)                   ; it's a built-in function
+		(let ((name (make-string (+ len 2))))
+		  (set! (name 0) #\c)
+		  (set! (name (+ len 1)) #\r)
+		  (do ((i 0 (+ i 1))
+		       (a accessor (cdr a)))
+		      ((= i len))
+		    (set! (name (+ i 1)) (if (eq? (car a) 'car) #\a #\d)))
+		  (string->symbol name))
+		(let ((body 'lst))          ; make a new function to find the spot
+		  (for-each
+		   (lambda (f)
+		     (set! body (list f body)))
+		   (reverse accessor))
+		  `(lambda (lst) ,body)))))))
+
+  (test ((c?r (a b X)) (list 1 2 3 4)) 3)
+  (test ((c?r (a (b X))) '(1 (2 3) ((4)))) 3)
+  (test ((c?r (a a a X)) '(1 2 3 4 5 6)) 4)
+  (test ((c?r (a (b c X))) '(1 (2 3 4))) 4)
+  (test ((c?r (((((a (b (c (d (e X)))))))))) '(((((1 (2 (3 (4 (5 6)))))))))) 6)
+  (test ((c?r (((((a (b (c (X (e f)))))))))) '(((((1 (2 (3 (4 (5 6)))))))))) 4))
+
+(let ()
+  (define-macro (nested-for-each args func . lsts)
+    (let ((body `(,func ,@args)))
+      (for-each
+       (lambda (arg lst)
+	 (set! body `(for-each
+		      (lambda (,arg)
+			,body)
+		      ,lst)))
+       args lsts)
+      body))
+
+  ;;(nested-for-each (a b) + '(1 2) '(3 4)) ->
+  ;;  (for-each (lambda (b) (for-each (lambda (a) (+ a b)) '(1 2))) '(3 4))
+
+  (define-macro (nested-map args func . lsts)
+    (let ((body `(,func ,@args)))
+      (for-each
+       (lambda (arg lst)
+	 (set! body `(map
+		      (lambda (,arg)
+			,body)
+		      ,lst)))
+       args lsts)
+      body))
+
+  ;;(nested-map (a b) + '(1 2) '(3 4))
+  ;;   ((4 5) (5 6))
+  ;;(nested-map (a b) / '(1 2) '(3 4))
+  ;;   ((1/3 2/3) (1/4 1/2))
+
+  (test (nested-map (a b) + '(1 2) '(3 4)) '((4 5) (5 6)))
+  (test (nested-map (a b) / '(1 2) '(3 4)) '((1/3 2/3) (1/4 1/2)))
+  )
+
+(let ()
+  (define-macro (define-curried name-and-args . body)
+    `(define ,@(let ((newlst `(begin ,@body)))
+		 (define (rewrap lst)
+		   (if (pair? (car lst))
+		       (begin
+			 (set! newlst (cons 'lambda (cons (cdr lst) (list newlst))))
+			 (rewrap (car lst)))
+		       (list (car lst) (list 'lambda (cdr lst) newlst))))
+                 (if (symbol? name-and-args)
+                     (list name-and-args newlst)
+		     (rewrap name-and-args)))))
+
+  (define-curried (((((f a) b) c) d) e) (* a b c d e))
+  (test (((((f 1) 2) 3) 4) 5) 120)
+  (define-curried (((((f a b) c) d e) f) g) (* a b c d e f g))
+  (test (((((f 1 2) 3) 4 5) 6) 7) 5040)
+  (define-curried (((foo)) x) (+ x 34))
+  (test (((foo)) 300) 334)
+  (define-curried ((foo-1) x) (+ x 34))
+  (test ((foo-1) 200) 234)
+  (define-curried (f1 a b) (+ a b))
+  (test (f1 2 3) 5)
+  (define-curried f2 32)
+  (test f2 32)
+  )
+
+
+(test (let ()
+	(define (set-cadr! a b)
+	  (set-car! (cdr a) b)
+	  b)
+	(let ((lst (list 1 2 3)))
+	  (set-cadr! lst 32)
+	  lst))
+      '(1 32 3))
+
+  ;;; macro?
+(test (macro? pi) #f)
+(test (macro? quasiquote) #t) ; s7_define_macro in s7.c
+(test (let ((m quasiquote)) (macro? m)) #t)
+(test (macro? macroexpand) #f) ; it's now syntactic
+(test (macro? cond) #f)
+(test (macro? letrec) #f)
+
+(for-each
+ (lambda (arg)
+   (test (macro? arg) #f))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () car abs (lambda () 1) #2d((1 2) (3 4)) _ht_ _undef_ _null_ _c_obj_ #f 'hi #(()) (list 1 2 3) '(1 . 2) "hi"))
+(test (macro?) 'error)
+
+(define-macro (fully-expand form)
+  (define (expand form)
+    (if (pair? form)
+	(if (and (symbol? (car form))
+		 (macro? (symbol->value (car form))))
+	    (expand (apply macroexpand (list form)))
+	    (cons (expand (car form))
+		  (expand (cdr form))))
+	form))
+  (expand form)) ; use (list 'quote (expand form)) to get fully-macroexpand of s7.html (see below)
+
+(define fe1-called #f)
+(define-macro (fe1 a) (set! fe1-called #t) `(+ ,a 1))
+(define fe2-called #f)
+(define-macro (fe2 b) (set! fe2-called #f) `(+ (fe1 ,b) 2))
+(fully-expand (define (fe3 c) (+ (fe2 c) (fe1 (+ c 1)))))
+(set! fe1-called #f)
+(set! fe2-called #f)
+(let ((val (fe3 3)))
+  (if (or (not (= val 11))
+	  fe1-called
+	  fe2-called)
+      (format #t "fully-expand: ~A ~A ~A ~A~%" val (procedure-source fe3) fe1-called fe2-called)))
+
+(let ()
+  (define-macro (swap a b)
+    `(set! ,b (with-let (inlet 'e (curlet) 'tmp ,a)
+		(with-let e (set! ,a ,b))
+		tmp)))
+
+  ;; this doesn't know when to use the setter
+  (define-macro (fully-macroexpand form)
+    (define (expand form)
+      (if (pair? form)
+	  (if (and (symbol? (car form))
+		   (macro? (symbol->value (car form))))
+	      (expand (apply macroexpand (list form)))
+	      (cons (expand (car form))
+		    (expand (cdr form))))
+	  form))
+    (list 'quote (expand form)))
+
+  (define-macro (define-with-macros name&args . body)
+    `(apply define ',name&args (fully-macroexpand `(begin ,,@body))))
+
+  (define-with-macros (call3 x)
+    (let ((a 1) (b x))
+      (swap a b)
+      (list a b)))
+
+  (test (call3 4) '(4 1)))
+
+(test (let ()
+	(define-macro (pop sym)
+	  (let ((v (gensym "v")))
+	    `(let ((,v (car ,sym)))
+	       (set! ,sym (cdr ,sym))
+	       ,v)))
+
+	(test (macro? pop) #t)
+
+	(let ((lst (list 1 2 3)))
+	  (let ((val (pop lst)))
+	    (and (= val 1)
+		 (equal? lst (list 2 3))))))
+      #t)
+
+(define-macro (destructuring-bind lst expr . body)
+  `(let ((ex ,expr))
+
+     (define (flatten lst)
+       (cond ((null? lst) ())
+	     ((pair? lst)
+	      (if (pair? (car lst))
+		  (append (flatten (car lst)) (flatten (cdr lst)))
+		  (cons (car lst) (flatten (cdr lst)))))
+	     (#t lst)))
+
+     (define (structures-equal? l1 l2)
+       (if (pair? l1)
+	   (and (pair? l2)
+		(structures-equal? (car l1) (car l2))
+		(structures-equal? (cdr l1) (cdr l2)))
+	   (not (pair? l2))))
+
+     (if (not (structures-equal? ',lst ex))
+	 (error 'test-error "~A and ~A do not match" ',lst ex))
+
+     (let ((names (flatten ',lst))
+	   (vals (flatten ex)))
+       (apply (eval (list 'lambda names ',@body)) vals))))
+
+(test (destructuring-bind (a b) (list 1 2) (+ a b)) 3)
+(test (destructuring-bind ((a) b) (list (list 1) 2) (+ a b)) 3)
+(test (destructuring-bind (a (b c)) (list 1 (list 2 3)) (+ a b c)) 6)
+(test (let ((x 1)) (destructuring-bind (a b) (list x 2) (+ a b))) 3)
+
+(when full-s7test
+  (define-macro (destructuring-bind lst expr . body)
+    `(let ,(letrec ((flatten (lambda (lst1 lst2 args)
+			       (cond ((null? lst1) args)
+				     ((not (pair? lst1))
+				      (cons (list lst1 lst2) args))
+				     (#t (flatten (car lst1) (car lst2)
+						  (flatten (cdr lst1) (cdr lst2) args)))))))
+	     (flatten lst expr ()))
+       ,@body))
+
+  (test (destructuring-bind (a b) (1 2) (+ a b)) 3)
+  (test (destructuring-bind (a (b)) (1 (2)) (+ a b)) 3)
+  (test (destructuring-bind ((a b)) ((1 2)) (+ a b)) 3)
+  (test (destructuring-bind ((a (b c))) ((1 (2 1))) (+ a b)) 3)
+  (test (destructuring-bind (a b) (0 (+ 1 2)) (+ a b)) 3)
+  (test (destructuring-bind (a ((b))) ((+ 1 3) (((- 1 2)))) (+ a b)) 3)
+  (test (destructuring-bind (a ((b c)) d e) (1 ((2 3)) (+ 4 5) 6) (list a b c d e)) '(1 2 3 9 6))
+
+  ;; CL version:
+  (define-macro (destructuring-bind-1 lst expr . body)
+    `(let ,(letrec ((flatten (lambda (lst1 lst2 args)
+			       (cond ((null? lst1) args)
+				     ((not (pair? lst1))
+				      (cons (list lst1 (list 'quote lst2)) args))
+				     (#t (flatten (car lst1) (car lst2)
+						  (flatten (cdr lst1) (cdr lst2) args)))))))
+	     (flatten lst (eval expr) ()))
+       ,@body))
+
+  (test (destructuring-bind-1 (a b) '(1 2) (list a b)) '(1 2))
+  (test (destructuring-bind-1 (a (b)) '(1 (2)) (list a b)) '(1 2))
+  (test (destructuring-bind-1 ((a b)) '((1 2)) (list a b)) '(1 2))
+  (test (destructuring-bind-1 ((a (b c))) '((1 (2 1))) (list a b)) '(1 2))
+  (test (destructuring-bind-1 (a b) '(0 (+ 1 2)) (list a b)) '(0 (+ 1 2)))
+  (test (destructuring-bind-1 (a ((b))) '((+ 1 3) (((- 1 2)))) (list a b)) '((+ 1 3) (- 1 2)))
+  (test (destructuring-bind-1 (a ((b c)) d e) '(1 ((2 3)) (4 5) 6) (list a b c d e)) '(1 2 3 (4 5) 6))
+
+  ;; CL version but values not quoted (I like this one)
+  (define-macro (destructuring-bind-2 lst expr . body)
+    `(let ,(letrec ((flatten (lambda (lst1 lst2 args)
+			       (cond ((null? lst1) args)
+				     ((not (pair? lst1))
+				      (cons (list lst1 lst2) args))
+				     (#t (flatten (car lst1) (car lst2)
+						  (flatten (cdr lst1) (cdr lst2) args)))))))
+	     (flatten lst (eval expr) ()))
+       ,@body))
+
+  (test (destructuring-bind-2 (a b) (list 1 2) (+ a b)) 3)
+  (test (destructuring-bind-2 (a (b)) '(1 (2)) (+ a b)) 3)
+  (test (destructuring-bind-2 ((a b)) '((1 2)) (+ a b)) 3)
+  (test (destructuring-bind-2 ((a (b c))) '((1 (2 1))) (+ a b)) 3)
+  (test (destructuring-bind-2 (a b) '(0 (+ 1 2)) (+ a b)) 3)
+  (test (destructuring-bind-2 (a ((b))) '((+ 1 3) (((- 1 2)))) (+ a b)) 3)
+  (test (destructuring-bind-2 (a ((b c)) d e) '(1 ((2 3)) (+ 4 5) 6) (list a b c d e)) '(1 2 3 9 6))
+  (test (let ((x 1)) (destructuring-bind-2 (a ((b))) '((+ x 3) (((- x 2)))) (+ a b))) 3))
+
+(define-macro (once-only names . body)
+  (let ((gensyms (map (lambda (n) (gensym)) names)))
+    `(let (,@(map (lambda (g) `(,g (gensym))) gensyms))
+       `(let (,,@(map (lambda (g n) ``(,,g ,,n)) gensyms names))
+	  ,(let (,@(map (lambda (n g) `(,n ,g)) names gensyms))
+	     ,@body)))))
+
+(let ()
+  (define-macro (hiho start end)
+    (once-only (start end)
+	       `(list ,start ,end (+ 2 ,start) (+ ,end 2))))
+
+  (test (let ((ctr 0))
+	  (let ((lst (hiho (let () (set! ctr (+ ctr 1)) ctr)
+			   (let () (set! ctr (+ ctr 1)) ctr))))
+	    (list ctr lst)))
+	'(2 (1 2 3 4))))
+
+(define-macro (once-only-2 names . body)
+  (let ((gensyms (map (lambda (n) (gensym)) names)))
+    `(let (,@(map (lambda (g) (list g '(gensym))) gensyms))
+       `(let (,,@(map (lambda (g n) (list list g n)) gensyms names))
+          ,(let (,@(map (lambda (n g) (list n g)) names gensyms))
+             ,@body)))))
+
+(let ()
+  (define-macro (hiho start end)
+    (once-only-2 (start end)
+	       `(list ,start ,end (+ 2 ,start) (+ ,end 2))))
+
+  (test (let ((ctr 0))
+	  (let ((lst (hiho (let () (set! ctr (+ ctr 1)) ctr)
+			   (let () (set! ctr (+ ctr 1)) ctr))))
+	    (list ctr lst)))
+	'(2 (1 2 3 4))))
+
+;;; (define-bacro (once-only-1 names . body)
+;;;   `(let (,@(map (lambda (name) `(,name ,(eval name))) names))
+;;;     ,@body))
+;;; can't be right: (let ((names 1)) (once-only (names) (+ names 1)))
+;;; if define-macro used here: syntax-error ("~A: unbound variable" start) in the example below
+
+(define once-only-1
+  (let ((names (gensym))
+	(body (gensym)))
+    (apply define-bacro
+	 `((once ,names . ,body)
+	   `(let (,@(map (lambda (name) `(,name ,(eval name))) ,names))
+	      ,@,body)))
+    once))
+
+(let ()
+  (define-bacro (hiho start end) ; note the bacro!  not a macro here
+    (once-only-1 (start end)
+		 `(list ,start ,end (+ 2 ,start) (+ ,end 2))))
+
+  (test (let ((ctr 0))
+	  (let ((lst (hiho (let () (set! ctr (+ ctr 1)) ctr)
+			   (let () (set! ctr (+ ctr 1)) ctr))))
+	    (list ctr lst)))
+	'(2 (1 2 3 4)))
+
+  (test (let ((names 1)) (once-only-1 (names) (+ names 1))) 2)
+  (test (let ((body 1)) (once-only-1 (body) (+ body 1))) 2) ; so body above also has to be gensym'd
+  )
+
+
+(define once-only-3
+  (let ((names (gensym))
+	(body (gensym)))
+    (apply define-bacro `((,(gensym) ,names . ,body)
+			  `(let (,@(map (lambda (name) `(,name ,(eval name))) ,names))
+			     ,@,body)))))
+
+(let ()
+  (define-bacro (hiho start end) ; note the bacro!  not a macro here
+    (once-only-3 (start end)
+		 `(list ,start ,end (+ 2 ,start) (+ ,end 2))))
+
+  (test (let ((ctr 0))
+	  (let ((lst (hiho (let () (set! ctr (+ ctr 1)) ctr)
+			   (let () (set! ctr (+ ctr 1)) ctr))))
+	    (list ctr lst)))
+	'(2 (1 2 3 4)))
+
+  (test (let ((names 1)) (once-only-3 (names) (+ names 1))) 2)
+  (test (let ((body 1)) (once-only-3 (body) (+ body 1))) 2) ; so body above also has to be gensym'd
+  )
+
+
+(let ()
+#|
+  (define setf
+    (let ((args (gensym)))
+      (apply define-bacro
+	     `((setf-1 . ,args)
+	       (if (not (null? ,args))
+		   (begin
+		     (apply set! (car ,args) (cadr ,args) ())
+		     (apply setf (cddr ,args)))))) ; not setf-1 -- it's not defined except during the definition
+      setf-1))
+|#
+(define setf
+  (let ((args (gensym))
+	(name (gensym)))
+    (apply define-bacro `((,name . ,args)
+			  (unless (null? ,args)
+			    (apply set! (car ,args) (cadr ,args) ())
+			    (apply setf (cddr ,args)))))))
+
+  (define-macro (psetf . args)
+    (let ((bindings ())
+	  (settings ()))
+      (do ((arglist args (cddr arglist)))
+	  ((null? arglist))
+	(let* ((g (gensym)))
+	  (set! bindings (cons (list g (cadr arglist)) bindings))
+	  (set! settings (cons `(set! ,(car arglist) ,g) settings))))
+      `(let ,bindings ,@settings)))
+
+  (test (let ((a 1) (b 2)) (setf a b b 3) (list a b)) '(2 3))
+  (test (let ((a 1) (b 2)) (setf a b b (+ a 3)) (list a b)) '(2 5))
+  (test (let ((a #(1)) (b 2)) (setf (a 0) b b (+ (a 0) 3)) (list a b)) '(#(2) 5))
+  (test (let ((a 1) (b 2)) (setf a b b a) (list a b)) '(2 2))
+  (test (let ((a 1) (b 2)) (setf a '(+ 1 2) b a) (list a b)) '((+ 1 2) (+ 1 2)))
+  (test (let ((args 1) (arg 1)) (setf args 2 arg 3) (list args arg)) '(2 3))
+  (test (let ((args 1) (arg 1)) (setf args (+ 2 3) arg args) (list args arg)) '(5 5))
+  (test (let ((args 1) (arg 1)) (setf args '(+ 2 3) arg (car args)) (list args arg)) '((+ 2 3) +))
+
+  (test (let ((a 1) (b 2)) (psetf a b b a) (list a b)) '(2 1))
+  (test (let ((a #(1)) (b 2)) (psetf (a 0) b b (+ (a 0) 3)) (list a b)) '(#(2) 4))
+  (test (let ((a 1) (b 2)) (psetf a '(+ 1 2) b a) (list a b)) '((+ 1 2) 1))
+  (test (let ((new-args 1)) (psetf new-args (+ new-args 1)) new-args) 2)
+  (test (let ((args 1) (arg 1)) (psetf args 2 arg 3) (list args arg)) '(2 3))
+  (test (let ((args 1) (arg 1)) (psetf args (+ 2 3) arg args) (list args arg)) '(5 1))
+  (test (let ((args 1) (arg 1)) (psetf args '(+ 2 3) arg (car args)) (list args arg)) 'error)
+  (test (let ((args '(1 2)) (arg 1)) (psetf args '(+ 2 3) arg (car args)) (list args arg)) '((+ 2 3) 1))
+  )
+
+(define-macro (with-gensyms names . body)
+  `(let ,(map (lambda (n) `(,n (gensym))) names)
+     ,@body))
+
+(define-macro (define-clean-macro name-and-args . body)
+  ;; the new backquote implementation breaks this slightly -- it's currently confused about unquoted nil in the original
+  (let ((syms ()))
+
+    (define (walk func lst)
+      (if (and (func lst)
+	       (pair? lst))
+	  (begin
+	    (walk func (car lst))
+	    (walk func (cdr lst)))))
+
+    (define (car-member sym lst)
+      (if (null? lst)
+	  #f
+	  (if (eq? sym (caar lst))
+	      (cdar lst)
+	      (car-member sym (cdr lst)))))
+
+    (define (walker val)
+      (if (pair? val)
+	  (if (eq? (car val) 'quote)
+	      (or (car-member (cadr val) syms)
+		  (and (pair? (cadr val))
+		       (or (and (eq? (caadr val) 'quote) ; 'sym -> (quote (quote sym))
+				val)
+			   (append (list 'list)
+				   (walker (cadr val)))))
+		  (cadr val))
+	      (cons (walker (car val))
+		    (walker (cdr val))))
+	  (or (car-member val syms)
+	      val)))
+
+    (walk (lambda (val)
+	    (if (and (pair? val)
+		     (eq? (car val) 'quote)
+		     (symbol? (cadr val))
+		     (not (car-member (cadr val) syms)))
+		(set! syms (cons
+			    (cons (cadr val)
+				  (gensym (symbol->string (cadr val))))
+			    syms)))
+	    (or (not (pair? val))
+		(not (eq? (car val) 'quote))
+		(not (pair? (cadr val)))
+		(not (eq? (caadr val) 'quote))))
+	  body)
+
+    (let* ((new-body (walker body))
+	   (new-syms (map (lambda (slot)
+			    (list (cdr slot) '(gensym)))
+			  syms))
+	   (new-globals
+	    (let ((result ()))
+	      (for-each
+	       (lambda (slot)
+		 (if (defined? (car slot))
+		     (set! result (cons
+				   (list 'set! (cdr slot) (car slot))
+				   result))))
+	       syms)
+	      result)))
+
+      `(define-macro ,name-and-args
+	 (let ,new-syms
+	   ,@new-globals
+	   `(begin ,,@new-body))))))
+
+
+(define-macro (define-immaculo name-and-args . body)
+  (let* ((gensyms (map (lambda (g) (gensym)) (cdr name-and-args)))
+	 (args (cdr (copy name-and-args)))
+	 (name (car name-and-args))
+	 (set-args (map (lambda (a g) `(list ',g ,a)) args gensyms))
+	 (get-args (map (lambda (a g) `(quote (cons ',a ,g))) args gensyms))
+	 (blocked-args (map (lambda (a) `(,a ',a)) args))
+	 (new-body (list (apply let blocked-args body))))
+    `(define-macro ,name-and-args
+       `(let ,(list ,@set-args)
+	  ,(list 'with-let
+		 (append (list 'sublet)
+			 (list (list 'funclet ,name))
+			 (list ,@get-args))
+		 ',@new-body)))))
+
+;;; this is not perfect: if unquote is on expr involving an arg, it's going to be unhappy,
+;;;   but we can always move the unquote in, so it's purely stylistic.  Another way would
+;;;   be to remove one level of unquotes throughout -- then the blocked-args and new-body
+;;;   would be unneeded.
+
+;;; in fact, it's wrong -- in the body we need to make explicit let refs to avoid collisions
+;;; these tests are pointless
+(test (let () (define-clean-macro (hi a) `(+ ,a 1)) (hi 1)) 2)
+(test (let () (define-immaculo (hi a) `(+ ,a 1)) (hi 1)) 2)
+(test (let () (define-immaculo (hi a) `(let ((b 23)) (+ b ,a)))	(hi 2)) 25)
+(test (let () (define-immaculo (mac a b) `(let ((c (+ ,a ,b))) (let ((d 12)) (* ,a ,b c d)))) (mac 2 3)) 360)
+(test (let () (define-immaculo (mac a b) `(let ((c (+ ,a ,b))) (let ((d 12)) (* ,a ,b c d)))) (let ((c 2) (d 3)) (mac c d))) 360)
+(test (let () (define-clean-macro (mac a . body) `(+ ,a ,@body)) (mac 2 3 4)) 9)
+(test (let () (define-clean-macro (mac) (let ((a 1)) `(+ ,a 1))) (mac)) 2)
+(test (let () (define-immaculo (mac) (let ((a 1)) `(+ ,a 1))) (mac)) 2)
+(test (let () (define-immaculo (hi a) `(list 'a ,a)) (hi 1)) (list 'a 1))
+
+
+(test (let () (define-macro (hi a) `(+ 1 (if ,(= a 0) 0 (hi ,(- a 1))))) (hi 3)) 4)
+(test (let () (define-macro (hi a) `(+ 1 ,a)) ((if #t hi abs) -3)) -2)
+(test (let () (apply define-macro '((m a) `(+ 1 ,a))) (m 2)) 3)
+(test (let () (apply (eval (apply define-macro '((m a) `(+ 1 ,a)))) '(3))) 4)
+(test (let () (apply (eval (apply define '((hi a) (+ a 1)))) '(2))) 3)
+(test (let () ((eval (apply define '((hi a) (+ a 1)))) 3)) 4)
+(test (let () ((eval (apply define-macro '((m a) `(+ 1 ,a)))) 3)) 4)
+(test (let () ((apply define '((hi a) (+ a 1))) 3)) 4)
+(test (let () ((apply define-macro '((m a) `(+ 1 ,a))) 3)) 4)
+(test (let ()
+	(define-macro (mu args . body)
+	  (let ((m (gensym)))
+	    `(apply define-macro '((,m ,@args) ,@body))))
+	((mu (a) `(+ 1 ,a)) 3))
+      4)
+(test (let () (define-macro (hi a) `(+ 1 ,a)) (map hi '(1 2 3))) '(2 3 4))
+(test (let () (define-macro (hi a) `(+ ,a 1)) (apply hi '(4))) 5)
+(test (let ()
+	(define-macro (hi a) `(+ ,a 1))
+	(define (fmac mac) (apply mac '(4)))
+	(fmac hi))
+      5)
+(test (let ()
+	(define (make-mac)
+	  (define-macro (hi a) `(+ ,a 1))
+	  hi)
+	(let ((x (make-mac)))
+	  (x 2)))
+      3)
+
+(define-macro* (_mac1_) `(+ 1 2))
+(test (_mac1_) 3)
+(define-macro* (_mac2_ a) `(+ ,a 2))
+(test (_mac2_ 1) 3)
+(test (_mac2_ :a 2) 4)
+(define-macro* (_mac3_ (a 1)) `(+ ,a 2))
+(test (_mac3_) 3)
+(test (_mac3_ 3) 5)
+(test (_mac3_ :a 0) 2)
+(define-macro* (_mac4_ (a 1) (b 2)) `(+ ,a ,b))
+(test (_mac4_) 3)
+(test (_mac4_ :b 3) 4)
+(test (_mac4_ 2 :b 3) 5)
+(test (_mac4_ :b 10 :a 12) 22)
+(test (_mac4_ :a 4) 6)
+
+(define-bacro* (_mac21_) `(+ 1 2))
+(test (_mac21_) 3)
+(define-bacro* (_mac22_ a) `(+ ,a 2))
+(test (_mac22_ 1) 3)
+(test (_mac22_ :a 2) 4)
+(define-bacro* (_mac23_ (a 1)) `(+ ,a 2))
+(test (_mac23_) 3)
+(test (_mac23_ 3) 5)
+(test (_mac23_ :a 0) 2)
+(define-bacro* (_mac24_ (a 1) (b 2)) `(+ ,a ,b))
+(test (_mac24_) 3)
+(test (_mac24_ :b 3) 4)
+(test (_mac24_ 2 :b 3) 5)
+(test (_mac24_ :b 10 :a 12) 22)
+(test (_mac24_ :a 4) 6)
+
+(define-macro* (_mac11_) `(+ 1 2))
+(test (_mac11_) 3)
+(define-macro* (_mac12_ a) `(+ ,a 2))
+(test (_mac12_ 1) 3)
+(test (_mac12_ :a 2) 4)
+(define-macro* (_mac13_ (a 1)) `(+ ,a 2))
+(test (_mac13_) 3)
+(test (_mac13_ 3) 5)
+(test (_mac13_ :a 0) 2)
+(define-macro* (_mac14_ (a 1) (b 2)) `(+ ,a ,b))
+(test (_mac14_) 3)
+(test (_mac14_ :b 3) 4)
+(test (_mac14_ 2 :b 3) 5)
+(test (_mac14_ :b 10 :a 12) 22)
+(test (_mac14_ :a 4) 6)
+
+(define-bacro (symbol-set! var val) `(set! ,(symbol->value var) ,val))
+(test (let ((x 32) (y 'x)) (symbol-set! y 123) (list x y)) '(123 x))
+
+(define-bacro (symbol-eset! var val) `(set! ,(eval var) ,val))
+(test (let ((x '(1 2 3)) (y `(x 1))) (symbol-eset! y 123) (list x y)) '((1 123 3) (x 1)))
+(test (let ((x #(1 2 3)) (y `(x 1))) (symbol-eset! y 123) (list x y)) '(#(1 123 3) (x 1)))
+
+(let ()
+  (define-macro (hi a) `````(+ ,,,,,a 1))
+  (test (eval (eval (eval (eval (hi 2))))) 3)
+
+  (define-macro (hi a) `(+ ,@@a))
+  (test (hi (1 2 3)) 'error)
+
+  (define-macro (hi @a) `(+ ,@@a))
+  (test (hi (1 2 3)) 6))
+
+
+;;; --------------------------------------------------------------------------------
+;;; # readers
+;;; *#readers*
+;;;
+;;; #\; reader:
+
+(let-temporarily ((*#readers* ()))
+
+  ;; testing *#readers* is slightly tricky because the reader runs before we evaluate the test expression
+  ;;    so in these cases, the new reader use is always in a string
+
+  (set! *#readers* (list (cons #\s (lambda (str) 123))))
+  (let ((val (eval-string "(+ 1 #s1)"))) ; force this into the current reader
+    (test val 124))
+  (set! *#readers* ())
+
+  (set! *#readers*
+	(cons (cons #\t (lambda (str)
+			  (string->number (substring str 1) 12)))
+	      *#readers*))
+  (num-test (string->number "#tb") 11)
+  (num-test (string->number "#t11.3") 13.25)
+  (num-test (string->number "#t#t1a") 22.0)
+  (num-test (string->number "#t#t#t1a") 22.0)
+  (test (eval-string "#t") #t)
+;  (test (eval-string "#T1") 'error)
+
+  (set! *#readers*
+	(cons (cons #\. (lambda (str)
+			  (if (string=? str ".") (eval (read)) #f)))
+	      *#readers*))
+
+  (test (eval-string "'(1 2 #.(* 3 4) 5)") '(1 2 12 5))
+  (num-test (string->number "#t1a") 22)
+  (test (eval-string "'(1 #t(2))") '(1 #t (2)))
+  (test (string->number "#t1r") #f)
+
+  (set! *#readers* (list (cons #\t (lambda (str)
+				     ;; in the duplicated case: "t#t..."
+				     (if (< (length str) 3)
+					 (string->number (substring str 1) 12)
+					 (and (not (char=? (str 1) #\#))
+					      (not (char=? (str 2) #\t))
+					      (string->number (substring str 1) 12)))))))
+  (test (string->number "#t#t1a") #f)
+
+  (set! *#readers* (cons (cons #\x (lambda (str)
+				     (or (if (< (length str) 3)
+					     (string->number (substring str 1) 7)
+					     (and (not (char=? (str 1) #\#))
+						  (not (char=? (str 2) #\x))
+						  (string->number (substring str 1) 7)))
+					 'error)))
+			 *#readers*))
+
+  (num-test (string->number "#x12") 9)
+  (num-test (string->number "#x-142.1e-1") -11.30612244898)
+  (num-test (string->number "#t460.88") 648.72222222222)
+  (num-test (string->number "#x1") 1)
+  (test (string->number "#te") #f)
+  (num-test (string->number "#x10") 7)
+  (test (string->number "#x17") #f)
+  (num-test (string->number "#x106") 55)
+  (test (string->number "#x#t1") #f)
+
+  (let ()
+    (define (read-in-radix str radix)
+      ;; no error checking, only integers
+      (define (char->digit c)
+	(cond ((char-numeric? c)
+	       (- (char->integer c) (char->integer #\0)))
+	      ((char-lower-case? c)
+	       (+ 10 (- (char->integer c) (char->integer #\a))))
+	      (#t
+	       (+ 10 (- (char->integer c) (char->integer #\A))))))
+      (let* ((negative (char=? (str 0) #\-))
+	     (len (length str))
+	     (j (if (or negative (char=? (str 0) #\+)) 2 1))) ; first char is "z"
+	(do ((sum (char->digit (str j))
+		  (+ (* sum radix) (char->digit (str j)))))
+	    ((= j (- len 1)) sum)
+	  (set! j (+ j 1)))))
+
+    (set! *#readers* (list (cons #\z (lambda (str) (read-in-radix str 32)))))
+    (num-test (string->number "#z1p") 57)
+    )
+
+  (let ((p1 (dilambda (lambda (str) (string->number (substring str 1) 12)) (lambda (a b) a))))
+    (set! *#readers* (list (cons #\t p1)))
+    (num-test (string->number "#ta") 10)
+    (num-test (string->number "#t11.6") 13.5)))
+
+(let-temporarily ((*#readers* (list (cons #\A (lambda (s) (and (string=? s "A") let)))
+		                    (cons #\B (lambda (s) (and (string=? s "B") `((x 1)))))
+ 		                    (cons #\C (lambda (s) (and (string=? s "C") `(+ x 1)))))))
+  (test (eval-string "(#A #B #C)") 2))
+
+(num-test (string->number "#x106") 262)
+(num-test (string->number "#x17") 23)
+
+(let ((old-readers *#readers*)
+      (reader-file tmp-output-file))
+  ;; to test readers in a file, we need to write the file and load it, so here we go...
+  (set! *#readers* ())
+
+  (define circular-list-reader
+    (let ((known-vals #f)
+	  (top-n -1))
+      (lambda (str)
+
+	(define (replace-syms lst)
+	  ;; walk through the new list, replacing our special keywords
+	  ;;   with the associated locations
+
+	  (define (replace-sym tree getter)
+	    (if (keyword? (getter tree))
+		(let ((n (string->number (symbol->string (keyword->symbol (getter tree))))))
+		  (if (integer? n)
+		      (let ((lst (assoc n known-vals)))
+			(if lst
+			    (set! (getter tree) (cdr lst))
+			    (format *stderr* "#~D# is not defined~%" n)))))))
+
+	  (define (walk-tree tree)
+	    (if (pair? tree)
+		(begin
+		  (if (pair? (car tree)) (walk-tree (car tree)) (replace-sym tree car))
+		  (if (pair? (cdr tree)) (walk-tree (cdr tree)) (replace-sym tree cdr))))
+	    tree)
+
+	  (walk-tree (cdr lst)))
+
+	;; str is whatever followed the #, first char is a digit
+	(let* ((len (length str))
+	       (last-char (str (- len 1))))
+	  (and (memq last-char '(#\= #\#))             ; is it #n= or #n#?
+	       (let ((n (string->number (substring str 0 (- len 1)))))
+		 (and (integer? n)
+		      (begin
+			(if (not known-vals)
+			    (begin
+			      (set! known-vals ())
+			      (set! top-n n)))
+
+			(if (char=? last-char #\=)      ; #n=
+			    (and (char=? (peek-char) #\()
+				 (let ((cur-val (assoc n known-vals)))
+				   ;; associate the number and the list it points to
+				   ;;    if cur-val, perhaps complain? (#n# redefined)
+				   (let ((lst (catch #t
+						(lambda ()
+						  (read))
+						(lambda args             ; a read error
+						  (set! known-vals #f)   ;   so clear our state
+						  (apply throw args))))) ;   and pass the error on up
+				     (if (not cur-val)
+					 (set! known-vals
+					       (cons (set! cur-val (cons n lst)) known-vals))
+					 (set! (cdr cur-val) lst)))
+
+				   (if (= n top-n)       ; replace our special keywords
+				       (let ((result (replace-syms cur-val)))
+					 (set! known-vals #f)
+					 result)
+				       (cdr cur-val))))
+				                     ; #n=<not a list>?
+
+			    ;; else it's #n# -- set a marker for now since we may not
+			    ;;   have its associated value yet.  We use a symbol name that
+			    ;;   string->number accepts.
+			    (symbol->keyword
+			     (symbol (string-append (number->string n) (string #\null) " ")))))))
+		                                    ; #n<not an integer>?
+	       )))))                                ; #n<something else>?
+
+  (define (sharp-plus str)
+    ;; str here is "+", we assume either a symbol or a expression involving symbols follows
+    (let* ((e (if (string=? str "+")
+		  (read)                                ; must be #+(...)
+		  (string->symbol (substring str 1))))  ; #+feature
+	   (expr (read)))
+      (if (symbol? e)
+	  (if (provided? e)
+	      expr
+	      (values))
+	  (if (pair? e)
+	      (begin
+		(define (traverse tree)
+		  (if (pair? tree)
+		      (cons (traverse (car tree))
+			    (if (null? (cdr tree)) () (traverse (cdr tree))))
+		      (if (memq tree '(and or not))
+			  tree
+			  (and (symbol? tree)
+			       (provided? tree)))))
+		(if (eval (traverse e))
+		    expr
+		    (values)))
+	      (error 'test-error "strange #+ chooser: ~S~%" e)))))
+
+  (set! *#readers*
+	(cons (cons #\+ sharp-plus)
+	      (cons (cons #\. (lambda (str) (if (string=? str ".") (eval (read)) #f)))
+		    (cons (cons #\; (lambda (str) (if (string=? str ";") (read)) (values)))
+			  *#readers*))))
+
+  (when pure-s7 (set! *#readers* (append *#readers* old-readers)))
+
+  (do ((i 0 (+ i 1)))
+      ((= i 10))
+    (set! *#readers*
+	  (cons (cons (integer->char (+ i (char->integer #\0))) circular-list-reader)
+		*#readers*)))
+
+  (call-with-output-file reader-file
+    (lambda (port)
+      (format port "(define x #.(+ 1 2 3))~%")
+      (format port "(define xlst '(1 2 3 #.(* 2 2)))~%")
+
+      (format port "(define y '#1=(2 . #1#))~%")
+      (format port "(define y1 '#1=(2 #2=(3 #3=(#1#) . #3#) . #2#))~%")
+      (format port "(define y2 #2d((1 2) (3 4)))~%")
+
+      (format port "#+s7 (define z 32)~%#+asdf (define z 123)~%")
+      (format port "#+(and complex-numbers (or snd s7)) (define z1 1)~%#+(and (not complex-numbers) (or asdf s7)) (define z1 123)~%")
+
+      (format port "(define x2 (+ 1 #;(* 2 3) 4))~%")
+      (format port "(define x3 (+ #;32 1 2))~%")
+      (format port "(define x4 (+ #; 32 1 2))~%")
+
+      (format port "(define y3 (+ 1 (car '#1=(2 . #1#))))~%")
+      (format port "(define y4 #.(+ 1 (car '#1=(2 . #1#))))~%")
+      (format port "(define y5 (+ 1 #.(* 2 3) #.(* 4 #.(+ 5 6))))~%")
+
+      (format port "(define r1 '(1 #. #;(+ 2 3) 4))~%")
+      (format port "(define r2 '(1 #. #;(+ 2 3) (* 2 4)))~%")
+      (format port "(define r3 '(1 #; #.(+ 2 3) (* 2 4)))~%")
+      (format port "(define r4 '(1 #. #1=(+ 2 3) (* 2 4)))~%")
+      (format port "(define r5 '(1 #. #1=(+ 2 #. 3) (* 2 4)))~%")
+      ;; but #.3 is ambiguous: '(1 #. #1=(+ 2 #.3) (* 2 4))
+      (format port "(define r6 '(1 #. #1=(+ 2 #+pi 3) (* 2 4)))~%")
+      (format port "(define r7 '(1 #. #1=(+ 2 #+pi #1#) (* 2 4)))~%")
+      (format port "(define r8 '(1 #+s7 #1=(1 2) 3))~%")
+      (format port "(define r9 '(1 #+asdf #1=(1 2) 3))~%")
+      (format port "(define r10 #. #1#)~%")
+      (format port "(define r14 #. #o1)~%")
+      (format port "(define r15 #. #_-)~%")
+      (format port "(define r17 (#. #_- #o1))~%")
+      (format port "(define r18 (#. #.  #_+))~%")
+      (format port "(define r19 (#. #+s7  #_+))~%")
+      (format port "(define r20 (#+s7 #+s7 #_+))~%")
+      (format port "(define r21 (#_-(#_+ 1 2)3))~%")
+      (format port "(define r22 (#(#_+ 1 2)#o1))~%")
+      (format port "(define r23 (+ #;#1.##+asdf ))~%")
+      (format port "(define r24 (+ #. #;(#_+ 1 2)))~%")
+      (format port "(define r25 (+ #;#1=#2=))~%")
+      (format port "(define r26 (+ #;#2#(#_+ 1 2)))~%")
+      (format port "(define r27 (+ #;#1=.))~%")
+      (format port "(define r28 (+ #; #; #; ()))~%")
+      (format port "(define r29 (+ 3(#_+ 1 2)#;#. ))~%")
+      (format port "(define r30 (+ #;#2=#+asdf#+s7))~%")
+      (format port "(define r31 (+ #;#f#=#\\))~%")
+      (format port "(define r32 (#. + (#_-(#_+ 1 2))))~%")
+      (format port "(define r33 (+ 1 #+asdf #\\a 2))~%")
+      (format port "(define r34 (+ #++(#. #\\a)))~%")
+      (format port "(define r35 (+ #+s7 #; (33)))~%")
+
+      (format port "(define r36 (cos #. #. #. `(string->symbol \"pi\")))~%")
+      ))
+
+  (catch #t
+    (lambda ()
+      (let ()
+	(load reader-file (curlet))
+	(if (not (= x 6)) (format #t ";#.(+ 1 2 3) -> ~A~%" x))
+	(if (not (equal? xlst '(1 2 3 4))) (format #t ";#.(* 2 2) -> ~A~%" xlst))
+	(if (not (equal? (object->string y) "#1=(2 . #1#)")) (format #t ";'#1=(2 . #1#) -> ~S~%" (object->string y)))
+	(if (not (equal? (object->string y1) "#1=(2 #3=(3 #2=(#1#) . #2#) . #3#)"))
+	    (format #t ";'#1=(2 #2=(3 #3=(#1#) . #3#) . #2#) -> ~S~%" (object->string y1)))
+	(if (not (equal? y2 #2d((1 2) (3 4)))) (format #t ";#2d((1 2) (3 4)) -> ~A~%" y2))
+	(if (not (= z 32)) (format #t ";#+asdf? -> ~A~%" z))
+	(if (not (= z1 1)) (format #t ";#(or ... +asdf)? -> ~A~%" z1))
+	(if (not (= x2 5)) (format #t ";(+ 1 #;(* 2 3) 4) -> ~A~%" x2))
+	(if (not (= x3 3)) (format #t ";(+ #;32 1 2) -> ~A~%" x3))
+	(if (not (= x4 3)) (format #t ";(+ #; 32 1 2) -> ~A~%" x4))
+	(if (not (= y3 3)) (format #t ";(+ 1 (car '#1=(2 . #1#))) -> ~A~%" y3))
+	(if (not (= y4 3)) (format #t ";#.(+ 1 (car '#1=(2 . #1#))) -> ~A~%" y4))
+	(if (not (= y5 51)) (format #t ";(+ 1 #.(* 2 3) #.(* 4 #.(+ 5 6))) -> ~A~%" y5))
+
+	(if (not (equal? r1 '(1 4))) (format #t ";'(1 #. #;(+ 2 3) 4) -> ~A~%" r1))
+	(if (not (equal? r2 '(1 (* 2 4)))) (format #t ";'(1 #. #;(+ 2 3) (* 2 4)) -> ~A~%" r2))
+	(if (not (equal? r3 '(1 (* 2 4)))) (format #t ";'(1 #; #.(+ 2 3) (* 2 4)) -> ~A~%" r3))
+	(if (not (equal? r4 '(1 5 (* 2 4)))) (format #t ";'(1 #. #1=(+ 2 3) (* 2 4)) -> ~A~%" r4))
+	(if (not (equal? r5 '(1 5 (* 2 4)))) (format #t ";'(1 #. #1=(+ 2 #. 3) (* 2 4)) -> ~A~%" r5))
+	(if (not (equal? r6 '(1 2 (* 2 4)))) (format #t ";'(1 #. #1=(+ 2 #+pi 3) (* 2 4)) -> ~A~%" r6))
+	(if (not (equal? r7 '(1 2 (* 2 4)))) (format #t ";'(1 #. #1=(+ 2 #+pi #1#) (* 2 4)) -> ~A~%" r7))
+	(if (not (equal? r8 '(1 (1 2) 3))) (format #t ";'(1 #+s7 #1=(1 2) 3) -> ~A~%" r8))
+	(if (not (equal? r9 '(1 3))) (format #t ";'(1 #+asdf #1=(1 2) 3)) -> ~A~%" r9))
+	(if (not (equal? r10 ':1)) (format #t ";#. #1# -> ~A~%" r10))
+	(if (not (equal? r14 1)) (format #t ";#. #o1 -> ~A~%" r14))
+	(if (not (equal? r15 -)) (format #t ";#. #_- -> ~A~%" r15))
+	(if (not (equal? r17 -1)) (format #t ";(#. #_- #o1) -> ~A~%" r17))
+	(if (not (equal? r18 0)) (format #t ";(#. #.  #_+) -> ~A~%" r18))
+	(if (not (equal? r19 0)) (format #t ";(#. #+s7  #_+) -> ~A~%" r19))
+	(if (not (equal? r20 0)) (format #t ";(#+s7 #+s7 #_+) -> ~A~%" r20))
+	(if (not (equal? r21 0)) (format #t ";(#_-(#_+ 1 2)3) -> ~A~%" r21))
+	(if (not (equal? r22 1)) (format #t ";(#(#_+ 1 2)#o1) -> ~A~%" r22))
+	(if (not (equal? r23 0)) (format #t ";(+ #;#1.##+asdf ) -> ~A~%" r23))
+	(if (not (equal? r24 0)) (format #t ";(+ #. #;(#_+ 1 2)) -> ~A~%" r24))
+	(if (not (equal? r25 0)) (format #t ";(+ #;#1=#2=) -> ~A~%" r25))
+	(if (not (equal? r26 3)) (format #t ";(+ #;#2#(#_+ 1 2)) -> ~A~%" r26))
+	(if (not (equal? r27 0)) (format #t ";(+ #;#1=.) -> ~A~%" r27))
+	(if (not (equal? r28 0)) (format #t ";(+ #; #; #; ()) -> ~A~%" r28))
+	(if (not (equal? r29 6)) (format #t ";(+ 3(#_+ 1 2)#;#. ) -> ~A~%" r29))
+	(if (not (equal? r30 0)) (format #t ";(+ #;#2=#+asdf#+s7) -> ~A~%" r30))
+	(if (not (equal? r31 0)) (format #t ";(+ #;#f#=#\\) -> ~A~%" r31))
+	(if (not (equal? r32 -3)) (format #t ";(#. + (#_-(#_+ 1 2))) -> ~A~%" r32))
+	(if (not (equal? r33 3)) (format #t ";(+ 1 #+asdf #\\a 2) -> ~A~%" r33))
+	(if (not (equal? r34 0)) (format #t ";(+ #++(#. #\\a)) -> ~A~%" r34))
+	(if (not (equal? r35 0)) (format #t ";(+ #+s7 #; (33)) -> ~A~%" r35))
+
+	(if (not (equivalent? r36 -1.0)) (format #t ";(cos #. #. #. `(string->symbol \"pi\")) -> ~A~%" r36))
+	))
+    (lambda (type info)
+      (format *stderr* "reader test: ~A ~A~%" type info)))
+
+  (set! *#readers* old-readers))
+
+(define *old-#readers* *#readers*)
+(set! *#readers*  ; #[...] -> '(...)
+      (cons (cons #\[ (lambda (str)
+			(if (char=? (str 1) #\]) ; #[] -> ()
+			    ()
+			    (let ((pos (char-position #\] str)))
+			      (if pos            ; #[1] -> '(1)
+				  (with-input-from-string (string-append "'(" (substring str 1 (- (length str) 1)) ")") read)
+				  (do ((S (string-append "'(" (substring str 1))) ; or #( for vector
+				       (E (read-char) (read-char)))
+				      ((char=? E #\])
+				       (with-input-from-string (string-append S ")") read))
+				    (set! S (string-append S (string E)))))))))
+	    ()))
+
+(test #[1 2] '(1 2))
+(test #[] ())
+(test #[a b (1 2 3)] '(a b (1 2 3)))
+(test #[ab (1 2 3)] '(ab (1 2 3)))
+(test (pair? #[1 2]) #t)
+(test #[1] '(1))
+(set! *#readers* *old-#readers*)
+
+;;; check a pair_to_port bug (subsequent read = missing close paren)
+(with-input-from-string
+    (object->string (car (list (cons  (apply + (make-list 2 3)) (let ((<1> (vector #f))) (set! (<1> 0) <1>) <1>)))) :readable)
+     read)
+(with-input-from-string
+    (object->string (car (list (cons  (bignum -inf.0) (let ((<1> (inlet :a #f))) (set! (<1> :a) <1>) <1>)))) :readable)
+     read)
+
+(let-temporarily ((*#readers*
+		   (cons
+		    (cons #\& (lambda (str)
+				(if (= (string-length str) 1) ; #& followed by a reader delimiter
+				    (read)
+				    (begin
+				      (set! (port-position (current-input-port))
+					    (- (port-position (current-input-port))
+					       (string-length str)
+					       -2)) ;-1))
+				      (string (string-ref str 1))))))
+		    ())))
+  (with-input-from-string "#&Newton"
+    (lambda ()
+      (test (read) "N")
+      (test (read) 'ewton)
+      (test (read) #<eof>)))
+  (with-input-from-string "#&N#&123"
+    (lambda ()
+      (test (read) "N")
+      (test (read) "1")
+      (test (read) 23)
+      (test (read) #<eof>)))
+  (with-input-from-string "#&(123)"
+    (lambda ()
+      (test (read) '(123))
+      (test (read) #<eof>))))
+
+
+(set! *#readers*
+      (list (cons #\s
+		  (lambda (str)
+		    (let ((len (length str)))
+		      (and (string=? (substring str 0 7) "symbol<")
+			   (if (char=? (str (- len 1)) #\>) ; pointless use of #symbol!
+			       (symbol (substring str 7 (- len 1)))
+			       (do ((sym (substring str 7))
+				    (c (read-char) (read-char)))
+				   ((memq c (list #\> #<eof>))
+				    (string->symbol sym))
+				 (set! sym (string-append sym (string c)))))))))))
+
+(test (let ((#symbol<a b c> 32)) (+ #symbol<a b c> 1)) 33)
+(test (let ((#symbol<ab cd> 32)) #symbol<ab cd>) 32)
+(test (let ((#symbol< a b c > 32)) #symbol< a b c >) 32)
+(test (let ((#symbol<a b c> 3) (#symbol<ab cd> 4) (#symbol< a b c > 5)) (+ #symbol<ab cd> #symbol<a b c> #symbol< a b c >)) 12)
+(test (symbol->string '#symbol<a b>) "a b")
+
+(let () (define (f #symbol<a b>) (+ #symbol<a b> 3)) (test (f 2) 5))
+(let () (define* (f (#symbol<a b> 1)) (+ #symbol<a b> 3))
+  (test (f 2) 5)
+  (test (f) 4)
+  (test (f #symbol<:a b> 3) 6))
+
+(define #symbol<a b> 12)
+(let-temporarily ((#symbol<a b> 3))
+  (test #symbol<a b> 3))
+(test #symbol<a b> 12)
+
+(test (let () (define #symbol<a b> 32) (set! #symbol<a b> (+ #symbol<a b> 1)) #symbol<a b>) 33)
+(test (let () (define #symbol<a b> 32) (immutable! '#symbol<a b>) (set! #symbol<a b> 1)) 'error) ; can't set! (symbol "a b") (it is immutable)
+
+(let ((abc 12)
+      (#symbol<efg> 14))
+  (test #symbol<abc> 12) ; same as abc
+  (test efg 14))         ; same as #symbol<efg>
+
+(unless (> (*s7* 'debug) 0)
+(let ()
+  (define f (apply lambda (list () (list 'let (list (list (symbol "a b") 3)) (symbol "a b"))))) ; (f) -> 3
+  ;; prints "readably" as "(lambda () (let (((symbol \"a b\") 3)) (symbol \"a b\")))"
+  (let-temporarily (((*s7* 'symbol-printer) (lambda (obj) (string-append "#symbol<" (symbol->string obj) ">"))))
+    (test (object->string f :readable) "(lambda () (let ((#symbol<a b> 3)) #symbol<a b>))"))
+  (let-temporarily (((*s7* 'symbol-printer) (lambda (obj) 312)))
+    (test (object->string f :readable) 'error))))
+
+(test (set! (*s7* 'symbol-printer) 3) 'error)
+(test (set! (*s7* 'symbol-printer) (lambda () 'oops)) 'error)
+(test (set! (*s7* 'symbol-printer) #f) #f)
+
+(set! *#readers* *old-#readers*)
+
+
+;;; --------------------------------------------------------------------------------
+
+(begin
+  (define-macro (hi a) `(+ ,a 1))
+  (test (hi 2) 3)
+  (let ()
+    (define (ho b) (+ 1 (hi b)))
+    (test (ho 1) 3))
+  (let ((hi 32))
+    (test (+ hi 1) 33))
+  (letrec ((hi (lambda (a) (if (= a 0) 0 (+ 2 (hi (- a 1)))))))
+    (test (hi 3) 6))
+  (letrec* ((hi (lambda (a) (if (= a 0) 0 (+ 2 (hi (- a 1)))))))
+	   (test (hi 3) 6))
+  (test (equal? '(hi 1) (quote (hi 1))) #t)
+  (test (list? '(hi 1)) #t)
+  (test (list? '(((hi 1)))) #t)
+  (test (equal? (vector (hi 1)) #(2)) #t)
+  (test (symbol? (vector-ref #(hi) 0)) #t))
+
+(define-macro (define-with-goto name-and-args . body)
+  ;; run through the body collecting label accessors, (label name)
+  ;; run through getting goto positions, (goto name)
+  ;; tie all the goto's to their respective labels (via set-cdr! essentially)
+
+  (define (find-accessor type)
+    (let ((labels ()))
+      (define (gather-labels accessor tree)
+	(if (pair? tree)
+	    (if (equal? (car tree) type)
+		(begin
+		  (set! labels (cons (cons (cadr tree)
+					   (let ((body 'lst))
+					     (for-each
+					      (lambda (f)
+						(set! body (list f body)))
+					      (reverse (cdr accessor)))
+					     (dilambda
+					      (apply lambda '(lst) (list body))
+					      (apply lambda '(lst val) `((set! ,body val))))))
+				     labels))
+		  (gather-labels (cons 'cdr accessor) (cdr tree)))
+		(begin
+		  (gather-labels (cons 'car accessor) (car tree))
+		  (gather-labels (cons 'cdr accessor) (cdr tree))))))
+      (gather-labels () body)
+      labels))
+  (let ((labels (find-accessor 'label))
+	(gotos (find-accessor 'goto)))
+    (if (not (null? gotos))
+	(for-each
+	 (lambda (goto)
+	   (let* ((name (car goto))
+		  (goto-accessor (cdr goto))
+		  (label (assoc name labels))
+		  (label-accessor (and label (cdr label))))
+	     (if label-accessor
+		 (set! (goto-accessor body) (label-accessor body))
+		 (error 'bad-goto "can't find label: ~S" name))))
+	 gotos))
+    `(define ,name-and-args
+       (let ((label (lambda (name) #f))
+	     (goto (lambda (name) #f)))
+	 ,@body))))
+
+(let ()
+  (define-with-goto (g1 a)
+    (let ((x 1))
+      (if a
+	  (begin
+	    (set! x 2)
+	    (goto 'the-end)
+	    (set! x 3))
+	  (set! x 4))
+      (label 'the-end)
+      x))
+
+  (define-with-goto (g2 a)
+    (let ((x a))
+      (label 'start)
+      (if (< x 4)
+	  (begin
+	    (set! x (+ x 1))
+	    (goto 'start)))
+      x))
+
+  (test (g1 #f) 4)
+  (test (g1 #t) 2)
+  (test (g2 1) 4)
+  (test (g2 32) 32))
+
+(let ((sum 0))
+  (define-macro (define-with-goto-and-come-froms name-and-args . body)
+    (let ((labels ())
+	  (gotos ())
+	  (come-froms ()))
+
+      (define (collect-jumps tree)
+	(when (pair? tree)
+	  (when (pair? (car tree))
+	    (case (caar tree)
+	      ((label)     (set! labels (cons tree labels)))
+	      ((goto)      (set! gotos (cons tree gotos)))
+	      ((come-from) (set! come-froms (cons tree come-froms)))
+	      (else (collect-jumps (car tree)))))
+	  (collect-jumps (cdr tree))))
+
+      (collect-jumps body)
+
+      (for-each
+       (lambda (goto)
+	 (let* ((name (cadr (cadar goto)))
+		(label (member name labels (lambda (a b) (eq? a (cadr (cadar b)))))))
+	   (if label
+	       (set-cdr! goto (car label))
+	       (error 'bad-goto "can't find label: ~S" name))))
+       gotos)
+
+      (for-each
+       (lambda (from)
+	 (let* ((name (cadr (cadar from)))
+		(label (member name labels (lambda (a b) (eq? a (cadr (cadar b)))))))
+	   (if label
+	       (set-cdr! (car label) from)
+	       (error 'bad-come-from "can't find label: ~S" name))))
+       come-froms)
+
+      `(define ,name-and-args
+	 (let ((label (lambda (name) #f))
+	       (goto (lambda (name) #f))
+	       (come-from (lambda (name) #f)))
+	   ,@body))))
+
+  (define-with-goto-and-come-froms (hi)
+    (set! sum (+ sum 1))
+    (goto 'the-end)
+    (set! sum (+ sum 2))
+    (label 'the-end)
+    (set! sum (+ sum 4))
+    (label 'not-done)
+    (set! sum (+ sum 8))
+    (come-from 'not-done)
+    (set! sum (+ sum 16))
+    (newline)
+    sum)
+
+  (test (hi) 21)
+
+  (define-with-goto-and-come-froms (ho i)
+    (label 'the-start)
+    (if (= i 0)
+	(begin
+	  (goto 'the-end))
+	(begin
+	  (set! i (- i 1))
+	  (goto 'the-start)))
+    (label 'the-end)
+    0)
+  (let-temporarily (((*s7* 'safety) 1))
+    (test (object->string ho :readable) "#<write_closure_readably: body is cyclic>") ; changed 12-Mar-19
+    (test (equivalent? ho hi) #f))
+  (test (ho 2) 0))
+
+
+
+;;; ----------------------------------------
+#|
+;;; these tests are problematic -- they might not fail as hoped, or they might generate unwanted troubles
+(let ((bad-ideas "
+                      (define (bad-idea)
+                        (let ((lst '(1 2 3)))
+                          (let ((result (list-ref lst 1)))
+                            (list-set! lst 1 (* 2.0 16.6))
+                            (gc)
+                            result)))
+
+                      (define (bad-idea-1)
+                        (let ((lst #(1 2 3)))
+                          (let ((result (vector-ref lst 1)))
+                            (vector-set! lst 1 (* 2.0 16.6))
+                            (gc)
+                             result)))
+                      "))
+  (with-output-to-file tmp-output-file (lambda () (display bad-ideas)))
+  (load tmp-output-file))
+
+(num-test (bad-idea) 2)
+(let ((val (bad-idea)))
+  (if (equal? val 33.2)
+      (set! val (bad-idea)))
+  (if (equal? val 33.2)
+      (format #t ";bad-idea 3rd time: ~A~%" val)))
+(num-test (bad-idea-1) 2)
+(let ((val (bad-idea-1)))
+  (if (equal? val 33.2)
+      (set! val (bad-idea-1)))
+  (if (equal? val 33.2)
+      (format #t ";bad-idea-1 3rd time: ~A~%" val)))
+(set! (*s7* 'safety) 1)
+(load tmp-output-file)
+(num-test (bad-idea) 2)
+(num-test (bad-idea) 33.2)
+(num-test (bad-idea) 33.2)
+(num-test (bad-idea-1) 2)
+(num-test (bad-idea-1) 33.2)
+(num-test (bad-idea-1) 33.2)
+(set! (*s7* 'safety) 0)
+|#
+
+;(test (quit 0) 'error)
+
+;;; ----------------------------------------
+;;; macroexpand
+(let ()
+  (define-macro (hi a) `(+ ,a 1))
+  (test (macroexpand (hi 2)) '(+ 2 1))
+  (test (macroexpand (hi (abs 2))) '(+ (abs 2) 1))
+  (define-macro (ho a) `(+ ,@a 1))
+  (test (macroexpand (ho (2 3 4))) '(+ 2 3 4 1))
+  (define-macro* (hi1 a (b 2)) `(+ ,a ,b))
+  (test (macroexpand (hi1 3)) '(+ 3 2))
+  (define-bacro* (hi2 a (b 2)) `(+ ,a ,b))
+  (test (macroexpand (hi2 3)) '(+ 3 2))
+  )
+
+(let ()
+  (define-macro (Let vars . body)
+    `(with-let (sublet (curlet)
+		 ,@(map (lambda (var)
+			  (values (symbol->keyword (car var)) (cadr var)))
+			vars))
+       ,@body))
+  (test (Let ((c 4)) (Let ((a 2) (b (+ c 2))) (+ a b c))) 12)
+  (test (macroexpand (Let ((a 2) (b (+ c 2))) (+ a b c))) '(with-let (sublet (curlet) :a 2 :b (+ c 2)) (+ a b c))))
+
+(let ()
+  (define-macro (m1 . args) `(begin ,@args))
+  (test (macroexpand (m1 (display 1) (newline))) '(begin (display 1) (newline))))
+
+(test (let ((a 3) (b (list 2 3 4))) (quasiquote (+ ,a 1 ,@b))) '(+ 3 1 2 3 4))
+(test (let ((a 3) (b (list 2 3 4))) (macroexpand (quasiquote (+ ,a 1 ,@b)))) (list #_list-values ''+ 'a 1 (list #_apply-values 'b)))
+
+(let ()
+  (define-macro* (m2 (a 3) (b 2)) `(+ ,a ,b))
+  (test (macroexpand (m2)) '(+ 3 2))
+  (test (macroexpand ((symbol->value 'm2) (* 2 3))) '(+ (* 2 3) 2)))
+
+(let ()
+  (define-bacro (m3 b) `(+ ,a ,b))
+  (test (let ((a 3)) (macroexpand (m3 2))) '(+ 3 2)))
+
+(let ()
+  (define-macro (progv vars vals . body) `(apply (apply lambda ,vars ',body) ,vals))
+  (test (macroexpand (progv '(one two) '(1 2) (+ one two))) '(apply (apply lambda '(one two) '((+ one two))) '(1 2))))
+
+(let ()
+  (define-macro (Letrec* bindings . body)
+    (if (null? body)
+	(error 'syntax-error "letrec* has no body")
+	(if (not (list? bindings))
+	    (error 'syntax-error "letrec* variables are messed up")
+	    `(let (,@(map (lambda (var&init)
+			    (list (car var&init) #<undefined>))
+			  bindings))
+	       ,@(map (lambda (var&init)
+			(if (not (null? (cddr var&init)))
+			    (error 'syntax-error "letrec* variable has more than one value"))
+			(list 'set! (car var&init) (cadr var&init)))
+		      bindings)
+	       ,@body))))
+  (test (macroexpand (Letrec* ((p (lambda (x) (+ 1 (q (- x 1)))))
+			       (q (lambda (y) (if (zero? y) 0 (+ 1 (p (- y 1))))))
+			       (x (p 5))
+			       (y x))
+		       y))
+	'(let ((p #<undefined>) (q #<undefined>) (x #<undefined>) (y #<undefined>)) (set! p (lambda (x) (+ 1 (q (- x 1))))) (set! q (lambda (y) (if (zero? y) 0 (+ 1 (p (- y 1)))))) (set! x (p 5)) (set! y x) y)))
+
+(let ()
+  (define-macro (m5 a) `(define-macro (m6 b) `(+ 1 ,b ,,a)))
+  (test (macroexpand ((m5 3) 4)) '(+ 1 4 3)))
+
+(let ()
+  (define* (fgh2 (!x (let ()
+		       (define-macro (m5 a) `(define-macro (m6 b) `(+ 1 ,b ,,a)))
+		       (macroexpand ((m5 3) 4)) '(+ 1 4 3))))
+    !x)
+  (test (fgh2) '(+ 1 4 3)))
+
+(test (macroexpand) 'error)
+(test (macroexpand 1) 'error)
+(test (macroexpand . 1) 'error)
+(test (macroexpand (* 1 2)) 'error)
+(test (macroexpand (* 1 2) . 3) 'error)
+(test (macroexpand (* 1 2) 3) 'error)
+(test (macroexpand ((symbol->value 'abs) -1)) 'error)
+(test (macroexpand (1 2)) 'error)
+
+(let ()
+  (define-macro (rmac . args)
+    (if (null? args)
+	()
+	(if (null? (cdr args))
+	    `(display ',(car args))
+	    (append (list 'begin `(display ',(car args)))
+		    (append (list (apply macroexpand (list (append '(rmac) (cdr args))))))))))
+  (test (with-output-to-string
+	  (lambda ()
+	    (rmac a b c (+ 1 2) d)))
+	"abc(+ 1 2)d"))
+
+
+
+;;; define-expansion
+(define-expansion (_expansion_ a) `(+ ,a 1))
+(test (_expansion_ 3) 4)
+(test (macroexpand (_expansion_ 3)) `(+ 3 1))
+(test '(_expansion_ 3) (quote (_expansion_ 3)))
+(test (_expansion_ (+ (_expansion_ 1) 2)) 5)
+(test (let ((x _expansion_)) (x 3)) (+ 3 1))
+(test (let ((x 3)) (define (hi a) (a x)) (hi _expansion_)) 4)
+
+(define-expansion (whatever->zero . whatever) 0)
+(let ((val (+ 1 (whatever->zero 2 3) 4)))
+  (if (not (= val 5))
+      (format *stderr* "whatever->zero: ~A?" val)))
+
+(define (make-instrument-conf6) (<gui3>))
+(define-expansion (<gui3>) `(+ 2 3))
+(test (make-instrument-conf6) 5)
+
+(define (make-instrument-conf5) (<gui2>))
+(define-macro (<gui2>) `(+ 2 3))
+(test (make-instrument-conf5) 5)
+
+(define-expansion (<gui1>) `(+ 2 3))
+(define (make-instrument-conf4) (<gui1>))
+(test (make-instrument-conf4) 5)
+
+(define-expansion* (<mac2> (x 32)) `(+ ,x 1))
+(let ()
+  (define (f2) (+ 2 (<mac2>)))
+  (when (zero? (*s7* 'debug)) (test (procedure-source f2) '(lambda () (+ 2 (+ 32 1)))))
+  (test (f2) 35))
+
+(let ()
+  (define-macro (_mac_ x) `(+ ,x 1))
+  (test (member 1 (list 3 2) (lambda (a b) (null? (macroexpand (_mac_ (make-hash-table)))))) #f))
+
+(let ()
+  (define-macro (c-define-macro2 def . body) `(define-macro ,def ,@body))
+  (c-define-macro2 (*testexp* a . b) `(list ,a ,@b))
+  (test (*testexp* 1 2 3) '(1 2 3))
+  (test (macroexpand (c-define-macro2 (*testexp* a . b) `(list ,a ,@b)))
+	'(define-macro (*testexp* a . b) (#_list-values (#_quote list) a (#_apply-values b)))))
+
+(define-expansion (__add-1__ x) (+ x 1)) ; needs to be global for define-expansion to see it at read-time
+(let ()
+  (define v #((__add-1__ 1) (__add-1__ 2)))
+  (test v #(2 3))) ; !
+
+
+;;; --------------------------------------------------------------------------------
+;;; define-constant
+(test (let () (define-constant __c1__ 32) __c1__) 32)
+(test (let () (define-constant __c1__ 32) (let ((__c1__ 3)) __c1__)) 'error)
+(test (let () (define-constant __c1__ 32) (letrec ((__c1__ 3)) __c1__)) 'error)
+(test (let () (define-constant __c1__ 32) (letrec* ((__c1__ 3)) __c1__)) 'error)
+(test (let () (define-constant __c1__ 32) (let* ((__c1__ 3)) __c1__)) 'error)
+(test (let () (define-constant __c1__ 32) (let () (define __c1__ 3) __c1__)) 'error)
+(test (let () (define-constant __c1__ 32) (let () (set! __c1__ 3) __c1__)) 'error)
+(test (let () (define-constant __c1__ 32) (do ((__c1__ 3)) (#t) __c1__)) 'error)
+(test (let () (define-constant __c1__ 32) (let ((x (inlet :__c1__ 34))) x)) 'error)
+
+(let ()
+  (define (df1 a) (set! pi a))
+  (test (df1 3.0) 'error)
+  (test (df1 #\a) 'error)
+  (define (df2 a b) (set! pi (+ a b)))
+  (test (df2 1.0 2.0) 'error)
+  (define (df3 a) (set! pi (+ pi 1)))
+  (test (df3 1) 'error)
+  (test (set! pi (abs pi)) pi) ; ok 2-Nov-23
+  (test (set! pi pi) pi) ; was 'error 24-Oct-23
+  (test (define-constant pi pi) pi) ;   but this is ok -- define-constant can be a no-op
+  (test (define-constant pi 3.0) 'error)
+  (test (define pi 3.0) 'error)
+  (test (define (pi a) a) 'error)
+  (test (define (f1 pi) pi) 'error)
+  (test (let ((pi 3.0)) pi) 'error)
+  (test (let* ((pi 3.0)) pi) 'error)
+  (test (letrec ((pi 3.0)) pi) 'error)
+  (test (letrec* ((pi 3.0)) pi) 'error)
+  (test (do ((pi 0 (+ pi 1))) ((= pi 3))) 'error)
+  )
+
+(let ((xc 3))
+  (let ()
+    (define-constant xc 32)
+    (test (constant? 'xc) #t)
+    (test (let ((xc 3)) xc) 'error)
+    (test (let* ((y 1) (xc y)) xc) 'error)
+    (test (let ((y (lambda (xc) xc))) (y 1)) 'error)
+    (test (let ((y (lambda (a . xc) xc))) (y 1 2)) 'error)
+    (test (let ((y (lambda* (a :rest xc) xc))) (y 1 2)) 'error)
+    (test (do ((xc 0 (+ xc 1))) ((= xc 2) xc) xc) 'error)
+    (test (inlet 'xc 1) 'error)
+    (test (varlet (inlet) 'xc 1) 'error)
+    (test (set! xc 4) 'error)
+    (test xc 32)
+    (test (let () (define xc 5) xc) 'error)
+    (test (let () (define-constant xc 5) xc) 'error)
+    (test (let () (define* (xc y) 5) (xc)) 'error)
+    (test (let () (define-macro (xc y) `(+ ,y 1)) (xc 2)) 'error)
+    )
+  (test xc 3)
+  (test (constant? 'xc) #f)
+  (test (let ((xc 3)) xc) 3)
+  (test (let* ((y 1) (xc y)) xc) 1)
+  (test (let ((y (lambda (xc) xc))) (y 1)) 1)
+  (test (let ((y (lambda (a . xc) xc))) (y 1 2)) '(2))
+  (test (let ((y (lambda* (a :rest xc) xc))) (y 1 2)) '(2))
+  (test (do ((xc 0 (+ xc 1))) ((= xc 2) xc) xc) 2)
+  (test (inlet 'xc 1) (inlet 'xc 1))
+  (test (varlet (inlet) 'xc 1) (inlet 'xc 1))
+  (test (set! xc 4) 4)
+  (test xc 4)
+  (test (let () (define xc 5) xc) 5)
+  (test (let () (define-constant xc 5) xc) 5)
+  (test (let () (define* (xc y) 5) (xc)) 5)
+  (test (let () (define-macro (xc y) `(+ ,y 1)) (xc 2)) 3)
+  (test xc 4)
+  )
+
+(test (let ((z (let () (define-constant xc 3) (lambda (y) (let ((xc y)) xc))))) (z 1)) 'error)
+(test (let ((xc 1)) (define z (let () (define-constant xc 3) (lambda (y) (let ((xc y)) xc)))) (z 1)) 'error)
+(test (let () (define-constant (xc xc) xc) (xc 1)) 1)
+(let ()
+  (define (f) (define-constant xxx 3) (constant? 'xxx)) ; op_define_constant_unchecked
+  (test (f) #t)
+  (test (f) #t))
+(let ()
+  (define (g) (define-constant (xyx x) (+ x 1)) (constant? 'xyx))
+  (test (g) #t)
+  (test (g) #t))
+
+(let ()
+  (define-constant (func) 1)
+  (test (immutable? func) #t))
+
+(unless (> (*s7* 'profile) 0)
+  (let ()
+    (with-output-to-file tmp-output-file
+      (lambda ()
+        (display "(define-constant _s7test_xxx 32)\n")
+        (display "(define-constant (_s7test_yyy a) (+ a 1))\n")
+        (display "(define-constant _s7test_zzz _s7test_yyy)\n")))
+    (load tmp-output-file)
+    (test _s7test_xxx 32)
+    (test (_s7test_yyy 2) 3)
+    (test (_s7test_zzz 2) 3)
+    (load tmp-output-file)
+    (test _s7test_xxx 32)
+    (test (_s7test_yyy 2) 3)
+    (test (_s7test_zzz 2) 3)))
+
+#|
+(let ((old-stdin *stdin*)
+      (old-closed (port-closed? *stdin*)))
+  (let ((tag (catch #t (lambda () (set! *stdin* #f)) (lambda args 'error))))
+    (when (or (not (eq? *stdin* old-stdin))
+	      (not (eq? old-closed (port-closed? *stdin*))))
+      (set! *stdin* old-stdin)
+      (format *stderr* ";*stdin* mutable?~%"))
+    (if (not (eq? tag 'error))
+	(format *stderr* ";set! *stdin* no error? ~A~%" tag))))
+
+(let ((old-stdout *stdout*)
+      (old-closed (port-closed? *stdout*)))
+  (let ((tag (catch #t (lambda () (set! *stdout* #f)) (lambda args 'error))))
+    (when (or (not (eq? *stdout* old-stdout))
+	      (not (eq? old-closed (port-closed? *stdout*))))
+      (set! *stdout* old-stdout)
+      (format *stderr* ";*stdout* mutable?~%"))
+    (if (not (eq? tag 'error))
+	(format *stderr* ";set! *stdout* no error? ~A~%" tag))))
+
+(let ((old-stderr *stderr*)
+      (old-closed (port-closed? *stderr*)))
+  (let ((tag (catch #t (lambda () (set! *stderr* #f)) (lambda args 'error))))
+    (when (or (not (eq? *stderr* old-stderr))
+	      (not (eq? old-closed (port-closed? *stderr*))))
+      (set! *stderr* old-stderr)
+      (format *stderr* ";*stderr* mutable?~%"))
+    (if (not (eq? tag 'error))
+	(format *stderr* ";set! *stderr* no error? ~A~%" tag))))
+|#
+
+(let ((old-pi pi))
+  (let ((tag (catch #t (lambda () (set! pi #f)) (lambda args 'error))))
+    (if (not (eq? pi old-pi))
+	(format pi ";pi mutable?~%"))
+    (if (not (eq? tag 'error))
+	(format pi ";set! pi no error? ~A~%" tag))))
+
+(let ((old-with-let with-let))
+  (let ((tag (catch #t (lambda () (set! with-let #f)) (lambda args 'error))))
+    (if (not (eq? with-let old-with-let))
+	(format with-let ";with-let mutable?~%"))
+    (if (not (eq? tag 'error))
+	(format with-let ";set! with-let no error? ~A~%" tag))))
+
+(let ((old-*s7* *s7*))
+  (let ((tag (catch #t (lambda () (set! *s7* #f)) (lambda args 'error))))
+    (if (not (eq? *s7* old-*s7*))
+	(format *s7* ";*s7* mutable?~%"))
+    (if (not (eq? tag 'error))
+	(format *s7* ";set! *s7* no error? ~A~%" tag))))
+
+(let ()
+  (define-constant (c_f1 c) (define-constant (c_g1) (if (= c 0) 0 (- c 1))) (c_g1))
+  (test (c_f1 1) 0)
+  (test (c_f1 2) 1)
+
+  (define (c_f2 c) (define (c_g2) (if (= c 0) 0 (- c 1))) (c_g2))
+  (test (c_f2 1) 0)
+  (test (c_f2 2) 1)
+
+  (define-constant (c_f3 c) (define (c_g3) (if (= c 0) 0 (- c 1))) (c_g3))
+  (test (c_f3 1) 0)
+  (test (c_f3 2) 1)
+
+  (define (c_f4 c) (define-constant (c_g4) (if (= c 0) 0 (- c 1))) (c_g4))
+  (test (c_f4 1) 0)
+  (test (c_f4 2) 1)
+
+  (define c_f5 (let ((c 0)) (define-constant (c_g5) (if (= c 0) 0 (- c 1))) (lambda (d) (set! c d) (c_g5))))
+  (test (c_f5 1) 0)
+  (test (c_f5 2) 1)
+
+  (define-constant (c_f6 c) (define-constant (c_g6) (call/cc (lambda (x) (if (= c 0) 0 (- c 1))))) (c_g6))
+  (test (c_f6 1) 0)
+  (test (c_f6 2) 1)
+
+  (define (c_f7 c) (define (c_g7) (call/cc (lambda (x) (if (= c 0) 0 (- c 1))))) (c_g7))
+  (test (c_f7 1) 0)
+  (test (c_f7 2) 1)
+
+  (define-constant (c_f8 c) (define (c_g8) (call/cc (lambda (x) (if (= c 0) 0 (- c 1))))) (c_g8))
+  (test (c_f8 1) 0)
+  (test (c_f8 2) 1)
+
+  (define (c_f9 c) (define-constant (c_g9) (call/cc (lambda (x) (if (= c 0) 0 (- c 1))))) (c_g9))
+  (test (c_f9 1) 0)
+  (test (c_f9 2) 1))
+
+
+;;; --------------------------------------------------------------------------------
+;;; constant?
+
+(test (constant? '__c1__) #f)
+(test (constant? pi) #t)
+(test (constant? 'pi) #t) ; take that, Clisp!
+(test (constant? 12345) #t)
+(test (constant? 3.14) #t)
+(test (constant? :asdf) #t)
+(test (constant? 'asdf) #f)
+(test (constant? "hi") #t)
+(test (constant? #\a) #t)
+(test (constant? #f) #t)
+(test (constant? #t) #t)
+(test (constant? ()) #t)
+(test (constant? '(a)) #t)
+(test (constant? '*features*) #f)
+(test (let ((a 3)) (constant? 'a)) #f)
+(test (constant? 'abs) #f)
+(test (constant? abs) #t)
+(test (constant? most-positive-fixnum) #t)
+(test (constant? (/ (log 0))) #t)       ; +nan.0 is a constant as a number I guess
+(test (constant? 1/0) #t)
+(test (constant? (log 0)) #t)
+(test (constant?) 'error)
+(test (constant? 1 2) 'error)
+(test (constant? #<eof>) #t) ; ?
+(test (constant? #<undefined>) #t)
+(test (constant? _undef_) #t)
+(test (constant? #<unspecified>) #t)
+(test (constant? '-) #f)
+(test (constant? ''-) #t)
+(test (constant? '''-) #t)
+(test (constant? '1) #t)
+(test (constant? 1/2) #t)
+(test (constant? 'with-let) #t)
+(test (constant? with-let) #t)
+(test (constant? (cons 1 2)) #t)
+(test (constant? #(1 2)) #t)
+(test (constant? (list 1 2)) #t)
+(test (constant? (vector 1 2)) #t)
+(test (let ((v (vector 1 2))) (constant? v)) #t) ;!!
+;; it's returning #t unless the arg is a symbol that is not a keyword or a defined constant
+;; (it's seeing the value of v, not v):
+(test (let ((v (vector 1 2))) (constant? 'v)) #f)
+;; that is something that can be set! is not a constant?
+
+(when with-bignums
+  (test (constant? 1624540914719833702142058941) #t)
+  (test (constant? 1624540914719833702142058941.4) #t)
+  (test (constant? 7151305879464824441563197685/828567267217721441067369971) #t))
+
+(test (constant? lambda) #t)   ; like abs?
+(test (constant? (lambda () 1)) #t)
+(test (constant? ''3) #t)
+(test (constant? (if #f #f)) #t)
+(test (constant? 'x) #f)
+(test (let ((x 'x)) (and (not (constant? x)) (equal? x (eval x)))) #t)
+(test (and (constant? (list + 1)) (not (equal? (list + 1) (eval (list + 1))))) #t)
+
+
+;;; --------------------------------------------------------------------------------
+;;; immutable!
+;;; immutable?
+
+(test (immutable? ()) #t)
+(test (immutable? (list 1)) #f)
+(test (immutable? (immutable! (list 1))) #t)
+(test (immutable? '__c1__) #f)
+(test (immutable? pi) #t)
+(test (immutable? 'pi) #t)
+(test (immutable? :asdf) #t)
+(test (immutable? ':asdf) #t)
+(test (immutable? 'asdf) #f)
+(test (immutable? "hi") #f)
+(test (immutable? #\a) #t)
+(test (immutable? #f) #t)
+(test (immutable? #t) #t)
+(test (immutable? ()) #t)
+(test (immutable? #()) #t)
+(test (immutable? #i()) #t)
+(test (immutable? #u()) #t)
+(test (immutable? #r()) #t)
+(test (immutable? #(1)) #f)
+(test (immutable? #i(1)) #f)
+(test (immutable? #u(1)) #f)
+(test (immutable? #r(1.0)) #f)
+(test (immutable? (hash-table)) #f)
+(test (immutable? (inlet)) #f)
+(test (immutable? (c-pointer 0)) #f)
+(test (immutable? *stdin*) #t)
+(test (immutable? *stdout*) #t)
+(test (immutable? *stderr*) #t)
+(test (immutable? (random-state 1234)) #f) ; a c-function without a setter, but perhaps this makes sense
+(test (immutable?) 'error)
+(test (immutable? 1 2) 'error)
+(test (immutable? #<eof>) #t)
+(test (immutable? 'with-let) #t)
+;(test (immutable? (format #t #u())) #f)
+(test (immutable? (format #t "")) #f)
+(test (immutable? "") #f) ; ??
+(test (immutable? '"") #f)
+(test (immutable? #<undefined>) #t)
+(test (immutable? _undef_) #t)
+(test (immutable? #<unspecified>) #t)
+(test (immutable? 123123) #t)
+(test (immutable? (bignum 123123)) #t)
+(test (immutable? 123/2) #t)
+(test (immutable? (bignum 123/2)) #t)
+(test (immutable? 123.0) #t)
+(test (immutable? (bignum 123.0)) #t)
+(test (immutable? 123.0+i) #t)
+(test (immutable? (bignum 123.0+i)) #t)
+(test (immutable? when) #t)
+(test (immutable? abs) #t)
+(test (immutable? #_abs) #t)
+(test (immutable? with-let) #t)
+(test (immutable? apply-values) #t)
+(test (immutable? quasiquote) #t)
+(test (immutable? (rootlet)) #f)
+;(test (immutable? (unlet)) #t) ; unlet as a function returns a new let that restores changed unlet values
+(test (immutable? :a (inlet 'a 1)) #t)
+(test (immutable? :a (let ((a 1)) (immutable! 'a) (curlet))) #t)
+(test (immutable? 'a #f) 'error)
+(test (immutable? :allow-other-keys (rootlet)) #t)
+
+;; Clisp:
+;;  (constantp (cons 1 2)) ->NIL
+;;  (constantp #(1 2)) -> T
+;;  (constantp '(1 . 2)) -> NIL
+;;  (constantp (vector 1)) -> T
+
+(let ((e (inlet 'a 1)))
+  (test (with-let e (immutable? 'a)) #f)
+  (test (set! (e 'a) 2) 2)
+  (test e (inlet 'a 2))
+  (with-let e (immutable! 'a))
+  (test (with-let e (immutable? 'a)) #t)
+  (test (set! (e 'a) 4) 'error)) ;error: can't let-set! a (it is immutable)
+
+(test (sort! (immutable! (string #\a #\b #\c)) char>?) 'error)
+(test (sort! (immutable! (vector #\a #\b #\c)) char>?) 'error)
+(test (sort! (immutable! #(3 2 1) <)) 'error)
+;(test (let-temporarily (((*s7* 'safety) 2)) (sort! #(2 4 1) >)) 'error) -- safety must be set at read-time, so this is #(4 2 1)
+(test (sort! (immutable! (byte-vector 0 1 2)) >) 'error)
+(test (sort! (immutable! (int-vector 0 1 2)) >) 'error)
+(test (sort! (immutable! (float-vector 0 1 2)) >) 'error)
+(test (sort! (immutable! (list 0 1 2)) >) 'error)
+(test (sort! () >) ())
+(test (sort! (vector) >) #())
+
+(test (reverse! (immutable! (string #\a #\b #\c))) 'error)
+(test (reverse! (immutable! (vector #\a #\b #\c))) 'error)
+(test (reverse! (immutable! (byte-vector 0 1 2))) 'error)
+(test (reverse! (immutable! (int-vector 0 1 2))) 'error)
+(test (reverse! (immutable! (float-vector 0 1 2))) 'error)
+(test (reverse! (immutable! (hash-table :a 1 :b 2))) 'error)
+(test (reverse! (immutable! (inlet :a 1 :b 2))) 'error)
+(test (reverse! (immutable! (list 1 2 3))) 'error)
+(test (reverse! ()) ())
+(test (reverse! (vector)) #())
+(test (let ((e (inlet 'a 1))) (immutable! :a e) (immutable? 'a e)) #t)
+(test (let ((e (inlet 'a 1))) (immutable! 'b e) (immutable? 'b e)) #f) ; #f because it is not defined in e
+(test (immutable! :a) :a)
+
+(test (set-car! (immutable! (cons 1 2)) 3) 'error)
+(test (set-cdr! (immutable! (cons 1 2)) 3) 'error)
+(test (let ((c (immutable! (list 1 2)))) (set-car! c 0)) 'error)
+(test (let ((c (cons 1 (immutable! (cons 2 ()))))) (set-car! (cdr c) 0)) 'error)
+(test (let ((c (cons 1 (immutable! (cons 2 ()))))) (set-car! c 0) c) '(0 2))
+
+(test (fill! (immutable! (string #\a #\b #\c)) #\a) 'error)
+(test (string-fill! (immutable! (string #\a #\b #\c)) #\a) 'error)
+(test (fill! (immutable! (vector #\a #\b #\c)) 1) 'error)
+(test (vector-fill! (immutable! (vector #\a #\b #\c)) 1) 'error)
+(test (fill! (immutable! (byte-vector 0 1 2)) 0) 'error)
+(test (fill! (immutable! (int-vector 0 1 2)) 1) 'error)
+(test (fill! (immutable! (float-vector 0 1 2)) 1.0) 'error)
+(test (fill! (immutable! (hash-table :a 1 :b 2)) #f) 'error)
+(test (fill! (immutable! (inlet :a 1 :b 2)) #f) #f) ; was 'error 8-Jun-20
+(test (fill! (immutable! (list 1 2 3)) 0) 'error)
+(test (let () (define (func) (immutable? (string-append (get-output-string (open-output-string))))) (func)) #f)
+(test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (immutable! 'i)))) (func)) 'error)
+
+(test (reverse! (copy (immutable! (string #\a #\b #\c)))) "cba")
+(test (immutable? (copy (immutable! (list 1 2)))) #f)
+(test (immutable? (copy (immutable! "123"))) #f)
+(test (object->string (copy (immutable! (cons 0 (immutable! (cons 1 (immutable! (cons 2 ()))))))) :readable) "(list 0 1 2)") ; copy drops the immutable bit
+(test (immutable? (copy (immutable! (cons 1 ())))) #f)
+
+(define (vars-immutable! L)
+  ;; (for-each (lambda (f) (with-let (sublet L :f f) (immutable! (car f)))) L)
+  (with-let L (for-each (lambda (f) (immutable! (car f))) (curlet)))
+  L)
+
+(test (let ((str (immutable! (string #\1 #\2)))) (string-set! str 0 #\a)) 'error)
+(test (let ((str (immutable! (string #\1 #\2)))) (set! (str 0) #\a)) 'error)
+(test (let ((bv (immutable! (byte-vector 1 2)))) (byte-vector-set! bv 0 2)) 'error)
+(test (let ((lt (vars-immutable! (inlet :a 1)))) (let-set! lt :a 2)) 'error)
+(test (let ((lt (vars-immutable! (inlet :a 1)))) (set! (lt :a) 2)) 'error)
+(test (let ((lt (vars-immutable! (inlet :a 1)))) (with-let lt (set! a 2))) 'error)
+(test (let ((lt (immutable! (hash-table :a 1)))) (hash-table-set! lt :a 2)) 'error)
+(test (let ((lt (immutable! (hash-table :a 1)))) (set! (lt :a) 2)) 'error)
+(test (let () (immutable! (curlet)) (define hi 3) hi) 'error)
+(test (let () (immutable! (curlet)) (immutable? (curlet))) #t)
+
+(let ((L (immutable! (inlet 'a 1))))
+  (test (with-let L (define b 3)) 'error)
+  (test (varlet L 'b 32) 'error)
+  (test (with-let L (set! a 12)) 12)
+  (test (let-set! L 'a 32) 32))
+
+(test (let ((p (immutable! (list 1 2)))) (list-set! p 0 2)) 'error)
+(test (let ((p (immutable! (list 1 2)))) (set! (p 0) 2)) 'error)
+(test (let ((p (immutable! (vector 1 2)))) (vector-set! p 0 2)) 'error)
+(test (let ((p (immutable! (vector 1 2)))) (set! (p 0) 2)) 'error)
+(test (let ((p (immutable! (int-vector 1 2)))) (int-vector-set! p 0 2)) 'error)
+(test (let ((p (immutable! (int-vector 1 2)))) (set! (p 0) 2)) 'error)
+(test (let ((p (immutable! (float-vector 1 2)))) (float-vector-set! p 0 2)) 'error)
+(test (let ((p (immutable! (float-vector 1 2)))) (set! (p 0) 2)) 'error)
+(test (let ((ht (immutable! (hash-table 'a 1)))) (hash-table-set! ht 'a #f)) 'error)
+(test (let ((lt (immutable! (inlet 'a 1)))) (varlet lt 'b 2)) 'error)
+(test (let ((lt (immutable! (inlet 'a 1 'b 2)))) (cutlet lt 'b)) 'error)
+
+(let ((src (vector 0 0)))
+  (test (let ((p1 (immutable! (list 1 2)))) (copy src p1)) 'error)
+  (test (let ((p1 (immutable! (string #\a #\b)))) (copy src p1)) 'error)
+  (test (let ((p1 (immutable! (byte-vector 1 2)))) (copy src p1)) 'error)
+  (test (let ((p1 (immutable! (vector 1 2)))) (copy src p1)) 'error)
+  (test (let ((p1 (immutable! (int-vector 1 2)))) (copy src p1)) 'error)
+  (test (let ((p1 (immutable! (float-vector 1 2)))) (copy src p1)) 'error)
+  (test (let ((p1 (immutable! (hash-table 'a 1)))) (copy src p1)) 'error)
+  (test (let ((p1 (immutable! (inlet 'a 1)))) (copy src p1)) 'error))
+(test (copy (inlet 'a 1) (immutable! (inlet 'b 2))) 'error)
+(test (copy (inlet 'a 1) (immutable! (vector 0 0))) 'error)
+(test (copy (hash-table 'a 1) (immutable! (vector 0 0))) 'error)
+
+(test (let ((lt (vars-immutable! (inlet 'a 1)))) (let-set! lt 'a 2)) 'error)
+(test (let ((lt (vars-immutable! (inlet 'a 1)))) (set! (lt 'a) 2)) 'error)
+(test (let ((lt (immutable! (inlet 'a 1)))) (let-set! lt 'b 2)) 'error)
+(test (let ((lt (immutable! (inlet 'a 1)))) (set! (lt 'b) 2)) 'error)
+
+(test (let ((lt (immutable! (inlet 'a 1)))) (with-let lt (define b 2))) 'error)
+(test (let ((lt (immutable! (inlet 'a 1)))) (with-let lt (define* (b x) (+ x 2)))) 'error)
+(test (let ((lt (immutable! (inlet 'a 1)))) (with-let lt (apply define '(b 2)))) 'error)
+(test (let ((a 1)) (immutable! (curlet)) (define b 2)) 'error)
+(test (let ((lt (immutable! (inlet 'a 1)))) (with-let lt (define-macro (b x) `(+ ,x 2)))) 'error)
+(test (let ((lt (immutable! (inlet 'a 1)))) (with-let lt (provide 'hiho))) 'error)
+(test (let ((a 1)) (immutable! (curlet)) (provide 'hiho)) 'error)
+
+(test (let () (let ((x 0)) (immutable! 'x)) (let ((x 0)) x)) 0)
+(test (let () (let ((x 0)) (set! x 3) x)) 3)
+(test (let () (let ((x 3)) (immutable! 'x) (set! x 31))) 'error)
+(test (let ((a (openlet (immutable! (inlet 'asdf 1))))) (a 'asdf)) 1)
+
+(let ((caught 0)) (immutable! 'caught) ; op_set_s_constant|symbol|expression
+  (define (func) (catch #t (lambda () (set! caught 1)) (lambda (type info) 'error)))
+  (test (func) 'error)
+  (test (func) 'error))
+(let ((one 1) (caught 0)) (immutable! 'caught)
+  (define (func) (catch #t (lambda () (set! caught one)) (lambda (type info) 'error)))
+  (test (func) 'error)
+  (test (func) 'error))
+(let ((caught 0)) (immutable! 'caught)
+  (define (func)(catch #t (lambda () (set! caught (abs 1))) (lambda (type info) 'error)))
+  (test (func) 'error)
+  (test (func) 'error))
+
+(let ((caught 1)) (immutable! 'caught) ; op_set_s_constant|symbol|expression
+  (define (func) (catch #t (lambda () (set! caught 1)) (lambda (type info) 'error)))
+  (test (func) 1)
+  (test (func) 1))
+(let ((one 1) (caught 1)) (immutable! 'caught)
+  (define (func) (catch #t (lambda () (set! caught one)) (lambda (type info) 'error)))
+  (test (func) 1)
+  (test (func) 1))
+(let ((caught 1)) (immutable! 'caught)
+  (define (func)(catch #t (lambda () (set! caught (abs 1))) (lambda (type info) 'error)))
+  (test (func) 1)
+  (test (func) 1))
+
+(let ()
+  (define-macro (im-test expr result)
+    `(let ((res (catch #t (lambda () ,expr) (lambda (type info) type))))
+       (unless (equal? res ,result)
+	 (format *stderr* "~S: got ~S, but expected ~S~%" ',expr res ',result))))
+
+  (define L1 (inlet 'a1 (list 1)))
+  (define L2 (inlet 'a2 (list 2)))
+  (define L3 (inlet 'a3 (list 3)))
+  (define L4 (let ((a4 (list 4))) (immutable! 'a4) (curlet)))
+  (define L5 (inlet 'a5 (list 5)))
+
+  (for-each (lambda (f) (with-let (sublet L1 :f f) (immutable! (car f)))) L1)
+  (with-let L2 (for-each (lambda (f) (immutable! (car f))) (curlet)))
+  (with-let L3 (immutable! 'a3))
+  (immutable! (L5 'a5)) ; this is the value
+
+  (im-test (let ((a1 32)) a1) 32)
+  (im-test (let ((a2 32)) a2) 32)
+  (im-test (let ((a3 32)) a3) 32)
+  (im-test (let ((a4 32)) a4) 32)
+  (im-test (let ((a5 32)) a5) 32)
+
+  (im-test (immutable? 'a1) #f)
+  (im-test (immutable? 'a2) #f)
+  (im-test (immutable? 'a3) #f)
+  (im-test (immutable? 'a4) #f)
+  (im-test (immutable? 'a5) #f)
+
+  (im-test (immutable? L1) #f)
+  (im-test (immutable? L2) #f)
+  (im-test (immutable? L3) #f)
+  (im-test (immutable? L4) #f)
+  (im-test (immutable? L5) #f)
+
+  (im-test (immutable? (L1 'a1)) #f) ; this is the value
+;  (im-test (with-let L1 (immutable? 'a1)) #t)
+  (im-test (let ((a8 (list 8))) (immutable! a8) (immutable? a8)) #t)
+
+  (im-test (with-let L1 (set! a1 32)) 'immutable-error)
+  (im-test (with-let L2 (set! a2 32)) 'immutable-error)
+  (im-test (with-let L3 (set! a3 32)) 'immutable-error)
+  (im-test (with-let L4 (set! a4 32)) 'immutable-error)
+  (im-test (with-let L5 (set! a5 32)) 32)
+
+  (im-test (let-set! L1 'a1 32) 'immutable-error)
+  (im-test (let-set! L2 'a2 32) 'immutable-error)
+  (im-test (let-set! L3 'a3 32) 'immutable-error)
+  (im-test (let-set! L4 'a4 32) 'immutable-error)
+  (im-test (let-set! L5 'a5 32) 32)
+
+  (im-test (set! (L1 'a1) 32) 'immutable-error)
+  (im-test (set! (L2 'a2) 32) 'immutable-error)
+  (im-test (set! (L3 'a3) 32) 'immutable-error)
+  (im-test (set! (L4 'a4) 32) 'immutable-error)
+  (im-test (set! (L5 'a5) 32) 32)
+
+  (im-test (fill! L1 #f) 'immutable-error)
+  (im-test (fill! L2 #f) 'immutable-error)
+  (im-test (fill! L3 #f) 'immutable-error)
+  (im-test (fill! L4 #f) 'immutable-error)
+  (im-test (fill! L5 #f) #f)
+
+  (im-test (with-let L1 (define a7 7)) 7)
+  (im-test L1 (inlet 'a1 (list 1) 'a7 7))
+
+  (define L8 (copy L1))
+  (im-test (immutable? L8) #f)
+  (im-test (with-let L8 (set! a1 12)) 12) ; new slot not immutable
+
+  (define L6 (immutable! (inlet 'a6 (list 6))))
+  (im-test (immutable? L6) #t)
+  (im-test (immutable? (L6 'a6)) #f)
+  (im-test (with-let L6 (set! a6 32)) 32)
+  (im-test (let-set! L6 'a6 321) 321)
+  (im-test (set! (L6 'a6) 123) 123)
+  (im-test (with-let L6 (define a7 7)) 'immutable-error)
+  (im-test (varlet L6 'a7 7) 'immutable-error)
+  (im-test (cutlet L6 'a6) 'immutable-error)
+  (im-test (fill! L6 123) 123)
+  (im-test (L6 'a6) 123)
+  (im-test (fill! L6 #<undefined>) #<undefined>)
+  (im-test (set! L6 32) 32)
+
+  (define L61 (immutable! (inlet 'a6 (list 6))))
+  (im-test (immutable? L61) #t)
+  (define L9 (copy L61))
+  (im-test (immutable? L9) #f)                        ; new let not immutable
+  (im-test (with-let L9 (set! a6 12)) 12))
+
+(let ((f2 (let ((+documentation+ "hiho")
+	       (+signature+ (list integer? integer?))
+	       (+setter+ (lambda (val) val)))
+	   (lambda (x)
+	     (+ x 1)))))
+  (set! ((funclet 'f2) '+documentation+) "new docs")
+  (set! ((funclet 'f2) '+signature+) (list #t #t))
+  (set! ((funclet 'f2) '+setter+) (lambda (val) (+ val 1)))
+  (with-let (funclet 'f2) (immutable! '+setter+))
+  (with-let (funclet 'f2) (immutable! '+documentation+))
+  (with-let (funclet 'f2) (immutable! '+signature+))
+  (test (set! ((funclet 'f2) '+documentation+) "newer docs") 'error)
+  (test (set! ((funclet 'f2) '+signature+) (list #f #f)) 'error)
+  (test (set! ((funclet 'f2) '+setter+) (lambda (val) (+ val 2))) 'error))
+(test (let ((+setter+ abs)) (set! +setter+ #f)) #f)
+
+(test (let () (define (fstr) "fstr result") (let ((str (fstr))) (string-set! str 1 #\!) (fstr))) "f!tr result")
+(test (let () (define (fstr) (immutable! "fstr result")) (let ((str (fstr))) (string-set! str 1 #\!) (fstr))) 'error)
+(when (zero? (*s7* 'debug))
+  (test (let () (define (fstr) "fstr result") (object->string fstr :readable))              "(lambda () \"fstr result\")")
+  (test (let () (define (fstr) (immutable! "fstr result")) (object->string fstr :readable)) "(lambda () (immutable! \"fstr result\"))"))
+(test (let ((str (immutable! "1234"))) (object->string str :readable))                "(immutable! \"1234\")")
+(test (let ((seq (immutable! (list 1 2 3)))) (object->string seq :readable))          "(immutable! (cons 1 (cons 2 (cons 3 ()))))")
+(test (let ((seq (immutable! (vector 1 2 3)))) (object->string seq :readable))        "(immutable! (vector 1 2 3))")
+(test (let ((seq (immutable! (int-vector 1 2 3)))) (object->string seq :readable))    "(immutable! #i(1 2 3))")
+(test (let ((seq (immutable! (float-vector 1 2 3)))) (object->string seq :readable))  "(immutable! #r(1.0 2.0 3.0))")
+(test (let ((seq (immutable! (inlet :a 1)))) (object->string seq :readable))          "(immutable! (inlet :a 1))")
+(test (let ((seq (immutable! (hash-table :a 1)))) (object->string seq :readable))     "(immutable! (hash-table :a 1))")
+(test (let ((seq (immutable! (byte-vector 1 2 3)))) (object->string seq :readable))   "(immutable! #u(1 2 3))")
+(test (let ((seq (immutable! (cons 1 2)))) (object->string seq :readable))            "(immutable! (cons 1 2))")
+(test (let ((seq (immutable! '(1 2)))) (object->string seq :readable))                "(immutable! (cons 1 (cons 2 ())))")
+(test (let ((seq (immutable! (list 1)))) (object->string (list seq 2) :readable))     "(list (immutable! (cons 1 ())) 2)")
+(test (let ((str (immutable! 1234))) (object->string str :readable))                  "1234")
+(test (let ((str (immutable! #\a))) (object->string str :readable))                   "#\\a")
+(test (object->string (immutable! (cons 1 (immutable! (cons 2 ())))) :readable)       "(immutable! (cons 1 (immutable! (cons 2 ()))))")
+(test (object->string (cons 1 (immutable! (list 2))) :readable)                       "(cons 1 (immutable! (cons 2 ())))")
+(test (object->string (list 1 (immutable! (list 2))) :readable)                       "(list 1 (immutable! (cons 2 ())))")
+(test (object->string (immutable! '(1 2 . 3)) :readable)                              "(immutable! (cons 1 (cons 2 3)))")
+(test (object->string (cons 0 (immutable! (cons 1 (immutable! (cons 2 3))))) :readable)
+      "(cons 0 (immutable! (cons 1 (immutable! (cons 2 3)))))")
+(test (object->string (list (list (immutable! (cons 1 2)))) :readable)                "(list (list (immutable! (cons 1 2))))")
+
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (string-set! str 0 #\a)) str) (f (immutable! "1234"))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (string-set! str 0 #\a)) str) (f (immutable! (vector 1 2 3)))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set! (str 0) #\a)) str) (f (immutable! "1234"))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (do ((j 0 (+ j 1))) ((= j 2)) (string-set! str 0 #\a))) str) (f (immutable! "1234"))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (let-set! str :a 2)) str) (f (vars-immutable! (inlet :a 1)))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set! (str :a) 2)) str) (f (vars-immutable! (inlet :a 1)))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (hash-table-set! str 'a 1)) str) (f (immutable! (hash-table 'a 1)))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set! (str 'a) 1)) str) (f (immutable! (hash-table 'a 1)))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (list-set! str 1 2)) str) (f (immutable! (list 0 1 2)))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set! (str 1) 2)) str) (f (immutable! (list 0 1 2)))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set-car! str 1)) str) (f (immutable! (list 0 1 2)))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set-cdr! str 1)) str) (f (immutable! (list 0 1 2)))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (vector-set! str 1 2)) str) (f (immutable! (vector 0 1 2)))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set! (str 1) 2)) str) (f (immutable! (vector 0 1 2)))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (byte-vector-set! str 1 2)) str) (f (immutable! (byte-vector 0 1 2)))) 'error)
+(test (let ((lt (immutable! (inlet 'a 1)))) (set! (outlet lt) (curlet))) 'error)
+(test (let ((c (immutable! (cons 1 (immutable! (cons 2 ())))))) (set-car! (cdr c) 3)) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (float-vector-set! str 1 2)) str) (f (immutable! (float-vector 0 1 2)))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (int-vector-set! str 1 2)) str) (f (immutable! (int-vector 0 1 2)))) 'error)
+
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (string-set! (car str) 0 #\a)) str) (f (list (immutable! "1234")))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set! ((car str) 0) #\a)) str) (f (list (immutable! "1234")))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (do ((j 0 (+ j 1))) ((= j 2)) (string-set! (car str) 0 #\a))) str) (f (list (immutable! "1234")))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (let-set! (car str) :a 2)) str) (f (list (vars-immutable! (inlet :a 1))))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set! ((car str) :a) 2)) str) (f (list (vars-immutable! (inlet :a 1))))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (hash-table-set! (car str) 'a 1)) str) (f (list (immutable! (hash-table 'a 1))))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set! ((car str) 'a) 1)) str) (f (list (immutable! (hash-table 'a 1))))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (list-set! (car str) 1 2)) str) (f (list (immutable! (list 0 1 2))))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set! ((car str) 1) 2)) str) (f (list (immutable! (list 0 1 2))))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set-car! (car str) 1)) str) (f (list (immutable! (list 0 1 2))))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set-cdr! (car str) 1)) str) (f (list (immutable! (list 0 1 2))))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (vector-set! (car str) 1 2)) str) (f (list (immutable! (vector 0 1 2))))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set! ((car str) 1) 2)) str) (f (list (immutable! (vector 0 1 2))))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (float-vector-set! (car str) 1 2)) str) (f (list (immutable! (float-vector 0 1 2))))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (int-vector-set! (car str) 1 2)) str) (f (list (immutable! (int-vector 0 1 2))))) 'error)
+(test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (byte-vector-set! (car str) 1 2)) str) (f (list (immutable! (byte-vector 0 1 2))))) 'error)
+(test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (get-output-string (immutable? (abs x)))))) (func)) 'error)
+
+(test (immutable? (subvector (immutable! (vector 1 2 3 4)) 0 1)) #t)
+(let ((lst (subvector (immutable! (vector 1 2 3 4)) 0 1)))
+  (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (vector-set! lst 1 32)) (lambda args 'error))) (define (h) (f)) (h))))
+    (format *stderr* "vector-set! immutable ~S~%" lst))
+  (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (fill! lst 32)) (lambda args 'error))) (define (h) (f)) (h))))
+    (format *stderr* "fill! immutable ~S~%" lst))
+  ;; (reverse! #(1)) is no longer an error 9-Oct-23
+  (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (set! (lst 1) 32)) (lambda args 'error))) (define (h) (f)) (h))))
+    (format *stderr* "set! immutable ~S~%" lst))
+  (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (sort! lst >)) (lambda args 'error))) (define (h) (f)) (h))))
+    (format *stderr* "sort! immutable ~S~%" lst)))
+
+#|
+;; can't decide about this
+(let ((lst (cons 1 (immutable! (cons 2 (immutable! (cons 3 ())))))))
+  (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (list-set! lst 1 32)) (lambda args 'error))) (define (h) (f)) (h))))
+    (format *stderr* "list-set! ~S~%" lst))
+  (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (fill! lst 32)) (lambda args 'error))) (define (h) (f)) (h))))
+    (format *stderr* "fill! ~S~%" lst))
+  (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (reverse! lst)) (lambda args 'error))) (define (h) (f)) (h))))
+    (format *stderr* "reverse! ~S~%" lst))  ; ok
+  (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (set! (lst 1) 32)) (lambda args 'error))) (define (h) (f)) (h))))
+    (format *stderr* "set! ~S~%" lst))
+  (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (sort! lst >)) (lambda args 'error))) (define (h) (f)) (h))))
+    (format *stderr* "sort! ~S~%" lst))
+  (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (set-car! (cdr lst) 32)) (lambda args 'error))) (define (h) (f)) (h))))
+    (format *stderr* "set-car! ~S~%" lst))  ; ok
+  (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (set-cdr! (cdr lst) 32)) (lambda args 'error))) (define (h) (f)) (h))))
+    (format *stderr* "set-cdr! ~S~%" lst))) ; ok
+|#
+
+(let-temporarily (((*s7* 'safety) 2))
+  (test (immutable? (eval (with-input-from-string "'(1 2)" read))) #t))
+
+(define old-safety (*s7* 'safety))
+(set! (*s7* 'safety) 2)
+(let ()
+  (define* (bpar1 (lst #(0 1 2 3))) ; safety needs to be set before this is read
+    (set! (lst 2) (* 2 (lst 2)))
+    lst)
+  (test (bpar1) 'error))
+(set! (*s7* 'safety) old-safety)
+
+(test (catch #t
+	(lambda ()
+	  (catch #t 1
+		 (lambda (type info)
+		   (set-cdr! (cdr info) info))))
+	(lambda args 'error))
+      'error)
+
+(test (catch #t
+	(lambda ()
+	  (catch #t 1
+		 (lambda (type info)
+		   (reverse! info))))
+	(lambda args 'error))
+      'error)
+
+(test (let ((lst (immutable! (cons 1 2))))
+	(define (f) (set! (cdr lst) 3))
+	(define (h) (f)) (h))
+      'error)
+#|
+;;; it's possible to clobber the built-in error cases:
+(let ()
+  (copy (catch #t 1 (lambda (type info) info)) (catch #t 1 cons))
+  (catch #t 1 (lambda (type info) (apply format #f info))))
+|#
+
+;;; does this make sense?:
+(test (let ((x 1)) (immutable! 'x) (let ((x x)) (set! x 2))) 2)
+(test (let () (define-constant x 1) (let ((x x)) (set! x 2))) 'error)
+
+(let ()
+
+  (define (f0 b) (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 10) b) (set! (b i) x)))
+  (define (f1 b) (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 10) b) (float-vector-set! b i x)))
+
+  (test (let ((b1 (make-float-vector 10)))
+	  (f0 b1)
+	  (immutable! b1)
+	  (f0 b1)
+	  (display b1) (newline))
+	'error)
+
+  (test (let ((b1 (make-float-vector 10)))
+	  (f1 b1)
+	  (immutable! b1)
+	  (f1 b1)
+	  (display b1) (newline))
+	'error)
+
+  (define (f2 b) (do ((i 0 (+ i 1))) ((= i 10) b) (set! (b i) 1)))
+  (define (f3 b) (do ((i 0 (+ i 1))) ((= i 10) b) (int-vector-set! b i 1)))
+
+  (test (let ((b1 (make-int-vector 10)))
+	  (f2 b1)
+	  (immutable! b1)
+	  (f2 b1)
+	  (display b1) (newline))
+	'error)
+
+  (test (let ((b1 (make-int-vector 10)))
+	  (f3 b1)
+	  (immutable! b1)
+	  (f3 b1)
+	  (display b1) (newline))
+	'error)
+
+  (define (f4 b) (do ((i 0 (+ i 1))) ((= i 10) b) (set! (b i) 20)))
+  (define (f5 b) (do ((i 0 (+ i 1))) ((= i 10) b) (byte-vector-set! b i 20)))
+
+  (test (let ((b1 (make-byte-vector 10)))
+	  (f4 b1)
+	  (immutable! b1)
+	  (f4 b1)
+	  (display b1) (newline))
+	'error)
+
+  (test (let ((b1 (make-byte-vector 10)))
+	  (f5 b1)
+	  (immutable! b1)
+	  (f5 b1)
+	  (display b1) (newline))
+	'error)
+
+  (when with-block
+    (define (f) ; opt_cell_set -> opt_d_7pid_sff
+      (let ((iv (make-block 10)))
+        (do ((i 0 (+ i 1)))
+	    ((= i 10) iv)
+          (set! (iv (- (+ i 1) 1)) (* 3.0 2.0)))))
+    (test (f) (block 6 6 6 6 6 6 6 6 6 6))
+
+    (define (g) ; d_7pid_ok -> opt_d_7pid_sff
+      (let ((iv (make-block 10)))
+        (do ((i 0 (+ i 1)))
+	    ((= i 10) iv)
+          (block-set! iv (- (+ i 1) 1) (* 3.0 2.0)))))
+    (test (g) (block 6 6 6 6 6 6 6 6 6 6))
+
+    (test (let ((b (block 1))) (define (f) (+ 1 (block-set! b 0 (logand)))) (f)) 0) ; block-set! sig bug float? -> real?
+
+    (define (f6 b) (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 10) b) (set! (b i) x)))
+    (define (f7 b) (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 10) b) (block-set! b i x)))
+
+    (test (let ((b1 (make-block 10)))
+	    (f6 b1)
+	    (immutable! b1)
+	    (f6 b1)
+	    (display b1) (newline))
+	  'error)
+    (test  (let ((b1 (make-block 10)))
+	    (f7 b1)
+	    (immutable! b1)
+	    (f7 b1)
+	    (display b1) (newline))
+	  'error))
+
+  (define (f8 b) (do ((i 0 (+ i 1))) ((= i 10) b) (set! (b i) #\a)))
+  (define (f9 b) (do ((i 0 (+ i 1))) ((= i 10) b) (string-set! b i #\a)))
+
+  (test (let ((b1 (make-string 10)))
+	  (f8 b1)
+	  (immutable! b1)
+	  (f8 b1)
+	  (display b1) (newline))
+	'error)
+
+  (test (let ((b1 (make-string 10)))
+	  (f9 b1)
+	  (immutable! b1)
+	  (f9 b1)
+	  (display b1) (newline))
+	'error)
+
+  (define (f10 b) (do ((i 0 (+ i 1))) ((= i 10) b) (set! (b i) #\a)))
+  (define (f11 b) (do ((i 0 (+ i 1))) ((= i 10) b) (vector-set! b i #\a)))
+
+  (test (let ((b1 (make-vector 10)))
+	  (f10 b1)
+	  (immutable! b1)
+	  (f10 b1)
+	  (display b1) (newline))
+	'error)
+
+  (test (let ((b1 (make-vector 10)))
+	  (f11 b1)
+	  (immutable! b1)
+	  (f11 b1)
+	  (display b1) (newline))
+	'error)
+
+  (define (f12 b) (do ((i 0 (+ i 1))) ((= i 10) b) (set! (b i) 1)))
+  (define (f13 b) (do ((i 0 (+ i 1))) ((= i 10) b) (list-set! b i 1)))
+
+  (test (let ((b1 (make-list 10)))
+	  (f12 b1)
+	  (immutable! b1)
+	  (f12 b1)
+	  (display b1) (newline))
+	'error)
+
+  (test (let ((b1 (make-list 10)))
+	  (f13 b1)
+	  (immutable! b1)
+	  (f13 b1)
+	  (display b1) (newline))
+	'error)
+
+  (define (f14 b) (do ((i 0 (+ i 1))) ((= i 10) b) (set! (b i) 1)))
+  (define (f15 b) (do ((i 0 (+ i 1))) ((= i 10) b) (hash-table-set! b i 1)))
+
+  (test (let ((b1 (make-hash-table)))
+	  (f14 b1)
+	  (immutable! b1)
+	  (f14 b1)
+	  (display b1) (newline))
+	'error)
+
+  (test (let ((b1 (make-hash-table)))
+	  (f15 b1)
+	  (immutable! b1)
+	  (f15 b1)
+	  (display b1) (newline))
+	'error)
+
+  (define (f16 b) (do ((i 0 (+ i 1))) ((= i 10) b) (set! (b 'a) i)))
+  (define (f17 b) (do ((i 0 (+ i 1))) ((= i 10) b) (let-set! b 'a i)))
+
+  (test (let ((b1 (inlet 'a 0)))
+	  (f16 b1)
+	  (vars-immutable! b1)
+	  (f16 b1)
+	  (display b1) (newline))
+	'error)
+
+  (test (let ((b1 (inlet 'a 0)))
+	  (f17 b1)
+	  (vars-immutable! b1)
+	  (f17 b1)
+	  (display b1) (newline))
+	'error))
+
+(let ()
+  ;; these are similar but involve saved-optlist incompatible length changes (and non-constant set value to avoid optimization to fill!)
+  (define (f0 b) (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 100) b) (set! (b i) x)))
+  (define (f1 b) (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 100) b) (float-vector-set! b i x)))
+
+  (test (let ((b1 (make-float-vector 100)))
+	  (f0 b1)
+	  (set! b1 (make-float-vector 10))
+	  (f0 b1)
+	  (display b1) (newline))
+	'error)
+
+  (test (let ((b1 (make-float-vector 100)))
+	  (f1 b1)
+	  (set! b1 (make-float-vector 10))
+	  (f1 b1)
+	  (display b1) (newline))
+	'error)
+
+  (define (f2 b) (do ((i 0 (+ i 1))) ((= i 100) b) (set! (b i) i)))
+  (define (f3 b) (do ((i 0 (+ i 1))) ((= i 100) b) (int-vector-set! b i i)))
+
+  (test (let ((b1 (make-int-vector 100)))
+	  (f2 b1)
+	  (set! b1 (make-int-vector 10))
+	  (f2 b1)
+	  (display b1) (newline))
+	'error)
+
+  (test (let ((b1 (make-int-vector 100)))
+	  (f3 b1)
+	  (set! b1 (make-int-vector 10))
+	  (f3 b1)
+	  (display b1) (newline))
+	'error)
+
+  (define (f4 b) (do ((i 0 (+ i 1))) ((= i 100) b) (set! (b i) (logand i 255))))
+  (define (f5 b) (do ((i 0 (+ i 1))) ((= i 100) b) (byte-vector-set! b i (logand i 255))))
+
+  (test (let ((b1 (make-byte-vector 100)))
+	  (f4 b1)
+	  (set! b1 (make-byte-vector 10))
+	  (f4 b1)
+	  (display b1) (newline))
+	'error)
+
+  (test (let ((b1 (make-byte-vector 100)))
+	  (f5 b1)
+	  (set! b1 (make-byte-vector 10))
+	  (f5 b1)
+	  (display b1) (newline))
+	'error)
+
+  (define (f6 b) (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 100) b) (set! (b i) x)))
+  (define (f7 b) (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 100) b) (block-set! b i x)))
+
+  (test (let ((b1 (make-block 100)))
+	  (f6 b1)
+	  (set! b1 (make-block 10))
+	  (f6 b1)
+	  (display b1) (newline))
+	'error)
+
+  (test (let ((b1 (make-block 100)))
+	  (f7 b1)
+	  (set! b1 (make-block 10))
+	  (f7 b1)
+	  (display b1) (newline))
+	'error)
+
+  (define (f8 b) (do ((i 0 (+ i 1))) ((= i 100) b) (set! (b i) (integer->char 65))))
+  (define (f9 b) (do ((i 0 (+ i 1))) ((= i 100) b) (string-set! b i (integer->char 65))))
+
+  (test (let ((b1 (make-string 100)))
+	  (f8 b1)
+	  (set! b1 (make-string 10))
+	  (f8 b1)
+	  (display b1) (newline))
+	'error)
+
+  (test (let ((b1 (make-string 100)))
+	  (f9 b1)
+	  (set! b1 (make-string 10))
+	  (f9 b1)
+	  (display b1) (newline))
+	'error)
+
+  (define (f10 b) (do ((i 0 (+ i 1))) ((= i 100) b) (set! (b i) i)))
+  (define (f11 b) (do ((i 0 (+ i 1))) ((= i 100) b) (vector-set! b i i)))
+
+  (test (let ((b1 (make-vector 100)))
+	  (f10 b1)
+	  (set! b1 (make-vector 10))
+	  (f10 b1)
+	  (display b1) (newline))
+	'error)
+
+  (test (let ((b1 (make-vector 100)))
+	  (f11 b1)
+	  (set! b1 (make-vector 10))
+	  (f11 b1)
+	  (display b1) (newline))
+	'error)
+
+  (define (f12 b) (do ((i 0 (+ i 1))) ((= i 100) b) (set! (b i) i)))
+  (define (f13 b) (do ((i 0 (+ i 1))) ((= i 100) b) (list-set! b i i)))
+
+  (test (let ((b1 (make-list 100)))
+	  (f12 b1)
+	  (set! b1 (make-list 10))
+	  (f12 b1)
+	  (display b1) (newline))
+	'error)
+
+  (test (let ((b1 (make-list 100)))
+	  (f13 b1)
+	  (set! b1 (make-list 10))
+	  (f13 b1)
+	  (display b1) (newline))
+	'error))
+
+(test (let () (define-constant bigcmp 1+2i) (define (func) (let ((_x_ 1)) (do ((i 0 (+ i _x_))) ((= i _x_)) (set! bigcmp (bignum 0+i))))) (func)) 'error) ; op_dox 81337
+(test (let ((lim 1)) (define-constant x 1) (define (f) (let ((y 1)) (do ((i 0 (+ i y))) ((= i lim)) (set! x 3)))) (f)) 'error)
+(test (let ((lim 1)) (define (f) (let ((y 1)) (do ((i 0 (+ i y))) ((= i lim)) (set! xxx 3)))) (f)) 'error) ; unbound variable op_dox 81345
+(test (let () (define (f) (do ((x 0 (+ x 1)) (i 0 (+ i 1))) ((= i 1) y))) (f)) 'error) ; op_dox 81181
+(test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (immutable! 'x) (set! x 32))) (func)) 'error) ; op_set1 79220
+(test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (immutable! 'x)))) (func)) 'error) ; op_set1 79220
+(test (let ((x 0)) (immutable! 'x) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x i))) (func)) 0) ; 79220 was error 2-Nov-23
+(test (let ((x 0)) (define (func) (do ((i 0 (+ i 1))) ((= i 2) x) (set! x i) (immutable! 'x))) (func)) 'error) ; op_set_s_s 78767
+(test (let ((x 0)) (define (func) (do ((j 0 (+ j 1))) ((= j 1) x) (do ((i 0 (+ i 1))) ((= i 2)) (set! x i) (immutable! 'x)))) (func)) 'error) ; op_set_s_s 78767
+(test (let ((x 0)) (define (func) (do ((j 0 (+ j 1))) ((= j 1) x) (do ((i 0 (+ i 1))) ((= i 2)) (set! x (immutable! 'x))))) (func)) 'error) ; op_set1 79220
+(test (let ((x #f) (i 0)) (let-temporarily ((x (list (define xx (immutable! 'x)) (byte-vector)))) x)) 'error) ; op_set_from_let_temp 78803
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; defined?
+
+(test (defined? 'pi) #t)
+(test (defined? 'pi (rootlet)) #t)
+(test (defined? 'abs (rootlet)) #t)
+(test (defined? 'abs (rootlet) #f) #t)
+(test (defined? 'abs (rootlet) #t) #f) ;! #t=ignore rootlet
+(test (defined? 'abs (curlet)) #t)
+(test (defined? 'abs (curlet) #f) #t)
+(test (defined? 'abs (curlet) #t) #f)
+(test (let ((__c2__ 32)) (defined? '__c2__)) #t)
+(test (let ((__c2__ 32)) (defined? '__c2__ (curlet))) #t)
+(test (let ((__c2__ 32)) (defined? '__c3__ (curlet))) #f)
+(test (let ((__c2__ 32)) (defined? '__c2__ (rootlet))) #f)
+(test (let ((__c2__ 32)) (defined? '__c3__ (rootlet))) #f)
+(test (let ((ge (rootlet))) (ge 'abs)) abs)
+(test (let ((ge (rootlet))) (ge 'rootlet)) rootlet)
+(test (let ((ge (rootlet))) (ge 'define)) define)
+(test (let ((ge (rootlet))) (ge 'if)) if)
+(test (let ((ge (rootlet))) (let ((abc 1)) (ge 'abc))) #<undefined>)
+(test (defined?) 'error)
+(test (defined? 'a 'b) 'error)
+(test (defined? 'abs (curlet)) #t)
+(test (defined? 'abs (curlet) #()) 'error)
+(test (defined? 'abs 0) 'error)
+(test (defined? 'undef_x (dilambda (lambda () 1) (lambda (a) a)) #t) #f)
+(test (let () (defined? 'abs (curlet) #())) 'error)
+(for-each
+ (lambda (arg)
+   (test (defined? arg) 'error)
+   (test (defined? 'abs arg) 'error))
+ (list -1 #\a 1 _ht_ _undef_ #(1 2 3) 3.14 3/4 1.0+1.0i () #f #(()) (list 1 2 3) '(1 . 2) "hi"))
+(test (defined? 'lambda car) #t)
+(test (defined? lambda gensym) 'error)
+(test (defined? 'lambda defined?) #t)
+(test (defined? 'define car) #t)
+(test (defined? 'abs (sublet ())) #t) ; nil = global now
+(test (defined? lambda) 'error)
+(test (defined? 'lambda) #t)
+(test (defined? 'dynamic-wind) #t)
+(test (defined? 'asdaf) #f)
+(test (defined? ':asdaf) #t) ; keywords are defined in the sense that they evaluate to themselves
+(test (defined? :asdaf) #t)
+(test (defined? 'ok?) #t)
+(test (defined? 'test-t) #t)
+(test (defined? 'quasiquote) #t)
+(test (defined? (symbol "123")) #f)
+(test (defined? (symbol "+")) #t)
+(test (defined? ''+) 'error)
+(test (defined? 'if) #t)
+(test (defined? if) 'error)
+(test (defined? quote) 'error)
+(test (let () (defined? 'abs (curlet) #t)) #f)
+(test (let () (defined? 'abs (curlet))) #t)
+(test (let () (defined? 'abs (curlet) #f)) #t)
+(test (let () (define (func) (defined? _!asdf!_ (rootlet))) (func)) 'error)
+(test (let () (define (func) (defined? '_!asdf!_ (rootlet))) (func)) #f)
+(test (let ((v1 #())) (define (func) (defined? v1 (rootlet))) (func)) 'error)
+
+(test (let ((b 2))
+	(let ((e (curlet)))
+	  (let ((a 1))
+	    (if (defined? 'a e)
+		(format #f "a: ~A in ~{~A ~}" (symbol->value 'a e) e)))))
+      #<unspecified>) ; not "a: 1 in (b . 2)")
+
+(test (let ((b 2))
+	(let ((e (curlet)))
+	  (let ((a 1))
+	    (format #f "~A: ~A" (defined? 'abs e) (eval '(abs -1) e)))))
+      "#t: 1")
+
+(test (defined? '#<undefined>) 'error) ; arg should be a symbol...
+(test (defined? :ho (rootlet)) #t)     ; changed 21-Nov-23
+(test (let ((xx :ho)) (defined? xx (rootlet))) #t)
+(test (defined? 'abs (rootlet)) #t)
+(test (let () (define (func) (defined? 'else (rootlet))) (func)) #t)
+(test (let ((hih 3)) (define (func) (defined? 'hih (rootlet))) (func)) #f)
+(test (let ((hi 'abs)) (define (func) (defined? hi (rootlet))) (func)) #t)
+(test (let ((hi 'asdf)) (define (func) (defined? hi (rootlet))) (func)) #f)
+(test (let () (define (func) (defined? :ho (rootlet))) (func)) #t) ; changed 21-Nov-23
+(test (let () (define (func) (defined? ... (rootlet))) (func)) 'error)
+
+(test (let () (do () ((not #f) (defined? :hi8)))) #t)
+(test (let ((xx8 :hi8)) (define (func) (do () ((not #f) (defined? xx8)))) (func)) #t)
+(test (let () (define (func) (do () ((not #f) (defined? :hi8)))) (func)) #t)
+(test (defined? :hi8) #t)
+(test (let ((xx8 :hi8)) (define (func) (defined? xx8)) (func)) #t)
+(test (let () (define (func) (defined? :hi8)) (func)) #t)
+(test (let () (do () ((not #f) (defined? :hi8 (rootlet))))) #t)
+(test (let ((xx8 :hi8)) (define (func) (do () ((not #f) (defined? xx8 (rootlet))))) (func)) #t)
+(test (let () (define (func) (do () ((not #f) (defined? :hi8 (rootlet))))) (func)) #t)
+(test (defined? :hi8 (rootlet)) #t)
+(test (let ((xx8 :hi8)) (define (func) (defined? xx8 (rootlet))) (func)) #t)
+(test (let () (define (func) (defined? :hi8 (rootlet))) (func)) #t)
+
+(test (defined? :a (inlet :a 1)) #t)
+(test (defined? 'a (inlet :a 1)) #t)
+(test (defined? 'a (inlet 'b 2)) #f)
+(test (let ((a 1)) (defined? 'a (lambda () a))) #t)
+(test (let ((a 1)) (defined? 'b (lambda () a))) #f)
+(when with-block
+  (test (defined? 'a (block)) #f)
+  (test (defined? 'float-vector-ref (block)) #t))
+(test (defined? 'a3 (openlet (c-pointer 3 'asdf (inlet 'a3 (lambda (val) 12))))) #t)
+
+
+;;; --------------------------------------------------------------------------------
+;;; undefined?
+
+(for-each
+ (lambda (arg)
+   (test (undefined? arg) #f))
+ (list #<eof> #<unspecified> -1 #\a 1 _ht_ _null_ _c_obj_ #(1 2 3) 3.14 3/4 1.0+1.0i () #f #(()) (list 1 2 3) '(1 . 2) "hi"))
+(test (undefined? #<undefined>) #t)
+(test (undefined? _undef_) #t)
+(test (undefined?) 'error)
+(test (undefined? 1 2) 'error)
+(test (object->let _undef_) (inlet 'value _undef_ 'type 'undefined?))
+(test (object->let #<undefined>) (inlet 'value #<undefined> 'type 'undefined?))
+
+(let ((a1 (with-input-from-string "#feed" read)))
+  (test (undefined? a1) #t)
+  (test (equal? #<undefined> a1) #f)
+  (test (eq? a1 a1) #t)
+  (test (equal? a1 (with-input-from-string "#feed" read)) #t)
+  (test (equal? a1 (with-input-from-string "#xfeedback" read)) 'error)
+  (test (equivalent? a1 (with-input-from-string "#feed" read)) #t)
+  (test (equivalent? a1 (with-input-from-string "#xfeedback" read)) 'error)
+  (test (object->string a1) "#feed")
+  (test (object->string a1 :readable) "(with-input-from-string \"#feed\" read)")
+  (test (undefined? (copy a1)) #t)
+  (test (equal? a1 (copy a1)) #t))
+
+(test (with-input-from-string "#b32" read) 'error)
+(test (with-input-from-string "#o98" read) 'error)
+
+(test (undefined? #<>) #t)
+(test (equal? #<> #<>) #t)
+(test (eq? #<> #<>) #f) ; currently anyway
+(test (equal? #<asdf> #<asdf>) #t)
+(test (equal? #<> (cdr (cons 1 #<>))) #t)
+(test (undefined? #<x:>) #t)
+(test (undefined? #<xyz>) #t)
+
+
+;;; --------------------------------------------------------------------------------
+;;; unspecified?
+
+(for-each
+ (lambda (arg)
+   (test (unspecified? arg) #f))
+ (list -1 #\a 1 _ht_ _undef_ #<eof> _null_ _c_obj_ #(1 2 3) 3.14 3/4 1.0+1.0i () #f #(()) (list 1 2 3) '(1 . 2) "hi"))
+(test (unspecified? (values)) #t)
+(test (unspecified?) 'error)
+(test (unspecified? 1 2) 'error)
+(test (object->let #<unspecified>) (inlet 'value #<unspecified> 'type 'unspecified?))
+(test (object->let (values)) (inlet 'value (values) 'type 'unspecified?))
+
+
+;;; --------------------------------------------------------------------------------
+;;; let?
+;;; inlet
+;;; rootlet
+;;; curlet
+;;; sublet
+;;; with-let
+;;; let->list
+;;; outlet
+;;; let-ref
+;;; let-set!
+;;; varlet
+;;; cutlet
+;;; coverlet
+;;; openlet
+;;; unlet
+
+(test (let () (length (curlet))) 0)
+(test (let ((a 1) (b 2) (c 3)) (length (curlet))) 3)
+
+(for-each
+ (lambda (arg)
+   (test (let? arg) #f))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1))))
+(let () (test (let? (unlet)) #t))
+(test (let? (curlet)) #t)
+(test (let? (rootlet)) #t)
+(test (let? (sublet ())) #t)
+(test (let? (varlet ())) 'error)
+(test (let? (sublet (sublet ()) '(a . 1))) #t)
+(test (let? (sublet () '(a . 1))) #t)
+(test (eq? abs ((rootlet) 'abs)) #t)
+(test (eq? abs #_abs) #t)
+(test (eq? abs (with-let (unlet) abs)) #t)
+(test ((sublet () '(asdf . 32)) 'asdf) 32)
+(test ((sublet () '(asdf . 32)) 'asd) #<undefined>)
+(test (let? (sublet (curlet))) #t) ; no bindings is like (let () ...)
+;(test (varlet (rootlet) '(quote . 1)) 'error)
+;(test (varlet (rootlet) 'if 3) 'error)
+;(test (let-set! (rootlet) 'if 3) 'error)
+(test (inlet 'let-set! (lambda (a b c) c)) 'error) ; currently immutable
+(test (inlet 'let-ref (lambda (a b c) c)) 'error) ; currently immutable
+(test (set! (outlet (curlet)) 32) 'error)
+(test (set! (outlet 32) (curlet)) 'error)
+
+(test (eq? (curlet) (let ((a (curlet))) a)) #t)
+(test (eq? (curlet) (let* ((a (curlet))) a)) #t)
+(test (eq? (curlet) (letrec ((a (curlet))) a)) #f)
+(test (eq? (curlet) (letrec* ((a (curlet))) a)) #f)
+(test (let ((a (curlet))) (eq? a (curlet))) #f)
+(test (letrec ((a (curlet))) (eq? a (curlet))) #t)
+
+(test (let ((e (inlet 'e (inlet '+ -)))) (((e 'e) '+) 2 3)) -1)
+(test (let ((confused (inlet '+ -))) ((confused '+) 2 3)) -1)
+;;;  (with-let (inlet '+ -) (+ 2 3)) -> 5
+;;;  (with-let (inlet '+ -) (((curlet) '+) 2 3)) -> -1
+;;;  (with-let (inlet 'plus -) (plus 2 3)) -> -1
+;;; which is consistent, so to speak, with the (set! gcd +) example mentioned in s7.html
+(test (let ((i 0)) ((lambda* ((x 1)) (with-let (rootlet) (= i 2))))) 'error)
+(test (let ((i 0)) (with-output-to-string (lambda () (with-let (rootlet) (cons i i))))) 'error)
+(test (eq? abs #_abs) #t)
+(test (eq? #_abs ((rootlet) 'abs)) #t)
+(test (eq? ((rootlet) 'abs) (with-let (rootlet) abs)) #t)
+
+;(display (object->let (rootlet))) (newline)            ; (inlet 'alias rootlet 'value (rootlet) 'type let? 'size 438 'open #f 'outlet () 'mutable? #t)
+;(display (object->string (rootlet))) (newline)         ; (rootlet)
+;(display (let->list (rootlet))) (newline)              ; ... tons of output
+(test (coverlet (rootlet)) 'error)                      ; error: out-of-range ("can't coverlet rootlet")
+(test (openlet (rootlet)) 'error)                       ; error: out-of-range ("can't openlet rootlet")
+;(display (varlet (rootlet) 'a 1)) (newline)            ; (rootlet)
+;(display (cutlet (rootlet) 'abs)) (newline)            ; (rootlet)
+(test (eval '(abs -1) (rootlet)) 1)
+(test (eval-string "(abs -1)" (rootlet)) 1)
+;(display (immutable! (rootlet))) (newline)             ; (rootlet) -- actually works...
+(test (immutable? 'abs (rootlet)) #f)
+(test (immutable? (rootlet)) #f)
+;(display (load "stuff.scm" (rootlet))) (newline)       ; sandbox
+(test (outlet (rootlet)) (rootlet))
+(test (sublet (rootlet) 'a 1) (inlet 'a 1))
+
+(test (((let ((x (lambda (y) (+ y 1)))) (curlet)) 'x) 2) 3)
+(test (let ((h (inlet 'a (inlet 'b 2)))) (h 'a 'b)) 2)
+
+(test (equal? (inlet 'a 1) (inlet 'a 1)) #t)
+(test (equivalent? (inlet 'a 1) (inlet 'a 1)) #t)
+(test (equal? (inlet 'a 1) (inlet 'a 2 'a 1)) #f)
+(test (equal? (inlet 'a 3 'a 1) (inlet 'a 2 'a 1)) #f)
+(test (equivalent? (inlet 'a 1) (inlet 'a 2 'a 1)) #f)
+(test (equal? (inlet 'a 1 'b "hi") (inlet 'a 1 'b "hi")) #t)
+(test (equivalent? (inlet 'a 1 'b "hi") (inlet 'a 1 'b "hi")) #t)
+(test (equal? (inlet 'b "hi" 'a 1) (inlet 'a 1 'b "hi")) #t)
+(test (equivalent? (inlet 'b "hi" 'a 1) (inlet 'a 1 'b "hi")) #t)
+(test (equal? (inlet 'a 2 'b "hi" 'a 1) (inlet 'b "hi" 'a 2 'a 1)) #t)
+(test (equal? (inlet 'a (vector 1.0)) (inlet 'a (float-vector 1.0))) #t)
+(test (equivalent? (inlet 'a (vector 1.0)) (inlet 'a (float-vector 1.0))) #t)
+(test (equal? (inlet 'b "hi" 'a 1) (inlet 'b "hi" 'a 1.0)) #f)
+(test (equivalent? (inlet 'b "hi" 'a 1) (inlet 'b "hi" 'a 1.0)) #t)
+(test (equal? (inlet 'b "hi" 'a 1) (inlet 'b "hi" 'a 1/2)) #f)
+(test (equivalent? (inlet 'b "hi" 'a 1) (inlet 'b "hi" 'a 1/2)) #f)
+(test (equal? (inlet 'a 1) (inlet 'b "hi" 'a 1)) #f)
+(test (equal? (inlet 'a 1 'b "hi") (inlet 'a 1)) #f)
+(test (equal? (inlet 'a 1 'a 1) (inlet 'a 1)) #t)
+(test (equal? (inlet 'a (inlet 'b 1)) (inlet 'a (inlet 'b 1))) #t)
+(test (equal? (inlet 'a (inlet 'b 1)) (inlet 'a (inlet 'b 1))) #t)
+(test (equal? (inlet 'b (inlet 'b 1)) (inlet 'b (inlet 'b 1))) #t)
+(test (equal? (inlet) (inlet)) #t)
+(test (equal? (inlet 'a 1) (inlet)) #f)
+(test (equal? (inlet) (inlet 'a 1)) #f)
+(test (object->string (inlet 'a 1 'a 3)) "(inlet 'a 1 'a 3)")
+(test ((inlet 'a 1 'a 3) 'a) 3) ; so the print form follows the input order, but the earlier entries (as printed) are shadowed
+(test (equal? (inlet) (sublet (inlet))) #t)
+(test (equal? (inlet 'a 1) (inlet 'a 2)) #f)
+(test (equal? (inlet 'a 1) (inlet 'b 1)) #f)
+(test (equal? (inlet 'a 1) (inlet 'a 1 'b 1)) #f)
+(test (equal? (inlet 'a 1 'b 1) (inlet 'a 1 'c 1)) #f)
+(test (equal? (inlet 'a 1 'b 1) (inlet 'a 1 'b 1)) #t)
+(test (equal? (inlet 'a 1) (inlet 'a 1 'a 1)) #t)
+(test (equal? (inlet 'a 1) (inlet 'a 1 'a 2)) #t)
+(test (equal? (sublet (inlet 'a 1) 'b 2) (sublet (inlet 'a 1) 'b 2)) #t)
+(test (equal? (sublet (inlet 'a 1) 'b 2) (sublet (inlet 'a 2) 'b 2)) #f)
+(test (equal? (sublet (inlet 'a 1) 'b 2) (sublet (inlet 'a 1) 'b 1)) #f)
+(test (equal? (sublet (inlet 'a 1) 'b 2) (sublet (inlet 'a 1))) #f)
+(test (equal? (sublet (inlet 'a 1)) (sublet (inlet))) #f)
+(test (equal? (sublet (inlet 'a 1)) (inlet 'a 1)) #t)
+(test (equal? (sublet (sublet (inlet 'a 1))) (sublet (inlet 'a 1))) #t)
+(test (let ((e (inlet 'a 1))) (equal? (sublet e 'a 1) (sublet e 'a 1))) #t)
+(test (equal? (inlet 'a 1 'b 2 'c 3) (inlet 'c 3 'b 2 'a 1)) #t)
+(test (equal? (inlet 'a 1 'b 2 'c 3) (inlet 'c 3 'b 1 'a 1)) #f)
+(test (equal? (inlet 'a 1 'a 2) (inlet 'a 3 'a 2)) #f)
+(test (equal? (inlet 'a 2 'a 1) (inlet 'a 2 'a 3)) #t)
+(test (equal? (sublet (inlet 'a 1 'a 3) 'a 2) (sublet (inlet 'a 3) 'a 2)) #t)
+(test (equal? (inlet 'a 1) (inlet 'a 1 'b 2)) #f)
+(test (equal? (inlet 'a 1) (sublet (inlet 'a 1))) #t)
+(test (equal? (sublet (inlet 'a 1)) (inlet 'a 1)) #t)
+(test (let () (eq? (curlet) (outlet (inlet)))) #f)
+(test (let () (eq? (rootlet) (outlet (inlet)))) #t)
+(test (let () (copy (inlet '_rootlet_var_ 32) (rootlet)) _rootlet_var_) 32)
+
+(test (equal? (inlet (cons 'a 1)) (inlet 'a 1)) #t)
+(test (equal? (inlet (cons :a 1)) (inlet 'a 1)) #t)
+(test (equal? (inlet :a 1) (inlet 'a 1)) #t)
+(test (equal? (inlet a: 1) (inlet :a 1)) #t)
+(test (inlet 'pi 3) 'error)
+(test (inlet 'let-ref (lambda (obj val) val)) 'error)
+(test (inlet 'let-set! (lambda (obj arg val) val)) 'error)
+(test (let ((incr (lambda (val) (+ val 1))))
+        (let ((e1 (curlet))
+              (incr (lambda (val) (+ val 2))))
+          (+ (with-let e1 (incr 2)) (incr 5))))
+      10)
+(let () (define (f) (inlet 'value (inlet 'a (inlet 'b 1)) :a (list (list 1 2)))) (test (f) (inlet 'value (inlet 'a (inlet 'b 1)) 'a '((1 2)))))
+
+(test (varlet (immutable! (inlet 'a 1)) 'b 2) 'error)
+(test (cutlet (immutable! (inlet 'a 1)) 'a) 'error)
+(test (let ((abc 123)) (immutable! 'abc) (cutlet (curlet) 'abc)) 'error)
+(test (cutlet (rootlet) 'with-let) 'error)
+(test (with-let (immutable! (inlet 'a 1)) (define b 2)) 'error)
+(test (length (openlet (inlet 'length 8))) 'error)
+(test (openlet (rootlet)) 'error)
+(test (with-let (rootlet) (openlet (lambda (x) x))) 'error)
+(test (coverlet (rootlet)) 'error)
+(test (outlet (rootlet)) (rootlet))
+
+(let ((x (let ((a 1)) (immutable! 'a) (curlet))))
+  (test (set! (x 'a) 3) 'error)
+  (let ((y (sublet x)))
+    (test (set! (y 'a) 3) 'error)))
+
+(test (let ((e (inlet 'a 2 'a 1)))
+	(let ((c (copy e)))
+	  (list (e 'a) (c 'a))))
+      '(2 2))
+
+(test (equal? (inlet 'a 1) (sublet (inlet 'a 1))) #t)
+(test (equal? (sublet (inlet 'a 1) 'b 2) (sublet (inlet 'a 1 'b 2) 'b 2)) #t)
+(test (equal? (sublet (inlet 'a 3) 'a 2) (sublet (inlet 'a 1) 'a 2)) #t)  ; ((sublet (inlet 'a 1) 'a 2) 'a) -> 2
+(test (equal? (sublet (inlet) 'a 2) (sublet (inlet 'a 1) 'a 2)) #t)
+(test (equal? (inlet 'a 1) (inlet 'a 1 'a 2 'a 3)) #t)
+(test (equal? (sublet (rootlet) 'a 1) (inlet 'a 1)) #t)
+(test (let () (define (func) (inlet :b 3 :a (inlet 'a 1))) (func)) (inlet :b 3 :a (inlet :a 1))) ; symbol_id in fx_inlet_ca
+(test (let ((L (sublet (sublet (inlet 'x 1) 'y 2) 'z 3))) (with-let L (+ x y z))) 6)
+(test (let () (define (func) (with-let (inlet 'a 1) else)) (func) (func)) else)
+(test (defined? 'else (inlet 'a 1) #t) #f)
+(test (let ((a (inlet))) (define (func) (catch #t (lambda () (with-let a _!asdf!_) :oops) (lambda (type info) 'error))) (func) (func)) 'error)
+(test (with-let (let ((+documentation+ "hiho")) (curlet)) (define (f) 1) (documentation f)) "hiho")
+(test (with-let (rootlet) +signature+) 'error) ; unbound variable
+(test (let () (with-let (rootlet) +signature+)) 'error) ; unbound variable
+(test (let () (define (f) (with-let (rootlet) +signature+)) (f) (f)) 'error) ; unbound variable
+(test (with-let (rootlet) (and #t +iterator+)) 'error) ; let_symbol_is_safe T_Lsd bug
+(test (let ((mlet (inlet 'a 1))) (define (f) (do ((i 0 (+ i 1))) ((= i 3)) (let-set! mlet with-let 0))) (f)) 'error)
+(test (let ((mlet (inlet 'a 1)) (nsym :a)) (define (f) (do ((i 0 (+ i 1))) ((= i 3)) (let-set! mlet nsym 0))) (f)) #t) ; do loop return
+(test (let ((mlet (inlet 'a 1)) (nsym 'a)) (define (f) (do ((i 0 (+ i 1))) ((= i 3)) (let-set! mlet nsym 0))) (f)) #t)
+(test (let ((mlet (inlet 'a 1)) (nsym 32)) (define (f) (do ((i 0 (+ i 1))) ((= i 3)) (let-set! mlet nsym 0))) (f)) 'error)
+(test (let ((L (inlet 'a 1)) (V (make-vector 8 'a symbol?))) (define (f) (do ((i 0 (+ i 1))) ((= i 2)) (let-set! L V (append)))) (f)) 'error)
+(test (let ((imb (block 0.0 1.0 2.0))) (define (f) (do ((i 0 (+ i 1))) ((= i 2)) (hash-table? (memq imb `(+ x 1))))) (f)) #t)
+(test (let ((clet (inlet 'a 1))) (define (f) (do ((i 0 (+ i 1))) ((= i 3)) (let? (inlet 'value clet)))) (f)) #t)
+(if with-block (test (let ((mlet (openlet (inlet 'abs cycle-ref)))) (abs mlet)) 'error)) ; wrong-type-arg "object passed to cycle-ref is not a cycle object"
+(test (let ((mlet (openlet (inlet 'abs list)))) (abs mlet)) (list (inlet 'abs list)))
+(test (let ((mlet (openlet (inlet 'abs with-let)))) (abs mlet)) 'error)      ; with-let has no body
+(test (let ((mlet (openlet (inlet 'abs #<undefined>)))) (abs mlet)) 'error)  ; abs method is not defined in openlet
+(test (let ((mlet (openlet (inlet 'abs catch)))) (abs mlet)) 'error)         ; catch: function missing: (catch (inlet 'abs catch))
+(test (let ((mlet (openlet (inlet 'abs string-ref)))) (abs mlet)) 'error)    ; string-ref method is not defined in openlet? (inlet 'abs string-ref)
+(test (let ((mlet (openlet (inlet 'abs let-ref)))) (abs mlet)) 'error)       ; let-ref: symbol missing: (let-ref (inlet 'abs let-ref))
+(test (let ((mlet (openlet (inlet 'abs owlet)))) (abs mlet)) 'error)         ; owlet: too many arguments: ((inlet 'abs owlet))
+;; (let ((mlet (openlet (inlet 'abs abs)))) (abs mlet))                      ; infinite loop in find_and_apply_method
+(test (let ((mlet (openlet (inlet 'abs map)))) (abs mlet)) 'error)           ; map: 0 arguments for (inlet 'abs map)?
+
+(test (equivalent? (sublet (inlet) 'a 1 (inlet 'b 2)) (inlet 'b 2 'a 1)) #t)
+(test (equivalent? (sublet (inlet) (inlet 'b 2)) (inlet 'b 2)) #t)
+(test (equivalent? (sublet (inlet) (inlet 'b 2) 'a 1) (inlet 'a 1 'b 2)) #t)
+(test (equivalent? (sublet (inlet) (inlet 'b 2) 'a 1 'c 3) (inlet 'b 2 'a 1 'c 3)) #t)
+(test (equivalent? (sublet (inlet 'd 4) (inlet 'b 2) 'a 1 'c 3) (sublet (inlet 'd 4) 'b 2 'a 1 'c 3)) #t)
+(test (equivalent? (sublet (inlet 'd 4) (inlet 'b 2 'e 5) 'a 1 'c 3) (sublet (inlet 'd 4) 'e 5 'b 2 'a 1 'c 3)) #t)
+(test (equivalent? (sublet (inlet) 'a 1 (inlet 'b 2) 'c 3) (inlet 'b 2 'a 1 'c 3)) #t)
+(test (equivalent? (sublet (inlet) 'a 1 'c 3 (inlet 'b 2)) (inlet 'b 2 'a 1 'c 3)) #t)
+
+(let ((f (inlet 'sym 'sam 'sam 'sym))
+      (g (inlet 'sam 'sym 'sym 'sam)))
+  (test (f (g 'sym)) 'sym)
+  (test (f (f 'sym)) 'sym)
+  (test (g (f 'sam)) 'sam)
+  (test (g (f (g (f (f 'sym))))) 'sam))
+
+(let ((f (inlet :a 1 :b 2)))
+  (test (length f) 2)
+  (fill! f #<undefined>)
+  (test (length f) 2) ; was 0, 8-Jun-20
+  (test (f 'b) #<undefined>)
+  (test (let-ref f 'a) #<undefined>))
+
+(let ()
+  (define (f a)
+    (curlet))
+  (define (g)
+    (let ((cpa (f 32)))
+      (f 12)
+      (cpa 'a)))
+  (test (g) 32)) ; if curlet safe by accident, this returns 12 (funclets are the same in that case?)
+
+(test (apply inlet (map values (hash-table 'a 1 'b 2))) (inlet 'b 2 'a 1))
+(test (apply hash-table (map (lambda (x) (values (car x) (cdr x))) (inlet 'a 1 'b 2))) (hash-table 'a 1 'b 2))
+
+(let ((e (inlet 'a 1 'a 2)))
+  (test (e 'a) ((copy e) 'a)))
+
+(let ((e1 (inlet 'a 1 'a 2)))
+  (let ((e2 (copy e1)))
+    (test (list (equal? e1 e2) (equal? (e1 'a) (e2 'a))) '(#t #t))))
+
+(let ()
+  (define-bacro (let/ e . body)
+    `(with-let (sublet (curlet) ,e)
+       ,@body))
+  (test (let ((a 1))
+	  (let/ (inlet 'b 2)
+	    (+ a b)))
+	3))
+
+(let ((e (inlet 'a (inlet 'b 1 'c 2) 'b (inlet 'b 3 'c 4))))
+  (test (e 'a 'b) 1)
+  (test (e 'b 'b) 3)
+  (test (e 'b 'c) 4))
+
+(let ()
+  (define (f1) (let ((e (inlet 'a 1))) (e '(1))))
+  (test (f1) 'error))
+
+(test (equal? (inlet 'a 1) (cutlet (inlet 'a 1 'b 2) 'b)) #t)
+(test (equal? (inlet 'a 1) (inlet 'a 1 'b 2)) #f)
+(test (length (cutlet (inlet 'a 1 'b 2 'c 3) 'b 'a)) 1)
+(test (length (cutlet (inlet 'a 1 'b 2 'c 3) 'd)) 3)
+(test (let->list (cutlet (inlet 'a 1 'b 2 'c 3) 'b 'a)) '((c . 3)))
+(test ((cutlet (inlet 'a 1 'b 2) 'a) 'a) #<undefined>)
+(test ((cutlet (inlet 'a 1 'b 2 'c 3) 'a) 'b) 2)
+(test ((cutlet (inlet 'a 1 'b 2) 'a) 'b) 2)
+(test ((cutlet (inlet 'a 1 'b 2 'c 3) 'a 'b 'c) 'a) #<undefined>)
+(test ((cutlet (inlet 'a 1 'b 2 'c 3 'a 4) 'a) 'a) 4)
+(test (cutlet (inlet)) 'error)
+(test (cutlet (inlet 'a 1) 'a) (inlet))
+(test ((cutlet (inlet 'a 1 'a 2) 'a) 'a) 2)
+(test (let ((g (gensym))) (cutlet (inlet g '1) g)) (inlet))
+(test (cutlet (sublet (inlet 'a 1) 'b 2) 'a) (sublet (inlet 'a 1) 'b 2))
+(test (let ((b 2)) (cutlet (curlet) 'b) b) 'error) ; unbound variable
+(test (let ((b 1)) (let ((b 2)) (cutlet (curlet) 'b)) b) 1)
+(test (openlet? (sublet (openlet (inlet 'a 1)))) #t)
+
+(test (cutlet (rootlet) :scaler) 'error)
+(test (cutlet (rootlet) 'scaler) 'error)
+(test (cutlet (rootlet) '_asdf_) 'error)
+
+(test (let ((#_+ 3)) #_+) 'error)
+(test (define #_+ 3) 'error)
+(test (set! #_+ 3) 'error)
+(test (with-let (inlet :rest 3) rest) 3)
+(test (with-let (inlet :allow-other-keys 32) allow-other-keys) 32)
+(test (with-let (sublet (rootlet)) (with-let (rootlet) :display)) :display)
+(test (with-let (lambda (x) (fill! (copy x) 0)) :if) :if)
+
+(test (let ((a 21)) (let ((e (inlet (curlet)))) (set! a 32) (with-let e a))) 21)
+(test (let ((a 21)) (let ((e (sublet (curlet)))) (set! a 32) (with-let e a))) 32)
+(test (with-let (block 1 2 3) ((curlet) 0)) 'error)
+(test (with-let (c-pointer 0) (curlet)) (rootlet))
+(test (let () (define (f sym ?x) (with-let (inlet sym ?x) a)) (f 'a 123)) 123)
+(test (integer? (let () ((sublet (curlet) *s7*) 'gc-freed))) #t) ; append_let coverage
+;(test (let () (sublet (curlet) (rootlet))) (inlet))
+
+(let ((lt (inlet 'a 3 'b 2)))
+  (test (with-let lt :a) :a)
+  (test (with-let lt a) 3)
+  (test (lt :a) 3)
+  (test (let ((a 3)) :a) :a)
+  (test (let () (define (func) (with-let lt :a)) (func) (func)) :a)
+  (test (let () (define (func) (let ((a 3)) :a)) (func) (func)) :a)
+  (test (let () (define (func) (with-let lt a)) (func) (func)) 3))
+
+(test (let () (define (f) (with-let (unlet) abs)) (f) (f)) abs)
+(catch #t
+  (lambda ()
+    (let ()
+      (define hi (inlet 'x 12))
+      (let ((x 32)
+	    (y 1))
+	(let ((old-out (outlet hi)))
+	  (set! (outlet hi) (curlet))
+	  (with-let hi                              ; x 12 y 1
+	    (test (+ x y) 13))
+	  (set! (outlet hi) old-out)                ; x 32 y 1
+	  (test (+ x y) 33)
+	  (with-let hi                              ; x 12 y #<undefined>
+	    (test x 12)
+	    (test (defined? 'y) #f))))))
+  (lambda (type info)
+    (format *stderr* "unbound in local inlet: ~A ~A~%" type info)))
+
+(test (let ((L (inlet 'a 1))) (set! (outlet L) L) (L 'abs)) 'error)
+(test (let ((a 1)) (set! (outlet (curlet)) (curlet)) abs) 'error)
+
+(test (let ()
+	(with-let (curlet) (define hiho 43))
+	hiho)
+      43)
+(let ()
+  (define-macro (define! env . args)
+    `(with-let ,env (define ,@args)))
+  (test (let ()
+	  (define! (curlet) (hiho x) (+ x 1))
+	  (hiho 2))
+	3))
+
+(test (let () (with-let (curlet) (define (f3 a) (+ a 2))) (f3 1)) 3)
+
+(let ()
+  (with-let (rootlet)
+    (define (this-is-global a) (+ a 1))))
+
+(test (this-is-global 2) 3)
+
+(let ()
+  (with-let (inlet)
+    (define (this-is-not-global a) (+ a 1))))
+
+(test (this-is-not-global 2) 'error)
+
+(test (let ((b 2)) (varlet (curlet) 'a 1) (+ a b)) 3)
+
+(let ()
+  (apply varlet (curlet)
+	 (with-let (unlet)
+	   (let ()
+	     (define (lognor n1 n2) (lognot (logior n1 n2)))
+	     (define (logit n1) n1)
+
+	     (map (lambda (binding)
+		    (cons (string->symbol
+			   (string-append "library:" (symbol->string (car binding))))
+			  (cdr binding)))
+		  (curlet)))))
+  (test (library:lognor 1 2) -4))
+
+(let ()
+  (define (f1)
+    (let ((a 0)
+	  (v (make-vector 3)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) v)
+	(vector-set! v i a)
+	(varlet (curlet) 'a i))))
+
+  (test (f1) #(0 0 1))
+
+  (define (f2)
+    (let ((v (make-vector 3)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) v)
+	(varlet (curlet) 'a i)
+	(vector-set! v i a))))
+
+  (test (f2) #(0 1 2)))
+
+(let ()
+  (varlet (curlet)
+    ((lambda (a b)
+       (define (f1 x) (+ x a))
+       (define (f2 x) (+ x a b))
+       (curlet))
+     1 2))
+  (test (f1 3) 4)
+  (test (f2 3) 6))
+
+(test (null? (let->list (rootlet))) #f)
+
+(test (let? (inlet)) #t)
+(test (length (inlet)) 0)
+(test (length (inlet '(a . 2))) 1)
+(test (with-let (inlet '(a . 2)) a) 2)
+(test (with-let (inlet '(a . 2) '(b . 3)) (+ a b)) 5)
+(test (eq? (inlet) (rootlet)) #f)
+(test ((inlet (inlet '(a . 1))) 'a) 1)
+(test ((inlet (inlet '(a . 1)) '(b . 2)) 'b) 2)
+(test ((inlet '(b . 3) (inlet '(a . 1))) 'b) 3)
+(test (let ((a 1)) ((inlet (curlet)) 'a)) 1)
+(test (let ((a 1)) ((inlet '(b . 2)) 'a)) #<undefined>)
+(test (let ((a (inlet 'b 2))) (set! (let-ref a 'b) 3) (a 'b)) 3) ; let-ref setter is let-set!
+(let ((let1 (inlet 'a 1))) (varlet let1 'let1 let1) (with-let let1 (with-let let1 (define b 2))) (test (let1 'b) 2))
+(test (let ((lt (inlet 'a 1))) (set! (with-let lt a) (values 1 2))) 'error)
+(let ((a 123.0)) (define (f) (set! (let-ref) a)) (catch #t f (lambda args #f)) (test (f) 'error))
+(test (let () (define (func) (catch #t (lambda () (set! (let-ref (list 1)) 1)) (lambda args 'error))) (func) (func)) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (sublet arg) 'error)
+   (test (varlet arg) 'error)
+   (test (cutlet arg) 'error)
+   (test (cutlet (curlet) arg) 'error))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i pi abs macroexpand #<eof> #<unspecified> #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1))))
+
+(test (let ((e (inlet '(a . 1)))) ((lambda (x) (x *)) e)) 'error)
+(test (let ((e (inlet '(a . 1)))) ((lambda (x) (x pi)) e)) 'error)
+(test (let () (inlet (cons pi 1))) 'error)
+(test (let () (inlet (cons "hi" 1))) 'error)
+(test (let () (define (f) (eq? #<eof> (inlet 'quasiquote 1))) (f)) 'error)
+
+(test (let? (inlet)) #t)
+(test (length (inlet)) 0)
+(test (length (inlet 'a 2)) 1)
+(test (with-let (inlet 'a 2) a) 2)
+(test (with-let (inlet 'a 2 'b 3) (+ a b)) 5)
+(test (eq? (inlet) (rootlet)) #f)
+(test ((inlet (inlet 'a 1)) 'a) 1)
+(test ((inlet (inlet 'a 1) '(b . 2)) 'b) 2)
+
+(test (let ((c 1)) (set! (with-let (curlet) c) 32) c) 32)
+(test (let ((c (list 1 2))) (set! (with-let (curlet) (c 1)) 32) c) '(1 32))
+(test (let ((c (list 1 2))) (set! (with-let (curlet) (c 3)) 32) c) 'error)
+(test (let ((a (inlet 'b #(0 1)))) (set! (with-let a (b 0)) 1) ((a 'b) 0)) 1)
+(test (set! (with-let (curlet) 3) 2) 'error)
+(test (let ((c (list 1 2))) (set! (with-let (curlet) (c 3)) 32 0)) 'error)
+(test (let () (define (func) (let ((lt (inlet 'a 1))) (set! (with-let lt a) 32))) (func) (func)) 32)
+(test (abs (let ((abs (lambda (x) 32))) (openlet (curlet)))) 32)
+(test (let ((i 0)) ; check bugfix: in_with_let set in optimize_syntax to warn optimize_c_func_one_arg that 'i in (null i) is trouble
+        (let loop ((i 1) (x (lambda () (set! (with-let (inlet) ((null? i) i)) 0))))
+          (if (> i 0) (loop (- i 1) x) (x)))) 'error) ; unbound variable i
+
+(let ((a (inlet 'abc (let ((inx 0)) (dilambda (lambda () inx) (lambda (y) (set! inx y)))))))
+  (set! ((a 'abc)) 32)
+  (test ((a 'abc)) 32)
+  (with-let a (set! (abc) 1))
+  (test (with-let a (abc)) 1)
+  (set! (with-let a (abc)) 3)
+  (test ((a 'abc)) 3))
+
+(let ((lt1 (inlet 'a 1 'b 2)))
+  (set! (with-let lt1 a) 32)
+  (test (lt1 'a) 32)
+  (set! (with-let lt1 a) (with-let lt1 (+ a b)))
+  (test (lt1 'a) 34)
+  (set! (with-let (curlet) (*s7* 'print-length)) 16)
+  (test (*s7* 'print-length) 16)
+  (varlet lt1 'c (vector 1 2 3))
+  (set! (with-let lt1 (c 1)) 12)
+  (test ((lt1 'c) 1) 12)
+  (let ((lt2 (list lt1)))
+    (set! (with-let (car lt2) (c 0)) 11)
+    (test ((lt1 'c) 0) 11))
+  (let ((lt2 (list lt1))
+	(d 100))
+    (set! (with-let (car lt2) (c (sqrt 4))) (sqrt d))
+    (test ((lt1 'c) 2) 10))
+  (let ((lt3 (inlet 'a (vector 1 2 3))))
+    (set! (with-let lt3 a) '(1 2))
+    (test (lt3 'a) '(1 2)))
+  (let ((lt3 (inlet 'a (vector 1 2 3) 'b 1)))
+    (set! (with-let lt3 a) 'b)
+    (test (lt3 'a) 'b)))
+
+(test (let ((v (vector 1 2))) (set! (with-let (curlet) (v 0)) 'a) v) #(a 2))
+(test (set! (with-let (inlet :v (vector 1 2)) (v 0)) '(3 4)) '(3 4))
+(test (let ((v (vector 1 2))) (set! (with-let (curlet) (v 0)) 32) v) #(32 2))
+
+(test (catch #t (lambda () (set! (with-let (inlet :a 1) 3) 2)) (lambda (type info) (apply format #f info)))
+      "can't set 3 in (#_set! 3 2)")
+
+(test (catch #t (lambda () (set! (with-let (inlet :a 1) :asdf) (+ 1 1))) (lambda (type info) (apply format #f info)))
+      "let-set!: asdf is not defined in (inlet 'a 1)")
+
+(test (catch #t (lambda () (set! (with-let (inlet :a 1) (symbol->keyword 'asdf)) (+ 1 1))) (lambda (type info) (apply format #f info)))
+      "symbol->keyword (a c-function) does not have a setter: (set! (symbol->keyword 'asdf) 2)")
+
+(test (catch #t (lambda () (set! (with-let (inlet :a 1) 3) 'a)) (lambda (type info) (apply format #f info)))
+      "can't set 3 in (#_set! 3 'a)")
+
+(test (catch #t (lambda () (let ((e (inlet :v (vector 1 2)))) (set! (with-let e (let ((z 0)) (v z))) 'a) (e 'v))) (lambda (type info) (apply format #f info)))
+      "let (syntactic) does not have a setter: (set! (let ((z 0)) (v z)) 'a)")
+
+(test (catch #t (lambda () (set! (with-let) 1)) (lambda (type info) (apply format #f info)))
+      "with-let needs a let and a symbol: (set! (with-let) 1)")
+
+(test (catch #t (lambda () (set! (with-let (curlet)) 'a)) (lambda (type info) (apply format #f info)))
+      "with-let in (set! (with-let (curlet)) 'a) has no symbol to set?")
+
+(test (catch #t (lambda () (set! ((unlet) 'abs) 1)) (lambda (type info) (apply format #f info)))
+      "abs is immutable in (unlet)")
+
+(let ()
+  (define-macro* (msym6 a b :rest c)
+    `(list ,a ,b (copy ,c)))
+  (define-macro* (msym4 :rest a)
+    `(copy ,a))
+  (define _dilambda_ (dilambda (lambda (x) (+ x 1)) (lambda (x y) (+ x y))))
+  (define (func)
+    (let ((i 0))
+      (((vector msym6) 0) 1 2 with-let (inlet 'a 1) (zero? i)))) ; inline_op_safe_c_s[87021]: i unbound
+  (test (func) 'error)
+  (test (let ((i 0))
+          (let _L_ ((x 1))
+            (if (> x 0)
+	        (_L_ (- x 1))
+ 	        ((let () msym6) 1 2 with-let (inlet 'a 1) (vector x i))))) ; inline_op_safe_c_ss[87031]: x unbound
+        'error)
+  (test (let () (define (func1) (((vector msym4) 0) cond (_dilambda_ (flush-output-port)))) (func1)) *stdout*))
+
+(for-each
+ (lambda (arg)
+   (test (inlet arg) 'error)
+   (test (apply inlet arg) 'error))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i pi abs macroexpand #<eof> #<unspecified> #f #(()) (list 1 2 3) '(1 . 2) "hi"))
+
+(test (inlet 'a) 'error)
+(test (inlet 1 2) 'error)
+(test (inlet 'a 2 'b) 'error)
+(test (with-let (inlet 'a (let ((p (open-output-string))) (display "32" p) p)) (get-output-string a)) "32")
+
+(test (set! (with-let) 1) 'error)
+(test (set! (with-let (curlet)) 1) 'error)
+
+(test (let ((a3 (inlet 'a 1))) (define (func) (procedure? (a3 ':abs))) (func)) #t)
+(test (let ((a3 (inlet 'a 1))) (define (func) (procedure? (a3 :abs))) (func)) #t)
+(test (let ((a3 (inlet 'a 1))) (define (func) (procedure? (a3 'abs))) (func)) #t)
+(test (let ((a3 (inlet 'a 1)) (asdf :abs)) (define (func) (procedure? (a3 asdf))) (func)) #t)
+(test (let ((a3 (inlet 'a 1)) (asdf abs)) (define (func) (procedure? (a3 asdf))) (func)) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (let->list arg) 'error))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i pi () #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1))))
+
+(for-each
+ (lambda (arg)
+   (test (openlet arg) 'error)
+   (test (coverlet arg) 'error))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i pi abs macroexpand () #<eof> #<unspecified> #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1))))
+
+(test (coverlet (rootlet)) 'error)
+
+(let ()
+  (let ((_xxx_ 0))
+    (let ((e (curlet)))
+      (for-each
+       (lambda (arg)
+	 (let-set! e '_xxx_ arg)
+	 (test (let-ref e '_xxx_) arg))
+       (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i pi abs macroexpand () #<eof> #<unspecified> #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1)))))))
+
+(test (let-ref) 'error)
+(test (let-ref (curlet)) 'error)
+(test (let-ref a b c) 'error)
+(test (let-ref (sublet ()) '_asdf_) #<undefined>)
+(test (let-ref (sublet () '(a . 3)) 'a) 3)
+(test (let-ref (sublet () '(a . 3)) 'A) #<undefined>)
+(test (let-ref (rootlet) '+) +)
+(test (let-ref (rootlet) +) 'error)
+(test (let-ref () '+) 'error)
+(test (let-ref (funclet (let ((a 2)) (lambda (b) (+ a b)))) 'a) 2)
+(test (#_let-ref  (lambda* ((a 1) (b 2)) (+ a b)) else) else)
+
+(let ((etest (let ((a 2)) (lambda (b) (+ a b)))))
+  (let-set! (funclet etest) 'a 32)
+  (test (etest 1) 33))
+(test (let-set!) 'error)
+(test (let-set! a b) 'error)
+(let ((e (inlet 'a 1))) (test (let-set! e 'b 2) 'error))
+(let ((e (inlet (cons 'a 1))))
+  (define (eref a) (e a))
+  (define (eset a b) (set! (e a) b))
+  (for-each
+   (lambda (arg)
+     (test (let-ref arg 'a) 'error)
+     (test (let-set! arg 'a 1) 'error)
+     (test (let-ref e arg) 'error)
+     (test (let-set! e arg #f) 'error)
+     (test (e arg) 'error)
+     (test (set! (e arg) #f) 'error)
+     (test (eref arg) 'error)
+     (test (eset (e arg) #f) 'error))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i pi () #<eof> #<unspecified> #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1)))))
+
+(test (let () (define (func) (set! (let-ref) (vector))) (func))'error)
+(test (let ((L (inlet 'a 1))) (define (func) (set! (let-ref) L :a (vector))) (func)) 'error)
+(test (let ((L (inlet 'a 1))) (define (func) (set! (let-ref L) (vector))) (func)) 'error)
+(test (catch #t
+	(lambda ()
+	  (let ((x #f))
+	    (let-temporarily ((x 1))
+	      (set! (setter 'x) (macro (a b . c)
+				  `(list ,a ,b ,c))))))
+	(lambda (type info)
+	  (apply format #f info)))
+      "implicit let-ref needs a symbol to lookup: ((inlet 'x 1))")
+
+(let () (define (ft) (let ((a (vector #f)) (b 0)) (*s7* (vector-ref a b)))) (test (ft) 'error))
+
+(let ()
+  (define f2
+    (let ((plus1 (lambda (x) (* x 2)))) ; "p0"
+      (let ((L (inlet 'plus1 (lambda (x) (if (< x 3) (plus1 (+ x 1)) x))))) ; "p1" calls "p0"
+	(lambda ()
+	  (with-let L (plus1 2)))))) ; "p1"
+
+  (test (f2) 6))
+
+(let ()
+  (define (f5)
+    (let ((L (inlet 'a 1))
+	  (H (hash-table 'a 2))
+	  (res ()))
+      (do ((i 0 (+ i 1)))
+	  ((= i 1) (reverse res))
+	(set! res (cons (L 'a) res))
+	(set! L H)
+	(set! res (cons (L 'a) res)))))
+
+  (test (f5) '(1 2))
+
+  (define (f6)
+    (let ((L (inlet 'a 1))
+	  (V (vector 2))
+	  (res ()))
+      (do ((i 0 (+ i 1)))
+	  ((= i 1) (reverse res))
+	(set! res (cons (L 'a) res))
+	(set! L V)
+	(set! res (cons (L 'a) res)))))
+
+  (test (f6) 'error))
+
+(test (inlet :a 1) (inlet (cons 'a 1)))
+(test (inlet :a 1 :b 2) (inlet 'a 1 'b 2))
+(test (inlet 'pi 3.0) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (openlet? arg) #f))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () abs macroexpand #<eof> #<unspecified> #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1))))
+
+(test (openlet) 'error)
+(test (openlet 1 2) 'error)
+(test (openlet?) 'error)
+(test (openlet? 1 2) 'error)
+(test (openlet (rootlet)) 'error)
+
+(test (catch #t (lambda () (openlet 3) #f) (lambda (type info) type)) 'wrong-type-arg)
+(test (openlet ()) 'error)
+(test (catch #t (lambda () (openlet (rootlet)) #f) (lambda (type info) type)) 'out-of-range)
+
+(let ((e (openlet (inlet 'a 1))))
+  (test (openlet? (sublet e '(b . 2))) #t))
+(let ()
+  (let ((f (lambda (x) (+ x 1))))
+    (test (openlet? f) #f)
+    (openlet f)
+    (test (openlet? f) #t)
+    (coverlet f)
+    (test (openlet? f) #f))
+
+  (let ((f (lambda* (x) (+ x 1))))
+    (test (openlet? f) #f)
+    (openlet f)
+    (test (openlet? f) #t)
+    (coverlet f)
+    (test (openlet? f) #f))
+
+  (let ((f (sublet ())))
+    (test (openlet? f) #f)
+    (openlet f)
+    (test (openlet? f) #t)
+    (coverlet f)
+    (test (openlet? f) #f))
+
+  (let ((e1 (openlet (inlet 'f1 (define-macro (f1 a) `(+ ,a 1))))))
+    (test ((e1 'f1) 3) 4))
+
+  (let ()
+    (define-macro (f x) `(+ ,x 1))
+    (test (openlet? f) #f)
+    (test (openlet f) f)
+    (test (openlet? f) #t)
+    (test (coverlet f) f))
+
+  (let ()
+    (define-bacro* (f x) `(+ ,x 1))
+    (test (openlet? f) #f)
+    (test (openlet f) f)
+    (test (openlet? f) #t)
+    (test (coverlet f) f))
+  )
+(test (with-let (openlet (sublet (curlet) 'let-set-fallback (lambda (obj key val) 32))) (set! basf (* 2 3))) 32)
+(test (let () (define (f2) (do ((i 0 (+ i 1))) ((= i 2)) (with-let (openlet (sublet (curlet) 'let-set-fallback (lambda (obj key val) 32))) (set! basf (* 2 3))))) (f2) (f2)) #t)
+
+(let () ; inspired by bug-guile
+  (define p0 (openlet (inlet 'method (lambda (x) (+ x 1)))))
+  (define p1 (openlet (sublet p0 'value 32)))
+  (test ((p0 'method) (p1 'value)) 33)
+  (let-set! p0 'method (lambda (x) (set! x (+ x 1)) (+ x 1)))
+  (test ((p0 'method) (p1 'value)) 34)
+  (test ((p1 'method) (p1 'value)) 34) ; same thing -- (outlet p1) == p0
+  (define p2 (openlet (sublet p0 'value 3)))
+  (test ((p2 'method) (p2 'value)) 5)) ; (p0 'method) is the same
+
+(let () ; setf-method
+  (define f9 (dilambda
+	      (lambda (x)
+		(if (let? x)
+		    ((x 'f9) x)
+		    (+ x 1)))
+	      (lambda (x y)
+		(if (let? x)
+		    ((x 'set-f9) x y)
+		    (error 'oops "no set!")))))
+  (define (f9-1)
+    (let ((obj (openlet (inlet 'value -1
+			       'f9 (lambda (x)
+				     (+ (x 'value) 1))
+			       'set-f9 (lambda (x y)
+					 (set! (x 'value) y))))))
+      (test (f9 obj) 0)
+      (set! (f9 obj) 32)
+      (test (f9 obj) 33)))
+  (f9-1)
+
+  (define (f10)
+    (let ((obj (openlet (inlet 'value -1
+	  		       'abs (lambda (x)
+				      (magnitude (x 'value)))
+			       'set-abs (lambda (x y)
+					  (set! (x 'value) y))))))
+      (set! (setter abs)
+	    (lambda (x y)
+	      (if (let? x)
+		  ((x 'set-abs) x y)
+		  'oops)))
+      (test (abs obj)1)
+      (set! (abs obj) 32)
+      (test (abs obj) 32)))
+  (f10)
+  (set! (setter abs) #f))
+
+(let () ; let_set_p_ppp_2 from snd-test.scm
+  (define (fv157)
+    (do ((g0 (inlet 'a 0 'b 1 'c 2 'd 3))
+	 (syms (vector 'a 'b 'c 'd))
+	 (v (inlet 'a -1 'b -1 'c -1 'd -1))
+	 (i 0 (+ i 1)))
+	((= i 4) v)
+      (set! (v (syms i)) (g0 (syms i)))))
+    (test (fv157) (inlet 'a 0 'b 1 'c 2 'd 3)))
+
+(test (curlet 1) 'error)
+(test (rootlet 1) 'error)
+(test (unlet 1) 'error)
+(test (set! (curlet) 1) 'error)
+(test (set! (rootlet) 1) 'error)
+(test (set! (unlet) 1) 'error)
+(test (let () (set! unlet 2)) 'error)
+(test (let ((unlet 2)) unlet) 'error)
+
+(test (let ((e (sublet () '(a . 1)))) ((lambda (x) (x *)) e)) 'error)
+(test (let ((e (sublet () '(a . 1)))) ((lambda (x) (x pi)) e)) 'error)
+(test (let () (sublet () (cons pi 1))) 'error)
+(test (let () (sublet () (cons "hi" 1))) 'error)
+(test (let () (varlet () (cons pi 1))) 'error)
+(test (let () (varlet () (cons "hi" 1))) 'error)
+(test (catch 'wrong-type-arg
+	(lambda ()
+	  (define-constant asdf 1)
+	  (varlet (curlet) 'asdf 3)
+	  asdf)
+	(lambda (t info)
+	  (apply format #f info)))
+      "varlet second argument, asdf, is a symbol but should be a non-constant symbol") ; argnum is what we're trying to check here
+(test (varlet (inlet 'a 1) (rootlet)) (inlet 'a 1))
+
+(test (let ((lt (openlet (inlet 'x (list 1 2 3) 'make-iterator (let ((+iterator+ #t)) (lambda (e) (#_make-iterator (e 'x)))))))) (format #f "~{~A~^ ~}" lt)) "1 2 3")
+(unless pure-s7 (test (let ((lt (openlet (inlet 'x (list 1 2 3) 'let->list (lambda (e) (e 'x)))))) (format #f "~{~A~^ ~}" lt)) "1 2 3"))
+
+(test (eq? (rootlet) ()) #f)
+(test (eq? (rootlet) (rootlet)) #t)
+(test (eq? (rootlet) (unlet)) #f)
+(test (eqv? (rootlet) (rootlet)) #t)
+(test (eqv? (rootlet) (unlet)) #f)
+(test (equal? (rootlet) (rootlet)) #t)
+(test (equal? (rootlet) (unlet)) #f)
+;(test (equal? (curlet) (unlet)) #f)
+(let ((e #f) (g #f))
+  (set! e (curlet))
+  (set! g (rootlet))
+  (if (not (equal? e (curlet))) ; test here introduces a new environment
+      (format #t ";(equal? e (curlet)) -> #f?~%"))
+  (test g (rootlet))
+  (test (equal? e g) #f)
+  (let ()
+    (if (not (equal? e (curlet)))
+	(format #t ";2nd case (equal? e (curlet)) -> #f?~%"))))
+
+(let ()
+  (define global-env (rootlet))
+  (test (equal? global-env (rootlet)) #t)
+  (test (equal? (list global-env) (list (rootlet))) #t)
+  (test (equivalent? global-env (rootlet)) #t)
+  (test (equivalent? (list global-env) (list (rootlet))) #t))
+
+(test (pair? (member (let ((a 1) (b 2)) (map cdr (curlet))) '((1 2) (2 1)))) #t)
+(test (let () (map cdr (curlet))) ())
+(test (pair? (member (let ((vals ())) (let ((a 1) (b 2)) (for-each (lambda (slot) (set! vals (cons (cdr slot) vals))) (curlet))) vals) '((2 1) (1 2)))) #t)
+(test (let ((a '(1 2 3)) (b '(3 4 5)) (c '(6 7 8))) (map + a b c (apply values (map cdr (curlet))))) '(20 26 32))
+(test (pair? (member (let ((a 1) (b 2) (c 3)) (map (lambda (a b) (+ a (cdr b))) (list 1 2 3) (curlet))) '((2 4 6) (4 4 4)))) #t)
+
+(test (let () (format #f "~A" (curlet))) "(inlet)")
+;(test (let ((a 32) (b '(1 2 3))) (format #f "~A" (curlet))) "(inlet)")
+;(test (let ((a 1)) (object->string (curlet))) "(inlet)")
+(test (let ((a 1)) (object->string (rootlet))) "(rootlet)")
+(test (format #f "~A" (rootlet)) "(rootlet)")
+(test (let ((a 32) (b #(1 2 3))) (format #f "~{~A~^ ~}" (curlet))) "(a . 32) (b . #(1 2 3))")
+
+(test (object->string (rootlet)) "(rootlet)")
+(test (let () (object->string (curlet))) "(inlet)")
+(test (let ((a 3)) (object->string (curlet))) "(inlet 'a 3)")
+(test (let ((a 3) (b "hi")) (object->string (curlet))) "(inlet 'a 3 'b \"hi\")")
+(let ()
+  (define (hi a b) (curlet))
+  (let ((str (object->string (hi 3 4))))
+    (or (string=? str "(inlet 'a 3 'b 4)")
+	(string=? str "(inlet 'b 4 'a 3)"))))
+
+(test (let () (varlet (unlet) (cons 'a 32)) (symbol->value 'a (unlet))) #<undefined>)
+(test (let ((abs 32)) (with-let (unlet) (abs -1))) 1)
+(test (let ((caar 123)) (+ caar (with-let (unlet) (caar '((2) 3))))) 125)
+(test (let ()
+	(+ (let ((caar 123))
+	     (+ caar (with-let (unlet)
+                       (let ((val (caar '((2) 3))))
+			 (set! caar -1)
+			 (+ val caar))))) ; 124
+	   (let ((caar -123))
+	     (+ caar (with-let (unlet)
+                       (let ((val (caar '((20) 3))))
+			 (set! caar -2)
+			 (+ val caar))))) ; -105
+	   (caar '((30) 3)))) ; 30 + 19
+      49)
+
+(test (let ((a 1)) (eval '(+ a b) (sublet (curlet) (cons 'b 32)))) 33)
+(test (let ((a 1)) (+ (eval '(+ a b) (sublet (curlet) (cons 'b 32))) a)) 34)
+(test (let ((a 1)) (+ (eval '(+ a b) (sublet (curlet) (cons 'b 32) (cons 'a 12))) a)) 45)
+(test (let ((a 2)) (eval '(+ a 1) (sublet (curlet)))) 3)
+(test (let ((a 1)) (+ (eval '(+ a b) (sublet (sublet (curlet) (cons 'b 32)) (cons 'a 12))) a)) 45)
+(test (eval (list + 'a (eval (list - 'b) (sublet (unlet) (cons 'b 1))))
+	    (sublet (unlet) (cons 'a 2)))
+      1)
+
+#|
+;;; this checks each procedure call against its signature -- it could be simplified to check just one procedure
+(define (setup-check-sig)
+
+  (define (check-sig sym sig arg args)
+    ;; signature can be #t, values, a symbol=type desired, or a list of these.  We ignore #t and values before calling check-sig.
+    (if (#_symbol? sig)
+	((#_with-let (#_unlet) (symbol->value sig)) arg) ; "unlet" in pretty-print?
+	(if (#_pair? sig)
+	    (#_call-with-exit
+	     (lambda (return)
+	       (#_for-each
+		(lambda (checker)
+		  (if ((#_with-let (#_unlet) (symbol->value checker)) arg)
+		      (return #t)))
+		sig)
+	       #f))
+	    (#_format *stderr* "~S for ~S if (~S ~{~^ S~}~%" arg sig sym args))))
+
+  ;; redefine all the built-in procedures (so this code gradually clobbers rootlet as it runs)
+  (#_for-each
+   (lambda (sym)
+     (let ((x (#_symbol->value sym)))
+       (when (and (#_procedure? x)
+		  (#_signature x)
+		  (#_not (#_immutable? sym)) ; unlet etc
+		  (#_not (#_memq sym '(values setup-check-sig check-sig))))
+	 (apply set! sym
+		(#_list (let ((old-x x))
+			  (lambda args
+			    (#_catch #t ; this messes with outside error handling -- it's probably also unnecessary
+			      (lambda ()
+				(let ((result (#_apply old-x args))
+				      (sig (#_signature old-x)))
+
+				  ;; check result against (car signature)
+				  (unless (#_memq (#_car sig) '(#t values))
+				    (let ((sig-result (check-sig sym (#_car sig) result args)))
+				      (if (#_not sig-result)
+					  (#_format *stderr* "(~S~{~^ ~$~}) -> ~$ (~S) but sig: ~S~%" sym args result (#_type-of result) (#_car sig)))))
+
+				  ;; check args against (cdr signature)
+				  (#_for-each
+				   (lambda (arg-sig arg)
+				     (unless (#_memq arg-sig '(#t values))
+				       (let ((sig-result (check-sig sym arg-sig arg args)))
+					 (if (#_not sig-result)
+					     (#_format *stderr* "(~S~{~^ ~$~}) arg ~$ (~S) -> ~$ but sig: ~S~%" sym args arg (#_type-of arg) result arg-sig)))))
+				   (#_cdr sig)
+				   args)
+
+				  ;; return function result
+				  result))
+			      (lambda (type info)
+				#f)))))))))
+   ;; this does not fixup any preset setter (current-output-port for example)
+   (symbol-table)))
+|#
+
+(let ((e (openlet  ; make it appear to be empty to the rest of s7
+  (inlet 'object->string    (lambda args "(inlet)")
+	 'map               (lambda args ())
+	 'for-each          (lambda args #<unspecified>)
+	 'let->list         (lambda args ())
+	 'length            (lambda args 0)
+	 'copy              (lambda args (inlet))
+	 'open              #t
+	 'coverlet          (lambda (e) (set! (e 'open) #f) e)
+	 'openlet           (lambda (e) (set! (e 'open) #t) e)
+	 'openlet?          (lambda (e) (e 'open))
+	 ;; your secret data here
+	 'secret            'gray-cat
+	 ))))
+  (test (object->string e) "(inlet)")
+  ;(test (map values e) ())
+  (unless pure-s7 (test (let->list e) ()))
+  (test (length e) 0)
+  (test (object->string (copy e)) "(inlet)")
+  (coverlet e)
+  (test (object->string e) "(inlet)")
+  (test (openlet? e) #f)
+  (openlet e)
+  (test (openlet? e) #t))
+
+(let ()
+  (define (lets . args)
+    (apply sublet () args))
+  (let ((e (lets '(a . 1) '(b . 2))))
+    (test (eval '(+ a b 3) e) 6)))
+
+;(test (eval 'a (sublet () '(a . 1) '(a . 2))) 'error) ; no longer an error, mainly for repl's convenience
+;(test (eval 'a (varlet () '(a . 1) '(a . 2))) 'error)
+(test (eval 'pi (sublet () '(pi . 1) '(a . 2))) 'error)
+(test (eval 'pi (varlet () '(pi . 1) '(a . 2))) 'error)
+(test (eval 'pi (sublet () (cons 'pi pi))) 'error) ; changed 25-Jun-14
+(test (eval 'pi (varlet () (cons 'pi pi))) 'error)
+(test (map (sublet () '(asdf . 32) '(bsdf . 3)) '(bsdf asdf)) '(3 32))
+(test (equal? (map (rootlet) '(abs cons car)) (list abs cons car)) #t)
+
+(test (with-let (sublet (inlet) '(a . 1)) a) 1)
+(test (with-let (sublet (inlet '(b . 2)) '(a . 1)) (+ a b)) 3)
+(test (with-let (sublet () (inlet) '(a . 1)) a) 1)
+(test (with-let (sublet () (inlet '(b . 2)) '(a . 1)) (+ a b)) 3)
+(test (with-let (sublet (inlet '(b . 2) '(c . 3)) '(a . 1)) (+ a b c)) 6)
+
+(let ()
+  (define (e1) (let ((e (curlet))) (with-let e 0)))
+  (define (e2 a) (let ((e (curlet))) (with-let e a)))
+  (define (e3) (let ((e (curlet))) (with-let e 1 . 2)))
+  (define (e4) (let ((e (curlet))) (with-let e 0 1)))
+  (define (e5) (let ((e (curlet))) (with-let e (+ 1 2) (+ 2 3))))
+  (test (e2 10) 10) (e1)
+  (test (e1) (e2 0))
+  (test (e3) 'error) (e4)
+  (test (e4) 1) (e5)
+  (test (e5) 5))
+
+(let ()
+  (define-constant _a_constant_ 32)
+  (test (eval '_a_constant_ (sublet () (cons '_a_constant_ 1))) 'error)
+  (test (eval '_a_constant_ (sublet () (cons '_a_constant_ 32))) 'error))
+
+(test (let ((a 1)) (eval-string "(+ a b)" (sublet (curlet) (cons 'b 32)))) 33)
+(test (let ((a 1)) (+ (eval-string "(+ a b)" (sublet (curlet) (cons 'b 32))) a)) 34)
+(test (let ((a 1)) (+ (eval-string "(+ a b)" (sublet (curlet) (cons 'b 32) (cons 'a 12))) a)) 45)
+(test (let ((a 2)) (eval-string "(+ a 1)" (sublet (curlet)))) 3)
+(test (let ((a 1)) (+ (eval-string "(+ a b)" (sublet (sublet (curlet) (cons 'b 32)) (cons 'a 12))) a)) 45)
+(test (eval-string (string-append "(+ a " (number->string (eval (list - 'b) (sublet (unlet) (cons 'b 1)))) ")")
+		   (sublet (unlet) (cons 'a 2)))
+      1)
+
+(test (sublet) 'error)
+(for-each
+ (lambda (arg)
+   (test (sublet arg '(a . 32)) 'error)
+   (test (varlet arg '(a . 32)) 'error))
+ (list -1 #\a 1 3.14 3/4 1.0+1.0i "hi" 'hi #() #f _ht_ _undef_ _null_ _c_obj_))
+
+(let ((e (sublet (curlet)
+			      (cons 'a 32)
+			      (cons 'b 12))))
+  (test (eval '(+ a b) e) 44)
+  (test (eval '(+ a b c) (sublet e (cons 'c 3))) 47)
+  (test (eval '(+ a b) (sublet e (cons 'b 3))) 35)
+  (test (eval-string "(+ a b)" e) 44)
+  (test (eval-string "(+ a b c)" (sublet e (cons 'c 3))) 47)
+  (test (eval-string "(+ a b)" (sublet e (cons 'b 3))) 35)
+  )
+
+(test (with-let (sublet () '(a . 1)) (defined? 'a)) #t)
+(test (defined? 'a (sublet () '(a . 1))) #t)
+(test (defined? 'b (sublet () '(a . 1))) #f)
+(test (defined? 'a '((a . 1))) 'error)
+(test (defined? 'a '((a . 1) 2)) 'error)
+(test (defined? 'a (sublet ())) #f)
+
+(test (symbol->value 'a (sublet () '(a . 1))) 1)
+(test (symbol->value 'b (sublet () '(a . 1))) #<undefined>)
+(test (symbol->value 'a '((a . 1))) 'error)
+(test (symbol->value 'a '((a . 1) 2)) 'error)
+
+(test (eval 'a (sublet () '(a . 1))) 1)
+(test (eval 'a (sublet () '(b . 1))) 'error)
+(test (eval 'a '((a . 1))) 'error)
+(test (eval 'a '((a . 1) 2)) 'error)
+
+(test (eval-string "a" (sublet () '(a . 1))) 1)
+(test (eval-string "a" (sublet () '(b . 1))) 'error)
+(test (eval-string "a" '((a . 1))) 'error)
+(test (eval-string "a" '((a . 1) 2)) 'error)
+
+(test (with-let (sublet () '(a . 1)) a) 1)
+(test (with-let (sublet ()) 1) 1)
+(test (with-let (sublet () '(b . 1)) a) 'error)
+(test (with-let '((a . 1)) a) 'error)
+(test (with-let '((a . 1) 2) a) 'error)
+(test (let ((a 1)) (set! ((curlet) 'a) 32) a) 32)
+(test (with-let (inlet '+ -) (+ 2 3)) -1) ; from s7.html
+
+(for-each
+ (lambda (arg)
+   (test (sublet (curlet) arg) 'error)
+   (test (varlet (curlet) arg) 'error))
+ (list -1 #\a #(1 2 3) 3.14 3/4 1.0+1.0i 'hi "hi" abs #(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+
+(test (with-let (curlet) (let ((x 1)) x)) 1)
+(test (let (( x 1)) (with-let (curlet) (set! x 2)) x) 2)
+
+(let ()
+  (define (hi)
+    (let ((e (sublet (curlet)
+	       (cons 'abs (lambda (a) (- a 1))))))
+      (with-let e
+	(abs -1))))
+  (test (hi) -2)
+  (test (hi) -2)
+  (test (let ((e (sublet (curlet)
+		   (cons 'abs (lambda (a) (- a 1))))))
+	  (with-let e
+	    (abs -1)))
+	-2))
+
+(test (let ((x 12))
+	(let ((e (curlet)))
+	  (let ((x 32))
+	    (with-let e (* x 2)))))
+      24)
+
+(test (let ((e #f)) (let ((x 2) (y 3)) (set! e (curlet))) (let ((x 0) (y 0)) (with-let e (+ x y)))) 5)
+(test (let ((e #f)) (let () (define (func a b) (set! e (curlet)) (+ a b)) (func 1 2)) (with-let e (+ a b))) 3)
+(test (let ((e #f)
+	    (f #f))
+	(let ()
+	  (define (func a b)
+	    (set! e (curlet))
+	    (+ a b))
+	  (set! f func)
+	  (func 1 2))
+	(let ((val (with-let e (+ a b))))
+	  (f 3 4)
+	  (list val (with-let e (+ a b)))))
+      '(3 7))
+
+(test (with-let) 'error)
+(test (with-let 1) 'error)
+(test (with-let () 1) 'error)
+(test (with-let (curlet)) 'error) ; ?? perhaps this should be #<unspecified> but it's like (let) = error
+(test (outlet) 'error)
+(test (outlet (curlet) #f) 'error)
+(test (eq? (outlet (rootlet)) (rootlet)) #t)
+(test (set! (outlet (curlet)) #f) 'error)
+(test (set! (outlet (curlet)) ()) 'error)
+(test (set! (outlet) #f) 'error)
+(test (let? (set! (outlet (inlet)) (rootlet))) #t)
+(test (set! (outlet (inlet)) (rootlet)) (rootlet))
+(test (set! (outlet (inlet 'a 1)) 32) 'error)
+
+(test (object->string (let ((a 1)) (immutable! 'a) (curlet)) :readable) "(let ((a 1)) (immutable! 'a) (curlet))")
+(test (object->string (let ((a 1)) (set! (setter 'a) integer?) (curlet)) :readable)
+      "(let ((a 1)) (set! (setter 'a) #_integer?) (curlet))")
+(test (object->string (let ((a 1)) (set! (setter 'a) (lambda (s v) (integer? v))) (curlet)) :readable)
+      "(let ((a 1)) (set! (setter 'a) (lambda (s v) (integer? v))) (curlet))")
+(test (let ((L (immutable! (inlet 'a 1 'b #(1 2 3))))) (object->string L :readable)) "(immutable! (inlet :a 1 :b (vector 1 2 3)))")
+
+(let ()
+  (test (let ()
+	  (set! (outlet (curlet))
+		(let ((a 1)
+		      (b 2))
+		  (set! (outlet (curlet)) (rootlet))
+		  (curlet)))
+	  (+ a b))
+	3))
+;; equivalent to (let ((a 1) (b 2)) (let () (curlet)))
+;;   that is, we've turned the let structure inside out
+
+
+(test (let ()
+	(set! (outlet (curlet)) (rootlet))
+	(eq? (outlet (curlet)) (rootlet)))
+      #t)
+(test (let ((a 1))
+	(let ((b 2))
+	  (set! (outlet (curlet)) (rootlet))
+	  ((curlet) 'a)))
+      #<undefined>)
+(test (let ((a 1)
+	    (e #f))
+	(set! e (curlet))
+	(let ((b 2))
+	  (let ((c 3))
+	    (set! (outlet (curlet)) e)
+	    (and (equal? ((curlet) 'a) 1)
+		 (equal? ((curlet) 'b) #<undefined>)
+		 (equal? ((curlet) 'c) 3)
+		 (equal? (outlet (curlet)) e)))))
+      #t)
+
+(for-each
+ (lambda (arg)
+   (test (with-let arg #f) 'error)
+   (test (outlet arg) 'error)
+   (test (set! (outlet (curlet)) arg) 'error))
+ (list -1 () #\a #(1 2 3) 3.14 3/4 1.0+1.0i 'hi "hi" #(()) (list 1 2 3) '(1 . 2)))
+
+(test (with-let (sublet (sublet (rootlet)) '(a . 1)) 1) 1)
+(test (with-let (sublet (sublet (rootlet)) '(a . 1)) a) 1)
+(test (with-let (curlet) 1) 1)
+(test (let ((a 1))
+	(+ (with-let
+	    (sublet (curlet) (cons 'a 10))
+	    a)
+	   a))
+      11)
+(test (let ((a 1))
+	(+ (with-let
+	    (sublet (curlet) (cons 'a 10))
+	    (+ a
+	       (with-let
+		(sublet (curlet) (cons 'a 100))
+		a)))
+	   a))
+      111)
+(test (let ((a 1))
+	(+ (with-let
+	    (sublet (curlet) (cons 'a 10))
+	    (+ a
+	       (with-let
+		(sublet (curlet) (cons 'b 100))
+		a)))
+	   a))
+      21)
+(test (let ((a 1))
+	(let ((e (curlet)))
+	  (+ (with-let
+	      (sublet (curlet) (cons 'a 10))
+	      (+ a
+		 (with-let e a)))
+	   a)))
+      12)
+(test (let ((a 1))
+	(let ((e (curlet)))
+	  (+ (with-let
+	      (varlet (sublet (curlet) (cons 'a 10)) (cons 'a 20))
+	      (+ a
+		 (with-let e a)))
+	   a)))
+      22)
+; (test (= ((inlet 'a 1 'a 2) 'a) (with-let (inlet 'a 1 'a 2) a)) #t) ; undecided...
+(test (= ((varlet (inlet 'a 1) 'a 2) 'a) (with-let (varlet (inlet 'a 1) 'a 2) a)) #t)
+(test (let ((a 1))
+	(+ (with-let
+	    (sublet (curlet) (cons 'a 10))
+	    (+ (let ((b a))
+		 (varlet (curlet) (cons 'a 20))
+		 (+ a b))
+	       a))
+	   a))
+      41)
+
+(test (let ((a 1)) (+ (let ((a 2)) (+ (let ((a 3)) a) a)) a)) 6)
+(test (let ((a 1)) (+ (let () (+ (let ((a 3)) (varlet (outlet (curlet)) '(a . 2)) a) a)) a)) 6)
+(test (let () (let ((a 1)) (varlet (outlet (curlet)) '(a . 2))) a) 2)
+
+(test (let ((a 1))
+	(let ((e (curlet)))
+	  (+ (with-let
+	      (sublet e (cons 'a 10))
+	      (+ a
+		 (with-let e a)))
+	   a)))
+      'error) ; "e" is not in the curlet at the top, so it's not in the nested env
+
+(test (let ((x 3))
+	(varlet (curlet)
+          (cons 'y 123))
+	(+ x y))
+      126)
+#|
+;; can't decide about these -- safe closures prebuild the funclet from the arglist so two of these fail
+(test (let ()
+	(define (hiho a) (+ a b))
+	(varlet (funclet hiho) (cons 'b 21))
+	(hiho 1))
+      22)
+
+(test (let ()
+	(define hiho (let ((x 32)) (lambda (a) (+ a x b))))
+	(varlet (funclet hiho) (cons 'b 10) (cons 'x 100))
+	(hiho 1))
+      111)
+
+(test (let ()
+	(define hiho (let ((x 32)) (lambda* (a) (+ a x b))))
+	(varlet (funclet hiho) (cons 'b 10) (cons 'x 100))
+	(hiho 1))
+      111)
+
+(test (let ()
+	(define hiho (let ()
+		       (define (hi b)
+			 (+ b 1))
+		       (lambda (a)
+			 (hi a))))
+	(varlet (funclet hiho) (cons 'hi (lambda (b) (+ b 123))))
+	(hiho 2))
+      125)
+|#
+
+(test (let () ; here's one way for multiple functions to share a normal scheme closure
+	(define f1 (let ((x 23))
+		     (lambda (a)
+		       (+ x a))))
+	(define f2
+	  (with-let (outlet (funclet f1)) ; outlet is needed as of 28-Feb-16
+            (lambda (b)
+	      (+ b (* 2 x)))))
+	(+ (f1 1) (f2 1)))
+      71)
+
+
+(test (varlet) 'error)
+(test (sublet 3) 'error)
+(test (varlet 3) 'error)
+
+(test (let ((e (curlet))) (let? e)) #t)
+(test (let ((f (lambda (x) (let? x)))) (f (curlet))) #t)
+(test (let ((e (varlet () '(a . 1)))) (let? e)) #t)
+(test (let ((e (varlet () '(a . 1)))) ((lambda (x) (let? x)) e)) #t)
+(test (let? ((lambda () (curlet)))) #t)
+(test (let? ((lambda (x) x) (curlet))) #t)
+(test (let ((e (let ((x 32)) (lambda (y) (let ((z 123)) (curlet))))))
+	(eval `(+ x y z) (e 1)))
+      156)
+(test (let ((e #f)) (set! e (let ((x 32)) (lambda (y) (let ((z 123)) (funclet e)))))
+	   (eval `(+ x 1) (e 1)))
+      33)
+
+(test (let () ((curlet) 'abs)) abs) ; was #<undefined>)??
+(test ((rootlet) 'abs) abs)
+
+(test (catch #t
+	     (lambda ()
+	       (with-let (curlet)
+		 (error 'testing "a test")
+		 32))
+	     (lambda args (car args)))
+      'testing)
+(test (call-with-exit
+       (lambda (go)
+	 (with-let (curlet)
+	   (go 1)
+	   32)))
+      1)
+
+(test (let ((x 0))
+	(call-with-exit
+	 (lambda (go)
+	   (with-let (varlet (curlet) (cons 'x 123))
+            (go 1))))
+	x)
+      0)
+(test (let ((x 1))
+	(+ x (call-with-exit
+	      (lambda (go)
+		(with-let (varlet (curlet) (cons 'x 123))
+                  (go x))))
+	   x))
+      125)
+
+(test (let ((x 0))
+	(catch #t
+          (lambda ()
+	    (with-let (varlet (curlet) (cons 'x 123))
+              (error 'oops) x))
+	  (lambda args x)))
+      0)
+
+(let ((a 1))
+  (test ((curlet) 'a) 1)
+  (set! ((curlet) 'a) 32)
+  (test ((curlet) 'a) 32))
+
+(let () (test (equal? (curlet) (rootlet)) #f))
+(test (let ((a 1)) (let ((e (curlet))) (set! (e 'a) 2)) a) 2)
+(let () (define (hi e) (set! (e 'a) 2)) (test (let ((a 1)) (hi (curlet)) a) 2))
+(let () (define (hi) (let ((a 1)) (let ((e (curlet)) (i 'a)) (set! (e i) #\a)) a)) (hi) (hi) (test (hi) #\a))
+
+(let ((e1 #f) (e2 #f))
+  (let ((a 1)) (set! e1 (curlet)))
+  (let ((a 1)) (set! e2 (curlet)))
+  (test (equal? e1 e2) #t)
+  (test (eqv? e1 e2) #f))
+
+(let ((e1 #f) (e2 #f))
+  (let ((a 1)) (set! e1 (curlet)))
+  (let ((a 2)) (set! e2 (curlet)))
+  (test (equal? e1 e2) #f))
+
+(let ((e1 #f) (e2 #f))
+  (let ((a 1)) (set! e1 (curlet)))
+  (let ((a 1) (b 2)) (set! e2 (curlet)))
+  (test (equal? e1 e2) #f))
+
+(let ((e1 #f) (e2 #f))
+  (let ((a 1) (b 2)) (set! e1 (curlet)))
+  (let ((a 1) (b 2)) (set! e2 (curlet)))
+  (test (equal? e1 e2) #t))
+
+(let ((e1 #f) (e2 #f))
+  (let () (set! e1 (curlet)))
+  (let ((a 1)) (set! e2 (curlet)))
+  (test (equal? e1 e2) #f))
+
+(test (let ((a #(1 2 3))) ((curlet) 'a 1)) 2)
+(test (let ((a #(1 2 3))) (let ((e (curlet))) ((curlet) 'e 'a 1))) 2)
+
+(let ((x (openlet (inlet 'let-ref-fallback (lambda args args)))))
+  (test (x) 'error)
+  (test (x 1) (list x 1))
+  (varlet x 'let-ref-fallback (lambda (s v) 32))
+  (test (x 1) 32)
+  (test (cutlet x 'let-ref-fallback) 'error))
+(let ((x (openlet (inlet 'let-ref-fallback (lambda args args)))))
+  (let ((y (copy x)))
+    (test (y 1) (list y 1))))
+(let ((x (openlet (inlet 'a 1))))
+  (varlet x 'let-ref-fallback (lambda (s v) 32))
+  (test (x 'a) 1)
+  (test (x 'b) 32))
+(let ((x (openlet (inlet 'a 1))))
+  (test (x 'a) 1)
+  (test (x 'b) #<undefined>)
+  (varlet x (openlet (inlet 'let-ref-fallback (lambda (s v) 32))))
+    (test (x 'a) 1)
+    (test (x 'b) 32))
+
+(test ((inlet :a 1)) 'error)
+
+(let ()
+  (define (f1)
+    (let ((v (vector #f)) (X 0))
+      (do ((i 0 (+ i 1))) ((= i 1) v)
+	(vector-set! v 0 (let-ref X 'a)))))
+  (test (f1) 'error))
+
+(let ((x '(a)))
+  (let ((x '(c)))
+    x)
+  (let ((x '(b)))
+    (define (transparent-memq sym var e)
+      (let ((val (symbol->value var e)))
+	(or (and (pair? val)
+		 (memq sym val))
+	    (and (not (eq? e (rootlet)))
+		 (transparent-memq sym var (outlet e))))))
+    (let ((ce (curlet)))
+      (test (list (transparent-memq 'a 'x ce)
+		  (transparent-memq 'b 'x ce)
+		  (transparent-memq 'c 'x ce))
+	    '((a) (b) #f)))))
+
+(test (let-set! (rootlet) :rest #f) 'error) ; key->sym so this is not a constant
+(test (let-set! (rootlet) 'pi #f) 'error)
+
+(let ((a44 (subvector #i2d((1 2) (3 4))))
+      (bat (bignum 1/2)))
+  (define (func) (do ((x 0.0 (+ x 0.1)) (i 0 (+ i 1))) ((>= x .1) (let-set! a44 bat (integer->char 255)))))
+  (test (func) 'error)) ; op_safe_c_ssa has_fx clear
+
+(let-temporarily ((*#readers*
+		   (cons (cons #\l (lambda (str)
+				     (and (string=? str "let") ; #let(...)
+					  (if (> (*s7* 'safety) 0)
+					      (immutable! (apply inlet (read)))
+					      (apply inlet (read))))))
+			 *#readers*)))
+  (test (eval-string "#let(:a 1)") (inlet :a 1)) ; need eval-string since this is handled at read-time
+  (test (eval-string "#let(:a 1 :b \"asdf\")") (inlet :a 1 :b "asdf")) ; unlike hash-tables, :a and 'a are the same in lets:
+  (test ((inlet :a 1) 'a) 1)
+  (test ((inlet 'a 1) 'a) 1)
+  (test (eval-string "#let(a 1 b 2)") (inlet 'b 2 'a 1))
+  (test (eval-string "#let(a #let(c 1))") (inlet 'a (inlet 'c 1)))
+  (test (eval-string "#lot(:a 1)") 'error) ;attempt to apply a symbol :a to (1) in (:a 1)? because #lot is not handled by the reader
+  (set! *#readers*
+        (cons (cons #\l (lambda (str)
+			  (and (string=? str "lot") ; #let(...)
+			       (apply inlet (read)))))
+	      *#readers*))
+  (test (eval-string "#lot(:a 1)") (inlet 'a 1)))
+
+
+;;; make-type ----------------
+(let ()
+  (define (make-type . args)
+    (let* ((type (gensym "make-type type"))   ; built-in type and value slots have gensym'd names
+	   (value (gensym "make-type value"))
+	   (obj (openlet
+		 (sublet ()
+		   (cons type type)
+		   (cons value #<unspecified>)))))
+
+      ;; load up any methods/slots
+      (do ((arg args (cddr arg)))
+	  ((null? arg))
+	(varlet obj
+			      (cons (keyword->symbol (car arg)) (cadr arg))))
+
+      ;; return a list of '(? make ref) funcs
+      (list (lambda (x)
+	      (and (let? x)
+		   (eq? (x type) type)))
+	    (lambda* (new-value)
+		     (let ((new-obj (copy obj)))
+		       (set! (new-obj value) new-value)
+		       new-obj))
+	    (lambda (x)
+	      (x value)))))
+
+  (define special-value
+    (let ((type (make-type)))
+      ((cadr type) 'special)))
+
+  (test (eq? special-value special-value) #t)
+  (test (eqv? special-value special-value) #t)
+  (test (equal? special-value special-value) #t)
+  (test (procedure? special-value) #f)
+  (for-each
+   (lambda (arg)
+     (test (or (eq? arg special-value)
+	       (eqv? arg special-value)
+	       (equal? arg special-value))
+	   #f))
+   (list "hi" -1 #\a 1 'special 3.14 3/4 1.0+1.0i #f #t '(1 . 2) #<unspecified> #<undefined>))
+
+  (test (let ((obj ((cadr (make-type :type "hi" :value 123)) 0))) (list (obj 'type) (obj 'value))) '("hi" 123))
+  (test (let ((obj ((cadr (make-type :type "hi" :value 123))))) (list (obj 'type) (obj 'value))) '("hi" 123))
+
+  (test (let* ((rec-type (make-type))
+	       (? (car rec-type))
+	       (make (cadr rec-type))
+	       (ref (caddr rec-type)))
+	  (let ((val-1 (make "hi")))
+	    (let ((val-2 (make val-1)))
+	      (let ((val-3 (make val-2)))
+		(ref (ref (ref val-3)))))))
+	"hi")
+
+  (test (let* ((rec1-type (make-type))
+	       (?1 (car rec1-type))
+	       (make1 (cadr rec1-type))
+	       (ref1 (caddr rec1-type)))
+	  (let* ((rec2-type (make-type))
+		 (?2 (car rec2-type))
+		 (make2 (cadr rec2-type))
+		 (ref2 (caddr rec2-type)))
+	    (let ((val-1 (make1 "hi")))
+	      (let ((val-2 (make2 "hi")))
+		(let ((val-3 (make1 val-2)))
+		  (and (string=? (ref2 (ref1 val-3)) "hi")
+		       (not (equal? val-1 val-2))
+		       (?1 val-1)
+		       (?2 val-2)
+		       (not (?2 val-3))))))))
+	#t)
+
+  (test (let* ((rec1-type (make-type))
+	       (make1 (cadr rec1-type))
+	       (ref1 (caddr rec1-type)))
+	  (let* ((rec2-type (make-type))
+		 (make2 (cadr rec2-type)))
+	    (let ((val-1 (make1 "hi")))
+	      (let ((val-2 (make2 val-1)))
+		(ref1 val-2)))))
+	#<undefined>)
+
+  (test (make-type (make-type)) 'error)
+  (let ((t (make-type)))
+    (let ((t? (car t))
+	  (make-t (cadr t))
+	  (t-ref (caddr t)))
+      (test (make-t 1 2) 'error)
+      (test (t? (make-t)) #t)
+      (test (t-ref (make-t)) #f)
+      (test (t? 1 2) 'error)
+      (test (t?) 'error)
+      (test (t-ref) 'error)
+      (test (t-ref 1 2) 'error)
+      (for-each
+       (lambda (arg)
+	 (test (t-ref arg) 'error))
+       (list #\a 'a-symbol 1.0+1.0i #t #(1 2) () 3/4 3.14 #() "hi" :hi 1 #f #t '(1 . 2)))))
+
+  (begin
+    (define rec? #f)
+    (define make-rec #f)
+    (define rec-a #f)
+    (define rec-b #f)
+
+    (let* ((rec-type (make-type))
+	   (? (car rec-type))
+	   (make (cadr rec-type))
+	   (ref (caddr rec-type)))
+
+      (set! make-rec (lambda* ((a 1) (b 2))
+			      (make (vector a b))))
+
+      (set! rec? (lambda (obj)
+		   (? obj)))
+
+      (set! rec-a (dilambda
+		   (lambda (obj)
+		     (and (rec? obj)
+			  (vector-ref (ref obj) 0)))
+		   (lambda (obj val)
+		     (if (rec? obj)
+			 (vector-set! (ref obj) 0 val)))))
+
+      (set! rec-b (dilambda
+		   (lambda (obj)
+		     (and (rec? obj)
+			  (vector-ref (ref obj) 1)))
+		   (lambda (obj val)
+		     (if (rec? obj)
+			 (vector-set! (ref obj) 1 val)))))))
+
+  (let ((hi (make-rec 32 '(1 2))))
+    (test (rec? hi) #t)
+    (test (equal? hi hi) #t)
+    (test (rec? 32) #f)
+    (test (rec-a hi) 32)
+    (test (rec-b hi) '(1 2))
+    (set! (rec-b hi) 123)
+    (test (rec-b hi) 123)
+    (let ((ho (make-rec 32 '(1 2))))
+      (test (eq? hi ho) #f)
+      (test (eqv? hi ho) #f)
+      (test (equal? hi ho) #f)
+      (set! (rec-b ho) 123)
+      (test (equal? hi ho) #t))
+    (let ((ho (make-rec 123 ())))
+      (test (eq? hi ho) #f)
+      (test (eqv? hi ho) #f)
+      (test (equal? hi ho) #f))
+    (test (equal? (copy hi) hi) #t)
+    (test (fill! hi 1) 1)
+    ;(test (object->string hi) "(inlet)")
+    (test (length hi) 2)
+    (test (let? (reverse hi)) 'error)
+    (test (for-each abs hi) 'error)
+    (test (map abs hi) 'error)
+    (test (hi 1) 'error)
+    (test (set! (hi 1) 2) 'error)
+    )
+
+  (let ((rec3? (car (make-type)))
+	(rec4? (car (make-type :value 21))))
+    (for-each
+     (lambda (arg)
+       (test (rec3? arg) #f)
+       (test (rec4? arg) #f))
+     (list "hi" -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #f #t '(1 . 2))))
+
+    )
+
+;;; pfloat-vector
+(let ()
+  (begin
+    (define pfloat-vector? #f)
+    (define make-pfloat-vector #f)
+
+    (let ((type (gensym))
+	  (->float (lambda (x)
+		     (if (real? x)
+			 (* x 1.0)
+			 (error 'wrong-type-arg "pfloat-vector new value is not a real: ~A" x)))))
+
+      (varlet (curlet)
+	(cons 'length (lambda (p) ((funclet p) 'len)))
+	(cons 'object->string (lambda args "#<pfloat-vector>"))
+	(cons 'vector? (lambda (p) #t))
+	(cons 'vector-length (lambda (p) ((funclet p) 'len)))
+	(cons 'vector-dimensions (lambda (p) (list ((funclet p) 'len))))
+	(cons 'vector-ref (lambda (p ind) (#_vector-ref ((funclet p) 'obj) ind)))
+	(cons 'vector-set! (lambda (p ind val) (#_vector-set! ((funclet p) 'obj) ind (->float val))))
+	(cons 'equal? (lambda (x y) (#_equal? ((funclet x) 'obj) ((funclet y) 'obj))))
+	(cons 'equivalent? (lambda (x y) (#_equivalent? ((funclet x) 'obj) ((funclet y) 'obj))))
+	(cons 'reverse (lambda (p) (vector->pfloat-vector (#_reverse ((funclet p) 'obj)))))
+	(cons 'copy (lambda (p) (vector->pfloat-vector ((funclet p) 'obj))))
+	(cons 'sort! (lambda (p f) (vector->pfloat-vector (#_sort! ((funclet p) 'obj) f))))
+	)
+
+      (set! make-pfloat-vector
+	    (lambda* (len (init 0.0))
+	      (let ((obj (make-vector len (->float init))))
+		(openlet
+		 (dilambda
+		  (lambda (i) (#_vector-ref obj i))
+		  (lambda (i val) (#_vector-set! obj i (->float val))))))))
+
+      (set! pfloat-vector?
+	    (lambda (obj)
+	      (and (procedure? obj)
+		   (eq? ((funclet obj) 'type) type))))))
+
+  (define pfloat-vector
+    (lambda args
+      (let* ((len (length args))
+	     (v (make-pfloat-vector len)))
+	(do ((i 0 (+ i 1))
+	     (arg args (cdr arg)))
+	    ((= i len) v)
+	  (set! (v i) (car arg))))))
+
+  (define (vector->pfloat-vector v)
+    (let* ((len (length v))
+	   (fv (make-pfloat-vector len)))
+      (do ((i 0 (+ i 1)))
+	  ((= i len))
+	(set! (fv i) (v i)))
+      fv))
+
+  (let ((v (make-pfloat-vector 3 0.0)))
+    (test (length v) 3)
+    (set! (v 1) 32.0)
+    (test (v 0) 0.0)
+    (test (v 1) 32.0)
+    (test (eq? v v) #t)
+    (test (eq? v (pfloat-vector 0.0 32.0 0.0)) #f)
+    (test (equal? v (pfloat-vector 0.0 32.0 0.0)) #t)
+    (test (equivalent? v (pfloat-vector 0.0 32.0 0.0)) #t)
+    (test (reverse (pfloat-vector 1.0 2.0 3.0)) (pfloat-vector 3.0 2.0 1.0))
+    (test (copy (pfloat-vector 1.0 2.0 3.0)) (pfloat-vector 1.0 2.0 3.0))
+    (test (object->string v) "#<pfloat-vector>")
+    (test (let ((v (pfloat-vector 1.0 2.0 3.0))) (map v (list 2 1 0))) '(3.0 2.0 1.0))
+    (test (v -1) 'error)
+    (test (v 32) 'error)
+    (for-each
+     (lambda (arg)
+       (test (v arg) 'error))
+     (list #\a 'a-symbol 1.0+1.0i #f #t abs #(1 2) () 3/4 3.14 '(1 . 2)))
+
+    (test (set! (v 0) "hi") 'error)
+    (test (set! (v -1) "hi") 'error)
+    (test (set! (v 32) "hi") 'error)
+    (for-each
+     (lambda (arg)
+       (test (set! (v 0) arg) 'error))
+     (list #\a 'a-symbol 1.0+1.0i #f #t abs #(1 2) () '(1 . 2)))
+    (test (length v) 3)
+    )
+
+  (let ((v1 (pfloat-vector 3 1 4 8 2)))
+    (let ((v2 (sort! v1 <))
+	  (one 1))
+      (test (equal? v2 (pfloat-vector 1 2 3 4 8)) #t)
+      (test (vector? v1) #t)
+      (test (pfloat-vector? v1) #t)
+      (test (vector-length v1) 5)
+      (test (vector-ref v1 one) 2.0)
+      (test (vector-set! v1 1 3/2) 1.5)
+      (test (vector-ref v1 1) 1.5)
+      (test (vector-dimensions v1) '(5))
+
+      (for-each
+       (lambda (arg)
+	 (test (pfloat-vector? arg) #f))
+       (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1))))
+
+      (for-each
+       (lambda (arg)
+	 (test (make-pfloat-vector arg) 'error))
+       (list -1 #\a #(1 2 3) 3.14 3/4 1.0+1.0i () #f #(()) '(1 . 2) "hi" '((a . 1))))
+
+      (for-each
+       (lambda (arg)
+	 (test (make-pfloat-vector 3 arg) 'error))
+       (list #\a #(1 2 3) 1.0+1.0i () #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1))))
+
+      (for-each
+       (lambda (arg)
+	 (test (pfloat-vector (list arg)) 'error))
+       (list #\a #(1 2 3) 1.0+1.0i () #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1))))
+
+      )))
+
+
+;;; environments as objects
+
+(define-macro* (define-class class-name inherited-classes (slots ()) (methods ()))
+  `(let ((outer-env (outlet (curlet)))
+	 (new-methods ())
+	 (new-slots ())
+	 (new-type (gensym "define-class")))
+
+    (for-each
+     (lambda (class)
+       ;; each class is a set of nested environments, the innermost (first in the list)
+       ;;   holds the local slots which are copied each time an instance is created,
+       ;;   the next holds the class slots (global to all instances, not copied);
+       ;;   these hold the class name and other such info.  The remaining environments
+       ;;   hold the methods, with the localmost method first.  So in this loop, we
+       ;;   are gathering the local slots and all the methods of the inherited
+       ;;   classes, and will splice them together below as a new class.
+
+       (set! new-slots (append (let->list class) new-slots))
+       (do ((e (outlet (outlet class)) (outlet e)))
+	   ((or (not (let? e))
+		(eq? e (rootlet))))
+         (set! new-methods (append (let->list e) new-methods))))
+     ,inherited-classes)
+
+     (let ((remove-duplicates
+	    (lambda (lst)         ; if multiple local slots with same name, take the localmost
+	      (letrec ((rem-dup
+			(lambda (lst nlst)
+			  (cond ((null? lst) nlst)
+				((assq (caar lst) nlst) (rem-dup (cdr lst) nlst))
+				(else (rem-dup (cdr lst) (cons (car lst) nlst)))))))
+		(reverse (rem-dup lst ()))))))
+       (set! new-slots
+	     (remove-duplicates
+	      (append (map (lambda (slot)
+			     (if (pair? slot)
+				 (cons (car slot) (cadr slot))
+				 (cons slot #f)))
+			   ,slots)                    ; the incoming new slots, #f is the default value
+		      new-slots)))                    ; the inherited slots
+
+    (set! new-methods
+      (remove-duplicates
+	  (append (map (lambda (method)
+			 (if (pair? method)
+			     (cons (car method) (cadr method))
+			     (cons method #f)))
+		       ,methods)                     ; the incoming new methods
+
+		  ;; add an object->string method for this class.
+		  (list (cons 'object->string
+                              (lambda* (obj (port #f))
+				(format port "#<~A: ~{~A~^ ~}>"
+					',class-name
+					(map (lambda (slot)
+					       (list (car slot) (cdr slot)))
+					     obj)))))
+		  (reverse! new-methods)))))           ; the inherited methods
+
+    (let ((new-class (openlet
+                       (apply sublet           ; the local slots
+		         (sublet               ; the global slots
+		           (apply sublet ()    ; the methods
+			     new-methods)
+		           (cons 'class-name ',class-name)  ; class-name slot
+			   (cons 'class-type new-type)      ; save a unique type identifier (unneeded if class-names are unique)
+			   (cons 'inherited ,inherited-classes)
+			   (cons 'inheritors ()))           ; classes that inherit from this class
+		         new-slots))))
+
+      (varlet outer-env
+        (cons ',class-name new-class)                       ; define the class as class-name in the calling environment
+
+	;; define class-name? type check
+	(cons (symbol (symbol->string ',class-name) "?")
+	      (lambda (obj)
+		(and (let? obj)
+		     (eq? (obj 'class-type) new-type)))))
+
+      (varlet outer-env
+        ;; define the make-instance function for this class.
+        ;;   Each slot is a keyword argument to the make function.
+        (cons (symbol "make-" (symbol->string ',class-name))
+	      (apply lambda* (map (lambda (slot)
+				    (if (pair? slot)
+					(list (car slot) (cdr slot))
+					(list slot #f)))
+				  new-slots)
+		     `((let ((new-obj (copy ,,class-name)))
+			 ,@(map (lambda (slot)
+				  `(set! (new-obj ',(car slot)) ,(car slot)))
+				new-slots)
+			 new-obj)))))
+
+      ;; save inheritance info for this class for subsequent define-method
+      (letrec ((add-inheritor (lambda (class)
+				(for-each add-inheritor (class 'inherited))
+				(if (not (memq new-class (class 'inheritors)))
+				    (set! (class 'inheritors) (cons new-class (class 'inheritors)))))))
+	(for-each add-inheritor ,inherited-classes))
+
+      ',class-name)))
+
+
+(define-macro (define-generic name)
+  `(define ,name (lambda args (apply ((car args) ',name) args))))
+
+
+(define-macro (define-slot-accessor name slot)
+  `(define ,name (dilambda
+                   (lambda (obj) (obj ',slot))
+		   (lambda (obj val) (set! (obj ',slot) val)))))
+
+
+(define-macro (define-method name-and-args . body)
+  `(let* ((outer-env (outlet (curlet)))
+	  (method-name (car ',name-and-args))
+	  (method-args (cdr ',name-and-args))
+	  (object (caar method-args))
+	  (class (symbol->value (cadar method-args)))
+	  (old-method (class method-name))
+	  (method (apply lambda* method-args ',body)))
+
+     ;; define the method as a normal-looking function
+     ;;   s7test.scm has define-method-with-next-method that implements call-next-method here
+     ;;   it also has make-instance
+     (varlet outer-env
+       (cons method-name
+	     (apply lambda* method-args
+		    `(((,object ',method-name)
+		       ,@(map (lambda (arg)
+				(if (pair? arg) (car arg) arg))
+			      method-args))))))
+
+     ;; add the method to the class
+     (varlet (outlet (outlet class))
+       (cons method-name method))
+
+     ;; if there are inheritors, add it to them as well, but not if they have a shadowing version
+     (for-each
+      (lambda (inheritor)
+	(if (not (eq? (inheritor method-name) #<undefined>)) ; defined? goes to the global env
+	    (if (eq? (inheritor method-name) old-method)
+		(set! (inheritor method-name) method))
+	    (varlet (outlet (outlet inheritor))
+   	      (cons method-name method))))
+      (class 'inheritors))
+
+     method-name))
+
+
+(define (all-methods obj method)
+  ;; for arbitrary method combinations: this returns a list of all the methods of a given name
+  ;;   in obj's class and the classes it inherits from (see example below)
+  (let* ((base-method (obj method))
+	 (methods (if (procedure? base-method) (list base-method) ())))
+    (for-each
+     (lambda (ancestor)
+       (let ((next-method (ancestor method)))
+	 (if (and (procedure? next-method)
+		  (not (memq next-method methods)))
+	     (set! methods (cons next-method methods)))))
+     (obj 'inherited))
+    (reverse methods)))
+
+(define-macro (make-instance class . args)
+  `(let* ((cls (if (symbol? ,class) (symbol->value ,class) ,class))
+	  (make (symbol->value (symbol "make-" (symbol->string (cls 'class-name))))))
+     (apply make ',args)))
+
+(define-macro (define-method-with-next-method name-and-args . body)
+  `(let* ((outer-env (outlet (curlet)))
+	  (method-name (car ',name-and-args))
+	  (method-args (cdr ',name-and-args))
+	  (object (caar method-args))
+	  (class (symbol->value (cadar method-args)))
+	  (old-method (class method-name))
+	  (arg-names (map (lambda (arg)
+			    (if (pair? arg) (car arg) arg))
+			  method-args))
+	  (next-class (and (pair? (class 'inherited))
+			   (car (class 'inherited)))) ; or perhaps the last member of this list?
+	  (nwrap-body (if next-class
+			  `((let ((call-next-method
+				   (lambda new-args
+				     (apply (,next-class ',method-name)
+					    (or new-args ,arg-names)))))
+			      ,@',body))
+			  ',body))
+	  (method (apply lambda* method-args nwrap-body)))
+
+     ;; define the method as a normal-looking function
+     (varlet outer-env
+       (cons method-name
+	     (apply lambda* method-args
+		    `(((,object ',method-name) ,@arg-names)))))
+
+     ;; add the method to the class
+     (varlet (outlet (outlet class))
+       (cons method-name method))
+
+     ;; if there are inheritors, add it to them as well, but not if they have a shadowing version
+     (for-each
+      (lambda (inheritor)
+	(if (not (eq? (inheritor method-name) #<undefined>)) ; defined? goes to the global env
+	    (if (eq? (inheritor method-name) old-method)
+		(set! (inheritor method-name) method))
+	    (varlet (outlet (outlet inheritor))
+   	      (cons method-name method))))
+      (class 'inheritors))
+
+     method-name))
+
+(let ()
+(let ()
+  (define-class class-1 ()
+    '((a 1) (b 2))
+    (list (list 'add (lambda (obj)
+		       (with-let obj
+			 (+ a b))))))
+
+  (define-slot-accessor slot-a a)
+
+  (let ()
+    (test (let? (outlet (curlet))) #t)
+    (test (class-1? class-1) #t)
+    (test (class-1 'a) 1)
+    (test (class-1 'b) 2)
+    (test (class-1 'class-name) 'class-1)
+    (test (class-1 'divide) #<undefined>)
+    (test (class-1 'inheritors) ())
+    (test ((class-1 'add) class-1) 3)
+    (test (pair? (member (object->string class-1) '("#<class-1: (a 1) (b 2)>" "#<class-1: (b 2) (a 1)>"))) #t)
+    (test (format #f "~{~A~^ ~}" class-1) "(a . 1) (b . 2)"))
+
+  (let ((v (make-class-1)))
+    (test (class-1? v) #t)
+    (test (v 'a) 1)
+    (test (v 'b) 2)
+    (test (v 'class-name) 'class-1)
+    (test (v 'inheritors) ())
+    (test ((v 'add) v) 3)
+    (test (pair? (member (object->string v) '("#<class-1: (a 1) (b 2)>" "#<class-1: (b 2) (a 1)>"))) #t)
+    (test (format #f "~{~A~^ ~}" v) "(a . 1) (b . 2)")
+    (set! (v 'a) 32)
+    (test ((v 'add) v) 34)
+    (test (equal? v v) #t)
+    (test (equal? v (make-class-1 :a 32)) #t)
+    (test (slot-a v) 32)
+    (set! (slot-a v) 1)
+    (test (slot-a v) 1)
+    (test (pair? (member (map cdr v) '((1 2) (2 1)))) #t))
+
+  (let ((v (make-class-1 :a 32))
+	(v1 (make-class-1))
+	(v2 (make-class-1 :a 32)))
+    (test (class-1? v) #t)
+    (test (v 'a) 32)
+    (test (v 'b) 2)
+    (test (v 'class-name) 'class-1)
+    (test (v 'inheritors) ())
+    (test ((v 'add) v) 34)
+    (test (pair? (member (object->string v) '("#<class-1: (a 32) (b 2)>" "#<class-1: (b 2) (a 32)>"))) #t)
+    (test (eq? v v) #t)
+    (test (eq? v v1) #f)
+    (test (eqv? v v) #t)
+    (test (eqv? v v1) #f)
+    (test (eqv? v v2) #f)
+    (test (equal? v v) #t)
+    (test (equal? v v1) #f)
+    (test (equal? v v2) #t))
+
+  (let ((v (make-class-1 32 3)))
+    (test (class-1? v) #t)
+    (test (v 'a) 32)
+    (test (v 'b) 3)
+    (test (v 'class-name) 'class-1)
+    (test (v 'inheritors) ())
+    (test ((v 'add) v) 35)
+    (test (pair? (member (object->string v) '("#<class-1: (a 32) (b 3)>" "#<class-1: (b 3) (a 32)>"))) #t))
+
+  (define-generic add)
+
+  (let ()
+    (test (add class-1) 3)
+    (test (add (make-class-1 :b 0)) 1)
+    (test (add 2) 'error))
+
+  (define-class class-2 (list class-1)
+    '((c 3))
+    (list (list 'multiply (lambda (obj)
+			    (with-let obj
+                              (* a b c))))))
+
+  (let ((v (make-class-2 :a 32)))
+    (test (class-1? v) #f)
+    (test (class-2? v) #t)
+    (test (equal? v (make-class-1 :a 32)) #f)
+    (test (equal? v (make-class-2 :a 32)) #t)
+    (test (v 'a) 32)
+    (test (v 'b) 2)
+    (test (v 'c) 3)
+    (test (v 'class-name) 'class-2)
+    (test (v 'inheritors) ())
+    (test (class-1 'inheritors) (list class-2))
+    (test ((v 'add) v) 34)
+    (test (pair? (member (object->string v) '("#<class-2: (c 3) (a 32) (b 2)>" "#<class-2: (b 2) (a 32) (c 3)>" "#<class-2: (c 3) (b 2) (a 32)>"))) #t)
+    (test ((v 'multiply) v) 192)
+    (test (add v) 34))
+
+  (let ((v1 (make-class-1))
+	(v2 (make-class-1)))
+    (test (add v1) 3)
+    (test (add v2) 3)
+    (varlet v2 (cons 'add (lambda (obj) (with-let obj (+ 1 a (* 2 b))))))
+    (test (add v1) 3)
+    (test (add v2) 6))
+
+  (define-class class-3 (list class-2)
+    ()
+    (list (list 'multiply (lambda (obj num)
+			    (* num
+			       ((class-2 'multiply) obj)
+			       (add obj))))))
+
+  (let ((v (make-class-3)))
+    (test (class-1? v) #f)
+    (test (class-2? v) #f)
+    (test (class-3? v) #t)
+    (test (v 'a) 1)
+    (test (v 'b) 2)
+    (test (v 'c) 3)
+    (test (v 'class-name) 'class-3)
+    (test (v 'inheritors) ())
+    (test (class-1 'inheritors) (list class-3 class-2))
+    (test (class-2 'inheritors) (list class-3))
+    (test ((v 'add) v) 3)
+    (test (pair? (member (object->string v) '("#<class-3: (c 3) (a 1) (b 2)>" "#<class-3: (b 2) (a 1) (c 3)>" "#<class-3: (a 1) (b 2) (c 3)>"))) #t)
+    (test ((v 'multiply) v) 'error)
+    (test ((v 'multiply) v 4) (* 4 6 3))
+    (test (add v) 3))
+
+  (define-method (subtract (obj class-1))
+    (with-let obj
+      (- a b)))
+
+  (let ((v1 (make-class-1))
+	(v2 (make-class-2))
+	(v3 (make-class-3)))
+    (test (subtract v1) -1)
+    (test (subtract v2) -1)
+    (test (subtract v3) -1))
+
+  ;; class-2|3 have their own multiply so...
+  (define-method (multiply (obj class-1)) (with-let obj (* a b 100)))
+
+  (let ((v1 (make-class-1))
+	(v2 (make-class-2))
+	(v3 (make-class-3)))
+    (test (multiply v1) 200)
+    (test (multiply v2) 6)
+    (test (multiply v3) 'error))
+
+  (define-method-with-next-method (add-1 (obj class-1)) (+ (obj 'a) 1))
+  (define-method-with-next-method (add-1 (obj class-2)) (+ 1 (call-next-method)))
+  (define-method-with-next-method (add-1 (obj class-3)) (+ 1 (call-next-method obj)))
+
+  (test (add-1 (make-class-1)) 2)
+  (test (add-1 (make-class-2)) 3)
+  (test (add-1 (make-class-3)) 4)
+
+  (test ((make-instance class-1) 'class-name) 'class-1)
+  (test ((make-instance 'class-1) 'class-name) 'class-1)
+  (test ((make-instance class-2) 'class-name) 'class-2)
+  (test ((make-instance class-1 :a 123) 'class-name) 'class-1)
+
+  (test ((make-instance class-1) 'b) 2)
+  (test ((make-instance 'class-1) 'b) 2)
+  (test ((make-instance class-1 :b 12 :a 123) 'b) 12)
+
+  (test ((make-instance 'class-3 :a "hi" :c 21) 'c) 21)
+
+  ))
+
+;;; let field writer
+(let ()
+  (define lt (let ((a 1))
+	       (set! (setter 'a)
+		     (lambda (s v)
+		       (if (integer? v)
+			   v
+			   (error 'wrong-type-arg "'a value should be an integer"))))
+	       (curlet)))
+  (test (lt 'a) 1)
+  (set! (lt 'a) 32)
+  (test (lt 'a) 32)
+  (test (set! (lt 'a) pi) 'error)
+  (define a 12)
+  (test a 12)
+  (set! a pi)
+  (test a pi)
+  (test (lt 'a) 32)
+  (test (set! (lt 'a) pi) 'error))
+
+
+;;; --------------------------------------------------------------------------------
+;;; owlet
+
+(test (vector? (owlet)) #f)
+(test (let? (owlet)) #t)
+(test (let () (set! (owlet) 2)) 'error)
+(test (owlet 123) 'error)
+(test (let ((e (owlet))) (e 'asdf)) #<undefined>)
+
+(let ((val (catch #t (lambda () (/ 1 0.0)) (lambda args args))))
+  (with-let (owlet)
+    (test error-type 'division-by-zero)
+    (test (or (equal? error-code '(/ 1 0.0)) (equal? error-code '(lambda args args))) #t)
+    (test (list? error-data) #t)
+    (test (string? error-file) #t)
+    (test (integer? error-line) #t)
+    (test ((owlet) 'error-file) error-file)
+    ))
+
+;;; this needs to be global (fx_tree outlet let* optimization bug, taken from array1.scm in the benchmarks)
+  (define (_create-y_ x) (let* ((n (vector-length x)) (result (make-vector n))) (do ((i (- n 1) (- i 1))) ((< i 0) result) (vector-set! result i 0))))
+  (define (_test-fx_) (let loop ((repeat 2) (result ())) (if (> repeat 0) (loop (- repeat 1) (_create-y_ (make-vector 1))) result)))
+  (_test-fx_)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; object->let
+
+(test (object->let) 'error)
+(test (object->let 12 21) 'error)
+
+(test (object->let ()) (inlet :value () :type 'null?))
+(test (object->let #<unspecified>) (inlet :value #<unspecified> :type 'unspecified?))
+(test (object->let #<undefined>) (inlet :value #<undefined> :type 'undefined?))
+(test (object->let else) (inlet 'value else 'type 'symbol? 'current-value else 'setter #f 'mutable? #t))
+(test (object->let with-baffle)
+      (inlet 'value with-baffle
+	     'type 'syntax?
+	     'documentation "(with-baffle ...) evaluates its body in a context that blocks re-entry via call/cc."))
+(test (object->let #<eof>) (inlet :value #<eof> :type 'eof-object?))
+(test (object->let #t) (inlet :value #t :type 'boolean?))
+
+(test (object->let 'abc) (inlet 'value 'abc 'type 'symbol? 'current-value #<undefined> 'setter #f 'mutable? #t))
+(test (object->let :abc) (inlet :value :abc :type 'keyword?))
+(test (object->let #\space) (inlet :value #\space :type 'char?))
+(let ((_sym_ 3))
+  (set! (setter '_sym_) log)
+  (test (object->let '_sym_)
+	(inlet 'value '_sym_ 'type 'symbol? 'current-value 3 'setter log 'mutable? #t)))
+(test (object->let 123) (inlet :value 123 :type 'integer?))
+(test (object->let 1/2) (inlet :value 1/2 :type 'rational?))
+(test (object->let 1.0) (inlet :value 1.0 :type 'real?))
+(test (object->let 1+i) (inlet :value 1+i :type 'complex?))
+(when with-bignums
+  (test (object->let (bignum "123")) (inlet :value (bignum "123") :type 'integer?))
+  (test (object->let (bignum "1/2")) (inlet :value (bignum "1/2") :type 'rational?))
+  (test (object->let (bignum "1.0")) (inlet :value (bignum "1.0") :type 'real?))
+  (test (object->let (bignum "1+i")) (inlet :value (bignum "1+i") :type 'complex?)))
+
+(test (object->let "abc") (inlet :value "abc" :type 'string? :size 3 :mutable? #t))
+(test (object->let (byte-vector 1 2 3)) (inlet :value (byte-vector 1 2 3) :type 'byte-vector? :dimensions '(3) :size 3 :mutable? #t))
+(test (object->let (cons 1 2)) (inlet :value (cons 1 2) :type 'pair? :size -1))
+(test (object->let (c-pointer 0)) (inlet :value (c-pointer 0) :type 'c-pointer? :pointer 0 :c-type #f :info #f))
+
+(let ((c #f))
+  (call/cc (lambda (f) (set! c f)))
+  (let ((obj (object->let c)))
+    (test (obj 'value) c)
+    (test (obj 'type) 'continuation?)
+    (test (obj 'name) 'f)))
+(let ((c #f))
+  (call-with-exit (lambda (f) (set! c f)))
+  (test (object->let c) (inlet :value c :type 'goto? :active #f 'name 'f)))
+(call-with-exit (lambda (f) (test (object->let f) (inlet :value f :type 'goto? :active #t 'name 'f))))
+
+(unless with-bignums
+  (let ((r (random-state 1234)))
+    (test (object->let r) (inlet :value r :type 'random-state? :seed 1234 :carry 1675393560))))
+
+(test (object->let (vector 1 2 3)) (inlet :value (vector 1 2 3) :type 'vector? :size 3 :dimensions '(3) :mutable? #t))
+(test (object->let (int-vector 1 2 3)) (inlet :value (int-vector 1 2 3) :type 'int-vector? :size 3 :dimensions '(3) :mutable? #t))
+(test (object->let (float-vector 1 2 3)) (inlet :value (float-vector 1 2 3) :type 'float-vector? :size 3 :dimensions '(3) :mutable? #t))
+(let ((v (subvector (vector 1 2 3) 1 3)))
+  (test (object->let v) (inlet :value (vector 2 3) :type '(subvector? . vector?) :size 2 :dimensions '(2) :mutable? #t :position 1 :original-vector #(1 2 3))))
+(test (object->let (make-vector '(2 3 4) #f))
+      (inlet :value (make-vector '(2 3 4) #f) :type 'vector? :size 24 :dimensions '(2 3 4) :mutable? #t))
+
+(let ((iter (make-iterator '(1 2 3))))
+  (test (object->let iter) (inlet :value iter :type 'iterator? :at-end #f :sequence '(1 2 3) :size 3 :position '(1 2 3))))
+(let ((iter (make-iterator #(1 2 3))))
+  (iter)
+  (test (object->let iter) (inlet :value iter :type 'iterator? :at-end #f :sequence #(1 2 3) :size 3 :position 1)))
+(let ((iter (make-iterator "1234")))
+  (iter)
+  (iter)
+  (test (object->let iter) (inlet :value iter :type 'iterator? :at-end #f :sequence "1234" :size 4 :position 2)))
+(let ((iter (make-iterator (int-vector 1 2))))
+  (iter)
+  (iter)
+  (iter)
+  (test (object->let iter) (inlet :value iter :type 'iterator? :at-end #t :sequence (int-vector 1 2) :size 2 :position 2)))
+
+(let ((h (hash-table :a 1 :b 2)))
+  (test (object->let h)
+        (if (provided? 'debugging)
+            (inlet :stats:0|1|2|n|max '(6 2 0 0 1) :function 'eq? :value h :type 'hash-table? :size 8 :entries 2 :mutable? #t)
+            (inlet :value h :type 'hash-table? :size 8 :entries 2 :mutable? #t :function 'eq?))))
+
+(let ((h (hash-table 1 1 2 2)))
+  (test (object->let h)
+        (if (provided? 'debugging)
+            (inlet 'stats:0|1|2|n|max '(6 2 0 0 1) 'function '= 'value h 'type 'hash-table? 'size 8 'entries 2 'mutable? #t)
+            (inlet :value h :type 'hash-table? :size 8 :entries 2 :mutable? #t :function '=))))
+
+(let ((h (make-hash-table 8 string=?))) (test (object->let h) (inlet :value h :type 'hash-table? :size 8 :entries 0 :mutable? #t :function 'string=?)))
+(test ((object->let (make-weak-hash-table)) 'weak) #t)
+
+(let ((e (inlet 'a 1 'b 2))) (test (object->let e) (inlet :value e :type 'let? :size 2 :open #f :outlet (rootlet) :mutable? #t)))
+(test (object->let (rootlet)) (inlet :value (rootlet) :type 'let? :size (length (rootlet)) :open #f :outlet () :mutable? #t :alias 'rootlet))
+;(test (object->let (owlet)) (inlet :value (owlet) :type 'let? :size (length (owlet)) :open #f :outlet (rootlet) :alias 'owlet))
+
+(let ((e (openlet (inlet 'a 1 'b 2 'object->let (lambda (p lt) (varlet lt 'a+b (+ (p 'a) (p 'b))))))))
+  (test (object->let e) (inlet :value e :type 'let? :size 3 :open #t :outlet (rootlet) :mutable? #t 'a+b 3)))
+
+(test (equal? (object->let (byte-vector-ref (make-byte-vector '(2 3) 1) 1))
+              (inlet 'value #u(1 1 1) 'type '(subvector? . byte-vector?) 'size 3 'dimensions '(3) 'mutable? #t 'position 3 'original-vector #u2d((1 1 1) (1 1 1))))
+      #t) ; segfault in gcc if -O2 if vector_elements used for all vector types (and the stacktrace is messed up in gdb)
+(test (equal? (object->let (int-vector-ref (make-int-vector '(2 3) 1) 1))
+              (inlet 'value #i(1 1 1) 'type '(subvector? . int-vector?) 'size 3 'dimensions '(3) 'mutable? #t 'position 3 'original-vector #i2d((1 1 1) (1 1 1))))
+      #t)
+(test (equal? (object->let (vector-ref (make-vector '(2 3) 1) 1))
+              (inlet 'value #(1 1 1) 'type '(subvector? . vector?) 'size 3 'dimensions '(3) 'mutable? #t 'position 3 'original-vector #2d((1 1 1) (1 1 1))))
+      #t)
+(test (equal? (object->let (float-vector-ref (make-float-vector '(2 3) 1) 1))
+              (inlet 'value #r(1.0 1.0 1.0) 'type '(subvector? . float-vector?) 'size 3 'dimensions '(3) 'mutable? #t 'position 3 'original-vector #r2d((1.0 1.0 1.0) (1.0 1.0 1.0))))
+      #t)
+
+(let ()
+  (define (fff x) (+ x 1))
+  (let ((e (funclet fff)))
+    (test ((object->let e) :type) 'let?)))
+;          (inlet 'value e :type 'let? :size 1 :open #f :outlet (inlet 'fff fff) :function 'fff :file "s7test.scm" :line (port-line-number)))))
+(let ((e (openlet (inlet :abs (lambda (x) (- x 1))))))
+  (test (object->let e) (inlet :value e :type 'let? :size 1 :open #t :outlet (rootlet) :mutable? #t)))
+
+(when with-block
+  (let* ((b (make-block 8))
+	 (bl (object->let b)))
+    (test (let? bl) #t)
+    (test (bl 'value) b)
+    (test (bl 'type) 'c-object?)
+    (test (let? (bl 'class)) #t)
+    (test ((bl 'class) 'name) "<block>")
+    (test (integer? (bl 'c-object-type)) #t)
+    (test ((b 'empty) b) #f)
+    (test (let? (bl 'c-object-let)) #t)
+    (test (((bl 'c-object-let) 'empty) b) #f)))
+(when (provided? 'snd)
+  (when (provided? 'snd-motif)
+    (let ((cl (object->let jet-colormap)))
+      (test (let? cl) #t)
+      (test (cl 'value) jet-colormap)
+      (test (cl 'type) 'c-object?)
+      (test (cl 'class) (inlet 'name "<colormap>" 'setter #f))
+      (test (integer? (cl 'c-object-type)) #t)
+      (test (null? (cl 'c-object-let)) #t)))
+  (let ((cl (object->let fourier-transform)))
+      (test (let? cl) #t)
+      (test (cl 'value) fourier-transform)
+      (test (cl 'type) 'c-object?)
+      (test (cl 'class) (inlet 'name "<transform>" 'setter #f))
+      (test (integer? (cl 'c-object-type)) #t)
+      (test (null? (cl 'c-object-let)) #t)))
+
+(test (object->let *stderr*) (inlet :value *stderr* :type 'output-port? :port-type 'file :closed #f :mutable? #f :file "*stderr*"))
+(test (object->let *stdin*) (inlet :value *stdin* :type 'input-port? :port-type 'file :closed #f :mutable? #f :file "*stdin*" :line 0))
+(with-input-from-string "1234"
+  (lambda ()
+    (read-char)
+    (test (object->let (current-input-port))
+	  (inlet :value (current-input-port) :type 'input-port? :port-type 'string :closed #f :mutable? #t :size 4 :position 1 :data "1"))))
+(call-with-output-string
+ (lambda (p)
+   (display 123 p)
+   (let ((e (object->let p)))
+     (test (e 'type) 'output-port?)
+     (test (e 'port-type) 'string)
+     (test (e 'size) 128)
+     (test (let-ref e 'size) 128)
+     (test (e 'position) 3)
+     (test (substring (e 'data) 0 3) "123"))))
+(let ((e #f))
+  (call-with-output-string
+   (lambda (p)
+     (display 123 p)
+     (set! e p)))
+  (test (object->let e) (inlet :value e :type 'output-port? :port-type 'string :closed #t :mutable? #t)))
+
+(when (and (zero? (*s7* 'debug))
+           (not (provided? 'snd)))
+  (let ()
+    (define (ff1 x y) (+ x y))
+    (test (object->let ff1) (inlet 'value ff1 'type 'procedure? 'arity '(2 . 2) :mutable? #t 'file "s7test.scm" 'line (- (port-line-number) 7) 'source '(lambda (x y) (+ x y)))))
+  (let ()
+    (define (ff2 . x) (apply + x))
+    (test (object->let ff2) (inlet 'value ff2 'type 'procedure? 'arity '(0 . 536870912) :mutable? #t 'file "s7test.scm" 'line (- (port-line-number) 4) 'source '(lambda x (apply + x)))))
+  (let ()
+    (define* (ff3 x y) (+ x y))
+    (test (object->let ff3) (inlet 'value ff3 'type 'procedure? 'arity '(0 . 2) :mutable? #t 'file "s7test.scm" 'line (- (port-line-number) 1) 'source '(lambda* (x y) (+ x y))))))
+
+(call-with-output-file "empty-file"
+  (lambda (p)
+    (format p ";;; this is a test of file/line data in object->let~%~%")
+    (format p "(define (ff4 x)~%  (+ (log x) 1))~%~%(set! (setter ff4) set-car!)~%~%")))
+
+(when (zero? (*s7* 'debug))
+  (let ()
+    (load "empty-file" (curlet))
+    (test (object->let ff4)
+    	  (inlet 'value ff4 'type 'procedure? 'arity '(1 . 1) :mutable? #t 'file "empty-file" 'line 3 '+setter+ set-car! 'source '(lambda (x) (+ (log x) 1))))))
+
+(test (object->let abs)
+      (inlet 'value abs 'type 'procedure? 'arity '(1 . 1) :mutable? #t '+signature+ '(real? real?) '+documentation+ "(abs x) returns the absolute value of the real number x"))
+(if with-block
+    (test (object->let make-block)
+	  (inlet 'value make-block 'type 'procedure? 'arity '(1 . 1) :mutable? #t '+documentation+ "(make-block size) returns a new block of the given size")))
+(test (object->let string=?)
+      (inlet 'value string=?
+	     'type 'procedure?
+	     'arity '(2 . 536870912)
+	     'mutable? #t
+	     '+signature+ (let ((lst (list 'boolean? 'string?)))
+			  (set-cdr! (cdr lst) (cdr lst))
+			  lst)
+	     '+documentation+ "(string=? str ...) returns #t if all the string arguments are equal"))
+(test (object->let car)
+      (inlet 'value car 'type 'procedure? 'arity '(1 . 1) :mutable? #t '+signature+ '(#t pair?)
+	     '+documentation+ "(car pair) returns the first element of the pair"
+	     '+setter+ set-car!))
+(test (object->let quasiquote)
+      (inlet 'value quasiquote 'type 'macro? 'arity '(1 . 1) :mutable? #t
+	     '+documentation+ "(quasiquote arg) is the same as `arg.  If arg is a list, it can contain comma (\"unquote\") and comma-atsign (\"apply values\") to pre-evaluate portions of the list. unquoted expressions are evaluated and plugged into the list, apply-values evaluates the expression and splices the resultant list into the outer list. `(1 ,(+ 1 1) ,@(list 3 4)) -> (1 2 3 4)."))
+(let ()
+  (define-macro (1+ x) `(+ ,x 1))
+  (let ((e (object->let 1+)))
+    (test (e 'value) 1+)
+    (test (e 'type) 'macro?)
+    (test (e 'arity) '(1 . 1))
+    (test (e 'source) '(macro (x) (#_list-values '+ x 1)))))
+
+(test (substring "1234" ((openlet (inlet 'value 1)) 'value) ((openlet (object->let 3)) 'value)) "23")
+
+;(test (let? (eval-string (object->string (object->let (rootlet)) :readable))) #t)
+(test (let ((x '2)) (set! (setter 'x) integer?) (object->string (object->let 'x))) "(inlet 'mutable? #t 'setter integer? 'current-value 2 'value x 'type symbol?)")
+
+
+;;; --------------------------------------------------------------------------------
+;;; let-temporarily
+
+(let ((aaa 1)
+      (bbb 0)
+      (ccc 0))
+  (let-temporarily ((aaa 2))
+    (set! bbb aaa)
+    (set! aaa 32)
+    (set! ccc aaa))
+  (test (list aaa bbb ccc) '(1 2 32)))
+
+(test (let ((aaa 0)
+	    (bbb 0))
+	(let-temporarily ((aaa 32))
+	  (set! bbb aaa)
+	  (let-temporarily ((bbb 10))
+	    (set! aaa bbb)))
+	(list aaa bbb))
+      '(0 32))
+
+(let ()
+  (define f2 (let ((x '(0 1)))
+	       (dilambda (lambda () x)
+			 (lambda (y) (set! x y)))))
+  (let-temporarily (((f2) '(3 2)))
+    (test (f2) '(3 2)))
+  (test (f2) '(0 1)))
+
+(test (let ((x 3) (y 4)) (let-temporarily ((x (+ y (let-temporarily ((y 5)) (+ x y))))) (+ x y))) 16)
+
+(let ()
+  (define f3 (let ((x 'z))
+	       (dilambda (lambda () x)
+			 (lambda (y) (set! x y)))))
+  (let ((z 32))
+    (let-temporarily (((f3) 'z))
+      (test (f3) 'z))
+    (test (f3) 'z)))
+
+(let ((z 1)
+      (x 32))
+  (let-temporarily ((z 'x))
+    (test z 'x))
+  (test z 1))
+
+(let ((saved 0)
+      (orig 1)
+      (vars 2)
+      (body 3))
+  (let ((vals (list (let-temporarily ((saved 30)
+				      (orig 31)
+				      (vars 32)
+				      (body 33))
+		      (let ((inner (list saved orig vars body)))
+			(set! saved 41)
+			(set! orig 42)
+			(set! vars 43)
+			(set! body 44)
+			inner))
+		    (list saved orig vars body))))
+    (test vals '((30 31 32 33) (0 1 2 3)))))
+
+(let ((cons +)
+      (curlet abs)
+      (inlet call/cc)
+      (saved 32)
+      (inner-let -1))
+  (let-temporarily ((saved *))
+    (set! inner-let (cons (saved (abs inner-let) 2) 3)))
+  (test inner-let 5)
+  (test (eq? curlet abs) #t))
+
+(let ((a (vector 1 2 3))
+      (x 1)
+      (y 32))
+  (let-temporarily (((a x) y))
+    (test (a x) y))
+  (test (a x) 2))
+
+(let ((a (inlet 'b (vector 1 2 3)))
+      (x 32)
+      (y 1))
+  (let-temporarily ((((a 'b) 1) 32))
+    (test (a 'b) #(1 32 3)))
+  (test (a 'b) #(1 2 3)))
+
+(let ((x 1)
+      (y 2))
+  (let-temporarily ((x 32) (y x))
+    (test (list x y) '(32 1)))
+  (test (list x y) '(1 2)))
+
+(let ((a (vector 1 2 3))
+      (x 1)
+      (y 32)
+      (z 0))
+  (let-temporarily (((a x) y) (z (a x)))
+    (test (list (a x) y z) '(32 32 2)))
+  (test (list (a x) y z) '(2 32 0)))
+
+(test (let ((x 1)) (let-temporarily ((x 32)))) ()) ; was #f when let-temporarily was a macro -- not sure what it should be
+
+(test (let-temporarily . 1) 'error)
+(test (let-temporarily 1 1) 'error)
+(test (let-temporarily ((a 1) . 2) a) 'error)
+(test (let-temporarily (1 2) #t) 'error)
+(test (let-temporarily ((pi 3)) pi) 'error)
+(test (let-temporarily ((x . 1)) x) 'error)
+(test (let-temporarily ((x 1 2 3)) x) 'error)
+;; (let ((x 0) (y 0)) (let-temporarily ((x 1) (x 2)) (set! y x)) (list x y)) '(0 1) ? let*-temp -> '(0 2)
+(test (let ((x 3)) (list (let-temporarily ((x 1)) (values x 2)))) '(1 2))
+(test (let ((x #t)) (if (let-temporarily ((x #f)) x) 'error x)) #t)
+(test (let ((x 1)) (case (let-temporarily ((x 2)) x) ((1) 'error) ((2) x))) 1)
+(test (let-temporarily ((1 2)) 1) 'error)
+(test (let-temporarily ((*load-hook* 32)) 3) 'error)
+(test (apply let-temporarily (list (list 1 2)) 2) 'error)
+(let ((a 1))
+  (test (let-temporarily ((a 2)) (let-temporarily ((a 3)))) ())
+  (test a 1)
+  (test (let-temporarily ((a (let-temporarily ((a 3))))) a) ())
+  (test a 1))
+(test (let ((x 31)) (set! (setter 'x) (lambda (a b) 16)) (let-temporarily ((x 1)) x)) 16)
+
+(let ()
+  (define ourlet
+    (let ((x 1))
+      (define (a-func) x)
+      (define b-func (let ((y 1))
+		       (lambda ()
+			 (+ x y))))
+      (curlet)))
+  (test (ourlet 'x) 1)
+  (test (let-temporarily (((ourlet 'x) 2)) ((ourlet 'a-func))) 2)
+  (test ((funclet (ourlet 'b-func)) 'y) 1)
+  (test (let-temporarily ((((funclet (ourlet 'b-func)) 'y) 3)) ((ourlet 'b-func))) 4))
+
+(let ((x 0))
+  (let ((y (call-with-exit
+	    (lambda (go)
+	      (let-temporarily ((x 1))
+		(go (+ x 1)))))))
+    (test (list x y) '(0 2))))
+(let ((x 0))
+  (let ((y (let-temporarily ((x 1))
+	     (call-with-exit
+	      (lambda (go)
+		(go (+ x 1)))))))
+    (test (list x y) '(0 2))))
+(let ((x 0))
+  (let ((y (call/cc
+	    (lambda (go)
+	      (let-temporarily ((x 1))
+		(go (+ x 1)))))))
+    (test (list x y) '(0 2))))
+(let ((x 0))
+  (let ((y (let-temporarily ((x 1))
+	     (call/cc
+	      (lambda (go)
+		(go (+ x 1)))))))
+    (test (list x y) '(0 2))))
+(let ((x 10)
+      (y 10))
+  (catch #t
+    (lambda ()
+      (let-temporarily ((x 1))
+	(set! y x)
+	(error 'oops)))
+    (lambda args 'error))
+  (test (list x y) '(10 1)))
+(let ((x 10)
+      (y 10))
+  (catch #t
+    (lambda ()
+      (let-temporarily ((x 1))
+	(set! y x)
+	(throw 'oops)))
+    (lambda args 'error))
+  (test (list x y) '(10 1)))
+(let ((x 10)
+      (y 10))
+  (call-with-exit
+    (lambda (go)
+      (let-temporarily ((x 1))
+	(set! y x)
+	(go 'oops))))
+  (test (list x y) '(10 1)))
+(let ((x 10)
+      (y 10))
+  (call-with-exit
+    (lambda (go)
+      (dynamic-wind
+        (lambda () #f)
+        (lambda ()
+          (let-temporarily ((x 1))
+	    (set! y x)
+	    (go 'oops)))
+        (lambda () #f))))
+  (test (list x y) '(10 1)))
+
+(test (let ((x 1)) (immutable! 'x) (let-temporarily ((x 1234)) (+ x 1))) 'error)
+(test (let ((x 1)) (let-temporarily ((x 1234)) (immutable! 'x) (+ x 1))) 'error)
+(test (let ((x 1)) (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (let-temporarily ((x 1234)) (+ x 1)))) (immutable! 'x) (f)) 'error)
+(test (let () (define (g) (cadr ())) (let ((x #f) (y 0)) (let-temporarily ((x 1234) (y 1/2)) (g)))) 'error)
+(let () (define (func) ; fx_c_opsq_optuq_direct opt2_sym (does this mean catch lambda has no let?)
+	  (let ((x #f) (i 0))
+	    (catch #t (lambda ()
+			(let-temporarily ((x (list (string->list i) (vector x i)))) x))
+		   (lambda (type info) 'error))))
+     (func) (test (func) 'error))
+
+(test (let ((x 0)) (let ((func (lambda () (let-temporarily ((x 1234)))))) (func) (func))) ())
+(test (let ((x 0)) (let ((func (lambda () (let-temporarily ((x 1234)))))) (func) (func)) x) 0)
+(test (let ((x 0)) (let-temporarily ((x 1234)))) ())
+(test (let ((x 0)) (let-temporarily ((x 1234))) x) 0)
+(test (let ((x 0) (y 1)) (let ((func (lambda () (let-temporarily ((x 1234) (y 12)))))) (func) (func))) ())
+(test (let ((x 0) (y 1)) (let ((func (lambda () (let-temporarily ((x 1234) (y 12)))))) (func) (func)) (+ x y)) 1)
+(test (let ((x 0) (y 1)) (let-temporarily ((x 1234)))) ())
+(test (let ((x 0) (y 1)) (let-temporarily ((x 1234))) (+ x y)) 1)
+(test (let ((x 0)) (let ((func (lambda () (let-temporarily (((*s7* 'print-length) 12)))))) (func) (func))) ())
+(test (let ((x 0)) (set! (setter 'x) integer?) (let-temporarily ((x 1234)))) ())
+(test (let () (define (func) (let ((x #f)) (let-temporarily  ((x 1234))))) (define (hi) (func)) (hi) (hi)) ())
+(test (let ()
+        (define (func) (let ((x 0))
+                         (set! (setter 'x) (lambda (s v) (if (integer? v) v (error "setter ~A not integer" v))))
+                         (let-temporarily ((x 1234)))))
+        (func) (func))
+      ()) ; not 0! see let_temp_unwind
+(test (let ()
+        (define (func) (let ((x 0))
+                         (set! (setter 'x) (lambda (s v) (if (integer? v) v (error "setter ~A not integer" v))))
+                         (let-temporarily ((x 1234)) (+ x 1))))
+        (func) (func))
+      1235)
+
+(test (+ 4 (let-temporarily (((*s7* 'safety) 1)) (values 1 2 3)) 5) 15)
+(test (+ 4 (let-temporarily (((*s7* 'safety) 1)) (c-function-with-values 1 2 3)) 5) 15)
+
+(let ((__x__ 0)
+      (f (lambda (sym val) val)))
+  (set! (setter '__x__) f)
+  (test (eq? (setter '__x__) f) #t)
+  (let-temporarily (((setter '__x__) #f))
+    (test (setter '__x__) #f))
+  (test (eq? (setter '__x__) f) #t))
+
+;;; need global symbol test of this also
+(define ___x___ 0)
+(let ((f (lambda (sym val) val)))
+  (set! (setter '___x___) f)
+  (test (eq? (setter '___x___) f) #t)
+  (let-temporarily (((setter '___x___) #f))
+    (test (setter '___x___) #f))
+  (test (eq? (setter '___x___) f) #t))
+
+(let ()
+  (define (flet x) x)
+  (let-temporarily ((flet (lambda (x) (+ x 1))))
+    (test (flet 1) 2))
+  (test (flet 1) 1))
+
+(let () (define (f x) (let-temporarily ((x (values 1 32)) (+ x 1))))
+  (test (catch #t (lambda () (f 2)) (lambda (type info) (apply format #f info)))
+        "let-temporarily: variable declaration has more than one value?: (+ x 1)"))
+
+(let ((orig (*s7* 'print-length)))
+  (define (f x)
+    (let ((y (+ (let-temporarily (((*s7* 'print-length) 32)) (values (*s7* 'print-length) x)))))
+      (list (*s7* 'print-length) y)))
+  (test (f 1) (list orig 33))
+  (test (f 2) (list orig 34))
+
+  (test (*s7* (symbol "print-length")) orig)
+  (let-temporarily (((*s7* (symbol "print-length")) 43))
+    (test (*s7* (symbol "print-length")) 43)
+    (test (*s7* :print-length) 43))
+  (test (*s7* (symbol "print-length")) orig)
+
+  (let ((pl 'print-length)
+        (y 32))
+    (test (*s7* pl) orig)
+    (let-temporarily (((*s7* pl) 60))
+      (test (*s7* 'print-length) 60))
+    (test (*s7* pl) orig)
+    (let-temporarily ((y 12)
+                      ((*s7* pl) 23))
+      (test (*s7* pl) 23)
+      (test y 12))
+    (test (*s7* 'print-length) orig)
+    (test y 32)))
+
+(let ()
+  (define (f x)
+    (let ((y (+ (let-temporarily ((x 32)) (values x x)))))
+      (list x y)))
+  (test (f 1) '(1 64))
+  (test (f 2) '(2 64)))
+
+(let ()
+  (define (f x)
+    (let ((y (+ (catch #t (lambda () (let-temporarily ((x 32)) (values x x))) (lambda (type info) info)))))
+      (list x y)))
+  (test (f 1) '(1 64))
+  (test (f 2) '(2 64)))
+
+(let ()
+  (define (f x)
+    (let ((y (+ (dynamic-wind (lambda () #f) (lambda () (let-temporarily ((x 32)) (values x x))) (lambda () #f)))))
+      (list x y)))
+  (test (f 1) '(1 64))
+  (test (f 2) '(2 64)))
+
+(when with-block
+  (let ((obj (block 1 2 3)))
+    (let-temporarily (((obj 1) 32))
+      (test obj (block 1 32 3)))
+    (test obj (block 1 2 3))))
+
+(test (with-output-to-string
+	(lambda ()
+	  (call-with-exit
+	   (lambda (quit)
+	     (let ((x #f)
+		   (cc #f))
+	       (let-temporarily ((x 1))
+		 (set! x 2)
+		 (call/cc
+		  (lambda (return)
+		    (set! cc return)))
+		 (display x)
+		 (unless (= x 2) (quit))
+		 (set! x 3)
+		 (cc)))))))
+      (with-output-to-string
+	(lambda ()
+	  (call-with-exit
+	   (lambda (quit)
+	     (let ((x #f)
+		   (cc #f)
+		   (returned #f))
+	       (let-temporarily ((x 1))
+		 (set! x 2)
+		 (call/cc
+		  (lambda (return)
+		    (set! cc return)))
+		 (display x)
+		 (when returned (quit))
+		 (set! returned #t))
+	       (set! x 3)
+	       (cc)))))))
+
+(let ()
+  (define dil2 (let ((val 0))
+		 (dilambda (lambda ()
+			     val)
+			   (lambda (v)
+			     (set! val (+ v 2))))))
+  (let-temporarily (((dil2) 3))
+    (test (dil2) 5))
+  (test (dil2) 2)             ; 2! let-temp can't reset the value to 0!
+
+  (define dil (let ((val 0))
+		(dilambda (lambda ()
+			    (catch #t (lambda () (+ 1 #\a)) (lambda (t i) val)))
+			  (lambda (v)
+			    (catch #t (lambda () (+ 1 #\a)) (lambda (t i) (set! val v)))))))
+  (let-temporarily (((dil) 3))
+    (test (dil) 3))
+  (test (dil) 0)
+
+  (define dil1 (let ((val 0))
+		 (dilambda (lambda ()
+			     (catch #t (lambda () (+ 1 #\a)) (lambda (t i) (+ val 1))))
+			   (lambda (v)
+			     (catch #t (lambda () (+ 1 #\a)) (lambda (t i) (set! val (+ v 2))))))))
+  (test (dil1) 1)            ; read 0+1
+  (let-temporarily (((dil1) 3))
+    (test (dil1) 6))         ; 6 -- set val=3+2, read 5+1
+  (test (dil1) 4))           ; 4 -- set val=1+2 (old+2) read 3+1
+
+(let ()
+  (define dil (let ((val 0)) (dilambda (lambda () val) (lambda (v) (set! val v)))))
+  (test (let ((m1 0)) (list (call-with-exit (lambda (r) (let-temporarily (((dil) 21) (m1 (r 1 2 3))) 1))))) '(1 2 3))
+  (test (dil) 0))
+
+(let ((x #f))
+  (sort! (vector 3 2)
+	 (lambda (a b)
+	   (let-temporarily ((x (list (cons x ())
+				      (call/cc (lambda (return) (return 1))))))
+	     (> a b))))
+  (test x #f))
+
+(let ((x #f) (y 0))
+  (sort! (vector 3 2 1)
+	 (lambda (a b)
+	   (let-temporarily ((x (list (cons x ())
+				      (call/cc (lambda (return) (return 1)))))
+			     (y (cons x x)))
+	     (> a b))))
+  (test x #f)
+  (test y 0))
+
+(let ((x #f))
+  (sort! (vector 3 2 1)
+	 (lambda (a b)
+	   (let-temporarily ((x (list (call/cc (lambda (return) (return 1)))
+				      (cons x ()))))
+	     (> a b))))
+  (test x #f))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; stacktrace
+
+(test (string? (stacktrace)) #t)
+(test (begin (stacktrace 0 -1 1 20100) #f) #f) ; segfault?
+(do ((i 0 (+ i 1)))
+    ((= i 10))
+  (stacktrace (- (random 10) 50) (- (random 100) 50) (- (random 100) 50) (- (random 100) 50) (> (random 100) 50)))
+(test (stacktrace pi) 'error)
+(test (stacktrace 30 pi) 'error)
+(test (stacktrace 30 50 pi) 'error)
+(test (stacktrace 30 50 80 pi) 'error)
+(test (stacktrace 30 50 80 50 pi) 'error)
+(test (stacktrace 30 50 80 50 #f pi) 'error)
+
+(let ((str ""))
+
+  (define testtrace (lambda () (set! str (stacktrace 3))))
+  (define (hi1 a) (testtrace))
+  (define (hi2 b) (string-append (hi1 b) ""))
+  (define (hi3 c) (string-append (hi2 c) ""))
+  (define (hi4 d) (string-append (hi3 d) ""))
+  (define (hi5 e) (string-append (hi4 e) ""))
+  (define (hi6 f) (string-append (hi5 f) ""))
+  (hi6 12)
+  (test str "hi2: (string-append (hi1 b) \"\")                   ; b: 12
+hi3: (string-append (hi2 c) \"\")                   ; c: 12
+hi4: (string-append (hi3 d) \"\")                   ; d: 12
+"))
+
+(let ((str ""))
+  (define testtrace (lambda () (set! str (stacktrace 5))))
+  (define (hi1 a) (testtrace))
+  (define (hi2 b) (string-append (hi1 b) ""))
+  (define (hi3 c) (string-append (hi2 c) ""))
+  (define (hi4 d) (string-append (hi3 d) ""))
+  (define (hi5 e) (string-append (hi4 e) ""))
+  (define (hi6 f) (string-append (hi5 f) ""))
+  (hi6 12)
+  (test str "hi2: (string-append (hi1 b) \"\")                   ; b: 12
+hi3: (string-append (hi2 c) \"\")                   ; c: 12
+hi4: (string-append (hi3 d) \"\")                   ; d: 12
+hi5: (string-append (hi4 e) \"\")                   ; e: 12
+hi6: (string-append (hi5 f) \"\")                   ; f: 12
+"))
+
+(let ((str ""))
+  (define testtrace (lambda () (set! str (stacktrace 5 20 40 20))))
+  (define (hi1 a) (testtrace))
+  (define (hi2 b) (string-append (hi1 b) ""))
+  (define (hi3 c) (string-append (hi2 c) ""))
+  (define (hi4 d) (string-append (hi3 d) ""))
+  (define (hi5 e) (string-append (hi4 e) ""))
+  (define (hi6 f) (string-append (hi5 f) ""))
+  (hi6 12)
+  (test str "hi2: (string-app... ; b: 12
+hi3: (string-app... ; c: 12
+hi4: (string-app... ; d: 12
+hi5: (string-app... ; e: 12
+hi6: (string-app... ; f: 12
+"))
+
+(let ((str ""))
+  (define testtrace (lambda () (set! str (stacktrace 5 20 40 8))))
+  (define (hi1 a) (testtrace))
+  (define (hi2 b) (string-append (hi1 b) ""))
+  (define (hi3 c) (string-append (hi2 c) ""))
+  (define (hi4 d) (string-append (hi3 d) ""))
+  (define (hi5 e) (string-append (hi4 e) ""))
+  (define (hi6 f) (string-append (hi5 f) ""))
+  (hi6 12)
+  (test str "hi2: (string-app...
+         ; b: 12
+hi3: (string-app...
+         ; c: 12
+hi4: (string-app...
+         ; d: 12
+hi5: (string-app...
+         ; e: 12
+hi6: (string-app...
+         ; f: 12
+"))
+
+(let ((str ""))
+  (define testtrace (lambda () (set! str (stacktrace 5 20 40 8 #t))))
+  (define (hi1 a) (testtrace))
+  (define (hi2 b) (string-append (hi1 b) ""))
+  (define (hi3 c) (string-append (hi2 c) ""))
+  (define (hi4 d) (string-append (hi3 d) ""))
+  (define (hi5 e) (string-append (hi4 e) ""))
+  (define (hi6 f) (string-append (hi5 f) ""))
+  (hi6 12)
+  (test str "; hi2: (string-app...
+;         b: 12
+; hi3: (string-app...
+;         c: 12
+; hi4: (string-app...
+;         d: 12
+; hi5: (string-app...
+;         e: 12
+; hi6: (string-app...
+;         f: 12
+"))
+
+(let ((str ""))
+  (define testtrace (lambda () (set! str (stacktrace 5 40 80 8 #t))))
+  (define (hi1 a) (testtrace))
+  (define (hi2 b) (string-append (hi1 b) ""))
+  (define (hi3 c) (string-append (hi2 c) ""))
+  (define (hi4 d) (string-append (hi3 d) ""))
+  (define (hi5 e) (string-append (hi4 e) ""))
+  (define (hi6 f) (string-append (hi5 f) ""))
+  (hi6 12)
+  (test (string-wi=? str "; hi2: (string-append (hi1 b) \"\")
+;         b: 12
+; hi3: (string-append (hi2 c) \"\")
+;         c: 12
+; hi4: (string-append (hi3 d) \"\")
+;         d: 12
+; hi5: (string-append (hi4 e) \"\")
+;         e: 12
+; hi6: (string-append (hi5 f) \"\")
+;         f: 12") #t))
+
+(test (set! (*s7* 'max-stack-size) -1) 'error)
+(test (set! (*s7* 'max-stack-size) 0) 'error)
+(test (set! (*s7* 'max-stack-size) 32) 'error) ; this depends on INITIAL_STACK_SIZE (512)
+(test (set! (*s7* 'max-stack-size) #\a) 'error)
+(test (set! (*s7* 'max-stack-size) 3/4) 'error)
+(test (set! (*s7* 'max-stack-size) 123123.123) 'error)
+(test (integer? (*s7* 'max-stack-size)) #t)
+(test (> (*s7* 'max-stack-size) 8192) #t)
+
+(test (set! (*s7* 'max-heap-size) -1) 'error)
+(test (set! (*s7* 'max-heap-size) 0) 'error)
+(test (set! (*s7* 'max-heap-size) #\a) 'error)
+(test (set! (*s7* 'max-heap-size) 3/4) 'error)
+(test (set! (*s7* 'max-heap-size) 123123.123) 'error)
+(test (integer? (*s7* 'max-heap-size)) #t)
+(test (> (*s7* 'max-heap-size) (ash 1 20)) #t)
+
+(let () ; from lisp bboard
+  (define (st n) (if (= n 0) 0 (+ 1 (st (- n 1)))))
+  (test (st 20000) 20000))
+
+
+;;; --------------------------------------------------------------------------------
+;;; dilambda
+
+(test (let ((local 123))
+	(define pws-test (dilambda
+			  (lambda () local)
+			  (lambda (val) (set! local val))))
+	(pws-test))
+      123)
+
+(test (let ((local 123))
+	(define pws-test (dilambda
+			  (lambda () local)
+			  (lambda (val) (set! local val))))
+	(pws-test 32))
+      'error)
+
+(test (let ((local 123))
+	(define pws-test (dilambda
+			  (lambda () local)
+			  (lambda (val) (set! local val))))
+	(set! (pws-test 32) 123))
+      'error)
+
+(let ()
+  (define-constant -dl1- (let ((x 1)) (dilambda (lambda () x) (lambda (y) (set! x y)))))
+  (test (-dl1-) 1)
+  (set! (-dl1-) 3)
+  (test (-dl1-) 3)
+  (define (f1) (set! (-dl1-) 32) (-dl1-))
+  (test (f1) 32))
+
+(test (call-with-exit
+       (lambda (return)
+	 (let ((local 123))
+	   (define pws-test (dilambda
+			     (lambda () (return "oops"))
+			     (lambda (val) (set! local val))))
+	   (pws-test))))
+      "oops")
+(test (call-with-exit
+       (lambda (return)
+	 (let ((local 123))
+	   (define pws-test (dilambda
+			     (lambda () 123)
+			     (lambda (val) (return "oops"))))
+	   (set! (pws-test) 1))))
+      "oops")
+
+(test (let ((local 123))
+	(define pws-test (dilambda
+			  (lambda () local)
+			  (lambda (val) (set! local val))))
+	(set! (pws-test) 321)
+	(pws-test))
+      321)
+
+(test (let ((v (vector 1 2 3)))
+	(define vset (dilambda
+		      (lambda (loc)
+			(vector-ref v loc))
+		      (lambda (loc val)
+			(vector-set! v loc val))))
+	(let ((lst (list vset)))
+	  (let ((val (vset 1)))
+	    (set! (vset 1) 32)
+	    (let ((val1 (vset 1)))
+	      (set! ((car lst) 1) 3)
+	      (list val val1 (vset 1))))))
+      (list 2 32 3))
+
+(let ((local 123))
+  (define pws-test (dilambda
+		    (lambda () local)
+		    (lambda (val) (set! local val))))
+  (test (dilambda? pws-test) #t)
+  (test (pws-test) 123)
+  (set! (pws-test) 32)
+  (test (pws-test) 32)
+  (set! (pws-test) 0)
+  (test (pws-test) 0)
+  (test (set! (pws-test . 1) 1) 'error)
+  (test (set! (pws-test 1) 1) 'error)
+  (test (set! (pws-test 1) . 1) 'error)
+  (test (set! (pws-test)) 'error))
+
+(let ((local 123))
+  (define pws-test (dilambda
+		    (lambda (val) (+ local val))
+		    (lambda (val new-val) (set! local new-val) (+ local val))))
+  (test (pws-test 1) 124)
+  (set! (pws-test 1) 32)
+  (test (pws-test 2) 34)
+  (set! (pws-test 3) 0)
+  (test (pws-test 3) 3))
+
+(let ((ho (dilambda (lambda* ((a 1)) a) (lambda* (a (b 2)) (set! a b) a))))
+  (test (ho) 1)
+  (test (ho 3) 3)
+  (test (set! (ho) 32) 2)
+  (test (set! (ho 3) 32) 32))
+
+
+(test (dilambda) 'error)
+(test (dilambda abs) 'error)
+(test (dilambda 1 2) 'error)
+(test (dilambda (lambda () 1) (lambda (a) a) (lambda () 2)) 'error)
+(test (dilambda (lambda () 1) 2) 'error)
+(test (call-with-exit (lambda (return) (let ((g (dilambda return (lambda (s v) s)))) (g 0)))) 'error)
+(test (call-with-exit (lambda (return) (let ((g (dilambda (lambda (s) s) return))) (g 0)))) 'error)
+(test (+ (call-with-exit (lambda (return) (let ((g (dilambda (lambda (s) s) return))) (set! (g 1) 2))))) 'error)
+
+(test (set! (dilambda (lambda () 3) (lambda (x) x)) 32) 'error) ; dilambda (a c-function) does not have a setter
+;; dilambda returns the getter, and it has a setter: (setter (dilambda (lambda () 3) (lambda (x) x))) -> #<lambda (x)>
+;;   but the argument to set! if a pair expects the car (as a symbol) to have a setter(?), so...
+(test (let ((d (dilambda (lambda () 3) (lambda (x) x)))) (define (f) d) (set! ((f)) 12)) 12) ;!  maybe dilambda should have a setter...
+(test (set! ((dilambda (lambda () 3) (lambda (x) x))) 12) 12)
+(test (let ((f (lambda () 3))) (set! (setter f) (lambda (x) x)) (set! (f) 12)) 12)
+(test (set! ((let ((f (lambda () 3))) (set! (setter f) (lambda (x) x)) f)) 12) 12)
+(test (set! (let ((f (lambda () 3))) (set! (setter f) (lambda (x) x)) f) 12) 'error) ; let (syntactic) does not have a setter
+
+(for-each
+ (lambda (arg)
+   (test (dilambda arg (lambda () #f)) 'error)
+   (test (dilambda (lambda () #f) arg) 'error))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(for-each
+ (lambda (arg)
+   (test (dilambda? arg) #f))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi "hi" #(()) abs (lambda () #f) (list (lambda () #f) (lambda (val) val)) (list 1 2 3) '(1 . 2) #<eof> #<unspecified> #<undefined>))
+
+(let ((pws (dilambda vector-ref vector-set!)))
+  (let ((v (vector 1 2 3)))
+    (test (dilambda? pws) #t)
+    (test (dilambda? pws pws) 'error)
+    (test (pws v 1) 2)
+    (set! (pws v 1) 32)
+    (test (pws v 1) 32)))
+
+(test (dilambda?) 'error)
+
+(let ()
+  (define macfun (dilambda
+		  (define-macro (_m_ a) `(+ ,a 1))
+		  (define-macro (_m_ a b) `(- ,a 1))))
+
+  (test (macfun (+ 2 3)) 6)
+  (test (set! (macfun (+ 2 3)) 3) 4))
+
+(let () ; reality check...
+  (set! (setter logbit?)
+	(define-macro (_m_ var index on)
+	  `(if ,on
+	       (set! ,var (logior ,var (ash 1 ,index)))
+	       (set! ,var (logand ,var (lognot (ash 1 ,index)))))))
+
+  (define (mingle a b)
+    (let ((r 0))
+      (do ((i 0 (+ i 1)))
+          ((= i 31) r)
+        (set! (logbit? r (* 2 i)) (logbit? a i))
+        (set! (logbit? r (+ (* 2 i) 1)) (logbit? b i)))))
+
+  (test (mingle 6 3) 30)
+  (set! (setter logbit?) #f))
+
+(let ()
+  (dilambda logbit?
+	    (define-macro (_m_ var index on)
+	      `(if ,on
+		   (set! ,var (logior ,var (ash 1 ,index)))
+		   (set! ,var (logand ,var (lognot (ash 1 ,index)))))))
+  (define (mingle a b)
+    (let ((r 0))
+      (do ((i 0 (+ i 1)))
+          ((= i 31) r)
+        (set! (logbit? r (* 2 i)) (logbit? a i))
+        (set! (logbit? r (+ (* 2 i) 1)) (logbit? b i)))))
+
+  (test (mingle 6 3) 30)
+  (set! (setter logbit?) #f))
+
+
+#|
+(let ()
+  (define pws-args (dilambda
+		    (lambda args args)
+		    (lambda args (set-car! args 0) args)))
+  (let ((lst (list 1 2 3)))
+    (let ((l1 (apply pws-args lst)))
+      (test l1 '(1 2 3))
+      (set-car! l1 32)
+      (test lst '(1 2 3))
+      (set! (pws-args l1) 3)
+      (test l1 '(32 2 3))
+      (test lst '(1 2 3))
+      (let ()
+	(define (pws1)
+	  (pws-args lst))
+	(let ((l2 (pws1)))
+	  (set! l2 (pws1))
+	  (test lst '(1 2 3)))))))
+|#
+
+(test (call-with-exit (lambda (return) (dilambda? return))) #f)
+(test (dilambda? quasiquote) #f)
+
+(test (let ((pws (dilambda (lambda args (apply + args)) (lambda args (apply * args))))) (pws 2 3 4)) 9)
+(test (let ((pws (dilambda (lambda args (apply + args)) (lambda args (apply * args))))) (set! (pws 2 3 4) 5)) 120)
+(let ((x 0))
+  (let ((pws (dilambda
+	      (let ((y 1)) ((lambda () (set! x (+ x y)) (lambda () x))))
+	      (let ((y 2)) ((lambda () (set! x (* x y)) (lambda (z) (set! x (+ x z)))))))))
+    (test x 2)
+    (set! (pws) 3)
+    (test x 5)))
+
+(let ((p1 (dilambda (lambda () 1) (lambda (a) a)))) (test (dilambda? (dilambda p1 p1)) 'error))
+(test ((dilambda call-with-exit call/cc) (lambda (a) (a 1))) 1) ;call/cc itself is a c_function
+(test (length (dilambda < >)) #f)
+
+(let ()
+  (define sf1 (let ((val 0))
+	      (dilambda
+	       (let ((+signature+ '(integer?))
+		     (+documentation+ "getter help"))
+		 (lambda ()
+		   val))
+	       (let ((+signature+ '(integer? integer?))
+		     (+documentation+ "setter help"))
+		 (lambda (new-val)
+		   (if (integer? new-val)
+		       (set! val new-val)
+		       (error 'wrong-type-arg ";sf1 new value should be an integer: ~A" new-val)))))))
+  (test (documentation sf1) "getter help")
+  (test (documentation (setter sf1)) "setter help")
+  (test (signature sf1) '(integer?))
+  (test (signature (setter sf1)) '(integer? integer?)))
+
+;;; dilambda?
+(test (dilambda? (dilambda (lambda () 1) (make-hook))) 'error)
+(test (dilambda? (dilambda (make-hook) (setter car))) #t) ; ??
+
+(for-each
+ (lambda (arg)
+   (if (dilambda? arg)
+       (format #t ";(dilambda? ~A) -> #t?~%" arg)))
+ (list "hi" _ht_ _undef_ _null_ :hi (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f #() (if #f #f)))
+
+(test (dilambda?) 'error)
+(test (dilambda? abs car) 'error)
+(test (dilambda? abs) #f)
+(test (dilambda? car) #t)
+
+(let () (define xb (dilambda (lambda args args) (lambda args args))) (define (fxb) (set! (xb 3) 2)) (fxb) (fxb))
+;;; this test needs to be outside the test macro
+
+(when (zero? (*s7* 'debug))
+  (test (object->string (dilambda (lambda () 1) quasiquote) :readable) "(dilambda (lambda () 1) #_quasiquote)")
+  (test (let ((str (object->string (dilambda (lambda (x) x) logior) :readable)))
+  	  (pair? (member str '("(dilambda (lambda (x) x) #_logior)" "(dilambda (lambda (x) x) logior)"))))
+          #t)
+  (test (let () (define-macro (mac x) `(+ ,x 1)) (object->string (dilambda (lambda () 1) mac) :readable)) "(dilambda (lambda () 1) (lambda (x) (list-values '+ x 1)))")
+  (test (object->string (dilambda (lambda (x) x) (lambda* (x y . z) x)) :readable) "(dilambda (lambda (x) x) (lambda* (x y . z) x))")
+  (test (object->string (dilambda (lambda (x) x) (lambda (x . y) x)) :readable) "(dilambda (lambda (x) x) (lambda (x . y) x))")
+  (test (object->string (dilambda (lambda* (x) x) (lambda* ((x 1) :rest y) x)) :readable) "(dilambda (lambda* (x) x) (lambda* ((x 1) :rest y) x))"))
+
+
+;;; --------------------------------------------------------------------------------
+;;; copy
+
+(test (copy 3) 3)
+(test (copy 3/4) 3/4)
+(test (copy "hi") "hi")
+(test (copy 'hi) 'hi)
+(test (copy (list 1 2 3)) (list 1 2 3))
+(test (copy (vector 0.0)) (vector 0.0))
+(let ((bv (make-byte-vector 10 2))) (test (copy bv) bv))
+(let ((iv (make-int-vector 10 2))) (test (copy iv) iv))
+(let ((fv (make-float-vector 10 2.5))) (test (copy fv) fv))
+(test (copy #\f) #\f)
+(test (copy (list 1 (list 2 3))) (list 1 (list 2 3)))
+(test (copy (cons 1 2)) (cons 1 2))
+(test (let ((x (list 1 2 3))) (eq? (copy x) x)) #f)
+(test (let ((x (list 1 2 3))) (equal? (copy x) x)) #t)
+(test (let ((x #(1 2 3))) (eq? (copy x) x)) #f)
+(test (let ((x #(1 2 3))) (equal? (copy x) x)) #t)
+(test (let ((x "hi")) (eq? (copy x) x)) #f)
+(test (let ((x "hi")) (equal? (copy x) x)) #t)
+(test (copy '(1 2 . 3)) '(1 2 . 3))
+(test (copy (+)) 0)
+(test (copy +) +)
+(test (copy (#(#() #()) 1)) #())
+(test (copy #f) #f)
+(test (copy ()) ())
+(test (copy #()) #())
+(test (copy #2d((1 2) (3 4))) #2d((1 2) (3 4)))
+(test (let ((f (lambda () 1))) ((copy f))) 1)
+(test (let ((f (lambda () 1))) (eq? (copy f) f)) #f)
+(test (let ((f (lambda* ((a 2)) (+ a 1)))) ((copy f))) 3)
+(test (let ((f (lambda* ((a 2)) (+ a 1)))) (eq? (copy f) f)) #f)
+(test (copy 1.0) 1.0)
+(test (copy 1.0+i) 1.0+i)
+(test (copy "") "")
+(test (copy #t) #t)
+(test (copy (string #\a #\null #\b)) "a\x00;b")
+(test (copy #<eof>) #<eof>)
+(test ((copy abs) -123) 123)
+(test (copy ''1) ''1)
+(test (copy '''1) '''1)
+(test (copy not) not)
+(test (copy "a\x00;b") "a\x00;b")
+(test (infinite? (copy (log 0.0))) #t)
+(test (nan? (copy 1/0)) #t)
+(test (copy if) if)
+(test (copy quote) quote)
+(test (let ((a 1) (b 2)) (equal? (copy (curlet)) (curlet))) #t)
+(test (copy (rootlet)) (rootlet))
+(test (copy (funclet abs)) (rootlet))
+(test (copy (funclet quasiquote)) (rootlet))
+(test (eval '(+ a 1) (copy (sublet (curlet) '(a . 2)))) 3)
+(test (copy #<undefined>) #<undefined>)
+(test (copy _undef_) _undef_)
+(test (object->string (copy *s7*)) "(inlet 'let-ref-fallback s7-let-ref 'let-set-fallback s7-let-set)")
+
+(test (copy (list 1 2 (list 3 4))) '(1 2 (3 4)))
+(test (copy (cons 1 2)) '(1 . 2))
+(test (copy '(1 2 (3 4) . 5)) '(1 2 (3 4) . 5))
+(test (copy ()) ())
+(let ((L '(1 (2 . 3) (4 5 . 6)))) (test L (copy L)))
+(test (let ((L '((1 2 (3 . 4)) ((5 . 6))))) (object->string (copy L))) "((1 2 (3 . 4)) ((5 . 6)))")
+
+(test (copy) 'error)
+(test (copy () () ()) 'error)
+(test (copy (make-hash-table) pi) 'error)
+(test (copy 1 3) 'error)
+(test (copy #() abs) 'error)
+(test (let ((x 0)) (copy 0 x)) 'error)
+(test (let () (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (copy 0 x)))) 'error)
+(test (let () (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (copy 0 x))) 'error)
+(test (let ((x 0)) (set! x (copy 0 x))) 'error)
+(test (let () (define (func) (let ((x 0)) (set! x (copy 0 x)))) (func)) 'error)
+
+;;; 2 arg version of copy
+(test (copy (list 1 2) (vector 0 0)) #(1 2))
+(test (copy (list 1 2) (vector 0)) #(1))
+(test (copy (list 1 2) (vector)) #())
+(test (copy (list) (vector)) #())
+(test (copy (list 1 2) (vector 0 0 3 4)) #(1 2 3 4))
+; should (copy 1 2) be an error?
+(test (copy #2d((1 2) (3 4)) (vector 0 0 0 0 0)) #(1 2 3 4 0))
+(test (copy (vector 0 0 0 0 0) #2d((1 2) (3 4))) #2d((0 0) (0 0)))
+(test (copy (vector 1 2 3 4 5) #2d((0 0) (0 0))) #2d((1 2) (3 4)))
+(test (copy "12345" (make-list 5)) '(#\1 #\2 #\3 #\4 #\5))
+(test (copy (list #\0 #\1 #\2) (make-string 3)) "012")
+(test (copy '(0 1 2 3) (list 4 3 2 1)) '(0 1 2 3))
+(test (copy #(0 1 2 3) (vector 4 3 2 1)) #(0 1 2 3))
+(test (copy "12345" (make-string 5)) "12345")
+(test (copy "12345" (make-byte-vector 5))  #u(49 50 51 52 53))
+(test (copy '(4 3 2 1) '(1 . 2)) '(4 . 2))
+(test (copy (string (integer->char 255)) (vector 0)) #(#\xff))
+(test (copy (vector (integer->char 255)) (string #\a)) (string (integer->char 255)))
+(test (copy #() "") "")
+(test (copy "" #()) #())
+(test (copy #() (vector 1 2 3)) #(1 2 3))
+(test (copy (make-float-vector 3 0.0)) (make-float-vector 3 0.0))
+(test (copy (make-int-vector 3 0)) (make-int-vector 3 0))
+(test (copy (make-int-vector '(2 3) 0)) (make-int-vector '(2 3) 0))
+(test (eq? (copy 1) 1) #f)
+(test (eq? (copy 1.0) 1.0) #f)
+(test (eq? (copy 2/3) 2/3) #f)
+;(test (eq? (copy "") "") #f) ; 23-Apr-24 these might both be nil_string
+(test (copy #u(101 102) (vector 1 2)) #(101 102))
+(if with-block (test (copy (block 1.0) (immutable! (block 2.0))) 'error))
+(test (pair? (copy *s7* (make-list (length *s7*)))) #t)
+
+(test (copy (vector 1 2 3 4 5) (vector 1 2 3) 0 5) #(1 2 3))
+(test (copy (vector 1 2 3 4 5) (vector 1 2 3) 0 1) #(1 2 3))
+(test (copy (vector 1 2 3 4 5) (vector 0 0 0) 0 1) #(1 0 0))
+(test (copy (vector 1 2 3 4 5) (vector 0 0 0) 1 1) #(0 0 0))
+(test (copy (vector 1 2 3 4 5) (vector 0 0 0) 1 2) #(2 0 0))
+(test (copy (vector 1 2 3 4 5) (vector 0 0 0) 0 10) 'error) ;error: copy fourth argument, 10, is out of range (it is too large))
+(test (copy (vector 1 2 3 4 5) (vector 0 0 0) 0 4) #(1 2 3))
+(test (copy (vector 1 2 3) (vector 0 0 0 0 0 0) 0 4) 'error) ;error: copy fourth argument, 4, is out of range (it is too large))
+(test (copy (vector 1 2 3) (vector 0 0 0 0 0 0) 0 2) #(1 2 0 0 0 0))
+(test (copy (vector 1 2 3 4 5) (vector 0) 0 2) #(1))
+(test (copy (vector 1 2 3 4 5) (vector 0) 0 20) 'error) ;error: copy fourth argument, 20, is out of range (it is too large))
+(test (copy (vector 1 2 3 4 5) (vector 0) 0 6) 'error) ;error: copy fourth argument, 6, is out of range (it is too large))
+(test (copy (vector 1 2 3 4 5) (vector 0) 0 5) #(1))
+
+(let ((v1 (make-vector 8 'a symbol?))) (set! (v1 0) 'b) (test (equal? v1 (copy v1)) #t))
+(let ((v1 (make-vector '(2 3) 'a symbol?))) (set! (v1 0 0) 'b) (test (equal? v1 (copy v1)) #t))
+(let ((v1 (make-vector 3 12 integer?))) (set! (v1 0) 123) (test (equal? v1 (copy v1)) #t))
+(let ((v1 (make-vector 3 12.0 float?))) (set! (v1 0) 123.0) (test (equal? v1 (copy v1)) #t))
+(let ((v1 (make-vector 8 'a symbol?)) (v2 (make-vector 8 'a symbol?))) (set! (v1 0) 'b) (test (equal? v1 (copy v1 v2)) #t))
+(let ((v1 (make-vector '(2 3) 'a symbol?)) (v2 (make-vector '(2 3) 'a symbol?))) (set! (v1 0 0) 'b) (test (equal? v1 (copy v1 v2)) #t))
+(let ((v1 (make-vector 3 12 integer?)) (v2 (make-vector 3 12 integer?))) (set! (v1 0) 123) (test (equal? v1 (copy v1 v2)) #t))
+(let ((v1 (make-vector 8 'a symbol?)) (v2 (make-vector 8 'a symbol?))) (test (equal? v1 (copy v1 v2 1 3)) #t))
+(let ((v1 (make-vector '(2 3) 'a symbol?)) (v2 (make-vector '(2 3) 'a symbol?))) (test (equal? v1 (copy v1 v2 0 3)) #t))
+(let ((v1 (make-vector 3 12 integer?)) (v2 (make-vector 3 12 integer?))) (set! (v1 0) 123) (set! (v1 1) 321) (test (equal? v1 (copy v1 v2 0 2)) #t))
+(let ((v1 (make-vector 8 #\a char?)))
+  (do ((i 0 (+ i 1)))
+      ((= i 8))
+    (set! (v1 i) (integer->char (+ 70 i))))
+  (test (equal? v1 (copy v1)) #t))
+
+(let ((<1> (list #f #f #f))
+      (<2> (list 1 1 1)))
+  (set-cdr! (list-tail <1> 2) <1>)
+  (set-cdr! (list-tail <2> 2) <2>)
+  (test (copy (make-byte-vector 256 1) <1>) <2>))
+
+(let ((lst (list 1 2 3))) ; segfault before source==dest check
+  (test (copy lst lst) lst)
+  (test (copy lst lst 1) (list 2 3 3)))
+
+(when with-block
+  (let ((b (copy (block 1 2 3 4))))
+    (test b (block 1 2 3 4))
+    (fill! b 0 1 3)
+    (test b (block 1 0 0 4))
+    (let ((b1 (block 1 1 1 1 1)))
+      (copy b b1)
+      (test b1 (block 1 0 0 4 1)))
+    (let ((b2 (block 1 2 3)))
+      (let ((b3 (copy b b2)))
+	(test (eq? b2 b3) #t)
+	(test b3 (block 1 0 0))))
+    (let ((b4 (block 5 6 7 8)))
+      (copy b4 b 1)
+      (test b (block 6 7 8 4))))
+  (let ((b (block 1 2 3 4)))
+    (copy #r(0 3 6) b)
+    (test b (block 0 3 6 4))
+    (copy #(10 11 12 13 14) b)
+    (test b (block 10 11 12 13))
+    (copy '(0 2) b)
+    (test b (block 0 2 12 13))
+    (copy #u(0 0 100 101) b 2)
+    (test b (block 100 101 12 13))
+    (copy #r(0 1 2 3 4) b 1 3)
+    (test b (block 1 2 12 13))
+    (test (copy #r(0 1 2 3 4 5 6) b 3 12) 'error))
+  (let ((b (block 1 2 3))
+	(v (float-vector 0 0 0)))
+    (copy b v)
+    (test v (float-vector 1 2 3))
+    (copy (list 3 2 1) b)
+    (test b (block 3 2 1))))
+
+(let ((lst (list 1 2 3)))
+   (set! (cdr (cddr lst)) lst)
+   (test (copy lst lst) lst)
+   (test (copy lst (make-list 15 5)) '(1 2 3 5 5 5 5 5 5 5 5 5 5 5 5))) ; was going around twice
+
+(let ((v (vector 1 2 3)))
+  (test (copy v v) v)
+  (test (copy v v 1 3) #(2 3 3)))
+
+(test (copy #(1 2 3 4 5 6) (make-list 3) 0 3) '(1 2 3))
+(test (copy #(1 2 3 4 5 6) (make-list 3) 0) '(1 2 3))
+(test (copy #(1 2 3 4 5 6) (make-list 3) 1) '(2 3 4))
+(test (copy #(1 2 3 4 5 6) (make-list 3 0) 5) '(6 0 0))
+(test (copy #(1 2 3 4 5 6) (make-list 3)) '(1 2 3))
+(test (copy #(1 2 3 4 5 6) (make-list 3) 1 4) '(2 3 4))
+(test (copy #(1 2 3 4 5 6) (make-list 3 #f) 1 2) '(2 #f #f))
+(test (copy #(1 2 3 4 5 6) (make-list 3 #f) 1 1) '(#f #f #f))
+(test (copy #(1 2 3 4 5 6) (make-list 3 #f) -1 1) 'error)
+(test (copy #(1 2 3 4 5 6) (make-list 3 #f) 1 7) 'error)
+(test (copy #(1 2 3 4 5 6) (make-list 3 #f) 1 0) 'error)
+(test (copy #(1 2 3 4 5 6) () 1 2) ())
+(test (copy #(1 2 3 4 5 6) ()) ())
+(test (copy #(1 2 3 4 5 6) (make-list 6 #f) 2) '(3 4 5 6 #f #f))
+(test (copy #(1 2 3 4 5 6) '(0 0 0 . 3)) '(1 2 3 . 3))
+
+(let ((lst (list 7 8 9)))
+   (set! (cdr (cddr lst)) lst)
+   (copy #(1 2 3 4 5 6) lst 0 1)
+   (test (car lst) 1)
+   (copy #(1 2 3 4 5 6) lst 1 4)
+   (test (car lst) 2))
+
+(test (copy #(#\a #\b #\c) (make-string 2) 1) "bc")
+(test (copy '(#\a #\b #\c) (make-string 2) 1) "bc")
+(test (copy "abc" (make-string 2) 1) "bc")
+(test (copy "abc" (make-vector 2) 1) #(#\b #\c))
+(test (copy "abc" (make-list 2) 1) '(#\b #\c))
+(test (copy '(1 2 3) (make-list 2) 1) '(2 3))
+(test (copy '(1 2 3) (make-vector 2) 1) #(2 3))
+(test (copy #(1 2 3) (make-vector 2) 1) #(2 3))
+(test (copy #(1 2 3) (make-list 2) 1) '(2 3))
+
+(let ((orig "0123456789"))
+  (let ((iv (copy (string->byte-vector orig) (make-int-vector 10))))
+    (test (byte-vector->string (string->byte-vector (copy iv (make-string 10)))) orig)))
+(test (copy "0123456789" (make-float-vector 10)) (float-vector 48 49 50 51 52 53 54 55 56 57))
+
+(test (let ((e (inlet 'a 1 'b 2 'c 3)) (f (inlet 'd 4))) (copy e f)) (inlet 'd 4 'c 3 'b 2 'a 1))
+(test (let ((e (inlet 'a 1 'b 2 'c 3)) (f (inlet 'd 4))) (copy e f 0)) (inlet 'd 4 'c 3 'b 2 'a 1))
+(test (let ((e (inlet 'a 1 'b 2 'c 3)) (f (inlet 'd 4))) (copy e f 1)) (inlet 'b 2 'c 3 'd 4))
+(test (let ((e (inlet 'a 1 'b 2 'c 3)) (f (inlet 'd 4))) (copy e f 1 2)) (inlet 'd 4 'b 2))
+(test (let ((e (inlet 'a 1 'b 2 'c 3)) (f (inlet 'd 4))) (copy f e)) (inlet 'a 1 'b 2 'c 3 'd 4))
+;; printout is confusing (is this a reversal in this slot list, or a let-id side-effect?)
+(test (let ((e (inlet 'a 1 'b 2 'c 3)) (f (inlet 'a 100 'b 200 'c 300 'd 400))) ((copy e f) 'a)) 100) ; this is a bad test -- depends on order whereas let should not
+(test (let ((f (inlet 'a 100 'b 200 'c 300 'd 400)) (e (inlet 'a 1 'b 2 'c 3))) ((copy e f) 'a)) 1)
+(test (let ((e (inlet 'a 1 'b 2 'c 3)) (f (inlet 'a 100 'b 200 'c 300 'd 400))) (copy e f)) (inlet 'c 3 'b 2 'a 1 'a 100 'b 200 'c 300 'd 400))
+
+(test (weak-hash-table? (copy (weak-hash-table))) #t)
+(test (object->string (copy (weak-hash-table 'a 1))) "(weak-hash-table 'a 1)")
+
+(let ((e1 (inlet 'a 1 'b 2))
+      (e2 (inlet 'a 3 'c 3))
+      (v1 (vector 1 2))
+      (v2 (vector 3 4))
+      (i1 (int-vector 5 6))
+      (i2 (int-vector 7 8))
+      (h1 (hash-table 'd 4 'e 5))
+      (h2 (hash-table 'f 6 'e 7))
+      (f1 (float-vector 9 10))
+      (f2 (float-vector 11 12))
+      (p1 (list 13 14))
+      (p2 (list 15 16))
+      (b1 (if with-block (block 17 18) (float-vector 17 18)))
+      (b2 (if with-block (block 19 20) (float-vector 19 20)))
+      (s1 (make-string 2 #\a))
+      (s2 (make-string 2 #\b)))
+  (test (copy e1 e2) (inlet 'a 1 'b 2 'a 3 'c 3))
+  (test (copy e1 v2) #((a . 1) (b . 2)))
+  (test (copy e1 i2) 'error)
+  (test (copy e1 f2) 'error)
+  (test (copy e1 h2) (hash-table 'a 1 'b 2 'e 7 'f 6))
+  (test (copy e1 p2) '((a . 1) (b . 2)))
+  (if with-block (test (copy e1 b2) 'error))
+  (test (copy e1 s2) 'error)
+  (test (copy v1 e2) 'error)
+  (test (copy v1 v2) #(1 2))
+  (test (copy v1 i2) (int-vector 1 2))
+  (test (copy v1 f2) (float-vector 1.0 2.0))
+  (test (copy v1 h2) 'error)
+  (test (copy v1 p2) '(1 2))
+  (if with-block (test (copy v1 b2) (block 1.000 2.000)))
+  (test (copy v1 s2) 'error)
+  (test (copy i1 e2) 'error)
+  (test (copy i1 v2) #(5 6))
+  (test (copy i1 i2) (int-vector 5 6))
+  (test (copy i1 f2) (float-vector 5.0 6.0))
+  (test (copy i1 h2) 'error)
+  (test (copy i1 p2) '(5 6))
+  (if with-block (test (copy i1 b2) (block 5.000 6.000)))
+  (test (copy i1 s2) "\x05;\x06;")
+  (test (copy f1 e2) 'error)
+  (test (copy f1 v2) #(9.0 10.0))
+  (test (copy f1 i2) 'error) ;(int-vector 9 10))
+  (test (copy f1 f2) (float-vector 9.0 10.0))
+  (test (copy f1 h2) 'error)
+  (test (copy f1 p2) '(9.0 10.0))
+  (if with-block (test (copy f1 b2) (block 9.000 10.000)))
+  (test (copy f1 s2) 'error)
+  (test (copy h1 e2) (inlet 'd 4 'e 5 'b 2 'a 1 'a 3 'c 3))
+  (test (let ((h (copy h1 v2)))
+	  (or (equal? h #((d . 4) (e . 5)))
+	      (equal? h #((e . 5) (d . 4)))))
+	#t)
+  (test (copy h1 i2) 'error)
+  (test (copy h1 f2) 'error)
+  (test (copy h1 h2) (hash-table 'a 1 'b 2 'd 4 'e 5 'f 6))
+  (test (let ((p (copy h1 p2)))
+	  (or (equal? p '((d . 4) (e . 5)))
+	      (equal? p '((e . 5) (d . 4)))))
+	#t)
+  (test (copy h1 b2) 'error)
+  (test (copy h1 s2) 'error)
+  (test (copy p1 e2) 'error)
+  (test (copy p1 v2) #(13 14))
+  (test (copy p1 i2) (int-vector 13 14))
+  (test (copy p1 f2) (float-vector 13.0 14.0))
+  (test (copy p1 h2) 'error)
+  (test (copy p1 p2) '(13 14))
+  (test (copy p1 b2) (if with-block (block 13.000 14.000) (float-vector 13.0 14.0)))
+  (test (copy p1 s2) 'error)
+  (test (copy b1 e2) 'error)
+  (test (copy b1 v2) #(17.0 18.0))
+  (test (copy b1 i2) 'error) ;(int-vector 17 18))
+  (test (copy b1 f2) (float-vector 17.0 18.0))
+  (test (copy b1 h2) 'error)
+  (test (copy b1 p2) '(17.0 18.0))
+  (test (copy b1 b2) (if with-block (block 17.000 18.000) (float-vector 17.0 18.0)))
+  (test (copy b1 s2) 'error)
+  (test (copy s1 e2) 'error)
+  (test (copy s1 v2) #(#\a #\a))
+  (test (copy s1 i2) (int-vector 97 97))
+  (test (copy s1 f2) (float-vector 97.0 97.0))
+  (test (copy s1 h2) 'error)
+  (test (copy s1 p2) '(#\a #\a))
+  (if with-block (test (copy s1 b2) 'error))
+  (test (copy s1 s2) "aa"))
+
+(let ((e1 (inlet 'a 1 'b 2))
+      (e2 (inlet 'a 3 'c 3))
+      (v1 (vector 1 2))
+      (v2 (vector 3 4))
+      (i1 (int-vector 5 6))
+      (i2 (int-vector 7 8))
+      (h1 (hash-table 'd 4 'e 5))
+      (h2 (hash-table 'f 6 'e 7))
+      (f1 (float-vector 9 10))
+      (f2 (float-vector 11 12))
+      (p1 (list 13 14))
+      (p2 (list 15 16))
+      (b1 (if with-block (block 17 18) (float-vector 17 18)))
+      (b2 (if with-block (block 19 20) (float-vector 19 20)))
+      (s1 (make-string 2 #\a))
+      (s2 (make-string 2 #\b)))
+  (test (copy e1 e2 1) (inlet 'a 3 'c 3 'b 2))
+  (test (copy e1 v2 1) #((b . 2) 4))
+  (test (copy e1 i2 1) 'error)
+  (test (copy e1 f2 1) 'error)
+  (test (copy e1 h2 1) (hash-table 'b 2 'e 7 'f 6))
+  (test (copy e1 p2 1) '((b . 2) 16))
+  (if with-block (test (copy e1 b2 1) 'error))
+  (test (copy e1 s2 1) 'error)
+  (test (copy v1 e2 1) 'error)
+  (test (copy v1 v2 1) #(2 4))
+  (test (copy v1 i2 1) (int-vector 2 8))
+  (test (copy v1 f2 1) (float-vector 2.0 12.0))
+  (test (copy v1 h2 1) 'error)
+  (test (copy v1 p2 1) '(2 16))
+  (if with-block (test (copy v1 b2 1) (block 2.000 20.000)))
+  (test (copy v1 s2 1) 'error)
+  (test (copy i1 e2 1) 'error)
+  (test (copy i1 v2 1) #(6 4))
+  (test (copy i1 i2 1) (int-vector 6 8))
+  (test (copy i1 f2 1) (float-vector 6.0 12.0))
+  (test (copy i1 h2 1) 'error)
+  (test (copy i1 p2 1) '(6 16))
+  (if with-block (test (copy i1 b2 1) (block 6.000 20.000)))
+  (test (copy i1 s2 1) "\x06;b")
+  (test (copy f1 e2 1) 'error)
+  (test (copy f1 v2 1) #(10.0 4))
+  (test (copy f1 i2 1) 'error) ;(int-vector 10 8))
+  (test (copy f1 f2 1) (float-vector 10.0 12.0))
+  (test (copy f1 h2 1) 'error)
+  (test (copy f1 p2 1) '(10.0 16))
+  (if with-block (test (copy f1 b2 1) (block 10.000 20.000)))
+  (test (copy f1 s2 1) 'error)
+  (test (let ((v (copy h1 v2 1)))
+	  (or (equal? v #((e . 5) 4))
+	      (equal? v #((d . 4) 4))))
+	#t)
+  (test (copy h1 i2 1) 'error)
+  (test (copy h1 f2 1) 'error)
+  (test (let ((h (copy h1 h2 1)))
+	  (or (equal? h (hash-table 'b 2 'e 5 'f 6))
+	      (equal? h (hash-table 'e 7 'b 2 'f 6 'd 4)))) ; ??
+	#t)
+  (test (let ((p (copy h1 p2 1)))
+	  (or (equal? p '((e . 5) 16))
+	      (equal? p '((d . 4) 16))))
+	#t)
+  (test (copy h1 b2 1) 'error)
+  (test (copy h1 s2 1) 'error)
+  (test (copy p1 e2 1) 'error)
+  (test (copy p1 v2 1) #(14 4))
+  (test (copy p1 i2 1) (int-vector 14 8))
+  (test (copy p1 f2 1) (float-vector 14.0 12.0))
+  (test (copy p1 h2 1) 'error)
+  (test (copy p1 p2 1) '(14 16))
+  (test (copy p1 b2 1) (if with-block (block 14.000 20.000) (float-vector 14.0 20.0)))
+  (test (copy p1 s2 1) 'error)
+  (test (copy b1 e2 1) 'error)
+  (test (copy b1 v2 1) #(18.0 4))
+  (test (copy b1 i2 1) 'error) ;(int-vector 18 8))
+  (test (copy b1 f2 1) (float-vector 18.0 12.0))
+  (test (copy b1 h2 1) 'error)
+  (test (copy b1 p2 1) '(18.0 16))
+  (test (copy b1 b2 1) (if with-block (block 18.000 20.000) (float-vector 18.0 20.0)))
+  (test (copy b1 s2 1) 'error)
+  (test (copy s1 e2 1) 'error)
+  (test (copy s1 v2 1) #(#\a 4))
+  (test (copy s1 i2 1) (int-vector 97 8))
+  (test (copy s1 f2 1) (float-vector 97.0 12.0))
+  (test (copy s1 h2 1) 'error)
+  (test (copy s1 p2 1) '(#\a 16))
+  (if with-block (test (copy s1 b2 1) 'error))
+  (test (copy s1 s2 1) "ab"))
+
+(for-each (lambda (x)
+	    (let ((y (copy x)))
+	      (if (not (equal? x y)) (format *stderr* ";(copy ~S) -> ~S?~%" x y))))
+	  (list (list 1 2) (cons 1 2) #(1 2) #i(1 2) #u(1 2) #r(1 2) "12" (hash-table 'a 1) (inlet 'a 2)))
+#|
+(when full-s7test
+  (let ((e1 (inlet 'a 1 'b 2))
+        (e2 (inlet 'a 3 'c 3))
+        (v1 (vector 1 2))
+        (v2 (vector 3 4))
+        (i1 (int-vector 5 6))
+        (i2 (int-vector 7 8))
+        (h1 (hash-table 'd 4 'e 5))
+        (h2 (hash-table 'f 6 'e 7))
+        (f1 (float-vector 9 10))
+        (f2 (float-vector 11 12))
+        (p1 (list 13 14))
+        (p2 (list 15 16))
+        (b1 (if with-block (block 17 18) (vector 17 18)))
+        (b2 (if with-block (block 19 20) (vector 19 20)))
+        (s1 (make-string 2 #\a))
+        (s2 (make-string 2 #\b)))
+    (for-each
+     (lambda (o1 o1name)
+       (for-each
+          (lambda (o2 o2name)
+	    (let ((val (catch #t (lambda () (copy o1 o2)) (lambda any 'error))))
+	      (format *stderr* "(copy ~S ~S) -> '~S~%" o1name o2name val)))
+        (list e2 v2 i2 f2 h2 p2 b2 s2)
+        (list 'e2 'v2 'i2 'f2 'h2 'p2 'b2 's2)))
+     (list e1 v1 i1 f1 h1 p1 b1 s1)
+     (list 'e1 'v1 'i1 'f1 'h1 'p1 'b1 's1))))
+|#
+(let ()
+  (define* (copy-1 s d start end)
+    (let ((dend (length d))
+	  (send (or end (length s))))
+      (if (not end)
+	  (set! end (length s)))
+      (do ((i (or start 0) (+ i 1))
+	   (j 0 (+ j 1)))
+	  ((or (= i end)
+	       (= j dend))
+	   d)
+	(set! (d j) (s i)))))
+
+  (for-each
+   (lambda (s1 s2)
+     (for-each
+      (lambda (start)
+	(for-each
+	 (lambda (end)
+	   (for-each
+	    (lambda (d1 d2)
+	      (catch #t
+		(lambda ()
+		  (if end
+		      (copy s1 d1 (or start 0) end)
+		      (if start
+			  (copy s1 d1 start)
+			  (copy s1 d1)))
+		  (copy-1 s2 d2 start end)
+		  (if (not (equal? d1 d2))
+		      (format *stderr* "(copy ~A ~A ~A) -> ~A ~A?~%" s1 start end d1 d2)))
+		(lambda args 'error)))
+	    (list (vector 0 0 0)
+		  (make-int-vector 2 1)
+		  (make-float-vector 2 0.0)
+		  (string #\a #\b #\c #\d #\e)
+		  (string) (list) (vector)
+		  (if with-block (block 1.0 1.0) (float-vector 1.0 1.0))
+		  (cons 1 2))
+	    (list (vector 0 0 0)
+		  (make-int-vector 2 1)
+		  (make-float-vector 2 0.0)
+		  (string #\a #\b #\c #\d #\e)
+		  (string) (list) (vector)
+		  (if with-block (block 1.0 1.0) (float-vector 1.0 1.0))
+		  (cons 1 2))))
+	 (list #f 0 1 3)))
+      (list #f 0 1 2)))
+   (list (vector 1 2 3 4)
+	 (let ((v (make-int-vector 3 0))) (set! (v 0) 32) (set! (v 1) 16) (set! (v 2) 8) v)
+	 (list 1 2 3 4 5)
+	 (string #\a #\b)
+	 (string) (list) (vector)
+	 (cons 1 (cons 2 3))
+	 (if with-block (block 1.0 2.0 3.0 4.0) (float-vector 1.0 2.0 3.0 4.0)))
+   (list (vector 1 2 3 4)
+	 (let ((v (make-int-vector 3 0))) (set! (v 0) 32) (set! (v 1) 16) (set! (v 2) 8) v)
+	 (list 1 2 3 4 5)
+	 (string #\a #\b)
+	 (string) (list) (vector)
+	 (cons 1 (cons 2 3))
+	 (if with-block (block 1.0 2.0 3.0 4.0) (float-vector 1.0 2.0 3.0 4.0)))))
+
+(test (copy -1 6) 'error)
+(for-each
+ (lambda (arg)
+   (test (copy arg #(1 2 3)) 'error)
+   (test (copy #(1 2 3) arg) 'error))
+ (list -1 #\a 3.14 3/4 1.0+1.0i 'hi abs (lambda () #f) #<eof> #<unspecified> #<undefined>))
+
+(let ((ht (hash-table 'a 1)))
+  (test (copy ht (make-vector 3 #f)) #((a . 1) #f #f))
+  (let ((e (inlet)))
+    (copy ht e)
+    (test (eval '(+ a 2) e) 3)
+    (test (copy e #(1 2 3)) #((a . 1) 2 3))
+    (copy (list (cons 'b 2)) ht)
+    (test (ht 'b) 2)))
+
+(let ((ht1 (hash-table 'a 1))
+      (ht2 (hash-table 123 2)))
+  (copy ht2 ht1)
+  (test (ht1 123) 2)
+  (copy ht1 ht2)
+  (test (ht2 'a) 1)
+  (test (hash-table-entries ht2) 2)
+  (test (let ((str (object->string ht2)))
+	  (or (string=? str "(hash-table 'a 1 123 2)")
+	      (string=? str "(hash-table 123 2 'a 1)")))
+	#t)
+  (test (equal? ht1 ht2) #t))
+
+(let ((ht1 (hash-table 'a 1))
+      (ht2 (make-hash-table)))
+  (copy ht1 ht2)
+  (test (= (hash-table-entries ht1) (hash-table-entries ht2)) #t)
+  (test (equal? ht1 ht2) #t))
+
+(let ((ht1 (hash-table 'a 1 'b 2 'c 3))
+      (ht2 (make-hash-table)))
+  (copy ht1 ht2)
+  (test (= (hash-table-entries ht1) (hash-table-entries ht2)) #t)
+  (test (equal? ht1 ht2) #t))
+
+(let ((ht1 (hash-table 'a 1 'b 2 'c 3))
+      (ht2 (make-hash-table)))
+  (copy ht1 ht2 0 3)
+  (test (= (hash-table-entries ht1) (hash-table-entries ht2)) #t)
+  (test (equal? ht1 ht2) #t))
+
+(let ((ht1 (hash-table 'a 1 'b 2 'c 3))
+      (ht2 (make-hash-table)))
+  (copy ht1 ht2 1) ; either can be skipped here
+  (test (= (hash-table-entries ht1) (+ (hash-table-entries ht2) 1)) #t)
+  (test (equal? ht1 ht2) #f)
+  (test (ht1 'a) 1)
+  (test (ht1 'c) 3))
+
+(let ((ht1 (hash-table 'a 1 'b 2 'c 3))
+      (ht2 (make-hash-table)))
+  (copy ht1 ht2 1 2)
+  (test (= (hash-table-entries ht1) (+ (hash-table-entries ht2) 2)) #t)
+  (test (equal? ht1 ht2) #f)
+  (test (ht1 'a) 1)
+  (test (ht1 'c) 3))
+
+(let ((H (make-hash-table 8 eq? (cons symbol? integer?))))
+  (set! (H 'a) 32)
+  (test (equal? H (copy H)) #t))
+
+(let ((ht1 (hash-table 'a 1))
+      (ht2 (hash-table "a" 2)))
+  (copy ht1 ht2)
+  (test (= (hash-table-entries ht1) (hash-table-entries ht2)) #f)
+  (test (equal? ht1 ht2) #f)
+  (test (ht2 "a") 2)
+  (test (ht2 'a) 1)
+  (test (hash-table-entries ht2) 2))
+
+(let ((ht1 (hash-table 'a 1 "a" 3))
+      (ht2 (hash-table "a" 2)))
+  (copy ht1 ht2)
+  (test (= (hash-table-entries ht1) (hash-table-entries ht2)) #t)
+  (test (equal? ht1 ht2) #t)
+  (test (ht2 "a") 3)
+  (test (ht2 'a) 1)
+  (test (hash-table-entries ht2) 2))
+
+(when with-bignums
+  (test (let ((x (bignum "1"))) (eq? x (copy x))) #f)
+  (test (let ((x (bignum "1/2"))) (eq? x (copy x))) #f)
+  (test (let ((x (bignum "1.0"))) (eq? x (copy x))) #f)
+  (test (let ((x (bignum "1+i"))) (eq? x (copy x))) #f))
+
+(test (let ((x 1)) (eq? x (copy x))) #f)
+(test (= 1 (copy 1)) #t)
+(test (= 1.5 (copy 1.5)) #t)
+(test (= 1/2 (copy 1/2)) #t)
+(test (= 1+i (copy 1+i)) #t)
+(test (let ((x "str")) (eq? x (copy x))) #f)
+
+(if (not (provided? 'gmp))
+    (let ((r1 (random-state 1234)))
+      (random 1.0 r1)
+      (let ((r2 (copy r1)))
+	(let ((v1 (random 1.0 r1))
+	      (v2 (random 1.0 r2)))
+	  (test (= v1 v2) #t)
+	  (let ((v3 (random 1.0 r1)))
+	    (random 1.0 r1)
+	    (random 1.0 r1)
+	    (let ((v4 (random 1.0 r2)))
+	      (test (= v3 v4) #t)))))))
+
+(if (provided? 'gmp)
+    (let ((i (copy (bignum "1")))
+	  (r (copy (bignum "3/4")))
+	  (f (copy (bignum "1.5")))
+	  (c (copy (bignum "1.0+1.0i"))))
+      (test (= i (bignum "1")) #t)
+      (test (= r (bignum "3/4")) #t)
+      (test (= f (bignum "1.5")) #t)
+      (test (= c (bignum "1.0+1.0i")) #t)))
+
+(let ()
+  (define (f1 a) (+ a 1))
+  (define f2 (copy f1))
+  (test (f1 1) (f2 1))
+  (define* (f3 (a 2)) (* a 2))
+  (define f4 (copy f3))
+  (test (f3 3) (f4 3))
+  (test (f3) (f4))
+  (define-macro (f5 a) `(+ ,a 1))
+  (define f6 (copy f5))
+  (test (f5 2) (f6 2)))
+
+(let ()
+  (define (engulph form)
+    (let ((body `(let ((L ()))
+		   (do ((i 0 (+ i 1)))
+		       ((= i 10) (reverse L))
+		     (set! L (cons ,form L))))))
+      (define function (apply lambda () (list (copy body :readable)))) ; an optimizable no-macro macro?
+      (function)))
+
+  (test (engulph '(+ i 1)) '(1 2 3 4 5 6 7 8 9 10)))
+
+(test (copy '((x)) (inlet 'a 1) (let ((local-func (lambda (x) x))) (local-func 0))) (inlet 'a 1 'x ()))
+(test (catch #t (lambda () (copy '((x)) (string #\a))) (lambda (type info) (apply format #f info)))
+      "copy first element, (x), is a pair but should be a character")
+(test (copy '(+ 1 2) :readable 1 3) 'error)
+
+(let* ((Lq '((() <1>) (() <2>)))
+       (L1 (copy Lq :readable))
+       (L2 (copy Lq :readable)))
+  (set-car! (cdar L1) '<4>)
+  (test L1 '((() <4>) (() <2>)))
+  (test Lq '((() <1>) (() <2>)))
+  (test L2 '((() <1>) (() <2>))))
+
+(test (copy (let ((L (list 1))) (set-cdr! L L)) :readable) 'error) ; "tree is cyclic"
+(test (length (copy (let ((L (list 1))) (set-cdr! L L)))) +inf.0)
+(test (copy (let ((<1> (list 1 #f)))
+              (set! (<1> 1) (let ((<L> (list #f 3)))
+                              (set-car! <L> <1>) <L>))
+              <1>) :readable)
+      'error)
+(test (length (copy (let ((<1> (list 1 #f)))
+                      (set! (<1> 1) (let ((<L> (list #f 3)))
+                                      (set-car! <L> <1>) <L>))
+                      <1>)))
+      2)
+
+
+(test (let ((x (list 1 2)))
+	(let ((y (cons x x)))
+	  (let ((z (copy y)))
+	    (list (eq? (car y) (cdr y)) (eq? (car z) (cdr z))))))
+      '(#t #f))
+
+(let () ; opt_do_copy
+  (define (vcop-1 a b start end)
+    (do ((i (- end 1) (- i 1)))
+	((< i start) b)
+      (vector-set! b i (vector-ref a i))))
+
+  (define (vcop+1 a b start end)
+    (do ((i start (+ i 1)))
+	((= i end) b)
+      (vector-set! b i (vector-ref a i))))
+
+  (let ((a (vector 0 1 2 3 4 5 6 7 8 9))
+	(b (make-vector 20 10)))
+    (test (vcop-1 a b 0 10) #(0 1 2 3 4 5 6 7 8 9 10 10 10 10 10 10 10 10 10 10))
+    (fill! b 10)
+    (test (vcop+1 a b 0 10) #(0 1 2 3 4 5 6 7 8 9 10 10 10 10 10 10 10 10 10 10))
+    (fill! b 10)
+    (test (vcop-1 a b 2 7) #(10 10 2 3 4 5 6 10 10 10 10 10 10 10 10 10 10 10 10 10))
+    (fill! b 10)
+    (test (vcop+1 a b 2 7) #(10 10 2 3 4 5 6 10 10 10 10 10 10 10 10 10 10 10 10 10))
+    (fill! b 10)
+    (test (vcop-1 a b 2 27) 'error)
+    (fill! b 10)
+    (test (vcop-1 a b -2 27) 'error))
+
+  (let ((a (vector 0 1 2 3 4 5 6 7 8 9))
+	(b (make-vector 10 10)))
+    (test (vcop-1 a b 0 10) #(0 1 2 3 4 5 6 7 8 9))
+    (fill! b 10)
+    (test (vcop+1 a b 0 10) #(0 1 2 3 4 5 6 7 8 9))
+    (fill! b 10)
+    (test (vcop-1 a b 2 7) #(10 10 2 3 4 5 6 10 10 10))
+    (fill! b 10)
+    (test (vcop+1 a b 2 7) #(10 10 2 3 4 5 6 10 10 10))
+    ))
+
+(when full-s7test
+  (let ()
+    (define (fltv)
+      (let ((v1 (make-float-vector 2048 1.0))
+	    (v2 (make-float-vector 2048 0.0)))
+	(copy v1 v2)
+	(call-with-exit
+	 (lambda (quit)
+	   (do ((i 0 (+ i 1)))
+	       ((= i 2048))
+	     (unless (= (v2 i) 1.0)
+	       (format *stderr* "flt (v2 ~D): ~S~%" i (v2 i))
+	       (quit)))))))
+    (fltv)
+
+    (define (ivs)
+      (for-each
+       (lambda (maker name)
+	 (let ((v1 (maker 2048 1))
+	       (v2 (maker 2048 0)))
+	   (copy v1 v2)
+	   (call-with-exit
+	    (lambda (quit)
+	      (do ((i 0 (+ i 1)))
+		  ((= i 2048))
+		(unless (= (v2 i) 1)
+		  (format *stderr* "~A (v2 ~D): ~S~%" name i (v2 i))
+		  (quit)))))))
+       (list make-int-vector make-byte-vector make-vector)
+       (list "int" "byte" "normal")))
+    (ivs)
+
+    (define (strv)
+      (let ((v1 (make-string 2048))
+	    (v2 (make-string 2048)))
+	(do ((i 0 (+ i 1)))
+	    ((= i 2048))
+	  (set! (v1 i) (integer->char (modulo i 128))))
+	(copy v1 v2)
+	(call-with-exit
+	 (lambda (quit)
+	   (do ((i 0 (+ i 1)))
+	       ((= i 2048))
+	     (unless (char=? (v1 i) (v2 i))
+	       (format *stderr* "str (v1 ~D): ~S, (v2 ~D): ~S~%" i (v1 i) i (v2 i))
+	       (quit)))))))
+    (strv)))
+
+
+;;; --------
+
+(let ((c1 #f))
+  (call/cc
+   (lambda (c)
+     (test (reverse c) 'error)
+     (test (fill! c) 'error)
+     (test (length c) #f)
+     (test (eq? c c) #t) ; is this the norm?
+     (test (equal? c c) #t)
+     (test (equal? c (copy c)) #t)
+     (set! c1 c)))
+  (test (continuation? c1) #t))
+
+(let ((c1 #f))
+  (call-with-exit
+   (lambda (c)
+     (test (reverse c) 'error)
+     (test (fill! c) 'error)
+     (test (length c) #f)
+     (test (eq? c c) #t)
+     (test (equal? c c) #t)
+     (test (equal? c (copy c)) #t)
+     (set! c1 c)))
+  (test (procedure? c1) #t))
+
+
+;;; length
+(test (length (list 1 2)) 2)
+(test (length "hiho") 4)
+(test (length (vector 1 2)) 2)
+(test (>= (length (make-hash-table 7)) 7) #t)
+(test (length ()) 0)
+(test (length (#(#() #()) 1)) 0)
+(test (length abs) #f)
+(when with-block (test (length (block 1.0 2.0 3.0)) 3))
+(test (length (make-iterator "123")) 3) ; this is not completely correct in all cases
+
+
+;;; --------------------------------------------------------------------------------
+;;; fill!
+
+(let ((str (string #\1 #\2 #\3)))
+  (fill! str #\x)
+  (test str "xxx"))
+(let ((v (vector 1 2 3)))
+  (fill! v 0.0)
+  (test v (vector 0.0 0.0 0.0)))
+(let ((lst (list 1 2 (list (list 3) 4))))
+  (fill! lst 100)
+  (test lst '(100 100 100)))
+(let ((cn (cons 1 2)))
+  (fill! cn 100)
+  (test cn (cons 100 100)))
+(test (fill! 1 0) 'error)
+(test (fill! 'hi 0) 'error)
+(test (let ((x (cons 1 2))) (fill! x 3) x) '(3 . 3))
+(test (let ((x "")) (fill! x #\c) x) "")
+(test (let ((x ())) (fill! x #\c) x) ())
+(test (let ((x #())) (fill! x #\c) x) #())
+(test (let ((x #(0 1))) (fill! x -1) (set! (x 0) -2) x) #(-2 -1))
+(test (let ((x #(0 0))) (fill! x #(1)) (object->string x)) "#(#(1) #(1))") ; was "#(#1=#(1) #1#)"
+(test (let ((lst (list "hi" "hi" "hi"))) (fill! lst "hi") (equal? lst '("hi" "hi" "hi"))) #t)
+(test (let ((lst (list "hi" "hi"))) (fill! lst "hi") (equal? lst '("hi" "hi"))) #t)
+(test (let ((lst (list 1 2 3 4))) (fill! lst "hi") (equal? lst '("hi" "hi" "hi" "hi"))) #t)
+(test (let ((lst (list 1 2 3))) (fill! lst lst) (object->string lst)) "#1=(#1# #1# #1#)")
+(test (let ((lst (vector 1 2 3))) (fill! lst lst) (object->string lst)) "#1=#(#1# #1# #1#)")
+(test (let ((lst #2d((1) (1)))) (fill! lst lst) (object->string lst)) "#1=#2d((#1#) (#1#))")
+(test (let ((lst '(1 2 3))) (fill! lst (cons 1 2)) (set! (car (car lst)) 3) (caadr lst)) 3)
+
+(test (let ((lst (list))) (fill! lst 0) lst) ())
+(test (let ((lst (list 1))) (fill! lst 0) lst) '(0))
+(test (let ((lst (list 1 2))) (fill! lst 0) lst) '(0 0))
+(test (let ((lst (list 1 (list 2 3)))) (fill! lst 0) lst) '(0 0))
+(test (let ((lst (cons 1 2))) (fill! lst 0) lst) '(0 . 0))
+(test (let ((lst (cons 1 (cons 2 3)))) (fill! lst 0) lst) '(0 0 . 0))
+(let ((lst (make-list 3)))
+  (fill! lst lst)
+  (test lst (lst 0))
+  (set! (lst 1) 32)
+  (test ((lst 0) 1) 32))
+
+(when with-block
+  (let ((b (make-block 4)))
+    (fill! b 32.0)
+    (test b (block 32.0 32.0 32.0 32.0))))
+
+(test (fill!) 'error)
+(test (fill! '"hi") 'error)
+(test (fill! (begin) if) if)
+(test (fill! (rootlet) 3) 'error)
+(test (fill! (rootlet) #f) 'error)
+;(test (fill! (owlet) 3) 'error) ;; (owlet) copies sc->owlet
+(let ((a 2) (e #f)) (set! e (curlet)) (test (begin (fill! e 3) a) 3))
+(test (fill! "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" #f) 'error)
+(let ((v (make-int-vector 3 0))) (fill! v 32) (test v (make-int-vector 3 32)))
+(test (fill! (byte-vector 0) 300) 'error)
+(test (fill! (byte-vector 0) -1) 'error)
+(test (fill! () 1 2) 'error)
+(test (fill! "" #\a) #\a) ; !?
+(test (fill! "" #u(65)) 'error)
+(test (fill! () :allow-other-keys  #i(10)) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (fill! arg 1) 'error))
+ (list (integer->char 65) #f 'a-symbol abs quasiquote macroexpand 1/0 (log 0) #<eof> #<unspecified> #<undefined> (lambda (a) (+ a 1))
+       3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+   (let ((str (string #\a #\b)))
+     (test (fill! str arg) 'error)))
+ (list "hi" '(1 2 3) #() #f 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(let ((ht (hash-table :a 1)))
+  (for-each
+   (lambda (arg)
+     (test (fill! ht arg) arg)
+     (test (ht :a) arg))
+   (list "hi" '(1 2 3) #() 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0)
+	 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)) #f)))
+
+(let ((str (make-string 10 #\a)))
+  (fill! str #\b 0 2)
+  (test str "bbaaaaaaaa")
+  (fill! str #\c 8)
+  (test str "bbaaaaaacc")
+  (test (fill! str #\d -1) 'error)
+  (test (fill! str #\d 1 0) 'error)
+  (fill! str #\d 4 4)
+  (test str "bbaaaaaacc"))
+
+(let ((v (vector 1 2 3 4)))
+  (fill! v 5 2 3)
+  (test v #(1 2 5 4))
+  (fill! v 6 2)
+  (test v #(1 2 6 6)))
+
+(let ((v (float-vector 1.0 2.0 3.0)))
+  (test (fill! v 0.0 0 4) 'error)
+  (test (fill! v 0.0 4 4) 'error)
+  (fill! v 0.0 1)
+  (test v (float-vector 1.0 0.0 0.0)))
+
+(let ((v (int-vector 1 2 3)))
+  (test (fill! v 0 0 4) 'error)
+  (test (fill! v 0 4 4) 'error)
+  (fill! v 0 1)
+  (test v (int-vector 1 0 0)))
+
+(let ((p (list 0 1 2 3 4)))
+  (fill! p 5 3)
+  (test p (list 0 1 2 5 5))
+  (fill! p 6 0 3)
+  (test p (list 6 6 6 5 5)))
+
+(let ((p (cons 1 2)))
+  (fill! p 3 0)
+  (test p (cons 3 3))
+  (set! p (cons 0 (cons 1 2)))
+  (fill! p 4 0 1) ; "end" is ambiguous here
+  (test p '(4 1 . 2))
+  (fill! p 5 1)
+  (test p '(4 5 . 5)))
+
+(test (let ((e (let ((i 0)) (set! (setter 'i) integer?) (curlet)))) (fill! e #f)  e) 'error)
+
+;;; --------
+;; fill! ignores (can't find) the setter (except in a let), but can see typers:
+
+(let ((L (list 1 2 3)))
+  (set! (setter 'L) (lambda (s v) (error 'oops "can't fill! ~A" s)))
+  (fill! L 12)
+  (test L '(12 12 12)))
+
+(let ((str "asdf"))
+  (set! (setter 'str) (lambda (s v) (error 'oops "can't fill! ~A" s)))
+  (fill! str #\d)
+  (test str "dddd"))
+
+(let ((v (make-vector 3 1)))
+  (set! (setter 'v) (lambda (s v) (error 'oops "can't fill! ~A" s)))
+  (fill! v 2)
+  (test v #(2 2 2)))
+
+(let ((v (make-vector 3 1/2 rational?)))
+  (test (fill! v 2+i) 'error))
+
+(let ((lt (inlet 'a 1)))
+  (set! (setter 'lt) (lambda (s v) (error 'oops "can't fill! ~A" s)))
+  (fill! lt 2)
+  (test (equal? lt (inlet 'a 2)) #t))
+
+(let ((lt (let ((a 2))
+	    (set! (setter 'a) (lambda (s v) (error 'oops "can't set! ~A to ~A" s v)))
+	    (curlet))))
+  (test (fill! lt 2) 'error)) ; but 'a is already 2
+
+(let ((lt (let ((a 2))
+	    (set! (setter 'a) (lambda (s v) (error 'oops "can't set! ~A to ~A" s v)))
+	    (curlet))))
+  (test (fill! lt 12) 'error))
+
+(let ((H (make-hash-table 8 eq? (cons symbol? integer?))))
+  (set! (H 'a) 1)
+  (fill! H #f)
+  (test H (hash-table)))
+
+(let ((H (make-hash-table 8 eq? (cons symbol? integer?))))
+  (set! (H 'a) 1)
+  (set! (H 'a) #f) ; here the value-typer is ignored, #f is always ok
+  (test H (hash-table)))
+
+(let ((H (make-hash-table 8 eq? (cons symbol? integer?))))
+  (set! (H 'a) 1)
+  (test (fill! H #\a) 'error))
+
+;; and fill! is not as flexible as set!:
+(let ((v (let ((vect (vector 1 2 3)))
+           (dilambda
+	     (lambda (index)
+	       (vector-ref vect index))
+	     (lambda (index new-value)
+	       (if (< (abs new-value) 10)
+		   (vector-set! vect index new-value)
+		   (error 'wring-type-arg "can't set (v ~D) to ~S" index new-value)))))))
+  (test (v 0) 1)
+  (set! (v 1) -3)
+  (test (v 1) -3)
+  (test (set! (v 1) 32) 'error)
+  (test (fill! v 3) 'error)) ; fill! first argument, v, is a function but should be a sequence
+
+;; not ideal...
+;;   and copy is worse than fill!:
+;; (copy '(1 2 3) *features*) ; '(1 2 3 ...)!
+
+(let ((L (list 1 2 3)))
+  (set! (setter 'L) (lambda (s v) (error 'oops "can't set! ~A" s)))
+  (copy '(12 12) L)
+  (test L '(12 12 3)))
+
+(let ((str "asdf"))
+  (set! (setter 'str) (lambda (s v) (error 'oops "can't set! ~A" s)))
+  (copy "ddd" str)
+  (test str "dddf"))
+
+(let ((v (make-vector 3 1)))
+  (set! (setter 'v) (lambda (s v) (error 'oops "can't set! ~A" s)))
+  (copy #(2 2 2) v)
+  (test v #(2 2 2)))
+
+(let ((v (make-vector 3 1/2 rational?)))
+  (test (copy #(2+i) v) 'error))
+
+(let ((lt (inlet 'a 1)))
+  (set! (setter 'lt) (lambda (s v) (error 'oops "can't set! ~A" s)))
+  (copy (inlet 'a 2) lt) ; (inlet 'a 2 'a 1)
+  (test (lt 'a) 2))
+
+(let ((lt (let ((a 2))
+	    (set! (setter 'a) (lambda (s v) (error 'oops "can't set! ~A to ~A" s v)))
+	    (curlet))))
+  (copy (inlet 'a 12) lt) ; (inlet 'a 12 'a 2) !
+  (test (lt 'a) 12))
+;; copy -> let should look for each slot setter?
+
+(let ((H (make-hash-table 8 eq? (cons symbol? integer?))))
+  (set! (H 'a) 1)
+  (test (copy (hash-table 'a #\a) H) 'error))
+
+;; and reverse! also ignores setters:
+(let ((L (list 1 2 3)))
+  (set! (setter 'L) (lambda (s v) (error 'oops "can't set! ~A" s)))
+  (reverse! L) ; this clobbers L but we can't set! it to the value of reverse!
+  (test L '(1)))
+
+(let ((str "asdf"))
+  (set! (setter 'str) (lambda (s v) (error 'oops "can't set! ~A" s)))
+  (reverse! str)
+  (test str "fdsa"))
+
+(let ((v (vector 1 2 3)))
+  (set! (setter 'v) (lambda (s v) (error 'oops "can't set! ~A" s)))
+  (reverse! v)
+  (test v #(3 2 1)))
+
+;; and sort!, technically we're not setting the variable but messing with its value:
+;; (sort! *features* (lambda (a b) (< (length (symbol->string a)) (length (symbol->string b)))))
+
+(let ((L (list 1 2 3)))
+  (set! (setter 'L) (lambda (s v) (error 'oops "can't set! ~A" s)))
+  (sort! L >)
+  (test L '(3 2 1)))
+
+(let ((str "asdf"))
+  (set! (setter 'str) (lambda (s v) (error 'oops "can't set! ~A" s)))
+  (sort! str char>?)
+  (test str "sfda"))
+
+(let ((v (vector 1 2 3)))
+  (set! (setter 'v) (lambda (s v) (error 'oops "can't set! ~A" s)))
+  (sort! v >)
+  (test v #(3 2 1)))
+
+
+;;; --------------------------------------------------------------------------------
+;; generic for-each/map
+(test (let ((sum 0)) (for-each (lambda (n) (set! sum (+ sum n))) (vector 1 2 3)) sum) 6)
+(test (map (lambda (n) (+ n 1)) (vector 1 2 3)) '(2 3 4))
+(test (map (lambda (a b) (/ a b)) (list 1 2 3) (list 4 5 6)) '(1/4 2/5 1/2))
+
+(when with-block
+  (let ((b (block 1.0 2.0 3.0)))
+    (test (map (lambda (x) (floor x)) b) '(1 2 3))
+    (let ((sum 0))
+      (for-each
+       (lambda (x)
+	 (set! sum (+ sum (floor x))))
+       b)
+      (test sum 6))))
+
+;; try some applicable stuff
+(test (let ((lst (list 1 2 3)))
+	(set! (lst 1) 32)
+	(list (lst 0) (lst 1)))
+      (list 1 32))
+
+(test (let ((hash (make-hash-table)))
+	(set! (hash 'hi) 32)
+	(hash 'hi))
+      32)
+
+(test (let ((str (string #\1 #\2 #\3)))
+	(set! (str 1) #\a)
+	(str 1))
+      #\a)
+
+(test (let ((v (vector 1 2 3)))
+	(set! (v 1) 0)
+	(v 1))
+      0)
+
+(let ()
+  (define (hiho a) (*function* (curlet)))
+  (test (or (equal? (hiho 1) 'hiho)
+	    (equal? (car (hiho 1)) 'hiho))
+	#t))
+
+(let ()
+  (define-macro (hiho a) (let ((p (*function* (curlet)))) (if (pair? p) (car p) p)))
+  (test (equal? (hiho 1) hiho) #t))
+
+;; somewhat amusing...
+(let ((x (vector 0)))
+  (set! (x 0) x)
+  (test (fill! (x 0) 3) 3)
+  (test (fill! (x 0) 3) 'error)) ; error: fill! argument 1, 3, is an integer but should be a sequence
+
+;;; gc
+(for-each
+ (lambda (arg)
+   (test (gc arg) 'error))
+ (list "hi" '(1 2 3) #() 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+       3.14 3/4 1.0+1.0i 1 () "" :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (gc #f #t) 'error)
+(if with-block (test (fill! (immutable! (block 0)) 1.0) 'error))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; tail recursion tests
+
+(define (command-line)
+  (let ((lst ()))
+    (with-input-from-file "/proc/self/cmdline"
+      (lambda ()
+	(do ((c (read-char) (read-char))
+	     (s ""))
+	    ((eof-object? c)
+	     (reverse lst))
+	  (if (char=? c #\null)
+	      (begin
+		(set! lst (cons s lst))
+		(set! s ""))
+	      (set! s (string-append s (string c)))))))))
+
+(if (provided? 'linux)
+    (define _max_stack_tc_ (if (member "s7test.scm" (command-line)) 13 20))
+    (define _max_stack_tc_ 20))
+
+(let ((max-stack 0))
+  (define (tc-1 a c)
+    (let ((b (+ a 1)))
+      (if (> (-s7-stack-top-) max-stack)
+	  (set! max-stack (-s7-stack-top-)))
+      (if (< b c)
+	  (tc-1 b c))))
+  (tc-1 0 32)
+  (if (> max-stack _max_stack_tc_) (format #t "tc-1 max: ~D~%" max-stack))) ; 18 here and below in repl.scm, 13 in t101-3
+
+(let ((max-stack 0))
+  (define (tc-1 a c)
+    (if (> (-s7-stack-top-) max-stack)
+	(set! max-stack (-s7-stack-top-)))
+    (if (< a c)
+	(tc-2 (+ a 1) c)))
+  (define (tc-2 a c)
+    (if (> (-s7-stack-top-) max-stack)
+	(set! max-stack (-s7-stack-top-)))
+    (if (< a c)
+	(tc-1 (+ a 1) c)))
+  (tc-1 0 32)
+  (if (> max-stack _max_stack_tc_) (format #t "tc-1-1 max: ~D~%" max-stack)))
+
+(let ((max-stack 0))
+  (define (tc-2 a c)
+    (let ((b (+ a 1)))
+      (if (> (-s7-stack-top-) max-stack)
+	  (set! max-stack (-s7-stack-top-)))
+      (if (= b c)
+	  #f
+	  (tc-2 b c))))
+  (tc-2 0 32)
+  (if (> max-stack _max_stack_tc_) (format #t "tc-2 max: ~D~%" max-stack)))
+
+(let ((max-stack 0))
+  (define (tc-2 a c)
+    (let ((b (+ a 1)))
+      (if (> (-s7-stack-top-) max-stack)
+	  (set! max-stack (-s7-stack-top-)))
+      (if (< b c)
+	  (tc-2 b c)
+	  #f)))
+  (tc-2 0 32)
+  (if (> max-stack _max_stack_tc_) (format #t "tc-2-1 max: ~D~%" max-stack)))
+
+(let ((max-stack 0))
+  (define (tc-3 a c)
+    (let ((b (+ a 1)))
+      (if (> (-s7-stack-top-) max-stack)
+	  (set! max-stack (-s7-stack-top-)))
+      (cond ((= b c) #f)
+	    ((< b c)
+	     (tc-3 b c)))))
+  (tc-3 0 32)
+  (if (> max-stack _max_stack_tc_) (format #t "tc-3 max: ~D~%" max-stack)))
+
+(let ((max-stack 0))
+  (define (tc-4 a c)
+    (let ((b (+ a 1)))
+      (if (> (-s7-stack-top-) max-stack)
+	  (set! max-stack (-s7-stack-top-)))
+      (cond ((= b c) #f)
+	    (else (tc-4 b c)))))
+  (tc-4 0 32)
+  (if (> max-stack _max_stack_tc_) (format #t "tc-4 max: ~D~%" max-stack)))
+
+(let ((max-stack 0))
+  (define (tc-5 a c)
+    (let ((b (+ a 1)))
+      (if (> (-s7-stack-top-) max-stack)
+	  (set! max-stack (-s7-stack-top-)))
+      (case b
+	((32) #f)
+	(else (tc-5 b c)))))
+  (tc-5 0 32)
+  (if (> max-stack _max_stack_tc_) (format #t "tc-5 max: ~D~%" max-stack)))
+
+(let ((max-stack 0))
+  (define (tc-6 a c)
+    (let ((b (+ a 1)))
+      (if (> (-s7-stack-top-) max-stack)
+	  (set! max-stack (-s7-stack-top-)))
+      (case b
+	((17) #f)
+	((0 1 2 3 4 5 6 7 8) (tc-6 b c))
+	((9 10 11 12 13 14 15 16) (tc-6 b c)))))
+  (tc-6 0 32)
+  (if (> max-stack _max_stack_tc_) (format #t "tc-6 max: ~D~%" max-stack)))
+
+(let ((max-stack 0))
+  (define (tc-7 a c)
+    (let ((b (+ a 1)))
+      (if (> (-s7-stack-top-) max-stack)
+	  (set! max-stack (-s7-stack-top-)))
+      (or (>= b c)
+	  (tc-7 b c))))
+  (tc-7 0 32)
+  (if (> max-stack _max_stack_tc_) (format #t "tc-7 max: ~D~%" max-stack)))
+
+(let ((max-stack 0))
+  (define (tc-8 a c)
+    (let ((b (+ a 1)))
+      (if (> (-s7-stack-top-) max-stack)
+	  (set! max-stack (-s7-stack-top-)))
+      (and (< b c)
+	   (tc-8 b c))))
+  (tc-8 0 32)
+  (if (> max-stack _max_stack_tc_) (format #t "tc-8 max: ~D~%" max-stack)))
+
+(let ((max-stack 0))
+  (define (tc-9 a c)
+    (let tc-9a ((b a))
+      (if (> (-s7-stack-top-) max-stack)
+	  (set! max-stack (-s7-stack-top-)))
+      (if (< b c)
+	  (tc-9a (+ b 1)))))
+  (tc-9 0 32)
+  (if (> max-stack _max_stack_tc_) (format #t "tc-9 max: ~D~%" max-stack)))
+
+(let ((max-stack 0))
+  (define (tc-10 a c)
+    (let* ((b (+ a 1)))
+      (if (> (-s7-stack-top-) max-stack)
+	  (set! max-stack (-s7-stack-top-)))
+      (and (< b c)
+	   (tc-10 b c))))
+  (tc-10 0 32)
+  (if (> max-stack _max_stack_tc_) (format #t "tc-10 max: ~D~%" max-stack)))
+
+(let ((max-stack 0))
+  (define (tc-11 a c)
+    (letrec ((b (+ a 1)))
+      (if (> (-s7-stack-top-) max-stack)
+	  (set! max-stack (-s7-stack-top-)))
+      (and (< b c)
+	   (tc-11 b c))))
+  (tc-11 0 32)
+  (if (> max-stack _max_stack_tc_) (format #t "tc-11 max: ~D~%" max-stack)))
+
+(let ((max-stack 0))
+  (define (tc-12 a c)
+    (if (< a c)
+	(begin
+	  (if (> (-s7-stack-top-) max-stack)
+	      (set! max-stack (-s7-stack-top-)))
+	  (tc-12 (+ a 1) c))))
+  (tc-12 0 32)
+  (if (> max-stack _max_stack_tc_) (format #t "tc-12 max: ~D~%" max-stack)))
+
+(let ((max-stack 0))
+  (define (tc-13 a c)
+    (if (> (-s7-stack-top-) max-stack)
+	(set! max-stack (-s7-stack-top-)))
+    (cond ((= a c) #f)
+	  ((< a c)
+	   (if (> a c) (display "oops"))
+	   (tc-13 (+ a 1) c))))
+  (tc-13 0 32)
+  (if (> max-stack _max_stack_tc_) (format #t "tc-13 max: ~D~%" max-stack)))
+
+(let ((max-stack 0))
+  (define (tc-14 a)
+    (if (> (-s7-stack-top-) max-stack)
+	(set! max-stack (-s7-stack-top-)))
+    (cond ((>= a 32) #f)
+	  ((values (+ a 1) 32) => tc-14)))
+  (tc-14 0)
+  (if (> max-stack _max_stack_tc_) (format #t "tc-14 max: ~D~%" max-stack)))
+
+(let ((max-stack 0))
+  (define (tc-15 a c)
+    (if (> (-s7-stack-top-) max-stack)
+	(set! max-stack (-s7-stack-top-)))
+    (or (>= a c)
+	(apply tc-15 (list (+ a 1) c))))
+  (tc-15 0 32)
+  (if (> max-stack _max_stack_tc_) (format #t "tc-15 max: ~D~%" max-stack)))
+
+(let ((max-stack 0)
+      (e #f))
+  (set! e (curlet))
+  (define (tc-17 a c)
+    (if (> (-s7-stack-top-) max-stack)
+	(set! max-stack (-s7-stack-top-)))
+    (or (and (>= a c) a)
+	(eval `(tc-17 (+ ,a 1) ,c) e)))
+  (let ((val (tc-17 0 32)))
+    (test (and (= val 32) (< max-stack 28)) #t)))
+
+(when full-s7test
+  (let ((max-stack 0))
+    (define (tc-19 a c)
+      (if (> (-s7-stack-top-) max-stack)
+	  (set! max-stack (-s7-stack-top-)))
+      (call/cc
+       (lambda (r)
+	 (if (>= a c) (r a))
+	 (tc-19 (+ a 1) c))))
+    (let ((val (tc-19 0 16)))
+      (test (and (= val 16) (< max-stack 8)) #t))))
+
+(let ((max-stack 0))
+  (define (tc-21 a)
+    (if (< a 32)
+	(do ((i (- a 1) (+ i 1)))
+	    ((= i a)
+	     (tc-21 (+ a 1)))
+	  (if (> (-s7-stack-top-) max-stack)
+	      (set! max-stack (-s7-stack-top-))))
+	a))
+  (let ((val (tc-21 0)))
+    (if (> max-stack _max_stack_tc_) (format #t "tc-21 max: ~D~%" max-stack))
+    (if (not (= val 32)) (format #t "tc-21 returned: ~A~%" val))))
+
+(let ((max-stack 0))
+  (define (tc-env a c)
+    (with-let (sublet (curlet) (cons 'b (+ a 1))) ; this confuses the optimizer -- it thinks max-stack is not defined?
+      (if (> (-s7-stack-top-) max-stack)
+	  (set! max-stack (-s7-stack-top-)))
+      (if (< b c)
+	  (tc-env b c))))
+  (tc-env 0 32)
+  (if (> max-stack _max_stack_tc_) (format #t "tc-env max: ~D~%" max-stack)))
+
+(let ((max-stack 0))
+  (define (tc-env-1 a)
+    (if (> (-s7-stack-top-) max-stack)
+	(set! max-stack (-s7-stack-top-)))
+    (if (> a 0)
+	(with-let (curlet)
+	  (tc-env-1 (- a 1)))))
+  (tc-env-1 32)
+  (if (> max-stack _max_stack_tc_) (format #t "tc-env-1 max: ~D~%" max-stack)))
+
+
+;;; make sure for-each and map aren't messed up
+
+(let ((max-stack 0))
+  (for-each
+   (lambda (a)
+     (if (> (-s7-stack-top-) max-stack)
+	 (set! max-stack (-s7-stack-top-)))
+     (if (not (= a 1))
+	 (error 'wrong-type-arg ";for-each arg is ~A" a)))
+   (make-list 100 1))
+  (test (<= max-stack 21) #t)) ; 10 is not snd-test (and below)
+
+(let ((max-stack 0))
+  (map
+   (lambda (a)
+     (if (> (-s7-stack-top-) max-stack)
+	 (set! max-stack (-s7-stack-top-)))
+     (if (not (= a 1))
+	 (error 'wrong-type-arg ";map arg is ~A" a)))
+   (make-list 100 1))
+  (test (<= max-stack 21) #t))
+
+
+(let ((max-stack 0)
+      (e #f))
+  (set! e (curlet))
+  (define (tc-17 a c)
+    (if (> (-s7-stack-top-) max-stack)
+	(set! max-stack (-s7-stack-top-)))
+    (or (and (>= a c) a)
+	(eval-string (format #f "(tc-17 (+ ~A 1) ~A)" a c) e)))
+  (let ((val (tc-17 0 32)))
+    (test (and (= val 32) (< max-stack 28)) #t)))
+
+;;; the next 2 are not tail-recursive
+;;;   OP_DEACTIVATE_GOTO in call-with-exit
+;;;   OP_DYNAMIC_WIND in the dynamic-wind case
+
+(let ((max-stack 0))
+  (define (tc-16 a c)
+    (if (> (-s7-stack-top-) max-stack)
+	(set! max-stack (-s7-stack-top-)))
+    (call-with-exit
+     (lambda (r)
+       (if (>= a c) (r a))
+       (tc-16 (+ a 1) c))))
+  (let ((val (tc-16 0 32)))
+    (test (and (= val 32) (> max-stack 28)) #t)))
+
+(let ((max-stack 0))
+  (define (tc-18 a c)
+    (dynamic-wind
+	(lambda ()
+	  (if (> (-s7-stack-top-) max-stack)
+	      (set! max-stack (-s7-stack-top-))))
+	(lambda ()
+	  (or (and (>= a c) a)
+	      (tc-18 (+ a 1) c)))
+	(lambda ()
+	  #f)))
+  (let ((val (tc-18 0 32)))
+    (test (and (= val 32) (> max-stack 28)) #t)))
+
+(test (let ((f #f)) (let tr ((i 10)) (if (= i 3) (set! f (lambda () i))) (if (> i 0) (tr (- i 1)))) (f)) 3)
+(test (let ((f ())) (let tr ((i 4)) (set! f (cons i f)) (if (> i 0) (tr (- i 1)))) f) '(0 1 2 3 4))
+
+
+
+;;; -------- miscellaneous amusements
+
+(test ((number->string -1) 0) #\-)
+(test ((reverse '(1 2)) 0) 2)
+(test ((append begin) list) list)
+(test ((begin object->string) car) "car")
+(test ((and abs) -1) 1)
+(test (((values begin) object->string) car) "car")
+(test (((values (begin begin)) object->string) car) "car")
+(test ((((values append) begin) object->string) car) "car")
+(test ((((((values and) or) append) begin) object->string) car) "car")
+(test (((((((values values) and) or) append) begin) object->string) car) "car")
+(test ((values (lambda hi #()))) #())
+(test (((((lambda () (lambda () (lambda () (lambda () 1)))))))) 1)
+(test ((object->string #f) (ceiling 3/4)) #\f)
+(test (procedure? ((((((lambda* ((x (lambda () x))) x))))))) #t)
+(test (procedure? ((((((letrec ((x (lambda () x))) x))))))) #t)
+(test (procedure? ((((((letrec ((x (lambda () y)) (y (lambda () x))) x))))))) #t)
+(test (procedure? ((((((let x () x))))))) #t)
+(test (procedure? (((let () (define (x) x) x)))) #t)
+(test (procedure? ((((((lambda (x) (set! x (lambda () x))) (lambda () x))))))) #t)
+(test (procedure? ````,,,,((((let x () x))))) #t)
+(test ((do ((i 0 (+ i 1))) ((= i 1) (lambda () 3)))) 3)
+(num-test ((list .(log 0)) 1) 0)
+(num-test (((cons .(log 0)) 0) 1) 0.0)
+
+(test (+ (+) (*)) 1)
+(test (modulo (lcm) (gcd)) 1)
+(test (max (+) (*)) 1)
+(test (min (gcd) (lcm)) 0)
+(test (symbol->value (gensym) (rootlet)) #<undefined>)
+(test (string-ref (*s7* 'version) (*)) #\7)
+(test (string>=? (string-append) (string)) #t)
+(test (substring (string-append) (+)) "")
+(test (ash (*) (+)) 1)
+(test (> (*) (+)) #t)
+(test ((or #f list)) ())
+(test ((or #f lcm)) 1)
+(test ((or begin symbol?)) ())
+(test ((or begin make-polar)) ())
+(test ((and #t begin)) ())
+(test (begin) ())
+(test ((or #f lcm) 2 3) 6)
+(test ((or and) #f #t) #f)
+(test ((and or) #f #t) #t)
+(test (or (or) (and)) #t)
+(test ((car '((1 2) (3 4))) 0) 1)
+(test ((or apply) lcm) 1)
+(test (- ((or *))) -1)
+(test ((car (list lcm))) 1)
+(test ((or (cond (lcm)))) 1)
+(test ((cond (asin floor *))) 1)
+(test (logior (#(1 #\a (3)) 0) (truncate 1.5)) 1)
+(test (real? (*)) #t)
+(test (- (lcm)) -1)
+(test (* (*)) 1)
+(test (+ (+) (+ (+)) (+ (+ (+)))) 0)
+(test (+(*(+))(*)(+(+)(+)(*))) 2)
+(num-test (+(-(*).(+1))(*(+).(-1))(*(+).(-10))(*(-(+)0)1.)(-(+)(*).01)(*(-(+)).01)(-(+)(*)1.0)(-(*(+))1.0)(*(-(+))1.0)(-(+(*)1).0))-2.01)
+(num-test (+(-(*).(+1.0))(*(+).(-1.0))(-(+)1.(*)0.)(-(*(+)0.)1.)(-(+(*)1.)0.)(+(-(*)0.)1.))1.0)
+;; float comparison so can't use direct '=' here
+
+(test (nan? (asinh (cos (real-part (log 0.0))))) #t)
+(num-test(cos(sin(log(tan(*))))) 0.90951841537482)
+(num-test (asinh (- 9223372036854775807)) -44.361419555836)
+(num-test (imag-part (asin -9223372036854775808)) 44.361419555836)
+(num-test (apply * (map (lambda (r) (sin (* pi (/ r 130)))) (list 1 67 69 73 81 97))) (/ 1.0 64))
+(num-test (max 0(+)(-(*))1) 1)
+
+(test ((call-with-exit object->string) 0) #\#) ; #<goto>
+(test ((begin begin) 1) 1)
+(test ((values begin) 1) 1)
+(test ((provide or) 3/4) 'error)
+(test (string? cond) #f)
+(test (list? or) #f)
+(test (pair? define) #f)
+(test (number? lambda*) #f)
+(test ((*s7* 'version) (rationalize 0)) #\s)
+(test (cond (((values '(1 2) '(3 4)) 0 0))) 'error)
+(test (cond (((#2d((1 2) (3 4)) 0) 0) 32)) 32)
+(test (cond ((apply < '(1 2)))) #t)
+(test (dynamic-wind lcm gcd *) 0) ; was 'error but Peter Bex tells me this is normal
+(test (case 0 ((> 0 1) 32)) 32)
+(test (char-downcase (char-downcase #\newline)) #\newline)
+(test (and (and) (and (and)) (and (and (and (or))))) #f)
+(test ((values begin #\a 1)) 1)
+(test ((values and 1 3)) 3)
+(test ((((lambda () begin)) (values begin 1))) 1)
+(test (+ (((lambda* () values)) 1 2 3)) 6)
+(test ((values ('((1 2) (3 4)) 1) (abs -1))) 4)
+(test ((apply lambda () '(() ()))) ())
+(test ((lambda* ((symbol "#(1 #\\a (3))")) #t)) #t)
+(test (apply if ('((1 2) (3 4)) 1)) 4)
+
+(test (((lambda #\newline gcd))) 'error)
+(test (symbol? (let () (define (hi) (+ 1 2)))) #f)
+(test (symbol? (begin (define (x y) y) (x (define (x y) y)))) #f)
+(test (symbol? (do () ((define (x) 1) (define (y) 2)))) #f)
+(test (cond (0 (define (x) 3) (x))) 3)
+(test (let ((x (lambda () 3))) (if (define (x) 4) (x) 0)) 4)
+(test (and (define (x) 4) (+ (x) 1)) 5)
+(test (do ((x (lambda () 3) (lambda () 4))) ((= (x) 4) (define (x) 5) (x))) 5)
+(test (begin (if (define (x) 3) (define (x) 4) (define (x) 5)) (x)) 4)
+
+(test (let ((1,1 3) (1'1 4) (1|1 5) (1#1 6) (1\1 7) (1?1 8)) (+ 1,1 1'1 1|1 1#1 1\1 1?1)) 33)
+(test (let ((,a 3)) ,a) 'error)
+(test (let ((@a 3)) @a) 3)
+(test (let (("a" 3)) "a") 'error)
+(test (let ((`a 3)) `a) 'error)
+(test (let (('a 3)) 'a) 'error)
+(test (let ((a`!@#$%^&*~.,<>?/'{}[]\|+=_-a 3)) a`!@#$%^&*~.,<>?/'{}[]\|+=_-a) 3)
+
+(test (set! ((quote (1 2)) 0) #t) #t)
+(test (set! (((lambda () (list 1 2))) 0) 2) 2)
+(test (let ((x (list 1 2))) (set! (((lambda () x)) 0) 3) x) '(3 2))
+(test (let ((x (list 1 2))) (set! (((vector x) 0) 1) 32) x) '(1 32))
+(test (let ((x (list 1 2))) (set! ((((lambda () (vector x))) 0) 0) 3) x) '(3 2))
+(test (let ((x (list 1 2))) (set! ((((lambda () (list x))) 0) 0) 3) x) '(3 2))
+(test (let ((x (list 1 2))) (set! ((set! x (list 4 3)) 0) 32) x) '(32 3))
+(test (let ((x (list 1 2))) (list-set! (set! x (list 4 3)) 0 32) x) '(32 3))
+(test (let ((x (list 1 2))) (set! ((list-set! x 0 (list 4 3)) 0) 32) x) '((32 3) 2))
+(test (let ((x (list 1 2))) (list-set! (list-set! x 0 (list 4 3)) 0 32) x) '((32 3) 2))
+(test (set! (('((0 2) (3 4)) 0) 0) 0) 0)
+(test (set! ((map abs '(1 2)) 1) 0) 0)
+(test (let () (set! ((define x #(1 2)) 0) 12) x) #(12 2))
+(test (let ((x (list 1 2))) (set! ((call-with-exit (lambda (k) (k x))) 0) 12) x) '(12 2))
+(test (let ((x #2d((1 2) (3 4)))) (set! (((values x) 0) 1) 12) x) #2d((1 12) (3 4)))
+(test (let ((x 0)) (set! ((dilambda (lambda () x) (lambda (y) (set! x y)))) 12) x) 12)
+(test (let ((x 0) (str "hiho")) (string-set! (let () (set! x 32) str) 0 #\x) (list x str)) '(32 "xiho"))
+(test (let ((x "hi") (y "ho")) (set! ((set! x y) 0) #\x) (list x y)) '("xo" "xo"))
+(test (let ((x "hi") (y "ho")) (set! x y) (set! (y 0) #\x) (list x y)) '("xo" "xo")) ; Guile gets the same result
+(test (let ((x (lambda (a) (a z 1) z))) (x define)) 1) ; !
+(test (let ((x (lambda (a) (a z (lambda (b) (+ b 1))) (z 2)))) (x define)) 3)
+(test (let ((x (lambda (a b c) (apply a (list b c))))) (x let () 3)) 3)
+(test (let ((x (lambda (a b c) (apply a (list b c))))) (x let '((y 2)) '(+ y 1))) 3)
+
+(let () (test ((values let '((x 1))) '(+ x 1)) 2)) ; !
+(let () (test ((values begin '(define x 32)) '(+ x 1)) 33))
+(let () (test (((values lambda '(x) '(+ x 1))) 32) 33))
+(let () (test (let ((arg '(x)) (body '(+ x 1))) (((values lambda arg body)) 32)) 33))
+(let () (test (let ((arg '(x)) (body '(+ x 1))) ((apply lambda arg (list body)) 32)) 33))
+(let () (test (let ((x 12)) ((apply lambda '(x) (list (list '+ 1 x 'x))) 3)) 16))
+(let () (test (let* ((x 3) (arg '(x)) (body `((+ ,x x 1)))) ((apply lambda arg body) 12)) 16))
+
+(let ()
+  (define (bcase start end func)
+    (let ((body ()))
+      (do ((i start (+ i 1)))
+	  ((= i end))
+	  (set! body (cons `((,i) ,(func i)) body)))
+      (lambda (i) (apply case i body))))
+  (test ((bcase 0 3 abs) 1) 1))
+
+(when full-s7test
+  (define (__let_f1__ a b) (list a b))
+  (define-expansion (read__let_f1__) `(list ,__let_f1__))
+  (define (call__let_f1__) (read__let_f1__))
+  (call__let_f1__)
+  (gc)
+  (gc)
+  (__let_f1__ 1 2)
+
+  (define* (__let__f2__ a) (+ a 1))
+  (define-expansion (read__let__f2__) `(,__let__f2__ 3))
+  (define (call__let__f2__) (read__let__f2__))
+  (call__let__f2__)
+  (gc)
+  (gc)
+  (__let__f2__ 3)
+  (__let_f1__ 1 2)
+
+  (define __let__f3__-iter (make-iterator "123"))
+  (define-expansion (read__let__f3__) `(iterate ,__let__f3__-iter))
+  (define (__let__f3__) (read__let__f3__))
+  (define (call__let__f3__) (read__let__f3__))
+  (call__let__f3__)
+  (gc)
+  (gc)
+  (__let__f2__ 3)
+  (__let_f1__ 1 2)
+  (__let__f3__)
+
+  (let ((d (block 0 1 2)) ; safe-list = sc->args gc problem (iterator will be a free cell) -- limit below needs to be higher in this context
+	(m (immutable! (inlet 'a 3 'b 2))))
+    (define (func)
+      (with-input-from-string
+	  (object->string (car (list (round (+)) (make-iterator (make-vector '(2 3) #f)) m d (make-list 256 1) +inf.0)))
+	read-line))
+    (define (gunc) (func))
+    (do ((i 0 (+ i 1)))
+	((= i 100))
+      (when (zero? (modulo i 100000)) (*s7* 'version) (display "."))
+      (gunc))))
+
+
+
+;;; ------ CLisms ------------------------------------------------------------------------
+
+
+(let ()
+
+      ;; **********************************************************************
+      ;;
+      ;; Copyright (C) 2002 Heinrich Taube (taube@uiuc.edu)
+      ;;
+      ;; This program is free software; you can redistribute it and/or
+      ;; modify it under the terms of the GNU General Public License
+      ;; as published by the Free Software Foundation; either version 2
+      ;; of the License, or (at your option) any later version.
+      ;;
+      ;; This program is distributed in the hope that it will be useful,
+      ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+      ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+      ;; GNU General Public License for more details.
+      ;;
+      ;; **********************************************************************
+
+      ;; $Name:  $
+      ;; $Revision: 1.6 $
+      ;; $Date: 2005/11/17 13:29:37 $
+
+      ;;
+      ;; Implementation of the CLTL2 loop macro. The following
+      ;; non Rev 5 definitions need to be in effect before the file
+      ;; is loaded:
+      ;;
+      ;; (define-macro (name . args) ...)
+      ;; (error string)
+      ;; (gensym string)
+      ;;
+
+;      (define-macro (when test . forms)
+;	`(if ,test (begin ,@forms)))
+
+      (define-macro (loop . args)
+	(let ()
+
+	  (define-macro (push val sym)
+	    `(begin (set! ,sym (cons ,val ,sym)) ,sym))
+
+	  (define-macro (pop sym)
+	    (let ((v (gensym "v")))
+	      `(let ((,v (car ,sym)))
+		 (set! ,sym (cdr ,sym))
+		 ,v)))
+
+	  ;; this next one is a no-op but i need it as a marker for my cltl2
+	  ;; translator.
+
+	  (define-macro (function sym) sym)
+
+	  ;; getters and setters for the loop-clause "struct"
+
+	  (define (loop-operator c)          (vector-ref  c 0))
+	  (define (loop-operator-set! c x)   (vector-set! c 0 x))
+	  (define (loop-bindings c)          (vector-ref  c 1))
+	  (define (loop-bindings-set! c x)   (vector-set! c 1 x))
+	  (define (loop-collectors c)        (vector-ref  c 2))
+	  (define (loop-collectors-set! c x) (vector-set! c 2 x))
+	  (define (loop-initially c)         (vector-ref  c 3))
+	  (define (loop-initially-set! c x)  (vector-set! c 3 x))
+	  (define (loop-end-tests c)         (vector-ref  c 4))
+	  (define (loop-end-tests-set! c x)  (vector-set! c 4 x))
+	  (define (loop-looping c)           (vector-ref  c 5))
+	  (define (loop-looping-set! c x)    (vector-set! c 5 x))
+	  (define (loop-stepping c)          (vector-ref  c 6))
+	  (define (loop-stepping-set! c x)   (vector-set! c 6 x))
+	  (define (loop-finally c)           (vector-ref  c 7))
+	  (define (loop-finally-set! c x)    (vector-set! c 7 x))
+	  (define (loop-returning c)         (vector-ref  c 8))
+	  (define (loop-returning-set! c x)  (vector-set! c 8 x))
+
+	  (define (make-loop-clause . args)
+	    (let ((v (vector #f () () () () () () () ())))
+	      (if (null? args) v
+		  (do ((a args (cddr a)))
+		      ((null? a) v)
+		    (case (car a)
+		      ((operator) (loop-operator-set! v (cadr a)))
+		      ((bindings) (loop-bindings-set! v (cadr a)))
+		      ((collectors) (loop-collectors-set! v (cadr a)))
+		      ((initially) (loop-initially-set! v (cadr a)))
+		      ((end-tests) (loop-end-tests-set! v (cadr a)))
+		      ((looping) (loop-looping-set! v (cadr a)))
+		      ((stepping) (loop-stepping-set! v (cadr a)))
+		      ((finally) (loop-finally-set! v (cadr a)))
+		      ((returning) (loop-returning-set! v (cadr a))))))))
+
+	  (define (gather-clauses caller clauses)
+	    ;; nconc all clausal expressions into one structure
+	    (let ((gather-clause
+		   (lambda (clauses accessor)
+		     ;; append data from clauses
+		     (do ((l ()))
+			 ((null? clauses) l)
+		       (set! l (append l (accessor (car clauses))))
+		       (set! clauses (cdr clauses))))))
+	      (make-loop-clause 'operator caller
+				'bindings
+				(gather-clause clauses
+					       (function loop-bindings))
+				'collectors
+				(gather-clause clauses
+					       (function loop-collectors))
+				'initially
+				(gather-clause clauses
+					       (function loop-initially))
+				'end-tests
+				(gather-clause clauses
+					       (function loop-end-tests))
+				'looping
+				(gather-clause clauses
+					       (function loop-looping))
+				'stepping
+				(gather-clause clauses
+					       (function loop-stepping))
+				'finally
+				(gather-clause clauses
+					       (function loop-finally))
+				'returning
+				(gather-clause clauses
+					       (function loop-returning)))))
+
+	  (define (loop-op? x ops)
+	    (assoc x ops))
+
+	  (define (loop-variable? x)
+	    (symbol? x))
+
+	  (define (make-binding var val)
+	    (list var val))
+
+	  (define (loop-error ops forms . args)
+	    ;; all error messages include error context.
+	    (let ((loop-context
+		   (lambda (lst ops)
+		     ;; return tail of expr up to next op in cdr of tail
+		     (do ((h lst)
+			  (l ()))
+			 ((or (null? lst)
+			      ;; ignore op if in front.
+			      (and (not (eq? h lst))
+				   (loop-op? (car lst) ops)))
+			  (reverse l))
+		       (set! l (cons (car lst) l))
+		       (set! lst (cdr lst))))))
+	      (let ((forms (loop-context forms ops)))
+		(newline)
+		(display "LOOP ERROR: ")
+		(do ((tail args (cdr tail)))
+		    ((null? tail) #f)
+		  (display (car tail)))
+		(newline)
+		(display "clause context: ")
+		(if (null? forms)
+		    (display "()")
+		    (do ((tail forms (cdr tail)))
+			((null? tail) #f)
+		      (if (eq? tail forms) (display "'"))
+		      (display (car tail))
+		      (display (if (null? (cdr tail)) "'" " "))))
+		(newline)
+		(error 'syntax-error "illegal loop syntax"))))
+
+	  (define (parse-for forms clauses ops)
+	    ;; forms is (FOR ...)
+	    (let ((op (loop-op? (car forms) ops)))
+	      (if (null? (cdr forms))
+		  (loop-error ops forms "Variable expected but source code ran out." )
+		  (let ((var (cadr forms)))
+		    (if (loop-variable? var)
+			(if (null? (cddr forms))
+			    (loop-error ops forms
+					"'for' clause expected but source code ran out.")
+			    ;; find the iteration path in the op
+			    (let ((path (assoc (caddr forms) (cdddr op))))
+			      ;; path is (<pathop> <parser>)
+			      (if (not path)
+				  (loop-error ops forms "'" (caddr forms) "'"
+					      " is not valid with 'for'.")
+				  ( (cadr path) forms clauses ops))))
+			(loop-error ops forms "Found '" (cadr forms)
+				    "' where a variable expected."))))))
+
+	  (define (parse-numerical-for forms clauses ops)
+	    ;; forms is (FOR <var> <OP> ...)
+	    ;; where <OP> is guaranteed to be one of: FROM TO BELOW ABOVE DOWNTO
+	    ;; (bil) clauses
+	    (let ((var (cadr forms))
+		  (tail (cddr forms))
+		  (bind ())
+		  (from #f)
+		  (head #f)
+		  (last #f)
+		  (stop #f)
+		  (step #f)
+		  (test #f)
+		  (incr #f))
+
+	      (do ((next #f))
+		  ((or (null? tail) (loop-op? (car tail) ops)))
+		(set! next (pop tail))
+		(if (null? tail)
+		    (loop-error ops forms
+				"Expected expression but source code ran out."))
+		(case next
+		  ((from downfrom)
+		   (if head (loop-error ops forms "Found '" next "' when '"
+					head "' in effect."))
+		   (set! head next)
+		   (set! from (pop tail)))
+		  ((below)
+		   (if last (loop-error ops forms "Found '" next "' when '"
+					last "' in effect."))
+		   (set! stop (pop tail))
+		   (set! last next))
+		  ((to)
+		   (if last (loop-error ops forms "Found '" next "' when '"
+					last "' in effect."))
+		   (set! stop (pop tail) )
+		   (set! last next))
+		  ((above )
+		   (if last (loop-error ops forms "Found '" next "' when '"
+					last "' in effect."))
+		   (set! stop (pop tail))
+		   (set! last next))
+		  ((downto )
+		   (if last (loop-error ops forms "Found '" next "' when '"
+					last "' in effect."))
+		   (set! stop (pop tail))
+		   (set! last next))
+		  ((by)
+		   (if step (loop-error ops forms "Found duplicate 'by'."))
+		   (set! step (pop tail)))
+		  (else
+		   (loop-error ops forms
+			       "'" next "' is not valid with 'for'."))))
+	      (if (not head)
+		  (set! head 'from))
+	      (if (or (eq? head 'downfrom)
+		      (eq? last 'downto)
+		      (eq? last 'above))
+		  (begin
+		    (set! incr '-)
+		    (if (eq? last 'above)
+			(set! test '<=)
+			(set! test '<)))   ; allow to for downto
+		  (begin
+		    (set! incr '+)
+		    (if (eq? last 'below)
+			(set! test '>=)
+			(set! test '>))))
+
+	      ;; add binding for initial value
+	      (push (make-binding var (or from 0)) bind)
+	      ;; add binding for non-constant stepping values.
+	      (if (not step)
+		  (set! step 1)
+		  (if (not (number? step))
+		      (let ((var (gensym "v")))
+			(push (make-binding var step) bind)
+			(set! step var))))
+	      (set! step `(set! ,var (,incr ,var ,step)))
+	      (if stop
+		  (let ((end (gensym "v")))
+		    (push (make-binding end stop) bind)
+		    (set! stop (list test var end))))
+	      (values (make-loop-clause 'operator 'for
+					'bindings (reverse bind)
+					'stepping (list step)
+					'end-tests (if (not stop)
+						       () (list stop)))
+		      tail)))
+
+	  (define (parse-repeat forms clauses ops)
+	    ;; forms is (REPEAT <FORM> ...)
+	    (if (null? (cdr forms))
+		(loop-error ops forms
+			    "'repeat' clause expected but source code ran out." )
+		(call-with-values (lambda ()
+				    (parse-numerical-for
+				     (list 'for (gensym "v") 'below (cadr forms))
+				     clauses ops))
+		  (lambda (clause ignore)
+		    ignore
+		    (values clause (cddr forms))))))
+
+	  (define (parse-sequence-iteration forms clauses ops)
+	    ;; tail is (FOR <var> <OP> ...)
+	    ;; <OP> is guaranteed to be one of: IN ON ACROSS
+	    ;; (bil) clauses
+	    (let ((head forms)
+		  (var (cadr forms))
+		  (seq (gensym "v"))
+		  (tail (cddr forms))
+		  (bind ())
+		  (data #f)
+		  (init ())
+		  (loop ())
+		  (incr #f)
+		  (stop ())
+		  (step ())
+		  (type #f))
+
+	      (do ((next #f))
+		  ((or (null? tail) (loop-op? (car tail) ops)))
+		(set! next (pop tail))
+		(when (null? tail)
+		      (loop-error ops head
+				  "Expression expected but source code ran out." ))
+		(case next
+		  ((in on across)
+		   (if type (loop-error ops head
+					"Extraneous '" next "' when '"
+					type "' in effect."))
+		   (set! type next)
+		   (set! data (pop tail)))
+		  ((by )
+		   (if incr
+		       (loop-error ops head "Duplicate 'by'." )
+		       (if (eq? type 'across)
+			   (loop-error ops head "'by' is invalid with 'across'." )
+			   (set! incr (pop tail)))))
+		  (else
+		   (loop-error ops head "'" next "' is not valid with 'for'."))))
+					; add bindings for stepping var and source
+	      (push (make-binding var #f) bind)
+	      (push (make-binding seq data) bind)
+	      (if (eq? type 'across)
+		  (let ((pos (gensym "v"))
+			(mx (gensym "v")))
+		    (push (make-binding pos 0) bind)
+		    (push (make-binding mx #f) bind)
+		    (push `(set! ,mx (vector-length ,seq)) init)
+		    (push `(set! ,pos (+ 1 ,pos)) step)
+		    (push `(set! ,var (vector-ref ,seq ,pos)) loop)
+		    (push `(>= ,pos ,mx) stop))
+		  (begin
+		    (if incr
+			(if (and (list? incr) (eq? (car incr) 'quote))
+			    (push `(set! ,seq (,(cadr incr) ,seq)) step)
+			    (push `(set! ,seq (,incr ,seq)) step))
+			(push `(set! ,seq (cdr ,seq)) step))
+		    (push (if (eq? type 'in)
+			      `(set! ,var (car ,seq))
+			      `(set! ,var ,seq))
+			  loop)
+		    (push `(null? ,seq) stop)))
+
+	      (values (make-loop-clause 'operator 'for
+					'bindings (reverse bind)
+					'end-tests stop
+					'initially init
+					'looping loop
+					'stepping step)
+		      tail)))
+
+	  (define (parse-general-iteration forms clauses ops)
+	    ;; forms is (FOR <var> = ...)
+	    ;; (bil) clauses
+	    (let ((head forms)
+		  (var (cadr forms))
+		  (tail (cddr forms))
+		  (init #f)
+		  (type #f)
+		  (loop #f)
+		  (step #f))
+	      (do ((next #f))
+		  ((or (null? tail) (loop-op? (car tail) ops)))
+		(set! next (pop tail))
+		(if (null? tail)
+		    (loop-error ops head
+				"Expression expected but source code ran out."))
+		(case next
+		  ((= )
+		   (if type (loop-error ops head "Duplicate '='."))
+		   (set! loop `(set! ,var ,(pop tail)))
+		   (set! type next))
+		  ((then )
+		   (if init (loop-error ops head "Duplicate 'then'."))
+		   (set! init loop)
+		   (set! loop #f)
+		   (set! step `(set! ,var ,(pop tail)))
+		   (set! type next))
+		  (else
+		   (loop-error ops head "'" next "' is not valid with 'for'."))))
+
+	      (values (make-loop-clause 'operator 'for
+					'bindings (list (make-binding var #f))
+					'initially (if init (list init) ())
+					'looping (if loop (list loop) ())
+					'stepping (if step (list step) ()))
+		      tail)))
+
+	  (define (parse-with forms clauses ops)
+	    ;; forms is (WITH <var> = ...)
+	    ;; (bil) clauses
+	    (let ((head forms)
+		  (tail (cdr forms))
+		  (var #f)
+		  (expr #f)
+		  (and? #f)
+		  (bind ())
+		  (init ()))
+	      (do ((need #t)
+		   (next #f))
+		  ((or (null? tail) (loop-op? (car tail) ops)))
+		(set! next (pop tail))
+		(cond ((and (loop-variable? next) need)
+		       (if var
+			   (loop-error ops head
+				       "Found '" next "' where 'and' expected."))
+		       (if expr
+			   (loop-error ops head
+				       "Found '" next "' where 'and' expected."))
+		       (set! var next)
+		       (set! expr #f)
+		       (set! and? #f)
+		       (set! need #f))
+		      ((eq? next 'and)
+		       (if and?
+			   (loop-error ops head "Duplicate 'and'.")
+			   (if var
+			       (if expr
+				   (begin
+				     (push (make-binding var #f) bind)
+				     (push `(set! ,var ,expr) init))
+				   (push (make-binding var #f) bind))
+			       (loop-error ops head "Extraneous 'and'.")))
+		       (set! var #f)
+		       (set! expr #f)
+		       (set! and? #t)
+		       (set! need #t))
+		      ((eq? next '=)
+		       (if expr
+			   (loop-error ops head
+				       "Found '=' where 'and' expected.")
+			   (set! expr (pop tail))))
+		      (else
+		       (if need
+			   (loop-error ops head
+				       "Found '" next "' where variable expected.")
+			   (loop-error ops head "Found '" next
+				       "' where '=' or 'and' expected.")))))
+	      (if and?
+		  (loop-error ops head "Extraneous 'and'.")
+		  (if var
+		      (if expr
+			  (begin (push (make-binding var #f) bind)
+				 (push `(set! ,var ,expr) init))
+			  (push (make-binding var #f) bind))))
+
+	      (values (make-loop-clause 'operator 'with
+					'bindings (reverse bind)
+					'initially (reverse init))
+		      tail)))
+
+	  (define (parse-do forms clauses ops)
+	    ;; (bil) clauses
+	    (let ((head forms)
+		  (oper (pop forms))
+		  (body ()))
+	      (do ()
+		  ((or (null? forms)
+		       (loop-op? (car forms) ops))
+		   (if (null? body)
+		       (loop-error ops head "Missing '" oper "' expression.")
+		       (set! body (reverse body))))
+		(push (car forms) body)
+		(set! forms (cdr forms)))
+	      (values
+	       (make-loop-clause 'operator oper 'looping body)
+	       forms)))
+
+	  (define (parse-finally forms clauses ops)
+	    ;; (bil) clauses
+	    (let ((oper (pop forms))
+		  (expr #f))
+	      (if (null? forms)
+		  (loop-error ops forms "Missing '" oper "' expression."))
+	      (set! expr (pop forms))
+	      (values (make-loop-clause 'operator oper 'finally (list expr))
+		      forms)))
+
+	  (define (parse-initially forms clauses ops)
+	    ;; (bil) clauses
+	    (let ((oper (pop forms))
+		  (expr #f))
+	      (if (null? forms)
+		  (loop-error ops forms "Missing '" oper "' expression."))
+	      (set! expr (pop forms))
+	      (values (make-loop-clause 'operator oper 'initially (list expr))
+		      forms)))
+
+	  (define (lookup-collector var clauses)
+	    ;; collector is list: (<var> <type> <acc> <head>)
+	    ;; returns the clause where the collect variable VAR is
+	    ;; actually bound or nil if var hasn't already been bound
+	    ;; if var is nil only the single system allocated collecter
+	    ;; is possibly returned.
+	    (let ((checkthem (lambda (var lis)
+			       (do ((a #f))
+				   ((or (null? lis) a) a)
+				 (if (eq? var (car (car lis))) ;collector-var
+				     (set! a (car lis)))
+				 (set! lis (cdr lis))))))
+	      (do ((c #f))
+		  ((or (null? clauses) c) c)
+		(set! c (checkthem var (loop-collectors (car clauses))))
+		(set! clauses (cdr clauses)))))
+
+	  (define (compatible-accumulation? typ1 typ2)
+	    (let ((l1 '(collect append nconc))
+		  (l2 '(never always))
+		  (l3 '(minimize maximize)))
+	      (or (eq? typ1 typ2)
+		  (and (member typ1 l1) (member typ2 l1))
+		  (and (member typ1 l2) (member typ2 l2))
+		  (and (member typ1 l3) (member typ2 l3)))))
+
+	  (define (parse-accumulation forms clauses ops)
+	    ;; forms is (<op> form ...)
+	    ;; where <op> is collect append nconc
+	    (let ((save forms)
+		  (oper (pop forms))
+		  (make-collector (lambda (var type acc head)
+				    (list var type acc head)))
+		  ;; removed because noop
+		  ;;(collector-var (lambda (col) (car col)))
+		  (collector-type (lambda (col) (cadr col)))
+		  (collector-acc (lambda (col) (caddr col)))
+		  (collector-head (lambda (col) (cadddr col)))
+		  (expr #f)
+		  (coll #f)
+		  (new? #f)
+		  (into #f)
+		  (loop ())
+		  (bind ())
+		  (init ())
+		  (tests ())
+		  (return ()))
+
+	      (if (null? forms)
+		  (loop-error ops forms "Missing '" oper "' expression."))
+	      (set! expr (pop forms))
+	      (if (not (null? forms))
+		  (if (eq? (car forms) 'into)
+		      (begin
+			(if (null? (cdr forms))
+			    (loop-error ops save "Missing 'into' variable."))
+			(if (loop-variable? (cadr forms))
+			    (begin (set! into (cadr forms))
+				   (set! forms (cddr forms)))
+			    (loop-error ops save "Found '" (car forms)
+					"' where 'into' variable expected.")))))
+
+	      ;; search for a clause that already binds either the user specified
+	      ;; accumulator (into) or a system allocated one if no into.
+	      ;; system collectors
+	      ;;   o only one  allowed, all accumuations must be compatible
+	      ;;   o returns value
+	      ;;   value collector: (nil <op> <#:acc>)
+	      ;;   list collector:  (nil <op> <#:tail> <#:head>)
+	      ;; into collectors
+	      ;;   o any number allowed
+	      ;;   o returns nothing.
+	      ;;   value collector: (<into> <op> <into> )
+	      ;;   list collector:  (<into> <op> <#:tail> <#:head>)
+	      (set! coll (lookup-collector into clauses))
+	      (if (not coll)
+		  (set! new? #t)
+		  ;; accumulator already established by earlier clause
+		  ;; check to make sure clauses are compatible.
+		  (if (not (compatible-accumulation? oper (collector-type coll)))
+		      (loop-error ops save "'" (collector-type coll)
+				  "' and '" oper "' are incompatible accumulators.")))
+	      (case oper
+		((sum count)
+		 (let ((acc #f))
+		   (if new?
+		       (begin
+			 (set! acc (or into (gensym "v")))
+			 (push (make-binding acc 0) bind)
+			 ;; coll= (nil <op> <#:acc>) or (<into> <op> <into>)
+			 (set! coll (make-collector into oper acc #f))
+			 ;; only add a return value if new collector isnt into
+			 (if (not into) (push acc return)))
+		       (set! acc (collector-acc coll)))
+		   (if (eq? oper 'sum)
+		       (push `(set! ,acc (+ ,acc ,expr)) loop)
+		       (push `(if ,expr (set! ,acc (+ ,acc 1))) loop))))
+		((minimize maximize)
+		 (let ((var (gensym "v"))
+		       (opr (if (eq? oper 'minimize) '< '>))
+		       (acc #f))
+		   (if new?
+		       (begin
+			 (set! acc (or into (gensym "v")))
+			 (push (make-binding acc #f) bind)
+			 ;; coll= (nil <op> <#:acc>) or (<into> <op> <into>)
+			 (set! coll (make-collector into oper acc #f))
+			 ;; only add a return value if new collector isnt into
+			 (if (not into) (push `(or ,acc 0) return)))
+		       (set! acc (collector-acc coll)))
+		   (push (make-binding var #f) bind)
+		   (push `(begin (set! ,var ,expr)
+				 (if (or (not ,acc)
+					 (,opr ,var ,acc))
+				     (set! ,acc ,var)))
+			 loop)))
+		((append collect nconc)
+		 ;; for list accumulation a pointer to the tail of the list
+		 ;; is updated and the head of the list is returned. any
+		 ;; into variable is set to the head inside the loop.
+		 (let ((head #f)
+		       (tail #f))
+		   (if (not new?)
+		       (begin (set! tail (collector-acc coll))
+			      (set! head (collector-head coll)))
+		       (begin
+			 (if into (push (make-binding into '(list)) bind))
+			 (set! tail (gensym "v"))
+			 ;; allocate a pointer to the head of list
+			 (set! head (gensym "v"))
+			 (push (make-binding head '(list #f)) bind)
+			 (push (make-binding tail #f) bind)
+			 ;; initialize tail to head
+			 (push `(set! ,tail ,head) init)
+			 (set! coll (make-collector into oper tail head))
+			 ;; only add a return value if new collector isnt into
+			 (if (not into)
+			     (push `(cdr ,head) return))))
+		   ;; add loop accumulation forms
+		   (if (eq? oper 'append)
+		       (begin
+			 (push `(set-cdr! ,tail (append ,expr (list))) loop)
+			 (push `(set! ,tail (last-pair ,tail)) loop))
+		       (if (eq? oper 'collect)
+			   (begin
+			     (push `(set-cdr! ,tail (list ,expr)) loop)
+			     (push `(set! ,tail (cdr ,tail)) loop))
+			   (begin
+			     (push `(set-cdr! ,tail ,expr) loop)
+			     (push `(set! ,tail (last-pair ,tail)) loop))))
+		   ;; update user into variable inside the main loop
+		   ;; regardless of whether its a new collector or not
+		   (if into
+		       (push `(set! ,into (cdr ,head)) loop)))))
+
+	      (values (make-loop-clause 'operator oper
+					'bindings (reverse bind)
+					'initially (reverse init)
+					'looping (reverse loop)
+					'returning (reverse return)
+					'collectors (if new? (list coll) ())
+					'end-tests (reverse tests))
+		      forms)))
+
+					;(define (loop-stop expr)
+					;  `(%done% ,expr))
+
+	  (define (loop-return expr)
+	    `(return ,expr))
+
+	  (define (parse-while-until forms clauses ops)
+	    ;; (bil) clauses
+	    (let ((head forms)
+		  (oper (pop forms))
+		  (test #f)
+		  (stop '(go #t))) ; :done
+	      (if (null? forms)
+		  (loop-error ops head "Missing '" oper "' expression."))
+
+	      (case oper
+		((until ) (set! test (pop forms)))
+		((while ) (set! test `(not ,(pop forms)))))
+	      ;; calls the DONE continuation.
+	      (values (make-loop-clause 'operator oper
+					'looping (list `(if ,test ,stop)))
+		      forms)))
+
+	  (define (parse-thereis forms clauses ops)
+	    ;; (bil) clauses
+	    (let ((oper (car forms))
+		  (expr #f)
+		  (bool #f)
+		  (func #f))
+	      (if (null? (cdr forms))
+		  (loop-error ops forms "Missing '" (car forms) "' expression." ))
+	      (set! expr (cadr forms))
+	      ;; fourth element of operator definition must be
+	      ;; a function that returns the stop expression.
+	      (set! func (cadddr (loop-op? oper ops) ))
+
+	      (case oper
+		((thereis )
+		 ;; return true as soon as expr is true or false at end
+		 (set! bool #f))
+		((always )
+		 ;; return false as soon as expr is false, or true at end
+		 (set! expr `(not ,expr))
+		 (set! bool #t))
+		((never )
+		 ;; return false as soon as expr is true, or true at end
+		 (set! bool #t)))
+	      (set! forms (cddr forms))
+	      ;; this calls the RETURN continuation
+	      (values (make-loop-clause 'operator 'thereis
+					'looping
+					(list `(if ,expr ,(func (not bool))))
+					'returning
+					(list bool))
+		      forms)))
+
+	  (define (parse-return forms clauses ops)
+	    ;; (bil) clauses
+	    (let ((oper (car forms))
+		  (expr #f)
+		  (func #f))
+	      (if (null? (cdr forms))
+		  (loop-error ops forms "Missing '" (car forms) "' expression."))
+	      (set! expr (cadr forms))
+	      (set! forms (cddr forms))
+	      ;; fourth element of operator definition must be
+	      ;; a function that returns the stop expression.
+	      (set! func (cadddr (loop-op? oper ops) ))
+	      ;; this calls the RETURN continuation
+	      (values (make-loop-clause 'operator 'return
+					'looping `(,(func expr)))
+		      forms)))
+
+	  (define (legal-in-conditional? x ops)
+	    ;; FIXED (member (loop-operator...))
+	    (let ((op (loop-op? x ops)))
+	      (if (and op
+		       (not (null? (cddr op)))
+		       (eq? (caddr op) 'task)
+		       (not (member (car op) '(thereis never always))))
+		  op #f)))
+
+	  (define (parse-then-else-dependents forms clauses ops)
+	    (let ((previous forms)
+		  (stop? #f)
+		  (parsed ()))
+
+	      (do ((op #f)
+		   (clause #f)
+		   (remains #f))
+		  ((or (null? forms) stop?))
+		(set! op (legal-in-conditional? (car forms) ops))
+		(if (not op)
+		    (loop-error ops previous "'" (car forms)
+				"' is not conditional operator."))
+					;(multiple-value-setq
+					; (clause remains)
+					; ( (cadr op) forms (append clauses parsed) ops))
+		(call-with-values
+		    (lambda () ( (cadr op) forms (append clauses parsed) ops))
+		  (lambda (a b) (set! clause a) (set! remains b)))
+
+					;(format #t "~%after call clause=~s forms=~S" clause forms)
+
+		(set! parsed (append parsed (list clause)))
+		(set! previous forms)
+		(set! forms remains)
+
+		(if (not (null? forms))
+		    (if (eq? (car forms) 'and)
+			(begin
+			  (set! forms (cdr forms))
+			  (if (null? forms)
+			      (loop-error ops previous "Missing 'and' clause.")))
+			(if (eq? (car forms) 'else)
+			    (set! stop? #t)
+			    (if (loop-op? (car forms) ops)
+				(set! stop? #t))))))
+	      (values parsed forms)))
+
+	  (define (parse-conditional forms clauses ops)
+	    (let ((ops (cons '(else ) ops))
+		  (save forms)
+		  (oper (car forms))
+		  (loop (list))  ; avoid () because of acl bug
+		  (expr (list))
+		  (then (list))
+		  (else (list)))
+	      (if (null? (cdr forms))
+		  (loop-error ops save "Missing '" oper "' expression."))
+	      (set! forms (cdr forms))
+	      (set! expr (pop forms))
+	      (if (null? forms)
+		  (loop-error ops forms "Missing conditional clause."))
+	      (if (eq? oper 'unless)
+		  (set! expr (list 'not expr)))
+	      (call-with-values
+		  (lambda () (parse-then-else-dependents forms clauses ops))
+		(lambda (a b)
+		  (set! then a)
+		  (set! forms b)))
+
+	      ;; combine dependant clauses if more than one
+	      (if (not (null? (cdr then)))
+		  (set! then (gather-clauses (list) then))
+		  (set! then (car then)))
+	      (loop-operator-set! then 'if)
+
+	      ;; this (if ...) is hacked so that it is a newly
+	      ;; allocated list. otherwise acl and clisp have a
+	      ;; nasty structure sharing problem.
+	      (set! loop (list 'if expr
+			       (append `(begin ,@(loop-looping then)) (list))
+			       #f))
+	      (if (and (not (null? forms))
+		       (eq? (car forms) 'else))
+		  (begin
+		    (set! forms (cdr forms))
+		    (when (null? forms)
+			  (loop-error ops save "Missing 'else' clause."))
+		    (call-with-values
+			(lambda ()
+			  (parse-then-else-dependents
+			   forms (append clauses (list then))
+			   ops))
+		      (lambda (a b) (set! else a) (set! forms b)))
+		    (if (not (null? (cdr else)))
+			(set! else (gather-clauses () else))
+			(set! else (car else)))
+		    (set-car! (cdddr loop) `(begin ,@(loop-looping else)))
+		    ;; flush loop forms so we dont gather actions.
+		    (loop-looping-set! then ())
+		    (loop-looping-set! else ())
+		    (set! then (gather-clauses 'if (list then else)))))
+	      (loop-looping-set! then (list loop))
+	      (values then forms)))
+
+	  (define (parse-clauses forms cond? ops)
+	    (if (or (null? forms)
+		    (not (symbol? (car forms))))
+		(list (make-loop-clause 'operator 'do 'looping forms))
+		(let ((op-type? (lambda (op type)
+				  (and (not (null? (cddr op)))
+				       (eq? (caddr op) type)))))
+		  (let ((previous forms)
+			(clauses ()))
+		    (do ((op #f)
+			 (clause #f)
+			 (remains ())
+			 (body ()) )
+			((null? forms))
+		      (if (and cond? (eq? (car forms) 'and))
+			  (pop forms))
+		      (set! op (loop-op? (car forms) ops))
+		      (if (not op)
+			  (loop-error ops previous "Found '" (car forms)
+				      "' where operator expected."))
+					;(multiple-value-setq (clause remains)
+					;                     ((cadr op) forms clauses ops))
+		      (call-with-values
+			  (lambda () ( (cadr op) forms clauses ops))
+			(lambda (a b)
+			  (set! clause a)
+			  (set! remains b)))
+		      (if (op-type? op 'task)
+			  (set! body op)
+			  (if (op-type? op 'iter)
+			      (if (not (null? body))
+				  (loop-error ops previous "'" (car op)
+					      "' clause cannot follow '"
+					      (car body) "'."))))
+		      (set! previous forms)
+		      (set! forms remains)
+		      (set! clauses (append clauses (list clause))))
+		    clauses))))
+
+	  (define (parse-iteration caller forms ops)
+	    (gather-clauses caller (parse-clauses forms () ops)))
+
+	  ;;
+	  ;; loop implementation
+	  ;;
+
+	  (define *loop-operators*
+	    ;; each clause is (<op> <parser> <tag> . <whatever>)
+	    (list (list 'with (function parse-with) #f)
+		  (list 'initially (function parse-initially) #f)
+		  (list 'repeat (function parse-repeat) 'iter)
+		  (list 'for (function parse-for) 'iter
+			(list 'from (function parse-numerical-for))
+			(list 'downfrom (function parse-numerical-for))
+			(list 'below (function parse-numerical-for))
+			(list 'to (function parse-numerical-for))
+			(list 'above (function parse-numerical-for))
+			(list 'downto (function parse-numerical-for))
+			(list 'in (function parse-sequence-iteration))
+			(list 'on (function parse-sequence-iteration))
+			(list 'across (function parse-sequence-iteration))
+			(list '= (function parse-general-iteration)))
+		  (list 'as (function parse-for) 'iter)
+		  (list 'do (function parse-do) 'task)
+		  (list 'collect (function parse-accumulation) 'task)
+		  (list 'append (function parse-accumulation) 'task)
+		  (list 'nconc (function parse-accumulation) 'task)
+		  (list 'sum (function parse-accumulation) 'task)
+		  (list 'count (function parse-accumulation) 'task)
+		  (list 'minimize (function parse-accumulation) 'task)
+		  (list 'maximize (function parse-accumulation) 'task)
+		  (list 'thereis (function parse-thereis) 'task
+			(function loop-return))
+		  (list 'always (function parse-thereis) 'task
+			(function loop-return))
+		  (list 'never (function parse-thereis) 'task
+			(function loop-return))
+		  (list 'return (function parse-return) 'task
+			(function loop-return))
+		  (list 'while (function parse-while-until) #f )
+		  (list 'until (function parse-while-until) #f )
+		  (list 'when (function parse-conditional) 'task)
+		  (list 'unless (function parse-conditional) 'task)
+		  (list 'if (function parse-conditional) 'task)
+		  (list 'finally (function parse-finally) #f)))
+
+	  ;;
+	  ;; loop expansions for scheme and cltl2
+	  ;;
+
+	  (define (scheme-loop forms)
+	    (let ((name (gensym "v"))
+		  (parsed (parse-iteration 'loop forms *loop-operators*))
+		  (end-test ())
+		  (done '(go #t))  ; :done
+		  (return #f))
+					;(write (list :parsed-> parsed))
+	      ;; cltl2's loop needs a way to stop iteration from with the run
+	      ;; block (the done form) and/or immediately return a value
+	      ;; (the return form).  scheme doesnt have a block return or a
+	      ;; go/tagbody mechanism these conditions are implemented using
+	      ;; continuations.  The forms that done and return expand to are
+	      ;; not hardwired into the code because this utility is also used
+	      ;; by CM's 'process' macro. Instead, the done and return forms
+	      ;; are returned by functions assocated with the relevant operator
+	      ;; data. For example, the function that returns the return form
+	      ;; is stored as the fourth element in the return operator data.
+	      ;; and the done function is stored in the while and until op data.
+
+	      ;; the cadddr of the RETURN operator is a function that
+	      ;; provides the form for immediately returning a value
+	      ;; from the iteration.
+
+	      (let ((returnfn (cadddr (assoc 'return *loop-operators*))))
+		(set! return (returnfn
+			      (if (null? (loop-returning parsed))
+				  #f
+				  (car (loop-returning parsed))))))
+
+	      ;; combine any end-tests into a single IF expression
+	      ;; that calls the (done) continuation if true. multiple
+	      ;; tests are OR'ed togther
+
+	      (set! end-test
+		    (let ((ends (loop-end-tests parsed)))
+		      (if (null? ends)
+			  ()
+			  (list
+			   `(if ,(if (null? (cdr ends))
+				     (car ends)
+				     (cons 'or ends))
+				;;  calls the done continuation
+				,done
+				#f)))))
+	      `(let (,@ (loop-bindings parsed))
+		 ,@(loop-initially parsed)
+		 (call-with-exit
+		  (lambda (return)     ; <- (return) returns from this lambda
+		    (call-with-exit
+		     (lambda (go)  ; <- (go #t) returns from this lambda
+		       ;; a named let provides the actual looping mechanism.
+		       ;; the various tests and actions may exit via the
+		       ;; (done) or (return) continuations.
+		       (let ,name ()
+			    ,@end-test
+			    ,@(loop-looping parsed)
+			    ,@(loop-stepping parsed)
+			    (,name))))
+		    ;; this is the lexical point for (go #t) continuation.
+		    ,@(loop-finally parsed)
+		    ;; invoke the RETURN continuation with loop value or #f
+		    ,return)))))
+
+
+	  (scheme-loop args)))
+
+      ;;
+      ;; loop tests.
+      ;;
+
+      (test (loop for i below 10 collect i) '(0 1 2 3 4 5 6 7 8 9))
+      (test (loop for i to 10 sum i) 55)
+      (test (loop for i downto -10 count (even? i)) 6)
+      (test (loop for x in '(0 1 2 3 4 5 6 7 8 9) by cddr collect x) '(0 2 4 6 8))
+      (test (loop for x on '(0 1 2 3) by cddr collect x) '((0 1 2 3) (2 3)))
+      (test (loop for x in '(0 1 2 3 4 5 6 7 8 9) thereis (= x 4)) #t)
+      (test (loop for x in '(0 1 2 3 4 5 6 7 8 9) never (= x 4)) #f)
+      (test (loop for x in '(0 1 2 3 4 5 6 7 8 9) never (= x 40)) #t)
+      (test (loop for x in '(0 2 3 4 5 6 7 8 9) always (< x 40)) #t)
+      (test (loop repeat 10 with x = 0 collect x do (set! x (+ x 1))) '(0 1 2 3 4 5 6 7 8 9))
+      (test (loop repeat 10 for x = #t then (not x) collect x) '(#t #f #t #f #t #f #t #f #t #f))
+      (test (loop repeat 10 count #t) 10)
+      (test (loop repeat 10 count #f) 0)
+      (test (loop for i to 10 collect i collect (* 2 i)) '(0 0 1 2 2 4 3 6 4 8 5 10 6 12 7 14 8 16 9 18 10 20))
+      (test (loop for i from -10 to 10 by 2 nconc (list i (- i))) '(-10 10 -8 8 -6 6 -4 4 -2 2 0 0 2 -2 4 -4 6 -6 8 -8 10 -10))
+      (test (loop for i from -10 downto 10 by -1 collect i) ())
+      (test (loop for i downfrom 10 downto -10 by 2 collect i) '(10 8 6 4 2 0 -2 -4 -6 -8 -10))
+      (test (loop for i from 10 to -10 by 1 collect i) ())
+      (test (loop for i to 10 for j downfrom 10 collect i collect j) '(0 10 1 9 2 8 3 7 4 6 5 5 6 4 7 3 8 2 9 1 10 0))
+      (test (loop for i below 0 collect i into foo finally (return foo)) ())
+      (test (loop for i below 0 sum i into foo finally (return foo)) 0)
+      (test (loop for i below 0 maximize i into foo finally (return foo)) #f)
+      (test (loop with a and b = 'x and c = 2 repeat 10 for x = 1 then 'fred collect (list x a b c))
+	    '((1 #f x 2) (fred #f x 2) (fred #f x 2) (fred #f x 2) (fred #f x 2) (fred #f x 2) (fred #f x 2) (fred #f x 2) (fred #f x 2) (fred #f x 2)))
+      (test (loop for i across #(0 1 2 3) append (list i (expt 2 i))) '(0 1 1 2 2 4 3 8))
+      (test (loop with a = 0 and b = -1 while (< a 10) sum a into foo do (set! a (+ a 1)) finally (return (list foo b))) '(45 -1))
+      (test (loop for i from 0 until (> i 9) collect i) '(0 1 2 3 4 5 6 7 8 9))
+      (test (loop for i from 0 while (< i 9) when (even? i) collect i) '(0 2 4 6 8))
+      (test (loop with l = (list 0) for s in spec for k = s then (+ k s) do (push k l) finally (return l)) 'error)
+      (test (loop with l = (list (encode-interval 'p 1)) for s in spec for k = (interval s) then (transpose k (interval s)) do (push k l) finally (return l)) 'error)
+      ;; end loop
+
+      ;; more macros from Rick's stuff
+      (define-macro (dolist spec . body)	;; spec = (var list . return)
+	(let ((v (gensym)))
+	  `(do ((,v ,(cadr spec) (cdr ,v))
+		(,(car spec) #f))
+	       ((null? ,v) ,@(cddr spec))
+	     (set! ,(car spec) (car ,v))
+	     ,@body)))
+
+      (test (let ((sum 0)) (dolist (v (list 1 2 3) sum) (set! sum (+ sum v)))) 6)
+
+      (define-macro (dotimes spec . body)	;; spec = (var end . return)
+	(let ((e (gensym))
+	      (n (car spec)))
+	  `(do ((,e ,(cadr spec))
+		(,n 0 (+ ,n 1)))
+	       ((>= ,n ,e) ,@(cddr spec))
+	     ,@body)))
+
+      (test (let ((sum 0)) (dotimes (i 3 sum) (set! sum (+ sum i)))) 3)
+
+      (define-macro (do* spec end . body)
+	`(let* (,@(map (lambda (var) (list (car var) (cadr var))) spec))
+	   (do () ,end
+	     ,@body
+	     ,@(map (lambda (var) (if (pair? (cddr var))
+				      `(set! ,(car var) ,(caddr var))
+				      (values)))
+		    spec))))
+
+      (define (1+ x) (+ x 1))
+
+      (test (let ((sum 0)) (do* ((i 0 (+ i 1)) (j i (+ i 1))) ((= i 3) sum) (set! sum (+ sum j)))) 5)
+      (test (do* ((a 1 (+ a 1)) (b a)) ((> a 9) b)) 1)
+      (test (let ((a 0)) (do* ((a 1 (+ a 1)) (b a)) ((> a 9) a)) a) 0)
+      (test (do* ((i 0 (1+ i))) ((>= i 10) i)) 10)
+      (test (do* ((i 0 (1+ j)) (j 0 (1+ i))) ((>= i 10) (+ i j))) 23)
+      (test (let ((x ())) (do* ((i 0 (1+ i))) ((>= i 10) x) (set! x (cons i x)))) '(9 8 7 6 5 4 3 2 1 0))
+      (test (call-with-exit (lambda (return) (do* ((i 0 (1+ i))) () (when (> i 10) (return i))))) 11)
+      (test (do* ((i 0 (+ i 10))) ((> i -1) i) (error 'bad)) 0)
+      (test (do* ((i 0 (1+ i)) (x ())) ((>= i 10) x) (set! x (cons 'a x))) '(a a a a a a a a a a))
+      (test (let ((i 0)) (do* () ((>= i 10) i) (set! i (+ i 1)))) 10)
+      (test (do* ((i 0 (1+ i))) ((> i 10) (values))) #<unspecified>)
+      (test (+ 1 (do* ((i 0 (1+ i))) ((> i 10) (values i (1+ i))))) 24)
+      (test (do* ((i 0 (1+ i))) ((> i 10) (set! i (+ i 1)) (set! i (+ i 1)) i)) 13)
+      (test (do* ((i 0 (1+ i))) ((> i 10))) #t)
+      (test (map (lambda (f) (f)) (let ((x ())) (do* ((i 0 (+ i 1))) ((= i 5) x) (set! x (cons (lambda () i) x))))) '(5 5 5 5 5))
+      (test (do* ((lst (list 0 1 2 3 4 5 6 7 8 9) (cdr lst))
+		  (elm (car lst) (and (pair? lst) (car lst)))
+		  (n 0 (+ n (or elm 0))))
+		 ((null? lst) n))
+	    45)
+      (test (do* ((lst (list 0 1 2 3 4 5 6 7 8 9) (cdr lst))
+		  (elm (car lst) (and (pair? lst) (car lst)))
+		  (n 0))
+		 ((null? lst) n)
+		 (set! n (+ n elm)))
+	    45)
+      (test (let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
+	      (and (do* ((n #f)
+			 (i 0 (+ i 1))
+			 (j (- 9 i) (- 9 i)))
+			((>= i j))
+			(set! n (vec i))
+			(set! (vec i) (vec j))
+			(set! (vec j) n))
+		   (equal? vec #(9 8 7 6 5 4 3 2 1 0))))
+	    #t)
+
+      (define-macro (fluid-let xexe . body)
+	;; taken with changes from Teach Yourself Scheme
+	(let ((xx (map car xexe))
+	      (ee (map cadr xexe))
+	      (old-xx (map (lambda (ig) (gensym)) xexe)))
+	  `(let ,(map (lambda (old-x x) `(,old-x ,x))
+		      old-xx xx)
+	     (dynamic-wind
+		 (lambda () #f)
+		 (lambda ()
+		   ,@(map (lambda (x e)
+			    `(set! ,x ,e))
+			  xx ee)
+		   (let ()
+		     ,@body))
+		 (lambda ()
+		   ,@(map (lambda (x old-x)
+			    `(set! ,x ,old-x))
+			  xx old-xx))))))
+
+      (test (let ((x 32)
+		  (y 0))
+	      (define (gx) x)
+	      (fluid-let ((x 12))
+		(set! y (gx)))
+	      (list x y))
+	    '(32 12))
+
+      (test (let ((x "hi")
+		  (y 0)
+		  (z '(1 2 3)))
+	      (define (gx) (+ x z))
+	      (fluid-let
+		  ((x 32) (z (+ 123 (car z))))
+		(set! y (gx)))
+	      (list x y z))
+            '("hi" 156 (1 2 3)))
+
+      (test (let ((x 32)
+		  (y 0))
+	      (define (gx) x)
+	      (call-with-exit
+	       (lambda (return)
+		 (fluid-let ((x 12))
+		   (set! y (gx))
+		   (return))))
+	      (list x y))
+	    '(32 12))
+
+      (test (let ((x 32)
+		  (y 0))
+	      (define (gx) x)
+	      (let ((x 100))
+		(fluid-let ((x 12))
+		  (set! y (gx))))
+	      (list x y))
+	    '(32 32))
+      ;; oops! fluid-let doesn't actually work
+
+      ;; to make this work, use symbol->dynamic-value.  See also let-temporarily in stuff.scm.
+      (test (let ((x 32)
+		  (y 0))
+	      (define (gx) (symbol->dynamic-value 'x))
+	      (let ((x 100))
+		(let ((x 12))   ; no need for fluid-let anymore
+		  (set! y (gx))))
+	      (list x y))
+	    '(32 12))
+
+      (test (let ((y 0))
+	      (define (gx) (symbol->dynamic-value 'x))
+	      (let ((x 100))
+		(let ((x 12))
+		  (set! y (gx))
+		  (set! x 123))
+		(list x y)))
+	    '(100 12))
+
+      ;; in CL: (defvar x 32) (let ((y 0)) (defun gx () x) (let ((x 12)) (setf y (gx))) (list x y)) -> '(32 12)
+      ;;                      (let ((y 0)) (defun gx () x) (let ((x 100)) (let ((x 12)) (setf y (gx)))) (list x y)) -> '(32 12)
+      ;;                      (let ((y 0)) (defun gx () x) (let ((x 100)) (let ((x 12)) (setf y (gx)) (setf x 123)) (list x y))) -> '(100 12) !
+      ;; (the defvar makes x dynamic)
+
+      ;; define** treats args before :optional as required args
+      (define-macro (define** declarations . forms)
+	(let ((name (car declarations))
+	      (args (cdr declarations)))
+	  (define (position thing lst count)
+	    (if (or (null? lst)
+		    (not (pair? (cdr lst))))
+		#f
+		(if (eq? thing (car lst))
+		    count
+		    (position thing (cdr lst) (+ count 1)))))
+	  (define (no-opt old-args new-args)
+	    (if (null? old-args)
+		(reverse new-args)
+		(no-opt (cdr old-args)
+			(if (eq? (car old-args) :optional)
+			    new-args
+			    (cons (car old-args) new-args)))))
+	  (let ((required-args (position :optional args 0)))
+	    (if required-args
+		`(define* (,name . func-args)
+		   (if (< (length func-args) ,required-args)
+		       (error 'syntax-error
+			      "~A requires ~D argument~A: ~A"
+			      ',name ,required-args (if (> ,required-args 1) "s" "") func-args)
+		       (apply (lambda* ,(no-opt args ()) ,@forms) func-args)))
+		`(define* ,declarations ,@forms)))))
+
+      (let ()
+	(define** (f1 a :optional b) (+ a (or b 1)))
+	(test (f1 1) 2)
+	(test (f1 1 2) 3)
+	(test (f1) 'error))
+
+      ;; Rick's with-optkeys
+
+      (define-macro (with-optkeys spec . body)
+	(
+	 (lambda (user rawspec body)
+
+	   ;(define (string->keyword str) (symbol->keyword (string->symbol str)))
+
+	   (define (key-parse-clause info mode args argn user)
+	     ;; return a cond clause that parses one keyword. info for each
+	     ;; var is: (<got> <var> <val>)
+	     (let* ((got (car info))
+		    (var (cadr info))
+		    (key (string->keyword (symbol->string var))))
+	       `((eq? (car ,args) ,key )
+		 (if ,got (error 'syntax-error "duplicate keyword: ~S" , key))
+		 (set! ,var (if (null? (cdr ,args))
+				(error 'syntax-error "missing value for keyword: ~S"
+				       , user)
+				(cadr ,args)))
+		 (set! ,got #t) ; mark that we have a value for this param
+		 (set! ,mode #t) ; mark that we are now parsing keywords
+		 (set! ,argn (+ ,argn 1))
+		 (set! ,args (cddr ,args)))))
+
+	   (define (pos-parse-clause info mode args argn I)
+	     ;; return a cond clause that parses one positional. info for
+	     ;; each var is: (<got> <var> <val>)
+	     (let ((got (car info))
+		   (var (cadr info)))
+	       `((= ,argn ,I)
+		 (set! ,var (car ,args))
+		 (set! ,got #t) ; mark that we have a value for this param
+		 (set! ,argn (+ ,argn 1))
+		 (set! ,args (cdr ,args)))))
+
+	   (let* ((otherkeys? (member '&allow-other-keys rawspec))
+		  ;; remove &allow-other-keys from spec
+		  (spec (if otherkeys? (reverse (cdr (reverse rawspec))) rawspec))
+		  (data (map (lambda (v)
+			       ;; for each optkey variable v return a list
+			       ;; (<got> <var> <val>) where the <got>
+			       ;; variable indicates that <var> has been
+			       ;; set, <var> is the optkey variable itself
+			       ;; and <val> is its default value
+			       (if (pair? v)
+				   (cons (gensym (symbol->string (car v))) v)
+				   (list (gensym (symbol->string v)) v #f)))
+			     spec))
+		  (args (gensym "args")) ; holds arg data as its parsed
+		  (argn (gensym "argn"))
+		  (SIZE (length data))
+		  (mode (gensym "keyp")) ; true if parsing keywords
+		  ;; keyc are cond clauses that parse valid keyword
+		  (keyc (map (lambda (d) (key-parse-clause d mode args argn user))
+			     data))
+		  (posc (let lup ((tail data) (I 0))
+			  (if (null? tail) (list)
+			      (cons (pos-parse-clause (car tail) mode args argn I)
+				    (lup (cdr tail) (+ I 1))))))
+		  (bindings (map cdr data)) ; optkey variable bindings
+		  )
+
+	     (if otherkeys?
+		 (set! bindings (cons '(&allow-other-keys (list)) bindings)))
+
+	     `(let* ,bindings ; bind all the optkey variables with default values
+		;; bind status and parsing vars
+		(let ,(append (map (lambda (i) (list (car i) #f)) data)
+			      `((,args ,user)
+				(,argn 0)
+				(,mode #f)))
+		  ;; iterate arglist and set opt/key values
+		  (do ()
+		      ((null? ,args) #f)
+		    (cond
+		     ;; add valid keyword clauses first
+		     ,@ keyc
+			;; a keyword in (car args) is now either added to
+			;; &allow-other-keys or an error
+			, (if otherkeys?
+			      `((keyword? (car ,args))
+				(if (not (pair? (cdr ,args)))
+				    (error 'syntax-error "missing value for keyword ~S" (car ,args)))
+				(set! &allow-other-keys (append &allow-other-keys
+								(list (car ,args)
+								      (cadr ,args))))
+				(set! ,mode #t) ; parsing keys now...
+				(set! ,args (cddr ,args)) )
+			      `((keyword? (car ,args)) ;(and ,mode (keyword? (car ,args)))
+				(error 'syntax-error "invalid keyword: ~S" (car ,args)) )
+			      )
+			  ;; positional clauses illegal if keywords have happened
+			  (,mode (error 'syntax-error "positional after keywords: ~S" (car ,args)))
+			  ;; too many value specified
+			  ((not (< ,argn ,SIZE)) (error 'wrong-number-of-args "too many args: ~S" , args))
+			  ;; add the valid positional clauses
+			  ,@ posc
+			     ))
+		  ,@ body))
+	     ))
+	 (car spec)
+	 (cdr spec)
+	 body
+	 ))
+
+      (test (let ((args '(1 2 3)))  (with-optkeys (args a b c) (list a b c))) '(1 2 3))
+      (test (let ((args '(1 2 3 4)))  (with-optkeys (args a b c) (list a b c))) 'error)
+      (test (let ((args '(1 2))) (with-optkeys (args a b (c 33)) (list a b c))) '(1 2 33))
+      (test (let ((args ())) (with-optkeys (args a b (c 33)) (list a b c))) '(#f #f 33))
+      (test (let ((args '(:b 22))) (with-optkeys (args a b (c 33)) (list a b c))) '(#f 22 33))
+      (test (let ((args '(-1 :z 22))) (with-optkeys (args a b (c 33)) (list a b c))) 'error)
+      (test (let ((args '(:b 99 :z 22))) (with-optkeys (args a b (c 33)) (list a b c))) 'error)
+      (test (let ((args '(:z 22))) (with-optkeys (args a b (c 33) &allow-other-keys) (list a b c &allow-other-keys))) '(#f #f 33 (:z 22)))
+      (test (let ((args '(:id "0" :inst "flute" :name "Flute"))) (with-optkeys (args id inst &allow-other-keys) (list id inst &allow-other-keys))) '("0" "flute" (:name "Flute")))
+      (test (let ((args '(:inst "flute" :id "0" :name "Flute"))) (with-optkeys (args id inst &allow-other-keys) (list id inst &allow-other-keys))) '("0" "flute" (:name "Flute")))
+      (test (let ((args '(:id "0" :name "Flute" :inst "flute"))) (with-optkeys (args id inst &allow-other-keys) (list id inst &allow-other-keys))) '("0" "flute" (:name "Flute")))
+      (test (let ((args '(:name "Flute" :inst "flute" :id "0"))) (with-optkeys (args id inst &allow-other-keys) (list id inst &allow-other-keys))) '("0" "flute" (:name "Flute")))
+
+
+      (let ()
+
+	;; some common lispisms
+	;;   where names are the same, but functions are different (abs for example),
+	;;   I'll prepend "cl-" to the CL version; otherwise we end up redefining
+	;;   map and member, for example, which can only cause confusion.
+	;;
+	;; also I'm omitting the test-if-not and test-not args which strike me as ridiculous.
+	;; If CLtL2 says something is deprecated, it's not included.
+	;; Series and generators are ignored.
+	;;
+	;;  ... later ... I've run out of gas.
+
+					;(define-macro (progn . body) `(let () ,@body))
+	(define (null obj) (or (not obj) (null? obj)))
+	(define t #t)
+	(define nil ())
+
+	(define eq eq?)
+	(define eql eqv?)
+	(define equal equal?)
+	(define (equalp x y)
+	  (or (equal x y)
+	      (and (char? x) (char? y) (char-ci=? x y))
+	      (and (number? x) (number? y) (= x y))
+	      (and (string? x) (string? y) (string-ci=? x y))))
+
+	(define (identity x) x)
+	(define (complement fn) (lambda args (not (apply fn args))))
+
+	;; -------- numbers
+
+	(define (conjugate z) (complex (real-part z) (- (imag-part z))))
+	(define zerop zero?)
+	(define oddp odd?)
+	(define evenp even?)
+	(define plusp positive?)
+	(define minusp negative?)
+	(define realpart real-part)
+	(define imagpart imag-part)
+	(define* (float x ignore) (* 1.0 x))
+	(define rational rationalize)
+	(define mod modulo)
+	(define rem remainder)
+
+	(define (logtest i1 i2) (not (zero? (logand i1 i2))))
+	(define (logbitp index integer) (logbit? integer index)) ;(logtest (expt 2 index) integer))
+	(define (lognand n1 n2) (lognot (logand n1 n2)))
+	(define (lognor n1 n2) (lognot (logior n1 n2)))
+	(define (logandc1 n1 n2) (logand (lognot n1) n2))
+	(define (logandc2 n1 n2) (logand n1 (lognot n2)))
+	(define (logorc1 n1 n2) (logior (lognot n1) n2))
+	(define (logorc2 n1 n2) (logior n1 (logior n2)))
+	(define (logeqv . ints) (lognot (apply logxor ints)))
+
+	;; from slib
+	(define (logcount n)
+	  (define bitwise-bit-count
+	    (letrec ((logcnt (lambda (n tot)
+			       (if (zero? n)
+				   tot
+				   (logcnt (quotient n 16)
+					   (+ (vector-ref
+					       #(0 1 1 2 1 2 2 3 1 2 2 3 2 3 3 4)
+					       (modulo n 16))
+					      tot))))))
+	      (lambda (n)
+		(cond ((negative? n) (lognot (logcnt (lognot n) 0)))
+		      ((positive? n) (logcnt n 0))
+		      (else 0)))))
+	  (cond ((negative? n) (bitwise-bit-count (lognot n)))
+		(else (bitwise-bit-count n))))
+
+	(define-constant boole-clr 0)
+	(define-constant boole-set 1)
+	(define-constant boole-1 2)
+	(define-constant boole-2 3)
+	(define-constant boole-c1 4)
+	(define-constant boole-c2 5)
+	(define-constant boole-and 6)
+	(define-constant boole-ior 7)
+	(define-constant boole-xor 8)
+	(define-constant boole-eqv 9)
+	(define-constant boole-nand 10)
+	(define-constant boole-nor 11)
+	(define-constant boole-andc1 12)
+	(define-constant boole-andc2 13)
+	(define-constant boole-orc1 14)
+	(define-constant boole-orc2 15)
+
+	(define (boole op int1 int2)
+	  (cond
+	    ((= op boole-clr)   0)
+	    ((= op boole-set)   -1) ;; all ones -- "always 1" is misleading
+	    ((= op boole-1)     int1)
+	    ((= op boole-2)     int2)
+	    ((= op boole-c1)    (lognot int1))
+	    ((= op boole-c2)    (lognot int2))
+	    ((= op boole-and)   (logand int1 int2))
+	    ((= op boole-ior)   (logior int1 int2))
+	    ((= op boole-xor)   (logxor int1 int2))
+	    ((= op boole-eqv)   (logeqv int1 int2))
+	    ((= op boole-nand)  (lognot (logand int1 int2)))
+	    ((= op boole-nor)   (lognot (logior int1 int2)))
+	    ((= op boole-andc1) (logand (lognot int1) int2))
+	    ((= op boole-andc2) (logand int1 (lognot int2)))
+	    ((= op boole-orc1)  (logior (lognot int1) int2))
+	    ((= op boole-orc2)  (logior int1 (lognot int2)))))
+
+	;; from Rick
+	(define (byte siz pos)
+	  ;; cache size, position and mask.
+	  (list siz pos (ash (- (ash 1 siz) 1) pos)))
+
+	(define byte-size car)
+	(define byte-position cadr)
+	(define byte-mask caddr)
+
+	(define (ldb bytespec integer)
+	  (ash (logand integer (byte-mask bytespec))
+	       (- (byte-position bytespec))))
+
+	(define (dpb integer bytespec into)
+	  (logior (ash (logand integer (- (ash 1 (byte-size bytespec)) 1)) (byte-position bytespec))
+		  (logand into (lognot (byte-mask bytespec)))))
+
+	(define (ldb-test byte int) (not (zero? (ldb byte int))))
+	(define (mask-field byte int) (logand int (dpb -1 byte 0)))
+	(define (deposit-field byte spec int) (logior (logand byte (byte-mask spec)) (logand int (lognot (byte-mask spec)))))
+	(define (scale-float x k) (* x (expt 2.0 k)))
+
+	;; from clisp -- can't see any point to most of these
+	(define-constant double-float-epsilon 1.1102230246251568e-16)
+	(define-constant double-float-negative-epsilon 5.551115123125784e-17)
+	(define-constant least-negative-double-float -2.2250738585072014e-308)
+	(define-constant least-negative-long-float -5.676615526003731344e-646456994)
+	(define-constant least-negative-normalized-double-float -2.2250738585072014e-308)
+	(define-constant least-negative-normalized-long-float -5.676615526003731344e-646456994)
+	(define-constant least-negative-normalized-short-float -1.1755e-38)
+	(define-constant least-negative-normalized-single-float -1.1754944e-38)
+	(define-constant least-negative-short-float -1.1755e-38)
+	(define-constant least-negative-single-float -1.1754944e-38)
+	(define-constant least-positive-double-float 2.2250738585072014e-308)
+	(define-constant least-positive-long-float 5.676615526003731344e-646456994)
+	(define-constant least-positive-normalized-double-float 2.2250738585072014e-308)
+	(define-constant least-positive-normalized-long-float 5.676615526003731344e-646456994)
+	(define-constant least-positive-normalized-short-float 1.1755e-38)
+	(define-constant least-positive-normalized-single-float 1.1754944e-38)
+	(define-constant least-positive-short-float 1.1755e-38)
+	(define-constant least-positive-single-float 1.1754944e-38)
+	(define-constant long-float-epsilon 5.4210108624275221706e-20)
+	(define-constant long-float-negative-epsilon 2.7105054312137610853e-20)
+	(define-constant most-negative-double-float -1.7976931348623157e308)
+	;; most-negative-fixnum
+	(define-constant most-negative-long-float -8.8080652584198167656e646456992)
+	(define-constant most-negative-short-float -3.4028e38)
+	(define-constant most-negative-single-float -3.4028235e38)
+	(define-constant most-positive-double-float 1.7976931348623157e308)
+	;; most-positive-fixnum
+	(define-constant most-positive-long-float 8.8080652584198167656e646456992)
+	(define-constant most-positive-short-float 3.4028e38)
+	(define-constant most-positive-single-float 3.4028235e38)
+	(define-constant short-float-epsilon 7.6295e-6)
+	(define-constant short-float-negative-epsilon 3.81476e-6)
+	(define-constant single-float-epsilon 5.960465e-8)
+	(define-constant single-float-negative-epsilon 2.9802326e-8)
+
+	(define (lisp-implementation-type) "s7")
+	(define lisp-implementation-version (lambda () (*s7* 'version)))
+	(define (software-type) "s7")
+	(define software-version (lambda () (*s7* 'version)))
+
+	(define (machine-version)
+	  (if (and (defined? 'file-exists?)
+                   (file-exists? "/proc/cpuinfo"))
+	      (call-with-input-file "/proc/cpuinfo"
+		(lambda (cpufile)
+		  (do ((line (read-line cpufile) (read-line cpufile)))
+		      ((or (eof-object? line)
+			   (string=? (substring line 0 10) "model name"))
+		       (if (string? line)
+			   (string-trim " " (substring line (+ 1 (position #\: line))))
+			   "unknown")))))
+	      "unknown"))
+
+	;; = < <= > >= are the same, also min max + - * / lcm gcd exp expt log sqrt
+	;; sin cos tan acos asin atan pi sinh cosh tanh asinh acosh atanh
+	;; numerator denominator logior logxor logand ash integer-length random
+
+	;; slightly different: floor ceiling truncate round and the ff cases thereof
+	;; abs of complex -> magnitude
+	(define (cl-abs x) (if (not (zero? (imag-part x))) (magnitude x) (abs x)))
+
+	;; these actually return multiple values
+	(define* (cl-floor x (divisor 1)) (floor (/ x divisor)))
+	(define* (cl-ceiling x (divisor 1)) (ceiling (/ x divisor)))
+	(define* (cl-truncate x (divisor 1)) (truncate (/ x divisor)))
+	(define* (cl-round x (divisor 1)) (round (/ x divisor)))
+	(define* (ffloor x divisor) (* 1.0 (cl-floor x divisor)))
+	(define* (fceling x divisor) (* 1.0 (cl-ceiling x divisor)))
+	(define* (ftruncate x divisor) (* 1.0 (cl-truncate x divisor)))
+	(define* (fround x divisor) (* 1.0 (cl-round x divisor)))
+
+	(define (/= . args)
+	  (if (null? (cdr args))
+	      #t
+	      (if (member (car args) (cdr args))
+		  #f
+		  (apply /= (cdr args)))))
+
+	(define (1- x) (- x 1))
+	(define (isqrt x) (floor (sqrt x)))
+	(define phase angle)
+	(define* (cl-complex rl (im 0.0)) (#_complex rl im))
+	(define (signum x) (if (zerop x) x (/ x (abs x))))
+	(define (cis x) (exp (cl-complex 0.0 x)))
+
+
+	;; -------- characters
+
+	(define char-code-limit 256)
+	(define alpha-char-p char-alphabetic?)
+	(define upper-case-p char-upper-case?)
+	(define lower-case-p char-lower-case?)
+	(define* (digit-char-p c (radix 10)) (string->number (string c) radix))
+	(define (alphanumericp c) (or (char-alphabetic? c) (char-numeric? c)))
+
+	(define* (char= . args) (or (< (length args) 2) (apply char=? args)))
+	(define* (char< . args) (or (< (length args) 2) (apply char<? args)))
+	(define* (char<= . args) (or (< (length args) 2) (apply char<=? args)))
+	(define* (char> . args) (or (< (length args) 2) (apply char>? args)))
+	(define* (char>= . args) (or (< (length args) 2) (apply char>=? args)))
+	(define* (char-equal . args) (or (< (length args) 2) (apply char-ci=? args)))
+	(define* (char-lessp . args) (or (< (length args) 2) (apply char-ci<? args)))
+	(define* (char-greaterp . args) (or (< (length args) 2) (apply char-ci>? args)))
+	(define* (char-not-lessp . args) (or (< (length args) 2) (apply char-ci>=? args)))
+	(define* (char-not-greaterp . args) (or (< (length args) 2) (apply char-ci<=? args)))
+
+	(define (char/= . args)
+	  (if (null? (cdr args))
+	      #t
+	      (if (member (car args) (cdr args))
+		  #f
+		  (apply char/= (cdr args)))))
+
+	(define (char-not-equal . args)
+	  (if (null? (cdr args))
+	      #t
+	      (if (or (member (char-upcase (car args)) (cdr args))
+		      (member (char-downcase (car args)) (cdr args)))
+		  #f
+		  (apply char-not-equal (cdr args)))))
+
+	(define char-code char->integer)
+	(define code-char integer->char)
+
+	(define (character c)
+	  (if (char? c)
+	      c
+	      (if (integer? c)
+		  (integer->char c)
+		  (if (string? c)
+		      (c 0)
+		      (if (symbol? c)
+			  ((symbol->string c) 0))))))
+
+	;; char-upcase and char-downcase are ok
+	(define char-int char->integer)
+	(define int-char integer->char)
+
+	(define* (digit-char w (radix 10))
+	  (let ((str (number->string w radix)))
+	    (and str (= (length str) 1) (str 0))))
+
+	(define (both-case-p c) "unimplemented")
+	(define (standard-char-p c) "unimplemented")
+	(define (char-name c) "unimplemented")
+	(define (name-char s) "unimplemented")
+
+	;; --------
+
+	(define terpri newline)
+
+
+	;; -------- types
+
+	(define vectorp vector?)
+	(define simple-vector-p vector?)
+	(define symbolp symbol?)
+	(define (atom obj) (not (pair? obj)))
+	(define consp pair?)
+	(define (listp obj) (or (null? obj) (pair? obj)))
+	(define numberp number?)
+	(define integerp integer?)
+	(define rationalp rational?)
+	(define (floatp l) (and (number? l) (not (rational? l)) (zero? (imag-part l)))) ; clisp
+	(define (complexp l) (and (complex? l) (not (real? l))))
+	(define realp real?)
+	(define characterp char?)
+	(define stringp string?)
+	(define simple-string-p string?)
+	(define arrayp vector?)
+	(define simple-bit-vector-p vector?)
+	(define keywordp keyword?)
+	(define functionp procedure?)
+
+	(define symbol-value symbol->value)
+	(define symbol-function symbol->value)
+	(define fdefinition symbol->value)
+	(define boundp defined?)
+	(define fboundp defined?)
+	(define (funcall fn . arguments) (apply fn arguments))
+	(define-constant call-arguments-limit 65536)
+
+
+	;; --------
+	(define progn begin)
+	(define-macro (prog1 first . body) (let ((result (gensym))) `(let ((,result ,first)) ,@body ,result)))
+	(define-macro (prog2 first second . body) `(prog1 (progn ,first ,second) ,@body))
+
+	(define-macro (the type form) form) ; see function the in stuff.scm
+	(define-macro (defvar var . args) `(define ,var (or ,(and (not (null? args)) (car args)) #f)))
+
+	(define-macro* (incf sym (inc 1))
+	  `(set! ,sym (+ ,sym ,inc)))
+
+	(define-macro* (decf sym (dec 1))
+	  `(set! ,sym (- ,sym ,dec)))
+
+	;; the simple version seems to work ok, but just for lafs:
+	(define incf-b
+	  (let ((arg (gensym))
+		(inc (gensym))
+		(name (gensym)))
+	    (apply define-bacro* `((,name ,arg (,inc 1))
+				   `(set! ,,arg (+ ,,arg ,,inc))))))
+
+	(define-macro (push val sym)
+	  `(setf ,sym (cons ,val ,sym)))
+
+	(define-macro (pop sym)
+	  (let ((v (gensym)))
+	    `(let ((,v (car ,sym)))
+	       (setf ,sym (cdr ,sym))
+	       ,v)))
+
+	(define-macro* (pushnew val sym (test equal?) (key identity))
+	  (let ((g (gensym))
+		(k (if (procedure? key) key identity))) ; can be explicit nil!
+	    `(let ((,g ,val))
+	       (if (null? (cl-member (,k ,g) ,sym ,test ,k))
+		   (push ,g ,sym))
+	       ,sym)))
+
+	(define-macro (declare . args) #f)
+	(define-macro (set a b) `(set! ,(symbol->value a) ,b))
+
+	(define-expansion (setf . pairs)
+	  (if (not (even? (length pairs)))
+	      (error 'syntax-error "setf has odd number of args"))
+	  `(let () ,@(let ((var #f))
+		       (map (lambda (p)
+			      (if var
+				  (let ((val (if (pair? var)
+						 (if (member (car var) '(aref svref elt char schar))
+						     (list 'set! (cdr var) p)
+						     (if (eq? (car var) 'car)
+							 (list 'set-car! (cadr var) p)
+							 (if (eq? (car var) 'cdr)
+							     (list 'set-cdr! (cadr var) p)
+							     (if (eq? (car var) 'nth)
+								 (list 'set! (list (caddr var) (cadr var)) p)
+								 (list 'set! var p)
+								 ))))
+						 (list 'set! var p))))
+				    (set! var #f)
+				    val)
+				  (begin
+				    (set! var p)
+				    ())))
+			    pairs))))
+
+	(define-expansion (setq . pairs)
+	  (if (not (even? (length pairs)))
+	      (error 'syntax-error "setq has odd number of args"))
+	  `(let () ,@(let ((var #f))
+		       (map (lambda (p)
+			      (if var
+				  (let ((val (list 'set! var p)))
+				    (set! var #f)
+				    val)
+				  (begin
+				    (set! var p)
+				    ())))
+			    pairs))))
+
+	(define-macro (psetq . pairs)
+	  (let ((vals ())
+		(vars ()))
+	    (do ((var-val pairs (cddr var-val)))
+		((null? var-val))
+	      (let ((interval (gensym)))
+		(set! vals (cons (list interval (cadr var-val)) vals))
+		(set! vars (cons (list 'set! (car var-val) interval) vars))))
+	    `(let ,(reverse vals)
+	       ,@vars)))
+
+	(define (mapcar func . lists)
+	  ;; not scheme's map because lists can be different lengths
+	  ;; and args can be any sequence type (all mixed together)
+	  (define (mapcar-seqs func seqs)
+	    (if (null? seqs)
+		()
+		(cons (func (car seqs))
+		      (mapcar-seqs func (cdr seqs)))))
+
+	  (define (mapcar-1 index lens func seqs)
+	    (if (member index lens)
+		()
+		(cons (apply func (mapcar-seqs (lambda (obj) (obj index)) seqs))
+		      (mapcar-1 (+ index 1) lens func seqs))))
+
+	  (let ((lens (map length lists)))
+	    (mapcar-1 0 lens func lists)))
+
+	;; (define (mapcar func . lists)
+	;; not scheme's map because lists can be different lengths
+	;; (if (member () lists) () (cons (apply func (map car lists)) (apply mapcar func (map cdr lists)))))
+
+	(define (maplist function . lists)
+	  (if (member () lists)
+	      ()
+	      (cons (apply function lists)
+		    (apply maplist function (map cdr lists)))))
+
+	(define (mapc function . lists)
+	  (define (mapc-1 function . lists)
+	    (if (not (member () lists))
+		(begin
+		  (apply function (map car lists))
+		  (apply mapc-1 function (map cdr lists)))))
+	  (apply mapc-1 function lists)
+	  (car lists))
+
+	(define (mapl function . lists)
+	  (define (mapl-1 function . lists)
+	    (if (not (member () lists))
+		(begin
+		  (apply function lists)
+		  (apply mapl-1 function (map cdr lists)))))
+	  (apply mapl-1 function lists)
+	  (car lists))
+
+	(define (mapcon function . lists)
+	  (apply nconc (apply maplist function lists)))
+
+	(define (mapcan function . lists)
+	  (apply nconc (apply mapcar function lists)))
+
+	(define* (map-into result-sequence function . sequences)
+	  (if (or (null? result-sequence)
+		  (null? sequences))
+	      result-sequence
+	      (let* ((vals (apply mapcar function sequences))
+		     (len (min (length vals) (length result-sequence))))
+		(do ((i 0 (+ i 1)))
+		    ((= i len))
+		  (set! (result-sequence i) (vals i)))
+		result-sequence)))
+
+
+	(define input-stream-p input-port?)
+	(define output-stream-p output-port?)
+
+
+	;; -------- vectors
+
+	;; vector is ok
+
+	(define svref vector-ref)
+	(define aref vector-ref)
+        (define array-dimensions vector-dimensions)
+	(define array-total-size vector-length)
+        (define (array-dimension array num) (list-ref (vector-dimensions array) num))
+
+	(define-constant array-dimension-limit 16777215)
+	(define-constant array-rank-limit 4096)
+	(define-constant array-total-size-limit 16777215)
+
+	(define* (make-array dimensions element-type initial-element initial-contents adjustable fill-pointer displaced-to displaced-index-offset)
+	  (if (eq? element-type 'character)
+	      (or (and initial-contents
+		       (string-copy initial-contents))
+		  (cl-make-string dimensions initial-element))
+	      (make-vector (or dimensions 1) initial-element)))
+
+	(define (array-in-bounds-p array . subscripts)
+	  (define (in-bounds dims subs)
+	    (or (null? subs)
+		(null? dims)
+		(and (< (car subs) (car dims))
+		     (in-bounds (cdr dims) (cdr subs)))))
+	  (in-bounds (vector-dimensions array) subscripts))
+
+	(define (row-major-index array . subscripts)
+	  (apply + (maplist (lambda (x y)
+			      (* (car x) (apply * (cdr y))))
+			    subscripts
+			    (vector-dimensions array))))
+
+
+	;; -------- lists
+
+	;; in CL (cdr ()) is nil
+
+	(define (first l) (if (not (null? l)) (list-ref l 0) ()))
+	(define (second l) (if (> (length l) 1) (list-ref l 1) ()))
+	(define (third l) (if (> (length l) 2) (list-ref l 2) ()))
+	(define (fourth l) (if (> (length l) 3) (list-ref l 3) ()))
+	(define (fifth l) (if (> (length l) 4) (list-ref l 4) ()))
+	(define (sixth l) (if (> (length l) 5) (list-ref l 5) ()))
+	(define (seventh l) (if (> (length l) 6) (list-ref l 6) ()))
+	(define (eighth l) (if (> (length l) 7) (list-ref l 7) ()))
+	(define (ninth l) (if (> (length l) 8) (list-ref l 8) ()))
+	(define (tenth l) (if (> (length l) 9) (list-ref l 9) ()))
+	(define (nth n l) (if (< n (length l)) (list-ref l n) ()))
+	(define (endp val) (if (null? val) #t (if (pair? val) #f (error 'wrong-type-arg "bad arg to endp"))))
+	(define rest cdr)
+	(define list-length length)
+	(define* (cl-make-list size (initial-element ())) (make-list size initial-element))
+
+	(define (copy-list lis)
+	  (if (not (pair? lis))
+	      lis
+	      (cons (car lis) (copy-list (cdr lis)))))
+
+	(define (rplaca x y) (set-car! x y) x)
+	(define (rplacd x y) (set-cdr! x y) x)
+
+	(define (copy-tree lis)
+	  (if (pair? lis)
+	      (copy lis :readable)
+	      lis))
+
+	(define* (butlast lis (n 1))
+	  (let ((len (length lis)))
+	    (if (<= len n)
+		()
+		(let ((result ()))
+		  (do ((i 0 (+ i 1))
+		       (lst lis (cdr lst)))
+		      ((= i (- len n)) (reverse result))
+		    (set! result (cons (car lst) result)))))))
+
+	(define* (last lst (n 1))
+	  (let ((len (length lst)))
+	    (do ((i 0 (+ i 1))
+		 (l lst (cdr l)))
+		((or (null? l)
+		     (>= i (- len n)))
+		 l))))
+
+	(define (nthcdr n lst)
+	  (do ((i n (- i 1))
+	       (result lst (cdr result)))
+	      ((or (null? result) (zero? i)) result)))
+
+	(define* (tree-equal a b (test eql))
+	  (define (teq a b)
+	    (if (not (pair? a))
+		(and (not (pair? b))
+		     (test a b))
+		(and (pair? b)
+		     (teq (car a) (car b))
+		     (teq (cdr a) (cdr b)))))
+	  (teq a b))
+
+	(define (acons key datum alist) (cons (cons key datum) alist))
+
+	(define (list* obj1 . objs)
+	  (define (list-1 obj)
+	    (if (null? (cdr obj))
+		(car obj)
+		(cons (car obj) (list-1 (cdr obj)))))
+	  (if (null? objs)
+	      obj1
+	      (cons obj1 (list-1 objs))))
+
+	(define* (assoc-if predicate alist (key car))
+	  (if (null? alist)
+	      ()
+	      (if (and (not (null? (car alist)))
+		       (predicate (key (car alist))))
+		  (car alist)
+		  (assoc-if predicate (cdr alist) key))))
+
+	(define* (assoc-if-not predicate alist (key car))
+	  (assoc-if (lambda (obj) (not (predicate obj))) alist key))
+
+	(define* (cl-assoc item alist (test eql) (key car))
+	  (assoc-if (lambda (obj) (test item obj)) alist key))
+
+	(define* (rassoc-if predicate alist (key cdr))
+	  (if (null? alist)
+	      ()
+	      (if (and (pair? (car alist))
+		       (predicate (key (car alist))))
+		  (car alist)
+		  (rassoc-if predicate (cdr alist) key))))
+
+	(define* (rassoc-if-not predicate alist (key cdr))
+	  (rassoc-if (lambda (obj) (not (predicate obj))) alist key))
+
+	(define* (rassoc item alist (test eql) (key cdr))
+	  (rassoc-if (lambda (obj) (test item obj)) alist key))
+
+	(define (copy-alist alist)
+	  (if (null? alist)
+	      ()
+	      (cons (if (pair? (car alist))
+			(cons (caar alist) (cdar alist))
+			(car alist))
+		    (copy-alist (cdr alist)))))
+
+	(define (revappend x y) (append (reverse x) y))
+
+
+	(define* (pairlis keys data alist)
+	  (if (not (= (length keys) (length data)))
+	      (error 'syntax-error "pairlis keys and data lists should have the same length"))
+	  (let ((lst (or alist ())))
+	    (if (null? keys)
+		lst
+		(do ((key keys (cdr key))
+		     (datum data (cdr datum)))
+		    ((null? key) lst)
+		  (set! lst (cons (cons (car key) (car datum)) lst))))))
+
+	(define* (sublis alist tree (test eql) (key car))
+	  (let ((val (cl-assoc tree alist test key)))
+	    (if (not (null? val))
+		(cdr val)
+		(if (not (pair? tree))
+		    tree
+		    (cons (sublis alist (car tree) test key)
+			  (sublis alist (cdr tree) test key))))))
+
+	(define* (nsublis alist tree (test eql) (key car)) ; sacla
+	  (define (sub subtree)
+	    (let ((ac (cl-assoc subtree alist test key)))
+	      (if (not (null? ac))
+		  (cdr ac)
+		  (if (not (pair? subtree))
+		      subtree
+		      (let ()
+			(set-car! subtree (sub (car subtree)))
+			(set-cdr! subtree (sub (cdr subtree)))
+			subtree)))))
+	  (sub tree))
+
+	(let ()
+	  (define* (subst-if new test tree (key identity))
+	    (if (test (key tree))
+		new
+		(if (not (pair? tree))
+		    tree
+		    (cons (subst-if new test (car tree) key)
+			  (subst-if new test (cdr tree) key)))))
+
+	  (define* (subst-if-not new test tree (key identity))
+	    (subst-if new (lambda (obj) (not (test obj))) tree key))
+
+	  (define* (subst new old tree (test eql) (key identity))
+	    (subst-if new (lambda (obj) (test old obj)) tree key))
+
+	  (define* (nsubst-if new predicate tree (key identity)) ; sacla
+	    (define (sub subtree)
+	      (if (predicate (key subtree))
+		  new
+		  (if (not (pair? subtree))
+		      subtree
+		      (let ()
+			(set-car! subtree (sub (car subtree)))
+			(set-cdr! subtree (sub (cdr subtree)))
+			subtree))))
+	    (sub tree))
+
+	  (define* (nsubst-if-not new predicate tree (key identity))
+	    (nsubst-if new (lambda (obj) (not (predicate obj))) tree key))
+
+	  (define* (nsubst new old tree (test eql) (key identity))
+	    (nsubst-if new (lambda (obj) (test old obj)) tree key))
+
+	  (test-t (let ((tree '(old (old) ((old))))) (equal (subst 'new 'old tree) '(new (new) ((new))))))
+	  (test-t (eq (subst 'new 'old 'old) 'new))
+	  (test-t (eq (subst 'new 'old 'not-old) 'not-old))
+	  (test-t (equal (subst 'new '(b) '(a ((b))) :test equal) '(a (new))))
+	  (test-t (equal (subst 'x 3 '(1 (1 2) (1 2 3) (1 2 3 4)) :key (lambda (y) (and (listp y) (third y)))) '(1 (1 2) x x)))
+	  (test-t (equal (subst 'x "D" '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d"))
+				:test equalp
+				:key (lambda (y) (and (listp y) (fourth y))))
+			 '("a" ("a" "b") ("a" "b" "c") x)))
+	  (test-t (equal (subst-if 'new (lambda (x) (eq x 'old)) '(old old)) '(new new)))
+	  (test-t (eq (subst-if 'new (lambda (x) (eq x 'old)) 'old) 'new))
+	  (test-t (equal (subst-if 'x (lambda (x) (eql x 3)) '(1 (1 2) (1 2 3) (1 2 3 4)) :key (lambda (y) (and (listp y) (third y)))) '(1 (1 2) x x)))
+	  (test-t (let ((tree '(old (old) ((old))))) (equal (subst-if 'new (lambda (x) (eq x 'old)) tree) '(new (new) ((new))))))
+	  (test-t (eq (subst-if 'new (lambda (x) (eq x 'old)) 'old) 'new))
+	  (test-t (eq (subst-if 'new (lambda (x) (eq x 'old)) 'not-old) 'not-old))
+	  (test-t (equal (subst-if 'new (lambda (x) (equal x '(b))) '(a ((b)))) '(a (new))))
+	  (test-t (equal (subst-if 'x (lambda (x) (eql x 3)) '(1 (1 2) (1 2 3) (1 2 3 4)) :key (lambda (y) (and (listp y) (third y)))) '(1 (1 2) x x)))
+	  (test-t (equal (subst-if 'x
+				   (lambda (x) (equalp x "D"))
+				   '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d"))
+				   :key (lambda (y) (and (listp y) (fourth y))))
+			 '("a" ("a" "b") ("a" "b" "c") x)))
+	  (test-t (equal (subst-if-not 'new (lambda (x) (not (eq x 'old))) '(old old)) '(new new)))
+	  (test-t (eq (subst-if-not 'new (lambda (x) (not (eq x 'old))) 'old) 'new))
+	  (test-t (equal (subst-if-not 'x (lambda (x) (not (eql x 3)))
+				       '(1 (1 2) (1 2 3) (1 2 3 4))
+				       :key (lambda (y) (and (listp y) (third y))))
+			 '(1 (1 2) x x)))
+	  (test-t (let ((tree '(old (old) ((old)))))
+		    (equal (subst-if-not 'new (lambda (x) (not (eq x 'old))) tree)
+			   '(new (new) ((new))))))
+	  (test-t (eq (subst-if-not 'new (lambda (x) (not (eq x 'old))) 'old) 'new))
+	  (test-t (eq (subst-if-not 'new (lambda (x) (not (eq x 'old))) 'not-old) 'not-old))
+	  (test-t (equal (subst-if-not 'new (lambda (x) (not (equal x '(b)))) '(a ((b)))) '(a (new))))
+	  (test-t (equal (subst-if-not 'x
+				       (lambda (x) (not (eql x 3)))
+				       '(1 (1 2) (1 2 3) (1 2 3 4))
+				       :key (lambda (y) (and (listp y) (third y))))
+			 '(1 (1 2) x x)))
+	  (test-t (equal (subst-if-not 'x
+				       (lambda (x) (not (equalp x "D")))
+				       '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d"))
+				       :key (lambda (y) (and (listp y) (fourth y))))
+			 '("a" ("a" "b") ("a" "b" "c") x)))
+	  (test-t (let ((tree '(old (old) ((old)))))
+		    (equal (nsubst 'new 'old (copy-tree tree))
+			   '(new (new) ((new))))))
+	  (test-t (let* ((tree (copy-tree '(old (old) ((old)))))
+			 (new-tree (nsubst 'new 'old tree)))
+		    (and (eq tree new-tree)
+			 (equal tree '(new (new) ((new)))))))
+	  (test-t (eq (nsubst 'new 'old 'old) 'new))
+	  (test-t (eq (nsubst 'new 'old 'not-old) 'not-old))
+	  (test-t (equal (nsubst 'new '(b) (copy-tree '(a ((b)))) :test equal) '(a (new))))
+	  (test-t (equal (nsubst 'x 3 (copy-tree '(1 (1 2) (1 2 3) (1 2 3 4)))
+				 :key (lambda (y) (and (listp y) (third y))))
+			 '(1 (1 2) x x)))
+	  (test-t (equal (nsubst 'x "D"
+				 (copy-tree '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d")))
+				 :test equalp
+				 :key (lambda (y) (and (listp y) (fourth y))))
+			 '("a" ("a" "b") ("a" "b" "c") x)))
+	  (test-t (equal (nsubst-if 'new (lambda (x) (eq x 'old)) (list 'old 'old)) '(new new)))
+	  (test-t (eq (nsubst-if 'new (lambda (x) (eq x 'old)) 'old) 'new))
+	  (test-t (let* ((x (copy-tree '(old (old) ((old)) (old) old)))
+			 (y (nsubst-if 'new (lambda (x) (eq x 'old)) x)))
+		    (and (eq x y)
+			 (equal x '(new (new) ((new)) (new) new)))))
+	  (test-t (equal (nsubst-if 'x
+				    (lambda (x) (eql x 3))
+				    (copy-tree '(1 (1 2) (1 2 3) (1 2 3 4)))
+				    :key (lambda (y) (and (listp y) (third y))))
+			 '(1 (1 2) x x)))
+	  (test-t (let ((tree '(old (old) ((old)))))
+		    (equal (nsubst-if 'new (lambda (x) (eq x 'old)) (copy-tree tree))
+			   '(new (new) ((new))))))
+	  (test-t (eq (nsubst-if 'new (lambda (x) (eq x 'old)) 'old) 'new))
+	  (test-t (eq (nsubst-if 'new (lambda (x) (eq x 'old)) 'not-old) 'not-old))
+	  (test-t (equal (nsubst-if 'new (lambda (x) (equal x '(b))) (copy-tree '(a ((b))))) '(a (new))))
+	  (test-t (equal (nsubst-if 'x
+				    (lambda (x) (eql x 3))
+				    (copy-tree '(1 (1 2) (1 2 3) (1 2 3 4)))
+				    :key (lambda (y) (and (listp y) (third y))))
+			 '(1 (1 2) x x)))
+	  (test-t (equal (nsubst-if 'x
+				    (lambda (x) (equalp x "D"))
+				    (copy-tree '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d")))
+				    :key (lambda (y) (and (listp y) (fourth y))))
+			 '("a" ("a" "b") ("a" "b" "c") x)))
+	  (test-t (equal (nsubst-if-not 'new (lambda (x) (not (eq x 'old)))
+					(list 'old 'old))
+			 '(new new)))
+	  (test-t (eq (nsubst-if-not 'new (lambda (x) (not (eq x 'old))) 'old) 'new))
+	  (test-t (let* ((x (copy-tree '(old (old) ((old)) (old) old)))
+			 (y (nsubst-if-not 'new (lambda (x) (not (eq x 'old))) x)))
+		    (and (eq x y)
+			 (equal x '(new (new) ((new)) (new) new)))))
+	  (test-t (equal (nsubst-if-not 'x (lambda (x) (not (eql x 3)))
+					(copy-tree '(1 (1 2) (1 2 3) (1 2 3 4)))
+					:key (lambda (y) (and (listp y) (third y))))
+			 '(1 (1 2) x x)))
+	  (test-t (let ((tree '(old (old) ((old)))))
+		    (equal (nsubst-if-not 'new (lambda (x) (not (eq x 'old))) (copy-tree tree))
+			   '(new (new) ((new))))))
+	  (test-t (eq (nsubst-if-not 'new (lambda (x) (not (eq x 'old))) 'old) 'new))
+	  (test-t (eq (nsubst-if-not 'new (lambda (x) (not (eq x 'old))) 'not-old) 'not-old))
+	  (test-t (equal (nsubst-if-not 'new (lambda (x) (not (equal x '(b)))) (copy-tree '(a ((b))))) '(a (new))))
+	  (test-t (equal (nsubst-if-not 'x
+					(lambda (x) (not (eql x 3)))
+					(copy-tree '(1 (1 2) (1 2 3) (1 2 3 4)))
+					:key (lambda (y) (and (listp y) (third y))))
+			 '(1 (1 2) x x)))
+	  (test-t (equal
+		   (nsubst-if-not 'x
+				  (lambda (x) (not (equalp x "D")))
+				  (copy-tree '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d")))
+				  :key (lambda (y) (and (listp y) (fourth y))))
+		   '("a" ("a" "b") ("a" "b" "c") x)))
+	  )
+
+	(define (ldiff lst object) ; sacla
+	  (if (not (eqv? lst object))
+	      (let* ((result (list (car lst)))
+		     (splice result))
+		(call-with-exit
+		 (lambda (return)
+		   (do ((l (cdr lst) (cdr l)))
+		       ((not (pair? l))
+			(if (eql l object)
+			    (set-cdr! splice ()))
+			result)
+		     (if (eqv? l object)
+			 (return result)
+			 (set! splice (cdr (rplacd splice (list (car l))))))))))
+	      ()))
+
+	(define* (member-if predicate list (key identity))
+	  (if (null? list)
+	      ()
+	      (if (predicate (key (car list)))
+		  list
+		  (member-if predicate (cdr list) key))))
+
+	(define* (member-if-not predicate list (key identity))
+	  (member-if (lambda (obj) (not (predicate obj))) list key))
+
+	(define* (cl-member item list (test eql) (key identity))
+	  (if (null? list)
+	      ()
+	      (if (test item (key (car list)))
+		  list
+		  (cl-member item (cdr list) test key))))
+
+	(define* (adjoin item list (test eql) (key identity))
+	  (if (not (null? (cl-member (key item) list test key)))
+	      list
+	      (cons item list)))
+
+	(define (tailp sublist list)
+	  (or (eq? sublist list)
+	      (and (not (null? list))
+		   (tailp sublist (cdr list)))))
+
+
+	(define* (nbutlast list (n 1)) ; sacla
+	  (if (null? list)
+	      ()
+	      (let ((length (do ((p (cdr list) (cdr p))
+				 (i 1 (+ i 1)))
+				((not (pair? p)) i))))
+		(if (> length n)
+		    (do ((1st (cdr list) (cdr 1st))
+			 (2nd list 1st)
+			 (count (- length n 1) (- count 1)))
+			((zero? count)
+			 (set-cdr! 2nd ())
+			 list))
+		    ()))))
+
+	(define (nconc . lists) ; sacla sort of
+	  (let ((ls (let ()
+		      (define (strip-nulls lst)
+			(if (null? lst)
+			    ()
+			    (if (null? (car lst))
+				(strip-nulls (cdr lst))
+				lst)))
+		      (strip-nulls lists))))
+	    (if (null? ls)
+		()
+	      (let* ((top (car ls))
+		     (splice top))
+		(do ((here (cdr ls) (cdr here)))
+		    ((null? here) top)
+		  (set-cdr! (last splice) (car here))
+		  (if (not (null? (car here)))
+		      (set! splice (car here))))))))
+
+	(define (nreconc x y) (nconc (nreverse x) y))
+
+
+
+
+	;; -------- sequences
+
+        (define-macro (with-iterator it . body)
+          `(let ((,(car it) (let ((f (make-iterator ,(cadr it)))
+				  (+iterator+ #t))
+                              (lambda ()
+                                (let ((val (f)))
+                                  (and val (values #t (car val) (cdr val))))))))
+             ,@body))
+        (define hash-table-p hash-table?)
+        (define* (gethash k h (d ())) (or (hash-table-ref k h) d))
+        (define maphash map)
+        (define clrhash fill!)
+        (define hash-table-count hash-table-entries)
+
+	(let ()
+	  (define* (count-if predicate sequence from-end (start 0) end (key identity))
+	    (let* ((counts 0)
+		   (len (length sequence))
+		   (nd (or (and (number? end) end) len))) ; up to but not including end
+	      (if (< nd start)
+		  (error 'out-of-range "count-if :start ~A is greater than ~A ~A" start (if end ":end" "length") nd))
+	      (if (not from-end)
+		  (do ((i start (+ i 1)))
+		      ((= i nd))
+		    (if (predicate (key (sequence i)))
+			(set! counts (+ counts 1))))
+		  (do ((i (- nd 1) (- i 1)))
+		      ((< i start))
+		    (if (predicate (key (sequence i)))
+			(set! counts (+ counts 1)))))
+	      counts))
+
+	  (define* (count-if-not predicate sequence from-end (start 0) end (key identity))
+	    (count-if (lambda (obj) (not (predicate obj))) sequence from-end start end key))
+
+	  (define* (count item sequence from-end (test eql) (start 0) end (key identity))
+	    (count-if (lambda (arg) (test item arg)) sequence from-end start end key))
+
+	  (test-t (eql (count-if-not oddp '((1) (2) (3) (4)) :key car) 2))
+	  (test-t (eql (count-if upper-case-p "The Crying of Lot 49" :start 4) 2))
+					;(test-t (eql (count #\a (concatenate 'list "how many A's are there in here?")) 2))
+	  (test-t (eql (count-if alpha-char-p "-a-b-c-0-1-2-3-4-") 3))
+	  (test-t (eql (count-if alphanumericp "-a-b-c-0-1-2-3-4-") 8))
+	  (test-t (eql (count nil (list t nil t nil t nil)) 3))
+	  (test-t (eql (count nil (vector t nil t nil t nil)) 3))
+	  (test-t (zerop (count 9 '(0 1 2 3 4))))
+	  (test-t (zerop (count 'a '(0 1 2 3 4))))
+	  (test-t (eql (count 0 '(0 0 0 0 0) :start 1) 4))
+	  (test-t (eql (count 0 '(0 0 0 0 0) :start 1 :end nil) 4))
+	  (test-t (eql (count 0 '(0 0 0 0 0) :start 2) 3))
+	  (test-t (zerop (count 0 '(0 0 0 0) :start 0 :end 0)))
+	  (test-t (zerop (count 0 '(0 0 0 0) :start 2 :end 2)))
+	  (test-t (zerop (count 0 '(0 0 0 0) :start 4 :end 4)))
+	  (test-t (eql (count 0 '(0 0 0 0) :start 2 :end 3) 1))
+	  (test-t (eql (count #\a "abcABC" :test equalp) 2))
+	  (test-t (eql (count #\a "abcABC" :test char-equal) 2))
+	  (test-t (eql (count '(a) '((x) (y) (z) (a) (b) (c)) :test equalp) 1))
+	  (test-t (eql (count 'a '((x) (y) (z) (a) (b) (c)) :key car :test eq) 1))
+	  (test-t (eql (count nil '((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr :test eq) 3))
+	  (test-t (let ((lst nil))
+		    (and (eql (count 'a '(a b c d)
+				     :test (lambda (a b) (setq lst (cons b lst)) (eq a b)))
+			      1)
+			 (equal lst '(d c b a)))))
+	  (test-t (let ((lst nil))
+		    (and (eql (count 'a '(a b c d)
+				     :test (lambda (a b) (setq lst (cons b lst)) (eq a b))
+				     :from-end t)
+			      1)
+			 (equal lst '(a b c d)))))
+	  (test-t (zerop (count 9 #(0 1 2 3 4))))
+	  (test-t (zerop (count 'a #(0 1 2 3 4))))
+	  (test-t (eql (count 0 #(0 0 0 0 0) :start 1) 4))
+	  (test-t (eql (count 0 #(0 0 0 0 0) :start 1 :end nil) 4))
+	  (test-t (eql (count 0 #(0 0 0 0 0) :start 2) 3))
+	  (test-t (zerop (count 0 #(0 0 0 0) :start 0 :end 0)))
+	  (test-t (zerop (count 0 #(0 0 0 0) :start 2 :end 2)))
+	  (test-t (zerop (count 0 #(0 0 0 0) :start 4 :end 4)))
+	  (test-t (eql (count 0 #(0 0 0 0) :start 2 :end 3) 1))
+	  (test-t (eql (count '(a) #((x) (y) (z) (a) (b) (c)) :test equalp) 1))
+	  (test-t (eql (count 'a #((x) (y) (z) (a) (b) (c)) :key car :test eq) 1))
+	  (test-t (eql (count nil #((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr :test eq) 3))
+	  (test-t (let ((list nil))
+		    (and (eql (count 'a #(a b c d)
+				     :test (lambda (a b) (setq list (cons b list)) (eq a b)))
+			      1)
+			 (equal list '(d c b a)))))
+	  (test-t (let ((list nil))
+		    (and (eql (count 'a #(a b c d)
+				     :test (lambda (a b) (setq list (cons b list)) (eq a b))
+				     :from-end t)
+			      1)
+			 (equal list '(a b c d)))))
+	  (test-t (eql (count-if null (list t nil t nil t nil)) 3))
+	  (test-t (zerop (count-if (lambda (x) (eql x 9)) #(0 1 2 3 4))))
+	  (test-t (zerop (count-if (lambda (a) (eq 'x a)) #(0 1 2 3 4))))
+	  (test-t (eql (count-if zerop '(0 0 0 0 0) :start 1) 4))
+	  (test-t (eql (count-if zerop '(0 0 0 0 0) :start 1 :end nil) 4))
+	  (test-t (eql (count-if zerop '(0 0 0 0 0) :start 2) 3))
+	  (test-t (zerop (count-if zerop '(0 0 0 0) :start 0 :end 0)))
+	  (test-t (zerop (count-if zerop '(0 0 0 0) :start 2 :end 2)))
+	  (test-t (zerop (count-if zerop '(0 0 0 0) :start 4 :end 4)))
+	  (test-t (eql (count-if zerop '(0 0 0 0) :start 2 :end 3) 1))
+	  (test-t (eql (count-if (lambda (x) (equalp #\a x)) "abcABC") 2))
+	  (test-t (eql (count-if (lambda (x) (char-equal #\a x)) "abcABC") 2))
+	  (test-t (eql (count-if (lambda (x) (equal x '(a))) '((x) (y) (z) (a) (b) (c))) 1))
+	  (test-t (eql (count-if (lambda (x) (eq x 'a)) '((x) (y) (z) (a) (b) (c)) :key car) 1))
+	  (test-t (eql (count-if null '((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
+	  (test-t (eql (count-if (lambda (x) (equal x '(a))) '((x) (y) (z) (a) (b) (c))) 1))
+	  (test-t (eql (count-if (lambda (x) (eq x 'a)) '((x) (y) (z) (a) (b) (c)) :key car) 1))
+	  (test-t (eql (count-if null '((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
+	  (test-t (let ((list nil))
+		    (and (eql (count-if (lambda (x) (setq list (cons x list)) (eq x 'a))
+					'(a b c d))
+			      1)
+			 (equal list '(d c b a)))))
+	  (test-t (let ((list nil))
+		    (and (eql (count-if (lambda (x) (setq list (cons x list)) (eq x 'a))
+					'(a b c d)
+					:from-end t)
+			      1)
+			 (equal list '(a b c d)))))
+	  (test-t (eql (count-if null (vector t nil t nil t nil)) 3))
+	  (test-t (eql (count-if zerop #(0 0 0 0 0) :start 1) 4))
+	  (test-t (eql (count-if zerop #(0 0 0 0 0) :start 1 :end nil) 4))
+	  (test-t (eql (count-if zerop #(0 0 0 0 0) :start 2) 3))
+	  (test-t (zerop (count-if zerop #(0 0 0 0) :start 0 :end 0)))
+	  (test-t (zerop (count-if zerop #(0 0 0 0) :start 2 :end 2)))
+	  (test-t (zerop (count-if zerop #(0 0 0 0) :start 4 :end 4)))
+	  (test-t (eql (count-if zerop #(0 0 0 0) :start 2 :end 3) 1))
+	  (test-t (eql (count-if (lambda (x) (equal x '(a))) #((x) (y) (z) (a) (b) (c))) 1))
+	  (test-t (eql (count-if (lambda (x) (eq x 'a)) #((x) (y) (z) (a) (b) (c)) :key car) 1))
+	  (test-t (eql (count-if null #((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
+	  (test-t (eql (count-if (lambda (x) (equal x '(a))) #((x) (y) (z) (a) (b) (c))) 1))
+	  (test-t (eql (count-if (lambda (x) (eq x 'a)) #((x) (y) (z) (a) (b) (c)) :key car) 1))
+	  (test-t (eql (count-if null #((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
+	  (test-t (let ((list nil))
+		    (and (eql (count-if (lambda (x) (setq list (cons x list)) (eq x 'a))
+					#(a b c d))
+			      1)
+			 (equal list '(d c b a)))))
+	  (test-t (let ((list nil))
+		    (and (eql (count-if (lambda (x) (setq list (cons x list)) (eq x 'a))
+					#(a b c d)
+					:from-end t)
+			      1)
+			 (equal list '(a b c d)))))
+	  (test-t (eql (count-if-not (complement null) (list t nil t nil t nil)) 3))
+	  (test-t (zerop (count-if-not (lambda (x) (not (eql x 9))) #(0 1 2 3 4))))
+	  (test-t (zerop (count-if-not (lambda (a) (not (eq 'x a))) #(0 1 2 3 4))))
+	  (test-t (eql (count-if-not (complement zerop) '(0 0 0 0 0) :start 1) 4))
+	  (test-t (eql (count-if-not (complement zerop) '(0 0 0 0 0) :start 1 :end nil) 4))
+	  (test-t (eql (count-if-not (complement zerop) '(0 0 0 0 0) :start 2) 3))
+	  (test-t (zerop (count-if-not (complement zerop) '(0 0 0 0) :start 0 :end 0)))
+	  (test-t (zerop (count-if-not (complement zerop) '(0 0 0 0) :start 2 :end 2)))
+	  (test-t (zerop (count-if-not (complement zerop) '(0 0 0 0) :start 4 :end 4)))
+	  (test-t (eql (count-if-not (complement zerop) '(0 0 0 0) :start 2 :end 3) 1))
+	  (test-t (eql (count-if-not (lambda (x) (not (equalp #\a x))) "abcABC") 2))
+	  (test-t (eql (count-if-not (lambda (x) (not (char-equal #\a x))) "abcABC") 2))
+	  (test-t (eql (count-if-not (lambda (x) (not (equal x '(a)))) '((x) (y) (z) (a) (b) (c))) 1))
+	  (test-t (eql (count-if-not (lambda (x) (not (eq x 'a))) '((x) (y) (z) (a) (b) (c)) :key car) 1))
+	  (test-t (eql (count-if-not (complement null) '((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
+	  (test-t (eql (count-if-not (lambda (x) (not (equal x '(a)))) '((x) (y) (z) (a) (b) (c))) 1))
+	  (test-t (eql (count-if-not (lambda (x) (not (eq x 'a))) '((x) (y) (z) (a) (b) (c)) :key car) 1))
+	  (test-t (eql (count-if-not (complement null) '((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
+	  (test-t (let ((list nil))
+		    (and (eql (count-if-not (lambda (x)
+					      (setq list (cons x list))
+					      (not (eq x 'a)))
+					    '(a b c d))
+			      1)
+			 (equal list '(d c b a)))))
+	  (test-t (let ((list nil))
+		    (and (eql (count-if-not (lambda (x)
+					      (setq list (cons x list))
+					      (not (eq x 'a)))
+					    '(a b c d)
+					    :from-end t)
+			      1)
+			 (equal list '(a b c d)))))
+	  (test-t (eql (count-if-not (complement null) (vector t nil t nil t nil)) 3))
+	  (test-t (eql (count-if-not (complement zerop) #(0 0 0 0 0) :start 1) 4))
+	  (test-t (eql (count-if-not (complement zerop) #(0 0 0 0 0) :start 1 :end nil) 4))
+	  (test-t (eql (count-if-not (complement zerop) #(0 0 0 0 0) :start 2) 3))
+	  (test-t (zerop (count-if-not (complement zerop) #(0 0 0 0) :start 0 :end 0)))
+	  (test-t (zerop (count-if-not (complement zerop) #(0 0 0 0) :start 2 :end 2)))
+	  (test-t (zerop (count-if-not (complement zerop) #(0 0 0 0) :start 4 :end 4)))
+	  (test-t (eql (count-if-not (complement zerop) #(0 0 0 0) :start 2 :end 3) 1))
+	  (test-t (eql (count-if-not (lambda (x) (not (equal x '(a)))) #((x) (y) (z) (a) (b) (c))) 1))
+	  (test-t (eql (count-if-not (lambda (x) (not (eq x 'a))) #((x) (y) (z) (a) (b) (c)) :key car) 1))
+	  (test-t (eql (count-if-not (complement null) #((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
+	  (test-t (eql (count-if-not (lambda (x) (not (equal x '(a)))) #((x) (y) (z) (a) (b) (c))) 1))
+	  (test-t (eql (count-if-not (lambda (x) (not (eq x 'a))) #((x) (y) (z) (a) (b) (c)) :key car) 1))
+	  (test-t (eql (count-if-not (complement null) #((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
+	  (test-t (let ((list nil))
+		    (and (eql (count-if-not (lambda (x)
+					      (setq list (cons x list))
+					      (not (eq x 'a)))
+					    #(a b c d))
+			      1)
+			 (equal list '(d c b a)))))
+	  (test-t (let ((list nil))
+		    (and (eql (count-if-not (lambda (x)
+					      (setq list (cons x list))
+					      (not (eq x 'a)))
+					    #(a b c d)
+					    :from-end t)
+			      1)
+			 (equal list '(a b c d)))))
+	  (test (count-if zero? '(0 1 2 0)) 2)
+	  (test (count-if-not zero? '(0 1 2 0 3)) 3)
+	  (test (count-if zero? #(0 1 2 0)) 2)
+	  (test (count-if zero? '((0 1) (1 0) (2 3) (0 1)) :key car) 2)
+	  (test (count-if zero? '(0 1 2 0) :from-end #t) 2)
+	  (test (count-if zero? '(0 1 2 0) :start 1) 1)
+	  (test (count-if zero? '(0 1 2 0) :start 1 :end 3) 0)
+	  (test (count-if zero? '(0 1 2 0) :end 3) 1)
+	  (test (count-if zero? '(0 1 2 0) :end 4) 2)
+	  (test (count-if zero? '(0 1 2 0) :end 4 :from-end #t) 2)
+	  (test-t (eql (count #\a "how many A's are there in here?") 2))
+	  )
+
+	(define* (find-if predicate sequence from-end (start 0) end (key identity))
+	  (let* ((len (length sequence))
+		 (nd (or (and (number? end) end) len))) ; up to but not including end
+	    (if (< nd start)
+		(error 'out-of-range "~A :start ~A is greater than ~A ~A" (*function* (curlet)) start (if end ":end" "length") nd))
+	    (call-with-exit
+	     (lambda (return)
+	       (if (not from-end)
+		   (do ((i start (+ i 1)))
+		       ((= i nd) #f)
+		     (if (predicate (key (sequence i)))
+			 (return (sequence i))))
+		   (do ((i (- nd 1) (- i 1)))
+		       ((< i start) #f)
+		     (if (predicate (key (sequence i)))
+			 (return (sequence i)))))))))
+
+	(define* (find item sequence from-end (test eql) (start 0) end (key identity))
+	  (find-if (lambda (arg) (test item arg)) sequence from-end start end key))
+
+	(let ()
+	  (define* (find-if-not predicate sequence from-end (start 0) end (key identity))
+	    (find-if (lambda (obj) (not (predicate obj))) sequence from-end start end key))
+
+	  (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) '(a b c)) 'a))
+	  (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) '(a b c)) 'b))
+	  (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) '(a b c)) 'c))
+	  (test-t (null (find-if-not (lambda (arg) (not (eq arg 'x))) '(a b c))))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'b))) '(a b c) :start 2)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'c))) '(a b c) :start 3)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 0 :end 0)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 0 :end 0 :from-end t)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1 :end 1)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1 :end 1 :from-end t)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 2 :end 2)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 2 :end 2 :from-end t)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 3 :end 3)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 3 :end 3 :from-end t)))
+	  (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end nil) 'a))
+	  (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end nil) 'b))
+	  (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end nil) 'c))
+	  (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end 1) 'a))
+	  (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end 2) 'b))
+	  (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end 3) 'c))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end 0)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end 1)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end 2)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c)))))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c)) :key car) '(a)))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c)) :key car) '(b)))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c)) :key car) '(c)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c)) :key car)))
+	  (test-t (let ((list '((a) (b) (c))))
+		    (and (eq (find-if-not (lambda (x) (not (eq x 'a))) list :key car)
+			     (car list))
+			 (eq (find-if-not (lambda (x) (not (eq x 'b))) list :key car)
+			     (cadr list))
+			 (eq (find-if-not (lambda (x) (not (eq x 'c))) list :key car)
+			     (caddr list))
+			 (null (find-if-not (lambda (x) (not (eq x 'z))) list :key car)))))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c)) :key car) '(a)))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(a a)))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c) (a a) (b b) (c c)) :key car) '(b)))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(b b)))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c) (a a) (b b) (c c)) :key car) '(c)))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(c c)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c) (a a) (b b) (c c)) :key car)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) '(a a a)))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) '(a a a)))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) '(a a)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
+	  (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) #(a b c)) 'a))
+	  (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) #(a b c)) 'b))
+	  (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) #(a b c)) 'c))
+	  (test-t (null (find-if-not (lambda (arg) (not (eq arg 'x))) #(a b c))))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'b))) #(a b c) :start 2)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'c))) #(a b c) :start 3)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 0 :end 0)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 0 :end 0 :from-end t)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1 :end 1)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1 :end 1 :from-end t)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 2 :end 2)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 2 :end 2 :from-end t)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 3 :end 3)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 3 :end 3 :from-end t)))
+	  (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end nil) 'a))
+	  (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end nil) 'b))
+	  (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end nil) 'c))
+	  (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end 1) 'a))
+	  (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end 2) 'b))
+	  (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end 3) 'c))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end 0)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end 1)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end 2)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c)))))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c)) :key car) '(a)))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c)) :key car) '(b)))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c)) :key car) '(c)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c)) :key car)))
+	  (test-t (let ((vect #((a) (b) (c))))
+		    (and (eq (find-if-not (lambda (x) (not (eq x 'a))) vect :key car)
+			     (aref vect 0))
+			 (eq (find-if-not (lambda (x) (not (eq x 'b))) vect :key car)
+			     (aref vect 1))
+			 (eq (find-if-not (lambda (x) (not (eq x 'c))) vect :key car)
+			     (aref vect 2))
+			 (null (find-if-not (lambda (x) (not (eq x 'z))) vect :key car)))))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c)) :key car) '(a)))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(a a)))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c) (a a) (b b) (c c)) :key car) '(b)))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(b b)))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c) (a a) (b b) (c c)) :key car) '(c)))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(c c)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c) (a a) (b b) (c c)) :key car)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) '(a a a)))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) '(a a a)))
+	  (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) '(a a)))
+	  (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
+	  )
+
+	(let ()
+	  (define* (position-if predicate sequence from-end (start 0) end (key identity))
+	    (let* ((len (length sequence))
+		   (nd (or (and (number? end) end) len))) ; up to but not including end
+	      (if (< nd start)
+		  (error 'out-of-range "~A :start ~A is greater than ~A ~A" (*function* (curlet)) start (if end ":end" "length") nd))
+	      (call-with-exit
+	       (lambda (return)
+		 (if (not from-end)
+		     (do ((i start (+ i 1)))
+			 ((= i nd) #f)
+		       (if (predicate (key (sequence i)))
+			   (return i)))
+		     (do ((i (- nd 1) (- i 1)))
+			 ((< i start) #f)
+		       (if (predicate (key (sequence i)))
+			   (return i))))))))
+
+	  (define* (position-if-not predicate sequence from-end (start 0) end (key identity))
+	    (position-if (lambda (obj) (not (predicate obj))) sequence from-end start end key))
+
+	  (define* (position item sequence from-end (test eql) (start 0) end (key identity))
+	    (position-if (lambda (arg) (test item arg)) sequence from-end start end key))
+
+	  (test-t (eql (position #\a "baobab" :from-end t) 4))
+	  (test-t (eql (position-if oddp '((1) (2) (3) (4)) :start 1 :key car) 2))
+	  (test-t (null (position 595 ())))
+	  (test-t (eql (position-if-not integerp '(1 2 3 4 5.0)) 4))
+	  (test-t (eql (position 'a '(a b c)) 0))
+	  (test-t (eql (position 'b '(a b c)) 1))
+	  (test-t (eql (position 'c '(a b c)) 2))
+	  (test-t (null (position 'x '(a b c))))
+	  (test-t (null (position 'a '(a b c) :start 1)))
+	  (test-t (null (position 'b '(a b c) :start 2)))
+	  (test-t (null (position 'c '(a b c) :start 3)))
+	  (test-t (null (position 'a '(a b c) :start 0 :end 0)))
+	  (test-t (null (position 'a '(a b c) :start 0 :end 0 :from-end t)))
+	  (test-t (null (position 'a '(a b c) :start 1 :end 1)))
+	  (test-t (null (position 'a '(a b c) :start 1 :end 1 :from-end t)))
+	  (test-t (null (position 'a '(a b c) :start 2 :end 2)))
+	  (test-t (null (position 'a '(a b c) :start 2 :end 2 :from-end t)))
+	  (test-t (null (position 'a '(a b c) :start 3 :end 3)))
+	  (test-t (null (position 'a '(a b c) :start 3 :end 3 :from-end t)))
+	  (test-t (eql (position 'a '(a b c) :end nil) '0))
+	  (test-t (eql (position 'b '(a b c) :end nil) '1))
+	  (test-t (eql (position 'c '(a b c) :end nil) '2))
+	  (test-t (eql (position 'a '(a b c) :end 1) '0))
+	  (test-t (eql (position 'b '(a b c) :end 2) '1))
+	  (test-t (eql (position 'c '(a b c) :end 3) '2))
+	  (test-t (null (position 'a '(a b c) :end 0)))
+	  (test-t (null (position 'b '(a b c) :end 1)))
+	  (test-t (null (position 'c '(a b c) :end 2)))
+	  (test-t (null (position 'a '((a) (b) (c)))))
+	  (test-t (eql (position 'a '((a) (b) (c)) :key car) 0))
+	  (test-t (eql (position 'b '((a) (b) (c)) :key car) 1))
+	  (test-t (eql (position 'c '((a) (b) (c)) :key car) 2))
+	  (test-t (null (position 'z '((a) (b) (c)) :key car)))
+	  (test-t (null (position '(a) '((a) (b) (c)))))
+	  (test-t (eql (position '(a) '((a) (b) (c)) :test equal) 0))
+	  (test-t (null (position '("a") '(("a") ("b") ("c")))))
+	  (test-t (eql (position 3 '(0 1 2 3 4 5)) 3))
+	  (test-t (eql (position 3 '(0 1 2 3 4 5) :test <) 4))
+	  (test-t (eql (position 3 '(0 1 2 3 4 5) :test >) 0))
+	  (test-t (eql (position 'a '((a) (b) (c) (a a) (b b) (c c)) :key car) 0))
+	  (test-t (eql (position 'a '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3))
+	  (test-t (eql (position 'b '((a) (b) (c) (a a) (b b) (c c)) :key car) 1))
+	  (test-t (eql (position 'b '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4))
+	  (test-t (eql (position 'c '((a) (b) (c) (a a) (b b) (c c)) :key car) 2))
+	  (test-t (eql (position 'c '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5))
+	  (test-t (null (position 'z '((a) (b) (c) (a a) (b b) (c c)) :key car)))
+	  (test-t (null (position 'z '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
+	  (test-t (eql (position 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6))
+	  (test-t (eql (position 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6))
+	  (test-t (eql (position 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3))
+	  (test-t (null (position 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
+	  (test-t (eql (position 'a #(a b c)) 0))
+	  (test-t (eql (position 'b #(a b c)) 1))
+	  (test-t (eql (position 'c #(a b c)) 2))
+	  (test-t (null (position 'x #(a b c))))
+	  (test-t (null (position 'a #(a b c) :start 1)))
+	  (test-t (null (position 'b #(a b c) :start 2)))
+	  (test-t (null (position 'c #(a b c) :start 3)))
+	  (test-t (null (position 'a #(a b c) :start 0 :end 0)))
+	  (test-t (null (position 'a #(a b c) :start 0 :end 0 :from-end t)))
+	  (test-t (null (position 'a #(a b c) :start 1 :end 1)))
+	  (test-t (null (position 'a #(a b c) :start 1 :end 1 :from-end t)))
+	  (test-t (null (position 'a #(a b c) :start 2 :end 2)))
+	  (test-t (null (position 'a #(a b c) :start 2 :end 2 :from-end t)))
+	  (test-t (null (position 'a #(a b c) :start 3 :end 3)))
+	  (test-t (null (position 'a #(a b c) :start 3 :end 3 :from-end t)))
+	  (test-t (eql (position 'a #(a b c) :end nil) 0))
+	  (test-t (eql (position 'b #(a b c) :end nil) 1))
+	  (test-t (eql (position 'c #(a b c) :end nil) 2))
+	  (test-t (eql (position 'a #(a b c) :end 1) 0))
+	  (test-t (eql (position 'b #(a b c) :end 2) 1))
+	  (test-t (eql (position 'c #(a b c) :end 3) 2))
+	  (test-t (null (position 'a #(a b c) :end 0)))
+	  (test-t (null (position 'b #(a b c) :end 1)))
+	  (test-t (null (position 'c #(a b c) :end 2)))
+	  (test-t (null (position 'a #((a) (b) (c)))))
+	  (test-t (eql (position 'a #((a) (b) (c)) :key car) 0))
+	  (test-t (eql (position 'b #((a) (b) (c)) :key car) 1))
+	  (test-t (eql (position 'c #((a) (b) (c)) :key car) 2))
+	  (test-t (null (position 'z #((a) (b) (c)) :key car)))
+	  (test-t (null (position '(a) #((a) (b) (c)))))
+	  (test-t (eql (position '(a) #((a) (b) (c)) :test equal) 0))
+	  (test-t (null (position '("a") #(("a") ("b") ("c")))))
+	  (test-t (eql (position 3 #(0 1 2 3 4 5)) 3))
+	  (test-t (eql (position 3 #(0 1 2 3 4 5) :test <) 4))
+	  (test-t (eql (position 3 #(0 1 2 3 4 5) :test >) 0))
+	  (test-t (eql (position 'a #((a) (b) (c) (a a) (b b) (c c)) :key car) 0))
+	  (test-t (eql (position 'a #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3))
+	  (test-t (eql (position 'b #((a) (b) (c) (a a) (b b) (c c)) :key car) 1))
+	  (test-t (eql (position 'b #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4))
+	  (test-t (eql (position 'c #((a) (b) (c) (a a) (b b) (c c)) :key car) 2))
+	  (test-t (eql (position 'c #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5))
+	  (test-t (null (position 'z #((a) (b) (c) (a a) (b b) (c c)) :key car)))
+	  (test-t (null (position 'z #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
+	  (test-t (eql (position 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6))
+	  (test-t (eql (position 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6))
+	  (test-t (eql (position 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3))
+	  (test-t (null (position 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
+	  (test-t (null (position #\z "abcABC")))
+	  (test-t (eql (position #\a "abcABC") 0))
+	  (test-t (eql (position #\A "abcABC") 3))
+	  (test-t (eql (position #\A "abcABC" :test char-equal) 0))
+	  (test-t (eql (position #\A "abcABC" :test char-equal :from-end t) 3))
+	  (test-t (eql (position #\a "abcABC" :test char-equal :from-end t) 3))
+	  (test-t (eql (position #\a "abcABC" :test char-equal :from-end t :end 4) 3))
+	  (test-t (eql (position #\a "abcABC" :test char-equal :from-end t :end 3) 0))
+	  (test-t (eql (position-if (lambda (x) (eq x 'a)) '(a b c)) 0))
+	  (test-t (eql (position-if (lambda (x) (eq x 'b)) '(a b c)) 1))
+	  (test-t (eql (position-if (lambda (x) (eq x 'c)) '(a b c)) 2))
+	  (test-t (null (position-if (lambda (arg) (eq arg 'x)) '(a b c))))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 1)))
+	  (test-t (null (position-if (lambda (x) (eq x 'b)) '(a b c) :start 2)))
+	  (test-t (null (position-if (lambda (x) (eq x 'c)) '(a b c) :start 3)))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 0 :end 0)))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 0 :end 0 :from-end t)))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 1 :end 1)))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 1 :end 1 :from-end t)))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 2 :end 2)))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 2 :end 2 :from-end t)))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 3 :end 3)))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 3 :end 3 :from-end t)))
+	  (test-t (eql (position-if (lambda (x) (eq x 'a)) '(a b c) :end nil) 0))
+	  (test-t (eql (position-if (lambda (x) (eq x 'b)) '(a b c) :end nil) 1))
+	  (test-t (eql (position-if (lambda (x) (eq x 'c)) '(a b c) :end nil) 2))
+	  (test-t (eql (position-if (lambda (x) (eq x 'a)) '(a b c) :end 1) 0))
+	  (test-t (eql (position-if (lambda (x) (eq x 'b)) '(a b c) :end 2) 1))
+	  (test-t (eql (position-if (lambda (x) (eq x 'c)) '(a b c) :end 3) 2))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :end 0)))
+	  (test-t (null (position-if (lambda (x) (eq x 'b)) '(a b c) :end 1)))
+	  (test-t (null (position-if (lambda (x) (eq x 'c)) '(a b c) :end 2)))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) '((a) (b) (c)))))
+	  (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c)) :key car) 0))
+	  (test-t (eql (position-if (lambda (x) (eq x 'b)) '((a) (b) (c)) :key car) 1))
+	  (test-t (eql (position-if (lambda (x) (eq x 'c)) '((a) (b) (c)) :key car) 2))
+	  (test-t (null (position-if (lambda (x) (eq x 'z)) '((a) (b) (c)) :key car)))
+	  (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c)) :key car) 0))
+	  (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3))
+	  (test-t (eql (position-if (lambda (x) (eq x 'b)) '((a) (b) (c) (a a) (b b) (c c)) :key car) 1))
+	  (test-t (eql (position-if (lambda (x) (eq x 'b)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4))
+	  (test-t (eql (position-if (lambda (x) (eq x 'c)) '((a) (b) (c) (a a) (b b) (c c)) :key car) 2))
+	  (test-t (eql (position-if (lambda (x) (eq x 'c)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5))
+	  (test-t (null (position-if (lambda (x) (eq x 'z)) '((a) (b) (c) (a a) (b b) (c c)) :key car)))
+	  (test-t (null (position-if (lambda (x) (eq x 'z)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
+	  (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6))
+	  (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6))
+	  (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
+	  (test-t (eql (position-if (lambda (x) (eq x 'a)) #(a b c)) 0))
+	  (test-t (eql (position-if (lambda (x) (eq x 'b)) #(a b c)) 1))
+	  (test-t (eql (position-if (lambda (x) (eq x 'c)) #(a b c)) 2))
+	  (test-t (null (position-if (lambda (arg) (eq arg 'x)) #(a b c))))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 1)))
+	  (test-t (null (position-if (lambda (x) (eq x 'b)) #(a b c) :start 2)))
+	  (test-t (null (position-if (lambda (x) (eq x 'c)) #(a b c) :start 3)))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 0 :end 0)))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 0 :end 0 :from-end t)))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 1 :end 1)))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 1 :end 1 :from-end t)))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 2 :end 2)))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 2 :end 2 :from-end t)))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 3 :end 3)))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 3 :end 3 :from-end t)))
+	  (test-t (eql (position-if (lambda (x) (eq x 'a)) #(a b c) :end nil) 0))
+	  (test-t (eql (position-if (lambda (x) (eq x 'b)) #(a b c) :end nil) 1))
+	  (test-t (eql (position-if (lambda (x) (eq x 'c)) #(a b c) :end nil) 2))
+	  (test-t (eql (position-if (lambda (x) (eq x 'a)) #(a b c) :end 1) 0))
+	  (test-t (eql (position-if (lambda (x) (eq x 'b)) #(a b c) :end 2) 1))
+	  (test-t (eql (position-if (lambda (x) (eq x 'c)) #(a b c) :end 3) 2))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :end 0)))
+	  (test-t (null (position-if (lambda (x) (eq x 'b)) #(a b c) :end 1)))
+	  (test-t (null (position-if (lambda (x) (eq x 'c)) #(a b c) :end 2)))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) #((a) (b) (c)))))
+	  (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c)) :key car) 0))
+	  (test-t (eql (position-if (lambda (x) (eq x 'b)) #((a) (b) (c)) :key car) 1))
+	  (test-t (eql (position-if (lambda (x) (eq x 'c)) #((a) (b) (c)) :key car) 2))
+	  (test-t (null (position-if (lambda (x) (eq x 'z)) #((a) (b) (c)) :key car)))
+	  (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c)) :key car) 0))
+	  (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3))
+	  (test-t (eql (position-if (lambda (x) (eq x 'b)) #((a) (b) (c) (a a) (b b) (c c)) :key car) 1))
+	  (test-t (eql (position-if (lambda (x) (eq x 'b)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4))
+	  (test-t (eql (position-if (lambda (x) (eq x 'c)) #((a) (b) (c) (a a) (b b) (c c)) :key car) 2))
+	  (test-t (eql (position-if (lambda (x) (eq x 'c)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5))
+	  (test-t (null (position-if (lambda (x) (eq x 'z)) #((a) (b) (c) (a a) (b b) (c c)) :key car)))
+	  (test-t (null (position-if (lambda (x) (eq x 'z)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
+	  (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6))
+	  (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6))
+	  (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3))
+	  (test-t (null (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '(a b c)) 0))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '(a b c)) 1))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '(a b c)) 2))
+	  (test-t (null (position-if-not (lambda (arg) (not (eq arg 'x))) '(a b c))))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'b))) '(a b c) :start 2)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'c))) '(a b c) :start 3)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 0 :end 0)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 0 :end 0 :from-end t)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1 :end 1)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1 :end 1 :from-end t)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 2 :end 2)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 2 :end 2 :from-end t)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 3 :end 3)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 3 :end 3 :from-end t)))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end nil) 0))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end nil) 1))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end nil) 2))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end 1) 0))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end 2) 1))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end 3) 2))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end 0)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end 1)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end 2)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c)))))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c)) :key car) 0))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c)) :key car) 1))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c)) :key car) 2))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c)) :key car)))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c)) :key car) 0))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c) (a a) (b b) (c c)) :key car) 1))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c) (a a) (b b) (c c)) :key car) 2))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c) (a a) (b b) (c c)) :key car)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #(a b c)) 0))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #(a b c)) 1))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #(a b c)) 2))
+	  (test-t (null (position-if-not (lambda (arg) (not (eq arg 'x))) #(a b c))))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'b))) #(a b c) :start 2)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'c))) #(a b c) :start 3)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 0 :end 0)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 0 :end 0 :from-end t)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1 :end 1)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1 :end 1 :from-end t)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 2 :end 2)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 2 :end 2 :from-end t)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 3 :end 3)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 3 :end 3 :from-end t)))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end nil) 0))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end nil) 1))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end nil) 2))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end 1) 0))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end 2) 1))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end 3) 2))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end 0)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end 1)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end 2)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c)))))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c)) :key car) 0))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c)) :key car) 1))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c)) :key car) 2))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c)) :key car)))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c)) :key car) 0))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c) (a a) (b b) (c c)) :key car) 1))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c) (a a) (b b) (c c)) :key car) 2))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c) (a a) (b b) (c c)) :key car)))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6))
+	  (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3))
+	  (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
+	)
+
+	;; -------- strings
+
+	(define char string-ref)
+	(define schar string-ref)
+	(define* (cl-make-string size (initial-element #\null)) (make-string size initial-element))
+
+	(define (cl-string x)
+	  (if (string? x) x
+	      (if (char? x)
+		  (string x)
+		  (if (symbol? x)
+		      (symbol->string x)
+		      (error 'wrong-type-arg "string ~A?" x)))))
+
+	(define* (string= str-1 str-2 (start1 0) end1 (start2 0) end2)
+	  (let* ((str1 (cl-string str-1))
+		 (str2 (cl-string str-2))
+		 (nd1 (if (number? end1) end1 (length str1)))
+		 (nd2 (if (number? end2) end2 (length str2))))
+	    (if (and (not end1) (not end2) (= start1 0) (= start2 0))
+		(string=? str1 str2)
+		(string=? (subseq str1 start1 nd1)
+			  (subseq str2 start2 nd2)))))
+
+	(define* (string-equal str-1 str-2 (start1 0) end1 (start2 0) end2)
+	  (let* ((str1 (cl-string str-1))
+		 (str2 (cl-string str-2))
+		 (nd1 (if (number? end1) end1 (length str1)))
+		 (nd2 (if (number? end2) end2 (length str2))))
+	    (if (and (not end1) (not end2) (= start1 0) (= start2 0))
+		(string-ci=? str1 str2)
+		(string-ci=? (subseq str1 start1 nd1)
+			     (subseq str2 start2 nd2)))))
+
+	(define (string-prefixes-equal str1 str2 start1 nd1 start2 nd2)
+	  (do ((i start1 (+ i 1))
+	       (j start2 (+ j 1)))
+	      ((or (= i nd1)
+		   (= j nd2)
+		   (not (char=? (str1 i) (str2 j))))
+	       i)))
+
+	(define (string-prefixes-equal-ci str1 str2 start1 nd1 start2 nd2)
+	  (do ((i start1 (+ i 1))
+	       (j start2 (+ j 1)))
+	      ((or (= i nd1)
+		   (= j nd2)
+		   (not (char-ci=? (str1 i) (str2 j))))
+	       i)))
+
+	(define* (string< str-1 str-2 (start1 0) end1 (start2 0) end2)
+	  (let* ((str1 (cl-string str-1))
+		 (str2 (cl-string str-2))
+		 (nd1 (if (number? end1) end1 (length str1)))
+		 (nd2 (if (number? end2) end2 (length str2)))
+		 (val (if (and (not end1) (not end2) (= start1 0) (= start2 0))
+			  (string<? str1 str2)
+			  (string<? (subseq str1 start1 nd1)
+				    (subseq str2 start2 nd2)))))
+	    (and val (string-prefixes-equal str1 str2 start1 nd1 start2 nd2))))
+
+	(define* (string-lessp str-1 str-2 (start1 0) end1 (start2 0) end2)
+	  (let* ((str1 (cl-string str-1))
+		 (str2 (cl-string str-2))
+		 (nd1 (if (number? end1) end1 (length str1)))
+		 (nd2 (if (number? end2) end2 (length str2)))
+		 (val (if (and (not end1) (not end2) (= start1 0) (= start2 0))
+			  (string-ci<? str1 str2)
+			  (string-ci<? (subseq str1 start1 nd1)
+				       (subseq str2 start2 nd2)))))
+	    (and val (string-prefixes-equal-ci str1 str2 start1 nd1 start2 nd2))))
+
+	(define* (string<= str-1 str-2 (start1 0) end1 (start2 0) end2)
+	  (let* ((str1 (cl-string str-1))
+		 (str2 (cl-string str-2))
+		 (nd1 (if (number? end1) end1 (length str1)))
+		 (nd2 (if (number? end2) end2 (length str2)))
+		 (val (if (and (not end1) (not end2) (= start1 0) (= start2 0))
+			  (string<=? str1 str2)
+			  (string<=? (subseq str1 start1 nd1)
+				     (subseq str2 start2 nd2)))))
+	    (and val (string-prefixes-equal str1 str2 start1 nd1 start2 nd2))))
+
+	(define* (string-not-greaterp str-1 str-2 (start1 0) end1 (start2 0) end2)
+	  (let* ((str1 (cl-string str-1))
+		 (str2 (cl-string str-2))
+		 (nd1 (if (number? end1) end1 (length str1)))
+		 (nd2 (if (number? end2) end2 (length str2)))
+		 (val (if (and (not end1) (not end2) (= start1 0) (= start2 0))
+			  (string-ci<=? str1 str2)
+			  (string-ci<=? (subseq str1 start1 nd1)
+					(subseq str2 start2 nd2)))))
+	    (and val (string-prefixes-equal-ci str1 str2 start1 nd1 start2 nd2))))
+
+	(define* (string> str-1 str-2 (start1 0) end1 (start2 0) end2)
+	  (let* ((str1 (cl-string str-1))
+		 (str2 (cl-string str-2))
+		 (nd1 (if (number? end1) end1 (length str1)))
+		 (nd2 (if (number? end2) end2 (length str2)))
+		 (val (if (and (not end1) (not end2) (= start1 0) (= start2 0))
+			  (string>? str1 str2)
+			  (string>? (subseq str1 start1 nd1)
+				    (subseq str2 start2 nd2)))))
+	    (and val (string-prefixes-equal str1 str2 start1 nd1 start2 nd2))))
+
+	(define* (string-greaterp str-1 str-2 (start1 0) end1 (start2 0) end2)
+	  (let* ((str1 (cl-string str-1))
+		 (str2 (cl-string str-2))
+		 (nd1 (if (number? end1) end1 (length str1)))
+		 (nd2 (if (number? end2) end2 (length str2)))
+		 (val (if (and (not end1) (not end2) (= start1 0) (= start2 0))
+			  (string-ci>? str1 str2)
+			  (string-ci>? (subseq str1 start1 nd1)
+				       (subseq str2 start2 nd2)))))
+	    (and val (string-prefixes-equal-ci str1 str2 start1 nd1 start2 nd2))))
+
+	(define* (string>= str-1 str-2 (start1 0) end1 (start2 0) end2)
+	  (let* ((str1 (cl-string str-1))
+		 (str2 (cl-string str-2))
+		 (nd1 (if (number? end1) end1 (length str1)))
+		 (nd2 (if (number? end2) end2 (length str2)))
+		 (val (if (and (not end1) (not end2) (= start1 0) (= start2 0))
+			  (string>=? str1 str2)
+			  (string>=? (subseq str1 start1 nd1)
+				     (subseq str2 start2 nd2)))))
+	    (and val (string-prefixes-equal str1 str2 start1 nd1 start2 nd2))))
+
+	(define* (string-not-lessp str-1 str-2 (start1 0) end1 (start2 0) end2)
+	  (let* ((str1 (cl-string str-1))
+		 (str2 (cl-string str-2))
+		 (nd1 (if (number? end1) end1 (length str1)))
+		 (nd2 (if (number? end2) end2 (length str2)))
+		 (val (if (and (not end1) (not end2) (= start1 0) (= start2 0))
+			  (string-ci>=? str1 str2)
+			  (string-ci>=? (subseq str1 start1 nd1)
+					(subseq str2 start2 nd2)))))
+	    (and val (string-prefixes-equal-ci str1 str2 start1 nd1 start2 nd2))))
+
+	(define* (string/= str-1 str-2 (start1 0) end1 (start2 0) end2)
+	  (let* ((str1 (cl-string str-1))
+		 (str2 (cl-string str-2))
+		 (nd1 (if (number? end1) end1 (length str1)))
+		 (nd2 (if (number? end2) end2 (length str2)))
+		 (val (if (and (not end1) (not end2) (= start1 0) (= start2 0))
+			  (not (string=? str1 str2))
+			  (not (string=? (subseq str1 start1 nd1)
+					 (subseq str2 start2 nd2))))))
+	    (and val (string-prefixes-equal str1 str2 start1 nd1 start2 nd2))))
+
+	(define* (string-not-equal str-1 str-2 (start1 0) end1 (start2 0) end2)
+	  (let* ((str1 (cl-string str-1))
+		 (str2 (cl-string str-2))
+		 (nd1 (if (number? end1) end1 (length str1)))
+		 (nd2 (if (number? end2) end2 (length str2)))
+		 (val (if (and (not end1) (not end2) (= start1 0) (= start2 0))
+			  (not (string-ci=? str1 str2))
+			  (not (string-ci=? (subseq str1 start1 nd1)
+					    (subseq str2 start2 nd2))))))
+	    (and val (string-prefixes-equal-ci str1 str2 start1 nd1 start2 nd2))))
+
+	(define (string-left-trim bag str-1)
+	  (let ((str (cl-string str-1)))
+	    (if (string? bag) (set! bag (string->list bag)))
+	    (let ((len (length str)))
+	      (do ((i 0 (+ i 1)))
+		  ((or (= i len)
+		       (not (member (str i) bag)))
+		   (if (= i 0)
+		       str
+		       (subseq str i)))))))
+
+	(define (string-right-trim bag str-1)
+	  (let ((str (cl-string str-1)))
+	    (if (string? bag) (set! bag (string->list bag)))
+	    (let ((len (length str)))
+	      (do ((i (- len 1) (- i 1)))
+		  ((or (< i 0)
+		       (not (member (str i) bag)))
+		   (if (= i (- len 1))
+		       str
+		       (subseq str 0 (+ i 1))))))))
+
+	(define (string-trim bag str)
+	  (string-right-trim bag (string-left-trim bag str)))
+
+	(define* (nstring-upcase str (start 0) end)
+	  (let ((nd (if (number? end) end (length str))))
+	    (do ((i start (+ i 1)))
+		((= i nd) str)
+	      (set! (str i) (char-upcase (str i))))))
+
+	(define* (cl-string-upcase str-1 (start 0) end)
+	  (let ((str (cl-string str-1)))
+	    (nstring-upcase (copy str) start end)))
+
+	(define* (nstring-downcase str (start 0) end)
+	  (let ((nd (if (number? end) end (length str))))
+	    (do ((i start (+ i 1)))
+		((= i nd) str)
+	      (set! (str i) (char-downcase (str i))))))
+
+	(define* (cl-string-downcase str-1 (start 0) end)
+	  (let ((str (cl-string str-1)))
+	    (nstring-downcase (copy str) start end)))
+
+	(define* (nstring-capitalize str-1 (start 0) end)
+	  (define (alpha? c)
+	    (or (char-alphabetic? c)
+		(char-numeric? c)))
+	  (let ((str (cl-string str-1)))
+	    (let ((nd (if (number? end) end (length str))))
+	      (do ((i start (+ i 1)))
+		  ((= i nd) str)
+		(if (alpha? (str i))
+		    (if (or (= i 0)
+			    (not (alpha? (str (- i 1)))))
+			(set! (str i) (char-upcase (str i)))
+			(set! (str i) (char-downcase (str i)))))))))
+
+	(define* (string-capitalize str-1 (start 0) end)
+	  (let ((str (cl-string str-1)))
+	    (nstring-capitalize (copy str) start end)))
+
+	(let ()
+	  (define* (union list1 list2 (test eql) (key identity))
+	    (let ((new-list (copy list1)))
+	      (do ((obj list2 (cdr obj)))
+		  ((null? obj) new-list)
+		(set! new-list (adjoin (car obj) new-list test key)))))
+
+	  (define nunion union) ; this is not required to be destructive
+
+	  (define* (intersection list1 list2 (test eql) (key identity))
+	    (let ((new-list ()))
+	      (do ((obj list1 (cdr obj)))
+		  ((null? obj) new-list)
+		(if (not (null? (cl-member (key (car obj)) list2 test key)))
+		    (set! new-list (adjoin (car obj) new-list test key))))))
+
+	  (define nintersection intersection)
+
+	  (define* (set-difference list1 list2 (test eql) (key identity))
+	    (let ((new-list ()))
+	      (do ((obj list1 (cdr obj)))
+		  ((null? obj) new-list)
+		(if (null? (cl-member (key (car obj)) list2 test key))
+		    (set! new-list (adjoin (car obj) new-list test key))))))
+
+	  (define nset-difference set-difference)
+
+	  (define* (set-exclusive-or list1 list2 (test eql) (key identity))
+	    (let ((new-list ()))
+	      (do ((obj list1 (cdr obj)))
+		  ((null? obj))
+		(if (null? (cl-member (key (car obj)) list2 test key))
+		    (set! new-list (adjoin (car obj) new-list test key))))
+	      (do ((obj list2 (cdr obj)))
+		  ((null? obj) new-list)
+		(if (null? (cl-member (key (car obj)) list1 test key))
+		    (set! new-list (adjoin (car obj) new-list test key))))))
+
+	  (define nset-exclusive-or set-exclusive-or)
+
+	  (define* (subsetp list1 list2 (test eql) (key identity))
+	    (call-with-exit
+	     (lambda (return)
+	       (do ((obj list1 (cdr obj)))
+		   ((null? obj) #t)
+		 (if (null? (cl-member (key (car obj)) list2 test key))
+		     (return nil))))))
+
+	  (test-t (subsetp '(1 2 3) '(1 2 3)))
+	  (test-t (subsetp '(1 2 3) '(3 2 1)))
+	  (test-t (subsetp '(1 2 3) '(2 1 3)))
+	  (test-t (null (subsetp '(1 2 3 4) '(2 1 3))))
+	  (test-t (subsetp '(1) '(2 1 3)))
+	  (test-t (subsetp '(1 2) '(1 2 3 4 5 6 7 8)))
+	  (test-t (subsetp '(1 2 3 4 5) '(8 7 6 5 4 3 2 1)))
+	  (test-t (null (subsetp '("car" "ship" "airplane" "submarine") '("car" "ship" "horse" "airplane" "submarine" "camel"))))
+	  (test-t (subsetp '("car" "ship" "airplane" "submarine")
+			   '("car" "ship" "horse" "airplane" "submarine" "camel")
+			   :test equal))
+	  (test-t (subsetp '("CAR" "SHIP" "AIRPLANE" "SUBMARINE")
+			   '("car" "ship" "horse" "airplane" "submarine" "camel")
+			   :test equalp))
+	  (test-t (subsetp '(("car") ("ship") ("airplane") ("submarine"))
+			   '(("car") ("ship") ("horse") ("airplane") ("submarine") ("camel"))
+			   :test string=
+			   :key car))
+
+	  (test-t (null (union () ())))
+	  (test-t (null (nunion () ())))
+	  (test-t (null (set-difference (union '(1 2 3) '(2 3 4)) '(1 2 3 4))))
+	  (test-t (null (set-difference (nunion (list 1 2 3) (list 2 3 4)) '(1 2 3 4))))
+	  (test-t (null (set-difference (union '(1 2 3) '(1 2 3)) '(1 2 3))))
+	  (test-t (null (set-difference (nunion (list 1 2 3) (list 1 2 3)) '(1 2 3))))
+	  (test-t (null (set-difference (union '(1) '(3 2 1)) '(1 2 3))))
+	  (test-t (null (set-difference (nunion (list 1) (list 3 2 1)) '(1 2 3))))
+	  (test-t (null (set-difference (union '(1 2 3) ()) '(1 2 3))))
+	  (test-t (null (set-difference (nunion (list 1 2 3) ()) '(1 2 3))))
+	  (test-t (null (set-difference (union () '(1 2 3)) '(1 2 3))))
+	  (test-t (null (set-difference (nunion () (list 1 2 3)) '(1 2 3))))
+	  (test-t (null (set-difference (union '(1 2 3) '(2)) '(1 2 3))))
+	  (test-t (null (set-difference (nunion (list 1 2 3) (list 2)) '(1 2 3))))
+
+	  (let ((list1 (list 1 1 2 3 4 'a 'b 'c "A" "B" "C" "d"))
+		(list2 (list 1 4 5 'b 'c 'd "a" "B" "c" "D")))
+	    (test-t (null (set-exclusive-or (intersection list1 list2) '(c b 4 1 1))))
+	    (test-t (null (set-exclusive-or (intersection list1 list2 :test equal)
+					    '("B" c b 4 1 1)
+					    :test equal)))
+	    (test-t (null (set-exclusive-or (intersection list1 list2 :test equalp)
+					    '("d" "C" "B" "A" c b 4 1 1)
+					    :test equalp))))
+	  (test-t (null (intersection '(0 1 2) ())))
+	  (test-t (null (intersection () ())))
+	  (test-t (null (intersection () '(0 1 2))))
+	  (test-t (equal (intersection '(0) '(0)) '(0)))
+	  (test-t (equal (intersection '(0 1 2 3) '(2)) '(2)))
+	  (test-t (cl-member 0 (intersection '(0 0 0 0 0) '(0 1 2 3 4 5))))
+	  (test-t (null (set-exclusive-or (intersection '(0 1 2 3 4) '(4 3 2 1 0)) '(4 3 2 1 0))))
+	  (test-t (null (set-exclusive-or (intersection '(0 1 2 3 4) '(0 1 2 3 4)) '(0 1 2 3 4))))
+	  (test-t (null (set-exclusive-or (intersection '(0 1 2 3 4) '(4 3 2 1 0)) '(0 1 2 3 4))))
+	  (test-t (let ((list1 (list "A" "B" "C" "d" "e" "F" "G" "h"))
+			(list2 (list "a" "B" "c" "D" "E" "F" "g" "h")))
+		    (null (set-exclusive-or (intersection list1 list2
+							  :test char=
+							  :key (lambda (x) (char x 0)))
+					    '("B" "F" "h")
+					    :test char=
+					    :key (lambda (x) (char x 0))))))
+	  (test-t (let ((list1 (list "A" "B" "C" "d" "e" "F" "G" "h"))
+			(list2 (list "a" "B" "c" "D" "E" "F" "g" "h")))
+		    (null (set-exclusive-or (intersection list1 list2
+							  :test char-equal
+							  :key (lambda (x) (char x 0)))
+					    '("A" "B" "C" "d" "e" "F" "G" "h")
+					    :test char-equal
+					    :key (lambda (x) (char x 0))))))
+	  (test-t (let ((list1 (list "A" "B" "C" "d"))
+			(list2 (list "D" "E" "F" "g" "h")))
+		    (null (set-exclusive-or (intersection list1 list2
+							  :test char-equal
+							  :key (lambda (x) (char x 0)))
+					    '("d")
+					    :test char-equal
+					    :key (lambda (x) (char x 0))))))
+	  (let ((list1 (list 1 1 2 3 4 'a 'b 'c "A" "B" "C" "d"))
+		(list2 (list 1 4 5 'b 'c 'd "a" "B" "c" "D")))
+	    (test-t (null (set-exclusive-or (nintersection (copy-list list1) list2) '(c b 4 1 1))))
+	    (test-t (null (set-exclusive-or (nintersection (copy-list list1) list2 :test equal)
+					    '("B" c b 4 1 1)
+					    :test equal)))
+	    (test-t (null (set-exclusive-or (nintersection (copy-list list1) list2 :test equalp)
+					    '("d" "C" "B" "A" c b 4 1 1)
+					    :test equalp))))
+	  (test-t (null (nintersection (list 0 1 2) ())))
+	  (test-t (null (nintersection () ())))
+	  (test-t (null (nintersection () '(0 1 2))))
+	  (test-t (equal (nintersection (list 0) '(0)) '(0)))
+	  (test-t (equal (nintersection (list 0 1 2 3) '(2)) '(2)))
+	  (test-t (cl-member 0 (nintersection (list 0 0 0 0 0) '(0 1 2 3 4 5))))
+	  (test-t (null (set-exclusive-or (nintersection (list 0 1 2 3 4) '(4 3 2 1 0)) '(4 3 2 1 0))))
+	  (test-t (null (set-exclusive-or (nintersection (list 0 1 2 3 4) '(0 1 2 3 4)) '(0 1 2 3 4))))
+	  (test-t (null (set-exclusive-or (nintersection (list 0 1 2 3 4) '(4 3 2 1 0)) '(0 1 2 3 4))))
+	  (test-t (let ((list1 (list "A" "B" "C" "d" "e" "F" "G" "h"))
+			(list2 (list "a" "B" "c" "D" "E" "F" "g" "h")))
+		    (null (set-exclusive-or (nintersection list1 list2
+							   :test char=
+							   :key (lambda (x) (char x 0)))
+					    '("B" "F" "h")
+					    :test char=
+					    :key (lambda (x) (char x 0))))))
+	  (test-t (let ((list1 (list "A" "B" "C" "d" "e" "F" "G" "h"))
+			(list2 (list "a" "B" "c" "D" "E" "F" "g" "h")))
+		    (null (set-exclusive-or (nintersection list1 list2
+							   :test char-equal
+							   :key (lambda (x) (char x 0)))
+					    '("A" "B" "C" "d" "e" "F" "G" "h")
+					    :test char-equal
+					    :key (lambda (x) (char x 0))))))
+	  (test-t (let ((list1 (list "A" "B" "C" "d"))
+			(list2 (list "D" "E" "F" "g" "h")))
+		    (null (set-exclusive-or (nintersection list1 list2
+							   :test char-equal
+							   :key (lambda (x) (char x 0)))
+					    '("d")
+					    :test char-equal
+					    :key (lambda (x) (char x 0))))))
+
+
+	  (test-t (null (set-difference (set-difference '(1 2 3 4 5 6 7 8 9)
+							'(2 4 6 8))
+					'(1 3 5 7 9))))
+	  (test-t (null (nset-difference (set-difference (list 1 2 3 4 5 6 7 8 9)
+							 '(2 4 6 8))
+					 '(1 3 5 7 9))))
+	  (test-t (null (set-difference () ())))
+	  (test-t (null (set-difference () () :test equal :key 'identity)))
+	  (test-t (null (nset-difference () ())))
+	  (test-t (null (set-difference () '(1 2 3))))
+	  (test-t (null (set-difference () '(1 2 3) :test equal :key 'identity)))
+	  (test-t (null (nset-difference () '(1 2 3))))
+	  (test-t (null (set-difference '(1 2 3 4) '(4 3 2 1))))
+	  (test-t (null (nset-difference (list 1 2 3 4) '(4 3 2 1))))
+	  (test-t (null (set-difference '(1 2 3 4) '(2 4 3 1))))
+	  (test-t (null (nset-difference (list 1 2 3 4) '(2 4 3 1))))
+	  (test-t (null (set-difference '(1 2 3 4) '(1 3 4 2))))
+	  (test-t (null (nset-difference (list 1 2 3 4) '(1 3 4 2))))
+	  (test-t (null (set-difference '(1 2 3 4) '(1 3 2 4))))
+	  (test-t (null (nset-difference (list 1 2 3 4) '(1 3 2 4))))
+	  (test-t (eq (set-difference (set-difference '(1 2 3) ()) '(1 2 3)) ()))
+	  (test-t (eq (nset-difference (nset-difference (list 1 2 3) ()) '(1 2 3)) ()))
+	  (test-t (eq (set-difference (set-difference '(1 2 3) '(1)) '(2 3)) ()))
+	  (test-t (eq (nset-difference (nset-difference (list 1 2 3) '(1)) '(2 3)) ()))
+	  (test-t (eq (set-difference (set-difference '(1 2 3) '(1 2)) '(3)) ()))
+	  (test-t (eq (nset-difference (nset-difference (list 1 2 3) '(1 2)) '(3)) ()))
+	  (test-t (null (set-exclusive-or (set-exclusive-or '(1 2 3) '(2 3 4)) '(1 4))))
+	  (test-t (null (nset-exclusive-or (nset-exclusive-or (list 1 2 3) '(2 3 4)) '(1 4))))
+	  (test-t (null (set-exclusive-or (set-exclusive-or '(1 2 3) '(1 3)) '(2))))
+	  (test-t (null (nset-exclusive-or (nset-exclusive-or (list 1 2 3) '(1 3)) '(2))))
+	  (test-t (null (set-exclusive-or () ())))
+	  (test-t (null (nset-exclusive-or () ())))
+	  (test-t (null (set-exclusive-or '(1 2 3) '(3 2 1))))
+	  (test-t (null (nset-exclusive-or (list 1 2 3) '(3 2 1))))
+	  (test-t (null (set-exclusive-or '(1 2 3) '(2 3 1))))
+	  (test-t (null (nset-exclusive-or (list 1 2 3) '(2 3 1))))
+	  (test-t (null (set-exclusive-or '(1 2 3) '(1 3 2))))
+	  (test-t (null (nset-exclusive-or (list 1 2 3) '(1 3 2))))
+	  (test-t (null (set-exclusive-or (set-exclusive-or '(1 2 3) ()) '(3 2 1))))
+	  (test-t (null (nset-exclusive-or (nset-exclusive-or (list 1 2 3) ()) '(3 2 1))))
+	  (test-t (null (set-exclusive-or (set-exclusive-or () '(1 2 3)) '(2 1 3))))
+	  (test-t (null (nset-exclusive-or (nset-exclusive-or () '(1 2 3)) '(2 1 3))))
+	  (test-t (null (set-exclusive-or '("car" "ship" "airplane" "submarine")
+					  '("car" "ship" "airplane" "submarine")
+					  :test equal)))
+	  (test-t (null (nset-exclusive-or (copy-list '("car" "ship" "airplane" "submarine"))
+					   '("car" "ship" "airplane" "submarine")
+					   :test equal)))
+	  (test-t (null (set-exclusive-or '("car" "ship" "airplane" "submarine")
+					  '("CAR" "SHIP" "AIRPLANE" "SUBMARINE")
+					  :test equalp)))
+	  (test-t (null (nset-exclusive-or (copy-list '("car" "ship" "airplane" "submarine"))
+					   '("CAR" "SHIP" "AIRPLANE" "SUBMARINE")
+					   :test equalp)))
+	  (test-t (null (set-exclusive-or '(("car") ("ship") ("airplane") ("submarine"))
+					  '(("car") ("ship") ("airplane") ("submarine"))
+					  :test string=
+					  :key car)))
+	  (test-t (null (nset-exclusive-or (copy-tree
+					    '(("car") ("ship") ("airplane") ("submarine")))
+					   '(("car") ("ship") ("airplane") ("submarine"))
+					   :test string=
+					   :key car)))
+	  )
+
+	(let ()
+	  (define* (nsubstitute-if new-item test sequence from-end (start 0) end count (key identity))
+	    (if (and (number? count)
+		     (not (positive? count)))
+		sequence
+		(let* ((len (length sequence))
+		       (nd (or (and (number? end) end) len))) ; up to but not including end
+		  (if (< nd start)
+		      (error 'out-of-range "~A :start ~A is greater than ~A ~A" (*function* (curlet)) start (if end ":end" "length") nd))
+		  (let ((cur-count 0))
+		    (if (not (number? count))
+			(set! count len))
+		    (if (not from-end)
+			(do ((i start (+ i 1)))
+			    ((or (= cur-count count)
+				 (= i nd))
+			     sequence)
+			  (if (test (key (sequence i)))
+			      (begin
+				(set! cur-count (+ cur-count 1))
+				(set! (sequence i) new-item))))
+			(do ((i (- nd 1) (- i 1)))
+			    ((or (= cur-count count)
+				 (< i start))
+			     sequence)
+			  (if (test (key (sequence i)))
+			      (begin
+				(set! cur-count (+ cur-count 1))
+				(set! (sequence i) new-item)))))))))
+
+	  (define* (nsubstitute-if-not new-item test sequence from-end (start 0) end count (key identity))
+	    (nsubstitute-if new-item (lambda (obj) (not (test obj))) sequence from-end start end count key))
+
+	  (define* (nsubstitute new-item old-item sequence from-end (test eql) (start 0) end count (key identity))
+	    (nsubstitute-if new-item (lambda (arg) (test old-item arg)) sequence from-end start end count key))
+
+	  (define* (substitute-if new-item test sequence from-end (start 0) end count (key identity))
+	    (nsubstitute-if new-item test (copy sequence) from-end start end count key))
+
+	  (define* (substitute-if-not new-item test sequence from-end (start 0) end count (key identity))
+	    (substitute-if new-item (lambda (obj) (not (test obj))) (copy sequence) from-end start end count key))
+
+	  (define* (substitute new-item old-item sequence from-end (test eql) (start 0) end count (key identity))
+	    (nsubstitute new-item old-item (copy sequence) from-end test start end count key))
+
+
+	  (test-t (equal (substitute #\. #\space "0 2 4 6") "0.2.4.6"))
+	  (test-t (equal (substitute 9 4 '(1 2 4 1 3 4 5)) '(1 2 9 1 3 9 5)))
+	  (test-t (equal (substitute 9 4 '(1 2 4 1 3 4 5) :count 1) '(1 2 9 1 3 4 5)))
+	  (test-t (equal (substitute 9 4 '(1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 9 5)))
+	  (test-t (equal (substitute 9 3 '(1 2 4 1 3 4 5) :test >) '(9 9 4 9 3 4 5)))
+	  (test-t (equal (substitute-if 0 evenp '((1) (2) (3) (4)) :start 2 :key car) '((1) (2) (3) 0)))
+	  (test-t (equal (substitute-if 9 oddp '(1 2 4 1 3 4 5)) '(9 2 4 9 9 4 9)))
+	  (test-t (equal (substitute-if 9 evenp '(1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 9 5)))
+
+	  (test-t (let ((some-things (list 'a 'car 'b 'cdr 'c)))
+		    (and (equal (nsubstitute-if "function was here" fboundp some-things
+						:count 1 :from-end t)
+				'(a car b "function was here" c))
+			 (equal some-things '(a car b "function was here" c)))))
+	  (test-t (let ((alpha-tester (copy "ab "))) (and (equal (nsubstitute-if-not #\z alpha-char-p alpha-tester) "abz") (equal alpha-tester "abz"))))
+	  (test-t (equal (substitute 'a 'x '(x y z)) '(a y z)))
+	  (test-t (equal (substitute 'b 'y '(x y z)) '(x b z)))
+	  (test-t (equal (substitute 'c 'z '(x y z)) '(x y c)))
+	  (test-t (equal (substitute 'a 'p '(x y z)) '(x y z)))
+	  (test-t (equal (substitute 'a 'x ()) ()))
+	  (test-t (equal (substitute #\x #\b '(#\a #\b #\c #\d #\e) :test char<) '(#\a #\b #\x #\x #\x)))
+	  (test-t (equal (substitute '(a) 'x '((x) (y) (z)) :key car) '((a) (y) (z))))
+	  (test-t (equal (substitute 'c 'b '(a b a b a b a b)) '(a c a c a c a c)))
+	  (test-t (equal (substitute 'a 'b '(b b b)) '(a a a)))
+	  (define axbx-etc '(a x b x c x d x e x f))
+	  (test-t (equal (substitute 'z 'x axbx-etc) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute 'z 'x axbx-etc :count nil) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute 'z 'x axbx-etc :count 0) axbx-etc))
+	  (test-t (equal (substitute 'z 'x axbx-etc :count -100) axbx-etc))
+	  (test-t (equal (substitute 'z 'x axbx-etc :count 1) '(a z b x c x d x e x f)))
+	  (test-t (equal (substitute 'z 'x axbx-etc :count 2) '(a z b z c x d x e x f)))
+	  (test-t (equal (substitute 'z 'x axbx-etc :count 3) '(a z b z c z d x e x f)))
+	  (test-t (equal (substitute 'z 'x axbx-etc :count 4) '(a z b z c z d z e x f)))
+	  (test-t (equal (substitute 'z 'x axbx-etc :count 5) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute 'z 'x axbx-etc :count 6) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute 'z 'x axbx-etc :count 7) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute 'z 'x axbx-etc :count nil :from-end t) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute 'z 'x axbx-etc :count 0 :from-end t) axbx-etc))
+	  (test-t (equal (substitute 'z 'x axbx-etc :count -100 :from-end t) axbx-etc))
+	  (test-t (equal (substitute 'z 'x axbx-etc :count 1 :from-end t) '(a x b x c x d x e z f)))
+	  (test-t (equal (substitute 'z 'x axbx-etc :count 2 :from-end t) '(a x b x c x d z e z f)))
+	  (test-t (equal (substitute 'z 'x axbx-etc :count 3 :from-end t) '(a x b x c z d z e z f)))
+	  (test-t (equal (substitute 'z 'x axbx-etc :count 4 :from-end t) '(a x b z c z d z e z f)))
+	  (test-t (equal (substitute 'z 'x axbx-etc :count 5 :from-end t) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute 'z 'x axbx-etc :count 6 :from-end t) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute 'z 'x axbx-etc :count 7 :from-end t) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute 'z 'x axbx-etc :start 2 :count 1) '(a x b z c x d x e x f)))
+	  (test-t (equal (substitute 'z 'x axbx-etc :start 2 :end nil :count 1) '(a x b z c x d x e x f)))
+	  (test-t (equal (substitute 'z 'x axbx-etc :start 2 :end 6 :count 100) '(a x b z c z d x e x f)))
+	  (test-t (equal (substitute 'z 'x axbx-etc :start 2 :end 11 :count 100) '(a x b z c z d z e z f)))
+	  (test-t (equal (substitute 'z 'x axbx-etc :start 2 :end 8 :count 10) '(a x b z c z d z e x f)))
+	  (test-t (equal (substitute 'z 'x axbx-etc :start 2 :end 8 :count 2 :from-end t) '(a x b x c z d z e x f)))
+	  (test-t (equal (substitute #\z #\c '(#\a #\b #\c #\d #\e #\f) :test char<) '(#\a #\b #\c #\z #\z #\z)))
+	  (test-t (equal (substitute "peace" "war" '("war" "War" "WAr" "WAR") :test string-equal) '("peace" "peace" "peace" "peace")))
+	  (test-t (equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR") :test string=) '("war" "War" "WAr" "peace")))
+	  (test-t (equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR") :test string= :key cl-string-upcase) '("peace" "peace" "peace" "peace")))
+	  (test-t (equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR") :start 1 :end 2 :test string= :key cl-string-upcase) '("war" "peace" "WAr" "WAR")))
+	  (test-t (equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR") :start 1 :end nil :test string= :key cl-string-upcase) '("war" "peace" "peace" "peace")))
+	  (test-t (equal (substitute "peace" "war" '("war" "War" "WAr" "WAR") :test string= :key cl-string-upcase) '("war" "War" "WAr" "WAR")))
+	  (test-t (equalp (substitute 'a 'x #(x y z)) #(a y z)))
+	  (test-t (equalp (substitute 'b 'y #(x y z)) #(x b z)))
+	  (test-t (equalp (substitute 'c 'z #(x y z)) #(x y c)))
+	  (test-t (equalp (substitute 'a 'p #(x y z)) #(x y z)))
+	  (test-t (equalp (substitute 'a 'x #()) #()))
+	  (test-t (equalp (substitute #\x #\b #(#\a #\b #\c #\d #\e) :test char<) #(#\a #\b #\x #\x #\x)))
+	  (test-t (equalp (substitute '(a) 'x #((x) (y) (z)) :key car) #((a) (y) (z))))
+	  (test-t (equalp (substitute 'c 'b #(a b a b a b a b)) #(a c a c a c a c)))
+	  (test-t (equalp (substitute 'a 'b #(b b b)) #(a a a)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f)) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count nil) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 0) #(a x b x c x d x e x f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count -100) #(a x b x c x d x e x f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 1) #(a z b x c x d x e x f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 2) #(a z b z c x d x e x f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 3) #(a z b z c z d x e x f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 4) #(a z b z c z d z e x f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 5) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 6) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 7) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count nil :from-end t) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 0 :from-end t) #(a x b x c x d x e x f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count -100 :from-end t) #(a x b x c x d x e x f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 1 :from-end t) #(a x b x c x d x e z f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 2 :from-end t) #(a x b x c x d z e z f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 3 :from-end t) #(a x b x c z d z e z f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 4 :from-end t) #(a x b z c z d z e z f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 5 :from-end t) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 6 :from-end t) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 7 :from-end t) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :count 1) #(a x b z c x d x e x f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end nil :count 1) #(a x b z c x d x e x f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end 6 :count 100) #(a x b z c z d x e x f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end 11 :count 100) #(a x b z c z d z e z f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end 8 :count 10) #(a x b z c z d z e x f)))
+	  (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end 8 :count 2 :from-end t) #(a x b x c z d z e x f)))
+	  (test-t (equalp (substitute #\z #\c #(#\a #\b #\c #\d #\e #\f) :test char<) #(#\a #\b #\c #\z #\z #\z)))
+	  (test-t (equalp (substitute "peace" "war" #("love" "hate" "war" "peace") :test equal) #("love" "hate" "peace" "peace")))
+	  (test-t (equalp (substitute "peace" "war" #("war" "War" "WAr" "WAR") :test string-equal) #("peace" "peace" "peace" "peace")))
+	  (test-t (equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR") :test string=) #("war" "War" "WAr" "peace")))
+	  (test-t (equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR") :test string= :key cl-string-upcase) #("peace" "peace" "peace" "peace")))
+	  (test-t (equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR") :start 1 :end 2 :test string= :key cl-string-upcase) #("war" "peace" "WAr" "WAR")))
+	  (test-t (equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR") :start 1 :end nil :test string= :key cl-string-upcase) #("war" "peace" "peace" "peace")))
+	  (test-t (equalp (substitute "peace" "war" #("war" "War" "WAr" "WAR") :test string= :key cl-string-upcase) #("war" "War" "WAr" "WAR")))
+	  (test-t (string= (substitute #\A #\a "abcabc") "AbcAbc"))
+	  (test-t (string= (substitute #\A #\a "") ""))
+	  (test-t (string= (substitute #\A #\a "xyz") "xyz"))
+	  (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :start 5 :end nil) "aaaaaAAAAA"))
+	  (test-t (string= (substitute #\x #\5 "0123456789" :test char<) "012345xxxx"))
+	  (test-t (string= (substitute #\x #\5 "0123456789" :test char>) "xxxxx56789"))
+	  (test-t (string= (substitute #\x #\D "abcdefg" :key char-upcase :test char>) "xxxdefg"))
+	  (test-t (string= (substitute #\x #\D "abcdefg" :start 1 :end 2 :key char-upcase :test char>) "axcdefg"))
+	  (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count 2) "AAaaaaaaaa"))
+	  (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count -1) "aaaaaaaaaa"))
+	  (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count 0) "aaaaaaaaaa"))
+	  (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count nil) "AAAAAAAAAA"))
+	  (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count 100) "AAAAAAAAAA"))
+	  (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count 9) "AAAAAAAAAa"))
+	  (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count 9 :from-end t) "aAAAAAAAAA"))
+	  (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :start 2 :end 8 :count 3) "aaAAAaaaaa"))
+	  (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaAAAaa"))
+	  (test-t (string= (substitute #\x #\A "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaaaaaa"))
+	  (test-t (string= (substitute #\X #\A "aaaaaaaaaa" :start 2 :end 8 :from-end t :key char-upcase :count 3) "aaaaaXXXaa"))
+	  (test-t (string= (substitute #\X #\D "abcdefghij" :start 2 :end 8 :from-end t :key char-upcase :test char< :count 3) "abcdeXXXij"))
+	  (test-t (equal (substitute-if 'a (lambda (arg) (eq arg 'x)) '(x y z)) '(a y z)))
+	  (test-t (equal (substitute-if 'b (lambda (arg) (eq arg 'y)) '(x y z)) '(x b z)))
+	  (test-t (equal (substitute-if 'c (lambda (arg) (eq arg 'z)) '(x y z)) '(x y c)))
+	  (test-t (equal (substitute-if 'a (lambda (arg) (eq arg 'p)) '(x y z)) '(x y z)))
+	  (test-t (equal (substitute-if 'a (lambda (arg) (eq arg 'x)) ()) ()))
+	  (test-t (equal (substitute-if #\x (lambda (arg) (char< #\b arg)) '(#\a #\b #\c #\d #\e)) '(#\a #\b #\x #\x #\x)))
+	  (test-t (equal (substitute-if '(a) (lambda (arg) (eq arg 'x)) '((x) (y) (z)) :key car) '((a) (y) (z))))
+	  (test-t (equal (substitute-if 'c (lambda (arg) (eq arg 'b)) '(a b a b a b a b)) '(a c a c a c a c)))
+	  (test-t (equal (substitute-if 'a (lambda (arg) (eq arg 'b)) '(b b b)) '(a a a)))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count nil) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 0) axbx-etc))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count -100) axbx-etc))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 1) '(a z b x c x d x e x f)))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 2) '(a z b z c x d x e x f)))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 3) '(a z b z c z d x e x f)))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 4) '(a z b z c z d z e x f)))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 5) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 6) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 7) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count nil :from-end t) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 0 :from-end t) axbx-etc))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count -100 :from-end t) axbx-etc))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 1 :from-end t) '(a x b x c x d x e z f)))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 2 :from-end t) '(a x b x c x d z e z f)))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 3 :from-end t) '(a x b x c z d z e z f)))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 4 :from-end t) '(a x b z c z d z e z f)))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 5 :from-end t) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 6 :from-end t) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 7 :from-end t) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :start 2 :count 1) '(a x b z c x d x e x f)))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :start 2 :end nil :count 1) '(a x b z c x d x e x f)))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :start 2 :end 6 :count 100) '(a x b z c z d x e x f)))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :start 2 :end 11 :count 100) '(a x b z c z d z e z f)))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :start 2 :end 8 :count 10) '(a x b z c z d z e x f)))
+	  (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :start 2 :end 8 :count 2 :from-end t) '(a x b x c z d z e x f)))
+	  (test-t (equal (substitute-if #\z (lambda (arg) (char< #\c arg)) '(#\a #\b #\c #\d #\e #\f)) '(#\a #\b #\c #\z #\z #\z)))
+	  (test-t (equal (substitute-if "peace" (lambda (arg) (equal "war" arg)) '("love" "hate" "war" "peace")) '("love" "hate" "peace" "peace")))
+	  (test-t (equal (substitute-if "peace" (lambda (arg) (string-equal "war" arg)) '("war" "War" "WAr" "WAR")) '("peace" "peace" "peace" "peace")))
+	  (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR") :key cl-string-upcase) '("peace" "peace" "peace" "peace")))
+	  (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR") :start 1 :end 2 :key string-upcase) '("war" "peace" "WAr" "WAR")))
+	  (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR") :start 1 :end nil :key string-upcase) '("war" "peace" "peace" "peace")))
+	  (test-t (equal (substitute-if "peace" (lambda (arg) (string= "war" arg)) '("war" "War" "WAr" "WAR") :key string-upcase) '("war" "War" "WAr" "WAR")))
+	  (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 1 :key string-upcase) '("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+	  (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :key string-upcase) '("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR")))
+	  (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR")))
+	  (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 0 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+	  (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count -2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+	  (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count nil :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+	  (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 6 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+	  (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 7 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+	  (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 100 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+
+	  (test-t (equalp (substitute-if 'a (lambda (arg) (eq arg 'x)) #(x y z)) #(a y z)))
+	  (test-t (equalp (substitute-if 'b (lambda (arg) (eq arg 'y)) #(x y z)) #(x b z)))
+	  (test-t (equalp (substitute-if 'c (lambda (arg) (eq arg 'z)) #(x y z)) #(x y c)))
+	  (test-t (equalp (substitute-if 'a (lambda (arg) (eq arg 'p)) #(x y z)) #(x y z)))
+	  (test-t (equalp (substitute-if 'a (lambda (arg) (eq arg 'x)) #()) #()))
+	  (test-t (equalp (substitute-if #\x (lambda (arg) (char< #\b arg)) #(#\a #\b #\c #\d #\e)) #(#\a #\b #\x #\x #\x)))
+	  (test-t (equalp (substitute-if '(a) (lambda (arg) (eq arg 'x)) #((x) (y) (z)) :key car) #((a) (y) (z))))
+	  (test-t (equalp (substitute-if 'c (lambda (arg) (eq arg 'b)) #(a b a b a b a b)) #(a c a c a c a c)))
+	  (test-t (equalp (substitute-if 'a (lambda (arg) (eq arg 'b)) #(b b b)) #(a a a)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f)) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count nil) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 0) #(a x b x c x d x e x f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count -100) #(a x b x c x d x e x f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 1) #(a z b x c x d x e x f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 2) #(a z b z c x d x e x f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 3) #(a z b z c z d x e x f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 4) #(a z b z c z d z e x f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 5) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 6) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 7) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count nil :from-end t) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 0 :from-end t) #(a x b x c x d x e x f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count -100 :from-end t) #(a x b x c x d x e x f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 1 :from-end t) #(a x b x c x d x e z f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 2 :from-end t) #(a x b x c x d z e z f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 3 :from-end t) #(a x b x c z d z e z f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 4 :from-end t) #(a x b z c z d z e z f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 5 :from-end t) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 6 :from-end t) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 7 :from-end t) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :count 1) #(a x b z c x d x e x f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :end nil :count 1) #(a x b z c x d x e x f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :end 6 :count 100) #(a x b z c z d x e x f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :end 11 :count 100) #(a x b z c z d z e z f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :end 8 :count 10) #(a x b z c z d z e x f)))
+	  (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :end 8 :count 2 :from-end t) #(a x b x c z d z e x f)))
+	  (test-t (equalp (substitute-if #\z (lambda (arg) (char< #\c arg)) #(#\a #\b #\c #\d #\e #\f)) #(#\a #\b #\c #\z #\z #\z)))
+	  (test-t (equalp (substitute-if "peace" (lambda (arg) (equal "war" arg)) #("love" "hate" "war" "peace")) #("love" "hate" "peace" "peace")))
+	  (test-t (equalp (substitute-if "peace" (lambda (arg) (string-equal "war" arg)) #("war" "War" "WAr" "WAR")) #("peace" "peace" "peace" "peace")))
+	  (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR") :key string-upcase) #("peace" "peace" "peace" "peace")))
+	  (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR") :start 1 :end 2 :key string-upcase) #("war" "peace" "WAr" "WAR")))
+	  (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR") :start 1 :end nil :key string-upcase) #("war" "peace" "peace" "peace")))
+	  (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "war" arg)) #("war" "War" "WAr" "WAR") :key string-upcase) #("war" "War" "WAr" "WAR")))
+	  (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 1 :key string-upcase) #("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+	  (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :key string-upcase) #("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR")))
+	  (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR")))
+	  (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 0 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+	  (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count -2 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+	  (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count nil :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+	  (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 6 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+	  (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 7 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+	  (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 100 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+	  (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "abcabc") "AbcAbc"))
+	  (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "") ""))
+	  (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "xyz") "xyz"))
+	  (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :start 5 :end nil) "aaaaaAAAAA"))
+	  (test-t (string= (substitute-if #\x (lambda (arg) (char< #\5 arg)) "0123456789") "012345xxxx"))
+	  (test-t (string= (substitute-if #\x (lambda (arg) (char> #\5 arg)) "0123456789") "xxxxx56789"))
+	  (test-t (string= (substitute-if #\x (lambda (arg) (char> #\D arg)) "abcdefg" :key char-upcase) "xxxdefg"))
+	  (test-t (string= (substitute-if #\x (lambda (arg) (char> #\D arg)) "abcdefg" :start 1 :end 2 :key char-upcase) "axcdefg"))
+	  (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count 2) "AAaaaaaaaa"))
+	  (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count -1) "aaaaaaaaaa"))
+	  (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count 0) "aaaaaaaaaa"))
+	  (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count nil) "AAAAAAAAAA"))
+	  (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count 100) "AAAAAAAAAA"))
+	  (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count 9) "AAAAAAAAAa"))
+	  (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count 9 :from-end t) "aAAAAAAAAA"))
+	  (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :start 2 :end 8 :count 3) "aaAAAaaaaa"))
+	  (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaAAAaa"))
+	  (test-t (string= (substitute-if #\x (lambda (arg) (eql #\A arg)) "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaaaaaa"))
+	  (test-t (string= (substitute-if #\X (lambda (arg) (eql #\A arg)) "aaaaaaaaaa" :start 2 :end 8 :from-end t :key char-upcase :count 3) "aaaaaXXXaa"))
+	  (test-t (string= (substitute-if #\X (lambda (arg) (char< #\D arg)) "abcdefghij" :start 2 :end 8 :from-end t :key char-upcase :count 3) "abcdeXXXij"))
+	  (test-t (equal (substitute-if-not 'a (lambda (arg) (not (eq arg 'x))) '(x y z)) '(a y z)))
+	  (test-t (equal (substitute-if-not 'b (lambda (arg) (not (eq arg 'y))) '(x y z)) '(x b z)))
+	  (test-t (equal (substitute-if-not 'c (lambda (arg) (not (eq arg 'z))) '(x y z)) '(x y c)))
+	  (test-t (equal (substitute-if-not 'a (lambda (arg) (not (eq arg 'p))) '(x y z)) '(x y z)))
+	  (test-t (equal (substitute-if-not 'a (lambda (arg) (not (eq arg 'x))) ()) ()))
+	  (test-t (equal (substitute-if-not #\x (lambda (arg) (not (char< #\b arg))) '(#\a #\b #\c #\d #\e)) '(#\a #\b #\x #\x #\x)))
+	  (test-t (equal (substitute-if-not '(a) (lambda (arg) (not (eq arg 'x))) '((x) (y) (z)) :key car) '((a) (y) (z))))
+	  (test-t (equal (substitute-if-not 'c (lambda (arg) (not (eq arg 'b))) '(a b a b a b a b)) '(a c a c a c a c)))
+	  (test-t (equal (substitute-if-not 'a (lambda (arg) (not (eq arg 'b))) '(b b b)) '(a a a)))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count nil) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 0) axbx-etc))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count -100) axbx-etc))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 1) '(a z b x c x d x e x f)))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 2) '(a z b z c x d x e x f)))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 3) '(a z b z c z d x e x f)))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 4) '(a z b z c z d z e x f)))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 5) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 6) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 7) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count nil :from-end t) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 0 :from-end t) axbx-etc))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count -100 :from-end t) axbx-etc))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 1 :from-end t) '(a x b x c x d x e z f)))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 2 :from-end t) '(a x b x c x d z e z f)))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 3 :from-end t) '(a x b x c z d z e z f)))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 4 :from-end t) '(a x b z c z d z e z f)))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 5 :from-end t) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 6 :from-end t) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 7 :from-end t) '(a z b z c z d z e z f)))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :start 2 :count 1) '(a x b z c x d x e x f)))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :start 2 :end nil :count 1) '(a x b z c x d x e x f)))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :start 2 :end 6 :count 100) '(a x b z c z d x e x f)))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :start 2 :end 11 :count 100) '(a x b z c z d z e z f)))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :start 2 :end 8 :count 10) '(a x b z c z d z e x f)))
+	  (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :start 2 :end 8 :count 2 :from-end t) '(a x b x c z d z e x f)))
+	  (test-t (equal (substitute-if-not #\z (lambda (arg) (not (char< #\c arg))) '(#\a #\b #\c #\d #\e #\f)) '(#\a #\b #\c #\z #\z #\z)))
+	  (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (equal "war" arg))) '("love" "hate" "war" "peace")) '("love" "hate" "peace" "peace")))
+	  (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string-equal "war" arg))) '("war" "War" "WAr" "WAR")) '("peace" "peace" "peace" "peace")))
+	  (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR") :key string-upcase) '("peace" "peace" "peace" "peace")))
+	  (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR") :start 1 :end 2 :key string-upcase) '("war" "peace" "WAr" "WAR")))
+	  (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR") :start 1 :end nil :key string-upcase) '("war" "peace" "peace" "peace")))
+	  (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "war" arg))) '("war" "War" "WAr" "WAR") :key string-upcase) '("war" "War" "WAr" "WAR")))
+	  (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 1 :key string-upcase) '("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+	  (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :key string-upcase) '("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR")))
+	  (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR")))
+	  (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 0 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+	  (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count -2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+	  (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count nil :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+	  (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 6 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+	  (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 7 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+	  (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 100 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+	  (test-t (equalp (substitute-if-not 'a (lambda (arg) (not (eq arg 'x))) #(x y z)) #(a y z)))
+	  (test-t (equalp (substitute-if-not 'b (lambda (arg) (not (eq arg 'y))) #(x y z)) #(x b z)))
+	  (test-t (equalp (substitute-if-not 'c (lambda (arg) (not (eq arg 'z))) #(x y z)) #(x y c)))
+	  (test-t (equalp (substitute-if-not 'a (lambda (arg) (not (eq arg 'p))) #(x y z)) #(x y z)))
+	  (test-t (equalp (substitute-if-not 'a (lambda (arg) (not (eq arg 'x))) #()) #()))
+	  (test-t (equalp (substitute-if-not #\x (lambda (arg) (not (char< #\b arg))) #(#\a #\b #\c #\d #\e)) #(#\a #\b #\x #\x #\x)))
+	  (test-t (equalp (substitute-if-not '(a) (lambda (arg) (not (eq arg 'x))) #((x) (y) (z)) :key car) #((a) (y) (z))))
+	  (test-t (equalp (substitute-if-not 'c (lambda (arg) (not (eq arg 'b))) #(a b a b a b a b)) #(a c a c a c a c)))
+	  (test-t (equalp (substitute-if-not 'a (lambda (arg) (not (eq arg 'b))) #(b b b)) #(a a a)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f)) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count nil) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 0) #(a x b x c x d x e x f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count -100) #(a x b x c x d x e x f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 1) #(a z b x c x d x e x f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 2) #(a z b z c x d x e x f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 3) #(a z b z c z d x e x f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 4) #(a z b z c z d z e x f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 5) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 6) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 7) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count nil :from-end t) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 0 :from-end t) #(a x b x c x d x e x f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count -100 :from-end t) #(a x b x c x d x e x f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 1 :from-end t) #(a x b x c x d x e z f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 2 :from-end t) #(a x b x c x d z e z f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 3 :from-end t) #(a x b x c z d z e z f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 4 :from-end t) #(a x b z c z d z e z f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 5 :from-end t) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 6 :from-end t) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 7 :from-end t) #(a z b z c z d z e z f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :count 1) #(a x b z c x d x e x f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :end nil :count 1) #(a x b z c x d x e x f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :end 6 :count 100) #(a x b z c z d x e x f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :end 11 :count 100) #(a x b z c z d z e z f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :end 8 :count 10) #(a x b z c z d z e x f)))
+	  (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :end 8 :count 2 :from-end t) #(a x b x c z d z e x f)))
+	  (test-t (equalp (substitute-if-not #\z (lambda (arg) (not (char< #\c arg))) #(#\a #\b #\c #\d #\e #\f)) #(#\a #\b #\c #\z #\z #\z)))
+	  (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (equal "war" arg))) #("love" "hate" "war" "peace")) #("love" "hate" "peace" "peace")))
+	  (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string-equal "war" arg))) #("war" "War" "WAr" "WAR")) #("peace" "peace" "peace" "peace")))
+	  (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR") :key string-upcase) #("peace" "peace" "peace" "peace")))
+	  (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR") :start 1 :end 2 :key string-upcase) #("war" "peace" "WAr" "WAR")))
+	  (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR") :start 1 :end nil :key string-upcase) #("war" "peace" "peace" "peace")))
+	  (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "war" arg))) #("war" "War" "WAr" "WAR") :key string-upcase) #("war" "War" "WAr" "WAR")))
+	  (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 1 :key string-upcase) #("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+	  (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :key string-upcase) #("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR")))
+	  (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR")))
+	  (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 0 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+	  (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count -2 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+	  (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count nil :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+	  (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 6 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+	  (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 7 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+	  (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 100 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+	  (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "abcabc") "AbcAbc"))
+	  (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "") ""))
+	  (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "xyz") "xyz"))
+	  (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :start 5 :end nil) "aaaaaAAAAA"))
+	  (test-t (string= (substitute-if-not #\x (lambda (arg) (not (char< #\5 arg))) "0123456789") "012345xxxx"))
+	  (test-t (string= (substitute-if-not #\x (lambda (arg) (not (char> #\5 arg))) "0123456789") "xxxxx56789"))
+	  (test-t (string= (substitute-if-not #\x (lambda (arg) (not (char> #\D arg))) "abcdefg" :key char-upcase) "xxxdefg"))
+	  (test-t (string= (substitute-if-not #\x (lambda (arg) (not (char> #\D arg))) "abcdefg" :start 1 :end 2 :key char-upcase) "axcdefg"))
+	  (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count 2) "AAaaaaaaaa"))
+	  (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count -1) "aaaaaaaaaa"))
+	  (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count 0) "aaaaaaaaaa"))
+	  (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count nil) "AAAAAAAAAA"))
+	  (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count 100) "AAAAAAAAAA"))
+	  (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count 9) "AAAAAAAAAa"))
+	  (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count 9 :from-end t) "aAAAAAAAAA"))
+	  (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :start 2 :end 8 :count 3) "aaAAAaaaaa"))
+	  (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaAAAaa"))
+	  (test-t (string= (substitute-if-not #\x (lambda (arg) (not (eql #\A arg))) "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaaaaaa"))
+	  (test-t (string= (substitute-if-not #\X (lambda (arg) (not (eql #\A arg))) "aaaaaaaaaa" :start 2 :end 8 :from-end t :key char-upcase :count 3) "aaaaaXXXaa"))
+	  (test-t (string= (substitute-if-not #\X (lambda (arg) (not (char< #\D arg))) "abcdefghij" :start 2 :end 8 :from-end t :key char-upcase :count 3) "abcdeXXXij"))
+	  (test-t (equal (nsubstitute 'a 'x (copy '(x y z))) '(a y z)))
+	  (test-t (equal (nsubstitute 'b 'y (copy '(x y z))) '(x b z)))
+	  (test-t (equal (nsubstitute 'c 'z (copy '(x y z))) '(x y c)))
+	  (test-t (equal (nsubstitute 'a 'p (copy '(x y z))) '(x y z)))
+	  (test-t (equal (nsubstitute 'a 'x (copy ())) ()))
+	  (test-t (equal (nsubstitute #\x #\b (copy '(#\a #\b #\c #\d #\e)) :test char<) '(#\a #\b #\x #\x #\x)))
+	  (test-t (equal (nsubstitute '(a) 'x (copy '((x) (y) (z))) :key car) '((a) (y) (z))))
+	  (test-t (equal (nsubstitute 'c 'b (copy '(a b a b a b a b))) '(a c a c a c a c)))
+	  (test-t (equal (nsubstitute 'a 'b (copy '(b b b))) '(a a a)))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc)) '(a z b z c z d z e z f)))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count nil) '(a z b z c z d z e z f)))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 0) axbx-etc))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count -100) axbx-etc))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 1) '(a z b x c x d x e x f)))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 2) '(a z b z c x d x e x f)))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 3) '(a z b z c z d x e x f)))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 4) '(a z b z c z d z e x f)))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 5) '(a z b z c z d z e z f)))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 6) '(a z b z c z d z e z f)))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 7) '(a z b z c z d z e z f)))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count nil :from-end t) '(a z b z c z d z e z f)))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 0 :from-end t) axbx-etc))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count -100 :from-end t) axbx-etc))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 1 :from-end t) '(a x b x c x d x e z f)))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 2 :from-end t) '(a x b x c x d z e z f)))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 3 :from-end t) '(a x b x c z d z e z f)))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 4 :from-end t) '(a x b z c z d z e z f)))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 5 :from-end t) '(a z b z c z d z e z f)))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 6 :from-end t) '(a z b z c z d z e z f)))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 7 :from-end t) '(a z b z c z d z e z f)))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :start 2 :count 1) '(a x b z c x d x e x f)))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :start 2 :end nil :count 1) '(a x b z c x d x e x f)))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :start 2 :end 6 :count 100) '(a x b z c z d x e x f)))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :start 2 :end 11 :count 100) '(a x b z c z d z e z f)))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :start 2 :end 8 :count 10) '(a x b z c z d z e x f)))
+	  (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :start 2 :end 8 :count 2 :from-end t) '(a x b x c z d z e x f)))
+	  (test-t (equal (nsubstitute #\z #\c (copy '(#\a #\b #\c #\d #\e #\f)) :test char<) '(#\a #\b #\c #\z #\z #\z)))
+	  (test-t (equal (nsubstitute "peace" "war" (copy '("love" "hate" "war" "peace")) :test equal) '("love" "hate" "peace" "peace")))
+	  (test-t (equal (nsubstitute "peace" "war" (copy '("war" "War" "WAr" "WAR")) :test string-equal) '("peace" "peace" "peace" "peace")))
+	  (test-t (equal (nsubstitute "peace" "WAR" (copy '("war" "War" "WAr" "WAR")) :test string=) '("war" "War" "WAr" "peace")))
+	  (test-t (equal (nsubstitute "peace" "WAR" (copy '("war" "War" "WAr" "WAR")) :test string= :key string-upcase) '("peace" "peace" "peace" "peace")))
+	  (test-t (equal (nsubstitute "peace" "WAR" (copy '("war" "War" "WAr" "WAR")) :start 1 :end 2 :test string= :key string-upcase) '("war" "peace" "WAr" "WAR")))
+	  (test-t (equalp (nsubstitute 'a 'x (copy #(x y z))) #(a y z)))
+	  (test-t (equalp (nsubstitute 'b 'y (copy #(x y z))) #(x b z)))
+	  (test-t (equalp (nsubstitute 'c 'z (copy #(x y z))) #(x y c)))
+	  (test-t (equalp (nsubstitute 'a 'p (copy #(x y z))) #(x y z)))
+	  (test-t (equalp (nsubstitute 'a 'x (copy #())) #()))
+	  (test-t (equalp (nsubstitute #\x #\b (copy #(#\a #\b #\c #\d #\e)) :test char<) #(#\a #\b #\x #\x #\x)))
+	  (test-t (equalp (nsubstitute '(a) 'x (copy #((x) (y) (z))) :key car) #((a) (y) (z))))
+	  (test-t (equalp (nsubstitute 'c 'b (copy #(a b a b a b a b))) #(a c a c a c a c)))
+	  (test-t (equalp (nsubstitute 'a 'b (copy #(b b b))) #(a a a)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f))) #(a z b z c z d z e z f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count nil) #(a z b z c z d z e z f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 0) #(a x b x c x d x e x f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count -100) #(a x b x c x d x e x f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 1) #(a z b x c x d x e x f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 2) #(a z b z c x d x e x f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 3) #(a z b z c z d x e x f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 4) #(a z b z c z d z e x f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 5) #(a z b z c z d z e z f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 6) #(a z b z c z d z e z f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 7) #(a z b z c z d z e z f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count nil :from-end t) #(a z b z c z d z e z f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 0 :from-end t) #(a x b x c x d x e x f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count -100 :from-end t) #(a x b x c x d x e x f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 1 :from-end t) #(a x b x c x d x e z f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 2 :from-end t) #(a x b x c x d z e z f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 3 :from-end t) #(a x b x c z d z e z f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 4 :from-end t) #(a x b z c z d z e z f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 5 :from-end t) #(a z b z c z d z e z f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 6 :from-end t) #(a z b z c z d z e z f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 7 :from-end t) #(a z b z c z d z e z f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :start 2 :count 1) #(a x b z c x d x e x f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :start 2 :end nil :count 1) #(a x b z c x d x e x f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :start 2 :end 6 :count 100) #(a x b z c z d x e x f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :start 2 :end 11 :count 100) #(a x b z c z d z e z f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :start 2 :end 8 :count 10) #(a x b z c z d z e x f)))
+	  (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :start 2 :end 8 :count 2 :from-end t) #(a x b x c z d z e x f)))
+	  (test-t (equalp (nsubstitute #\z #\c (copy #(#\a #\b #\c #\d #\e #\f)) :test char<) #(#\a #\b #\c #\z #\z #\z)))
+	  (test-t (equalp (nsubstitute "peace" "war" (copy #("love" "hate" "war" "peace")) :test equal) #("love" "hate" "peace" "peace")))
+	  (test-t (equalp (nsubstitute "peace" "war" (copy #("war" "War" "WAr" "WAR")) :test string-equal) #("peace" "peace" "peace" "peace")))
+	  (test-t (equalp (nsubstitute "peace" "WAR" (copy #("war" "War" "WAr" "WAR")) :test string=) #("war" "War" "WAr" "peace")))
+	  (test-t (equalp (nsubstitute "peace" "WAR" (copy #("war" "War" "WAr" "WAR")) :test string= :key string-upcase) #("peace" "peace" "peace" "peace")))
+	  (test-t (equalp (nsubstitute "peace" "WAR" (copy #("war" "War" "WAr" "WAR")) :start 1 :end 2 :test string= :key string-upcase) #("war" "peace" "WAr" "WAR")))
+	  (test-t (equalp (nsubstitute "peace" "WAR" (copy #("war" "War" "WAr" "WAR")) :start 1 :end nil :test string= :key cl-string-upcase) #("war" "peace" "peace" "peace")))
+	  (test-t (string= (nsubstitute #\A #\a (copy "abcabc")) "AbcAbc"))
+	  (test-t (string= (nsubstitute #\A #\a (copy "")) ""))
+	  (test-t (string= (nsubstitute #\A #\a (copy "xyz")) "xyz"))
+	  (test-t (string= (nsubstitute #\A #\a (copy "aaaaaaaaaa") :start 5 :end nil) "aaaaaAAAAA"))
+	  (test-t (string= (nsubstitute #\x #\5 (copy "0123456789") :test char<) "012345xxxx"))
+	  (test-t (string= (nsubstitute #\x #\5 (copy "0123456789") :test char>) "xxxxx56789"))
+	  (test-t (string= (nsubstitute #\x #\D (copy "abcdefg") :key char-upcase :test char>) "xxxdefg"))
+	  (test-t (string= (nsubstitute #\x #\D (copy "abcdefg") :start 1 :end 2 :key char-upcase :test char>) "axcdefg"))
+	  (test-t (string= (nsubstitute #\A #\a (copy "aaaaaaaaaa") :count 2) "AAaaaaaaaa"))
+	  (test-t (string= (nsubstitute #\A #\a (copy "aaaaaaaaaa") :count -1) "aaaaaaaaaa"))
+	  (test-t (string= (nsubstitute #\A #\a (copy "aaaaaaaaaa") :count 0) "aaaaaaaaaa"))
+	  (test-t (string= (nsubstitute #\A #\a (copy "aaaaaaaaaa") :count nil) "AAAAAAAAAA"))
+	  (test-t (string= (nsubstitute #\A #\a (copy "aaaaaaaaaa") :count 100) "AAAAAAAAAA"))
+	  (test-t (string= (nsubstitute #\A #\a (copy "aaaaaaaaaa") :count 9) "AAAAAAAAAa"))
+	  (test-t (string= (nsubstitute #\A #\a (copy "aaaaaaaaaa") :count 9 :from-end t) "aAAAAAAAAA"))
+	  (test-t (string= (nsubstitute #\A #\a (copy "aaaaaaaaaa") :start 2 :end 8 :count 3) "aaAAAaaaaa"))
+	  (test-t (string= (nsubstitute #\A #\a (copy "aaaaaaaaaa") :start 2 :end 8 :from-end t :count 3) "aaaaaAAAaa"))
+	  (test-t (string= (nsubstitute #\x #\A (copy "aaaaaaaaaa") :start 2 :end 8 :from-end t :count 3) "aaaaaaaaaa"))
+	  (test-t (string= (nsubstitute #\X #\A (copy "aaaaaaaaaa") :start 2 :end 8 :from-end t :key char-upcase :count 3) "aaaaaXXXaa"))
+	  (test-t (string= (nsubstitute #\X #\D (copy "abcdefghij") :start 2 :end 8 :from-end t :key char-upcase :test char< :count 3) "abcdeXXXij"))
+	  (test-t (equal (nsubstitute-if 'a (lambda (arg) (eq arg 'x)) (copy '(x y z))) '(a y z)))
+	  (test-t (equal (nsubstitute-if 'b (lambda (arg) (eq arg 'y)) (copy '(x y z))) '(x b z)))
+	  (test-t (equal (nsubstitute-if 'c (lambda (arg) (eq arg 'z)) (copy '(x y z))) '(x y c)))
+	  (test-t (equal (nsubstitute-if 'a (lambda (arg) (eq arg 'p)) (copy '(x y z))) '(x y z)))
+	  (test-t (equal (nsubstitute-if 'a (lambda (arg) (eq arg 'x)) (copy ())) ()))
+	  (test-t (equal (nsubstitute-if #\x (lambda (arg) (char< #\b arg)) (copy '(#\a #\b #\c #\d #\e))) '(#\a #\b #\x #\x #\x)))
+	  (test-t (equal (nsubstitute-if '(a) (lambda (arg) (eq arg 'x)) (copy '((x) (y) (z))) :key car) '((a) (y) (z))))
+	  (test-t (equal (nsubstitute-if 'c (lambda (arg) (eq arg 'b)) (copy '(a b a b a b a b))) '(a c a c a c a c)))
+	  (test-t (equal (nsubstitute-if 'a (lambda (arg) (eq arg 'b)) (copy '(b b b))) '(a a a)))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc)) '(a z b z c z d z e z f)))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count nil) '(a z b z c z d z e z f)))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 0) axbx-etc))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count -100) axbx-etc))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 1) '(a z b x c x d x e x f)))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 2) '(a z b z c x d x e x f)))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 3) '(a z b z c z d x e x f)))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 4) '(a z b z c z d z e x f)))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 5) '(a z b z c z d z e z f)))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 6) '(a z b z c z d z e z f)))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 7) '(a z b z c z d z e z f)))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count nil :from-end t) '(a z b z c z d z e z f)))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 0 :from-end t) axbx-etc))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count -100 :from-end t) axbx-etc))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 1 :from-end t) '(a x b x c x d x e z f)))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 2 :from-end t) '(a x b x c x d z e z f)))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 3 :from-end t) '(a x b x c z d z e z f)))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 4 :from-end t) '(a x b z c z d z e z f)))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 5 :from-end t) '(a z b z c z d z e z f)))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 6 :from-end t) '(a z b z c z d z e z f)))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 7 :from-end t) '(a z b z c z d z e z f)))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :start 2 :count 1) '(a x b z c x d x e x f)))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :start 2 :end nil :count 1) '(a x b z c x d x e x f)))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :start 2 :end 6 :count 100) '(a x b z c z d x e x f)))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :start 2 :end 11 :count 100) '(a x b z c z d z e z f)))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :start 2 :end 8 :count 10) '(a x b z c z d z e x f)))
+	  (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :start 2 :end 8 :count 2 :from-end t) '(a x b x c z d z e x f)))
+	  (test-t (equal (nsubstitute-if #\z (lambda (arg) (char< #\c arg)) (copy '(#\a #\b #\c #\d #\e #\f))) '(#\a #\b #\c #\z #\z #\z)))
+	  (test-t (equal (nsubstitute-if "peace" (lambda (arg) (equal "war" arg)) (copy '("love" "hate" "war" "peace"))) '("love" "hate" "peace" "peace")))
+	  (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string-equal "war" arg)) (copy '("war" "War" "WAr" "WAR"))) '("peace" "peace" "peace" "peace")))
+	  (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR")) :key string-upcase) '("peace" "peace" "peace" "peace")))
+	  (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR")) :start 1 :end 2 :key string-upcase) '("war" "peace" "WAr" "WAR")))
+	  (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR")) :start 1 :end nil :key string-upcase) '("war" "peace" "peace" "peace")))
+	  (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "war" arg)) (copy '("war" "War" "WAr" "WAR")) :key string-upcase) '("war" "War" "WAr" "WAR")))
+	  (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 1 :key string-upcase) '("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+	  (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 2 :key string-upcase) '("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR")))
+	  (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR")))
+	  (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 0 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+	  (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count -2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+	  (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count nil :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+	  (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 6 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+	  (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 7 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+	  (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 100 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+	  (test-t (equalp (nsubstitute-if 'a (lambda (arg) (eq arg 'x)) (copy #(x y z))) #(a y z)))
+	  (test-t (equalp (nsubstitute-if 'b (lambda (arg) (eq arg 'y)) (copy #(x y z))) #(x b z)))
+	  (test-t (equalp (nsubstitute-if 'c (lambda (arg) (eq arg 'z)) (copy #(x y z))) #(x y c)))
+	  (test-t (equalp (nsubstitute-if 'a (lambda (arg) (eq arg 'p)) (copy #(x y z))) #(x y z)))
+	  (test-t (equalp (nsubstitute-if 'a (lambda (arg) (eq arg 'x)) (copy #())) #()))
+	  (test-t (equalp (nsubstitute-if #\x (lambda (arg) (char< #\b arg)) (copy #(#\a #\b #\c #\d #\e))) #(#\a #\b #\x #\x #\x)))
+	  (test-t (equalp (nsubstitute-if '(a) (lambda (arg) (eq arg 'x)) (copy #((x) (y) (z))) :key car) #((a) (y) (z))))
+	  (test-t (equalp (nsubstitute-if 'c (lambda (arg) (eq arg 'b)) (copy #(a b a b a b a b))) #(a c a c a c a c)))
+	  (test-t (equalp (nsubstitute-if 'a (lambda (arg) (eq arg 'b)) (copy #(b b b))) #(a a a)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f))) #(a z b z c z d z e z f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count nil) #(a z b z c z d z e z f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 0) #(a x b x c x d x e x f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count -100) #(a x b x c x d x e x f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 1) #(a z b x c x d x e x f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 2) #(a z b z c x d x e x f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 3) #(a z b z c z d x e x f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 4) #(a z b z c z d z e x f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 5) #(a z b z c z d z e z f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 6) #(a z b z c z d z e z f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 7) #(a z b z c z d z e z f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count nil :from-end t) #(a z b z c z d z e z f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 0 :from-end t) #(a x b x c x d x e x f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count -100 :from-end t) #(a x b x c x d x e x f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 1 :from-end t) #(a x b x c x d x e z f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 2 :from-end t) #(a x b x c x d z e z f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 3 :from-end t) #(a x b x c z d z e z f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 4 :from-end t) #(a x b z c z d z e z f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 5 :from-end t) #(a z b z c z d z e z f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 6 :from-end t) #(a z b z c z d z e z f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 7 :from-end t) #(a z b z c z d z e z f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :start 2 :count 1) #(a x b z c x d x e x f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :start 2 :end nil :count 1) #(a x b z c x d x e x f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :start 2 :end 6 :count 100) #(a x b z c z d x e x f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :start 2 :end 11 :count 100) #(a x b z c z d z e z f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :start 2 :end 8 :count 10) #(a x b z c z d z e x f)))
+	  (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :start 2 :end 8 :count 2 :from-end t) #(a x b x c z d z e x f)))
+	  (test-t (equalp (nsubstitute-if #\z (lambda (arg) (char< #\c arg)) (copy #(#\a #\b #\c #\d #\e #\f))) #(#\a #\b #\c #\z #\z #\z)))
+	  (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (equal "war" arg)) (copy #("love" "hate" "war" "peace"))) #("love" "hate" "peace" "peace")))
+	  (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string-equal "war" arg)) (copy #("war" "War" "WAr" "WAR"))) #("peace" "peace" "peace" "peace")))
+	  (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy #("war" "War" "WAr" "WAR")) :key string-upcase) #("peace" "peace" "peace" "peace")))
+	  (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy #("war" "War" "WAr" "WAR")) :start 1 :end 2 :key string-upcase) #("war" "peace" "WAr" "WAR")))
+	  (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy #("war" "War" "WAr" "WAR")) :start 1 :end nil :key string-upcase) #("war" "peace" "peace" "peace")))
+	  (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "war" arg)) (copy #("war" "War" "WAr" "WAR")) :key string-upcase) #("war" "War" "WAr" "WAR")))
+	  (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 1 :key string-upcase) #("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+	  (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 2 :key string-upcase) #("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR")))
+	  (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 2 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR")))
+	  (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy "abcabc")) "AbcAbc"))
+	  (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy "")) ""))
+	  (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy "xyz")) "xyz"))
+	  (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy "aaaaaaaaaa") :start 5 :end nil) "aaaaaAAAAA"))
+	  (test-t (string= (nsubstitute-if #\x (lambda (arg) (char< #\5 arg)) (copy "0123456789")) "012345xxxx"))
+	  (test-t (string= (nsubstitute-if #\x (lambda (arg) (char> #\5 arg)) (copy "0123456789")) "xxxxx56789"))
+	  (test-t (string= (nsubstitute-if #\x (lambda (arg) (char> #\D arg)) (copy "abcdefg") :key char-upcase) "xxxdefg"))
+	  (test-t (string= (nsubstitute-if #\x (lambda (arg) (char> #\D arg)) (copy "abcdefg") :start 1 :end 2 :key char-upcase) "axcdefg"))
+	  (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy "aaaaaaaaaa") :count 2) "AAaaaaaaaa"))
+	  (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy "aaaaaaaaaa") :count -1) "aaaaaaaaaa"))
+	  (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy "aaaaaaaaaa") :count 0) "aaaaaaaaaa"))
+	  (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy "aaaaaaaaaa") :count nil) "AAAAAAAAAA"))
+	  (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy "aaaaaaaaaa") :count 100) "AAAAAAAAAA"))
+	  (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy "aaaaaaaaaa") :count 9) "AAAAAAAAAa"))
+	  (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy "aaaaaaaaaa") :count 9 :from-end t) "aAAAAAAAAA"))
+	  (test-t (equal (nsubstitute-if-not 'a (lambda (arg) (not (eq arg 'x))) (copy '(x y z))) '(a y z)))
+	  (test-t (equal (nsubstitute-if-not 'b (lambda (arg) (not (eq arg 'y))) (copy '(x y z))) '(x b z)))
+	  (test-t (equal (nsubstitute-if-not 'c (lambda (arg) (not (eq arg 'z))) (copy '(x y z))) '(x y c)))
+	  (test-t (equal (nsubstitute-if-not 'a (lambda (arg) (not (eq arg 'p))) (copy '(x y z))) '(x y z)))
+	  (test-t (equal (nsubstitute-if-not 'a (lambda (arg) (not (eq arg 'x))) (copy ())) ()))
+	  (test-t (equal (nsubstitute-if-not #\x (lambda (arg) (not (char< #\b arg))) (copy '(#\a #\b #\c #\d #\e))) '(#\a #\b #\x #\x #\x)))
+	  (test-t (equal (nsubstitute-if-not '(a) (lambda (arg) (not (eq arg 'x))) (copy '((x) (y) (z))) :key car) '((a) (y) (z))))
+	  (test-t (equal (nsubstitute-if-not 'c (lambda (arg) (not (eq arg 'b))) (copy '(a b a b a b a b))) '(a c a c a c a c)))
+	  (test-t (equal (nsubstitute-if-not 'a (lambda (arg) (not (eq arg 'b))) (copy '(b b b))) '(a a a)))
+	  (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy axbx-etc)) '(a z b z c z d z e z f)))
+	  (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy axbx-etc) :count nil) '(a z b z c z d z e z f)))
+	  (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy axbx-etc) :count 0) axbx-etc))
+	  (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy axbx-etc) :count -100) axbx-etc))
+	  (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy axbx-etc) :count 1) '(a z b x c x d x e x f)))
+	  (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy axbx-etc) :count 2) '(a z b z c x d x e x f)))
+	  (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy axbx-etc) :count 3) '(a z b z c z d x e x f)))
+	  (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy axbx-etc) :count 4) '(a z b z c z d z e x f)))
+	  (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy axbx-etc) :count 5) '(a z b z c z d z e z f)))
+	  (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy axbx-etc) :count 6) '(a z b z c z d z e z f)))
+	  (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy axbx-etc) :count 7) '(a z b z c z d z e z f)))
+	  )
+
+	(let ()
+	  (define* (reduce function sequence from-end (start 0) end initial-value (key identity))
+	    (let* ((slen (length sequence))
+		   (nd (or (and (number? end) end) slen))
+		   (len (min slen (- nd start))))
+	      (if (< nd start)
+		  (error 'out-of-range "~A :start ~A is greater than ~A ~A" (*function* (curlet)) start (if end ":end" "length") nd))
+	      (if (not (positive? len))
+		  (or initial-value
+		      (function))
+		  (if (and (= len 1)
+			   (not initial-value))
+		      (sequence start)
+		      (if (and (not from-end) (not (null? from-end)))
+			  (let* ((first-arg (or initial-value (key (sequence start))))
+				 (second-arg (if initial-value (key (sequence start)) (key (sequence (+ start 1)))))
+				 (val (function first-arg second-arg)))
+			    (do ((i (if initial-value (+ start 1) (+ start 2)) (+ i 1)))
+				((= i nd) val)
+			      (set! val (function val (key (sequence i))))))
+			  (let* ((second-arg (or initial-value (key (sequence (- nd 1)))))
+				 (first-arg (if initial-value (key (sequence (- nd 1))) (key (sequence (- nd 2)))))
+				 (val (function first-arg second-arg)))
+			    (do ((i (if initial-value (- nd 2) (- nd 3)) (- i 1)))
+				((< i start) val)
+			      (set! val (function (key (sequence i)) val)))))))))
+
+	  (test-t (eql (reduce * '(1 2 3 4 5)) 120))
+	  (test-t (equal (reduce append '((1) (2)) :initial-value '(i n i t)) '(i n i t 1 2)))
+	  (test-t (equal (reduce append '((1) (2)) :from-end t :initial-value '(i n i t)) '(1 2 i n i t)))
+	  (test-t (eql (reduce - '(1 2 3 4)) -8))
+	  (test-t (eql (reduce - '(1 2 3 4) :from-end t) -2))
+	  (test-t (eql (reduce + ()) 0))
+	  (test-t (eql (reduce + '(3)) 3))
+	  (test-t (eq (reduce + '(foo)) 'foo))
+	  (test-t (equal (reduce list '(1 2 3 4)) '(((1 2) 3) 4)))
+	  (test-t (equal (reduce list '(1 2 3 4) :from-end t) '(1 (2 (3 4)))))
+	  (test-t (equal (reduce list '(1 2 3 4) :initial-value 'foo) '((((foo 1) 2) 3) 4)))
+	  (test-t (equal (reduce list '(1 2 3 4) :from-end t :initial-value 'foo) '(1 (2 (3 (4 foo))))))
+	  (test-t (equal (reduce list '(0 1 2 3)) '(((0 1) 2) 3)))
+	  (test-t (equal (reduce list '(0 1 2 3) :start 1) '((1 2) 3)))
+	  (test-t (equal (reduce list '(0 1 2 3) :start 1 :end nil) '((1 2) 3)))
+	  (test-t (equal (reduce list '(0 1 2 3) :start 2) '(2 3)))
+	  (test-t (eq (reduce list '(0 1 2 3) :start 0 :end 0) ()))
+	  (test-t (eq (reduce list '(0 1 2 3) :start 0 :end 0 :initial-value 'initial-value) 'initial-value))
+	  (test-t (eq (reduce list '(0 1 2 3) :start 2 :end 2) ()))
+	  (test-t (eq (reduce list '(0 1 2 3) :start 2 :end 2 :initial-value 'initial-value) 'initial-value))
+	  (test-t (eq (reduce list '(0 1 2 3) :start 4 :end 4) ()))
+	  (test-t (eq (reduce list '(0 1 2 3) :start 4 :end 4 :initial-value 'initial-value) 'initial-value))
+	  (test-t (eql (reduce list '(0 1 2 3) :start 2 :end 3) 2))
+	  (test-t (equal (reduce list '(0 1 2 3) :start 2 :end 3 :initial-value 'initial-value) '(initial-value 2)))
+	  (test-t (eql (reduce + '(0 1 2 3 4 5 6 7 8 9)) 45))
+	  (test-t (eql (reduce - '(0 1 2 3 4 5 6 7 8 9)) -45))
+	  (test-t (eql (reduce - '(0 1 2 3 4 5 6 7 8 9) :from-end t) -5))
+	  (test-t (equal (reduce list '(0 1 2 3) :initial-value 'initial-value) '((((initial-value 0) 1) 2) 3)))
+	  (test-t (equal (reduce list '(0 1 2 3) :from-end t) '(0 (1 (2 3)))))
+	  (test-t (equal (reduce list '((1) (2) (3) (4)) :key car) '(((1 2) 3) 4)))
+					;(test-t (equal (reduce list '((1) (2) (3) (4)) :key car :from-end nil) '(((1 2) 3) 4)))
+	  (test-t (equal (reduce list '((1) (2) (3) (4)) :key car :initial-value 0) '((((0 1) 2) 3) 4)))
+	  (test-t (equal (reduce list '((1) (2) (3) (4)) :key car :from-end t) '(1 (2 (3 4)))))
+	  (test-t (equal (reduce list '((1) (2) (3) (4)) :key car :from-end t :initial-value 5) '(1 (2 (3 (4 5))))))
+	  (test-t (equal (reduce list #(0 1 2 3)) '(((0 1) 2) 3)))
+	  (test-t (equal (reduce list #(0 1 2 3) :start 1) '((1 2) 3)))
+	  (test-t (equal (reduce list #(0 1 2 3) :start 1 :end nil) '((1 2) 3)))
+	  (test-t (equal (reduce list #(0 1 2 3) :start 2) '(2 3)))
+	  (test-t (eq (reduce list #(0 1 2 3) :start 0 :end 0) ()))
+	  (test-t (eq (reduce list #(0 1 2 3) :start 0 :end 0 :initial-value 'initial-value) 'initial-value))
+	  (test-t (eq (reduce list #(0 1 2 3) :start 2 :end 2) ()))
+	  (test-t (eq (reduce list #(0 1 2 3) :start 2 :end 2 :initial-value 'initial-value) 'initial-value))
+	  (test-t (eq (reduce list #(0 1 2 3) :start 4 :end 4) ()))
+	  (test-t (eq (reduce list #(0 1 2 3) :start 4 :end 4 :initial-value 'initial-value) 'initial-value))
+	  (test-t (eql (reduce list #(0 1 2 3) :start 2 :end 3) 2))
+	  (test-t (equal (reduce list #(0 1 2 3) :start 2 :end 3 :initial-value 'initial-value) '(initial-value 2)))
+	  (test-t (eql (reduce + #(0 1 2 3 4 5 6 7 8 9)) 45))
+	  (test-t (eql (reduce - #(0 1 2 3 4 5 6 7 8 9)) -45))
+	  (test-t (eql (reduce - #(0 1 2 3 4 5 6 7 8 9) :from-end t) -5))
+	  (test-t (equal (reduce list #(0 1 2 3) :initial-value 'initial-value) '((((initial-value 0) 1) 2) 3)))
+	  (test-t (equal (reduce list #(0 1 2 3) :from-end t) '(0 (1 (2 3)))))
+	  (test-t (equal (reduce list #((1) (2) (3) (4)) :key car) '(((1 2) 3) 4)))
+					;(test-t (equal (reduce list #((1) (2) (3) (4)) :key car :from-end nil) '(((1 2) 3) 4)))
+	  (test-t (equal (reduce list #((1) (2) (3) (4)) :key car :initial-value 0) '((((0 1) 2) 3) 4)))
+	  (test-t (equal (reduce list #((1) (2) (3) (4)) :key car :from-end t) '(1 (2 (3 4)))))
+	  (test-t (equal (reduce list #((1) (2) (3) (4)) :key car :from-end t :initial-value 5) '(1 (2 (3 (4 5))))))
+	  )
+
+	(define (nreverse sequence)
+	  (let ((len (length sequence)))
+	    (do ((i 0 (+ i 1))
+		 (j (- len 1) (- j 1)))
+		((>= i j) sequence)
+	      (let ((tmp (sequence i)))
+		(set! (sequence i) (sequence j))
+		(set! (sequence j) tmp)))))
+
+	(define (cl-reverse sequence)
+	  (nreverse (copy sequence)))
+
+	(define (elt sequence index) (sequence index))
+	;; length is ok
+
+	(define* (some predicate . sequences)
+	  (call-with-exit
+	   (lambda (return)
+		     (apply for-each
+		      (lambda args
+			(let ((val (apply predicate args)))
+			  (if val (return val))))
+		      sequences)
+		     #f)))
+
+	(define* (notany predicate . sequences)
+	  (not (apply some predicate sequences)))
+
+	(define* (every predicate . sequences)
+	  (call-with-exit
+	   (lambda (return)
+		     (apply for-each
+		      (lambda args
+			(if (not (apply predicate args))
+			    (return #f)))
+		      sequences)
+		     #t)))
+
+	(define* (notevery predicate . sequences)
+	  (not (apply every predicate sequences)))
+
+	(define* (cl-fill sequence item (start 0) end) ; actually "fill" doesn't collide, but it's confusing
+	  (let ((nd (or (and (not (null? end)) end)
+			(length sequence))))
+	    (fill! sequence item start nd)
+	    sequence))
+
+	;; many of the sequence functions return a different length sequence, but
+	;;   for user-defined sequence types, we can't use the 'type kludge (or
+	;;   at least it's ugly), so we need either (make obj size initial-value)
+	;;   where obj is a representative of the desired type, or another
+	;;   arg to copy giving the new object's size.  For now, I'll cobble up
+	;;   something explicit.
+	;;
+	;; perhaps the extended type could give its type symbol as well as the make function?
+
+	(define (make obj size)
+	  (cond ((vector? obj)     (make-vector size))
+		((list? obj)       (make-list size))
+		((string? obj)     (make-string size))
+		((hash-table? obj) (make-hash-table size)))) ; does this make any sense?
+
+	(define* (make-sequence type size initial-element)
+	  (case type
+	    ((vector bit-vector simple-vector) (make-vector size initial-element))
+	    ((hash-table) (make-hash-table size))
+	    ((string) (cl-make-string size (or initial-element #\null))) ; not #f!
+	    ((list) (cl-make-list size initial-element))
+            (else ())))
+
+	(define (cl-map type func . lists)
+	  (let* ((vals (apply mapcar func lists))
+		 (len (length vals)))
+	    (let ((obj (make-sequence (or type 'list) len)))
+	      (if (> (length obj) 0)
+		  (do ((i 0 (+ i 1)))
+		      ((= i len))
+		    (set! (obj i) (vals i))))
+	      obj)))
+
+	(define* (subseq sequence start end)
+	  (let* ((len (length sequence))
+		 (nd (or (and (number? end) end) len))
+		 (size (- nd start))
+		 (obj (make sequence size)))
+	    (do ((i start (+ i 1))
+		 (j 0 (+ j 1)))
+		((= i nd) obj)
+	      (set! (obj j) (sequence i)))))
+
+	(define (concatenate type . sequences)
+	  (let* ((len (apply + (map length sequences)))
+		 (new-obj (make-sequence type len))
+		 (ctr 0))
+	    (for-each
+	     (lambda (sequence)
+	       (for-each
+		(lambda (obj)
+		  (set! (new-obj ctr) obj)
+		  (set! ctr (+ ctr 1)))
+		sequence))
+	     sequences)
+	    new-obj))
+
+	;; :(concatenate 'list "hiho" #(1 2)) -> (#\h #\i #\h #\o 1 2)
+
+	(define* (replace seq1 seq2 (start1 0) end1 (start2 0) end2)
+	  (let* ((len1 (length seq1))
+		 (len2 (length seq2))
+		 (nd1 (or (and (number? end1) end1) len1))
+		 (nd2 (or (and (number? end2) end2) len2)))
+	    (if (and (eq? seq1 seq2)
+		     (> start1 start2))
+		(let ((offset (- start1 start2)))
+		  (do ((i (- nd1 1) (- i 1)))
+		      ((< i start1) seq1)
+		    (set! (seq1 i) (seq1 (- i offset)))))
+		(do ((i start1 (+ i 1))
+		     (j start2 (+ j 1)))
+		    ((or (= i nd1)
+			 (= j nd2))
+		     seq1)
+		  (set! (seq1 i) (seq2 j))))))
+
+	(let ()
+	  (define* (remove-if predicate sequence from-end (start 0) end count (key identity))
+	    (let* ((len (length sequence))
+		   (nd (or (and (number? end) end) len))
+		   (num (if (number? count) count len))
+		   (changed 0))
+	      (if (not (positive? num))
+		  sequence
+		  (let ((result ()))
+		    (if (null from-end)
+			(do ((i 0 (+ i 1)))
+			    ((= i len))
+			  (if (or (< i start)
+				  (>= i nd)
+				  (>= changed num)
+				  (not (predicate (key (sequence i)))))
+			      (set! result (cons (sequence i) result))
+			      (set! changed (+ changed 1))))
+			(do ((i (- len 1) (- i 1)))
+			    ((< i 0))
+			  (if (or (< i start)
+				  (>= i nd)
+				  (>= changed num)
+				  (not (predicate (key (sequence i)))))
+			      (set! result (cons (sequence i) result))
+			      (set! changed (+ changed 1)))))
+		    (let* ((len (length result))
+			   (obj (make sequence len))
+			   (vals (if (null from-end) (reverse result) result)))
+		      (do ((i 0 (+ i 1)))
+			  ((= i len))
+			(set! (obj i) (vals i)))
+		      obj)))))
+
+	  (define* (remove-if-not predicate sequence from-end (start 0) end count (key identity))
+	    (remove-if (lambda (obj) (not (predicate obj))) sequence from-end start end count key))
+
+	  (define* (remove item sequence from-end (test eql) (start 0) end count (key identity))
+	    (remove-if (lambda (arg) (test item arg)) sequence from-end start end count key))
+
+	  (define-macro* (delete-if predicate sequence from-end (start 0) end count (key identity))
+	    `(let ((obj (remove-if ,predicate ,sequence ,from-end ,start ,end ,count ,key)))
+	       (if (symbol? ',sequence)
+		   (set! ,sequence obj))
+	       obj))
+
+	  (define-macro* (delete-if-not predicate sequence from-end (start 0) end count (key identity))
+	    `(let ((obj (remove-if-not ,predicate ,sequence ,from-end ,start ,end ,count ,key)))
+	       (if (symbol? ',sequence)
+		   (set! ,sequence obj))
+	       obj))
+
+	  (define-macro* (delete item sequence from-end (test eql) (start 0) end count (key identity))
+	    `(let ((obj (remove ,item ,sequence ,from-end ,test ,start ,end ,count ,key)))
+	       (if (symbol? ',sequence)
+		   (set! ,sequence obj))
+	       obj))
+
+	  (define* (remove-duplicates sequence from-end (test eql) (start 0) end (key identity))
+	    (let* ((result ())
+		   (start-seq (+ start 1))
+		   (len (length sequence))
+		   (nd (if (number? end) end len)))
+	      (do ((i start (+ i 1)))
+		  ((= i nd))
+		(let* ((orig-obj (sequence i))
+		       (obj (key orig-obj)))
+		  (if (null from-end)
+		      (begin
+			(if (not (find obj sequence :start start-seq :end nd :test test :key key))
+			    (set! result (cons orig-obj result)))
+			(set! start-seq (+ start-seq 1)))
+		      (if (not (find obj result :test test :key key))
+			  (set! result (cons orig-obj result))))))
+	      (let* ((res (reverse result))
+		     (new-len (+ (length result) start (- len nd)))
+		     (new-seq (make sequence new-len)))
+		(let ((n 0))
+		  (do ((i 0 (+ i 1)))
+		      ((= i len) new-seq)
+		    (if (or (< i start)
+			    (>= i nd))
+			(begin
+			  (set! (new-seq n) (sequence i))
+			  (set! n (+ n 1)))
+			(if (not (null? res))
+			    (begin
+			      (set! (new-seq n) (car res))
+			      (set! res (cdr res))
+			      (set! n (+ n 1))))))))))
+
+	  (define-macro* (delete-duplicates sequence from-end (test eql) (start 0) end (key identity))
+	    `(let ((obj (remove-duplicates ,sequence ,from-end ,test ,start ,end ,key)))
+	       (if (symbol? ,sequence)
+		   (set! ,sequence obj))
+	       obj))
+
+
+	  (test-t (equal (remove 4 '(1 3 4 5 9)) '(1 3 5 9)))
+	  (test-t (equal (remove 4 '(1 2 4 1 3 4 5)) '(1 2 1 3 5)))
+	  (test-t (equal (remove 4 '(1 2 4 1 3 4 5) :count 1) '(1 2 1 3 4 5)))
+	  (test-t (equal (remove 4 '(1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 5)))
+	  (test-t (equal (remove 3 '(1 2 4 1 3 4 5) :test >) '(4 3 4 5)))
+	  (test-t (let* ((lst '(list of four elements)) (lst2 (copy lst)) (lst3 (delete 'four lst))) (and (equal lst3 '(list of elements)) (not (equal lst lst2)))))
+	  (test-t (equal (remove-if oddp '(1 2 4 1 3 4 5)) '(2 4 4)))
+	  (test-t (equal (remove-if evenp '(1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 5)))
+	  (test-t (equal (remove-if-not evenp '(1 2 3 4 5 6 7 8 9) :count 2 :from-end t) '(1 2 3 4 5 6 8)))
+	  (test-t (equal (delete 4 (list 1 2 4 1 3 4 5)) '(1 2 1 3 5)))
+	  (test-t (equal (delete 4 (list 1 2 4 1 3 4 5) :count 1) '(1 2 1 3 4 5)))
+	  (test-t (equal (delete 4 (list 1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 5)))
+	  (test-t (equal (delete 3 (list 1 2 4 1 3 4 5) :test >) '(4 3 4 5)))
+	  (test-t (equal (delete-if oddp (list 1 2 4 1 3 4 5)) '(2 4 4)))
+	  (test-t (equal (delete-if evenp (list 1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 5)))
+	  (test-t (equal (delete-if evenp (list 1 2 3 4 5 6)) '(1 3 5)))
+	  (test-t (let* ((list0 (list 0 1 2 3 4)) (list (remove 3 list0))) (and (not (eq list0 list)) (equal list0 '(0 1 2 3 4)) (equal list '(0 1 2 4)))))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c)) '(b c b c)))
+	  (test-t (equal (remove 'b (list 'a 'b 'c 'a 'b 'c)) '(a c a c)))
+	  (test-t (equal (remove 'c (list 'a 'b 'c 'a 'b 'c)) '(a b a b)))
+	  (test-t (equal (remove 'a (list 'a 'a 'a)) ()))
+	  (test-t (equal (remove 'z (list 'a 'b 'c)) '(a b c)))
+	  (test-t (equal (remove 'a ()) ()))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c)))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c)))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c)))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c)))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c)))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c)))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c)))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c)))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c)))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c)))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c)))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c)))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c)))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c)))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c)))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c)))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c)))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c)))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c)))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c)))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c)))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c)))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c)))
+	  (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c)))
+	  (test-t (equal (remove 'a (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c))))
+	  (test-t (equal (remove 'a (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c))))
+	  (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal) ()))
+	  (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1) '(("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t) '(("Love") ("LOve") ("LOVe"))))
+	  (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 2 :from-end t) '(("Love") ("LOve"))))
+	  (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :start 1 :end 3) '(("Love") ("LOVE"))))
+	  (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE"))))
+	  (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE"))))
+	  (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE"))))
+	  (test-t (let* ((vector0 (vector 0 1 2 3 4)) (vector (remove 3 vector0))) (and (not (eq vector0 vector)) (equalp vector0 #(0 1 2 3 4)) (equalp vector #(0 1 2 4)))))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c)) #(b c b c)))
+	  (test-t (equalp (remove 'b (vector 'a 'b 'c 'a 'b 'c)) #(a c a c)))
+	  (test-t (equalp (remove 'c (vector 'a 'b 'c 'a 'b 'c)) #(a b a b)))
+	  (test-t (equalp (remove 'a (vector 'a 'a 'a)) #()))
+	  (test-t (equalp (remove 'z (vector 'a 'b 'c)) #(a b c)))
+	  (test-t (equalp (remove 'a #()) #()))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c)))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c)))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c)))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c)))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c)))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c)))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c)))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c)))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c)))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c)))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c)))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c)))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c)))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c)))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c)))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c)))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c)))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c)))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c)))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (remove 'a (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c))))
+	  (test-t (equalp (remove 'a (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c))))
+	  (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal) #()))
+	  (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1) #(("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
+	  (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 2 :from-end t) #(("Love") ("LOve"))))
+	  (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :start 1 :end 3) #(("Love") ("LOVE"))))
+	  (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE"))))
+	  (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE"))))
+	  (test-t (string= (remove #\a (copy "abcabc")) "bcbc"))
+	  (test-t (string= (remove #\a (copy "")) ""))
+	  (test-t (string= (remove #\a (copy "xyz")) "xyz"))
+	  (test-t (string= (remove #\a (copy "ABCABC")) "ABCABC"))
+	  (test-t (string= (remove #\a (copy "ABCABC") :key char-downcase) "BCBC"))
+	  (test-t (string= (remove #\a (copy "abcabc") :count 1) "bcabc"))
+	  (test-t (string= (remove #\a (copy "abcabc") :count 1 :from-end t) "abcbc"))
+	  (test-t (string= (remove #\a (copy "abcabc") :count 0) "abcabc"))
+	  (test-t (string= (remove #\a (copy "abcabc") :count -10) "abcabc"))
+	  (test-t (let* ((str0 (copy "abc")) (str (remove #\a str0))) (and (not (eq str0 str)) (string= str0 "abc") (string= str "bc"))))
+	  (test-t (string= (remove #\a (copy "abcabc") :count 0) "abcabc"))
+	  (test-t (string= (remove #\a (copy "abcabc")) "bcbc"))
+	  (test-t (string= (remove #\b (copy "abcabc")) "acac"))
+	  (test-t (string= (remove #\c (copy "abcabc")) "abab"))
+	  (test-t (string= (remove #\a (copy "abcabc") :count 0) "abcabc"))
+	  (test-t (string= (remove #\a (copy "abcabc") :count 1) "bcabc"))
+	  (test-t (string= (remove #\a (copy "abcabc") :count 1 :from-end t) "abcbc"))
+	  (test-t (string= (remove #\a (copy "abcabc") :count 2) "bcbc"))
+	  (test-t (string= (remove #\a (copy "abcabc") :count 2 :from-end t) "bcbc"))
+	  (test-t (string= (remove #\a (copy "abcabc") :count 3) "bcbc"))
+	  (test-t (string= (remove #\a (copy "abcabc") :count 3 :from-end t) "bcbc"))
+	  (test-t (string= (remove #\a (copy "abcabc") :count 4) "bcbc"))
+	  (test-t (string= (remove #\a (copy "abcabc") :count 4 :from-end t) "bcbc"))
+	  (test-t (string= (remove #\a (copy "abcabc") :count -1) "abcabc"))
+	  (test-t (string= (remove #\a (copy "abcabc") :count -10) "abcabc"))
+	  (test-t (string= (remove #\a (copy "abcabc") :count -100) "abcabc"))
+	  (test-t (string= (remove #\a (copy "abcabcabcabc") :start 1) "abcbcbcbc"))
+	  (test-t (string= (remove #\a (copy "abcabcabcabc") :start 1 :count 1) "abcbcabcabc"))
+	  (test-t (string= (remove #\a (copy "abcabcabcabc") :start 1 :count 2) "abcbcbcabc"))
+	  (test-t (string= (remove #\a (copy "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc"))
+	  (test-t (string= (remove #\a (copy "abcabcabcabc") :start 1 :end 8) "abcbcbcabc"))
+	  (test-t (string= (remove #\a (copy "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc"))
+	  (test-t (string= (remove #\a (copy "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc"))
+	  (test-t (string= (remove #\a (copy "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc"))
+	  (test-t (string= (remove #\a (copy "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc"))
+	  (test-t (string= (remove #\a (copy "abcabcabcabc") :start 1 :end 1) "abcabcabcabc"))
+	  (test-t (string= (remove #\a (copy "abcabcabcabc") :start 2 :end 2) "abcabcabcabc"))
+	  (test-t (string= (remove #\a (copy "abcabcabcabc") :start 12 :end 12) "abcabcabcabc"))
+	  (test-t (let* ((list0 (list 0 1 2 3 4)) (list (remove-if (lambda (arg) (eql arg 3)) list0))) (and (not (eq list0 list)) (equal list0 '(0 1 2 3 4)) (equal list '(0 1 2 4)))))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)) '(b c b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'b)) (list 'a 'b 'c 'a 'b 'c)) '(a c a c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'c)) (list 'a 'b 'c 'a 'b 'c)) '(a b a b)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'a 'a)) ()))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'z)) (list 'a 'b 'c)) '(a b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) ()) ()))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c)))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c))))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c))))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equal (remove-if (lambda (arg) (eql arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) ()))
+	  (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) '(("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) '(("Love") ("LOve") ("LOVe"))))
+	  (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) '(("Love") ("LOve"))))
+	  (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) '(("Love") ("LOVE"))))
+	  (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE"))))
+	  (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE"))))
+	  (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE"))))
+	  (test-t (let* ((vector0 (vector 0 1 2 3 4)) (vector (remove-if (lambda (arg) (eql arg 3)) vector0))) (and (not (eq vector0 vector)) (equalp vector0 #(0 1 2 3 4)) (equalp vector #(0 1 2 4)))))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c)) #(b c b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'b)) (vector 'a 'b 'c 'a 'b 'c)) #(a c a c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'c)) (vector 'a 'b 'c 'a 'b 'c)) #(a b a b)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'a 'a)) #()))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'z)) (vector 'a 'b 'c)) #(a b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) #()) #()))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c))))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c))))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (remove-if (lambda (arg) (eql arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
+	  (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
+	  (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
+	  (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
+	  (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
+	  (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
+	  (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) #(("Love") ("LOVE"))))
+	  (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE"))))
+	  (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE"))))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc")) "bcbc"))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "")) ""))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "xyz")) "xyz"))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "ABCABC") :key char-downcase) "BCBC"))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 1) "bcabc"))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 1 :from-end t) "abcbc"))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 0) "abcabc"))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count -10) "abcabc"))
+	  (test-t (let* ((str0 (copy "abc")) (str (remove-if (lambda (arg) (string-equal arg #\a)) str0))) (and (not (eq str0 str)) (string= str0 "abc") (string= str "bc"))))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 0) "abcabc"))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc")) "bcbc"))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\b)) (copy "abcabc")) "acac"))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\c)) (copy "abcabc")) "abab"))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 0) "abcabc"))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 1) "bcabc"))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 1 :from-end t) "abcbc"))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 2) "bcbc"))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 2 :from-end t) "bcbc"))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 3) "bcbc"))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 3 :from-end t) "bcbc"))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 4) "bcbc"))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 4 :from-end t) "bcbc"))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count -1) "abcabc"))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count -10) "abcabc"))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count -100) "abcabc"))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabcabcabc") :start 1) "abcbcbcbc"))
+	  (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabcabcabc") :start 1 :count 1) "abcbcabcabc"))
+	  (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :count 2) "abcbcbcabc"))
+	  (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc"))
+	  (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 8) "abcbcbcabc"))
+	  (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc"))
+	  (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc"))
+	  (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc"))
+	  (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc"))
+	  (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 1) "abcabcabcabc"))
+	  (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 2 :end 2) "abcabcabcabc"))
+	  (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 12 :end 12) "abcabcabcabc"))
+	  (test-t (let* ((list0 (list 0 1 2 3 4)) (list (remove-if-not (lambda (arg) (not (eql arg 3))) list0))) (and (not (eq list0 list)) (equal list0 '(0 1 2 3 4)) (equal list '(0 1 2 4)))))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c)) '(b c b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'b))) (list 'a 'b 'c 'a 'b 'c)) '(a c a c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'c))) (list 'a 'b 'c 'a 'b 'c)) '(a b a b)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'a 'a)) ()))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'z))) (list 'a 'b 'c)) '(a b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) ()) ()))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c)))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c))))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c))))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (eql arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) ()))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) '(("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) '(("Love") ("LOve") ("LOVe"))))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) '(("Love") ("LOve"))))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) '(("Love") ("LOVE"))))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE"))))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE"))))
+	  (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE"))))
+	  (test-t (let* ((vector0 (vector 0 1 2 3 4)) (vector (remove-if-not (lambda (arg) (not (eql arg 3))) vector0))) (and (not (eq vector0 vector)) (equalp vector0 #(0 1 2 3 4)) (equalp vector #(0 1 2 4)))))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c)) #(b c b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'b))) (vector 'a 'b 'c 'a 'b 'c)) #(a c a c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'c))) (vector 'a 'b 'c 'a 'b 'c)) #(a b a b)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'a 'a)) #()))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'z))) (vector 'a 'b 'c)) #(a b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) #()) #()))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c))))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c))))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) #(("Love") ("LOVE"))))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE"))))
+	  (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE"))))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc")) "bcbc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "")) ""))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "xyz")) "xyz"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "ABCABC") :key char-downcase) "BCBC"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 1) "bcabc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 1 :from-end t) "abcbc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 0) "abcabc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count -10) "abcabc"))
+	  (test-t (let* ((str0 (copy "abc")) (str (remove-if-not (lambda (arg) (not (string-equal arg #\a))) str0))) (and (not (eq str0 str)) (string= str0 "abc") (string= str "bc"))))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 0) "abcabc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc")) "bcbc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\b))) (copy "abcabc")) "acac"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\c))) (copy "abcabc")) "abab"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 0) "abcabc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 1) "bcabc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 1 :from-end t) "abcbc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 2) "bcbc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 2 :from-end t) "bcbc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 3) "bcbc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 3 :from-end t) "bcbc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 4) "bcbc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 4 :from-end t) "bcbc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count -1) "abcabc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count -10) "abcabc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count -100) "abcabc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabcabcabc") :start 1) "abcbcbcbc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabcabcabc") :start 1 :count 1) "abcbcabcabc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :count 2) "abcbcbcabc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 8) "abcbcbcabc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 1) "abcabcabcabc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 2 :end 2) "abcabcabcabc"))
+	  (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 12 :end 12) "abcabcabcabc"))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c)) '(b c b c)))
+	  (test-t (equal (delete 'b (list 'a 'b 'c 'a 'b 'c)) '(a c a c)))
+	  (test-t (equal (delete 'c (list 'a 'b 'c 'a 'b 'c)) '(a b a b)))
+	  (test-t (equal (delete 'a (list 'a 'a 'a)) ()))
+	  (test-t (equal (delete 'z (list 'a 'b 'c)) '(a b c)))
+	  (test-t (equal (delete 'a ()) ()))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c)))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c)))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c)))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c)))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c)))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c)))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c)))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c)))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c)))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c)))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c)))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c)))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c)))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c)))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c)))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c)))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c)))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c)))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c)))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c)))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c)))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c)))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c)))
+	  (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c)))
+	  (test-t (equal (delete 'a (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c))))
+	  (test-t (equal (delete 'a (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c))))
+	  (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal) ()))
+	  (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1) '(("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t) '(("Love") ("LOve") ("LOVe"))))
+	  (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 2 :from-end t) '(("Love") ("LOve"))))
+	  (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :start 1 :end 3) '(("Love") ("LOVE"))))
+	  (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE"))))
+	  (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE"))))
+	  (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE"))))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c)) #(b c b c)))
+	  (test-t (equalp (delete 'b (vector 'a 'b 'c 'a 'b 'c)) #(a c a c)))
+	  (test-t (equalp (delete 'c (vector 'a 'b 'c 'a 'b 'c)) #(a b a b)))
+	  (test-t (equalp (delete 'a (vector 'a 'a 'a)) #()))
+	  (test-t (equalp (delete 'z (vector 'a 'b 'c)) #(a b c)))
+	  (test-t (equalp (delete 'a #()) #()))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c)))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c)))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c)))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c)))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c)))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c)))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c)))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c)))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c)))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c)))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c)))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c)))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c)))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c)))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c)))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c)))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c)))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c)))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c)))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (delete 'a (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c))))
+	  (test-t (equalp (delete 'a (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c))))
+	  (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal) #()))
+	  (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1) #(("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
+	  (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 2 :from-end t) #(("Love") ("LOve"))))
+	  (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :start 1 :end 3) #(("Love") ("LOVE"))))
+	  (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE"))))
+	  (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE"))))
+	  (test-t (string= (delete #\a (copy "abcabc")) "bcbc"))
+	  (test-t (string= (delete #\a (copy "")) ""))
+	  (test-t (string= (delete #\a (copy "xyz")) "xyz"))
+	  (test-t (string= (delete #\a (copy "ABCABC")) "ABCABC"))
+	  (test-t (string= (delete #\a (copy "ABCABC") :key char-downcase) "BCBC"))
+	  (test-t (string= (delete #\a (copy "abcabc") :count 1) "bcabc"))
+	  (test-t (string= (delete #\a (copy "abcabc") :count 1 :from-end t) "abcbc"))
+	  (test-t (string= (delete #\a (copy "abcabc") :count 0) "abcabc"))
+	  (test-t (string= (delete #\a (copy "abcabc") :count -10) "abcabc"))
+	  (test-t (string= (delete #\a (copy "abcabc") :count 0) "abcabc"))
+	  (test-t (string= (delete #\a (copy "abcabc")) "bcbc"))
+	  (test-t (string= (delete #\b (copy "abcabc")) "acac"))
+	  (test-t (string= (delete #\c (copy "abcabc")) "abab"))
+	  (test-t (string= (delete #\a (copy "abcabc") :count 0) "abcabc"))
+	  (test-t (string= (delete #\a (copy "abcabc") :count 1) "bcabc"))
+	  (test-t (string= (delete #\a (copy "abcabc") :count 1 :from-end t) "abcbc"))
+	  (test-t (string= (delete #\a (copy "abcabc") :count 2) "bcbc"))
+	  (test-t (string= (delete #\a (copy "abcabc") :count 2 :from-end t) "bcbc"))
+	  (test-t (string= (delete #\a (copy "abcabc") :count 3) "bcbc"))
+	  (test-t (string= (delete #\a (copy "abcabc") :count 3 :from-end t) "bcbc"))
+	  (test-t (string= (delete #\a (copy "abcabc") :count 4) "bcbc"))
+	  (test-t (string= (delete #\a (copy "abcabc") :count 4 :from-end t) "bcbc"))
+	  (test-t (string= (delete #\a (copy "abcabc") :count -1) "abcabc"))
+	  (test-t (string= (delete #\a (copy "abcabc") :count -10) "abcabc"))
+	  (test-t (string= (delete #\a (copy "abcabc") :count -100) "abcabc"))
+	  (test-t (string= (delete #\a (copy "abcabcabcabc") :start 1) "abcbcbcbc"))
+	  (test-t (string= (delete #\a (copy "abcabcabcabc") :start 1 :count 1) "abcbcabcabc"))
+	  (test-t (string= (delete #\a (copy "abcabcabcabc") :start 1 :count 2) "abcbcbcabc"))
+	  (test-t (string= (delete #\a (copy "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc"))
+	  (test-t (string= (delete #\a (copy "abcabcabcabc") :start 1 :end 8) "abcbcbcabc"))
+	  (test-t (string= (delete #\a (copy "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc"))
+	  (test-t (string= (delete #\a (copy "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc"))
+	  (test-t (string= (delete #\a (copy "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc"))
+	  (test-t (string= (delete #\a (copy "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc"))
+	  (test-t (string= (delete #\a (copy "abcabcabcabc") :start 1 :end 1) "abcabcabcabc"))
+	  (test-t (string= (delete #\a (copy "abcabcabcabc") :start 2 :end 2) "abcabcabcabc"))
+	  (test-t (string= (delete #\a (copy "abcabcabcabc") :start 12 :end 12) "abcabcabcabc"))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)) '(b c b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'b)) (list 'a 'b 'c 'a 'b 'c)) '(a c a c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'c)) (list 'a 'b 'c 'a 'b 'c)) '(a b a b)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'a 'a)) ()))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'z)) (list 'a 'b 'c)) '(a b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) ()) ()))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c)))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c))))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c))))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equal (delete-if (lambda (arg) (eql arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) ()))
+	  (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) '(("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) '(("Love") ("LOve") ("LOVe"))))
+	  (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) '(("Love") ("LOve"))))
+	  (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) '(("Love") ("LOVE"))))
+	  (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE"))))
+	  (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE"))))
+	  (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE"))))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c)) #(b c b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'b)) (vector 'a 'b 'c 'a 'b 'c)) #(a c a c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'c)) (vector 'a 'b 'c 'a 'b 'c)) #(a b a b)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'a 'a)) #()))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'z)) (vector 'a 'b 'c)) #(a b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) #()) #()))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c))))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c))))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (delete-if (lambda (arg) (eql arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
+	  (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
+	  (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
+	  (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
+	  (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
+	  (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
+	  (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) #(("Love") ("LOVE"))))
+	  (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE"))))
+	  (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE"))))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc")) "bcbc"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "")) ""))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "xyz")) "xyz"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "ABCABC") :key char-downcase) "BCBC"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 1) "bcabc"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 1 :from-end t) "abcbc"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 0) "abcabc"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count -10) "abcabc"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 0) "abcabc"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc")) "bcbc"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\b)) (copy "abcabc")) "acac"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\c)) (copy "abcabc")) "abab"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 0) "abcabc"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 1) "bcabc"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 1 :from-end t) "abcbc"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 2) "bcbc"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 2 :from-end t) "bcbc"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 3) "bcbc"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 3 :from-end t) "bcbc"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 4) "bcbc"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 4 :from-end t) "bcbc"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count -1) "abcabc"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count -10) "abcabc"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count -100) "abcabc"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabcabcabc") :start 1) "abcbcbcbc"))
+	  (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabcabcabc") :start 1 :count 1) "abcbcabcabc"))
+	  (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :count 2) "abcbcbcabc"))
+	  (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc"))
+	  (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 8) "abcbcbcabc"))
+	  (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc"))
+	  (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc"))
+	  (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc"))
+	  (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc"))
+	  (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 1) "abcabcabcabc"))
+	  (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 2 :end 2) "abcabcabcabc"))
+	  (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 12 :end 12) "abcabcabcabc"))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c)) '(b c b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'b))) (list 'a 'b 'c 'a 'b 'c)) '(a c a c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'c))) (list 'a 'b 'c 'a 'b 'c)) '(a b a b)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'a 'a)) ()))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'z))) (list 'a 'b 'c)) '(a b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) ()) ()))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c)))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c))))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c))))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (eql arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) ()))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) '(("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) '(("Love") ("LOve") ("LOVe"))))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) '(("Love") ("LOve"))))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) '(("Love") ("LOVE"))))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE"))))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE"))))
+	  (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE"))))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c)) #(b c b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'b))) (vector 'a 'b 'c 'a 'b 'c)) #(a c a c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'c))) (vector 'a 'b 'c 'a 'b 'c)) #(a b a b)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'a 'a)) #()))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'z))) (vector 'a 'b 'c)) #(a b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) #()) #()))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c)))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c))))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c))))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) #(("Love") ("LOVE"))))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE"))))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE"))))
+	  (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE"))))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc")) "bcbc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "")) ""))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "xyz")) "xyz"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "ABCABC") :key char-downcase) "BCBC"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 1) "bcabc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 1 :from-end t) "abcbc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 0) "abcabc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count -10) "abcabc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 0) "abcabc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc")) "bcbc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\b))) (copy "abcabc")) "acac"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\c))) (copy "abcabc")) "abab"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 0) "abcabc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 1) "bcabc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 1 :from-end t) "abcbc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 2) "bcbc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 2 :from-end t) "bcbc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 3) "bcbc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 3 :from-end t) "bcbc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 4) "bcbc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 4 :from-end t) "bcbc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count -1) "abcabc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count -10) "abcabc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count -100) "abcabc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabcabcabc") :start 1) "abcbcbcbc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabcabcabc") :start 1 :count 1) "abcbcabcabc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :count 2) "abcbcbcabc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 8) "abcbcbcabc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 1) "abcabcabcabc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 2 :end 2) "abcabcabcabc"))
+	  (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 12 :end 12) "abcabcabcabc"))
+	  (test-t (equal (remove-duplicates "aBcDAbCd" :test char-equal :from-end t) "aBcD"))
+	  (test-t (equal (remove-duplicates '(a b c b d d e)) '(a c b d e)))
+	  (test-t (equal (remove-duplicates '(a b c b d d e) :from-end t) '(a b c d e)))
+	  (test-t (let* ((list0 (list 0 1 2 3 4 5 6)) (list (delete-duplicates list0 :key oddp :start 1 :end 6))) (equal list '(0 4 5 6))))
+	  (test-t (let* ((list0 (list 2 1 0 1 0 1 2)) (list (remove-duplicates list0))) (and (not (eq list0 list)) (equal list0 '(2 1 0 1 0 1 2)) (equal list '(0 1 2)))))
+	  (test-t (let* ((vector0 (vector 2 1 0 1 0 1 2)) (vector (remove-duplicates vector0))) (and (not (eq vector0 vector)) (equalp vector0 #(2 1 0 1 0 1 2)) (equalp vector #(0 1 2)))))
+	  (test-t (equal (remove-duplicates (list 0 1 2 2 3 3 3)) '(0 1 2 3)))
+	  (test-t (equal (remove-duplicates (list 0 0 0 2 0 1 1 2 2 2 1 1 1 1 2)) '(0 1 2)))
+	  (test-t (equal (remove-duplicates (list 'a 'a 'b 'c 'c)) '(a b c)))
+	  (test-t (equal (remove-duplicates (list 0 1 2)) '(0 1 2)))
+	  (test-t (equal (remove-duplicates (list 2 0 2 1 1 1 0 0 0 1 2)) '(0 1 2)))
+	  (test-t (equal (remove-duplicates (list)) ()))
+	  (test-t (equal (remove-duplicates (list '(x . 0) '(y . 1) '(z . 2) '(a . 0) '(b . 1) '(c . 2)) :key cdr) '((a . 0) (b . 1) (c . 2))))
+	  (test-t (equal (remove-duplicates (list '(x . 0) '(y . 1) '(z . 2) '(a . 0) '(b . 1) '(c . 2)) :key cdr :test (lambda (a b) (and (oddp a) (oddp b)))) '((x . 0) (z . 2) (a . 0) (b . 1) (c . 2))))
+	  (test-t (equal (remove-duplicates (list '(x . 0) '(y . 1) '(z . 2) '(a . 0) '(b . 1) '(c . 2)) :key cdr :test (lambda (a b) (and (evenp a) (evenp b)))) '((y . 1) (b . 1) (c . 2))))
+	  (test-t (equal (remove-duplicates (list 0 1 2 0 1 2 0 1 2 0 1 2) :start 3 :end 9) '(0 1 2 0 1 2 0 1 2)))
+	  (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11))) (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11))))
+	  (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :key car) '((0 . 9) (1 . 10) (2 . 11))))
+	  (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :key car :from-end t) (list '(0 . 0) '(1 . 1) '(2 . 2))))
+	  (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :start 3 :key car) (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 9) '(1 . 10) '(2 . 11))))
+	  (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :start 3 :key car :from-end t) (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5))))
+	  (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :start 3 :end nil :key car) (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 9) '(1 . 10) '(2 . 11))))
+	  (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :start 3 :end 9 :key car) '((0 . 0) (1 . 1) (2 . 2) (0 . 6) (1 . 7) (2 . 8) (0 . 9) (1 . 10) (2 . 11))))
+	  (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :start 3 :end 9 :key car :from-end t) (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 9) '(1 . 10) '(2 . 11))))
+	  (test-t (equal (remove-duplicates (list "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday") :key length) (list "Tuesday" "Wednesday" "Saturday" "Sunday")))
+	  (test-t (equal (remove-duplicates (list "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday") :key (lambda (arg) (char arg 0)) :test char=) (list "Monday" "Wednesday" "Thursday" "Friday" "Sunday")))
+	  (test-t (equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C) :key char-upcase) '(#\A #\B #\C)))
+	  (test-t (equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C) :key char-upcase :from-end t) '(#\a #\b #\c)))
+	  (test-t (equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C) :test char=) (list #\a #\b #\c #\A #\B #\C)))
+	  (test-t (equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C) :test char-equal) (list #\A #\B #\C)))
+	  (test-t (equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C) :test char-equal :from-end t) (list #\a #\b #\c)))
+	  (test-t (equal (remove-duplicates (list #\a #\1 #\b #\1 #\2 #\c #\0 #\A #\0 #\B #\C #\9) :key alpha-char-p) (list #\C #\9)))
+	  (test-t (equal (remove-duplicates (list #\a #\1 #\b #\1 #\2 #\c #\0 #\A #\0 #\B #\C #\9) :key alphanumericp) (list #\9)))
+	  (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
+	  (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car) (list '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
+	  (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3 :end 9) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
+	  (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3 :end 9 :test char-equal) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
+	  (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3 :end 9 :test char-equal :from-end t) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
+	  (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
+	  (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3 :end nil) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
+	  (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3 :from-end t) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8))))
+	  (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :end 9) (list '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
+	  (test-t (equalp (remove-duplicates (vector 0 1 2 2 3 3 3)) #(0 1 2 3)))
+	  (test-t (equalp (remove-duplicates (vector 0 0 0 2 0 1 1 2 2 2 1 1 1 1 2)) #(0 1 2)))
+	  (test-t (equalp (remove-duplicates (vector 'a 'a 'b 'c 'c)) #(a b c)))
+	  (test-t (equalp (remove-duplicates (vector 0 1 2)) #(0 1 2)))
+	  (test-t (equalp (remove-duplicates (vector 2 0 2 1 1 1 0 0 0 1 2)) #(0 1 2)))
+	  (test-t (equalp (remove-duplicates (vector)) #()))
+	  (test-t (equalp (remove-duplicates (vector '(x . 0) '(y . 1) '(z . 2) '(a . 0) '(b . 1) '(c . 2)) :key cdr) #((a . 0) (b . 1) (c . 2))))
+	  (test-t (equalp (remove-duplicates (vector 0 1 2 0 1 2 0 1 2 0 1 2) :start 3 :end 9) #(0 1 2 0 1 2 0 1 2)))
+	  (test-t (equalp (remove-duplicates (vector "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday") :key length) (vector "Tuesday" "Wednesday" "Saturday" "Sunday")))
+	  (test-t (equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C) :key char-upcase) #(#\A #\B #\C)))
+	  (test-t (equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C) :key char-upcase :from-end t) #(#\a #\b #\c)))
+	  (test-t (equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C) :test char=) (vector #\a #\b #\c #\A #\B #\C)))
+	  (test-t (equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C) :test char-equal) (vector #\A #\B #\C)))
+	  (test-t (equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C) :test char-equal :from-end t) (vector #\a #\b #\c)))
+	  (test-t (equalp (remove-duplicates (vector #\a #\1 #\b #\1 #\2 #\c #\0 #\A #\0 #\B #\C #\9) :key alpha-char-p) (vector #\C #\9)))
+	  (test-t (equalp (remove-duplicates (vector #\a #\1 #\b #\1 #\2 #\c #\0 #\A #\0 #\B #\C #\9) :key alphanumericp) (vector #\9)))
+	  (test-t (string= (remove-duplicates (copy "")) ""))
+	  (test-t (string= (remove-duplicates (copy "abc")) "abc"))
+	  (test-t (string= (remove-duplicates (copy "abcabc")) "abc"))
+	  (test-t (string= (remove-duplicates (copy "cbaabc")) "abc"))
+	  (test-t (string= (remove-duplicates (copy "cbaabc") :from-end t) "cba"))
+	  (test-t (string= (remove-duplicates (copy "cbaabcABCCBA")) "abcCBA"))
+	  (test-t (string= (remove-duplicates (copy "cbaabcABCCBA") :from-end t) "cbaABC"))
+	  (test-t (string= (remove-duplicates (copy "cbaabcABCCBA") :key char-downcase) "CBA"))
+	  (test-t (string= (remove-duplicates (copy "cbaabcABCCBA") :key char-downcase :from-end t) "cba"))
+	  (test-t (string= (remove-duplicates (copy "cbaabcABCCBA") :start 3) "cbaabcCBA"))
+	  (test-t (string= (remove-duplicates (copy "cbaabcABCCBA") :start 3 :from-end t) "cbaabcABC"))
+	  (test-t (string= (remove-duplicates (copy "cbaabcABCCBA") :start 3 :end 9) "cbaabcABCCBA"))
+	  (test-t (string= (remove-duplicates (copy "cbaabcABCCBA") :start 3 :end 9 :key char-upcase) "cbaABCCBA"))
+	  (test-t (string= (remove-duplicates (copy "cbaabcABCCBA") :start 3 :end 9 :key char-upcase :from-end t) "cbaabcCBA"))
+	  (test-t (string= (remove-duplicates (copy "cbaabcABCCBA") :start 3 :end 9 :test char-equal :from-end t) "cbaabcCBA"))
+	  (test-t (string= (remove-duplicates (copy "cbaabcABCCBA") :start 3 :end 9 :key upper-case-p :test eq) "cbacCCBA"))
+	  (test-t (string= (remove-duplicates (copy "cbaabcABCCBA") :start 3 :end 9 :key upper-case-p :test eq :from-end t) "cbaaACBA"))
+	  )
+
+	(let ()
+	  (define* (merge result-type seq1 seq2 predicate (key identity))
+	    (let* ((len1 (length seq1))
+		   (len2 (length seq2))
+		   (size (+ len1 len2))
+		   (obj (make-sequence result-type size))
+		   (i 0)
+		   (j 0))
+	      (do ((n 0 (+ n 1)))
+		  ((or (= i len1)
+		       (= j len2))
+		   (if (< i len1)
+		       (do ((k i (+ k 1)))
+			   ((= k len1) obj)
+			 (set! (obj n) (seq1 k))
+			 (set! n (+ n 1)))
+		       (if (< j len2)
+			   (do ((k j (+ k 1)))
+			       ((= k len2) obj)
+			     (set! (obj n) (seq2 k))
+			     (set! n (+ n 1)))
+			   obj)))
+		(if (null (predicate (key (seq1 i)) (key (seq2 j))))
+		    (begin
+		      (set! (obj n) (seq2 j))
+		      (set! j (+ j 1)))
+		    (begin
+		      (set! (obj n) (seq1 i))
+		      (set! i (+ i 1)))))))
+
+	  (test-t (let ((test1 (list 1 3 4 6 7)) (test2 (list 2 5 8))) (equal (merge 'list test1 test2 <) '(1 2 3 4 5 6 7 8))))
+	  (test-t (let ((test1 (vector '(red . 1) '(blue . 4))) (test2 (vector '(yellow . 2) '(green . 7)))) (equalp (merge 'vector test1 test2 < :key cdr) #((red . 1) (yellow . 2) (blue . 4) (green . 7)))))
+	  (test-t (equal (merge 'list (list 1 3 5 7 9) (list 0 2 4 6 8) <) '(0 1 2 3 4 5 6 7 8 9)))
+	  (test-t (equal (merge 'list (list 0 1 2) nil <) '(0 1 2)))
+	  (test-t (equal (merge 'list nil (list 0 1 2) <) '(0 1 2)))
+	  (test-t (equal (merge 'list nil nil <) nil))
+	  (test-t (equal (merge 'list (list '(1 1) '(2 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
+	  (test-t (equal (merge 'list (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
+	  (test-t (equal (merge 'list (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
+	  (test-t (equal (merge 'list (list 3 1 9 5 7) (list 8 6 0 2 4) <) '(3 1 8 6 0 2 4 9 5 7)))
+	  (test-t (equal (merge 'list (vector 1 3 5 7 9) (list 0 2 4 6 8) <) '(0 1 2 3 4 5 6 7 8 9)))
+	  (test-t (equal (merge 'list (vector 0 1 2) nil <) '(0 1 2)))
+	  (test-t (equal (merge 'list #() (list 0 1 2) <) '(0 1 2)))
+	  (test-t (equal (merge 'list #() #() <) nil))
+	  (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
+	  (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
+	  (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
+	  (test-t (equal (merge 'list (vector 3 1 9 5 7) (list 8 6 0 2 4) <) '(3 1 8 6 0 2 4 9 5 7)))
+	  (test-t (equal (merge 'list (list 1 3 5 7 9) (vector 0 2 4 6 8) <) '(0 1 2 3 4 5 6 7 8 9)))
+	  (test-t (equal (merge 'list (list 0 1 2) #() <) '(0 1 2)))
+	  (test-t (equal (merge 'list nil (vector 0 1 2) <) '(0 1 2)))
+	  (test-t (equal (merge 'list nil #() <) nil))
+	  (test-t (equal (merge 'list (list '(1 1) '(2 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
+	  (test-t (equal (merge 'list (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
+	  (test-t (equal (merge 'list (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
+	  (test-t (equal (merge 'list (list 3 1 9 5 7) (vector 8 6 0 2 4) <) '(3 1 8 6 0 2 4 9 5 7)))
+	  (test-t (equal (merge 'list (vector 1 3 5 7 9) (vector 0 2 4 6 8) <) '(0 1 2 3 4 5 6 7 8 9)))
+	  (test-t (equal (merge 'list (vector 0 1 2) #() <) '(0 1 2)))
+	  (test-t (equal (merge 'list #() (vector 0 1 2) <) '(0 1 2)))
+	  (test-t (equal (merge 'list #() #() <) nil))
+	  (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
+	  (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
+	  (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
+	  (test-t (equal (merge 'list (vector 3 1 9 5 7) (vector 8 6 0 2 4) <) '(3 1 8 6 0 2 4 9 5 7)))
+	  (test-t (equalp (merge 'vector (list 1 3 5 7 9) (list 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9)))
+	  (test-t (equalp (merge 'vector (list 1 3 5 7 9) (list 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9)))
+	  (test-t (equalp (merge 'vector (list 0 1 2) nil <) #(0 1 2)))
+	  (test-t (equalp (merge 'vector nil (list 0 1 2) <) #(0 1 2)))
+	  (test-t (equalp (merge 'vector nil nil <) #()))
+	  (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
+	  (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
+	  (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
+	  (test-t (equalp (merge 'vector (list 3 1 9 5 7) (list 8 6 0 2 4) <) #(3 1 8 6 0 2 4 9 5 7)))
+	  (test-t (equalp (merge 'vector (vector 1 3 5 7 9) (list 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9)))
+	  (test-t (equalp (merge 'vector (vector 1 3 5 7 9) (list 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9)))
+	  (test-t (equalp (merge 'vector (vector 0 1 2) nil <) #(0 1 2)))
+	  (test-t (equalp (merge 'vector #() (list 0 1 2) <) #(0 1 2)))
+	  (test-t (equalp (merge 'vector #() #() <) #()))
+	  (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
+	  (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
+	  (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
+	  (test-t (equalp (merge 'vector (vector 3 1 9 5 7) (list 8 6 0 2 4) <) #(3 1 8 6 0 2 4 9 5 7)))
+	  (test-t (equalp (merge 'vector (list 1 3 5 7 9) (vector 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9)))
+	  (test-t (equalp (merge 'vector (list 1 3 5 7 9) (vector 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9)))
+	  (test-t (equalp (merge 'vector (list 0 1 2) #() <) #(0 1 2)))
+	  (test-t (equalp (merge 'vector nil (vector 0 1 2) <) #(0 1 2)))
+	  (test-t (equalp (merge 'vector nil #() <) #()))
+	  (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
+	  (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
+	  (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
+	  (test-t (equalp (merge 'vector (list 3 1 9 5 7) (vector 8 6 0 2 4) <) #(3 1 8 6 0 2 4 9 5 7)))
+	  (test-t (equalp (merge 'vector (vector 1 3 5 7 9) (vector 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9)))
+	  (test-t (equalp (merge 'vector (vector 0 1 2) #() <) #(0 1 2)))
+	  (test-t (equalp (merge 'vector #() (vector 0 1 2) <) #(0 1 2)))
+	  (test-t (equalp (merge 'vector #() #() <) #()))
+	  (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
+	  (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
+	  (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
+	  (test-t (equalp (merge 'vector (vector 3 1 9 5 7) (vector 8 6 0 2 4) <) #(3 1 8 6 0 2 4 9 5 7)))
+	  (test-t (string= (merge 'string (list #\a #\c #\e) (list #\b #\d #\f) char<) "abcdef"))
+	  (test-t (string= (merge 'string (list #\a #\b #\c) (list #\d #\e #\f) char<) "abcdef"))
+	  (test-t (string= (merge 'string (list #\a #\b #\c) () char<) "abc"))
+	  (test-t (string= (merge 'string () (list #\a #\b #\c) char<) "abc"))
+	  (test-t (string= (merge 'string (list #\a #\b #\c) (copy "") char<) "abc"))
+	  (test-t (string= (merge 'string (list #\a #\b #\z) #(#\c #\x #\y) char<) "abcxyz"))
+	)
+
+	(let ()
+	  (define* (search seq1 seq2 from-end (test eql) (key identity) (start1 0) (start2 0) end1 end2)
+	    (let* ((len1 (length seq1))
+		   (len2 (length seq2))
+		   (nd1 (or (and (number? end1) end1) len1))
+		   (nd2 (or (and (number? end2) end2) len2)))
+	      (set! len1 (min len1 (- nd1 start1)))
+	      (set! len2 (min len2 (- nd2 start2)))
+	      (if (or (= len2 0)
+		      (> len1 len2))
+		  ()
+		  (call-with-exit
+		   (lambda (return)
+		     (if (or (not from-end) (null? from-end))
+			 (do ((i start2 (+ i 1)))
+			     ((> i (- nd2 len1)) ())
+			   (do ((j start1 (+ j 1))
+				(k i (+ k 1)))
+			       ((or (= j nd1)
+				    (not (test (key (seq1 j)) (key (seq2 k)))))
+				(if (= j nd1)
+				    (return i)))))
+			 (do ((i (- nd2 len1) (- i 1)))
+			     ((< i start2) ())
+			   (do ((j start1 (+ j 1))
+				(k i (+ k 1)))
+			       ((or (= j nd1)
+				    (not (test (key (seq1 j)) (key (seq2 k)))))
+				(if (= j nd1)
+				    (return i)))))))))))
+
+	  (define* (mismatch seq1 seq2 from-end (test eql) (key identity) (start1 0) (start2 0) end1 end2)
+	    (let* ((nd1 (or (and (number? end1) end1) (length seq1)))
+		   (nd2 (or (and (number? end2) end2) (length seq2))))
+	      (if (not from-end)
+		  (do ((i start1 (+ i 1))
+		       (j start2 (+ j 1)))
+		      ((or (= i nd1)
+			   (= j nd2)
+			   (not (test (key (seq1 i)) (key (seq2 j)))))
+		       (if (and (= i nd1) (= j nd2))
+			   ()
+			   i)))
+		  (do ((i (- nd1 1) (- i 1))
+		       (j (- nd2 1) (- j 1)))
+		      ((or (< i start1)
+			   (< j start2)
+			   (not (test (key (seq1 i)) (key (seq2 j)))))
+		       (if (and (< i start1) (< j start2))
+			   ()
+			   (+ i 1)))))))
+
+	  (test-t (eql (search "dog" "it's a dog's life") 7))
+	  (test-t (eql (search '(0 1) '(2 4 6 1 3 5) :key oddp) 2))
+	  (test-t (null (search '(a b c) '(x y z))))
+	  (test-t (eql (search () '(x y z)) 0))
+	  (test-t (eql (search '(a) '(a)) 0))
+	  (test-t (eql (search '(a b c) '(a b c x y z)) 0))
+	  (test-t (eql (search '(a b c) '(x a b c y z)) 1))
+	  (test-t (eql (search '(a b c) '(x y a b c z)) 2))
+	  (test-t (eql (search '(a b c) '(x y z a b c)) 3))
+	  (test-t (eql (search '(a b c) '(a b c a b c) :start2 1) 3))
+	  (test-t (eql (search '(a b c) '(a b c a b c) :start2 1 :end2 nil) 3))
+	  (test-t (eql (search '(a b c) '(a b c a b c) :start1 1 :start2 1 :end2 nil) 1))
+	  (test-t (eql (search '(a b c) '(a b c a b c) :start1 1 :end1 nil :start2 1 :end2 nil) 1))
+	  (test-t (null (search '(a b c) '(a b c a b c) :start2 0 :end2 0)))
+	  (test-t (null (search '(a b c) '(a b c a b c) :start2 1 :end2 1)))
+	  (test-t (null (search '(a b c) '(a b c a b c) :start2 2 :end2 2)))
+	  (test-t (null (search '(a b c) '(a b c a b c) :start2 3 :end2 3)))
+	  (test-t (null (search '(a b c) '(a b c a b c) :start2 4 :end2 4)))
+	  (test-t (null (search '(a b c) '(a b c a b c) :start2 5 :end2 5)))
+	  (test-t (null (search '(a b c) '(a b c a b c) :start2 6 :end2 6)))
+	  (test-t (eql (search '(a b c) '(a b c a b c)) 0))
+	  (test-t (eql (search '(a b c) '(a b c a b c) :from-end t) 3))
+	  (test-t (eql (search '(a b c) '(a b c a b c) :start2 3 :end2 6) 3))
+	  (test-t (eql (search '(a b c) '(a b c a b c) :start2 3 :end2 6 :from-end t) 3))
+	  (test-t (eql (search '(a b c) '(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6) 0))
+	  (test-t (eql (search '(a b c) '(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6 :from-end t) 3))
+	  (test-t (null (search '(#\a #\b #\c) '(#\A #\B #\C))))
+	  (test-t (eql (search '(#\a #\b #\c) '(#\A #\B #\C) :test char-equal) 0))
+	  (test-t (eql (search '(#\a #\b) '(#\a #\b #\x #\y #\z)) 0))
+	  (test-t (eql (search '(#\a #\b) '(#\a #\b #\x #\y #\z) :test char<) 1))
+	  (test-t (null (search '((a) (b)) '((x) (y) (z) (a) (b) (c)))))
+	  (test-t (eql (search '((a) (b)) '((x) (y) (z) (a) (b) (c)) :key car) 3))
+	  (test-t (eql (search '((a) (b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
+	  (test-t (eql (search '((a) (b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car :from-end t) 6))
+	  (test-t (eql (search '((a a) (b b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
+	  (test-t (eql (search '((a a) (b b)) '((a nil) (b t) (c nil) (x) (y) (z) (a 0) (b 1) (c 2)) :key car :from-end t) 6))
+	  (test-t (eql (search '(("a" a) ("b" b))
+			       '(("a" nil) ("b" t) ("c" nil) ("x") ("y") ("z")
+				 ("A" 0) ("B" 1) ("C" 2))
+			       :start1 1
+			       :end1 2
+			       :start2 3
+			       :end2 nil
+			       :key car
+			       :test string-equal
+			       :from-end t)
+		       7))
+	  (test-t (null (search #(a b c) '(x y z))))
+	  (test-t (eql (search #() '(x y z)) 0))
+	  (test-t (eql (search #(a) '(a)) 0))
+	  (test-t (eql (search #(a b c) '(a b c x y z)) 0))
+	  (test-t (eql (search #(a b c) '(x a b c y z)) 1))
+	  (test-t (eql (search #(a b c) '(x y a b c z)) 2))
+	  (test-t (eql (search #(a b c) '(x y z a b c)) 3))
+	  (test-t (eql (search #(a b c) '(a b c a b c) :start2 1) 3))
+	  (test-t (eql (search #(a b c) '(a b c a b c) :start2 1 :end2 nil) 3))
+	  (test-t (eql (search #(a b c) '(a b c a b c) :start1 1 :start2 1 :end2 nil) 1))
+	  (test-t (eql (search #(a b c) '(a b c a b c) :start1 1 :end1 nil :start2 1 :end2 nil) 1))
+	  (test-t (null (search #(a b c) '(a b c a b c) :start2 0 :end2 0)))
+	  (test-t (null (search #(a b c) '(a b c a b c) :start2 1 :end2 1)))
+	  (test-t (null (search #(a b c) '(a b c a b c) :start2 2 :end2 2)))
+	  (test-t (null (search #(a b c) '(a b c a b c) :start2 3 :end2 3)))
+	  (test-t (null (search #(a b c) '(a b c a b c) :start2 4 :end2 4)))
+	  (test-t (null (search #(a b c) '(a b c a b c) :start2 5 :end2 5)))
+	  (test-t (null (search #(a b c) '(a b c a b c) :start2 6 :end2 6)))
+	  (test-t (eql (search #(a b c) '(a b c a b c)) 0))
+	  (test-t (eql (search #(a b c) '(a b c a b c) :from-end t) 3))
+	  (test-t (eql (search #(a b c) '(a b c a b c) :start2 3 :end2 6) 3))
+	  (test-t (eql (search #(a b c) '(a b c a b c) :start2 3 :end2 6 :from-end t) 3))
+	  (test-t (eql (search #(a b c) '(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6) 0))
+	  (test-t (eql (search #(a b c) '(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6 :from-end t) 3))
+	  (test-t (null (search #(#\a #\b #\c) '(#\A #\B #\C))))
+	  (test-t (eql (search #(#\a #\b #\c) '(#\A #\B #\C) :test char-equal) 0))
+	  (test-t (eql (search #(#\a #\b) '(#\a #\b #\x #\y #\z)) 0))
+	  (test-t (eql (search #(#\a #\b) '(#\a #\b #\x #\y #\z) :test char<) 1))
+	  (test-t (null (search #((a) (b)) '((x) (y) (z) (a) (b) (c)))))
+	  (test-t (eql (search #((a) (b)) '((x) (y) (z) (a) (b) (c)) :key car) 3))
+	  (test-t (eql (search #((a) (b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
+	  (test-t (eql (search #((a) (b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car :from-end t) 6))
+	  (test-t (eql (search #((a a) (b b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
+	  (test-t (eql (search #((a a) (b b)) '((a nil) (b t) (c nil) (x) (y) (z) (a 0) (b 1) (c 2)) :key car :from-end t) 6))
+	  (test-t (eql (search #(("a" a) ("b" b))
+			       '(("a" nil) ("b" t) ("c" nil) ("x") ("y") ("z")
+				 ("A" 0) ("B" 1) ("C" 2))
+			       :start1 1
+			       :end1 2
+			       :start2 3
+			       :end2 nil
+			       :key car
+			       :test string-equal
+			       :from-end t)
+		       7))
+	  (test-t (null (search '(a b c) #(x y z))))
+	  (test-t (eql (search () #(x y z)) 0))
+	  (test-t (eql (search '(a) #(a)) 0))
+	  (test-t (eql (search '(a b c) #(a b c x y z)) 0))
+	  (test-t (eql (search '(a b c) #(x a b c y z)) 1))
+	  (test-t (eql (search '(a b c) #(x y a b c z)) 2))
+	  (test-t (eql (search '(a b c) #(x y z a b c)) 3))
+	  (test-t (eql (search '(a b c) #(a b c a b c) :start2 1) 3))
+	  (test-t (eql (search '(a b c) #(a b c a b c) :start2 1 :end2 nil) 3))
+	  (test-t (eql (search '(a b c) #(a b c a b c) :start1 1 :start2 1 :end2 nil) 1))
+	  (test-t (eql (search '(a b c) #(a b c a b c) :start1 1 :end1 nil :start2 1 :end2 nil) 1))
+	  (test-t (null (search '(a b c) #(a b c a b c) :start2 0 :end2 0)))
+	  (test-t (null (search '(a b c) #(a b c a b c) :start2 1 :end2 1)))
+	  (test-t (null (search '(a b c) #(a b c a b c) :start2 2 :end2 2)))
+	  (test-t (null (search '(a b c) #(a b c a b c) :start2 3 :end2 3)))
+	  (test-t (null (search '(a b c) #(a b c a b c) :start2 4 :end2 4)))
+	  (test-t (null (search '(a b c) #(a b c a b c) :start2 5 :end2 5)))
+	  (test-t (null (search '(a b c) #(a b c a b c) :start2 6 :end2 6)))
+	  (test-t (eql (search '(a b c) #(a b c a b c)) 0))
+	  (test-t (eql (search '(a b c) #(a b c a b c) :from-end t) 3))
+	  (test-t (eql (search '(a b c) #(a b c a b c) :start2 3 :end2 6) 3))
+	  (test-t (eql (search '(a b c) #(a b c a b c) :start2 3 :end2 6 :from-end t) 3))
+	  (test-t (eql (search '(a b c) #(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6) 0))
+	  (test-t (eql (search '(a b c) #(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6 :from-end t) 3))
+	  (test-t (null (search '(#\a #\b #\c) #(#\A #\B #\C))))
+	  (test-t (eql (search '(#\a #\b #\c) #(#\A #\B #\C) :test char-equal) 0))
+	  (test-t (eql (search '(#\a #\b) #(#\a #\b #\x #\y #\z)) 0))
+	  (test-t (eql (search '(#\a #\b) #(#\a #\b #\x #\y #\z) :test char<) 1))
+	  (test-t (null (search '((a) (b)) #((x) (y) (z) (a) (b) (c)))))
+	  (test-t (eql (search '((a) (b)) #((x) (y) (z) (a) (b) (c)) :key car) 3))
+	  (test-t (eql (search '((a) (b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
+	  (test-t (eql (search '((a) (b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car :from-end t) 6))
+	  (test-t (eql (search '((a a) (b b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
+	  (test-t (eql (search '((a a) (b b)) #((a nil) (b t) (c nil) (x) (y) (z) (a 0) (b 1) (c 2)) :key car :from-end t) 6))
+	  (test-t (eql (search '(("a" a) ("b" b))
+			       #(("a" nil) ("b" t) ("c" nil) ("x") ("y") ("z")
+				 ("A" 0) ("B" 1) ("C" 2))
+			       :start1 1
+			       :end1 2
+			       :start2 3
+			       :end2 nil
+			       :key car
+			       :test string-equal
+			       :from-end t)
+		       7))
+	  (test-t (null (search #(a b c) #(x y z))))
+	  (test-t (eql (search #() #(x y z)) 0))
+	  (test-t (eql (search #(a) #(a)) 0))
+	  (test-t (eql (search #(a b c) #(a b c x y z)) 0))
+	  (test-t (eql (search #(a b c) #(x a b c y z)) 1))
+	  (test-t (eql (search #(a b c) #(x y a b c z)) 2))
+	  (test-t (eql (search #(a b c) #(x y z a b c)) 3))
+	  (test-t (eql (search #(a b c) #(a b c a b c) :start2 1) 3))
+	  (test-t (eql (search #(a b c) #(a b c a b c) :start2 1 :end2 nil) 3))
+	  (test-t (eql (search #(a b c) #(a b c a b c) :start1 1 :start2 1 :end2 nil) 1))
+	  (test-t (eql (search #(a b c) #(a b c a b c) :start1 1 :end1 nil :start2 1 :end2 nil) 1))
+	  (test-t (null (search #(a b c) #(a b c a b c) :start2 0 :end2 0)))
+	  (test-t (null (search #(a b c) #(a b c a b c) :start2 1 :end2 1)))
+	  (test-t (null (search #(a b c) #(a b c a b c) :start2 2 :end2 2)))
+	  (test-t (null (search #(a b c) #(a b c a b c) :start2 3 :end2 3)))
+	  (test-t (null (search #(a b c) #(a b c a b c) :start2 4 :end2 4)))
+	  (test-t (null (search #(a b c) #(a b c a b c) :start2 5 :end2 5)))
+	  (test-t (null (search #(a b c) #(a b c a b c) :start2 6 :end2 6)))
+	  (test-t (eql (search #(a b c) #(a b c a b c)) 0))
+	  (test-t (eql (search #(a b c) #(a b c a b c) :from-end t) 3))
+	  (test-t (eql (search #(a b c) #(a b c a b c) :start2 3 :end2 6) 3))
+	  (test-t (eql (search #(a b c) #(a b c a b c) :start2 3 :end2 6 :from-end t) 3))
+	  (test-t (eql (search #(a b c) #(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6) 0))
+	  (test-t (eql (search #(a b c) #(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6 :from-end t) 3))
+	  (test-t (null (search #(#\a #\b #\c) #(#\A #\B #\C))))
+	  (test-t (eql (search #(#\a #\b #\c) #(#\A #\B #\C) :test char-equal) 0))
+	  (test-t (eql (search #(#\a #\b) #(#\a #\b #\x #\y #\z)) 0))
+	  (test-t (eql (search #(#\a #\b) #(#\a #\b #\x #\y #\z) :test char<) 1))
+	  (test-t (null (search #((a) (b)) #((x) (y) (z) (a) (b) (c)))))
+	  (test-t (eql (search #((a) (b)) #((x) (y) (z) (a) (b) (c)) :key car) 3))
+	  (test-t (eql (search #((a) (b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
+	  (test-t (eql (search #((a) (b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car :from-end t) 6))
+	  (test-t (eql (search #((a a) (b b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
+	  (test-t (eql (search #((a a) (b b)) #((a nil) (b t) (c nil) (x) (y) (z) (a 0) (b 1) (c 2)) :key car :from-end t) 6))
+	  (test-t (eql (search #(("a" a) ("b" b))
+			       #(("a" nil) ("b" t) ("c" nil) ("x") ("y") ("z")
+				 ("A" 0) ("B" 1) ("C" 2))
+			       :start1 1
+			       :end1 2
+			       :start2 3
+			       :end2 nil
+			       :key car
+			       :test string-equal
+			       :from-end t)
+		       7))
+	  (test-t (null (search "peace" "LOVE&PEACE")))
+	  (test-t (eql (search "peace" "LOVE&PEACE" :test char-equal) 5))
+	  (test-t (null (search "PeAcE" "LoVe&pEaCe")))
+	  (test-t (eql (search "PeAcE" "LoVe&pEaCe" :key char-upcase) 5))
+	  (test-t (eql (search "abc" "abc xyz abc" :from-end t) 8))
+	  (test-t (eql (search "abc" "abc xyz abc xyz abc xyz abc" :start2 8 :end2 19) 8))
+	  (test-t (eql (search "abc" "abc xyz abc xyz abc xyz abc" :from-end t :start2 8 :end2 19) 16))
+	  (test-t (eql (mismatch "abcd" "ABCDE" :test char-equal) 4))
+	  (test-t (eql (mismatch '(3 2 1 1 2 3) '(1 2 3) :from-end t) 3))
+	  (test-t (null (mismatch '(1 2 3 4 5 6) '(3 4 5 6 7) :start1 2 :end2 4)))
+	  (test-t (null (mismatch () ())))
+	  (test-t (eql (mismatch '(a b c) '(x y z)) 0))
+	  (test-t (eql (mismatch () '(x y z)) 0))
+	  (test-t (eql (mismatch '(x y z) ()) 0))
+	  (test-t (null (mismatch '(a) '(a))))
+	  (test-t (eql (mismatch '(a b c x y z) '(a b c)) 3))
+	  (test-t (null (mismatch '(a b c) '(a b c))))
+	  (test-t (eql (mismatch '(a b c d e f) '(a b c)) 3))
+	  (test-t (eql (mismatch '(a b c) '(a b c d e f)) 3))
+	  (test-t (eql (mismatch '(a b c) '(a b x)) 2))
+	  (test-t (eql (mismatch '(a b c) '(a x c)) 1))
+	  (test-t (eql (mismatch '(a b c) '(x b c)) 0))
+	  (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 3) 6))
+	  (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 3 :end1 nil) 6))
+	  (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 3 :end1 4) 4))
+	  (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 3 :end1 3) 3))
+	  (test-t (null (mismatch '(x y z) () :start1 0 :end1 0)))
+	  (test-t (null (mismatch '(x y z) () :start1 1 :end1 1)))
+	  (test-t (null (mismatch '(x y z) () :start1 2 :end1 2)))
+	  (test-t (null (mismatch '(x y z) () :start1 3 :end1 3)))
+	  (test-t (null (mismatch '(x y z) () :start1 0 :end1 0 :start2 0 :end2 0)))
+	  (test-t (null (mismatch '(x y z) () :start1 1 :end1 1 :start2 1 :end2 1)))
+	  (test-t (null (mismatch '(x y z) () :start1 2 :end1 2 :start2 2 :end2 2)))
+	  (test-t (null (mismatch '(x y z) () :start1 3 :end1 3 :start2 3 :end2 3)))
+	  (test-t (null (mismatch '(x y z) () :start1 0 :end1 0 :start2 3 :end2 3)))
+	  (test-t (null (mismatch '(x y z) () :start1 1 :end1 1 :start2 2 :end2 2)))
+	  (test-t (null (mismatch '(x y z) () :start1 2 :end1 2 :start2 1 :end2 1)))
+	  (test-t (null (mismatch '(x y z) () :start1 3 :end1 3 :start2 0 :end2 0)))
+	  (test-t (eql (mismatch '(x y z) '(a b c) :start1 0 :end1 0) 0))
+	  (test-t (eql (mismatch '(x y z) '(a b c) :start1 1 :end1 1) 1))
+	  (test-t (eql (mismatch '(x y z) '(a b c) :start1 2 :end1 2) 2))
+	  (test-t (eql (mismatch '(x y z) '(a b c) :start1 3 :end1 3) 3))
+	  (test-t (eql (mismatch '(x y z) '(x y z) :start1 0 :end1 1) 1))
+	  (test-t (eql (mismatch '(x y z) '(x y z) :start1 0 :end1 2) 2))
+	  (test-t (eql (mismatch '(x y z) '(x y z Z) :start1 0 :end1 3) 3))
+	  (test-t (null (mismatch '(x y z) '(x y z) :start1 0 :end1 3)))
+	  (test-t (eql (mismatch '(a b c x y z) '(x y z a b c)) 0))
+	  (test-t (eql (mismatch '(a b c x y z) '(x y z a b c) :start1 3) 6))
+	  (test-t (eql (mismatch '(a b c x y z a b c) '(x y z a b c x y z) :start1 3) 9))
+	  (test-t (eql (mismatch '(a b c x y z a b c) '(x y z a b c x y z) :start1 6) 6))
+	  (test-t (eql (mismatch '(a b c x y z a b c) '(x y z a b c x y z) :start1 6 :start2 3) 9))
+	  (test-t (eql (mismatch '(a b c x y z a b c) '(x y z a b c x y z) :start1 0 :start2 3) 6))
+	  (test-t (eql (mismatch '(a b c) '(a b c x y z)) 3))
+	  (test-t (eql (mismatch '(a b c) '(x a b c y z)) 0))
+	  (test-t (eql (mismatch '(a b c) '(x a b c y z) :start2 1) 3))
+	  (test-t (eql (mismatch '(a b c) '(x a b c y z) :start2 1 :end2 nil) 3))
+	  (test-t (null (mismatch '(a b c) '(x a b c y z) :start2 1 :end2 4)))
+	  (test-t (eql (mismatch '(a b c d e) '(c d)) 0))
+	  (test-t (eql (mismatch '(a b c d e) '(c d) :start1 2) 4))
+	  (test-t (eql (mismatch '(a b c d e) '(c d) :start1 2 :end1 3) 3))
+	  (test-t (eql (mismatch '(a b c d e) '(c d) :start1 2 :start2 1) 2))
+	  (test-t (eql (mismatch '(a b c d e) '(c d) :start1 3 :start2 1) 4))
+	  (test-t (eql (mismatch '(a b c d e) '(c d) :start1 2 :end2 1) 3))
+	  (test-t (null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 2 :start2 1 :end2 2)))
+	  (test-t (null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 3 :start2 1 :end2 3)))
+	  (test-t (null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 4 :start2 1 :end2 4)))
+	  (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 1) 1))
+	  (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 2) 2))
+	  (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 3) 3))
+	  (test-t (null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 4)))
+	  (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 1 :start2 1) 1))
+	  (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 2 :start2 1) 2))
+	  (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 3 :start2 1) 3))
+	  (test-t (null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 4 :start2 1)))
+	  (test-t (null (mismatch '(a b c) '(a b c) :from-end t)))
+	  (test-t (eql (mismatch '(a b c d) '(a b c) :from-end t) 4))
+	  (test-t (eql (mismatch '(a b c) '(c) :from-end t) 2))
+	  (test-t (eql (mismatch '(a b c) '(z a b c) :from-end t) 0))
+	  (test-t (eql (mismatch '(a b c) '(x y z a b c) :from-end t) 0))
+	  (test-t (eql (mismatch '(x y z a b c) '(a b c) :from-end t) 3))
+	  (test-t (eql (mismatch '(x y z a b c) '(a b c) :end1 3 :from-end t) 3))
+	  (test-t (eql (mismatch '(x y z a b c) '(a b c) :end1 5 :from-end t) 5))
+	  (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :end1 6 :from-end t) 3))
+	  (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 2 :end1 6 :from-end t) 3))
+	  (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :from-end t :start1 2 :end1 5 :start2 1 :end2 2 ) 4))
+	  (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 2 :end1 5 :start2 1 :end2 2 ) 2))
+	  (test-t (eql (mismatch '((a) (b) (c)) '((a) (b) (c))) 0))
+	  (test-t (null (mismatch '((a) (b) (c)) '((a) (b) (c)) :key car)))
+	  (test-t (null (mismatch '((a) (b) (c)) '((a) (b) (c)) :test equal)))
+	  (test-t (eql (mismatch '(#(a) #(b) #(c)) '(#(a) #(b) #(c))) 0))
+	  (test-t (null (mismatch '(#(a) #(b) #(c)) '(#(a) #(b) #(c)) :test equalp)))
+	  (test-t (eql (mismatch '((a) (b) (c) (d)) '((a) (b) (c)) :key car) 3))
+	  (test-t (eql (mismatch '((a) (b) (c)) '((a) (b) (c) (d)) :key car) 3))
+	  (test-t (eql (mismatch '(#\a #\b #\c) '(#\A #\B #\C)) 0))
+	  (test-t (null (mismatch '(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase)))
+	  (test-t (null (mismatch '(#\a #\b #\c) '(#\A #\B #\C) :key char-downcase)))
+	  (test-t (null (mismatch '(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase :start1 1 :end1 2 :start2 1 :end2 2)))
+	  (test-t (null (mismatch '(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase :start1 2 :start2 2)))
+	  (test-t (eql (mismatch '((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f))) 0))
+	  (test-t (eql (mismatch '((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr) 0))
+	  (test-t (null (mismatch '((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr :test equal)))
+	  (test-t (eql (mismatch '((a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal) 3))
+	  (test-t (eql (mismatch '((a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 4))
+	  (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 1))
+	  (test-t (null (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1 :end1 4)))
+	  (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1) 5))
+	  (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :end1 3 :start2 1 :end2 2) 2))
+	  (test-t (null (mismatch #() ())))
+	  (test-t (eql (mismatch #(a b c) '(x y z)) 0))
+	  (test-t (eql (mismatch #() '(x y z)) 0))
+	  (test-t (eql (mismatch #(x y z) ()) 0))
+	  (test-t (null (mismatch #(a) '(a))))
+	  (test-t (eql (mismatch #(a b c x y z) '(a b c)) 3))
+	  (test-t (null (mismatch #(a b c) '(a b c))))
+	  (test-t (eql (mismatch #(a b c d e f) '(a b c)) 3))
+	  (test-t (eql (mismatch #(a b c) '(a b c d e f)) 3))
+	  (test-t (eql (mismatch #(a b c) '(a b x)) 2))
+	  (test-t (eql (mismatch #(a b c) '(a x c)) 1))
+	  (test-t (eql (mismatch #(a b c) '(x b c)) 0))
+	  (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 3) 6))
+	  (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 3 :end1 nil) 6))
+	  (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 3 :end1 4) 4))
+	  (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 3 :end1 3) 3))
+	  (test-t (null (mismatch #(x y z) () :start1 0 :end1 0)))
+	  (test-t (null (mismatch #(x y z) () :start1 1 :end1 1)))
+	  (test-t (null (mismatch #(x y z) () :start1 2 :end1 2)))
+	  (test-t (null (mismatch #(x y z) () :start1 3 :end1 3)))
+	  (test-t (eql (mismatch #(x y z) '(a b c) :start1 0 :end1 0) 0))
+	  (test-t (eql (mismatch #(x y z) '(a b c) :start1 1 :end1 1) 1))
+	  (test-t (eql (mismatch #(x y z) '(a b c) :start1 2 :end1 2) 2))
+	  (test-t (eql (mismatch #(x y z) '(a b c) :start1 3 :end1 3) 3))
+	  (test-t (eql (mismatch #(x y z) '(x y z) :start1 0 :end1 1) 1))
+	  (test-t (eql (mismatch #(x y z) '(x y z) :start1 0 :end1 2) 2))
+	  (test-t (eql (mismatch #(x y z) '(x y z Z) :start1 0 :end1 3) 3))
+	  (test-t (null (mismatch #(x y z) '(x y z) :start1 0 :end1 3)))
+	  (test-t (eql (mismatch #(a b c x y z) '(x y z a b c)) 0))
+	  (test-t (eql (mismatch #(a b c x y z) '(x y z a b c) :start1 3) 6))
+	  (test-t (eql (mismatch #(a b c x y z a b c) '(x y z a b c x y z) :start1 3) 9))
+	  (test-t (eql (mismatch #(a b c x y z a b c) '(x y z a b c x y z) :start1 6) 6))
+	  (test-t (eql (mismatch #(a b c x y z a b c) '(x y z a b c x y z) :start1 6 :start2 3) 9))
+	  (test-t (eql (mismatch #(a b c x y z a b c) '(x y z a b c x y z) :start1 0 :start2 3) 6))
+	  (test-t (eql (mismatch #(a b c) '(a b c x y z)) 3))
+	  (test-t (eql (mismatch #(a b c) '(x a b c y z)) 0))
+	  (test-t (eql (mismatch #(a b c) '(x a b c y z) :start2 1) 3))
+	  (test-t (eql (mismatch #(a b c) '(x a b c y z) :start2 1 :end2 nil) 3))
+	  (test-t (null (mismatch #(a b c) '(x a b c y z) :start2 1 :end2 4)))
+	  (test-t (eql (mismatch #(a b c d e) '(c d)) 0))
+	  (test-t (eql (mismatch #(a b c d e) '(c d) :start1 2) 4))
+	  (test-t (eql (mismatch #(a b c d e) '(c d) :start1 2 :end1 3) 3))
+	  (test-t (eql (mismatch #(a b c d e) '(c d) :start1 2 :start2 1) 2))
+	  (test-t (eql (mismatch #(a b c d e) '(c d) :start1 3 :start2 1) 4))
+	  (test-t (eql (mismatch #(a b c d e) '(c d) :start1 2 :end2 1) 3))
+	  (test-t (null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 2 :start2 1 :end2 2)))
+	  (test-t (null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 3 :start2 1 :end2 3)))
+	  (test-t (null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 4 :start2 1 :end2 4)))
+	  (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 1) 1))
+	  (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 2) 2))
+	  (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 3) 3))
+	  (test-t (null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 4)))
+	  (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 1 :start2 1) 1))
+	  (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 2 :start2 1) 2))
+	  (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 3 :start2 1) 3))
+	  (test-t (null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 4 :start2 1)))
+	  (test-t (null (mismatch #(a b c) '(a b c) :from-end t)))
+	  (test-t (eql (mismatch #(a b c d) '(a b c) :from-end t) 4))
+	  (test-t (eql (mismatch #(a b c) '(c) :from-end t) 2))
+	  (test-t (eql (mismatch #(a b c) '(z a b c) :from-end t) 0))
+	  (test-t (eql (mismatch #(a b c) '(x y z a b c) :from-end t) 0))
+	  (test-t (eql (mismatch #(x y z a b c) '(a b c) :from-end t) 3))
+	  (test-t (eql (mismatch #(x y z a b c) '(a b c) :end1 3 :from-end t) 3))
+	  (test-t (eql (mismatch #(x y z a b c) '(a b c) :end1 5 :from-end t) 5))
+	  (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :end1 6 :from-end t) 3))
+	  (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 2 :end1 6 :from-end t) 3))
+	  (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :from-end t :start1 2 :end1 5 :start2 1 :end2 2 ) 4))
+	  (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 2 :end1 5 :start2 1 :end2 2 ) 2))
+	  (test-t (eql (mismatch #((a) (b) (c)) '((a) (b) (c))) 0))
+	  (test-t (null (mismatch #((a) (b) (c)) '((a) (b) (c)) :key car)))
+	  (test-t (null (mismatch #((a) (b) (c)) '((a) (b) (c)) :test equal)))
+	  (test-t (eql (mismatch #(#(a) #(b) #(c)) '(#(a) #(b) #(c))) 0))
+	  (test-t (null (mismatch #(#(a) #(b) #(c)) '(#(a) #(b) #(c)) :test equalp)))
+	  (test-t (eql (mismatch #((a) (b) (c) (d)) '((a) (b) (c)) :key car) 3))
+	  (test-t (eql (mismatch #((a) (b) (c)) '((a) (b) (c) (d)) :key car) 3))
+	  (test-t (eql (mismatch #(#\a #\b #\c) '(#\A #\B #\C)) 0))
+	  (test-t (null (mismatch #(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase)))
+	  (test-t (null (mismatch #(#\a #\b #\c) '(#\A #\B #\C) :key char-downcase)))
+	  (test-t (null (mismatch #(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase :start1 1 :end1 2 :start2 1 :end2 2)))
+	  (test-t (null (mismatch #(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase :start1 2 :start2 2)))
+	  (test-t (eql (mismatch #((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f))) 0))
+	  (test-t (eql (mismatch #((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr) 0))
+	  (test-t (null (mismatch #((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr :test equal)))
+	  (test-t (eql (mismatch #((a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal) 3))
+	  (test-t (eql (mismatch #((a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 4))
+	  (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 1))
+	  (test-t (null (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1 :end1 4)))
+	  (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1) 5))
+	  (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :end1 3 :start2 1 :end2 2) 2))
+	  (test-t (null (mismatch () #())))
+	  (test-t (eql (mismatch '(a b c) #(x y z)) 0))
+	  (test-t (eql (mismatch () #(x y z)) 0))
+	  (test-t (eql (mismatch '(x y z) #()) 0))
+	  (test-t (null (mismatch '(a) #(a))))
+	  (test-t (eql (mismatch '(a b c x y z) #(a b c)) 3))
+	  (test-t (null (mismatch '(a b c) #(a b c))))
+	  (test-t (eql (mismatch '(a b c d e f) #(a b c)) 3))
+	  (test-t (eql (mismatch '(a b c) #(a b c d e f)) 3))
+	  (test-t (eql (mismatch '(a b c) #(a b x)) 2))
+	  (test-t (eql (mismatch '(a b c) #(a x c)) 1))
+	  (test-t (eql (mismatch '(a b c) #(x b c)) 0))
+	  (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 3) 6))
+	  (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 3 :end1 nil) 6))
+	  (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 3 :end1 4) 4))
+	  (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 3 :end1 3) 3))
+	  (test-t (null (mismatch '(x y z) #() :start1 0 :end1 0)))
+	  (test-t (null (mismatch '(x y z) #() :start1 1 :end1 1)))
+	  (test-t (null (mismatch '(x y z) #() :start1 2 :end1 2)))
+	  (test-t (null (mismatch '(x y z) #() :start1 3 :end1 3)))
+	  (test-t (eql (mismatch '(x y z) #(a b c) :start1 0 :end1 0) 0))
+	  (test-t (eql (mismatch '(x y z) #(a b c) :start1 1 :end1 1) 1))
+	  (test-t (eql (mismatch '(x y z) #(a b c) :start1 2 :end1 2) 2))
+	  (test-t (eql (mismatch '(x y z) #(a b c) :start1 3 :end1 3) 3))
+	  (test-t (eql (mismatch '(x y z) #(x y z) :start1 0 :end1 1) 1))
+	  (test-t (eql (mismatch '(x y z) #(x y z) :start1 0 :end1 2) 2))
+	  (test-t (eql (mismatch '(x y z) #(x y z Z) :start1 0 :end1 3) 3))
+	  (test-t (null (mismatch '(x y z) #(x y z) :start1 0 :end1 3)))
+	  (test-t (eql (mismatch '(a b c x y z) #(x y z a b c)) 0))
+	  (test-t (eql (mismatch '(a b c x y z) #(x y z a b c) :start1 3) 6))
+	  (test-t (eql (mismatch '(a b c x y z a b c) #(x y z a b c x y z) :start1 3) 9))
+	  (test-t (eql (mismatch '(a b c x y z a b c) #(x y z a b c x y z) :start1 6) 6))
+	  (test-t (eql (mismatch '(a b c x y z a b c) #(x y z a b c x y z) :start1 6 :start2 3) 9))
+	  (test-t (eql (mismatch '(a b c x y z a b c) #(x y z a b c x y z) :start1 0 :start2 3) 6))
+	  (test-t (eql (mismatch '(a b c) #(a b c x y z)) 3))
+	  (test-t (eql (mismatch '(a b c) #(x a b c y z)) 0))
+	  (test-t (eql (mismatch '(a b c) #(x a b c y z) :start2 1) 3))
+	  (test-t (eql (mismatch '(a b c) #(x a b c y z) :start2 1 :end2 nil) 3))
+	  (test-t (null (mismatch '(a b c) #(x a b c y z) :start2 1 :end2 4)))
+	  (test-t (eql (mismatch '(a b c d e) #(c d)) 0))
+	  (test-t (eql (mismatch '(a b c d e) #(c d) :start1 2) 4))
+	  (test-t (eql (mismatch '(a b c d e) #(c d) :start1 2 :end1 3) 3))
+	  (test-t (eql (mismatch '(a b c d e) #(c d) :start1 2 :start2 1) 2))
+	  (test-t (eql (mismatch '(a b c d e) #(c d) :start1 3 :start2 1) 4))
+	  (test-t (eql (mismatch '(a b c d e) #(c d) :start1 2 :end2 1) 3))
+	  (test-t (null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 2 :start2 1 :end2 2)))
+	  (test-t (null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 3 :start2 1 :end2 3)))
+	  (test-t (null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 4 :start2 1 :end2 4)))
+	  (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 1) 1))
+	  (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 2) 2))
+	  (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 3) 3))
+	  (test-t (null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 4)))
+	  (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 1 :start2 1) 1))
+	  (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 2 :start2 1) 2))
+	  (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 3 :start2 1) 3))
+	  (test-t (null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 4 :start2 1)))
+	  (test-t (null (mismatch '(a b c) #(a b c) :from-end t)))
+	  (test-t (eql (mismatch '(a b c d) #(a b c) :from-end t) 4))
+	  (test-t (eql (mismatch '(a b c) #(c) :from-end t) 2))
+	  (test-t (eql (mismatch '(a b c) #(z a b c) :from-end t) 0))
+	  (test-t (eql (mismatch '(a b c) #(x y z a b c) :from-end t) 0))
+	  (test-t (eql (mismatch '(x y z a b c) #(a b c) :from-end t) 3))
+	  (test-t (eql (mismatch '(x y z a b c) #(a b c) :end1 3 :from-end t) 3))
+	  (test-t (eql (mismatch '(x y z a b c) #(a b c) :end1 5 :from-end t) 5))
+	  (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :end1 6 :from-end t) 3))
+	  (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 2 :end1 6 :from-end t) 3))
+	  (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :from-end t :start1 2 :end1 5 :start2 1 :end2 2 ) 4))
+	  (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 2 :end1 5 :start2 1 :end2 2 ) 2))
+	  (test-t (eql (mismatch '((a) (b) (c)) #((a) (b) (c))) 0))
+	  (test-t (null (mismatch '((a) (b) (c)) #((a) (b) (c)) :key car)))
+	  (test-t (null (mismatch '((a) (b) (c)) #((a) (b) (c)) :test equal)))
+	  (test-t (eql (mismatch '(#(a) #(b) #(c)) #(#(a) #(b) #(c))) 0))
+	  (test-t (null (mismatch '(#(a) #(b) #(c)) #(#(a) #(b) #(c)) :test equalp)))
+	  (test-t (eql (mismatch '((a) (b) (c) (d)) #((a) (b) (c)) :key car) 3))
+	  (test-t (eql (mismatch '((a) (b) (c)) #((a) (b) (c) (d)) :key car) 3))
+	  (test-t (eql (mismatch '(#\a #\b #\c) #(#\A #\B #\C)) 0))
+	  (test-t (null (mismatch '(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase)))
+	  (test-t (null (mismatch '(#\a #\b #\c) #(#\A #\B #\C) :key char-downcase)))
+	  (test-t (null (mismatch '(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase :start1 1 :end1 2 :start2 1 :end2 2)))
+	  (test-t (null (mismatch '(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase :start1 2 :start2 2)))
+	  (test-t (eql (mismatch '((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f))) 0))
+	  (test-t (eql (mismatch '((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr) 0))
+	  (test-t (null (mismatch '((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr :test equal)))
+	  (test-t (eql (mismatch '((a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal) 3))
+	  (test-t (eql (mismatch '((a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 4))
+	  (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 1))
+	  (test-t (null (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1 :end1 4)))
+	  (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1) 5))
+	  (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :end1 3 :start2 1 :end2 2) 2))
+	  (test-t (null (mismatch #() #())))
+	  (test-t (eql (mismatch #(a b c) #(x y z)) 0))
+	  (test-t (eql (mismatch #() #(x y z)) 0))
+	  (test-t (eql (mismatch #(x y z) #()) 0))
+	  (test-t (null (mismatch #(a) #(a))))
+	  (test-t (eql (mismatch #(a b c x y z) #(a b c)) 3))
+	  (test-t (null (mismatch #(a b c) #(a b c))))
+	  (test-t (eql (mismatch #(a b c d e f) #(a b c)) 3))
+	  (test-t (eql (mismatch #(a b c) #(a b c d e f)) 3))
+	  (test-t (eql (mismatch #(a b c) #(a b x)) 2))
+	  (test-t (eql (mismatch #(a b c) #(a x c)) 1))
+	  (test-t (eql (mismatch #(a b c) #(x b c)) 0))
+	  (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 3) 6))
+	  (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 3 :end1 nil) 6))
+	  (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 3 :end1 4) 4))
+	  (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 3 :end1 3) 3))
+	  (test-t (null (mismatch #(x y z) #() :start1 0 :end1 0)))
+	  (test-t (null (mismatch #(x y z) #() :start1 1 :end1 1)))
+	  (test-t (null (mismatch #(x y z) #() :start1 2 :end1 2)))
+	  (test-t (null (mismatch #(x y z) #() :start1 3 :end1 3)))
+	  (test-t (eql (mismatch #(x y z) #(a b c) :start1 0 :end1 0) 0))
+	  (test-t (eql (mismatch #(x y z) #(a b c) :start1 1 :end1 1) 1))
+	  (test-t (eql (mismatch #(x y z) #(a b c) :start1 2 :end1 2) 2))
+	  (test-t (eql (mismatch #(x y z) #(a b c) :start1 3 :end1 3) 3))
+	  (test-t (eql (mismatch #(x y z) #(x y z) :start1 0 :end1 1) 1))
+	  (test-t (eql (mismatch #(x y z) #(x y z) :start1 0 :end1 2) 2))
+	  (test-t (eql (mismatch #(x y z) #(x y z Z) :start1 0 :end1 3) 3))
+	  (test-t (null (mismatch #(x y z) #(x y z) :start1 0 :end1 3)))
+	  (test-t (eql (mismatch #(a b c x y z) #(x y z a b c)) 0))
+	  (test-t (eql (mismatch #(a b c x y z) #(x y z a b c) :start1 3) 6))
+	  (test-t (eql (mismatch #(a b c x y z a b c) #(x y z a b c x y z) :start1 3) 9))
+	  (test-t (eql (mismatch #(a b c x y z a b c) #(x y z a b c x y z) :start1 6) 6))
+	  (test-t (eql (mismatch #(a b c x y z a b c) #(x y z a b c x y z) :start1 6 :start2 3) 9))
+	  (test-t (eql (mismatch #(a b c x y z a b c) #(x y z a b c x y z) :start1 0 :start2 3) 6))
+	  (test-t (eql (mismatch #(a b c) #(a b c x y z)) 3))
+	  (test-t (eql (mismatch #(a b c) #(x a b c y z)) 0))
+	  (test-t (eql (mismatch #(a b c) #(x a b c y z) :start2 1) 3))
+	  (test-t (eql (mismatch #(a b c) #(x a b c y z) :start2 1 :end2 nil) 3))
+	  (test-t (null (mismatch #(a b c) #(x a b c y z) :start2 1 :end2 4)))
+	  (test-t (eql (mismatch #(a b c d e) #(c d)) 0))
+	  (test-t (eql (mismatch #(a b c d e) #(c d) :start1 2) 4))
+	  (test-t (eql (mismatch #(a b c d e) #(c d) :start1 2 :end1 3) 3))
+	  (test-t (eql (mismatch #(a b c d e) #(c d) :start1 2 :start2 1) 2))
+	  (test-t (eql (mismatch #(a b c d e) #(c d) :start1 3 :start2 1) 4))
+	  (test-t (eql (mismatch #(a b c d e) #(c d) :start1 2 :end2 1) 3))
+	  (test-t (null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 2 :start2 1 :end2 2)))
+	  (test-t (null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 3 :start2 1 :end2 3)))
+	  (test-t (null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 4 :start2 1 :end2 4)))
+	  (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 1) 1))
+	  (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 2) 2))
+	  (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 3) 3))
+	  (test-t (null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 4)))
+	  (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 1 :start2 1) 1))
+	  (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 2 :start2 1) 2))
+	  (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 3 :start2 1) 3))
+	  (test-t (null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 4 :start2 1)))
+	  (test-t (null (mismatch #(a b c) #(a b c) :from-end t)))
+	  (test-t (eql (mismatch #(a b c d) #(a b c) :from-end t) 4))
+	  (test-t (eql (mismatch #(a b c) #(c) :from-end t) 2))
+	  (test-t (eql (mismatch #(a b c) #(z a b c) :from-end t) 0))
+	  (test-t (eql (mismatch #(a b c) #(x y z a b c) :from-end t) 0))
+	  (test-t (eql (mismatch #(x y z a b c) #(a b c) :from-end t) 3))
+	  (test-t (eql (mismatch #(x y z a b c) #(a b c) :end1 3 :from-end t) 3))
+	  (test-t (eql (mismatch #(x y z a b c) #(a b c) :end1 5 :from-end t) 5))
+	  (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :end1 6 :from-end t) 3))
+	  (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 2 :end1 6 :from-end t) 3))
+	  (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :from-end t :start1 2 :end1 5 :start2 1 :end2 2 ) 4))
+	  (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 2 :end1 5 :start2 1 :end2 2 ) 2))
+	  (test-t (eql (mismatch #((a) (b) (c)) #((a) (b) (c))) 0))
+	  (test-t (null (mismatch #((a) (b) (c)) #((a) (b) (c)) :key car)))
+	  (test-t (null (mismatch #((a) (b) (c)) #((a) (b) (c)) :test equal)))
+	  (test-t (eql (mismatch #(#(a) #(b) #(c)) #(#(a) #(b) #(c))) 0))
+	  (test-t (null (mismatch #(#(a) #(b) #(c)) #(#(a) #(b) #(c)) :test equalp)))
+	  (test-t (eql (mismatch #((a) (b) (c) (d)) #((a) (b) (c)) :key car) 3))
+	  (test-t (eql (mismatch #((a) (b) (c)) #((a) (b) (c) (d)) :key car) 3))
+	  (test-t (eql (mismatch #(#\a #\b #\c) #(#\A #\B #\C)) 0))
+	  (test-t (null (mismatch #(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase)))
+	  (test-t (null (mismatch #(#\a #\b #\c) #(#\A #\B #\C) :key char-downcase)))
+	  (test-t (null (mismatch #(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase :start1 1 :end1 2 :start2 1 :end2 2)))
+	  (test-t (null (mismatch #(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase :start1 2 :start2 2)))
+	  (test-t (eql (mismatch #((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f))) 0))
+	  (test-t (eql (mismatch #((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr) 0))
+	  (test-t (null (mismatch #((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr :test equal)))
+	  (test-t (eql (mismatch #((a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal) 3))
+	  (test-t (eql (mismatch #((a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 4))
+	  (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 1))
+	  (test-t (null (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1 :end1 4)))
+	  (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1) 5))
+	  (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :end1 3 :start2 1 :end2 2) 2))
+	  (test-t (eql (mismatch "abc" "xyz") 0))
+	  (test-t (null (mismatch "" "")))
+	  (test-t (null (mismatch "a" "a")))
+	  (test-t (null (mismatch "abc" "abc")))
+	  (test-t (null (mismatch "abc" "ABC" :key char-downcase)))
+	  (test-t (null (mismatch "abc" "ABC" :test char-equal)))
+	  (test-t (eql (mismatch "abcde" "abc") 3))
+	  (test-t (eql (mismatch "abc" "abcde") 3))
+	  (test-t (eql (mismatch "abc" "abxyz") 2))
+	  (test-t (eql (mismatch "abcde" "abx") 2))
+	  (test-t (null (mismatch "abc" "abc" :from-end t)))
+	  (test-t (eql (mismatch "abcxyz" "xyzxyz" :from-end t) 3))
+	  (test-t (eql (mismatch "abcxyz" "xyz" :from-end t) 3))
+	  (test-t (eql (mismatch "xyz" "abcxyz" :from-end t) 0))
+	  (test-t (eql (mismatch "ayz" "abcxyz" :from-end t) 1))
+	  (test-t (null (mismatch "abc" "xyz" :test char<)))
+	  (test-t (eql (mismatch "abc" "xyz" :test char>) 0))
+	  (test-t (eql (mismatch "abcxyz" "abcdefg") 3))
+	  (test-t (eql (mismatch "1xyz" "22xyz" :from-end t) 1))
+	  )
+
+	;; -------- defstruct
+
+	(define-macro (defstruct struct-name . fields)
+	  (let* ((name (if (list? struct-name) (car struct-name) struct-name))
+		 (sname (if (string? name) name (symbol->string name)))
+
+		 (fsname (if (list? struct-name)
+			     (let ((cname (assoc :conc-name (cdr struct-name))))
+			       (if cname
+				   (symbol->string (cadr cname))
+				   sname))
+			     sname))
+
+		 (make-name (if (list? struct-name)
+				(let ((cname (assoc :constructor (cdr struct-name))))
+				  (if cname
+				      (cadr cname)
+				      (symbol "make-" sname)))
+				(symbol "make-" sname)))
+
+		 (copy-name (if (list? struct-name)
+				(let ((cname (assoc :copier (cdr struct-name))))
+				  (if cname
+				      (cadr cname)
+				      (symbol "copy-" sname)))
+				(symbol "copy-" sname)))
+
+		 (field-names (map (lambda (n)
+				     (symbol->string (if (list? n) (car n) n)))
+				   fields))
+
+		 (field-types (map (lambda (field)
+				     (if (list? field)
+					 (apply (lambda* (val type read-only) type) (cdr field))
+					 #f))
+				   fields))
+
+		 (field-read-onlys (map (lambda (field)
+					  (if (list? field)
+					      (apply (lambda* (val type read-only) read-only) (cdr field))
+					      #f))
+					fields)))
+	    `(begin
+
+	       (define ,(symbol sname "?")
+		 (lambda (obj)
+		   (and (vector? obj)
+			(eq? (obj 0) ',(string->symbol sname)))))
+
+	       (define* (,make-name
+			 ,@(map (lambda (n)
+				  (if (and (list? n)
+					   (>= (length n) 2))
+				      (list (car n) (cadr n))
+				      (list n #f)))
+				fields))
+		 (vector ',(string->symbol sname) ,@(map string->symbol field-names)))
+
+	       (define ,copy-name copy)
+
+	       ,@(map (let ((ctr 1))
+			(lambda (n type read-only)
+			  (let ((val (if read-only
+					 `(define ,(symbol fsname "-" n)
+					    (lambda (arg) (arg ,ctr)))
+					 `(define ,(symbol fsname "-" n)
+					    (dilambda
+					     (lambda (arg) (arg ,ctr))
+					     (lambda (arg val) (set! (arg ,ctr) val)))))))
+			    (set! ctr (+ 1 ctr))
+			    val)))
+		      field-names field-types field-read-onlys))))
+
+	;; not yet implemented: :print-function :include :named :type :initial-offset
+	;;   also the explicit constructor business
+
+	(define-macro (enum . args) ; (enum zero one two)
+	  `(begin
+	     ,@(let ((names ()))
+		 (do ((arg args (cdr arg))
+		      (i 0 (+ i 1)))
+		     ((null? arg) names)
+		   (set! names (cons
+				`(define ,(car arg) ,i)
+				names))))))
+
+	(define-macro (let*-values vals . body)
+	  (let ((args ())
+		(exprs ()))
+	    (for-each
+	     (lambda (arg+expr)
+	       (set! args (cons (car arg+expr) args))
+	       (set! exprs (cons (cadr arg+expr) exprs)))
+	     vals)
+	    (let ((form `((lambda ,(car args) ,@body) ,(car exprs))))
+	      (if (not (null? (cdr args)))
+		  (for-each
+		   (lambda (arg expr)
+		     (set! form `((lambda ,arg ,form) ,expr)))
+		   (cdr args)
+		   (cdr exprs)))
+	      form)))
+
+        (let ()
+
+          ;; this is the nbody computer shootout benchmark taken from mzscheme
+	  (define +days-per-year+ 365.24)
+	  (define +solar-mass+ (* 4 pi pi))
+	  (defstruct body x y z vx vy vz mass)
+
+	  (define *sun*
+	    (make-body 0.0 0.0 0.0 0.0 0.0 0.0 +solar-mass+))
+
+	  (define *jupiter*
+	    (make-body 4.84143144246472090
+		       -1.16032004402742839
+		       -1.03622044471123109e-1
+		       (* 1.66007664274403694e-3 +days-per-year+)
+		       (* 7.69901118419740425e-3 +days-per-year+)
+		       (* -6.90460016972063023e-5 +days-per-year+)
+		       (* 9.54791938424326609e-4 +solar-mass+)))
+
+	  (define *saturn*
+	    (make-body 8.34336671824457987
+		       4.12479856412430479
+		       -4.03523417114321381e-1
+		       (* -2.76742510726862411e-3 +days-per-year+)
+		       (* 4.99852801234917238e-3 +days-per-year+)
+		       (* 2.30417297573763929e-5 +days-per-year+)
+		       (* 2.85885980666130812e-4 +solar-mass+)))
+
+	  (define *uranus*
+	    (make-body 1.28943695621391310e1
+		       -1.51111514016986312e1
+		       -2.23307578892655734e-1
+		       (* 2.96460137564761618e-03 +days-per-year+)
+		       (* 2.37847173959480950e-03 +days-per-year+)
+		       (* -2.96589568540237556e-05 +days-per-year+)
+		       (*  4.36624404335156298e-05 +solar-mass+)))
+
+	  (define *neptune*
+	    (make-body 1.53796971148509165e+01
+		       -2.59193146099879641e+01
+		       1.79258772950371181e-01
+		       (* 2.68067772490389322e-03 +days-per-year+)
+		       (* 1.62824170038242295e-03 +days-per-year+)
+		       (* -9.51592254519715870e-05 +days-per-year+)
+		       (* 5.15138902046611451e-05 +solar-mass+)))
+
+	  (define (offset-momentum system)
+	    (let loop-i ((i system) (px 0.0) (py 0.0) (pz 0.0))
+	      (if (null? i)
+		  (begin
+		    (set! (body-vx (car system)) (/ (- px) +solar-mass+))
+		    (set! (body-vy (car system)) (/ (- py) +solar-mass+))
+		    (set! (body-vz (car system)) (/ (- pz) +solar-mass+)))
+		  (loop-i (cdr i)
+			  (+ px (* (body-vx (car i)) (body-mass (car i))))
+			  (+ py (* (body-vy (car i)) (body-mass (car i))))
+			  (+ pz (* (body-vz (car i)) (body-mass (car i))))))))
+
+	  (define (energy system)
+	    (let loop-o ((o system) (e 0.0))
+	      (if (null? o)
+		  e
+		  (let ((e (+ e (* 0.5 (body-mass (car o))
+				   (+ (* (body-vx (car o)) (body-vx (car o)))
+				      (* (body-vy (car o)) (body-vy (car o)))
+				      (* (body-vz (car o)) (body-vz (car o))))))))
+		    (let loop-i ((i (cdr o)) (e e))
+		      (if (null? i)
+			  (loop-o (cdr o) e)
+			  (let* ((dx (- (body-x (car o)) (body-x (car i))))
+				 (dy (- (body-y (car o)) (body-y (car i))))
+				 (dz (- (body-z (car o)) (body-z (car i))))
+				 (distance (sqrt (+ (* dx dx) (* dy dy) (* dz dz)))))
+			    (let ((e  (- e (/ (* (body-mass (car o)) (body-mass (car i))) distance))))
+			      (loop-i (cdr i) e)))))))))
+
+	  (define (advance system dt)
+	    (let loop-o ((o system))
+	      (unless (null? o)
+		      (let loop-i ((i (cdr o)))
+			(unless (null? i)
+				(let* ((o1 (car o))
+				       (i1 (car i))
+				       (dx (- (body-x o1) (body-x i1)))
+				       (dy (- (body-y o1) (body-y i1)))
+				       (dz (- (body-z o1) (body-z i1)))
+				       (distance (sqrt (+ (* dx dx) (* dy dy) (* dz dz))))
+				       (mag (/ dt (* distance distance distance)))
+				       (dxmag (* dx mag))
+				       (dymag (* dy mag))
+				       (dzmag (* dz mag))
+				       (om (body-mass o1))
+				       (im (body-mass i1)))
+				  (set! (body-vx o1) (- (body-vx o1) (* dxmag im)))
+				  (set! (body-vy o1) (- (body-vy o1) (* dymag im)))
+				  (set! (body-vz o1) (- (body-vz o1) (* dzmag im)))
+				  (set! (body-vx i1) (+ (body-vx i1) (* dxmag om)))
+				  (set! (body-vy i1) (+ (body-vy i1) (* dymag om)))
+				  (set! (body-vz i1) (+ (body-vz i1) (* dzmag om)))
+				  (loop-i (cdr i)))))
+		      (loop-o (cdr o))))
+	    (let loop-o ((o system))
+	      (unless (null? o)
+		      (let ((o1 (car o)))
+			(set! (body-x o1) (+ (body-x o1) (* dt (body-vx o1))))
+			(set! (body-y o1) (+ (body-y o1) (* dt (body-vy o1))))
+			(set! (body-z o1) (+ (body-z o1) (* dt (body-vz o1))))
+			(loop-o (cdr o))))))
+
+	  ;; (define (nbody-test)
+
+	  (let ((n 10) ;(n 1000) ; (command-line #:args (n) (string->number n)))
+		(system (list *sun* *jupiter* *saturn* *uranus* *neptune*)))
+	    (offset-momentum system)
+	    (let ((initial (energy system)))
+	      (do ((i 1 (+ i 1)))
+		  ((< n i))
+		(advance system 0.01))
+	      (let ((final (energy system)))
+		(test (< (abs (- initial -0.16907516382852)) 1e-5) #t)
+		(test (< (abs (- final -0.1690730217)) 1e-4) #t)
+		))))
+
+
+	;;; ----------------
+	;;; some of these tests are taken (with modifications) from sacla which has
+	;;;  the following copyright notice:
+	;;;
+	;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+	;; ALL RIGHTS RESERVED.
+	;;
+	;; Redistribution and use in source and binary forms, with or without
+	;; modification, are permitted provided that the following conditions
+	;; are met:
+	;;
+	;;  * Redistributions of source code must retain the above copyright
+	;;    notice, this list of conditions and the following disclaimer.
+	;;  * Redistributions in binary form must reproduce the above copyright
+	;;    notice, this list of conditions and the following disclaimer in
+	;;    the documentation and/or other materials provided with the
+	;;    distribution.
+	;;
+	;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+	;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+	;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+	;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+	;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+	;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+	;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+	;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+	;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+	;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+	;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+	(test-t (equal 'a 'a))
+	(test-t (not (equal 'a 'b)))
+	(test-t (equal 'abc 'abc))
+	(test-t (equal 1 1))
+	(test-t (equal 2 2))
+	(test-t (equal 0.1 0.1))
+	(test-t (equal 1/3 1/3))
+	(test-t (not (equal 0 1)))
+	(test-t (not (equal 1 1.0)))
+	(test-t (not (equal 1/3 1/4)))
+	(test-t (equal #\a #\a))
+	(test-t (equal #\b #\b))
+	(test-t (not (equal #\b #\B)))
+	(test-t (not (equal #\C #\c)))
+	(test-t (equal '(0) '(0)))
+	(test-t (equal '(0 #\a) '(0 #\a)))
+	(test-t (equal '(0 #\a x) '(0 #\a x)))
+	(test-t (equal '(0 #\a x (0)) '(0 #\a x (0))))
+
+	(test-t (eql (identity 101) 101))
+	(test-t (eq (identity 'x) 'x))
+
+	;; chars
+	(test-t (char= #\d #\d))
+	(test-t (not (char= #\A #\a)))
+	(test-t (not (char= #\d #\x)))
+	(test-t (not (char= #\d #\D)))
+	(test-t (not (char/= #\d #\d)))
+	(test-t (char/= #\d #\x))
+	(test-t (char/= #\d #\D))
+	(test-t (char= #\d #\d #\d #\d))
+	(test-t (not (char/= #\d #\d #\d #\d)))
+	(test-t (not (char= #\d #\d #\x #\d)))
+	(test-t (not (char/= #\d #\d #\x #\d)))
+	(test-t (not (char= #\d #\y #\x #\c)))
+	(test-t (char/= #\d #\y #\x #\c))
+	(test-t (not (char= #\d #\c #\d)))
+	(test-t (not (char/= #\d #\c #\d)))
+	(test-t (char< #\d #\x))
+	(test-t (char<= #\d #\x))
+	(test-t (not (char< #\d #\d)))
+	(test-t (char<= #\d #\d))
+	(test-t (char< #\a #\e #\y #\z))
+	(test-t (char<= #\a #\e #\y #\z))
+	(test-t (not (char< #\a #\e #\e #\y)))
+	(test-t (char<= #\a #\e #\e #\y))
+	(test-t (char> #\e #\d))
+	(test-t (char>= #\e #\d))
+	(test-t (char> #\d #\c #\b #\a))
+	(test-t (char>= #\d #\c #\b #\a))
+	(test-t (not (char> #\d #\d #\c #\a)))
+	(test-t (char>= #\d #\d #\c #\a))
+	(test-t (not (char> #\e #\d #\b #\c #\a)))
+	(test-t (not (char>= #\e #\d #\b #\c #\a)))
+	(test-t (char-equal #\A #\a))
+	(test-t (char= #\a))
+	(test-t (char= #\a #\a))
+	(test-t (char= #\a #\a #\a))
+	(test-t (char= #\a #\a #\a #\a))
+	(test-t (char= #\a #\a #\a #\a #\a))
+	(test-t (char= #\a #\a #\a #\a #\a #\a))
+	(test-t (let ((c #\z))  (and (eq c c)       (char= c c))))
+	(test-t (not (char= #\Z #\z)))
+	(test-t (not (char= #\z #\z #\z #\a)))
+	(test-t (not (char= #\a #\z #\z #\z #\a)))
+	(test-t (not (char= #\z #\i #\z #\z)))
+	(test-t (not (char= #\z #\z #\Z #\z)))
+	(test-t (char/= #\a))
+	(test-t (char/= #\a #\b))
+	(test-t (char/= #\a #\b #\c))
+	(test-t (char/= #\a #\b #\c #\d))
+	(test-t (char/= #\a #\b #\c #\d #\e))
+	(test-t (char/= #\a #\b #\c #\d #\e #\f))
+	(test-t (let ((c #\z))  (and (eq c c)       (not (char/= c c)))))
+	(test-t (char/= #\Z #\z))
+	(test-t (not (char/= #\z #\z #\z #\a)))
+	(test-t (not (char= #\a #\z #\z #\z #\a)))
+	(test-t (not (char= #\z #\i #\z #\z)))
+	(test-t (not (char= #\z #\z #\Z #\z)))
+	(test-t (not (char/= #\a #\a #\b #\c)))
+	(test-t (not (char/= #\a #\b #\a #\c)))
+	(test-t (not (char/= #\a #\b #\c #\a)))
+	(test-t (char< #\a))
+	(test-t (char< #\a #\z))
+	(test-t (char< #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m       #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z))
+	(test-t (not (char< #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n	    #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a)))
+	(test-t (char< #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M       #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z))
+	(test-t (not (char< #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N	    #\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A)))
+	(test-t (char< #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
+	(test-t (not (char< #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0)))
+	(test-t (or (char< #\9 #\A)    (char< #\Z #\0)))
+	(test-t (or (char< #\9 #\a)    (char< #\z #\0)))
+	(test-t (not (char< #\a #\a #\b #\c)))
+	(test-t (not (char< #\a #\b #\a #\c)))
+	(test-t (not (char< #\a #\b #\c #\a)))
+	(test-t (not (char< #\9 #\0)))
+	(test-t (char> #\a))
+	(test-t (not (char> #\a #\z)))
+	(test-t (char> #\z #\a))
+	(test-t (not (char> #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m	    #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z)))
+	(test-t (char> #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n       #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a))
+	(test-t (not (char> #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M	    #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z)))
+	(test-t (char> #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N      #\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A))
+	(test-t (not (char> #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)))
+	(test-t (char> #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0))
+	(test-t (or (char> #\A #\9)    (char> #\0 #\Z)))
+	(test-t (or (char> #\a #\9)    (char> #\0 #\z)))
+	(test-t (not (char> #\a #\a #\b #\c)))
+	(test-t (not (char> #\a #\b #\a #\c)))
+	(test-t (not (char> #\a #\b #\c #\a)))
+	(test-t (char> #\9 #\0))
+	(test-t (char<= #\a))
+	(test-t (char<= #\a #\z))
+	(test-t (char<= #\a #\a))
+	(test-t (char<= #\Z #\Z))
+	(test-t (char<= #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m	#\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z))
+	(test-t (char<= #\a #\a #\b #\b #\c #\c #\d #\d #\e #\e #\f #\f #\g #\g #\h #\h
+			#\i #\i #\j #\j #\k #\k #\l #\l #\m #\m	#\n #\n #\o #\o #\p #\p #\q #\q #\r #\r #\s #\s
+			#\t #\t #\u #\u #\v #\v #\w #\w #\x #\x #\y #\y #\z #\z))
+	(test-t (not (char<= #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n     #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a)))
+	(test-t (char<= #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M	#\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z))
+	(test-t (char<= #\A #\B #\B #\C #\D #\E #\E #\F #\G #\H #\I #\I #\J #\K #\L #\M	#\N #\N #\O #\P #\Q #\R #\S #\T #\T #\U #\V #\W #\X #\Y #\Z))
+	(test-t (not (char<= #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N     #\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A)))
+	(test-t (char<= #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
+	(test-t (char<= #\0 #\1 #\2 #\2 #\3 #\3 #\3 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\9))
+	(test-t (not (char<= #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0)))
+	(test-t (or (char<= #\9 #\A)    (char<= #\Z #\0)))
+	(test-t (or (char<= #\9 #\a)    (char<= #\z #\0)))
+	(test-t (char<= #\a #\a #\b #\c))
+	(test-t (not (char<= #\a #\b #\a #\c)))
+	(test-t (not (char<= #\a #\b #\c #\a)))
+	(test-t (not (char<= #\9 #\0)))
+	(test-t (char>= #\a))
+	(test-t (not (char>= #\a #\z)))
+	(test-t (char>= #\z #\a))
+	(test-t (char>= #\a #\a))
+	(test-t (char>= #\Z #\Z))
+	(test-t (not (char>= #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m     #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z)))
+	(test-t (char>= #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n	#\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a))
+	(test-t (char>= #\z #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n #\n	#\m #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a #\a))
+	(test-t (not (char>= #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M     #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z)))
+	(test-t (char>= #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N	#\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A))
+	(test-t (char>= #\Z #\Y #\X #\W #\V #\U #\U #\T #\T #\S #\S #\R #\Q #\P #\O #\N	#\M #\L #\K #\J #\I #\H #\H #\G #\G #\F #\F #\E #\D #\C #\B #\A))
+	(test-t (not (char>= #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)))
+	(test-t (char>= #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0))
+	(test-t (char>= #\9 #\8 #\8 #\8 #\7 #\6 #\5 #\4 #\3 #\3 #\3 #\2 #\1 #\0))
+	(test-t (or (char>= #\A #\9)    (char>= #\0 #\Z)))
+	(test-t (or (char>= #\a #\9)    (char>= #\0 #\z)))
+	(test-t (char>= #\c #\b #\a #\a))
+	(test-t (not (char>= #\c #\b #\a #\a #\b #\c)))
+	(test-t (not (char>= #\c #\b #\a #\c)))
+	(test-t (not (char>= #\c #\b #\c #\a)))
+	(test-t (char>= #\9 #\0))
+	(test-t (not (char>= #\0 #\9)))
+	(test-t (char-equal #\a))
+	(test-t (char-equal #\a #\a))
+	(test-t (char-equal #\a #\a #\a))
+	(test-t (char-equal #\a #\a #\a #\a))
+	(test-t (char-equal #\a #\a #\a #\a #\a))
+	(test-t (char-equal #\a #\a #\a #\a #\a #\a))
+	(test-t (char-equal #\a #\A))
+	(test-t (char-equal #\a #\A #\a))
+	(test-t (char-equal #\a #\a #\A #\a))
+	(test-t (char-equal #\a #\a #\a #\A #\a))
+	(test-t (char-equal #\a #\a #\a #\a #\A #\a))
+	(test-t (let ((c #\z))  (and (eq c c)       (char-equal c c))))
+	(test-t (char-equal #\Z #\z))
+	(test-t (not (char-equal #\z #\z #\z #\a)))
+	(test-t (not (char-equal #\a #\z #\z #\z #\a)))
+	(test-t (not (char-equal #\z #\i #\z #\z)))
+	(test-t (char-equal #\z #\z #\Z #\z))
+	(test-t (char-equal #\a #\A #\a #\A #\a #\A #\a #\A #\a #\A))
+	(test-t (char-not-equal #\a))
+	(test-t (char-not-equal #\a #\b))
+	(test-t (char-not-equal #\a #\b #\c))
+	(test-t (char-not-equal #\a #\b #\c #\d))
+	(test-t (char-not-equal #\a #\b #\c #\d #\e))
+	(test-t (char-not-equal #\a #\b #\c #\d #\e #\f))
+	(test-t (let ((c #\z))  (and (eq c c)       (not (char-not-equal c c)))))
+	(test-t (not (char-not-equal #\Z #\z)))
+	(test-t (not (char-not-equal #\z #\z #\z #\a)))
+	(test-t (not (char= #\a #\z #\z #\z #\a)))
+	(test-t (not (char= #\z #\i #\z #\z)))
+	(test-t (not (char= #\z #\z #\Z #\z)))
+	(test-t (not (char-not-equal #\a #\a #\b #\c)))
+	(test-t (not (char-not-equal #\a #\b #\a #\c)))
+	(test-t (not (char-not-equal #\a #\b #\c #\a)))
+	(test-t (not (char-not-equal #\a #\A #\a #\A)))
+	(test-t (char-lessp #\a))
+	(test-t (char-lessp #\a #\z))
+	(test-t (char-lessp #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m       #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z))
+	(test-t (not (char-lessp #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n	    #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a)))
+	(test-t (char-lessp #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M       #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z))
+	(test-t (not (char-lessp #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N	    #\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A)))
+	(test-t (char-lessp #\a #\B #\c #\D #\e #\F #\g #\H #\i #\J #\k #\L #\m       #\N #\o #\P #\q #\R #\s #\T #\u #\V #\w #\X #\y #\Z))
+	(test-t (char-lessp #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
+	(test-t (not (char-lessp #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0)))
+	(test-t (or (char-lessp #\9 #\A)    (char-lessp #\Z #\0)))
+	(test-t (or (char-lessp #\9 #\a)    (char-lessp #\z #\0)))
+	(test-t (not (char-lessp #\a #\a #\b #\c)))
+	(test-t (not (char-lessp #\a #\b #\a #\c)))
+	(test-t (not (char-lessp #\a #\b #\c #\a)))
+	(test-t (not (char-lessp #\9 #\0)))
+	(test-t (and (char-lessp #\a #\Z)     (char-lessp #\A #\z)))
+	(test-t (char-greaterp #\a))
+	(test-t (not (char-greaterp #\a #\z)))
+	(test-t (char-greaterp #\z #\a))
+	(test-t (not (char-greaterp #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m	    #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z)))
+	(test-t (char-greaterp #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n       #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a))
+	(test-t (not (char-greaterp #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M	    #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z)))
+	(test-t (char-greaterp #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N   #\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A))
+	(test-t (char-greaterp #\z #\Y #\x #\W #\v #\U #\t #\S #\r #\Q #\p #\O #\n   #\M #\l #\K #\j #\I #\h #\G #\f #\E #\d #\C #\b #\A))
+	(test-t (not (char-greaterp #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)))
+	(test-t (char-greaterp #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0))
+	(test-t (or (char-greaterp #\A #\9)    (char-greaterp #\0 #\Z)))
+	(test-t (or (char-greaterp #\a #\9)    (char-greaterp #\0 #\z)))
+	(test-t (not (char-greaterp #\a #\a #\b #\c)))
+	(test-t (not (char-greaterp #\a #\b #\a #\c)))
+	(test-t (not (char-greaterp #\a #\b #\c #\a)))
+	(test-t (char-greaterp #\9 #\0))
+	(test-t (and (char-greaterp #\z #\A)     (char-greaterp #\Z #\a)))
+	(test-t (char-not-greaterp #\a))
+	(test-t (char-not-greaterp #\a #\z))
+	(test-t (char-not-greaterp #\a #\a))
+	(test-t (char-not-greaterp #\Z #\Z))
+	(test-t (char-not-greaterp #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z))
+	(test-t (char-not-greaterp #\a #\a #\b #\b #\c #\c #\d #\d #\e #\e #\f #\f #\g #\g #\h #\h #\i #\i
+				   #\j #\j #\k #\k #\l #\l #\m #\m #\n #\n #\o #\o #\p #\p #\q #\q #\r #\r #\s #\s #\t
+				   #\t #\u #\u #\v #\v #\w #\w #\x #\x #\y #\y #\z #\z))
+	(test-t (char-not-greaterp #\a #\A #\b #\B #\c #\C #\d #\D #\e #\E #\f #\F #\g #\G #\h #\H #\i #\I #\j #\J
+				   #\k #\K #\l #\L #\m #\M #\n #\N #\o #\O #\p #\P #\q #\Q #\r #\R #\s #\S #\t #\T
+				   #\u #\U #\v #\V #\w #\W #\x #\X #\y #\Y #\z #\z))
+	(test-t (not (char-not-greaterp      #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n      #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a)))
+	(test-t (char-not-greaterp #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z))
+	(test-t (char-not-greaterp #\A #\B #\B #\C #\D #\E #\E #\F #\G #\H #\I #\I #\J #\K #\L #\M #\N #\N #\O #\P #\Q #\R #\S #\T #\T #\U #\V #\W #\X #\Y #\Z))
+	(test-t (not (char-not-greaterp      #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N      #\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A)))
+	(test-t (char-not-greaterp #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
+	(test-t (char-not-greaterp #\0 #\1 #\2 #\2 #\3 #\3 #\3 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\9))
+	(test-t (not (char-not-greaterp #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0)))
+	(test-t (or (char-not-greaterp #\9 #\A)    (char-not-greaterp #\Z #\0)))
+	(test-t (or (char-not-greaterp #\9 #\a)    (char-not-greaterp #\z #\0)))
+	(test-t (char-not-greaterp #\a #\a #\b #\c))
+	(test-t (not (char-not-greaterp #\a #\b #\a #\c)))
+	(test-t (not (char-not-greaterp #\a #\b #\c #\a)))
+	(test-t (not (char-not-greaterp #\9 #\0)))
+	(test-t (and (char-not-greaterp #\A #\z)     (char-not-greaterp #\a #\Z)))
+	(test-t (char-not-lessp #\a))
+	(test-t (not (char-not-lessp #\a #\z)))
+	(test-t (char-not-lessp #\z #\a))
+	(test-t (char-not-lessp #\a #\a))
+	(test-t (char-not-lessp #\Z #\Z))
+	(test-t (not (char-not-lessp #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m  #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z)))
+	(test-t (char-not-lessp #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n	#\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a))
+	(test-t (char-not-lessp #\z #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n #\n	#\m #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a #\a))
+	(test-t (not (char-not-lessp #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\m     #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z)))
+	(test-t (char-not-lessp #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N	#\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A))
+	(test-t (char-not-lessp #\Z #\Y #\X #\W #\V #\U #\U #\T #\T #\S #\S #\R #\Q #\P #\O #\N	#\M #\L #\K #\J #\I #\H #\H #\G #\G #\F #\F #\E #\D #\C #\B #\A))
+	(test-t (char-not-lessp #\z #\Z #\y #\x #\w #\V #\v #\u #\t #\s #\r #\q #\p #\o #\n #\n	#\m #\M #\l #\k #\K #\j #\i #\h #\g #\f #\e #\d #\c #\b #\A #\a))
+	(test-t (not (char-not-lessp #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)))
+	(test-t (char-not-lessp #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0))
+	(test-t (char-not-lessp #\9 #\8 #\8 #\8 #\7 #\6 #\5 #\4 #\3 #\3 #\3 #\2 #\1 #\0))
+	(test-t (or (char-not-lessp #\A #\9)    (char-not-lessp #\0 #\Z)))
+	(test-t (or (char-not-lessp #\a #\9)    (char-not-lessp #\0 #\z)))
+	(test-t (char-not-lessp #\c #\b #\a #\a))
+	(test-t (not (char-not-lessp #\c #\b #\a #\a #\b #\c)))
+	(test-t (not (char-not-lessp #\c #\b #\a #\c)))
+	(test-t (not (char-not-lessp #\c #\b #\c #\a)))
+	(test-t (char-not-lessp #\9 #\0))
+	(test-t (not (char-not-lessp #\0 #\9)))
+	(test-t (and (char-not-lessp #\z #\A)     (char-not-lessp #\Z #\a)))
+	(test-t (char= (character #\a) #\a))
+	(test-t (char= (character #\b) #\b))
+;	(test-t (char= (character #\Space) #\Space))
+	(test-t (char= (character "a") #\a))
+	(test-t (char= (character "X") #\X))
+	(test-t (char= (character "z") #\z))
+	(test-t (char= (character 'a) #\a))
+;	(test-t (char= (character '\a) #\a))
+	(test-t (alpha-char-p #\a))
+	(test-t (every alpha-char-p '(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z)))
+	(test-t (every alpha-char-p '(#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z)))
+	(test-t (notany alpha-char-p '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)))
+;	(test-t (not (alpha-char-p #\Newline)))
+	(test-t (alphanumericp #\Z))
+	(test-t (alphanumericp #\9))
+	(test-t (every alphanumericp '(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m  #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z)))
+	(test-t (every alphanumericp '(#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M  #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z)))
+	(test-t (every alphanumericp '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)))
+;	(test-t (not (alphanumericp #\Newline)))
+	(test-t (not (alphanumericp #\#)))
+	(test-t (char= (digit-char 0) #\0))
+;	(test-t (char= (digit-char 10 11) #\A))
+	(test-t (null (digit-char 10 10)))
+	(test-t (char= (digit-char 7) #\7))
+	(test-t (null (digit-char 12)))
+;	(test-t (char= (digit-char 12 16) #\C))
+	(test-t (null (digit-char 6 2)))
+	(test-t (char= (digit-char 1 2) #\1))
+;	(test-t (char= (digit-char 35 36) #\Z))
+	(test-t (= (digit-char-p #\0) 0))
+	(test-t (= (digit-char-p #\5) 5))
+	(test-t (not (digit-char-p #\5 2)))
+	(test-t (not (digit-char-p #\A)))
+	(test-t (not (digit-char-p #\a)))
+;	(test-t (= (digit-char-p #\A 11) 10))
+	(test-t (= (digit-char-p #\a 11) 10))
+;	(test-t (standard-char-p #\a))
+;	(test-t (standard-char-p #\z))
+;	(test-t (standard-char-p #\Newline))
+;	(test-t (every standard-char-p " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_'abcdefghijklmnopqrstuvwxyz{|}~"))
+	(test-t (char= (char-upcase #\a) #\A))
+	(test-t (char= (char-upcase #\A) #\A))
+	(test-t (char= (char-upcase #\-) #\-))
+	(test-t (char= (char-downcase #\A) #\a))
+	(test-t (char= (char-downcase #\a) #\a))
+	(test-t (char= (char-downcase #\-) #\-))
+	(test-t (not (upper-case-p #\a)))
+	(test-t (upper-case-p #\A))
+	(test-t (not (upper-case-p #\-)))
+	(test-t (not (lower-case-p #\A)))
+	(test-t (lower-case-p #\a))
+	(test-t (not (lower-case-p #\-)))
+;	(test-t (char= #\Space (name-char (char-name #\Space))))
+;	(test-t (char= #\Newline (name-char (char-name #\Newline))))
+
+
+	(test-t (simple-string-p ""))
+	(test-t (simple-string-p "abc"))
+	(test-t (not (simple-string-p 'not-a-string)))
+	(test-t (char= (char "abc" 0) #\a))
+	(test-t (char= (char "abc" 1) #\b))
+	(test-t (char= (char "abc" 2) #\c))
+	(test-t (char= (schar "abc" 0) #\a))
+	(test-t (char= (schar "abc" 1) #\b))
+	(test-t (char= (schar "abc" 2) #\c))
+	(test-t (string= (cl-string "") ""))
+	(test-t (string= (cl-string "abc") "abc"))
+	(test-t (string= (cl-string "a") "a"))
+	(test-t (string= (cl-string 'abc) "abc"))
+	(test-t (string= (cl-string 'a) "a"))
+	(test-t (string= (cl-string #\a) "a"))
+	(test-t (string= (cl-string-upcase "abcde") "ABCDE"))
+	(test-t (string= (cl-string-upcase "Dr. Livingston, I presume?")	 "DR. LIVINGSTON, I PRESUME?"))
+	(test-t (string= (cl-string-upcase "Dr. Livingston, I presume?" :start 6 :end 10)	 "Dr. LiVINGston, I presume?"))
+	(test-t (string= (cl-string-upcase 'Kludgy-HASH-Search) "KLUDGY-HASH-SEARCH"))
+	(test-t (string= (cl-string-upcase "abcde" :start 2 :end nil) "abCDE"))
+	(test-t (string= (cl-string-downcase "Dr. Livingston, I presume?")	 "dr. livingston, i presume?"))
+	(test-t (string= (cl-string-downcase 'Kludgy-HASH-Search) "kludgy-hash-search"))
+	(test-t (string= (cl-string-downcase "A FOOL" :start 2 :end nil) "A fool"))
+	(test-t (string= (string-capitalize "elm 13c arthur;fig don't")	 "Elm 13c Arthur;Fig Don'T"))
+	(test-t (string= (string-capitalize " hello ") " Hello "))
+	(test-t (string= (string-capitalize  "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION") "Occluded Casements Forestall Inadvertent Defenestration"))
+	(test-t (string= (string-capitalize 'kludgy-hash-search) "Kludgy-Hash-Search"))
+	(test-t (string= (string-capitalize "DON'T!") "Don'T!"))
+	(test-t (string= (string-capitalize "pipe 13a, foo16c") "Pipe 13a, Foo16c"))
+	(test-t (string= (string-capitalize "a fool" :start 2 :end nil) "a Fool"))
+	(test-t (let ((str (copy "0123ABCD890a")))  (and (string= (nstring-downcase str :start 5 :end 7) "0123AbcD890a")       (string= str "0123AbcD890a"))))
+	(test-t (let* ((str0 (copy "abcde"))  (str  (nstring-upcase str0)))  (and (eq str0 str)       (string= str "ABCDE"))))
+	(test-t (let* ((str0 (copy "Dr. Livingston, I presume?")) (str  (nstring-upcase str0))) (and (eq str0 str) (string= str "DR. LIVINGSTON, I PRESUME?"))))
+	(test-t (let* ((str0 (copy "Dr. Livingston, I presume?")) (str  (nstring-upcase str0 :start 6 :end 10))) (and (eq str0 str) (string= str "Dr. LiVINGston, I presume?"))))
+	(test-t (let* ((str0 (copy "abcde")) (str (nstring-upcase str0 :start 2 :end nil)))  (string= str "abCDE")))
+	(test-t (let* ((str0 (copy "Dr. Livingston, I presume?")) (str  (nstring-downcase str0))) (and (eq str0 str) (string= str "dr. livingston, i presume?"))))
+	(test-t (let* ((str0 (copy "ABCDE")) (str (nstring-downcase str0 :start 2 :end nil)))  (string= str "ABcde")))
+	(test-t (let* ((str0 (copy "elm 13c arthur;fig don't")) (str  (nstring-capitalize str0))) (and (eq str0 str) (string= str "Elm 13c Arthur;Fig Don'T"))))
+	(test-t (let* ((str0 (copy " hello ")) (str  (nstring-capitalize str0)))  (and (eq str0 str) (string= str " Hello "))))
+	(test-t (let* ((str0 (copy "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION")) (str (nstring-capitalize str0))) (and (eq str0 str) (string= str		"Occluded Casements Forestall Inadvertent Defenestration"))))
+	(test-t (let* ((str0 (copy "DON'T!"))  (str  (nstring-capitalize str0))) (and (eq str0 str)  (string= str "Don'T!"))))
+	(test-t (let* ((str0 (copy "pipe 13a, foo16c"))       (str  (nstring-capitalize str0)))  (and (eq str0 str)       (string= str "Pipe 13a, Foo16c"))))
+	(test-t (let* ((str0 (copy "a fool"))       (str (nstring-capitalize str0 :start 2 :end nil)))  (string= str "a Fool")))
+	(test-t (string= (string-trim "abc" "abcaakaaakabcaaa") "kaaak"))
+	(test-t (string= (string-trim '(#\space) " garbanzo beans        ") "garbanzo beans"))
+	(test-t (string= (string-trim " (*)" " ( *three (silly) words* ) ")	 "three (silly) words"))
+	(test-t (string= (string-left-trim "abc" "labcabcabc") "labcabcabc"))
+	(test-t (string= (string-left-trim " (*)" " ( *three (silly) words* ) ")	 "three (silly) words* ) "))
+	(test-t (string= (string-right-trim " (*)" " ( *three (silly) words* ) ") 	 " ( *three (silly) words"))
+	(test-t (string= (string-trim "ABC" "abc") "abc"))
+	(test-t (string= (string-trim "AABBCC" "abc") "abc"))
+	(test-t (string= (string-trim "" "abc") "abc"))
+	(test-t (string= (string-trim "ABC" "") ""))
+	(test-t (string= (string-trim "cba" "abc") ""))
+	(test-t (string= (string-trim "cba" "abccba") ""))
+	(test-t (string= (string-trim "ccbbba" "abccba") ""))
+	(test-t (string= (string-trim "cba" "abcxabc") "x"))
+	(test-t (string= (string-trim "xyz" "xxyabcxyyz") "abc"))
+	(test-t (string= (string-trim "a" #\a) ""))
+	(test-t (string= (string-left-trim "ABC" "abc") "abc"))
+	(test-t (string= (string-left-trim "" "abc") "abc"))
+	(test-t (string= (string-left-trim "ABC" "") ""))
+	(test-t (string= (string-left-trim "cba" "abc") ""))
+	(test-t (string= (string-left-trim "cba" "abccba") ""))
+	(test-t (string= (string-left-trim "cba" "abcxabc") "xabc"))
+	(test-t (string= (string-left-trim "xyz" "xxyabcxyz") "abcxyz"))
+	(test-t (string= (string-left-trim "a" #\a) ""))
+	(test-t (string= (string-right-trim "ABC" "abc") "abc"))
+	(test-t (string= (string-right-trim "" "abc") "abc"))
+	(test-t (string= (string-right-trim "ABC" "") ""))
+	(test-t (string= (string-right-trim "cba" "abc") ""))
+	(test-t (string= (string-right-trim "cba" "abccba") ""))
+	(test-t (string= (string-right-trim "cba" "abcxabc") "abcx"))
+	(test-t (string= (string-right-trim "xyz" "xxyabcxyz") "xxyabc"))
+	(test-t (string= (string-right-trim "a" #\a) ""))
+	(test-t (string= (cl-string "already a string") "already a string"))
+	(test-t (string=  (cl-string #\c) "c"))
+	(test-t (string= "foo" "foo"))
+	(test-t (not (string= "foo" "Foo")))
+	(test-t (not (string= "foo" "bar")))
+	(test-t (string= "together" "frog" :start1 1 :end1 3 :start2 2))
+	(test-t (string-equal "foo" "Foo"))
+	(test-t (string= "abcd" "01234abcd9012" :start2 5 :end2 9))
+	(test-t (eql (string< "aaaa" "aaab") 3))
+	(test-t (eql (string>= "aaaaa" "aaaa") 4))
+	(test-t (eql (string-not-greaterp "Abcde" "abcdE") 5))
+	(test-t (eql (string-lessp "012AAAA789" "01aaab6"   :start1 3 :end1 7   :start2 2 :end2 6) 6))
+	(test-t (not (string-not-equal "AAAA" "aaaA")))
+	(test-t (string= "" ""))
+	(test-t (not (string= "abc" "")))
+	(test-t (not (string= "" "abc")))
+	(test-t (not (string= "A" "a")))
+	(test-t (string= "abc" "xyz" :start1 3 :start2 3))
+	(test-t (string= "abc" "xyz" :start1 1 :end1 1 :start2 0 :end2 0))
+	(test-t (string= "axyza" "xyz" :start1 1 :end1 4))
+	(test-t (string= "axyza" "xyz" :start1 1 :end1 4 :start2 0 :end2 nil))
+	(test-t (string= "abxyz" "xyabz" :end1 2 :start2 2 :end2 4))
+	(test-t (not (string= "love" "hate")))
+	(test-t (string= 'love 'love))
+	(test-t (not (string= 'love "hate")))
+	(test-t (string= #\a #\a))
+	(test-t (not (string/= "" "")))
+	(test-t (eql (string/= "abc" "") 0))
+	(test-t (eql (string/= "" "abc") 0))
+	(test-t (eql (string/= "A" "a") 0))
+	(test-t (not (string/= "abc" "xyz" :start1 3 :start2 3)))
+	(test-t (not (string/= "abc" "xyz" :start1 1 :end1 1 :start2 0 :end2 0)))
+	(test-t (not (string/= "axyza" "xyz" :start1 1 :end1 4)))
+	(test-t (not (string/= "axyza" "xyz" :start1 1 :end1 4 :start2 0 :end2 nil)))
+	(test-t (not (string/= "abxyz" "xyabz" :end1 2 :start2 2 :end2 4)))
+	(test-t (eql (string/= "love" "hate") 0))
+	(test-t (eql (string/= "love" "loVe") 2))
+	(test-t (not (string/= "life" "death" :start1 3 :start2 1 :end2 2)))
+	(test-t (eql (string/= "abcxyz" "ABCxyZ" :start1 3 :start2 3) 5))
+	(test-t (eql (string/= "abcxyz" "ABCxyZ" :start1 3 :end1 nil :start2 3 :end2 nil) 5))
+	(test-t (eql (string/= "abcxyz" "ABCxyZ" :end1 nil :start2 3 :end2 3) 0))
+	(test-t (eql (string/= "abc" "abcxyz") 3))
+	(test-t (eql (string/= "abcxyz" "abc") 3))
+	(test-t (eql (string/= "abcxyz" "") 0))
+	(test-t (eql (string/= "AbcDef" "cdef" :start1 2) 3))
+	(test-t (eql (string/= "cdef" "AbcDef" :start2 2) 1))
+	(test-t (= (string/= 'love "hate") 0))
+	(test-t (not (string/= 'love 'love)))
+	(test-t (not (string/= #\a #\a)))
+	(test-t (= (string/= #\a #\b) 0))
+	(test-t (not (string< "" "")))
+	(test-t (not (string< "dog" "dog")))
+	(test-t (not (string< " " " ")))
+	(test-t (not (string< "abc" "")))
+	(test-t (eql (string< "" "abc") 0))
+	(test-t (eql (string< "ab" "abc") 2))
+	(test-t (not (string< "abc" "ab")))
+	(test-t (eql (string< "aaa" "aba") 1))
+	(test-t (not (string< "aba" "aaa")))
+	(test-t (not (string< "my cat food" "your dog food" :start1 6 :start2 8)))
+	(test-t (not (string< "cat food 2 dollars" "dog food 3 dollars"	      :start1 3 :end1 9 :start2 3 :end2 9)))
+	(test-t (eql (string< "xyzabc" "abcd" :start1 3) 6))
+	(test-t (eql (string< "abc" "abc" :end1 1) 1))
+	(test-t (eql (string< "xyzabc" "abc" :start1 3 :end1 5) 5))
+	(test-t (eql (string< "xyz" "abcxyzXYZ" :start2 3) 3))
+	(test-t (not (string< "abc" "abcxyz" :end2 3)))
+	(test-t (eql (string< "xyz" "abcxyz" :end1 2 :start2 3) 2))
+	(test-t (not (string< "xyzabc" "abcdef" :start1 3 :end2 3)))
+	(test-t (eql (string< "aaaa" "z") 0))
+	(test-t (eql (string< "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6))
+	(test-t (eql (string< "pppTTTaTTTqqq" "pTTTxTTT"     :start1 6 :end1 7     :start2 4 :end2 5) 6))
+	(test-t (not (string< 'love 'hate)))
+	(test-t (= (string< 'peace 'war) 0))
+	(test-t (not (string< 'love 'love)))
+	(test-t (not (string< #\a #\a)))
+	(test-t (= (string< #\a #\b) 0))
+	(test-t (not (string> "" "")))
+	(test-t (not (string> "dog" "dog")))
+	(test-t (not (string> " " " ")))
+	(test-t (eql (string> "abc" "") 0))
+	(test-t (not (string> "" "abc")))
+	(test-t (not (string> "ab" "abc")))
+	(test-t (eql (string> "abc" "ab") 2))
+	(test-t (eql (string> "aba" "aaa") 1))
+	(test-t (not (string> "aaa" "aba")))
+	(test-t (not (string> "my cat food" "your dog food" :start1 6 :start2 8)))
+	(test-t (not (string> "cat food 2 dollars" "dog food 3 dollars"	     :start1 3 :end1 9 :start2 3 :end2 9)))
+	(test-t (eql (string> "xyzabcde" "abcd" :start1 3) 7))
+	(test-t (not (string> "abc" "abc" :end1 1)))
+	(test-t (eql (string> "xyzabc" "a" :start1 3 :end1 5) 4))
+	(test-t (eql (string> "xyzXYZ" "abcxyz" :start2 3) 3))
+	(test-t (eql (string> "abcxyz" "abcxyz" :end2 3) 3))
+	(test-t (not (string> "xyzXYZ" "abcxyz" :end1 2 :start2 3)))
+	(test-t (not (string> "xyzabc" "abcdef" :start1 3 :end2 3)))
+	(test-t (eql (string> "z" "aaaa") 0))
+	(test-t (eql (string> "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4))
+	(test-t (eql (string> "pppTTTxTTTqqq" "pTTTaTTT"     :start1 6 :end1 7      :start2 4 :end2 5) 6))
+	(test-t (= (string> 'love 'hate) 0))
+	(test-t (not (string> 'peace 'war)))
+	(test-t (not (string> 'love 'love)))
+	(test-t (not (string> #\a #\a)))
+	(test-t (not (string> #\a #\b)))
+	(test-t (= (string> #\z #\a) 0))
+	(test-t (eql (string<= "" "") 0))
+	(test-t (eql (string<= "dog" "dog") 3))
+	(test-t (eql (string<= " " " ") 1))
+	(test-t (not (string<= "abc" "")))
+	(test-t (eql (string<= "ab" "abc") 2))
+	(test-t (eql (string<= "aaa" "aba") 1))
+	(test-t (not (string<= "aba" "aaa")))
+	(test-t (eql (string<= "my cat food" "your dog food" :start1 6 :start2 8) 11))
+	(test-t (eql (string<= "cat food 2 dollars" "dog food 3 dollars"      :start1 3 :end1 9 :start2 3 :end2 9) 9))
+	(test-t (eql (string<= "xyzabc" "abcd" :start1 3) 6))
+	(test-t (eql (string<= "abc" "abc" :end1 1) 1))
+	(test-t (eql (string<= "xyzabc" "abc" :start1 3 :end1 5) 5))
+	(test-t (eql (string<= "xyz" "abcxyzXYZ" :start2 3) 3))
+	(test-t (eql (string<= "abc" "abcxyz" :end2 3) 3))
+	(test-t (eql (string<= "xyz" "abcxyz" :end1 2 :start2 3) 2))
+	(test-t (eql (string<= "xyzabc" "abcdef" :start1 3 :end2 3) 6))
+	(test-t (eql (string<= "aaaa" "z") 0))
+	(test-t (eql (string<= "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6))
+	(test-t (eql (string<= "pppTTTaTTTqqq" "pTTTxTTT"      :start1 6 :end1 7     :start2 4 :end2 5) 6))
+	(test-t (not (string<= 'love 'hate)))
+	(test-t (= (string<= 'peace 'war) 0))
+	(test-t (= (string<= 'love 'love) 4))
+	(test-t (= (string<= #\a #\a) 1))
+	(test-t (= (string<= #\a #\b) 0))
+	(test-t (not (string<= #\z #\a)))
+	(test-t (eql (string>= "" "") 0))
+	(test-t (eql (string>= "dog" "dog") 3))
+	(test-t (eql (string>= " " " ") 1))
+	(test-t (eql (string>= "abc" "") 0))
+	(test-t (not (string>= "" "abc")))
+	(test-t (not (string>= "ab" "abc")))
+	(test-t (eql (string>= "abc" "ab") 2))
+	(test-t (eql (string>= "aba" "aaa") 1))
+	(test-t (not (string>= "aaa" "aba")))
+	(test-t (eql (string>= "my cat food" "your dog food" :start1 6 :start2 8) 11))
+	(test-t (eql (string>= "cat food 2 dollars" "dog food 3 dollars"      :start1 3 :end1 9 :start2 3 :end2 9) 9))
+	(test-t (eql (string>= "xyzabcde" "abcd" :start1 3) 7))
+	(test-t (not (string>= "abc" "abc" :end1 1)))
+	(test-t (eql (string>= "xyzabc" "a" :start1 3 :end1 5) 4))
+	(test-t (eql (string>= "xyzXYZ" "abcxyz" :start2 3) 3))
+	(test-t (eql (string>= "abcxyz" "abcxyz" :end2 3) 3))
+	(test-t (not (string>= "xyzXYZ" "abcxyz" :end1 2 :start2 3)))
+	(test-t (eql (string>= "xyzabc" "abcdef" :start1 3 :end2 3) 6))
+	(test-t (eql (string>= "z" "aaaa") 0))
+	(test-t (eql (string>= "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4))
+	(test-t (eql (string>= "pppTTTxTTTqqq" "pTTTaTTT"     :start1 6 :end1 7      :start2 4 :end2 5) 6))
+	(test-t (= (string>= 'love 'hate) 0))
+	(test-t (not (string>= 'peace 'war)))
+	(test-t (= (string>= 'love 'love) 4))
+	(test-t (= (string>= #\a #\a) 1))
+	(test-t (not (string>= #\a #\b)))
+	(test-t (= (string>= #\z #\a) 0))
+	(test-t (string-equal "" ""))
+	(test-t (not (string-equal "abc" "")))
+	(test-t (not (string-equal "" "abc")))
+	(test-t (string-equal "A" "a"))
+	(test-t (string-equal "abc" "xyz" :start1 3 :start2 3))
+	(test-t (string-equal "abc" "xyz" :start1 1 :end1 1 :start2 0 :end2 0))
+	(test-t (string-equal "axyza" "xyz" :start1 1 :end1 4))
+	(test-t (string-equal "axyza" "xyz" :start1 1 :end1 4 :start2 0 :end2 nil))
+	(test-t (string-equal "abxyz" "xyabz" :end1 2 :start2 2 :end2 4))
+	(test-t (not (string-equal "love" "hate")))
+	(test-t (string-equal "xyz" "XYZ"))
+	(test-t (not (string-equal 'love 'hate)))
+	(test-t (not (string-equal 'peace 'war)))
+	(test-t (string-equal 'love 'love))
+	(test-t (string-equal #\a #\a))
+	(test-t (not (string-equal #\a #\b)))
+	(test-t (not (string-equal #\z #\a)))
+	(test-t (not (string-not-equal "" "")))
+	(test-t (eql (string-not-equal "abc" "") 0))
+	(test-t (eql (string-not-equal "" "abc") 0))
+	(test-t (not (string-not-equal "A" "a")))
+	(test-t (not (string-not-equal "abc" "xyz" :start1 3 :start2 3)))
+	(test-t (not (string-not-equal "abc" "xyz" :start1 1 :end1 1 :start2 0 :end2 0)))
+	(test-t (not (string-not-equal "axyza" "xyz" :start1 1 :end1 4)))
+	(test-t (not (string-not-equal "axyza" "xyz" :start1 1 :end1 4 :start2 0 :end2 nil)))
+	(test-t (not (string-not-equal "abxyz" "xyabz" :end1 2 :start2 2 :end2 4)))
+	(test-t (eql (string-not-equal "love" "hate") 0))
+	(test-t (not (string-not-equal "love" "loVe")))
+	(test-t (not (string-not-equal "life" "death" :start1 3 :start2 1 :end2 2)))
+	(test-t (not (string-not-equal "abcxyz" "ABCxyZ" :start1 3 :start2 3)))
+	(test-t (not (string-not-equal "abcxyz" "ABCxyZ" :start1 3 :end1 nil :start2 3 :end2 nil)))
+	(test-t (eql (string-not-equal "abcxyz" "ABCxyZ" :end1 nil :start2 3 :end2 3) 0))
+	(test-t (eql (string-not-equal "abc" "abcxyz") 3))
+	(test-t (eql (string-not-equal "abcxyz" "abc") 3))
+	(test-t (eql (string-not-equal "abcxyz" "") 0))
+	(test-t (not (string-not-equal "AbcDef" "cdef" :start1 2)))
+	(test-t (not (string-not-equal "cdef" "AbcDef" :start2 2)))
+	(test-t (not (string-not-equal "ABC" "abc")))
+	(test-t (= (string-not-equal 'love 'hate) 0))
+	(test-t (= (string-not-equal 'peace 'war) 0))
+	(test-t (not (string-not-equal 'love 'love)))
+	(test-t (not (string-not-equal #\a #\a)))
+	(test-t (= (string-not-equal #\a #\b) 0))
+	(test-t (= (string-not-equal #\z #\a) 0))
+	(test-t (not (string-lessp "" "")))
+	(test-t (not (string-lessp "dog" "dog")))
+	(test-t (not (string-lessp " " " ")))
+	(test-t (not (string-lessp "abc" "")))
+	(test-t (eql (string-lessp "" "abc") 0))
+	(test-t (eql (string-lessp "ab" "abc") 2))
+	(test-t (not (string-lessp "abc" "ab")))
+	(test-t (eql (string-lessp "aaa" "aba") 1))
+	(test-t (not (string-lessp "aba" "aaa")))
+	(test-t (not (string-lessp "my cat food" "your dog food" :start1 6 :start2 8)))
+	(test-t (not (string-lessp "cat food 2 dollars" "dog food 3 dollars"   :start1 3 :end1 9 :start2 3 :end2 9)))
+	(test-t (eql (string-lessp "xyzabc" "abcd" :start1 3) 6))
+	(test-t (eql (string-lessp "abc" "abc" :end1 1) 1))
+	(test-t (eql (string-lessp "xyzabc" "abc" :start1 3 :end1 5) 5))
+	(test-t (eql (string-lessp "xyz" "abcxyzXYZ" :start2 3) 3))
+	(test-t (not (string-lessp "abc" "abcxyz" :end2 3)))
+	(test-t (eql (string-lessp "xyz" "abcxyz" :end1 2 :start2 3) 2))
+	(test-t (not (string-lessp "xyzabc" "abcdef" :start1 3 :end2 3)))
+	(test-t (eql (string-lessp "aaaa" "z") 0))
+	(test-t (eql (string-lessp "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6))
+	(test-t (eql (string-lessp "pppTTTaTTTqqq" "pTTTxTTT"   :start1 6 :end1 7   :start2 4 :end2 5) 6))
+	(test-t (and (not (string-lessp "abc" "ABC"))     (not (string-lessp "ABC" "abc"))))
+	(test-t (not (string-lessp 'love 'hate)))
+	(test-t (= (string-lessp 'peace 'war) 0))
+	(test-t (not (string-lessp 'love 'love)))
+	(test-t (not (string-lessp #\a #\a)))
+	(test-t (= (string-lessp #\a #\b) 0))
+	(test-t (not (string-lessp #\z #\a)))
+	(test-t (not (string-greaterp "" "")))
+	(test-t (not (string-greaterp "dog" "dog")))
+	(test-t (not (string-greaterp " " " ")))
+	(test-t (eql (string-greaterp "abc" "") 0))
+	(test-t (not (string-greaterp "" "abc")))
+	(test-t (not (string-greaterp "ab" "abc")))
+	(test-t (eql (string-greaterp "abc" "ab") 2))
+	(test-t (eql (string-greaterp "aba" "aaa") 1))
+	(test-t (not (string-greaterp "aaa" "aba")))
+	(test-t (not (string-greaterp "my cat food" "your dog food" :start1 6 :start2 8)))
+	(test-t (not (string-greaterp "cat food 2 dollars" "dog food 3 dollars"      :start1 3 :end1 9 :start2 3 :end2 9)))
+	(test-t (eql (string-greaterp "xyzabcde" "abcd" :start1 3) 7))
+	(test-t (not (string-greaterp "abc" "abc" :end1 1)))
+	(test-t (eql (string-greaterp "xyzabc" "a" :start1 3 :end1 5) 4))
+	(test-t (eql (string-greaterp "xyzXYZ" "abcxyz" :start2 3) 3))
+	(test-t (eql (string-greaterp "abcxyz" "abcxyz" :end2 3) 3))
+	(test-t (not (string-greaterp "xyzXYZ" "abcxyz" :end1 2 :start2 3)))
+	(test-t (not (string-greaterp "xyzabc" "abcdef" :start1 3 :end2 3)))
+	(test-t (eql (string-greaterp "z" "aaaa") 0))
+	(test-t (eql (string-greaterp "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4))
+	(test-t (eql (string-greaterp "pppTTTxTTTqqq" "pTTTaTTT"     :start1 6 :end1 7	     :start2 4 :end2 5) 6))
+	(test-t (and (not (string-greaterp "abc" "ABC"))     (not (string-greaterp "ABC" "abc"))))
+	(test-t (= (string-greaterp 'love 'hate) 0))
+	(test-t (not (string-greaterp 'peace 'war)))
+	(test-t (not (string-greaterp 'love 'love)))
+	(test-t (not (string-greaterp #\a #\a)))
+	(test-t (not (string-greaterp #\a #\b)))
+	(test-t (= (string-greaterp #\z #\a) 0))
+	(test-t (eql (string-not-greaterp "" "") 0))
+	(test-t (eql (string-not-greaterp "dog" "dog") 3))
+	(test-t (eql (string-not-greaterp " " " ") 1))
+	(test-t (not (string-not-greaterp "abc" "")))
+	(test-t (eql (string-not-greaterp "ab" "abc") 2))
+	(test-t (eql (string-not-greaterp "aaa" "aba") 1))
+	(test-t (not (string-not-greaterp "aba" "aaa")))
+	(test-t (eql (string-not-greaterp "my cat food" "your dog food" :start1 6 :start2 8) 11))
+	(test-t (eql (string-not-greaterp "cat food 2 dollars" "dog food 3 dollars"  :start1 3 :end1 9 :start2 3 :end2 9) 9))
+	(test-t (eql (string-not-greaterp "xyzabc" "abcd" :start1 3) 6))
+	(test-t (eql (string-not-greaterp "abc" "abc" :end1 1) 1))
+	(test-t (eql (string-not-greaterp "xyzabc" "abc" :start1 3 :end1 5) 5))
+	(test-t (eql (string-not-greaterp "xyz" "abcxyzXYZ" :start2 3) 3))
+	(test-t (eql (string-not-greaterp "abc" "abcxyz" :end2 3) 3))
+	(test-t (eql (string-not-greaterp "xyz" "abcxyz" :end1 2 :start2 3) 2))
+	(test-t (eql (string-not-greaterp "xyzabc" "abcdef" :start1 3 :end2 3) 6))
+	(test-t (eql (string-not-greaterp "aaaa" "z") 0))
+	(test-t (eql (string-not-greaterp "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6))
+	(test-t (eql (string-not-greaterp "pppTTTaTTTqqq" "pTTTxTTT"  :start1 6 :end1 7	  :start2 4 :end2 5) 6))
+	(test-t (and (eql (string-not-greaterp "abc" "ABC") 3)    (eql (string-not-greaterp "ABC" "abc") 3)))
+	(test-t (not (string-not-greaterp 'love 'hate)))
+	(test-t (= (string-not-greaterp 'peace 'war) 0))
+	(test-t (= (string-not-greaterp 'love 'love) 4))
+	(test-t (= (string-not-greaterp #\a #\a) 1))
+	(test-t (= (string-not-greaterp #\a #\b) 0))
+	(test-t (not (string-not-greaterp #\z #\a)))
+	(test-t (eql (string-not-lessp "" "") 0))
+	(test-t (eql (string-not-lessp "dog" "dog") 3))
+	(test-t (eql (string-not-lessp " " " ") 1))
+	(test-t (eql (string-not-lessp "abc" "") 0))
+	(test-t (not (string-not-lessp "" "abc")))
+	(test-t (not (string-not-lessp "ab" "abc")))
+	(test-t (eql (string-not-lessp "abc" "ab") 2))
+	(test-t (eql (string-not-lessp "aba" "aaa") 1))
+	(test-t (not (string-not-lessp "aaa" "aba")))
+	(test-t (eql (string-not-lessp "my cat food" "your dog food" :start1 6 :start2 8) 11))
+	(test-t (eql (string-not-lessp "cat food 2 dollars" "dog food 3 dollars"  :start1 3 :end1 9 :start2 3 :end2 9) 9))
+	(test-t (eql (string-not-lessp "xyzabcde" "abcd" :start1 3) 7))
+	(test-t (not (string-not-lessp "abc" "abc" :end1 1)))
+	(test-t (eql (string-not-lessp "xyzabc" "a" :start1 3 :end1 5) 4))
+	(test-t (eql (string-not-lessp "xyzXYZ" "abcxyz" :start2 3) 3))
+	(test-t (eql (string-not-lessp "abcxyz" "abcxyz" :end2 3) 3))
+	(test-t (not (string-not-lessp "xyzXYZ" "abcxyz" :end1 2 :start2 3)))
+	(test-t (eql (string-not-lessp "xyzabc" "abcdef" :start1 3 :end2 3) 6))
+	(test-t (eql (string-not-lessp "z" "aaaa") 0))
+	(test-t (eql (string-not-lessp "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4))
+	(test-t (eql (string-not-lessp "pppTTTxTTTqqq" "pTTTaTTT"       :start1 6 :end1 7       :start2 4 :end2 5) 6))
+	(test-t (and (eql (string-not-lessp "abc" "ABC") 3)    (eql (string-not-lessp "ABC" "abc") 3)))
+	(test-t (= (string-not-lessp 'love 'hate) 0))
+	(test-t (not (string-not-lessp 'peace 'war)))
+	(test-t (= (string-not-lessp 'love 'love) 4))
+	(test-t (= (string-not-lessp #\a #\a) 1))
+	(test-t (not (string-not-lessp #\a #\b)))
+	(test-t (= (string-not-lessp #\z #\a) 0))
+	(test-t (stringp "aaaaaa"))
+	(test-t (not (stringp #\a)))
+	(test-t (not (stringp 'a)))
+	(test-t (not (stringp '(string))))
+	(test-t (string= (cl-make-string 3 :initial-element #\a) "aaa"))
+	(test-t (string= (cl-make-string 1 :initial-element #\space) " "))
+	(test-t (string= (cl-make-string 0) ""))
+
+	(test-t (dotimes (i 10)))
+	(test-t (= (dotimes (temp-one 10 temp-one)) 10))
+	(test-t (let ((temp-two 0)) (and (eq t (dotimes (temp-one 10 t) (incf temp-two)))  (eql temp-two 10))))
+	(test-t (let ((count 0))  (eql (dotimes (i 5 count) (incf count)) 5)))
+	(test-t (let ((count 0))  (eql (dotimes (i 1 count) (incf count)) 1)))
+	(test-t (let ((count 0))  (zerop (dotimes (i 0 count) (incf count)))))
+	(test-t (let ((count 0))  (zerop (dotimes (i -1 count) (incf count)))))
+	(test-t (let ((count 0))  (zerop (dotimes (i -100 count) (incf count)))))
+	(test-t (eql (dotimes (i 3 i)) 3))
+	(test-t (eql (dotimes (i 2 i)) 2))
+	(test-t (eql (dotimes (i 1 i)) 1))
+	(test-t (eql (dotimes (i 0 i)) 0))
+	(test-t (eql (dotimes (i -1 i)) 0))
+	(test-t (eql (dotimes (i -2 i)) 0))
+	(test-t (eql (dotimes (i -10 i)) 0))
+	(test-t (let ((list nil))  (and (eq (dotimes (i 10 t) (push i list)) t)       (equal list '(9 8 7 6 5 4 3 2 1 0)))))
+	(test-t (let ((list nil))  (equal (dotimes (i 10 (push i list)) (push i list))	 '(10 9 8 7 6 5 4 3 2 1 0))))
+	(test-t (let ((list nil))  (equal (dotimes (i '10 (push i list)) (push i list))	 '(10 9 8 7 6 5 4 3 2 1 0))))
+	(test-t (let ((list nil))  (equal (dotimes (i (/ 100 10) (push i list)) (push i list))	 '(10 9 8 7 6 5 4 3 2 1 0))))
+	(test-t (= 3 (let ((i 3)) (dotimes (i i i) ))))
+	(test-t (= 3 (let ((x 0)) (dotimes (i 3 x) (incf x)))))
+	(test-t (= 3 (dotimes (i 3 i) )))
+	(test-t (= 3 (let ((x 0)) (dotimes (i 3 x) (declare (fixnum i)) (incf x)))))
+	(test-t (dolist (x ())))
+	(test-t (dolist (x '(a))))
+	(test-t (eq t (dolist (x nil t))))
+	(test-t (= 6 (let ((sum 0))       (dolist (x '(0 1 2 3) sum)	 (incf sum x)))))
+	(test-t (let ((temp-two ()))  (equal (dolist (temp-one '(1 2 3 4) temp-two) (push temp-one temp-two))	 '(4 3 2 1))))
+	(test-t (let ((temp-two 0))  (and (dolist (temp-one '(1 2 3 4)) (incf temp-two)) (eql temp-two 4))))
+	(test-t (not (dolist (var nil var))))
+	(test-t (let ((list nil))  (equal (dolist (var '(0 1 2 3) list)	   (push var list))	 '(3 2 1 0))))
+	(test-t (dolist (var '(0 1 2 3))))
+	(test-t (eql (do ((temp-one 1 (1+ temp-one))	  (temp-two 0 (1- temp-two)))	 ((> (- temp-one temp-two) 5) temp-one))     4))
+	(test-t (eql (do ((temp-one 1 (1+ temp-one))	  (temp-two 0 (1+ temp-one)))     	 ((= 3 temp-two) temp-one))     3))
+	(test-t (eql (do* ((temp-one 1 (1+ temp-one))	   (temp-two 0 (1+ temp-one)))	 ((= 3 temp-two) temp-one))     2))
+
+	(test-t (let ((a-vector (vector 1 nil 3 nil)))
+		  (do ((i 0 (+ i 1))
+		       (n (array-dimension a-vector 0)))
+		      ((= i n))
+		    (when (null (aref a-vector i))
+			  (setf (aref a-vector i) 0)))
+		  (equalp a-vector #(1 0 3 0))))
+
+	(test-t (let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
+		  (equalp (do ((i 0 (1+ i))
+			       (n #f)
+			       (j 9 (1- j)))
+			      ((>= i j) vec)
+			    (setq n (aref vec i))
+			    (setf (aref vec i) (aref vec j))
+			    (setf (aref vec j) n))
+			  #(9 8 7 6 5 4 3 2 1 0))))
+
+	(test-t (let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
+		  (and (do ((i 0 (1+ i))
+			    (n #f)
+			    (j 9 (1- j)))
+			   ((>= i j))
+			 (setq n (aref vec i))
+			 (setf (aref vec i) (aref vec j))
+			 (setf (aref vec j) n))
+		       (equalp vec #(9 8 7 6 5 4 3 2 1 0)))))
+
+	(test-t (let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
+		  (and (do ((i 0 (1+ i))
+			    (n #f)
+			    (j 9 (1- j)))
+			   ((>= i j))
+			 (setq n (aref vec i))
+			 (setf (aref vec i) (aref vec j))
+			 (setf (aref vec j) n))
+		       (equalp vec #(9 8 7 6 5 4 3 2 1 0)))))
+
+	(test-t (let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
+		  (and (do ((n #f)
+			    (i 0 (1+ i))
+			    (j 9 (1- j)))
+			   ((>= i j))
+			 (setq n (aref vec i))
+			 (setf (aref vec i) (aref vec j))
+			 (setf (aref vec j) n))
+		       (equalp vec #(9 8 7 6 5 4 3 2 1 0)))))
+
+	(test-t (let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
+		  (and (do ((i 0 (1+ i))
+			    (j 9 (1- j))
+			    (n #f))
+			   ((>= i j))
+			 (setq n (aref vec i))
+			 (setf (aref vec i) (aref vec j))
+			 (setf (aref vec j) n))
+		       (equalp vec #(9 8 7 6 5 4 3 2 1 0)))))
+
+	(test-t (= (funcall (lambda (x) (+ x 3)) 4) 7))
+	(test-t (= (funcall (lambda args (apply + args)) 1 2 3 4) 10))
+	(test-t (functionp (lambda args (apply + args))))
+
+	(test-t (consp (cons 'a 'b)))
+	(test-t (consp '(1 . 2)))
+	(test-t (consp (list nil)))
+	(test-t (not (consp 'a)))
+	(test-t (not (consp nil)))
+	(test-t (not (consp 1)))
+	(test-t (not (consp #\a)))
+	(test-t (let ((a (cons 1 2))) (and (eql (car a) 1) (eql (cdr a) 2))))
+	(test-t (equal (cons 1 nil) '(1)))
+	(test-t (equal (cons nil nil) '(())))
+	(test-t (equal (cons 'a (cons 'b (cons 'c ()))) '(a b c)))
+	(test-t (atom 'a))
+	(test-t (atom nil))
+	(test-t (atom 1))
+	(test-t (atom #\a))
+	(test-t (not (atom (cons 1 2))))
+	(test-t (not (atom '(a . b))))
+	(test-t (not (atom (list nil))))
+	(test-t (listp nil))
+	(test-t (listp '(a b c)))
+	(test-t (listp '(a . b)))
+	(test-t (listp (cons 'a 'b)))
+	(test-t (not (listp 1)))
+	(test-t (not (listp 't)))
+	(test-t (null ()))
+	(test-t (null nil))
+	(test-t (not (null t)))
+	(test-t (null (cdr '(a))))
+	(test-t (not (null (cdr '(1 . 2)))))
+	(test-t (not (null 'a)))
+	(test-t (endp ()))
+	(test-t (not (endp '(1))))
+	(test-t (not (endp '(1 2))))
+	(test-t (not (endp '(1 2 3))))
+	(test-t (not (endp (cons 1 2))))
+	(test-t (endp (cddr '(1 2))))
+	(test-t (let ((a (cons 1 2))) (and (eq (rplaca a 0) a) (equal a '(0 . 2)))))
+	(test-t (let ((a (list 1 2 3))) (and (eq (rplaca a 0) a) (equal a '(0 2 3)))))
+	(test-t (let ((a (cons 1 2))) (and (eq (rplacd a 0) a) (equal a '(1 . 0)))))
+	(test-t (let ((a (list 1 2 3))) (and (eq (rplacd a 0) a) (equal a '(1 . 0)))))
+	(test-t (eq (car '(a . b)) 'a))
+	(test-t (let ((a (cons 1 2))) (eq (car (list a)) a)))
+	(test-t (eq (cdr '(a . b)) 'b))
+	(test-t (eq (rest '(a . b)) 'b))
+	(test-t (let ((a (cons 1 2))) (eq (cdr (cons 1 a)) a)))
+	(test-t (let ((a (cons 1 2))) (eq (rest (cons 1 a)) a)))
+	(test-t (eq (caar '((a) b c)) 'a))
+	(test-t (eq (cadr '(a b c)) 'b))
+	(test-t (eq (cdar '((a . aa) b c)) 'aa))
+	(test-t (eq (cddr '(a b . c)) 'c))
+	(test-t (eq (caaar '(((a)) b c)) 'a))
+	(test-t (eq (caadr '(a (b) c)) 'b))
+	(test-t (eq (cadar '((a aa) b c)) 'aa))
+	(test-t (eq (caddr '(a b c)) 'c))
+	(test-t (eq (cdaar '(((a . aa)) b c)) 'aa))
+	(test-t (eq (cdadr '(a (b . bb) c)) 'bb))
+	(test-t (eq (cddar '((a aa . aaa) b c)) 'aaa))
+	(test-t (eq (cdddr '(a b c . d)) 'd))
+	(test-t (eq (caaaar '((((a))) b c)) 'a))
+	(test-t (eq (caaadr '(a ((b)) c)) 'b))
+	(test-t (eq (caadar '((a (aa)) b c)) 'aa))
+	(test-t (eq (caaddr '(a b (c))) 'c))
+	(test-t (eq (cadaar '(((a aa)) b c)) 'aa))
+	(test-t (eq (cadadr '(a (b bb) c)) 'bb))
+	(test-t (eq (caddar '((a aa aaa) b c)) 'aaa))
+	(test-t (eq (cadddr '(a b c d)) 'd))
+	(test-t (eq (cdaaar '((((a . aa))) b c)) 'aa))
+	(test-t (eq (cdaadr '(a ((b . bb)) c)) 'bb))
+	(test-t (eq (cdadar '((a (aa . aaa)) b c)) 'aaa))
+	(test-t (eq (cdaddr '(a b (c . cc))) 'cc))
+	(test-t (eq (cddaar '(((a aa . aaa)) b c)) 'aaa))
+	(test-t (eq (cddadr '(a (b bb . bbb) c)) 'bbb))
+	(test-t (eq (cdddar '((a aa aaa . aaaa) b c)) 'aaaa))
+	(test-t (eq (cddddr '(a b c d . e)) 'e))
+	(test-t (eq (copy-tree nil) nil))
+	(test-t (let* ((a (list 'a))
+		       (b (list 'b))
+		       (c (list 'c))
+		       (x3 (cons c nil))
+		       (x2 (cons b x3))
+		       (x (cons a x2))
+		       (y (copy-tree x)))
+		  (and (not (eq x y))
+		       (not (eq (car x) (car y)))
+		       (not (eq (cdr x) (cdr y)))
+		       (not (eq (cadr x) (cadr y)))
+		       (not (eq (cddr x) (cddr y)))
+		       (not (eq (caddr x) (caddr y)))
+		       (eq (cdddr x) (cdddr y))
+		       (equal x y)
+		       (eq (car x) a) (eq (car a) 'a) (eq (cdr a) nil)
+		       (eq (cdr x) x2)
+		       (eq (car x2) b) (eq (car b) 'b) (eq (cdr b) nil)
+		       (eq (cdr x2) x3)
+		       (eq (car x3) c) (eq (car c) 'c) (eq (cdr c) nil)
+		       (eq (cdr x3) nil))))
+	(test-t (let* ((x (list (list 'a 1) (list 'b 2) (list 'c 3)))
+		       (y (copy-tree x)))
+		  (and (not (eq (car x) (car y)))
+		       (not (eq (cadr x) (cadr y)))
+		       (not (eq (caddr x) (caddr y))))))
+	(test-t (let* ((x (list (list (list 1))))
+		       (y (copy-tree x)))
+		  (and (not (eq x y))
+		       (not (eq (car x) (car y)))
+		       (not (eq (caar x) (caar y))))))
+	(test-t (let ((x (list 'a 'b 'c 'd)))
+		  (and (equal (sublis '((a . 1) (b . 2) (c . 3)) x)
+			      '(1 2 3 d))
+		       (equal x '(a b c d)))))
+	(test-t (eq (sublis () ()) ()))
+	(test-t (equal (sublis () '(1 2 3)) '(1 2 3)))
+	(test-t (eq (sublis '((a . 1) (b . 2)) ()) nil))
+	(test-t (equal (sublis '((a . 1) (b . 2) (c . 3)) '(((a)) (b) c)) '(((1)) (2) 3)))
+	(test-t (equal (sublis '(((a) . 1) ((b) . 2) ((c) . 3)) '((((a))) ((b)) (c))) '((((a))) ((b)) (c))))
+	(test-t (equal (sublis '(((a) . 1) ((b) . 2) ((c) . 3)) '((((a))) ((b)) (c)) :test equal) '(((1)) (2) 3)))
+	(test-t (equal (nsublis '((a . 1) (b . 2) (c . 3)) (list 'a 'b 'c 'd)) '(1 2 3 d)))
+	(test-t (let* ((x (list 'a 'b 'c 'd)) (y (nsublis '((a . 1) (b . 2) (c . 3)) x))) (and (eq x y) (equal x '(1 2 3 d)))))
+	(test-t (let ((x (list 'l 'm 'n))) (and (eq (nsublis '((a . 1) (b . 2) (c . 3)) x) x) (equal x '(l m n)))))
+	(test-t (let* ((n (cons 'n nil))
+		       (m (cons 'm n))
+		       (l (cons 'l m))
+		       (x (nsublis '((a . 1) (b . 2) (c . 3)) l)))
+		  (and (eq x l)
+		       (eq (car l) 'l)
+		       (eq (cdr l) m)
+		       (eq (car m) 'm)
+		       (eq (cdr m) n)
+		       (eq (car n) 'n)
+		       (eq (cdr n) nil))))
+	(test-t (eq (nsublis () ()) ()))
+	(test-t (equal (nsublis () '(1 2 3)) '(1 2 3)))
+	(test-t (eq (nsublis '((a . 1) (b . 2)) ()) nil))
+	(test-t (equal (nsublis '((a b c) (b c d) (c d e)) (list 'a 'b 'c)) '((b c) (c d) (d e))))
+	(test-t (equal (nsublis '((a . 1) (b . 2) (c . 3)) (copy-tree '(((a)) (b) c))) '(((1)) (2) 3)))
+	(test-t (equal (nsublis '(((a) . 1) ((b) . 2) ((c) . 3)) (copy-tree '((((a))) ((b)) (c)))) '((((a))) ((b)) (c))))
+	(test-t (equal (nsublis '(((a) . 1) ((b) . 2) ((c) . 3)) (copy-tree '((((a))) ((b)) (c))) :test equal) '(((1)) (2) 3)))
+	(test-t (tree-equal 'a 'a))
+	(test-t (not (tree-equal 'a 'b)))
+	(test-t (tree-equal '(a (b (c))) '(a (b (c)))))
+	(test-t (tree-equal '(a (b (c))) '(a (b (c))) :test eq))
+	(test-t (not (tree-equal '("a" ("b" ("c"))) '("a" ("b" ("c"))))))
+	(test-t (tree-equal '("a" ("b" ("c"))) '("a" ("b" ("c"))) :test equal))
+	(test-t (not (tree-equal '(a b) '(a (b)))))
+	(test-t (eq (copy-list ()) ()))
+	(test-t (equal (copy-list '(a b c)) '(a b c)))
+	(test-t (equal (copy-list '(a . b)) '(a . b)))
+	(test-t (let* ((x '(a b c)) (y (copy-list x))) (and (equal x y) (not (eq x y)))))
+	(test-t (let* ((a (list 'a))
+		       (b (list 'b))
+		       (c (list 'c))
+		       (x (list a b c))
+		       (y (copy-list x)))
+		  (and (equal x y)
+		       (not (eq x y))
+		       (eq (car x) (car y))
+		       (eq (cadr x) (cadr y))
+		       (eq (caddr x) (caddr y))
+		       (eq (caar x) 'a)
+		       (eq (caadr x) 'b)
+		       (eq (caaddr x) 'c))))
+	(test-t (null (list)))
+	(test-t (equal (list 1) '(1)))
+	(test-t (equal (list 1 2 3) '(1 2 3)))
+	(test-t (equal (list* 1 2 '(3)) '(1 2 3)))
+	(test-t (equal (list* 1 2 'x) '(1 2 . x)))
+	(test-t (equal (list* 1 2 '(3 4)) '(1 2 3 4)))
+	(test-t (eq (list* 'x) 'x))
+	(test-t (eql (list-length ()) 0))
+	(test-t (eql (list-length '(1)) 1))
+	(test-t (eql (list-length '(1 2)) 2))
+	(test-t (equal (cl-make-list 5) '(() () () () ())))
+	(test-t (equal (cl-make-list 3 :initial-element 'rah) '(rah rah rah)))
+	(test-t (equal (cl-make-list 2 :initial-element '(1 2 3)) '((1 2 3) (1 2 3))))
+	(test-t (null (cl-make-list 0)))
+	(test-t (null (cl-make-list 0 :initial-element 'new-element)))
+	(test-t (let ((place nil)) (and (equal (push 0 place) '(0)) (equal place '(0)))))
+	(test-t (let ((place (list 1 2 3))) (and (equal (push 0 place) '(0 1 2 3)) (equal place '(0 1 2 3)))))
+	(test-t (let ((a (list (list 1 2 3) 9))) (and (equal (push 0 (car a)) '(0 1 2 3)) (equal a '((0 1 2 3) 9)))))
+	(test-t (let ((place (list 1 2 3))) (and (eql (pop place) 1) (equal place '(2 3)))))
+	(test-t (let ((a (list (list 1 2 3) 9))) (and (eql (pop (car a)) 1) (equal a '((2 3) 9)))))
+	(test-t (let ((x (list 'a 'b 'c))) (and (eq (pop (cdr x)) 'b) (equal x '(a c)))))
+	(test-t (eq (first '(a . b)) 'a))
+	(test-t (null (first nil)))
+	(test-t (let ((a (cons 1 2))) (eq (first (list a)) a)))
+	(test-t (eql (first '(1 2 3)) '1))
+	(test-t (eql (second '(1 2 3)) '2))
+	(test-t (eql (third '(1 2 3)) '3))
+	(test-t (eql (fourth '(1 2 3 4)) '4))
+	(test-t (eql (fifth '(1 2 3 4 5)) '5))
+	(test-t (eql (sixth '(1 2 3 4 5 6)) '6))
+	(test-t (eql (seventh '(1 2 3 4 5 6 7)) '7))
+	(test-t (eql (eighth '(1 2 3 4 5 6 7 8)) '8))
+	(test-t (eql (ninth '(1 2 3 4 5 6 7 8 9)) '9))
+	(test-t (eql (tenth '(1 2 3 4 5 6 7 8 9 10)) '10))
+	(test-t (let ((x '(a b c))) (eq (nthcdr 0 x) x)))
+	(test-t (let ((x '(a b c))) (eq (nthcdr 1 x) (cdr x))))
+	(test-t (let ((x '(a b c))) (eq (nthcdr 2 x) (cddr x))))
+	(test-t (let ((x '(a b c))) (eq (nthcdr 2 x) (cddr x))))
+	(test-t (let ((x '(a b c))) (eq (nthcdr 3 x) (cdddr x))))
+	(test-t (equal (nthcdr 0 '(0 1 2)) '(0 1 2)))
+	(test-t (equal (nthcdr 1 '(0 1 2)) '(1 2)))
+	(test-t (equal (nthcdr 2 '(0 1 2)) '(2)))
+	(test-t (equal (nthcdr 3 '(0 1 2)) ()))
+	(test-t (eql (nthcdr 1 '(0 . 1)) 1))
+	(test-t (eql (nth 0 '(a b c)) 'a))
+	(test-t (eql (nth 1 '(a b c)) 'b))
+	(test-t (eql (nth 2 '(a b c)) 'c))
+	(test-t (eql (nth 3 '(a b c)) ()))
+	(test-t (eql (nth 4 '(a b c)) ()))
+	(test-t (eql (nth 5 '(a b c)) ()))
+	(test-t (eql (nth 6 '(a b c)) ()))
+	(test-t (let ((x (list 'a 'b 'c))) (and (eq (setf (nth 0 x) 'z) 'z) (equal x '(z b c)))))
+	(test-t (let ((x (list 'a 'b 'c))) (and (eq (setf (nth 1 x) 'z) 'z) (equal x '(a z c)))))
+	(test-t (let ((x (list 'a 'b 'c))) (and (eq (setf (nth 2 x) 'z) 'z) (equal x '(a b z)))))
+	(test-t (let ((0-to-3 (list 0 1 2 3))) (and (equal (setf (nth 2 0-to-3) "two") "two") (equal 0-to-3 '(0 1 "two" 3)))))
+	(test-t (let* ((x (list 'a 'b 'c))) (eq (nconc x) x)))
+	(test-t (let* ((x (list 'a 'b 'c))
+		       (y (list 'd 'e 'f))
+		       (list (nconc x y)))
+		  (and (eq list x)
+		       (eq (nthcdr 3 list) y)
+		       (equal list '(a b c d e f)))))
+	(test-t (let* ((x (list 'a))
+		       (y (list 'b))
+		       (z (list 'c))
+		       (list (nconc x y z)))
+		  (and (eq x list)
+		       (eq (first list) 'a)
+		       (eq y (cdr list))
+		       (eq (second list) 'b)
+		       (eq z (cddr list))
+		       (eq (third list) 'c))))
+	(test-t (equal (append '(a b) () '(c d) '(e f)) '(a b c d e f)))
+	(test-t (null (append)))
+	(test-t (null (append ())))
+	(test-t (null (append () ())))
+	(test-t (eq (append 'a) 'a))
+	(test-t (eq (append () 'a) 'a))
+	(test-t (eq (append () () 'a) 'a))
+	(test-t (equal (append '(a b) 'c) '(a b . c)))
+	(test-t (let* ((x '(a b c))
+		       (y '(d e f))
+		       (z (append x y)))
+		  (and (equal z '(a b c d e f))
+		       (eq (nthcdr 3 z) y)
+		       (not (eq x z)))))
+	(test-t (equal (revappend '(a b c) '(d e f)) '(c b a d e f)))
+	(test-t (let* ((x '(a b c))
+		       (y '(d e f))
+		       (z (revappend x y)))
+		  (and (equal z '(c b a d e f))
+		       (not (eq x z))
+		       (eq (nthcdr 3 z) y))))
+	(test-t (let ((x '(a b c))) (eq (revappend () x) x)))
+	(test-t (null (revappend () ())))
+	(test-t (eq (revappend () 'a) 'a))
+	(test-t (equal (revappend '(a) 'b) '(a . b)))
+	(test-t (equal (revappend '(a) ()) '(a)))
+	(test-t (equal (revappend '(1 2 3) ()) '(3 2 1)))
+	(test-t (equal (nreconc (list 'a 'b 'c) '(d e f)) '(c b a d e f)))
+	(test-t (let* ((x (list 'a 'b 'c))
+		       (y '(d e f))
+		       (z (nreconc x y)))
+		  (and (equal z '(c b a d e f))
+		       (eq (nthcdr 3 z) y))))
+	(test-t (equal (nreconc (list 'a) 'b) '(a . b)))
+	(test-t (equal (nreconc (list 'a) ()) '(a)))
+	(test-t (equal (nreconc (list 1 2 3) ()) '(3 2 1)))
+	(test-t (null (butlast nil)))
+	(test-t (null (butlast nil 1)))
+	(test-t (null (butlast nil 2)))
+	(test-t (null (butlast nil 3)))
+	(test-t (equal (butlast '(1 2 3 4 5)) '(1 2 3 4)))
+	(test-t (equal (butlast '(1 2 3 4 5) 1) '(1 2 3 4)))
+	(test-t (equal (butlast '(1 2 3 4 5) 2) '(1 2 3)))
+	(test-t (equal (butlast '(1 2 3 4 5) 3) '(1 2)))
+	(test-t (equal (butlast '(1 2 3 4 5) 4) '(1)))
+	(test-t (equal (butlast '(1 2 3 4 5) 5) ()))
+	(test-t (equal (butlast '(1 2 3 4 5) 6) ()))
+	(test-t (equal (butlast '(1 2 3 4 5) 7) ()))
+	(test-t (let ((a '(1 2 3 4 5))) (equal (butlast a 3) '(1 2)) (equal a '(1 2 3 4 5))))
+	(test-t (null (nbutlast nil)))
+	(test-t (null (nbutlast nil 1)))
+	(test-t (null (nbutlast nil 2)))
+	(test-t (null (nbutlast nil 3)))
+	(test-t (equal (nbutlast (list 1 2 3 4 5)) '(1 2 3 4)))
+	(test-t (equal (nbutlast (list 1 2 3 4 5) 1) '(1 2 3 4)))
+	(test-t (equal (nbutlast (list 1 2 3 4 5) 2) '(1 2 3)))
+	(test-t (equal (nbutlast (list 1 2 3 4 5) 3) '(1 2)))
+	(test-t (equal (nbutlast (list 1 2 3 4 5) 4) '(1)))
+	(test-t (equal (nbutlast (list 1 2 3 4 5) 5) ()))
+	(test-t (equal (nbutlast (list 1 2 3 4 5) 6) ()))
+	(test-t (equal (nbutlast (list 1 2 3 4 5) 7) ()))
+	(test-t (equal (nbutlast (list* 1 2 3 4 5 6)) '(1 2 3 4)))
+	(test-t (equal (nbutlast (list* 1 2 3 4 5 6) 1) '(1 2 3 4)))
+	(test-t (equal (nbutlast (list* 1 2 3 4 5 6) 2) '(1 2 3)))
+	(test-t (equal (nbutlast (list* 1 2 3 4 5 6) 3) '(1 2)))
+	(test-t (equal (nbutlast (list* 1 2 3 4 5 6) 4) '(1)))
+	(test-t (equal (nbutlast (list* 1 2 3 4 5 6) 5) ()))
+	(test-t (equal (nbutlast (list* 1 2 3 4 5 6) 6) ()))
+	(test-t (equal (nbutlast (list* 1 2 3 4 5 6) 7) ()))
+	(test-t (let* ((a '(1 2 3 4 5)) (b (nbutlast a 3))) (and (eq a b) (equal a '(1 2)))))
+	(test-t (let ((x '(0 1 2 3 4 5 6 7 8 9))) (eq (last x) (nthcdr 9 x))))
+	(test-t (let ((x '(0 1 2 3 4))) (eq (last x 0) nil)))
+	(test-t (let ((x '(0 1 2 3 4))) (eq (last x) (nthcdr 4 x))))
+	(test-t (let ((x '(0 1 2 3 4))) (eq (last x 1) (nthcdr 4 x))))
+	(test-t (let ((x '(0 1 2 3 4))) (eq (last x 2) (cdddr x))))
+	(test-t (let ((x '(0 1 2 3 4))) (eq (last x 3) (cddr x))))
+	(test-t (let ((x '(0 1 2 3 4))) (eq (last x 4) (cdr x))))
+	(test-t (let ((x '(0 1 2 3 4))) (eq (last x 5) x)))
+	(test-t (let ((x '(0 1 2 3 4))) (eq (last x 6) x)))
+	(test-t (let ((x '(0 1 2 3 4))) (eq (last x 7) x)))
+	(test-t (let ((x '(0 1 2 3 4))) (eq (last x 8) x)))
+	(test-t (tailp () ()))
+	(test-t (tailp () '(1)))
+	(test-t (tailp () '(1 2 3 4 5 6 7 8 9)))
+	(test-t (let ((x '(1 2 3))) (and (tailp x x) (tailp (cdr x) x) (tailp (cddr x) x) (tailp (cdddr x) x))))
+	(test-t (let ((x '(1 . 2))) (and (tailp x x) (tailp (cdr x) x))))
+	(test-t (not (tailp 'x '(1 2 3 4 5 6))))
+	(test-t (not (tailp (list 1 2 3) '(1 2 3))))
+	(test-t (define (ldiff . args) #f))
+	(test-t (null (ldiff () ())))
+	(test-t (equal (ldiff '(1 . 2) 2) '(1)))
+	(test-t (equal (ldiff '(1 2 3 4 5 6 7 8 9) ()) '(1 2 3 4 5 6 7 8 9)))
+	(test-t (let ((x '(1 2 3)))
+		  (and (null (ldiff x x))
+		       (equal (ldiff x (cdr x)) '(1))
+		       (equal (ldiff x (cddr x)) '(1 2))
+		       (equal (ldiff x (cdddr x)) '(1 2 3)))))
+	(test-t (let* ((x '(1 2 3))
+		       (y '(a b c))
+		       (z (ldiff x y)))
+		  (and (not (eq x z))
+		       (equal z '(1 2 3)))))
+	(test-t (equal (cl-member 'a '(a b c d)) '(a b c d)))
+	(test-t (equal (cl-member 'b '(a b c d)) '(b c d)))
+	(test-t (equal (cl-member 'c '(a b c d)) '(c d)))
+	(test-t (equal (cl-member 'd '(a b c d)) '(d)))
+	(test-t (equal (cl-member 'e '(a b c d)) ()))
+	(test-t (equal (cl-member 'f '(a b c d)) ()))
+	(test-t (let ((x '(a b c d)))
+		  (eq (cl-member 'a x) x)
+		  (eq (cl-member 'b x) (cdr x))
+		  (eq (cl-member 'c x) (cddr x))
+		  (eq (cl-member 'd x) (cdddr x))
+		  (eq (cl-member 'e x) nil)))
+	(test-t (equal (cl-member 'a '(a b c d) :test eq) '(a b c d)))
+	(test-t (equal (cl-member 'b '(a b c d) :test eq) '(b c d)))
+	(test-t (equal (cl-member 'c '(a b c d) :test eq) '(c d)))
+	(test-t (equal (cl-member 'd '(a b c d) :test eq) '(d)))
+	(test-t (equal (cl-member 'e '(a b c d) :test eq) ()))
+	(test-t (equal (cl-member 'f '(a b c d) :test eq) ()))
+	(test-t (null (cl-member 'a ())))
+	(test-t (let* ((x '((1 . a) (2 . b) (3 . c) (4 . d) (5 . e)))
+		       (y (cl-member 'd x :key cdr :test eq)))
+		  (and (equal y '((4 . d) (5 . e)))
+		       (eq y (nthcdr 3 x)))))
+	(test-t (let* ((x '((1 . a) (2 . b) (3 . c) (4 . d) (5 . e)))
+		       (y (cl-member 'd x :key cdr)))
+		  (and (equal y '((4 . d) (5 . e)))
+		       (eq y (nthcdr 3 x)))))
+	(test-t (equal (member-if (lambda (x) (eql x 'a)) '(a b c d)) '(a b c d)))
+	(test-t (equal (member-if (lambda (x) (eql x 'b)) '(a b c d)) '(b c d)))
+	(test-t (equal (member-if (lambda (x) (eql x 'c)) '(a b c d)) '(c d)))
+	(test-t (equal (member-if (lambda (x) (eql x 'd)) '(a b c d)) '(d)))
+	(test-t (equal (member-if (lambda (x) (eql x 'e)) '(a b c d)) ()))
+	(test-t (equal (member-if (lambda (x) (eql x 'f)) '(a b c d)) ()))
+	(test-t (null (member-if (lambda (x) (eql x 'a)) ())))
+	(test-t (let* ((x '((1 . a) (2 . b) (3 . c) (4 . d) (5 . e)))
+		       (y (member-if (lambda (p) (eq p 'd)) x :key cdr)))
+		  (and (equal y '((4 . d) (5 . e)))
+		       (eq y (nthcdr 3 x)))))
+	(test-t (null (member-if zerop '(7 8 9))))
+	(test-t (equal (member-if-not (lambda (x) (not (eql x 'a))) '(a b c d)) '(a b c d)))
+	(test-t (equal (member-if-not (lambda (x) (not (eql x 'b))) '(a b c d)) '(b c d)))
+	(test-t (equal (member-if-not (lambda (x) (not (eql x 'c))) '(a b c d)) '(c d)))
+	(test-t (equal (member-if-not (lambda (x) (not (eql x 'd))) '(a b c d)) '(d)))
+	(test-t (equal (member-if-not (lambda (x) (not (eql x 'e))) '(a b c d)) ()))
+	(test-t (equal (member-if-not (lambda (x) (not (eql x 'f))) '(a b c d)) ()))
+	(test-t (null (member-if-not (lambda (x) (not (eql x 'a))) ())))
+
+	(test-t (let* ((x '((1 . a) (2 . b) (3 . c) (4 . d) (5 . e)))
+		       (y (member-if-not (lambda (p) (not (eq p 'd))) x :key cdr)))
+		  (and (equal y '((4 . d) (5 . e)))
+		       (eq y (nthcdr 3 x)))))
+
+	(test-t (let ((dummy nil)
+		      (list-1 '(1 2 3 4)))
+		  (and (eq (mapc (lambda x (setq dummy (append dummy x)))
+				 list-1
+				 '(a b c d e)
+				 '(x y z))
+			   list-1)
+		       (equal dummy '(1 a x 2 b y 3 c z)))))
+	(test-t (let* ((x '(0 1 2 3))
+		       (y nil)
+		       (z (mapc (lambda (a b c) (push (list a b c) y))
+				x '(1 2 3 4) '(2 3 4 5))))
+		  (and (eq z x)
+		       (equal y '((3 4 5) (2 3 4) (1 2 3) (0 1 2))))))
+	(test-t (let* ((x '(0 1 2 3))
+		       (y nil)
+		       (z (mapc (lambda (a b c) (push (list a b c) y))
+				nil x '(1 2 3 4) '(2 3 4 5))))
+		  (and (null z)
+		       (null y))))
+	(test-t (let ((sum 0))
+		  (mapc (lambda rest (setq sum (+ sum (apply + rest))))
+			'(0 1 2)
+			'(1 2 0)
+			'(2 0 1))
+		  (eql sum 9)))
+	(test-t (let ((result 'initial-value)
+		      (list-1 nil))
+		  (and (eq (mapc (lambda (a b) (setq result (cons (cons a b) result))) list-1) list-1)
+		       (eq result 'initial-value))))
+	(test-t (let ((result 'initial-value)
+		      (list-1 nil))
+		  (and (eq (mapc (lambda (a b) (setq result (cons (cons a b) result)))
+				 list-1
+				 '(1 2 3))
+			   list-1)
+		       (eq result 'initial-value))))
+	(test-t (let ((result 'initial-value)
+		      (list-1 '(1 2 3)))
+		  (and (eq (mapc (lambda (a b) (setq result (cons (cons a b) result)))
+				 list-1
+				 ())
+			   list-1)
+		       (eq result 'initial-value))))
+	(test-t (equal (mapcar car '((1 2) (2 3) (3 4) (4 5))) '(1 2 3 4)))
+	(test-t (null (mapcar identity ())))
+	(test-t (equal (mapcar list '(0 1 2 3) '(a b c d) '(w x y z)) '((0 a w) (1 b x) (2 c y) (3 d z))))
+	(test-t (null (mapcar list () '(0 1 2 3) '(1 2 3 4) '(2 3 4 5))))
+	(test-t (null (mapcar list '(0 1 2 3) () '(1 2 3 4) '(2 3 4 5))))
+	(test-t (null (mapcar list '(0 1 2 3) '(1 2 3 4) () '(2 3 4 5))))
+	(test-t (null (mapcar list '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) ())))
+	(test-t (equal (mapcar list '(0) '(a b) '(x y z)) '((0 a x))))
+	(test-t (equal (mapcar list '(a b) '(0) '(x y z)) '((a 0 x))))
+	(test-t (equal (mapcar list '(a b) '(x y z) '(0)) '((a x 0))))
+	(test-t (equal (mapcar cons '(a b c) '(1 2 3)) '((a . 1) (b . 2) (c . 3))))
+	(test-t (equal (mapcan cdr (copy-tree '((1 2) (2 3) (3 4) (4 5)))) '(2 3 4 5)))
+	(test-t (equal (mapcan append
+			       '((1 2 3) (4 5 6) (7 8 9))
+			       '((a) (b c) (d e f))
+			       (list (list 'x 'y 'z) (list 'y 'z) (list 'z)))
+		       '(1 2 3 a x y z 4 5 6 b c y z 7 8 9 d e f z)))
+	(test-t (null (mapcan append '((1 2 3) (4 5 6) (7 8 9)) '((a) (b c)) ())))
+	(test-t (null (mapcan append '((1 2 3) (4 5 6) (7 8 9)) () '((a) (b c)))))
+	(test-t (null (mapcan append () '((1 2 3) (4 5 6) (7 8 9)) '((a) (b c)))))
+	(test-t (equal (mapcan list
+			       (list 1 2 3 4 5)
+			       (list 2 3 4 5 6)
+			       (list 3 4 5 6 7)
+			       (list 4 5 6 7 8))
+		       '(1 2 3 4 2 3 4 5 3 4 5 6 4 5 6 7 5 6 7 8)))
+	(test-t (equal (mapcan (lambda (x y) (if (null x) () (list x y)))
+			       '(() () () d e)
+			       '(1 2 3 4 5 6))
+		       '(d 4 e 5)))
+	(test-t (equal (mapcan (lambda (x) (if (numberp x) (list x) ()))
+			       '(a 1 b c 3 4 d 5))
+		       '(1 3 4 5)))
+	(test-t (equal (maplist identity '(a b c d)) '((a b c d) (b c d) (c d) (d))))
+	(test-t (equal (maplist car '((1 2) (2 3) (3 4) (4 5))) '((1 2) (2 3) (3 4) (4 5))))
+	(test-t (equal (maplist list '(a b c) '(b c d) '(c d e))
+		       '(((a b c) (b c d) (c d e))
+			 ((b c) (c d) (d e))
+			 ((c) (d) (e)))))
+	(test-t (equal (maplist append '(a b c) '(b c d) '(c d e)) '((a b c b c d c d e) (b c c d d e) (c d e))))
+	(test-t (equal (maplist append '(a b c) '(b c) '(c)) '((a b c b c c))))
+	(test-t (null (maplist append () '(a b c) '(b c) '(c))))
+	(test-t (null (maplist append '(a b c) () '(b c) '(c))))
+	(test-t (null (maplist append '(a b c) '(b c) '(c) ())))
+	(test-t (let ((x '((1 2) (2 3) (3 4) (4 5)))
+		      (y nil))
+		  (and (eq (mapl (lambda (a) (push (car a) y)) x) x)
+		       (equal y '((4 5) (3 4) (2 3) (1 2))))))
+	(test-t (let ((x nil))
+		  (and (null (mapl (lambda rest (push rest x)) () '(0) '(0 1)))
+		       (null x))))
+	(test-t (let ((x nil))
+		  (and (equal (mapl (lambda rest (push rest x)) '(0) () '(0 1))
+			      '(0))
+		       (null x))))
+	(test-t (let ((x nil))
+		  (and (equal (mapl (lambda rest (push rest x)) '(0) '(0 1) ())
+			      '(0))
+		       (null x))))
+	(test-t (equal (mapcon car (copy-tree '((1 2) (2 3) (3 4) (4 5)))) '(1 2 2 3 3 4 4 5)))
+	(test-t (equal (mapcon list '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) '(3 4 5 6))
+		       '((0 1 2 3) (1 2 3 4) (2 3 4 5) (3 4 5 6) (1 2 3) (2 3 4) (3 4 5)
+			 (4 5 6) (2 3) (3 4) (4 5) (5 6) (3) (4) (5) (6))))
+	(test-t (null (mapcon list () '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) '(3 4 5 6))))
+	(test-t (null (mapcon list '(0 1 2 3) () '(1 2 3 4) '(2 3 4 5) '(3 4 5 6))))
+	(test-t (null (mapcon list '(0 1 2 3) '(1 2 3 4) () '(2 3 4 5) '(3 4 5 6))))
+	(test-t (null (mapcon list '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) () '(3 4 5 6))))
+	(test-t (null (mapcon list '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) '(3 4 5 6) ())))
+	(test-t (let* ((x '((apple . 1) (orange . 2) (grapes . 3)))
+		       (y (acons 'plum 9 x)))
+		  (and (equal y '((plum . 9) (apple . 1) (orange . 2) (grapes . 3)))
+		       (eq x (cdr y)))))
+	(test-t (equal (acons 'a '0 nil) '((a . 0))))
+	(test-t (equal (acons 'apple 1 (acons 'orange 2 (acons 'grapes '3 nil))) '((apple . 1) (orange . 2) (grapes . 3))))
+	(test-t (equal (acons () () ()) '((()))))
+	(test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (cl-assoc 'y alist) (cadr alist))))
+	(test-t (null (cl-assoc 'no-such-key '((x . 100) (y . 200) (z . 50)))))
+	(test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (cl-assoc 'y alist :test eq) (cadr alist))))
+	(test-t (null (cl-assoc 'key ())))
+	(test-t (null (cl-assoc () '(()))))
+	(test-t (null (cl-assoc () '(() ()))))
+	(test-t (let ((alist '(() () () (x . 100) (y . 200) (z . 50)))) (eq (cl-assoc 'y alist) (car (cddddr alist)))))
+	(test-t (let ((alist '((1 . a) () (2 . b) (())))) (eq (cl-assoc () alist) (cadddr alist))))
+	(test-t (let ((alist '((x . 100) (y . 200) (x . 100) (z . 50)))) (eq (cl-assoc 'y alist) (cadr alist))))
+	(test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (assoc-if (lambda (arg) (eq arg 'y)) alist) (cadr alist))))
+	(test-t (null (assoc-if consp '((x . 100) (y . 200) (z . 50)))))
+	(test-t (null (assoc-if (lambda (x) (eq x 'key)) ())))
+	(test-t (null (assoc-if identity '(()))))
+	(test-t (null (assoc-if identity '(() ()))))
+	(test-t (let ((alist '(() () () (x . 100) (y . 200) (z . 50)))) (eq (assoc-if (lambda (arg) (eq arg 'y)) alist) (car (cddddr alist)))))
+	(test-t (let ((alist '((1 . a) () (2 . b) (())))) (eq (assoc-if (lambda (arg) (null arg)) alist) (cadddr alist))))
+	(test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (assoc-if-not (lambda (arg) (not (eq arg 'y))) alist) (cadr alist))))
+	(test-t (null (assoc-if-not (complement consp) '((x . 100) (y . 200) (z . 50)))))
+	(test-t (null (assoc-if-not (lambda (x) (not (eq x 'key))) ())))
+	(test-t (null (assoc-if-not identity '(()))))
+	(test-t (null (assoc-if-not identity '(() ()))))
+	(test-t (let ((alist '(() () () (x . 100) (y . 200) (z . 50))))
+		  (eq (assoc-if-not (lambda (arg) (not (eq arg 'y))) alist)
+		      (car (cddddr alist)))))
+	(test-t (equal (copy-alist '((a . 10) (b . 100) (c . 1000)))
+		       '((a . 10) (b . 100) (c . 1000))))
+	(test-t (let* ((alist '((a . 10) (b . 100) (c . 1000)))
+		       (copy (copy-alist alist)))
+		  (and (not (eq alist copy))
+		       (not (eq (cdr alist) (cdr copy)))
+		       (not (eq (cddr alist) (cddr copy)))
+		       (not (eq (car alist) (car copy)))
+		       (not (eq (cadr alist) (cadr copy)))
+		       (not (eq (caddr alist) (caddr copy))))))
+	(test-t (let* ((alist '((a 10 x) (b 100 y) (c 1000 z)))
+		       (copy (copy-alist alist)))
+		  (and (not (eq alist copy))
+		       (not (eq (cdr alist) (cdr copy)))
+		       (not (eq (cddr alist) (cddr copy)))
+		       (not (eq (car alist) (car copy)))
+		       (not (eq (cadr alist) (cadr copy)))
+		       (not (eq (caddr alist) (caddr copy)))
+		       (eq (cdar alist) (cdar copy))
+		       (eq (cdadr alist) (cdadr copy))
+		       (eq (cdaddr alist) (cdaddr copy)))))
+	(test-t (let* ((alist (pairlis '(x y z) '(xx yy zz) '((a . aa) (b . bb)))))
+		  (and (equal (cl-assoc 'x alist) '(x . xx))
+		       (equal (cl-assoc 'y alist) '(y . yy))
+		       (equal (cl-assoc 'z alist) '(z . zz))
+		       (equal (cl-assoc 'a alist) '(a . aa))
+		       (equal (cl-assoc 'b alist) '(b . bb))
+		       (null (cl-assoc 'key alist)))))
+	(test-t (let* ((alist (pairlis '(x y z) '(xx yy zz))))
+		  (and (equal (cl-assoc 'x alist) '(x . xx))
+		       (equal (cl-assoc 'y alist) '(y . yy))
+		       (equal (cl-assoc 'z alist) '(z . zz))
+		       (null (cl-assoc 'key alist)))))
+	(test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (rassoc '200 alist) (cadr alist))))
+	(test-t (null (rassoc 'no-such-datum '((x . 100) (y . 200) (z . 50)))))
+	(test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (rassoc '200 alist :test =) (cadr alist))))
+	(test-t (null (rassoc 'key ())))
+	(test-t (null (rassoc () '(()))))
+	(test-t (null (rassoc () '(() ()))))
+	(test-t (let ((alist '(() () () (x . 100) (y . 200) (z . 50)))) (eq (rassoc '200 alist) (car (cddddr alist)))))
+	(test-t (let ((alist '((1 . a) () (2 . b) (())))) (eq (rassoc () alist) (cadddr alist))))
+	(test-t (let ((alist '((x . 100) (y . 200) (x . 100) (z . 50)))) (eq (rassoc '200 alist) (cadr alist))))
+	(test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (rassoc-if (lambda (arg) (= arg 200)) alist) (cadr alist))))
+	(test-t (null (rassoc-if consp '((x . 100) (y . 200) (z . 50)))))
+	(test-t (null (rassoc-if (lambda (x) (eq x 'key)) ())))
+	(test-t (null (rassoc-if identity '(()))))
+	(test-t (null (rassoc-if identity '(() ()))))
+	(test-t (let ((alist '(() () () (x . 100) (y . 200) (z . 50)))) (eq (rassoc-if (lambda (arg) (= arg 200)) alist) (car (cddddr alist)))))
+	(test-t (let ((alist '((1 . a) () (2 . b) (())))) (eq (rassoc-if (lambda (arg) (null arg)) alist) (cadddr alist))))
+	(test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (rassoc-if-not (lambda (arg) (not (= arg 200))) alist) (cadr alist))))
+	(test-t (null (rassoc-if-not (complement consp) '((x . 100) (y . 200) (z . 50)))))
+	(test-t (null (rassoc-if-not (lambda (x) (not (eq x 'key))) ())))
+	(test-t (null (rassoc-if-not identity '(()))))
+	(test-t (null (rassoc-if-not identity '(() ()))))
+	(test-t (let ((alist '(() () () (x . 100) (y . 200) (z . 50))))
+		  (eq (rassoc-if-not (lambda (arg) (not (= arg 200))) alist)
+		      (car (cddddr alist)))))
+	(test-t (let ((set '(a b c))) (eq (adjoin 'a set) set)))
+	(test-t (let* ((set '(a b c)) (new-set (adjoin 'x set))) (and (equal new-set '(x a b c)) (eq set (cdr new-set)))))
+	(test-t (equal (adjoin 1 nil) '(1)))
+	(test-t (let ((set '((test-item 1)))) (equal (adjoin '(test-item 1) set) '((test-item 1) (test-item 1)))))
+	(test-t (let ((set '((test-item 1)))) (equal (adjoin '(test-item 1) set) '((test-item 1) (test-item 1)))))
+	(test-t (let ((set '((test-item 1)))) (eq (adjoin '(test-item 1) set :test equal) set)))
+	(test-t (let ((set '((test-item 1)))) (eq (adjoin '(test-item) set :key car) set)))
+	(test-t (let ((set '((test-item 1)))) (eq (adjoin '(test-item) set :key car :test eq) set)))
+	(test-t (let ((set '(("test-item" 1)))) (eq (adjoin '("test-item") set :key car :test equal) set)))
+	(test-t (let ((place nil)) (and (equal (pushnew 'a place) '(a)) (equal place '(a)))))
+	(test-t (let ((place nil)) (and (equal (pushnew 'a place) '(a)) (equal place '(a)))))
+	(test-t (let ((place '("love" "peace")))
+		  (equal (pushnew "war" place :test equal) '("war" "love" "peace"))))
+	(test-t (let ((place '("love" "peace")))
+		  (and (eq (pushnew "peace" place :test equal) place)
+		       (equal place '("love" "peace")))))
+	(test-t (let ((place '(("love" . l) ("peace" . p))))
+		  (equal (pushnew '("war" . w) place :test equal :key car)
+			 '(("war" . w) ("love" . l) ("peace" . p)))))
+	(test-t (let ((place '(("love" . l) ("peace" . p))))
+		  (and (eq (pushnew '("love" . l) place :test equal :key car) place)
+		       (equal place '(("love" . l) ("peace" . p))))))
+	(test-t (let* ((list '((1) (1 2) (1 2 3)))
+		       (original list))
+		  (and (equal (pushnew '(1) list :test equal) '((1) (1 2) (1 2 3)))
+		       (eq list original))))
+	(test-t (let* ((list '((1) (1 2) (1 2 3)))
+		       (original list))
+		  (and (equal (pushnew '(1) list :test equal :key nil) '((1) (1 2) (1 2 3)))
+		       (eq list original))))
+
+	(test-t (eql (length "abc") 3))
+	(test-t (zerop (length "")))
+	(test-t (zerop (length #())))
+	(test-t (zerop (length ())))
+	(test-t (eql (length '(0)) 1))
+	(test-t (eql (length '(0 1)) 2))
+	(test-t (eql (length '(0 1 2)) 3))
+	(test-t (eql (length '(0 1 2 3)) 4))
+	(test-t (eql (length '(0 1 2 3 4)) 5))
+	(test-t (eql (length '(0 1 2 3 4 5)) 6))
+	(test-t (eql (length '(0 1 2 3 4 5 6)) 7))
+	(test-t (eql (length #(0)) 1))
+	(test-t (eql (length #(0 1)) 2))
+	(test-t (eql (length #(0 1 2)) 3))
+	(test-t (eql (length #(0 1 2 3)) 4))
+	(test-t (eql (length #(0 1 2 3 4)) 5))
+	(test-t (eql (length #(0 1 2 3 4 5)) 6))
+	(test-t (eql (length #(0 1 2 3 4 5 6)) 7))
+	(test-t (eql (length (make-array 100)) 100))
+	(test-t (eql (length (make-sequence 'list 20)) 20))
+	(test-t (eql (length (make-sequence 'string 10)) 10))
+	(test-t (eql (length (make-sequence 'bit-vector 3)) 3))
+	(test-t (eql (length (make-sequence 'bit-vector 64)) 64))
+	(test-t (eql (length (make-sequence 'simple-vector 64)) 64))
+	(test-t (string= (copy "love") "love"))
+	(test-t (equalp (copy #(a b c d)) #(a b c d)))
+	(test-t (equal (copy '(love)) '(love)))
+	(test-t (equal (copy '(love hate war peace)) '(love hate war peace)))
+	(test-t (null (copy nil)))
+	(test-t (string= (copy "") ""))
+	(test-t (let* ((seq0 "love&peace") (seq (copy seq0))) (and (not (eq seq0 seq)) (string= seq0 seq))))
+	(test-t (let* ((seq0 (list 'love 'and 'peace)) (seq (copy seq0))) (and (not (eq seq0 seq)) (equal seq0 seq))))
+	(test-t (let* ((c0 (list 'love))
+		       (c1 (list 'peace))
+		       (seq (copy (list c0 c1))))
+		  (and (equal seq '((love) (peace)))
+		       (eq (car seq) c0)
+		       (eq (cadr seq) c1))))
+	(test-t (let* ((seq0 #(t nil t nil))
+		       (seq (copy seq0)))
+		  (and (not (eq seq0 seq))
+		       (equalp seq seq0))))
+	(test-t (vectorp (copy (vector))))
+	(test-t (simple-vector-p (copy (vector))))
+	(test-t (simple-vector-p (copy (vector 0 1))))
+	(test-t (simple-string-p (copy "xyz")))
+	(test-t (char= (elt "0123456789" 6) #\6))
+	(test-t (eq (elt #(a b c d e f g) 0) 'a))
+	(test-t (eq (elt '(a b c d e f g) 4) 'e))
+	(test-t (let ((str (copy "0123456789"))) (and (char= (elt str 6) #\6) (setf (elt str 0) #\#) (string= str "#123456789"))))
+	(test-t (let ((list (list 0 1 2 3)))
+		  (and (= (elt list 2) 2)
+		       (setf (elt list 1) 9)
+		       (= (elt list 1) 9)
+		       (equal list '(0 9 2 3)))))
+	(test-t (let ((vec (vector 'a 'b 'c)))
+		  (and (eq (elt vec 0) 'a)
+		       (eq (elt vec 1) 'b)
+		       (eq (elt vec 2) 'c))))
+	(test-t (let ((list (list 0 1 2 3))) (and (eq (cl-fill list nil) list) (every null list))))
+	(test-t (let ((v (vector 'x 'y 'z))) (and (eq (cl-fill v 'a) v) (every (lambda (arg) (eq arg 'a)) v))))
+	(test-t (let ((list (list 0 1 2 3))) (and (eq (cl-fill list '9 :start 2) list) (equal list '(0 1 9 9)))))
+	(test-t (let ((list (list 0 1 2 3))) (and (eq (cl-fill list '9 :start 1 :end 3) list) (equal list '(0 9 9 3)))))
+	(test-t (let ((list (list 0 1 2 3))) (and (eq (cl-fill list '9 :start 1 :end nil) list) (equal list '(0 9 9 9)))))
+	(test-t (let ((list (list 0 1 2 3))) (and (eq (cl-fill list '9 :end 1) list) (equal list '(9 1 2 3)))))
+	(test-t (let ((v (vector 0 1 2 3))) (and (eq (cl-fill v 't :start 3) v) (equalp v #(0 1 2 t)))))
+	(test-t (let ((v (vector 0 1 2 3))) (and (eq (cl-fill v 't :start 2 :end 4) v) (equalp v #(0 1 t t)))))
+	(test-t (let ((v (vector 0 1 2 3))) (and (eq (cl-fill v 't :start 2 :end nil) v) (equalp v #(0 1 t t)))))
+	(test-t (let ((v (vector 0 1 2 3))) (and (eq (cl-fill v 't :end 3) v) (equalp v #(t t t 3)))))
+	(test-t (null (make-sequence 'list 0)))
+	(test-t (string= (make-sequence 'string 26 :initial-element #\.) ".........................."))
+	(test-t (equal (make-sequence 'list 3 :initial-element 'a) '(a a a)))
+	(test-t (null (make-sequence 'null 0 :initial-element 'a)))
+	(test-t (equalp (make-sequence 'vector 3 :initial-element 'z) #(z z z)))
+	(test-t (string= (make-sequence 'string 4 :initial-element '#\z) "zzzz"))
+	(test-t (vectorp (make-sequence 'vector 10)))
+	(test-t (string= (subseq "012345" 2) "2345"))
+	(test-t (string= (subseq "012345" 3 5) "34"))
+	(test-t (equal (subseq '(0 1 2 3) 0) '(0 1 2 3)))
+	(test-t (equal (subseq '(0 1 2 3) 1) '(1 2 3)))
+	(test-t (equal (subseq '(0 1 2 3) 2) '(2 3)))
+	(test-t (equal (subseq '(0 1 2 3) 3) '(3)))
+	(test-t (equal (subseq '(0 1 2 3) 4) ()))
+	(test-t (equalp (subseq #(a b c d) 0) #(a b c d)))
+	(test-t (equalp (subseq #(a b c d) 1) #(b c d)))
+	(test-t (equalp (subseq #(a b c d) 2) #(c d)))
+	(test-t (equalp (subseq #(a b c d) 3) #(d)))
+	(test-t (equalp (subseq #(a b c d) 4) #()))
+	(test-t (string= (subseq "0123" 0) "0123"))
+	(test-t (string= (subseq "0123" 1) "123"))
+	(test-t (string= (subseq "0123" 2) "23"))
+	(test-t (string= (subseq "0123" 3) "3"))
+	(test-t (string= (subseq "0123" 4) ""))
+	(test-t (equal (subseq '(0 1 2 3) 0 4) '(0 1 2 3)))
+	(test-t (equal (subseq '(0 1 2 3) 0 nil) '(0 1 2 3)))
+	(test-t (let* ((list0 '(0 1 2 3)) (list (subseq list0 0 4))) (and (not (eq list0 list)) (equal list0 list))))
+	(test-t (let* ((list0 '(0 1 2 3)) (list (subseq list0 0 nil))) (and (not (eq list0 list)) (equal list0 list))))
+	(test-t (equal (subseq '(0 1 2 3) 1 3) '(1 2)))
+	(test-t (equal (subseq '(0 1 2 3) 2 2) ()))
+	(test-t (equal (subseq '(0 1 2 3) 0 0) ()))
+	(test-t (equal (subseq '(0 1 2 3) 1 1) ()))
+	(test-t (equal (subseq '(0 1 2 3) 2 2) ()))
+	(test-t (equal (subseq '(0 1 2 3) 3 3) ()))
+	(test-t (equal (subseq '(0 1 2 3) 4 4) ()))
+	(test-t (equalp (subseq #(0 1 2 3) 0 4) #(0 1 2 3)))
+	(test-t (equalp (subseq #(0 1 2 3) 0 nil) #(0 1 2 3)))
+	(test-t (let* ((vec0 #(0 1 2 3)) (vec (subseq vec0 0 4))) (and (not (eq vec0 vec)) (equalp vec0 vec))))
+	(test-t (let* ((vec0 #(0 1 2 3)) (vec (subseq vec0 0 nil))) (and (not (eq vec0 vec)) (equalp vec0 vec))))
+	(test-t (equalp (subseq #(0 1 2 3) 1 3) #(1 2)))
+	(test-t (equalp (subseq #(0 1 2 3) 2 2) #()))
+	(test-t (equalp (subseq #(0 1 2 3) 0 0) #()))
+	(test-t (equalp (subseq #(0 1 2 3) 1 1) #()))
+	(test-t (equalp (subseq #(0 1 2 3) 2 2) #()))
+	(test-t (equalp (subseq #(0 1 2 3) 3 3) #()))
+	(test-t (equalp (subseq #(0 1 2 3) 4 4) #()))
+	(test-t (string= (cl-map 'string (lambda (x y) (char "01234567890ABCDEF" (mod (+ x y) 16))) '(1 2 3 4) '(10 9 8 7)) "AAAA"))
+	(test-t (equal (cl-map 'list - '(1 2 3 4)) '(-1 -2 -3 -4)))
+	(test-t (string= (cl-map 'string (lambda (x) (if (oddp x) #\1 #\0)) '(1 2 3 4)) "1010"))
+	(test-t (equal (cl-map 'list + '(0 1) '(1 0)) '(1 1)))
+	(test-t (equal (cl-map 'list - '(0 1) '(1 0)) '(-1 1)))
+	(test-t (every null (list (cl-map 'list + ())
+				  (cl-map 'list + () ())
+				  (cl-map 'list + () () ())
+				  (cl-map 'list + () () () ())
+				  (cl-map 'list + () () () () ()))))
+	(test-t (equal (cl-map 'list + '(0 1 2)) '(0 1 2)))
+	(test-t (equal (cl-map 'list + '(0 1 2) '(1 2 3)) '(1 3 5)))
+	(test-t (equal (cl-map 'list + '(0 1 2) '(1 2 3) '(2 3 4)) '(3 6 9)))
+	(test-t (equal (cl-map 'list + '(0 1 2) '(1 2 3) '(2 3 4) '(3 4 5)) '(6 10 14)))
+	(test-t (equal (cl-map 'list + '(1 2) '(1 2 3)) '(2 4)))
+	(test-t (equal (cl-map 'list + '(0 1 2) '(2 3) '(2 3 4)) '(4 7)))
+	(test-t (equal (cl-map 'list + '(0 1 2) '(1 2 3) '(2) '(3 4 5)) '(6)))
+	(test-t (equal (cl-map 'list + '(0 1 2) '(1 2 3) '(2 3 4) '(3 4 5) ()) ()))
+	(test-t (null (cl-map 'null + ())))
+	(test-t (equalp (cl-map 'vector + #()) #()))
+	(test-t (equalp (cl-map 'vector + #() #()) #()))
+	(test-t (equalp (cl-map 'vector + #() #() #()) #()))
+	(test-t (equalp (cl-map 'vector + #() #() #() #()) #()))
+	(test-t (equalp (cl-map 'vector + #() #() #() #() #()) #()))
+	(test-t (equalp (cl-map 'vector + () #()) #()))
+	(test-t (equalp (cl-map 'vector + () #() "") #()))
+	(test-t (equalp (cl-map 'vector + '(0 1 2)) #(0 1 2)))
+	(test-t (equalp (cl-map 'vector + '(0 1 2) #(1 2 3)) #(1 3 5)))
+	(test-t (equalp (cl-map 'vector + #(0 1 2) '(1 2 3) #(2 3 4)) #(3 6 9)))
+	(test-t (equalp (cl-map 'vector + '(0 1 2) #(1 2 3) '(2 3 4) #(3 4 5)) #(6 10 14)))
+	(test-t (equalp (cl-map 'vector + '(1 2) '(1 2 3)) #(2 4)))
+	(test-t (equalp (cl-map 'vector + '(0 1 2) '(2 3) '(2 3 4)) #(4 7)))
+	(test-t (equalp (cl-map 'vector + '(0 1 2) '(1 2 3) '(2) '(3 4 5)) #(6)))
+	(test-t (equalp (cl-map 'vector + '(0 1 2) '(1 2 3) '(2 3 4) '(3 4 5) ()) #()))
+	(test-t (equalp (cl-map 'vector + #(1 2) #(1 2 3)) #(2 4)))
+	(test-t (equalp (cl-map 'vector + #(0 1 2) #(2 3) #(2 3 4)) #(4 7)))
+	(test-t (equalp (cl-map 'vector + #(0 1 2) '(1 2 3) #(2) '(3 4 5)) #(6)))
+	(test-t (equalp (cl-map 'vector + '(0 1 2) #(1 2 3) '(2 3 4) '(3 4 5) ()) #()))
+	(test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "") ""))
+	(test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "" "") ""))
+	(test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "" "" "") ""))
+	(test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "" "" "" "") ""))
+	(test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "" "" "" "" "") ""))
+	(test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "") ""))
+	(test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "" ()) ""))
+	(test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "" #() ()) ""))
+	(test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) () () "" "") ""))
+	(test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) #() #() #() #() #()) ""))
+	(test-t (string= (cl-map 'string (lambda (a b) (if (char< a b) b a)) "axbycz" "xaybzc") "xxyyzz"))
+	(test-t (string= (cl-map 'string (lambda (a b) (if (char< a b) b a)) "axbycz" "xayb") "xxyy"))
+	(test-t (let ((list ()))
+		  (and (null (cl-map nil
+				     (lambda rest
+				       (setq list (cons (apply + rest) list)))
+				     '(0 1 2 3)
+				     '(1 2 3 4)))
+		       (equal list '(7 5 3 1)))))
+	(test-t (let ((list ()))
+		  (and (null (cl-map nil
+				     (lambda rest
+				       (setq list (cons (apply + rest) list)))
+				     '(0 1 2 3)
+				     '(1 2 3 4)
+				     '(2 3 4 5)))
+		       (equal list (cl-reverse '(3 6 9 12))))))
+	(test-t (let ((list ()))
+		  (and (null (cl-map nil
+				     (lambda rest
+				       (setq list (cons (apply + rest) list)))
+				     '(0 1 2 3)
+				     '(1)
+				     '(2 3 4 5)))
+		       (equal list '(3)))))
+	(test-t (string= (cl-map 'string char-upcase "abc") "ABC"))
+	(test-t (let ((a (list 1 2 3 4))
+		      (b (list 10 10 10 10)))
+		  (and (equal (map-into a + a b) '(11 12 13 14))
+		       (equal a '(11 12 13 14))
+		       (equal b '(10 10 10 10)))))
+	(test-t (let ((a '(11 12 13 14)) (k '(one two three))) (equal (map-into a cons k a) '((one . 11) (two . 12) (three . 13) 14))))
+	(test-t (null (map-into nil identity)))
+	(test-t (null (map-into nil identity)))
+	(test-t (null (map-into nil identity ())))
+	(test-t (null (map-into nil identity '(0 1 2) '(9 8 7))))
+	(test-t (let ((list (list 0 1 2))) (and (eq (map-into list identity) list) (equal list '(0 1 2)))))
+	(test-t (let ((list (list 0 1 2))) (and (eq (map-into list identity ()) list) (equal list '(0 1 2)))))
+	(test-t (let ((vec (vector 0 1 2))) (and (eq (map-into vec identity) vec) (equalp vec #(0 1 2)))))
+	(test-t (let ((vec (vector 0 1 2))) (and (eq (map-into vec identity #()) vec) (equalp vec #(0 1 2)))))
+	(test-t (let ((vec (vector 0 1 2))) (and (eq (map-into vec + #() () #()) vec) (equalp vec #(0 1 2)))))
+	(test-t (equal (map-into (list nil nil) + '(0 1) '(1 0)) '(1 1)))
+	(test-t (equal (map-into (list nil nil) - '(0 1) '(1 0)) '(-1 1)))
+	(test-t (let ((list (cl-make-list 3 :initial-element nil))) (and (eq (map-into list + '(0 1 2)) list) (equal list '(0 1 2)))))
+	(test-t (let ((list (cl-make-list 3 :initial-element nil))) (and (eq (map-into list + '(0 1 2) '(1 2 3)) list) (equal list '(1 3 5)))))
+	(test-t (let ((list (cl-make-list 3 :initial-element nil))) (and (eq (map-into list + '(0 1 2) '(1 2 3) '(2 3 4)) list) (equal list '(3 6 9)))))
+	(test-t (let ((list (cl-make-list 3 :initial-element nil))) (and (eq (map-into list + '(1 2) '(1 2 3)) list) (equal list '(2 4 ())))))
+	(test-t (let ((list (cl-make-list 1 :initial-element nil))) (and (eq (map-into list + '(1 2 3) '(1 2 3)) list) (equal list '(2)))))
+	(test-t (let ((list (cl-make-list 3 :initial-element nil))) (and (eq (map-into list + '(1 2 3 4) '(1 2 3) '(0)) list) (equal list '(2 () ())))))
+	(test-t (let ((vec (make-sequence 'vector 3 :initial-element nil))) (and (eq (map-into vec + '(0 1 2)) vec) (equalp vec #(0 1 2)))))
+	(test-t (let ((vec (make-sequence 'vector 3 :initial-element nil))) (and (eq (map-into vec + '(0 1 2) #(1 2 3)) vec) (equalp vec #(1 3 5)))))
+	(test-t (let ((vec (make-sequence 'vector 3 :initial-element nil))) (and (eq (map-into vec + '(0 1 2) '(1 2 3) #(2 3 4)) vec) (equalp vec #(3 6 9)))))
+	(test-t (let ((vec (make-sequence 'vector 3 :initial-element nil))) (and (eq (map-into vec + '(1 2) #(1 2 3)) vec) (equalp vec #(2 4 ())))))
+	(test-t (let ((vec (make-sequence 'vector 1 :initial-element nil))) (and (eq (map-into vec + '(1 2) #(1 2 3)) vec) (equalp vec #(2)))))
+	(test-t (let ((vec (make-sequence 'vector 3 :initial-element nil))) (and (eq (map-into vec + '(1 2 3 4) #(1 2 3) '(0)) vec) (equalp vec #(2 () ())))))
+	(test-t (null (cl-reverse nil)))
+	(test-t (string= (cl-reverse "") ""))
+	(test-t (equalp (cl-reverse #()) #()))
+	(test-t (equal (cl-reverse '(0 1 2 3)) '(3 2 1 0)))
+	(test-t (string= (cl-reverse "0123") "3210"))
+	(test-t (equalp (cl-reverse #(a b c d)) #(d c b a)))
+	(test-t (null (nreverse nil)))
+	(test-t (string= (nreverse (copy "")) ""))
+	(test-t (equalp (nreverse (copy #())) #()))
+	(test-t (equal (nreverse (list 0 1 2 3)) '(3 2 1 0)))
+	(test-t (string= (nreverse (copy "0123")) "3210"))
+	(test-t (equalp (cl-reverse (copy #(a b c d))) #(d c b a)))
+	(test-t (char= (find #\d "edcba" :test char>) #\c))
+	(test-t (eql (find-if oddp '(1 2 3 4 5) :end 3 :from-end t) 3))
+	(test-t (eq (find 'a '(a b c)) 'a))
+	(test-t (eq (find 'b '(a b c)) 'b))
+	(test-t (eq (find 'c '(a b c)) 'c))
+	(test-t (null (find 'x '(a b c))))
+	(test-t (null (find 'a '(a b c) :start 1)))
+	(test-t (null (find 'b '(a b c) :start 2)))
+	(test-t (null (find 'c '(a b c) :start 3)))
+	(test-t (null (find 'a '(a b c) :start 0 :end 0)))
+	(test-t (null (find 'a '(a b c) :start 0 :end 0 :from-end t)))
+	(test-t (null (find 'a '(a b c) :start 1 :end 1)))
+	(test-t (null (find 'a '(a b c) :start 1 :end 1 :from-end t)))
+	(test-t (null (find 'a '(a b c) :start 2 :end 2)))
+	(test-t (null (find 'a '(a b c) :start 2 :end 2 :from-end t)))
+	(test-t (null (find 'a '(a b c) :start 3 :end 3)))
+	(test-t (null (find 'a '(a b c) :start 3 :end 3 :from-end t)))
+	(test-t (eq (find 'a '(a b c) :end nil) 'a))
+	(test-t (eq (find 'b '(a b c) :end nil) 'b))
+	(test-t (eq (find 'c '(a b c) :end nil) 'c))
+	(test-t (eq (find 'a '(a b c) :end 1) 'a))
+	(test-t (eq (find 'b '(a b c) :end 2) 'b))
+	(test-t (eq (find 'c '(a b c) :end 3) 'c))
+	(test-t (null (find 'a '(a b c) :end 0)))
+	(test-t (null (find 'b '(a b c) :end 1)))
+	(test-t (null (find 'c '(a b c) :end 2)))
+	(test-t (null (find 'a '((a) (b) (c)))))
+	(test-t (equal (find 'a '((a) (b) (c)) :key car) '(a)))
+	(test-t (equal (find 'b '((a) (b) (c)) :key car) '(b)))
+	(test-t (equal (find 'c '((a) (b) (c)) :key car) '(c)))
+	(test-t (null (find 'z '((a) (b) (c)) :key car)))
+	(test-t (let ((list '((a) (b) (c))))
+		  (and (eq (find 'a list :key car) (car list))
+		       (eq (find 'b list :key car) (cadr list))
+		       (eq (find 'c list :key car) (caddr list))
+		       (null (find 'z list :key car)))))
+	(test-t (null (find '(a) '((a) (b) (c)))))
+	(test-t (equal (find '(a) '((a) (b) (c)) :test equal) '(a)))
+	(test-t (null (find '("a") '(("a") ("b") ("c")))))
+	(test-t (null (find '("a") '(("A") ("B") ("c")) :test equal)))
+	(test-t (eql (find 3 '(0 1 2 3 4 5)) 3))
+	(test-t (eql (find 3 '(0 1 2 3 4 5) :test <) 4))
+	(test-t (eql (find 3 '(0 1 2 3 4 5) :test >) 0))
+	(test-t (equal (find 'a '((a) (b) (c) (a a) (b b) (c c)) :key car) '(a)))
+	(test-t (equal (find 'a '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(a a)))
+	(test-t (equal (find 'b '((a) (b) (c) (a a) (b b) (c c)) :key car) '(b)))
+	(test-t (equal (find 'b '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(b b)))
+	(test-t (equal (find 'c '((a) (b) (c) (a a) (b b) (c c)) :key car) '(c)))
+	(test-t (equal (find 'c '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(c c)))
+	(test-t (null (find 'z '((a) (b) (c) (a a) (b b) (c c)) :key car)))
+	(test-t (null (find 'z '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
+	(test-t (equal (find 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) '(a a a)))
+	(test-t (equal (find 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) '(a a a)))
+	(test-t (equal (find 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) '(a a)))
+	(test-t (null (find 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
+	(test-t (null (find #\c '("abc" "bcd" "cde"))))
+	(test-t (string= (find #\c '("abc" "bcd" "cde") :key (lambda (arg) (char arg 0)) :test char=) "cde"))
+	(test-t (eq (find 'a #(a b c)) 'a))
+	(test-t (eq (find 'b #(a b c)) 'b))
+	(test-t (eq (find 'c #(a b c)) 'c))
+	(test-t (null (find 'x #(a b c))))
+	(test-t (null (find 'a #(a b c) :start 1)))
+	(test-t (null (find 'b #(a b c) :start 2)))
+	(test-t (null (find 'c #(a b c) :start 3)))
+	(test-t (null (find 'a #(a b c) :start 0 :end 0)))
+	(test-t (null (find 'a #(a b c) :start 0 :end 0 :from-end t)))
+	(test-t (null (find 'a #(a b c) :start 1 :end 1)))
+	(test-t (null (find 'a #(a b c) :start 1 :end 1 :from-end t)))
+	(test-t (null (find 'a #(a b c) :start 2 :end 2)))
+	(test-t (null (find 'a #(a b c) :start 2 :end 2 :from-end t)))
+	(test-t (null (find 'a #(a b c) :start 3 :end 3)))
+	(test-t (null (find 'a #(a b c) :start 3 :end 3 :from-end t)))
+	(test-t (eq (find 'a #(a b c) :end nil) 'a))
+	(test-t (eq (find 'b #(a b c) :end nil) 'b))
+	(test-t (eq (find 'c #(a b c) :end nil) 'c))
+	(test-t (eq (find 'a #(a b c) :end 1) 'a))
+	(test-t (eq (find 'b #(a b c) :end 2) 'b))
+	(test-t (eq (find 'c #(a b c) :end 3) 'c))
+	(test-t (null (find 'a #(a b c) :end 0)))
+	(test-t (null (find 'b #(a b c) :end 1)))
+	(test-t (null (find 'c #(a b c) :end 2)))
+	(test-t (null (find 'a #((a) (b) (c)))))
+	(test-t (equal (find 'a #((a) (b) (c)) :key car) '(a)))
+	(test-t (equal (find 'b #((a) (b) (c)) :key car) '(b)))
+	(test-t (equal (find 'c #((a) (b) (c)) :key car) '(c)))
+	(test-t (null (find 'z #((a) (b) (c)) :key car)))
+	(test-t (let ((vector #((a) (b) (c))))
+		  (and (eq (find 'a vector :key car) (aref vector 0))
+		       (eq (find 'b vector :key car) (aref vector 1))
+		       (eq (find 'c vector :key car) (aref vector 2))
+		       (null (find 'z vector :key car)))))
+	(test-t (null (find '(a) #((a) (b) (c)))))
+	(test-t (equal (find '(a) #((a) (b) (c)) :test equal) '(a)))
+	(test-t (null (find '("a") #(("a") ("b") ("c")))))
+	(test-t (null (find '("a") #(("A") ("B") ("c")) :test equal)))
+	(test-t (eql (find 3 #(0 1 2 3 4 5)) 3))
+	(test-t (eql (find 3 #(0 1 2 3 4 5) :test <) 4))
+	(test-t (eql (find 3 #(0 1 2 3 4 5) :test >) 0))
+	(test-t (equal (find 'a #((a) (b) (c) (a a) (b b) (c c)) :key car) '(a)))
+	(test-t (equal (find 'a #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(a a)))
+	(test-t (equal (find 'b #((a) (b) (c) (a a) (b b) (c c)) :key car) '(b)))
+	(test-t (equal (find 'b #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(b b)))
+	(test-t (equal (find 'c #((a) (b) (c) (a a) (b b) (c c)) :key car) '(c)))
+	(test-t (equal (find 'c #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(c c)))
+	(test-t (null (find 'z #((a) (b) (c) (a a) (b b) (c c)) :key car)))
+	(test-t (null (find 'z #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
+	(test-t (equal (find 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) '(a a a)))
+	(test-t (equal (find 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) '(a a a)))
+	(test-t (equal (find 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) '(a a)))
+	(test-t (null (find 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
+	(test-t (null (find #\c #("abc" "bcd" "cde"))))
+	(test-t (null (find #\z "abcABC")))
+	(test-t (eql (find #\a "abcABC") #\a))
+	(test-t (eql (find #\A "abcABC") #\A))
+	(test-t (eql (find #\A "abcABC" :test char-equal) #\a))
+	(test-t (eql (find #\A "abcABC" :test char-equal :from-end t) #\A))
+	(test-t (eql (find #\a "abcABC" :test char-equal :from-end t) #\A))
+	(test-t (eql (find #\a "abcABC" :test char-equal :from-end t :end 4) #\A))
+	(test-t (eql (find #\a "abcABC" :test char-equal :from-end t :end 3) #\a))
+	(test-t (eq (find-if (lambda (x) (eq x 'a)) '(a b c)) 'a))
+	(test-t (eq (find-if (lambda (x) (eq x 'b)) '(a b c)) 'b))
+	(test-t (eq (find-if (lambda (x) (eq x 'c)) '(a b c)) 'c))
+	(test-t (null (find-if (lambda (arg) (eq arg 'x)) '(a b c))))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) '(a b c) :start 1)))
+	(test-t (null (find-if (lambda (x) (eq x 'b)) '(a b c) :start 2)))
+	(test-t (null (find-if (lambda (x) (eq x 'c)) '(a b c) :start 3)))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) '(a b c) :start 0 :end 0)))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) '(a b c) :start 0 :end 0 :from-end t)))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) '(a b c) :start 1 :end 1)))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) '(a b c) :start 1 :end 1 :from-end t)))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) '(a b c) :start 2 :end 2)))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) '(a b c) :start 2 :end 2 :from-end t)))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) '(a b c) :start 3 :end 3)))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) '(a b c) :start 3 :end 3 :from-end t)))
+	(test-t (eq (find-if (lambda (x) (eq x 'a)) '(a b c) :end nil) 'a))
+	(test-t (eq (find-if (lambda (x) (eq x 'b)) '(a b c) :end nil) 'b))
+	(test-t (eq (find-if (lambda (x) (eq x 'c)) '(a b c) :end nil) 'c))
+	(test-t (eq (find-if (lambda (x) (eq x 'a)) '(a b c) :end 1) 'a))
+	(test-t (eq (find-if (lambda (x) (eq x 'b)) '(a b c) :end 2) 'b))
+	(test-t (eq (find-if (lambda (x) (eq x 'c)) '(a b c) :end 3) 'c))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) '(a b c) :end 0)))
+	(test-t (null (find-if (lambda (x) (eq x 'b)) '(a b c) :end 1)))
+	(test-t (null (find-if (lambda (x) (eq x 'c)) '(a b c) :end 2)))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) '((a) (b) (c)))))
+	(test-t (equal (find-if (lambda (x) (eq x 'a)) '((a) (b) (c)) :key car) '(a)))
+	(test-t (equal (find-if (lambda (x) (eq x 'b)) '((a) (b) (c)) :key car) '(b)))
+	(test-t (equal (find-if (lambda (x) (eq x 'c)) '((a) (b) (c)) :key car) '(c)))
+	(test-t (null (find-if (lambda (x) (eq x 'z)) '((a) (b) (c)) :key car)))
+	(test-t (let ((list '((a) (b) (c))))
+		  (and (eq (find-if (lambda (x) (eq x 'a)) list :key car) (car list))
+		       (eq (find-if (lambda (x) (eq x 'b)) list :key car) (cadr list))
+		       (eq (find-if (lambda (x) (eq x 'c)) list :key car) (caddr list))
+		       (null (find-if (lambda (x) (eq x 'z)) list :key car)))))
+	(test-t (equal (find-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c)) :key car) '(a)))
+	(test-t (equal (find-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(a a)))
+	(test-t (equal (find-if (lambda (x) (eq x 'b)) '((a) (b) (c) (a a) (b b) (c c)) :key car) '(b)))
+	(test-t (equal (find-if (lambda (x) (eq x 'b)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(b b)))
+	(test-t (equal (find-if (lambda (x) (eq x 'c)) '((a) (b) (c) (a a) (b b) (c c)) :key car) '(c)))
+	(test-t (equal (find-if (lambda (x) (eq x 'c)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(c c)))
+	(test-t (null (find-if (lambda (x) (eq x 'z)) '((a) (b) (c) (a a) (b b) (c c)) :key car)))
+	(test-t (null (find-if (lambda (x) (eq x 'z)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
+	(test-t (equal (find-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) '(a a a)))
+	(test-t (equal (find-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) '(a a a)))
+	(test-t (equal (find-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) '(a a)))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
+	(test-t (eq (find-if (lambda (x) (eq x 'a)) #(a b c)) 'a))
+	(test-t (eq (find-if (lambda (x) (eq x 'b)) #(a b c)) 'b))
+	(test-t (eq (find-if (lambda (x) (eq x 'c)) #(a b c)) 'c))
+	(test-t (null (find-if (lambda (arg) (eq arg 'x)) #(a b c))))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) #(a b c) :start 1)))
+	(test-t (null (find-if (lambda (x) (eq x 'b)) #(a b c) :start 2)))
+	(test-t (null (find-if (lambda (x) (eq x 'c)) #(a b c) :start 3)))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) #(a b c) :start 0 :end 0)))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) #(a b c) :start 0 :end 0 :from-end t)))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) #(a b c) :start 1 :end 1)))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) #(a b c) :start 1 :end 1 :from-end t)))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) #(a b c) :start 2 :end 2)))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) #(a b c) :start 2 :end 2 :from-end t)))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) #(a b c) :start 3 :end 3)))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) #(a b c) :start 3 :end 3 :from-end t)))
+	(test-t (eq (find-if (lambda (x) (eq x 'a)) #(a b c) :end nil) 'a))
+	(test-t (eq (find-if (lambda (x) (eq x 'b)) #(a b c) :end nil) 'b))
+	(test-t (eq (find-if (lambda (x) (eq x 'c)) #(a b c) :end nil) 'c))
+	(test-t (eq (find-if (lambda (x) (eq x 'a)) #(a b c) :end 1) 'a))
+	(test-t (eq (find-if (lambda (x) (eq x 'b)) #(a b c) :end 2) 'b))
+	(test-t (eq (find-if (lambda (x) (eq x 'c)) #(a b c) :end 3) 'c))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) #(a b c) :end 0)))
+	(test-t (null (find-if (lambda (x) (eq x 'b)) #(a b c) :end 1)))
+	(test-t (null (find-if (lambda (x) (eq x 'c)) #(a b c) :end 2)))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) #((a) (b) (c)))))
+	(test-t (equal (find-if (lambda (x) (eq x 'a)) #((a) (b) (c)) :key car) '(a)))
+	(test-t (equal (find-if (lambda (x) (eq x 'b)) #((a) (b) (c)) :key car) '(b)))
+	(test-t (equal (find-if (lambda (x) (eq x 'c)) #((a) (b) (c)) :key car) '(c)))
+	(test-t (null (find-if (lambda (x) (eq x 'z)) #((a) (b) (c)) :key car)))
+	(test-t (let ((vector #((a) (b) (c))))
+		  (and (eq (find-if (lambda (x) (eq x 'a)) vector :key car) (aref vector 0))
+		       (eq (find-if (lambda (x) (eq x 'b)) vector :key car) (aref vector 1))
+		       (eq (find-if (lambda (x) (eq x 'c)) vector :key car) (aref vector 2))
+		       (null (find-if (lambda (x) (eq x 'z)) vector :key car)))))
+	(test-t (equal (find-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c)) :key car) '(a)))
+	(test-t (equal (find-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(a a)))
+	(test-t (equal (find-if (lambda (x) (eq x 'b)) #((a) (b) (c) (a a) (b b) (c c)) :key car) '(b)))
+	(test-t (equal (find-if (lambda (x) (eq x 'b)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(b b)))
+	(test-t (equal (find-if (lambda (x) (eq x 'c)) #((a) (b) (c) (a a) (b b) (c c)) :key car) '(c)))
+	(test-t (equal (find-if (lambda (x) (eq x 'c)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(c c)))
+	(test-t (null (find-if (lambda (x) (eq x 'z)) #((a) (b) (c) (a a) (b b) (c c)) :key car)))
+	(test-t (null (find-if (lambda (x) (eq x 'z)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
+	(test-t (equal (find-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) '(a a a)))
+	(test-t (equal (find-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) '(a a a)))
+	(test-t (equal (find-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) '(a a)))
+	(test-t (null (find-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
+
+	(test-t (let ((lst (copy "012345678"))) (and (equal (replace lst lst :start1 2 :start2 0) "010123456") (equal lst "010123456"))))
+	(test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z)))) (and (eq list0 list) (equal list0 '(x y z d e)))))
+	(test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z) :start1 1))) (and (eq list0 list) (equal list0 '(a x y z e)))))
+	(test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z) :start1 1 :end1 nil))) (and (eq list0 list) (equal list0 '(a x y z e)))))
+	(test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z) :start1 1 :start2 1))) (and (eq list0 list) (equal list0 '(a y z d e)))))
+	(test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z) :start1 1 :start2 1 :end2 nil))) (and (eq list0 list) (equal list0 '(a y z d e)))))
+	(test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z) :start1 1 :end1 nil :start2 1 :end2 nil))) (and (eq list0 list) (equal list0 '(a y z d e)))))
+	(test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z) :start1 1 :end1 2 :start2 1))) (and (eq list0 list) (equal list0 '(a y c d e)))))
+	(test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z) :start1 1 :end1 1))) (and (eq list0 list) (equal list0 '(a b c d e)))))
+	(test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z) :start1 2 :end1 2))) (and (eq list0 list) (equal list0 '(a b c d e)))))
+	(test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z) :start1 3 :end1 3))) (and (eq list0 list) (equal list0 '(a b c d e)))))
+	(test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z) :start1 4 :end1 4))) (and (eq list0 list) (equal list0 '(a b c d e)))))
+	(test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z) :start1 5 :end1 5))) (and (eq list0 list) (equal list0 '(a b c d e)))))
+	(test-t (null (replace nil nil)))
+	(test-t (null (replace nil '(a b c))))
+	(test-t (let* ((list0 (list 'a 'b 'c)) (list (replace list0 ()))) (and (eq list0 list) (equal list0 '(a b c)))))
+	(test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 list0))) (and (eq list0 list) (equal list0 '(a b c d e)))))
+	(test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 list0 :start1 3))) (and (eq list0 list) (equal list0 '(a b c a b)))))
+	(test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 list0 :start1 1))) (and (eq list0 list) (equal list0 '(a a b c d)))))
+	(test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 list0 :start1 1 :end1 3))) (and (eq list0 list) (equal list0 '(a a b d e)))))
+	(test-t (let* ((list0 (list 'a 'b 'c)) (list (replace list0 '(x y z)))) (and (eq list0 list) (equal list0 '(x y z)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z)))) (and (eq vector0 vector) (equalp vector0 #(x y z d e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z) :start1 1))) (and (eq vector0 vector) (equalp vector0 #(a x y z e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z) :start1 1 :end1 nil))) (and (eq vector0 vector) (equalp vector0 #(a x y z e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z) :start1 1 :start2 1))) (and (eq vector0 vector) (equalp vector0 #(a y z d e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z) :start1 1 :start2 1 :end2 nil))) (and (eq vector0 vector) (equalp vector0 #(a y z d e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z) :start1 1 :end1 nil :start2 1 :end2 nil))) (and (eq vector0 vector) (equalp vector0 #(a y z d e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z) :start1 1 :end1 2 :start2 1))) (and (eq vector0 vector) (equalp vector0 #(a y c d e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z) :start1 1 :end1 1))) (and (eq vector0 vector) (equalp vector0 #(a b c d e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z) :start1 2 :end1 2))) (and (eq vector0 vector) (equalp vector0 #(a b c d e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z) :start1 3 :end1 3))) (and (eq vector0 vector) (equalp vector0 #(a b c d e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z) :start1 4 :end1 4))) (and (eq vector0 vector) (equalp vector0 #(a b c d e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z) :start1 5 :end1 5))) (and (eq vector0 vector) (equalp vector0 #(a b c d e)))))
+	(test-t (null (replace nil #())))
+	(test-t (null (replace nil #(a b c))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c)) (vector (replace vector0 ()))) (and (eq vector0 vector) (equalp vector0 #(a b c)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 vector0))) (and (eq vector0 vector) (equalp vector0 #(a b c d e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 vector0 :start1 3))) (and (eq vector0 vector) (equalp vector0 #(a b c a b)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 vector0 :start1 1))) (and (eq vector0 vector) (equalp vector0 #(a a b c d)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 vector0 :start1 1 :end1 3))) (and (eq vector0 vector) (equalp vector0 #(a a b d e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c)) (vector (replace vector0 '(x y z)))) (and (eq vector0 vector) (equalp vector0 #(x y z)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z)))) (and (eq vector0 vector) (equalp vector0 #(x y z d e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z) :start1 1))) (and (eq vector0 vector) (equalp vector0 #(a x y z e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z) :start1 1 :end1 nil))) (and (eq vector0 vector) (equalp vector0 #(a x y z e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z) :start1 1 :start2 1))) (and (eq vector0 vector) (equalp vector0 #(a y z d e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z) :start1 1 :start2 1 :end2 nil))) (and (eq vector0 vector) (equalp vector0 #(a y z d e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z) :start1 1 :end1 nil :start2 1 :end2 nil))) (and (eq vector0 vector) (equalp vector0 #(a y z d e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z) :start1 1 :end1 2 :start2 1))) (and (eq vector0 vector) (equalp vector0 #(a y c d e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z) :start1 1 :end1 1))) (and (eq vector0 vector) (equalp vector0 #(a b c d e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z) :start1 2 :end1 2))) (and (eq vector0 vector) (equalp vector0 #(a b c d e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z) :start1 3 :end1 3))) (and (eq vector0 vector) (equalp vector0 #(a b c d e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z) :start1 4 :end1 4))) (and (eq vector0 vector) (equalp vector0 #(a b c d e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z) :start1 5 :end1 5))) (and (eq vector0 vector) (equalp vector0 #(a b c d e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c)) (vector (replace vector0 #()))) (and (eq vector0 vector) (equalp vector0 #(a b c)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 vector0))) (and (eq vector0 vector) (equalp vector0 #(a b c d e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 vector0 :start1 3))) (and (eq vector0 vector) (equalp vector0 #(a b c a b)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 vector0 :start1 1))) (and (eq vector0 vector) (equalp vector0 #(a a b c d)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 vector0 :start1 1 :end1 3))) (and (eq vector0 vector) (equalp vector0 #(a a b d e)))))
+	(test-t (let* ((vector0 (vector 'a 'b 'c)) (vector (replace vector0 #(x y z)))) (and (eq vector0 vector) (equalp vector0 #(x y z)))))
+	(test-t (let* ((str0 (copy "abc")) (str (replace str0 "xyz"))) (and (eq str0 str) (equalp str0 "xyz"))))
+	(test-t (let* ((str0 (copy "")) (str (replace str0 ""))) (and (eq str0 str) (equalp str0 ""))))
+	(test-t (let* ((str0 (copy "")) (str (replace str0 "xyz"))) (and (eq str0 str) (equalp str0 ""))))
+	(test-t (let* ((str0 (copy "abc")) (str (replace str0 ""))) (and (eq str0 str) (equalp str0 "abc"))))
+	(test-t (let* ((str0 (copy "abcdef")) (str (replace str0 "xyz" :start1 3))) (and (eq str0 str) (equalp str0 "abcxyz"))))
+	(test-t (let* ((str0 (copy "abcdef")) (str (replace str0 "xyz" :start1 4 :start2 1))) (and (eq str0 str) (equalp str0 "abcdyz"))))
+	(test-t (let* ((str0 (copy "abcdef")) (str (replace str0 "xyz" :start1 1 :end1 2 :start2 1))) (and (eq str0 str) (equalp str0 "aycdef"))))
+	(test-t (let* ((str0 (copy "abcdef")) (str (replace str0 "xyz" :start1 1 :start2 1 :end2 2))) (and (eq str0 str) (equalp str0 "aycdef"))))
+	(test-t (let* ((str0 (copy "abcdef")) (str (replace str0 str0 :start1 1))) (and (eq str0 str) (equalp str0 "aabcde"))))
+
+	(test-t (string= (concatenate 'string "all" " " "together" " " "now") "all together now"))
+	(test-t (equal (concatenate 'list () '(a b c) '(x y z)) '(a b c x y z)))
+	(test-t (equal (concatenate 'list '(a) #(b) '(c) #(x y) '(z)) '(a b c x y z)))
+	(test-t (null (concatenate 'list)))
+	(test-t (let* ((list0 '(a b c)) (list (concatenate 'list list0))) (and (not (eq list0 list)) (equal list list0) (equal list '(a b c)))))
+	(test-t (equalp (concatenate 'vector () '(a b c) '(x y z)) #(a b c x y z)))
+	(test-t (equalp (concatenate 'vector '(a) #(b) '(c) #(x y) '(z)) #(a b c x y z)))
+	(test-t (equalp (concatenate 'vector) #()))
+	(test-t (let* ((vector0 #(a b c)) (vector (concatenate 'vector vector0))) (and (not (eq vector0 vector)) (equalp vector vector0) (equalp vector #(a b c)))))
+	(test-t (string= (concatenate 'string "abc" "def" "ghi" "jkl" "mno" "pqr") "abcdefghijklmnopqr"))
+	(test-t (string= (concatenate 'string "" "abc" "" "def" "" "ghi" "" "" "jkl" "" "mno" "" "pqr" "" "") "abcdefghijklmnopqr"))
+	(test-t (string= (concatenate 'string) ""))
+	(test-t (string= (concatenate 'string "abc" '(#\d #\e #\f #\g) #(#\h #\i #\j #\k #\l)) "abcdefghijkl"))
+	;;
+	;; ----------------------------------- end sacla ---------------------------------------------
+	;;
+
+	(let ((boole-n-vector
+	       (vector boole-clr   boole-and  boole-andc1 boole-2
+		       boole-andc2 boole-1    boole-xor   boole-ior
+		       boole-nor   boole-eqv  boole-c1    boole-orc1
+		       boole-c2    boole-orc2 boole-nand  boole-set)))
+	  (do ((n 0 (+ n 1)))
+	      ((= n 16))
+	    (if (not (= n (logand (boole (boole-n-vector n) #b0101 #b0011) #b1111)))
+		(format #t "~A: ~A ~A~%" n (boole-n-vector n) (logand (boole (boole-n-vector n) #b0101 #b0011) #b1111))))
+	  (let ((lst ()))
+	    (do ((n #b0000 (+ n 1)))
+		((> n #b1111))
+	      (set! lst (cons (boole (boole-n-vector n) 5 3) lst)))
+	    (if (not (equal? (reverse lst)
+			     (list 0 1 2 3 4 5 6 7 -8 -7 -6 -5 -4 -3 -2 -1)))
+		(format #t ";boole: ~A~%" (reverse lst)))))
+
+	(test (digit-char-p #\a) #f)
+	(test (digit-char-p #\a 16) 10)
+	(test (let ((v (vector 1 2 3 4 5))) (cl-fill v 32 :start 2 :end 3)) #(1 2 32 4 5))
+	(test (let ((v (vector 1 2 3 4 5))) (cl-fill v 32 :start 2)) #(1 2 32 32 32))
+	(test (let ((v (vector 1 2 3))) (cl-fill v 32)) #(32 32 32))
+	(test (let ((lst (list 1 2 3))) (cl-fill lst "hi")) '("hi" "hi" "hi"))
+	(test (some zero? '(1 2 3)) #f)
+	(test (some zero? '(1 0 3)) #t)
+	(test (some (lambda args (apply > args)) #(1 2 3) #(2 3 4)) #f)
+	(test (some (lambda args (apply > args)) #(1 2 3) #(2 3 1)) #t)
+	(test (some (lambda (a) (and (positive? a) a)) '(0 -3 1 2)) 1)
+	(test (notany zero? '(1 2 3)) #t)
+	(test (notany zero? '(1 0 3)) #f)
+	(test (notany (lambda args (apply > args)) #(1 2 3) #(2 3 4)) #t)
+	(test (notany (lambda args (apply > args)) #(1 2 3) #(2 3 1)) #f)
+	(test (notany (lambda (a) (and (positive? a) a)) '(0 -3 1 2)) #f)
+	(test (every zero? '(1 2 3)) #f)
+	(test (every zero? '(0 0)) #t)
+	(test (every (lambda args (apply < args)) #(1 2 3) #(2 3 4)) #t)
+	(test (every (lambda args (apply < args)) #(1 2 3) #(2 3 1)) #f)
+	(test (notevery zero? '(1 2 3)) #t)
+	(test (notevery zero? '(0 0)) #f)
+	(test (notevery (lambda args (apply < args)) #(1 2 3) #(2 3 4)) #f)
+	(test (notevery (lambda args (apply < args)) #(1 2 3) #(2 3 1)) #t)
+	(test ((complement >) 1 2 3) #t)
+	(test (cl-abs -1) 1)
+	(test (cl-abs 1.0) 1.0)
+	(test (cl-abs 1+i) (magnitude 1+i))
+	(test (signum 3) 1)
+	(test (signum 0) 0)
+	(test (signum -3) -1)
+	(test (signum 3.0) 1.0)
+	(test (isqrt 12) 3)
+	(test (1+ 1) 2)
+	(test (1- 1) 0)
+	(test (/= 0 0) #f)
+	(test (/= 1 2 3) #t)
+	(test (/= 3 45 3) #f)
+	(test (zerop 0) #t)
+	(test (zerop 1) #f)
+	(test (minusp -1) #t)
+	(test (minusp 1) #f)
+	(test (plusp 1) #t)
+	(test (plusp -1) #f)
+	(test (oddp 3) #t)
+	(test (oddp 4) #f)
+	(test (evenp 3) #f)
+	(test (evenp 4) #t)
+	(test (conjugate 1+i) 1-i)
+	(test (conjugate 3.7) 3.7)
+	(test (ldb (byte 8 8) #x123) 1)
+	(test (ldb (byte 8 0) #x123) #x23)
+	(test (ldb (byte 4 4) #x123) 2)
+	(test (ldb (byte 1 4) #x123) 0)
+	(test (ldb (byte 1 5) #x123) 1)
+	(test (ldb (byte 16 16) -1) 65535)
+	(test (ldb (byte 12 18) #x12345678) 1165)
+	(test (dpb 1 (byte 8 0) #x100) #x101)
+	(test (dpb #x22 (byte 8 1) #x100) #x44) ;!
+	(test (dpb #x22 (byte 8 8) #x100) #x2200) ; not #x2300
+	(test (dpb #x1001 (byte 16 0) -1) -61439)
+	(test (dpb #x1 (byte 8 8) #xffffff) #xff01ff)
+	(test (dpb #x1 (byte 8 16) #xffffff) #x1ffff)
+	(test (dpb #x1 (byte 8 16) #xffffffff) #xff01ffff)
+	(test (dpb -1 (byte 8 0) 0) 255)
+	(test (dpb -1 (byte 8 2) 0) 1020)
+	(test (dpb 0 (byte 16 16) #xffffffff) 65535)
+	(test (mask-field (byte 8 8) #xfffffff) #xff00)
+	(test (mask-field (byte 1 8) #xfffffff) #x100)
+	(test (ldb-test (byte 1 8) #xfffffff) #t)
+	(test (ldb-test (byte 1 8) #x10ff) #f)
+	(test (deposit-field #xabcdef (byte 8 8) 0) #xcd00)
+	(test (deposit-field #xabcdef (byte 8 4) 0) #xde0)
+	(test (deposit-field #xabcdef (byte 8 8) #xffffffff) #xffffcdff)
+	(test (identity 1) 1)
+	(test (stringp "hi") #t)
+	(test (stringp #\h) #f)
+	(test (characterp #\a) #t)
+	(test (characterp "a") #f)
+	(test (realp 1) #t)
+	(test (realp 3.14) #t)
+	(test (realp 1.0+i) #f)
+	(test (complexp 1) #f)
+	(test (complexp 1.0+i) #t)
+	(test (floatp 1) #f)
+	(test (floatp 3.14) #t)
+	(test (rationalp 1) #t)
+	(test (rationalp 1.12) #f)
+	(test (rationalp 3/4) #t)
+	(test (rationalp "hiho") #f)
+	(test (integerp "hiho") #f)
+	(test (integerp 3.14) #f)
+	(test (integerp 3) #t)
+	(test (numberp 3) #t)
+	(test (numberp "hiho") #f)
+	(test (consp ()) #f)
+	(test (consp '(1 2)) #t)
+	(test (consp 3) #f)
+	(test (atom 3) #t)
+	(test (atom ()) #t)
+	(test (atom '(1 2 3)) #f)
+	(test (vectorp #(1 2 3)) #t)
+	(test (vectorp "hiho") #f)
+	(test (symbolp 'hi) #t)
+	(test (symbolp "hiho") #f)
+	(test (last '(1 2 3)) '(3))
+	(test (last ()) ())
+	(test (tree-equal () ()) #t)
+	(test (tree-equal (list 1 2 (list 3 5) 5) (list 1 2 (list 3 4) 5)) #f)
+	(test (tree-equal (list 1 2 (list 3 4) 5) (list 1 2 (list 3 4) 5)) #t)
+	(test (nthcdr 0 '(1 2 3)) '(1 2 3))
+	(test (nthcdr 2 '(1 2 3)) '(3))
+	(test (nthcdr 4 '(1 2 3)) ())
+	(test (listp ()) #t)
+	(test (listp 3) #f)
+	(test (listp '(1 . 2)) #t)
+	(test (listp (list 1 2)) #t)
+	(test (null ()) #t)
+	(test (null '(1 2 3)) #f)
+	(test (butlast '(1 2 3 4)) '(1 2 3))
+	(test (butlast '((1 2) (3 4))) '((1 2)))
+	(test (butlast '(1)) ())
+	(test (butlast ()) ())
+	(test (copy-list ()) ())
+	(test (copy-list '(1 2 3)) '(1 2 3))
+	(test (copy-tree '(1 (2 3) 4)) '(1 (2 3) 4))
+	(test (rest '(1 2 3)) '(2 3))
+	(test (let ((i1 1) (i2 2)) (setf i1 3) (list i1 i2)) (list 3 2))
+	(test (let ((i1 1) (i2 2)) (setf i1 123 i2 32) (list i1 i2)) (list 123 32))
+	(test (let ((hi (vector 1 2 3))) (setf (hi 0) (+ 1 2) (hi 2) (* 2 3)) hi) (vector 3 2 6))
+	(test (let ((val 0)) (progn (+ val 1))) 1)
+	(test (let ((val 0)) (prog1 (+ val 1) (+ val 2))) 1)
+	(test (let ((val 0)) (prog2 (+ val 1) (+ val 2) (+ val 3))) 2)
+	(test (let ((lst (list 1))) (push 2 lst)) (list 2 1))
+	(test (let ((lst (list 1 2 3))) (list (pop lst) lst)) (list 1 (list 2 3)))
+	(test (let ((x 0)) (incf x) x) 1)
+	(test (let ((x 0)) (incf x 2) x) 2)
+	(test (let ((x 0)) (decf x) x) -1)
+	(test (let ((x 0)) (decf x 2) x) -2)
+	(test (let ((lst (list 1 2))) (pushnew 1 lst)) (list 1 2))
+	(test (let ((lst (list 1 2))) (pushnew 3 lst)) (list 3 1 2))
+	(test (let ((a 1) (b 2)) (psetq a b b a) (list a b)) '(2 1))
+	(test (let ((a 1) (b 2) (c 3)) (psetq a (+ b c) b (+ a c) c (+ a b)) (list a b c)) '(5 4 3))
+	(test (let ((val #f)) (unless val 1)) 1)
+	(test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (first val)) 1)
+	(test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (second val)) 2)
+	(test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (third val)) 3)
+	(test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (fourth val)) 4)
+	(test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (fifth val)) 5)
+	(test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (sixth val)) 6)
+	(test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (seventh val)) 7)
+	(test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (eighth val)) 8)
+	(test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (ninth val)) 9)
+	(test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (tenth val)) 10)
+	(test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (nth 7 val)) 8)
+	(test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (nth 17 val)) ())
+
+	(test (let () (enum one two three) (list one two three)) '(0 1 2))
+
+	(test (let () (defstruct x1 a b c) (let ((xx1 (make-x1 1 2 3))) (list (x1-a xx1) (x1-b xx1) (x1-c xx1) (x1? xx1)))) '(1 2 3 #t))
+	(test (let () (defstruct x1 a (b "hi") (c 3/4)) (let ((xx1 (make-x1 1))) (list (x1-a xx1) (x1-b xx1) (x1-c xx1) (x1? xx1)))) '(1 "hi" 3/4 #t))
+	(test (let () (defstruct x1 a (b "hi") (c 3/4)) (let ((xx1 (make-x1 :b 1))) (list (x1-a xx1) (x1-b xx1) (x1-c xx1) (x1? xx1)))) '(#f 1 3/4 #t))
+	(test (let () (defstruct x1 a b c) (let ((xx1 (make-x1 1 2 3))) (set! (x1-a xx1) 32) (list (x1-a xx1) (x1-b xx1) (x1-c xx1)))) '(32 2 3))
+
+	(let ()
+	  (defstruct ship (x 0.0) (y 0.0 :type 'real))
+	  (test (let ((s1 (make-ship 1.0 2.0)))
+		  (let ((s2 (copy-ship s1)))
+		    (list (ship-x s2) (ship-y s2))))
+		'(1.0 2.0))
+	  (test (let ((s3 (make-ship :y 1.0 :x 2.0)))
+		  (list (ship-x s3) (ship-y s3)))
+		'(2.0 1.0)))
+
+	(let()
+	  (defstruct ship1 x y)
+	  (let ((s1 (make-ship1 "hi" (list 1 2 3))))
+	    (let ((s2 (copy-ship1 s1)))
+	      (test (list (ship1-x s2) (ship1-y s2)) '("hi" (1 2 3))))))
+
+	(let ()
+	  (defstruct ship2 (x 0.0) (y 1.0 :read-only #t))
+	  (let ((s1 (make-ship2)))
+	    (test (let ((tag (catch #t
+				    (lambda ()
+				      (set! (ship2-y s1) 123.0))
+				    (lambda args (car args)))))
+		    tag)
+		  'no-setter)
+	    (set! (ship2-x s1) 123.0)
+	    (test (ship2-x s1)  123.0)))
+
+	(let ()
+	  (defstruct (ship3 (:conc-name hi)) (x 0.0) (y 1.0 :read-only #t))
+	  (let ((s1 (make-ship3 :x 3.0)))
+	    (test (list (hi-x s1) (hi-y s1)) '(3.0 1.0))))
+
+	(let ()
+	  (defstruct (ship4 (:constructor new-ship)) (x 0.0) (y 1.0 :read-only #t))
+	  (let ((s1 (new-ship 1.0 2.0)))
+	    (test (list (ship4-x s1) (ship4-y s1)) '(1.0 2.0))))
+
+	)
+     ) ; end CL
+(if (not (eq? else 'else)) (set! else 'else)) ; loop sets else!
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; NUMBERS
+;;; --------------------------------------------------------------------------------
+
+
+(test (let () (set! most-positive-fixnum 2)) 'error)
+(test (let ((most-positive-fixnum 2)) most-positive-fixnum) 'error)
+(test (let () (set! most-negative-fixnum 2)) 'error)
+(test (let ((most-negative-fixnum 2)) most-negative-fixnum) 'error)
+(test (let () (set! pi 2)) 'error)
+(test (let ((pi 2)) pi) 'error)
+
+(if (not (nan? +nan.0)) (format #t ";(string->number \"+nan.0\") returned ~A~%" +nan.0))
+(if (infinite? +nan.0) (format #t ";+nan.0 is infinite?~%"))
+
+(if (not (infinite? +inf.0)) (format #t ";(string->number \"+inf.0\") returned ~A~%" +inf.0))
+(if (nan? +inf.0) (format #t ";+inf.0 is NaN?~%"))
+
+(if (not (infinite? -inf.0)) (format #t ";(string->number \"-inf.0\") returned ~A~%" -inf.0))
+(if (nan? -inf.0) (format #t ";-inf.0 is NaN?~%"))
+
+(define-constant inf+infi (complex +inf.0 +inf.0))
+(define-constant nan+nani (complex +nan.0 +nan.0))
+(define-constant 0+infi (complex 0 +inf.0))
+(define-constant 0+nani (complex 0 +nan.0))
+
+(test (equal? +inf.0 +inf.0) #t)
+(test (equal? +inf.0 -inf.0) #f)
+(test (equal? +nan.0 +inf.0) #f)
+(test (= +nan.0 +nan.0) #f)
+(test (equal? +inf.0 +nan.0) #f)
+; (test (equal? +nan.0 +nan.0) (eqv? +nan.0 +nan.0)) ; these are confusing: (equal? 0/0 0/0) is a different case
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; number?
+;;; --------------------------------------------------------------------------------
+;;; (synonym for complex?)
+
+(test (number? -) #f)
+(test (number? +) #f)
+(test (number? 12) #t)
+(test (number? 3) #t )
+(test (number? (expt 2 130)) #t)
+(test (number? 5/3+7.2i) #t)
+(test (number? #f) #f)
+(test (number? (cons 1 2)) #f)
+(test (number? 2.5-.5i) #t)
+(test (number? most-negative-fixnum) #t)
+(test (number? 1e-308) #t)
+(test (number? 1e308) #t)
+(test (number? 0+0i) #t)
+(test (number? (log 0)) #t)
+(test (number? (real-part (log 0))) #t)
+(test (number? '-1-i) #t)
+(test (number? -1.797693134862315699999999999999999999998E308) #t)
+(test (number? -2.225073858507201399999999999999999999996E-308) #t)
+(test (number? -9223372036854775808) #t)
+(test (number? 1.110223024625156799999999999999999999997E-16) #t)
+(test (number? 9223372036854775807) #t)
+(test (number? +inf.0) #t)
+(test (number? -inf.0) #t)
+(test (number? +nan.0) #t)
+(test (number? inf+infi) #t)
+(test (number? nan+nani) #t)
+(test (number? 0+infi) #t)
+(test (number? 0+nani) #t)
+(test (number? pi) #t)
+(test (number? 0/0) #t)
+(test (number? 1/-4) 'error)
+(test (number? '+nan.0) #t) ; i.e. is +nan.0 read as a number so #r(+nan.0) is legal
+(test (number? '-nan.0) #t)
+(test (number? '+inf.0) #t)
+(test (number? '-inf.0) #t)
+
+(for-each
+ (lambda (n)
+   (let ((nb (catch #t (lambda () (number? n)) (lambda args 'error))))
+     (if (not nb) (format #t ";(number? ~A) -> #f?~%" n))))
+ (list '1e311 '1e-311 '0e311 '2.1e40000))
+
+(when with-bignums
+  (test (number? 1234567891234567890/1234567) #t)
+  (test (number? 9223372036854775808) #t)
+  (test (number? 9223372036854775808.1) #t)
+  (test (number? 9223372036854775808.1+1.5i) #t)
+  (test (number? 9223372036854775808/3) #t))
+
+(test (number?) 'error)
+(test (number? 1 2) 'error)
+
+(for-each
+ (lambda (op opname)
+   (for-each
+    (lambda (arg)
+      (if (op arg)
+	  (format #t ";(~A ~A) -> #t?~%" op arg)))
+    (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+	  #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>)))
+ (list number? complex? real? rational? integer? float?)
+ (list 'number? 'complex? 'real? 'rational? 'integer? float?))
+
+
+;;; --------------------------------------------------------------------------------
+;;; complex?
+;;; --------------------------------------------------------------------------------
+
+(test (complex? 1/2) #t)
+(test (complex? 2) #t)
+(test (complex? (sqrt 2)) #t)
+(test (complex? 1.0) #t)
+(test (complex? 1+i) #t)
+(test (complex? most-negative-fixnum) #t)
+(test (complex? 1/0) #t) ; nan is complex?? I guess so -- it's a "real"...
+(test (complex? (log 0.0)) #t)
+(test (complex? 0/0) #t)
+(test (complex? 1+0/0i) #t)
+(test (complex? -1.797693134862315699999999999999999999998E308) #t)
+(test (complex? -2.225073858507201399999999999999999999996E-308) #t)
+(test (complex? -9223372036854775808) #t)
+(test (complex? 1.110223024625156799999999999999999999997E-16) #t)
+(test (complex? 9223372036854775807) #t)
+(test (complex? 3) #t )
+(test (complex? +inf.0) #t)
+(test (complex? -inf.0) #t)
+(test (complex? +nan.0) #t) ; this should be #f
+(test (complex? pi) #t)
+
+(for-each
+ (lambda (arg)
+   (if (not (complex? arg))
+       (format #t ";(complex? ~A) -> #f?~%" arg)))
+ (list 1 1.0 1.0+0.5i 1/2))
+
+(when with-bignums
+  (test (complex? 1234567891234567890/1234567) #t)
+  (test (complex? 9223372036854775808) #t)
+  (test (complex? 9223372036854775808.1) #t)
+  (test (complex? 9223372036854775808.1+1.5i) #t)
+  (test (complex? 0+92233720368547758081.0i) #t)
+  (test (complex? 9223372036854775808/3) #t))
+
+(test (complex?) 'error)
+(test (complex? 1 2) 'error)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; real?
+;;; --------------------------------------------------------------------------------
+
+(test (real? 1) #t)
+(test (real? most-negative-fixnum) #t)
+(test (real? 1/2) #t)
+(test (real? 1.0) #t)
+(test (real? (+ 1+i 1-i)) #t)
+(test (real? (- 1+i 1+i)) #t)
+(test (real? (+ 1+i -1-i)) #t)
+(test (real? (/ 1+i 1+i)) #t)
+(test (real? (* 0+i 0+i)) #t)
+(test (real? (magnitude 1+i)) #t)
+(test (real? (string->number "1+0i")) #t)
+(test (real? (complex 1 0)) #t)
+(test (real? (complex 0 0)) #t)
+(test (real? (complex 1 0.0)) #t)
+(test (real? (complex 0.0 -0.0)) #t)
+(test (real? (make-polar 0 0)) #t)
+(test (real? (make-polar 1 0)) #t)
+(test (real? (angle 1+i)) #t)
+(test (real? (real-part 1+i)) #t)
+(test (real? (imag-part 1+i)) #t)
+(test (real? (expt 0+i 0+i)) #t)
+(test (real? (log 0)) #f)
+(test (real? (real-part (log 0))) #t)
+(test (real? +inf.0) #t)
+(test (real? -inf.0) #t)
+(test (real? +nan.0) #t) ; see below
+(test (real? pi) #t)
+(test (real? 0+i) #f)
+(test (real? 1.0-0.1i) #f)
+(test (real? (sqrt 2)) #t)
+(test (real? 1+i) #f)
+(test (real? 1e9-0i) #t)
+(test (real? 0+0i) #t)
+(test (real? 1.0+0i) #t)
+(test (real? 1.0+0.0i) #t)
+(test (real? 1+0.0i) #t)
+(test (real? 1-0.0i) #t)
+(test (real? 1+0i) #t)
+(test (real? -0+1e22i) #f)
+(test (real? -0+1e-22i) #f)
+(test (real? 0+1e-322i) #f)
+(test (real? 1+0/0i) #f) ; bignum direct 1+0/0i -> 1.0
+(test (real? 1.0000000000000000000000000000+0.0000000000000000000000000000i) #t)
+(test (real? 1.0+0.0000000000000000000000000000i) #t)
+(test (real? 1.0000000000000000000000000000+0.0i) #t)
+(test (real? 1.0000000000000000000000000000+0e10i) #t)
+(test (real? 1.0+0.0000000000000000000000000000e10i) #t)
+(test (real? 1.0000000000000000000000000000+0.0e10i) #t)
+(test (real? 0+00000000000000000000000000000000/123456789012345678901234567890i) #t)
+(test (real? -1.797693134862315699999999999999999999998E308) #t)
+(test (real? -2.225073858507201399999999999999999999996E-308) #t)
+(test (real? -9223372036854775808) #t)
+(test (real? 1.110223024625156799999999999999999999997E-16) #t)
+(test (real? 9223372036854775807) #t)
+
+(when with-bignums
+  (test (real? 9.92209574402351949043519108941671096176E-1726-4.788930572030484370393069119625570107346E-1726i) #f)
+  (test (real? 1234567891234567890/1234567) #t)
+  (test (real? 9223372036854775808) #t)
+  (test (real? 9223372036854775808.1) #t)
+  (test (real? 9223372036854775808.1+1.5i) #f)
+  (test (real? 9223372036854775808/3) #t))
+
+(test (real? case) #f)
+(test (real?) 'error)
+(test (real? 1 2) 'error)
+
+(test (real? (real-part (log 0.0))) #t) ; -inf
+(test (real? (/ (real-part (log 0.0)) (real-part (log 0.0)))) #t) ; nan -- I think this should be #f
+(test (real? (real-part (log 0))) #t)
+
+
+;;; float?
+
+(test (float? 1) #f)
+(test (float? 1/2) #f)
+(test (float? 1.4) #t)
+(test (float? 1+i) #f)
+(test (float?) 'error)
+(test (float? 1.0 1.0) 'error)
+(test (float? #\a) #f)
+(test (float? (real-part (log 0.0))) #t)
+(test (float? 1/0) #t)
+(test (float? pi) #t)
+(test (float? 1e-308) #t)
+(when with-bignums (test (float? (bignum "1.0")) #t))
+
+;;; byte?
+
+(test (byte? 1) #t)
+(test (byte? 1/2) #f)
+(test (byte? 1.4) #f)
+(test (byte? 1+i) #f)
+(test (byte?) 'error)
+(test (byte? 1 1) 'error)
+(test (byte? #\a) #f)
+(test (byte? 0) #t)
+(test (byte? -1) #f)
+(test (byte? 256) #f)
+(test (byte? 255) #t)
+(when with-bignums (test (byte? (bignum "1")) #t))
+
+(for-each
+ (lambda (arg)
+   (if (byte? arg) (format #t ";(byte? ~A) -> #t?~%" arg))
+   (if (float? arg) (format #t ";(float? ~A) -> #t?~%" arg)))
+ (list "hi" '(1 2) (integer->char 65) 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote
+       macroexpand #\f (lambda (a) (+ a 1)) :hi (if #f #f) #<eof> #<undefined>))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; rational?
+;;; --------------------------------------------------------------------------------
+
+(test (rational? 3) #t)
+(test (rational? 1/2) #t)
+(test (rational? 2) #t)
+(test (rational? (sqrt 2)) #f)
+(test (rational? 1.0) #f)
+(test (rational? 1+i) #f)
+(test (rational? most-negative-fixnum) #t)
+(test (rational? 0/0) #f)  ; I like this
+(test (rational? 1/0) #f)
+(test (rational? (/ 1 2)) #t)
+(test (rational? (/ 1 2/3)) #t)
+(test (rational? (/ 2/5 2/3)) #t)
+(test (rational? (/ 2/5 -3)) #t)
+(test (rational? (/ -4 4)) #t)
+(test (rational? (/ 1.0 2)) #f)
+(test (rational? 1/2+i) #f)
+(test (rational? -1.797693134862315699999999999999999999998E308) #f)
+(test (rational? -2.225073858507201399999999999999999999996E-308) #f)
+(test (rational? -9223372036854775808) #t)
+(test (rational? 1.110223024625156799999999999999999999997E-16) #f)
+(test (rational? 9223372036854775807) #t)
+(test (rational? +inf.0) #f)
+(test (rational? -inf.0) #f)
+(test (rational? +nan.0) #f) ; guile says #t!
+(test (rational? pi) #f)
+(test (rational? 9223372036854775806/9223372036854775807) #t)
+(test (rational? 1+0i) #f) ; ??
+(test (rational? 1+0.0i) #f) ; ?? see integer?
+
+(when with-bignums
+  (test (rational? 1234567891234567890/1234567) #t)
+  (test (rational? 9223372036854775808) #t)
+  (test (rational? 9223372036854775808.1) #f)
+  (test (rational? 9223372036854775808.1+1.5i) #f)
+  (test (rational? 9223372036854775808/3) #t))
+
+(test (rational?) 'error)
+(test (rational? 1 2) 'error)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; integer?
+;;; --------------------------------------------------------------------------------
+
+(test (integer? 0.0) #f)
+(test (integer? 3) #t)
+(test (integer? 1/2) #f)
+(test (integer? 1/1) #t)
+(test (integer? 2) #t)
+(test (integer? (sqrt 2)) #f)
+(test (integer? 1.0) #f)
+(test (integer? 1+i) #f)
+(test (integer? most-negative-fixnum) #t)
+(test (integer? 250076005727/500083) #t)
+(test (integer? 1+0i) #f) ; hmmm -- guile says #t, but it thinks 1.0 is an integer
+(test (integer? 0/0) #f)
+(test (integer? 1/0) #f)
+(test (integer? (/ 2 1)) #t)
+(test (integer? (/ 2 1.0)) #f)
+(test (integer? -1.797693134862315699999999999999999999998E308) #f)
+(test (integer? -2.225073858507201399999999999999999999996E-308) #f)
+(test (integer? -9223372036854775808) #t)
+(test (integer? 1.110223024625156799999999999999999999997E-16) #f)
+(test (integer? 9223372036854775807) #t)
+(test (integer? (expt 2.3 54)) #f)
+(test (integer? 10000000000000000.5) #f)
+(test (integer? (expt 2 54)) #t)
+(test (integer? (expt 2.0 54)) #f)
+(test (integer? most-positive-fixnum) #t)
+(test (integer? (/ most-positive-fixnum most-positive-fixnum)) #t)
+(test (integer? +inf.0) #f)
+(test (integer? -inf.0) #f)
+(test (integer? +nan.0) #f)
+(test (integer? pi) #f)
+(test (integer? 9223372036854775806/9223372036854775807) #f)
+(test (integer? 1+0.0i) #f)
+
+(when with-bignums
+  (test (integer? 1234567891234567890/1234567) #f)
+  (test (integer? 9223372036854775808) #t)
+  (test (integer? 9223372036854775808.1) #f)
+  (test (integer? 9223372036854775808.1+1.5i) #f)
+  (test (integer? 9223372036854775808/3) #f)
+  (test (integer? 9223372036854775808/9223372036854775808) #t)
+  (test (integer? 21345678912345678912345678913456789123456789123456789) #t))
+
+(test (integer?) 'error)
+(test (integer? 1 2) 'error)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; infinite?
+;;; --------------------------------------------------------------------------------
+;;; (define (infinite? x) (and (number? x) (or (= x +inf.0) (= x -inf.0)))) but this misses complex cases
+;;;
+;;; a number can be both NaN and infinite...:
+(test (nan? (complex 0/0 (real-part (log 0)))) #t)
+(test (infinite? (complex 0/0 (real-part (log 0)))) #t)
+;;; maybe we should restrict nan? and infinite? to reals?
+
+(test (infinite? 0) #f)
+(test (infinite? 1.0) #f)
+(test (infinite? 1/2) #f)
+(test (infinite? 1+i) #f)
+(test (infinite? most-positive-fixnum) #f)
+(test (infinite? +inf.0) #t)
+(test (infinite? -inf.0) #t)
+(test (infinite? +nan.0) #f)
+(test (infinite? pi) #f)
+(test (infinite? (imag-part (sinh (log 0.0)))) #t)
+(test (infinite? (complex -inf.0 +inf.0)) #t)
+(test (infinite? (+ (complex 1 +inf.0))) #t)
+(test (infinite? most-negative-fixnum) #f)
+(test (infinite? -1.797693134862315699999999999999999999998E308) #f)
+(test (infinite? -2.225073858507201399999999999999999999996E-308) #f)
+(test (infinite? (real-part inf+infi)) #t)
+(test (infinite? (real-part 0+infi)) #f)
+(test (infinite? (imag-part inf+infi)) #t)
+(test (infinite? (imag-part 0+infi)) #t)
+
+(test (infinite? (imag-part (complex 0.0 (real-part (log 0))))) #t)
+(test (infinite? (real-part (complex 0.0 (real-part (log 0))))) #f)
+(test (infinite? (complex 0.0 (real-part (log 0)))) #t)
+(test (infinite? (real-part (complex (real-part (log 0)) 1.0))) #t)
+(test (infinite? (imag-part (complex (real-part (log 0)) 1.0))) #f)
+(test (infinite? (complex (real-part (log 0)) 1.0)) #t)
+(test (infinite? (imag-part (complex (real-part (log 0)) (real-part (log 0))))) #t)
+(test (infinite? (real-part (complex (real-part (log 0)) (real-part (log 0))))) #t)
+(test (infinite? (complex (real-part (log 0)) (real-part (log 0)))) #t)
+
+;; if mpc version > 0.8.2
+;; (test (infinite? (sin 1+1e10i)) #t)
+;; this hangs in earlier versions
+
+(when with-bignums
+  (test (infinite? (log (bignum "0.0"))) #t)
+  (test (infinite? 1e310) #f)
+  (test (infinite? 1e400) #f)
+  (test (infinite? 1.695681258519314941339000000000000000003E707) #f)
+  (test (infinite? 7151305879464824441563197685/828567267217721441067369971) #f))
+
+(test (infinite?) 'error)
+(test (infinite? 1 2) 'error)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; nan?
+;;; nan
+;;; nan-payload
+;;; --------------------------------------------------------------------------------
+;;; (define (nan? x) (and (number? x) (not (= x x))))
+
+(test (nan? +inf.0) #f)
+(test (nan? -inf.0) #f)
+(test (nan? +nan.0) #t)
+(test (nan? pi) #f)
+(test (nan? (imag-part 0+0/0i)) #t)
+(test (nan? (imag-part (sinh 0+0/0i))) #t)
+(test (nan? (imag-part (sinh 1-0/0i))) #t)
+(test (nan? (log 10 0/0)) #t)
+(test (nan? (* 0 +inf.0)) #t)
+(test (nan? (real-part nan+nani)) #t)
+(test (nan? (imag-part nan+nani)) #t)
+(test (nan? (real-part 0+nani)) #f)
+(test (nan? (imag-part 0+nani)) #t)
+
+(when with-bignums
+  (test (nan? (bignum "1/0")) #t)
+  (test (nan? 7151305879464824441563197685/828567267217721441067369971) #f)
+  (test (nan? 1624540914719833702142058941.4) #f))
+
+(test (nan?) 'error)
+(test (nan? 1 2) 'error)
+
+#|
+(define digits (vector #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
+
+(do ((i 0 (+ i 1)))
+    ((= i 10000))
+  (let ((int-digits (random 80))
+	(frac-digits (random 80))
+	(exp-digits (+ 1 (random 5)))
+	(signed (> (random 10) 5))
+	(signed-exponent (> (random 10) 5)))
+    (let ((str (make-string (+ 1 int-digits 1 frac-digits 2 exp-digits) #\space))
+	  (j 0))
+
+      (if signed
+	  (begin
+	    (set! (str j) #\-)
+	    (set! j (+ j 1))))
+
+      (do ((k 0 (+ k 1)))
+	  ((= k int-digits))
+	(set! (str j) (digits (random 10)))
+	(set! j (+ j 1)))
+
+      (set! (str j) #\.)
+      (set! j (+ j 1))
+
+       (do ((k 0 (+ k 1)))
+	  ((= k frac-digits))
+	(set! (str j) (digits (random 10)))
+	(set! j (+ j 1)))
+
+      (set! (str j) #\e)
+      (set! j (+ j 1))
+
+      (if signed-exponent
+	  (begin
+	    (set! (str j) #\-)
+	    (set! j (+ j 1))))
+
+      (do ((k 0 (+ k 1)))
+	  ((= k exp-digits))
+	 (if (< k 3)
+	     (set! (str j) (digits (random 10)))
+	     (set! (str j) (digits (random 4))))
+	 (set! j (+ j 1)))
+
+      (let ((num (string->number (substring str 0 j))))
+	(if (or (nan? num)
+		(infinite? num))
+	    (format #t "~A: ~S -> ~A~%" (if (infinite? num) 'inf 'nan) str num)))
+      )))
+|#
+
+;;; these all relate to inf/nan
+
+(unless with-bignums
+  (test (* 1e12000 1e12000) +inf.0)
+  (test (<= 0 +inf.0 +nan.0) #f)
+  (test (<= 1 +nan.0) #f)
+  (test (<= +nan.0 1) #f)
+  (test (<= +nan.0 +inf.0) #f)
+  (test (<= +nan.0 +nan.0) #f)
+  (test (>= 1 +nan.0) #f)
+  (test (>= +nan.0 1) #f)
+  (test (>= +nan.0 +inf.0) #f)
+  (test (>= +nan.0 +nan.0) #f)
+  (test (floor +inf.0) 'error)
+  (test (inexact->exact (complex 1 +inf.0)) 'error)
+  (test (nan? (expt 0 +nan.0)) #t)
+  (test (nan? (expt 1 +nan.0)) #t)
+  (test (nan? (expt +nan.0 +inf.0)) #t)
+  (test (nan? (expt +nan.0 +nan.0)) #t)
+  (test (rationalize 1e19) 'error)
+  (test (round +inf.0) 'error)
+  (test (truncate +inf.0) 'error))
+
+(num-test (/ -1 -inf.0 -9223372036854775808) 0.0)
+(num-test (angle -inf.0) pi)
+(num-test (angle +inf.0) 0.0)
+(num-test (atan +inf.0) 1.5707963267949)
+;; (test (let ((val (atanh +inf.0))) (or (nan? val) (equivalent? val 0+1.5707963267949i))) #t) ; different if g++
+(num-test (tanh -inf.0) -1.0)
+(num-test (tanh +inf.0) 1.0)
+(test (* -inf.0 +inf.0) -inf.0)
+(test (* +inf.0) +inf.0)
+(test (+ 0 +inf.0) +inf.0)
+(test (+ +inf.0) +inf.0)
+(test (- -inf.0 +inf.0) -inf.0)
+(test (- 0 +inf.0) -inf.0)
+(test (- +inf.0) -inf.0)
+(test (/ 0 +inf.0) 0.0)
+(test (/ +inf.0) 0.0)
+(test (/ +nan.0 0) 'error)
+(test (< -inf.0 0.0) #t)
+(test (< -inf.0 +inf.0) #t)
+(test (< -inf.0 +inf.0) #t)
+(test (< 0 +inf.0 -inf.0) #f)
+(test (< 0 +inf.0) #t)
+(test (< +inf.0 -inf.0) #f)
+(test (< +nan.0 +inf.0) #f)
+(test (< +nan.0 +nan.0) #f)
+(test (<= -inf.0 0.0 +inf.0 +inf.0) #t)
+(test (<= -inf.0 +inf.0) #t)
+(test (<= 0 +inf.0 -inf.0) #f)
+(test (<= 0 +inf.0) #t)
+(test (= (* (+ +inf.0 +inf.0) -inf.0) -inf.0) #t)
+(test (= (* -3.4 -inf.0) +inf.0) #t)
+(test (= (* -inf.0 -inf.0) +inf.0) #t)
+(test (= (* +inf.0 -inf.0) -inf.0) #t)
+(test (= (* +inf.0 +inf.0) +inf.0) #t)
+(test (= (+ 1 +inf.0) +inf.0) #t)
+(test (= (+ +inf.0 +inf.0) +inf.0) #t)
+(test (= (- -inf.0) +inf.0) #t)
+(test (= (- 0.0 +inf.0) -inf.0) #t)
+(test (= (- +inf.0) -inf.0) #t)
+(test (= (/ 0.0 +inf.0) 0.0) #t)
+(test (= (abs -inf.0) +inf.0) #t)
+(test (= (abs +inf.0) +inf.0) #t)
+(test (= (exp -inf.0) 0.0) #t)
+(unless with-bignums
+  (test (= (exp +inf.0) +inf.0) #t)
+  (test (= (exp most-positive-fixnum) +inf.0) #t))
+(test (= (exp most-negative-fixnum) 0.0) #t)
+(test (= (expt -inf.0 0) 1.0) #t)
+(test (= (expt 0.0 +inf.0) 0.0) #t)
+(test (= (expt 1 -inf.0) 1.0) #t)
+(test (= (expt 1 +inf.0) 1.0) #t)
+(test (= (expt 2 -inf.0) 0.0) #t)
+(test (= (expt +inf.0 0) 1.0) #t)
+(test (= (log +inf.0) +inf.0) #t)
+(test (= (magnitude -inf.0) +inf.0) #t)
+(test (= (magnitude +inf.0) +inf.0) #t)
+;(if (not (provided? 'pure-s7)) (test (= (make-polar +inf.0 0) +inf.0) #t))
+(test (= (complex 0 +inf.0) (sqrt -inf.0)) #t)   ; (sqrt -inf.0) -> 0+infi !
+(test (= (complex +inf.0 0) +inf.0) #t)
+(test (= (max -inf.0 +inf.0) +inf.0) #t)
+(test (= (min -inf.0 +inf.0) -inf.0) #t)
+(test (= (sqrt +inf.0) +inf.0) #t)
+(test (infinite? (imag-part (sqrt -inf.0))) #t)
+(test (= -inf.0 -inf.0) #t)
+(test (= -inf.0 +inf.0) #f)
+(test (= 0 +inf.0 -inf.0) #f)
+(test (= 0 +inf.0) #f)
+(test (= 0.0 +nan.0) #f)
+(test (= +inf.0 0.0) #f)
+(test (= +inf.0 +inf.0) #t)
+(test (= +inf.0 most-positive-fixnum) #f)
+(test (= +inf.0 +nan.0) #f)
+(test (nan? (real-part nan+nani)) #t)
+(test (= +nan.0 +inf.0) #f)
+(test (nan? nan+nani) #t)
+(test (nan? +nan.0) #t)
+(test (> -inf.0 +inf.0) #f)
+(test (> 0 +inf.0 -inf.0) #f)
+(test (> 0 +inf.0) #f)
+(test (> +inf.0 0.0) #t)
+(test (> +inf.0 1.0e308) #t)
+(test (> +inf.0 most-positive-fixnum) #t)
+(test (> +nan.0 +inf.0) #f)
+(test (> +nan.0 +nan.0) #f)
+(test (>= -inf.0 +inf.0) #f)
+(test (>= 0 +inf.0) #f)
+(test (>= +inf.0 -inf.0 0.0) #f)
+(test (abs +inf.0) +inf.0)
+(test (acosh +inf.0) +inf.0)
+(test (angle +inf.0) 0.0)
+(test (ash -inf.0 +inf.0) 'error)
+(test (ash +nan.0 +inf.0) 'error)
+(test (ash +nan.0 +nan.0) 'error)
+(test (asinh +inf.0) +inf.0)
+(test (ceiling +inf.0) 'error)
+(test (ceiling +nan.0) 'error)
+(test (complex? nan+nani) #t)
+(test (cosh +inf.0) +inf.0)
+(test (even? +inf.0) 'error)
+(test (exact? (complex 1 +inf.0)) #f)
+(test (exp +inf.0) +inf.0)
+(test (expt +nan.0) 'error)
+(test (floor +inf.0) 'error)
+(test (floor +nan.0) 'error)
+(test (gcd -inf.0 +inf.0) 'error)
+(test (gcd +nan.0 +inf.0) 'error)
+(test (gcd +nan.0 +nan.0) 'error)
+(test (imag-part (complex 1 +inf.0)) +inf.0)
+(test (imag-part +nan.0) 0.0)
+(test (inexact? (complex 1 +inf.0)) #t)
+(test (infinite? 1 2) 'error)
+(test (infinite?) 'error)
+(test (lcm -inf.0 +inf.0) 'error)
+(test (lcm +nan.0 +inf.0) 'error)
+(test (lcm +nan.0 +nan.0) 'error)
+(test (lcm +nan.0) 'error)
+(test (log 8.0 +inf.0) 0.0)
+(test (log +inf.0) +inf.0)
+(test (logand -inf.0 +inf.0) 'error)
+(test (logand +nan.0 +inf.0) 'error)
+(test (logand +nan.0 +nan.0) 'error)
+(test (logior -inf.0 +inf.0) 'error)
+(test (logior +nan.0 +inf.0) 'error)
+(test (logior +nan.0 +nan.0) 'error)
+(test (lognot -inf.0) 'error)
+(test (lognot +nan.0) 'error)
+(test (logbit? -inf.0 +inf.0) 'error)
+(test (logbit? +nan.0 +inf.0) 'error)
+(test (logbit? +nan.0 +nan.0) 'error)
+(test (logxor -inf.0 +inf.0) 'error)
+(test (logxor +nan.0 +inf.0) 'error)
+(test (logxor +nan.0 +nan.0) 'error)
+(test (magnitude +inf.0) +inf.0)
+(test (random-state +inf.0) 'error)
+(test (random-state +nan.0) 'error)
+(test (max -inf.0 +inf.0) +inf.0)
+(test (max 0 +inf.0 -inf.0) +inf.0)
+(test (max 0 +inf.0) +inf.0)
+(test (max +inf.0) +inf.0)
+(test (min -inf.0 +inf.0) -inf.0)
+(test (min 0 +inf.0 -inf.0) -inf.0)
+(test (min 0 +inf.0) 0)
+(test (min +inf.0) +inf.0)
+(test (nan? (* 0 +nan.0)) #t)
+(test (nan? (+ (values +inf.0 -inf.0) +inf.0)) #t)
+(test (nan? (- -inf.0 -inf.0)) #t)
+(test (nan? (- +inf.0 +inf.0)) #t)
+(test (nan? (- +nan.0 +nan.0)) #t)
+(test (nan? (- +nan.0)) #t)
+(test (nan? (* 0 (log 0))) #t)
+(test (nan? (/ -1 +nan.0 -inf.0)) #t)
+(test (nan? (/ -inf.0 -inf.0)) #t)
+(test (nan? (/ 0 +nan.0)) #t)
+;(test (nan? (/ 0 (log 0))) #t) ;why not just 0.0?
+(test (nan? (/ +inf.0 -inf.0)) #t)
+(test (nan? (/ +inf.0 +inf.0)) #t)
+(test (nan? (/ +inf.0 +nan.0)) #t)
+(test (nan? (/ +nan.0 +inf.0)) #t)
+(test (nan? (/ +nan.0 +nan.0)) #t)
+(test (nan? (/ +nan.0)) #t)
+(test (nan? (abs +nan.0)) #t)
+;(test (nan? (acos +inf.0)) #t)
+(test (nan? (angle +nan.0)) #t)
+;(test (nan? (asin +inf.0)) #t)
+(test (nan? (asin +nan.0)) #t)
+(test (nan? (exp +nan.0)) #t)
+(test (nan? (imag-part (complex 0 +nan.0))) #t)
+(test (nan? (imag-part nan+nani)) #t)
+(test (nan? (log 8.0 +nan.0)) #t)
+(test (nan? (log +nan.0 +nan.0)) #t)
+(test (nan? (magnitude nan+nani)) #t)
+(test (nan? (magnitude +nan.0)) #t)
+(test (nan? (make-polar -inf.0 +inf.0)) #t)
+(test (nan? (make-polar +nan.0 0)) #t)
+(test (nan? (complex +nan.0 0)) #t)
+(test (nan? (max 0 +inf.0 +nan.0)) #t)
+(test (nan? (max 1 +nan.0)) #t)
+(test (nan? (min 0 +inf.0 +nan.0)) #t)
+(test (nan? (min 1 +nan.0)) #t)
+;(test (nan? (modulo 1 +inf.0)) #t)
+;(test (nan? (modulo 1 +nan.0)) #t)
+;(test (nan? (modulo +inf.0 1)) #t)
+;(test (nan? (modulo +nan.0 1)) #t)
+(test (nan? (random +nan.0)) #t)
+(test (nan? (real-part (exp nan+nani))) #t)
+(test (nan? (real-part (log nan+nani))) #t)
+(test (nan? (real-part (log +nan.0))) #t)
+(test (nan? (real-part (complex -inf.0 0))) #f)
+(test (nan? (real-part (sqrt +nan.0))) #t)
+(test (nan? (real-part nan+nani)) #t)
+(test (nan? (sin -inf.0)) #t)
+(test (nan? (sin +inf.0)) #t)
+(test (nan? (sin +nan.0)) #t)
+(test (nan? (string->number "+nan.0")) #t)
+(test (nan? -inf.0) #f)
+(test (nan? 1 2) 'error)
+(test (nan? +inf.0) #f)
+(test (nan? most-negative-fixnum) #f)
+(test (nan? most-positive-fixnum) #f)
+(test (nan?) 'error)
+(test (negative? (/ (real-part (log 0.0)) (real-part (log 0.0)))) #f) ; and yet it prints as -nan.0
+(test (number? nan+nani) #t)
+(test (nan? (quotient 1 +nan.0)) #t)
+(test (nan? (quotient +nan.0 1)) #t)
+(test (random +nan.0 +inf.0) 'error)
+(test (rationalize -inf.0) 'error)
+(test (rationalize 0.5 +inf.0) 0)
+(test (rationalize 178978.5 -inf.0) 0)
+(test (rationalize 178987.5 +nan.0) 'error)
+(test (rationalize 198797.5 +inf.0) 0)
+(test (rationalize +inf.0) 'error)
+(test (rationalize +nan.0 +nan.0) 'error)
+(test (rationalize +nan.0) 'error)
+(test (real-part (complex 1 +inf.0)) 1.0)
+(test (real? nan+nani) #f)
+(test (nan? (remainder 1 +nan.0)) #t)
+(test (nan? (remainder +nan.0 1)) #t)
+(test (round +inf.0) 'error)
+(test (round +nan.0)'error)
+(test (sinh +inf.0) +inf.0)
+(test (sqrt +inf.0) +inf.0)
+(test (tanh +inf.0) 1.0)
+(test (truncate +inf.0) 'error)
+(test (truncate +nan.0) 'error)
+(test (zero? (complex 1 +inf.0)) #f)
+(test (zero? (real-part (complex 0 -inf.0))) #t)
+(test (zero? 0/0) #f)
+(test (zero? +inf.0) #f)
+(test (zero? +nan.0) #f)
+;; (test (nan? (angle +nan.0)) #t)
+;; but (* 0 (expt 10 310)) -> -nan if not GMP -- is this a bug?
+;;(atanh -inf.0) 0+1.5707963267949i ; different if g++
+;;(test (/ 0 +inf.0 -inf.0) 0.0)
+;;(test (= (expt 1 nan+nani) 1) #t) ; or maybe NaN?
+;;(test (= (expt 1 +nan.0) 1) #t)
+;;(test (= (expt 2 +inf.0) +inf.0) #t)
+;;(test (= (expt +inf.0 -inf.0) 0.0) #t)
+;;(test (= (expt +inf.0 +inf.0) +inf.0) #t)
+;;(test (= (expt +nan.0 0) 1.0) #t) ;hmmm
+;;(test (= (expt +nan.0 +nan.0) 0) #t)
+;;(test (>= 0 +inf.0 -inf.0) #t)
+;;(test (angle (complex 1 +inf.0)) 1.5707963267949)
+;;(test (atanh (complex 1 +inf.0)) -0+1.5707963267949i)
+;;(test (nan? (atan -inf.0 +inf.0)) #t) ; ??
+;;(test (nan? (expt 0 +inf.0)) #t)
+;;(test (nan? (quotient -inf.0 +inf.0)) #t)
+;;(test (nan? (quotient 1 +nan.0)) #t)
+;;(test (nan? (quotient +nan.0 1)) #t)
+;;(test (nan? (quotient +nan.0 +inf.0)) #t)
+;;(test (nan? (quotient +nan.0 +nan.0)) #t)
+;;(test (tan (complex 1 +inf.0)) 0+1i)
+;;(log +nan.0 0) (log 0 +inf.0) (log 0 -inf.0)
+
+(for-each
+ (lambda (x)
+   (test (infinite? x) #f) ; these were errors, but now infinite? is used in signatures
+   (test (nan? x) #f))
+ (list #\a "hi" #f #(1 2) () '(1 . 2) _ht_ _undef_ _null_ _c_obj_ 'hi abs #<eof> #<unspecified>))
+
+(for-each
+ (lambda (n)
+   (test (infinite? n) #f)
+   (test (nan? n) #f))
+ (list 0.0 -0.0 .1 1+i 0-i 1/10))
+
+(for-each
+ (lambda (op)
+   (test (number? (op +inf.0)) #t)
+   (test (number? (op -inf.0)) #t)
+   (test (number? (op +nan.0)) #t))
+ (list magnitude abs exp angle sin cos tan sinh cosh tanh atan sqrt log asinh acosh atanh acos asin
+       real-part imag-part exact->inexact))
+
+(for-each
+ (lambda (op)
+   (test (op +inf.0) 'error)
+   (test (op -inf.0) 'error)
+   (test (op +nan.0) 'error))
+ (list floor ceiling truncate round))
+
+(for-each
+ (lambda (op)
+   (test (number? (op +inf.0 +inf.0)) #t)
+   (test (number? (op +nan.0 -inf.0)) #t))
+ (list + - * / expt complex make-polar))
+
+(for-each
+ (lambda (op)
+   (test (boolean? (op +inf.0)) #t)
+   (test (boolean? (op +nan.0)) #t)
+   (test (op) 'error))
+ (list number? integer? real? complex? rational? zero? positive? negative? inexact? exact?))
+
+(for-each
+ (lambda (op)
+   (test (boolean? (op +inf.0 -inf.0)) #t)
+   (test (boolean? (op +nan.0 -inf.0)) #t))
+ (list  = < > <= >=))
+
+(for-each
+ (lambda (op)
+   (test (op +inf.0) 'error)
+   (test (op +nan.0) 'error))
+ (list even? odd? numerator denominator lcm gcd inexact->exact
+       logior logxor logand lognot logbit? ash integer-length))
+
+(let ((d1 1e-312)
+      (d2 1e-316)
+      (d3 1e-320))
+  (when (not (zero? d3))
+    (unless with-bignums
+      (test (= d1 d2 d3) #f)
+      (test (not (= d2 (* 2 d1))) #t))
+    (test (< d1 d2 d3) #f)
+    (test (> d1 d2 d3) #t)
+    (test (rationalize d1) 0)
+    (test (rationalize d3) 0)
+    (test (rationalize (- d1)) 0)
+    (num-test (string->number (number->string d1)) d1)
+
+    (test (< (sin d3) (sin d2) (sin d1)) #t)
+    (test (< (log d3) (log d2) (log d1)) #t)
+    (test (< (abs d3) (abs d2) (abs d1)) #t)
+    (test (< (sqrt d3) (sqrt d2) (sqrt d1)) #t)
+    (test (<= (exp d3) (exp d2) (exp d3)) #t) ; all might be 1.0
+    ))
+
+
+(define (nan-eqv? x y)
+  (and (nan? x)
+       (nan? y)
+       (= (nan-payload x) (nan-payload y))))
+
+(test (nan-eqv? (nan 123) +nan.123) #t)
+(test (nan? (nan)) #t)
+(test (nan-eqv? (nan) +nan.0) #t)
+(test (nan? (nan 123)) #t)
+(test (nan-payload (nan 123)) 123)
+(test (nan-eqv? (nan 0) +nan.0) #t)
+(test (nan-eqv? +nan.123 +nan.123) #t)
+(test (nan-eqv? -nan.123 +nan.123) #t)
+(test (nan-eqv? -nan.0 +nan.0) #t)
+(test (nan? +nan.123) #t)
+(test (nan? +nan.1.2) 'error)           ;error: unbound variable +nan.1.2 in (+nan.1.2)
+(test +nan.1i 'error)
+(test (nan-payload +nan.123) 123)
+(test (nan 123.1) 'error)               ;error: nan argument, 123.1, is a real but should be an integer
+(test (nan -123) 'error)                ;error: nan argument, (-123), is out of range (it is negative)
+(test (nan-payload 123) 'error)         ;error: nan-payload argument, 123, is an integer but should be a NaN
+(test (nan (+ (ash 1 51) 1)) 'error)    ;error: nan argument, (2251799813685249), is out of range (it is too large) ; somewhat arbitrary, see above
+(test (arity nan) (cons 0 1))
+(test (arity nan-payload) (cons 1 1))
+(test (signature nan) '(real? integer?))
+(test (signature nan-payload) '(integer? real?))
+(test (eval-string "+nan.2i") 'error)   ;error: unbound variable +nan.2i
+(test (eval-string "+nan.0i") 'error)   ;error: unbound variable +nan.0i
+(test (eval-string "+nan.-123") 'error)
+(test (nan? +nan.123+nan.321i) #t) ; don't use (+ +nan.123 (* 0+i +nan.321)) because 0*nan->nan, and then it's up to chance which nan is in the real part!
+(test (nan-payload (real-part +nan.123+nan.321i)) 123)
+(test (nan-payload (imag-part +nan.123+nan.321i)) 321)
+(test (nan? +nan.123+1.0i) #t)
+(test (nan? +nan.0+1.0i) #t)
+(test (nan? 1.0+nan.123i) #t)
+(test (nan? 1.0-nan.123i) #t)
+(test (nan? 1.0+nan.0i) #t)
+(test (nan-payload (imag-part 1.0+nan.123i)) 123)
+(test (nan-payload (imag-part 1.0-nan.123i)) 123) ; prints as 1.0+nan.123i because we don't care about negative NaNs
+(test (nan-payload (imag-part +inf.0+nan.123i)) 123)
+(test (nan-payload (real-part +nan.123-inf.0i)) 123)
+(test (nan? +nan.123+nan.0i) #t)
+(test (nan-payload (real-part +nan.123+nan.0i)) 123)
+(test (nan-payload (imag-part +nan.123+nan.0i)) 0)
+(test (nan? +nan.123-nan.321i) #t)
+(test (nan-payload (real-part +nan.123-nan.321i)) 123)
+(test (nan-payload (imag-part +nan.123-nan.321i)) 321)
+
+(for-each
+ (lambda (arg)
+   (test (nan? arg) #f)
+   (test (nan-payload arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(test (nan 1 2) 'error)
+(test (nan-payload +nan.123 321) 'error)
+(test (nan-payload) 'error)
+
+;;; NaN pass-through tests
+(test (nan-eqv? (magnitude +nan.123+1.0i) +nan.123) #t)
+(test (nan-eqv? (magnitude +nan.123+nan.321i) +nan.123) #t)
+(test (nan-eqv? (magnitude +1.0+nan.321i) +nan.321) #t)
+(test (nan-eqv? (abs +nan.123) +nan.123) #t)
+(test (nan-eqv? (abs -nan.123) +nan.123) #t)
+(test (nan-eqv? (abs +nan.0) +nan.0) #t)
+(test (nan-eqv? (abs -nan.0) +nan.0) #t)
+(test (nan-eqv? (/ +nan.123) +nan.123) #t)
+(test (nan-eqv? (/ 1.5 +nan.123) +nan.123) #t)
+(test (nan-eqv? (/ +nan.123 1.5) +nan.123) #t)
+
+
+;;; --------------------------------------------------------------------------------
+;;; zero?
+;;; --------------------------------------------------------------------------------
+
+(test (zero? 0) #t)
+(test (zero? 0.0) #t)
+(test (zero? 0/1) #t)
+(test (zero? -0) #t)
+(test (zero? -0.0) #t)
+(test (zero? 0.0) #t)
+(test (zero? 1) #f)
+(test (zero? -1) #f)
+(test (zero? -100) #f)
+(test (zero? -0/4) #t)
+(test (zero? 0+0i) #t)
+(test (zero?) 'error)
+(test (zero? "hi") 'error)
+(test (zero? 1.0+23.0i 1.0+23.0i) 'error)
+(test (zero? 0+i) #f)
+(test (zero? 0-0i) #t)
+(test (zero? 0.0-0.0i) #t)
+(test (zero? +0.0) #t)
+(test (zero? 1e-20) #f)
+(test (zero? -1.797693134862315699999999999999999999998E308) #f)
+(test (zero? -2.225073858507201399999999999999999999996E-308) #f)
+(test (zero? 2.2250738585072012e-308) #f) ; gauche says one of these can hang
+(test (zero? 2.2250738585072013e-308) #f)
+(test (zero? 2.2250738585072014e-308) #f)
+(test (zero? 2.2250738585072015e-308) #f)
+(test (zero? 2.2250738585072011e-308) #f)
+(test (zero? 2.2250738585072010e-308) #f)
+(test (zero? 2.2250738585072010e-309) #f)
+(test (zero? 2.2250738585072010e-310) #f)
+(test (zero? -9223372036854775808) #f)
+(test (zero? 1.110223024625156799999999999999999999997E-16) #f)
+(test (zero? 9223372036854775807) #f)
+(test (zero? +inf.0) #f)
+(test (zero? +nan.0) #f)
+(test (zero? pi) #f)
+(test (zero? -1/9223372036854775807) #f)
+(test (zero? 1/2) #f)
+(test (zero? 0-i) #f)
+(test (zero? 0.00001) #f)
+(test (zero? most-negative-fixnum) #f)
+(test (zero? most-positive-fixnum) #f)
+(test (undefined? 18446744073709551616) (not with-bignums))
+(test (zero? (* 0 most-positive-fixnum most-positive-fixnum)) #t)
+(test (zero? (* 0.0 most-positive-fixnum most-positive-fixnum)) #t)
+(test (zero? (* most-positive-fixnum most-negative-fixnum 0)) #t)
+(test (zero? (* most-positive-fixnum most-negative-fixnum 0.0)) #t)
+(test (undefined? 1000000000000000000000000000000000) (not with-bignums))
+(test (zero? 000000000000000000000000000000000) #t)
+
+(when with-bignums
+  (test (zero? (- (expt 2.3 54) (floor (expt 2.3 54)))) #f)
+  (test (zero? 1e-600) #f)
+  (test (zero? 9.92209574402351949043519108941671096176E-1726) #f)
+  (test (zero? 12345678901234567890) #f)
+  (test (zero? 9223372036854775808) #f)
+  (test (zero? 9223372036854775808.1) #f)
+  (test (zero? 9223372036854775808.1+1.5i) #f)
+  (test (zero? 9223372036854775808/3) #f))
+
+(test (zero?) 'error)
+(test (zero? 1 2) 'error)
+(test (zero? 0.@2211) #t)
+(test (zero? 0@0) #t) ; ?? (expt 0 0) -> 1 but 0@0 -> 0.0 because (expt 0.0 0) -> 0.0?
+
+(for-each
+ (lambda (arg)
+   (test (zero? arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; positive?
+;;; --------------------------------------------------------------------------------
+
+(test (positive? 4/3) #t)
+(test (positive? 4) #t)
+(test (positive? -4) #f)
+(test (positive? -4/3) #f)
+(test (positive? 0) #f)
+(test (positive? 0.0) #f)
+(test (positive? -0) #f)
+(test (positive? -0.0) #f)
+(test (positive? 1-0.0i) #t)
+(test (positive? 1.0) #t)
+(test (positive? -1.797693134862315699999999999999999999998E308) #f)
+(test (positive? -2.225073858507201399999999999999999999996E-308) #f)
+(test (positive? -9223372036854775808) #f)
+(test (positive? 1.110223024625156799999999999999999999997E-16) #t)
+(test (positive? 9223372036854775807) #t)
+(test (positive? most-negative-fixnum) #f)
+(test (positive? most-positive-fixnum) #t)
+(test (positive? +inf.0) #t)
+(test (positive? -inf.0) #f)
+(test (positive? +nan.0) #f)
+
+(for-each
+ (lambda (n)
+   (if (not (positive? n))
+       (format #t ";(positive? ~A) -> #f?~%") n))
+ (list 1 123 123456123 1.4 0.001 1/2 124124124.2))
+
+(for-each
+ (lambda (n)
+   (if (positive? n)
+       (format #t ";(positive? ~A) -> #t?~%" n)))
+ (list -1 -123 -123456123 -3/2 -0.00001 -1.4 -123124124.1))
+
+(when with-bignums
+  (test (positive? 1000000000000000000000000000000000) #t)
+  (test (positive? -1000000000000000000000000000000000) #f)
+  (test (positive? 9.92209574402351949043519108941671096176E-1726) #t)
+  (test (positive? 12345678901234567890) #t)
+  (test (positive? -12345678901234567890) #f)
+  (test (positive? 9223372036854775808) #t)
+  (test (positive? 9223372036854775808.1) #t)
+  (test (positive? 9223372036854775808/3) #t)
+  (test (positive? (/ most-positive-fixnum most-negative-fixnum)) #f)
+  (test (positive? 0+92233720368547758081.0i) 'error))
+
+(test (positive? 1.23+1.0i) 'error)
+(test (positive? 1.23 1.23) 'error)
+(test (positive?) 'error)
+(test (positive? 1 2) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (positive? arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; negative?
+;;; --------------------------------------------------------------------------------
+
+(test (negative? 4) #f)
+(test (negative? 4/3) #f)
+(test (negative? -4) #t)
+(test (negative? -4/3) #t)
+(test (negative? -0/4) #f)
+(test (negative? 0) #f)
+(test (negative? -0) #f)
+(test (negative? 0.0) #f)
+(test (negative? -0.0) #f)
+(test (negative? (- 0.0)) #f)
+(test (negative? (expt -0.0 1)) #f)
+(test (negative? (/ -0.0 1.0)) #f)
+(test (negative? (* -0.0 1.0)) #f)
+(test (negative?) 'error)
+(test (negative? 1-0i) #f)
+(test (negative? -1.797693134862315699999999999999999999998E308) #t)
+(test (negative? -2.225073858507201399999999999999999999996E-308) #t)
+(test (negative? -9223372036854775808) #t)
+(test (negative? 1.110223024625156799999999999999999999997E-16) #f)
+(test (negative? 9223372036854775807) #f)
+(test (negative? most-negative-fixnum) #t)
+(test (negative? most-positive-fixnum) #f)
+(test (negative? +inf.0) #f)
+(test (negative? -inf.0) #t)
+(test (negative? +nan.0) #f)
+
+;; (negative? -1/0): #f? (positive? 1/0) is also #f, but (negative? -nan.0): #f (guile agrees) -- so what's the point of -nan.0??
+;;    chibi says (negative? -nan.0) #t, but (positive? +nan.0) #f??
+
+(for-each
+ (lambda (n)
+   (if (negative? n)
+       (format #t ";(negative? ~A) -> #t?~%" n)))
+ (list 1 123 123456123 1.4 0.001 1/2 12341243124.2))
+
+(for-each
+ (lambda (n)
+   (if (not (negative? n))
+       (format #t ";(negative? ~A) -> #f?~%" n)))
+ (list -1 -123 -123456123 -2/3 -0.00001 -1.4 -123124124.1))
+
+(let ((val1 (catch #t (lambda () (negative? 0.0)) (lambda args 'error)))
+      (val2 (catch #t (lambda () (negative? -0.0)) (lambda args 'error))))
+  (test (equal? val1 val2) #t))
+
+(when with-bignums
+  (test (negative? 1000000000000000000000000000000000) #f)
+  (test (negative? -1000000000000000000000000000000000) #t)
+  (test (negative? -9.92209574402351949043519108941671096176E-1726) #t)
+  (test (negative? 12345678901234567890) #f)
+  (test (negative? -12345678901234567890) #t)
+  (test (negative? 9223372036854775808) #f)
+  (test (negative? 9223372036854775808.1) #f)
+  (test (negative? 9223372036854775808/3) #f)
+  (test (negative? 0+92233720368547758081.0i) 'error))
+
+(test (negative? -1-i) 'error)
+(test (negative? 1.23+1.0i) 'error)
+(test (negative? 1.23 1.23) 'error)
+(test (negative?) 'error)
+(test (negative? 1 2) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (negative? arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; odd?
+;;; --------------------------------------------------------------------------------
+
+(test (odd? 3) #t)
+(test (odd? 2) #f)
+(test (odd? -4) #f)
+(test (odd? -1) #t)
+(test (odd? 0) #f)
+(test (odd? -0) #f)
+(test (odd? -9223372036854775808) #f)
+(test (odd? 9223372036854775807) #t)
+(test (odd? most-positive-fixnum) #t)
+(test (odd? most-negative-fixnum) #f)
+(test (odd? -2147483647) #t)
+(test (odd? -2147483648) #f)
+(test (odd? -2147483649) #t)
+(test (odd? 2147483647) #t)
+(test (odd? 2147483648) #f)
+(test (odd? 2147483649) #t)
+
+(for-each
+ (lambda (n)
+   (if (odd? n)
+       (format #t ";(odd? ~A) -> #t?~%" n)))
+ (list 0 2 1234 -4 -10000002 1000000006))
+
+(for-each
+ (lambda (n)
+   (if (not (odd? n))
+       (format #t ";(odd? ~A) -> #f?~%" n)))
+ (list 1 -1 31 50001 543321))
+
+(when with-bignums
+  (test (odd? 12345678901234567891) #t)
+  (test (odd? 12345678901234567890) #f)
+  (test (odd? -1231234567891234567891) #t)
+  (test (odd? -1231234567891234567891) #t)
+  (test (odd? -1239223372036854775808) #f)
+  (test (odd? -9223372036854775808) #f)
+  (test (odd? 1231234567891234567891) #t)
+  (test (odd? 1234567891234567891) #t)
+  (test (odd? 1239223372036854775808) #f)
+  (test (odd? 9223372036854775808) #f)
+  (test (odd? 9223372036854775808/9223372036854775807) 'error)
+  (test (odd? 0+92233720368547758081.0i) 'error))
+
+(test (odd?) 'error)
+(test (odd? 1.23) 'error)
+(test (odd? 1.0) 'error)
+(test (odd? 1+i) 'error)
+(test (odd? 123 123) 'error)
+(test (odd? +inf.0) 'error)
+(test (odd? +nan.0) 'error)
+(test (odd? 1/2) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (odd? arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; even?
+;;; --------------------------------------------------------------------------------
+
+(test (even? 3) #f)
+(test (even? 2) #t)
+(test (even? -4) #t)
+(test (even? -1) #f)
+(test (even? -0) #t)
+(test (even? -9223372036854775808) #t)
+(test (even? 9223372036854775807) #f)
+(test (even? most-positive-fixnum) #f)
+(test (even? most-negative-fixnum) #t)
+(test (even? -2147483647) #f)
+(test (even? -2147483648) #t)
+(test (even? -2147483649) #f)
+(test (even? 2147483647) #f)
+(test (even? 2147483648) #t)
+(test (even? 2147483649) #f)
+
+(for-each
+ (lambda (n)
+   (if (not (even? n))
+       (format #t ";(even? ~A) -> #f?~%" n)))
+ (list 0 2 1234 -4 -10000002 1000000006))
+
+(for-each
+ (lambda (n)
+   (if (even? n)
+       (format #t ";(even? ~A) -> #t?~%" n)))
+ (list 1 -1 31 50001 543321))
+
+(let ((top-exp 60))
+  (let ((happy #t))
+    (do ((i 2 (+ i 1)))
+	((or (not happy) (> i top-exp)))
+      (let* ((val1 (+ 2 (inexact->exact (expt 2 i))))
+	     (val2 (- val1 1))
+	     (ev1 (even? val1))
+	     (ov1 (odd? val1))
+	     (ev2 (even? val2))
+	     (ov2 (odd? val2)))
+	(if (not ev1)
+	    (begin (set! happy #f) (display "not (even? ") (display val1) (display ")?") (newline)))
+	(if ev2
+	    (begin (set! happy #f) (display "(even? ") (display val2) (display ")?") (newline)))
+	(if ov1
+	    (begin (set! happy #f) (display "(odd? ") (display val1) (display ")?") (newline)))
+	(if (not ov2)
+	    (begin (set! happy #f) (display "not (odd? ") (display val2) (display ")?") (newline)))))))
+
+(when with-bignums
+  (test (even? 12345678901234567890) #t)
+  (test (even? 12345678901234567891) #f)
+  (test (even? -1231234567891234567891) #f)
+  (test (even? -1234567891234567891) #f)
+  (test (even? -1239223372036854775808) #t)
+  (test (even? -9223372036854775808) #t)
+  (test (even? 1231234567891234567891) #f)
+  (test (even? 1234567891234567891) #f)
+  (test (even? 1239223372036854775808) #t)
+  (test (even? 9223372036854775808) #t)
+  (test (even? 9223372036854775808/9223372036854775807) 'error)
+  (test (even? 0+92233720368547758081.0i) 'error))
+
+(test (even?) 'error)
+(test (even? 1.23) 'error)
+(test (even? 1.0) 'error)
+(test (even? 123 123) 'error)
+(test (even? 1+i) 'error)
+(test (even? 1+0i) 'error)
+(test (even? +inf.0) 'error)
+(test (even? +nan.0) 'error)
+(test (even? 1/2) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (even? arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; exact?
+;;; --------------------------------------------------------------------------------
+
+(test (exact? 1/0) #f)
+(test (exact? '0/1) #t)
+(test (exact? (/ 1 2)) #t)
+(test (exact? -0) #t)
+(test (exact? -1.797693134862315699999999999999999999998E308) #f)
+(test (exact? -2.225073858507201399999999999999999999996E-308) #f)
+(test (exact? -9223372036854775808) #t)
+(test (exact? 0/0) #f)
+(test (exact? 0/1) #t)
+(test (exact? 1.0) #f)
+(test (exact? 1.110223024625156799999999999999999999997E-16) #f)
+(test (exact? 1.5+0.123i) #f)
+(test (exact? 1/2) #t)
+(test (exact? 3) #t)
+(test (exact? 3.123) #f)
+(test (exact? 9223372036854775807) #t)
+(test (exact? most-positive-fixnum) #t)
+(test (exact? pi) #f)
+(test (exact? +inf.0) #f)
+(test (exact? -inf.0) #f)
+(test (exact? +nan.0) #f)
+(test (exact? (imag-part 1+0i)) #f)
+(test (exact? (imag-part 1+0.0i)) #f)
+(test (exact? (imag-part 1+1i)) #f)
+
+(when with-bignums
+  (test (exact? 12345678901234567890) #t)
+  (test (exact? 9223372036854775808.1) #f)
+  (test (exact? 9223372036854775808) #t)
+  (test (exact? 9223372036854775808/3) #t)
+  (test (exact? 9223372036854775808.1+1.0i) #f))
+
+(test (exact?) 'error)
+(test (exact? "hi") 'error)
+(test (exact? 1.0+23.0i 1.0+23.0i) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (exact? arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; inexact?
+;;; --------------------------------------------------------------------------------
+
+(test (inexact? -1) #f)
+(test (inexact? -1.797693134862315699999999999999999999998E308) #t)
+(test (inexact? -2.225073858507201399999999999999999999996E-308) #t)
+(test (inexact? -9223372036854775808) #f)
+(test (inexact? 1.0) #t)
+(test (inexact? 1.110223024625156799999999999999999999997E-16) #t)
+(test (inexact? 1.5+0.123i) #t)
+(test (inexact? 1/2) #f)
+(test (inexact? 3) #f)
+(test (inexact? 3.123) #t)
+(test (inexact? 9223372036854775807) #f)
+(test (inexact? +inf.0) #t)
+(test (inexact? -inf.0) #t)
+(test (inexact? +nan.0) #t)
+
+(when with-bignums
+  (test (inexact? 12345678901234567890) #f)
+  (test (inexact? 9223372036854775808.1) #t)
+  (test (inexact? 9223372036854775808) #f)
+  (test (inexact? 9223372036854775808/3) #f)
+  (test (inexact? 9223372036854775808.1+1.0i) #t))
+
+(test (inexact? "hi") 'error)
+(test (inexact? 1.0+23.0i 1.0+23.0i) 'error)
+(test (inexact?) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (inexact? arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; exact->inexact
+;;; --------------------------------------------------------------------------------
+
+(num-test (exact->inexact 0+1.5i) 0+1.5i)
+(num-test (exact->inexact 1) 1.0)
+(num-test (exact->inexact 1.0) 1.0)
+(num-test (exact->inexact 3/2) 1.5)
+(num-test (exact->inexact -3/2) -1.5)
+(test (infinite? (exact->inexact +inf.0)) #t)
+(test (nan? (exact->inexact +nan.0)) #t)
+(num-test (exact->inexact most-positive-fixnum) 9.223372036854775807E18)
+(num-test (exact->inexact most-negative-fixnum) -9.223372036854775808E18)
+
+(num-test (exact->inexact 17/12) 1.416666666666666666666666666666666666665E0)
+(num-test (exact->inexact 41/29) 1.413793103448275862068965517241379310344E0)
+(num-test (exact->inexact 99/70) 1.414285714285714285714285714285714285714E0)
+(num-test (exact->inexact 577/408) 1.414215686274509803921568627450980392157E0)
+(num-test (exact->inexact 1393/985) 1.414213197969543147208121827411167512692E0)
+(num-test (exact->inexact 3363/2378) 1.414213624894869638351555929352396972245E0)
+(num-test (exact->inexact 19601/13860) 1.414213564213564213564213564213564213564E0)
+(num-test (exact->inexact 47321/33461) 1.414213562057320462628134245838438779476E0)
+(num-test (exact->inexact 114243/80782) 1.414213562427273402490653858532841474586E0)
+(num-test (exact->inexact 275807/195025) 1.414213562363799512882963722599666709396E0)
+(num-test (exact->inexact 1607521/1136689) 1.414213562372821413772808569450394962913E0)
+(num-test (exact->inexact 3880899/2744210) 1.414213562373141997150363856993451667326E0)
+(num-test (exact->inexact 9369319/6625109) 1.414213562373086993738518113437831739826E0)
+(num-test (exact->inexact 54608393/38613965) 1.414213562373094811682768138418315757008E0)
+(num-test (exact->inexact 131836323/93222358) 1.414213562373095089484863706193743779791E0)
+(num-test (exact->inexact 318281039/225058681) 1.414213562373095041821559418096829599746E0)
+(num-test (exact->inexact 1855077841/1311738121) 1.414213562373095048596212902163571413046E0)
+(num-test (exact->inexact 4478554083/3166815962) 1.414213562373095048836942801793292211529E0)
+
+(num-test (exact->inexact -1.797693134862315699999999999999999999998E308) -1.797693134862315699999999999999999999998E308)
+(num-test (exact->inexact -2.225073858507201399999999999999999999996E-308) -2.225073858507201399999999999999999999996E-308)
+(num-test (exact->inexact -9223372036854775808) -9.223372036854775808E18)
+(num-test (exact->inexact 1.110223024625156799999999999999999999997E-16) 1.110223024625156799999999999999999999997E-16)
+(num-test (exact->inexact 9223372036854775807) 9.223372036854775807E18)
+
+(num-test (exact->inexact 9007199254740991) 9.007199254740991E15)
+(test (= (exact->inexact 9007199254740992) (exact->inexact 9007199254740991)) #f)
+
+(when with-bignums
+  (num-test (truncate (exact->inexact most-positive-fixnum)) 9223372036854775807)
+  (test (= (exact->inexact 9007199254740993) (exact->inexact 9007199254740992)) #f)
+  (num-test (exact->inexact 73786976294838206464) (expt 2.0 66))
+  (num-test (exact->inexact (bignum "0+1.5i")) 0+1.5i)
+  (test (< (abs (- (expt 2 66.5) (exact->inexact 19459393535087060477929284/186481))) 1e-9) #t)
+  (test (< (abs (- (exact->inexact -186198177976134811212136169603791619/103863) (- (expt 2 100.5)))) 1e-9) #t))
+
+(test (exact->inexact "hi") 'error)
+(test (exact->inexact 1.0+23.0i 1.0+23.0i) 'error)
+(test (exact->inexact) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (exact->inexact arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(test (integer? (* 0 1.0)) #f) ; s7.html check -- we want 0.0 here, not 0 [for exact->inexact replacement code]
+(test (rational? (* 1.0 0)) #f)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; inexact->exact
+;;; --------------------------------------------------------------------------------
+
+(num-test (inexact->exact 0.0) 0)
+(num-test (inexact->exact 1) 1)
+(num-test (inexact->exact 1.0) 1)
+(num-test (inexact->exact 1.5) 3/2)
+(test (inexact->exact most-negative-fixnum) most-negative-fixnum)
+
+(num-test (inexact->exact 1.0000000000000000000000000000+0.0000000000000000000000000000i) 1)
+(num-test (inexact->exact 1.0+0.0000000000000000000000000000i) 1)
+(num-test (inexact->exact 1.0000000000000000000000000000+0.0i) 1)
+(num-test (inexact->exact 1.0000000000000000000000000000+0e10i) 1)
+(num-test (inexact->exact 1.0+0.0000000000000000000000000000e10i) 1)
+(num-test (inexact->exact 1.0000000000000000000000000000+0.0e10i) 1)
+(num-test (inexact->exact -2.225073858507201399999999999999999999996E-308) 0)
+(num-test (inexact->exact -9223372036854775808) -9223372036854775808)
+(num-test (inexact->exact 1.110223024625156799999999999999999999997E-16) 0)
+(num-test (inexact->exact 9223372036854775807) 9223372036854775807)
+(num-test (inexact->exact -2305843009213693952/4611686018427387903) -2305843009213693952/4611686018427387903)
+
+;(num-test (inexact->exact 9007199254740995.0) 9007199254740995)
+;this can't work in the non-gmp case -- see s7.c under BIGNUM_PLUS
+
+(if with-bignums
+    (begin
+      (num-test (inexact->exact .1e20) 10000000000000000000)
+      (num-test (inexact->exact 1e19) 10000000000000000000)
+      (num-test (inexact->exact 1e20) 100000000000000000000)
+      (num-test (inexact->exact 9007199254740995.0) 9007199254740995)
+      (num-test (inexact->exact 4611686018427388404.0) 4611686018427388404)
+      (test (inexact->exact (bignum "0+1.5i")) 'error))
+    (begin
+      (test (inexact->exact 1.1e54) 'error)
+      (test (inexact->exact 1.1e564) 'error)
+      (test (inexact->exact .1e20) 'error)
+      (test (inexact->exact 1e19) 'error)
+      (test (inexact->exact 1e20) 'error)))
+
+(test (inexact->exact +inf.0) 'error)
+(test (inexact->exact +nan.0) 'error)
+(test (inexact->exact "hi") 'error)
+(test (inexact->exact 0+1.5i) 'error)
+(test (inexact->exact 1+i) 'error)
+(test (inexact->exact 1.0+23.0i 1.0+23.0i) 'error)
+(test (inexact->exact) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (inexact->exact arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; numerator
+;;; --------------------------------------------------------------------------------
+
+(num-test (numerator (/ 8 -6)) -4)
+(num-test (numerator -1/10) -1)
+(num-test (numerator -1/2) -1)
+(num-test (numerator -10/1) -10)
+(num-test (numerator -10/1234) -5)
+(num-test (numerator -10/3) -10)
+(num-test (numerator -10/500029) -10)
+(num-test (numerator -1234/10) -617)
+(num-test (numerator -1234/2) -617)
+(num-test (numerator -2/1) -2)
+(num-test (numerator -2/1234) -1)
+(num-test (numerator -2/3) -2)
+(num-test (numerator -2/500029) -2)
+(num-test (numerator -2/6) -1)
+(num-test (numerator -3/10) -3)
+(num-test (numerator -3/2) -3)
+(num-test (numerator -500029/10) -500029)
+(num-test (numerator -500029/2) -500029)
+(num-test (numerator 0/1) 0)
+(num-test (numerator 0/10) 0)
+(num-test (numerator 0/1234) 0)
+(num-test (numerator 0/2) 0)
+(num-test (numerator 0/3) 0)
+(num-test (numerator 0/500029) 0)
+(num-test (numerator 1) 1)
+(num-test (numerator 1/1) 1)
+(num-test (numerator 1/1234) 1)
+(num-test (numerator 1/3) 1)
+(num-test (numerator 1/500029) 1)
+(num-test (numerator 10/10) 1)
+(num-test (numerator 10/2) 5)
+(num-test (numerator 12/6000996) 1)
+(num-test (numerator 1234/1) 1234)
+(num-test (numerator 1234/3) 1234)
+(num-test (numerator 1234/500029) 1234)
+(num-test (numerator 2/10) 1)
+(num-test (numerator 2/2) 1)
+(num-test (numerator 2/3) 2)
+(num-test (numerator 2/4) 1)
+(num-test (numerator 3/1) 3)
+(num-test (numerator 3/1234) 3)
+(num-test (numerator 3/3) 1)
+(num-test (numerator 3/500029) 3)
+(num-test (numerator 5/2) 5)
+(num-test (numerator 500029/1) 500029)
+(num-test (numerator 500029/1234) 500029)
+(num-test (numerator 500029/3) 500029)
+(num-test (numerator 500029/500029) 1)
+(num-test (numerator -9223372036854775808) -9223372036854775808)
+(num-test (numerator 9223372036854775807) 9223372036854775807)
+(num-test (numerator (/ 2 -1)) -2)
+(num-test (numerator (/ most-positive-fixnum 2)) most-positive-fixnum)
+(num-test (numerator (/ most-negative-fixnum 3)) most-negative-fixnum)
+(num-test (numerator (/ most-negative-fixnum most-positive-fixnum)) most-negative-fixnum)
+
+(when with-bignums
+  (num-test (numerator 1195068768795265792518361315725116351898245581/48889032896862784894921) 24444516448431392447461)
+  (num-test (numerator 24444516448431392447461/1195068768795265792518361315725116351898245581) 1)
+  (num-test (numerator -46116860184273879035/27670116110564327424) -46116860184273879035)
+  (num-test (numerator (/ 9223372036854775808 -9223372036854775807)) -9223372036854775808)
+  (num-test (numerator 1234567891234567890/1234567) 1234567891234567890)
+  (num-test (numerator 9223372036854775808/9223372036854775807) 9223372036854775808)
+  (test (numerator 0+92233720368547758081.0i) 'error))
+
+(test (numerator 0.0) 'error) ; guile thinks this is ok
+(test (numerator 1.23 1.23) 'error)
+(test (numerator 1.23+1.0i) 'error)
+(test (numerator) 'error)
+(test (numerator +inf.0) 'error)
+(test (numerator +nan.0) 'error)
+(test (numerator "hi") 'error)
+(test (numerator 1+i) 'error)
+(test (numerator 2.3+0.5i) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (numerator arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; denominator
+;;; --------------------------------------------------------------------------------
+
+(num-test (denominator (/ 8 -6)) 3)
+(num-test (denominator -1/10) 10)
+(num-test (denominator -1/2) 2)
+(num-test (denominator -10/1) 1)
+(num-test (denominator -10/1234) 617)
+(num-test (denominator -10/3) 3)
+(num-test (denominator -10/500029) 500029)
+(num-test (denominator -1234/10) 5)
+(num-test (denominator -1234/2) 1)
+(num-test (denominator -2/1) 1)
+(num-test (denominator -2/1234) 617)
+(num-test (denominator -2/3) 3)
+(num-test (denominator -2/500029) 500029)
+(num-test (denominator -2/6) 3)
+(num-test (denominator -3/10) 10)
+(num-test (denominator -3/2) 2)
+(num-test (denominator -500029/10) 10)
+(num-test (denominator -500029/2) 2)
+(num-test (denominator 0) 1)
+(num-test (denominator 0/1) 1)
+(num-test (denominator 0/10) 1)
+(num-test (denominator 0/1234) 1)
+(num-test (denominator 0/2) 1)
+(num-test (denominator 0/3) 1)
+(num-test (denominator 0/500029) 1)
+(num-test (denominator 1) 1)
+(num-test (denominator 1/1) 1)
+(num-test (denominator 1/1234) 1234)
+(num-test (denominator 1/3) 3)
+(num-test (denominator 1/500029) 500029)
+(num-test (denominator 10/10) 1)
+(num-test (denominator 10/2) 1)
+(num-test (denominator 12/6000996) 500083)
+(num-test (denominator 1234/1) 1)
+(num-test (denominator 1234/3) 3)
+(num-test (denominator 1234/500029) 500029)
+(num-test (denominator 2/10) 5)
+(num-test (denominator 2/2) 1)
+(num-test (denominator 2/3) 3)
+(num-test (denominator 2/4) 2)
+(num-test (denominator 3/1) 1)
+(num-test (denominator 3/1234) 1234)
+(num-test (denominator 3/3) 1)
+(num-test (denominator 3/500029) 500029)
+(num-test (denominator 5/2) 2)
+(num-test (denominator 500029/1) 1)
+(num-test (denominator 500029/1234) 1234)
+(num-test (denominator 500029/3) 3)
+(num-test (denominator 500029/500029) 1)
+(num-test (denominator -9223372036854775808) 1)
+(num-test (denominator 9223372036854775807) 1)
+(num-test (denominator (/ 2 -1)) 1)
+(num-test (denominator (/ 1 most-positive-fixnum)) most-positive-fixnum)
+(num-test (denominator (/ most-negative-fixnum most-positive-fixnum)) most-positive-fixnum)
+
+(when with-bignums
+  (num-test (denominator 1195068768795265792518361315725116351898245581/48889032896862784894921) 1)
+  (num-test (denominator 24444516448431392447461/1195068768795265792518361315725116351898245581) 48889032896862784894921)
+  (num-test (denominator -46116860184273879035/27670116110564327424) 27670116110564327424)
+  (num-test (denominator (/ 9223372036854775808 -9223372036854775807)) 9223372036854775807)
+  (num-test (denominator 1234567891234567890/1234567) 1234567)
+  (num-test (denominator 9223372036854775808/9223372036854775807) 9223372036854775807)
+  (test (denominator 0+92233720368547758081.0i) 'error))
+
+(test (denominator 0.0) 'error)
+(test (denominator 1.23 1.23) 'error)
+(test (denominator 1.23+1.0i) 'error)
+(test (denominator) 'error)
+(test (denominator +inf.0) 'error)
+(test (denominator +nan.0) 'error)
+(test (denominator "hi") 'error)
+(test (denominator 1+i) 'error)
+(test (denominator 2.3+0.5i) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (denominator arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; real-part
+;;; --------------------------------------------------------------------------------
+
+(num-test (real-part -0.0+0.00000001i) 0.0)
+(num-test (real-part -0.0+1234.0i) 0.0)
+(num-test (real-part -0.0-3.14159265358979i) 0.0)
+(num-test (real-part -0.00000001+1.0i) -0.00000001)
+(num-test (real-part -0.00000001-0.0i) -0.00000001)
+(num-test (real-part -1.0+3.14159265358979i) -1.0)
+(num-test (real-part -1.0-0.00000001i) -1.0)
+(num-test (real-part -1.0-1234.0i) -1.0)
+(num-test (real-part -1234.0+1.0i) -1234.0)
+(num-test (real-part -1234.0-0.0i) -1234.0)
+(num-test (real-part -3.14159265358979+0.0i) -3.14159265358979)
+(num-test (real-part -3.14159265358979-1.0i) -3.14159265358979)
+(num-test (real-part 0.0+0.0i) 0.0)
+(num-test (real-part 0.0-1.0i) 0.0)
+(num-test (real-part 0.00000001+0.00000001i) 0.00000001)
+(num-test (real-part 0.00000001+1234.0i) 0.00000001)
+(num-test (real-part 0.00000001-3.14159265358979i) 0.00000001)
+(num-test (real-part 1) 1)
+(num-test (real-part 1.0+1.0i) 1.0)
+(num-test (real-part 1.0-0.0i) 1.0)
+(num-test (real-part 1.4+0.0i) 1.4)
+(num-test (real-part 1234.0+0.00000001i) 1234.0)
+(num-test (real-part 1234.0+1234.0i) 1234.0)
+(num-test (real-part 1234.0-3.14159265358979i) 1234.0)
+(num-test (real-part 2.0) 2.0)
+(num-test (real-part 2/3) 2/3)
+(num-test (real-part 3.14159265358979+3.14159265358979i) 3.14159265358979)
+(num-test (real-part 3.14159265358979-0.00000001i) 3.14159265358979)
+(num-test (real-part 3.14159265358979-1234.0i) 3.14159265358979)
+(num-test (real-part 3/4+1/2i) 0.75)
+(num-test (real-part 5) 5)
+(num-test (real-part -1.797693134862315699999999999999999999998E308) -1.797693134862315699999999999999999999998E308)
+(num-test (real-part -2.225073858507201399999999999999999999996E-308) -2.225073858507201399999999999999999999996E-308)
+(num-test (real-part -9223372036854775808) -9223372036854775808)
+(num-test (real-part 1.110223024625156799999999999999999999997E-16) 1.110223024625156799999999999999999999997E-16)
+(num-test (real-part 9223372036854775807) 9223372036854775807)
+(test (real-part +inf.0) +inf.0)
+(num-test (real-part (+ 2 0+1/0i)) 2)
+
+(when with-bignums
+  (num-test (real-part 0+1e400i) 0.0)
+  (num-test (real-part 0+9223372036854775808.0i) 0.0)
+  (num-test (real-part 1.5+9223372036854775808.0i) 1.5)
+  (num-test (real-part 9223372036854775808.0) 9223372036854775808.0)
+  (num-test (real-part 9223372036854775808.0+1.5i) 9.223372036854775808E18))
+
+(test (denominator (real-part 3/4+1/2i)) 'error)
+(num-test (denominator (real-part 01/100)) 100)
+(test (real-part "hi") 'error)
+(test (real-part 1.0+23.0i 1.0+23.0i) 'error)
+(test (real-part) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (real-part arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; imag-part
+;;; --------------------------------------------------------------------------------
+
+(num-test (imag-part -0.0+0.00000001i) 0.00000001)
+(num-test (imag-part -0.0+1234.0i) 1234.0)
+(num-test (imag-part -0.0-3.14159265358979i) -3.14159265358979)
+(num-test (imag-part -0.00000001+1.0i) 1.0)
+(num-test (imag-part -0.00000001-0.0i) 0.0)
+(num-test (imag-part -1.0+3.14159265358979i) 3.14159265358979)
+(num-test (imag-part -1.0-0.00000001i) -0.00000001)
+(num-test (imag-part -1.0-1234.0i) -1234.0)
+(num-test (imag-part -1234.0+1.0i) 1.0)
+(num-test (imag-part -1234.0-0.0i) 0.0)
+(num-test (imag-part -2.0) 0.0)
+(num-test (imag-part -3.14159265358979+0.0i) 0.0)
+(num-test (imag-part -3.14159265358979-1.0i) -1.0)
+(num-test (imag-part 0+i) 1.0)
+(num-test (imag-part 0.0+0.0i) 0.0)
+(num-test (imag-part 0.0-1.0i) -1.0)
+(num-test (imag-part 0.00000001+0.00000001i) 0.00000001)
+(num-test (imag-part 0.00000001+1234.0i) 1234.0)
+(num-test (imag-part 0.00000001-3.14159265358979i) -3.14159265358979)
+(num-test (imag-part 1) 0.0)
+(num-test (imag-part 1+i) 1.0)
+(num-test (imag-part 1-i) -1.0)
+(num-test (imag-part 1.0+1.0i) 1.0)
+(num-test (imag-part 1.0-0.0i) 0.0)
+(num-test (imag-part 1.4+0.0i) 0.0)
+(num-test (imag-part 1234.0+0.00000001i) 0.00000001)
+(num-test (imag-part 1234.0+1234.0i) 1234.0)
+(num-test (imag-part 1234.0-3.14159265358979i) -3.14159265358979)
+(num-test (imag-part 2/3) 0.0)
+(num-test (imag-part 3.14159265358979+3.14159265358979i) 3.14159265358979)
+(num-test (imag-part 3.14159265358979-0.00000001i) -0.00000001)
+(num-test (imag-part 3.14159265358979-1234.0i) -1234.0)
+(num-test (imag-part 5) 0.0)
+(num-test (imag-part -1.797693134862315699999999999999999999998E308) 0.0)
+(num-test (imag-part -2.225073858507201399999999999999999999996E-308) 0.0)
+(num-test (imag-part -9223372036854775808) 0)
+(num-test (imag-part 1.110223024625156799999999999999999999997E-16) 0.0)
+(num-test (imag-part 9223372036854775807) 0)
+(if (not with-bignums) (test (nan? (imag-part (+ 2 0+1/0i))) #t))
+(num-test (imag-part 0/0+0i) 0.0)
+(num-test (imag-part 1/0) 0.0)
+;(num-test (imag-part (log 1/0)) pi) ; hmmm -- I could imagine other choices here and below
+;(num-test (imag-part (sqrt 1/0)) 0.0)
+;(test (nan? (imag-part (sqrt (log 1/0)))) #t)
+
+(when with-bignums
+  (num-test (imag-part 0+1e400i) 1e400)
+  (num-test (imag-part 0+9223372036854775808.0i) 9223372036854775808.0)
+  (num-test (imag-part 1.5+9223372036854775808.0i) 9.223372036854775808E18)
+  (num-test (imag-part 9223372036854775808.0) 0)
+  (num-test (imag-part 9223372036854775808.0+1.5i) 1.5))
+
+(test (imag-part "hi") 'error)
+(test (imag-part 1.0+23.0i 1.0+23.0i) 'error)
+(test (imag-part) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (imag-part arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; complex
+;;; --------------------------------------------------------------------------------
+
+(num-test (complex -0 -1) -0.0-1.0i)
+(num-test (complex -0 -10) -0.0-10.0i)
+(num-test (complex -0 -1234) -0.0-1234.0i)
+(num-test (complex -0 -2) -0.0-2.0i)
+(num-test (complex -0 -3) -0.0-3.0i)
+(num-test (complex -0 -500029) -0.0-500029.0i)
+(num-test (complex -0 1) -0.0+1.0i)
+(num-test (complex -0 10) -0.0+10.0i)
+(num-test (complex -0 1234) -0.0+1234.0i)
+(num-test (complex -0 2) -0.0+2.0i)
+(num-test (complex -0 3) -0.0+3.0i)
+(num-test (complex -0 500029) -0.0+500029.0i)
+(num-test (complex -0.0 -0.00000001) -0.0-0.00000001i)
+(num-test (complex -0.0 -1.0) -0.0-1.0i)
+(num-test (complex -0.0 -1234.0) -0.0-1234.0i)
+(num-test (complex -0.0 -3.14159265358979) -0.0-3.14159265358979i)
+(num-test (complex -0.0 0.00000001) -0.0+0.00000001i)
+(num-test (complex -0.0 1.0) -0.0+1.0i)
+(num-test (complex -0.0 1234.0) -0.0+1234.0i)
+(num-test (complex -0.0 pi) -0.0+3.14159265358979i)
+(num-test (complex -0.00000001 -0.00000001) -0.00000001-0.00000001i)
+(num-test (complex -0.00000001 -1.0) -0.00000001-1.0i)
+(num-test (complex -0.00000001 -1234.0) -0.00000001-1234.0i)
+(num-test (complex -0.00000001 -3.14159265358979) -0.00000001-3.14159265358979i)
+(num-test (complex -0.00000001 0.00000001) -0.00000001+0.00000001i)
+(num-test (complex -0.00000001 1.0) -0.00000001+1.0i)
+(num-test (complex -0.00000001 1234.0) -0.00000001+1234.0i)
+(num-test (complex -0.00000001 pi) -0.00000001+3.14159265358979i)
+(num-test (complex -1 -1) -1.0-1.0i)
+(num-test (complex -1 -10) -1.0-10.0i)
+(num-test (complex -1 -1234) -1.0-1234.0i)
+(num-test (complex -1 -2) -1.0-2.0i)
+(num-test (complex -1 -3) -1.0-3.0i)
+(num-test (complex -1 -500029) -1.0-500029.0i)
+(num-test (complex -1 1) -1.0+1.0i)
+(num-test (complex -1 10) -1.0+10.0i)
+(num-test (complex -1 1234) -1.0+1234.0i)
+(num-test (complex -1 2) -1.0+2.0i)
+(num-test (complex -1 3) -1.0+3.0i)
+(num-test (complex -1 500029) -1.0+500029.0i)
+(num-test (complex -1.0 -0.00000001) -1.0-0.00000001i)
+(num-test (complex -1.0 -1.0) -1.0-1.0i)
+(num-test (complex -1.0 -1234.0) -1.0-1234.0i)
+(num-test (complex -1.0 -3.14159265358979) -1.0-3.14159265358979i)
+(num-test (complex -1.0 0.00000001) -1.0+0.00000001i)
+(num-test (complex -1.0 1.0) -1.0+1.0i)
+(num-test (complex -1.0 1234.0) -1.0+1234.0i)
+(num-test (complex -1.0 pi) -1.0+3.14159265358979i)
+(num-test (complex -2 -1) -2.0-1.0i)
+(num-test (complex -2 -10) -2.0-10.0i)
+(num-test (complex -2 -1234) -2.0-1234.0i)
+(num-test (complex -2 -2) -2.0-2.0i)
+(num-test (complex -2 -3) -2.0-3.0i)
+(num-test (complex -2 -500029) -2.0-500029.0i)
+(num-test (complex -2 1) -2.0+1.0i)
+(num-test (complex -2 10) -2.0+10.0i)
+(num-test (complex -2 1234) -2.0+1234.0i)
+(num-test (complex -2 2) -2.0+2.0i)
+(num-test (complex -2 3) -2.0+3.0i)
+(num-test (complex -2 500029) -2.0+500029.0i)
+(num-test (complex 0 -1) 0.0-1.0i)
+(num-test (complex 0 -10) 0.0-10.0i)
+(num-test (complex 0 -1234) 0.0-1234.0i)
+(num-test (complex 0 -2) 0.0-2.0i)
+(num-test (complex 0 -3) 0.0-3.0i)
+(num-test (complex 0 -500029) 0.0-500029.0i)
+(num-test (complex 0 0) 0)
+(num-test (complex 0 1) 0.0+1.0i)
+(num-test (complex 0 10) 0.0+10.0i)
+(num-test (complex 0 1234) 0.0+1234.0i)
+(num-test (complex 0 2) 0.0+2.0i)
+(num-test (complex 0 3) 0.0+3.0i)
+(num-test (complex 0 500029) 0.0+500029.0i)
+(num-test (complex 0.0 -0.00000001) 0.0-0.00000001i)
+(num-test (complex 0.0 -1.0) 0.0-1.0i)
+(num-test (complex 0.0 -1234.0) 0.0-1234.0i)
+(num-test (complex 0.0 -3.14159265358979) 0.0-3.14159265358979i)
+(num-test (complex 0.0 0.0) 0.0)
+(num-test (complex 0.0 0.00000001) 0.0+0.00000001i)
+(num-test (complex 0.0 1.0) 0.0+1.0i)
+(num-test (complex 0.0 1234.0) 0.0+1234.0i)
+(num-test (complex 0.0 pi) 0.0+3.14159265358979i)
+(num-test (complex 0.00000001 -0.00000001) 0.00000001-0.00000001i)
+(num-test (complex 0.00000001 -1.0) 0.00000001-1.0i)
+(num-test (complex 0.00000001 -1234.0) 0.00000001-1234.0i)
+(num-test (complex 0.00000001 -3.14159265358979) 0.00000001-3.14159265358979i)
+(num-test (complex 0.00000001 0.00000001) 0.00000001+0.00000001i)
+(num-test (complex 0.00000001 1.0) 0.00000001+1.0i)
+(num-test (complex 0.00000001 1234.0) 0.00000001+1234.0i)
+(num-test (complex 0.00000001 pi) 0.00000001+3.14159265358979i)
+(num-test (complex 1 -1) 1.0-1.0i)
+(num-test (complex 1 -10) 1.0-10.0i)
+(num-test (complex 1 -1234) 1.0-1234.0i)
+(num-test (complex 1 -2) 1.0-2.0i)
+(num-test (complex 1 -3) 1.0-3.0i)
+(num-test (complex 1 -500029) 1.0-500029.0i)
+(num-test (complex 1 1) 1.0+1.0i)
+(num-test (complex 1 10) 1.0+10.0i)
+(num-test (complex 1 1234) 1.0+1234.0i)
+(num-test (complex 1 2) 1.0+2.0i)
+(num-test (complex 1 3) 1.0+3.0i)
+(num-test (complex 1 500029) 1.0+500029.0i)
+(num-test (complex 1.0 -0.00000001) 1.0-0.00000001i)
+(num-test (complex 1.0 -1.0) 1.0-1.0i)
+(num-test (complex 1.0 -1234.0) 1.0-1234.0i)
+(num-test (complex 1.0 -3.14159265358979) 1.0-3.14159265358979i)
+(num-test (complex 1.0 0.00000001) 1.0+0.00000001i)
+(num-test (complex 1.0 1.0) 1.0+1.0i)
+(num-test (complex 1.0 1234.0) 1.0+1234.0i)
+(num-test (complex 1.0 pi) 1.0+3.14159265358979i)
+(num-test (complex 2 -1) 2.0-1.0i)
+(num-test (complex 2 -10) 2.0-10.0i)
+(num-test (complex 2 -1234) 2.0-1234.0i)
+(num-test (complex 2 -2) 2.0-2.0i)
+(num-test (complex 2 -3) 2.0-3.0i)
+(num-test (complex 2 -500029) 2.0-500029.0i)
+(num-test (complex 2 1) 2.0+1.0i)
+(num-test (complex 2 10) 2.0+10.0i)
+(num-test (complex 2 1234) 2.0+1234.0i)
+(num-test (complex 2 2) 2.0+2.0i)
+(num-test (complex 2 3) 2.0+3.0i)
+(num-test (complex 2 500029) 2.0+500029.0i)
+(num-test (complex 1/2 0) 1/2)
+(num-test (complex 1/2 1/2) 0.5+0.5i)
+(num-test (complex 0 1/2) 0+0.5i)
+
+(test (nan? (complex +nan.0 +nan.0)) #t)
+(test (nan? (complex +nan.0 +inf.0)) #t)
+
+(when with-bignums
+  (test (nan? (complex (bignum "0/0") 0)) #t)
+  (test (nan? (complex 0 (bignum "0/0"))) #t)
+  (num-test (complex 0 (* 2 most-positive-fixnum)) 0.0+1.8446744073709551614E19i)
+  (num-test (- (complex 2e20 (* 2 most-positive-fixnum)) 0+1.8446744073709551614E19i) 2e20)
+  (num-test (imag-part (complex 1.0 1180591620717411303424/717897987691852588770249)) 1.644511672909387396372163624382128338027E-3)
+  (test (complex 0.0 0+92233720368547758081.0i) 'error))
+
+(test (complex 0 0+0/0i) 'error)
+(test (complex 0+0/0i 0) 'error)
+(test (complex 1.23 1.23 1.23) 'error)
+(test (complex 1.23) 'error)
+(test (complex 1.23+1.0i 1.23+1.0i) 'error)
+(test (complex) 'error)
+(test (complex 1.0 1.0+0.1i) 'error)
+(test (complex 1.0+0.1i 1.0) 'error)
+(for-each
+ (lambda (x)
+   (test (complex x 0-i) 'error))
+ (list 0 1 1/2 1.0 0.0 0+i))
+(for-each
+ (lambda (x)
+   (test (complex 0-i x) 'error))
+ (list 0 1 pi (- pi) 1/2 0.0 1.0 0+i))
+
+(test (equivalent? (complex 1.0 1/2) 1+0.5i) #t)
+
+(for-each
+ (lambda (arg)
+   (test (complex arg 0.0) 'error)
+   (test (complex 0.0 arg) 'error)
+   (test (complex arg +nan.0) 'error)
+   (test (complex +nan.0 arg) 'error)
+   (test (complex arg +inf.0) 'error)
+   (test (complex +inf.0 arg) 'error)
+   (test (complex 1 arg) 'error)
+   (test (complex 1/2 arg) 'error)
+   (test (complex 1+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; make-polar
+;;; --------------------------------------------------------------------------------
+
+(num-test (make-polar -0 -1) 0)
+(num-test (make-polar -0 -10) 0)
+(num-test (make-polar -0 -1234) 0)
+(num-test (make-polar -0 -2) 0)
+(num-test (make-polar -0 -3) 0)
+(num-test (make-polar -0 -500029) 0)
+(num-test (make-polar -0 1) 0)
+(num-test (make-polar -0 10) 0)
+(num-test (make-polar -0 1234) 0)
+(num-test (make-polar -0 2) 0)
+(num-test (make-polar -0 3) 0)
+(num-test (make-polar -0 500029) 0)
+(num-test (make-polar -0.0 -0.00000001) 0.0)
+(num-test (make-polar -0.0 -1.0) 0.0)
+(num-test (make-polar -0.0 -1234.0) 0.0)
+(num-test (make-polar -0.0 -3.14159265358979) 0.0)
+(num-test (make-polar -0.0 0.00000001) 0.0)
+(num-test (make-polar -0.0 1.0) 0.0)
+(num-test (make-polar -0.0 1234.0) 0.0)
+(num-test (make-polar -0.0 pi) 0.0)
+(num-test (make-polar -0.00000001 -0.00000001) -0.00000001+1e-16i)
+(num-test (make-polar -0.00000001 -1.0) -0.00000000540302+0.00000000841471i)
+(num-test (make-polar -0.00000001 -1234.0) 0.00000000798551+0.00000000601928i)
+(num-test (make-polar -0.00000001 (- pi)) 0.00000001)
+(num-test (make-polar -0.00000001 0.00000001) -0.00000001-1e-16i)
+(num-test (make-polar -0.00000001 1.0) -0.00000000540302-0.00000000841471i)
+(num-test (make-polar -0.00000001 1234.0) 0.00000000798551-0.00000000601928i)
+(num-test (make-polar -0.00000001 pi) 0.00000001-0.0i)
+(num-test (make-polar -1 -1) -0.54030230586814+0.84147098480790i)
+(num-test (make-polar -1 -10) 0.83907152907645-0.54402111088937i)
+(num-test (make-polar -1 -1234) 0.79855062358758+0.60192765476250i)
+(num-test (make-polar -1 -2) 0.41614683654714+0.90929742682568i)
+(num-test (make-polar -1 -3) 0.98999249660045+0.14112000805987i)
+(num-test (make-polar -1 -500029) -0.85414905629947+0.52002825848479i)
+(num-test (make-polar -1 1) -0.54030230586814-0.84147098480790i)
+(num-test (make-polar -1 10) 0.83907152907645+0.54402111088937i)
+(num-test (make-polar -1 1234) 0.79855062358758-0.60192765476250i)
+(num-test (make-polar -1 2) 0.41614683654714-0.90929742682568i)
+(num-test (make-polar -1 3) 0.98999249660045-0.14112000805987i)
+(num-test (make-polar -1 500029) -0.85414905629947-0.52002825848479i)
+(num-test (make-polar -1.0 -0.00000001) -1.0+0.00000001i)
+(num-test (make-polar -1.0 -1.0) -0.54030230586814+0.84147098480790i)
+(num-test (make-polar -1.0 -1234.0) 0.79855062358758+0.60192765476250i)
+(num-test (make-polar -1.0 (- pi)) 1.0)
+(num-test (make-polar -1.0 0.00000001) -1.0-0.00000001i)
+(num-test (make-polar -1.0 1.0) -0.54030230586814-0.84147098480790i)
+(num-test (make-polar -1.0 1234.0) 0.79855062358758-0.60192765476250i)
+(num-test (make-polar -1.0 pi) 1.0-0.0i)
+(num-test (make-polar -1234 -1) -666.73304544128450+1038.37519525294420i)
+(num-test (make-polar -1234 -10) 1035.41426688034221-671.32205083748227i)
+(num-test (make-polar -1234 -1234) 985.41146950707912+742.77872597692169i)
+(num-test (make-polar -1234 -2) 513.52519629917379+1122.07302470289119i)
+(num-test (make-polar -1234 -3) 1221.65074080494969+174.14208994587614i)
+(num-test (make-polar -1234 -500029) -1054.01993547355005+641.71487097022577i)
+(num-test (make-polar -1234 1) -666.73304544128450-1038.37519525294420i)
+(num-test (make-polar -1234 10) 1035.41426688034221+671.32205083748227i)
+(num-test (make-polar -1234 1234) 985.41146950707912-742.77872597692169i)
+(num-test (make-polar -1234 2) 513.52519629917379-1122.07302470289119i)
+(num-test (make-polar -1234 3) 1221.65074080494969-174.14208994587614i)
+(num-test (make-polar -1234 500029) -1054.01993547355005-641.71487097022577i)
+(num-test (make-polar -1234.0 -1.0) -666.73304544128450+1038.37519525294420i)
+(num-test (make-polar -1234.0 -1234.0) 985.41146950707912+742.77872597692169i)
+(num-test (make-polar -1234.0 (- pi)) 1234.0+0.00000000000015i)
+(num-test (make-polar -1234.0 1.0) -666.73304544128450-1038.37519525294420i)
+(num-test (make-polar -1234.0 1234.0) 985.41146950707912-742.77872597692169i)
+(num-test (make-polar -1234.0 pi) 1234.0-0.00000000000015i)
+(num-test (make-polar -2 -1) -1.08060461173628+1.68294196961579i)
+(num-test (make-polar -2 -10) 1.67814305815290-1.08804222177874i)
+(num-test (make-polar -2 -1234) 1.59710124717517+1.20385530952499i)
+(num-test (make-polar -2 -2) 0.83229367309428+1.81859485365136i)
+(num-test (make-polar -2 -3) 1.97998499320089+0.28224001611973i)
+(num-test (make-polar -2 -500029) -1.70829811259895+1.04005651696957i)
+(num-test (make-polar -2 1) -1.08060461173628-1.68294196961579i)
+(num-test (make-polar -2 10) 1.67814305815290+1.08804222177874i)
+(num-test (make-polar -2 1234) 1.59710124717517-1.20385530952499i)
+(num-test (make-polar -2 2) 0.83229367309428-1.81859485365136i)
+(num-test (make-polar -2 3) 1.97998499320089-0.28224001611973i)
+(num-test (make-polar -2 500029) -1.70829811259895-1.04005651696957i)
+(num-test (make-polar 0 -1) 0)
+(num-test (make-polar 0 -10) 0)
+(num-test (make-polar 0 -1234) 0)
+(num-test (make-polar 0 -2) 0)
+(num-test (make-polar 0 -3) 0)
+(num-test (make-polar 0 -500029) 0)
+(num-test (make-polar 0 0) 0)
+(num-test (make-polar 0 1) 0)
+(num-test (make-polar 0 10) 0)
+(num-test (make-polar 0 1234) 0)
+(num-test (make-polar 0 2) 0)
+(num-test (make-polar 0 3) 0)
+(num-test (make-polar 0 500029) 0)
+(num-test (make-polar 0 922337203685477) 0)
+(num-test (make-polar 0 1/922337203685477) 0)
+(num-test (make-polar 0.0 -0.00000001) 0.0)
+(num-test (make-polar 0.0 -1.0) 0.0)
+(num-test (make-polar 0.0 -1234.0) 0.0)
+(num-test (make-polar 0.0 -3.14159265358979) 0.0)
+(num-test (make-polar 0.0 0.0) 0.0)
+(num-test (make-polar 0.0 0.00000001) 0.0)
+(num-test (make-polar 0.0 1.0) 0.0)
+(num-test (make-polar 0.0 1234.0) 0.0)
+(num-test (make-polar 0.0 pi) 0.0)
+(num-test (make-polar 0.00000001 -0.00000001) 0.00000001-1e-16i)
+(num-test (make-polar 0.00000001 -1.0) 0.00000000540302-0.00000000841471i)
+(num-test (make-polar 0.00000001 -1234.0) -0.00000000798551-0.00000000601928i)
+(num-test (make-polar 0.00000001 -3.14159265358979) -0.00000001-0.0i)
+(num-test (make-polar 0.00000001 0.00000001) 0.00000001+1e-16i)
+(num-test (make-polar 0.00000001 1.0) 0.00000000540302+0.00000000841471i)
+(num-test (make-polar 0.00000001 1234.0) -0.00000000798551+0.00000000601928i)
+(num-test (make-polar 0.00000001 pi) -0.00000001)
+(num-test (make-polar 1 -1) 0.54030230586814-0.84147098480790i)
+(num-test (make-polar 1 -10) -0.83907152907645+0.54402111088937i)
+(num-test (make-polar 1 -1234) -0.79855062358758-0.60192765476250i)
+(num-test (make-polar 1 -2) -0.41614683654714-0.90929742682568i)
+(num-test (make-polar 1 -3) -0.98999249660045-0.14112000805987i)
+(num-test (make-polar 1 -500029) 0.85414905629947-0.52002825848479i)
+(num-test (make-polar 1 1) 0.54030230586814+0.84147098480790i)
+(num-test (make-polar 1 10) -0.83907152907645-0.54402111088937i)
+(num-test (make-polar 1 1234) -0.79855062358758+0.60192765476250i)
+(num-test (make-polar 1 2) -0.41614683654714+0.90929742682568i)
+(num-test (make-polar 1 3) -0.98999249660045+0.14112000805987i)
+(num-test (make-polar 1 500029) 0.85414905629947+0.52002825848479i)
+(num-test (make-polar 1.0 -0.00000001) 1.0-0.00000001i)
+(num-test (make-polar 1.0 -1.0) 0.54030230586814-0.84147098480790i)
+(num-test (make-polar 1.0 -1234.0) -0.79855062358758-0.60192765476250i)
+(num-test (make-polar 1.0 -3.14159265358979) -1.0-0.0i)
+(num-test (make-polar 1.0 0.00000001) 1.0+0.00000001i)
+(num-test (make-polar 1.0 1.0) 0.54030230586814+0.84147098480790i)
+(num-test (make-polar 1.0 1234.0) -0.79855062358758+0.60192765476250i)
+(num-test (make-polar 1.0 pi) -1.0)
+(num-test (make-polar 1234 -1) 666.73304544128450-1038.37519525294420i)
+(num-test (make-polar 1234 -10) -1035.41426688034221+671.32205083748227i)
+(num-test (make-polar 1234 -1234) -985.41146950707912-742.77872597692169i)
+(num-test (make-polar 1234 -2) -513.52519629917379-1122.07302470289119i)
+(num-test (make-polar 1234 -3) -1221.65074080494969-174.14208994587614i)
+(num-test (make-polar 1234 -500029) 1054.01993547355005-641.71487097022577i)
+(num-test (make-polar 1234 1) 666.73304544128450+1038.37519525294420i)
+(num-test (make-polar 1234 10) -1035.41426688034221-671.32205083748227i)
+(num-test (make-polar 1234 1234) -985.41146950707912+742.77872597692169i)
+(num-test (make-polar 1234 2) -513.52519629917379+1122.07302470289119i)
+(num-test (make-polar 1234 3) -1221.65074080494969+174.14208994587614i)
+(num-test (make-polar 1234 500029) 1054.01993547355005+641.71487097022577i)
+(num-test (make-polar 1234.0 -1.0) 666.73304544128450-1038.37519525294420i)
+(num-test (make-polar 1234.0 -1234.0) -985.41146950707912-742.77872597692169i)
+(num-test (make-polar 1234.0 -3.14159265358979) -1234.0-0.00000000000015i)
+(num-test (make-polar 1234.0 1.0) 666.73304544128450+1038.37519525294420i)
+(num-test (make-polar 1234.0 1234.0) -985.41146950707912+742.77872597692169i)
+(num-test (make-polar 1234.0 pi) -1234.0+0.00000000000015i)
+(num-test (make-polar 2 -1) 1.08060461173628-1.68294196961579i)
+(num-test (make-polar 2 -10) -1.67814305815290+1.08804222177874i)
+(num-test (make-polar 2 -1234) -1.59710124717517-1.20385530952499i)
+(num-test (make-polar 2 -2) -0.83229367309428-1.81859485365136i)
+(num-test (make-polar 2 -3) -1.97998499320089-0.28224001611973i)
+(num-test (make-polar 2 -500029) 1.70829811259895-1.04005651696957i)
+(num-test (make-polar 2 1) 1.08060461173628+1.68294196961579i)
+(num-test (make-polar 2 10) -1.67814305815290-1.08804222177874i)
+(num-test (make-polar 2 1234) -1.59710124717517+1.20385530952499i)
+(num-test (make-polar 2 2) -0.83229367309428+1.81859485365136i)
+(num-test (make-polar 2 3) -1.97998499320089+0.28224001611973i)
+(num-test (make-polar 2 500029) 1.70829811259895+1.04005651696957i)
+(num-test (angle (make-polar 1.0 4.0)) (- 4 (* 2 pi)))
+(num-test (make-polar 1/2 0) 1/2)
+(num-test (make-polar 1/2 pi) -1/2)
+(num-test (make-polar 1 0) 1)
+(num-test (make-polar 1 1/2) 0.87758256189037+0.4794255386042i)
+(num-test (make-polar 0 1/2) 0.0)
+
+(test (nan? (make-polar 0 0/0)) #t)
+(test (nan? (make-polar +nan.0 +nan.0)) #t)
+(num-test (make-polar 1.0 (* 200 pi)) 1.0)
+(num-test (make-polar 1.0 (* 2000000 pi)) 1.0)
+(num-test (make-polar 1.0 (* 2000000000 pi)) 1.0)
+
+(let ((val1 (catch #t (lambda () (make-polar 1.0 0.0)) (lambda args 'error)))
+      (val2 (catch #t (lambda () (make-polar 1.0 -0.0)) (lambda args 'error))))
+  (test (equal? val1 val2) #t))
+
+(when with-bignums
+  (test (nan? (make-polar (bignum "0/0") 0)) #t)
+  (test (nan? (make-polar 0 (bignum "0/0"))) #t)
+  (num-test (make-polar (bignum "1.0") (bignum "0.0")) 1.0)
+  (num-test (make-polar 1000000000000000000000000.0 0.0) 1e24)
+  (num-test (make-polar 1000000000000000000000000.0 pi) -1e24)
+  (num-test (angle (make-polar 1000000000000000000000000.0 4.0)) (- 4 (* 2 pi)))
+  (num-test (make-polar 1000000000000000000000000.0 4.0) -6.536436208636119146391681830977503814246E23-7.568024953079282513726390945118290941345E23i)
+  (num-test (make-polar 1000000000000000000000000.0 -4.0) -6.536436208636119146391681830977503814246E23+7.568024953079282513726390945118290941345E23i)
+  (num-test (magnitude (make-polar 1e24 (* 1e19 pi))) 1e24)
+  (num-test (magnitude (make-polar 100000000000000000000000000000000000000.0 (* 1.5 pi))) 1e38)
+  (num-test (magnitude (make-polar 100000000000000000000000000000000000000.0 .01)) 1e38)
+  (num-test (angle (make-polar 100000000000000000000000000000000000000.0 (* 100 pi))) 0.0)
+  (test (make-polar 0.0 0+92233720368547758081.0i) 'error))
+
+(test (make-polar 0 0+0/0i) 'error)
+(test (make-polar 0+0/0i 0) 'error)
+(test (make-polar 1.23 1.23 1.23) 'error)
+(test (make-polar 1.23) 'error)
+(test (make-polar 1.23+1.0i 1.23+1.0i) 'error)
+(test (make-polar) 'error)
+(test (make-polar 1.0 1.0+0.1i) 'error)
+(test (make-polar 1.0+0.1i 0.0) 'error)
+(for-each
+ (lambda (x)
+   (test (make-polar x 0-i) 'error))
+ (list 0 1 1/2 1.0 0.0 0+i))
+(for-each
+ (lambda (x)
+   (test (make-polar 0-i x) 'error))
+ (list 0 1 1/2 pi (- pi) 0.0 1.0 0+i))
+
+(for-each
+ (lambda (arg)
+   (test (make-polar arg 0.0) 'error)
+   (test (make-polar 0.0 arg) 'error)
+   (test (make-polar 1 arg) 'error)
+   (test (make-polar 1/2 arg) 'error)
+   (test (make-polar 1+i arg) 'error)
+   (test (make-polar arg +nan.0) 'error)
+   (test (make-polar +nan.0 arg) 'error)
+   (test (make-polar arg +inf.0) 'error)
+   (test (make-polar +inf.0 arg) 'error))
+ (list "hi" () (integer->char 65) #f #t 0+i '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+;;; --------------------------------------------------------------------------------
+;;; abs
+;;; --------------------------------------------------------------------------------
+
+(num-test (abs -0) 0)
+(num-test (abs -0.0) 0.0)
+(num-test (abs -0.00000001) 0.00000001)
+(num-test (abs -0/1) 0/1)
+(num-test (abs -0/10) 0/10)
+(num-test (abs -0/1234) 0/1234)
+(num-test (abs -0/2) 0/2)
+(num-test (abs -0/3) 0/3)
+(num-test (abs -0/500029) 0/500029)
+(num-test (abs -1) 1)
+(num-test (abs -1.0) 1.0)
+(num-test (abs -1/1) 1/1)
+(num-test (abs -1/10) 1/10)
+(num-test (abs -1/1234) 1/1234)
+(num-test (abs -1/2) 1/2)
+(num-test (abs -1/3) 1/3)
+(num-test (abs -1/500029) 1/500029)
+(num-test (abs -1/9223372036854775807) 1/9223372036854775807)
+(num-test (abs -1234) 1234)
+(num-test (abs -1234.0) 1234.0)
+(num-test (abs -1234/1) 1234/1)
+(num-test (abs -1234/10) 1234/10)
+(num-test (abs -1234/2) 1234/2)
+(num-test (abs -1234/3) 1234/3)
+(num-test (abs -1234/500029) 1234/500029)
+(num-test (abs -123456789) 123456789)
+(num-test (abs -1234567890) 1234567890)
+(num-test (abs -2) 2)
+(num-test (abs -2/1) 2/1)
+(num-test (abs -2/10) 2/10)
+(num-test (abs -2/1234) 2/1234)
+(num-test (abs -2/2) 2/2)
+(num-test (abs -2/3) 2/3)
+(num-test (abs -2/500029) 2/500029)
+(num-test (abs -3) 3)
+(num-test (abs -3.14159265358979) pi)
+(num-test (abs -3/500029) 3/500029)
+(num-test (abs -500029) 500029)
+(num-test (abs -500029/1) 500029/1)
+(num-test (abs -500029/10) 500029/10)
+(num-test (abs -500029/1234) 500029/1234)
+(num-test (abs -500029/2) 500029/2)
+(num-test (abs -500029/3) 500029/3)
+(num-test (abs -500029/500029) 500029/500029)
+(num-test (abs -6) 6)
+(num-test (abs -7) 7)
+(num-test (abs 0) 0)
+(num-test (abs 0.0) 0.0)
+(num-test (abs 0.00000001) 0.00000001)
+(num-test (abs 0/1) 0/1)
+(num-test (abs 0/10) 0/10)
+(num-test (abs 0/1234) 0/1234)
+(num-test (abs 0/2) 0/2)
+(num-test (abs 0/3) 0/3)
+(num-test (abs 0/500029) 0/500029)
+(num-test (abs 1) 1)
+(num-test (abs 1.0) 1.0)
+(num-test (abs 1/1) 1/1)
+(num-test (abs 1/10) 1/10)
+(num-test (abs 1/1234) 1/1234)
+(num-test (abs 1/2) 1/2)
+(num-test (abs 1/3) 1/3)
+(num-test (abs 1/500029) 1/500029)
+(num-test (abs 1234) 1234)
+(num-test (abs 1234.0) 1234.0)
+(num-test (abs 1234/1) 1234/1)
+(num-test (abs 1234/10) 1234/10)
+(num-test (abs 1234/2) 1234/2)
+(num-test (abs 1234/3) 1234/3)
+(num-test (abs 1234/500029) 1234/500029)
+(num-test (abs 2) 2)
+(num-test (abs 2/1) 2/1)
+(num-test (abs 2/10) 2/10)
+(num-test (abs 2/1234) 2/1234)
+(num-test (abs 2/2) 2/2)
+(num-test (abs 2/3) 2/3)
+(num-test (abs 2/500029) 2/500029)
+(num-test (abs 3) 3)
+(num-test (abs 500029) 500029)
+(num-test (abs 500029/1) 500029/1)
+(num-test (abs 500029/10) 500029/10)
+(num-test (abs 500029/1234) 500029/1234)
+(num-test (abs 500029/2) 500029/2)
+(num-test (abs 500029/3) 500029/3)
+(num-test (abs 500029/500029) 500029/500029)
+(num-test (abs 6) 6)
+(num-test (abs 7) 7)
+(num-test (abs pi) pi)
+
+(num-test (abs -2.225073858507201399999999999999999999996E-308) 2.225073858507201399999999999999999999996E-308)
+(num-test (abs 1.110223024625156799999999999999999999997E-16) 1.110223024625156799999999999999999999997E-16)
+(num-test (abs 9223372036854775807) 9223372036854775807)
+(test (= (abs (+ most-negative-fixnum 1)) most-positive-fixnum) #t)
+(test (abs most-positive-fixnum) most-positive-fixnum)
+(num-test (abs -922337203685477580) 922337203685477580)
+(test (abs -9223372036854775808) (if with-bignums 9223372036854775808 'error))
+
+(for-each
+ (lambda (num-and-val)
+   (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'abs num (abs num) val)))
+ (vector (list 0 0) (list 1 1) (list 2 2) (list 3 3) (list -1 1) (list -2 2) (list -3 3) (list 9223372036854775807 9223372036854775807)
+	 (list 1/2 1/2) (list 1/3 1/3) (list -1/2 1/2)
+	 (list -1/3 1/3) (list 1/9223372036854775807 1/9223372036854775807) (list 0.0 0.0)
+	 (list 1.0 1.0) (list 2.0 2.0) (list -2.0 2.0) (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309)
+	 (list 1e+16 1e+16) ))
+
+(when with-bignums
+  (num-test (abs -1e310) 1e310)
+  (num-test (abs -.1e310) 1e309)
+  (num-test (abs -.00001e309) 1e304)
+  (num-test (abs most-negative-fixnum) 9223372036854775808)
+  (num-test (abs -.1e-400) 1.000000000000000000000000000000000000001E-401)
+  (num-test (abs -1.797693134862315699999999999999999999998E308) 1.797693134862315699999999999999999999998E308)
+  (num-test (abs -12345678901234567890) 12345678901234567890)
+  (num-test (abs 12345678901234567890) 12345678901234567890)
+  (num-test (abs 9223372036854775808.0) 9223372036854775808.0)
+  (num-test (abs -9223372036854775808.0) 9223372036854775808.0)
+  (num-test (abs 9223372036854775808/3) 9223372036854775808/3)
+  (num-test (abs -9223372036854775808/3) 9223372036854775808/3)
+  (num-test (abs 9223372036854775808) 9223372036854775808)
+  (num-test (abs -9223372036854775808) 9223372036854775808)
+  (num-test (abs 1231234567891234567895/4924938271564938271564) 1231234567891234567895/4924938271564938271564)
+  (num-test (abs -1231234567891234567895/4924938271564938271564) 1231234567891234567895/4924938271564938271564)
+  (num-test (abs 5/4924938271564938271564) 5/4924938271564938271564)
+  (num-test (abs -5/4924938271564938271564) 5/4924938271564938271564)
+  (num-test (abs 1231234567891234567895.4924938271564938271564) 1231234567891234567895.4924938271564938271564)
+  (num-test (abs -1231234567891234567895.4924938271564938271564) 1231234567891234567895.4924938271564938271564)
+
+  (test (< (abs (- 217307123869033896670383722255101771944951615456222473725950809456844385078286527901170732595082536915607499776643486838126400154358628745576030002134993982282420557293291331398770482226850626076965834765751024210059623687394545134173058036837172944503241193618487196846261991269480351798163386073355597133702428176134419602160051931823812274538708325328119629419660293102211559158897247464223430070715316610068188075169995173607390273159413073729599663002285391560133032803005324145809498542320942319/69171005865679080805116192745197553936743146778127491628445014149228719516632195993428601364184241694325570308897501794466504355763015991674090032275753543906386364041957503000266249940077862458146827521257517440768326138892186263673940157476537922438310169667984623997354774657585797547359740040386280140433453254961653602051204994301868729700341678413408419088335979860854285428030584998257285624659397393914631805389952520897186723117920856639645035858695810847480593484518166856238091362466500961 pi)) 1e-30) #t)
+  (test (< (abs (- 86506249226122124054607019515040072569389309675677090446756879032293209564976057920114008345082990143050895371432654098617595803586181179031736344131661104245709204440599410618785461104070923873664766537405043170624321277708803595336768044461421851475181966244993926088957647640608814315524675779027527947452743019231877030652479460288601395608061537360792381908211008391170537372395545350366754911899795085297260398105485029514527793853213999006311528934617756311568188335120606938078206683552323219/31823870623143321794788842272907994994917601540780651644441590671647399038540853367332145707942720183928541015066510539504636213034857780420049324239395126123695561521079512763516656025946557452382852551302156382716241918690232497805575429042492016743374932252325803315778289435501557305339709678335435100310171257145989526559485407857600325792028152511795618358674583299689136950642929744615564346477399823659926550178426308547711386364571735861738189405232059295317994009776897697526162381026548407 (exp 1.0))) 1e-10) #t)
+
+  (test (< (abs (- 394372834342725903069943709807632345074473102456264/125532772013612015195543173729505082616186012726141 pi)) 1e-100) #t)
+  (test (< (abs (- 37263594917349868210957473113622483286895975031882232950275573404793068492510874215659862655765029385/11861370656940517106115970314230542917832783292279765360251185207749769595904108589726721941267812387 pi)) 1e-200) #t)
+  (test (< (abs (- 9723120205746844213570925835953968530586731050832362731080980958991370971563630998369876152193644009314571826202389376113741653418445346223192649145551112347805140423409409719828584948506325652698166338315337526327656688617124164275819596889301942895/3094965286042593318538169915190725425595617454610327314732861344227207817775353866654459841280603529756895813991351842180977260125352058245398197717632118060786828996125027995519815695529226138848308047979443033939320415958110104195587441744710374021 pi)) 1e-500) #t)
+  (test (< (abs (- 217307123869033896670383722255101771944951615456222473725950809456844385078286527901170732595082536915607499776643486838126400154358628745576030002134993982282420557293291331398770482226850626076965834765751024210059623687394545134173058036837172944503241193618487196846261991269480351798163386073355597133702428176134419602160051931823812274538708325328119629419660293102211559158897247464223430070715316610068188075169995173607390273159413073729599663002285391560133032803005324145809498542320942319/69171005865679080805116192745197553936743146778127491628445014149228719516632195993428601364184241694325570308897501794466504355763015991674090032275753543906386364041957503000266249940077862458146827521257517440768326138892186263673940157476537922438310169667984623997354774657585797547359740040386280140433453254961653602051204994301868729700341678413408419088335979860854285428030584998257285624659397393914631805389952520897186723117920856639645035858695810847480593484518166856238091362466500961 pi)) 1e-1000) #t)
+  (test (< (abs (- 86506249226122124054607019515040072569389309675677090446756879032293209564976057920114008345082990143050895371432654098617595803586181179031736344131661104245709204440599410618785461104070923873664766537405043170624321277708803595336768044461421851475181966244993926088957647640608814315524675779027527947452743019231877030652479460288601395608061537360792381908211008391170537372395545350366754911899795085297260398105485029514527793853213999006311528934617756311568188335120606938078206683552323219/31823870623143321794788842272907994994917601540780651644441590671647399038540853367332145707942720183928541015066510539504636213034857780420049324239395126123695561521079512763516656025946557452382852551302156382716241918690232497805575429042492016743374932252325803315778289435501557305339709678335435100310171257145989526559485407857600325792028152511795618358674583299689136950642929744615564346477399823659926550178426308547711386364571735861738189405232059295317994009776897697526162381026548407 (exp (bignum "1.0")))) 1e-1000) #t))
+
+(test (abs 0+0i) 0.0)
+(test (abs 1.23 1.23) 'error)
+(test (abs 1.23+1.0i) 'error)
+(test (abs) 'error)
+(test (nan? (abs 1/0)) #t)
+(test (positive? (abs (real-part (log 0.0)))) #t)
+(if (not pure-s7) (test (abs 1.0+0.1i) 'error))
+
+;; an optimizer bug
+(let () (define (t1) (let ((a 1+i) (b 0+i)) (abs (- a b)))) (num-test (t1) 1.0))
+
+(for-each
+ (lambda (arg)
+   (test (abs arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; magnitude
+;;; --------------------------------------------------------------------------------
+
+(num-test (magnitude (complex (expt 2 62) (expt 2 62))) 6.521908912666391106174785903126254184439E18)
+(num-test (magnitude (complex most-positive-fixnum most-negative-fixnum)) 1.30438178253327822116424650250659608445E19)
+(num-test (magnitude (complex most-positive-fixnum most-positive-fixnum)) 1.304381782533278221093535824387941332006E19)
+(num-test (magnitude -0) 0)
+(num-test (magnitude -0.0) 0.0)
+(num-test (magnitude -0.0+0.00000001i) 0.00000001)
+(num-test (magnitude -0.0+1.0i) 1.0)
+(num-test (magnitude -0.0+1234.0i) 1234.0)
+(num-test (magnitude -0.0+3.14159265358979i) 3.14159265358979)
+(num-test (magnitude -0.0-0.00000001i) 0.00000001)
+(num-test (magnitude -0.0-1.0i) 1.0)
+(num-test (magnitude -0.0-1234.0i) 1234.0)
+(num-test (magnitude -0.0-3.14159265358979i) 3.14159265358979)
+(num-test (magnitude -0.00000001) 0.00000001)
+(num-test (magnitude -0.00000001+0.00000001i) 0.00000001414214)
+(num-test (magnitude -0.00000001+1.0i) 1.0)
+(num-test (magnitude -0.00000001+1234.0i) 1234.0)
+(num-test (magnitude -0.00000001+3.14159265358979i) pi)
+(num-test (magnitude -0.00000001-0.00000001i) 0.00000001414214)
+(num-test (magnitude -0.00000001-1.0i) 1.0)
+(num-test (magnitude -0.00000001-1234.0i) 1234.0)
+(num-test (magnitude -0.00000001-3.14159265358979i) pi)
+(num-test (magnitude -0/1) 0/1)
+(num-test (magnitude -0/10) 0/10)
+(num-test (magnitude -0/1234) 0/1234)
+(num-test (magnitude -0/2) 0/2)
+(num-test (magnitude -0/3) 0/3)
+(num-test (magnitude -0/500029) 0/500029)
+(num-test (magnitude -1) 1)
+(num-test (magnitude -1.0) 1.0)
+(num-test (magnitude -1.0+0.00000001i) 1.0)
+(num-test (magnitude -1.0+1.0i) 1.41421356237310)
+(num-test (magnitude -1.0+1234.0i) 1234.00040518631931)
+(num-test (magnitude -1.0+3.14159265358979i) 3.29690830947562)
+(num-test (magnitude -1.0-0.00000001i) 1.0)
+(num-test (magnitude -1.0-1.0i) 1.41421356237310)
+(num-test (magnitude -1.0-1234.0i) 1234.00040518631931)
+(num-test (magnitude -1.0-3.14159265358979i) 3.29690830947562)
+(num-test (magnitude -1.0e+00+0.0e+00i) 1e0)
+(num-test (magnitude -1.0e+00+1.0e+00i) 1.4142135623730950488e0)
+(num-test (magnitude -1.0e+00+1.19209289550781250e-07i) 1.0000000000000071054e0)
+(num-test (magnitude -1.0e+00+2.0e+00i) 2.2360679774997896964e0)
+(num-test (magnitude -1.0e+00+5.0e-01i) 1.1180339887498948482e0)
+(num-test (magnitude -1.0e+00+8.3886080e+06i) 8.3886080000000596046e6)
+(num-test (magnitude -1.0e+00-1.0e+00i) 1.4142135623730950488e0)
+(num-test (magnitude -1.0e+00-1.19209289550781250e-07i) 1.0000000000000071054e0)
+(num-test (magnitude -1.0e+00-2.0e+00i) 2.2360679774997896964e0)
+(num-test (magnitude -1.0e+00-5.0e-01i) 1.1180339887498948482e0)
+(num-test (magnitude -1.0e+00-8.3886080e+06i) 8.3886080000000596046e6)
+(num-test (magnitude -1.19209289550781250e-07+0.0e+00i) 1.1920928955078125e-7)
+(num-test (magnitude -1.19209289550781250e-07+1.0e+00i) 1.0000000000000071054e0)
+(num-test (magnitude -1.19209289550781250e-07+1.19209289550781250e-07i) 1.6858739404357612715e-7)
+(num-test (magnitude -1.19209289550781250e-07+2.0e+00i) 2.0000000000000035527e0)
+(num-test (magnitude -1.19209289550781250e-07+5.0e-01i) 5.0000000000001421085e-1)
+(num-test (magnitude -1.19209289550781250e-07+8.3886080e+06i) 8.3886080e6)
+(num-test (magnitude -1.19209289550781250e-07-1.0e+00i) 1.0000000000000071054e0)
+(num-test (magnitude -1.19209289550781250e-07-1.19209289550781250e-07i) 1.6858739404357612715e-7)
+(num-test (magnitude -1.19209289550781250e-07-2.0e+00i) 2.0000000000000035527e0)
+(num-test (magnitude -1.19209289550781250e-07-5.0e-01i) 5.0000000000001421085e-1)
+(num-test (magnitude -1.19209289550781250e-07-8.3886080e+06i) 8.3886080e6)
+(num-test (magnitude -1/1) 1/1)
+(num-test (magnitude -1/10) 1/10)
+(num-test (magnitude -1/1234) 1/1234)
+(num-test (magnitude -1/2) 1/2)
+(num-test (magnitude -1/3) 1/3)
+(num-test (magnitude -1/500029) 1/500029)
+(num-test (magnitude -1234/500029) 1234/500029)
+(num-test (magnitude -2) 2)
+(num-test (magnitude -2.0e+00+0.0e+00i) 2e0)
+(num-test (magnitude -2.0e+00+1.0e+00i) 2.2360679774997896964e0)
+(num-test (magnitude -2.0e+00+1.19209289550781250e-07i) 2.0000000000000035527e0)
+(num-test (magnitude -2.0e+00+2.0e+00i) 2.8284271247461900976e0)
+(num-test (magnitude -2.0e+00+5.0e-01i) 2.0615528128088302749e0)
+(num-test (magnitude -2.0e+00+8.3886080e+06i) 8.3886080000002384186e6)
+(num-test (magnitude -2.0e+00-1.0e+00i) 2.2360679774997896964e0)
+(num-test (magnitude -2.0e+00-1.19209289550781250e-07i) 2.0000000000000035527e0)
+(num-test (magnitude -2.0e+00-2.0e+00i) 2.8284271247461900976e0)
+(num-test (magnitude -2.0e+00-5.0e-01i) 2.0615528128088302749e0)
+(num-test (magnitude -2.0e+00-8.3886080e+06i) 8.3886080000002384186e6)
+(num-test (magnitude -2/1) 2/1)
+(num-test (magnitude -2/10) 2/10)
+(num-test (magnitude -2/1234) 2/1234)
+(num-test (magnitude -2/2) 2/2)
+(num-test (magnitude -2/3) 2/3)
+(num-test (magnitude -2/500029) 2/500029)
+(num-test (magnitude -5.0e-01+0.0e+00i) 5e-1)
+(num-test (magnitude -5.0e-01+1.0e+00i) 1.1180339887498948482e0)
+(num-test (magnitude -5.0e-01+1.19209289550781250e-07i) 5.0000000000001421085e-1)
+(num-test (magnitude -5.0e-01+2.0e+00i) 2.0615528128088302749e0)
+(num-test (magnitude -5.0e-01+5.0e-01i) 7.0710678118654752440e-1)
+(num-test (magnitude -5.0e-01+8.3886080e+06i) 8.3886080000000149012e6)
+(num-test (magnitude -5.0e-01-1.0e+00i) 1.1180339887498948482e0)
+(num-test (magnitude -5.0e-01-1.19209289550781250e-07i) 5.0000000000001421085e-1)
+(num-test (magnitude -5.0e-01-2.0e+00i) 2.0615528128088302749e0)
+(num-test (magnitude -5.0e-01-5.0e-01i) 7.0710678118654752440e-1)
+(num-test (magnitude -5.0e-01-8.3886080e+06i) 8.3886080000000149012e6)
+(num-test (magnitude -500029) 500029)
+(num-test (magnitude -500029/1) 500029/1)
+(num-test (magnitude -500029/10) 500029/10)
+(num-test (magnitude -500029/1234) 500029/1234)
+(num-test (magnitude -500029/2) 500029/2)
+(num-test (magnitude -500029/3) 500029/3)
+(num-test (magnitude -500029/500029) 500029/500029)
+(num-test (magnitude -8.3886080e+06+0.0e+00i) 8.388608e6)
+(num-test (magnitude -8.3886080e+06+1.0e+00i) 8.3886080000000596046e6)
+(num-test (magnitude -8.3886080e+06+1.19209289550781250e-07i) 8.3886080e6)
+(num-test (magnitude -8.3886080e+06+2.0e+00i) 8.3886080000002384186e6)
+(num-test (magnitude -8.3886080e+06+5.0e-01i) 8.3886080000000149012e6)
+(num-test (magnitude -8.3886080e+06+8.3886080e+06i) 1.1863283203031444111e7)
+(num-test (magnitude -8.3886080e+06-1.0e+00i) 8.3886080000000596046e6)
+(num-test (magnitude -8.3886080e+06-1.19209289550781250e-07i) 8.3886080e6)
+(num-test (magnitude -8.3886080e+06-2.0e+00i) 8.3886080000002384186e6)
+(num-test (magnitude -8.3886080e+06-5.0e-01i) 8.3886080000000149012e6)
+(num-test (magnitude -8.3886080e+06-8.3886080e+06i) 1.1863283203031444111e7)
+(num-test (magnitude .1e-18-.1e-18i) 1.4142135623731e-19)
+(num-test (magnitude .1e200+.1e200i) 1.4142135623731e+199)
+(num-test (magnitude 0) 0)
+(num-test (magnitude 0.0) 0.0)
+(num-test (magnitude 0.0+0.00000001i) 0.00000001)
+(num-test (magnitude 0.0+1.0i) 1.0)
+(num-test (magnitude 0.0+1234.0i) 1234.0)
+(num-test (magnitude 0.0+3.14159265358979i) 3.14159265358979)
+(num-test (magnitude 0.0-0.00000001i) 0.00000001)
+(num-test (magnitude 0.0-1.0i) 1.0)
+(num-test (magnitude 0.0-1234.0i) 1234.0)
+(num-test (magnitude 0.0-3.14159265358979i) 3.14159265358979)
+(num-test (magnitude 0.00000001) 0.00000001)
+(num-test (magnitude 0.00000001+0.00000001i) 0.00000001414214)
+(num-test (magnitude 0.00000001+1.0i) 1.0)
+(num-test (magnitude 0.00000001+1234.0i) 1234.0)
+(num-test (magnitude 0.00000001+3.14159265358979i) pi)
+(num-test (magnitude 0.00000001-0.00000001i) 0.00000001414214)
+(num-test (magnitude 0.00000001-1.0i) 1.0)
+(num-test (magnitude 0.00000001-1234.0i) 1234.0)
+(num-test (magnitude 0.00000001-3.14159265358979i) pi)
+(num-test (magnitude 0.0e+00+0.0e+00i) 0e0)
+(num-test (magnitude 0.0e+00+1.0e+00i) 1e0)
+(num-test (magnitude 0.0e+00+1.19209289550781250e-07i) 1.1920928955078125e-7)
+(num-test (magnitude 0.0e+00+2.0e+00i) 2e0)
+(num-test (magnitude 0.0e+00+5.0e-01i) 5e-1)
+(num-test (magnitude 0.0e+00+8.3886080e+06i) 8.388608e6)
+(num-test (magnitude 0.0e+00-1.0e+00i) 1e0)
+(num-test (magnitude 0.0e+00-1.19209289550781250e-07i) 1.1920928955078125e-7)
+(num-test (magnitude 0.0e+00-2.0e+00i) 2e0)
+(num-test (magnitude 0.0e+00-5.0e-01i) 5e-1)
+(num-test (magnitude 0.0e+00-8.3886080e+06i) 8.388608e6)
+(num-test (magnitude 0/1) 0/1)
+(num-test (magnitude 0/10) 0/10)
+(num-test (magnitude 0/1234) 0/1234)
+(num-test (magnitude 0/2) 0/2)
+(num-test (magnitude 0/3) 0/3)
+(num-test (magnitude 0/500029) 0/500029)
+(num-test (magnitude 1) 1)
+(num-test (magnitude 1.0) 1.0)
+(num-test (magnitude 1.0+0.00000001i) 1.0)
+(num-test (magnitude 1.0+1.0i) 1.41421356237310)
+(num-test (magnitude 1.0+1234.0i) 1234.00040518631931)
+(num-test (magnitude 1.0+3.14159265358979i) 3.29690830947562)
+(num-test (magnitude 1.0-0.00000001i) 1.0)
+(num-test (magnitude 1.0-1.0i) 1.41421356237310)
+(num-test (magnitude 1.0-1234.0i) 1234.00040518631931)
+(num-test (magnitude 1.0-3.14159265358979i) 3.29690830947562)
+(num-test (magnitude 1.0e+00+0.0e+00i) 1e0)
+(num-test (magnitude 1.0e+00+1.0e+00i) 1.4142135623730950488e0)
+(num-test (magnitude 1.0e+00+1.19209289550781250e-07i) 1.0000000000000071054e0)
+(num-test (magnitude 1.0e+00+2.0e+00i) 2.2360679774997896964e0)
+(num-test (magnitude 1.0e+00+5.0e-01i) 1.1180339887498948482e0)
+(num-test (magnitude 1.0e+00+8.3886080e+06i) 8.3886080000000596046e6)
+(num-test (magnitude 1.0e+00-1.0e+00i) 1.4142135623730950488e0)
+(num-test (magnitude 1.0e+00-1.19209289550781250e-07i) 1.0000000000000071054e0)
+(num-test (magnitude 1.0e+00-2.0e+00i) 2.2360679774997896964e0)
+(num-test (magnitude 1.0e+00-5.0e-01i) 1.1180339887498948482e0)
+(num-test (magnitude 1.0e+00-8.3886080e+06i) 8.3886080000000596046e6)
+(num-test (magnitude 1.19209289550781250e-07+0.0e+00i) 1.1920928955078125e-7)
+(num-test (magnitude 1.19209289550781250e-07+1.0e+00i) 1.0000000000000071054e0)
+(num-test (magnitude 1.19209289550781250e-07+1.19209289550781250e-07i) 1.6858739404357612715e-7)
+(num-test (magnitude 1.19209289550781250e-07+2.0e+00i) 2.0000000000000035527e0)
+(num-test (magnitude 1.19209289550781250e-07+5.0e-01i) 5.0000000000001421085e-1)
+(num-test (magnitude 1.19209289550781250e-07+8.3886080e+06i) 8.3886080e6)
+(num-test (magnitude 1.19209289550781250e-07-1.0e+00i) 1.0000000000000071054e0)
+(num-test (magnitude 1.19209289550781250e-07-1.19209289550781250e-07i) 1.6858739404357612715e-7)
+(num-test (magnitude 1.19209289550781250e-07-2.0e+00i) 2.0000000000000035527e0)
+(num-test (magnitude 1.19209289550781250e-07-5.0e-01i) 5.0000000000001421085e-1)
+(num-test (magnitude 1.19209289550781250e-07-8.3886080e+06i) 8.3886080e6)
+(num-test (magnitude 1/1) 1/1)
+(num-test (magnitude 1/10) 1/10)
+(num-test (magnitude 1/1234) 1/1234)
+(num-test (magnitude 1/2) 1/2)
+(num-test (magnitude 1/3) 1/3)
+(num-test (magnitude 1/500029) 1/500029)
+(num-test (magnitude 1e18+1e18i) 1.414213562373095048801688724209698078569E18)
+(num-test (magnitude 2) 2)
+(num-test (magnitude 2.0e+00+0.0e+00i) 2e0)
+(num-test (magnitude 2.0e+00+1.0e+00i) 2.2360679774997896964e0)
+(num-test (magnitude 2.0e+00+1.19209289550781250e-07i) 2.0000000000000035527e0)
+(num-test (magnitude 2.0e+00+2.0e+00i) 2.8284271247461900976e0)
+(num-test (magnitude 2.0e+00+5.0e-01i) 2.0615528128088302749e0)
+(num-test (magnitude 2.0e+00+8.3886080e+06i) 8.3886080000002384186e6)
+(num-test (magnitude 2.0e+00-1.0e+00i) 2.2360679774997896964e0)
+(num-test (magnitude 2.0e+00-1.19209289550781250e-07i) 2.0000000000000035527e0)
+(num-test (magnitude 2.0e+00-2.0e+00i) 2.8284271247461900976e0)
+(num-test (magnitude 2.0e+00-5.0e-01i) 2.0615528128088302749e0)
+(num-test (magnitude 2.0e+00-8.3886080e+06i) 8.3886080000002384186e6)
+(num-test (magnitude 2/1) 2/1)
+(num-test (magnitude 2/10) 2/10)
+(num-test (magnitude 2/1234) 2/1234)
+(num-test (magnitude 2/2) 2/2)
+(num-test (magnitude 2/3) 2/3)
+(num-test (magnitude 2/500029) 2/500029)
+(num-test (magnitude 5.0e-01+0.0e+00i) 5e-1)
+(num-test (magnitude 5.0e-01+1.0e+00i) 1.1180339887498948482e0)
+(num-test (magnitude 5.0e-01+1.19209289550781250e-07i) 5.0000000000001421085e-1)
+(num-test (magnitude 5.0e-01+2.0e+00i) 2.0615528128088302749e0)
+(num-test (magnitude 5.0e-01+5.0e-01i) 7.0710678118654752440e-1)
+(num-test (magnitude 5.0e-01+8.3886080e+06i) 8.3886080000000149012e6)
+(num-test (magnitude 5.0e-01-1.0e+00i) 1.1180339887498948482e0)
+(num-test (magnitude 5.0e-01-1.19209289550781250e-07i) 5.0000000000001421085e-1)
+(num-test (magnitude 5.0e-01-2.0e+00i) 2.0615528128088302749e0)
+(num-test (magnitude 5.0e-01-5.0e-01i) 7.0710678118654752440e-1)
+(num-test (magnitude 5.0e-01-8.3886080e+06i) 8.3886080000000149012e6)
+(num-test (magnitude 500029) 500029)
+(num-test (magnitude 500029/1) 500029/1)
+(num-test (magnitude 500029/10) 500029/10)
+(num-test (magnitude 500029/1234) 500029/1234)
+(num-test (magnitude 500029/2) 500029/2)
+(num-test (magnitude 500029/3) 500029/3)
+(num-test (magnitude 500029/500029) 500029/500029)
+(num-test (magnitude 8.3886080e+06+0.0e+00i) 8.388608e6)
+(num-test (magnitude 8.3886080e+06+1.0e+00i) 8.3886080000000596046e6)
+(num-test (magnitude 8.3886080e+06+1.19209289550781250e-07i) 8.3886080e6)
+(num-test (magnitude 8.3886080e+06+2.0e+00i) 8.3886080000002384186e6)
+(num-test (magnitude 8.3886080e+06+5.0e-01i) 8.3886080000000149012e6)
+(num-test (magnitude 8.3886080e+06+8.3886080e+06i) 1.1863283203031444111e7)
+(num-test (magnitude 8.3886080e+06-1.0e+00i) 8.3886080000000596046e6)
+(num-test (magnitude 8.3886080e+06-1.19209289550781250e-07i) 8.3886080e6)
+(num-test (magnitude 8.3886080e+06-2.0e+00i) 8.3886080000002384186e6)
+(num-test (magnitude 8.3886080e+06-5.0e-01i) 8.3886080000000149012e6)
+(num-test (magnitude 8.3886080e+06-8.3886080e+06i) 1.1863283203031444111e7)
+(num-test (magnitude most-positive-fixnum) most-positive-fixnum)
+(num-test (magnitude pi) pi)
+(num-test (magnitude -2.225073858507201399999999999999999999996E-308) 2.225073858507201399999999999999999999996E-308)
+(if (not with-bignums)
+    (num-test (magnitude -9223372036854775808) 9223372036854775807)) ; changed 28-Apr-15
+(num-test (magnitude 1.110223024625156799999999999999999999997E-16) 1.110223024625156799999999999999999999997E-16)
+(num-test (magnitude 9223372036854775807) 9223372036854775807)
+
+(for-each
+ (lambda (num-and-val)
+   (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'magnitude num (magnitude num) val)))
+ (vector (list 0 0) (list 1 1) (list 2 2) (list 3 3) (list -1 1) (list -2 2) (list -3 3) (list 9223372036854775807 9223372036854775807)
+	 (list 1/2 1/2) (list 1/3 1/3) (list -1/2 1/2)
+	 (list -1/3 1/3) (list 1/9223372036854775807 1/9223372036854775807) (list 0.0 0.0)
+	 (list 1.0 1.0) (list 2.0 2.0) (list -2.0 2.0) (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309)
+	 (list 1e+16 1e+16) (list 0+1i 1.0) (list 0+2i 2.0) (list 0-1i 1.0) (list 1+1i 1.4142135623731)
+	 (list 1-1i 1.4142135623731) (list -1+1i 1.4142135623731) (list -1-1i 1.4142135623731)
+	 (list 0.1+0.1i 0.14142135623731) (list 1e+16+1e+16i 1.4142135623731e+16) (list 1e-16+1e-16i 1.4142135623731e-16)
+	 ))
+
+(when with-bignums
+  (num-test (magnitude (complex (expt 2 63) (expt 2 63))) 1.304381782533278221234957180625250836888E19)
+  (num-test (magnitude most-negative-fixnum) 9223372036854775808)
+  (num-test (magnitude 1e400+1e400i) 1.414213562373095048801688724209698078569E400)
+  (num-test (magnitude .1e400+.1e400i) 1.41421356237309504880168872420969807857E399)
+  (num-test (magnitude .001e310+.001e310i) 1.414213562373095048801688724209698078572E307)
+  (num-test (magnitude 1e-310+1e-310i) 1.414213562373095048801688724209698078569E-310)
+  (num-test (magnitude 1e-400+1e-400i) 1.414213562373095048801688724209698078568E-400)
+  (num-test (magnitude -1.797693134862315699999999999999999999998E308) 1.797693134862315699999999999999999999998E308)
+  (num-test (magnitude 9223372036854775808.1) 9223372036854775808.1)
+  (num-test (magnitude 9223372036854775808) 9223372036854775808)
+  (num-test (magnitude 9223372036854775808/3) 9223372036854775808/3)
+  (num-test (magnitude 9223372036854775808.1+1.0e19i) 1.360406526484765934746566522678055771386E19)
+  (num-test (magnitude 1.0e19+9223372036854775808.1i) 1.360406526484765934746566522678055771386E19)
+  (num-test (magnitude 14142135623730950488.0168872420969+14142135623730950488.0168872420969i) 1.9999999999999999999999999999999885751772054578776001965575456E19))
+
+(test (magnitude "hi") 'error)
+(test (magnitude 1.0+23.0i 1.0+23.0i) 'error)
+(test (magnitude) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (magnitude arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+;;; (magnitude -9223372036854775808) -> -9223372036854775808?
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; angle
+;;; --------------------------------------------------------------------------------
+
+(num-test (angle (make-polar 1.0 (+ pi .0001))) (- .0001 pi))
+(num-test (angle (make-polar 1.0 (- pi .0001))) (- pi .0001))
+(num-test (angle -0) 0)
+(num-test (angle -0.0+0.00000001i) 1.57079632679490)
+(num-test (angle -0.0+1.0i) 1.57079632679490)
+(num-test (angle -0.0+1234.0i) 1.57079632679490)
+(num-test (angle -0.0+3.14159265358979i) 1.57079632679490)
+(num-test (angle -0.0-0.00000001i) -1.57079632679490)
+(num-test (angle -0.0-1.0i) -1.57079632679490)
+(num-test (angle -0.0-1234.0i) -1.57079632679490)
+(num-test (angle -0.0-3.14159265358979i) -1.57079632679490)
+(num-test (angle -0.00000001) pi)
+(num-test (angle -0.00000001+0.00000001i) 2.35619449019234)
+(num-test (angle -0.00000001+1.0i) 1.57079633679490)
+(num-test (angle -0.00000001+1234.0i) 1.57079632680300)
+(num-test (angle -0.00000001+3.14159265358979i) 1.57079632997800)
+(num-test (angle -0.00000001-0.00000001i) -2.35619449019234)
+(num-test (angle -0.00000001-1.0i) -1.57079633679490)
+(num-test (angle -0.00000001-1234.0i) -1.57079632680300)
+(num-test (angle -0.00000001-3.14159265358979i) -1.57079632997800)
+(num-test (angle -1) pi)
+(num-test (angle -1.0) pi)
+(num-test (angle -1.0+0.00000001i) 3.14159264358979)
+(num-test (angle -1.0+1.0i) 2.35619449019234)
+(num-test (angle -1.0+1234.0i) 1.57160669938898)
+(num-test (angle -1.0+3.14159265358979i) 1.87896539791088)
+(num-test (angle -1.0-0.00000001i) -3.14159264358979)
+(num-test (angle -1.0-1.0i) -2.35619449019234)
+(num-test (angle -1.0-1234.0i) -1.57160669938898)
+(num-test (angle -1.0-3.14159265358979i) -1.87896539791088)
+(num-test (angle -1.0e+00+0.0e+00i) pi)
+(num-test (angle -1.0e+00+1.0e+00i) 2.3561944901923449288e0)
+(num-test (angle -1.0e+00+1.19209289550781250e-07i) 3.1415925343805036877e0)
+(num-test (angle -1.0e+00+2.0e+00i) 2.0344439357957027354e0)
+(num-test (angle -1.0e+00+5.0e-01i) 2.6779450445889871222e0)
+(num-test (angle -1.0e+00+8.3886080e+06i) 1.570796446004186170e0)
+(num-test (angle -1.0e+00-1.0e+00i) -2.3561944901923449288e0)
+(num-test (angle -1.0e+00-1.19209289550781250e-07i) -3.1415925343805036877e0)
+(num-test (angle -1.0e+00-2.0e+00i) -2.0344439357957027354e0)
+(num-test (angle -1.0e+00-5.0e-01i) -2.6779450445889871222e0)
+(num-test (angle -1.0e+00-8.3886080e+06i) -1.570796446004186170e0)
+(num-test (angle -1.19209289550781250e-07+0.0e+00i) pi)
+(num-test (angle -1.19209289550781250e-07+1.0e+00i) 1.570796446004186170e0)
+(num-test (angle -1.19209289550781250e-07+1.19209289550781250e-07i) 2.3561944901923449288e0)
+(num-test (angle -1.19209289550781250e-07+2.0e+00i) 1.5707963863995413946e0)
+(num-test (angle -1.19209289550781250e-07+5.0e-01i) 1.5707965652134757208e0)
+(num-test (angle -1.19209289550781250e-07+8.3886080e+06i) 1.5707963267949108301e0)
+(num-test (angle -1.19209289550781250e-07-1.0e+00i) -1.570796446004186170e0)
+(num-test (angle -1.19209289550781250e-07-1.19209289550781250e-07i) -2.3561944901923449288e0)
+(num-test (angle -1.19209289550781250e-07-2.0e+00i) -1.5707963863995413946e0)
+(num-test (angle -1.19209289550781250e-07-5.0e-01i) -1.5707965652134757208e0)
+(num-test (angle -1.19209289550781250e-07-8.3886080e+06i) -1.5707963267949108301e0)
+(num-test (angle -1/1) pi)
+(num-test (angle -1/10) pi)
+(num-test (angle -1/1234) pi)
+(num-test (angle -1/2) pi)
+(num-test (angle -1/3) pi)
+(num-test (angle -1/500029) pi)
+(num-test (angle -2) pi)
+(num-test (angle -2.0e+00+0.0e+00i) pi)
+(num-test (angle -2.0e+00+1.0e+00i) 2.6779450445889871222e0)
+(num-test (angle -2.0e+00+1.19209289550781250e-07i) 3.1415925939851484631e0)
+(num-test (angle -2.0e+00+2.0e+00i) 2.3561944901923449288e0)
+(num-test (angle -2.0e+00+5.0e-01i) 2.8966139904629290843e0)
+(num-test (angle -2.0e+00+8.3886080e+06i) 1.5707965652134757208e0)
+(num-test (angle -2.0e+00-1.0e+00i) -2.6779450445889871222e0)
+(num-test (angle -2.0e+00-1.19209289550781250e-07i) -3.1415925939851484631e0)
+(num-test (angle -2.0e+00-2.0e+00i) -2.3561944901923449288e0)
+(num-test (angle -2.0e+00-5.0e-01i) -2.8966139904629290843e0)
+(num-test (angle -2.0e+00-8.3886080e+06i) -1.5707965652134757208e0)
+(num-test (angle -2.225073858507201399999999999999999999996E-308) 3.141592653589793238462643383279502884195E0)
+(num-test (angle -2/1) pi)
+(num-test (angle -2/10) pi)
+(num-test (angle -2/1234) pi)
+(num-test (angle -2/2) pi)
+(num-test (angle -2/3) pi)
+(num-test (angle -2/500029) pi)
+(num-test (angle -5.0e-01+0.0e+00i) pi)
+(num-test (angle -5.0e-01+1.0e+00i) 2.0344439357957027354e0)
+(num-test (angle -5.0e-01+1.19209289550781250e-07i) 3.1415924151712141369e0)
+(num-test (angle -5.0e-01+2.0e+00i) 1.8157749899217607734e0)
+(num-test (angle -5.0e-01+5.0e-01i) 2.3561944901923449288e0)
+(num-test (angle -5.0e-01+8.3886080e+06i) 1.5707963863995413946e0)
+(num-test (angle -5.0e-01-1.0e+00i) -2.0344439357957027354e0)
+(num-test (angle -5.0e-01-1.19209289550781250e-07i) -3.1415924151712141369e0)
+(num-test (angle -5.0e-01-2.0e+00i) -1.8157749899217607734e0)
+(num-test (angle -5.0e-01-5.0e-01i) -2.3561944901923449288e0)
+(num-test (angle -5.0e-01-8.3886080e+06i) -1.5707963863995413946e0)
+(num-test (angle -500029) pi)
+(num-test (angle -500029/1) pi)
+(num-test (angle -500029/10) pi)
+(num-test (angle -500029/1234) pi)
+(num-test (angle -500029/2) pi)
+(num-test (angle -500029/3) pi)
+(num-test (angle -500029/500029) pi)
+(num-test (angle -8.3886080e+06+0.0e+00i) pi)
+(num-test (angle -8.3886080e+06+1.0e+00i) 3.1415925343805036877e0)
+(num-test (angle -8.3886080e+06+1.19209289550781250e-07i) 3.1415926535897790276e0)
+(num-test (angle -8.3886080e+06+2.0e+00i) 3.1415924151712141369e0)
+(num-test (angle -8.3886080e+06+5.0e-01i) 3.1415925939851484631e0)
+(num-test (angle -8.3886080e+06+8.3886080e+06i) 2.3561944901923449288e0)
+(num-test (angle -8.3886080e+06-1.0e+00i) -3.1415925343805036877e0)
+(num-test (angle -8.3886080e+06-1.19209289550781250e-07i) -3.1415926535897790276e0)
+(num-test (angle -8.3886080e+06-2.0e+00i) -3.1415924151712141369e0)
+(num-test (angle -8.3886080e+06-5.0e-01i) -3.1415925939851484631e0)
+(num-test (angle -8.3886080e+06-8.3886080e+06i) -2.3561944901923449288e0)
+(num-test (angle -9223372036854775808) 3.141592653589793238462643383279502884195E0)
+(num-test (angle 0) 0)
+(num-test (angle 0.0) 0.0)
+(num-test (angle 0.0+0.00000001i) 1.57079632679490)
+(num-test (angle 0.0+1.0i) 1.57079632679490)
+(num-test (angle 0.0+1234.0i) 1.57079632679490)
+(num-test (angle 0.0+3.14159265358979i) 1.57079632679490)
+(num-test (angle 0.0-0.00000001i) -1.57079632679490)
+(num-test (angle 0.0-1.0i) -1.57079632679490)
+(num-test (angle 0.0-1234.0i) -1.57079632679490)
+(num-test (angle 0.0-3.14159265358979i) -1.57079632679490)
+(num-test (angle 0.00000001) 0.0)
+(num-test (angle 0.00000001+0.00000001i) 0.78539816339745)
+(num-test (angle 0.00000001+1.0i) 1.57079631679490)
+(num-test (angle 0.00000001+1234.0i) 1.57079632678679)
+(num-test (angle 0.00000001+3.14159265358979i) 1.57079632361180)
+(num-test (angle 0.00000001-0.00000001i) -0.78539816339745)
+(num-test (angle 0.00000001-1.0i) -1.57079631679490)
+(num-test (angle 0.00000001-1234.0i) -1.57079632678679)
+(num-test (angle 0.00000001-3.14159265358979i) -1.57079632361180)
+(num-test (angle 0.0e+00+0.0e+00i) 0e0)
+(num-test (angle 0.0e+00+1.0e+00i) 1.5707963267948966192e0)
+(num-test (angle 0.0e+00+1.19209289550781250e-07i) 1.5707963267948966192e0)
+(num-test (angle 0.0e+00+2.0e+00i) 1.5707963267948966192e0)
+(num-test (angle 0.0e+00+5.0e-01i) 1.5707963267948966192e0)
+(num-test (angle 0.0e+00+8.3886080e+06i) 1.5707963267948966192e0)
+(num-test (angle 0.0e+00-1.0e+00i) -1.5707963267948966192e0)
+(num-test (angle 0.0e+00-1.19209289550781250e-07i) -1.5707963267948966192e0)
+(num-test (angle 0.0e+00-2.0e+00i) -1.5707963267948966192e0)
+(num-test (angle 0.0e+00-5.0e-01i) -1.5707963267948966192e0)
+(num-test (angle 0.0e+00-8.3886080e+06i) -1.5707963267948966192e0)
+(num-test (angle 1) 0)
+(num-test (angle 1.0) 0.0)
+(num-test (angle 1.0+0.00000001i) 0.00000001)
+(num-test (angle 1.0+1.0i) 0.78539816339745)
+(num-test (angle 1.0+1234.0i) 1.56998595420081)
+(num-test (angle 1.0+3.14159265358979i) 1.26262725567891)
+(num-test (angle 1.0-0.00000001i) -0.00000001)
+(num-test (angle 1.0-1.0i) -0.78539816339745)
+(num-test (angle 1.0-1234.0i) -1.56998595420081)
+(num-test (angle 1.0-3.14159265358979i) -1.26262725567891)
+(num-test (angle 1.0e+00+0.0e+00i) 0e0)
+(num-test (angle 1.0e+00+1.0e+00i) 7.8539816339744830962e-1)
+(num-test (angle 1.0e+00+1.19209289550781250e-07i) 1.1920928955078068531e-7)
+(num-test (angle 1.0e+00+2.0e+00i) 1.1071487177940905030e0)
+(num-test (angle 1.0e+00+5.0e-01i) 4.6364760900080611621e-1)
+(num-test (angle 1.0e+00+8.3886080e+06i) 1.5707962075856070685e0)
+(num-test (angle 1.0e+00-1.0e+00i) -7.8539816339744830962e-1)
+(num-test (angle 1.0e+00-1.19209289550781250e-07i) -1.1920928955078068531e-7)
+(num-test (angle 1.0e+00-2.0e+00i) -1.1071487177940905030e0)
+(num-test (angle 1.0e+00-5.0e-01i) -4.6364760900080611621e-1)
+(num-test (angle 1.0e+00-8.3886080e+06i) -1.5707962075856070685e0)
+(num-test (angle 1.110223024625156799999999999999999999997E-16) 0.0)
+(num-test (angle 1.19209289550781250e-07+0.0e+00i) 0e0)
+(num-test (angle 1.19209289550781250e-07+1.0e+00i) 1.5707962075856070685e0)
+(num-test (angle 1.19209289550781250e-07+1.19209289550781250e-07i) 7.8539816339744830962e-1)
+(num-test (angle 1.19209289550781250e-07+2.0e+00i) 1.5707962671902518438e0)
+(num-test (angle 1.19209289550781250e-07+5.0e-01i) 1.5707960883763175177e0)
+(num-test (angle 1.19209289550781250e-07+8.3886080e+06i) 1.5707963267948824084e0)
+(num-test (angle 1.19209289550781250e-07-1.0e+00i) -1.5707962075856070685e0)
+(num-test (angle 1.19209289550781250e-07-1.19209289550781250e-07i) -7.8539816339744830962e-1)
+(num-test (angle 1.19209289550781250e-07-2.0e+00i) -1.5707962671902518438e0)
+(num-test (angle 1.19209289550781250e-07-5.0e-01i) -1.5707960883763175177e0)
+(num-test (angle 1.19209289550781250e-07-8.3886080e+06i) -1.5707963267948824084e0)
+(num-test (angle 1/1) 0)
+(num-test (angle 1/10) 0)
+(num-test (angle 1/1234) 0)
+(num-test (angle 1/2) 0)
+(num-test (angle 1/3) 0)
+(num-test (angle 1/500029) 0)
+(num-test (angle 2) 0)
+(num-test (angle 2.0e+00+0.0e+00i) 0e0)
+(num-test (angle 2.0e+00+1.0e+00i) 4.6364760900080611621e-1)
+(num-test (angle 2.0e+00+1.19209289550781250e-07i) 5.9604644775390554414e-8)
+(num-test (angle 2.0e+00+2.0e+00i) 7.8539816339744830962e-1)
+(num-test (angle 2.0e+00+5.0e-01i) 2.4497866312686415417e-1)
+(num-test (angle 2.0e+00+8.3886080e+06i) 1.5707960883763175177e0)
+(num-test (angle 2.0e+00-1.0e+00i) -4.6364760900080611621e-1)
+(num-test (angle 2.0e+00-1.19209289550781250e-07i) -5.9604644775390554414e-8)
+(num-test (angle 2.0e+00-2.0e+00i) -7.8539816339744830962e-1)
+(num-test (angle 2.0e+00-5.0e-01i) -2.4497866312686415417e-1)
+(num-test (angle 2.0e+00-8.3886080e+06i) -1.5707960883763175177e0)
+(num-test (angle 2/1) 0)
+(num-test (angle 2/10) 0)
+(num-test (angle 2/1234) 0)
+(num-test (angle 2/2) 0)
+(num-test (angle 2/3) 0)
+(num-test (angle 2/500029) 0)
+(num-test (angle 3) 0)
+(num-test (angle 3.14159265358979+0.00000001i) 0.00000000318310)
+(num-test (angle 3.14159265358979+1.0i) 0.30816907111598)
+(num-test (angle 3.14159265358979+1234.0i) 1.56825047114960)
+(num-test (angle 3.14159265358979+3.14159265358979i) 0.78539816339745)
+(num-test (angle 3.14159265358979-0.00000001i) -0.00000000318310)
+(num-test (angle 3.14159265358979-1.0i) -0.30816907111598)
+(num-test (angle 3.14159265358979-1234.0i) -1.56825047114960)
+(num-test (angle 3.14159265358979-3.14159265358979i) -0.78539816339745)
+(num-test (angle 5.0e-01+0.0e+00i) 0.0)
+(num-test (angle 5.0e-01+1.0e+00i) 1.1071487177940905030e0)
+(num-test (angle 5.0e-01+1.19209289550781250e-07i) 2.3841857910155798249e-7)
+(num-test (angle 5.0e-01+2.0e+00i) 1.3258176636680324651e0)
+(num-test (angle 5.0e-01+5.0e-01i) 7.8539816339744830962e-1)
+(num-test (angle 5.0e-01+8.3886080e+06i) 1.5707962671902518438e0)
+(num-test (angle 5.0e-01-1.0e+00i) -1.1071487177940905030e0)
+(num-test (angle 5.0e-01-1.19209289550781250e-07i) -2.3841857910155798249e-7)
+(num-test (angle 5.0e-01-2.0e+00i) -1.3258176636680324651e0)
+(num-test (angle 5.0e-01-5.0e-01i) -7.8539816339744830962e-1)
+(num-test (angle 5.0e-01-8.3886080e+06i) -1.5707962671902518438e0)
+(num-test (angle 500029) 0)
+(num-test (angle 500029/1) 0)
+(num-test (angle 500029/10) 0)
+(num-test (angle 500029/1234) 0)
+(num-test (angle 500029/2) 0)
+(num-test (angle 500029/3) 0)
+(num-test (angle 500029/500029) 0)
+(num-test (angle 8.3886080e+06+0.0e+00i) 0e0)
+(num-test (angle 8.3886080e+06+1.0e+00i) 1.1920928955078068531e-7)
+(num-test (angle 8.3886080e+06+1.19209289550781250e-07i) 1.4210854715202003717e-14)
+(num-test (angle 8.3886080e+06+2.0e+00i) 2.3841857910155798249e-7)
+(num-test (angle 8.3886080e+06+5.0e-01i) 5.9604644775390554414e-8)
+(num-test (angle 8.3886080e+06+8.3886080e+06i) 7.8539816339744830962e-1)
+(num-test (angle 8.3886080e+06-1.0e+00i) -1.1920928955078068531e-7)
+(num-test (angle 8.3886080e+06-1.19209289550781250e-07i) -1.4210854715202003717e-14)
+(num-test (angle 8.3886080e+06-2.0e+00i) -2.3841857910155798249e-7)
+(num-test (angle 8.3886080e+06-5.0e-01i) -5.9604644775390554414e-8)
+(num-test (angle 8.3886080e+06-8.3886080e+06i) -7.8539816339744830962e-1)
+(num-test (angle 9223372036854775807) 0)
+(num-test (angle pi) 0.0)
+
+(let ((val1 (catch #t (lambda () (angle 0.0)) (lambda args 'error)))
+      (val2 (catch #t (lambda () (angle -0.0)) (lambda args 'error))))
+  (test (equal? val1 val2) #t))
+
+(when with-bignums
+  (num-test (angle -1.797693134862315699999999999999999999998E308) 3.141592653589793238462643383279502884195E0)
+  (num-test (angle (complex 1.0 1.0)) (angle (complex (expt 2 70) (expt 2 70))))
+  (num-test (angle (make-polar 1000000000000000000000000.0 (* .1 pi))) (* .1 pi))
+  (num-test (angle (complex most-positive-fixnum most-positive-fixnum)) 7.853981633974483096156608458198757210488E-1))
+
+(test (angle) 'error)
+(test (angle "hi") 'error)
+(test (angle 1.0+23.0i 1.0+23.0i) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (angle arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; integer-length
+;;; --------------------------------------------------------------------------------
+
+;;; integer-length
+(num-test (integer-length 0) 0)
+(num-test (integer-length 1) 1)
+(num-test (integer-length 2) 2)
+(num-test (integer-length 3) 2)
+(num-test (integer-length 4) 3)
+(num-test (integer-length 7) 3)
+(num-test (integer-length 8) 4)
+(num-test (integer-length 21) 5)
+(num-test (integer-length 215) 8)
+(num-test (integer-length 12341234) 24)
+
+(num-test (integer-length -1) 0)
+(num-test (integer-length -2) 1)
+(num-test (integer-length -3) 2)
+(num-test (integer-length -4) 2)
+(num-test (integer-length -7) 3)
+(num-test (integer-length -8) 3)
+(num-test (integer-length -9) 4)
+(num-test (integer-length -21) 5)
+(num-test (integer-length -215) 8)
+(num-test (integer-length -12341234) 24)
+
+(num-test (integer-length 127) 7)
+(num-test (integer-length 128) 8)
+(num-test (integer-length 129) 8)
+(num-test (integer-length -127) 7)
+(num-test (integer-length -128) 7)
+(num-test (integer-length -129) 8)
+(num-test (integer-length most-negative-fixnum) (if with-bignums 64 63))
+(num-test (integer-length most-positive-fixnum) 63)
+
+(test (integer-length) 'error)
+(test (integer-length 1 2) 'error)
+(test (integer-length 1/2) 'error)
+(test (integer-length 1.2) 'error)
+(test (integer-length 1+2i) 'error)
+(test (integer-length 1/0) 'error)
+(test (integer-length (log 0)) 'error)
+
+(when with-bignums
+  (test (integer-length (bignum "100000000000000000000000000000000000")) (ceiling (log (bignum "100000000000000000000000000000000001") 2)))
+  (num-test (integer-length (+ (expt 2 48) (expt 2 46))) 49)
+  (num-test (integer-length (ash 1 64)) 65)
+  (num-test (integer-length 9223372036854775808) 64)
+  (num-test (integer-length (* 4 most-positive-fixnum)) 65)
+  (num-test (integer-length (* most-positive-fixnum most-positive-fixnum)) 126)
+  (test (integer-length 0+92233720368547758081.0i) 'error)
+  (test (integer-length 92233720368547758081.0) 'error))
+
+(for-each
+ (lambda (arg)
+   (test (integer-length arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; integer-decode-float
+;;; --------------------------------------------------------------------------------
+
+(if (not with-bignums)
+    (let ()
+      (define (idf-test val1 val2)
+	(test (cadr val1) (cadr val2))
+	(test (caddr val1) (caddr val2))
+	(test (< (abs (- (car val1) (car val2))) 1000) #t))
+
+      (idf-test (integer-decode-float 0.0) '(0 0 1))
+      (idf-test (integer-decode-float -0.0) '(0 0 1))
+      (idf-test (integer-decode-float 1.0) '(4503599627370496 -52 1))
+      (idf-test (integer-decode-float -1.0) '(4503599627370496 -52 -1))
+      (idf-test (integer-decode-float 0.2) '(7205759403792794 -55 1))
+      (idf-test (integer-decode-float -0.2) '(7205759403792794 -55 -1))
+      (idf-test (integer-decode-float 3.0) '(6755399441055744 -51 1))
+      (idf-test (integer-decode-float -3.0) '(6755399441055744 -51 -1))
+      (idf-test (integer-decode-float 0.04) '(5764607523034235 -57 1))
+      (idf-test (integer-decode-float -0.04) '(5764607523034235 -57 -1))
+      (idf-test (integer-decode-float 50.0) '(7036874417766400 -47 1))
+      (idf-test (integer-decode-float -50.0) '(7036874417766400 -47 -1))
+      (idf-test (integer-decode-float 0.006) '(6917529027641082 -60 1))
+      (idf-test (integer-decode-float -0.006) '(6917529027641082 -60 -1))
+      (idf-test (integer-decode-float 7000.0) '(7696581394432000 -40 1))
+      (idf-test (integer-decode-float -7000.0) '(7696581394432000 -40 -1))
+      (idf-test (integer-decode-float 0.0008) '(7378697629483821 -63 1))
+      (idf-test (integer-decode-float -0.0008) '(7378697629483821 -63 -1))
+      (idf-test (integer-decode-float 90000.0) '(6184752906240000 -36 1))
+      (idf-test (integer-decode-float -90000.0) '(6184752906240000 -36 -1))
+      (idf-test (integer-decode-float 0.00001) '(5902958103587057 -69 1))
+      (idf-test (integer-decode-float 1.0e-6) '(4722366482869645 -72 1))
+      (idf-test (integer-decode-float 1.0e-8) '(6044629098073146 -79 1))
+      (idf-test (integer-decode-float 1.0e-12) '(4951760157141521 -92 1))
+      (idf-test (integer-decode-float 1.0e-16) '(8112963841460668 -106 1))
+      (idf-test (integer-decode-float 1.0e-17) '(6490371073168535 -109 1))
+      (idf-test (integer-decode-float 1.0e-18) '(5192296858534828 -112 1))
+      (idf-test (integer-decode-float 1.0e-19) '(8307674973655724 -116 1))
+      (idf-test (integer-decode-float 1.0e-25) '(8711228593176025 -136 1))
+      (idf-test (integer-decode-float 1.0e6)  '(8589934592000000 -33 1))
+      (idf-test (integer-decode-float 1.0e12) '(8192000000000000 -13 1))
+      (idf-test (integer-decode-float 1.0e17) '(6250000000000000 4 1))
+      (idf-test (integer-decode-float 1.0e18) '(7812500000000000 7 1))
+      (idf-test (integer-decode-float 1.0e19) '(4882812500000000 11 1))
+      (idf-test (integer-decode-float 1.0e20) '(6103515625000000 14 1))
+      (idf-test (integer-decode-float 1.0e-100) '(7880401239278896 -385 1))
+      (idf-test (integer-decode-float 1.0e100) '(5147557589468029 280 1))
+      (idf-test (integer-decode-float 1.0e200) '(5883593420661338 612 1))
+      (idf-test (integer-decode-float 1.0e-200) '(6894565328877484 -717 1))
+      (idf-test (integer-decode-float 1.0e307) '(8016673440035891 967 1))
+
+      (let ((val (integer-decode-float 1.0e-307)))
+	(if (and (not (equal? val '(5060056332682765 -1072 1)))
+		 (not (equal? val '(5060056332682766 -1072 1))))
+	    (format #t ";(integer-decode-float 1.0e-307) got ~A?~%" val)))
+
+      (test (integer-decode-float (/ 1.0e-307 100.0e0)) '(4706001880677807 -1075 1)) ; denormal
+      (test (integer-decode-float (/ (log 0.0))) '(6755399441055744 972 -1)) ; nan
+      (test (integer-decode-float (- (real-part (log 0.0)))) '(4503599627370496 972 1)) ; +inf
+      (test (integer-decode-float (real-part (log 0.0))) '(4503599627370496 972 -1)) ; -inf
+      (test (integer-decode-float 1.797e308) '(9003726357340310 971 1))
+      (test (integer-decode-float 1.0e-322) '(4503599627370516 -1075 1))
+      (test (integer-decode-float (expt 2.0 31)) (list #x10000000000000 -21 1))
+      (test (integer-decode-float (expt 2.0 52)) (list #x10000000000000 0 1))
+      (test (pair? (member (integer-decode-float 1e23) '((5960464477539062 24 1) (5960464477539063 24 1)))) #t)
+      (test (integer-decode-float 1/0) '(6755399441055744 972 1)) ; nan
+      (test (integer-decode-float (real-part (log 0))) '(4503599627370496 972 -1)) ; -inf
+      (test (integer-decode-float (- (real-part (log 0)))) '(4503599627370496 972 1)) ; inf
+      (test (integer-decode-float (/ (real-part (log 0)) (real-part (log 0)))) '(6755399441055744 972 1)) ; nan
+      (test (integer-decode-float (- (/ (real-part (log 0)) (real-part (log 0))))) '(6755399441055744 972 -1)) ; -nan
+      )
+    ;; with-bignums
+    (let-temporarily (((*s7* 'bignum-precision) 128))
+      (test (integer-decode-float 2.225e-308) '(340271071678961823938180190063081855376 -1150 1))
+      (test (integer-decode-float (bignum "3.1")) '(263718834363727316739901693351052705792 -126 1))
+      (test (integer-decode-float (bignum "1E430")) '(229073916549713112029076262063818929063 1301 1))
+      (test (integer-decode-float (bignum "1E310")) '(295763046541693677743187899379506632913 902 1))
+      (test (integer-decode-float (bignum "-1E310")) '(295763046541693677743187899379506632913 902 -1))
+      (test (integer-decode-float 0+92233720368547758081.0i) 'error)
+      (test (integer-decode-float 92233720368547758081/123) 'error))
+    )
+
+(do ((i 0 (+ i 1)))
+    ((= i 100))
+  (let ((val (- 1.0e6 (random 2.0e6))))
+    (let* ((data (integer-decode-float val))
+	   (signif (car data))
+	   (expon (cadr data))
+	   (sign (caddr data)))
+      (num-test (* sign signif (expt 2.0 expon)) val))))
+
+(test (integer-decode-float) 'error)
+(for-each
+ (lambda (arg)
+   (test (integer-decode-float arg) 'error))
+ (list -1 0 #\a #(1 2 3) 2/3 1.5+0.3i 1+i () 'hi abs "hi" #(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+(test (integer-decode-float 1.0 1.0) 'error)
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; lognot
+;;; --------------------------------------------------------------------------------
+
+(for-each
+ (lambda (op)
+   (for-each
+    (lambda (arg)
+      (let ((val (catch #t (lambda () (op arg)) (lambda args 'error))))
+	(if (not (equal? val 'error))
+	    (format #t ";(~A ~A) -> ~A?~%" op arg val))))
+    (list "hi" _ht_ _undef_ _null_ _c_obj_ () '(1 2) #f (integer->char 65) 'a-symbol (make-vector 3) 3.14 3/4 3.1+i abs #\f (lambda (a) (+ a 1)))))
+ (list logior logand lognot logxor logbit? ash integer-length))
+
+(for-each
+ (lambda (op)
+   (for-each
+    (lambda (arg)
+      (let ((val (catch #t (lambda () (op 1 arg)) (lambda args 'error))))
+	(if (not (equal? val 'error))
+	    (format #t ";(~A ~A) -> ~A?~%" op arg val))))
+    (list "hi" _ht_ _undef_ _null_ _c_obj_ () '(1 2) #f (integer->char 65) 'a-symbol (make-vector 3) 3.14 -1/2 1+i abs #\f (lambda (a) (+ a 1)))))
+ (list logior logand logxor lognot logbit?))
+
+
+(num-test (lognot 0) -1)
+(num-test (lognot -1) 0)
+(num-test (lognot 1) -2)
+(num-test (lognot #b101) -6)
+(num-test (lognot -6) #b101)
+(num-test (lognot 12341234) -12341235)
+(num-test (lognot #b-101) 4)
+(num-test (lognot (+ 1 (lognot 1000))) 999)
+(num-test (lognot -9223372036854775808) 9223372036854775807)
+(num-test (lognot 9223372036854775807) -9223372036854775808)
+(num-test (lognot most-positive-fixnum) most-negative-fixnum)
+
+(when with-bignums
+  (test (lognot 9223372036854775808) -9223372036854775809)
+  (test (lognot 618970019642690137449562111) (- (expt 2 89)))
+  (num-test (lognot (+ (expt 2 48) (expt 2 46))) -351843720888321)
+  (test (lognot 0+92233720368547758081.0i) 'error)
+  (test (lognot 92233720368547758081.0) 'error))
+
+(test (lognot) 'error)
+(test (lognot 1.0) 'error)
+(test (lognot 1+i) 'error)
+(test (lognot 1/2) 'error)
+(test (lognot #f) 'error)
+(test (lognot 1/1) -2)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; logior
+;;; --------------------------------------------------------------------------------
+
+;;; logior
+(num-test (logior 0 1) 1)
+(num-test (logior #b101 #b10001) 21)
+(num-test (logior 1 3 6) 7)
+(num-test (logior -6 1) -5)
+(num-test (logior -6 3) -5)
+(num-test (logior #b1 #b11 #b111 #b1111) #b1111)
+(num-test (logior -1 0 -1 -1) -1)
+(num-test (logior 3 3 3 3) 3)
+(num-test (logior 1) 1)
+(num-test (logior -1) -1)
+(num-test (logior 12341234 10001111) 12378103)
+(num-test (logior 1 2 4 8) 15)
+(num-test (logior 0 1/1) 1)
+(num-test (logior 1/1 0) 1)
+(num-test (logior -1 1 0) -1)
+(num-test (logior 1 2 3 4) 7)
+(num-test (logior 1 3 5 7) 7)
+(num-test (logior -9223372036854775808 -9223372036854775808) -9223372036854775808)
+(num-test (logior -9223372036854775808 9223372036854775807 -9223372036854775808) -1)
+(num-test (logior 9223372036854775807 -9223372036854775808) -1)
+(num-test (logior 9223372036854775807 9223372036854775807) 9223372036854775807)
+(num-test (logior) 0)
+
+(when with-bignums
+  (test (logior (expt 2 63) (expt 2 75)) (+ (expt 2 63) (expt 2 75)))
+  (num-test (logior (+ (expt 2 48) (expt 2 46)) (expt 2 48)) 351843720888320)
+  (test (logior 0+92233720368547758081.0i) 'error)
+  (test (logior 92233720368547758081.0) 'error))
+
+(test (logior 0 1.0) 'error)
+(test (logior 0 1/2) 'error)
+(test (logior 1.0 0) 'error)
+(test (logior 1/2 0) 'error)
+(test (logior 1+i) 'error)
+(test (logior -1 #\a) 'error)
+(test (logior -1 "hi") 'error)
+(test (logior #f "hi") 'error)
+
+(let ()
+  (define (make-bit-vector n)
+    (make-int-vector (ceiling (/ n 63))))
+
+  (define (bit-vector-ref v n)
+    (logbit? (int-vector-ref v (quotient n 63)) (remainder n 63)))
+
+  (define (bit-vector-set! v n t-or-f)
+    (int-vector-set! v (quotient n 63)
+		     (let ((cur (int-vector-ref v (quotient n 63)))
+			   (bit (ash 1 (remainder n 63))))
+		       (if t-or-f
+			   (logior cur bit)
+			   (logand cur (lognot bit))))))
+
+  (let ((bv (make-bit-vector 128)))
+    (if (bit-vector-ref bv 72)
+	(format *stderr* "default #f: ~A~%" (bit-vector-ref bv 72)))
+    (bit-vector-set! bv 72 #t)
+    (if (not (bit-vector-ref bv 72))
+	(format *stderr* "set: ~A~%" (bit-vector-ref bv 72)))
+    (bit-vector-set! bv 72 #f)
+    (if (bit-vector-ref bv 72)
+	(format *stderr* "clear #f: ~A~%" (bit-vector-ref bv 72)))))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; logand
+;;; --------------------------------------------------------------------------------
+
+(num-test (logand 0 1) 0)
+(num-test (logand 0 -1) 0)
+(num-test (logand #b101 #b10001) 1)
+(num-test (logand 1 3 6) 0)
+(num-test (logand -1 3 6) 2)
+(num-test (logand -6 1) 0)
+(num-test (logand -6 3) 2)
+(num-test (logand #b1 #b11 #b111 #b1111) #b1)
+(num-test (logand -1 0 -1 -1) 0)
+(num-test (logand 3 3 3 3) 3)
+(num-test (logand 0) 0)
+(num-test (logand -1) -1)
+(num-test (logand 12341234 10001111) 9964242)
+(num-test (logand -1 1) 1)
+(num-test (logand -1 -1) -1)
+(num-test (logand 1 -1) 1)
+(num-test (logand 1 1) 1)
+(num-test (logand 16 31) 16)
+(num-test (logand 0 1/1) 0)
+(num-test (logand 1/1 0) 0)
+(num-test (logand 1 -1 -1) 1)
+(num-test (logand 1 2 3 4) 0)
+(num-test (logand 1 3 5 7) 1)
+(num-test (logand -9223372036854775808 -1) -9223372036854775808)
+(num-test (logand -9223372036854775808 -9223372036854775808) -9223372036854775808)
+(num-test (logand -9223372036854775808 1) 0)
+(num-test (logand -9223372036854775808 9223372036854775807 -9223372036854775808) 0)
+(num-test (logand 9223372036854775807 -1) 9223372036854775807)
+(num-test (logand 9223372036854775807 -9223372036854775808) 0)
+(num-test (logand 9223372036854775807 1) 1)
+(num-test (logand 9223372036854775807 9223372036854775807) 9223372036854775807)
+(num-test (logand) -1)
+
+(when with-bignums
+  (test (logand 9223372036854775808 -9223372036854775809) 0)
+  (test (logand 618970019642690137449562111 (expt 2 88)) (expt 2 88))
+  (num-test (logand (+ (expt 2 48) (expt 2 46)) (expt 2 48)) 281474976710656)
+  (test (logand 0+92233720368547758081.0i) 'error)
+  (test (logand 92233720368547758081.0) 'error))
+
+(test (logand 0 1.0) 'error)
+(test (logand 1+i) 'error)
+(test (logand 0 1/2) 'error)
+(test (logand 1.0 0) 'error)
+(test (logand 1/2 0) 'error)
+(test (logand 0 #\a) 'error)
+(test (logand 0 "hi") 'error)
+(test (logand #f ()) 'error)
+
+(when with-bignums
+  (let () ; from bug-guile
+    (define (k n t) (logand (ash n t) 4294967295))
+    (define run (lambda (q) (k (+ (ash (k q -96) 30) (ash (k q -96) -2)) 0)))
+    (test (run 589567850402597453564513526754136399297876517360) 2079550178)))
+
+
+;;; --------------------------------------------------------------------------------
+;;; logxor
+;;; --------------------------------------------------------------------------------
+
+(num-test (logxor 0 1) 1)
+(num-test (logxor #b101 #b10001) 20)
+(num-test (logxor 1 3 6) 4)
+(num-test (logxor -6 1) -5)
+(num-test (logxor -6 3) -7)
+(num-test (logxor #b1 #b11 #b111 #b1111) #b1010)
+(num-test (logxor 12341234 10001111) 2413861)
+(num-test (logxor 1 3 7 15) 10)
+(num-test (logxor 0 1/1) 1)
+(num-test (logxor 1/1 0) 1)
+(num-test (logxor 0 1 -1) -2)
+(num-test (logxor -1 -1 -1) -1)
+;; to get the bits that are on in just 1 argument? (logxor (logxor a b c) (logand a b c))
+(num-test (logxor 1 2 3 4) 4)
+(num-test (logxor 1 3 5 7) 0)
+(num-test (logxor -1 8 8) -1)
+(num-test (logxor 8 8 8) 8)
+(num-test (logxor -1 most-positive-fixnum) most-negative-fixnum)
+(num-test (logxor most-negative-fixnum most-positive-fixnum) -1)
+(num-test (logxor -100 -100 -100) -100)
+(num-test (logxor -100 -100 -100 -1) 99)
+(num-test (logxor -100 -100 -100 -1 -1) -100)
+(num-test (logxor 4/2 11/11) 3)
+(num-test (logxor -9223372036854775808 -9223372036854775808) 0)
+(num-test (logxor -9223372036854775808 9223372036854775807 -9223372036854775808) 9223372036854775807)
+(num-test (logxor 9223372036854775807 -9223372036854775808) -1)
+(num-test (logxor 9223372036854775807 9223372036854775807) 0)
+(num-test (logxor) 0)
+
+(when with-bignums
+  (test (logxor 37788155234994016485376 (+ (expt 2 63) 1)) (+ 1 (expt 2 75)))
+  (num-test (logxor (+ (expt 2 48) (expt 2 46)) (expt 2 48)) 70368744177664)
+  (test (logxor 0+92233720368547758081.0i) 'error)
+  (test (logxor 92233720368547758081.0) 'error))
+
+(test (logxor 0 1.0) 'error)
+(test (logxor 0 1/2) 'error)
+(test (logxor 1.0 0) 'error)
+(test (logxor 1/2 0) 'error)
+
+
+;;; log-n-of
+(let ((top-checked-bit (if with-bignums 64 63)))
+
+  (define (log-none-of . ints)  ; bits on in none of ints
+    (lognot (apply logior ints)))
+
+  (define (log-all-of . ints)   ; bits on in all of ints
+    (apply logand ints))
+
+  (define (log-any-of . ints)   ; bits on in at least 1 of ints
+    (apply logior ints))
+
+  (define (log-1-of . ints)     ; bits on in exactly 1 of ints
+    (let ((len (length ints)))
+      (cond ((= len 0)
+	     0)
+	    ((= len 1)
+	     (car ints))
+	    ((= len 2)
+	     (apply logxor ints))
+	    ((= len 3)
+	     (logxor (apply logxor ints) (apply logand ints)))
+	    (#t
+	     (do ((iors ())
+		  (i 0 (+ i 1)))
+		 ((= i len) (apply logior iors))
+	       (let ((cur (ints i)))
+		 (set! (ints i) 0)
+		 (set! iors (cons (logand cur (lognot (apply logior ints))) iors))
+		 (set! (ints i) cur)))))))
+
+  (test (log-1-of 1 1) 0)
+  (test (log-1-of 1 2) 3)
+  (test (log-1-of 1 2 2) 1)
+  (test (log-1-of 1 2 2 1) 0)
+  (test (log-1-of 1 2 3 4 8 9) 4)
+  (test (log-1-of -1 1 2 3) -4)
+  (test (log-1-of 1 2 3 5) 4)
+  (test (log-1-of -6 -31 -19 -9) 0)
+  (test (log-1-of -45 -15 -7 -3) 6)
+  (test (log-1-of -1 most-positive-fixnum -1) 0)
+  (test (log-1-of -1 most-negative-fixnum -1) 0)
+  (test (log-1-of 1 most-negative-fixnum 1) most-negative-fixnum)
+  (test (log-1-of 31 11 27 -38) -60)
+  (test (log-1-of -254) #b-11111110) ; (-254)
+  (test (log-1-of 406 26 439 -361 -133 -480 312) #b1000000) ; (64)
+  (test (log-1-of 47 110) #b1000001) ; (65)
+  (test (log-1-of) 0)
+  (test (log-1-of -52 108 97 48) #b-1101111) ; (-111)
+  (test (log-1-of -113 -391 -129 -58 -374 -297 -498) #b0) ; (0)
+  (test (log-1-of -251 138 418 494 -300 -224) #b10001) ; (17)
+  (test (log-1-of 385 364 372) #b10011001) ; (153)
+  (test (log-1-of -221 -56 173) #b1000110) ; (70)
+  (test (log-1-of 31 -309 244 -478 396 -352 162 -479 -500) #b100000000) ; (256)
+  (test (log-1-of -152 495 80 -403 -439 387) #b10000) ; (16)
+  (test (log-1-of 115 71 110 568 10 382 124 378 23) #b1000000000) ; (512)
+  (test (log-1-of 766 332 285 280 489 229) #b1000000010) ; (514)
+  (test (log-1-of 424 935) #b1000001111) ; (527)
+  (test (log-1-of 788 268 388) #b1010011000) ; (664)
+  (test (log-1-of 389 237 398 530) #b1001110000) ; (624)
+  (test (log-1-of 554 550 215 44 892 668) #b100000001) ; (257)
+  (test (log-1-of 562 171 772 480 6 211 542 678) #b0) ; (0)
+
+  (do ((i 0 (+ i 1)))
+      ((= i 10))
+
+    (let ((len (+ 1 (random 10)))
+	  (ints ()))
+      (do ((k 0 (+ k 1)))
+	  ((= k len))
+	(set! ints (cons (- (random 1000) 500) ints)))
+
+      (let ((result (apply log-1-of ints)))
+	;;(format #t "(test (log-1-of ~{~D~^ ~}) #b~B) ; (~D)~%" ints result result)
+
+	(do ((b 0 (+ b 1)))
+	    ((= b top-checked-bit))
+	  (let ((counts 0))
+	    (for-each
+	     (lambda (int)
+	       (if (logbit? int b) ;(not (zero? (logand int (ash 1 b))))
+		   (set! counts (+ counts 1))))
+	     ints)
+
+	    (if (logbit? result b) ;(not (zero? (logand result (ash 1 b))))
+		(if (not (= counts 1))
+		    (format #t ";(log-1-of ~{~D~^ ~}) -> ~A,  [#b~B, counts: ~D but we're on]~%" ints result (ash 1 b) counts))
+		(if (= counts 1)
+		    (format #t ";(log-1-of ~{~D~^ ~}) -> ~A,  [#b~B, counts = 1 but we're off]~%" ints result (ash 1 b)))))))))
+
+
+  (define (log-n-1-of . ints) ; bits on in exactly n-1 of ints
+    (let ((len (length ints)))
+      (cond ((= len 0)
+	     0)
+	    ((= len 1)
+	     0)
+	    ((= len 2)
+	     (apply logxor ints))
+	    ((= len 3)
+	     (logand (lognot (apply logxor ints)) (apply logior ints)))
+	    (#t
+	     (do ((iors ())
+		  (i 0 (+ i 1)))
+		 ((= i len) (apply logior iors))
+	       (let ((cur (ints i)))
+		 (set! (ints i) -1)
+		 (set! iors (cons (logand (lognot cur) (apply logand ints)) iors))
+		 (set! (ints i) cur)))))))
+
+  (test (log-n-1-of 1 1) 0)
+  (test (log-n-1-of 1 2) 3)
+  (test (log-n-1-of 1 2 2) 2)
+  (test (log-n-1-of 1 2 2 3) 2)
+  (test (log-n-1-of -336 -225 275) #b-11111101) ; (-253)
+  (test (log-n-1-of -35 32 -17 -310 256 -360 171 -370) #b0) ; (0)
+  (test (log-n-1-of 311 237) #b111011010) ; (474)
+  (test (log-n-1-of 32 348 -340 147) #b0) ; (0)
+  (test (log-n-1-of -334 -267 -478 -93 239 423 18 496) #b100000) ; (32)
+  (test (log-n-1-of -347 149 135 107 -436) #b101) ; (5)
+  (test (log-n-1-of -181 406 480 390 207 13 0) #b0) ; (0)
+  (test (log-n-1-of 348) #b0) ; (0)
+  (test (log-n-1-of -498 226) #b-100010100) ; (-276)
+  (test (log-n-1-of 259 -171 146 -344 63 -240 290 -418) #b0) ; (0)
+  (test (log-n-1-of 86 -74 61 -138 215 -277 358) #b110) ; (6)
+  (test (log-n-1-of -144 425 -356 -341 211 -390) #b0) ; (0)
+  (test (log-n-1-of -223 390 195 265) #b100000001) ; (257)
+  (test (log-n-1-of 103 263 -92 -7) #b100100101) ; (293)
+  (test (log-n-1-of -78 -199 68 218 -98 -464 307 301) #b0) ; (0)
+  (test (log-n-1-of -355 258 -134 -371 211) #b0) ; (0)
+  (test (log-n-1-of -222 -39 408 -50 -207 58) #b100000000) ; (256)
+  (test (log-n-1-of 66 93 484) #b100) ; (4)
+  (test (log-n-1-of 36 -384 3 49 359 -284 -284 -133 268) #b0) ; (0)
+  (test (log-n-1-of -339 -50 243 -159 -159) #b-110011111) ; (-415)
+  (test (log-n-1-of 154 -260 -219 400 -196 -236 421 -277 375 -67) #b0) ; (0)
+  (test (log-n-1-of 45 112) #b1011101) ; (93)
+  (test (log-n-1-of -493 131 48 45 311 197 491 -86 164) #b0) ; (0)
+  (test (log-n-1-of 371 -75 -107 -348 -9 7 -129) #b101) ; (5)
+  (test (log-n-1-of 349 -219 -160) #b-110011011) ; (-411)
+  (test (log-n-1-of 412 456 407 -13 352 467 327 147) #b100000000) ; (256)
+  (test (log-n-1-of 133 -133 -471 -284 -58 -266) #b-1000000000) ; (-512)
+  (test (log-n-1-of 43 -339 22 150 49 259) #b0) ; (0)
+  (test (log-n-1-of 258 -138 185 400 -476 -312 69 380) #b0) ; (0)
+  (test (log-n-1-of 260 -85 -208 -21) #b-111100000) ; (-480)
+  (test (log-n-1-of -294 177 -78) #b-111011110) ; (-478)
+  (test (log-n-1-of -40 81 445 -300) #b11000000) ; (192)
+  (test (log-n-1-of -325 -393 411 -441 -221 -43 -231 -283 -223) #b-1000000000) ; (-512)
+  (test (log-n-1-of 18 -36 -351 -160 211 412) #b0) ; (0)
+
+  (do ((i 0 (+ i 1)))
+      ((= i 10))
+
+    (let ((len (+ 1 (random 10)))
+	  (ints ()))
+      (do ((k 0 (+ k 1)))
+	  ((= k len))
+	(set! ints (cons (- (random 1000) 500) ints)))
+
+      (let ((result (apply log-n-1-of ints)))
+	;;(format #t "(test (log-n-1-of ~{~D~^ ~}) #b~B) ; (~D)~%" ints result result)
+
+	(do ((b 0 (+ b 1)))
+	    ((= b top-checked-bit))
+	  (let ((counts 0))
+	    (for-each
+	     (lambda (int)
+	       (if (logbit? int b) ;(not (zero? (logand int (ash 1 b))))
+		   (set! counts (+ counts 1))))
+	     ints)
+
+	    (if (logbit? result b) ;(not (zero? (logand result (ash 1 b))))
+		(if (not (= counts (- len 1)))
+		    (format #t ";(log-n-1-of ~{~D~^ ~}) -> ~A,  [#b~B, counts: ~D but we're on]~%" ints result (ash 1 b) counts))
+		(if (and (> len 1) (= counts (- len 1)))
+		    (format #t ";(log-n-1-of ~{~D~^ ~}) -> ~A,  [#b~B, counts: ~D but we're off]~%" ints result (ash 1 b) counts))))))))
+
+  (define (log-n-of n . ints) ; bits on in exactly n of ints
+    (let ((len (length ints)))
+      (cond ((= len 0)
+	     (if (= n 0) -1 0))
+
+	    ((= n 0)
+	     (apply log-none-of ints))
+
+	    ((= n len)
+	     (apply log-all-of ints))
+
+	    ((> n len)
+	     0)
+
+	    ((= n 1)
+	     (apply log-1-of ints))
+
+	    ((= n (- len 1))
+	     (apply log-n-1-of ints))
+
+	    ;; now n is between 2 and len-2, and len is 3 or more
+	    ;;   I think it would be less inefficient here to choose either this or the n-1 case based on n<=len/2
+	    (#t
+	     (do ((1s ())
+		  (prev ints)
+		  (i 0 (+ i 1)))
+		 ((= i len) (apply logior 1s))
+	       (let ((cur (ints i)))
+		 (if (= i 0)
+		     (set! 1s (cons (logand cur (apply log-n-of (- n 1) (cdr ints))) 1s))
+		     (let ((mid (cdr prev)))
+		       (set! (cdr prev) (if (= i (- len 1)) () (cdr mid)))
+		       (set! 1s (cons (logand cur (apply log-n-of (- n 1) ints)) 1s))
+		       (set! (cdr prev) mid)
+		       (set! prev mid)))))))))
+
+  (test (log-n-of 1) 0)
+  (test (log-n-of 0) -1)
+  (test (log-n-of 0 -2) 1)
+  (test (log-n-of 0 92 -451 317 -269 -300 245 461 -64) #b0)
+  (test (log-n-of 0 287) #b-100100000) ; (-288)
+  (test (log-n-of 0 -180 441 -487) #b10) ; (2)
+  (test (log-n-of 0 274 150) #b-110010111) ; (-407)
+  (test (log-n-of 0 140 -307 8 216 -392 8 -486 147 -469) #b100000000) ; (256)
+
+  (test (log-n-of 1 1 1) 0)
+  (test (log-n-of 1 1 2) 3)
+  (test (log-n-of 2 1 2) 0)
+  (test (log-n-of 2 2 2) 2)
+  (test (log-n-of 2 2 2 2) 0)
+  (test (log-n-of 3 2 2 2) 2)
+  (test (log-n-of 3 2 2 3) 2)
+  (test (log-n-of 3 2 1 3 3) 3)
+
+  (test (log-n-of 1 158 172 -4 432 147 497 -236 85 -454 -447) #b0) ; (0)
+  (test (log-n-of 1 377 -232 295) #b-110111010) ; (-442)
+  (test (log-n-of 1 -110) #b-1101110) ; (-110)
+  (test (log-n-of 1 304 -36 64 -140 -165 -85) #b0) ; (0)
+  (test (log-n-of 1 226 -135 -392 55 -358 260 -447) #b0) ; (0)
+  (test (log-n-of 1 -241 454 178 107 312) #b-1000000000) ; (-512)
+  (test (log-n-of 1 -122 419 -121) #b100000) ; (32)
+  (test (log-n-of 1 378 -233 -332 -308) #b1) ; (1)
+  (test (log-n-of 1 -381 44 -99 -161 338) #b100000) ; (32)
+
+  (test (log-n-of 2 6 -45 331 339 156 207 -308) #b-1000000000) ; (-512)
+  (test (log-n-of 2 -483) #b0) ; (0)
+  (test (log-n-of 2 -113 75 465 -434 -164 291) #b10010000) ; (144)
+  (test (log-n-of 2 -95 -314 187 40) #b-111110101) ; (-501)
+  (test (log-n-of 2 126 -254) #b10) ; (2)
+  (test (log-n-of 2 -228) #b0) ; (0)
+  (test (log-n-of 2 -472 163 6 -185 -208 -481 -60 -331 479) #b0) ; (0)
+  (test (log-n-of 2 357 -468 490 -423 33) #b-11111100) ; (-252)
+  (test (log-n-of 2 13 343 -276 148 -425 -116 361 -305 344 -361) #b100000) ; (32)
+  (test (log-n-of 2 -79) #b0) ; (0)
+
+  (test (log-n-of 3 268 134 46 -207 414) #b100001010) ; (266)
+  (test (log-n-of 3 455 -138 58 -225 -250) #b-111110000) ; (-496)
+  (test (log-n-of 3 -267 154 -217 468 -455 43 307 364) #b-101000000) ; (-320)
+  (test (log-n-of 3 14 197 65 -327 -86 -438) #b-100111101) ; (-317)
+  (test (log-n-of 3 229 452 434 -75 -405 440 -420 40) #b-111111111) ; (-511)
+  (test (log-n-of 3 -24 -450 437 -467 -487 -479 14 394 -433 53) #b110000000) ; (384)
+  (test (log-n-of 3 474 442 303 -203 -59) #b10111111) ; (191)
+  (test (log-n-of 3 -401 104 66) #b1000000) ; (64)
+  (test (log-n-of 3 -129 79 215 -272 -259) #b-101010110) ; (-342)
+  (test (log-n-of 3 -139 36 -489 352 -364 498 -11) #b10000001) ; (129)
+
+  (test (log-n-of 4 23) #b0) ; (0)
+  (test (log-n-of 4 407 225 417 269 -174 181 -332) #b100110100) ; (308)
+  (test (log-n-of 4 439 480 -278 168 189) #b0) ; (0)
+  (test (log-n-of 4 -206 295) #b0) ; (0)
+  (test (log-n-of 4 -260 24 -320) #b0) ; (0)
+  (test (log-n-of 4 354 -463 -66 137 -364) #b0) ; (0)
+  (test (log-n-of 4 -117 -68 -343 -285) #b-110000000) ; (-384)
+  (test (log-n-of 4 -206 -449 118 -211 -125 391 232) #b-11111011) ; (-251)
+  (test (log-n-of 4 -164 -499 -291 325 -143 -268 135 103) #b10000) ; (16)
+
+  (do ((i 0 (+ i 1)))
+      ((= i 10))
+
+    (let ((len (+ 1 (random 10)))
+	  (ints ())
+	  (n (random 5)))
+
+      (do ((k 0 (+ k 1)))
+	  ((= k len))
+	(set! ints (cons (- (random 1000) 500) ints)))
+
+      (let ((result (apply log-n-of n ints)))
+	;;(format #t "(test (log-n-of ~D ~{~D~^ ~}) #b~B) ; (~D)~%" n ints result result)
+
+	(do ((b 0 (+ b 1)))
+	    ((= b top-checked-bit))
+	  (let ((counts 0))
+	    (for-each
+	     (lambda (int)
+	       (if (logbit? int b) ;(not (zero? (logand int (ash 1 b))))
+		   (set! counts (+ counts 1))))
+	     ints)
+
+	    (if (logbit? result b) ;(not (zero? (logand result (ash 1 b))))
+		(if (not (= counts n))
+		    (format #t ";(log-n-of ~D ~{~D~^ ~}) -> ~A,  [#b~B, counts: ~D but we're on]~%" n ints result (ash 1 b) counts))
+		(if (and (> len 1) (= counts n))
+		    (format #t ";(log-n-of ~D ~{~D~^ ~}) -> ~A,  [#b~B, counts: ~D but we're off]~%" n ints result (ash 1 b) counts))))))))
+
+
+  (define (simple-log-n-of n . ints)     ; bits on in exactly n of ints
+    (let ((len (length ints)))
+      (cond ((= len 0) (if (= n 0) -1 0))
+	    ((= n 0)   (lognot (apply logior ints)))
+	    ((= n len) (apply logand ints))
+	    ((> n len) 0)
+	    (#t
+	     (do ((1s 0)
+		  (prev ints)
+		  (i 0 (+ i 1)))
+		 ((= i len) 1s)
+	       (let ((cur (ints i)))
+		 (if (= i 0)
+		     (set! 1s (logior 1s (logand cur (apply simple-log-n-of (- n 1) (cdr ints)))))
+		     (let* ((mid (cdr prev))
+			    (nxt (if (= i (- len 1)) () (cdr mid))))
+		       (set! (cdr prev) nxt)
+		       (set! 1s (logior 1s (logand cur (apply simple-log-n-of (- n 1) ints))))
+		       (set! (cdr prev) mid)
+		       (set! prev mid)))))))))
+
+  (num-test (simple-log-n-of 1 0 0 -1 0) -1)
+  (num-test (simple-log-n-of 1 0 -1 -1 0) 0)
+  (num-test (simple-log-n-of 2 0 -1 -1 0) -1)
+  (num-test (simple-log-n-of 2 0 -1 -1 -1) 0)
+  (num-test (simple-log-n-of 3 0 -1 -1 -1) -1)
+  (num-test (simple-log-n-of 4 0 -1 -1 -1) 0)
+
+  (do ((i 0 (+ i 1)))
+      ((= i 10))
+
+    (let ((len (+ 1 (random 10)))
+	  (ints ())
+	  (n (random 5)))
+
+      (do ((k 0 (+ k 1)))
+	  ((= k len))
+	(set! ints (cons (- (random 1000) 500) ints)))
+
+      (let ((result (apply simple-log-n-of n ints)))
+	(do ((b 0 (+ b 1)))
+	    ((= b top-checked-bit))
+	  (let ((counts 0))
+	    (for-each
+	     (lambda (int)
+	       (if (logbit? int b) ;(not (zero? (logand int (ash 1 b))))
+		   (set! counts (+ counts 1))))
+	     ints)
+
+	    (if (logbit? result b) ;(not (zero? (logand result (ash 1 b))))
+		(if (not (= counts n))
+		    (format #t ";(simple-log-n-of ~D ~{~D~^ ~}) -> ~A,  [#b~B, counts: ~D but we're on]~%" n ints result (ash 1 b) counts))
+		(if (and (> len 1) (= counts n))
+		    (format #t ";(simple-log-n-of ~D ~{~D~^ ~}) -> ~A,  [#b~B, counts: ~D but we're off]~%" n ints result (ash 1 b) counts)))))))))
+
+(let () ; from sbcl/contrib/sb-rotate-byte
+  (define (rotate-byte count bytespec integer)  ; logrot?
+    (let* ((size (car bytespec))
+	   (count (- count (* (round (/ count size)) size)))
+	   (mask (ash (- (ash 1 size) 1) (cdr bytespec)))
+	   (field (logand mask integer)))
+      (logior (logand integer (lognot mask))
+	      (logand mask
+		      (logior (ash field count)
+			      (ash field ((if (positive? count) - +) count size)))))))
+
+  (test (rotate-byte 6 (cons 8 0) -3) -129)
+  (test (rotate-byte 3 (cons 32 0) 3) 24)
+  (test (rotate-byte 3 (cons 16 0) 3) 24)
+  (test (rotate-byte 5 (cons 32 0) 5) 160)
+  (test (rotate-byte 5 (cons 32 0) (ash 1 26)) (ash 1 31)))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; logbit?
+;;; --------------------------------------------------------------------------------
+
+(test (logbit? 0 1) #f)
+(test (logbit? 0 0) #f)
+(test (logbit? 0 -1) 'error)
+(test (logbit? #b101 1) #f)
+(test (logbit? #b101 0) #t)
+(test (logbit? 1 3 6) 'error)
+(test (logbit? -1 3) #t)
+(test (logbit? -1 0) #t)
+(test (logbit? -6 0) #f)
+(test (logbit? -6 3) #t)
+(test (logbit? 4 1) #f)
+(test (logbit? 1 1) #f)
+(test (logbit? 1 0) #t)
+(test (logbit? -9223372036854775808 1) #f)
+(test (logbit? most-positive-fixnum 31) #t)
+(test (logbit? most-positive-fixnum 68) #f)
+(test (logbit? most-positive-fixnum 63) #f)
+(test (logbit? most-positive-fixnum 62) #t)
+(test (logbit? (ash 1 12) 12) #t)
+(test (logbit? (ash 1 12) 11) #f)
+(test (logbit? (ash 1 32) 32) #t)
+(test (logbit? (ash 1 31) 31) #t)
+(test (logbit? (ash 1 31) 30) #f)
+(test (logbit? (ash 1 31) 32) #f)
+(test (logbit? (ash 1 32) 31) #f)
+(test (logbit? (ash 1 62) 62) #t)
+(test (logbit? (ash 1 62) 61) #f)
+(test (logbit? -1 most-negative-fixnum) 'error)
+(test (logbit? most-negative-fixnum 63) #t)
+(test (logbit? most-negative-fixnum 62) #f)
+(test (logbit? -31 63) #t)
+(test (logbit? 1 most-positive-fixnum) #f)
+(test (logbit? 0 most-positive-fixnum) #f)
+(test (logbit? -1 most-positive-fixnum) #t)
+(test (logbit? -1 64) #t)
+(test (logbit? 1 64) #f)
+
+;;; (test (logbit? most-negative-fixnum most-positive-fixnum) #t) ;??
+(test (logbit? most-negative-fixnum most-negative-fixnum) 'error)
+(test (logbit? most-positive-fixnum most-positive-fixnum) #f)
+(test (logbit? (ash most-negative-fixnum 1) 1) #f)
+
+(when with-bignums
+  (test (logbit? (ash 1 64) 64) #t)
+  (test (logbit? (ash 1 64) 63) #f)
+  (test (logbit? most-negative-fixnum 63) #t)
+  (test (logbit? (bignum "-1") 64) #t))
+
+(test (logbit? 0 1.0) 'error)
+(test (logbit? 1+i) 'error)
+(test (logbit? 1+i 0) 'error)
+(test (logbit? 0 1/2) 'error)
+(test (logbit? 1.0 0) 'error)
+(test (logbit? 1/2 0) 'error)
+(test (logbit? -1/2 0) 'error)
+(test (logbit? 1/2 123123123) 'error)
+(test (logbit? 0 #\a) 'error)
+(test (logbit? 0 "hi") 'error)
+(test (logbit? #f ()) 'error)
+(test (logbit?) 'error)
+(test (logbit? 0) 'error)
+
+(test (logbit? -1/9223372036854775807 7) 'error)
+(test (logbit? -1/9223372036854775807 123123123) 'error)
+(test (logbit? 1/0 123123123) 'error)
+(test (logbit? (c-pointer 0) 123123123) 'error)
+
+(do ((i 0 (+ i 1)))
+    ((= i 100))
+  (let ((x (random most-positive-fixnum)) ; or most-negative-fixnum
+	(index (random 63)))
+    (let ((on? (logbit? x index))
+	  (ash? (not (zero? (logand x (ash 1 index))))))
+      (if (not (eq? on? ash?))
+	  (format #t "(logbit? ~A ~A): ~A ~A~%" x index on? ash?)))))
+
+(let () (define (f1) (do ((i 0 (+ i 1))) ((= i 1)) (logbit? i -1))) (test (f1) 'error)) ; logbit_b_ii error
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; ash
+;;; --------------------------------------------------------------------------------
+
+(num-test (ash #b-1100 -2) -3)
+(num-test (ash #b-1100 2) -48)
+(num-test (ash (ash 1 31) -31) 1)
+(num-test (ash (expt 2 31) (- (expt 2 31))) 0)
+(num-test (ash -0 -10) 0)
+(num-test (ash -1 -12)  -1)
+(num-test (ash -1 -3) -1)
+(num-test (ash -1 -8) -1)
+(num-test (ash -1 0) -1)
+(num-test (ash -1 30) -1073741824)
+(num-test (ash -1 8) -256)
+(num-test (ash -129876 -1026) -1)
+(num-test (ash -2 -3) -1)
+(num-test (ash -3 -3) -1)
+(num-test (ash -3 3) -24)
+(num-test (ash -31 -100) -1)
+(num-test (ash -31 -20) -1)
+(num-test (ash -31 -60) -1)
+(num-test (ash -31 -70) -1)
+(num-test (ash -31 most-negative-fixnum) -1)
+(num-test (ash 0 (expt 2 32)) 0)
+(num-test (ash 0 -10) 0)
+(num-test (ash 0 0) 0)
+(num-test (ash 0 1) 0)
+(num-test (ash 0 100) 0)
+(num-test (ash 1 (- (expt 2 31))) 0)
+(num-test (ash 1 (- (expt 2 32))) 0)
+(num-test (ash 1 -1) 0)
+(num-test (ash 1 -100) 0)
+(num-test (ash 1 10) 1024)
+(num-test (ash 1 31) 2147483648)
+(num-test (ash 1 32) 4294967296)
+(num-test (ash 1/1 10) 1024)
+(num-test (ash 1024 -8) 4)
+(num-test (ash 123 0) 123)
+(num-test (ash 1234 -6) 19)
+(num-test (ash 1234 6) 78976)
+(num-test (ash 12341234 -16) 188)
+(num-test (ash 12341234 6) 789838976)
+(num-test (ash 2 -1) 1)
+(num-test (ash 2 -2) 0)
+(test (> (ash 1 30) 1) #t)
+(test (> (ash 1 62) 1) #t)
+(test (ash most-positive-fixnum -2) 2305843009213693951)
+(test (ash most-positive-fixnum -62) 1)
+(test (ash (ash most-negative-fixnum -2) 2) most-negative-fixnum)
+;; (test (ash most-positive-fixnum 2) 'error) if not bignums?
+(num-test (ash 1000000000 -100000000000) 0)
+(num-test (ash -1 63) most-negative-fixnum)
+(num-test (* 2 (ash -1 62)) most-negative-fixnum)
+
+(do ((i 0 (+ i 1)))
+    ((= i 15))
+  (test (= (expt (ash 1 i) 2)
+	   (ash 1 (* 2 i))
+	   (expt 2 (* 2 i))
+	   (* (- (expt 2 i)) (- (ash 1 i)))
+	   (ash 2 (- (* i 2) 1)))
+	#t))
+
+(when with-bignums
+  (num-test (ash 1 48) 281474976710656)
+  (num-test (ash most-positive-fixnum 2) 36893488147419103228)
+  (num-test (ash 281474976710656 -48) 1)
+  (num-test (ash -100000000000000000000000000000000 -100) -79)
+  ;; (floor (/ -100000000000000000000000000000000 (expt 2 100))) = -79
+  (num-test (ash -100000000000000000000000000000000 -200) -1)
+  (num-test (ash 1 63) 9223372036854775808)
+  (num-test (ash 1 64) 18446744073709551616)
+  (num-test (ash 1 100) 1267650600228229401496703205376)
+  (num-test (ash 18446744073709551616 -63) 2)
+  (num-test (ash 1267650600228229401496703205376 -100) 1)
+  (test (ash 1 89) (expt 2 89))
+  (test (ash 1 0+92233720368547758081.0i) 'error)
+  (test (ash 1 92233720368547758081.0) 'error)
+  (test (ash 0+92233720368547758081.0i -1) 'error)
+  (test (ash 92233720368547758081.0 1) 'error)
+  (num-test (ash 9223372036854775807 1) 18446744073709551614)
+  (num-test (ash -9223372036854775807 1) -18446744073709551614)
+  (test (ash 4294967297 (ash 1 43)) 'error) ; else gmp aborts the program!
+  (test (ash 1 (ash 1 37)) 'error)
+  (test (ash 12 (ash 1 32)) 'error))       ;   not sure where the boundary is (malloc failure?)
+
+(test (ash 1 (expt 2 32)) 'error)
+(test (ash) 'error)
+(test (ash 1) 'error)
+(test (ash 1 2 3) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (ash 1 arg) 'error)
+   (test (ash arg 1) 'error))
+ (list #\a #f _ht_ _undef_ _null_ _c_obj_ #(1 2 3) 3.14 2/3 1.5+0.3i 1+i () 'hi abs "hi" #(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+
+(let ()
+  ;; fails if x=0: (define (2^n? x) (zero? (logand x (- x 1))))
+  (define (2^n? x) (and (not (zero? x)) (zero? (logand x (- x 1)))))
+  (define (2^n-1? x) (zero? (logand x (+ x 1))))
+  (define (x+y x y) (- x (lognot y) 1))
+  (define (0? x) (negative? (logand (lognot x) (- x 1))))
+  (define (<=0? x) (negative? (logior x (- x 1))))
+  (define (>=0? x) (negative? (lognot x)))
+  (define (>0? x) (negative? (logand (- x) (lognot x))))
+  (define-macro (<=> x y) `(begin (set! ,x (logxor ,x ,y)) (set! ,y (logxor ,y ,x)) (set! ,x (logxor ,x ,y))))
+
+  (test (2^n? 32) #t)
+  (test (2^n? 0) #f)
+  (test (2^n? 2305843009213693952) #t)
+  (test (2^n? 2305843009213693950) #f)
+  (test (2^n? 17) #f)
+  (test (2^n? 1) #t)
+  (test (2^n-1? 31) #t)
+  (test (2^n-1? 32) #f)
+  (test (2^n-1? 18014398509481985) #f)
+  (test (2^n-1? 18014398509481983) #t)
+  (test (x+y 41 3) 44)
+  (test (0? 0) #t)
+  (test (0? 123) #f)
+  (test (<=0? 0) #t)
+  (test (<=0? -2) #t)
+  (test (<=0? 2) #f)
+  (test (>=0? -1) #f)
+  (test (>0? 1) #t)
+  (test (let ((x 1) (y 321)) (<=> x y) (list x y)) (list 321 1))
+  )
+
+(unless with-bignums
+  ;; these added 28-Jan-18 but maybe they're a bad idea
+  (num-test #xffffffffffffffff -1)
+  (num-test #x7fffffffffffffff most-positive-fixnum)
+  (num-test #x7ffffffffffffffe (- most-positive-fixnum 1))
+  (num-test #x8000000000000000 most-negative-fixnum)
+  (num-test #x8000000000000001 (+ most-negative-fixnum 1))
+  (num-test #xfffffffffffffffe -2))
+
+(define (bit-reverse int)
+  ;; from "Hacker's Delight" Henry Warren p101, but 64 bit
+  (let ((x int))
+    (set! x (logior (ash (logand x #x5555555555555555) 1)
+		    (ash (logand x #xAAAAAAAAAAAAAAAA) -1)))
+    (set! x (logior (ash (logand x #x3333333333333333) 2)
+		    (ash (logand x #xCCCCCCCCCCCCCCCC) -2)))
+    (set! x (logior (ash (logand x #x0F0F0F0F0F0F0F0F) 4)
+		    (ash (logand x #xF0F0F0F0F0F0F0F0) -4)))
+    (set! x (logior (ash (logand x #x00FF00FF00FF00FF) 8)
+		    (ash (logand x #xFF00FF00FF00FF00) -8)))
+    (set! x (logior (ash (logand x #x0000FFFF0000FFFF) 16)
+		    (ash (logand x #xFFFF0000FFFF0000) -16)))
+    (logior (ash (logand x #x00000000FFFFFFFF) 32)
+	    (ash (logand x #xFFFFFFFF00000000) -32))))
+
+(let ((x (ash (bit-reverse #x01234566) -32)))
+  (num-test x  1721943168))
+
+(unless with-bignums
+  (test (let () (define (func) ((lambda* ((x 1)) (do ((i 0 (+ i 1))) ((= i 1) 1) (ash x 1234))))) (define (hi) (func)) (hi)) 'error))
+
+;; from CL spec
+(test (let ((str ""))
+	(let ((show (lambda (m x y)
+		      (set! str (string-append str (format #f "[m = #o~6,'0O, x = #o~6,'0O, y = #o~6,'0O] " m x y))))))
+	  (let ((m #o007750)
+		(x #o452576)
+		(y #o317407))
+	    (show m x y)
+	    (let ((z (logand (logxor x y) m)))
+	      (set! x (logxor z x))
+	      (set! y (logxor z y))
+	      (show m x y)))) str)
+      "[m = #o007750, x = #o452576, y = #o317407] [m = #o007750, x = #o457426, y = #o312557] ")
+
+
+#|
+    (DEFUN HAULONG (ARG)
+      (INTEGER-LENGTH (ABS ARG)))
+
+    (DEFUN HAIPART (X N)
+      (SETQ X (ABS X))
+      (IF (MINUSP N)
+          (LOGAND X (- (ASH 1 (- N)) 1))
+          (ASH X (MIN (- N (HAULONG X)) 0))))
+|#
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; truncate
+;;; --------------------------------------------------------------------------------
+
+(num-test (truncate (/ (- most-positive-fixnum 1) most-positive-fixnum)) 0)
+(num-test (truncate (/ -1 most-positive-fixnum)) 0)
+(num-test (truncate (/ 1 most-positive-fixnum)) 0)
+(num-test (truncate (/ most-negative-fixnum most-positive-fixnum)) -1)
+(num-test (truncate (/ most-positive-fixnum (- most-positive-fixnum 1))) 1)
+(num-test (truncate -0) 0)
+(num-test (truncate -0.0) 0)
+(num-test (truncate -0.1) 0)
+(num-test (truncate -0.9) 0)
+(num-test (truncate -1) -1)
+(num-test (truncate -1.1) -1)
+(num-test (truncate -1.9) -1)
+(num-test (truncate -1/10) 0)
+(num-test (truncate -1/2) 0)
+(num-test (truncate -100/3) -33)
+(num-test (truncate -11/10) -1)
+(num-test (truncate -17/2) -8)
+(num-test (truncate -19/10) -1)
+(num-test (truncate -2.225073858507201399999999999999999999996E-308) 0)
+(num-test (truncate -2/3) 0)
+(num-test (truncate -200/3) -66)
+(num-test (truncate -3/2) -1)
+(num-test (truncate -9/10) 0)
+(num-test (truncate -9223372036854775808) -9223372036854775808)
+(num-test (truncate 0) 0)
+(num-test (truncate 0.0) 0)
+(num-test (truncate 0.1) 0)
+(num-test (truncate 0.9) 0)
+(num-test (truncate 1) 1)
+(num-test (truncate 1.1) 1)
+(num-test (truncate 1.110223024625156799999999999999999999997E-16) 0)
+(num-test (truncate 1.9) 1)
+(num-test (truncate 1/10) 0)
+(num-test (truncate 1/2) 0)
+(num-test (truncate 100/3) 33)
+(num-test (truncate 11/10) 1)
+(num-test (truncate 17.3) 17)
+(num-test (truncate 19) 19)
+(num-test (truncate 19/10) 1)
+(num-test (truncate 2.4) 2)
+(num-test (truncate 2.5) 2)
+(num-test (truncate 2.6) 2)
+(num-test (truncate 2/3) 0)
+(num-test (truncate 200/3) 66)
+(num-test (truncate 3/2) 1)
+(num-test (truncate 9/10) 0)
+(num-test (truncate 9223372036854775807) 9223372036854775807)
+(num-test (truncate most-negative-fixnum) most-negative-fixnum)
+(num-test (truncate most-positive-fixnum) most-positive-fixnum)
+(num-test (truncate 1+0i) 1)
+
+(when with-bignums
+  (num-test (truncate 8388608.9999999995) 8388608)
+  (num-test (truncate -8388609.0000000005) -8388609)
+  (num-test (truncate -8388609.9999999995) -8388609))
+
+(test (= (truncate (* 111738283365989051/177100989030047175 1.0)) (truncate 130441933147714940/206745572560704147)) #t)
+(test (= (truncate (* 114243/80782 114243/80782 1.0)) (truncate (* 275807/195025 275807/195025))) #f)
+(test (= (truncate (* 131836323/93222358 131836323/93222358 1.0)) (truncate (* 318281039/225058681 318281039/225058681))) #f)
+(test (= (truncate (* 1393/985 1393/985 1.0)) (truncate (* 3363/2378 3363/2378))) #f)
+(test (= (truncate (* 1607521/1136689 1607521/1136689 1.0)) (truncate (* 3880899/2744210 3880899/2744210))) #f)
+(when with-bignums
+  (test (= (truncate (* 1855077841/1311738121 1855077841/1311738121 1.0)) (truncate (* 4478554083/3166815962 4478554083/3166815962))) #f)
+  (test (= (truncate (* 318281039/225058681 318281039/225058681 1.0)) (truncate (* 1855077841/1311738121 1855077841/1311738121))) #t))
+(test (= (truncate (* 19601/13860 19601/13860 1.0)) (truncate (* 47321/33461 47321/33461))) #f)
+(test (= (truncate (* 275807/195025 275807/195025 1.0)) (truncate (* 1607521/1136689 1607521/1136689))) #t)
+(test (= (truncate (* 3363/2378 3363/2378 1.0)) (truncate (* 19601/13860 19601/13860))) #t)
+(test (= (truncate (* 3880899/2744210 3880899/2744210 1.0)) (truncate (* 9369319/6625109 9369319/6625109))) #f)
+(test (= (truncate (* 47321/33461 47321/33461 1.0)) (truncate (* 114243/80782 114243/80782))) #f)
+(test (= (truncate (* 54608393/38613965 54608393/38613965 1.0)) (truncate (* 131836323/93222358 131836323/93222358))) #f)
+(test (= (truncate (* 9369319/6625109 9369319/6625109 1.0)) (truncate (* 54608393/38613965 54608393/38613965))) #t)
+
+(when with-bignums
+  (num-test (truncate (+ (expt 2.0 62) 512)) 4611686018427388416)
+  (num-test (truncate (+ (expt 2.0 62) 513)) 4611686018427388417)
+  (num-test (truncate (exact->inexact most-negative-fixnum)) most-negative-fixnum)
+  (test (truncate (exact->inexact most-positive-fixnum)) most-positive-fixnum)
+
+  (num-test (truncate 1e19) 10000000000000000000)
+  (num-test (truncate 1e32) 100000000000000000000000000000000)
+  (num-test (truncate -1e19) -10000000000000000000)
+  (num-test (truncate -1e32) -100000000000000000000000000000000)
+  (num-test (truncate 100000000000000000000000000000000/3) 33333333333333333333333333333333)
+  (num-test (truncate -100000000000000000000000000000000/3) -33333333333333333333333333333333)
+  (num-test (truncate 200000000000000000000000000000000/3) 66666666666666666666666666666666)
+  (num-test (truncate -200000000000000000000000000000000/3) -66666666666666666666666666666666)
+
+  (let-temporarily (((*s7* 'bignum-precision) 512))
+    (test (= (truncate (* 111760107268250945908601/79026329715516201199301 111760107268250945908601/79026329715516201199301 1.0))
+	     (truncate (* 269812766699283348307203/190786436983767147107902 269812766699283348307203/190786436983767147107902))) #f)
+    (test (= (truncate (* 1180872205318713601/835002744095575440 1180872205318713601/835002744095575440 1.0))
+	     (truncate (* 2850877693509864481/2015874949414289041 2850877693509864481/2015874949414289041))) #f)
+    (test (= (truncate (* 1362725501650887306817/963592443113182178088 1362725501650887306817/963592443113182178088 1.0))
+	     (truncate (* 3289910387877251662993/2326317944764069484905 3289910387877251662993/2326317944764069484905))) #f)
+    (test (= (truncate (* 14398739476117879/10181446324101389 14398739476117879/10181446324101389 1.0))
+	     (truncate (* 34761632124320657/24580185800219268 34761632124320657/24580185800219268))) #f)
+    (test (= (truncate (* 1572584048032918633353217/1111984844349868137938112 1572584048032918633353217/1111984844349868137938112 1.0))
+	     (truncate (* 3796553736732654909229441/2684568892382786771291329 3796553736732654909229441/2684568892382786771291329))) #f)
+    (test (= (truncate (* 16616132878186749607/11749380235262596085 16616132878186749607/11749380235262596085 1.0))
+	     (truncate (* 40114893348711941777/28365513113449345692 40114893348711941777/28365513113449345692))) #f)
+    (test (= (truncate (* 19175002942688032928599/13558774610046711780701 19175002942688032928599/13558774610046711780701 1.0))
+	     (truncate (* 46292552162781456490001/32733777552734744709300 46292552162781456490001/32733777552734744709300))) #f)
+    (test (= (truncate (* 202605639573839043/143263821649299118 202605639573839043/143263821649299118 1.0))
+	     (truncate (* 489133282872437279/345869461223138161 489133282872437279/345869461223138161))) #f)
+    (test (= (truncate (* 269812766699283348307203/190786436983767147107902 269812766699283348307203/190786436983767147107902 1.0))
+	     (truncate (* 1572584048032918633353217/1111984844349868137938112 1572584048032918633353217/1111984844349868137938112))) #t)
+    (test (= (truncate (* 2850877693509864481/2015874949414289041 2850877693509864481/2015874949414289041 1.0))
+	     (truncate (* 16616132878186749607/11749380235262596085 16616132878186749607/11749380235262596085))) #t)
+    (test (= (truncate (* 3289910387877251662993/2326317944764069484905 3289910387877251662993/2326317944764069484905 1.0))
+	     (truncate (* 19175002942688032928599/13558774610046711780701 19175002942688032928599/13558774610046711780701))) #t)
+    (test (= (truncate (* 34761632124320657/24580185800219268 34761632124320657/24580185800219268 1.0))
+	     (truncate (* 202605639573839043/143263821649299118 202605639573839043/143263821649299118))) #t)
+    (test (= (truncate (* 46292552162781456490001/32733777552734744709300 46292552162781456490001/32733777552734744709300 1.0))
+	     (truncate (* 111760107268250945908601/79026329715516201199301 111760107268250945908601/79026329715516201199301))) #f)
+    (test (= (truncate (* 489133282872437279/345869461223138161 489133282872437279/345869461223138161 1.0))
+	     (truncate (* 1180872205318713601/835002744095575440 1180872205318713601/835002744095575440))) #f)
+    (test (= (truncate (* 564459384575477049359/399133058537705128729 564459384575477049359/399133058537705128729 1.0))
+	     (truncate (* 1362725501650887306817/963592443113182178088 1362725501650887306817/963592443113182178088))) #f)
+    (test (= (truncate (* 5964153172084899/4217293152016490 5964153172084899/4217293152016490 1.0))
+	     (truncate (* 14398739476117879/10181446324101389 14398739476117879/10181446324101389))) #f)))
+
+(test (truncate) 'error)
+(test (truncate 1.23+1.0i) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (truncate arg) 'error))
+  (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+        #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(test (let () (define (func) (let ((x #f) (i 0)) (begin (do ((i 0 (+ i 1))) ((= i 1)) (truncate  -1e18))))) (define (hi) (func)) (hi)) (if with-bignums #t 'error))
+
+
+;;; --------------------------------------------------------------------------------
+;;; floor
+;;; --------------------------------------------------------------------------------
+
+(num-test (floor (+ 1 (expt 2 30))) 1073741825)
+(num-test (floor (/ (- most-positive-fixnum 1) most-positive-fixnum)) 0)
+(num-test (floor (/ -1 most-positive-fixnum)) -1)
+(num-test (floor (/ 1 most-positive-fixnum)) 0)
+(num-test (floor (/ most-negative-fixnum most-positive-fixnum)) -2)
+(num-test (floor -0) 0)
+(num-test (floor -0.0) 0)
+(num-test (floor -0.1) -1)
+(num-test (floor -0.9) -1)
+(num-test (floor -1) -1)
+(num-test (floor -1.1) -2)
+(num-test (floor -1.9) -2)
+(num-test (floor -1/10) -1)
+(num-test (floor -1/2) -1)
+(num-test (floor -100/3) -34)
+(num-test (floor -11/10) -2)
+(num-test (floor -17/2) -9)
+(num-test (floor -19/10) -2)
+(num-test (floor -2.225073858507201399999999999999999999996E-308) -1)
+(num-test (floor -2/3) -1)
+(num-test (floor -200/3) -67)
+(num-test (floor -3/2) -2)
+(num-test (floor -9/10) -1)
+(num-test (floor -9223372036854775808) -9223372036854775808)
+(num-test (floor 0) 0)
+(num-test (floor 0.0) 0)
+(num-test (floor 0.1) 0)
+(num-test (floor 0.9) 0)
+(num-test (floor 1) 1)
+(num-test (floor 1.0-00.i) 1)
+(num-test (floor 1.1) 1)
+(num-test (floor 1.110223024625156799999999999999999999997E-16) 0)
+(num-test (floor 1.9) 1)
+(num-test (floor 1/10) 0)
+(num-test (floor 1/2) 0)
+(num-test (floor 100/3) 33)
+(num-test (floor 11/10) 1)
+(num-test (floor 17.3) 17)
+(num-test (floor 19) 19)
+(num-test (floor 19/10) 1)
+(num-test (floor 2.5) 2)
+(num-test (floor 2.6) 2)
+(num-test (floor 2/3) 0)
+(num-test (floor 200/3) 66)
+(num-test (floor 3/2) 1)
+(num-test (floor 9/10) 0)
+(num-test (floor 9223372036854775807) 9223372036854775807)
+(num-test (floor most-negative-fixnum) most-negative-fixnum)
+(num-test (floor most-positive-fixnum) most-positive-fixnum)
+
+(num-test (floor (+ 0.7 8388608.0)) 8388608)
+(when with-bignums
+  (let-temporarily (((*s7* 'bignum-precision) 512))
+    (test (floor (cosh (bignum 128)))    19438542029972975461113368441787390363640875315414994428)
+    (test (ceiling (cosh (bignum 128)))  19438542029972975461113368441787390363640875315414994429)
+    (test (round (cosh (bignum 128)))    19438542029972975461113368441787390363640875315414994429)
+    (test (truncate (cosh (bignum 128))) 19438542029972975461113368441787390363640875315414994428)
+    (num-test (acosh 19438542029972975461113368441787390363640875315414994428) 128.0)))
+
+(if with-bignums
+    (begin
+      (num-test (floor 8388608.9999999995) 8388608)
+      (num-test (floor 8388607.9999999995) 8388607)
+      (num-test (floor 8388608.0000000005) 8388608)
+      (num-test (floor 9007199254740992.95) 9007199254740992)
+      (num-test (floor 9007199254740990.95) 9007199254740990)
+      (num-test (floor 9007199254740993.95) 9007199254740993)
+      (num-test (floor (+ 0.995 (expt 2.0 46))) 70368744177664)
+      (num-test (floor (+ 0.9995 (expt 2.0 45))) 35184372088832))
+    (begin
+      (test (floor 1e308) 'error)
+      (test (floor 1e19) 'error)
+      (test (floor -1e308) 'error)
+      (test (floor -1e19) 'error)))
+
+(test (= (floor (* 111738283365989051/177100989030047175 1.0)) (floor 130441933147714940/206745572560704147)) #t)
+(test (= (floor (* 114243/80782 114243/80782 1.0)) (floor (* 275807/195025 275807/195025))) #f)
+(test (= (floor (* 131836323/93222358 131836323/93222358 1.0)) (floor (* 318281039/225058681 318281039/225058681))) #f)
+(test (= (floor (* 1393/985 1393/985 1.0)) (floor (* 3363/2378 3363/2378))) #f)
+(test (= (floor (* 1607521/1136689 1607521/1136689 1.0)) (floor (* 3880899/2744210 3880899/2744210))) #f)
+(if with-bignums (test (= (floor (* 1855077841/1311738121 1855077841/1311738121 1.0)) (floor (* 4478554083/3166815962 4478554083/3166815962))) #f))
+(test (= (floor (* 19601/13860 19601/13860 1.0)) (floor (* 47321/33461 47321/33461))) #f)
+(test (= (floor (* 275807/195025 275807/195025 1.0)) (floor (* 1607521/1136689 1607521/1136689))) #t)
+(if with-bignums (test (= (floor (* 318281039/225058681 318281039/225058681 1.0)) (floor (* 1855077841/1311738121 1855077841/1311738121))) #t))
+(test (= (floor (* 3363/2378 3363/2378 1.0)) (floor (* 19601/13860 19601/13860))) #t)
+(test (= (floor (* 3880899/2744210 3880899/2744210 1.0)) (floor (* 9369319/6625109 9369319/6625109))) #f)
+(test (= (floor (* 47321/33461 47321/33461 1.0)) (floor (* 114243/80782 114243/80782))) #f)
+(test (= (floor (* 54608393/38613965 54608393/38613965 1.0)) (floor (* 131836323/93222358 131836323/93222358))) #f)
+(test (= (floor (* 9369319/6625109 9369319/6625109 1.0)) (floor (* 54608393/38613965 54608393/38613965))) #t)
+(test (let ()
+        (define (func)
+          (do ((_var_ #f)
+               (i 0 (+ i 1)))
+              ((= i 10000) _var_)
+            (set! _var_ (integer->char (floor 3441313796169221281/1720656898084610641)))))
+         (func))
+      #\x1)
+
+(when with-bignums
+  (num-test (floor (+ (expt 2.0 62) 512)) 4611686018427388416)
+  (num-test (floor (+ (expt 2.0 62) 513)) 4611686018427388417)
+  (num-test (floor (exact->inexact most-negative-fixnum)) most-negative-fixnum)
+  (test (floor (exact->inexact most-positive-fixnum)) most-positive-fixnum)
+
+  (num-test (floor 1e19) 10000000000000000000)
+  (num-test (floor 1e32) 100000000000000000000000000000000)
+  (num-test (floor -1e19) -10000000000000000000)
+  (num-test (floor -1e32) -100000000000000000000000000000000)
+  (num-test (floor 100000000000000000000000000000000/3) 33333333333333333333333333333333)
+  (num-test (floor -100000000000000000000000000000000/3) -33333333333333333333333333333334)
+  (num-test (floor 200000000000000000000000000000000/3) 66666666666666666666666666666666)
+  (num-test (floor -200000000000000000000000000000000/3) -66666666666666666666666666666667)
+
+  (test (= (floor (* 1180872205318713601/835002744095575440 1180872205318713601/835002744095575440 1.0))
+	   (floor (* 2850877693509864481/2015874949414289041 2850877693509864481/2015874949414289041))) #f)
+  (test (= (floor (* 1362725501650887306817/963592443113182178088 1362725501650887306817/963592443113182178088 1.0))
+	   (floor (* 3289910387877251662993/2326317944764069484905 3289910387877251662993/2326317944764069484905))) #f)
+  (test (= (floor (* 14398739476117879/10181446324101389 14398739476117879/10181446324101389 1.0))
+	   (floor (* 34761632124320657/24580185800219268 34761632124320657/24580185800219268))) #f)
+  (test (= (floor (* 202605639573839043/143263821649299118 202605639573839043/143263821649299118 1.0))
+	   (floor (* 489133282872437279/345869461223138161 489133282872437279/345869461223138161))) #f)
+  (test (= (floor (* 2850877693509864481/2015874949414289041 2850877693509864481/2015874949414289041 1.0))
+	   (floor (* 16616132878186749607/11749380235262596085 16616132878186749607/11749380235262596085))) #t)
+  (test (= (floor (* 34761632124320657/24580185800219268 34761632124320657/24580185800219268 1.0))
+	   (floor (* 202605639573839043/143263821649299118 202605639573839043/143263821649299118))) #t)
+  (test (= (floor (* 40114893348711941777/28365513113449345692 40114893348711941777/28365513113449345692 1.0))
+	   (floor (* 96845919575610633161/68480406462161287469 96845919575610633161/68480406462161287469))) #f)
+  (test (= (floor (* 46292552162781456490001/32733777552734744709300 46292552162781456490001/32733777552734744709300 1.0))
+	   (floor (* 111760107268250945908601/79026329715516201199301 111760107268250945908601/79026329715516201199301))) #f)
+  (test (= (floor (* 489133282872437279/345869461223138161 489133282872437279/345869461223138161 1.0))
+	   (floor (* 1180872205318713601/835002744095575440 1180872205318713601/835002744095575440))) #f)
+  (test (= (floor (* 5964153172084899/4217293152016490 5964153172084899/4217293152016490 1.0))
+	   (floor (* 14398739476117879/10181446324101389 14398739476117879/10181446324101389))) #f))
+
+(let ((val1 (catch #t (lambda () (floor 0.0)) (lambda args 'error)))
+      (val2 (catch #t (lambda () (floor -0.0)) (lambda args 'error))))
+  (test (equal? val1 val2) #t))
+
+(test (floor) 'error)
+(test (floor 1.23+1.0i) 'error)
+(test (floor 1.23 1.23) 'error)
+
+(let ()
+  (define (f1 x) (floor (/ x 3)))
+  (test (f1 6) 2)
+  (test (f1 7) 2)
+  (test (f1 7.3) 2))
+
+(for-each
+ (lambda (arg)
+   (test (floor arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (floor (atanh (logand))))) (define (hi) (func)) (hi)) 'error) ; floor_i_p real arg case
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; ceiling
+;;; --------------------------------------------------------------------------------
+
+(num-test (ceiling (/ (- most-positive-fixnum 1) most-positive-fixnum)) 1)
+(num-test (ceiling (/ -1 most-positive-fixnum)) 0)
+(num-test (ceiling (/ 1 most-positive-fixnum)) 1)
+(num-test (ceiling (/ most-negative-fixnum most-positive-fixnum)) -1)
+(num-test (ceiling (/ most-positive-fixnum (- most-positive-fixnum 1))) 2)
+(num-test (ceiling -.0001) 0)
+(num-test (ceiling -0) 0)
+(num-test (ceiling -0.0) 0)
+(num-test (ceiling -0.1) 0)
+(num-test (ceiling -0.9) 0)
+(num-test (ceiling -1) -1)
+(num-test (ceiling -1.1) -1)
+(num-test (ceiling -1.9) -1)
+(num-test (ceiling -1/10) 0)
+(num-test (ceiling -1/2) 0)
+(num-test (ceiling -100/3) -33)
+(num-test (ceiling -11/10) -1)
+(num-test (ceiling -17/2) -8)
+(num-test (ceiling -19/10) -1)
+(num-test (ceiling -2.225073858507201399999999999999999999996E-308) 0)
+(num-test (ceiling -2/3) 0)
+(num-test (ceiling -200/3) -66)
+(num-test (ceiling -2147483647.8) -2147483647)
+(num-test (ceiling -3/2) -1)
+(num-test (ceiling -9/10) 0)
+(num-test (ceiling -9223372036854775808) -9223372036854775808)
+(num-test (ceiling .0001) 1)
+(num-test (ceiling 0) 0)
+(num-test (ceiling 0.0) 0)
+(num-test (ceiling 0.1) 1)
+(num-test (ceiling 0.9) 1)
+(num-test (ceiling 1) 1)
+(num-test (ceiling 1.01e-123) 1)
+(num-test (ceiling 1.1) 2)
+(num-test (ceiling 1.110223024625156799999999999999999999997E-16) 1)
+(num-test (ceiling 1.9) 2)
+(num-test (ceiling 1/10) 1)
+(num-test (ceiling 1/2) 1)
+(num-test (ceiling 100/3) 34)
+(num-test (ceiling 11/10) 2)
+(num-test (ceiling 17.3) 18)
+(num-test (ceiling 19) 19)
+(num-test (ceiling 19/10) 2)
+(num-test (ceiling 2.4) 3)
+(num-test (ceiling 2.5) 3)
+(num-test (ceiling 2.6) 3)
+(num-test (ceiling 2/3) 1)
+(num-test (ceiling 200/3) 67)
+(num-test (ceiling 2147483646.8) 2147483647)
+(num-test (ceiling 3/2) 2)
+(num-test (ceiling 9/10) 1)
+(num-test (ceiling 9223372036854775807) 9223372036854775807)
+(num-test (ceiling most-negative-fixnum) most-negative-fixnum)
+(num-test (ceiling most-positive-fixnum) most-positive-fixnum)
+(num-test (ceiling 8922337203685477.9) 8922337203685478)
+
+(if with-bignums
+    (begin
+      (num-test (ceiling 8388608.0000000005) 8388609)
+      (num-test (ceiling 8388609.0000000005) 8388610)
+      (num-test (ceiling 8388607.9999999995) 8388608)
+      (num-test (ceiling 9223372036854775806.9) 9223372036854775807))
+    (begin
+      (test (ceiling 1e308) 'error)
+      (test (ceiling 1e19) 'error)
+      (test (ceiling -1e308) 'error)
+      (test (ceiling -1e19) 'error)
+
+      ;; but unfortunately (ceiling 9223372036854775806.9) => -9223372036854775808
+      ;;                   (ceiling 922337203685477580.9)  => 922337203685477632
+      ;;                   (ceiling 9223372036854770.9)    => 9223372036854770
+      ))
+
+(test (= (ceiling (* 111738283365989051/177100989030047175 1.0)) (ceiling 130441933147714940/206745572560704147)) #t)
+(test (= (ceiling (* 114243/80782 114243/80782 1.0)) (ceiling (* 275807/195025 275807/195025))) #f)
+(if with-bignums (test (= (ceiling (* 131836323/93222358 131836323/93222358 1.0)) (ceiling (* 318281039/225058681 318281039/225058681))) #f))
+(test (= (ceiling (* 1393/985 1393/985 1.0)) (ceiling (* 3363/2378 3363/2378))) #f)
+(test (= (ceiling (* 1607521/1136689 1607521/1136689 1.0)) (ceiling (* 3880899/2744210 3880899/2744210))) #f)
+(if with-bignums (test (= (ceiling (* 1855077841/1311738121 1855077841/1311738121 1.0)) (ceiling (* 4478554083/3166815962 4478554083/3166815962))) #f))
+(test (= (ceiling (* 19601/13860 19601/13860 1.0)) (ceiling (* 47321/33461 47321/33461))) #f)
+(test (= (ceiling (* 275807/195025 275807/195025 1.0)) (ceiling (* 1607521/1136689 1607521/1136689))) #t)
+(test (= (ceiling (* 318281039/225058681 318281039/225058681 1.0)) (ceiling (* 1855077841/1311738121 1855077841/1311738121))) #t)
+(test (= (ceiling (* 3363/2378 3363/2378 1.0)) (ceiling (* 19601/13860 19601/13860))) #t)
+(test (= (ceiling (* 3880899/2744210 3880899/2744210 1.0)) (ceiling (* 9369319/6625109 9369319/6625109))) #f)
+(test (= (ceiling (* 47321/33461 47321/33461 1.0)) (ceiling (* 114243/80782 114243/80782))) #f)
+(test (= (ceiling (* 54608393/38613965 54608393/38613965 1.0)) (ceiling (* 131836323/93222358 131836323/93222358))) #f)
+(test (= (ceiling (* 9369319/6625109 9369319/6625109 1.0)) (ceiling (* 54608393/38613965 54608393/38613965))) #t)
+
+(when with-bignums
+  (num-test (ceiling (+ (expt 2.0 62) 512)) 4611686018427388416)
+  (num-test (ceiling (+ (expt 2.0 62) 513)) 4611686018427388417)
+  (num-test (ceiling (exact->inexact most-negative-fixnum)) most-negative-fixnum)
+  (test (ceiling (exact->inexact most-positive-fixnum)) most-positive-fixnum)
+  (num-test (ceiling 123456789012345678901234567890.1) 123456789012345678901234567891)
+  (num-test (ceiling -123456789012345678901234567890.1) -123456789012345678901234567890)
+
+  (num-test (ceiling  9223372036854775806.7)  9223372036854775807)
+  (num-test (ceiling -9223372036854775807.9) -9223372036854775807)
+  (num-test (ceiling -1e19) -10000000000000000000)
+  (num-test (ceiling -1e32) -100000000000000000000000000000000)
+  (num-test (ceiling 100000000000000000000000000000000/3) 33333333333333333333333333333334)
+  (num-test (ceiling -100000000000000000000000000000000/3) -33333333333333333333333333333333)
+  (num-test (ceiling 200000000000000000000000000000000/3) 66666666666666666666666666666667)
+  (num-test (ceiling -200000000000000000000000000000000/3) -66666666666666666666666666666666)
+
+  (test (= (ceiling (* 1180872205318713601/835002744095575440 1180872205318713601/835002744095575440 1.0))
+	   (ceiling (* 2850877693509864481/2015874949414289041 2850877693509864481/2015874949414289041))) #f)
+
+  ;;      (test (= (ceiling (* 1362725501650887306817/963592443113182178088 1362725501650887306817/963592443113182178088 1.0))
+  ;;	       (ceiling (* 3289910387877251662993/2326317944764069484905 3289910387877251662993/2326317944764069484905))) #f)
+  ;; this requires much more precision (2048 bits)
+  (test (= (ceiling (* 1362725501650887306817/963592443113182178088 1362725501650887306817/963592443113182178088))
+	   (ceiling (* 3289910387877251662993/2326317944764069484905 3289910387877251662993/2326317944764069484905))) #f)
+
+  (test (= (ceiling (* 14398739476117879/10181446324101389 14398739476117879/10181446324101389 1.0))
+	   (ceiling (* 34761632124320657/24580185800219268 34761632124320657/24580185800219268))) #f)
+  (test (= (ceiling (* 16616132878186749607/11749380235262596085 16616132878186749607/11749380235262596085 1.0))
+	   (ceiling (* 40114893348711941777/28365513113449345692 40114893348711941777/28365513113449345692))) #f)
+  (test (= (ceiling (* 19175002942688032928599/13558774610046711780701 19175002942688032928599/13558774610046711780701 1.0))
+	   (ceiling (* 46292552162781456490001/32733777552734744709300 46292552162781456490001/32733777552734744709300))) #f)
+  (test (= (ceiling (* 202605639573839043/143263821649299118 202605639573839043/143263821649299118 1.0))
+	   (ceiling (* 489133282872437279/345869461223138161 489133282872437279/345869461223138161))) #f)
+  (test (= (ceiling (* 2850877693509864481/2015874949414289041 2850877693509864481/2015874949414289041 1.0))
+	   (ceiling (* 16616132878186749607/11749380235262596085 16616132878186749607/11749380235262596085))) #t)
+  (test (= (ceiling (* 34761632124320657/24580185800219268 34761632124320657/24580185800219268 1.0))
+	   (ceiling (* 202605639573839043/143263821649299118 202605639573839043/143263821649299118))) #t)
+  (test (= (ceiling (* 489133282872437279/345869461223138161 489133282872437279/345869461223138161 1.0))
+	   (ceiling (* 1180872205318713601/835002744095575440 1180872205318713601/835002744095575440))) #f)
+  (test (= (ceiling (* 564459384575477049359/399133058537705128729 564459384575477049359/399133058537705128729 1.0))
+	   (ceiling (* 1362725501650887306817/963592443113182178088 1362725501650887306817/963592443113182178088))) #f)
+  (test (= (ceiling (* 5964153172084899/4217293152016490 5964153172084899/4217293152016490 1.0))
+	   (ceiling (* 14398739476117879/10181446324101389 14398739476117879/10181446324101389))) #f)
+  (test (= (ceiling (* 96845919575610633161/68480406462161287469 96845919575610633161/68480406462161287469 1.0))
+	   (ceiling (* 564459384575477049359/399133058537705128729 564459384575477049359/399133058537705128729))) #t))
+
+(let ((val1 (catch #t (lambda () (ceiling 0.0)) (lambda args 'error)))
+      (val2 (catch #t (lambda () (ceiling -0.0)) (lambda args 'error))))
+  (test (equal? val1 val2) #t))
+
+(test (ceiling) 'error)
+(test (ceiling 1.23+1.0i) 'error)
+(test (ceiling 1.23 1.23) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (ceiling arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (ceiling (atanh (logand))))) (define (hi) (func)) (hi)) 'error)
+(test (integer? (let () (define (f) (let ((v (vector #f))) (do ((i 0 (+ i 1))) ((= i 1)) (vector-set! v 0 (ceiling 1.0))) (vector-ref v 0))) (f))) #t)
+(test (integer? (let () (define (f) (let ((v (vector #f))) (do ((i 0 (+ i 1))) ((= i 1)) (vector-set! v 0 (floor 1.0))) (vector-ref v 0))) (f))) #t)
+(test (integer? (let () (define (f) (let ((v (vector #f))) (do ((i 0 (+ i 1))) ((= i 1)) (vector-set! v 0 (round 1.0))) (vector-ref v 0))) (f))) #t)
+(test (integer? (let () (define (f) (let ((v (vector #f))) (do ((i 0 (+ i 1))) ((= i 1)) (vector-set! v 0 (truncate 1.0))) (vector-ref v 0))) (f))) #t)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (ceiling pi)))) (define (hi) (func)) (hi)) #t)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (floor pi)))) (define (hi) (func)) (hi)) #t)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (round pi)))) (define (hi) (func)) (hi)) #t)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (truncate pi)))) (define (hi) (func)) (hi)) #t)
+
+
+;;; --------------------------------------------------------------------------------
+;;; round
+;;; --------------------------------------------------------------------------------
+
+(num-test (round (/ (- most-positive-fixnum 1) most-positive-fixnum)) 1)
+(num-test (round (/ -1 most-positive-fixnum)) 0)
+(num-test (round (/ 1 most-positive-fixnum)) 0)
+(num-test (round (/ most-negative-fixnum most-positive-fixnum)) -1)
+(num-test (round -0) 0)
+(num-test (round -0.0) 0)
+(num-test (round -0.1) 0)
+(num-test (round -0.9) -1)
+(num-test (round -1) -1)
+(num-test (round -1.1) -1)
+(num-test (round -1.9) -2)
+(num-test (round -1/10) 0)
+(num-test (round -1/2) 0)
+(num-test (round -100/3) -33)
+(num-test (round -11/10) -1)
+(num-test (round -17/2) -8)
+(num-test (round -19/10) -2)
+(num-test (round -2.225073858507201399999999999999999999996E-308) 0)
+(num-test (round -2/3) -1)
+(num-test (round -200/3) -67)
+(num-test (round -3/2) -2)
+(num-test (round -9/10) -1)
+(num-test (round -9223372036854775808) -9223372036854775808)
+(num-test (round 0) 0)
+(num-test (round 0.0) 0)
+(num-test (round 0.1) 0)
+(num-test (round 0.9) 1)
+(num-test (round 1) 1)
+(num-test (round 1.1) 1)
+(num-test (round 1.110223024625156799999999999999999999997E-16) 0)
+(num-test (round 1.9) 2)
+(num-test (round 1/10) 0)
+(num-test (round 1/2) 0)
+(num-test (round 100/3) 33)
+(num-test (round 11/10) 1)
+(num-test (round 17.3) 17)
+(num-test (round 19) 19)
+(num-test (round 19/10) 2)
+(num-test (round 2.4) 2)
+(num-test (round 2.5) 2)
+(num-test (round 2.5) 2)
+(num-test (round 2.6) 3)
+(num-test (round 2/3) 1)
+(num-test (round 200/3) 67)
+(num-test (round 3.5) 4)
+(num-test (round 3/2) 2)
+(num-test (round 9/10) 1)
+(num-test (round 9223372036854775807) 9223372036854775807)
+(num-test (round most-negative-fixnum) most-negative-fixnum)
+(num-test (round most-positive-fixnum) most-positive-fixnum)
+
+(num-test (round (+ 8388608 .1)) 8388608)
+(num-test (round (+ 8388608 .9)) 8388609)
+(num-test (round (- 8388608 .1)) 8388608)
+(num-test (round (- 8388608 .9)) 8388607)
+
+(num-test (round 9007199254740990.501) 9007199254740991)
+(num-test (round 9007199254740990.499) 9007199254740990)
+
+(if with-bignums
+    (begin
+      (test (round (bignum +nan.0)) 'error)
+      (num-test (round 9007199254740992.51) 9007199254740993)
+      (num-test (round 9007199254740993.99) 9007199254740994))
+    (begin
+      (test (round 1e308) 'error)
+      (test (round 1e19) 'error)
+      (test (round -1e308) 'error)
+      (test (round -1e19) 'error)))
+
+(test (= (round (* 111738283365989051/177100989030047175 1.0)) (round 130441933147714940/206745572560704147)) #t)
+(test (= (round (* 114243/80782 114243/80782 1.0)) (round (* 275807/195025 275807/195025))) #t)
+(test (= (round (* 131836323/93222358 131836323/93222358 1.0)) (round (* 318281039/225058681 318281039/225058681))) #t)
+(test (= (round (* 1393/985 1393/985 1.0)) (round (* 3363/2378 3363/2378))) #t)
+(test (= (round (* 1607521/1136689 1607521/1136689 1.0)) (round (* 3880899/2744210 3880899/2744210))) #t)
+(if (provided? 'overflow-checks)
+    (test (= (round (* 1855077841/1311738121 1855077841/1311738121 1.0)) (round (* 4478554083/3166815962 4478554083/3166815962))) #t))
+(test (= (round (* 19601/13860 19601/13860 1.0)) (round (* 47321/33461 47321/33461))) #t)
+(test (= (round (* 275807/195025 275807/195025 1.0)) (round (* 1607521/1136689 1607521/1136689))) #t)
+(test (= (round (* 318281039/225058681 318281039/225058681 1.0)) (round (* 1855077841/1311738121 1855077841/1311738121))) #t)
+(test (= (round (* 3363/2378 3363/2378 1.0)) (round (* 19601/13860 19601/13860))) #t)
+(test (= (round (* 3880899/2744210 3880899/2744210 1.0)) (round (* 9369319/6625109 9369319/6625109))) #t)
+(test (= (round (* 47321/33461 47321/33461 1.0)) (round (* 114243/80782 114243/80782))) #t)
+(test (= (round (* 54608393/38613965 54608393/38613965 1.0)) (round (* 131836323/93222358 131836323/93222358))) #t)
+(test (= (round (* 9369319/6625109 9369319/6625109 1.0)) (round (* 54608393/38613965 54608393/38613965))) #t)
+
+(test (round 1.23 1.23) 'error)
+(test (round 1.23+1.0i) 'error)
+(test (round) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (round arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(num-test (round 400000000000000000/800000000000000001) 0)
+(num-test (round 400000000000000000/800000000000000000) 0)
+(num-test (round 400000000000000000/799999999999999999) 1)
+
+(when with-bignums
+  (num-test (round (+ (expt 2.0 62) 512)) 4611686018427388416)
+  (num-test (round (+ (expt 2.0 62) 513)) 4611686018427388417)
+  (num-test (round (exact->inexact most-negative-fixnum)) most-negative-fixnum)
+  (test (round (exact->inexact most-positive-fixnum)) most-positive-fixnum)
+
+  (num-test (round -1e19) -10000000000000000000)
+  (num-test (round -1e32) -100000000000000000000000000000000)
+  (num-test (round 100000000000000000000000000000000/3) 33333333333333333333333333333333)
+  (num-test (round -100000000000000000000000000000000/3) -33333333333333333333333333333333)
+  (num-test (round 200000000000000000000000000000000/3) 66666666666666666666666666666667)
+  (num-test (round -200000000000000000000000000000000/3) -66666666666666666666666666666667)
+
+  (test (= (round (* 1180872205318713601/835002744095575440 1180872205318713601/835002744095575440 1.0))
+	   (round (* 2850877693509864481/2015874949414289041 2850877693509864481/2015874949414289041))) #t)
+  (test (= (round (* 1362725501650887306817/963592443113182178088 1362725501650887306817/963592443113182178088 1.0))
+	   (round (* 3289910387877251662993/2326317944764069484905 3289910387877251662993/2326317944764069484905))) #t)
+  (test (= (round (* 14398739476117879/10181446324101389 14398739476117879/10181446324101389 1.0))
+	   (round (* 34761632124320657/24580185800219268 34761632124320657/24580185800219268))) #t)
+  (test (= (round (* 16616132878186749607/11749380235262596085 16616132878186749607/11749380235262596085 1.0))
+	   (round (* 40114893348711941777/28365513113449345692 40114893348711941777/28365513113449345692))) #t)
+  (test (= (round (* 202605639573839043/143263821649299118 202605639573839043/143263821649299118 1.0))
+	   (round (* 489133282872437279/345869461223138161 489133282872437279/345869461223138161))) #t)
+  (test (= (round (* 2850877693509864481/2015874949414289041 2850877693509864481/2015874949414289041 1.0))
+	   (round (* 16616132878186749607/11749380235262596085 16616132878186749607/11749380235262596085))) #t)
+  (test (= (round (* 34761632124320657/24580185800219268 34761632124320657/24580185800219268 1.0))
+	   (round (* 202605639573839043/143263821649299118 202605639573839043/143263821649299118))) #t)
+  (test (= (round (* 40114893348711941777/28365513113449345692 40114893348711941777/28365513113449345692 1.0))
+	   (round (* 96845919575610633161/68480406462161287469 96845919575610633161/68480406462161287469))) #t)
+  (test (= (round (* 489133282872437279/345869461223138161 489133282872437279/345869461223138161 1.0))
+	   (round (* 1180872205318713601/835002744095575440 1180872205318713601/835002744095575440))) #t)
+  (test (= (round (* 5964153172084899/4217293152016490 5964153172084899/4217293152016490 1.0))
+	   (round (* 14398739476117879/10181446324101389 14398739476117879/10181446324101389))) #t)
+  (test (= (round (* 96845919575610633161/68480406462161287469 96845919575610633161/68480406462161287469 1.0))
+	   (round (* 564459384575477049359/399133058537705128729 564459384575477049359/399133058537705128729))) #t))
+
+(test (equal? (let ((vals ()))
+		(do ((k 1/3 (+ k 1/3))) ((> k 2) (reverse vals))
+		  (set! vals (cons (round k) vals))))
+	      (list 0 1 1 1 2 2))
+      #t)
+(test (equal? (let ((vals ()))
+		(do ((k 1/3 (+ k 1/3))) ((> k 2) (reverse vals))
+		  (set! vals (cons (round (- k)) vals))))
+	      (list 0 -1 -1 -1 -2 -2))
+      #t)
+(test (equal? (let ((vals ()))
+		(do ((k 1/2 (+ k 1/2))) ((> k 3) (reverse vals))
+		  (set! vals (cons (round k) vals))))
+	      (list 0 1 2 2 2 3))
+      #t)
+(test (equal? (let ((vals ()))
+		(do ((k 1/2 (+ k 1/2))) ((> k 3) (reverse vals))
+		  (set! vals (cons (round (- k)) vals))))
+	      (list 0 -1 -2 -2 -2 -3))
+      #t)
+
+(let ((top-exp 60))
+  (if with-bignums
+      (set! top-exp 150))
+
+  (let ((happy #t))
+    (do ((i 2 (+ i 1)))
+	((or (not happy) (> i top-exp)))
+      (let* ((val1 (/ (- (expt 2 i) 1) 2))
+	     (val2 (expt 2 (- i 1)))
+	     (fv (floor val1))
+	     (rv (round val1))
+	     (cv (ceiling val1))
+	     (tv (truncate val1)))
+	(if (not (= fv (- val2 1)))
+	    (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv)))
+	(if (not (= cv val2))
+	    (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv)))
+	(if (not (= tv (- val2 1)))
+	    (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv)))
+	(if (not (= rv val2))
+	    (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv))))))
+
+  (let ((happy #t))
+    (do ((i 2 (+ i 1)))
+	((or (not happy) (> i top-exp)))
+      (let* ((val1 (/ (+ (expt 2 i) 1) 2))
+	     (val2 (expt 2 (- i 1)))
+	     (fv (floor val1))
+	     (rv (round val1))
+	     (cv (ceiling val1))
+	     (tv (truncate val1)))
+	(if (not (= fv val2))
+	    (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv)))
+	(if (not (= cv (+ val2 1)))
+	    (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv)))
+	(if (not (= tv val2))
+	    (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv)))
+	(if (not (= rv val2))
+	    (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv))))))
+
+  (let ((happy #t))
+    (do ((i 2 (+ i 1)))
+	((or (not happy) (> i top-exp)))
+      (let* ((val1 (expt 2 i))
+	     (val2 (- val1 1)))
+	(if (= (floor val1) (floor val2))
+	    (begin (set! happy #f) (format #t ";(floor ~S) = (floor ~S)?~%" val1 val2)))
+	(if (= (ceiling val1) (ceiling val2))
+	    (begin (set! happy #f) (format #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2)))
+	(if (= (truncate val1) (truncate val2))
+	    (begin (set! happy #f) (format #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2)))
+	(if (= (round val1) (round val2))
+	    (begin (set! happy #f) (format #t ";(round ~S) = (round ~S)?~%" val1 val2))))))
+
+  (let ((happy #t))
+    (do ((i 2 (+ i 1)))
+	((or (not happy) (> i top-exp)))
+      (let* ((val1 (/ (- (expt 2 i) 1) 2))
+	     (val2 (/ (- (expt 2 i) 3) 2)))
+	(if (= (floor val1) (floor val2))
+	    (begin (set! happy #f) (format #t ";(floor ~S) = (floor ~S)?~%" val1 val2)))
+	(if (= (ceiling val1) (ceiling val2))
+	    (begin (set! happy #f) (format #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2)))
+	(if (= (truncate val1) (truncate val2))
+	    (begin (set! happy #f) (format #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2)))
+	(if (= (round val1) (round val2))
+	    (begin (set! happy #f) (format #t ";(round ~S) = (round ~S)?~%" val1 val2))))))
+
+  (let ((happy #t)
+	(off-by 1/3))
+    (do ((i 2 (+ i 1)))
+	((or (not happy) (>= i top-exp)))
+      (let* ((val1 (/ (expt 2 i) 3))
+	     (fv (floor val1))
+	     (cv (ceiling val1))
+	     (tv (truncate val1))
+	     (rv (round val1)))
+	(if (not (= fv (- val1 off-by)))
+	    (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv)))
+	(if (not (= cv (+ val1 (- 1 off-by))))
+	    (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv)))
+	(if (not (= tv (- val1 off-by)))
+	    (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv)))
+	(if (= off-by 1/3)
+	    (if (not (= rv (- val1 off-by)))
+		(begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv)))
+	    (if (not (= rv (+ val1 (- 1 off-by))))
+		(begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv))))
+	(if (= off-by 1/3)
+	    (set! off-by 2/3)
+	    (set! off-by 1/3)))))
+
+  (let ((happy #t))
+    (do ((i 2 (+ i 1)))
+	((or (not happy) (> i top-exp)))
+      (let* ((val1 (- (/ (- (expt 2 i) 1) 2)))
+	     (val2 (- (expt 2 (- i 1))))
+	     (fv (floor val1))
+	     (rv (round val1))
+	     (cv (ceiling val1))
+	     (tv (truncate val1)))
+	(if (not (= fv val2))
+	    (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv)))
+	(if (not (= cv (+ val2 1)))
+	    (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv)))
+	(if (not (= tv (+ val2 1)))
+	    (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv)))
+	(if (not (= rv val2))
+	    (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv))))))
+
+  (let ((happy #t))
+    (do ((i 2 (+ i 1)))
+	((or (not happy) (> i top-exp)))
+      (let* ((val1 (- (/ (+ (expt 2 i) 1) 2)))
+	     (val2 (- (expt 2 (- i 1))))
+	     (fv (floor val1))
+	     (rv (round val1))
+	     (cv (ceiling val1))
+	     (tv (truncate val1)))
+	(if (not (= fv (- val2 1)))
+	    (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv)))
+	(if (not (= cv val2))
+	    (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv)))
+	(if (not (= tv val2))
+	    (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv)))
+	(if (not (= rv val2))
+	    (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv))))))
+
+  (let ((happy #t))
+    (do ((i 2 (+ i 1)))
+	((or (not happy) (> i top-exp)))
+      (let* ((val1 (- (expt 2 i)))
+	     (val2 (+ val1 1)))
+	(if (= (floor val1) (floor val2))
+	    (begin (set! happy #f) (format #t ";(floor ~S) = (floor ~S)?~%" val1 val2)))
+	(if (= (ceiling val1) (ceiling val2))
+	    (begin (set! happy #f) (format #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2)))
+	(if (= (truncate val1) (truncate val2))
+	    (begin (set! happy #f) (format #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2)))
+	(if (= (round val1) (round val2))
+	    (begin (set! happy #f) (format #t ";(round ~S) = (round ~S)?~%" val1 val2))))))
+
+  (let ((happy #t))
+    (do ((i 2 (+ i 1)))
+	((or (not happy) (> i top-exp)))
+      (let* ((val1 (- (/ (- (expt 2 i) 1) 2)))
+	     (val2 (- (/ (- (expt 2 i) 3) 2))))
+	(if (= (floor val1) (floor val2))
+	    (begin (set! happy #f) (format #t ";(floor ~S) = (floor ~S)?~%" val1 val2)))
+	(if (= (ceiling val1) (ceiling val2))
+	    (begin (set! happy #f) (format #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2)))
+	(if (= (truncate val1) (truncate val2))
+	    (begin (set! happy #f) (format #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2)))
+	(if (= (round val1) (round val2))
+	    (begin (set! happy #f) (format #t ";(round ~S) = (round ~S)?~%" val1 val2))))))
+
+  (let ((happy #t)
+	(off-by 2/3))
+    (do ((i 2 (+ i 1)))
+	((or (not happy) (>= i top-exp)))
+      (let* ((val1 (- (/ (expt 2 i) 3)))
+	     (fv (floor val1))
+	     (cv (ceiling val1))
+	     (tv (truncate val1))
+	     (rv (round val1)))
+	(if (not (= fv (- val1 off-by)))
+	    (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv)))
+	(if (not (= cv (+ val1 (- 1 off-by))))
+	    (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv)))
+	(if (not (= tv (+ val1 (- 1 off-by))))
+	    (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv)))
+	(if (= off-by 1/3)
+	    (if (not (= rv (- val1 off-by)))
+		(begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv)))
+	    (if (not (= rv (+ val1 (- 1 off-by))))
+		(begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv))))
+	(if (= off-by 1/3)
+	    (set! off-by 2/3)
+	    (set! off-by 1/3)))))
+  )
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; modulo
+;;; --------------------------------------------------------------------------------
+;;; (modulo x 0) -> x?  I seem to be getting errors instead; maxima returns x and refers to Section 3.4, of "Concrete Mathematics," by Graham, Knuth, and Patashnik
+;;; (mod x 1.0) = sawtooth
+
+(num-test (modulo (/ (expt 2 61)) (/ (expt 3 10))) 1/2305843009213693952)
+(num-test (modulo (/ (expt 2 61)) (/ (expt 3 20))) 1/2305843009213693952)
+(num-test (modulo (/ (expt 2 61)) 1/512) 1/2305843009213693952)
+(num-test (modulo -0.5 -1) -0.5)
+(num-test (modulo -1 -1) 0)
+(num-test (modulo -1 -10) -1)
+(num-test (modulo -1 -1234) -1)
+(num-test (modulo -1 -2) -1)
+(num-test (modulo -1 -3) -1)
+(num-test (modulo -1 -500029) -1)
+(num-test (modulo -1 1) 0)
+(num-test (modulo -1 10) 9)
+(num-test (modulo -1 1234) 1233)
+(num-test (modulo -1 2) 1)
+(num-test (modulo -1 3) 2)
+(num-test (modulo -1 500029) 500028)
+(num-test (modulo -1.5 -2) -1.5)
+(num-test (modulo -1.5 2) 0.5)
+(num-test (modulo -1/2 -1) -1/2)
+(num-test (modulo -1/2 -1.0) -0.5)
+(num-test (modulo -1/2 2) 3/2)
+(num-test (modulo -1/9223372036854775807 -1/3) -1/9223372036854775807)
+(num-test (modulo -1234 -1) 0)
+(num-test (modulo -1234 -10) -4)
+(num-test (modulo -1234 -1234) 0)
+(num-test (modulo -1234 -2) 0)
+(num-test (modulo -1234 -3) -1)
+(num-test (modulo -1234 -500029) -1234)
+(num-test (modulo -1234 1) 0)
+(num-test (modulo -1234 10) 6)
+(num-test (modulo -1234 1234) 0)
+(num-test (modulo -1234 2) 0)
+(num-test (modulo -1234 3) 2)
+(num-test (modulo -1234 500029) 498795)
+(num-test (modulo -13 -4) -1)
+(num-test (modulo -13 4) 3)
+(num-test (modulo -2 -1) 0)
+(num-test (modulo -2 -10) -2)
+(num-test (modulo -2 -1234) -2)
+(num-test (modulo -2 -2) 0)
+(num-test (modulo -2 -3) -2)
+(num-test (modulo -2 -500029) -2)
+(num-test (modulo -2 1) 0)
+(num-test (modulo -2 10) 8)
+(num-test (modulo -2 1234) 1232)
+(num-test (modulo -2 2) 0)
+(num-test (modulo -2 3) 1)
+(num-test (modulo -2 500029) 500027)
+(num-test (modulo -2/9223372036854775807 -2/3) -2/9223372036854775807)
+(num-test (modulo -3 -1) 0)
+(num-test (modulo -3 -10) -3)
+(num-test (modulo -3 -1234) -3)
+(num-test (modulo -3 -2) -1)
+(num-test (modulo -3 -3) 0)
+(num-test (modulo -3 -500029) -3)
+(num-test (modulo -3 1) 0)
+(num-test (modulo -3 1) 0)
+(num-test (modulo -3 10) 7)
+(num-test (modulo -3 1234) 1231)
+(num-test (modulo -3 2) 1)
+(num-test (modulo -3 3) 0)
+(num-test (modulo -3 500029) 500026)
+(num-test (modulo -3.1 -2.0) -1.1)
+(num-test (modulo -3.1 2.0) 0.9) ; parallels (modulo -3 2) -> 1
+(num-test (modulo -3.1 2.5) 1.9)
+(num-test (modulo -3.5 1.5) 1.0)
+(num-test (modulo -3/2 -2) -3/2)
+(num-test (modulo -3/2 2) 1/2)
+(num-test (modulo -500029 -1) 0)
+(num-test (modulo -500029 -10) -9)
+(num-test (modulo -500029 -1234) -259)
+(num-test (modulo -500029 -2) -1)
+(num-test (modulo -500029 -3) -1)
+(num-test (modulo -500029 -500029) 0)
+(num-test (modulo -500029 1) 0)
+(num-test (modulo -500029 10) 1)
+(num-test (modulo -500029 1234) 975)
+(num-test (modulo -500029 2) 1)
+(num-test (modulo -500029 3) 2)
+(num-test (modulo -500029 500029) 0)
+(num-test (modulo 0 -1) 0)
+(num-test (modulo 0 -10) 0)
+(num-test (modulo 0 -1234) 0)
+(num-test (modulo 0 -2) 0)
+(num-test (modulo 0 -3) 0)
+(num-test (modulo 0 -500029) 0)
+(num-test (modulo 0 1) 0)
+(num-test (modulo 0 10) 0)
+(num-test (modulo 0 1234) 0)
+(num-test (modulo 0 2) 0)
+(num-test (modulo 0 3) 0)
+(num-test (modulo 0 500029) 0)
+(num-test (modulo 0 86400) 0)
+(num-test (modulo 0.5 -2) -1.5)
+(num-test (modulo 0.5 -2.0) -1.5)
+(num-test (modulo 0.5 2.0) 0.5)
+(num-test (modulo 1 -1) 0)
+(num-test (modulo 1 -10) -9)
+(num-test (modulo 1 -1234) -1233)
+(num-test (modulo 1 -2) -1)
+(num-test (modulo 1 -3) -2)
+(num-test (modulo 1 -4) -3)
+(num-test (modulo 1 -500029) -500028)
+(num-test (modulo 1 1) 0)
+(num-test (modulo 1 10) 1)
+(num-test (modulo 1 1234) 1)
+(num-test (modulo 1 2) 1)
+(num-test (modulo 1 3) 1)
+(num-test (modulo 1 500029) 1)
+(num-test (modulo 1.5 1/3) 0.16666666666667)
+(num-test (modulo 1.5 1/4) 0.0)
+(num-test (modulo 1/2 -2) -3/2)
+(num-test (modulo 1/2 2) 1/2)
+(num-test (modulo 1/2305843009213693952 1/4) 1/2305843009213693952)
+(num-test (modulo 1/9223372036854775807 1/2) 1/9223372036854775807)
+(num-test (modulo 1/9223372036854775807 1/3) 1/9223372036854775807)
+(num-test (modulo 11/9223372036854775807 3/9223372036854775807) 2/9223372036854775807)
+(num-test (modulo 1234 -1) 0)
+(num-test (modulo 1234 -10) -6)
+(num-test (modulo 1234 -1234) 0)
+(num-test (modulo 1234 -2) 0)
+(num-test (modulo 1234 -3) -2)
+(num-test (modulo 1234 -500029) -498795)
+(num-test (modulo 1234 1) 0)
+(num-test (modulo 1234 10) 4)
+(num-test (modulo 1234 1234) 0)
+(num-test (modulo 1234 2) 0)
+(num-test (modulo 1234 3) 1)
+(num-test (modulo 1234 500029) 1234)
+(num-test (modulo 13 -4) -3)
+(num-test (modulo 13 4) 1)
+(num-test (modulo 13 4) 1)
+(num-test (modulo 19439282 4409.5) 2206.0)
+(num-test (modulo 2 -1) 0)
+(num-test (modulo 2 -10) -8)
+(num-test (modulo 2 -1234) -1232)
+(num-test (modulo 2 -2) 0)
+(num-test (modulo 2 -3) -1)
+(num-test (modulo 2 -500029) -500027)
+(num-test (modulo 2 1) 0)
+(num-test (modulo 2 10) 2)
+(num-test (modulo 2 1234) 2)
+(num-test (modulo 2 2) 0)
+(num-test (modulo 2 3) 2)
+(num-test (modulo 2 500029) 2)
+(num-test (modulo 2/9223372036854775807 2/3) 2/9223372036854775807)
+(num-test (modulo 3 -1) 0)
+(num-test (modulo 3 -1) 0)
+(num-test (modulo 3 -10) -7)
+(num-test (modulo 3 -1234) -1231)
+(num-test (modulo 3 -2) -1)
+(num-test (modulo 3 -3) 0)
+(num-test (modulo 3 -500029) -500026)
+(num-test (modulo 3 1) 0)
+(num-test (modulo 3 1) 0)
+(num-test (modulo 3 10) 3)
+(num-test (modulo 3 1234) 3)
+(num-test (modulo 3 2) 1)
+(num-test (modulo 3 2.5) 0.5)
+(num-test (modulo 3 3) 0)
+(num-test (modulo 3 500029) 3)
+(num-test (modulo 3.1 -2.0) -0.9)
+(num-test (modulo 3.1 2) 1.1)
+(num-test (modulo 3.1 2.0) 1.1)
+(num-test (modulo 3.5 1.5) 0.5)
+(num-test (modulo 3/2 1/3) 1/6)
+(num-test (modulo 3/2 1/4) 0)
+(num-test (modulo 3/2 3/10) 0)
+(num-test (modulo 3/3037000501 2/3037000501) 1/3037000501)
+(num-test (modulo 3/9223372036854775807 2/9223372036854775807) 1/9223372036854775807)
+(num-test (modulo 500029 -1) 0)
+(num-test (modulo 500029 -10) -1)
+(num-test (modulo 500029 -1234) -975)
+(num-test (modulo 500029 -2) -1)
+(num-test (modulo 500029 -3) -2)
+(num-test (modulo 500029 -500029) 0)
+(num-test (modulo 500029 1) 0)
+(num-test (modulo 500029 10) 9)
+(num-test (modulo 500029 1234) 259)
+(num-test (modulo 500029 2) 1)
+(num-test (modulo 500029 3) 1)
+(num-test (modulo 500029 500029) 0)
+(num-test (modulo 922337203685477 1/3) 0)
+(num-test (modulo 9223372036854775 1/3) 0)
+(num-test (modulo 92233720368547758 1/3) 0)
+(num-test (modulo 92233720368547758/23 1/3) 1/69)
+(num-test (modulo 922337203685477580 1/3) 0)
+(num-test (modulo 2755 13) 12)
+(num-test (modulo 56 2) 0)
+(num-test (modulo 148665 2) 1)
+(num-test (modulo 71862 203) 0)
+(num-test (modulo 21568911 41) 0)
+(num-test (modulo 15295874 111) 74)
+(num-test (modulo 20430054 41) 0)
+(num-test (modulo 248255254 767) 364)
+(num-test (modulo 510104442 5453) 3557)
+(num-test (modulo 242162410 41) 10)
+(num-test (modulo 660070972 74) 0)
+(num-test (modulo 6542405452 117) 37)
+(num-test (modulo 629448534 2) 0)
+(num-test (modulo 163873565922 155) 62)
+(num-test (modulo 1563464979842 442) 272)
+(num-test (modulo 3712337724 576173) 55085)
+(num-test (modulo 4380921044390 5) 0)
+(num-test (modulo 4097970629150 86) 16)
+(num-test (modulo 2090198664 1118) 398)
+(num-test (modulo 5275411661289 31857) 10521)
+(num-test (modulo 38602581835881 19) 8)
+(num-test (modulo 82578867500655 319) 174)
+(num-test (modulo 363169800 20) 0)
+(num-test (modulo 2033404107084 23374) 16730)
+(num-test (modulo 7438317458260 31213) 22165)
+(num-test (modulo 390609000 11) 1)
+(num-test (modulo 406117800 57) 39)
+(num-test (modulo 1008217762344 4403) 3922)
+(num-test (modulo 136581511784536 67022) 19220)
+(num-test (modulo 43293168048 1344610) 759878)
+(num-test (modulo 608503422693864 47) 0)
+(num-test (modulo 6945109296864 779) 722)
+(num-test (modulo 1346702251365156 435) 261)
+(num-test (modulo 1388225063690465 644) 525)
+(num-test (modulo 1200780158492850 91686) 60534)
+(num-test (modulo 1551193257090906 2656731) 2347158)
+(num-test (modulo 386512944051107445 17) 0)
+(num-test (modulo 1111364125679340 6) 0)
+(num-test (modulo 15858537083857314 21793) 0)
+(num-test (modulo 44179338013272 280645) 48872)
+(num-test (modulo 64149298745840 43808357) 20657028)
+(num-test (modulo 4412914630225794 515823) 281358)
+(num-test (modulo 169216424701305960 17) 14)
+(num-test (modulo 178335507754891305 817) 0)
+(num-test (modulo -9223372036854775808 -9223372036854775808) 0)
+(when with-bignums (num-test (modulo 1.110223024625156799999999999999999999997E-16 -9223372036854775808) -9.223372036854775807999999999999999888978E18))
+(num-test (modulo 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) 5.551115123125783999999999999999999999984E-17)
+(num-test (modulo 9223372036854775807 -9223372036854775808) -1)
+(num-test (modulo 9223372036854775807 9223372036854775807) 0)
+(num-test (modulo (+ (ash 1 54) 1) (ash 1 54)) 1)
+
+(num-test (modulo 8/3 3/2) 7/6)
+(num-test (modulo 37/8 17/12) 3/8)
+(num-test (modulo 12/19 41/29) 12/19)
+(num-test (modulo 389/84 99/70) 163/420)
+(num-test (modulo 1456/401 577/408) 65647/81804)
+(num-test (modulo 9097/1054 1393/985) 151213/1038190)
+(num-test (modulo 53963/20511 3363/2378) 59345521/48775158)
+(num-test (modulo 163963/24727 19601/13860) 83457868/85679055)
+(num-test (modulo 456564/125743 47321/33461) 3376518998/4207486523)
+(num-test (modulo 794525/301994 114243/80782) 7420654502/6098919827)
+(num-test (modulo 75261245/11350029 275807/195025) 2156154512513/2213539405725)
+(num-test (modulo 92819835/16483927 1607521/1136689) 26012508981414/18737098497703)
+(num-test (modulo 44957104/17087915 3880899/2744210) 11411052426451/9378565444430)
+(num-test (modulo 53715833/85137581 9369319/6625109) 53715833/85137581)
+(num-test (modulo 171928773/272500658 54608393/38613965) 171928773/272500658)
+(num-test (modulo 4178406761/630138897 131836323/93222358) 28610075152269757/29371516922929563)
+
+(num-test (modulo 1/9223372036 9223372036) 1/9223372036)
+(num-test (modulo 1/9223372036854775807 9223372036854775807) 1/9223372036854775807)
+(num-test (modulo 3/2 most-positive-fixnum) 3/2)
+(num-test (modulo most-negative-fixnum -1) 0)
+(num-test (modulo 100 -1/2) 0) ; was -1/2??
+(num-test (modulo 100 1/2) 0)
+(num-test (modulo 100.0 -0.5) 0.0)
+(num-test (modulo 100.0 -1/2) 0.0)
+(num-test (modulo 100 -0.5) 0.0)
+(num-test (modulo 9223372036854775807 2) 1)
+(num-test (modulo 2 -9223372036854775808) -9223372036854775806)
+(when with-bignums
+  (num-test (modulo 9223372036854775807 2.0) 1.0) ; depends on * and / handling (double)integer(x|y)! -- 0.0 in non-gmp case due to truncation error
+  (num-test (/ 9223372036854775807 2.0) 4.6116860184273879035E18)
+  (num-test (/ (bignum 9223372036854775807) 2.0) 4.6116860184273879035E18)
+  (num-test (floor 4.6116860184273879035E18) 4611686018427387903)
+  (num-test (* 2.0 4611686018427387903) 9.223372036854775806E18)
+  (num-test (* 4611686018427387903 2.0) 9.223372036854775806E18)
+  (num-test (modulo 9223372036854775807.0 2) 1.0)
+  (num-test (modulo 9223372036854775807.0 2.0) 1.0)
+  (num-test (modulo 10000000000000001 2.0) 1.0) ; even this is 0.0 in non-gmp case
+  (num-test (modulo -9223372036854775808 0.6931471805599453) 3.263807524297868999704069770118053384067E-1)
+  (num-test (modulo 2.0 -9223372036854775808) -9223372036854775806.0)
+  (num-test (modulo -1 10000000000000000.0) 9.999999999999999E15) ; non-gmp: 1e16
+  (num-test (modulo -1 1.176926334185099927039499553745174043786E17) 1.176926334185099917039499553745174043786E17)
+)
+(num-test (modulo -9223372036854775808 2) 0)
+
+(unless with-bignums
+  (test (modulo 3/2 most-negative-fixnum) 'error))
+
+(when with-bignums
+  (test (= (modulo 2.0 (* 318281039/225058681 318281039/225058681)) 0.0) #f)
+  (test (= (modulo (* 1855077841/1311738121 1855077841/1311738121) 2.0) 0.0) #f)
+  (num-test (modulo 3/2 most-negative-fixnum) -18446744073709551613/2)
+  (num-test (modulo (+ 2 (* 3 499127 495037 490459 468803)) (* 499127 495037 490459 468803)) 2)
+  (num-test (modulo -9223372036854775808 5.551115123125783999999999999999999999984E-17) 3.258027528318940824192395666614174842834E-17)
+  (num-test (modulo 12345678901234567890 12345678901234567) 890)
+  (num-test (modulo 12345678901234567890 3123) 1071)
+  (num-test (modulo 460683358924445799142 518) 0)
+  (num-test (modulo 113021475230160 74635) 67850)
+  (num-test (modulo 74228340534140364 363909) 357201)
+  (num-test (modulo 69242022961311060 48305942) 17170072)
+  (num-test (modulo 286967952870300 2273388) 2067312)
+  (num-test (modulo 302822258393413362492399 29) 0)
+  (num-test (modulo 10491072879382200 133) 0)
+  (num-test (modulo 167206737423420464 609) 539)
+  (num-test (modulo 72212583812867784 4888799) 1883149)
+  (num-test (modulo 4170116471639397292390 1798025) 1078815)
+  (num-test (modulo 83910330283522050 35224) 9282)
+  (num-test (modulo 275373383775647594346 66884092) 19813626)
+  (num-test (modulo 14656657495570695990 37) 7)
+  (num-test (modulo 95470974177676509874110 1219) 0)
+  (num-test (modulo 619506317623001424 5957) 3304)
+  (num-test (modulo 11268171656665155960 9858) 372)
+  (num-test (modulo 6172860073826160 5167394) 906830)
+  (num-test (modulo 26457493095663264 1491412) 1103724)
+  (num-test (modulo 8481384175941103284 313836405) 93136149)
+  (num-test (modulo 60356595775749199080 176098815946) 156894620552)
+  (num-test (modulo 611492274956002440 37) 0)
+  (num-test (modulo 164614611843685080 1711) 177)
+  (num-test (modulo 93177516542679418720 62197) 37333)
+  (num-test (modulo 938959746797519770440 127558) 0)
+  (num-test (modulo 137670522526899326250 200) 50)
+  (num-test (modulo 852063402206742880 41643478) 23771242)
+  (num-test (modulo 55947291202307909360 188546228) 125937196)
+  (num-test (modulo 12877971214039423262680 9832253830) 8120608300)
+  (num-test (modulo 192158415774146059920 53) 0)
+  (num-test (modulo 902814024155808960 1829) 434)
+  (num-test (modulo 1265864304573235487120 4921) 1295)
+  (num-test (modulo 14172662463567665400 95817) 38076)
+  (num-test (modulo 32171996211745702482324 2368555) 459984)
+  (num-test (modulo 971324258606045826300 4576748) 342908)
+  (num-test (modulo 2400649320046378377000 1704690) 165540)
+  (num-test (modulo 953233796456393760 18342152493) 178603257)
+  (num-test (modulo 28906333140964843080 236206740) 140736420)
+  (num-test (modulo 775403093708557121609032 41) 0)
+  (num-test (modulo 12587009808135760402860 2491) 1410)
+  (num-test (modulo 510685807527370566909720 76) 44)
+  (num-test (modulo 9842598153710524682146590 10089) 3363)
+  (num-test (modulo 44936631038618189620242012 30740) 24592)
+  (num-test (modulo 934589372977008750144 373650) 202194)
+  (num-test (modulo 33027125273398900134069150 840577803) 0)
+  (num-test (modulo 4428219127938822420288 1695783782) 1071746452)
+  (num-test (modulo 29316428815807608915440 560764380) 415244720)
+  (num-test (modulo 1364397376360544429904 19) 0)
+  (num-test (modulo 4991450791697293128313385277 329) 133)
+  (num-test (modulo 75448279792981695149550 3009) 2385)
+  (num-test (modulo 181031604499464166188731133 3364) 1641)
+  (num-test (modulo 405831142402606479845286 2746214) 1938504)
+  (num-test (modulo 89170366469003867207160 25337230) 23157930)
+  (num-test (modulo 13523725766340619200 1490114045) 621483730)
+  (num-test (modulo 104705939487154940255412 192200052) 48253032)
+  (num-test (modulo 7232591421499800642000 16584679460) 4668328860)
+  (num-test (modulo 14043796716396386984750160 33382708236) 717907704)
+  (num-test (modulo 13894638105872256412416 23) 0)
+  (num-test (modulo 147611447155643499428400 118) 68)
+  (num-test (modulo 13356594697070649024 4558) 1802)
+  (num-test (modulo 15089731174706036171537760 90) 60)
+  (num-test (modulo 307230141273924828960 1971507) 1430805)
+  (num-test (modulo 2582563944548247741930009096 22873474) 3518996)
+  (num-test (modulo 1074296602920111687342072 146235518) 73672588)
+  (num-test (modulo 774058642832724262993980 407557010) 187324340)
+  (num-test (modulo 291091930213008490369569480 13412544348) 10762778160)
+  (num-test (modulo 2089068565149831833568 7302038455228) 470177842332)
+  (num-test (modulo 1064437567441124038217970656 5) 1)
+  (num-test (modulo 142557826750459447787460 1333) 527)
+  (num-test (modulo 311779340580033594160200 23693) 0)
+  (num-test (modulo 29314187023691666530559664 110143) 0)
+  (num-test (modulo 222003853016244177637944900 857463) 0)
+  (num-test (modulo 6247776111945111006243552 77976501) 12576855)
+  (num-test (modulo 1140058514761397155259712 5530338) 502758)
+  (num-test (modulo 580962736822969724865449808 55686036) 13545252)
+  (num-test (modulo 4100502596989506786787500 45333475410) 13925822190)
+  (num-test (modulo 1497378750311599979536944 262630276090) 236984817664)
+  (num-test (modulo 105637634198318524045536 2633013240) 452166936)
+  (num-test (modulo 11415822547029425161364106595632 7) 3)
+  (num-test (modulo 198305933339312916107438448 177) 15)
+  (num-test (modulo 3127415425979879537134790928 3335) 2668)
+  (num-test (modulo 589703503861221139260034914750 13209) 4641)
+  (num-test (modulo 3108579252052448504121792 14322) 12936)
+  (num-test (modulo 636976201153021006473464400 66264077) 55801328)
+  (num-test (modulo 9544425315508129998909285900 1488396) 850512)
+  (num-test (modulo 458100280193857502802977376 260747103934) 17656078468)
+  (num-test (modulo 114208186302155358124900650 22076867505) 6602131305)
+  (num-test (modulo 90107067439719108194114160 28566806069714) 24735629596458)
+  (num-test (modulo 2976572787365723002218245484 110104803958578) 49695655366500)
+  (num-test (modulo 53453375725613238735360 17) 7)
+  (num-test (modulo 888822833524306124874229800 106) 0)
+  (num-test (modulo 21275338550698297089687698855820 3021) 0)
+  (num-test (modulo 417525245705449941528380320750068 5828) 0)
+  (num-test (modulo 1954871230146370370001829871352 22765249) 0)
+  (num-test (modulo 903057827710908645847577520 648545995) 631903275)
+  (num-test (modulo 6002846634833433581621040 28493572159) 8965596645)
+  (num-test (modulo 26428903214964558277189300080 100428856) 20778384)
+  (num-test (modulo 470486531607553676511206181180 28495896) 23264436)
+  (num-test (modulo 483599554429365539310928369206620 5577334078910) 3472679709510)
+  (num-test (modulo 134511400157705323668887400 1285071093558916) 114037248705380)
+  (num-test (modulo 25897125642468049125349982599216 1183846707540) 999692775256)
+  (num-test (modulo 1118034209930460291955200 3) 0)
+  (num-test (modulo 16297594064835666104344589410644 413) 0)
+  (num-test (modulo 536762539932642345554192060100 1378) 0)
+  (num-test (modulo 933250179448203335817687635834340 58029) 55821)
+  (num-test (modulo 65573457048202714607131200 486115) 32895)
+  (num-test (modulo 85664559165674439863772868932 322014) 0)
+  (num-test (modulo 7232817686074320060728552759760 11307940) 0)
+  (num-test (modulo 78400098291720425971762131120 5646921093) 0)
+  (num-test (modulo 345445746644065669842240 19727989065) 1869036660)
+  (num-test (modulo 627854758484491743169777558200 750371721805653) 32673867918264)
+  (num-test (modulo 788233263079483492974876830792850 7170146100) 1202847750)
+  (num-test (modulo 18378856389802641496737518160 6247594493140) 1385698158460)
+  (num-test (modulo 9620902642431357480148667659080 59) 0)
+  (num-test (modulo 16008524600631853118144316000 629) 620)
+  (num-test (modulo 4342138447708715023205684275423920 53041) 5133)
+  (num-test (modulo 2431833161592653384508687244500 47541) 0)
+  (num-test (modulo 39424620224103957589082132160 1671734) 0)
+  (num-test (modulo 652830233576052788654372406432 552231327) 231166602)
+  (num-test (modulo 6892963340916411083970414000 3662431431) 935088876)
+  (num-test (modulo 29102758215190063506219566460000 10565720) 0)
+  (num-test (modulo 21253900104556838003127171970777418412 1182797770) 1026303562)
+  (num-test (modulo 3964268932242030284914943132662620 21244177854110) 13576270590290)
+  (num-test (modulo 6070388091189460078138338240 40809131994181213) 6560348180153677)
+  (num-test (modulo 9685989954133695108793384134000 964113514382876) 108668324726468)
+  (num-test (modulo 56468122001858834917195045500 429400787158167902) 411466139739284938)
+  (num-test (modulo 18843408973202596901221568364900 47) 0)
+  (num-test (modulo 7800980538292163259967028613764250 6) 0)
+  (num-test (modulo 270433907726619219545089642715200 3422) 3132)
+  (num-test (modulo 45771666919597903071546708768 2342359) 1698374)
+  (num-test (modulo 47198294949461301503537593835384892 314502) 130548)
+  (num-test (modulo 3165335901519110207943908102359110 14953473) 10646010)
+  (num-test (modulo 189219585097956261544520863361400 35605794) 0)
+  (num-test (modulo 38532137569034426600955256933810890813 1341358608707) 100754920326)
+  (num-test (modulo 1396277868664090735481380981225896 312520860) 187512516)
+  (num-test (modulo 864038349500762576564773759109700 714136202724) 614489290716)
+  (num-test (modulo 12514185871591242579049167322464 10706997440178) 749897068284)
+  (num-test (modulo 1981802660405609330969478067056636 33312289752) 27681419124)
+  (num-test (modulo 979313401024175219420658240 125278417383795) 92954907481995)
+  (num-test (modulo 4074026154111369481048033354344 29) 0)
+  (num-test (modulo 599666571180604695702511920885005100 129) 0)
+  (num-test (modulo 5703263639326551702474610108800 1978) 0)
+  (num-test (modulo 134137932950214683609064669163440 190619) 115401)
+  (num-test (modulo 344735091370772631136645455600 1048985) 0)
+  (num-test (modulo 6759508339299085316106145385400 4969610) 1763410)
+  (num-test (modulo 700334422308861928135313594400 228529587) 194401350)
+  (num-test (modulo 10277417891211405957191810814198480 2516552038) 1372664748)
+  (num-test (modulo 490099971577877358878082782880 9282588354) 7843699422)
+  (num-test (modulo 1954558750269048828645390249600 5575829490) 2295929790)
+  (num-test (modulo 1360588454560018295496656378989200 7868178296420) 3049105010900)
+  (num-test (modulo 4337552841738910859248770564912480 17722936528737830) 1203686858124400)
+  (num-test (modulo 215913068853045803981566931862756 7009479781500) 1803638466756)
+  (num-test (modulo 44890707654126305940250882318870941900 18329973480720) 7637488950300)
+  (num-test (modulo 28579720891831355496720656680837200 3) 0)
+  (num-test (modulo 29332703209780553199747293473184160 1711) 551)
+  (num-test (modulo 3648979393315349438003046604440000 186) 0)
+  (num-test (modulo 1159760236369472473822068077011807878780 25714) 0)
+  (num-test (modulo 158186359726371025615685433600 31395) 17940)
+  (num-test (modulo 331091450443070201468559735703944 28424) 0)
+  (num-test (modulo 9734443639363161342241553023288200 1961348207) 1708271019)
+  (num-test (modulo 701896612128009033011419603540080 51300) 47880)
+  (num-test (modulo 86169288128517384618860929451245320 5032162527446) 925322642976)
+  (num-test (modulo 64828800524794653881296183831741773624 4645294472) 311380888)
+  (num-test (modulo 49068907706533938991402184550000 268183371225) 262983139650)
+  (num-test (modulo 1708602980304476478496020543612288 4083128544) 131713824)
+  (num-test (modulo 17608179287674151740172985536160 980399424528) 962337263616)
+  (num-test (modulo 43194437079731225735521919644800 178119261126453036) 70796157206439912)
+  (num-test (modulo 817555977437791699707628651571149344 59) 0)
+  (num-test (modulo 19062946261334997559157066059536 533) 287)
+  (num-test (modulo 6533849124840489114353090499099000 598) 130)
+  (num-test (modulo 427663965127849896842400211428345149025 234) 117)
+  (num-test (modulo 352395507261316174741530450071590608 154734) 26418)
+  (num-test (modulo 391579493632653867660919800000 9221565) 1166160)
+  (num-test (modulo 2618798923882923048581401148931738000 681876) 419616)
+  (num-test (modulo 174712575449141140214591110997980800 233260339838) 37341839152)
+  (num-test (modulo 88598141227372995032227898284800 1929763976) 1797148024)
+  (num-test (modulo 210110141308655567793064872567302676320 720390430628) 523536832148)
+  (num-test (modulo 668425085137718599277317523827419000 19898594339442) 17330916357006)
+  (num-test (modulo 89533471731097208414073727453200 4173840860670546) 1611748174428756)
+  (num-test (modulo 113987439157802480362236410675251462620 21548296273949445) 20414175417425790)
+  (num-test (modulo 48129335993995093308894209644253760 1009442888504820) 947047755795120)
+  (num-test (modulo 3497836376962291922989777163497680 138736290091634664) 23686683674181528)
+  (num-test (modulo 11371924962562208722154622794880 3) 0)
+  (num-test (modulo 9451631862008339290824315653784000 703) 171)
+  (num-test (modulo 16869347753325980368094612370435598560 806) 0)
+  (num-test (modulo 4701845646467068759127854100132739552 3198) 504)
+  (num-test (modulo 1029865193584911347147121232800485280 1005771) 24531)
+  (num-test (modulo 10657125216930337802109861408000 2415138) 2210802)
+  (num-test (modulo 14382707743772734802155022983680 247913634) 7969170)
+  (num-test (modulo 60134748581470366378101904574533857248 54828228) 9878960)
+  (num-test (modulo 214830664120540781167218700750596000 505665810) 223433730)
+  (num-test (modulo 48933004118344447687599112101802800 6263883444) 849340128)
+  (num-test (modulo 5498670161558110606435630054129739400 262699548132) 255270333864)
+  (num-test (modulo 35941673649029587182509620977230062500 25622409466332) 7911836749404)
+  (num-test (modulo 1592802602494326390643157055239113248 736377633395508) 260180363298804)
+  (num-test (modulo 4043816553144402557587143272522043028314 5011466158645380) 1781651263267134)
+  (num-test (modulo 7171921165220830707276631005512550 1765284492289500) 1588756043060550)
+  (num-test (modulo 2402189359210218692854826119405968750 23) 22)
+  (num-test (modulo 26149068753160488131648964110990162400 1147) 868)
+  (num-test (modulo 556184059176863945810376239306506311552 4089) 0)
+  (num-test (modulo 67871323087036310486238021899264593800 13395) 0)
+  (num-test (modulo 12750401179065252879838440979200 7177173) 0)
+  (num-test (modulo 278110245000092733617125071646080 17748) 0)
+  (num-test (modulo 13408203364935178481017292708752000 50619404) 13680920)
+  (num-test (modulo 124271828931784534297423756437875067000 8839796595) 1143112215)
+  (num-test (modulo 11893442806922081156953529319100769836176 972789007267) 210492262442)
+  (num-test (modulo 352581052555284857902053030133344488264100 923561430099) 488944286523)
+  (num-test (modulo 6108908012714804315575319947340956346976 31944833628092) 28158060036920)
+  (num-test (modulo 67475643422116264959949054821520228800 22515435540) 8157766500)
+  (num-test (modulo 470601888939348535946408832 5135943991060962937) 4475576385383445628)
+  (num-test (modulo 110759232155568113345545635903016614000 30159198663300) 0)
+  (num-test (modulo 146100914712024458707469587112300146320 26868173101560) 24880219882560)
+  (num-test (modulo 12173192708601511002951184416658091200 466645866900785428350) 288583529752854077950)
+  (num-test (modulo 5784684831478746253226687170890240 13) 0)
+  (num-test (modulo 35042260655085685815432622412891903767500 667) 0)
+  (num-test (modulo 2903871349270676921837488659419545120987500 530) 0)
+  (num-test (modulo 630123969240840167098426767919876491188000 77691) 51794)
+  (num-test (modulo 33192703032132982013024959634241667249800 4684718) 4051648)
+  (num-test (modulo 4731525733734729472809717145544850000 90706055) 0)
+  (num-test (modulo 214011009809686092216200126896120006823232 50400042) 45006552)
+  (num-test (modulo 5854250735296111435541950856160000 24357777002) 2121729090)
+  (num-test (modulo 35348208247612761916374738259136697649608 156806713508) 8948839908)
+  (num-test (modulo 612558317420289618714916924536521515286100 2377007388) 375316956)
+  (num-test (modulo 181857299802925368992522029882739454720 21606337755618) 0)
+  (num-test (modulo 4731635341196946327443020710970699860000 58092526675092) 44387995860156)
+  (num-test (modulo 22081740554432638182773611616166588288192 61419768950540) 49135815160432)
+  (num-test (modulo 125627844706077784535328068665849312000 30482033400) 19356933400)
+  (num-test (modulo 1225504716872819103560254268197955520 510813364186125) 233201076344145)
+  (num-test (modulo 5209185280578468690281136425214396728400 2327880739319250103818) 518788605323339989776)
+  (num-test (modulo 230425011604643097634961294406535254400 31) 0)
+  (num-test (modulo 13222608481676137093434201748083744000 893) 0)
+  (num-test (modulo 13348198818240350339028224064019716678960 651) 117)
+  (num-test (modulo 7236172685650198160266777676385295337308176 23426) 14144)
+  (num-test (modulo 756264162229440667711265021676693350760 28899) 0)
+  (num-test (modulo 40915062421030872924283823601517905600 36345062) 0)
+  (num-test (modulo 1174590526522170015825602834292923520 4991486258) 1554170940)
+  (num-test (modulo 2891892862328155581145450075391651333218020 35138529818) 0)
+  (num-test (modulo 1993335355070485984559797658834121810059400 535644500) 433741400)
+  (num-test (modulo 6324295450641455215591954662726515160 367472693133) 134441229195)
+  (num-test (modulo 6576388154814679090356195121505112000 15901952377630) 3827367890390)
+  (num-test (modulo 117828556355409428513249595788296238400 565992666495795) 106570976318730)
+  (num-test (modulo 592831716700236607285748949860604000 139641978135660) 133123065151440)
+  (num-test (modulo 106766839071170184723986891291602032000 1584924526628112) 785519540106048)
+  (num-test (modulo 21677148858122146832326483307664860804937400 247815827510760) 183567279637600)
+  (num-test (modulo 14079549844487257384278196623697173813600 160967604100961853832) 160644118308938243512)
+  (num-test (modulo 2696480372014145687016224877963234647656980 2219319031453896088860) 1749775073012430835800)
+  (num-test (modulo 13545431257849875145060979241270859310160 29) 0)
+  (num-test (modulo 137485634482479300158725199474868559498162500 329) 188)
+  (num-test (modulo 529252417743761759027305009539254400 3243) 0)
+  (num-test (modulo 133897419738958073238580385894509887148800 330455) 0)
+  (num-test (modulo 3896215507210178905244623173635584334007288624 1005238) 0)
+  (num-test (modulo 17654511984514518592175290794029073043800 1060530) 511980)
+  (num-test (modulo 16470780256339082688310222474503880382858400 913836) 0)
+  (num-test (modulo 57267105834722825210001789897760395576000 2958974018) 2329405078)
+  (num-test (modulo 521977833444747522001426544601807810543216 1066521690) 625031316)
+  (num-test (modulo 1699559962174727325529414216960251941390400 25883611479) 16915574049)
+  (num-test (modulo 10654036597801063717295948399628964800 317449894126222) 116812646389120)
+  (num-test (modulo 381902381115592200811990304316262139150724960 4640335440216) 0)
+  (num-test (modulo 425968526187959807410151867411382902838703889232 1882826315615025) 1191718303295157)
+  (num-test (modulo 174609167728518272531601927200939868792000 1712923655178450) 541648883945400)
+  (num-test (modulo 3325168366561555458817274989681612518000 1699726139891780) 1568977975284720)
+  (num-test (modulo 11429650426242566426919762928176000 7414967839104) 1771142792832)
+  (num-test (modulo 2104794191230056678355480848036599377844400 16946684823025584) 9111120872594400)
+  (num-test (modulo 11894522530167763519415142641640874994880 7) 0)
+  (num-test (modulo 5906329981690378696996009087718418780000 185) 0)
+  (num-test (modulo 3056294774178096513474941936265025440000 658) 0)
+  (num-test (modulo 10491907660880423349353457742257185280 123369) 0)
+  (num-test (modulo 673239479595593149777212259021965839229225628776 15470) 12376)
+  (num-test (modulo 1506608574369860432616005754109397877696 1474070) 1179256)
+  (num-test (modulo 4849814041048623250005708880379694793905000 2172220582) 0)
+  (num-test (modulo 21154344928580705924176101470087564940000 5023204186) 0)
+  (num-test (modulo 346448039376394135288065831861806112294000 776147372) 25037012)
+  (num-test (modulo 2339009760844587560470606952218133142645504 194201967414) 78730527330)
+  (num-test (modulo 2242982161480922111384667548175169152 21419749763490) 17054708275722)
+  (num-test (modulo 4717315265246821759830981157482117120 45609714193992) 45557259088536)
+  (num-test (modulo 16628111321698075419789804224660024289936 4643626415880804) 3203755070835528)
+  (num-test (modulo 115557531507210992033160068979962880 88406536976058378) 13997397131802546)
+  (num-test (modulo 21059511907771200155093927745003762840000 180298981648603620) 88715511648941760)
+  (num-test (modulo 2124921015128697258800067298086064536000 2282525112298516782924) 1050493715522523120240)
+  (num-test (modulo 16015671538624533047089928322348864000 49817926936366875) 31511531988217125)
+  (num-test (modulo 166517667014186289390514558017250969134523800 43413708621878528404068) 4443969735426840626952)
+  (num-test (modulo 2780796292789128359666429021610464935722000 47) 0)
+  (num-test (modulo 21297913114430245153455383503409684916193317960 58) 0)
+  (num-test (modulo 1516745257039775143654568869485529015398000 6293) 0)
+  (num-test (modulo 8447692776411453120390905608381515479808 2030) 518)
+  (num-test (modulo 958876033949638283967045624731391031146081240 9834415) 9667730)
+  (num-test (modulo 4731349833403602529573388098680617532624192 14868) 0)
+  (num-test (modulo 6375001358038970462026761077388061675464000 430513678) 0)
+  (num-test (modulo 254088526608579040642428151389718385042344800 4799428101) 294233472)
+  (num-test (modulo 21140490542258031885408065086507444825621023648 164778747198) 63851269926)
+  (num-test (modulo 34214837305812460226811046733375808000 4312787868) 2681970660)
+  (num-test (modulo 11450197571956515037245443769386989035470896800 75585518430279) 69771247781796)
+  (num-test (modulo 1211397915863796187148880114197307052796506376580 538601201880) 128795939580)
+  (num-test (modulo 5454139401260819402160859765169199667337088 30452838731872) 22996976784800)
+  (num-test (modulo 744935981632690384026127091216926530879171660 1032747922358460) 630836297950320)
+  (num-test (modulo 324574326062026951443376280715122947502400 103751223626207988025) 7552030128655111125)
+  (num-test (modulo 15272163751269260921486082393684080908800 6484309049057400) 4436632507249800)
+  (num-test (modulo 386527546655781220813671331401971490218262720 3481571963427119100) 243571263764902920)
+  (num-test (modulo 3189682029126430413458911948222943640000 6724598925622907976570) 2607219061590696572250)
+  (num-test (modulo 709403542855323660533377490060722241678400 7) 0)
+  (num-test (modulo 139803787314578422635552652090095842837312147438904 123) 0)
+  (num-test (modulo 171985399350431759069945935900956183322827030835560 18241) 0)
+  (num-test (modulo 33090522521924986387051477884789600000 26187) 25578)
+  (num-test (modulo 1733723010009930088165729903139785699319986530 372945) 23805)
+  (num-test (modulo 56408303994570817306318494803635460247582000 5761730) 3307860)
+  (num-test (modulo 25845509336769185412951159262424903513866295760 64371378271) 0)
+  (num-test (modulo 624970361450506104794172455132584603069611058500 108222780) 0)
+  (num-test (modulo 82823962548382643645255524843049561752323600 135325929794) 123023572540)
+  (num-test (modulo 170620453449723034746079844571491973300000 9460614789626) 4845680745906)
+  (num-test (modulo 125144597811313015929871740675462711600000 12764411911636) 5714078712188)
+  (num-test (modulo 257193319319332344553297882967977761077115600 6510126541380) 1111485019260)
+  (num-test (modulo 879624546681838385457288074812140664728758550 10045784120501316) 5303606126868522)
+  (num-test (modulo 18300938860777100857669855248554588369659200 118088077425391892) 94617840861501464)
+  (num-test (modulo 8394780474625841647581984803260010511075000 746584618179400) 91432008031000)
+  (num-test (modulo 146802334713757872619395774222116859916800 718775571956687400) 62390745247132200)
+  (num-test (modulo 240155883351717999820072393833707008014911556000 1350921510529331832) 1096988895768179232)
+  (num-test (modulo 918942437243241528855354123800826649596480 74343962238703160850) 1608809218075839780)
+  (num-test (modulo 1361069299753299783990135442290762165844800 8281085446358585640) 7375208194228544280)
+
+  (num-test (modulo 1/9223372036854775807 -1/3) -9223372036854775804/27670116110564327421)
+  (num-test (modulo -1/9223372036854775807 1/3) 9223372036854775804/27670116110564327421)
+  (num-test (modulo 9223372036854775807 1/3) 0)
+  (num-test (modulo (/ (expt 3 10)) (/ (expt 2 61))) 1991/136157723851059414171648)
+  (num-test (modulo (/ (expt 3 20)) (/ (expt 2 61))) 487228559/2009994358920301836855410688)
+  (num-test (modulo -2/9223372036854775807 2/3) 18446744073709551608/27670116110564327421)
+  (num-test (modulo 2/9223372036854775807 -2/3) -18446744073709551608/27670116110564327421)
+  (num-test (modulo 57473596068/6659027209 318281039/225058681) 218279130532125402/1498671880400651329)
+  (num-test (modulo 25808688679/9809721694 1855077841/1311738121) 15656443452349049505/12867785902420496974)
+  (num-test (modulo 17026679261/10439860591 4478554083/3166815962) 7164879387815321029/33061117160633553542)
+  (num-test (modulo 480544481373/103768467013 10812186007/7645370045) 308048482161795610512/793348329316760825585)
+  (num-test (modulo 137528045312/217976794617 63018038201/44560482149) 137528045312/217976794617)
+  (num-test (modulo 1591258440050/975675645481 152139002499/107578520350) 22746909008980882960481/104961742282377144038350)
+  (num-test (modulo 6721373040371/1193652440098 367296043199/259717522849) 430386901580727488556473/310012454884916918799202)
+  (num-test (modulo 56850567176297/8573543875303 886731088897/627013566048) 1309091318011705591580273/1343932079730680866628136)
+  (num-test (modulo 176638380405175/18340740190704 5168247530883/3654502875938) 38394278980353599950554679/33513143886879715286440176)
+  (num-test (modulo 551230231989018/83130157078217 12477253282759/8822750406821) 714422652331325234782048966/733436627180932669467318157)
+  (num-test (modulo 1360510821127147/517121682660006 30122754096401/21300003689580) 2233626037506212134611298309/1835782291436657618117489580)
+  (num-test (modulo 5849200401628882/766512153894657 175568277047523/124145519261542) 53275930148683942294955132989/95159049365535186345899381094)
+  (num-test (modulo 15914407453568626/6048967074079039 423859315570607/299713796309065) 2205856429990054302964180188017/1812958885520765991472282188535)
+  (num-test (modulo 25997605614346611/9881527843552324 1023286908188737/723573111879672) 127934269420347558776141264953/105147174292423231311078293496)
+  (num-test (modulo 1528546195606366451/177100989030047175 5964153172084899/4217293152016490) 10878285025401489444908608411504/74688678825176546867355107791575)
+  (num-test (modulo 1991152086194052263/206745572560704147 14398739476117879/10181446324101389) 2411554265852820467970218680028029/2104968949772418231181062860760183)
+  (num-test (modulo 1657796840421716313/630118245525664765 34761632124320657/24580185800219268) 18845015710796719738302110345968279/15488423551129023359673258461692020)
+  (num-test (modulo 30769194397037159797/5464318637170278738 202605639573839043/143263821649299118) 271701765358086704077048080811413961/195709792667626007806640474599388271)
+  (num-test (modulo 63477669249275110720/7354673373747273033 489133282872437279/345869461223138161) 370494072414302426447989361648602678/2543756917250129165517177396348512313)
+  (num-test (modulo 275806591309589148297/36143248623210700400 1180872205318713601/835002744095575440) 9600268203288030825290513354903593/17147563511880433985428780967862600)
+
+  (num-test (modulo 1e19 10) 0.0)
+  (num-test (modulo .1e20 10) 0.0)
+  (num-test (modulo 1e20 10) 0.0)
+  (num-test (modulo 1e21 10) 0.0)
+  (num-test (modulo 1e19 -1) 0.0)
+  (num-test (modulo 1e19 1) 0.0)
+  (num-test (modulo .1e20 1) 0.0)
+  (num-test (modulo 1e20 1) 0.0)
+  (num-test (modulo 10000000000000000000 1) 0)
+  (num-test (modulo 100000000000000000000 1) 0)
+  (num-test (modulo 10000000000000000000 10) 0)
+  (num-test (modulo 100000000000000000000 10) 0)
+
+  (test (modulo 1361069299753299783990135442290762165844800+i 8281085446358585640) 'error))
+
+(test (modulo 123 123 123) 'error)
+(test (modulo 123) 'error)
+(test (modulo) 'error)
+(test (mod 2 0) 'error)
+(test (modulo 2.3 1.0+0.1i) 'error)
+(test (modulo 3.0+2.3i 3) 'error)
+;(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (modulo (cosh 128) 1.0)))) (define (hi) (func)) (hi)) 'error)
+(test (do ((i 0 (+ i __x__))) ((= i __x__)) (modulo (cosh 128) #x123.123)) 'error)
+(test (modulo 21010111 10) 1) ; from CL bboard
+(test (modulo 21010111 10.0) 1.0)
+(test (modulo 8101011121111 10) 1)
+(test (modulo 8101011121111 10.0) 1.0)
+(test (modulo 21010111211111 10) 1)
+(test (modulo 21010111211111 10.0) (if with-bignums 1.0 'error))
+
+(for-each
+ (lambda (arg)
+   (test (modulo arg +nan.0) 'error)
+   (test (modulo +nan.0 arg) 'error)
+   (test (modulo arg +inf.0) 'error)
+   (test (modulo +inf.0 arg) 'error)
+   (test (modulo arg 2) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(for-each
+ (lambda (arg)
+   (test (modulo 2 arg) 'error)
+   (test (modulo 1/2 arg) 'error)
+   (test (modulo 2.0 arg) 'error)
+   (test (modulo 2+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+;; check an optimizer bug
+(test (let () (define (f x) (modulo x 12)) (f 3/4)) 3/4)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (modulo -inf.0 1234)))) (define (hi) (func)) (hi)) #t)
+
+
+;;; --------------------------------------------------------------------------------
+;;; quotient
+;;; --------------------------------------------------------------------------------
+
+(num-test (quotient -0.5 -1) 0)
+(num-test (quotient -1 -1) 1)
+(num-test (quotient -1 -10) 0)
+(num-test (quotient -1 -1234) 0)
+(num-test (quotient -1 -2) 0)
+(num-test (quotient -1 -3) 0)
+(num-test (quotient -1 -500029) 0)
+(num-test (quotient -1 1) -1)
+(num-test (quotient -1 10) 0)
+(num-test (quotient -1 1234) 0)
+(num-test (quotient -1 2) 0)
+(num-test (quotient -1 3) 0)
+(num-test (quotient -1 500029) 0)
+(num-test (quotient -1.5 -2) 0)
+(num-test (quotient -1.5 2) 0)
+(num-test (quotient -1/2 -1) 0)
+(num-test (quotient -1/2 -1.0) 0)
+(num-test (quotient -1234 -1) 1234)
+(num-test (quotient -1234 -10) 123)
+(num-test (quotient -1234 -1234) 1)
+(num-test (quotient -1234 -2) 617)
+(num-test (quotient -1234 -3) 411)
+(num-test (quotient -1234 -500029) 0)
+(num-test (quotient -1234 1) -1234)
+(num-test (quotient -1234 10) -123)
+(num-test (quotient -1234 1234) -1)
+(num-test (quotient -1234 2) -617)
+(num-test (quotient -1234 3) -411)
+(num-test (quotient -1234 500029) 0)
+(num-test (quotient -2 -1) 2)
+(num-test (quotient -2 -10) 0)
+(num-test (quotient -2 -1234) 0)
+(num-test (quotient -2 -2) 1)
+(num-test (quotient -2 -3) 0)
+(num-test (quotient -2 -500029) 0)
+(num-test (quotient -2 1) -2)
+(num-test (quotient -2 10) 0)
+(num-test (quotient -2 1234) 0)
+(num-test (quotient -2 2) -1)
+(num-test (quotient -2 3) 0)
+(num-test (quotient -2 500029) 0)
+(num-test (quotient -35 -7) 5)
+(num-test (quotient -35 7) -5)
+(num-test (quotient -500029 -1) 500029)
+(num-test (quotient -500029 -10) 50002)
+(num-test (quotient -500029 -1234) 405)
+(num-test (quotient -500029 -2) 250014)
+(num-test (quotient -500029 -3) 166676)
+(num-test (quotient -500029 -500029) 1)
+(num-test (quotient -500029 1) -500029)
+(num-test (quotient -500029 10) -50002)
+(num-test (quotient -500029 1234) -405)
+(num-test (quotient -500029 2) -250014)
+(num-test (quotient -500029 3) -166676)
+(num-test (quotient -500029 500029) -1)
+(num-test (quotient 0 -1) 0)
+(num-test (quotient 0 -10) 0)
+(num-test (quotient 0 -1234) 0)
+(num-test (quotient 0 -2) 0)
+(num-test (quotient 0 -3) 0)
+(num-test (quotient 0 -500029) 0)
+(num-test (quotient 0 1) 0)
+(num-test (quotient 0 10) 0)
+(num-test (quotient 0 1234) 0)
+(num-test (quotient 0 2) 0)
+(num-test (quotient 0 3) 0)
+(num-test (quotient 0 500029) 0)
+(num-test (quotient 0.5 -2) 0)
+(num-test (quotient 0.5 -2.0) 0)
+(num-test (quotient 0.5 2.0) 0)
+(num-test (quotient 1 -1) -1)
+(num-test (quotient 1 -10) 0)
+(num-test (quotient 1 -1234) 0)
+(num-test (quotient 1 -2) 0)
+(num-test (quotient 1 -3) 0)
+(num-test (quotient 1 -4) 0)
+(num-test (quotient 1 -500029) 0)
+(num-test (quotient 1 1) 1)
+(num-test (quotient 1 10) 0)
+(num-test (quotient 1 1234) 0)
+(num-test (quotient 1 2) 0)
+(num-test (quotient 1 3) 0)
+(num-test (quotient 1 500029) 0)
+(num-test (quotient 1.5 1/3) 4)
+(num-test (quotient 1.5 1/4) 6)
+(num-test (quotient 1/2 -2) 0)
+(num-test (quotient 1/2 2) 0)
+(num-test (quotient 1/9223372036854775807 1/3) 0)
+(num-test (quotient 11/9223372036854775807 3/9223372036854775807) 3)
+(num-test (quotient 1234 -1) -1234)
+(num-test (quotient 1234 -10) -123)
+(num-test (quotient 1234 -1234) -1)
+(num-test (quotient 1234 -2) -617)
+(num-test (quotient 1234 -3) -411)
+(num-test (quotient 1234 -500029) 0)
+(num-test (quotient 1234 1) 1234)
+(num-test (quotient 1234 10) 123)
+(num-test (quotient 1234 1234) 1)
+(num-test (quotient 1234 2) 617)
+(num-test (quotient 1234 3) 411)
+(num-test (quotient 1234 500029) 0)
+(num-test (quotient 19439282 4409.5) 4408)
+(num-test (quotient 2 -1) -2)
+(num-test (quotient 2 -10) 0)
+(num-test (quotient 2 -1234) 0)
+(num-test (quotient 2 -2) -1)
+(num-test (quotient 2 -3) 0)
+(num-test (quotient 2 -500029) 0)
+(num-test (quotient 2 1) 2)
+(num-test (quotient 2 10) 0)
+(num-test (quotient 2 1234) 0)
+(num-test (quotient 2 2) 1)
+(num-test (quotient 2 3) 0)
+(num-test (quotient 2 500029) 0)
+(num-test (quotient 3/9223372036854775807 -2/9223372036854775807) -1)
+(num-test (quotient 3/9223372036854775807 1/9223372036854775807) 3)
+(num-test (quotient 35 -7) -5)
+(num-test (quotient 35 7) 5 )
+(num-test (quotient 500029 -1) -500029)
+(num-test (quotient 500029 -10) -50002)
+(num-test (quotient 500029 -1234) -405)
+(num-test (quotient 500029 -2) -250014)
+(num-test (quotient 500029 -3) -166676)
+(num-test (quotient 500029 -500029) -1)
+(num-test (quotient 500029 1) 500029)
+(num-test (quotient 500029 10) 50002)
+(num-test (quotient 500029 1234) 405)
+(num-test (quotient 500029 2) 250014)
+(num-test (quotient 500029 3) 166676)
+(num-test (quotient 500029 500029) 1)
+(num-test (quotient 512/1350851717672992089 512/4052555153018976267) 3)
+(num-test (quotient 9223372036854775 1/3) 27670116110564325)
+(num-test (quotient 9223372036854775807/2 9223372036854775807/8) 4)
+(num-test (quotient 9223372036854775807/8 9223372036854775807/2) 0)
+(num-test (quotient -9223372036854775808 -9223372036854775808) 1)
+(num-test (quotient 1.110223024625156799999999999999999999997E-16 -9223372036854775808) 0)
+(num-test (quotient 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) 0)
+(num-test (quotient 9223372036854775807 -9223372036854775808) 0)
+(num-test (quotient 9223372036854775807 9223372036854775807) 1)
+
+(if (not with-bignums)
+    (test (quotient most-negative-fixnum -1) 'error)
+    (num-test (quotient most-negative-fixnum -1) 9223372036854775808))
+
+(num-test (quotient 3 1.5) 2)
+(num-test (quotient 3 1.75) 1)
+(num-test (quotient pi 1) 3)
+(num-test (quotient pi 1.5) 2)
+(num-test (quotient pi 1.6) 1)
+(num-test (quotient pi 3.0) 1)
+(num-test (quotient pi 4.0) 0)
+
+(num-test (quotient 0.0 1) 0)
+(num-test (quotient 0.0 2) 0)
+(num-test (quotient 0.0 3) 0)
+(num-test (quotient 0.0 4) 0)
+(num-test (quotient 0.0 pi) 0)
+(num-test (quotient 0.0 2.5) 0)
+(num-test (quotient 0.0 4.0) 0)
+(num-test (quotient 0.0 1000.1) 0)
+(num-test (quotient pi 1) 3)
+(num-test (quotient pi 2) 1)
+(num-test (quotient pi 3) 1)
+(num-test (quotient pi 4) 0)
+(num-test (quotient pi pi) 1)
+(num-test (quotient pi 2.5) 1)
+(num-test (quotient pi 4.0) 0)
+(num-test (quotient pi 1000.1) 0)
+(num-test (quotient 1.5 1) 1)
+(num-test (quotient 1.5 2) 0)
+(num-test (quotient 1.5 3) 0)
+(num-test (quotient 1.5 4) 0)
+(num-test (quotient 1.5 pi) 0)
+(num-test (quotient 1.5 2.5) 0)
+(num-test (quotient 1.5 4.0) 0)
+(num-test (quotient 1.5 1000.1) 0)
+(num-test (quotient -1.5 1) -1)
+(num-test (quotient -1.5 2) 0)
+(num-test (quotient -1.5 3) 0)
+(num-test (quotient -1.5 4) 0)
+(num-test (quotient -1.5 pi) 0)
+(num-test (quotient -1.5 2.5) 0)
+(num-test (quotient -1.5 4.0) 0)
+(num-test (quotient -1.5 1000.1) 0)
+(num-test (quotient 3.0 1) 3)
+(num-test (quotient 3.0 2) 1)
+(num-test (quotient 3.0 3) 1)
+(num-test (quotient 3.0 4) 0)
+(num-test (quotient 3.0 pi) 0)
+(num-test (quotient 3.0 2.5) 1)
+(num-test (quotient 3.0 4.0) 0)
+(num-test (quotient 3.0 1000.1) 0)
+(num-test (quotient 110.123 1) 110)
+(num-test (quotient 110.123 2) 55)
+(num-test (quotient 110.123 3) 36)
+(num-test (quotient 110.123 4) 27)
+(num-test (quotient 110.123 pi) 35)
+(num-test (quotient 110.123 2.5) 44)
+(num-test (quotient 110.123 4.0) 27)
+(num-test (quotient 110.123 1000.1) 0)
+(test (quotient 100 1.0) 100)
+(test (quotient 100 1.5) 66)
+(test (quotient pi 1.5) 2)
+
+(if with-bignums (num-test (quotient 1e+18 8) 125000000000000000))
+(num-test (quotient 1/9223372036854775807 -1/9223372036854775807) -1)
+(num-test (quotient -4611686018427387904 1/2) -9223372036854775808)
+
+(test (= (quotient (* 99/70 99/70) 2) (quotient (* 577/408 577/408) 2)) #t)
+(test (= (quotient 2.0 (* 99/70 99/70)) (quotient (* 577/408 577/408) 2.0)) #f)
+(test (= (quotient 99/70 577/408) (floor (/ 99/70 577/408))) #t)
+(test (= (quotient (* 577/408 577/408) 2) (quotient (* 1393/985 1393/985) 2)) #f)
+(test (= (quotient 2.0 (* 577/408 577/408)) (quotient (* 1393/985 1393/985) 2.0)) #t)
+(test (= (quotient 577/408 1393/985) (floor (/ 577/408 1393/985))) #t)
+(test (= (quotient (* 3363/2378 3363/2378) 2) (quotient (* 19601/13860 19601/13860) 2)) #t)
+(test (= (quotient 2.0 (* 3363/2378 3363/2378)) (quotient (* 19601/13860 19601/13860) 2.0)) #f)
+(test (= (quotient 3363/2378 19601/13860) (floor (/ 3363/2378 19601/13860))) #t)
+(test (= (quotient (* 47321/33461 47321/33461) 2) (quotient (* 114243/80782 114243/80782) 2)) #f)
+(test (= (quotient 2.0 (* 47321/33461 47321/33461)) (quotient (* 114243/80782 114243/80782) 2.0)) #t)
+(test (= (quotient 47321/33461 114243/80782) (floor (/ 47321/33461 114243/80782))) #t)
+(test (= (quotient (* 275807/195025 275807/195025) 2) (quotient (* 1607521/1136689 1607521/1136689) 2)) #t)
+(test (= (quotient 2.0 (* 275807/195025 275807/195025)) (quotient (* 1607521/1136689 1607521/1136689) 2.0)) #f)
+(test (= (quotient 275807/195025 1607521/1136689) (floor (/ 275807/195025 1607521/1136689))) #t)
+(test (= (quotient (* 3880899/2744210 3880899/2744210) 2) (quotient (* 9369319/6625109 9369319/6625109) 2)) #f)
+(test (= (quotient 2.0 (* 3880899/2744210 3880899/2744210)) (quotient (* 9369319/6625109 9369319/6625109) 2.0)) #t)
+(test (= (quotient 3880899/2744210 9369319/6625109) (floor (/ 3880899/2744210 9369319/6625109))) #t)
+(test (= (quotient (* 54608393/38613965 54608393/38613965) 2) (quotient (* 131836323/93222358 131836323/93222358) 2)) #f)
+(test (= (quotient 2.0 (* 54608393/38613965 54608393/38613965)) (quotient (* 131836323/93222358 131836323/93222358) 2.0)) #t)
+(test (= (quotient 54608393/38613965 131836323/93222358) (floor (/ 54608393/38613965 131836323/93222358))) #t)
+(test (= (quotient (* 131836323/93222358 131836323/93222358) 2) (quotient (* 318281039/225058681 318281039/225058681) 2)) #f)
+;(if with-bignums (test (= (quotient 2.0 (* 131836323/93222358 131836323/93222358)) ; this should be 1 I think
+;			  (quotient (* 318281039/225058681 318281039/225058681) 2.0)) #f))
+(test (= (quotient 131836323/93222358 318281039/225058681) (floor (/ 131836323/93222358 318281039/225058681))) #t)
+(when with-bignums
+  (test (= (quotient (* 318281039/225058681 318281039/225058681) 2) (quotient (* 1855077841/1311738121 1855077841/1311738121) 2)) #t)
+  ;; (exact->inexact (* 1855077841/1311738121 1855077841/1311738121))
+  ;; 1.999999999999999999418826611445214136431E0
+  ;; (exact->inexact (* 318281039/225058681 318281039/225058681))
+  ;; 1.999999999999999980257212936354560469555E0
+  (test (= (quotient 2.0 (* 318281039/225058681 318281039/225058681)) (quotient (* 1855077841/1311738121 1855077841/1311738121) 2.0)) #f) ; see above
+  (test (= (quotient 318281039/225058681 1855077841/1311738121) (floor (/ 318281039/225058681 1855077841/1311738121))) #t)
+  (test (= (quotient (* 1855077841/1311738121 1855077841/1311738121) 2) (quotient (* 4478554083/3166815962 4478554083/3166815962) 2)) #f))
+(if (provided? 'overflow-checks)
+    (test (= (quotient 2.0 (* 1855077841/1311738121 1855077841/1311738121)) (quotient (* 4478554083/3166815962 4478554083/3166815962) 2.0)) #t))
+(test (= (quotient 1855077842/1311738121 4478554083/3166815962) (floor (/ 1855077842/1311738121 4478554083/3166815962))) #t)
+(test (nan? (let () (define (func) (* (quotient (expt 2 32) +inf.0) 12)) (define (hi) (func)) (hi))) #t) ; g_mul_2_ix signature->optimizer confusion
+
+;;; there's one really dumb problem here:
+;;;  (quotient 1e-12 1E-16) -> 9999
+;;;  (quotient 1.0000000000000e-12 1E-16) -> 9999 but
+;;;  (quotient 1.00000000000000e-12 1E-16) -> 10000
+;;;  for 1e-14 however, there is no number of zeros that will work, but you can set precision to 1024
+;;;  or you can spell it out: (quotient 0.0000000000001 0.00000000000000001) -> 10000
+
+;;;  (quotient 1e+18 3/4) -> 1333333333333333248
+;;;  which should be 333 at the end of course
+;;;  (quotient 1e+15 3/4) -> 1333333333333333
+
+(num-test (quotient 1e16 1e14) 100)
+
+(when with-bignums
+  (num-test (quotient 1.00000000000000e-12 1E-16) 10000)
+  (test (quotient 2.0 (* 318281039/225058681 318281039/225058681)) 1)
+  (test (quotient (* 1855077841/1311738121 1855077841/1311738121) 2.0) 0)
+
+  (num-test (quotient -1.797693134862315699999999999999999999998E308 -9223372036854775808) 19490628022799995908501125008172039088075481712089442747863503837260448050616338003410135413043522984719682345909025832711116783129727902847513862872544943321023332545672815506523677443663683097294005030046422806743414556504424564204282517830151319186021046775247332737488676655598816722944)
+  (num-test (quotient -9223372036854775808 5.551115123125783999999999999999999999984E-17) -166153499473114445265356059994784304)
+  (num-test (quotient 295147905149568077200 34359738366) 8589934591)
+  (num-test (quotient 696898287454081973170944403677937368733396 1180591620717411303422) 590295810358705651711)
+  (num-test (quotient 1e19 10) 1000000000000000000)
+  (num-test (quotient .1e20 10) 1000000000000000000)
+  (num-test (quotient 1e20 10) 10000000000000000000)
+  (num-test (quotient 1e21 10) 100000000000000000000)
+  (num-test (quotient 1e19 -1) -10000000000000000000)
+  (num-test (quotient 1e19 1) 10000000000000000000)
+  (num-test (quotient .1e20 1) 10000000000000000000)
+  (num-test (quotient 1e20 1) 100000000000000000000)
+  (num-test (quotient 10000000000000000000 1) 10000000000000000000)
+  (num-test (quotient 100000000000000000000 1) 100000000000000000000)
+  (num-test (quotient 10000000000000000000 10) 1000000000000000000)
+  (num-test (quotient 100000000000000000000 10) 10000000000000000000)
+
+  (num-test (quotient 1 1/9223372036854775807) 9223372036854775807)
+  (num-test (quotient 9223372036854775807 2/3) 13835058055282163710)
+  (test (quotient 1361069299753299783990135442290762165844800+i 8281085446358585640) 'error)
+  (test (quotient 1231231231231231232123 0.0) 'error)
+  (test (quotient 1231231231231231232123 0) 'error)
+
+  ;; the tests that multiply by 2.0 may be on the edge of the 128 bit default precision
+  (test (= (quotient (* 4478554083/3166815962 4478554083/3166815962) 2) (quotient (* 10812186007/7645370045 10812186007/7645370045) 2)) #f)
+  (test (= (quotient 2.0 (* 4478554083/3166815962 4478554083/3166815962)) (quotient (* 10812186007/7645370045 10812186007/7645370045) 2.0)) #t)
+  (test (= (quotient 4478554083/3166815962 10812186007/7645370045) (floor (/ 4478554083/3166815962 10812186007/7645370045))) #t)
+  (test (= (quotient (* 63018038201/44560482149 63018038201/44560482149) 2) (quotient (* 152139002499/107578520350 152139002499/107578520350) 2)) #f)
+  (test (= (quotient 2.0 (* 63018038201/44560482149 63018038201/44560482149)) (quotient (* 152139002499/107578520350 152139002499/107578520350) 2.0)) #t)
+  (test (= (quotient 63018038201/44560482149 152139002499/107578520350) (floor (/ 63018038201/44560482149 152139002499/107578520350))) #t)
+  (test (= (quotient (* 367296043199/259717522849 367296043199/259717522849) 2) (quotient (* 886731088897/627013566048 886731088897/627013566048) 2)) #f)
+  (test (= (quotient 2.0 (* 367296043199/259717522849 367296043199/259717522849)) (quotient (* 886731088897/627013566048 886731088897/627013566048) 2.0)) #t)
+  (test (= (quotient 367296043199/259717522849 886731088897/627013566048) (floor (/ 367296043199/259717522849 886731088897/627013566048))) #t)
+  (test (= (quotient (* 5168247530883/3654502875938 5168247530883/3654502875938) 2) (quotient (* 12477253282759/8822750406821 12477253282759/8822750406821) 2)) #f)
+  (test (= (quotient 2.0 (* 5168247530883/3654502875938 5168247530883/3654502875938)) (quotient (* 12477253282759/8822750406821 12477253282759/8822750406821) 2.0)) #t)
+  (test (= (quotient 5168247530883/3654502875938 12477253282759/8822750406821) (floor (/ 5168247530883/3654502875938 12477253282759/8822750406821))) #t)
+  (test (= (quotient (* 30122754096401/21300003689580 30122754096401/21300003689580) 2) (quotient (* 175568277047523/124145519261542 175568277047523/124145519261542) 2)) #t)
+  (test (= (quotient 2.0 (* 30122754096401/21300003689580 30122754096401/21300003689580)) (quotient (* 175568277047523/124145519261542 175568277047523/124145519261542) 2.0)) #f)
+  (test (= (quotient 30122754096401/21300003689580 175568277047523/124145519261542) (floor (/ 30122754096401/21300003689580 175568277047523/124145519261542))) #t)
+
+  (test (= (quotient (* 423859315570607/299713796309065 423859315570607/299713796309065) 2)
+	   (quotient (* 1023286908188737/723573111879672 1023286908188737/723573111879672) 2)) #f)
+  (test (= (quotient 423859315570607/299713796309065 1023286908188737/723573111879672)
+	   (floor (/ 423859315570607/299713796309065 1023286908188737/723573111879672))) #t)
+  (test (= (quotient (* 1023286908188737/723573111879672 1023286908188737/723573111879672) 2)
+	   (quotient (* 5964153172084899/4217293152016490 5964153172084899/4217293152016490) 2)) #t)
+  (test (= (quotient (* 3289910387877251662993/2326317944764069484905 3289910387877251662993/2326317944764069484905) 2)
+	   (quotient (* 19175002942688032928599/13558774610046711780701 19175002942688032928599/13558774610046711780701) 2)) #t)
+  (test (= (quotient 3289910387877251662993/2326317944764069484905 19175002942688032928599/13558774610046711780701)
+	   (floor (/ 3289910387877251662993/2326317944764069484905 19175002942688032928599/13558774610046711780701))) #t)
+  (test (= (quotient (* 46292552162781456490001/32733777552734744709300 46292552162781456490001/32733777552734744709300) 2)
+	   (quotient (* 111760107268250945908601/79026329715516201199301 111760107268250945908601/79026329715516201199301) 2)) #f)
+  (test (= (quotient 46292552162781456490001/32733777552734744709300 111760107268250945908601/79026329715516201199301)
+	   (floor (/ 46292552162781456490001/32733777552734744709300 111760107268250945908601/79026329715516201199301))) #t)
+  (test (= (quotient (* 269812766699283348307203/190786436983767147107902 269812766699283348307203/190786436983767147107902) 2)
+	   (quotient (* 1572584048032918633353217/1111984844349868137938112 1572584048032918633353217/1111984844349868137938112) 2)) #t)
+  (test (= (quotient 269812766699283348307203/190786436983767147107902 1572584048032918633353217/1111984844349868137938112)
+	   (floor (/ 269812766699283348307203/190786436983767147107902 1572584048032918633353217/1111984844349868137938112))) #t)
+  (test (= (quotient (* 1572584048032918633353217/1111984844349868137938112 1572584048032918633353217/1111984844349868137938112) 2)
+	   (quotient (* 3796553736732654909229441/2684568892382786771291329 3796553736732654909229441/2684568892382786771291329) 2)) #f)
+  (test (= (quotient 1572584048032918633353217/1111984844349868137938112 3796553736732654909229441/2684568892382786771291329)
+	   (floor (/ 1572584048032918633353217/1111984844349868137938112 3796553736732654909229441/2684568892382786771291329))) #t))
+
+(test (quotient 123 123 123) 'error)
+(test (quotient 123) 'error)
+(test (quotient 3 0) 'error)
+(test (quotient) 'error)
+(test (quotient 3 1+i) 'error)
+(test (quotient 3 0.0) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (quotient arg +nan.0) 'error)
+   (test (quotient +nan.0 arg) 'error)
+   (test (quotient arg +inf.0) 'error)
+   (test (quotient +inf.0 arg) 'error)
+   (test (quotient arg 2) 'error))
+ (list "hi" () (integer->char 65) #f #t 0+i '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(for-each
+ (lambda (arg)
+   (test (quotient 2 arg) 'error)
+   (test (quotient 1/2 arg) 'error)
+   (test (quotient 2.0 arg) 'error)
+   (test (quotient 2+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t 0 0.0 0+i '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; remainder
+;;; --------------------------------------------------------------------------------
+
+(num-test (remainder -0.5 -1) -0.5)
+(num-test (remainder -1 -1) 0)
+(num-test (remainder -1 -10) -1)
+(num-test (remainder -1 -1234) -1)
+(num-test (remainder -1 -2) -1)
+(num-test (remainder -1 -3) -1)
+(num-test (remainder -1 -500029) -1)
+(num-test (remainder -1 1) 0)
+(num-test (remainder -1 10) -1)
+(num-test (remainder -1 1234) -1)
+(num-test (remainder -1 2) -1)
+(num-test (remainder -1 3) -1)
+(num-test (remainder -1 500029) -1)
+(num-test (remainder -1.5 -2) -1.5)
+(num-test (remainder -1.5 2) -1.5)
+(num-test (remainder -1/2 -1) -1/2)
+(num-test (remainder -1/2 -1.0) -0.5)
+(num-test (remainder -1234 -1) 0)
+(num-test (remainder -1234 -10) -4)
+(num-test (remainder -1234 -1234) 0)
+(num-test (remainder -1234 -2) 0)
+(num-test (remainder -1234 -3) -1)
+(num-test (remainder -1234 -500029) -1234)
+(num-test (remainder -1234 1) 0)
+(num-test (remainder -1234 10) -4)
+(num-test (remainder -1234 1234) 0)
+(num-test (remainder -1234 2) 0)
+(num-test (remainder -1234 3) -1)
+(num-test (remainder -1234 500029) -1234)
+(num-test (remainder -13 -4) -1)
+(num-test (remainder -13 4) -1)
+(num-test (remainder -2 -1) 0)
+(num-test (remainder -2 -10) -2)
+(num-test (remainder -2 -1234) -2)
+(num-test (remainder -2 -2) 0)
+(num-test (remainder -2 -3) -2)
+(num-test (remainder -2 -500029) -2)
+(num-test (remainder -2 1) 0)
+(num-test (remainder -2 10) -2)
+(num-test (remainder -2 1234) -2)
+(num-test (remainder -2 2) 0)
+(num-test (remainder -2 3) -2)
+(num-test (remainder -2 500029) -2)
+(num-test (remainder -500029 -1) 0)
+(num-test (remainder -500029 -10) -9)
+(num-test (remainder -500029 -1234) -259)
+(num-test (remainder -500029 -2) -1)
+(num-test (remainder -500029 -3) -1)
+(num-test (remainder -500029 -500029) 0)
+(num-test (remainder -500029 1) 0)
+(num-test (remainder -500029 10) -9)
+(num-test (remainder -500029 1234) -259)
+(num-test (remainder -500029 2) -1)
+(num-test (remainder -500029 3) -1)
+(num-test (remainder -500029 500029) 0)
+(num-test (remainder 0 -1) 0)
+(num-test (remainder 0 -10) 0)
+(num-test (remainder 0 -1234) 0)
+(num-test (remainder 0 -2) 0)
+(num-test (remainder 0 -3) 0)
+(num-test (remainder 0 -500029) 0)
+(num-test (remainder 0 1) 0)
+(num-test (remainder 0 10) 0)
+(num-test (remainder 0 1234) 0)
+(num-test (remainder 0 2) 0)
+(num-test (remainder 0 3) 0)
+(num-test (remainder 0 500029) 0)
+(num-test (remainder 0.5 -2) 0.5)
+(num-test (remainder 0.5 -2.0) 0.5)
+(num-test (remainder 0.5 2.0) 0.5)
+(num-test (remainder 1 -1) 0)
+(num-test (remainder 1 -10) 1)
+(num-test (remainder 1 -1234) 1)
+(num-test (remainder 1 -2) 1)
+(num-test (remainder 1 -3) 1)
+(num-test (remainder 1 -4) 1)
+(num-test (remainder 1 -500029) 1)
+(num-test (remainder 1 1) 0)
+(num-test (remainder 1 10) 1)
+(num-test (remainder 1 1234) 1)
+(num-test (remainder 1 2) 1)
+(num-test (remainder 1 3) 1)
+(num-test (remainder 1 500029) 1)
+(num-test (remainder 1.5 1/3) 0.16666666666667)
+(num-test (remainder 1.5 1/4) 0.0)
+(num-test (remainder 1/2 -2) 1/2)
+(num-test (remainder 1/2 2) 1/2)
+(num-test (remainder 1/9223372036854775807 1/3) 1/9223372036854775807)
+(num-test (remainder 11/9223372036854775807 3/9223372036854775807) 2/9223372036854775807)
+(num-test (remainder 1234 -1) 0)
+(num-test (remainder 1234 -10) 4)
+(num-test (remainder 1234 -1234) 0)
+(num-test (remainder 1234 -2) 0)
+(num-test (remainder 1234 -3) 1)
+(num-test (remainder 1234 -500029) 1234)
+(num-test (remainder 1234 1) 0)
+(num-test (remainder 1234 10) 4)
+(num-test (remainder 1234 1234) 0)
+(num-test (remainder 1234 2) 0)
+(num-test (remainder 1234 3) 1)
+(num-test (remainder 1234 500029) 1234)
+(num-test (remainder 13 -4) 1)
+(num-test (remainder 13 4) 1)
+(num-test (remainder 19439282 4409.5) 2206.0)
+(num-test (remainder 2 -1) 0)
+(num-test (remainder 2 -10) 2)
+(num-test (remainder 2 -1234) 2)
+(num-test (remainder 2 -2) 0)
+(num-test (remainder 2 -3) 2)
+(num-test (remainder 2 -500029) 2)
+(num-test (remainder 2 1) 0)
+(num-test (remainder 2 10) 2)
+(num-test (remainder 2 1234) 2)
+(num-test (remainder 2 2) 0)
+(num-test (remainder 2 3) 2)
+(num-test (remainder 500029 -1) 0)
+(num-test (remainder 500029 -10) 9)
+(num-test (remainder 500029 -1234) 259)
+(num-test (remainder 500029 -2) 1)
+(num-test (remainder 500029 -3) 1)
+(num-test (remainder 500029 -500029) 0)
+(num-test (remainder 500029 1) 0)
+(num-test (remainder 500029 10) 9)
+(num-test (remainder 500029 1234) 259)
+(num-test (remainder 500029 2) 1)
+(num-test (remainder 500029 3) 1)
+(num-test (remainder 500029 500029) 0)
+(num-test (remainder -9223372036854775808 -9223372036854775808) 0)
+(num-test (remainder 1.110223024625156799999999999999999999997E-16 -9223372036854775808) 1.110223024625156799999999999999999999997E-16)
+(num-test (remainder 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) 5.551115123125783999999999999999999999984E-17)
+(num-test (remainder 9223372036854775807 -9223372036854775808) 9223372036854775807)
+(num-test (remainder 9223372036854775807 9223372036854775807) 0)
+
+(num-test (remainder 0.0 1) 0.0)
+(num-test (remainder 0.0 2) 0.0)
+(num-test (remainder 0.0 3) 0.0)
+(num-test (remainder 0.0 4) 0.0)
+(num-test (remainder 0.0 pi) 0.0)
+(num-test (remainder 0.0 2.5) 0.0)
+(num-test (remainder 0.0 4.0) 0.0)
+(num-test (remainder 0.0 1000.1) 0.0)
+(num-test (remainder pi 1) 1.415926535897932384626433832795028841953E-1)
+(num-test (remainder pi 2) 1.141592653589793238462643383279502884195E0)
+(num-test (remainder pi 3) 1.415926535897932384626433832795028841953E-1)
+(num-test (remainder pi 4) pi)
+(num-test (remainder pi pi) 0.0)
+(num-test (remainder pi 2.5) 6.415926535897932384626433832795028841953E-1)
+(num-test (remainder pi 4.0) pi)
+(num-test (remainder pi 1000.1) pi)
+(num-test (remainder 1.5 1) 0.5)
+(num-test (remainder 1.5 2) 1.5)
+(num-test (remainder 1.5 3) 1.5)
+(num-test (remainder 1.5 4) 1.5)
+(num-test (remainder 1.5 pi) 1.500E0)
+(num-test (remainder 1.5 2.5) 1.5)
+(num-test (remainder 1.5 4.0) 1.5)
+(num-test (remainder 1.5 1000.1) 1.5)
+(num-test (remainder -1.5 1) -0.5)
+(num-test (remainder -1.5 2) -1.5)
+(num-test (remainder -1.5 3) -1.5)
+(num-test (remainder -1.5 4) -1.5)
+(num-test (remainder -1.5 pi) -1.50E0)
+(num-test (remainder -1.5 2.5) -1.5)
+(num-test (remainder -1.5 4.0) -1.5)
+(num-test (remainder -1.5 1000.1) -1.5)
+(num-test (remainder 3.0 1) 0.0)
+(num-test (remainder 3.0 2) 1.0)
+(num-test (remainder 3.0 3) 0.0)
+(num-test (remainder 3.0 4) 3.0)
+(num-test (remainder 3.0 pi) 3.000E0)
+(num-test (remainder 3.0 2.5) 0.5)
+(num-test (remainder 3.0 4.0) 3.0)
+(num-test (remainder 3.0 1000.1) 3.0)
+(num-test (remainder 110.123 1) 0.123)
+(num-test (remainder 110.123 2) 0.123)
+(num-test (remainder 110.123 3) 2.123)
+(num-test (remainder 110.123 4) 2.123)
+(num-test (remainder 110.123 pi) 1.672571243572413149678281714746183675874E-1)
+(num-test (remainder 110.123 2.5) 0.123)
+(num-test (remainder 110.123 4.0) 2.123)
+(num-test (remainder 110.123 1000.1) 110.123)
+
+(when (provided? 'overflow-checks)
+  (num-test (remainder 3/2 most-negative-fixnum) 3/2)
+  (num-test (remainder 3/2 most-positive-fixnum) 3/2)
+  (num-test (remainder most-negative-fixnum -1) 0))
+
+(test (= (remainder (* 577/408 577/408) 2) (remainder (* 1393/985 1393/985) 2)) #f)
+(test (= (remainder 2.0 (* 577/408 577/408)) (remainder (* 1393/985 1393/985) 2.0)) #f)
+(test (= (remainder 577/408 1393/985) (floor (/ 577/408 1393/985))) #f)
+(test (= (remainder (* 3363/2378 3363/2378) 2) (remainder (* 19601/13860 19601/13860) 2)) #f)
+(test (= (remainder 2.0 (* 47321/33461 47321/33461)) (remainder (* 114243/80782 114243/80782) 2.0)) #f)
+(test (= (remainder 47321/33461 114243/80782) (floor (/ 47321/33461 114243/80782))) #f)
+(test (= (remainder (* 275807/195025 275807/195025) 2) (remainder (* 1607521/1136689 1607521/1136689) 2)) #f)
+(test (= (remainder 2.0 (* 275807/195025 275807/195025)) (remainder (* 1607521/1136689 1607521/1136689) 2.0)) #f)
+(test (= (remainder 275807/195025 1607521/1136689) (floor (/ 275807/195025 1607521/1136689))) #f)
+(test (= (remainder (* 3880899/2744210 3880899/2744210) 2) (remainder (* 9369319/6625109 9369319/6625109) 2)) #f)
+(test (= (remainder 2.0 (* 3880899/2744210 3880899/2744210)) (remainder (* 9369319/6625109 9369319/6625109) 2.0)) #f)
+(test (= (remainder 3880899/2744210 9369319/6625109) (floor (/ 3880899/2744210 9369319/6625109))) #f)
+(when with-bignums
+  (test (= (remainder 2.0 (* 318281039/225058681 318281039/225058681)) 0.0) #f)
+  (test (= (remainder (* 1855077841/1311738121 1855077841/1311738121) 2.0) 0.0) #f)
+  (test (= (remainder 2.0 (* 54608393/38613965 54608393/38613965)) (remainder (* 131836323/93222358 131836323/93222358) 2.0)) #f) ; was #t?
+  (test (= (remainder 54608393/38613965 131836323/93222358) (floor (/ 54608393/38613965 131836323/93222358))) #f)
+  (test (= (remainder (* 318281039/225058681 318281039/225058681) 2) (remainder (* 1855077841/1311738121 1855077841/1311738121) 2)) #f)
+  (test (= (remainder 2.0 (* 318281039/225058681 318281039/225058681)) (remainder (* 1855077841/1311738121 1855077841/1311738121) 2.0)) #f) ; was #t?? 25-Apr-2020
+  (test (= (remainder 318281039/225058681 1855077841/1311738121) (floor (/ 318281039/225058681 1855077841/1311738121))) #f)
+  (test (= (remainder (* 54608393/38613965 54608393/38613965) 2) (remainder (* 131836323/93222358 131836323/93222358) 2)) #f))
+
+(num-test (+ (remainder 23/3 3/2) (* 3/2 (quotient 23/3 3/2))) 23/3)
+(num-test (+ (remainder 29/8 17/12) (* 17/12 (quotient 29/8 17/12))) 29/8)
+(num-test (+ (remainder 164/19 41/29) (* 41/29 (quotient 164/19 41/29))) 164/19)
+(num-test (+ (remainder 725/84 99/70) (* 99/70 (quotient 725/84 99/70))) 725/84)
+(num-test (+ (remainder 3862/401 577/408) (* 577/408 (quotient 3862/401 577/408))) 3862/401)
+(num-test (+ (remainder 4881/1054 1393/985) (* 1393/985 (quotient 4881/1054 1393/985))) 4881/1054)
+(num-test (+ (remainder 53963/20511 3363/2378) (* 3363/2378 (quotient 53963/20511 3363/2378))) 53963/20511)
+(num-test (+ (remainder 188690/24727 19601/13860) (* 19601/13860 (quotient 188690/24727 19601/13860))) 188690/24727)
+(num-test (+ (remainder 959536/125743 47321/33461) (* 47321/33461 (quotient 959536/125743 47321/33461))) 959536/125743)
+(num-test (+ (remainder 2606489/301994 114243/80782) (* 114243/80782 (quotient 2606489/301994 114243/80782))) 2606489/301994)
+(num-test (+ (remainder 97961303/11350029 275807/195025) (* 275807/195025 (quotient 97961303/11350029 275807/195025))) 97961303/11350029)
+(when (provided? 'overflow-checks)
+  (num-test (+ (remainder 109303762/16483927 1607521/1136689) (* 1607521/1136689 (quotient 109303762/16483927 1607521/1136689))) 109303762/16483927)
+  (num-test (+ (remainder 27869189/17087915 3880899/2744210) (* 3880899/2744210 (quotient 27869189/17087915 3880899/2744210))) 27869189/17087915)
+  (num-test (+ (remainder 564541319/85137581 9369319/6625109) (* 9369319/6625109 (quotient 564541319/85137581 9369319/6625109))) 564541319/85137581)
+  (num-test (+ (remainder 2351934037/272500658 54608393/38613965) (* 54608393/38613965 (quotient 2351934037/272500658 54608393/38613965))) 2351934037/272500658)
+  (num-test (+ (remainder 1657851173/630138897 131836323/93222358) (* 131836323/93222358 (quotient 1657851173/630138897 131836323/93222358))) 1657851173/630138897))
+
+(when with-bignums
+  (num-test (remainder -9223372036854775808 5.551115123125783999999999999999999999984E-17) -2.295798100238055639010781305842101573944E-17)
+  (num-test (remainder 295147905149568077200 34359738366) 21754858894)
+  (num-test (remainder 696898287454081973170944403677937368733396 1180591620717411303422) 314390899110894278354)
+  (num-test (remainder 1e19 10) 0.0)
+  (num-test (remainder .1e20 10) 0.0)
+  (num-test (remainder 1e20 10) 0.0)
+  (num-test (remainder 1e21 10) 0.0)
+  (num-test (remainder 1e19 -1) 0.0)
+  (num-test (remainder 1e19 1) 0.0)
+  (num-test (remainder .1e20 1) 0.0)
+  (num-test (remainder 1e20 1) 0.0)
+  (num-test (remainder 10000000000000000000 1) 0)
+  (num-test (remainder 100000000000000000000 1) 0)
+  (num-test (remainder 10000000000000000000 10) 0)
+  (num-test (remainder 100000000000000000000 10) 0)
+
+  (num-test (remainder 9223372036854775807 1/3) 0)
+  (num-test (remainder 9223372036854775807 2/3) 1/3)
+  (num-test (remainder 922337203685477580 1/3) 0)
+  (test (remainder 1361069299753299783990135442290762165844800+i 8281085446358585640) 'error)
+  (test (remainder 1231231231231231232123 0.0) 'error)
+  (test (remainder 1231231231231231232123 0) 'error)
+  (when with-bignums (test (remainder 9007199254740996.0 9007199254740995) 1.0)) ; 0.0 in 64-bit land
+
+  (test (= (remainder (* 4478554083/3166815962 4478554083/3166815962) 2)
+	   (remainder (* 10812186007/7645370045 10812186007/7645370045) 2)) #f)
+  (test (= (remainder 2.0 (* 4478554083/3166815962 4478554083/3166815962))
+	   (remainder (* 10812186007/7645370045 10812186007/7645370045) 2.0)) #f)
+  (test (= (remainder 367296043199/259717522849 886731088897/627013566048)
+	   (floor (/ 367296043199/259717522849 886731088897/627013566048))) #f)
+  (test (= (remainder (* 5168247530883/3654502875938 5168247530883/3654502875938) 2)
+	   (remainder (* 12477253282759/8822750406821 12477253282759/8822750406821) 2)) #f)
+  (test (= (remainder 2.0 (* 423859315570607/299713796309065 423859315570607/299713796309065))
+	   (remainder (* 1023286908188737/723573111879672 1023286908188737/723573111879672) 2.0)) #f)
+  (test (= (remainder 2.0 (* 34761632124320657/24580185800219268 34761632124320657/24580185800219268))
+	   (remainder (* 202605639573839043/143263821649299118 202605639573839043/143263821649299118) 2.0)) #f)
+  (test (= (remainder 34761632124320657/24580185800219268 202605639573839043/143263821649299118)
+	   (floor (/ 34761632124320657/24580185800219268 202605639573839043/143263821649299118))) #f)
+  (test (= (remainder (* 489133282872437279/345869461223138161 489133282872437279/345869461223138161) 2)
+	   (remainder (* 1180872205318713601/835002744095575440 1180872205318713601/835002744095575440) 2)) #f)
+  (test (= (remainder (* 2850877693509864481/2015874949414289041 2850877693509864481/2015874949414289041) 2)
+	   (remainder (* 16616132878186749607/11749380235262596085 16616132878186749607/11749380235262596085) 2)) #f)
+  (test (= (remainder (* 564459384575477049359/399133058537705128729 564459384575477049359/399133058537705128729) 2)
+	   (remainder (* 1362725501650887306817/963592443113182178088 1362725501650887306817/963592443113182178088) 2)) #f)
+  (test (= (remainder 564459384575477049359/399133058537705128729 1362725501650887306817/963592443113182178088)
+	   (floor (/ 564459384575477049359/399133058537705128729 1362725501650887306817/963592443113182178088))) #f)
+  (test (= (remainder (* 3289910387877251662993/2326317944764069484905 3289910387877251662993/2326317944764069484905) 2)
+	   (remainder (* 19175002942688032928599/13558774610046711780701 19175002942688032928599/13558774610046711780701) 2)) #f)
+  (test (= (remainder (* 46292552162781456490001/32733777552734744709300 46292552162781456490001/32733777552734744709300) 2)
+	   (remainder (* 111760107268250945908601/79026329715516201199301 111760107268250945908601/79026329715516201199301) 2)) #f)
+  (test (= (remainder 46292552162781456490001/32733777552734744709300 111760107268250945908601/79026329715516201199301)
+	   (floor (/ 46292552162781456490001/32733777552734744709300 111760107268250945908601/79026329715516201199301))) #f)
+  (test (= (remainder (* 269812766699283348307203/190786436983767147107902 269812766699283348307203/190786436983767147107902) 2)
+	   (remainder (* 1572584048032918633353217/1111984844349868137938112 1572584048032918633353217/1111984844349868137938112) 2)) #f)
+  (test (= (remainder 269812766699283348307203/190786436983767147107902 1572584048032918633353217/1111984844349868137938112)
+	   (floor (/ 269812766699283348307203/190786436983767147107902 1572584048032918633353217/1111984844349868137938112))) #f)
+
+  (num-test (+ (remainder 37496514441/6659027209 318281039/225058681)
+	       (* 318281039/225058681 (quotient 37496514441/6659027209 318281039/225058681))) 37496514441/6659027209)
+  (num-test (+ (remainder 74857297149/9809721694 1855077841/1311738121)
+	       (* 1855077841/1311738121 (quotient 74857297149/9809721694 1855077841/1311738121))) 74857297149/9809721694)
+  (num-test (+ (remainder 48346261034/10439860591 4478554083/3166815962)
+	       (* 4478554083/3166815962 (quotient 48346261034/10439860591 4478554083/3166815962))) 48346261034/10439860591)
+  (num-test (+ (remainder 584312948386/103768467013 10812186007/7645370045)
+	       (* 10812186007/7645370045 (quotient 584312948386/103768467013 10812186007/7645370045))) 584312948386/103768467013)
+  (num-test (+ (remainder 1663365607631/217976794617 63018038201/44560482149)
+	       (* 63018038201/44560482149 (quotient 1663365607631/217976794617 63018038201/44560482149))) 1663365607631/217976794617)
+  (num-test (+ (remainder 4518285376493/975675645481 152139002499/107578520350)
+	       (* 152139002499/107578520350 (quotient 4518285376493/975675645481 152139002499/107578520350))) 4518285376493/975675645481)
+  (num-test (+ (remainder 10302330360665/1193652440098 367296043199/259717522849)
+	       (* 367296043199/259717522849 (quotient 10302330360665/1193652440098 367296043199/259717522849))) 10302330360665/1193652440098)
+  (num-test (+ (remainder 73997654926903/8573543875303 886731088897/627013566048)
+	       (* 886731088897/627013566048 (quotient 73997654926903/8573543875303 886731088897/627013566048))) 73997654926903/8573543875303)
+  (num-test (+ (remainder 176638380405175/18340740190704 5168247530883/3654502875938)
+	       (* 5168247530883/3654502875938 (quotient 176638380405175/18340740190704 5168247530883/3654502875938))) 176638380405175/18340740190704)
+  (num-test (+ (remainder 468100074910801/83130157078217 12477253282759/8822750406821)
+	       (* 12477253282759/8822750406821 (quotient 468100074910801/83130157078217 12477253282759/8822750406821))) 468100074910801/83130157078217)
+  (num-test (+ (remainder 843389138467141/517121682660006 30122754096401/21300003689580)
+	       (* 30122754096401/21300003689580 (quotient 843389138467141/517121682660006 30122754096401/21300003689580))) 843389138467141/517121682660006)
+  (num-test (+ (remainder 1250127478260940/766512153894657 175568277047523/124145519261542)
+	       (* 175568277047523/124145519261542 (quotient 1250127478260940/766512153894657 175568277047523/124145519261542))) 1250127478260940/766512153894657)
+  (num-test (+ (remainder 21963374527647665/6048967074079039 423859315570607/299713796309065)
+	       (* 423859315570607/299713796309065 (quotient 21963374527647665/6048967074079039 423859315570607/299713796309065))) 21963374527647665/6048967074079039)
+  (num-test (+ (remainder 45760661301451259/9881527843552324 1023286908188737/723573111879672)
+	       (* 1023286908188737/723573111879672 (quotient 45760661301451259/9881527843552324 1023286908188737/723573111879672))) 45760661301451259/9881527843552324)
+  (num-test (+ (remainder 1528546195606366451/177100989030047175 5964153172084899/4217293152016490)
+	       (* 5964153172084899/4217293152016490 (quotient 1528546195606366451/177100989030047175 5964153172084899/4217293152016490))) 1528546195606366451/177100989030047175)
+  (num-test (+ (remainder 543933078269123234/206745572560704147 14398739476117879/10181446324101389)
+	       (* 14398739476117879/10181446324101389 (quotient 543933078269123234/206745572560704147 14398739476117879/10181446324101389))) 543933078269123234/206745572560704147)
+  (num-test (+ (remainder 4808388068050040138/630118245525664765 34761632124320657/24580185800219268)
+	       (* 34761632124320657/24580185800219268 (quotient 4808388068050040138/630118245525664765 34761632124320657/24580185800219268))) 4808388068050040138/630118245525664765))
+
+
+(test (remainder 123 123 123) 'error)
+(test (remainder 123) 'error)
+(test (remainder 3 0) 'error)
+(test (remainder) 'error)
+(test (remainder 2.3 1.0+0.1i) 'error)
+(test (remainder 3.0+2.3i 3) 'error)
+(test (remainder 3 0.0) 'error)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (remainder -inf.0 1855077841/1311738121)))) (define (hi) (func)) (hi)) #t)
+
+(for-each
+ (lambda (arg)
+   (test (remainder arg +nan.0) 'error)
+   (test (remainder +nan.0 arg) 'error)
+   (test (remainder arg +inf.0) 'error)
+   (test (remainder +inf.0 arg) 'error)
+   (test (remainder arg 2) 'error))
+ (list "hi" () (integer->char 65) 0+i #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(for-each
+ (lambda (arg)
+   (test (remainder 2 arg) 'error)
+   (test (remainder 2.0 arg) 'error)
+   (test (remainder 1/2 arg) 'error)
+   (test (remainder 2+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t 0 0+i '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(test (remainder -nan.0 0) 'error)
+(test (remainder -nan.0 0.0) 'error)
+
+(when with-bignums
+  (let ((top-exp 60))
+    (let ((happy #t))
+      (do ((i 2 (+ i 1)))
+	  ((or (not happy) (> i top-exp)))
+	(let* ((val1 (inexact->exact (expt 2 i)))
+	       (val2 (+ val1 1))
+	       (mv (modulo val2 2))
+	       (qv (quotient val2 2))
+	       (rv (remainder val2 2)))
+	  (if (not (= mv 1))
+	      (begin (set! happy #f) (display "(modulo ") (display val2) (display " 2) = ") (display mv) (display "?") (newline)))
+	  (if (not (= qv (/ val1 2)))
+	      (begin (set! happy #f) (display "(quotient ") (display val2) (display " 2) = ") (display qv) (display "?") (newline)))
+	  (if (not (= rv 1))
+	      (begin (set! happy #f) (display "(remainder ") (display val2) (display " 2) = ") (display rv) (display "?") (newline))))))
+
+    (let ((happy #t))
+      (do ((i 2 (+ i 1)))
+	  ((or (not happy) (> i top-exp)))
+	(let* ((val1 (inexact->exact (expt 2 i)))
+	       (val2 (/ (+ val1 1) 2))
+	       (mv (modulo val2 2))
+	       (qv (quotient val2 2))
+	       (rv (remainder val2 2)))
+	  (if (not (= mv 1/2))
+	      (begin (set! happy #f) (display "(modulo ") (display val2) (display " 2) = ") (display mv) (display "?") (newline)))
+	  (if (not (= qv (/ val1 4)))
+	      (begin (set! happy #f) (display "(quotient ") (display val2) (display " 2) = ") (display qv) (display "?") (newline)))
+	  (if (not (= rv 1/2))
+	      (begin (set! happy #f) (display "(remainder ") (display val2) (display " 2) = ") (display rv) (display "?") (newline))))))))
+
+(unless with-bignums
+  (test (remainder 1e20 10) 'error)
+  (test (quotient 1e20 10) 'error))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; gcd
+;;; --------------------------------------------------------------------------------
+
+(num-test (gcd (* 512 500057) (* 128 500057) (* 2048 500057)) 64007296)
+(num-test (gcd (- (expt 2 11) 1) (- (expt 2 19) 1)) (- (expt 2 (gcd 11 19)) 1))
+(num-test (gcd (- (expt 2 11) 1) (- (expt 2 22) 1)) (- (expt 2 (gcd 11 22)) 1))
+(num-test (gcd (- (expt 2 12) 1) (- (expt 2 18) 1)) (- (expt 2 (gcd 12 18)) 1))
+(num-test (gcd (- (expt 2 52) 1) (- (expt 2 39) 1)) (- (expt 2 (gcd 52 39)) 1))
+(num-test (gcd (numerator 7/9) (denominator 7/9)) 1)
+(num-test (gcd -1 -1) 1)
+(num-test (gcd -1 -10) 1)
+(num-test (gcd -1 -1234) 1)
+(num-test (gcd -1 -2) 1)
+(num-test (gcd -1 -3) 1)
+(num-test (gcd -1 -500029) 1)
+(num-test (gcd -1 0) 1)
+(num-test (gcd -1 1) 1)
+(num-test (gcd -1 10) 1)
+(num-test (gcd -1 1234) 1)
+(num-test (gcd -1 2) 1)
+(num-test (gcd -1 3) 1)
+(num-test (gcd -1 500029) 1)
+(num-test (gcd -1) 1)
+(num-test (gcd -1234 -1) 1)
+(num-test (gcd -1234 -10) 2)
+(num-test (gcd -1234 -1234) 1234)
+(num-test (gcd -1234 -2) 2)
+(num-test (gcd -1234 -3) 1)
+(num-test (gcd -1234 -500029) 1)
+(num-test (gcd -1234 0) 1234)
+(num-test (gcd -1234 1) 1)
+(num-test (gcd -1234 10) 2)
+(num-test (gcd -1234 1234) 1234)
+(num-test (gcd -1234 2) 2)
+(num-test (gcd -1234 3) 1)
+(num-test (gcd -1234 500029) 1)
+(num-test (gcd -1234) 1234)
+(num-test (gcd -2 -1) 1)
+(num-test (gcd -2 -10) 2)
+(num-test (gcd -2 -1234) 2)
+(num-test (gcd -2 -2) 2)
+(num-test (gcd -2 -3) 1)
+(num-test (gcd -2 -500029) 1)
+(num-test (gcd -2 0) 2)
+(num-test (gcd -2 1) 1)
+(num-test (gcd -2 10) 2)
+(num-test (gcd -2 1234) 2)
+(num-test (gcd -2 2) 2)
+(num-test (gcd -2 3) 1)
+(num-test (gcd -2 500029) 1)
+(num-test (gcd -2) 2)
+(num-test (gcd -4 0) 4 )
+(num-test (gcd -500029 -1) 1)
+(num-test (gcd -500029 -10) 1)
+(num-test (gcd -500029 -1234) 1)
+(num-test (gcd -500029 -2) 1)
+(num-test (gcd -500029 -3) 1)
+(num-test (gcd -500029 -500029) 500029)
+(num-test (gcd -500029 0) 500029)
+(num-test (gcd -500029 1) 1)
+(num-test (gcd -500029 10) 1)
+(num-test (gcd -500029 1234) 1)
+(num-test (gcd -500029 2) 1)
+(num-test (gcd -500029 3) 1)
+(num-test (gcd -500029 500029) 500029)
+(num-test (gcd -500029) 500029)
+(num-test (gcd 0 -1) 1)
+(num-test (gcd 0 -10) 10)
+(num-test (gcd 0 -1234) 1234)
+(num-test (gcd 0 -2) 2)
+(num-test (gcd 0 -3) 3)
+(num-test (gcd 0 -500029) 500029)
+(num-test (gcd 0 0 0 10) 10)
+(num-test (gcd 0 0) 0)
+(num-test (gcd 0 1) 1)
+(num-test (gcd 0 10 10 1234) 2)
+(num-test (gcd 0 10) 10)
+(num-test (gcd 0 1234 -1234 10) 2)
+(num-test (gcd 0 1234) 1234)
+(num-test (gcd 0 2 2 -500029) 1)
+(num-test (gcd 0 2) 2)
+(num-test (gcd 0 2) 2)
+(num-test (gcd 0 3) 3)
+(num-test (gcd 0 4) 4 )
+(num-test (gcd 0 500029 -500029 -2) 1)
+(num-test (gcd 0 500029) 500029)
+(num-test (gcd 0) 0)
+(num-test (gcd 1 -1) 1)
+(num-test (gcd 1 -10) 1)
+(num-test (gcd 1 -1234) 1)
+(num-test (gcd 1 -2) 1)
+(num-test (gcd 1 -3) 1)
+(num-test (gcd 1 -500029) 1)
+(num-test (gcd 1 0 -1 1) 1)
+(num-test (gcd 1 0) 1)
+(num-test (gcd 1 1 2 -10) 1)
+(num-test (gcd 1 1) 1)
+(num-test (gcd 1 10) 1)
+(num-test (gcd 1 1234) 1)
+(num-test (gcd 1 2) 1)
+(num-test (gcd 1 3 10 500029) 1)
+(num-test (gcd 1 3) 1)
+(num-test (gcd 1 500029) 1)
+(num-test (gcd 1) 1)
+(num-test (gcd 1/10 1/1000000000) 1/1000000000)
+(num-test (gcd 1/1024 1/9765625) 1/10000000000)
+(num-test (gcd 1/131072 1/762939453125) 1/100000000000000000)
+(num-test (gcd 1/2 1/3) 1/6)
+(num-test (gcd 1/2 2) 1/2)
+(num-test (gcd 1/262144 1/3814697265625) 1/1000000000000000000)
+(num-test (gcd 1/3 1/6 5/12 2) 1/12)
+(num-test (gcd 1/3 1/6 5/12) 1/12)
+(num-test (gcd 1/3 2/3) 1/3)
+(num-test (gcd 1/3 3/4 5/8) 1/24)
+(num-test (gcd 1/3 3/4) 1/12)
+(num-test (gcd 1008217762344 4403) 37)
+(num-test (gcd 1111364125679340 6) 6)
+(num-test (gcd 1200780158492850 91686) 354)
+(num-test (gcd 1234 -1) 1)
+(num-test (gcd 1234 -10) 2)
+(num-test (gcd 1234 -1234) 1234)
+(num-test (gcd 1234 -2) 2)
+(num-test (gcd 1234 -3) 1)
+(num-test (gcd 1234 -500029) 1)
+(num-test (gcd 1234 0 -1234 1234) 1234)
+(num-test (gcd 1234 0) 1234)
+(num-test (gcd 1234 1) 1)
+(num-test (gcd 1234 10 0 1) 1)
+(num-test (gcd 1234 10) 2)
+(num-test (gcd 1234 1234 1 -10) 1)
+(num-test (gcd 1234 1234) 1234)
+(num-test (gcd 1234 2 -500029 -3) 1)
+(num-test (gcd 1234 2) 2)
+(num-test (gcd 1234 3) 1)
+(num-test (gcd 1234 500029 3 500029) 1)
+(num-test (gcd 1234 500029) 1)
+(num-test (gcd 1234) 1234)
+(num-test (gcd 1346702251365156 435) 87)
+(num-test (gcd 136581511784536 67022) 62)
+(num-test (gcd 1388225063690465 644) 7)
+(num-test (gcd 15295874 111) 37)
+(num-test (gcd 1551193257090906 2656731) 1749)
+(num-test (gcd 1563464979842 442) 34)
+(num-test (gcd 15858537083857314 21793) 21793)
+(num-test (gcd 163873565922 155) 31)
+(num-test (gcd 178335507754891305 817) 817)
+(num-test (gcd 2 -1) 1)
+(num-test (gcd 2 -10) 2)
+(num-test (gcd 2 -1234) 2)
+(num-test (gcd 2 -2) 2)
+(num-test (gcd 2 -3) 1)
+(num-test (gcd 2 -500029) 1)
+(num-test (gcd 2 0 2 -2) 2)
+(num-test (gcd 2 0) 2)
+(num-test (gcd 2 1 -3 -1) 1)
+(num-test (gcd 2 1) 1)
+(num-test (gcd 2 10) 2)
+(num-test (gcd 2 1234) 2)
+(num-test (gcd 2 2 10 10) 2)
+(num-test (gcd 2 2) 2)
+(num-test (gcd 2 3) 1)
+(num-test (gcd 2 3/4) 1/4)
+(num-test (gcd 2 500029 0 10) 1)
+(num-test (gcd 2 500029) 1)
+(num-test (gcd 2) 2)
+(num-test (gcd 2033404107084 23374) 2)
+(num-test (gcd 20430054 41) 41)
+(num-test (gcd 2090198664 1118) 2)
+(num-test (gcd 21568911 41) 41)
+(num-test (gcd 248255254 767) 13)
+(num-test (gcd 2755 13) 1)
+(num-test (gcd 3 500029 1 -1234) 1)
+(num-test (gcd 3 500029) 1)
+(num-test (gcd 3) 3)
+(num-test (gcd 3/4 2) 1/4)
+(num-test (gcd 32 -36) 4 )
+(num-test (gcd 323 28747 27113) 19)
+(num-test (gcd 3333 -33 1002001) 11)
+(num-test (gcd 3333 -33 101) 1)
+(num-test (gcd 363169800 20) 20)
+(num-test (gcd 3712337724 576173) 23)
+(num-test (gcd 386512944051107445 17) 17)
+(num-test (gcd 406117800 57) 3)
+(num-test (gcd 4097970629150 86) 2)
+(num-test (gcd 4294967298 3) 3)
+(num-test (gcd 43293168048 1344610) 2)
+(num-test (gcd 4380921044390 5) 5)
+(num-test (gcd 4412914630225794 515823) 46893)
+(num-test (gcd 44179338013272 280645) 41)
+(num-test (gcd 500029 -1) 1)
+(num-test (gcd 500029 -10) 1)
+(num-test (gcd 500029 -1234) 1)
+(num-test (gcd 500029 -2) 1)
+(num-test (gcd 500029 -3) 1)
+(num-test (gcd 500029 -500029) 500029)
+(num-test (gcd 500029 0 -500029 -500029) 500029)
+(num-test (gcd 500029 0) 500029)
+(num-test (gcd 500029 1) 1)
+(num-test (gcd 500029 10 -2 -3) 1)
+(num-test (gcd 500029 10) 1)
+(num-test (gcd 500029 1234 3 2) 1)
+(num-test (gcd 500029 1234) 1)
+(num-test (gcd 500029 2 0 1234) 1)
+(num-test (gcd 500029 2) 1)
+(num-test (gcd 500029 3 1 -10) 1)
+(num-test (gcd 500029 3) 1)
+(num-test (gcd 500029 500029 1234 -10) 1)
+(num-test (gcd 500029 500029) 500029)
+(num-test (gcd 500029) 500029)
+(num-test (gcd 510104442 5453) 1)
+(num-test (gcd 524288/5 19073486328125/2) 1/10)
+(num-test (gcd 5275411661289 31857) 21)
+(num-test (gcd 56 2) 2)
+(num-test (gcd 60 42) 6)
+(num-test (gcd 608503422693864 47) 47)
+(num-test (gcd 629448534 2) 2)
+(num-test (gcd 63 -42 35) 7)
+(num-test (gcd 64149298745840 43808357) 35131)
+(num-test (gcd 660070972 74) 74)
+(num-test (gcd 6945109296864 779) 19)
+(num-test (gcd 71862 203) 203)
+(num-test (gcd 7438317458260 31213) 13)
+(num-test (gcd 77874422 32223899) 1)
+(num-test (gcd 82578867500655 319) 29)
+(num-test (gcd 91 -49) 7)
+(num-test (gcd) 0)
+(num-test (gcd 9223372036854775807 -9223372036854775808) (if with-bignums 1 'error))
+
+(num-test (gcd 10400200/16483927 1607521/1136689) 1/18737098497703)
+(num-test (gcd 10781274/17087915 3880899/2744210) 3/9378565444430)
+(num-test (gcd 12/19 41/29) 1/551)
+(num-test (gcd 12941/20511 3363/2378) 1/48775158)
+(num-test (gcd 15601/24727 19601/13860) 1/342716220)
+(num-test (gcd 171928773/272500658 54608393/38613965) 1/10522330870488970)
+(num-test (gcd 190537/301994 114243/80782) 1/12197839654)
+(num-test (gcd 2/3 3/2) 1/6)
+(num-test (gcd 253/401 577/408) 1/163608)
+(num-test (gcd 397573379/630138897 131836323/93222358) 1/58743033845859126)
+(num-test (gcd 4201378396/6659027209 318281039/225058681) 1/1498671880400651329)
+(num-test (gcd 5/8 17/12) 1/24)
+(num-test (gcd 53/84 99/70) 1/420)
+(num-test (gcd 53715833/85137581 9369319/6625109) 1/564045754121329)
+(num-test (gcd 665/1054 1393/985) 7/1038190)
+(num-test (gcd 7161071/11350029 275807/195025) 1/2213539405725)
+(num-test (gcd 79335/125743 47321/33461) 1/4207486523)
+
+(num-test (gcd -2305843009213693952/4611686018427387903) 2305843009213693952/4611686018427387903)
+(test (gcd 1/92233720368547758 1/3005) (if with-bignums 1/277162329707486012790 'error))
+(test (gcd -9223372036854775808) (if with-bignums 9223372036854775808 'error))
+(test (gcd -9223372036854775808 -9223372036854775808) (if with-bignums 9223372036854775808 'error))
+
+(test (gcd 0 "hi") 'error)
+(test (gcd 1 "hi") 'error)
+(test (gcd 3 5 #\a) 'error)
+(test (gcd 1.4 2.3) 'error)
+(test (gcd 1.0) 'error)
+(test (gcd 0/0) 'error)
+(test (gcd 2 1.0+0.5i) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (gcd arg +nan.0) 'error)
+   (test (gcd +nan.0 arg) 'error)
+   (test (gcd arg +inf.0) 'error)
+   (test (gcd +inf.0 arg) 'error)
+   (test (gcd arg 2) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(for-each
+ (lambda (arg)
+   (test (gcd 2 arg) 'error)
+   (test (gcd 1/2 arg) 'error)
+   (test (gcd 2.0 arg) 'error)
+   (test (gcd 2+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(when with-bignums
+  (num-test (gcd (* 2 (ash 1 63)) 72) 8)
+  (num-test (gcd 72 (* 2 (ash 1 63))) 8)
+  (test (bignum? (gcd (* 2 (ash 1 63)) 72)) #f)
+  (test (bignum? (gcd 72 (* 2 (ash 1 63)))) #f)
+  (num-test (gcd -9223372036854775808 -9223372036854775808) 9223372036854775808)
+  (num-test (gcd -9223372036854775808 9223372036854775807 -9223372036854775808) 1)
+  (num-test (gcd 12345678901234567890 12345) 15)
+  (num-test (gcd 2155967190204955525121 -12850565775361 93458656690177) 557057)
+  (num-test (gcd 2155967190204955525121 0) 2155967190204955525121)
+  (num-test (gcd 2155967190204955525121 12850565775361 93458656690177) 557057)
+  (num-test (gcd 2346026393680644703525505657 17293822570713318399) 11)
+  (num-test (gcd 974507656412513757857315037382926980395082974811562770185617915360 -1539496810360685510909469177732386446833404488164283) 1)
+  (num-test (gcd 460683358924445799142 518) 518)
+  (num-test (gcd 113021475230160 74635) 6785)
+  (num-test (gcd 74228340534140364 363909) 1677)
+  (num-test (gcd 69242022961311060 48305942) 60458)
+  (num-test (gcd -286967952870300 2273388) 156)
+  (num-test (gcd 302822258393413362492399 29) 29)
+  (num-test (gcd 10491072879382200 133) 133)
+  (num-test (gcd 167206737423420464 609) 7)
+  (num-test (gcd 72212583812867784 4888799) 47)
+  (num-test (gcd 4170116471639397292390 1798025) 359605)
+  (num-test (gcd 83910330283522050 35224) 238)
+  (num-test (gcd 275373383775647594346 66884092) 104834)
+  (num-test (gcd 14656657495570695990 37) 1)
+  (num-test (gcd 95470974177676509874110 1219) 1219)
+  (num-test (gcd 619506317623001424 -5957) 7)
+  (num-test (gcd 11268171656665155960 9858) 186)
+  (num-test (gcd 6172860073826160 5167394) 3074)
+  (num-test (gcd 26457493095663264 1491412) 3956)
+  (num-test (gcd -8481384175941103284 313836405) 51)
+  (num-test (gcd 60356595775749199080 -176098815946) 1716346)
+  (num-test (gcd 611492274956002440 37) 37)
+  (num-test (gcd 164614611843685080 1711) 59)
+  (num-test (gcd 93177516542679418720 62197) 37)
+  (num-test (gcd 938959746797519770440 127558) 127558)
+  (num-test (gcd 137670522526899326250 200) 50)
+  (num-test (gcd 852063402206742880 41643478) 58406)
+  (num-test (gcd 55947291202307909360 188546228) 6364)
+  (num-test (gcd 12877971214039423262680 9832253830) 121730)
+  (num-test (gcd 192158415774146059920 53) 53)
+  (num-test (gcd 902814024155808960 1829) 31)
+  (num-test (gcd 1265864304573235487120 4921) 259)
+  (num-test (gcd -14172662463567665400 95817) 57)
+  (num-test (gcd 32171996211745702482324 2368555) 259)
+  (num-test (gcd 971324258606045826300 4576748) 236)
+  (num-test (gcd 2400649320046378377000 1704690) 930)
+  (num-test (gcd 953233796456393760 18342152493) 574287)
+  (num-test (gcd 28906333140964843080 236206740) 823020)
+  (num-test (gcd 775403093708557121609032 41) 41)
+  (num-test (gcd 12587009808135760402860 2491) 47)
+  (num-test (gcd 510685807527370566909720 76) 4)
+  (num-test (gcd 9842598153710524682146590 10089) 3363)
+  (num-test (gcd 44936631038618189620242012 30740) 6148)
+  (num-test (gcd 934589372977008750144 373650) 282)
+  (num-test (gcd 33027125273398900134069150 840577803) 840577803)
+  (num-test (gcd 4428219127938822420288 1695783782) 12502)
+  (num-test (gcd 29316428815807608915440 560764380) 153340)
+  (num-test (gcd 1364397376360544429904 19) 19)
+  (num-test (gcd 4991450791697293128313385277 329) 7)
+  (num-test (gcd 75448279792981695149550 3009) 3)
+  (num-test (gcd 181031604499464166188731133 3364) 1)
+  (num-test (gcd 405831142402606479845286 2746214) 161542)
+  (num-test (gcd 89170366469003867207160 25337230) 11470)
+  (num-test (gcd 13523725766340619200 1490114045) 28595)
+  (num-test (gcd 104705939487154940255412 192200052) 26196)
+  (num-test (gcd 7232591421499800642000 16584679460) 7820)
+  (num-test (gcd 14043796716396386984750160 -33382708236) 358953852)
+  (num-test (gcd 13894638105872256412416 23) 23)
+  (num-test (gcd 147611447155643499428400 118) 2)
+  (num-test (gcd 13356594697070649024 4558) 106)
+  (num-test (gcd 15089731174706036171537760 90) 30)
+  (num-test (gcd 307230141273924828960 1971507) 1581)
+  (num-test (gcd 2582563944548247741930009096 22873474) 1759498)
+  (num-test (gcd 1074296602920111687342072 146235518) 21758)
+  (num-test (gcd 774058642832724262993980 -407557010) 2531410)
+  (num-test (gcd 291091930213008490369569480 13412544348) 26508)
+  (num-test (gcd 2089068565149831833568 7302038455228) 68171356)
+  (num-test (gcd 1064437567441124038217970656 5) 1)
+  (num-test (gcd 142557826750459447787460 1333) 31)
+  (num-test (gcd 311779340580033594160200 23693) 23693)
+  (num-test (gcd 29314187023691666530559664 110143) 110143)
+  (num-test (gcd 222003853016244177637944900 857463) 857463)
+  (num-test (gcd 6247776111945111006243552 77976501) 2515371)
+  (num-test (gcd 1140058514761397155259712 5530338) 502758)
+  (num-test (gcd 580962736822969724865449808 55686036) 1505028)
+  (num-test (gcd 4100502596989506786787500 45333475410) 563730)
+  (num-test (gcd 1497378750311599979536944 262630276090) 361046)
+  (num-test (gcd 105637634198318524045536 2633013240) 150072)
+  (num-test (gcd 11415822547029425161364106595632 7) 1)
+  (num-test (gcd 198305933339312916107438448 177) 3)
+  (num-test (gcd 3127415425979879537134790928 3335) 667)
+  (num-test (gcd 589703503861221139260034914750 13209) 357)
+  (num-test (gcd 3108579252052448504121792 14322) 462)
+  (num-test (gcd 636976201153021006473464400 66264077) 3487583)
+  (num-test (gcd 9544425315508129998909285900 1488396) 212628)
+  (num-test (gcd 458100280193857502802977376 260747103934) 6212554)
+  (num-test (gcd 114208186302155358124900650 22076867505) 6342105)
+  (num-test (gcd 90107067439719108194114160 28566806069714) 3408519994)
+  (num-test (gcd 2976572787365723002218245484 -110104803958578) 2966904798)
+  (num-test (gcd 53453375725613238735360 17) 1)
+  (num-test (gcd 888822833524306124874229800 106) 106)
+  (num-test (gcd 21275338550698297089687698855820 3021) 3021)
+  (num-test (gcd 417525245705449941528380320750068 5828) 5828)
+  (num-test (gcd 1954871230146370370001829871352 22765249) 22765249)
+  (num-test (gcd 903057827710908645847577520 648545995) 520085)
+  (num-test (gcd 6002846634833433581621040 28493572159) 27869)
+  (num-test (gcd 26428903214964558277189300080 100428856) 3463064)
+  (num-test (gcd 470486531607553676511206181180 28495896) 2964)
+  (num-test (gcd 483599554429365539310928369206620 5577334078910) 105232718470)
+  (num-test (gcd 134511400157705323668887400 -1285071093558916) 340069628)
+  (num-test (gcd -25897125642468049125349982599216 1183846707540) 26307704612)
+  (num-test (gcd 1118034209930460291955200 3) 3)
+  (num-test (gcd 16297594064835666104344589410644 413) 413)
+  (num-test (gcd 536762539932642345554192060100 1378) 1378)
+  (num-test (gcd 933250179448203335817687635834340 58029) 69)
+  (num-test (gcd 65573457048202714607131200 486115) 3655)
+  (num-test (gcd 85664559165674439863772868932 322014) 322014)
+  (num-test (gcd 7232817686074320060728552759760 11307940) 11307940)
+  (num-test (gcd 78400098291720425971762131120 5646921093) 5646921093)
+  (num-test (gcd 345445746644065669842240 19727989065) 2193705)
+  (num-test (gcd 627854758484491743169777558200 -750371721805653) 156322329)
+  (num-test (gcd 788233263079483492974876830792850 7170146100) 5867550)
+  (num-test (gcd 18378856389802641496737518160 6247594493140) 824329660)
+  (num-test (gcd 9620902642431357480148667659080 59) 59)
+  (num-test (gcd 16008524600631853118144316000 629) 1)
+  (num-test (gcd 4342138447708715023205684275423920 53041) 1711)
+  (num-test (gcd 2431833161592653384508687244500 47541) 47541)
+  (num-test (gcd 39424620224103957589082132160 1671734) 1671734)
+  (num-test (gcd 652830233576052788654372406432 552231327) 12842589)
+  (num-test (gcd 6892963340916411083970414000 3662431431) 77924073)
+  (num-test (gcd 29102758215190063506219566460000 10565720) 10565720)
+  (num-test (gcd 21253900104556838003127171970777418412 1182797770) 62698)
+  (num-test (gcd 3964268932242030284914943132662620 21244177854110) 18521515130)
+  (num-test (gcd 6070388091189460078138338240 40809131994181213) 274113073169)
+  (num-test (gcd 9685989954133695108793384134000 964113514382876) 169529367748)
+  (num-test (gcd 56468122001858834917195045500 -429400787158167902) 2090772606538)
+  (num-test (gcd 18843408973202596901221568364900 47) 47)
+  (num-test (gcd 7800980538292163259967028613764250 6) 6)
+  (num-test (gcd 270433907726619219545089642715200 3422) 58)
+  (num-test (gcd 45771666919597903071546708768 2342359) 2183)
+  (num-test (gcd 47198294949461301503537593835384892 314502) 5934)
+  (num-test (gcd 3165335901519110207943908102359110 14953473) 207)
+  (num-test (gcd 189219585097956261544520863361400 35605794) 35605794)
+  (num-test (gcd -38532137569034426600955256933810890813 -1341358608707) 6436369)
+  (num-test (gcd 1396277868664090735481380981225896 312520860) 62504172)
+  (num-test (gcd -864038349500762576564773759109700 714136202724) 16607818668)
+  (num-test (gcd 12514185871591242579049167322464 10706997440178) 200614518)
+  (num-test (gcd 1981802660405609330969478067056636 33312289752) 14779188)
+  (num-test (gcd 979313401024175219420658240 125278417383795) 1551032145)
+  (num-test (gcd 4074026154111369481048033354344 29) 29)
+  (num-test (gcd 599666571180604695702511920885005100 129) 129)
+  (num-test (gcd 5703263639326551702474610108800 1978) 1978)
+  (num-test (gcd 134137932950214683609064669163440 190619) 143)
+  (num-test (gcd 344735091370772631136645455600 1048985) 1048985)
+  (num-test (gcd 6759508339299085316106145385400 4969610) 160310)
+  (num-test (gcd 700334422308861928135313594400 228529587) 432003)
+  (num-test (gcd 10277417891211405957191810814198480 2516552038) 228777458)
+  (num-test (gcd 490099971577877358878082782880 9282588354) 17547426)
+  (num-test (gcd 1954558750269048828645390249600 5575829490) 327989970)
+  (num-test (gcd 1360588454560018295496656378989200 7868178296420) 14873682980)
+  (num-test (gcd 4337552841738910859248770564912480 17722936528737830) 338114285990)
+  (num-test (gcd 215913068853045803981566931862756 7009479781500) 2930844)
+  (num-test (gcd 44890707654126305940250882318870941900 18329973480720) 1527497790060)
+  (num-test (gcd 28579720891831355496720656680837200 3) 3)
+  (num-test (gcd 29332703209780553199747293473184160 1711) 29)
+  (num-test (gcd 3648979393315349438003046604440000 186) 186)
+  (num-test (gcd 1159760236369472473822068077011807878780 25714) 25714)
+  (num-test (gcd 158186359726371025615685433600 31395) 4485)
+  (num-test (gcd 331091450443070201468559735703944 28424) 28424)
+  (num-test (gcd 9734443639363161342241553023288200 1961348207) 63269297)
+  (num-test (gcd 701896612128009033011419603540080 51300) 3420)
+  (num-test (gcd 86169288128517384618860929451245320 5032162527446) 180164066)
+  (num-test (gcd 64828800524794653881296183831741773624 4645294472) 6354712)
+  (num-test (gcd 49068907706533938991402184550000 268183371225) 742890225)
+  (num-test (gcd 1708602980304476478496020543612288 4083128544) 131713824)
+  (num-test (gcd 17608179287674151740172985536160 980399424528) 91686096)
+  (num-test (gcd 43194437079731225735521919644800 -178119261126453036) 80633436453804)
+  (num-test (gcd 817555977437791699707628651571149344 59) 59)
+  (num-test (gcd 19062946261334997559157066059536 533) 41)
+  (num-test (gcd 6533849124840489114353090499099000 598) 26)
+  (num-test (gcd 427663965127849896842400211428345149025 234) 117)
+  (num-test (gcd 352395507261316174741530450071590608 154734) 3774)
+  (num-test (gcd 391579493632653867660919800000 9221565) 645)
+  (num-test (gcd 2618798923882923048581401148931738000 681876) 52452)
+  (num-test (gcd 174712575449141140214591110997980800 233260339838) 126154862)
+  (num-test (gcd 88598141227372995032227898284800 1929763976) 155288)
+  (num-test (gcd 210110141308655567793064872567302676320 720390430628) 468699044)
+  (num-test (gcd 668425085137718599277317523827419000 19898594339442) 58711254)
+  (num-test (gcd 89533471731097208414073727453200 4173840860670546) 2257350384354)
+  (num-test (gcd 113987439157802480362236410675251462620 21548296273949445)  1134120856523655)
+  (num-test (gcd 48129335993995093308894209644253760 1009442888504820) 84891337020)
+  (num-test (gcd -3497836376962291922989777163497680 138736290091634664)  3383811953454504)
+  (num-test (gcd 11371924962562208722154622794880 3) 3)
+  (num-test (gcd 9451631862008339290824315653784000 703) 19)
+  (num-test (gcd 16869347753325980368094612370435598560 806) 806)
+  (num-test (gcd 4701845646467068759127854100132739552 3198) 6)
+  (num-test (gcd 1029865193584911347147121232800485280 1005771) 24531)
+  (num-test (gcd 10657125216930337802109861408000 2415138) 2838)
+  (num-test (gcd 14382707743772734802155022983680 247913634) 144894)
+  (num-test (gcd 60134748581470366378101904574533857248 54828228) 493948)
+  (num-test (gcd 214830664120540781167218700750596000 505665810) 11759670)
+  (num-test (gcd 48933004118344447687599112101802800 6263883444) 106167516)
+  (num-test (gcd 5498670161558110606435630054129739400 262699548132) 1346604)
+  (num-test (gcd 35941673649029587182509620977230062500 25622409466332) 525598668)
+  (num-test (gcd 1592802602494326390643157055239113248 736377633395508) 960075141324)
+  (num-test (gcd 4043816553144402557587143272522043028314 5011466158645380)  366067652202)
+  (num-test (gcd 7171921165220830707276631005512550 1765284492289500) 176528449228950)
+  (num-test (gcd 2402189359210218692854826119405968750 23) 1)
+  (num-test (gcd 26149068753160488131648964110990162400 1147) 31)
+  (num-test (gcd 556184059176863945810376239306506311552 4089) 4089)
+  (num-test (gcd 67871323087036310486238021899264593800 13395) 13395)
+  (num-test (gcd 12750401179065252879838440979200 -7177173) 7177173)
+  (num-test (gcd 278110245000092733617125071646080 17748) 17748)
+  (num-test (gcd 13408203364935178481017292708752000 50619404) 1368092)
+  (num-test (gcd 124271828931784534297423756437875067000 -8839796595) 4068015)
+  (num-test (gcd 11893442806922081156953529319100769836176 972789007267) 983608703)
+  (num-test (gcd 352581052555284857902053030133344488264100 923561430099) 54327142947)
+  (num-test (gcd 6108908012714804315575319947340956346976 31944833628092) 97096758748)
+  (num-test (gcd 67475643422116264959949054821520228800 22515435540) 326310660)
+  (num-test (gcd 470601888939348535946408832 5135943991060962937) 36905011)
+  (num-test (gcd -110759232155568113345545635903016614000 30159198663300)  30159198663300)
+  (num-test (gcd 146100914712024458707469587112300146320 26868173101560) 10304280)
+  (num-test (gcd 12173192708601511002951184416658091200 466645866900785428350)  1496624001041650)
+  (num-test (gcd 5784684831478746253226687170890240 13) 13)
+  (num-test (gcd 35042260655085685815432622412891903767500 667) 667)
+  (num-test (gcd 2903871349270676921837488659419545120987500 530) 530)
+  (num-test (gcd 630123969240840167098426767919876491188000 77691) 25897)
+  (num-test (gcd 33192703032132982013024959634241667249800 4684718) 126614)
+  (num-test (gcd 4731525733734729472809717145544850000 90706055) 90706055)
+  (num-test (gcd 214011009809686092216200126896120006823232 50400042) 258)
+  (num-test (gcd 5854250735296111435541950856160000 24357777002) 817622)
+  (num-test (gcd 35348208247612761916374738259136697649608 156806713508) 8596388)
+  (num-test (gcd 612558317420289618714916924536521515286100 2377007388) 125105652)
+  (num-test (gcd 181857299802925368992522029882739454720 21606337755618)  21606337755618)
+  (num-test (gcd 4731635341196946327443020710970699860000 58092526675092) 776108892)
+  (num-test (gcd 22081740554432638182773611616166588288192 61419768950540)  12283953790108)
+  (num-test (gcd 125627844706077784535328068665849312000 30482033400) 32200)
+  (num-test (gcd 1225504716872819103560254268197955520 510813364186125) 168863922045)
+  (num-test (gcd 5209185280578468690281136425214396728400 2327880739319250103818)  829166238)
+  (num-test (gcd 230425011604643097634961294406535254400 31) 31)
+  (num-test (gcd 13222608481676137093434201748083744000 893) 893)
+  (num-test (gcd 13348198818240350339028224064019716678960 651) 3)
+  (num-test (gcd 7236172685650198160266777676385295337308176 23426) 442)
+  (num-test (gcd 756264162229440667711265021676693350760 28899) 28899)
+  (num-test (gcd 40915062421030872924283823601517905600 36345062) 36345062)
+  (num-test (gcd 1174590526522170015825602834292923520 4991486258) 145114)
+  (num-test (gcd 2891892862328155581145450075391651333218020 35138529818) 35138529818)
+  (num-test (gcd 1993335355070485984559797658834121810059400 535644500) 2612900)
+  (num-test (gcd 6324295450641455215591954662726515160 367472693133) 8962748613)
+  (num-test (gcd 6576388154814679090356195121505112000 15901952377630) 969690370)
+  (num-test (gcd 117828556355409428513249595788296238400 565992666495795) 33126555)
+  (num-test (gcd 592831716700236607285748949860604000 139641978135660) 343100683380)
+  (num-test (gcd 106766839071170184723986891291602032000 1584924526628112)  1983635202288)
+  (num-test (gcd 21677148858122146832326483307664860804937400 247815827510760)  9178363981880)
+  (num-test (gcd 14079549844487257384278196623697173813600 160967604100961853832)  42959600534344)
+  (num-test (gcd 2696480372014145687016224877963234647656980 -2219319031453896088860)  1258830987778727220)
+  (num-test (gcd 13545431257849875145060979241270859310160 29) 29)
+  (num-test (gcd 137485634482479300158725199474868559498162500 329) 47)
+  (num-test (gcd 529252417743761759027305009539254400 3243) 3243)
+  (num-test (gcd 133897419738958073238580385894509887148800 330455) 330455)
+  (num-test (gcd 3896215507210178905244623173635584334007288624 1005238) 1005238)
+  (num-test (gcd 17654511984514518592175290794029073043800 1060530) 36570)
+  (num-test (gcd 16470780256339082688310222474503880382858400 913836) 913836)
+  (num-test (gcd 57267105834722825210001789897760395576000 2958974018) 62956894)
+  (num-test (gcd 521977833444747522001426544601807810543216 1066521690) 4960566)
+  (num-test (gcd 1699559962174727325529414216960251941390400 25883611479) 30924267)
+  (num-test (gcd 10654036597801063717295948399628964800 317449894126222) 19212606314)
+  (num-test (gcd 381902381115592200811990304316262139150724960 4640335440216)  4640335440216)
+  (num-test (gcd 425968526187959807410151867411382902838703889232 1882826315615025)  4430179566153)
+  (num-test (gcd 174609167728518272531601927200939868792000 1712923655178450) 6189150)
+  (num-test (gcd 3325168366561555458817274989681612518000 1699726139891780)  130748164607060)
+  (num-test (gcd 11429650426242566426919762928176000 7414967839104) 5416338816)
+  (num-test (gcd 2104794191230056678355480848036599377844400 -16946684823025584)  182222417451888)
+  (num-test (gcd 11894522530167763519415142641640874994880 7) 7)
+  (num-test (gcd 5906329981690378696996009087718418780000 185) 185)
+  (num-test (gcd 3056294774178096513474941936265025440000 658) 658)
+  (num-test (gcd 10491907660880423349353457742257185280 123369) 123369)
+  (num-test (gcd 673239479595593149777212259021965839229225628776 15470) 3094)
+  (num-test (gcd 1506608574369860432616005754109397877696 1474070) 294814)
+  (num-test (gcd 4849814041048623250005708880379694793905000 2172220582) 2172220582)
+  (num-test (gcd 21154344928580705924176101470087564940000 5023204186) 5023204186)
+  (num-test (gcd 346448039376394135288065831861806112294000 776147372) 25037012)
+  (num-test (gcd 2339009760844587560470606952218133142645504 194201967414) 5248701822)
+  (num-test (gcd 2242982161480922111384667548175169152 21419749763490) 2316901002)
+  (num-test (gcd 4717315265246821759830981157482117120 45609714193992) 26227552728)
+  (num-test (gcd 16628111321698075419789804224660024289936 4643626415880804)  1653124391556)
+  (num-test (gcd 115557531507210992033160068979962880 88406536976058378)  36546728803662)
+  (num-test (gcd 21059511907771200155093927745003762840000 180298981648603620)  191197223381340)
+  (num-test (gcd 2124921015128697258800067298086064536000 2282525112298516782924)  15103625661372)
+  (num-test (gcd 16015671538624533047089928322348864000 49817926936366875)  69075001125)
+  (num-test (gcd 166517667014186289390514558017250969134523800 -43413708621878528404068)  1188862957578074004)
+  (num-test (gcd -2780796292789128359666429021610464935722000 47) 47)
+  (num-test (gcd 21297913114430245153455383503409684916193317960 58) 58)
+  (num-test (gcd 1516745257039775143654568869485529015398000 6293) 6293)
+  (num-test (gcd 8447692776411453120390905608381515479808 2030) 14)
+  (num-test (gcd 958876033949638283967045624731391031146081240 9834415) 166685)
+  (num-test (gcd 4731349833403602529573388098680617532624192 14868) 14868)
+  (num-test (gcd 6375001358038970462026761077388061675464000 430513678) 430513678)
+  (num-test (gcd 254088526608579040642428151389718385042344800 4799428101) 255411)
+  (num-test (gcd 21140490542258031885408065086507444825621023648 164778747198)  13189686)
+  (num-test (gcd 34214837305812460226811046733375808000 4312787868) 746028)
+  (num-test (gcd 11450197571956515037245443769386989035470896800 75585518430279)  5814270648483)
+  (num-test (gcd 1211397915863796187148880114197307052796506376580 538601201880)  11708721780)
+  (num-test (gcd 5454139401260819402160859765169199667337088 30452838731872)  48414687968)
+  (num-test (gcd 744935981632690384026127091216926530879171660 1032747922358460)  60868033380)
+  (num-test (gcd 324574326062026951443376280715122947502400 103751223626207988025)  3334229637375325)
+  (num-test (gcd 15272163751269260921486082393684080908800 6484309049057400)  341279423634600)
+  (num-test (gcd 386527546655781220813671331401971490218262720 3481571963427119100)  1915440648660)
+  (num-test (gcd 3189682029126430413458911948222943640000 -6724598925622907976570)  829921474949490)
+  (num-test (gcd -709403542855323660533377490060722241678400 7) 7)
+  (num-test (gcd 139803787314578422635552652090095842837312147438904 123) 123)
+  (num-test (gcd 171985399350431759069945935900956183322827030835560 18241) 18241)
+  (num-test (gcd 33090522521924986387051477884789600000 26187) 609)
+  (num-test (gcd 1733723010009930088165729903139785699319986530 372945) 7935)
+  (num-test (gcd 56408303994570817306318494803635460247582000 5761730) 10810)
+  (num-test (gcd 25845509336769185412951159262424903513866295760 64371378271)  64371378271)
+  (num-test (gcd 624970361450506104794172455132584603069611058500 108222780)  108222780)
+  (num-test (gcd 82823962548382643645255524843049561752323600 135325929794)  12302357254)
+  (num-test (gcd 170620453449723034746079844571491973300000 9460614789626)  230746702186)
+  (num-test (gcd 125144597811313015929871740675462711600000 12764411911636)  12726233212)
+  (num-test (gcd 257193319319332344553297882967977761077115600 6510126541380)  158783574180)
+  (num-test (gcd 879624546681838385457288074812140664728758550 10045784120501316)  80757786714)
+  (num-test (gcd 18300938860777100857669855248554588369659200 118088077425391892)  1433647093268)
+  (num-test (gcd 8394780474625841647581984803260010511075000 746584618179400)  11198041400)
+  (num-test (gcd 146802334713757872619395774222116859916800 718775571956687400)  854667743111400)
+  (num-test (gcd 240155883351717999820072393833707008014911556000 -1350921510529331832)  10157304590446104)
+  (num-test (gcd -918942437243241528855354123800826649596480 -74343962238703160850)  3476056267530)
+  (num-test (gcd 1361069299753299783990135442290762165844800 8281085446358585640)  8546011812547560)
+
+  (num-test (gcd 111738283365989051/177100989030047175 5964153172084899/4217293152016490) 1/149377357650353093734710215583150)
+  (num-test (gcd 11571718688839/18340740190704 5168247530883/3654502875938) 1/33513143886879715286440176)
+  (num-test (gcd 130441933147714940/206745572560704147 14398739476117879/10181446324101389) 1/2104968949772418231181062860760183)
+  (num-test (gcd 137528045312/217976794617 63018038201/44560482149) 1/9713151065427067791933)
+  (num-test (gcd 205632218873398596256/325919355854421968365 16616132878186749607/11749380235262596085) 1/5590292610168557896833020882635974965)
+  (num-test (gcd 22803850947114245497/36143248623210700400 1180872205318713601/835002744095575440) 1/34295127023760867970857561935725200)
+  (num-test (gcd 326267455807135/517121682660006 30122754096401/21300003689580) 1/1835782291436657618117489580)
+  (num-test (gcd 3447601211185766107/5464318637170278738 202605639573839043/143263821649299118) 1/391419585335252015613280949198776542)
+  (num-test (gcd 3816473305410548/6048967074079039 423859315570607/299713796309065) 313/1812958885520765991472282188535)
+  (num-test (gcd 397560349370386783/630118245525664765 34761632124320657/24580185800219268) 17/15488423551129023359673258461692020)
+  (num-test (gcd 4640282259296926456/7354673373747273033 489133282872437279/345869461223138161) 1/2543756917250129165517177396348512313)
+  (num-test (gcd 483615324366283/766512153894657 175568277047523/124145519261542) 1/95159049365535186345899381094)
+  (num-test (gcd 50247984153525417450/79641170620168673833 2850877693509864481/2015874949414289041) 1/160546640795227287934843564657515364153)
+  (num-test (gcd 5409303924479/8573543875303 886731088897/627013566048) 1/5375728318922723466512544)
+  (num-test (gcd 5680010011095224105765/9002602871306688466954 40114893348711941777/28365513113449345692) 1/127681724900613301985499022520606932131084)
+  (num-test (gcd 615582794569/975675645481 152139002499/107578520350) 19/104961742282377144038350)
+  (num-test (gcd 6189245291/9809721694 1855077841/1311738121) 1/12867785902420496974)
+  (num-test (gcd 6234549927241963/9881527843552324 1023286908188737/723573111879672) 1/105147174292423231311078293496)
+  (num-test (gcd 65470613321/103768467013 10812186007/7645370045) 1/793348329316760825585)
+  (num-test (gcd 6586818670/10439860591 4478554083/3166815962) 1/33061117160633553542)
+  (num-test (gcd 7530699980955811472069/11935877073996486182239 96845919575610633161/68480406462161287469) 1/817373713509671731923053344199644801063091)
+  (num-test (gcd 753110839881/1193652440098 367296043199/259717522849) 1/310012454884916918799202))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; lcm
+;;; --------------------------------------------------------------------------------
+
+(num-test (lcm (* 512 500057) (* 128 500057) (* 2048 500057)) 1024116736)
+(num-test (lcm (/ (expt 2 10)) (/ (expt 3 10))) 1)
+(num-test (lcm (/ (expt 2 57) 3) (/ 63 11)) 9079256848778919936)
+(num-test (lcm (/ 3 (expt 2 10)) (/ 2 (expt 3 10))) 6)
+(num-test (lcm (/ 3 (expt 2 40)) (/ 2 (expt 3 10))) 6)
+(num-test (lcm (/ 3 (expt 2 60)) (/ 2 (expt 2 30))) 3/536870912)
+(num-test (lcm (/ 3 (expt 2 60)) (/ 2 (expt 3 30))) 6)
+(num-test (lcm -1 -1) 1)
+(num-test (lcm -1 -10) 10)
+(num-test (lcm -1 -1234) 1234)
+(num-test (lcm -1 -2) 2)
+(num-test (lcm -1 -3) 3)
+(num-test (lcm -1 -500029) 500029)
+(num-test (lcm -1 0) 0)
+(num-test (lcm -1 1) 1)
+(num-test (lcm -1 10) 10)
+(num-test (lcm -1 1234) 1234)
+(num-test (lcm -1 2) 2)
+(num-test (lcm -1 3) 3)
+(num-test (lcm -1 500029) 500029)
+(num-test (lcm -1) 1)
+(num-test (lcm -1/2 -2) 2)
+(num-test (lcm -1234 -1) 1234)
+(num-test (lcm -1234 -10) 6170)
+(num-test (lcm -1234 -1234) 1234)
+(num-test (lcm -1234 -2) 1234)
+(num-test (lcm -1234 -3) 3702)
+(num-test (lcm -1234 -500029) 617035786)
+(num-test (lcm -1234 0) 0)
+(num-test (lcm -1234 1) 1234)
+(num-test (lcm -1234 10) 6170)
+(num-test (lcm -1234 1234) 1234)
+(num-test (lcm -1234 2) 1234)
+(num-test (lcm -1234 3) 3702)
+(num-test (lcm -1234 500029) 617035786)
+(num-test (lcm -1234) 1234)
+(num-test (lcm -2 -1) 2)
+(num-test (lcm -2 -10) 10)
+(num-test (lcm -2 -1234) 1234)
+(num-test (lcm -2 -2) 2)
+(num-test (lcm -2 -3) 6)
+(num-test (lcm -2 -500029) 1000058)
+(num-test (lcm -2 0) 0)
+(num-test (lcm -2 1) 2)
+(num-test (lcm -2 10) 10)
+(num-test (lcm -2 1234) 1234)
+(num-test (lcm -2 2) 2)
+(num-test (lcm -2 3) 6)
+(num-test (lcm -2 500029) 1000058)
+(num-test (lcm -2) 2)
+(num-test (lcm -500029 -1) 500029)
+(num-test (lcm -500029 -10) 5000290)
+(num-test (lcm -500029 -1234) 617035786)
+(num-test (lcm -500029 -2) 1000058)
+(num-test (lcm -500029 -3) 1500087)
+(num-test (lcm -500029 -500029) 500029)
+(num-test (lcm -500029 0) 0)
+(num-test (lcm -500029 1) 500029)
+(num-test (lcm -500029 10) 5000290)
+(num-test (lcm -500029 1234) 617035786)
+(num-test (lcm -500029 2) 1000058)
+(num-test (lcm -500029 3) 1500087)
+(num-test (lcm -500029 500029) 500029)
+(num-test (lcm -500029) 500029)
+(num-test (lcm 0 -1) 0)
+(num-test (lcm 0 -10) 0)
+(num-test (lcm 0 -1234) 0)
+(num-test (lcm 0 -2) 0)
+(num-test (lcm 0 -3) 0)
+(num-test (lcm 0 -500029) 0)
+(num-test (lcm 0 0 0 10) 0)
+(num-test (lcm 0 0) 0)
+(num-test (lcm 0 1) 0)
+(num-test (lcm 0 10 10 1234) 0)
+(num-test (lcm 0 10) 0)
+(num-test (lcm 0 1234 -1234 10) 0)
+(num-test (lcm 0 1234) 0)
+(num-test (lcm 0 2) 0)
+(num-test (lcm 0 3) 0)
+(num-test (lcm 0 500029) 0)
+(num-test (lcm 0) 0)
+(num-test (lcm 1 -1) 1)
+(num-test (lcm 1 -10) 10)
+(num-test (lcm 1 -1234) 1234)
+(num-test (lcm 1 -2) 2)
+(num-test (lcm 1 -3) 3)
+(num-test (lcm 1 -500029) 500029)
+(num-test (lcm 1 0 -1 1) 0)
+(num-test (lcm 1 0) 0)
+(num-test (lcm 1 1 2 -10) 10)
+(num-test (lcm 1 1) 1)
+(num-test (lcm 1 10) 10)
+(num-test (lcm 1 1234) 1234)
+(num-test (lcm 1 2) 2)
+(num-test (lcm 1 3) 3)
+(num-test (lcm 1 500029) 500029)
+(num-test (lcm 1) 1)
+(num-test (lcm 1/2 -2) 2)
+(num-test (lcm 1/2 2) 2)
+(num-test (lcm 1/21 1/33) 1/3)
+(num-test (lcm 1/3 1/6 5/12 2) 10)
+(num-test (lcm 1/3 1/6 5/12) 5/3)
+(num-test (lcm 1/3 2/3) 2/3)
+(num-test (lcm 1/3 3/4 5/8) 15)
+(num-test (lcm 1/3 3/4) 3)
+(num-test (lcm 1024 9765625) 10000000000)
+(num-test (lcm 1234 -1) 1234)
+(num-test (lcm 1234 -10) 6170)
+(num-test (lcm 1234 -1234) 1234)
+(num-test (lcm 1234 -2) 1234)
+(num-test (lcm 1234 -3) 3702)
+(num-test (lcm 1234 -500029) 617035786)
+(num-test (lcm 1234 0 -1234 1234) 0)
+(num-test (lcm 1234 0) 0)
+(num-test (lcm 1234 1) 1234)
+(num-test (lcm 1234 10 0 1) 0)
+(num-test (lcm 1234 10) 6170)
+(num-test (lcm 1234 1234 1 -10) 6170)
+(num-test (lcm 1234 1234) 1234)
+(num-test (lcm 1234 2) 1234)
+(num-test (lcm 1234 3) 3702)
+(num-test (lcm 1234 500029) 617035786)
+(num-test (lcm 1234) 1234)
+(num-test (lcm 131072 762939453125) 100000000000000000)
+(num-test (lcm 14 35) 70)
+(num-test (lcm 1741 2063 3137 3797 3251 3 19) 7927658615618708709)
+(num-test (lcm 2 -1) 2)
+(num-test (lcm 2 -10) 10)
+(num-test (lcm 2 -1234) 1234)
+(num-test (lcm 2 -2) 2)
+(num-test (lcm 2 -3) 6)
+(num-test (lcm 2 -500029) 1000058)
+(num-test (lcm 2 0 2 -2) 0)
+(num-test (lcm 2 0) 0)
+(num-test (lcm 2 1 -3 -1) 6)
+(num-test (lcm 2 1) 2)
+(num-test (lcm 2 10) 10)
+(num-test (lcm 2 1234) 1234)
+(num-test (lcm 2 2 10 10) 10)
+(num-test (lcm 2 2) 2)
+(num-test (lcm 2 3) 6)
+(num-test (lcm 2 3/4) 6)
+(num-test (lcm 2 500029) 1000058)
+(num-test (lcm 2) 2)
+(num-test (lcm 262144 3814697265625) 1000000000000000000)
+(num-test (lcm 3 500029) 1500087)
+(num-test (lcm 3) 3)
+(num-test (lcm 3/4 2) 6)
+(num-test (lcm 32 -36) 288 )
+(num-test (lcm 323 28747 27113) 41021969)
+(num-test (lcm 4242884/3 1907348632815/7) 8092658996592638460)
+(num-test (lcm 500029 -1) 500029)
+(num-test (lcm 500029 -10) 5000290)
+(num-test (lcm 500029 -1234) 617035786)
+(num-test (lcm 500029 -2) 1000058)
+(num-test (lcm 500029 -3) 1500087)
+(num-test (lcm 500029 -500029) 500029)
+(num-test (lcm 500029 0) 0)
+(num-test (lcm 500029 1) 500029)
+(num-test (lcm 500029 10) 5000290)
+(num-test (lcm 500029 1234) 617035786)
+(num-test (lcm 500029 2) 1000058)
+(num-test (lcm 500029 3) 1500087)
+(num-test (lcm 500029 500029) 500029)
+(num-test (lcm 500029) 500029)
+(num-test (lcm 524288 -17500000000001) 9175040000000524288)
+(num-test (lcm 524288 17500000000001) 9175040000000524288)
+(num-test (lcm 524288/3 1907348632815/7) 1000000000001310720)
+(num-test (lcm) 1 )
+(num-test (lcm) 1)
+(num-test (lcm 2755 13) 35815)
+(num-test (lcm 56 2) 56)
+(num-test (lcm 148665 2) 297330)
+(num-test (lcm 71862 203) 71862)
+(num-test (lcm 21568911 41) 21568911)
+(num-test (lcm 15295874 111) 45887622)
+(num-test (lcm 20430054 41) 20430054)
+(num-test (lcm 248255254 767) 14647059986)
+(num-test (lcm 510104442 5453) 2781599522226)
+(num-test (lcm 242162410 41) 9928658810)
+(num-test (lcm 660070972 74) 660070972)
+(num-test (lcm 6542405452 117) 765461437884)
+(num-test (lcm 629448534 2) 629448534)
+(num-test (lcm 163873565922 155) 819367829610)
+(num-test (lcm 1563464979842 442) 20325044737946)
+(num-test (lcm 3712337724 576173) 92997772323924)
+(num-test (lcm 4380921044390 5) 4380921044390)
+(num-test (lcm 4097970629150 86) 176212737053450)
+(num-test (lcm 2090198664 1118) 1168421053176)
+(num-test (lcm 5275411661289 31857) 8002799490175413)
+(num-test (lcm 38602581835881 19) 733449054881739)
+(num-test (lcm 82578867500655 319) 908367542507205)
+(num-test (lcm 363169800 20) 363169800)
+(num-test (lcm 2033404107084 23374) 23764393799490708)
+(num-test (lcm 7438317458260 31213) 17859400217282260)
+(num-test (lcm 390609000 11) 4296699000)
+(num-test (lcm 406117800 57) 7716238200)
+(num-test (lcm 1008217762344 4403) 119977913718936)
+(num-test (lcm 136581511784536 67022) 147644614239083416)
+(num-test (lcm 43293168048 1344610) 29106213344510640)
+(num-test (lcm 608503422693864 47) 608503422693864)
+(num-test (lcm 6945109296864 779) 284749481171424)
+(num-test (lcm 1346702251365156 435) 6733511256825780)
+(num-test (lcm 1388225063690465 644) 127716705859522780)
+(num-test (lcm 1200780158492850 91686) 311002061049648150)
+(num-test (lcm 1551193257090906 2656731) 2356262557521086214)
+(num-test (lcm 386512944051107445 17) 386512944051107445)
+(num-test (lcm 1111364125679340 6) 1111364125679340)
+(num-test (lcm 15858537083857314 21793) 15858537083857314)
+(num-test (lcm 44179338013272 280645) 302407568700846840)
+(num-test (lcm 64149298745840 43808357) 79994175536062480)
+(num-test (lcm 4412914630225794 515823) 48542060932483734)
+(num-test (lcm 169216424701305960 17) 2876679219922201320)
+(num-test (lcm 178335507754891305 817) 178335507754891305)
+
+(when (provided? 'overflow-checks)
+  (num-test (lcm 10781274/17087915 3880899/2744210) (/ (* 10781274/17087915 3880899/2744210) (gcd 10781274/17087915 3880899/2744210)))
+  (num-test (lcm 190537/301994 114243/80782) (/ (* 190537/301994 114243/80782) (gcd 190537/301994 114243/80782)))
+  (num-test (lcm 397573379/630138897 131836323/93222358) (/ (* 397573379/630138897 131836323/93222358) (gcd 397573379/630138897 131836323/93222358))))
+
+(num-test (lcm 10400200/16483927 1607521/1136689) (/ (* 10400200/16483927 1607521/1136689) (gcd 10400200/16483927 1607521/1136689)))
+(num-test (lcm 12/19 41/29) (/ (* 12/19 41/29) (gcd 12/19 41/29)))
+(num-test (lcm 12941/20511 3363/2378) (/ (* 12941/20511 3363/2378) (gcd 12941/20511 3363/2378)))
+(num-test (lcm 15601/24727 19601/13860) (/ (* 15601/24727 19601/13860) (gcd 15601/24727 19601/13860)))
+(num-test (lcm 171928773/272500658 54608393/38613965) (/ (* 171928773/272500658 54608393/38613965) (gcd 171928773/272500658 54608393/38613965)))
+(num-test (lcm 2/3 3/2) (/ (* 2/3 3/2) (gcd 2/3 3/2)))
+(num-test (lcm 253/401 577/408) (/ (* 253/401 577/408) (gcd 253/401 577/408)))
+(num-test (lcm 4201378396/6659027209 318281039/225058681) (/ (* 4201378396/6659027209 318281039/225058681) (gcd 4201378396/6659027209 318281039/225058681)))
+(num-test (lcm 5/8 17/12) (/ (* 5/8 17/12) (gcd 5/8 17/12)))
+(num-test (lcm 53/84 99/70) (/ (* 53/84 99/70) (gcd 53/84 99/70)))
+(num-test (lcm 53715833/85137581 9369319/6625109) (/ (* 53715833/85137581 9369319/6625109) (gcd 53715833/85137581 9369319/6625109)))
+(num-test (lcm 665/1054 1393/985) (/ (* 665/1054 1393/985) (gcd 665/1054 1393/985)))
+(num-test (lcm 7161071/11350029 275807/195025) (/ (* 7161071/11350029 275807/195025) (gcd 7161071/11350029 275807/195025)))
+(num-test (lcm 79335/125743 47321/33461) (/ (* 79335/125743 47321/33461) (gcd 79335/125743 47321/33461)))
+
+(num-test (lcm -2305843009213693951/4611686018427387903) 2305843009213693951/4611686018427387903)
+
+(let ()
+  (define (flcm n) (if (<= n 1) 1 (lcm n (flcm (- n 1)))))
+  (num-test (flcm 9) 2520)
+  (num-test (flcm 40) 5342931457063200)
+  (if with-bignums (num-test (flcm 100) 69720375229712477164533808935312303556800)))
+
+(when with-bignums
+  (num-test (let ((n 1)) (do ((i 2 (+ i 1))) ((= i 100)) (set! n (lcm n i))) n) 69720375229712477164533808935312303556800)
+  (num-test (lcm -9223372036854775808 -9223372036854775808) 9223372036854775808)
+  (num-test (lcm -9223372036854775808 9223372036854775807 -9223372036854775808) 85070591730234615856620279821087277056)
+  (num-test (lcm 1/21 1/2432902008176640001) 1)
+  (num-test (lcm 132120577 33292289 260046847) 1143841133453061178785791)
+  (num-test (lcm 132120577 33292289) 4398596432330753)
+  (num-test (lcm 132120577/12 33292289/6 260046847/4) 1143841133453061178785791/2)
+  (num-test (lcm 2/132120577 3/33292289 4/260046847) 12)
+  (num-test (lcm 21 2432902008176640001) 51090942171709440021)
+  (num-test (lcm 2353913150770005286438421033702874906038383291674012942337 9641628265553941653251772554046975615133217962696757011808257)
+	    22695555569123220026272727097682721551725929819788097280747860983024240452040931523149698041303750665450606153441476609)
+  (num-test (lcm 2432902008176640001 21) 51090942171709440021)
+  (num-test (lcm 2432902008176640001/21 21/2432902008176640001) 51090942171709440021)
+  (num-test (lcm 557057 23068673 167772161) 2155967190204955525121)
+  (num-test (lcm 9223372036854775807 -9223372036854775808) 85070591730234615856620279821087277056)
+  (num-test (lcm 524288 19073486328125) 10000000000000000000)
+  (num-test (lcm 2147483648 4656612873077392578125) 10000000000000000000000000000000)
+  (num-test (lcm (/ (expt 2 57) 3) (/ 65 11)) 9367487224930631680)
+  (num-test (lcm 460683358924445799142 518) 460683358924445799142)
+  (num-test (lcm 113021475230160 74635) 1243236227531760)
+  (num-test (lcm 74228340534140364 363909) 16107549895908458988)
+  (num-test (lcm 69242022961311060 48305942) 55324376346087536940)
+  (num-test (lcm 286967952870300 2273388) 4181983977178881900)
+  (num-test (lcm 302822258393413362492399 29) 302822258393413362492399)
+  (num-test (lcm 10491072879382200 133) 10491072879382200)
+  (num-test (lcm 167206737423420464 609) 14546986155837580368)
+  (num-test (lcm 72212583812867784 4888799) 7511336330463068288328)
+  (num-test (lcm 4170116471639397292390 1798025) 20850582358196986461950)
+  (num-test (lcm 83910330283522050 35224) 12418728881961263400)
+  (num-test (lcm 275373383775647594346 66884092) 175688218848863165192748)
+  (num-test (lcm 14656657495570695990 37) 542296327336115751630)
+  (num-test (lcm 95470974177676509874110 1219) 95470974177676509874110)
+  (num-test (lcm 619506317623001424 5957) 527199876297174211824)
+  (num-test (lcm 11268171656665155960 9858) 597213097803253265880)
+  (num-test (lcm 6172860073826160 5167394) 10376577784101774960)
+  (num-test (lcm 26457493095663264 1491412) 9974474897065050528)
+  (num-test (lcm 8481384175941103284 313836405) 52191512141200849929103020)
+  (num-test (lcm 60356595775749199080 176098815946) 6192647083187643574807080)
+  (num-test (lcm 611492274956002440 37) 611492274956002440)
+  (num-test (lcm 164614611843685080 1711) 4773823743466867320)
+  (num-test (lcm 93177516542679418720 62197) 156631405308244102868320)
+  (num-test (lcm 938959746797519770440 127558) 938959746797519770440)
+  (num-test (lcm 137670522526899326250 200) 550682090107597305000)
+  (num-test (lcm 852063402206742880 41643478) 607521205773407673440)
+  (num-test (lcm 55947291202307909360 188546228) 1657550396450776430608720)
+  (num-test (lcm 12877971214039423262680 9832253830) 1040166612929178256349926280)
+  (num-test (lcm 192158415774146059920 53) 192158415774146059920)
+  (num-test (lcm 902814024155808960 1829) 53266027425192728640)
+  (num-test (lcm 1265864304573235487120 4921) 24051421786891474255280)
+  (num-test (lcm 14172662463567665400 95817) 23824245601257245537400)
+  (num-test (lcm 32171996211745702482324 2368555) 294212905356414449200852980)
+  (num-test (lcm 971324258606045826300 4576748) 18836891347147046709435900)
+  (num-test (lcm 2400649320046378377000 1704690) 4400390203645011565041000)
+  (num-test (lcm 953233796456393760 18342152493) 30445334225020760300640)
+  (num-test (lcm 28906333140964843080 236206740) 8296117611456909963960)
+  (num-test (lcm 775403093708557121609032 41) 775403093708557121609032)
+  (num-test (lcm 12587009808135760402860 2491) 667111519831195301351580)
+  (num-test (lcm 510685807527370566909720 76) 9703030343020040771284680)
+  (num-test (lcm 9842598153710524682146590 10089) 29527794461131574046439770)
+  (num-test (lcm 44936631038618189620242012 30740) 224683155193090948101210060)
+  (num-test (lcm 934589372977008750144 373650) 1238330919194536593940800)
+  (num-test (lcm 33027125273398900134069150 840577803) 33027125273398900134069150)
+  (num-test (lcm 4428219127938822420288 1695783782) 600648070732749811910284608)
+  (num-test (lcm 29316428815807608915440 560764380) 107210180179408425803764080)
+  (num-test (lcm 1364397376360544429904 19) 1364397376360544429904)
+  (num-test (lcm 4991450791697293128313385277 329) 234598187209772777030729108019)
+  (num-test (lcm 75448279792981695149550 3009) 75674624632360640234998650)
+  (num-test (lcm 181031604499464166188731133 3364) 608990317536197455058891531412)
+  (num-test (lcm 405831142402606479845286 2746214) 6899129420844310157369862)
+  (num-test (lcm 89170366469003867207160 25337230) 196977339530029542660616440)
+  (num-test (lcm 13523725766340619200 1490114045) 704734873409776007131200)
+  (num-test (lcm 104705939487154940255412 192200052) 768227478017255796653957844)
+  (num-test (lcm 7232591421499800642000 16584679460) 15338901584491041700955526000)
+  (num-test (lcm 14043796716396386984750160 33382708236) 1306073094624863989581764880)
+  (num-test (lcm 13894638105872256412416 23) 13894638105872256412416)
+  (num-test (lcm 147611447155643499428400 118) 8709075382182966466275600)
+  (num-test (lcm 13356594697070649024 4558) 574333571974037908032)
+  (num-test (lcm 15089731174706036171537760 90) 45269193524118108514613280)
+  (num-test (lcm 307230141273924828960 1971507) 383115986168584261713120)
+  (num-test (lcm 2582563944548247741930009096 22873474) 33573331279127220645090118248)
+  (num-test (lcm 1074296602920111687342072 146235518) 7220347468226070650626065912)
+  (num-test (lcm 774058642832724262993980 407557010) 124623441496068606342030780)
+  (num-test (lcm 291091930213008490369569480 13412544348) 147286985941108248965685135059880)
+  (num-test (lcm 2089068565149831833568 7302038455228) 223766401218893937188969184)
+  (num-test (lcm 1064437567441124038217970656 5) 5322187837205620191089853280)
+  (num-test (lcm 142557826750459447787460 1333) 6129986550269756254860780)
+  (num-test (lcm 311779340580033594160200 23693) 311779340580033594160200)
+  (num-test (lcm 29314187023691666530559664 110143) 29314187023691666530559664)
+  (num-test (lcm 222003853016244177637944900 857463) 222003853016244177637944900)
+  (num-test (lcm 6247776111945111006243552 77976501) 193681059470298441193550112)
+  (num-test (lcm 1140058514761397155259712 5530338) 12540643662375368707856832)
+  (num-test (lcm 580962736822969724865449808 55686036) 21495621262449879820021642896)
+  (num-test (lcm 4100502596989506786787500 45333475410) 329750117342105167273090387500)
+  (num-test (lcm 1497378750311599979536944 262630276090) 1089215763657912499114866119760)
+  (num-test (lcm 105637634198318524045536 2633013240) 1853412292009498504378929120)
+  (num-test (lcm 11415822547029425161364106595632 7) 79910757829205976129548746169424)
+  (num-test (lcm 198305933339312916107438448 177) 11700050067019462050338868432)
+  (num-test (lcm 3127415425979879537134790928 3335) 15637077129899397685673954640)
+  (num-test (lcm 589703503861221139260034914750 13209) 21819029642865182152621291845750)
+  (num-test (lcm 3108579252052448504121792 14322) 96365956813625903627775552)
+  (num-test (lcm 636976201153021006473464400 66264077) 12102547821907399122995823600)
+  (num-test (lcm 9544425315508129998909285900 1488396) 66810977208556909992365001300)
+  (num-test (lcm 458100280193857502802977376 260747103934) 19226926860016393250143763448096)
+  (num-test (lcm 114208186302155358124900650 22076867505) 397558696517802801632779162650)
+  (num-test (lcm 90107067439719108194114160 28566806069714) 755187332212285845774870774960)
+  (num-test (lcm 2976572787365723002218245484 110104803958578) 110463592711929346335321308156724)
+  (num-test (lcm 53453375725613238735360 17) 908707387335425058501120)
+  (num-test (lcm 888822833524306124874229800 106) 888822833524306124874229800)
+  (num-test (lcm 21275338550698297089687698855820 3021) 21275338550698297089687698855820)
+  (num-test (lcm 417525245705449941528380320750068 5828) 417525245705449941528380320750068)
+  (num-test (lcm 1954871230146370370001829871352 22765249) 1954871230146370370001829871352)
+  (num-test (lcm 903057827710908645847577520 648545995) 1126113111155503081371929167440)
+  (num-test (lcm 6002846634833433581621040 28493572159) 6137376430766685661618749127440)
+  (num-test (lcm 26428903214964558277189300080 100428856) 766438193233972190038489702320)
+  (num-test (lcm 470486531607553676511206181180 28495896) 4523257514875021045978736225864520)
+  (num-test (lcm 483599554429365539310928369206620 5577334078910) 25630776384756373583479203567950860)
+  (num-test (lcm 134511400157705323668887400 1285071093558916) 508298000951744289230204144827800)
+  (num-test (lcm 25897125642468049125349982599216 1183846707540) 1165370653911062210640749216964720)
+  (num-test (lcm 1118034209930460291955200 3) 1118034209930460291955200)
+  (num-test (lcm 16297594064835666104344589410644 413) 16297594064835666104344589410644)
+  (num-test (lcm 536762539932642345554192060100 1378) 536762539932642345554192060100)
+  (num-test (lcm 933250179448203335817687635834340 58029) 784863400915939005422675301736679940)
+  (num-test (lcm 65573457048202714607131200 486115) 8721269787410961042748449600)
+  (num-test (lcm 85664559165674439863772868932 322014) 85664559165674439863772868932)
+  (num-test (lcm 7232817686074320060728552759760 11307940) 7232817686074320060728552759760)
+  (num-test (lcm 78400098291720425971762131120 5646921093) 78400098291720425971762131120)
+  (num-test (lcm 345445746644065669842240 19727989065) 3106593599570082568891264320)
+  (num-test (lcm 627854758484491743169777558200 750371721805653) 3013801413922642432418609934436637400)
+  (num-test (lcm 788233263079483492974876830792850 7170146100) 963221047483128828415299487228862700)
+  (num-test (lcm 18378856389802641496737518160 6247594493140) 139293352578314219903773650134640)
+  (num-test (lcm 9620902642431357480148667659080 59) 9620902642431357480148667659080)
+  (num-test (lcm 16008524600631853118144316000 629) 10069361973797435611312774764000)
+  (num-test (lcm 4342138447708715023205684275423920 53041) 134606291878970165719376212538141520)
+  (num-test (lcm 2431833161592653384508687244500 47541) 2431833161592653384508687244500)
+  (num-test (lcm 39424620224103957589082132160 1671734) 39424620224103957589082132160)
+  (num-test (lcm 652830233576052788654372406432 552231327) 28071700043770269912138013476576)
+  (num-test (lcm 6892963340916411083970414000 3662431431) 323969277023071320946609458000)
+  (num-test (lcm 29102758215190063506219566460000 10565720) 29102758215190063506219566460000)
+  (num-test (lcm 21253900104556838003127171970777418412 1182797770) 400954825472464748928994099228715998342380)
+  (num-test (lcm 3964268932242030284914943132662620 21244177854110) 4547016465281608736797439773164025140)
+  (num-test (lcm 6070388091189460078138338240 40809131994181213) 903741167852013248053001382156480)
+  (num-test (lcm 9685989954133695108793384134000 964113514382876) 55084224869158324083707975570058000)
+  (num-test (lcm 56468122001858834917195045500 429400787158167902) 11597366428619765656458601249744500)
+  (num-test (lcm 18843408973202596901221568364900 47) 18843408973202596901221568364900)
+  (num-test (lcm 7800980538292163259967028613764250 6) 7800980538292163259967028613764250)
+  (num-test (lcm 270433907726619219545089642715200 3422) 15955600555870533953160288920196800)
+  (num-test (lcm 45771666919597903071546708768 2342359) 49112998604728549995769618508064)
+  (num-test (lcm 47198294949461301503537593835384892 314502) 2501509632321448979687492473275399276)
+  (num-test (lcm 3165335901519110207943908102359110 14953473) 228660700189839002311659977406319747290)
+  (num-test (lcm 189219585097956261544520863361400 35605794) 189219585097956261544520863361400)
+  (num-test (lcm 38532137569034426600955256933810890813 1341358608707) 8030213065799481606918878410776991078101639)
+  (num-test (lcm 1396277868664090735481380981225896 312520860) 6981389343320453677406904906129480)
+  (num-test (lcm 864038349500762576564773759109700 714136202724) 37153649028532790792285271641717100)
+  (num-test (lcm 12514185871591242579049167322464 10706997440178) 667894614152696207686433109167226144)
+  (num-test (lcm 1981802660405609330969478067056636 33312289752) 4466983196554243432005203563145657544)
+  (num-test (lcm 979313401024175219420658240 125278417383795) 79100122714123656647825986703040)
+  (num-test (lcm 4074026154111369481048033354344 29) 4074026154111369481048033354344)
+  (num-test (lcm 599666571180604695702511920885005100 129) 599666571180604695702511920885005100)
+  (num-test (lcm 5703263639326551702474610108800 1978) 5703263639326551702474610108800)
+  (num-test (lcm 134137932950214683609064669163440 190619) 178805864622636173250883203994865520)
+  (num-test (lcm 344735091370772631136645455600 1048985) 344735091370772631136645455600)
+  (num-test (lcm 6759508339299085316106145385400 4969610) 209544758518271644799290506947400)
+  (num-test (lcm 700334422308861928135313594400 228529587) 370476909401387959983580891437600)
+  (num-test (lcm 10277417891211405957191810814198480 2516552038) 113051596803325465529109918956183280)
+  (num-test (lcm 490099971577877358878082782880 9282588354) 259262884964697122846505792143520)
+  (num-test (lcm 1954558750269048828645390249600 5575829490) 33227498754573830086971634243200)
+  (num-test (lcm 1360588454560018295496656378989200 7868178296420) 719751292462249678317731224485286800)
+  (num-test (lcm 4337552841738910859248770564912480 17722936528737830) 227361507305428490509242806701017464160)
+  (num-test (lcm 215913068853045803981566931862756 7009479781500) 516383093295665670947415013416263818500)
+  (num-test (lcm 44890707654126305940250882318870941900 18329973480720) 538688491849515671283010587826451302800)
+  (num-test (lcm 28579720891831355496720656680837200 3) 28579720891831355496720656680837200)
+  (num-test (lcm 29332703209780553199747293473184160 1711) 1730629489377052638785090314917865440)
+  (num-test (lcm 3648979393315349438003046604440000 186) 3648979393315349438003046604440000)
+  (num-test (lcm 1159760236369472473822068077011807878780 25714) 1159760236369472473822068077011807878780)
+  (num-test (lcm 158186359726371025615685433600 31395) 1107304518084597179309798035200)
+  (num-test (lcm 331091450443070201468559735703944 28424) 331091450443070201468559735703944)
+  (num-test (lcm 9734443639363161342241553023288200 1961348207) 301767752820258001609488143721934200)
+  (num-test (lcm 701896612128009033011419603540080 51300) 10528449181920135495171294053101200)
+  (num-test (lcm 86169288128517384618860929451245320 5032162527446) 2406794386717619069789404620502733032920)
+  (num-test (lcm 64828800524794653881296183831741773624 4645294472) 47389853183624891987227510381003236519144)
+  (num-test (lcm 49068907706533938991402184550000 268183371225) 17713875682058751975896188622550000)
+  (num-test (lcm 1708602980304476478496020543612288 4083128544) 52966692389438770833376636851980928)
+  (num-test (lcm 17608179287674151740172985536160 980399424528) 188284261123099704557669734338158880)
+  (num-test (lcm 43194437079731225735521919644800 178119261126453036) 95416511509126277649767920495363200)
+  (num-test (lcm 817555977437791699707628651571149344 59) 817555977437791699707628651571149344)
+  (num-test (lcm 19062946261334997559157066059536 533) 247818301397354968269041858773968)
+  (num-test (lcm 6533849124840489114353090499099000 598) 150278529871331249630121081479277000)
+  (num-test (lcm 427663965127849896842400211428345149025 234) 855327930255699793684800422856690298050)
+  (num-test (lcm 352395507261316174741530450071590608 154734) 14448215797713963164402748452935214928)
+  (num-test (lcm 391579493632653867660919800000 9221565) 5598412020466052345948170380600000)
+  (num-test (lcm 2618798923882923048581401148931738000 681876) 34044386010477999631558214936112594000)
+  (num-test (lcm 174712575449141140214591110997980800 233260339838) 323043552005461968256778964235266499200)
+  (num-test (lcm 88598141227372995032227898284800 1929763976) 1101009101032564209265496091985209600)
+  (num-test (lcm 210110141308655567793064872567302676320 720390430628) 322939287191403607697940709135944213503840)
+  (num-test (lcm 668425085137718599277317523827419000 19898594339442) 226544635130131000822866287128160329737000)
+  (num-test (lcm 89533471731097208414073727453200 4173840860670546) 165547389230798738357622322060966800)
+  (num-test (lcm 113987439157802480362236410675251462620 21548296273949445) 2165761343998247126882491802829777789780)
+  (num-test (lcm 48129335993995093308894209644253760 1009442888504820) 572305934304595654536061046879821460160)
+  (num-test (lcm 3497836376962291922989777163497680 138736290091634664) 143411291455453968842580863703404880)
+  (num-test (lcm 11371924962562208722154622794880 3) 11371924962562208722154622794880)
+  (num-test (lcm 9451631862008339290824315653784000 703) 349710378894308553760499679190008000)
+  (num-test (lcm 16869347753325980368094612370435598560 806) 16869347753325980368094612370435598560)
+  (num-test (lcm 4701845646467068759127854100132739552 3198) 2506083729566947648615146235370750181216)
+  (num-test (lcm 1029865193584911347147121232800485280 1005771) 42224472936981365233031970544819896480)
+  (num-test (lcm 10657125216930337802109861408000 2415138) 9069213559607717469595492058208000)
+  (num-test (lcm 14382707743772734802155022983680 247913634) 24608812949595149246487244325076480)
+  (num-test (lcm 60134748581470366378101904574533857248 54828228) 6674957092543210667969311407773258154528)
+  (num-test (lcm 214830664120540781167218700750596000 505665810) 9237718557183253590190404132275628000)
+  (num-test (lcm 48933004118344447687599112101802800 6263883444) 2887047242982322413568347614006365200)
+  (num-test (lcm 5498670161558110606435630054129739400 262699548132) 1072697071127240891435282017849791951370200)
+  (num-test (lcm 35941673649029587182509620977230062500 25622409466332) 1752120648716543345560161513018988316812500)
+  (num-test (lcm 1592802602494326390643157055239113248 736377633395508) 1221679596113148341623301461368399861216)
+  (num-test (lcm 4043816553144402557587143272522043028314 5011466158645380) 55359848612546871013367991400826769057618660)
+  (num-test (lcm 7171921165220830707276631005512550 1765284492289500) 71719211652208307072766310055125500)
+  (num-test (lcm 2402189359210218692854826119405968750 23) 55250355261835029935661000746337281250)
+  (num-test (lcm 26149068753160488131648964110990162400 1147) 967515543866938060871011672106636008800)
+  (num-test (lcm 556184059176863945810376239306506311552 4089) 556184059176863945810376239306506311552)
+  (num-test (lcm 67871323087036310486238021899264593800 13395) 67871323087036310486238021899264593800)
+  (num-test (lcm 12750401179065252879838440979200 7177173) 12750401179065252879838440979200)
+  (num-test (lcm 278110245000092733617125071646080 17748) 278110245000092733617125071646080)
+  (num-test (lcm 13408203364935178481017292708752000 50619404) 496103524502601603797639830223824000)
+  (num-test (lcm 124271828931784534297423756437875067000 8839796595) 270042684268767793028301822739502520591000)
+  (num-test (lcm 11893442806922081156953529319100769836176 972789007267) 11762614936045938264227040496590661367978064)
+  (num-test (lcm 352581052555284857902053030133344488264100 923561430099) 5993877893439842584334901512266856300489700)
+  (num-test (lcm 6108908012714804315575319947340956346976 31944833628092) 2009830736183170619824280262675174638155104)
+  (num-test (lcm 67475643422116264959949054821520228800 22515435540) 4655819396126022282236484782684895787200)
+  (num-test (lcm 470601888939348535946408832 5135943991060962937) 65492053197870222825732159796881558144)
+  (num-test (lcm 110759232155568113345545635903016614000 30159198663300) 110759232155568113345545635903016614000)
+  (num-test (lcm 146100914712024458707469587112300146320 26868173101560) 380954774790565399517176676594819048626034640)
+  (num-test (lcm 12173192708601511002951184416658091200 466645866900785428350) 3795589313349242529209176349929576178068800)
+  (num-test (lcm 5784684831478746253226687170890240 13) 5784684831478746253226687170890240)
+  (num-test (lcm 35042260655085685815432622412891903767500 667) 35042260655085685815432622412891903767500)
+  (num-test (lcm 2903871349270676921837488659419545120987500 530) 2903871349270676921837488659419545120987500)
+  (num-test (lcm 630123969240840167098426767919876491188000 77691) 1890371907722520501295280303759629473564000)
+  (num-test (lcm 33192703032132982013024959634241667249800 4684718) 1228130012188920334481923506466941688242600)
+  (num-test (lcm 4731525733734729472809717145544850000 90706055) 4731525733734729472809717145544850000)
+  (num-test (lcm 214011009809686092216200126896120006823232 50400042) 41806836755312368428342478589030147212911547968)
+  (num-test (lcm 5854250735296111435541950856160000 24357777002) 174403983655206455776230257955862560000)
+  (num-test (lcm 35348208247612761916374738259136697649608 156806713508) 644786666644704390116591600584912501826499528)
+  (num-test (lcm 612558317420289618714916924536521515286100 2377007388) 11638608030985502755583421566193908790435900)
+  (num-test (lcm 181857299802925368992522029882739454720 21606337755618) 181857299802925368992522029882739454720)
+  (num-test (lcm 4731635341196946327443020710970699860000 58092526675092) 354167636923932629555437543236867855220860000)
+  (num-test (lcm 22081740554432638182773611616166588288192 61419768950540) 110408702772163190913868058080832941440960)
+  (num-test (lcm 125627844706077784535328068665849312000 30482033400) 118925222307474416497014710218320253656864000)
+  (num-test (lcm 1225504716872819103560254268197955520 510813364186125) 3707151768540277788269769161298815448000)
+  (num-test (lcm 5209185280578468690281136425214396728400 2327880739319250103818) 14624765850878700374498228867533344237423825059372400)
+  (num-test (lcm 230425011604643097634961294406535254400 31) 230425011604643097634961294406535254400)
+  (num-test (lcm 13222608481676137093434201748083744000 893) 13222608481676137093434201748083744000)
+  (num-test (lcm 13348198818240350339028224064019716678960 651) 2896559143558156023569124621892278519334320)
+  (num-test (lcm 7236172685650198160266777676385295337308176 23426) 383517152339460502494139216848420652877333328)
+  (num-test (lcm 756264162229440667711265021676693350760 28899) 756264162229440667711265021676693350760)
+  (num-test (lcm 40915062421030872924283823601517905600 36345062) 40915062421030872924283823601517905600)
+  (num-test (lcm 1174590526522170015825602834292923520 4991486258) 40402390340783082034353260691173690317440)
+  (num-test (lcm 2891892862328155581145450075391651333218020 35138529818) 2891892862328155581145450075391651333218020)
+  (num-test (lcm 1993335355070485984559797658834121810059400 535644500) 408633747789449626834758520060994971062177000)
+  (num-test (lcm 6324295450641455215591954662726515160 367472693133) 259296113476299663839270141171787121560)
+  (num-test (lcm 6576388154814679090356195121505112000 15901952377630) 107846189350805922402751243797562331688000)
+  (num-test (lcm 117828556355409428513249595788296238400 565992666495795) 2013191495492007395999396032982202432871329600)
+  (num-test (lcm 592831716700236607285748949860604000 139641978135660) 241282508696996299165299822593265828000)
+  (num-test (lcm 106766839071170184723986891291602032000 1584924526628112) 85306704417864977594465526141990023568000)
+  (num-test (lcm 21677148858122146832326483307664860804937400 247815827510760) 585283019169297964472815049306951241733309800)
+  (num-test (lcm 14079549844487257384278196623697173813600 160967604100961853832) 52755411528451062517793341673751996512389960800)
+  (num-test (lcm 2696480372014145687016224877963234647656980 2219319031453896088860) 4753894895860938846209604459849182683819255740)
+  (num-test (lcm 13545431257849875145060979241270859310160 29) 13545431257849875145060979241270859310160)
+  (num-test (lcm 137485634482479300158725199474868559498162500 329) 962399441377355101111076396324079916487137500)
+  (num-test (lcm 529252417743761759027305009539254400 3243) 529252417743761759027305009539254400)
+  (num-test (lcm 133897419738958073238580385894509887148800 330455) 133897419738958073238580385894509887148800)
+  (num-test (lcm 3896215507210178905244623173635584334007288624 1005238) 3896215507210178905244623173635584334007288624)
+  (num-test (lcm 17654511984514518592175290794029073043800 1060530) 511980847550921039173083433026843118270200)
+  (num-test (lcm 16470780256339082688310222474503880382858400 913836) 16470780256339082688310222474503880382858400)
+  (num-test (lcm 57267105834722825210001789897760395576000 2958974018) 2691553974231972784870084125194738592072000)
+  (num-test (lcm 521977833444747522001426544601807810543216 1066521690) 112225234190620717230306707089388679266791440)
+  (num-test (lcm 1699559962174727325529414216960251941390400 25883611479) 1422531688340246771468119699595730874943764800)
+  (num-test (lcm 10654036597801063717295948399628964800 317449894126222) 176036646705466975800880955407069385390400)
+  (num-test (lcm 381902381115592200811990304316262139150724960 4640335440216) 381902381115592200811990304316262139150724960)
+  (num-test (lcm 425968526187959807410151867411382902838703889232 1882826315615025) 181036623629882918149314543649837733706449152923600)
+  (num-test (lcm 174609167728518272531601927200939868792000 1712923655178450) 48325242369824705024158690915447549888986499656000)
+  (num-test (lcm 3325168366561555458817274989681612518000 1699726139891780) 43227188765300220964624574865860962734000)
+  (num-test (lcm 11429650426242566426919762928176000 7414967839104) 15647191433526073438453155448672944000)
+  (num-test (lcm 2104794191230056678355480848036599377844400 16946684823025584) 195745859784395271087059718867403742139529200)
+  (num-test (lcm 11894522530167763519415142641640874994880 7) 11894522530167763519415142641640874994880)
+  (num-test (lcm 5906329981690378696996009087718418780000 185) 5906329981690378696996009087718418780000)
+  (num-test (lcm 3056294774178096513474941936265025440000 658) 3056294774178096513474941936265025440000)
+  (num-test (lcm 10491907660880423349353457742257185280 123369) 10491907660880423349353457742257185280)
+  (num-test (lcm 673239479595593149777212259021965839229225628776 15470) 3366197397977965748886061295109829196146128143880)
+  (num-test (lcm 1506608574369860432616005754109397877696 1474070) 7533042871849302163080028770546989388480)
+  (num-test (lcm 4849814041048623250005708880379694793905000 2172220582) 4849814041048623250005708880379694793905000)
+  (num-test (lcm 21154344928580705924176101470087564940000 5023204186) 21154344928580705924176101470087564940000)
+  (num-test (lcm 346448039376394135288065831861806112294000 776147372) 10739889220668218193930040787715989481114000)
+  (num-test (lcm 2339009760844587560470606952218133142645504 194201967414) 86543361151249739737412457232070926277883648)
+  (num-test (lcm 2242982161480922111384667548175169152 21419749763490) 20736370082891124919751251482879438810240)
+  (num-test (lcm 4717315265246821759830981157482117120 45609714193992) 8203411246264223040346076232861401671680)
+  (num-test (lcm 16628111321698075419789804224660024289936 4643626415880804) 46708364702649893854189560067070008230430224)
+  (num-test (lcm 115557531507210992033160068979962880 88406536976058378) 279533668715943389728214206862530206720)
+  (num-test (lcm 21059511907771200155093927745003762840000 180298981648603620) 19859119729028241746253573863538548358120000)
+  (num-test (lcm 2124921015128697258800067298086064536000 2282525112298516782924) 321127237090271040335932409977291910220921912000)
+  (num-test (lcm 16015671538624533047089928322348864000 49817926936366875) 11550742548729092601556962655002835949760000)
+  (num-test (lcm 166517667014186289390514558017250969134523800 43413708621878528404068) 6080725646357040729673420115115953639885405604600)
+  (num-test (lcm 2780796292789128359666429021610464935722000 47) 2780796292789128359666429021610464935722000)
+  (num-test (lcm 21297913114430245153455383503409684916193317960 58) 21297913114430245153455383503409684916193317960)
+  (num-test (lcm 1516745257039775143654568869485529015398000 6293) 1516745257039775143654568869485529015398000)
+  (num-test (lcm 8447692776411453120390905608381515479808 2030) 1224915452579660702456681313215319744572160)
+  (num-test (lcm 958876033949638283967045624731391031146081240 9834415) 56573686003028658754055691859152070837618793160)
+  (num-test (lcm 4731349833403602529573388098680617532624192 14868) 4731349833403602529573388098680617532624192)
+  (num-test (lcm 6375001358038970462026761077388061675464000 430513678) 6375001358038970462026761077388061675464000)
+  (num-test (lcm 254088526608579040642428151389718385042344800 4799428101) 4774577503501808752711867392764198173330701136800)
+  (num-test (lcm 21140490542258031885408065086507444825621023648 164778747198) 264108148344429592344402957125737508206483448434464)
+  (num-test (lcm 34214837305812460226811046733375808000 4312787868) 197795974464901832571194661165645546048000)
+  (num-test (lcm 11450197571956515037245443769386989035470896800 75585518430279) 148852568435434695484190769002030857461121658400)
+  (num-test (lcm 1211397915863796187148880114197307052796506376580 538601201880) 55724304129734624608848485253076124428639293322680)
+  (num-test (lcm 5454139401260819402160859765169199667337088 30452838731872) 3430653683393055403959180792291426590755028352)
+  (num-test (lcm 744935981632690384026127091216926530879171660 1032747922358460) 12639328800361857745771298356677592449426905555220)
+  (num-test (lcm 324574326062026951443376280715122947502400 103751223626207988025) 10099779304072092648063539727012480757432180800)
+  (num-test (lcm 15272163751269260921486082393684080908800 6484309049057400) 290171111274115957508235565479997537267200)
+  (num-test (lcm 386527546655781220813671331401971490218262720 3481571963427119100) 702565997265680899293657490452822449622871959067200)
+  (num-test (lcm 3189682029126430413458911948222943640000 6724598925622907976570) 25845014249628523826120631630482407871222520000)
+  (num-test (lcm 709403542855323660533377490060722241678400 7) 709403542855323660533377490060722241678400)
+  (num-test (lcm 139803787314578422635552652090095842837312147438904 123) 139803787314578422635552652090095842837312147438904)
+  (num-test (lcm 171985399350431759069945935900956183322827030835560 18241) 171985399350431759069945935900956183322827030835560)
+  (num-test (lcm 33090522521924986387051477884789600000 26187) 1422892468442774414643213549045952800000)
+  (num-test (lcm 1733723010009930088165729903139785699319986530 372945) 81484981470466714143789305447569927868039366910)
+  (num-test (lcm 56408303994570817306318494803635460247582000 5761730) 30065626029106245624267757730337700311961206000)
+  (num-test (lcm 25845509336769185412951159262424903513866295760 64371378271) 25845509336769185412951159262424903513866295760)
+  (num-test (lcm 624970361450506104794172455132584603069611058500 108222780) 624970361450506104794172455132584603069611058500)
+  (num-test (lcm 82823962548382643645255524843049561752323600 135325929794) 911063588032209080097810773273545179275559600)
+  (num-test (lcm 170620453449723034746079844571491973300000 9460614789626) 6995438591438644424589273627431170905300000)
+  (num-test (lcm 125144597811313015929871740675462711600000 12764411911636) 125520031604746954977661355897489099734800000)
+  (num-test (lcm 257193319319332344553297882967977761077115600 6510126541380) 10544926092092626126685213201687088204161739600)
+  (num-test (lcm 879624546681838385457288074812140664728758550 10045784120501316) 109420015859940604120573892778181425848269191068700)
+  (num-test (lcm 18300938860777100857669855248554588369659200 118088077425391892) 1507430033023349020545408306968192889420458644800)
+  (num-test (lcm 8394780474625841647581984803260010511075000 746584618179400) 559688409023779488485938508818148160783881325000)
+  (num-test (lcm 146802334713757872619395774222116859916800 718775571956687400) 123460763494270370872911846120800279190028800)
+  (num-test (lcm 240155883351717999820072393833707008014911556000 1350921510529331832) 31940732485778493976069628379883032065983236948000)
+  (num-test (lcm 918942437243241528855354123800826649596480 74343962238703160850) 19653830834705779820109799278313370922778988193600)
+  (num-test (lcm 1361069299753299783990135442290762165844800 8281085446358585640) 1318876151460947490686441243579748538703611200)
+
+  (num-test (lcm 111738283365989051/177100989030047175 5964153172084899/4217293152016490)
+	    (/ (* 111738283365989051/177100989030047175 5964153172084899/4217293152016490)
+	       (gcd 111738283365989051/177100989030047175 5964153172084899/4217293152016490)))
+  (num-test (lcm 11571718688839/18340740190704 5168247530883/3654502875938)
+	    (/ (* 11571718688839/18340740190704 5168247530883/3654502875938) (gcd 11571718688839/18340740190704 5168247530883/3654502875938)))
+  (num-test (lcm 130441933147714940/206745572560704147 14398739476117879/10181446324101389)
+	    (/ (* 130441933147714940/206745572560704147 14398739476117879/10181446324101389)
+	       (gcd 130441933147714940/206745572560704147 14398739476117879/10181446324101389)))
+  (num-test (lcm 137528045312/217976794617 63018038201/44560482149)
+	    (/ (* 137528045312/217976794617 63018038201/44560482149) (gcd 137528045312/217976794617 63018038201/44560482149)))
+  (num-test (lcm 326267455807135/517121682660006 30122754096401/21300003689580)
+	    (/ (* 326267455807135/517121682660006 30122754096401/21300003689580) (gcd 326267455807135/517121682660006 30122754096401/21300003689580)))
+  (num-test (lcm 3816473305410548/6048967074079039 423859315570607/299713796309065)
+	    (/ (* 3816473305410548/6048967074079039 423859315570607/299713796309065) (gcd 3816473305410548/6048967074079039 423859315570607/299713796309065)))
+  (num-test (lcm 397560349370386783/630118245525664765 34761632124320657/24580185800219268)
+	    (/ (* 397560349370386783/630118245525664765 34761632124320657/24580185800219268)
+	       (gcd 397560349370386783/630118245525664765 34761632124320657/24580185800219268)))
+  (num-test (lcm 483615324366283/766512153894657 175568277047523/124145519261542)
+	    (/ (* 483615324366283/766512153894657 175568277047523/124145519261542) (gcd 483615324366283/766512153894657 175568277047523/124145519261542)))
+  (num-test (lcm 52449289519716/83130157078217 12477253282759/8822750406821)
+	    (/ (* 52449289519716/83130157078217 12477253282759/8822750406821) (gcd 52449289519716/83130157078217 12477253282759/8822750406821)))
+  (num-test (lcm 5409303924479/8573543875303 886731088897/627013566048)
+	    (/ (* 5409303924479/8573543875303 886731088897/627013566048) (gcd 5409303924479/8573543875303 886731088897/627013566048)))
+  (num-test (lcm 615582794569/975675645481 152139002499/107578520350)
+	    (/ (* 615582794569/975675645481 152139002499/107578520350) (gcd 615582794569/975675645481 152139002499/107578520350)))
+  (num-test (lcm 6189245291/9809721694 1855077841/1311738121)
+	    (/ (* 6189245291/9809721694 1855077841/1311738121) (gcd 6189245291/9809721694 1855077841/1311738121)))
+  (num-test (lcm 65470613321/103768467013 10812186007/7645370045)
+	    (/ (* 65470613321/103768467013 10812186007/7645370045) (gcd 65470613321/103768467013 10812186007/7645370045)))
+  (num-test (lcm 6586818670/10439860591 4478554083/3166815962)
+	    (/ (* 6586818670/10439860591 4478554083/3166815962) (gcd 6586818670/10439860591 4478554083/3166815962)))
+  (num-test (lcm 7530699980955811472069/11935877073996486182239 96845919575610633161/68480406462161287469)
+	    (/ (* 7530699980955811472069/11935877073996486182239 96845919575610633161/68480406462161287469)
+	       (gcd 7530699980955811472069/11935877073996486182239 96845919575610633161/68480406462161287469)))
+  (num-test (lcm 753110839881/1193652440098 367296043199/259717522849)
+	    (/ (* 753110839881/1193652440098 367296043199/259717522849) (gcd 753110839881/1193652440098 367296043199/259717522849))))
+
+(test (lcm 0 "hi") 'error)
+(test (lcm 0 1 "hi") 'error)
+(test (lcm 1.4 2.3) 'error)
+(test (lcm 2 1.0+0.5i) 'error)
+
+(test (lcm 92233720368547758/3 3005/2) (if with-bignums 92387443235828670930 'error))
+(test (lcm 92233720368547758/3 30005/2) (if with-bignums 922490926552758492930 'error))
+(test (lcm 92233720368547758/13 3005/17) (if with-bignums 21320179208268154830 'error))
+(when with-bignums
+  (test (lcm (bignum 92233720368547758/3) (bignum 3005/2)) 92387443235828670930)
+  (test (lcm (bignum 92233720368547758/3) (bignum 30005/2)) 922490926552758492930)
+  (test (lcm (bignum 92233720368547758/13) (bignum 3005/17)) 21320179208268154830))
+;; the "reason":
+(test (lcm 3/2 1) 3) ; = 3/2 2/2 -> 6/2 -> 3
+(test (lcm 3/2 5/2) 15/2)
+
+(test (lcm 92233720368547758/13 30005/17) (if with-bignums 12522501265422060990 'error))
+(test (lcm 1152921504606846976/17 3486784401/13) (if with-bignums 4019988717840603673710821376 'error))
+(test (lcm 1152921504606846976/17 59049/13) (if with-bignums 68078861925529707085824 'error))
+(test (lcm 1152921504606846976/17 3486784401/17) (if with-bignums 4019988717840603673710821376/17 'error))
+(test (lcm -9223372036854775808 1) (if with-bignums 9223372036854775808 'error))
+(test (lcm 9223372036854775806 2) 9223372036854775806)
+(test (lcm -9223372036854775808/3 1/3) (if with-bignums 9223372036854775808/3 'error))
+(test (lcm -9223372036854775808) (if with-bignums 9223372036854775808 'error))
+
+(for-each
+ (lambda (arg)
+   (test (lcm arg +nan.0) 'error)
+   (test (lcm +nan.0 arg) 'error)
+   (test (lcm arg +inf.0) 'error)
+   (test (lcm +inf.0 arg) 'error)
+   (test (lcm 2 arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(for-each
+ (lambda (arg)
+   (test (lcm arg 2) 'error)
+   (test (lcm arg 1/2) 'error)
+   (test (lcm arg 2.0) 'error)
+   (test (lcm arg 2+i) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; rationalize
+;;; --------------------------------------------------------------------------------
+
+(num-test (rationalize 0.0 1.0001) 0)
+(num-test (rationalize -0.0 1.0001) 0)
+(num-test (rationalize 0.0 0.50000000000000) 0)
+(num-test (rationalize -0.0 0.50000000000000) 0)
+(num-test (rationalize 0.0 0.1) 0)
+(num-test (rationalize -0.0 0.1) 0)
+(num-test (rationalize 0.0 0.001) 0)
+(num-test (rationalize -0.0 0.001) 0)
+(num-test (rationalize 0.00000001 0.000000011) 0)
+(num-test (rationalize -0.00000001 0.000000011) 0)
+(num-test (rationalize 0.00000001 1.0) 0)
+(num-test (rationalize -0.00000001 1.0) 0)
+(num-test (rationalize 0.00000001 0.50000000000000) 0)
+(num-test (rationalize -0.00000001 0.50000000000000) 0)
+(num-test (rationalize 0.00000001 0.1) 0)
+(num-test (rationalize -0.00000001 0.1) 0)
+(num-test (rationalize 0.00000001 0.001) 0)
+(num-test (rationalize -0.00000001 0.001) 0)
+(num-test (rationalize 1.0 1.0001) 0)
+(num-test (rationalize -1.0 1.0001) 0)
+(num-test (rationalize 1.0 0.999) 1)
+(num-test (rationalize -1.0 0.999) -1)
+(num-test (rationalize 1.0 0.50000000000000) 1)
+(num-test (rationalize -1.0 0.50000000000000) -1)
+(num-test (rationalize 1.0 0.1) 1)
+(num-test (rationalize -1.0 0.1) -1)
+(num-test (rationalize 1.0 0.001) 1)
+(num-test (rationalize -1.0 0.001) -1)
+(num-test (rationalize 1.0 0.00300000000000) 1)
+(num-test (rationalize -1.0 0.00300000000000) -1)
+(num-test (rationalize 1.0 0.00002000000000) 1)
+(num-test (rationalize -1.0 0.00002000000000) -1)
+(num-test (rationalize 1.0 0.00000001) 1)
+(num-test (rationalize -1.0 0.00000001) -1)
+(num-test (rationalize 3.14159265358979 1.0) 3)
+(num-test (rationalize -3.14159265358979 1.0) -3)
+(num-test (rationalize 3.14159265358979 0.50000000000000) 3)
+(num-test (rationalize -3.14159265358979 0.50000000000000) -3)
+(num-test (rationalize 3.14159265358979 0.1) 16/5)
+(num-test (rationalize -3.14159265358979 0.1) -16/5)
+(num-test (rationalize 3.14159265358979 0.001) 201/64)
+(num-test (rationalize -3.14159265358979 0.001) -201/64)
+(num-test (rationalize 3.14159265358979 0.00300000000000) 22/7)
+(num-test (rationalize -3.14159265358979 0.00300000000000) -22/7)
+(num-test (rationalize 3.14159265358979 0.00002000000000) 355/113)
+(num-test (rationalize -3.14159265358979 0.00002000000000) -355/113)
+(num-test (rationalize 3.14159265358979 0.00000001) 100798/32085)
+(num-test (rationalize -3.14159265358979 0.00000001) -100798/32085)
+(num-test (rationalize -2.71828182845905 0.1) -8/3)
+(num-test (rationalize 2.71828182845905 0.001) 87/32)
+(num-test (rationalize -2.71828182845905 0.001) -87/32)
+(num-test (rationalize 2.71828182845905 0.00300000000000) 68/25)
+(num-test (rationalize -2.71828182845905 0.00300000000000) -68/25)
+(num-test (rationalize 2.71828182845905 0.00002000000000) 878/323)
+(num-test (rationalize -2.71828182845905 0.00002000000000) -878/323)
+(num-test (rationalize 2.71828182845905 0.00000001) 23225/8544)
+(num-test (rationalize -2.71828182845905 0.00000001) -23225/8544)
+(num-test (rationalize 1234.12339999999995 1.0) 1234)
+(num-test (rationalize -1234.12339999999995 1.0) -1234)
+(num-test (rationalize 1234.12339999999995 0.50000000000000) 1234)
+(num-test (rationalize -1234.12339999999995 0.50000000000000) -1234)
+(num-test (rationalize 1234.12339999999995 0.1) 6171/5)
+(num-test (rationalize -1234.12339999999995 0.1) -6171/5)
+(num-test (rationalize 1234.12339999999995 0.001) 60472/49)
+(num-test (rationalize -1234.12339999999995 0.001) -60472/49)
+(num-test (rationalize 1234.12339999999995 0.00300000000000) 9873/8)
+(num-test (rationalize -1234.12339999999995 0.00300000000000) -9873/8)
+(num-test (rationalize 1234.12339999999995 0.00002000000000) 290019/235)
+(num-test (rationalize -1234.12339999999995 0.00002000000000) -290019/235)
+(num-test (rationalize 1234.12339999999995 0.00000001) 6170617/5000)
+(num-test (rationalize -1234.12339999999995 0.00000001) -6170617/5000)
+(num-test (rationalize 0.33 1.0) 0)
+(num-test (rationalize -0.33 1.0) 0)
+(num-test (rationalize 0.33 0.50000000000000) 0)
+(num-test (rationalize -0.33 0.50000000000000) 0)
+(num-test (rationalize 0.33 0.1) 1/3)
+(num-test (rationalize -0.33 0.1) -1/3)
+(num-test (rationalize 0.33 0.001) 26/79)
+(num-test (rationalize -0.33 0.001) -26/79)
+(num-test (rationalize 0.33 0.00300000000000) 18/55)
+(num-test (rationalize -0.33 0.00300000000000) -18/55)
+(num-test (rationalize 0.33 0.00002000000000) 33/100)
+(num-test (rationalize -0.33 0.00002000000000) -33/100)
+(num-test (rationalize 0.33 0.00000001) 33/100)
+(num-test (rationalize -0.33 0.00000001) -33/100)
+(num-test (rationalize 0.99990 1.0) 0)
+(num-test (rationalize -0.99990 1.0) 0)
+(num-test (rationalize 0.99990 0.50000000000000) 1)
+(num-test (rationalize -0.99990 0.50000000000000) -1)
+(num-test (rationalize 0.99990 0.1) 1)
+(num-test (rationalize -0.99990 0.1) -1)
+(num-test (rationalize 0.99990 0.001) 1)
+(num-test (rationalize -0.99990 0.001) -1)
+(num-test (rationalize 0.99990 0.00300000000000) 1)
+(num-test (rationalize -0.99990 0.00300000000000) -1)
+(num-test (rationalize 0.99990 0.00002000000000) 8333/8334)
+(num-test (rationalize -0.99990 0.00002000000000) -8333/8334)
+(num-test (rationalize 0.99990 0.00000001) 9999/10000)
+(num-test (rationalize -0.99990 0.00000001) -9999/10000)
+(num-test (rationalize 0.5010 1.0) 0)
+(num-test (rationalize -0.5010 1.0) 0)
+(num-test (rationalize 0.5010 0.50000000000000) 1)
+(num-test (rationalize -0.5010 0.50000000000000) -1)
+(num-test (rationalize 0.5010 0.1) 1/2)
+(num-test (rationalize -0.5010 0.1) -1/2)
+(num-test (rationalize 0.5010 0.00099) 127/253)
+(num-test (rationalize -0.5010 0.00099) -127/253)
+(num-test (rationalize 0.5010 0.00300000000000) 1/2)
+(num-test (rationalize -0.5010 0.00300000000000) -1/2)
+(num-test (rationalize 0.5010 0.00002000000000) 246/491)
+(num-test (rationalize -0.5010 0.00002000000000) -246/491)
+(num-test (rationalize 0.5010 0.00000001) 501/1000)
+(num-test (rationalize -0.5010 0.00000001) -501/1000)
+(num-test (rationalize 0.499 1.0) 0)
+(num-test (rationalize -0.499 1.0) 0)
+(num-test (rationalize 0.499 0.50000000000000) 0)
+(num-test (rationalize -0.499 0.50000000000000) 0)
+(num-test (rationalize 0.499 0.1) 1/2)
+(num-test (rationalize -0.499 0.1) -1/2)
+(num-test (rationalize 0.499 0.00099) 126/253)
+(num-test (rationalize -0.499 0.00099) -126/253)
+(num-test (rationalize 0.499 0.00300000000000) 1/2)
+(num-test (rationalize -0.499 0.00300000000000) -1/2)
+(num-test (rationalize 0.499 0.00002000000000) 245/491)
+(num-test (rationalize -0.499 0.00002000000000) -245/491)
+(num-test (rationalize 0.499 0.00000001) 499/1000)
+(num-test (rationalize -0.499 0.00000001) -499/1000)
+(num-test (rationalize 1.501 1.0) 1)
+(num-test (rationalize -1.501 1.0) -1)
+(num-test (rationalize 1.501 0.50000000000000) 2)
+(num-test (rationalize -1.501 0.50000000000000) -2)
+(num-test (rationalize 1.501 0.1) 3/2)
+(num-test (rationalize -1.501 0.1) -3/2)
+(num-test (rationalize 1.501 0.01) 3/2)
+(num-test (rationalize -1.501 0.01) -3/2)
+(num-test (rationalize 1.501 0.00300000000000) 3/2)
+(num-test (rationalize -1.501 0.00300000000000) -3/2)
+(num-test (rationalize 1.501 0.00002000000000) 737/491)
+(num-test (rationalize -1.501 0.00002000000000) -737/491)
+(num-test (rationalize 1.501 0.00000001) 1501/1000)
+(num-test (rationalize -1.501 0.00000001) -1501/1000)
+(num-test (rationalize 1.499 1.0) 1)
+(num-test (rationalize -1.499 1.0) -1)
+(num-test (rationalize 1.499 0.50000000000000) 1)
+(num-test (rationalize -1.499 0.50000000000000) -1)
+(num-test (rationalize 1.499 0.1) 3/2)
+(num-test (rationalize -1.499 0.1) -3/2)
+(num-test (rationalize 1.499 0.001) 3/2)
+(num-test (rationalize -1.499 0.001) -3/2)
+(num-test (rationalize 1.499 0.00300000000000) 3/2)
+(num-test (rationalize -1.499 0.00300000000000) -3/2)
+(num-test (rationalize 1.499 0.00002000000000) 736/491)
+(num-test (rationalize -1.499 0.00002000000000) -736/491)
+(num-test (rationalize 1.499 0.00000001) 1499/1000)
+(num-test (rationalize -1.499 0.00000001) -1499/1000)
+
+(num-test (rationalize 1.16 .2) 1)
+(num-test (rationalize 1.16 .1) 5/4)
+(num-test (rationalize 1.16 .041) 6/5)
+(num-test (rationalize 1.16 .039) 7/6)
+(num-test (rationalize 1.16 .007) 7/6)
+(num-test (rationalize 1.16 .006) 22/19)
+(num-test (rationalize 1.16 .0022) 22/19)
+(num-test (rationalize 1.16 .002) 29/25)
+(num-test (rationalize 1.16 .0000001) 29/25)
+(num-test (rationalize .1 .1) 0)
+(num-test (rationalize .1 .0999) 1/6)
+(num-test (rationalize .1 .065) 1/7)
+(num-test (rationalize .1 .067) 1/6)
+(num-test (rationalize .1 .04) 1/8)
+(num-test (rationalize .1 .02) 1/9)
+(num-test (rationalize .1 .01) 1/10)
+
+(num-test (rationalize 23.1 22.0) 2)
+(num-test (rationalize 23.1 22) 2)
+(num-test (rationalize 23.1 .5) 23)
+(num-test (rationalize 23.1 1/2) 23)
+
+(num-test (rationalize 1/2 3/4) 0)
+(num-test (rationalize 1/2 1/4) 1/2)
+(num-test (rationalize 1 3) 0)
+(num-test (rationalize 11/10 1/5) 1)
+(num-test (rationalize 3/4 1/2) 1)
+(num-test (rationalize 1/4 1/3) 0)
+(num-test (rationalize 1/4 1/6) 1/3)
+(num-test (rationalize 2/3 1/4) 1/2)
+(num-test (rationalize 1/3 1/3) 0)
+(num-test (rationalize 1/3 1/4) 1/2)
+(num-test (rationalize 3/10 1/10) 1/3)
+
+(num-test (rationalize 1/4 1/11) 1/3)
+(num-test (rationalize 1/4 1/12) 1/4)
+(num-test (rationalize pi 1/10) 16/5)
+(num-test (rationalize pi 1/100) 22/7)
+(num-test (rationalize pi 1/10000) 333/106)
+
+;; currently (rationalize pi 0) -> 245850922/78256779, but should it return the actual (float-style) ratio?
+
+(num-test (rationalize 1 .1) 1)
+(num-test (rationalize 1 1) 0)
+(num-test (rationalize 1 1/2) 1)
+(num-test (rationalize 1 0) 1)
+(num-test (rationalize 0 -.1) 0)
+(num-test (rationalize 0 1) 0)
+(num-test (rationalize 0 0) 0)
+(num-test (rationalize -1 .1) -1)
+(num-test (rationalize -1 -1) 0)
+
+(num-test (rationalize (exact->inexact 1/2) 3/4) 0)
+(num-test (rationalize (exact->inexact 1/2) 1/4) 1/2)
+(num-test (rationalize (exact->inexact 1) 3) 0)
+(num-test (rationalize (exact->inexact 11/10) 1/5) 1)
+(num-test (rationalize (exact->inexact 3/4) 1/2) 1)
+(num-test (rationalize (exact->inexact 1/4) 1/3) 0)
+(num-test (rationalize (exact->inexact 1/4) 1/6) 1/3)
+(num-test (rationalize (exact->inexact 2/3) 1/4) 1/2)
+(num-test (rationalize (exact->inexact 1/3) 1/4) 1/2)
+(num-test (rationalize (exact->inexact 3/10) 1/10) 1/3)
+
+(num-test (rationalize 1/2 (exact->inexact 3/4)) 0)
+(num-test (rationalize 1/2 (exact->inexact 1/4)) 1/2)
+(num-test (rationalize 1 (exact->inexact 3)) 0)
+(num-test (rationalize 11/10 (exact->inexact 1/5)) 1)
+(num-test (rationalize 3/4 (exact->inexact 1/2)) 1)
+(num-test (rationalize 1/4 (exact->inexact 1/3)) 0)
+(num-test (rationalize 1/4 (exact->inexact 1/6)) 1/3)
+(num-test (rationalize 2/3 (exact->inexact 1/4)) 1/2)
+(num-test (rationalize 1/3 (exact->inexact 1/4)) 1/2)
+(num-test (rationalize 3/10 (exact->inexact 1/10)) 1/3)
+
+(num-test (rationalize (exact->inexact 1/2) (exact->inexact 3/4)) 0)
+(num-test (rationalize (exact->inexact 1/2) (exact->inexact 1/4)) 1/2)
+(num-test (rationalize (exact->inexact 1) (exact->inexact 3)) 0)
+(num-test (rationalize (exact->inexact 11/10) (exact->inexact 1/5)) 1)
+(num-test (rationalize (exact->inexact 3/4) (exact->inexact 1/2)) 1)
+(num-test (rationalize (exact->inexact 1/4) (exact->inexact 1/3)) 0)
+(num-test (rationalize (exact->inexact 1/4) (exact->inexact 1/6)) 1/3)
+(num-test (rationalize (exact->inexact 2/3) (exact->inexact 1/4)) 1/2)
+(num-test (rationalize (exact->inexact 1/3) (exact->inexact 1/4)) 1/2)
+(num-test (rationalize (exact->inexact 3/10) (exact->inexact 1/10)) 1/3)
+
+(num-test (rationalize -1/2 3/4) 0)
+(num-test (rationalize -1/2 1/4) -1/2)
+(num-test (rationalize -1 3) 0)
+(num-test (rationalize -11/10 1/5) -1)
+(num-test (rationalize -3/4 1/2) -1)
+(num-test (rationalize -1/4 1/3) 0)
+(num-test (rationalize -1/4 1/6) -1/3)
+(num-test (rationalize -2/3 1/4) -1/2)
+(num-test (rationalize -1/3 1/4) -1/2)
+(num-test (rationalize -1/3 1/3) 0)
+(num-test (rationalize -3/10 1/10) -1/3)
+(num-test (rationalize .0999 .1) 0)
+(num-test (rationalize -.0999 .1) 0)
+(num-test (rationalize 1.0999 .1) 1)
+(num-test (rationalize -1.0999 .1) -1)
+
+(num-test (rationalize .239 .0005) 11/46) ;baseball of course... the average .001 is the hardest to get: 1/667
+(num-test (rationalize .001 .0005) 1/667)
+(num-test (rationalize .334 .0005) 96/287)
+
+(num-test (rationalize 1.0000001 0.00000001) 9090911/9090910)
+(num-test (rationalize 0.000000015 0.0000000009999999) 1/62500001)
+(num-test (rationalize 0.00000001 1e-16) 1/100000000)
+(num-test (rationalize 0.1 0) (if with-bignums 3602879701896397/36028797018963968 1/10))
+(num-test (rationalize 0.1 .00000000000000001) 1/10)
+(num-test (/ 0.(rationalize .1)) 0.0)
+
+(unless with-bignums
+  (num-test (rationalize .1 0) 1/10)
+  ;; but (rationalize 0.1 0) -> 1526457681181556/15264576811815559? independent of precision
+  ;; and (rationalize 0.1000000000000000 0) -> 1/10 so once again it's either the idiotic reader or the bignum promotion process
+  ;;     (rationalize 0.00000001 0) 3022314549036573/302231454903657293676544?
+
+  (num-test (rationalize 1e-3 0) 1/1000)
+  (unless (provided? '32-bit)
+    (num-test (rationalize 1e-12 0) 1/1000000000000)
+    (num-test (rationalize 1e-15 0) 1/1000000000000000))
+  (num-test (rationalize (+ 1e2 1e-2) 0) 10001/100))
+
+(num-test (rationalize -1 -1) 0) ;; spec says "differs by no more than", but that seems to imply a comparison
+;; on either side, so a negative error doesn't change the result??
+(num-test (rationalize 1/4 -1/6) 1/3)
+(num-test (rationalize -3/10 -1/10) -1/3)
+(num-test (rationalize (exact->inexact 1/3) (exact->inexact -1/4)) 1/2)
+(num-test (rationalize 0.5 0.02) 1/2)
+(num-test (rationalize 1073741824 1) 1073741823) ; perverse
+(num-test (rationalize -2.225073858507201399999999999999999999996E-308) 0)
+(num-test (rationalize -9223372036854775808) -9223372036854775808)
+(num-test (rationalize 1.110223024625156799999999999999999999997E-16) 0)
+(num-test (rationalize 9223372036854775807) 9223372036854775807)
+(num-test (rationalize -3037000503.0 -3037000500.0) -3)
+
+(num-test (rationalize 33309123021416.7508179322803e-25 1e-20) 1/300218050279)
+(num-test (rationalize 33309123021416.7508179322803e-25 1e-12) 1/230898233499)
+(num-test (rationalize 33309123021416.7508179322803e-25 1e-23) 1/300218051179)
+
+(num-test (rationalize 9223372036854775807 0) 9223372036854775807)
+(num-test (rationalize 9223372036854775807 -1) 9223372036854775806)
+(num-test (rationalize 9223372036854775807 -1/2) 9223372036854775807)
+(num-test (rationalize 9223372036854775807 1/2) 9223372036854775807)
+(num-test (rationalize 9223372036854775807 3/2) 9223372036854775806)
+(num-test (rationalize 9223372036854775807 -3/2) 9223372036854775806)
+(num-test (rationalize 9223372036854775807 1) 9223372036854775806)
+(num-test (rationalize 9223372036854775807 +inf.0) 0)
+
+(test (rationalize (/ pi) 1e-8) 24288/76303)
+(test (rationalize (/ pi) 1e-10) 33102/103993)
+(num-test (rationalize 1e8 1e9) 0)
+(num-test (rationalize 1e16 most-positive-fixnum) 0)
+(num-test (rationalize most-positive-fixnum 1e20) 0)
+(num-test (rationalize most-positive-fixnum most-positive-fixnum) 0)
+(num-test (rationalize (/ 1 most-positive-fixnum) 0) (/ 1 most-positive-fixnum))
+(num-test (rationalize 1e20 -1e21) 0)
+(num-test (rationalize -1e20 1e21) 0)
+(num-test (rationalize 1e20 +inf.0) 0)
+
+(num-test (rationalize (/ (expt 2 60) (expt 3 20)) .01) 2314582608/7)
+(num-test (rationalize (/ (expt 2 60) (expt 3 20)) .001) 8266366457/25)
+(num-test (rationalize 33309123021416.7508179322803e-25 1e-23) 1/300218051179)
+(num-test (rationalize 11/30 .1) 1/3)
+(num-test (rationalize 11/30 .2) 1/2)
+(num-test (rationalize 11/30 .365) 1/2)
+(num-test (rationalize 11/30 .367) 0)
+
+;; these differ from the ratify result
+(num-test (rationalize 0.02 .01) 1/34)
+(num-test (rationalize 0.05 .01) 1/17)
+(num-test (rationalize 0.06 .01) 1/15)
+(num-test (rationalize 0.07 .01) 1/13)
+(num-test (rationalize 0.32 .01) 5/16)
+(num-test (rationalize 0.35 .01) 5/14)
+(num-test (rationalize 0.39 .01) 2/5)
+(num-test (rationalize 0.47 .01) 6/13)
+(num-test (rationalize 0.48 .01) 8/17)
+(num-test (rationalize 0.52 .01) 9/17)
+(num-test (rationalize 0.53 .01) 7/13)
+(num-test (rationalize 0.61 .01) 3/5)
+(num-test (rationalize 0.65 .01) 9/14)
+(num-test (rationalize 0.68 .01) 11/16)
+(num-test (rationalize 0.93 .01) 12/13)
+(num-test (rationalize 0.94 .01) 14/15)
+(num-test (rationalize 0.95 .01) 16/17)
+(num-test (rationalize 0.96 .01) 19/20)
+(num-test (rationalize 0.97 .01) 24/25)
+(num-test (rationalize 0.98 .01) 33/34)
+
+(num-test (rationalize 0.01 .001) 1/91)
+(num-test (rationalize 0.02 .001) 1/48)
+(num-test (rationalize 0.06 .001) 2/33)
+(num-test (rationalize 0.11 .001) 6/55)
+(num-test (rationalize 0.14 .001) 6/43)
+(num-test (rationalize 0.17 .001) 7/41)
+(num-test (rationalize 0.18 .001) 7/39)
+(num-test (rationalize 0.33 .001) 26/79)
+(num-test (rationalize 0.34 .001) 15/44)
+(num-test (rationalize 0.43 .001) 28/65)
+(num-test (rationalize 0.46 .001) 17/37)
+(num-test (rationalize 0.49 .001) 23/47)
+(num-test (rationalize 0.51 .001) 24/47)
+(num-test (rationalize 0.57 .001) 37/65)
+(num-test (rationalize 0.58 .001) 18/31)
+(num-test (rationalize 0.66 .001) 29/44)
+(num-test (rationalize 0.67 .001) 53/79)
+(num-test (rationalize 0.83 .001) 34/41)
+(num-test (rationalize 0.86 .001) 37/43)
+(num-test (rationalize 0.89 .001) 49/55)
+(num-test (rationalize 0.94 .001) 31/33)
+(num-test (rationalize 0.98 .001) 47/48)
+(num-test (rationalize 0.99 .001) 90/91)
+
+(num-test (rationalize 0.1001 .1) 1/5)
+(num-test (rationalize 0.101 .1) 1/5)
+(num-test (rationalize 0.451 .0010001) 9/20)
+(num-test (rationalize 0.9876 .0001) 80/81)
+
+(num-test (rationalize (expt 2 1/3) (expt 10 -10)) 96389/76504)
+(num-test (rationalize (expt 2 1/3) (expt 10 -15)) 15240955/12096754)
+
+(for-each
+ (lambda (num-and-val)
+   (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'rationalize num (rationalize num) val)))
+ (vector (list 0 0) (list 1 1) (list 2 2) (list 3 3) (list -1 -1) (list -2 -2) (list -3 -3)
+	 (list 9223372036854775807 9223372036854775807) (list -9223372036854775808 -9223372036854775808)
+	 (list 1/2 1/2) (list 1/3 1/3) (list -1/2 -1/2) (list -1/3 -1/3) (list 1/9223372036854775807 0)
+	 (list 0.0 0) (list 1.0 1) (list 2.0 2) (list -2.0 -2) (list 1.000000000000000000000000000000000000002E-309 0)))
+
+(if (not with-bignums)
+    (begin
+      (test (< (abs (- (rationalize (/ pi) 1e-17) (/ pi))) 1e-10) #t) ; make sure we don't hang!
+      (test (< (abs (- (rationalize (/ pi) 1e-18) (/ pi))) 1e-10) #t)
+      (test (< (abs (- (rationalize (/ pi) 1e-20) (/ pi))) 1e-10) #t)
+
+      (num-test (rationalize 1e-19 1e-21) 0)
+      (num-test (rationalize 1e-19 1e-30) 0)
+      (num-test (rationalize 1e-19 1e-50) 0)
+      (num-test (rationalize 1e-19 0.0) 0)
+      (num-test (rationalize 1e-19 1e-19) 0)
+      (num-test (rationalize 1e-30 0.0) 0)
+      (num-test (rationalize (+ .1 1e-18) 1e-17) 1/10)
+      (num-test (rationalize (- .1 1e-18) 1e-17) 1/10)
+      )
+    (begin
+      (test (rationalize (/ pi) 1e-17) 78256779/245850922)
+      (test (rationalize (/ pi) 1e-18) 340262731/1068966896)
+      (test (rationalize (/ pi) 1e-20) 1963319607/6167950454)
+      (test (rationalize (/ pi) 1e-30) 136308121570117/428224593349304)
+      (num-test (rationalize (/ 1 most-negative-fixnum) 0) (/ 1 most-negative-fixnum))
+
+      (num-test (rationalize 1e-19 1e-21) 1/9900990099009900991)
+      (num-test (rationalize 1e-19 1e-30) 1/9999999999900000001)
+      (num-test (rationalize 1e-30 0.0) 1/1000000000000000000000000000000)
+      (num-test (rationalize (+ .1 1e-18) 0) 1894333982346309985/18943339823463098609)
+      (num-test (rationalize (+ .1 1e-18) 1e-20) 1524131159466061/15241311594660609)
+      (num-test (rationalize (- .1 1e-18) 1e-20) 2192446305355891/21924463053558909)
+      (num-test (rationalize 1e18 1e19) 0)
+
+      (num-test (rationalize 1180591620717411303424) 1180591620717411303424)
+      (num-test (rationalize 1180591620717411303424 .9) 1180591620717411303424)
+      (num-test (rationalize -1180591620717411303424 1.9) -1180591620717411303423)
+      (test (rationalize -1180591620717411303424 +nan.0) 'error)
+      (num-test (rationalize -1180591620717411303424 +inf.0) 0)
+      (num-test (rationalize most-negative-fixnum 1) (+ most-negative-fixnum 1))
+
+      (num-test (rationalize (/ 3.0 most-positive-fixnum) 1e-50) 3/9223372036854775807)
+      (num-test (rationalize (/ 3.0 most-positive-fixnum) 1e-38) 3/9223372036854775807)
+
+      (num-test (rationalize (expt 2 1/3) (expt 10 -20)) 11952836413/9486972548)
+      (num-test (rationalize (expt 2 1/3) (expt 10 -30)) 2566462403285413/2037002559406049)
+      (test (< (abs (- (expt (rationalize (expt 2 1/3) (expt 10 -30)) 3.0) 2)) 1e-29) #t)
+
+      (test (rationalize 3796553736732654909229441/2684568892382786771291329) 1607521/1136689) ; default error?
+      (test (< (abs (- (rationalize 3796553736732654909229441/2684568892382786771291329)3796553736732654909229441/2684568892382786771291329)) 1e-12) #t)
+      (num-test (rationalize 3796553736732654909229441/2684568892382786771291329 1) 1)
+
+      (test (let () (define (func) (let ((x 8796093022208)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (rationalize x))))) (define (hi) (func)) (hi)) #t)
+
+      (let-temporarily (((*s7* 'bignum-precision) 1024))
+	(num-test (rationalize (expt 2 1/3) 1e-40) 77270484057362988877/61329623839374997455)
+	(num-test (rationalize 3796553736732654909229441/2684568892382786771291329 0) 3796553736732654909229441/2684568892382786771291329))))
+
+
+(let ()
+  (define (check-rationalize val n)
+    (call-with-exit
+     (lambda (return)
+       (let* ((diffs (make-vector n 0.0))
+	      (ratios (make-vector n 0)))
+	 (do ((i 0 (+ i 1)))
+	     ((= i n))
+	   (let* ((err (expt 2 (- (+ i 1))))
+		  (rat (rationalize val err))
+		  (diff (abs (- rat val))))
+	     (vector-set! ratios i rat)
+	     (vector-set! diffs i diff)
+	     (if (> diff err)
+		 (begin
+		   (format #t "|~A - ~A| = ~A > ~A (2^~A -> 2^~A)?~%" val rat diff err (log diff 2) (log err 2))
+		   (return #f)))))
+	 (and (apply >= (vector->list diffs))
+	      (apply <= (map denominator ratios)))))))
+
+  (for-each
+   (lambda (val)
+     (test (check-rationalize val 40) #t))
+   (list pi (/ pi) (- pi) (- (/ pi)) (* 10 pi) (* -1000 pi) (exp 1.0) (exp -1.0) (exp 4.0) (exp -4.0)))
+
+  (do ((i 0 (+ i 1)))
+      ((= i 100))
+    (let ((val (- (random 2.0) 1.0)))
+      (let ((rat (check-rationalize val 40)))
+	(if (not rat)
+	    (format #t "rationalize trouble with ~A~%" val)))))
+
+  (when with-bignums
+    (let-temporarily (((*s7* 'bignum-precision) 4096))
+      (test (*s7* 'bignum-precision) 4096)
+
+      (test (check-rationalize pi 100) #t)
+      (test (check-rationalize (/ pi) 100) #t)
+
+      (for-each
+       (lambda (arg)
+	 (test (set! (*s7* 'bignum-precision) arg) 'error))
+       (list "hi" #\a 'a-symbol #(1 2 3) -1 0 1 3.14 3/4 1.0+1.0i #t abs #<eof> #<unspecified> (lambda () 1)))
+
+      (test (bignum-precision 213) 'error)
+      (test (set! (bignum-precision 213) 123) 'error)
+
+      (set! (*s7* 'bignum-precision) 2)
+      (test (*s7* 'bignum-precision) 2)
+      (test (object->string pi) "3.0E0"))))
+
+(test (rationalize) 'error)
+(test (rationalize 1.23+1.0i 1.23+1.0i) 'error)
+(test (rationalize 1.23 1.23 1.23) 'error)
+(test (rationalize 0 +nan.0) 'error) ; ??
+(test (rationalize 1 +nan.0) 'error)
+(test (rationalize (expt 2 60) -) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (rationalize arg 0.1) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+#|
+;; this is only the tip of the iceberg -- need much more stringent tests
+(let ()
+  (define (func)
+    (call-with-output-string
+      (lambda (p)
+	(do ((i 0 (+ i 1)))
+	    ((= i 1) (get-output-string p))
+	  (display (rationalize most-positive-fixnum) p)))))
+  (test (func) "9223372036854775807"))
+|#
+
+(for-each
+ (lambda (arg)
+   (test (rationalize arg +nan.0) 'error)
+   (test (rationalize +nan.0 arg) 'error)
+   (test (rationalize arg +inf.0) 'error)
+   (test (rationalize +inf.0 arg) 'error)
+   (test (rationalize 0.1 arg) 'error)
+   (test (rationalize 1 arg) 'error)
+   (test (rationalize 1/2 arg) 'error)
+   (test (rationalize 0+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(if with-bignums
+    (begin
+      (num-test (rationalize .1e20) 10000000000000000000)
+      (num-test (rationalize 1e19) 10000000000000000000)
+      (num-test (rationalize 1e20) 100000000000000000000))
+    (begin
+      (test (rationalize .1e20) 'error)
+      (test (rationalize 1e19) 'error)
+      (test (rationalize 1e20) 'error)))
+
+(call-with-exit
+ (lambda (done)
+   (do ((k -6 (- k 1)))
+       ((= k -17))
+     (call-with-exit
+      (lambda (ok)
+	(let ((fraction (rationalize (expt 10.0 k) 1e-18)))
+	  (do ((i 0 (+ i 1)))
+	      ((= i 100))
+	    (if (not (zero? (random fraction)))
+		(ok))))
+	(format #t ";random of small ratios is always 0 below ca. ~A~%" (expt 10.0 k))
+	(done))))))
+
+(let-temporarily (((*s7* 'default-rationalize-error) 1e-11))
+  (test (rationalize 1.000000056443638e-12) 0)
+  (set! (*s7* 'default-rationalize-error) 1e-12)
+  (test (rationalize 1.000000056443638e-12) (if with-bignums 1/499999985890 0)))
+
+
+;;; Bill Gosper's farint:
+
+(let ()
+  (define* (farint x (err 1/1000000)) ; this err term is not the same as the s7 rationalize error term
+
+    (define (farint-1 x nhi dhi ln ld hn hd)
+      (if (> (+ ln hn) (* (+ ld hd) x))
+	  (let* ((m (min (if (= 0 ln)
+			     nhi
+			     (floor (/ (- nhi hn) ln)))
+			 (floor (/ (- dhi hd) ld))))
+		 (d (- (* x ld) ln))
+		 (k (if (= 0 d)
+			m
+			(ceiling (/ (- hn (* x hd)) d)))))
+	    (if (< k m)
+		(let ((hn1 (+ (* k ln) hn))
+		      (hd1 (+ (* k ld) hd)))
+		  (farint-1 x nhi dhi hn1 hd1 (- hn1 ln) (- hd1 ld)))
+
+		(let* ((n (+ (* m ln) hn)) (d (+ (* m ld) hd)))
+		  (if (< (* 2 d ld x) (+ (* ld n) (* ln d)))
+		      (/ ln ld)
+		      (/ n d)))))
+
+	  (let* ((m (min (floor (/ (- nhi ln) hn))
+			 (if (= 0 hd)
+			     dhi
+			     (floor (/ (- dhi ld) hd)))))
+		 (d (- hn (* x hd)))
+		 (k (if (= 0 d)
+			m
+			(ceiling (/ (- (* x ld) ln) d)))))
+	    (if (< k m)
+		(let ((ln1 (+ (* k hn) ln))
+		      (ld1 (+ (* k hd) ld)))
+		  (farint-1 x nhi dhi (- ln1 hn) (- ld1 hd) ln1 ld1))
+		(let* ((n (+ (* m hn) ln)) (d (+ (* m hd) ld)))
+		  (if (< (* 2 d hd x) (+ (* hd n) (* hn d)))
+		      (/ n d)
+		      (/ hn hd)))))))
+
+    (farint-1 x (/ err) (/ err) 0 1 1 0))
+
+  (num-test (farint .1) 1/10))
+
+;; scheme version of rationalize
+(define* (cdr-ratify ux (err 0.0000001))
+  ;; translated from CL code in Canny, Donald, Ressler, "A Rational Rotation Method for Robust Geometric Algorithms"
+  (let ((x0 (- ux err))
+	(x1 (+ ux err)))
+    (let ((i (ceiling x0))
+	  (i0 (floor x0))
+	  (i1 (ceiling x1))
+	  (r 0))
+      (if (>= x1 i)
+	  i
+	  (do ((p0 i0 (+ p1 (* r p0)))
+	       (q0 1 (+ q1 (* r q0)))
+	       (p1 i1 p0)
+	       (q1 1 q0)
+	       (e0 (- i1 x0) e1p)
+	       (e1 (- x0 i0) (- e0p (* r e1p)))
+	       (e0p (- i1 x1) e1)
+	       (e1p (- x1 i0) (- e0 (* r e1))))
+	      ((<= x0 (/ p0 q0) x1)
+	       (/ p0 q0))
+	    (set! r (min (floor (/ e0 e1))
+			 (ceiling (/ e0p e1p)))))))))
+
+(test (cdr-ratify .75) 3/4)
+
+
+;;; --------------------------------------------------------------------------------
+;;; min
+;;; --------------------------------------------------------------------------------
+
+(num-test (min -0.0) 0.0)
+(num-test (min -1 -1/2) -1)
+(num-test (min -1/2 0) -1/2)
+(num-test (min 0 -1/2) -1/2)
+(num-test (min -1 1/2) -1)
+(num-test (min -1 1/2) -1)
+(num-test (min -1.0) -1.0)
+(num-test (min -1.797693134862315699999999999999999999998E308 -9223372036854775808) -1.797693134862315699999999999999999999998E308)
+(num-test (min -1/2 -1) -1)
+(num-test (min -1/2 1) -1/2)
+(num-test (min -10) -10)
+(num-test (min -10/3) -10/3)
+(num-test (min -2 3 0 7) -2)
+(num-test (min -2) -2)
+(num-test (min -2/2) -2/2)
+(num-test (min -3/2 -1/2) -3/2)
+(num-test (min -3/2 -6/5) -3/2)
+(num-test (min -3/2 1/2) -3/2)
+(num-test (min -3/2 6/5) -3/2)
+(num-test (min -6 -12) -12)
+(num-test (min -9223372036854775808 -9223372036854775808) -9223372036854775808)
+(num-test (min -9223372036854775808 5.551115123125783999999999999999999999984E-17) -9.223372036854775808E18)
+(num-test (min -9223372036854775808 9223372036854775807 -9223372036854775808) -9223372036854775808)
+(num-test (min 0 1 1) 0)
+(num-test (min 0 1 1.0) 0.0)
+(num-test (min 0 1 1/1) 0)
+(num-test (min 0 1 123.4) 0.0)
+(num-test (min 0 1 1234) 0)
+(num-test (min 0 1 1234/11) 0)
+(num-test (min 0 1) 0)
+(num-test (min 0 1.0 1) 0.0)
+(num-test (min 0 1.0 1.0) 0.0)
+(num-test (min 0 1.0 1/1) 0.0)
+(num-test (min 0 1.0 123.4) 0.0)
+(num-test (min 0 1.0 1234) 0.0)
+(num-test (min 0 1.0 1234/11) 0.0)
+(num-test (min 0 1.0) 0.0)
+(num-test (min 0 1/1) 0)
+(num-test (min 0 123.4 1) 0.0)
+(num-test (min 0 123.4 1.0) 0.0)
+(num-test (min 0 123.4 1/1) 0.0)
+(num-test (min 0 123.4 123.4) 0.0)
+(num-test (min 0 123.4 1234) 0.0)
+(num-test (min 0 123.4 1234/11) 0.0)
+(num-test (min 0 123.4) 0.0)
+(num-test (min 0 1234 1) 0)
+(num-test (min 0 1234 1.0) 0.0)
+(num-test (min 0 1234 1/1) 0)
+(num-test (min 0 1234 123.4) 0.0)
+(num-test (min 0 1234 1234) 0)
+(num-test (min 0 1234 1234/11) 0)
+(num-test (min 0 1234) 0)
+(num-test (min 0 1234/11 1) 0)
+(num-test (min 0 1234/11 1.0) 0.0)
+(num-test (min 0 1234/11 1/1) 0)
+(num-test (min 0 1234/11 123.4) 0.0)
+(num-test (min 0 1234/11 1234) 0)
+(num-test (min 0 1234/11 1234/11) 0)
+(num-test (min 0 1234/11) 0)
+(num-test (min 0) 0)
+(num-test (min 0.0 1 1) 0.0)
+(num-test (min 0.0 1 1.0) 0.0)
+(num-test (min 0.0 1 1/1) 0.0)
+(num-test (min 0.0 1 123.4) 0.0)
+(num-test (min 0.0 1 1234) 0.0)
+(num-test (min 0.0 1 1234/11) 0.0)
+(num-test (min 0.0 1) 0.0)
+(num-test (min 0.0 1.0 1) 0.0)
+(num-test (min 0.0 1.0 1.0) 0.0)
+(num-test (min 0.0 1.0 1/1) 0.0)
+(num-test (min 0.0 1.0 123.4) 0.0)
+(num-test (min 0.0 1.0 1234) 0.0)
+(num-test (min 0.0 1.0 1234/11) 0.0)
+(num-test (min 0.0 1.0) 0.0)
+(num-test (min 0.0 1/1) 0.0)
+(num-test (min 0.0 123.4 1) 0.0)
+(num-test (min 0.0 123.4 1.0) 0.0)
+(num-test (min 0.0 123.4 1/1) 0.0)
+(num-test (min 0.0 123.4 123.4) 0.0)
+(num-test (min 0.0 123.4 1234) 0.0)
+(num-test (min 0.0 123.4 1234/11) 0.0)
+(num-test (min 0.0 123.4) 0.0)
+(num-test (min 0.0 1234 1) 0.0)
+(num-test (min 0.0 1234 1.0) 0.0)
+(num-test (min 0.0 1234 1/1) 0.0)
+(num-test (min 0.0 1234 123.4) 0.0)
+(num-test (min 0.0 1234 1234) 0.0)
+(num-test (min 0.0 1234 1234/11) 0.0)
+(num-test (min 0.0 1234) 0.0)
+(num-test (min 0.0 1234/11 1) 0.0)
+(num-test (min 0.0 1234/11 1.0) 0.0)
+(num-test (min 0.0 1234/11 1/1) 0.0)
+(num-test (min 0.0 1234/11 123.4) 0.0)
+(num-test (min 0.0 1234/11 1234) 0.0)
+(num-test (min 0.0 1234/11 1234/11) 0.0)
+(num-test (min 0.0 1234/11) 0.0)
+(num-test (min 0.0) 0.0)
+(num-test (min 0/1) 0/1)
+(num-test (min 1 -1/2) -1/2)
+(num-test (min 1 1 1) 1)
+(num-test (min 1 1 1.0) 1.0)
+(num-test (min 1 1 1/1) 1)
+(num-test (min 1 1 123.4) 1.0)
+(num-test (min 1 1 1234) 1)
+(num-test (min 1 1 1234/11) 1)
+(num-test (min 1 1) 1)
+(num-test (min 1 1.0 1) 1.0)
+(num-test (min 1 1.0 1.0) 1.0)
+(num-test (min 1 1.0 1/1) 1.0)
+(num-test (min 1 1.0 123.4) 1.0)
+(num-test (min 1 1.0 1234) 1.0)
+(num-test (min 1 1.0 1234/11) 1.0)
+(num-test (min 1 1.0) 1.0)
+(num-test (min 1 1/1) 1)
+(num-test (min 1 1/2) 1/2)
+(num-test (min 1 123.4 1) 1.0)
+(num-test (min 1 123.4 1.0) 1.0)
+(num-test (min 1 123.4 1/1) 1.0)
+(num-test (min 1 123.4 123.4) 1.0)
+(num-test (min 1 123.4 1234) 1.0)
+(num-test (min 1 123.4 1234/11) 1.0)
+(num-test (min 1 123.4) 1.0)
+(num-test (min 1 1234 1) 1)
+(num-test (min 1 1234 1.0) 1.0)
+(num-test (min 1 1234 1/1) 1)
+(num-test (min 1 1234 123.4) 1.0)
+(num-test (min 1 1234 1234) 1)
+(num-test (min 1 1234 1234/11) 1)
+(num-test (min 1 1234) 1)
+(num-test (min 1 1234/11 1) 1)
+(num-test (min 1 1234/11 1.0) 1.0)
+(num-test (min 1 1234/11 1/1) 1)
+(num-test (min 1 1234/11 123.4) 1.0)
+(num-test (min 1 1234/11 1234) 1)
+(num-test (min 1 1234/11 1234/11) 1)
+(num-test (min 1 1234/11) 1)
+(num-test (min 1 3 2 -7) -7)
+(num-test (min 1.0 1 1) 1.0)
+(num-test (min 1.0 1 1.0) 1.0)
+(num-test (min 1.0 1 1/1) 1.0)
+(num-test (min 1.0 1 123.4) 1.0)
+(num-test (min 1.0 1 1234) 1.0)
+(num-test (min 1.0 1 1234/11) 1.0)
+(num-test (min 1.0 1) 1.0)
+(num-test (min 1.0 1.0 1) 1.0)
+(num-test (min 1.0 1.0 1.0) 1.0)
+(num-test (min 1.0 1.0 1/1) 1.0)
+(num-test (min 1.0 1.0 123.4) 1.0)
+(num-test (min 1.0 1.0 1234) 1.0)
+(num-test (min 1.0 1.0 1234/11) 1.0)
+(num-test (min 1.0 1.0) 1.0)
+(num-test (min 1.0 1/1) 1.0)
+(num-test (min 1.0 123.4 1) 1.0)
+(num-test (min 1.0 123.4 1.0) 1.0)
+(num-test (min 1.0 123.4 1/1) 1.0)
+(num-test (min 1.0 123.4 123.4) 1.0)
+(num-test (min 1.0 123.4 1234) 1.0)
+(num-test (min 1.0 123.4 1234/11) 1.0)
+(num-test (min 1.0 123.4) 1.0)
+(num-test (min 1.0 1234 1) 1.0)
+(num-test (min 1.0 1234 1.0) 1.0)
+(num-test (min 1.0 1234 1/1) 1.0)
+(num-test (min 1.0 1234 123.4) 1.0)
+(num-test (min 1.0 1234 1234) 1.0)
+(num-test (min 1.0 1234 1234/11) 1.0)
+(num-test (min 1.0 1234) 1.0)
+(num-test (min 1.0 1234/11 1) 1.0)
+(num-test (min 1.0 1234/11 1.0) 1.0)
+(num-test (min 1.0 1234/11 1/1) 1.0)
+(num-test (min 1.0 1234/11 123.4) 1.0)
+(num-test (min 1.0 1234/11 1234) 1.0)
+(num-test (min 1.0 1234/11 1234/11) 1.0)
+(num-test (min 1.0 1234/11) 1.0)
+(num-test (min 1.0) 1.0)
+(num-test (min 1.110223024625156799999999999999999999997E-16 -9223372036854775808) -9.223372036854775808E18)
+(num-test (min 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) 5.42101086242752217060000000000000000001E-20)
+(num-test (min 1/2 -1) -1)
+(num-test (min 1/2 1) 1/2)
+(num-test (min 1/46116860184273883 1/46116860184273879) 1/46116860184273883)
+(num-test (min 1/9223372036854775807 1/9223372036854775300) 1/9223372036854775807)
+(num-test (min 1/9223372036854775807 2/9223372036854775807) 1/9223372036854775807)
+(num-test (min 10) 10)
+(num-test (min 10/3) 10/3)
+(num-test (min 1010-0.i) 1010.0)
+(num-test (min 123.4 1 1) 1.0)
+(num-test (min 123.4 1 1.0) 1.0)
+(num-test (min 123.4 1 1/1) 1.0)
+(num-test (min 123.4 1 123.4) 1.0)
+(num-test (min 123.4 1 1234) 1.0)
+(num-test (min 123.4 1 1234/11) 1.0)
+(num-test (min 123.4 1) 1.0)
+(num-test (min 123.4 1.0 1) 1.0)
+(num-test (min 123.4 1.0 1.0) 1.0)
+(num-test (min 123.4 1.0 1/1) 1.0)
+(num-test (min 123.4 1.0 123.4) 1.0)
+(num-test (min 123.4 1.0 1234) 1.0)
+(num-test (min 123.4 1.0 1234/11) 1.0)
+(num-test (min 123.4 1.0) 1.0)
+(num-test (min 123.4 1/1) 1.0)
+(num-test (min 123.4 123.4 1) 1.0)
+(num-test (min 123.4 123.4 1.0) 1.0)
+(num-test (min 123.4 123.4 1/1) 1.0)
+(num-test (min 123.4 123.4 123.4) 123.4)
+(num-test (min 123.4 123.4 1234) 123.4)
+(num-test (min 123.4 123.4 1234/11) 112.18181818181819)
+(num-test (min 123.4 123.4) 123.4)
+(num-test (min 123.4 1234 1) 1.0)
+(num-test (min 123.4 1234 1.0) 1.0)
+(num-test (min 123.4 1234 1/1) 1.0)
+(num-test (min 123.4 1234 123.4) 123.4)
+(num-test (min 123.4 1234 1234) 123.4)
+(num-test (min 123.4 1234 1234/11) 112.18181818181819)
+(num-test (min 123.4 1234) 123.4)
+(num-test (min 123.4 1234/11 1) 1.0)
+(num-test (min 123.4 1234/11 1.0) 1.0)
+(num-test (min 123.4 1234/11 1/1) 1.0)
+(num-test (min 123.4 1234/11 123.4) 112.18181818181819)
+(num-test (min 123.4 1234/11 1234) 112.18181818181819)
+(num-test (min 123.4 1234/11 1234/11) 112.18181818181819)
+(num-test (min 123.4 1234/11) 112.18181818181819)
+(num-test (min 1234 1 1) 1)
+(num-test (min 1234 1 1.0) 1.0)
+(num-test (min 1234 1 1/1) 1)
+(num-test (min 1234 1 123.4) 1.0)
+(num-test (min 1234 1 1234) 1)
+(num-test (min 1234 1 1234/11) 1)
+(num-test (min 1234 1) 1)
+(num-test (min 1234 1.0 1) 1.0)
+(num-test (min 1234 1.0 1.0) 1.0)
+(num-test (min 1234 1.0 1/1) 1.0)
+(num-test (min 1234 1.0 123.4) 1.0)
+(num-test (min 1234 1.0 1234) 1.0)
+(num-test (min 1234 1.0 1234/11) 1.0)
+(num-test (min 1234 1.0) 1.0)
+(num-test (min 1234 1/1) 1)
+(num-test (min 1234 123.4 1) 1.0)
+(num-test (min 1234 123.4 1.0) 1.0)
+(num-test (min 1234 123.4 1/1) 1.0)
+(num-test (min 1234 123.4 123.4) 123.4)
+(num-test (min 1234 123.4 1234) 123.4)
+(num-test (min 1234 123.4 1234/11) 112.18181818181819)
+(num-test (min 1234 123.4) 123.4)
+(num-test (min 1234 1234 1) 1)
+(num-test (min 1234 1234 1.0) 1.0)
+(num-test (min 1234 1234 1/1) 1)
+(num-test (min 1234 1234 123.4) 123.4)
+(num-test (min 1234 1234 1234) 1234)
+(num-test (min 1234 1234 1234/11) 1234/11)
+(num-test (min 1234 1234) 1234)
+(num-test (min 1234 1234/11 1) 1)
+(num-test (min 1234 1234/11 1.0) 1.0)
+(num-test (min 1234 1234/11 1/1) 1)
+(num-test (min 1234 1234/11 123.4) 112.18181818181819)
+(num-test (min 1234 1234/11 1234) 1234/11)
+(num-test (min 1234 1234/11 1234/11) 1234/11)
+(num-test (min 1234 1234/11) 1234/11)
+(num-test (min 1234/11 1 1) 1)
+(num-test (min 1234/11 1 1.0) 1.0)
+(num-test (min 1234/11 1 1/1) 1)
+(num-test (min 1234/11 1 123.4) 1.0)
+(num-test (min 1234/11 1 1234) 1)
+(num-test (min 1234/11 1 1234/11) 1)
+(num-test (min 1234/11 1) 1)
+(num-test (min 1234/11 1.0 1) 1.0)
+(num-test (min 1234/11 1.0 1.0) 1.0)
+(num-test (min 1234/11 1.0 1/1) 1.0)
+(num-test (min 1234/11 1.0 123.4) 1.0)
+(num-test (min 1234/11 1.0 1234) 1.0)
+(num-test (min 1234/11 1.0 1234/11) 1.0)
+(num-test (min 1234/11 1.0) 1.0)
+(num-test (min 1234/11 1/1) 1)
+(num-test (min 1234/11 123.4 1) 1.0)
+(num-test (min 1234/11 123.4 1.0) 1.0)
+(num-test (min 1234/11 123.4 1/1) 1.0)
+(num-test (min 1234/11 123.4 123.4) 112.18181818181819)
+(num-test (min 1234/11 123.4 1234) 112.18181818181819)
+(num-test (min 1234/11 123.4 1234/11) 112.18181818181819)
+(num-test (min 1234/11 123.4) 112.18181818181819)
+(num-test (min 1234/11 1234 1) 1)
+(num-test (min 1234/11 1234 1.0) 1.0)
+(num-test (min 1234/11 1234 1/1) 1)
+(num-test (min 1234/11 1234 123.4) 112.18181818181819)
+(num-test (min 1234/11 1234 1234) 1234/11)
+(num-test (min 1234/11 1234 1234/11) 1234/11)
+(num-test (min 1234/11 1234) 1234/11)
+(num-test (min 1234/11 1234/11 1) 1)
+(num-test (min 1234/11 1234/11 1.0) 1.0)
+(num-test (min 1234/11 1234/11 1/1) 1)
+(num-test (min 1234/11 1234/11 123.4) 112.18181818181819)
+(num-test (min 1234/11 1234/11 1234) 1234/11)
+(num-test (min 1234/11 1234/11 1234/11) 1234/11)
+(num-test (min 1234/11 1234/11) 1234/11)
+(num-test (min 2 1+0i) 1.0)
+(num-test (min 2) 2)
+(num-test (min 2/2) 2/2)
+(num-test (min 2/9223372036854775807 1/9223372036854775807) 1/9223372036854775807)
+(num-test (min 3  5 5 330 4 -24) -24 )
+(num-test (min 3) 3)
+(num-test (min 3.0 7 1) 1.0)
+(num-test (min 3/2 -1/2) -1/2)
+(num-test (min 3/2 -6/5) -6/5)
+(num-test (min 3/2 1/2) 1/2)
+(num-test (min 3/2 6/5) 6/5)
+(num-test (min 5.0 2) 2.0)  ; why not 2?
+(num-test (min 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) 5.551115123125783999999999999999999999984E-17)
+(num-test (min 6 12) 6)
+(num-test (min 92233720368547758/9223372036854775807 92233720368547757/9223372036854775807) 92233720368547757/9223372036854775807)
+(num-test (min 9223372036854775807 -9223372036854775808) -9223372036854775808)
+
+(when with-bignums
+  (num-test (min 12345678901234567890 12345678901234567891) 12345678901234567890)
+  (num-test (min 2.168404344971008681816600431489558149231E-17 2.168404344971008869895696563055543437233E-17) 2.168404344971008681816600431489558149231E-17)
+  (num-test (min 2.168404344971008869895696563055543437233E-17 2.168404344971008681816600431489558149231E-17 ) 2.168404344971008681816600431489558149231E-17)
+  (num-test (min 2.168404344971008681816600431489558149231E-17 1/46116860184273879) 2.168404344971008681816600431489558149231E-17)
+  (num-test (min 1/46116860184273883 2.168404344971008869895696563055543437233E-17) 2.168404344971008681816600431489558149231E-17)
+
+  (num-test (let ((n (list 2.0 (bignum "3")))) (eval `(let () (define (f1) (min ,@n)) (f1)))) 2.0)
+  (num-test (let ((n (list 2.0 (bignum "0")))) (eval `(let () (define (f1) (min ,@n)) (f1)))) 0)
+  (num-test (let ((n (list 2.0 (bignum "3")))) (eval `(let () (define (f1) (max ,@n)) (f1)))) 3)
+  (num-test (let ((n (list 2.0 (bignum "0")))) (eval `(let () (define (f1) (max ,@n)) (f1)))) 2.0))
+
+(test (min 92233720368547758/5 18446744073709552.0) 92233720368547758/5)
+(test (max 92233720368547758/5 18446744073709552.0) 18446744073709552.0)
+(test (min 92233720368547758/5 18446744073709551) 18446744073709551)
+(test (max 92233720368547758/5 18446744073709551) 92233720368547758/5)
+
+(test (min 1.23+1.0i) 'error)
+(test (min) 'error)
+(test (min 1.0+1.0i) 'error)
+(test (min 0.0+0.00000001i) 'error)
+(test (min -0.0+0.00000001i) 'error)
+(test (min -1.0+1.0i) 'error)
+(test (min +nan.0 1+i) 'error)
+(test (min +nan.0 1 1+i) 'error)
+(test (min 1 +nan.0 2 1+i) 'error)
+(test (min +inf.0 1+i) 'error)
+(test (min +inf.0 +nan.0 0-i 1) 'error)
+(test (min 3441313796169221281/1720656898084610641 2.0) 3441313796169221281/1720656898084610641)
+(test (max 3441313796169221281/1720656898084610641 2.0) 2.0)
+
+(test (nan? (min 3/4 1/0)) #t)
+(test (nan? (min 3/4 +nan.0)) #t)
+(test (min 3/4 +nan.0 #\a) 'error)
+(num-test (min 1 +nan.0) +nan.0)
+(num-test (min +nan.0 1) +nan.0)
+(num-test (min 1.0 +nan.0) +nan.0)
+(num-test (min +nan.0 1.0) +nan.0)
+(num-test (min 1 1.0) 1) ; (eqv? (min 1 1.0) 1): #t etc
+(num-test (min 1.0 1) 1.0)
+
+(for-each
+ (lambda (arg)
+   (test (min arg +nan.0) 'error)
+   (test (min +nan.0 arg) 'error)
+   (test (min arg +inf.0) 'error)
+   (test (min +inf.0 arg) 'error)
+   (test (min 0 arg) 'error)
+   (test (min 0.0 arg) 'error)
+   (test (min 1/2 arg) 'error)
+   (test (min 1+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(test (catch #t (lambda () (min 1 +nan.0 #f)) (lambda (type info) (apply format #f info))) "min second argument, #f, is boolean but should be a real")
+
+
+;;; --------------------------------------------------------------------------------
+;;; max
+;;; --------------------------------------------------------------------------------
+
+(num-test (max -0.0) 0.0)
+(num-test (max -1 -1/2) -1/2)
+(num-test (max -1/2 0) 0)
+(num-test (max -1/2 -1) -1/2)
+(num-test (max 0 -1/2) 0)
+(num-test (max -1 -1/2) -1/2)
+(num-test (max -1 1/2) 1/2)
+(num-test (max -1.0) -1.0)
+(num-test (max -1.797693134862315699999999999999999999998E308 -9223372036854775808) -9.223372036854775808E18)
+(num-test (max -1/2 -1) -1/2)
+(num-test (max -1/2 1) 1)
+(num-test (max -10) -10)
+(num-test (max -10/3) -10/3)
+(num-test (max -2 3 0 7) 7)
+(num-test (max -2) -2)
+(num-test (max -2/2) -2/2)
+(num-test (max -3/2 -1/2) -1/2)
+(num-test (max -3/2 -6/5) -6/5)
+(num-test (max -3/2 1/2) 1/2)
+(num-test (max -3/2 6/5) 6/5)
+(num-test (max -6 -12) -6)
+(num-test (max -9223372036854775808 -9223372036854775808) -9223372036854775808)
+(num-test (max -9223372036854775808 5.551115123125783999999999999999999999984E-17) 5.551115123125783999999999999999999999984E-17)
+(num-test (max -9223372036854775808 9223372036854775807 -9223372036854775808) 9223372036854775807)
+(num-test (max 0 1 1) 1)
+(num-test (max 0 1 1.0) 1.0)
+(num-test (max 0 1 1/1) 1)
+(num-test (max 0 1 123.4) 123.4)
+(num-test (max 0 1 1234) 1234)
+(num-test (max 0 1 1234/11) 1234/11)
+(num-test (max 0 1) 1)
+(num-test (max 0 1.0 1) 1.0)
+(num-test (max 0 1.0 1.0) 1.0)
+(num-test (max 0 1.0 1/1) 1.0)
+(num-test (max 0 1.0 123.4) 123.4)
+(num-test (max 0 1.0 1234) 1234.0)
+(num-test (max 0 1.0 1234/11) 112.18181818181819)
+(num-test (max 0 1.0) 1.0)
+(num-test (max 0 1/1) 1)
+(num-test (max 0 123.4 1) 123.4)
+(num-test (max 0 123.4 1.0) 123.4)
+(num-test (max 0 123.4 1/1) 123.4)
+(num-test (max 0 123.4 123.4) 123.4)
+(num-test (max 0 123.4 1234) 1234.0)
+(num-test (max 0 123.4 1234/11) 123.4)
+(num-test (max 0 123.4) 123.4)
+(num-test (max 0 1234 1) 1234)
+(num-test (max 0 1234 1.0) 1234.0)
+(num-test (max 0 1234 1/1) 1234)
+(num-test (max 0 1234 123.4) 1234.0)
+(num-test (max 0 1234 1234) 1234)
+(num-test (max 0 1234 1234/11) 1234)
+(num-test (max 0 1234) 1234)
+(num-test (max 0 1234/11 1) 1234/11)
+(num-test (max 0 1234/11 1.0) 112.18181818181819)
+(num-test (max 0 1234/11 1/1) 1234/11)
+(num-test (max 0 1234/11 123.4) 123.4)
+(num-test (max 0 1234/11 1234) 1234)
+(num-test (max 0 1234/11 1234/11) 1234/11)
+(num-test (max 0 1234/11) 1234/11)
+(num-test (max 0) 0)
+(num-test (max 0.0 1 1) 1.0)
+(num-test (max 0.0 1 1.0) 1.0)
+(num-test (max 0.0 1 1/1) 1.0)
+(num-test (max 0.0 1 123.4) 123.4)
+(num-test (max 0.0 1 1234) 1234.0)
+(num-test (max 0.0 1 1234/11) 112.18181818181819)
+(num-test (max 0.0 1) 1.0)
+(num-test (max 0.0 1.0 1) 1.0)
+(num-test (max 0.0 1.0 1.0) 1.0)
+(num-test (max 0.0 1.0 1/1) 1.0)
+(num-test (max 0.0 1.0 123.4) 123.4)
+(num-test (max 0.0 1.0 1234) 1234.0)
+(num-test (max 0.0 1.0 1234/11) 112.18181818181819)
+(num-test (max 0.0 1.0) 1.0)
+(num-test (max 0.0 1/1) 1.0)
+(num-test (max 0.0 123.4 1) 123.4)
+(num-test (max 0.0 123.4 1.0) 123.4)
+(num-test (max 0.0 123.4 1/1) 123.4)
+(num-test (max 0.0 123.4 123.4) 123.4)
+(num-test (max 0.0 123.4 1234) 1234.0)
+(num-test (max 0.0 123.4 1234/11) 123.4)
+(num-test (max 0.0 123.4) 123.4)
+(num-test (max 0.0 1234 1) 1234.0)
+(num-test (max 0.0 1234 1.0) 1234.0)
+(num-test (max 0.0 1234 1/1) 1234.0)
+(num-test (max 0.0 1234 123.4) 1234.0)
+(num-test (max 0.0 1234 1234) 1234.0)
+(num-test (max 0.0 1234 1234/11) 1234.0)
+(num-test (max 0.0 1234) 1234.0)
+(num-test (max 0.0 1234/11 1) 112.18181818181819)
+(num-test (max 0.0 1234/11 1.0) 112.18181818181819)
+(num-test (max 0.0 1234/11 1/1) 112.18181818181819)
+(num-test (max 0.0 1234/11 123.4) 123.4)
+(num-test (max 0.0 1234/11 1234) 1234.0)
+(num-test (max 0.0 1234/11 1234/11) 112.18181818181819)
+(num-test (max 0.0 1234/11) 112.18181818181819)
+(num-test (max 0.0) 0.0)
+(num-test (max 0/1) 0/1)
+(num-test (max 1 -1/2) 1)
+(num-test (max 1 1 1) 1)
+(num-test (max 1 1 1.0) 1.0)
+(num-test (max 1 1 1/1) 1)
+(num-test (max 1 1 123.4) 123.4)
+(num-test (max 1 1 1234) 1234)
+(num-test (max 1 1 1234/11) 1234/11)
+(num-test (max 1 1) 1)
+(num-test (max 1 1.0 1) 1.0)
+(num-test (max 1 1.0 1.0) 1.0)
+(num-test (max 1 1.0 1/1) 1.0)
+(num-test (max 1 1.0 123.4) 123.4)
+(num-test (max 1 1.0 1234) 1234.0)
+(num-test (max 1 1.0 1234/11) 112.18181818181819)
+(num-test (max 1 1.0) 1.0)
+(num-test (max 1 1/1) 1)
+(num-test (max 1 1/2) 1)
+(num-test (max 1 123.4 1) 123.4)
+(num-test (max 1 123.4 1.0) 123.4)
+(num-test (max 1 123.4 1/1) 123.4)
+(num-test (max 1 123.4 123.4) 123.4)
+(num-test (max 1 123.4 1234) 1234.0)
+(num-test (max 1 123.4 1234/11) 123.4)
+(num-test (max 1 123.4) 123.4)
+(num-test (max 1 1234 1) 1234)
+(num-test (max 1 1234 1.0) 1234.0)
+(num-test (max 1 1234 1/1) 1234)
+(num-test (max 1 1234 123.4) 1234.0)
+(num-test (max 1 1234 1234) 1234)
+(num-test (max 1 1234 1234/11) 1234)
+(num-test (max 1 1234) 1234)
+(num-test (max 1 1234/11 1) 1234/11)
+(num-test (max 1 1234/11 1.0) 112.18181818181819)
+(num-test (max 1 1234/11 1/1) 1234/11)
+(num-test (max 1 1234/11 123.4) 123.4)
+(num-test (max 1 1234/11 1234) 1234)
+(num-test (max 1 1234/11 1234/11) 1234/11)
+(num-test (max 1 1234/11) 1234/11)
+(num-test (max 1 3 2 -7) 3)
+(num-test (max 1.0 1 1) 1.0)
+(num-test (max 1.0 1 1.0) 1.0)
+(num-test (max 1.0 1 1/1) 1.0)
+(num-test (max 1.0 1 123.4) 123.4)
+(num-test (max 1.0 1 1234) 1234.0)
+(num-test (max 1.0 1 1234/11) 112.18181818181819)
+(num-test (max 1.0 1) 1.0)
+(num-test (max 1.0 1.0 1) 1.0)
+(num-test (max 1.0 1.0 1.0) 1.0)
+(num-test (max 1.0 1.0 1/1) 1.0)
+(num-test (max 1.0 1.0 123.4) 123.4)
+(num-test (max 1.0 1.0 1234) 1234.0)
+(num-test (max 1.0 1.0 1234/11) 112.18181818181819)
+(num-test (max 1.0 1.0) 1.0)
+(num-test (max 1.0 1/1) 1.0)
+(num-test (max 1.0 123.4 1) 123.4)
+(num-test (max 1.0 123.4 1.0) 123.4)
+(num-test (max 1.0 123.4 1/1) 123.4)
+(num-test (max 1.0 123.4 123.4) 123.4)
+(num-test (max 1.0 123.4 1234) 1234.0)
+(num-test (max 1.0 123.4 1234/11) 123.4)
+(num-test (max 1.0 123.4) 123.4)
+(num-test (max 1.0 1234 1) 1234.0)
+(num-test (max 1.0 1234 1.0) 1234.0)
+(num-test (max 1.0 1234 1/1) 1234.0)
+(num-test (max 1.0 1234 123.4) 1234.0)
+(num-test (max 1.0 1234 1234) 1234.0)
+(num-test (max 1.0 1234 1234/11) 1234.0)
+(num-test (max 1.0 1234) 1234.0)
+(num-test (max 1.0 1234/11 1) 112.18181818181819)
+(num-test (max 1.0 1234/11 1.0) 112.18181818181819)
+(num-test (max 1.0 1234/11 1/1) 112.18181818181819)
+(num-test (max 1.0 1234/11 123.4) 123.4)
+(num-test (max 1.0 1234/11 1234) 1234.0)
+(num-test (max 1.0 1234/11 1234/11) 112.18181818181819)
+(num-test (max 1.0 1234/11) 112.18181818181819)
+(num-test (max 1.0) 1.0)
+(num-test (max 1.110223024625156799999999999999999999997E-16 -9223372036854775808) 1.110223024625156799999999999999999999997E-16)
+(num-test (max 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) 1.110223024625156799999999999999999999997E-16)
+(num-test (max 1/2 -1) 1/2)
+(num-test (max 1/2 1) 1)
+(num-test (max 1/461168601842738841 1/461168601842738790) 1/461168601842738790)
+(num-test (max 1/4611686018427388416 1/4611686018427387904) 1/4611686018427387904)
+(num-test (max 1/461168601842738848 1/461168601842738790) 1/461168601842738790)
+(num-test (max 1/9223372036854775300 1/9223372036854775807) 1/9223372036854775300)
+(num-test (max 1/9223372036854775807 1/9223372036854775300) 1/9223372036854775300)
+(num-test (max 1/9223372036854775807 1/9223372036854775806) 1/9223372036854775806)
+(num-test (max 1/9223372036854775807 2/9223372036854775807) 2/9223372036854775807)
+(num-test (max 10) 10)
+(num-test (max 10/3) 10/3)
+(num-test (max 123.4 1 1) 123.4)
+(num-test (max 123.4 1 1.0) 123.4)
+(num-test (max 123.4 1 1/1) 123.4)
+(num-test (max 123.4 1 123.4) 123.4)
+(num-test (max 123.4 1 1234) 1234.0)
+(num-test (max 123.4 1 1234/11) 123.4)
+(num-test (max 123.4 1) 123.4)
+(num-test (max 123.4 1.0 1) 123.4)
+(num-test (max 123.4 1.0 1.0) 123.4)
+(num-test (max 123.4 1.0 1/1) 123.4)
+(num-test (max 123.4 1.0 123.4) 123.4)
+(num-test (max 123.4 1.0 1234) 1234.0)
+(num-test (max 123.4 1.0 1234/11) 123.4)
+(num-test (max 123.4 1.0) 123.4)
+(num-test (max 123.4 1/1) 123.4)
+(num-test (max 123.4 123.4 1) 123.4)
+(num-test (max 123.4 123.4 1.0) 123.4)
+(num-test (max 123.4 123.4 1/1) 123.4)
+(num-test (max 123.4 123.4 123.4) 123.4)
+(num-test (max 123.4 123.4 1234) 1234.0)
+(num-test (max 123.4 123.4 1234/11) 123.4)
+(num-test (max 123.4 123.4) 123.4)
+(num-test (max 123.4 1234 1) 1234.0)
+(num-test (max 123.4 1234 1.0) 1234.0)
+(num-test (max 123.4 1234 1/1) 1234.0)
+(num-test (max 123.4 1234 123.4) 1234.0)
+(num-test (max 123.4 1234 1234) 1234.0)
+(num-test (max 123.4 1234 1234/11) 1234.0)
+(num-test (max 123.4 1234) 1234.0)
+(num-test (max 123.4 1234/11 1) 123.4)
+(num-test (max 123.4 1234/11 1.0) 123.4)
+(num-test (max 123.4 1234/11 1/1) 123.4)
+(num-test (max 123.4 1234/11 123.4) 123.4)
+(num-test (max 123.4 1234/11 1234) 1234.0)
+(num-test (max 123.4 1234/11 1234/11) 123.4)
+(num-test (max 123.4 1234/11) 123.4)
+(num-test (max 1234 1 1) 1234)
+(num-test (max 1234 1 1.0) 1234.0)
+(num-test (max 1234 1 1/1) 1234)
+(num-test (max 1234 1 123.4) 1234.0)
+(num-test (max 1234 1 1234) 1234)
+(num-test (max 1234 1 1234/11) 1234)
+(num-test (max 1234 1) 1234)
+(num-test (max 1234 1.0 1) 1234.0)
+(num-test (max 1234 1.0 1.0) 1234.0)
+(num-test (max 1234 1.0 1/1) 1234.0)
+(num-test (max 1234 1.0 123.4) 1234.0)
+(num-test (max 1234 1.0 1234) 1234.0)
+(num-test (max 1234 1.0 1234/11) 1234.0)
+(num-test (max 1234 1.0) 1234.0)
+(num-test (max 1234 1/1) 1234)
+(num-test (max 1234 123.4 1) 1234.0)
+(num-test (max 1234 123.4 1.0) 1234.0)
+(num-test (max 1234 123.4 1/1) 1234.0)
+(num-test (max 1234 123.4 123.4) 1234.0)
+(num-test (max 1234 123.4 1234) 1234.0)
+(num-test (max 1234 123.4 1234/11) 1234.0)
+(num-test (max 1234 123.4) 1234.0)
+(num-test (max 1234 1234 1) 1234)
+(num-test (max 1234 1234 1.0) 1234.0)
+(num-test (max 1234 1234 1/1) 1234)
+(num-test (max 1234 1234 123.4) 1234.0)
+(num-test (max 1234 1234 1234) 1234)
+(num-test (max 1234 1234 1234/11) 1234)
+(num-test (max 1234 1234) 1234)
+(num-test (max 1234 1234/11 1) 1234)
+(num-test (max 1234 1234/11 1.0) 1234.0)
+(num-test (max 1234 1234/11 1/1) 1234)
+(num-test (max 1234 1234/11 123.4) 1234.0)
+(num-test (max 1234 1234/11 1234) 1234)
+(num-test (max 1234 1234/11 1234/11) 1234)
+(num-test (max 1234 1234/11) 1234)
+(num-test (max 1234/11 1 1) 1234/11)
+(num-test (max 1234/11 1 1.0) 112.18181818181819)
+(num-test (max 1234/11 1 1/1) 1234/11)
+(num-test (max 1234/11 1 123.4) 123.4)
+(num-test (max 1234/11 1 1234) 1234)
+(num-test (max 1234/11 1 1234/11) 1234/11)
+(num-test (max 1234/11 1) 1234/11)
+(num-test (max 1234/11 1.0 1) 112.18181818181819)
+(num-test (max 1234/11 1.0 1.0) 112.18181818181819)
+(num-test (max 1234/11 1.0 1/1) 112.18181818181819)
+(num-test (max 1234/11 1.0 123.4) 123.4)
+(num-test (max 1234/11 1.0 1234) 1234.0)
+(num-test (max 1234/11 1.0 1234/11) 112.18181818181819)
+(num-test (max 1234/11 1.0) 112.18181818181819)
+(num-test (max 1234/11 1/1) 1234/11)
+(num-test (max 1234/11 123.4 1) 123.4)
+(num-test (max 1234/11 123.4 1.0) 123.4)
+(num-test (max 1234/11 123.4 1/1) 123.4)
+(num-test (max 1234/11 123.4 123.4) 123.4)
+(num-test (max 1234/11 123.4 1234) 1234.0)
+(num-test (max 1234/11 123.4 1234/11) 123.4)
+(num-test (max 1234/11 123.4) 123.4)
+(num-test (max 1234/11 1234 1) 1234)
+(num-test (max 1234/11 1234 1.0) 1234.0)
+(num-test (max 1234/11 1234 1/1) 1234)
+(num-test (max 1234/11 1234 123.4) 1234.0)
+(num-test (max 1234/11 1234 1234) 1234)
+(num-test (max 1234/11 1234 1234/11) 1234)
+(num-test (max 1234/11 1234) 1234)
+(num-test (max 1234/11 1234/11 1) 1234/11)
+(num-test (max 1234/11 1234/11 1.0) 112.18181818181819)
+(num-test (max 1234/11 1234/11 1/1) 1234/11)
+(num-test (max 1234/11 1234/11 123.4) 123.4)
+(num-test (max 1234/11 1234/11 1234) 1234)
+(num-test (max 1234/11 1234/11 1234/11) 1234/11)
+(num-test (max 1234/11 1234/11) 1234/11)
+(num-test (max 1e+16 9223372036854775807 1e+17) 9223372036854775807)
+(num-test (max 2 1+0i) 2)
+(num-test (max 2) 2)
+(num-test (max 2/2) 2/2)
+(num-test (max 2/9223372036854775807 1/9223372036854775807) 2/9223372036854775807)
+(num-test (max 3) 3)
+(num-test (max 3.0 7 1) 7.0)
+(num-test (max 3/2 -1/2) 3/2)
+(num-test (max 3/2 -6/5) 3/2)
+(num-test (max 3/2 1/2) 3/2)
+(num-test (max 3/2 6/5) 3/2)
+(num-test (max 34 5 7 38 6) 38 )
+(num-test (max 5.0 2) 5.0)
+(num-test (max 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) 1.110223024625156799999999999999999999997E-16)
+(num-test (max 6 12) 12)
+(num-test (max 92233720368547758/9223372036854775807 92233720368547757/9223372036854775807) 13176245766935394/1317624576693539401)
+(num-test (max 9223372036854775805/9223372036854775807 9223372036854775806/9223372036854775807) 9223372036854775806/9223372036854775807)
+(num-test (max 9223372036854775806/9223372036854775807 9223372036854775805/9223372036854775807) 9223372036854775806/9223372036854775807)
+(num-test (max 9223372036854775807 -9223372036854775808) 9223372036854775807)
+
+(num-test (max 92233720368547757/9223372036854775807 92233720368547758/9223372036854775807) 13176245766935394/1317624576693539401)
+;; after reduction this is 13176245766935394/1317624576693539401 and 92233720368547757/9223372036854775807 ->
+;; 9.999999999999999992410584792601468961145E-3
+;; 9.999999999999999883990367544051025548645E-3
+;; but in doubles-land, they're exactly the same, so we have to hope long doubles work in the non-gmp case
+
+(num-test (max 9223372036854776/9223372036854775807 9223372036854775/9223372036854775807) 9223372036854776/9223372036854775807)
+(num-test (max 9223372036854776/9223372036854775807 9223372036854775/922337203685477500) 1/100)
+(num-test (max 9223372036854775/922337203685477500 9223372036854776/9223372036854775807) 1/100)
+(num-test (max 9223372036854776/9223372036854775807 9223372036854775/9223372036854774806) 9223372036854775/9223372036854774806)
+(num-test (max 9223372036854775/9223372036854774806 9223372036854776/9223372036854775807) 9223372036854775/9223372036854774806)
+(num-test (max 9223372036854776/9223372036854775807 9223372036854775/9223372036854775000) 9223372036854776/9223372036854775807)
+;; mpfr says the first fraction is 1.000000000000000020925101928970235578612E-3
+(num-test (max 1e18 most-positive-fixnum) most-positive-fixnum) ; in bignum case there's type confusion here I think (hence num-test)
+
+(let ()
+  (define (f) ; opt_d_7dd_ff and opt_d_dd_ff
+    (let ((sum 0.0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) sum)
+        (set! sum (/ (+ sum 2.0) (max (* 2.0 sum) (+ sum 1.0)))))))
+  (num-test (f) 1.5))
+
+(test (max) 'error)
+(test (max 1.23+1.0i) 'error)
+(test (max -0.0+0.00000001i) 'error)
+(test (max -1.0+1.0i) 'error)
+(test (max 0.0+0.00000001i) 'error)
+(test (max 1.0+1.0i) 'error)
+(test (max +nan.0 1+i) 'error)
+(test (max +nan.0 1 1+i) 'error)
+(test (max 1 +nan.0 2 1+i) 'error)
+(test (max +inf.0 1+i) 'error)
+(test (max +inf.0 +nan.0 0-i 1) 'error)
+
+(test (nan? (max 3/4 1/0)) #t)
+(test (nan? (max 3/4 +nan.0)) #t)
+(test (max 3/4 +nan.0 #\a) 'error)
+;; s7 and Guile say (max -nan.0 -nan.0) -> +nan.0
+
+(num-test (max 1 +nan.0) +nan.0)
+(num-test (max +nan.0 1) +nan.0)
+(num-test (max 1.0 +nan.0) +nan.0)
+(num-test (max +nan.0 1.0) +nan.0)
+(num-test (max 1 1.0) 1)
+(num-test (max 1.0 1) 1.0)
+
+(for-each
+ (lambda (arg)
+   (test (max arg +nan.0) 'error)
+   (test (max +nan.0 arg) 'error)
+   (test (max arg +inf.0) 'error)
+   (test (max +inf.0 arg) 'error)
+   (test (max 0 arg) 'error)
+   (test (max 0.0 arg) 'error)
+   (test (max 1/2 arg) 'error)
+   (test (max 0+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(let ((top-exp 60))
+  (let ((happy #t))
+    (do ((i 2 (+ i 1)))
+	((or (not happy) (> i top-exp)))
+      (let* ((val1 (+ 2 (expt 2 i)))
+	     (val2 (- val1 1)))
+	(if (not (= val1 (max val1 val2)))
+	    (begin (set! happy #f) (display "(max ") (display val1) (display " ") (display val2) (display ") -> ") (display (max val1 val2)) (display "?") (newline)))
+	(if (not (= val2 (min val1 val2)))
+	    (begin (set! happy #f) (display "(min ") (display val1) (display " ") (display val2) (display ") -> ") (display (min val1 val2)) (display "?") (newline))))))
+
+  (let ((happy #t))
+    (do ((i 2 (+ i 1)))
+	((or (not happy) (> i top-exp)))
+      (let* ((val1 (/ (expt 2 i) 3))
+	     (val2 (/ (+ 1 (expt 2 i)) 3)))
+	(if (not (= val2 (max val1 val2)))
+	    (begin (set! happy #f) (display "(max ") (display val1) (display " ") (display val2) (display ") -> ") (display (max val1 val2)) (display "?") (newline)))
+	(if (not (= val2 (max val2 val1)))
+	    (begin (set! happy #f) (display "(max ") (display val1) (display " ") (display val2) (display ") -> ") (display (max val2 val1)) (display "?") (newline)))
+	(if (not (= val1 (min val1 val2)))
+	    (begin (set! happy #f) (display "(min ") (display val1) (display " ") (display val2) (display ") -> ") (display (min val1 val2)) (display "?") (newline)))
+	(if (not (= val1 (min val2 val1)))
+	    (begin (set! happy #f) (display "(min ") (display val1) (display " ") (display val2) (display ") -> ") (display (min val2 val1)) (display "?") (newline)))
+	))))
+
+(let ()
+  (define (tmin . args)
+    (let ((val (apply min args)))
+      (if (number? val)
+	  (for-each
+	   (lambda (arg)
+	     (if (< arg val)
+		 (format *stderr* "(min ~{~^~A ~}) -> ~A~%" args val)))
+	   args))
+      val))
+
+  (define (tmax . args)
+    (let ((val (apply max args)))
+      (if (number? val)
+	  (for-each
+	   (lambda (arg)
+	     (if (> arg val)
+		 (format *stderr* "(max ~{~^~A ~}) -> ~A~%" args val)))
+	   args))
+      val))
+
+  (do ((i 0 (+ i 1)))
+      ((= i 10))
+    (tmin (- (random 10) 5) (- (random 99/100) 49/100))
+    (tmax (- (random 10) 5) (- (random 99/100) 49/100))
+    (tmin (- (random 99/100) 49/100) (- (random 10) 5))
+    (tmax (- (random 99/100) 49/100) (- (random 10) 5))
+    (tmin (- (random 10) 5) 0)
+    (tmax (- (random 10) 5) 0)
+    (tmin (- (random 99/100) 49/100) 0)
+    (tmax (- (random 99/100) 49/100) 0)
+    (tmin 0 (- (random 10) 5))
+    (tmax 0 (- (random 10) 5))
+    (tmin 0 (- (random 99/100) 49/100))
+    (tmax 0 (- (random 99/100) 49/100))
+
+    (tmin (- (random 10) 5) 1)
+    (tmax (- (random 10) 5) 1)
+    (tmin (- (random 99/100) 49/100) 1)
+    (tmax (- (random 99/100) 49/100) 1)
+    (tmin 1 (- (random 10) 5))
+    (tmax 1 (- (random 10) 5))
+    (tmin 1 (- (random 99/100) 49/100))
+    (tmax 1 (- (random 99/100) 49/100))
+
+    (tmin (- (random 10) 5) -1/4)
+    (tmax (- (random 10) 5) -1/4)
+    (tmin (- (random 99/100) 49/100) -1/4)
+    (tmax (- (random 99/100) 49/100) -1/4)
+    (tmin -3/4 (- (random 10) 5))
+    (tmax -3/4 (- (random 10) 5))
+    (tmin -3/4 (- (random 99/100) 49/100))
+    (tmax -3/4 (- (random 99/100) 49/100))
+
+    (tmin (- (random 299/100) 149/100) (- (random 199/100) 1))
+    (tmax (- (random 299/100) 149/100) (- (random 199/100) 1))
+    (tmin 0 (- (random 10) 5) (- (random 99/100) 49/100))
+    (tmax 0 (- (random 10) 5) (- (random 99/100) 49/100))
+    (tmin 0 (- (random 99/100) 49/100) (- (random 10) 5))
+    (tmax 0 (- (random 99/100) 49/100) (- (random 10) 5))
+    (tmin (- (random 10) 5) -1/2)
+    (tmax (- (random 10) 5) -1/2)
+    (tmin (- (random 99/100) 49/100) -1/2)
+    (tmax (- (random 99/100) 49/100) -1/2)
+    (tmin -1/2 (- (random 10) 5))
+    (tmax -1/2 (- (random 10) 5))
+    (tmin -1/2 (- (random 99/100) 49/100))
+    (tmax -1/2 (- (random 99/100) 49/100))))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; <
+;;; --------------------------------------------------------------------------------
+
+(test (< 0 1 1) #f)
+(test (< 0 1 1.0) #f)
+(test (< 0 1 1/1) #f)
+(test (< 0 1 123.4) #t)
+(test (< 0 1 1234) #t)
+(test (< 0 1 1234/11) #t)
+(test (< 0 1) #t)
+(test (< 0 1.0 1) #f)
+(test (< 0 1.0 1.0) #f)
+(test (< 0 1.0 1/1) #f)
+(test (< 0 1.0 123.4) #t)
+(test (< 0 1.0 1234) #t)
+(test (< 0 1.0 1234/11) #t)
+(test (< 0 1.0) #t)
+(test (< 0 123.4) #t)
+(test (< 0 1234) #t)
+(test (< 0 1234/11) #t)
+(test (< 0.0 1 1.0) #f)
+(test (< 0.0 1 1/1) #f)
+(test (< 0.0 1 123.4) #t)
+(test (< 0.0 1 1234) #t)
+(test (< 0.0 1 1234/11) #t)
+(test (< 0.0 1) #t)
+(test (< 0.0 1.0 1) #f)
+(test (< 0.0 1.0 1.0) #f)
+(test (< 0.0 1.0 1/1) #f)
+(test (< 0.0 1.0 123.4) #t)
+(test (< 0.0 1.0 1234) #t)
+(test (< 0.0 1.0 1234/11) #t)
+(test (< 0.0 1.0) #t)
+(test (< 0.0 123.4 1) #f)
+(test (< 0.0 123.4 1.0) #f)
+(test (< 0.0 123.4 1/1) #f)
+(test (< 0.0 123.4 123.4) #f)
+(test (< 0.0 123.4 1234) #t)
+(test (< 0.0 123.4 1234/11) #f)
+(test (< 0.0 123.4) #t)
+(test (< 0.0 1234 1) #f)
+(test (< 0.0 1234 1.0) #f)
+(test (< 0.0 1234 1/1) #f)
+(test (< 0.0 1234 123.4) #f)
+(test (< 0.0 1234 1234) #f)
+(test (< 0.0 1234 1234/11) #f)
+(test (< 0.0 1234) #t)
+(test (< 0.0 1234/11 1) #f)
+(test (< 0.0 1234/11 1.0) #f)
+(test (< 0.0 1234/11 1/1) #f)
+(test (< 0.0 1234/11 123.4) #t)
+(test (< 0.0 1234/11 1234) #t)
+(test (< 0.0 1234/11 1234/11) #f)
+(test (< 0.0 1234/11) #t)
+(test (< 1 1 1) #f)
+(test (< 1 1 1.0) #f)
+(test (< 1 1 1/1) #f)
+(test (< 1 1 123.4) #f)
+(test (< 1 1 1234) #f)
+(test (< 1 1 1234/11) #f)
+(test (< 1 1) #f)
+(test (< 1 1.0 1) #f)
+(test (< 1 1.0 1.0) #f)
+(test (< 1 1.0 1/1) #f)
+(test (< 1 1.0 123.4) #f)
+(test (< 1 1.0 1234) #f)
+(test (< 1 1.0 1234/11) #f)
+(test (< 1 1.0) #f)
+(test (< 1 1/1) #f)
+(test (< 1 123.4) #t)
+(test (< 1 1234) #t)
+(test (< 1 1234/11) #t)
+(test (< 1.0 1 1) #f)
+(test (< 1.0 1 1.0) #f)
+(test (< 1.0 1 1/1) #f)
+(test (< 1.0 1 123.4) #f)
+(test (< 1.0 1 1234) #f)
+(test (< 1.0 1 1234/11) #f)
+(test (< 1.0 1) #f)
+(test (< 1.0 1.0 1) #f)
+(test (< 1.0 1.0 1.0) #f)
+(test (< 1.0 1.0 1/1) #f)
+(test (< 1.0 1.0 123.4) #f)
+(test (< 1.0 1.0 1234) #f)
+(test (< 1.0 1.0 1234/11) #f)
+(test (< 1.0 1.0) #f)
+(test (< 1.0 123.4 1) #f)
+(test (< 1.0 123.4 1.0) #f)
+(test (< 1.0 123.4 1/1) #f)
+(test (< 1.0 123.4 123.4) #f)
+(test (< 1.0 123.4 1234) #t)
+(test (< 1.0 123.4 1234/11) #f)
+(test (< 1.0 123.4) #t)
+(test (< 1.0 1234 1) #f)
+(test (< 1.0 1234 1.0) #f)
+(test (< 1.0 1234 1/1) #f)
+(test (< 1.0 1234 123.4) #f)
+(test (< 1.0 1234 1234) #f)
+(test (< 1.0 1234 1234/11) #f)
+(test (< 1.0 1234) #t)
+(test (< 1.0 1234/11 1) #f)
+(test (< 1.0 1234/11 1.0) #f)
+(test (< 1.0 1234/11 1/1) #f)
+(test (< 1.0 1234/11 123.4) #t)
+(test (< 1.0 1234/11 1234) #t)
+(test (< 1.0 1234/11 1234/11) #f)
+(test (< 1.0 1234/11) #t)
+(test (< 123.4 1 1) #f)
+(test (< 123.4 1 1.0) #f)
+(test (< 123.4 1 1/1) #f)
+(test (< 123.4 1 123.4) #f)
+(test (< 123.4 1 1234) #f)
+(test (< 123.4 1 1234/11) #f)
+(test (< 123.4 1) #f)
+(test (< 123.4 1.0 1) #f)
+(test (< 123.4 1.0 1.0) #f)
+(test (< 123.4 1.0 1/1) #f)
+(test (< 123.4 1.0 123.4) #f)
+(test (< 123.4 1.0 1234) #f)
+(test (< 123.4 1.0 1234/11) #f)
+(test (< 123.4 1.0) #f)
+(test (< 123.4 123.4 1) #f)
+(test (< 123.4 123.4 1.0) #f)
+(test (< 123.4 123.4 1/1) #f)
+(test (< 123.4 123.4 123.4) #f)
+(test (< 123.4 123.4 1234) #f)
+(test (< 123.4 123.4 1234/11) #f)
+(test (< 123.4 123.4) #f)
+(test (< 123.4 1234 1) #f)
+(test (< 123.4 1234 1.0) #f)
+(test (< 123.4 1234 1/1) #f)
+(test (< 123.4 1234 123.4) #f)
+(test (< 123.4 1234 1234) #f)
+(test (< 123.4 1234 1234/11) #f)
+(test (< 123.4 1234) #t)
+(test (< 123.4 1234/11 1) #f)
+(test (< 123.4 1234/11 1.0) #f)
+(test (< 123.4 1234/11 1/1) #f)
+(test (< 123.4 1234/11 123.4) #f)
+(test (< 123.4 1234/11 1234) #f)
+(test (< 123.4 1234/11 1234/11) #f)
+(test (< 123.4 1234/11) #f)
+(test (< 1234 1) #f)
+(test (< 1234 1.0) #f)
+(test (< 1234 1/1) #f)
+(test (< 1234 123.4) #f)
+(test (< 1234 1234) #f)
+(test (< 1234 1234/11) #f)
+(test (< 1234/11 1) #f)
+(test (< 1234/11 1.0) #f)
+(test (< 1234/11 1/1) #f)
+(test (< 1234/11 123.4) #t)
+(test (< 1234/11 1234) #t)
+(test (< 1234/11 1234/11) #f)
+
+(test (< -0 0) #f)
+(test (< -0.0 0.0) #f)
+(test (< -1 2 3 4 4 5 6 7) #f)
+(test (< -1 2 3 4 5 6 7 8) #t)
+(test (< 0 -0) #f)
+(test (< 0.0 -0.0) #f)
+(test (< 1 0+i) 'error)
+(test (< 1 0-i) 'error)
+(test (< 1 1 2) #f)
+(test (< 1 3 2) #f)
+(test (< 1+i 0+i) 'error)
+(test (< 1+i 0-i) 'error)
+(test (< 2 1 #\a) 'error)
+(test (< +nan.0 1+i) 'error)
+(test (< +nan.0 1 1+i) 'error)
+(test (< 1 +nan.0 1+i) 'error)
+(test (< +inf.0 1+i) 'error)
+(test (< +inf.0 +nan.0 0-i 1) 'error)
+(test (< 2 1+0/2i) #f)
+(test (< 2 1+0i) #f)
+(test (< 2 1-0i) #f)
+(test (< -nan.0 0.0) #f)
+(test (> +nan.0 0.0) #f) ; NaN should be NaN or maybe nan, not these idiotic names
+
+(test (< -5 -4 -2 0 4 5) #t)
+(test (< 0 3 4 4 6) #f)
+(test (< 0 3 4 6 7) #t)
+(test (< 0) 'error)
+(test (<) 'error)
+(test (< 0.0) 'error)
+(test (< 0.0+0.00000001i) 'error)
+(test (< 0/1) 'error)
+(test (< 1.0) 'error)
+(test (< 1.0+1.0i) 'error)
+(test (< 10/3) 'error)
+(test (< 2 1 1.0+1.0i) 'error)
+(test (< 2) 'error)
+(test (< 3 -5) #f)
+(test (< 3 3) #f)
+(test (< 3 3.0 3 3.0+1.0i) 'error)
+(test (< 3 5) #t)
+(test (< 3.0 3) #f)
+
+(for-each
+ (lambda (arg)
+   (test (< arg +nan.0) 'error)
+   (test (< +nan.0 arg) 'error)
+   (test (< arg +inf.0) 'error)
+   (test (< +inf.0 arg) 'error)
+   (test (< 1 0 arg) 'error)
+   (test (< 1 arg) 'error)
+   (test (< 1.0 arg) 'error)
+   (test (< 1/2 arg) 'error)
+   (test (< arg 1) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(test (< -1/9223372036854775807 -1/9223372036854775806) #f)
+(test (< -10/3147483647 -40/12345678901) #f)
+(test (< -101/3147483647 40/12345678901) #t)
+(test (< -1047483646/11111111111111 -1234567890213/12345678901123123) #f)
+(test (< -1047483646/11111111111111 1234567890213/12345678901123123) #t)
+(test (< -11/3147483647 -40/12345678901) #t)
+(test (< -1282469252763/12824692526603504 -1234567890213/12345678901123123) #f)
+(test (< -1282469252763/12824692526603504 1234567890213/12345678901123123) #t)
+(test (< -1282469252765/12824692526603504 -1234567890213/12345678901123123) #t)
+(test (< -1282469252765/12824692526603504 1234567890213/12345678901123123) #t)
+(test (< -2/3 -3147483547123/4) #f)
+(test (< -2/3 3147483547123/4) #t)
+(test (< -2/3147483547 -3147483547/3) #f)
+(test (< -2/3147483547 3147483547/3) #t)
+(test (< -2147483646/11111111111111 -1234567890213/12345678901123123) #t)
+(test (< -2147483646/11111111111111 1234567890213/12345678901123123) #t)
+(test (< -3147483547/2 -3/3147483547) #t)
+(test (< -3147483547/2 -3147483547/3) #t)
+(test (< -3147483547/2 3/3147483547) #t)
+(test (< -3147483547/2 3147483547/3) #t)
+(test (< -3147483646/11 -12345678901/40) #f)
+(test (< -3147483646/11 -1234567890213/12345678901123123) #t)
+(test (< -3147483646/11 -40/12345678901) #t)
+(test (< -3147483646/11 12345678901/40) #t)
+(test (< -3147483646/11 1234567890213/12345678901123123) #t)
+(test (< -3147483646/11 40/12345678901) #t)
+(test (< -3147483646/11111111111111 -1234567890213/12345678901123123) #t)
+(test (< -3147483646/11111111111111 1234567890213/12345678901123123) #t)
+(test (< -3147483646/111111111111111 -1234567890213/12345678901123123) #f)
+(test (< -3147483646/111111111111111 1234567890213/12345678901123123) #t)
+(test (< 1/9223372036854775807 1/9223372036854775806) #t)
+(test (< 10/3147483647 40/12345678901) #t)
+(test (< 100000000000000.0 100000000000001.0) #t)
+(test (< 100000000000000/3 100000000000001/3) #t)
+(test (< 1000000000000000000/3 1000000000000000001/3) #t)
+(test (< 1047483646/11111111111111 -1234567890213/12345678901123123) #f)
+(test (< 1047483646/11111111111111 1234567890213/12345678901123123) #t)
+(test (< 11/3147483647 40/12345678901) #f)
+(test (< 1282469252763/12824692526603504 -1234567890213/12345678901123123) #f)
+(test (< 1282469252763/12824692526603504 1234567890213/12345678901123123) #t)
+(test (< 1282469252765/12824692526603504 -1234567890213/12345678901123123) #f)
+(test (< 1282469252765/12824692526603504 1234567890213/12345678901123123) #f)
+(test (< 2/3 -3147483547123/4) #f)
+(test (< 2/3 3147483547123/4) #t)
+(test (< 2/3147483547 -3147483547/3) #f)
+(test (< 2/3147483547 3147483547/3) #t)
+(test (< 2147483646/11111111111111 -1234567890213/12345678901123123) #f)
+(test (< 2147483646/11111111111111 1234567890213/12345678901123123) #f)
+(test (< 3/147483647 40/3) #t)
+(test (< 3/3147483647 -40/12345678901) #f)
+(test (< 3/3147483647 40/12345678901) #t)
+(test (< 3/3147483647 40/3) #t)
+(test (< 3147483547/2 -3/3147483547) #f)
+(test (< 3147483547/2 -3147483547/3) #f)
+(test (< 3147483547/2 3/3147483547) #f)
+(test (< 3147483547/2 3147483547/3) #f)
+(test (< 3147483646/11 -12345678901/40) #f)
+(test (< 3147483646/11 -1234567890213/12345678901123123) #f)
+(test (< 3147483646/11 -40/12345678901) #f)
+(test (< 3147483646/11 12345678901/40) #t)
+(test (< 3147483646/11 1234567890213/12345678901123123) #f)
+(test (< 3147483646/11 40/12345678901) #f)
+(test (< 3147483646/11111111111111 -1234567890213/12345678901123123) #f)
+(test (< 3147483646/11111111111111 1234567890213/12345678901123123) #f)
+(test (< 3147483646/111111111111111 -1234567890213/12345678901123123) #f)
+(test (< 3147483646/111111111111111 1234567890213/12345678901123123) #t)
+(test (< -1.797693134862315699999999999999999999998E308 -9223372036854775808) #t)
+(test (< -9223372036854775808 -9223372036854775808) #f)
+(test (< -9223372036854775808 5.551115123125783999999999999999999999984E-17) #t)
+(test (< -9223372036854775808 9223372036854775807 -9223372036854775808) #f)
+(test (< 1.110223024625156799999999999999999999997E-16 -9223372036854775808) #f)
+(test (< 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) #f)
+(test (< 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) #t)
+(test (< 9223372036854775807 -9223372036854775808) #f)
+(test (< 9223372036854775807 9223372036854775807) #f)
+(when with-bignums
+  (test (< (- 1237940039285380274899124223 1237940039285380000000000000) (- 1.2379400392853803e+27 1237940039285380000000000000) (- 1237940039285380274899124225 1237940039285380000000000000)) #f)
+  (test (< 1237940039285380274899124223 1.2379400392853803e+27 1237940039285380274899124225) #f))
+(test (< 0 most-negative-fixnum) #f)
+(test (< 0 most-positive-fixnum) #t)
+(test (< 1 3 . 2) 'error)
+(test (< 274899124223 3.0E11 274899124225) #f)
+(test (< most-negative-fixnum (real-part (log 0.0))) #f)
+(test (< most-negative-fixnum 0) #t)
+(test (< most-negative-fixnum most-positive-fixnum) #t)
+(test (< most-positive-fixnum (- (real-part (log 0.0)))) #t)
+(test (< most-positive-fixnum 0) #f)
+(test (< most-positive-fixnum most-negative-fixnum) #f)
+
+(test (< -1 1/9223372036854775807 9223372036854775807) #t)
+(test (< -9223372036854775807 -1/9223372036854775807 1) #t)
+(test (< -9223372036854775807 -1/9223372036854775807) #t)
+(test (< 1 9223372036 1/9223372036 1.0) #f)
+(test (< 1 9223372036 1/9223372036) #f)
+(test (< 1 922337203685 1/922337203685 1.0) #f)
+(test (< 1 922337203685 1/922337203685) #f)
+(test (< 1.0 9223372036 1/9223372036 1) #f)
+(test (< 1.0 9223372036 1/9223372036) #f)
+(test (< 1.0 922337203685 1/922337203685 1) #f)
+(test (< 1.0 922337203685 1/922337203685) #f)
+(test (< 1/9223372036 9223372036) #t)
+(test (< 1/922337203685 922337203685) #t)
+(test (< 1/9223372036854775807 9223372036854775807) #t)
+(test (< 9223372036 1/9223372036 1) #f)
+(test (< 9223372036 1/9223372036 1.0) #f)
+(test (< 9223372036 1/9223372036) #f)
+(test (< 922337203685 1/922337203685 1) #f)
+(test (< 922337203685 1/922337203685 1.0) #f)
+(test (< 922337203685 1/922337203685) #f)
+(test (< 1.0 9223372036854775807/9223372036854775806) #t)
+(test (< 9223372036854775806/9223372036854775807 1.0 9223372036854775807/9223372036854775806) #t)
+(test (< 9223372036854775806/9223372036854775807 1.0) #t)
+
+;;; there are cases that look innocuous that the non-gmp version can't get right:
+;;;    (< 21053343141/6701487259 3587785776203/1142027682075)
+;;; I'll put a few of these in the bignum section
+(test (< (* 10400200/16483927 1.0) (* 10781274/17087915 1.0)) #f)
+(test (< (* 10400200/16483927 1.0) 10781274/17087915) #f)
+(test (< (* 10781274/17087915 1.0) (* 53715833/85137581 1.0)) #t)
+(test (< (* 10781274/17087915 1.0) 53715833/85137581) #t)
+(test (< (* 12/19 1.0) (* 53/84 1.0)) #f)
+(test (< (* 12/19 1.0) 53/84) #f)
+(test (< (* 12941/20511 1.0) (* 15601/24727 1.0)) #t)
+(test (< (* 12941/20511 1.0) 15601/24727) #t)
+(test (< (* 15601/24727 1.0) (* 79335/125743 1.0)) #t)
+(test (< (* 15601/24727 1.0) 79335/125743) #t)
+
+;;; (if with-bignums (test (< (* 171928773/272500658 1.0) (* 397573379/630138897 1.0)) #t))
+;;; this requires more precision than 128 bits
+(test (negative? (- 171928773/272500658 397573379/630138897)) #t) ; so the first is less
+;; clisp, sbcl, guile, non-gmp s7 all say #f for the < comparison of reals
+(test (< 171928773/272500658 397573379/630138897) #t)
+;;; (= (* 171928773/272500658 1.0D0) (* 397573379/630138897 1.0D0)) -- clisp, sbcl, non-gmp s7, and guile say true
+
+(test (< (* 171928773/272500658 1.0) 397573379/630138897) #t)
+(test (< (* 190537/301994 1.0) (* 7161071/11350029 1.0)) #t)
+(test (< (* 190537/301994 1.0) 7161071/11350029) #t)
+(test (< (* 2/3 1.0) (* 5/8 1.0)) #f)
+(test (< (* 2/3 1.0) 5/8) #f)
+(test (< (* 253/401 1.0) (* 665/1054 1.0)) #t)
+(test (< (* 253/401 1.0) 665/1054) #t)
+(if with-bignums (test (< (* 397573379/630138897 1.0) (* 4201378396/6659027209 1.0)) #t))
+;;; fraction -> double troubles -- this is ok if s7_double is long double in s7.h
+(test (< (* 397573379/630138897 1.0) 4201378396/6659027209) #t)
+(test (< (* 4201378396/6659027209 1.0) (* 6189245291/9809721694 1.0)) #f)
+(if with-bignums (test (< (* 4201378396/6659027209 1.0) 6189245291/9809721694) #f))
+(test (< (* 5/8 1.0) (* 12/19 1.0)) #t)
+(test (< (* 5/8 1.0) 12/19) #t)
+(test (< (* 53/84 1.0) (* 253/401 1.0)) #f)
+(test (< (* 53/84 1.0) 253/401) #f)
+
+(test (< (* 53715833/85137581 1.0) (* 171928773/272500658 1.0)) #f)
+;;; (if with-bignums (test (< (* 53715833/85137581 1.0) 171928773/272500658) #f)) -- needs more than 128 bits
+(test (< 53715833/85137581 171928773/272500658) #f)
+
+(test (< (* 665/1054 1.0) (* 12941/20511 1.0)) #f)
+(test (< (* 665/1054 1.0) 12941/20511) #f)
+(test (< (* 7161071/11350029 1.0) (* 10400200/16483927 1.0)) #f)
+(test (< (* 7161071/11350029 1.0) 10400200/16483927) #f)
+(test (< (* 79335/125743 1.0) (* 190537/301994 1.0)) #t)
+(test (< (* 79335/125743 1.0) 190537/301994) #t)
+(test (< 10400200/16483927 10781274/17087915) #f)
+(test (< 10781274/17087915 53715833/85137581) #t)
+(test (< 12/19 53/84) #f)
+(test (< 12941/20511 15601/24727) #t)
+(test (< 15601/24727 79335/125743) #t)
+(test (< 171928773/272500658 397573379/630138897) #t)
+(test (< 190537/301994 7161071/11350029) #t)
+(test (< 2/3 5/8) #f)
+(test (< 253/401 665/1054) #t)
+(test (< 397573379/630138897 4201378396/6659027209) #t)
+(test (< 4201378396/6659027209 6189245291/9809721694) #f)
+(test (< 5/8 12/19) #t)
+(test (< 53/84 253/401) #f)
+(test (< 665/1054 12941/20511) #f)
+(test (< 7161071/11350029 10400200/16483927) #f)
+(test (< 79335/125743 190537/301994) #t)
+
+(test (< 131836323/93222358 110442295/78088974 125383891/88652904 61328902/43362679 138113653/97653429 254989762/180290825
+	 393920845/278522218 100728653/71220318 175072959/123785551 278215191/196712393 )
+      #t)
+(test (< 10812186007/7645370045 18338419250/12967220607 13343405959/9435212837 11079453630/7834356793 6071445385/4293160203
+	 14707776949/10399968816 22357396263/15809066506 77901127500/55084415513 2284381030/1615301317 10340752226/7312016021 )
+      #t)
+(test (< 886731088897/627013566048 1534756075495/1085236428449 244625906708/172976637487 1462171251759/1033911207374
+	 1743861030874/1233095960377 954593412651/674999475361 )
+      #t)
+
+(test (< 10651773591371/984771132841 1.081649758092772603273242802490196379734E1 22691355773217/2095909383391
+	 1.082649668092772603273242802490196379733E1 11269199657045/1040794570824 1.08274965909277260327324280249019637973E1 ) #t)
+(test (< 11320859/1046629 1.081649758092772603273242802490196379734E1 10021556/926421 1.081749668092772603273242802490196379733E1
+	 12893515/1191902 1.08175965909277260327324280249019637973E1 ) #t)
+(test (< 11320859/1046629 1.081649659092772603273242802490196379732E1 6398591/591558 1.081650658192772603273242802490196379729E1
+	 14562686/1346339 1.081650758102772603273242802490196379731E1 ) #t)
+(test (< 11320859/1046629 1.081649658102772603273242802490196379729E1 8517115/787419 1.081649668093772603273242802490196379735E1
+	 9667298/893755 1.081649669092872603273242802490196379734E1 ) #t)
+(test (< 1109328651/102558961 1.08164965809278260327324280249019637973E1 1412995811/130633408 1.081649658102773603273242802490196379729E1
+	 753823853/69692053 1.081649658103772703273242802490196379731E1 ) #t)
+
+(when with-bignums
+  (test (< 12345678901234567890 12345678901234567891) #t)
+  (test (< -9223372036854775808 -9223372036854775809) #f)
+  (test (< -9223372036854775809 -9223372036854775808) #t)
+  (test (< 9223372036854775808 9223372036854775807) #f)
+  (test (< 9223372036854775808 1e19) #t)
+  (test (< 9223372036854775807 85070591730234615865843651857942052865/9223372036854775807) #t)
+  (test (< 1.000e19 1267650600228229401496703205376 1e20) #f)
+
+  (test (< 4272943/1360120 21053343141/6701487259 3587785776203/1142027682075 2646693125139304345/842468587426513207) #t)
+  (test (< 4272943/1360120 21053343141/6701487259 3587785776203/1142027682075) #t)
+  (test (< 4272943/1360120 21053343141/6701487259 3587785776203/1142027682075 355/113) #t)
+  (test (< 21053343141/6701487259 3587785776203/1142027682075 355/113) #t)
+  (test (< 4272943/1360120 21053343141/6701487259 3587785776203/1142027682075) #t)
+  (test (< 21053343141/6701487259 3587785776203/1142027682075) #t)
+
+  (test (< 886731088897/627013566048 1534756075495/1085236428449 244625906708/172976637487 1462171251759/1033911207374
+	   1743861030874/1233095960377 954593412651/674999475361 902779846866/638361751637 2968095823096/2098760683721
+	   1684058273173/1190809024873 2947786590277/2084399887474 )
+	#t)
+  (test (< 1023286908188737/723573111879672 1763020673688684/1246643873737343 1430528867885681/1011536663165079
+	   2711447141769903/1917282660774379 575142878279173/406687429382352 935610884438753/661576800938585
+	   2339755998541282/1654457332890441 1443730843578617/1020871869702614 478219565475493/338152297643805 2026075188260327/1432651504812687 )
+	#t)
+
+  (test (< 1267650600228229401496703205376) 'error)
+  (test (< 1.0 1267650600228229401496703205376+i) 'error))
+
+;; need 2 globals here, fx_lt_gsg
+(define _lt_test_1 2)
+(define _lt_test_2 1+i)
+(let ((mid 1))
+  (define (func) (list (< _lt_test_1 mid _lt_test_2)))
+  (test (func) 'error))
+(when with-bignums
+  (test (let ((big (bignum 3.0))) (define (func) (< pi big pi)) (define (hi) (func)) (hi)) #f))
+
+;;; gad -- accidental pointer< rather than integer< in fx_lt_gsg!
+(define __fx_lt_1__ 1)
+(define __fx_lt_2__ 2)
+(define __fx_lt_3__ 8192) ; not a small int!
+(test (let () (define (func) (let ((i 2)) (cond (else (< __fx_lt_1__ __fx_lt_2__ __fx_lt_3__))))) (func) (func)) #t)
+
+
+;;; --------------------------------------------------------------------------------
+;;; <=
+;;; --------------------------------------------------------------------------------
+
+(test (<= 0 1 1) #t)
+(test (<= 0 1 1.0) #t)
+(test (<= 0 1 1/1) #t)
+(test (<= 0 1 123.4) #t)
+(test (<= 0 1 1234) #t)
+(test (<= 0 1 1234/11) #t)
+(test (<= 0 1) #t)
+(test (<= 0 1.0 1) #t)
+(test (<= 0 1.0 1.0) #t)
+(test (<= 0 1.0 1/1) #t)
+(test (<= 0 1.0 123.4) #t)
+(test (<= 0 1.0 1234) #t)
+(test (<= 0 1.0 1234/11) #t)
+(test (<= 0 1.0) #t)
+(test (<= 0 123.4) #t)
+(test (<= 0 1234) #t)
+(test (<= 0 1234/11) #t)
+(test (<= 0.0 1 1.0) #t)
+(test (<= 0.0 1 1/1) #t)
+(test (<= 0.0 1 123.4) #t)
+(test (<= 0.0 1 1234) #t)
+(test (<= 0.0 1 1234/11) #t)
+(test (<= 0.0 1) #t)
+(test (<= 0.0 1.0 1) #t)
+(test (<= 0.0 1.0 1.0) #t)
+(test (<= 0.0 1.0 1/1) #t)
+(test (<= 0.0 1.0 123.4) #t)
+(test (<= 0.0 1.0 1234) #t)
+(test (<= 0.0 1.0 1234/11) #t)
+(test (<= 0.0 1.0) #t)
+(test (<= 0.0 123.4 1) #f)
+(test (<= 0.0 123.4 1.0) #f)
+(test (<= 0.0 123.4 1/1) #f)
+(test (<= 0.0 123.4 123.4) #t)
+(test (<= 0.0 123.4 1234) #t)
+(test (<= 0.0 123.4 1234/11) #f)
+(test (<= 0.0 123.4) #t)
+(test (<= 0.0 1234 1) #f)
+(test (<= 0.0 1234 1.0) #f)
+(test (<= 0.0 1234 1/1) #f)
+(test (<= 0.0 1234 123.4) #f)
+(test (<= 0.0 1234 1234) #t)
+(test (<= 0.0 1234 1234/11) #f)
+(test (<= 0.0 1234) #t)
+(test (<= 0.0 1234/11 1) #f)
+(test (<= 0.0 1234/11 1.0) #f)
+(test (<= 0.0 1234/11 1/1) #f)
+(test (<= 0.0 1234/11 123.4) #t)
+(test (<= 0.0 1234/11 1234) #t)
+(test (<= 0.0 1234/11 1234/11) #t)
+(test (<= 0.0 1234/11) #t)
+(test (<= 1 1 1) #t)
+(test (<= 1 1 1.0) #t)
+(test (<= 1 1 1/1) #t)
+(test (<= 1 1 123.4) #t)
+(test (<= 1 1 1234) #t)
+(test (<= 1 1 1234/11) #t)
+(test (<= 1 1) #t)
+(test (<= 1 1.0 1) #t)
+(test (<= 1 1.0 1.0) #t)
+(test (<= 1 1.0 1/1) #t)
+(test (<= 1 1.0 123.4) #t)
+(test (<= 1 1.0 1234) #t)
+(test (<= 1 1.0 1234/11) #t)
+(test (<= 1 1.0) #t)
+(test (<= 1 123.4) #t)
+(test (<= 1 1234) #t)
+(test (<= 1 1234/11) #t)
+(test (<= 1.0 1 1) #t)
+(test (<= 1.0 1 1.0) #t)
+(test (<= 1.0 1 1/1) #t)
+(test (<= 1.0 1 123.4) #t)
+(test (<= 1.0 1 1234) #t)
+(test (<= 1.0 1 1234/11) #t)
+(test (<= 1.0 1) #t)
+(test (<= 1.0 1.0 1) #t)
+(test (<= 1.0 1.0 1.0) #t)
+(test (<= 1.0 1.0 1/1) #t)
+(test (<= 1.0 1.0 123.4) #t)
+(test (<= 1.0 1.0 1234) #t)
+(test (<= 1.0 1.0 1234/11) #t)
+(test (<= 1.0 1.0) #t)
+(test (<= 1.0 123.4 1) #f)
+(test (<= 1.0 123.4 1.0) #f)
+(test (<= 1.0 123.4 1/1) #f)
+(test (<= 1.0 123.4 123.4) #t)
+(test (<= 1.0 123.4 1234) #t)
+(test (<= 1.0 123.4 1234/11) #f)
+(test (<= 1.0 123.4) #t)
+(test (<= 1.0 1234 1) #f)
+(test (<= 1.0 1234 1.0) #f)
+(test (<= 1.0 1234 1/1) #f)
+(test (<= 1.0 1234 123.4) #f)
+(test (<= 1.0 1234 1234) #t)
+(test (<= 1.0 1234 1234/11) #f)
+(test (<= 1.0 1234) #t)
+(test (<= 1.0 1234/11 1) #f)
+(test (<= 1.0 1234/11 1.0) #f)
+(test (<= 1.0 1234/11 1/1) #f)
+(test (<= 1.0 1234/11 123.4) #t)
+(test (<= 1.0 1234/11 1234) #t)
+(test (<= 1.0 1234/11 1234/11) #t)
+(test (<= 1.0 1234/11) #t)
+(test (<= 123.4 1 1) #f)
+(test (<= 123.4 1 1.0) #f)
+(test (<= 123.4 1 1/1) #f)
+(test (<= 123.4 1 123.4) #f)
+(test (<= 123.4 1 1234) #f)
+(test (<= 123.4 1 1234/11) #f)
+(test (<= 123.4 1) #f)
+(test (<= 123.4 1.0 1) #f)
+(test (<= 123.4 1.0 1.0) #f)
+(test (<= 123.4 1.0 1/1) #f)
+(test (<= 123.4 1.0 123.4) #f)
+(test (<= 123.4 1.0 1234) #f)
+(test (<= 123.4 1.0 1234/11) #f)
+(test (<= 123.4 1.0) #f)
+(test (<= 123.4 123.4 1) #f)
+(test (<= 123.4 123.4 1.0) #f)
+(test (<= 123.4 123.4 1/1) #f)
+(test (<= 123.4 123.4 123.4) #t)
+(test (<= 123.4 123.4 1234) #t)
+(test (<= 123.4 123.4 1234/11) #f)
+(test (<= 123.4 123.4) #t)
+(test (<= 123.4 1234 1) #f)
+(test (<= 123.4 1234 1.0) #f)
+(test (<= 123.4 1234 1/1) #f)
+(test (<= 123.4 1234 123.4) #f)
+(test (<= 123.4 1234 1234) #t)
+(test (<= 123.4 1234 1234/11) #f)
+(test (<= 123.4 1234) #t)
+(test (<= 123.4 1234/11 1) #f)
+(test (<= 123.4 1234/11 1.0) #f)
+(test (<= 123.4 1234/11 1/1) #f)
+(test (<= 123.4 1234/11 123.4) #f)
+(test (<= 123.4 1234/11 1234) #f)
+(test (<= 123.4 1234/11 1234/11) #f)
+(test (<= 123.4 1234/11) #f)
+(test (<= 1234 1) #f)
+(test (<= 1234 1.0) #f)
+(test (<= 1234 1/1) #f)
+(test (<= 1234 123.4) #f)
+(test (<= 1234 1234) #t)
+(test (<= 1234 1234/11) #f)
+(test (<= 1234/11 1) #f)
+(test (<= 1234/11 1.0) #f)
+(test (<= 1234/11 1/1) #f)
+(test (<= 1234/11 123.4) #t)
+(test (<= 1234/11 1234) #t)
+(test (<= 1234/11 1234/11) #t)
+
+(test (<= -1 2 3 4 4 5 6 7) #t)
+(test (<= -1 2 3 4 5 6 7 8) #t)
+(test (<= 1 0+i) 'error)
+(test (<= 1 0-i) 'error)
+(test (<= 1+i 0+i) 'error)
+(test (<= 1+i 0-i) 'error)
+(test (<= 2 1 #\a) 'error)
+(test (<= 2 1+0/2i) #f)
+(test (<= 2 1+0i) #f)
+(test (<= 2 1-0i) #f)
+(test (<= 2 2 1) #f)
+
+(test (<= 0 3 4 4 6) #t)
+(test (<= 0 3 4 6 7) #t)
+(test (<= 0) 'error)
+(test (<=) 'error)
+(test (<= 0.0) 'error)
+(test (<= 0.0+0.00000001i) 'error)
+(test (<= 0/1) 'error)
+(test (<= 1 3 3 2 5) #f)
+(test (<= 1.0) 'error)
+(test (<= 1.0+1.0i) 'error)
+(test (<= +nan.0 1+i) 'error)
+(test (<= +nan.0 1 1+i) 'error)
+(test (<= 1 +nan.0 1+i) 'error)
+(test (<= +inf.0 1+i) 'error)
+(test (<= +inf.0 +nan.0 0-i 1) 'error)
+(test (<= 10/3) 'error)
+(test (<= 2 1 1.0+1.0i) 'error)
+(test (<= 2) 'error)
+(test (<= 3 -5) #f)
+(test (<= 3 3) #t)
+(test (<= 3 5) #t)
+(test (<= 3.0 3) #t)
+(test (<= 5/2 2.5) #t)
+(test (<= -1.797693134862315699999999999999999999998E308 -9223372036854775808) #t)
+(test (<= -9223372036854775808 -9223372036854775808) #t)
+(test (<= -9223372036854775808 5.551115123125783999999999999999999999984E-17) #t)
+(test (<= -9223372036854775808 9223372036854775807 -9223372036854775808) #f)
+(test (<= 1.110223024625156799999999999999999999997E-16 -9223372036854775808) #f)
+(test (<= 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) #f)
+(test (<= 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) #t)
+(test (<= 9223372036854775807 -9223372036854775808) #f)
+(test (<= 9223372036854775807 9223372036854775807) #t)
+
+(test (<= -1 -1/9223372036854775807 -9223372036854775807 1) #f)
+(test (<= -1 -1/9223372036854775807 -9223372036854775807) #f)
+(test (<= -1 1 9223372036854775807 1/9223372036854775807) #f)
+(test (<= -1 9223372036854775807 1/9223372036854775807 1) #f)
+(test (<= -1 9223372036854775807 1/9223372036854775807) #f)
+(test (<= -1/9223372036854775807 -9223372036854775807 -1 1) #f)
+(test (<= -1/9223372036854775807 -9223372036854775807 -1) #f)
+(test (<= -1/9223372036854775807 -9223372036854775807 1) #f)
+(test (<= -1/9223372036854775807 -9223372036854775807) #f)
+(test (<= 1 1.0 9223372036 1/9223372036) #f)
+(test (<= 1 1.0 922337203685 1/922337203685) #f)
+(test (<= 1 9223372036 1/9223372036 1.0) #f)
+(test (<= 1 9223372036 1/9223372036) #f)
+(test (<= 1 922337203685 1/922337203685 1.0) #f)
+(test (<= 1 922337203685 1/922337203685) #f)
+(test (<= 1 9223372036854775807 1/9223372036854775807) #f)
+(test (<= 1.0 1 9223372036 1/9223372036) #f)
+(test (<= 1.0 1 922337203685 1/922337203685) #f)
+(test (<= 1.0 9223372036 1/9223372036 1) #f)
+(test (<= 1.0 9223372036 1/9223372036) #f)
+(test (<= 1.0 922337203685 1/922337203685 1) #f)
+(test (<= 1.0 922337203685 1/922337203685) #f)
+(test (<= 1/9223372036 9223372036) #t)
+(test (<= 1/922337203685 922337203685) #t)
+(test (<= 9223372036 1/9223372036 1 1.0) #f)
+(test (<= 9223372036 1/9223372036 1) #f)
+(test (<= 9223372036 1/9223372036 1.0 1) #f)
+(test (<= 9223372036 1/9223372036 1.0) #f)
+(test (<= 9223372036 1/9223372036) #f)
+(test (<= 922337203685 1/922337203685 1 1.0) #f)
+(test (<= 922337203685 1/922337203685 1) #f)
+(test (<= 922337203685 1/922337203685 1.0 1) #f)
+(test (<= 922337203685 1/922337203685 1.0) #f)
+(test (<= 922337203685 1/922337203685) #f)
+(test (<= 9223372036854775807 1/9223372036854775807 1) #f)
+(test (<= 9223372036854775807 1/9223372036854775807) #f)
+(test (<= 1 1.0 9223372036854775806/9223372036854775807 9223372036854775807/9223372036854775806) #f)
+(test (<= 1 1.0 9223372036854775806/9223372036854775807) #f)
+(test (<= 1 9223372036854775807/9223372036854775806 1.0 9223372036854775806/9223372036854775807) #f)
+(test (<= 1 9223372036854775807/9223372036854775806 1.0) #f)
+(test (<= 1.0 9223372036854775806/9223372036854775807 1 9223372036854775807/9223372036854775806) #f)
+(test (<= 1.0 9223372036854775806/9223372036854775807 1) #f)
+(test (<= 1.0 9223372036854775806/9223372036854775807 9223372036854775807/9223372036854775806) #f)
+(test (<= 1.0 9223372036854775806/9223372036854775807) #f)
+(test (<= 9223372036854775806/9223372036854775807 1 9223372036854775807/9223372036854775806 1.0) #f)
+(test (<= 9223372036854775806/9223372036854775807 9223372036854775807/9223372036854775806 1.0 1) #f)
+(test (<= 9223372036854775806/9223372036854775807 9223372036854775807/9223372036854775806 1.0) #f)
+(test (<= 9223372036854775807/9223372036854775806 1.0 1) #f)
+(test (<= 9223372036854775807/9223372036854775806 1.0 9223372036854775806/9223372036854775807 1) #f)
+(test (<= 9223372036854775807/9223372036854775806 1.0 9223372036854775806/9223372036854775807) #f)
+(test (<= 9223372036854775807/9223372036854775806 1.0) #f)
+
+(when with-bignums
+  (test (<= 12345678901234567890 12345678901234567891) #t)
+  (test (let () (define (func) (<= (bignum +nan.0) 10001)) (define (hi) (func)) (hi)) #f)
+  (test (let () (define (func) (<= (bignum +nan.0) 0+i)) (define (hi) (func)) (hi)) 'error)
+
+  (test (<= 4272943/1360120 21053343141/6701487259 2646693125139304345/842468587426513207 3587785776203/1142027682075) #f)
+  (test (<= 4272943/1360120 3587785776203/1142027682075 21053343141/6701487259 2646693125139304345/842468587426513207) #f)
+  (test (<= 4272943/1360120 3587785776203/1142027682075 21053343141/6701487259) #f)
+  (test (<= 4272943/1360120 2646693125139304345/842468587426513207 3587785776203/1142027682075) #f)
+  (test (<= 21053343141/6701487259 2646693125139304345/842468587426513207 3587785776203/1142027682075) #f)
+  (test (<= 3587785776203/1142027682075 21053343141/6701487259 2646693125139304345/842468587426513207) #f)
+  (test (<= 3587785776203/1142027682075 21053343141/6701487259) #f)
+  (test (<= 2646693125139304345/842468587426513207 21053343141/6701487259) #f)
+  (test (<= 4272943/1360120 3587785776203/1142027682075 21053343141/6701487259 355/113) #f)
+  (test (<= 3587785776203/1142027682075 21053343141/6701487259 355/113) #f)
+  (test (<= 4272943/1360120 3587785776203/1142027682075 21053343141/6701487259) #f)
+  (test (<= 3587785776203/1142027682075 21053343141/6701487259) #f)
+
+  (test (<= 1267650600228229401496703205376) 'error))
+
+(for-each
+ (lambda (arg)
+   (test (<= arg +nan.0) 'error)
+   (test (<= +nan.0 arg) 'error)
+   (test (<= arg +inf.0) 'error)
+   (test (<= +inf.0 arg) 'error)
+   (test (<= 1 0 arg) 'error)
+   (test (<= 1 arg) 'error)
+   (test (<= 1.0 arg) 'error)
+   (test (<= 1/2 arg) 'error)
+   (test (<= arg 1) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+(test (<= +nan.0 2.0) #f)
+(test (<= +nan.0 (bignum 2.0)) #f)
+(test (<= (bignum +nan.0) 2.0) #f)
+(test (<= (bignum +nan.0) (bignum 2.0)) #f)
+(test (< +nan.0 2.0) #f)
+(test (< +nan.0 (bignum 2.0)) #f)
+(test (< (bignum +nan.0) 2.0) #f)
+(test (< (bignum +nan.0) (bignum 2.0)) #f)
+(test (>= +nan.0 2.0) #f)
+(test (>= +nan.0 (bignum 2.0)) #f)
+(test (>= (bignum +nan.0) 2.0) #f)
+(test (>= (bignum +nan.0) (bignum 2.0)) #f)
+(test (> +nan.0 2.0) #f)
+(test (> +nan.0 (bignum 2.0)) #f)
+(test (> (bignum +nan.0) 2.0) #f)
+(test (> (bignum +nan.0) (bignum 2.0)) #f)
+(test (= +nan.0 2.0) #f)
+(test (= +nan.0 (bignum 2.0)) #f)
+(test (= (bignum +nan.0) 2.0) #f)
+(test (= (bignum +nan.0) (bignum 2.0)) #f)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; =
+;;; --------------------------------------------------------------------------------
+
+(test (= -1.0+1.0i -1.0+1.0i) #t)
+(test (= -1.0+1.0i 0.0+1.0i) #f)
+(test (= -1.0+1.0i 1) #f)
+(test (= -1.0+1.0i 1.0) #f)
+(test (= -1.0+1.0i 1.0+1.0i) #f)
+(test (= -1.0+1.0i 1/1) #f)
+(test (= -1.0+1.0i 123.4) #f)
+(test (= -1.0+1.0i 1234) #f)
+(test (= -1.0+1.0i 1234/11) #f)
+(test (= 0 -1.0+1.0i) #f)
+(test (= 0 0.0+1.0i) #f)
+(test (= 0 1 -1.0+1.0i) #f)
+(test (= 0 1 0.0+1.0i) #f)
+(test (= 0 1 1) #f)
+(test (= 0 1 1.0) #f)
+(test (= 0 1 1.0+1.0i) #f)
+(test (= 0 1 1/1) #f)
+(test (= 0 1 123.4) #f)
+(test (= 0 1 1234) #f)
+(test (= 0 1 1234/11) #f)
+(test (= 0 1) #f)
+(test (= 0 -0) #t)
+(test (= 0 1.0 -1.0+1.0i) #f)
+(test (= 0 1.0 0.0+1.0i) #f)
+(test (= 0 1.0 1) #f)
+(test (= 0 1.0 1.0) #f)
+(test (= 0 1.0 1.0+1.0i) #f)
+(test (= 0 1.0 1/1) #f)
+(test (= 0 1.0 123.4) #f)
+(test (= 0 1.0 1234) #f)
+(test (= 0 1.0 1234/11) #f)
+(test (= 0 1.0) #f)
+(test (= 0 1.0+1.0i -1.0+1.0i) #f)
+(test (= 0 1.0+1.0i 0.0+1.0i) #f)
+(test (= 0 1.0+1.0i 1) #f)
+(test (= 0 1.0+1.0i 1.0) #f)
+(test (= 0 1.0+1.0i 1.0+1.0i) #f)
+(test (= 0 1.0+1.0i 1/1) #f)
+(test (= 0 1.0+1.0i 123.4) #f)
+(test (= 0 1.0+1.0i 1234) #f)
+(test (= 0 1.0+1.0i 1234/11) #f)
+(test (= 0 1.0+1.0i) #f)
+(test (= 0 123.4) #f)
+(test (= 0 1234) #f)
+(test (= 0 1234/11) #f)
+(test (= 0.0 -1.0+1.0i -1.0+1.0i) #f)
+(test (= 0.0 -1.0+1.0i 0.0+1.0i) #f)
+(test (= 0.0 -1.0+1.0i 1) #f)
+(test (= 0.0 -1.0+1.0i 1.0) #f)
+(test (= 0.0 -1.0+1.0i 1.0+1.0i) #f)
+(test (= 0.0 -1.0+1.0i 1/1) #f)
+(test (= 0.0 -1.0+1.0i 123.4) #f)
+(test (= 0.0 -1.0+1.0i 1234) #f)
+(test (= 0.0 -1.0+1.0i 1234/11) #f)
+(test (= 0.0 -1.0+1.0i) #f)
+(test (= 0.0 0.0+1.0i -1.0+1.0i) #f)
+(test (= 0.0 0.0+1.0i 0.0+1.0i) #f)
+(test (= 0.0 0.0+1.0i 1) #f)
+(test (= 0.0 0.0+1.0i 1.0) #f)
+(test (= 0.0 0.0+1.0i 1.0+1.0i) #f)
+(test (= 0.0 0.0+1.0i 1/1) #f)
+(test (= 0.0 0.0+1.0i 123.4) #f)
+(test (= 0.0 0.0+1.0i 1234) #f)
+(test (= 0.0 0.0+1.0i 1234/11) #f)
+(test (= 0.0 0.0+1.0i) #f)
+(test (= 0.0 1 -1.0+1.0i) #f)
+(test (= 0.0 1 0.0+1.0i) #f)
+(test (= 0.0 1 1.0) #f)
+(test (= 0.0 1 1.0+1.0i) #f)
+(test (= 0.0 1 1/1) #f)
+(test (= 0.0 1 123.4) #f)
+(test (= 0.0 1 1234) #f)
+(test (= 0.0 1 1234/11) #f)
+(test (= 0.0 1) #f)
+(test (= 0.0 1.0 -1.0+1.0i) #f)
+(test (= 0.0 1.0 0.0+1.0i) #f)
+(test (= 0.0 1.0 1) #f)
+(test (= 0.0 1.0 1.0) #f)
+(test (= 0.0 1.0 1.0+1.0i) #f)
+(test (= 0.0 1.0 1/1) #f)
+(test (= 0.0 1.0 123.4) #f)
+(test (= 0.0 1.0 1234) #f)
+(test (= 0.0 1.0 1234/11) #f)
+(test (= 0.0 1.0) #f)
+(test (= 0.0 1.0+1.0i -1.0+1.0i) #f)
+(test (= 0.0 1.0+1.0i 0.0+1.0i) #f)
+(test (= 0.0 1.0+1.0i 1) #f)
+(test (= 0.0 1.0+1.0i 1.0) #f)
+(test (= 0.0 1.0+1.0i 1.0+1.0i) #f)
+(test (= 0.0 1.0+1.0i 1/1) #f)
+(test (= 0.0 1.0+1.0i 123.4) #f)
+(test (= 0.0 1.0+1.0i 1234) #f)
+(test (= 0.0 1.0+1.0i 1234/11) #f)
+(test (= 0.0 1.0+1.0i) #f)
+(test (= 0.0 123.4 -1.0+1.0i) #f)
+(test (= 0.0 123.4 0.0+1.0i) #f)
+(test (= 0.0 123.4 1) #f)
+(test (= 0.0 123.4 1.0) #f)
+(test (= 0.0 123.4 1.0+1.0i) #f)
+(test (= 0.0 123.4 1/1) #f)
+(test (= 0.0 123.4 123.4) #f)
+(test (= 0.0 123.4 1234) #f)
+(test (= 0.0 123.4 1234/11) #f)
+(test (= 0.0 123.4) #f)
+(test (= 0.0 1234 -1.0+1.0i) #f)
+(test (= 0.0 1234 0.0+1.0i) #f)
+(test (= 0.0 1234 1) #f)
+(test (= 0.0 1234 1.0) #f)
+(test (= 0.0 1234 1.0+1.0i) #f)
+(test (= 0.0 1234 1/1) #f)
+(test (= 0.0 1234 123.4) #f)
+(test (= 0.0 1234 1234) #f)
+(test (= 0.0 1234 1234/11) #f)
+(test (= 0.0 1234) #f)
+(test (= 0.0 1234/11 -1.0+1.0i) #f)
+(test (= 0.0 1234/11 0.0+1.0i) #f)
+(test (= 0.0 1234/11 1) #f)
+(test (= 0.0 1234/11 1.0) #f)
+(test (= 0.0 1234/11 1.0+1.0i) #f)
+(test (= 0.0 1234/11 1/1) #f)
+(test (= 0.0 1234/11 123.4) #f)
+(test (= 0.0 1234/11 1234) #f)
+(test (= 0.0 1234/11 1234/11) #f)
+(test (= 0.0 1234/11) #f)
+(test (= 0.0+1.0i -1.0+1.0i) #f)
+(test (= 0.0+1.0i 0.0+1.0i) #t)
+(test (= 0.0+1.0i 1) #f)
+(test (= 0.0+1.0i 1.0) #f)
+(test (= 0.0+1.0i 1.0+1.0i) #f)
+(test (= 0.0+1.0i 1/1) #f)
+(test (= 0.0+1.0i 123.4) #f)
+(test (= 0.0+1.0i 1234) #f)
+(test (= 0.0+1.0i 1234/11) #f)
+(test (= 1 -1) #f)
+(test (= 1 -1.0+1.0i) #f)
+(test (= 1 -2) #f)
+(test (= 1 0.0+1.0i) #f)
+(test (= 1 1 -1.0+1.0i) #f)
+(test (= 1 1 0.0+1.0i) #f)
+(test (= 1 1 1) #t)
+(test (= 1 1 1.0) #t)
+(test (= 1 1 1.0+1.0i) #f)
+(test (= 1 1 1/1) #t)
+(test (= 1 1 123.4) #f)
+(test (= 1 1 1234) #f)
+(test (= 1 1 1234/11) #f)
+(test (= 1 1) #t)
+(test (= 1 1.0 -1.0+1.0i) #f)
+(test (= 1 1.0 0.0+1.0i) #f)
+(test (= 1 1.0 1) #t)
+(test (= 1 1.0 1.0) #t)
+(test (= 1 1.0 1.0+1.0i) #f)
+(test (= 1 1.0 1/1) #t)
+(test (= 1 1.0 123.4) #f)
+(test (= 1 1.0 1234) #f)
+(test (= 1 1.0 1234/11) #f)
+(test (= 1 1.0) #t)
+(test (= 1 1.0+1.0i -1.0+1.0i) #f)
+(test (= 1 1.0+1.0i 0.0+1.0i) #f)
+(test (= 1 1.0+1.0i 1) #f)
+(test (= 1 1.0+1.0i 1.0) #f)
+(test (= 1 1.0+1.0i 1.0+1.0i) #f)
+(test (= 1 1.0+1.0i 1/1) #f)
+(test (= 1 1.0+1.0i 123.4) #f)
+(test (= 1 1.0+1.0i 1234) #f)
+(test (= 1 1.0+1.0i 1234/11) #f)
+(test (= 1 1.0+1.0i) #f)
+(test (= 1 123.4) #f)
+(test (= 1 1234) #f)
+(test (= 1 1234/11) #f)
+(test (= 1.0 -1.0) #f)
+(test (= 1.0 -1.0+1.0i -1.0+1.0i) #f)
+(test (= 1.0 -1.0+1.0i 0.0+1.0i) #f)
+(test (= 1.0 -1.0+1.0i 1) #f)
+(test (= 1.0 -1.0+1.0i 1.0) #f)
+(test (= 1.0 -1.0+1.0i 1.0+1.0i) #f)
+(test (= 1.0 -1.0+1.0i 1/1) #f)
+(test (= 1.0 -1.0+1.0i 123.4) #f)
+(test (= 1.0 -1.0+1.0i 1234) #f)
+(test (= 1.0 -1.0+1.0i 1234/11) #f)
+(test (= 1.0 -1.0+1.0i) #f)
+(test (= 1.0 0.0+1.0i -1.0+1.0i) #f)
+(test (= 1.0 0.0+1.0i 0.0+1.0i) #f)
+(test (= 1.0 0.0+1.0i 1) #f)
+(test (= 1.0 0.0+1.0i 1.0) #f)
+(test (= 1.0 0.0+1.0i 1.0+1.0i) #f)
+(test (= 1.0 0.0+1.0i 1/1) #f)
+(test (= 1.0 0.0+1.0i 123.4) #f)
+(test (= 1.0 0.0+1.0i 1234) #f)
+(test (= 1.0 0.0+1.0i 1234/11) #f)
+(test (= 1.0 0.0+1.0i) #f)
+(test (= 1.0 1 -1.0+1.0i) #f)
+(test (= 1.0 1 0.0+1.0i) #f)
+(test (= 1.0 1 1) #t)
+(test (= 1.0 1 1.0) #t)
+(test (= 1.0 1 1.0+1.0i) #f)
+(test (= 1.0 1 1/1) #t)
+(test (= 1.0 1 123.4) #f)
+(test (= 1.0 1 1234) #f)
+(test (= 1.0 1 1234/11) #f)
+(test (= 1.0 1) #t)
+(test (= 1.0 1.0 -1.0+1.0i) #f)
+(test (= 1.0 1.0 0.0+1.0i) #f)
+(test (= 1.0 1.0 1) #t)
+(test (= 1.0 1.0 1.0) #t)
+(test (= 1.0 1.0 1.0+1.0i) #f)
+(test (= 1.0 1.0 1/1) #t)
+(test (= 1.0 1.0 123.4) #f)
+(test (= 1.0 1.0 1234) #f)
+(test (= 1.0 1.0 1234/11) #f)
+(test (= 1.0 1.0) #t)
+(test (= 1.0 1.0+1.0i -1.0+1.0i) #f)
+(test (= 1.0 1.0+1.0i 0.0+1.0i) #f)
+(test (= 1.0 1.0+1.0i 1) #f)
+(test (= 1.0 1.0+1.0i 1.0) #f)
+(test (= 1.0 1.0+1.0i 1.0+1.0i) #f)
+(test (= 1.0 1.0+1.0i 1/1) #f)
+(test (= 1.0 1.0+1.0i 123.4) #f)
+(test (= 1.0 1.0+1.0i 1234) #f)
+(test (= 1.0 1.0+1.0i 1234/11) #f)
+(test (= 1.0 1.0+1.0i) #f)
+(test (= 1.0 123.4 -1.0+1.0i) #f)
+(test (= 1.0 123.4 0.0+1.0i) #f)
+(test (= 1.0 123.4 1) #f)
+(test (= 1.0 123.4 1.0) #f)
+(test (= 1.0 123.4 1.0+1.0i) #f)
+(test (= 1.0 123.4 1/1) #f)
+(test (= 1.0 123.4 123.4) #f)
+(test (= 1.0 123.4 1234) #f)
+(test (= 1.0 123.4 1234/11) #f)
+(test (= 1.0 123.4) #f)
+(test (= 1.0 1234 -1.0+1.0i) #f)
+(test (= 1.0 1234 0.0+1.0i) #f)
+(test (= 1.0 1234 1) #f)
+(test (= 1.0 1234 1.0) #f)
+(test (= 1.0 1234 1.0+1.0i) #f)
+(test (= 1.0 1234 1/1) #f)
+(test (= 1.0 1234 123.4) #f)
+(test (= 1.0 1234 1234) #f)
+(test (= 1.0 1234 1234/11) #f)
+(test (= 1.0 1234) #f)
+(test (= 1.0 1234/11 -1.0+1.0i) #f)
+(test (= 1.0 1234/11 0.0+1.0i) #f)
+(test (= 1.0 1234/11 1) #f)
+(test (= 1.0 1234/11 1.0) #f)
+(test (= 1.0 1234/11 1.0+1.0i) #f)
+(test (= 1.0 1234/11 1/1) #f)
+(test (= 1.0 1234/11 123.4) #f)
+(test (= 1.0 1234/11 1234) #f)
+(test (= 1.0 1234/11 1234/11) #f)
+(test (= 1.0 1234/11) #f)
+(test (= 1.0+1.0i -1.0+1.0i -1.0+1.0i) #f)
+(test (= 1.0+1.0i -1.0+1.0i 0.0+1.0i) #f)
+(test (= 1.0+1.0i -1.0+1.0i 1) #f)
+(test (= 1.0+1.0i -1.0+1.0i 1.0) #f)
+(test (= 1.0+1.0i -1.0+1.0i 1.0+1.0i) #f)
+(test (= 1.0+1.0i -1.0+1.0i 1/1) #f)
+(test (= 1.0+1.0i -1.0+1.0i 123.4) #f)
+(test (= 1.0+1.0i -1.0+1.0i 1234) #f)
+(test (= 1.0+1.0i -1.0+1.0i 1234/11) #f)
+(test (= 1.0+1.0i -1.0+1.0i) #f)
+(test (= 1.0+1.0i 0.0+1.0i -1.0+1.0i) #f)
+(test (= 1.0+1.0i 0.0+1.0i 0.0+1.0i) #f)
+(test (= 1.0+1.0i 0.0+1.0i 1) #f)
+(test (= 1.0+1.0i 0.0+1.0i 1.0) #f)
+(test (= 1.0+1.0i 0.0+1.0i 1.0+1.0i) #f)
+(test (= 1.0+1.0i 0.0+1.0i 1/1) #f)
+(test (= 1.0+1.0i 0.0+1.0i 123.4) #f)
+(test (= 1.0+1.0i 0.0+1.0i 1234) #f)
+(test (= 1.0+1.0i 0.0+1.0i 1234/11) #f)
+(test (= 1.0+1.0i 0.0+1.0i) #f)
+(test (= 1.0+1.0i 1 -1.0+1.0i) #f)
+(test (= 1.0+1.0i 1 0.0+1.0i) #f)
+(test (= 1.0+1.0i 1 1) #f)
+(test (= 1.0+1.0i 1 1.0) #f)
+(test (= 1.0+1.0i 1 1.0+1.0i) #f)
+(test (= 1.0+1.0i 1 1/1) #f)
+(test (= 1.0+1.0i 1 123.4) #f)
+(test (= 1.0+1.0i 1 1234) #f)
+(test (= 1.0+1.0i 1 1234/11) #f)
+(test (= 1.0+1.0i 1) #f)
+(test (= 1.0+1.0i 1.0 -1.0+1.0i) #f)
+(test (= 1.0+1.0i 1.0 0.0+1.0i) #f)
+(test (= 1.0+1.0i 1.0 1) #f)
+(test (= 1.0+1.0i 1.0 1.0) #f)
+(test (= 1.0+1.0i 1.0 1.0+1.0i) #f)
+(test (= 1.0+1.0i 1.0 1/1) #f)
+(test (= 1.0+1.0i 1.0 123.4) #f)
+(test (= 1.0+1.0i 1.0 1234) #f)
+(test (= 1.0+1.0i 1.0 1234/11) #f)
+(test (= 1.0+1.0i 1.0) #f)
+(test (= 1.0+1.0i 1.0+1.0i -1.0+1.0i) #f)
+(test (= 1.0+1.0i 1.0+1.0i 0.0+1.0i) #f)
+(test (= 1.0+1.0i 1.0+1.0i 1) #f)
+(test (= 1.0+1.0i 1.0+1.0i 1.0) #f)
+(test (= 1.0+1.0i 1.0+1.0i 1.0+1.0i) #t)
+(test (= 1.0+1.0i 1.0+1.0i 1/1) #f)
+(test (= 1.0+1.0i 1.0+1.0i 123.4) #f)
+(test (= 1.0+1.0i 1.0+1.0i 1234) #f)
+(test (= 1.0+1.0i 1.0+1.0i 1234/11) #f)
+(test (= 1.0+1.0i 1.0+1.0i) #t)
+(test (= 1.0+1.0i 123.4 -1.0+1.0i) #f)
+(test (= 1.0+1.0i 123.4 0.0+1.0i) #f)
+(test (= 1.0+1.0i 123.4 1) #f)
+(test (= 1.0+1.0i 123.4 1.0) #f)
+(test (= 1.0+1.0i 123.4 1.0+1.0i) #f)
+(test (= 1.0+1.0i 123.4 1/1) #f)
+(test (= 1.0+1.0i 123.4 123.4) #f)
+(test (= 1.0+1.0i 123.4 1234) #f)
+(test (= 1.0+1.0i 123.4 1234/11) #f)
+(test (= 1.0+1.0i 123.4) #f)
+(test (= 1.0+1.0i 1234 -1.0+1.0i) #f)
+(test (= 1.0+1.0i 1234 0.0+1.0i) #f)
+(test (= 1.0+1.0i 1234 1) #f)
+(test (= 1.0+1.0i 1234 1.0) #f)
+(test (= 1.0+1.0i 1234 1.0+1.0i) #f)
+(test (= 1.0+1.0i 1234 1/1) #f)
+(test (= 1.0+1.0i 1234 123.4) #f)
+(test (= 1.0+1.0i 1234 1234) #f)
+(test (= 1.0+1.0i 1234 1234/11) #f)
+(test (= 1.0+1.0i 1234) #f)
+(test (= 1.0+1.0i 1234/11 -1.0+1.0i) #f)
+(test (= 1.0+1.0i 1234/11 0.0+1.0i) #f)
+(test (= 1.0+1.0i 1234/11 1) #f)
+(test (= 1.0+1.0i 1234/11 1.0) #f)
+(test (= 1.0+1.0i 1234/11 1.0+1.0i) #f)
+(test (= 1.0+1.0i 1234/11 1/1) #f)
+(test (= 1.0+1.0i 1234/11 123.4) #f)
+(test (= 1.0+1.0i 1234/11 1234) #f)
+(test (= 1.0+1.0i 1234/11 1234/11) #f)
+(test (= 1.0+1.0i 1234/11) #f)
+(test (= 123.4 -1.0+1.0i -1.0+1.0i) #f)
+(test (= 123.4 -1.0+1.0i 0.0+1.0i) #f)
+(test (= 123.4 -1.0+1.0i 1) #f)
+(test (= 123.4 -1.0+1.0i 1.0) #f)
+(test (= 123.4 -1.0+1.0i 1.0+1.0i) #f)
+(test (= 123.4 -1.0+1.0i 1/1) #f)
+(test (= 123.4 -1.0+1.0i 123.4) #f)
+(test (= 123.4 -1.0+1.0i 1234) #f)
+(test (= 123.4 -1.0+1.0i 1234/11) #f)
+(test (= 123.4 -1.0+1.0i) #f)
+(test (= 123.4 0.0+1.0i -1.0+1.0i) #f)
+(test (= 123.4 0.0+1.0i 0.0+1.0i) #f)
+(test (= 123.4 0.0+1.0i 1) #f)
+(test (= 123.4 0.0+1.0i 1.0) #f)
+(test (= 123.4 0.0+1.0i 1.0+1.0i) #f)
+(test (= 123.4 0.0+1.0i 1/1) #f)
+(test (= 123.4 0.0+1.0i 123.4) #f)
+(test (= 123.4 0.0+1.0i 1234) #f)
+(test (= 123.4 0.0+1.0i 1234/11) #f)
+(test (= 123.4 0.0+1.0i) #f)
+(test (= 123.4 1 -1.0+1.0i) #f)
+(test (= 123.4 1 0.0+1.0i) #f)
+(test (= 123.4 1 1) #f)
+(test (= 123.4 1 1.0) #f)
+(test (= 123.4 1 1.0+1.0i) #f)
+(test (= 123.4 1 1/1) #f)
+(test (= 123.4 1 123.4) #f)
+(test (= 123.4 1 1234) #f)
+(test (= 123.4 1 1234/11) #f)
+(test (= 123.4 1) #f)
+(test (= 123.4 1.0 -1.0+1.0i) #f)
+(test (= 123.4 1.0 0.0+1.0i) #f)
+(test (= 123.4 1.0 1) #f)
+(test (= 123.4 1.0 1.0) #f)
+(test (= 123.4 1.0 1.0+1.0i) #f)
+(test (= 123.4 1.0 1/1) #f)
+(test (= 123.4 1.0 123.4) #f)
+(test (= 123.4 1.0 1234) #f)
+(test (= 123.4 1.0 1234/11) #f)
+(test (= 123.4 1.0) #f)
+(test (= 123.4 1.0+1.0i -1.0+1.0i) #f)
+(test (= 123.4 1.0+1.0i 0.0+1.0i) #f)
+(test (= 123.4 1.0+1.0i 1) #f)
+(test (= 123.4 1.0+1.0i 1.0) #f)
+(test (= 123.4 1.0+1.0i 1.0+1.0i) #f)
+(test (= 123.4 1.0+1.0i 1/1) #f)
+(test (= 123.4 1.0+1.0i 123.4) #f)
+(test (= 123.4 1.0+1.0i 1234) #f)
+(test (= 123.4 1.0+1.0i 1234/11) #f)
+(test (= 123.4 1.0+1.0i) #f)
+(test (= 123.4 123.4 -1.0+1.0i) #f)
+(test (= 123.4 123.4 0.0+1.0i) #f)
+(test (= 123.4 123.4 1) #f)
+(test (= 123.4 123.4 1.0) #f)
+(test (= 123.4 123.4 1.0+1.0i) #f)
+(test (= 123.4 123.4 1/1) #f)
+(test (= 123.4 123.4 123.4) #t)
+(test (= 123.4 123.4 1234) #f)
+(test (= 123.4 123.4 1234/11) #f)
+(test (= 123.4 123.4) #t)
+(test (= 123.4 1234 -1.0+1.0i) #f)
+(test (= 123.4 1234 0.0+1.0i) #f)
+(test (= 123.4 1234 1) #f)
+(test (= 123.4 1234 1.0) #f)
+(test (= 123.4 1234 1.0+1.0i) #f)
+(test (= 123.4 1234 1/1) #f)
+(test (= 123.4 1234 123.4) #f)
+(test (= 123.4 1234 1234) #f)
+(test (= 123.4 1234 1234/11) #f)
+(test (= 123.4 1234) #f)
+(test (= 123.4 1234/11 -1.0+1.0i) #f)
+(test (= 123.4 1234/11 0.0+1.0i) #f)
+(test (= 123.4 1234/11 1) #f)
+(test (= 123.4 1234/11 1.0) #f)
+(test (= 123.4 1234/11 1.0+1.0i) #f)
+(test (= 123.4 1234/11 1/1) #f)
+(test (= 123.4 1234/11 123.4) #f)
+(test (= 123.4 1234/11 1234) #f)
+(test (= 123.4 1234/11 1234/11) #f)
+(test (= 123.4 1234/11) #f)
+(test (= 1234 -1.0+1.0i) #f)
+(test (= 1234 0.0+1.0i) #f)
+(test (= 1234 1) #f)
+(test (= 1234 1.0) #f)
+(test (= 1234 1.0+1.0i) #f)
+(test (= 1234 1/1) #f)
+(test (= 1234 123.4) #f)
+(test (= 1234 1234) #t)
+(test (= 1234 1234/11) #f)
+(test (= 1234/11 -1.0+1.0i) #f)
+(test (= 1234/11 0.0+1.0i) #f)
+(test (= 1234/11 1) #f)
+(test (= 1234/11 1.0) #f)
+(test (= 1234/11 1.0+1.0i) #f)
+(test (= 1234/11 1/1) #f)
+(test (= 1234/11 123.4) #f)
+(test (= 1234/11 1234) #f)
+(test (= 1234/11 1234/11) #t)
+(test (= 2 -1) #f)
+(test (= 2 -2) #f)
+
+(test (= -0 0) #t)
+(test (= -0-0i 0.0) #t)
+(test (= -0.0 0.0) #t)
+(test (= -0.0-0.0i 0.0) #t)
+(test (= .6 .6) #t)
+(test (= 0.11 0.11) #t)
+(test (= 0.18 0.18) #t)
+(test (= 0.3 0.3) #t)
+(test (= 0.333 0.333) #t)
+(test (= 0.60 0.60) #t)
+(test (= 0.999 0.999) #t)
+(test (= 1 2 #\a) 'error)
+(test (= 1+0i 1-0i) #t)
+(test (= 1+i 0+i) #f)
+(test (= 1+i 0-i) #f)
+(test (= 1/2 1/2+0i) #t) ; gmp reads 1/2+0i as 1.0
+(test (= 100.000 100.000) #t)
+(test (= 1e10 1e10) #t)
+(test (= 22 22 22) #t)
+(test (= 22 22) #t)
+(test (= 34 34 35) #f)
+(test (= 34 35) #f)
+(test (= 60e-2 60e-2) #t)
+
+
+;; should these be an error if not bignums? or if safety>n?
+(test (= 9007199254740992 9007199254740992.0) #t)
+(when with-bignums
+  (test (= 9007199254740992 (+ 9007199254740992 1.0)) #f)
+  (test (= 9007199254740992 (+ 9007199254740992 1.0e-1)) #f)
+  (test (= 9007199254740992 (+ 9007199254740992 1.0e-10)) #f))
+(test (= 92233720368547758/19 (exact->inexact 92233720368547758/19)) #f) ; repeating decimal 4.854406335186724105263157894736842105267E15)
+
+(test (= 9007199254740992.0 9007199254740992) #t)
+(when with-bignums
+  (test (= (+ 9007199254740992 1.0) 9007199254740992) #f)
+  (test (= (+ 9007199254740992 1.0e-1) 9007199254740992) #f)
+  (test (= (+ 9007199254740992 1.0e-10) 9007199254740992) #f))
+(test (= (exact->inexact 92233720368547758/19) 92233720368547758/19) #f)
+
+(test (= 9007199254740993 (+ 9007199254740992 1)) #t)
+(test (= 9007199254740993.0 (+ 9007199254740992 1)) #t)
+(test (= 9007199254740993.0 (+ 9007199254740992 1.0)) #t)
+(test (= 9007199254740991 (- 9007199254740992 1)) #t)
+(test (= 9007199254740991.0 (- 9007199254740992 1)) #t)
+(test (= 9007199254740991.0 (- 9007199254740992 1.0)) #t)
+
+(test (let () (define (f) (= 9007199254740993.0 (+ 9007199254740992 1))) (f)) #t)
+(when with-bignums
+  (test (let () (define (f) (= 9007199254740992 (+ 9007199254740992 1.0))) (f)) #f))
+
+(test (= 0 0.0) #t)
+(test (= 0 1 "hi") 'error)
+(test (= 0) 'error)
+(test (=) 'error)
+(test (= 0.0 0.0) #t)
+(test (= 0.0 1.0 "hi") 'error)
+(test (= 0.0) 'error)
+(test (= 0.0+0.00000001i) 'error)
+(test (= 0/1) 'error)
+(test (= 1.0) 'error)
+(test (= 1.0+1.0i) 'error)
+(test (= 1 lambda) 'error)
+(test (= 10/3) 'error)
+(test (= 2) 'error)
+(test (= 2.5 5/2) #t)
+(test (= 2.5+0.0i 5/2) #t)
+(test (= 2.5+1.0i 5/2) #f)
+(test (= pi '(1)) 'error) ; for gmp
+(test (= 3 2 3) #f)
+(test (= 3 3 3 3) #t)
+(test (= 3 3 5 3) #f)
+(test (= 3 3) #t)
+(test (= 3 3.0) #t)
+(test (= 3 5) #f)
+(test (= 3 6 5 2) #f)
+(test (= 3.0 3.0+0.0i) #t)
+(test (= 5/2 2.5) #t)
+(test (= 5/2 2.5+0.0i) #t)
+(test (= 5/2 2.5+1.0i) #f)
+
+(for-each
+ (lambda (arg)
+   (test (= arg +nan.0) 'error)
+   (test (= +nan.0 arg) 'error)
+   (test (= arg +inf.0) 'error)
+   (test (= +inf.0 arg) 'error)
+   (test (= 1 0 arg) 'error)
+   (test (= 1 arg) 'error)
+   (test (= 1.0 arg) 'error)
+   (test (= 1/2 arg) 'error)
+   (test (= 1+i arg) 'error)
+   (test (= arg 1) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(test (= +0 -0 0/100 00 -0/9223372036854775807) #t)
+(test (= +1/2 1/2) #t)
+(test (= 0 0) #t)
+(test (= 0.0 0.0+0.0i +0.0 -0.0 +.0 -.0 +0. -0. 0. .0 0.e1 0e1 0e+1 +0.0e+1+0.0e+1i 0-0i) #t)
+(test (= 1.0 1.0+0.0i +1.0 1. 1e0 1-0i) #t)
+(test (= 0.0+0.0i 0.0+0.0i) #t)
+(test (= 1+1i 1+1i) #t)
+(test (= 1.0+1.0i 1.0+1.0i) #t)
+(test (= 1.0+1i 1.0+1.0i) #t)
+(test (= 100000000000000.0 100000000000001.0) #f)
+(test (= -1.797693134862315699999999999999999999998E308 -9223372036854775808) #f)
+(test (= -9223372036854775808 -9223372036854775808) #t)
+(test (= -9223372036854775808 5.551115123125783999999999999999999999984E-17) #f)
+(test (= -9223372036854775808 9223372036854775807 -9223372036854775808) #f)
+(test (= 1.110223024625156799999999999999999999997E-16 -9223372036854775808) #f)
+(when with-bignums
+  (test (= 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) #f)
+  (test (= 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) #f))
+(test (= 9223372036854775807 -9223372036854775808) #f)
+(test (= 9223372036854775807 9223372036854775807) #t)
+(test (= (* most-negative-fixnum 1) (- (* -1 most-positive-fixnum) 1)) #t)
+(test (= (* most-positive-fixnum -1) (+ most-negative-fixnum 1)) #t)
+(test (= (+ most-negative-fixnum 1) (- most-positive-fixnum)) #t)
+(test (= (+ most-negative-fixnum most-positive-fixnum) -1) #t)
+(test (= (- most-negative-fixnum (- most-positive-fixnum)) -1) #t)
+(test (= 0 1/0 0/0) #f)
+(test (= 0/1 -0/1) #t)
+(test (= 1/0 (log 0)) #f)
+(test (= 1/0 -1/0) #f)
+(test (= 1e100 1e+100) #t)
+(test (= most-negative-fixnum (/ (log 0) (log 0))) #f)
+(test (= most-negative-fixnum 0/0) #f)
+(test (= most-negative-fixnum 0/0+0/0i) #f)
+(test (= most-negative-fixnum 1/0) #f)
+(test (= most-positive-fixnum (/ (log 0) (log 0))) #f)
+(test (= most-positive-fixnum 0/0) #f)
+(test (= most-positive-fixnum 0/0+0/0i) #f)
+(test (= most-positive-fixnum 1/0) #f)
+(test (= most-positive-fixnum most-negative-fixnum) #f)
+(test (= most-positive-fixnum most-positive-fixnum) #t)
+
+(test (= 1+i 1+nan.0i) #f)                ; mpc_cmp can't handle NaNs, so we have to check that case by hand
+(test (= (bignum 1+i) 1+nan.0i) #f)
+(test (= 1+i (bignum 1+nan.0i)) #f)
+(test (= (bignum 1+i) (bignum 1+nan.0i)) #f)
+(test (= 1+nan.0i 1+i) #f)
+(test (= (bignum 1+nan.0i) 1+i) #f)
+(test (= 1+nan.0i (bignum 1+i)) #f)
+(test (= (bignum 1+nan.0i) (bignum 1+i)) #f)
+(test (eqv? 1+i 1+nan.0i) #f)
+(test (eqv? (bignum 1+i) 1+nan.0i) #f)
+(test (eqv? 1+i (bignum 1+nan.0i)) #f)
+(test (eqv? (bignum 1+i) (bignum 1+nan.0i)) #f)
+(test (eqv? 1+nan.0i 1+i) #f)
+(test (eqv? (bignum 1+nan.0i) 1+i) #f)
+(test (eqv? 1+nan.0i (bignum 1+i)) #f)
+(test (eqv? (bignum 1+nan.0i) (bignum 1+i)) #f)
+(test (equal? 1+i 1+nan.0i) #f)
+(test (equal? (bignum 1+i) 1+nan.0i) #f)
+(test (equal? 1+i (bignum 1+nan.0i)) #f)
+(test (equal? (bignum 1+i) (bignum 1+nan.0i)) #f)
+(test (equal? 1+nan.0i 1+i) #f)
+(test (equal? (bignum 1+nan.0i) 1+i) #f)
+(test (equal? 1+nan.0i (bignum 1+i)) #f)
+(test (equal? (bignum 1+nan.0i) (bignum 1+i)) #f)
+(test (equivalent? 1+i 1+nan.0i) #f)
+(test (equivalent? (bignum 1+i) 1+nan.0i) #f)
+(test (equivalent? 1+i (bignum 1+nan.0i)) #f)
+(test (equivalent? (bignum 1+i) (bignum 1+nan.0i)) #f)
+(test (equivalent? 1+nan.0i 1+i) #f)
+(test (equivalent? (bignum 1+nan.0i) 1+i) #f)
+(test (equivalent? 1+nan.0i (bignum 1+i)) #f)
+(test (equivalent? (bignum 1+nan.0i) (bignum 1+i)) #f)
+(test (> (bignum 3/4) +nan.0) #f)
+(test (>= (bignum 3/4) +nan.0) #f)
+(test (< (bignum 3/4) +nan.0) #f)
+(test (<= (bignum 3/4) +nan.0) #f)
+(test (> +nan.0 (bignum 3/4)) #f)
+(test (>= +nan.0 (bignum 3/4)) #f)
+(test (< +nan.0 (bignum 3/4)) #f)
+(test (<= +nan.0 (bignum 3/4)) #f)
+(test (<= (bignum +nan.0) (bignum 23)) #f)
+
+(when with-bignums
+  (test (= (bignum +nan.0) "asdf") 'error)
+  (test (let () (define (func) (= (bignum +nan.0) 10001)) (define (hi) (func)) (hi)) #f)
+  (for-each ; just do them all!
+   (lambda (op)
+     (if (op +nan.0 +nan.0) (format *stderr* "~A bignum case 1~%" op))
+     (if (op +nan.0 (bignum +nan.0)) (format *stderr* "~A bignum case 2~%" op))
+     (if (op +nan.0 1) (format *stderr* "~A bignum case 3~%" op))
+     (if (op +nan.0 1/2) (format *stderr* "~A bignum case 4~%" op))
+     (if (op +nan.0 1.0) (format *stderr* "~A bignum case 5~%" op))
+     (if (op +nan.0 (bignum 1)) (format *stderr* "~A bignum case 6~%" op))
+     (if (op +nan.0 (bignum 1/2)) (format *stderr* "~A bignum case 7~%" op))
+     (if (op +nan.0 (bignum 1.0)) (format *stderr* "~A bignum case 8~%" op))
+
+     (if (op (bignum +nan.0) +nan.0) (format *stderr* "~A bignum case 11~%" op))
+     (if (op (bignum +nan.0) (bignum +nan.0)) (format *stderr* "~A bignum case 12~%" op))
+     (if (op (bignum +nan.0) 1) (format *stderr* "~A bignum case 13~%" op))
+     (if (op (bignum +nan.0) 1/2) (format *stderr* "~A bignum case 14~%" op))
+     (if (op (bignum +nan.0) 1.0) (format *stderr* "~A bignum case 15~%" op))
+     (if (op (bignum +nan.0) (bignum 1)) (format *stderr* "~A bignum case 16~%" op))
+     (if (op (bignum +nan.0) (bignum 1/2)) (format *stderr* "~A bignum case 17~%" op))
+     (if (op (bignum +nan.0) (bignum 1.0)) (format *stderr* "~A bignum case 18~%" op))
+
+     (if (op 1 +nan.0) (format *stderr* "~A bignum case 23~%" op))
+     (if (op 1/2 +nan.0) (format *stderr* "~A bignum case 24~%" op))
+     (if (op 1.0 +nan.0) (format *stderr* "~A bignum case 25~%" op))
+     (if (op (bignum 1) +nan.0) (format *stderr* "~A bignum case 26~%" op))
+     (if (op (bignum 1/2) +nan.0) (format *stderr* "~A bignum case 27~%" op))
+     (if (op (bignum 1.0) +nan.0) (format *stderr* "~A bignum case 28~%" op))
+
+     (if (op 1 (bignum +nan.0)) (format *stderr* "~A bignum case 43~%" op))
+     (if (op 1/2 (bignum +nan.0)) (format *stderr* "~A bignum case 44~%" op))
+     (if (op 1.0 (bignum +nan.0)) (format *stderr* "~A bignum case 45~%" op))
+     (if (op (bignum 1) (bignum +nan.0)) (format *stderr* "~A bignum case 46~%" op))
+     (if (op (bignum 1/2) (bignum +nan.0)) (format *stderr* "~A bignum case 47~%" op))
+     (if (op (bignum 1.0) (bignum +nan.0)) (format *stderr* "~A bignum case 48~%" op)))
+   (list = >= <= < >)))
+
+;; these are a mess -- they depend on optimizer choices, etc
+(when with-bignums
+  (test (= 9223372036854775807/9223372036854775806 1.0 9223372036854775806/9223372036854775807) #f)
+  (test (= 9223372036854775806/9223372036854775807 1.0 9223372036854775807/9223372036854775806) #f)
+  (test (= 1 1.0 9223372036854775806/9223372036854775807) #f)
+  (test (= 9223372036854775806/9223372036854775807 1.0 1) #f)
+  (test (= 9223372036854775806/9223372036854775807 1.0) #f)
+  (test (= 1.0 9223372036854775806/9223372036854775807) #f)
+  (test (= 1 1.0 9223372036854775807/9223372036854775806) #f)
+  (test (= 9223372036854775807/9223372036854775806 1.0 1) #f)
+  (test (= 9223372036854775807/9223372036854775806 1.0) #f)
+  (test (= 1.0 9223372036854775807/9223372036854775806) #f)
+  (test (= 1.0 9223372036854775807/9223372036854775806) (= 9223372036854775807/9223372036854775806 1.0))
+  (test (= (* 397573379/630138897 1.0) 4201378396/6659027209) (= 4201378396/6659027209 (* 397573379/630138897 1.0))))
+
+(test (= (* 10400200/16483927 1.0) (* 10781274/17087915 1.0)) #f)
+(test (= (* 10400200/16483927 1.0) 10781274/17087915) #f)
+(unless with-bignums ; equivalent? used here
+  (test (= (* 10781274/17087915 1.0) (* 53715833/85137581 1.0)) #f)
+  (test (= (* 10781274/17087915 1.0) 53715833/85137581) #f))
+(test (= (* 12/19 1.0) (* 53/84 1.0)) #f)
+(test (= (* 12/19 1.0) 53/84) #f)
+(test (= (* 12941/20511 1.0) (* 15601/24727 1.0)) #f)
+(test (= (* 12941/20511 1.0) 15601/24727) #f)
+(test (= (* 15601/24727 1.0) (* 79335/125743 1.0)) #f)
+(test (= (* 15601/24727 1.0) 79335/125743) #f)
+
+(when with-bignums (test (positive? 9223372036854775808) #t))
+(test (rational? -9223372036854775808/3) #t)
+(test (positive? (abs -9223372036854775808/3)) #t)
+
+;;; (if with-bignums (test (= (* 171928773/272500658 1.0) (* 397573379/630138897 1.0)) #t)) -- needs more bits
+;;; (test (= (* 171928773/272500658 1.0) 397573379/630138897) #f)
+
+(test (= (* 190537/301994 1.0) (* 7161071/11350029 1.0)) #f)
+(test (= (* 190537/301994 1.0) 7161071/11350029) #f)
+(test (= (* 2/3 1.0) (* 5/8 1.0)) #f)
+(test (= (* 2/3 1.0) 5/8) #f)
+(test (= (* 253/401 1.0) (* 665/1054 1.0)) #f)
+(test (= (* 253/401 1.0) 665/1054) #f)
+(when with-bignums
+  (test (= (* 397573379/630138897 1.0) (* 4201378396/6659027209 1.0)) #f)  ;; first is not bignum currently
+  (test (= (* 4201378396/6659027209 1.0) (* 6189245291/9809721694 1.0)) #f)
+  (test (= (* 397573379/630138897 1.0) 4201378396/6659027209) #f)
+  (test (= (* 4201378396/6659027209 1.0) 6189245291/9809721694) #f))
+(test (= (* 5/8 1.0) (* 12/19 1.0)) #f)
+(test (= (* 5/8 1.0) 12/19) #f)
+(test (= (* 53/84 1.0) (* 253/401 1.0)) #f)
+(test (= (* 53/84 1.0) 253/401) #f)
+
+;;; (if with-bignums (test (= (* 53715833/85137581 1.0) (* 171928773/272500658 1.0)) #f)) -- more bits
+;;; (if with-bignums (test (= (* 53715833/85137581 1.0) 171928773/272500658) #f))
+
+(test (= (* 665/1054 1.0) (* 12941/20511 1.0)) #f)
+(test (= (* 665/1054 1.0) 12941/20511) #f)
+(test (= (* 7161071/11350029 1.0) (* 10400200/16483927 1.0)) #f)
+(test (= (* 7161071/11350029 1.0) 10400200/16483927) #f)
+(test (= (* 79335/125743 1.0) (* 190537/301994 1.0)) #f)
+(test (= (* 79335/125743 1.0) 190537/301994) #f)
+(test (= 10400200/16483927 10781274/17087915) #f)
+(test (= 10781274/17087915 53715833/85137581) #f)
+(test (= 12/19 53/84) #f)
+(test (= 12941/20511 15601/24727) #f)
+(test (= 15601/24727 79335/125743) #f)
+(test (= 171928773/272500658 397573379/630138897) #f)
+(test (= 190537/301994 7161071/11350029) #f)
+(test (= 2/3 5/8) #f)
+(test (= 253/401 665/1054) #f)
+(test (= 397573379/630138897 4201378396/6659027209) #f)
+(test (= 4201378396/6659027209 6189245291/9809721694) #f)
+(test (= 5/8 12/19) #f)
+(test (= 53/84 253/401) #f)
+(test (= 53715833/85137581 171928773/272500658) #f)
+(test (= 665/1054 12941/20511) #f)
+(test (= 7161071/11350029 10400200/16483927) #f)
+(test (= 79335/125743 190537/301994) #f)
+(unless with-bignums (test (= 10.000000000 10.000000000000001) #f))
+
+(when with-bignums
+  (test (= 8388608.9999999995 8388609) #f)
+  (test (= (* 1.0 16743730547042864/1996007985) 8388609) #f)
+  (test (= (* 1.0 13981015002796202/1666666667) 8388609) #f)
+
+  (test (= (bignum "3") 1/0) #f)
+  (test (= 12345678901234567890 12345678901234567891) #f)
+  (test (= most-positive-fixnum (- (/ most-negative-fixnum -1) 1)) #t)
+  (test (= 1267650600228229401496703205376) 'error))
+
+;;; non-gmp strangeness:
+;;;    (zero? (- (sqrt 2) 5964153172084899/4217293152016490)) -> #t, but
+;;;    (= (sqrt 2) 5964153172084899/4217293152016490) -> #f
+
+
+(test (= 0 '(1 . 2) . 3) 'error)
+(test (append 0 '(1 . 2) . 3) 'error)
+(test (= 0 ''0  . 0) 'error)
+(test (= . 0) 'error)
+(test (= 0 . (0)) #t)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; >
+;;; --------------------------------------------------------------------------------
+
+(test (> 0 1 1) #f)
+(test (> 0 1 1.0) #f)
+(test (> 0 1 1/1) #f)
+(test (> 0 1 123.4) #f)
+(test (> 0 1 1234) #f)
+(test (> 0 1 1234/11) #f)
+(test (> 0 1) #f)
+(test (> 0 1.0 1) #f)
+(test (> 0 1.0 1.0) #f)
+(test (> 0 1.0 1/1) #f)
+(test (> 0 1.0 123.4) #f)
+(test (> 0 1.0 1234) #f)
+(test (> 0 1.0 1234/11) #f)
+(test (> 0 1.0) #f)
+(test (> 0 123.4) #f)
+(test (> 0 1234) #f)
+(test (> 0 1234/11) #f)
+(test (> 0.0 1 1.0) #f)
+(test (> 0.0 1 1/1) #f)
+(test (> 0.0 1 123.4) #f)
+(test (> 0.0 1 1234) #f)
+(test (> 0.0 1 1234/11) #f)
+(test (> 0.0 1) #f)
+(test (> 0.0 1.0 1) #f)
+(test (> 0.0 1.0 1.0) #f)
+(test (> 0.0 1.0 1/1) #f)
+(test (> 0.0 1.0 123.4) #f)
+(test (> 0.0 1.0 1234) #f)
+(test (> 0.0 1.0 1234/11) #f)
+(test (> 0.0 1.0) #f)
+(test (> 0.0 123.4 1) #f)
+(test (> 0.0 123.4 1.0) #f)
+(test (> 0.0 123.4 1/1) #f)
+(test (> 0.0 123.4 123.4) #f)
+(test (> 0.0 123.4 1234) #f)
+(test (> 0.0 123.4 1234/11) #f)
+(test (> 0.0 123.4) #f)
+(test (> 0.0 1234 1) #f)
+(test (> 0.0 1234 1.0) #f)
+(test (> 0.0 1234 1/1) #f)
+(test (> 0.0 1234 123.4) #f)
+(test (> 0.0 1234 1234) #f)
+(test (> 0.0 1234 1234/11) #f)
+(test (> 0.0 1234) #f)
+(test (> 0.0 1234/11 1) #f)
+(test (> 0.0 1234/11 1.0) #f)
+(test (> 0.0 1234/11 1/1) #f)
+(test (> 0.0 1234/11 123.4) #f)
+(test (> 0.0 1234/11 1234) #f)
+(test (> 0.0 1234/11 1234/11) #f)
+(test (> 0.0 1234/11) #f)
+(test (> 1 1 1) #f)
+(test (> 1 1 1.0) #f)
+(test (> 1 1 1/1) #f)
+(test (> 1 1 123.4) #f)
+(test (> 1 1 1234) #f)
+(test (> 1 1 1234/11) #f)
+(test (> 1 1) #f)
+(test (> 1 1.0 1) #f)
+(test (> 1 1.0 1.0) #f)
+(test (> 1 1.0 1/1) #f)
+(test (> 1 1.0 123.4) #f)
+(test (> 1 1.0 1234) #f)
+(test (> 1 1.0 1234/11) #f)
+(test (> 1 1.0) #f)
+(test (> 1 123.4) #f)
+(test (> 1 1234) #f)
+(test (> 1 1234/11) #f)
+(test (> 1.0 1 1) #f)
+(test (> 1.0 1 1.0) #f)
+(test (> 1.0 1 1/1) #f)
+(test (> 1.0 1 123.4) #f)
+(test (> 1.0 1 1234) #f)
+(test (> 1.0 1 1234/11) #f)
+(test (> 1.0 1) #f)
+(test (> 1.0 1.0 1) #f)
+(test (> 1.0 1.0 1.0) #f)
+(test (> 1.0 1.0 1/1) #f)
+(test (> 1.0 1.0 123.4) #f)
+(test (> 1.0 1.0 1234) #f)
+(test (> 1.0 1.0 1234/11) #f)
+(test (> 1.0 1.0) #f)
+(test (> 1.0 123.4 1) #f)
+(test (> 1.0 123.4 1.0) #f)
+(test (> 1.0 123.4 1/1) #f)
+(test (> 1.0 123.4 123.4) #f)
+(test (> 1.0 123.4 1234) #f)
+(test (> 1.0 123.4 1234/11) #f)
+(test (> 1.0 123.4) #f)
+(test (> 1.0 1234 1) #f)
+(test (> 1.0 1234 1.0) #f)
+(test (> 1.0 1234 1/1) #f)
+(test (> 1.0 1234 123.4) #f)
+(test (> 1.0 1234 1234) #f)
+(test (> 1.0 1234 1234/11) #f)
+(test (> 1.0 1234) #f)
+(test (> 1.0 1234/11 1) #f)
+(test (> 1.0 1234/11 1.0) #f)
+(test (> 1.0 1234/11 1/1) #f)
+(test (> 1.0 1234/11 123.4) #f)
+(test (> 1.0 1234/11 1234) #f)
+(test (> 1.0 1234/11 1234/11) #f)
+(test (> 1.0 1234/11) #f)
+(test (> 123.4 1 1) #f)
+(test (> 123.4 1 1.0) #f)
+(test (> 123.4 1 1/1) #f)
+(test (> 123.4 1 123.4) #f)
+(test (> 123.4 1 1234) #f)
+(test (> 123.4 1 1234/11) #f)
+(test (> 123.4 1) #t)
+(test (> 123.4 1.0 1) #f)
+(test (> 123.4 1.0 1.0) #f)
+(test (> 123.4 1.0 1/1) #f)
+(test (> 123.4 1.0 123.4) #f)
+(test (> 123.4 1.0 1234) #f)
+(test (> 123.4 1.0 1234/11) #f)
+(test (> 123.4 1.0) #t)
+(test (> 123.4 123.4 1) #f)
+(test (> 123.4 123.4 1.0) #f)
+(test (> 123.4 123.4 1/1) #f)
+(test (> 123.4 123.4 123.4) #f)
+(test (> 123.4 123.4 1234) #f)
+(test (> 123.4 123.4 1234/11) #f)
+(test (> 123.4 123.4) #f)
+(test (> 123.4 1234 1) #f)
+(test (> 123.4 1234 1.0) #f)
+(test (> 123.4 1234 1/1) #f)
+(test (> 123.4 1234 123.4) #f)
+(test (> 123.4 1234 1234) #f)
+(test (> 123.4 1234 1234/11) #f)
+(test (> 123.4 1234) #f)
+(test (> 123.4 1234/11 1) #t)
+(test (> 123.4 1234/11 1.0) #t)
+(test (> 123.4 1234/11 1/1) #t)
+(test (> 123.4 1234/11 123.4) #f)
+(test (> 123.4 1234/11 1234) #f)
+(test (> 123.4 1234/11 1234/11) #f)
+(test (> 123.4 1234/11) #t)
+(test (> 1234 1) #t)
+(test (> 1234 1.0) #t)
+(test (> 1234 1/1) #t)
+(test (> 1234 123.4) #t)
+(test (> 1234 1234) #f)
+(test (> 1234 1234/11) #t)
+(test (> 1234/11 1) #t)
+(test (> 1234/11 1.0) #t)
+(test (> 1234/11 1/1) #t)
+(test (> 1234/11 123.4) #f)
+(test (> 1234/11 1234) #f)
+(test (> 1234/11 1234/11) #f)
+(test (> +nan.0 1) #f)
+(test (> +nan.0 1.0) #f)
+(test (> +nan.0 1/2) #f)
+(test (> 1 +nan.0) #f)
+(test (> 1.0 +nan.0) #f)
+(test (> 1/2 +nan.0) #f)
+
+(test (> 1 0+i) 'error)
+(test (> 1 0-i) 'error)
+(test (> 1 2 #\a) 'error)
+(test (> 1+i 0+i) 'error)
+(test (> 1+i 0-i) 'error)
+(test (> +nan.0 1+i) 'error)
+(test (> +nan.0 1 1+i) 'error)
+(test (> 1 +nan.0 1+i) 'error)
+(test (> +inf.0 1+i) 'error)
+(test (> +inf.0 +nan.0 0-i 1) 'error)
+(test (> 2 1+0/2i) #t)
+(test (> 2 1+0i) #t)
+(test (> 2 1-0i) #t)
+(test (> 2 2 1) #f)
+(test (> 3 -6246) #t)
+(test (> 9 9 -2424) #f)
+(test (> quote if) 'error)
+
+(test (> 0) 'error)
+(test (> 0.0 0.0) #f)
+(test (> 0.0) 'error)
+(test (>) 'error)
+(test (> 0.0+0.00000001i) 'error)
+(test (> 0/1) 'error)
+(test (> 1 2 #\a) 'error)
+(test (> 1 2 1.0+1.0i) 'error)
+(test (> 1.0) 'error)
+(test (> 1.0+1.0i) 'error)
+(test (> 10/3) 'error)
+(test (> 2) 'error)
+(test (> 3 3.0 3 3.0+1.0i) 'error)
+(test (> 4 3 1 2 0) #f)
+(test (> 4 3 2 1 0) #t)
+(test (> 4 3 3 2 0) #f)
+(test (> 4 3) #t)
+(test (> 8 7 6 5 4) #t)
+
+(test (> -10/3147483647 -40/12345678901) #t)
+(test (> -101/3147483647 40/12345678901) #f)
+(test (> -11/3147483647 -40/12345678901) #f)
+(test (> 1/9223372036854775807 1/9223372036854775806) #f)
+(test (> 10/3147483647 40/12345678901) #f)
+(test (> 1047483646/11111111111111 1234567890213/12345678901123123) #f)
+(test (> 11/3147483647 40/12345678901) #t)
+(test (> 1282469252763/12824692526603504 1234567890213/12345678901123123) #f)
+(test (> 1282469252765/12824692526603504 1234567890213/12345678901123123) #t)
+(test (> 2/3 3147483547123/4) #f)
+(test (> 2/3147483547 3147483547/3) #f)
+(test (> 2147483646/11111111111111 1234567890213/12345678901123123) #t)
+(test (> 3/147483647 40/3) #f)
+(test (> 3/3147483647 -40/12345678901) #t)
+(test (> 3/3147483647 40/12345678901) #f)
+(test (> 3/3147483647 40/3) #f)
+(test (> 3147483547/2 3/3147483547) #t)
+(test (> 3147483547/2 3147483547/3) #t)
+(test (> 3147483646/11 12345678901/40) #f)
+(test (> 3147483646/11 1234567890213/12345678901123123) #t)
+(test (> 3147483646/11 40/12345678901) #t)
+(test (> 3147483646/11111111111111 1234567890213/12345678901123123) #t)
+(test (> 3147483646/111111111111111 1234567890213/12345678901123123) #f)
+(test (> -1.797693134862315699999999999999999999998E308 -9223372036854775808) #f)
+(test (> -9223372036854775808 -9223372036854775808) #f)
+(test (> -9223372036854775808 5.551115123125783999999999999999999999984E-17) #f)
+(test (> -9223372036854775808 9223372036854775807 -9223372036854775808) #f)
+(test (> 1.110223024625156799999999999999999999997E-16 -9223372036854775808) #t)
+(test (> 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) #t)
+(test (> 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) #f)
+(test (> 9223372036854775807 -9223372036854775808) #t)
+(test (> 9223372036854775807 9223372036854775807) #f)
+(test (> 0 most-negative-fixnum) #t)
+(test (> 0 most-positive-fixnum) #f)
+(test (> 1e18 most-positive-fixnum) #f)
+(test (> 9007199254740992.0 9007199254740991.0) #t)
+(test (> most-negative-fixnum (real-part (log 0.0))) #t)
+(test (> most-negative-fixnum 0) #f)
+(test (> most-negative-fixnum most-positive-fixnum) #f)
+(test (> most-positive-fixnum (- (real-part (log 0.0)))) #f)
+(test (> most-positive-fixnum 0) #t)
+(test (> most-positive-fixnum most-negative-fixnum) #t)
+(test (> most-positive-fixnum most-negative-fixnum) #t)
+(test (> 1/123400000000 .000000000001) #t)
+; these can go either way I guess -- 1/0 might be NaN?
+;(test (< most-positive-fixnum 1/0) #t)
+;(test (> most-positive-fixnum 1/0) #f)
+(test (> 10.000000000 9.99999999999999) #t)
+
+(test (> -1/9223372036854775807 -9223372036854775807) #t)
+(test (> 1 -1/9223372036854775807 -9223372036854775807) #t)
+(test (> 1 1/9223372036 9223372036 1.0) #f)
+(test (> 1 1/9223372036 9223372036) #f)
+(test (> 1 1/922337203685 922337203685 1.0) #f)
+(test (> 1 1/922337203685 922337203685) #f)
+(test (> 1.0 1/9223372036 9223372036 1) #f)
+(test (> 1.0 1/9223372036 9223372036) #f)
+(test (> 1.0 1/922337203685 922337203685 1) #f)
+(test (> 1.0 1/922337203685 922337203685) #f)
+(test (> 1/9223372036 9223372036 1) #f)
+(test (> 1/9223372036 9223372036 1.0) #f)
+(test (> 1/9223372036 9223372036) #f)
+(test (> 1/922337203685 922337203685 1) #f)
+(test (> 1/922337203685 922337203685 1.0) #f)
+(test (> 1/922337203685 922337203685) #f)
+(test (> 9223372036 1/9223372036) #t)
+(test (> 922337203685 1/922337203685) #t)
+(test (> 9223372036854775807 1/9223372036854775807 -1) #t)
+(test (> 9223372036854775807 1/9223372036854775807) #t)
+(test (> 1.0 9223372036854775806/9223372036854775807) #t)
+(test (> 9223372036854775807/9223372036854775806 1.0 9223372036854775806/9223372036854775807) #t)
+(test (> 9223372036854775807/9223372036854775806 1.0) #t)
+
+(num-test (/ 9007199254740992 9007199254740993) 9007199254740992/9007199254740993)
+(num-test (/ 9007199254740992 9007199254740993 1.0) 1.0)
+(test (< (/ 9007199254740992 9007199254740993) 1.0) #t)
+(test (< 1.0 (/ 9007199254740992 9007199254740993)) #f)
+(test (= 9007199254740992 9007199254740993) #f)
+(test (= 9007199254740992 9007199254740993 (exact->inexact 9007199254740992)) #f)
+
+(test (> (* 10400200/16483927 1.0) (* 10781274/17087915 1.0)) #t)
+(test (> (* 10400200/16483927 1.0) 10781274/17087915) #t)
+(test (> (* 10781274/17087915 1.0) (* 53715833/85137581 1.0)) #f)
+(test (> (* 10781274/17087915 1.0) 53715833/85137581) #f)
+(test (> (* 12/19 1.0) (* 53/84 1.0)) #t)
+(test (> (* 12/19 1.0) 53/84) #t)
+(test (> (* 12941/20511 1.0) (* 15601/24727 1.0)) #f)
+(test (> (* 12941/20511 1.0) 15601/24727) #f)
+(test (> (* 15601/24727 1.0) (* 79335/125743 1.0)) #f)
+(test (> (* 15601/24727 1.0) 79335/125743) #f)
+
+(test (> (* 171928773/272500658 1.0) (* 397573379/630138897 1.0)) #f)
+(test (> (* 171928773/272500658 1.0) 397573379/630138897) #f)
+
+(test (> (* 190537/301994 1.0) (* 7161071/11350029 1.0)) #f)
+(test (> (* 190537/301994 1.0) 7161071/11350029) #f)
+(test (> (* 2/3 1.0) (* 5/8 1.0)) #t)
+(test (> (* 2/3 1.0) 5/8) #t)
+(test (> (* 253/401 1.0) (* 665/1054 1.0)) #f)
+(test (> (* 253/401 1.0) 665/1054) #f)
+(test (> (* 397573379/630138897 1.0) (* 4201378396/6659027209 1.0)) #f)
+(test (> (* 397573379/630138897 1.0) 4201378396/6659027209) #f)
+(test (> (* 5/8 1.0) (* 12/19 1.0)) #f)
+(test (> (* 5/8 1.0) 12/19) #f)
+(test (> (* 53/84 1.0) (* 253/401 1.0)) #t)
+(test (> (* 53/84 1.0) 253/401) #t)
+(test (> (abs (- .1 .2)) .3) #f)
+(test (> (abs (- .1 .2)) .03) #t)
+
+;;; (if with-bignums (test (> (* 53715833/85137581 1.0) (* 171928773/272500658 1.0)) #t)) -- more bits
+;;; (if with-bignums (test (> (* 53715833/85137581 1.0) 171928773/272500658) #t))
+(test (> 53715833/85137581 171928773/272500658) #t)
+
+(test (> (* 665/1054 1.0) (* 12941/20511 1.0)) #t)
+(test (> (* 665/1054 1.0) 12941/20511) #t)
+(test (> (* 7161071/11350029 1.0) (* 10400200/16483927 1.0)) #t)
+(test (> (* 7161071/11350029 1.0) 10400200/16483927) #t)
+(test (> (* 79335/125743 1.0) (* 190537/301994 1.0)) #f)
+(test (> (* 79335/125743 1.0) 190537/301994) #f)
+(test (> 10400200/16483927 10781274/17087915) #t)
+(test (> 10781274/17087915 53715833/85137581) #f)
+(test (> 12/19 53/84) #t)
+(test (> 12941/20511 15601/24727) #f)
+(test (> 15601/24727 79335/125743) #f)
+(test (> 171928773/272500658 397573379/630138897) #f)
+(test (> 190537/301994 7161071/11350029) #f)
+(test (> 2/3 5/8) #t)
+(test (> 253/401 665/1054) #f)
+(test (> 397573379/630138897 4201378396/6659027209) #f)
+(test (> 4201378396/6659027209 6189245291/9809721694) #t)
+(test (> 5/8 12/19) #f)
+(test (> 53/84 253/401) #t)
+(test (> 53715833/85137581 171928773/272500658) #t)
+(test (> 665/1054 12941/20511) #t)
+(test (> 7161071/11350029 10400200/16483927) #t)
+(test (> 79335/125743 190537/301994) #f)
+
+(when with-bignums
+  (test (> (* 4201378396/6659027209 1.0) (* 6189245291/9809721694 1.0)) #t)
+  (test (> (* 4201378396/6659027209 1.0) 6189245291/9809721694) #t)
+  (test (> 10.000000000 9.999999999999999) #t)
+  (test (> 12345678901234567890 12345678901234567891) #f)
+  (test (> 9007199254740993.0 9007199254740992.0) #t)
+  (test (> 1267650600228229401496703205376) 'error)
+
+  (test (> 355/113 3587785776203/1142027682075 21053343141/6701487259) #t)
+  (test (> 3587785776203/1142027682075 21053343141/6701487259 4272943/1360120) #t)
+  (test (> 22/7 2646693125139304345/842468587426513207 21053343141/6701487259) #t)
+  (test (> 2646693125139304345/842468587426513207 21053343141/6701487259 4272943/1360120) #t)
+  (test (> 2646693125139304345/842468587426513207 3587785776203/1142027682075 21053343141/6701487259 4272943/1360120) #t)
+  (test (> 3587785776203/1142027682075 21053343141/6701487259 4272943/1360120) #t)
+  (test (> 2646693125139304345/842468587426513207 21053343141/6701487259 4272943/1360120) #t)
+  (test (> 2646693125139304345/842468587426513207 3587785776203/1142027682075 21053343141/6701487259) #t)
+  (test (> 3587785776203/1142027682075 21053343141/6701487259) #t)
+  (test (> 2646693125139304345/842468587426513207 21053343141/6701487259) #t))
+
+(for-each
+ (lambda (arg)
+   (test (> arg +nan.0) 'error)
+   (test (> +nan.0 arg) 'error)
+   (test (> arg +inf.0) 'error)
+   (test (> +inf.0 arg) 'error)
+   (test (> 0 1 arg) 'error)
+   (test (> 1 arg) 'error)
+   (test (> 1/2 arg) 'error)
+   (test (> 1.0 arg) 'error)
+   (test (> 1+i arg) 'error)
+   (test (> arg 1) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; >=
+;;; --------------------------------------------------------------------------------
+
+(test (>= 0 1 1) #f)
+(test (>= 0 1 1.0) #f)
+(test (>= 0 1 1/1) #f)
+(test (>= 0 1 123.4) #f)
+(test (>= 0 1 1234) #f)
+(test (>= 0 1 1234/11) #f)
+(test (>= 0 1) #f)
+(test (>= 0 1.0 1) #f)
+(test (>= 0 1.0 1.0) #f)
+(test (>= 0 1.0 1/1) #f)
+(test (>= 0 1.0 123.4) #f)
+(test (>= 0 1.0 1234) #f)
+(test (>= 0 1.0 1234/11) #f)
+(test (>= 0 1.0) #f)
+(test (>= 0 123.4) #f)
+(test (>= 0 1234) #f)
+(test (>= 0 1234/11) #f)
+(test (>= 0.0 1 1) #f)
+(test (>= 0.0 1 1.0) #f)
+(test (>= 0.0 1 1/1) #f)
+(test (>= 0.0 1 123.4) #f)
+(test (>= 0.0 1 1234) #f)
+(test (>= 0.0 1 1234/11) #f)
+(test (>= 0.0 1) #f)
+(test (>= 0.0 1.0 1) #f)
+(test (>= 0.0 1.0 1.0) #f)
+(test (>= 0.0 1.0 1/1) #f)
+(test (>= 0.0 1.0 123.4) #f)
+(test (>= 0.0 1.0 1234) #f)
+(test (>= 0.0 1.0 1234/11) #f)
+(test (>= 0.0 1.0) #f)
+(test (>= 0.0 123.4 1) #f)
+(test (>= 0.0 123.4 1.0) #f)
+(test (>= 0.0 123.4 1/1) #f)
+(test (>= 0.0 123.4 123.4) #f)
+(test (>= 0.0 123.4 1234) #f)
+(test (>= 0.0 123.4 1234/11) #f)
+(test (>= 0.0 123.4) #f)
+(test (>= 0.0 1234 1) #f)
+(test (>= 0.0 1234 1.0) #f)
+(test (>= 0.0 1234 1/1) #f)
+(test (>= 0.0 1234 123.4) #f)
+(test (>= 0.0 1234 1234) #f)
+(test (>= 0.0 1234 1234/11) #f)
+(test (>= 0.0 1234) #f)
+(test (>= 0.0 1234/11 1) #f)
+(test (>= 0.0 1234/11 1.0) #f)
+(test (>= 0.0 1234/11 1/1) #f)
+(test (>= 0.0 1234/11 123.4) #f)
+(test (>= 0.0 1234/11 1234) #f)
+(test (>= 0.0 1234/11 1234/11) #f)
+(test (>= 0.0 1234/11) #f)
+(test (>= 1 1 1) #t)
+(test (>= 1 1 1.0) #t)
+(test (>= 1 1 1/1) #t)
+(test (>= 1 1 123.4) #f)
+(test (>= 1 1 1234) #f)
+(test (>= 1 1 1234/11) #f)
+(test (>= 1 1) #t)
+(test (>= 1 1.0 1) #t)
+(test (>= 1 1.0 1.0) #t)
+(test (>= 1 1.0 1/1) #t)
+(test (>= 1 1.0 123.4) #f)
+(test (>= 1 1.0 1234) #f)
+(test (>= 1 1.0 1234/11) #f)
+(test (>= 1 1.0) #t)
+(test (>= 1 123.4) #f)
+(test (>= 1 1234) #f)
+(test (>= 1 1234/11) #f)
+(test (>= 1.0 1 1) #t)
+(test (>= 1.0 1 1.0) #t)
+(test (>= 1.0 1 1/1) #t)
+(test (>= 1.0 1 123.4) #f)
+(test (>= 1.0 1 1234) #f)
+(test (>= 1.0 1 1234/11) #f)
+(test (>= 1.0 1) #t)
+(test (>= 1.0 1.0 1) #t)
+(test (>= 1.0 1.0 1.0) #t)
+(test (>= 1.0 1.0 1/1) #t)
+(test (>= 1.0 1.0 123.4) #f)
+(test (>= 1.0 1.0 1234) #f)
+(test (>= 1.0 1.0 1234/11) #f)
+(test (>= 1.0 1.0) #t)
+(test (>= 1.0 1/1 1) #t)
+(test (>= 1.0 123.4 1) #f)
+(test (>= 1.0 123.4 1.0) #f)
+(test (>= 1.0 123.4 1/1) #f)
+(test (>= 1.0 123.4 123.4) #f)
+(test (>= 1.0 123.4 1234) #f)
+(test (>= 1.0 123.4 1234/11) #f)
+(test (>= 1.0 123.4) #f)
+(test (>= 1.0 1234 1) #f)
+(test (>= 1.0 1234 1.0) #f)
+(test (>= 1.0 1234 1/1) #f)
+(test (>= 1.0 1234 123.4) #f)
+(test (>= 1.0 1234 1234) #f)
+(test (>= 1.0 1234 1234/11) #f)
+(test (>= 1.0 1234) #f)
+(test (>= 1.0 1234/11 1) #f)
+(test (>= 1.0 1234/11 1.0) #f)
+(test (>= 1.0 1234/11 1/1) #f)
+(test (>= 1.0 1234/11 123.4) #f)
+(test (>= 1.0 1234/11 1234) #f)
+(test (>= 1.0 1234/11 1234/11) #f)
+(test (>= 1.0 1234/11) #f)
+(test (>= 123.4 1 1) #t)
+(test (>= 123.4 1 1.0) #t)
+(test (>= 123.4 1 1/1) #t)
+(test (>= 123.4 1 123.4) #f)
+(test (>= 123.4 1 1234) #f)
+(test (>= 123.4 1 1234/11) #f)
+(test (>= 123.4 1) #t)
+(test (>= 123.4 1.0 1) #t)
+(test (>= 123.4 1.0 1.0) #t)
+(test (>= 123.4 1.0 1/1) #t)
+(test (>= 123.4 1.0 123.4) #f)
+(test (>= 123.4 1.0 1234) #f)
+(test (>= 123.4 1.0 1234/11) #f)
+(test (>= 123.4 1.0) #t)
+(test (>= 123.4 123.4 1) #t)
+(test (>= 123.4 123.4 1.0) #t)
+(test (>= 123.4 123.4 1/1) #t)
+(test (>= 123.4 123.4 123.4) #t)
+(test (>= 123.4 123.4 1234) #f)
+(test (>= 123.4 123.4 1234/11) #t)
+(test (>= 123.4 123.4) #t)
+(test (>= 123.4 1234 1) #f)
+(test (>= 123.4 1234 1.0) #f)
+(test (>= 123.4 1234 1/1) #f)
+(test (>= 123.4 1234 123.4) #f)
+(test (>= 123.4 1234 1234) #f)
+(test (>= 123.4 1234 1234/11) #f)
+(test (>= 123.4 1234) #f)
+(test (>= 123.4 1234/11 1) #t)
+(test (>= 123.4 1234/11 1.0) #t)
+(test (>= 123.4 1234/11 1/1) #t)
+(test (>= 123.4 1234/11 123.4) #f)
+(test (>= 123.4 1234/11 1234) #f)
+(test (>= 123.4 1234/11 1234/11) #t)
+(test (>= 123.4 1234/11) #t)
+(test (>= 1234 1) #t)
+(test (>= 1234 1.0) #t)
+(test (>= 1234 1/1) #t)
+(test (>= 1234 123.4) #t)
+(test (>= 1234 1234) #t)
+(test (>= 1234 1234/11) #t)
+(test (>= 1234/11 1) #t)
+(test (>= 1234/11 1.0) #t)
+(test (>= 1234/11 1/1) #t)
+(test (>= 1234/11 123.4) #f)
+(test (>= 1234/11 1234) #f)
+(test (>= 1234/11 1234/11) #t)
+
+(test (>= 0+i 0+i) 'error) ;??
+(test (>= 1 0+i) 'error)
+(test (>= 1 0-i) 'error)
+(test (>= 1 1 2) #f)
+(test (>= 1 2 #\a) 'error)
+(test (>= 1 3 2) #f)
+(test (>= 1+i 0+i) 'error)
+(test (>= 1+i 0-i) 'error)
+(test (>= +nan.0 1+i) 'error)
+(test (>= +nan.0 1 1+i) 'error)
+(test (>= 1 +nan.0 1+i) 'error)
+(test (>= +inf.0 1+i) 'error)
+(test (>= +inf.0 +nan.0 0-i 1) 'error)
+(test (>= 2 1+0/2i) #t)
+(test (>= 2 1+0i) #t)
+(test (>= 2 1-0i) #t)
+(test (>= 3 -4 -6246) #t)
+(test (>= 8 9) #f)
+(test (>= 9 9) #t)
+
+(test (>= -5 -4 -2 0 4 5) #f)
+(test (>= 0) 'error)
+(test (>=) 'error)
+(test (>= 0.0) 'error)
+(test (>= 0.0+0.00000001i) 'error)
+(test (>= 0/1) 'error)
+(test (>= 1 2 #\a) 'error)
+(test (>= 1 2 1.0+1.0i) 'error)
+(test (>= 1.0) 'error)
+(test (>= 1.0+1.0i) 'error)
+(test (>= 10/3) 'error)
+(test (>= 2) 'error)
+(test (>= 4 3 1 2 0) #f)
+(test (>= 4 3 2 1 0) #t)
+(test (>= 4 3 3 2 0) #t)
+(test (>= 4 3) #t)
+(test (>= -1.797693134862315699999999999999999999998E308 -9223372036854775808) #f)
+(test (>= -9223372036854775808 -9223372036854775808) #t)
+(test (>= -9223372036854775808 5.551115123125783999999999999999999999984E-17) #f)
+(test (>= -9223372036854775808 9223372036854775807 -9223372036854775808) #f)
+(test (>= 1.110223024625156799999999999999999999997E-16 -9223372036854775808) #t)
+(test (>= 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) #t)
+(test (>= 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) #f)
+(test (>= 9223372036854775807 -9223372036854775808) #t)
+(test (>= 9223372036854775807 9223372036854775807) #t)
+
+(test (>= -1 -9223372036854775807 -1/9223372036854775807) #f)
+(test (>= -9223372036854775807 -1/9223372036854775807 -1) #f)
+(test (>= -9223372036854775807 -1/9223372036854775807) #f)
+(test (>= 1 -1 -9223372036854775807 -1/9223372036854775807) #f)
+(test (>= 1 -9223372036854775807 -1/9223372036854775807 -1) #f)
+(test (>= 1 -9223372036854775807 -1/9223372036854775807) #f)
+(test (>= 1 1.0 1/9223372036 9223372036) #f)
+(test (>= 1 1.0 1/922337203685 922337203685) #f)
+(test (>= 1 1/9223372036 9223372036 1.0) #f)
+(test (>= 1 1/9223372036 9223372036) #f)
+(test (>= 1 1/922337203685 922337203685 1.0) #f)
+(test (>= 1 1/922337203685 922337203685) #f)
+(test (>= 1 1/9223372036854775807 9223372036854775807 -1) #f)
+(test (>= 1 1/9223372036854775807 9223372036854775807) #f)
+(test (>= 1.0 1 1/9223372036 9223372036) #f)
+(test (>= 1.0 1 1/922337203685 922337203685) #f)
+(test (>= 1.0 1/9223372036 9223372036 1) #f)
+(test (>= 1.0 1/9223372036 9223372036) #f)
+(test (>= 1.0 1/922337203685 922337203685 1) #f)
+(test (>= 1.0 1/922337203685 922337203685) #f)
+(test (>= 1/9223372036 9223372036 1 1.0) #f)
+(test (>= 1/9223372036 9223372036 1) #f)
+(test (>= 1/9223372036 9223372036 1.0 1) #f)
+(test (>= 1/9223372036 9223372036 1.0) #f)
+(test (>= 1/9223372036 9223372036) #f)
+(test (>= 1/922337203685 922337203685 1 1.0) #f)
+(test (>= 1/922337203685 922337203685 1) #f)
+(test (>= 1/922337203685 922337203685 1.0 1) #f)
+(test (>= 1/922337203685 922337203685 1.0) #f)
+(test (>= 1/922337203685 922337203685) #f)
+(test (>= 1/9223372036854775807 9223372036854775807 -1) #f)
+(test (>= 1/9223372036854775807 9223372036854775807 1 -1) #f)
+(test (>= 1/9223372036854775807 9223372036854775807 1) #f)
+(test (>= 1/9223372036854775807 9223372036854775807) #f)
+(test (>= 9223372036 1/9223372036) #t)
+(test (>= 922337203685 1/922337203685) #t)
+(test (>= 1 1.0 9223372036854775807/9223372036854775806 9223372036854775806/9223372036854775807) #f)
+(test (>= 1 1.0 9223372036854775807/9223372036854775806) #f)
+(test (>= 1 9223372036854775806/9223372036854775807 1.0 9223372036854775807/9223372036854775806) #f)
+(test (>= 1 9223372036854775806/9223372036854775807 1.0) #f)
+(test (>= 1.0 9223372036854775807/9223372036854775806 1 9223372036854775806/9223372036854775807) #f)
+(test (>= 1.0 9223372036854775807/9223372036854775806 1) #f)
+(test (>= 1.0 9223372036854775807/9223372036854775806 9223372036854775806/9223372036854775807) #f)
+(test (>= 1.0 9223372036854775807/9223372036854775806) #f)
+(test (>= 9223372036854775806/9223372036854775807 1.0 1) #f)
+(test (>= 9223372036854775806/9223372036854775807 1.0 9223372036854775807/9223372036854775806 1) #f)
+(test (>= 9223372036854775806/9223372036854775807 1.0 9223372036854775807/9223372036854775806) #f)
+(test (>= 9223372036854775806/9223372036854775807 1.0) #f)
+(test (>= 9223372036854775807/9223372036854775806 1 9223372036854775806/9223372036854775807 1.0) #f)
+(test (>= 9223372036854775807/9223372036854775806 9223372036854775806/9223372036854775807 1.0 1) #f)
+(test (>= 9223372036854775807/9223372036854775806 9223372036854775806/9223372036854775807 1.0) #f)
+
+(when with-bignums
+  (test (>= 12345678901234567890 12345678901234567891) #f)
+  (test (>= 1267650600228229401496703205376) 'error)
+  (test (let () (define (func) (>= (bignum +nan.0) 10001)) (define (hi) (func)) (hi)) #f)
+  (test (let () (define (func) (>= (bignum +nan.0) 0+i)) (define (hi) (func)) (hi)) 'error)
+
+  (test (>= 21053343141/6701487259 2646693125139304345/842468587426513207 3587785776203/1142027682075 4272943/1360120) #f)
+  (test (>= 21053343141/6701487259 3587785776203/1142027682075 4272943/1360120) #f)
+  (test (>= 3587785776203/1142027682075 2646693125139304345/842468587426513207 4272943/1360120) #f)
+  (test (>= 21053343141/6701487259 2646693125139304345/842468587426513207 3587785776203/1142027682075) #f)
+  (test (>= 21053343141/6701487259 3587785776203/1142027682075 2646693125139304345/842468587426513207) #f)
+  (test (>= 21053343141/6701487259 3587785776203/1142027682075) #f)
+  (test (>= 21053343141/6701487259 2646693125139304345/842468587426513207) #f)
+  (test (>= 3587785776203/1142027682075 2646693125139304345/842468587426513207) #f)
+  (test (>= 22/7 21053343141/6701487259 2646693125139304345/842468587426513207 4272943/1360120) #f)
+  (test (>= 21053343141/6701487259 2646693125139304345/842468587426513207 4272943/1360120) #f)
+  (test (>= 21053343141/6701487259 2646693125139304345/842468587426513207) #f)
+  (test (>= 355/113 21053343141/6701487259 3587785776203/1142027682075) #f)
+  (test (>= 21053343141/6701487259 3587785776203/1142027682075 4272943/1360120) #f))
+
+(test (>= - 1 2) 'error)
+(test (>=- 1 2) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (>= arg +nan.0) 'error)
+   (test (>= +nan.0 arg) 'error)
+   (test (>= arg +inf.0) 'error)
+   (test (>= +inf.0 arg) 'error)
+   (test (>= 0 1 arg) 'error)
+   (test (>= 1 arg) 'error)
+   (test (>= 1/2 arg) 'error)
+   (test (>= 1.0 arg) 'error)
+   (test (>= 1+i arg) 'error)
+   (test (>= arg 1) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(for-each
+ (lambda (op)
+   (for-each
+    (lambda (arg1)
+      (test (op arg1) 'error)
+      (test (op 0 arg1) 'error)
+      (test (op 0.0 arg1) 'error)
+      (for-each
+       (lambda (arg2)
+	 (test (op arg1 arg2) 'error))
+       (list "hi" () 1 1.5 3/2 1+i (cons 1 2) (list 1 2) #\a 'a-symbol #(1) abs #f (lambda (a) (+ a 1)) #<unspecified> :hi #<eof> #<undefined>)))
+    (list "hi" () (cons 1 2) (list 1 2) #\a 'a-symbol #(1) abs #f (lambda (a) (+ a 1)) #<unspecified> :hi #<eof> #<undefined>)))
+ (list + - * / > < >= <= ))
+
+(for-each
+ (lambda (op)
+   (let ((val1 (catch #t (lambda () (op 1.0)) (lambda args 'error)))
+	 (val2 (catch #t (lambda () (op 1.0+0i)) (lambda args 'error))))
+     (if (not (equivalent? val1 val2)) ; ignore nans
+	 (format #t ";(~A 1) != (~A 1+0i)? (~A ~A)~%" op op val1 val2))))
+ (list magnitude angle rationalize abs exp log sin cos tan asin acos atan
+       sinh cosh tanh asinh acosh atanh sqrt floor ceiling truncate round + - * /
+       max min number? integer? real? complex? rational?
+       even? odd? zero? positive? negative? real-part imag-part numerator denominator))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; sin
+;;; --------------------------------------------------------------------------------
+
+(num-test (sin -0.0+0.00000001i) 0.0+0.00000001i)
+(num-test (sin -0.0+0.0i) 0.0)
+(num-test (sin -0.0+1.0i) 0.0+1.17520119364380i)
+(num-test (sin -0.0+3.14159265358979i) 0.0+11.54873935725775i)
+(num-test (sin -0.0-0.00000001i) -0.0-0.00000001i)
+(num-test (sin -0.0-0.0i) 0.0)
+(num-test (sin -0.0-1.0i) -0.0-1.17520119364380i)
+(num-test (sin -0.0-3.14159265358979i) -0.0-11.54873935725775i)
+(num-test (sin -0.00000001) -0.00000001)
+(num-test (sin -0.00000001+0.00000001i) -0.00000001+0.00000001i)
+(num-test (sin -0.00000001+0.0i) -0.00000001)
+(num-test (sin -0.00000001+1.0i) -0.00000001543081+1.17520119364380i)
+(num-test (sin -0.00000001+3.14159265358979i) -0.00000011591953+11.54873935725775i)
+(num-test (sin -0.00000001-0.00000001i) -0.00000001-0.00000001i)
+(num-test (sin -0.00000001-0.0i) -0.00000001)
+(num-test (sin -0.00000001-1.0i) -0.00000001543081-1.17520119364380i)
+(num-test (sin -0.00000001-3.14159265358979i) -0.00000011591953-11.54873935725775i)
+(num-test (sin -1) -0.84147098480790)
+(num-test (sin -1.0) -0.84147098480790)
+(num-test (sin -1.0+0.00000001i) -0.84147098480790+0.00000000540302i)
+(num-test (sin -1.0+0.0i) -0.84147098480790)
+(num-test (sin -1.0+1.0i) -1.29845758141598+0.63496391478474i)
+(num-test (sin -1.0+3.14159265358979i) -9.75429233860021+6.23981050459650i)
+(num-test (sin -1.0-0.00000001i) -0.84147098480790-0.00000000540302i)
+(num-test (sin -1.0-0.0i) -0.84147098480790)
+(num-test (sin -1.0-1.0i) -1.29845758141598-0.63496391478474i)
+(num-test (sin -1.0-3.14159265358979i) -9.75429233860021-6.23981050459650i)
+(num-test (sin -1.57045105981189525579e+00+0.0e+00i) -9.9999994039535581669e-1)
+(num-test (sin -1.57045105981189525579e+00+1.0e+00i) -1.5430805428404715942e0+4.0575816248730593018e-4i)
+(num-test (sin -1.57045105981189525579e+00+1.19209289550781250e-07i) -9.9999994039536292211e-1+4.1159030931177815679e-11i)
+(num-test (sin -1.57045105981189525579e+00+2.0e+00i) -3.7621954668392959445e0+1.2522351259047577385e-3i)
+(num-test (sin -1.57045105981189525579e+00+5.0e-01i) -1.1276258979946363572e0+1.7991700040937027667e-4i)
+(num-test (sin -1.57045105981189525579e+00-1.0e+00i) -1.5430805428404715942e0-4.0575816248730593018e-4i)
+(num-test (sin -1.57045105981189525579e+00-1.19209289550781250e-07i) -9.9999994039536292211e-1-4.1159030931177815679e-11i)
+(num-test (sin -1.57045105981189525579e+00-2.0e+00i) -3.7621954668392959445e0-1.2522351259047577385e-3i)
+(num-test (sin -1.57045105981189525579e+00-5.0e-01i) -1.1276258979946363572e0-1.7991700040937027667e-4i)
+(num-test (sin -1.57114159377789786021e+00+0.0e+00i) -9.9999994039535581673e-1)
+(num-test (sin -1.57114159377789786021e+00+1.0e+00i) -1.5430805428404715942e0-4.0575816248716200955e-4i)
+(num-test (sin -1.57114159377789786021e+00+1.19209289550781250e-07i) -9.9999994039536292216e-1-4.1159030931163216752e-11i)
+(num-test (sin -1.57114159377789786021e+00+2.0e+00i) -3.7621954668392959447e0-1.2522351259043135762e-3i)
+(num-test (sin -1.57114159377789786021e+00+5.0e-01i) -1.1276258979946363573e0-1.7991700040930646090e-4i)
+(num-test (sin -1.57114159377789786021e+00-1.0e+00i) -1.5430805428404715942e0+4.0575816248716200955e-4i)
+(num-test (sin -1.57114159377789786021e+00-1.19209289550781250e-07i) -9.9999994039536292216e-1+4.1159030931163216752e-11i)
+(num-test (sin -1.57114159377789786021e+00-2.0e+00i) -3.7621954668392959447e0+1.2522351259043135762e-3i)
+(num-test (sin -1.57114159377789786021e+00-5.0e-01i) -1.1276258979946363573e0+1.7991700040930646090e-4i)
+(num-test (sin -1/1) -0.84147098480790)
+(num-test (sin -1/10) -0.09983341664683)
+(num-test (sin -1/1234) -0.00081037268278)
+(num-test (sin -1/1234000000) -0.00000000081037)
+(num-test (sin -1/2) -0.47942553860420)
+(num-test (sin -1/3) -0.32719469679615)
+(num-test (sin -1/500029) -0.00000199988401)
+(num-test (sin -10/1234) -0.00810363901920)
+(num-test (sin -10/1234000000) -0.00000000810373)
+(num-test (sin -10/500029) -0.00001999884007)
+(num-test (sin -1234/500029) -0.00246785435930)
+(num-test (sin -1234000000/1234000000) -0.84147098480790)
+(num-test (sin -2) -0.90929742682568)
+(num-test (sin -2.225073858507201399999999999999999999996E-308) -2.225073858507201399999999999999999999996E-308)
+(num-test (sin -2/1) -0.90929742682568)
+(num-test (sin -2/10) -0.19866933079506)
+(num-test (sin -2/1234) -0.00162074483338)
+(num-test (sin -2/1234000000) -0.00000000162075)
+(num-test (sin -2/3) -0.61836980306974)
+(num-test (sin -2/500029) -0.00000399976801)
+(num-test (sin -3.14124738660679181379e+00+0.0e+00i) -3.4526697614158608860e-4)
+(num-test (sin -3.14124738660679181379e+00+1.0e+00i) -5.3277478472529828958e-4-1.1752011235963524659e0i)
+(num-test (sin -3.14124738660679181379e+00+1.19209289550781250e-07i) -3.4526697614158854187e-4-1.1920928244535424532e-7i)
+(num-test (sin -3.14124738660679181379e+00+2.0e+00i) -1.2989619299133501696e-3-3.6268601916692946553e0i)
+(num-test (sin -3.14124738660679181379e+00+5.0e-01i) -3.8933200722554445944e-4-5.2109527443404709206e-1i)
+(num-test (sin -3.14124738660679181379e+00-1.0e+00i) -5.3277478472529828958e-4+1.1752011235963524659e0i)
+(num-test (sin -3.14124738660679181379e+00-1.19209289550781250e-07i) -3.4526697614158854187e-4+1.1920928244535424532e-7i)
+(num-test (sin -3.14124738660679181379e+00-2.0e+00i) -1.2989619299133501696e-3+3.6268601916692946553e0i)
+(num-test (sin -3.14124738660679181379e+00-5.0e-01i) -3.8933200722554445944e-4+5.2109527443404709206e-1i)
+(num-test (sin -3.14193792057279441821e+00+0.0e+00i) 3.4526697614134115926e-4)
+(num-test (sin -3.14193792057279441821e+00+1.0e+00i) 5.3277478472492034385e-4-1.1752011235963524660e0i)
+(num-test (sin -3.14193792057279441821e+00+1.19209289550781250e-07i) 3.4526697614134361253e-4-1.1920928244535424533e-7i)
+(num-test (sin -3.14193792057279441821e+00+2.0e+00i) 1.2989619299124286975e-3-3.6268601916692946556e0i)
+(num-test (sin -3.14193792057279441821e+00+5.0e-01i) 3.8933200722526827075e-4-5.2109527443404709211e-1i)
+(num-test (sin -3.14193792057279441821e+00-1.0e+00i) 5.3277478472492034385e-4+1.1752011235963524660e0i)
+(num-test (sin -3.14193792057279441821e+00-1.19209289550781250e-07i) 3.4526697614134361253e-4+1.1920928244535424533e-7i)
+(num-test (sin -3.14193792057279441821e+00-2.0e+00i) 1.2989619299124286975e-3+3.6268601916692946556e0i)
+(num-test (sin -3.14193792057279441821e+00-5.0e-01i) 3.8933200722526827075e-4+5.2109527443404709211e-1i)
+(num-test (sin -3.45266983001243932001e-04+0.0e+00i) -3.4526697614140534807e-4)
+(num-test (sin -3.45266983001243932001e-04+1.0e+00i) -5.3277478472501939236e-4+1.1752011235963524660e0i)
+(num-test (sin -3.45266983001243932001e-04+1.19209289550781250e-07i) -3.4526697614140780134e-4+1.1920928244535424533e-7i)
+(num-test (sin -3.45266983001243932001e-04+2.0e+00i) -1.2989619299126701883e-3+3.6268601916692946556e0i)
+(num-test (sin -3.45266983001243932001e-04+5.0e-01i) -3.8933200722534065172e-4+5.2109527443404709209e-1i)
+(num-test (sin -3.45266983001243932001e-04-1.0e+00i) -5.3277478472501939236e-4-1.1752011235963524660e0i)
+(num-test (sin -3.45266983001243932001e-04-1.19209289550781250e-07i) -3.4526697614140780134e-4-1.1920928244535424533e-7i)
+(num-test (sin -3.45266983001243932001e-04-2.0e+00i) -1.2989619299126701883e-3-3.6268601916692946556e0i)
+(num-test (sin -3.45266983001243932001e-04-5.0e-01i) -3.8933200722534065172e-4-5.2109527443404709209e-1i)
+(num-test (sin -3/10) -0.29552020666134)
+(num-test (sin -3/1234) -0.00243111591964)
+(num-test (sin -3/1234000000) -0.00000000243112)
+(num-test (sin -3/2) -0.99749498660405)
+(num-test (sin -3/500029) -0.00000599965202)
+(num-test (sin -4.71204371340168837179e+00+0.0e+00i) 9.9999994039535581664e-1)
+(num-test (sin -4.71204371340168837179e+00+1.0e+00i) 1.5430805428404715941e0-4.0575816248744985081e-4i)
+(num-test (sin -4.71204371340168837179e+00+1.19209289550781250e-07i) 9.9999994039536292207e-1-4.1159030931192414605e-11i)
+(num-test (sin -4.71204371340168837179e+00+2.0e+00i) 3.7621954668392959444e0-1.2522351259052019007e-3i)
+(num-test (sin -4.71204371340168837179e+00+5.0e-01i) 1.1276258979946363572e0-1.7991700040943409243e-4i)
+(num-test (sin -4.71204371340168837179e+00-1.0e+00i) 1.5430805428404715941e0+4.0575816248744985081e-4i)
+(num-test (sin -4.71204371340168837179e+00-1.19209289550781250e-07i) 9.9999994039536292207e-1+4.1159030931192414605e-11i)
+(num-test (sin -4.71204371340168837179e+00-2.0e+00i) 3.7621954668392959444e0+1.2522351259052019007e-3i)
+(num-test (sin -4.71204371340168837179e+00-5.0e-01i) 1.1276258979946363572e0+1.7991700040943409243e-4i)
+(num-test (sin -4.71273424736769097620e+00+0.0e+00i) 9.9999994039535581677e-1)
+(num-test (sin -4.71273424736769097620e+00+1.0e+00i) 1.5430805428404715943e0+4.0575816248701808892e-4i)
+(num-test (sin -4.71273424736769097620e+00+1.19209289550781250e-07i) 9.9999994039536292220e-1+4.1159030931148617825e-11i)
+(num-test (sin -4.71273424736769097620e+00+2.0e+00i) 3.7621954668392959448e0+1.2522351259038694139e-3i)
+(num-test (sin -4.71273424736769097620e+00+5.0e-01i) 1.1276258979946363573e0+1.7991700040924264514e-4i)
+(num-test (sin -4.71273424736769097620e+00-1.0e+00i) 1.5430805428404715943e0-4.0575816248701808892e-4i)
+(num-test (sin -4.71273424736769097620e+00-1.19209289550781250e-07i) 9.9999994039536292220e-1-4.1159030931148617825e-11i)
+(num-test (sin -4.71273424736769097620e+00-2.0e+00i) 3.7621954668392959448e0-1.2522351259038694139e-3i)
+(num-test (sin -4.71273424736769097620e+00-5.0e-01i) 1.1276258979946363573e0-1.7991700040924264514e-4i)
+(num-test (sin -500029/1234000000) -0.00040520987546)
+(num-test (sin -6.28284004019658492979e+00+0.0e+00i) 3.4526697614170855328e-4)
+(num-test (sin -6.28284004019658492979e+00+1.0e+00i) 5.3277478472548726245e-4+1.1752011235963524659e0i)
+(num-test (sin -6.28284004019658492979e+00+1.19209289550781250e-07i) 3.4526697614171100655e-4+1.1920928244535424532e-7i)
+(num-test (sin -6.28284004019658492979e+00+2.0e+00i) 1.2989619299138109057e-3+3.6268601916692946552e0i)
+(num-test (sin -6.28284004019658492979e+00+5.0e-01i) 3.8933200722568255379e-4+5.2109527443404709204e-1i)
+(num-test (sin -6.28284004019658492979e+00-1.0e+00i) 5.3277478472548726245e-4-1.1752011235963524659e0i)
+(num-test (sin -6.28284004019658492979e+00-1.19209289550781250e-07i) 3.4526697614171100655e-4-1.1920928244535424532e-7i)
+(num-test (sin -6.28284004019658492979e+00-2.0e+00i) 1.2989619299138109057e-3-3.6268601916692946552e0i)
+(num-test (sin -6.28284004019658492979e+00-5.0e-01i) 3.8933200722568255379e-4-5.2109527443404709204e-1i)
+(num-test (sin -6.28353057416258753420e+00+0.0e+00i) -3.4526697614121869459e-4)
+(num-test (sin -6.28353057416258753420e+00+1.0e+00i) -5.3277478472473137099e-4+1.1752011235963524661e0i)
+(num-test (sin -6.28353057416258753420e+00+1.19209289550781250e-07i) -3.4526697614122114786e-4+1.1920928244535424534e-7i)
+(num-test (sin -6.28353057416258753420e+00+2.0e+00i) -1.2989619299119679614e-3+3.6268601916692946558e0i)
+(num-test (sin -6.28353057416258753420e+00+5.0e-01i) -3.8933200722513017641e-4+5.2109527443404709213e-1i)
+(num-test (sin -6.28353057416258753420e+00-1.0e+00i) -5.3277478472473137099e-4-1.1752011235963524661e0i)
+(num-test (sin -6.28353057416258753420e+00-1.19209289550781250e-07i) -3.4526697614122114786e-4-1.1920928244535424534e-7i)
+(num-test (sin -6.28353057416258753420e+00-2.0e+00i) -1.2989619299119679614e-3-3.6268601916692946558e0i)
+(num-test (sin -6.28353057416258753420e+00-5.0e-01i) -3.8933200722513017641e-4-5.2109527443404709213e-1i)
+(num-test (sin -9.42443269378637893396e+00+0.0e+00i) -3.4526697614094283958e-4)
+(num-test (sin -9.42443269378637893396e+00+1.0e+00i) -5.3277478472430570447e-4-1.1752011235963524662e0i)
+(num-test (sin -9.42443269378637893396e+00+1.19209289550781250e-07i) -3.4526697614094529285e-4-1.1920928244535424535e-7i)
+(num-test (sin -9.42443269378637893396e+00+2.0e+00i) -1.2989619299109301409e-3-3.6268601916692946561e0i)
+(num-test (sin -9.42443269378637893396e+00+5.0e-01i) -3.8933200722481911514e-4-5.2109527443404709218e-1i)
+(num-test (sin -9.42443269378637893396e+00-1.0e+00i) -5.3277478472430570447e-4+1.1752011235963524662e0i)
+(num-test (sin -9.42443269378637893396e+00-1.19209289550781250e-07i) -3.4526697614094529285e-4+1.1920928244535424535e-7i)
+(num-test (sin -9.42443269378637893396e+00-2.0e+00i) -1.2989619299109301409e-3+3.6268601916692946561e0i)
+(num-test (sin -9.42443269378637893396e+00-5.0e-01i) -3.8933200722481911514e-4+5.2109527443404709218e-1i)
+(num-test (sin -9.42512322775237976202e+00+0.0e+00i) 3.4526697614020805155e-4)
+(num-test (sin -9.42512322775237976202e+00+1.0e+00i) 5.3277478472317186729e-4-1.1752011235963524665e0i)
+(num-test (sin -9.42512322775237976202e+00+1.19209289550781250e-07i) 3.4526697614021050482e-4-1.1920928244535424538e-7i)
+(num-test (sin -9.42512322775237976202e+00+2.0e+00i) 1.2989619299081657245e-3-3.6268601916692946571e0i)
+(num-test (sin -9.42512322775237976202e+00+5.0e-01i) 3.8933200722399054908e-4-5.2109527443404709231e-1i)
+(num-test (sin -9.42512322775237976202e+00-1.0e+00i) 5.3277478472317186729e-4+1.1752011235963524665e0i)
+(num-test (sin -9.42512322775237976202e+00-1.19209289550781250e-07i) 3.4526697614021050482e-4+1.1920928244535424538e-7i)
+(num-test (sin -9.42512322775237976202e+00-2.0e+00i) 1.2989619299081657245e-3+3.6268601916692946571e0i)
+(num-test (sin -9.42512322775237976202e+00-5.0e-01i) 3.8933200722399054908e-4+5.2109527443404709231e-1i)
+(num-test (sin 0) 0.0)
+(num-test (sin 0.0) 0.0)
+(num-test (sin 0.0+0.00000001i) 0.0+0.00000001i)
+(num-test (sin 0.0+0.0i) 0.0)
+(num-test (sin 0.0+1.0i) 0.0+1.17520119364380i)
+(num-test (sin 0.0+3.14159265358979i) 0.0+11.54873935725775i)
+(num-test (sin 0.0-0.00000001i) 0.0-0.00000001i)
+(num-test (sin 0.0-0.0i) 0.0)
+(num-test (sin 0.0-1.0i) 0.0-1.17520119364380i)
+(num-test (sin 0.0-3.14159265358979i) 0.0-11.54873935725775i)
+(num-test (sin 0.00000001) 0.00000001)
+(num-test (sin 0.00000001+0.00000001i) 0.00000001+0.00000001i)
+(num-test (sin 0.00000001+0.0i) 0.00000001)
+(num-test (sin 0.00000001+1.0i) 0.00000001543081+1.17520119364380i)
+(num-test (sin 0.00000001+3.14159265358979i) 0.00000011591953+11.54873935725775i)
+(num-test (sin 0.00000001-0.00000001i) 0.00000001-0.00000001i)
+(num-test (sin 0.00000001-0.0i) 0.00000001)
+(num-test (sin 0.00000001-1.0i) 0.00000001543081-1.17520119364380i)
+(num-test (sin 0.00000001-3.14159265358979i) 0.00000011591953-11.54873935725775i)
+(num-test (sin 0/1) 0.0)
+(num-test (sin 0/1234000000) 0.0)
+(num-test (sin 0/500029) 0.0)
+(num-test (sin 1) 0.84147098480790)
+(num-test (sin 1.0) 0.84147098480790)
+(num-test (sin 1.0+0.00000001i) 0.84147098480790+0.00000000540302i)
+(num-test (sin 1.0+0.0i) 0.84147098480790)
+(num-test (sin 1.0+1.0i) 1.29845758141598+0.63496391478474i)
+(num-test (sin 1.0+3.14159265358979i) 9.75429233860021+6.23981050459650i)
+(num-test (sin 1.0-0.00000001i) 0.84147098480790-0.00000000540302i)
+(num-test (sin 1.0-0.0i) 0.84147098480790)
+(num-test (sin 1.0-1.0i) 1.29845758141598-0.63496391478474i)
+(num-test (sin 1.0-3.14159265358979i) 9.75429233860021-6.23981050459650i)
+(num-test (sin 1.110223024625156799999999999999999999997E-16) 1.11022302462515679999999999999999771924E-16)
+(num-test (sin 1.57045105981189525579e+00+0.0e+00i) 9.9999994039535581669e-1)
+(num-test (sin 1.57045105981189525579e+00+1.0e+00i) 1.5430805428404715942e0+4.0575816248730593018e-4i)
+(num-test (sin 1.57045105981189525579e+00+1.19209289550781250e-07i) 9.9999994039536292211e-1+4.1159030931177815679e-11i)
+(num-test (sin 1.57045105981189525579e+00+2.0e+00i) 3.7621954668392959445e0+1.2522351259047577385e-3i)
+(num-test (sin 1.57045105981189525579e+00+5.0e-01i) 1.1276258979946363572e0+1.7991700040937027667e-4i)
+(num-test (sin 1.57045105981189525579e+00-1.0e+00i) 1.5430805428404715942e0-4.0575816248730593018e-4i)
+(num-test (sin 1.57045105981189525579e+00-1.19209289550781250e-07i) 9.9999994039536292211e-1-4.1159030931177815679e-11i)
+(num-test (sin 1.57045105981189525579e+00-2.0e+00i) 3.7621954668392959445e0-1.2522351259047577385e-3i)
+(num-test (sin 1.57045105981189525579e+00-5.0e-01i) 1.1276258979946363572e0-1.7991700040937027667e-4i)
+(num-test (sin 1.57114159377789786021e+00+0.0e+00i) 9.9999994039535581673e-1)
+(num-test (sin 1.57114159377789786021e+00+1.0e+00i) 1.5430805428404715942e0-4.0575816248716200955e-4i)
+(num-test (sin 1.57114159377789786021e+00+1.19209289550781250e-07i) 9.9999994039536292216e-1-4.1159030931163216752e-11i)
+(num-test (sin 1.57114159377789786021e+00+2.0e+00i) 3.7621954668392959447e0-1.2522351259043135762e-3i)
+(num-test (sin 1.57114159377789786021e+00+5.0e-01i) 1.1276258979946363573e0-1.7991700040930646090e-4i)
+(num-test (sin 1.57114159377789786021e+00-1.0e+00i) 1.5430805428404715942e0+4.0575816248716200955e-4i)
+(num-test (sin 1.57114159377789786021e+00-1.19209289550781250e-07i) 9.9999994039536292216e-1+4.1159030931163216752e-11i)
+(num-test (sin 1.57114159377789786021e+00-2.0e+00i) 3.7621954668392959447e0+1.2522351259043135762e-3i)
+(num-test (sin 1.57114159377789786021e+00-5.0e-01i) 1.1276258979946363573e0+1.7991700040930646090e-4i)
+(num-test (sin 1/1) 0.84147098480790)
+(num-test (sin 1/10) 0.09983341664683)
+(num-test (sin 1/1234) 0.00081037268278)
+(num-test (sin 1/1234000000) 0.00000000081037)
+(num-test (sin 1/2) 0.47942553860420)
+(num-test (sin 1/3) 0.32719469679615)
+(num-test (sin 1/500029) 0.00000199988401)
+(num-test (sin 10/1234) 0.00810363901920)
+(num-test (sin 10/1234000000) 0.00000000810373)
+(num-test (sin 10/3) -0.1905679628754527)
+(num-test (sin 10/500029) 0.00001999884007)
+(num-test (sin 1234.0+0.00000001i) .6019276547624973-7.985506235875843E-9i)
+(num-test (sin 1234.0+12.0i) 48983.30495194942-64983.97008730317i)
+(num-test (sin 1234.0+3.14159265358979i) 6.977517249251167-9.222253015388718i)
+(num-test (sin 1234/10) -0.7693905459455223)
+(num-test (sin 1234/3) 0.213644699569724)
+(num-test (sin 1234/500029) 0.00246785435930)
+(num-test (sin 1234000000.0+0.00000001i) -0.9872932128398908+1.5890913089022285E-9i)
+(num-test (sin 1234000000.0+3.14159265358979i) -11.44465679247962+1.835200134139553i)
+(num-test (sin 1234000000/1234000000) 0.84147098480790)
+(num-test (sin 1234000000/3) 9.98585468017658e-1)
+(num-test (sin 1234000000/500029) -0.9907886154453116)
+(num-test (sin 2) 0.90929742682568)
+(num-test (sin 2/10) 0.19866933079506)
+(num-test (sin 2/1234) 0.00162074483338)
+(num-test (sin 2/1234000000) 0.00000000162075)
+(num-test (sin 2/3) 0.61836980306974)
+(num-test (sin 2/500029) 0.00000399976801)
+(num-test (sin 3.14124738660679181379e+00+0.0e+00i) 3.4526697614158608860e-4)
+(num-test (sin 3.14124738660679181379e+00+1.0e+00i) 5.3277478472529828958e-4-1.1752011235963524659e0i)
+(num-test (sin 3.14124738660679181379e+00+1.19209289550781250e-07i) 3.4526697614158854187e-4-1.1920928244535424532e-7i)
+(num-test (sin 3.14124738660679181379e+00+2.0e+00i) 1.2989619299133501696e-3-3.6268601916692946553e0i)
+(num-test (sin 3.14124738660679181379e+00+5.0e-01i) 3.8933200722554445944e-4-5.2109527443404709206e-1i)
+(num-test (sin 3.14124738660679181379e+00-1.0e+00i) 5.3277478472529828958e-4+1.1752011235963524659e0i)
+(num-test (sin 3.14124738660679181379e+00-1.19209289550781250e-07i) 3.4526697614158854187e-4+1.1920928244535424532e-7i)
+(num-test (sin 3.14124738660679181379e+00-2.0e+00i) 1.2989619299133501696e-3+3.6268601916692946553e0i)
+(num-test (sin 3.14124738660679181379e+00-5.0e-01i) 3.8933200722554445944e-4+5.2109527443404709206e-1i)
+(num-test (sin 3.14159265358979+0.00000001i) -6.982889851335445E-15-1.0E-8i)
+(num-test (sin 3.14159265358979+0.0i) -6.982889851335445E-15)
+(num-test (sin 3.14159265358979+1.0i) -1.077516210464362E-14-1.175201193643801i)
+(num-test (sin 3.14159265358979+3.14159265358979i) -8.094533288479446E-14-11.54873935725783i)
+(num-test (sin 3.14193792057279441821e+00+0.0e+00i) -3.4526697614134115926e-4)
+(num-test (sin 3.14193792057279441821e+00+1.0e+00i) -5.3277478472492034385e-4-1.1752011235963524660e0i)
+(num-test (sin 3.14193792057279441821e+00+1.19209289550781250e-07i) -3.4526697614134361253e-4-1.1920928244535424533e-7i)
+(num-test (sin 3.14193792057279441821e+00+2.0e+00i) -1.2989619299124286975e-3-3.6268601916692946556e0i)
+(num-test (sin 3.14193792057279441821e+00+5.0e-01i) -3.8933200722526827075e-4-5.2109527443404709211e-1i)
+(num-test (sin 3.14193792057279441821e+00-1.0e+00i) -5.3277478472492034385e-4+1.1752011235963524660e0i)
+(num-test (sin 3.14193792057279441821e+00-1.19209289550781250e-07i) -3.4526697614134361253e-4+1.1920928244535424533e-7i)
+(num-test (sin 3.14193792057279441821e+00-2.0e+00i) -1.2989619299124286975e-3+3.6268601916692946556e0i)
+(num-test (sin 3.14193792057279441821e+00-5.0e-01i) -3.8933200722526827075e-4+5.2109527443404709211e-1i)
+(num-test (sin 3.45266983001243932001e-04+0.0e+00i) 3.4526697614140534807e-4)
+(num-test (sin 3.45266983001243932001e-04+1.0e+00i) 5.3277478472501939236e-4+1.1752011235963524660e0i)
+(num-test (sin 3.45266983001243932001e-04+1.19209289550781250e-07i) 3.4526697614140780134e-4+1.1920928244535424533e-7i)
+(num-test (sin 3.45266983001243932001e-04+2.0e+00i) 1.2989619299126701883e-3+3.6268601916692946556e0i)
+(num-test (sin 3.45266983001243932001e-04+5.0e-01i) 3.8933200722534065172e-4+5.2109527443404709209e-1i)
+(num-test (sin 3.45266983001243932001e-04-1.0e+00i) 5.3277478472501939236e-4-1.1752011235963524660e0i)
+(num-test (sin 3.45266983001243932001e-04-1.19209289550781250e-07i) 3.4526697614140780134e-4-1.1920928244535424533e-7i)
+(num-test (sin 3.45266983001243932001e-04-2.0e+00i) 1.2989619299126701883e-3-3.6268601916692946556e0i)
+(num-test (sin 3.45266983001243932001e-04-5.0e-01i) 3.8933200722534065172e-4-5.2109527443404709209e-1i)
+(num-test (sin 3/10) 0.29552020666134)
+(num-test (sin 3/1234) 0.00243111591964)
+(num-test (sin 3/1234000000) 0.00000000243112)
+(num-test (sin 3/2) 0.99749498660405)
+(num-test (sin 3/500029) 0.00000599965202)
+(num-test (sin 4.71204371340168837179e+00+0.0e+00i) -9.9999994039535581664e-1)
+(num-test (sin 4.71204371340168837179e+00+1.0e+00i) -1.5430805428404715941e0-4.0575816248744985081e-4i)
+(num-test (sin 4.71204371340168837179e+00+1.19209289550781250e-07i) -9.9999994039536292207e-1-4.1159030931192414605e-11i)
+(num-test (sin 4.71204371340168837179e+00+2.0e+00i) -3.7621954668392959444e0-1.2522351259052019007e-3i)
+(num-test (sin 4.71204371340168837179e+00+5.0e-01i) -1.1276258979946363572e0-1.7991700040943409243e-4i)
+(num-test (sin 4.71204371340168837179e+00-1.0e+00i) -1.5430805428404715941e0+4.0575816248744985081e-4i)
+(num-test (sin 4.71204371340168837179e+00-1.19209289550781250e-07i) -9.9999994039536292207e-1+4.1159030931192414605e-11i)
+(num-test (sin 4.71204371340168837179e+00-2.0e+00i) -3.7621954668392959444e0+1.2522351259052019007e-3i)
+(num-test (sin 4.71204371340168837179e+00-5.0e-01i) -1.1276258979946363572e0+1.7991700040943409243e-4i)
+(num-test (sin 4.71273424736769097620e+00+0.0e+00i) -9.9999994039535581677e-1)
+(num-test (sin 4.71273424736769097620e+00+1.0e+00i) -1.5430805428404715943e0+4.0575816248701808892e-4i)
+(num-test (sin 4.71273424736769097620e+00+1.19209289550781250e-07i) -9.9999994039536292220e-1+4.1159030931148617825e-11i)
+(num-test (sin 4.71273424736769097620e+00+2.0e+00i) -3.7621954668392959448e0+1.2522351259038694139e-3i)
+(num-test (sin 4.71273424736769097620e+00+5.0e-01i) -1.1276258979946363573e0+1.7991700040924264514e-4i)
+(num-test (sin 4.71273424736769097620e+00-1.0e+00i) -1.5430805428404715943e0-4.0575816248701808892e-4i)
+(num-test (sin 4.71273424736769097620e+00-1.19209289550781250e-07i) -9.9999994039536292220e-1-4.1159030931148617825e-11i)
+(num-test (sin 4.71273424736769097620e+00-2.0e+00i) -3.7621954668392959448e0-1.2522351259038694139e-3i)
+(num-test (sin 4.71273424736769097620e+00-5.0e-01i) -1.1276258979946363573e0-1.7991700040924264514e-4i)
+(num-test (sin 500029/10) .9665258739436294)
+(num-test (sin 500029/1234) .05553717596791147)
+(num-test (sin 500029/1234000000) 0.00040520987546)
+(num-test (sin 500029/2) 0.270047165973401)
+(num-test (sin 500029/3) 7.610322596690986e-1)
+(num-test (sin 6.28284004019658492979e+00+0.0e+00i) -3.4526697614170855328e-4)
+(num-test (sin 6.28284004019658492979e+00+1.0e+00i) -5.3277478472548726245e-4+1.1752011235963524659e0i)
+(num-test (sin 6.28284004019658492979e+00+1.19209289550781250e-07i) -3.4526697614171100655e-4+1.1920928244535424532e-7i)
+(num-test (sin 6.28284004019658492979e+00+2.0e+00i) -1.2989619299138109057e-3+3.6268601916692946552e0i)
+(num-test (sin 6.28284004019658492979e+00+5.0e-01i) -3.8933200722568255379e-4+5.2109527443404709204e-1i)
+(num-test (sin 6.28284004019658492979e+00-1.0e+00i) -5.3277478472548726245e-4-1.1752011235963524659e0i)
+(num-test (sin 6.28284004019658492979e+00-1.19209289550781250e-07i) -3.4526697614171100655e-4-1.1920928244535424532e-7i)
+(num-test (sin 6.28284004019658492979e+00-2.0e+00i) -1.2989619299138109057e-3-3.6268601916692946552e0i)
+(num-test (sin 6.28284004019658492979e+00-5.0e-01i) -3.8933200722568255379e-4-5.2109527443404709204e-1i)
+(num-test (sin 6.28353057416258753420e+00+0.0e+00i) 3.4526697614121869459e-4)
+(num-test (sin 6.28353057416258753420e+00+1.0e+00i) 5.3277478472473137099e-4+1.1752011235963524661e0i)
+(num-test (sin 6.28353057416258753420e+00+1.19209289550781250e-07i) 3.4526697614122114786e-4+1.1920928244535424534e-7i)
+(num-test (sin 6.28353057416258753420e+00+2.0e+00i) 1.2989619299119679614e-3+3.6268601916692946558e0i)
+(num-test (sin 6.28353057416258753420e+00+5.0e-01i) 3.8933200722513017641e-4+5.2109527443404709213e-1i)
+(num-test (sin 6.28353057416258753420e+00-1.0e+00i) 5.3277478472473137099e-4-1.1752011235963524661e0i)
+(num-test (sin 6.28353057416258753420e+00-1.19209289550781250e-07i) 3.4526697614122114786e-4-1.1920928244535424534e-7i)
+(num-test (sin 6.28353057416258753420e+00-2.0e+00i) 1.2989619299119679614e-3-3.6268601916692946558e0i)
+(num-test (sin 6.28353057416258753420e+00-5.0e-01i) 3.8933200722513017641e-4-5.2109527443404709213e-1i)
+(num-test (sin 9.42443269378637893396e+00+0.0e+00i) 3.4526697614094283958e-4)
+(num-test (sin 9.42443269378637893396e+00+1.0e+00i) 5.3277478472430570447e-4-1.1752011235963524662e0i)
+(num-test (sin 9.42443269378637893396e+00+1.19209289550781250e-07i) 3.4526697614094529285e-4-1.1920928244535424535e-7i)
+(num-test (sin 9.42443269378637893396e+00+2.0e+00i) 1.2989619299109301409e-3-3.6268601916692946561e0i)
+(num-test (sin 9.42443269378637893396e+00+5.0e-01i) 3.8933200722481911514e-4-5.2109527443404709218e-1i)
+(num-test (sin 9.42443269378637893396e+00-1.0e+00i) 5.3277478472430570447e-4+1.1752011235963524662e0i)
+(num-test (sin 9.42443269378637893396e+00-1.19209289550781250e-07i) 3.4526697614094529285e-4+1.1920928244535424535e-7i)
+(num-test (sin 9.42443269378637893396e+00-2.0e+00i) 1.2989619299109301409e-3+3.6268601916692946561e0i)
+(num-test (sin 9.42443269378637893396e+00-5.0e-01i) 3.8933200722481911514e-4+5.2109527443404709218e-1i)
+(num-test (sin 9.42512322775237976202e+00+0.0e+00i) -3.4526697614020805155e-4)
+(num-test (sin 9.42512322775237976202e+00+1.0e+00i) -5.3277478472317186729e-4-1.1752011235963524665e0i)
+(num-test (sin 9.42512322775237976202e+00+1.19209289550781250e-07i) -3.4526697614021050482e-4-1.1920928244535424538e-7i)
+(num-test (sin 9.42512322775237976202e+00+2.0e+00i) -1.2989619299081657245e-3-3.6268601916692946571e0i)
+(num-test (sin 9.42512322775237976202e+00+5.0e-01i) -3.8933200722399054908e-4-5.2109527443404709231e-1i)
+(num-test (sin 9.42512322775237976202e+00-1.0e+00i) -5.3277478472317186729e-4+1.1752011235963524665e0i)
+(num-test (sin 9.42512322775237976202e+00-1.19209289550781250e-07i) -3.4526697614021050482e-4+1.1920928244535424538e-7i)
+(num-test (sin 9.42512322775237976202e+00-2.0e+00i) -1.2989619299081657245e-3+3.6268601916692946571e0i)
+(num-test (sin 9.42512322775237976202e+00-5.0e-01i) -3.8933200722399054908e-4+5.2109527443404709231e-1i)
+(num-test (sin pi) -6.982889851335445E-15)
+(num-test (sin 32767.) 1.8750655394138942394239E-1)
+(num-test (sin 8388607.) 9.9234509376961249835628E-1)
+(num-test (sin 2147483647.) -7.2491655514455639054829E-1)
+(num-test (sin 80143857.0000000149) 1.283143758817470627530994988383551176295E-10)
+
+(num-test (sin (- (/ pi 2) (* 0+i (log (/ (+ 1 (sqrt 5)) 2))))) (/ (sqrt 5) 2))
+(num-test (sin (/ pi 10)) (/ (- (sqrt 5) 1) 4))
+(num-test (sin (/ pi 12)) (* (/ (sqrt 2) 4) (- (sqrt 3) 1)))
+(num-test (sin (/ pi 12)) (/ (- (sqrt 6) (sqrt 2)) 4))
+(num-test (sin (/ pi 15)) (/ (sqrt (- 7 (sqrt 5) (sqrt (- 30 (* 6 (sqrt 5)))))) 4))
+(num-test (sin (/ pi 16)) (/ (sqrt (- 2 (sqrt (+ 2 (sqrt 2))))) 2))
+(num-test (sin (/ pi 20)) (/ (sqrt (- 8 (* 2 (sqrt (+ 10 (* 2 (sqrt 5))))))) 4))
+(num-test (sin (/ pi 24)) (/ (sqrt (- 2 (sqrt (+ 2 (sqrt 3))))) 2))
+(num-test (sin (/ pi 3)) (/ (sqrt 3) 2))
+(num-test (sin (/ pi 3)) (/ (sqrt 3) 2))
+(num-test (sin (/ pi 30)) (/ (+ -1 (- (sqrt 5)) (sqrt (- 30 (* 6 (sqrt 5))))) 8))
+(num-test (sin (/ pi 32)) (/ (sqrt (- 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt 2))))))) 2))
+(num-test (sin (/ pi 4)) (/ (sqrt 2) 2))
+(num-test (sin (/ pi 5)) (/ (sqrt (- 10 (* 2 (sqrt 5)))) 4))
+(num-test (sin (/ pi 6)) 1/2)
+(num-test (sin (/ pi 8)) (/ (sqrt (- 2 (sqrt 2))) 2))
+(num-test (* (sin (/ pi 11)) (sin (/ (* 2 pi) 11)) (sin (/ (* 3 pi) 11)) (sin (/ (* 4 pi) 11)) (sin (/ (* 5 pi) 11))) (sqrt (/ 11 1024)))
+(num-test (* (sin (/ pi 7)) (sin (/ (* 2 pi) 7)) (sin (/ (* 3 pi) 7))) (/ (sqrt 7) 8))
+(num-test (* (sin (/ pi 9)) (sin (/ (* 2 pi) 9)) (sin (/ (* 4 pi) 9))) (/ (sqrt 3) 8))
+(num-test (* pi (+ 1.0 (atan (tan (acos (cos (asin (sin (/ 1.0 (/ 1.0 pi)))))))))) pi)
+(num-test (+ (* (sin 0.1) (sin 0.1)) (* (cos 0.1) (cos 0.1))) 1.0)
+(num-test (/ (- (sqrt 5) 1) 2) (/ (sin (* pi 1/5)) (sin (* pi 2/5))))
+
+(let ((val1 (sin (/ pi 60)))
+      (val2 (* 1/16 (- (* (+ (sqrt 6) (sqrt 2)) (- (sqrt 5) 1)) (* 2 (- (sqrt 3) 1) (sqrt (+ 5 (sqrt 5))))))))
+  (num-test (- val1 val2) 0.0))
+
+(let ((val1 (sin (/ (* 4 pi) 15)))
+      (val2 (* 1/8 (+ (sqrt (+ 10 (* 2 (sqrt 5)))) (sqrt 15) (- (sqrt 3))))))
+  (num-test (- val1 val2) 0.0))
+
+(num-test (sin 22) -8.851309290403875921690256815772332463307E-3)
+(when with-bignums
+  (num-test (sin 9223372036854775806) (sin (bignum 9223372036854775806)))
+  (num-test (sin 1e22) -8.522008497671888017727058937530293682616E-1)
+  (num-test (sin 1+100i) 1.130986289301505745599509129978056149094E43+7.261979450834655624032117190441273726075E42i)
+  (num-test (sin 0+100i) 0.0+1.34405857090806772420631277579000679368E43i)
+  (num-test (sin 0+1000i) 0.0+9.850355570085234969444396761216615626576E433i)
+  (num-test (sin 1+1000i) 8.288788402267571487966465808315066740252E433+5.322169828138126401369949836048836144292E433i)
+  (num-test (sin 1e-100+1e-100i) 9.999999999999999999999999999999999999992E-101+9.999999999999999999999999999999999999992E-101i))
+
+;; not even close if not bignums: 0.4626130407646
+;; we start to lose around 1e18 -- running out of bits of fraction?
+
+(test (>= 0.0000001 (sin 0.0000001)) #t)
+(test (>= 0.000000001 (sin 0.000000001)) #t)
+;(test (>= 0.0000001 (sin (+ (* 2 pi) 0.0000001))) #t)
+; this fails because "pi" is inaccurate?
+(num-test (sin 31415926.0) -0.5106132968486)
+(num-test (sin (+ (* 200 pi) 0.001)) 9.999998333333416874831395573527051109993E-4)
+(test (< (abs (- (sin (+ (* 200 pi) 0.001)) (- (sin (- (* 200 pi) 0.001))))) 5e-13) #t)
+
+(for-each
+ (lambda (num-and-val)
+   (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'sin num (sin num) val)))
+ (vector (list 0 0) (list 1 0.8414709848079) (list 2 0.90929742682568) (list 3 0.14112000805987)
+	 (list -1 -0.8414709848079) (list -2 -0.90929742682568) (list -3 -0.14112000805987)
+	 (list 1/2 0.4794255386042) (list 1/3 0.32719469679615) (list -1/2 -0.4794255386042)
+	 (list -1/3 -0.32719469679615) (list 1/9223372036854775807 1.0842021724855e-19) (list 0.0 0.0)
+	 (list 1.0 0.8414709848079) (list 2.0 0.90929742682568) (list -2.0 -0.90929742682568)
+	 (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309)
+	 (list 0+1i 0+1.1752011936438i) (list 0+2i 0+3.626860407847i)
+	 (list 0-1i 0-1.1752011936438i) (list 1+1i 1.298457581416+0.63496391478474i) (list 1-1i 1.298457581416-0.63496391478474i)
+	 (list -1+1i -1.298457581416+0.63496391478474i) (list -1-1i -1.298457581416-0.63496391478474i)
+	 (list 0.1+0.1i 0.10033299984131+0.099666333492108i) (list 1e-16+1e-16i 1e-16+1e-16i)
+	 ))
+
+(test (sin) 'error)
+(test (sin "hi") 'error)
+(test (sin 1.0+23.0i 1.0+23.0i) 'error)
+(test (sin 0 1) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (sin arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(when with-bignums
+  (letrec ((sin-m*pi/n
+	    (lambda (m1 n1)
+
+	      ;; this returns an expression giving the exact value of sin(m*pi/n), m and n integer
+	      ;;   if we can handle n -- currently it can be anything of the form 2^a 3^b 5^c 7^d 11^h 13^e 17^f 257^g
+	      ;;   so (sin-m*pi/n 1 60) returns an exact expression for sin(pi/60).
+
+	      (let ((m (numerator (/ m1 n1)))
+		    (n (denominator (/ m1 n1))))
+
+		(set! m (modulo m (* 2 n)))
+		;; now it's in lowest terms without extra factors of 2*pi
+
+		(cond ((zero? m) 0)
+
+		      ((zero? n) (error 'divide-by-zero "divide by zero (sin-m*pi/n n = 0)"))
+
+		      ((= n 1) 0)
+
+		      ((negative? n)
+		       (let ((val (sin-m*pi/n m (- n))))
+			 (and val `(- ,val))))
+
+		      ((> m n)
+		       (let ((val (sin-m*pi/n (- m n) n)))
+			 (and val `(- ,val))))
+
+		      ((= n 2) (if (= m 0) 0 1))
+
+		      ((= n 3) `(sqrt 3/4))
+
+		      ((> m 1)
+		       (let ((m1 (sin-m*pi/n (- m 1) n))
+			     (n1 (sin-m*pi/n 1 n))
+			     (m2 (sin-m*pi/n (- m 2) n)))
+			 (and m1 m2 n1
+			      `(- (* 2 ,m1 (sqrt (- 1 (* ,n1 ,n1)))) ,m2))))
+
+		      ((= n 5) `(/ (sqrt (- 10 (* 2 (sqrt 5)))) 4))
+
+		      ((= n 7) `(let ((A1 (expt (+ -7/3456 (sqrt -49/442368)) 1/3))
+				      (A2 (expt (- -7/3456 (sqrt -49/442368)) 1/3)))
+				  (sqrt (+ 7/12 (* -1/2 (+ A1 A2)) (* 1/2 0+i (sqrt 3) (- A1 A2))))))
+
+		      ((= n 17) `(let* ((A1 (sqrt (- 17 (sqrt 17))))
+					(A2 (sqrt (+ 17 (sqrt 17))))
+					(A3 (sqrt (+ 34 (* 6 (sqrt 17)) (* (sqrt 2) (- (sqrt 17) 1) A1) (* -8 (sqrt 2) A2)))))
+				   (* 1/8 (sqrt 2) (sqrt (- 17 (sqrt 17) (* (sqrt 2) (+ A1 A3)))))))
+
+
+		      ((= n 11) `(let* ((SQRT5 (* 1/2 (- (sqrt 5) 1)))
+					(B5 (sqrt (+ 2 (* 1/2 (+ (sqrt 5) 1)))))
+					(B6 (+ SQRT5 (* 0+i B5)))
+					(B6_2 (* B6 B6))
+					(B6_3 (* B6 B6 B6))
+					(B6_4 (* B6 B6 B6 B6))
+					(D1 (+ 6 (* 3/2 B6) (* 3/4 B6_2)))
+					(D2 (+ SQRT5 (* 0+i B5) (* 1/4 B6_2)))
+					(D3 (* 1/2 (- (+ 1 (* 0+i (sqrt 11))))))
+					(D4 (* 1/2 (- (* 0+i (sqrt 11)) 1)))
+					(D6 (+ 1 (* 1/4 B6_2) (* 1/8 B6_3)))
+					(D7 (+ (* 1/2 B6) (* 1/16 B6_4)))
+					(D8 (+ 2 (* 1/2 B6)))
+					(D9 (+ 13 (* 21 B6) (* 67/4 B6_2) (* 21/4 B6_3) (* 2 B6_4)))
+					(D11 (+ 129 (* 109/2 B6) (* 59/4 B6_2) (* 9/8 B6_3) (* 9/16 B6_4)))
+					(D13 (+ (* 3 B6) B6_2))
+					(D14 (+ (* 3 B6) (* 3/4 B6_2) (* 3/8 B6_3)))
+					(D15 (+ 79 (* 27 B6) (* 39/4 B6_2) (* 37/4 B6_3) (* 21/4 B6_4)))
+					(D16 (+ D11 (* D3 D9) (* D4 D15)))
+					(D17 (+ D11 (* D4 D9) (* D3 D15)))
+					(D30 (/ (* B6_2 (+ (* D3 D6) (* D4 D7))) (* 4 (expt D17 1/5))))
+					(D32 (* 1/2 (+ 1 (* 0+i (sqrt 11)))))
+					(D33 (/ (* B6_3 (+ (* D4 D6) (* D3 D7))) (* 8 (expt D16 1/5))))
+					(D34 (* 1/4 B6_2 (expt D16 1/5)))
+					(D35 (+ 2 (* 1/8 B6_4) (* 1/2 B6 D8) (* 1/8 B6_3 D2)))
+					(D36 (+ SQRT5 (* 0+i B5) (* 1/2 B6_2) (* 1/4 B6_3) (* 1/2 B6 D2) (* 1/4 B6_2 (+ (* 1/4 B6_3) (* 1/16 B6_4)))))
+					(D38 (* 1/2 (+ -1 (* 0+i (sqrt 11)))))
+					(D39 (* 1/8 B6_3 (expt D17 1/5)))
+					(D40 (+ 3 (* 3/2 B6) (* 9/4 B6_2) (* 7/8 B6_3) (* 3/16 B6_4) (* 1/2 B6 (+ 6 (* 2 B6)))
+						(* 1/16 B6_4 D1) (* 1/4 B6_2 D13) (* 1/8 B6_3 (+ 3 (* 3/4 B6_3) (* 3/16 B6_4)))))
+					(D41 (+ (* 1/4 B6_2 D1) (* 1/8 B6_3 D13) (* 1/16 B6_4 D14) (* 1/2 B6 (+ 4 (* 3/8 B6_4)))))
+					(D42 (+ 3 (* 3/4 B6_3) (* 3/16 B6_4) (* 1/8 B6_3 D1) (* 1/4 B6_2 D14)
+						(* 1/2 B6 (+ (* 3/2 B6_2) (* 3/8 B6_3) (* 3/16 B6_4))) (* 1/16 B6_4 (+ 3 (* 3/2 B6) (* 3/8 B6_4)))))
+					(D43 (+ (* 1/4 B6_3) (* 1/16 B6_4) (* 1/8 B6_3 D8) (* 1/4 B6_2 D2)
+						(* 1/2 B6 (+ (* 1/2 B6_2) (* 1/8 B6_3))) (* 1/16 B6_4 (+ 1 (* 1/8 B6_4)))))
+					(D44 (/ (* B6_4 (+ D42 (* D4 D40) (* D3 D41))) (* 16 (expt D16 3/5))))
+					(D45 (/ (* B6 (+ D42 (* D3 D40) (* D4 D41))) (* 2 (expt D17 3/5))))
+					(D48 (/ (* B6 (+ D43 (* D3 D35) (* D4 D36))) (* 2 (expt D16 2/5))))
+					(D49 (/ (* B6_4 (+ D43 (* D4 D35) (* D3 D36))) (* 16 (expt D17 2/5)))))
+				   (* -1/2 0+i
+				      (+ (* 1/5 (- D32 D33 D34 D48 D44))
+					 (* 1/5 (+ D38 D30 D39 D49 D45))))))
+
+		      ((= n 13)
+		       `(let* ((A1 (/ (- -1 (sqrt 13)) 2))
+			       (A2 (/ (+ -1 (sqrt 13)) 2))
+			       (A3 (/ (+ -1 (* 0+i (sqrt 3))) 2))
+			       (A4 (+ -1 (* 0+i (sqrt 3))))
+			       (A5 (* 0+i (sqrt (+ 7 (sqrt 13) A2))))
+			       (A6 (* 0+i (sqrt (+ 7 (- (sqrt 13)) A1))))
+			       (A8  (* 1/2 (- A2 A6)))
+			       (A9  (* 1/2 (+ A1 A5)))
+			       (A11 (* 1/2 (+ A2 A6)))
+			       (A12 (* 1/2 (- A1 A5)))
+			       (A13 (* 3/2 A4 A8))
+			       (A14 (* 3/2 A4 A11))
+			       (A15 (* 3/4 A4 A4 A11))
+			       (A16 (* 3/4 A4 A4 A8))
+			       (A17 (+ A3 (* 1/4 A4 A4))))
+			  (* -1/6 0+i (+ (- A9 A12)
+					 (* A4 (+ (/ (+ A8 (* A17 A12)) (* 2 (expt (+ 6 A13 A15 A9) 1/3)))
+						  (/ (+ A11 (* A17 A9)) (* -2 (expt (+ 6 A16 A14 A12) 1/3)))
+						  (* 1/4 A4 (- (expt (+ 6 A13 A15 A9) 1/3) (expt (+ 6 A16 A14 A12) 1/3)))))))))
+
+		      ((= n 257)
+		       `(let* ((A1 (sqrt (- 514 (* 2 (sqrt 257)))))
+			       (A2 (- 257 (* 15 (sqrt 257))))
+			       (A3 (+ 257 (* 15 (sqrt 257))))
+			       (A4 (- 257 (sqrt 257)))
+			       (A5 (+ (sqrt 257) 257))
+			       (A7 (+ 257 (* 9 (sqrt 257))))
+			       (A8 (- 514 (* 18 (sqrt 257))))
+			       (AA (sqrt (* 2 A5)))
+			       (A9 (sqrt (+ A2 (* 8 A1) (* -7 AA))))
+			       (A10 (sqrt (+ A2 (* -8 A1) (* 7 AA))))
+			       (A11 (sqrt (+ A3 (* 7 A1) (* 8 AA))))
+			       (A12 (sqrt (+ A3 (* -7 A1) (* -8 AA))))
+			       (A13 (sqrt (+ A8 (* 6 A1) (* 8 A9) (* -24 A10) (* 12 A11))))
+			       (A14 (* 4 (sqrt (+ A8 (* 6 A1) (* -8 A9) (* 24 A10) (* -12 A11)))))
+			       (A15 (* 4 (sqrt (+ A8 (* -6 A1) (* -12 A12) (* 24 A9) (* 8 A10)))))
+			       (A16 (* 4 (sqrt (* 2 (+ (- 257 (* 9 (sqrt 257))) (* -3 A1) (* 6 A12) (* -12 A9) (* -4 A10))))))
+			       (A17 (sqrt (* 2 (+ A7 (* -3 AA) (* -4 A12) (* 6 A9) (* 12 A11)))))
+			       (A18 (sqrt (* 2 (+ A7 (* 3 AA) (* 12 A12) (* -6 A10) (* 4 A11)))))
+			       (A19 (* 4 (sqrt (* 2 (+ A7 (* 3 AA) (* -12 A12) (* 6 A10) (* -4 A11))))))
+			       (A20 (* 4 (sqrt (* 2 (+ A7 (* -3 AA) (* 4 A12) (* -6 A9) (* -12 A11))))))
+			       (A22 (+ A4 (* 3 A1) (* -4 AA) (* -4 A12) (* 4 A9) (* -4 A10) (* 2 A11)))
+			       (A23 (+ A5 (* -4 A1) (* -3 AA) (* -4 A12) (* 2 A9) (* 4 A10) (* 4 A11)))
+			       (A24 (+ A5 (* 4 A1) (* 3 AA) (* 4 A12) (* 4 A9) (* -2 A10) (* 4 A11)))
+			       (A26 (sqrt (+ A22 (+ (- A16) (- A19) (* 4 A17) (* -6 A13)))))
+			       (A27 (sqrt (+ A22 (+ A16 A19 (* -4 A17) (* 6 A13)))))
+			       (A28 (+ 257 (* 7 (sqrt 257)) (* 3 A1) (* -4 A9) (* 4 A10) (* 6 A11)))
+			       (A29 (* 8 (sqrt (+ A24 A15 (- A20) (* -6 A18) (* -4 A13)))))
+			       (A30 (+ A28 (* -4 A18) (* -4 A17) (* -2 A13)))
+			       (A31 (+ (* 8 (sqrt (+ A23 A15 A14 (* 4 A18) (* -6 A17)))) (* 4 A26) A29 (* -8 A27))))
+			  (* 1/16 (sqrt (* 1/2 (+ A4 (- A1) (* -2 A11) (* -2 A13) (* -4 A26)
+						  (* -4 (sqrt (* 2 (+ A30 (- A31)))))
+						  (* -8 (sqrt (+ A4 (- A1) (* -2 A11) (* 6 A13) (* -4 A26) (* -8 A27)
+								 (* 4 (sqrt (* 2 (+ A30 A31))))
+								 (* -8 (sqrt (* 2 (+ A28 (* 4 A18) (* 4 A17) (* 2 A13) (* -8 A26) (* -4 A27)
+										     (* -8 (sqrt (+ A23 (- A15) (- A14) (* -4 A18) (* 6 A17))))
+										     (* -8 (sqrt (+ A24 (- A15) A20 (* 6 A18) (* 4 A13)))))))))))))))))
+
+		      ((or (= (modulo n 2) 0) (= (modulo n 3) 0) (= (modulo n 5) 0) (= (modulo n 7) 0)
+			   (= (modulo n 17) 0) (= (modulo n 13) 0) (= (modulo n 257) 0) (= (modulo n 11) 0))
+		       (let ((divisor (if (= (modulo n 2) 0) 2
+					  (if (= (modulo n 3) 0) 3
+					      (if (= (modulo n 5) 0) 5
+						  (if (= (modulo n 7) 0) 7
+						      (if (= (modulo n 17) 0) 17
+							  (if (= (modulo n 13) 0) 13
+							      (if (= (modulo n 11) 0) 11
+								  257)))))))))
+			 (let ((val (sin-m*pi/n 1 (/ n divisor))))
+			   (and val
+				`(let ((ex ,val))
+				   (/ (- (expt (+ (sqrt (- 1 (* ex ex))) (* 0+i ex)) (/ 1 ,divisor))
+					 (expt (- (sqrt (- 1 (* ex ex))) (* 0+i ex)) (/ 1 ,divisor)))
+				      0+2i))))))
+
+		      (else #f))))))
+
+    (let ((maxerr 0.0)
+	  (max-case #f)
+	  (cases 0))
+      (do ((n 1 (+ n 1)))
+	  ((= n 100))
+	(do ((m 1 (+ m 1)))
+	    ((= m 4))
+	  (letrec ((bigify (lambda (lst)
+			     (if (pair? lst)
+				 (cons (if (number? (car lst))
+					   (list 'bignum (number->string (car lst)))
+					   (bigify (car lst)))
+				       (bigify (cdr lst)))
+				 lst))))
+	    (let ((val (sin (/ (* m pi) n)))
+		  (expr (bigify (sin-m*pi/n m n))))
+	      (if expr
+		  (let ((err (magnitude (- val (eval expr)))))
+		    (set! cases (+ cases 1))
+		    (if (> err maxerr)
+			(begin
+			  (set! max-case (/ m n))
+			  (set! maxerr err)))))))))
+      (if (> maxerr 1e-35)
+	  (format #t "sin-m*pi/n (~A cases) max err ~A at ~A~%" cases maxerr max-case)))))
+
+(let ((sins (list
+	     0.00000000000000000000000000000000000000000000000000000000000000000000
+	     0.09983341664682815230681419841062202698991538801798225999276686156165
+	     0.19866933079506121545941262711838975037020672954020540398639599139797
+	     0.29552020666133957510532074568502737367783211174261844850153103617326
+	     0.38941834230865049166631175679570526459306018344395889511584896585734
+	     0.47942553860420300027328793521557138808180336794060067518861661312553
+	     0.56464247339503535720094544565865790710988808499415177102426589426735
+	     0.64421768723769105367261435139872018306581384457368964474396308809382
+	     0.71735609089952276162717461058138536619278523779142282098968252068287
+	     0.78332690962748338846138231571354862314014792572030960356048515256195
+	     0.84147098480789650665250232163029899962256306079837106567275170999191
+	     0.89120736006143533995180257787170353831890931945282652766035329176720
+	     0.93203908596722634967013443549482599541507058820873073536659789445024
+	     0.96355818541719296470134863003955481534204849131773911795564922309212
+	     0.98544972998846018065947457880609751735626167234736563194021894560084
+	     0.99749498660405443094172337114148732270665142592211582194997482405934
+	     0.99957360304150516434211382554623417197949791475491995534260751586102
+	     0.99166481045246861534613339864787565240681957116712372532710249102330
+	     0.97384763087819518653237317884335760670293947136523395566725825917196
+	     0.94630008768741448848970961163495776211399866559491176443047155279581
+	     0.90929742682568169539601986591174484270225497144789026837897301153096
+	     0.86320936664887377068075931326902458492047242489508107697183045949721
+	     0.80849640381959018430403691041611906515855960597557707903336060873485
+	     0.74570521217672017738540621164349953894264877802047425750762828050000
+	     0.67546318055115092656577152534128337425336495789352584226890212866520
+	     0.59847214410395649405185470218616227170359717157722357330262703263874
+	     0.51550137182146423525772693520936824389387858775426312126259173008382
+	     0.42737988023382993455605308585788064749647642266670256499017776070511
+	     0.33498815015590491954385375271242210603030652888358671068410107309479
+	     0.23924932921398232818425691873957537221555293029961877411621026588071
+	     0.14112000805986722210074480280811027984693326425226558415188264123242
+	     0.04158066243329057919469827159667310055461342296380675064800900076588
+	     -0.05837414342757990913721741461909518512512509908292656970935025422273)))
+  (let ((mxerr 0.0))
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x 0.1)))
+	((= i 32))
+      (let ((err (abs (- (sin x) (list-ref sins i)))))
+	(if (> err mxerr)
+	    (set! mxerr err))))
+    (if (> mxerr 1e-12) (format #t "sin err: ~A~%" mxerr))))
+
+(when with-bignums
+  (let-temporarily (((*s7* 'bignum-precision) 500))
+    (let ((sin-vals (list   ;arprec mathtool table[Sin[k/10], {k, 0, 30}]
+		     "0.00000000000000000000000000000000000000000000000000000000000000000000"
+		     "0.09983341664682815230681419841062202698991538801798225999276686156165"
+		     "0.19866933079506121545941262711838975037020672954020540398639599139797"
+		     "0.29552020666133957510532074568502737367783211174261844850153103617326"
+		     "0.38941834230865049166631175679570526459306018344395889511584896585734"
+		     "0.47942553860420300027328793521557138808180336794060067518861661312553"
+		     "0.56464247339503535720094544565865790710988808499415177102426589426735"
+		     "0.64421768723769105367261435139872018306581384457368964474396308809382"
+		     "0.71735609089952276162717461058138536619278523779142282098968252068287"
+		     "0.78332690962748338846138231571354862314014792572030960356048515256195"
+		     "0.84147098480789650665250232163029899962256306079837106567275170999191"
+		     "0.89120736006143533995180257787170353831890931945282652766035329176720"
+		     "0.93203908596722634967013443549482599541507058820873073536659789445024"
+		     "0.96355818541719296470134863003955481534204849131773911795564922309212"
+		     "0.98544972998846018065947457880609751735626167234736563194021894560084"
+		     "0.99749498660405443094172337114148732270665142592211582194997482405934"
+		     "0.99957360304150516434211382554623417197949791475491995534260751586102"
+		     "0.99166481045246861534613339864787565240681957116712372532710249102330"
+		     "0.97384763087819518653237317884335760670293947136523395566725825917196"
+		     "0.94630008768741448848970961163495776211399866559491176443047155279581"
+		     "0.90929742682568169539601986591174484270225497144789026837897301153096"
+		     "0.86320936664887377068075931326902458492047242489508107697183045949721"
+		     "0.80849640381959018430403691041611906515855960597557707903336060873485"
+		     "0.74570521217672017738540621164349953894264877802047425750762828050000"
+		     "0.67546318055115092656577152534128337425336495789352584226890212866520"
+		     "0.59847214410395649405185470218616227170359717157722357330262703263874"
+		     "0.51550137182146423525772693520936824389387858775426312126259173008382"
+		     "0.42737988023382993455605308585788064749647642266670256499017776070511"
+		     "0.33498815015590491954385375271242210603030652888358671068410107309479"
+		     "0.23924932921398232818425691873957537221555293029961877411621026588071"
+		     "0.14112000805986722210074480280811027984693326425226558415188264123242")))
+      (do ((k 2 (+ k 1)))
+	  ((= k 30))
+	(let ((sin-val-2 (number->string (sin (bignum (/ k 10))))))
+	  (if (not (string=? (substring (list-ref sin-vals k) 3 60) (substring sin-val-2 2 59)))
+	      (format #t ";(sin (/ ~A 10)) mp: ~A does not match~%~A~%" k (substring (list-ref sin-vals k) 3 60) (substring sin-val-2 2 59))))))
+
+    (let ((sin-vals (list   ;arprec mathtool table[Sin[k/10], {k, 0, 30}]
+		     0.00000000000000000000000000000000000000000000000000000000000000000000
+		     0.09983341664682815230681419841062202698991538801798225999276686156165
+		     0.19866933079506121545941262711838975037020672954020540398639599139797
+		     0.29552020666133957510532074568502737367783211174261844850153103617326
+		     0.38941834230865049166631175679570526459306018344395889511584896585734
+		     0.47942553860420300027328793521557138808180336794060067518861661312553
+		     0.56464247339503535720094544565865790710988808499415177102426589426735
+		     0.64421768723769105367261435139872018306581384457368964474396308809382
+		     0.71735609089952276162717461058138536619278523779142282098968252068287
+		     0.78332690962748338846138231571354862314014792572030960356048515256195
+		     0.84147098480789650665250232163029899962256306079837106567275170999191
+		     0.89120736006143533995180257787170353831890931945282652766035329176720
+		     0.93203908596722634967013443549482599541507058820873073536659789445024
+		     0.96355818541719296470134863003955481534204849131773911795564922309212
+		     0.98544972998846018065947457880609751735626167234736563194021894560084
+		     0.99749498660405443094172337114148732270665142592211582194997482405934
+		     0.99957360304150516434211382554623417197949791475491995534260751586102
+		     0.99166481045246861534613339864787565240681957116712372532710249102330
+		     0.97384763087819518653237317884335760670293947136523395566725825917196
+		     0.94630008768741448848970961163495776211399866559491176443047155279581
+		     0.90929742682568169539601986591174484270225497144789026837897301153096
+		     0.86320936664887377068075931326902458492047242489508107697183045949721
+		     0.80849640381959018430403691041611906515855960597557707903336060873485
+		     0.74570521217672017738540621164349953894264877802047425750762828050000
+		     0.67546318055115092656577152534128337425336495789352584226890212866520
+		     0.59847214410395649405185470218616227170359717157722357330262703263874
+		     0.51550137182146423525772693520936824389387858775426312126259173008382
+		     0.42737988023382993455605308585788064749647642266670256499017776070511
+		     0.33498815015590491954385375271242210603030652888358671068410107309479
+		     0.23924932921398232818425691873957537221555293029961877411621026588071
+		     0.14112000805986722210074480280811027984693326425226558415188264123242))
+	  (mxerr 0.0))
+      (do ((x 0 (+ x 1)))
+	  ((= x 20))
+	(let ((phase (* 2 pi (expt 10 x))))
+	  (do ((k 0 (+ k 1)))
+	      ((= k 30))
+	    (let ((sin-val-2 (sin (bignum (+ phase (/ k 10))))))
+	      (let ((err (magnitude (- sin-val-2 (list-ref sin-vals k)))))
+		(if (> err mxerr)
+		    (set! mxerr err)))))))
+      (if (> mxerr 1e-35)
+	  (format #t ";(sin big-angle) max error: ~A" mxerr)))))
+
+#|
+(do ((i 0 (+ i 1)))
+    ((= i 20))
+  (format *stderr* "~16F ~16F~%" (sin (* (expt 10 i) pi)) (cos (* (expt 10 i) pi))))
+
+no gmp:
+        0.000000        -1.000000
+       -0.000000         1.000000
+        0.000000         1.000000
+       -0.000000         1.000000
+       -0.000000         1.000000
+       -0.000000         1.000000
+       -0.000000         1.000000
+        0.000000         1.000000
+       -0.000000         1.000000
+       -0.000000         1.000000
+       -0.000002         1.000000
+       -0.000015         1.000000
+       -0.000270         1.000000
+       -0.002697         0.999996
+       -0.011346         0.999936
+       -0.236209         0.971702
+       -0.375213         0.926939
+       -0.847970        -0.530045
+       -0.641653        -0.766995
+        0.746337         0.665569
+
+gmp:
+1.883041077660785116745909548456034940273E-39          -1.00E0
+-4.234029779305360132683382622900526295916E-38          1.000E0
+-6.114820740621020145433361082456119380431E-37          1.000E0
+-3.105555202515964125033395547167170445206E-36          1.000E0
+-3.10555520251596412503339554716717044521E-35          1.000E0
+-5.031485146903199978089373489752097763739E-34          1.000E0
+-5.031485146903199978089373489752097763744E-33          1.000E0
+-2.566294818087538086177721723243390796012E-32          1.000E0
+1.378009708017520940880921103170540352349E-31          1.000E0
+1.378009708017520940880921103170540352352E-30          1.000E0
+-1.146345188689716836436610305734375582604E-29          1.000E0
+-1.146345188689716836436610305734375582607E-28          1.000E0
+-4.37751945647498119140305050913266797935E-27          1.000E0
+-1.792580042246769707429898346414034061949E-26          1.000E0
+2.343323020518368666927145113935780205877E-25          1.000E0
+-4.274121879905852732044124422623922622644E-24          1.000E0
+-4.274121879905852732044124422623922622652E-23          1.000E0
+-3.895714363435103670251191922571281239311E-24          1.000E0
+3.349174645382850319570778083492855035814E-21          1.000E0
+-4.782341648258432935485117923031707799885E-20          1.000E0
+|#
+
+
+;;; --------------------------------------------------------------------------------
+;;; cos
+;;; --------------------------------------------------------------------------------
+
+(num-test (cos 0) 1.0)
+(num-test (cos 1) 0.54030230586814)
+(num-test (cos 2) -0.41614683654714)
+(num-test (cos 3) -0.98999249660045)
+(num-test (cos 0/1) 1.0)
+(num-test (cos 0/2) 1.0)
+(num-test (cos 0/3) 1.0)
+(num-test (cos 0/10) 1.0)
+(num-test (cos 0/1234) 1.0)
+(num-test (cos 0/500029) 1.0)
+(num-test (cos 1/1) 0.54030230586814)
+(num-test (cos 1/2) 0.87758256189037)
+(num-test (cos -1/2) 0.87758256189037)
+(num-test (cos 1/3) 0.94495694631474)
+(num-test (cos -1/3) 0.94495694631474)
+(num-test (cos 1/10) 0.99500416527803)
+(num-test (cos -1/10) 0.99500416527803)
+(num-test (cos 1/1234) 0.99999967164800)
+(num-test (cos -1/1234) 0.99999967164800)
+(num-test (cos 1/500029) 0.99999999999800)
+(num-test (cos -1/500029) 0.99999999999800)
+(num-test (cos 2/1) -0.41614683654714)
+(num-test (cos 2/2) 0.54030230586814)
+(num-test (cos 2/3) 0.78588726077695)
+(num-test (cos 2/10) 0.98006657784124)
+(num-test (cos -2/10) 0.98006657784124)
+(num-test (cos 2/1234) 0.99999868659223)
+(num-test (cos -2/1234) 0.99999868659223)
+(num-test (cos 2/500029) 0.99999999999200)
+(num-test (cos -2/500029) 0.99999999999200)
+(num-test (cos 3/1) -0.98999249660045)
+(num-test (cos 3/2) 0.07073720166770)
+(num-test (cos 3/3) 0.54030230586814)
+(num-test (cos 3/10) 0.95533648912561)
+(num-test (cos -3/10) 0.95533648912561)
+(num-test (cos 3/1234) 0.99999704483333)
+(num-test (cos -3/1234) 0.99999704483333)
+(num-test (cos 3/500029) 0.99999999998200)
+(num-test (cos -3/500029) 0.99999999998200)
+(num-test (cos 10/3) -0.98167400471108)
+(num-test (cos 10/10) 0.54030230586814)
+(num-test (cos 10/1234) 0.99996716497825)
+(num-test (cos -10/1234) 0.99996716497825)
+(num-test (cos 10/500029) 0.99999999980002)
+(num-test (cos -10/500029) 0.99999999980002)
+(num-test (cos 1234/500029) 0.99999695484279)
+(num-test (cos -1234/500029) 0.99999695484279)
+(num-test (cos 500029/500029) 0.54030230586814)
+(num-test (cos 0.0) 1.0)
+(num-test (cos 0.00000001) 1.0)
+(num-test (cos -0.00000001) 1.0)
+(num-test (cos 1.0) 0.54030230586814)
+(num-test (cos pi) -1.0)
+(num-test (cos 0.0+0.0i) 1.0)
+(num-test (cos -0.0+0.0i) 1.0)
+(num-test (cos 0.0-0.0i) 1.0)
+(num-test (cos -0.0-0.0i) 1.0)
+(num-test (cos 0.0+0.00000001i) 1.0)
+(num-test (cos -0.0+0.00000001i) 1.0)
+(num-test (cos 0.0-0.00000001i) 1.0)
+(num-test (cos -0.0-0.00000001i) 1.0)
+(num-test (cos 0.0+1.0i) 1.54308063481524)
+(num-test (cos -0.0+1.0i) 1.54308063481524)
+(num-test (cos 0.0-1.0i) 1.54308063481524)
+(num-test (cos 0.0+3.14159265358979i) 11.59195327552152)
+(num-test (cos -0.0+3.14159265358979i) 11.59195327552152)
+(num-test (cos 0.0-3.14159265358979i) 11.59195327552152)
+(num-test (cos 0.00000001+0.0i) 1.0)
+(num-test (cos -0.00000001+0.0i) 1.0)
+(num-test (cos 0.00000001-0.0i) 1.0)
+(num-test (cos -0.00000001-0.0i) 1.0)
+(num-test (cos 0.00000001+0.00000001i) 1.0-1e-16i) ; maxima
+(num-test (cos -0.00000001+0.00000001i) 1.0+1e-16i)
+(num-test (cos 0.00000001-0.00000001i) 1.0+1e-16i)
+(num-test (cos -0.00000001-0.00000001i) 1.0-1e-16i)
+(num-test (cos 0.00000001+1.0i) 1.54308063481524-0.00000001175201i)
+(num-test (cos 0.00000001-1.0i) 1.54308063481524+0.00000001175201i)
+(num-test (cos 0.00000001+3.14159265358979i) 11.59195327552152-0.00000011548739i)
+(num-test (cos 0.00000001-3.14159265358979i) 11.59195327552152+0.00000011548739i)
+(num-test (cos 1.0+0.0i) 0.54030230586814)
+(num-test (cos 1.0-0.0i) 0.54030230586814)
+(num-test (cos 1.0+0.00000001i) 0.54030230586814-0.00000000841471i)
+(num-test (cos 1.0-0.00000001i) 0.54030230586814+0.00000000841471i)
+(num-test (cos 1.0+1.0i) 0.83373002513115-0.98889770576287i)
+(num-test (cos 1.0-1.0i) 0.83373002513115+0.98889770576287i)
+(num-test (cos 1.0+3.14159265358979i) 6.26315908428001-9.71792908024139i)
+(num-test (cos 1.0-3.14159265358979i) 6.26315908428001+9.71792908024139i)
+(num-test (cos 3.14159265358979+0.0i) -1.0)
+(num-test (cos 3.14159265358979-0.0i) -1.0)
+(num-test (cos 3.14159265358979+0.00000001i) -1.0-3.23121723694911E-23i) ; maxima
+(num-test (cos 3.14159265358979-0.00000001i) -1.0+3.23121723694911E-23i) ; maxima
+(num-test (cos 3.14159265358979+1.0i) -1.54308063481524)
+(num-test (cos 3.14159265358979-1.0i) -1.54308063481524)
+(num-test (cos 3.14159265358979+3.14159265358979i) -11.5919532755216+8.064357485351393E-14i) ; maxima
+(num-test (cos 3.14159265358979-3.14159265358979i) -11.59195327552152+3.73164856762037E-14i)
+(num-test (cos -2/3) .7858872607769459)
+(num-test (cos -3/2) 0.0707372016677029)
+(num-test (cos -10/3) -0.9816740047110853)
+(num-test (cos 1234/3) -0.9769114301438807)
+(num-test (cos 1234/10) -0.6387786688749486)
+(num-test (cos 500029/2) 0.962847094896035)
+(num-test (cos 500029/3) -0.6487140328750399)
+(num-test (cos 500029/10) .2565691622107056)
+(num-test (cos 500029/1234) -0.9984566200318916)
+(num-test (cos -3.14159265358979) -1.0)
+(num-test (cos 0.0+3.14159265358979i) 11.5919532755216)
+(num-test (cos 0.00000001+1.0i) 1.543080634815244-1.1752011936438014E-8i)
+(num-test (cos 0.00000001+3.14159265358979i) 11.5919532755216-1.154873935725783E-7i)
+(num-test (cos 1.0+0.00000001i) .5403023058681398-8.414709848078964E-9i)
+(num-test (cos 1.0+3.14159265358979i) 6.263159084280057-9.71792908024146i)
+(num-test (cos 3.14159265358979+0.0i) -1.0)
+(num-test (cos 3.14159265358979+0.00000001i) -1.0+6.982889851335445E-23i)
+(num-test (cos 3.14159265358979+1.0i) -1.543080634815244+8.206300488372603E-15i)
+(num-test (cos 3.14159265358979+3.14159265358979i) -11.5919532755216+8.064357485351393E-14i)
+(num-test (cos 1234.0+0.00000001i) -0.7985506235875843-6.019276547624973E-9i)
+(num-test (cos 1234.0+3.14159265358979i) -9.256761516765916-6.951505596777556i)
+(num-test (cos 1234.0+12.0i) -64983.97009220963-48983.30494825104i)
+(num-test (cos -3.45266983001243932001e-04+0.0e+00i) 9.9999994039535581673e-1)
+(num-test (cos 3.45266983001243932001e-04+0.0e+00i) 9.9999994039535581673e-1)
+(num-test (cos -3.45266983001243932001e-04+1.19209289550781250e-07i) 9.9999994039536292216e-1+4.1159030931163569191e-11i)
+(num-test (cos -3.45266983001243932001e-04-1.19209289550781250e-07i) 9.9999994039536292216e-1-4.1159030931163569191e-11i)
+(num-test (cos 3.45266983001243932001e-04+1.19209289550781250e-07i) 9.9999994039536292216e-1-4.1159030931163569191e-11i)
+(num-test (cos 3.45266983001243932001e-04-1.19209289550781250e-07i) 9.9999994039536292216e-1+4.1159030931163569191e-11i)
+(num-test (cos -3.45266983001243932001e-04+5.0e-01i) 1.1276258979946363573e0+1.7991700040930800151e-4i)
+(num-test (cos -3.45266983001243932001e-04-5.0e-01i) 1.1276258979946363573e0-1.7991700040930800151e-4i)
+(num-test (cos 3.45266983001243932001e-04+5.0e-01i) 1.1276258979946363573e0-1.7991700040930800151e-4i)
+(num-test (cos 3.45266983001243932001e-04-5.0e-01i) 1.1276258979946363573e0+1.7991700040930800151e-4i)
+(num-test (cos -3.45266983001243932001e-04+1.0e+00i) 1.5430805428404715942e0+4.057581624871654840e-4i)
+(num-test (cos -3.45266983001243932001e-04-1.0e+00i) 1.5430805428404715942e0-4.057581624871654840e-4i)
+(num-test (cos 3.45266983001243932001e-04+1.0e+00i) 1.5430805428404715942e0-4.057581624871654840e-4i)
+(num-test (cos 3.45266983001243932001e-04-1.0e+00i) 1.5430805428404715942e0+4.057581624871654840e-4i)
+(num-test (cos -3.45266983001243932001e-04+2.0e+00i) 3.7621954668392959447e0+1.2522351259043242989e-3i)
+(num-test (cos -3.45266983001243932001e-04-2.0e+00i) 3.7621954668392959447e0-1.2522351259043242989e-3i)
+(num-test (cos 3.45266983001243932001e-04+2.0e+00i) 3.7621954668392959447e0-1.2522351259043242989e-3i)
+(num-test (cos 3.45266983001243932001e-04-2.0e+00i) 3.7621954668392959447e0+1.2522351259043242989e-3i)
+(num-test (cos 1.57045105981189525579e+00+0.0e+00i) 3.4526697614152485627e-4)
+(num-test (cos -1.57045105981189525579e+00+0.0e+00i) 3.4526697614152485627e-4)
+(num-test (cos 1.57045105981189525579e+00+1.19209289550781250e-07i) 3.4526697614152730954e-4-1.1920928244535424532e-7i)
+(num-test (cos 1.57045105981189525579e+00-1.19209289550781250e-07i) 3.4526697614152730954e-4+1.1920928244535424532e-7i)
+(num-test (cos -1.57045105981189525579e+00+1.19209289550781250e-07i) 3.4526697614152730954e-4+1.1920928244535424532e-7i)
+(num-test (cos -1.57045105981189525579e+00-1.19209289550781250e-07i) 3.4526697614152730954e-4-1.1920928244535424532e-7i)
+(num-test (cos 1.57045105981189525579e+00+5.0e-01i) 3.8933200722547541227e-4-5.2109527443404709207e-1i)
+(num-test (cos 1.57045105981189525579e+00-5.0e-01i) 3.8933200722547541227e-4+5.2109527443404709207e-1i)
+(num-test (cos -1.57045105981189525579e+00+5.0e-01i) 3.8933200722547541227e-4+5.2109527443404709207e-1i)
+(num-test (cos -1.57045105981189525579e+00-5.0e-01i) 3.8933200722547541227e-4-5.2109527443404709207e-1i)
+(num-test (cos 1.57045105981189525579e+00+1.0e+00i) 5.3277478472520380315e-4-1.1752011235963524659e0i)
+(num-test (cos 1.57045105981189525579e+00-1.0e+00i) 5.3277478472520380315e-4+1.1752011235963524659e0i)
+(num-test (cos -1.57045105981189525579e+00+1.0e+00i) 5.3277478472520380315e-4+1.1752011235963524659e0i)
+(num-test (cos -1.57045105981189525579e+00-1.0e+00i) 5.3277478472520380315e-4-1.1752011235963524659e0i)
+(num-test (cos 1.57045105981189525579e+00+2.0e+00i) 1.2989619299131198016e-3-3.6268601916692946554e0i)
+(num-test (cos 1.57045105981189525579e+00-2.0e+00i) 1.2989619299131198016e-3+3.6268601916692946554e0i)
+(num-test (cos -1.57045105981189525579e+00+2.0e+00i) 1.2989619299131198016e-3+3.6268601916692946554e0i)
+(num-test (cos -1.57045105981189525579e+00-2.0e+00i) 1.2989619299131198016e-3-3.6268601916692946554e0i)
+(num-test (cos 1.57114159377789786021e+00+0.0e+00i) -3.4526697614140239160e-4)
+(num-test (cos -1.57114159377789786021e+00+0.0e+00i) -3.4526697614140239160e-4)
+(num-test (cos 1.57114159377789786021e+00+1.19209289550781250e-07i) -3.4526697614140484486e-4-1.1920928244535424533e-7i)
+(num-test (cos 1.57114159377789786021e+00-1.19209289550781250e-07i) -3.4526697614140484486e-4+1.1920928244535424533e-7i)
+(num-test (cos -1.57114159377789786021e+00+1.19209289550781250e-07i) -3.4526697614140484486e-4+1.1920928244535424533e-7i)
+(num-test (cos -1.57114159377789786021e+00-1.19209289550781250e-07i) -3.4526697614140484486e-4-1.1920928244535424533e-7i)
+(num-test (cos 1.57114159377789786021e+00+5.0e-01i) -3.8933200722533731792e-4-5.2109527443404709209e-1i)
+(num-test (cos 1.57114159377789786021e+00-5.0e-01i) -3.8933200722533731792e-4+5.2109527443404709209e-1i)
+(num-test (cos -1.57114159377789786021e+00+5.0e-01i) -3.8933200722533731792e-4+5.2109527443404709209e-1i)
+(num-test (cos -1.57114159377789786021e+00-5.0e-01i) -3.8933200722533731792e-4-5.2109527443404709209e-1i)
+(num-test (cos 1.57114159377789786021e+00+1.0e+00i) -5.3277478472501483029e-4-1.1752011235963524660e0i)
+(num-test (cos 1.57114159377789786021e+00-1.0e+00i) -5.3277478472501483029e-4+1.1752011235963524660e0i)
+(num-test (cos -1.57114159377789786021e+00+1.0e+00i) -5.3277478472501483029e-4+1.1752011235963524660e0i)
+(num-test (cos -1.57114159377789786021e+00-1.0e+00i) -5.3277478472501483029e-4-1.1752011235963524660e0i)
+(num-test (cos 1.57114159377789786021e+00+2.0e+00i) -1.2989619299126590655e-3-3.6268601916692946556e0i)
+(num-test (cos 1.57114159377789786021e+00-2.0e+00i) -1.2989619299126590655e-3+3.6268601916692946556e0i)
+(num-test (cos -1.57114159377789786021e+00+2.0e+00i) -1.2989619299126590655e-3+3.6268601916692946556e0i)
+(num-test (cos -1.57114159377789786021e+00-2.0e+00i) -1.2989619299126590655e-3-3.6268601916692946556e0i)
+(num-test (cos 3.14124738660679181379e+00+0.0e+00i) -9.9999994039535581667e-1)
+(num-test (cos -3.14124738660679181379e+00+0.0e+00i) -9.9999994039535581667e-1)
+(num-test (cos 3.14124738660679181379e+00+1.19209289550781250e-07i) -9.9999994039536292209e-1-4.1159030931185115142e-11i)
+(num-test (cos 3.14124738660679181379e+00-1.19209289550781250e-07i) -9.9999994039536292209e-1+4.1159030931185115142e-11i)
+(num-test (cos -3.14124738660679181379e+00+1.19209289550781250e-07i) -9.9999994039536292209e-1+4.1159030931185115142e-11i)
+(num-test (cos -3.14124738660679181379e+00-1.19209289550781250e-07i) -9.9999994039536292209e-1-4.1159030931185115142e-11i)
+(num-test (cos 3.14124738660679181379e+00+5.0e-01i) -1.1276258979946363572e0-1.7991700040940218455e-4i)
+(num-test (cos 3.14124738660679181379e+00-5.0e-01i) -1.1276258979946363572e0+1.7991700040940218455e-4i)
+(num-test (cos -3.14124738660679181379e+00+5.0e-01i) -1.1276258979946363572e0+1.7991700040940218455e-4i)
+(num-test (cos -3.14124738660679181379e+00-5.0e-01i) -1.1276258979946363572e0-1.7991700040940218455e-4i)
+(num-test (cos 3.14124738660679181379e+00+1.0e+00i) -1.5430805428404715941e0-4.0575816248737789049e-4i)
+(num-test (cos 3.14124738660679181379e+00-1.0e+00i) -1.5430805428404715941e0+4.0575816248737789049e-4i)
+(num-test (cos -3.14124738660679181379e+00+1.0e+00i) -1.5430805428404715941e0+4.0575816248737789049e-4i)
+(num-test (cos -3.14124738660679181379e+00-1.0e+00i) -1.5430805428404715941e0-4.0575816248737789049e-4i)
+(num-test (cos 3.14124738660679181379e+00+2.0e+00i) -3.7621954668392959444e0-1.2522351259049798196e-3i)
+(num-test (cos 3.14124738660679181379e+00-2.0e+00i) -3.7621954668392959444e0+1.2522351259049798196e-3i)
+(num-test (cos -3.14124738660679181379e+00+2.0e+00i) -3.7621954668392959444e0+1.2522351259049798196e-3i)
+(num-test (cos -3.14124738660679181379e+00-2.0e+00i) -3.7621954668392959444e0-1.2522351259049798196e-3i)
+(num-test (cos 3.14193792057279441821e+00+0.0e+00i) -9.9999994039535581675e-1)
+(num-test (cos -3.14193792057279441821e+00+0.0e+00i) -9.9999994039535581675e-1)
+(num-test (cos 3.14193792057279441821e+00+1.19209289550781250e-07i) -9.9999994039536292218e-1+4.1159030931155917289e-11i)
+(num-test (cos 3.14193792057279441821e+00-1.19209289550781250e-07i) -9.9999994039536292218e-1-4.1159030931155917289e-11i)
+(num-test (cos -3.14193792057279441821e+00+1.19209289550781250e-07i) -9.9999994039536292218e-1-4.1159030931155917289e-11i)
+(num-test (cos -3.14193792057279441821e+00-1.19209289550781250e-07i) -9.9999994039536292218e-1+4.1159030931155917289e-11i)
+(num-test (cos 3.14193792057279441821e+00+5.0e-01i) -1.1276258979946363573e0+1.7991700040927455302e-4i)
+(num-test (cos 3.14193792057279441821e+00-5.0e-01i) -1.1276258979946363573e0-1.7991700040927455302e-4i)
+(num-test (cos -3.14193792057279441821e+00+5.0e-01i) -1.1276258979946363573e0-1.7991700040927455302e-4i)
+(num-test (cos -3.14193792057279441821e+00-5.0e-01i) -1.1276258979946363573e0+1.7991700040927455302e-4i)
+(num-test (cos 3.14193792057279441821e+00+1.0e+00i) -1.5430805428404715943e0+4.0575816248709004923e-4i)
+(num-test (cos 3.14193792057279441821e+00-1.0e+00i) -1.5430805428404715943e0-4.0575816248709004923e-4i)
+(num-test (cos -3.14193792057279441821e+00+1.0e+00i) -1.5430805428404715943e0-4.0575816248709004923e-4i)
+(num-test (cos -3.14193792057279441821e+00-1.0e+00i) -1.5430805428404715943e0+4.0575816248709004923e-4i)
+(num-test (cos 3.14193792057279441821e+00+2.0e+00i) -3.7621954668392959448e0+1.2522351259040914950e-3i)
+(num-test (cos 3.14193792057279441821e+00-2.0e+00i) -3.7621954668392959448e0-1.2522351259040914950e-3i)
+(num-test (cos -3.14193792057279441821e+00+2.0e+00i) -3.7621954668392959448e0-1.2522351259040914950e-3i)
+(num-test (cos -3.14193792057279441821e+00-2.0e+00i) -3.7621954668392959448e0+1.2522351259040914950e-3i)
+(num-test (cos 4.71204371340168837179e+00+0.0e+00i) -3.4526697614164732094e-4)
+(num-test (cos -4.71204371340168837179e+00+0.0e+00i) -3.4526697614164732094e-4)
+(num-test (cos 4.71204371340168837179e+00+1.19209289550781250e-07i) -3.4526697614164977421e-4+1.1920928244535424532e-7i)
+(num-test (cos 4.71204371340168837179e+00-1.19209289550781250e-07i) -3.4526697614164977421e-4-1.1920928244535424532e-7i)
+(num-test (cos -4.71204371340168837179e+00+1.19209289550781250e-07i) -3.4526697614164977421e-4-1.1920928244535424532e-7i)
+(num-test (cos -4.71204371340168837179e+00-1.19209289550781250e-07i) -3.4526697614164977421e-4+1.1920928244535424532e-7i)
+(num-test (cos 4.71204371340168837179e+00+5.0e-01i) -3.8933200722561350661e-4+5.2109527443404709205e-1i)
+(num-test (cos 4.71204371340168837179e+00-5.0e-01i) -3.8933200722561350661e-4-5.2109527443404709205e-1i)
+(num-test (cos -4.71204371340168837179e+00+5.0e-01i) -3.8933200722561350661e-4-5.2109527443404709205e-1i)
+(num-test (cos -4.71204371340168837179e+00-5.0e-01i) -3.8933200722561350661e-4+5.2109527443404709205e-1i)
+(num-test (cos 4.71204371340168837179e+00+1.0e+00i) -5.3277478472539277601e-4+1.1752011235963524659e0i)
+(num-test (cos 4.71204371340168837179e+00-1.0e+00i) -5.3277478472539277601e-4-1.1752011235963524659e0i)
+(num-test (cos -4.71204371340168837179e+00+1.0e+00i) -5.3277478472539277601e-4-1.1752011235963524659e0i)
+(num-test (cos -4.71204371340168837179e+00-1.0e+00i) -5.3277478472539277601e-4+1.1752011235963524659e0i)
+(num-test (cos 4.71204371340168837179e+00+2.0e+00i) -1.2989619299135805376e-3+3.6268601916692946552e0i)
+(num-test (cos 4.71204371340168837179e+00-2.0e+00i) -1.2989619299135805376e-3-3.6268601916692946552e0i)
+(num-test (cos -4.71204371340168837179e+00+2.0e+00i) -1.2989619299135805376e-3-3.6268601916692946552e0i)
+(num-test (cos -4.71204371340168837179e+00-2.0e+00i) -1.2989619299135805376e-3+3.6268601916692946552e0i)
+(num-test (cos 4.71273424736769097620e+00+0.0e+00i) 3.4526697614127992692e-4)
+(num-test (cos -4.71273424736769097620e+00+0.0e+00i) 3.4526697614127992692e-4)
+(num-test (cos 4.71273424736769097620e+00+1.19209289550781250e-07i) 3.4526697614128238019e-4+1.1920928244535424533e-7i)
+(num-test (cos 4.71273424736769097620e+00-1.19209289550781250e-07i) 3.4526697614128238019e-4-1.1920928244535424533e-7i)
+(num-test (cos -4.71273424736769097620e+00+1.19209289550781250e-07i) 3.4526697614128238019e-4-1.1920928244535424533e-7i)
+(num-test (cos -4.71273424736769097620e+00-1.19209289550781250e-07i) 3.4526697614128238019e-4+1.1920928244535424533e-7i)
+(num-test (cos 4.71273424736769097620e+00+5.0e-01i) 3.8933200722519922358e-4+5.2109527443404709212e-1i)
+(num-test (cos 4.71273424736769097620e+00-5.0e-01i) 3.8933200722519922358e-4-5.2109527443404709212e-1i)
+(num-test (cos -4.71273424736769097620e+00+5.0e-01i) 3.8933200722519922358e-4-5.2109527443404709212e-1i)
+(num-test (cos -4.71273424736769097620e+00-5.0e-01i) 3.8933200722519922358e-4+5.2109527443404709212e-1i)
+(num-test (cos 4.71273424736769097620e+00+1.0e+00i) 5.3277478472482585742e-4+1.1752011235963524660e0i)
+(num-test (cos 4.71273424736769097620e+00-1.0e+00i) 5.3277478472482585742e-4-1.1752011235963524660e0i)
+(num-test (cos -4.71273424736769097620e+00+1.0e+00i) 5.3277478472482585742e-4-1.1752011235963524660e0i)
+(num-test (cos -4.71273424736769097620e+00-1.0e+00i) 5.3277478472482585742e-4+1.1752011235963524660e0i)
+(num-test (cos 4.71273424736769097620e+00+2.0e+00i) 1.2989619299121983294e-3+3.6268601916692946557e0i)
+(num-test (cos 4.71273424736769097620e+00-2.0e+00i) 1.2989619299121983294e-3-3.6268601916692946557e0i)
+(num-test (cos -4.71273424736769097620e+00+2.0e+00i) 1.2989619299121983294e-3-3.6268601916692946557e0i)
+(num-test (cos -4.71273424736769097620e+00-2.0e+00i) 1.2989619299121983294e-3+3.6268601916692946557e0i)
+(num-test (cos 6.28284004019658492979e+00+0.0e+00i) 9.9999994039535581662e-1)
+(num-test (cos -6.28284004019658492979e+00+0.0e+00i) 9.9999994039535581662e-1)
+(num-test (cos 6.28284004019658492979e+00+1.19209289550781250e-07i) 9.9999994039536292205e-1+4.1159030931199714069e-11i)
+(num-test (cos 6.28284004019658492979e+00-1.19209289550781250e-07i) 9.9999994039536292205e-1-4.1159030931199714069e-11i)
+(num-test (cos -6.28284004019658492979e+00+1.19209289550781250e-07i) 9.9999994039536292205e-1-4.1159030931199714069e-11i)
+(num-test (cos -6.28284004019658492979e+00-1.19209289550781250e-07i) 9.9999994039536292205e-1+4.1159030931199714069e-11i)
+(num-test (cos 6.28284004019658492979e+00+5.0e-01i) 1.1276258979946363572e0+1.7991700040946600032e-4i)
+(num-test (cos 6.28284004019658492979e+00-5.0e-01i) 1.1276258979946363572e0-1.7991700040946600032e-4i)
+(num-test (cos -6.28284004019658492979e+00+5.0e-01i) 1.1276258979946363572e0-1.7991700040946600032e-4i)
+(num-test (cos -6.28284004019658492979e+00-5.0e-01i) 1.1276258979946363572e0+1.7991700040946600032e-4i)
+(num-test (cos 6.28284004019658492979e+00+1.0e+00i) 1.5430805428404715941e0+4.0575816248752181112e-4i)
+(num-test (cos 6.28284004019658492979e+00-1.0e+00i) 1.5430805428404715941e0-4.0575816248752181112e-4i)
+(num-test (cos -6.28284004019658492979e+00+1.0e+00i) 1.5430805428404715941e0-4.0575816248752181112e-4i)
+(num-test (cos -6.28284004019658492979e+00-1.0e+00i) 1.5430805428404715941e0+4.0575816248752181112e-4i)
+(num-test (cos 6.28284004019658492979e+00+2.0e+00i) 3.7621954668392959443e0+1.2522351259054239819e-3i)
+(num-test (cos 6.28284004019658492979e+00-2.0e+00i) 3.7621954668392959443e0-1.2522351259054239819e-3i)
+(num-test (cos -6.28284004019658492979e+00+2.0e+00i) 3.7621954668392959443e0-1.2522351259054239819e-3i)
+(num-test (cos -6.28284004019658492979e+00-2.0e+00i) 3.7621954668392959443e0+1.2522351259054239819e-3i)
+(num-test (cos 6.28353057416258753420e+00+0.0e+00i) 9.9999994039535581679e-1)
+(num-test (cos -6.28353057416258753420e+00+0.0e+00i) 9.9999994039535581679e-1)
+(num-test (cos 6.28353057416258753420e+00+1.19209289550781250e-07i) 9.9999994039536292222e-1-4.1159030931141318362e-11i)
+(num-test (cos 6.28353057416258753420e+00-1.19209289550781250e-07i) 9.9999994039536292222e-1+4.1159030931141318362e-11i)
+(num-test (cos -6.28353057416258753420e+00+1.19209289550781250e-07i) 9.9999994039536292222e-1+4.1159030931141318362e-11i)
+(num-test (cos -6.28353057416258753420e+00-1.19209289550781250e-07i) 9.9999994039536292222e-1-4.1159030931141318362e-11i)
+(num-test (cos 6.28353057416258753420e+00+5.0e-01i) 1.1276258979946363574e0-1.7991700040921073725e-4i)
+(num-test (cos 6.28353057416258753420e+00-5.0e-01i) 1.1276258979946363574e0+1.7991700040921073725e-4i)
+(num-test (cos -6.28353057416258753420e+00+5.0e-01i) 1.1276258979946363574e0+1.7991700040921073725e-4i)
+(num-test (cos -6.28353057416258753420e+00-5.0e-01i) 1.1276258979946363574e0-1.7991700040921073725e-4i)
+(num-test (cos 6.28353057416258753420e+00+1.0e+00i) 1.5430805428404715943e0-4.0575816248694612861e-4i)
+(num-test (cos 6.28353057416258753420e+00-1.0e+00i) 1.5430805428404715943e0+4.0575816248694612861e-4i)
+(num-test (cos -6.28353057416258753420e+00+1.0e+00i) 1.5430805428404715943e0+4.0575816248694612861e-4i)
+(num-test (cos -6.28353057416258753420e+00-1.0e+00i) 1.5430805428404715943e0-4.0575816248694612861e-4i)
+(num-test (cos 6.28353057416258753420e+00+2.0e+00i) 3.7621954668392959449e0-1.2522351259036473328e-3i)
+(num-test (cos 6.28353057416258753420e+00-2.0e+00i) 3.7621954668392959449e0+1.2522351259036473328e-3i)
+(num-test (cos -6.28353057416258753420e+00+2.0e+00i) 3.7621954668392959449e0+1.2522351259036473328e-3i)
+(num-test (cos -6.28353057416258753420e+00-2.0e+00i) 3.7621954668392959449e0-1.2522351259036473328e-3i)
+(num-test (cos 9.42443269378637893396e+00+0.0e+00i) -9.9999994039535581689e-1)
+(num-test (cos -9.42443269378637893396e+00+0.0e+00i) -9.9999994039535581689e-1)
+(num-test (cos 9.42443269378637893396e+00+1.19209289550781250e-07i) -9.9999994039536292231e-1-4.1159030931108433883e-11i)
+(num-test (cos 9.42443269378637893396e+00-1.19209289550781250e-07i) -9.9999994039536292231e-1+4.1159030931108433883e-11i)
+(num-test (cos -9.42443269378637893396e+00+1.19209289550781250e-07i) -9.9999994039536292231e-1+4.1159030931108433883e-11i)
+(num-test (cos -9.42443269378637893396e+00-1.19209289550781250e-07i) -9.9999994039536292231e-1-4.1159030931108433883e-11i)
+(num-test (cos 9.42443269378637893396e+00+5.0e-01i) -1.1276258979946363575e0-1.7991700040906699050e-4i)
+(num-test (cos 9.42443269378637893396e+00-5.0e-01i) -1.1276258979946363575e0+1.7991700040906699050e-4i)
+(num-test (cos -9.42443269378637893396e+00+5.0e-01i) -1.1276258979946363575e0+1.7991700040906699050e-4i)
+(num-test (cos -9.42443269378637893396e+00-5.0e-01i) -1.1276258979946363575e0-1.7991700040906699050e-4i)
+(num-test (cos 9.42443269378637893396e+00+1.0e+00i) -1.5430805428404715945e0-4.0575816248662194348e-4i)
+(num-test (cos 9.42443269378637893396e+00-1.0e+00i) -1.5430805428404715945e0+4.0575816248662194348e-4i)
+(num-test (cos -9.42443269378637893396e+00+1.0e+00i) -1.5430805428404715945e0+4.0575816248662194348e-4i)
+(num-test (cos -9.42443269378637893396e+00-1.0e+00i) -1.5430805428404715945e0-4.0575816248662194348e-4i)
+(num-test (cos 9.42443269378637893396e+00+2.0e+00i) -3.7621954668392959453e0-1.2522351259026468452e-3i)
+(num-test (cos 9.42443269378637893396e+00-2.0e+00i) -3.7621954668392959453e0+1.2522351259026468452e-3i)
+(num-test (cos -9.42443269378637893396e+00+2.0e+00i) -3.7621954668392959453e0+1.2522351259026468452e-3i)
+(num-test (cos -9.42443269378637893396e+00-2.0e+00i) -3.7621954668392959453e0-1.2522351259026468452e-3i)
+(num-test (cos 9.42512322775237976202e+00+0.0e+00i) -9.9999994039535581714e-1)
+(num-test (cos -9.42512322775237976202e+00+0.0e+00i) -9.9999994039535581714e-1)
+(num-test (cos 9.42512322775237976202e+00+1.19209289550781250e-07i) -9.9999994039536292257e-1+4.1159030931020840323e-11i)
+(num-test (cos 9.42512322775237976202e+00-1.19209289550781250e-07i) -9.9999994039536292257e-1-4.1159030931020840323e-11i)
+(num-test (cos -9.42512322775237976202e+00+1.19209289550781250e-07i) -9.9999994039536292257e-1-4.1159030931020840323e-11i)
+(num-test (cos -9.42512322775237976202e+00-1.19209289550781250e-07i) -9.9999994039536292257e-1+4.1159030931020840323e-11i)
+(num-test (cos 9.42512322775237976202e+00+5.0e-01i) -1.1276258979946363577e0+1.7991700040868409591e-4i)
+(num-test (cos 9.42512322775237976202e+00-5.0e-01i) -1.1276258979946363577e0-1.7991700040868409591e-4i)
+(num-test (cos -9.42512322775237976202e+00+5.0e-01i) -1.1276258979946363577e0-1.7991700040868409591e-4i)
+(num-test (cos -9.42512322775237976202e+00-5.0e-01i) -1.1276258979946363577e0+1.7991700040868409591e-4i)
+(num-test (cos 9.42512322775237976202e+00+1.0e+00i) -1.5430805428404715949e0+4.0575816248575841970e-4i)
+(num-test (cos 9.42512322775237976202e+00-1.0e+00i) -1.5430805428404715949e0-4.0575816248575841970e-4i)
+(num-test (cos -9.42512322775237976202e+00+1.0e+00i) -1.5430805428404715949e0-4.0575816248575841970e-4i)
+(num-test (cos -9.42512322775237976202e+00-1.0e+00i) -1.5430805428404715949e0+4.0575816248575841970e-4i)
+(num-test (cos 9.42512322775237976202e+00+2.0e+00i) -3.7621954668392959462e0+1.2522351258999818715e-3i)
+(num-test (cos 9.42512322775237976202e+00-2.0e+00i) -3.7621954668392959462e0-1.2522351258999818715e-3i)
+(num-test (cos -9.42512322775237976202e+00+2.0e+00i) -3.7621954668392959462e0-1.2522351258999818715e-3i)
+(num-test (cos -9.42512322775237976202e+00-2.0e+00i) -3.7621954668392959462e0+1.2522351258999818715e-3i)
+(num-test (cos 0) 1.0)
+(num-test (cos -2.225073858507201399999999999999999999996E-308) 1.000E0)
+(num-test (cos 1.110223024625156799999999999999999999997E-16) 9.999999999999999999999999999999938370242E-1)
+
+(num-test (cos 22) -9.999608263946371264541747392126937741354E-1)
+(num-test (cos 32767.) 9.8226335176928229845654E-1)
+(num-test (cos 8388607.) -1.2349580912475928183718E-1)
+(num-test (cos 2147483647.) -6.8883669187794383467976E-1)
+(num-test (cos (* pi (cos (* pi (cos (log (+ pi 20))))))) -1.0) ; actually there's a 3.93216e-35 imag part
+(num-test (cos (/ pi 10)) (/ (sqrt (+ 10 (* 2 (sqrt 5)))) 4))
+(num-test (cos (/ pi 12)) (* (/ (sqrt 2) 4) (+ (sqrt 3) 1)))
+(num-test (cos (/ pi 12)) (/ (+ (sqrt 6) (sqrt 2)) 4))
+(num-test (cos (/ pi 128)) (* 1/2 (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt 2)))))))))))))
+(num-test (cos (/ pi 15)) (/ (+ (sqrt (+ 30 (* 6 (sqrt 5)))) (sqrt 5) -1) 8))
+(num-test (cos (/ pi 16)) (/ (sqrt (+ 2 (sqrt (+ 2 (sqrt 2))))) 2))
+(num-test (cos (/ pi 20)) (/ (sqrt (+ 8 (* 2 (sqrt (+ 10 (* 2 (sqrt 5))))))) 4))
+(num-test (cos (/ pi 24)) (/ (sqrt (+ 2 (sqrt (+ 2 (sqrt 3))))) 2))
+(num-test (cos (/ pi 3)) 1/2)
+(num-test (cos (/ pi 3)) 1/2)
+(num-test (cos (/ pi 30)) (/ (sqrt (+ 7 (sqrt 5) (sqrt (* 6 (+ 5 (sqrt 5)))))) 4))
+(num-test (cos (/ pi 32))      (/ (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt 2))))))) 2))
+(num-test (cos (/ pi 4)) (/ (sqrt 2) 2))
+(num-test (cos (/ pi 5)) (/ (+ 1 (sqrt 5)) 4))
+(num-test (cos (/ pi 6)) (/ (sqrt 3) 2))
+(num-test (cos (/ pi 64))  (* 1/2 (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt 2)))))))))))
+(num-test (cos (/ pi 8)) (/ (sqrt (+ 2 (sqrt 2))) 2))
+(num-test (cos (log (+ pi 20))) -0.99999999924368)
+(num-test (* (cos (/ pi 11)) (cos (/ (* 2 pi) 11)) (cos (/ (* 3 pi) 11)) (cos (/ (* 4 pi) 11)) (cos (/ (* 5 pi) 11))) 1/32)
+(num-test (* (cos (/ pi 7)) (cos (/ (* 2 pi) 7)) (cos (/ (* 3 pi) 7))) 1/8)
+(num-test (* (cos (/ pi 9)) (cos (/ (* 2 pi) 9)) (cos (/ (* 4 pi) 9))) 1/8)
+(num-test (* (cos (/ pi 9)) (cos (/ (* 2 pi) 9)) (cos (/ (* 4 pi) 9))) 1/8)
+(num-test (do ((i 1 (+ i 1)) (sum 0.0 (+ sum (cos (/ (* 2 pi i) 11))))) ((= i 6) sum)) -0.5)
+(num-test (let ((a (/ (* 2 pi) 13))) (* 8 (+ (cos a) (cos (* 5 a))) (+ (cos (* 2 a)) (cos (* 3 a))) (+ (cos (* 4 a)) (cos (* 6 a))))) -1.0)
+
+(for-each
+ (lambda (num-and-val)
+   (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'cos num (cos num) val)))
+ (vector (list 0 1) (list 1 0.54030230586814) (list 2 -0.41614683654714) (list 3 -0.98999249660045)
+	 (list -1 0.54030230586814) (list -2 -0.41614683654714) (list -3 -0.98999249660045)
+	 (list 1/2 0.87758256189037) (list 1/3 0.94495694631474) (list -1/2 0.87758256189037)
+	 (list -1/3 0.94495694631474) (list 1/9223372036854775807 1.0) (list 0.0 1.0) (list 1.0 0.54030230586814)
+	 (list 2.0 -0.41614683654714) (list -2.0 -0.41614683654714) (list 1.000000000000000000000000000000000000002E-309 1.000E0)
+	 (list 0+1i 1.5430806348152) (list 0+2i 3.7621956910836)
+	 (list 0-1i 1.5430806348152) (list 1+1i 0.83373002513115-0.98889770576287i) (list 1-1i 0.83373002513115+0.98889770576287i)
+	 (list -1+1i 0.83373002513115+0.98889770576287i) (list -1-1i 0.83373002513115-0.98889770576287i)
+	 (list 0.1+0.1i 0.9999833333373-0.0099999888888898i) (list 1e-16+1e-16i 1-1e-32i)
+	 ))
+
+;; these are from the error analysis package from ETH, Gaston H. Gonnet
+(num-test (cos -1.79424124483688191e-11) 9.999999999999999999998390349177663098196E-1)
+(num-test (sqrt 3.63861067050296029e-308) 1.907514264822929257351751954551699751189E-154)
+(if with-bignums (num-test (tan 10526671570.5) 1.140653720398103887405511659009364634384E12))
+(if with-bignums (num-test (tan (modulo 10526671570.5 (* 2 pi))) 1.140653720398103899436689297531030608688E12))
+(num-test (modulo 10526671570.5 (* 2 pi)) 4.712388980383813167439843967777959731718E0)
+;; this is so sensitive because (cos 4.712388980383813167439843967777959731718E0) = -8.766902541211071412945944658266052999824E-13
+;; unfair!
+
+(test (cos) 'error)
+(test (cos "hi") 'error)
+(test (cos 1.0+23.0i 1.0+23.0i) 'error)
+(test (cos 0 1) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (cos arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(unless (provided? 'osx) ; why does this cause a segfault on a mac -- can't run gdb, and lldb crashes
+  (let* ((angle 0.0)
+         (z 1.18)
+         (result (* z (cos angle))))
+    (do ((k 0 (+ 1 k)))
+        ((= k 1000))
+      (set! result (* z (cos result))))
+    ;; result: 0.81194462369499
+    ;; (let ((x 0.0))
+    ;;   (do ((i 0 (+ 1 i)))
+    ;;       ((= i 10000))
+    ;;     (set! x (+ x (* (expt -1 i)
+    ;;		           (/ (bes-jn (+ 1 (* 2 i)) (* z (+ 1 (* 2 i))))
+    ;;		              (+ 1 (* 2 i)))))))
+    ;;   (* 2 x))
+    ;; 0.81194498071946
+    (let ((x (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos 0.0))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
+      ;; 47? calls here so we're at around .812 (oscillating around .8119)
+      (test (< (abs (- x result)) .001) #t))))
+
+(when full-s7test
+(let () ; this is trying to cause a stack overflow
+  (define (f1 z)
+    (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z   (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos 0.0)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
+
+  (num-test (f1 0.5) 0.4501836112948736)
+  (let ((c #f) (i 0)) (call/cc (lambda (c1) (set! c c1))) (set! i (+ i 1)) (let ((result (f1 0.5))) (if (< i 2) (c)) (num-test result 0.4501836112948736)))))
+
+
+(let ()
+  (define (dht data)
+    ;; the Hartley transform of 'data'
+    (let* ((len (vector-length data))
+	   (arr (make-vector len 0.0))
+	   (w (/ (* 2.0 pi) len)))
+      (do ((i 0 (+ 1 i)))
+	  ((= i len))
+	(do ((j 0 (+ 1 j)))
+	    ((= j len))
+	  (vector-set! arr i (+ (vector-ref arr i)
+				(* (vector-ref data j)
+				   (+ (cos (* i j w))
+				      (sin (* i j w))))))))
+      arr))
+  (let ((data (list->vector '(0.9196 0.9457 0.0268 0.0839 0.1974 0.1060 0.1463 0.3513 0.0391 0.6310
+				     0.9556 0.6259 0.9580 0.8848 0.0104 0.1440 0.0542 0.3001 0.1844 0.3781
+				     0.9641 0.6051 0.3319 0.6143 0.1828 0.2290 0.4026 0.5990 0.7906 0.0403
+				     0.7882 0.1591)))
+	(saved-data (make-vector 32 0.0)))
+    (do ((i 0 (+ i 1)))
+	((= i 32))
+      (vector-set! saved-data i (vector-ref data i)))
+    (dht data)
+    (dht data)
+    (let ((mx 0.0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 32))
+	(let ((err (abs (- (vector-ref data i) (vector-ref saved-data i)))))
+	  (if (> err mx)
+	      (set! mx err))))
+      (if (> mx 1e-6)
+	  (format #t "dht error: ~A~%" mx)))))
+
+(let ((coss (list
+	     1.00000000000000000000000000000000000000000000000000000000000000000000
+	     0.99500416527802576609556198780387029483857622541508403595935274468526
+	     0.98006657784124163112419651674816887739352436080656799405254829012618
+	     0.95533648912560601964231022756804989824421408263203767451761361222758
+	     0.92106099400288508279852673205180161402585956931985044561508926713514
+	     0.87758256189037271611628158260382965199164519710974405299761086831595
+	     0.82533561490967829724095249895537603887809103918847038136974977367156
+	     0.76484218728448842625585999019186490926821055037370335607293245825206
+	     0.69670670934716542092074998164232492610178601370806078363714489414924
+	     0.62160996827066445648471615140713350872176136659123900757638348453897
+	     0.54030230586813971740093660744297660373231042061792222767009725538110
+	     0.45359612142557738777137005178471612212146729566259504745593805541880
+	     0.36235775447667357763837335562307602033994778557664862648774972093613
+	     0.26749882862458740699798410929287135927592992167912966191725336742182
+	     0.16996714290024093861674803520364980292818392102853430898236521149464
+	     0.07073720166770291008818985143426870908509102756334686942264541719092
+	     -0.02919952230128872620577046294649852444486472109384694500313007908245
+	     -0.12884449429552468408764285733487351410164007964520297633178213994289
+	     -0.22720209469308705531667430653058073247695158653826107158496911100681
+	     -0.32328956686350342227883369508031017459419076544223959990115436505106
+	     -0.41614683654714238699756822950076218976600077107554489075514997378196
+	     -0.50484610459985745162093852371916747040702337674136205964819622353659
+	     -0.58850111725534570852414261265492841629376036669872798974753517400616
+	     -0.66627602127982419331788057116601723016327537100376988865266957182167
+	     -0.73739371554124549960882222733478290843301289199228479878436568873073
+	     -0.80114361554693371483350279046735166442856784876782013507459799166202
+	     -0.85688875336894723379770215164520111235392263823324404910501242714241
+	     -0.90407214201706114798252728194333012633184973516362471104126694868604
+	     -0.94222234066865815258678811736615401246341423446824662018098201995710
+	     -0.97095816514959052178110666934553217911761475942423954213867099245327
+	     -0.98999249660044545727157279473126130239367909661558832881408593292832
+	     -0.99913515027327946449237605454146626283664166994794274354471598254947
+	     -0.99829477579475308466166072228358269144701258595166016759508002045139)))
+  (let ((mxerr 0.0))
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x 0.1)))
+	((= i 32))
+      (let ((err (abs (- (cos x) (list-ref coss i)))))
+	(if (> err mxerr)
+	    (set! mxerr err))))
+    (if (> mxerr 1e-12) (format #t "cos err: ~A~%" mxerr))))
+
+(when with-bignums
+  (num-test (cos 100000000000000000000000000000000)   -9.207313839241906875982573440296245746235E-1)
+  (num-test (cos 100000000000000000000000000000000.0) -9.207313839241906875982573440296245746235E-1)
+  (let-temporarily (((*s7* 'bignum-precision) 500))
+    (let ((cos-vals (list ; arprec mathtool table[Cos[k/20], {k, 0, 30}]
+		     "1.00000000000000000000000000000000000000000000000000000000000000000000"
+		     "0.99875026039496624656287081115652109495898026202467575301500996478674"
+		     "0.99500416527802576609556198780387029483857622541508403595935274468526"
+		     "0.98877107793604228673498099865433895791835001710693704356129574806756"
+		     "0.98006657784124163112419651674816887739352436080656799405254829012618"
+		     "0.96891242171064478414459544949418919980413419028744283114812812428894"
+		     "0.95533648912560601964231022756804989824421408263203767451761361222758"
+		     "0.93937271284737892003503235730366558297406104641303414382897205809282"
+		     "0.92106099400288508279852673205180161402585956931985044561508926713514"
+		     "0.90044710235267692166884061148644643975762309272876915613354673932299"
+		     "0.87758256189037271611628158260382965199164519710974405299761086831595"
+		     "0.85252452205950574280498179761777305104031900079223767166865534849083"
+		     "0.82533561490967829724095249895537603887809103918847038136974977367156"
+		     "0.79608379854905582891760457067990587351049589381429244823834230313846"
+		     "0.76484218728448842625585999019186490926821055037370335607293245825206"
+		     "0.73168886887382088631183875300008454384054127605077248250768322022075"
+		     "0.69670670934716542092074998164232492610178601370806078363714489414924"
+		     "0.65998314588498217039541602946146607363862433893076798146474793887138"
+		     "0.62160996827066445648471615140713350872176136659123900757638348453897"
+		     "0.58168308946388349416618097376045571713934034193760200851355170750073"
+		     "0.54030230586813971740093660744297660373231042061792222767009725538110"
+		     "0.49757104789172699029084957281210067725147811164693171708781576506313"
+		     "0.45359612142557738777137005178471612212146729566259504745593805541880"
+		     "0.40848744088415729815257671880991853998462713510786075458328732035938"
+		     "0.36235775447667357763837335562307602033994778557664862648774972093613"
+		     "0.31532236239526866544753855243803801372798570798275680751499914045328"
+		     "0.26749882862458740699798410929287135927592992167912966191725336742182"
+		     "0.21900668709304158142002217301062666089672421266400567061594451723594"
+		     "0.16996714290024093861674803520364980292818392102853430898236521149464"
+		     "0.12050276936736657053286662724801883979155423770384722087315404654227"
+		     "0.07073720166770291008818985143426870908509102756334686942264541719092")))
+      (do ((k 1 (+ k 1)))
+	  ((= k 30))
+	(let ((cos-val-2 (number->string (cos (bignum (/ k 20))))))
+	  (if (not (string=? (substring (list-ref cos-vals k) 3 60) (substring cos-val-2 2 59)))
+	      (format #t ";(cos (/ ~A 20)) mp: ~A does not match~%~A~%" k (substring (list-ref cos-vals k) 3 60) (substring cos-val-2 2 59))))))))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; tan
+;;; --------------------------------------------------------------------------------
+
+(num-test (tan 0) 0.0)
+(num-test (tan 1) 1.55740772465490)
+(num-test (tan -1) -1.55740772465490)
+(num-test (tan 0/1) 0.0)
+(num-test (tan 0/2) 0.0)
+(num-test (tan 0/3) 0.0)
+(num-test (tan 0/10) 0.0)
+(num-test (tan 0/1234) 0.0)
+(num-test (tan 0/500029) 0.0)
+(num-test (tan 1/1) 1.55740772465490)
+(num-test (tan -1/1) -1.55740772465490)
+(num-test (tan 1/2) 0.54630248984379)
+(num-test (tan -1/2) -0.54630248984379)
+(num-test (tan 1/3) 0.34625354951058)
+(num-test (tan -1/3) -0.34625354951058)
+(num-test (tan 1/10) 0.10033467208545)
+(num-test (tan -1/10) -0.10033467208545)
+(num-test (tan 1/1234) 0.00081037294887)
+(num-test (tan -1/1234) -0.00081037294887)
+(num-test (tan 1/500029) 0.00000199988401)
+(num-test (tan -1/500029) -0.00000199988401)
+(num-test (tan 2/2) 1.55740772465490)
+(num-test (tan -2/2) -1.55740772465490)
+(num-test (tan 2/3) 0.78684288947298)
+(num-test (tan -2/3) -0.78684288947298)
+(num-test (tan 2/10) 0.20271003550867)
+(num-test (tan -2/10) -0.20271003550867)
+(num-test (tan 2/1234) 0.00162074696208)
+(num-test (tan -2/1234) -0.00162074696208)
+(num-test (tan 2/500029) 0.00000399976801)
+(num-test (tan -2/500029) -0.00000399976801)
+(num-test (tan 3/2) 14.10141994717166)
+(num-test (tan -3/2) -14.10141994717166)
+(num-test (tan 3/3) 1.55740772465490)
+(num-test (tan -3/3) -1.55740772465490)
+(num-test (tan 3/10) 0.30933624960962)
+(num-test (tan -3/10) -0.30933624960962)
+(num-test (tan 3/1234) 0.00243112310401)
+(num-test (tan -3/1234) -0.00243112310401)
+(num-test (tan 3/500029) 0.00000599965202)
+(num-test (tan -3/500029) -0.00000599965202)
+(num-test (tan 10/10) 1.55740772465490)
+(num-test (tan -10/10) -1.55740772465490)
+(num-test (tan 10/1234) 0.00810390511110)
+(num-test (tan -10/1234) -0.00810390511110)
+(num-test (tan 10/500029) 0.00001999884007)
+(num-test (tan -10/500029) -0.00001999884007)
+(num-test (tan 1234/500029) 0.00246786187432)
+(num-test (tan -1234/500029) -0.00246786187432)
+(num-test (tan 500029/500029) 1.55740772465490)
+(num-test (tan -500029/500029) -1.55740772465490)
+(num-test (tan 0.0) 0.0)
+(num-test (tan 0.00000001) 0.00000001)
+(num-test (tan -0.00000001) -0.00000001)
+(num-test (tan 1.0) 1.55740772465490)
+(num-test (tan -1.0) -1.55740772465490)
+(num-test (tan 0.0+0.0i) 0.0)
+(num-test (tan -0.0+0.0i) 0.0)
+(num-test (tan 0.0-0.0i) 0.0)
+(num-test (tan -0.0-0.0i) 0.0)
+(num-test (tan 0.0+0.00000001i) 0.0+0.00000001i)
+(num-test (tan -0.0+0.00000001i) 0.0+0.00000001i)
+(num-test (tan 0.0-0.00000001i) 0.0-0.00000001i)
+(num-test (tan -0.0-0.00000001i) -0.0-0.00000001i)
+(num-test (tan 0.0+1.0i) 0.0+0.76159415595576i)
+(num-test (tan -0.0+1.0i) 0.0+0.76159415595576i)
+(num-test (tan 0.0-1.0i) 0.0-0.76159415595576i)
+(num-test (tan -0.0-1.0i) -0.0-0.76159415595576i)
+(num-test (tan 0.0+3.14159265358979i) 0.0+0.99627207622075i)
+(num-test (tan -0.0+3.14159265358979i) 0.0+0.99627207622075i)
+(num-test (tan 0.0-3.14159265358979i) 0.0-0.99627207622075i)
+(num-test (tan -0.0-3.14159265358979i) -0.0-0.99627207622075i)
+(num-test (tan 0.00000001+0.0i) 0.00000001)
+(num-test (tan -0.00000001+0.0i) -0.00000001)
+(num-test (tan 0.00000001-0.0i) 0.00000001)
+(num-test (tan -0.00000001-0.0i) -0.00000001)
+(num-test (tan 0.00000001+0.00000001i) 0.00000001+0.00000001i)
+(num-test (tan -0.00000001+0.00000001i) -0.00000001+0.00000001i)
+(num-test (tan 0.00000001-0.00000001i) 0.00000001-0.00000001i)
+(num-test (tan -0.00000001-0.00000001i) -0.00000001-0.00000001i)
+(num-test (tan 0.00000001+1.0i) 0.00000000419974+0.76159415595576i)
+(num-test (tan -0.00000001+1.0i) -0.00000000419974+0.76159415595576i)
+(num-test (tan 0.00000001-1.0i) 0.00000000419974-0.76159415595576i)
+(num-test (tan -0.00000001-1.0i) -0.00000000419974-0.76159415595576i)
+(num-test (tan 0.00000001+3.14159265358979i) 0.00000000007442+0.99627207622075i)
+(num-test (tan -0.00000001+3.14159265358979i) -0.00000000007442+0.99627207622075i)
+(num-test (tan 0.00000001-3.14159265358979i) 0.00000000007442-0.99627207622075i)
+(num-test (tan -0.00000001-3.14159265358979i) -0.00000000007442-0.99627207622075i)
+(num-test (tan 1.0+0.0i) 1.55740772465490)
+(num-test (tan -1.0+0.0i) -1.55740772465490)
+(num-test (tan 1.0-0.0i) 1.55740772465490)
+(num-test (tan -1.0-0.0i) -1.55740772465490)
+(num-test (tan 1.0+0.00000001i) 1.55740772465490+0.00000003425519i)
+(num-test (tan -1.0+0.00000001i) -1.55740772465490+0.00000003425519i)
+(num-test (tan 1.0-0.00000001i) 1.55740772465490-0.00000003425519i)
+(num-test (tan -1.0-0.00000001i) -1.55740772465490-0.00000003425519i)
+(num-test (tan 1.0+1.0i) 0.27175258531951+1.08392332733869i)
+(num-test (tan -1.0+1.0i) -0.27175258531951+1.08392332733869i)
+(num-test (tan 1.0-1.0i) 0.27175258531951-1.08392332733869i)
+(num-test (tan -1.0-1.0i) -0.27175258531951-1.08392332733869i)
+(num-test (tan 1.0+3.14159265358979i) 0.00340139653674+1.00154968930275i)
+(num-test (tan -1.0+3.14159265358979i) -0.00340139653674+1.00154968930275i)
+(num-test (tan 1.0-3.14159265358979i) 0.00340139653674-1.00154968930275i)
+(num-test (tan -1.0-3.14159265358979i) -0.00340139653674-1.00154968930275i)
+(num-test (tan 1234.0+1234.0i) 2.7e-20+1.0i)
+(num-test (tan 1234.0-1234.0i) 2.7e-20-1.0i)
+(num-test (tan 10/3) .1941255059835657)
+(num-test (tan 1234/3) -0.2186940320047828)
+(num-test (tan 1234/10) 1.204471256531804)
+(num-test (tan 500029/2) .2804673425353792)
+(num-test (tan 500029/3) -1.173139817032177)
+(num-test (tan 500029/10) 3.767116303516932)
+(num-test (tan 500029/1234) -0.05562302342803592)
+(num-test (tan pi) 6.982889851335445E-15)
+(num-test (tan 0.00000001+1234.0i) +8.077935669463161E-28+1.0i)
+(num-test (tan 3.14159265358979+0.0i) 6.982889851335445E-15)
+(num-test (tan 3.14159265358979+0.00000001i) +6.982889851335444E-15+1.0E-8i)
+(num-test (tan 3.14159265358979+1.0i) +2.932634567877868E-15+0.7615941559557649i)
+(num-test (tan 3.14159265358979+3.14159265358979i) +5.196631812627532E-17+0.99627207622075i)
+(num-test (tan 3.14159265358979+1234.0i) 0.0+1.0i)
+(num-test (tan 1234.0+0.00000001i) -0.7537751984442328+1.5681770497896427E-8i)
+(num-test (tan 1234.0+3.14159265358979i) -0.003586791196867043+0.9989656315245496i)
+					;(num-test (tan 1.5707963259845+2.0630965522972e-18i) 1.234000079689074E+9+3.141593059344448i)
+(num-test (tan -3.45266983001243932001e-04+0.0e+00i) -3.4526699672092183585e-4)
+(num-test (tan 3.45266983001243932001e-04+0.0e+00i) 3.4526699672092183585e-4)
+(num-test (tan -3.45266983001243932001e-04+1.19209289550781250e-07i) -3.4526699672091692931e-4+1.1920930376163652989e-7i)
+(num-test (tan -3.45266983001243932001e-04-1.19209289550781250e-07i) -3.4526699672091692931e-4-1.1920930376163652989e-7i)
+(num-test (tan 3.45266983001243932001e-04+1.19209289550781250e-07i) 3.4526699672091692931e-4+1.1920930376163652989e-7i)
+(num-test (tan 3.45266983001243932001e-04-1.19209289550781250e-07i) 3.4526699672091692931e-4-1.1920930376163652989e-7i)
+(num-test (tan -3.45266983001243932001e-04+5.0e-01i) -2.7153443992655805934e-4+4.6211720058436229979e-1i)
+(num-test (tan -3.45266983001243932001e-04-5.0e-01i) -2.7153443992655805934e-4-4.6211720058436229979e-1i)
+(num-test (tan 3.45266983001243932001e-04+5.0e-01i) 2.7153443992655805934e-4+4.6211720058436229979e-1i)
+(num-test (tan 3.45266983001243932001e-04-5.0e-01i) 2.7153443992655805934e-4-4.6211720058436229979e-1i)
+(num-test (tan -3.45266983001243932001e-04+1.0e+00i) -1.4500326960274960880e-4+7.6159419408485704836e-1i)
+(num-test (tan -3.45266983001243932001e-04-1.0e+00i) -1.4500326960274960880e-4-7.6159419408485704836e-1i)
+(num-test (tan 3.45266983001243932001e-04+1.0e+00i) 1.4500326960274960880e-4+7.6159419408485704836e-1i)
+(num-test (tan 3.45266983001243932001e-04-1.0e+00i) 1.4500326960274960880e-4-7.6159419408485704836e-1i)
+(num-test (tan -3.45266983001243932001e-04+2.0e+00i) -2.4393395410435306874e-5+9.6402758819508310556e-1i)
+(num-test (tan -3.45266983001243932001e-04-2.0e+00i) -2.4393395410435306874e-5-9.6402758819508310556e-1i)
+(num-test (tan 3.45266983001243932001e-04+2.0e+00i) 2.4393395410435306874e-5+9.6402758819508310556e-1i)
+(num-test (tan 3.45266983001243932001e-04-2.0e+00i) 2.4393395410435306874e-5-9.6402758819508310556e-1i)
+(num-test (tan 1.57045105981189525579e+00+0.0e+00i) 2.8963092606501007060e3)
+(num-test (tan -1.57045105981189525579e+00+0.0e+00i) -2.8963092606501007060e3)
+(num-test (tan 1.57045105981189525579e+00+1.19209289550781250e-07i) 2.8963089153831588642e3+9.9999992052646305569e-1i)
+(num-test (tan 1.57045105981189525579e+00-1.19209289550781250e-07i) 2.8963089153831588642e3-9.9999992052646305569e-1i)
+(num-test (tan -1.57045105981189525579e+00+1.19209289550781250e-07i) -2.8963089153831588642e3+9.9999992052646305569e-1i)
+(num-test (tan -1.57045105981189525579e+00-1.19209289550781250e-07i) -2.8963089153831588642e3-9.9999992052646305569e-1i)
+(num-test (tan 1.57045105981189525579e+00+5.0e-01i) 1.2715121175455623363e-3+2.1639524637389325996e0i)
+(num-test (tan 1.57045105981189525579e+00-5.0e-01i) 1.2715121175455623363e-3-2.1639524637389325996e0i)
+(num-test (tan -1.57045105981189525579e+00+5.0e-01i) -1.2715121175455623363e-3+2.1639524637389325996e0i)
+(num-test (tan -1.57045105981189525579e+00-5.0e-01i) -1.2715121175455623363e-3-2.1639524637389325996e0i)
+(num-test (tan 1.57045105981189525579e+00+1.0e+00i) 2.4999454374276273814e-4+1.3130351721648674823e0i)
+(num-test (tan 1.57045105981189525579e+00-1.0e+00i) 2.4999454374276273814e-4-1.3130351721648674823e0i)
+(num-test (tan -1.57045105981189525579e+00+1.0e+00i) -2.4999454374276273814e-4+1.3130351721648674823e0i)
+(num-test (tan -1.57045105981189525579e+00-1.0e+00i) -2.4999454374276273814e-4-1.3130351721648674823e0i)
+(num-test (tan 1.57045105981189525579e+00+2.0e+00i) 2.6247825506572821595e-5+1.0373147113268752620e0i)
+(num-test (tan 1.57045105981189525579e+00-2.0e+00i) 2.6247825506572821595e-5-1.0373147113268752620e0i)
+(num-test (tan -1.57045105981189525579e+00+2.0e+00i) -2.6247825506572821595e-5+1.0373147113268752620e0i)
+(num-test (tan -1.57045105981189525579e+00-2.0e+00i) -2.6247825506572821595e-5-1.0373147113268752620e0i)
+(num-test (tan 1.57114159377789786021e+00+0.0e+00i) -2.8963092606511280143e3)
+(num-test (tan -1.57114159377789786021e+00+0.0e+00i) 2.8963092606511280143e3)
+(num-test (tan 1.57114159377789786021e+00+1.19209289550781250e-07i) -2.8963089153841861720e3+9.9999992052717244672e-1i)
+(num-test (tan 1.57114159377789786021e+00-1.19209289550781250e-07i) -2.8963089153841861720e3-9.9999992052717244672e-1i)
+(num-test (tan -1.57114159377789786021e+00+1.19209289550781250e-07i) 2.8963089153841861720e3+9.9999992052717244672e-1i)
+(num-test (tan -1.57114159377789786021e+00-1.19209289550781250e-07i) 2.8963089153841861720e3-9.9999992052717244672e-1i)
+(num-test (tan 1.57114159377789786021e+00+5.0e-01i) -1.2715121175451113370e-3+2.1639524637389326002e0i)
+(num-test (tan 1.57114159377789786021e+00-5.0e-01i) -1.2715121175451113370e-3-2.1639524637389326002e0i)
+(num-test (tan -1.57114159377789786021e+00+5.0e-01i) 1.2715121175451113370e-3+2.1639524637389326002e0i)
+(num-test (tan -1.57114159377789786021e+00-5.0e-01i) 1.2715121175451113370e-3-2.1639524637389326002e0i)
+(num-test (tan 1.57114159377789786021e+00+1.0e+00i) -2.4999454374267406620e-4+1.3130351721648674824e0i)
+(num-test (tan 1.57114159377789786021e+00-1.0e+00i) -2.4999454374267406620e-4-1.3130351721648674824e0i)
+(num-test (tan -1.57114159377789786021e+00+1.0e+00i) 2.4999454374267406620e-4+1.3130351721648674824e0i)
+(num-test (tan -1.57114159377789786021e+00-1.0e+00i) 2.4999454374267406620e-4-1.3130351721648674824e0i)
+(num-test (tan 1.57114159377789786021e+00+2.0e+00i) -2.6247825506563511609e-5+1.0373147113268752620e0i)
+(num-test (tan 1.57114159377789786021e+00-2.0e+00i) -2.6247825506563511609e-5-1.0373147113268752620e0i)
+(num-test (tan -1.57114159377789786021e+00+2.0e+00i) 2.6247825506563511609e-5+1.0373147113268752620e0i)
+(num-test (tan -1.57114159377789786021e+00-2.0e+00i) 2.6247825506563511609e-5-1.0373147113268752620e0i)
+(num-test (tan 3.14124738660679181379e+00+0.0e+00i) -3.4526699672110257641e-4)
+(num-test (tan -3.14124738660679181379e+00+0.0e+00i) 3.4526699672110257641e-4)
+(num-test (tan 3.14124738660679181379e+00+1.19209289550781250e-07i) -3.4526699672109766987e-4+1.1920930376163652991e-7i)
+(num-test (tan 3.14124738660679181379e+00-1.19209289550781250e-07i) -3.4526699672109766987e-4-1.1920930376163652991e-7i)
+(num-test (tan -3.14124738660679181379e+00+1.19209289550781250e-07i) 3.4526699672109766987e-4+1.1920930376163652991e-7i)
+(num-test (tan -3.14124738660679181379e+00-1.19209289550781250e-07i) 3.4526699672109766987e-4-1.1920930376163652991e-7i)
+(num-test (tan 3.14124738660679181379e+00+5.0e-01i) -2.7153443992670020234e-4+4.6211720058436229984e-1i)
+(num-test (tan 3.14124738660679181379e+00-5.0e-01i) -2.7153443992670020234e-4-4.6211720058436229984e-1i)
+(num-test (tan -3.14124738660679181379e+00+5.0e-01i) 2.7153443992670020234e-4+4.6211720058436229984e-1i)
+(num-test (tan -3.14124738660679181379e+00-5.0e-01i) 2.7153443992670020234e-4-4.6211720058436229984e-1i)
+(num-test (tan 3.14124738660679181379e+00+1.0e+00i) -1.4500326960282551519e-4+7.6159419408485704840e-1i)
+(num-test (tan 3.14124738660679181379e+00-1.0e+00i) -1.4500326960282551519e-4-7.6159419408485704840e-1i)
+(num-test (tan -3.14124738660679181379e+00+1.0e+00i) 1.4500326960282551519e-4+7.6159419408485704840e-1i)
+(num-test (tan -3.14124738660679181379e+00-1.0e+00i) 1.4500326960282551519e-4-7.6159419408485704840e-1i)
+(num-test (tan 3.14124738660679181379e+00+2.0e+00i) -2.4393395410448076340e-5+9.6402758819508310557e-1i)
+(num-test (tan 3.14124738660679181379e+00-2.0e+00i) -2.4393395410448076340e-5-9.6402758819508310557e-1i)
+(num-test (tan -3.14124738660679181379e+00+2.0e+00i) 2.4393395410448076340e-5+9.6402758819508310557e-1i)
+(num-test (tan -3.14124738660679181379e+00-2.0e+00i) 2.4393395410448076340e-5-9.6402758819508310557e-1i)
+(num-test (tan 3.14193792057279441821e+00+0.0e+00i) 3.4526699672085764703e-4)
+(num-test (tan -3.14193792057279441821e+00+0.0e+00i) -3.4526699672085764703e-4)
+(num-test (tan 3.14193792057279441821e+00+1.19209289550781250e-07i) 3.4526699672085274049e-4+1.1920930376163652989e-7i)
+(num-test (tan 3.14193792057279441821e+00-1.19209289550781250e-07i) 3.4526699672085274049e-4-1.1920930376163652989e-7i)
+(num-test (tan -3.14193792057279441821e+00+1.19209289550781250e-07i) -3.4526699672085274049e-4+1.1920930376163652989e-7i)
+(num-test (tan -3.14193792057279441821e+00-1.19209289550781250e-07i) -3.4526699672085274049e-4-1.1920930376163652989e-7i)
+(num-test (tan 3.14193792057279441821e+00+5.0e-01i) 2.7153443992650757820e-4+4.6211720058436229978e-1i)
+(num-test (tan 3.14193792057279441821e+00-5.0e-01i) 2.7153443992650757820e-4-4.6211720058436229978e-1i)
+(num-test (tan -3.14193792057279441821e+00+5.0e-01i) -2.7153443992650757820e-4+4.6211720058436229978e-1i)
+(num-test (tan -3.14193792057279441821e+00-5.0e-01i) -2.7153443992650757820e-4-4.6211720058436229978e-1i)
+(num-test (tan 3.14193792057279441821e+00+1.0e+00i) 1.4500326960272265115e-4+7.6159419408485704835e-1i)
+(num-test (tan 3.14193792057279441821e+00-1.0e+00i) 1.4500326960272265115e-4-7.6159419408485704835e-1i)
+(num-test (tan -3.14193792057279441821e+00+1.0e+00i) -1.4500326960272265115e-4+7.6159419408485704835e-1i)
+(num-test (tan -3.14193792057279441821e+00-1.0e+00i) -1.4500326960272265115e-4-7.6159419408485704835e-1i)
+(num-test (tan 3.14193792057279441821e+00+2.0e+00i) 2.4393395410430771882e-5+9.6402758819508310556e-1i)
+(num-test (tan 3.14193792057279441821e+00-2.0e+00i) 2.4393395410430771882e-5-9.6402758819508310556e-1i)
+(num-test (tan -3.14193792057279441821e+00+2.0e+00i) -2.4393395410430771882e-5+9.6402758819508310556e-1i)
+(num-test (tan -3.14193792057279441821e+00-2.0e+00i) -2.4393395410430771882e-5-9.6402758819508310556e-1i)
+(num-test (tan 4.71204371340168837179e+00+0.0e+00i) 2.8963092606490733978e3)
+(num-test (tan -4.71204371340168837179e+00+0.0e+00i) -2.8963092606490733978e3)
+(num-test (tan 4.71204371340168837179e+00+1.19209289550781250e-07i) 2.8963089153821315563e3+9.9999992052575366466e-1i)
+(num-test (tan 4.71204371340168837179e+00-1.19209289550781250e-07i) 2.8963089153821315563e3-9.9999992052575366466e-1i)
+(num-test (tan -4.71204371340168837179e+00+1.19209289550781250e-07i) -2.8963089153821315563e3+9.9999992052575366466e-1i)
+(num-test (tan -4.71204371340168837179e+00-1.19209289550781250e-07i) -2.8963089153821315563e3-9.9999992052575366466e-1i)
+(num-test (tan 4.71204371340168837179e+00+5.0e-01i) 1.2715121175460133355e-3+2.1639524637389325989e0i)
+(num-test (tan 4.71204371340168837179e+00-5.0e-01i) 1.2715121175460133355e-3-2.1639524637389325989e0i)
+(num-test (tan -4.71204371340168837179e+00+5.0e-01i) -1.2715121175460133355e-3+2.1639524637389325989e0i)
+(num-test (tan -4.71204371340168837179e+00-5.0e-01i) -1.2715121175460133355e-3-2.1639524637389325989e0i)
+(num-test (tan 4.71204371340168837179e+00+1.0e+00i) 2.4999454374285141007e-4+1.3130351721648674822e0i)
+(num-test (tan 4.71204371340168837179e+00-1.0e+00i) 2.4999454374285141007e-4-1.3130351721648674822e0i)
+(num-test (tan -4.71204371340168837179e+00+1.0e+00i) -2.4999454374285141007e-4+1.3130351721648674822e0i)
+(num-test (tan -4.71204371340168837179e+00-1.0e+00i) -2.4999454374285141007e-4-1.3130351721648674822e0i)
+(num-test (tan 4.71204371340168837179e+00+2.0e+00i) 2.6247825506582131582e-5+1.0373147113268752620e0i)
+(num-test (tan 4.71204371340168837179e+00-2.0e+00i) 2.6247825506582131582e-5-1.0373147113268752620e0i)
+(num-test (tan -4.71204371340168837179e+00+2.0e+00i) -2.6247825506582131582e-5+1.0373147113268752620e0i)
+(num-test (tan -4.71204371340168837179e+00-2.0e+00i) -2.6247825506582131582e-5-1.0373147113268752620e0i)
+(num-test (tan 4.71273424736769097620e+00+0.0e+00i) -2.8963092606521553225e3)
+(num-test (tan -4.71273424736769097620e+00+0.0e+00i) 2.8963092606521553225e3)
+(num-test (tan 4.71273424736769097620e+00+1.19209289550781250e-07i) -2.8963089153852134799e3+9.9999992052788183776e-1i)
+(num-test (tan 4.71273424736769097620e+00-1.19209289550781250e-07i) -2.8963089153852134799e3-9.9999992052788183776e-1i)
+(num-test (tan -4.71273424736769097620e+00+1.19209289550781250e-07i) 2.8963089153852134799e3+9.9999992052788183776e-1i)
+(num-test (tan -4.71273424736769097620e+00-1.19209289550781250e-07i) 2.8963089153852134799e3-9.9999992052788183776e-1i)
+(num-test (tan 4.71273424736769097620e+00+5.0e-01i) -1.2715121175446603377e-3+2.1639524637389326009e0i)
+(num-test (tan 4.71273424736769097620e+00-5.0e-01i) -1.2715121175446603377e-3-2.1639524637389326009e0i)
+(num-test (tan -4.71273424736769097620e+00+5.0e-01i) 1.2715121175446603377e-3+2.1639524637389326009e0i)
+(num-test (tan -4.71273424736769097620e+00-5.0e-01i) 1.2715121175446603377e-3-2.1639524637389326009e0i)
+(num-test (tan 4.71273424736769097620e+00+1.0e+00i) -2.4999454374258539427e-4+1.3130351721648674825e0i)
+(num-test (tan 4.71273424736769097620e+00-1.0e+00i) -2.4999454374258539427e-4-1.3130351721648674825e0i)
+(num-test (tan -4.71273424736769097620e+00+1.0e+00i) 2.4999454374258539427e-4+1.3130351721648674825e0i)
+(num-test (tan -4.71273424736769097620e+00-1.0e+00i) 2.4999454374258539427e-4-1.3130351721648674825e0i)
+(num-test (tan 4.71273424736769097620e+00+2.0e+00i) -2.6247825506554201622e-5+1.0373147113268752620e0i)
+(num-test (tan 4.71273424736769097620e+00-2.0e+00i) -2.6247825506554201622e-5-1.0373147113268752620e0i)
+(num-test (tan -4.71273424736769097620e+00+2.0e+00i) 2.6247825506554201622e-5+1.0373147113268752620e0i)
+(num-test (tan -4.71273424736769097620e+00-2.0e+00i) 2.6247825506554201622e-5-1.0373147113268752620e0i)
+(num-test (tan 6.28284004019658492979e+00+0.0e+00i) -3.4526699672122504111e-4)
+(num-test (tan -6.28284004019658492979e+00+0.0e+00i) 3.4526699672122504111e-4)
+(num-test (tan 6.28284004019658492979e+00+1.19209289550781250e-07i) -3.4526699672122013457e-4+1.1920930376163652992e-7i)
+(num-test (tan 6.28284004019658492979e+00-1.19209289550781250e-07i) -3.4526699672122013457e-4-1.1920930376163652992e-7i)
+(num-test (tan -6.28284004019658492979e+00+1.19209289550781250e-07i) 3.4526699672122013457e-4+1.1920930376163652992e-7i)
+(num-test (tan -6.28284004019658492979e+00-1.19209289550781250e-07i) 3.4526699672122013457e-4-1.1920930376163652992e-7i)
+(num-test (tan 6.28284004019658492979e+00+5.0e-01i) -2.7153443992679651442e-4+4.6211720058436229987e-1i)
+(num-test (tan 6.28284004019658492979e+00-5.0e-01i) -2.7153443992679651442e-4-4.6211720058436229987e-1i)
+(num-test (tan -6.28284004019658492979e+00+5.0e-01i) 2.7153443992679651442e-4+4.6211720058436229987e-1i)
+(num-test (tan -6.28284004019658492979e+00-5.0e-01i) 2.7153443992679651442e-4-4.6211720058436229987e-1i)
+(num-test (tan 6.28284004019658492979e+00+1.0e+00i) -1.4500326960287694721e-4+7.6159419408485704843e-1i)
+(num-test (tan 6.28284004019658492979e+00-1.0e+00i) -1.4500326960287694721e-4-7.6159419408485704843e-1i)
+(num-test (tan -6.28284004019658492979e+00+1.0e+00i) 1.4500326960287694721e-4+7.6159419408485704843e-1i)
+(num-test (tan -6.28284004019658492979e+00-1.0e+00i) 1.4500326960287694721e-4-7.6159419408485704843e-1i)
+(num-test (tan 6.28284004019658492979e+00+2.0e+00i) -2.4393395410456728569e-5+9.6402758819508310558e-1i)
+(num-test (tan 6.28284004019658492979e+00-2.0e+00i) -2.4393395410456728569e-5-9.6402758819508310558e-1i)
+(num-test (tan -6.28284004019658492979e+00+2.0e+00i) 2.4393395410456728569e-5+9.6402758819508310558e-1i)
+(num-test (tan -6.28284004019658492979e+00-2.0e+00i) 2.4393395410456728569e-5-9.6402758819508310558e-1i)
+(num-test (tan 6.28353057416258753420e+00+0.0e+00i) 3.4526699672073518233e-4)
+(num-test (tan -6.28353057416258753420e+00+0.0e+00i) -3.4526699672073518233e-4)
+(num-test (tan 6.28353057416258753420e+00+1.19209289550781250e-07i) 3.4526699672073027579e-4+1.1920930376163652988e-7i)
+(num-test (tan 6.28353057416258753420e+00-1.19209289550781250e-07i) 3.4526699672073027579e-4-1.1920930376163652988e-7i)
+(num-test (tan -6.28353057416258753420e+00+1.19209289550781250e-07i) -3.4526699672073027579e-4+1.1920930376163652988e-7i)
+(num-test (tan -6.28353057416258753420e+00-1.19209289550781250e-07i) -3.4526699672073027579e-4-1.1920930376163652988e-7i)
+(num-test (tan 6.28353057416258753420e+00+5.0e-01i) 2.7153443992641126612e-4+4.6211720058436229974e-1i)
+(num-test (tan 6.28353057416258753420e+00-5.0e-01i) 2.7153443992641126612e-4-4.6211720058436229974e-1i)
+(num-test (tan -6.28353057416258753420e+00+5.0e-01i) -2.7153443992641126612e-4+4.6211720058436229974e-1i)
+(num-test (tan -6.28353057416258753420e+00-5.0e-01i) -2.7153443992641126612e-4-4.6211720058436229974e-1i)
+(num-test (tan 6.28353057416258753420e+00+1.0e+00i) 1.4500326960267121913e-4+7.6159419408485704832e-1i)
+(num-test (tan 6.28353057416258753420e+00-1.0e+00i) 1.4500326960267121913e-4-7.6159419408485704832e-1i)
+(num-test (tan -6.28353057416258753420e+00+1.0e+00i) -1.4500326960267121913e-4+7.6159419408485704832e-1i)
+(num-test (tan -6.28353057416258753420e+00-1.0e+00i) -1.4500326960267121913e-4-7.6159419408485704832e-1i)
+(num-test (tan 6.28353057416258753420e+00+2.0e+00i) 2.4393395410422119654e-5+9.6402758819508310555e-1i)
+(num-test (tan 6.28353057416258753420e+00-2.0e+00i) 2.4393395410422119654e-5-9.6402758819508310555e-1i)
+(num-test (tan -6.28353057416258753420e+00+2.0e+00i) -2.4393395410422119654e-5+9.6402758819508310555e-1i)
+(num-test (tan -6.28353057416258753420e+00-2.0e+00i) -2.4393395410422119654e-5-9.6402758819508310555e-1i)
+(num-test (tan 9.42443269378637893396e+00+0.0e+00i) -3.4526699672045932728e-4)
+(num-test (tan -9.42443269378637893396e+00+0.0e+00i) 3.4526699672045932728e-4)
+(num-test (tan 9.42443269378637893396e+00+1.19209289550781250e-07i) -3.4526699672045442074e-4+1.1920930376163652985e-7i)
+(num-test (tan 9.42443269378637893396e+00-1.19209289550781250e-07i) -3.4526699672045442074e-4-1.1920930376163652985e-7i)
+(num-test (tan -9.42443269378637893396e+00+1.19209289550781250e-07i) 3.4526699672045442074e-4+1.1920930376163652985e-7i)
+(num-test (tan -9.42443269378637893396e+00-1.19209289550781250e-07i) 3.4526699672045442074e-4-1.1920930376163652985e-7i)
+(num-test (tan 9.42443269378637893396e+00+5.0e-01i) -2.7153443992619432056e-4+4.6211720058436229968e-1i)
+(num-test (tan 9.42443269378637893396e+00-5.0e-01i) -2.7153443992619432056e-4-4.6211720058436229968e-1i)
+(num-test (tan -9.42443269378637893396e+00+5.0e-01i) 2.7153443992619432056e-4+4.6211720058436229968e-1i)
+(num-test (tan -9.42443269378637893396e+00-5.0e-01i) 2.7153443992619432056e-4-4.6211720058436229968e-1i)
+(num-test (tan 9.42443269378637893396e+00+1.0e+00i) -1.4500326960255536711e-4+7.6159419408485704826e-1i)
+(num-test (tan 9.42443269378637893396e+00-1.0e+00i) -1.4500326960255536711e-4-7.6159419408485704826e-1i)
+(num-test (tan -9.42443269378637893396e+00+1.0e+00i) 1.4500326960255536711e-4+7.6159419408485704826e-1i)
+(num-test (tan -9.42443269378637893396e+00-1.0e+00i) 1.4500326960255536711e-4-7.6159419408485704826e-1i)
+(num-test (tan 9.42443269378637893396e+00+2.0e+00i) -2.4393395410402630273e-5+9.6402758819508310554e-1i)
+(num-test (tan 9.42443269378637893396e+00-2.0e+00i) -2.4393395410402630273e-5-9.6402758819508310554e-1i)
+(num-test (tan -9.42443269378637893396e+00+2.0e+00i) 2.4393395410402630273e-5+9.6402758819508310554e-1i)
+(num-test (tan -9.42443269378637893396e+00-2.0e+00i) 2.4393395410402630273e-5-9.6402758819508310554e-1i)
+(num-test (tan 9.42512322775237976202e+00+0.0e+00i) 3.4526699671972453911e-4)
+(num-test (tan -9.42512322775237976202e+00+0.0e+00i) -3.4526699671972453911e-4)
+(num-test (tan 9.42512322775237976202e+00+1.19209289550781250e-07i) 3.4526699671971963257e-4+1.1920930376163652979e-7i)
+(num-test (tan 9.42512322775237976202e+00-1.19209289550781250e-07i) 3.4526699671971963257e-4-1.1920930376163652979e-7i)
+(num-test (tan -9.42512322775237976202e+00+1.19209289550781250e-07i) -3.4526699671971963257e-4+1.1920930376163652979e-7i)
+(num-test (tan -9.42512322775237976202e+00-1.19209289550781250e-07i) -3.4526699671971963257e-4-1.1920930376163652979e-7i)
+(num-test (tan 9.42512322775237976202e+00+5.0e-01i) 2.7153443992561644811e-4+4.6211720058436229949e-1i)
+(num-test (tan 9.42512322775237976202e+00-5.0e-01i) 2.7153443992561644811e-4-4.6211720058436229949e-1i)
+(num-test (tan -9.42512322775237976202e+00+5.0e-01i) -2.7153443992561644811e-4+4.6211720058436229949e-1i)
+(num-test (tan -9.42512322775237976202e+00-5.0e-01i) -2.7153443992561644811e-4-4.6211720058436229949e-1i)
+(num-test (tan 9.42512322775237976202e+00+1.0e+00i) 1.450032696022467750e-4+7.6159419408485704810e-1i)
+(num-test (tan 9.42512322775237976202e+00-1.0e+00i) 1.450032696022467750e-4-7.6159419408485704810e-1i)
+(num-test (tan -9.42512322775237976202e+00+1.0e+00i) -1.450032696022467750e-4+7.6159419408485704810e-1i)
+(num-test (tan -9.42512322775237976202e+00-1.0e+00i) -1.450032696022467750e-4-7.6159419408485704810e-1i)
+(num-test (tan 9.42512322775237976202e+00+2.0e+00i) 2.439339541035071690e-5+9.6402758819508310550e-1i)
+(num-test (tan 9.42512322775237976202e+00-2.0e+00i) 2.439339541035071690e-5-9.6402758819508310550e-1i)
+(num-test (tan -9.42512322775237976202e+00+2.0e+00i) -2.439339541035071690e-5+9.6402758819508310550e-1i)
+(num-test (tan -9.42512322775237976202e+00-2.0e+00i) -2.439339541035071690e-5-9.6402758819508310550e-1i)
+(num-test (tan 32767.) 1.9089234430221485740826E-1)
+(num-test (tan 8388607.) -8.0354556223613614748329E0)
+(num-test (tan 2147483647.) 1.0523779637351339136698E0)
+(num-test (tan -2.225073858507201399999999999999999999996E-308) -2.225073858507201399999999999999999999996E-308)
+(num-test (tan 1.110223024625156799999999999999999999997E-16) 1.110223024625156800000000000000004561517E-16)
+(num-test (tan (* 1/4 (atan 4))) (* 2 (+ (cos (/ (* 6 pi) 17)) (cos (/ (* 10 pi) 17)))))
+(num-test (tan (/ pi 10)) (/ (sqrt (- 25 (* 10 (sqrt 5)))) 5))
+(num-test (tan (/ pi 12)) (- 2 (sqrt 3)))
+(num-test (tan (/ pi 12)) (- 2 (sqrt 3)))
+(num-test (tan (/ pi 16)) (- (sqrt (+ 4 (* 2 (sqrt 2)))) (sqrt 2) 1))
+(num-test (tan (/ pi 20)) (+ 1 (sqrt 5) (- (sqrt (+ 5 (* 2 (sqrt 5)))))))
+(num-test (tan (/ pi 24)) (+ -2 (sqrt 2) (- (sqrt 3)) (sqrt 6)))
+(num-test (tan (/ pi 3)) (sqrt 3))
+(num-test (tan (/ pi 3)) (sqrt 3))
+(num-test (tan (/ pi 30)) (sqrt (- 7 (* 2 (sqrt 5)) (* 2 (sqrt (- 15 (* 6 (sqrt 5))))))))
+(num-test (tan (/ pi 4)) 1)
+(num-test (tan (/ pi 4)) 1.0)
+(num-test (tan (/ pi 4)) 1.0)
+(num-test (tan (/ pi 5)) (sqrt (- 5 (* 2 (sqrt 5)))))
+(num-test (tan (/ pi 6)) (/ (sqrt 3) 3))
+(num-test (tan (/ pi 6)) (/ (sqrt 3)))
+(num-test (tan (/ pi 8)) (- (sqrt 2) 1))
+(num-test (* (tan (/ pi 11)) (tan (/ (* 2 pi) 11)) (tan (/ (* 3 pi) 11)) (tan (/ (* 4 pi) 11)) (tan (/ (* 5 pi) 11))) (sqrt 11))
+(num-test (* (tan (/ pi 9)) (tan (/ (* 2 pi) 9)) (tan (/ (* 4 pi) 9))) (sqrt 3))
+(num-test (tan 0-1000i) 0-i)
+(num-test (tan 0+1000i) 0+i)
+(num-test (tan (complex 0 +inf.0)) 0+i)
+
+(when with-bignums
+  (num-test (tan 9223372036854775806) (tan (bignum 9223372036854775806)))
+  (letrec ((sum-cot (lambda (n)
+		      (let ((sum 0.0))
+			(do ((k 1 (+ k 1)))
+			    ((= k n) sum)
+			  (set! sum (+ sum (sin (/ (* k pi) n)))))))))
+    (let ((mxerr 0.0)
+	  (mxcase 0))
+      (do ((i 2 (+ i 1)))
+	  ((= i 100))
+	(let ((val1 (sum-cot i))
+	      (val2 (/ 1.0 (tan (/ pi (* 2 i))))))
+	  (let ((err (magnitude (- val1 val2))))
+	    (if (> err mxerr)
+		(begin
+		  (set! mxerr err)
+		  (set! mxcase i))))))
+      (if (> mxerr 1e-35)
+	  (format #t "sum-cot max error ~A at ~A~%" mxerr mxcase)))))
+
+(for-each
+ (lambda (num-and-val)
+   (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'tan num (tan num) val)))
+ (vector (list 0 0) (list 1 1.5574077246549) (list 2 -2.1850398632615) (list 3 -0.14254654307428)
+	 (list -1 -1.5574077246549) (list -2 2.1850398632615) (list -3 0.14254654307428)
+	 (list 1/2 0.54630248984379)
+	 (list 1/3 0.34625354951058) (list -1/2 -0.54630248984379) (list -1/3 -0.34625354951058)
+	 (list 1/9223372036854775807 1.0842021724855e-19) (list 0.0 0.0) (list 1.0 1.5574077246549)
+	 (list 2.0 -2.1850398632615) (list -2.0 2.1850398632615) (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309)
+	 (list 0+1i 0+0.76159415595576i)
+	 (list 0+2i 0+0.96402758007582i) (list 0-1i 0-0.76159415595576i) (list 1+1i 0.27175258531951+1.0839233273387i)
+	 (list 1-1i 0.27175258531951-1.0839233273387i) (list -1+1i -0.27175258531951+1.0839233273387i)
+	 (list -1-1i -0.27175258531951-1.0839233273387i) (list 0.1+0.1i 0.099328043521656+0.10066129051146i)
+	 (list 1e+16+1e+16i 0+1i) (list 1e-16+1e-16i 1e-16+1e-16i) ))
+
+(when with-bignums
+  (let-temporarily (((*s7* 'bignum-precision) 500))
+    (let ((tans (list ; table[Tan[k/10], {k, 0, 30}]
+		 0.00000000000000000000000000000000000000000000000000000000000000000000e0
+		 0.10033467208545054505808004578111153681900480457644204002220806579803
+		 0.20271003550867248332135827164753448262687566965163133004781996689038
+		 0.30933624960962323303530367969829466725781590680046134075142272636569
+		 0.42279321873816176198163542716529033394198977271569358984733094139266
+		 0.54630248984379051325517946578028538329755172017979124616409138593290
+		 0.68413680834169231707092541746333574524265408075678204603738401651742
+		 0.84228838046307944812813500221293771718722125080419899879692251366850
+		 1.02963855705036401274636117282036528416821960677230780766895721581894
+		 1.26015821755033913713457548539574847783362583439629440734976898386523
+		 1.55740772465490223050697480745836017308725077238152003838394660569886
+		 1.96475965724865195093092278177937824371908489378986426895526379547792
+		 2.57215162212631893540999423603336395652940930604338927922563726223880
+		 3.60210244796797815123114551507651373970302582865487479569579648938869
+		 5.79788371548288964370772024360369904599369751893967972517934732424182
+		 14.10141994717171938764608365198775644565954357723586186612326758608969
+		 -34.23253273555741705801487543047619090177569941115323597430813746321248
+		 -7.69660213945915841412819296829866091636528991430764756294574142318097
+		 -4.28626167462806352545188895228026668020736003385824824436108662437549
+		 -2.92709751467777270368689918927087330066328793602580283437505670792996
+		 -2.18503986326151899164330610231368254343201774622766316456295586996677
+		 -1.70984654290450774834778079380390375776090098123394621314534682027235
+		 -1.37382305676879516014003676333346987430263329223370049420804295416122
+		 -1.11921364173413217123235669407622790313829418580200248125375565107236
+		 -0.91601428967341051273086324750810579399364554997699617941685909082222
+		 -0.74702229723866027935535268782527455790411695688301127906659308970027
+		 -0.60159661308975872273608189269127978293417758666969145078057164875561
+		 -0.47272762910303750795198918126389516105797171531608327694222778882857
+		 -0.35552983165117587757735260363543503816953711960914396739605909199266
+		 -0.24640539397196625534356707388530576476208894415934539659747894722272
+		 -0.14254654307427780529563541053391349322609228490180464763323897668885)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 30))
+	(let ((val (tan (bignum (/ i 10)))))
+	  (if (> (magnitude (- val (list-ref tans i))) 1e-35)
+	      (format #t ";(tan ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref tans i) (magnitude (- val (list-ref tans i))))))))))
+
+(test (tan) 'error)
+(test (tan "hi") 'error)
+(test (tan 1.0+23.0i 1.0+23.0i) 'error)
+(test (tan 0 1) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (tan arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; asin
+;;; --------------------------------------------------------------------------------
+
+(num-test (asin 0) 0.0)
+(num-test (asin 1) 1.57079632679490)
+(num-test (asin -1) -1.57079632679490)
+(num-test (asin 2) 1.57079632679490+1.31695789692482i)
+(num-test (asin -2) -1.57079632679490+1.31695789692482i)
+(num-test (asin 3) 1.57079632679490+1.76274717403909i)
+(num-test (asin -3) -1.57079632679490+1.76274717403909i)
+(num-test (asin 10) 1.57079632679490+2.99322284612638i)
+(num-test (asin -10) -1.57079632679490+2.99322284612638i)
+(num-test (asin 1234) 1.57079632679490+7.81116322068415i)
+(num-test (asin -1234) -1.57079632679490+7.81116322068415i)
+(num-test (asin 0/1) 0.0)
+(num-test (asin 0/2) 0.0)
+(num-test (asin 0/3) 0.0)
+(num-test (asin 0/10) 0.0)
+(num-test (asin 0/1234) 0.0)
+(num-test (asin 0/500029) 0.0)
+(num-test (asin 1/1) 1.57079632679490)
+(num-test (asin -1/1) -1.57079632679490)
+(num-test (asin 1/2) 0.52359877559830)
+(num-test (asin -1/2) -0.52359877559830)
+(num-test (asin 1/3) 0.33983690945412)
+(num-test (asin -1/3) -0.33983690945412)
+(num-test (asin 1/10) 0.10016742116156)
+(num-test (asin -1/10) -0.10016742116156)
+(num-test (asin 1/1234) 0.00081037286017)
+(num-test (asin -1/1234) -0.00081037286017)
+(num-test (asin 1/500029) 0.00000199988401)
+(num-test (asin -1/500029) -0.00000199988401)
+(num-test (asin 2/1) 1.57079632679490+1.31695789692482i)
+(num-test (asin -2/1) -1.57079632679490+1.31695789692482i)
+(num-test (asin 2/2) 1.57079632679490)
+(num-test (asin -2/2) -1.57079632679490)
+(num-test (asin 2/3) 0.72972765622697)
+(num-test (asin -2/3) -0.72972765622697)
+(num-test (asin 2/10) 0.20135792079033)
+(num-test (asin -2/10) -0.20135792079033)
+(num-test (asin 2/1234) 0.00162074625252)
+(num-test (asin -2/1234) -0.00162074625252)
+(num-test (asin 2/500029) 0.00000399976801)
+(num-test (asin -2/500029) -0.00000399976801)
+(num-test (asin 3/1) 1.57079632679490+1.76274717403909i)
+(num-test (asin -3/1) -1.57079632679490+1.76274717403909i)
+(num-test (asin 3/2) 1.57079632679490+0.96242365011921i)
+(num-test (asin -3/2) -1.57079632679490+0.96242365011921i)
+(num-test (asin 3/3) 1.57079632679490)
+(num-test (asin -3/3) -1.57079632679490)
+(num-test (asin 3/10) 0.30469265401540)
+(num-test (asin -3/10) -0.30469265401540)
+(num-test (asin 3/1234) 0.00243112070922)
+(num-test (asin -3/1234) -0.00243112070922)
+(num-test (asin 3/500029) 0.00000599965202)
+(num-test (asin -3/500029) -0.00000599965202)
+(num-test (asin 10/1) 1.57079632679490+2.99322284612638i)
+(num-test (asin -10/1) -1.57079632679490+2.99322284612638i)
+(num-test (asin 10/2) 1.57079632679490+2.29243166956117i)
+(num-test (asin -10/2) -1.57079632679490+2.29243166956117i)
+(num-test (asin 10/3) 1.57079632679490+1.87382024252741i)
+(num-test (asin -10/3) -1.57079632679490+1.87382024252741i)
+(num-test (asin 10/10) 1.57079632679490)
+(num-test (asin -10/10) -1.57079632679490)
+(num-test (asin 10/1234) 0.00810381641321)
+(num-test (asin -10/1234) -0.00810381641321)
+(num-test (asin 10/500029) 0.00001999884007)
+(num-test (asin -10/500029) -0.00001999884007)
+(num-test (asin 1234/1) 1.57079632679490+7.81116322068415i)
+(num-test (asin -1234/1) -1.57079632679490+7.81116322068415i)
+(num-test (asin 1234/2) 1.57079632679490+7.11801554770806i)
+(num-test (asin -1234/2) -1.57079632679490+7.11801554770806i)
+(num-test (asin 1234/3) 1.57079632679490+6.71254961876657i)
+(num-test (asin -1234/3) -1.57079632679490+6.71254961876657i)
+(num-test (asin 1234/10) 1.57079632679490+5.50856187402751i)
+(num-test (asin -1234/10) -1.57079632679490+5.50856187402751i)
+(num-test (asin 1234/500029) 0.00246785936931)
+(num-test (asin -1234/500029) -0.00246785936931)
+(num-test (asin 500029/3) 1.570796326794897-12.71695626760523i)
+(num-test (asin -500029/3) -1.570796326794897+12.71695626760523i)
+(num-test (asin 500029/10) 1.570796326794897-1.151298346318831e1i)
+(num-test (asin -500029/10) -1.57079632679490+1.151298346318831e1i)
+(num-test (asin 500029/1234) 1.57079632679490+6.69755082925184i)
+(num-test (asin -500029/1234) -1.57079632679490+6.69755082925184i)
+(num-test (asin 500029/500029) 1.57079632679490)
+(num-test (asin -500029/500029) -1.57079632679490)
+(num-test (asin 0.0) 0.0)
+(num-test (asin 0.00000001) 0.00000001)
+(num-test (asin -0.00000001) -0.00000001)
+(num-test (asin 1.0) 1.57079632679490)
+(num-test (asin -1.0) -1.57079632679490)
+(num-test (asin pi) 1.57079632679490+1.81152627246085i)
+(num-test (asin -3.14159265358979) -1.57079632679490+1.81152627246085i)
+(num-test (asin 1234.0) 1.57079632679490+7.81116322068415i)
+(num-test (asin -1234.0) -1.57079632679490+7.81116322068415i)
+(num-test (asin 0.0+0.0i) 0.0)
+(num-test (asin -0.0+0.0i) 0.0)
+(num-test (asin 0.0-0.0i) 0.0)
+(num-test (asin -0.0-0.0i) 0.0)
+(num-test (asin 0.0+0.00000001i) 0.0+0.00000001i)
+(num-test (asin -0.0+0.00000001i) 0.0+0.00000001i)
+(num-test (asin 0.0-0.00000001i) 0.0-0.00000001i)
+(num-test (asin -0.0-0.00000001i) -0.0-0.00000001i)
+(num-test (asin 0.0+1.0i) 0.0+0.88137358701954i)
+(num-test (asin -0.0+1.0i) 0.0+0.88137358701954i)
+(num-test (asin 0.0-1.0i) 0.0-0.88137358701954i)
+(num-test (asin -0.0-1.0i) -0.0-0.88137358701954i)
+(num-test (asin 0.0+3.14159265358979i) 0.0+1.86229574331085i)
+(num-test (asin -0.0+3.14159265358979i) 0.0+1.86229574331085i)
+(num-test (asin 0.0-3.14159265358979i) 0.0-1.86229574331085i)
+(num-test (asin -0.0-3.14159265358979i) -0.0-1.86229574331085i)
+(num-test (asin 0.0+1234.0i) 0.0+7.81116354896171i)
+(num-test (asin -0.0+1234.0i) 0.0+7.81116354896171i)
+(num-test (asin 0.0-1234.0i) 0.0-7.81116354920125i)
+(num-test (asin -0.0-1234.0i) -0.0-7.81116354920125i)
+(num-test (asin 0.00000001+0.0i) 0.00000001)
+(num-test (asin -0.00000001+0.0i) -0.00000001)
+(num-test (asin 0.00000001-0.0i) 0.00000001)
+(num-test (asin -0.00000001-0.0i) -0.00000001)
+(num-test (asin 0.00000001+0.00000001i) 0.00000001+0.00000001i)
+(num-test (asin -0.00000001+0.00000001i) -0.00000001+0.00000001i)
+(num-test (asin 0.00000001-0.00000001i) 0.00000001-0.00000001i)
+(num-test (asin -0.00000001-0.00000001i) -0.00000001-0.00000001i)
+(num-test (asin 0.00000001+1.0i) 0.00000000707107+0.88137358701954i)
+(num-test (asin -0.00000001+1.0i) -0.00000000707107+0.88137358701954i)
+(num-test (asin 0.00000001-1.0i) 0.00000000707107-0.88137358701954i)
+(num-test (asin -0.00000001-1.0i) -0.00000000707107-0.88137358701954i)
+(num-test (asin 0.00000001+3.14159265358979i) 0.00000000303314+1.86229574331085i)
+(num-test (asin -0.00000001+3.14159265358979i) -0.00000000303314+1.86229574331085i)
+(num-test (asin 0.00000001-3.14159265358979i) 0.00000000303314-1.86229574331085i)
+(num-test (asin -0.00000001-3.14159265358979i) -0.00000000303314-1.86229574331085i)
+(num-test (asin 0.00000001+1234.0i) 0.00000000000810+7.81116354896171i)
+(num-test (asin -0.00000001+1234.0i) -0.00000000000810+7.81116354896171i)
+(num-test (asin 0.00000001-1234.0i) 0.00000000000810-7.81116354920125i)
+(num-test (asin -0.00000001-1234.0i) -0.00000000000810-7.81116354920125i)
+(num-test (asin 1.0+0.0i) 1.57079632679490)
+(num-test (asin -1.0+0.0i) -1.57079632679490)
+(num-test (asin 1.0-0.0i) 1.57079632679490)
+(num-test (asin -1.0-0.0i) -1.57079632679490)
+(num-test (asin 1.0+0.00000001i) 1.57069632679498+0.00010000000008i)
+(num-test (asin -1.0+0.00000001i) -1.57069632679498+0.00010000000008i)
+(num-test (asin 1.0-0.00000001i) 1.57069632679498-0.00010000000008i)
+(num-test (asin -1.0-0.00000001i) -1.57069632679498-0.00010000000008i)
+(num-test (asin 1.0+1.0i) 0.66623943249252+1.06127506190504i)
+(num-test (asin -1.0+1.0i) -0.66623943249252+1.06127506190504i)
+(num-test (asin 1.0-1.0i) 0.66623943249252-1.06127506190504i)
+(num-test (asin -1.0-1.0i) -0.66623943249252-1.06127506190504i)
+(num-test (asin 1.0+3.14159265358979i) 0.29558503421163+1.90462768697066i)
+(num-test (asin -1.0+3.14159265358979i) -0.29558503421163+1.90462768697066i)
+(num-test (asin 1.0-3.14159265358979i) 0.29558503421163-1.90462768697066i)
+(num-test (asin -1.0-3.14159265358979i) -0.29558503421163-1.90462768697066i)
+(num-test (asin 1.0+1234.0i) 0.00081037232806+7.81116387772663i)
+(num-test (asin -1.0+1234.0i) -0.00081037232806+7.81116387772663i)
+(num-test (asin 1.0-1234.0i) 0.00081037232800-7.81116387755283i)
+(num-test (asin -1.0-1234.0i) -0.00081037232800-7.81116387755283i)
+(num-test (asin 3.14159265358979+0.0i) 1.57079632679490+1.81152627246085i)
+(num-test (asin -3.14159265358979+0.0i) -1.57079632679490+1.81152627246085i)
+(num-test (asin 3.14159265358979-0.0i) 1.57079632679490+1.81152627246085i)
+(num-test (asin -3.14159265358979-0.0i) -1.57079632679490+1.81152627246085i)
+(num-test (asin 3.14159265358979+0.00000001i) 1.57079632343715+1.81152627246085i)
+(num-test (asin -3.14159265358979+0.00000001i) -1.57079632343715+1.81152627246085i)
+(num-test (asin 3.14159265358979-0.00000001i) 1.57079632343715-1.81152627246085i)
+(num-test (asin -3.14159265358979-0.00000001i) -1.57079632343715-1.81152627246085i)
+(num-test (asin 3.14159265358979+1.0i) 1.24854303281344+1.86711439316026i)
+(num-test (asin -3.14159265358979+1.0i) -1.24854303281344+1.86711439316026i)
+(num-test (asin 3.14159265358979-1.0i) 1.24854303281344-1.86711439316026i)
+(num-test (asin -3.14159265358979-1.0i) -1.24854303281344-1.86711439316026i)
+(num-test (asin 3.14159265358979+3.14159265358979i) 0.77273977912748+2.18469104082751i)
+(num-test (asin -3.14159265358979+3.14159265358979i) -0.77273977912748+2.18469104082751i)
+(num-test (asin 3.14159265358979-3.14159265358979i) 0.77273977912748-2.18469104082751i)
+(num-test (asin -3.14159265358979-3.14159265358979i) -0.77273977912748-2.18469104082751i)
+(num-test (asin 3.14159265358979+1234.0i) 0.00254585480900+7.81116678966949i)
+(num-test (asin -3.14159265358979+1234.0i) -0.00254585480900+7.81116678966949i)
+(num-test (asin 3.14159265358979-1234.0i) 0.00254585480937-7.81116678989204i)
+(num-test (asin -3.14159265358979-1234.0i) -0.00254585480937-7.81116678989204i)
+(num-test (asin 1234.0+0.0i) 1.57079632679490+7.81116322068415i)
+(num-test (asin -1234.0+0.0i) -1.57079632679490+7.81116322068415i)
+(num-test (asin 1234.0-0.0i) 1.57079632679490+7.81116322068415i)
+(num-test (asin -1234.0-0.0i) -1.57079632679490+7.81116322068415i)
+(num-test (asin 1234.0+0.00000001i) 1.57079632678679+7.81116322068415i)
+(num-test (asin -1234.0+0.00000001i) -1.57079632678679+7.81116322068415i)
+(num-test (asin 1234.0-0.00000001i) 1.57079632678679-7.81116322084923i)
+(num-test (asin -1234.0-0.00000001i) -1.57079632678679-7.81116322084923i)
+(num-test (asin 1234.0+1.0i) 1.56998595393442+7.81116354944842i)
+(num-test (asin -1234.0+1.0i) -1.56998595393442+7.81116354944842i)
+(num-test (asin 1234.0-1.0i) 1.56998595393473-7.81116354920146i)
+(num-test (asin -1234.0-1.0i) -1.56998595393473-7.81116354920146i)
+(num-test (asin 1234.0+3.14159265358979i) 1.56825047031506+7.81116646138554i)
+(num-test (asin -1234.0+3.14159265358979i) -1.56825047031506+7.81116646138554i)
+(num-test (asin 1234.0-3.14159265358979i) 1.56825047031367-7.81116646154641i)
+(num-test (asin -1234.0-3.14159265358979i) -1.56825047031367-7.81116646154641i)
+(num-test (asin 1234.0+1234.0i) 0.78539808146835+8.15773697538346i)
+(num-test (asin -1234.0+1234.0i) -0.78539808146835+8.15773697538346i)
+(num-test (asin 1234.0-1234.0i) 0.78539808130944-8.15773697530526i)
+(num-test (asin -1234.0-1234.0i) -0.78539808130944-8.15773697530526i)
+(num-test (asin 8.2729394e-17) 8.2729394e-17)
+(num-test (asin 1.821832e-231) 1.821832e-231)
+(num-test (asin 48983.30495194942-64983.97008730317i) 0.6459128607940432-12i)
+(num-test (asin 500029/2) 1.570796326794897-13.12242137571839i)
+(num-test (asin 0.0e+00+0.0e+00i) 0e0+0.0i)
+(num-test (asin 0.0e+00+1.19209289550781250e-07i) 0+1.1920928955078096766e-7i)
+(num-test (asin 0.0e+00-1.19209289550781250e-07i) 0-1.1920928955078096766e-7i)
+(num-test (asin 0.0e+00+5.0e-01i) 0+4.8121182505960344750e-1i)
+(num-test (asin 0.0e+00-5.0e-01i) 0-4.8121182505960344750e-1i)
+(num-test (asin 0.0e+00+1.0e+00i) 0+8.8137358701954302523e-1i)
+(num-test (asin 0.0e+00-1.0e+00i) 0-8.8137358701954302523e-1i)
+(num-test (asin 0.0e+00+2.0e+00i) 0+1.4436354751788103425e0i)
+(num-test (asin 0.0e+00-2.0e+00i) 0-1.4436354751788103425e0i)
+(num-test (asin 0.0e+00+8.3886080e+06i) 0+1.6635532333438690979e1i)
+(num-test (asin 0.0e+00-8.3886080e+06i) 0-1.6635532333438690979e1i)
+(num-test (asin 1.19209289550781250e-07+0.0e+00i) 1.1920928955078153234e-7)
+(num-test (asin -1.19209289550781250e-07+0.0e+00i) -1.1920928955078153234e-7)
+(num-test (asin 1.19209289550781250e-07+1.19209289550781250e-07i) 1.1920928955078068531e-7+1.1920928955078181469e-7i)
+(num-test (asin 1.19209289550781250e-07-1.19209289550781250e-07i) 1.1920928955078068531e-7-1.1920928955078181469e-7i)
+(num-test (asin -1.19209289550781250e-07+1.19209289550781250e-07i) -1.1920928955078068531e-7+1.1920928955078181469e-7i)
+(num-test (asin -1.19209289550781250e-07-1.19209289550781250e-07i) -1.1920928955078068531e-7-1.1920928955078181469e-7i)
+(num-test (asin 1.19209289550781250e-07+5.0e-01i) 1.0662402999400097805e-7+4.8121182505960598961e-1i)
+(num-test (asin 1.19209289550781250e-07-5.0e-01i) 1.0662402999400097805e-7-4.8121182505960598961e-1i)
+(num-test (asin -1.19209289550781250e-07+5.0e-01i) -1.0662402999400097805e-7+4.8121182505960598961e-1i)
+(num-test (asin -1.19209289550781250e-07-5.0e-01i) -1.0662402999400097805e-7-4.8121182505960598961e-1i)
+(num-test (asin 1.19209289550781250e-07+1.0e+00i) 8.4293697021788013662e-8+8.8137358701954553738e-1i)
+(num-test (asin 1.19209289550781250e-07-1.0e+00i) 8.4293697021788013662e-8-8.8137358701954553738e-1i)
+(num-test (asin -1.19209289550781250e-07+1.0e+00i) -8.4293697021788013662e-8+8.8137358701954553738e-1i)
+(num-test (asin -1.19209289550781250e-07-1.0e+00i) -8.4293697021788013662e-8-8.8137358701954553738e-1i)
+(num-test (asin 1.19209289550781250e-07+2.0e+00i) 5.3312014997000413263e-8+1.4436354751788116136e0i)
+(num-test (asin 1.19209289550781250e-07-2.0e+00i) 5.3312014997000413263e-8-1.4436354751788116136e0i)
+(num-test (asin -1.19209289550781250e-07+2.0e+00i) -5.3312014997000413263e-8+1.4436354751788116136e0i)
+(num-test (asin -1.19209289550781250e-07-2.0e+00i) -5.3312014997000413263e-8-1.4436354751788116136e0i)
+(num-test (asin 1.19209289550781250e-07+8.3886080e+06i) 1.4210854715201902743e-14+1.6635532333438690979e1i)
+(num-test (asin 1.19209289550781250e-07-8.3886080e+06i) 1.4210854715201902743e-14-1.6635532333438690979e1i)
+(num-test (asin -1.19209289550781250e-07+8.3886080e+06i) -1.4210854715201902743e-14+1.6635532333438690979e1i)
+(num-test (asin -1.19209289550781250e-07-8.3886080e+06i) -1.4210854715201902743e-14-1.6635532333438690979e1i)
+(num-test (asin 5.0e-01+0.0e+00i) 5.2359877559829887308e-1)
+(num-test (asin -5.0e-01+0.0e+00i) -5.2359877559829887308e-1)
+(num-test (asin 5.0e-01+1.19209289550781250e-07i) 5.2359877559829340332e-1+1.3765103082409432364e-7i)
+(num-test (asin 5.0e-01-1.19209289550781250e-07i) 5.2359877559829340332e-1-1.3765103082409432364e-7i)
+(num-test (asin -5.0e-01+1.19209289550781250e-07i) -5.2359877559829340332e-1+1.3765103082409432364e-7i)
+(num-test (asin -5.0e-01-1.19209289550781250e-07i) -5.2359877559829340332e-1-1.3765103082409432364e-7i)
+(num-test (asin 5.0e-01+5.0e-01i) 4.5227844715119068206e-1+5.3063753095251782602e-1i)
+(num-test (asin 5.0e-01-5.0e-01i) 4.5227844715119068206e-1-5.3063753095251782602e-1i)
+(num-test (asin -5.0e-01+5.0e-01i) -4.5227844715119068206e-1+5.3063753095251782602e-1i)
+(num-test (asin -5.0e-01-5.0e-01i) -4.5227844715119068206e-1-5.3063753095251782602e-1i)
+(num-test (asin 5.0e-01+1.0e+00i) 3.4943906285721329363e-1+9.2613303135018242455e-1i)
+(num-test (asin 5.0e-01-1.0e+00i) 3.4943906285721329363e-1-9.2613303135018242455e-1i)
+(num-test (asin -5.0e-01+1.0e+00i) -3.4943906285721329363e-1+9.2613303135018242455e-1i)
+(num-test (asin -5.0e-01-1.0e+00i) -3.4943906285721329363e-1-9.2613303135018242455e-1i)
+(num-test (asin 5.0e-01+2.0e+00i) 2.2101863562288385890e-1+1.4657153519472905218e0i)
+(num-test (asin 5.0e-01-2.0e+00i) 2.2101863562288385890e-1-1.4657153519472905218e0i)
+(num-test (asin -5.0e-01+2.0e+00i) -2.2101863562288385890e-1+1.4657153519472905218e0i)
+(num-test (asin -5.0e-01-2.0e+00i) -2.2101863562288385890e-1-1.4657153519472905218e0i)
+(num-test (asin 5.0e-01+8.3886080e+06i) 5.9604644775390130897e-8+1.6635532333438692755e1i)
+(num-test (asin 5.0e-01-8.3886080e+06i) 5.9604644775390130897e-8-1.6635532333438692755e1i)
+(num-test (asin -5.0e-01+8.3886080e+06i) -5.9604644775390130897e-8+1.6635532333438692755e1i)
+(num-test (asin -5.0e-01-8.3886080e+06i) -5.9604644775390130897e-8-1.6635532333438692755e1i)
+(num-test (asin 1.0e+00+0.0e+00i) 1.5707963267948966192e0)
+(num-test (asin -1.0e+00+0.0e+00i) -1.5707963267948966192e0)
+(num-test (asin 1.0e+00+1.19209289550781250e-07i) 1.5704510598153252947e0+3.4526698643116312881e-4i)
+(num-test (asin 1.0e+00-1.19209289550781250e-07i) 1.5704510598153252947e0-3.4526698643116312881e-4i)
+(num-test (asin -1.0e+00+1.19209289550781250e-07i) -1.5704510598153252947e0+3.4526698643116312881e-4i)
+(num-test (asin -1.0e+00-1.19209289550781250e-07i) -1.5704510598153252947e0-3.4526698643116312881e-4i)
+(num-test (asin 1.0e+00+5.0e-01i) 8.9590748120889023907e-1+7.3285767597364526089e-1i)
+(num-test (asin 1.0e+00-5.0e-01i) 8.9590748120889023907e-1-7.3285767597364526089e-1i)
+(num-test (asin -1.0e+00+5.0e-01i) -8.9590748120889023907e-1+7.3285767597364526089e-1i)
+(num-test (asin -1.0e+00-5.0e-01i) -8.9590748120889023907e-1-7.3285767597364526089e-1i)
+(num-test (asin 1.0e+00+1.0e+00i) 6.6623943249251525510e-1+1.0612750619050356520e0i)
+(num-test (asin 1.0e+00-1.0e+00i) 6.6623943249251525510e-1-1.0612750619050356520e0i)
+(num-test (asin -1.0e+00+1.0e+00i) -6.6623943249251525510e-1+1.0612750619050356520e0i)
+(num-test (asin -1.0e+00-1.0e+00i) -6.6623943249251525510e-1-1.0612750619050356520e0i)
+(num-test (asin 1.0e+00+2.0e+00i) 4.2707858639247612548e-1+1.5285709194809981613e0i)
+(num-test (asin 1.0e+00-2.0e+00i) 4.2707858639247612548e-1-1.5285709194809981613e0i)
+(num-test (asin -1.0e+00+2.0e+00i) -4.2707858639247612548e-1+1.5285709194809981613e0i)
+(num-test (asin -1.0e+00-2.0e+00i) -4.2707858639247612548e-1-1.5285709194809981613e0i)
+(num-test (asin 1.0e+00+8.3886080e+06i) 1.1920928955077983828e-7+1.6635532333438698084e1i)
+(num-test (asin 1.0e+00-8.3886080e+06i) 1.1920928955077983828e-7-1.6635532333438698084e1i)
+(num-test (asin -1.0e+00+8.3886080e+06i) -1.1920928955077983828e-7+1.6635532333438698084e1i)
+(num-test (asin -1.0e+00-8.3886080e+06i) -1.1920928955077983828e-7-1.6635532333438698084e1i)
+(num-test (asin 2.0e+00+0.0e+00i) 1.5707963267948966192e0-1.3169578969248167086e0i)
+(num-test (asin -2.0e+00+0.0e+00i) -1.5707963267948966192e0+1.3169578969248167086e0i)
+(num-test (asin 2.0e+00+1.19209289550781250e-07i) 1.5707962579693812072e0+1.3169578969248194435e0i)
+(num-test (asin 2.0e+00-1.19209289550781250e-07i) 1.5707962579693812072e0-1.3169578969248194435e0i)
+(num-test (asin -2.0e+00+1.19209289550781250e-07i) -1.5707962579693812072e0+1.3169578969248194435e0i)
+(num-test (asin -2.0e+00-1.19209289550781250e-07i) -1.5707962579693812072e0-1.3169578969248194435e0i)
+(num-test (asin 2.0e+00+5.0e-01i) 1.2930420702371826591e0+1.3618009008578457882e0i)
+(num-test (asin 2.0e+00-5.0e-01i) 1.2930420702371826591e0-1.3618009008578457882e0i)
+(num-test (asin -2.0e+00+5.0e-01i) -1.2930420702371826591e0+1.3618009008578457882e0i)
+(num-test (asin -2.0e+00-5.0e-01i) -1.2930420702371826591e0-1.3618009008578457882e0i)
+(num-test (asin 2.0e+00+1.0e+00i) 1.0634400235777520562e0+1.4693517443681852733e0i)
+(num-test (asin 2.0e+00-1.0e+00i) 1.0634400235777520562e0-1.4693517443681852733e0i)
+(num-test (asin -2.0e+00+1.0e+00i) -1.0634400235777520562e0+1.4693517443681852733e0i)
+(num-test (asin -2.0e+00-1.0e+00i) -1.0634400235777520562e0-1.4693517443681852733e0i)
+(num-test (asin 2.0e+00+2.0e+00i) 7.5424914469804604071e-1+1.7343245214879664480e0i)
+(num-test (asin 2.0e+00-2.0e+00i) 7.5424914469804604071e-1-1.7343245214879664480e0i)
+(num-test (asin -2.0e+00+2.0e+00i) -7.5424914469804604071e-1+1.7343245214879664480e0i)
+(num-test (asin -2.0e+00-2.0e+00i) -7.5424914469804604071e-1-1.7343245214879664480e0i)
+(num-test (asin 2.0e+00+8.3886080e+06i) 2.3841857910155628843e-7+1.663553233343871940e1i)
+(num-test (asin 2.0e+00-8.3886080e+06i) 2.3841857910155628843e-7-1.663553233343871940e1i)
+(num-test (asin -2.0e+00+8.3886080e+06i) -2.3841857910155628843e-7+1.663553233343871940e1i)
+(num-test (asin -2.0e+00-8.3886080e+06i) -2.3841857910155628843e-7-1.663553233343871940e1i)
+(num-test (asin 8.3886080e+06+0.0e+00i) 1.5707963267948966192e0-1.6635532333438683873e1i)
+(num-test (asin -8.3886080e+06+0.0e+00i) -1.5707963267948966192e0+1.6635532333438683873e1i)
+(num-test (asin 8.3886080e+06+1.19209289550781250e-07i) 1.5707963267948824084e0+1.6635532333438683873e1i)
+(num-test (asin 8.3886080e+06-1.19209289550781250e-07i) 1.5707963267948824084e0-1.6635532333438683873e1i)
+(num-test (asin -8.3886080e+06+1.19209289550781250e-07i) -1.5707963267948824084e0+1.6635532333438683873e1i)
+(num-test (asin -8.3886080e+06-1.19209289550781250e-07i) -1.5707963267948824084e0-1.6635532333438683873e1i)
+(num-test (asin 8.3886080e+06+5.0e-01i) 1.5707962671902518438e0+1.6635532333438685650e1i)
+(num-test (asin 8.3886080e+06-5.0e-01i) 1.5707962671902518438e0-1.6635532333438685650e1i)
+(num-test (asin -8.3886080e+06+5.0e-01i) -1.5707962671902518438e0+1.6635532333438685650e1i)
+(num-test (asin -8.3886080e+06-5.0e-01i) -1.5707962671902518438e0-1.6635532333438685650e1i)
+(num-test (asin 8.3886080e+06+1.0e+00i) 1.5707962075856070684e0+1.6635532333438690979e1i)
+(num-test (asin 8.3886080e+06-1.0e+00i) 1.5707962075856070684e0-1.6635532333438690979e1i)
+(num-test (asin -8.3886080e+06+1.0e+00i) -1.5707962075856070684e0+1.6635532333438690979e1i)
+(num-test (asin -8.3886080e+06-1.0e+00i) -1.5707962075856070684e0-1.6635532333438690979e1i)
+(num-test (asin 8.3886080e+06+2.0e+00i) 1.5707960883763175177e0+1.6635532333438712295e1i)
+(num-test (asin 8.3886080e+06-2.0e+00i) 1.5707960883763175177e0-1.6635532333438712295e1i)
+(num-test (asin -8.3886080e+06+2.0e+00i) -1.5707960883763175177e0+1.6635532333438712295e1i)
+(num-test (asin -8.3886080e+06-2.0e+00i) -1.5707960883763175177e0-1.6635532333438712295e1i)
+(num-test (asin 8.3886080e+06+8.3886080e+06i) 7.8539816339744653326e-1+1.6982105923718660081e1i)
+(num-test (asin 8.3886080e+06-8.3886080e+06i) 7.8539816339744653326e-1-1.6982105923718660081e1i)
+(num-test (asin -8.3886080e+06+8.3886080e+06i) -7.8539816339744653326e-1+1.6982105923718660081e1i)
+(num-test (asin -8.3886080e+06-8.3886080e+06i) -7.8539816339744653326e-1-1.6982105923718660081e1i)
+(num-test (asin -1.0e+01) -1.5707963267948966192e0+2.9932228461263808979e0i)
+(num-test (asin -2.0e+00) -1.5707963267948966192e0+1.3169578969248167086e0i)
+(num-test (asin -1.0e+00) -1.5707963267948966192e0)
+(num-test (asin -7.50e-01) -8.4806207898148100805e-1)
+(num-test (asin -5.0e-01) -5.2359877559829887308e-1)
+(num-test (asin -1.250e-01) -1.2532783116806539687e-1)
+(num-test (asin -3.45266983001243932001e-04) -3.4526698986108292481e-4)
+(num-test (asin -1.19209289550781250e-07) -1.1920928955078153234e-7)
+(num-test (asin 0.0e+00) 0e0)
+(num-test (asin 1.19209289550781250e-07) 1.1920928955078153234e-7)
+(num-test (asin 3.45266983001243932001e-04) 3.4526698986108292481e-4)
+(num-test (asin 1.250e-01) 1.2532783116806539687e-1)
+(num-test (asin 5.0e-01) 5.2359877559829887308e-1)
+(num-test (asin 7.50e-01) 8.4806207898148100805e-1)
+(num-test (asin 1.0e+00) 1.5707963267948966192e0)
+(num-test (asin 2.0e+00) 1.5707963267948966192e0-1.3169578969248167086e0i)
+(num-test (asin 1.0e+01) 1.5707963267948966192e0-2.9932228461263808979e0i)
+(num-test (asin 0) 0.0)
+(num-test (asin 2) 1.570796326794897-1.316957896924817i)
+(num-test (asin 3.0+70000000i) 4.2857142400327436E-8+18.7571529895002i)
+(num-test (asin 70000000+3i) 1.570796279536826+18.75715298057358i)
+(num-test (asin 3.0-70000000i) 4.2857142400327436E-8-18.7571529895002i)
+(num-test (asin -70000000+3i) -1.570796279536826+18.75715298057358i)
+(num-test (asin 1e17+1e17i) 0.78539816339745+40.183667351739i)
+(num-test (asin 1+1e17i) 1e-17+39.837093761459i)
+(num-test (asin -2.225073858507201399999999999999999999996E-308) -2.225073858507201399999999999999999999996E-308)
+(num-test (asin 1.110223024625156799999999999999999999997E-16) 1.110223024625156800000000000000002280754E-16)
+(num-test (asin (/ (sqrt 2) 2)) (/ pi 4))
+(num-test (asin (/ (sqrt 3) -2)) (/ pi -3))
+(num-test (* 10 (asin (/ (- (sqrt 5) 1) 4))) pi)
+(num-test (* 2 (asin 1)) pi)
+
+(for-each
+ (lambda (num-and-val)
+   (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'asin num (asin num) val)))
+ (vector (list 0 0) (list 1 1.5707963267949) (list 2 1.5707963267949-1.3169578969248i) (list 3 1.5707963267949-1.7627471740391i)
+	 (list -1 -1.5707963267949) (list -2 -1.5707963267949+1.3169578969248i) (list -3 -1.5707963267949+1.7627471740391i)
+	 (list 9223372036854775807 1.5707963267949-44.361419555836i) (list -9223372036854775808 -1.5707963267949+44.361419555836i)
+	 (list 1/2 0.5235987755983) (list 1/3 0.33983690945412) (list -1/2 -0.5235987755983)
+	 (list -1/3 -0.33983690945412) (list 1/9223372036854775807 1.0842021724855e-19) (list 0.0 0.0)
+	 (list 1.0 1.5707963267949) (list 2.0 1.5707963267949-1.3169578969248i) (list -2.0 -1.5707963267949+1.3169578969248i)
+	 (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309)
+	 (list 1e+16 1.5707963267949-37.534508668465i) (list 0+1i 0+0.88137358701954i) (list 0+2i 0+1.4436354751788i)
+	 (list 0-1i 0-0.88137358701954i) (list 1+1i 0.66623943249252+1.061275061905i) (list 1-1i 0.66623943249252-1.061275061905i)
+	 (list -1+1i -0.66623943249252+1.061275061905i) (list -1-1i -0.66623943249252-1.061275061905i)
+	 (list 0.1+0.1i 0.099663702859795+0.10033029811221i) (list 1e+16+1e+16i 0.78539816339745+37.881082258745i)
+	 (list 1e-16+1e-16i 1e-16+1.1102230246252e-16i) ))
+
+(let ((err 0.0)
+      (mx 0.0))
+  (do ((i 0 (+ i 1))
+       (x -10.0 (+ x .1)))
+      ((= i 200))
+    (let ((y (magnitude (- x (sin (asin x))))))
+      (if (> y err) (begin (set! mx x) (set! err y)))))
+  (if (> err 1e-12)
+      (format #t ";(sin (asin ~A)) error: ~A~%" mx err)))
+
+(let ((err 0.0)
+      (mx 0.0))
+  (do ((i 0 (+ i 1))
+       (x 1.0-i (+ x -.1+i)))
+      ((= i 100))
+    (let ((y (magnitude (- x (sin (asin x))))))
+      (if (> y err) (begin (set! mx x) (set! err y)))))
+  (if (> err 1e-9)
+      (format #t ";(sin (asin ~A)) error: ~A~%" mx err)))
+
+(test (asin) 'error)
+(test (asin "hi") 'error)
+(test (asin 1.0+23.0i 1.0+23.0i) 'error)
+(test (asin 0 1) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (asin arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(let ((asins (list
+	      0.00000000000000000000000000000000000000000000000000000000000000000000
+	      0.02500260489936113599406838915349107150195748368840710160729904233944
+	      0.05002085680577001466274438682046411497780608049468789272874398055703
+	      0.07507049107671654265775143572317089898194705496817785120910161299955
+	      0.10016742116155979634552317945269331856867597222962954139102385503640
+	      0.12532783116806539687456698635708471804814772683867237523396403098649
+	      0.15056827277668602642326030146739539047425784470580485344319902595849
+	      0.17590576816371628737774199743846051972730948209298253171964068749984
+	      0.20135792079033079145512555221762341024003808140222838625725124345560
+	      0.22694303617851994909359260763689579636930963064761339672521677581090
+	      0.25268025514207865348565743699371097225219373309683819363392377874057
+	      0.27858970239165058217050815183568882129133935843106227203280647300877
+	      0.30469265401539750797200296122752916695456003170677638739297794874647
+	      0.33101172808929452771961639961139035858195303667932389628972377319123
+	      0.35757110364551028671483849232064256784674132498948776325141270863037
+	      0.38439677449563908303819487296704697375277948430656504155058375479079
+	      0.41151684606748801938473789761733560485570113512702585178394678070009
+	      0.43896188560976067483321619602147236009843505358239561712817387552271
+	      0.46676533904729636185033976030413712126156503909241369925276357159851
+	      0.49496403171689461363027991615293072605447706550005723007748628111125
+	      0.52359877559829887307710723054658381403286156656251763682915743205130
+	      0.55271511309678317285035596261806027710654731438452549350875265730232
+	      0.58236423786874344183204729090997636797897358751436418853659347126034
+	      0.61260414804862246566851988030718610964520075565860642564808142300476
+	      0.64350110879328438680280922871732263804151059111531238286560611871351
+	      0.67513153293703164720905626529438801420418535124967921737841984904557
+	      0.70758443672535557545286474430459468476197717933193633785448106190261
+	      0.74096470220302000164595109317351452207440076171206748884906746063949
+	      0.77539749661075306374035335271498711355578873864116199359771996373272
+	      0.81103439428758154765966499519016990220446846078107874166646027112837
+	      0.84806207898148100805294433899841808007336621326311264286071816357020
+	      0.88671509499956738294114522105877020358977872696702934222169938478807
+	      0.92729521800161223242851246292242880405707410857224052762186617744039
+	      0.97020219992884564627294507144637975649395034794671876838355202607208
+	      1.01598529381482513116231792163105149400316379682053508778250056579494
+	      1.06543581651073931226000681765232949759419723349387652321962473867275
+	      1.11976951499863418668667705584539961589516218640330288237568186391443
+	      1.18103559399742179696187441797151603545275866323114802494551011137296
+	      1.25323589750337525873710391866600599574114067342736145636046515573871
+	      1.34672104149307735953151290762049740983950868154764854526693662237423
+	      1.57079632679489661923132169163975144209858469968755291048747229615390)))
+  (let ((mxerr 0.0))
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x (/ 1.0 40.0))))
+	((= i 40))
+      (let ((err (abs (- (asin x) (list-ref asins i)))))
+	(if (> err mxerr)
+	    (set! mxerr err))))
+    (if (> mxerr 1e-12) (format #t "asin err: ~A~%" mxerr))))
+
+(when with-bignums
+  (let-temporarily (((*s7* 'bignum-precision) 500))
+    (let ((asins (list ; table[Arcsin[k/30], {k, 0, 30}]
+		  0.00000000000000000000000000000000000000000000000000000000000000000000e0
+		  0.03333950926130208699143488077083860917565937855129663393680393744362
+		  0.06671614841022525954540510327036927409184944434654403274652597117428
+		  0.10016742116155979634552317945269331856867597222962954139102385503640
+		  0.13373158940994152865632332716309743011405498274444165545458875924377
+		  0.16744807921968933055327460604363822091495716231623832046578730373329
+		  0.20135792079033079145512555221762341024003808140222838625725124345560
+		  0.23550423672079979129288448393723556648106234259531297814541683051663
+		  0.26993279583340344442461498978851864365647337427020501782962042633379
+		  0.30469265401539750797200296122752916695456003170677638739297794874647
+		  0.33983690945412193709639251339176406638824469033245807143192396248991
+		  0.37542360798103940368516545708214708494670535320625397496008012654413
+		  0.41151684606748801938473789761733560485570113512702585178394678070009
+		  0.44818813597943128994043756304906477118029918046343080720212217855713
+		  0.48551812229559116327223435902482444763168509494201196125953547218486
+		  0.52359877559829887307710723054658381403286156656251763682915743205130
+		  0.56253624454385561973132565694853319169977493405170278279550382560769
+		  0.60245463338499055124863378781466897272136400811697167837514413874507
+		  0.64350110879328438680280922871732263804151059111531238286560611871351
+		  0.68585296461871075596328071793021108476903703940127104404158318225766
+		  0.72972765622696636345479665981332069539650591404771369070894949146181
+		  0.77539749661075306374035335271498711355578873864116199359771996373272
+		  0.82321197712587582143797706006235798228453830885144107684904792594002
+		  0.87363319315266432351068180914720023973456695459982111043494836254140
+		  0.92729521800161223242851246292242880405707410857224052762186617744039
+		  0.98511078333774565961356415316223367589822363251591140783691296893264
+		  1.04848150498884799670722286578404816608970376214442109090268484725633
+		  1.11976951499863418668667705584539961589516218640330288237568186391443
+		  1.20358830623705947672584877793852613585139977949919656045114461770445
+		  1.31187478478867540346593147633958737932614651512288222488818316043445
+		  1.57079632679489661923132169163975144209858469968755291048747229615390)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 30))
+	(let ((val (asin (bignum (/ i 30)))))
+	  (if (> (magnitude (- val (list-ref asins i))) 1e-36)
+	      (format #t ";(asin ~A) -> ~A ~A~%[~A]~%" (/ i 30) val (list-ref asins i) (magnitude (- val (list-ref asins i))))))))))
+
+
+
+
+
+;;;--------------------------------------------------------------------------------
+;;; acos
+;;; --------------------------------------------------------------------------------
+
+(num-test (acos 0) 1.57079632679490)
+(num-test (acos 1) 0.0)
+(num-test (acos -1) pi)
+(num-test (acos 2) 0.0-1.31695789692482i)
+(num-test (acos -2) 3.14159265358979-1.31695789692482i)
+(num-test (acos 3) 0.0-1.76274717403909i)
+(num-test (acos -3) 3.14159265358979-1.76274717403909i)
+(num-test (acos 10) 0.0-2.99322284612638i)
+(num-test (acos -10) 3.14159265358979-2.99322284612638i)
+(num-test (acos 1234) 0.0-7.81116322068415i)
+(num-test (acos -1234) 3.14159265358979-7.81116322068415i)
+(num-test (acos 0/1) 1.57079632679490)
+(num-test (acos 0/2) 1.57079632679490)
+(num-test (acos 0/3) 1.57079632679490)
+(num-test (acos 0/10) 1.57079632679490)
+(num-test (acos 0/1234) 1.57079632679490)
+(num-test (acos 0/500029) 1.57079632679490)
+(num-test (acos 1/1) 0.0)
+(num-test (acos -1/1) pi)
+(num-test (acos 1/2) 1.04719755119660)
+(num-test (acos -1/2) 2.09439510239320)
+(num-test (acos 1/3) 1.23095941734077)
+(num-test (acos -1/3) 1.91063323624902)
+(num-test (acos 1/10) 1.47062890563334)
+(num-test (acos -1/10) 1.67096374795646)
+(num-test (acos 1/1234) 1.56998595393473)
+(num-test (acos -1/1234) 1.57160669965507)
+(num-test (acos 1/500029) 1.57079432691089)
+(num-test (acos -1/500029) 1.57079832667890)
+(num-test (acos 2/1) 0.0-1.31695789692482i)
+(num-test (acos -2/1) 3.14159265358979-1.31695789692482i)
+(num-test (acos 2/2) 0.0)
+(num-test (acos -2/2) pi)
+(num-test (acos 2/3) 0.84106867056793)
+(num-test (acos -2/3) 2.30052398302186)
+(num-test (acos 2/10) 1.36943840600457)
+(num-test (acos -2/10) 1.77215424758523)
+(num-test (acos 2/1234) 1.56917558054238)
+(num-test (acos -2/1234) 1.57241707304741)
+(num-test (acos 2/500029) 1.57079232702688)
+(num-test (acos -2/500029) 1.57080032656291)
+(num-test (acos 3/1) 0.0-1.76274717403909i)
+(num-test (acos -3/1) 3.14159265358979-1.76274717403909i)
+(num-test (acos 3/2) 0.0-0.96242365011921i)
+(num-test (acos -3/2) 3.14159265358979-0.96242365011921i)
+(num-test (acos 3/3) 0.0)
+(num-test (acos -3/3) pi)
+(num-test (acos 3/10) 1.26610367277950)
+(num-test (acos -3/10) 1.87548898081029)
+(num-test (acos 3/1234) 1.56836520608568)
+(num-test (acos -3/1234) 1.57322744750412)
+(num-test (acos 3/500029) 1.57079032714288)
+(num-test (acos -3/500029) 1.57080232644692)
+(num-test (acos 10/1) 0.0-2.99322284612638i)
+(num-test (acos -10/1) 3.14159265358979-2.99322284612638i)
+(num-test (acos 10/2) 0.0-2.29243166956117i)
+(num-test (acos -10/2) 3.14159265358979-2.29243166956117i)
+(num-test (acos 10/3) 0.0-1.87382024252741i)
+(num-test (acos -10/3) 3.14159265358979-1.87382024252741i)
+(num-test (acos 10/10) 0.0)
+(num-test (acos -10/10) pi)
+(num-test (acos 10/1234) 1.56269251038168)
+(num-test (acos -10/1234) 1.57890014320811)
+(num-test (acos 10/500029) 1.57077632795483)
+(num-test (acos -10/500029) 1.57081632563497)
+(num-test (acos 1234/1) 0.0-7.81116322068415i)
+(num-test (acos -1234/1) 3.14159265358979-7.81116322068415i)
+(num-test (acos 1234/2) 0.0-7.11801554770806i)
+(num-test (acos -1234/2) 3.14159265358979-7.11801554770806i)
+(num-test (acos 1234/3) 0.0-6.71254961876657i)
+(num-test (acos -1234/3) 3.14159265358979-6.71254961876657i)
+(num-test (acos 1234/10) 0.0-5.50856187402751i)
+(num-test (acos -1234/10) 3.14159265358979-5.50856187402751i)
+(num-test (acos 1234/500029) 1.56832846742558)
+(num-test (acos -1234/500029) 1.57326418616421)
+(num-test (acos 500029/3) 0+12.7169561400958i)
+(num-test (acos -500029/3) 3.14159265358979-12.7169561400958i)
+(num-test (acos 500029/10) 0.0+11.51298346318831i) ; maxima
+(num-test (acos -500029/10) 3.14159265358979-11.51298333576987i)
+(num-test (acos 500029/1234) 0.0-6.69755082925184i)
+(num-test (acos -500029/1234) 3.14159265358979-6.69755082925184i)
+(num-test (acos 500029/500029) 0.0)
+(num-test (acos -500029/500029) pi)
+(num-test (acos 0.0) 1.57079632679490)
+(num-test (acos 0.00000001) 1.57079631679490)
+(num-test (acos -0.00000001) 1.57079633679490)
+(num-test (acos 1.0) 0.0)
+(num-test (acos -1.0) pi)
+(num-test (acos pi) 0.0-1.81152627246085i)
+(num-test (acos -3.14159265358979) 3.14159265358979-1.81152627246085i)
+(num-test (acos 1234.0) 0.0-7.81116322068415i)
+(num-test (acos -1234.0) 3.14159265358979-7.81116322068415i)
+(num-test (acos 0.0+0.0i) 1.57079632679490)
+(num-test (acos -0.0+0.0i) 1.57079632679490)
+(num-test (acos 0.0-0.0i) 1.57079632679490)
+(num-test (acos -0.0-0.0i) 1.57079632679490)
+(num-test (acos 0.0+0.00000001i) 1.57079632679490-0.00000001i)
+(num-test (acos -0.0+0.00000001i) 1.57079632679490-0.00000001i)
+(num-test (acos 0.0-0.00000001i) 1.57079632679490+0.00000001i)
+(num-test (acos -0.0-0.00000001i) 1.57079632679490+0.00000001i)
+(num-test (acos 0.0+1.0i) 1.57079632679490-0.88137358701954i)
+(num-test (acos -0.0+1.0i) 1.57079632679490-0.88137358701954i)
+(num-test (acos 0.0-1.0i) 1.57079632679490+0.88137358701954i)
+(num-test (acos -0.0-1.0i) 1.57079632679490+0.88137358701954i)
+(num-test (acos 0.0+3.14159265358979i) 1.57079632679490-1.86229574331085i)
+(num-test (acos -0.0+3.14159265358979i) 1.57079632679490-1.86229574331085i)
+(num-test (acos 0.0-3.14159265358979i) 1.57079632679490+1.86229574331085i)
+(num-test (acos -0.0-3.14159265358979i) 1.57079632679490+1.86229574331085i)
+(num-test (acos 0.0+1234.0i) 1.57079632679490-7.81116354896171i)
+(num-test (acos -0.0+1234.0i) 1.57079632679490-7.81116354896171i)
+(num-test (acos 0.0-1234.0i) 1.57079632679490+7.81116354920125i)
+(num-test (acos -0.0-1234.0i) 1.57079632679490+7.81116354920125i)
+(num-test (acos 0.00000001+0.0i) 1.57079631679490)
+(num-test (acos -0.00000001+0.0i) 1.57079633679490)
+(num-test (acos 0.00000001-0.0i) 1.57079631679490)
+(num-test (acos -0.00000001-0.0i) 1.57079633679490)
+(num-test (acos 0.00000001+0.00000001i) 1.57079631679490-0.00000001i)
+(num-test (acos -0.00000001+0.00000001i) 1.57079633679490-0.00000001i)
+(num-test (acos 0.00000001-0.00000001i) 1.57079631679490+0.00000001i)
+(num-test (acos -0.00000001-0.00000001i) 1.57079633679490+0.00000001i)
+(num-test (acos 0.00000001+1.0i) 1.57079631972383-0.88137358701954i)
+(num-test (acos -0.00000001+1.0i) 1.57079633386596-0.88137358701954i)
+(num-test (acos 0.00000001-1.0i) 1.57079631972383+0.88137358701954i)
+(num-test (acos -0.00000001-1.0i) 1.57079633386596+0.88137358701954i)
+(num-test (acos 0.00000001+3.14159265358979i) 1.57079632376175-1.86229574331085i)
+(num-test (acos -0.00000001+3.14159265358979i) 1.57079632982804-1.86229574331085i)
+(num-test (acos 0.00000001-3.14159265358979i) 1.57079632376175+1.86229574331085i)
+(num-test (acos -0.00000001-3.14159265358979i) 1.57079632982804+1.86229574331085i)
+(num-test (acos 0.00000001+1234.0i) 1.57079632678679-7.81116354896171i)
+(num-test (acos -0.00000001+1234.0i) 1.57079632680300-7.81116354896171i)
+(num-test (acos 0.00000001-1234.0i) 1.57079632678679+7.81116354920125i)
+(num-test (acos -0.00000001-1234.0i) 1.57079632680300+7.81116354920125i)
+(num-test (acos 1.0+0.0i) 0.0)
+(num-test (acos -1.0+0.0i) pi)
+(num-test (acos 1.0-0.0i) 0.0)
+(num-test (acos -1.0-0.0i) pi)
+(num-test (acos 1.0+0.00000001i) 0.00009999999992-0.00010000000008i)
+(num-test (acos -1.0+0.00000001i) 3.14149265358988-0.00010000000008i)
+(num-test (acos 1.0-0.00000001i) 0.00009999999992+0.00010000000008i)
+(num-test (acos -1.0-0.00000001i) 3.14149265358988+0.00010000000008i)
+(num-test (acos 1.0+1.0i) 0.90455689430238-1.06127506190504i)
+(num-test (acos -1.0+1.0i) 2.23703575928741-1.06127506190504i)
+(num-test (acos 1.0-1.0i) 0.90455689430238+1.06127506190504i)
+(num-test (acos -1.0-1.0i) 2.23703575928741+1.06127506190504i)
+(num-test (acos 1.0+3.14159265358979i) 1.27521129258327-1.90462768697066i)
+(num-test (acos -1.0+3.14159265358979i) 1.86638136100653-1.90462768697066i)
+(num-test (acos 1.0-3.14159265358979i) 1.27521129258327+1.90462768697066i)
+(num-test (acos -1.0-3.14159265358979i) 1.86638136100653+1.90462768697066i)
+(num-test (acos 1.0+1234.0i) 1.56998595446684-7.81116387772663i)
+(num-test (acos -1.0+1234.0i) 1.57160669912296-7.81116387772663i)
+(num-test (acos 1.0-1234.0i) 1.56998595446690+7.81116387755283i)
+(num-test (acos -1.0-1234.0i) 1.57160669912289+7.81116387755283i)
+(num-test (acos 3.14159265358979+0.0i) 0.0-1.81152627246085i)
+(num-test (acos -3.14159265358979+0.0i) 3.14159265358979-1.81152627246085i)
+(num-test (acos 3.14159265358979-0.0i) 0.0-1.81152627246085i)
+(num-test (acos -3.14159265358979-0.0i) 3.14159265358979-1.81152627246085i)
+(num-test (acos 3.14159265358979+0.00000001i) 0.00000000335775-1.81152627246085i)
+(num-test (acos -3.14159265358979+0.00000001i) 3.14159265023205-1.81152627246085i)
+(num-test (acos 3.14159265358979-0.00000001i) 0.00000000335775+1.81152627246085i)
+(num-test (acos -3.14159265358979-0.00000001i) 3.14159265023205+1.81152627246085i)
+(num-test (acos 3.14159265358979+1.0i) 0.32225329398146-1.86711439316026i)
+(num-test (acos -3.14159265358979+1.0i) 2.81933935960833-1.86711439316026i)
+(num-test (acos 3.14159265358979-1.0i) 0.32225329398146+1.86711439316026i)
+(num-test (acos -3.14159265358979-1.0i) 2.81933935960833+1.86711439316026i)
+(num-test (acos 3.14159265358979+3.14159265358979i) 0.79805654766741-2.18469104082751i)
+(num-test (acos -3.14159265358979+3.14159265358979i) 2.34353610592238-2.18469104082751i)
+(num-test (acos 3.14159265358979-3.14159265358979i) 0.79805654766741+2.18469104082751i)
+(num-test (acos -3.14159265358979-3.14159265358979i) 2.34353610592238+2.18469104082751i)
+(num-test (acos 3.14159265358979+1234.0i) 1.56825047198589-7.81116678966949i)
+(num-test (acos -3.14159265358979+1234.0i) 1.57334218160390-7.81116678966949i)
+(num-test (acos 3.14159265358979-1234.0i) 1.56825047198552+7.81116678989204i)
+(num-test (acos -3.14159265358979-1234.0i) 1.57334218160427+7.81116678989204i)
+(num-test (acos 1234.0+0.0i) 0.0-7.81116322068415i)
+(num-test (acos -1234.0+0.0i) 3.14159265358979-7.81116322068415i)
+(num-test (acos 1234.0-0.0i) 0.0-7.81116322068415i)
+(num-test (acos -1234.0-0.0i) 3.14159265358979-7.81116322068415i)
+(num-test (acos 1234.0+0.00000001i) 0.00000000000810-7.81116322068415i)
+(num-test (acos -1234.0+0.00000001i) 3.14159265358169-7.81116322068415i)
+(num-test (acos 1234.0-0.00000001i) 0.00000000000810+7.81116322084923i)
+(num-test (acos -1234.0-0.00000001i) 3.14159265358169+7.81116322084923i)
+(num-test (acos 1234.0+1.0i) 0.00081037286048-7.81116354944842i)
+(num-test (acos -1234.0+1.0i) 3.14078228072931-7.81116354944842i)
+(num-test (acos 1234.0-1.0i) 0.00081037286017+7.81116354920146i)
+(num-test (acos -1234.0-1.0i) 3.14078228072962+7.81116354920146i)
+(num-test (acos 1234.0+3.14159265358979i) 0.00254585647983-7.81116646138554i)
+(num-test (acos -1234.0+3.14159265358979i) 3.13904679710996-7.81116646138554i)
+(num-test (acos 1234.0-3.14159265358979i) 0.00254585648123+7.81116646154641i)
+(num-test (acos -1234.0-3.14159265358979i) 3.13904679710856+7.81116646154641i)
+(num-test (acos 1234.0+1234.0i) 0.78539824532655-8.15773697538346i)
+(num-test (acos -1234.0+1234.0i) 2.35619440826324-8.15773697538346i)
+(num-test (acos 1234.0-1234.0i) 0.78539824548545+8.15773697530526i)
+(num-test (acos -1234.0-1234.0i) 2.35619440810434+8.15773697530526i)
+(num-test (acos -2.0) 3.141592653589793-1.316957896924817i)
+(num-test (acos 3.0+70000000i) 1.570796283937754-18.7571529895002i) ; C breaks near here
+(num-test (acos 70000000+3i) 4.725807101202406E-8-18.75715298057358i)
+(num-test (acos 3.0-70000000i) 1.570796283937754+18.7571529895002i)
+(num-test (acos -70000000+3i) 3.141592606331722-18.75715298057358i)
+(num-test (acos 1.5) 0.0+0.9624236501192069i)
+(num-test (acos -1.5) 3.141592653589793-0.9624236501192069i)
+(num-test (acos -1.0e+01) 3.1415926535897932385e0-2.9932228461263808979e0i)
+(num-test (acos -2.0e+00) 3.1415926535897932385e0-1.3169578969248167086e0i)
+(num-test (acos -1.0e+00) pi)
+(num-test (acos -7.50e-01) 2.4188584057763776273e0)
+(num-test (acos -5.0e-01) 2.0943951023931954923e0)
+(num-test (acos -1.250e-01) 1.6961241579629620161e0)
+(num-test (acos -3.45266983001243932001e-04) 1.5711415937847577022e0)
+(num-test (acos -1.19209289550781250e-07) 1.570796446004186170e0)
+(num-test (acos 0.0e+00) 1.5707963267948966192e0)
+(num-test (acos 1.19209289550781250e-07) 1.5707962075856070684e0)
+(num-test (acos 3.45266983001243932001e-04) 1.5704510598050355363e0)
+(num-test (acos 1.250e-01) 1.4454684956268312224e0)
+(num-test (acos 5.0e-01) 1.0471975511965977462e0)
+(num-test (acos 7.50e-01) 7.2273424781341561118e-1)
+(num-test (acos 1.0e+00) 0e0)
+(num-test (acos 2.0e+00) 0+1.3169578969248167086e0i)
+(num-test (acos 1.0e+01) 0+2.9932228461263808979e0i)
+(num-test (acos 0.0e+00+0.0e+00i) 1.5707963267948966192e0)
+(num-test (acos 0.0e+00+1.19209289550781250e-07i) 1.5707963267948966192e0-1.1920928955078096766e-7i)
+(num-test (acos 0.0e+00-1.19209289550781250e-07i) 1.5707963267948966192e0+1.1920928955078096766e-7i)
+(num-test (acos 0.0e+00+5.0e-01i) 1.5707963267948966192e0-4.8121182505960344750e-1i)
+(num-test (acos 0.0e+00-5.0e-01i) 1.5707963267948966192e0+4.8121182505960344750e-1i)
+(num-test (acos 0.0e+00+1.0e+00i) 1.5707963267948966192e0-8.8137358701954302523e-1i)
+(num-test (acos 0.0e+00-1.0e+00i) 1.5707963267948966192e0+8.8137358701954302523e-1i)
+(num-test (acos 0.0e+00+2.0e+00i) 1.5707963267948966192e0-1.4436354751788103425e0i)
+(num-test (acos 0.0e+00-2.0e+00i) 1.5707963267948966192e0+1.4436354751788103425e0i)
+(num-test (acos 0.0e+00+8.3886080e+06i) 1.5707963267948966192e0-1.6635532333438690979e1i)
+(num-test (acos 0.0e+00-8.3886080e+06i) 1.5707963267948966192e0+1.6635532333438690979e1i)
+(num-test (acos 1.19209289550781250e-07+0.0e+00i) 1.5707962075856070684e0)
+(num-test (acos -1.19209289550781250e-07+0.0e+00i) 1.570796446004186170e0)
+(num-test (acos 1.19209289550781250e-07+1.19209289550781250e-07i) 1.5707962075856070685e0-1.1920928955078181469e-7i)
+(num-test (acos 1.19209289550781250e-07-1.19209289550781250e-07i) 1.5707962075856070685e0+1.1920928955078181469e-7i)
+(num-test (acos -1.19209289550781250e-07+1.19209289550781250e-07i) 1.570796446004186170e0-1.1920928955078181469e-7i)
+(num-test (acos -1.19209289550781250e-07-1.19209289550781250e-07i) 1.570796446004186170e0+1.1920928955078181469e-7i)
+(num-test (acos 1.19209289550781250e-07+5.0e-01i) 1.5707962201708666252e0-4.8121182505960598961e-1i)
+(num-test (acos 1.19209289550781250e-07-5.0e-01i) 1.5707962201708666252e0+4.8121182505960598961e-1i)
+(num-test (acos -1.19209289550781250e-07+5.0e-01i) 1.5707964334189266132e0-4.8121182505960598961e-1i)
+(num-test (acos -1.19209289550781250e-07-5.0e-01i) 1.5707964334189266132e0+4.8121182505960598961e-1i)
+(num-test (acos 1.19209289550781250e-07+1.0e+00i) 1.5707962425011995974e0-8.8137358701954553738e-1i)
+(num-test (acos 1.19209289550781250e-07-1.0e+00i) 1.5707962425011995974e0+8.8137358701954553738e-1i)
+(num-test (acos -1.19209289550781250e-07+1.0e+00i) 1.5707964110885936410e0-8.8137358701954553738e-1i)
+(num-test (acos -1.19209289550781250e-07-1.0e+00i) 1.5707964110885936410e0+8.8137358701954553738e-1i)
+(num-test (acos 1.19209289550781250e-07+2.0e+00i) 1.5707962734828816222e0-1.4436354751788116136e0i)
+(num-test (acos 1.19209289550781250e-07-2.0e+00i) 1.5707962734828816222e0+1.4436354751788116136e0i)
+(num-test (acos -1.19209289550781250e-07+2.0e+00i) 1.5707963801069116162e0-1.4436354751788116136e0i)
+(num-test (acos -1.19209289550781250e-07-2.0e+00i) 1.5707963801069116162e0+1.4436354751788116136e0i)
+(num-test (acos 1.19209289550781250e-07+8.3886080e+06i) 1.5707963267948824084e0-1.6635532333438690979e1i)
+(num-test (acos 1.19209289550781250e-07-8.3886080e+06i) 1.5707963267948824084e0+1.6635532333438690979e1i)
+(num-test (acos -1.19209289550781250e-07+8.3886080e+06i) 1.5707963267949108301e0-1.6635532333438690979e1i)
+(num-test (acos -1.19209289550781250e-07-8.3886080e+06i) 1.5707963267949108301e0+1.6635532333438690979e1i)
+(num-test (acos 5.0e-01+0.0e+00i) 1.0471975511965977462e0)
+(num-test (acos -5.0e-01+0.0e+00i) 2.0943951023931954923e0)
+(num-test (acos 5.0e-01+1.19209289550781250e-07i) 1.0471975511966032159e0-1.3765103082409432364e-7i)
+(num-test (acos 5.0e-01-1.19209289550781250e-07i) 1.0471975511966032159e0+1.3765103082409432364e-7i)
+(num-test (acos -5.0e-01+1.19209289550781250e-07i) 2.0943951023931900225e0-1.3765103082409432364e-7i)
+(num-test (acos -5.0e-01-1.19209289550781250e-07i) 2.0943951023931900225e0+1.3765103082409432364e-7i)
+(num-test (acos 5.0e-01+5.0e-01i) 1.1185178796437059372e0-5.3063753095251782602e-1i)
+(num-test (acos 5.0e-01-5.0e-01i) 1.1185178796437059372e0+5.3063753095251782602e-1i)
+(num-test (acos -5.0e-01+5.0e-01i) 2.0230747739460873013e0-5.3063753095251782602e-1i)
+(num-test (acos -5.0e-01-5.0e-01i) 2.0230747739460873013e0+5.3063753095251782602e-1i)
+(num-test (acos 5.0e-01+1.0e+00i) 1.2213572639376833256e0-9.2613303135018242455e-1i)
+(num-test (acos 5.0e-01-1.0e+00i) 1.2213572639376833256e0+9.2613303135018242455e-1i)
+(num-test (acos -5.0e-01+1.0e+00i) 1.9202353896521099129e0-9.2613303135018242455e-1i)
+(num-test (acos -5.0e-01-1.0e+00i) 1.9202353896521099129e0+9.2613303135018242455e-1i)
+(num-test (acos 5.0e-01+2.0e+00i) 1.3497776911720127603e0-1.4657153519472905218e0i)
+(num-test (acos 5.0e-01-2.0e+00i) 1.3497776911720127603e0+1.4657153519472905218e0i)
+(num-test (acos -5.0e-01+2.0e+00i) 1.7918149624177804781e0-1.4657153519472905218e0i)
+(num-test (acos -5.0e-01-2.0e+00i) 1.7918149624177804781e0+1.4657153519472905218e0i)
+(num-test (acos 5.0e-01+8.3886080e+06i) 1.5707962671902518438e0-1.6635532333438692755e1i)
+(num-test (acos 5.0e-01-8.3886080e+06i) 1.5707962671902518438e0+1.6635532333438692755e1i)
+(num-test (acos -5.0e-01+8.3886080e+06i) 1.5707963863995413946e0-1.6635532333438692755e1i)
+(num-test (acos -5.0e-01-8.3886080e+06i) 1.5707963863995413946e0+1.6635532333438692755e1i)
+(num-test (acos 1.0e+00+0.0e+00i) 0e0)
+(num-test (acos -1.0e+00+0.0e+00i) pi)
+(num-test (acos 1.0e+00+1.19209289550781250e-07i) 3.4526697957132450399e-4-3.4526698643116312881e-4i)
+(num-test (acos 1.0e+00-1.19209289550781250e-07i) 3.4526697957132450399e-4+3.4526698643116312881e-4i)
+(num-test (acos -1.0e+00+1.19209289550781250e-07i) 3.1412473866102219140e0-3.4526698643116312881e-4i)
+(num-test (acos -1.0e+00-1.19209289550781250e-07i) 3.1412473866102219140e0+3.4526698643116312881e-4i)
+(num-test (acos 1.0e+00+5.0e-01i) 6.7488884558600638016e-1-7.3285767597364526089e-1i)
+(num-test (acos 1.0e+00-5.0e-01i) 6.7488884558600638016e-1+7.3285767597364526089e-1i)
+(num-test (acos -1.0e+00+5.0e-01i) 2.4667038080037868583e0-7.3285767597364526089e-1i)
+(num-test (acos -1.0e+00-5.0e-01i) 2.4667038080037868583e0+7.3285767597364526089e-1i)
+(num-test (acos 1.0e+00+1.0e+00i) 9.0455689430238136413e-1-1.0612750619050356520e0i)
+(num-test (acos 1.0e+00-1.0e+00i) 9.0455689430238136413e-1+1.0612750619050356520e0i)
+(num-test (acos -1.0e+00+1.0e+00i) 2.2370357592874118743e0-1.0612750619050356520e0i)
+(num-test (acos -1.0e+00-1.0e+00i) 2.2370357592874118743e0+1.0612750619050356520e0i)
+(num-test (acos 1.0e+00+2.0e+00i) 1.1437177404024204938e0-1.5285709194809981613e0i)
+(num-test (acos 1.0e+00-2.0e+00i) 1.1437177404024204938e0+1.5285709194809981613e0i)
+(num-test (acos -1.0e+00+2.0e+00i) 1.9978749131873727447e0-1.5285709194809981613e0i)
+(num-test (acos -1.0e+00-2.0e+00i) 1.9978749131873727447e0+1.5285709194809981613e0i)
+(num-test (acos 1.0e+00+8.3886080e+06i) 1.5707962075856070685e0-1.6635532333438698084e1i)
+(num-test (acos 1.0e+00-8.3886080e+06i) 1.5707962075856070685e0+1.6635532333438698084e1i)
+(num-test (acos -1.0e+00+8.3886080e+06i) 1.570796446004186170e0-1.6635532333438698084e1i)
+(num-test (acos -1.0e+00-8.3886080e+06i) 1.570796446004186170e0+1.6635532333438698084e1i)
+(num-test (acos 2.0e+00+0.0e+00i) 0+1.3169578969248167086e0i)
+(num-test (acos -2.0e+00+0.0e+00i) 3.1415926535897932385e0-1.3169578969248167086e0i)
+(num-test (acos 2.0e+00+1.19209289550781250e-07i) 6.8825515412047433504e-8-1.3169578969248194435e0i)
+(num-test (acos 2.0e+00-1.19209289550781250e-07i) 6.8825515412047433504e-8+1.3169578969248194435e0i)
+(num-test (acos -2.0e+00+1.19209289550781250e-07i) 3.1415925847642778264e0-1.3169578969248194435e0i)
+(num-test (acos -2.0e+00-1.19209289550781250e-07i) 3.1415925847642778264e0+1.3169578969248194435e0i)
+(num-test (acos 2.0e+00+5.0e-01i) 2.7775425655771396018e-1-1.3618009008578457882e0i)
+(num-test (acos 2.0e+00-5.0e-01i) 2.7775425655771396018e-1+1.3618009008578457882e0i)
+(num-test (acos -2.0e+00+5.0e-01i) 2.8638383970320792783e0-1.3618009008578457882e0i)
+(num-test (acos -2.0e+00-5.0e-01i) 2.8638383970320792783e0+1.3618009008578457882e0i)
+(num-test (acos 2.0e+00+1.0e+00i) 5.0735630321714456304e-1-1.4693517443681852733e0i)
+(num-test (acos 2.0e+00-1.0e+00i) 5.0735630321714456304e-1+1.4693517443681852733e0i)
+(num-test (acos -2.0e+00+1.0e+00i) 2.6342363503726486754e0-1.4693517443681852733e0i)
+(num-test (acos -2.0e+00-1.0e+00i) 2.6342363503726486754e0+1.4693517443681852733e0i)
+(num-test (acos 2.0e+00+2.0e+00i) 8.1654718209685057852e-1-1.7343245214879664480e0i)
+(num-test (acos 2.0e+00-2.0e+00i) 8.1654718209685057852e-1+1.7343245214879664480e0i)
+(num-test (acos -2.0e+00+2.0e+00i) 2.3250454714929426599e0-1.7343245214879664480e0i)
+(num-test (acos -2.0e+00-2.0e+00i) 2.3250454714929426599e0+1.7343245214879664480e0i)
+(num-test (acos 2.0e+00+8.3886080e+06i) 1.5707960883763175177e0-1.663553233343871940e1i)
+(num-test (acos 2.0e+00-8.3886080e+06i) 1.5707960883763175177e0+1.663553233343871940e1i)
+(num-test (acos -2.0e+00+8.3886080e+06i) 1.5707965652134757208e0-1.663553233343871940e1i)
+(num-test (acos -2.0e+00-8.3886080e+06i) 1.5707965652134757208e0+1.663553233343871940e1i)
+(num-test (acos 8.3886080e+06+0.0e+00i) 0+1.6635532333438683873e1i)
+(num-test (acos -8.3886080e+06+0.0e+00i) 3.1415926535897932385e0-1.6635532333438683873e1i)
+(num-test (acos 8.3886080e+06+1.19209289550781250e-07i) 1.4210854715202104692e-14-1.6635532333438683873e1i)
+(num-test (acos 8.3886080e+06-1.19209289550781250e-07i) 1.4210854715202104692e-14+1.6635532333438683873e1i)
+(num-test (acos -8.3886080e+06+1.19209289550781250e-07i) 3.1415926535897790276e0-1.6635532333438683873e1i)
+(num-test (acos -8.3886080e+06-1.19209289550781250e-07i) 3.1415926535897790276e0+1.6635532333438683873e1i)
+(num-test (acos 8.3886080e+06+5.0e-01i) 5.9604644775390977930e-8-1.6635532333438685650e1i)
+(num-test (acos 8.3886080e+06-5.0e-01i) 5.9604644775390977930e-8+1.6635532333438685650e1i)
+(num-test (acos -8.3886080e+06+5.0e-01i) 3.1415925939851484631e0-1.6635532333438685650e1i)
+(num-test (acos -8.3886080e+06-5.0e-01i) 3.1415925939851484631e0+1.6635532333438685650e1i)
+(num-test (acos 8.3886080e+06+1.0e+00i) 1.1920928955078153234e-7-1.6635532333438690979e1i)
+(num-test (acos 8.3886080e+06-1.0e+00i) 1.1920928955078153234e-7+1.6635532333438690979e1i)
+(num-test (acos -8.3886080e+06+1.0e+00i) 3.1415925343805036877e0-1.6635532333438690979e1i)
+(num-test (acos -8.3886080e+06-1.0e+00i) 3.1415925343805036877e0+1.6635532333438690979e1i)
+(num-test (acos 8.3886080e+06+2.0e+00i) 2.3841857910155967656e-7-1.6635532333438712295e1i)
+(num-test (acos 8.3886080e+06-2.0e+00i) 2.3841857910155967656e-7+1.6635532333438712295e1i)
+(num-test (acos -8.3886080e+06+2.0e+00i) 3.1415924151712141369e0-1.6635532333438712295e1i)
+(num-test (acos -8.3886080e+06-2.0e+00i) 3.1415924151712141369e0+1.6635532333438712295e1i)
+(num-test (acos 8.3886080e+06+8.3886080e+06i) 7.8539816339745008597e-1-1.6982105923718660081e1i)
+(num-test (acos 8.3886080e+06-8.3886080e+06i) 7.8539816339745008597e-1+1.6982105923718660081e1i)
+(num-test (acos -8.3886080e+06+8.3886080e+06i) 2.3561944901923431525e0-1.6982105923718660081e1i)
+(num-test (acos -8.3886080e+06-8.3886080e+06i) 2.3561944901923431525e0+1.6982105923718660081e1i)
+(num-test (acos -64983.97009220963-48983.30494825104i) 2.495679792792491+12.0i)
+(num-test (acos -2.225073858507201399999999999999999999996E-308) 1.570796326794896619231321691639751442098E0)
+(num-test (acos 1.110223024625156799999999999999999999997E-16) 1.570796326794896508209019229124071442098E0)
+(num-test (acos (/ (sqrt 2) 2)) (/ pi 4))
+(num-test (acos (/ (sqrt 3) -2)) (- pi (/ pi 6)))
+(num-test (acos 1.00001) 0.0+0.004472132228240686i)
+
+(for-each
+ (lambda (num-and-val)
+   (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'acos num (acos num) val)))
+ (vector (list 0 1.5707963267949) (list 1 0) (list 2 0+1.3169578969248i) (list 3 0+1.7627471740391i)
+	 (list -1 3.1415926535898) (list -2 3.1415926535898-1.3169578969248i) (list -3 3.1415926535898-1.7627471740391i)
+	 (list 9223372036854775807 0+44.361419555836i) (list -9223372036854775808 3.1415926535898-44.361419555836i)
+	 (list 1/2 1.0471975511966) (list 1/3 1.2309594173408) (list -1/2 2.0943951023932)
+	 (list -1/3 1.910633236249) (list 1/9223372036854775807 1.5707963267949) (list 0.0 1.5707963267949)
+	 (list 1.0 0.0) (list 2.0 0+1.3169578969248i) (list -2.0 3.1415926535898-1.3169578969248i)
+	 (list 1.000000000000000000000000000000000000002E-309 1.570796326794896619231321691639751442098E0)
+	 (list 1e+16 0+37.534508668465i) (list 0+1i 1.5707963267949-0.88137358701954i) (list 0+2i 1.5707963267949-1.4436354751788i)
+	 (list 0-1i 1.5707963267949+0.88137358701954i) (list 1+1i 0.90455689430238-1.061275061905i)
+	 (list 1-1i 0.90455689430238+1.061275061905i) (list -1+1i 2.2370357592874-1.061275061905i)
+	 (list -1-1i 2.2370357592874+1.061275061905i) (list 0.1+0.1i 1.4711326239351-0.10033029811221i)
+	 (list 1e+16+1e+16i 0.78539816339745-37.881082258745i) (list 1e-16+1e-16i 1.5707963267949-1.1102230246252e-16i)
+	 ))
+
+(let ((err 0.0)
+      (mx 0.0))
+  (do ((i 0 (+ i 1))
+       (x -10.0 (+ x .1)))
+      ((= i 200))
+    (let ((y (magnitude (- x (cos (acos x))))))
+      (if (> y err) (begin (set! mx x) (set! err y)))))
+  (if (> err 1e-12)
+      (format #t ";(cos (acos ~A)) error: ~A~%" mx err)))
+
+(let ((err 0.0)
+      (mx 0.0))
+  (do ((i 0 (+ i 1))
+       (x 1.0-i (+ x -0.1+0.1i)))
+      ((= i 200))
+    (let ((y (magnitude (- x (cos (acos x))))))
+      (if (> y err) (begin (set! mx x) (set! err y)))))
+  (if (> err 1e-10)
+      (format #t ";(cos (acos ~A)) error: ~A~%" mx err)))
+
+(test (acos) 'error)
+(test (acos "hi") 'error)
+(test (acos 1.0+23.0i 1.0+23.0i) 'error)
+(test (acos 0 1) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (acos arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(when with-bignums
+  (let-temporarily (((*s7* 'bignum-precision) 500))
+    (let ((acoss (list ; table[Arccos[k/30], {k, 0, 30}]
+		  1.57079632679489661923132169163975144209858469968755291048747229615390
+		  1.53745681753359453223988681086891283292292532113625627655066835871028
+		  1.50408017838467135968591658836938216800673525534100887774094632497961
+		  1.47062890563333682288579851218705812352990872745792336909644844111750
+		  1.43706473738495509057499836447665401198452971694311125503288353691013
+		  1.40334824757520728867804708559611322118362753737131459002168499242061
+		  1.36943840600456582777619613942212803185854661828532452423022105269829
+		  1.33529209007409682793843720770251587561752235709223993234205546563727
+		  1.30086353096149317480670670185123279844211132541734789265785186982011
+		  1.26610367277949911125931873041222227514402466798077652309449434740743
+		  1.23095941734077468213492917824798737571034000935509483905554833366399
+		  1.19537271881385721554615623455760435715187934648129893552739216960977
+		  1.15927948072740859984658379402241583724288356456052705870352551545381
+		  1.12260819081546532929088412859068667091828551922412210328535011759677
+		  1.08527820449930545595908733261492699446689960474554094922793682396904
+		  1.04719755119659774615421446109316762806572313312503527365831486410260
+		  1.00826008225104099949999603469121825039880976563585012769196847054621
+		  0.96834169340990606798268790382508246937722069157058123211232815740883
+		  0.92729521800161223242851246292242880405707410857224052762186617744039
+		  0.88494336217618586326804097370954035732954766028628186644588911389624
+		  0.84106867056793025577652503182643074670207878563983921977852280469208
+		  0.79539883018414355549096833892476432854279596104639091688975233242118
+		  0.74758434966902079779334463157739345981404639083611183363842437021388
+		  0.69716313364223229572063988249255120236401774508773180005252393361250
+		  0.64350110879328438680280922871732263804151059111531238286560611871351
+		  0.58568554345715095961775753847751776620036106717164150265055932722126
+		  0.52231482180604862252409882585570327600888093754313181958478744889757
+		  0.45102681179626243254464463579435182620342251328425002811179043223947
+		  0.36720802055783714250547291370122530624718492018835635003632767844945
+		  0.25892154200622121576539021530016406277243818456467068559928913571945
+		  0.00000000000000000000000000000000000000000000000000000000000000000000e0)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 30))
+	(let ((val (acos (bignum (/ i 30)))))
+	  (if (> (magnitude (- val (list-ref acoss i))) 1e-36)
+	      (format #t ";(acos ~A) -> ~A ~A~%[~A]~%" (/ i 30) val (list-ref acoss i) (magnitude (- val (list-ref acoss i))))))))))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; atan
+;;; --------------------------------------------------------------------------------
+
+(num-test (atan 0) 0.0)
+(num-test (atan 1) 0.78539816339745)
+(num-test (atan -1) -0.78539816339745)
+(num-test (atan 2) 1.10714871779409)
+(num-test (atan -2) -1.10714871779409)
+(num-test (atan 3) 1.24904577239825)
+(num-test (atan -3) -1.24904577239825)
+(num-test (atan 10) 1.47112767430373)
+(num-test (atan -10) -1.47112767430373)
+(num-test (atan 1234) 1.56998595420081)
+(num-test (atan -1234) -1.56998595420081)
+(num-test (atan 0/1) 0.0)
+(num-test (atan 0/2) 0.0)
+(num-test (atan 0/3) 0.0)
+(num-test (atan 0/10) 0.0)
+(num-test (atan 0/1234) 0.0)
+(num-test (atan 0/500029) 0.0)
+(num-test (atan 1/1) 0.78539816339745)
+(num-test (atan -1/1) -0.78539816339745)
+(num-test (atan 1/2) 0.46364760900081)
+(num-test (atan -1/2) -0.46364760900081)
+(num-test (atan 1/3) 0.32175055439664)
+(num-test (atan -1/3) -0.32175055439664)
+(num-test (atan 1/10) 0.09966865249116)
+(num-test (atan -1/10) -0.09966865249116)
+(num-test (atan 1/1234) 0.00081037259408)
+(num-test (atan -1/1234) -0.00081037259408)
+(num-test (atan 1/500029) 0.00000199988401)
+(num-test (atan -1/500029) -0.00000199988401)
+(num-test (atan 2/1) 1.10714871779409)
+(num-test (atan -2/1) -1.10714871779409)
+(num-test (atan 2/2) 0.78539816339745)
+(num-test (atan -2/2) -0.78539816339745)
+(num-test (atan 2/3) 0.58800260354757)
+(num-test (atan -2/3) -0.58800260354757)
+(num-test (atan 2/10) 0.19739555984988)
+(num-test (atan -2/10) -0.19739555984988)
+(num-test (atan 2/1234) 0.00162074412382)
+(num-test (atan -2/1234) -0.00162074412382)
+(num-test (atan 2/500029) 0.00000399976801)
+(num-test (atan -2/500029) -0.00000399976801)
+(num-test (atan 3/1) 1.24904577239825)
+(num-test (atan -3/1) -1.24904577239825)
+(num-test (atan 3/2) 0.98279372324733)
+(num-test (atan -3/2) -0.98279372324733)
+(num-test (atan 3/3) 0.78539816339745)
+(num-test (atan -3/3) -0.78539816339745)
+(num-test (atan 3/10) 0.29145679447787)
+(num-test (atan -3/10) -0.29145679447787)
+(num-test (atan 3/1234) 0.00243111352487)
+(num-test (atan -3/1234) -0.00243111352487)
+(num-test (atan 3/500029) 0.00000599965202)
+(num-test (atan -3/500029) -0.00000599965202)
+(num-test (atan 10/1) 1.47112767430373)
+(num-test (atan -10/1) -1.47112767430373)
+(num-test (atan 10/2) 1.37340076694502)
+(num-test (atan -10/2) -1.37340076694502)
+(num-test (atan 10/3) 1.27933953231703)
+(num-test (atan -10/3) -1.27933953231703)
+(num-test (atan 10/10) 0.78539816339745)
+(num-test (atan -10/10) -0.78539816339745)
+(num-test (atan 10/1234) 0.00810355033005)
+(num-test (atan -10/1234) -0.00810355033005)
+(num-test (atan 10/500029) 0.00001999884006)
+(num-test (atan -10/500029) -0.00001999884006)
+(num-test (atan 1234/1) 1.56998595420081)
+(num-test (atan -1234/1) -1.56998595420081)
+(num-test (atan 1234/2) 1.56917558267108)
+(num-test (atan -1234/2) -1.56917558267108)
+(num-test (atan 1234/3) 1.56836521327003)
+(num-test (atan -1234/3) -1.56836521327003)
+(num-test (atan 1234/10) 1.56269277646485)
+(num-test (atan -1234/10) -1.56269277646485)
+(num-test (atan 1234/500029) 0.00246785185431)
+(num-test (atan -1234/500029) -0.00246785185431)
+(num-test (atan 500029/2) 1.57079232702688)
+(num-test (atan -500029/2) -1.57079232702688)
+(num-test (atan 500029/3) 1.57079032714288)
+(num-test (atan -500029/3) -1.57079032714288)
+(num-test (atan 500029/10) 1.57077632795483)
+(num-test (atan -500029/10) -1.57077632795483)
+(num-test (atan 500029/1234) 1.56832847494059)
+(num-test (atan -500029/1234) -1.56832847494059)
+(num-test (atan 500029/500029) 0.78539816339745)
+(num-test (atan -500029/500029) -0.78539816339745)
+(num-test (atan 0.0) 0.0)
+(num-test (atan 0.00000001) 0.00000001)
+(num-test (atan -0.00000001) -0.00000001)
+(num-test (atan 1.0) 0.78539816339745)
+(num-test (atan -1.0) -0.78539816339745)
+(num-test (atan pi) 1.26262725567891)
+(num-test (atan -3.14159265358979) -1.26262725567891)
+(num-test (atan 1234.0) 1.56998595420081)
+(num-test (atan -1234.0) -1.56998595420081)
+(num-test (atan 0.0+0.0i) 0.0)
+(num-test (atan -0.0+0.0i) 0.0)
+(num-test (atan 0.0-0.0i) 0.0)
+(num-test (atan -0.0-0.0i) 0.0)
+(num-test (atan 0.0+0.00000001i) 0.0+0.00000001i)
+(num-test (atan -0.0+0.00000001i) 0.0+0.00000001i)
+(num-test (atan 0.0-0.00000001i) 0.0-0.00000001i)
+(num-test (atan -0.0-0.00000001i) -0.0-0.00000001i)
+(num-test (atan 0.0+3.14159265358979i) 1.57079632679490+0.32976531495670i)
+(num-test (atan -0.0+3.14159265358979i) 1.57079632679490+0.32976531495670i)
+(num-test (atan 0.0-3.14159265358979i) 1.57079632679490-0.32976531495670i)
+(num-test (atan -0.0-3.14159265358979i) -1.57079632679490-0.32976531495670i)
+(num-test (atan 0.0+1234.0i) 1.57079632679490+0.00081037294887i)
+(num-test (atan -0.0+1234.0i) 1.57079632679490+0.00081037294887i)
+(num-test (atan 0.0-1234.0i) 1.57079632679490-0.00081037294887i)
+(num-test (atan -0.0-1234.0i) -1.57079632679490-0.00081037294887i)
+(num-test (atan 0.00000001+0.0i) 0.00000001)
+(num-test (atan -0.00000001+0.0i) -0.00000001)
+(num-test (atan 0.00000001-0.0i) 0.00000001)
+(num-test (atan -0.00000001-0.0i) -0.00000001)
+(num-test (atan 0.00000001+0.00000001i) 0.00000001+0.00000001i)
+(num-test (atan -0.00000001+0.00000001i) -0.00000001+0.00000001i)
+(num-test (atan 0.00000001-0.00000001i) 0.00000001-0.00000001i)
+(num-test (atan -0.00000001-0.00000001i) -0.00000001-0.00000001i)
+(num-test (atan 0.00000001+1.0i) 0.78539816589789+9.55691396225616i)
+(num-test (atan -0.00000001+1.0i) -0.78539816589789+9.55691396225616i)
+(num-test (atan 0.00000001-1.0i) 0.78539816589789-9.55691396225616i)
+(num-test (atan -0.00000001-1.0i) -0.78539816589789-9.55691396225616i)
+(num-test (atan 0.00000001+3.14159265358979i) 1.57079632566745+0.32976531495670i)
+(num-test (atan -0.00000001+3.14159265358979i) -1.57079632566745+0.32976531495670i)
+(num-test (atan 0.00000001-3.14159265358979i) 1.57079632566745-0.32976531495670i)
+(num-test (atan -0.00000001-3.14159265358979i) -1.57079632566745-0.32976531495670i)
+(num-test (atan 0.00000001+1234.0i) 1.57079632679489+0.00081037294887i)
+(num-test (atan -0.00000001+1234.0i) -1.57079632679489+0.00081037294887i)
+(num-test (atan 0.00000001-1234.0i) 1.57079632679489-0.00081037294887i)
+(num-test (atan -0.00000001-1234.0i) -1.57079632679489-0.00081037294887i)
+(num-test (atan 1.0+0.0i) 0.78539816339745)
+(num-test (atan -1.0+0.0i) -0.78539816339745)
+(num-test (atan 1.0-0.0i) 0.78539816339745)
+(num-test (atan -1.0-0.0i) -0.78539816339745)
+(num-test (atan 1.0+0.00000001i) 0.78539816339745+0.00000000500000i)
+(num-test (atan -1.0+0.00000001i) -0.78539816339745+0.00000000500000i)
+(num-test (atan 1.0-0.00000001i) 0.78539816339745-0.00000000500000i)
+(num-test (atan -1.0-0.00000001i) -0.78539816339745-0.00000000500000i)
+(num-test (atan 1.0+1.0i) 1.01722196789785+0.40235947810853i)
+(num-test (atan -1.0+1.0i) -1.01722196789785+0.40235947810853i)
+(num-test (atan 1.0-1.0i) 1.01722196789785-0.40235947810853i)
+(num-test (atan -1.0-1.0i) -1.01722196789785-0.40235947810853i)
+(num-test (atan 1.0+3.14159265358979i) 1.47082882591946+0.29462144034086i)
+(num-test (atan -1.0+3.14159265358979i) -1.47082882591946+0.29462144034086i)
+(num-test (atan 1.0-3.14159265358979i) 1.47082882591946-0.29462144034086i)
+(num-test (atan -1.0-3.14159265358979i) -1.47082882591946-0.29462144034086i)
+(num-test (atan 1.0+1234.0i) 1.57079567009087+0.00081037241669i)
+(num-test (atan -1.0+1234.0i) -1.57079567009087+0.00081037241669i)
+(num-test (atan 1.0-1234.0i) 1.57079567009087-0.00081037241669i)
+(num-test (atan -1.0-1234.0i) -1.57079567009087-0.00081037241669i)
+(num-test (atan 3.14159265358979+0.0i) 1.26262725567891)
+(num-test (atan -3.14159265358979+0.0i) -1.26262725567891)
+(num-test (atan 3.14159265358979-0.0i) 1.26262725567891)
+(num-test (atan -3.14159265358979-0.0i) -1.26262725567891)
+(num-test (atan 3.14159265358979+0.00000001i) 1.26262725567891+0.00000000092000i)
+(num-test (atan -3.14159265358979+0.00000001i) -1.26262725567891+0.00000000092000i)
+(num-test (atan 3.14159265358979-0.00000001i) 1.26262725567891-0.00000000092000i)
+(num-test (atan -3.14159265358979-0.00000001i) -1.26262725567891-0.00000000092000i)
+(num-test (atan 3.14159265358979+1.0i) 1.28734057432439+0.08505998507745i)
+(num-test (atan -3.14159265358979+1.0i) -1.28734057432439+0.08505998507745i)
+(num-test (atan 3.14159265358979-1.0i) 1.28734057432439-0.08505998507745i)
+(num-test (atan -3.14159265358979-1.0i) -1.28734057432439-0.08505998507745i)
+(num-test (atan 3.14159265358979+3.14159265358979i) 1.40903828502376+0.15638868878130i)
+(num-test (atan -3.14159265358979+3.14159265358979i) -1.40903828502376+0.15638868878130i)
+(num-test (atan 3.14159265358979-3.14159265358979i) 1.40903828502376-0.15638868878130i)
+(num-test (atan -3.14159265358979-3.14159265358979i) -1.40903828502376-0.15638868878130i)
+(num-test (atan 3.14159265358979+1234.0i) 1.57079426371036+0.00081036769654i)
+(num-test (atan -3.14159265358979+1234.0i) -1.57079426371036+0.00081036769654i)
+(num-test (atan 3.14159265358979-1234.0i) 1.57079426371036-0.00081036769654i)
+(num-test (atan -3.14159265358979-1234.0i) -1.57079426371036-0.00081036769654i)
+(num-test (atan 1234.0+0.0i) 1.56998595420081)
+(num-test (atan -1234.0+0.0i) -1.56998595420081)
+(num-test (atan 1234.0-0.0i) 1.56998595420081)
+(num-test (atan -1234.0-0.0i) -1.56998595420081)
+(num-test (atan 1234.0+0.00000001i) 1.56998595420081+0.00000000000001i)
+(num-test (atan -1234.0+0.00000001i) -1.56998595420081+0.00000000000001i)
+(num-test (atan 1234.0-0.00000001i) 1.56998595420081-0.00000000000001i)
+(num-test (atan -1234.0-0.00000001i) -1.56998595420081-0.00000000000001i)
+(num-test (atan 1234.0+1.0i) 1.56998595473299+0.00000065670317i)
+(num-test (atan -1234.0+1.0i) -1.56998595473299+0.00000065670317i)
+(num-test (atan 1234.0-1.0i) 1.56998595473299-0.00000065670317i)
+(num-test (atan -1234.0-1.0i) -1.56998595473299-0.00000065670317i)
+(num-test (atan 1234.0+3.14159265358979i) 1.56998595945313+0.00000206308183i)
+(num-test (atan -1234.0+3.14159265358979i) -1.56998595945313+0.00000206308183i)
+(num-test (atan 1234.0-3.14159265358979i) 1.56998595945313-0.00000206308183i)
+(num-test (atan -1234.0-3.14159265358979i) -1.56998595945313-0.00000206308183i)
+(num-test (atan 1234.0+1234.0i) 1.57039114036481+0.00040518634139i)
+(num-test (atan -1234.0+1234.0i) -1.57039114036481+0.00040518634139i)
+(num-test (atan 1234.0-1234.0i) 1.57039114036481-0.00040518634139i)
+(num-test (atan -1234.0-1234.0i) -1.57039114036481-0.00040518634139i)
+(num-test (atan 6.9279836e-17) 6.9279836e-17)
+(num-test (atan 1.7976931e+308) 1.5707963267949)
+(num-test (atan 0 0) 0.0)
+(num-test (atan 0 1.0) 0.0)
+(num-test (atan 0 -1.0) pi)
+(num-test (atan 1.0 0) (/ pi 2))
+(num-test (atan -1.0 0) (/ pi -2))
+(num-test (atan 0.0 0.0) 0.0)
+(num-test (atan 0.0 0.00000001) 0.0)
+(num-test (atan 0.0 1.0) 0.0)
+(num-test (atan 0.0 pi) 0.0)
+(num-test (atan 0.0 1234.0) 0.0)
+(num-test (atan 0.00000001 0.0) 1.57079632679490)
+(num-test (atan 0.00000001 0.00000001) 0.78539816339745)
+(num-test (atan 0.00000001 1.0) 0.00000001)
+(num-test (atan 0.00000001 pi) 0.00000000318310)
+(num-test (atan 0.00000001 1234.0) 0.00000000000810)
+(num-test (atan 1.0 0.0) 1.57079632679490)
+(num-test (atan 1.0 0.00000001) 1.57079631679490)
+(num-test (atan 1.0 1.0) 0.78539816339745)
+(num-test (atan 1.0 pi) 0.30816907111598)
+(num-test (atan 1.0 1234.0) 0.00081037259408)
+(num-test (atan 3.14159265358979 0.0) 1.57079632679490)
+(num-test (atan 3.14159265358979 0.00000001) 1.57079632361180)
+(num-test (atan 3.14159265358979 1.0) 1.26262725567891)
+(num-test (atan 3.14159265358979 pi) 0.78539816339745)
+(num-test (atan 3.14159265358979 1234.0) 0.00254585564530)
+(num-test (atan 1234.0 0.0) 1.57079632679490)
+(num-test (atan 1234.0 0.00000001) 1.57079632678679)
+(num-test (atan 1234.0 1.0) 1.56998595420081)
+(num-test (atan 1234.0 pi) 1.56825047114960)
+(num-test (atan 1234.0 1234.0) 0.78539816339745)
+(num-test (atan 1) 0.7853981633974483)
+(num-test (atan 0.0e+00+0.0e+00i) 0e0)
+(num-test (atan 0.0e+00+1.19209289550781250e-07i) 0+1.1920928955078181469e-7i)
+(num-test (atan 0.0e+00-1.19209289550781250e-07i) 0-1.1920928955078181469e-7i)
+(num-test (atan 0.0e+00+5.0e-01i) 0+5.4930614433405484570e-1i)
+(num-test (atan 0.0e+00-5.0e-01i) 0-5.4930614433405484570e-1i)
+(num-test (atan 0.0e+00+2.0e+00i) 1.5707963267948966192e0+5.4930614433405484570e-1i)
+(num-test (atan 0.0e+00-2.0e+00i) -1.5707963267948966192e0-5.4930614433405484570e-1i)
+(num-test (atan 0.0e+00+8.3886080e+06i) 1.5707963267948966192e0+1.1920928955078181469e-7i)
+(num-test (atan 0.0e+00-8.3886080e+06i) -1.5707963267948966192e0-1.1920928955078181469e-7i)
+(num-test (atan 1.19209289550781250e-07+0.0e+00i) 1.1920928955078068531e-7)
+(num-test (atan -1.19209289550781250e-07+0.0e+00i) -1.1920928955078068531e-7)
+(num-test (atan 1.19209289550781250e-07+1.19209289550781250e-07i) 1.1920928955078237938e-7+1.1920928955078012062e-7i)
+(num-test (atan 1.19209289550781250e-07-1.19209289550781250e-07i) 1.1920928955078237938e-7-1.1920928955078012062e-7i)
+(num-test (atan -1.19209289550781250e-07+1.19209289550781250e-07i) -1.1920928955078237938e-7+1.1920928955078012062e-7i)
+(num-test (atan -1.19209289550781250e-07-1.19209289550781250e-07i) -1.1920928955078237938e-7-1.1920928955078012062e-7i)
+(num-test (atan 1.19209289550781250e-07+5.0e-01i) 1.5894571940103932425e-7+5.4930614433404221383e-1i)
+(num-test (atan 1.19209289550781250e-07-5.0e-01i) 1.5894571940103932425e-7-5.4930614433404221383e-1i)
+(num-test (atan -1.19209289550781250e-07+5.0e-01i) -1.5894571940103932425e-7+5.4930614433404221383e-1i)
+(num-test (atan -1.19209289550781250e-07-5.0e-01i) -1.5894571940103932425e-7-5.4930614433404221383e-1i)
+(num-test (atan 1.19209289550781250e-07+1.0e+00i) 7.8539819319977069731e-1+8.3177661667193446012e0i)
+(num-test (atan 1.19209289550781250e-07-1.0e+00i) 7.8539819319977069731e-1-8.3177661667193446012e0i)
+(num-test (atan -1.19209289550781250e-07+1.0e+00i) -7.8539819319977069731e-1+8.3177661667193446012e0i)
+(num-test (atan -1.19209289550781250e-07-1.0e+00i) -7.8539819319977069731e-1-8.3177661667193446012e0i)
+(num-test (atan 1.19209289550781250e-07+2.0e+00i) 1.5707962870584667690e0+5.4930614433405168773e-1i)
+(num-test (atan 1.19209289550781250e-07-2.0e+00i) 1.5707962870584667690e0-5.4930614433405168773e-1i)
+(num-test (atan -1.19209289550781250e-07+2.0e+00i) -1.5707962870584667690e0+5.4930614433405168773e-1i)
+(num-test (atan -1.19209289550781250e-07-2.0e+00i) -1.5707962870584667690e0-5.4930614433405168773e-1i)
+(num-test (atan 1.19209289550781250e-07+8.3886080e+06i) 1.5707963267948966192e0+1.1920928955078181469e-7i)
+(num-test (atan 1.19209289550781250e-07-8.3886080e+06i) 1.5707963267948966192e0-1.1920928955078181469e-7i)
+(num-test (atan -1.19209289550781250e-07+8.3886080e+06i) -1.5707963267948966192e0+1.1920928955078181469e-7i)
+(num-test (atan -1.19209289550781250e-07-8.3886080e+06i) -1.5707963267948966192e0-1.1920928955078181469e-7i)
+(num-test (atan 5.0e-01+0.0e+00i) 4.6364760900080611621e-1)
+(num-test (atan -5.0e-01+0.0e+00i) -4.6364760900080611621e-1)
+(num-test (atan 5.0e-01+1.19209289550781250e-07i) 4.6364760900081066369e-1+9.5367431640625072280e-8i)
+(num-test (atan 5.0e-01-1.19209289550781250e-07i) 4.6364760900081066369e-1-9.5367431640625072280e-8i)
+(num-test (atan -5.0e-01+1.19209289550781250e-07i) -4.6364760900081066369e-1+9.5367431640625072280e-8i)
+(num-test (atan -5.0e-01-1.19209289550781250e-07i) -4.6364760900081066369e-1-9.5367431640625072280e-8i)
+(num-test (atan 5.0e-01+5.0e-01i) 5.5357435889704525151e-1+4.0235947810852509365e-1i)
+(num-test (atan 5.0e-01-5.0e-01i) 5.5357435889704525151e-1-4.0235947810852509365e-1i)
+(num-test (atan -5.0e-01+5.0e-01i) -5.5357435889704525151e-1+4.0235947810852509365e-1i)
+(num-test (atan -5.0e-01-5.0e-01i) -5.5357435889704525151e-1-4.0235947810852509365e-1i)
+(num-test (atan 5.0e-01+1.0e+00i) 9.0788749496088038670e-1+7.0830333601405402006e-1i)
+(num-test (atan 5.0e-01-1.0e+00i) 9.0788749496088038670e-1-7.0830333601405402006e-1i)
+(num-test (atan -5.0e-01+1.0e+00i) -9.0788749496088038670e-1+7.0830333601405402006e-1i)
+(num-test (atan -5.0e-01-1.0e+00i) -9.0788749496088038670e-1-7.0830333601405402006e-1i)
+(num-test (atan 5.0e-01+2.0e+00i) 1.4215468610018069803e0+5.0037000005253101744e-1i)
+(num-test (atan 5.0e-01-2.0e+00i) 1.4215468610018069803e0-5.0037000005253101744e-1i)
+(num-test (atan -5.0e-01+2.0e+00i) -1.4215468610018069803e0+5.0037000005253101744e-1i)
+(num-test (atan -5.0e-01-2.0e+00i) -1.4215468610018069803e0-5.0037000005253101744e-1i)
+(num-test (atan 5.0e-01+8.3886080e+06i) 1.5707963267948895138e0+1.1920928955078139117e-7i)
+(num-test (atan 5.0e-01-8.3886080e+06i) 1.5707963267948895138e0-1.1920928955078139117e-7i)
+(num-test (atan -5.0e-01+8.3886080e+06i) -1.5707963267948895138e0+1.1920928955078139117e-7i)
+(num-test (atan -5.0e-01-8.3886080e+06i) -1.5707963267948895138e0-1.1920928955078139117e-7i)
+(num-test (atan 1.0e+00+0.0e+00i) 7.8539816339744830962e-1)
+(num-test (atan -1.0e+00+0.0e+00i) -7.8539816339744830962e-1)
+(num-test (atan 1.0e+00+1.19209289550781250e-07i) 7.8539816339745186233e-1+5.9604644775390483828e-8i)
+(num-test (atan 1.0e+00-1.19209289550781250e-07i) 7.8539816339745186233e-1-5.9604644775390483828e-8i)
+(num-test (atan -1.0e+00+1.19209289550781250e-07i) -7.8539816339745186233e-1+5.9604644775390483828e-8i)
+(num-test (atan -1.0e+00-1.19209289550781250e-07i) -7.8539816339745186233e-1-5.9604644775390483828e-8i)
+(num-test (atan 1.0e+00+5.0e-01i) 8.4757566067082902713e-1+2.3887786125685909036e-1i)
+(num-test (atan 1.0e+00-5.0e-01i) 8.4757566067082902713e-1-2.3887786125685909036e-1i)
+(num-test (atan -1.0e+00+5.0e-01i) -8.4757566067082902713e-1+2.3887786125685909036e-1i)
+(num-test (atan -1.0e+00-5.0e-01i) -8.4757566067082902713e-1-2.3887786125685909036e-1i)
+(num-test (atan 1.0e+00+1.0e+00i) 1.0172219678978513677e0+4.0235947810852509365e-1i)
+(num-test (atan 1.0e+00-1.0e+00i) 1.0172219678978513677e0-4.0235947810852509365e-1i)
+(num-test (atan -1.0e+00+1.0e+00i) -1.0172219678978513677e0+4.0235947810852509365e-1i)
+(num-test (atan -1.0e+00-1.0e+00i) -1.0172219678978513677e0-4.0235947810852509365e-1i)
+(num-test (atan 1.0e+00+2.0e+00i) 1.3389725222944935611e0+4.0235947810852509365e-1i)
+(num-test (atan 1.0e+00-2.0e+00i) 1.3389725222944935611e0-4.0235947810852509365e-1i)
+(num-test (atan -1.0e+00+2.0e+00i) -1.3389725222944935611e0+4.0235947810852509365e-1i)
+(num-test (atan -1.0e+00-2.0e+00i) -1.3389725222944935611e0-4.0235947810852509365e-1i)
+(num-test (atan 1.0e+00+8.3886080e+06i) 1.5707963267948824084e0+1.1920928955078012062e-7i)
+(num-test (atan 1.0e+00-8.3886080e+06i) 1.5707963267948824084e0-1.1920928955078012062e-7i)
+(num-test (atan -1.0e+00+8.3886080e+06i) -1.5707963267948824084e0+1.1920928955078012062e-7i)
+(num-test (atan -1.0e+00-8.3886080e+06i) -1.5707963267948824084e0-1.1920928955078012062e-7i)
+(num-test (atan 2.0e+00+0.0e+00i) 1.1071487177940905030e0)
+(num-test (atan -2.0e+00+0.0e+00i) -1.1071487177940905030e0)
+(num-test (atan 2.0e+00+1.19209289550781250e-07i) 1.1071487177940916399e0+2.3841857910156200307e-8i)
+(num-test (atan 2.0e+00-1.19209289550781250e-07i) 1.1071487177940916399e0-2.3841857910156200307e-8i)
+(num-test (atan -2.0e+00+1.19209289550781250e-07i) -1.1071487177940916399e0+2.3841857910156200307e-8i)
+(num-test (atan -2.0e+00-1.19209289550781250e-07i) -1.1071487177940916399e0-2.3841857910156200307e-8i)
+(num-test (atan 2.0e+00+5.0e-01i) 1.1265564408348223487e0+9.6415620202996167238e-2i)
+(num-test (atan 2.0e+00-5.0e-01i) 1.1265564408348223487e0-9.6415620202996167238e-2i)
+(num-test (atan -2.0e+00+5.0e-01i) -1.1265564408348223487e0+9.6415620202996167238e-2i)
+(num-test (atan -2.0e+00-5.0e-01i) -1.1265564408348223487e0-9.6415620202996167238e-2i)
+(num-test (atan 2.0e+00+1.0e+00i) 1.1780972450961724644e0+1.7328679513998632735e-1i)
+(num-test (atan 2.0e+00-1.0e+00i) 1.1780972450961724644e0-1.7328679513998632735e-1i)
+(num-test (atan -2.0e+00+1.0e+00i) -1.1780972450961724644e0+1.7328679513998632735e-1i)
+(num-test (atan -2.0e+00-1.0e+00i) -1.1780972450961724644e0-1.7328679513998632735e-1i)
+(num-test (atan 2.0e+00+2.0e+00i) 1.3112232696716351433e0+2.3887786125685909036e-1i)
+(num-test (atan 2.0e+00-2.0e+00i) 1.3112232696716351433e0-2.3887786125685909036e-1i)
+(num-test (atan -2.0e+00+2.0e+00i) -1.3112232696716351433e0+2.3887786125685909036e-1i)
+(num-test (atan -2.0e+00-2.0e+00i) -1.3112232696716351433e0-2.3887786125685909036e-1i)
+(num-test (atan 2.0e+00+8.3886080e+06i) 1.5707963267948681975e0+1.1920928955077503843e-7i)
+(num-test (atan 2.0e+00-8.3886080e+06i) 1.5707963267948681975e0-1.1920928955077503843e-7i)
+(num-test (atan -2.0e+00+8.3886080e+06i) -1.5707963267948681975e0+1.1920928955077503843e-7i)
+(num-test (atan -2.0e+00-8.3886080e+06i) -1.5707963267948681975e0-1.1920928955077503843e-7i)
+(num-test (atan 8.3886080e+06+0.0e+00i) 1.5707962075856070685e0)
+(num-test (atan -8.3886080e+06+0.0e+00i) -1.5707962075856070685e0)
+(num-test (atan 8.3886080e+06+1.19209289550781250e-07i) 1.5707962075856070685e0+1.6940658945085766040e-21i)
+(num-test (atan 8.3886080e+06-1.19209289550781250e-07i) 1.5707962075856070685e0-1.6940658945085766040e-21i)
+(num-test (atan -8.3886080e+06+1.19209289550781250e-07i) -1.5707962075856070685e0+1.6940658945085766040e-21i)
+(num-test (atan -8.3886080e+06-1.19209289550781250e-07i) -1.5707962075856070685e0-1.6940658945085766040e-21i)
+(num-test (atan 8.3886080e+06+5.0e-01i) 1.5707962075856070685e0+7.1054273576008756410e-15i)
+(num-test (atan 8.3886080e+06-5.0e-01i) 1.5707962075856070685e0-7.1054273576008756410e-15i)
+(num-test (atan -8.3886080e+06+5.0e-01i) -1.5707962075856070685e0+7.1054273576008756410e-15i)
+(num-test (atan -8.3886080e+06-5.0e-01i) -1.5707962075856070685e0-7.1054273576008756410e-15i)
+(num-test (atan 8.3886080e+06+1.0e+00i) 1.5707962075856070685e0+1.4210854715201599821e-14i)
+(num-test (atan 8.3886080e+06-1.0e+00i) 1.5707962075856070685e0-1.4210854715201599821e-14i)
+(num-test (atan -8.3886080e+06+1.0e+00i) -1.5707962075856070685e0+1.4210854715201599821e-14i)
+(num-test (atan -8.3886080e+06-1.0e+00i) -1.5707962075856070685e0-1.4210854715201599821e-14i)
+(num-test (atan 8.3886080e+06+2.0e+00i) 1.5707962075856070685e0+2.8421709430401987951e-14i)
+(num-test (atan 8.3886080e+06-2.0e+00i) 1.5707962075856070685e0-2.8421709430401987951e-14i)
+(num-test (atan -8.3886080e+06+2.0e+00i) -1.5707962075856070685e0+2.8421709430401987951e-14i)
+(num-test (atan -8.3886080e+06-2.0e+00i) -1.5707962075856070685e0-2.8421709430401987951e-14i)
+(num-test (atan 8.3886080e+06+8.3886080e+06i) 1.5707962671902518438e0+5.9604644775390483828e-8i)
+(num-test (atan 8.3886080e+06-8.3886080e+06i) 1.5707962671902518438e0-5.9604644775390483828e-8i)
+(num-test (atan -8.3886080e+06+8.3886080e+06i) -1.5707962671902518438e0+5.9604644775390483828e-8i)
+(num-test (atan -8.3886080e+06-8.3886080e+06i) -1.5707962671902518438e0-5.9604644775390483828e-8i)
+(num-test (atan -2.225073858507201399999999999999999999996E-308) -2.225073858507201399999999999999999999996E-308)
+(num-test (atan 1.110223024625156799999999999999999999997E-16) 1.110223024625156799999999999999995438476E-16)
+(num-test (/ pi 2) (+ (* 2 (atan (/ (sqrt 2)))) (atan (/ (sqrt 8)))))
+(num-test (/ pi 4) (+ (* 12 (atan (/ 18))) (* 8 (atan (/ 57))) (* -5 (atan (/ 239)))))
+(num-test (/ pi 4) (+ (* 2 (atan 1/3)) (atan 1/7)))
+(num-test (/ pi 4) (+ (* 5 (atan 1/7)) (* 2 (atan 3/79))))
+(num-test (/ pi 4) (+ (atan 1/2) (atan 1/3)))
+(num-test (/ pi 4) (- (* 2 (atan 1/2)) (atan 1/7)))
+(num-test (/ pi 4) (- (* 4 (atan (/ 1 5))) (atan (/ 1 239))))
+(num-test (* 4 (+ (* 3 (atan 1/4)) (atan 1/20) (atan 1/1985))) pi)
+(num-test (+ (* 176 (atan (/ 57))) (* 28 (atan (/ 239))) (* -48 (atan (/ 682))) (* 96 (atan (/ 12943)))) pi)
+(num-test (+ (* 2 (atan (/ (sqrt 2)))) (atan (/ (sqrt 8)))) (/ pi 2))
+(num-test (+ (* 48 (atan (/ 49))) (* 128 (atan (/ 57))) (* -20 (atan (/ 239))) (* 48 (atan (/ 110443)))) pi)
+(num-test (/ (+ (atan (/ 239)) (atan (/ 70)) (- (atan (/ 99)))) 2) (+ (atan (/ 408)) (atan (/ 577))))
+(num-test (atan (/ -1 (sqrt 3))) (/ pi -6))
+(num-test (atan (sqrt 3)) (/ pi 3))
+(num-test (atan 1/2 1/2) 0.78539816339745)
+
+(for-each
+ (lambda (num-and-val)
+   (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'atan num (atan num) val)))
+ (vector (list 0 0) (list 1 0.78539816339745) (list 2 1.1071487177941) (list 3 1.2490457723983)
+	 (list -1 -0.78539816339745) (list -2 -1.1071487177941) (list -3 -1.2490457723983)
+	 (list 9223372036854775807 1.5707963267949) (list -9223372036854775808 -1.5707963267949)
+	 (list 1/2 0.46364760900081) (list 1/3 0.32175055439664) (list -1/2 -0.46364760900081)
+	 (list -1/3 -0.32175055439664) (list 1/9223372036854775807 1.0842021724855e-19) (list 0.0 0.0)
+	 (list 1.0 0.78539816339745) (list 2.0 1.1071487177941) (list -2.0 -1.1071487177941)
+	 (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309)
+	 (list 1e+16 1.5707963267949) (list +inf.0 1.5707963267949) (list -inf.0 -1.5707963267949)
+	 (list 0+2i 1.5707963267949+0.54930614433405i) (list 1+1i 1.0172219678979+0.40235947810853i)
+	 (list 1-1i 1.0172219678979-0.40235947810853i) (list -1+1i -1.0172219678979+0.40235947810853i)
+	 (list -1-1i -1.0172219678979-0.40235947810853i) (list 0.1+0.1i 0.10065855418732+0.099325449367251i)
+	 (list 1e+16+1e+16i 1.5707963267949+5.5511151231258e-17i) (list 1e-16+1e-16i 1e-16+1.1102230246252e-16i)
+	 ))
+
+;; the x=0 cases are errors in clisp
+(num-test (atan 0 0) 0.0)
+(num-test (atan 0 0.0) 0.0)
+(num-test (atan 0 1) 0.0)
+(num-test (atan 0 -1) pi)
+(num-test (atan 0 2) 0.0)
+(num-test (atan 0 -2) pi)
+(num-test (atan 0 1.5) 0.0)
+(num-test (atan 0 -1.5) pi)
+(num-test (atan 0 3.0) 0.0)
+(num-test (atan 0 -3.0) pi)
+(num-test (atan 0 4.0) 0.0)
+(num-test (atan 0 -4.0) pi)
+(num-test (atan 0 pi) 0.0)
+(num-test (atan 0 (- pi)) pi)
+(num-test (atan 0.0 0) 0.0)
+(num-test (atan 0.0 1) 0.0)
+(num-test (atan 0.0 -1) pi)
+(num-test (atan 0.0 2) 0.0)
+(num-test (atan 0.0 -2) pi)
+(num-test (atan 0.0 1.5) 0.0)
+(num-test (atan 0.0 -1.5) pi)
+(num-test (atan 0.0 3.0) 0.0)
+(num-test (atan 0.0 -3.0) pi)
+(num-test (atan 0.0 4.0) 0.0)
+(num-test (atan 0.0 -4.0) pi)
+(num-test (atan 0.0 (- pi)) pi)
+(num-test (atan 1 0) 1.5707963267949)
+(num-test (atan 1 0.0) 1.5707963267949)
+(num-test (atan 1 1) 0.78539816339745)
+(num-test (atan 1 -1) 2.3561944901923)
+(num-test (atan 1 2) 0.46364760900081)
+(num-test (atan 1 -2) 2.677945044589)
+(num-test (atan 1 1.5) 0.58800260354757)
+(num-test (atan 1 -1.5) 2.5535900500422)
+(num-test (atan 1 3.0) 0.32175055439664)
+(num-test (atan 1 -3.0) 2.8198420991932)
+(num-test (atan 1 4.0) 0.24497866312686)
+(num-test (atan 1 -4.0) 2.8966139904629)
+(num-test (atan 1 pi) 3.081690711159849357869996080340530985905E-1)
+(num-test (atan 1 (- pi)) 2.833423582473808302675643775245449785612E0)
+(num-test (atan -1 0) -1.5707963267949)
+(num-test (atan -1 0.0) -1.5707963267949)
+(num-test (atan -1 1) -0.78539816339745)
+(num-test (atan -1 -1) -2.3561944901923)
+(num-test (atan -1 2) -0.46364760900081)
+(num-test (atan -1 -2) -2.677945044589)
+(num-test (atan -1 1.5) -0.58800260354757)
+(num-test (atan -1 -1.5) -2.5535900500422)
+(num-test (atan -1 3.0) -0.32175055439664)
+(num-test (atan -1 -3.0) -2.8198420991932)
+(num-test (atan -1 4.0) -0.24497866312686)
+(num-test (atan -1 -4.0) -2.8966139904629)
+(num-test (atan -1 pi) -3.081690711159849357869996080340530985905E-1)
+(num-test (atan -1 (- pi)) -2.833423582473808302675643775245449785612E0)
+(num-test (atan 2 0) 1.5707963267949)
+(num-test (atan 2 0.0) 1.5707963267949)
+(num-test (atan 2 1) 1.1071487177941)
+(num-test (atan 2 -1) 2.0344439357957)
+(num-test (atan 2 2) 0.78539816339745)
+(num-test (atan 2 -2) 2.3561944901923)
+(num-test (atan 2 1.5) 0.92729521800161)
+(num-test (atan 2 -1.5) 2.2142974355882)
+(num-test (atan 2 3.0) 0.58800260354757)
+(num-test (atan 2 -3.0) 2.5535900500422)
+(num-test (atan 2 4.0) 0.46364760900081)
+(num-test (atan 2 -4.0) 2.677945044589)
+(num-test (atan 2 pi) 5.669115049410094050828977467226191538068E-1)
+(num-test (atan 2 (- pi)) 2.574681148648783833379745636556883730391E0)
+(num-test (atan -2 0) -1.5707963267949)
+(num-test (atan -2 0.0) -1.5707963267949)
+(num-test (atan -2 1) -1.1071487177941)
+(num-test (atan -2 -1) -2.0344439357957)
+(num-test (atan -2 2) -0.78539816339745)
+(num-test (atan -2 -2) -2.3561944901923)
+(num-test (atan -2 1.5) -0.92729521800161)
+(num-test (atan -2 -1.5) -2.2142974355882)
+(num-test (atan -2 3.0) -0.58800260354757)
+(num-test (atan -2 -3.0) -2.5535900500422)
+(num-test (atan -2 4.0) -0.46364760900081)
+(num-test (atan -2 -4.0) -2.677945044589)
+(num-test (atan -2 pi) -5.669115049410094050828977467226191538068E-1)
+(num-test (atan -2 (- pi)) -2.574681148648783833379745636556883730391E0)
+(num-test (atan 1.5 0) 1.5707963267949)
+(num-test (atan 1.5 0.0) 1.5707963267949)
+(num-test (atan 1.5 1) 0.98279372324733)
+(num-test (atan 1.5 -1) 2.1587989303425)
+(num-test (atan 1.5 2) 0.64350110879328)
+(num-test (atan 1.5 -2) 2.4980915447965)
+(num-test (atan 1.5 1.5) 0.78539816339745)
+(num-test (atan 1.5 -1.5) 2.3561944901923)
+(num-test (atan 1.5 3.0) 0.46364760900081)
+(num-test (atan 1.5 -3.0) 2.677945044589)
+(num-test (atan 1.5 4.0) 0.35877067027057)
+(num-test (atan 1.5 -4.0) 2.7828219833192)
+(num-test (atan 1.5 pi) 4.454574939105981596935303215574368401686E-1)
+(num-test (atan 1.5 (- pi)) 2.696135159679195078769113061722066044025E0)
+(num-test (atan -1.5 0) -1.5707963267949)
+(num-test (atan -1.5 0.0) -1.5707963267949)
+(num-test (atan -1.5 1) -0.98279372324733)
+(num-test (atan -1.5 -1) -2.1587989303425)
+(num-test (atan -1.5 2) -0.64350110879328)
+(num-test (atan -1.5 -2) -2.4980915447965)
+(num-test (atan -1.5 1.5) -0.78539816339745)
+(num-test (atan -1.5 -1.5) -2.3561944901923)
+(num-test (atan -1.5 3.0) -0.46364760900081)
+(num-test (atan -1.5 -3.0) -2.677945044589)
+(num-test (atan -1.5 4.0) -0.35877067027057)
+(num-test (atan -1.5 -4.0) -2.7828219833192)
+(num-test (atan -1.5 pi) -4.454574939105981596935303215574368401686E-1)
+(num-test (atan -1.5 (- pi)) -2.696135159679195078769113061722066044025E0)
+(num-test (atan 3.0 0) 1.5707963267949)
+(num-test (atan 3.0 0.0) 1.5707963267949)
+(num-test (atan 3.0 1) 1.2490457723983)
+(num-test (atan 3.0 -1) 1.8925468811915)
+(num-test (atan 3.0 2) 0.98279372324733)
+(num-test (atan 3.0 -2) 2.1587989303425)
+(num-test (atan 3.0 1.5) 1.1071487177941)
+(num-test (atan 3.0 -1.5) 2.0344439357957)
+(num-test (atan 3.0 3.0) 0.78539816339745)
+(num-test (atan 3.0 -3.0) 2.3561944901923)
+(num-test (atan 3.0 4.0) 0.64350110879328)
+(num-test (atan 3.0 -4.0) 2.4980915447965)
+(num-test (atan 3.0 pi) 7.623475341648745879175385302461797760774E-1)
+(num-test (atan 3.0 (- pi)) 2.379245119424918650545104853033323108118E0)
+(num-test (atan -3.0 0) -1.5707963267949)
+(num-test (atan -3.0 0.0) -1.5707963267949)
+(num-test (atan -3.0 1) -1.2490457723983)
+(num-test (atan -3.0 -1) -1.8925468811915)
+(num-test (atan -3.0 2) -0.98279372324733)
+(num-test (atan -3.0 -2) -2.1587989303425)
+(num-test (atan -3.0 1.5) -1.1071487177941)
+(num-test (atan -3.0 -1.5) -2.0344439357957)
+(num-test (atan -3.0 3.0) -0.78539816339745)
+(num-test (atan -3.0 -3.0) -2.3561944901923)
+(num-test (atan -3.0 4.0) -0.64350110879328)
+(num-test (atan -3.0 -4.0) -2.4980915447965)
+(num-test (atan -3.0 pi) -7.623475341648745879175385302461797760774E-1)
+(num-test (atan -3.0 (- pi)) -2.379245119424918650545104853033323108118E0)
+(num-test (atan 4.0 0) 1.5707963267949)
+(num-test (atan 4.0 0.0) 1.5707963267949)
+(num-test (atan 4.0 1) 1.325817663668)
+(num-test (atan 4.0 -1) 1.8157749899218)
+(num-test (atan 4.0 2) 1.1071487177941)
+(num-test (atan 4.0 -2) 2.0344439357957)
+(num-test (atan 4.0 1.5) 1.2120256565243)
+(num-test (atan 4.0 -1.5) 1.9295669970655)
+(num-test (atan 4.0 3.0) 0.92729521800161)
+(num-test (atan 4.0 -3.0) 2.2142974355882)
+(num-test (atan 4.0 4.0) 0.78539816339745)
+(num-test (atan 4.0 -4.0) 2.3561944901923)
+(num-test (atan 4.0 pi) 9.050225767665427556408039831275762329032E-1)
+(num-test (atan 4.0 (- pi)) 2.236570076823250482821839400151926651295E0)
+(num-test (atan -4.0 0) -1.5707963267949)
+(num-test (atan -4.0 0.0) -1.5707963267949)
+(num-test (atan -4.0 1) -1.325817663668)
+(num-test (atan -4.0 -1) -1.8157749899218)
+(num-test (atan -4.0 2) -1.1071487177941)
+(num-test (atan -4.0 -2) -2.0344439357957)
+(num-test (atan -4.0 1.5) -1.2120256565243)
+(num-test (atan -4.0 -1.5) -1.9295669970655)
+(num-test (atan -4.0 3.0) -0.92729521800161)
+(num-test (atan -4.0 -3.0) -2.2142974355882)
+(num-test (atan -4.0 4.0) -0.78539816339745)
+(num-test (atan -4.0 -4.0) -2.3561944901923)
+(num-test (atan -4.0 pi) -9.050225767665427556408039831275762329032E-1)
+(num-test (atan -4.0 (- pi)) -2.236570076823250482821839400151926651295E0)
+(num-test (atan pi 0) 1.570796326794896619231321691639751442098E0)
+(num-test (atan pi 0.0) 1.570796326794896619231321691639751442098E0)
+(num-test (atan pi 1) 1.262627255678911683444322083605698343509E0)
+(num-test (atan pi -1) 1.878965397910881555018321299673804540687E0)
+(num-test (atan pi 2) 1.003884821853887214148423944917132288294E0)
+(num-test (atan pi -2) 2.137707831735906024314219438362370595907E0)
+(num-test (atan pi 1.5) 1.125338832884298459537791370082314601928E0)
+(num-test (atan pi -1.5) 2.016253820705494778924852013197188282274E0)
+(num-test (atan pi 3.0) 8.084487926300220313137831613935716660202E-1)
+(num-test (atan pi -3.0) 2.333143860959771207148860221885931218181E0)
+(num-test (atan pi 4.0) 6.657737500283538635905177085121752091944E-1)
+(num-test (atan pi -4.0) 2.475818903561439374872125674767327675004E0)
+(num-test (atan pi pi) 7.853981633974483096156608458198757210488E-1)
+(num-test (atan pi (- pi)) 2.356194490192344928846982537459627163149E0)
+(num-test (atan (- pi) 0) -1.570796326794896619231321691639751442098E0)
+(num-test (atan (- pi) 0.0) -1.570796326794896619231321691639751442098E0)
+(num-test (atan (- pi) 1) -1.262627255678911683444322083605698343509E0)
+(num-test (atan (- pi) -1) -1.878965397910881555018321299673804540687E0)
+(num-test (atan (- pi) 2) -1.003884821853887214148423944917132288294E0)
+(num-test (atan (- pi) -2) -2.137707831735906024314219438362370595907E0)
+(num-test (atan (- pi) 1.5) -1.125338832884298459537791370082314601928E0)
+(num-test (atan (- pi) -1.5) -2.016253820705494778924852013197188282274E0)
+(num-test (atan (- pi) 3.0) -8.084487926300220313137831613935716660202E-1)
+(num-test (atan (- pi) -3.0) -2.333143860959771207148860221885931218181E0)
+(num-test (atan (- pi) 4.0) -6.657737500283538635905177085121752091944E-1)
+(num-test (atan (- pi) -4.0) -2.475818903561439374872125674767327675004E0)
+(num-test (atan (- pi) pi) -7.853981633974483096156608458198757210488E-1)
+(num-test (atan (- pi) (- pi)) -2.356194490192344928846982537459627163149E0)
+
+(num-test (atan 3037000500 1/3037000500) 1.570796326794896619122901474392911039606E0)
+(num-test (atan most-positive-fixnum) 1.570796326794896619122901474391200998685E0)
+(num-test (atan 1/3037000500 3037000500) 1.084202172468404024919078833314741441372E-19)
+
+(test (atan) 'error)
+(test (atan "hi") 'error)
+(test (atan 1.0+23.0i 1.0+23.0i) 'error)
+(test (atan 0 1 2) 'error)
+(test (atan 0 0-i) 'error)
+(test (atan 1+i 0-i) 'error)
+(test (atan 1 0-i) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (atan arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(for-each
+ (lambda (arg)
+   (test (atan arg +nan.0) 'error)
+   (test (atan +nan.0 arg) 'error)
+   (test (atan arg +inf.0) 'error)
+   (test (atan +inf.0 arg) 'error)
+   (test (atan 1 arg) 'error)
+   (test (atan 1.0 arg) 'error)
+   (test (atan 1/2 arg) 'error)
+   (test (atan 1+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(for-each
+ (lambda (arg)
+   (test (atan arg 1) 'error)
+   (test (atan arg 1/2) 'error)
+   (test (atan arg 1.0) 'error)
+   (test (atan arg 1+i) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+(let ((formulas
+       '((1/4  (1 1))
+
+	 (1/4  (1 2) (1 3))
+	 (1/4  (2 2) (-1 7))
+	 (1/4  (2 3) (1 7))
+	 (1/4  (4 5) (-1 239))
+
+	 (1/4  (1 2) (1 4) (1 13))
+	 (1/4  (1 2) (1 5) (1 8))
+	 (1/4  (1 2) (2 6) (-1 117))
+	 (1/4  (1 3) (2 4) (-1 38))
+	 (1/4  (2 2) (-2 12) (1 41))
+	 (1/4  (2 2) (-2 14) (1 1393))
+	 (1/4  (2 2) (-2 17) (-1 41))
+	 (1/4  (2 2) (-1 5) (1 18))
+	 (1/4  (2 2) (-1 6) (1 43))
+	 (1/4  (2 2) (-1 8) (-1 57))
+	 (1/4  (2 2) (-1 9) (-1 32))
+	 (1/4  (2 2) (-1 12) (-1 17))
+	 (1/4  (2 3) (1 5) (-1 18))
+	 (1/4  (2 3) (1 6) (-1 43))
+	 (1/4  (2 3) (1 8) (1 57))
+	 (1/4  (2 3) (1 9) (1 32))
+	 (1/4  (2 3) (1 12) (1 17))
+	 (1/4  (2 3) (2 12) (-1 41))
+	 (1/4  (2 3) (2 14) (-1 1393))
+	 (1/4  (2 3) (2 17) (1 41))
+	 (1/4  (2 4) (1 7) (2 13))
+	 (1/4  (2 5) (1 7) (2 8))
+	 (1/4  (2 5) (3 7) (-2 57))
+	 (1/4  (2 5) (3 8) (1 57))
+	 (1/4  (2 6) (3 7) (2 68))
+	 (1/4  (2 7) (4 8) (1 239))
+	 (1/4  (3 3) (-2 11) (1 682))
+	 (1/4  (3 3) (-2 13) (-1 38))
+	 (1/4  (3 3) (-1 5) (1 57))
+	 (1/4  (3 3) (-1 6) (-1 68))
+	 (1/4  (3 3) (-1 8) (-1 18))
+	 (1/4  (3 4) (1 13) (-1 38))
+	 (1/4  (3 4) (1 20) (1 1985))
+	 (1/4  (3 5) (2 8) (-1 18))
+	 (1/4  (3 7) (2 8) (2 18))
+	 (1/4  (3 7) (4 11) (-2 682))
+	 (1/4  (3 7) (4 13) (2 38))
+	 (1/4  (4 3) (-4 8) (-1 239))
+	 (1/4  (4 4) (-1 7) (-2 38))
+	 (1/4  (4 4) (-4 21) (-1 239))
+	 (1/4  (4 5) (-2 408) (1 1393))
+	 (1/4  (4 5) (-2 478) (1 54608393))
+	 (1/4  (4 5) (-2 577) (-1 1393))
+	 (1/4  (4 5) (-1 41) (2 99))
+	 (1/4  (4 5) (-1 70) (1 99))
+	 (1/4  (4 5) (-1 213) (1 1958))
+	 (1/4  (4 5) (-1 226) (1 4155))
+	 (1/4  (4 5) (-1 237) (1 28322))
+	 (1/4  (4 5) (-1 238) (1 56883))
+	 (1/4  (4 5) (-1 240) (-1 57361))
+	 (1/4  (4 5) (-1 241) (-1 28800))
+	 (1/4  (4 5) (-1 252) (-1 4633))
+	 (1/4  (4 5) (-1 265) (-1 2436))
+	 (1/4  (4 5) (-1 408) (-1 577))
+	 (1/4  (4 5) (1 41) (-2 70))
+	 (1/4  (4 6) (1 7) (-2 117))
+	 (1/4  (4 6) (4 31) (-1 239))
+	 (1/4  (4 7) (4 18) (-1 239))
+	 (1/4  (5 5) (-3 18) (-2 57))
+	 (1/4  (5 6) (-1 43) (-2 117))
+	 (1/4  (5 6) (-1 68) (-3 117))
+
+	 (1/4  (-29 239) (256 378) (200 829) (244 882) (-388 993) (324 2943) (-144 18543))
+	 (1/4  (-4 307) (394 577) (163 1393) (-12 12238) (-24 58911) (-68 1999509) (-68 11653127))
+	 (1/4  (7 10) (2 50) (4 100) (1 682) (4 1000) (3 1303) (-4 90109))
+	 (1/4  (7 10) (8 100) (1 682) (4 1000) (3 1303) (-4 90109) (-2 500150))
+	 (1/4  (12 18) (8 307) (46 577) (19 1393) (-8 2827807) (-16 11653127) (-8 16480443))
+	 (1/4  (17 23) (11 882) (24 931) (10 1143) (-2 34208) (-8 44179) (-13 485298))
+	 (1/4  (29 268) (198 378) (142 829) (186 882) (-301 993) (237 2943) (-115 18543))
+	 (1/4  (43 57) (22 746) (-2 1568) (1 4662) (28 12943) (14 32807) (11 157318))
+	 (1/4  (44 515) (95 538) (127 682) (176 782) (95 1068) (88 4030) (17 12943))
+	 (1/4  (76 682) (190 746) (271 882) (315 2917) (-132 9466) (295 12943) (-95 19703))
+	 (1/4  (83 107) (17 4443) (68 11343) (-5 113568) (-34 595667) (-5 23481902) (5 168925949733307))
+	 (1/4  (83 107) (17 4443) (68 11343) (-5 111693) (-34 595667) (5 9503057) (5 232633636378307))
+	 (1/4  (95 418) (171 682) (176 882) (315 2917) (-132 9466) (105 12943) (95 16693))
+	 (1/4  (100 437) (254 577) (127 1393) (44 2072) (24 2943) (-12 16432) (-100 28800))
+	 (1/4  (122 162) (22 568) (-29 1432) (83 5087) (-7 6107) (-10 27493) (-29 30027))
+	 (1/4  (122 183) (108 1177) (29 1393) (22 4443) (54 5087) (-64 7078) (-10 27493))
+	 (1/4  (122 418) (237 557) (29 1068) (144 3458) (-61 5087) (122 16452) (105 27493))
+	 (1/4  (127 239) (100 343) (-56 2072) (-76 2943) (100 7983) (-12 16432) (100 28322))
+	 (1/4  (127 239) (212 1068) (-144 2072) (188 2309) (-200 6105) (376 6807) (288 13637))
+	 (1/4  (127 239) (400 1068) (44 2072) (-376 2943) (-200 6105) (100 13637) (188 16432))
+	 (1/4  (127 682) (227 788) (227 843) (44 2072) (51 2943) (-27 12943) (88 16432))
+	 (1/4  (127 682) (454 818) (271 1303) (-403 2943) (-44 6118) (-254 12943) (-183 3014557))
+	 (1/4  (171 239) (68 788) (-56 1744) (36 2943) (44 6613) (-112 13603) (144 28322))
+	 (1/4  (171 239) (68 993) (-20 2943) (56 4443) (-44 13252) (-112 17088) (156 28322))
+	 (1/4  (171 239) (124 993) (-56 1252) (56 2855) (-76 2943) (-100 13252) (100 28322))
+	 (1/4  (171 682) (183 788) (227 843) (95 2943) (44 6613) (-115 12943) (88 28322))
+	 (1/4  (171 682) (271 882) (95 993) (315 2917) (95 2943) (-227 9466) (200 12943))
+	 (1/4  (171 682) (366 1068) (139 2436) (271 5357) (315 5507) (227 6962) (-71 12943))
+	 (1/4  (176 463) (32 682) (241 798) (241 3141) (-58 5357) (-122 12943) (-51 390112))
+	 (1/4  (176 557) (244 757) (90 1068) (61 1393) (22 3458) (122 11018) (44 27493))
+	 (1/4  (179 239) (44 5357) (80 5507) (156 12943) (8 17923) (48 32807) (-40 157318))
+	 (1/4  (179 239) (120 4662) (4 5357) (116 12943) (-32 17923) (88 32807) (40 390112))
+	 (1/4  (179 233) (120 4662) (4 5357) (-63 12943) (-32 17923) (-91 32807) (40 390112))
+	 (1/4  (183 239) (32 682) (-88 1143) (132 2673) (68 12943) (-132 34208) (-44 44179))
+	 (1/4  (183 239) (32 1023) (-68 5832) (12 111693) (-100 6826318) (-12 9503057) (-12 232633636378307))
+	 (1/4  (183 239) (32 1023) (-68 5832) (12 112068) (-100 6826318) (-12 13288972) (-12 49541920807))
+	 (1/4  (183 239) (32 1023) (-68 5832) (12 113568) (-100 6826318) (12 23476958) (-12 111432033307))
+	 (1/4  (183 239) (32 1023) (-68 5832) (12 113568) (-100 6826318) (12 23481005) (-12 612463280182))
+	 (1/4  (183 239) (32 1023) (-68 5832) (12 113568) (-100 6826318) (12 23463218) (-12 29483238307))
+	 (1/4  (183 239) (32 1023) (-68 5832) (12 113568) (-100 6826318) (12 23481902) (-12 168925949733307))
+	 (1/4  (183 294) (44 905) (115 1292) (88 3957) (-32 12238) (68 12943) (51 114483))
+	 (1/4  (183 307) (32 682) (95 1143) (132 2673) (68 12943) (51 34208) (139 44179))
+	 (1/4  (183 378) (115 557) (29 1068) (122 2943) (144 3458) (-244 14318) (44 27493))
+	 (1/4  (183 378) (144 606) (86 1772) (122 2943) (-115 6118) (-71 14318) (-71 27493))
+	 (1/4  (183 378) (144 905) (115 1057) (151 2943) (-29 3957) (-100 14318) (-100 27493))
+	 (1/4  (183 378) (215 682) (44 1432) (51 2943) (-315 5257) (-71 12943) (44 13043))
+	 (1/4  (183 538) (215 682) (51 1068) (44 2309) (88 2673) (88 3039) (17 12943))
+	 (1/4  (183 568) (215 682) (278 1636) (-139 6107) (112 12943) (-234 19703) (132 32807))
+	 (1/4  (186 307) (41 378) (27 829) (-13 1713) (122 2943) (42 12238) (71 58911))
+	 (1/4  (190 577) (76 682) (176 882) (95 1393) (220 2917) (-132 9466) (200 12943))
+	 (1/4  (198 577) (200 606) (127 1393) (-20 2943) (112 3740) (-44 6118) (56 11018))
+	 (1/4  (199 233) (-60 1393) (-76 5357) (-43 12943) (-152 17923) (9 32807) (120 1049433))
+	 (1/4  (215 233) (-216 1568) (12 4662) (-64 6898) (113 12943) (-51 32807) (-32 534568))
+	 (1/4  (215 239) (-248 1568) (76 4662) (296 12943) (132 32807) (64 83270) (32 1493208))
+
+	 (1/4  (160 200) (-1 239) (-4 515) (-8 4030) (-16 50105) (-16 62575) (-32 500150) (-80 4000300))
+	 (1/4  (215 682) (644 1568) (227 5767) (366 6898) (-532 12943)  (227 24331) (-51 32807) (183 534568))
+	 (1/4  (295 4193) (3767 5507) (593 18543) (-1228 39307) (2068 55603) (-962 211050) (-708 390112) (-1587 2867938))
+	 (1/4  (537 1393) (1118 5357) (952 12943) (3032 17923) (-1384 32807) (-1194 157318) (-1870 1049433) (796 21638297))
+	 (1/4  (581 1023) (183 4443) (664 5832) (732 11343) (-171 110443) (-366 595667) (171 4841182) (83 6826318))
+	 (1/4  (581 1252) (764 4853) (1030 5832) (-398 58898) (-764 97232) (195 110443) (537 4841182) (266 6826318))
+	 (1/4  (581 1252) (764 5593) (1030 5827) (366 58898) (195 110443) (537 4841182) (-764 6826318) (-1030 1561886607))
+	 (1/4  (581 1252) (764 5618) (1030 5832) (366 58898) (195 110443) (764 1256859) (537 4841182) (266 6826318))
+	 (1/4  (581 1252) (764 5593) (1030 5832) (366 69051) (195 110443) (366 369957) (171 4841182) (266 6826318))
+	 (1/4  (581 1252) (764 5593) (1030 11557) (1030 11773) (366 58898) (195 110443) (537 4841182) (266 6826318))
+	 (1/4  (581 1252) (1030 5507) (764 5593) (366 58898) (-1030 98821) (195 110443) (537 4841182) (266 6826318))
+	 (1/4  (764 1068) (298 5832) (581 26307) (-183 78813) (-171 110443) (215 314982) (171 4841182) (83 6826318))
+	 (1/4  (808 1477) (1308 2436) (-1635 5283) (-417 5507) (593 6962) (632 390112) (-561 2733307) (266 23747457))
+	 (1/4  (1074 1568) (840 5357) (-779 12943) (625 17923) (-1106 32807) (657 198505) (-259 390112) (657 24185182))
+	 (1/4  (1074 4246) (1257 5357) (1731 6107) (295 12943) (625 19703) (-481 32807) (-1042 39307) (398 390112))
+	 (1/4  (1484 4693) (2097 4831) (366 18543) (1189 49457) (-227 123093) (-879 128643) (481 27872057) (-266 31895807))
+	 (1/4  (1738 4193) (1699 4246) (144 6687) (-1443 32318) (-266 39307) (337 235318) (-227 390112) (-481 2282363))
+	 (1/4  (2363 4557) (1218 5507) (1850 18543) (-266 39307) (-2658 49457) (1257 123093) (-1484 390112) (481 27872057))
+
+	 (1/4  (-31739656 201229582) (38819595 231373438) (110380200 284862638) (122355452 312322593) (-134055653 496651953) (5301720 509435077) (63861353 543644509) (68679613 934981432) (130575087 1845907403) (-32548340 2189376182) (-71616726 2539791558) (98822066 4732978887) (119051879 7804016832) (48482068 9233371207) (-99832073 41734246913) (-99143267 66492889557) (-25601898 73276714818) (-79323772 579766497643))
+	 (1/4  (16106659 103224943) (48702787 196047454) (18674705 199762118) (8786524 201229582) (-16824928 244653118) (-9582339 261221282) (33092716 266981905) (50379909 270684757) (24748365 909140573) (31675677 1770638022) (1576733 2189376182) (-4742586 2701984943) (-34586991 5475957057) (10864048 14033378718) (-13079131 18986886768) (22266057 25220059245) (17791526 34840696582) (-12650410 193100304493))
+	 (1/4  (154370374 124845505) (-90941691 193788912) (64454803 196047454) (-82996236 201229582) (109691394 244653118) (-15562779 462333568) (6518215 553806443) (-169821027 1134156517) (-244516782 1222853176) (100563577 2154947322) (-47118309 2189376182) (-35713908 4006581229) (60656646 5475957057) (-4001125 18986886768) (-68810571 37093513413) (-20888958 100083704193) (16990004 250645741818) (-62587614 5142102426318))
+	 (1/4  (-119375678 193788912) (61799442 201229582) (-19991865 272525023) (20438744 321390012) (88331413 331905423) (103467976 343841922) (88464202 378026293) (138122046 600536193) (44232101 653023206) (115219328 846974497) (-81969855 1033937133) (-63521464 1454097393) (-118694678 2189376182) (117332455 2322170807) (-26482877 6884660047) (-18702052 29546599818) (7415308 250645741818) (166718050 512223806648))
+	 (1/4  (-85386445 101859193) (4420755 112519818) (43555859 193788912) (15003774 194195097) (108912996 201229582) (61225652 231373438) (16824928 262992072) (73421340 284862638) (123118321 1057929843) (-10593254 2189376182) (40618746 2539791558) (73863237 2616939213) (-30947737 14811180432) (58354910 41734246913) (19908612 66492889557) (5345839 73276714818) (-90280386 120563046313) (61328880 579766497643))
+	 (1/4  (-75143577 193788912) (17567341 201229582) (64670845 321390012) (88331413 331905423) (103467976 343841922) (68472337 372954564) (49657844 600536193) (115219328 846974497) (24240236 1012047353) (-81969855 1033937133) (24942738 1454097393) (-118694678 2189376182) (73100354 2322170807) (-88464202 4549886677) (-26482877 6884660047) (-18702052 29546599818) (7415308 250645741818) (34021747 512223806648))
+	 (1/4  (-9761163 108220762) (13910116 144252856) (12032992 157157432) (55358773 167207057) (6697039 168623905) (-28651627 193788912) (1825738 201229582) (67020547 215266693) (-1575761 216260702) (45238607 284862638) (10024910 934981432) (20338355 2189376182) (-450675 4832545807) (-27703534 4935283579) (-25688998 7804016832) (-58020549 18986886768) (-28330426 120563046313) (-20446387 69971515635443))
+	 (1/4  (-9719634 193788912) (17567341 201229582) (70452403 204415882) (12270610 244653118) (18184957 313467682) (44573394 426775692) (3945487 600536193) (33076315 892642643) (62731148 919331002) (18631836 1012047353) (58964485 1454097393) (32836016 2032914193) (-3430506 2189376182) (-19017973 5475957057) (60427493 6884660047) (-9222216 16406542707) (25467476 22827763470) (-8020348 29546599818))
+	 (1/4  (-7707046 100457781) (102467557 168623905) (-37989469 201229582) (-19264491 216904033) (74130709 231373438) (9117882 262992072) (61898132 284862638) (-26046661 314198789) (20721724 327012132) (-6893934 1111885489) (-40541219 1183092682) (-40255386 2189376182) (82347539 2296713307) (31354293 12988236682) (27538131 18221678207) (-68243977 41734246913) (12646329 73276714818) (-45544955 193100304493))
+	 (1/4  (-6829481 193788912) (49141523 227661182) (80561462 231373438) (12671730 244653118) (29897458 284862638) (-73630486 355671793) (58626712 398795108) (62468573 509435077) (24454447 543644509) (-19908612 657922943) (28905471 1057929843) (35237534 1845907403) (26678061 2189376182) (-117350972 4866438247) (-61240161 5475957057) (23212961 9075730623) (-20886351 9233371207) (-65421299 60402345333))
+	 (1/4  (-6249813 193788912) (56771042 201229582) (28076746 231373438) (-19468648 262992072) (30639871 266981905) (19911270 284862638) (130457979 532399876) (96830507 672554667) (-25661007 1057929843) (13459441 1111885489) (-45480502 1183092682) (5693286 1770638022) (-21577251 2170952313) (-67486342 2189376182) (2925523 2701984943) (27538131 18221678207) (-7198038 193100304493) (36293576 307026452057))
+	 (1/4  (-60656646 143846482) (38271221 144309885) (138138220 157565949) (35739707 193788912) (-42115413 201229582) (-49270023 231373438) (94471578 278263393) (-68287996 398795108) (87062724 462333568) (-21411533 593897943) (-13257608 1057929843) (-106971336 1206519637) (34427295 2189376182) (166256019 4006581229) (111296506 4832545807) (58999250 18986886768) (100563577 373139596292) (100694535 5142102426318))
+	 (1/4  (-5621437 103224943) (81294931 115811807) (23943179 193788912) (33709426 199762118) (-2077524 201229582) (-31310435 261221282) (4978864 266981905) (-15147806 282218776) (-1688365 909140573) (20050974 1047764193) (-18279356 1770638022) (-1777511 2189376182) (19200593 2701984943) (-21507860 5475957057) (30332696 34840696582) (26011854 48312162432) (7938525 193100304493) (9186926 250645741818))
+	 (1/4  (-5497394 101057042) (65180148 144309885) (53832596 193788912) (48554212 201229582) (52075350 447821668) (-105963621 539290393) (-8554603 2060228568) (7313117 2112819717) (-57858314 2189376182) (-3891660 2572149874) (7518287 3261365450) (-19908612 4044044333) (12568802 4866438247) (-83992146 5494891577) (-68408704 9233371207) (6071631 20336334426) (26993421 45384196187) (-20080982 71617196968))
+	 (1/4  (-52897653 193788912) (17567341 201229582) (88637360 214539684) (16824928 329492391) (87365276 426775692) (89084239 434859193) (64670845 478798161) (-60879340 600536193) (51820567 706366957) (25661007 1033937133) (-7721255 1119211358) (-11874055 1454097393) (-46608525 2189376182) (-7415308 2674664693) (38361126 6884660047) (-54246761 29546599818) (29095538 42354792693) (55834766 512223806648))
+	 (1/4  (-51730315 193788912) (50509639 201229582) (-2925523 224497457) (34338149 231373438) (56651725 266981905) (88974774 284862638) (6009207 367829623) (44851350 532399876) (77361859 672554667) (-36293576 1047764193) (19819495 1057929843) (-26011854 1695830317) (-10691678 1770638022) (-51609424 2170952313) (-31380534 2189376182) (21276728 18221678207) (9186926 250645741818) (-16384964 4125516427007))
+	 (1/4  (-50738726 193788912) (95363435 196047454) (69453144 225823278) (69510447 227661182) (22432893 244653118) (-32772323 266981905) (-17689880 284862638) (-25151223 657922943) (45597610 672554667) (-15126313 934981432) (76492809 1770638022) (84039104 2189376182) (-104948381 4832545807) (-85627080 5475957057) (-40656362 5684017953) (-5242611 7804016832) (-197723175 18986886768) (42533486 25220059245))
+	 (1/4  (-28765620 120868561) (44046442 160007778) (67427201 167207057) (37325093 191800592) (70499068 270090468) (-57543499 289008998) (17519675 361632045) (-4374603 747769833) (-52576452 2674664693) (-7666625 2971354082) (83775059 3069221943) (44136928 4549886677) (-7704241 4832545807) (109211041 4935283579) (43406332 5271470807) (-4967047 8815417307) (24253605 14033378718) (72936300 69392205693))
+	 (1/4  (-19504206 100457781) (24986381 107793452) (26438497 121042733) (40255386 160007778) (28377269 168623905) (23815821 314198789) (-2374068 361632045) (25057307 672554667) (-9351768 773302059) (11008080 1479406293) (574237 2296713307) (-3020779 2701984943) (17648998 4038832337) (-9422284 12139595709) (27538131 12957904393) (20007517 12988236682) (23727647 18710140581) (-4711783 120563046313))
+	 (1/4  (-42543389 193788912) (74917830 201229582) (28076746 231373438) (16824928 262992072) (30639871 266981905) (74351634 284862638) (21577251 640348873) (78683719 672554667) (-25661007 1057929843) (-4687347 1111885489) (-27333714 1183092682) (5693286 1770638022) (8531273 2189376182) (-76017615 2674664693) (2925523 2701984943) (-39724039 4309606382) (27538131 18221678207) (68819577 193100304493))
+	 (1/4  (-41665661 138884933) (61863206 168623905) (-24923249 201229582) (1860735 231373438) (152322833 244685917) (16824928 262992072) (45004160 284862638) (6816407 306903943) (-25731933 2189376182) (-2937113 2539791558) (-80514719 4100676432) (-30142453 5157407572) (88702086 17249711432) (10077565 18986886768) (-34456033 41734246913) (19908612 66492889557) (66436029 73276714818) (-10644159 579766497643))
+	 (1/4  (-39775463 119742462) (20197545 168623905) (93476735 201229582) (1860735 231373438) (58490589 262992072) (86669821 284862638) (-4706801 437768635) (41665661 1258140850) (-35068662 1396533757) (-56669435 1624720807) (61079955 2189376182) (69090409 2539791558) (-73253757 3712239557) (42278290 41734246913) (-46591870 52254287493) (59684075 66492889557) (-12188492 73276714818) (-15350960 579766497643))
+	 (1/4  (-3944315 103224943) (48706548 136899993) (18362609 186695067) (14767496 193788912) (-25501467 201229582) (-15136563 244653118) (29933522 261221282) (30079929 266981905) (117267526 480808760) (-30911261 1012047353) (40320881 1770638022) (53656250 2189376182) (20888958 2701984943) (-63283169 5475957057) (-32599626 37093513413) (-43463674 43917943025) (-64759288 193100304493) (21735578 5142102426318))
+	 (1/4  (-3908713 100351813) (64565359 115453918) (26685223 201229582) (-8153925 214539684) (96935488 385231007) (15853328 459637173) (-19281720 539290393) (-48760063 883337939) (62688235 909140573) (-67639108 1282794079) (-5891323 1304967682) (-10583319 2189376182) (34749426 2572149874) (-55437542 3508373380) (-90085473 4427365493) (-35842901 5494891577) (-35317011 18986886768) (-22926686 45119420807))
+	 (1/4  (-36515828 110175338) (5722932 193788912) (17567341 201229582) (83804410 203283777) (85603231 244653118) (79850836 273202197) (68353757 345311195) (-87424385 549758463) (-63893191 1454097393) (-111387800 1459933093) (69893108 1725455932) (-61767440 2189376182) (-19017973 5475957057) (102875038 6930719818) (47464799 16406542707) (21866697 29546599818) (-15003774 37093513413) (-46223313 5142102426318))
+	 (1/4  (-36293576 132095062) (57870827 168623905) (-42543389 193788912) (35193791 201229582) (-8216830 231373438) (53118504 262992072) (30639871 266981905) (128791998 284862638) (60536931 672554667) (-25661007 1057929843) (49753017 1111885489) (-45480502 1183092682) (-30600290 1770638022) (-9615515 2189376182) (-69661629 2701984943) (63831707 18221678207) (29095538 193100304493) (-36293576 5142102426318))
+	 (1/4  (-35775309 107793452) (-7119735 111530944) (127376638 115811807) (66649464 193788912) (-21949674 201229582) (-43413311 244653118) (-45561148 261221282) (49941099 266981905) (-9186926 396134107) (-886843 1770638022) (73138594 2189376182) (-39140796 2296713307) (61906878 2701984943) (-3565489 5458840213) (-21696619 5475957057) (-7498561 55237647473) (75356069 193100304493) (-1877124 579766497643))
+	 (1/4  (-35368492 144309885) (-13432309 201229582) (124560353 231373438) (-8671679 284862638) (3303573 398795108) (141414744 509435077) (203277950 543644509) (-124589816 1845907403) (-32548340 2189376182) (-53309379 2539791558) (115883211 4732978887) (68679613 9075730623) (-1890198 9233371207) (19219806 41734246913) (19908612 66492889557) (60138860 73276714818) (-53675839 102428655030) (-10644159 579766497643))
+	 (1/4  (-35368492 110911039) (50372266 113561432) (3303573 168623905) (-16735882 201229582) (74188087 231373438) (30000386 284862638) (106046252 509435077) (99229845 543644509) (-89221324 1845907403) (-67916832 2189376182) (-53309379 2539791558) (-15003774 3658567505) (65510945 4732978887) (-16893972 9233371207) (-19452259 41734246913) (-30463654 66492889557) (75142634 73276714818) (-10644159 579766497643))
+	 (1/4  (-34897469 115453918) (87164915 118708522) (27407173 168623905) (87908983 193788912) (-27111639 201229582) (25214128 284862638) (-104763374 426775692) (55687060 600536193) (-49901243 909140573) (3434531 975229968) (-44950370 1454097393) (75180138 2189376182) (27482161 3508373380) (-68146942 4866438247) (-85620582 6884660047) (15583442 9233371207) (30725109 29546599818) (2193045 1442060060693))
+	 (1/4  (-32461025 169937257) (42456472 193788912) (60136529 201229582) (45652872 230845763) (-11582317 231373438) (-12390325 448235443) (44415233 539290393) (59855124 595484173) (64938439 1057929843) (30600290 1500534537) (71357041 2189376182) (45920466 2616939213) (48826263 2701984943) (27854052 5494891577) (22522061 7193374037) (-21720539 11115923863) (1241486 14811180432) (-44678980 58240834569))
+	 (1/4  (-30911476 193788912) (17567341 201229582) (68472337 272525023) (64670845 321390012) (88331413 331905423) (15003774 343841922) (5425743 600536193) (70987227 846974497) (-37737754 1033937133) (69174839 1454097393) (-30230476 2189376182) (28868253 2322170807) (-26482877 6884660047) (-44232101 24139206772) (-18702052 29546599818) (-44232101 50443911578) (7415308 250645741818) (-10210354 512223806648))
+	 (1/4  (-30692741 227661182) (12504894 231373438) (-39446702 244653118) (114600079 262992072) (92590873 284862638) (113856011 314198789) (86140179 346369967) (-22467890 355671793) (-141382552 398795108) (59415160 657922943) (-7326899 1620933557) (-1037771 2189376182) (-79323772 8895085098) (-27205340 17997844652) (-10574983 41734246913) (-27904591 60402345333) (-79821190 73276714818) (16893972 102428655030))
+	 (1/4  (-30361861 113561432) (85628068 168623905) (20493345 231373438) (53783788 262992072) (46894358 284862638) (65430523 1172624874) (36958860 1258140850) (-16893972 1624720807) (21304492 2189376182) (-1046915 2539791558) (-16436052 3658567505) (20222978 3712239557) (18632610 9549201618) (-27859034 41734246913) (-6816407 52254287493) (50270473 66492889557) (22880170 73276714818) (-10644159 579766497643))
+	 (1/4  (-29735286 115453918) (-1890198 149299093) (12010178 168623905) (30661691 195053432) (7109402 201229582) (55743030 213255960) (32522426 231373438) (65751551 262992072) (35890388 284862638) (40220018 687606629) (-29216048 909140573) (-63654586 2189376182) (44099312 2539791558) (-33529628 41734246913) (-20830644 66492889557) (26660566 73276714818) (28204899 579766497643) (-48926623 1197009532318))
+
+	 (1/2  (94283734 231373438) (147962666 262992072) (211308992 284862638) (-26800082 318942476) (-69173113 610076381) (-137945216 1111885489) (126007473 1183092682) (333203505 2189376182) (-250903561 2296713307) (248078871 2539791558) (-379960570 5458840213) (-73879914 18221678207) (132652425 30446482737) (68447160 41734246913) (-28954879 66492889557) (35907922 73276714818) (124495078 193100304493) (118351969 579766497643) (18339615 69971515635443))
+
+	 (1/4  (-177112869 1047764193) (690072825 1057929843) (94777525 1082548618) (102841728 1770638022) (254740469 1845907403) (-7897447 2189376182) (-276135745 4866438247) (382919489 8634733487) (364832031 9233371207) (-255036003 18221678207) (-47281269 30446482737) (-14754756 31147706551) (145805470 35587716432) (-60553945 41734246913) (275062833 73276714818) (130937707 73745675437) (225667081 91140429801) (-58222931 120563046313) (217205407 250645741818) (-335335373 69971515635443))
+	 (1/4  (48554212 1047764193) (-8064203 1695830317) (273129107 1845907403) (256152120 2060228568) (387484239 2170952313) (522262813 2189376182) (139928940 2426435870) (35269543 6249781117) (-116987170 9233371207) (-153310392 14885462059) (243523167 16346803247) (-191276069 18221678207) (-114320902 30446482737) (430509851 31147706551) (-62448154 35587716432) (118676670 41734246913) (-206756368 73276714818) (103732367 73745675437) (887580 250645741818) (-42628659 69971515635443))
+	 (1/4  (59529729 1111885489) (411801489 1183092682) (-11697838 1770638022) (-10217933 2189376182) (178183864 2420845318) (481604223 2674664693) (200815307 2701984943) (18311409 4309606382) (-54066665 5684017953) (391091355 9566096322) (433050011 14033378718) (155959834 14474950443) (123563452 18221678207) (-322558047 18986886768) (-187246484 41734246913) (182267620 73276714818) (70949047 120563046313) (85657566 134237866432) (150508360 193100304493) (16824928 804006285737))
+	 (1/4  (79674619 1057929843) (430112898 1183092682) (103029535 1770638022) (419995354 1845907403) (161719567 2189376182) (25897285 2701984943) (-165526275 3651666474) (-450635225 4866438247) (418811986 5684017953) (520079918 9233371207) (-370946465 11079391432) (11498734 14033378718) (1575319 15548138481) (-17734177 18221678207) (310673925 18986886768) (179773324 91140429801) (10643092 193100304493) (158038974 250645741818) (-165442692 804006285737) (119720378 11484937157318))
+	 (1/4  (210413195 1047764193) (49034748 1057929843) (129893399 1111885489) (920835218 1222853176) (-367170458 1770638022) (-460082449 2154947322) (471386290 2189376182) (-4742586 2701984943) (-385386694 3651666474) (239038662 5684017953) (399473027 12988236682) (-298167989 14033378718) (111903950 15548138481) (-327400900 18221678207) (-789934617 18986886768) (-490722320 34352737807) (-639330225 193100304493) (-182267620 250645741818) (264670206 804006285737) (460026972 11484937157318))
+	 (1/4  (245117311 1057929843) (-441536832 1111885489) (694624721 1183092682) (357582197 1845907403) (993878808 2189376182) (-264511823 2296713307) (279266579 2701984943) (-1351244216 4866438247) (255211890 9233371207) (142361641 10855443178) (-647040605 11079391432) (-55648319 15548138481) (-29232911 18221678207) (533067633 35587716432) (34223580 41734246913) (165442692 73276714818) (-215957611 91140429801) (786436927 120563046313) (939525243 193100304493) (311982932 250645741818))
+	 (1/4  (290087814 1057929843) (129893399 1111885489) (189059832 1183092682) (312611694 1770638022) (-177755991 2189376182) (30639871 2539791558) (236310480 2701984943) (285108950 3651666474) (-530648699 5458840213) (208398791 5684017953) (381614163 14033378718) (81264079 15548138481) (-679782152 17249711432) (321741381 18221678207) (130900601 18986886768) (210413195 66492889557) (250865122 193100304493) (28145575 250645741818) (44970503 804006285737) (-460808246 11484937157318))
+	 (1/4  (719865552 1057929843) (-120111015 1111885489) (-210078035 1183092682) (62607280 1770638022) (322252837 2189376182) (486314894 2701984943) (254469079 3651666474) (149133453 4832545807) (-401152271 5684017953) (491057480 7804016832) (-30639871 8995467682) (-328807860 14033378718) (392548235 15548138481) (-311284156 17058320068) (-669324927 18221678207) (-180383555 18986886768) (-60419034 193100304493) (278149989 250645741818) (325614788 804006285737) (-180163961 11484937157318))
+	 (1/4  (764256596 1183092682) (340757269 1770638022) (82030807 2189376182) (-651971659 2296713307) (188678845 2539791558) (371182743 2701984943) (-541133952 5458840213) (282350263 5684017953) (261942239 9566096322) (414738602 14033378718) (-578034328 17249711432) (219993557 18221678207) (-126062774 18986886768) (-58097368 41734246913) (129149116 66492889557) (53118504 73276714818) (-68972608 120563046313) (210038089 193100304493) (285108950 579766497643) (16824928 804006285737))
+	 (1/2  (-389355483 1111885489) (-85198635 1770638022) (942772580 2189376182) (860225796 2296713307) (958295292 2439473093) (1701938869 2701984943) (570217900 3651666474) (-653171089 5684017953) (1290597651 9566096322) (632981931 14033378718) (-258298232 15548138481) (-716081542 18221678207) (-448620821 18986886768) (-1711424041 41734246913) (1131248413 73276714818) (1650144299 120563046313) (1441452520 193100304493) (766713173 250645741818) (800363029 804006285737) (-1590316151 11484937157318))
+	 (1/2  (-383575951 1082548618) (367447545 1695830317) (470326860 1845907403) (302791880 2060228568) (1332608020 2170952313) (1886585069 2189376182) (-562201563 2426435870) (610170129 2539791558) (-707278553 4732978887) (-215928441 6249781117) (-232950527 9233371207) (201602620 16346803247) (172870593 31147706551) (-125920121 35587716432) (696860645 41734246913) (207464734 66492889557) (-412488923 73276714818) (689924269 250645741818) (305596971 579766497643) (199162583 69971515635443))
+
+	 (1/2  (468218462 2189376182) (1818521088 2439473093) (1312583386 2701984943) (121856072 5684017953) (-1109476277 6327662603) (570217900 8634733487) (1720710549 9566096322) (718180566 14033378718) (601927564 15548138481) (-1921221601 18221678207) (-59265338 18986886768) (1164382644 30446482737) (-936396880 41734246913) (701135515 73276714818) (1205140059 73745675437) (875117138 120563046313) (236312461 193100304493) (336600275 250645741818) (715164394 804006285737) (-815288990 11484937157318) (-860225796 69971515635443))
+	 )))
+  (for-each
+   (lambda (formula)
+     (let ((r (/ 1 (car formula)))
+	   (sum 0.0))
+       (for-each
+	(lambda (arg)
+	  (set! sum (+ sum (* (car arg) (atan (/ 1 (cadr arg)))))))
+	(cdr formula))
+
+       (if (> (abs (- (* r sum) pi)) 1e-12)
+	   (begin (display formula) (display " = ") (display (* r sum)) (newline)))))
+   formulas)
+
+  (when with-bignums
+    (let ((mxerr 0.0))
+      (for-each
+       (lambda (formula)
+	 (let ((r (/ (bignum 1) (car formula)))
+	       (sum (bignum "0.0")))
+	   (for-each
+	    (lambda (arg)
+	      (set! sum (+ sum (* (car arg) (atan (bignum 1) (cadr arg))))))
+	    (cdr formula))
+
+	   (let ((err (abs (- (* r sum) (* 4 (atan (bignum 1.0) 1.0))))))
+	     (if (> err mxerr)
+		 (set! mxerr err)))))
+       formulas)
+      (if (> mxerr 1e-30)
+	  (format #t "big max error: ~A~%" mxerr)))))
+
+(let ((atans (list
+	      0.00000000000000000000000000000000000000000000000000000000000000000000
+	      0.04995839572194276141000628703484488149127708042350717441085345482998
+	      0.09966865249116202737844611987802059024327832250431464801550877681002
+	      0.14888994760949725058653039165586728099052584656913639751654183508627
+	      0.19739555984988075837004976519479029344758510378785210151768894024103
+	      0.24497866312686415417208248121127581091414409838118406712737591466735
+	      0.29145679447786709199560462143289119350316759901206541927220608308729
+	      0.33667481938672718139669863134176645842796861176681965716976593102220
+	      0.38050637711236488630358791681043310449740571365810083757630562232420
+	      0.42285392613294071296648279098114197360332058559089653470801277782477
+	      0.46364760900080611621425623146121440202853705428612026381093308872019
+	      0.50284321092786082733088202924527755577645581499776483101147435179592
+	      0.54041950027058415544357836460859991013514825146259238811636023340959
+	      0.57637522059118368022757047839377004593402018294846332167674413471879
+	      0.61072596438920861654375887649023609381850306612882761584286773000023
+	      0.64350110879328438680280922871732263804151059111531238286560611871351
+	      0.67474094222355266305652097360981361507400625484071242312092170496930
+	      0.70449406424221771665748034078199625698360683805607748632242138272858
+	      0.73281510178650659164079207273428025198575567935825608631050693192821
+	      0.75976275487577082892296119539998182400552294838843900175686400378812
+	      0.78539816339744830961566084581987572104929234984377645524373614807695
+	      0.80978357257016684662414585801888523310377327237135123533486105150550
+	      0.83298126667443170541769356183636123851585134443710842085342312250327
+	      0.85505273712601651097815432807058769283799489703232752323972864020297
+	      0.87605805059819342311404752112834133907534524616033200346065614838499
+	      0.89605538457134395617480071802993782702457844484684048736655059118459
+	      0.91510070055336041656680197245527296654755880944161873770852665151657
+	      0.93324752865620386989366255071265925262560793377140310475404520234906
+	      0.95054684081207514789478913546381917504767901030880427426177057808809
+	      0.96704699339746024466331914650201513140746494542545306371969751473184
+	      0.98279372324732906798571061101466601449687745363162855676142508831798
+	      0.99783018390619045494496187944270463542510496590550026609871776901127
+	      1.01219701145133418325981347523809017175213711715353810435383625801215
+	      1.02593241134335292660599590143869494280346122674543977431139573494988
+	      1.03907225953609102762125033790727884531233378855364699989530509706554
+	      1.05165021254837366745986731208629982963024430034204461753698029655611
+	      1.06369782240255966094389111605254547856256296541932752568273985366635
+	      1.07524465330906808242086208732184320752064516718532174460312177009311
+	      1.08631839775787341806397958192567762897580047046812780208748680606431
+	      1.09694499030013626798639002132512259906130967805041989207206852796014
+	      1.10714871779409050301706546017853704007004764540143264667653920743371)))
+  (let ((mxerr 0.0))
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x 0.05)))
+	((= i 40))
+      (let ((err (abs (- (atan x) (list-ref atans i)))))
+	(if (> err mxerr)
+	    (set! mxerr err))))
+    (if (> mxerr 1e-12) (format #t "atan err: ~A~%" mxerr))))
+
+(when with-bignums
+  (let-temporarily (((*s7* 'bignum-precision) 500))
+    (let ((atans (list ; table[Arctan[k/10], {k, 0, 30}]
+		  0.00000000000000000000000000000000000000000000000000000000000000000000e0
+		  0.09966865249116202737844611987802059024327832250431464801550877681002
+		  0.19739555984988075837004976519479029344758510378785210151768894024103
+		  0.29145679447786709199560462143289119350316759901206541927220608308729
+		  0.38050637711236488630358791681043310449740571365810083757630562232420
+		  0.46364760900080611621425623146121440202853705428612026381093308872019
+		  0.54041950027058415544357836460859991013514825146259238811636023340959
+		  0.61072596438920861654375887649023609381850306612882761584286773000023
+		  0.67474094222355266305652097360981361507400625484071242312092170496930
+		  0.73281510178650659164079207273428025198575567935825608631050693192821
+		  0.78539816339744830961566084581987572104929234984377645524373614807695
+		  0.83298126667443170541769356183636123851585134443710842085342312250327
+		  0.87605805059819342311404752112834133907534524616033200346065614838499
+		  0.91510070055336041656680197245527296654755880944161873770852665151657
+		  0.95054684081207514789478913546381917504767901030880427426177057808809
+		  0.98279372324732906798571061101466601449687745363162855676142508831798
+		  1.01219701145133418325981347523809017175213711715353810435383625801215
+		  1.03907225953609102762125033790727884531233378855364699989530509706554
+		  1.06369782240255966094389111605254547856256296541932752568273985366635
+		  1.08631839775787341806397958192567762897580047046812780208748680606431
+		  1.10714871779409050301706546017853704007004764540143264667653920743371
+		  1.12637711689379770989641767275145325372112241040085015241064879177491
+		  1.14416883366802053001158090974633622082626800572469223488413501483165
+		  1.16066898625340562678011092078453217718605394084134102434206195147540
+		  1.17600520709513510249122216125017085520341449211184870745209441567184
+		  1.19028994968253173292773377482931833760117898602945207291116667382970
+		  1.20362249297667741080683267484687578339840429857832439350850411338551
+		  1.21609067478395630285892632134113779481025954203667431449700610948231
+		  1.22777238637419322215779309222594182541102155201281262388880100298534
+		  1.23873685925201114137796025438808735907407693977120210817129118165791
+		  1.24904577239825442582991707728109012307782940412989671905466923679715)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 30))
+	(let ((val (atan (bignum (/ i 10)))))
+	  (if (> (magnitude (- val (list-ref atans i))) 1e-36)
+	      (format #t ";(atan ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref atans i) (magnitude (- val (list-ref atans i))))))))))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; sinh
+;;; --------------------------------------------------------------------------------
+
+(num-test (sinh 0) 0.0)
+(num-test (sinh 1) 1.17520119364380)
+(num-test (sinh -1) -1.17520119364380)
+(num-test (sinh 2) 3.62686040784702)
+(num-test (sinh -2) -3.62686040784702)
+(num-test (sinh 3) 10.01787492740990)
+(num-test (sinh -3) -10.01787492740990)
+(num-test (sinh 10) 11013.23287470339346)
+(num-test (sinh -10) -11013.23287470339346)
+(num-test (sinh 0/1) 0.0)
+(num-test (sinh 0/2) 0.0)
+(num-test (sinh 0/3) 0.0)
+(num-test (sinh 0/10) 0.0)
+(num-test (sinh 0/1234) 0.0)
+(num-test (sinh 0/500029) 0.0)
+(num-test (sinh 1/1) 1.17520119364380)
+(num-test (sinh -1/1) -1.17520119364380)
+(num-test (sinh 1/2) 0.52109530549375)
+(num-test (sinh -1/2) -0.52109530549375)
+(num-test (sinh 1/3) 0.33954055725615)
+(num-test (sinh -1/3) -0.33954055725615)
+(num-test (sinh 1/10) 0.10016675001984)
+(num-test (sinh -1/10) -0.10016675001984)
+(num-test (sinh 1/1234) 0.00081037286017)
+(num-test (sinh -1/1234) -0.00081037286017)
+(num-test (sinh 1/500029) 0.00000199988401)
+(num-test (sinh -1/500029) -0.00000199988401)
+(num-test (sinh 2/1) 3.62686040784702)
+(num-test (sinh -2/1) -3.62686040784702)
+(num-test (sinh 2/2) 1.17520119364380)
+(num-test (sinh -2/2) -1.17520119364380)
+(num-test (sinh 2/3) 0.71715846101104)
+(num-test (sinh -2/3) -0.71715846101104)
+(num-test (sinh 2/10) 0.20133600254109)
+(num-test (sinh -2/10) -0.20133600254109)
+(num-test (sinh 2/1234) 0.00162074625252)
+(num-test (sinh -2/1234) -0.00162074625252)
+(num-test (sinh 2/500029) 0.00000399976801)
+(num-test (sinh -2/500029) -0.00000399976801)
+(num-test (sinh 3/1) 10.01787492740990)
+(num-test (sinh -3/1) -10.01787492740990)
+(num-test (sinh 3/2) 2.12927945509482)
+(num-test (sinh -3/2) -2.12927945509482)
+(num-test (sinh 3/3) 1.17520119364380)
+(num-test (sinh -3/3) -1.17520119364380)
+(num-test (sinh 3/10) 0.30452029344714)
+(num-test (sinh -3/10) -0.30452029344714)
+(num-test (sinh 3/1234) 0.00243112070921)
+(num-test (sinh -3/1234) -0.00243112070921)
+(num-test (sinh 3/500029) 0.00000599965202)
+(num-test (sinh -3/500029) -0.00000599965202)
+(num-test (sinh 10/1) 11013.23287470339346)
+(num-test (sinh -10/1) -11013.23287470339346)
+(num-test (sinh 10/2) 74.20321057778875)
+(num-test (sinh -10/2) -74.20321057778875)
+(num-test (sinh 10/3) 13.99797545058944)
+(num-test (sinh -10/3) -13.99797545058944)
+(num-test (sinh 10/10) 1.17520119364380)
+(num-test (sinh -10/10) -1.17520119364380)
+(num-test (sinh 10/1234) 0.00810381641088)
+(num-test (sinh -10/1234) -0.00810381641088)
+(num-test (sinh 10/500029) 0.00001999884007)
+(num-test (sinh -10/500029) -0.00001999884007)
+(num-test (sinh 1234/500029) 0.00246785936931)
+(num-test (sinh -1234/500029) -0.00246785936931)
+(num-test (sinh 500029/500029) 1.17520119364380)
+(num-test (sinh -500029/500029) -1.17520119364380)
+(num-test (sinh 0.0) 0.0)
+(num-test (sinh 0.00000001) 0.00000001)
+(num-test (sinh -0.00000001) -0.00000001)
+(num-test (sinh 1.0) 1.17520119364380)
+(num-test (sinh -1.0) -1.17520119364380)
+(num-test (sinh pi) 11.54873935725775)
+(num-test (sinh -3.14159265358979) -11.54873935725775)
+(num-test (sinh 0.0+0.0i) 0.0)
+(num-test (sinh -0.0+0.0i) 0.0)
+(num-test (sinh 0.0-0.0i) 0.0)
+(num-test (sinh -0.0-0.0i) 0.0)
+(num-test (sinh 0.0+0.00000001i) 0.0+0.00000001i)
+(num-test (sinh -0.0+0.00000001i) 0.0+0.00000001i)
+(num-test (sinh 0.0-0.00000001i) 0.0-0.00000001i)
+(num-test (sinh -0.0-0.00000001i) -0.0-0.00000001i)
+(num-test (sinh 0.0+1.0i) 0.0+0.84147098480790i)
+(num-test (sinh -0.0+1.0i) 0.0+0.84147098480790i)
+(num-test (sinh 0.0-1.0i) 0.0-0.84147098480790i)
+(num-test (sinh -0.0-1.0i) -0.0-0.84147098480790i)
+(num-test (sinh 0.00000001+0.0i) 0.00000001)
+(num-test (sinh -0.00000001+0.0i) -0.00000001)
+(num-test (sinh 0.00000001-0.0i) 0.00000001)
+(num-test (sinh -0.00000001-0.0i) -0.00000001)
+(num-test (sinh 0.00000001+0.00000001i) 0.00000001+0.00000001i)
+(num-test (sinh -0.00000001+0.00000001i) -0.00000001+0.00000001i)
+(num-test (sinh 0.00000001-0.00000001i) 0.00000001-0.00000001i)
+(num-test (sinh -0.00000001-0.00000001i) -0.00000001-0.00000001i)
+(num-test (sinh 0.00000001+1.0i) 0.00000000540302+0.84147098480790i)
+(num-test (sinh -0.00000001+1.0i) -0.00000000540302+0.84147098480790i)
+(num-test (sinh 0.00000001-1.0i) 0.00000000540302-0.84147098480790i)
+(num-test (sinh -0.00000001-1.0i) -0.00000000540302-0.84147098480790i)
+(num-test (sinh 1.0+0.0i) 1.17520119364380)
+(num-test (sinh -1.0+0.0i) -1.17520119364380)
+(num-test (sinh 1.0-0.0i) 1.17520119364380)
+(num-test (sinh -1.0-0.0i) -1.17520119364380)
+(num-test (sinh 1.0+0.00000001i) 1.17520119364380+0.00000001543081i)
+(num-test (sinh -1.0+0.00000001i) -1.17520119364380+0.00000001543081i)
+(num-test (sinh 1.0-0.00000001i) 1.17520119364380-0.00000001543081i)
+(num-test (sinh -1.0-0.00000001i) -1.17520119364380-0.00000001543081i)
+(num-test (sinh 1.0+1.0i) 0.63496391478474+1.29845758141598i)
+(num-test (sinh -1.0+1.0i) -0.63496391478474+1.29845758141598i)
+(num-test (sinh 1.0-1.0i) 0.63496391478474-1.29845758141598i)
+(num-test (sinh -1.0-1.0i) -0.63496391478474-1.29845758141598i)
+(num-test (sinh 3.14159265358979+0.0i) 11.54873935725775)
+(num-test (sinh -3.14159265358979+0.0i) -11.54873935725775)
+(num-test (sinh 3.14159265358979-0.0i) 11.54873935725775)
+(num-test (sinh -3.14159265358979-0.0i) -11.54873935725775)
+(num-test (sinh 3.14159265358979+0.00000001i) 11.54873935725775+0.00000011591953i)
+(num-test (sinh -3.14159265358979+0.00000001i) -11.54873935725775+0.00000011591953i)
+(num-test (sinh 3.14159265358979-0.00000001i) 11.54873935725775-0.00000011591953i)
+(num-test (sinh -3.14159265358979-0.00000001i) -11.54873935725775-0.00000011591953i)
+(num-test (sinh 3.14159265358979+1.0i) 6.23981050459650+9.75429233860021i)
+(num-test (sinh -3.14159265358979+1.0i) -6.23981050459650+9.75429233860021i)
+(num-test (sinh 3.14159265358979-1.0i) 6.23981050459650-9.75429233860021i)
+(num-test (sinh -3.14159265358979-1.0i) -6.23981050459650-9.75429233860021i)
+(num-test (sinh 1234/3) 2.18155865313939E+178)
+(num-test (sinh 1234/10) 1.953930316004457E+53)
+(num-test (sinh 0.0+3.14159265358979i) 0.0-6.982889851335445E-15i)
+(num-test (sinh 0.00000001+3.14159265358979i) -1.00000000000000003758922749678992050291E-8+3.231089148865173792463232707134864571569E-15i)
+(num-test (sinh 0.00000001+1234.0i) -7.985506235875843E-9+0.6019276547624973i)
+(num-test (sinh 1.0+3.14159265358979i) -1.175201193643801-1.077516210464362E-14i)
+(num-test (sinh 3.14159265358979+3.14159265358979i) -11.54873935725783-8.094533288479446E-14i)
+(num-test (sinh 3.14159265358979+1234.0i) -9.222253015388718+6.977517249251167i)
+(num-test (sinh 0.0e+00-3.45266983001243932001e-04i) 0-3.4526697614140534807e-4i)
+(num-test (sinh 0.0e+00+3.45266983001243932001e-04i) 0+3.4526697614140534807e-4i)
+(num-test (sinh 0.0e+00+1.57045105981189525579e+00i) 0+9.9999994039535581669e-1i)
+(num-test (sinh 0.0e+00-1.57045105981189525579e+00i) 0-9.9999994039535581669e-1i)
+(num-test (sinh 0.0e+00+1.57114159377789786021e+00i) 0+9.9999994039535581673e-1i)
+(num-test (sinh 0.0e+00-1.57114159377789786021e+00i) 0-9.9999994039535581673e-1i)
+(num-test (sinh 0.0e+00+3.14124738660679181379e+00i) 0+3.4526697614158608860e-4i)
+(num-test (sinh 0.0e+00-3.14124738660679181379e+00i) 0-3.4526697614158608860e-4i)
+(num-test (sinh 0.0e+00+3.14193792057279441821e+00i) 0-3.4526697614134115926e-4i)
+(num-test (sinh 0.0e+00-3.14193792057279441821e+00i) 0+3.4526697614134115926e-4i)
+(num-test (sinh 0.0e+00+4.71204371340168837179e+00i) 0-9.9999994039535581664e-1i)
+(num-test (sinh 0.0e+00-4.71204371340168837179e+00i) 0+9.9999994039535581664e-1i)
+(num-test (sinh 0.0e+00+4.71273424736769097620e+00i) 0-9.9999994039535581677e-1i)
+(num-test (sinh 0.0e+00-4.71273424736769097620e+00i) 0+9.9999994039535581677e-1i)
+(num-test (sinh 0.0e+00+6.28284004019658492979e+00i) 0-3.4526697614170855328e-4i)
+(num-test (sinh 0.0e+00-6.28284004019658492979e+00i) 0+3.4526697614170855328e-4i)
+(num-test (sinh 0.0e+00+6.28353057416258753420e+00i) 0+3.4526697614121869459e-4i)
+(num-test (sinh 0.0e+00-6.28353057416258753420e+00i) 0-3.4526697614121869459e-4i)
+(num-test (sinh 0.0e+00+9.42443269378637893396e+00i) 0+3.4526697614094283958e-4i)
+(num-test (sinh 0.0e+00-9.42443269378637893396e+00i) 0-3.4526697614094283958e-4i)
+(num-test (sinh 0.0e+00+9.42512322775237976202e+00i) 0-3.4526697614020805155e-4i)
+(num-test (sinh 0.0e+00-9.42512322775237976202e+00i) 0+3.4526697614020805155e-4i)
+(num-test (sinh 1.19209289550781250e-07-3.45266983001243932001e-04i) 1.1920928244535424533e-7-3.4526697614140780134e-4i)
+(num-test (sinh 1.19209289550781250e-07+3.45266983001243932001e-04i) 1.1920928244535424533e-7+3.4526697614140780134e-4i)
+(num-test (sinh -1.19209289550781250e-07-3.45266983001243932001e-04i) -1.1920928244535424533e-7-3.4526697614140780134e-4i)
+(num-test (sinh -1.19209289550781250e-07+3.45266983001243932001e-04i) -1.1920928244535424533e-7+3.4526697614140780134e-4i)
+(num-test (sinh 1.19209289550781250e-07+1.57045105981189525579e+00i) 4.1159030931177815679e-11+9.9999994039536292211e-1i)
+(num-test (sinh 1.19209289550781250e-07-1.57045105981189525579e+00i) 4.1159030931177815679e-11-9.9999994039536292211e-1i)
+(num-test (sinh -1.19209289550781250e-07+1.57045105981189525579e+00i) -4.1159030931177815679e-11+9.9999994039536292211e-1i)
+(num-test (sinh -1.19209289550781250e-07-1.57045105981189525579e+00i) -4.1159030931177815679e-11-9.9999994039536292211e-1i)
+(num-test (sinh 1.19209289550781250e-07+1.57114159377789786021e+00i) -4.1159030931163216752e-11+9.9999994039536292216e-1i)
+(num-test (sinh 1.19209289550781250e-07-1.57114159377789786021e+00i) -4.1159030931163216752e-11-9.9999994039536292216e-1i)
+(num-test (sinh -1.19209289550781250e-07+1.57114159377789786021e+00i) 4.1159030931163216752e-11+9.9999994039536292216e-1i)
+(num-test (sinh -1.19209289550781250e-07-1.57114159377789786021e+00i) 4.1159030931163216752e-11-9.9999994039536292216e-1i)
+(num-test (sinh 1.19209289550781250e-07+3.14124738660679181379e+00i) -1.1920928244535424532e-7+3.4526697614158854187e-4i)
+(num-test (sinh 1.19209289550781250e-07-3.14124738660679181379e+00i) -1.1920928244535424532e-7-3.4526697614158854187e-4i)
+(num-test (sinh -1.19209289550781250e-07+3.14124738660679181379e+00i) 1.1920928244535424532e-7+3.4526697614158854187e-4i)
+(num-test (sinh -1.19209289550781250e-07-3.14124738660679181379e+00i) 1.1920928244535424532e-7-3.4526697614158854187e-4i)
+(num-test (sinh 1.19209289550781250e-07+3.14193792057279441821e+00i) -1.1920928244535424533e-7-3.4526697614134361253e-4i)
+(num-test (sinh 1.19209289550781250e-07-3.14193792057279441821e+00i) -1.1920928244535424533e-7+3.4526697614134361253e-4i)
+(num-test (sinh -1.19209289550781250e-07+3.14193792057279441821e+00i) 1.1920928244535424533e-7-3.4526697614134361253e-4i)
+(num-test (sinh -1.19209289550781250e-07-3.14193792057279441821e+00i) 1.1920928244535424533e-7+3.4526697614134361253e-4i)
+(num-test (sinh 1.19209289550781250e-07+4.71204371340168837179e+00i) -4.1159030931192414605e-11-9.9999994039536292207e-1i)
+(num-test (sinh 1.19209289550781250e-07-4.71204371340168837179e+00i) -4.1159030931192414605e-11+9.9999994039536292207e-1i)
+(num-test (sinh -1.19209289550781250e-07+4.71204371340168837179e+00i) 4.1159030931192414605e-11-9.9999994039536292207e-1i)
+(num-test (sinh -1.19209289550781250e-07-4.71204371340168837179e+00i) 4.1159030931192414605e-11+9.9999994039536292207e-1i)
+(num-test (sinh 1.19209289550781250e-07+4.71273424736769097620e+00i) 4.1159030931148617825e-11-9.9999994039536292220e-1i)
+(num-test (sinh 1.19209289550781250e-07-4.71273424736769097620e+00i) 4.1159030931148617825e-11+9.9999994039536292220e-1i)
+(num-test (sinh -1.19209289550781250e-07+4.71273424736769097620e+00i) -4.1159030931148617825e-11-9.9999994039536292220e-1i)
+(num-test (sinh -1.19209289550781250e-07-4.71273424736769097620e+00i) -4.1159030931148617825e-11+9.9999994039536292220e-1i)
+(num-test (sinh 1.19209289550781250e-07+6.28284004019658492979e+00i) 1.1920928244535424532e-7-3.4526697614171100655e-4i)
+(num-test (sinh 1.19209289550781250e-07-6.28284004019658492979e+00i) 1.1920928244535424532e-7+3.4526697614171100655e-4i)
+(num-test (sinh -1.19209289550781250e-07+6.28284004019658492979e+00i) -1.1920928244535424532e-7-3.4526697614171100655e-4i)
+(num-test (sinh -1.19209289550781250e-07-6.28284004019658492979e+00i) -1.1920928244535424532e-7+3.4526697614171100655e-4i)
+(num-test (sinh 1.19209289550781250e-07+6.28353057416258753420e+00i) 1.1920928244535424534e-7+3.4526697614122114786e-4i)
+(num-test (sinh 1.19209289550781250e-07-6.28353057416258753420e+00i) 1.1920928244535424534e-7-3.4526697614122114786e-4i)
+(num-test (sinh -1.19209289550781250e-07+6.28353057416258753420e+00i) -1.1920928244535424534e-7+3.4526697614122114786e-4i)
+(num-test (sinh -1.19209289550781250e-07-6.28353057416258753420e+00i) -1.1920928244535424534e-7-3.4526697614122114786e-4i)
+(num-test (sinh 1.19209289550781250e-07+9.42443269378637893396e+00i) -1.1920928244535424535e-7+3.4526697614094529285e-4i)
+(num-test (sinh 1.19209289550781250e-07-9.42443269378637893396e+00i) -1.1920928244535424535e-7-3.4526697614094529285e-4i)
+(num-test (sinh -1.19209289550781250e-07+9.42443269378637893396e+00i) 1.1920928244535424535e-7+3.4526697614094529285e-4i)
+(num-test (sinh -1.19209289550781250e-07-9.42443269378637893396e+00i) 1.1920928244535424535e-7-3.4526697614094529285e-4i)
+(num-test (sinh 1.19209289550781250e-07+9.42512322775237976202e+00i) -1.1920928244535424538e-7-3.4526697614021050482e-4i)
+(num-test (sinh 1.19209289550781250e-07-9.42512322775237976202e+00i) -1.1920928244535424538e-7+3.4526697614021050482e-4i)
+(num-test (sinh -1.19209289550781250e-07+9.42512322775237976202e+00i) 1.1920928244535424538e-7-3.4526697614021050482e-4i)
+(num-test (sinh -1.19209289550781250e-07-9.42512322775237976202e+00i) 1.1920928244535424538e-7+3.4526697614021050482e-4i)
+(num-test (sinh 5.0e-01-3.45266983001243932001e-04i) 5.2109527443404709209e-1-3.8933200722534065172e-4i)
+(num-test (sinh 5.0e-01+3.45266983001243932001e-04i) 5.2109527443404709209e-1+3.8933200722534065172e-4i)
+(num-test (sinh -5.0e-01-3.45266983001243932001e-04i) -5.2109527443404709209e-1-3.8933200722534065172e-4i)
+(num-test (sinh -5.0e-01+3.45266983001243932001e-04i) -5.2109527443404709209e-1+3.8933200722534065172e-4i)
+(num-test (sinh 5.0e-01+1.57045105981189525579e+00i) 1.7991700040937027667e-4+1.1276258979946363572e0i)
+(num-test (sinh 5.0e-01-1.57045105981189525579e+00i) 1.7991700040937027667e-4-1.1276258979946363572e0i)
+(num-test (sinh -5.0e-01+1.57045105981189525579e+00i) -1.7991700040937027667e-4+1.1276258979946363572e0i)
+(num-test (sinh -5.0e-01-1.57045105981189525579e+00i) -1.7991700040937027667e-4-1.1276258979946363572e0i)
+(num-test (sinh 5.0e-01+1.57114159377789786021e+00i) -1.7991700040930646090e-4+1.1276258979946363573e0i)
+(num-test (sinh 5.0e-01-1.57114159377789786021e+00i) -1.7991700040930646090e-4-1.1276258979946363573e0i)
+(num-test (sinh -5.0e-01+1.57114159377789786021e+00i) 1.7991700040930646090e-4+1.1276258979946363573e0i)
+(num-test (sinh -5.0e-01-1.57114159377789786021e+00i) 1.7991700040930646090e-4-1.1276258979946363573e0i)
+(num-test (sinh 5.0e-01+3.14124738660679181379e+00i) -5.2109527443404709206e-1+3.8933200722554445944e-4i)
+(num-test (sinh 5.0e-01-3.14124738660679181379e+00i) -5.2109527443404709206e-1-3.8933200722554445944e-4i)
+(num-test (sinh -5.0e-01+3.14124738660679181379e+00i) 5.2109527443404709206e-1+3.8933200722554445944e-4i)
+(num-test (sinh -5.0e-01-3.14124738660679181379e+00i) 5.2109527443404709206e-1-3.8933200722554445944e-4i)
+(num-test (sinh 5.0e-01+3.14193792057279441821e+00i) -5.2109527443404709211e-1-3.8933200722526827075e-4i)
+(num-test (sinh 5.0e-01-3.14193792057279441821e+00i) -5.2109527443404709211e-1+3.8933200722526827075e-4i)
+(num-test (sinh -5.0e-01+3.14193792057279441821e+00i) 5.2109527443404709211e-1-3.8933200722526827075e-4i)
+(num-test (sinh -5.0e-01-3.14193792057279441821e+00i) 5.2109527443404709211e-1+3.8933200722526827075e-4i)
+(num-test (sinh 5.0e-01+4.71204371340168837179e+00i) -1.7991700040943409243e-4-1.1276258979946363572e0i)
+(num-test (sinh 5.0e-01-4.71204371340168837179e+00i) -1.7991700040943409243e-4+1.1276258979946363572e0i)
+(num-test (sinh -5.0e-01+4.71204371340168837179e+00i) 1.7991700040943409243e-4-1.1276258979946363572e0i)
+(num-test (sinh -5.0e-01-4.71204371340168837179e+00i) 1.7991700040943409243e-4+1.1276258979946363572e0i)
+(num-test (sinh 5.0e-01+4.71273424736769097620e+00i) 1.7991700040924264514e-4-1.1276258979946363573e0i)
+(num-test (sinh 5.0e-01-4.71273424736769097620e+00i) 1.7991700040924264514e-4+1.1276258979946363573e0i)
+(num-test (sinh -5.0e-01+4.71273424736769097620e+00i) -1.7991700040924264514e-4-1.1276258979946363573e0i)
+(num-test (sinh -5.0e-01-4.71273424736769097620e+00i) -1.7991700040924264514e-4+1.1276258979946363573e0i)
+(num-test (sinh 5.0e-01+6.28284004019658492979e+00i) 5.2109527443404709204e-1-3.8933200722568255379e-4i)
+(num-test (sinh 5.0e-01-6.28284004019658492979e+00i) 5.2109527443404709204e-1+3.8933200722568255379e-4i)
+(num-test (sinh -5.0e-01+6.28284004019658492979e+00i) -5.2109527443404709204e-1-3.8933200722568255379e-4i)
+(num-test (sinh -5.0e-01-6.28284004019658492979e+00i) -5.2109527443404709204e-1+3.8933200722568255379e-4i)
+(num-test (sinh 5.0e-01+6.28353057416258753420e+00i) 5.2109527443404709213e-1+3.8933200722513017641e-4i)
+(num-test (sinh 5.0e-01-6.28353057416258753420e+00i) 5.2109527443404709213e-1-3.8933200722513017641e-4i)
+(num-test (sinh -5.0e-01+6.28353057416258753420e+00i) -5.2109527443404709213e-1+3.8933200722513017641e-4i)
+(num-test (sinh -5.0e-01-6.28353057416258753420e+00i) -5.2109527443404709213e-1-3.8933200722513017641e-4i)
+(num-test (sinh 5.0e-01+9.42443269378637893396e+00i) -5.2109527443404709218e-1+3.8933200722481911514e-4i)
+(num-test (sinh 5.0e-01-9.42443269378637893396e+00i) -5.2109527443404709218e-1-3.8933200722481911514e-4i)
+(num-test (sinh -5.0e-01+9.42443269378637893396e+00i) 5.2109527443404709218e-1+3.8933200722481911514e-4i)
+(num-test (sinh -5.0e-01-9.42443269378637893396e+00i) 5.2109527443404709218e-1-3.8933200722481911514e-4i)
+(num-test (sinh 5.0e-01+9.42512322775237976202e+00i) -5.2109527443404709231e-1-3.8933200722399054908e-4i)
+(num-test (sinh 5.0e-01-9.42512322775237976202e+00i) -5.2109527443404709231e-1+3.8933200722399054908e-4i)
+(num-test (sinh -5.0e-01+9.42512322775237976202e+00i) 5.2109527443404709231e-1-3.8933200722399054908e-4i)
+(num-test (sinh -5.0e-01-9.42512322775237976202e+00i) 5.2109527443404709231e-1+3.8933200722399054908e-4i)
+(num-test (sinh 1.0e+00-3.45266983001243932001e-04i) 1.1752011235963524660e0-5.3277478472501939236e-4i)
+(num-test (sinh 1.0e+00+3.45266983001243932001e-04i) 1.1752011235963524660e0+5.3277478472501939236e-4i)
+(num-test (sinh -1.0e+00-3.45266983001243932001e-04i) -1.1752011235963524660e0-5.3277478472501939236e-4i)
+(num-test (sinh -1.0e+00+3.45266983001243932001e-04i) -1.1752011235963524660e0+5.3277478472501939236e-4i)
+(num-test (sinh 1.0e+00+1.57045105981189525579e+00i) 4.0575816248730593018e-4+1.5430805428404715942e0i)
+(num-test (sinh 1.0e+00-1.57045105981189525579e+00i) 4.0575816248730593018e-4-1.5430805428404715942e0i)
+(num-test (sinh -1.0e+00+1.57045105981189525579e+00i) -4.0575816248730593018e-4+1.5430805428404715942e0i)
+(num-test (sinh -1.0e+00-1.57045105981189525579e+00i) -4.0575816248730593018e-4-1.5430805428404715942e0i)
+(num-test (sinh 1.0e+00+1.57114159377789786021e+00i) -4.0575816248716200955e-4+1.5430805428404715942e0i)
+(num-test (sinh 1.0e+00-1.57114159377789786021e+00i) -4.0575816248716200955e-4-1.5430805428404715942e0i)
+(num-test (sinh -1.0e+00+1.57114159377789786021e+00i) 4.0575816248716200955e-4+1.5430805428404715942e0i)
+(num-test (sinh -1.0e+00-1.57114159377789786021e+00i) 4.0575816248716200955e-4-1.5430805428404715942e0i)
+(num-test (sinh 1.0e+00+3.14124738660679181379e+00i) -1.1752011235963524659e0+5.3277478472529828958e-4i)
+(num-test (sinh 1.0e+00-3.14124738660679181379e+00i) -1.1752011235963524659e0-5.3277478472529828958e-4i)
+(num-test (sinh -1.0e+00+3.14124738660679181379e+00i) 1.1752011235963524659e0+5.3277478472529828958e-4i)
+(num-test (sinh -1.0e+00-3.14124738660679181379e+00i) 1.1752011235963524659e0-5.3277478472529828958e-4i)
+(num-test (sinh 1.0e+00+3.14193792057279441821e+00i) -1.1752011235963524660e0-5.3277478472492034385e-4i)
+(num-test (sinh 1.0e+00-3.14193792057279441821e+00i) -1.1752011235963524660e0+5.3277478472492034385e-4i)
+(num-test (sinh -1.0e+00+3.14193792057279441821e+00i) 1.1752011235963524660e0-5.3277478472492034385e-4i)
+(num-test (sinh -1.0e+00-3.14193792057279441821e+00i) 1.1752011235963524660e0+5.3277478472492034385e-4i)
+(num-test (sinh 1.0e+00+4.71204371340168837179e+00i) -4.0575816248744985081e-4-1.5430805428404715941e0i)
+(num-test (sinh 1.0e+00-4.71204371340168837179e+00i) -4.0575816248744985081e-4+1.5430805428404715941e0i)
+(num-test (sinh -1.0e+00+4.71204371340168837179e+00i) 4.0575816248744985081e-4-1.5430805428404715941e0i)
+(num-test (sinh -1.0e+00-4.71204371340168837179e+00i) 4.0575816248744985081e-4+1.5430805428404715941e0i)
+(num-test (sinh 1.0e+00+4.71273424736769097620e+00i) 4.0575816248701808892e-4-1.5430805428404715943e0i)
+(num-test (sinh 1.0e+00-4.71273424736769097620e+00i) 4.0575816248701808892e-4+1.5430805428404715943e0i)
+(num-test (sinh -1.0e+00+4.71273424736769097620e+00i) -4.0575816248701808892e-4-1.5430805428404715943e0i)
+(num-test (sinh -1.0e+00-4.71273424736769097620e+00i) -4.0575816248701808892e-4+1.5430805428404715943e0i)
+(num-test (sinh 1.0e+00+6.28284004019658492979e+00i) 1.1752011235963524659e0-5.3277478472548726245e-4i)
+(num-test (sinh 1.0e+00-6.28284004019658492979e+00i) 1.1752011235963524659e0+5.3277478472548726245e-4i)
+(num-test (sinh -1.0e+00+6.28284004019658492979e+00i) -1.1752011235963524659e0-5.3277478472548726245e-4i)
+(num-test (sinh -1.0e+00-6.28284004019658492979e+00i) -1.1752011235963524659e0+5.3277478472548726245e-4i)
+(num-test (sinh 1.0e+00+6.28353057416258753420e+00i) 1.1752011235963524661e0+5.3277478472473137099e-4i)
+(num-test (sinh 1.0e+00-6.28353057416258753420e+00i) 1.1752011235963524661e0-5.3277478472473137099e-4i)
+(num-test (sinh -1.0e+00+6.28353057416258753420e+00i) -1.1752011235963524661e0+5.3277478472473137099e-4i)
+(num-test (sinh -1.0e+00-6.28353057416258753420e+00i) -1.1752011235963524661e0-5.3277478472473137099e-4i)
+(num-test (sinh 1.0e+00+9.42443269378637893396e+00i) -1.1752011235963524662e0+5.3277478472430570447e-4i)
+(num-test (sinh 1.0e+00-9.42443269378637893396e+00i) -1.1752011235963524662e0-5.3277478472430570447e-4i)
+(num-test (sinh -1.0e+00+9.42443269378637893396e+00i) 1.1752011235963524662e0+5.3277478472430570447e-4i)
+(num-test (sinh -1.0e+00-9.42443269378637893396e+00i) 1.1752011235963524662e0-5.3277478472430570447e-4i)
+(num-test (sinh 1.0e+00+9.42512322775237976202e+00i) -1.1752011235963524665e0-5.3277478472317186729e-4i)
+(num-test (sinh 1.0e+00-9.42512322775237976202e+00i) -1.1752011235963524665e0+5.3277478472317186729e-4i)
+(num-test (sinh -1.0e+00+9.42512322775237976202e+00i) 1.1752011235963524665e0-5.3277478472317186729e-4i)
+(num-test (sinh -1.0e+00-9.42512322775237976202e+00i) 1.1752011235963524665e0+5.3277478472317186729e-4i)
+(num-test (sinh 2.0e+00-3.45266983001243932001e-04i) 3.6268601916692946556e0-1.2989619299126701883e-3i)
+(num-test (sinh 2.0e+00+3.45266983001243932001e-04i) 3.6268601916692946556e0+1.2989619299126701883e-3i)
+(num-test (sinh -2.0e+00-3.45266983001243932001e-04i) -3.6268601916692946556e0-1.2989619299126701883e-3i)
+(num-test (sinh -2.0e+00+3.45266983001243932001e-04i) -3.6268601916692946556e0+1.2989619299126701883e-3i)
+(num-test (sinh 2.0e+00+1.57045105981189525579e+00i) 1.2522351259047577385e-3+3.7621954668392959445e0i)
+(num-test (sinh 2.0e+00-1.57045105981189525579e+00i) 1.2522351259047577385e-3-3.7621954668392959445e0i)
+(num-test (sinh -2.0e+00+1.57045105981189525579e+00i) -1.2522351259047577385e-3+3.7621954668392959445e0i)
+(num-test (sinh -2.0e+00-1.57045105981189525579e+00i) -1.2522351259047577385e-3-3.7621954668392959445e0i)
+(num-test (sinh 2.0e+00+1.57114159377789786021e+00i) -1.2522351259043135762e-3+3.7621954668392959447e0i)
+(num-test (sinh 2.0e+00-1.57114159377789786021e+00i) -1.2522351259043135762e-3-3.7621954668392959447e0i)
+(num-test (sinh -2.0e+00+1.57114159377789786021e+00i) 1.2522351259043135762e-3+3.7621954668392959447e0i)
+(num-test (sinh -2.0e+00-1.57114159377789786021e+00i) 1.2522351259043135762e-3-3.7621954668392959447e0i)
+(num-test (sinh 2.0e+00+3.14124738660679181379e+00i) -3.6268601916692946553e0+1.2989619299133501696e-3i)
+(num-test (sinh 2.0e+00-3.14124738660679181379e+00i) -3.6268601916692946553e0-1.2989619299133501696e-3i)
+(num-test (sinh -2.0e+00+3.14124738660679181379e+00i) 3.6268601916692946553e0+1.2989619299133501696e-3i)
+(num-test (sinh -2.0e+00-3.14124738660679181379e+00i) 3.6268601916692946553e0-1.2989619299133501696e-3i)
+(num-test (sinh 2.0e+00+3.14193792057279441821e+00i) -3.6268601916692946556e0-1.2989619299124286975e-3i)
+(num-test (sinh 2.0e+00-3.14193792057279441821e+00i) -3.6268601916692946556e0+1.2989619299124286975e-3i)
+(num-test (sinh -2.0e+00+3.14193792057279441821e+00i) 3.6268601916692946556e0-1.2989619299124286975e-3i)
+(num-test (sinh -2.0e+00-3.14193792057279441821e+00i) 3.6268601916692946556e0+1.2989619299124286975e-3i)
+(num-test (sinh 2.0e+00+4.71204371340168837179e+00i) -1.2522351259052019007e-3-3.7621954668392959444e0i)
+(num-test (sinh 2.0e+00-4.71204371340168837179e+00i) -1.2522351259052019007e-3+3.7621954668392959444e0i)
+(num-test (sinh -2.0e+00+4.71204371340168837179e+00i) 1.2522351259052019007e-3-3.7621954668392959444e0i)
+(num-test (sinh -2.0e+00-4.71204371340168837179e+00i) 1.2522351259052019007e-3+3.7621954668392959444e0i)
+(num-test (sinh 2.0e+00+4.71273424736769097620e+00i) 1.2522351259038694139e-3-3.7621954668392959448e0i)
+(num-test (sinh 2.0e+00-4.71273424736769097620e+00i) 1.2522351259038694139e-3+3.7621954668392959448e0i)
+(num-test (sinh -2.0e+00+4.71273424736769097620e+00i) -1.2522351259038694139e-3-3.7621954668392959448e0i)
+(num-test (sinh -2.0e+00-4.71273424736769097620e+00i) -1.2522351259038694139e-3+3.7621954668392959448e0i)
+(num-test (sinh 2.0e+00+6.28284004019658492979e+00i) 3.6268601916692946552e0-1.2989619299138109057e-3i)
+(num-test (sinh 2.0e+00-6.28284004019658492979e+00i) 3.6268601916692946552e0+1.2989619299138109057e-3i)
+(num-test (sinh -2.0e+00+6.28284004019658492979e+00i) -3.6268601916692946552e0-1.2989619299138109057e-3i)
+(num-test (sinh -2.0e+00-6.28284004019658492979e+00i) -3.6268601916692946552e0+1.2989619299138109057e-3i)
+(num-test (sinh 2.0e+00+6.28353057416258753420e+00i) 3.6268601916692946558e0+1.2989619299119679614e-3i)
+(num-test (sinh 2.0e+00-6.28353057416258753420e+00i) 3.6268601916692946558e0-1.2989619299119679614e-3i)
+(num-test (sinh -2.0e+00+6.28353057416258753420e+00i) -3.6268601916692946558e0+1.2989619299119679614e-3i)
+(num-test (sinh -2.0e+00-6.28353057416258753420e+00i) -3.6268601916692946558e0-1.2989619299119679614e-3i)
+(num-test (sinh 2.0e+00+9.42443269378637893396e+00i) -3.6268601916692946561e0+1.2989619299109301409e-3i)
+(num-test (sinh 2.0e+00-9.42443269378637893396e+00i) -3.6268601916692946561e0-1.2989619299109301409e-3i)
+(num-test (sinh -2.0e+00+9.42443269378637893396e+00i) 3.6268601916692946561e0+1.2989619299109301409e-3i)
+(num-test (sinh -2.0e+00-9.42443269378637893396e+00i) 3.6268601916692946561e0-1.2989619299109301409e-3i)
+(num-test (sinh 2.0e+00+9.42512322775237976202e+00i) -3.6268601916692946571e0-1.2989619299081657245e-3i)
+(num-test (sinh 2.0e+00-9.42512322775237976202e+00i) -3.6268601916692946571e0+1.2989619299081657245e-3i)
+(num-test (sinh -2.0e+00+9.42512322775237976202e+00i) 3.6268601916692946571e0-1.2989619299081657245e-3i)
+(num-test (sinh -2.0e+00-9.42512322775237976202e+00i) 3.6268601916692946571e0+1.2989619299081657245e-3i)
+(num-test (sinh 0) 0.0)
+(num-test (sinh 0+i) (* 0+i (sin 1)))
+(num-test (sinh -2.225073858507201399999999999999999999996E-308) -2.225073858507201399999999999999999999996E-308)
+(num-test (sinh 1.110223024625156799999999999999999999997E-16) 1.110223024625156800000000000000002280754E-16)
+(num-test (sinh 1/9223372036854775807) 1.084202172485504434125002235952170462235E-19)
+
+(for-each
+ (lambda (num-and-val)
+   (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'sinh num (sinh num) val)))
+ (vector (list 0 0) (list 1 1.1752011936438) (list 2 3.626860407847) (list 3 10.01787492741)
+	 (list -1 -1.1752011936438) (list -2 -3.626860407847) (list -3 -10.01787492741) (list 1/2 0.52109530549375)
+	 (list 1/3 0.33954055725615) (list -1/2 -0.52109530549375) (list -1/3 -0.33954055725615)
+	 (list 1/9223372036854775807 1.0842021724855e-19) (list 0.0 0.0) (list 1.0 1.1752011936438)
+	 (list 2.0 3.626860407847) (list -2.0 -3.626860407847) (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309)
+	 (list 0+1i 0+0.8414709848079i) (list 0+2i -0+0.90929742682568i) (list 0-1i 0-0.8414709848079i)
+	 (list 1+1i 0.63496391478474+1.298457581416i) (list 1-1i 0.63496391478474-1.298457581416i)
+	 (list -1+1i -0.63496391478474+1.298457581416i) (list -1-1i -0.63496391478474-1.298457581416i)
+	 (list 0.1+0.1i 0.099666333492108+0.10033299984131i) (list 1e-16+1e-16i 1e-16+1e-16i)
+	 ))
+
+(test (sinh) 'error)
+(test (sinh "hi") 'error)
+(test (sinh 1.0+23.0i 1.0+23.0i) 'error)
+(test (sinh 0 1) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (sinh arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; cosh
+;;; --------------------------------------------------------------------------------
+
+(num-test (cosh 0) 1.0)
+(num-test (cosh 1) 1.54308063481524)
+(num-test (cosh 2) 3.76219569108363)
+(num-test (cosh 3) 10.06766199577777)
+(num-test (cosh 10) 11013.23292010332261)
+(num-test (cosh 0/1) 1.0)
+(num-test (cosh 0/2) 1.0)
+(num-test (cosh 0/3) 1.0)
+(num-test (cosh 0/10) 1.0)
+(num-test (cosh 0/1234) 1.0)
+(num-test (cosh 0/500029) 1.0)
+(num-test (cosh 1/1) 1.54308063481524)
+(num-test (cosh 1/2) 1.12762596520638)
+(num-test (cosh -1/2) 1.12762596520638)
+(num-test (cosh 1/3) 1.05607186782994)
+(num-test (cosh -1/3) 1.05607186782994)
+(num-test (cosh 1/10) 1.00500416805580)
+(num-test (cosh -1/10) 1.00500416805580)
+(num-test (cosh 1/1234) 1.00000032835203)
+(num-test (cosh -1/1234) 1.00000032835203)
+(num-test (cosh 1/500029) 1.00000000000200)
+(num-test (cosh -1/500029) 1.00000000000200)
+(num-test (cosh 2/1) 3.76219569108363)
+(num-test (cosh 2/2) 1.54308063481524)
+(num-test (cosh 2/3) 1.23057558004363)
+(num-test (cosh 2/10) 1.02006675561908)
+(num-test (cosh -2/10) 1.02006675561908)
+(num-test (cosh 2/1234) 1.00000131340834)
+(num-test (cosh -2/1234) 1.00000131340834)
+(num-test (cosh 2/500029) 1.00000000000800)
+(num-test (cosh -2/500029) 1.00000000000800)
+(num-test (cosh 3/1) 10.06766199577777)
+(num-test (cosh 3/2) 2.35240961524325)
+(num-test (cosh 3/3) 1.54308063481524)
+(num-test (cosh 3/10) 1.04533851412886)
+(num-test (cosh -3/10) 1.04533851412886)
+(num-test (cosh 3/1234) 1.00000295516958)
+(num-test (cosh -3/1234) 1.00000295516958)
+(num-test (cosh 3/500029) 1.00000000001800)
+(num-test (cosh -3/500029) 1.00000000001800)
+(num-test (cosh 10/1) 11013.23292010332261)
+(num-test (cosh 10/2) 74.20994852478785)
+(num-test (cosh 10/3) 14.03364944393670)
+(num-test (cosh 10/10) 1.54308063481524)
+(num-test (cosh 10/1234) 1.00003283538113)
+(num-test (cosh -10/1234) 1.00003283538113)
+(num-test (cosh 10/500029) 1.00000000019998)
+(num-test (cosh -10/500029) 1.00000000019998)
+(num-test (cosh 1234/500029) 1.00000304516030)
+(num-test (cosh -1234/500029) 1.00000304516030)
+(num-test (cosh 500029/500029) 1.54308063481524)
+(num-test (cosh 0.0) 1.0)
+(num-test (cosh 0.00000001) 1.0)
+(num-test (cosh -0.00000001) 1.0)
+(num-test (cosh 1.0) 1.54308063481524)
+(num-test (cosh pi) 11.59195327552152)
+(num-test (cosh 0.0+0.0i) 1.0)
+(num-test (cosh -0.0+0.0i) 1.0)
+(num-test (cosh 0.0-0.0i) 1.0)
+(num-test (cosh -0.0-0.0i) 1.0)
+(num-test (cosh 0.0+0.00000001i) 1.0)
+(num-test (cosh -0.0+0.00000001i) 1.0)
+(num-test (cosh 0.0-0.00000001i) 1.0)
+(num-test (cosh -0.0-0.00000001i) 1.0)
+(num-test (cosh 0.0+1.0i) 0.54030230586814)
+(num-test (cosh -0.0+1.0i) 0.54030230586814)
+(num-test (cosh 0.0-1.0i) 0.54030230586814)
+(num-test (cosh 0.0+3.14159265358979i) -1.0)
+(num-test (cosh -0.0+3.14159265358979i) -1.0)
+(num-test (cosh 0.0-3.14159265358979i) -1.0)
+(num-test (cosh 0.00000001+0.0i) 1.0)
+(num-test (cosh -0.00000001+0.0i) 1.0)
+(num-test (cosh 0.00000001-0.0i) 1.0)
+(num-test (cosh -0.00000001-0.0i) 1.0)
+(num-test (cosh 0.00000001+0.00000001i) 1.0+1e-16i) ; maxima
+(num-test (cosh -0.00000001+0.00000001i) 1.0-1e-16i)
+(num-test (cosh 0.00000001-0.00000001i) 1.0-1e-16i)
+(num-test (cosh -0.00000001-0.00000001i) 1.0+1e-16i)
+(num-test (cosh 0.00000001+1.0i) 0.54030230586814+0.00000000841471i)
+(num-test (cosh 0.00000001-1.0i) 0.54030230586814-0.00000000841471i)
+(num-test (cosh 0.00000001+3.14159265358979i) -1.0-6.982889851335445E-23i) ;maxima -- stopped here
+(num-test (cosh 0.00000001-3.14159265358979i) -1.0-0.0i)
+(num-test (cosh 1.0+0.0i) 1.54308063481524)
+(num-test (cosh 1.0-0.0i) 1.54308063481524)
+(num-test (cosh 1.0+0.00000001i) 1.54308063481524+0.00000001175201i)
+(num-test (cosh 1.0-0.00000001i) 1.54308063481524-0.00000001175201i)
+(num-test (cosh 1.0+1.0i) 0.83373002513115+0.98889770576287i)
+(num-test (cosh 1.0-1.0i) 0.83373002513115-0.98889770576287i)
+(num-test (cosh 1.0+3.14159265358979i) -1.54308063481524+0.0i)
+(num-test (cosh 1.0-3.14159265358979i) -1.54308063481524-0.0i)
+(num-test (cosh 3.14159265358979+0.0i) 11.59195327552152)
+(num-test (cosh 3.14159265358979-0.0i) 11.59195327552152)
+(num-test (cosh 3.14159265358979+0.00000001i) 11.59195327552152+0.00000011548739i)
+(num-test (cosh 3.14159265358979-0.00000001i) 11.59195327552152-0.00000011548739i)
+(num-test (cosh 3.14159265358979+1.0i) 6.26315908428001+9.71792908024139i)
+(num-test (cosh 3.14159265358979-1.0i) 6.26315908428001-9.71792908024139i)
+(num-test (cosh 3.14159265358979+3.14159265358979i) -11.59195327552152+0.0i)
+(num-test (cosh 3.14159265358979-3.14159265358979i) -11.59195327552152-0.0i)
+(num-test (cosh -2/3) 1.230575580043636)
+(num-test (cosh -3/2) 2.352409615243247)
+(num-test (cosh -10/3) 14.03364944393623)
+(num-test (cosh 1234/3) 2.18155865313939E+178)
+(num-test (cosh 1234/10) 1.953930316004457E+53)
+(num-test (cosh 500029/1234) 4.77955809407816E+175)
+(num-test (cosh -3.14159265358979) 11.5919532755216)
+(num-test (cosh 0.0+3.14159265358979i) -1.0)
+(num-test (cosh 0.00000001+1.0i) +0.5403023058681398+8.414709848078964E-9i)
+(num-test (cosh 0.00000001+3.14159265358979i) -1.0-6.982889851335445E-23i)
+(num-test (cosh 0.00000001+1234.0i) -0.7985506235875843+6.019276547624973E-9i)
+(num-test (cosh 1.0+0.00000001i) +1.543080634815244+1.1752011936438014E-8i)
+(num-test (cosh 1.0+3.14159265358979i) -1.543080634815244-8.206300488372603E-15i)
+(num-test (cosh 3.14159265358979+0.0i) 11.5919532755216)
+(num-test (cosh 3.14159265358979+0.00000001i) +11.5919532755216+1.154873935725783E-7i)
+(num-test (cosh 3.14159265358979+1.0i) +6.263159084280057+9.71792908024146i)
+(num-test (cosh 3.14159265358979+3.14159265358979i) -11.5919532755216-8.064357485351393E-14i)
+(num-test (cosh 3.14159265358979+1234.0i) -9.256761516765916+6.951505596777556i)
+(num-test (cosh 0.0e+00-3.45266983001243932001e-04i) 9.9999994039535581673e-1+0.0i)
+(num-test (cosh 0.0e+00+3.45266983001243932001e-04i) 9.9999994039535581673e-1+0.0i)
+(num-test (cosh 0.0e+00+1.57045105981189525579e+00i) 3.4526697614152485627e-4+0.0i)
+(num-test (cosh 0.0e+00-1.57045105981189525579e+00i) 3.4526697614152485627e-4+0.0i)
+(num-test (cosh 0.0e+00+1.57114159377789786021e+00i) -3.4526697614140239160e-4+0.0i)
+(num-test (cosh 0.0e+00-1.57114159377789786021e+00i) -3.4526697614140239160e-4+0.0i)
+(num-test (cosh 0.0e+00+3.14124738660679181379e+00i) -9.9999994039535581667e-1+0.0i)
+(num-test (cosh 0.0e+00-3.14124738660679181379e+00i) -9.9999994039535581667e-1+0.0i)
+(num-test (cosh 0.0e+00+3.14193792057279441821e+00i) -9.9999994039535581675e-1+0.0i)
+(num-test (cosh 0.0e+00-3.14193792057279441821e+00i) -9.9999994039535581675e-1+0.0i)
+(num-test (cosh 0.0e+00+4.71204371340168837179e+00i) -3.4526697614164732094e-4+0.0i)
+(num-test (cosh 0.0e+00-4.71204371340168837179e+00i) -3.4526697614164732094e-4+0.0i)
+(num-test (cosh 0.0e+00+4.71273424736769097620e+00i) 3.4526697614127992692e-4+0.0i)
+(num-test (cosh 0.0e+00-4.71273424736769097620e+00i) 3.4526697614127992692e-4+0.0i)
+(num-test (cosh 0.0e+00+6.28284004019658492979e+00i) 9.9999994039535581662e-1+0.0i)
+(num-test (cosh 0.0e+00-6.28284004019658492979e+00i) 9.9999994039535581662e-1+0.0i)
+(num-test (cosh 0.0e+00+6.28353057416258753420e+00i) 9.9999994039535581679e-1+0.0i)
+(num-test (cosh 0.0e+00-6.28353057416258753420e+00i) 9.9999994039535581679e-1+0.0i)
+(num-test (cosh 0.0e+00+9.42443269378637893396e+00i) -9.9999994039535581689e-1+0.0i)
+(num-test (cosh 0.0e+00-9.42443269378637893396e+00i) -9.9999994039535581689e-1+0.0i)
+(num-test (cosh 0.0e+00+9.42512322775237976202e+00i) -9.9999994039535581714e-1+0.0i)
+(num-test (cosh 0.0e+00-9.42512322775237976202e+00i) -9.9999994039535581714e-1+0.0i)
+(num-test (cosh 1.19209289550781250e-07-3.45266983001243932001e-04i) 9.9999994039536292216e-1-4.1159030931163569191e-11i)
+(num-test (cosh 1.19209289550781250e-07+3.45266983001243932001e-04i) 9.9999994039536292216e-1+4.1159030931163569191e-11i)
+(num-test (cosh -1.19209289550781250e-07-3.45266983001243932001e-04i) 9.9999994039536292216e-1+4.1159030931163569191e-11i)
+(num-test (cosh -1.19209289550781250e-07+3.45266983001243932001e-04i) 9.9999994039536292216e-1-4.1159030931163569191e-11i)
+(num-test (cosh 1.19209289550781250e-07+1.57045105981189525579e+00i) 3.4526697614152730954e-4+1.1920928244535424532e-7i)
+(num-test (cosh 1.19209289550781250e-07-1.57045105981189525579e+00i) 3.4526697614152730954e-4-1.1920928244535424532e-7i)
+(num-test (cosh -1.19209289550781250e-07+1.57045105981189525579e+00i) 3.4526697614152730954e-4-1.1920928244535424532e-7i)
+(num-test (cosh -1.19209289550781250e-07-1.57045105981189525579e+00i) 3.4526697614152730954e-4+1.1920928244535424532e-7i)
+(num-test (cosh 1.19209289550781250e-07+1.57114159377789786021e+00i) -3.4526697614140484486e-4+1.1920928244535424533e-7i)
+(num-test (cosh 1.19209289550781250e-07-1.57114159377789786021e+00i) -3.4526697614140484486e-4-1.1920928244535424533e-7i)
+(num-test (cosh -1.19209289550781250e-07+1.57114159377789786021e+00i) -3.4526697614140484486e-4-1.1920928244535424533e-7i)
+(num-test (cosh -1.19209289550781250e-07-1.57114159377789786021e+00i) -3.4526697614140484486e-4+1.1920928244535424533e-7i)
+(num-test (cosh 1.19209289550781250e-07+3.14124738660679181379e+00i) -9.9999994039536292209e-1+4.1159030931185115142e-11i)
+(num-test (cosh 1.19209289550781250e-07-3.14124738660679181379e+00i) -9.9999994039536292209e-1-4.1159030931185115142e-11i)
+(num-test (cosh -1.19209289550781250e-07+3.14124738660679181379e+00i) -9.9999994039536292209e-1-4.1159030931185115142e-11i)
+(num-test (cosh -1.19209289550781250e-07-3.14124738660679181379e+00i) -9.9999994039536292209e-1+4.1159030931185115142e-11i)
+(num-test (cosh 1.19209289550781250e-07+3.14193792057279441821e+00i) -9.9999994039536292218e-1-4.1159030931155917289e-11i)
+(num-test (cosh 1.19209289550781250e-07-3.14193792057279441821e+00i) -9.9999994039536292218e-1+4.1159030931155917289e-11i)
+(num-test (cosh -1.19209289550781250e-07+3.14193792057279441821e+00i) -9.9999994039536292218e-1+4.1159030931155917289e-11i)
+(num-test (cosh -1.19209289550781250e-07-3.14193792057279441821e+00i) -9.9999994039536292218e-1-4.1159030931155917289e-11i)
+(num-test (cosh 1.19209289550781250e-07+4.71204371340168837179e+00i) -3.4526697614164977421e-4-1.1920928244535424532e-7i)
+(num-test (cosh 1.19209289550781250e-07-4.71204371340168837179e+00i) -3.4526697614164977421e-4+1.1920928244535424532e-7i)
+(num-test (cosh -1.19209289550781250e-07+4.71204371340168837179e+00i) -3.4526697614164977421e-4+1.1920928244535424532e-7i)
+(num-test (cosh -1.19209289550781250e-07-4.71204371340168837179e+00i) -3.4526697614164977421e-4-1.1920928244535424532e-7i)
+(num-test (cosh 1.19209289550781250e-07+4.71273424736769097620e+00i) 3.4526697614128238019e-4-1.1920928244535424533e-7i)
+(num-test (cosh 1.19209289550781250e-07-4.71273424736769097620e+00i) 3.4526697614128238019e-4+1.1920928244535424533e-7i)
+(num-test (cosh -1.19209289550781250e-07+4.71273424736769097620e+00i) 3.4526697614128238019e-4+1.1920928244535424533e-7i)
+(num-test (cosh -1.19209289550781250e-07-4.71273424736769097620e+00i) 3.4526697614128238019e-4-1.1920928244535424533e-7i)
+(num-test (cosh 1.19209289550781250e-07+6.28284004019658492979e+00i) 9.9999994039536292205e-1-4.1159030931199714069e-11i)
+(num-test (cosh 1.19209289550781250e-07-6.28284004019658492979e+00i) 9.9999994039536292205e-1+4.1159030931199714069e-11i)
+(num-test (cosh -1.19209289550781250e-07+6.28284004019658492979e+00i) 9.9999994039536292205e-1+4.1159030931199714069e-11i)
+(num-test (cosh -1.19209289550781250e-07-6.28284004019658492979e+00i) 9.9999994039536292205e-1-4.1159030931199714069e-11i)
+(num-test (cosh 1.19209289550781250e-07+6.28353057416258753420e+00i) 9.9999994039536292222e-1+4.1159030931141318362e-11i)
+(num-test (cosh 1.19209289550781250e-07-6.28353057416258753420e+00i) 9.9999994039536292222e-1-4.1159030931141318362e-11i)
+(num-test (cosh -1.19209289550781250e-07+6.28353057416258753420e+00i) 9.9999994039536292222e-1-4.1159030931141318362e-11i)
+(num-test (cosh -1.19209289550781250e-07-6.28353057416258753420e+00i) 9.9999994039536292222e-1+4.1159030931141318362e-11i)
+(num-test (cosh 1.19209289550781250e-07+9.42443269378637893396e+00i) -9.9999994039536292231e-1+4.1159030931108433883e-11i)
+(num-test (cosh 1.19209289550781250e-07-9.42443269378637893396e+00i) -9.9999994039536292231e-1-4.1159030931108433883e-11i)
+(num-test (cosh -1.19209289550781250e-07+9.42443269378637893396e+00i) -9.9999994039536292231e-1-4.1159030931108433883e-11i)
+(num-test (cosh -1.19209289550781250e-07-9.42443269378637893396e+00i) -9.9999994039536292231e-1+4.1159030931108433883e-11i)
+(num-test (cosh 1.19209289550781250e-07+9.42512322775237976202e+00i) -9.9999994039536292257e-1-4.1159030931020840323e-11i)
+(num-test (cosh 1.19209289550781250e-07-9.42512322775237976202e+00i) -9.9999994039536292257e-1+4.1159030931020840323e-11i)
+(num-test (cosh -1.19209289550781250e-07+9.42512322775237976202e+00i) -9.9999994039536292257e-1+4.1159030931020840323e-11i)
+(num-test (cosh -1.19209289550781250e-07-9.42512322775237976202e+00i) -9.9999994039536292257e-1-4.1159030931020840323e-11i)
+(num-test (cosh 5.0e-01-3.45266983001243932001e-04i) 1.1276258979946363573e0-1.7991700040930800151e-4i)
+(num-test (cosh 5.0e-01+3.45266983001243932001e-04i) 1.1276258979946363573e0+1.7991700040930800151e-4i)
+(num-test (cosh -5.0e-01-3.45266983001243932001e-04i) 1.1276258979946363573e0+1.7991700040930800151e-4i)
+(num-test (cosh -5.0e-01+3.45266983001243932001e-04i) 1.1276258979946363573e0-1.7991700040930800151e-4i)
+(num-test (cosh 5.0e-01+1.57045105981189525579e+00i) 3.8933200722547541227e-4+5.2109527443404709207e-1i)
+(num-test (cosh 5.0e-01-1.57045105981189525579e+00i) 3.8933200722547541227e-4-5.2109527443404709207e-1i)
+(num-test (cosh -5.0e-01+1.57045105981189525579e+00i) 3.8933200722547541227e-4-5.2109527443404709207e-1i)
+(num-test (cosh -5.0e-01-1.57045105981189525579e+00i) 3.8933200722547541227e-4+5.2109527443404709207e-1i)
+(num-test (cosh 5.0e-01+1.57114159377789786021e+00i) -3.8933200722533731792e-4+5.2109527443404709209e-1i)
+(num-test (cosh 5.0e-01-1.57114159377789786021e+00i) -3.8933200722533731792e-4-5.2109527443404709209e-1i)
+(num-test (cosh -5.0e-01+1.57114159377789786021e+00i) -3.8933200722533731792e-4-5.2109527443404709209e-1i)
+(num-test (cosh -5.0e-01-1.57114159377789786021e+00i) -3.8933200722533731792e-4+5.2109527443404709209e-1i)
+(num-test (cosh 5.0e-01+3.14124738660679181379e+00i) -1.1276258979946363572e0+1.7991700040940218455e-4i)
+(num-test (cosh 5.0e-01-3.14124738660679181379e+00i) -1.1276258979946363572e0-1.7991700040940218455e-4i)
+(num-test (cosh -5.0e-01+3.14124738660679181379e+00i) -1.1276258979946363572e0-1.7991700040940218455e-4i)
+(num-test (cosh -5.0e-01-3.14124738660679181379e+00i) -1.1276258979946363572e0+1.7991700040940218455e-4i)
+(num-test (cosh 5.0e-01+3.14193792057279441821e+00i) -1.1276258979946363573e0-1.7991700040927455302e-4i)
+(num-test (cosh 5.0e-01-3.14193792057279441821e+00i) -1.1276258979946363573e0+1.7991700040927455302e-4i)
+(num-test (cosh -5.0e-01+3.14193792057279441821e+00i) -1.1276258979946363573e0+1.7991700040927455302e-4i)
+(num-test (cosh -5.0e-01-3.14193792057279441821e+00i) -1.1276258979946363573e0-1.7991700040927455302e-4i)
+(num-test (cosh 5.0e-01+4.71204371340168837179e+00i) -3.8933200722561350661e-4-5.2109527443404709205e-1i)
+(num-test (cosh 5.0e-01-4.71204371340168837179e+00i) -3.8933200722561350661e-4+5.2109527443404709205e-1i)
+(num-test (cosh -5.0e-01+4.71204371340168837179e+00i) -3.8933200722561350661e-4+5.2109527443404709205e-1i)
+(num-test (cosh -5.0e-01-4.71204371340168837179e+00i) -3.8933200722561350661e-4-5.2109527443404709205e-1i)
+(num-test (cosh 5.0e-01+4.71273424736769097620e+00i) 3.8933200722519922358e-4-5.2109527443404709212e-1i)
+(num-test (cosh 5.0e-01-4.71273424736769097620e+00i) 3.8933200722519922358e-4+5.2109527443404709212e-1i)
+(num-test (cosh -5.0e-01+4.71273424736769097620e+00i) 3.8933200722519922358e-4+5.2109527443404709212e-1i)
+(num-test (cosh -5.0e-01-4.71273424736769097620e+00i) 3.8933200722519922358e-4-5.2109527443404709212e-1i)
+(num-test (cosh 5.0e-01+6.28284004019658492979e+00i) 1.1276258979946363572e0-1.7991700040946600032e-4i)
+(num-test (cosh 5.0e-01-6.28284004019658492979e+00i) 1.1276258979946363572e0+1.7991700040946600032e-4i)
+(num-test (cosh -5.0e-01+6.28284004019658492979e+00i) 1.1276258979946363572e0+1.7991700040946600032e-4i)
+(num-test (cosh -5.0e-01-6.28284004019658492979e+00i) 1.1276258979946363572e0-1.7991700040946600032e-4i)
+(num-test (cosh 5.0e-01+6.28353057416258753420e+00i) 1.1276258979946363574e0+1.7991700040921073725e-4i)
+(num-test (cosh 5.0e-01-6.28353057416258753420e+00i) 1.1276258979946363574e0-1.7991700040921073725e-4i)
+(num-test (cosh -5.0e-01+6.28353057416258753420e+00i) 1.1276258979946363574e0-1.7991700040921073725e-4i)
+(num-test (cosh -5.0e-01-6.28353057416258753420e+00i) 1.1276258979946363574e0+1.7991700040921073725e-4i)
+(num-test (cosh 5.0e-01+9.42443269378637893396e+00i) -1.1276258979946363575e0+1.7991700040906699050e-4i)
+(num-test (cosh 5.0e-01-9.42443269378637893396e+00i) -1.1276258979946363575e0-1.7991700040906699050e-4i)
+(num-test (cosh -5.0e-01+9.42443269378637893396e+00i) -1.1276258979946363575e0-1.7991700040906699050e-4i)
+(num-test (cosh -5.0e-01-9.42443269378637893396e+00i) -1.1276258979946363575e0+1.7991700040906699050e-4i)
+(num-test (cosh 5.0e-01+9.42512322775237976202e+00i) -1.1276258979946363577e0-1.7991700040868409591e-4i)
+(num-test (cosh 5.0e-01-9.42512322775237976202e+00i) -1.1276258979946363577e0+1.7991700040868409591e-4i)
+(num-test (cosh -5.0e-01+9.42512322775237976202e+00i) -1.1276258979946363577e0+1.7991700040868409591e-4i)
+(num-test (cosh -5.0e-01-9.42512322775237976202e+00i) -1.1276258979946363577e0-1.7991700040868409591e-4i)
+(num-test (cosh 1.0e+00-3.45266983001243932001e-04i) 1.5430805428404715942e0-4.057581624871654840e-4i)
+(num-test (cosh 1.0e+00+3.45266983001243932001e-04i) 1.5430805428404715942e0+4.057581624871654840e-4i)
+(num-test (cosh -1.0e+00-3.45266983001243932001e-04i) 1.5430805428404715942e0+4.057581624871654840e-4i)
+(num-test (cosh -1.0e+00+3.45266983001243932001e-04i) 1.5430805428404715942e0-4.057581624871654840e-4i)
+(num-test (cosh 1.0e+00+1.57045105981189525579e+00i) 5.3277478472520380315e-4+1.1752011235963524659e0i)
+(num-test (cosh 1.0e+00-1.57045105981189525579e+00i) 5.3277478472520380315e-4-1.1752011235963524659e0i)
+(num-test (cosh -1.0e+00+1.57045105981189525579e+00i) 5.3277478472520380315e-4-1.1752011235963524659e0i)
+(num-test (cosh -1.0e+00-1.57045105981189525579e+00i) 5.3277478472520380315e-4+1.1752011235963524659e0i)
+(num-test (cosh 1.0e+00+1.57114159377789786021e+00i) -5.3277478472501483029e-4+1.1752011235963524660e0i)
+(num-test (cosh 1.0e+00-1.57114159377789786021e+00i) -5.3277478472501483029e-4-1.1752011235963524660e0i)
+(num-test (cosh -1.0e+00+1.57114159377789786021e+00i) -5.3277478472501483029e-4-1.1752011235963524660e0i)
+(num-test (cosh -1.0e+00-1.57114159377789786021e+00i) -5.3277478472501483029e-4+1.1752011235963524660e0i)
+(num-test (cosh 1.0e+00+3.14124738660679181379e+00i) -1.5430805428404715941e0+4.0575816248737789049e-4i)
+(num-test (cosh 1.0e+00-3.14124738660679181379e+00i) -1.5430805428404715941e0-4.0575816248737789049e-4i)
+(num-test (cosh -1.0e+00+3.14124738660679181379e+00i) -1.5430805428404715941e0-4.0575816248737789049e-4i)
+(num-test (cosh -1.0e+00-3.14124738660679181379e+00i) -1.5430805428404715941e0+4.0575816248737789049e-4i)
+(num-test (cosh 1.0e+00+3.14193792057279441821e+00i) -1.5430805428404715943e0-4.0575816248709004923e-4i)
+(num-test (cosh 1.0e+00-3.14193792057279441821e+00i) -1.5430805428404715943e0+4.0575816248709004923e-4i)
+(num-test (cosh -1.0e+00+3.14193792057279441821e+00i) -1.5430805428404715943e0+4.0575816248709004923e-4i)
+(num-test (cosh -1.0e+00-3.14193792057279441821e+00i) -1.5430805428404715943e0-4.0575816248709004923e-4i)
+(num-test (cosh 1.0e+00+4.71204371340168837179e+00i) -5.3277478472539277601e-4-1.1752011235963524659e0i)
+(num-test (cosh 1.0e+00-4.71204371340168837179e+00i) -5.3277478472539277601e-4+1.1752011235963524659e0i)
+(num-test (cosh -1.0e+00+4.71204371340168837179e+00i) -5.3277478472539277601e-4+1.1752011235963524659e0i)
+(num-test (cosh -1.0e+00-4.71204371340168837179e+00i) -5.3277478472539277601e-4-1.1752011235963524659e0i)
+(num-test (cosh 1.0e+00+4.71273424736769097620e+00i) 5.3277478472482585742e-4-1.1752011235963524660e0i)
+(num-test (cosh 1.0e+00-4.71273424736769097620e+00i) 5.3277478472482585742e-4+1.1752011235963524660e0i)
+(num-test (cosh -1.0e+00+4.71273424736769097620e+00i) 5.3277478472482585742e-4+1.1752011235963524660e0i)
+(num-test (cosh -1.0e+00-4.71273424736769097620e+00i) 5.3277478472482585742e-4-1.1752011235963524660e0i)
+(num-test (cosh 1.0e+00+6.28284004019658492979e+00i) 1.5430805428404715941e0-4.0575816248752181112e-4i)
+(num-test (cosh 1.0e+00-6.28284004019658492979e+00i) 1.5430805428404715941e0+4.0575816248752181112e-4i)
+(num-test (cosh -1.0e+00+6.28284004019658492979e+00i) 1.5430805428404715941e0+4.0575816248752181112e-4i)
+(num-test (cosh -1.0e+00-6.28284004019658492979e+00i) 1.5430805428404715941e0-4.0575816248752181112e-4i)
+(num-test (cosh 1.0e+00+6.28353057416258753420e+00i) 1.5430805428404715943e0+4.0575816248694612861e-4i)
+(num-test (cosh 1.0e+00-6.28353057416258753420e+00i) 1.5430805428404715943e0-4.0575816248694612861e-4i)
+(num-test (cosh -1.0e+00+6.28353057416258753420e+00i) 1.5430805428404715943e0-4.0575816248694612861e-4i)
+(num-test (cosh -1.0e+00-6.28353057416258753420e+00i) 1.5430805428404715943e0+4.0575816248694612861e-4i)
+(num-test (cosh 1.0e+00+9.42443269378637893396e+00i) -1.5430805428404715945e0+4.0575816248662194348e-4i)
+(num-test (cosh 1.0e+00-9.42443269378637893396e+00i) -1.5430805428404715945e0-4.0575816248662194348e-4i)
+(num-test (cosh -1.0e+00+9.42443269378637893396e+00i) -1.5430805428404715945e0-4.0575816248662194348e-4i)
+(num-test (cosh -1.0e+00-9.42443269378637893396e+00i) -1.5430805428404715945e0+4.0575816248662194348e-4i)
+(num-test (cosh 1.0e+00+9.42512322775237976202e+00i) -1.5430805428404715949e0-4.0575816248575841970e-4i)
+(num-test (cosh 1.0e+00-9.42512322775237976202e+00i) -1.5430805428404715949e0+4.0575816248575841970e-4i)
+(num-test (cosh -1.0e+00+9.42512322775237976202e+00i) -1.5430805428404715949e0+4.0575816248575841970e-4i)
+(num-test (cosh -1.0e+00-9.42512322775237976202e+00i) -1.5430805428404715949e0-4.0575816248575841970e-4i)
+(num-test (cosh 2.0e+00-3.45266983001243932001e-04i) 3.7621954668392959447e0-1.2522351259043242989e-3i)
+(num-test (cosh 2.0e+00+3.45266983001243932001e-04i) 3.7621954668392959447e0+1.2522351259043242989e-3i)
+(num-test (cosh -2.0e+00-3.45266983001243932001e-04i) 3.7621954668392959447e0+1.2522351259043242989e-3i)
+(num-test (cosh -2.0e+00+3.45266983001243932001e-04i) 3.7621954668392959447e0-1.2522351259043242989e-3i)
+(num-test (cosh 2.0e+00+1.57045105981189525579e+00i) 1.2989619299131198016e-3+3.6268601916692946554e0i)
+(num-test (cosh 2.0e+00-1.57045105981189525579e+00i) 1.2989619299131198016e-3-3.6268601916692946554e0i)
+(num-test (cosh -2.0e+00+1.57045105981189525579e+00i) 1.2989619299131198016e-3-3.6268601916692946554e0i)
+(num-test (cosh -2.0e+00-1.57045105981189525579e+00i) 1.2989619299131198016e-3+3.6268601916692946554e0i)
+(num-test (cosh 2.0e+00+1.57114159377789786021e+00i) -1.2989619299126590655e-3+3.6268601916692946556e0i)
+(num-test (cosh 2.0e+00-1.57114159377789786021e+00i) -1.2989619299126590655e-3-3.6268601916692946556e0i)
+(num-test (cosh -2.0e+00+1.57114159377789786021e+00i) -1.2989619299126590655e-3-3.6268601916692946556e0i)
+(num-test (cosh -2.0e+00-1.57114159377789786021e+00i) -1.2989619299126590655e-3+3.6268601916692946556e0i)
+(num-test (cosh 2.0e+00+3.14124738660679181379e+00i) -3.7621954668392959444e0+1.2522351259049798196e-3i)
+(num-test (cosh 2.0e+00-3.14124738660679181379e+00i) -3.7621954668392959444e0-1.2522351259049798196e-3i)
+(num-test (cosh -2.0e+00+3.14124738660679181379e+00i) -3.7621954668392959444e0-1.2522351259049798196e-3i)
+(num-test (cosh -2.0e+00-3.14124738660679181379e+00i) -3.7621954668392959444e0+1.2522351259049798196e-3i)
+(num-test (cosh 2.0e+00+3.14193792057279441821e+00i) -3.7621954668392959448e0-1.2522351259040914950e-3i)
+(num-test (cosh 2.0e+00-3.14193792057279441821e+00i) -3.7621954668392959448e0+1.2522351259040914950e-3i)
+(num-test (cosh -2.0e+00+3.14193792057279441821e+00i) -3.7621954668392959448e0+1.2522351259040914950e-3i)
+(num-test (cosh -2.0e+00-3.14193792057279441821e+00i) -3.7621954668392959448e0-1.2522351259040914950e-3i)
+(num-test (cosh 2.0e+00+4.71204371340168837179e+00i) -1.2989619299135805376e-3-3.6268601916692946552e0i)
+(num-test (cosh 2.0e+00-4.71204371340168837179e+00i) -1.2989619299135805376e-3+3.6268601916692946552e0i)
+(num-test (cosh -2.0e+00+4.71204371340168837179e+00i) -1.2989619299135805376e-3+3.6268601916692946552e0i)
+(num-test (cosh -2.0e+00-4.71204371340168837179e+00i) -1.2989619299135805376e-3-3.6268601916692946552e0i)
+(num-test (cosh 2.0e+00+4.71273424736769097620e+00i) 1.2989619299121983294e-3-3.6268601916692946557e0i)
+(num-test (cosh 2.0e+00-4.71273424736769097620e+00i) 1.2989619299121983294e-3+3.6268601916692946557e0i)
+(num-test (cosh -2.0e+00+4.71273424736769097620e+00i) 1.2989619299121983294e-3+3.6268601916692946557e0i)
+(num-test (cosh -2.0e+00-4.71273424736769097620e+00i) 1.2989619299121983294e-3-3.6268601916692946557e0i)
+(num-test (cosh 2.0e+00+6.28284004019658492979e+00i) 3.7621954668392959443e0-1.2522351259054239819e-3i)
+(num-test (cosh 2.0e+00-6.28284004019658492979e+00i) 3.7621954668392959443e0+1.2522351259054239819e-3i)
+(num-test (cosh -2.0e+00+6.28284004019658492979e+00i) 3.7621954668392959443e0+1.2522351259054239819e-3i)
+(num-test (cosh -2.0e+00-6.28284004019658492979e+00i) 3.7621954668392959443e0-1.2522351259054239819e-3i)
+(num-test (cosh 2.0e+00+6.28353057416258753420e+00i) 3.7621954668392959449e0+1.2522351259036473328e-3i)
+(num-test (cosh 2.0e+00-6.28353057416258753420e+00i) 3.7621954668392959449e0-1.2522351259036473328e-3i)
+(num-test (cosh -2.0e+00+6.28353057416258753420e+00i) 3.7621954668392959449e0-1.2522351259036473328e-3i)
+(num-test (cosh -2.0e+00-6.28353057416258753420e+00i) 3.7621954668392959449e0+1.2522351259036473328e-3i)
+(num-test (cosh 2.0e+00+9.42443269378637893396e+00i) -3.7621954668392959453e0+1.2522351259026468452e-3i)
+(num-test (cosh 2.0e+00-9.42443269378637893396e+00i) -3.7621954668392959453e0-1.2522351259026468452e-3i)
+(num-test (cosh -2.0e+00+9.42443269378637893396e+00i) -3.7621954668392959453e0-1.2522351259026468452e-3i)
+(num-test (cosh -2.0e+00-9.42443269378637893396e+00i) -3.7621954668392959453e0+1.2522351259026468452e-3i)
+(num-test (cosh 2.0e+00+9.42512322775237976202e+00i) -3.7621954668392959462e0-1.2522351258999818715e-3i)
+(num-test (cosh 2.0e+00-9.42512322775237976202e+00i) -3.7621954668392959462e0+1.2522351258999818715e-3i)
+(num-test (cosh -2.0e+00+9.42512322775237976202e+00i) -3.7621954668392959462e0+1.2522351258999818715e-3i)
+(num-test (cosh -2.0e+00-9.42512322775237976202e+00i) -3.7621954668392959462e0-1.2522351258999818715e-3i)
+(num-test (cosh (log (/ (+ 1 (sqrt 5)) 2))) (/ (sqrt 5) 2))
+(num-test (/ (+ (cos (/ 10)) (cosh (/ 10)) (* 2 (cos (/ (sqrt 2) 20)) (cosh (/ (sqrt 2) 20)))) 4) 1.0000000000002480)
+(num-test (cosh 0) 1.0)
+(num-test (cosh -2.225073858507201399999999999999999999996E-308) 1.000E0)
+(num-test (cosh 1.110223024625156799999999999999999999997E-16) 1.000000000000000000000000000000006162976E0)
+
+(for-each
+ (lambda (num-and-val)
+   (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'cosh num (cosh num) val)))
+ (vector (list 0 1) (list 1 1.5430806348152) (list 2 3.7621956910836) (list 3 10.067661995778)
+	 (list -1 1.5430806348152) (list -2 3.7621956910836) (list -3 10.067661995778) (list 1/2 1.1276259652064)
+	 (list 1/3 1.0560718678299) (list -1/2 1.1276259652064) (list -1/3 1.0560718678299)
+	 (list 1/9223372036854775807 1.0) (list 0.0 1.0) (list 1.0 1.5430806348152) (list 2.0 3.7621956910836)
+	 (list -2.0 3.7621956910836) (list 1.000000000000000000000000000000000000002E-309 1.000E0)
+	 (list 0+1i 0.54030230586814) (list 0+2i -0.41614683654714) (list 0-1i 0.54030230586814)
+	 (list 1+1i 0.83373002513115+0.98889770576287i) (list 1-1i 0.83373002513115-0.98889770576287i)
+	 (list -1+1i 0.83373002513115-0.98889770576287i) (list -1-1i 0.83373002513115+0.98889770576287i)
+	 (list 0.1+0.1i 0.9999833333373+0.0099999888888898i) (list 1e-16+1e-16i 1+1e-32i)
+	 ))
+
+(when with-bignums
+  (let ((max-s-error 0.0)
+	(max-s-error-case 0)
+	(max-sh-error 0.0)
+	(max-sh-error-case 0))
+    (do ((x 0.10000000000000000000000 (+ x 0.1000000000000000000000)))
+	((> x (* 2 pi)))
+      (let ((s (sin x))
+	    (sh (sinh x))
+	    (c (cos x))
+	    (ch (cosh x)))
+	(let ((err (magnitude (- (+ (* s s) (* c c)) 1))))
+	  (if (> err max-s-error)
+	      (begin
+		(set! max-s-error err)
+		(set! max-s-error-case x))))
+	(let ((err (magnitude (+ (- (* sh sh) (* ch ch)) 1))))
+	  (if (> err max-sh-error)
+	      (begin
+		(set! max-sh-error err)
+		(set! max-sh-error-case x))))))
+    (if (> max-s-error 1e-35)
+	(format #t "s^2 + c^2 error: ~A at ~A~%" max-s-error max-s-error-case))
+    (if (> max-sh-error 1e-33)
+	(format #t "sh^2 + ch^2 error: ~A at ~A~%" max-sh-error max-sh-error-case)))
+
+  (num-test (sinh 1000.0) 9.850355570085234969444396761216615626576E433)
+  (num-test (cosh 1000.0) 9.850355570085234969444396761216615626576E433))
+
+(test (cosh) 'error)
+(test (cosh "hi") 'error)
+(test (cosh 1.0+23.0i 1.0+23.0i) 'error)
+(test (cosh 0 1) 'error)
+(num-test (cosh 1/9223372036854775807) 1.000000000000000000000000000000000000006E0)
+
+(for-each
+ (lambda (arg)
+   (test (cosh arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; tanh
+;;; --------------------------------------------------------------------------------
+
+(num-test (tanh 0) 0.0)
+(num-test (tanh 1) 0.76159415595576)
+(num-test (tanh -1) -0.76159415595576)
+(num-test (tanh 2) 0.96402758007582)
+(num-test (tanh -2) -0.96402758007582)
+(num-test (tanh 3) 0.99505475368673)
+(num-test (tanh -3) -0.99505475368673)
+(num-test (tanh 10) 0.99999999587769)
+(num-test (tanh -10) -0.99999999587769)
+(num-test (tanh 0/1) 0.0)
+(num-test (tanh 0/2) 0.0)
+(num-test (tanh 0/3) 0.0)
+(num-test (tanh 0/10) 0.0)
+(num-test (tanh 0/1234) 0.0)
+(num-test (tanh 0/500029) 0.0)
+(num-test (tanh 1/1) 0.76159415595576)
+(num-test (tanh -1/1) -0.76159415595576)
+(num-test (tanh 1/2) 0.46211715726001)
+(num-test (tanh -1/2) -0.46211715726001)
+(num-test (tanh 1/3) 0.32151273753163)
+(num-test (tanh -1/3) -0.32151273753163)
+(num-test (tanh 1/10) 0.09966799462496)
+(num-test (tanh -1/10) -0.09966799462496)
+(num-test (tanh 1/1234) 0.00081037259408)
+(num-test (tanh -1/1234) -0.00081037259408)
+(num-test (tanh 1/500029) 0.00000199988401)
+(num-test (tanh -1/500029) -0.00000199988401)
+(num-test (tanh 2/1) 0.96402758007582)
+(num-test (tanh -2/1) -0.96402758007582)
+(num-test (tanh 2/2) 0.76159415595576)
+(num-test (tanh -2/2) -0.76159415595576)
+(num-test (tanh 2/3) 0.58278294534791)
+(num-test (tanh -2/3) -0.58278294534791)
+(num-test (tanh 2/10) 0.19737532022490)
+(num-test (tanh -2/10) -0.19737532022490)
+(num-test (tanh 2/1234) 0.00162074412382)
+(num-test (tanh -2/1234) -0.00162074412382)
+(num-test (tanh 2/500029) 0.00000399976801)
+(num-test (tanh -2/500029) -0.00000399976801)
+(num-test (tanh 3/1) 0.99505475368673)
+(num-test (tanh -3/1) -0.99505475368673)
+(num-test (tanh 3/2) 0.90514825364487)
+(num-test (tanh -3/2) -0.90514825364487)
+(num-test (tanh 3/3) 0.76159415595576)
+(num-test (tanh -3/3) -0.76159415595576)
+(num-test (tanh 3/10) 0.29131261245159)
+(num-test (tanh -3/10) -0.29131261245159)
+(num-test (tanh 3/1234) 0.00243111352486)
+(num-test (tanh -3/1234) -0.00243111352486)
+(num-test (tanh 3/500029) 0.00000599965202)
+(num-test (tanh -3/500029) -0.00000599965202)
+(num-test (tanh 10/1) 0.99999999587769)
+(num-test (tanh -10/1) -0.99999999587769)
+(num-test (tanh 10/2) 0.99990920426260)
+(num-test (tanh -10/2) -0.99990920426260)
+(num-test (tanh 10/3) 0.99745796747384)
+(num-test (tanh -10/3) -0.99745796747384)
+(num-test (tanh 10/10) 0.76159415595576)
+(num-test (tanh -10/10) -0.76159415595576)
+(num-test (tanh 10/1234) 0.00810355032772)
+(num-test (tanh -10/1234) -0.00810355032772)
+(num-test (tanh 10/500029) 0.00001999884006)
+(num-test (tanh -10/500029) -0.00001999884006)
+(num-test (tanh 1234/10) 1.0)
+(num-test (tanh -1234/10) -1.0)
+(num-test (tanh 1234/500029) 0.00246785185430)
+(num-test (tanh -1234/500029) -0.00246785185430)
+(num-test (tanh 500029/500029) 0.76159415595576)
+(num-test (tanh -500029/500029) -0.76159415595576)
+(num-test (tanh 0.0) 0.0)
+(num-test (tanh 0.00000001) 0.00000001)
+(num-test (tanh -0.00000001) -0.00000001)
+(num-test (tanh 1.0) 0.76159415595576)
+(num-test (tanh -1.0) -0.76159415595576)
+(num-test (tanh pi) 0.99627207622075)
+(num-test (tanh -3.14159265358979) -0.99627207622075)
+(num-test (tanh 0.0+0.0i) 0.0)
+(num-test (tanh -0.0+0.0i) 0.0)
+(num-test (tanh 0.0-0.0i) 0.0)
+(num-test (tanh -0.0-0.0i) 0.0)
+(num-test (tanh 0.0+0.00000001i) 0.0+0.00000001i)
+(num-test (tanh -0.0+0.00000001i) 0.0+0.00000001i)
+(num-test (tanh 0.0-0.00000001i) 0.0-0.00000001i)
+(num-test (tanh -0.0-0.00000001i) -0.0-0.00000001i)
+(num-test (tanh 0.0+1.0i) 0.0+1.55740772465490i)
+(num-test (tanh -0.0+1.0i) 0.0+1.55740772465490i)
+(num-test (tanh 0.0-1.0i) 0.0-1.55740772465490i)
+(num-test (tanh -0.0-1.0i) -0.0-1.55740772465490i)
+(num-test (tanh 0.00000001+0.0i) 0.00000001)
+(num-test (tanh -0.00000001+0.0i) -0.00000001)
+(num-test (tanh 0.00000001-0.0i) 0.00000001)
+(num-test (tanh -0.00000001-0.0i) -0.00000001)
+(num-test (tanh 0.00000001+0.00000001i) 0.00000001+0.00000001i)
+(num-test (tanh -0.00000001+0.00000001i) -0.00000001+0.00000001i)
+(num-test (tanh 0.00000001-0.00000001i) 0.00000001-0.00000001i)
+(num-test (tanh -0.00000001-0.00000001i) -0.00000001-0.00000001i)
+(num-test (tanh 0.00000001+1.0i) 0.00000003425519+1.55740772465490i)
+(num-test (tanh -0.00000001+1.0i) -0.00000003425519+1.55740772465490i)
+(num-test (tanh 0.00000001-1.0i) 0.00000003425519-1.55740772465490i)
+(num-test (tanh -0.00000001-1.0i) -0.00000003425519-1.55740772465490i)
+(num-test (tanh 1.0+0.0i) 0.76159415595576)
+(num-test (tanh -1.0+0.0i) -0.76159415595576)
+(num-test (tanh 1.0-0.0i) 0.76159415595576)
+(num-test (tanh -1.0-0.0i) -0.76159415595576)
+(num-test (tanh 1.0+0.00000001i) 0.76159415595576+0.00000000419974i)
+(num-test (tanh -1.0+0.00000001i) -0.76159415595576+0.00000000419974i)
+(num-test (tanh 1.0-0.00000001i) 0.76159415595576-0.00000000419974i)
+(num-test (tanh -1.0-0.00000001i) -0.76159415595576-0.00000000419974i)
+(num-test (tanh 1.0+1.0i) 1.08392332733869+0.27175258531951i)
+(num-test (tanh -1.0+1.0i) -1.08392332733869+0.27175258531951i)
+(num-test (tanh 1.0-1.0i) 1.08392332733869-0.27175258531951i)
+(num-test (tanh -1.0-1.0i) -1.08392332733869-0.27175258531951i)
+(num-test (tanh 3.14159265358979+0.0i) 0.99627207622075)
+(num-test (tanh -3.14159265358979+0.0i) -0.99627207622075)
+(num-test (tanh 3.14159265358979-0.0i) 0.99627207622075)
+(num-test (tanh -3.14159265358979-0.0i) -0.99627207622075)
+(num-test (tanh 3.14159265358979+0.00000001i) 0.99627207622075+0.00000000007442i)
+(num-test (tanh -3.14159265358979+0.00000001i) -0.99627207622075+0.00000000007442i)
+(num-test (tanh 3.14159265358979-0.00000001i) 0.99627207622075-0.00000000007442i)
+(num-test (tanh -3.14159265358979-0.00000001i) -0.99627207622075-0.00000000007442i)
+(num-test (tanh 3.14159265358979+1.0i) 1.00154968930275+0.00340139653674i)
+(num-test (tanh -3.14159265358979+1.0i) -1.00154968930275+0.00340139653674i)
+(num-test (tanh 3.14159265358979-1.0i) 1.00154968930275-0.00340139653674i)
+(num-test (tanh -3.14159265358979-1.0i) -1.00154968930275-0.00340139653674i)
+(num-test (tanh 1234/3) 1.0)
+(num-test (tanh 500029/2) 1.0)
+(num-test (tanh 500029/3) 1.0)
+(num-test (tanh 500029/10) 1.0)
+(num-test (tanh 500029/1234) 1.0)
+(num-test (tanh 0.0+3.14159265358979i) 0.0+6.982889851335445E-15i)
+(num-test (tanh 0.00000001+3.14159265358979i) 1.0e-8+6.982889851335444E-15i)
+(num-test (tanh 0.00000001+1234.0i) 1.5681770497896427E-8-0.7537751984442328i)
+(num-test (tanh 1.0+3.14159265358979i) +0.7615941559557649+2.932634567877868E-15i)
+(num-test (tanh 3.14159265358979+3.14159265358979i) +0.99627207622075+5.196631812627532E-17i)
+(num-test (tanh 3.14159265358979+1234.0i) .9989656315245496-0.003586791196867043i)
+(num-test (tanh 1234.0+0.00000001i) +1.0+8.077935669463161E-28i)
+(num-test (tanh 1234.0+3.14159265358979i) 1.0)
+(num-test (tanh 0.0e+00-3.45266983001243932001e-04i) 0-3.4526699672092183585e-4i)
+(num-test (tanh 0.0e+00+3.45266983001243932001e-04i) 0+3.4526699672092183585e-4i)
+(num-test (tanh 0.0e+00+1.57045105981189525579e+00i) 0+2.8963092606501007060e3i)
+(num-test (tanh 0.0e+00-1.57045105981189525579e+00i) 0-2.8963092606501007060e3i)
+(num-test (tanh 0.0e+00+1.57114159377789786021e+00i) 0-2.8963092606511280143e3i)
+(num-test (tanh 0.0e+00-1.57114159377789786021e+00i) 0+2.8963092606511280143e3i)
+(num-test (tanh 0.0e+00+3.14124738660679181379e+00i) 0-3.4526699672110257641e-4i)
+(num-test (tanh 0.0e+00-3.14124738660679181379e+00i) 0+3.4526699672110257641e-4i)
+(num-test (tanh 0.0e+00+3.14193792057279441821e+00i) 0+3.4526699672085764703e-4i)
+(num-test (tanh 0.0e+00-3.14193792057279441821e+00i) 0-3.4526699672085764703e-4i)
+(num-test (tanh 0.0e+00+4.71204371340168837179e+00i) 0+2.8963092606490733978e3i)
+(num-test (tanh 0.0e+00-4.71204371340168837179e+00i) 0-2.8963092606490733978e3i)
+(num-test (tanh 0.0e+00+4.71273424736769097620e+00i) 0-2.8963092606521553225e3i)
+(num-test (tanh 0.0e+00-4.71273424736769097620e+00i) 0+2.8963092606521553225e3i)
+(num-test (tanh 0.0e+00+6.28284004019658492979e+00i) 0-3.4526699672122504111e-4i)
+(num-test (tanh 0.0e+00-6.28284004019658492979e+00i) 0+3.4526699672122504111e-4i)
+(num-test (tanh 0.0e+00+6.28353057416258753420e+00i) 0+3.4526699672073518233e-4i)
+(num-test (tanh 0.0e+00-6.28353057416258753420e+00i) 0-3.4526699672073518233e-4i)
+(num-test (tanh 0.0e+00+9.42443269378637893396e+00i) 0-3.4526699672045932728e-4i)
+(num-test (tanh 0.0e+00-9.42443269378637893396e+00i) 0+3.4526699672045932728e-4i)
+(num-test (tanh 0.0e+00+9.42512322775237976202e+00i) 0+3.4526699671972453911e-4i)
+(num-test (tanh 0.0e+00-9.42512322775237976202e+00i) 0-3.4526699671972453911e-4i)
+(num-test (tanh 1.19209289550781250e-07-3.45266983001243932001e-04i) 1.1920930376163652989e-7-3.4526699672091692931e-4i)
+(num-test (tanh 1.19209289550781250e-07+3.45266983001243932001e-04i) 1.1920930376163652989e-7+3.4526699672091692931e-4i)
+(num-test (tanh -1.19209289550781250e-07-3.45266983001243932001e-04i) -1.1920930376163652989e-7-3.4526699672091692931e-4i)
+(num-test (tanh -1.19209289550781250e-07+3.45266983001243932001e-04i) -1.1920930376163652989e-7+3.4526699672091692931e-4i)
+(num-test (tanh 1.19209289550781250e-07+1.57045105981189525579e+00i) 9.9999992052646305569e-1+2.8963089153831588642e3i)
+(num-test (tanh 1.19209289550781250e-07-1.57045105981189525579e+00i) 9.9999992052646305569e-1-2.8963089153831588642e3i)
+(num-test (tanh -1.19209289550781250e-07+1.57045105981189525579e+00i) -9.9999992052646305569e-1+2.8963089153831588642e3i)
+(num-test (tanh -1.19209289550781250e-07-1.57045105981189525579e+00i) -9.9999992052646305569e-1-2.8963089153831588642e3i)
+(num-test (tanh 1.19209289550781250e-07+1.57114159377789786021e+00i) 9.9999992052717244672e-1-2.8963089153841861720e3i)
+(num-test (tanh 1.19209289550781250e-07-1.57114159377789786021e+00i) 9.9999992052717244672e-1+2.8963089153841861720e3i)
+(num-test (tanh -1.19209289550781250e-07+1.57114159377789786021e+00i) -9.9999992052717244672e-1-2.8963089153841861720e3i)
+(num-test (tanh -1.19209289550781250e-07-1.57114159377789786021e+00i) -9.9999992052717244672e-1+2.8963089153841861720e3i)
+(num-test (tanh 1.19209289550781250e-07+3.14124738660679181379e+00i) 1.1920930376163652991e-7-3.4526699672109766987e-4i)
+(num-test (tanh 1.19209289550781250e-07-3.14124738660679181379e+00i) 1.1920930376163652991e-7+3.4526699672109766987e-4i)
+(num-test (tanh -1.19209289550781250e-07+3.14124738660679181379e+00i) -1.1920930376163652991e-7-3.4526699672109766987e-4i)
+(num-test (tanh -1.19209289550781250e-07-3.14124738660679181379e+00i) -1.1920930376163652991e-7+3.4526699672109766987e-4i)
+(num-test (tanh 1.19209289550781250e-07+3.14193792057279441821e+00i) 1.1920930376163652989e-7+3.4526699672085274049e-4i)
+(num-test (tanh 1.19209289550781250e-07-3.14193792057279441821e+00i) 1.1920930376163652989e-7-3.4526699672085274049e-4i)
+(num-test (tanh -1.19209289550781250e-07+3.14193792057279441821e+00i) -1.1920930376163652989e-7+3.4526699672085274049e-4i)
+(num-test (tanh -1.19209289550781250e-07-3.14193792057279441821e+00i) -1.1920930376163652989e-7-3.4526699672085274049e-4i)
+(num-test (tanh 1.19209289550781250e-07+4.71204371340168837179e+00i) 9.9999992052575366466e-1+2.8963089153821315563e3i)
+(num-test (tanh 1.19209289550781250e-07-4.71204371340168837179e+00i) 9.9999992052575366466e-1-2.8963089153821315563e3i)
+(num-test (tanh -1.19209289550781250e-07+4.71204371340168837179e+00i) -9.9999992052575366466e-1+2.8963089153821315563e3i)
+(num-test (tanh -1.19209289550781250e-07-4.71204371340168837179e+00i) -9.9999992052575366466e-1-2.8963089153821315563e3i)
+(num-test (tanh 1.19209289550781250e-07+4.71273424736769097620e+00i) 9.9999992052788183776e-1-2.8963089153852134799e3i)
+(num-test (tanh 1.19209289550781250e-07-4.71273424736769097620e+00i) 9.9999992052788183776e-1+2.8963089153852134799e3i)
+(num-test (tanh -1.19209289550781250e-07+4.71273424736769097620e+00i) -9.9999992052788183776e-1-2.8963089153852134799e3i)
+(num-test (tanh -1.19209289550781250e-07-4.71273424736769097620e+00i) -9.9999992052788183776e-1+2.8963089153852134799e3i)
+(num-test (tanh 1.19209289550781250e-07+6.28284004019658492979e+00i) 1.1920930376163652992e-7-3.4526699672122013457e-4i)
+(num-test (tanh 1.19209289550781250e-07-6.28284004019658492979e+00i) 1.1920930376163652992e-7+3.4526699672122013457e-4i)
+(num-test (tanh -1.19209289550781250e-07+6.28284004019658492979e+00i) -1.1920930376163652992e-7-3.4526699672122013457e-4i)
+(num-test (tanh -1.19209289550781250e-07-6.28284004019658492979e+00i) -1.1920930376163652992e-7+3.4526699672122013457e-4i)
+(num-test (tanh 1.19209289550781250e-07+6.28353057416258753420e+00i) 1.1920930376163652988e-7+3.4526699672073027579e-4i)
+(num-test (tanh 1.19209289550781250e-07-6.28353057416258753420e+00i) 1.1920930376163652988e-7-3.4526699672073027579e-4i)
+(num-test (tanh -1.19209289550781250e-07+6.28353057416258753420e+00i) -1.1920930376163652988e-7+3.4526699672073027579e-4i)
+(num-test (tanh -1.19209289550781250e-07-6.28353057416258753420e+00i) -1.1920930376163652988e-7-3.4526699672073027579e-4i)
+(num-test (tanh 1.19209289550781250e-07+9.42443269378637893396e+00i) 1.1920930376163652985e-7-3.4526699672045442074e-4i)
+(num-test (tanh 1.19209289550781250e-07-9.42443269378637893396e+00i) 1.1920930376163652985e-7+3.4526699672045442074e-4i)
+(num-test (tanh -1.19209289550781250e-07+9.42443269378637893396e+00i) -1.1920930376163652985e-7-3.4526699672045442074e-4i)
+(num-test (tanh -1.19209289550781250e-07-9.42443269378637893396e+00i) -1.1920930376163652985e-7+3.4526699672045442074e-4i)
+(num-test (tanh 1.19209289550781250e-07+9.42512322775237976202e+00i) 1.1920930376163652979e-7+3.4526699671971963257e-4i)
+(num-test (tanh 1.19209289550781250e-07-9.42512322775237976202e+00i) 1.1920930376163652979e-7-3.4526699671971963257e-4i)
+(num-test (tanh -1.19209289550781250e-07+9.42512322775237976202e+00i) -1.1920930376163652979e-7+3.4526699671971963257e-4i)
+(num-test (tanh -1.19209289550781250e-07-9.42512322775237976202e+00i) -1.1920930376163652979e-7-3.4526699671971963257e-4i)
+(num-test (tanh 5.0e-01-3.45266983001243932001e-04i) 4.6211720058436229979e-1-2.7153443992655805934e-4i)
+(num-test (tanh 5.0e-01+3.45266983001243932001e-04i) 4.6211720058436229979e-1+2.7153443992655805934e-4i)
+(num-test (tanh -5.0e-01-3.45266983001243932001e-04i) -4.6211720058436229979e-1-2.7153443992655805934e-4i)
+(num-test (tanh -5.0e-01+3.45266983001243932001e-04i) -4.6211720058436229979e-1+2.7153443992655805934e-4i)
+(num-test (tanh 5.0e-01+1.57045105981189525579e+00i) 2.1639524637389325996e0+1.2715121175455623363e-3i)
+(num-test (tanh 5.0e-01-1.57045105981189525579e+00i) 2.1639524637389325996e0-1.2715121175455623363e-3i)
+(num-test (tanh -5.0e-01+1.57045105981189525579e+00i) -2.1639524637389325996e0+1.2715121175455623363e-3i)
+(num-test (tanh -5.0e-01-1.57045105981189525579e+00i) -2.1639524637389325996e0-1.2715121175455623363e-3i)
+(num-test (tanh 5.0e-01+1.57114159377789786021e+00i) 2.1639524637389326002e0-1.2715121175451113370e-3i)
+(num-test (tanh 5.0e-01-1.57114159377789786021e+00i) 2.1639524637389326002e0+1.2715121175451113370e-3i)
+(num-test (tanh -5.0e-01+1.57114159377789786021e+00i) -2.1639524637389326002e0-1.2715121175451113370e-3i)
+(num-test (tanh -5.0e-01-1.57114159377789786021e+00i) -2.1639524637389326002e0+1.2715121175451113370e-3i)
+(num-test (tanh 5.0e-01+3.14124738660679181379e+00i) 4.6211720058436229984e-1-2.7153443992670020234e-4i)
+(num-test (tanh 5.0e-01-3.14124738660679181379e+00i) 4.6211720058436229984e-1+2.7153443992670020234e-4i)
+(num-test (tanh -5.0e-01+3.14124738660679181379e+00i) -4.6211720058436229984e-1-2.7153443992670020234e-4i)
+(num-test (tanh -5.0e-01-3.14124738660679181379e+00i) -4.6211720058436229984e-1+2.7153443992670020234e-4i)
+(num-test (tanh 5.0e-01+3.14193792057279441821e+00i) 4.6211720058436229978e-1+2.7153443992650757820e-4i)
+(num-test (tanh 5.0e-01-3.14193792057279441821e+00i) 4.6211720058436229978e-1-2.7153443992650757820e-4i)
+(num-test (tanh -5.0e-01+3.14193792057279441821e+00i) -4.6211720058436229978e-1+2.7153443992650757820e-4i)
+(num-test (tanh -5.0e-01-3.14193792057279441821e+00i) -4.6211720058436229978e-1-2.7153443992650757820e-4i)
+(num-test (tanh 5.0e-01+4.71204371340168837179e+00i) 2.1639524637389325989e0+1.2715121175460133355e-3i)
+(num-test (tanh 5.0e-01-4.71204371340168837179e+00i) 2.1639524637389325989e0-1.2715121175460133355e-3i)
+(num-test (tanh -5.0e-01+4.71204371340168837179e+00i) -2.1639524637389325989e0+1.2715121175460133355e-3i)
+(num-test (tanh -5.0e-01-4.71204371340168837179e+00i) -2.1639524637389325989e0-1.2715121175460133355e-3i)
+(num-test (tanh 5.0e-01+4.71273424736769097620e+00i) 2.1639524637389326009e0-1.2715121175446603377e-3i)
+(num-test (tanh 5.0e-01-4.71273424736769097620e+00i) 2.1639524637389326009e0+1.2715121175446603377e-3i)
+(num-test (tanh -5.0e-01+4.71273424736769097620e+00i) -2.1639524637389326009e0-1.2715121175446603377e-3i)
+(num-test (tanh -5.0e-01-4.71273424736769097620e+00i) -2.1639524637389326009e0+1.2715121175446603377e-3i)
+(num-test (tanh 5.0e-01+6.28284004019658492979e+00i) 4.6211720058436229987e-1-2.7153443992679651442e-4i)
+(num-test (tanh 5.0e-01-6.28284004019658492979e+00i) 4.6211720058436229987e-1+2.7153443992679651442e-4i)
+(num-test (tanh -5.0e-01+6.28284004019658492979e+00i) -4.6211720058436229987e-1-2.7153443992679651442e-4i)
+(num-test (tanh -5.0e-01-6.28284004019658492979e+00i) -4.6211720058436229987e-1+2.7153443992679651442e-4i)
+(num-test (tanh 5.0e-01+6.28353057416258753420e+00i) 4.6211720058436229974e-1+2.7153443992641126612e-4i)
+(num-test (tanh 5.0e-01-6.28353057416258753420e+00i) 4.6211720058436229974e-1-2.7153443992641126612e-4i)
+(num-test (tanh -5.0e-01+6.28353057416258753420e+00i) -4.6211720058436229974e-1+2.7153443992641126612e-4i)
+(num-test (tanh -5.0e-01-6.28353057416258753420e+00i) -4.6211720058436229974e-1-2.7153443992641126612e-4i)
+(num-test (tanh 5.0e-01+9.42443269378637893396e+00i) 4.6211720058436229968e-1-2.7153443992619432056e-4i)
+(num-test (tanh 5.0e-01-9.42443269378637893396e+00i) 4.6211720058436229968e-1+2.7153443992619432056e-4i)
+(num-test (tanh -5.0e-01+9.42443269378637893396e+00i) -4.6211720058436229968e-1-2.7153443992619432056e-4i)
+(num-test (tanh -5.0e-01-9.42443269378637893396e+00i) -4.6211720058436229968e-1+2.7153443992619432056e-4i)
+(num-test (tanh 5.0e-01+9.42512322775237976202e+00i) 4.6211720058436229949e-1+2.7153443992561644811e-4i)
+(num-test (tanh 5.0e-01-9.42512322775237976202e+00i) 4.6211720058436229949e-1-2.7153443992561644811e-4i)
+(num-test (tanh -5.0e-01+9.42512322775237976202e+00i) -4.6211720058436229949e-1+2.7153443992561644811e-4i)
+(num-test (tanh -5.0e-01-9.42512322775237976202e+00i) -4.6211720058436229949e-1-2.7153443992561644811e-4i)
+(num-test (tanh 1.0e+00-3.45266983001243932001e-04i) 7.6159419408485704836e-1-1.4500326960274960880e-4i)
+(num-test (tanh 1.0e+00+3.45266983001243932001e-04i) 7.6159419408485704836e-1+1.4500326960274960880e-4i)
+(num-test (tanh -1.0e+00-3.45266983001243932001e-04i) -7.6159419408485704836e-1-1.4500326960274960880e-4i)
+(num-test (tanh -1.0e+00+3.45266983001243932001e-04i) -7.6159419408485704836e-1+1.4500326960274960880e-4i)
+(num-test (tanh 1.0e+00+1.57045105981189525579e+00i) 1.3130351721648674823e0+2.4999454374276273814e-4i)
+(num-test (tanh 1.0e+00-1.57045105981189525579e+00i) 1.3130351721648674823e0-2.4999454374276273814e-4i)
+(num-test (tanh -1.0e+00+1.57045105981189525579e+00i) -1.3130351721648674823e0+2.4999454374276273814e-4i)
+(num-test (tanh -1.0e+00-1.57045105981189525579e+00i) -1.3130351721648674823e0-2.4999454374276273814e-4i)
+(num-test (tanh 1.0e+00+1.57114159377789786021e+00i) 1.3130351721648674824e0-2.4999454374267406620e-4i)
+(num-test (tanh 1.0e+00-1.57114159377789786021e+00i) 1.3130351721648674824e0+2.4999454374267406620e-4i)
+(num-test (tanh -1.0e+00+1.57114159377789786021e+00i) -1.3130351721648674824e0-2.4999454374267406620e-4i)
+(num-test (tanh -1.0e+00-1.57114159377789786021e+00i) -1.3130351721648674824e0+2.4999454374267406620e-4i)
+(num-test (tanh 1.0e+00+3.14124738660679181379e+00i) 7.6159419408485704840e-1-1.4500326960282551519e-4i)
+(num-test (tanh 1.0e+00-3.14124738660679181379e+00i) 7.6159419408485704840e-1+1.4500326960282551519e-4i)
+(num-test (tanh -1.0e+00+3.14124738660679181379e+00i) -7.6159419408485704840e-1-1.4500326960282551519e-4i)
+(num-test (tanh -1.0e+00-3.14124738660679181379e+00i) -7.6159419408485704840e-1+1.4500326960282551519e-4i)
+(num-test (tanh 1.0e+00+3.14193792057279441821e+00i) 7.6159419408485704835e-1+1.4500326960272265115e-4i)
+(num-test (tanh 1.0e+00-3.14193792057279441821e+00i) 7.6159419408485704835e-1-1.4500326960272265115e-4i)
+(num-test (tanh -1.0e+00+3.14193792057279441821e+00i) -7.6159419408485704835e-1+1.4500326960272265115e-4i)
+(num-test (tanh -1.0e+00-3.14193792057279441821e+00i) -7.6159419408485704835e-1-1.4500326960272265115e-4i)
+(num-test (tanh 1.0e+00+4.71204371340168837179e+00i) 1.3130351721648674822e0+2.4999454374285141007e-4i)
+(num-test (tanh 1.0e+00-4.71204371340168837179e+00i) 1.3130351721648674822e0-2.4999454374285141007e-4i)
+(num-test (tanh -1.0e+00+4.71204371340168837179e+00i) -1.3130351721648674822e0+2.4999454374285141007e-4i)
+(num-test (tanh -1.0e+00-4.71204371340168837179e+00i) -1.3130351721648674822e0-2.4999454374285141007e-4i)
+(num-test (tanh 1.0e+00+4.71273424736769097620e+00i) 1.3130351721648674825e0-2.4999454374258539427e-4i)
+(num-test (tanh 1.0e+00-4.71273424736769097620e+00i) 1.3130351721648674825e0+2.4999454374258539427e-4i)
+(num-test (tanh -1.0e+00+4.71273424736769097620e+00i) -1.3130351721648674825e0-2.4999454374258539427e-4i)
+(num-test (tanh -1.0e+00-4.71273424736769097620e+00i) -1.3130351721648674825e0+2.4999454374258539427e-4i)
+(num-test (tanh 1.0e+00+6.28284004019658492979e+00i) 7.6159419408485704843e-1-1.4500326960287694721e-4i)
+(num-test (tanh 1.0e+00-6.28284004019658492979e+00i) 7.6159419408485704843e-1+1.4500326960287694721e-4i)
+(num-test (tanh -1.0e+00+6.28284004019658492979e+00i) -7.6159419408485704843e-1-1.4500326960287694721e-4i)
+(num-test (tanh -1.0e+00-6.28284004019658492979e+00i) -7.6159419408485704843e-1+1.4500326960287694721e-4i)
+(num-test (tanh 1.0e+00+6.28353057416258753420e+00i) 7.6159419408485704832e-1+1.4500326960267121913e-4i)
+(num-test (tanh 1.0e+00-6.28353057416258753420e+00i) 7.6159419408485704832e-1-1.4500326960267121913e-4i)
+(num-test (tanh -1.0e+00+6.28353057416258753420e+00i) -7.6159419408485704832e-1+1.4500326960267121913e-4i)
+(num-test (tanh -1.0e+00-6.28353057416258753420e+00i) -7.6159419408485704832e-1-1.4500326960267121913e-4i)
+(num-test (tanh 1.0e+00+9.42443269378637893396e+00i) 7.6159419408485704826e-1-1.4500326960255536711e-4i)
+(num-test (tanh 1.0e+00-9.42443269378637893396e+00i) 7.6159419408485704826e-1+1.4500326960255536711e-4i)
+(num-test (tanh -1.0e+00+9.42443269378637893396e+00i) -7.6159419408485704826e-1-1.4500326960255536711e-4i)
+(num-test (tanh -1.0e+00-9.42443269378637893396e+00i) -7.6159419408485704826e-1+1.4500326960255536711e-4i)
+(num-test (tanh 1.0e+00+9.42512322775237976202e+00i) 7.6159419408485704810e-1+1.450032696022467750e-4i)
+(num-test (tanh 1.0e+00-9.42512322775237976202e+00i) 7.6159419408485704810e-1-1.450032696022467750e-4i)
+(num-test (tanh -1.0e+00+9.42512322775237976202e+00i) -7.6159419408485704810e-1+1.450032696022467750e-4i)
+(num-test (tanh -1.0e+00-9.42512322775237976202e+00i) -7.6159419408485704810e-1-1.450032696022467750e-4i)
+(num-test (tanh 2.0e+00-3.45266983001243932001e-04i) 9.6402758819508310556e-1-2.4393395410435306874e-5i)
+(num-test (tanh 2.0e+00+3.45266983001243932001e-04i) 9.6402758819508310556e-1+2.4393395410435306874e-5i)
+(num-test (tanh -2.0e+00-3.45266983001243932001e-04i) -9.6402758819508310556e-1-2.4393395410435306874e-5i)
+(num-test (tanh -2.0e+00+3.45266983001243932001e-04i) -9.6402758819508310556e-1+2.4393395410435306874e-5i)
+(num-test (tanh 2.0e+00+1.57045105981189525579e+00i) 1.0373147113268752620e0+2.6247825506572821595e-5i)
+(num-test (tanh 2.0e+00-1.57045105981189525579e+00i) 1.0373147113268752620e0-2.6247825506572821595e-5i)
+(num-test (tanh -2.0e+00+1.57045105981189525579e+00i) -1.0373147113268752620e0+2.6247825506572821595e-5i)
+(num-test (tanh -2.0e+00-1.57045105981189525579e+00i) -1.0373147113268752620e0-2.6247825506572821595e-5i)
+(num-test (tanh 2.0e+00+1.57114159377789786021e+00i) 1.0373147113268752620e0-2.6247825506563511609e-5i)
+(num-test (tanh 2.0e+00-1.57114159377789786021e+00i) 1.0373147113268752620e0+2.6247825506563511609e-5i)
+(num-test (tanh -2.0e+00+1.57114159377789786021e+00i) -1.0373147113268752620e0-2.6247825506563511609e-5i)
+(num-test (tanh -2.0e+00-1.57114159377789786021e+00i) -1.0373147113268752620e0+2.6247825506563511609e-5i)
+(num-test (tanh 2.0e+00+3.14124738660679181379e+00i) 9.6402758819508310557e-1-2.4393395410448076340e-5i)
+(num-test (tanh 2.0e+00-3.14124738660679181379e+00i) 9.6402758819508310557e-1+2.4393395410448076340e-5i)
+(num-test (tanh -2.0e+00+3.14124738660679181379e+00i) -9.6402758819508310557e-1-2.4393395410448076340e-5i)
+(num-test (tanh -2.0e+00-3.14124738660679181379e+00i) -9.6402758819508310557e-1+2.4393395410448076340e-5i)
+(num-test (tanh 2.0e+00+3.14193792057279441821e+00i) 9.6402758819508310556e-1+2.4393395410430771882e-5i)
+(num-test (tanh 2.0e+00-3.14193792057279441821e+00i) 9.6402758819508310556e-1-2.4393395410430771882e-5i)
+(num-test (tanh -2.0e+00+3.14193792057279441821e+00i) -9.6402758819508310556e-1+2.4393395410430771882e-5i)
+(num-test (tanh -2.0e+00-3.14193792057279441821e+00i) -9.6402758819508310556e-1-2.4393395410430771882e-5i)
+(num-test (tanh 2.0e+00+4.71204371340168837179e+00i) 1.0373147113268752620e0+2.6247825506582131582e-5i)
+(num-test (tanh 2.0e+00-4.71204371340168837179e+00i) 1.0373147113268752620e0-2.6247825506582131582e-5i)
+(num-test (tanh -2.0e+00+4.71204371340168837179e+00i) -1.0373147113268752620e0+2.6247825506582131582e-5i)
+(num-test (tanh -2.0e+00-4.71204371340168837179e+00i) -1.0373147113268752620e0-2.6247825506582131582e-5i)
+(num-test (tanh 2.0e+00+4.71273424736769097620e+00i) 1.0373147113268752620e0-2.6247825506554201622e-5i)
+(num-test (tanh 2.0e+00-4.71273424736769097620e+00i) 1.0373147113268752620e0+2.6247825506554201622e-5i)
+(num-test (tanh -2.0e+00+4.71273424736769097620e+00i) -1.0373147113268752620e0-2.6247825506554201622e-5i)
+(num-test (tanh -2.0e+00-4.71273424736769097620e+00i) -1.0373147113268752620e0+2.6247825506554201622e-5i)
+(num-test (tanh 2.0e+00+6.28284004019658492979e+00i) 9.6402758819508310558e-1-2.4393395410456728569e-5i)
+(num-test (tanh 2.0e+00-6.28284004019658492979e+00i) 9.6402758819508310558e-1+2.4393395410456728569e-5i)
+(num-test (tanh -2.0e+00+6.28284004019658492979e+00i) -9.6402758819508310558e-1-2.4393395410456728569e-5i)
+(num-test (tanh -2.0e+00-6.28284004019658492979e+00i) -9.6402758819508310558e-1+2.4393395410456728569e-5i)
+(num-test (tanh 2.0e+00+6.28353057416258753420e+00i) 9.6402758819508310555e-1+2.4393395410422119654e-5i)
+(num-test (tanh 2.0e+00-6.28353057416258753420e+00i) 9.6402758819508310555e-1-2.4393395410422119654e-5i)
+(num-test (tanh -2.0e+00+6.28353057416258753420e+00i) -9.6402758819508310555e-1+2.4393395410422119654e-5i)
+(num-test (tanh -2.0e+00-6.28353057416258753420e+00i) -9.6402758819508310555e-1-2.4393395410422119654e-5i)
+(num-test (tanh 2.0e+00+9.42443269378637893396e+00i) 9.6402758819508310554e-1-2.4393395410402630273e-5i)
+(num-test (tanh 2.0e+00-9.42443269378637893396e+00i) 9.6402758819508310554e-1+2.4393395410402630273e-5i)
+(num-test (tanh -2.0e+00+9.42443269378637893396e+00i) -9.6402758819508310554e-1-2.4393395410402630273e-5i)
+(num-test (tanh -2.0e+00-9.42443269378637893396e+00i) -9.6402758819508310554e-1+2.4393395410402630273e-5i)
+(num-test (tanh 2.0e+00+9.42512322775237976202e+00i) 9.6402758819508310550e-1+2.439339541035071690e-5i)
+(num-test (tanh 2.0e+00-9.42512322775237976202e+00i) 9.6402758819508310550e-1-2.439339541035071690e-5i)
+(num-test (tanh -2.0e+00+9.42512322775237976202e+00i) -9.6402758819508310550e-1+2.439339541035071690e-5i)
+(num-test (tanh -2.0e+00-9.42512322775237976202e+00i) -9.6402758819508310550e-1-2.439339541035071690e-5i)
+(num-test (tanh 50) 1.0)
+(num-test (tanh -2.225073858507201399999999999999999999996E-308) -2.225073858507201399999999999999999999996E-308)
+(num-test (tanh 1.110223024625156799999999999999999999997E-16) 1.110223024625156799999999999999995438476E-16)
+
+(test (nan? (tanh 1/0)) #t)
+;(test (nan? (tanh 1/0+i)) #t)
+;(test (nan? (tanh 1/0+1/0i)) #t)
+(test (nan? (tanh 1+1/0i)) #t)
+(test (nan? (tanh 0+1/0i)) #t)
+;(test (nan? (tanh 1/0+0i)) #t)
+(num-test (tanh (complex -400.0 1.0)) -1.0)
+
+(for-each
+ (lambda (num-and-val)
+   (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'tanh num (tanh num) val)))
+ (vector (list 0 0) (list 1 0.76159415595576) (list 2 0.96402758007582) (list 3 0.99505475368673)
+	 (list -1 -0.76159415595576) (list -2 -0.96402758007582) (list -3 -0.99505475368673)
+	 (list 9223372036854775807 1.0) (list -9223372036854775808 -1.0) (list 1/2 0.46211715726001)
+	 (list 1/3 0.32151273753163) (list -1/2 -0.46211715726001) (list -1/3 -0.32151273753163)
+	 (list 1/9223372036854775807 1.0842021724855e-19) (list 0.0 0.0) (list 1.0 0.76159415595576)
+	 (list 2.0 0.96402758007582) (list -2.0 -0.96402758007582) (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309)
+	 (list 1e+16 1.0) (list +inf.0 1.0) (list -inf.0 -1.0) (list 0+1i 0+1.5574077246549i)
+	 (list 0+2i 0-2.1850398632615i) (list 0-1i 0-1.5574077246549i) (list 1+1i 1.0839233273387+0.27175258531951i)
+	 (list 1-1i 1.0839233273387-0.27175258531951i) (list -1+1i -1.0839233273387+0.27175258531951i)
+	 (list -1-1i -1.0839233273387-0.27175258531951i) (list 0.1+0.1i 0.10066129051146+0.099328043521656i)
+	 (list 1e+16+1e+16i 1.0) (list 1e-16+1e-16i 1e-16+1e-16i) ))
+
+(test (tanh) 'error)
+(test (tanh "hi") 'error)
+(test (tanh 1.0+23.0i 1.0+23.0i) 'error)
+(test (tanh 0 1) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (tanh arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+;;; --------------------------------------------------------------------------------
+;;; asinh
+;;; --------------------------------------------------------------------------------
+
+(num-test (asinh 0) 0.0)
+(num-test (asinh 1) 0.88137358701954)
+(num-test (asinh -1) -0.88137358701954)
+(num-test (asinh 2) 1.44363547517881)
+(num-test (asinh -2) -1.44363547517881)
+(num-test (asinh 3) 1.81844645923207)
+(num-test (asinh -3) -1.81844645923207)
+(num-test (asinh 10) 2.99822295029797)
+(num-test (asinh -10) -2.99822295029798)
+(num-test (asinh 1234) 7.81116354920125)
+(num-test (asinh -1234) -7.81116354896171)
+(num-test (asinh 500029) 13.81556855628334)
+(num-test (asinh 0/1) 0.0)
+(num-test (asinh 0/2) 0.0)
+(num-test (asinh 0/3) 0.0)
+(num-test (asinh 0/10) 0.0)
+(num-test (asinh 0/1234) 0.0)
+(num-test (asinh 0/500029) 0.0)
+(num-test (asinh 1/1) 0.88137358701954)
+(num-test (asinh -1/1) -0.88137358701954)
+(num-test (asinh 1/2) 0.48121182505960)
+(num-test (asinh -1/2) -0.48121182505960)
+(num-test (asinh 1/3) 0.32745015023726)
+(num-test (asinh -1/3) -0.32745015023726)
+(num-test (asinh 1/10) 0.09983407889921)
+(num-test (asinh -1/10) -0.09983407889921)
+(num-test (asinh 1/1234) 0.00081037268278)
+(num-test (asinh -1/1234) -0.00081037268278)
+(num-test (asinh 1/500029) 0.00000199988401)
+(num-test (asinh -1/500029) -0.00000199988401)
+(num-test (asinh 2/1) 1.44363547517881)
+(num-test (asinh -2/1) -1.44363547517881)
+(num-test (asinh 2/2) 0.88137358701954)
+(num-test (asinh -2/2) -0.88137358701954)
+(num-test (asinh 2/3) 0.62514511725042)
+(num-test (asinh -2/3) -0.62514511725042)
+(num-test (asinh 2/10) 0.19869011034924)
+(num-test (asinh -2/10) -0.19869011034924)
+(num-test (asinh 2/1234) 0.00162074483338)
+(num-test (asinh -2/1234) -0.00162074483338)
+(num-test (asinh 2/500029) 0.00000399976801)
+(num-test (asinh -2/500029) -0.00000399976801)
+(num-test (asinh 3/1) 1.81844645923207)
+(num-test (asinh -3/1) -1.81844645923207)
+(num-test (asinh 3/2) 1.19476321728711)
+(num-test (asinh -3/2) -1.19476321728711)
+(num-test (asinh 3/3) 0.88137358701954)
+(num-test (asinh -3/3) -0.88137358701954)
+(num-test (asinh 3/10) 0.29567304756342)
+(num-test (asinh -3/10) -0.29567304756342)
+(num-test (asinh 3/1234) 0.00243111591964)
+(num-test (asinh -3/1234) -0.00243111591964)
+(num-test (asinh 3/500029) 0.00000599965202)
+(num-test (asinh -3/500029) -0.00000599965202)
+(num-test (asinh 10/1) 2.99822295029797)
+(num-test (asinh -10/1) -2.99822295029798)
+(num-test (asinh 10/2) 2.31243834127275)
+(num-test (asinh -10/2) -2.31243834127276)
+(num-test (asinh 10/3) 1.91889647209853)
+(num-test (asinh -10/3) -1.91889647209853)
+(num-test (asinh 10/10) 0.88137358701954)
+(num-test (asinh -10/10) -0.88137358701954)
+(num-test (asinh 10/1234) 0.00810363902153)
+(num-test (asinh -10/1234) -0.00810363902153)
+(num-test (asinh 10/500029) 0.00001999884007)
+(num-test (asinh -10/500029) -0.00001999884007)
+(num-test (asinh 1234/1) 7.81116354920125)
+(num-test (asinh -1234/1) -7.81116354896171)
+(num-test (asinh 1234/2) 7.11801686116871)
+(num-test (asinh -1234/2) -7.11801686109890)
+(num-test (asinh 1234/3) 6.71255257393796)
+(num-test (asinh -1234/3) -6.71255257391934)
+(num-test (asinh 1234/10) 5.50859470922766)
+(num-test (asinh -1234/10) -5.50859470922637)
+(num-test (asinh 1234/500029) 0.00246785435930)
+(num-test (asinh -1234/500029) -0.00246785435930)
+(num-test (asinh 500029/1) 13.81556855628334)
+(num-test (asinh 500029/2) 13.12242137572639)
+(num-test (asinh 500029/3) 12.71695626762323)
+(num-test (asinh -500029/3) -12.71695626762323)
+(num-test (asinh 500029/10) 11.51298346338828)
+(num-test (asinh -500029/10) -11.51298333576987)
+(num-test (asinh 500029/1234) 6.69755387439290)
+(num-test (asinh -500029/1234) -6.69755387437470)
+(num-test (asinh 500029/500029) 0.88137358701954)
+(num-test (asinh -500029/500029) -0.88137358701954)
+(num-test (asinh 0.0) 0.0)
+(num-test (asinh 0.00000001) 0.00000001)
+(num-test (asinh -0.00000001) -0.00000001)
+(num-test (asinh 1.0) 0.88137358701954)
+(num-test (asinh -1.0) -0.88137358701954)
+(num-test (asinh pi) 1.86229574331085)
+(num-test (asinh -3.14159265358979) -1.86229574331085)
+(num-test (asinh 1234.0) 7.81116354920125)
+(num-test (asinh -1234.0) -7.81116354896171)
+(num-test (asinh 0.0+0.0i) 0.0)
+(num-test (asinh -0.0+0.0i) 0.0)
+(num-test (asinh 0.0-0.0i) 0.0)
+(num-test (asinh -0.0-0.0i) 0.0)
+(num-test (asinh 0.0+0.00000001i) 0.0+0.00000001i)
+(num-test (asinh -0.0+0.00000001i) 0.0+0.00000001i)
+(num-test (asinh 0.0-0.00000001i) 0.0-0.00000001i)
+(num-test (asinh -0.0-0.00000001i) 0.0-0.00000001i)
+(num-test (asinh 0.0+1.0i) 0.0+1.57079632679490i)
+(num-test (asinh -0.0+1.0i) 0.0+1.57079632679490i)
+(num-test (asinh 0.0-1.0i) 0.0-1.57079632679490i)
+(num-test (asinh -0.0-1.0i) 0.0-1.57079632679490i)
+(num-test (asinh 0.0+3.14159265358979i) 1.81152627246085+1.57079632679490i)
+(num-test (asinh -0.0+3.14159265358979i) 1.81152627246085+1.57079632679490i)
+(num-test (asinh 0.0-3.14159265358979i) 1.81152627246085-1.57079632679490i)
+(num-test (asinh -0.0-3.14159265358979i) -1.81152627246085-1.57079632679490i)
+(num-test (asinh 0.0+1234.0i) 7.81116322084923+1.57079632679490i)
+(num-test (asinh -0.0+1234.0i) 7.81116322084923+1.57079632679490i)
+(num-test (asinh 0.0-1234.0i) 7.81116322084923-1.57079632679490i)
+(num-test (asinh -0.0-1234.0i) -7.81116322068415-1.57079632679490i)
+(num-test (asinh 0.00000001+0.0i) 0.00000001)
+(num-test (asinh -0.00000001+0.0i) -0.00000001)
+(num-test (asinh 0.00000001-0.0i) 0.00000001)
+(num-test (asinh -0.00000001-0.0i) -0.00000001)
+(num-test (asinh 0.00000001+0.00000001i) 0.00000001+0.00000001i)
+(num-test (asinh -0.00000001+0.00000001i) -0.00000001+0.00000001i)
+(num-test (asinh 0.00000001-0.00000001i) 0.00000001-0.00000001i)
+(num-test (asinh -0.00000001-0.00000001i) -0.00000001-0.00000001i)
+(num-test (asinh 0.00000001+1.0i) 0.00010000000008+1.57069632679498i)
+(num-test (asinh -0.00000001+1.0i) -0.00010000000008+1.57069632679498i)
+(num-test (asinh 0.00000001-1.0i) 0.00010000000008-1.57069632679498i)
+(num-test (asinh -0.00000001-1.0i) -0.00010000000008-1.57069632679498i)
+(num-test (asinh 0.00000001+3.14159265358979i) 1.81152627246085+1.57079632343715i)
+(num-test (asinh -0.00000001+3.14159265358979i) -1.81152627246085+1.57079632343715i)
+(num-test (asinh 0.00000001-3.14159265358979i) 1.81152627246085-1.57079632343715i)
+(num-test (asinh -0.00000001-3.14159265358979i) -1.81152627246085-1.57079632343715i)
+(num-test (asinh 0.00000001+1234.0i) 7.81116322084923+1.57079632678679i)
+(num-test (asinh -0.00000001+1234.0i) -7.81116322068415+1.57079632678679i)
+(num-test (asinh 0.00000001-1234.0i) 7.81116322084923-1.57079632678679i)
+(num-test (asinh -0.00000001-1234.0i) -7.81116322068415-1.57079632678679i)
+(num-test (asinh 1.0+0.0i) 0.88137358701954)
+(num-test (asinh -1.0+0.0i) -0.88137358701954)
+(num-test (asinh 1.0-0.0i) 0.88137358701954)
+(num-test (asinh -1.0-0.0i) -0.88137358701954)
+(num-test (asinh 1.0+0.00000001i) 0.88137358701954+0.00000000707107i)
+(num-test (asinh -1.0+0.00000001i) -0.88137358701954+0.00000000707107i)
+(num-test (asinh 1.0-0.00000001i) 0.88137358701954-0.00000000707107i)
+(num-test (asinh -1.0-0.00000001i) -0.88137358701954-0.00000000707107i)
+(num-test (asinh 1.0+1.0i) 1.06127506190504+0.66623943249252i)
+(num-test (asinh -1.0+1.0i) -1.06127506190504+0.66623943249252i)
+(num-test (asinh 1.0-1.0i) 1.06127506190504-0.66623943249252i)
+(num-test (asinh -1.0-1.0i) -1.06127506190504-0.66623943249252i)
+(num-test (asinh 1.0+3.14159265358979i) 1.86711439316026+1.24854303281344i)
+(num-test (asinh -1.0+3.14159265358979i) -1.86711439316026+1.24854303281344i)
+(num-test (asinh 1.0-3.14159265358979i) 1.86711439316026-1.24854303281344i)
+(num-test (asinh -1.0-3.14159265358979i) -1.86711439316026-1.24854303281344i)
+(num-test (asinh 1.0+1234.0i) 7.81116354920146+1.56998595393473i)
+(num-test (asinh -1.0+1234.0i) -7.81116354944842+1.56998595393442i)
+(num-test (asinh 1.0-1234.0i) 7.81116354920146-1.56998595393473i)
+(num-test (asinh -1.0-1234.0i) -7.81116354944842-1.56998595393442i)
+(num-test (asinh 3.14159265358979+0.0i) 1.86229574331085)
+(num-test (asinh -3.14159265358979+0.0i) -1.86229574331085)
+(num-test (asinh 3.14159265358979-0.0i) 1.86229574331085)
+(num-test (asinh -3.14159265358979-0.0i) -1.86229574331085)
+(num-test (asinh 3.14159265358979+0.00000001i) 1.86229574331085+0.00000000303314i)
+(num-test (asinh -3.14159265358979+0.00000001i) -1.86229574331085+0.00000000303314i)
+(num-test (asinh 3.14159265358979-0.00000001i) 1.86229574331085-0.00000000303314i)
+(num-test (asinh -3.14159265358979-0.00000001i) -1.86229574331085-0.00000000303314i)
+(num-test (asinh 3.14159265358979+1.0i) 1.90462768697066+0.29558503421163i)
+(num-test (asinh -3.14159265358979+1.0i) -1.90462768697066+0.29558503421163i)
+(num-test (asinh 3.14159265358979-1.0i) 1.90462768697066-0.29558503421163i)
+(num-test (asinh -3.14159265358979-1.0i) -1.90462768697066-0.29558503421163i)
+(num-test (asinh 3.14159265358979+3.14159265358979i) 2.18469104082751+0.77273977912748i)
+(num-test (asinh -3.14159265358979+3.14159265358979i) -2.18469104082751+0.77273977912748i)
+(num-test (asinh 3.14159265358979-3.14159265358979i) 2.18469104082751-0.77273977912748i)
+(num-test (asinh -3.14159265358979-3.14159265358979i) -2.18469104082751-0.77273977912748i)
+(num-test (asinh 3.14159265358979+1234.0i) 7.81116646154641+1.56825047031367i)
+(num-test (asinh -3.14159265358979+1234.0i) -7.81116646138554+1.56825047031506i)
+(num-test (asinh 3.14159265358979-1234.0i) 7.81116646154641-1.56825047031367i)
+(num-test (asinh -3.14159265358979-1234.0i) -7.81116646138554-1.56825047031506i)
+(num-test (asinh 1234.0+0.0i) 7.81116354920125)
+(num-test (asinh -1234.0+0.0i) -7.81116354896171)
+(num-test (asinh 1234.0-0.0i) 7.81116354920125)
+(num-test (asinh -1234.0-0.0i) -7.81116354896171)
+(num-test (asinh 1234.0+0.00000001i) 7.81116354920125+0.00000000000810i)
+(num-test (asinh -1234.0+0.00000001i) -7.81116354896171+0.00000000000810i)
+(num-test (asinh 1234.0-0.00000001i) 7.81116354920125-0.00000000000810i)
+(num-test (asinh -1234.0-0.00000001i) -7.81116354896171-0.00000000000810i)
+(num-test (asinh 1234.0+1.0i) 7.81116387755283+0.00081037232800i)
+(num-test (asinh -1234.0+1.0i) -7.81116387772663+0.00081037232806i)
+(num-test (asinh 1234.0-1.0i) 7.81116387755283-0.00081037232800i)
+(num-test (asinh -1234.0-1.0i) -7.81116387772663-0.00081037232806i)
+(num-test (asinh 1234.0+3.14159265358979i) 7.81116678989204+0.00254585480937i)
+(num-test (asinh -1234.0+3.14159265358979i) -7.81116678966949+0.00254585480900i)
+(num-test (asinh 1234.0-3.14159265358979i) 7.81116678989204-0.00254585480937i)
+(num-test (asinh -1234.0-3.14159265358979i) -7.81116678966949-0.00254585480900i)
+(num-test (asinh 1234.0+1234.0i) 8.15773697530526+0.78539808130944i)
+(num-test (asinh -1234.0+1234.0i) -8.15773697538346+0.78539808146835i)
+(num-test (asinh 1234.0-1234.0i) 8.15773697530526-0.78539808130944i)
+(num-test (asinh -1234.0-1234.0i) -8.15773697538346-0.78539808146835i)
+(num-test (asinh -500029/2) -13.12242137572639)
+(num-test (asinh 0.0e+00+0.0e+00i) 0e0+0.0i)
+(num-test (asinh 0.0e+00+1.19209289550781250e-07i) 0+1.1920928955078153234e-7i)
+(num-test (asinh 0.0e+00-1.19209289550781250e-07i) 0-1.1920928955078153234e-7i)
+(num-test (asinh 0.0e+00+5.0e-01i) 0+5.2359877559829887308e-1i)
+(num-test (asinh 0.0e+00-5.0e-01i) 0-5.2359877559829887308e-1i)
+(num-test (asinh 0.0e+00+1.0e+00i) 0+1.5707963267948966192e0i)
+(num-test (asinh 0.0e+00-1.0e+00i) 0-1.5707963267948966192e0i)
+(num-test (asinh 0.0e+00+2.0e+00i) 1.3169578969248167086e0+1.5707963267948966192e0i)
+(num-test (asinh 0.0e+00-2.0e+00i) -1.3169578969248167086e0-1.5707963267948966192e0i)
+(num-test (asinh 0.0e+00+8.3886080e+06i) 1.6635532333438683873e1+1.5707963267948966192e0i)
+(num-test (asinh 0.0e+00-8.3886080e+06i) -1.6635532333438683873e1-1.5707963267948966192e0i)
+(num-test (asinh 1.19209289550781250e-07+0.0e+00i) 1.1920928955078096766e-7+0.0i)
+(num-test (asinh -1.19209289550781250e-07+0.0e+00i) -1.1920928955078096766e-7+0.0i)
+(num-test (asinh 1.19209289550781250e-07+1.19209289550781250e-07i) 1.1920928955078181469e-7+1.1920928955078068531e-7i)
+(num-test (asinh 1.19209289550781250e-07-1.19209289550781250e-07i) 1.1920928955078181469e-7-1.1920928955078068531e-7i)
+(num-test (asinh -1.19209289550781250e-07+1.19209289550781250e-07i) -1.1920928955078181469e-7+1.1920928955078068531e-7i)
+(num-test (asinh -1.19209289550781250e-07-1.19209289550781250e-07i) -1.1920928955078181469e-7-1.1920928955078068531e-7i)
+(num-test (asinh 1.19209289550781250e-07+5.0e-01i) 1.3765103082409432364e-7+5.2359877559829340332e-1i)
+(num-test (asinh 1.19209289550781250e-07-5.0e-01i) 1.3765103082409432364e-7-5.2359877559829340332e-1i)
+(num-test (asinh -1.19209289550781250e-07+5.0e-01i) -1.3765103082409432364e-7+5.2359877559829340332e-1i)
+(num-test (asinh -1.19209289550781250e-07-5.0e-01i) -1.3765103082409432364e-7-5.2359877559829340332e-1i)
+(num-test (asinh 1.19209289550781250e-07+1.0e+00i) 3.4526698643116312881e-4+1.5704510598153252947e0i)
+(num-test (asinh 1.19209289550781250e-07-1.0e+00i) 3.4526698643116312881e-4-1.5704510598153252947e0i)
+(num-test (asinh -1.19209289550781250e-07+1.0e+00i) -3.4526698643116312881e-4+1.5704510598153252947e0i)
+(num-test (asinh -1.19209289550781250e-07-1.0e+00i) -3.4526698643116312881e-4-1.5704510598153252947e0i)
+(num-test (asinh 1.19209289550781250e-07+2.0e+00i) 1.3169578969248194435e0+1.5707962579693812072e0i)
+(num-test (asinh 1.19209289550781250e-07-2.0e+00i) 1.3169578969248194435e0-1.5707962579693812072e0i)
+(num-test (asinh -1.19209289550781250e-07+2.0e+00i) -1.3169578969248194435e0+1.5707962579693812072e0i)
+(num-test (asinh -1.19209289550781250e-07-2.0e+00i) -1.3169578969248194435e0-1.5707962579693812072e0i)
+(num-test (asinh 1.19209289550781250e-07+8.3886080e+06i) 1.6635532333438683873e1+1.5707963267948824084e0i)
+(num-test (asinh 1.19209289550781250e-07-8.3886080e+06i) 1.6635532333438683873e1-1.5707963267948824084e0i)
+(num-test (asinh -1.19209289550781250e-07+8.3886080e+06i) -1.6635532333438683873e1+1.5707963267948824084e0i)
+(num-test (asinh -1.19209289550781250e-07-8.3886080e+06i) -1.6635532333438683873e1-1.5707963267948824084e0i)
+(num-test (asinh 5.0e-01+0.0e+00i) 4.8121182505960344750e-1+0.0i)
+(num-test (asinh -5.0e-01+0.0e+00i) -4.8121182505960344750e-1+0.0i)
+(num-test (asinh 5.0e-01+1.19209289550781250e-07i) 4.8121182505960598961e-1+1.0662402999400097805e-7i)
+(num-test (asinh 5.0e-01-1.19209289550781250e-07i) 4.8121182505960598961e-1-1.0662402999400097805e-7i)
+(num-test (asinh -5.0e-01+1.19209289550781250e-07i) -4.8121182505960598961e-1+1.0662402999400097805e-7i)
+(num-test (asinh -5.0e-01-1.19209289550781250e-07i) -4.8121182505960598961e-1-1.0662402999400097805e-7i)
+(num-test (asinh 5.0e-01+5.0e-01i) 5.3063753095251782602e-1+4.5227844715119068206e-1i)
+(num-test (asinh 5.0e-01-5.0e-01i) 5.3063753095251782602e-1-4.5227844715119068206e-1i)
+(num-test (asinh -5.0e-01+5.0e-01i) -5.3063753095251782602e-1+4.5227844715119068206e-1i)
+(num-test (asinh -5.0e-01-5.0e-01i) -5.3063753095251782602e-1-4.5227844715119068206e-1i)
+(num-test (asinh 5.0e-01+1.0e+00i) 7.3285767597364526089e-1+8.9590748120889023907e-1i)
+(num-test (asinh 5.0e-01-1.0e+00i) 7.3285767597364526089e-1-8.9590748120889023907e-1i)
+(num-test (asinh -5.0e-01+1.0e+00i) -7.3285767597364526089e-1+8.9590748120889023907e-1i)
+(num-test (asinh -5.0e-01-1.0e+00i) -7.3285767597364526089e-1-8.9590748120889023907e-1i)
+(num-test (asinh 5.0e-01+2.0e+00i) 1.3618009008578457882e0+1.2930420702371826591e0i)
+(num-test (asinh 5.0e-01-2.0e+00i) 1.3618009008578457882e0-1.2930420702371826591e0i)
+(num-test (asinh -5.0e-01+2.0e+00i) -1.3618009008578457882e0+1.2930420702371826591e0i)
+(num-test (asinh -5.0e-01-2.0e+00i) -1.3618009008578457882e0-1.2930420702371826591e0i)
+(num-test (asinh 5.0e-01+8.3886080e+06i) 1.6635532333438685650e1+1.5707962671902518438e0i)
+(num-test (asinh 5.0e-01-8.3886080e+06i) 1.6635532333438685650e1-1.5707962671902518438e0i)
+(num-test (asinh -5.0e-01+8.3886080e+06i) -1.6635532333438685650e1+1.5707962671902518438e0i)
+(num-test (asinh -5.0e-01-8.3886080e+06i) -1.6635532333438685650e1-1.5707962671902518438e0i)
+(num-test (asinh 1.0e+00+0.0e+00i) 8.8137358701954302523e-1+0.0i)
+(num-test (asinh -1.0e+00+0.0e+00i) -8.8137358701954302523e-1+0.0i)
+(num-test (asinh 1.0e+00+1.19209289550781250e-07i) 8.8137358701954553738e-1+8.4293697021788013662e-8i)
+(num-test (asinh 1.0e+00-1.19209289550781250e-07i) 8.8137358701954553738e-1-8.4293697021788013662e-8i)
+(num-test (asinh -1.0e+00+1.19209289550781250e-07i) -8.8137358701954553738e-1+8.4293697021788013662e-8i)
+(num-test (asinh -1.0e+00-1.19209289550781250e-07i) -8.8137358701954553738e-1-8.4293697021788013662e-8i)
+(num-test (asinh 1.0e+00+5.0e-01i) 9.2613303135018242455e-1+3.4943906285721329363e-1i)
+(num-test (asinh 1.0e+00-5.0e-01i) 9.2613303135018242455e-1-3.4943906285721329363e-1i)
+(num-test (asinh -1.0e+00+5.0e-01i) -9.2613303135018242455e-1+3.4943906285721329363e-1i)
+(num-test (asinh -1.0e+00-5.0e-01i) -9.2613303135018242455e-1-3.4943906285721329363e-1i)
+(num-test (asinh 1.0e+00+1.0e+00i) 1.0612750619050356520e0+6.6623943249251525510e-1i)
+(num-test (asinh 1.0e+00-1.0e+00i) 1.0612750619050356520e0-6.6623943249251525510e-1i)
+(num-test (asinh -1.0e+00+1.0e+00i) -1.0612750619050356520e0+6.6623943249251525510e-1i)
+(num-test (asinh -1.0e+00-1.0e+00i) -1.0612750619050356520e0-6.6623943249251525510e-1i)
+(num-test (asinh 1.0e+00+2.0e+00i) 1.4693517443681852733e0+1.0634400235777520562e0i)
+(num-test (asinh 1.0e+00-2.0e+00i) 1.4693517443681852733e0-1.0634400235777520562e0i)
+(num-test (asinh -1.0e+00+2.0e+00i) -1.4693517443681852733e0+1.0634400235777520562e0i)
+(num-test (asinh -1.0e+00-2.0e+00i) -1.4693517443681852733e0-1.0634400235777520562e0i)
+(num-test (asinh 1.0e+00+8.3886080e+06i) 1.6635532333438690979e1+1.5707962075856070684e0i)
+(num-test (asinh 1.0e+00-8.3886080e+06i) 1.6635532333438690979e1-1.5707962075856070684e0i)
+(num-test (asinh -1.0e+00+8.3886080e+06i) -1.6635532333438690979e1+1.5707962075856070684e0i)
+(num-test (asinh -1.0e+00-8.3886080e+06i) -1.6635532333438690979e1-1.5707962075856070684e0i)
+(num-test (asinh 2.0e+00+0.0e+00i) 1.4436354751788103425e0+0.0i)
+(num-test (asinh -2.0e+00+0.0e+00i) -1.4436354751788103425e0+0.0i)
+(num-test (asinh 2.0e+00+1.19209289550781250e-07i) 1.4436354751788116136e0+5.3312014997000413263e-8i)
+(num-test (asinh 2.0e+00-1.19209289550781250e-07i) 1.4436354751788116136e0-5.3312014997000413263e-8i)
+(num-test (asinh -2.0e+00+1.19209289550781250e-07i) -1.4436354751788116136e0+5.3312014997000413263e-8i)
+(num-test (asinh -2.0e+00-1.19209289550781250e-07i) -1.4436354751788116136e0-5.3312014997000413263e-8i)
+(num-test (asinh 2.0e+00+5.0e-01i) 1.4657153519472905218e0+2.2101863562288385890e-1i)
+(num-test (asinh 2.0e+00-5.0e-01i) 1.4657153519472905218e0-2.2101863562288385890e-1i)
+(num-test (asinh -2.0e+00+5.0e-01i) -1.4657153519472905218e0+2.2101863562288385890e-1i)
+(num-test (asinh -2.0e+00-5.0e-01i) -1.4657153519472905218e0-2.2101863562288385890e-1i)
+(num-test (asinh 2.0e+00+1.0e+00i) 1.5285709194809981613e0+4.2707858639247612548e-1i)
+(num-test (asinh 2.0e+00-1.0e+00i) 1.5285709194809981613e0-4.2707858639247612548e-1i)
+(num-test (asinh -2.0e+00+1.0e+00i) -1.5285709194809981613e0+4.2707858639247612548e-1i)
+(num-test (asinh -2.0e+00-1.0e+00i) -1.5285709194809981613e0-4.2707858639247612548e-1i)
+(num-test (asinh 2.0e+00+2.0e+00i) 1.7343245214879664480e0+7.5424914469804604071e-1i)
+(num-test (asinh 2.0e+00-2.0e+00i) 1.7343245214879664480e0-7.5424914469804604071e-1i)
+(num-test (asinh -2.0e+00+2.0e+00i) -1.7343245214879664480e0+7.5424914469804604071e-1i)
+(num-test (asinh -2.0e+00-2.0e+00i) -1.7343245214879664480e0-7.5424914469804604071e-1i)
+(num-test (asinh 2.0e+00+8.3886080e+06i) 1.6635532333438712295e1+1.5707960883763175177e0i)
+(num-test (asinh 2.0e+00-8.3886080e+06i) 1.6635532333438712295e1-1.5707960883763175177e0i)
+(num-test (asinh -2.0e+00+8.3886080e+06i) -1.6635532333438712295e1+1.5707960883763175177e0i)
+(num-test (asinh -2.0e+00-8.3886080e+06i) -1.6635532333438712295e1-1.5707960883763175177e0i)
+(num-test (asinh 8.3886080e+06+0.0e+00i) 1.6635532333438690979e1+0.0i)
+(num-test (asinh -8.3886080e+06+0.0e+00i) -1.6635532333438690979e1+0.0i)
+(num-test (asinh 8.3886080e+06+1.19209289550781250e-07i) 1.6635532333438690979e1+1.4210854715201902743e-14i)
+(num-test (asinh 8.3886080e+06-1.19209289550781250e-07i) 1.6635532333438690979e1-1.4210854715201902743e-14i)
+(num-test (asinh -8.3886080e+06+1.19209289550781250e-07i) -1.6635532333438690979e1+1.4210854715201902743e-14i)
+(num-test (asinh -8.3886080e+06-1.19209289550781250e-07i) -1.6635532333438690979e1-1.4210854715201902743e-14i)
+(num-test (asinh 8.3886080e+06+5.0e-01i) 1.6635532333438692755e1+5.9604644775390130897e-8i)
+(num-test (asinh 8.3886080e+06-5.0e-01i) 1.6635532333438692755e1-5.9604644775390130897e-8i)
+(num-test (asinh -8.3886080e+06+5.0e-01i) -1.6635532333438692755e1+5.9604644775390130897e-8i)
+(num-test (asinh -8.3886080e+06-5.0e-01i) -1.6635532333438692755e1-5.9604644775390130897e-8i)
+(num-test (asinh 8.3886080e+06+1.0e+00i) 1.6635532333438698084e1+1.1920928955077983828e-7i)
+(num-test (asinh 8.3886080e+06-1.0e+00i) 1.6635532333438698084e1-1.1920928955077983828e-7i)
+(num-test (asinh -8.3886080e+06+1.0e+00i) -1.6635532333438698084e1+1.1920928955077983828e-7i)
+(num-test (asinh -8.3886080e+06-1.0e+00i) -1.6635532333438698084e1-1.1920928955077983828e-7i)
+(num-test (asinh 8.3886080e+06+2.0e+00i) 1.663553233343871940e1+2.3841857910155628843e-7i)
+(num-test (asinh 8.3886080e+06-2.0e+00i) 1.663553233343871940e1-2.3841857910155628843e-7i)
+(num-test (asinh -8.3886080e+06+2.0e+00i) -1.663553233343871940e1+2.3841857910155628843e-7i)
+(num-test (asinh -8.3886080e+06-2.0e+00i) -1.663553233343871940e1-2.3841857910155628843e-7i)
+(num-test (asinh 8.3886080e+06+8.3886080e+06i) 1.6982105923718660081e1+7.8539816339744653326e-1i)
+(num-test (asinh 8.3886080e+06-8.3886080e+06i) 1.6982105923718660081e1-7.8539816339744653326e-1i)
+(num-test (asinh -8.3886080e+06+8.3886080e+06i) -1.6982105923718660081e1+7.8539816339744653326e-1i)
+(num-test (asinh -8.3886080e+06-8.3886080e+06i) -1.6982105923718660081e1-7.8539816339744653326e-1i)
+(num-test (asinh -2.225073858507201399999999999999999999996E-308) -2.225073858507201399999999999999999999996E-308)
+(num-test (asinh 1.110223024625156799999999999999999999997E-16) 1.11022302462515679999999999999999771924E-16)
+
+(for-each
+ (lambda (num-and-val)
+   (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'asinh num (asinh num) val)))
+ (vector (list 0 0) (list 1 0.88137358701954) (list 2 1.4436354751788) (list 3 1.8184464592321)
+	 (list -1 -0.88137358701954) (list -2 -1.4436354751788) (list -3 -1.8184464592321)
+	 (list 9223372036854775807 44.361419555836) (list -9223372036854775808 -44.361419555836)
+	 (list 1/2 0.4812118250596) (list 1/3 0.32745015023726) (list -1/2 -0.4812118250596)
+	 (list -1/3 -0.32745015023726) (list 1/9223372036854775807 1.0842021724855e-19) (list 0.0 0.0)
+	 (list 1.0 0.88137358701954) (list 2.0 1.4436354751788) (list -2.0 -1.4436354751788)
+	 (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309)
+	 (list 1e+16 37.534508668465) (list 0+1i 0+1.5707963267949i) (list 0+2i 1.3169578969248+1.5707963267949i)
+	 (list 0-1i 0-1.5707963267949i) (list 1+1i 1.061275061905+0.66623943249252i) (list 1-1i 1.061275061905-0.66623943249252i)
+	 (list -1+1i -1.061275061905+0.66623943249252i) (list -1-1i -1.061275061905-0.66623943249252i)
+	 (list 0.1+0.1i 0.10033029811221+0.099663702859795i) (list 1e+16+1e+16i 37.881082258745+0.78539816339745i)
+	 (list 1e-16+1e-16i 0+1e-16i) ))
+
+(test (asinh) 'error)
+(test (asinh "hi") 'error)
+(test (asinh 1.0+23.0i 1.0+23.0i) 'error)
+(test (asinh 0 1) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (asinh arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; acosh
+;;; --------------------------------------------------------------------------------
+
+(num-test (acosh 0) 0.0+1.57079632679490i)
+(num-test (acosh 1) 0.0)
+(num-test (acosh -1) 0.0+3.14159265358979i)
+(num-test (acosh 2) 1.31695789692482)
+(num-test (acosh -2) 1.31695789692482+3.14159265358979i)
+(num-test (acosh 3) 1.76274717403909)
+(num-test (acosh -3) 1.76274717403909+3.14159265358979i)
+(num-test (acosh 10) 2.99322284612638)
+(num-test (acosh -10) 2.99322284612638+3.14159265358979i)
+(num-test (acosh 1234) 7.81116322084923)
+(num-test (acosh -1234) 7.81116322084923+3.14159265358979i)
+(num-test (acosh 500029) 13.81556855628134)
+(num-test (acosh -500029) 13.81556855628134+3.14159265358979i)
+(num-test (acosh 0/1) 0.0+1.57079632679490i)
+(num-test (acosh 0/2) 0.0+1.57079632679490i)
+(num-test (acosh 0/3) 0.0+1.57079632679490i)
+(num-test (acosh 0/10) 0.0+1.57079632679490i)
+(num-test (acosh 0/1234) 0.0+1.57079632679490i)
+(num-test (acosh 0/500029) 0.0+1.57079632679490i)
+(num-test (acosh 1/1) 0.0)
+(num-test (acosh -1/1) 0.0+3.14159265358979i)
+(num-test (acosh 1/2) 0.0+1.04719755119660i)
+(num-test (acosh -1/2) 0.0+2.09439510239320i)
+(num-test (acosh 1/3) 0.0+1.23095941734077i)
+(num-test (acosh -1/3) 0.0+1.91063323624902i)
+(num-test (acosh 1/10) 0.0+1.47062890563334i)
+(num-test (acosh -1/10) 0.0+1.67096374795646i)
+(num-test (acosh 1/1234) 0.0+1.56998595393473i)
+(num-test (acosh -1/1234) 0.0+1.57160669965507i)
+(num-test (acosh 1/500029) 0.0+1.57079432691089i)
+(num-test (acosh -1/500029) 0.0+1.57079832667890i)
+(num-test (acosh 2/1) 1.31695789692482)
+(num-test (acosh -2/1) 1.31695789692482+3.14159265358979i)
+(num-test (acosh 2/2) 0.0)
+(num-test (acosh -2/2) 0.0+3.14159265358979i)
+(num-test (acosh 2/3) 0.0+0.84106867056793i)
+(num-test (acosh -2/3) 0.0+2.30052398302186i)
+(num-test (acosh 2/10) 0.0+1.36943840600457i)
+(num-test (acosh -2/10) 0.0+1.77215424758523i)
+(num-test (acosh 2/1234) 0.0+1.56917558054238i)
+(num-test (acosh -2/1234) 0.0+1.57241707304741i)
+(num-test (acosh 2/500029) 0.0+1.57079232702688i)
+(num-test (acosh -2/500029) 0.0+1.57080032656291i)
+(num-test (acosh 3/1) 1.76274717403909)
+(num-test (acosh -3/1) 1.76274717403909+3.14159265358979i)
+(num-test (acosh 3/2) 0.96242365011921)
+(num-test (acosh -3/2) 0.96242365011921+3.14159265358979i)
+(num-test (acosh 3/3) 0.0)
+(num-test (acosh -3/3) 0.0+3.14159265358979i)
+(num-test (acosh 3/10) 0.0+1.26610367277950i)
+(num-test (acosh -3/10) 0.0+1.87548898081029i)
+(num-test (acosh 3/1234) 0.0+1.56836520608568i)
+(num-test (acosh -3/1234) 0.0+1.57322744750412i)
+(num-test (acosh 3/500029) 0.0+1.57079032714288i)
+(num-test (acosh -3/500029) 0.0+1.57080232644692i)
+(num-test (acosh 10/1) 2.99322284612638)
+(num-test (acosh -10/1) 2.99322284612638+3.14159265358979i)
+(num-test (acosh 10/2) 2.29243166956118)
+(num-test (acosh -10/2) 2.29243166956118+3.14159265358979i)
+(num-test (acosh 10/3) 1.87382024252741)
+(num-test (acosh -10/3) 1.87382024252741+3.14159265358979i)
+(num-test (acosh 10/10) 0.0)
+(num-test (acosh -10/10) 0.0+3.14159265358979i)
+(num-test (acosh 10/1234) 0.0+1.56269251038168i)
+(num-test (acosh -10/1234) 0.0+1.57890014320811i)
+(num-test (acosh 10/500029) 0.0+1.57077632795483i)
+(num-test (acosh -10/500029) 0.0+1.57081632563497i)
+(num-test (acosh 1234/1) 7.81116322084923)
+(num-test (acosh -1234/1) 7.81116322084923+3.14159265358979i)
+(num-test (acosh 1234/2) 7.11801554776066)
+(num-test (acosh -1234/2) 7.11801554776066+3.14159265358979i)
+(num-test (acosh 1234/3) 6.71254961876983)
+(num-test (acosh -1234/3) 6.71254961876983+3.14159265358979i)
+(num-test (acosh 1234/10) 5.50856187402619)
+(num-test (acosh -1234/10) 5.50856187402619+3.14159265358979i)
+(num-test (acosh 1234/500029) 0.0+1.56832846742558i)
+(num-test (acosh -1234/500029) 0.0+1.57326418616421i)
+(num-test (acosh 500029/1) 13.81556855628134)
+(num-test (acosh -500029/1) 13.81556855628134+3.14159265358979i)
+(num-test (acosh 500029/2) 13.12242137571839)
+(num-test (acosh -500029/2) 13.12242137571839+3.14159265358979i)
+(num-test (acosh 500029/3) 12.71695626760523)
+(num-test (acosh -500029/3) 12.71695626760523+3.14159265358979i)
+(num-test (acosh 500029/10) 11.51298346318831)
+(num-test (acosh -500029/10) 11.51298346318831+3.14159265358979i)
+(num-test (acosh 500029/1234) 6.69755082923415)
+(num-test (acosh -500029/1234) 6.69755082923415+3.14159265358979i)
+(num-test (acosh 500029/500029) 0.0)
+(num-test (acosh -500029/500029) 0.0+3.14159265358979i)
+(num-test (acosh 0.0) 0.0+1.57079632679490i)
+(num-test (acosh 0.00000001) 0.0+1.57079631679490i)
+(num-test (acosh -0.00000001) 0.0+1.57079633679490i)
+(num-test (acosh 1.0) 0.0)
+(num-test (acosh -1.0) 0.0+3.14159265358979i)
+(num-test (acosh pi) 1.81152627246085)
+(num-test (acosh -3.14159265358979) 1.81152627246085+3.14159265358979i)
+(num-test (acosh 1234.0) 7.81116322084923)
+(num-test (acosh -1234.0) 7.81116322084923+3.14159265358979i)
+(num-test (acosh 0.0+0.0i) 0.0+1.57079632679490i)
+(num-test (acosh -0.0+0.0i) 0.0+1.57079632679490i)
+(num-test (acosh 0.0-0.0i) 0.0+1.57079632679490i)
+(num-test (acosh -0.0-0.0i) 0.0+1.57079632679490i)
+(num-test (acosh 0.0+0.00000001i) 0.00000001+1.57079632679490i)
+(num-test (acosh -0.0+0.00000001i) 0.00000001+1.57079632679490i)
+(num-test (acosh 0.0-0.00000001i) 0.00000001-1.57079632679490i)
+(num-test (acosh -0.0-0.00000001i) 0.00000001-1.57079632679490i)
+(num-test (acosh 0.0+1.0i) 0.88137358701954+1.57079632679490i)
+(num-test (acosh -0.0+1.0i) 0.88137358701954+1.57079632679490i)
+(num-test (acosh 0.0-1.0i) 0.88137358701954-1.57079632679490i)
+(num-test (acosh -0.0-1.0i) 0.88137358701954-1.57079632679490i)
+(num-test (acosh 0.0+3.14159265358979i) 1.86229574331085+1.57079632679490i)
+(num-test (acosh -0.0+3.14159265358979i) 1.86229574331085+1.57079632679490i)
+(num-test (acosh 0.0-3.14159265358979i) 1.86229574331085-1.57079632679490i)
+(num-test (acosh -0.0-3.14159265358979i) 1.86229574331085-1.57079632679490i)
+(num-test (acosh 0.0+1234.0i) 7.81116354920125+1.57079632679490i)
+(num-test (acosh -0.0+1234.0i) 7.81116354920125+1.57079632679490i)
+(num-test (acosh 0.0-1234.0i) 7.81116354920125-1.57079632679490i)
+(num-test (acosh -0.0-1234.0i) 7.81116354896171-1.57079632679490i)
+(num-test (acosh 0.00000001+0.0i) 0.0+1.57079631679490i)
+(num-test (acosh -0.00000001+0.0i) 0.0+1.57079633679490i)
+(num-test (acosh 0.00000001-0.0i) 0.0+1.57079631679490i)
+(num-test (acosh -0.00000001-0.0i) 0.0+1.57079633679490i)
+(num-test (acosh 0.00000001+0.00000001i) 0.00000001+1.57079631679490i)
+(num-test (acosh -0.00000001+0.00000001i) 0.00000001+1.57079633679490i)
+(num-test (acosh 0.00000001-0.00000001i) 0.00000001-1.57079631679490i)
+(num-test (acosh -0.00000001-0.00000001i) 0.00000001-1.57079633679490i)
+(num-test (acosh 0.00000001+1.0i) 0.88137358701954+1.57079631972383i)
+(num-test (acosh -0.00000001+1.0i) 0.88137358701954+1.57079633386596i)
+(num-test (acosh 0.00000001-1.0i) 0.88137358701954-1.57079631972383i)
+(num-test (acosh -0.00000001-1.0i) 0.88137358701954-1.57079633386596i)
+(num-test (acosh 0.00000001+3.14159265358979i) 1.86229574331085+1.57079632376175i)
+(num-test (acosh -0.00000001+3.14159265358979i) 1.86229574331085+1.57079632982804i)
+(num-test (acosh 0.00000001-3.14159265358979i) 1.86229574331085-1.57079632376175i)
+(num-test (acosh -0.00000001-3.14159265358979i) 1.86229574331085-1.57079632982804i)
+(num-test (acosh 0.00000001+1234.0i) 7.81116354920125+1.57079632678679i)
+(num-test (acosh -0.00000001+1234.0i) 7.81116354920125+1.57079632680300i)
+(num-test (acosh 0.00000001-1234.0i) 7.81116354920125-1.57079632678679i)
+(num-test (acosh -0.00000001-1234.0i) 7.81116354920125-1.57079632680300i)
+(num-test (acosh 1.0+0.0i) 0.0)
+(num-test (acosh -1.0+0.0i) 0.0+3.14159265358979i)
+(num-test (acosh 1.0-0.0i) 0.0)
+(num-test (acosh -1.0-0.0i) 0.0+3.14159265358979i)
+(num-test (acosh 1.0+0.00000001i) 0.00010000000008+0.00009999999992i)
+(num-test (acosh -1.0+0.00000001i) 0.00010000000008+3.14149265358988i)
+(num-test (acosh 1.0-0.00000001i) 0.00010000000008-0.00009999999992i)
+(num-test (acosh -1.0-0.00000001i) 0.00010000000008-3.14149265358988i)
+(num-test (acosh 1.0+1.0i) 1.06127506190504+0.90455689430238i)
+(num-test (acosh -1.0+1.0i) 1.06127506190504+2.23703575928741i)
+(num-test (acosh 1.0-1.0i) 1.06127506190504-0.90455689430238i)
+(num-test (acosh -1.0-1.0i) 1.06127506190504-2.23703575928741i)
+(num-test (acosh 1.0+3.14159265358979i) 1.90462768697066+1.27521129258327i)
+(num-test (acosh -1.0+3.14159265358979i) 1.90462768697066+1.86638136100653i)
+(num-test (acosh 1.0-3.14159265358979i) 1.90462768697066-1.27521129258327i)
+(num-test (acosh -1.0-3.14159265358979i) 1.90462768697066-1.86638136100653i)
+(num-test (acosh 1.0+1234.0i) 7.81116387755283+1.56998595446690i)
+(num-test (acosh -1.0+1234.0i) 7.81116387755283+1.57160669912289i)
+(num-test (acosh 1.0-1234.0i) 7.81116387755283-1.56998595446690i)
+(num-test (acosh -1.0-1234.0i) 7.81116387755283-1.57160669912289i)
+(num-test (acosh 3.14159265358979+0.0i) 1.81152627246085)
+(num-test (acosh -3.14159265358979+0.0i) 1.81152627246085+3.14159265358979i)
+(num-test (acosh 3.14159265358979-0.0i) 1.81152627246085)
+(num-test (acosh -3.14159265358979-0.0i) 1.81152627246085+3.14159265358979i)
+(num-test (acosh 3.14159265358979+0.00000001i) 1.81152627246085+0.00000000335775i)
+(num-test (acosh -3.14159265358979+0.00000001i) 1.81152627246085+3.14159265023205i)
+(num-test (acosh 3.14159265358979-0.00000001i) 1.81152627246085-0.00000000335775i)
+(num-test (acosh -3.14159265358979-0.00000001i) 1.81152627246085-3.14159265023205i)
+(num-test (acosh 3.14159265358979+1.0i) 1.86711439316026+0.32225329398146i)
+(num-test (acosh -3.14159265358979+1.0i) 1.86711439316026+2.81933935960833i)
+(num-test (acosh 3.14159265358979-1.0i) 1.86711439316026-0.32225329398146i)
+(num-test (acosh -3.14159265358979-1.0i) 1.86711439316026-2.81933935960833i)
+(num-test (acosh 3.14159265358979+3.14159265358979i) 2.18469104082751+0.79805654766741i)
+(num-test (acosh -3.14159265358979+3.14159265358979i) 2.18469104082751+2.34353610592238i)
+(num-test (acosh 3.14159265358979-3.14159265358979i) 2.18469104082751-0.79805654766741i)
+(num-test (acosh -3.14159265358979-3.14159265358979i) 2.18469104082751-2.34353610592238i)
+(num-test (acosh 3.14159265358979+1234.0i) 7.81116678989204+1.56825047198552i)
+(num-test (acosh -3.14159265358979+1234.0i) 7.81116678989204+1.57334218160427i)
+(num-test (acosh 3.14159265358979-1234.0i) 7.81116678989204-1.56825047198552i)
+(num-test (acosh -3.14159265358979-1234.0i) 7.81116678989204-1.57334218160427i)
+(num-test (acosh 1234.0+0.0i) 7.81116322084923)
+(num-test (acosh -1234.0+0.0i) 7.81116322084923+3.14159265358979i)
+(num-test (acosh 1234.0-0.0i) 7.81116322084923)
+(num-test (acosh -1234.0-0.0i) 7.81116322084923+3.14159265358979i)
+(num-test (acosh 1234.0+0.00000001i) 7.81116322084923+0.00000000000810i)
+(num-test (acosh -1234.0+0.00000001i) 7.81116322084923+3.14159265358169i)
+(num-test (acosh 1234.0-0.00000001i) 7.81116322084923-0.00000000000810i)
+(num-test (acosh -1234.0-0.00000001i) 7.81116322084923-3.14159265358169i)
+(num-test (acosh 1234.0+1.0i) 7.81116354920146+0.00081037286017i)
+(num-test (acosh -1234.0+1.0i) 7.81116354920146+3.14078228072962i)
+(num-test (acosh 1234.0-1.0i) 7.81116354920146-0.00081037286017i)
+(num-test (acosh -1234.0-1.0i) 7.81116354920146-3.14078228072962i)
+(num-test (acosh 1234.0+3.14159265358979i) 7.81116646154641+0.00254585648123i)
+(num-test (acosh -1234.0+3.14159265358979i) 7.81116646154641+3.13904679710856i)
+(num-test (acosh 1234.0-3.14159265358979i) 7.81116646154641-0.00254585648123i)
+(num-test (acosh -1234.0-3.14159265358979i) 7.81116646154641-3.13904679710856i)
+(num-test (acosh 1234.0+1234.0i) 8.15773697530526+0.78539824548545i)
+(num-test (acosh -1234.0+1234.0i) 8.15773697530526+2.35619440810434i)
+(num-test (acosh 1234.0-1234.0i) 8.15773697530526-0.78539824548545i)
+(num-test (acosh -1234.0-1234.0i) 8.15773697530526-2.35619440810434i)
+(num-test (acosh 0) 0+1.570796326794897i)
+(num-test (acosh 1) 0)
+(num-test (acosh -1) 0+3.141592653589793i)
+(num-test (acosh -1.0e+01) 2.9932228461263808979e0+3.1415926535897932385e0i)
+(num-test (acosh -2.0e+00) 1.3169578969248167086e0+3.1415926535897932385e0i)
+(num-test (acosh -1.0e+00) 0+3.1415926535897932385e0i)
+(num-test (acosh -7.50e-01) 0+2.4188584057763776273e0i)
+(num-test (acosh -5.0e-01) 0+2.0943951023931954923e0i)
+(num-test (acosh -1.250e-01) 0+1.6961241579629620161e0i)
+(num-test (acosh -3.45266983001243932001e-04) 0+1.5711415937847577022e0i)
+(num-test (acosh -1.19209289550781250e-07) 0+1.570796446004186170e0i)
+(num-test (acosh 0.0e+00) 0+1.5707963267948966192e0i)
+(num-test (acosh 1.19209289550781250e-07) 0+1.5707962075856070684e0i)
+(num-test (acosh 3.45266983001243932001e-04) 0+1.5704510598050355363e0i)
+(num-test (acosh 1.250e-01) 0+1.4454684956268312224e0i)
+(num-test (acosh 5.0e-01) 0+1.0471975511965977462e0i)
+(num-test (acosh 7.50e-01) 0+7.2273424781341561118e-1i)
+(num-test (acosh 1.0e+00) 0e0+0.0i)
+(num-test (acosh 2.0e+00) 1.3169578969248167086e0+0.0i)
+(num-test (acosh 1.0e+01) 2.9932228461263808979e0+0.0i)
+(num-test (acosh 0.0e+00+0.0e+00i) 0+1.5707963267948966192e0i)
+(num-test (acosh 0.0e+00+1.19209289550781250e-07i) 1.1920928955078096766e-7+1.5707963267948966192e0i)
+(num-test (acosh 0.0e+00-1.19209289550781250e-07i) 1.1920928955078096766e-7-1.5707963267948966192e0i)
+(num-test (acosh 0.0e+00+5.0e-01i) 4.8121182505960344750e-1+1.5707963267948966192e0i)
+(num-test (acosh 0.0e+00-5.0e-01i) 4.8121182505960344750e-1-1.5707963267948966192e0i)
+(num-test (acosh 0.0e+00+1.0e+00i) 8.8137358701954302523e-1+1.5707963267948966192e0i)
+(num-test (acosh 0.0e+00-1.0e+00i) 8.8137358701954302523e-1-1.5707963267948966192e0i)
+(num-test (acosh 0.0e+00+2.0e+00i) 1.4436354751788103425e0+1.5707963267948966192e0i)
+(num-test (acosh 0.0e+00-2.0e+00i) 1.4436354751788103425e0-1.5707963267948966192e0i)
+(num-test (acosh 0.0e+00+8.3886080e+06i) 1.6635532333438690979e1+1.5707963267948966192e0i)
+(num-test (acosh 0.0e+00-8.3886080e+06i) 1.6635532333438690979e1-1.5707963267948966192e0i)
+(num-test (acosh 1.19209289550781250e-07+0.0e+00i) 0+1.5707962075856070684e0i)
+(num-test (acosh -1.19209289550781250e-07+0.0e+00i) 0+1.570796446004186170e0i)
+(num-test (acosh 1.19209289550781250e-07+1.19209289550781250e-07i) 1.1920928955078181469e-7+1.5707962075856070685e0i)
+(num-test (acosh 1.19209289550781250e-07-1.19209289550781250e-07i) 1.1920928955078181469e-7-1.5707962075856070685e0i)
+(num-test (acosh -1.19209289550781250e-07+1.19209289550781250e-07i) 1.1920928955078181469e-7+1.570796446004186170e0i)
+(num-test (acosh -1.19209289550781250e-07-1.19209289550781250e-07i) 1.1920928955078181469e-7-1.570796446004186170e0i)
+(num-test (acosh 1.19209289550781250e-07+5.0e-01i) 4.8121182505960598961e-1+1.5707962201708666252e0i)
+(num-test (acosh 1.19209289550781250e-07-5.0e-01i) 4.8121182505960598961e-1-1.5707962201708666252e0i)
+(num-test (acosh -1.19209289550781250e-07+5.0e-01i) 4.8121182505960598961e-1+1.5707964334189266132e0i)
+(num-test (acosh -1.19209289550781250e-07-5.0e-01i) 4.8121182505960598961e-1-1.5707964334189266132e0i)
+(num-test (acosh 1.19209289550781250e-07+1.0e+00i) 8.8137358701954553738e-1+1.5707962425011995974e0i)
+(num-test (acosh 1.19209289550781250e-07-1.0e+00i) 8.8137358701954553738e-1-1.5707962425011995974e0i)
+(num-test (acosh -1.19209289550781250e-07+1.0e+00i) 8.8137358701954553738e-1+1.5707964110885936410e0i)
+(num-test (acosh -1.19209289550781250e-07-1.0e+00i) 8.8137358701954553738e-1-1.5707964110885936410e0i)
+(num-test (acosh 1.19209289550781250e-07+2.0e+00i) 1.4436354751788116136e0+1.5707962734828816222e0i)
+(num-test (acosh 1.19209289550781250e-07-2.0e+00i) 1.4436354751788116136e0-1.5707962734828816222e0i)
+(num-test (acosh -1.19209289550781250e-07+2.0e+00i) 1.4436354751788116136e0+1.5707963801069116162e0i)
+(num-test (acosh -1.19209289550781250e-07-2.0e+00i) 1.4436354751788116136e0-1.5707963801069116162e0i)
+(num-test (acosh 1.19209289550781250e-07+8.3886080e+06i) 1.6635532333438690979e1+1.5707963267948824084e0i)
+(num-test (acosh 1.19209289550781250e-07-8.3886080e+06i) 1.6635532333438690979e1-1.5707963267948824084e0i)
+(num-test (acosh -1.19209289550781250e-07+8.3886080e+06i) 1.6635532333438690979e1+1.5707963267949108301e0i)
+(num-test (acosh -1.19209289550781250e-07-8.3886080e+06i) 1.6635532333438690979e1-1.5707963267949108301e0i)
+(num-test (acosh 5.0e-01+0.0e+00i) 0+1.0471975511965977462e0i)
+(num-test (acosh -5.0e-01+0.0e+00i) 0+2.0943951023931954923e0i)
+(num-test (acosh 5.0e-01+1.19209289550781250e-07i) 1.3765103082409432364e-7+1.0471975511966032159e0i)
+(num-test (acosh 5.0e-01-1.19209289550781250e-07i) 1.3765103082409432364e-7-1.0471975511966032159e0i)
+(num-test (acosh -5.0e-01+1.19209289550781250e-07i) 1.3765103082409432364e-7+2.0943951023931900225e0i)
+(num-test (acosh -5.0e-01-1.19209289550781250e-07i) 1.3765103082409432364e-7-2.0943951023931900225e0i)
+(num-test (acosh 5.0e-01+5.0e-01i) 5.3063753095251782602e-1+1.1185178796437059372e0i)
+(num-test (acosh 5.0e-01-5.0e-01i) 5.3063753095251782602e-1-1.1185178796437059372e0i)
+(num-test (acosh -5.0e-01+5.0e-01i) 5.3063753095251782602e-1+2.0230747739460873013e0i)
+(num-test (acosh -5.0e-01-5.0e-01i) 5.3063753095251782602e-1-2.0230747739460873013e0i)
+(num-test (acosh 5.0e-01+1.0e+00i) 9.2613303135018242455e-1+1.2213572639376833256e0i)
+(num-test (acosh 5.0e-01-1.0e+00i) 9.2613303135018242455e-1-1.2213572639376833256e0i)
+(num-test (acosh -5.0e-01+1.0e+00i) 9.2613303135018242455e-1+1.9202353896521099129e0i)
+(num-test (acosh -5.0e-01-1.0e+00i) 9.2613303135018242455e-1-1.9202353896521099129e0i)
+(num-test (acosh 5.0e-01+2.0e+00i) 1.4657153519472905218e0+1.3497776911720127603e0i)
+(num-test (acosh 5.0e-01-2.0e+00i) 1.4657153519472905218e0-1.3497776911720127603e0i)
+(num-test (acosh -5.0e-01+2.0e+00i) 1.4657153519472905218e0+1.7918149624177804781e0i)
+(num-test (acosh -5.0e-01-2.0e+00i) 1.4657153519472905218e0-1.7918149624177804781e0i)
+(num-test (acosh 5.0e-01+8.3886080e+06i) 1.6635532333438692755e1+1.5707962671902518438e0i)
+(num-test (acosh 5.0e-01-8.3886080e+06i) 1.6635532333438692755e1-1.5707962671902518438e0i)
+(num-test (acosh -5.0e-01+8.3886080e+06i) 1.6635532333438692755e1+1.5707963863995413946e0i)
+(num-test (acosh -5.0e-01-8.3886080e+06i) 1.6635532333438692755e1-1.5707963863995413946e0i)
+(num-test (acosh 1.0e+00+0.0e+00i) 0e0+0.0i)
+(num-test (acosh -1.0e+00+0.0e+00i) 0+3.1415926535897932385e0i)
+(num-test (acosh 1.0e+00+1.19209289550781250e-07i) 3.4526698643116312881e-4+3.4526697957132450399e-4i)
+(num-test (acosh 1.0e+00-1.19209289550781250e-07i) 3.4526698643116312881e-4-3.4526697957132450399e-4i)
+(num-test (acosh -1.0e+00+1.19209289550781250e-07i) 3.4526698643116312881e-4+3.1412473866102219140e0i)
+(num-test (acosh -1.0e+00-1.19209289550781250e-07i) 3.4526698643116312881e-4-3.1412473866102219140e0i)
+(num-test (acosh 1.0e+00+5.0e-01i) 7.3285767597364526089e-1+6.7488884558600638016e-1i)
+(num-test (acosh 1.0e+00-5.0e-01i) 7.3285767597364526089e-1-6.7488884558600638016e-1i)
+(num-test (acosh -1.0e+00+5.0e-01i) 7.3285767597364526089e-1+2.4667038080037868583e0i)
+(num-test (acosh -1.0e+00-5.0e-01i) 7.3285767597364526089e-1-2.4667038080037868583e0i)
+(num-test (acosh 1.0e+00+1.0e+00i) 1.0612750619050356520e0+9.0455689430238136413e-1i)
+(num-test (acosh 1.0e+00-1.0e+00i) 1.0612750619050356520e0-9.0455689430238136413e-1i)
+(num-test (acosh -1.0e+00+1.0e+00i) 1.0612750619050356520e0+2.2370357592874118743e0i)
+(num-test (acosh -1.0e+00-1.0e+00i) 1.0612750619050356520e0-2.2370357592874118743e0i)
+(num-test (acosh 1.0e+00+2.0e+00i) 1.5285709194809981613e0+1.1437177404024204938e0i)
+(num-test (acosh 1.0e+00-2.0e+00i) 1.5285709194809981613e0-1.1437177404024204938e0i)
+(num-test (acosh -1.0e+00+2.0e+00i) 1.5285709194809981613e0+1.9978749131873727447e0i)
+(num-test (acosh -1.0e+00-2.0e+00i) 1.5285709194809981613e0-1.9978749131873727447e0i)
+(num-test (acosh 1.0e+00+8.3886080e+06i) 1.6635532333438698084e1+1.5707962075856070685e0i)
+(num-test (acosh 1.0e+00-8.3886080e+06i) 1.6635532333438698084e1-1.5707962075856070685e0i)
+(num-test (acosh -1.0e+00+8.3886080e+06i) 1.6635532333438698084e1+1.570796446004186170e0i)
+(num-test (acosh -1.0e+00-8.3886080e+06i) 1.6635532333438698084e1-1.570796446004186170e0i)
+(num-test (acosh 2.0e+00+0.0e+00i) 1.3169578969248167086e0+0.0i)
+(num-test (acosh -2.0e+00+0.0e+00i) 1.3169578969248167086e0+3.1415926535897932385e0i)
+(num-test (acosh 2.0e+00+1.19209289550781250e-07i) 1.3169578969248194435e0+6.8825515412047433504e-8i)
+(num-test (acosh 2.0e+00-1.19209289550781250e-07i) 1.3169578969248194435e0-6.8825515412047433504e-8i)
+(num-test (acosh -2.0e+00+1.19209289550781250e-07i) 1.3169578969248194435e0+3.1415925847642778264e0i)
+(num-test (acosh -2.0e+00-1.19209289550781250e-07i) 1.3169578969248194435e0-3.1415925847642778264e0i)
+(num-test (acosh 2.0e+00+5.0e-01i) 1.3618009008578457882e0+2.7775425655771396018e-1i)
+(num-test (acosh 2.0e+00-5.0e-01i) 1.3618009008578457882e0-2.7775425655771396018e-1i)
+(num-test (acosh -2.0e+00+5.0e-01i) 1.3618009008578457882e0+2.8638383970320792783e0i)
+(num-test (acosh -2.0e+00-5.0e-01i) 1.3618009008578457882e0-2.8638383970320792783e0i)
+(num-test (acosh 2.0e+00+1.0e+00i) 1.4693517443681852733e0+5.0735630321714456304e-1i)
+(num-test (acosh 2.0e+00-1.0e+00i) 1.4693517443681852733e0-5.0735630321714456304e-1i)
+(num-test (acosh -2.0e+00+1.0e+00i) 1.4693517443681852733e0+2.6342363503726486754e0i)
+(num-test (acosh -2.0e+00-1.0e+00i) 1.4693517443681852733e0-2.6342363503726486754e0i)
+(num-test (acosh 2.0e+00+2.0e+00i) 1.7343245214879664480e0+8.1654718209685057852e-1i)
+(num-test (acosh 2.0e+00-2.0e+00i) 1.7343245214879664480e0-8.1654718209685057852e-1i)
+(num-test (acosh -2.0e+00+2.0e+00i) 1.7343245214879664480e0+2.3250454714929426599e0i)
+(num-test (acosh -2.0e+00-2.0e+00i) 1.7343245214879664480e0-2.3250454714929426599e0i)
+(num-test (acosh 2.0e+00+8.3886080e+06i) 1.663553233343871940e1+1.5707960883763175177e0i)
+(num-test (acosh 2.0e+00-8.3886080e+06i) 1.663553233343871940e1-1.5707960883763175177e0i)
+(num-test (acosh -2.0e+00+8.3886080e+06i) 1.663553233343871940e1+1.5707965652134757208e0i)
+(num-test (acosh -2.0e+00-8.3886080e+06i) 1.663553233343871940e1-1.5707965652134757208e0i)
+(num-test (acosh 8.3886080e+06+0.0e+00i) 1.6635532333438683873e1+0.0i)
+(num-test (acosh -8.3886080e+06+0.0e+00i) 1.6635532333438683873e1+3.1415926535897932385e0i)
+(num-test (acosh 8.3886080e+06+1.19209289550781250e-07i) 1.6635532333438683873e1+1.4210854715202104692e-14i)
+(num-test (acosh 8.3886080e+06-1.19209289550781250e-07i) 1.6635532333438683873e1-1.4210854715202104692e-14i)
+(num-test (acosh -8.3886080e+06+1.19209289550781250e-07i) 1.6635532333438683873e1+3.1415926535897790276e0i)
+(num-test (acosh -8.3886080e+06-1.19209289550781250e-07i) 1.6635532333438683873e1-3.1415926535897790276e0i)
+(num-test (acosh 8.3886080e+06+5.0e-01i) 1.6635532333438685650e1+5.9604644775390977930e-8i)
+(num-test (acosh 8.3886080e+06-5.0e-01i) 1.6635532333438685650e1-5.9604644775390977930e-8i)
+(num-test (acosh -8.3886080e+06+5.0e-01i) 1.6635532333438685650e1+3.1415925939851484631e0i)
+(num-test (acosh -8.3886080e+06-5.0e-01i) 1.6635532333438685650e1-3.1415925939851484631e0i)
+(num-test (acosh 8.3886080e+06+1.0e+00i) 1.6635532333438690979e1+1.1920928955078153234e-7i)
+(num-test (acosh 8.3886080e+06-1.0e+00i) 1.6635532333438690979e1-1.1920928955078153234e-7i)
+(num-test (acosh -8.3886080e+06+1.0e+00i) 1.6635532333438690979e1+3.1415925343805036877e0i)
+(num-test (acosh -8.3886080e+06-1.0e+00i) 1.6635532333438690979e1-3.1415925343805036877e0i)
+(num-test (acosh 8.3886080e+06+2.0e+00i) 1.6635532333438712295e1+2.3841857910155967656e-7i)
+(num-test (acosh 8.3886080e+06-2.0e+00i) 1.6635532333438712295e1-2.3841857910155967656e-7i)
+(num-test (acosh -8.3886080e+06+2.0e+00i) 1.6635532333438712295e1+3.1415924151712141369e0i)
+(num-test (acosh -8.3886080e+06-2.0e+00i) 1.6635532333438712295e1-3.1415924151712141369e0i)
+(num-test (acosh 8.3886080e+06+8.3886080e+06i) 1.6982105923718660081e1+7.8539816339745008597e-1i)
+(num-test (acosh 8.3886080e+06-8.3886080e+06i) 1.6982105923718660081e1-7.8539816339745008597e-1i)
+(num-test (acosh -8.3886080e+06+8.3886080e+06i) 1.6982105923718660081e1+2.3561944901923431525e0i)
+(num-test (acosh -8.3886080e+06-8.3886080e+06i) 1.6982105923718660081e1-2.3561944901923431525e0i)
+(num-test (acosh -2.225073858507201399999999999999999999996E-308) 0.0+1.570796326794896619231321691639751442098E0i)
+(num-test (acosh 1.110223024625156799999999999999999999997E-16) 0.0+1.570796326794896508209019229124071442098E0i)
+
+(for-each
+ (lambda (num-and-val)
+   (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'acosh num (acosh num) val)))
+ (vector (list 0 0+1.5707963267949i) (list 1 0) (list 2 1.3169578969248) (list 3 1.7627471740391)
+	 (list -1 0+3.1415926535898i) (list -2 1.3169578969248+3.1415926535898i) (list -3 1.7627471740391+3.1415926535898i)
+	 (list 9223372036854775807 44.361419555836) (list -9223372036854775808 44.361419555836+3.1415926535898i)
+	 (list 1/2 0+1.0471975511966i) (list 1/3 0+1.2309594173408i) (list -1/2 0+2.0943951023932i)
+	 (list -1/3 0+1.910633236249i) (list 1/9223372036854775807 0+1.5707963267949i) (list 0.0 0+1.5707963267949i)
+	 (list 1.0 0.0) (list 2.0 1.3169578969248) (list -2.0 1.3169578969248+3.1415926535898i)
+	 (list 1.000000000000000000000000000000000000002E-309 0.0+1.570796326794896619231321691639751442098E0i)
+	 (list 1e+16 37.534508668465) (list 0+1i 0.88137358701954+1.5707963267949i) (list 0+2i 1.4436354751788+1.5707963267949i)
+	 (list 0-1i 0.88137358701954-1.5707963267949i) (list 1+1i 1.061275061905+0.90455689430238i)
+	 (list 1-1i 1.061275061905-0.90455689430238i) (list -1+1i 1.061275061905+2.2370357592874i)
+	 (list -1-1i 1.061275061905-2.2370357592874i) (list 0.1+0.1i 0.10033029811221+1.4711326239351i)
+	 (list 1e+16+1e+16i 37.881082258745+0.78539816339745i) (list 1e-16+1e-16i 0+1.5707963267949i)
+	 ))
+
+(test (acosh) 'error)
+(test (acosh "hi") 'error)
+(test (acosh 1.0+23.0i 1.0+23.0i) 'error)
+(test (acosh 0 1) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (acosh arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; atanh
+;;; --------------------------------------------------------------------------------
+
+(num-test (atanh 0) 0.0)
+(num-test (atanh 2) 0.54930614433405+1.57079632679490i)
+(num-test (atanh -2) -0.54930614433405+1.57079632679490i)
+(num-test (atanh 3) 0.34657359027997+1.57079632679490i)
+(num-test (atanh -3) -0.34657359027997+1.57079632679490i)
+(num-test (atanh 10) 0.10033534773108+1.57079632679490i)
+(num-test (atanh -10) -0.10033534773108+1.57079632679490i)
+(num-test (atanh 1234) 0.00081037294887+1.57079632679490i)
+(num-test (atanh -1234) -0.00081037294887+1.57079632679490i)
+(num-test (atanh 500029) 0.00000199988401+1.57079632679490i)
+(num-test (atanh -500029) -0.00000199988401+1.57079632679490i)
+(num-test (atanh 0/1) 0.0)
+(num-test (atanh 0/2) 0.0)
+(num-test (atanh 0/3) 0.0)
+(num-test (atanh 0/10) 0.0)
+(num-test (atanh 0/1234) 0.0)
+(num-test (atanh 0/500029) 0.0)
+(num-test (atanh 1/2) 0.54930614433405)
+(num-test (atanh -1/2) -0.54930614433405)
+(num-test (atanh 1/3) 0.34657359027997)
+(num-test (atanh -1/3) -0.34657359027997)
+(num-test (atanh 1/10) 0.10033534773108)
+(num-test (atanh -1/10) -0.10033534773108)
+(num-test (atanh 1/1234) 0.00081037294887)
+(num-test (atanh -1/1234) -0.00081037294887)
+(num-test (atanh 1/500029) 0.00000199988401)
+(num-test (atanh -1/500029) -0.00000199988401)
+(num-test (atanh 2/1) 0.54930614433405+1.57079632679490i)
+(num-test (atanh -2/1) -0.54930614433405+1.57079632679490i)
+(num-test (atanh 2/3) 0.80471895621705)
+(num-test (atanh -2/3) -0.80471895621705)
+(num-test (atanh 2/10) 0.20273255405408)
+(num-test (atanh -2/10) -0.20273255405408)
+(num-test (atanh 2/1234) 0.00162074696209)
+(num-test (atanh -2/1234) -0.00162074696209)
+(num-test (atanh 2/500029) 0.00000399976801)
+(num-test (atanh -2/500029) -0.00000399976801)
+(num-test (atanh 3/1) 0.34657359027997+1.57079632679490i)
+(num-test (atanh -3/1) -0.34657359027997+1.57079632679490i)
+(num-test (atanh 3/2) 0.80471895621705+1.57079632679490i)
+(num-test (atanh -3/2) -0.80471895621705+1.57079632679490i)
+(num-test (atanh 3/10) 0.30951960420311)
+(num-test (atanh -3/10) -0.30951960420311)
+(num-test (atanh 3/1234) 0.00243112310402)
+(num-test (atanh -3/1234) -0.00243112310402)
+(num-test (atanh 3/500029) 0.00000599965202)
+(num-test (atanh -3/500029) -0.00000599965202)
+(num-test (atanh 10/1) 0.10033534773108+1.57079632679490i)
+(num-test (atanh -10/1) -0.10033534773108+1.57079632679490i)
+(num-test (atanh 10/2) 0.20273255405408+1.57079632679490i)
+(num-test (atanh -10/2) -0.20273255405408+1.57079632679490i)
+(num-test (atanh 10/3) 0.30951960420311+1.57079632679490i)
+(num-test (atanh -10/3) -0.30951960420311+1.57079632679490i)
+(num-test (atanh 10/1234) 0.00810390511343)
+(num-test (atanh -10/1234) -0.00810390511343)
+(num-test (atanh 10/500029) 0.00001999884007)
+(num-test (atanh -10/500029) -0.00001999884007)
+(num-test (atanh 1234/1) 0.00081037294887+1.57079632679490i)
+(num-test (atanh -1234/1) -0.00081037294887+1.57079632679490i)
+(num-test (atanh 1234/2) 0.00162074696209+1.57079632679490i)
+(num-test (atanh -1234/2) -0.00162074696209+1.57079632679490i)
+(num-test (atanh 1234/3) 0.00243112310402+1.57079632679490i)
+(num-test (atanh -1234/3) -0.00243112310402+1.57079632679490i)
+(num-test (atanh 1234/10) 0.00810390511343+1.57079632679490i)
+(num-test (atanh -1234/10) -0.00810390511343+1.57079632679490i)
+(num-test (atanh 1234/500029) 0.00246786187433)
+(num-test (atanh -1234/500029) -0.00246786187433)
+(num-test (atanh 500029/1) 0.00000199988401+1.57079632679490i)
+(num-test (atanh -500029/1) -0.00000199988401+1.57079632679490i)
+(num-test (atanh 500029/2) 0.00000399976801+1.57079632679490i)
+(num-test (atanh -500029/2) -0.00000399976801+1.57079632679490i)
+(num-test (atanh 500029/3) 0.00000599965202+1.57079632679490i)
+(num-test (atanh -500029/3) -0.00000599965202+1.57079632679490i)
+(num-test (atanh 500029/10) 0.00001999884007+1.57079632679490i)
+(num-test (atanh -500029/10) -0.00001999884007+1.57079632679490i)
+(num-test (atanh 500029/1234) 0.00246786187433+1.57079632679490i)
+(num-test (atanh -500029/1234) -0.00246786187433+1.57079632679490i)
+(num-test (atanh 0.0) 0.0)
+(num-test (atanh 0.00000001) 0.00000001)
+(num-test (atanh -0.00000001) -0.00000001)
+(num-test (atanh pi) 0.32976531495670+1.57079632679490i)
+(num-test (atanh -3.14159265358979) -0.32976531495670+1.57079632679490i)
+(num-test (atanh 1234.0) 0.00081037294887+1.57079632679490i)
+(num-test (atanh -1234.0) -0.00081037294887+1.57079632679490i)
+(num-test (atanh 0.0+0.0i) 0.0)
+(num-test (atanh -0.0+0.0i) 0.0)
+(num-test (atanh 0.0-0.0i) 0.0)
+(num-test (atanh -0.0-0.0i) 0.0)
+(num-test (atanh 0.0+0.00000001i) 0.0+0.00000001i)
+(num-test (atanh -0.0+0.00000001i) 0.0+0.00000001i)
+(num-test (atanh 0.0-0.00000001i) 0.0-0.00000001i)
+(num-test (atanh -0.0-0.00000001i) 0.0-0.00000001i)
+(num-test (atanh 0.0+1.0i) -0.0+0.78539816339745i)
+(num-test (atanh -0.0+1.0i) -0.0+0.78539816339745i)
+(num-test (atanh 0.0-1.0i) -0.0-0.78539816339745i)
+(num-test (atanh -0.0-1.0i) -0.0-0.78539816339745i)
+(num-test (atanh 0.0+3.14159265358979i) -0.0+1.26262725567891i)
+(num-test (atanh -0.0+3.14159265358979i) -0.0+1.26262725567891i)
+(num-test (atanh 0.0-3.14159265358979i) -0.0-1.26262725567891i)
+(num-test (atanh -0.0-3.14159265358979i) -0.0-1.26262725567891i)
+(num-test (atanh 0.0+1234.0i) 0.0+1.56998595420081i)
+(num-test (atanh -0.0+1234.0i) 0.0+1.56998595420081i)
+(num-test (atanh 0.0-1234.0i) 0.0-1.56998595420081i)
+(num-test (atanh -0.0-1234.0i) 0.0-1.56998595420081i)
+(num-test (atanh 0.00000001+0.0i) 0.00000001)
+(num-test (atanh -0.00000001+0.0i) -0.00000001)
+(num-test (atanh 0.00000001-0.0i) 0.00000001)
+(num-test (atanh -0.00000001-0.0i) -0.00000001)
+(num-test (atanh 0.00000001+0.00000001i) 0.00000001+0.00000001i)
+(num-test (atanh -0.00000001+0.00000001i) -0.00000001+0.00000001i)
+(num-test (atanh 0.00000001-0.00000001i) 0.00000001-0.00000001i)
+(num-test (atanh -0.00000001-0.00000001i) -0.00000001-0.00000001i)
+(num-test (atanh 0.00000001+1.0i) 0.00000000500000+0.78539816339745i)
+(num-test (atanh -0.00000001+1.0i) -0.00000000500000+0.78539816339745i)
+(num-test (atanh 0.00000001-1.0i) 0.00000000500000-0.78539816339745i)
+(num-test (atanh -0.00000001-1.0i) -0.00000000500000-0.78539816339745i)
+(num-test (atanh 0.00000001+3.14159265358979i) 0.00000000092000+1.26262725567891i)
+(num-test (atanh -0.00000001+3.14159265358979i) -0.00000000092000+1.26262725567891i)
+(num-test (atanh 0.00000001-3.14159265358979i) 0.00000000092000-1.26262725567891i)
+(num-test (atanh -0.00000001-3.14159265358979i) -0.00000000092000-1.26262725567891i)
+(num-test (atanh 0.00000001+1234.0i) 0.00000000000001+1.56998595420081i)
+(num-test (atanh -0.00000001+1234.0i) -0.00000000000001+1.56998595420081i)
+(num-test (atanh 0.00000001-1234.0i) 0.00000000000001-1.56998595420081i)
+(num-test (atanh -0.00000001-1234.0i) -0.00000000000001-1.56998595420081i)
+(num-test (atanh 1.0+0.00000001i) 9.55691396225616+0.78539816589745i)
+(num-test (atanh -1.0+0.00000001i) -9.55691396225615+0.78539816589745i)
+(num-test (atanh 1.0-0.00000001i) 9.55691396225616-0.78539816589745i)
+(num-test (atanh -1.0-0.00000001i) -9.55691396225615-0.78539816589745i)
+(num-test (atanh 1.0+1.0i) 0.40235947810853+1.01722196789785i)
+(num-test (atanh -1.0+1.0i) -0.40235947810853+1.01722196789785i)
+(num-test (atanh 1.0-1.0i) 0.40235947810853-1.01722196789785i)
+(num-test (atanh -1.0-1.0i) -0.40235947810853-1.01722196789785i)
+(num-test (atanh 1.0+3.14159265358979i) 0.08505998507745+1.28734057432439i)
+(num-test (atanh -1.0+3.14159265358979i) -0.08505998507745+1.28734057432439i)
+(num-test (atanh 1.0-3.14159265358979i) 0.08505998507745-1.28734057432439i)
+(num-test (atanh -1.0-3.14159265358979i) -0.08505998507745-1.28734057432439i)
+(num-test (atanh 1.0+1234.0i) 0.00000065670317+1.56998595473299i)
+(num-test (atanh -1.0+1234.0i) -0.00000065670317+1.56998595473299i)
+(num-test (atanh 1.0-1234.0i) 0.00000065670317-1.56998595473299i)
+(num-test (atanh -1.0-1234.0i) -0.00000065670317-1.56998595473299i)
+(num-test (atanh 3.14159265358979+0.0i) 0.32976531495670+1.57079632679490i)
+(num-test (atanh -3.14159265358979+0.0i) -0.32976531495670+1.57079632679490i)
+(num-test (atanh 3.14159265358979-0.0i) 0.32976531495670+1.57079632679490i)
+(num-test (atanh -3.14159265358979-0.0i) -0.32976531495670+1.57079632679490i)
+(num-test (atanh 3.14159265358979+0.00000001i) 0.32976531495670+1.57079632566745i)
+(num-test (atanh -3.14159265358979+0.00000001i) -0.32976531495670+1.57079632566745i)
+(num-test (atanh 3.14159265358979-0.00000001i) 0.32976531495670-1.57079632566745i)
+(num-test (atanh -3.14159265358979-0.00000001i) -0.32976531495670-1.57079632566745i)
+(num-test (atanh 3.14159265358979+1.0i) 0.29462144034086+1.47082882591946i)
+(num-test (atanh -3.14159265358979+1.0i) -0.29462144034086+1.47082882591946i)
+(num-test (atanh 3.14159265358979-1.0i) 0.29462144034086-1.47082882591946i)
+(num-test (atanh -3.14159265358979-1.0i) -0.29462144034086-1.47082882591946i)
+(num-test (atanh 3.14159265358979+3.14159265358979i) 0.15638868878130+1.40903828502376i)
+(num-test (atanh -3.14159265358979+3.14159265358979i) -0.15638868878130+1.40903828502376i)
+(num-test (atanh 3.14159265358979-3.14159265358979i) 0.15638868878130-1.40903828502376i)
+(num-test (atanh -3.14159265358979-3.14159265358979i) -0.15638868878130-1.40903828502376i)
+(num-test (atanh 3.14159265358979+1234.0i) 0.00000206308183+1.56998595945313i)
+(num-test (atanh -3.14159265358979+1234.0i) -0.00000206308183+1.56998595945313i)
+(num-test (atanh 3.14159265358979-1234.0i) 0.00000206308183-1.56998595945313i)
+(num-test (atanh -3.14159265358979-1234.0i) -0.00000206308183-1.56998595945313i)
+(num-test (atanh 1234.0+0.0i) 0.00081037294887+1.57079632679490i)
+(num-test (atanh -1234.0+0.0i) -0.00081037294887+1.57079632679490i)
+(num-test (atanh 1234.0-0.0i) 0.00081037294887+1.57079632679490i)
+(num-test (atanh -1234.0-0.0i) -0.00081037294887+1.57079632679490i)
+(num-test (atanh 1234.0+0.00000001i) 0.00081037294887+1.57079632679489i)
+(num-test (atanh -1234.0+0.00000001i) -0.00081037294887+1.57079632679489i)
+(num-test (atanh 1234.0-0.00000001i) 0.00081037294887-1.57079632679489i)
+(num-test (atanh -1234.0-0.00000001i) -0.00081037294887-1.57079632679489i)
+(num-test (atanh 1234.0+1.0i) 0.00081037241669+1.57079567009087i)
+(num-test (atanh -1234.0+1.0i) -0.00081037241669+1.57079567009087i)
+(num-test (atanh 1234.0-1.0i) 0.00081037241669-1.57079567009087i)
+(num-test (atanh -1234.0-1.0i) -0.00081037241669-1.57079567009087i)
+(num-test (atanh 1234.0+3.14159265358979i) 0.00081036769654+1.57079426371036i)
+(num-test (atanh -1234.0+3.14159265358979i) -0.00081036769654+1.57079426371036i)
+(num-test (atanh 1234.0-3.14159265358979i) 0.00081036769654-1.57079426371036i)
+(num-test (atanh -1234.0-3.14159265358979i) -0.00081036769654-1.57079426371036i)
+(num-test (atanh 1234.0+1234.0i) 0.00040518634139+1.57039114036481i)
+(num-test (atanh -1234.0+1234.0i) -0.00040518634139+1.57039114036481i)
+(num-test (atanh 1234.0-1234.0i) 0.00040518634139-1.57039114036481i)
+(num-test (atanh -1234.0-1234.0i) -0.00040518634139-1.57039114036481i)
+(num-test (atanh -1.0e+01) -1.0033534773107558064e-1+1.5707963267948966192e0i)
+(num-test (atanh -2.0e+00) -5.4930614433405484570e-1+1.5707963267948966192e0i)
+(num-test (atanh -7.50e-01) -9.7295507452765665255e-1+0.0i)
+(num-test (atanh -5.0e-01) -5.4930614433405484570e-1+0.0i)
+(num-test (atanh -1.250e-01) -1.2565721414045303884e-1+0.0i)
+(num-test (atanh -3.45266983001243932001e-04) -3.4526699672092216295e-4+0.0i)
+(num-test (atanh -1.19209289550781250e-07) -1.1920928955078181469e-7+0.0i)
+(num-test (atanh 0.0e+00) 0e0+0.0i)
+(num-test (atanh 1.19209289550781250e-07) 1.1920928955078181469e-7+0.0i)
+(num-test (atanh 3.45266983001243932001e-04) 3.4526699672092216295e-4+0.0i)
+(num-test (atanh 1.250e-01) 1.2565721414045303884e-1+0.0i)
+(num-test (atanh 5.0e-01) 5.4930614433405484570e-1+0.0i)
+(num-test (atanh 7.50e-01) 9.7295507452765665255e-1+0.0i)
+(num-test (atanh 2.0e+00) 5.4930614433405484570e-1-1.5707963267948966192e0i)
+(num-test (atanh 1.0e+01) 1.0033534773107558064e-1-1.5707963267948966192e0i)
+(num-test (atanh 2.8147497671066e+14) 3.552713678800501e-15-1.570796326794897i)
+(num-test (atanh 0.0e+00+0.0e+00i) 0e0+0.0i)
+(num-test (atanh 0.0e+00+1.19209289550781250e-07i) 0+1.1920928955078068531e-7i)
+(num-test (atanh 0.0e+00-1.19209289550781250e-07i) 0-1.1920928955078068531e-7i)
+(num-test (atanh 0.0e+00+5.0e-01i) 0+4.6364760900080611621e-1i)
+(num-test (atanh 0.0e+00-5.0e-01i) 0-4.6364760900080611621e-1i)
+(num-test (atanh 0.0e+00+1.0e+00i) 0+7.8539816339744830962e-1i)
+(num-test (atanh 0.0e+00-1.0e+00i) 0-7.8539816339744830962e-1i)
+(num-test (atanh 0.0e+00+2.0e+00i) 0+1.1071487177940905030e0i)
+(num-test (atanh 0.0e+00-2.0e+00i) 0-1.1071487177940905030e0i)
+(num-test (atanh 0.0e+00+8.3886080e+06i) 0+1.5707962075856070685e0i)
+(num-test (atanh 0.0e+00-8.3886080e+06i) 0-1.5707962075856070685e0i)
+(num-test (atanh 1.19209289550781250e-07+0.0e+00i) 1.1920928955078181469e-7+0.0i)
+(num-test (atanh -1.19209289550781250e-07+0.0e+00i) -1.1920928955078181469e-7+0.0i)
+(num-test (atanh 1.19209289550781250e-07+1.19209289550781250e-07i) 1.1920928955078012062e-7+1.1920928955078237938e-7i)
+(num-test (atanh 1.19209289550781250e-07-1.19209289550781250e-07i) 1.1920928955078012062e-7-1.1920928955078237938e-7i)
+(num-test (atanh -1.19209289550781250e-07+1.19209289550781250e-07i) -1.1920928955078012062e-7+1.1920928955078237938e-7i)
+(num-test (atanh -1.19209289550781250e-07-1.19209289550781250e-07i) -1.1920928955078012062e-7-1.1920928955078237938e-7i)
+(num-test (atanh 1.19209289550781250e-07+5.0e-01i) 9.5367431640625072280e-8+4.6364760900081066369e-1i)
+(num-test (atanh 1.19209289550781250e-07-5.0e-01i) 9.5367431640625072280e-8-4.6364760900081066369e-1i)
+(num-test (atanh -1.19209289550781250e-07+5.0e-01i) -9.5367431640625072280e-8+4.6364760900081066369e-1i)
+(num-test (atanh -1.19209289550781250e-07-5.0e-01i) -9.5367431640625072280e-8-4.6364760900081066369e-1i)
+(num-test (atanh 1.19209289550781250e-07+1.0e+00i) 5.9604644775390483828e-8+7.8539816339745186233e-1i)
+(num-test (atanh 1.19209289550781250e-07-1.0e+00i) 5.9604644775390483828e-8-7.8539816339745186233e-1i)
+(num-test (atanh -1.19209289550781250e-07+1.0e+00i) -5.9604644775390483828e-8+7.8539816339745186233e-1i)
+(num-test (atanh -1.19209289550781250e-07-1.0e+00i) -5.9604644775390483828e-8-7.8539816339745186233e-1i)
+(num-test (atanh 1.19209289550781250e-07+2.0e+00i) 2.3841857910156200307e-8+1.1071487177940916399e0i)
+(num-test (atanh 1.19209289550781250e-07-2.0e+00i) 2.3841857910156200307e-8-1.1071487177940916399e0i)
+(num-test (atanh -1.19209289550781250e-07+2.0e+00i) -2.3841857910156200307e-8+1.1071487177940916399e0i)
+(num-test (atanh -1.19209289550781250e-07-2.0e+00i) -2.3841857910156200307e-8-1.1071487177940916399e0i)
+(num-test (atanh 1.19209289550781250e-07+8.3886080e+06i) 1.6940658945085766040e-21+1.5707962075856070685e0i)
+(num-test (atanh 1.19209289550781250e-07-8.3886080e+06i) 1.6940658945085766040e-21-1.5707962075856070685e0i)
+(num-test (atanh -1.19209289550781250e-07+8.3886080e+06i) -1.6940658945085766040e-21+1.5707962075856070685e0i)
+(num-test (atanh -1.19209289550781250e-07-8.3886080e+06i) -1.6940658945085766040e-21-1.5707962075856070685e0i)
+(num-test (atanh 5.0e-01+0.0e+00i) 5.4930614433405484570e-1+0.0i)
+(num-test (atanh -5.0e-01+0.0e+00i) -5.4930614433405484570e-1+0.0i)
+(num-test (atanh 5.0e-01+1.19209289550781250e-07i) 5.4930614433404221383e-1+1.5894571940103932425e-7i)
+(num-test (atanh 5.0e-01-1.19209289550781250e-07i) 5.4930614433404221383e-1-1.5894571940103932425e-7i)
+(num-test (atanh -5.0e-01+1.19209289550781250e-07i) -5.4930614433404221383e-1+1.5894571940103932425e-7i)
+(num-test (atanh -5.0e-01-1.19209289550781250e-07i) -5.4930614433404221383e-1-1.5894571940103932425e-7i)
+(num-test (atanh 5.0e-01+5.0e-01i) 4.0235947810852509365e-1+5.5357435889704525151e-1i)
+(num-test (atanh 5.0e-01-5.0e-01i) 4.0235947810852509365e-1-5.5357435889704525151e-1i)
+(num-test (atanh -5.0e-01+5.0e-01i) -4.0235947810852509365e-1+5.5357435889704525151e-1i)
+(num-test (atanh -5.0e-01-5.0e-01i) -4.0235947810852509365e-1-5.5357435889704525151e-1i)
+(num-test (atanh 5.0e-01+1.0e+00i) 2.3887786125685909036e-1+8.4757566067082902713e-1i)
+(num-test (atanh 5.0e-01-1.0e+00i) 2.3887786125685909036e-1-8.4757566067082902713e-1i)
+(num-test (atanh -5.0e-01+1.0e+00i) -2.3887786125685909036e-1+8.4757566067082902713e-1i)
+(num-test (atanh -5.0e-01-1.0e+00i) -2.3887786125685909036e-1-8.4757566067082902713e-1i)
+(num-test (atanh 5.0e-01+2.0e+00i) 9.6415620202996167238e-2+1.1265564408348223487e0i)
+(num-test (atanh 5.0e-01-2.0e+00i) 9.6415620202996167238e-2-1.1265564408348223487e0i)
+(num-test (atanh -5.0e-01+2.0e+00i) -9.6415620202996167238e-2+1.1265564408348223487e0i)
+(num-test (atanh -5.0e-01-2.0e+00i) -9.6415620202996167238e-2-1.1265564408348223487e0i)
+(num-test (atanh 5.0e-01+8.3886080e+06i) 7.1054273576008756410e-15+1.5707962075856070685e0i)
+(num-test (atanh 5.0e-01-8.3886080e+06i) 7.1054273576008756410e-15-1.5707962075856070685e0i)
+(num-test (atanh -5.0e-01+8.3886080e+06i) -7.1054273576008756410e-15+1.5707962075856070685e0i)
+(num-test (atanh -5.0e-01-8.3886080e+06i) -7.1054273576008756410e-15-1.5707962075856070685e0i)
+(num-test (atanh 1.0e+00+1.19209289550781250e-07i) 8.3177661667193446012e0+7.8539819319977069731e-1i)
+(num-test (atanh 1.0e+00-1.19209289550781250e-07i) 8.3177661667193446012e0-7.8539819319977069731e-1i)
+(num-test (atanh -1.0e+00+1.19209289550781250e-07i) -8.3177661667193446012e0+7.8539819319977069731e-1i)
+(num-test (atanh -1.0e+00-1.19209289550781250e-07i) -8.3177661667193446012e0-7.8539819319977069731e-1i)
+(num-test (atanh 1.0e+00+5.0e-01i) 7.0830333601405402006e-1+9.0788749496088038670e-1i)
+(num-test (atanh 1.0e+00-5.0e-01i) 7.0830333601405402006e-1-9.0788749496088038670e-1i)
+(num-test (atanh -1.0e+00+5.0e-01i) -7.0830333601405402006e-1+9.0788749496088038670e-1i)
+(num-test (atanh -1.0e+00-5.0e-01i) -7.0830333601405402006e-1-9.0788749496088038670e-1i)
+(num-test (atanh 1.0e+00+1.0e+00i) 4.0235947810852509365e-1+1.0172219678978513677e0i)
+(num-test (atanh 1.0e+00-1.0e+00i) 4.0235947810852509365e-1-1.0172219678978513677e0i)
+(num-test (atanh -1.0e+00+1.0e+00i) -4.0235947810852509365e-1+1.0172219678978513677e0i)
+(num-test (atanh -1.0e+00-1.0e+00i) -4.0235947810852509365e-1-1.0172219678978513677e0i)
+(num-test (atanh 1.0e+00+2.0e+00i) 1.7328679513998632735e-1+1.1780972450961724644e0i)
+(num-test (atanh 1.0e+00-2.0e+00i) 1.7328679513998632735e-1-1.1780972450961724644e0i)
+(num-test (atanh -1.0e+00+2.0e+00i) -1.7328679513998632735e-1+1.1780972450961724644e0i)
+(num-test (atanh -1.0e+00-2.0e+00i) -1.7328679513998632735e-1-1.1780972450961724644e0i)
+(num-test (atanh 1.0e+00+8.3886080e+06i) 1.4210854715201599821e-14+1.5707962075856070685e0i)
+(num-test (atanh 1.0e+00-8.3886080e+06i) 1.4210854715201599821e-14-1.5707962075856070685e0i)
+(num-test (atanh -1.0e+00+8.3886080e+06i) -1.4210854715201599821e-14+1.5707962075856070685e0i)
+(num-test (atanh -1.0e+00-8.3886080e+06i) -1.4210854715201599821e-14-1.5707962075856070685e0i)
+(num-test (atanh 2.0e+00+0.0e+00i) 5.4930614433405484570e-1-1.5707963267948966192e0i)
+(num-test (atanh -2.0e+00+0.0e+00i) -5.4930614433405484570e-1+1.5707963267948966192e0i)
+(num-test (atanh 2.0e+00+1.19209289550781250e-07i) 5.4930614433405168773e-1+1.5707962870584667690e0i)
+(num-test (atanh 2.0e+00-1.19209289550781250e-07i) 5.4930614433405168773e-1-1.5707962870584667690e0i)
+(num-test (atanh -2.0e+00+1.19209289550781250e-07i) -5.4930614433405168773e-1+1.5707962870584667690e0i)
+(num-test (atanh -2.0e+00-1.19209289550781250e-07i) -5.4930614433405168773e-1-1.5707962870584667690e0i)
+(num-test (atanh 2.0e+00+5.0e-01i) 5.0037000005253101744e-1+1.4215468610018069803e0i)
+(num-test (atanh 2.0e+00-5.0e-01i) 5.0037000005253101744e-1-1.4215468610018069803e0i)
+(num-test (atanh -2.0e+00+5.0e-01i) -5.0037000005253101744e-1+1.4215468610018069803e0i)
+(num-test (atanh -2.0e+00-5.0e-01i) -5.0037000005253101744e-1-1.4215468610018069803e0i)
+(num-test (atanh 2.0e+00+1.0e+00i) 4.0235947810852509365e-1+1.3389725222944935611e0i)
+(num-test (atanh 2.0e+00-1.0e+00i) 4.0235947810852509365e-1-1.3389725222944935611e0i)
+(num-test (atanh -2.0e+00+1.0e+00i) -4.0235947810852509365e-1+1.3389725222944935611e0i)
+(num-test (atanh -2.0e+00-1.0e+00i) -4.0235947810852509365e-1-1.3389725222944935611e0i)
+(num-test (atanh 2.0e+00+2.0e+00i) 2.3887786125685909036e-1+1.3112232696716351433e0i)
+(num-test (atanh 2.0e+00-2.0e+00i) 2.3887786125685909036e-1-1.3112232696716351433e0i)
+(num-test (atanh -2.0e+00+2.0e+00i) -2.3887786125685909036e-1+1.3112232696716351433e0i)
+(num-test (atanh -2.0e+00-2.0e+00i) -2.3887786125685909036e-1-1.3112232696716351433e0i)
+(num-test (atanh 2.0e+00+8.3886080e+06i) 2.8421709430401987951e-14+1.5707962075856070685e0i)
+(num-test (atanh 2.0e+00-8.3886080e+06i) 2.8421709430401987951e-14-1.5707962075856070685e0i)
+(num-test (atanh -2.0e+00+8.3886080e+06i) -2.8421709430401987951e-14+1.5707962075856070685e0i)
+(num-test (atanh -2.0e+00-8.3886080e+06i) -2.8421709430401987951e-14-1.5707962075856070685e0i)
+(num-test (atanh 8.3886080e+06+0.0e+00i) 1.1920928955078181469e-7-1.5707963267948966192e0i)
+(num-test (atanh -8.3886080e+06+0.0e+00i) -1.1920928955078181469e-7+1.5707963267948966192e0i)
+(num-test (atanh 8.3886080e+06+1.19209289550781250e-07i) 1.1920928955078181469e-7+1.5707963267948966192e0i)
+(num-test (atanh 8.3886080e+06-1.19209289550781250e-07i) 1.1920928955078181469e-7-1.5707963267948966192e0i)
+(num-test (atanh -8.3886080e+06+1.19209289550781250e-07i) -1.1920928955078181469e-7+1.5707963267948966192e0i)
+(num-test (atanh -8.3886080e+06-1.19209289550781250e-07i) -1.1920928955078181469e-7-1.5707963267948966192e0i)
+(num-test (atanh 8.3886080e+06+5.0e-01i) 1.1920928955078139117e-7+1.5707963267948895138e0i)
+(num-test (atanh 8.3886080e+06-5.0e-01i) 1.1920928955078139117e-7-1.5707963267948895138e0i)
+(num-test (atanh -8.3886080e+06+5.0e-01i) -1.1920928955078139117e-7+1.5707963267948895138e0i)
+(num-test (atanh -8.3886080e+06-5.0e-01i) -1.1920928955078139117e-7-1.5707963267948895138e0i)
+(num-test (atanh 8.3886080e+06+1.0e+00i) 1.1920928955078012062e-7+1.5707963267948824084e0i)
+(num-test (atanh 8.3886080e+06-1.0e+00i) 1.1920928955078012062e-7-1.5707963267948824084e0i)
+(num-test (atanh -8.3886080e+06+1.0e+00i) -1.1920928955078012062e-7+1.5707963267948824084e0i)
+(num-test (atanh -8.3886080e+06-1.0e+00i) -1.1920928955078012062e-7-1.5707963267948824084e0i)
+(num-test (atanh 8.3886080e+06+2.0e+00i) 1.1920928955077503843e-7+1.5707963267948681975e0i)
+(num-test (atanh 8.3886080e+06-2.0e+00i) 1.1920928955077503843e-7-1.5707963267948681975e0i)
+(num-test (atanh -8.3886080e+06+2.0e+00i) -1.1920928955077503843e-7+1.5707963267948681975e0i)
+(num-test (atanh -8.3886080e+06-2.0e+00i) -1.1920928955077503843e-7-1.5707963267948681975e0i)
+(num-test (atanh 8.3886080e+06+8.3886080e+06i) 5.9604644775390483828e-8+1.5707962671902518438e0i)
+(num-test (atanh 8.3886080e+06-8.3886080e+06i) 5.9604644775390483828e-8-1.5707962671902518438e0i)
+(num-test (atanh -8.3886080e+06+8.3886080e+06i) -5.9604644775390483828e-8+1.5707962671902518438e0i)
+(num-test (atanh -8.3886080e+06-8.3886080e+06i) -5.9604644775390483828e-8-1.5707962671902518438e0i)
+(num-test (atanh -2.225073858507201399999999999999999999996E-308) -2.225073858507201399999999999999999999996E-308)
+(num-test (atanh 1.110223024625156799999999999999999999997E-16) 1.110223024625156800000000000000004561517E-16)
+
+(when with-bignums
+  (num-test (atanh 9223372036854775/9223372036854776) 1.872683213842718135862772724835833552118E1)
+  (num-test (atanh 92233720368547758/92233720368547757) 1.987812468492420421418925039646711911969E1+1.570796326794896619231321691639751442098E0i)
+  (num-test (atanh 9223372036854775806/9223372036854775807) 2.218070977791824990127011272372523734584E1)
+  (num-test (atanh 9223372036854775807/9223372036854775806) 2.218070977791824990127013919350483904273E1+1.570796326794896619231321691639751442098E0i))
+
+(test (atanh) 'error)
+(test (atanh "hi") 'error)
+(test (atanh 1.0+23.0i 1.0+23.0i) 'error)
+(test (atanh 0 1) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (atanh arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(let ((err 0.0)
+      (mx 0.0))
+  (do ((i 0 (+ i 1))
+       (x 1.0 (+ x .1)))
+      ((= i 100))
+    (let ((y (abs (- x (cosh (acosh x))))))
+      (if (> y err) (begin (set! mx x) (set! err y)))))
+  (if (> err 1e-14)
+      (format #t ";(cosh (acosh ~A)) error: ~A~%" mx err)))
+
+(let ((err 0.0)
+      (mx 0.0))
+  (do ((i 0 (+ i 1))
+       (x 1.0+i (+ x 0.1-0.1i)))
+      ((= i 100))
+    (let ((y (magnitude (- x (cosh (acosh x))))))
+      (if (> y err) (begin (set! mx x) (set! err y)))))
+  (if (> err 1e-14)
+      (format #t ";(cosh (acosh ~A)) error: ~A~%" mx err)))
+
+(let ((err 0.0)
+      (mx 0.0))
+  (do ((i 0 (+ i 1))
+       (x 1.0 (+ x .1)))
+      ((= i 100))
+    (let ((y (abs (- x (sinh (asinh x))))))
+      (if (> y err) (begin (set! mx x) (set! err y)))))
+  (if (> err 1e-14)
+      (format #t ";(sinh (asinh ~A)) error: ~A~%" mx err)))
+
+(let ((err 0.0)
+      (mx 0.0))
+  (do ((i 0 (+ i 1))
+       (x 1.0-i (+ x -0.1+i)))
+      ((= i 100))
+    (let ((y (magnitude (- x (sinh (asinh x))))))
+      (if (> y err) (begin (set! mx x) (set! err y)))))
+  (if (> err 1e-9)
+      (format #t ";(sinh (asinh ~A)) error: ~A~%" mx err)))
+
+(let ((err 0.0)
+      (mx 0.0))
+  (do ((i 0 (+ i 1))
+       (x 0.0 (+ x .1)))
+      ((= i 100))
+    (let ((y (magnitude (- x (tanh (atanh x))))))
+      (if (> y err) (begin (set! mx x) (set! err y)))))
+  (if (> err 1e-12)
+      (format #t ";(tanh (atanh ~A)) error: ~A~%" mx err)))
+
+(for-each
+ (lambda (num-and-val)
+   (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'atanh num (atanh num) val)))
+ (vector (list 0 0) (list 2 0.54930614433405+1.5707963267949i) (list 3 0.34657359027997+1.5707963267949i)
+	 (list -2 -0.54930614433405+1.5707963267949i) (list -3 -0.34657359027997+1.5707963267949i)
+	 (list 9223372036854775807 -1.6740081543176e-15+1.5707963267949i) (list -9223372036854775808 -1.6740081543176e-15+1.5707963267949i)
+	 (list 1/2 0.54930614433405) (list 1/3 0.34657359027997) (list -1/2 -0.54930614433405)
+	 (list -1/3 -0.34657359027997) (list 1/9223372036854775807 1.0842021724855e-19) (list 0.0 0.0)
+	 (list 2.0 0.54930614433405+1.5707963267949i) (list -2.0 -0.54930614433405+1.5707963267949i)
+	 (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309)
+	 (list 1e+16 1.7676832220204e-15+1.5707963267949i) (list +inf.0 0+1.5707963267949i)
+	 (list -inf.0 -0+1.5707963267949i) (list 0+1i -5.8004816227974e-18+0.78539816339745i)
+	 (list 0+2i -2.320192649119e-17+1.1071487177941i) (list 0-1i -5.8004816227974e-18-0.78539816339745i)
+	 (list 1+1i 0.40235947810853+1.0172219678979i) (list 1-1i 0.40235947810853-1.0172219678979i)
+	 (list -1+1i -0.40235947810853+1.0172219678979i) (list -1-1i -0.40235947810853-1.0172219678979i)
+	 (list 0.1+0.1i 0.099325449367251+0.10065855418732i) (list 1e+16+1e+16i -1.3183898417424e-15+1.5707963267949i)
+	 (list 1e-16+1e-16i 1.1102230246252e-16+1e-16i) ))
+
+;; this abs case is useless: abs symbol_id is not zero
+(let () (define (hi) (let ((e (sublet (curlet) :abs (lambda (a) (- a 1))))) (with-let e (abs -1)))) (test (hi) -2))
+(let () (define (hi) (let ((e (openlet (inlet :abs (lambda (a) (- a 1)))))) (with-let e (abs -1)))) (test (hi) -2))
+;; so try atanh
+(let () (define (hi) (let ((e (openlet (inlet :atanh (lambda (a) (- a 1)))))) (with-let e (atanh 2)))) (test (hi) 1)) ;0.549+1.570 if with-let ignored
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; sqrt
+;;; --------------------------------------------------------------------------------
+
+(num-test (sqrt 0) 0)
+(num-test (sqrt 1) 1)
+(num-test (sqrt -1) 0.0+1.0i)
+(num-test (sqrt 2) 1.41421356237310)
+(num-test (sqrt -2) 0.0+1.41421356237310i)
+(num-test (sqrt 3) 1.73205080756888)
+(num-test (sqrt -3) 0.0+1.73205080756888i)
+(num-test (sqrt 10) 3.16227766016838)
+(num-test (sqrt -10) 0.0+3.16227766016838i)
+(num-test (sqrt 1234) 35.12833614050059)
+(num-test (sqrt -1234) 0.0+35.12833614050059i)
+(num-test (sqrt 500029) 707.12728698587216)
+(num-test (sqrt -500029) 0.0+707.12728698587216i)
+(num-test (sqrt 0/1) 0)
+(num-test (sqrt 0/2) 0)
+(num-test (sqrt 0/3) 0)
+(num-test (sqrt 0/10) 0)
+(num-test (sqrt 0/1234) 0)
+(num-test (sqrt 0/500029) 0)
+(num-test (sqrt 1/1) 1)
+(num-test (sqrt -1/1) 0.0+1.0i)
+(num-test (sqrt 1/2) 0.70710678118655)
+(num-test (sqrt -1/2) 0.0+0.70710678118655i)
+(num-test (sqrt 1/3) 0.57735026918963)
+(num-test (sqrt -1/3) 0.0+0.57735026918963i)
+(num-test (sqrt 1/10) 0.31622776601684)
+(num-test (sqrt -1/10) 0.0+0.31622776601684i)
+(num-test (sqrt 1/1234) 0.02846704711548)
+(num-test (sqrt -1/1234) 0.0+0.02846704711548i)
+(num-test (sqrt 1/500029) 0.00141417255196)
+(num-test (sqrt -1/500029) 0.0+0.00141417255196i)
+(num-test (sqrt 2/1) 1.41421356237310)
+(num-test (sqrt -2/1) 0.0+1.41421356237310i)
+(num-test (sqrt 2/2) 1)
+(num-test (sqrt -2/2) 0.0+1.0i)
+(num-test (sqrt 2/3) 0.81649658092773)
+(num-test (sqrt -2/3) 0.0+0.81649658092773i)
+(num-test (sqrt 2/10) 0.44721359549996)
+(num-test (sqrt -2/10) 0.0+0.44721359549996i)
+(num-test (sqrt 2/1234) 0.04025848411142)
+(num-test (sqrt -2/1234) 0.0+0.04025848411142i)
+(num-test (sqrt 2/500029) 0.00199994200252)
+(num-test (sqrt -2/500029) 0.0+0.00199994200252i)
+(num-test (sqrt 3/1) 1.73205080756888)
+(num-test (sqrt -3/1) 0.0+1.73205080756888i)
+(num-test (sqrt 3/2) 1.22474487139159)
+(num-test (sqrt -3/2) 0.0+1.22474487139159i)
+(num-test (sqrt 3/3) 1)
+(num-test (sqrt -3/3) 0.0+1.0i)
+(num-test (sqrt 3/10) 0.54772255750517)
+(num-test (sqrt -3/10) 0.0+0.54772255750517i)
+(num-test (sqrt 3/1234) 0.04930637194547)
+(num-test (sqrt -3/1234) 0.0+0.04930637194547i)
+(num-test (sqrt 3/500029) 0.00244941871067)
+(num-test (sqrt -3/500029) 0.0+0.00244941871067i)
+(num-test (sqrt 10/1) 3.16227766016838)
+(num-test (sqrt -10/1) 0.0+3.16227766016838i)
+(num-test (sqrt 10/2) 2.23606797749979)
+(num-test (sqrt -10/2) 0.0+2.23606797749979i)
+(num-test (sqrt 10/3) 1.82574185835055)
+(num-test (sqrt -10/3) 0.0+1.82574185835055i)
+(num-test (sqrt 10/10) 1)
+(num-test (sqrt -10/10) 0.0+1.0i)
+(num-test (sqrt 10/1234) 0.09002070714424)
+(num-test (sqrt -10/1234) 0.0+0.09002070714424i)
+(num-test (sqrt 10/500029) 0.00447200626870)
+(num-test (sqrt -10/500029) 0.0+0.00447200626870i)
+(num-test (sqrt 1234/1) 35.12833614050059)
+(num-test (sqrt -1234/1) 0.0+35.12833614050059i)
+(num-test (sqrt 1234/2) 24.83948469674844)
+(num-test (sqrt -1234/2) 0.0+24.83948469674844i)
+(num-test (sqrt 1234/3) 20.28135432690167)
+(num-test (sqrt -1234/3) 0.0+20.28135432690167i)
+(num-test (sqrt 1234/10) 11.10855526159905)
+(num-test (sqrt -1234/10) 0.0+11.10855526159905i)
+(num-test (sqrt 1234/500029) 0.04967752876605)
+(num-test (sqrt -1234/500029) 0.0+0.04967752876605i)
+(num-test (sqrt 500029/1) 707.12728698587216)
+(num-test (sqrt -500029/1) 0.0+707.12728698587216i)
+(num-test (sqrt 500029/2) 500.01449978975609)
+(num-test (sqrt -500029/2) 0.0+500.01449978975609i)
+(num-test (sqrt 500029/3) 408.26012949262304)
+(num-test (sqrt -500029/3) 0.0+408.26012949262304i)
+(num-test (sqrt 500029/10) 223.61328225308978)
+(num-test (sqrt -500029/10) 0.0+223.61328225308978i)
+(num-test (sqrt 500029/1234) 20.12982579526738)
+(num-test (sqrt -500029/1234) 0.0+20.12982579526738i)
+(num-test (sqrt 500029/500029) 1)
+(num-test (sqrt -500029/500029) 0.0+1.0i)
+(num-test (sqrt 0.0) 0.0)
+(num-test (sqrt 0.00000001) 0.00010000000000)
+(num-test (sqrt -0.00000001) 0.0+0.00010000000000i)
+(num-test (sqrt 1.0) 1.0)
+(num-test (sqrt -1.0) 0.0+1.0i)
+(num-test (sqrt pi) 1.77245385090552)
+(num-test (sqrt -3.14159265358979) 0.0+1.77245385090552i)
+(num-test (sqrt 1234.0) 35.12833614050059)
+(num-test (sqrt -1234.0) 0.0+35.12833614050059i)
+(num-test (sqrt 0.0+0.0i) 0.0)
+(num-test (sqrt -0.0+0.0i) 0.0)
+(num-test (sqrt 0.0-0.0i) 0.0)
+(num-test (sqrt -0.0-0.0i) 0.0)
+(num-test (sqrt 0.0+0.00000001i) 0.00007071067812+0.00007071067812i)
+(num-test (sqrt -0.0+0.00000001i) 0.00007071067812+0.00007071067812i)
+(num-test (sqrt 0.0-0.00000001i) 0.00007071067812-0.00007071067812i)
+(num-test (sqrt -0.0-0.00000001i) 0.00007071067812-0.00007071067812i)
+(num-test (sqrt 0.0+1.0i) 0.70710678118655+0.70710678118655i)
+(num-test (sqrt -0.0+1.0i) 0.70710678118655+0.70710678118655i)
+(num-test (sqrt 0.0-1.0i) 0.70710678118655-0.70710678118655i)
+(num-test (sqrt -0.0-1.0i) 0.70710678118655-0.70710678118655i)
+(num-test (sqrt 0.0+3.14159265358979i) 1.25331413731550+1.25331413731550i)
+(num-test (sqrt -0.0+3.14159265358979i) 1.25331413731550+1.25331413731550i)
+(num-test (sqrt 0.0-3.14159265358979i) 1.25331413731550-1.25331413731550i)
+(num-test (sqrt -0.0-3.14159265358979i) 1.25331413731550-1.25331413731550i)
+(num-test (sqrt 0.0+1234.0i) 24.83948469674844+24.83948469674844i)
+(num-test (sqrt -0.0+1234.0i) 24.83948469674844+24.83948469674844i)
+(num-test (sqrt 0.0-1234.0i) 24.83948469674844-24.83948469674844i)
+(num-test (sqrt -0.0-1234.0i) 24.83948469674844-24.83948469674844i)
+(num-test (sqrt 0.00000001+0.0i) 0.00010000000000)
+(num-test (sqrt -0.00000001+0.0i) 0.0+0.00010000000000i)
+(num-test (sqrt 0.00000001-0.0i) 0.00010000000000)
+(num-test (sqrt -0.00000001-0.0i) 0.0+0.00010000000000i)
+(num-test (sqrt 0.00000001+0.00000001i) 0.00010986841135+0.00004550898606i)
+(num-test (sqrt -0.00000001+0.00000001i) 0.00004550898606+0.00010986841135i)
+(num-test (sqrt 0.00000001-0.00000001i) 0.00010986841135-0.00004550898606i)
+(num-test (sqrt -0.00000001-0.00000001i) 0.00004550898606-0.00010986841135i)
+(num-test (sqrt 0.00000001+1.0i) 0.70710678472208+0.70710677765101i)
+(num-test (sqrt -0.00000001+1.0i) 0.70710677765101+0.70710678472208i)
+(num-test (sqrt 0.00000001-1.0i) 0.70710678472208-0.70710677765101i)
+(num-test (sqrt -0.00000001-1.0i) 0.70710677765101-0.70710678472208i)
+(num-test (sqrt 0.00000001+3.14159265358979i) 1.25331413931021+1.25331413532079i)
+(num-test (sqrt -0.00000001+3.14159265358979i) 1.25331413532079+1.25331413931021i)
+(num-test (sqrt 0.00000001-3.14159265358979i) 1.25331413931021-1.25331413532079i)
+(num-test (sqrt -0.00000001-3.14159265358979i) 1.25331413532079-1.25331413931021i)
+(num-test (sqrt 0.00000001+1234.0i) 24.83948469684909+24.83948469664779i)
+(num-test (sqrt -0.00000001+1234.0i) 24.83948469664779+24.83948469684909i)
+(num-test (sqrt 0.00000001-1234.0i) 24.83948469684909-24.83948469664779i)
+(num-test (sqrt -0.00000001-1234.0i) 24.83948469664779-24.83948469684909i)
+(num-test (sqrt 1.0+0.0i) 1.0)
+(num-test (sqrt -0.0) 0.0)
+(num-test (sqrt -1.0+0.0i) 0.0+1.0i)
+(num-test (sqrt 1.0-0.0i) 1.0)
+(num-test (sqrt -1.0-0.0i) 0.0+1.0i)
+(num-test (sqrt 1.0+0.00000001i) 1.0+0.00000000500000i)
+(num-test (sqrt -1.0+0.00000001i) 0.00000000500000+1.0i)
+(num-test (sqrt 1.0-0.00000001i) 1.0-0.00000000500000i)
+(num-test (sqrt -1.0-0.00000001i) 0.00000000500000-1.0i)
+(num-test (sqrt 1.0+1.0i) 1.09868411346781+0.45508986056223i)
+(num-test (sqrt -1.0+1.0i) 0.45508986056223+1.09868411346781i)
+(num-test (sqrt 1.0-1.0i) 1.09868411346781-0.45508986056223i)
+(num-test (sqrt -1.0-1.0i) 0.45508986056223-1.09868411346781i)
+(num-test (sqrt 1.0+3.14159265358979i) 1.46576060621706+1.07165953303174i)
+(num-test (sqrt -1.0+3.14159265358979i) 1.07165953303174+1.46576060621706i)
+(num-test (sqrt 1.0-3.14159265358979i) 1.46576060621706-1.07165953303174i)
+(num-test (sqrt -1.0-3.14159265358979i) 1.07165953303174-1.46576060621706i)
+(num-test (sqrt 1.0+1234.0i) 24.84955135597340+24.82942211557006i)
+(num-test (sqrt -1.0+1234.0i) 24.82942211557006+24.84955135597340i)
+(num-test (sqrt 1.0-1234.0i) 24.84955135597340-24.82942211557006i)
+(num-test (sqrt -1.0-1234.0i) 24.82942211557006-24.84955135597340i)
+(num-test (sqrt 3.14159265358979+0.0i) 1.77245385090552)
+(num-test (sqrt -3.14159265358979+0.0i) 0.0+1.77245385090552i)
+(num-test (sqrt 3.14159265358979-0.0i) 1.77245385090552)
+(num-test (sqrt -3.14159265358979-0.0i) 0.0+1.77245385090552i)
+(num-test (sqrt 3.14159265358979+0.00000001i) 1.77245385090552+0.00000000282095i)
+(num-test (sqrt -3.14159265358979+0.00000001i) 0.00000000282095+1.77245385090552i)
+(num-test (sqrt 3.14159265358979-0.00000001i) 1.77245385090552-0.00000000282095i)
+(num-test (sqrt -3.14159265358979-0.00000001i) 0.00000000282095-1.77245385090552i)
+(num-test (sqrt 3.14159265358979+1.0i) 1.79422698718214+0.27867154132224i)
+(num-test (sqrt -3.14159265358979+1.0i) 0.27867154132224+1.79422698718214i)
+(num-test (sqrt 3.14159265358979-1.0i) 1.79422698718214-0.27867154132224i)
+(num-test (sqrt -3.14159265358979-1.0i) 0.27867154132224-1.79422698718214i)
+(num-test (sqrt 3.14159265358979+3.14159265358979i) 1.94736688784473+0.80662577586157i)
+(num-test (sqrt -3.14159265358979+3.14159265358979i) 0.80662577586157+1.94736688784473i)
+(num-test (sqrt 3.14159265358979-3.14159265358979i) 1.94736688784473-0.80662577586157i)
+(num-test (sqrt -3.14159265358979-3.14159265358979i) 0.80662577586157-1.94736688784473i)
+(num-test (sqrt 3.14159265358979+1234.0i) 24.87112373493049+24.80788590719961i)
+(num-test (sqrt -3.14159265358979+1234.0i) 24.80788590719961+24.87112373493049i)
+(num-test (sqrt 3.14159265358979-1234.0i) 24.87112373493049-24.80788590719961i)
+(num-test (sqrt -3.14159265358979-1234.0i) 24.80788590719961-24.87112373493049i)
+(num-test (sqrt 1234.0+0.0i) 35.12833614050059)
+(num-test (sqrt -1234.0+0.0i) 0.0+35.12833614050059i)
+(num-test (sqrt 1234.0-0.0i) 35.12833614050059)
+(num-test (sqrt -1234.0-0.0i) 0.0+35.12833614050059i)
+(num-test (sqrt 1234.0+0.00000001i) 35.12833614050059+0.00000000014234i)
+(num-test (sqrt -1234.0+0.00000001i) 0.00000000014234+35.12833614050059i)
+(num-test (sqrt 1234.0-0.00000001i) 35.12833614050059-0.00000000014234i)
+(num-test (sqrt -1234.0-0.00000001i) 0.00000000014234-35.12833614050059i)
+(num-test (sqrt 1234.0+1.0i) 35.12833902411499+0.01423352238934i)
+(num-test (sqrt -1234.0+1.0i) 0.01423352238934+35.12833902411499i)
+(num-test (sqrt 1234.0-1.0i) 35.12833902411499-0.01423352238934i)
+(num-test (sqrt -1234.0-1.0i) 0.01423352238934-35.12833902411499i)
+(num-test (sqrt 1234.0+3.14159265358979i) 35.12836460058208+0.04471589681601i)
+(num-test (sqrt -1234.0+3.14159265358979i) 0.04471589681601+35.12836460058208i)
+(num-test (sqrt 1234.0-3.14159265358979i) 35.12836460058208-0.04471589681601i)
+(num-test (sqrt -1234.0-3.14159265358979i) 0.04471589681601-35.12836460058208i)
+(num-test (sqrt 1234.0+1234.0i) 38.59494485012512+15.98654959596347i)
+(num-test (sqrt -1234.0+1234.0i) 15.98654959596347+38.59494485012512i)
+(num-test (sqrt 1234.0-1234.0i) 38.59494485012512-15.98654959596347i)
+(num-test (sqrt -1234.0-1234.0i) 15.98654959596347-38.59494485012512i)
+(num-test (sqrt 2.2250739e-308) 1.4916681e-154)
+(num-test (sqrt 1.7976931e+308) 1.3407808e+154)
+(num-test (sqrt 0.0e+00+0.0e+00i) 0e0+0.0i)
+(num-test (sqrt 0.0e+00+1.19209289550781250e-07i) 2.44140625e-4+2.44140625e-4i)
+(num-test (sqrt 0.0e+00-1.19209289550781250e-07i) 2.44140625e-4-2.44140625e-4i)
+(num-test (sqrt 0.0e+00+5.0e-01i) 5e-1+5e-1i)
+(num-test (sqrt 0.0e+00-5.0e-01i) 5e-1-5e-1i)
+(num-test (sqrt 0.0e+00+1.0e+00i) 7.0710678118654752440e-1+7.0710678118654752440e-1i)
+(num-test (sqrt 0.0e+00-1.0e+00i) 7.0710678118654752440e-1-7.0710678118654752440e-1i)
+(num-test (sqrt 0.0e+00+2.0e+00i) 1+1i)
+(num-test (sqrt 0.0e+00-2.0e+00i) 1-1i)
+(num-test (sqrt 0.0e+00+8.3886080e+06i) 2048+2048i)
+(num-test (sqrt 0.0e+00-8.3886080e+06i) 2048-2048i)
+(num-test (sqrt 1.19209289550781250e-07+0.0e+00i) 3.4526698300124390840e-4+0.0i)
+(num-test (sqrt -1.19209289550781250e-07+0.0e+00i) 0+3.4526698300124390840e-4i)
+(num-test (sqrt 1.19209289550781250e-07+1.19209289550781250e-07i) 3.7933934912842707699e-4+1.5712750315077700799e-4i)
+(num-test (sqrt 1.19209289550781250e-07-1.19209289550781250e-07i) 3.7933934912842707699e-4-1.5712750315077700799e-4i)
+(num-test (sqrt -1.19209289550781250e-07+1.19209289550781250e-07i) 1.5712750315077700799e-4+3.7933934912842707699e-4i)
+(num-test (sqrt -1.19209289550781250e-07-1.19209289550781250e-07i) 1.5712750315077700799e-4-3.7933934912842707699e-4i)
+(num-test (sqrt 1.19209289550781250e-07+5.0e-01i) 5.0000005960464832810e-1+4.9999994039535877732e-1i)
+(num-test (sqrt 1.19209289550781250e-07-5.0e-01i) 5.0000005960464832810e-1-4.9999994039535877732e-1i)
+(num-test (sqrt -1.19209289550781250e-07+5.0e-01i) 4.9999994039535877732e-1+5.0000005960464832810e-1i)
+(num-test (sqrt -1.19209289550781250e-07-5.0e-01i) 4.9999994039535877732e-1-5.0000005960464832810e-1i)
+(num-test (sqrt 1.19209289550781250e-07+1.0e+00i) 7.0710682333339729137e-1+7.0710673903970026958e-1i)
+(num-test (sqrt 1.19209289550781250e-07-1.0e+00i) 7.0710682333339729137e-1-7.0710673903970026958e-1i)
+(num-test (sqrt -1.19209289550781250e-07+1.0e+00i) 7.0710673903970026958e-1+7.0710682333339729137e-1i)
+(num-test (sqrt -1.19209289550781250e-07-1.0e+00i) 7.0710673903970026958e-1-7.0710682333339729137e-1i)
+(num-test (sqrt 1.19209289550781250e-07+2.0e+00i) 1.0000000298023228318e0+9.9999997019767805639e-1i)
+(num-test (sqrt 1.19209289550781250e-07-2.0e+00i) 1.0000000298023228318e0-9.9999997019767805639e-1i)
+(num-test (sqrt -1.19209289550781250e-07+2.0e+00i) 9.9999997019767805639e-1+1.0000000298023228318e0i)
+(num-test (sqrt -1.19209289550781250e-07-2.0e+00i) 9.9999997019767805639e-1-1.0000000298023228318e0i)
+(num-test (sqrt 1.19209289550781250e-07+8.3886080e+06i) 2.0480000000000145519e3+2.0479999999999854481e3i)
+(num-test (sqrt 1.19209289550781250e-07-8.3886080e+06i) 2.0480000000000145519e3-2.0479999999999854481e3i)
+(num-test (sqrt -1.19209289550781250e-07+8.3886080e+06i) 2.0479999999999854481e3+2.0480000000000145519e3i)
+(num-test (sqrt -1.19209289550781250e-07-8.3886080e+06i) 2.0479999999999854481e3-2.0480000000000145519e3i)
+(num-test (sqrt 5.0e-01+0.0e+00i) 7.0710678118654752440e-1+0.0i)
+(num-test (sqrt -5.0e-01+0.0e+00i) 0+7.0710678118654752440e-1i)
+(num-test (sqrt 5.0e-01+1.19209289550781250e-07i) 7.0710678118655254870e-1+8.4293697021787464631e-8i)
+(num-test (sqrt 5.0e-01-1.19209289550781250e-07i) 7.0710678118655254870e-1-8.4293697021787464631e-8i)
+(num-test (sqrt -5.0e-01+1.19209289550781250e-07i) 8.4293697021787464631e-8+7.0710678118655254870e-1i)
+(num-test (sqrt -5.0e-01-1.19209289550781250e-07i) 8.4293697021787464631e-8-7.0710678118655254870e-1i)
+(num-test (sqrt 5.0e-01+5.0e-01i) 7.7688698701501865367e-1+3.2179712645279131237e-1i)
+(num-test (sqrt 5.0e-01-5.0e-01i) 7.7688698701501865367e-1-3.2179712645279131237e-1i)
+(num-test (sqrt -5.0e-01+5.0e-01i) 3.2179712645279131237e-1+7.7688698701501865367e-1i)
+(num-test (sqrt -5.0e-01-5.0e-01i) 3.2179712645279131237e-1-7.7688698701501865367e-1i)
+(num-test (sqrt 5.0e-01+1.0e+00i) 8.9945371997393363613e-1+5.5589297025142117199e-1i)
+(num-test (sqrt 5.0e-01-1.0e+00i) 8.9945371997393363613e-1-5.5589297025142117199e-1i)
+(num-test (sqrt -5.0e-01+1.0e+00i) 5.5589297025142117199e-1+8.9945371997393363613e-1i)
+(num-test (sqrt -5.0e-01-1.0e+00i) 5.5589297025142117199e-1-8.9945371997393363613e-1i)
+(num-test (sqrt 5.0e-01+2.0e+00i) 1.1317139242778694103e0+8.8361553087551326576e-1i)
+(num-test (sqrt 5.0e-01-2.0e+00i) 1.1317139242778694103e0-8.8361553087551326576e-1i)
+(num-test (sqrt -5.0e-01+2.0e+00i) 8.8361553087551326576e-1+1.1317139242778694103e0i)
+(num-test (sqrt -5.0e-01-2.0e+00i) 8.8361553087551326576e-1-1.1317139242778694103e0i)
+(num-test (sqrt 5.0e-01+8.3886080e+06i) 2.0480000610351571595e3+2.0479999389648446595e3i)
+(num-test (sqrt 5.0e-01-8.3886080e+06i) 2.0480000610351571595e3-2.0479999389648446595e3i)
+(num-test (sqrt -5.0e-01+8.3886080e+06i) 2.0479999389648446595e3+2.0480000610351571595e3i)
+(num-test (sqrt -5.0e-01-8.3886080e+06i) 2.0479999389648446595e3-2.0480000610351571595e3i)
+(num-test (sqrt 1.0e+00+0.0e+00i) 1e0+0.0i)
+(num-test (sqrt -1.0e+00+0.0e+00i) 0+1i)
+(num-test (sqrt 1.0e+00+1.19209289550781250e-07i) 1.0000000000000017764e0+5.9604644775390519121e-8i)
+(num-test (sqrt 1.0e+00-1.19209289550781250e-07i) 1.0000000000000017764e0-5.9604644775390519121e-8i)
+(num-test (sqrt -1.0e+00+1.19209289550781250e-07i) 5.9604644775390519121e-8+1.0000000000000017764e0i)
+(num-test (sqrt -1.0e+00-1.19209289550781250e-07i) 5.9604644775390519121e-8-1.0000000000000017764e0i)
+(num-test (sqrt 1.0e+00+5.0e-01i) 1.0290855136357461252e0+2.4293413587832283909e-1i)
+(num-test (sqrt 1.0e+00-5.0e-01i) 1.0290855136357461252e0-2.4293413587832283909e-1i)
+(num-test (sqrt -1.0e+00+5.0e-01i) 2.4293413587832283909e-1+1.0290855136357461252e0i)
+(num-test (sqrt -1.0e+00-5.0e-01i) 2.4293413587832283909e-1-1.0290855136357461252e0i)
+(num-test (sqrt 1.0e+00+1.0e+00i) 1.0986841134678099660e0+4.5508986056222734130e-1i)
+(num-test (sqrt 1.0e+00-1.0e+00i) 1.0986841134678099660e0-4.5508986056222734130e-1i)
+(num-test (sqrt -1.0e+00+1.0e+00i) 4.5508986056222734130e-1+1.0986841134678099660e0i)
+(num-test (sqrt -1.0e+00-1.0e+00i) 4.5508986056222734130e-1-1.0986841134678099660e0i)
+(num-test (sqrt 1.0e+00+2.0e+00i) 1.2720196495140689643e0+7.8615137775742328607e-1i)
+(num-test (sqrt 1.0e+00-2.0e+00i) 1.2720196495140689643e0-7.8615137775742328607e-1i)
+(num-test (sqrt -1.0e+00+2.0e+00i) 7.8615137775742328607e-1+1.2720196495140689643e0i)
+(num-test (sqrt -1.0e+00-2.0e+00i) 7.8615137775742328607e-1-1.2720196495140689643e0i)
+(num-test (sqrt 1.0e+00+8.3886080e+06i) 2.0480001220703161380e3+2.0479998779296911380e3i)
+(num-test (sqrt 1.0e+00-8.3886080e+06i) 2.0480001220703161380e3-2.0479998779296911380e3i)
+(num-test (sqrt -1.0e+00+8.3886080e+06i) 2.0479998779296911380e3+2.0480001220703161380e3i)
+(num-test (sqrt -1.0e+00-8.3886080e+06i) 2.0479998779296911380e3-2.0480001220703161380e3i)
+(num-test (sqrt 2.0e+00+0.0e+00i) 1.4142135623730950488e0+0.0i)
+(num-test (sqrt -2.0e+00+0.0e+00i) 0+1.4142135623730950488e0i)
+(num-test (sqrt 2.0e+00+1.19209289550781250e-07i) 1.4142135623730956768e0+4.2146848510894013070e-8i)
+(num-test (sqrt 2.0e+00-1.19209289550781250e-07i) 1.4142135623730956768e0-4.2146848510894013070e-8i)
+(num-test (sqrt -2.0e+00+1.19209289550781250e-07i) 4.2146848510894013070e-8+1.4142135623730956768e0i)
+(num-test (sqrt -2.0e+00-1.19209289550781250e-07i) 4.2146848510894013070e-8-1.4142135623730956768e0i)
+(num-test (sqrt 2.0e+00+5.0e-01i) 1.4250531240639470060e0+1.7543205637629383228e-1i)
+(num-test (sqrt 2.0e+00-5.0e-01i) 1.4250531240639470060e0-1.7543205637629383228e-1i)
+(num-test (sqrt -2.0e+00+5.0e-01i) 1.7543205637629383228e-1+1.4250531240639470060e0i)
+(num-test (sqrt -2.0e+00-5.0e-01i) 1.7543205637629383228e-1-1.4250531240639470060e0i)
+(num-test (sqrt 2.0e+00+1.0e+00i) 1.4553466902253548081e0+3.4356074972251246414e-1i)
+(num-test (sqrt 2.0e+00-1.0e+00i) 1.4553466902253548081e0-3.4356074972251246414e-1i)
+(num-test (sqrt -2.0e+00+1.0e+00i) 3.4356074972251246414e-1+1.4553466902253548081e0i)
+(num-test (sqrt -2.0e+00-1.0e+00i) 3.4356074972251246414e-1-1.4553466902253548081e0i)
+(num-test (sqrt 2.0e+00+2.0e+00i) 1.5537739740300373073e0+6.4359425290558262474e-1i)
+(num-test (sqrt 2.0e+00-2.0e+00i) 1.5537739740300373073e0-6.4359425290558262474e-1i)
+(num-test (sqrt -2.0e+00+2.0e+00i) 6.4359425290558262474e-1+1.5537739740300373073e0i)
+(num-test (sqrt -2.0e+00-2.0e+00i) 6.4359425290558262474e-1-1.5537739740300373073e0i)
+(num-test (sqrt 2.0e+00+8.3886080e+06i) 2.0480002441406395519e3+2.0479997558593895519e3i)
+(num-test (sqrt 2.0e+00-8.3886080e+06i) 2.0480002441406395519e3-2.0479997558593895519e3i)
+(num-test (sqrt -2.0e+00+8.3886080e+06i) 2.0479997558593895519e3+2.0480002441406395519e3i)
+(num-test (sqrt -2.0e+00-8.3886080e+06i) 2.0479997558593895519e3-2.0480002441406395519e3i)
+(num-test (sqrt 8.3886080e+06+0.0e+00i) 2.8963093757400986599e3+0.0i)
+(num-test (sqrt -8.3886080e+06+0.0e+00i) 0+2.8963093757400986599e3i)
+(num-test (sqrt 8.3886080e+06+1.19209289550781250e-07i) 2.8963093757400986599e3+2.0579515874459976458e-11i)
+(num-test (sqrt 8.3886080e+06-1.19209289550781250e-07i) 2.8963093757400986599e3-2.0579515874459976458e-11i)
+(num-test (sqrt -8.3886080e+06+1.19209289550781250e-07i) 2.0579515874459976458e-11+2.8963093757400986599e3i)
+(num-test (sqrt -8.3886080e+06-1.19209289550781250e-07i) 2.0579515874459976458e-11-2.8963093757400986599e3i)
+(num-test (sqrt 8.3886080e+06+5.0e-01i) 2.8963093757400999462e3+8.6316745750310938767e-5i)
+(num-test (sqrt 8.3886080e+06-5.0e-01i) 2.8963093757400999462e3-8.6316745750310938767e-5i)
+(num-test (sqrt -8.3886080e+06+5.0e-01i) 8.6316745750310938767e-5+2.8963093757400999462e3i)
+(num-test (sqrt -8.3886080e+06-5.0e-01i) 8.6316745750310938767e-5-2.8963093757400999462e3i)
+(num-test (sqrt 8.3886080e+06+1.0e+00i) 2.8963093757401038048e3+1.7263349150062164754e-4i)
+(num-test (sqrt 8.3886080e+06-1.0e+00i) 2.8963093757401038048e3-1.7263349150062164754e-4i)
+(num-test (sqrt -8.3886080e+06+1.0e+00i) 1.7263349150062164754e-4+2.8963093757401038048e3i)
+(num-test (sqrt -8.3886080e+06-1.0e+00i) 1.7263349150062164754e-4-2.8963093757401038048e3i)
+(num-test (sqrt 8.3886080e+06+2.0e+00i) 2.8963093757401192395e3+3.4526698300124145513e-4i)
+(num-test (sqrt 8.3886080e+06-2.0e+00i) 2.8963093757401192395e3-3.4526698300124145513e-4i)
+(num-test (sqrt -8.3886080e+06+2.0e+00i) 3.4526698300124145513e-4+2.8963093757401192395e3i)
+(num-test (sqrt -8.3886080e+06-2.0e+00i) 3.4526698300124145513e-4-2.8963093757401192395e3i)
+(num-test (sqrt 8.3886080e+06+8.3886080e+06i) 3.1821290988135164054e3+1.3180810299506332155e3i)
+(num-test (sqrt 8.3886080e+06-8.3886080e+06i) 3.1821290988135164054e3-1.3180810299506332155e3i)
+(num-test (sqrt -8.3886080e+06+8.3886080e+06i) 1.3180810299506332155e3+3.1821290988135164054e3i)
+(num-test (sqrt -8.3886080e+06-8.3886080e+06i) 1.3180810299506332155e3-3.1821290988135164054e3i)
+(num-test (sqrt -1.0e+01) 0+3.1622776601683793320e0i)
+(num-test (sqrt -2.0e+00) 0+1.4142135623730950488e0i)
+(num-test (sqrt -1.0e+00) 0+1i)
+(num-test (sqrt -7.50e-01) 0+8.6602540378443864676e-1i)
+(num-test (sqrt -5.0e-01) 0+7.0710678118654752440e-1i)
+(num-test (sqrt -1.250e-01) 0+3.5355339059327376220e-1i)
+(num-test (sqrt -3.45266983001243932001e-04) 0+1.8581361171917517303e-2i)
+(num-test (sqrt -1.19209289550781250e-07) 0+3.4526698300124390840e-4i)
+(num-test (sqrt 0.0e+00) 0e0+0.0i)
+(num-test (sqrt 1.19209289550781250e-07) 3.4526698300124390840e-4+0.0i)
+(num-test (sqrt 3.45266983001243932001e-04) 1.8581361171917517303e-2+0.0i)
+(num-test (sqrt 1.250e-01) 3.5355339059327376220e-1+0.0i)
+(num-test (sqrt 5.0e-01) 7.0710678118654752440e-1+0.0i)
+(num-test (sqrt 7.50e-01) 8.6602540378443864676e-1+0.0i)
+(num-test (sqrt 1.0e+00) 1e0+0.0i)
+(num-test (sqrt 2.0e+00) 1.4142135623730950488e0+0.0i)
+(num-test (sqrt 1.0e+01) 3.1622776601683793320e0+0.0i)
+(num-test (sqrt 9) 3)
+(num-test (sqrt -9.0) 0.0+3.0i)
+(num-test (sqrt (sqrt (sqrt 256))) 2)
+(num-test (sqrt (sqrt (sqrt 1/256))) 1/2)
+(num-test (sqrt 0.1-111i) 7.4531887486175-7.4464771887462i)
+(num-test (sqrt -2.225073858507201399999999999999999999996E-308) 0.0+1.49166814624004135432626585974344862306E-154i)
+(num-test (sqrt -9223372036854775808) 0.0+3.037000499976049692451388530026308346744E9i)
+(num-test (sqrt 1.110223024625156799999999999999999999997E-16) 1.053671212772350917851343014434652692451E-8)
+(num-test (sqrt 9223372036854775807) 3.037000499976049692286752403030628535068E9)
+
+(num-test (sqrt (* 64686/26264 64686/26264)) 32343/13132)
+(num-test (sqrt (* 64812/61611 64812/61611)) 1964/1867)
+(num-test (sqrt (* 38868/48261 38868/48261)) 12956/16087)
+(num-test (sqrt (* 39537/63628 39537/63628)) 39537/63628)
+(num-test (sqrt (* 1238/47077 1238/47077)) 1238/47077)
+(num-test (sqrt (* 51490/46936 51490/46936)) 25745/23468)
+(num-test (sqrt (* 35778/34583 35778/34583)) 35778/34583)
+(num-test (sqrt (* 19920/16774 19920/16774)) 9960/8387)
+(num-test (sqrt (* 29100/37656 29100/37656)) 2425/3138)
+(num-test (sqrt (* 64906/58229 64906/58229)) 64906/58229)
+(num-test (sqrt 144) 12)
+(num-test (sqrt 9000000000000000000) 3000000000)
+;; but unfortunately in non-gmp, 9400000000000000000 -> -9046744073709551616
+
+(test (and (integer? (sqrt 9007199136250226)) (exact? (sqrt 9007199136250226))) #f)
+(test (and (integer? (sqrt 9007199136250225)) (exact? (sqrt 9007199136250225))) #t)
+(test (sqrt 1/4) 1/2)
+(test (sqrt 256/81) 16/9)
+(test (rational? (sqrt 256/81)) #t)
+
+(when (integer? (sqrt 4))
+  (for-each
+   (lambda (n sqn)
+     (if (positive? n) ; in case 32 bit int
+	 (let ((val (sqrt n)))
+	   (if (or (not (integer? val))
+		   (not (eqv? sqn val)))
+	       (format #t ";(sqrt ~A) expected ~A but got ~A~%" n sqn val)))))
+   (list 9 491401 19439281 1248844921 235565593201)
+   (list 3 701 4409 35339 485351))
+
+  (for-each
+   (lambda (n)
+     (if (positive? n)
+	 (let ((val (sqrt n)))
+	   (if (or (integer? val)
+		   (> (abs (- (* val val) n)) .001))
+	       (format #t ";(sqrt ~A) expected ~A but got ~A~%" n (sqrt (* 1.0 n)) val)))))
+   (list 10 491400 19439282 1248844920 235565593200))
+
+  (test (eqv? (expt 2 3) 8) #t)
+					;(test (eqv? (log 8 2) 3) #t) ; optimization in C (-O2) changes this
+  (num-test (log 8 2) 3)
+  (num-test (log 1/8 2) -3)
+  (unless (provided? '32-bit)
+    (test (eqv? (expt 701 2) 491401) #t)
+    (test (eqv? (log 491401 701) 2) #t)))
+
+(let ((err 0.0)
+      (mx 0.0))
+  (do ((i 0 (+ i 1))
+       (x -10.0 (+ x .1)))
+      ((= i 200))
+    (let ((y (magnitude (- x (* (sqrt x) (sqrt x))))))
+      (if (> y err) (begin (set! mx x) (set! err y)))))
+  (if (> err 1e-14)
+      (format #t ";(sqr (sqrt ~A)) error: ~A~%" mx err)))
+
+(let ((err 0.0)
+      (mx 0.0))
+  (do ((i 0 (+ i 1))
+       (x -10.0+i (+ x .1+i)))
+      ((= i 200))
+    (let ((y (magnitude (- x (* (sqrt x) (sqrt x))))))
+      (if (> y err) (begin (set! mx x) (set! err y)))))
+  (if (> err 1e-12)
+      (format #t ";(sqr (sqrt ~A)) error: ~A~%" mx err)))
+
+(num-test (* (/ 4 (sqrt 522))
+	     (log (* (expt (/ (+ 5 (sqrt 29)) (sqrt 2)) 3)
+		     (+ (* 5 (sqrt 29)) (* 11 (sqrt 6)))
+		     (expt (+ (sqrt (/ (+ 9 (* 3 (sqrt 6))) 4))
+			      (sqrt (/ (+ 5 (* 3 (sqrt 6))) 4))) 6)))) ;31 digits
+	  pi)
+
+(num-test (let* ((N 3502)
+		 (D (* 1/2 (+ 1071 (* 184 (sqrt 34)))))
+		 (E (* 1/2 (+ 1553 (* 266 (sqrt 34)))))
+		 (F (+ 429 (* 304 (sqrt 2))))
+		 (G (* 1/2 (+ 627 (* 442 (sqrt 2)))))
+		 (d1 (+ D (sqrt (- (* D D) 1))))
+		 (e1 (+ E (sqrt (- (* E E) 1))))
+		 (f1 (+ F (sqrt (- (* F F) 1))))
+		 (g1 (+ G (sqrt (- (* G G) 1))))
+		 (defg (* 2 d1 e1 f1 g1)))
+	    (* (/ (sqrt N)) (- (log (expt defg -6)))))
+	  pi)
+
+(num-test (let* ((N 2737)
+		 (D (* 1/2 (+ 621 (* 49 (sqrt 161)))))
+		 (E (* 1/4 (+ 321 (* 25 (sqrt 161)))))
+		 (F (* 1/4 (+ 393 (* 31 (sqrt 161)))))
+		 (G (* 1/4 (+ 2529 (* 199 (sqrt 161)))))
+		 (d (+ D (sqrt (- (* D D) 1))))
+		 (e (+ E (sqrt (- (* E E) 1))))
+		 (f (+ F (sqrt (- (* F F) 1))))
+		 (g (+ G (sqrt (- (* G G) 1))))
+		 (defg (* 2 d e f g)))
+	    (* (/ (sqrt N)) (- (log (abs (* -1 (expt defg -6)))))))
+	  pi) ; Newman and Shanks "On a Sequence Arising in Series for pi"
+
+(num-test (let* ((an (sqrt 2)) ; Borwein and Borwein "AGM Mean and Fast Computation"
+		 (bn 0)
+		 (pn (+ 2 (sqrt 2))))
+	    (do ((i 0 (+ i 1)))
+		((= i 4) pn)
+	      (let* ((sqa (sqrt an))
+		     (an1 (* 1/2 (+ sqa (/ 1.0 sqa))))
+		     (bn1 (* sqa (/ (+ bn 1) (+ bn an))))
+		     (pn1 (* pn bn1 (/ (+ an1 1) (+ bn1 1)))))
+		(set! pn pn1)
+		(set! bn bn1)
+		(set! an an1))))
+	  pi)
+
+(when with-bignums
+  (num-test (sqrt 340282366920938463463374607431768211456) 18446744073709551616)
+  (num-test (sqrt 32317006071311007300714876688669951960444102669715484032130345427524655138867890893197201411522913463688717960921898019494119559150490921095088152386448283120630877367300996091750197750389652106796057638384067568276792218642619756161838094338476170470581645852036305042887575891541065808607552399123930385521914333389668342420684974786564569494856176035326322058077805659331026192708460314150258592864177116725943603718461857357598351152301645904403697613233287231227125684710820209725157101726931323469678542580656697935045997268352998638215525166389437335543602135433229604645318478604952148193555853611059596230656) 179769313486231590772930519078902473361797697894230657273430081157732675805500963132708477322407536021120113879871393357658789768814416622492847430639474124377767893424865485276302219601246094119453082952085005768838150682342462881473913110540827237163350510684586298239947245938479716304835356329624224137216)
+  (num-test (sqrt 1208925819614629174706176/717897987691852588770249) 1099511627776/847288609443)
+  (num-test (sqrt (/ (* 1.0 (expt 2 80)) (expt 3 50))) 1.297682531692252029863335918836296060669E0)
+  (num-test (sqrt -340282366920938463463374607431768211456) 0.0+1.8446744073709551616E19i)
+  (num-test (sqrt 0+340282366920938463463374607431768211456i) 1.304381782533278221234957180625250836888E19+1.304381782533278221234957180625250836888E19i))
+
+(test (sqrt) 'error)
+(test (sqrt "hi") 'error)
+(test (sqrt 1.0+23.0i 1.0+23.0i) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (sqrt arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(num-test (sqrt 1/1073741824) 1/32768)
+(num-test (sqrt 1/274877906944) 1/524288)
+(num-test (sqrt 9223372030926249001) 3037000499)
+(num-test (sqrt 1/274877906944) 1/524288)
+(num-test (sqrt 1/1099511627776) 1/1048576)
+(num-test (sqrt 1/4398046511104) (sqrt (/ (expt 2 42))))
+(num-test (sqrt 1/4611686018427387904) 1/2147483648)
+(num-test (sqrt 1/1152921504606846976) 1/1073741824)
+(num-test (sqrt 1/9223372030926249001) 1/3037000499)
+(num-test (sqrt 0+i) (/ 1+i (sqrt 2)))
+(num-test (+ 0-i(sqrt 00)) 0-i)
+(num-test (sqrt (* 1.2345e-127 1.2345e-127)) 1.2345e-127)
+(num-test (sqrt (* 1.2345e-27 1.2345e-27)) 1.2345e-27)
+(num-test (sqrt 13) (do ((i 1 (+ i 1)) (prod 1.0 (* prod (tan (/ (* i pi) 13))))) ((= i 7) prod)))
+(num-test (* 768 (sqrt (- 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 1))))))))))))))))))) 3.1415904632368)
+
+(for-each
+ (lambda (num-and-val)
+   (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'sqrt num (sqrt num) val)))
+ (vector (list 0 0) (list 1 1) (list 2 1.4142135623731) (list 3 1.7320508075689) (list -1 0+1i)
+	 (list -2 0+1.4142135623731i) (list -3 0+1.7320508075689i) (list 9223372036854775807 3037000499.976)
+	 (list -9223372036854775808 0+3037000499.976i) (list 1/2 0.70710678118655) (list 1/3 0.57735026918963)
+	 (list -1/2 0+0.70710678118655i) (list -1/3 0+0.57735026918963i) (list 1/9223372036854775807 3.2927225399136e-10)
+	 (list 0.0 0.0) (list 1.0 1.0) (list 2.0 1.4142135623731) (list -2.0 0+1.4142135623731i)
+	 (list 1.000000000000000000000000000000000000002E-309 3.162277660168379331998893544432718533725E-155)
+	 (list 1e+16 100000000.0) (list 0+1i 0.70710678118655+0.70710678118655i) (list 0+2i 1+1i)
+	 (list 0-1i 0.70710678118655-0.70710678118655i) (list 1+1i 1.0986841134678+0.45508986056223i)
+	 (list 1-1i 1.0986841134678-0.45508986056223i) (list -1+1i 0.45508986056223+1.0986841134678i)
+	 (list -1-1i 0.45508986056223-1.0986841134678i) (list 0.1+0.1i 0.34743442276012+0.14391204994251i)
+	 (list 1e+16+1e+16i 109868411.34678+45508986.056223i) (list 1e-16+1e-16i 1.0986841134678e-08+4.5508986056223e-09i)
+	 ))
+
+(let ((sqrts (list
+	      1.00000000000000000000000000000000000000000000000000000000000000000000
+	      1.41421356237309504880168872420969807856967187537694807317667973799073
+	      1.73205080756887729352744634150587236694280525381038062805580697945193
+	      2.00000000000000000000000000000000000000000000000000000000000000000000
+	      2.23606797749978969640917366873127623544061835961152572427089724541052
+	      2.44948974278317809819728407470589139196594748065667012843269256725096
+	      2.64575131106459059050161575363926042571025918308245018036833445920106
+	      2.82842712474619009760337744841939615713934375075389614635335947598146
+	      3.00000000000000000000000000000000000000000000000000000000000000000000
+	      3.16227766016837933199889354443271853371955513932521682685750485279259
+	      3.31662479035539984911493273667068668392708854558935359705868214611648
+	      3.46410161513775458705489268301174473388561050762076125611161395890386
+	      3.60555127546398929311922126747049594625129657384524621271045305622716
+	      3.74165738677394138558374873231654930175601980777872694630374546732003
+	      3.87298334620741688517926539978239961083292170529159082658757376611348
+	      4.00000000000000000000000000000000000000000000000000000000000000000000
+	      4.12310562561766054982140985597407702514719922537362043439863357309495
+	      4.24264068711928514640506617262909423570901562613084421953003921397219
+	      4.35889894354067355223698198385961565913700392523244493689034413815955
+	      4.47213595499957939281834733746255247088123671922305144854179449082104
+	      4.58257569495584000658804719372800848898445657676797190260724212390686
+	      4.69041575982342955456563011354446628058822835341173715360570189101702
+	      4.79583152331271954159743806416269391999670704190412934648530911444825
+	      4.89897948556635619639456814941178278393189496131334025686538513450192
+	      5.00000000000000000000000000000000000000000000000000000000000000000000
+	      5.09901951359278483002822410902278198956377094609959640758497080442593
+	      5.19615242270663188058233902451761710082841576143114188416742093835579
+	      5.29150262212918118100323150727852085142051836616490036073666891840213
+	      5.38516480713450403125071049154032955629512016164478883768038867001664
+	      5.47722557505166113456969782800802133952744694997983254226894449732493
+	      5.56776436283002192211947129891854952047639337757041430396843258560358
+	      5.65685424949238019520675489683879231427868750150779229270671895196292
+	      5.74456264653802865985061146821892931822026445798279236769987747056590
+	      5.83095189484530047087415287754558307652139833488597195445000674486781
+	      5.91607978309961604256732829156161704841550123079434032287971966914282
+	      6.00000000000000000000000000000000000000000000000000000000000000000000
+	      6.08276253029821968899968424520206706208497009478641118641915304648633
+	      6.16441400296897645025019238145424422523562402344457454487457207245839
+	      6.24499799839839820584689312093979446107295997799165630845297193060961
+	      6.32455532033675866399778708886543706743911027865043365371500970558518)))
+  (let ((mxerr 0.0))
+    (do ((i 1 (+ i 1)))
+	((> i 40))
+      (let ((err (abs (- (sqrt i) (list-ref sqrts (- i 1))))))
+	(if (> err mxerr)
+	    (set! mxerr err))))
+    (if (> mxerr 1e-12) (format #t "sqrt err: ~A~%" mxerr))))
+
+(when with-bignums
+  (num-test (/ (sqrt (* 1.2345e-170 1.2345e-170))) 8.100445524503847216161209708816501953798E169)
+  (num-test (sqrt (expt 2 32)) 65536)
+  (num-test (sqrt -1.797693134862315699999999999999999999998E308) 0.0+1.34078079299425963249160560140156653105E154i)
+  (num-test (exp (* pi (sqrt (bignum "163")))) 2.625374126407687439999999999992500725895E17)
+  (let-temporarily (((*s7* 'bignum-precision) 500))
+    (let ((sqrts (list ; table[Sqrt[k/10], {k, 0, 30}]
+		  0.00000000000000000000000000000000000000000000000000000000000000000000e0
+		  0.31622776601683793319988935444327185337195551393252168268575048527925
+		  0.44721359549995793928183473374625524708812367192230514485417944908210
+		  0.54772255750516611345696978280080213395274469499798325422689444973249
+		  0.63245553203367586639977870888654370674391102786504336537150097055851
+		  0.70710678118654752440084436210484903928483593768847403658833986899536
+		  0.77459666924148337703585307995647992216658434105831816531751475322269
+		  0.83666002653407554797817202578518748939281536929867219981119154308041
+		  0.89442719099991587856366946749251049417624734384461028970835889816420
+		  0.94868329805051379959966806332981556011586654179756504805725145583777
+		  1.00000000000000000000000000000000000000000000000000000000000000000000
+		  1.04880884817015154699145351367993759847527185768150398487575576358000
+		  1.09544511501033222691393956560160426790548938999596650845378889946498
+		  1.14017542509913797913604902556675447907600531091641037529746941724956
+		  1.18321595661992320851346565831232340968310024615886806457594393382856
+		  1.22474487139158904909864203735294569598297374032833506421634628362548
+		  1.26491106406735173279955741777308741348782205573008673074300194111703
+		  1.30384048104052974291659431148583688330561875578201309179007936989676
+		  1.34164078649987381784550420123876574126437101576691543456253834724631
+		  1.37840487520902217679559125529341754271981635583990014790642120179806
+		  1.41421356237309504880168872420969807856967187537694807317667973799073
+		  1.44913767461894385737186641571697717231401328747589730886959248071181
+		  1.48323969741913258974227948816014261219598086381950031974652465286876
+		  1.51657508881031011085136508725641431090992842790349245064524200355844
+		  1.54919333848296675407170615991295984433316868211663633063502950644539
+		  1.58113883008418966599944677221635926685977756966260841342875242639629
+		  1.61245154965970993047332264606075422622687926112171467758731847785277
+		  1.64316767251549834037090934840240640185823408499394976268068334919747
+		  1.67332005306815109595634405157037497878563073859734439962238308616083
+		  1.70293863659264011661333218238773227063897151909784216273026969624657
+		  1.73205080756887729352744634150587236694280525381038062805580697945193)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 30))
+	(let ((val (sqrt (bignum (/ i 10)))))
+	  (if (> (magnitude (- val (list-ref sqrts i))) 1e-36)
+	      (format #t ";(sqrt ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref sqrts i) (magnitude (- val (list-ref sqrts i))))))))))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; exp
+;;; --------------------------------------------------------------------------------
+
+(num-test (exp 0) 1.0)
+(num-test (exp -1) 0.36787944117144)
+(num-test (exp 2) 7.38905609893065)
+(num-test (exp -2) 0.13533528323661)
+(num-test (exp 3) 20.08553692318767)
+(num-test (exp -3) 0.04978706836786)
+(num-test (exp 10) 22026.46579480671789)
+(num-test (exp -10) 0.00004539992976)
+(num-test (exp 0/1) 1.0)
+(num-test (exp 0/2) 1.0)
+(num-test (exp 0/3) 1.0)
+(num-test (exp 0/10) 1.0)
+(num-test (exp 0/1234) 1.0)
+(num-test (exp 0/500029) 1.0)
+(num-test (exp -1/1) 0.36787944117144)
+(num-test (exp 1/2) 1.64872127070013)
+(num-test (exp -1/2) 0.60653065971263)
+(num-test (exp 1/3) 1.39561242508609)
+(num-test (exp -1/3) 0.71653131057379)
+(num-test (exp 1/10) 1.10517091807565)
+(num-test (exp -1/10) 0.90483741803596)
+(num-test (exp 1/1234) 1.00081070121220)
+(num-test (exp -1/1234) 0.99918995549186)
+(num-test (exp 1/500029) 1.00000199988601)
+(num-test (exp -1/500029) 0.99999800011799)
+(num-test (exp 2/1) 7.38905609893065)
+(num-test (exp -2/1) 0.13533528323661)
+(num-test (exp -2/2) 0.36787944117144)
+(num-test (exp 2/3) 1.94773404105468)
+(num-test (exp -2/3) 0.51341711903259)
+(num-test (exp 2/10) 1.22140275816017)
+(num-test (exp -2/10) 0.81873075307798)
+(num-test (exp 2/1234) 1.00162205966086)
+(num-test (exp -2/1234) 0.99838056715583)
+(num-test (exp 2/500029) 1.00000399977601)
+(num-test (exp -2/500029) 0.99999600023999)
+(num-test (exp 3/1) 20.08553692318767)
+(num-test (exp -3/1) 0.04978706836786)
+(num-test (exp 3/2) 4.48168907033806)
+(num-test (exp -3/2) 0.22313016014843)
+(num-test (exp -3/3) 0.36787944117144)
+(num-test (exp 3/10) 1.34985880757600)
+(num-test (exp -3/10) 0.74081822068172)
+(num-test (exp 3/1234) 1.00243407587880)
+(num-test (exp -3/1234) 0.99757183446037)
+(num-test (exp 3/500029) 1.00000599967002)
+(num-test (exp -3/500029) 0.99999400036598)
+(num-test (exp 10/1) 22026.46579480671789)
+(num-test (exp -10/1) 0.00004539992976)
+(num-test (exp 10/2) 148.41315910257660)
+(num-test (exp -10/2) 0.00673794699909)
+(num-test (exp 10/3) 28.03162489452614)
+(num-test (exp -10/3) 0.03567399334725)
+(num-test (exp -10/10) 0.36787944117144)
+(num-test (exp 10/1234) 1.00813665179201)
+(num-test (exp -10/1234) 0.99192901897025)
+(num-test (exp 10/500029) 1.00001999904005)
+(num-test (exp -10/500029) 0.99998000135991)
+(num-test (exp 1234/500029) 1.00247090452960)
+(num-test (exp -1234/500029) 0.99753518579099)
+(num-test (exp -500029/500029) 0.36787944117144)
+(num-test (exp 0.0) 1.0)
+(num-test (exp 0.00000001) 1.00000001)
+(num-test (exp -0.00000001) 0.99999999000000)
+(num-test (exp -1.0) 0.36787944117144)
+(num-test (exp pi) 23.14069263277927)
+(num-test (exp -3.14159265358979) 0.04321391826377)
+(num-test (exp 2.71828182845905) 15.15426224147926)
+(num-test (exp -2.71828182845905) 0.06598803584531)
+(num-test (exp 0.0+0.0i) 1.0)
+(num-test (exp -0.0+0.0i) 1.0)
+(num-test (exp 0.0-0.0i) 1.0)
+(num-test (exp -0.0-0.0i) 1.0)
+(num-test (exp 0.0+0.00000001i) 1.0+0.00000001i)
+(num-test (exp -0.0+0.00000001i) 1.0+0.00000001i)
+(num-test (exp 0.0-0.00000001i) 1.0-0.00000001i)
+(num-test (exp -0.0-0.00000001i) 1.0-0.00000001i)
+(num-test (exp 0.0+1.0i) 0.54030230586814+0.84147098480790i)
+(num-test (exp -0.0+1.0i) 0.54030230586814+0.84147098480790i)
+(num-test (exp 0.0-1.0i) 0.54030230586814-0.84147098480790i)
+(num-test (exp -0.0-1.0i) 0.54030230586814-0.84147098480790i)
+(num-test (exp 0.0+3.14159265358979i) -1.0+0.0i)
+(num-test (exp -0.0+3.14159265358979i) -1.0+0.0i)
+(num-test (exp 0.0-3.14159265358979i) -1.0-0.0i)
+(num-test (exp -0.0-3.14159265358979i) -1.0-0.0i)
+(num-test (exp 0.0+2.71828182845905i) -0.91173391478697+0.41078129050291i)
+(num-test (exp -0.0+2.71828182845905i) -0.91173391478697+0.41078129050291i)
+(num-test (exp 0.0-2.71828182845905i) -0.91173391478697-0.41078129050291i)
+(num-test (exp -0.0-2.71828182845905i) -0.91173391478697-0.41078129050291i)
+(num-test (exp 0.00000001+0.0i) 1.00000001)
+(num-test (exp -0.00000001+0.0i) 0.99999999000000)
+(num-test (exp 0.00000001-0.0i) 1.00000001)
+(num-test (exp -0.00000001-0.0i) 0.99999999000000)
+(num-test (exp 0.00000001+0.00000001i) 1.00000001+0.00000001i)
+(num-test (exp -0.00000001+0.00000001i) 0.99999999000000+0.00000001i)
+(num-test (exp 0.00000001-0.00000001i) 1.00000001-0.00000001i)
+(num-test (exp -0.00000001-0.00000001i) 0.99999999000000-0.00000001i)
+(num-test (exp 0.00000001+1.0i) 0.54030231127116+0.84147099322261i)
+(num-test (exp -0.00000001+1.0i) 0.54030230046512+0.84147097639319i)
+(num-test (exp 0.00000001-1.0i) 0.54030231127116-0.84147099322261i)
+(num-test (exp -0.00000001-1.0i) 0.54030230046512-0.84147097639319i)
+(num-test (exp 0.00000001+3.14159265358979i) -1.00000001+0.0i)
+(num-test (exp -0.00000001+3.14159265358979i) -0.99999999000000+0.0i)
+(num-test (exp 0.00000001-3.14159265358979i) -1.00000001-0.0i)
+(num-test (exp -0.00000001-3.14159265358979i) -0.99999999000000-0.0i)
+(num-test (exp 0.00000001+2.71828182845905i) -0.91173392390430+0.41078129461072i)
+(num-test (exp -0.00000001+2.71828182845905i) -0.91173390566963+0.41078128639510i)
+(num-test (exp 0.00000001-2.71828182845905i) -0.91173392390430-0.41078129461072i)
+(num-test (exp -0.00000001-2.71828182845905i) -0.91173390566963-0.41078128639510i)
+(num-test (exp 1.0+0.0i) 2.71828182845905)
+(num-test (exp -1.0+0.0i) 0.36787944117144)
+(num-test (exp 1.0-0.0i) 2.71828182845905)
+(num-test (exp -1.0-0.0i) 0.36787944117144)
+(num-test (exp 1.0+0.00000001i) 2.71828182845905+0.00000002718282i)
+(num-test (exp -1.0+0.00000001i) 0.36787944117144+0.00000000367879i)
+(num-test (exp 1.0-0.00000001i) 2.71828182845905-0.00000002718282i)
+(num-test (exp -1.0-0.00000001i) 0.36787944117144-0.00000000367879i)
+(num-test (exp 1.0+1.0i) 1.46869393991589+2.28735528717884i)
+(num-test (exp -1.0+1.0i) 0.19876611034641+0.30955987565311i)
+(num-test (exp 1.0-1.0i) 1.46869393991589-2.28735528717884i)
+(num-test (exp -1.0-1.0i) 0.19876611034641-0.30955987565311i)
+(num-test (exp 1.0+3.14159265358979i) -2.71828182845905+0.0i)
+(num-test (exp -1.0+3.14159265358979i) -0.36787944117144+0.0i)
+(num-test (exp 1.0-3.14159265358979i) -2.71828182845905-0.0i)
+(num-test (exp -1.0-3.14159265358979i) -0.36787944117144-0.0i)
+(num-test (exp 1.0+2.71828182845905i) -2.47834973295523+1.11661931744501i)
+(num-test (exp -1.0+2.71828182845905i) -0.33540816306888+0.15111799159389i)
+(num-test (exp 1.0-2.71828182845905i) -2.47834973295523-1.11661931744501i)
+(num-test (exp -1.0-2.71828182845905i) -0.33540816306888-0.15111799159389i)
+(num-test (exp 3.14159265358979+0.0i) 23.14069263277927)
+(num-test (exp -3.14159265358979+0.0i) 0.04321391826377)
+(num-test (exp 3.14159265358979-0.0i) 23.14069263277927)
+(num-test (exp -3.14159265358979-0.0i) 0.04321391826377)
+(num-test (exp 3.14159265358979+0.00000001i) 23.14069263277926+0.00000023140693i)
+(num-test (exp -3.14159265358979+0.00000001i) 0.04321391826377+0.00000000043214i)
+(num-test (exp 3.14159265358979-0.00000001i) 23.14069263277926-0.00000023140693i)
+(num-test (exp -3.14159265358979-0.00000001i) 0.04321391826377-0.00000000043214i)
+(num-test (exp 3.14159265358979+1.0i) 12.50296958887651+19.47222141884161i)
+(num-test (exp -3.14159265358979+1.0i) 0.02334857968351+0.03636325835882i)
+(num-test (exp 3.14159265358979-1.0i) 12.50296958887651-19.47222141884161i)
+(num-test (exp -3.14159265358979-1.0i) 0.02334857968351-0.03636325835882i)
+(num-test (exp 3.14159265358979+3.14159265358979i) -23.14069263277927+0.0i)
+(num-test (exp -3.14159265358979+3.14159265358979i) -0.04321391826377+0.0i)
+(num-test (exp 3.14159265358979-3.14159265358979i) -23.14069263277927-0.0i)
+(num-test (exp -3.14159265358979-3.14159265358979i) -0.04321391826377-0.0i)
+(num-test (exp 3.14159265358979+2.71828182845905i) -21.09815428496572+9.50576358282422i)
+(num-test (exp -3.14159265358979+2.71828182845905i) -0.03939959487191+0.01775146911208i)
+(num-test (exp 3.14159265358979-2.71828182845905i) -21.09815428496572-9.50576358282422i)
+(num-test (exp -3.14159265358979-2.71828182845905i) -0.03939959487191-0.01775146911208i)
+(num-test (exp 2.71828182845905+0.0i) 15.15426224147926)
+(num-test (exp -2.71828182845905+0.0i) 0.06598803584531)
+(num-test (exp 2.71828182845905-0.0i) 15.15426224147926)
+(num-test (exp -2.71828182845905-0.0i) 0.06598803584531)
+(num-test (exp 2.71828182845905+0.00000001i) 15.15426224147926+0.00000015154262i)
+(num-test (exp 2.71828182845905-0.00000001i) 15.15426224147926-0.00000015154262i)
+(num-test (exp -2.71828182845905-0.00000001i) 0.06598803584531-0.00000000065988i)
+(num-test (exp 2.71828182845905+1.0i) 8.18788283280173+12.75187197237468i)
+(num-test (exp -2.71828182845905+1.0i) 0.03565348792693+0.05552701750829i)
+(num-test (exp 2.71828182845905-1.0i) 8.18788283280173-12.75187197237468i)
+(num-test (exp -2.71828182845905-1.0i) 0.03565348792693-0.05552701750829i)
+(num-test (exp 2.71828182845905+3.14159265358979i) -15.15426224147926+0.0i)
+(num-test (exp -2.71828182845905+3.14159265358979i) -0.06598803584531+0.0i)
+(num-test (exp 2.71828182845905-3.14159265358979i) -15.15426224147926-0.0i)
+(num-test (exp -2.71828182845905-3.14159265358979i) -0.06598803584531-0.0i)
+(num-test (exp 2.71828182845905+2.71828182845905i) -13.81665483913218+6.22508740017436i)
+(num-test (exp -2.71828182845905+2.71828182845905i) -0.06016353025035+0.02710665052229i)
+(num-test (exp 2.71828182845905-2.71828182845905i) -13.81665483913218-6.22508740017436i)
+(num-test (exp -2.71828182845905-2.71828182845905i) -0.06016353025035-0.02710665052229i)
+(num-test (exp -1234.0+0.0i) 0.0)
+(num-test (exp -1234.0-0.0i) 0.0)
+(num-test (exp -1234.0+0.00000001i) 0.0)
+(num-test (exp -1234.0-0.00000001i) 0.0)
+(num-test (exp -1234.0+3.14159265358979i) 0.0)
+(num-test (exp -1234.0-3.14159265358979i) 0.0)
+(num-test (exp 10.0) 22026.46579480672)
+(num-test (exp 100.0) 2.688117141816135E+43)
+(num-test (exp -10.0) 4.5399929762484853E-5)
+(num-test (exp -100.0) 3.720075976020836E-44)
+(num-test (exp -7.080000e+02) 3.307553e-308)
+(num-test (exp 7.090000e+02) 8.218407461554972189241372386597816393254E307)
+(num-test (exp 0.00000001+1234.0i) -0.7985506315730906+0.601927660781774i)
+(num-test (exp 3.14159265358979+1234.0i) -18.47901453215463+13.92902284602872i)
+(num-test (exp 0.0e+00-3.45266983001243932001e-04i) 9.9999994039535581673e-1-3.4526697614140534807e-4i)
+(num-test (exp 0.0e+00+3.45266983001243932001e-04i) 9.9999994039535581673e-1+3.4526697614140534807e-4i)
+(num-test (exp 0.0e+00+1.57045105981189525579e+00i) 3.4526697614152485627e-4+9.9999994039535581669e-1i)
+(num-test (exp 0.0e+00-1.57045105981189525579e+00i) 3.4526697614152485627e-4-9.9999994039535581669e-1i)
+(num-test (exp 0.0e+00+1.57114159377789786021e+00i) -3.4526697614140239160e-4+9.9999994039535581673e-1i)
+(num-test (exp 0.0e+00-1.57114159377789786021e+00i) -3.4526697614140239160e-4-9.9999994039535581673e-1i)
+(num-test (exp 0.0e+00+3.14124738660679181379e+00i) -9.9999994039535581667e-1+3.4526697614158608860e-4i)
+(num-test (exp 0.0e+00-3.14124738660679181379e+00i) -9.9999994039535581667e-1-3.4526697614158608860e-4i)
+(num-test (exp 0.0e+00+3.14193792057279441821e+00i) -9.9999994039535581675e-1-3.4526697614134115926e-4i)
+(num-test (exp 0.0e+00-3.14193792057279441821e+00i) -9.9999994039535581675e-1+3.4526697614134115926e-4i)
+(num-test (exp 0.0e+00+4.71204371340168837179e+00i) -3.4526697614164732094e-4-9.9999994039535581664e-1i)
+(num-test (exp 0.0e+00-4.71204371340168837179e+00i) -3.4526697614164732094e-4+9.9999994039535581664e-1i)
+(num-test (exp 0.0e+00+4.71273424736769097620e+00i) 3.4526697614127992692e-4-9.9999994039535581677e-1i)
+(num-test (exp 0.0e+00-4.71273424736769097620e+00i) 3.4526697614127992692e-4+9.9999994039535581677e-1i)
+(num-test (exp 0.0e+00+6.28284004019658492979e+00i) 9.9999994039535581662e-1-3.4526697614170855328e-4i)
+(num-test (exp 0.0e+00-6.28284004019658492979e+00i) 9.9999994039535581662e-1+3.4526697614170855328e-4i)
+(num-test (exp 0.0e+00+6.28353057416258753420e+00i) 9.9999994039535581679e-1+3.4526697614121869459e-4i)
+(num-test (exp 0.0e+00-6.28353057416258753420e+00i) 9.9999994039535581679e-1-3.4526697614121869459e-4i)
+(num-test (exp 0.0e+00+9.42443269378637893396e+00i) -9.9999994039535581689e-1+3.4526697614094283958e-4i)
+(num-test (exp 0.0e+00-9.42443269378637893396e+00i) -9.9999994039535581689e-1-3.4526697614094283958e-4i)
+(num-test (exp 0.0e+00+9.42512322775237976202e+00i) -9.9999994039535581714e-1-3.4526697614020805155e-4i)
+(num-test (exp 0.0e+00-9.42512322775237976202e+00i) -9.9999994039535581714e-1+3.4526697614020805155e-4i)
+(num-test (exp 1.19209289550781250e-07-3.45266983001243932001e-04i) 1.0000000596046453675e0-3.4526701730043873250e-4i)
+(num-test (exp 1.19209289550781250e-07+3.45266983001243932001e-04i) 1.0000000596046453675e0+3.4526701730043873250e-4i)
+(num-test (exp -1.19209289550781250e-07-3.45266983001243932001e-04i) 9.9999982118608047680e-1-3.4526693498237687017e-4i)
+(num-test (exp -1.19209289550781250e-07+3.45266983001243932001e-04i) 9.9999982118608047680e-1+3.4526693498237687017e-4i)
+(num-test (exp 1.19209289550781250e-07+1.57045105981189525579e+00i) 3.4526701730055824072e-4+1.0000000596046453675e0i)
+(num-test (exp 1.19209289550781250e-07-1.57045105981189525579e+00i) 3.4526701730055824072e-4-1.0000000596046453675e0i)
+(num-test (exp -1.19209289550781250e-07+1.57045105981189525579e+00i) 3.4526693498249637836e-4+9.9999982118608047676e-1i)
+(num-test (exp -1.19209289550781250e-07-1.57045105981189525579e+00i) 3.4526693498249637836e-4-9.9999982118608047676e-1i)
+(num-test (exp 1.19209289550781250e-07+1.57114159377789786021e+00i) -3.4526701730043577603e-4+1.0000000596046453675e0i)
+(num-test (exp 1.19209289550781250e-07-1.57114159377789786021e+00i) -3.4526701730043577603e-4-1.0000000596046453675e0i)
+(num-test (exp -1.19209289550781250e-07+1.57114159377789786021e+00i) -3.4526693498237391370e-4+9.9999982118608047680e-1i)
+(num-test (exp -1.19209289550781250e-07-1.57114159377789786021e+00i) -3.4526693498237391370e-4-9.9999982118608047680e-1i)
+(num-test (exp 1.19209289550781250e-07+3.14124738660679181379e+00i) -1.0000000596046453674e0+3.4526701730061947306e-4i)
+(num-test (exp 1.19209289550781250e-07-3.14124738660679181379e+00i) -1.0000000596046453674e0-3.4526701730061947306e-4i)
+(num-test (exp -1.19209289550781250e-07+3.14124738660679181379e+00i) -9.9999982118608047674e-1+3.4526693498255761069e-4i)
+(num-test (exp -1.19209289550781250e-07-3.14124738660679181379e+00i) -9.9999982118608047674e-1-3.4526693498255761069e-4i)
+(num-test (exp 1.19209289550781250e-07+3.14193792057279441821e+00i) -1.0000000596046453675e0-3.4526701730037454368e-4i)
+(num-test (exp 1.19209289550781250e-07-3.14193792057279441821e+00i) -1.0000000596046453675e0+3.4526701730037454368e-4i)
+(num-test (exp -1.19209289550781250e-07+3.14193792057279441821e+00i) -9.9999982118608047682e-1-3.4526693498231268137e-4i)
+(num-test (exp -1.19209289550781250e-07-3.14193792057279441821e+00i) -9.9999982118608047682e-1+3.4526693498231268137e-4i)
+(num-test (exp 1.19209289550781250e-07+4.71204371340168837179e+00i) -3.4526701730068070540e-4-1.0000000596046453674e0i)
+(num-test (exp 1.19209289550781250e-07-4.71204371340168837179e+00i) -3.4526701730068070540e-4+1.0000000596046453674e0i)
+(num-test (exp -1.19209289550781250e-07+4.71204371340168837179e+00i) -3.4526693498261884302e-4-9.9999982118608047672e-1i)
+(num-test (exp -1.19209289550781250e-07-4.71204371340168837179e+00i) -3.4526693498261884302e-4+9.9999982118608047672e-1i)
+(num-test (exp 1.19209289550781250e-07+4.71273424736769097620e+00i) 3.4526701730031331134e-4-1.0000000596046453676e0i)
+(num-test (exp 1.19209289550781250e-07-4.71273424736769097620e+00i) 3.4526701730031331134e-4+1.0000000596046453676e0i)
+(num-test (exp -1.19209289550781250e-07+4.71273424736769097620e+00i) 3.4526693498225144904e-4-9.9999982118608047684e-1i)
+(num-test (exp -1.19209289550781250e-07-4.71273424736769097620e+00i) 3.4526693498225144904e-4+9.9999982118608047684e-1i)
+(num-test (exp 1.19209289550781250e-07+6.28284004019658492979e+00i) 1.0000000596046453674e0-3.4526701730074193775e-4i)
+(num-test (exp 1.19209289550781250e-07-6.28284004019658492979e+00i) 1.0000000596046453674e0+3.4526701730074193775e-4i)
+(num-test (exp -1.19209289550781250e-07+6.28284004019658492979e+00i) 9.9999982118608047670e-1-3.4526693498268007535e-4i)
+(num-test (exp -1.19209289550781250e-07-6.28284004019658492979e+00i) 9.9999982118608047670e-1+3.4526693498268007535e-4i)
+(num-test (exp 1.19209289550781250e-07+6.28353057416258753420e+00i) 1.0000000596046453676e0+3.452670173002520790e-4i)
+(num-test (exp 1.19209289550781250e-07-6.28353057416258753420e+00i) 1.0000000596046453676e0-3.452670173002520790e-4i)
+(num-test (exp -1.19209289550781250e-07+6.28353057416258753420e+00i) 9.9999982118608047687e-1+3.4526693498219021671e-4i)
+(num-test (exp -1.19209289550781250e-07-6.28353057416258753420e+00i) 9.9999982118608047687e-1-3.4526693498219021671e-4i)
+(num-test (exp 1.19209289550781250e-07+9.42443269378637893396e+00i) -1.0000000596046453677e0+3.4526701729997622396e-4i)
+(num-test (exp 1.19209289550781250e-07-9.42443269378637893396e+00i) -1.0000000596046453677e0-3.4526701729997622396e-4i)
+(num-test (exp -1.19209289550781250e-07+9.42443269378637893396e+00i) -9.9999982118608047696e-1+3.4526693498191436174e-4i)
+(num-test (exp -1.19209289550781250e-07-9.42443269378637893396e+00i) -9.9999982118608047696e-1-3.4526693498191436174e-4i)
+(num-test (exp 1.19209289550781250e-07+9.42512322775237976202e+00i) -1.0000000596046453679e0-3.4526701729924143584e-4i)
+(num-test (exp 1.19209289550781250e-07-9.42512322775237976202e+00i) -1.0000000596046453679e0+3.4526701729924143584e-4i)
+(num-test (exp -1.19209289550781250e-07+9.42512322775237976202e+00i) -9.9999982118608047721e-1-3.4526693498117957380e-4i)
+(num-test (exp -1.19209289550781250e-07-9.42512322775237976202e+00i) -9.9999982118608047721e-1+3.4526693498117957380e-4i)
+(num-test (exp 5.0e-01-3.45266983001243932001e-04i) 1.6487211724286834494e0-5.6924900763464865323e-4i)
+(num-test (exp 5.0e-01+3.45266983001243932001e-04i) 1.6487211724286834494e0+5.6924900763464865323e-4i)
+(num-test (exp -5.0e-01-3.45266983001243932001e-04i) 6.0653062356058926519e-1-2.0941500681603265022e-4i)
+(num-test (exp -5.0e-01+3.45266983001243932001e-04i) 6.0653062356058926519e-1+2.0941500681603265022e-4i)
+(num-test (exp 5.0e-01+1.57045105981189525579e+00i) 5.6924900763484568894e-4+1.6487211724286834493e0i)
+(num-test (exp 5.0e-01-1.57045105981189525579e+00i) 5.6924900763484568894e-4-1.6487211724286834493e0i)
+(num-test (exp -5.0e-01+1.57045105981189525579e+00i) 2.0941500681610513560e-4+6.0653062356058926516e-1i)
+(num-test (exp -5.0e-01-1.57045105981189525579e+00i) 2.0941500681610513560e-4-6.0653062356058926516e-1i)
+(num-test (exp 5.0e-01+1.57114159377789786021e+00i) -5.6924900763464377883e-4+1.6487211724286834494e0i)
+(num-test (exp 5.0e-01-1.57114159377789786021e+00i) -5.6924900763464377883e-4-1.6487211724286834494e0i)
+(num-test (exp -5.0e-01+1.57114159377789786021e+00i) -2.0941500681603085702e-4+6.0653062356058926519e-1i)
+(num-test (exp -5.0e-01-1.57114159377789786021e+00i) -2.0941500681603085702e-4-6.0653062356058926519e-1i)
+(num-test (exp 5.0e-01+3.14124738660679181379e+00i) -1.6487211724286834493e0+5.6924900763494664399e-4i)
+(num-test (exp 5.0e-01-3.14124738660679181379e+00i) -1.6487211724286834493e0-5.6924900763494664399e-4i)
+(num-test (exp -5.0e-01+3.14124738660679181379e+00i) -6.0653062356058926515e-1+2.0941500681614227489e-4i)
+(num-test (exp -5.0e-01-3.14124738660679181379e+00i) -6.0653062356058926515e-1-2.0941500681614227489e-4i)
+(num-test (exp 5.0e-01+3.14193792057279441821e+00i) -1.6487211724286834494e0-5.6924900763454282377e-4i)
+(num-test (exp 5.0e-01-3.14193792057279441821e+00i) -1.6487211724286834494e0+5.6924900763454282377e-4i)
+(num-test (exp -5.0e-01+3.14193792057279441821e+00i) -6.0653062356058926520e-1-2.0941500681599371773e-4i)
+(num-test (exp -5.0e-01-3.14193792057279441821e+00i) -6.0653062356058926520e-1+2.0941500681599371773e-4i)
+(num-test (exp 5.0e-01+4.71204371340168837179e+00i) -5.6924900763504759905e-4-1.6487211724286834492e0i)
+(num-test (exp 5.0e-01-4.71204371340168837179e+00i) -5.6924900763504759905e-4+1.6487211724286834492e0i)
+(num-test (exp -5.0e-01+4.71204371340168837179e+00i) -2.0941500681617941418e-4-6.0653062356058926514e-1i)
+(num-test (exp -5.0e-01-4.71204371340168837179e+00i) -2.0941500681617941418e-4+6.0653062356058926514e-1i)
+(num-test (exp 5.0e-01+4.71273424736769097620e+00i) 5.6924900763444186872e-4-1.6487211724286834494e0i)
+(num-test (exp 5.0e-01-4.71273424736769097620e+00i) 5.6924900763444186872e-4+1.6487211724286834494e0i)
+(num-test (exp -5.0e-01+4.71273424736769097620e+00i) 2.0941500681595657844e-4-6.0653062356058926521e-1i)
+(num-test (exp -5.0e-01-4.71273424736769097620e+00i) 2.0941500681595657844e-4+6.0653062356058926521e-1i)
+(num-test (exp 5.0e-01+6.28284004019658492979e+00i) 1.6487211724286834492e0-5.6924900763514855410e-4i)
+(num-test (exp 5.0e-01-6.28284004019658492979e+00i) 1.6487211724286834492e0+5.6924900763514855410e-4i)
+(num-test (exp -5.0e-01+6.28284004019658492979e+00i) 6.0653062356058926512e-1-2.0941500681621655347e-4i)
+(num-test (exp -5.0e-01-6.28284004019658492979e+00i) 6.0653062356058926512e-1+2.0941500681621655347e-4i)
+(num-test (exp 5.0e-01+6.28353057416258753420e+00i) 1.6487211724286834495e0+5.6924900763434091366e-4i)
+(num-test (exp 5.0e-01-6.28353057416258753420e+00i) 1.6487211724286834495e0-5.6924900763434091366e-4i)
+(num-test (exp -5.0e-01+6.28353057416258753420e+00i) 6.0653062356058926523e-1+2.0941500681591943916e-4i)
+(num-test (exp -5.0e-01-6.28353057416258753420e+00i) 6.0653062356058926523e-1-2.0941500681591943916e-4i)
+(num-test (exp 5.0e-01+9.42443269378637893396e+00i) -1.6487211724286834496e0+5.6924900763388610565e-4i)
+(num-test (exp 5.0e-01-9.42443269378637893396e+00i) -1.6487211724286834496e0-5.6924900763388610565e-4i)
+(num-test (exp -5.0e-01+9.42443269378637893396e+00i) -6.0653062356058926528e-1+2.0941500681575212464e-4i)
+(num-test (exp -5.0e-01-9.42443269378637893396e+00i) -6.0653062356058926528e-1-2.0941500681575212464e-4i)
+(num-test (exp 5.0e-01+9.42512322775237976202e+00i) -1.6487211724286834501e0-5.6924900763267464498e-4i)
+(num-test (exp 5.0e-01-9.42512322775237976202e+00i) -1.6487211724286834501e0+5.6924900763267464498e-4i)
+(num-test (exp -5.0e-01+9.42512322775237976202e+00i) -6.0653062356058926544e-1-2.0941500681530645317e-4i)
+(num-test (exp -5.0e-01-9.42512322775237976202e+00i) -6.0653062356058926544e-1+2.0941500681530645317e-4i)
+(num-test (exp -1.0e+00-3.45266983001243932001e-04i) 3.6787941924411912823e-1-1.2701662223785390836e-4i)
+(num-test (exp -1.0e+00+3.45266983001243932001e-04i) 3.6787941924411912823e-1+1.2701662223785390836e-4i)
+(num-test (exp -1.0e+00+1.57045105981189525579e+00i) 1.2701662223789787297e-4+3.6787941924411912822e-1i)
+(num-test (exp -1.0e+00-1.57045105981189525579e+00i) 1.2701662223789787297e-4-3.6787941924411912822e-1i)
+(num-test (exp -1.0e+00+1.57114159377789786021e+00i) -1.2701662223785282074e-4+3.6787941924411912823e-1i)
+(num-test (exp -1.0e+00-1.57114159377789786021e+00i) -1.2701662223785282074e-4-3.6787941924411912823e-1i)
+(num-test (exp -1.0e+00+3.14124738660679181379e+00i) -3.6787941924411912821e-1+1.2701662223792039909e-4i)
+(num-test (exp -1.0e+00-3.14124738660679181379e+00i) -3.6787941924411912821e-1-1.2701662223792039909e-4i)
+(num-test (exp -1.0e+00+3.14193792057279441821e+00i) -3.6787941924411912824e-1-1.2701662223783029462e-4i)
+(num-test (exp -1.0e+00-3.14193792057279441821e+00i) -3.6787941924411912824e-1+1.2701662223783029462e-4i)
+(num-test (exp -1.0e+00+4.71204371340168837179e+00i) -1.2701662223794292521e-4-3.6787941924411912820e-1i)
+(num-test (exp -1.0e+00-4.71204371340168837179e+00i) -1.2701662223794292521e-4+3.6787941924411912820e-1i)
+(num-test (exp -1.0e+00+4.71273424736769097620e+00i) 1.2701662223780776850e-4-3.6787941924411912825e-1i)
+(num-test (exp -1.0e+00-4.71273424736769097620e+00i) 1.2701662223780776850e-4+3.6787941924411912825e-1i)
+(num-test (exp -1.0e+00+6.28284004019658492979e+00i) 3.6787941924411912819e-1-1.2701662223796545132e-4i)
+(num-test (exp -1.0e+00-6.28284004019658492979e+00i) 3.6787941924411912819e-1+1.2701662223796545132e-4i)
+(num-test (exp -1.0e+00+6.28353057416258753420e+00i) 3.6787941924411912825e-1+1.2701662223778524238e-4i)
+(num-test (exp -1.0e+00-6.28353057416258753420e+00i) 3.6787941924411912825e-1-1.2701662223778524238e-4i)
+(num-test (exp -1.0e+00+9.42443269378637893396e+00i) -3.6787941924411912829e-1+1.270166222376837610e-4i)
+(num-test (exp -1.0e+00-9.42443269378637893396e+00i) -3.6787941924411912829e-1-1.270166222376837610e-4i)
+(num-test (exp -1.0e+00+9.42512322775237976202e+00i) -3.6787941924411912838e-1-1.2701662223741344759e-4i)
+(num-test (exp -1.0e+00-9.42512322775237976202e+00i) -3.6787941924411912838e-1+1.2701662223741344759e-4i)
+(num-test (exp 2.0e+00-3.45266983001243932001e-04i) 7.3890556585085906002e0-2.5511970558169944872e-3i)
+(num-test (exp 2.0e+00+3.45266983001243932001e-04i) 7.3890556585085906002e0+2.5511970558169944872e-3i)
+(num-test (exp -2.0e+00-3.45266983001243932001e-04i) 1.3533527517000128913e-1-4.6726804008345889445e-5i)
+(num-test (exp -2.0e+00+3.45266983001243932001e-04i) 1.3533527517000128913e-1+4.6726804008345889445e-5i)
+(num-test (exp 2.0e+00+1.57045105981189525579e+00i) 2.551197055817877540e-3+7.3890556585085905999e0i)
+(num-test (exp 2.0e+00-1.57045105981189525579e+00i) 2.551197055817877540e-3-7.3890556585085905999e0i)
+(num-test (exp -2.0e+00+1.57045105981189525579e+00i) 4.6726804008362063122e-5+1.3533527517000128913e-1i)
+(num-test (exp -2.0e+00-1.57045105981189525579e+00i) 4.6726804008362063122e-5-1.3533527517000128913e-1i)
+(num-test (exp 2.0e+00+1.57114159377789786021e+00i) -2.5511970558169726417e-3+7.3890556585085906002e0i)
+(num-test (exp 2.0e+00-1.57114159377789786021e+00i) -2.5511970558169726417e-3-7.3890556585085906002e0i)
+(num-test (exp -2.0e+00+1.57114159377789786021e+00i) -4.6726804008345489330e-5+1.3533527517000128913e-1i)
+(num-test (exp -2.0e+00-1.57114159377789786021e+00i) -4.6726804008345489330e-5-1.3533527517000128913e-1i)
+(num-test (exp 2.0e+00+3.14124738660679181379e+00i) -7.3890556585085905998e0+2.5511970558183299892e-3i)
+(num-test (exp 2.0e+00-3.14124738660679181379e+00i) -7.3890556585085905998e0-2.5511970558183299892e-3i)
+(num-test (exp -2.0e+00+3.14124738660679181379e+00i) -1.3533527517000128912e-1+4.6726804008370350017e-5i)
+(num-test (exp -2.0e+00-3.14124738660679181379e+00i) -1.3533527517000128912e-1-4.6726804008370350017e-5i)
+(num-test (exp 2.0e+00+3.14193792057279441821e+00i) -7.3890556585085906004e0-2.5511970558165201925e-3i)
+(num-test (exp 2.0e+00-3.14193792057279441821e+00i) -7.3890556585085906004e0+2.5511970558165201925e-3i)
+(num-test (exp -2.0e+00+3.14193792057279441821e+00i) -1.3533527517000128914e-1-4.6726804008337202435e-5i)
+(num-test (exp -2.0e+00-3.14193792057279441821e+00i) -1.3533527517000128914e-1+4.6726804008337202435e-5i)
+(num-test (exp 2.0e+00+4.71204371340168837179e+00i) -2.5511970558187824384e-3-7.3890556585085905996e0i)
+(num-test (exp 2.0e+00-4.71204371340168837179e+00i) -2.5511970558187824384e-3+7.3890556585085905996e0i)
+(num-test (exp -2.0e+00+4.71204371340168837179e+00i) -4.6726804008378636913e-5-1.3533527517000128912e-1i)
+(num-test (exp -2.0e+00-4.71204371340168837179e+00i) -4.6726804008378636913e-5+1.3533527517000128912e-1i)
+(num-test (exp 2.0e+00+4.71273424736769097620e+00i) 2.5511970558160677434e-3-7.3890556585085906006e0i)
+(num-test (exp 2.0e+00-4.71273424736769097620e+00i) 2.5511970558160677434e-3+7.3890556585085906006e0i)
+(num-test (exp -2.0e+00+4.71273424736769097620e+00i) 4.6726804008328915539e-5-1.3533527517000128914e-1i)
+(num-test (exp -2.0e+00-4.71273424736769097620e+00i) 4.6726804008328915539e-5+1.3533527517000128914e-1i)
+(num-test (exp 2.0e+00+6.28284004019658492979e+00i) 7.3890556585085905995e0-2.5511970558192348875e-3i)
+(num-test (exp 2.0e+00-6.28284004019658492979e+00i) 7.3890556585085905995e0+2.5511970558192348875e-3i)
+(num-test (exp -2.0e+00+6.28284004019658492979e+00i) 1.3533527517000128912e-1-4.6726804008386923808e-5i)
+(num-test (exp -2.0e+00-6.28284004019658492979e+00i) 1.3533527517000128912e-1+4.6726804008386923808e-5i)
+(num-test (exp 2.0e+00+6.28353057416258753420e+00i) 7.3890556585085906007e0+2.5511970558156152942e-3i)
+(num-test (exp 2.0e+00-6.28353057416258753420e+00i) 7.3890556585085906007e0-2.5511970558156152942e-3i)
+(num-test (exp -2.0e+00+6.28353057416258753420e+00i) 1.3533527517000128914e-1+4.6726804008320628644e-5i)
+(num-test (exp -2.0e+00-6.28353057416258753420e+00i) 1.3533527517000128914e-1-4.6726804008320628644e-5i)
+(num-test (exp 2.0e+00+9.42443269378637893396e+00i) -7.3890556585085906014e0+2.5511970558135769861e-3i)
+(num-test (exp 2.0e+00-9.42443269378637893396e+00i) -7.3890556585085906014e0-2.5511970558135769861e-3i)
+(num-test (exp -2.0e+00+9.42443269378637893396e+00i) -1.3533527517000128916e-1+4.6726804008283295729e-5i)
+(num-test (exp -2.0e+00-9.42443269378637893396e+00i) -1.3533527517000128916e-1-4.6726804008283295729e-5i)
+(num-test (exp 2.0e+00+9.42512322775237976202e+00i) -7.3890556585085906033e0-2.5511970558081475961e-3i)
+(num-test (exp 2.0e+00-9.42512322775237976202e+00i) -7.3890556585085906033e0+2.5511970558081475961e-3i)
+(num-test (exp -2.0e+00+9.42512322775237976202e+00i) -1.3533527517000128919e-1-4.6726804008183852982e-5i)
+(num-test (exp -2.0e+00-9.42512322775237976202e+00i) -1.3533527517000128919e-1+4.6726804008183852982e-5i)
+(num-test (exp -1000) 0.0)
+(num-test (exp -1000000) 0.0)
+(num-test (exp (complex 0.0 (* 0.5 pi))) 0+i)
+(num-test (exp (complex 0.0 pi)) -1)
+(num-test (exp 100.0) 2.688117141816135e43)
+(num-test (exp 500.0) 1.40359221785284E+217)
+(num-test (exp -100.0) 3.720075976020836E-44)
+(num-test (exp -500.0) 7.12457640674129E-218)
+(num-test (exp 5e-10) 1.000000000500000000125000031161629077797E0)
+(num-test (- (expt (exp 5e-8) 2e7) (exp 1)) 0.0)
+(num-test (exp -2.225073858507201399999999999999999999996E-308) 1.000E0)
+(num-test (exp 1.110223024625156799999999999999999999997E-16) 1.000000000000000111022302462515686162976E0)
+(num-test (exp 1/9223372036854775807) 1.000000000000000000108420217248550443418E0)
+(num-test (exp -1/9223372036854775807) 9.999999999999999998915797827514495565934E-1)
+(num-test (exp (* pi (sqrt 163))) 262537412640768743.999999999999)
+(num-test (exp (* pi (sqrt 17))) 422150.99767568)
+(num-test (exp (* pi (sqrt 18))) 614551.992885619)
+(num-test (exp (* pi (sqrt 22))) 2508951.998257424)
+(num-test (exp (* pi (sqrt 6))) 2197.9908695437)
+(num-test (exp (* pi (sqrt 719))) 3.8426143735395488914902942778058291929999e+36)
+(num-test (exp (complex 0.0 pi)) -1.0)
+
+(for-each
+ (lambda (num-and-val)
+   (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'exp num (exp num) val)))
+ (vector (list 0 1) (list 1 2.718281828459) (list 2 7.3890560989307) (list 3 20.085536923188)
+	 (list -1 0.36787944117144) (list -2 0.13533528323661) (list -3 0.049787068367864)
+	 (list -9223372036854775808 0.0) (list 1/2 1.6487212707001) (list 1/3 1.3956124250861)
+	 (list -1/2 0.60653065971263) (list -1/3 0.71653131057379) (list 1/9223372036854775807 1.0)
+	 (list 1.000000000000000000000000000000000000002E-309 1.000E0) (list -inf.0 0.0) (list 0+1i 0.54030230586814+0.8414709848079i)
+	 (list 0+2i -0.41614683654714+0.90929742682568i) (list 0-1i 0.54030230586814-0.8414709848079i)
+	 (list 1+1i 1.4686939399159+2.2873552871788i) (list 1-1i 1.4686939399159-2.2873552871788i)
+	 (list -1+1i 0.19876611034641+0.30955987565311i) (list -1-1i 0.19876611034641-0.30955987565311i)
+	 (list 0.1+0.1i 1.0996496668294+0.1103329887302i) (list 1e-16+1e-16i 1+1e-16i) ))
+
+(test (exp) 'error)
+(test (exp "hi") 'error)
+(test (exp 1.0+23.0i 1.0+23.0i) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (exp arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(unless with-bignums
+  (test (infinite? (exp (expt 2 16))) #t)
+  (test (infinite? (exp (expt 2 54))) #t)
+  (test (infinite? (exp (exp 1e3))) #t))
+
+(when with-bignums
+  (let ((val1 (* 1000 (- (exp 30) 10686474581524)))
+	(val2 (* 1000 (- (exp (bignum "30")) 10686474581524))))
+    (if (> (abs (- val1 val2)) 1)
+	(format #t "(exp 30): ~A ~A~%" val1 val2)))
+  (num-test (exp (* 172.60813659204 (log 172.60813659204))) 1.364508485146898675293943657160611234948E386) ; not inf!
+  (num-test (exp 800.0) 2.726374572112566567364779546367269757963E347)
+  (num-test (exp -800.0) 3.667874584177687213455495654260798215465E-348)
+  (num-test (exp 100) 2.688117141816135448412625551580013587359E43)
+  (num-test (exp 50.0) 5.184705528587072464087453322933485384827E21)
+  (num-test (tan (exp 123)) 1.07218279264703679896051391152400627987E0)
+  (num-test (tan (exp (bignum 123))) 1.07218279264703679896051391152400627987E0)
+
+  (let-temporarily (((*s7* 'bignum-precision) 500))
+    (let ((exps (list  ; table[Exp[k/10], {k, 0, 30}]
+		 1.00000000000000000000000000000000000000000000000000000000000000000000
+		 1.10517091807564762481170782649024666822454719473751871879286328944096
+		 1.22140275816016983392107199463967417030758094152050364127342509859920
+		 1.34985880757600310398374431332800733037829969735936580304991798993961
+		 1.49182469764127031782485295283722228064328277393742528159563315007236
+		 1.64872127070012814684865078781416357165377610071014801157507931164066
+		 1.82211880039050897487536766816286451338223880854643538632054747658881
+		 2.01375270747047652162454938858306527001754239414586731156898930087978
+		 2.22554092849246760457953753139507675705363413504848459611858395555662
+		 2.45960311115694966380012656360247069542177230644008302074854573665746
+		 2.71828182845904523536028747135266249775724709369995957496696762772407
+		 3.00416602394643311205840795358867239328268102601627276212975286052863
+		 3.32011692273654748953076742960164432007363176479282675728202180154077
+		 3.66929666761924422045748991601148625143151888455755146725622649459660
+		 4.05519996684467458722410889522862025216756114168404107165223289450693
+		 4.48168907033806482260205546011927581900574986836966705677265008278593
+		 4.95303242439511480365428635642396425641303112355664964787158190112430
+		 5.47394739172719976079086266300909670070076114490748605875498633804484
+		 6.04964746441294608373102395302772533816116344511729126161486476549696
+		 6.68589444227926941607253072769286145380311864710852264561241990317501
+		 7.38905609893065022723042746057500781318031557055184732408712782252257
+		 8.16616991256765007344972741047863128518315260430523695926385375737882
+		 9.02501349943412092647177716688866402972021659669817926079803719255720
+		 9.97418245481472073995761515690885800147870119368402956369142191697585
+		 11.02317638064160165223793976966780200851716306933940388430829005877357
+		 12.18249396070347343807017595116796618318276779006316131156039834183818
+		 13.46373803500169039775082533258411724479408609657822907153993787261197
+		 14.87973172487283411186899301946839578068879752075547683852481232002013
+		 16.44464677109704987149801601092501556372435769719962288653996273295166
+		 18.17414536944306094267625657412806698753309200930534632364757918918540
+		 20.08553692318766774092852965458171789698790783855415014437893422969884)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 30))
+	(let ((val (exp (bignum (/ i 10)))))
+	  (if (> (magnitude (- val (list-ref exps i))) 1e-36)
+	      (format #t ";(exp ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref exps i) (magnitude (- val (list-ref exps i))))))))))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; log
+;;; --------------------------------------------------------------------------------
+
+(num-test (* 0-2i (log 0+i)) pi)
+(num-test (* 2  0+i (log (/ 1-i 1+i))) pi)
+(num-test (+ 100 (expt 10.0 15) (- (expt 10.0 15))) 100.0)
+(num-test (/ (log -1) (sqrt -1)) pi)
+(num-test (/ (log -8) (log 2)) 3+4.5323601418272i)
+(num-test (/ 53453 (log 53453)) 4910.0000012208)
+(num-test (exp (log (expt 10.0 -16))) 1e-16)
+(num-test (exp (log (expt 10.0 -36))) 1e-36)
+(num-test (exp (log (expt 10.0 16))) 1e16)
+(num-test (exp (log (expt 10.0 36))) 1e36)
+(num-test (exp (log 1000)) 1000.0)
+(num-test (exp (log 1000000)) 1000000.0)
+(num-test (exp (log 1000000000)) 1000000000.0)
+(num-test (exp (log 8)) 8.0)
+(num-test (expt (+ 1 1e-10) (log 100.0 (+ 1 1e-10))) 100.0)
+(num-test (expt (+ 1 1e-15) (log 100.0 (+ 1 1e-15))) 100.0) ; 16 doesn't work if not gmp
+(num-test (expt -2.0 0.13926097063622-0.63118087262379i) 8.0)
+(num-test (expt -2.0 0.26160508088635-0.052598406051983i) 1.0+i)
+(num-test (expt 1.0+i 0.97790391649038-2.2161063668189i) 8.0)
+(num-test (log (/ (+ 1 (sqrt 5)) 2)) (acosh (/ (sqrt 5) 2)))
+(num-test (log (exp 0.0000001)) 0.0000001)
+(num-test (log (exp 0.0001)) 0.0001)
+(num-test (log (exp 0.1)) 0.1)
+(num-test (log (exp 8)) 8.0)
+(num-test (log (expt 2 1022)) 7.083964185322641062244112281302564525734E2)
+(num-test (log (expt 2 125)) 8.664339756999316367715401518227207100938E1)
+(num-test (log (expt 3/2 10) 3/2) 10.0)
+(num-test (log (log (log -1))) 0.66457192224882+0.9410294873126i)
+(num-test (log (sqrt (- (expt 10 17) 1))) 1.957197329044938830915292736481709573957E1)
+(num-test (log (sqrt (- (expt 10 20) 1))) 2.302585092994045684017491454684364207599E1)
+(num-test (log (sqrt (- (expt 10 9) 1))) 1.036163291797320557783096154591297226743E1)
+(num-test (log (sqrt -2) -2) 0.5)
+(num-test (log (sqrt 1+i) 1+i) 0.5)
+(num-test (log (sqrt 2) 2) 0.5)
+(num-test (log -0.0+0.00000001i) -18.42068074395237+1.57079632679490i)
+(num-test (log -0.0+1.0i) 0.0+1.57079632679490i)
+(num-test (log -0.0+1234.0i) 7.11801620446533+1.57079632679490i)
+(num-test (log -0.0+3.14159265358979i) 1.14472988584940+1.57079632679490i)
+(num-test (log -0.0-0.00000001i) -18.42068074395237-1.57079632679490i)
+(num-test (log -0.0-1.0i) 0.0-1.57079632679490i)
+(num-test (log -0.0-1234.0i) 7.11801620446533-1.57079632679490i)
+(num-test (log -0.0-3.14159265358979i) 1.14472988584940-1.57079632679490i)
+(num-test (log -0.00000001) -18.42068074395237+3.14159265358979i)
+(num-test (log -0.00000001+0.00000001i) -18.07410715367239+2.35619449019234i)
+(num-test (log -0.00000001+0.0i) -18.42068074395237+3.14159265358979i)
+(num-test (log -0.00000001+1.0i) 0.0+1.57079633679490i)
+(num-test (log -0.00000001+1234.0i) 7.11801620446533+1.57079632680300i)
+(num-test (log -0.00000001+3.14159265358979i) 1.14472988584940+1.57079632997800i)
+(num-test (log -0.00000001-0.00000001i) -18.07410715367239-2.35619449019234i)
+(num-test (log -0.00000001-0.0i) -18.42068074395237+3.14159265358979i)
+(num-test (log -0.00000001-1.0i) 0.0-1.57079633679490i)
+(num-test (log -0.00000001-1234.0i) 7.11801620446533-1.57079632680300i)
+(num-test (log -0.00000001-3.14159265358979i) 1.14472988584940-1.57079632997800i)
+(num-test (log -0.1e001) (complex 0.0 pi))
+(num-test (log -1 -1) 1.0)
+(num-test (log -1) 0.0+3.141592653589793238462643383279502884197169399375105820974944592307816406286198E0i)
+(num-test (log -1) 0.0+3.14159265358979i)
+(num-test (log -1.0) 0.0+3.14159265358979i)
+(num-test (log -1.0+0.00000001i) 0.0+3.14159264358979i)
+(num-test (log -1.0+0.0i) 0.0+3.14159265358979i)
+(num-test (log -1.0+1.0i) 0.34657359027997+2.35619449019234i)
+(num-test (log -1.0+1234.0i) 7.11801653281724+1.57160669938898i)
+(num-test (log -1.0+3.14159265358979i) 1.19298515341341+1.87896539791088i)
+(num-test (log -1.0-0.00000001i) 0.0-3.14159264358979i)
+(num-test (log -1.0-0.0i) 0.0+3.14159265358979i)
+(num-test (log -1.0-1.0i) 0.34657359027997-2.35619449019234i)
+(num-test (log -1.0-1234.0i) 7.11801653281724-1.57160669938898i)
+(num-test (log -1.0-3.14159265358979i) 1.19298515341341-1.87896539791088i)
+(num-test (log -1.0e+00+0.0e+00i) 0+3.1415926535897932385e0i)
+(num-test (log -1.0e+00+1.0e+00i) 3.4657359027997265471e-1+2.3561944901923449288e0i)
+(num-test (log -1.0e+00+1.19209289550781250e-07i) 7.1054273576009513716e-15+3.1415925343805036877e0i)
+(num-test (log -1.0e+00+2.0e+00i) 8.0471895621705018730e-1+2.0344439357957027354e0i)
+(num-test (log -1.0e+00+5.0e-01i) 1.1157177565710487788e-1+2.6779450445889871222e0i)
+(num-test (log -1.0e+00+8.3886080e+06i) 1.5942385152878749222e1+1.570796446004186170e0i)
+(num-test (log -1.0e+00-1.0e+00i) 3.4657359027997265471e-1-2.3561944901923449288e0i)
+(num-test (log -1.0e+00-1.19209289550781250e-07i) 7.1054273576009513716e-15-3.1415925343805036877e0i)
+(num-test (log -1.0e+00-2.0e+00i) 8.0471895621705018730e-1-2.0344439357957027354e0i)
+(num-test (log -1.0e+00-5.0e-01i) 1.1157177565710487788e-1-2.6779450445889871222e0i)
+(num-test (log -1.0e+00-8.3886080e+06i) 1.5942385152878749222e1-1.570796446004186170e0i)
+(num-test (log -1.19209289550781250e-07+1.0e+00i) 7.1054273576009513716e-15+1.570796446004186170e0i)
+(num-test (log -1.19209289550781250e-07+1.19209289550781250e-07i) -1.5595811562598769462e1+2.3561944901923449288e0i)
+(num-test (log -1.19209289550781250e-07+2.0e+00i) 6.9314718055994708577e-1+1.5707963863995413946e0i)
+(num-test (log -1.19209289550781250e-07+5.0e-01i) -6.9314718055991688771e-1+1.5707965652134757208e0i)
+(num-test (log -1.19209289550781250e-07+8.3886080e+06i) 1.5942385152878742117e1+1.5707963267949108301e0i)
+(num-test (log -1.19209289550781250e-07-1.0e+00i) 7.1054273576009513716e-15-1.570796446004186170e0i)
+(num-test (log -1.19209289550781250e-07-1.19209289550781250e-07i) -1.5595811562598769462e1-2.3561944901923449288e0i)
+(num-test (log -1.19209289550781250e-07-2.0e+00i) 6.9314718055994708577e-1-1.5707963863995413946e0i)
+(num-test (log -1.19209289550781250e-07-5.0e-01i) -6.9314718055991688771e-1-1.5707965652134757208e0i)
+(num-test (log -1.19209289550781250e-07-8.3886080e+06i) 1.5942385152878742117e1-1.5707963267949108301e0i)
+(num-test (log -1/1) 0.0+3.14159265358979i)
+(num-test (log -1/10) -2.30258509299405+3.14159265358979i)
+(num-test (log -1/1234) -7.11801620446533+3.14159265358979i)
+(num-test (log -1/2) -0.69314718055995+3.14159265358979i)
+(num-test (log -1/3) -1.09861228866811+3.14159265358979i)
+(num-test (log -1/500029) -13.12242137572239+3.14159265358979i)
+(num-test (log -10) 2.30258509299405+3.14159265358979i)
+(num-test (log -10/1) 2.30258509299405+3.14159265358979i)
+(num-test (log -10/10) 0.0+3.14159265358979i)
+(num-test (log -10/1234) -4.81543111147129+3.14159265358979i)
+(num-test (log -10/2) 1.60943791243410+3.14159265358979i)
+(num-test (log -10/3) 1.20397280432594+3.14159265358979i)
+(num-test (log -10/500029) -10.81983628272835+3.14159265358979i)
+(num-test (log -1234) 7.11801620446533+3.14159265358979i)
+(num-test (log -1234.0) 7.11801620446533+3.14159265358979i)
+(num-test (log -1234.0+0.00000001i) 7.11801620446533+3.14159265358169i)
+(num-test (log -1234.0+0.0i) 7.11801620446533+3.14159265358979i)
+(num-test (log -1234.0+1.0i) 7.11801653281724+3.14078228099571i)
+(num-test (log -1234.0+1234.0i) 7.46458979474531+2.35619449019234i)
+(num-test (log -1234.0+3.14159265358979i) 7.11801944515932+3.13904679794449i)
+(num-test (log -1234.0-0.00000001i) 7.11801620446533-3.14159265358169i)
+(num-test (log -1234.0-0.0i) 7.11801620446533+3.14159265358979i)
+(num-test (log -1234.0-1.0i) 7.11801653281724-3.14078228099571i)
+(num-test (log -1234.0-1234.0i) 7.46458979474531-2.35619449019234i)
+(num-test (log -1234.0-3.14159265358979i) 7.11801944515932-3.13904679794449i)
+(num-test (log -1234/1) 7.11801620446533+3.14159265358979i)
+(num-test (log -1234/10) 4.81543111147129+3.14159265358979i)
+(num-test (log -1234/2) 6.42486902390539+3.14159265358979i)
+(num-test (log -1234/3) 6.01940391579722+3.14159265358979i)
+(num-test (log -1234/500029) -6.00440517125706+3.14159265358979i)
+(num-test (log -2 -2) 1)
+(num-test (log -2) 0.69314718055995+3.14159265358979i)
+(num-test (log -2.0e+00+0.0e+00i) 6.9314718055994530942e-1+3.1415926535897932385e0i)
+(num-test (log -2.0e+00+1.0e+00i) 8.0471895621705018730e-1+2.6779450445889871222e0i)
+(num-test (log -2.0e+00+1.19209289550781250e-07i) 6.9314718055994708577e-1+3.1415925939851484631e0i)
+(num-test (log -2.0e+00+2.0e+00i) 1.0397207708399179641e0+2.3561944901923449288e0i)
+(num-test (log -2.0e+00+5.0e-01i) 7.2345949146816273071e-1+2.8966139904629290843e0i)
+(num-test (log -2.0e+00+8.3886080e+06i) 1.5942385152878770538e1+1.5707965652134757208e0i)
+(num-test (log -2.0e+00-1.0e+00i) 8.0471895621705018730e-1-2.6779450445889871222e0i)
+(num-test (log -2.0e+00-1.19209289550781250e-07i) 6.9314718055994708577e-1-3.1415925939851484631e0i)
+(num-test (log -2.0e+00-2.0e+00i) 1.0397207708399179641e0-2.3561944901923449288e0i)
+(num-test (log -2.0e+00-5.0e-01i) 7.2345949146816273071e-1-2.8966139904629290843e0i)
+(num-test (log -2.0e+00-8.3886080e+06i) 1.5942385152878770538e1-1.5707965652134757208e0i)
+(num-test (log -2/1) 0.69314718055995+3.14159265358979i)
+(num-test (log -2/10) -1.60943791243410+3.14159265358979i)
+(num-test (log -2/1234) -6.42486902390539+3.14159265358979i)
+(num-test (log -2/2) 0.0+3.14159265358979i)
+(num-test (log -2/3) -0.40546510810816+3.14159265358979i)
+(num-test (log -2/500029) -12.42927419516245+3.14159265358979i)
+(num-test (log -3) 1.09861228866811+3.14159265358979i)
+(num-test (log -3.14159265358979) 1.14472988584940+3.14159265358979i)
+(num-test (log -3.14159265358979+0.00000001i) 1.14472988584940+3.14159265040669i)
+(num-test (log -3.14159265358979+0.0i) 1.14472988584940+3.14159265358979i)
+(num-test (log -3.14159265358979+1.0i) 1.19298515341341+2.83342358247381i)
+(num-test (log -3.14159265358979+1234.0i) 7.11801944515932+1.57334218244020i)
+(num-test (log -3.14159265358979+3.14159265358979i) 1.49130347612937+2.35619449019234i)
+(num-test (log -3.14159265358979-0.00000001i) 1.14472988584940-3.14159265040669i)
+(num-test (log -3.14159265358979-0.0i) 1.14472988584940+3.14159265358979i)
+(num-test (log -3.14159265358979-1.0i) 1.19298515341341-2.83342358247381i)
+(num-test (log -3.14159265358979-1234.0i) 7.11801944515932-1.57334218244020i)
+(num-test (log -3.14159265358979-3.14159265358979i) 1.49130347612937-2.35619449019234i)
+(num-test (log -3/1) 1.09861228866811+3.14159265358979i)
+(num-test (log -3/10) -1.20397280432594+3.14159265358979i)
+(num-test (log -3/1234) -6.01940391579722+3.14159265358979i)
+(num-test (log -3/2) 0.40546510810816+3.14159265358979i)
+(num-test (log -3/3) 0.0+3.14159265358979i)
+(num-test (log -3/500029) -12.02380908705428+3.14159265358979i)
+(num-test (log -5.0e-01+0.0e+00i) -6.9314718055994530942e-1+3.1415926535897932385e0i)
+(num-test (log -5.0e-01+1.0e+00i) 1.1157177565710487788e-1+2.0344439357957027354e0i)
+(num-test (log -5.0e-01+1.19209289550781250e-07i) -6.9314718055991688771e-1+3.1415924151712141369e0i)
+(num-test (log -5.0e-01+2.0e+00i) 7.2345949146816273071e-1+1.8157749899217607734e0i)
+(num-test (log -5.0e-01+5.0e-01i) -3.4657359027997265471e-1+2.3561944901923449288e0i)
+(num-test (log -5.0e-01+8.3886080e+06i) 1.5942385152878743893e1+1.5707963863995413946e0i)
+(num-test (log -5.0e-01-1.0e+00i) 1.1157177565710487788e-1-2.0344439357957027354e0i)
+(num-test (log -5.0e-01-1.19209289550781250e-07i) -6.9314718055991688771e-1-3.1415924151712141369e0i)
+(num-test (log -5.0e-01-2.0e+00i) 7.2345949146816273071e-1-1.8157749899217607734e0i)
+(num-test (log -5.0e-01-5.0e-01i) -3.4657359027997265471e-1-2.3561944901923449288e0i)
+(num-test (log -5.0e-01-8.3886080e+06i) 1.5942385152878743893e1-1.5707963863995413946e0i)
+(num-test (log -500029) 13.12242137572239+3.14159265358979i)
+(num-test (log -500029/1) 13.12242137572239+3.14159265358979i)
+(num-test (log -500029/10) 10.81983628272835+3.14159265358979i)
+(num-test (log -500029/1234) 6.00440517125706+3.14159265358979i)
+(num-test (log -500029/2) 12.42927419516245+3.14159265358979i)
+(num-test (log -500029/3) 12.02380908705428+3.14159265358979i)
+(num-test (log -500029/500029) 0.0+3.14159265358979i)
+(num-test (log -8.3886080e+06+1.0e+00i) 1.5942385152878749222e1+3.1415925343805036877e0i)
+(num-test (log -8.3886080e+06+1.19209289550781250e-07i) 1.5942385152878742117e1+3.1415926535897790276e0i)
+(num-test (log -8.3886080e+06+2.0e+00i) 1.5942385152878770538e1+3.1415924151712141369e0i)
+(num-test (log -8.3886080e+06+5.0e-01i) 1.5942385152878743893e1+3.1415925939851484631e0i)
+(num-test (log -8.3886080e+06+8.3886080e+06i) 1.6288958743158714771e1+2.3561944901923449288e0i)
+(num-test (log -8.3886080e+06-1.0e+00i) 1.5942385152878749222e1-3.1415925343805036877e0i)
+(num-test (log -8.3886080e+06-1.19209289550781250e-07i) 1.5942385152878742117e1-3.1415926535897790276e0i)
+(num-test (log -8.3886080e+06-2.0e+00i) 1.5942385152878770538e1-3.1415924151712141369e0i)
+(num-test (log -8.3886080e+06-5.0e-01i) 1.5942385152878743893e1-3.1415925939851484631e0i)
+(num-test (log -8.3886080e+06-8.3886080e+06i) 1.6288958743158714771e1-2.3561944901923449288e0i)
+(num-test (log -9223372036854775808) 4.366827237527655449328562365186512378885E1+3.141592653589793238462643383279502884195E0i)
+(num-test (log .3678794411714423) -1.0)
+(num-test (log 0+i) (complex 0.0 (* 0.5 pi)))
+(num-test (log 0-i) (complex 0.0 (* -0.5 pi)))
+(num-test (log 0.0+0.00000001i) -18.42068074395237+1.57079632679490i)
+(num-test (log 0.0+1.0i) 0.0+1.57079632679490i)
+(num-test (log 0.0+1234.0i) 7.11801620446533+1.57079632679490i)
+(num-test (log 0.0+3.14159265358979i) 1.14472988584940+1.57079632679490i)
+(num-test (log 0.0-0.00000001i) -18.42068074395237-1.57079632679490i)
+(num-test (log 0.0-1.0i) 0.0-1.57079632679490i)
+(num-test (log 0.0-1234.0i) 7.11801620446533-1.57079632679490i)
+(num-test (log 0.0-3.14159265358979i) 1.14472988584940-1.57079632679490i)
+(num-test (log 0.00000001) -18.42068074395237)
+(num-test (log 0.00000001+0.00000001i) -18.07410715367239+0.78539816339745i)
+(num-test (log 0.00000001+0.0i) -18.42068074395237)
+(num-test (log 0.00000001+1.0i) 0.0+1.57079631679490i)
+(num-test (log 0.00000001+1234.0i) 7.11801620446533+1.57079632678679i)
+(num-test (log 0.00000001+3.14159265358979i) 1.14472988584940+1.57079632361180i)
+(num-test (log 0.00000001-0.00000001i) -18.07410715367239-0.78539816339745i)
+(num-test (log 0.00000001-0.0i) -18.42068074395237)
+(num-test (log 0.00000001-1.0i) 0.0-1.57079631679490i)
+(num-test (log 0.00000001-1234.0i) 7.11801620446533-1.57079632678679i)
+(num-test (log 0.00000001-3.14159265358979i) 1.14472988584940-1.57079632361180i)
+(num-test (log 0.0e+00+1.0e+00i) 0+1.5707963267948966192e0i)
+(num-test (log 0.0e+00+1.19209289550781250e-07i) -1.5942385152878742117e1+1.5707963267948966192e0i)
+(num-test (log 0.0e+00+2.0e+00i) 6.9314718055994530942e-1+1.5707963267948966192e0i)
+(num-test (log 0.0e+00+5.0e-01i) -6.9314718055994530942e-1+1.5707963267948966192e0i)
+(num-test (log 0.0e+00+8.3886080e+06i) 1.5942385152878742117e1+1.5707963267948966192e0i)
+(num-test (log 0.0e+00-1.0e+00i) 0-1.5707963267948966192e0i)
+(num-test (log 0.0e+00-1.19209289550781250e-07i) -1.5942385152878742117e1-1.5707963267948966192e0i)
+(num-test (log 0.0e+00-2.0e+00i) 6.9314718055994530942e-1-1.5707963267948966192e0i)
+(num-test (log 0.0e+00-5.0e-01i) -6.9314718055994530942e-1-1.5707963267948966192e0i)
+(num-test (log 0.0e+00-8.3886080e+06i) 1.5942385152878742117e1-1.5707963267948966192e0i)
+(num-test (log 1 -1) 0.0)
+(num-test (log 1) 0.0)
+(num-test (log 1.0) 0.0)
+(num-test (log 1.0+0.00000001i) 0.0+0.00000001i)
+(num-test (log 1.0+0.0i) 0.0)
+(num-test (log 1.0+1.0i) 0.34657359027997+0.78539816339745i)
+(num-test (log 1.0+1234.0i) 7.11801653281724+1.56998595420081i)
+(num-test (log 1.0+3.14159265358979i) 1.19298515341341+1.26262725567891i)
+(num-test (log 1.0+i -2.0) 0.26160508088635-0.052598406051983i)
+(num-test (log 1.0-0.00000001i) 0.0-0.00000001i)
+(num-test (log 1.0-0.0i) 0.0)
+(num-test (log 1.0-1.0i) 0.34657359027997-0.78539816339745i)
+(num-test (log 1.0-1234.0i) 7.11801653281724-1.56998595420081i)
+(num-test (log 1.0-3.14159265358979i) 1.19298515341341-1.26262725567891i)
+(num-test (log 1.0e+00+0.0e+00i) 0e0+0.0i)
+(num-test (log 1.0e+00+1.0e+00i) 3.4657359027997265471e-1+7.8539816339744830962e-1i)
+(num-test (log 1.0e+00+1.19209289550781250e-07i) 7.1054273576009513716e-15+1.1920928955078068531e-7i)
+(num-test (log 1.0e+00+2.0e+00i) 8.0471895621705018730e-1+1.1071487177940905030e0i)
+(num-test (log 1.0e+00+5.0e-01i) 1.1157177565710487788e-1+4.6364760900080611621e-1i)
+(num-test (log 1.0e+00+8.3886080e+06i) 1.5942385152878749222e1+1.5707962075856070685e0i)
+(num-test (log 1.0e+00-1.0e+00i) 3.4657359027997265471e-1-7.8539816339744830962e-1i)
+(num-test (log 1.0e+00-1.19209289550781250e-07i) 7.1054273576009513716e-15-1.1920928955078068531e-7i)
+(num-test (log 1.0e+00-2.0e+00i) 8.0471895621705018730e-1-1.1071487177940905030e0i)
+(num-test (log 1.0e+00-5.0e-01i) 1.1157177565710487788e-1-4.6364760900080611621e-1i)
+(num-test (log 1.0e+00-8.3886080e+06i) 1.5942385152878749222e1-1.5707962075856070685e0i)
+(num-test (log 1.0e-12) -27.63102111592855)
+(num-test (log 1.0e-8) -18.42068074395237)
+(num-test (log 1.110223024625156799999999999999999999997E-16) -3.673680056967710116530769529852882544059E1)
+(num-test (log 1.19209289550781250e-07+0.0e+00i) -1.5942385152878742117e1+0.0i)
+(num-test (log 1.19209289550781250e-07+1.0e+00i) 7.1054273576009513716e-15+1.5707962075856070685e0i)
+(num-test (log 1.19209289550781250e-07+1.19209289550781250e-07i) -1.5595811562598769462e1+7.8539816339744830962e-1i)
+(num-test (log 1.19209289550781250e-07+2.0e+00i) 6.9314718055994708577e-1+1.5707962671902518438e0i)
+(num-test (log 1.19209289550781250e-07+5.0e-01i) -6.9314718055991688771e-1+1.5707960883763175177e0i)
+(num-test (log 1.19209289550781250e-07+8.3886080e+06i) 1.5942385152878742117e1+1.5707963267948824084e0i)
+(num-test (log 1.19209289550781250e-07-1.0e+00i) 7.1054273576009513716e-15-1.5707962075856070685e0i)
+(num-test (log 1.19209289550781250e-07-1.19209289550781250e-07i) -1.5595811562598769462e1-7.8539816339744830962e-1i)
+(num-test (log 1.19209289550781250e-07-2.0e+00i) 6.9314718055994708577e-1-1.5707962671902518438e0i)
+(num-test (log 1.19209289550781250e-07-5.0e-01i) -6.9314718055991688771e-1-1.5707960883763175177e0i)
+(num-test (log 1.19209289550781250e-07-8.3886080e+06i) 1.5942385152878742117e1-1.5707963267948824084e0i)
+(num-test (log 1.5 -1) 0-0.12906355241341i)
+(num-test (log 1.7976931e+308) 709.78271287399)
+(num-test (log 1/1) 0.0)
+(num-test (log 1/10) -2.30258509299405)
+(num-test (log 1/1073741824 2) -30)
+(num-test (log 1/1152921504606846976 8) -20)
+(num-test (log 1/1234) -7.11801620446533)
+(num-test (log 1/16777216 2) -24)
+(num-test (log 1/18014398509481984 512) -6)
+(num-test (log 1/2 1/4) 1/2)
+(num-test (log 1/2 1/8) 1/3)
+(num-test (log 1/2 8) -1/3)
+(num-test (log 1/2) -0.69314718055995)
+(num-test (log 1/2147483648 2) -31)
+(num-test (log 1/256 2) -8)
+(num-test (log 1/3) -1.09861228866811)
+(num-test (log 1/4 1/2) 2)
+(num-test (log 1/4 1/2) 2)
+(num-test (log 1/500029) -13.12242137572239)
+(num-test (log 1/65536 2) -16)
+(num-test (log 1/8192 2) -13)
+;(num-test (log 10 (real-part (log 0))) 0.0) ; ??? -- this returns -nan-nani in clang, 0.0 in gcc
+(num-test (log 10) 2.30258509299405)
+(num-test (log 10.0 (exp -1)) (- (log 10.0)))
+(num-test (log 10.0 (exp 1)) (log 10.0))
+(num-test (log 10.0 -0.001) -0.27620436338394-0.12561556740966i)
+(num-test (log 10.0 0.001) -0.33333333333333)
+(num-test (log 10.0 100.0) 0.5)
+(num-test (log 10.0 1e-20) -0.05)
+(num-test (log 10.0 1e20) 0.05)
+(num-test (log 10.0 2124008553358849/781379079653017) 2.302585092994045684017991454684419658469E0)
+(num-test (log 10/1) 2.30258509299405)
+(num-test (log 10/10) 0.0)
+(num-test (log 10/1234) -4.81543111147129)
+(num-test (log 10/2) 1.60943791243410)
+(num-test (log 10/3) 1.20397280432594)
+(num-test (log 10/500029) -10.81983628272835)
+(num-test (log 12/8 3/2) 1.0)
+(num-test (log 1234) 7.11801620446533)
+(num-test (log 1234.0) 7.11801620446533)
+(num-test (log 1234.0+0.00000001i) 7.11801620446533+0.00000000000810i)
+(num-test (log 1234.0+0.0i) 7.11801620446533)
+(num-test (log 1234.0+1.0i) 7.11801653281724+0.00081037259408i)
+(num-test (log 1234.0+1234.0i) 7.46458979474531+0.78539816339745i)
+(num-test (log 1234.0+3.14159265358979i) 7.11801944515932+0.00254585564530i)
+(num-test (log 1234.0-0.00000001i) 7.11801620446533-0.00000000000810i)
+(num-test (log 1234.0-0.0i) 7.11801620446533)
+(num-test (log 1234.0-1.0i) 7.11801653281724-0.00081037259408i)
+(num-test (log 1234.0-1234.0i) 7.46458979474531-0.78539816339745i)
+(num-test (log 1234.0-3.14159265358979i) 7.11801944515932-0.00254585564530i)
+(num-test (log 1234/1) 7.11801620446533)
+(num-test (log 1234/10) 4.81543111147129)
+(num-test (log 1234/2) 6.42486902390539)
+(num-test (log 1234/3) 6.01940391579722)
+(num-test (log 1234/500029) -6.00440517125706)
+(num-test (log 15693/12583 24271/35566) -5.78025354982372501902371206100042173188E-1)
+(num-test (log 1e-100) -2.302585092994045684017991454684364207602E2)
+(num-test (log 1e-18) -4.144653167389282231232384618431855573682E1)
+(num-test (log 1e-300) -6.907755278982137052053974364053092622806E2)
+(num-test (log 1e-50 10) -50.0)
+(num-test (log 1e100) 2.302585092994045684017991454684364207602E2)
+(num-test (log 1e18) 4.144653167389282231232384618431855573682E1)
+(num-test (log 1e300) 6.907755278982137052053974364053092622806E2)
+(num-test (log 1e50 10) 50.0)
+(num-test (log 2 1/8) -1/3)
+(num-test (log 2 2) 1)
+(num-test (log 2 8) 1/3)
+(num-test (log 2) 0.69314718055995)
+(num-test (log 2.0e+00+0.0e+00i) 6.9314718055994530942e-1+0.0i)
+(num-test (log 2.0e+00+1.0e+00i) 8.0471895621705018730e-1+4.6364760900080611621e-1i)
+(num-test (log 2.0e+00+1.19209289550781250e-07i) 6.9314718055994708577e-1+5.9604644775390554414e-8i)
+(num-test (log 2.0e+00+2.0e+00i) 1.0397207708399179641e0+7.8539816339744830962e-1i)
+(num-test (log 2.0e+00+5.0e-01i) 7.2345949146816273071e-1+2.4497866312686415417e-1i)
+(num-test (log 2.0e+00+8.3886080e+06i) 1.5942385152878770538e1+1.5707960883763175177e0i)
+(num-test (log 2.0e+00-1.0e+00i) 8.0471895621705018730e-1-4.6364760900080611621e-1i)
+(num-test (log 2.0e+00-1.19209289550781250e-07i) 6.9314718055994708577e-1-5.9604644775390554414e-8i)
+(num-test (log 2.0e+00-2.0e+00i) 1.0397207708399179641e0-7.8539816339744830962e-1i)
+(num-test (log 2.0e+00-5.0e-01i) 7.2345949146816273071e-1-2.4497866312686415417e-1i)
+(num-test (log 2.0e+00-8.3886080e+06i) 1.5942385152878770538e1-1.5707960883763175177e0i)
+(num-test (log 2.2250739e-308) -708.39641851362)
+(num-test (log 2.688117141816135E+43) 100.0)
+(num-test (log 2/1) 0.69314718055995)
+(num-test (log 2/10) -1.60943791243410)
+(num-test (log 2/1234) -6.42486902390539)
+(num-test (log 2/2) 0.0)
+(num-test (log 2/3) -0.40546510810816)
+(num-test (log 2/500029) -12.42927419516245)
+(num-test (log 22026.46579480672) 10.0)
+(num-test (log 24998/50401 24728/63453) 7.441028498776462417495086765025452881649E-1)
+(num-test (log 25438/28960 36472/54817) 3.182468797561633550530828023298618520944E-1)
+(num-test (log 2921/7914 2921/7914) 1)
+(num-test (log 3) 1.09861228866811)
+(num-test (log 3.14159265358979+0.00000001i) 1.14472988584940+0.00000000318310i)
+(num-test (log 3.14159265358979+0.0i) 1.14472988584940)
+(num-test (log 3.14159265358979+1.0i) 1.19298515341341+0.30816907111598i)
+(num-test (log 3.14159265358979+1234.0i) 7.11801944515932+1.56825047114960i)
+(num-test (log 3.14159265358979+3.14159265358979i) 1.49130347612937+0.78539816339745i)
+(num-test (log 3.14159265358979-0.00000001i) 1.14472988584940-0.00000000318310i)
+(num-test (log 3.14159265358979-0.0i) 1.14472988584940)
+(num-test (log 3.14159265358979-1.0i) 1.19298515341341-0.30816907111598i)
+(num-test (log 3.14159265358979-1234.0i) 7.11801944515932-1.56825047114960i)
+(num-test (log 3.14159265358979-3.14159265358979i) 1.49130347612937-0.78539816339745i)
+(num-test (log 3.720075976020836E-44) -100.0)
+(num-test (log 3/1) 1.09861228866811)
+(num-test (log 3/10) -1.20397280432594)
+(num-test (log 3/1234) -6.01940391579722)
+(num-test (log 3/2) 0.40546510810816)
+(num-test (log 3/3) 0.0)
+(num-test (log 3/500029) -12.02380908705428)
+(num-test (log 4 1/2) -2)
+(num-test (log 4.5399929762484853E-5) -10.0)
+(num-test (log 42665/30784 48270/29769) 6.752638664357152674138191677370820431573E-1)
+(num-test (log 43340/27863 27919/48593) -7.971826992064755184257579917033070384525E-1)
+(num-test (log 43686/40844 3924/13265) -5.522724914533037935994124583907811339125E-2)
+(num-test (log 46770/6899 56965/50618) 1.620137763694524415676013256791616662615E1)
+(num-test (log 5.0e-01+0.0e+00i) -6.9314718055994530942e-1+0.0i)
+(num-test (log 5.0e-01+1.0e+00i) 1.1157177565710487788e-1+1.1071487177940905030e0i)
+(num-test (log 5.0e-01+1.19209289550781250e-07i) -6.9314718055991688771e-1+2.3841857910155798249e-7i)
+(num-test (log 5.0e-01+2.0e+00i) 7.2345949146816273071e-1+1.3258176636680324651e0i)
+(num-test (log 5.0e-01+5.0e-01i) -3.4657359027997265471e-1+7.8539816339744830962e-1i)
+(num-test (log 5.0e-01+8.3886080e+06i) 1.5942385152878743893e1+1.5707962671902518438e0i)
+(num-test (log 5.0e-01-1.0e+00i) 1.1157177565710487788e-1-1.1071487177940905030e0i)
+(num-test (log 5.0e-01-1.19209289550781250e-07i) -6.9314718055991688771e-1-2.3841857910155798249e-7i)
+(num-test (log 5.0e-01-2.0e+00i) 7.2345949146816273071e-1-1.3258176636680324651e0i)
+(num-test (log 5.0e-01-5.0e-01i) -3.4657359027997265471e-1-7.8539816339744830962e-1i)
+(num-test (log 5.0e-01-8.3886080e+06i) 1.5942385152878743893e1-1.5707962671902518438e0i)
+(num-test (log 500029) 13.12242137572239)
+(num-test (log 500029/1) 13.12242137572239)
+(num-test (log 500029/10) 10.81983628272835)
+(num-test (log 500029/1234) 6.00440517125706)
+(num-test (log 500029/2) 12.42927419516245)
+(num-test (log 500029/3) 12.02380908705428)
+(num-test (log 500029/500029) 0.0)
+(num-test (log 54595/38975 21029/18267) 2.393514540234982342775959084446190967875E0)
+(num-test (log 55510/63095 55510/63095) 1)
+(num-test (log 60726/29873 34251/53142) -1.615057368690198504993598764304726754524E0)
+(num-test (log 62092/33540 1958/6237) -5.315823311016084206705945306286559292707E-1)
+(num-test (log 8 2) 3)
+(num-test (log 8.0 -2.0) 0.13926097063622-0.63118087262379i)
+(num-test (log 8.0 1.0+i) 0.97790391649038-2.2161063668189i)
+(num-test (log 8.0 2) 3.0)
+(num-test (log 8.3886080e+06+0.0e+00i) 1.5942385152878742117e1+0.0i)
+(num-test (log 8.3886080e+06+1.0e+00i) 1.5942385152878749222e1+1.1920928955078068531e-7i)
+(num-test (log 8.3886080e+06+1.19209289550781250e-07i) 1.5942385152878742117e1+1.4210854715202003717e-14i)
+(num-test (log 8.3886080e+06+2.0e+00i) 1.5942385152878770538e1+2.3841857910155798249e-7i)
+(num-test (log 8.3886080e+06+5.0e-01i) 1.5942385152878743893e1+5.9604644775390554414e-8i)
+(num-test (log 8.3886080e+06+8.3886080e+06i) 1.6288958743158714771e1+7.8539816339744830962e-1i)
+(num-test (log 8.3886080e+06-1.0e+00i) 1.5942385152878749222e1-1.1920928955078068531e-7i)
+(num-test (log 8.3886080e+06-1.19209289550781250e-07i) 1.5942385152878742117e1-1.4210854715202003717e-14i)
+(num-test (log 8.3886080e+06-2.0e+00i) 1.5942385152878770538e1-2.3841857910155798249e-7i)
+(num-test (log 8.3886080e+06-5.0e-01i) 1.5942385152878743893e1-5.9604644775390554414e-8i)
+(num-test (log 8.3886080e+06-8.3886080e+06i) 1.6288958743158714771e1-7.8539816339744830962e-1i)
+(num-test (log 9.0 3.0) 2.0)
+(num-test (log 9223372036854775807) 4.366827237527655449317720343461657334526E1)
+(num-test (log pi) 1.14472988584940)
+(num-test (log (/ 1+i)) (log (/ 1 1+i)))
+(test (< (real-part (log 0.0)) (real-part (- (log 0.0)))) #t)
+
+(test (infinite? (random (log 0.0))) #t)
+(test (infinite? (random +inf.0)) #t)
+(unless with-bignums (num-test (log 1 1) 0))  ; (expt 1 0) is 1 but so is (expt 1 1) -- an ambiguous case (returns NaN in gmp)
+(unless with-bignums (num-test (log 1.0 1.0) 0.0))
+(num-test (log 2 1) +inf.0)
+(test (nan? (log +nan.0)) #t)
+(test (nan? (log +nan.0 1)) #t)
+(test (nan? (log +nan.0 1+i)) #t)
+(num-test (log (log 16 2) 2) 2)
+
+(num-test (log 2/3 4/9) 1/2)
+(num-test (log 8/27 2/3) 3)
+(when with-bignums
+  (test (nan? (log +nan.0 (bignum +inf.0))) #t)
+  (num-test (log 8/27 (bignum 2/3)) 3)
+  (num-test (log -inf.0) +inf.0+3.141592653589793i)
+  (num-test (log +inf.0-nan.0i (bignum 1+i)) +nan.0)
+  (test (nan? (log (bignum 9223372036854775806) +inf.0-nan.0i)) #t)
+  (num-test (log (bignum +inf.0-nan.0i) (bignum 1+i)) +nan.0))
+(test (nan? (log 9223372036854775806 +inf.0-nan.0i)) #t)
+
+(num-test (log -1) (complex 0 pi))
+
+(do ((i 0 (+ i 1))
+     (n 1 (* n 2)))
+    ((= i 60))
+  (let ((x (log n 2)))
+    (if (not (= (expt 2 i) n))
+	(format *stderr* "(log ~D 2): ~A~%" n x))))
+
+(for-each
+ (lambda (num-and-val)
+   (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'log num (log num) val)))
+ (vector (list 1 0.0) (list 2 0.69314718055995) (list 3 1.0986122886681) (list -1 0+3.1415926535898i)
+	 (list -2 0.69314718055995+3.1415926535898i) (list -3 1.0986122886681+3.1415926535898i)
+	 (list 9223372036854775807 43.668272375277) (list -9223372036854775808 43.668272375277+3.1415926535898i)
+	 (list 1/2 -0.69314718055995) (list 1/3 -1.0986122886681) (list -1/2 -0.69314718055995+3.1415926535898i)
+	 (list -1/3 -1.0986122886681+3.1415926535898i) (list 1/9223372036854775807 -43.668272375277)
+	 (list 1.0 0.0) (list 2.0 0.69314718055995) (list -2.0 0.69314718055995+3.1415926535898i)
+	 (list 1.000000000000000000000000000000000000002E-309 -7.114987937351601163615593594974685401477E2)
+	 (list 1e+16 36.841361487905) (list 0+1i 0+1.5707963267949i) (list 0+2i 0.69314718055995+1.5707963267949i)
+	 (list 0-1i 0-1.5707963267949i) (list 1+1i 0.34657359027997+0.78539816339745i) (list 1-1i 0.34657359027997-0.78539816339745i)
+	 (list -1+1i 0.34657359027997+2.3561944901923i) (list -1-1i 0.34657359027997-2.3561944901923i)
+	 (list 0.1+0.1i -1.9560115027141+0.78539816339745i) (list 1e+16+1e+16i 37.187935078185+0.78539816339745i)
+	 (list 1e-16+1e-16i -36.494787897625+0.78539816339745i) ))
+
+(let ((err 0.0)
+      (mx 0.0))
+  (do ((i 0 (+ i 1))
+       (x -10.0 (+ x .1)))
+      ((= i 200))
+    (if (not (zero? x))
+	(let ((y (magnitude (- x (exp (log x))))))
+	  (if (> y err) (begin (set! mx x) (set! err y))))))
+  (if (> err 1e-14)
+      (format #t ";(exp (log ~A)) error: ~A~%" mx err)))
+
+(let ((err 0.0)
+      (mx 0.0))
+  (do ((i 0 (+ i 1))
+       (x -10.0+i (+ x 0.1-0.1i)))
+      ((= i 200))
+    (if (not (zero? x))
+	(let ((y (magnitude (- x (exp (log x))))))
+	  (if (> y err) (begin (set! err y) (set! mx x))))))
+  (if (> err 1e-14)
+      (format #t ";(exp (log ~A)) error: ~A~%" mx err)))
+
+(do ((i 0 (+ i 1)))
+    ((= i 100))
+  (let ((val (+ .001 (random 100.0)))
+	(base (+ 2 (random 20))))
+    (num-test (log val base) (/ (log val) (log base)))))
+
+(do ((i 0 (+ i 1)))
+    ((= i 100))
+  (let ((val (+ .001 (random 10000.0)))
+	(base (+ 1.0 (random 20.0))))
+    (num-test (log val base) (/ (log val) (log base)))))
+
+(let ((val1 (catch #t (lambda () (log 0.0)) (lambda args 'error)))
+      (val2 (catch #t (lambda () (log -0.0)) (lambda args 'error))))
+  (test (equal? val1 val2) #t))
+
+(do ((i 0 (+ i 1)))
+    ((= i 100))
+  (let ((val (+ .001 (random 100.0)))
+	(base (+ 2 (random 20))))
+    (if (> (random 1.0) 0.5) (set! val (- val)))
+    (if (> (random 1.0) 0.5) (set! base (- base)))
+    (num-test (log val base) (/ (log val) (log base)))))
+
+(do ((i 0 (+ i 1)))
+    ((= i 100))
+  (let ((val (+ .001 (random 10000.0)))
+	(base (+ 1.0 (random 20.0))))
+    (if (> (random 1.0) 0.5) (set! val (- val)))
+    (if (> (random 1.0) 0.5) (set! base (- base)))
+    (num-test (log val base) (/ (log val) (log base)))))
+
+(do ((i 0 (+ i 1)))
+    ((= i 100))
+  (let ((val1 (+ .001 (random 10000.0)))
+	(val2 (+ .001 (random 10000.0)))
+	(base1 (+ 1.0 (random 20.0)))
+	(base2 (+ 1.0 (random 20.0))))
+    (if (> (random 1.0) 0.5) (set! val1 (- val1)))
+    (if (> (random 1.0) 0.5) (set! val2 (- val2)))
+    (if (> (random 1.0) 0.5) (set! base1 (- base1)))
+    (if (> (random 1.0) 0.5) (set! base2 (- base2)))
+    (let ((val (complex val1 val2))
+	  (base (complex base1 base2)))
+      (num-test (log val base) (/ (log val) (log base))))))
+
+(if (not with-bignums)
+    (num-test (log 1 0) 0)) ; since (expt 0 0) is 1
+
+(when with-bignums
+  (num-test (log (expt 2 16382)) 1.135513711193302405887309661372784853823E4)
+  (num-test (log -1.797693134862315699999999999999999999998E308) 7.097827128933839967276924307167005609752E2+3.141592653589793238462643383279502884195E0i)
+  (num-test (log -2.225073858507201399999999999999999999996E-308) -7.083964185322641062168115849912137186655E2+3.141592653589793238462643383279502884195E0i)
+  (num-test (log 69720375229712477164533808935312303556800) 9.40453112293573922460049312446069272415E1)
+  (num-test (log 100.0 (+ 1.0 (bignum "1e-16"))) 4.605170185988091598294419229104461919985E16)
+  (num-test (expt (+ 1.0 (bignum "1e-16")) 4.605170185988091598294419229104461919985E16) 100.0)
+  (num-test (log 100.0 (+ 1.0 (bignum "1e-34"))) 4.60520221864866031976806443342804401709E34)
+  (num-test (expt (+ 1.0 (bignum "1e-34")) 4.60520221864866031976806443342804401709E34) 100.0)
+  (num-test (expt (+ 1 1e-16) (log 100.0 (+ 1 1e-16))) 100.0)
+  (num-test (+ 100 (expt 10.0 35) (- (expt 10.0 35))) 100.0)
+  (num-test (log 1/9223372036854775808 2) -63)
+  (num-test (log 9223372036854775808 2) 63)
+  (num-test (log 9223372036854775807/9223372036854775806 9223372036854775806/9223372036854775807) -9.999999999999999999999999999999999999647E-1)
+  (test (let ((z (log 0+0/0i))) (and (nan? z) (complex? z))) #t)
+  (test (let ((z (bignum (log 0+0/0i)))) (and (nan? z) (complex? z))) #t))
+
+(let ((logs-1 (list
+	       -4.60517018598809136803598290936872841520220297725754595206665580193514
+	       -3.91202300542814605861875078791055184712670284289729069794597579244175
+	       -3.50655789731998167664073767244620271055471241943479650033196146829765
+	       -3.21887582486820074920151866645237527905120270853703544382529578294835
+	       -2.99573227355399099343522357614254077567660162298902823015400791046096
+	       -2.81341071676003636722350555098802614247921228507454124621128145880425
+	       -2.65926003693277806293063016592554868556511824767568476360726565199756
+	       -2.52572864430825543978428654499419871097570257417678018970461577345496
+	       -2.40794560865187198524549243552367700590722186161204704859726713466015
+	       -2.30258509299404568401799145468436420760110148862877297603332790096757
+	       -2.20727491318972082397403933140359911538049612332012877684808809280457
+	       -2.12026353620009105780627342952984957440371215071428599209060144931086
+	       -2.04022082852655463198249546780340981039693503249733883564761029127168
+	       -1.96611285637283275351339804446737211748961811331542950948658564250417
+	       -1.89711998488588130203997833922001507102911106516627877841931357682347
+	       -1.83258146374831013036705442353602214290020243981652493558393576396157
+	       -1.77195684193187528778644829149560187961399996467180116476941806405285
+	       -1.71479842809192667582826031406550043783172172725179179447658712516676
+	       -1.66073120682165090802695547748087487796482371595841713352869556552585
+	       -1.60943791243410037460075933322618763952560135426851772191264789147417))
+      (logs-2 (list
+	       2.30258509299404568401799145468436420760110148862877297603332790096757
+	       2.99573227355399099343522357614254077567660162298902823015400791046096
+	       3.40119738166215537541323669160688991224859204645152242776802223460506
+	       3.68887945411393630285245569760071734375210175734928348427468791995435
+	       3.91202300542814605861875078791055184712670284289729069794597579244175
+	       4.09434456222210068483046881306506648032409218081177768188870224409846
+	       4.24849524204935898912334419812754393723818621821063416449271805090515
+	       4.38202663467388161226968781905889391182760189170953873839536792944775
+	       4.49980967033026506680848192852941561689608260427427187950271656824256
+	       4.60517018598809136803598290936872841520220297725754595206665580193514
+	       4.70048036579241622807993503264949350742280834256619015125189561009814
+	       4.78749174278204599424770093452324304839959231517203293600938225359185
+	       4.86753445045558242007147889624968281240636943338898009245237341163103
+	       4.94164242260930429854057631958572050531368635257088941861339806039854
+	       5.01063529409625575001399602483307755177419340072004014968067012607924
+	       5.07517381523382692168691994051707047990310202606979399251604793894114
+	       5.13579843705026176426752607255749074318930450121451776333056563884986
+	       5.19295685089021037622571404998759218497158273863452713362339657773595
+	       5.24702407216048614402701888657221774483848074992790179457128813737686
+	       5.29831736654803667745321503082690498327770311161780120618733581142853)))
+  (let ((mxerr 0.0))
+    (do ((i 0 (+ i 1))
+	 (x 0.01 (+ x 0.01))
+	 (y 10.0 (+ y 10.0)))
+	((= i 20))
+      (let ((err (max (abs (- (log x) (list-ref logs-1 i)))
+		      (abs (- (log y) (list-ref logs-2 i))))))
+	(if (> err mxerr)
+	    (set! mxerr err))))
+    (if (> mxerr 1e-12) (format #t "log err: ~A~%" mxerr))))
+
+(when with-bignums
+  (let-temporarily (((*s7* 'bignum-precision) 500))
+    (let ((logs (list ; table[Log[k/10 + 1.0], {k, 0, 30}]
+		 0.00000000000000000000000000000000000000000000000000000000000000000000e0
+		 0.09531017980432486004395212328076509222060536530864419918523980816300
+		 0.18232155679395462621171802515451463319738933791448698394272645165670
+		 0.26236426446749105203549598688095439720416645613143414038571760969589
+		 0.33647223662121293050459341021699209011148337531334346654674225846340
+		 0.40546510810816438197801311546434913657199042346249419761401432414410
+		 0.47000362924573555365093703114834206470089904881224804044939213700600
+		 0.53062825106217039623154316318876232798710152395697181126390983691471
+		 0.58778666490211900818973114061886376976937976137698118155674077580080
+		 0.64185388617239477599103597720348932963627777267035584250463233544172
+		 0.69314718055994530941723212145817656807550013436025525412068000949339
+		 0.74193734472937731248260652568134122668347379877583766416075658260750
+		 0.78845736036427016946118424473894166029610549966889945330591981765639
+		 0.83290912293510400678876137712583191084127882621166276596530747651542
+		 0.87546873735389993562895014661269120127288947227474223806340646115010
+		 0.91629073187415506518352721176801107145010121990826246779196788198078
+		 0.95551144502743636145272810833913096527966659049168939450639761918928
+		 0.99325177301028339016774425608321290634137018483947537917075509994491
+		 1.02961941718115823992182553167516865818698350967359872066742226795679
+		 1.06471073699242834316528057767754739789341142529397110288834245067520
+		 1.09861228866810969139524523692252570464749055782274945173469433363749
+		 1.13140211149110056191117286985799300284883744185181899572339017150740
+		 1.16315080980568086306816915260651863277639918317250329457007214649939
+		 1.19392246847243455143919736020329079686809592313139365091993414180049
+		 1.22377543162211570564877528464693889606260165831722706538458984640811
+		 1.25276296849536799568812062198500316156158459522160593433871014044418
+		 1.28093384546206431760696326207704033784487989573723643567742078529420
+		 1.30833281965017876035010421634708295629897609853886318761158478022541
+		 1.33500106673234008540826809866166589771177790703061109662531234493511
+		 1.36097655313560074343074122380348010185165701395418359212041194333338
+		 1.38629436111989061883446424291635313615100026872051050824136001898678)))
+
+      (do ((i 0 (+ i 1)))
+	  ((= i 30))
+	(let ((val (log (+ (bignum (/ i 10)) (bignum "1.0")))))
+	  (if (> (magnitude (- val (list-ref logs i))) 1e-36)
+	      (format #t ";(log ~A) -> ~A ~A~%[~A]~%" (+ 1.0 (/ i 10)) val (list-ref logs i) (magnitude (- val (list-ref logs i))))))))))
+
+(test (log) 'error)
+(test (log "hi") 'error)
+(test (log 1.0+23.0i 1.0+23.0i 1.0+23.0i) 'error)
+(test (log "hi" (expt 2 30)) 'error)
+(test (log (expt 2 30) #t) 'error)
+(test (log 0 0) 'error)
+(test (log 3 0) 'error)
+
+(for-each
+ (lambda (arg)
+   (test (log arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(for-each
+ (lambda (arg)
+   (test (log arg +nan.0) 'error)
+   (test (log +nan.0 arg) 'error)
+   (test (log arg +inf.0) 'error)
+   (test (log +inf.0 arg) 'error)
+   (test (log 10 arg) 'error)
+   (test (log arg 10) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; expt
+;;; --------------------------------------------------------------------------------
+
+(num-test (* (/ (expt 2 11) (+ (expt 2 10) 1)) (/ (+ (expt 2 11) 1) (expt 2 10))) 4098/1025)
+(num-test (* (/ (expt 2 21) (+ (expt 2 20) 1)) (/ (+ (expt 2 21) 1) (expt 2 20))) 4194306/1048577)
+(num-test (* (sqrt 2) (sqrt (- 31 (* 4 (sqrt (sqrt 3)) (sqrt (sqrt 5)))))) (+ (* (expt 3 1/4) (expt 5 3/4)) (- (* 2 (sqrt 5))) (* (expt 3 3/4) (expt 5 1/4)) (* 2 (sqrt 3))))
+(num-test (* 1/18014398509481984 1/2) (expt 2 -55))
+(num-test (+ (/ (expt 2 11) (+ (expt 2 10) 1)) (/ (+ (expt 2 11) 1) (expt 2 10))) 4197377/1049600)
+(num-test (+ (/ (expt 2 21) (+ (expt 2 20) 1)) (/ (+ (expt 2 21) 1) (expt 2 20))) 4398049656833/1099512676352)
+(num-test (+ (/ (expt 2 28)) (/ (expt 3 17)) 1/7 1/29) 1247968828249346465/7037157104192323584)
+(num-test (+ (/ (expt 2 28)) (/ (expt 3 17)) 1/7 1/31) 1317300430901043787/7522478283791794176)
+(num-test (+ (/ (expt 2 29)) (/ (expt 3 18)) 1/31) 207994819909949399/6447838528964395008)
+(num-test (+ (/ (expt 2 30)) (/ (expt 3 18)) 1/13) 415989601508942005/5407864572679815168)
+(num-test (+ (/ (expt 2 30)) (/ (expt 3 18)) 1/5) 415989589819643501/2079947912569159680)
+(num-test (+ (/ (expt 2 30)) (/ (expt 3 20))) 4560526225/3743906242624487424)
+(num-test (+ (/ (expt 2 31) (+ (expt 2 20) 1)) (/ (+ (expt 2 31) 1) (expt 2 20))) 4503601775902721/1099512676352)
+(num-test (+ (expt (+ 1/2 (/ (sqrt 69) 18)) 1/3) (/ (expt (+ 1/2 (/ (sqrt 69) 18)) -1/3) 3)) (* (/ (* 2 (sqrt 3)) 3) (cos (/ (acos (/ (* 3 (sqrt 3)) 2)) 3))))
+(num-test (+ (expt 2 5) (expt 298 5) (expt 351 5) (expt 474 5) (expt 500 5)) (expt 575 5))
+(num-test (+ (expt 2230 4) (expt 3196 4) (expt 5620 4) (expt 6995 4)) (expt 7703 4))
+(num-test (+ (expt 415280564497/348671682660 3) (expt 676702467503/348671682660 3)) 9)
+(num-test (+ (expt 510 3) (expt 580 3)) (+ (expt 300 3) (expt 670 3)))
+(num-test (+ 1 (expt 2 54)) 18014398509481985)
+(num-test (+ 10000000000000000 1) 10000000000000001)
+(num-test (+ 2 (expt 276694819753963/226588 1/158)) pi) ; 23 digits
+(num-test (- (/ (expt 2 11) (+ (expt 2 10) 1)) (/ (+ (expt 2 11) 1) (expt 2 10))) -3073/1049600)
+(num-test (- (/ (expt 2 21) (+ (expt 2 20) 1)) (/ (+ (expt 2 21) 1) (expt 2 20))) -3145729/1099512676352)
+(num-test (- (/ (expt 2 31) (+ (expt 2 20) 1)) (/ (+ (expt 2 31) 1) (expt 2 20))) -2148532225/1099512676352)
+(num-test (- (expt 2 54) 18014398509481983) 1)
+(num-test (- (expt 2 54) 18014398509481984) 0)
+(num-test (- 10000000000000000 9999999999999999) 1)
+(num-test (/ (/ (expt 2 11) (+ (expt 2 10) 1)) (/ (+ (expt 2 11) 1) (expt 2 10))) 2097152/2100225)
+(num-test (/ (/ (expt 2 21) (+ (expt 2 20) 1)) (/ (+ (expt 2 21) 1) (expt 2 20))) 2199023255552/2199026401281)
+(num-test (/ (/ (expt 2 31) (+ (expt 2 20) 1)) (/ (+ (expt 2 31) 1) (expt 2 20))) 2251799813685248/2251801962217473)
+(num-test (/ (expt 10 -20) (expt 10 -20)) 1)
+(num-test (/ (expt 10 -200) (expt 10 -200)) 1)
+(num-test (/ (expt 2 -53) 2) (expt 2 -54))
+(num-test (/ (expt 2.3 50) (expt 2.3 49)) 2.3)
+(num-test (/ (sqrt (* 7 (- 2 (expt 2 1/7)))) (expt 2 1/14)) (+ -1 (* 2 (expt 2 1/7)) (expt 2 3/7) (expt 2 5/7) (- (expt 2 6/7))))
+(num-test (do ((i 1 (+ i 1)) (sum 0.0 (+ sum (expt (sin (/ (* pi i) (* 2 10))) 4)))) ((= i 11) sum)) 4.25)
+(num-test (expt (+ (cos (/ (* 2 pi) 20)) (* 0+i (sin (/ (* 2 pi) 20)))) 20) 1.0)
+(num-test (expt (+ pi 20) 0+i) -0.99999999924368-3.8892669402222e-05i)
+(num-test (expt (- (expt 2 1/3) 1) 1/3) (+ (expt 1/9 1/3) (- (expt 2/9 1/3)) (expt 4/9 1/3)))
+(num-test (expt (- (expt 2 1/3) 1) 1/3) (+ (expt 1/9 1/3) (- (expt 2/9 1/3)) (expt 4/9 1/3)))
+(num-test (expt (- (expt 3 3/5) (expt 2 1/5)) 1/3) (/ (+ (- (* (expt 2 1/5) (expt 3 3/5))) (* (expt 2 3/5) (expt 3 2/5)) (expt 3 1/5) (expt 2 2/5)) (expt 5 2/3)))
+(num-test (expt (/ (+ 1 (sqrt 5)) 2) 5) (/ (+ 11 (* 5 (sqrt 5))) 2))
+(num-test (expt (/ (log (+ (expt 640320 3) 744)) pi) 2) 163.0) ; rest is 2.32167e-29
+(num-test (expt (expt -1 -1/2) -2) -1)
+(num-test (expt (expt -1 1/123) 123) -1)
+(num-test (expt (expt -1/2 -1/2) -2) -1/2)
+(num-test (expt (expt -1/2 1/2) 2) -1/2)
+(num-test (expt (expt -1/3 -1/2) -2) -1/3)
+(num-test (expt (expt -1/3 1/2) 2) -1/3)
+(num-test (expt (expt -1/3 1/3) 3) -1/3)
+(num-test (expt (expt -2 -1/2) -2) -2)
+(num-test (expt (expt -2 1/2) 2) -2)
+(num-test (expt (expt 0+i -1/2) -2) 0+i)
+(num-test (expt (expt 0+i -1/3) -3) 0+i)
+(num-test (expt (expt 0+i -1/4) -4) 0+i)
+(num-test (expt (expt 0+i 0.5) 2) 0+i)
+(num-test (expt (expt 0+i 1/10) 10) 0+i)
+(num-test (expt (expt 0+i 1/3) 3) 0+i)
+(num-test (expt (expt 0+i 1/4) 4) 0+i)
+(num-test (expt (expt 1 -1/2) -2) 1)
+(num-test (expt (expt 1 1/123) 123) 1)
+(num-test (expt (expt 1+i 1/2) 2) 1+i)
+(num-test (expt (expt 1+i 1/3) 3) 1+i)
+(num-test (expt (expt 1+i 1/4) 4) 1+i)
+(num-test (expt (expt 1-i 1/2) 2) 1-i)
+(num-test (expt (expt 1-i 1/3) 3) 1-i)
+(num-test (expt (expt 1-i 1/4) 4) 1-i)
+(num-test (expt (expt 1/2 -1/2) -2) 1/2)
+(num-test (expt (expt 2 0+i) (/ 0+i)) 2)
+(num-test (expt (expt 2 1/10) 10) 2)
+(num-test (expt (expt 2 1/30) 30) 2)
+(num-test (expt (expt 2 30) 1/30) 2)
+(num-test (expt (expt 2 50) 1/50) 2)
+(num-test (expt (expt 20 10) 1/10) 20)
+(num-test (expt (expt 40 10) 1/10) 40)
+(num-test (expt -0 -0) 1)
+(num-test (expt -0.0 -0.0) 0.0)
+(num-test (expt -0.0 0) 0.0)
+(num-test (expt -0.0 0-i) 0.0)
+(num-test (expt -0.0 0.00000001) 0.0)
+(num-test (expt -0.0 1.0) 0.0)
+(num-test (expt -0.0 1234.0) 0.0)
+(num-test (expt -0.0 pi) 0.0)
+(num-test (expt -0.00000001 -0.0) 1.0)
+(num-test (expt -0.00000001 -0.00000001) 1.00000018420682-0.00000003141593i)
+(num-test (expt -0.00000001 -1) -100000000.00000017881393-0.00000001224606i)
+(num-test (expt -0.00000001 -1.0) -100000000.00000017881393-0.00000001224606i)
+(num-test (expt -0.00000001 0) 1.0)
+(num-test (expt -0.00000001 0.0) 1.0)
+(num-test (expt -0.00000001 0.00000001) 0.99999981579321+0.00000003141592i)
+(num-test (expt -0.00000001 1) -0.00000001+0.0i)
+(num-test (expt -0.00000001 1.0) -0.00000001+0.0i)
+(num-test (expt -0.00000001 10) 1e-80)
+(num-test (expt -0.00000001 1234) 0.0)
+(num-test (expt -0.00000001 1234.0) 0.0)
+(num-test (expt -0.00000001 2) 1e-16)
+(num-test (expt -0.00000001 3) -1e-24)
+(num-test (expt -0.00000001 500029) 0.0)
+(num-test (expt -0.00000001 pi) -6.6495946361558e-26-3.1697962381573e-26i)
+(num-test (expt -0.00000001+0.00000001i 1.0-0.0i) -0.00000001+0.00000001i)
+(num-test (expt -0.00000001+0.0i 0.00000001-0.00000001i) 0.99999984720911+0.00000021562270i)
+(num-test (expt -0.00000001-0.00000001i -1.0-0.0i) -50000000.00000003725290+50000000.00000004470348i)
+(num-test (expt -0.00000001-0.0i -0.00000001-0.00000001i) 1.00000021562275+0.00000015279091i)
+(num-test (expt -1 (+ 1 (expt 2 32))) -1)
+(num-test (expt -1 (- (expt 2 32))) 1)
+(num-test (expt -1 (expt 2 32)) 1)
+(num-test (expt -1 -0.0) 1.0)
+(num-test (expt -1 -100) 1)
+(num-test (expt -1 -1000) 1)
+(num-test (expt -1 -1001) -1)
+(num-test (expt -1 -101) -1)
+(num-test (expt -1 -255) -1)
+(num-test (expt -1 -256) 1)
+(num-test (expt -1 0) 1)
+(num-test (expt -1 0+i) 4.321391826377224977441773717172801127572810981063308298071968740105076575701806E-2)
+(num-test (expt -1 0-i) 2.314069263277926900572908636794854738026610624260021199344504640952434235069032E1)
+(num-test (expt -1 0.0) 1.0)
+(num-test (expt -1 0.00000001) 1.0+0.00000003141593i)
+(num-test (expt -1 1) -1)
+(num-test (expt -1 1.0) -1.0+0.0i)
+(num-test (expt -1 1/2) 0+i)
+(num-test (expt -1 10) 1)
+(num-test (expt -1 100) 1)
+(num-test (expt -1 1000) 1)
+(num-test (expt -1 1001) -1)
+(num-test (expt -1 101) -1)
+(num-test (expt -1 1234) 1)
+(num-test (expt -1 1234.0) 1.0)
+(num-test (expt -1 1234000000.0) 1.0)
+(num-test (expt -1 2) 1)
+(num-test (expt -1 255) -1)
+(num-test (expt -1 256) 1)
+(num-test (expt -1 3) -1)
+(num-test (expt -1 500029) -1)
+(num-test (expt -1 pi) -0.90268536193307-0.43030121700009i)
+(num-test (expt -1.0 -0.0) 1.0)
+(num-test (expt -1.0 -0.00000001) 1.0-0.00000003141593i)
+(num-test (expt -1.0 -1) -1.0-0.0i)
+(num-test (expt -1.0 -1.0) -1.0-0.0i)
+(num-test (expt -1.0 -10) 1.0+0.0i)
+(num-test (expt -1.0 -1234) 1.0)
+(num-test (expt -1.0 -1234.0) 1.0)
+(num-test (expt -1.0 -1234000000) 1.0)
+(num-test (expt -1.0 -1234000000.0) 1.0)
+(num-test (expt -1.0 -2) 1.0+0.0i)
+(num-test (expt -1.0 -3) -1.0-0.0i)
+(num-test (expt -1.0 -3.14159265358979) -0.90268536193307+0.43030121700009i)
+(num-test (expt -1.0 -500029) -1.0)
+(num-test (expt -1.0 0) 1.0)
+(num-test (expt -1.0 0.0) 1.0)
+(num-test (expt -1.0 0.00000001) 1.0+0.00000003141593i)
+(num-test (expt -1.0 1) -1.0+0.0i)
+(num-test (expt -1.0 1.0) -1.0+0.0i)
+(num-test (expt -1.0 1/2) 0+i)
+(num-test (expt -1.0 10) 1.0-0.0i)
+(num-test (expt -1.0 1234) 1.0)
+(num-test (expt -1.0 1234.0) 1.0)
+(num-test (expt -1.0 1234000000) 1.0)
+(num-test (expt -1.0 1234000000.0) 1.0)
+(num-test (expt -1.0 2) 1.0-0.0i)
+(num-test (expt -1.0 3) -1.0+0.0i)
+(num-test (expt -1.0 500029) -1.0)
+(num-test (expt -1.0 pi) -0.90268536193307-0.43030121700009i)
+(num-test (expt -1.0+0.00000001i 3.14159265358979-0.00000001i) -0.90268540381008-0.43030120215971i)
+(num-test (expt -1.0-0.00000001i -3.14159265358979-0.00000001i) -0.90268534709269-0.43030117512308i)
+(num-test (expt -1.0e+00+0.0e+00i -1.0e+00+0.0e+00i) -1e0+0.0i)
+(num-test (expt -1.0e+00+0.0e+00i 0.0e+00+0.0e+00i) 1e0+0.0i)
+(num-test (expt -1.0e+00+0.0e+00i 0.0e+00+1.0e+00i) 4.3213918263772249774e-2+0.0i)
+(num-test (expt -1.0e+00+0.0e+00i 0.0e+00-1.0e+00i) 2.3140692632779269006e1+0.0i)
+(num-test (expt -1.0e+00+0.0e+00i 1.0e+00+0.0e+00i) -1e0+0.0i)
+(num-test (expt -1.0e+00+0.0e+00i 5.0e-01+1.00000000000000005551e-01i) 0+7.3040269104864559813e-1i)
+(num-test (expt -1.0e+00+0.0e+00i 5.0e-01-1.00000000000000005551e-01i) 0+1.3691077706248469087e0i)
+(if (not (provided? 'freebsd)) (num-test (expt -1/2 (- (real-part (log 0)))) (expt -0.5 (- (real-part (log 0))))))
+(num-test (expt -1/3 10/500029) 0.99997802729625+0.00006282682861i)
+(num-test (expt -1/8 -3) -512)
+(num-test (expt -10 3) -1000)
+(num-test (expt -10 pi) -1250.63060831127905-596.16328730697728i)
+(num-test (expt -10/1234000000 1/500029) 0.99996274095212+0.00000628258681i)
+(num-test (expt -10/500029 2/1234000000) 0.99999998246380+0.00000000509172i)
+(num-test (expt -1234 0) 1)
+(num-test (expt -1234 0.0) 1.0)
+(num-test (expt -1234 0.00000001) 1.00000007118016+0.00000003141593i)
+(num-test (expt -1234 1) -1234)
+(num-test (expt -1234 1.0) -1234.00000000000045+0.00000000000015i)
+(num-test (expt -1234 2) 1522756)
+(num-test (expt -1234.0 -0.0) 1.0)
+(num-test (expt -1234.0 -0.00000001) 0.99999992881984-0.00000003141592i)
+(num-test (expt -1234.0 -1) -0.00081037277147-0.0i)
+(num-test (expt -1234.0 -1.0) -0.00081037277147-0.0i)
+(num-test (expt -1234.0 -2) 0.00000065670403+0.0i)
+(num-test (expt -1234.0 -3) -0.00000000053218-0.0i)
+(num-test (expt -1234.0 -3.14159265358979) -0.00000000017534+0.00000000008358i)
+(num-test (expt -1234.0 0) 1.0)
+(num-test (expt -1234.0 0.0) 1.0)
+(num-test (expt -1234.0 0.00000001) 1.00000007118016+0.00000003141593i)
+(num-test (expt -1234.0 1) -1234.00000000000045+0.00000000000015i)
+(num-test (expt -1234.0 1.0) -1234.00000000000045+0.00000000000015i)
+(num-test (expt -1234.0 2) 1522756.00000000093132-0.00000000037296i)
+(num-test (expt -1234.0+1234.0i 3.14159265358979-0.0i) 6676669154.05054950714111+13759228759.84499740600586i)
+(num-test (expt -1234.0-1234.0i -3.14159265358979-0.0i) 2.854567008891443E-11+5.882669873167984E-11i)
+(num-test (expt -1234/10 0/1) 1)
+(num-test (expt -1234/500029 3/500029) 0.99996397612963+0.00001884778372i)
+(num-test (expt -1234000000 0) 1)
+(num-test (expt -1234000000 0.0) 1.0)
+(num-test (expt -1234000000 0.00000001) 1.00000020933529+0.00000003141593i)
+(num-test (expt -1234000000.0 -0.0) 1.0)
+(num-test (expt -1234000000.0 -0.00000001) 0.99999979066475-0.00000003141592i)
+(num-test (expt -1234000000.0 -1) -0.00000000081037-0.0i)
+(num-test (expt -1234000000.0 -1.0) -0.00000000081037-0.0i)
+(num-test (expt -1234000000.0 0) 1.0)
+(num-test (expt -1234000000.0 0.0) 1.0)
+(num-test (expt -1234000000.0 0.00000001) 1.00000020933529+0.00000003141593i)
+(num-test (expt -1234000000/10 1/2) 0.00000000000068+11108.55526159905094i)
+(num-test (expt -1234000000/3 0/3) 1)
+(num-test (expt -2 0) 1)
+(num-test (expt -2 0.0) 1.0)
+(num-test (expt -2 0.00000001) 1.00000000693147+0.00000003141593i)
+(num-test (expt -2 1) -2)
+(num-test (expt -2 1.0) -2.0+0.0i)
+(num-test (expt -2 10) 1024)
+(num-test (expt -2 2) 4)
+(num-test (expt -2 3) -8)
+(num-test (expt -2 pi) -7.96617830388569-3.79739869898975i)
+(num-test (expt -2/1 3/1) -8)
+(num-test (expt -2/1234 500029/1234000000) 0.99739915734849+0.00126969420446i)
+(num-test (expt -2/500029 0/10) 1)
+(num-test (expt -256 0) 1)
+(num-test (expt -256 1) -256)
+(num-test (expt -2742638075.5 1/2) (sqrt -2742638075.5))
+(num-test (expt -2742638075.5 2) (* -2742638075.5 -2742638075.5)) ; from bug-guile
+(num-test (expt -3 0) 1)
+(num-test (expt -3 0.0) 1.0)
+(num-test (expt -3 0.00000001) 1.00000001098612+0.00000003141593i)
+(num-test (expt -3 1) -3)
+(num-test (expt -3 1.0) -3.0+0.0i)
+(num-test (expt -3 10) 59049)
+(num-test (expt -3 2) 9)
+(num-test (expt -3 3) -27)
+(num-test (expt -3 pi) -28.47456044077623-13.57354237468751i)
+(num-test (expt -3.14159265358979 -0.0) 1.0)
+(num-test (expt -3.14159265358979 -0.00000001) 0.99999998855270-0.00000003141593i)
+(num-test (expt -3.14159265358979 -1) -0.31830988618379-0.0i)
+(num-test (expt -3.14159265358979 -1.0) -0.31830988618379-0.0i)
+(num-test (expt -3.14159265358979 -10) 0.00001067827923+0.0i)
+(num-test (expt -3.14159265358979 -2) 0.10132118364234+0.0i)
+(num-test (expt -3.14159265358979 -3) -0.03225153443320-0.0i)
+(num-test (expt -3.14159265358979 -3.14159265358979) -0.02475677172327+0.01180130912803i)
+(num-test (expt -3.14159265358979 0) 1.0)
+(num-test (expt -3.14159265358979 0.0) 1.0)
+(num-test (expt -3.14159265358979 0.00000001) 1.00000001144730+0.00000003141593i)
+(num-test (expt -3.14159265358979 1) -3.14159265358979+0.0i)
+(num-test (expt -3.14159265358979 1.0) -3.14159265358979+0.0i)
+(num-test (expt -3.14159265358979 10) 93648.04747608296748)
+(num-test (expt -3.14159265358979 2) 9.86960440108936-0.0i)
+(num-test (expt -3.14159265358979 3) -31.00627668029983)
+(num-test (expt -3.14159265358979 pi) -32.91385774189388-15.68971165343314i)
+(num-test (expt -3.14159265358979-3.14159265358979i -1234000000.0-0.0i) 0.0)
+(num-test (expt -3/1 10/2) -243)
+(num-test (expt -3/1234000000 0/1234000000) 1)
+(num-test (expt -3/500029 1/1234) 0.99030033992383+0.00252117260474i)
+(num-test (expt -500029 0) 1)
+(num-test (expt -500029 0.0) 1.0)
+(num-test (expt -500029 0.00000001) 1.00000013122422+0.00000003141593i)
+(num-test (expt -500029 1) -500029)
+(num-test (expt -500029 1.0) -500029.00000000040745+0.00000000006123i)
+(num-test (expt -500029/10 2/3) -678.63064326537926+1175.42275370878747i)
+(num-test (expt -500029/1234 3/2) -0.00000000000150-8156.80442672750178i)
+(num-test (expt -500029/1234000000 10/1) 0.0)
+(num-test (expt -500029/2 0/1234) 1)
+(num-test (expt -500029/3 1/10) 3.16514579334680+1.02841820970710i)
+(num-test (expt .1 -1) 10.0)
+(num-test (expt .1 -2) 100.0)
+(num-test (expt 0 (expt 2 31)) 0)
+(num-test (expt 0 (expt 2 32)) 0)
+(num-test (expt 0 (expt 2 33)) 0)
+(num-test (expt 0 (expt 2 63)) 0)
+(num-test (expt 0 (expt 2 64)) 0)
+(num-test (expt 0 (expt 2 65)) 0)
+(num-test (expt 0 -0.0) 0.0)
+(num-test (expt 0 -0/4) 1)
+(num-test (expt 0 0) 1)
+(num-test (expt 0 -0) 1)
+(num-test (expt 0 0.0) 0.0)
+(num-test (expt 0 0.00000001) 0.0)
+(num-test (expt 0 1) 0)
+(num-test (expt 0 1.0) 0.0)
+(num-test (expt 0 1.0+i) 0.0) ; ??
+(num-test (expt 0 1/10) 0)
+(num-test (expt 0 1/4) 0)
+(num-test (expt 0 10) 0)
+(num-test (expt 0 100) 0)
+(num-test (expt 0 1000) 0)
+(num-test (expt 0 1001) 0)
+(num-test (expt 0 101) 0)
+(num-test (expt 0 1234) 0)
+(num-test (expt 0 1234.0) 0.0)
+(num-test (expt 0 1234000000) 0)
+(num-test (expt 0 1234000000.0) 0.0)
+(num-test (expt 0 2) 0)
+(num-test (expt 0 256) 0)
+(num-test (expt 0 3) 0)
+(num-test (expt 0 500029) 0)
+(num-test (expt 0 pi) 0.0)
+(num-test (expt 0+1e-15i 0-1e-15i) 1.0000000000000015707963267943015114538E0+3.453877639491074211979699606989171173842E-14i)
+(num-test (expt 0+1i 2) -1)
+(num-test (expt 0+i 0+i) 2.078795763507619085469556198349787700342E-1)
+(num-test (expt 0+i 0+i) (exp (/ pi -2)))
+(num-test (expt 0+i 0-i) 4.810477380965351655473035666703833126401E0)
+(num-test (expt 0+i 1/2) (complex (/ (sqrt 2)) (/ (sqrt 2))))
+(num-test (expt 0+i 2) -1.0)
+(num-test (expt 0-i 1+i) 0.0-4.810477380965351655473035666703833126401E0i)
+(num-test (expt 0-i 1-i) 0.0-2.078795763507619085469556198349787700342E-1i)
+(num-test (expt 0-i 2) -1)
+(num-test (expt 0.0 (expt 2 31)) 0.0)
+(num-test (expt 0.0 (expt 2 32)) 0.0)
+(num-test (expt 0.0 (expt 2 33)) 0.0)
+(num-test (expt 0.0 (expt 2 63)) 0.0)
+(num-test (expt 0.0 (expt 2 64)) 0.0)
+(num-test (expt 0.0 (expt 2 65)) 0.0)
+(num-test (expt 0.0 0) 0.0)
+(num-test (expt 0.0 0+i) 0.0) ; why would they be radically different?
+(num-test (expt 0.0 0-i) 0.0)
+(num-test (expt 0.0 0.0) 0.0)
+(num-test (expt 0.0 0.00000001) 0.0)
+(num-test (expt 0.0 1) 0.0)
+(num-test (expt 0.0 1.0) 0.0)
+(num-test (expt 0.0 1234.0) 0.0)
+(num-test (expt 0.0 1234000000.0) 0.0)
+(num-test (expt 0.0 1e-15+i) 0.0)
+(num-test (expt 0.0 1e-15-i) 0.0)
+(num-test (expt 0.0 pi) 0.0)
+(num-test (expt 0.0-1234000000.0i -1234000000.0+0.00000001i) 0.0)
+(num-test (expt 0.00000001 -0.0) 1.0)
+(num-test (expt 0.00000001 -0.00000001) 1.00000018420682)
+(num-test (expt 0.00000001 -1) 100000000.00000017881393)
+(num-test (expt 0.00000001 -1.0) 100000000.00000017881393)
+(num-test (expt 0.00000001 0) 1.0)
+(num-test (expt 0.00000001 0.0) 1.0)
+(num-test (expt 0.00000001 0.00000001) 0.99999981579321)
+(num-test (expt 0.00000001 1) 0.00000001)
+(num-test (expt 0.00000001 1.0) 0.00000001)
+(num-test (expt 0.00000001 10) 0.0)
+(num-test (expt 0.00000001 1234) 0.0)
+(num-test (expt 0.00000001 1234.0) 0.0)
+(num-test (expt 0.00000001 1234000000) 0.0)
+(num-test (expt 0.00000001 1234000000.0) 0.0)
+(num-test (expt 0.00000001 2) 0.0)
+(num-test (expt 0.00000001 3) 0.0)
+(num-test (expt 0.00000001 500029) 0.0)
+(num-test (expt 0.00000001 pi) 0.0)
+(num-test (expt 0.00000001+0.00000001i 1.0+0.0i) 0.00000001+0.00000001i)
+(num-test (expt 0.00000001+0.0i 0.00000001+0.00000001i) 0.99999981579319-0.00000018420677i)
+(num-test (expt 0.00000001-0.00000001i -1.0+0.0i) 50000000.00000004470348+50000000.00000003725290i)
+(num-test (expt 0.00000001-0.0i -0.00000001+0.00000001i) 1.00000018420681-0.00000018420684i)
+(num-test (expt 0.0e+00+1.0e+00i -1.0e+00+0.0e+00i) 0-1i)
+(num-test (expt 0.0e+00+1.0e+00i 0.0e+00+0.0e+00i) 1e0+0.0i)
+(num-test (expt 0.0e+00+1.0e+00i 0.0e+00+1.0e+00i) 2.0787957635076190855e-1+0.0i)
+(num-test (expt 0.0e+00+1.0e+00i 0.0e+00-1.0e+00i) 4.8104773809653516555e0+0.0i)
+(num-test (expt 0.0e+00+1.0e+00i 1.0e+00+0.0e+00i) 0+1i)
+(num-test (expt 0.0e+00+1.0e+00i 5.0e-01+1.00000000000000005551e-01i) 6.0431891044739184057e-1+6.0431891044739184057e-1i)
+(num-test (expt 0.0e+00+1.0e+00i 5.0e-01-1.00000000000000005551e-01i) 8.2737771622906514822e-1+8.2737771622906514822e-1i)
+(num-test (expt 0.0e+00-1.0e+00i -1.0e+00+0.0e+00i) 0+1i)
+(num-test (expt 0.0e+00-1.0e+00i 0.0e+00+0.0e+00i) 1e0+0.0i)
+(num-test (expt 0.0e+00-1.0e+00i 0.0e+00+1.0e+00i) 4.8104773809653516555e0+0.0i)
+(num-test (expt 0.0e+00-1.0e+00i 0.0e+00-1.0e+00i) 2.0787957635076190855e-1+0.0i)
+(num-test (expt 0.0e+00-1.0e+00i 1.0e+00+0.0e+00i) 0-1i)
+(num-test (expt 0.0e+00-1.0e+00i 5.0e-01+1.00000000000000005551e-01i) 8.2737771622906514822e-1-8.2737771622906514822e-1i)
+(num-test (expt 0.0e+00-1.0e+00i 5.0e-01-1.00000000000000005551e-01i) 6.0431891044739184057e-1-6.0431891044739184057e-1i)
+(num-test (expt 0/10 10/1234) 0.0)
+(num-test (expt 0/11 000) 1)
+(num-test (expt 0/1234 1234/10) 0.0)
+(num-test (expt 0/2 2/500029) 0.0)
+(num-test (expt 0/3 3/1234000000) 0.0)
+(num-test (expt 0/500029 500029/2) 0.0)
+(num-test (expt -0.0 most-positive-fixnum) 0.0)
+(num-test (expt 0 most-positive-fixnum) 0)
+(test (expt 0 (- (expt 2 32))) 'error)
+(test (expt 0 (- (expt 2.0 60))) 'error)
+(test (expt 0 (complex (- (expt 2 60)) 1.0)) 'error)
+(test (expt 0 -255) 'error)
+(test (expt 0 -1) 'error)
+(test (expt 0 -1.0) 'error)
+(test (expt 0 -1/2) 'error)
+(num-test (expt 0 1/2) 0) ; or 0.0
+(num-test (expt 0 -0+i) 0.0)
+(num-test (expt 0 -0-i) 0.0)
+(test (expt 0 -1+i) 'error)
+(test (expt 0 most-negative-fixnum) 'error)
+(test (expt 0.0 most-negative-fixnum) 'error)
+(test (expt 0.0 -255) 'error)
+(test (expt 0.0 -1) 'error)
+(test (expt 0.0 -1.0) 'error)
+(test (expt 0.0 -1/2) 'error)
+(num-test (expt 0.0 1/2) 0.0)
+(num-test (expt 0.0 -0+i) 0.0)
+(num-test (expt 0.0 -0-i) 0.0)
+(test (expt 0.0 -1+i) 'error)
+(test (expt 0.0 most-negative-fixnum) 'error)
+(test (expt 0.0 most-negative-fixnum) 'error)
+(num-test (expt 1 1/2) 1)
+(num-test (expt 1 (- (expt 2 32))) 1)
+(num-test (expt 1 (expt 2 32)) 1)
+(num-test (expt 1 (real-part (log 0))) (expt 1.0 (real-part (log 0))))
+(num-test (expt 1 -0) 1)
+(num-test (expt 1 -0.0) 1.0)
+(num-test (expt 1 -0.00000001) 1.0)
+(num-test (expt 1 -1) 1)
+(num-test (expt 1 -1.0) 1.0)
+(num-test (expt 1 -10) 1)
+(num-test (expt 1 -100) 1)
+(num-test (expt 1 -1000) 1)
+(num-test (expt 1 -1001) 1)
+(num-test (expt 1 -101) 1)
+(num-test (expt 1 -1234) 1)
+(num-test (expt 1 -1234.0) 1.0)
+(num-test (expt 1 -1234000000) 1)
+(num-test (expt 1 -1234000000.0) 1.0)
+(num-test (expt 1 -1e-15) 1)
+(num-test (expt 1 -2) 1)
+(num-test (expt 1 -3) 1)
+(num-test (expt 1 -3.14159265358979) 1.0)
+(num-test (expt 1 -500029) 1)
+(num-test (expt 1 0) 1)
+(num-test (expt 1 0+i) 1)
+(num-test (expt 1 0-i) 1)
+(num-test (expt 1 0.0) 1.0)
+(num-test (expt 1 0.00000001) 1.0)
+(num-test (expt 1 1) 1)
+(num-test (expt 1 1+i) 1)
+(num-test (expt 1 1.0) 1.0)
+(num-test (expt 1 1/10) 1)
+(num-test (expt 1 10) 1)
+(num-test (expt 1 100) 1)
+(num-test (expt 1 1000) 1)
+(num-test (expt 1 1001) 1)
+(num-test (expt 1 101) 1)
+(num-test (expt 1 1234) 1)
+(num-test (expt 1 1234.0) 1.0)
+(num-test (expt 1 1234000000) 1)
+(num-test (expt 1 1234000000.0) 1.0)
+(num-test (expt 1 2) 1)
+(num-test (expt 1 3) 1)
+(num-test (expt 1 500029) 1)
+(num-test (expt 1 most-negative-fixnum) 1)
+(num-test (expt 1 pi) 1.0)
+(num-test (expt 1+i 1) 1+i)
+(num-test (expt 1+i 1.0) 1.0+i)
+(num-test (expt 1.0 -0.0) 1.0)
+(num-test (expt 1.0 -0.00000001) 1.0)
+(num-test (expt 1.0 -1) 1.0)
+(num-test (expt 1.0 -1.0) 1.0)
+(num-test (expt 1.0 -1/2) 1.0)
+(num-test (expt 1.0 -10) 1.0)
+(num-test (expt 1.0 -1234) 1.0)
+(num-test (expt 1.0 -1234.0) 1.0)
+(num-test (expt 1.0 -1234000000) 1.0)
+(num-test (expt 1.0 -1234000000.0) 1.0)
+(num-test (expt 1.0 -2) 1.0)
+(num-test (expt 1.0 -3) 1.0)
+(num-test (expt 1.0 -3.14159265358979) 1.0)
+(num-test (expt 1.0 -500029) 1.0)
+(num-test (expt 1.0 0) 1.0)
+(num-test (expt 1.0 0.0) 1.0)
+(num-test (expt 1.0 0.00000001) 1.0)
+(num-test (expt 1.0 1) 1.0)
+(num-test (expt 1.0 1.0) 1.0)
+(num-test (expt 1.0 1/2) 1.0)
+(num-test (expt 1.0 10) 1.0)
+(num-test (expt 1.0 1234) 1.0)
+(num-test (expt 1.0 1234.0) 1.0)
+(num-test (expt 1.0 1234000000) 1.0)
+(num-test (expt 1.0 1234000000.0) 1.0)
+(num-test (expt 1.0 2) 1.0)
+(num-test (expt 1.0 3) 1.0)
+(num-test (expt 1.0 500029) 1.0)
+(num-test (expt 1.0 pi) 1.0)
+(num-test (expt 1.0+0.00000001i 3.14159265358979+0.00000001i) 1.0+0.00000003141593i)
+(num-test (expt 1.0-0.00000001i -3.14159265358979+0.00000001i) 1.0+0.00000003141593i)
+(num-test (expt 1.0e+00+0.0e+00i -1.0e+00+0.0e+00i) 1e0+0.0i)
+(num-test (expt 1.0e+00+0.0e+00i 0.0e+00+1.0e+00i) 1e0+0.0i)
+(num-test (expt 1.0e+00+0.0e+00i 0.0e+00-1.0e+00i) 1e0+0.0i)
+(num-test (expt 1.0e+00+0.0e+00i 1.0e+00+0.0e+00i) 1e0+0.0i)
+(num-test (expt 1.0e+00+0.0e+00i 5.0e-01+1.00000000000000005551e-01i) 1e0+0.0i)
+(num-test (expt 1.0e+00+0.0e+00i 5.0e-01-1.00000000000000005551e-01i) 1e0+0.0i)
+(num-test (expt 1/1234000000 500029/10) 0.0)
+(num-test (expt 1/2 (- (real-part (log 0)))) (expt 0.5 (- (real-part (log 0)))))
+(num-test (expt 1/2 -10) 1024)
+(num-test (expt 1/2 -3) 8)
+(num-test (expt 1/2 1/3) 7.937005259840997373758528196361541301963E-1)
+(num-test (expt 1/2 10) 1/1024)
+(num-test (expt 1/2 3) 1/8)
+(num-test (expt 1/3 10/500029) 0.99997802926990)
+(num-test (expt 1/4 -2) 16)
+(num-test (expt 1/4 1/2) 1/2)
+(num-test (expt 1/4 1/3) 6.299605249474365823836053036391141752849E-1)
+(num-test (expt 1/64 -1/2) 8)
+(num-test (expt 1/64 -1/3) 4)
+(num-test (expt 1/64 -2/3) 16)
+(num-test (expt 1/64 -3/2) 512)
+(num-test (expt 1/64 1/2) 1/8)
+(num-test (expt 1/64 1/3) 1/4)
+(num-test (expt 1/64 2/3) 1/16)
+(num-test (expt 1/64 3/2) 1/512)
+(num-test (expt 1/9223372036854775807 -1) 9223372036854775807)
+(num-test (expt 1/9223372036854775807 1) 1/9223372036854775807)
+(num-test (expt 9223372036854775807 -1) 1/9223372036854775807)
+(num-test (expt 10 -0.0) 1.0)
+(num-test (expt 10 -0.00000001) 0.99999997697415)
+(num-test (expt 10 -1) 1/10)
+(num-test (expt 10 -1.0) 0.1)
+(num-test (expt 10 -10) 1/10000000000)
+(num-test (expt 10 -2) 1/100)
+(num-test (expt 10 -3) 1/1000)
+(num-test (expt 10 -3.14159265358979) 0.00072178415907)
+(num-test (expt 10 0) 1)
+(num-test (expt 10 0.0) 1.0)
+(num-test (expt 10 0.00000001) 1.00000002302585)
+(num-test (expt 10 1) 10)
+(num-test (expt 10 1.0) 10.0)
+(num-test (expt 10 10) 10000000000)
+(num-test (expt 10 2) 100)
+(num-test (expt 10 3) 1000)
+(num-test (expt 10 pi) 1385.45573136701182)
+(num-test (expt 10/1234000000 1/500029) 0.99996274097186)
+(num-test (expt 10/500029 2/1234000000) 0.99999998246380)
+(num-test (expt 10000000000 1/10) 10)
+(num-test (expt 1024 1/10) 2)
+(num-test (expt 1048576 1/10) 4)
+(num-test (expt 1073741824 1/10) 8)
+(num-test (expt 11 10) 25937424601)
+(num-test (expt 1234 -0.0) 1.0)
+(num-test (expt 1234 -0.00000001) 0.99999992881984)
+(num-test (expt 1234 -1) 1/1234)
+(num-test (expt 1234 -1.0) 0.00081037277147)
+(num-test (expt 1234 -2) 1/1522756)
+(num-test (expt 1234 -3) 1/1879080904)
+(num-test (expt 1234 -3.14159265358979) 0.00000000019424)
+(num-test (expt 1234 0) 1)
+(num-test (expt 1234 0.0) 1.0)
+(num-test (expt 1234 0.00000001) 1.00000007118016)
+(num-test (expt 1234 1) 1234)
+(num-test (expt 1234 1.0) 1234.00000000000045)
+(num-test (expt 1234 2) 1522756)
+(num-test (expt 1234.0 -0.0) 1.0)
+(num-test (expt 1234.0 -0.00000001) 0.99999992881984)
+(num-test (expt 1234.0 -1) 0.00081037277147)
+(num-test (expt 1234.0 -1.0) 0.00081037277147)
+(num-test (expt 1234.0 -2) 0.00000065670403)
+(num-test (expt 1234.0 -3) 0.00000000053218)
+(num-test (expt 1234.0 -3.14159265358979) 0.00000000019424)
+(num-test (expt 1234.0 0) 1.0)
+(num-test (expt 1234.0 0.0) 1.0)
+(num-test (expt 1234.0 0.00000001) 1.00000007118016)
+(num-test (expt 1234.0 1) 1234.00000000000045)
+(num-test (expt 1234.0 1.0) 1234.00000000000045)
+(num-test (expt 1234.0 2) 1522756.00000000093132)
+(num-test (expt 1234.0+1234.0i 3.14159265358979+0.0i) -11947544392.17545890808105+9547275530.50568199157715i)
+(num-test (expt 1234.0-1234.0i -3.14159265358979+0.0i) -5.108095859217296E-11+4.081876325659167E-11i)
+(num-test (expt 1234/10 0/1) 1)
+(num-test (expt 1234/500029 3/500029) 0.99996397630725)
+(num-test (expt 1234000000 -0.0) 1.0)
+(num-test (expt 1234000000 -0.00000001) 0.99999979066475)
+(num-test (expt 1234000000 -1) 1/1234000000)
+(num-test (expt 1234000000 -1.0) 0.00000000081037)
+(num-test (expt 1234000000 0) 1)
+(num-test (expt 1234000000 0.0) 1.0)
+(num-test (expt 1234000000 0.00000001) 1.00000020933529)
+(num-test (expt 1234000000.0 -0.0) 1.0)
+(num-test (expt 1234000000.0 -0.00000001) 0.99999979066475)
+(num-test (expt 1234000000.0 -1) 0.00000000081037)
+(num-test (expt 1234000000.0 -1.0) 0.00000000081037)
+(num-test (expt 1234000000.0 0) 1.0)
+(num-test (expt 1234000000.0 0.0) 1.0)
+(num-test (expt 1234000000.0 0.00000001) 1.00000020933529)
+(num-test (expt 1234000000/10 1/2) 11108.55526159905094)
+(num-test (expt 1234000000/3 0/3) 1)
+(num-test (expt 14879/18662 14879/18662) 8.347553395975456341642526041524525735791E-1)
+(num-test (expt 16 1/4) 2)
+(num-test (expt 1e-1 1e1) 1e-10)
+(num-test (expt 1e-1 1e2) 1e-100)
+(num-test (expt 1e-15 -1e-15) 1.000000000000034538776394911284329951335E0)
+(num-test (expt 1e-15 0+i) -0.999824358967590-0.018741697229594i)
+(num-test (expt 1e-15 0-i) -0.999824358967590+0.018741697229594i)
+(num-test (expt 1e-15 1e-15) 9.99999999999965461223605089908597123527E-1)
+(num-test (expt 1e-15 1e100) 0.0)
+(num-test (expt 1e15 -1e1) 1e-150)
+(num-test (expt 1e15 1e1) 1e150)
+(num-test (expt 1e18 -3) 1e-54)
+(if (not with-bignums) (num-test (expt 1e18 -63) 0.0)) ; 1e-1134
+(num-test (expt 1+1i -63) 2.3283064365386962890625E-10+2.3283064365386962890625E-10i)
+(num-test (expt 1+1i -3) -0.25-0.25i)
+(num-test (expt 2 (real-part (log 0))) (expt 2.0 (real-part (log 0))))
+(num-test (expt 2 -0.0) 1.0)
+(num-test (expt 2 -0.00000001) 0.99999999306853)
+(num-test (expt 2 -1) 1/2)
+(num-test (expt 2 -1.0) 0.50000000000000)
+(num-test (expt 2 -10) 1/1024)
+(num-test (expt 2 -2) 1/4)
+(num-test (expt 2 -3) 1/8)
+(num-test (expt 2 -3.14159265358979) 0.11331473229676)
+(num-test (expt 2 -9) 1/512)
+(num-test (expt 2 0) 1)
+(num-test (expt 2 0.0) 1.0)
+(num-test (expt 2 0.00000001) 1.00000000693147)
+(num-test (expt 2 1) 2)
+(num-test (expt 2 1+i) 1.538477802727944253156659987322541402879E0+1.277922552627269602300065822929403568513E0i)
+(num-test (expt 2 1.0) 2.0)
+(num-test (expt 2 1/3) 1.25992104989487316476721060727822835057E0)
+(num-test (expt 2 10) 1024)
+(num-test (expt 2 2) 4)
+(num-test (expt 2 3) 8)
+(num-test (expt 2 9) 512)
+(if (not with-bignums) (test (infinite? (expt 2 1000000000000)) #t))
+(num-test (expt 2 pi) 8.82497782707629)
+(num-test (expt 2.0 -1.0220000e+03) 2.225073858507201383090232717332404063624E-308)
+(num-test (expt 2.0 1.0230000e+03) 8.98846567431157953864652595394512365232E307)
+(num-test (expt 2/1 3/1) 8)
+(num-test (expt 2/10 1234000000/500029) 0.0)
+(num-test (expt 2/1234 500029/1234000000) 0.99739996551176)
+(num-test (expt 2/3 -5) (/ 1 (* 2/3 2/3 2/3 2/3 2/3)))
+(num-test (expt 2/3 5) (* 2/3 2/3 2/3 2/3 2/3))
+(num-test (expt 2/500029 0/10) 1)
+(num-test (expt 25 6) (+ (expt 1 6) (expt 2 6) (expt 3 6) (expt 5 6) (expt 6 6) (expt 7 6) (expt 8 6) (expt 9 6) (expt 10 6) (expt 12 6) (expt 13 6) (expt 15 6) (expt 16 6) (expt 17 6) (expt 18 6) (expt 23 6)))
+(num-test (expt 256 0) 1)
+(num-test (expt 256 1) 256)
+(num-test (expt 25937424601 1/10) 11)
+(num-test (expt 2718/1000 617/5) 3.858179469787681136058424024656091858698003418770850904916305853631035158956514884526199288e53) ; not an int!
+(num-test (expt 282475249 1/10) 7)
+(num-test (expt 29490/26049 29490/26049) 1.15080464191338725897675441635942490625E0)
+(num-test (expt 3 -0.0) 1.0)
+(num-test (expt 3 -0.00000001) 0.99999998901388)
+(num-test (expt 3 -1) 1/3)
+(num-test (expt 3 -1.0) 0.33333333333333)
+(num-test (expt 3 -10) 1/59049)
+(num-test (expt 3 -2) 1/9)
+(num-test (expt 3 -3) 1/27)
+(num-test (expt 3 -3.14159265358979) 0.03170146783514)
+(num-test (expt 3 0) 1)
+(num-test (expt 3 0.0) 1.0)
+(num-test (expt 3 0.00000001) 1.00000001098612)
+(num-test (expt 3 1) 3)
+(num-test (expt 3 1.0) 3.0)
+(num-test (expt 3 10) 59049)
+(num-test (expt 3 2) 9)
+(num-test (expt 3 3) 27)
+(num-test (expt 3 9) (* 3 3 3 3 3 3 3 3 3))
+(num-test (expt 3 pi) 31.54428070019755)
+(num-test (expt 3.0 0) 1.0)
+(num-test (expt 3.0 0.0) 1.0)
+(num-test (expt 3.0 1) 3.0)
+(num-test (expt 3.0 1.0) 3.0)
+(num-test (expt 3.14159265358979 -0.0) 1.0)
+(num-test (expt 3.14159265358979 -0.00000001) 0.99999998855270)
+(num-test (expt 3.14159265358979 -1) 0.31830988618379)
+(num-test (expt 3.14159265358979 -1.0) 0.31830988618379)
+(num-test (expt 3.14159265358979 -10) 0.00001067827923)
+(num-test (expt 3.14159265358979 -2) 0.10132118364234)
+(num-test (expt 3.14159265358979 -3) 0.03225153443320)
+(num-test (expt 3.14159265358979 -3.14159265358979) 0.02742569312330)
+(num-test (expt 3.14159265358979 0) 1.0)
+(num-test (expt 3.14159265358979 0.0) 1.0)
+(num-test (expt 3.14159265358979 0.00000001) 1.00000001144730)
+(num-test (expt 3.14159265358979 1) pi)
+(num-test (expt 3.14159265358979 1.0) pi)
+(num-test (expt 3.14159265358979 10) 93648.04747608296748)
+(num-test (expt 3.14159265358979 2) 9.86960440108936)
+(num-test (expt 3.14159265358979 3) 31.00627668029983)
+(num-test (expt 3.14159265358979 pi) 36.46215960720790)
+(num-test (expt 3.14159265358979-3.14159265358979i -1234000000.0+0.0i) 0.0)
+(num-test (expt 3/1 10/2) 243)
+(num-test (expt 3/1234000000 0/1234000000) 1)
+(num-test (expt 3/4 0) 1)
+(num-test (expt 3/4 0.0) 1.0)
+(num-test (expt 3/4 1) 3/4)
+(num-test (expt 3/4 1.0) 0.75)
+(num-test (expt 3/500029 1/1234) 0.99030354920325)
+(num-test (expt 3486784401 1/10) 9)
+(num-test (expt 36836/40706 36836/40706) 9.135636805317119582757524254250295946631E-1)
+(num-test (expt 38246/41321 38246/41321) 9.309245639585393834533875308768247886091E-1)
+(num-test (expt 4 1/3) 1.587401051968199474751705639272308260393E0)
+(num-test (expt 4 10) 1048576)
+(num-test (expt 45692/25507 45692/25507) 2.841422098671431061341360858366953184273E0)
+(num-test (expt 46394/6866 46394/6866) 4.043224602803809364259118808807234861721E5)
+(num-test (expt 5 10) 9765625)
+(num-test (expt 5.0e-01+1.00000000000000005551e-01i -1.0e+00+0.0e+00i) 1.9230769230769230687e0-3.8461538461538463509e-1i)
+(num-test (expt 5.0e-01+1.00000000000000005551e-01i 0.0e+00+0.0e+00i) 1e0+0.0i)
+(num-test (expt 5.0e-01+1.00000000000000005551e-01i 0.0e+00+1.0e+00i) 6.4160554864378080418e-1-5.1201864456768275590e-1i)
+(num-test (expt 5.0e-01+1.00000000000000005551e-01i 0.0e+00-1.0e+00i) 9.5219021866126714108e-1+7.5987364224031834571e-1i)
+(num-test (expt 5.0e-01+1.00000000000000005551e-01i 1.0e+00+0.0e+00i) 5e-1+1.0000000000000000555e-1i)
+(num-test (expt 5.0e-01+1.00000000000000005551e-01i 5.0e-01+1.00000000000000005551e-01i) 6.9977300530987816719e-1+2.1940939105372143160e-2i)
+(num-test (expt 5.0e-01+1.00000000000000005551e-01i 5.0e-01-1.00000000000000005551e-01i) 7.1829191470060938876e-1+1.2038189555821612762e-1i)
+(num-test (expt 5.0e-01-1.00000000000000005551e-01i -1.0e+00+0.0e+00i) 1.9230769230769230687e0+3.8461538461538463509e-1i)
+(num-test (expt 5.0e-01-1.00000000000000005551e-01i 0.0e+00+0.0e+00i) 1e0+0.0i)
+(num-test (expt 5.0e-01-1.00000000000000005551e-01i 0.0e+00+1.0e+00i) 9.5219021866126714108e-1-7.5987364224031834571e-1i)
+(num-test (expt 5.0e-01-1.00000000000000005551e-01i 0.0e+00-1.0e+00i) 6.4160554864378080418e-1+5.1201864456768275590e-1i)
+(num-test (expt 5.0e-01-1.00000000000000005551e-01i 1.0e+00+0.0e+00i) 5e-1-1.0000000000000000555e-1i)
+(num-test (expt 5.0e-01-1.00000000000000005551e-01i 5.0e-01+1.00000000000000005551e-01i) 7.1829191470060938876e-1-1.2038189555821612762e-1i)
+(num-test (expt 5.0e-01-1.00000000000000005551e-01i 5.0e-01-1.00000000000000005551e-01i) 6.9977300530987816719e-1-2.1940939105372143160e-2i)
+(num-test (expt 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) 9.999999999999958444410197170329529649165E-1)
+(num-test (expt 500029 -0.0) 1.0)
+(num-test (expt 500029 -0.00000001) 0.99999986877579)
+(num-test (expt 500029 -1) 1/500029)
+(num-test (expt 500029 -1.0) 0.00000199988401)
+(num-test (expt 500029 -2) 1/250029000841)
+(num-test (expt 500029 0) 1)
+(num-test (expt 500029 0.0) 1.0)
+(num-test (expt 500029 0.00000001) 1.00000013122422)
+(num-test (expt 500029 1) 500029)
+(num-test (expt 500029 1.0) 500029.00000000040745)
+(num-test (expt 500029/10 2/3) 1357.26128653075921)
+(num-test (expt 500029/1234 3/2) 8156.80442672750178)
+
+(if (not with-bignums)
+    (num-test (expt 500029/1234000000 10/1) 0.0)
+    (num-test (expt 500029/1234000000 10/1) 977129054104898258427314355689841897479681961836578300201/8187505353567209228244052427776000000000000000000000000000000000000000000000000000000000000))
+
+(num-test (expt 500029/2 0/1234) 1)
+(num-test (expt 500029/3 1/10) 3.32803123591083)
+(num-test (expt 50664/22466 50664/22466) 6.258302816095884603297081160883745414829E0)
+(num-test (expt 512 1/9) 2)
+(num-test (expt 56052/41477 56052/41477) 1.502246288382607077882411462458143945519E0)
+(num-test (expt 58288/55799 58288/55799) 1.046641989822034585352255152505850793912E0)
+(num-test (expt 59049 1/10) 3)
+(num-test (expt 6 10) 60466176)
+(num-test (expt 60466176 1/10) 6)
+(num-test (expt 64 -1/2) 1/8)
+(num-test (expt 64 -1/3) 1/4)
+(num-test (expt 64 -1/6) 1/2)
+(num-test (expt 64 -2/3) 1/16)
+(num-test (expt 64 -3/2) 1/512)
+(num-test (expt 64 1/2) 8)
+(num-test (expt 64 1/3) 4)
+(num-test (expt 64 1/6) 2)
+(num-test (expt 64 2/3) 16)
+(num-test (expt 64 3/2) 512)
+(num-test (expt 64/81 1/2) 8/9)
+(num-test (expt 7 10) 282475249)
+(num-test (expt 747/28616 747/28616) 9.092208838715899745892490249764275628871E-1)
+(num-test (expt 8 1/3) 2)
+(num-test (expt 8 10) 1073741824)
+(num-test (expt 9 10) 3486784401)
+(num-test (expt 9765625 1/10) 5)
+(num-test (sqrt (- (expt 4 1/5) (expt 3 1/5))) (/ (+ (* (- (expt 2 3/5)) (expt 3 4/5)) (expt 3 3/5) (* 2 (expt 2 2/5) (expt 3 2/5)) (* (- (expt 2 4/5)) (expt 3 1/5)) (expt 2 1/5)) 5))
+(num-test (sqrt (- (expt 4 2/3) (* (sqrt 3) (expt 5 1/6)))) (+ (/ (expt 5 1/3) (sqrt 6)) (- (/ (expt 5 5/6) (* 3 (sqrt 2)))) (/ (* (expt 2 1/6) (sqrt 5)) 3) (- (/ (* (expt 2 5/6) (expt 5 1/6)) 3)) (/ (expt 2 1/6) (sqrt 3))))
+(num-test (sqrt (- (expt 5 1/3) (expt 4 1/3))) (/ (+ (expt 2 1/3) (expt 20 1/3) (- (expt 25 1/3))) 3))
+(num-test (sqrt (- 127 (* 4 (sqrt 6) (expt 7 1/4)))) (+ (/ (* (sqrt 3) (expt 7 3/4)) (sqrt 2)) (* 2 (sqrt 7)) (/ (* 3 (sqrt 3) (expt 7 1/4)) (sqrt 2)) -6))
+(num-test (sqrt (- 161 (* 12 (expt 5 1/4)))) (+ (* 2 (expt 5 3/4)) (- (* 3 (sqrt 5))) (* 4 (sqrt (sqrt 5))) 6))
+(num-test (sqrt (- 2 (expt 2 1/7))) (/ (* (expt 2 1/14) (+ (- (expt 2 6/7)) (expt 2 5/7) (expt 2 3/7) (* 2 (expt 2 1/7)) -1)) (sqrt 7)))
+(test (= (+ (expt 2421 3) (expt 19083 3)) (+ (expt 5436 3) (expt 18948 3)) (+ (expt 10200 3) (expt 18072 3)) (+ (expt 13322 3) (expt 16630 3))) #t)
+
+;;; amol sasane MAA Monthly
+(num-test (expt (sqrt 2) (log 3 2)) (sqrt 3))
+(num-test (expt (expt 2 (sqrt 2)) 1/2) (expt (sqrt 2) (sqrt 2)))
+(num-test (expt (sqrt 2) (* 2 (log 3 2))) 3)
+(num-test (expt (sqrt 2) (+ (sqrt 2) 1)) (* (sqrt 2) (expt (sqrt 2) (sqrt 2))))
+(num-test (expt (expt (sqrt 2) (sqrt 2)) (sqrt 2)) 2)
+(when with-bignums
+  (num-test (expt 217288600195263/172462076265329 3) 10259136929659080970340082456456437407056447/5129568464829540485170041227870088110206289) ; 2.0+
+  (num-test (expt (bignum -inf.0) 1+i)  +nan.0+nan.0i)
+  (num-test (expt (bignum -inf.0) (bignum 1+i)) +nan.0+nan.0i))
+
+(unless with-bignums
+  (num-test (expt (+ 1 (/ 1000000)) 100) 1.0001000049501534764)
+  (num-test (expt (+ 1 (/ 1000000000)) 100000000) 1.1051709271646142850)
+  (num-test (expt (+ 1 (/ 1000000000)) 10000000000) 2.20264839094613347809362152246750859877E4)
+  (test (infinite? (expt 3/4 most-negative-fixnum)) #t)
+  (num-test (expt 4/3 most-negative-fixnum) 0)
+  (num-test (expt 1.0 most-negative-fixnum) 1.0)
+  (num-test (expt -1.0 most-negative-fixnum) 1.0)
+  (num-test (expt 1.0 most-positive-fixnum) 1.0)
+  (num-test (expt -1.0 most-positive-fixnum) -1.0)
+  (num-test (expt -1.0 (+ (expt 2 53) 1)) -1.0)
+  (num-test (expt -1.0 (- 1 (expt 2 54))) -1.0)
+  (num-test (expt -1.0 (expt 2 54)) 1.0)
+  (num-test (expt 2.0 (- (expt 2 53))) 0.0)
+  (num-test (expt 2 most-negative-fixnum) 0)
+  (test (nan? (expt 1/0 0)) #t)
+  (test (infinite? (expt 2 (expt 3 (expt 4 2)))) #t) ; bug-guile, gmp does this in about a second but the printout is enormous
+  (test (nan? (expt (complex 0 1/0) 0)) #t)
+  (test (nan? (expt (complex 1/0 1/0) 0)) #t)
+  (test (nan? (expt (complex 1/0 0) 0)) #t)
+  (num-test (expt most-negative-fixnum 8) 5.237424972633826992021103514924158643547E151)
+  (num-test (expt most-negative-fixnum 2) 8.5070591730234615865843651857942052864E37)
+  (num-test (expt most-negative-fixnum -1) -1.084202172485504434007452800869941711426E-19)
+  (num-test (expt most-negative-fixnum -2) 1.175494350822287507968736537222245677819E-38))
+
+(num-test (expt 1 most-negative-fixnum) 1)
+(num-test (expt -1 most-negative-fixnum) 1)
+(num-test (expt 1 most-positive-fixnum) 1)
+(num-test (expt -1 most-positive-fixnum) -1)
+(num-test (expt most-positive-fixnum 1) most-positive-fixnum)
+(num-test (expt most-positive-fixnum -1) (/ most-positive-fixnum))
+(num-test (expt most-negative-fixnum 1) most-negative-fixnum)
+(num-test (expt most-negative-fixnum 0) 1)
+(num-test (expt 1/9223372036854775807 9223372036854775807) 0.0)
+(test (infinite? (expt 1/9223372036854775807 -9223372036854775807)) #t)
+(test (infinite? (expt 9223372036854775807 9223372036854775807)) #t)
+
+(num-test (expt 0+i (+ 0 (expt 2 16))) 1.0)
+(num-test (expt 0+i (+ 1 (expt 2 16))) 0+i)
+(num-test (expt 0+i (+ 2 (expt 2 16))) -1.0)
+(num-test (expt 0+i (+ 3 (expt 2 16))) 0-i)
+(num-test (expt 0-i (+ 0 (expt 2 16))) 1.0)
+(num-test (expt 0-i (+ 1 (expt 2 16))) 0-i)
+(num-test (expt 0-i (+ 2 (expt 2 16))) -1.0)
+(num-test (expt 0-i (+ 3 (expt 2 16))) 0+i)
+(num-test (expt 0+i (+ 0 (expt 2 54))) 1.0)
+(num-test (expt 0+i (+ 1 (expt 2 54))) 0+i)
+(num-test (expt 0+i (+ 2 (expt 2 54))) -1.0)
+(num-test (expt 0+i (+ 3 (expt 2 54))) 0-i)
+(num-test (expt 0-i (+ 0 (expt 2 54))) 1.0)
+(num-test (expt 0-i (+ 1 (expt 2 54))) 0-i)
+(num-test (expt 0-i (+ 2 (expt 2 54))) -1.0)
+(num-test (expt 0-i (+ 3 (expt 2 54))) 0+i)
+
+(test (nan? (expt 0/0+0/0i 0+0/0i)) #t)
+(test (nan? (expt (bignum 0/0+0/0i) 0+0/0i)) #t)
+
+(let ((val1 (catch #t (lambda () (expt 0.0 0.0)) (lambda args 'error)))
+      (val2 (catch #t (lambda () (expt 0.0 -0.0)) (lambda args 'error))))
+  (test (equal? val1 val2) #t))
+(let ((val1 (catch #t (lambda () (expt 2.0 0.0)) (lambda args 'error)))
+      (val2 (catch #t (lambda () (expt 2.0 -0.0)) (lambda args 'error))))
+  (test (equal? val1 val2) #t))
+
+;;      (test (expt 0 0-i) 0.0) ; sbcl and clisp say division by 0 here, guile says NaN
+;;      but (expt 0.0 1e-15-i) is 0.0??
+;; clisp says (expt 0 1+i) is 0, but (expt 0 0+i) is division by zero??) -- sbcl agrees
+
+#|
+(do ((i 30 (+ i 1)))
+    ((= i 63))
+  (format #t "~D: (- ~A ~A) -> ~A~%" i (+ (expt 2.0 i) 500) (+ (expt 2.0 i) 100) (- (+ (expt 2.0 i) 500) (+ (expt 2.0 i) 100))))
+
+55: (- 3.6028797018964e+16 3.6028797018964e+16) -> 400.0
+56: (- 7.2057594037928e+16 7.2057594037928e+16) -> 400.0
+57: (- 1.4411518807586e+17 1.4411518807586e+17) -> 416.0
+58: (- 2.8823037615171e+17 2.8823037615171e+17) -> 384.0
+59: (- 5.7646075230342e+17 5.7646075230342e+17) -> 384.0
+60: (- 1.1529215046068e+18 1.1529215046068e+18) -> 512.0
+61: (- 2.3058430092137e+18 2.3058430092137e+18) -> 512.0
+62: (- 4.6116860184274e+18 4.6116860184274e+18) -> 0.0
+|#
+
+
+(test (< (abs (- (+ (complex 1.0 0.0) (make-polar 1.0 0.0) 1.0+0i (* -1.0 -1.0) (/ 1.0)
+		    (exp 0.0) (abs -1.0) (cos 0.0) (log (exp 1)) (magnitude 1.0+0i) (max 0.0 1.0) (min 1.0 2.0))
+		 12.0))
+	 1e-12)
+      #t)
+
+(let ((xs (list 2 3 4 1/2 1/3 1/4 2.5 1+i 2.5+1.5i 2.5-.5i))
+      (ys  (list 2 3 4 -2 -3 1/2 1/3 1/4 -1/2 -1/3 -1/4 2.5 -3.5 1+i -1+2i 2.5+1.5i 2.5-.5i)))
+  (for-each
+   (lambda (x)
+     (for-each
+      (lambda (y)
+	(num-test (expt (expt x y) (/ y)) x)
+	;;	(if (> (magnitude (- (expt (expt x y) (/ y)) x)) 1e-6)
+	;;	    (format #t ";(expt (expt ~A ~A) (/ ~A)) -> ~A (~A)~%" x y y (expt (expt x y) (/ y)) (magnitude (- (expt (expt x y) (/ y)) x))))
+	)
+      ys))
+   xs))
+
+(when with-bignums
+  ;; from Knuth IIp245(3rd)
+  (let* ((f (lambda (x) (/ (- 1 (expt x 107)) (- 1 x))))
+	 (g (lambda (y) (f (* (- 1/3 (* y y)) (+ 3 (* 3.45 y y))))))
+	 (gx (lambda (y) (+ 107 (* -10491.35 y y) (* 659749.9625 y y y y) (* 30141386.26625 (expt y 6))))))
+    (do ((i 3 (+ i 1)))
+	((> i 10))
+      (let ((g1 (g (expt 10 (- i))))
+	    (g2 (gx (expt 10 (- i)))))
+	(let ((diff (abs (- g1 g2))))
+	  (if (or (nan? diff) (> diff (expt 10 (- -7 i))))
+	      (format #t ";g(1e-~D) -> ~A ~A, diff: ~A~%" i g1 g2 (abs (- g1 g2))))))))
+
+  (let ((p (lambda (x y) (+ (* 2 y y) (* 9 x x x x) (* -1 y y y y)))))
+    (num-test (p 408855776 708158977) 1))
+  (let ((p (lambda (x y) (+ (* 2 y y) (* (- (* 3 x x) (* y y)) (+ (* 3 x x) (* y y)))))))
+    (num-test (p 408855776 708158977) 1)))
+
+(let ((top-exp 60))
+  (let ((happy #t))
+    (do ((i 2 (+ i 1)))
+	((or (not happy) (> i top-exp)))
+      (let* ((val1 (+ 2 (expt 2 i)))
+	     (val2 (- val1 1)))
+	(if (not (> val1 val2))
+	    (begin (set! happy #f) (display "(> ") (display val1) (display " ") (display val2) (display ") -> ") (display (> val1 val2)) (display "?") (newline)))
+	(if (< val1 val2)
+	    (begin (set! happy #f) (display "(< ") (display val1) (display " ") (display val2) (display ") -> ") (display (< val1 val2)) (display "?") (newline))))))
+
+  (let ((happy #t))
+    (do ((i 2 (+ i 1)))
+	((or (not happy) (> i top-exp)))
+      (let* ((val1 (/ (expt 2 i) 3))
+	     (val2 (/ (+ 1 (expt 2 i)) 3)))
+	(if (> val1 val2)
+	    (begin (set! happy #f) (display "(> ") (display val1) (display " ") (display val2) (display ") -> ") (display (> val1 val2)) (display "?") (newline)))
+	(if (not (> val2 val1))
+	    (begin (set! happy #f) (display "(> ") (display val1) (display " ") (display val2) (display ") -> ") (display (> val2 val1)) (display "?") (newline)))
+	(if (not (< val1 val2))
+	    (begin (set! happy #f) (display "(< ") (display val1) (display " ") (display val2) (display ") -> ") (display (< val1 val2)) (display "?") (newline)))
+	(if (< val2 val1)
+	    (begin (set! happy #f) (display "(< ") (display val1) (display " ") (display val2) (display ") -> ") (display (< val2 val1)) (display "?") (newline)))
+	))))
+
+(let* ((x (* #x1.6000022202b1076a (expt 2 -58)))
+       (a (expt (- 1.01 x) (- 1.01 x)))
+       (b (expt x (- 1.01 (expt x (- 1.01 x))))))
+  (num-test a 1.010100503341741589854787064753636627742E0)
+  (num-test b 3.201463978607038931337314838029261023486E-18)
+  (num-test x 4.770489999999999999978271189676737354422E-18)
+  (num-test (+ a b -1.01) 1.005033417415841744668463594232356924E-4)
+  (test (positive? (+ a b -1.01)) #t))
+
+(do ((k 1 (+ k 1)))
+    ((= k 12))
+  (num-test (+ (expt 11 k) (expt 24 k) (expt 65 k) (expt 90 k) (expt 129 k)
+	       (expt 173 k) (expt 212 k) (expt 237 k) (expt 278 k) (expt 291 k) (expt 302 k))
+	    (+ (expt 3 k) (expt 5 k) (expt 30 k) (expt 57 k) (expt 104 k) (expt 116 k)
+	       (expt 186 k) (expt 198 k) (expt 245 k) (expt 272 k) (expt 297 k) (expt 299 k))))
+
+(let ((top 0))
+  (let ((x-10 (lambda (n) (- (expt n 10) (* n n n n n n n n n n)))))
+    (let ((happy #t)
+	  (lim (if with-bignums 100 74)))
+      (do ((i 1 (+ i 1)))
+	  ((or (not happy) (= i lim))) ; stop around 63 bits
+	(let ((val (x-10 i)))
+	  (if (not (= val 0))
+	      (begin
+		(set! top (- i 1))
+		(set! happy #f)
+                (format #t "(expt ~D 10) = ~D, (* ~D ... 10x) = ~D, (x-10 ~D) = ~D~%"
+                   i (expt i 10) i (* i i i i i i i i i i) i (x-10 i))))))))
+  (if (> top 63)
+      (num-test (+ (expt 1 10) (expt 2 10) (expt 4 10) (expt 5 10) (expt 6 10) (expt 8 10) (expt 12 10)
+		   (expt 15 10) (expt 16 10) (expt 17 10) (expt 20 10) (expt 21 10) (expt 25 10) (expt 26 10)
+		   (expt 27 10) (expt 28 10) (expt 30 10) (expt 36 10) (expt 37 10) (expt 38 10) (expt 40 10)
+		   (expt 51 10) (expt 62 10))
+		(expt 63 10))))
+
+(do ((i 1 (+ i 1)))
+    ((= i 10))
+  (let ((v (vector i (- i) (/ i) (/ i (+ i 1)) (- (/ i)) (/ (- i) (+ i 1))
+		   (random (* i 10.0)) (sqrt i) (+ i (random (sqrt i))) (- (random (* i 2.0)) i)
+		   (complex i i)
+		   (complex (- i) (- i))
+		   )))
+    (let ((len (length v)))
+      (do ((k 0 (+ k 1)))
+	  ((= k len))
+	(do ((j 0 (+ j 1)))
+	    ((= j len))
+	  (let ((val1 (catch #t (lambda () (expt (v k) (v j))) (lambda args 'error)))) ; (expt 0 -1) for example
+	    (if (number? val1)
+		(let ((val2 (if (zero? (v k)) 0 (exp (* (v j) (log (v k))))))
+		      (val3 (if (zero? (v k)) 0 (exp (* (v j) (+ (* 0+2i pi) (log (v k))))))))
+		  (let ((diff
+			 (min (magnitude (- val1 val2))
+			      (magnitude (- val1 val3)))))
+		    (if (> (/ diff (max (magnitude val1) 1)) 1e-12)
+			(format #t ";(expt ~A ~A), ~A ~A ~A: ~A~%" (v k) (v j) val1 val2 val3 diff)))))))))))
+
+(if with-bignums
+    (num-test (let ((dickey (lambda (x y) ; from Kawa
+			      (+  (* 1335/4 (expt y 6))
+				  (* (expt x 2)
+				     (- (* 11 (expt x 2) (expt y 2))
+					(expt y 6)
+					(* 121 (expt y 4))
+					2))
+				  (* 11/2 (expt y 8))
+				  (/ x (* 2 y))))))
+		(dickey 77617 33096))
+               -54767/66192))
+
+(let ((x-10 (lambda (n) (- (expt n 10) (* n n n n n n n n n n)))))
+  (let ((happy #t)
+	(lim (if with-bignums 100 74)))
+    (do ((i 1 (+ i 2)))
+	((or (not happy) (> i lim))) ; stop around 63 bits
+      (let ((val (x-10 (/ i 2))))
+	(unless (= val 0)
+          (set! happy #f)
+          (display "(expt ") (display i) (display "/2 10) = ") (display (expt (/ i 2) 10))
+	  (display " but (* ") (display i) (display "/2 ... 10x) = ")
+	  (display (/ (* i i i i i i i i i i) 1024)) (newline))))))
+
+(let ((x-10 (lambda (n) (- (expt n -10) (/ 1 (* n n n n n n n n n n))))))
+  (let ((happy #t)
+	(lim (if with-bignums 100 74)))
+    (do ((i 1 (+ i 2)))
+	((or (not happy) (> i lim))) ; stop around 63 bits
+      (let ((val (x-10 (/ i 2))))
+	(unless (= val 0)
+	  (set! happy #f)
+	  (display "(expt ") (display i) (display "/2 -10) = ") (display (expt (/ i 2) -10))
+	  (display " but (* 1/(") (display i) (display "/2) ... 10x) = ")
+	  (display (/ 1024 (* i i i i i i i i i i)))
+	  (display " [diff=") (display val) (display "]")
+	  (newline))))))
+
+(let ((happy #t)
+      (lim (if with-bignums 50 19)))
+  (do ((i 1 (+ i 1)))
+      ((or (not happy) (> i lim)))
+    (let* ((val1 (expt 3 i))
+	   (val2 (sqrt (* val1 val1))))
+      (unless (= val1 val2)
+	(set! happy #f)
+	(display "[3^i] (sqrt ") (display (* val1 val1)) (display " = ") (display val2)
+	(display " but should be ") (display val1) (newline)))))
+
+
+(if (not with-bignums)
+    (begin
+      (num-test (* (/ (expt 2 31) (+ (expt 2 20) 1)) (/ (+ (expt 2 31) 1) (expt 2 20))) 4194300.0019569)
+      (num-test (expt -2/10 1234000000/500029) 0.0)
+      (num-test (expt -1/1234000000 500029/10) 0.0)
+      (num-test (expt 3.14159265358979-1.0i -1234.0+0.00000001i) 0.0)
+      (num-test (expt -3.14159265358979-1.0i -1234.0-0.00000001i) 0.0)
+      (num-test (expt 1234000000.0-1234000000.0i -1234.0+0.0i) 0.0)
+      (num-test (expt -1234000000.0-1234000000.0i -1234.0-0.0i) 0.0)
+      )
+    (begin
+      (num-test (* (/ (expt 2 31) (+ (expt 2 20) 1)) (/ (+ (expt 2 31) 1) (expt 2 20))) 4398046513152/1048577)
+      (test (expt 1/2 9223372036854775807) 0.0)
+      (num-test (expt (expt -4722366482869645213696/6561 1/2) 2) -4722366482869645213696/6561)
+      (num-test (expt 324518553658426726783156020576256.0 1/3) 68719476736.0)
+      (num-test (expt 4722366482869645213696 1/2) 68719476736)
+      (num-test (expt 4722366482869645213696.0 1/2) 68719476736.0)
+      (num-test (expt 4722366482869645213696/6561 -1/2) (/ 68719476736/81))
+      (num-test (* (/ (expt 2 61) (+ (expt 2 40) 1)) (/ (+ (expt 2 61) 1) (expt 2 40)))	4835703278458516700921856/1099511627777)
+      (num-test (+ (- 512 (expt 2.0 62)) (- (expt 2.0 62) 513)) -1.0)
+      (num-test (+ (/ (expt 2 61) (+ (expt 2 40) 1)) (/ (+ (expt 2 61) 1) (expt 2 40))) 5070602400915223450095538143233/1208925819615728686333952)
+      (num-test (+ (expt 2 61) (expt 2 62) (expt 2 61)) (/ (expt 2 64) 2))
+      (num-test (* 2 (expt 2 62)) (expt 2 63))
+      (num-test (* 8 (expt 2 30) (expt 2 30)) 9223372036854775808)
+      (num-test (- (+ (expt 2.0 62) 500) (+ (expt 2.0 62) 100)) 4.000E2)
+      (num-test (- (+ (expt 2.0 62) 512) (+ (expt 2.0 62) 513)) -1.0)
+      (num-test (- (/ (expt 2 61) (+ (expt 2 40) 1)) (/ (+ (expt 2 61) 1) (expt 2 40)))	-2305844108725321729/1208925819615728686333952)
+      (num-test (/ (/ (expt 2 61) (+ (expt 2 40) 1)) (/ (+ (expt 2 61) 1) (expt 2 40)))	2535301200456458802993406410752/2535301200458764647102131732481)
+      (num-test (/ (expt (* 1.2345e-170 1.2345e-170) 1/100)) 2.501325312985302606641508258507698932691E3)
+      (num-test (/ (log (expt 2 32)) (log 2)) 32.0)
+      (num-test 1180591620717411303424/1180591620717411303425 (/ (expt 2 70) (+ (expt 2 70) 1)))
+      (test (< (abs (- (expt (- (exp (* pi (sqrt (bignum "163")))) 744) 1/3) 6.4031999999999999999999999999939031735E5)) 1e-32) #t)
+      (test (> (+ (expt 2.0 62) 500) (+ (expt 2.0 62) 100)) #t)
+      (num-test (expt -2/10 1234000000/500029) 9.92209574402351949043519108941671096176E-1726-4.788930572030484370393069119625570107346E-1726i)
+      (num-test (expt -1/1234000000 500029/10) -7.168156874677746632219778149112758764437E-454593+2.32907535423388290492582809530285175961E-454593i)
+      (num-test (expt 3.14159265358979-1.0i -1234.0+0.00000001i) -4.480790643664505864348068449454625911766E-640-6.676876181099023202939008945839411012697E-641i)
+      (num-test (expt -3.14159265358979-1.0i -1234.0-0.00000001i) -4.480790502896318391426668753233092987401E-640+6.676875971338774903151645323179283073828E-641i)
+      (num-test (expt 1234000000.0-1234000000.0i -1234.0+0.0i) 0.0+3.815800046393940013006703716489144169017E-11405i)
+      (num-test (expt -1234000000.0-1234000000.0i -1234.0-0.0i) 0.0-3.815800046393940013006703716489144169017E-11405i)
+
+      (num-test (expt 2 1/3) 1.25992104989487316476721060727822835057E0)
+      (test (zero? (- (expt 2 1/3) 1.2599210498949)) #f) ; make sure it's not just libm's cbrt
+      ))
+
+(when (and (not (provided? 'freebsd)) (not (provided? 'openbsd)))
+  (for-each
+   (lambda (data)
+     (let ((num1 (car data))
+           (num2 (cadr data))
+           (val (caddr data)))
+       (num-test-2 'expt num1 num2 (expt num1 num2) val)))
+   (vector (list 0 0 1) (list 0 1 0) (list 0 2 0) (list 0 3 0) (list 0 1/2 0) (list 0 1/3 0)
+	   (list 0 0.0 0.0) (list 0 1.0 0.0) (list 0 2.0 0.0) (list 0 1.000000000000000000000000000000000000002E-309 0.0)
+	   (list 0 1e+16 0.0) (list 0 +inf.0 0.0) (list 0 0+1i 0.0) (list 0 0+2i 0.0)
+	   (list 0 0-1i 0.0) (list 0 1+1i 0.0) (list 0 1-1i 0.0) (list 0 0.1+0.1i 0.0) (list 0 1e+16+1e+16i 0.0)
+	   (list 0 1e-16+1e-16i 0.0) (list 1 0 1) (list 1 1 1) (list 1 2 1) (list 1 3 1) (list 1 -1 1)
+	   (list 1 -2 1) (list 1 -3 1) (list 1 1/2 1) (list 1 1/3 1.0) (list 1 -1/2 1.000E0)
+	   (list 1 -1/3 1.000E0) (list 1 0.0 1.000E0) (list 1 1.0 1.000E0) (list 1 2.0 1.000E0)
+	   (list 1 -2.0 1.000E0) (list 1 1.000000000000000000000000000000000000002E-309 1.000E0)
+	   (list 1 1e+16 1.000E0) (list 1 +inf.0 1.000E0) (list 1 -inf.0 1.000E0)
+	   (list 1 0+1i 1.0) (list 1 0+2i 1.0) (list 1 0-1i 1.0) (list 1 1+1i 1.0) (list 1 1-1i 1.0) (list 1 -1+1i 1.0)
+	   (list 1 -1-1i 1.0) (list 1 0.1+0.1i 1.0) (list 1 1e+16+1e+16i 1.0) (list 1 1e-16+1e-16i 1.0)
+	   (list 2 0 1) (list 2 1 2) (list 2 2 4) (list 2 3 8) (list 2 -1 1/2) (list 2 -2 1/4)
+	   (list 2 -3 1/8) (list 2 1/2 1.4142135623731) (list 2 1/3 1.2599210498949) (list 2 -1/2 7.071067811865475244008443621048490392845E-1)
+	   (list 2 -1/3 7.937005259840997475556964875637659160371E-1) (list 2 0.0 1.000E0) (list 2 1.0 2.000E0)
+	   (list 2 2.0 4.000E0) (list 2 -2.0 2.500E-1) (list 2 1.000000000000000000000000000000000000002E-309 1.000E0)
+	   (list 2 -inf.0 0.0) (list 2 0+1i 7.692389013639721265783299936612707014395E-1+6.389612763136348011500329114647017842567E-1i)
+	   (list 2 0+2i 1.83456974743301676839941236809235104518E-1+9.830277404112437205861648503427281526099E-1i)
+	   (list 2 0-1i 7.692389013639721265783299936612707014395E-1-6.389612763136348011500329114647017842567E-1i)
+	   (list 2 1+1i 1.538477802727944253156659987322541402879E0+1.277922552627269602300065822929403568513E0i)
+	   (list 2 1-1i 1.538477802727944253156659987322541402879E0-1.277922552627269602300065822929403568513E0i)
+	   (list 2 -1+1i 3.846194506819860632891649968306353507197E-1+3.194806381568174005750164557323508921283E-1i)
+	   (list 2 -1-1i 3.846194506819860632891649968306353507197E-1-3.194806381568174005750164557323508921283E-1i)
+	   (list 2 0.1+0.1i 1.069199809265204517687304849996528484166E0+7.423020183379063973209835788737470580225E-2i)
+	   (list 2 1e-16+1e-16i 1.00000000000000006931471805599452949289E0+6.931471805599453429742233135802455373554E-17i)
+	   (list 3 0 1) (list 3 1 3) (list 3 2 9) (list 3 3 27) (list 3 -1 1/3) (list 3 -2 1/9)
+	   (list 3 -3 1/27) (list 3 1/2 1.7320508075689) (list 3 1/3 1.4422495703074) (list 3 -1/2 5.773502691896257645091487805019574556475E-1)
+	   (list 3 -1/3 6.933612743506347189382852083362015558497E-1) (list 3 0.0 1.000E0) (list 3 1.0 3.000E0)
+	   (list 3 2.0 9.000E0) (list 3 -2.0 1.111111111111111111111111111111111111113E-1) (list 3 1.000000000000000000000000000000000000002E-309 1.000E0)
+	   (list 3 -inf.0 0.0) (list 3 0+1i 4.548324228266097550275651435950424840878E-1+8.905770416677470590749273065651780951036E-1i)
+	   (list 3 0+2i -5.862549342913521629213761016900936427016E-1+8.101266271509919688171526765177844453941E-1i)
+	   (list 3 0-1i 4.548324228266097550275651435950424840878E-1-8.905770416677470590749273065651780951036E-1i)
+	   (list 3 1+1i 1.364497268479829265082695430785127452266E0+2.671731125003241177224781919695534285314E0i)
+	   (list 3 1-1i 1.364497268479829265082695430785127452266E0-2.671731125003241177224781919695534285314E0i)
+	   (list 3 -1+1i 1.516108076088699183425217145316808280297E-1+2.968590138892490196916424355217260317017E-1i)
+	   (list 3 -1-1i 1.516108076088699183425217145316808280297E-1-2.968590138892490196916424355217260317017E-1i)
+	   (list 3 0.1+0.1i 1.109394427306365911813022078881836880638E0+1.223721548273860448930668229757603279477E-1i)
+	   (list 3 1e-16+1e-16i 1.00000000000000010986122886681096684318E0+1.098612288668109789126712952843432012306E-16i)
+	   (list -1 0 1) (list -1 1 -1) (list -1 2 1) (list -1 3 -1) (list -1 -1 -1) (list -1 -2 1)
+	   (list -1 -3 -1) (list -1 1/2 0+1i) (list -1 1/3 -1.0) (list -1 -1/2 0.0-1.00E0i)
+	   (list -1 -1/3 5.000000000000000503430454055824822034062E-1-8.660254037844386176981523540143355578944E-1i)
+	   (list -1 0.0 1.000E0) (list -1 1.0 -1.00E0) (list -1 2.0 1.000E0) (list -1 -2.0 1.000E0)
+					;(list -1 1e+16 1.000E0)
+	   (list -1 0+1i 4.321391826377224977441773717172801127579E-2)
+	   (list -1 0+2i 1.86744273170798881443021293482703039342E-3) (list -1 0-1i 2.314069263277926900572908636794854738031E1)
+	   (list -1 1+1i -4.321391826377224977441773717172801127579E-2) (list -1 1-1i -2.314069263277926900572908636794854738031E1)
+	   (list -1 -1+1i -4.321391826377224977441773717172801127579E-2) (list -1 -1-1i -2.314069263277926900572908636794854738031E1)
+	   (list -1 0.1+0.1i 6.946542388413302284911578278489504217747E-1+2.257068442712257901873502529761755278285E-1i)
+	   (list -1 1e+16+1e+16i 0.0) (list -1 1e-16+1e-16i 9.999999999999996858407346410206827203587E-1+3.141592653589792185835963602803850622895E-16i)
+	   (list -2 0 1) (list -2 1 -2) (list -2 2 4) (list -2 3 -8) (list -2 -1 -1/2) (list -2 -2 1/4)
+	   (list -2 -3 -1/8) (list -2 1/2 0+1.4142135623731i) (list -2 1/3 -1.2599210498949)
+	   (list -2 -1/2 0.0-7.071067811865475244008443621048490392845E-1i)
+	   (list -2 -1/3 3.968502629920499137351498618341152884837E-1-6.873648184993012989383839761489500939792E-1i)
+	   (list -2 0.0 1.000E0) (list -2 1.0 -2.00E0) (list -2 2.0 4.000E0) (list -2 -2.0 2.500E-1)
+	   (list -2 -inf.0 0.0) (list -2 0+1i 3.324182700885665525901791766265082328307E-2+2.761202036833300995082465454051316449496E-2i)
+	   (list -2 0+2i 3.425953940655147934023229852954811989202E-4+1.835748008898304681163796172161682131024E-3i)
+	   (list -2 0-1i 1.780072097764048857359856955378859222048E1-1.478600649942216768260366593652156810413E1i)
+	   (list -2 1+1i -6.648365401771331051803583532530164656613E-2-5.522404073666601990164930908102632898992E-2i)
+	   (list -2 1-1i -3.560144195528097714719713910757718444095E1+2.957201299884433536520733187304313620826E1i)
+	   (list -2 -1+1i -1.662091350442832762950895883132541164153E-2-1.380601018416650497541232727025658224748E-2i)
+	   (list -2 -1-1i -8.900360488820244286799284776894296110238E0+7.393003249711083841301832968260784052065E0i)
+	   (list -2 0.1+0.1i 7.259699150688950609812198701314241029302E-1+2.928900391985359860022641767906842987898E-1i)
+	   (list -2 1e+16+1e+16i 0.0) (list -2 1e-16+1e-16i 9.999999999999997551554526970151686615297E-1+3.834739834149737528810186916384012655492E-16i)
+	   (list -3 0 1) (list -3 1 -3) (list -3 2 9) (list -3 3 -27) (list -3 -1 -1/3) (list -3 -2 1/9)
+	   (list -3 -3 -1/27) (list -3 1/2 0+1.7320508075689i) (list -3 1/3 -1.4422495703074)
+	   (list -3 -1/2 0.0-5.773502691896257645091487805019574556475E-1i)
+	   (list -3 -1/3 3.466806371753173943750607212746369268463E-1-6.004684775880013553913614575447052401843E-1i)
+	   (list -3 0.0 1.000E0) (list -3 1.0 -3.00E0) (list -3 2.0 9.000E0) (list -3 -2.0 1.111111111111111111111111111111111111113E-1)
+	   (list -3 -inf.0 0.0) (list -3 0+1i 1.965509114374261361108537566165204334024E-2+3.848532348622211453375207440262631065206E-2i)
+	   (list -3 0+2i -1.094797515970330168691448329739632503045E-3+1.512865081636227781901948390654863520171E-3i)
+	   (list -3 0-1i 1.052513729605287378161514526579733692066E1-2.060856958704319044776041543097331663996E1i)
+	   (list -3 1+1i -5.896527343122784083325612698495613002091E-2-1.15455970458666343601256223207878931956E-1i)
+	   (list -3 1-1i -3.157541188815862134484543579739201076193E1+6.182570876112957134328124629291994991979E1i)
+	   (list -3 -1+1i -6.551697047914204537028458553884014446755E-3-1.282844116207403817791735813420877021735E-2i)
+	   (list -3 -1-1i -3.508379098684291260538381755265778973549E0+6.869523195681063482586805143657772213312E0i)
+	   (list -3 0.1+0.1i 7.430253085825579186796890883432274992943E-1+3.354042513063949187690186935389269335405E-1i)
+	   (list -3 1e+16+1e+16i 0.0) (list -3 1e-16+1e-16i 9.999999999999997957019635078315805356955E-1+4.240204942257901974962676555647136289098E-16i)
+	   (list 1/2 0 1) (list 1/2 1 1/2) (list 1/2 2 1/4) (list 1/2 3 1/8) (list 1/2 -1 2)
+	   (list 1/2 -2 4) (list 1/2 -3 8) (list 1/2 1/2 0.70710678118655) (list 1/2 1/3 0.7937005259841)
+	   (list 1/2 -1/2 1.414213562373095048801688724209698078569E0) (list 1/2 -1/3 1.259921049894873148607716059938123324722E0)
+	   (list 1/2 0.0 1.000E0) (list 1/2 1.0 5.000E-1) (list 1/2 2.0 2.500E-1) (list 1/2 -2.0 4.000E0)
+	   (list 1/2 1.000000000000000000000000000000000000002E-309 1.000E0) (list 1/2 1e+16 0.0)
+	   (list 1/2 +inf.0 0.0) (list 1/2 0+1i 7.692389013639721265783299936612707014395E-1-6.389612763136348011500329114647017842567E-1i)
+	   (list 1/2 0+2i 1.83456974743301676839941236809235104518E-1-9.830277404112437205861648503427281526099E-1i)
+	   (list 1/2 0-1i 7.692389013639721265783299936612707014395E-1+6.389612763136348011500329114647017842567E-1i)
+	   (list 1/2 1+1i 3.846194506819860632891649968306353507197E-1-3.194806381568174005750164557323508921283E-1i)
+	   (list 1/2 1-1i 3.846194506819860632891649968306353507197E-1+3.194806381568174005750164557323508921283E-1i)
+	   (list 1/2 -1+1i 1.538477802727944253156659987322541402879E0-1.277922552627269602300065822929403568513E0i)
+	   (list 1/2 -1-1i 1.538477802727944253156659987322541402879E0+1.277922552627269602300065822929403568513E0i)
+	   (list 1/2 0.1+0.1i 9.307924962319322751032548220951692988141E-1-6.462114401999142796156052473887795907618E-2i)
+	   (list 1/2 1e+16+1e+16i 0.0) (list 1/2 1e-16+1e-16i 9.999999999999999306852819440054705071071E-1-6.931471805599452468836205299399646209468E-17i)
+	   (list 1/3 0 1) (list 1/3 1 1/3) (list 1/3 2 1/9) (list 1/3 3 1/27) (list 1/3 -1 3)
+	   (list 1/3 -2 9) (list 1/3 -3 27) (list 1/3 1/2 0.57735026918963) (list 1/3 1/3 0.69336127435063)
+	   (list 1/3 -1/2 1.732050807568877341601513501094972563495E0) (list 1/3 -1/3 1.442249570307408379689974332217791378498E0)
+	   (list 1/3 0.0 1.000E0) (list 1/3 1.0 3.333333333333333148296162562473909929395E-1)
+	   (list 1/3 2.0 1.111111111111110987752997263871498932361E-1) (list 1/3 -2.0 9.000000000000000999200722162640969581442E0)
+	   (list 1/3 1.000000000000000000000000000000000000002E-309 1.000E0) (list 1/3 1e+16 0.0)
+	   (list 1/3 +inf.0 0.0) (list 1/3 0+1i 4.548324228266097055906083004905301340071E-1-8.905770416677470843231987149725161148001E-1i)
+	   (list 1/3 0+2i -5.862549342913522528634995341851693014879E-1-8.101266271509919037297800414810374565267E-1i)
+	   (list 1/3 0-1i 4.548324228266097055906083004905301340071E-1+8.905770416677470843231987149725161148001E-1i)
+	   (list 1/3 1+1i 1.516108076088698934474456306943980624137E-1-2.968590138892490116287472906226681453643E-1i)
+	   (list 1/3 1-1i 1.516108076088698934474456306943980624137E-1+2.968590138892490116287472906226681453643E-1i)
+	   (list 1/3 -1+1i 1.364497268479829192516639126693602447003E0-2.671731125003241401280466674231091613441E0i)
+	   (list 1/3 -1-1i 1.364497268479829192516639126693602447003E0+2.671731125003241401280466674231091613441E0i)
+	   (list 1/3 0.1+0.1i 8.905570151840088631186184238937353595899E-1-9.823321468210062916108146236871209771647E-2i)
+	   (list 1/3 1e+16+1e+16i 0.0)
+	   (list 1/3 1e-16+1e-16i 9.999999999999998901387711331890276057033E-1-1.098612288668109603248072021584861739285E-16i)
+	   (list -1/2 0 1) (list -1/2 1 -1/2) (list -1/2 2 1/4) (list -1/2 3 -1/8) (list -1/2 -1 -2)
+	   (list -1/2 -2 4) (list -1/2 -3 -8) (list -1/2 1/2 0+0.70710678118655i) (list -1/2 1/3 -0.7937005259841)
+	   (list -1/2 -1/2 0.0-1.414213562373095048801688724209698078569E0i)
+	   (list -1/2 -1/3 6.299605249474366377321206522758126486977E-1-1.09112363597172135294521532465807648133E0i)
+	   (list -1/2 0.0 1.000E0) (list -1/2 1.0 -5.00E-1) (list -1/2 2.0 2.500E-1) (list -1/2 -2.0 4.000E0)
+	   (list -1/2 1e+16 0.0) (list -1/2 +inf.0 0.0)
+	   (list -1/2 0+1i 3.324182700885665525901791766265082328307E-2-2.761202036833300995082465454051316449496E-2i)
+	   (list -1/2 0+2i 3.425953940655147934023229852954811989202E-4-1.835748008898304681163796172161682131024E-3i)
+	   (list -1/2 0-1i 1.780072097764048857359856955378859222048E1+1.478600649942216768260366593652156810413E1i)
+	   (list -1/2 1+1i -1.662091350442832762950895883132541164153E-2+1.380601018416650497541232727025658224748E-2i)
+	   (list -1/2 1-1i -8.900360488820244286799284776894296110238E0-7.393003249711083841301832968260784052065E0i)
+	   (list -1/2 -1+1i -6.648365401771331051803583532530164656613E-2+5.522404073666601990164930908102632898992E-2i)
+	   (list -1/2 -1-1i -3.560144195528097714719713910757718444095E1-2.957201299884433536520733187304313620826E1i)
+	   (list -1/2 0.1+0.1i 6.611643874791633083240145101585573999158E-1+1.651968853835831321053883592233542783317E-1i)
+	   (list -1/2 1e+16+1e+16i 0.0)
+	   (list -1/2 1e-16+1e-16i 9.999999999999996165260165850261967791906E-1+2.448445473029846938952343072863939318955E-16i)
+	   (list -1/3 0 1) (list -1/3 1 -1/3) (list -1/3 2 1/9) (list -1/3 3 -1/27) (list -1/3 -1 -3)
+	   (list -1/3 -2 9) (list -1/3 -3 -27) (list -1/3 1/2 0+0.57735026918963i) (list -1/3 1/3 -0.69336127435063)
+	   (list -1/3 -1/2 0.0-1.732050807568877341601513501094972563495E0i)
+	   (list -1/3 -1/3 7.211247851537042624522227702765802634347E-1-1.249024766483406435214284662923064132397E0i)
+	   (list -1/3 0.0 1.000E0) (list -1/3 1.0 -3.333333333333333148296162562473909929395E-1)
+	   (list -1/3 2.0 1.111111111111110987752997263871498932361E-1) (list -1/3 -2.0 9.000000000000000999200722162640969581442E0)
+	   (list -1/3 1e+16 0.0) (list -1/3 +inf.0 0.0)
+	   (list -1/3 0+1i 1.965509114374261147472076343409745270744E-2-3.848532348622211562482881134707887874423E-2i)
+	   (list -1/3 0+2i -1.094797515970330336653213008135348071651E-3-1.512865081636227660355007437386042651667E-3i)
+	   (list -1/3 0-1i 1.052513729605287263760972225954207976974E1+2.060856958704319103202290360191646176391E1i)
+	   (list -1/3 1+1i -6.551697047914203461214675496548324731564E-3+1.282844116207403782948806637317477237465E-2i)
+	   (list -1/3 1-1i -3.508379098684290684449078029532994204954E0-6.869523195681063296005826865220406716345E0i)
+	   (list -1/3 -1+1i -5.896527343122783769739250113564997536121E-2+1.154559704586663532835802707239006768699E-1i)
+	   (list -1/3 -1-1i -3.15754118881586196656166312914556280733E1-6.182570876112957652808497982451530065146E1i)
+	   (list -1/3 0.1+0.1i 6.408011144159694212372342969009069525835E-1+1.327666945668531521695779387535105337549E-1i)
+	   (list -1/3 1e+16+1e+16i 0.0)
+	   (list -1/3 1e-16+1e-16i 9.999999999999995759795057742097793539085E-1+2.042980364921682582587891581219059394882E-16i)
+	   (list 0.0 0 0.0) (list 0.0 1 0.0) (list 0.0 2 0.0) (list 0.0 3 0.0) (list 0.0 1/2 0.0)
+	   (list 0.0 1/3 0.0) (list 0.0 0.0 0.0) (list 0.0 1.0 0.0) (list 0.0 2.0 0.0)
+	   (list 0.0 1.000000000000000000000000000000000000002E-309 0.0)
+	   (list 0.0 1e+16 0.0) (list 0.0 +inf.0 0.0) (list 0.0 0+1i 0.0)
+	   (list 0.0 0+2i 0.0) (list 0.0 0-1i 0.0) (list 0.0 1+1i 0.0) (list 0.0 1-1i 0.0) (list 0.0 0.1+0.1i 0.0)
+	   (list 0.0 1e+16+1e+16i 0.0) (list 0.0 1e-16+1e-16i 0.0) (list 1.0 0 1.0) (list 1.0 1 1.0)
+	   (list 1.0 2 1.0) (list 1.0 3 1.0) (list 1.0 -1 1.0) (list 1.0 -2 1.0) (list 1.0 -3 1.0)
+	   (list 1.0 1/2 1.0) (list 1.0 1/3 1.0) (list 1.0 -1/2 1.000E0) (list 1.0 -1/3 1.000E0)
+	   (list 1.0 0.0 1.000E0) (list 1.0 1.0 1.000E0) (list 1.0 2.0 1.000E0) (list 1.0 -2.0 1.000E0)
+	   (list 1.0 1.000000000000000000000000000000000000002E-309 1.000E0) (list 1.0 1e+16 1.000E0)
+	   (list 1.0 +inf.0 1.000E0) (list 1.0 -inf.0 1.000E0) (list 1.0 0+1i 1)
+	   (list 1.0 0+2i 1) (list 1.0 0-1i 1) (list 1.0 1+1i 1) (list 1.0 1-1i 1) (list 1.0 -1+1i 1)
+	   (list 1.0 -1-1i 1) (list 1.0 0.1+0.1i 1) (list 1.0 1e+16+1e+16i 1) (list 1.0 1e-16+1e-16i 1)
+	   (list 2.0 0 1.0) (list 2.0 1 2.0) (list 2.0 2 4.000E0) (list 2.0 3 8.000E0) (list 2.0 -1 5.000E-1)
+	   (list 2.0 -2 2.500E-1) (list 2.0 -3 1.250E-1) (list 2.0 1/2 1.4142135623731) (list 2.0 1/3 1.2599210498949)
+	   (list 2.0 -1/2 7.071067811865475244008443621048490392845E-1) (list 2.0 -1/3 7.937005259840997475556964875637659160371E-1)
+	   (list 2.0 0.0 1.000E0) (list 2.0 1.0 2.000E0) (list 2.0 2.0 4.000E0) (list 2.0 -2.0 2.500E-1)
+	   (list 2.0 1.000000000000000000000000000000000000002E-309 1.000E0) (list 2.0 -inf.0 0.0)
+	   (list 2.0 0+1i 7.692389013639721265783299936612707014395E-1+6.389612763136348011500329114647017842567E-1i)
+	   (list 2.0 0+2i 1.83456974743301676839941236809235104518E-1+9.830277404112437205861648503427281526099E-1i)
+	   (list 2.0 0-1i 7.692389013639721265783299936612707014395E-1-6.389612763136348011500329114647017842567E-1i)
+	   (list 2.0 1+1i 1.538477802727944253156659987322541402879E0+1.277922552627269602300065822929403568513E0i)
+	   (list 2.0 1-1i 1.538477802727944253156659987322541402879E0-1.277922552627269602300065822929403568513E0i)
+	   (list 2.0 -1+1i 3.846194506819860632891649968306353507197E-1+3.194806381568174005750164557323508921283E-1i)
+	   (list 2.0 -1-1i 3.846194506819860632891649968306353507197E-1-3.194806381568174005750164557323508921283E-1i)
+	   (list 2.0 0.1+0.1i 1.069199809265204517687304849996528484166E0+7.423020183379063973209835788737470580225E-2i)
+	   (list 2.0 1e-16+1e-16i 1.00000000000000006931471805599452949289E0+6.931471805599453429742233135802455373554E-17i)
+	   (list -2.0 0 1.0) (list -2.0 1 -2.0) (list -2.0 2 4.000E0) (list -2.0 3 -8.00E0)
+	   (list -2.0 -1 -5.00E-1) (list -2.0 -2 2.500E-1) (list -2.0 -3 -1.25E-1) (list -2.0 1/2 0+1.4142135623731i)
+	   (list -2.0 1/3 -1.2599210498949) (list -2.0 -1/2 0.0-7.071067811865475244008443621048490392845E-1i)
+	   (list -2.0 -1/3 3.968502629920499137351498618341152884837E-1-6.873648184993012989383839761489500939792E-1i)
+	   (list -2.0 0.0 1.000E0) (list -2.0 1.0 -2.00E0) (list -2.0 2.0 4.000E0) (list -2.0 -2.0 2.500E-1)
+	   (list -2.0 -inf.0 0.0) (list -2.0 0+1i 3.324182700885665525901791766265082328307E-2+2.761202036833300995082465454051316449496E-2i)
+	   (list -2.0 0+2i 3.425953940655147934023229852954811989202E-4+1.835748008898304681163796172161682131024E-3i)
+	   (list -2.0 0-1i 1.780072097764048857359856955378859222048E1-1.478600649942216768260366593652156810413E1i)
+	   (list -2.0 1+1i -6.648365401771331051803583532530164656613E-2-5.522404073666601990164930908102632898992E-2i)
+	   (list -2.0 1-1i -3.560144195528097714719713910757718444095E1+2.957201299884433536520733187304313620826E1i)
+	   (list -2.0 -1+1i -1.662091350442832762950895883132541164153E-2-1.380601018416650497541232727025658224748E-2i)
+	   (list -2.0 -1-1i -8.900360488820244286799284776894296110238E0+7.393003249711083841301832968260784052065E0i)
+	   (list -2.0 0.1+0.1i 7.259699150688950609812198701314241029302E-1+2.928900391985359860022641767906842987898E-1i)
+	   (list -2.0 1e+16+1e+16i 0.0)
+	   (list -2.0 1e-16+1e-16i 9.999999999999997551554526970151686615297E-1+3.834739834149737528810186916384012655492E-16i)
+	   (list 1.000000000000000000000000000000000000002E-309 0 1.0)
+	   (list 1.000000000000000000000000000000000000002E-309 1 1.000000000000000000000000000000000000002E-309)
+	   (list 1.000000000000000000000000000000000000002E-309 2 1.000000000000000000000000000000000000006E-618)
+	   (list 1.000000000000000000000000000000000000002E-309 3 1.000000000000000000000000000000000000006E-927)
+	   (list 1.000000000000000000000000000000000000002E-309 1/2 3.162277660168379331998893544432718533725E-155)
+	   (list 1.000000000000000000000000000000000000002E-309 1/3 1.000000000000000000000000000000000000001E-103)
+	   (list 1.000000000000000000000000000000000000002E-309 -1/2 3.162277660168379331998893544432718533715E154)
+	   (list 1.000000000000000000000000000000000000002E-309 -1/3 9.999999999999868346276200367559315452517E102)
+	   (list 1.000000000000000000000000000000000000002E-309 0.0 1.000E0)
+	   (list 1.000000000000000000000000000000000000002E-309 1.0 1.000000000000000000000000000000000000002E-309)
+	   (list 1.000000000000000000000000000000000000002E-309 2.0 1.000000000000000000000000000000000000006E-618)
+	   (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309 1.000E0)
+	   (list 1.000000000000000000000000000000000000002E-309 1e+16 0.0) (list 1.000000000000000000000000000000000000002E-309 +inf.0 0.0)
+	   (list 1.000000000000000000000000000000000000002E-309 0+1i 7.188026041688456386956035152151008205727E-2-9.974132684912512522858369772702724490842E-1i)
+	   (list 1.000000000000000000000000000000000000002E-309 0+2i -9.896664563248017162886921042023427507381E-1-1.433886509648142863446390724753118562651E-1i)
+	   (list 1.000000000000000000000000000000000000002E-309 0-1i 7.188026041688456386956035152151008205727E-2+9.974132684912512522858369772702724490842E-1i)
+	   (list 1.000000000000000000000000000000000000002E-309 1+1i 7.188026041688456386956035152151008205733E-311-9.974132684912512522858369772702724490883E-310i)
+	   (list 1.000000000000000000000000000000000000002E-309 1-1i 7.188026041688456386956035152151008205733E-311+9.974132684912512522858369772702724490883E-310i)
+	   (list 1.000000000000000000000000000000000000002E-309 0.1+0.1i -5.63455610426506242496256141630861088283E-32-1.125793483521731083006048050604051624164E-31i)
+	   (list 1.000000000000000000000000000000000000002E-309 1e+16+1e+16i 0.0)
+	   (list 1.000000000000000000000000000000000000002E-309 1e-16+1e-16i 9.999999999999288501206264839898510340166E-1-7.114987937351094784363111696637191907549E-14i)
+	   (list 1e+16 0 1.0) (list 1e+16 1 1e+16) (list 1e+16 2 1.000E32) (list 1e+16 3 1.000E48)
+	   (list 1e+16 -1 1.000000000000000000000000000000000000001E-16) (list 1e+16 -2 9.999999999999999999999999999999999999998E-33)
+	   (list 1e+16 -3 9.999999999999999999999999999999999999991E-49) (list 1e+16 1/2 100000000.0)
+	   (list 1e+16 1/3 215443.46900319) (list 1e+16 -1/2 9.99999999999999999999999999999999999999E-9)
+	   (list 1e+16 -1/3 4.641588833612782056591069448235278756067E-6) (list 1e+16 0.0 1.000E0)
+	   (list 1e+16 1.0 1.000E16) (list 1e+16 2.0 1.000E32) (list 1e+16 -2.0 9.999999999999999999999999999999999999998E-33)
+	   (list 1e+16 1.000000000000000000000000000000000000002E-309 1.000E0) (list 1e+16 -inf.0 0.0)
+	   (list 1e+16 0+1i 6.541406923671771082966425998087477095845E-1-7.563728938753623529733450264648351927405E-1i)
+	   (list 1e+16 0+2i -1.441999091787803208994630162235380065937E-1-9.895485769747898065837021120946943010267E-1i)
+	   (list 1e+16 0-1i 6.541406923671771082966425998087477095845E-1+7.563728938753623529733450264648351927405E-1i)
+	   (list 1e+16 1+1i 6.541406923671771082966425998087477095832E15-7.563728938753623529733450264648351927387E15i)
+	   (list 1e+16 1-1i 6.541406923671771082966425998087477095832E15+7.563728938753623529733450264648351927387E15i)
+	   (list 1e+16 -1+1i 6.541406923671771082966425998087477095825E-17-7.563728938753623529733450264648351927399E-17i)
+	   (list 1e+16 -1-1i 6.541406923671771082966425998087477095825E-17+7.563728938753623529733450264648351927399E-17i)
+	   (list 1e+16 0.1+0.1i -3.409382666305111714726686098434812471081E1-2.055490637125206804018448749591854294103E1i)
+	   (list 1e+16 1e-16+1e-16i 1.000000000000003684136148790473017422188E0+3.684136148790486590281349632497736627823E-15i)
+	   (list +inf.0 0 1.0) (list +inf.0 -1 0.0) (list +inf.0 -2 0.0)
+	   (list +inf.0 -3 0.0) (list +inf.0 -1/2 0.0) (list +inf.0 -1/3 0.0) (list +inf.0 0.0 1.000E0)
+	   (list +inf.0 -2.0 0.0) (list +inf.0 -inf.0 0.0)
+           (list +inf.0 -1+1i (if with-bignums +nan.0+nan.0i 0.0)) (list +inf.0 -1-1i (if with-bignums +nan.0+nan.0i 0.0))
+	   (list -inf.0 0 1.0) (list -inf.0 -1 0.0) (list -inf.0 -2 0.0) (list -inf.0 -3 0.0)
+	   (list -inf.0 -1/2 0.0) (list -inf.0 -1/3 0.0) (list -inf.0 0.0 1.000E0) (list -inf.0 -2.0 0.0)
+	   (list -inf.0 -inf.0 0.0)
+           (list -inf.0 -1+1i (if with-bignums +nan.0+nan.0i 0.0)) (list -inf.0 -1-1i (if with-bignums +nan.0+nan.0i 0.0))
+           (list 0+1i 0 1.0)
+	   (list 0+1i 1 0+1i) (list 0+1i 2 -1.00E0) (list 0+1i 3 0.0-1.00E0i) (list 0+1i -1 0.0-1.00E0i)
+	   (list 0+1i -2 -1.00E0) (list 0+1i -3 0.0+1.000E0i) (list 0+1i 1/2 0.70710678118655+0.70710678118655i)
+	   (list 0+1i 1/3 8.660254037844386612965085791222353988232E-1+4.999999999999999748284772972087582646907E-1i)
+	   (list 0+1i -1/2 7.071067811865475244008443621048490392845E-1-7.071067811865475244008443621048490392845E-1i)
+	   (list 0+1i -1/3 8.660254037844386612965085791222353988232E-1-4.999999999999999748284772972087582646907E-1i)
+	   (list 0+1i 0.0 1.000E0) (list 0+1i 1.0 0.0+1.000E0i) (list 0+1i 2.0 -1.00E0) (list 0+1i -2.0 -1.00E0)
+	   (list 0+1i 1.000000000000000000000000000000000000002E-309 1.000E0+1.570796326794896619231321691639751442098E-309i)
+					;(list 0+1i 1e+16 1.000E0)
+	   (list 0+1i 0+1i 2.078795763507619085469556198349787700342E-1)
+	   (list 0+1i 0+2i 4.321391826377224977441773717172801127579E-2) (list 0+1i 0-1i 4.810477380965351655473035666703833126401E0)
+	   (list 0+1i 1+1i 0.0+2.078795763507619085469556198349787700342E-1i) (list 0+1i 1-1i 0.0+4.810477380965351655473035666703833126401E0i)
+	   (list 0+1i -1+1i 0.0-2.078795763507619085469556198349787700342E-1i) (list 0+1i -1-1i 0.0-4.810477380965351655473035666703833126401E0i)
+	   (list 0+1i 0.1+0.1i 8.441140118165246481415723784169170682829E-1+1.336945253316592796595429310740609657101E-1i)
+	   (list 0+1i 1e+16+1e+16i 0.0) (list 0+1i 1e-16+1e-16i 9.999999999999998429203673205103413601794E-1+1.570796326794896339658091828635841709635E-16i)
+	   (list 0+2i 0 1.0) (list 0+2i 1 0+2i) (list 0+2i 2 -4.00E0) (list 0+2i 3 0.0-8.00E0i)
+	   (list 0+2i -1 0.0-5.00E-1i) (list 0+2i -2 -2.50E-1) (list 0+2i -3 0.0+1.250E-1i)
+	   (list 0+2i 1/2 1+1i) (list 0+2i 1/3 1.09112363597172140787570207348670009638E0+6.299605249474365425897267188156853709001E-1i)
+	   (list 0+2i -1/2 5.000E-1-5.00E-1i) (list 0+2i -1/3 6.873648184993013335424222440592397343418E-1-3.968502629920498537991974347557662898919E-1i)
+	   (list 0+2i 0.0 1.000E0) (list 0+2i 1.0 0.0+2.000E0i) (list 0+2i 2.0 -4.00E0) (list 0+2i -2.0 -2.50E-1)
+	   (list 0+2i 1.000000000000000000000000000000000000002E-309 1.000E0+1.570796326794896619231321691639751442098E-309i)
+	   (list 0+2i -inf.0 0.0) (list 0+2i 0+1i 1.599090569280680525199117755445296515815E-1+1.328269994246205222492823642245871455648E-1i)
+	   (list 0+2i 0+2i 7.927894711475968677072935966913922424434E-3+4.248048042515221109836149914964543748435E-2i)
+	   (list 0+2i 0-1i 3.700406335570025108741522919010577122043E0-3.073708767019492322385562434551223151799E0i)
+	   (list 0+2i 1+1i -2.656539988492410444985647284491742911296E-1+3.19818113856136105039823551089059303163E-1i)
+	   (list 0+2i 1-1i 6.147417534038984644771124869102446303599E0+7.400812671140050217483045838021154244087E0i)
+	   (list 0+2i -1+1i 6.641349971231026112464118211229357278239E-2-7.995452846403402625995588777226482579074E-2i)
+	   (list 0+2i -1-1i -1.5368543835097461611927812172756115759E0-1.850203167785012554370761459505288561022E0i)
+	   (list 0+2i 0.1+0.1i 8.926023688328728424160522546503419745435E-1+2.056049144522835172454080598405456305612E-1i)
+	   (list 0+2i 1e+16+1e+16i 0.0) (list 0+2i 1e-16+1e-16i 9.999999999999999122350853765048490772098E-1+2.263943507354841682632315142216062597333E-16i)
+	   (list 0-1i 0 1.0) (list 0-1i 1 0-1i) (list 0-1i 2 -1.00E0) (list 0-1i 3 0.0+1.000E0i)
+	   (list 0-1i -1 0.0+1.000E0i) (list 0-1i -2 -1.00E0) (list 0-1i -3 0.0-1.00E0i) (list 0-1i 1/2 0.70710678118655-0.70710678118655i)
+	   (list 0-1i 1/3 8.660254037844386612965085791222353988232E-1-4.999999999999999748284772972087582646907E-1i)
+	   (list 0-1i -1/2 7.071067811865475244008443621048490392845E-1+7.071067811865475244008443621048490392845E-1i)
+	   (list 0-1i -1/3 8.660254037844386612965085791222353988232E-1+4.999999999999999748284772972087582646907E-1i)
+	   (list 0-1i 0.0 1.000E0) (list 0-1i 1.0 0.0-1.00E0i) (list 0-1i 2.0 -1.00E0) (list 0-1i -2.0 -1.00E0)
+	   (list 0-1i 1.000000000000000000000000000000000000002E-309 1.000E0-1.570796326794896619231321691639751442098E-309i)
+					;(list 0-1i 1e+16 1.000E0)
+	   (list 0-1i 0+1i 4.810477380965351655473035666703833126401E0)
+	   (list 0-1i 0+2i 2.314069263277926900572908636794854738031E1) (list 0-1i 0-1i 2.078795763507619085469556198349787700342E-1)
+	   (list 0-1i 1+1i 0.0-4.810477380965351655473035666703833126401E0i) (list 0-1i 1-1i 0.0-2.078795763507619085469556198349787700342E-1i)
+	   (list 0-1i -1+1i 0.0+4.810477380965351655473035666703833126401E0i) (list 0-1i -1-1i 0.0+2.078795763507619085469556198349787700342E-1i)
+	   (list 0-1i 0.1+0.1i 1.15568305287131774105188044357174956096E0-1.830422135215751576397991439148491080012E-1i)
+	   (list 0-1i 1e-16+1e-16i 1.000000000000000157079632679489658639818E0-1.570796326794896833138311883103752021701E-16i)
+	   (list 1+1i 0 1.0) (list 1+1i 1 1+1i) (list 1+1i 2 0.0+2.000E0i) (list 1+1i 3 -2.00E0+2.000E0i)
+	   (list 1+1i -1 5.000E-1-5.00E-1i) (list 1+1i -2 0.0-5.00E-1i) (list 1+1i -3 -2.50E-1-2.50E-1i)
+	   (list 1+1i 1/2 1.0986841134678+0.45508986056223i)
+	   (list 1+1i 1/3 1.084215081491351179148689172984121435876E0+2.905145555072514268841073782856571173254E-1i)
+	   (list 1+1i -1/2 7.768869870150186536720794765315734740815E-1-3.217971264527913123677217187091049044625E-1i)
+	   (list 1+1i -1/3 8.605420804595790018414012402960957705697E-1-2.305815555121423995608566442452670487351E-1i)
+	   (list 1+1i 0.0 1.000E0) (list 1+1i 1.0 1.000E0+1.000E0i) (list 1+1i 2.0 0.0+2.000E0i)
+	   (list 1+1i -2.0 0.0-5.00E-1i)
+	   (list 1+1i 1.000000000000000000000000000000000000002E-309 1.000E0+7.853981633974483096156608458198757210488E-310i)
+	   (list 1+1i -inf.0 0.0) (list 1+1i 0+1i 4.288290062943678493226520070973354996125E-1+1.548717524642467781923098896798325813036E-1i)
+	   (list 1+1i 0+2i 1.599090569280680525199117755445296515815E-1+1.328269994246205222492823642245871455648E-1i)
+	   (list 1+1i 0-1i 2.062872235080904951706990637170143171029E0-7.450070621797240878593548325920103204625E-1i)
+	   (list 1+1i 1+1i 2.739572538301210711303421174175029183081E-1+5.837007587586146275149618967771680809154E-1i)
+	   (list 1+1i 1-1i 2.807879297260629039566345469762153491497E0+1.317865172901180863847635804578132850572E0i)
+	   (list 1+1i -1+1i 2.918503793793073137574809483885840404577E-1-1.369786269150605355651710587087514591541E-1i)
+	   (list 1+1i -1-1i 6.589325864505904319238179022890664252861E-1-1.403939648630314519783172734881076745749E0i)
+	   (list 1+1i 0.1+0.1i 9.509412581367732262071184402582209392577E-1+1.08106001655210286400223506650660553711E-1i)
+	   (list 1+1i 1e+16+1e+16i 0.0) (list 1+1i 1e-16+1e-16i 9.99999999999999956117542688252429982572E-1+1.131971753677420890989859729961488955736E-16i)
+	   (list 1-1i 0 1.0) (list 1-1i 1 1-1i) (list 1-1i 2 0.0-2.00E0i) (list 1-1i 3 -2.00E0-2.00E0i)
+	   (list 1-1i -1 5.000E-1+5.000E-1i) (list 1-1i -2 0.0+5.000E-1i) (list 1-1i -3 -2.50E-1+2.500E-1i)
+	   (list 1-1i 1/2 1.0986841134678-0.45508986056223i)
+	   (list 1-1i 1/3 1.084215081491351179148689172984121435876E0-2.905145555072514268841073782856571173254E-1i)
+	   (list 1-1i -1/2 7.768869870150186536720794765315734740815E-1+3.217971264527913123677217187091049044625E-1i)
+	   (list 1-1i -1/3 8.605420804595790018414012402960957705697E-1+2.305815555121423995608566442452670487351E-1i)
+	   (list 1-1i 0.0 1.000E0) (list 1-1i 1.0 1.000E0-1.00E0i) (list 1-1i 2.0 0.0-2.00E0i)
+	   (list 1-1i -2.0 0.0+5.000E-1i)
+	   (list 1-1i 1.000000000000000000000000000000000000002E-309 1.000E0-7.853981633974483096156608458198757210488E-310i)
+	   (list 1-1i -inf.0 0.0) (list 1-1i 0+1i 2.062872235080904951706990637170143171029E0+7.450070621797240878593548325920103204625E-1i)
+	   (list 1-1i 0+2i 3.700406335570025108741522919010577122043E0+3.073708767019492322385562434551223151799E0i)
+	   (list 1-1i 0-1i 4.288290062943678493226520070973354996125E-1-1.548717524642467781923098896798325813036E-1i)
+	   (list 1-1i 1+1i 2.807879297260629039566345469762153491497E0-1.317865172901180863847635804578132850572E0i)
+	   (list 1-1i 1-1i 2.739572538301210711303421174175029183081E-1-5.837007587586146275149618967771680809154E-1i)
+	   (list 1-1i -1+1i 6.589325864505904319238179022890664252861E-1+1.403939648630314519783172734881076745749E0i)
+	   (list 1-1i -1-1i 2.918503793793073137574809483885840404577E-1+1.369786269150605355651710587087514591541E-1i)
+	   (list 1-1i 0.1+0.1i 1.118774658142734663065880800594211744947E0-4.912611879174141197780391086654035970153E-2i)
+	   (list 1-1i 1e-16+1e-16i 1.000000000000000113197175367742099510321E0-4.388245731174756954083421259082963337401E-17i)
+	   (list -1+1i 0 1.0) (list -1+1i 1 -1+1i) (list -1+1i 2 0.0-2.00E0i) (list -1+1i 3 2.000E0+2.000E0i)
+	   (list -1+1i -1 -5.00E-1-5.00E-1i) (list -1+1i -2 0.0+5.000E-1i) (list -1+1i -3 2.500E-1-2.50E-1i)
+	   (list -1+1i 1/2 0.45508986056223+1.0986841134678i)
+	   (list -1+1i 1/3 7.937005259840997668899692535826356354889E-1+7.937005259840996976818927177620594283082E-1i)
+	   (list -1+1i -1/2 3.217971264527913123677217187091049044625E-1-7.768869870150186536720794765315734740815E-1i)
+	   (list -1+1i -1/3 6.299605249474366138887223148884515164688E-1-6.299605249474365589582355660598282273075E-1i)
+	   (list -1+1i 0.0 1.000E0) (list -1+1i 1.0 -1.00E0+1.000E0i) (list -1+1i 2.0 0.0-2.00E0i)
+	   (list -1+1i -2.0 0.0+5.000E-1i)
+	   (list -1+1i 1.000000000000000000000000000000000000002E-309 1.000E0+2.35619449019234492884698253745962716315E-309i)
+	   (list -1+1i -inf.0 0.0) (list -1+1i 0+1i 8.914479215539140039333169785416699948907E-2+3.219467429096768688435430339284927790439E-2i)
+	   (list -1+1i 0+2i 6.910296915726436425237112293342453374671E-3+5.7399750963576748986151091014202337188E-3i)
+	   (list -1+1i 0-1i 9.923400226678132867281183645053121674554E0-3.583839621275010020102858511593195855531E0i)
+	   (list -1+1i 1+1i -1.213394664463590872776860012470162773935E-1+5.695011786442371350897739446131772158468E-2i)
+	   (list -1+1i 1-1i -6.339560605403122847178325133459925819034E0+1.350723984795314288738404215664631753007E1i)
+	   (list -1+1i -1+1i -2.847505893221185675448869723065886079234E-2-6.066973322317954363884300062350813869673E-2i)
+	   (list -1+1i -1-1i -6.753619923976571443692021078323158765037E0-3.169780302701561423589162566729962909517E0i)
+	   (list -1+1i 0.1+0.1i 7.882496598308880991233017323974702727041E-1+2.1838943088351018304792416348997040808E-1i)
+	   (list -1+1i 1e+16+1e+16i 0.0)
+	   (list -1+1i 1e-16+1e-16i 9.999999999999997990379100087627604548201E-1+2.702768080472316983907841531363385588262E-16i)
+	   (list -1-1i 0 1.0) (list -1-1i 1 -1-1i) (list -1-1i 2 0.0+2.000E0i) (list -1-1i 3 2.000E0-2.00E0i)
+	   (list -1-1i -1 -5.00E-1+5.000E-1i) (list -1-1i -2 0.0-5.00E-1i) (list -1-1i -3 2.500E-1+2.500E-1i)
+	   (list -1-1i 1/2 0.45508986056223-1.0986841134678i)
+	   (list -1-1i 1/3 7.937005259840997668899692535826356354889E-1-7.937005259840996976818927177620594283082E-1i)
+	   (list -1-1i -1/2 3.217971264527913123677217187091049044625E-1+7.768869870150186536720794765315734740815E-1i)
+	   (list -1-1i -1/3 6.299605249474366138887223148884515164688E-1+6.299605249474365589582355660598282273075E-1i)
+	   (list -1-1i 0.0 1.000E0) (list -1-1i 1.0 -1.00E0-1.00E0i) (list -1-1i 2.0 0.0+2.000E0i)
+	   (list -1-1i -2.0 0.0-5.00E-1i) (list -1-1i 1.000000000000000000000000000000000000002E-309 1.000E0-2.35619449019234492884698253745962716315E-309i)
+	   (list -1-1i -inf.0 0.0) (list -1-1i 0+1i 9.923400226678132867281183645053121674554E0+3.583839621275010020102858511593195855531E0i)
+	   (list -1-1i 0+2i 8.562996562781501151982322359385576132148E1+7.112774982027701655978420905114385775416E1i)
+	   (list -1-1i 0-1i 8.914479215539140039333169785416699948907E-2-3.219467429096768688435430339284927790439E-2i)
+	   (list -1-1i 1+1i -6.339560605403122847178325133459925819034E0-1.350723984795314288738404215664631753007E1i)
+	   (list -1-1i 1-1i -1.213394664463590872776860012470162773935E-1-5.695011786442371350897739446131772158468E-2i)
+	   (list -1-1i -1+1i -6.753619923976571443692021078323158765037E0+3.169780302701561423589162566729962909517E0i)
+	   (list -1-1i -1-1i -2.847505893221185675448869723065886079234E-2+6.066973322317954363884300062350813869673E-2i)
+	   (list -1-1i 0.1+0.1i 1.283956758872096257591990187677552600208E0-2.615572127992484175251616566885584992446E-1i)
+	   (list -1-1i 1e-16+1e-16i 1.000000000000000270276808047231769038073E0-2.009620899912372775286764036246047795846E-16i)
+	   (list 0.1+0.1i 0 1.0) (list 0.1+0.1i 1 0.1+0.1i) (list 0.1+0.1i 2 0.0+2.000000000000000222044604925031314247702E-2i)
+	   (list 0.1+0.1i 3 -2.000000000000000333066907387546980616012E-3+2.000000000000000333066907387546980616012E-3i)
+	   (list 0.1+0.1i -1 4.999999999999999722444243843710880301532E0-4.999999999999999722444243843710880301532E0i)
+	   (list 0.1+0.1i -2 0.0-4.999999999999999444888487687421776010503E1i)
+	   (list 0.1+0.1i -3 -2.499999999999999583666365765566343563457E2-2.499999999999999583666365765566343563457E2i)
+	   (list 0.1+0.1i 1/2 0.34743442276012+0.14391204994251i)
+	   (list 0.1+0.1i 1/3 5.032480615484825043523903544407412355396E-1+1.348449116844438143505188591437346924604E-1i)
+	   (list 0.1+0.1i -1/2 2.45673236351311521671469493547019420871E0-1.017611864088040968689409531603674348818E0i)
+	   (list 0.1+0.1i -1/3 1.853981710374325315321217484547221353494E0-4.967729020768720696346827580207236635648E-1i)
+	   (list 0.1+0.1i 0.0 1.000E0) (list 0.1+0.1i 1.0 1.000000000000000055511151231257827021182E-1+1.000000000000000055511151231257827021182E-1i)
+	   (list 0.1+0.1i 2.0 0.0+2.000000000000000222044604925031314247702E-2i) (list 0.1+0.1i -2.0 0.0-4.999999999999999444888487687421776010503E1i)
+	   (list 0.1+0.1i 1.000000000000000000000000000000000000002E-309 1.000E0+7.853981633974483096156608458198757210488E-310i)
+	   (list 0.1+0.1i 1e+16 0.0) (list 0.1+0.1i +inf.0 (if with-bignums +nan.0+nan.0i 0.0))
+	   (list 0.1+0.1i 0+1i -1.713226510357599956083331913106303247236E-1-4.22525887482460786856087271691853977193E-1i)
+	   (list 0.1+0.1i 0+2i -1.491766748349203175549260651566533449245E-1+1.447765103494648437770214174856742113327E-1i)
+	   (list 0.1+0.1i 0-1i -8.241437376545436347801862567004657850891E-1+2.032551224606688826869616254728598600103E0i)
+	   (list 0.1+0.1i 1+1i 2.512032364467008051923349285554493285946E-2-5.938485385182208154296364931488770060654E-2i)
+	   (list 0.1+0.1i 1-1i -2.856694962261232620228228583084710444815E-1+1.208407486952145259169520755212883935691E-1i)
+	   (list 0.1+0.1i -1+1i -2.969242692591103747496022164280467138525E0-1.256016182233503886515866161034993752114E0i)
+	   (list 0.1+0.1i -1-1i 6.042037434760725625046696204216927090118E0+1.428347481130616151535688219886713564214E1i)
+	   (list 0.1+0.1i 0.1+0.1i 7.550220306566742029451631510549876832316E-1-8.878982993466537268563019824356751882119E-2i)
+	   (list 0.1+0.1i 1e+16+1e+16i 0.0)
+	   (list 0.1+0.1i 1e-16+1e-16i 9.999999999999997258590333888479081137213E-1-1.170613339316624318801081266623392933101E-16i)
+	   (list 1e+16+1e+16i 0 1.0) (list 1e+16+1e+16i 1 1e+16+1e+16i) (list 1e+16+1e+16i 2 0.0+2.000E32i)
+	   (list 1e+16+1e+16i 3 -2.00E48+2.000E48i)
+	   (list 1e+16+1e+16i -1 5.000000000000000000000000000000000000004E-17-5.000000000000000000000000000000000000004E-17i)
+	   (list 1e+16+1e+16i -2 0.0-4.999999999999999999999999999999999999999E-33i)
+	   (list 1e+16+1e+16i -3 -2.499999999999999999999999999999999999998E-49-2.499999999999999999999999999999999999998E-49i)
+	   (list 1e+16+1e+16i 1/2 109868411.34678+45508986.056223i)
+	   (list 1e+16+1e+16i 1/3 2.335870583020711134947889498537726801442E5+6.258946363440152792122310286091229534238E4i)
+	   (list 1e+16+1e+16i -1/2 7.76886987015018653672079476531573474081E-9-3.217971264527913123677217187091049044617E-9i)
+	   (list 1e+16+1e+16i -1/3 3.994282511515094148675512812353991597295E-6-1.070264773302225997506194769200154785053E-6i)
+	   (list 1e+16+1e+16i 0.0 1.000E0) (list 1e+16+1e+16i 1.0 1.000E16+1.000E16i) (list 1e+16+1e+16i 2.0 0.0+2.000E32i)
+	   (list 1e+16+1e+16i -2.0 0.0-4.999999999999999999999999999999999999999E-33i)
+	   (list 1e+16+1e+16i 1.000000000000000000000000000000000000002E-309 1.000E0+7.853981633974483096156608458198757210488E-310i)
+	   (list 1e+16+1e+16i -inf.0 0.0)
+	   (list 1e+16+1e+16i 0+1i 3.97655298675457451476815297378330384373E-1-2.23046721083486532799277949440696753733E-1i)
+	   (list 1e+16+1e+16i 0+2i 1.083798967785726369788640263558841648425E-1-1.773914209820705797251910148995630479122E-1i)
+	   (list 1e+16+1e+16i 0-1i 1.912911819699309232365644880468914363155E0+1.072961206670599579011330828139081101248E0i)
+	   (list 1e+16+1e+16i 1+1i 6.207020197589439842760932468190271381067E15+1.746085775919709186775373479376336306396E15i)
+	   (list 1e+16+1e+16i 1-1i 8.39950613028709653354314052329833261908E15+2.985873026369908811376975708607995464407E16i)
+	   (list 1e+16+1e+16i -1+1i 8.730428879598545933876867396881681532013E-18-3.103510098794719921380466234095135690525E-17i)
+	   (list 1e+16+1e+16i -1-1i 1.492936513184954405688487854303997732202E-16-4.19975306514354826677157026164916630953E-17i)
+	   (list 1e+16+1e+16i 0.1+0.1i -3.019911767946562559553699791129052056384E1-2.323225580723027414176687762549620584343E1i)
+	   (list 1e+16+1e+16i 1e-16+1e-16i 1.000000000000003640253691478724868702006E0+3.797333324158228934745194038802400084708E-15i)
+	   (list 1e-16+1e-16i 0 1.0) (list 1e-16+1e-16i 1 1e-16+1e-16i) (list 1e-16+1e-16i 2 0.0+1.999999999999999916391146896138415121169E-32i)
+	   (list 1e-16+1e-16i 3 -1.999999999999999874586720344207623992465E-48+1.999999999999999874586720344207623992465E-48i)
+	   (list 1e-16+1e-16i -1 5.000000000000000104511066379826984375319E15-5.000000000000000104511066379826984375319E15i)
+	   (list 1e-16+1e-16i -2 0.0-5.00000000000000020902213275965397093513E31i)
+	   (list 1e-16+1e-16i -3 -2.500000000000000156766599569740479839725E47-2.500000000000000156766599569740479839725E47i)
+	   (list 1e-16+1e-16i 1/2 1.0986841134678e-08+4.5508986056223e-09i)
+	   (list 1e-16+1e-16i 1/3 5.032480615484828131577934532998162284517E-6+1.348449116844438970946772378503363059943E-6i)
+	   (list 1e-16+1e-16i -1/2 7.768869870150186617914082234866133300043E7-3.217971264527913157308578030636299721171E7i)
+	   (list 1e-16+1e-16i -1/3 1.853981710374324177672385518009559821262E5-4.967729020768717648025969623769604859166E4i)
+	   (list 1e-16+1e-16i 0.0 1.000E0) (list 1e-16+1e-16i 1.0 9.999999999999999790977867240346035618411E-17+9.999999999999999790977867240346035618411E-17i)
+	   (list 1e-16+1e-16i 2.0 0.0+1.999999999999999916391146896138415121169E-32i) (list 1e-16+1e-16i -2.0 0.0-5.00000000000000020902213275965397093513E31i)
+	   (list 1e-16+1e-16i 1.000000000000000000000000000000000000002E-309 1.000E0+7.853981633974483096156608458198757210488E-310i)
+	   (list 1e-16+1e-16i 1e+16 0.0) (list 1e-16+1e-16i +inf.0 (if with-bignums +nan.0+nan.0i 0.0))
+	   (list 1e-16+1e-16i 0+1i 1.633737074935952277071942452600366041402E-1+4.256625518536474393286932017574035701805E-1i)
+	   (list 1e-16+1e-16i 0+2i -1.544976397503562816275493845355474590488E-1+1.390841384750302156856253710476447606724E-1i)
+	   (list 1e-16+1e-16i 0-1i 7.859055245423894167511168257029299588438E-1-2.047640077615962126490396474363177248838E0i)
+	   (list 1e-16+1e-16i 1+1i -2.622888443600522061390815917770620324788E-17+5.890362593472426547237259268645081580369E-17i)
+	   (list 1e-16+1e-16i 1-1i 2.833545602158351484014138796578448096738E-16-1.26173455307357268336623492266154970137E-16i)
+	   (list 1e-16+1e-16i -1+1i 2.945181296736213396740244835851862239781E15+1.311444221800261085519581606088360070987E15i)
+	   (list 1e-16+1e-16i -1-1i -6.308672765367863680561621873294727149409E15-1.416772801079175801234443901776883778303E16i)
+	   (list 1e-16+1e-16i 0.1+0.1i -2.185846675892145203322615268234771243738E-2+1.000746379588156995072970612624735653063E-2i)
+	   (list 1e-16+1e-16i 1e+16+1e+16i 0.0)
+	   (list 1e-16+1e-16i 1e-16+1e-16i 9.999999999999962719813938977799891729155E-1-3.570938973422717612919117771011138615376E-15i)
+	     )))
+
+;; there's a difference here between gmp/non-gmp:
+; (test (expt 0 (real-part (log 0))) (expt 0.0 (real-part (log 0))))
+; (num-test (expt 1.0 (/ (real-part (log 0)) (real-part (log 0)))) (expt 1 (/ (real-part (log 0)) (real-part (log 0)))))
+; (num-test (expt 0.0 (/ (real-part (log 0)) (real-part (log 0)))) (expt 0 (/ (real-part (log 0)) (real-part (log 0)))))
+
+#|
+(let ((eps 1e-7))
+  (do ((i 0 (+ i 1)))
+      ((= i 1000))
+    (let ((val (- (random 1000.0) 500.0)))
+      (let ((rval (rationalize val))
+	    (ival (floor val)))
+	(let ((frval (exact->inexact rval))
+	      (fival (exact->inexact ival)))
+	  (for-each
+	   (lambda (e)
+	     (if (> (magnitude (- (expt rval e) (expt frval e))) eps)
+		 (format #t "~A: ;(expt ~A e) != (expt ~A e) -> ~A~%" e rval frval (magnitude (- (expt rval e) (expt frval e)))))
+	     (if (> (magnitude (- (expt ival e) (expt fival e))) eps)
+		 (format #t "~A ;(expt ~A e) != (expt ~A e) -> ~A~%" e ival fival (magnitude (- (expt ival e) (expt fival e))))))
+	   (list 0 0.0 (log 0) (real-part (log 0)) (- (real-part (log 0))))))))))
+|#
+
+  ;; table[(1/10^k)/(((1/10^k)^(1/10^k)) - 1), {k, 1, 30}]
+  ;;   the test came from calc_errors.txt from the web by "dave"
+  (let ((expts (list
+		-0.48621160938616180680870317336747983548142173621715706851490974881717
+		-0.22218561601345857583044966876729715619642038672598556073380084629504
+		-0.14526540294689938889864991134840220307566223888497162784858064408875
+		-0.10862362815109649171007844591526444220973735508130191198062253212652
+		-0.08686389647659141105044978528770239308857034812798554177686261943193
+		-0.07238291365169326382168151357331039782973682143307349669152489742891
+		-0.06204211884333512141082278643490234288550259196615819050849846987015
+		-0.05428681523790663196206398113420109019962541643547760927657854324749
+		-0.04825494293369464924373092184737925979664303236414611590980578553450
+		-0.04342944824032518278430110099994422226122739720915846151097610557365
+		-0.03948131654165925705940460838351885560840418164027583205682137097699
+		-0.03619120682577098563759637916147675090355043511246085981138602579761
+		-0.03340726783876167905008686486133377017608955166698061593202699553920
+		-0.03102103442166584483222349447696386196557178259759899539894506586562
+		-0.02895296546021728851007526126398523685253569082526692705926181546848
+		-0.02714340511895328922819555743231851877797306680518273360154914602559
+		-0.02554673422960305368536052464215356633451937057629542604571806752914
+		-0.02412747121684732425839605105092250802578858425793889081112350331353
+		-0.02285760431069746466321731152192658331511007129540571803806313398860
+		-0.02171472409516259138755644594583025411510361447234900258639235440074
+		-0.02068068961444056322198232947221928963307055360980162368063530687389
+		-0.01974065826832962852964676904166386737701808793240851850210059107980
+		-0.01888236877840225337614103995289587314323465286757518193028428290776
+		-0.01809560341263549281879753828819187842893320857975794377409033233328
+		-0.01737177927613007310604520675666420329177588023219463316734886061171
+		-0.01670363391935583952504342495833096470363065406937228989783888395986
+		-0.01608498081123154917226403453394833638127396317791358170357400676126
+		-0.01551051721083042241611174715416446722479989306441666312924319204483
+		-0.01497567178976730440176306617453810628601368985529884710795141610434
+		-0.01447648273010839425503763063105350274314656686012221887048754923492)))
+    (let ((happy #t))
+      (do ((i 1 (+ i 1)))
+	  ((or (= i (length expts))
+	       (not happy)))
+	(catch #t
+	       (lambda ()
+		 (let ((val (/ (expt .1 i)
+			       (- (expt (expt .1 i) (expt .1 i)) 1))))
+		   (if (> (abs (- val (list-ref expts (- i 1)))) 1e-6)
+		       (begin
+			 (set! happy #f)
+                         (if (or with-bignums (< (abs (log (expt .1 i) 2)) 46))
+			     (begin (display "expt error > 1e-6 around 2^") (display (log (expt .1 i) 2)) (newline)))))))
+	       (lambda args
+		 (display "expt not accurate below around 2^") (display (/ (log (expt .1 i)) (log 2))) (newline))))))
+
+(test (expt) 'error)
+(test (expt 1) 'error)
+(test (expt 1.0+23.0i) 'error)
+(test (expt "hi" "hi") 'error)
+(test (expt 1.0+23.0i 1.0+23.0i 1.0+23.0i) 'error)
+(test (expt #t 0) 'error)
+(test (expt 0 -1) 'error)
+(test (expt 0 -1/4) 'error)
+(test (expt 0.0 -1.0) 'error)
+(test (expt 0.0 -0.1) 'error)
+(test (expt 0 -1.0) 'error)
+(test (expt 0 -1.0+i) 'error)
+
+(unless with-bignums
+  (test (nan? (expt 0 0+0/0i)) #t)
+  (test (nan? (expt 0 0-0/0i)) #t)
+  (test (nan? (expt 0 0/0+i)) #t)
+  (test (nan? (expt 0 +nan.0)) #t))
+(for-each
+ (lambda (arg)
+   (test (expt arg +nan.0) 'error)
+   (test (expt +nan.0 arg) 'error)
+   (test (expt arg +inf.0) 'error)
+   (test (expt +inf.0 arg) 'error)
+   (test (expt arg 2) 'error)
+   (test (expt 2 arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(when full-s7test
+  (for-each (lambda (n)
+	    (let ((x 0.0))
+	      (define (f1) (expt n 0+0/0i))
+	      (define (f2) (expt n (bignum 0+0/0i)))
+	      (define (f3) (expt (bignum n) 0+0/0i))
+	      (define (f4) (expt (bignum n) (bignum 0+0/0i)))
+	      (define (f5) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (expt n 0+0/0i))))
+	      (define (f6) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (expt n (bignum 0+0/0i)))))
+	      (define (f7) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (expt (bignum n) 0+0/0i))))
+	      (define (f8) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (expt (bignum n) (bignum 0+0/0i)))))
+	      (define (g1) (f1))
+	      (define (g2) (f2))
+	      (define (g3) (f3))
+	      (define (g4) (f4))
+	      (define (g5) (f5))
+	      (define (g6) (f6))
+	      (define (g7) (f7))
+	      (define (g8) (f8))
+	      (let ((val (expt n 0+0/0i))) (unless (nan? val) (format *stderr* "expt 1 ~S: ~S~%" n val)))
+	      (let ((val (expt n (bignum 0+0/0i)))) (unless (nan? val) (format *stderr* "expt 2 ~S: ~S~%" n val)))
+	      (let ((val (expt n 0+0/0i))) (unless (nan? val) (format *stderr* "expt 3 ~S: ~S~%" n val)))
+	      (let ((val (expt n (bignum 0+0/0i)))) (unless (nan? val) (format *stderr* "expt 4 ~S: ~S~%" n val)))
+	      (let ((val (f1))) (unless (nan? val) (format *stderr* "expt f1 ~S: ~S~%" n val)))
+	      (let ((val (f2))) (unless (nan? val) (format *stderr* "expt f2 ~S: ~S~%" n val)))
+	      (let ((val (f3))) (unless (nan? val) (format *stderr* "expt f3 ~S: ~S~%" n val)))
+	      (let ((val (f4))) (unless (nan? val) (format *stderr* "expt f4 ~S: ~S~%" n val)))
+	      (let ((val (f5))) (unless (nan? val) (format *stderr* "expt f5 ~S: ~S~%" n val)))
+	      (let ((val (f6))) (unless (nan? val) (format *stderr* "expt f6 ~S: ~S~%" n val)))
+	      (let ((val (f7))) (unless (nan? val) (format *stderr* "expt f7 ~S: ~S~%" n val)))
+	      (let ((val (f8))) (unless (nan? val) (format *stderr* "expt f8 ~S: ~S~%" n val)))
+	      (let ((val (g1))) (unless (nan? val) (format *stderr* "expt g1 ~S: ~S~%" n val)))
+	      (let ((val (g2))) (unless (nan? val) (format *stderr* "expt g2 ~S: ~S~%" n val)))
+	      (let ((val (g3))) (unless (nan? val) (format *stderr* "expt g3 ~S: ~S~%" n val)))
+	      (let ((val (g4))) (unless (nan? val) (format *stderr* "expt g4 ~S: ~S~%" n val)))
+	      (let ((val (g5))) (unless (nan? val) (format *stderr* "expt g5 ~S: ~S~%" n val)))
+	      (let ((val (g6))) (unless (nan? val) (format *stderr* "expt g6 ~S: ~S~%" n val)))
+	      (let ((val (g7))) (unless (nan? val) (format *stderr* "expt g7 ~S: ~S~%" n val)))
+	      (let ((val (g8))) (unless (nan? val) (format *stderr* "expt g8 ~S: ~S~%" n val)))))
+	  (list -1 2 2/3 2.0 1+i +nan.0 +inf.0 +nan.0+i +inf.0+i 0+nan.0i 0+inf.0i +inf.0+nan.0i +inf.0+inf.0i +nan.0+nan.0i +nan.0+inf.0i))
+  (for-each (lambda (n)
+	    (let ((x 0.0))
+	      (define (f1) (log n 0+0/0i))
+	      (define (f2) (log n (bignum 0+0/0i)))
+	      (define (f3) (log (bignum n) 0+0/0i))
+	      (define (f4) (log (bignum n) (bignum 0+0/0i)))
+	      (define (f5) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (log n 0+0/0i))))
+	      (define (f6) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (log n (bignum 0+0/0i)))))
+	      (define (f7) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (log (bignum n) 0+0/0i))))
+	      (define (f8) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (log (bignum n) (bignum 0+0/0i)))))
+	      (define (g1) (f1))
+	      (define (g2) (f2))
+	      (define (g3) (f3))
+	      (define (g4) (f4))
+	      (define (g5) (f5))
+	      (define (g6) (f6))
+	      (define (g7) (f7))
+	      (define (g8) (f8))
+	      (let ((val (log n 0+0/0i))) (unless (nan? val) (format *stderr* "log 1 ~S: ~S~%" n val)))
+	      (let ((val (log n (bignum 0+0/0i)))) (unless (nan? val) (format *stderr* "log 2 ~S: ~S~%" n val)))
+	      (let ((val (log n 0+0/0i))) (unless (nan? val) (format *stderr* "log 3 ~S: ~S~%" n val)))
+	      (let ((val (log n (bignum 0+0/0i)))) (unless (nan? val) (format *stderr* "log 4 ~S: ~S~%" n val)))
+	      (let ((val (f1))) (unless (nan? val) (format *stderr* "log f1 ~S: ~S~%" n val)))
+	      (let ((val (f2))) (unless (nan? val) (format *stderr* "log f2 ~S: ~S~%" n val)))
+	      (let ((val (f3))) (unless (nan? val) (format *stderr* "log f3 ~S: ~S~%" n val)))
+	      (let ((val (f4))) (unless (nan? val) (format *stderr* "log f4 ~S: ~S~%" n val)))
+	      (let ((val (f5))) (unless (nan? val) (format *stderr* "log f5 ~S: ~S~%" n val)))
+	      (let ((val (f6))) (unless (nan? val) (format *stderr* "log f6 ~S: ~S~%" n val)))
+	      (let ((val (f7))) (unless (nan? val) (format *stderr* "log f7 ~S: ~S~%" n val)))
+	      (let ((val (f8))) (unless (nan? val) (format *stderr* "log f8 ~S: ~S~%" n val)))
+	      (let ((val (g1))) (unless (nan? val) (format *stderr* "log g1 ~S: ~S~%" n val)))
+	      (let ((val (g2))) (unless (nan? val) (format *stderr* "log g2 ~S: ~S~%" n val)))
+	      (let ((val (g3))) (unless (nan? val) (format *stderr* "log g3 ~S: ~S~%" n val)))
+	      (let ((val (g4))) (unless (nan? val) (format *stderr* "log g4 ~S: ~S~%" n val)))
+	      (let ((val (g5))) (unless (nan? val) (format *stderr* "log g5 ~S: ~S~%" n val)))
+	      (let ((val (g6))) (unless (nan? val) (format *stderr* "log g6 ~S: ~S~%" n val)))
+	      (let ((val (g7))) (unless (nan? val) (format *stderr* "log g7 ~S: ~S~%" n val)))
+	      (let ((val (g8))) (unless (nan? val) (format *stderr* "log g8 ~S: ~S~%" n val)))))
+	  (list -1 2 2/3 2.0 1+i +nan.0 +inf.0 +nan.0+i +inf.0+i 0+nan.0i 0+inf.0i +inf.0+nan.0i +inf.0+inf.0i +nan.0+nan.0i +nan.0+inf.0i)))
+
+(when with-bignums
+  (test (+ (expt -80538738812075974 3)
+           (expt 80435758145817515 3)
+           (expt 12602123297335631 3))
+        42))
+
+
+;;; --------------------------------------------------------------------------------
+
+(let ((f= (lambda (a b) (< (abs (- a b)) 1.0e-15))))
+  (let ((log2 0.69314718055994530941723212145817656807550013436025525412068000949339362196969471560586332699641868754200148102057068573368552023575813055703267075163507596193072757082837143519030703862389167347112335011536449795523912047517268157493206515552473413952588295045300709532636664265410423915781495204374043038550080194417064167151864471283996817178454695702627163106454615025720740248163777338963855069526066834113727387372292895649354702576265209885969320196505855476470330679365443254763274495125040606943814710468994650622016772042452452961268794654619316517468139267250410380254625965686914419287160829380317271436778265487756648508567407764845146443994046142260319309673540257444607030809608504748663852313818167675143866747664789088143714198549423151997354880375165861275352916610007105355824987941472950929311389715599820565439287170007218085761025236889213244971389320378439353088774825970171559107088236836275898425891853530243634214367061189236789192372314672321720534016492568727477823445353476481149418642386776774406069562657379600867076257199184734022651462837904883062033061144630073719489002743643965002580936519443041191150608094879306786515887090060520346842973619384128965255653968602219412292420757432175748909770675268711581705113700915894266547859596489065305846025866838294002283300538207400567705304678700184162404418833232798386349001563121889560650553151272199398332030751408426091479001265168243443893572472788205486271552741877243002489794540196187233980860831664811490930667519339312890431641370681397776498176974868903887789991296503619270710889264105230924783917373501229842420499568935992206602204654941510613918788574424557751020683703086661948089641218680779020818158858000168811597305618667619918739520076671921459223672060253959543654165531129517598994005600036651356756905124592682574394648316833262490180382424082423145230614096380570070255138770268178516306902551370323405380214501901537402950994226299577964742713815736380172987394070424217997226696297993931270694)
+
+	(log3 1.09861228866810969139524523692252570464749055782274945173469433363749429321860896687361575481373208878797002906595786574236800422593051982105280187076727741060316276918338136717937369884436095990374257031679591152114559191775067134705494016677558022220317025294689756069010652150564286813803631737329857778236699165479213181814902003010382363012224865274819822599109745249089645805346700884596508574844411901885708764749486707961308582941160216612118400140982551439194876889367984943022557315353296853452952514592138764946859325627944165569415782723103551688661021184698904399430631382552857364668828249881368228006341439107868932514564375102044516275619349739821169415857405353617589009751222337977369696877543547951357129821770175812421223514058101632724655889372495649191852429607966842346470693772372526550820320783339280558928531468730951326064583091843974968222303257654675333118230196492752575991322178513533902374829643395025460742458249346668661218814365265654295427676105054777954229339733234011737431939745798470185595484940594783539438410106029307622922281312074893063445340252777326856271480016818715472439782071878034446780216178158419042820076721243255738014364178876826161041016818724240687908909929874208152183237528942752732534071002835750695062403965462752244308462588450859786253083224774538885068003488324340490083990058080943565282122370388702036804548600776214244088697259413584365999226211739670804950952792714363154640444623089158185367119608370304853520909672629582415040355995121355450332241748474100331981487832452569334704949937301656336660991903957122822844881674312150628569993874038819012744839564791034772885972119850649422796985791669956418551265041502191554719665856929726606523573293736830027830921776605387030462007661584946700226011756797518003934791763277844935142634968360037557857160700498181519184373438290934746660457750659273670121115370582496479847930404205823964753857850960626093389914706120130243108260518262958640076003059494321166880446106134684533980))
+
+    (if (not (f= log3 (log 3.0)))
+	(begin (display "(- (log 3.0) true-log-3) = ") (display (- log3 (log 3.0))) (newline)))
+    (if (not (f= log2 (log 2.0)))
+	(begin (display "(- (log 2.0) true-log-2) = ") (display (- log2 (log 2.0))) (newline)))
+    (if (not (f= 3.0 (exp log3)))
+	(begin (display "(- 3.0 (exp log3)) = ") (display (- 3.0 (exp log3))) (newline)))
+    (if (not (f= 2.0 (exp log2)))
+	(begin (display "(- 2.0 (exp log2)) = ") (display (- 2.0 (exp log2))) (newline))))
+
+  (let ((sin1 8.414709848078965066525023216302989996225630607983710656727517099919104043912396689486397435430526959e-1)
+	(cos1 5.403023058681397174009366074429766037323104206179222276700972553811003947744717645179518560871830894e-1)
+	(tan1 1.557407724654902230506974807458360173087250772381520038383946605698861397151727289555099965202242984e0))
+
+    (if (not (f= sin1 (sin 1)))
+	(begin (display "(- (sin 1) true-sin-1) = ") (display (- sin1 (sin 1))) (newline)))
+    (if (not (f= (asin sin1) 1.0))
+	(begin (display "(- (asin (sin 1)) 1) = ") (display (- (asin sin1) 1)) (newline)))
+
+    (if (not (f= cos1 (cos 1)))
+	(begin (display "(- (cos 1) true-cos-1) = ") (display (- cos1 (cos 1))) (newline)))
+    (if (not (f= (acos cos1) 1.0))
+	(begin (display "(- (acos (cos 1)) 1) = ") (display (- (acos cos1) 1)) (newline)))
+
+    (if (not (f= tan1 (tan 1)))
+	(begin (display "(- (tan 1) true-tan-1) = ") (display (- tan1 (tan 1))) (newline)))
+    (if (not (f= (atan tan1) 1.0))
+	(begin (display "(- (atan (tan 1)) 1) = ") (display (- (atan tan1) 1)) (newline)))
+
+    (set! sin1 -.3056143888882523)
+    (set! cos1 -.9521553682590148)
+    (set! tan1 .3209711346238149)
+
+    (if (not (f= sin1 (sin 10000)))
+	(begin (display "(- (sin 10000) true-sin-10000) = ") (display (- sin1 (sin 10000))) (newline)))
+
+    (if (not (f= cos1 (cos 10000)))
+	(begin (display "(- (cos 10000) true-cos-10000) = ") (display (- cos1 (cos 10000))) (newline)))
+
+    (if (not (f= tan1 (tan 10000)))
+	(begin (display "(- (tan 10000) true-tan-10000) = ") (display (- tan1 (tan 10000))) (newline)))
+    )
+
+
+  (let ((sinh1 1.175201193643801456882381850595600815155717981334095870229565413013307567304323895607117452089623392e0)
+	(cosh1 1.543080634815243778477905620757061682601529112365863704737402214710769063049223698964264726435543036e0)
+	(tanh1 7.615941559557648881194582826047935904127685972579365515968105001219532445766384834589475216736767144e-1))
+
+    (if (not (f= sinh1 (sinh 1)))
+	(begin (display "(- (sinh 1) true-sinh-1) = ") (display (- sinh1 (sinh 1))) (newline)))
+    (if (not (f= (asinh sinh1) 1.0))
+	(begin (display "(- (asinh (sinh 1)) 1) = ") (display (- (asinh sinh1) 1)) (newline)))
+
+    (if (not (f= cosh1 (cosh 1)))
+	(begin (display "(- (cosh 1) true-cosh-1) = ") (display (- cosh1 (cosh 1))) (newline)))
+    (if (not (f= (acosh cosh1) 1.0))
+	(begin (display "(- (acosh (cosh 1)) 1) = ") (display (- (acosh cosh1) 1)) (newline)))
+
+    (if (not (f= tanh1 (tanh 1)))
+	(begin (display "(- (tanh 1) true-tanh-1) = ") (display (- tanh1 (tanh 1))) (newline)))
+    (if (not (f= (atanh tanh1) 1.0))
+	(begin (display "(- (atanh (tanh 1)) 1) = ") (display (- (atanh tanh1) 1)) (newline)))
+    ))
+
+(when with-bignums
+  (let-temporarily (((*s7* 'bignum-precision) 512))
+					; these checked against arprec (digits = 512)
+    (num-test (sin (bignum "696898287454081973170944403677937368733396.0")) -0.01999904696709900707248379699203543861700131080741493395453090012397)
+    (num-test (cos (bignum "696898287454081973170944403677937368733396.0")) -0.99979999906001588673892554498680272502063995303949755633430660411025)
+    (num-test (tan (bignum "696898287454081973170944403677937368733396.0")) 0.02000304759542063815661565629241173304757896817099118262507840447691)
+    (num-test (log (bignum "696898287454081973170944403677937368733396.0")) 96.34745809783239800899232787971326647885871562509641009125683617504293)
+    (num-test (sqrt (bignum "696898287454081973170944403677937368733396.0")) 8.34804340821298061589146684184612401904558331041225568173326261228620e20))
+
+  ;; these can be checked against arprec -- get tables of the others as well
+  ;;	(num-test (sin 31415926535897932384626433832795028841.971693993751058209749445) 6.8290634690588564658126265428876656461078982456442870201741792E-24)
+  ;; this test requires 500 bits of precision
+  (num-test (sin 31415926535897932384626433832795028841) -8.2584214320186030736155068085595298665361290626210864656288000E-1)
+  (num-test (sin 1.0) 0.84147098480789650665250232163029899962256306079837106567275170999191) ; if bignum here
+
+  ;;	(num-test (cos 31415926535897932384626433832795028841.971693993751058209749445) 9.9999999999999999999999999999999999999999999997668194606778265E-1)
+  ;; 500 bits
+  (num-test (cos 1.0) 5.4030230586813971740093660744297660373231042061792222767009714E-1))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; *
+;;; --------------------------------------------------------------------------------
+
+(num-test (* -0.0) 0.0)
+(num-test (* -0.0+0.00000001i) -0.0+0.00000001i)
+(num-test (* -1.0) -1.0)
+(num-test (* -1.0+1.0i -1.0+1.0i) 0.0-2.0i)
+(num-test (* -1.0+1.0i 0) 0.0)
+(num-test (* -1.0+1.0i 0.0) 0.0)
+(num-test (* -1.0+1.0i 0.0+1.0i) -1.0-1.0i)
+(num-test (* -1.0+1.0i 1) -1.0+1.0i)
+(num-test (* -1.0+1.0i 1.0) -1.0+1.0i)
+(num-test (* -1.0+1.0i 1.0+1.0i) -2.0)
+(num-test (* -1.0+1.0i 1/1) -1.0+1.0i)
+(num-test (* -1.0+1.0i 123.4) -123.4+123.4i)
+(num-test (* -1.0+1.0i 1234) -1234.0+1234.0i)
+(num-test (* -1.0+1.0i 1234/11) -112.18181818181819+112.18181818181819i)
+(num-test (* -1.0+1.0i) -1.0+1.0i)
+(num-test (* -10) -10)
+(num-test (* -10/3) -10/3)
+(num-test (* -2/2) -2/2)
+(num-test (* 0 0) 0)
+(num-test (* 0 0.0+1.0i) 0.0)
+(num-test (* 0 1 0) 0)
+(num-test (* 0 1 0.0+1.0i) 0.0)
+(num-test (* 0 1 1.0) 0.0)
+(num-test (* 0 1 1/1) 0)
+(num-test (* 0 1 1234) 0)
+(num-test (* 0 1) 0)
+(num-test (* 0 1.0 0) 0.0)
+(num-test (* 0 1.0 0.0+1.0i) 0.0)
+(num-test (* 0 1.0 1.0) 0.0)
+(num-test (* 0 1.0 1/1) 0.0)
+(num-test (* 0 1.0 1234) 0.0)
+(num-test (* 0 1.0) 0.0)
+(num-test (* 0 1.0+1.0i 0) 0.0)
+(num-test (* 0 1.0+1.0i 0.0+1.0i) 0.0)
+(num-test (* 0 1.0+1.0i 1.0) 0.0)
+(num-test (* 0 1.0+1.0i 1/1) 0.0)
+(num-test (* 0 1.0+1.0i 1234) 0.0)
+(num-test (* 0 1.0+1.0i) 0.0)
+(num-test (* 0 123.4) 0.0)
+(num-test (* 0 1234/11) 0)
+(num-test (* 0.0 -1.0+1.0i -1.0+1.0i) 0.0)
+(num-test (* 0.0 -1.0+1.0i 0.0) 0.0)
+(num-test (* 0.0 -1.0+1.0i 1) 0.0)
+(num-test (* 0.0 -1.0+1.0i 1.0+1.0i) 0.0)
+(num-test (* 0.0 -1.0+1.0i 123.4) 0.0)
+(num-test (* 0.0 -1.0+1.0i 1234/11) 0.0)
+(num-test (* 0.0 0 -1.0+1.0i) 0.0)
+(num-test (* 0.0 0 0.0) 0.0)
+(num-test (* 0.0 0 1) 0.0)
+(num-test (* 0.0 0 1.0+1.0i) 0.0)
+(num-test (* 0.0 0 123.4) 0.0)
+(num-test (* 0.0 0 1234/11) 0.0)
+(num-test (* 0.0 0.0 -1.0+1.0i) 0.0)
+(num-test (* 0.0 0.0 0.0) 0.0)
+(num-test (* 0.0 0.0 1) 0.0)
+(num-test (* 0.0 0.0 1.0+1.0i) 0.0)
+(num-test (* 0.0 0.0 123.4) 0.0)
+(num-test (* 0.0 0.0 1234/11) 0.0)
+(num-test (* 0.0 0.0+1.0i -1.0+1.0i) 0.0)
+(num-test (* 0.0 0.0+1.0i 0.0) 0.0)
+(num-test (* 0.0 0.0+1.0i 1) 0.0)
+(num-test (* 0.0 0.0+1.0i 1.0+1.0i) 0.0)
+(num-test (* 0.0 0.0+1.0i 123.4) 0.0)
+(num-test (* 0.0 0.0+1.0i 1234/11) 0.0)
+(num-test (* 0.0 1 -1.0+1.0i) 0.0)
+(num-test (* 0.0 1 0.0) 0.0)
+(num-test (* 0.0 1 1.0) 0.0)
+(num-test (* 0.0 1 1/1) 0.0)
+(num-test (* 0.0 1 1234) 0.0)
+(num-test (* 0.0 1) 0.0)
+(num-test (* 0.0 1.0 0) 0.0)
+(num-test (* 0.0 1.0 0.0+1.0i) 0.0)
+(num-test (* 0.0 1.0 1.0) 0.0)
+(num-test (* 0.0 1.0 1/1) 0.0)
+(num-test (* 0.0 1.0 1234) 0.0)
+(num-test (* 0.0 1.0) 0.0)
+(num-test (* 0.0 1.0+1.0i 0) 0.0)
+(num-test (* 0.0 1.0+1.0i 0.0+1.0i) 0.0)
+(num-test (* 0.0 1.0+1.0i 1.0) 0.0)
+(num-test (* 0.0 1.0+1.0i 1/1) 0.0)
+(num-test (* 0.0 1.0+1.0i 1234) 0.0)
+(num-test (* 0.0 1.0+1.0i) 0.0)
+(num-test (* 0.0 123.4 0) 0.0)
+(num-test (* 0.0 123.4 0.0+1.0i) 0.0)
+(num-test (* 0.0 123.4 1.0) 0.0)
+(num-test (* 0.0 123.4 1/1) 0.0)
+(num-test (* 0.0 123.4 1234) 0.0)
+(num-test (* 0.0 123.4) 0.0)
+(num-test (* 0.0 1234 0) 0.0)
+(num-test (* 0.0 1234 0.0+1.0i) 0.0)
+(num-test (* 0.0 1234 1.0) 0.0)
+(num-test (* 0.0 1234 1/1) 0.0)
+(num-test (* 0.0 1234 1234) 0.0)
+(num-test (* 0.0 1234) 0.0)
+(num-test (* 0.0 1234/11 0) 0.0)
+(num-test (* 0.0 1234/11 0.0+1.0i) 0.0)
+(num-test (* 0.0 1234/11 1.0) 0.0)
+(num-test (* 0.0 1234/11 1/1) 0.0)
+(num-test (* 0.0 1234/11 1234) 0.0)
+(num-test (* 0.0 1234/11) 0.0)
+(num-test (* 0.0+0.00000001i) 0.0+0.00000001i)
+(num-test (* 0.0+1.0i 0) 0.0)
+(num-test (* 0.0+1.0i 0.0+1.0i) -1.0)
+(num-test (* 0.0+1.0i 1.0) 0.0+1.0i)
+(num-test (* 0.0+1.0i 1/1) 0.0+1.0i)
+(num-test (* 0.0+1.0i 1234) 0.0+1234.0i)
+(num-test (* 0/1) 0/1)
+(num-test (* 1 0) 0)
+(num-test (* 1 0.0+1.0i) 0.0+1.0i)
+(num-test (* 1 1 0) 0)
+(num-test (* 1 1 0.0+1.0i) 0.0+1.0i)
+(num-test (* 1 1 1.0) 1.0)
+(num-test (* 1 1 1/1) 1)
+(num-test (* 1 1 1234) 1234)
+(num-test (* 1 1) 1)
+(num-test (* 1 1.0 0) 0.0)
+(num-test (* 1 1.0 0.0+1.0i) 0.0+1.0i)
+(num-test (* 1 1.0 1.0) 1.0)
+(num-test (* 1 1.0 1/1) 1.0)
+(num-test (* 1 1.0 1234) 1234.0)
+(num-test (* 1 1.0) 1.0)
+(num-test (* 1 1.0+1.0i 0) 0.0)
+(num-test (* 1 1.0+1.0i 0.0+1.0i) -1.0+1.0i)
+(num-test (* 1 1.0+1.0i 1.0) 1.0+1.0i)
+(num-test (* 1 1.0+1.0i 1/1) 1.0+1.0i)
+(num-test (* 1 1.0+1.0i 1234) 1234.0+1234.0i)
+(num-test (* 1 1.0+1.0i) 1.0+1.0i)
+(num-test (* 1 1234) 1234)
+(num-test (* 1.0 -1.0+1.0i -1.0+1.0i) 0.0-2.0i)
+(num-test (* 1.0 -1.0+1.0i 0.0) 0.0)
+(num-test (* 1.0 -1.0+1.0i 1) -1.0+1.0i)
+(num-test (* 1.0 -1.0+1.0i 1.0+1.0i) -2.0)
+(num-test (* 1.0 -1.0+1.0i 123.4) -123.4+123.4i)
+(num-test (* 1.0 -1.0+1.0i 1234/11) -112.18181818181819+112.18181818181819i)
+(num-test (* 1.0 0 -1.0+1.0i) 0.0)
+(num-test (* 1.0 0 0.0) 0.0)
+(num-test (* 1.0 0 1) 0.0)
+(num-test (* 1.0 0 1.0+1.0i) 0.0)
+(num-test (* 1.0 0 123.4) 0.0)
+(num-test (* 1.0 0 1234/11) 0.0)
+(num-test (* 1.0 0.0 -1.0+1.0i) 0.0)
+(num-test (* 1.0 0.0 0.0) 0.0)
+(num-test (* 1.0 0.0 1) 0.0)
+(num-test (* 1.0 0.0 1.0+1.0i) 0.0)
+(num-test (* 1.0 0.0 123.4) 0.0)
+(num-test (* 1.0 0.0 1234/11) 0.0)
+(num-test (* 1.0 0.0+1.0i -1.0+1.0i) -1.0-1.0i)
+(num-test (* 1.0 0.0+1.0i 0.0) 0.0)
+(num-test (* 1.0 0.0+1.0i 1) 0.0+1.0i)
+(num-test (* 1.0 0.0+1.0i 1.0+1.0i) -1.0+1.0i)
+(num-test (* 1.0 0.0+1.0i 123.4) 0.0+123.4i)
+(num-test (* 1.0 0.0+1.0i 1234/11) 0.0+112.18181818181819i)
+(num-test (* 1.0 1 -1.0+1.0i) -1.0+1.0i)
+(num-test (* 1.0 1 0.0) 0.0)
+(num-test (* 1.0 1 1) 1.0)
+(num-test (* 1.0 1 1.0+1.0i) 1.0+1.0i)
+(num-test (* 1.0 1 123.4) 123.4)
+(num-test (* 1.0 1 1234/11) 112.18181818181819)
+(num-test (* 1.0 1.0 -1.0+1.0i) -1.0+1.0i)
+(num-test (* 1.0 1.0 0.0) 0.0)
+(num-test (* 1.0 1.0 1) 1.0)
+(num-test (* 1.0 1.0 1.0+1.0i) 1.0+1.0i)
+(num-test (* 1.0 1.0 123.4) 123.4)
+(num-test (* 1.0 1.0 1234/11) 112.18181818181819)
+(num-test (* 1.0 1.0+1.0i -1.0+1.0i) -2.0)
+(num-test (* 1.0 1.0+1.0i 0.0) 0.0)
+(num-test (* 1.0 1.0+1.0i 1) 1.0+1.0i)
+(num-test (* 1.0 1.0+1.0i 1.0+1.0i) 0.0+2.0i)
+(num-test (* 1.0 1.0+1.0i 123.4) 123.4+123.4i)
+(num-test (* 1.0 1.0+1.0i 1234/11) 112.18181818181819+112.18181818181819i)
+(num-test (* 1.0 1/1 -1.0+1.0i) -1.0+1.0i)
+(num-test (* 1.0 123.4 0) 0.0)
+(num-test (* 1.0 123.4 0.0+1.0i) 0.0+123.4i)
+(num-test (* 1.0 123.4 1.0) 123.4)
+(num-test (* 1.0 123.4 1/1) 123.4)
+(num-test (* 1.0 123.4 1234) 152275.60000000000582)
+(num-test (* 1.0 123.4) 123.4)
+(num-test (* 1.0 1234 0) 0.0)
+(num-test (* 1.0 1234 0.0+1.0i) 0.0+1234.0i)
+(num-test (* 1.0 1234 1.0) 1234.0)
+(num-test (* 1.0 1234 1/1) 1234.0)
+(num-test (* 1.0 1234 1234) 1522756.0)
+(num-test (* 1.0 1234) 1234.0)
+(num-test (* 1.0 1234/11 0) 0.0)
+(num-test (* 1.0 1234/11 0.0+1.0i) 0.0+112.18181818181819i)
+(num-test (* 1.0 1234/11 1.0) 112.18181818181819)
+(num-test (* 1.0 1234/11 1/1) 112.18181818181819)
+(num-test (* 1.0 1234/11 1234) 138432.36363636364695)
+(num-test (* 1.0 1234/11) 112.18181818181819)
+(num-test (* 1.0+1.0i -1.0+1.0i -1.0+1.0i) 2.0-2.0i)
+(num-test (* 1.0+1.0i -1.0+1.0i 0.0) 0.0)
+(num-test (* 1.0+1.0i -1.0+1.0i 1) -2.0)
+(num-test (* 1.0+1.0i -1.0+1.0i 1.0+1.0i) -2.0-2.0i)
+(num-test (* 1.0+1.0i -1.0+1.0i 123.4) -246.8)
+(num-test (* 1.0+1.0i -1.0+1.0i 1234/11) -224.36363636363637)
+(num-test (* 1.0+1.0i 0 -1.0+1.0i) 0.0)
+(num-test (* 1.0+1.0i 0 0.0) 0.0)
+(num-test (* 1.0+1.0i 0 1) 0.0)
+(num-test (* 1.0+1.0i 0 1.0+1.0i) 0.0)
+(num-test (* 1.0+1.0i 0 123.4) 0.0)
+(num-test (* 1.0+1.0i 0 1234/11) 0.0)
+(num-test (* 1.0+1.0i 0.0 -1.0+1.0i) 0.0)
+(num-test (* 1.0+1.0i 0.0 0.0) 0.0)
+(num-test (* 1.0+1.0i 0.0 1) 0.0)
+(num-test (* 1.0+1.0i 0.0 1.0+1.0i) 0.0)
+(num-test (* 1.0+1.0i 0.0 123.4) 0.0)
+(num-test (* 1.0+1.0i 0.0 1234/11) 0.0)
+(num-test (* 1.0+1.0i 0.0+1.0i -1.0+1.0i) 0.0-2.0i)
+(num-test (* 1.0+1.0i 0.0+1.0i 0.0) 0.0)
+(num-test (* 1.0+1.0i 0.0+1.0i 1) -1.0+1.0i)
+(num-test (* 1.0+1.0i 0.0+1.0i 1.0+1.0i) -2.0)
+(num-test (* 1.0+1.0i 0.0+1.0i 123.4) -123.4+123.4i)
+(num-test (* 1.0+1.0i 0.0+1.0i 1234/11) -112.18181818181819+112.18181818181819i)
+(num-test (* 1.0+1.0i 1 -1.0+1.0i) -2.0)
+(num-test (* 1.0+1.0i 1 0.0) 0.0)
+(num-test (* 1.0+1.0i 1 1) 1.0+1.0i)
+(num-test (* 1.0+1.0i 1 1.0+1.0i) 0.0+2.0i)
+(num-test (* 1.0+1.0i 1 123.4) 123.4+123.4i)
+(num-test (* 1.0+1.0i 1 1234/11) 112.18181818181819+112.18181818181819i)
+(num-test (* 1.0+1.0i 1.0 -1.0+1.0i) -2.0)
+(num-test (* 1.0+1.0i 1.0 0.0) 0.0)
+(num-test (* 1.0+1.0i 1.0 1) 1.0+1.0i)
+(num-test (* 1.0+1.0i 1.0 1.0+1.0i) 0.0+2.0i)
+(num-test (* 1.0+1.0i 1.0 123.4) 123.4+123.4i)
+(num-test (* 1.0+1.0i 1.0 1234/11) 112.18181818181819+112.18181818181819i)
+(num-test (* 1.0+1.0i 1.0+1.0i -1.0+1.0i) -2.0-2.0i)
+(num-test (* 1.0+1.0i 1.0+1.0i 0.0) 0.0)
+(num-test (* 1.0+1.0i 1.0+1.0i 1) 0.0+2.0i)
+(num-test (* 1.0+1.0i 1.0+1.0i 1.0+1.0i) -2.0+2.0i)
+(num-test (* 1.0+1.0i 1.0+1.0i 123.4) 0.0+246.8i)
+(num-test (* 1.0+1.0i 1.0+1.0i 1234/11) 0.0+224.36363636363637i)
+(num-test (* 1.0+1.0i 123.4 -1.0+1.0i) -246.8)
+(num-test (* 1.0+1.0i 123.4 0.0) 0.0)
+(num-test (* 1.0+1.0i 123.4 1) 123.4+123.4i)
+(num-test (* 1.0+1.0i 123.4 1.0+1.0i) 0.0+246.8i)
+(num-test (* 1.0+1.0i 123.4 123.4) 15227.56000000000131+15227.56000000000131i)
+(num-test (* 1.0+1.0i 123.4 1234/11) 13843.23636363636433+13843.23636363636433i)
+(num-test (* 1.0+1.0i 1234 -1.0+1.0i) -2468.0)
+(num-test (* 1.0+1.0i 1234 0.0) 0.0)
+(num-test (* 1.0+1.0i 1234 1) 1234.0+1234.0i)
+(num-test (* 1.0+1.0i 1234 1.0+1.0i) 0.0+2468.0i)
+(num-test (* 1.0+1.0i 1234 123.4) 152275.60000000000582+152275.60000000000582i)
+(num-test (* 1.0+1.0i 1234 1234/11) 138432.36363636364695+138432.36363636364695i)
+(num-test (* 1.0+1.0i 1234/11 -1.0+1.0i) -224.36363636363637)
+(num-test (* 1.0+1.0i 1234/11 0.0) 0.0)
+(num-test (* 1.0+1.0i 1234/11 1) 112.18181818181819+112.18181818181819i)
+(num-test (* 1.0+1.0i 1234/11 1.0+1.0i) 0.0+224.36363636363637i)
+(num-test (* 1.0+1.0i 1234/11 123.4) 13843.23636363636433+13843.23636363636433i)
+(num-test (* 1.0+1.0i 1234/11 1234/11) 12584.76033057851419+12584.76033057851419i)
+(num-test (* 1.0+1.0i) 1.0+1.0i)
+(num-test (* 10/3) 10/3)
+(num-test (* 123.4 -1.0+1.0i 0) 0.0)
+(num-test (* 123.4 -1.0+1.0i 0.0+1.0i) -123.4-123.4i)
+(num-test (* 123.4 -1.0+1.0i 1.0) -123.4+123.4i)
+(num-test (* 123.4 -1.0+1.0i 1/1) -123.4+123.4i)
+(num-test (* 123.4 -1.0+1.0i 1234) -152275.60000000000582+152275.60000000000582i)
+(num-test (* 123.4 -1.0+1.0i) -123.4+123.4i)
+(num-test (* 123.4 0 0) 0.0)
+(num-test (* 123.4 0 0.0+1.0i) 0.0)
+(num-test (* 123.4 0 1.0) 0.0)
+(num-test (* 123.4 0 1/1) 0.0)
+(num-test (* 123.4 0 1234) 0.0)
+(num-test (* 123.4 0) 0.0)
+(num-test (* 123.4 0.0 0) 0.0)
+(num-test (* 123.4 0.0 0.0+1.0i) 0.0)
+(num-test (* 123.4 0.0 1.0) 0.0)
+(num-test (* 123.4 0.0 1/1) 0.0)
+(num-test (* 123.4 0.0 1234) 0.0)
+(num-test (* 123.4 0.0) 0.0)
+(num-test (* 123.4 0.0+1.0i 0) 0.0)
+(num-test (* 123.4 0.0+1.0i 0.0+1.0i) -123.4)
+(num-test (* 123.4 0.0+1.0i 1.0) 0.0+123.4i)
+(num-test (* 123.4 0.0+1.0i 1/1) 0.0+123.4i)
+(num-test (* 123.4 0.0+1.0i 1234) 0.0+152275.60000000000582i)
+(num-test (* 123.4 0.0+1.0i) 0.0+123.4i)
+(num-test (* 123.4 1 0) 0.0)
+(num-test (* 123.4 1 0.0+1.0i) 0.0+123.4i)
+(num-test (* 123.4 1 1.0) 123.4)
+(num-test (* 123.4 1 1/1) 123.4)
+(num-test (* 123.4 1 1234) 152275.60000000000582)
+(num-test (* 123.4 1) 123.4)
+(num-test (* 123.4 1.0 0) 0.0)
+(num-test (* 123.4 1.0 0.0+1.0i) 0.0+123.4i)
+(num-test (* 123.4 1.0 1.0) 123.4)
+(num-test (* 123.4 1.0 1/1) 123.4)
+(num-test (* 123.4 1.0 1234) 152275.60000000000582)
+(num-test (* 123.4 1.0) 123.4)
+(num-test (* 123.4 1.0+1.0i 0) 0.0)
+(num-test (* 123.4 1.0+1.0i 0.0+1.0i) -123.4+123.4i)
+(num-test (* 123.4 1.0+1.0i 1.0) 123.4+123.4i)
+(num-test (* 123.4 1.0+1.0i 1/1) 123.4+123.4i)
+(num-test (* 123.4 1.0+1.0i 1234) 152275.60000000000582+152275.60000000000582i)
+(num-test (* 123.4 1.0+1.0i) 123.4+123.4i)
+(num-test (* 123.4 123.4 -1.0+1.0i) -15227.56000000000131+15227.56000000000131i)
+(num-test (* 123.4 123.4 0.0) 0.0)
+(num-test (* 123.4 123.4 1) 15227.56000000000131)
+(num-test (* 123.4 123.4 1.0+1.0i) 15227.56000000000131+15227.56000000000131i)
+(num-test (* 123.4 123.4 123.4) 1879080.90400000032969)
+(num-test (* 123.4 123.4 1234/11) 1708255.36727272742428)
+(num-test (* 123.4 1234 -1.0+1.0i) -152275.60000000000582+152275.60000000000582i)
+(num-test (* 123.4 1234 0.0) 0.0)
+(num-test (* 123.4 1234 1) 152275.60000000000582)
+(num-test (* 123.4 1234 1.0+1.0i) 152275.60000000000582+152275.60000000000582i)
+(num-test (* 123.4 1234 123.4) 18790809.04000000283122)
+(num-test (* 123.4 1234 1234/11) 17082553.67272727191448)
+(num-test (* 123.4 1234/11 -1.0+1.0i) -13843.23636363636433+13843.23636363636433i)
+(num-test (* 123.4 1234/11 0.0) 0.0)
+(num-test (* 123.4 1234/11 1) 13843.23636363636433)
+(num-test (* 123.4 1234/11 1.0+1.0i) 13843.23636363636433+13843.23636363636433i)
+(num-test (* 123.4 1234/11 123.4) 1708255.36727272742428)
+(num-test (* 123.4 1234/11 1234/11) 1552959.42479338846169)
+(num-test (* 1234 -1.0+1.0i) -1234.0+1234.0i)
+(num-test (* 1234 0.0) 0.0)
+(num-test (* 1234 1) 1234)
+(num-test (* 1234 1.0+1.0i) 1234.0+1234.0i)
+(num-test (* 1234 123.4) 152275.60000000000582)
+(num-test (* 1234 1234/11) 1522756/11)
+(num-test (* 1234/11 0) 0)
+(num-test (* 1234/11 0.0+1.0i) 0.0+112.18181818181819i)
+(num-test (* 1234/11 1.0) 112.18181818181819)
+(num-test (* 1234/11 1/1) 1234/11)
+(num-test (* 1234/11 1234) 1522756/11)
+(num-test (* 1234000000) 1234000000)
+(num-test (* 1234000000/10) 1234000000/10)
+(num-test (* 2) 2)
+(num-test (* 2/2) 2/2)
+(num-test (let ((x 1) (y 2)) (set! x (* 0 (let () (set! y 32) 1))) y) 32)
+(num-test (* 4) 4 )
+(num-test (* 7 6 5 4 3 2 1) 5040)
+(num-test (*) 1 )
+(num-test (* (+ 1 3 5) (* 1 3 5)) 135)
+(when with-bignums (num-test (* -1/2147483648 1/4294967296) -1/9223372036854775808))
+(num-test (* -2147483648 4294967296) -9223372036854775808)
+(num-test (* .000000000000123 .000000000000123) 1.5129e-26)
+(num-test (* 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20) 2432902008176640000)
+(num-test (* 1/98947 2/97499 3/76847) 6/741360956847391)
+(num-test (* 11/1234 1234/11 11/1234 1234/11 11/1234 1234/11) 1)
+(num-test (* 12 (/ 13591409 (expt 640320 3/2))) (/ pi))
+(num-test (* 1e100 0.001) 1e97)
+(num-test (* 1e100 1e-100) 1.0)
+(num-test (* 1e200 1e-200) 1.0)
+(num-test (* 1e300 1e-300) 1.0)
+(num-test (* 500009/500029 500057/500041) 250033000513/250035001189)
+(num-test (* -9223372036854775808 5.551115123125783999999999999999999999984E-17) -5.120000000000001197084708550423347199985E2)
+(num-test (* -9223372036854775808) -9223372036854775808)
+(num-test (* 1.110223024625156799999999999999999999997E-16 -9223372036854775808) -1.024000000000000239416941710084669439997E3)
+(num-test (* 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) 3.340955887615246120290922872835723707327E-52)
+(num-test (* 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) 6.162975822039157611655737122931199999952E-33)
+(num-test (* 9223372036854775807 (/ 9223372036854775807)) 1)
+(num-test (* 1234567890e24 1e-33) 1.23456789)
+(num-test (* 1234567890e-24 1e20) 123456.789)
+(when (provided? 'overflow-checks)
+  (num-test (* 92233720/9221 -92233720/9221 9221/92233720 -9221/92233720) 1)
+  (num-test (* 9221/92233720 -9221/92233720 92233720/9221 -92233720/9221) 1))
+
+(for-each-permutation
+ (lambda args
+   (if (not (< (magnitude (- (apply * args) 0.25+0.25i)) 1e-15))
+       (format #t "~A: (* ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply * args))))
+ '(1 1/2 0.5 1+i))
+
+(for-each-permutation
+ (lambda args
+   (if (not (< (magnitude (- (apply * args) 1.0)) 1e-15))
+       (format #t "~A: (* ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply * args))))
+ '(5 1/3 0.5 1+i 1/5 3 2.0 0.5-0.5i))
+
+(num-test (* 7/1000 1000/999 999/7 most-positive-fixnum) most-positive-fixnum)
+(num-test (* 7/1000000 1/999 999/7 (- most-positive-fixnum 775807)) 9223372036854)
+(num-test (* 7/100000000000 1/999 999/7 (- most-positive-fixnum 36854775807)) 92233720)
+
+(num-test (* -0.2554913394465045E0 0.27042187315261135E0) -6.909044658739340841916780452607499999997E-2)
+(num-test (* -0.4489211233229662E0 -0.42892136850270857E0) 1.925518625654598642702435865603340000003E-1)
+(num-test (* -0.44586465919973783E0 -0.15168042462027043E0) 6.762894083058839862686475970136690000031E-2)
+(num-test (* 0.5509395670465355E0 0.3577558280766836E0) 1.971018410289428517174637096677999999998E-1)
+(num-test (* -0.42780066410606965E0 0.22704747885906007E0) -9.713106223951470697784938095387549999991E-2)
+(num-test (* 0.20955388816500042E0 0.605628751935113E0) 1.269118597525194529275610775776050864747E-1)
+(num-test (* 0.9993471610818964E0 -4.363771855901198E9) -4.360923015803940523218504871887199999987E9)
+(num-test (* 0.10502219375257282E0 3.425205053451057E9) 3.597225487658284459716764716837978363041E8)
+(num-test (* 0.7768651149081368E0 1.666066330143864E9) 1.294308811011790623456907580692100524906E9)
+(num-test (* -0.6438389801759042E0 2.8922130868526487E9) -1.862119524290613178578671687454540000003E9)
+(num-test (* -0.7427680566504474E0 6.763974500466173E9) -5.024064194944440168218138681386184692391E9)
+(num-test (* -0.8563035843259611E0 2.9100478627456827E9) -2.491884415429230578930028553142970000007E9)
+(num-test (* 0.6219502737119671E0 2.8868752190811842E-11) 1.795492832679837500144381979439820000005E-11)
+(num-test (* 0.6767479505813657E0 2.9324524289075574E-11) 1.98453117144053746900587234314118E-11)
+(num-test (* 0.7944531541461581E0 8.282076647859848E-11) 6.579721915772496180466156449968800000014E-11)
+(num-test (* -0.4662914070981966E0 -6.921260263903422E-11) 3.22732418734836218212517276876520000001E-11)
+(num-test (* 0.037804762510578516E0 -3.044514833184461E-11) -1.150971602284721156705916516398760000005E-12)
+(num-test (* -0.5364168049485208E0 -3.695280705974925E-11) 1.982210669686983584095600640940000000003E-11)
+(num-test (* 0.10343751426551051E0 4.8902635121181385E19) 5.058367017968254798845671333856350000002E18)
+(num-test (* -0.45511004829813784E0 1.8210069906740634E19) -8.287585794769196371535086060990559999988E18)
+(num-test (* -0.9675158737162977E0 8.097401718869682E19) -7.834364698864051180664785816331399999997E19)
+(num-test (* -0.06573561186185628E0 2.6049125586869125E19) -1.712355208919177984462215919354999999997E18)
+(num-test (* -0.5574365795036731E0 -8.822383181882661E19) 4.917919103979402413863422702119099999985E19)
+(num-test (* -0.4222667103024276E0 -1.8561723355961213E19) 7.837997859065477747526525340678799999995E18)
+(num-test (* -0.8412207478192143E0 2.3416069046402696E-22) -1.969808311420123220453436412175280000003E-22)
+(num-test (* 0.24291385591230452E0 -9.448120185342916E-21) -2.295079305344524973092760016780319999996E-21)
+(num-test (* -0.37792600430678414E0 -2.3929024368177364E-21) 9.043400566424941101603791982206959999978E-22)
+(num-test (* -0.007648867433060369E0 -5.3162210182098465E-21) 4.066306981313632980042734472335849999998E-23)
+(num-test (* -0.7631807323096114E0 -4.534410248041209E-21) 3.460574533692296555855373976182600000004E-21)
+(num-test (* 0.4735366300649959E0 -1.3895270471326203E-21) -6.579919552833457409343160757567699999986E-22)
+(num-test (* -8.64834403600587E9 -0.14057280586223464E0) 1.215721987203268063989050502795104980466E9)
+(num-test (* -1.5525713051163936E9 0.10621224657238759E0) -1.649020862802360033147528021954240000002E8)
+(num-test (* 3.297132746298694E9 0.05318660311813239E0) 1.753632908051865357781730185173082351681E8)
+(num-test (* 2.1659831568875275E9 0.11704159596099262E0) 2.535101255067452830195785975470499999995E8)
+(num-test (* -5.533403510176525E9 0.37778599060251605E0) -2.090442326495477997892444645726250000003E9)
+(num-test (* -2.4217306331294374E9 0.6051350227557695E0) -1.465474021787126179631541139079300000002E9)
+(num-test (* 1.4048311850866513E9 -4.304799039580996E9) -6.047515936334448947178704758694799999987E18)
+(num-test (* -5.070278162013437E9 -9.116233758795675E9) 4.622184094703138120556628748497500000004E19)
+(num-test (* 8.452801605894673E9 -9.002885976919611E9) -7.609960904339272295066535438875484466566E19)
+(num-test (* 6.352601599408395E9 -4.484034289922495E9) -2.84852834019637276707985964548254013062E19)
+(num-test (* -6.565407710101401E8 -6.718825369609182E9) 4.411182788445701880089696066398200000001E18)
+(num-test (* -9.37193973536698E9 9.577576231327314E9) -8.976046725088278448381480077370724757202E19)
+(num-test (* -1.7766859308675253E9 -4.079350537765101E-11) 7.247724707524128390808760574555300000015E-2)
+(num-test (* 2.3810136983742104E9 9.195156930614704E-11) 2.189379461049416913728349262972160000005E-1)
+(num-test (* -3.313966320976337E9 -3.44704749912067E-11) 1.142339931889161000998337758579000000001E-1)
+(num-test (* 6.598963960681895E9 -2.4298605961767928E-11) -1.6034562503651679888964996364737701416E-1)
+(num-test (* 7.908258993705348E9 1.528909719631646E-11) 1.209101404084048656249131044486427307128E-1)
+(num-test (* -5.906667889594469E9 5.917852809041966E-11) -3.4954791162514609467168142486054E-1)
+(num-test (* 4.86261281419926E9 -2.3925611132123714E19) -1.1634098327861323021375513143190574646E29)
+(num-test (* -9.753392818607462E9 -2.5653634777279775E18) 2.502099772078991953507318766810499999998E28)
+(num-test (* 1.5861252889272392E9 5.12939252547053E19) 8.135859201483165467280698143134187520016E28)
+(num-test (* -8.422142961023593E8 1.0428099441045047E19) -8.782694430425160722507674279387100000022E27)
+(num-test (* -3.109042783121446E9 -4.138252722536039E19) 1.286600476173334775049764879239400000004E29)
+(num-test (* -6.459303282089468E8 1.8408981660472957E19) -1.18909195659417795593544068516876E28)
+(num-test (* -1.432764110232635E9 8.98766033001457E-21) -1.287719715580647603395563949195000000001E-11)
+(num-test (* 8.539623949953406E9 -3.498784805440049E-21) -2.987830652026891151867478398400020599353E-11)
+(num-test (* 7.336784327799637E9 -1.048985206018761E-21) -7.696178219612118988966933703567504882842E-12)
+(num-test (* -4.320357143553698E9 2.591531476439043E-21) -1.119634152697768142457549423101400000004E-11)
+(num-test (* -9.374098076239548E9 5.5773248420603045E-21) -5.2282390072520541300690003822366E-11)
+(num-test (* 9.118926580475056E9 -1.379170270330765E-21) -1.257655243712018104094987568109512329098E-11)
+(num-test (* 8.145792307872788E-11 -0.06511382435429458E0) -5.304036895613925967063321178890399999982E-12)
+(num-test (* -6.1928426627437E-11 0.2526275616632321E0) -1.564482741652978543296795912770000000003E-11)
+(num-test (* -8.555119338859813E-11 -0.8366318482083728E0) 7.157485304113477734096792042286400000002E-11)
+(num-test (* 8.243060442429263E-12 0.3939656708074719E0) 3.247482836708180702664407610209699999993E-12)
+(num-test (* 8.600529286105945E-11 -0.891441509265547E0) -7.666868807288821095008580376914999999987E-11)
+(num-test (* -7.531046724969747E-11 0.24398797995196886E0) -1.837484877349259372047496586078419999997E-11)
+(num-test (* -3.7666526619188126E-12 4.659322150343885E9) -1.755004818033008198811983615043067932129E-2)
+(num-test (* 3.032501107241211E-11 -9.592046453776636E9) -2.908789149178678011789796814619600000006E-1)
+(num-test (* 7.311626957349528E-11 -9.061108567148174E9) -6.625144566303134478698468496187199999991E-1)
+(num-test (* 4.898078204161461E-11 8.88014689134599E9) 4.34956539382539434542556734824485778809E-1)
+(num-test (* 1.278207138618518E-11 -4.279966992086118E9) -5.470684362336102162321405533123999999992E-2)
+(num-test (* -8.538580654966055E-11 -5.191059833953482E8) 4.432428307696650304902715905351E-2)
+(num-test (* 4.0761422500127225E-11 1.527607426117321E-11) 6.226745171030000570391027616422499999987E-22)
+(num-test (* -9.186363051001198E-11 8.557763803549676E-11) -7.861472520412421845045812851184799999979E-21)
+(num-test (* -9.89183505930065E-11 9.717968160611499E-11) -9.61285381563042758142312881743500000002E-21)
+(num-test (* 7.440627873114725E-12 -4.535521332601712E-11) -3.374712644646273959960130740919999999997E-22)
+(num-test (* 8.701410920357686E-11 -7.032883383151379E-12) -6.119600827175551716944456414899399999975E-22)
+(num-test (* 9.866226673114161E-11 -2.814669610817353E-11) -2.777016839025002299729708883583300000003E-21)
+(num-test (* 5.192240545105114E-11 -3.366056660574579E19) -1.747737587015645175992519129700599999996E9)
+(num-test (* -1.372355669576939E-11 -4.819955130360066E19) 6.614692750256090679268960117974000000002E8)
+(num-test (* 3.637511103766519E-11 -4.071776382810416E19) -1.481113180452716050522430526190399999997E9)
+(num-test (* 7.446388208685151E-13 2.7760294268649034E19) 2.06713927911698144246650226294134E7)
+(num-test (* 6.267855179410938E-11 7.471751480940298E19) 4.683185621908299321917798617952399999997E9)
+(num-test (* -4.336562006766369E-11 8.143188451558233E19) -3.531344165296609191472762946597699999996E9)
+(num-test (* -1.0432655006975122E-11 -9.379512413340694E-21) 9.785321714202410134613576821466799999983E-32)
+(num-test (* -8.167646898574611E-11 -5.810795749825724E-21) 4.746052788431460582580726109336400000004E-31)
+(num-test (* -4.33805459341994E-11 -2.4289860591796017E-21) 1.053707413137706937228749003789799999998E-31)
+(num-test (* -1.384613082275421E-11 2.2174009100764947E-21) -3.070242308741338958377843646768700000007E-32)
+(num-test (* -4.910905591314494E-11 -5.456657623752349E-21) 2.679713043437427118620763024640600000007E-31)
+(num-test (* 1.3653011366548008E-11 -3.925911962906968E-21) -5.3600520653635635667567009719744E-32)
+(num-test (* 7.641468950470222E19 0.9034599537348024E0) 6.903761184457755820350566254132800000009E19)
+(num-test (* 5.146778093125584E19 -0.2791459460022878E0) -1.436702239669392041403916711075200000002E19)
+(num-test (* -8.874303077863696E19 -0.23153988023519345E0) 2.054755071819368785424861291991199999996E19)
+(num-test (* 7.10798162637783E19 -0.4719034863212067E0) -3.354281310194779040746230255943679999999E19)
+(num-test (* -9.820386602197546E19 0.03346146041258036E0) -3.286044775256677372510003197965599999991E18)
+(num-test (* -5.210458089116161E19 0.11173798093222442E0) -5.822060666098160855554015008516199999997E18)
+(num-test (* 3.257626718953688E18 -6.150510855712356E9) -2.003606849878328222529021336892800000007E28)
+(num-test (* -7.755105754004988E19 5.514896832715505E9) -4.276860816013589383294629509647750854492E29)
+(num-test (* 2.426235084788384E19 8.685431434428486E9) 2.10728984727342930836693974581298828125E29)
+(num-test (* -2.847383850475709E19 -2.412830829567453E9) 6.870255538040273498936753499177000000002E28)
+(num-test (* 1.4664659669727164E19 -4.8673539253155E9) -7.137808880686241930432174599520111083984E28)
+(num-test (* -4.24770317054668E19 1.3102543269150825E9) -5.5655714586597020914994623011E28)
+(num-test (* 2.17116835964837E19 -3.654789326884115E-11) -7.935162947711353824080778955354111999976E8)
+(num-test (* -1.8125809977916906E17 -5.944782899600832E-11) 1.077540051981345570924422644657920000001E7)
+(num-test (* -7.915462827540546E19 9.762153025588201E-11) -7.727195939080587759467382669774600000011E9)
+(num-test (* -4.360953588949649E19 -7.152431005584812E-11) 3.119141966351983288172806713098800000002E9)
+(num-test (* 3.550776271395866E19 -6.387656982922894E-11) -2.268114084477872045705002835620399999998E9)
+(num-test (* -8.278954580496595E19 -7.359178231519021E-11) 6.09263023285252303789473682334949999999E9)
+(num-test (* -5.5022682113038156E19 -8.979630229039327E19) 4.94083339585058897667477175561012E39)
+(num-test (* 1.1716230943203277E19 5.5764415854118265E19) 6.53348774559675813536051493554405E38)
+(num-test (* 7.462799608352103E19 6.061883497941003E19) 4.5238621794310193360802344979309E39)
+(num-test (* -3.2160334983646097E19 -3.8817785710003675E19) 1.248392991757108737054938769406475E39)
+(num-test (* 5.868090263060238E19 -8.37300331667736E19) -4.913353923516549470233569081168E39)
+(num-test (* -7.3652924769962656E19 9.725738480757314E19) -7.16329084655549342691442378865984E39)
+(num-test (* -6.447063647969567E19 4.0587529685661844E-21) -2.616703871973161409821231651015480000002E-1)
+(num-test (* -3.1999317568381926E17 3.015031281949113E-21) -9.647894346969533174030688093163799999993E-4)
+(num-test (* -1.5005852398726605E19 5.391316601974659E-21) -8.090130116403600588996007910269500000005E-2)
+(num-test (* 1.0084552719733576E19 2.78150956101201E-21) 2.805027980846861049488413624776000000002E-2)
+(num-test (* -7.171404412051077E19 1.4733392992015492E-21) -1.056591195074223176150038792848839999998E-1)
+(num-test (* -5.909802783283228E19 5.356071274587122E-21) -3.165332492601832012651928738981599999998E-1)
+(num-test (* 8.272641144282955E-22 -0.16191056182923802E0) -1.339427975482523749443486923949099999995E-22)
+(num-test (* 8.410471541398583E-21 -0.43256058128353736E0) -3.638038458816019512260007931560879999991E-21)
+(num-test (* -7.887238384137063E-22 0.5589746137044918E0) -4.408766028968254895651429959583400000002E-22)
+(num-test (* 4.778995446616728E-21 0.21608373898977795E0) 1.0326632047200663557809034755476E-21)
+(num-test (* 3.992449163872154E-21 0.9593422165456676E0) 3.830125030315009512425388980010399999991E-21)
+(num-test (* -9.700320218813958E-21 -0.42620535269852766E0) 4.134328400148261975602018057078279999983E-21)
+(num-test (* -1.7901566262876555E-21 9.461674014776534E8) -1.693787843332593653628245958251059055323E-12)
+(num-test (* 1.0928019952544443E-22 8.279199780524873E9) 9.047526039267738313652918648958873748777E-13)
+(num-test (* 9.942869097320962E-21 9.523169242022762E9) 9.46876251650656124754254949341964721678E-11)
+(num-test (* -2.7432601692209267E-21 -4.922145522647528E9) 1.350272575938808435595052562419760000003E-11)
+(num-test (* -5.97929682563092E-21 -6.147792689359443E8) 3.675947731212389417723913477756000000004E-12)
+(num-test (* -1.3564305221188254E-21 1.0862842413758955E9) -1.4734691006989580907776383331457E-12)
+(num-test (* -5.446806293721964E-21 -1.5358504316888942E-11) 8.365479797538664267835041412208799999977E-32)
+(num-test (* -1.0222776562632463E-21 -1.9781477525280056E-11) 2.022216248196737715829186720579279999999E-32)
+(num-test (* 8.192540157543917E-21 3.3215076993103644E-11) 2.721158521019146605658900627335480000005E-31)
+(num-test (* 9.685592607330157E-21 6.034805605641166E-11) 5.845066856067266821880143244306199999988E-31)
+(num-test (* 6.671870463340688E-21 -9.07657686679269E-11) -6.055774510579551477490933797071999999989E-31)
+(num-test (* -1.109409648670322E-21 -4.7905821901849965E-11) 5.314718104539438656835419223873000000025E-32)
+(num-test (* -3.9052432481663676E-22 2.0306112771345453E19) -7.930030979680167745084943578652280000005E-3)
+(num-test (* 8.596834841113507E-21 -9.453548987989818E19) -8.127059931212420192062869827172600000005E-1)
+(num-test (* 3.946325780779758E-21 -9.084484011754447E19) -3.585033346066809630978128408382600000004E-1)
+(num-test (* 5.3518824877647604E-21 -6.814116447592617E19) -3.64683504854607466529059878139668000001E-1)
+(num-test (* -7.456278485417833E-22 9.61914445493285E19) -7.172301984744205963559813785437470719996E-2)
+(num-test (* -5.0781537010216826E-21 9.216915512986622E19) -4.680491362427717476508990573017719999994E-1)
+(num-test (* 3.2906792172396555E-22 4.571445785546992E-21) 1.504316163923729767672342114125599999998E-42)
+(num-test (* 5.39814714322422E-21 6.687033308557664E-21) 3.609758975123575798079875142208000000008E-41)
+(num-test (* 4.3506183844841724E-21 7.266196706225928E-21) 3.161244897538486151238585450198720000008E-41)
+(num-test (* 6.910763289107986E-21 3.910584203890238E-21) 2.702512175521023610171407324066800000011E-41)
+(num-test (* -4.6131515924393325E-21 5.228174479773633E-21) -2.411836142691841383820888561997250000001E-41)
+(num-test (* -2.1886866436065787E-21 6.29322016055891E-22) -1.377388691069093503544474490121700000002E-42)
+
+(num-test (* 19813/30200 41168/38464 2571/31632) 43688873593/765502835200)
+(num-test (* 16476/12673 40086/15929) 38850408/11874601)
+
+(if (provided? 'overflow-checks)
+    (num-test (* 22713/35036 2008/41994 58982/21726 37919/44341 59831/3870) 608349727545125531/546777281752405290))
+(num-test (* 26100/43623 64347/64939 51424/56858) 4798021185600/8948293077857)
+(num-test (* 13336/48674 21323/50854 60055/14813) 4269362918510/9166534724887)
+(num-test (* 33457/53498 45548/13003 50476/8209 9613/3657) 369717652332927784/10441582621738311)
+(num-test (* 31186/2829 35725/62132) 557059925/87885714)
+(num-test (* 28682/22045 54652/61935 19725/39778 14431/165 5682/36504) 54173177045874781/6989848058967345)
+(num-test (* 6054/59436 53485/47493 65091/13749 59111/51596) 5324119682728535/8557570117787688)
+(num-test (* 26270/51496 62100/14371 9302/6501 11918/55524) 627970006908375/927532016146043)
+(num-test (* 6865/57699 53935/1664 25223/46128 13016/30664) 15194818521234275/16975596844836864)
+(num-test (* 0110/001) 110)
+(num-test (* 14000000000000 524288) 7340032000000000000)
+(num-test (* 17500000000000 524288) 9175040000000000000)
+(num-test (* 1907348632812 524288) 999999999999737856)
+(num-test (* 524288 14000000000000) 7340032000000000000)
+(num-test (* 524288 17500000000000) 9175040000000000000)
+(num-test (* 524288 1907348632812) 999999999999737856)
+(num-test (* 9223372036854775807 1/9223372036854775807) 1.0)
+
+(let ((bes-i0 (lambda (x)			;I0(x)
+		(if (< (abs x) 3.75)
+		    (let* ((y (expt (/ x 3.75) 2)))
+		      (+ 1.0
+			 (* y (+ 3.5156229
+				 (* y (+ 3.0899424
+					 (* y (+ 1.2067492
+						 (* y (+ 0.2659732
+							 (* y (+ 0.360768e-1
+								 (* y 0.45813e-2)))))))))))))
+		    (let* ((ax (abs x))
+			   (y (/ 3.75 ax)))
+		      (* (/ (exp ax) (sqrt ax))
+			 (+ 0.39894228
+			    (* y (+ 0.1328592e-1
+				    (* y (+ 0.225319e-2
+					    (* y (+ -0.157565e-2
+						    (* y (+ 0.916281e-2
+							    (* y (+ -0.2057706e-1
+								    (* y (+ 0.2635537e-1
+									    (* y (+ -0.1647633e-1
+										    (* y 0.392377e-2))))))))))))))))))))))
+  (num-test (bes-i0 1.0) 1.266065877752009)
+  (num-test (bes-i0 2.0) 2.279585302336067)
+  (num-test (bes-i0 5.0) 27.23987182360445)
+  (num-test (bes-i0 10.0) 2815.716628466254)
+  (num-test (bes-i0 50.0) 2.93255291463847587034176447517387076592E20) ;2.932553783849336E+20) arprec
+  (num-test (bes-i0 100.0) 1.073751199431789167620943174959211991306E42))
+
+(unless (or with-bignums (not (provided? 'overflow-checks)))
+  (num-test (* 1/9223372036854775807 1/9223372036854775806) 1.1754943508223e-38)
+  (num-test (* 1/98947 2/97499 3/76847 4/61981 5/59981 6/66601) 3.9223808052178e-27)
+  (num-test (* 1/98947 2/97499 3/76847 4/61981 5/59981) 4.3539080668052e-23)
+  (num-test (* 1/98947 2/97499 3/76847 4/61981) 5.2230351951008e-19)
+  (num-test (* 500009/500029 500057/500041 500083/500069) 1.00001999432878)
+  (num-test (* 98947 2/97499 76847 4/61981 5/59981) 304151204360/362470312515139) ;0.00083910652502692
+
+  (num-test (* 256 2048 35184372088832) 1.8446744073709551616E19)
+  (num-test (* 64 67108864 4294967296) 1.8446744073709551616E19)
+  (num-test (* 65535/131072 2305843009213693952 1048576/524287) 2.30581222282939585599978637654567059645E18))
+
+(when with-bignums
+  (let ((twos (make-vector 30)))
+    (do ((i 0 (+ i 1))
+	 (t2 1 (* t2 8)))
+	((= i 30))
+      (set! (twos i) t2))
+    (do ((i 0 (+ i 1)))
+	((= i 29))
+      (if (not (= (twos (+ i 1)) (* 8 (twos i))))
+	  (format #t "~A * 8 -> ~A (~A)~%" (twos i) (* 8 (twos i)) (twos (+ i 1))))
+      (if (not (= (+ (twos (+ i 1)) (* 8 (twos i))) (* 2 (twos (+ i 1)))))
+	  (format #t "~A + ~A -> ~A~%" (* 8 (twos i)) (twos (+ i 1)) (* 2 (twos (+ i 1)))))
+      (if (not (= (/ (twos (+ i 1)) (twos i)) 8))
+	  (format #t "~A / ~A = ~A (8)~%" (twos (+ i 1)) (twos i) (/ (twos (+ i 1)) (twos i))))
+      (if (not (= (- (twos (+ i 1)) (* 8 (twos i))) 0))
+	  (format #t "~A - ~A -> ~A~%" (* 8 (twos i)) (twos (+ i 1)) (- (twos (+ i 1)) (* 8 (twos i)))))))
+
+  (letrec ((factorial (lambda (n i) (if (positive? n) (factorial (- n 1) (* i n)) i))))
+    (num-test (/ (factorial 100 1) (factorial 99 1)) 100)
+    (num-test (/ (factorial 1000 1) (factorial 999 1)) 1000)
+    (num-test (factorial 100 1) 93326215443944152681699238856266700490715968264381621468592963895217599993229915608941463976156518286253697920827223758251185210916864000000000000000000000000)
+    (num-test (factorial 200 1) 788657867364790503552363213932185062295135977687173263294742533244359449963403342920304284011984623904177212138919638830257642790242637105061926624952829931113462857270763317237396988943922445621451664240254033291864131227428294853277524242407573903240321257405579568660226031904170324062351700858796178922222789623703897374720000000000000000000000000000000000000000000000000)
+
+    (num-test (* (factorial 3 1) (factorial 5 1) (factorial 7 1)) (factorial 10 1)))
+
+  (num-test (let () (define (func) (* 1855077841/1311738121 (ash 1 43))) (define (hi) (func)) (hi)) 16317437252872781692928/1311738121) ; g_mul_xi bug
+  (num-test (* 30370004999 30370004999) 922337203639284990001)
+
+  (num-test (* 12345678901234567890 1e-19) 1.234567890123456789E0)
+  (num-test (* 12345678901234567890123456789 1e-29) 1.2345678901234567890123456789e-1)
+  (num-test (* -1.797693134862315699999999999999999999998E308 -9223372036854775808) 1.658079259093488393947175407121858559998E327)
+  (num-test (* -1/21 -1/2432902008176640000) 1/51090942171709440000)
+  (num-test (* -1/21 1/2432902008176640000) -1/51090942171709440000)
+  (num-test (* -1/2432902008176640000 -1/21) 1/51090942171709440000)
+  (num-test (* -1/2432902008176640000 1/21) -1/51090942171709440000)
+  (num-test (* -1/2432902008176640000 2432902008176640000) -1)
+  (num-test (* -21 -2432902008176640000) 51090942171709440000)
+  (num-test (* -21 2432902008176640000) -51090942171709440000)
+  (num-test (* -2432902008176640000 -21) 51090942171709440000)
+  (num-test (* -2432902008176640000 21) -51090942171709440000)
+  (num-test (* -524288 -17600000000000) 9227468800000000000)
+  (num-test (* -9223372036854775808 -9223372036854775808) 85070591730234615865843651857942052864)
+  (num-test (* -9223372036854775808 9223372036854775807 -9223372036854775808) 784637716923335095394403086170723686146950778700062261248)
+  (num-test (* 0+1e20i 0+1e20i) -1e40)
+  (num-test (* 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23) 25852016738884976640000)
+  (num-test (* 1.0e70+i 1.0e70-i) 1.0e140)
+  (num-test (* 1/1024 -1/9765625 -1/512 1/1953125) 1/10000000000000000000)
+  (num-test (* 1/1024 1/9765625 1/512 1/1953125) 1/10000000000000000000)
+  (num-test (* 1/21 -1/2432902008176640000) -1/51090942171709440000)
+  (num-test (* 1/21 1/2432902008176640000) 1/51090942171709440000)
+  (num-test (* 1/2432902008176640000 -1/21) -1/51090942171709440000)
+  (num-test (* 1/2432902008176640000 1/21) 1/51090942171709440000)
+  (num-test (* 1/256 1/256 1/256 1/256 1/256 1/256 1/256 -1/128) (/ most-negative-fixnum))
+  (num-test (* 1/9223372036854775807 1/9223372036854775806) 1/85070591730234615838173535747377725442)
+  (num-test (* 1/98947 2/97499 3/76847 4/61981 5/59981 6/66601) 720/183561983334767209753061626751)
+  (num-test (* 1/98947 2/97499 3/76847 4/61981 5/59981) 120/2756144552405627689570151)
+  (num-test (* 1000000.0 (+ 1.0 1.2345e-10 -1.0)) 1.2345e-4)
+  (num-test (* 1000000.0 (- 1.0 -1.2345e-10 1.0)) 1.2345e-4)
+  (num-test (* 1000000000 1000000000 1000000000) 1000000000000000000000000000)
+  (num-test (* 1024 -9765625 512 -1953125) 10000000000000000000)
+  (num-test (* 1024 9765625 512 1953125) 10000000000000000000)
+  (num-test (* 132120577/12 33292289/6 260046847/4) 1143841133453061178785791/288)
+  (num-test (* 2 12345678901234567890+12345678901234567890i) 2.469135780246913578E19+2.469135780246913578E19i)
+  (num-test (* 2.0e-170 3.0e-170 4.0e170 5.0e170) 120.0)
+  (num-test (* 21 -2432902008176640000) -51090942171709440000)
+  (num-test (* 21 2432902008176640000) 51090942171709440000)
+  (num-test (* 2432902008176640000 -21) -51090942171709440000)
+  (num-test (* 2432902008176640000 21) 51090942171709440000)
+  (num-test (* 4.0e170 5.0e170 2.0e-170 3.0e-170) 120.0)
+  (num-test (* 4294967296 4294967296) 18446744073709551616)
+  (num-test (* 500009/500029 500057/500041 500083/500069) 125037252995542579/125034753009582041)
+  (num-test (* 524288 -19073486328125) -10000000000000000000)
+  (num-test (* 524288 17600000000000) 9227468800000000000)
+  (num-test (* 9223372036854775807 -9223372036854775808) -85070591730234615856620279821087277056)
+  (num-test (* 9223372036854775807 9223372036854775807) 85070591730234615847396907784232501249)
+  (num-test (* 98947 2/97499 76847 4/61981 5/59981) 304151204360/362470312515139)
+  (num-test (* 8736/53718 63349/36593 2595/65149 64793/55654 43939/26485) 1390659088083157464/64205855201422018751)
+  (num-test (* 54969/62648 20435/1782 23198/40155 17874/3641 36734/7395 36402/62041) 13827254253801875273/166253154009320895)
+  (num-test (* 60943/34150 48303/50035 11510/48029 47829/30632 32873/18834 22417/2481 33058/12503 17309/26655) 1265424338804436192426278624740533/72495658400472874898571063803000)
+  (num-test (* 27004/45232 47028/36314 65506/17434 26523/52475 51611/16322 12090/12813 11405/42722) 3271229108161979601346009209/2797073684091589444785715868)
+  (num-test (* 49543/13313 13047/51213 291/3256 62128/1256 22252/50000 6721/49922 20433/22341) 13848375453906602673519/60295540932769356700000)
+  (num-test (* 24886/21411 24103/16998 16669/52061 10869/30910 63499/50270 23235/64564 6966/28625 26608/32424 957/55396 36661/63680) 252953666671747144783991553669663/1509848199529034284126219405993600000)
+  (num-test (* 10658/5373 33874/4120 50218/27624 32003/31997 36890/5232 20975/22222 42566/23821 32593/38877) 79446367034396970532424018904275/268718417239101417993099877056)
+  (num-test (* 47540/33937 9597/40213 20965/57592 33167/35761 51930/46345 5554/50786 22141/42957 38576/15987 33878/10223) 94287693697494661741863470671584800/1654020197364120441179131115365910721)
+  (num-test (* 25521/34695 63478/8947 53875/28904 102/42469 1068/32213 42994/18166 58634/22402 26266/21149 46345/3896 12489/21331) 2213218340996076291055274962125/53325428353972306616141560355198)
+  (num-test (* 40953/64127 12327/6961 22167/29019 49635/32796 7657/16493 22904/2449 61975/28667 20516/6004) 4090451708614082328368601750/97539662436128754819974369)
+  (num-test (* 10109/23696 35613/28646 25222/28402 1339/25272 54032/1074 54456/39833 38346/15060 41802/41388 56761/38781 54798/1261) 8983158114946791370557093367421339/31998667830808722335250880339080)
+  (num-test (* 3039/17717 46858/6352 49984/23638 8924/34958 34932/46369 4022/13488 38433/34538 46750/2645 43883/61392) 6694310491567033247725656525/3103280388958588906030059796)
+  (num-test (* 31536/12807 62185/56296 30389/6526 53321/20781 58342/28759 39269/53225) 108723306155880938114002/2235179806925856029655)
+  (num-test (* 58784/29145 14245/16217 32388/51826 46401/13774 59002/56853 35615/17085 41786/53891 41646/4047 49564/4554 33807/36767) 2545383335773830668541245993741980009984/3950524525412306420222230035841219227)
+  (num-test (* 39890/59976 16641/39135 36632/15382 4037/16674 32789/39049 5621/24393 7230/37552) 4325746891228381220240705/712068637373286863948894448)
+  (num-test (* 64658/532 12056/22843 48004/41965 17525/20404 46987/34608 39890/37132 32167/52059 26352/16429 62428/21665 39941/30015 19743/16456) 24452413077816850567396233613920457829/58345020552056693855433778720676771)
+  (num-test (* 46215/56564 13217/15837 35488/45940 34754/59356 39024/37453 37845/19747 12129/17699 11475/23380 3024/11313) 9665517455334091811247537600/174562349461714107552224378659)
+  (num-test (* 20849/43211 44644/8350 39144/3119 26169/58795 48540/58870 53603/35775 50387/50026) 1503119635914748931419827344/83828469729567613584821875)
+
+  (num-test (* -1412797070596191471 -15492755620416346417) 21888119755986895161222137392796809407)
+  (num-test (* 16686841096925954110 1491135775021813104) 24882345731730524499708005167300657440)
+  (num-test (* 13262412958100188045 -18379071970155621919) -243750842254847872704698616507823758355)
+  (num-test (* 889503034794263569 -16600674457216690894) -14766350309325860687849239111838240686)
+  (num-test (* 3148165694020236318 -11771070679825280729) -37057280896113409834434531491271315822)
+  (num-test (* -4443818546267181727 -12001052312087213799) 53330498839175802532024121011435050873)
+  (num-test (* 8305259347214213793 -229351169208067535459370186456659711595) -1904820941859811670566233132773219565154696335396051029835)
+  (num-test (* -18273334758510166901 290047155020180552782039318570071650475) -5300128759437251944808204783222405076790289915320785927975)
+  (num-test (* -703280433697652940 91110448009482115063492795153459771021) -64076195390496041906141380919369524419358692517527451740)
+  (num-test (* 15279634596127882146 -220998726467849290098339792307263567896) -3376779786638352686104608499923871317791563686466157184816)
+  (num-test (* -4472497681184076830 325612942672822430032905460436166528379) -1456303131067722058341139305566346079551678140995111358570)
+  (num-test (* -6180420673489141029 -161157288800853703711204405567379740552) 996019839388256252540244286609069684717518686623358308008)
+  (num-test (* 14044956603588468379 10163190459901171254101452124764637970005230126310661589196828892266636678427020930101076689732526935899135126391465178494895371156141265424428405590113790) 142741568963316278148132287599703960511135825069792278910440475692913696263448088587778211787403889397993501704943449376875999977937418748662459138952952917221024170426846410)
+  (num-test (* 2133283347509865817 10577710515843519541178984366353275630877942729579274295972091544607384358263130633386329706527832990861547566574369528634541156662300858851752195966167381) 22565253698228972909216255630133478029433774404794962869038558824053350969301054394347471181756471783852326407546652836376109109470959746153989521923555764579738243072315277)
+  (num-test (* 7812722507014599311 -5055959518947106416800910724733658104378582281318226107212861190073091017493970778425583956006925004399967175604321778956828368132273155364830637407968648) -39500808728232764770485117356353304373275127104839804121600969932458363071148383405901570717732548020267052999198017578112731079638156026910705662052515278317807704170401528)
+  (num-test (* -17560801708050275829 9842515227842383346577123873881045824143545509071137371075701856197189100217561683579562062872293951325890789283651221922663521213150065638405410634222129) -172842458224605375239887212582262805312641302639067963604956593404910080268476692854082531021580381176489626536608405283010496488558204787140272050713264572452317265305619941)
+  (num-test (* 16743386830114877156 7347065846171565625701636575261347705942035850951855454324853850791855951431141198155170102434274509450315416946729031216385536668189501958761688618635668) 123014765528775807847206414290825117502032199391400884957413813554539073118943905948723779020186281150198999824020769031248882909461419778092564985979904308229718874140000208)
+  (num-test (* 12697192948029671719 -11416780209809507417142822520376617951137069007568339428552592261458272400645205700952156716454820410468812274673183389934216970221062627926131479014990611) -144961061169197993494569769162151457365959287966302572862364500950127981616038900865036521107816831702945678695331078399461327412574397914795455218447174498277798426197230309)
+  (num-test (* 17005139720743105479 -29990519259587469661876904501488342396062731024702923152492275204626478246142153608222329335341363164148761307659972897552084842238285026253664841395295138667328930482145590159132144957515157474957872335043653264146346772142483721767458961320947069718037828473530001033848282453826154763424789967441239969918856795769965946388666154136004597297855416503729657013008165049478441197537144135384444157408972370236442813734429031404855591324183846423588871065272526864866155918285777640819778251612915859290336548446745308788013234099839998683451658620461972798204104633072664604846231692505409653434538208644416538994256) -509992970306921990341332390474393215554862069848994183152714032617297815196921655222705396130464246880845576204295466273071779248718654338767559016551390771145212884412809612574391658668778295682412755916528976282396155832617323980694289208942491001345059122414240884660276842648466533488559879226195446807748573906940273568334343093922652142252689341425941673567630236228358747411926991658260241924294146562230425295426217833820067881064577380516936937782688004146531121831211284735538742160763820814174631414364095096099434285754767091040812242751724012532803037860394426031234340719537172735695313262283511554154662650333168783128624)
+  (num-test (* -15877530153400521290 27863984127681242643954505352420303514833683768731313003271701952957204538094398204984051331105594788039352443762851136101330385230866919393696564428736685568762923746771275677491379334452751710169529933675128178840986001684425353245791752781476028565228371147542431713985092322787978914276414008774443194161599919167210582437024618824616489802661351916633993681556274980075051797120207655478780052593534285265078265845445633803877185868676955831374479850746658711791169579387317321983669227930929736238215792068273805543745311609083833407544342964285215427999724272264458975101474080574470499647168865409458531868592) -442411248181132450919255517905812929771246981404050821923231762557171158858876183536414772404562764742655092127161703706239729646027465795612501446223663310668879007072125975886873343449629108246953385822769744013416908613100114754904323190537317463286500657291202287742354250227377164455244103312266617146454847578457073139633297517170508179596166314955134347046515455569689877574427319658085169791949003021426613961459610227430636932814700361914589752207776142403364490846294795496119883683491811246550808038342285518518431538295199537270236275774546666026424361019715280652576803278928827199810150387207105149968313623040090578323680)
+  (num-test (* -14162897687527555611 -23016403916121951319848021112075986869602408568431399211927062304968548663313037929311574133954267816204873252195499803324830278637331653769648377216095499136975244697758388851688873078022850203685120154634090802825656419418077380419130449990938627982123188424119187922828250625318327074513352279785514062876718714640725789938556578327139793467832731546881422469843509318627826856881082450937188956068348931459011923844607158528494902828851692203126881727638511348944908726926619613375594042390434147948508706733126737304560579515324106834237197081860910657003346633962662773394999353766192391746258372744063777808796) 325978973798843759388794644178802841408656469654887121096165875654577046313115917671847505813174070119516580105483409446057747653173640660143855580491229746795572929387698247460831363721394707501497262525550824977473864621747159715947297817600227665840640555029633517390896890601028716769035575763283168066843141870124768085499453574902575378368669494153555135898430469356384416638130459557518713454927909937610851489821263029886989981438507377741962130296498574556444168140838201069779040087521405032426995145166201901368032136008107323350679784004016321425234898132080844200202007395427054392280809376612533414505539109579739614954356)
+  (num-test (* 10844738523441551664 13010289169828379103330191247192587220592807931898339555723704078985668371901953113936581573750666143303899278973814509164982887504269303358034042953769514772858989849512527461308415676004712388964136857232374888643347097138114199889581495448978914022318770898259317738823514820591042321773469959130347470144905381758960436645008051488666423115693738341045851119808222048272924385188356021826450267608127588500233526688704136268009202730309974485584784539415807259862449203760469406037505772435323036790641520939576046423540699016607317147689982042035523118533555744274806239272109508745089640043900389441390176681340) 141093184161152226992592021994885140117836445291515772908453669279294934817987511015413332614094493905560980363483549300117114491702466085602279965168041684355125886388302948336158133555051817733078300668260616983283027038746214728386770752826764135491650323133831923154477800324207350667020747545837613879364064704092093040155243919335078139087599906324684688427176309081290932504214653249366429592335409761783188358003723753633106574740731573467850133547164922532633897844647383889253777956821171583261238607289172489135768839436605233457738153233579088224808850428203888700116300637190661108848906846940291749737998056247719674749760)
+  (num-test (* -16402132873169057380 8202725117980211375579199554494319645475746305836527475507064811368616698686329266053570766100878145903342129595869654087772486685252653587846560946850102095086896668181099435964053041678323706849735936082196618754721606824996486473796843333331029865501790248862590712245450877098960007272754260813822886287008295409755783478345202299352891066800825979067590290793893933819913530599309037639082839491869155044147367415785329077864525961799400923643936705317921900308490987828345313709179960659814100113658528990241758360711799009722683007157350272749544178688961738222930753008443755881419398858537860612954576778456) -134542187307192759584182063854799850608007421111316277594191532129597970622559949723743396309231347084450105499455916612009290113746722460358793168839937004812915757145655285798961178877391232945062437277255128401572171216279188126380587081673725314534095093062983435026047851041796084651601813918099532876684901239903769891552275465470747567830660442193995685219383258617057944010709906130655663966913354414611799232001438943448374556294933488875450563987147224709383408815994320229340710143082135667640802837699940654151297907451396297241124380508001357553893328703788960812706653503939250831164194874527033594779746890593262611805280)
+  (num-test (* -12094905083549825231 -7303327854122277566083382629094740392048421584433028903125893639493993705575691832165314461496849401726460344615713884253150283931509897329926825128629833541892164122168618243719393446304446866677253728405617434021389128710195093788280203239300086905325641224801020413858421914412156234316517981228056539721130386645649016559425091470643854813419057026759188125291655398451427686659900364573485593902992038773538760663063071699966278379037038361219424927031644750173900916227834573604566165762753650347331082640552394430002401423199016978155236550541225512734287851807727860645247391524620773399994302380387697957581) 88333057189654571362020288527489792875655269960629008914349561689924145109953656394378545526256758871407020025766992398117775520525507898420898102744530402370720932219749861094609497366188371774072368034971851022164946370916317410415503705484491514312339956381120953283812334833067601825812118392757289250628861166579446800637104996060739031010579056633535166403083327528575504427815713481850979373113173151813491831551023902022537957860211597622343157802805275942920911544696695931809085743355666792408029743911424760065578742910735408262758198787195579745280191859776661700139596074108035867940154338953640690242795671183308201526211)
+  (num-test (* -81618231044418675360403541307856740187 9751573706924018395) -795906195858402819552264165081526765614024708979523739865)
+  (num-test (* -167600745660011044249531125104202473984 -12960244919927910377) 2172146712516287908809731894157839567367040369214826131968)
+  (num-test (* 90306383312124738690336097936949488486 156109477991590792) 14097682358164298866835386043901377722456291173827620912)
+  (num-test (* 126202800261728727198105694812165074067 -17404362862588500316) -2196479330029905727399352310201914876903532806486592905172)
+  (num-test (* -80093647977875266525946940496137725572 -9499399805878278852) 760841584053111508349403804472960020663660465509267203344)
+  (num-test (* 304052889577333477963637861956318521374 7233536405885618691) 2199377646072361697737485358722028853038393128548297401434)
+  (num-test (* -124787646062877233829165925777950698937 -125798384154373172164515376683173327013) 15698084237137783175768362160964949930745617334715009097620154581879012485181)
+  (num-test (* 259623502197082370239517374851053110076 307089583871541575627915295134832918432) 79727673252974285068387698133566605944659309374400074880377824560177225320832)
+  (num-test (* -245358177397026033963771466683003477163 -285087883756432161967673595037725276963) 69948643556453419103498093570621669430956866597291662675473644085666220495969)
+  (num-test (* 46731711386059374483493216849082745840 -216522280665540473581476116002923812173) -10118456728713381305690589407461434638634240429858378588644634276171257110320)
+  (num-test (* -301422430661955757433852743238845048860 -737194742467573013847855072675441356) 222207031145790358162820429948896977201848379524899474475604149595884654160)
+  (num-test (* 109781582310220385246795023904554278713 -273317662617851276579672019029762858338) -30005245475518685175699313262818315773200953201653075289648004177366787958994)
+  (num-test (* -312236719893391897821327608828679767006 -661158307192284418474080017860142217763949256471548515134335997907628404839044913830388499435166012788226998900468665646723366842553747501004752506346280) 206437901167986463762021023207669068873036145952740267172145693855475451354717023377588805030022300923600718715029262618794758202955817341818233889201852381575043965927328029955969846754837680)
+  (num-test (* -134379788461141842858846278268259347105 -5535479645589936472405910397299739073641612836770238183712206042659632410776896398062277742229906915852933418684231779996404071421767274180368154310128427) 743856583805332082970350662728998610690268824090148728726850517499798631519601137183443104910590855501252539324674812560702657332874686395923181633958702249128106139207076314713649515720653835)
+  (num-test (* 278271843790644800793473851247546123375 -3845690285506025443856370771250487683891303505653819308540635173436088084480277686684743918745832832765066355874381847690771330587033980524869033600561589) -1070147326395532917564114389205677334125034378502074943828571411806344559859053091006175486397820822872698474899835730026158782698085673635033947150554253148685482702599776833910878579880042875)
+  (num-test (* 22345490710865165412267189692679994671 -13168094845644809414256057134926669929759930873747535851687323456073141938879368460977723280750841588750507348317544461824280674332488497533955177541413394) -294247541053147552931885013427268298282376074124656716577088212043667912662239091316191145352314750820026626159649861330384837204227899202392764926604802655267738710003310052268554637728023374)
+  (num-test (* -223445051950608517881717261787296926498 -2609806601119499724524852022247741111662431776874117401343811680374867931883996125145979162937751368655661775097445043144114599069842524778189198926688379) 583148371568187658089071213924575304457465978545376486297236105670932990897420147110485946155066725440999079357995678147717407410446012970360780626554347417807723098476525833332400212113766742)
+  (num-test (* 12604140228725912459681435851589379433 10671266866958584640992033560488052420339425977492420594983497264069815016478448589306666811246532193922229713077112601565462530332258877522384022088660628) 134502144009302626262781543880199144227907004673612064586081220538754991037447647926963488301214672345398823354945333417956344119228084327815583754032364976497975702972112644238248704660063924)
+  (num-test (* -221289678591114384943252477126208006780 20020996887149770966522122735176842174467884990518978494604707026520269232864200848420530223248762875769520715632742683760311747174524709550334825291720803698613541109690224185041740294906022358446325921538593105347423518731748623037078340006459454656405997570119591344894717789372844612253617591807770017562530034107842444403952657949565007792107071767260484233194674888488789619319597151367813735192433631007526015463229060702510632792171187339118004038505860316305860704455466207113207893106982258864355430481457640304138738182009363353560090082819036973601710432437342931523433079941958203038050750205966472435692) -4430439966231074415853738608900692925851705818190624801199561884242897308817127146763274284287396980593383317678766559004881552228480591814939402896201244425805503258878061459604511214900528594870260206969839682573246490602076070316760182753341371682323914671418233629420599310422437691170629449435494697829163966912842611408632129590129483811802031178053300073562716917597174161526976287351465154825036851645956354853960835948518860624747958440181683978083391663149733813297698623499283645627889274004656942800842013709298338912226207338477579862672216831422765369078886850523202897989792734789430796029206661261129141144642117177625405158700499049991760)
+  (num-test (* 180785619668676509441152734583033930295 -11909038209406834057075682058438206007134213485822042209417443270921391661498900475635417780140585878716264253792335317341527677051828500780153492153490249297998660274828986996948999762620400587091118252205695562417522111840305140989214300921122857271717052213225664738544344394774362885331856170636862181712515248810239601812262573113794334115259873527539564296101166439562124016438281173202196876398090029995104489712272260608848551754611421227761245487365953257890749115194455096508613617028024932657498899001119282498614739316599704645009607294747043489655424155986912576002393048535846081096337705941547991821928) -2152982852345560218506186041143281789706715672110278207735389192913214838321097754496849942223194392302524369156102301165660674797665128931611291246607346536492650554391248756408556789391955568308599431054809433808337036546281323840555452571430884302696950144068129601527530304907460164571704857360215834011779559395577299313379666503707563751314135201994045874159291100986903645360754621200008830207429980872071814202801994486961737459218017354210479544121100423399040398021780750351097082070296255480707530391964970754186799748521538525274241709676878827522138880241734356460339681718690408853314007343934035505873192699052380699509877559455199604508760)
+  (num-test (* -196121729286794751535600080816329923561 31755463535476988506639447113088283661031267977524968610501132544098607201258848456920865390506381665724254592728643925608893982794532243733117636645689751360224314774452374503339856173343683819017479955914451013484169313685311530532055735999039466721411777061709328450052490025363788971916050033904534189719389237878257877112162843506491071470067738867693853480174965212750301808781573369342701195147083717623066339671595077736036738235636996351642097684597005928843274525502529735435418805821748637387888409663397547514467435322454217015563134545731593492200855670248739786405074231658957946422903165662016649229286) -6227936422881500100190187768375947805694946596622670066116457374856427496311253030141271922822486386675428302332027411428470488965226898801659352566022706152307022438261392466548357753526474097246042956052374187605144719189465046544498482461077851578811186829094445089366592317045580466302238653533114619908864036973070346979261546801894831273337217021756025770590122176562027129481076270727248949609326868225755958667670279949371399535144788247565199415296122873444199709788941984099349149684384486618280260678252604631431089580057102263617056951788273430713908768738965854953667135156866028646584137788146112300214498814212865170902491169332389942607446)
+  (num-test (* -149247491509558553673630984739524508601 -9241905448313719916485289537122695595500213295294799660583133638026091750542612875183284894676615989153030773719811347110864468582634048542108726080717551794580656021381515769591713295631818532114918070215760259364277583650102628486861397602958930509695263902920994329409932518607260720657755504091822028630927071374796474717671220452208310602827254296323761245420486376569048549643478954846020045263141546849795367522490793641049509748005893155533480849922847230018411440739584477452313387881413141538766185123978087175960946255649923135634987656065468774634483495944248865774633962770893338531522570776854773975281) 1379331204929344851843348280532786532350930013132149419346606977890849868537539899667631713548510207947097949976792337278764045110931774279794402312944786743575421497528669859045492875676005849752425421867514661792129580445000023570590786705609341859529483054902802038173138834528021423393677908655442991197348183257271932188161681770513283703502340499171444058119260228931558784004778969491586252899270869275893402714040693571919281494643765571068045362364213060063345212881008657925426024923296369533374671614852576576041747836643356665301762059898161073609265572267138950725010661453917338098901465732991316661901878681888138048552901254914604845891881)
+  (num-test (* -246070233154436622785727814428081917418 29761582253452470642591719346200231425423204062498655510037025199574178834762931489817919404889920159374886981199608181795387339523762458361385170203883094308920011218315748466148953320570427838912637152446837553950810011344492780712558515815917745810385725989241835877316836808088478276603934260581342710503593237081689944686263274319354100341139245512159619947319496638082702549196795236216458749363904150768879765280332386830831409591769966706351022328535490587838695167807967607003680703048770719240872629379640571077329748828739281770075441660330884779539288220944313294762143588847790653176774089774033399559617) -7323439484151992757431054484912931979861244043627630118213112440051387392428853497035249623931234821362770902740177541812170377563064854590834087655133962963430877452052749127605572395112726398103244974178157574726551814002744001021805127518246639418981066588073652668879613252372759895389345727455380224104332342029151667860553645106555190741775758687650292791318963679857313030729683299101577207875499929500963723267185390425716927303375831321783415003339099100562942730763231688479910689887284950156875532151104047755803876078837921949287811575034368641167438367411569736575067233548122814012421044943430647665260439418887639347030312118291762161708906)
+  (num-test (* 203826295936164259559522643510940430939 428315860474710981601019542870649234168732095026625500771233691514247613083810271191136212287636290276352210600151884730196161003906066671915478570992925366265552107746965374246537358349673161970290367972281768471743836339191023211359427335141701167253694144280251188008871929010775436125645541749886873478179599464478734149706121117222690271210887178499620737860802605991262799781279373870647695125320153193063528861104479576369448865373971847676465682752435142074973627172566791961541105525781297462635428308325033717669972726101583722868689418677558787287897456521530400671342257419067050354522203242849353639864) 87302035331271280954456598486072605056704393103691656908943847729634903654600322194677794243221825233700566108459784062758955025931450719283517278054268553004951352280583820782976072352456972931479389375165173986780482062859853305469143408707179895843295115510597584169486406323435925707638987591151227843652210256611991940374072593149367903739596883229844326054223707236369465710416960023659329202073724249764308867733476242261506975691004092043954515337899900837434270833782490145948781128533218641649564543508314976001614187701395586824982250794852925954991265270537649691628899148413763865280007928191637215283244406869662872539567459561720369352296)
+  (num-test (* -5899540498246269366107488541138263797694914692322476860852796858749106720144552037986906792251681094769894732746138541066810195167688318229720888479512583 5834015210744942902) -34418009003174534626858248456163154666511779871358190892629413477534042866009573638264296461516598238780495750056279721797403178867717911762916049857737963922333901125535866)
+  (num-test (* -7558198374656605586076446665394545534375963428962439959101805545423930654069723860456022097647139432324162475685494459942871728608277717748075653794546685 -2079670855873590264) 15718564882684481784074014915267371190416032453294568239793060140651422710113447422494938907375595456199203928496644205320139985222135619659630853564447794621716315309474840)
+  (num-test (* -9442744083812363570102321552182535031605446031706376100893354933468482520577272174689455502380973733378565213055641110431767353396963744600184737808983381 -7204974197101757391) 68034727473703353914019458883709211780958983263702756416891835054494728840771498925306650413027883039860202168095834137357212487561983607389479135319040711944281262212918971)
+  (num-test (* -10658732210276096534851972646242288663170038580488752611749460640657411087860047053151548660331707024718100598181073744715506934778234716535781332588396176 9193953347013373121) -97995886679587166046252015742839992974979220158813197140160489510432960510418039749924861744197553021702396544307690217470606424904065359660871469041838900287446937257585296)
+  (num-test (* 3330096979672637104536573277593029682675932033891010715180474877149733802060455951241981993421466123791200840797318740359792251505430948855600408060492000 -9413190658845804679) -31346837782105095097578725347257193539696338226258990009265748336528353873277500144838721882313026604404426563737656928378230261942407473822851842589487713775609448642068000)
+  (num-test (* 2224201331350479188470378485954814766783857696988331736807430786504130570570323948774102396158334805040994159865821844362926631687258969480929122732089195 10226747830478556903) 22746346139936030910929166328517425029735137934434969334578972386859485783192993228082340012742115893176871887387993591191632260444955081663604449277961804869872353878963085)
+  (num-test (* -12394770820700925077767705800588617445613665027183406054209162910642613421436080064653443098327137503596792411463268187212855350864330592654862321763110243 336135860956209890623046930607725140868) -4166326961171213704571179876442248501325782360170764344978629523457550315208845439497110652079907652744850691289494398473488033083739905461347650605270023127087625641779424751335704552988710924)
+  (num-test (* 11792778994619176404079667787533709801900490264171877873621265044313417667869688303207909681289642260521608966405181881416781694320672906600599581862090088 -197661229068721548419113517262926820105) -2330975190212228827672814304508257223671550753091700552243633152084831515892056240354560520878171696176381845689952044935988868477421447557890739834031207059212175922089523097911477486879619240)
+  (num-test (* 11608994516281296345925963401821217560860934641820086911326880657644311461955556832927259499969983808078591149768068360172431078248807463030805586293656663 -40654941048774156019243747229920736005) -471962987694958552110784676392477007070112288398143925079396435246284471999814508543057304008480666763661066976653446723271982094424149279649226771823800871458389214002872916339341019732251315)
+  (num-test (* 4821517917539756801293776911844480642406562140007084392649374723119190602353617113036081438891134008988421494142194891002983491670246762173236312873933599 -255528396376819316172341014108564420589) -1232034741571035406264710387186737842510579499938716343220834781077329515145216794636313459582844773420679078031627466542930137302257934575129329529129776153159694412903937370462708576694469811)
+  (num-test (* 7638751115643228563298483305056828584775811590562130101723525925933790010789130133831569153863129513189315440899053288261039147463032870669035935364282061 114438828287750304954799140618669114911) 874169727255956505920153418854946321208907128396839975975317705220623267360648189969313978740314703015845506506608054761304647627635292132043887080298168302864314697920637105700927041824911571)
+  (num-test (* -3653826017463740005170218884285271512636869606149686475539243914909566619638259666405831445823138528809165270360144267462878986866506114069923299116957450 215752050445782448772085819939961259625) -788320455239949216234629350585027855111249573063377172522422069903710014529292638311216050777840734448624510386643245486023092483841464815987597578151663227035102742664709136512524899527956250)
+  (num-test (* -43242564273985683175827997542883970694363047476880657467026050730764924897992516355909421962249292250047896135687573746158665836208681548975073555418266 4424346097667245771102179669235543742385176589624011161914909311078645828684936231569739522607200308028372644149306431599085361996722603718517735348761218) -191320070498733614136284309000213964486426347688040889144514933290125387693498098446328694172047943298442181705949005984031677324306763731212307716485454004382079159622650481983102917517993601466178931324415483972311904823997211920702201161092866663969163567426868740120661073974542958600768774774949607988)
+  (num-test (* -5093597555679260616199210906198149266592665304134802327659606846977583233938836318559188141955851256260954289429418183711191354912372372976165948043123133 -2240632735861652612028397136046974907251405868353380459030143407902436514978447480884513019736738955326732458088791830752499716417751919868492224207936623) 11412881426559848135724717164530530041659963797467536748076144863846600718211858527283843975968920120508569299672573958424908957105703597501013710262110218780710678312197455759181436286391257283676806548463507528765947919856827004176416634630489598937924092540289712219714362500246928243091408698274649199859)
+  (num-test (* 6049789822056553589237940133475342650218069231558204589924996117723031491205673061674252841792149409384720347601549237626288416453061224734057079515141650 -826416247951451524584060567988229017033981218652490450160817307801130685352465013890931297548015267655971295627931896259998420078888499206031390299169584) -4999644605638856588581238481465237523157457201817697008198975191261856978252081380810200468420738807464233192102972784271159116426108806200426852134469939032473362689081653859652824862066224063273799612269941254948709760659691148103622071316554194507524610166457990087959160807415102946877307193349131573600)
+  (num-test (* -1175978338162966145239180473229656000174129248706173549637767835154921467129547950144109700900405904250603515318348888619371004435353505449762899046094747 8633693716102199391202401198009047492431980605560930404972542822133579985462906768067706391388213605203282586546130434156768523403030127356256666478340720) -10153036788469908062299722391986722149392791936544969945546931764708792252481931153733789787389051773529081688846141949513463792442701686406966696738286561777611293604311491896230769507535896070984747493738525389837795316954065260075941524322954935690803870500012809797698319359975893462672845329776468197840)
+  (num-test (* -5083395547684319640767882199938390155755986838939007846911062687871291096073452055061784159768637502151635665247461348347470360218957222873087414506633886 10813098236568616588240471432239693891825284805405416395976866126102880121934298269375465735278296789484402954117593716698067735458182402220278016922449294) -54967255432446073625448401244836956268872685687128644401372608170106281377801209665004925733448944141633739594240156882328181133879414641109484442890809130544146420476457200729843868300396656004198615619691952536924980482714767859804902602805398865249514544806725162402291122143659939645240358379962457176484)
+  (num-test (* -8944626200084865988157251013718979706166428261352840753194709093968177704853157211364231059892647813839391802007588961807572842923682104089512428902387812 3814836951264415657788614449012480613328314590744410079075164918748648723114236698412482309581077603776489883375576245233128800002373843611668945838558629) -34122290543331565327874124324135450224668275222811493728051290368641401807963502623692504750924543845019291736982354932620821594287780848608647686402233097059022704206628297180782771812500512744911371653368388270442874670230118309469599458827222162362901084328510647514081302476000779049412605744638457029748)
+  (num-test (* 5186176030253526423885531264483408352469356233262336223619904269047786350470477526433506158542551137478071074193659876898065998079440819597952826155782068 21428324964794197485898135923805540163916541943812058590308650649384013587098638034673796533027113673143959572855470411726978105342739938341516634354246514986124789451866589211982659199267654387148420461876524076040233779391563396552267276880650559148637067641021059664960876301072636635299261389450890094318429077561092553337025096293793433968243940381587994428364726938534453507046761494257538813861046058298873206568935790790373886840765817404479239485444563488020955730741209738203470138117422899051269778988135668626686262669881048094388220931264751830393793846372816717368806996496715219806062282836392457741918) 111131065300898907482632501071313138589398597291097276435916516379173430095773463468344138866282820740991088290299992221985607057347883717514843661030457396422379155394966857856069231504805779448809986906434617741485942621643754096548512120178021034054648207248963478122178145159262707381679354401629366698488021743300737044695960363216253889163551918513521913593214414139637549577618641974388739304727218804595402055185824193445089425262833385286117064481648652550355832014346131722965510192584901901111154083186713580209077544982897821477349293279848852596241762198202012197892321827305803333334823616660229870976569043453639028059771892706354703750763908127611939169337399882784092285804830644630059487027413697220038110815990084742241055099963659761569486906596326424)
+  (num-test (* -12615422028124847936088012564413126213419674293830655240645918456932358053670311316461359727921727680491520480380615359506308571290338231702217134487397730 21538722931308708400287621200994476771789912594554241036641406577761480056366647329031140922034590767810855360008375309986798226712928670905618807986829790199948665185268081173685941421700542631395958882077936923141152528333121096909688700106365468854487023847026564219531968849793109908193037522063952753477768381591929787242143631287330811801315216116212154423972654430356675401769729358415036943501470085182304183033246682446978634892995900678975109490698283226559860736462409705544079080978470202336645384768211440438501339641775269445439018148409151795830925198162301321965042997632479354427154223366199106583051) -271720079725309675925162538296715595434811519956795637977932956405490708202732964133816538801099235844279338645471102896234318181092598033040518838847055114923365599862266767493227393553801736813141780001130539648588341196802606083178208108557367013886856183999712817955194261262279080641101769944037282423238147653270651419282545398168930625797556638625301898893565965773914460998322350526545278664715332414172614761548301364063397364632709194713561073496860524124460861314674679928692398440036071116570829193414179054372604203478369755566003622621281005164747628075596444178089558747835994702060740334079222508147598079351187013336751322569865313532407367116553748939535664259669808534100091049960040092785009707220249025633808590643620557093069849490009472441113874230)
+  (num-test (* 10381022953674450046578890619826448644067144294659610359943634722044183130638243233110364436029778310048006743033299956844491228999113516347401915490861208 -20974871685432829994714153210121536409377362402944992609230062091789259307033495284524234519701670462495676590513192861649457148897274608767543942797542628100823017887236899471151903799837558453043431373811892813126194662218472834650841742305925226558315372771353677064933578639099452438843500601586038910108679737480263349221244638463171088589123712367802373159421798288708123925853179931628847579314900787361946716531755600236755527982132768286927549323465697241340003870259800347640599467922823203446834792229595507968354687630029075884034263531531423883902851487995214646322431057626558858528344843531280263328354) -217740624416854507100100919338835880277259264187442792458843251425095703739537223785767883764746809214920580060316177442387941385712712426957388995082877226019966428812240179251716274377143798847348759498926420314709056615470455134468678662646006408843897699718742372199854223008996321568642038054564397441209859567556502098420151667437837356649730396360374136203172669776530655738388121236079327354422138744456395348910073462618440421257604563050031602590345028438897601523520973759458890228893913090702884911857207117714231568437403212806578764580006787626657709435954760239671948147344463295520930250155876010414461245194991189183956653772752290656063730950237649394743456230607077768595983629559996700837383822873994717987698780007691157576205450973669241823945091632)
+  (num-test (* -3984492646329789478973994496812455855595578196959138558282015917391108383154917581748539892089090551298072688793487597623310815918942283997753800645644511 22199897116873160263914990610762123553075230334116099569358672964060004245706770678771431369917479502828754815568950371273785689812698287446020480951417047185190067265849637510591502642000414540862689426343523077229502494771352820057572619644085930901096534031496492870227890836816886496090287321502805172125273822231241073590840684742085641304915656543831190976008986490532066597410386596132766422026234488163435487889876791504407434387555507637783709991326338482319227500686541368087892665100076351075069628862376686619537655838590687615291898971286325099164241688147975845320979841704002364545072665891829427213069) -88455326811459002089798581395024759975871889172872668466370443703433800509268320055453743803627754859670391415348970278548381190662701716228279482045339649051139909543850883613464992501666524385524517648069873862957915620016943364950043289963237718026629805297916194484838158010754666017024585366330526135823515744339445036315966714684052345462172808299142368905939297220895721123725415007532441824406115746741972351142687017849809593982432484296719999502992792447259391592152463664807498752410740679664044620898308783634092355737296495489953554685938970593890496829484673393665321572846542839714620847185428664388282452532264810310019327395691530430185946743995669191791841546685206884247468693248673484055915613115527492005264289557719000245333079386593840592027314259)
+  (num-test (* -10672574004830373997900438516438419278676753890756925443116289034080220708922677740383425352837266631691319394850521121221541344600832530724104047804922665 -7307684417326792807224298894786988180161884427390942431653062127076829842696634441114228528164049031680536693195116703321494895319862805505304314401000204515985676763063862569446064343853536464020413910728442475032187317639476018710375702206456631041987826826225461927793241495220512935434301833094232834266749666697332380140380619185254354273073522191066457437931022783436360434167505326773192959291779779370530770935758482422581712556111319611455306383173529090289274267200543081481693078804068524057891845603351773722737987393428313340760607600482724483853560340630587029610437280601010173185018227638972500038072) 77991802747865927212086621295493124451256238920588746597961055391511562690441964216934615500942858653797884925704270904527938466874924049039962754703188019915846345804228044693122758075602494985337649496117180241872910247079655077012999375809878184011356481981590430241786534827516536543734645410817621964035091467871491521760928486006653992134635010794346993161329777270345449763927429735191213854873362673179799811714902439637861750855639857969259787075469241319618538795721956528400353086156169058060112255274542232054021662809196965752800525093125763127895334967094763817500702626282397394521201385439419885607578137159972521677923972708827090645776826953976605193554447841693259586575931864396484621463004541561908426383260772786784541411548146173991869741515701880)
+  (num-test (* 1420855003086789510813111205540636553863493314684153860389816109865085846062678305775289632805233481596171530412925552158799875183492757047174905459819169 13897739053062356545217161606361735964779941697726983959749295377836209520566715597422965426908191354971972501742952706730523748574796773473606175934144970768662226027157110240776527834790487577863781140089347362129598158760833470434895693782503529955845076709376071972727346128409008293671217324995682020009675316075606538241192607139905488719485728099428376369506685875348346231688684483781160648420909364963718027571565217314827671844485031440079254478598236877074793221578612249882886835580737423192061550370069895525711885220268707201966615936769696379335772521903910689934596134239331592980694745008817040569590) 19746672065138309742065153069587996891492444461032276894328314121573439684229636534026409362850111716212254549198595854140809664451286626009917828620279583631575940837712663100442879662416765138504151063632823014639305658882804073655537352377258786105147057375069447099908107785635606190515362082317465738205179108333064680370909383338688734129396788764959056886328471374018961975554190739706996184818378586233017775166959010668462907838359485424792026496574369912033757997469014639705459505746723512361959074802456098328538419933637295482429555127226978561859965498424173552676019033370307387047798600024901453757451579262061785051932535359410827170361533603618131510421439128567361259204833501190218719779570258541358012741265599985490513564378203502703406698160470710)
+  (num-test (* -25117824099635104147178796272946098711514362630774369209876335291088434247131228189812265510495277875692804180473811834186270331245779845635089547499275113671007257221593872123397418355506777725721168216892830217596134983713752526559153149600553468865338887605949011743043425900799896245185282419637806859906582214420191794114207677635194054239563071023206500505880052007267243210206807805387341085613436600843317096291021780624738422589234020279836961194869688005260369009833026575446099544900581955685627511787510900479881434909308757027825050977932238481841909425598834367032841935054158448815026264505726593064239 7846111496222858966) -197077248428250572361351389692146917243277049539013604789802566767174747369897711991559940484392921619974209620152008632450612546796556905740493507885376190913893140368029841033442857949219716681475253727058707723386016055991276120001690579154370788782636181079931076758384034193266737114305362492836167078199155929937891579224024229182935372106924021709421948701131654358516297806197381566809357458374057189773041520552821330635689748583803171230633654728360451100477472934847975252390985102859262992904778849652221553818627134153578436315973777720706502751232660284910468721430874674021521629540714057383398858244828214000543075116874)
+  (num-test (* -12000343217458212092754251360179138661969968218789048702097501439124892987400633614429800307263114371624489988815324366411323242909652002510513570900627875514001409309670202055060404640758548257776155562167062337394219073071639153822126554525439988062676648294108951003012550815746564810508912122306190725453386412796036693387315128514162061147675205485143205925649214342646148112549805850530430229663418469577245456944558387628002442451042105749848177325651852669794048215063957689756465788955050513359977166122710392613631703123491357791351447110169966270916789849428298930624807758982400706608788793481972190953569 15463017349709835150) -185561515374029078700596518575548896805308728003103939537818954646551372890610870275966055765608887701776880889777402229764948269089126750201922167386201171243298907675542965323275634529293654817279957832652909009385491998537031060285890512199675273422070784691446251899120095880199298512230290860589352290462643231396804350623684034400741386070220057232978556614620855818271117742675632435727751812101639747357642295230273344552327870600519422276996860893842363996198017494117619585153346745838853026029459826407782259598477529242420507010652705302341725948095720110508044256096963772599572721279996322424269691990173052929936294150350)
+  (num-test (* 20244597897909303129995907707212050478823487084391413473821544089492035634291726811145005824559631386634261268723753786161463497881725871168747275110149007801865428978596190887145324535224079986377522166727137028753272158887188902047835658826867304220850429481233026043496635847568448251753504834367809877190895369288045026559783632709799678639927825194847005181499299410953860627694080906167346078299421796974815616608326704894611151743720515377248152215241639534004099341398238713597030368980166731393247619511322804984829747216779359780372801101821087516269912916462719248736442644433057333788741151270815989388229 17931151643499274580) 363008954869078360197158713265773114114991766614027768774402465306840646219477262855625957403406166192075865834283840624408916170935610374573318606346031792128003204902147985329385955814330782527184421959263266167048755628089412213360508944817963403092490479480264538027768728303095523018598016863928762335410109567604756183580676503045557867957273324581082608248341332512325136675167966306268035077761004923732568405295901819511346235524577361289712297365403327125212199451099538443576479787130510546755789504852631291774614010584650672707483555436445926222945298928326313943231688436271883746272589347954697213098866117569339490918820)
+  (num-test (* 18134862906191691435095953372467318196853760384894170022863300447691250350836421337333332682828557871096554531436829166444150586004379181099133295174348038948038399079336722004125999533719492457544642570217406286811480006881054375314838605871238868968956868878182133492469763282800195060849734382249696543089869191257451321764806079423169235271658993054867624410589213892458246001270123109841429271429275464249821855221014782727398959126117031823977229309775211695677345378510417534328974531801634095862859684508240122911023047425473036305928743193594967362216559973174709883576295373749738633873828863608550295977368 15082354452174510460) 273516430292774638949326170314933525797985748367549139070674899956657807928629067317576809269188258819686207094298714770978509118959142516619521080722291318367607601498107007447014759288176261262818034997399866363248136237609824401265450913244758024085739876914482935655100890803279961929047974391299795570244708811454483314898873277493486428279875241232025231140855860469097028388778917980779775554139507550577255217032521719099071084956515691364008526064349956553916033914728254580848198941020806723485184338914882588931083516851849558411503129184026079582257756707601984686901646494090820169212279581209612798749779318126482639269280)
+  (num-test (* 19213874382308276075905228027166553836726993832150876980655958901416537033385379180983129528081628446454583401834309285184752924794893846406622935494758142810049493348116192315865522516744262115026742103678965417868790607689989205765793528434388393584537260717130892518011447327847533083474230074174308157934463971640826422302901570010591182715932658037868980053012095115562188975692530473556182305847290196895478280679341869546292639446526021874910117953225154204035612531584978136604161393474554294315903436682283787080297348697922389355209790646124024053098888687638640826064745026930980189268652291562437512941810 3155416591710364359) 60627778016974262766014671335614995348970065077989108071534610098195400001445248886220725085881796599270026085183075312353388418711598523030563716616967792282609748819081238929738105086199457414615236966895805539596649555457494710621217412773036416007129418290246899690911654008867819945724649185574237527152410775686803449108977881160831441280833577932476667657759420192656716352190871667386955409426879693856001112340390304980532208752863058384169885129364117656404549585836664647784765508649117301622797243353610345828189312360124462238989888436478381583689386509617357901461416012201469794664889076397809504626996523928173064949790)
+  (num-test (* -6561903839860415551587224953276060627466820222543175464705113686962550773423611522044145975606965294164125376820288981286542044306677764776675868357117109664125730405280822770267329297542599719353907954399688197248115043785617436343303277493146049939491224480136371029084354063731401026459653680017632996944506546122253686805764620116169065663214526857151412139439538335533979733329962892417175374550305659302592107472151941922230309227785266745974334776462642676959433923828440435340579340133192678341787895007461237846313005612116885419002449356480017828933592324336731295317076205553526568668826499450826560670163 14908715577157091280) -97829557993133908713082095435440645457469053259814412551982534425389603663024461131358343104414088618618030154957456050473312402460589893359522167472060177968099538846750606564761307960896264958539903740023783283814849937681270591589750181462708056758506230073751440847913386576449367635057595344744119561166438538811561109125506233466453974371464999669336530949393433719456191822836826214814780222021267726528396849558417851727452246676857867278196266042327956933753121947589485377148388716839519782819642328655117625818256334190717182923260613562191698788004591479576661108985313450029332968584240383859113741485244318702724563478640)
+  (num-test (* -10378013547095983701124686671659666242518351347561698092030999302329372512356819420877395264401390796163955327080881297568412490286247154759694714275858127906305200295043241717769593877683535229411640745872559018085757273530771413156968541499388413497221629366848027355125816131586610997516488552323667400115617175682996681969687885201321292153656071894385242141321468096793766926179134511319941715949712230831768643024119693594235207988046511542691719002262040067921088838755337917414526554050602539873232518619281766327369577617796816586064895744680567067970817494102948032924671421242699225194947982378019119315136 30004910492448871409155105619400474385) -311391367570036811050052853596227388481520279736812036769684195465110674594690412517879149770622679377262288447706750813509857551308594851067359841826754786725926298013483569424123912020079066150719085450400229896983461212531213110847425940968466564079253939695853896434719530729030897976597410468081535234663568150722646854183317007227669132983719314653861536414057481478039579810285535699518386214012059191958557306338432321511585867535008319640705419431310336566447165302011113284064246284641707577414470505948868362067233709611758700034131461348997580441628136979257037186480770286846026250437141175360847735150981343952303257191661069675154710791360)
+  (num-test (* 6311357747888359229575837883366949670125882865462293491587368290797766017168248637163030339387377997726585769250585768079027576213724941259801478313127113803503561717311996500019522893295813684259416551410025111443510215766297835872165689077882298506134885487991732718254835036694083204758447948541157893533099634169589161496492972953698758234452126564385255035294546278732684663873459439615228706684138982066055370429797835904846166362278557095045056472775166294675997320598469599722704075215700819354957397052721573993997624711445698656580401684113096559767093466880001548887739825916626416328760047783071058963451 -212654096583990292869707082365869207538) -1342136080095566600483524091094048745061145155430997807005186206704767933140306297188996797343723817220160636373424666345108189275851749622201429179882167381735732553825696482751584102093819432866729465599060815670807282181979889263381844726842751894916887860819210652174987999919869623292751389157233409465756974677789790982740267208982768450215563288024088369480574425410032306456026930809228182100949940216614156925537929648841127727165386031716586596638254705402653861723407930666152691102484352058909219619985877341630210918347460471644327858114815713557305185589162775699323253049631349906791700893878999711846225062306568467992135934882289075693638)
+  (num-test (* 25104391676237653962996674810232896003857294806799086059884413856421530328279649263948893056601611073815235439115612155497964541323584159786678357898152394779494741995735881624055133443980324145256438160990490767324719276757840825641421547232460969806196141938571103617707677351907526127993230143577974386169402623023560579220343920203666762052525898442578990183400559087522259053245822827313206196194989095468393682721753147596892214609346047051670610252732846805143964713621673722554204896154742594858056891979146566683467510164875593192581407047920719605560716270697985110227952698114701527191421628561835164291236 -205991315859231724218751687295926841150) -5171286675233738337789203670843122752625713948587464573381323151628930998435518250812603433784823922283042037694290795352461861058217142213862777203850665369756106838860420507328654214723398688455622487003912073924323587826356928211672752672052670663842775836967587150049181838707784871641183683742967716787111671792311389517753578360293551031540853470719098360013225516593755039537796518619542838794169319227197212817921098393499332268929332950035803734983497370378852859829228973012039890600437082235032378948656232679080766068869430262740600476498399803176452431728914806536862849281928869092524387549297345184969051926149006293586531930828748109161400)
+  (num-test (* -25971587288596053786734900662696128734726180676323130693160397208008930123341700520454723462226657743365779183466120836187720332442041321870351823609046027805781414454998487673927365486893294110931852680018706479684281928396163669935417207859889405108139261480861908067489849403284000981453574189898304616775302917687860062501465417706095450121596418236563421425311420755550335597318818628123183624214438801254105808079227429950505879366254661664881055965092586612702279548151277733307180663770432418397550642136953750720624507617115504303570076531620003848642167562950736271141440609700821621532583527124386811144839 -182748557863603655835821910989658558236) 4746270122419629115710902425435990509747636609113505336611751359043717100752575149404352359855260443259846554733621122684788488984010741203981300775978945529551335641218319619542248418128319220383298229263331638090009313676486209764655429828385994626323209879925281409485074778611946493692237774852428345451174837474328995186242262565013937544898941834362941815633750896882758939509605799422068815435202904271722442099465950700886702949580264958171808372530471918175963644209760378395316412115175988232945569517230829200985652504383431054550902852797293952515652017940918628980037316292352828228005975466732028971159947131994753006597870175664981312344004)
+  (num-test (* 2117427896392849163304163145095251890404997781812823978967013619233450901604407363671467658244435728579079751353560538034596183240362499870272373308111405924505741579887345118857908796509418246599428633956038017783178050402412769812823236255234302205027282366926174916871858199918908361186936687654278623156607813451034087735179167324944824913226799346886951212979149617678949292799645035425029596869092844906629996914674904522806258932192931217652241231736891642224851547474205131131019084734780208254203537633402057673465583362982905095029133132240839391503135932501785844503813910210348239157828902668852795945482 -296778668392678698960782643314222141731) -628407431508980610909134894336322264939705333430111861505965183839156278363647883745193463537783397824947515214540990712455315080515980803996660089847066076833542492719707493333185909990202372284811233272987993068106356248349054482194817336258302692039392400931536481136340269417905505366385505196886218794044229758585631131853635721528813397816307666671727692971421531381290925317161326036075629905443938124481334173158440927555118173661486114828362551889594188958723424604273078091320087897088472418346754088900034854230711982602435635574895960156993014703292551046970069204857846207328434544990709459402656908170089318995291341536347275682867153109342)
+  (num-test (* 24743327715258194976385899813930363006464428087412805068703455203318769863096919192538751530954777047772548306936907016751357570434930538612382851621309732767199276228580401695793317612267605312672263736938703887622824117576912830029817460033437752668221355377879837833796222831371174014543622739933433581963103361464022058091243110136610854806189138108937004805781857031030005354158991203388998364340053773883952742645161560754545458260688560269655272249435540890073696261770299845722705104648358053080678920468895189601731801025555650490534399590288852165862135571140382055044665678298182909026026068995867606241201 309156501491030456401354118244509785044) 7649560631695275371386748526795333430293346807872366006552933839286343590101586516802834568317627508914888989005968805867728947519409222814667350103434422356009252082456906520988877859152125402282765775845766265340707473525444185795403554160270722809642681642831847296672303556012796775586274347178092325226458743113317655523655255626670958156216225968018208281266858684283741496986683426354716284780229004376492833583965647875097951642088252875535823145900129967026856898970545720526282798418382467634180690243423325770596949644122541224189780082061715230852249880601371985342796525016176048518593825361248232406051886794538203297084423942036889326397844)
+  (num-test (* 31345149697924857384985323414506591310628538098830133854928154990821019223495435414394178930529373634315044777562902565397455028894455733092896622048288278424884040917250546068175763309233883078972879622697667174865833277342334219810618450605650614585133187005110148963483824629405555603493157452295284935004578187488673124814714326405406894084902824045787647963172437833905574178160343833139650913077173865287057167288286708807322607983179910358234015596109655900840652230258122852488289951986129788952718105898226951651151495867246384586164892018870981480003722043190639707903266193064807571586900961788679579912089 2067227180806746570739122295766566373146995767544546241400900414826379465803168632854028593293108913670556431832056563218709444199286888840721753894461468) 64797545442006646811970698282511426059102976298051534827345388707272469591333019870381858263624490336448197115781363489554169207652559213486772008013638214870324260793199674746523791257170452738018910619029072942848422098770309928561867618844814267276213608306045020686764830302020953883994906997293368193331696747777630621086600981981357507299729947717565760536305785574555255589190221698706036770081438750974356437738060098906046001271392354762036427049946092656701257615490057677558059955825843182799904828201890893555678855718728417223845757559310912618029462136640226686626513375024547351747669476392735304999046232068947570708757930233036922714350584650744960478326257916948676866148362166017752159953504981324652709881831381637989229842766220141292801807437886652)
+  (num-test (* 1965759082776833678304908699214846485256126608825750175641683294458978302204367346739996602241053060915897480812220051082619942907491598551933638540412113496542245474287364500698693202553692963910123752514310355402167440783023542848697962967771951714434359320001430281377747193083851165947498546085410216620013287853719686698746328198021011905482303248172483782066908570502837009924228011993318265674390462360820566174204659723461994730913995303015012684826295802887547970851558451858623353950391701673651959262042520584275132971807158231859672678070714276061110616753309305801080136339206017351200193800253572481467 -11092241138073130060021642325471345789108575712118027611362686690749327689527135459714040658411176246054106270789083336195599640521602432629024562630323934) -21804673765518097879589124792137157558586438669762099454880024920520894260754279593873244443852337739758694535682558790532827482894104906218015712179591886600693703465749571299271429989154199263793230178266758966678432691901731270899259065726530463438316383699558373053423999416350780342222940065486831353604365192968606300436304827279383661172824549131179471364227618431414928702407510473319879188990689163932586727702195573766225861364297410904859137393184592815970592502081722125458353280743087607273547490382023433724488604177909671497082747464946083901888849483505451426245881736990810339421864101129619181017696837017966116165703320918568645290788634265522956017905246042460811062666193790657969385648522736090098231379029903772234867701846824572274796526421531178)
+  (num-test (* -4067457132547237558852016696244696525033953641638067592741078194074861352472861925779476293767777560910963786727886946479865734639031042985368829200802420611189793957001730656623744670821921724417176679009632346904384261431052972127975733031277489967119978909321422086102208644766894305071609385305464547231057263658903212521469801833214062476735046735467944834107695748433481665714184831786462886261252526036621257865158497049125410241033365487816324425563483999957660557670189397770488996359512245971368638615503320507431381893539767352426795415898379765583574977542068222040889423739693921998717145084904555464058 9635268828818063607505341812331931088336041632536136269505180222913464638532245578488168867093853062326136774925531196873279749483997619950077042084971972) -39191042921786100943542578352486285322085069425292685238158202937549417928185097567102615300826629615520476316505465412722375794150552330462353356124896483739321653441446703127728441315609093330694305784991844511900128172079464896650958648496336601612657347012294121239821167759496102233234525084695798195547141521849769350204659392602605928907953707277320590923278178152903602506284861018886300148663530071056792375593665422754923886137410482547324901798328311927545105456397213670390651819229021443747424183114992653572959318104053511452473611466305149349027962240989590453237778130260105665310067480846969449221473610614214933278048389171979184119355459010233147440293881252851501522689209874112819966647846701257081192324007280573826673895648273593609466000383382376)
+  (num-test (* -22047771987573494284336211037167956208924595972749016352929724093971147687332865088249749580556015503923927321586913446367676445848750229391300778587369581738560634537089081840938984779012854694220894920437076215176060179241185151442003472788530160589267677502568156006531439509890061829154786579353177129190813899423306499631144919702707240832059008168851983259611724134448165201725432622521420667808597545410136493805873769372831833878868603946583848422310946469083400330960925084024624317866822897278934924368888332618046649078771617892961267312226309927786691384460940015979582201446635756024251269978545916298961 7481502540911026808093162425787184755732317118387068406204973030847892995155568099553397887864257088525242568880427634318737874025160499293315047534753494) -164950462146458057264341765173378248123415893870534274075422323606836246718538063890359159423074703472625232511667875897808555123518162244263016096627959208397334135559180524195701526029092734741010866589515172934676451385008535538102832400604699294088534999994990970130226363762230944961249818769566697211068918154629209895730969522747736738946126971914549491889482944152891334838234907190697109929512401661529882587076352559260375439428815896053844621297552401396168240947357044985051323834074355418902009161796886350497072010833513601114819625605048943438304411954380599728561071485061414856047768286383287807924135081902458690495890129203192613070824670256334683011083767124852354110322463725619194174195587835939047474059288568764831570274891727391545546467943319734)
+  (num-test (* 22607201423790553279447786193696575272983924506336369475058795405894123712509544256099524616893423762658394830755129501447553593365768543361107397299007141714383407862976654294384881771985218996697067215804348472693636567074361380875512341556932579903687576929186215185312685712277482751425466251201421842248749944123326048360909954588266368306843116245625635467041934524547983478110533044085242847795585598341867070787331785945399446665919396062565614516404861115244243161694059679274045050270546536781907061002623188435269769778378780371158624481539046590932125320888745103158180784231722265376331553893647061533815 10075764395489719205294189472045365742345400155046712954334138069917417587273618147303160957788995022989479371576840422540097479703418600112174202202728054) 227784835187493343385594867881830022845566753253174983274076326016001091958812135049265213053390506720261776960833046225700903422206015373488419693650378821159134369608830936915027161415300759990632038898164509761337714774392506802504397626551196717184785586630245704512525844329038355790338277254618639554796026366029578805283659986085947726260520495140332204643887370987929304924491772630534558682402396784510750317396488402942581973350428066695976988812610467654886227733900635715495731445319565054848075104982244316563526232071957624002266648721592744376122065531440026836549316222728280595228806728872537793522244957258060730038589170810090676474272044568671474692128168357087077816573419470273384256552275636517940058764711467508281344270125535855785388198570146010)
+  (num-test (* 21997874907846585575969651776904015812729615626636027149446399573806943459105370044846476738175828244018281160136531735881270437472624605280356112191272531838028896521621800558410217146758345955334174583639352151367532676985598470747138461153212653362188252002768647808852054182649808145379073620834551216386805267446360709820441771932135218282126427988826945094538034579367527908530151926679515746133600376612899354099328788736038811470295396365432559354070365548930628714861826464935305416998192532029724853617023971964507955475554955277722555849603716733374588174421463022213135839490633927005539569058361144905451 -1400498192750070094581812894241996480373581610489471746158083224360249880335094841398529960182484181641387946900090289855375996313447832474435929084180606) -30807984052781257825246153008277875918087659020905755686964119182052911551148620538090633516362197112383237624321406969368641524681503231262834662890145617622830207559490089313283375890353617292096501953380469351747504928597461154633889236826060654886877907382241867167198409355653371944304660938495445848950444683274236538890057643038410268234731745456035923559528706349316582901179686671568504971088561096469997823300883298811440849031903066114422309644669680078733839046643542078157684064686933779591609758494599988463628362190034612412739669041368897594110022347872452261447359402810277413572637740870748949093642723240662839444216981630862346445890780016393330114883270596630385367407921496982236074288475142085411632630374714528706189796772213264952893973677883306)
+  (num-test (* -270155241925436273159477510619232592261228150696806729750247050 15545126743930076938536195287546926534964892301082800206802745964245668351235397 72127079799316080210744562119267314209211162112457416152560774669179705347659265 58427280233475514109627698916382980237252687770812483048907352594138577656301900 91336330475502063985843547526216808965829995610054777216888670176112782119332811 99495081134815818196404370468895496198561677002653930126818668800341380375657337 6904264296552316628911621065724553059847235903647375662685025031963599691416829398469283631386160328944460790101458427909545198569619131058877708293713734 -16074984786353617526516141164566295497596312655026144270863093715961484079732496604871734572736757225277596743795506589617891195569235287256031608792067121393492186703333733526879481948463529609113624075923052999494363547340563039654910799974388353472433635130983731604982117092991918514078659590068643956240711810902756784590442416249652077644077280371860780741318193975770906075446772544431670392964384669681404295839302410058434872964315897505894833409101781069230919347279857855594782111721176074849502391457684148683668165019969667481755384384017844104770253558111588611189351637275389688093074751942960310850074) 17849860827147993486644896214424106325295064110723402251474432199595968349198253682890653243676378684005650871261983711134190416277366473221365848417375107498764965893729640224952922241531788638514200018520970345581414705756736222535562338748426356003659523260330725662384208724142177900990027225665451069059291754155591197426279006090296512196415617974140965334686090032257444820748820516976632201388937358434205022475303705442914044454220818215336283948743042841946229853366515552653568436171217572212088935263340599371830215580988184775240338748954666846379831467518505260487989636951404886967842600777836444030434816421999334066711024026401362115623932221335906548647785232855815515579448393689650116225664467056283988125816950714780486880294535933597118808163054631168063568847830481653855357008353733414826165759079092633441356914450038756281940532159493763482047244493174370100586359619040444818634156576789665732998111907245928253704097384811414269835758656988678207624731164159069547745777423464124959379113843649940896359346515513936964849811155238140671698227057228045173997904545787593258286212427476788605370334985423461194148838623911634821153061693257996982252745844329344589168264774527631972524787804330730506700000)
+  (num-test (* 6411564443509812216548163965666668398784964137255201222920640150 65325385402074288043601436729391841747319174569548241717675134253657593233436152 63305037198546989906433329294566491017476837189978173607681765241525113921707860 72383582945810879300930057856704905379805338886592055772943486702915907397618845 35525980101796892634292856352740658817031405780112750352735419884048051630180860 47579150292602967366908574298176357632207539947399443701205872093150879604391127 7775494633965874654516687741429737470333189902121089184439228657893110997221737422210698789286625633365548095171257583020272703565350668755439139356570 -7847653632223099338936161226557020783515367997970448568586056286591257384101422312757649765574456754668588904917800060981155642916520580540801153603733496143328839018174649200566737789874193483124577734129346933208306772618814806884416239295732454033604210880463262467564639515484363761639994642888910703066277724414372379965872478153546766131136324967950786993982228851928269842355632200589446224738709869729930285189047112131897218464505263042012855229737941639093204086147932759923796947642895167078971517834730472596647456786099215405165290569214043431009370032818978995463168133051136053246705694337584724712230) -197949741939898550383903354028842356745461597695099989904494711851411610441324234089773644533872304737431480244289438922163630848266242200711131210228027234579469457105291847132071566876246332653149194709623963836885480655282595345693084881617726426841183231475364991154699746506928116505297453355016975688761948609740314324443406930215518937775475617384099331839748494157863510168743547396262979908353122625808170296763676837551973930928848463398657587603606321137626467028732193151671337338929938959296176472483674270114824853018199281637976410726195357458134038379491704909997939715446657856320452698914513791221947734373322868574099599391493563479057703049036936132407025278683219316357543078875410080612067641232277376174351958080693019953378024732243763129075732499165068171168470237875348580987967740148512425201518758344757030205911031119619416763996490581551977913711646761182756531618786226541010835120092904291975494846126923510483263978074437667987560077422810120462938292680423746968095994108344184522240467647491991837793653579480334442342102339933473270535800619630342940590477752278184994533764839125736268376640933720554199782388890444619996919031351334561766248781813883867406045414518951152508504891407920000000)
+  (num-test (* 1669833986019218156514274418186396165434871163342486930502417566 58528969848472951398118375496887849181512821636583415470809040929690124231959506 50098163184827557635697120379841225459445103589988345336880332217224622666020381 90445522698871905833766573423181067004916996574451008349087758531794463581708977 92366726802191504770638415639612204654473958526592425718659284841373421985393966 69096133232785816552402133765198624674167660496399099321713067612475604030259084 323971624832697152056406152359288553860210436839331005469891386690556929684663075996719803995137130737141925308417709520389528780839777347463558171582753 2635514624483961079560488004237441873979133312246005082134175818331132377114926863102436691793380965631848192666106793612266994709357524826644421074908075389316030912936338175907209987972553710900613011802455058538786723149316934049388525865455871552882282353445228425640452635081303490379594663330152071465360003249884180020993032086861074931796165970076448856988084523672973069824258299029863033098237556417571526135639288006133579174344589248428714474318969988990720790226604664141927030250855550010512291136517209169959021730625428868037074528890516086527430801590050720467893089085308995719513895962750896813152) 2413207990093478676325592386500172980330574558867366638913149256222218924700401110600319869300256745035993991818342784487193857053589994816247466074246569162659879368383295411190237107255160498774228460295857931362161062884154872938368166514128474751716517750517217000290486110198899480877593169193610813452614906598055909439037075588626529658637140089909227353944313408987644743661503976835580507054926908821206921014266535160031749397432350114673787218438589065861056449106115395189057409933330355574558853874223262465965933679584884152813357065227868165556818717270584803360466149860292769520737249610469675917864449261901859162854558012721179400237645357401213337423255109839806528503425658270050436129019270883446965562683284298538825840361267548675967778385927410390726055957928634152514415917053614892441910675109517307682075989998558764742821214685548219206933043196677521610851950501225469125512893859254575460130829051324112015464552874242522140166275233893076603452098841950130740353331198999756316969161591691095397245996664755249875720008141774247384884623389430842799829690618405724986702942913150258769060684255363816662231923570491001519802836627028431389746450987110456127797025006251203111629141890634728548553728)
+
+  (num-test (* -6520062188352981842/3213004995534018829 -3812444292971845716/15284944374811818089) 24857373879807849010516976362973488872/49110602632729971801355498746248797781)
+  (num-test (* -844583948128454879/4750740551331102615 -1309778567130405125/4885884698278749707) 221243590680205607733892613510570975/4642314113048197066962569716783636761)
+  (num-test (* -4579815856418431271/16947444571374397297 7990245706938186906/12540719430158043191) -36593853985314806270746820601513137526/212533147427761354206383017714519654727)
+  (num-test (* -3587966953201943536/3194797554208122281 975954052071387816/2707062718507963111) -3501690886675668292903668827990357376/8648517352177231144330968693325176191)
+  (num-test (* 710265334225408429/567023629756400552 -5578988760400430103/4131535930210536898) -3962562316545608552741467762441538187/2342678499616965424161446427863567696)
+  (num-test (* 18305319006789031727/4480148641441744463 -1641093267260986094/16028097657311023719) -30040735777106040963634910981471804338/71808259944297590021537032075729917897)
+  (num-test (* 522499067029593907/142530390958606446621834761330018829110 1567459634764499377/31663510497342378306792964160850079086) 818996196770998943862055820464495939/4513012530308148429025282037949729145117603192483641232823845248212618993460)
+  (num-test (* 6214041481074460220/139497414619784295310756757536261769729 12187470171919324678/129216394212432939561557938117593031955) 15146689039532873328968703771155061832/3605070583825050709361064709099418651298807367637359842488375232197429738039)
+  (num-test (* 10022419596195177499/91129297586760817507648681092594591108 239769653037576215/24086455608554015268646156321002022494) 104481394312031409685890479072416795/95433990476618390508514520731482064738017476445225501421324446942302103624)
+  (num-test (* 127731839927226607/59760640855511386051149338950192132591 3679984267166095161/269870724770589242613062477043917992045) 470051161348371979221331000573148727/16127647460431744118786930146746069875784110572380855085272434637353123238595)
+  (num-test (* 4919926511230586366/29288587285987487013553554568227355149 -2914615432991234299/34407808954885309804037535414452526052) -7169846869407694119621783007930483717/503878057947370143933800273784055481319429768630967123178484618174989420874)
+  (num-test (* -4322680734125283661/246950524730861178141734701180345535020 11581515233057355754/82204027418720951285150957025638971309) -3575942340708251875937466941988609671/1450023407574517046920597087724458064116343346221474061477327267648859624370)
+  (num-test (* -5552456004563371781/36434418778024040927761226774271610950778609263056622471030041615086459120568 233319937833204741/228703279535756717601739981368829304509550463672786894384479957768850829340) -1295498689806330283646616799874813721/8332671062513255913250553083541810221054209355142441164334390514659539371361850837178162594438925276666798780352514152276296209564179606228713851865120)
+  (num-test (* 7279569964232187047/36316165899095632459738478614507512808578186173163489609755035948221062420580 4568992288187244990/18279847281938710983382796940666233712517527808023718591530848159479207220137) 1108676634263212048809114991909788151/22128465550033953372731954247755694375180631486898426116907313824243654714198100644737500721615620412852035450119116976232805701601749863504629937973982)
+  (num-test (* -8689289043809733973/34365105035540924847908154205433563929060132734873649554594240958996510665976 281724695877043289/3383396067954681850718083474385093262190311835985400909911383280975222535225) -2447987313255021583629117408894957197/116270761252098802423406562021935246701911690887646043563899994409915142686943691634418411056232663942535537938126289647041118885713303684881867869004600)
+  (num-test (* -4176416206981759902/47077361360975682486641492558477246171356187409295624938308162261216397376441 -10870319933050648575/51626085927005484523186190379579228801774286705829757742503501130303410401261) 2670528255498212232918897515060496450/142965876637554026205455979922464979254073063785755559223760631646970673683621524411341782655829702451013418009338618833412062193643308417898164204593653)
+  (num-test (* 4496049401725150702/8024116634872885909638996643719901973664008349644172107626390134736213108465 -5231341280619167012/99267989241776204190444307671763754306088564051099822830201760217121508089279) -23520368834947889555464127765407042424/796537923785319116837266627763277272873506235001122453584405648384893204423914484193595265931840447141766909166026026228531619859740155558402735330646735)
+  (num-test (* -2488955833769033882/80573015130339486598712021266263458487997757617589137912729682647628329090307 17723590657579960683/79078600039601362101827108583564759878924923849842119643649415446502020994810) -22056617181258995266120581914227430703/3185800618738432636378738398589185111057563002909241393794402306079667392482341108052833514927720630087013771419748846412352850012097731569487991234153335)
+  (num-test (* 24410613567363183821142175154197794689/2233491913446620869 -289777146895293391500645889398422195537/12394177861163531771) -7073637953514043162500219088395995153310329907185649946877180402954938102993/27682296026727883467940485833673128999)
+  (num-test (* 15029397898618080393623393093137341347/9939158597399833599 268484092305118852707129202725716126526/9752180454987984749) 1345051417567645337656755504737828287428006597367109244226136136424901090174/32309489404196149853047846865649927217)
+  (num-test (* 175291724581304230067306380062677652261/4791591464449055089 -207911166974886786162808240992513636954/957635297799905137) -36445107018739410292029741836217649994267718828374576884161821761303211252994/4588597118993154438342028473487092193)
+  (num-test (* 208446980882041538439350888438428103817/11756453246592156788 -99855903858077543170703702663212319708/7775813092266901197) -1734555140205305628415286772698507060801514301420325900368570916304368260453/7617998589456250715053087609460739603)
+  (num-test (* -49595797981179247160347259926801311825/16426101929443877636 104499598328969971414586784725010079457/3085074725343747115) -1036548193567594227670217621556353400490405002875929378150074378019016735805/10135150379689493069951723318357604028)
+  (num-test (* -288919818051255959565698296502103975540/9373352185361138021 77343596824463059344208562767410464067/8355013728778983070) -319229970313622361785032672064391711775428287673147624981393545586243098874/1118778374191039878067165437747032921)
+  (num-test (* 301194765217764762175383920433701358543/150076401641721289621709469985978858175 -109319143590504335906407585568245068241/158084148208214805386290412276525928977) -32926353787549066990014316879429253235742017240010356390402491456481443332863/23724700119685440084214937112355810539035473428177368317381421021523605836975)
+  (num-test (* 14575317438235510996984657523859363247/6747043355688580686998987940004831062 -98472042392613093668204392119412188287/152397803267436514292317070561082866275) -1435261276663720115408306632770383012566806521695455296458086302958691687889/1028234585957093005711368462502470683211464374115746651290896689614112234050)
+  (num-test (* 7543367187310376010646193530301789591/61115754966424662873097894247178344192 309940239796651595482411737112678240799/200261667764086238794802895148430893795) 2337993034909171213000031444662193658341848356694420878002930517675329723209/12239143016237439360279809707749702660797878084581096344749106125186707088640)
+  (num-test (* 306232835922656327867425959604977465100/55646521674811091128956181530575055283 45245255551837746690160535427248646677/3669533234425940180962041078287629087) 13855582919684583969821610044729507626133731299765443289084519977056998472700/204196760665922729081584465192637337445710456706084552841012480810023816621)
+  (num-test (* -280037880297253633994139513185953058494/23798550327416056573646642830182072429 13967268482262630670960486883264178489/7947215947745048068401387767511847243) -434596028812829556627014314125713048434599389957141408329542154357763726174/21014690966139335562014814134594464675233042588696546668504776333756662583)
+  (num-test (* 87160410649223805266866345018804635271/204719779683096591635231158476535039583 91197762560765392928084914476898132964/277206223024759381433146631560580134513) 7948834435086720002947247338196997812861466884983039250681993725808882173244/56749596904412078223459353928850191672356004665473536520452927516595919428079)
+  (num-test (* 272801380449749740391855824723351316848/2170368723435176720708253536680067463416474841046765138040214254204061862261 14545537787709209389572055399030228996/8381323291479119825335849511027103148981778425333781230074116361235206363821) 3968042787871071204066360146704950989545352280096012736206796950415592924608/18190561932825050861659739926693806725838682397154479213760300500132465705680046683155463862909993066621811136554677896021527098482779305371951555659281)
+  (num-test (* 58980225701104541897366713189611773567/10973700523953435846969235385386214078292603476932194022615006557054104506344 21633357583056027790037764923811848217/41236459355840549300942497778444413350482341379076368704834339005347182486274) 1275940312921345964633100864283753667394719832288287163056787891633576680039/452516555639171997520308257003811683819837367444947027711901120987864272999978391252372420644671039873982401560595091423172287702745925783369137325922256)
+  (num-test (* -39569537110370574225194522625562874655/36290593978404925051095380486087641410218299612051669925683823165483928853304 39273660356839128453616088747231247259/28875229647500294680887983884278577441525691250738380954940513956990510132534) -1554040560950035541902707236381071410695075315482961522429891905381129320645/1047899235170633560739863801929205639611958070150694189488499584527041043137082563721218908614201921449076002548982308540689571766482794493357171683792336)
+  (num-test (* 8957762734053174688386697837976422606/712105675122280831038408324375785815130945929819518342973925027507219300067 118977607972668646264715307919875588738/36563306353035936296510796886853084280648109576589600551753305930842020963283) 355257727628119695756412145322380851760544279491883270008434507085780737076/8678979318410478400681656718586483785992423192579006235728835173903750764880944673586689792087386144715446501744012435157310426693657188196381455479987)
+  (num-test (* 114386050140129336980347743358441052599/11994188887964574384037137314302737861703229337059619512751326848591488081229 -50822174853799566513638003084407139228/97406657802317796912648600328217961853548397771614449630742570869667560514587) -5813347841057137571369557065847591420664634372223088557679866032754664253572/1168313852626327929522799656188055465298138284154709873285311568978496136227795809646907486798429717114923178357702460243511883684964123937654308495387423)
+  (num-test (* -22147677230189664783449572410799931501/75580058176304394102183955194485040346816524663599269056794063928343401057143 -127672554664595215026114551202414743739/35777311684781371234035985601066874920871049301826919955489852676067316906014) 2827650531865200718433745248471704607394596478050653604940563621773668622239/2704051298527551014378337257898371613519363350219566689647796093438747503077807722203668806231503452508016974614236112792032033672965127824348803574358002)
+  (num-test (* 3468729773587632113679855593063165286551216344725198121609354788619580819847/7106612002452012151 20863200733446307102600190583661606839853255577505815215312643683864543217073/5700246487811068117) 72368805556440529088812813715602124890901251289457147618293618526488567540302416253970205832659523238561757581481150988870947074663135867252252227647831/40509440107213064064897416415172689667)
+  (num-test (* 43306673717838918980731699770600730039727453611468399058203483818093233880231/6173575908538565981 106634227988568775671050783423559067905086861634892257032833451008548321218936/17988169594879808463) 1539324572884864883885215269788177741067901747630436643318399808029602335378536990210735234944615096105103848497832537965483619535769637171783464984418072/37017110149885307295697375341989232401)
+  (num-test (* 61636028396239445662576777415312348317278054920190931147781159688109244233565/149659999183936017 50280832809996410949441105432174396823883728565382915986396125237655209339731/3406752842984125790) 206607389257567119017662603624829733217835095238758046754428174885007999774491792658838812826043033826701244157167565054600950156595290052398436186551401/33990308513391731439280046802638562)
+  (num-test (* -100579490802304807750359433955474958462342659278486016345156932756807754105945/15683759624513404963 7314396152134987983181095955389244247502417255088677055075146925285457081540/950287995699608967) -735678240508074701153113537069655056596152436111651040530896921701439724727486696483134676487497031899584038731663111390949471467249259023050011663755300/14904088498613295322494450308817103221)
+  (num-test (* 25984831699359211750216710442693374608159925357093100400945034699383345074385/10463598404993207796 -2395913226491242076662067669730978955981403048697660449593722338244504668974/7015215522730452775) -6225740195664363384298636893730784883811595661227613249243163802476751022407971476247993440178871949687923603921101094083879668063131450147131783163099/7340439795432595812648347200273983390)
+  (num-test (* 5173661857391320950903772549611256023540539838210520778403003347430938670915/2590493168574884173 100300641976357496491877756123729102910724064566692821682523911939220592349990/15304416107565779147) 518921605664943617990486317157527087053001312760892500249127957517476408720600460633868004681188890038115877413554399588737851074382787744833707113540850/39645985375676570588146199684023740431)
+  (num-test (* 30299639015164203561126609159677900559022306879488518544803392527841364186955/97638167801975054493877206805944332747 -50150465496280036231382225902610460555496341860773955714344071185921583266663/170117675960786609061777750278261277482) -1519541000979732808188648781832621044050652591754537200855596768903085847105531546641139177813880505696192826380113425984545675787584857974943247950981165/16609978191541300835961154615181304582159561006676548938424954151558306303054)
+  (num-test (* -34494394944257769716276791009665812125094062960425641316440943461722789694119/69239821080832171466311153221314488591 -68027404272124217088707268142523090163964888591405843143848585935878552833247/257149529774225346004390673137885895872) 2346564149995340998782934409780604815295734898030424565252099571337345550054284934036215402972664245125313098735082896555892607540059632597741979943574393/17804987432587488254198543762235568841018786223139145264591718687823557996352)
+  (num-test (* 22330754509472350470460807673039908304726422770752644988051418230315708975569/141163736844241522445115344332946835969 -3776092949566234532895208849184634613770861313997034923686862122594334787771/22367110097535579962848998753563258272) -9369222740190326741203615957382420344247102784278353165345406236082475331042528539717966581690645628370939381978953360215380653092335198860022382107411/350824982641632215769272917522017419782283768012468846380070797128085153952)
+  (num-test (* 1376215273451682681102140384578115142238259557166158859699272578561460124263/3593386179017642636485249017714833669104405991325015697577507088650274886871 37146275008876311604039415809582675415172661567487888072055609579242279390723/55424998453085285819414374477780690192979527887019008768378662580126754826472) 51121271019052119686352858568900325361226598163234091421115939503875711782442415328681175322030659510284806538410228985354770913411724825992699509412149/199163423413390889071651575953261174839972499014963134990506980080139461063269751906284862132821075544766093817070661266293471833091996501160433036049112)
+  (num-test (* -88175289711320073148300791156190227927348022787624424521937188958291199926437/38194742314758366741668899229532351990874883495690656157862650973602784662629 93421911195279228911508870033119580111709458306921869937709821511660370035352/66371395138592894543765954603571534463846496049156722497129962530412046587003) -8237504085028962150049531747535213236460729066521397582683209771842938254589363802757604921456170821878391951762499073662677974506165863935238701489400824/2535038334389561782321790943041741331416028402594806464107449488311138037598457377927652600804722340759363172755193254192462811091332303758223034251210887)
+  (num-test (* -88364214910455569163017945328431687038422451206033411348821431934742389780753/43010507830592044720656702803904712217809857004582018186125828892174875808576 10405170283887792832024806983921158923908589830001636723872220129826733402834/4055629711949631304631599195955105801456753694558712994574702123032807265321) -459722351572673455425943766571506569631562018487574498847133029199411842205331593858852090421782204158679934054007027833206633183796877753882057444427001/87217346741895687976684378003169607737518608233754137677854312677618987931466495788077930577814677920791330694741284253568592140275298729115088619596448)
+
+  (num-test (* -1412797070596191471.0 -15492755620416346417.0) 21888119755986895161222137392796809407.0)
+  (num-test (* 16686841096925954110.0 1491135775021813104.0) 24882345731730524499708005167300657440.0)
+  (num-test (* 13262412958100188045.0 -18379071970155621919.0) -243750842254847872704698616507823758355.0)
+  (num-test (* 889503034794263569.0 -16600674457216690894.0) -14766350309325860687849239111838240686.0)
+  (num-test (* 3148165694020236318.0 -11771070679825280729.0) -37057280896113409834434531491271315822.0)
+  (num-test (* -4443818546267181727.0 -12001052312087213799.0) 53330498839175802532024121011435050873.0)
+  (num-test (* 8305259347214213793.0 -229351169208067535459370186456659711595.0) -1904820941859811670566233132773219565154696335396051029835.0)
+  (num-test (* -18273334758510166901.0 290047155020180552782039318570071650475.0) -5300128759437251944808204783222405076790289915320785927975.0)
+  (num-test (* -703280433697652940.0 91110448009482115063492795153459771021.0) -64076195390496041906141380919369524419358692517527451740.0)
+  (num-test (* 15279634596127882146.0 -220998726467849290098339792307263567896.0) -3376779786638352686104608499923871317791563686466157184816.0)
+  (num-test (* -4472497681184076830.0 325612942672822430032905460436166528379.0) -1456303131067722058341139305566346079551678140995111358570.0)
+  (num-test (* -6180420673489141029.0 -161157288800853703711204405567379740552.0) 996019839388256252540244286609069684717518686623358308008.0)
+  (num-test (* 14044956603588468379.0 10163190459901171254101452124764637970005230126310661589196828892266636678427020930101076689732526935899135126391465178494895371156141265424428405590113790.0) 142741568963316278148132287599703960511135825069792278910440475692913696263448088587778211787403889397993501704943449376875999977937418748662459138952952917221024170426846410.0)
+  (num-test (* 2133283347509865817.0 10577710515843519541178984366353275630877942729579274295972091544607384358263130633386329706527832990861547566574369528634541156662300858851752195966167381.0) 22565253698228972909216255630133478029433774404794962869038558824053350969301054394347471181756471783852326407546652836376109109470959746153989521923555764579738243072315277.0)
+  (num-test (* 7812722507014599311.0 -5055959518947106416800910724733658104378582281318226107212861190073091017493970778425583956006925004399967175604321778956828368132273155364830637407968648.0) -39500808728232764770485117356353304373275127104839804121600969932458363071148383405901570717732548020267052999198017578112731079638156026910705662052515278317807704170401528.0)
+  (num-test (* -17560801708050275829.0 9842515227842383346577123873881045824143545509071137371075701856197189100217561683579562062872293951325890789283651221922663521213150065638405410634222129.0) -172842458224605375239887212582262805312641302639067963604956593404910080268476692854082531021580381176489626536608405283010496488558204787140272050713264572452317265305619941.0)
+  (num-test (* 16743386830114877156.0 7347065846171565625701636575261347705942035850951855454324853850791855951431141198155170102434274509450315416946729031216385536668189501958761688618635668.0) 123014765528775807847206414290825117502032199391400884957413813554539073118943905948723779020186281150198999824020769031248882909461419778092564985979904308229718874140000208.0)
+  (num-test (* 12697192948029671719.0 -11416780209809507417142822520376617951137069007568339428552592261458272400645205700952156716454820410468812274673183389934216970221062627926131479014990611.0) -144961061169197993494569769162151457365959287966302572862364500950127981616038900865036521107816831702945678695331078399461327412574397914795455218447174498277798426197230309.0)
+  (num-test (* 17005139720743105479.0 -29990519259587469661876904501488342396062731024702923152492275204626478246142153608222329335341363164148761307659972897552084842238285026253664841395295138667328930482145590159132144957515157474957872335043653264146346772142483721767458961320947069718037828473530001033848282453826154763424789967441239969918856795769965946388666154136004597297855416503729657013008165049478441197537144135384444157408972370236442813734429031404855591324183846423588871065272526864866155918285777640819778251612915859290336548446745308788013234099839998683451658620461972798204104633072664604846231692505409653434538208644416538994256.0) -509992970306921990341332390474393215554862069848994183152714032617297815196921655222705396130464246880845576204295466273071779248718654338767559016551390771145212884412809612574391658668778295682412755916528976282396155832617323980694289208942491001345059122414240884660276842648466533488559879226195446807748573906940273568334343093922652142252689341425941673567630236228358747411926991658260241924294146562230425295426217833820067881064577380516936937782688004146531121831211284735538742160763820814174631414364095096099434285754767091040812242751724012532803037860394426031234340719537172735695313262283511554154662650333168783128624.0)
+  (num-test (* -15877530153400521290.0 27863984127681242643954505352420303514833683768731313003271701952957204538094398204984051331105594788039352443762851136101330385230866919393696564428736685568762923746771275677491379334452751710169529933675128178840986001684425353245791752781476028565228371147542431713985092322787978914276414008774443194161599919167210582437024618824616489802661351916633993681556274980075051797120207655478780052593534285265078265845445633803877185868676955831374479850746658711791169579387317321983669227930929736238215792068273805543745311609083833407544342964285215427999724272264458975101474080574470499647168865409458531868592.0) -442411248181132450919255517905812929771246981404050821923231762557171158858876183536414772404562764742655092127161703706239729646027465795612501446223663310668879007072125975886873343449629108246953385822769744013416908613100114754904323190537317463286500657291202287742354250227377164455244103312266617146454847578457073139633297517170508179596166314955134347046515455569689877574427319658085169791949003021426613961459610227430636932814700361914589752207776142403364490846294795496119883683491811246550808038342285518518431538295199537270236275774546666026424361019715280652576803278928827199810150387207105149968313623040090578323680.0)
+  (num-test (* -14162897687527555611.0 -23016403916121951319848021112075986869602408568431399211927062304968548663313037929311574133954267816204873252195499803324830278637331653769648377216095499136975244697758388851688873078022850203685120154634090802825656419418077380419130449990938627982123188424119187922828250625318327074513352279785514062876718714640725789938556578327139793467832731546881422469843509318627826856881082450937188956068348931459011923844607158528494902828851692203126881727638511348944908726926619613375594042390434147948508706733126737304560579515324106834237197081860910657003346633962662773394999353766192391746258372744063777808796.0) 325978973798843759388794644178802841408656469654887121096165875654577046313115917671847505813174070119516580105483409446057747653173640660143855580491229746795572929387698247460831363721394707501497262525550824977473864621747159715947297817600227665840640555029633517390896890601028716769035575763283168066843141870124768085499453574902575378368669494153555135898430469356384416638130459557518713454927909937610851489821263029886989981438507377741962130296498574556444168140838201069779040087521405032426995145166201901368032136008107323350679784004016321425234898132080844200202007395427054392280809376612533414505539109579739614954356.0)
+  (num-test (* 10844738523441551664.0 13010289169828379103330191247192587220592807931898339555723704078985668371901953113936581573750666143303899278973814509164982887504269303358034042953769514772858989849512527461308415676004712388964136857232374888643347097138114199889581495448978914022318770898259317738823514820591042321773469959130347470144905381758960436645008051488666423115693738341045851119808222048272924385188356021826450267608127588500233526688704136268009202730309974485584784539415807259862449203760469406037505772435323036790641520939576046423540699016607317147689982042035523118533555744274806239272109508745089640043900389441390176681340.0) 141093184161152226992592021994885140117836445291515772908453669279294934817987511015413332614094493905560980363483549300117114491702466085602279965168041684355125886388302948336158133555051817733078300668260616983283027038746214728386770752826764135491650323133831923154477800324207350667020747545837613879364064704092093040155243919335078139087599906324684688427176309081290932504214653249366429592335409761783188358003723753633106574740731573467850133547164922532633897844647383889253777956821171583261238607289172489135768839436605233457738153233579088224808850428203888700116300637190661108848906846940291749737998056247719674749760.0)
+  (num-test (* -16402132873169057380.0 8202725117980211375579199554494319645475746305836527475507064811368616698686329266053570766100878145903342129595869654087772486685252653587846560946850102095086896668181099435964053041678323706849735936082196618754721606824996486473796843333331029865501790248862590712245450877098960007272754260813822886287008295409755783478345202299352891066800825979067590290793893933819913530599309037639082839491869155044147367415785329077864525961799400923643936705317921900308490987828345313709179960659814100113658528990241758360711799009722683007157350272749544178688961738222930753008443755881419398858537860612954576778456.0) -134542187307192759584182063854799850608007421111316277594191532129597970622559949723743396309231347084450105499455916612009290113746722460358793168839937004812915757145655285798961178877391232945062437277255128401572171216279188126380587081673725314534095093062983435026047851041796084651601813918099532876684901239903769891552275465470747567830660442193995685219383258617057944010709906130655663966913354414611799232001438943448374556294933488875450563987147224709383408815994320229340710143082135667640802837699940654151297907451396297241124380508001357553893328703788960812706653503939250831164194874527033594779746890593262611805280.0)
+  (num-test (* -12094905083549825231.0 -7303327854122277566083382629094740392048421584433028903125893639493993705575691832165314461496849401726460344615713884253150283931509897329926825128629833541892164122168618243719393446304446866677253728405617434021389128710195093788280203239300086905325641224801020413858421914412156234316517981228056539721130386645649016559425091470643854813419057026759188125291655398451427686659900364573485593902992038773538760663063071699966278379037038361219424927031644750173900916227834573604566165762753650347331082640552394430002401423199016978155236550541225512734287851807727860645247391524620773399994302380387697957581.0) 88333057189654571362020288527489792875655269960629008914349561689924145109953656394378545526256758871407020025766992398117775520525507898420898102744530402370720932219749861094609497366188371774072368034971851022164946370916317410415503705484491514312339956381120953283812334833067601825812118392757289250628861166579446800637104996060739031010579056633535166403083327528575504427815713481850979373113173151813491831551023902022537957860211597622343157802805275942920911544696695931809085743355666792408029743911424760065578742910735408262758198787195579745280191859776661700139596074108035867940154338953640690242795671183308201526211.0)
+  (num-test (* -81618231044418675360403541307856740187.0 9751573706924018395.0) -795906195858402819552264165081526765614024708979523739865.0)
+  (num-test (* -167600745660011044249531125104202473984.0 -12960244919927910377.0) 2172146712516287908809731894157839567367040369214826131968.0)
+  (num-test (* 90306383312124738690336097936949488486.0 156109477991590792.0) 14097682358164298866835386043901377722456291173827620912.0)
+  (num-test (* 126202800261728727198105694812165074067.0 -17404362862588500316.0) -2196479330029905727399352310201914876903532806486592905172.0)
+  (num-test (* -80093647977875266525946940496137725572.0 -9499399805878278852.0) 760841584053111508349403804472960020663660465509267203344.0)
+  (num-test (* 304052889577333477963637861956318521374.0 7233536405885618691.0) 2199377646072361697737485358722028853038393128548297401434.0)
+  (num-test (* -124787646062877233829165925777950698937.0 -125798384154373172164515376683173327013.0) 15698084237137783175768362160964949930745617334715009097620154581879012485181.0)
+  (num-test (* 259623502197082370239517374851053110076.0 307089583871541575627915295134832918432.0) 79727673252974285068387698133566605944659309374400074880377824560177225320832.0)
+  (num-test (* -245358177397026033963771466683003477163.0 -285087883756432161967673595037725276963.0) 69948643556453419103498093570621669430956866597291662675473644085666220495969.0)
+  (num-test (* 46731711386059374483493216849082745840.0 -216522280665540473581476116002923812173.0) -10118456728713381305690589407461434638634240429858378588644634276171257110320.0)
+  (num-test (* -301422430661955757433852743238845048860.0 -737194742467573013847855072675441356.0) 222207031145790358162820429948896977201848379524899474475604149595884654160.0)
+  (num-test (* 109781582310220385246795023904554278713.0 -273317662617851276579672019029762858338.0) -30005245475518685175699313262818315773200953201653075289648004177366787958994.0)
+  (num-test (* -312236719893391897821327608828679767006.0 -661158307192284418474080017860142217763949256471548515134335997907628404839044913830388499435166012788226998900468665646723366842553747501004752506346280.0) 206437901167986463762021023207669068873036145952740267172145693855475451354717023377588805030022300923600718715029262618794758202955817341818233889201852381575043965927328029955969846754837680.0)
+  (num-test (* -134379788461141842858846278268259347105.0 -5535479645589936472405910397299739073641612836770238183712206042659632410776896398062277742229906915852933418684231779996404071421767274180368154310128427.0) 743856583805332082970350662728998610690268824090148728726850517499798631519601137183443104910590855501252539324674812560702657332874686395923181633958702249128106139207076314713649515720653835.0)
+  (num-test (* 278271843790644800793473851247546123375.0 -3845690285506025443856370771250487683891303505653819308540635173436088084480277686684743918745832832765066355874381847690771330587033980524869033600561589.0) -1070147326395532917564114389205677334125034378502074943828571411806344559859053091006175486397820822872698474899835730026158782698085673635033947150554253148685482702599776833910878579880042875.0)
+  (num-test (* 22345490710865165412267189692679994671.0 -13168094845644809414256057134926669929759930873747535851687323456073141938879368460977723280750841588750507348317544461824280674332488497533955177541413394.0) -294247541053147552931885013427268298282376074124656716577088212043667912662239091316191145352314750820026626159649861330384837204227899202392764926604802655267738710003310052268554637728023374.0)
+  (num-test (* -223445051950608517881717261787296926498.0 -2609806601119499724524852022247741111662431776874117401343811680374867931883996125145979162937751368655661775097445043144114599069842524778189198926688379.0) 583148371568187658089071213924575304457465978545376486297236105670932990897420147110485946155066725440999079357995678147717407410446012970360780626554347417807723098476525833332400212113766742.0)
+  (num-test (* 12604140228725912459681435851589379433.0 10671266866958584640992033560488052420339425977492420594983497264069815016478448589306666811246532193922229713077112601565462530332258877522384022088660628.0) 134502144009302626262781543880199144227907004673612064586081220538754991037447647926963488301214672345398823354945333417956344119228084327815583754032364976497975702972112644238248704660063924.0)
+  (num-test (* -221289678591114384943252477126208006780.0 20020996887149770966522122735176842174467884990518978494604707026520269232864200848420530223248762875769520715632742683760311747174524709550334825291720803698613541109690224185041740294906022358446325921538593105347423518731748623037078340006459454656405997570119591344894717789372844612253617591807770017562530034107842444403952657949565007792107071767260484233194674888488789619319597151367813735192433631007526015463229060702510632792171187339118004038505860316305860704455466207113207893106982258864355430481457640304138738182009363353560090082819036973601710432437342931523433079941958203038050750205966472435692.0) -4430439966231074415853738608900692925851705818190624801199561884242897308817127146763274284287396980593383317678766559004881552228480591814939402896201244425805503258878061459604511214900528594870260206969839682573246490602076070316760182753341371682323914671418233629420599310422437691170629449435494697829163966912842611408632129590129483811802031178053300073562716917597174161526976287351465154825036851645956354853960835948518860624747958440181683978083391663149733813297698623499283645627889274004656942800842013709298338912226207338477579862672216831422765369078886850523202897989792734789430796029206661261129141144642117177625405158700499049991760.0)
+  (num-test (* 180785619668676509441152734583033930295.0 -11909038209406834057075682058438206007134213485822042209417443270921391661498900475635417780140585878716264253792335317341527677051828500780153492153490249297998660274828986996948999762620400587091118252205695562417522111840305140989214300921122857271717052213225664738544344394774362885331856170636862181712515248810239601812262573113794334115259873527539564296101166439562124016438281173202196876398090029995104489712272260608848551754611421227761245487365953257890749115194455096508613617028024932657498899001119282498614739316599704645009607294747043489655424155986912576002393048535846081096337705941547991821928.0) -2152982852345560218506186041143281789706715672110278207735389192913214838321097754496849942223194392302524369156102301165660674797665128931611291246607346536492650554391248756408556789391955568308599431054809433808337036546281323840555452571430884302696950144068129601527530304907460164571704857360215834011779559395577299313379666503707563751314135201994045874159291100986903645360754621200008830207429980872071814202801994486961737459218017354210479544121100423399040398021780750351097082070296255480707530391964970754186799748521538525274241709676878827522138880241734356460339681718690408853314007343934035505873192699052380699509877559455199604508760.0)
+  (num-test (* -196121729286794751535600080816329923561.0 31755463535476988506639447113088283661031267977524968610501132544098607201258848456920865390506381665724254592728643925608893982794532243733117636645689751360224314774452374503339856173343683819017479955914451013484169313685311530532055735999039466721411777061709328450052490025363788971916050033904534189719389237878257877112162843506491071470067738867693853480174965212750301808781573369342701195147083717623066339671595077736036738235636996351642097684597005928843274525502529735435418805821748637387888409663397547514467435322454217015563134545731593492200855670248739786405074231658957946422903165662016649229286.0) -6227936422881500100190187768375947805694946596622670066116457374856427496311253030141271922822486386675428302332027411428470488965226898801659352566022706152307022438261392466548357753526474097246042956052374187605144719189465046544498482461077851578811186829094445089366592317045580466302238653533114619908864036973070346979261546801894831273337217021756025770590122176562027129481076270727248949609326868225755958667670279949371399535144788247565199415296122873444199709788941984099349149684384486618280260678252604631431089580057102263617056951788273430713908768738965854953667135156866028646584137788146112300214498814212865170902491169332389942607446.0)
+  (num-test (* -149247491509558553673630984739524508601.0 -9241905448313719916485289537122695595500213295294799660583133638026091750542612875183284894676615989153030773719811347110864468582634048542108726080717551794580656021381515769591713295631818532114918070215760259364277583650102628486861397602958930509695263902920994329409932518607260720657755504091822028630927071374796474717671220452208310602827254296323761245420486376569048549643478954846020045263141546849795367522490793641049509748005893155533480849922847230018411440739584477452313387881413141538766185123978087175960946255649923135634987656065468774634483495944248865774633962770893338531522570776854773975281.0) 1379331204929344851843348280532786532350930013132149419346606977890849868537539899667631713548510207947097949976792337278764045110931774279794402312944786743575421497528669859045492875676005849752425421867514661792129580445000023570590786705609341859529483054902802038173138834528021423393677908655442991197348183257271932188161681770513283703502340499171444058119260228931558784004778969491586252899270869275893402714040693571919281494643765571068045362364213060063345212881008657925426024923296369533374671614852576576041747836643356665301762059898161073609265572267138950725010661453917338098901465732991316661901878681888138048552901254914604845891881.0)
+  (num-test (* -246070233154436622785727814428081917418.0 29761582253452470642591719346200231425423204062498655510037025199574178834762931489817919404889920159374886981199608181795387339523762458361385170203883094308920011218315748466148953320570427838912637152446837553950810011344492780712558515815917745810385725989241835877316836808088478276603934260581342710503593237081689944686263274319354100341139245512159619947319496638082702549196795236216458749363904150768879765280332386830831409591769966706351022328535490587838695167807967607003680703048770719240872629379640571077329748828739281770075441660330884779539288220944313294762143588847790653176774089774033399559617.0) -7323439484151992757431054484912931979861244043627630118213112440051387392428853497035249623931234821362770902740177541812170377563064854590834087655133962963430877452052749127605572395112726398103244974178157574726551814002744001021805127518246639418981066588073652668879613252372759895389345727455380224104332342029151667860553645106555190741775758687650292791318963679857313030729683299101577207875499929500963723267185390425716927303375831321783415003339099100562942730763231688479910689887284950156875532151104047755803876078837921949287811575034368641167438367411569736575067233548122814012421044943430647665260439418887639347030312118291762161708906.0)
+  (num-test (* 203826295936164259559522643510940430939.0 428315860474710981601019542870649234168732095026625500771233691514247613083810271191136212287636290276352210600151884730196161003906066671915478570992925366265552107746965374246537358349673161970290367972281768471743836339191023211359427335141701167253694144280251188008871929010775436125645541749886873478179599464478734149706121117222690271210887178499620737860802605991262799781279373870647695125320153193063528861104479576369448865373971847676465682752435142074973627172566791961541105525781297462635428308325033717669972726101583722868689418677558787287897456521530400671342257419067050354522203242849353639864.0) 87302035331271280954456598486072605056704393103691656908943847729634903654600322194677794243221825233700566108459784062758955025931450719283517278054268553004951352280583820782976072352456972931479389375165173986780482062859853305469143408707179895843295115510597584169486406323435925707638987591151227843652210256611991940374072593149367903739596883229844326054223707236369465710416960023659329202073724249764308867733476242261506975691004092043954515337899900837434270833782490145948781128533218641649564543508314976001614187701395586824982250794852925954991265270537649691628899148413763865280007928191637215283244406869662872539567459561720369352296.0)
+  (num-test (* -5899540498246269366107488541138263797694914692322476860852796858749106720144552037986906792251681094769894732746138541066810195167688318229720888479512583.0 5834015210744942902.0) -34418009003174534626858248456163154666511779871358190892629413477534042866009573638264296461516598238780495750056279721797403178867717911762916049857737963922333901125535866.0)
+  (num-test (* -7558198374656605586076446665394545534375963428962439959101805545423930654069723860456022097647139432324162475685494459942871728608277717748075653794546685.0 -2079670855873590264.0) 15718564882684481784074014915267371190416032453294568239793060140651422710113447422494938907375595456199203928496644205320139985222135619659630853564447794621716315309474840.0)
+  (num-test (* -9442744083812363570102321552182535031605446031706376100893354933468482520577272174689455502380973733378565213055641110431767353396963744600184737808983381.0 -7204974197101757391.0) 68034727473703353914019458883709211780958983263702756416891835054494728840771498925306650413027883039860202168095834137357212487561983607389479135319040711944281262212918971.0)
+  (num-test (* -10658732210276096534851972646242288663170038580488752611749460640657411087860047053151548660331707024718100598181073744715506934778234716535781332588396176.0 9193953347013373121.0) -97995886679587166046252015742839992974979220158813197140160489510432960510418039749924861744197553021702396544307690217470606424904065359660871469041838900287446937257585296.0)
+  (num-test (* 3330096979672637104536573277593029682675932033891010715180474877149733802060455951241981993421466123791200840797318740359792251505430948855600408060492000.0 -9413190658845804679.0) -31346837782105095097578725347257193539696338226258990009265748336528353873277500144838721882313026604404426563737656928378230261942407473822851842589487713775609448642068000.0)
+  (num-test (* 2224201331350479188470378485954814766783857696988331736807430786504130570570323948774102396158334805040994159865821844362926631687258969480929122732089195.0 10226747830478556903.0) 22746346139936030910929166328517425029735137934434969334578972386859485783192993228082340012742115893176871887387993591191632260444955081663604449277961804869872353878963085.0)
+  (num-test (* -12394770820700925077767705800588617445613665027183406054209162910642613421436080064653443098327137503596792411463268187212855350864330592654862321763110243.0 336135860956209890623046930607725140868.0) -4166326961171213704571179876442248501325782360170764344978629523457550315208845439497110652079907652744850691289494398473488033083739905461347650605270023127087625641779424751335704552988710924.0)
+  (num-test (* 11792778994619176404079667787533709801900490264171877873621265044313417667869688303207909681289642260521608966405181881416781694320672906600599581862090088.0 -197661229068721548419113517262926820105.0) -2330975190212228827672814304508257223671550753091700552243633152084831515892056240354560520878171696176381845689952044935988868477421447557890739834031207059212175922089523097911477486879619240.0)
+  (num-test (* 11608994516281296345925963401821217560860934641820086911326880657644311461955556832927259499969983808078591149768068360172431078248807463030805586293656663.0 -40654941048774156019243747229920736005.0) -471962987694958552110784676392477007070112288398143925079396435246284471999814508543057304008480666763661066976653446723271982094424149279649226771823800871458389214002872916339341019732251315.0)
+  (num-test (* 4821517917539756801293776911844480642406562140007084392649374723119190602353617113036081438891134008988421494142194891002983491670246762173236312873933599.0 -255528396376819316172341014108564420589.0) -1232034741571035406264710387186737842510579499938716343220834781077329515145216794636313459582844773420679078031627466542930137302257934575129329529129776153159694412903937370462708576694469811.0)
+  (num-test (* 7638751115643228563298483305056828584775811590562130101723525925933790010789130133831569153863129513189315440899053288261039147463032870669035935364282061.0 114438828287750304954799140618669114911.0) 874169727255956505920153418854946321208907128396839975975317705220623267360648189969313978740314703015845506506608054761304647627635292132043887080298168302864314697920637105700927041824911571.0)
+  (num-test (* -3653826017463740005170218884285271512636869606149686475539243914909566619638259666405831445823138528809165270360144267462878986866506114069923299116957450.0 215752050445782448772085819939961259625.0) -788320455239949216234629350585027855111249573063377172522422069903710014529292638311216050777840734448624510386643245486023092483841464815987597578151663227035102742664709136512524899527956250.0)
+  (num-test (* -43242564273985683175827997542883970694363047476880657467026050730764924897992516355909421962249292250047896135687573746158665836208681548975073555418266.0 4424346097667245771102179669235543742385176589624011161914909311078645828684936231569739522607200308028372644149306431599085361996722603718517735348761218.0) -191320070498733614136284309000213964486426347688040889144514933290125387693498098446328694172047943298442181705949005984031677324306763731212307716485454004382079159622650481983102917517993601466178931324415483972311904823997211920702201161092866663969163567426868740120661073974542958600768774774949607988.0)
+  (num-test (* -5093597555679260616199210906198149266592665304134802327659606846977583233938836318559188141955851256260954289429418183711191354912372372976165948043123133.0 -2240632735861652612028397136046974907251405868353380459030143407902436514978447480884513019736738955326732458088791830752499716417751919868492224207936623.0) 11412881426559848135724717164530530041659963797467536748076144863846600718211858527283843975968920120508569299672573958424908957105703597501013710262110218780710678312197455759181436286391257283676806548463507528765947919856827004176416634630489598937924092540289712219714362500246928243091408698274649199859.0)
+  (num-test (* 6049789822056553589237940133475342650218069231558204589924996117723031491205673061674252841792149409384720347601549237626288416453061224734057079515141650.0 -826416247951451524584060567988229017033981218652490450160817307801130685352465013890931297548015267655971295627931896259998420078888499206031390299169584.0) -4999644605638856588581238481465237523157457201817697008198975191261856978252081380810200468420738807464233192102972784271159116426108806200426852134469939032473362689081653859652824862066224063273799612269941254948709760659691148103622071316554194507524610166457990087959160807415102946877307193349131573600.0)
+  (num-test (* -1175978338162966145239180473229656000174129248706173549637767835154921467129547950144109700900405904250603515318348888619371004435353505449762899046094747.0 8633693716102199391202401198009047492431980605560930404972542822133579985462906768067706391388213605203282586546130434156768523403030127356256666478340720.0) -10153036788469908062299722391986722149392791936544969945546931764708792252481931153733789787389051773529081688846141949513463792442701686406966696738286561777611293604311491896230769507535896070984747493738525389837795316954065260075941524322954935690803870500012809797698319359975893462672845329776468197840.0)
+  (num-test (* -5083395547684319640767882199938390155755986838939007846911062687871291096073452055061784159768637502151635665247461348347470360218957222873087414506633886.0 10813098236568616588240471432239693891825284805405416395976866126102880121934298269375465735278296789484402954117593716698067735458182402220278016922449294.0) -54967255432446073625448401244836956268872685687128644401372608170106281377801209665004925733448944141633739594240156882328181133879414641109484442890809130544146420476457200729843868300396656004198615619691952536924980482714767859804902602805398865249514544806725162402291122143659939645240358379962457176484.0)
+  (num-test (* -8944626200084865988157251013718979706166428261352840753194709093968177704853157211364231059892647813839391802007588961807572842923682104089512428902387812.0 3814836951264415657788614449012480613328314590744410079075164918748648723114236698412482309581077603776489883375576245233128800002373843611668945838558629.0) -34122290543331565327874124324135450224668275222811493728051290368641401807963502623692504750924543845019291736982354932620821594287780848608647686402233097059022704206628297180782771812500512744911371653368388270442874670230118309469599458827222162362901084328510647514081302476000779049412605744638457029748.0)
+  (num-test (* 5186176030253526423885531264483408352469356233262336223619904269047786350470477526433506158542551137478071074193659876898065998079440819597952826155782068.0 21428324964794197485898135923805540163916541943812058590308650649384013587098638034673796533027113673143959572855470411726978105342739938341516634354246514986124789451866589211982659199267654387148420461876524076040233779391563396552267276880650559148637067641021059664960876301072636635299261389450890094318429077561092553337025096293793433968243940381587994428364726938534453507046761494257538813861046058298873206568935790790373886840765817404479239485444563488020955730741209738203470138117422899051269778988135668626686262669881048094388220931264751830393793846372816717368806996496715219806062282836392457741918.0) 111131065300898907482632501071313138589398597291097276435916516379173430095773463468344138866282820740991088290299992221985607057347883717514843661030457396422379155394966857856069231504805779448809986906434617741485942621643754096548512120178021034054648207248963478122178145159262707381679354401629366698488021743300737044695960363216253889163551918513521913593214414139637549577618641974388739304727218804595402055185824193445089425262833385286117064481648652550355832014346131722965510192584901901111154083186713580209077544982897821477349293279848852596241762198202012197892321827305803333334823616660229870976569043453639028059771892706354703750763908127611939169337399882784092285804830644630059487027413697220038110815990084742241055099963659761569486906596326424.0)
+  (num-test (* -12615422028124847936088012564413126213419674293830655240645918456932358053670311316461359727921727680491520480380615359506308571290338231702217134487397730.0 21538722931308708400287621200994476771789912594554241036641406577761480056366647329031140922034590767810855360008375309986798226712928670905618807986829790199948665185268081173685941421700542631395958882077936923141152528333121096909688700106365468854487023847026564219531968849793109908193037522063952753477768381591929787242143631287330811801315216116212154423972654430356675401769729358415036943501470085182304183033246682446978634892995900678975109490698283226559860736462409705544079080978470202336645384768211440438501339641775269445439018148409151795830925198162301321965042997632479354427154223366199106583051.0) -271720079725309675925162538296715595434811519956795637977932956405490708202732964133816538801099235844279338645471102896234318181092598033040518838847055114923365599862266767493227393553801736813141780001130539648588341196802606083178208108557367013886856183999712817955194261262279080641101769944037282423238147653270651419282545398168930625797556638625301898893565965773914460998322350526545278664715332414172614761548301364063397364632709194713561073496860524124460861314674679928692398440036071116570829193414179054372604203478369755566003622621281005164747628075596444178089558747835994702060740334079222508147598079351187013336751322569865313532407367116553748939535664259669808534100091049960040092785009707220249025633808590643620557093069849490009472441113874230.0)
+  (num-test (* 10381022953674450046578890619826448644067144294659610359943634722044183130638243233110364436029778310048006743033299956844491228999113516347401915490861208.0 -20974871685432829994714153210121536409377362402944992609230062091789259307033495284524234519701670462495676590513192861649457148897274608767543942797542628100823017887236899471151903799837558453043431373811892813126194662218472834650841742305925226558315372771353677064933578639099452438843500601586038910108679737480263349221244638463171088589123712367802373159421798288708123925853179931628847579314900787361946716531755600236755527982132768286927549323465697241340003870259800347640599467922823203446834792229595507968354687630029075884034263531531423883902851487995214646322431057626558858528344843531280263328354.0) -217740624416854507100100919338835880277259264187442792458843251425095703739537223785767883764746809214920580060316177442387941385712712426957388995082877226019966428812240179251716274377143798847348759498926420314709056615470455134468678662646006408843897699718742372199854223008996321568642038054564397441209859567556502098420151667437837356649730396360374136203172669776530655738388121236079327354422138744456395348910073462618440421257604563050031602590345028438897601523520973759458890228893913090702884911857207117714231568437403212806578764580006787626657709435954760239671948147344463295520930250155876010414461245194991189183956653772752290656063730950237649394743456230607077768595983629559996700837383822873994717987698780007691157576205450973669241823945091632.0)
+  (num-test (* -3984492646329789478973994496812455855595578196959138558282015917391108383154917581748539892089090551298072688793487597623310815918942283997753800645644511.0 22199897116873160263914990610762123553075230334116099569358672964060004245706770678771431369917479502828754815568950371273785689812698287446020480951417047185190067265849637510591502642000414540862689426343523077229502494771352820057572619644085930901096534031496492870227890836816886496090287321502805172125273822231241073590840684742085641304915656543831190976008986490532066597410386596132766422026234488163435487889876791504407434387555507637783709991326338482319227500686541368087892665100076351075069628862376686619537655838590687615291898971286325099164241688147975845320979841704002364545072665891829427213069.0) -88455326811459002089798581395024759975871889172872668466370443703433800509268320055453743803627754859670391415348970278548381190662701716228279482045339649051139909543850883613464992501666524385524517648069873862957915620016943364950043289963237718026629805297916194484838158010754666017024585366330526135823515744339445036315966714684052345462172808299142368905939297220895721123725415007532441824406115746741972351142687017849809593982432484296719999502992792447259391592152463664807498752410740679664044620898308783634092355737296495489953554685938970593890496829484673393665321572846542839714620847185428664388282452532264810310019327395691530430185946743995669191791841546685206884247468693248673484055915613115527492005264289557719000245333079386593840592027314259.0)
+  (num-test (* -10672574004830373997900438516438419278676753890756925443116289034080220708922677740383425352837266631691319394850521121221541344600832530724104047804922665.0 -7307684417326792807224298894786988180161884427390942431653062127076829842696634441114228528164049031680536693195116703321494895319862805505304314401000204515985676763063862569446064343853536464020413910728442475032187317639476018710375702206456631041987826826225461927793241495220512935434301833094232834266749666697332380140380619185254354273073522191066457437931022783436360434167505326773192959291779779370530770935758482422581712556111319611455306383173529090289274267200543081481693078804068524057891845603351773722737987393428313340760607600482724483853560340630587029610437280601010173185018227638972500038072.0) 77991802747865927212086621295493124451256238920588746597961055391511562690441964216934615500942858653797884925704270904527938466874924049039962754703188019915846345804228044693122758075602494985337649496117180241872910247079655077012999375809878184011356481981590430241786534827516536543734645410817621964035091467871491521760928486006653992134635010794346993161329777270345449763927429735191213854873362673179799811714902439637861750855639857969259787075469241319618538795721956528400353086156169058060112255274542232054021662809196965752800525093125763127895334967094763817500702626282397394521201385439419885607578137159972521677923972708827090645776826953976605193554447841693259586575931864396484621463004541561908426383260772786784541411548146173991869741515701880.0)
+  (num-test (* 1420855003086789510813111205540636553863493314684153860389816109865085846062678305775289632805233481596171530412925552158799875183492757047174905459819169.0 13897739053062356545217161606361735964779941697726983959749295377836209520566715597422965426908191354971972501742952706730523748574796773473606175934144970768662226027157110240776527834790487577863781140089347362129598158760833470434895693782503529955845076709376071972727346128409008293671217324995682020009675316075606538241192607139905488719485728099428376369506685875348346231688684483781160648420909364963718027571565217314827671844485031440079254478598236877074793221578612249882886835580737423192061550370069895525711885220268707201966615936769696379335772521903910689934596134239331592980694745008817040569590.0) 19746672065138309742065153069587996891492444461032276894328314121573439684229636534026409362850111716212254549198595854140809664451286626009917828620279583631575940837712663100442879662416765138504151063632823014639305658882804073655537352377258786105147057375069447099908107785635606190515362082317465738205179108333064680370909383338688734129396788764959056886328471374018961975554190739706996184818378586233017775166959010668462907838359485424792026496574369912033757997469014639705459505746723512361959074802456098328538419933637295482429555127226978561859965498424173552676019033370307387047798600024901453757451579262061785051932535359410827170361533603618131510421439128567361259204833501190218719779570258541358012741265599985490513564378203502703406698160470710.0)
+  (num-test (* -25117824099635104147178796272946098711514362630774369209876335291088434247131228189812265510495277875692804180473811834186270331245779845635089547499275113671007257221593872123397418355506777725721168216892830217596134983713752526559153149600553468865338887605949011743043425900799896245185282419637806859906582214420191794114207677635194054239563071023206500505880052007267243210206807805387341085613436600843317096291021780624738422589234020279836961194869688005260369009833026575446099544900581955685627511787510900479881434909308757027825050977932238481841909425598834367032841935054158448815026264505726593064239.0 7846111496222858966.0) -197077248428250572361351389692146917243277049539013604789802566767174747369897711991559940484392921619974209620152008632450612546796556905740493507885376190913893140368029841033442857949219716681475253727058707723386016055991276120001690579154370788782636181079931076758384034193266737114305362492836167078199155929937891579224024229182935372106924021709421948701131654358516297806197381566809357458374057189773041520552821330635689748583803171230633654728360451100477472934847975252390985102859262992904778849652221553818627134153578436315973777720706502751232660284910468721430874674021521629540714057383398858244828214000543075116874.0)
+  (num-test (* -12000343217458212092754251360179138661969968218789048702097501439124892987400633614429800307263114371624489988815324366411323242909652002510513570900627875514001409309670202055060404640758548257776155562167062337394219073071639153822126554525439988062676648294108951003012550815746564810508912122306190725453386412796036693387315128514162061147675205485143205925649214342646148112549805850530430229663418469577245456944558387628002442451042105749848177325651852669794048215063957689756465788955050513359977166122710392613631703123491357791351447110169966270916789849428298930624807758982400706608788793481972190953569.0 15463017349709835150.0) -185561515374029078700596518575548896805308728003103939537818954646551372890610870275966055765608887701776880889777402229764948269089126750201922167386201171243298907675542965323275634529293654817279957832652909009385491998537031060285890512199675273422070784691446251899120095880199298512230290860589352290462643231396804350623684034400741386070220057232978556614620855818271117742675632435727751812101639747357642295230273344552327870600519422276996860893842363996198017494117619585153346745838853026029459826407782259598477529242420507010652705302341725948095720110508044256096963772599572721279996322424269691990173052929936294150350.0)
+  (num-test (* 20244597897909303129995907707212050478823487084391413473821544089492035634291726811145005824559631386634261268723753786161463497881725871168747275110149007801865428978596190887145324535224079986377522166727137028753272158887188902047835658826867304220850429481233026043496635847568448251753504834367809877190895369288045026559783632709799678639927825194847005181499299410953860627694080906167346078299421796974815616608326704894611151743720515377248152215241639534004099341398238713597030368980166731393247619511322804984829747216779359780372801101821087516269912916462719248736442644433057333788741151270815989388229.0 17931151643499274580.0) 363008954869078360197158713265773114114991766614027768774402465306840646219477262855625957403406166192075865834283840624408916170935610374573318606346031792128003204902147985329385955814330782527184421959263266167048755628089412213360508944817963403092490479480264538027768728303095523018598016863928762335410109567604756183580676503045557867957273324581082608248341332512325136675167966306268035077761004923732568405295901819511346235524577361289712297365403327125212199451099538443576479787130510546755789504852631291774614010584650672707483555436445926222945298928326313943231688436271883746272589347954697213098866117569339490918820.0)
+  (num-test (* 18134862906191691435095953372467318196853760384894170022863300447691250350836421337333332682828557871096554531436829166444150586004379181099133295174348038948038399079336722004125999533719492457544642570217406286811480006881054375314838605871238868968956868878182133492469763282800195060849734382249696543089869191257451321764806079423169235271658993054867624410589213892458246001270123109841429271429275464249821855221014782727398959126117031823977229309775211695677345378510417534328974531801634095862859684508240122911023047425473036305928743193594967362216559973174709883576295373749738633873828863608550295977368.0 15082354452174510460.0) 273516430292774638949326170314933525797985748367549139070674899956657807928629067317576809269188258819686207094298714770978509118959142516619521080722291318367607601498107007447014759288176261262818034997399866363248136237609824401265450913244758024085739876914482935655100890803279961929047974391299795570244708811454483314898873277493486428279875241232025231140855860469097028388778917980779775554139507550577255217032521719099071084956515691364008526064349956553916033914728254580848198941020806723485184338914882588931083516851849558411503129184026079582257756707601984686901646494090820169212279581209612798749779318126482639269280.0)
+  (num-test (* 19213874382308276075905228027166553836726993832150876980655958901416537033385379180983129528081628446454583401834309285184752924794893846406622935494758142810049493348116192315865522516744262115026742103678965417868790607689989205765793528434388393584537260717130892518011447327847533083474230074174308157934463971640826422302901570010591182715932658037868980053012095115562188975692530473556182305847290196895478280679341869546292639446526021874910117953225154204035612531584978136604161393474554294315903436682283787080297348697922389355209790646124024053098888687638640826064745026930980189268652291562437512941810.0 3155416591710364359.0) 60627778016974262766014671335614995348970065077989108071534610098195400001445248886220725085881796599270026085183075312353388418711598523030563716616967792282609748819081238929738105086199457414615236966895805539596649555457494710621217412773036416007129418290246899690911654008867819945724649185574237527152410775686803449108977881160831441280833577932476667657759420192656716352190871667386955409426879693856001112340390304980532208752863058384169885129364117656404549585836664647784765508649117301622797243353610345828189312360124462238989888436478381583689386509617357901461416012201469794664889076397809504626996523928173064949790.0)
+  (num-test (* -6561903839860415551587224953276060627466820222543175464705113686962550773423611522044145975606965294164125376820288981286542044306677764776675868357117109664125730405280822770267329297542599719353907954399688197248115043785617436343303277493146049939491224480136371029084354063731401026459653680017632996944506546122253686805764620116169065663214526857151412139439538335533979733329962892417175374550305659302592107472151941922230309227785266745974334776462642676959433923828440435340579340133192678341787895007461237846313005612116885419002449356480017828933592324336731295317076205553526568668826499450826560670163.0 14908715577157091280.0) -97829557993133908713082095435440645457469053259814412551982534425389603663024461131358343104414088618618030154957456050473312402460589893359522167472060177968099538846750606564761307960896264958539903740023783283814849937681270591589750181462708056758506230073751440847913386576449367635057595344744119561166438538811561109125506233466453974371464999669336530949393433719456191822836826214814780222021267726528396849558417851727452246676857867278196266042327956933753121947589485377148388716839519782819642328655117625818256334190717182923260613562191698788004591479576661108985313450029332968584240383859113741485244318702724563478640.0)
+  (num-test (* -10378013547095983701124686671659666242518351347561698092030999302329372512356819420877395264401390796163955327080881297568412490286247154759694714275858127906305200295043241717769593877683535229411640745872559018085757273530771413156968541499388413497221629366848027355125816131586610997516488552323667400115617175682996681969687885201321292153656071894385242141321468096793766926179134511319941715949712230831768643024119693594235207988046511542691719002262040067921088838755337917414526554050602539873232518619281766327369577617796816586064895744680567067970817494102948032924671421242699225194947982378019119315136.0 30004910492448871409155105619400474385.0) -311391367570036811050052853596227388481520279736812036769684195465110674594690412517879149770622679377262288447706750813509857551308594851067359841826754786725926298013483569424123912020079066150719085450400229896983461212531213110847425940968466564079253939695853896434719530729030897976597410468081535234663568150722646854183317007227669132983719314653861536414057481478039579810285535699518386214012059191958557306338432321511585867535008319640705419431310336566447165302011113284064246284641707577414470505948868362067233709611758700034131461348997580441628136979257037186480770286846026250437141175360847735150981343952303257191661069675154710791360.0)
+  (num-test (* 6311357747888359229575837883366949670125882865462293491587368290797766017168248637163030339387377997726585769250585768079027576213724941259801478313127113803503561717311996500019522893295813684259416551410025111443510215766297835872165689077882298506134885487991732718254835036694083204758447948541157893533099634169589161496492972953698758234452126564385255035294546278732684663873459439615228706684138982066055370429797835904846166362278557095045056472775166294675997320598469599722704075215700819354957397052721573993997624711445698656580401684113096559767093466880001548887739825916626416328760047783071058963451.0 -212654096583990292869707082365869207538.0) -1342136080095566600483524091094048745061145155430997807005186206704767933140306297188996797343723817220160636373424666345108189275851749622201429179882167381735732553825696482751584102093819432866729465599060815670807282181979889263381844726842751894916887860819210652174987999919869623292751389157233409465756974677789790982740267208982768450215563288024088369480574425410032306456026930809228182100949940216614156925537929648841127727165386031716586596638254705402653861723407930666152691102484352058909219619985877341630210918347460471644327858114815713557305185589162775699323253049631349906791700893878999711846225062306568467992135934882289075693638.0)
+  (num-test (* 25104391676237653962996674810232896003857294806799086059884413856421530328279649263948893056601611073815235439115612155497964541323584159786678357898152394779494741995735881624055133443980324145256438160990490767324719276757840825641421547232460969806196141938571103617707677351907526127993230143577974386169402623023560579220343920203666762052525898442578990183400559087522259053245822827313206196194989095468393682721753147596892214609346047051670610252732846805143964713621673722554204896154742594858056891979146566683467510164875593192581407047920719605560716270697985110227952698114701527191421628561835164291236.0 -205991315859231724218751687295926841150.0) -5171286675233738337789203670843122752625713948587464573381323151628930998435518250812603433784823922283042037694290795352461861058217142213862777203850665369756106838860420507328654214723398688455622487003912073924323587826356928211672752672052670663842775836967587150049181838707784871641183683742967716787111671792311389517753578360293551031540853470719098360013225516593755039537796518619542838794169319227197212817921098393499332268929332950035803734983497370378852859829228973012039890600437082235032378948656232679080766068869430262740600476498399803176452431728914806536862849281928869092524387549297345184969051926149006293586531930828748109161400.0)
+  (num-test (* -25971587288596053786734900662696128734726180676323130693160397208008930123341700520454723462226657743365779183466120836187720332442041321870351823609046027805781414454998487673927365486893294110931852680018706479684281928396163669935417207859889405108139261480861908067489849403284000981453574189898304616775302917687860062501465417706095450121596418236563421425311420755550335597318818628123183624214438801254105808079227429950505879366254661664881055965092586612702279548151277733307180663770432418397550642136953750720624507617115504303570076531620003848642167562950736271141440609700821621532583527124386811144839.0 -182748557863603655835821910989658558236.0) 4746270122419629115710902425435990509747636609113505336611751359043717100752575149404352359855260443259846554733621122684788488984010741203981300775978945529551335641218319619542248418128319220383298229263331638090009313676486209764655429828385994626323209879925281409485074778611946493692237774852428345451174837474328995186242262565013937544898941834362941815633750896882758939509605799422068815435202904271722442099465950700886702949580264958171808372530471918175963644209760378395316412115175988232945569517230829200985652504383431054550902852797293952515652017940918628980037316292352828228005975466732028971159947131994753006597870175664981312344004.0)
+  (num-test (* 2117427896392849163304163145095251890404997781812823978967013619233450901604407363671467658244435728579079751353560538034596183240362499870272373308111405924505741579887345118857908796509418246599428633956038017783178050402412769812823236255234302205027282366926174916871858199918908361186936687654278623156607813451034087735179167324944824913226799346886951212979149617678949292799645035425029596869092844906629996914674904522806258932192931217652241231736891642224851547474205131131019084734780208254203537633402057673465583362982905095029133132240839391503135932501785844503813910210348239157828902668852795945482.0 -296778668392678698960782643314222141731.0) -628407431508980610909134894336322264939705333430111861505965183839156278363647883745193463537783397824947515214540990712455315080515980803996660089847066076833542492719707493333185909990202372284811233272987993068106356248349054482194817336258302692039392400931536481136340269417905505366385505196886218794044229758585631131853635721528813397816307666671727692971421531381290925317161326036075629905443938124481334173158440927555118173661486114828362551889594188958723424604273078091320087897088472418346754088900034854230711982602435635574895960156993014703292551046970069204857846207328434544990709459402656908170089318995291341536347275682867153109342.0)
+  (num-test (* 24743327715258194976385899813930363006464428087412805068703455203318769863096919192538751530954777047772548306936907016751357570434930538612382851621309732767199276228580401695793317612267605312672263736938703887622824117576912830029817460033437752668221355377879837833796222831371174014543622739933433581963103361464022058091243110136610854806189138108937004805781857031030005354158991203388998364340053773883952742645161560754545458260688560269655272249435540890073696261770299845722705104648358053080678920468895189601731801025555650490534399590288852165862135571140382055044665678298182909026026068995867606241201.0 309156501491030456401354118244509785044.0) 7649560631695275371386748526795333430293346807872366006552933839286343590101586516802834568317627508914888989005968805867728947519409222814667350103434422356009252082456906520988877859152125402282765775845766265340707473525444185795403554160270722809642681642831847296672303556012796775586274347178092325226458743113317655523655255626670958156216225968018208281266858684283741496986683426354716284780229004376492833583965647875097951642088252875535823145900129967026856898970545720526282798418382467634180690243423325770596949644122541224189780082061715230852249880601371985342796525016176048518593825361248232406051886794538203297084423942036889326397844.0)
+  (num-test (* 31345149697924857384985323414506591310628538098830133854928154990821019223495435414394178930529373634315044777562902565397455028894455733092896622048288278424884040917250546068175763309233883078972879622697667174865833277342334219810618450605650614585133187005110148963483824629405555603493157452295284935004578187488673124814714326405406894084902824045787647963172437833905574178160343833139650913077173865287057167288286708807322607983179910358234015596109655900840652230258122852488289951986129788952718105898226951651151495867246384586164892018870981480003722043190639707903266193064807571586900961788679579912089.0 2067227180806746570739122295766566373146995767544546241400900414826379465803168632854028593293108913670556431832056563218709444199286888840721753894461468.0) 64797545442006646811970698282511426059102976298051534827345388707272469591333019870381858263624490336448197115781363489554169207652559213486772008013638214870324260793199674746523791257170452738018910619029072942848422098770309928561867618844814267276213608306045020686764830302020953883994906997293368193331696747777630621086600981981357507299729947717565760536305785574555255589190221698706036770081438750974356437738060098906046001271392354762036427049946092656701257615490057677558059955825843182799904828201890893555678855718728417223845757559310912618029462136640226686626513375024547351747669476392735304999046232068947570708757930233036922714350584650744960478326257916948676866148362166017752159953504981324652709881831381637989229842766220141292801807437886652.0)
+  (num-test (* 1965759082776833678304908699214846485256126608825750175641683294458978302204367346739996602241053060915897480812220051082619942907491598551933638540412113496542245474287364500698693202553692963910123752514310355402167440783023542848697962967771951714434359320001430281377747193083851165947498546085410216620013287853719686698746328198021011905482303248172483782066908570502837009924228011993318265674390462360820566174204659723461994730913995303015012684826295802887547970851558451858623353950391701673651959262042520584275132971807158231859672678070714276061110616753309305801080136339206017351200193800253572481467.0 -11092241138073130060021642325471345789108575712118027611362686690749327689527135459714040658411176246054106270789083336195599640521602432629024562630323934.0) -21804673765518097879589124792137157558586438669762099454880024920520894260754279593873244443852337739758694535682558790532827482894104906218015712179591886600693703465749571299271429989154199263793230178266758966678432691901731270899259065726530463438316383699558373053423999416350780342222940065486831353604365192968606300436304827279383661172824549131179471364227618431414928702407510473319879188990689163932586727702195573766225861364297410904859137393184592815970592502081722125458353280743087607273547490382023433724488604177909671497082747464946083901888849483505451426245881736990810339421864101129619181017696837017966116165703320918568645290788634265522956017905246042460811062666193790657969385648522736090098231379029903772234867701846824572274796526421531178.0)
+  (num-test (* -4067457132547237558852016696244696525033953641638067592741078194074861352472861925779476293767777560910963786727886946479865734639031042985368829200802420611189793957001730656623744670821921724417176679009632346904384261431052972127975733031277489967119978909321422086102208644766894305071609385305464547231057263658903212521469801833214062476735046735467944834107695748433481665714184831786462886261252526036621257865158497049125410241033365487816324425563483999957660557670189397770488996359512245971368638615503320507431381893539767352426795415898379765583574977542068222040889423739693921998717145084904555464058.0 9635268828818063607505341812331931088336041632536136269505180222913464638532245578488168867093853062326136774925531196873279749483997619950077042084971972.0) -39191042921786100943542578352486285322085069425292685238158202937549417928185097567102615300826629615520476316505465412722375794150552330462353356124896483739321653441446703127728441315609093330694305784991844511900128172079464896650958648496336601612657347012294121239821167759496102233234525084695798195547141521849769350204659392602605928907953707277320590923278178152903602506284861018886300148663530071056792375593665422754923886137410482547324901798328311927545105456397213670390651819229021443747424183114992653572959318104053511452473611466305149349027962240989590453237778130260105665310067480846969449221473610614214933278048389171979184119355459010233147440293881252851501522689209874112819966647846701257081192324007280573826673895648273593609466000383382376.0)
+  (num-test (* -22047771987573494284336211037167956208924595972749016352929724093971147687332865088249749580556015503923927321586913446367676445848750229391300778587369581738560634537089081840938984779012854694220894920437076215176060179241185151442003472788530160589267677502568156006531439509890061829154786579353177129190813899423306499631144919702707240832059008168851983259611724134448165201725432622521420667808597545410136493805873769372831833878868603946583848422310946469083400330960925084024624317866822897278934924368888332618046649078771617892961267312226309927786691384460940015979582201446635756024251269978545916298961.0 7481502540911026808093162425787184755732317118387068406204973030847892995155568099553397887864257088525242568880427634318737874025160499293315047534753494.0) -164950462146458057264341765173378248123415893870534274075422323606836246718538063890359159423074703472625232511667875897808555123518162244263016096627959208397334135559180524195701526029092734741010866589515172934676451385008535538102832400604699294088534999994990970130226363762230944961249818769566697211068918154629209895730969522747736738946126971914549491889482944152891334838234907190697109929512401661529882587076352559260375439428815896053844621297552401396168240947357044985051323834074355418902009161796886350497072010833513601114819625605048943438304411954380599728561071485061414856047768286383287807924135081902458690495890129203192613070824670256334683011083767124852354110322463725619194174195587835939047474059288568764831570274891727391545546467943319734.0)
+  (num-test (* 22607201423790553279447786193696575272983924506336369475058795405894123712509544256099524616893423762658394830755129501447553593365768543361107397299007141714383407862976654294384881771985218996697067215804348472693636567074361380875512341556932579903687576929186215185312685712277482751425466251201421842248749944123326048360909954588266368306843116245625635467041934524547983478110533044085242847795585598341867070787331785945399446665919396062565614516404861115244243161694059679274045050270546536781907061002623188435269769778378780371158624481539046590932125320888745103158180784231722265376331553893647061533815.0 10075764395489719205294189472045365742345400155046712954334138069917417587273618147303160957788995022989479371576840422540097479703418600112174202202728054.0) 227784835187493343385594867881830022845566753253174983274076326016001091958812135049265213053390506720261776960833046225700903422206015373488419693650378821159134369608830936915027161415300759990632038898164509761337714774392506802504397626551196717184785586630245704512525844329038355790338277254618639554796026366029578805283659986085947726260520495140332204643887370987929304924491772630534558682402396784510750317396488402942581973350428066695976988812610467654886227733900635715495731445319565054848075104982244316563526232071957624002266648721592744376122065531440026836549316222728280595228806728872537793522244957258060730038589170810090676474272044568671474692128168357087077816573419470273384256552275636517940058764711467508281344270125535855785388198570146010.0)
+  (num-test (* 21997874907846585575969651776904015812729615626636027149446399573806943459105370044846476738175828244018281160136531735881270437472624605280356112191272531838028896521621800558410217146758345955334174583639352151367532676985598470747138461153212653362188252002768647808852054182649808145379073620834551216386805267446360709820441771932135218282126427988826945094538034579367527908530151926679515746133600376612899354099328788736038811470295396365432559354070365548930628714861826464935305416998192532029724853617023971964507955475554955277722555849603716733374588174421463022213135839490633927005539569058361144905451.0 -1400498192750070094581812894241996480373581610489471746158083224360249880335094841398529960182484181641387946900090289855375996313447832474435929084180606.0) -30807984052781257825246153008277875918087659020905755686964119182052911551148620538090633516362197112383237624321406969368641524681503231262834662890145617622830207559490089313283375890353617292096501953380469351747504928597461154633889236826060654886877907382241867167198409355653371944304660938495445848950444683274236538890057643038410268234731745456035923559528706349316582901179686671568504971088561096469997823300883298811440849031903066114422309644669680078733839046643542078157684064686933779591609758494599988463628362190034612412739669041368897594110022347872452261447359402810277413572637740870748949093642723240662839444216981630862346445890780016393330114883270596630385367407921496982236074288475142085411632630374714528706189796772213264952893973677883306.0)
+  (num-test (* -270155241925436273159477510619232592261228150696806729750247050.0 15545126743930076938536195287546926534964892301082800206802745964245668351235397.0 72127079799316080210744562119267314209211162112457416152560774669179705347659265.0 58427280233475514109627698916382980237252687770812483048907352594138577656301900.0 91336330475502063985843547526216808965829995610054777216888670176112782119332811.0 99495081134815818196404370468895496198561677002653930126818668800341380375657337.0 6904264296552316628911621065724553059847235903647375662685025031963599691416829398469283631386160328944460790101458427909545198569619131058877708293713734.0 -16074984786353617526516141164566295497596312655026144270863093715961484079732496604871734572736757225277596743795506589617891195569235287256031608792067121393492186703333733526879481948463529609113624075923052999494363547340563039654910799974388353472433635130983731604982117092991918514078659590068643956240711810902756784590442416249652077644077280371860780741318193975770906075446772544431670392964384669681404295839302410058434872964315897505894833409101781069230919347279857855594782111721176074849502391457684148683668165019969667481755384384017844104770253558111588611189351637275389688093074751942960310850074.0) 17849860827147993486644896214424106325295064110723402251474432199595968349198253682890653243676378684005650871261983711134190416277366473221365848417375107498764965893729640224952922241531788638514200018520970345581414705756736222535562338748426356003659523260330725662384208724142177900990027225665451069059291754155591197426279006090296512196415617974140965334686090032257444820748820516976632201388937358434205022475303705442914044454220818215336283948743042841946229853366515552653568436171217572212088935263340599371830215580988184775240338748954666846379831467518505260487989636951404886967842600777836444030434816421999334066711024026401362115623932221335906548647785232855815515579448393689650116225664467056283988125816950714780486880294535933597118808163054631168063568847830481653855357008353733414826165759079092633441356914450038756281940532159493763482047244493174370100586359619040444818634156576789665732998111907245928253704097384811414269835758656988678207624731164159069547745777423464124959379113843649940896359346515513936964849811155238140671698227057228045173997904545787593258286212427476788605370334985423461194148838623911634821153061693257996982252745844329344589168264774527631972524787804330730506700000.0)
+  (num-test (* 6411564443509812216548163965666668398784964137255201222920640150.0 65325385402074288043601436729391841747319174569548241717675134253657593233436152.0 63305037198546989906433329294566491017476837189978173607681765241525113921707860.0 72383582945810879300930057856704905379805338886592055772943486702915907397618845.0 35525980101796892634292856352740658817031405780112750352735419884048051630180860.0 47579150292602967366908574298176357632207539947399443701205872093150879604391127.0 7775494633965874654516687741429737470333189902121089184439228657893110997221737422210698789286625633365548095171257583020272703565350668755439139356570.0 -7847653632223099338936161226557020783515367997970448568586056286591257384101422312757649765574456754668588904917800060981155642916520580540801153603733496143328839018174649200566737789874193483124577734129346933208306772618814806884416239295732454033604210880463262467564639515484363761639994642888910703066277724414372379965872478153546766131136324967950786993982228851928269842355632200589446224738709869729930285189047112131897218464505263042012855229737941639093204086147932759923796947642895167078971517834730472596647456786099215405165290569214043431009370032818978995463168133051136053246705694337584724712230.0) -197949741939898550383903354028842356745461597695099989904494711851411610441324234089773644533872304737431480244289438922163630848266242200711131210228027234579469457105291847132071566876246332653149194709623963836885480655282595345693084881617726426841183231475364991154699746506928116505297453355016975688761948609740314324443406930215518937775475617384099331839748494157863510168743547396262979908353122625808170296763676837551973930928848463398657587603606321137626467028732193151671337338929938959296176472483674270114824853018199281637976410726195357458134038379491704909997939715446657856320452698914513791221947734373322868574099599391493563479057703049036936132407025278683219316357543078875410080612067641232277376174351958080693019953378024732243763129075732499165068171168470237875348580987967740148512425201518758344757030205911031119619416763996490581551977913711646761182756531618786226541010835120092904291975494846126923510483263978074437667987560077422810120462938292680423746968095994108344184522240467647491991837793653579480334442342102339933473270535800619630342940590477752278184994533764839125736268376640933720554199782388890444619996919031351334561766248781813883867406045414518951152508504891407920000000.0)
+  (num-test (* 1669833986019218156514274418186396165434871163342486930502417566.0 58528969848472951398118375496887849181512821636583415470809040929690124231959506.0 50098163184827557635697120379841225459445103589988345336880332217224622666020381.0 90445522698871905833766573423181067004916996574451008349087758531794463581708977.0 92366726802191504770638415639612204654473958526592425718659284841373421985393966.0 69096133232785816552402133765198624674167660496399099321713067612475604030259084.0 323971624832697152056406152359288553860210436839331005469891386690556929684663075996719803995137130737141925308417709520389528780839777347463558171582753.0 2635514624483961079560488004237441873979133312246005082134175818331132377114926863102436691793380965631848192666106793612266994709357524826644421074908075389316030912936338175907209987972553710900613011802455058538786723149316934049388525865455871552882282353445228425640452635081303490379594663330152071465360003249884180020993032086861074931796165970076448856988084523672973069824258299029863033098237556417571526135639288006133579174344589248428714474318969988990720790226604664141927030250855550010512291136517209169959021730625428868037074528890516086527430801590050720467893089085308995719513895962750896813152.0) 2413207990093478676325592386500172980330574558867366638913149256222218924700401110600319869300256745035993991818342784487193857053589994816247466074246569162659879368383295411190237107255160498774228460295857931362161062884154872938368166514128474751716517750517217000290486110198899480877593169193610813452614906598055909439037075588626529658637140089909227353944313408987644743661503976835580507054926908821206921014266535160031749397432350114673787218438589065861056449106115395189057409933330355574558853874223262465965933679584884152813357065227868165556818717270584803360466149860292769520737249610469675917864449261901859162854558012721179400237645357401213337423255109839806528503425658270050436129019270883446965562683284298538825840361267548675967778385927410390726055957928634152514415917053614892441910675109517307682075989998558764742821214685548219206933043196677521610851950501225469125512893859254575460130829051324112015464552874242522140166275233893076603452098841950130740353331198999756316969161591691095397245996664755249875720008141774247384884623389430842799829690618405724986702942913150258769060684255363816662231923570491001519802836627028431389746450987110456127797025006251203111629141890634728548553728.0))
+
+(let ((val1 (catch #t (lambda () (* 1.0 0.0)) (lambda args 'error)))
+      (val2 (catch #t (lambda () (* 1.0 -0.0)) (lambda args 'error))))
+  (test (equal? val1 val2) #t))
+
+(if with-bignums
+    (begin
+      (num-test (let ((n 40) (s 1)) (do ((i 0 (+ i 1))) ((= i n) s) (set! s (* s 2/3)))) 1099511627776/12157665459056928801)
+      (num-test (expt 2 40) 1099511627776)
+      (num-test (expt 3 40) 12157665459056928801))
+    (if (provided? 'overflow-checks)
+	(num-test (let ((n 40) (s 1)) (do ((i 0 (+ i 1))) ((= i n) s) (set! s (* s 2/3)))) 9.043772683816628192400549525035572818665E-8)))
+
+(test (* 0 1 "hi") 'error)
+(test (* 0.0 "hi") 'error)
+(test (* 0.0+0.0i "hi") 'error)
+(test (* 0/1 "hi") 'error)
+(test (* 1 0.0 #\a) 'error)
+(test (* 2 2 2.0 2) 16.0)
+
+(test (nan? (* +nan.0 0)) #t)
+(test (nan? (* +inf.0 0)) #t)
+(test (infinite? (* +inf.0 +inf.0)) #t)
+
+(catch #t (lambda () (* #() 1)) (lambda (type info) (test (apply format #f info) "* first argument, #(), is a vector but should be a number")))
+(catch #t (lambda () (* #() 1.0)) (lambda (type info) (test (apply format #f info) "* first argument, #(), is a vector but should be a number")))
+(catch #t (lambda () (* #() 1.0+i)) (lambda (type info) (test (apply format #f info) "* first argument, #(), is a vector but should be a number")))
+(catch #t (lambda () (* 1 #())) (lambda (type info) (test (apply format #f info) "* second argument, #(), is a vector but should be a number")))
+(catch #t (lambda () (* 2.0 #())) (lambda (type info) (test (apply format #f info) "* second argument, #(), is a vector but should be a number")))
+(catch #t (lambda () (* 1 2 #())) (lambda (type info) (test (apply format #f info) "* third argument, #(), is a vector but should be a number")))
+(catch #t (lambda () (* 1 2 3 #())) (lambda (type info) (test (apply format #f info) "* fourth argument, #(), is a vector but should be a number")))
+
+(for-each
+ (lambda (arg)
+   (test (* arg +nan.0) 'error)
+   (test (* +nan.0 arg) 'error)
+   (test (* arg +inf.0) 'error)
+   (test (* +inf.0 arg) 'error)
+   (test (* 0 arg +nan.0) 'error)
+   (test (* 0 +nan.0 arg) 'error)
+   (test (* 0 arg +inf.0) 'error)
+   (test (* 0 +inf.0 arg) 'error)
+   (test (* 0 arg) 'error)
+   (test (* 0.0 arg) 'error)
+   (test (* 1 arg) 'error)
+   (test (* 1.0 arg) 'error)
+   (test (* 1/2 arg) 'error)
+   (test (* 1+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(unless with-bignums
+  (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (make-float-vector (* (ash 1 43) (ash 1 43))))) (define (hi) (func)) (hi)) 'error)
+  (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (make-float-vector (* (ash 1 2) (ash 1 43) (ash 1 43))))) (define (hi) (func)) (hi)) 'error))
+(test (real? (* 0 0+1e18i)) #t) ; 0 or 0.0
+
+
+;;; --------------------------------------------------------------------------------
+;;; +
+;;; --------------------------------------------------------------------------------
+
+(num-test (+ -0.0) 0.0)
+(num-test (+ -0.0+0.00000001i) -0.0+0.00000001i)
+(num-test (+ -1.0) -1.0)
+(num-test (+ -1.0+1.0i -1.0+1.0i) -2.0+2.0i)
+(num-test (+ -1.0+1.0i 0) -1.0+1.0i)
+(num-test (+ -1.0+1.0i 0.0) -1.0+1.0i)
+(num-test (+ -1.0+1.0i 0.0+1.0i) -1.0+2.0i)
+(num-test (+ -1.0+1.0i 1) 0.0+1.0i)
+(num-test (+ -1.0+1.0i 1.0) 0.0+1.0i)
+(num-test (+ -1.0+1.0i 1.0+1.0i) 0.0+2.0i)
+(num-test (+ -1.0+1.0i 1/1) 0.0+1.0i)
+(num-test (+ -1.0+1.0i 123.4) 122.4+1.0i)
+(num-test (+ -1.0+1.0i 1234) 1233.0+1.0i)
+(num-test (+ -1.0+1.0i 1234/11) 111.18181818181819+1.0i)
+(num-test (+ -1.0+1.0i) -1.0+1.0i)
+(num-test (+ -10) -10)
+(num-test (+ -10/3) -10/3)
+(num-test (+ -1234000000) -1234000000)
+(num-test (+ -1234000000.0) -1234000000.0)
+(num-test (+ -1234000000/10) -1234000000/10)
+(num-test (+ -2/2) -2/2)
+(num-test (+ 0 0) 0)
+(num-test (+ 0 0.0+1.0i) 0.0+1.0i)
+(num-test (+ 0 1 0) 1)
+(num-test (+ 0 1 0.0+1.0i) 1.0+1.0i)
+(num-test (+ 0 1 1.0) 2.0)
+(num-test (+ 0 1 1/1) 2)
+(num-test (+ 0 1 1234) 1235)
+(num-test (+ 0 1) 1)
+(num-test (+ 0 1.0 0) 1.0)
+(num-test (+ 0 1.0 0.0+1.0i) 1.0+1.0i)
+(num-test (+ 0 1.0 1.0) 2.0)
+(num-test (+ 0 1.0 1/1) 2.0)
+(num-test (+ 0 1.0 1234) 1235.0)
+(num-test (+ 0 1.0) 1.0)
+(num-test (+ 0 1.0+1.0i 0) 1.0+1.0i)
+(num-test (+ 0 1.0+1.0i 0.0+1.0i) 1.0+2.0i)
+(num-test (+ 0 1.0+1.0i 1.0) 2.0+1.0i)
+(num-test (+ 0 1.0+1.0i 1/1) 2.0+1.0i)
+(num-test (+ 0 1.0+1.0i 1234) 1235.0+1.0i)
+(num-test (+ 0 1.0+1.0i) 1.0+1.0i)
+(num-test (+ 0 123.4) 123.4)
+(num-test (+ 0 1234/11) 1234/11)
+(num-test (+ 0.0 -1.0+1.0i -1.0+1.0i) -2.0+2.0i)
+(num-test (+ 0.0 -1.0+1.0i 0.0) -1.0+1.0i)
+(num-test (+ 0.0 -1.0+1.0i 1) 0.0+1.0i)
+(num-test (+ 0.0 -1.0+1.0i 1.0+1.0i) 0.0+2.0i)
+(num-test (+ 0.0 -1.0+1.0i 123.4) 122.4+1.0i)
+(num-test (+ 0.0 -1.0+1.0i 1234/11) 111.18181818181819+1.0i)
+(num-test (+ 0.0 0 -1.0+1.0i) -1.0+1.0i)
+(num-test (+ 0.0 0 0.0) 0.0)
+(num-test (+ 0.0 0 1) 1.0)
+(num-test (+ 0.0 0 1.0+1.0i) 1.0+1.0i)
+(num-test (+ 0.0 0 123.4) 123.4)
+(num-test (+ 0.0 0 1234/11) 112.18181818181819)
+(num-test (+ 0.0 0.0 -1.0+1.0i) -1.0+1.0i)
+(num-test (+ 0.0 0.0 0.0) 0.0)
+(num-test (+ 0.0 0.0 1) 1.0)
+(num-test (+ 0.0 0.0 1.0+1.0i) 1.0+1.0i)
+(num-test (+ 0.0 0.0 123.4) 123.4)
+(num-test (+ 0.0 0.0 1234/11) 112.18181818181819)
+(num-test (+ 0.0 0.0+1.0i -1.0+1.0i) -1.0+2.0i)
+(num-test (+ 0.0 0.0+1.0i 0.0) 0.0+1.0i)
+(num-test (+ 0.0 0.0+1.0i 1) 1.0+1.0i)
+(num-test (+ 0.0 0.0+1.0i 1.0+1.0i) 1.0+2.0i)
+(num-test (+ 0.0 0.0+1.0i 123.4) 123.4+1.0i)
+(num-test (+ 0.0 0.0+1.0i 1234/11) 112.18181818181819+1.0i)
+(num-test (+ 0.0 1 -1.0+1.0i) 0.0+1.0i)
+(num-test (+ 0.0 1 0.0) 1.0)
+(num-test (+ 0.0 1 1.0) 2.0)
+(num-test (+ 0.0 1 1/1) 2.0)
+(num-test (+ 0.0 1 1234) 1235.0)
+(num-test (+ 0.0 1) 1.0)
+(num-test (+ 0.0 1.0 0) 1.0)
+(num-test (+ 0.0 1.0 0.0+1.0i) 1.0+1.0i)
+(num-test (+ 0.0 1.0 1.0) 2.0)
+(num-test (+ 0.0 1.0 1/1) 2.0)
+(num-test (+ 0.0 1.0 1234) 1235.0)
+(num-test (+ 0.0 1.0) 1.0)
+(num-test (+ 0.0 1.0+1.0i 0) 1.0+1.0i)
+(num-test (+ 0.0 1.0+1.0i 0.0+1.0i) 1.0+2.0i)
+(num-test (+ 0.0 1.0+1.0i 1.0) 2.0+1.0i)
+(num-test (+ 0.0 1.0+1.0i 1/1) 2.0+1.0i)
+(num-test (+ 0.0 1.0+1.0i 1234) 1235.0+1.0i)
+(num-test (+ 0.0 1.0+1.0i) 1.0+1.0i)
+(num-test (+ 0.0 123.4 -1.0+1.0i) 122.4+1.0i)
+(num-test (+ 0.0 123.4 0.0) 123.4)
+(num-test (+ 0.0 123.4 1) 124.4)
+(num-test (+ 0.0 123.4 1.0+1.0i) 124.4+1.0i)
+(num-test (+ 0.0 123.4 123.4) 246.8)
+(num-test (+ 0.0 123.4 1234/11) 235.58181818181819)
+(num-test (+ 0.0 1234 -1.0+1.0i) 1233.0+1.0i)
+(num-test (+ 0.0 1234 0.0) 1234.0)
+(num-test (+ 0.0 1234 1) 1235.0)
+(num-test (+ 0.0 1234 1.0+1.0i) 1235.0+1.0i)
+(num-test (+ 0.0 1234 123.4) 1357.4)
+(num-test (+ 0.0 1234 1234/11) 1346.18181818181824)
+(num-test (+ 0.0 1234/11 -1.0+1.0i) 111.18181818181819+1.0i)
+(num-test (+ 0.0 1234/11 0.0) 112.18181818181819)
+(num-test (+ 0.0 1234/11 1) 113.18181818181819)
+(num-test (+ 0.0 1234/11 1.0+1.0i) 113.18181818181819+1.0i)
+(num-test (+ 0.0 1234/11 123.4) 235.58181818181819)
+(num-test (+ 0.0 1234/11 1234/11) 224.36363636363637)
+(num-test (+ 0.0) 0.0)
+(num-test (+ 0.0+1.0i -1.0+1.0i) -1.0+2.0i)
+(num-test (+ 0.0+1.0i 0.0) 0.0+1.0i)
+(num-test (+ 0.0+1.0i 1) 1.0+1.0i)
+(num-test (+ 0.0+1.0i 1.0+1.0i) 1.0+2.0i)
+(num-test (+ 0.0+1.0i 123.4) 123.4+1.0i)
+(num-test (+ 0.0+1.0i 1234/11) 112.18181818181819+1.0i)
+(num-test (+ 1 -1.0+1.0i) 0.0+1.0i)
+(num-test (+ 1 0.0) 1.0)
+(num-test (+ 1 1 -1.0+1.0i) 1.0+1.0i)
+(num-test (+ 1 1 0.0) 2.0)
+(num-test (+ 1 1 1) 3)
+(num-test (+ 1 1 1.0+1.0i) 3.0+1.0i)
+(num-test (+ 1 1 123.4) 125.4)
+(num-test (+ 1 1 1234/11) 1256/11)
+(num-test (+ 1 1.0 -1.0+1.0i) 1.0+1.0i)
+(num-test (+ 1 1.0 0.0) 2.0)
+(num-test (+ 1 1.0 1) 3.0)
+(num-test (+ 1 1.0 1.0+1.0i) 3.0+1.0i)
+(num-test (+ 1 1.0 123.4) 125.4)
+(num-test (+ 1 1.0 1234/11) 114.18181818181819)
+(num-test (+ 1 1.0+1.0i -1.0+1.0i) 1.0+2.0i)
+(num-test (+ 1 1.0+1.0i 0.0) 2.0+1.0i)
+(num-test (+ 1 1.0+1.0i 1) 3.0+1.0i)
+(num-test (+ 1 1.0+1.0i 1.0+1.0i) 3.0+2.0i)
+(num-test (+ 1 1.0+1.0i 123.4) 125.4+1.0i)
+(num-test (+ 1 1.0+1.0i 1234/11) 114.18181818181819+1.0i)
+(num-test (+ 1 123.4) 124.4)
+(num-test (+ 1 1234/11) 1245/11)
+(num-test (+ 1.0 -1.0+1.0i 0) 0.0+1.0i)
+(num-test (+ 1.0 -1.0+1.0i 0.0+1.0i) 0.0+2.0i)
+(num-test (+ 1.0 -1.0+1.0i 1.0) 1.0+1.0i)
+(num-test (+ 1.0 -1.0+1.0i 1/1) 1.0+1.0i)
+(num-test (+ 1.0 -1.0+1.0i 1234) 1234.0+1.0i)
+(num-test (+ 1.0 -1.0+1.0i) 0.0+1.0i)
+(num-test (+ 1.0 0 0) 1.0)
+(num-test (+ 1.0 0 0.0+1.0i) 1.0+1.0i)
+(num-test (+ 1.0 0 1.0) 2.0)
+(num-test (+ 1.0 0 1/1) 2.0)
+(num-test (+ 1.0 0 1234) 1235.0)
+(num-test (+ 1.0 0) 1.0)
+(num-test (+ 1.0 0.0 0) 1.0)
+(num-test (+ 1.0 0.0 0.0+1.0i) 1.0+1.0i)
+(num-test (+ 1.0 0.0 1.0) 2.0)
+(num-test (+ 1.0 0.0 1/1) 2.0)
+(num-test (+ 1.0 0.0 1234) 1235.0)
+(num-test (+ 1.0 0.0) 1.0)
+(num-test (+ 1.0 0.0+1.0i 0) 1.0+1.0i)
+(num-test (+ 1.0 0.0+1.0i 0.0+1.0i) 1.0+2.0i)
+(num-test (+ 1.0 0.0+1.0i 1.0) 2.0+1.0i)
+(num-test (+ 1.0 0.0+1.0i 1/1) 2.0+1.0i)
+(num-test (+ 1.0 0.0+1.0i 1234) 1235.0+1.0i)
+(num-test (+ 1.0 0.0+1.0i) 1.0+1.0i)
+(num-test (+ 1.0 1 0) 2.0)
+(num-test (+ 1.0 1 0.0+1.0i) 2.0+1.0i)
+(num-test (+ 1.0 1 1.0) 3.0)
+(num-test (+ 1.0 1 1/1) 3.0)
+(num-test (+ 1.0 1 1234) 1236.0)
+(num-test (+ 1.0 1) 2.0)
+(num-test (+ 1.0 1.0 0) 2.0)
+(num-test (+ 1.0 1.0 0.0+1.0i) 2.0+1.0i)
+(num-test (+ 1.0 1.0 1.0) 3.0)
+(num-test (+ 1.0 1.0 1/1) 3.0)
+(num-test (+ 1.0 1.0 1234) 1236.0)
+(num-test (+ 1.0 1.0) 2.0)
+(num-test (+ 1.0 1.0+1.0i 0) 2.0+1.0i)
+(num-test (+ 1.0 1.0+1.0i 0.0+1.0i) 2.0+2.0i)
+(num-test (+ 1.0 1.0+1.0i 1.0) 3.0+1.0i)
+(num-test (+ 1.0 1.0+1.0i 1/1) 3.0+1.0i)
+(num-test (+ 1.0 1.0+1.0i 1234) 1236.0+1.0i)
+(num-test (+ 1.0 1.0+1.0i) 2.0+1.0i)
+(num-test (+ 1.0 123.4 -1.0+1.0i) 123.4+1.0i)
+(num-test (+ 1.0 123.4 0.0) 124.4)
+(num-test (+ 1.0 123.4 1) 125.4)
+(num-test (+ 1.0 123.4 1.0+1.0i) 125.4+1.0i)
+(num-test (+ 1.0 123.4 123.4) 247.8)
+(num-test (+ 1.0 123.4 1234/11) 236.58181818181819)
+(num-test (+ 1.0 1234 -1.0+1.0i) 1234.0+1.0i)
+(num-test (+ 1.0 1234 0.0) 1235.0)
+(num-test (+ 1.0 1234 1) 1236.0)
+(num-test (+ 1.0 1234 1.0+1.0i) 1236.0+1.0i)
+(num-test (+ 1.0 1234 123.4) 1358.4)
+(num-test (+ 1.0 1234 1234/11) 1347.18181818181824)
+(num-test (+ 1.0 1234/11 -1.0+1.0i) 112.18181818181819+1.0i)
+(num-test (+ 1.0 1234/11 0.0) 113.18181818181819)
+(num-test (+ 1.0 1234/11 1) 114.18181818181819)
+(num-test (+ 1.0 1234/11 1.0+1.0i) 114.18181818181819+1.0i)
+(num-test (+ 1.0 1234/11 123.4) 236.58181818181819)
+(num-test (+ 1.0 1234/11 1234/11) 225.36363636363637)
+(num-test (+ 1.0) 1.0)
+(num-test (+ 1.0+1.0i -1.0+1.0i 0) 0.0+2.0i)
+(num-test (+ 1.0+1.0i -1.0+1.0i 0.0+1.0i) 0.0+3.0i)
+(num-test (+ 1.0+1.0i -1.0+1.0i 1.0) 1.0+2.0i)
+(num-test (+ 1.0+1.0i -1.0+1.0i 1/1) 1.0+2.0i)
+(num-test (+ 1.0+1.0i -1.0+1.0i 1234) 1234.0+2.0i)
+(num-test (+ 1.0+1.0i -1.0+1.0i) 0.0+2.0i)
+(num-test (+ 1.0+1.0i 0 0) 1.0+1.0i)
+(num-test (+ 1.0+1.0i 0 0.0+1.0i) 1.0+2.0i)
+(num-test (+ 1.0+1.0i 0 1.0) 2.0+1.0i)
+(num-test (+ 1.0+1.0i 0 1/1) 2.0+1.0i)
+(num-test (+ 1.0+1.0i 0 1234) 1235.0+1.0i)
+(num-test (+ 1.0+1.0i 0) 1.0+1.0i)
+(num-test (+ 1.0+1.0i 0.0 0) 1.0+1.0i)
+(num-test (+ 1.0+1.0i 0.0 0.0+1.0i) 1.0+2.0i)
+(num-test (+ 1.0+1.0i 0.0 1.0) 2.0+1.0i)
+(num-test (+ 1.0+1.0i 0.0 1/1) 2.0+1.0i)
+(num-test (+ 1.0+1.0i 0.0 1234) 1235.0+1.0i)
+(num-test (+ 1.0+1.0i 0.0) 1.0+1.0i)
+(num-test (+ 1.0+1.0i 0.0+1.0i 0) 1.0+2.0i)
+(num-test (+ 1.0+1.0i 0.0+1.0i 0.0+1.0i) 1.0+3.0i)
+(num-test (+ 1.0+1.0i 0.0+1.0i 1.0) 2.0+2.0i)
+(num-test (+ 1.0+1.0i 0.0+1.0i 1/1) 2.0+2.0i)
+(num-test (+ 1.0+1.0i 0.0+1.0i 1234) 1235.0+2.0i)
+(num-test (+ 1.0+1.0i 0.0+1.0i) 1.0+2.0i)
+(num-test (+ 1.0+1.0i 1 0) 2.0+1.0i)
+(num-test (+ 1.0+1.0i 1 0.0+1.0i) 2.0+2.0i)
+(num-test (+ 1.0+1.0i 1 1.0) 3.0+1.0i)
+(num-test (+ 1.0+1.0i 1 1/1) 3.0+1.0i)
+(num-test (+ 1.0+1.0i 1 1234) 1236.0+1.0i)
+(num-test (+ 1.0+1.0i 1) 2.0+1.0i)
+(num-test (+ 1.0+1.0i 1.0 0) 2.0+1.0i)
+(num-test (+ 1.0+1.0i 1.0 0.0+1.0i) 2.0+2.0i)
+(num-test (+ 1.0+1.0i 1.0 1.0) 3.0+1.0i)
+(num-test (+ 1.0+1.0i 1.0 1/1) 3.0+1.0i)
+(num-test (+ 1.0+1.0i 1.0 1234) 1236.0+1.0i)
+(num-test (+ 1.0+1.0i 1.0) 2.0+1.0i)
+(num-test (+ 1.0+1.0i 1.0+1.0i 0) 2.0+2.0i)
+(num-test (+ 1.0+1.0i 1.0+1.0i 0.0+1.0i) 2.0+3.0i)
+(num-test (+ 1.0+1.0i 1.0+1.0i 1.0) 3.0+2.0i)
+(num-test (+ 1.0+1.0i 1.0+1.0i 1/1) 3.0+2.0i)
+(num-test (+ 1.0+1.0i 1.0+1.0i 1234) 1236.0+2.0i)
+(num-test (+ 1.0+1.0i 1.0+1.0i) 2.0+2.0i)
+(num-test (+ 1.0+1.0i 123.4 0) 124.4+1.0i)
+(num-test (+ 1.0+1.0i 123.4 0.0+1.0i) 124.4+2.0i)
+(num-test (+ 1.0+1.0i 123.4 1.0) 125.4+1.0i)
+(num-test (+ 1.0+1.0i 123.4 1/1) 125.4+1.0i)
+(num-test (+ 1.0+1.0i 123.4 1234) 1358.4+1.0i)
+(num-test (+ 1.0+1.0i 123.4) 124.4+1.0i)
+(num-test (+ 1.0+1.0i 1234 0) 1235.0+1.0i)
+(num-test (+ 1.0+1.0i 1234 0.0+1.0i) 1235.0+2.0i)
+(num-test (+ 1.0+1.0i 1234 1.0) 1236.0+1.0i)
+(num-test (+ 1.0+1.0i 1234 1/1) 1236.0+1.0i)
+(num-test (+ 1.0+1.0i 1234 1234) 2469.0+1.0i)
+(num-test (+ 1.0+1.0i 1234) 1235.0+1.0i)
+(num-test (+ 1.0+1.0i 1234/11 0) 113.18181818181819+1.0i)
+(num-test (+ 1.0+1.0i 1234/11 0.0+1.0i) 113.18181818181819+2.0i)
+(num-test (+ 1.0+1.0i 1234/11 1.0) 114.18181818181819+1.0i)
+(num-test (+ 1.0+1.0i 1234/11 1/1) 114.18181818181819+1.0i)
+(num-test (+ 1.0+1.0i 1234/11 1234) 1347.18181818181824+1.0i)
+(num-test (+ 1.0+1.0i 1234/11) 113.18181818181819+1.0i)
+(num-test (+ 10) 10)
+(num-test (+ 123.4 -1.0+1.0i -1.0+1.0i) 121.4+2.0i)
+(num-test (+ 123.4 -1.0+1.0i 0.0) 122.4+1.0i)
+(num-test (+ 123.4 -1.0+1.0i 1) 123.4+1.0i)
+(num-test (+ 123.4 -1.0+1.0i 1.0+1.0i) 123.4+2.0i)
+(num-test (+ 123.4 -1.0+1.0i 123.4) 245.8+1.0i)
+(num-test (+ 123.4 -1.0+1.0i 1234/11) 234.58181818181819+1.0i)
+(num-test (+ 123.4 0 -1.0+1.0i) 122.4+1.0i)
+(num-test (+ 123.4 0 0.0) 123.4)
+(num-test (+ 123.4 0 1) 124.4)
+(num-test (+ 123.4 0 1.0+1.0i) 124.4+1.0i)
+(num-test (+ 123.4 0 123.4) 246.8)
+(num-test (+ 123.4 0 1234/11) 235.58181818181819)
+(num-test (+ 123.4 0.0 -1.0+1.0i) 122.4+1.0i)
+(num-test (+ 123.4 0.0 0.0) 123.4)
+(num-test (+ 123.4 0.0 1) 124.4)
+(num-test (+ 123.4 0.0 1.0+1.0i) 124.4+1.0i)
+(num-test (+ 123.4 0.0 123.4) 246.8)
+(num-test (+ 123.4 0.0 1234/11) 235.58181818181819)
+(num-test (+ 123.4 0.0+1.0i -1.0+1.0i) 122.4+2.0i)
+(num-test (+ 123.4 0.0+1.0i 0.0) 123.4+1.0i)
+(num-test (+ 123.4 0.0+1.0i 1) 124.4+1.0i)
+(num-test (+ 123.4 0.0+1.0i 1.0+1.0i) 124.4+2.0i)
+(num-test (+ 123.4 0.0+1.0i 123.4) 246.8+1.0i)
+(num-test (+ 123.4 0.0+1.0i 1234/11) 235.58181818181819+1.0i)
+(num-test (+ 123.4 1 -1.0+1.0i) 123.4+1.0i)
+(num-test (+ 123.4 1 0.0) 124.4)
+(num-test (+ 123.4 1 1) 125.4)
+(num-test (+ 123.4 1 1.0+1.0i) 125.4+1.0i)
+(num-test (+ 123.4 1 123.4) 247.8)
+(num-test (+ 123.4 1 1234/11) 236.58181818181819)
+(num-test (+ 123.4 1.0 -1.0+1.0i) 123.4+1.0i)
+(num-test (+ 123.4 1.0 0.0) 124.4)
+(num-test (+ 123.4 1.0 1) 125.4)
+(num-test (+ 123.4 1.0 1.0+1.0i) 125.4+1.0i)
+(num-test (+ 123.4 1.0 123.4) 247.8)
+(num-test (+ 123.4 1.0 1234/11) 236.58181818181819)
+(num-test (+ 123.4 1.0+1.0i -1.0+1.0i) 123.4+2.0i)
+(num-test (+ 123.4 1.0+1.0i 0.0) 124.4+1.0i)
+(num-test (+ 123.4 1.0+1.0i 1) 125.4+1.0i)
+(num-test (+ 123.4 1.0+1.0i 1.0+1.0i) 125.4+2.0i)
+(num-test (+ 123.4 1.0+1.0i 123.4) 247.8+1.0i)
+(num-test (+ 123.4 1.0+1.0i 1234/11) 236.58181818181819+1.0i)
+(num-test (+ 123.4 1/1 -1.0+1.0i) 123.4+1.0i)
+(num-test (+ 123.4 123.4 0) 246.8)
+(num-test (+ 123.4 123.4 0.0+1.0i) 246.8+1.0i)
+(num-test (+ 123.4 123.4 1.0) 247.8)
+(num-test (+ 123.4 123.4 1/1) 247.8)
+(num-test (+ 123.4 123.4 1234) 1480.79999999999995)
+(num-test (+ 123.4 123.4) 246.8)
+(num-test (+ 123.4 1234 0) 1357.4)
+(num-test (+ 123.4 1234 0.0+1.0i) 1357.4+1.0i)
+(num-test (+ 123.4 1234 1.0) 1358.4)
+(num-test (+ 123.4 1234 1/1) 1358.4)
+(num-test (+ 123.4 1234 1234) 2591.4)
+(num-test (+ 123.4 1234) 1357.4)
+(num-test (+ 123.4 1234/11 0) 235.58181818181819)
+(num-test (+ 123.4 1234/11 0.0+1.0i) 235.58181818181819+1.0i)
+(num-test (+ 123.4 1234/11 1.0) 236.58181818181819)
+(num-test (+ 123.4 1234/11 1/1) 236.58181818181819)
+(num-test (+ 123.4 1234/11 1234) 1469.58181818181811)
+(num-test (+ 123.4 1234/11) 235.58181818181819)
+(num-test (+ 1234 0) 1234)
+(num-test (+ 1234 0.0+1.0i) 1234.0+1.0i)
+(num-test (+ 1234 1.0) 1235.0)
+(num-test (+ 1234 1/1) 1235)
+(num-test (+ 1234 1234) 2468)
+(num-test (+ 1234/11 -1.0+1.0i) 111.18181818181819+1.0i)
+(num-test (+ 1234/11 0.0) 112.18181818181819)
+(num-test (+ 1234/11 1) 1245/11)
+(num-test (+ 1234/11 1.0+1.0i) 113.18181818181819+1.0i)
+(num-test (+ 1234/11 123.4) 235.58181818181819)
+(num-test (+ 1234/11 1234/11) 2468/11)
+(num-test (+ 1234000000.0) 1234000000.0)
+(num-test (+ 2) 2)
+(num-test (+ 2/2) 2/2)
+
+(for-each-permutation
+ (lambda args
+   (if (not (= (apply + args) 3+i))
+       (format #t "~A: (+ ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply + args))))
+ '(1 1/2 0.5 1+i))
+
+(for-each-permutation
+ (lambda args
+   (if (not (zero? (apply + args)))
+       (format #t "~A: (+ ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply + args))))
+ '(1 1/2 0.5 1+i -1/2 -1 -0.5 -1-i))
+
+(num-test (+ 10.0+0.i) 10.0)
+(num-test (+ +10.+.0i) 10.0)
+(test (integer? (+ 1/2 1/2)) #t)
+(test (real? (+ 1+i 1-i)) #t)
+(test (integer? (+ 1/100 99/100 (- most-positive-fixnum 2))) #t) ; of course reversing the args won't work
+(test (integer? (+ 1/1000 999/1000 (- most-positive-fixnum 9223372036854775807))) #t)
+(num-test (+ 1/1000 999/1000 (- most-positive-fixnum 9223372036854775807)) 1)
+(test (integer? (+ 1/1000 999/1000 (- most-positive-fixnum 9200000000000000000))) #t)
+(num-test (+ 1/1000 999/1000 (- most-positive-fixnum 9200000000000000000)) 23372036854775808)
+(test (+ (rootlet) 1) 'error)
+
+(test (< (+ 0.7 8388608) 8388609) #t) ; false in clisp!
+
+(num-test (+ -1.797693134862315699999999999999999999998E308 -9223372036854775808) -1.797693134862315699999999999999999999998E308)
+(num-test (+ -9223372036854775808 5.551115123125783999999999999999999999984E-17) -9.223372036854775807999999999999999944489E18)
+(num-test (+ -9223372036854775808 9223372036854775807 -9223372036854775808) -9.223372036854775809e18)
+(num-test (+ -9223372036854775808) -9223372036854775808)
+(num-test (+ 1.110223024625156799999999999999999999997E-16 -9223372036854775808) -9.223372036854775807999999999999999888978E18)
+(num-test (+ 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) 1.665876638023977952217059999999999999994E-16)
+(num-test (+ 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) 1.665334536937735199999999999999999999992E-16)
+(num-test (+ 9223372036854775807 -9223372036854775808) -1)
+(num-test (+ 0.(*)) 1.0)
+(num-test (+ 0.(+)) 0.0)
+(when (provided? 'overflow-checks)
+  (num-test (+ 1/9223372036854775807 1/9223372036854775807) 2/9223372036854775807)
+  (num-test (+ 10000000/9223372036854775807 1/3) 3.333333333344175355058188377674583355698E-1)
+  (num-test (+ 1073741824 1073741824 1073741824 1073741824) (* 4 1073741824))
+  (num-test (+ 268435456/129140163 129140163/268435456 7/19 29/19) 2933929486555791403/658650172313567232)
+  (num-test (+ 268435456/129140163 129140163/268435456 7/29 29/19) 4.327416192871913348352681814704887193821E0)
+  (num-test (+ -9223372036854775808 9223372036854775807) -1)
+  (num-test (+ -9221/92233720 -92233720/9221 9221/92233720 92233720/9221) 0))
+
+(num-test (+ (/ most-negative-fixnum 2) (/ most-negative-fixnum 2)) -9223372036854775808)
+(num-test (+ (/ most-negative-fixnum 2) (/ most-negative-fixnum 2) 1) -9223372036854775807)
+(num-test (+ (/ most-negative-fixnum 2) (/ most-negative-fixnum 2) -1) (if with-bignums -9223372036854775809 -9.223372036854776e+18))
+(if (provided? 'overflow-checks)
+    (num-test (- (/ most-negative-fixnum 2) (/ most-positive-fixnum 2) 1) (if with-bignums -18446744073709551617/2 -9.223372036854776e+18)))
+(num-test (* 3037000499 3037000500) 9223372033963249500)
+(num-test (* 3037000499 3037000499) 9223372030926249001)
+;(num-test (* 3037000500 3037000500) (if with-bignums 9223372037000250000 9.223372037000249e+18))
+;(num-test (/ (* (/ 3037000499) (/ 3037000498))) 9223372027889248502)
+(when (provided? 'overflow-checks)
+  (num-test (/ (* (/ 3037000500) (/ 3037000500))) (if with-bignums 9223372037000250000 9.223372037000251e+18))
+  (num-test (/ 3037000499 (/ 3037000499)) 9223372030926249001)
+  (num-test (/ 3037000500 (/ 3037000500)) (if with-bignums 9223372037000250000 9.223372037000251e+18)))
+
+(num-test (+ 0.6049332056786565E0 -0.9611373574853808E0) -3.562041518067242999999999999999999999981E-1)
+(num-test (+ -0.4763715667865308E0 0.25936932107685584E0) -2.170022457096749600000000000000000000008E-1)
+(num-test (+ 0.2666481927718355E0 -0.04984768063142031E0) 2.168005121404151899999999999999999999994E-1)
+(num-test (+ -0.29478659758474846E0 0.3371004337672615E0) 4.231383618251304000000000000000000000076E-2)
+(num-test (+ 0.8203063910979178E0 0.28968607542857916E0) 1.109992466526496959999999999999999999999E0)
+(num-test (+ -0.08207985138263585E0 0.4368723951711785E0) 3.5479254378854265E-1)
+(num-test (+ -0.8659875373355486E0 -6.631430771196765E9) -6.6314307720627525373355486E9)
+(num-test (+ 0.15071385783307878E0 -7.154424279496395E9) -7.154424279345681142166921220000000000013E9)
+(num-test (+ -0.8969642760814789E0 -2.4070067380831727E8) -2.407006747052815460814789000000000000005E8)
+(num-test (+ -0.9610362081435054E0 9.070410778399954E9) 9.070410777438917634019580537500000000004E9)
+(num-test (+ 0.5129052501104072E0 -7.47841120327471E9) -7.478411202761804451427678737500000000008E9)
+(num-test (+ 0.3840242289740675E0 7.793048210060242E9) 7.793048210444265928192817499999999999991E9)
+(num-test (+ 0.07603066126204616E0 5.215008470388369E-11) 7.603066131419624470388369000000000000006E-2)
+(num-test (+ -0.17187858025312586E0 -5.116645189173968E-11) -1.718785803042923118917396799999999999997E-1)
+(num-test (+ 0.2521315816245864E0 8.603210607505339E-11) 2.521315817106185060750533899999999999992E-1)
+(num-test (+ -0.3557185853193914E0 -2.0371324697272998E-11) -3.557185853397627246972729979999999999995E-1)
+(num-test (+ 0.7142792289542045E0 -7.106356053331326E-11) 7.142792288831409394666867399999999999997E-1)
+(num-test (+ 0.4380415886629452E0 -3.069969538383403E-11) 4.380415886322455046161659700000000000005E-1)
+(num-test (+ 0.24798614227178573E0 3.972393639614975E19) 3.972393639614975000024798614227178572989E19)
+(num-test (+ -0.5210677288128815E0 4.846393336901129E19) 4.846393336901128999947893227118711850007E19)
+(num-test (+ 0.5825404819115E0 1.9710987361264255E19) 1.971098736126425500058254048191149998548E19)
+(num-test (+ 0.9105175208730549E0 2.391166552096775E19) 2.391166552096775000091051752087305489998E19)
+(num-test (+ 0.48414423368371695E0 -9.696117779740095E19) -9.696117779740094999951585576631628304997E19)
+(num-test (+ 0.25780758450697716E0 6.094683117025535E19) 6.094683117025535000025780758450697715991E19)
+(num-test (+ 0.9824539149570484E0 -5.4680066990812835E-21) 9.824539149570483999945319933009187165013E-1)
+(num-test (+ -0.9520982941158654E0 3.2513564801568073E-21) -9.520982941158653999967486435198431927013E-1)
+(num-test (+ 0.0630170624560149E0 -9.858852595793203E-21) 6.301706245601489999014114740420679700008E-2)
+(num-test (+ 0.24705141169888878E0 1.4582081178692862E-22) 2.470514116988887800001458208117869286195E-1)
+(num-test (+ 0.7440948700757135E0 -3.0932442581890818E-21) 7.440948700757134999969067557418109181978E-1)
+(num-test (+ -0.5055970869515372E0 4.0277457257516025E-21) -5.055970869515371999959722542742483974988E-1)
+(num-test (+ 1.672355787134947E9 0.0064909681594120805E0) 1.6723557871414380296981083695625E9)
+(num-test (+ -9.694504381396599E9 -0.8925470085542831E0) -9.694504382289146008554283099999999999987E9)
+(num-test (+ -1.6695005924298635E9 -0.34426964741306E0) -1.669500592774133147413059987073324919041E9)
+(num-test (+ -6.085591212594774E9 0.5107956920100049E0) -6.085591212083978307989995100000000000004E9)
+(num-test (+ 7.457486660952688E9 -0.4323787588338597E0) 7.457486660520309458329226237499999999989E9)
+(num-test (+ -8.790796444526546E9 0.911415263281967E0) -8.790796443615130736718033019187146237507E9)
+(num-test (+ 9.667548804251982E9 -1.266547751029956E8) 9.54089402914898613522949218749999999999E9)
+(num-test (+ -6.169561898845145E9 9.627911197121864E9) 3.458349298276719318847656250000000000009E9)
+(num-test (+ -9.870287253215279E9 9.004242781937655E8) -8.969862975021513478950500488281249999995E9)
+(num-test (+ -8.175630881172554E9 -4.08632236263908E9) -1.226195324381163404760742187500000000002E10)
+(num-test (+ 2.9069444232153206E9 -7.961831315741894E9) -5.054886892526573399999999999999999999977E9)
+(num-test (+ -7.003647401371184E9 -1.768371514817526E9) -8.772018916188710000000000000000000000001E9)
+(num-test (+ -6.418847599138249E9 2.755257250162372E-11) -6.418847599138248999972447427498376279997E9)
+(num-test (+ 2.3093152687241793E9 1.2205440142364766E-11) 2.309315268724179300012205440142364766011E9)
+(num-test (+ 8.634577667577518E9 -9.065714034538668E-11) 8.634577667577518463044108484654613319994E9)
+(num-test (+ 1.711283212591781E9 -3.235019197733951E-11) 1.71128321259178090092285000333516049E9)
+(num-test (+ 2.583886638357791E9 -8.199109798920928E-11) 2.583886638357790946878458120760790719997E9)
+(num-test (+ -7.517123950474774E9 5.2057802142431697E-11) -7.51712395047477399994794219785756830298E9)
+(num-test (+ 3.266571938086574E9 -4.4782768261898355E19) -4.478276825863178306191342592239379882812E19)
+(num-test (+ 2.1000389219899452E9 -8.547158903365463E19) -8.547158903155459107801005480000000000002E19)
+(num-test (+ -3.9140926801217155E9 7.387959860641422E19) 7.387959860250012731987828450000000000009E19)
+(num-test (+ -7.087607465790431E9 7.96875093387599E19) 7.968750933167229781420956900000000000008E19)
+(num-test (+ -8.341000808926519E9 6.9360028397637304E19) 6.936002838929630319107348100000000000009E19)
+(num-test (+ -5.507940634743809E9 9.760028858210094E19) 9.760028857659299936525619099999999999989E19)
+(num-test (+ 8.492522971238823E9 -2.8253881864964467E-22) 8.492522971238822937011718749999717461174E9)
+(num-test (+ 1.2731765723336241E9 -5.8473937102910264E-21) 1.273176572333624099999999999994152606294E9)
+(num-test (+ 9.654280758878323E9 -4.2332114049658973E-22) 9.654280758878322601318359374999576678861E9)
+(num-test (+ -6.864618926120946E9 -1.245648314796599E-21) -6.864618926120946000000000000001245648334E9)
+(num-test (+ -3.9916044043798673E8 1.697737588450543E-21) -3.991604404379867299999999999983022624115E8)
+(num-test (+ -7.818041624198686E9 4.635421587404246E-21) -7.818041624198685999999999999995364578418E9)
+(num-test (+ 2.0609929543990767E-12 -0.2126306554359736E0) -2.126306554339126070456009232999999999998E-1)
+(num-test (+ -1.5923091695877845E-11 0.515731533720818E0) 5.157315337048949444413677540931484848253E-1)
+(num-test (+ 4.794527092905871E-11 -0.9066947202676092E0) -9.0669472021966392907094129E-1)
+(num-test (+ -8.63854477728633E-11 0.3122982022565777E0) 3.122982021701922522271366999999999999999E-1)
+(num-test (+ -7.577966666552416E-11 -0.24137602092437593E0) -2.413760210001555966655241600000000000004E-1)
+(num-test (+ -4.971730475882754E-11 -0.8202688719750202E0) -8.202688720247375047588275400000000000012E-1)
+(num-test (+ -5.249369194379291E-11 -8.546120620321186E9) -8.546120620321186000052493691943792910002E9)
+(num-test (+ 8.280786962526793E-11 5.758373397436368E9) 5.758373397436367988669233650875267930002E9)
+(num-test (+ 6.370323595535815E-11 -8.470663335712393E9) -8.470663335712392999936296764044641849996E9)
+(num-test (+ 3.59771226839467E-11 3.5042505440266216E8) 3.504250544026621600359771226839466999997E8)
+(num-test (+ -3.945501687396375E-11 -5.082779978069177E9) -5.082779978069177000039455016873963749988E9)
+(num-test (+ 9.780590963267516E-11 -5.05591945120475E9) -5.055919451204750060937350340367324839998E9)
+(num-test (+ 6.323293597096768E-11 -7.208898910487284E-11) -8.856053133905159999999999999999999999986E-12)
+(num-test (+ -4.549781732354749E-11 -6.095452636416357E-11) -1.064523436877110600000000000000000000002E-10)
+(num-test (+ -5.372680267837374E-11 2.0748354219485134E-11) -3.297844845888860599999999999999999999998E-11)
+(num-test (+ 3.550879553916665E-11 -4.374873254056574E-11) -8.239937001399090000000000000000000000007E-12)
+(num-test (+ -6.746002242414832E-11 3.0803985031459436E-11) -3.665603739268888400000000000000000000013E-11)
+(num-test (+ -7.902512161494214E-11 -8.907842858073236E-11) -1.681035501956744999999999999999999999998E-10)
+(num-test (+ -4.1465935469350415E-11 6.244210696961323E19) 6.24421069696132299999999999999585340645E19)
+(num-test (+ 4.921297536286578E-11 -1.694436650099881E19) -1.694436650099880999999999999995078702462E19)
+(num-test (+ -7.879478980672654E-11 6.41757969360492E19) 6.41757969360491970559999999999212052103E19)
+(num-test (+ -8.200749317872953E-11 -9.490225542618815E19) -9.490225542618815000000000000008200749324E19)
+(num-test (+ -7.572981329795812E-11 -3.350367078181029E19) -3.350367078181029000000000000007572981326E19)
+(num-test (+ -5.955255565125549E-11 -5.009913629288125E19) -5.00991362928812500000000000000595525556E19)
+(num-test (+ -9.818180775332558E-11 -7.926156011681593E-21) -9.818180776125173601168159300000000000011E-11)
+(num-test (+ -5.2466438379505935E-12 8.468830229031857E-21) -5.246643829481763270968143000000000000009E-12)
+(num-test (+ 3.582774358441715E-11 3.6865211729351863E-22) 3.582774358478580211729351862999999999999E-11)
+(num-test (+ 7.169296413565744E-11 -9.974881413980864E-21) 7.169296412568255858601913599999999999987E-11)
+(num-test (+ -9.615073655516977E-11 4.9552491300097786E-21) -9.615073655021452086999022140000000000005E-11)
+(num-test (+ 6.7696956269187E-11 4.1431488006404866E-21) 6.769695627333015423852294397336791395272E-11)
+(num-test (+ -4.663397365185298E19 0.9758464195927673E0) -4.663397365185297999902415358040723270005E19)
+(num-test (+ -4.77977261393851E19 0.04145189313162445E0) -4.779772613938509999995854810686837555009E19)
+(num-test (+ 7.195364554121596E19 0.5169917736820715E0) 7.195364554121596000051699177368207149992E19)
+(num-test (+ -7.766254779507882E19 0.5919134938460356E0) -7.766254779507881999940808650615396440016E19)
+(num-test (+ -8.411122653901408E19 -0.14463225181516137E0) -8.411122653901408000014463225181516137013E19)
+(num-test (+ -9.101920591747218E19 0.23349918704239836E0) -9.101920591747217999976650081295760164003E19)
+(num-test (+ 7.037477746142529E18 -3.250947575909365E9) 7.037477742891581424090634999999999999988E18)
+(num-test (+ -6.864341752972099E19 -4.0510449339565725E9) -6.864341753377203493395657250000000000004E19)
+(num-test (+ -5.329540273290228E19 8.14869777458878E9) -5.329540272475358222541121959686279296875E19)
+(num-test (+ -9.726234388247201E19 2.053976989398215E9) -9.726234388041803301060178494453430175781E19)
+(num-test (+ -1.910324088450308E19 6.247052535748024E9) -1.910324087825602746425197601318359375E19)
+(num-test (+ -6.079933001949367E18 6.316829148809886E9) -6.07993299563253785119011402130126953125E18)
+(num-test (+ -4.499107911798452E19 9.659763881732633E-11) -4.499107911798451999999999999990340236126E19)
+(num-test (+ -3.0972208018542522E19 -9.077209886078653E-11) -3.097220801854252200000000000009077209882E19)
+(num-test (+ -2.3000547840875442E19 -3.2043634522621155E-11) -2.300054784087544200000000000003204363456E19)
+(num-test (+ 2.124555308489292E19 2.252166800652451E-11) 2.124555308489292000000000000002252166802E19)
+(num-test (+ -7.74280238703686E19 1.7289553748884322E-11) -7.74280238703685999999999999999827104461E19)
+(num-test (+ -8.119446783121816E19 -4.3461802389685114E-11) -8.11944678312181600000000000000434618023E19)
+(num-test (+ -4.70848534032654E18 -4.698316648967506E19) -5.16916518300016E19)
+(num-test (+ 2.853799842810312E19 -5.56805968603395E19) -2.714259843223638E19)
+(num-test (+ -2.9128622996090335E19 -5.153369106520702E19) -8.0662314061297355E19)
+(num-test (+ -5.415993984772977E19 4.481932558278175E19) -9.34061426494802E18)
+(num-test (+ -1.4652301908531261E19 7.89284449966826E19) 6.4276143088151335352E19)
+(num-test (+ -8.241911630479252E19 5.377001886877124E19) -2.864909743602128E19)
+(num-test (+ -6.923631123395076E19 7.100129853298664E-22) -6.923631123395076E19)
+(num-test (+ -5.864213410820717E19 -2.649878514627326E-21) -5.864213410820717E19)
+(num-test (+ 8.660575002861176E19 2.751926085897399E-21) 8.660575002861176E19)
+(num-test (+ -3.0252871646631318E19 6.852831573716124E-21) -3.0252871646631318E19)
+(num-test (+ -9.155476807340938E19 -5.552907466957205E-21) -9.155476807340938E19)
+(num-test (+ -4.03382621358461E19 6.670808279457885E-21) -4.03382621358461E19)
+(num-test (+ 8.842980509187577E-21 0.5028466982188534E0) 5.028466982188534000088429805091875769998E-1)
+(num-test (+ 1.7292043381396136E-21 0.19490424064972922E0) 1.949042406497292200017292043381396136E-1)
+(num-test (+ -5.854820918836103E-21 -0.6700030154364615E0) -6.700030154364615000058548209188361029995E-1)
+(num-test (+ -2.152396491682048E-21 0.5002930268902921E0) 5.002930268902920999978476035083179519998E-1)
+(num-test (+ -1.0897149666610629E-21 0.16555534170490604E0) 1.655553417049060399989102850333389370996E-1)
+(num-test (+ 6.321421497987867E-24 -0.08008112131564671E0) -8.008112131564670999999367857850201213302E-2)
+(num-test (+ -6.1552667309563055E-21 7.235074489769488E9) 7.23507448976948833465576171874384473328E9)
+(num-test (+ -2.2311335001219955E-22 1.220011008333989E9) 1.220011008333988904953002929687276886647E9)
+(num-test (+ 8.523565724937177E-23 -4.1650242034123087E9) -4.165024203412308699999999999999914764338E9)
+(num-test (+ -2.4400041303825447E-21 4.435554678685388E9) 4.435554678685387611389160156247559995867E9)
+(num-test (+ -3.4479065449345757E-22 8.491084033112451E8) 8.491084033112450838088989257809052093456E8)
+(num-test (+ -7.919939059912893E-21 -7.610637842585286E9) -7.610637842585286000000000000007919939044E9)
+(num-test (+ 4.4958602369105625E-21 5.758376768873417E-11) 5.758376769323003023691056249999999999989E-11)
+(num-test (+ 2.4375297386412195E-21 9.417086717671841E-11) 9.41708671791559397386412194999999999998E-11)
+(num-test (+ 1.0040647133383462E-21 3.4701016271268983E-12) 3.470101628130963013338346199999999999999E-12)
+(num-test (+ -3.885093055726793E-21 -8.523534862249969E-11) -8.523534862638478305572679299999999999995E-11)
+(num-test (+ 1.027951323422187E-21 -7.65508060829868E-11) -7.655080608195884867657781300000000000011E-11)
+(num-test (+ -9.83813940552434E-21 -5.048380063082019E-11) -5.048380064065832940552434000000000000001E-11)
+(num-test (+ -7.640856498925806E-21 -5.743808556015994E19) -5.743808556015994E19)
+(num-test (+ 8.053891045717591E-21 4.0840032650134725E19) 4.0840032650134725E19)
+(num-test (+ -4.794782783871528E-21 -3.431216587740782E18) -3.431216587740782E18)
+(num-test (+ 1.860870988390988E-21 -3.757945694933625E19) -3.757945694933625E19)
+(num-test (+ 5.445498222566789E-21 7.575823566817991E19) 7.575823566817991E19)
+(num-test (+ 2.631896745307223E-21 4.906449817201212E19) 4.906449817201212E19)
+(num-test (+ -6.61689881073516E-21 5.357007670385275E-21) -1.25989114034988500000000000000000000001E-21)
+(num-test (+ 3.0173001109587537E-21 5.2947222461350496E-21) 8.312022357093803300000000000000000000009E-21)
+(num-test (+ -8.792518441030627E-21 -1.0516787854168774E-21) -9.84419722644750439999999999999999999997E-21)
+(num-test (+ 7.349451992884509E-21 -8.427997362671486E-21) -1.078545369786976999999999999999999999993E-21)
+(num-test (+ -7.881179611953633E-21 3.2080446524364824E-21) -4.673134959517150599999999999999999999987E-21)
+(num-test (+ -9.614117725927607E-21 -5.35667712698602E-21) -1.4970794852913627E-20)
+
+(num-test (+ 763661/10959 314049/215772 801211/520111) 29795593575023947/409959352197876)
+(num-test (+ 754684/707399 364133/66140) 43928874261/6683909980)
+(num-test (+ 440608/272315 551945/732519 640011/210080) 45409303060766899/8381179896953760)
+(num-test (+ 6567/58532 12009/41861 51413/44691) 169671941552201/109502248051932)
+(num-test (+ 24362/18498 57440/40727 22449/57480) 22502908640629/7217265880680)
+(num-test (+ 31721/56074 60995/54239) 5140748949/3041397686)
+(num-test (+ 53838/33670 41433/21212 18707/18707 38145/30697 18708/22768) 51605878718885969/7799478725530310)
+(num-test (+ 28104/38994 16087/7686 61878/25480) 238289915659/45455695740)
+(num-test (+ 19084/1172 31274/36894 58813/47401 21693/36339) 58866653148990514/3103363080883923)
+(num-test (+ 46622/34221 37123/47024 30488/35441) 2816139009923/934950024624)
+(num-test (+ 5132/18296 39996/45879 41433/58822 63206/41458) 72097712837475423/21322935628641329)
+(num-test (+ 2203/36057 55977/14559 48383/64098 9101/28942) 134587284141221743/27051518778595353)
+(num-test (+ 32375/41641 50274/42858 18792/37422 7370/20399) 1314683476492406/467198461232349)
+(num-test (+ 13733/12161 54393/23682 3717/60389) 2888390497365/828182803618)
+(num-test (+ 62280/7667 54471/23126 54070/62784) 31558604335387/2783011331232)
+(num-test (+ 11072/35120 33950/8514 59489/8783 38683/16720) 66811589960405/4989817212336)
+(num-test (+ 20220/12370 24149/50379 63926/10436) 2679308820467/325179618414)
+(num-test (+ 26718/50103 44333/20749 6375/11441 47216/19118) 12699871541397230/2229293103730143)
+(num-test (+ 38673/65491 57303/2569 40991/55309) 219956905519979/9305538976111)
+
+(num-test (+ 1/98947 2/97499 3/76847) 51641766530/741360956847391)
+(test (> (+ 123456789/3 3/123456789 -123456789/3 -3/123456789) 2e-12) #f) ; it's really 0, but fp inaccuracies catch us
+(num-test (+ 1e100 -1e100) 0.0)
+(num-test (+ 1e100 1e100) 2e100)
+(num-test (+ 1e200 -1e200) 0.0)
+(num-test (+ 1e300 -1e300) 0.0)
+(num-test (+ 500009/500029 500057/500041) 500068002022/250035001189)
+(num-test (+ 0.5 -0.5 1/2) 0.5)
+(num-test (+ 1 1/2 0.5 3.0+5.5i) 5.0+5.5i)
+(num-test (+ 1/2 0.5) 1.0)
+(num-test (+ 3 4) 7 )
+(num-test (+ 3) '3 )
+(num-test (+) 0 )
+(num-test (+ 123123123123123 123123123123123) 246246246246246)
+;(test (+ 9007199254740996.0 -9007199254740995) 1.0) ; these are fake...(anything nearby is probably bad: (+ 9007199254740995.0 -9007199254740994): 2.0
+;(test (+ -9007199254740996.0 9007199254740995) -1.0)
+;(test (+ -9007199254740996 -9007199254740995) 1)
+;(test (+ 9007199254740996 -9007199254740995.0) 1.0)
+
+(unless (or with-bignums (not (provided? 'overflow-checks)))
+  (num-test (+ 3/4 4611686018427387904) 4.61168601842738790475E18)
+  (num-test (+ 1/17179869184 1073741824) 1.073741824000000000058207660913467407227E9)
+  (num-test (+ 1/8589934592 1073741824) 1.073741824000000000116415321826934814453E9)
+  (num-test (+ 100000 1/142857142857140) 1.000000000000000000070000000000001400001E5)
+  (num-test (+ 4611686018427387904 3/4) 4.61168601842738790475E18)
+  (num-test (+ -63 8 1/9223372036854775807) -55.0)
+  (num-test (+ 8 8 1/9223372036854775807) 16.0)
+  (num-test (+ -1 -63 1/9223372036854775807) -64.0)
+  (num-test (+ 32768 -1 562949953421312/281474976710655) 32769.0)
+  (num-test (+ -63 262144 70368744177664/35184372088831) 262083.0)
+  (num-test (+ 2147483648 -1 8589934592/4294967295) 2147483649.0)
+  (num-test (+ 8589934592/4294967295 2147483648 -1) 2147483649.0)
+  (num-test (+ 8589934592/4294967295 -1 2147483648) 2147483649.0)
+  (num-test (+ -1 8589934592/4294967295 2147483648) 2147483649.0))
+
+;      (num-test (+ 4611686018427387904 4611686018427387904) 9.223372036854775808e18)
+;      (num-test (+ most-positive-fixnum most-positive-fixnum) 1.8446744073709551614e19)
+;      (num-test (+ most-negative-fixnum most-negative-fixnum) -1.8446744073709551616e19)
+
+(let () ; opt_d_dd_ff_add_mul
+  (define (f)
+    (let ((sum (float-vector 1 2 3)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) sum)
+        (float-vector-set! sum i (+ (sum i) (* (sum i) (sum i)))))))
+  (test (f) #r(2.0 6.0 12.0)))
+
+(let ()
+  (define (add1)
+    (+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99))
+  (num-test (add1) 4950)
+
+  (define (add2)
+    (+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999))
+  (num-test (add2) 499500)
+
+  (define (add3)
+    (+ 1 (+ 2 (+ 3 (+ 4 (+ 5 (+ 6 (+ 7 (+ 8 (+ 9 (+ 10 (+ 11 (+ 12 (+ 13 (+ 14 (+ 15 (+ 16 (+ 17 (+ 18 (+ 19 (+ 20 (+ 21 (+ 22 (+ 23 (+ 24 (+ 25 (+ 26 (+ 27 (+ 28 (+ 29 (+ 30 (+ 31 (+ 32 (+ 33 (+ 34 (+ 35 (+ 36 (+ 37 (+ 38 (+ 39 (+ 40 (+ 41 (+ 42 (+ 43 (+ 44 (+ 45 (+ 46 (+ 47 (+ 48 (+ 49 (+ 50 (+ 51 (+ 52 (+ 53 (+ 54 (+ 55 (+ 56 (+ 57 (+ 58 (+ 59 (+ 60 (+ 61 (+ 62 (+ 63 (+ 64 (+ 65 (+ 66 (+ 67 (+ 68 (+ 69 (+ 70 (+ 71 (+ 72 (+ 73 (+ 74 (+ 75 (+ 76 (+ 77 (+ 78 (+ 79 (+ 80 (+ 81 (+ 82 (+ 83 (+ 84 (+ 85 (+ 86 (+ 87 (+ 88 (+ 89 (+ 90 (+ 91 (+ 92 (+ 93 (+ 94 (+ 95 (+ 96 (+ 97 (+ 98 (+ 99))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
+  (num-test (add3) 4950)
+
+  (define (add4)
+    (+ 1 (+ 2 (+ 3 (+ 4 (+ 5 (+ 6 (+ 7 (+ 8 (+ 9 (+ 10 (+ 11 (+ 12 (+ 13 (+ 14 (+ 15 (+ 16 (+ 17 (+ 18 (+ 19 (+ 20 (+ 21 (+ 22 (+ 23 (+ 24 (+ 25 (+ 26 (+ 27 (+ 28 (+ 29 (+ 30 (+ 31 (+ 32 (+ 33 (+ 34 (+ 35 (+ 36 (+ 37 (+ 38 (+ 39 (+ 40 (+ 41 (+ 42 (+ 43 (+ 44 (+ 45 (+ 46 (+ 47 (+ 48 (+ 49 (+ 50 (+ 51 (+ 52 (+ 53 (+ 54 (+ 55 (+ 56 (+ 57 (+ 58 (+ 59 (+ 60 (+ 61 (+ 62 (+ 63 (+ 64 (+ 65 (+ 66 (+ 67 (+ 68 (+ 69 (+ 70 (+ 71 (+ 72 (+ 73 (+ 74 (+ 75 (+ 76 (+ 77 (+ 78 (+ 79 (+ 80 (+ 81 (+ 82 (+ 83 (+ 84 (+ 85 (+ 86 (+ 87 (+ 88 (+ 89 (+ 90 (+ 91 (+ 92 (+ 93 (+ 94 (+ 95 (+ 96 (+ 97 (+ 98 (+ 99 (+ 100 (+ 101 (+ 102 (+ 103 (+ 104 (+ 105 (+ 106 (+ 107 (+ 108 (+ 109 (+ 110 (+ 111 (+ 112 (+ 113 (+ 114 (+ 115 (+ 116 (+ 117 (+ 118 (+ 119 (+ 120 (+ 121 (+ 122 (+ 123 (+ 124 (+ 125 (+ 126 (+ 127 (+ 128 (+ 129 (+ 130 (+ 131 (+ 132 (+ 133 (+ 134 (+ 135 (+ 136 (+ 137 (+ 138 (+ 139 (+ 140 (+ 141 (+ 142 (+ 143 (+ 144 (+ 145 (+ 146 (+ 147 (+ 148 (+ 149 (+ 150 (+ 151 (+ 152 (+ 153 (+ 154 (+ 155 (+ 156 (+ 157 (+ 158 (+ 159 (+ 160 (+ 161 (+ 162 (+ 163 (+ 164 (+ 165 (+ 166 (+ 167 (+ 168 (+ 169 (+ 170 (+ 171 (+ 172 (+ 173 (+ 174 (+ 175 (+ 176 (+ 177 (+ 178 (+ 179 (+ 180 (+ 181 (+ 182 (+ 183 (+ 184 (+ 185 (+ 186 (+ 187 (+ 188 (+ 189 (+ 190 (+ 191 (+ 192 (+ 193 (+ 194 (+ 195 (+ 196 (+ 197 (+ 198 (+ 199 (+ 200 (+ 201 (+ 202 (+ 203 (+ 204 (+ 205 (+ 206 (+ 207 (+ 208 (+ 209 (+ 210 (+ 211 (+ 212 (+ 213 (+ 214 (+ 215 (+ 216 (+ 217 (+ 218 (+ 219 (+ 220 (+ 221 (+ 222 (+ 223 (+ 224 (+ 225 (+ 226 (+ 227 (+ 228 (+ 229 (+ 230 (+ 231 (+ 232 (+ 233 (+ 234 (+ 235 (+ 236 (+ 237 (+ 238 (+ 239 (+ 240 (+ 241 (+ 242 (+ 243 (+ 244 (+ 245 (+ 246 (+ 247 (+ 248 (+ 249 (+ 250 (+ 251 (+ 252 (+ 253 (+ 254 (+ 255 (+ 256 (+ 257 (+ 258 (+ 259 (+ 260 (+ 261 (+ 262 (+ 263 (+ 264 (+ 265 (+ 266 (+ 267 (+ 268 (+ 269 (+ 270 (+ 271 (+ 272 (+ 273 (+ 274 (+ 275 (+ 276 (+ 277 (+ 278 (+ 279 (+ 280 (+ 281 (+ 282 (+ 283 (+ 284 (+ 285 (+ 286 (+ 287 (+ 288 (+ 289 (+ 290 (+ 291 (+ 292 (+ 293 (+ 294 (+ 295 (+ 296 (+ 297 (+ 298 (+ 299 (+ 300 (+ 301 (+ 302 (+ 303 (+ 304 (+ 305 (+ 306 (+ 307 (+ 308 (+ 309 (+ 310 (+ 311 (+ 312 (+ 313 (+ 314 (+ 315 (+ 316 (+ 317 (+ 318 (+ 319 (+ 320 (+ 321 (+ 322 (+ 323 (+ 324 (+ 325 (+ 326 (+ 327 (+ 328 (+ 329 (+ 330 (+ 331 (+ 332 (+ 333 (+ 334 (+ 335 (+ 336 (+ 337 (+ 338 (+ 339 (+ 340 (+ 341 (+ 342 (+ 343 (+ 344 (+ 345 (+ 346 (+ 347 (+ 348 (+ 349 (+ 350 (+ 351 (+ 352 (+ 353 (+ 354 (+ 355 (+ 356 (+ 357 (+ 358 (+ 359 (+ 360 (+ 361 (+ 362 (+ 363 (+ 364 (+ 365 (+ 366 (+ 367 (+ 368 (+ 369 (+ 370 (+ 371 (+ 372 (+ 373 (+ 374 (+ 375 (+ 376 (+ 377 (+ 378 (+ 379 (+ 380 (+ 381 (+ 382 (+ 383 (+ 384 (+ 385 (+ 386 (+ 387 (+ 388 (+ 389 (+ 390 (+ 391 (+ 392 (+ 393 (+ 394 (+ 395 (+ 396 (+ 397 (+ 398 (+ 399 (+ 400 (+ 401 (+ 402 (+ 403 (+ 404 (+ 405 (+ 406 (+ 407 (+ 408 (+ 409 (+ 410 (+ 411 (+ 412 (+ 413 (+ 414 (+ 415 (+ 416 (+ 417 (+ 418 (+ 419 (+ 420 (+ 421 (+ 422 (+ 423 (+ 424 (+ 425 (+ 426 (+ 427 (+ 428 (+ 429 (+ 430 (+ 431 (+ 432 (+ 433 (+ 434 (+ 435 (+ 436 (+ 437 (+ 438 (+ 439 (+ 440 (+ 441 (+ 442 (+ 443 (+ 444 (+ 445 (+ 446 (+ 447 (+ 448 (+ 449 (+ 450 (+ 451 (+ 452 (+ 453 (+ 454 (+ 455 (+ 456 (+ 457 (+ 458 (+ 459 (+ 460 (+ 461 (+ 462 (+ 463 (+ 464 (+ 465 (+ 466 (+ 467 (+ 468 (+ 469 (+ 470 (+ 471 (+ 472 (+ 473 (+ 474 (+ 475 (+ 476 (+ 477 (+ 478 (+ 479 (+ 480 (+ 481 (+ 482 (+ 483 (+ 484 (+ 485 (+ 486 (+ 487 (+ 488 (+ 489 (+ 490 (+ 491 (+ 492 (+ 493 (+ 494 (+ 495 (+ 496 (+ 497 (+ 498 (+ 499 (+ 500 (+ 501 (+ 502 (+ 503 (+ 504 (+ 505 (+ 506 (+ 507 (+ 508 (+ 509 (+ 510 (+ 511 (+ 512 (+ 513 (+ 514 (+ 515 (+ 516 (+ 517 (+ 518 (+ 519 (+ 520 (+ 521 (+ 522 (+ 523 (+ 524 (+ 525 (+ 526 (+ 527 (+ 528 (+ 529 (+ 530 (+ 531 (+ 532 (+ 533 (+ 534 (+ 535 (+ 536 (+ 537 (+ 538 (+ 539 (+ 540 (+ 541 (+ 542 (+ 543 (+ 544 (+ 545 (+ 546 (+ 547 (+ 548 (+ 549 (+ 550 (+ 551 (+ 552 (+ 553 (+ 554 (+ 555 (+ 556 (+ 557 (+ 558 (+ 559 (+ 560 (+ 561 (+ 562 (+ 563 (+ 564 (+ 565 (+ 566 (+ 567 (+ 568 (+ 569 (+ 570 (+ 571 (+ 572 (+ 573 (+ 574 (+ 575 (+ 576 (+ 577 (+ 578 (+ 579 (+ 580 (+ 581 (+ 582 (+ 583 (+ 584 (+ 585 (+ 586 (+ 587 (+ 588 (+ 589 (+ 590 (+ 591 (+ 592 (+ 593 (+ 594 (+ 595 (+ 596 (+ 597 (+ 598 (+ 599 (+ 600 (+ 601 (+ 602 (+ 603 (+ 604 (+ 605 (+ 606 (+ 607 (+ 608 (+ 609 (+ 610 (+ 611 (+ 612 (+ 613 (+ 614 (+ 615 (+ 616 (+ 617 (+ 618 (+ 619 (+ 620 (+ 621 (+ 622 (+ 623 (+ 624 (+ 625 (+ 626 (+ 627 (+ 628 (+ 629 (+ 630 (+ 631 (+ 632 (+ 633 (+ 634 (+ 635 (+ 636 (+ 637 (+ 638 (+ 639 (+ 640 (+ 641 (+ 642 (+ 643 (+ 644 (+ 645 (+ 646 (+ 647 (+ 648 (+ 649 (+ 650 (+ 651 (+ 652 (+ 653 (+ 654 (+ 655 (+ 656 (+ 657 (+ 658 (+ 659 (+ 660 (+ 661 (+ 662 (+ 663 (+ 664 (+ 665 (+ 666 (+ 667 (+ 668 (+ 669 (+ 670 (+ 671 (+ 672 (+ 673 (+ 674 (+ 675 (+ 676 (+ 677 (+ 678 (+ 679 (+ 680 (+ 681 (+ 682 (+ 683 (+ 684 (+ 685 (+ 686 (+ 687 (+ 688 (+ 689 (+ 690 (+ 691 (+ 692 (+ 693 (+ 694 (+ 695 (+ 696 (+ 697 (+ 698 (+ 699 (+ 700 (+ 701 (+ 702 (+ 703 (+ 704 (+ 705 (+ 706 (+ 707 (+ 708 (+ 709 (+ 710 (+ 711 (+ 712 (+ 713 (+ 714 (+ 715 (+ 716 (+ 717 (+ 718 (+ 719 (+ 720 (+ 721 (+ 722 (+ 723 (+ 724 (+ 725 (+ 726 (+ 727 (+ 728 (+ 729 (+ 730 (+ 731 (+ 732 (+ 733 (+ 734 (+ 735 (+ 736 (+ 737 (+ 738 (+ 739 (+ 740 (+ 741 (+ 742 (+ 743 (+ 744 (+ 745 (+ 746 (+ 747 (+ 748 (+ 749 (+ 750 (+ 751 (+ 752 (+ 753 (+ 754 (+ 755 (+ 756 (+ 757 (+ 758 (+ 759 (+ 760 (+ 761 (+ 762 (+ 763 (+ 764 (+ 765 (+ 766 (+ 767 (+ 768 (+ 769 (+ 770 (+ 771 (+ 772 (+ 773 (+ 774 (+ 775 (+ 776 (+ 777 (+ 778 (+ 779 (+ 780 (+ 781 (+ 782 (+ 783 (+ 784 (+ 785 (+ 786 (+ 787 (+ 788 (+ 789 (+ 790 (+ 791 (+ 792 (+ 793 (+ 794 (+ 795 (+ 796 (+ 797 (+ 798 (+ 799 (+ 800 (+ 801 (+ 802 (+ 803 (+ 804 (+ 805 (+ 806 (+ 807 (+ 808 (+ 809 (+ 810 (+ 811 (+ 812 (+ 813 (+ 814 (+ 815 (+ 816 (+ 817 (+ 818 (+ 819 (+ 820 (+ 821 (+ 822 (+ 823 (+ 824 (+ 825 (+ 826 (+ 827 (+ 828 (+ 829 (+ 830 (+ 831 (+ 832 (+ 833 (+ 834 (+ 835 (+ 836 (+ 837 (+ 838 (+ 839 (+ 840 (+ 841 (+ 842 (+ 843 (+ 844 (+ 845 (+ 846 (+ 847 (+ 848 (+ 849 (+ 850 (+ 851 (+ 852 (+ 853 (+ 854 (+ 855 (+ 856 (+ 857 (+ 858 (+ 859 (+ 860 (+ 861 (+ 862 (+ 863 (+ 864 (+ 865 (+ 866 (+ 867 (+ 868 (+ 869 (+ 870 (+ 871 (+ 872 (+ 873 (+ 874 (+ 875 (+ 876 (+ 877 (+ 878 (+ 879 (+ 880 (+ 881 (+ 882 (+ 883 (+ 884 (+ 885 (+ 886 (+ 887 (+ 888 (+ 889 (+ 890 (+ 891 (+ 892 (+ 893 (+ 894 (+ 895 (+ 896 (+ 897 (+ 898 (+ 899 (+ 900 (+ 901 (+ 902 (+ 903 (+ 904 (+ 905 (+ 906 (+ 907 (+ 908 (+ 909 (+ 910 (+ 911 (+ 912 (+ 913 (+ 914 (+ 915 (+ 916 (+ 917 (+ 918 (+ 919 (+ 920 (+ 921 (+ 922 (+ 923 (+ 924 (+ 925 (+ 926 (+ 927 (+ 928 (+ 929 (+ 930 (+ 931 (+ 932 (+ 933 (+ 934 (+ 935 (+ 936 (+ 937 (+ 938 (+ 939 (+ 940 (+ 941 (+ 942 (+ 943 (+ 944 (+ 945 (+ 946 (+ 947 (+ 948 (+ 949 (+ 950 (+ 951 (+ 952 (+ 953 (+ 954 (+ 955 (+ 956 (+ 957 (+ 958 (+ 959 (+ 960 (+ 961 (+ 962 (+ 963 (+ 964 (+ 965 (+ 966 (+ 967 (+ 968 (+ 969 (+ 970 (+ 971 (+ 972 (+ 973 (+ 974 (+ 975 (+ 976 (+ 977 (+ 978 (+ 979 (+ 980 (+ 981 (+ 982 (+ 983 (+ 984 (+ 985 (+ 986 (+ 987 (+ 988 (+ 989 (+ 990 (+ 991 (+ 992 (+ 993 (+ 994 (+ 995 (+ 996 (+ 997 (+ 998 (+ 999))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
+  (num-test (add4) 499500))
+
+#|
+;;; similar -- 1 million lines and 1 million levels of nesting in a let with a million locals:
+(define size 1000000)
+(define calls 100)
+
+(call-with-output-file "t231-1.scm"
+  (lambda (p)
+    (format p "(set! (*s7* 'gc-stats) 6)~%~%")
+    (format p "(define (f~D)~%  (let ((x 0))~%" size)
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (format p "    (set! x (+ x ~D))~%" (random 10)))
+    (format p "    ))~%~%")
+
+    (format p "(define (test-f~D)~%" size)
+    (format p "  (let ((sum (f~D)))~%" size)
+    (format p "    (display sum) (newline)~%")
+    (format p "    (do ((i 0 (+ i 1)))~%")
+    (format p "        ((= i ~D))~%" calls)
+    (format p "      (unless (= (f~D) sum)~%" size)
+    (format p "        (display \"oops\")))))~%~%")
+    (format p "(test-f~D)~%~%" size)
+
+    (format p "(let ((g_0 (lambda (x) (+ x ~D)))~%" (random 10))
+    (do ((i 1 (+ i 1)))
+	((= i size))
+      (format p "      (g_~D (lambda (x) (+ x ~D)))~%" i (random 10)))
+    (format p "      )~%")
+    (format p "  (let ((call-g (lambda ()~%")
+    (format p "                 ")
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (format p "(g_~D " i)
+      (if (= (modulo i 10) 9)
+	  (format p "~%                    ")))
+    (format p "1)~%                    ")
+    (do ((i 1 (+ i 1)))
+	((= i size))
+      (format p ")")
+      (if (= (modulo i 80) 79)
+	  (format p "~%                    ")))
+    (format p ")))~%")
+    (format p "    (define (test-g)~%")
+    (format p "      (let ((sum (call-g)))~%")
+    (format p "        (display sum) (newline)~%")
+    (format p "        (do ((i 0 (+ i 1)))~%")
+    (format p "            ((= i ~D))~%" calls)
+    (format p "          (unless (= (call-g) sum)~%")
+    (format p "            (display \"yow\")))))~%~%")
+    (format p "    (test-g)))~%")))
+
+(load "t231-1.scm")
+|#
+
+(let ()
+  (define (fact n) (if (<= n 1) 1 (* n (fact (- n 1)))))
+  (num-test (fact 7) 5040)
+  (num-test (fact 20) 2432902008176640000)
+  (do ((i 2 (+ i 1)))
+      ((= i 21))
+    (num-test (* i (fact (- i 1))) (fact i))
+    (num-test (/ (* i (fact (- i 1)))) (/ (fact i))))
+  (if with-bignums
+      (begin
+	(num-test (fact 21) 51090942171709440000)
+	(num-test (fact 32) 263130836933693530167218012160000000)
+	(do ((i 20 (+ i 1)))
+	    ((= i 40))
+	  (num-test (* i (fact (- i 1))) (fact i))))))
+
+(num-test (let ((pi2 0.0)
+		(ais (vector 1 -3 -2 -3 1 0)))
+	    (do ((i 1 (+ i 1))
+		 (two 2 (* two 2)))
+		((= i 30) (* 36 pi2))
+	      (set! pi2 (+ pi2 (/ (vector-ref ais (modulo (- i 1) 6))
+				  (* two i i))))))
+	  (* pi pi))
+
+(num-test (let ((log2 0.0)
+		(ais (vector 2 -10 -7 -10 2 -1)))
+	    (do ((i 1 (+ i 1))
+		 (two 2 (* two 2)))
+		((= i 30) (* 2 log2))
+	      (set! log2 (+ log2 (/ (vector-ref ais (modulo (- i 1) 6))
+				    (* two i i))))))
+	  (* (log 2) (log 2)))
+
+(unless (or with-bignums (not (provided? 'overflow-checks)))
+  (num-test (+ 1/9223372036854775807 1/9223372036854775806) 2.168404344971e-19)
+  (num-test (+ 1/98947 2/97499 3/76847 4/61981 5/59981 6/66601) 0.00030764243484887)
+  (num-test (+ 1/98947 2/97499 3/76847 4/61981 5/59981) 0.00021755369744252)
+  (num-test (+ 1/98947 2/97499 3/76847 4/61981) 0.00013419396686117)
+  (num-test (+ 500009/500029 500057/500041 500083/500069) 3.00001999583261)
+  (num-test (+ 98947 2/97499 76847 4/61981 5/59981) 175794.00016841))
+
+;;; this test was bogus:
+(when with-bignums
+  (test (< (abs (- (do ((x0 11/2)
+			(x1 61/11)
+			(i 0 (+ i 1)))
+		       ((= i 100) x1)
+		     (let ((tmp x1))
+		       (set! x1 (- 111 (/ (- 1130 (/ 3000 x0)) x1)))
+		       (set! x0 tmp)))
+                      6)) ; was 100 because float precision not high enough!
+	     .00001)
+	  #t)
+  (let-temporarily (((*s7* 'bignum-precision) 1024))
+  (test (< (abs (- (do ((x0 (bignum (* 1.0 11/2)))
+			(x1 61/11)
+			(i 0 (+ i 1)))
+		       ((= i 100) x1)
+		     (let ((tmp x1))
+		       (set! x1 (- 111 (/ (- 1130 (/ 3000 x0)) x1)))
+		       (set! x0 tmp)))
+                      6)) ; was 100 because float precision not high enough!
+	     .00001)
+	  #t)))
+
+;; in floats this heads for 100:
+;;   (do ((x0 (exact->inexact 11/2)) (x1 (exact->inexact 61/11)) (i 0 (+ i 1))) ((= i 100) x1) (let ((tmp x1)) (set! x1 (- 111 (/ (- 1130 (/ 3000 x0)) x1))) (set! x0 tmp)))
+;; but in fact if 2048 (or > 256 probably) bits of precision, floats go to 6 just as with big ratios!
+
+(when with-bignums
+  (num-test (+ 9223372036854775807 .1) 9.2233720368547758071E18)
+  (num-test (+ .1 9223372036854775807) 9.2233720368547758071E18)
+  (num-test (+ 8796093022208 1855077841/1311738121) 11538170533094188269009/1311738121)
+  (num-test (+ 8796093022208 (bignum 1855077841/1311738121)) (bignum 11538170533094188269009/1311738121))
+  (num-test (+ 0.999999995 8388608) 8388608.999999995)
+  (num-test (+ (+ 1.0e-30 1.0e30) -1.0e30) (+ 1.0e-30 (+ 1.0e30 -1.0e30)))
+  (num-test (+ 11111111111111113.0 (+ -11111111111111111.0 7.5111111111111)) (+ (+ 11111111111111113.0 -11111111111111111.0) 7.5111111111111))
+  (num-test (+ -1000000000 -1000000000 -1000000000) -3000000000)
+  (num-test (+ -8589934591 -4611686018427387904) -4611686027017322495)
+  (num-test (+ -8589934591 4611686018427387904) 4611686009837453313)
+  (num-test (+ -9223372036854775807 -1) -9223372036854775808)
+  (num-test (+ -9223372036854775807 1) -9223372036854775806)
+  (num-test (+ -9223372036854775808 -9223372036854775808) -18446744073709551616)
+  (num-test (+ 1 1/2 0+9223372036854775808.0i 0-i) 1.5+9.223372036854775807E18i)
+  (num-test (+ 1 1/2 9223372036854775808.0 0+i) 9.2233720368547758095E18+1.0i)
+  (num-test (+ 1 1/2 9223372036854775808.0 0-i) 9.2233720368547758095E18-1.0i)
+  (num-test (+ 1 1/2 9223372036854775808.0) 9.2233720368547758095E18)
+  (num-test (+ 1.0 12345678901234567890) 1.2345678901234567891E19)
+  (num-test (+ 1.0e80+i 1.0e80+i) 2.0e80+2.0i)
+  (num-test (+ 1.0e80+i 1.0e80-i) 2.0e80)
+  (num-test (+ 1.5 9223372036854775808.0) 9.2233720368547758095E18)
+  (num-test (+ 1/1231234567891234567891 1/4) 1231234567891234567895/4924938271564938271564)
+  (num-test (+ 1/2147483648 1/2147483647) 4294967295/4611686016279904256)
+  (num-test (+ 1/3 (* 13835058055282163710 2/3)) 9223372036854775807) ; would be nice if this worked...
+  (num-test (+ 1/65537 -1/65536) -1/4295032832)
+  (num-test (+ 1/65537 -1/65538) 1/4295163906)
+  (num-test (+ 1/65537 1/65536) 131073/4295032832)
+  (num-test (+ 1/65537 1/65538) 131075/4295163906)
+  (num-test (+ 1/9223372036854775807 1/9223372036854775806) 18446744073709551613/85070591730234615838173535747377725442)
+  (num-test (+ 1/98947 2/97499 3/76847 4/61981 5/59981 6/66601) 56471455498794722585779775/183561983334767209753061626751)
+  (num-test (+ 1/98947 2/97499 3/76847 4/61981 5/59981) 599609438061905323469/2756144552405627689570151)
+  (num-test (+ 10 9223372036854775800) 9223372036854775810)
+  (num-test (+ 1000000000 1000000000 1000000000) 3000000000)
+  (num-test (+ 1073741825 1073741825) 2147483650)
+  (num-test (+ 1099511627775 9223372036854775807) 9223373136366403582)
+  (num-test (+ 1180591620717411303424+i 1+1180591620717411303424i) 1.180591620717411303425E21+1.180591620717411303425E21i)
+  (num-test (+ 1180591620717411303424.0+i 1+1180591620717411303424.0i) 1.180591620717411303425E21+1.180591620717411303425E21i)
+  (num-test (+ 12345678901234567890+12345678901234567890i 12345678901234567890-12345678901234567890i) 2.469135780246913578E19)
+  (num-test (+ 132120577/12 33292289/6 260046847/4) 244711424/3)
+  (num-test (+ 18446744082299486212 1) 18446744082299486213)
+  (num-test (+ 1e400 1e399) 1.1e400)
+  (num-test (+ 2147483647 1) 2147483648)
+  (num-test (+ 2147483647 2) 2147483649)
+  (num-test (+ 2147483647 4611686018427387904) 4611686020574871551)
+  (num-test (+ 2147483648 -1) 2147483647)
+  (num-test (+ 2147483648 -2) 2147483646)
+  (num-test (+ 2147483648 1) 2147483649)
+  (num-test (+ 2147483648 4611686018427387904) 4611686020574871552)
+  (num-test (+ 2147483648) 2147483648)
+  (num-test (+ 2147483649 -1) 2147483648)
+  (num-test (+ 2147483649 -4611686018427387904 -2147483649 4611686018427387904) 0)
+  (num-test (+ 2147483649 4611686018427387904 2147483649 4611686018427387904) 9223372041149743106)
+  (num-test (+ 2147483649 4611686018427387904) 4611686020574871553)
+  (num-test (+ 3 9223372036854775807/4) 9223372036854775819/4)
+  (num-test (+ 3 9223372036854775808/4) 2305843009213693955)
+  (num-test (+ 3/2 9223372036854775808.0) 9.2233720368547758095E18)
+  (num-test (+ 3/4 9223372036854775807/4) 4611686018427387905/2)
+  (num-test (+ 3/4 9223372036854775808) 36893488147419103235/4)
+  (num-test (+ 4611686018427387904 -1) 4611686018427387903)
+  (num-test (+ 4611686018427387904 -4611686018427387904) 0)
+  (num-test (+ 4611686018427387904 1) 4611686018427387905) ; (expt 2 62) + 1 -- should work in both cases
+  (num-test (+ 4611686018427387904 4611686018427387904) 9223372036854775808)
+  (num-test (+ 4611686018427387904 4611686018427387906) 9223372036854775810)
+  (num-test (+ 500009/500029 500057/500041 500083/500069) 375106759202738205/125034753009582041)
+  (num-test (+ 8589934591 -4611686018427387904) -4611686009837453313)
+  (num-test (+ 8589934591 4611686018427387904) 4611686027017322495)
+  (num-test (+ 8589934592 4611686018427387904) 4611686027017322496)
+  (num-test (+ 9223372036854775800 10) 9223372036854775810)
+  (num-test (+ 9223372036854775807 -1) 9223372036854775806)
+  (num-test (+ 9223372036854775807 1) 9223372036854775808)
+  (num-test (+ 9223372036854775807 2) 9223372036854775809)
+  (num-test (+ 9223372036854775807 9223372036854775807) 18446744073709551614)
+  (num-test (+ 9223372036854775807/4 3) 9223372036854775819/4)
+  (num-test (+ 9223372036854775807/4 3/4 4611686018427387905/2) 4611686018427387905)
+  (num-test (+ 9223372036854775807/4 3/4) 4611686018427387905/2)
+  (num-test (+ 9223372036854775807/4 4611686018427387905/3) 46116860184273879041/12)
+  (num-test (+ 9223372036854775808 -1) 9223372036854775807)
+  (num-test (+ 9223372036854775808 -2) 9223372036854775806)
+  (num-test (+ 9223372036854775808 1) 9223372036854775809)
+  (num-test (+ 9223372036854775808 3/4) 36893488147419103235/4)
+  (num-test (+ 9223372036854775808.0 3.4) 9.2233720368547758114E18)
+  (num-test (+ 9223372036854775808.0+1.5i 3.4) 9.2233720368547758114E18+1.5i)
+  (num-test (+ 9223372036854775808/4 3) 2305843009213693955)
+  (num-test (+ 9223372036854775808/9223372036854775808) 1)
+  (num-test (+ 9223372036854775809 -1) 9223372036854775808)
+  (num-test (+ 9223372041149743106 -9223372041149743106) 0)
+  (num-test (+ 9223372041149743106 9223372041149743106) 18446744082299486212)
+  (num-test (+ 98947 2/97499 76847 4/61981 5/59981) 63720106179329487759/362470312515139)
+
+  (num-test (+ 576460752303423488 576460752303423488 576460752303423488 576460752303423488
+	       576460752303423488 576460752303423488 576460752303423488 576460752303423488
+	       576460752303423488 576460752303423488 576460752303423488 576460752303423488
+	       576460752303423488 576460752303423488 576460752303423488 576460752303423488)
+	    9223372036854775808)
+  (num-test (+ -576460752303423488 -576460752303423488 -576460752303423488 -576460752303423488
+	       -576460752303423488 -576460752303423488 -576460752303423488 -576460752303423488
+	       -576460752303423488 -576460752303423488 -576460752303423488 -576460752303423488
+	       -576460752303423488 -576460752303423488 -576460752303423488 -576460752303423488)
+	    -9223372036854775808) ; this fits in both cases = -(expt 2 63)
+
+  (num-test (+ 12766/44484 39852/43605 31122/19043 51508/63811 36845/41288 28101/14083 56682/37410 47892/22120 39412/22980 60124/55166 42856/59693) 208780620213964670464533749059169842219977/15202497819117370814835285951563379420520)
+  (num-test (+ 63216/39382 57676/45091 53354/2630 1048/39076 16116/23210 42095/55806 27474/26658 50811/59328) 191349291372060004326881331664759/7211602793633848370218614932160)
+  (num-test (+ 59885/27233 26245/45891 40482/5828 51990/36443 9623/46196) 34799310234648621493801/3065498111736131980788)
+  (num-test (+ 37870/11132 60558/48391 53644/64989 60943/2780 9073/15664 15430/61388 55088/37713) 49618689694342545850764990997/1671112820517946923490092720)
+  (num-test (+ 37890/11488 45896/14037 3589/36071 22835/41473 42331/17823 42800/56681) 420312190408065989902262231/40617147626636993628447504)
+  (num-test (+ 26660/49395 52605/23369 30235/15203 37926/38348 54028/49472 32407/12923 20689/1984 27919/46263) 69930317632493223450434305725419/3428000885137780298513956804672)
+  (num-test (+ 56351/21775 14958/21250 13859/32508 24968/65124 885/6861 3913/38588 90/55711 12269/37075 6579/33653) 201796703852921650643001395969752/41522567198031666874435508825625)
+  (num-test (+ 8582/48034 27069/11031 29676/5507 56684/32514 25699/47391 44069/2704 18193/3289) 5684819414248430672302049/176897854654356635413328)
+  (num-test (+ 421240/871225 1021193/39462 252094/592111 2478/11660) 32043461749854904862/1186809749708031735)
+  (num-test (+ 149278/597089 747410/315908 218673/956214 174632/245649 45750/515909) 165277142441527691870266634/45353662154623612097256297)
+  (num-test (+ 361087/1038423 629417/722796 693707/392139 237025/961767 88560/187279) 2426130069686588061565863289/654491499930590555724694236)
+  (num-test (+ 94466/1038229 807503/592385 802950/953585 954630/176875) 6384533383241957925411/829875721759976907875)
+  (num-test (+ 913461/774815 817965/788155 237677/532117 542827/225728 343160/431483) 2183257313717880748058258989/372346251755101707126455360)
+  (num-test (+ 888429/600657 680124/108845 265059/727366 395224/748135) 20445657641208104518701/2371792747070499020510)
+  (num-test (+ 37622/1698 9183/57409 12127/36899 11451/26597 64339/35514) 14092685195493114237067/566256574856769105474)
+  (num-test (+ 24122/8583 41997/57541 42760/57555 40699/12923 30325/37640) 1518749441232333398909/184353450944764326984)
+  (num-test (+ 16104/12728 32020/64625 35345/37481 29241/50823 13216/61075 11245/2022) 751811438787510154499/83010789184720173150)
+  (num-test (+ 4312/48465 44171/56694 8599/3231 46048/62568 2132/45901 24407/26161) 455702434782048082459/86885567283849955830)
+  (num-test (+ 59496/7030 37058/2679 2158/41193 48873/59329 52768/30853 34749/39139) 339576145632874325598832/13177075606485410552535)
+  (num-test (+ 131/58542 41136/2572 43951/20070 63439/14560 33259/63731 10981/51495 49078/63698 10727/32805 29362/30842) 51962727546984124809096307414129847/2051626916225689647807786049306080)
+  (num-test (+ 16640/40785 56062/38132 43843/29406 5867/50944 19248/58540) 1083456041462784832133/284138789764221200640)
+  (num-test (+ 34314/54910 54195/13905 32762/15225 20808/42764 20977/59771 26320/20306 53116/23035 30385/31200 57396/3367 58378/6806 5724/29599) 39875514688522166158239445824103603/1051980164901898842922034228906400)
+  (num-test (+ 40391/35273 27957/29448 52381/18500 60009/3366 27528/2124 62426/65445 43110/25891 40183/26944 30274/1504 27638/40611) 15253761502587455936752727098716743/251570544261187774378167518568000)
+  (num-test (+ 52269/62857 21518/38958 29849/9192 27730/2604 20427/36068) 116322789710447328047/7340588373519969288)
+  (num-test (+ 17009115185923538769 -12047631083067675031) 4961484102855863738)
+  (num-test (+ 12677011568664239747 3269056182420253574) 15946067751084493321)
+  (num-test (+ 9315504781982082433 13857624532376678678) 23173129314358761111)
+  (num-test (+ 15226508728194069537 11481952022080775416) 26708460750274844953)
+  (num-test (+ 7461641943684774743 12249026721402718630) 19710668665087493373)
+  (num-test (+ 1180469445886971055 -3208456171287181032) -2027986725400209977)
+  (num-test (+ 18358552990465743315 221529797579218180385160273426219343697) 221529797579218180403518826416685087012)
+  (num-test (+ -14819874956616484359 30498815629431206969122152847973230849) 30498815629431206954302277891356746490)
+  (num-test (+ -11781881800334342169 112219460388643619332860331282276228017) 112219460388643619321078449481941885848)
+  (num-test (+ 3570694277032201957 284821691832196381859344006870088122712) 284821691832196381862914701147120324669)
+  (num-test (+ -17005463295060938595 69162171850264911722979835561124066203) 69162171850264911705974372266063127608)
+  (num-test (+ 15647113311796203488 150750467185419235519670165664526735459) 150750467185419235535317278976322938947)
+  (num-test (+ -14330150541101371097 -13054027994001826312503071338715966858478218093171762021549815587520723118772963817341751396703629529810372702877555022105594068768886421335353882155416908) -13054027994001826312503071338715966858478218093171762021549815587520723118772963817341751396703629529810372702877555022105594068768886435665504423256788005)
+  (num-test (+ 7406427184711759740 -4059250217961011548005203450962458026528281798230141192186669580689721046971433745892994467792118611646113962840750314719233572760336084100766391093756252) -4059250217961011548005203450962458026528281798230141192186669580689721046971433745892994467792118611646113962840750314719233572760336076694339206381996512)
+  (num-test (+ 8819522415901031498 7274905269237471130619913887005155660991437201841760414347836177003483932007334374478344594178179032728521106519295465031750530183363793325150672647162846) 7274905269237471130619913887005155660991437201841760414347836177003483932007334374478344594178179032728521106519295465031750530183363802144673088548194344)
+  (num-test (+ -7242932332215698200 -10558564312909325527488520195600871241245891651644550509993750377630234801225525279855157008009255586978047154906058790342845859331159009687703010657137320) -10558564312909325527488520195600871241245891651644550509993750377630234801225525279855157008009255586978047154906058790342845859331159016930635342872835520)
+  (num-test (+ 9794320575955609492 13380937715397052566925484435342184213544885758759259410983243841206628594840271850190097746775475837233042430565529099681550277688470325394342993771343357) 13380937715397052566925484435342184213544885758759259410983243841206628594840271850190097746775475837233042430565529099681550277688470335188663569726952849)
+  (num-test (+ -18404048401680891243 6690884608978704096379677348142836785900717005050936986370615083929607190833180925295418079551348559691161519822750772440155040888224482801864925665484770) 6690884608978704096379677348142836785900717005050936986370615083929607190833180925295418079551348559691161519822750772440155040888224464397816523984593527)
+  (num-test (+ -10763220363947284865 -30985722824355332972176356513316569304601382411274079243859710673739383446566598659878378034375348869471278415635671865753349734809209959160389615096293457362383744562507969316522225741589739150453090393424063226271167062127000223628785686999799282795143706407082119829140399988180879618548495395684946331608899565543458192773899200054228140747414544792128323269250618482622488195333106891323515989863192944848391405358725993695671970811097285270641251816244586360288952156538400321933146150313939864593445583603568771077260174826348411367609521412133720180359748539721570562669201065857989876521301209899829037444385) -30985722824355332972176356513316569304601382411274079243859710673739383446566598659878378034375348869471278415635671865753349734809209959160389615096293457362383744562507969316522225741589739150453090393424063226271167062127000223628785686999799282795143706407082119829140399988180879618548495395684946331608899565543458192773899200054228140747414544792128323269250618482622488195333106891323515989863192944848391405358725993695671970811097285270641251816244586360288952156538400321933146150313939864593445583603568771077260174826348411367609521412133720180359748539721570562669201065857989876521311973120192984729250)
+  (num-test (+ -12742462236537568498 8711131313747826394504271797986775572294949693272674156076339989631171694968899228610359983845552623710580616605402899155485071497929100432998183040757832449369366844015907530612334721882095163137705867337969942902346066961718232788529860214990099385213558935023241940238638069647809530490438245386869385682221280939688108487754251075630026707075310465788398213293782900699868609660892232563106662995330591906155134237356516622436517046191466823447743155250482328613449506396571170001248589926831956459700467126756876526930443317428628239358666456771112897986098390410773312792390699312960051747534683311506465130527) 8711131313747826394504271797986775572294949693272674156076339989631171694968899228610359983845552623710580616605402899155485071497929100432998183040757832449369366844015907530612334721882095163137705867337969942902346066961718232788529860214990099385213558935023241940238638069647809530490438245386869385682221280939688108487754251075630026707075310465788398213293782900699868609660892232563106662995330591906155134237356516622436517046191466823447743155250482328613449506396571170001248589926831956459700467126756876526930443317428628239358666456771112897986098390410773312792390699312960051747521940849269927562029)
+  (num-test (+ 9991390529516174614 7879872958436992955898278403297937595295396115022400543178444946646147916754852888072481665174663073269556311758611700754643170639645548596647557683044355930340624784190093631808382820554407595007761070026239341594197877214157118335743842022627898879376346092898666610367809537340994845045475091410516226225078052019727419030585524815982151736622865401299588936172760762386183577504972623377661437665668080131418564228642443266935225613702941906491478788336262289516199380144218708241406077806669686589734333554945412904560108150202389909124657090061223183441083590340175629756198442568877659538345749595968764873879) 7879872958436992955898278403297937595295396115022400543178444946646147916754852888072481665174663073269556311758611700754643170639645548596647557683044355930340624784190093631808382820554407595007761070026239341594197877214157118335743842022627898879376346092898666610367809537340994845045475091410516226225078052019727419030585524815982151736622865401299588936172760762386183577504972623377661437665668080131418564228642443266935225613702941906491478788336262289516199380144218708241406077806669686589734333554945412904560108150202389909124657090061223183441083590340175629756198442568877659538355740986498281048493)
+  (num-test (+ 831234034418847630 -744676478858160349467117341859049692149463503380690495147216354303526704924280287782902146026018180364963325847811379182950159627878800024734206345960410146056000392683000433501805629464626281031086102425271022388473812300724085127447081771317912465921636737545371909901577246384446144919253141375367648958387948463576516115079816552636772639965957498569187848459747361493535081532845254971492261148968198806736512864867151355002902241562014241077734122599581732704243705918200179789271894804233542502502119523149682814025979598424744685548054183678652651244898867735764030968089217841214778606507809487462642341164) -744676478858160349467117341859049692149463503380690495147216354303526704924280287782902146026018180364963325847811379182950159627878800024734206345960410146056000392683000433501805629464626281031086102425271022388473812300724085127447081771317912465921636737545371909901577246384446144919253141375367648958387948463576516115079816552636772639965957498569187848459747361493535081532845254971492261148968198806736512864867151355002902241562014241077734122599581732704243705918200179789271894804233542502502119523149682814025979598424744685548054183678652651244898867735764030968089217841214778606506978253428223493534)
+  (num-test (+ -6996572501442843347 -16567158719848992553565776505785820491834685475229611199353714982570065913508303466008005931649515528390057456882757990896824841386431756898386429000065518724021230756426613661219891419166146764347562529640689229693578574350948436847247856000438153789455857903402883189892697143647998643667467614427922009931545254965075041050860609824086811877108940020349157317276288348430058535959434983921323332907180869396258655826781438419383792024592535415693101119109484610789291889841197827977530804650015884500878613240443324806805475203272442094530735476095374446946252236490708915034012846683015547314889561060687692538144) -16567158719848992553565776505785820491834685475229611199353714982570065913508303466008005931649515528390057456882757990896824841386431756898386429000065518724021230756426613661219891419166146764347562529640689229693578574350948436847247856000438153789455857903402883189892697143647998643667467614427922009931545254965075041050860609824086811877108940020349157317276288348430058535959434983921323332907180869396258655826781438419383792024592535415693101119109484610789291889841197827977530804650015884500878613240443324806805475203272442094530735476095374446946252236490708915034012846683015547314896557633189135381491)
+  (num-test (+ -8920936222630165483 -18738991973681679876688842391791783563249057933653045519186959571392922172943405646958686202208790537612746921398028331540617848217445632123805070077600768524509025758950743971128222843292926773668584735575066246660802064630842300367821042873152766467703905048558085377302000898639290554395913805527529259855535801856020623830262396582180677933562523957295341539162448074423901242873918231922121053192425691524797238343327318801359521456598967984637483081312932069399045363737622797213185099130529375169698811801965974416555301085043300426947769193582129151016159057101028336667142913854943018973494705119572045938607) -18738991973681679876688842391791783563249057933653045519186959571392922172943405646958686202208790537612746921398028331540617848217445632123805070077600768524509025758950743971128222843292926773668584735575066246660802064630842300367821042873152766467703905048558085377302000898639290554395913805527529259855535801856020623830262396582180677933562523957295341539162448074423901242873918231922121053192425691524797238343327318801359521456598967984637483081312932069399045363737622797213185099130529375169698811801965974416555301085043300426947769193582129151016159057101028336667142913854943018973503626055794676104090)
+  (num-test (+ -243510292488206214847646757340020705642 5940577100149745132) -243510292488206214841706180239870960510)
+  (num-test (+ 35446324064743728955945058978206455057 -6248622708755929572) 35446324064743728949696436269450525485)
+  (num-test (+ -285342226760657637664173494795024413673 -11942737781617905307) -285342226760657637676116232576642318980)
+  (num-test (+ 180790435817422032042321866247362452865 12401641959336396832) 180790435817422032054723508206698849697)
+  (num-test (+ -179994871947239535956826388240542999950 13573822506399140772) -179994871947239535943252565734143859178)
+  (num-test (+ -308198027295905163635866438671452347268 -8790069282378476990) -308198027295905163644656507953830824258)
+  (num-test (+ -139324757925833055762410227358605285566 -190622873846936719063564661032771271922) -329947631772769774825974888391376557488)
+  (num-test (+ 332866352618304570046318203427223999347 147978646177673305481282943528696833018) 480844998795977875527601146955920832365)
+  (num-test (+ -39471620476300923970352914034802271156 28992893610776120142668950821916856486) -10478726865524803827683963212885414670)
+  (num-test (+ 274120253734611965146455315763505869288 254675910805265090692978775702306142625) 528796164539877055839434091465812011913)
+  (num-test (+ -122086811464559635596206661886176775901 287312583034687582188356355813963609701) 165225771570127946592149693927786833800)
+  (num-test (+ 288576174771266329955482943556556984728 -57843540651903655425270706396868707777) 230732634119362674530212237159688276951)
+  (num-test (+ -47977736580820486006305788441965482221 984809271313988066640898939725532304075331399066274624928410251834520283291912387208948664716457549646483445981126881113426109906085249657168046936670489) 984809271313988066640898939725532304075331399066274624928410251834520283291912387208948664716457549646483445981126833135689529085599243351379604971188268)
+  (num-test (+ 21225484205143479814642328762121362291 11839789093732539327981861490012713257538550745921177905266671749716203131127256902110452504526721633943016923389974867770082516862899595554460170417713940) 11839789093732539327981861490012713257538550745921177905266671749716203131127256902110452504526721633943016923389974888995566722006379410196788932539076231)
+  (num-test (+ -193095363331703875886398909106293703000 4389392021031719669078675478621418677903292147307684123866099084349756491860737402449105804868232530632178577388168068485304437343508442251302846768269976) 4389392021031719669078675478621418677903292147307684123866099084349756491860737402449105804868232530632178577388167875389941105639632555852393740474566976)
+  (num-test (+ -14827657635864183514988182371035598180 -7256545787852407071411458891023580461638051949278710509801472046178301830006724297747051044450550248499056073213660185258676369175307019300952192657194576) -7256545787852407071411458891023580461638051949278710509801472046178301830006724297747051044450550248499056073213660200086334005039490534289134563692792756)
+  (num-test (+ 54301423175725658626298504084995819705 -13385853291610595576947504757201441006088030688464261540642594993520424631577281077984278942244446266776534612440941312995898184903431893212829646845766101) -13385853291610595576947504757201441006088030688464261540642594993520424631577281077984278942244446266776534612440941258694475009177773266914325561849946396)
+  (num-test (+ 195114404067053480147948948510253723990 -8373866462448797623435948949281383906369538962237624940506813188612614128993186653340202956656303504523161255703176374041758276069255591562198514767063594) -8373866462448797623435948949281383906369538962237624940506813188612614128993186653340202956656303504523161255703176178927354209015775443613250004513339604)
+  (num-test (+ -308030589512186791277525017840002670741 -11922204352024596469278978325035646517433105521287613403902396944414655739824695945028308092245747333098422116078042326104667969967224788442970266049942774583538734406057081597034454910987815490244451193242377705191422489528853976486607580169986057592557285271953385769215318545520155212402919465580052078255078759756709086185424029620805084776442744700501748376290562843380642608395240491162047933014854466267084965223593172702334466729933986413870670083326499598274393380692146118979961818816348097032083332695128587696590646086980241100792624502607816103195636761141133903550454815591457829485684936036414823492160) -11922204352024596469278978325035646517433105521287613403902396944414655739824695945028308092245747333098422116078042326104667969967224788442970266049942774583538734406057081597034454910987815490244451193242377705191422489528853976486607580169986057592557285271953385769215318545520155212402919465580052078255078759756709086185424029620805084776442744700501748376290562843380642608395240491162047933014854466267084965223593172702334466729933986413870670083326499598274393380692146118979961818816348097032083332695128587696590646086980241100792624502607816103195636761141133903550762846180970016276962461054254826162901)
+  (num-test (+ -172649878347923210775992373331623646864 22180935775581457002090790736532281654456312526625354262953960635330604551829750571440878712430708012807252279301365732385899228826740712544768476577874129759972563823209525283326887563301081200476495752033290851190327066070873711444930389093339915885090143783170994309089448293499799071372787520776773788274677288230540162485916160484352398851925328125588729604931589867889917097887951581817207079060016091919559509735997493084833476849835444339835031436580214492450731100723026312163752403946315983551266206214298679421644737804098691991631489261658890937663698502561036246447760919715595005106669653475931803053499) 22180935775581457002090790736532281654456312526625354262953960635330604551829750571440878712430708012807252279301365732385899228826740712544768476577874129759972563823209525283326887563301081200476495752033290851190327066070873711444930389093339915885090143783170994309089448293499799071372787520776773788274677288230540162485916160484352398851925328125588729604931589867889917097887951581817207079060016091919559509735997493084833476849835444339835031436580214492450731100723026312163752403946315983551266206214298679421644737804098691991631489261658890937663698502561036246447588269837247081895893661102600179406635)
+  (num-test (+ 17539006966816771902104329685391462527 15609797782337099611892065465036826453911053690739041627254619195700021040383385710184052653282070244915503750549545390475671883312314708978681904377133928647935359080875691628246716591529028104762422990155477702994042953196747769893182153631482194578269859879402160062955490194674372351117284129320011166238130774752386987036267064693133554447596069886693581191241594745541512444806003236372840085705813835001957163976961730871756250344335996073970142337882238844723800849054637237549515249957267772181010402413375667537558243971058326641257721901094391380667244006959028327507917720426571969997513984360849930719808) 15609797782337099611892065465036826453911053690739041627254619195700021040383385710184052653282070244915503750549545390475671883312314708978681904377133928647935359080875691628246716591529028104762422990155477702994042953196747769893182153631482194578269859879402160062955490194674372351117284129320011166238130774752386987036267064693133554447596069886693581191241594745541512444806003236372840085705813835001957163976961730871756250344335996073970142337882238844723800849054637237549515249957267772181010402413375667537558243971058326641257721901094391380667244006959028327507935259433538786769416088690535322182335)
+  (num-test (+ 244901855797156286376563377540855746602 -22138106346578776369849317622304392466030036563754663379976505966920461958652141160336156065177498990718609170201272980114106671808245437660234479124938853665375934080221740523696180221118540569603989748587853373569525751680828044059607889572522502629277877343410298879764820905044284757389006201848194571453112545228115550224254565141563427486518108434758694923122284117299374156393942906293546318323661938734959824887786185558612820887463537294120950912969343488704744978847504513710882720654330147775174336365363311173472002077960424794151168301281665765411704505095008907760396535767621855642720080219960822554492) -22138106346578776369849317622304392466030036563754663379976505966920461958652141160336156065177498990718609170201272980114106671808245437660234479124938853665375934080221740523696180221118540569603989748587853373569525751680828044059607889572522502629277877343410298879764820905044284757389006201848194571453112545228115550224254565141563427486518108434758694923122284117299374156393942906293546318323661938734959824887786185558612820887463537294120950912969343488704744978847504513710882720654330147775174336365363311173472002077960424794151168301281665765411704505095008907760151633911824699356343516842419966807890)
+  (num-test (+ -119403662992279138748600939857239307122 26272999248235953724172008428088697264933069743507017434844709711501131900922919455931092196539942532993887162365511473221418376205773427597933886270411672062672089518774390132453916538404354895529975888201032175628249480896964400801763570333497287321002961557096975786141940970260074557095118887294558700145949117395512768347250531196100831164663613049206690894640391431616112104502483838173255614981302462548882276825096564828583591963617871547373532874400764134244496979962241959713525053686209002866840900623246072884125102845824992994967009109046451949348656842486048332953732384499190437432898387573320391878853) 26272999248235953724172008428088697264933069743507017434844709711501131900922919455931092196539942532993887162365511473221418376205773427597933886270411672062672089518774390132453916538404354895529975888201032175628249480896964400801763570333497287321002961557096975786141940970260074557095118887294558700145949117395512768347250531196100831164663613049206690894640391431616112104502483838173255614981302462548882276825096564828583591963617871547373532874400764134244496979962241959713525053686209002866840900623246072884125102845824992994967009109046451949348656842486048332953612980836198158294149786633463152571731)
+  (num-test (+ 313963939617834410089002930298454269912 23286645405607099799151331553995799851855144387826191186590140820016670502830395945076644578998873585162998873396623634135231418574284200209367505115739462344028303923666952261030907434438322884189133236837089851688275865098623902644385995630973049587854251981548128145516004461191094062488421288607625783540996659060285661398859383778209495884203323937672739376151794507745282074538961033778823733980759695886879886017489555795079194346438911010371103435094677167286870898482214310646392174423422237727456012197253183422715313378603607058548706460095379882633958651034759773864354021315490712575535559549015858088608) 23286645405607099799151331553995799851855144387826191186590140820016670502830395945076644578998873585162998873396623634135231418574284200209367505115739462344028303923666952261030907434438322884189133236837089851688275865098623902644385995630973049587854251981548128145516004461191094062488421288607625783540996659060285661398859383778209495884203323937672739376151794507745282074538961033778823733980759695886879886017489555795079194346438911010371103435094677167286870898482214310646392174423422237727456012197253183422715313378603607058548706460095379882633958651034759773864667985255108546985624562479314312358520)
+  (num-test (+ 2000877973959266893810594143560134441447453310844726478119781029700338468704683515329516333146806175216349912753585564808803731447160643580198590073658869 -17993015014355471903) 2000877973959266893810594143560134441447453310844726478119781029700338468704683515329516333146806175216349912753585564808803731447160625587183575718186966)
+  (num-test (+ 5492930533666246223206322654398877802091439062008700770880939594548305919677404080859141226095489505872709347538974725998600861651942609010590873980143878 15372278140141207703) 5492930533666246223206322654398877802091439062008700770880939594548305919677404080859141226095489505872709347538974725998600861651942624382869014121351581)
+  (num-test (+ -13405500833215428652808705089190188280715732437731292502890523313631564795139560159124390691283401484515088713758307366404145018349044148223082253439210893 -14793401891248640808) -13405500833215428652808705089190188280715732437731292502890523313631564795139560159124390691283401484515088713758307366404145018349044163016484144687851701)
+  (num-test (+ 9945195259699924701593703207751086973468898794114625092150620088406276196469184233537941913755508476427888065765634203723512911676149274871082481174186606 8699133332160461067) 9945195259699924701593703207751086973468898794114625092150620088406276196469184233537941913755508476427888065765634203723512911676149283570215813334647673)
+  (num-test (+ -1785165974800693006461065312083337532938610906605533088558498259067461510781028452552786542598361030690629530721209490413999022804146471920873844686294838 -13079925952361275418) -1785165974800693006461065312083337532938610906605533088558498259067461510781028452552786542598361030690629530721209490413999022804146485000799797047570256)
+  (num-test (+ -4861207515430071951958387366611380234482792653010151054346367776006873932152600469133110239669746470475230906073865131648496652783311445471793936775767736 -9381557743227419896) -4861207515430071951958387366611380234482792653010151054346367776006873932152600469133110239669746470475230906073865131648496652783311454853351680003187632)
+  (num-test (+ -6638723469626495957966112633999375479181736600737250559572415894485618850919815869703127084789143821420728194272094956858541960962483734293877093635361160 277811698220276334443479876776376776138) -6638723469626495957966112633999375479181736600737250559572415894485618850919815869703127084789143821420728194272094679046843740686149290814000317258585022)
+  (num-test (+ 1983880417172931934469534542170437296262471214582817006917470485544552211448284732460451903536334682269123998240709059499894818265755197559390728940140016 -118940994129137705779355371753506018694) 1983880417172931934469534542170437296262471214582817006917470485544552211448284732460451903536334682269123998240708940558900689128049418204018975434121322)
+  (num-test (+ -9354509264984586574958285335910611806441061705184818350015454221731287473282231343722010109181841005578131927454778025302197744540571159656556971614966757 120224841184491944160266976391113485817) -9354509264984586574958285335910611806441061705184818350015454221731287473282231343722010109181841005578131927454777905077356560048626999389580580501480940)
+  (num-test (+ 4389359421234641412950681847970318834150108533025088077429496538447029921663033978550089607257809597829358374972237448178553189381274150213236222139873594 106674783386899772113212633712093787897) 4389359421234641412950681847970318834150108533025088077429496538447029921663033978550089607257809597829358374972237554853336576281046263425869934233661491)
+  (num-test (+ -9319417879153488839579936799737117639058244394679644240663244688680826325564084529474537634510092069422987165268448907193562300482925125162731530249763801 192969103435503875767216559494769734726) -9319417879153488839579936799737117639058244394679644240663244688680826325564084529474537634510092069422987165268448714224458864979049357946172035480029075)
+  (num-test (+ 1394404616168163951844558734723678125985464491792846741433683801962971891047718103736551854371207400145441134823994228143957746922511631911996296931168332 -211230038021470285136061932161632203274) 1394404616168163951844558734723678125985464491792846741433683801962971891047718103736551854371207400145441134823994016913919725452226495850064135298965058)
+  (num-test (+ -2935941510094051560788359387128767361559188973149773593522440619832472030019457317998381634585179453958737810428870232715146002408187749944694186205812791 -1221176156661231926164756142840452419679061324806989304452215660535991083923207702827717652226257158321829748247784282139952864899457896871473184473608543) -4157117666755283486953115529969219781238250297956762897974656280368463113942665020826099286811436612280567558676654514855098867307645646816167370679421334)
+  (num-test (+ -1338674579024795395027232680327531457830908239605718353094975139226848400289367913459076082700361212506196070727982446232782659114647371030398516119682505 -1298372177520411182435886041880377054374169787570856408996533471838082317927648953576721017727347029007573543972764860712708420553928791798580799809858729) -2637046756545206577463118722207908512205078027176574762091508611064930718217016867035797100427708241513769614700747306945491079668576162828979315929541234)
+  (num-test (+ -2072456075229532951804023218627137969798924912365258263779029006567941400203608770518731715660383378937120213112973528605594220795605977413985543331908189 -9744489461776287963808523409593616918248399004543154581056479712028497082820841423941781438667661074968238703192056877665754560746003512076830245760254982) -11816945537005820915612546628220754888047323916908412844835508718596438483024450194460513154328044453905358916305030406271348781541609489490815789092163171)
+  (num-test (+ -2570682164188734368809161664810917340861573482754788446510182252413437925852206735928397938304353826925422441004271229738766803460790995673395984247950088 656920705293329551826685120408221577679101260931105312141757138825917579070505267306626244216341686712802796891966598838285570807961966448181138356047523) -1913761458895404816982476544402695763182472221823683134368425113587520346781701468621771694088012140212619644112304630900481232652829029225214845891902565)
+  (num-test (+ 7846359203342053693101523606887617345982401999003795257520576318451663998927274759872692123323796450295314377046602880394071105863527900699633560551732837 3683380639347829102597675045842249667669675715600522157867595962635108482512780509393310714588544837398923613138772339053021025559943198965234376657126821) 11529739842689882795699198652729867013652077714604317415388172281086772481440055269266002837912341287694237990185375219447092131423471099664867937208859658)
+  (num-test (+ -11692323148567132684205145901751681947225824260005631214936266006610207543813382900867093989444659986091234552140689684476541703112098935301322850961583953 -8534276689564199122569555420819240948691777228327984555753862457592427992599992931175844172478864477440165366128106812103785256271256853749622592560655914) -20226599838131331806774701322570922895917601488333615770690128464202635536413375832042938161923524463531399918268796496580326959383355789050945443522239867)
+  (num-test (+ -10734754884168724884333968138739681643742524619139397687680049322697740991391014196697040576174049452737571835233123127815762146577096625434481167057340772 17059878151450238567815178684522345445687980385106446646013863901583786249398194029757376950491550197185231926262467028755342392379269039238766592672298850588065335172902157386017520689203005559576263548017475991638498600879259882041932152385436968424098224966518534467302264172016376096778201462205990822825056602379115848799619564610033123837036507127427054121975400703490855123544706355545059512146550901507159940126280812512339749605195422987937677650572797378799103456094203126081464905326203083057134061673694975250599375795827437561275156235513192978645909947341297774926450637694325145427434486258223666250272) 17059878151450238567815178684522345445687980385106446646013863901583786249398194029757376950491550197185231926262467028755342392379269039238766592672298850588065335172902157386017520689203005559576263548017475991638498600879259882041932152385436968424098224966518534467302264172016376096778201462205990822825056602379115848799619564610033123837036507127427054121975400703490855123544706355545059512146550901507159940126280812512339749605195422987937677650572797368064348571925478241747496766586521439314609442534297287570550053098086446170260959538472616804596457209769462541803322821932178568330809051777056608909500)
+  (num-test (+ 1982582032974021971225071139786536402936929744496433027195224299475980201425925452469321205602618940472354066218156609448199804973454183972974358405933935 -5591374624026484498020036332218412149978824230210339582240360391202660977358546150723165491729699122647688030937226316069237264083850854032732663284717882873051337566653841254365703461654061656817936193716386141166210237666314879751427421825450110467888973152907618520704486700443275358649289847595635931220181024199692771066498714511145489237541761266539978351840438236927937894376002981658065431416811632941197501676956304254109064936038146674412392128883565757325842468006824235119684861972224857533964558963441079998949499582965764591461900562931342373507763081479989957632695010603500633322408246084430203281475) -5591374624026484498020036332218412149978824230210339582240360391202660977358546150723165491729699122647688030937226316069237264083850854032732663284717882873051337566653841254365703461654061656817936193716386141166210237666314879751427421825450110467888973152907618520704486700443275358649289847595635931220181024199692771066498714511145489237541761266539978351840438236927937894376002981658065431416811632941197501676956304254109064936038146674412392128883565755343260435032802263894613722185688454597034814467008052803725200106985563165536448093610136770888822609125923739476085562403695659868224273110071797347540)
+  (num-test (+ 11532228364136654310006206557545352284448588590560137249197311142901246089838098630841794341370689745410654263817911440601934362503092628725755210859171724 -25776236925500995542036591604259749301547568770017466769502569415611770276300787105037848049555500555975152877716727294374436703766730618054071617947449695177320842403963009384468257891933593584757723535299746543328292715942626303315235241470269740287031317322772461137186093930239744879822272349431389779234805703118929710210161489122272898252221025966631463842234537744822906696719691188223105175714602909117904182229960075276443648211003011686250829474364425483901920822837775032295913486152631638908227467242772081310515646217115760180349854601959031626524004201825198439309850266508687796415478396821644422350208) -25776236925500995542036591604259749301547568770017466769502569415611770276300787105037848049555500555975152877716727294374436703766730618054071617947449695177320842403963009384468257891933593584757723535299746543328292715942626303315235241470269740287031317322772461137186093930239744879822272349431389779234805703118929710210161489122272898252221025966631463842234537744822906696719691188223105175714602909117904182229960075276443648211003011686250829474364425472369692458701120722289706928607279354459638876682634832113204503315869670342251223760164690255834258791170934621398409664574325293322849671066433563178484)
+  (num-test (+ -2603756427337798371354526130541868239006085657393372011847827118826669474695402075575479286172808099892726251004549675772420422527946534088483901153485670 -10844269742362409682236511127219508926736627172993604953084481596070757241623728297275447608738915355190715664012379562650777199088096670239050254578284071100042116609747208178716191571268815994455064584659920497876052406993834873124981417288518101426395560764186717660091472734401090302285129741058888303693710456902635092811413971399734306158050053239768185860958896447298052082493590498954512083131068867270078638929796561440903919430094619437872896595720463663570751134804664228918188923926951933302878771189484614604311920655871182974081898031051411394311700207305532216445616083858025977851570522763537300875989) -10844269742362409682236511127219508926736627172993604953084481596070757241623728297275447608738915355190715664012379562650777199088096670239050254578284071100042116609747208178716191571268815994455064584659920497876052406993834873124981417288518101426395560764186717660091472734401090302285129741058888303693710456902635092811413971399734306158050053239768185860958896447298052082493590498954512083131068867270078638929796561440903919430094619437872896595720463666174507562142462600272715054468820172308964428582856626452139039482540657669483973606530697567119800100031783220995291856278448505798104611247438454361659)
+  (num-test (+ -5929887196386997518766568868806997104240129372360669348628384183712406620199102166145939206783172815805659513128544493795329100599632286529420772709366102 24544958491142793859949310604465694574872439331169358241746200808802938771527900616394258199996170862256988647191747967628756772368808644819831481350919782560499270148419601775750932556119448001824346026042068416905254113155445053931789404515589532235225580737103411251232560863878948880220469490014568323308965914171394449781093816607870593225534700167342589927524232815571862258490314644577819742372918446373756857848586825568514909823940075182825283229026250682015641747568282510036326125505522447591703308661608718100933027549520132308555240654655887041040427813131621391320267698106519650611462269033902177180035) 24544958491142793859949310604465694574872439331169358241746200808802938771527900616394258199996170862256988647191747967628756772368808644819831481350919782560499270148419601775750932556119448001824346026042068416905254113155445053931789404515589532235225580737103411251232560863878948880220469490014568323308965914171394449781093816607870593225534700167342589927524232815571862258490314644577819742372918446373756857848586825568514909823940075182825283229026250676085754551181284991269757256698525343351573936300939369472548843837113512109453074508716680257867612007472108262775773902777419050979175739613129467813933)
+  (num-test (+ -8848084327536592532063677611386811805244460767433749071435930786126721080365289638381557872263825830664387392539638767251180242665642373539064690745095464 -15917950175678012281826361248776190984758236997789474333609547749168308439513527143790323694526378056113636462939674273462177686456811495629631337058042159570336251822399402513133598701991665209363955263097315081570618652783181494594400709239428597117944511110842795526862595552977665064029517628515465251448116061875878430407784298951946811321795808932206846491091803276390661869369638950672478828532423383951689632136029256108992610781912267083149156104328033893238864631158195280554850035949666897861529711006187241710164902350100555999894332438423857208747342184052953230247487231455921360593096823760117493579248) -15917950175678012281826361248776190984758236997789474333609547749168308439513527143790323694526378056113636462939674273462177686456811495629631337058042159570336251822399402513133598701991665209363955263097315081570618652783181494594400709239428597117944511110842795526862595552977665064029517628515465251448116061875878430407784298951946811321795808932206846491091803276390661869369638950672478828532423383951689632136029256108992610781912267083149156104328033902086948958694787812618527647336478703105990478439936313146095688476821636365183970819981729472573172848440345769886254482636164026235470362824808238674712)
+  (num-test (+ -16314775600714318471451792035636584056297958597339492996728118376578145765736873313518831390349547274517050864260054903974054712997529177834428786007341762649083404743713562157667828894017440065599882523458121037421757904691003094608420565550031561905074671735751685371533975894842331113347413787808917193134135744321547478500861021485075363990553639161661734684228250909589741380076008551020384304303171431833670236949934603973673998262066558668396388979463892768199916011368116729432353268535563246463324517035331079693172060671712718486388759443825620676228470068291448236914050793177812037679396721657020438979754 12553426083939460917) -16314775600714318471451792035636584056297958597339492996728118376578145765736873313518831390349547274517050864260054903974054712997529177834428786007341762649083404743713562157667828894017440065599882523458121037421757904691003094608420565550031561905074671735751685371533975894842331113347413787808917193134135744321547478500861021485075363990553639161661734684228250909589741380076008551020384304303171431833670236949934603973673998262066558668396388979463892768199916011368116729432353268535563246463324517035331079693172060671712718486388759443825620676228470068291448236914050793177812037679384168230936499518837)
+  (num-test (+ 20637030084881771176788188367974505419050866216433677435050410899110162793040751338330447574748263391136356400036001988938659722098883893353523409458775455519257672423829361150611806294256710309281788819450225670112435352092313483086404714074567539245791066202051788986426960935796927738180831688497683293306590464598379493141645539253898709000874685535467854788184424886911457134522632486730390913239660179785071885982403741669161655812015114272497907946919026898579927936299607156006210124954460880383605958519412435713868501997649784658832599101777001703519408664662715322044086646014163774269660274683400619225321 11620128128044940816) 20637030084881771176788188367974505419050866216433677435050410899110162793040751338330447574748263391136356400036001988938659722098883893353523409458775455519257672423829361150611806294256710309281788819450225670112435352092313483086404714074567539245791066202051788986426960935796927738180831688497683293306590464598379493141645539253898709000874685535467854788184424886911457134522632486730390913239660179785071885982403741669161655812015114272497907946919026898579927936299607156006210124954460880383605958519412435713868501997649784658832599101777001703519408664662715322044086646014163774269671894811528664166137)
+  (num-test (+ -9838804688358141062268493389453191808060717708062736103828856866310283812230958467655270667206937622979717683919584610288962829724022506216738929136418489468786902364550847498615864720240589837282441807174290461916292258263929411081218952357662703079709351365960916688275651864441386750529258343003652300629003597744958152243494244227986280506395347894285277364095898602965258114321853474000520432831298793365139040664543928707100657375292032051256485942532600998813627925626928634068613637417702688610315924917761411247617905738119218110678854564441914784262998574445847209847985439514580300936248281049628734475702 2380166482232871816) -9838804688358141062268493389453191808060717708062736103828856866310283812230958467655270667206937622979717683919584610288962829724022506216738929136418489468786902364550847498615864720240589837282441807174290461916292258263929411081218952357662703079709351365960916688275651864441386750529258343003652300629003597744958152243494244227986280506395347894285277364095898602965258114321853474000520432831298793365139040664543928707100657375292032051256485942532600998813627925626928634068613637417702688610315924917761411247617905738119218110678854564441914784262998574445847209847985439514580300936245900883146501603886)
+  (num-test (+ -30961575335426221869515496362216292453766907587859856766456625722888557357647164641922707199324601608700561081422636642523431947551124957385652791834855425829101761914145137205962610515642614866296480715893528289170482422505734612327038754622917335073993027434927547277037587173529054849390646376806910407207016292483185533697336599641898250465186168797820802225861771331652801064811222606773495565340386327294310913503461903243119204619412324538886439122443769008953829820425376589389335553937319588224864611583436327810214798652896733118881040503785110481197462772022447173744898802421806800203373153221004361953729 -10586442965055062759) -30961575335426221869515496362216292453766907587859856766456625722888557357647164641922707199324601608700561081422636642523431947551124957385652791834855425829101761914145137205962610515642614866296480715893528289170482422505734612327038754622917335073993027434927547277037587173529054849390646376806910407207016292483185533697336599641898250465186168797820802225861771331652801064811222606773495565340386327294310913503461903243119204619412324538886439122443769008953829820425376589389335553937319588224864611583436327810214798652896733118881040503785110481197462772022447173744898802421806800203383739663969417016488)
+  (num-test (+ 8835746018617511846981408800319983340292665114153404569022025834059427359831684523399830234196625160662387716033871154398104436720494608541518837969397374272734698261557358249258503982414578618525420572597611597792132117034895074841909295420434392963714805547538976612884853497014341345150095544449860198192757839489063747595073430612069212219930749783824683135433987509303139260133564905961552149844964215891730262218278214035649706577154652729844092199333026620127958228847111442161350881527928460177763370427262298116900358910460957772350452949782281117704005514462730290063772968929608448642592954601418753021512 -12227722924075527556) 8835746018617511846981408800319983340292665114153404569022025834059427359831684523399830234196625160662387716033871154398104436720494608541518837969397374272734698261557358249258503982414578618525420572597611597792132117034895074841909295420434392963714805547538976612884853497014341345150095544449860198192757839489063747595073430612069212219930749783824683135433987509303139260133564905961552149844964215891730262218278214035649706577154652729844092199333026620127958228847111442161350881527928460177763370427262298116900358910460957772350452949782281117704005514462730290063772968929608448642580726878494677493956)
+  (num-test (+ -5455184800550144006991157215735481579353213544152145628297990102571936052187486515129266239245491863623978659179559754999567936067584384479787934704340911556625153536160778495579370425428019248950494107696016864499055854257192071541354806671987402367524770228296322497224645429524493838356022616251290117624472061673033274133156467148770562815676767117605001434288573911556053311048284534341905722947046607192815465807736361991479044698448267471087552952494477144251510778491315012457514838113324210534577956298926109164909779987221094000880908857594198276812276890284008572664102792405452379662935026125770444036994 -7349798942312432150) -5455184800550144006991157215735481579353213544152145628297990102571936052187486515129266239245491863623978659179559754999567936067584384479787934704340911556625153536160778495579370425428019248950494107696016864499055854257192071541354806671987402367524770228296322497224645429524493838356022616251290117624472061673033274133156467148770562815676767117605001434288573911556053311048284534341905722947046607192815465807736361991479044698448267471087552952494477144251510778491315012457514838113324210534577956298926109164909779987221094000880908857594198276812276890284008572664102792405452379662942375924712756469144)
+  (num-test (+ 27233955893140063612427006607965940109569052437681267421929959186535416115028420267622879017163568256526042146282241931623674996867133390355390677118211537487769195270234259640386625552763891339073878417517169618832945750393661600092643257470064376916337734385887099957095417541169462231630821139075814859604097878094729685589777579267192538715202397220666651307185763054526407234767132218634060693076054116575833737797189157152326979078121760900891899319809724675232853322526718686306470372869701173824664984405178677187081936624687293494821338781534163633206006387449585716391843039459733925494003066841874935048611 -66646390577667468207341453008390168215) 27233955893140063612427006607965940109569052437681267421929959186535416115028420267622879017163568256526042146282241931623674996867133390355390677118211537487769195270234259640386625552763891339073878417517169618832945750393661600092643257470064376916337734385887099957095417541169462231630821139075814859604097878094729685589777579267192538715202397220666651307185763054526407234767132218634060693076054116575833737797189157152326979078121760900891899319809724675232853322526718686306470372869701173824664984405178677187081936624687293494821338781534163633206006387449585716391776393069156258025795725388866544880396)
+  (num-test (+ 15030400024888781078933103028897733817304421960545019199443871381537070197157227994520524631721701055962609956080413517776229513420814407790533237358129529547793422514837651333555776540939235592155512951229106778709351772195248438493792786143040421233061520515971787881798980515709417481015662862327435825812557205663033601853937647320838585333754027488605638576977560072206293290493215523194883494322543800546276353830683084405428005815296131527861252717516620765986589669237487765523936713749717927502645633123584240464131140829496052170285171610845098023517906586134613874506419828208611247177336492131262918439281 -164048419232636429449474429717211197442) 15030400024888781078933103028897733817304421960545019199443871381537070197157227994520524631721701055962609956080413517776229513420814407790533237358129529547793422514837651333555776540939235592155512951229106778709351772195248438493792786143040421233061520515971787881798980515709417481015662862327435825812557205663033601853937647320838585333754027488605638576977560072206293290493215523194883494322543800546276353830683084405428005815296131527861252717516620765986589669237487765523936713749717927502645633123584240464131140829496052170285171610845098023517906586134613874506255779789378610747887017701545707241839)
+  (num-test (+ -10227062646189307616073129048534031298512434237226774743330733206156788005874968173984804649812506029813402205606562016228122184161577517837608957023376079537037472977098465137152327215807765130656192272994478964341604278041664840636982572214751638093860605132350960802560601354006634296348422600320863531059118477125143903734159707623839282511184908969206873548650544269932394344952983661665472663102992782521888857016369837211403335306200813816060883478434441858442549261115972947741929087886423170398410216855322384956160289855500229952405068604320121652911887067414460828300146993858360430784079225137421074839819 117460076430162201914796277915447781936) -10227062646189307616073129048534031298512434237226774743330733206156788005874968173984804649812506029813402205606562016228122184161577517837608957023376079537037472977098465137152327215807765130656192272994478964341604278041664840636982572214751638093860605132350960802560601354006634296348422600320863531059118477125143903734159707623839282511184908969206873548650544269932394344952983661665472663102992782521888857016369837211403335306200813816060883478434441858442549261115972947741929087886423170398410216855322384956160289855500229952405068604320121652911887067414460828300029533781930268582164428859505627057883)
+  (num-test (+ 27989453264793973121573869640708223239762902243991948581280654553806618470632044367386680716040316895884976837122054709584963028986161694425215067648887944710852278135008221491665079705797192389681328802747226171436158375378499411314855257919224316919346771317457123252623293612958336691335423245293660257386649100685560072354549579281852792682734916555498283053758141666658137856828164206947320523255487437004565021167276952652515632644458005291855624829941937578229983628962137595011570216766689546500517528191189928660433013004254032861383790553611840534023221000900694995707453499030166286828319347894538505334235 -59175168207571178843658955348404514921) 27989453264793973121573869640708223239762902243991948581280654553806618470632044367386680716040316895884976837122054709584963028986161694425215067648887944710852278135008221491665079705797192389681328802747226171436158375378499411314855257919224316919346771317457123252623293612958336691335423245293660257386649100685560072354549579281852792682734916555498283053758141666658137856828164206947320523255487437004565021167276952652515632644458005291855624829941937578229983628962137595011570216766689546500517528191189928660433013004254032861383790553611840534023221000900694995707394323861958715649475688939190100819314)
+  (num-test (+ 1178650930337394440162727078866515771626896502845852711186000991913866844090831426017480263676964607121490209778220339316756171449922437605552456088105443130477974682689512446683178356259305893852096425478878588001446154476458310269704392486398646169362313605456233489086567865316333034897433650974160168545492823208575634152241341906068149887959566983066154182855136114289266802474404127414747112706158621650063987662749553991791509795764642256261917497984177610694405881831052199417235241109412927893781778469398975117797578753730248539151297798807326284978255001046995523851829184120171969918537718488250577987049 -151873924489040812813761508259707631973) 1178650930337394440162727078866515771626896502845852711186000991913866844090831426017480263676964607121490209778220339316756171449922437605552456088105443130477974682689512446683178356259305893852096425478878588001446154476458310269704392486398646169362313605456233489086567865316333034897433650974160168545492823208575634152241341906068149887959566983066154182855136114289266802474404127414747112706158621650063987662749553991791509795764642256261917497984177610694405881831052199417235241109412927893781778469398975117797578753730248539151297798807326284978255001046995523851677310195682929105723956979990870355076)
+  (num-test (+ 28233332719950979786871881804755080223325040620170668729385709165879717973040387558150293205758215739710262749733170837042434162049732587908182282319848154049410849721309988807368466228286699721201975848741931128639324322061892706638973259354962358866000024260698793885547287093369940035337370984725857550291339492871017395328145015077506882578124550084937438336881072124376107623716831044079223921566902242543198986921476998895559488862309653154914291349588095330683589871173449191854284433182368052817373384461363574550061788800329400860372148193491004593903732351395815409821222597665222975816418433744748143385431 -43245950360315656184924888243641533635) 28233332719950979786871881804755080223325040620170668729385709165879717973040387558150293205758215739710262749733170837042434162049732587908182282319848154049410849721309988807368466228286699721201975848741931128639324322061892706638973259354962358866000024260698793885547287093369940035337370984725857550291339492871017395328145015077506882578124550084937438336881072124376107623716831044079223921566902242543198986921476998895559488862309653154914291349588095330683589871173449191854284433182368052817373384461363574550061788800329400860372148193491004593903732351395815409821179351714862660160233508856504501851796)
+  (num-test (+ 17311283930487575047109155431670372891723312431004343097275158353815289445461275098157423001160013464866170709729134076291306322952612660169010483426086431377525432637844274608988581691477819008626983761905899834444008235608280930166913911248710072733217113558125600345343437000427963292980921009445490627620344145866648036116660335905940809860199697939729919140888034303887423527841395304960072549430314367914315102150378504502158659627719016733307736583749830415574905929299482373462584995162798576853564481617711234957058703455021082855018642616999836886763535412642684228990890160568207941504887072856663966242787 1954009743321912552050341299974626734964446274711484506734354360114801426013796892421541915293157994203607853436799102383078659985249097057923578528366737) 17311283930487575047109155431670372891723312431004343097275158353815289445461275098157423001160013464866170709729134076291306322952612660169010483426086431377525432637844274608988581691477819008626983761905899834444008235608280930166913911248710072733217113558125600345343437000427963292980921009445490627620344145866648036116660335905940809860199697939729919140888034303887423527841395304960072549430314367914315102150378504502158659627719016733307736583749830417528915672621394925512926295137425311818010756329195741691413063569822508868815535038541752179921529616250537665789992543646867926753984130780242494609524)
+  (num-test (+ 1135960177108146621604027872788612991247811085764456406834564014092038611848908717507207251239454266163702244932570537009884467598603226302482406831131219148530146321028801515381981782506355042255201016953375149829517466449677312249611502599434850555618739830488706171667035140895674806873502543300909514568759918040129665855731078258004983486524477103833885001539135541445685573269814159175744401893663504523858005835387122082112362666991112899837534230326730196110477118156871579503345757821268248575583821695674912517830056856597644827244194658166928026249459511837772775196175188368236573504643083995409774002567 -5513982495816270388232134254127393284677692173792609278582774509636977743203029647121158805174638642867428501907786521939155900331399058909602425073976766) 1135960177108146621604027872788612991247811085764456406834564014092038611848908717507207251239454266163702244932570537009884467598603226302482406831131219148530146321028801515381981782506355042255201016953375149829517466449677312249611502599434850555618739830488706171667035140895674806873502543300909514568759918040129665855731078258004983486524477103833885001539135541445685573269814159175744401893663504523858005835387122082112362666991112899837534230326730190596494622340601191271211503693874963897891647903065633935055547219619901624214547537008122851610816644409270867409653249212336242105584174392984700025801)
+  (num-test (+ -30369736932762868789456108597366835061749107555998091727589163626331595118680326568212941898571309672187038272915036839449380083450246957904300051802617002374912724325419651633014408152565340519439718081357147324136023867003917288524338643759680061563616479323818330115572573568245719292922176485298767387601922362893307843067637295955606642841006993776777666041277965868780958830666697755738164183356399977211227424725670822944234275611849032230010745799964550976844117943559190671369193871330514473741920389633762695829790016565565261170688485790141638094160105909405353382982945608773290740598479367828342651860878 3451570547959142767282758882796967240086418127970526029661337442068316209707489088420708984628065070358319478649952710478991064476168799556496237099109563) -30369736932762868789456108597366835061749107555998091727589163626331595118680326568212941898571309672187038272915036839449380083450246957904300051802617002374912724325419651633014408152565340519439718081357147324136023867003917288524338643759680061563616479323818330115572573568245719292922176485298767387601922362893307843067637295955606642841006993776777666041277965868780958830666697755738164183356399977211227424725670822944234275611849032230010745799964550973392547395600047904086434988533547233655502261663236666168452574497249051463199397369432653466095035551085874733030235129782226264429679811332105552751315)
+  (num-test (+ 24749014370880469345815230363662696846133977441600857690896762642529872426102613384561609594131771018575590861342023688138502403609639138062665279129058939911797019091643704220495944170754490238422880589600838613701783818105188827633578438439212856537589855796204839275633245851474930725845096235668385012500773524750522781174430369067441632028068262240870795850561389232369373523415592833273932285308223863420210049445377497367753786125779044716949754454461623397410528064697616617917065021866397277409044449982605591256067763430930720398889239414812509701319783809830072841056369381573100589260104551934136733317845 -9461623592584966196513107657889418526847060851423069480904645009418813160370721071067349946095573698635859409908288864150475056170059858850823883834932131) 24749014370880469345815230363662696846133977441600857690896762642529872426102613384561609594131771018575590861342023688138502403609639138062665279129058939911797019091643704220495944170754490238422880589600838613701783818105188827633578438439212856537589855796204839275633245851474930725845096235668385012500773524750522781174430369067441632028068262240870795850561389232369373523415592833273932285308223863420210049445377497367753786125779044716949754454461623387948904472112650421403957363976978750561983598559536110351422754012117560028168168347462563605746085173970662932767505231098044419200245701110252898385714)
+  (num-test (+ 19070246171469235561279483225919489206942407814032615339351735800304747459507922411906751965555240682457214768298108831815622470433175555196912899313888991765436434867025639919521068437191248198117664398275835972573354886915721765715992151871453808224011999677700078879590132676060988550961950472536029228350169237717222998397029428440792110955380302156159849645211726041489206565536560827557279129751110297078563108009278363910936720061216511798518178957070787710331228500533067546198458251241005176280410230146430275074766072259256583499095689284871987010372039977403712023630453400259082684930755893684499232318008 12330599952818018622104330691506128012101935028731995985677032980931398338453806827555760801312052792065671886621851470997557806941112316627790755867100463) 19070246171469235561279483225919489206942407814032615339351735800304747459507922411906751965555240682457214768298108831815622470433175555196912899313888991765436434867025639919521068437191248198117664398275835972573354886915721765715992151871453808224011999677700078879590132676060988550961950472536029228350169237717222998397029428440792110955380302156159849645211726041489206565536560827557279129751110297078563108009278363910936720061216511798518178957070787722661828453351086168302788942747133188382345258878426260751799053190654921952902516840632788322424832043075598645481924397816889626043072521475255099418471)
+  (num-test (+ -20895998178036569919774658790651496115060841511658297683195804524712012347695091074325978179977718571444320688167469052862702339462089668992243209990795362064005869602003990235714500149401994013174762139297327430396441552225926368085284222509085197484452650071390132794942944512235132641643003294762547138305644086106533258432786768644384855008506026923783604514268955071498269812887794817192371944269611642901807443894686178438687102834127061425955994253034824027771176714559050403098437684091684851207513969915720607528045624635094984539637789113651579846373399975502788877555747414523231999341294756679330384323996 764238600803843266244444637050072967342049538611688895792923539838804953492110953673720766879606601435939162680753428779068917662740403667549850724878795) -20895998178036569919774658790651496115060841511658297683195804524712012347695091074325978179977718571444320688167469052862702339462089668992243209990795362064005869602003990235714500149401994013174762139297327430396441552225926368085284222509085197484452650071390132794942944512235132641643003294762547138305644086106533258432786768644384855008506026923783604514268955071498269812887794817192371944269611642901807443894686178438687102834127061425955994253034824027006938113755207136853993047041611883865464431304031711735122084796290031047526835439930812966766798539563626196802318635454314336600891089129479659445201)
+  (num-test (+ 6243894672855694190803081952962387322599009058758027960092936187687064819462191583137945440936085088260632250436567758576422207449236613172605950116622271404444221039084346501796818945639456207912207604248991842124079786471250102192718092353598850889806607728696519257402580732995770031331187089424192803722612735557735028710899438934171272639518928194764526910590046378401600819132587804143949995694950116915803127294011661411525934100144319021440919928013617766507409909846670172516021888661284467975865076091834094160862228180625536450124272957206172214541444266874056050295270719541605687740822711659847211976891 11877496607682442993105675644902145742318375725225741293060927105303783712520284640625374957608051032540491531573337817824773543104969422017506696018037874641947740606655370938613842356322585858034851150595788166740174872996252792014218946552442572806242471174234462119454014379628228878122072189387777413014452140618318641689597452676091677588204537830401725113931418426919671512011822864583481449136550835952005765386885680701637038206002172218712504732572449659704181315669255320876647592649071711438131711904976335957846353867776093588236311654631696625859173554395714740218099921290128795607292259527492722462071) 18121391280538137183908757597864533064917384783983769253153863292990848531982476223763320398544136120801123782009905576401195750554206035190112646134660146046391961645739717440410661301962042065947058754844780008864254659467502894206937038906041423696049078902930981376856595112623998909453259278811970216737064876176053670400496891610262950227723466025166252024521464805321272331144410668727431444831500952867808892680897342113162972306146491240153424660586067426211591225515925493392669481310356179413996787996810430118708582048401630038360584611837868840400617821269770790513370640831734483348114971187339934438962)
+  (num-test (+ -24023960171862805266003610953999097357395283354964456554686635290239019705581779621120391229617494503580661676939681517550103414632840981987397485411400553792707518662609532504246677658012933762605038799352109564432278094548068984563394926376371580465135388578139331334464060067790936072127680597181415407099723844313625277987147283697141407959289588588489162704824409673099509423520008795428217612706997355591985894255450783091681112776112997887084157623388943538145736618168104404283342039105202585543852590302154958791010622670839015475427693311663800177428904406869645066988663292128104453773413982185343111560886 -31939808827732134714870375774276102357277346245583282398423150631754622253109692213928642228787888509211781331649081002266227303203259124984426497846441848502574293640959494009564992092503141598640200823656998243767453860939156780549404892392521391484933772285520949470194562525777116137058001008184603332597820522016200623301007194309404025522056113671560767212894303567191067178003014955596425115379852712737129325098876542459702682095445350281859042779889411325882123213577906096942649941285655935053362468972482748617111598313960198743596285343178242282172686940700127068972627110105953098737923773182254460772630) -55963768999594939980873986728275199714672629600547738953109785921993641958691471835049033458405383012792443008588762519816330717836100106971823983257842402295281812303569026513811669750516075361245239623009107808199731955487225765112799818768892971950069160863660280804658622593568052209185681605366018739697544366329825901288154478006545433481345702260049929917718713240290576601523023751024642728086850068329115219354327325551383794871558348168943200403278354864027859831746010501225991980390858520597215059274637707408122220984799214219023978654842042459601591347569772135961290402234057552511337755367597572333516)
+  (num-test (+ 14513652183174940741664411990199277445706189147726874603036586212536012746892966848269748909379750612027025331446918381470766609543142456872580466135425754204680927122749772612276850998180593344389487924747722210296498854143380696064338777945015153982467675141485724865534995199700908286263993697988986805404864429385840512740226775506122190698806967785494289035976495492863456705096841250592980439363856397663738211335801835896091823148249303370609165910779981271035234045185574995335952208702661648744928539539455138167482396767268362221492607154709559716065850417221174683768503217544145599044845325824451589309835 -12814535978730024053359592817368712576084646962861720729844389627130663192435154658607204342320327460695280260731620465435530495952836598646143907272825807563512741964987882356778796849529260646503692618525570185450780889283642116889481314560395290434301143877809550098309214046129802023655714098730144464028249594406616074059558969757405392170810220921023905546104487938441503430332099605473144930508420331873995741851604525954472341693863067199617721032815462094767522339305487934030130207039176659398466616780628644572276059410087128533031562978399689702766028716401176531098447698206272762966470643604141938670152) 1699116204444916688304819172830564869621542184865153873192196585405349554457812189662544567059423151331745070715297916035236113590305858226436558862599946641168185157761890255498054148651332697885795306222152024845717964859738579174857463384619863548166531263676174767225781153571106262608279599258842341376614834979224438680667805748716798527996746864470383489872007554421953274764741645119835508855436065789742469484197309941619481454386236170991444877964519176267711705880087061305822001663484989346461922758826493595206337357181233688461044176309870013299821700819998152670055519337872836078374682220309650639683)
+  (num-test (+ 11356479761814008572465147431830778885327227506593483181241437802252618729479905490826767363633131720717461693888023278837835457496021519184903984385091047829540007466025527592005114414671285638168997562037691602144751434208304408870143450743278437854754504713023422097017723330207792526222436928747286558205279330508360438281011315147578105966454344087225699378388309094140949428028313539634103047841948634832398526343605363013644180832752120081735152285507591096001749463421326282317713079361827765412853023201330345752038722069405404812511739634687282327711258974520622248165974215116400638833123609666501349513623 -2451734542868054449539778460457497703609327132304922810342762480808881050209276687756391911546806187586640918078231508181876445466503459873508196878629364924241891220686182517218825181707207808769770392864734466652524094735160185556148554260517746279303022469784592528209667497664672945900929888144529727881050106027775707933311860110618130543481573815538047460723253898548348335762406437618625388229555824532715231231491787570056329865617082709588903922431713098922691537317839185452018617461891748518176708607861270770493263960554805373552348256747200291438630960804647686832667981625018361034564086859426490014044) 8904745218945954122925368971373281181717900374288560370898675321443737679270628803070375452086325533130820775809791770655959012029518059311395787506461682905298116245339345074786289232964077829399227169172957135492227339473144223313994896482760691575451482243238829568808055832543119580321507040602756830324229224480584730347699455036959975422972770271687651917665055195592601092265907102015477659612392810299683295112113575443587850967135037372146248363075877997079057926103487096865694461899936016894676314593469074981545458108850599438959391377940082036272628013715974561333306233491382277798559522807074859499579)
+  (num-test (+ -1814184401790217165873937825605141478060935014868566665644215718762341535891730598045990231798382966074312671040257824056876679135909008140059087311700216658095793352051583071432744886316274989901835606602224927350560604355249919901932382803472476702792978322468747380191775778902733911968522382089332819162367884984027854067607561808704316828316820133400099093450636968732151876570835173932998599031643640476109466728761033062776578175554441947411139184426213290292577467587355369954997241091769769542810051228504545831588488726789173405585678190671534386784806998695797717346491308862362775748058331375692317599945 15466182953987394334491149436346080039471412309427279110582769586053943302670765125931570041904640518032832554998553018838321871748542118021556398569294085708441934948186080236498081517178574839977996802813431873543309853609838200338534343580791382510179184571852290959723696010410340740895530535423959476873857191548113125728667781953125153120447892632916574768078583174099545013854248664119997703948998871566374080719541931440495888606776561795893839624084254684939434035018741535261951124673664746010067859317726891535170781460914710499572006592206360512398012457295755926986236618644330364227754380084585899275327) 13651998552197177168617211610740938561410477294558712444938553867291601766779034527885579810106257551958519883958295194781445192612633109881497311257593869050346141596134497165065336630862299850076161196211206946192749249254588280436601960777318905807386206249383543579531920231507606828927008153334626657711489306564085271661060220144420836292131072499516475674627946205367393137283413490186999104917355231090264613990780898377719310431222119848482700439658041394646856567431386165306953883581894976467257808089222345703582292734125537093986328401534826125613205458599958209639745309781967588479696048708893581675382)
+  (num-test (+ -27127130599753372624001250456405972983012981437652156246797208697430661165612459362971759027335854588888552031022264244768883843080959804690580574272908031271224646245152017114094021048441971097191444782106551075175878815012595015584723250801765859461211934306789890718268168352614164589637346918581658850565274510502652089457352942736418509881708568727739912127781455473660768550022762222130489047215089836402367851853412705556570667960548570630054608024914653686223423908494006675057953013815512203710764854485332282975729323105427143207127239069826750682633272289409910001698385240596625059970587393681128674617278 5719655139276246085992066702308194672442413085748146924567717361937179810269300239821879673460959112727066470468217892213025828988023367028158410455624528688729907493639908638553730770145274142147983721694721139760883483821883267129411125364089207412089113869427479340283853501026803387874124668123626271531796990801822527792189514551888019206405597994403243358155410088320317141454525417323186389587327532772638942220300149829241141659063128602316305332848477566686425551944956989370838072872906293845914921103561360871571846865478762953536949621421094416539099628942010528483544062050170673327754206501716239719529) -21407475460477126538009183754097778310570568351904009322229491335493481355343159123149879353874895476161485560554046352555858014092936437662422163817283502582494738751512108475540290278296696955043461060411829935414995331190711748455312125437676652049122820437362411377984314851587361201763222250458032579033477519700829561665163428184530490675302970733336668769626045385340451408568236804807302657627762303629728909633112555727329526301485442027738302692066176119536998356549049685687114940942605909864849933381770922104157476239948380253590289448405656266094172660467899473214841178546454386642833187179412434897749)
+
+  (num-test (+ -6069217517368004039/4076344942716985944 -399587800008780737/578697755310708616) -321318766345655960630110128852941297/147435729263904928853096856396980844)
+  (num-test (+ -41285036778370718/305793940074617155 -1396094619926552183/15846027887642356854) -1081121118676718273499338028514700537/4845619302294419132297197085940230370)
+  (num-test (+ 15975644088444536091/18063939613598316583 17501188199168431305/2979264551795273683) 363736076920798535449296038324193823968/53817254956563877935003279344562385189)
+  (num-test (+ 10197734562406803221/17452826108659293487 14639450560606090654/236781760961536951) 257914422508077920978698094723491089669/4132510899763835955061848877304138137)
+  (num-test (+ -16810360766832230069/13652857552883800956 5011749175730438558/4169057419710079215) -184295743992738197672588473692806043/6324394120121667288243293659228081060)
+  (num-test (+ 2234573531734039025/1128831476977636536 5842177084459535064/10255356071975483971) 29511180623959738330730559435115466579/11576568741659658592450950022331964456)
+  (num-test (+ 2268894928233321367/45672733521488298991909987382109984899 -10510750087507287356/187832098427494353069556175466145198255) -53883392376116199828369509984040539934420061636271022459/8578805378260910951788610598591490227836321974082207035230408675959411151245)
+  (num-test (+ 14273433611429514043/7774518083776389556784045601066955324 17247074371340283485/225579726714102822702316919752160926694) 1676942472465190408518249346164012571239098147062478293991/876886832336064155131767120243155911448808491410701588797601053820468509428)
+  (num-test (+ -384768590020206817/26284423885474502132625533495652664626 -913687410374243983/254477371735734658619949996700223764026) -10160887225658731404416073535892287983824191154410167550/557399258996959835387173465565070652935481894323496556880024318994528462023)
+  (num-test (+ -4465222504572200650/89674568206322981678158378582739708537 4148550863841320780/74302497820894496090312266744880513261) 2118016946376507498169590394563632549990739165791772590/350686547828419379316750498534703170285368675911953477374458878558215968903)
+  (num-test (+ -4466938407638238142/281859125741189685767904931589784285893 7302241525893379697/204618108204962312932373858463395271264) 1144186926000295881841982161759159994442430111060328362933/57673481089466829503954266461746705742702466399988738560842837126631263478752)
+  (num-test (+ 6692616266348342275/280491911593106290120490189988812804382 5414100524539959087/183579771905991028181574615911067652873) 2747240373316006570071525025488180559154305534334705425309/51492641151737853299832848099101317109893853469394209716061486746077629289486)
+  (num-test (+ -2794289802081124319/15768464977850217600859580216291365931410230647587457388598921425875331529149 10869776169503285673/33805119742344157512165738805682358903614971418053290198565741206390317449856) 76938383491719886409504555688515759257937029058461512747558964579607347503639994773101488934213/533054846729186819415263583890627325668798847177803707144003483502948153457972377767011992167761176556555806720273883868208938866192358148729990609852544)
+  (num-test (+ -253222140119290489/2123024034843473393742534167007121513293496410591072104903085284304117612082 17957334013642389787/32058972871090153103034645121513493401113378486125580864856088310966601405847) 30005809992231287609744177955201962181880644831204431411802631067134766877061419104162728517351/68061969937719269465960475690278941280799593161143759512261685488134507341176789799765185182008442410081522124548392827986923668912612728349293792643454)
+  (num-test (+ -13318881947309618/3105936147298438543619802738126617974207009907186580731552500517452462642139 1850968757748704519/36469179946212878965111748233319050931475015876401494718861814560453153824935) 5263262069792987469108717688485565287648879759118200779949761992573778798556738644541735401311/113270944257273905484832818286307416845956086746130199501242465128236430928807948126409718436237517505516279133169796919230385184900609912160483959935965)
+  (num-test (+ -9937822914683494298/36414156259035675966580098631253549474580108307284844243190992829476777586283 -13712605099585970325/17758145954890657915358548152198427387923366136638180213650029984340849686198) -675810254607579372158951115566887998278519717754376916387787672973408477396668549189167387350979/646647901672150721610792561233068038707362067627156669418022102308446036384411330678972562863413004325878365438890328206637571985169324874284800419222034)
+  (num-test (+ 2479135971595944301/28169711053558469409458629766960029324030958129245230797895768033968717159836 3427244662960653095/28446538857424788738244844756675951434179713170118835630969510829753715142438) 83533664807147783700314944003289704497366290621039272787320536148072960487262393639109696219129/400665390043739792096386856839000624247597803909916773326187593475005945995926511155915226239317839405221783416485999405286913042389632370302962776360084)
+  (num-test (+ 14865500635281371370/56222262470894935247131881777606182311286871927285650835673424014252462156319 6436092572090050725/19282524131572095520593158313261757267758159099923763177708581262473988426947) 648496060602737474174747620183913927791943082591316359990137585798909535115053578637078811588665/1084107132826611778585714784136700465449309125114745313342842325649687943726086785657821763235618936882528385000712567133180567926723616940173290425928093)
+  (num-test (+ 340196811925805824067049620503247332111/14422464039094716975 51285507111580975533385007190438537498/3230944134273302873) 1838820276033673324738967436225477772648372110186756083453/46598175588880723338390245118389369175)
+  (num-test (+ -210449319160504160992731982827917332322/5436857856220342451 251628249079137248539965770847855056283/4323109210037952829) 458271632943884346915405609513071881239303671882386130695/23504130271893362375786510953364243879)
+  (num-test (+ -40984360445255688839942109197081457275/6593417935076565019 -138094174027187773198981391229349265879/7135512300754720691) -1202957011856131413678873259651070808566709454882536663726/47047414779755620074837011989046108129)
+  (num-test (+ -289704472880230079383856507128133962457/10452740760651010288 -55251460678415911958671096669490155237/10333740726609314202) -1785630052601050832889834016432677758176770083879794496285/54007956451514283340719766211063255088)
+  (num-test (+ 276702099951674677215621541062877777467/3899918017008359516 42623843937285717338660228144403811741/1973785812353331893) 712380176058162142132059442064597996057720566915757732387/7697602851312240113570356856612843788)
+  (num-test (+ -323480614013303716597188084301661616596/12957985934572321773 -72966206939397711493108854138997499334/4539020357040680881) -2413780175334213399707013296172687953960842714316410700258/58816561943270580900205343368941122013)
+  (num-test (+ 65443777543319569578713907336699651721/218804857459609839540825438673960136766 -61986861924091374470669233802827103921/65997977315012279293170493460332070399) -9243869541956614722377007489838492339200370508580665293676272508698701352807/14440678019033825487758061900150103876633207457375858942267120523885980189634)
+  (num-test (+ 75417845823236070411341994633288547531/70553457686181702397810927701121800017 -7132208259849175775323757110664708879/24379326462014713478002790304943339422) 1335434330716260509518880689691257567128541829706203586134358870209350816139/1720045777955364955754847231620711706115121721983605654691934662747636370174)
+  (num-test (+ -144692585186931942602350348772472248638/135233395864627580439431775527364081053 282512666765911374279543408363363928190/317835040256607665191397469890906044457) -7783226336195038987381961251409043080655184208289882004756343793157154115496/42981911818671667582796085276418080952868666330715445603855323471628969373221)
+  (num-test (+ 44888992584766727877549626240272070725/30583318432547259097085073976959329092 8004917623696885952432014881247978821/22005016116109025986417835664774768346) 616299974987760892931461886440810919939264155149950328291076750435394215691/336493207496148335911511951044490614757807556827643881435283379298939260916)
+  (num-test (+ 78378756441281199312006031491361997668/175125578595003447448566412156266355477 41128705932035853424044828385766740319/216359823601433445464965619660717081261) 24160702340946845080381231961736762955784254747832931999121777482667650876511/37890139292913914697800186893609983979783140570423836226844401085057321416497)
+  (num-test (+ -36669293296367265584135816683983780855/7341750629088488427994322429098120058 -110335983484012479290765295565662258281/5944410911181873015545360879141666465) -1028036623331099574157832708037007047972965676333418398303213384036005227873/43642382546729990922161061763293407461832155878510163500678954788762454970)
+  (num-test (+ 228535455883892721240720366651075744967/13353170075841095813026701300679754576855418298534901819672803635370738730013 50622643250826426975012800479360461693/18462345430382979738234695697296360785230118465695284267226773073149552698303) 4895273294635392498665165879164922265508724130843670837390305811645771221742112327485665544066552056189958877583010/246530838530831602270074647792752210668736478466245992891169449973883874207653264921203783108295835419855394180777469634862446033810927048792871560267939)
+  (num-test (+ 11355068601761731966774720678777239425/4604724775053993730579400400679579947095967462408565975449642189823843820753 140083339434585694465706029861026468774/44667214322013486680993684507177513903616004462434123967566781106229226297333) 1152244506542792151980649054527153167035843960949499862764543674633978109831264344257976000890169981044543787620347/205680228421222079539939271800361418862113882206694593495620042859527547538342323521609420336002641308832164587573546802806916292021672743366881933951749)
+  (num-test (+ -1347509007210283053816302848714698886/1127513773036247565111791991337919355855664936242166138889250311777351432819 -29464928273311615445392112247506626497/61933028109313748081628643142485450090725737246358993405254280723087421657760) -116677425670791909053501267317366054796703074907755330120413752187834449333299886015456661052906469074533366060403/69830342199092322009251417145364324484174202256910311362396720371574344280505889954115533896831727771442604285956749924105078563356474162416148250025440)
+  (num-test (+ -324250487660721070279458563122233299722/81069650926979269606211148691445887485067008319429991878657612702576019034861 221744296343315457943731256980089803078/69422237643162665956763790134527973903052044485041686255401689654420090859107) -1511153903564243978242173323335554031611949546418082039382510246845821774680210236992700372319944685567533765722032/1876012190766999122356500320654631447623282613780323887424324139799202291067983209550065997185860196433399782230215269625922714982832188312141580824109709)
+  (num-test (+ -5518324152042099343909980322067306333/114786626838714403445081775763480415805466836213320421844559660900880511042496 -34415425451618992284220085078832944671/96012285963709194218263616278916829663708037691620330613749177799086889040577) -121088040955051148243092870850103339772063863319219725752028251933576579890093496821887384992074112246777968211161/297862876779681729593084954525306275464788137269287692384941959703420459939692410434239827100068259769782676124741025632728203586961467995819025176090816)
+  (num-test (+ -14763921690861243371082340598041267817/5580497386043551028888310256097864185640794395615400088682607872958152738111 -37917865546640067592937379176813765341/6460563866107795917092814416816176677900242086501650458839130903088333290440) -306983808565398982164654624310995401934900925070311336095043743767915008644459192438083753301097540174379867380331/36053159767181973313125557585868206969047484351694148822117591172786449966899079869470557965303954072842600790897257698854023751399649072014440219958840)
+  (num-test (+ -50167218239107621378232529938205077788547946059832391744348095230748591585676/15685777859540025727 2959973815535345735348053015389999235839609978295604181643547897863515739931/7556072538495923601) -332637648328710384664787658442281566361265475773778265650094684540358159241317316408573560734439/118522875329417757148187346888166482927)
+  (num-test (+ 36275100136090483878026478935942224245036692059657264537598788566553406654319/7192442039871568876 31833552596558882106090352174644817045294359487590746360517241517440556146007/5115621724114081523) 6795584791386081942310910570767193224876510928834120433155946649367201608618436115134135392229/603177258173744207443043238127434068)
+  (num-test (+ 1518304705177739493483387141342904186483658277690975456045607777812450680478/1837349761252804045 -98159070764971437450169149833809835519268242923913777966502463698396945141091/17238232824535200528) -154179655228376218743158291724235398278770272999447263973992852061897564252670941977524115620711/31672662964580000612902147746364535760)
+  (num-test (+ -16820231344048323866426670709751443650129113909724546927974450301780935205864/4879137683452153951 41987219452495799378686134495924115238909423831017150785452046648616005475639/10470103987572807938) 28751853386830083847297108941057082854166610198448421498169760256533906032780671559334244751257/51085078915429149801779227663330863038)
+  (num-test (+ 106981694162678522688926793970551228214793665448093395251834862896418045995969/12359470989873920972 57736849967187961211538031441400807467468650239660040144967046985609433512403/9148121311784151716) 211534804819567028232303054650327703050869189253958355919997046592895748577556985792570078031065/14133242495605447754080611005730273494)
+  (num-test (+ 32477400086615533920132766925666506741908300936974348739732763951610256880146/9045135183308696243 -27444990730472195954051975667481893116650518055101159075033425831129583042846/14815776448343565085) 232934248044934592851252865496377968609159820017147884670610366058217203617961573611006127074832/134010700820948737148715427669965475655)
+  (num-test (+ -110053921687226074580746319073262192216481755737797790655164396095655530752161/255625377233605953547425802301922658850 104095037267817888539158192425982072195078148060302393917025130946535913363779/52156238014583575190277280296975732513) 20869334635774913818120011435677143948904421430726712952150525645851498022294865158343391008006649321440592131083557/13332458017563665620865770931104425383051282278510599570476131200251352190050)
+  (num-test (+ -29732769078100192507326444863945498799317005912797369958801703828462203585495/153426302667449722633466432797809987061 36094569840376017510791155197897623093337784636438580042046806320700826250193/73286165979315961333009750429763545174) 3358855747298609357265422062476767573626163217619249414656940907348235709105513077913806378841119674678021275101643/11244025482879487592663298816607141776071841230792806495601092332558428993614)
+  (num-test (+ -5942892427460131788264792587455286675871284855854073854440582948253436001319/42136930106315714728428443448730580823 4013357443728612356640061171485791666303136232331145404661874650095235381569/4039594279673425548586623641599574814) 48367895947790658831309709091377784501687363167039737892874371817395083020674648576881857510385191335175551957207/56738700606823969419119152217721454504573192499839513549171731025354063974)
+  (num-test (+ 83833896550100013648317056712064289497247852876055488793078639582729685477353/188580876675619574786621140720273228537 -94310653397371924313725082402708514144086936359594289802762093989853507835016/223423274286761439988276492107364036191) 945257965914081840217765265999453398105151083284254483307155736205796420255026737575918161700355729594975143830831/42133356934734885127066999419230498520039134905254787577957770920054881982567)
+  (num-test (+ -14753992026457621496269953958381833108089826525439816493815533773338622353285/187171041855711408638339193132645929319 41340837577662628944845446369855468662228665858415210386857356535970453143469/322471558852595372991189266479896691326) 993354944176102401496932276511264091214577507066786487301109889019709943488537161608732610457423116833164991120567/20119112546425211128699888199278894685207186285215928241217590790016852128998)
+  (num-test (+ 1370528773439579327226257222995383030603284075640526658282329726447335048230/305600505683287165495713194488435114383 65450762047588146235054351616480175308174618406941901794570541085963681607527/78934496562987400429145916504112602768) 2234440886428442112499564751364146150136438855986167755259621093816030535881959724370423862435538502079424185584609/2680269118389404699570998335430047660909241475691839354273569734988880268016)
+  (num-test (+ -76890617375308981455205142622328108690129081798840077873315966300000409208129/15716637731576156581128288257209679492686622162926707938907282962815471734862 38716252217351070567267262306332875768795464072349655597599997486613800623507/8966639693620677733207403249675415446338239705879120765911896990394928596139) -80961151400006413290662155450270992168701818633203071886556882897757813544592915596861717853520674107309124394292702460320442121704840951425284048212897/140925427734207212133604717335369986754855062343668899363006574618520848268718851310007161609443093589067206438198588881828988648068282656538084484897818)
+  (num-test (+ -43290760758277846058307167265569849910514905939554272559141355223092464986939/39390771697068809730875092892395235497943839933482798653607450783947201796777 -34021960935937170163894986285771504067448629886312440795733904794894095253649/106500928228745564800818258673435811176493306775154643113582742982704678574998) -5950657500399238361998292872481533631424138885403498309639150240712482075115081624153513501886127772738596607451116548616099047843190357858736503567640395/4195153749384427435979718872073512266029328962522899010907363614544821318917440413166534226890289043064894115954085809567292470182917919104836361549181446)
+  (num-test (+ 17906146982204022925114071077515882010955693727109005464426577098738402001871/11978213712662686419384559301746021856683603106261241838035626618416021524231 37108371752538653389309509075248119316034595087990649061240232817571629131708/23044877611981158676785639370406786635050056158699399001947422631523989139615) 857136973087880657664203854652754375000000796400911171478039451763440064550649429609696307332611304395324153178602635490321877797571177424460384122636213/276036469018466057777760709173569478463866562650149880633721199971933767458324034017734890892482223472007882939609440193626728031771767304374122564511065)
+  (num-test (+ -77062185592993847534024832256462395143306675613123510837298699277378172890089/108133793614758275822883834459865239455798743725021300772336023406871185253111 11169356025540464491224577661206910726665825152149521753528516637690366838655/6369000033300801574913390611244042297918207179453133439308688067382050608197) 716975776667538986425481530620118513423964367153518065425241139444161780269039780459555836804116752462325735011822817367819625929553250251515977390346172/688704135133337463423649074673019029541747166391680122270752018123634233590688096940261480888455237095078029621363428114402137147558304641222314936350867)
+  (num-test (+ 13583698920327742567560325715281067532806062839142769830536738488850089822247/37364394142255392010559408553278838878570049727027927213977555360874308098434 89809462356450792524214360688853318641058652796345720882094866396911421360072/67457610947238032712889230619376608100793287037427539672885124981055281513463) 4272000026182362299819817378001862956001381379478285995446709640464951377212652125169846305230835604666564953883168949950485767679005929254184987140738609/2520512763327523955464432226120154092742373168521113224665257966793820057379494860454732800329019773731110452438496395974166220481124541266348389100216942)
+  (num-test (+ -56124163112538495128545947597589743957824668875494126834084658670528264380488/4752969512023182700122983723156599300062332404522277372984645779569746369511 -24794747728228571193100294011820993825205231022194400752319729320185378063197/98168688073468429337427023004226732413974455700654808087001957859427678524065) -5627484141989830997868845457242226973925524393512774885292323552602180052845805156311097870316601631410500655735815037997645271136502511615781690896430387/466592781448509275992390948177487068548424631274164031114910250651063315574511979617153568070687706304645818907382693929886654490427484894987856595782215)
+  (num-test (+ 17009115185923538769.0 -12047631083067675031.0) 4961484102855863738.0)
+  (num-test (+ 12677011568664239747.0 3269056182420253574.0) 15946067751084493321.0)
+  (num-test (+ 9315504781982082433.0 13857624532376678678.0) 23173129314358761111.0)
+  (num-test (+ 15226508728194069537.0 11481952022080775416.0) 26708460750274844953.0)
+  (num-test (+ 7461641943684774743.0 12249026721402718630.0) 19710668665087493373.0)
+  (num-test (+ 1180469445886971055.0 -3208456171287181032.0) -2027986725400209977.0)
+  (num-test (+ 18358552990465743315.0 221529797579218180385160273426219343697.0) 221529797579218180403518826416685087012.0)
+  (num-test (+ -14819874956616484359.0 30498815629431206969122152847973230849.0) 30498815629431206954302277891356746490.0)
+  (num-test (+ -11781881800334342169.0 112219460388643619332860331282276228017.0) 112219460388643619321078449481941885848.0)
+  (num-test (+ 3570694277032201957.0 284821691832196381859344006870088122712.0) 284821691832196381862914701147120324669.0)
+  (num-test (+ -17005463295060938595.0 69162171850264911722979835561124066203.0) 69162171850264911705974372266063127608.0)
+  (num-test (+ 15647113311796203488.0 150750467185419235519670165664526735459.0) 150750467185419235535317278976322938947.0)
+  (num-test (+ -14330150541101371097.0 -13054027994001826312503071338715966858478218093171762021549815587520723118772963817341751396703629529810372702877555022105594068768886421335353882155416908.0) -13054027994001826312503071338715966858478218093171762021549815587520723118772963817341751396703629529810372702877555022105594068768886435665504423256788005.0)
+  (num-test (+ 7406427184711759740.0 -4059250217961011548005203450962458026528281798230141192186669580689721046971433745892994467792118611646113962840750314719233572760336084100766391093756252.0) -4059250217961011548005203450962458026528281798230141192186669580689721046971433745892994467792118611646113962840750314719233572760336076694339206381996512.0)
+  (num-test (+ 8819522415901031498.0 7274905269237471130619913887005155660991437201841760414347836177003483932007334374478344594178179032728521106519295465031750530183363793325150672647162846.0) 7274905269237471130619913887005155660991437201841760414347836177003483932007334374478344594178179032728521106519295465031750530183363802144673088548194344.0)
+  (num-test (+ -7242932332215698200.0 -10558564312909325527488520195600871241245891651644550509993750377630234801225525279855157008009255586978047154906058790342845859331159009687703010657137320.0) -10558564312909325527488520195600871241245891651644550509993750377630234801225525279855157008009255586978047154906058790342845859331159016930635342872835520.0)
+  (num-test (+ 9794320575955609492.0 13380937715397052566925484435342184213544885758759259410983243841206628594840271850190097746775475837233042430565529099681550277688470325394342993771343357.0) 13380937715397052566925484435342184213544885758759259410983243841206628594840271850190097746775475837233042430565529099681550277688470335188663569726952849.0)
+  (num-test (+ -18404048401680891243.0 6690884608978704096379677348142836785900717005050936986370615083929607190833180925295418079551348559691161519822750772440155040888224482801864925665484770.0) 6690884608978704096379677348142836785900717005050936986370615083929607190833180925295418079551348559691161519822750772440155040888224464397816523984593527.0)
+  (num-test (+ -10763220363947284865.0 -30985722824355332972176356513316569304601382411274079243859710673739383446566598659878378034375348869471278415635671865753349734809209959160389615096293457362383744562507969316522225741589739150453090393424063226271167062127000223628785686999799282795143706407082119829140399988180879618548495395684946331608899565543458192773899200054228140747414544792128323269250618482622488195333106891323515989863192944848391405358725993695671970811097285270641251816244586360288952156538400321933146150313939864593445583603568771077260174826348411367609521412133720180359748539721570562669201065857989876521301209899829037444385.0) -30985722824355332972176356513316569304601382411274079243859710673739383446566598659878378034375348869471278415635671865753349734809209959160389615096293457362383744562507969316522225741589739150453090393424063226271167062127000223628785686999799282795143706407082119829140399988180879618548495395684946331608899565543458192773899200054228140747414544792128323269250618482622488195333106891323515989863192944848391405358725993695671970811097285270641251816244586360288952156538400321933146150313939864593445583603568771077260174826348411367609521412133720180359748539721570562669201065857989876521311973120192984729250.0)
+  (num-test (+ -12742462236537568498.0 8711131313747826394504271797986775572294949693272674156076339989631171694968899228610359983845552623710580616605402899155485071497929100432998183040757832449369366844015907530612334721882095163137705867337969942902346066961718232788529860214990099385213558935023241940238638069647809530490438245386869385682221280939688108487754251075630026707075310465788398213293782900699868609660892232563106662995330591906155134237356516622436517046191466823447743155250482328613449506396571170001248589926831956459700467126756876526930443317428628239358666456771112897986098390410773312792390699312960051747534683311506465130527.0) 8711131313747826394504271797986775572294949693272674156076339989631171694968899228610359983845552623710580616605402899155485071497929100432998183040757832449369366844015907530612334721882095163137705867337969942902346066961718232788529860214990099385213558935023241940238638069647809530490438245386869385682221280939688108487754251075630026707075310465788398213293782900699868609660892232563106662995330591906155134237356516622436517046191466823447743155250482328613449506396571170001248589926831956459700467126756876526930443317428628239358666456771112897986098390410773312792390699312960051747521940849269927562029.0)
+  (num-test (+ 9991390529516174614.0 7879872958436992955898278403297937595295396115022400543178444946646147916754852888072481665174663073269556311758611700754643170639645548596647557683044355930340624784190093631808382820554407595007761070026239341594197877214157118335743842022627898879376346092898666610367809537340994845045475091410516226225078052019727419030585524815982151736622865401299588936172760762386183577504972623377661437665668080131418564228642443266935225613702941906491478788336262289516199380144218708241406077806669686589734333554945412904560108150202389909124657090061223183441083590340175629756198442568877659538345749595968764873879.0) 7879872958436992955898278403297937595295396115022400543178444946646147916754852888072481665174663073269556311758611700754643170639645548596647557683044355930340624784190093631808382820554407595007761070026239341594197877214157118335743842022627898879376346092898666610367809537340994845045475091410516226225078052019727419030585524815982151736622865401299588936172760762386183577504972623377661437665668080131418564228642443266935225613702941906491478788336262289516199380144218708241406077806669686589734333554945412904560108150202389909124657090061223183441083590340175629756198442568877659538355740986498281048493.0)
+  (num-test (+ 831234034418847630.0 -744676478858160349467117341859049692149463503380690495147216354303526704924280287782902146026018180364963325847811379182950159627878800024734206345960410146056000392683000433501805629464626281031086102425271022388473812300724085127447081771317912465921636737545371909901577246384446144919253141375367648958387948463576516115079816552636772639965957498569187848459747361493535081532845254971492261148968198806736512864867151355002902241562014241077734122599581732704243705918200179789271894804233542502502119523149682814025979598424744685548054183678652651244898867735764030968089217841214778606507809487462642341164.0) -744676478858160349467117341859049692149463503380690495147216354303526704924280287782902146026018180364963325847811379182950159627878800024734206345960410146056000392683000433501805629464626281031086102425271022388473812300724085127447081771317912465921636737545371909901577246384446144919253141375367648958387948463576516115079816552636772639965957498569187848459747361493535081532845254971492261148968198806736512864867151355002902241562014241077734122599581732704243705918200179789271894804233542502502119523149682814025979598424744685548054183678652651244898867735764030968089217841214778606506978253428223493534.0)
+  (num-test (+ -6996572501442843347.0 -16567158719848992553565776505785820491834685475229611199353714982570065913508303466008005931649515528390057456882757990896824841386431756898386429000065518724021230756426613661219891419166146764347562529640689229693578574350948436847247856000438153789455857903402883189892697143647998643667467614427922009931545254965075041050860609824086811877108940020349157317276288348430058535959434983921323332907180869396258655826781438419383792024592535415693101119109484610789291889841197827977530804650015884500878613240443324806805475203272442094530735476095374446946252236490708915034012846683015547314889561060687692538144.0) -16567158719848992553565776505785820491834685475229611199353714982570065913508303466008005931649515528390057456882757990896824841386431756898386429000065518724021230756426613661219891419166146764347562529640689229693578574350948436847247856000438153789455857903402883189892697143647998643667467614427922009931545254965075041050860609824086811877108940020349157317276288348430058535959434983921323332907180869396258655826781438419383792024592535415693101119109484610789291889841197827977530804650015884500878613240443324806805475203272442094530735476095374446946252236490708915034012846683015547314896557633189135381491.0)
+  (num-test (+ -8920936222630165483.0 -18738991973681679876688842391791783563249057933653045519186959571392922172943405646958686202208790537612746921398028331540617848217445632123805070077600768524509025758950743971128222843292926773668584735575066246660802064630842300367821042873152766467703905048558085377302000898639290554395913805527529259855535801856020623830262396582180677933562523957295341539162448074423901242873918231922121053192425691524797238343327318801359521456598967984637483081312932069399045363737622797213185099130529375169698811801965974416555301085043300426947769193582129151016159057101028336667142913854943018973494705119572045938607.0) -18738991973681679876688842391791783563249057933653045519186959571392922172943405646958686202208790537612746921398028331540617848217445632123805070077600768524509025758950743971128222843292926773668584735575066246660802064630842300367821042873152766467703905048558085377302000898639290554395913805527529259855535801856020623830262396582180677933562523957295341539162448074423901242873918231922121053192425691524797238343327318801359521456598967984637483081312932069399045363737622797213185099130529375169698811801965974416555301085043300426947769193582129151016159057101028336667142913854943018973503626055794676104090.0)
+  (num-test (+ -243510292488206214847646757340020705642.0 5940577100149745132.0) -243510292488206214841706180239870960510.0)
+  (num-test (+ 35446324064743728955945058978206455057.0 -6248622708755929572.0) 35446324064743728949696436269450525485.0)
+  (num-test (+ -285342226760657637664173494795024413673.0 -11942737781617905307.0) -285342226760657637676116232576642318980.0)
+  (num-test (+ 180790435817422032042321866247362452865.0 12401641959336396832.0) 180790435817422032054723508206698849697.0)
+  (num-test (+ -179994871947239535956826388240542999950.0 13573822506399140772.0) -179994871947239535943252565734143859178.0)
+  (num-test (+ -308198027295905163635866438671452347268.0 -8790069282378476990.0) -308198027295905163644656507953830824258.0)
+  (num-test (+ -139324757925833055762410227358605285566.0 -190622873846936719063564661032771271922.0) -329947631772769774825974888391376557488.0)
+  (num-test (+ 332866352618304570046318203427223999347.0 147978646177673305481282943528696833018.0) 480844998795977875527601146955920832365.0)
+  (num-test (+ -39471620476300923970352914034802271156.0 28992893610776120142668950821916856486.0) -10478726865524803827683963212885414670.0)
+  (num-test (+ 274120253734611965146455315763505869288.0 254675910805265090692978775702306142625.0) 528796164539877055839434091465812011913.0)
+  (num-test (+ -122086811464559635596206661886176775901.0 287312583034687582188356355813963609701.0) 165225771570127946592149693927786833800.0)
+  (num-test (+ 288576174771266329955482943556556984728.0 -57843540651903655425270706396868707777.0) 230732634119362674530212237159688276951.0)
+  (num-test (+ -47977736580820486006305788441965482221.0 984809271313988066640898939725532304075331399066274624928410251834520283291912387208948664716457549646483445981126881113426109906085249657168046936670489.0) 984809271313988066640898939725532304075331399066274624928410251834520283291912387208948664716457549646483445981126833135689529085599243351379604971188268.0)
+  (num-test (+ 21225484205143479814642328762121362291.0 11839789093732539327981861490012713257538550745921177905266671749716203131127256902110452504526721633943016923389974867770082516862899595554460170417713940.0) 11839789093732539327981861490012713257538550745921177905266671749716203131127256902110452504526721633943016923389974888995566722006379410196788932539076231.0)
+  (num-test (+ -193095363331703875886398909106293703000.0 4389392021031719669078675478621418677903292147307684123866099084349756491860737402449105804868232530632178577388168068485304437343508442251302846768269976.0) 4389392021031719669078675478621418677903292147307684123866099084349756491860737402449105804868232530632178577388167875389941105639632555852393740474566976.0)
+  (num-test (+ -14827657635864183514988182371035598180.0 -7256545787852407071411458891023580461638051949278710509801472046178301830006724297747051044450550248499056073213660185258676369175307019300952192657194576.0) -7256545787852407071411458891023580461638051949278710509801472046178301830006724297747051044450550248499056073213660200086334005039490534289134563692792756.0)
+  (num-test (+ 54301423175725658626298504084995819705.0 -13385853291610595576947504757201441006088030688464261540642594993520424631577281077984278942244446266776534612440941312995898184903431893212829646845766101.0) -13385853291610595576947504757201441006088030688464261540642594993520424631577281077984278942244446266776534612440941258694475009177773266914325561849946396.0)
+  (num-test (+ 195114404067053480147948948510253723990.0 -8373866462448797623435948949281383906369538962237624940506813188612614128993186653340202956656303504523161255703176374041758276069255591562198514767063594.0) -8373866462448797623435948949281383906369538962237624940506813188612614128993186653340202956656303504523161255703176178927354209015775443613250004513339604.0)
+  (num-test (+ -308030589512186791277525017840002670741.0 -11922204352024596469278978325035646517433105521287613403902396944414655739824695945028308092245747333098422116078042326104667969967224788442970266049942774583538734406057081597034454910987815490244451193242377705191422489528853976486607580169986057592557285271953385769215318545520155212402919465580052078255078759756709086185424029620805084776442744700501748376290562843380642608395240491162047933014854466267084965223593172702334466729933986413870670083326499598274393380692146118979961818816348097032083332695128587696590646086980241100792624502607816103195636761141133903550454815591457829485684936036414823492160.0) -11922204352024596469278978325035646517433105521287613403902396944414655739824695945028308092245747333098422116078042326104667969967224788442970266049942774583538734406057081597034454910987815490244451193242377705191422489528853976486607580169986057592557285271953385769215318545520155212402919465580052078255078759756709086185424029620805084776442744700501748376290562843380642608395240491162047933014854466267084965223593172702334466729933986413870670083326499598274393380692146118979961818816348097032083332695128587696590646086980241100792624502607816103195636761141133903550762846180970016276962461054254826162901.0)
+  (num-test (+ -172649878347923210775992373331623646864.0 22180935775581457002090790736532281654456312526625354262953960635330604551829750571440878712430708012807252279301365732385899228826740712544768476577874129759972563823209525283326887563301081200476495752033290851190327066070873711444930389093339915885090143783170994309089448293499799071372787520776773788274677288230540162485916160484352398851925328125588729604931589867889917097887951581817207079060016091919559509735997493084833476849835444339835031436580214492450731100723026312163752403946315983551266206214298679421644737804098691991631489261658890937663698502561036246447760919715595005106669653475931803053499.0) 22180935775581457002090790736532281654456312526625354262953960635330604551829750571440878712430708012807252279301365732385899228826740712544768476577874129759972563823209525283326887563301081200476495752033290851190327066070873711444930389093339915885090143783170994309089448293499799071372787520776773788274677288230540162485916160484352398851925328125588729604931589867889917097887951581817207079060016091919559509735997493084833476849835444339835031436580214492450731100723026312163752403946315983551266206214298679421644737804098691991631489261658890937663698502561036246447588269837247081895893661102600179406635.0)
+  (num-test (+ 17539006966816771902104329685391462527.0 15609797782337099611892065465036826453911053690739041627254619195700021040383385710184052653282070244915503750549545390475671883312314708978681904377133928647935359080875691628246716591529028104762422990155477702994042953196747769893182153631482194578269859879402160062955490194674372351117284129320011166238130774752386987036267064693133554447596069886693581191241594745541512444806003236372840085705813835001957163976961730871756250344335996073970142337882238844723800849054637237549515249957267772181010402413375667537558243971058326641257721901094391380667244006959028327507917720426571969997513984360849930719808.0) 15609797782337099611892065465036826453911053690739041627254619195700021040383385710184052653282070244915503750549545390475671883312314708978681904377133928647935359080875691628246716591529028104762422990155477702994042953196747769893182153631482194578269859879402160062955490194674372351117284129320011166238130774752386987036267064693133554447596069886693581191241594745541512444806003236372840085705813835001957163976961730871756250344335996073970142337882238844723800849054637237549515249957267772181010402413375667537558243971058326641257721901094391380667244006959028327507935259433538786769416088690535322182335.0)
+  (num-test (+ 244901855797156286376563377540855746602.0 -22138106346578776369849317622304392466030036563754663379976505966920461958652141160336156065177498990718609170201272980114106671808245437660234479124938853665375934080221740523696180221118540569603989748587853373569525751680828044059607889572522502629277877343410298879764820905044284757389006201848194571453112545228115550224254565141563427486518108434758694923122284117299374156393942906293546318323661938734959824887786185558612820887463537294120950912969343488704744978847504513710882720654330147775174336365363311173472002077960424794151168301281665765411704505095008907760396535767621855642720080219960822554492.0) -22138106346578776369849317622304392466030036563754663379976505966920461958652141160336156065177498990718609170201272980114106671808245437660234479124938853665375934080221740523696180221118540569603989748587853373569525751680828044059607889572522502629277877343410298879764820905044284757389006201848194571453112545228115550224254565141563427486518108434758694923122284117299374156393942906293546318323661938734959824887786185558612820887463537294120950912969343488704744978847504513710882720654330147775174336365363311173472002077960424794151168301281665765411704505095008907760151633911824699356343516842419966807890.0)
+  (num-test (+ -119403662992279138748600939857239307122.0 26272999248235953724172008428088697264933069743507017434844709711501131900922919455931092196539942532993887162365511473221418376205773427597933886270411672062672089518774390132453916538404354895529975888201032175628249480896964400801763570333497287321002961557096975786141940970260074557095118887294558700145949117395512768347250531196100831164663613049206690894640391431616112104502483838173255614981302462548882276825096564828583591963617871547373532874400764134244496979962241959713525053686209002866840900623246072884125102845824992994967009109046451949348656842486048332953732384499190437432898387573320391878853.0) 26272999248235953724172008428088697264933069743507017434844709711501131900922919455931092196539942532993887162365511473221418376205773427597933886270411672062672089518774390132453916538404354895529975888201032175628249480896964400801763570333497287321002961557096975786141940970260074557095118887294558700145949117395512768347250531196100831164663613049206690894640391431616112104502483838173255614981302462548882276825096564828583591963617871547373532874400764134244496979962241959713525053686209002866840900623246072884125102845824992994967009109046451949348656842486048332953612980836198158294149786633463152571731.0)
+  (num-test (+ 313963939617834410089002930298454269912.0 23286645405607099799151331553995799851855144387826191186590140820016670502830395945076644578998873585162998873396623634135231418574284200209367505115739462344028303923666952261030907434438322884189133236837089851688275865098623902644385995630973049587854251981548128145516004461191094062488421288607625783540996659060285661398859383778209495884203323937672739376151794507745282074538961033778823733980759695886879886017489555795079194346438911010371103435094677167286870898482214310646392174423422237727456012197253183422715313378603607058548706460095379882633958651034759773864354021315490712575535559549015858088608.0) 23286645405607099799151331553995799851855144387826191186590140820016670502830395945076644578998873585162998873396623634135231418574284200209367505115739462344028303923666952261030907434438322884189133236837089851688275865098623902644385995630973049587854251981548128145516004461191094062488421288607625783540996659060285661398859383778209495884203323937672739376151794507745282074538961033778823733980759695886879886017489555795079194346438911010371103435094677167286870898482214310646392174423422237727456012197253183422715313378603607058548706460095379882633958651034759773864667985255108546985624562479314312358520.0)
+  (num-test (+ 2000877973959266893810594143560134441447453310844726478119781029700338468704683515329516333146806175216349912753585564808803731447160643580198590073658869.0 -17993015014355471903.0) 2000877973959266893810594143560134441447453310844726478119781029700338468704683515329516333146806175216349912753585564808803731447160625587183575718186966.0)
+  (num-test (+ 5492930533666246223206322654398877802091439062008700770880939594548305919677404080859141226095489505872709347538974725998600861651942609010590873980143878.0 15372278140141207703.0) 5492930533666246223206322654398877802091439062008700770880939594548305919677404080859141226095489505872709347538974725998600861651942624382869014121351581.0)
+  (num-test (+ -13405500833215428652808705089190188280715732437731292502890523313631564795139560159124390691283401484515088713758307366404145018349044148223082253439210893.0 -14793401891248640808.0) -13405500833215428652808705089190188280715732437731292502890523313631564795139560159124390691283401484515088713758307366404145018349044163016484144687851701.0)
+  (num-test (+ 9945195259699924701593703207751086973468898794114625092150620088406276196469184233537941913755508476427888065765634203723512911676149274871082481174186606.0 8699133332160461067.0) 9945195259699924701593703207751086973468898794114625092150620088406276196469184233537941913755508476427888065765634203723512911676149283570215813334647673.0)
+  (num-test (+ -1785165974800693006461065312083337532938610906605533088558498259067461510781028452552786542598361030690629530721209490413999022804146471920873844686294838.0 -13079925952361275418.0) -1785165974800693006461065312083337532938610906605533088558498259067461510781028452552786542598361030690629530721209490413999022804146485000799797047570256.0)
+  (num-test (+ -4861207515430071951958387366611380234482792653010151054346367776006873932152600469133110239669746470475230906073865131648496652783311445471793936775767736.0 -9381557743227419896.0) -4861207515430071951958387366611380234482792653010151054346367776006873932152600469133110239669746470475230906073865131648496652783311454853351680003187632.0)
+  (num-test (+ -6638723469626495957966112633999375479181736600737250559572415894485618850919815869703127084789143821420728194272094956858541960962483734293877093635361160.0 277811698220276334443479876776376776138.0) -6638723469626495957966112633999375479181736600737250559572415894485618850919815869703127084789143821420728194272094679046843740686149290814000317258585022.0)
+  (num-test (+ 1983880417172931934469534542170437296262471214582817006917470485544552211448284732460451903536334682269123998240709059499894818265755197559390728940140016.0 -118940994129137705779355371753506018694.0) 1983880417172931934469534542170437296262471214582817006917470485544552211448284732460451903536334682269123998240708940558900689128049418204018975434121322.0)
+  (num-test (+ -9354509264984586574958285335910611806441061705184818350015454221731287473282231343722010109181841005578131927454778025302197744540571159656556971614966757.0 120224841184491944160266976391113485817.0) -9354509264984586574958285335910611806441061705184818350015454221731287473282231343722010109181841005578131927454777905077356560048626999389580580501480940.0)
+  (num-test (+ 4389359421234641412950681847970318834150108533025088077429496538447029921663033978550089607257809597829358374972237448178553189381274150213236222139873594.0 106674783386899772113212633712093787897.0) 4389359421234641412950681847970318834150108533025088077429496538447029921663033978550089607257809597829358374972237554853336576281046263425869934233661491.0)
+  (num-test (+ -9319417879153488839579936799737117639058244394679644240663244688680826325564084529474537634510092069422987165268448907193562300482925125162731530249763801.0 192969103435503875767216559494769734726.0) -9319417879153488839579936799737117639058244394679644240663244688680826325564084529474537634510092069422987165268448714224458864979049357946172035480029075.0)
+  (num-test (+ 1394404616168163951844558734723678125985464491792846741433683801962971891047718103736551854371207400145441134823994228143957746922511631911996296931168332.0 -211230038021470285136061932161632203274.0) 1394404616168163951844558734723678125985464491792846741433683801962971891047718103736551854371207400145441134823994016913919725452226495850064135298965058.0)
+  (num-test (+ -2935941510094051560788359387128767361559188973149773593522440619832472030019457317998381634585179453958737810428870232715146002408187749944694186205812791.0 -1221176156661231926164756142840452419679061324806989304452215660535991083923207702827717652226257158321829748247784282139952864899457896871473184473608543.0) -4157117666755283486953115529969219781238250297956762897974656280368463113942665020826099286811436612280567558676654514855098867307645646816167370679421334.0)
+  (num-test (+ -1338674579024795395027232680327531457830908239605718353094975139226848400289367913459076082700361212506196070727982446232782659114647371030398516119682505.0 -1298372177520411182435886041880377054374169787570856408996533471838082317927648953576721017727347029007573543972764860712708420553928791798580799809858729.0) -2637046756545206577463118722207908512205078027176574762091508611064930718217016867035797100427708241513769614700747306945491079668576162828979315929541234.0)
+  (num-test (+ -2072456075229532951804023218627137969798924912365258263779029006567941400203608770518731715660383378937120213112973528605594220795605977413985543331908189.0 -9744489461776287963808523409593616918248399004543154581056479712028497082820841423941781438667661074968238703192056877665754560746003512076830245760254982.0) -11816945537005820915612546628220754888047323916908412844835508718596438483024450194460513154328044453905358916305030406271348781541609489490815789092163171.0)
+  (num-test (+ -2570682164188734368809161664810917340861573482754788446510182252413437925852206735928397938304353826925422441004271229738766803460790995673395984247950088.0 656920705293329551826685120408221577679101260931105312141757138825917579070505267306626244216341686712802796891966598838285570807961966448181138356047523.0) -1913761458895404816982476544402695763182472221823683134368425113587520346781701468621771694088012140212619644112304630900481232652829029225214845891902565.0)
+  (num-test (+ 7846359203342053693101523606887617345982401999003795257520576318451663998927274759872692123323796450295314377046602880394071105863527900699633560551732837.0 3683380639347829102597675045842249667669675715600522157867595962635108482512780509393310714588544837398923613138772339053021025559943198965234376657126821.0) 11529739842689882795699198652729867013652077714604317415388172281086772481440055269266002837912341287694237990185375219447092131423471099664867937208859658.0)
+  (num-test (+ -11692323148567132684205145901751681947225824260005631214936266006610207543813382900867093989444659986091234552140689684476541703112098935301322850961583953.0 -8534276689564199122569555420819240948691777228327984555753862457592427992599992931175844172478864477440165366128106812103785256271256853749622592560655914.0) -20226599838131331806774701322570922895917601488333615770690128464202635536413375832042938161923524463531399918268796496580326959383355789050945443522239867.0)
+  (num-test (+ -10734754884168724884333968138739681643742524619139397687680049322697740991391014196697040576174049452737571835233123127815762146577096625434481167057340772.0 17059878151450238567815178684522345445687980385106446646013863901583786249398194029757376950491550197185231926262467028755342392379269039238766592672298850588065335172902157386017520689203005559576263548017475991638498600879259882041932152385436968424098224966518534467302264172016376096778201462205990822825056602379115848799619564610033123837036507127427054121975400703490855123544706355545059512146550901507159940126280812512339749605195422987937677650572797378799103456094203126081464905326203083057134061673694975250599375795827437561275156235513192978645909947341297774926450637694325145427434486258223666250272.0) 17059878151450238567815178684522345445687980385106446646013863901583786249398194029757376950491550197185231926262467028755342392379269039238766592672298850588065335172902157386017520689203005559576263548017475991638498600879259882041932152385436968424098224966518534467302264172016376096778201462205990822825056602379115848799619564610033123837036507127427054121975400703490855123544706355545059512146550901507159940126280812512339749605195422987937677650572797368064348571925478241747496766586521439314609442534297287570550053098086446170260959538472616804596457209769462541803322821932178568330809051777056608909500.0)
+  (num-test (+ 1982582032974021971225071139786536402936929744496433027195224299475980201425925452469321205602618940472354066218156609448199804973454183972974358405933935.0 -5591374624026484498020036332218412149978824230210339582240360391202660977358546150723165491729699122647688030937226316069237264083850854032732663284717882873051337566653841254365703461654061656817936193716386141166210237666314879751427421825450110467888973152907618520704486700443275358649289847595635931220181024199692771066498714511145489237541761266539978351840438236927937894376002981658065431416811632941197501676956304254109064936038146674412392128883565757325842468006824235119684861972224857533964558963441079998949499582965764591461900562931342373507763081479989957632695010603500633322408246084430203281475.0) -5591374624026484498020036332218412149978824230210339582240360391202660977358546150723165491729699122647688030937226316069237264083850854032732663284717882873051337566653841254365703461654061656817936193716386141166210237666314879751427421825450110467888973152907618520704486700443275358649289847595635931220181024199692771066498714511145489237541761266539978351840438236927937894376002981658065431416811632941197501676956304254109064936038146674412392128883565755343260435032802263894613722185688454597034814467008052803725200106985563165536448093610136770888822609125923739476085562403695659868224273110071797347540.0)
+  (num-test (+ 11532228364136654310006206557545352284448588590560137249197311142901246089838098630841794341370689745410654263817911440601934362503092628725755210859171724.0 -25776236925500995542036591604259749301547568770017466769502569415611770276300787105037848049555500555975152877716727294374436703766730618054071617947449695177320842403963009384468257891933593584757723535299746543328292715942626303315235241470269740287031317322772461137186093930239744879822272349431389779234805703118929710210161489122272898252221025966631463842234537744822906696719691188223105175714602909117904182229960075276443648211003011686250829474364425483901920822837775032295913486152631638908227467242772081310515646217115760180349854601959031626524004201825198439309850266508687796415478396821644422350208.0) -25776236925500995542036591604259749301547568770017466769502569415611770276300787105037848049555500555975152877716727294374436703766730618054071617947449695177320842403963009384468257891933593584757723535299746543328292715942626303315235241470269740287031317322772461137186093930239744879822272349431389779234805703118929710210161489122272898252221025966631463842234537744822906696719691188223105175714602909117904182229960075276443648211003011686250829474364425472369692458701120722289706928607279354459638876682634832113204503315869670342251223760164690255834258791170934621398409664574325293322849671066433563178484.0)
+  (num-test (+ -2603756427337798371354526130541868239006085657393372011847827118826669474695402075575479286172808099892726251004549675772420422527946534088483901153485670.0 -10844269742362409682236511127219508926736627172993604953084481596070757241623728297275447608738915355190715664012379562650777199088096670239050254578284071100042116609747208178716191571268815994455064584659920497876052406993834873124981417288518101426395560764186717660091472734401090302285129741058888303693710456902635092811413971399734306158050053239768185860958896447298052082493590498954512083131068867270078638929796561440903919430094619437872896595720463663570751134804664228918188923926951933302878771189484614604311920655871182974081898031051411394311700207305532216445616083858025977851570522763537300875989.0) -10844269742362409682236511127219508926736627172993604953084481596070757241623728297275447608738915355190715664012379562650777199088096670239050254578284071100042116609747208178716191571268815994455064584659920497876052406993834873124981417288518101426395560764186717660091472734401090302285129741058888303693710456902635092811413971399734306158050053239768185860958896447298052082493590498954512083131068867270078638929796561440903919430094619437872896595720463666174507562142462600272715054468820172308964428582856626452139039482540657669483973606530697567119800100031783220995291856278448505798104611247438454361659.0)
+  (num-test (+ -5929887196386997518766568868806997104240129372360669348628384183712406620199102166145939206783172815805659513128544493795329100599632286529420772709366102.0 24544958491142793859949310604465694574872439331169358241746200808802938771527900616394258199996170862256988647191747967628756772368808644819831481350919782560499270148419601775750932556119448001824346026042068416905254113155445053931789404515589532235225580737103411251232560863878948880220469490014568323308965914171394449781093816607870593225534700167342589927524232815571862258490314644577819742372918446373756857848586825568514909823940075182825283229026250682015641747568282510036326125505522447591703308661608718100933027549520132308555240654655887041040427813131621391320267698106519650611462269033902177180035.0) 24544958491142793859949310604465694574872439331169358241746200808802938771527900616394258199996170862256988647191747967628756772368808644819831481350919782560499270148419601775750932556119448001824346026042068416905254113155445053931789404515589532235225580737103411251232560863878948880220469490014568323308965914171394449781093816607870593225534700167342589927524232815571862258490314644577819742372918446373756857848586825568514909823940075182825283229026250676085754551181284991269757256698525343351573936300939369472548843837113512109453074508716680257867612007472108262775773902777419050979175739613129467813933.0)
+  (num-test (+ -8848084327536592532063677611386811805244460767433749071435930786126721080365289638381557872263825830664387392539638767251180242665642373539064690745095464.0 -15917950175678012281826361248776190984758236997789474333609547749168308439513527143790323694526378056113636462939674273462177686456811495629631337058042159570336251822399402513133598701991665209363955263097315081570618652783181494594400709239428597117944511110842795526862595552977665064029517628515465251448116061875878430407784298951946811321795808932206846491091803276390661869369638950672478828532423383951689632136029256108992610781912267083149156104328033893238864631158195280554850035949666897861529711006187241710164902350100555999894332438423857208747342184052953230247487231455921360593096823760117493579248.0) -15917950175678012281826361248776190984758236997789474333609547749168308439513527143790323694526378056113636462939674273462177686456811495629631337058042159570336251822399402513133598701991665209363955263097315081570618652783181494594400709239428597117944511110842795526862595552977665064029517628515465251448116061875878430407784298951946811321795808932206846491091803276390661869369638950672478828532423383951689632136029256108992610781912267083149156104328033902086948958694787812618527647336478703105990478439936313146095688476821636365183970819981729472573172848440345769886254482636164026235470362824808238674712.0)
+  (num-test (+ -16314775600714318471451792035636584056297958597339492996728118376578145765736873313518831390349547274517050864260054903974054712997529177834428786007341762649083404743713562157667828894017440065599882523458121037421757904691003094608420565550031561905074671735751685371533975894842331113347413787808917193134135744321547478500861021485075363990553639161661734684228250909589741380076008551020384304303171431833670236949934603973673998262066558668396388979463892768199916011368116729432353268535563246463324517035331079693172060671712718486388759443825620676228470068291448236914050793177812037679396721657020438979754.0 12553426083939460917.0) -16314775600714318471451792035636584056297958597339492996728118376578145765736873313518831390349547274517050864260054903974054712997529177834428786007341762649083404743713562157667828894017440065599882523458121037421757904691003094608420565550031561905074671735751685371533975894842331113347413787808917193134135744321547478500861021485075363990553639161661734684228250909589741380076008551020384304303171431833670236949934603973673998262066558668396388979463892768199916011368116729432353268535563246463324517035331079693172060671712718486388759443825620676228470068291448236914050793177812037679384168230936499518837.0)
+  (num-test (+ 20637030084881771176788188367974505419050866216433677435050410899110162793040751338330447574748263391136356400036001988938659722098883893353523409458775455519257672423829361150611806294256710309281788819450225670112435352092313483086404714074567539245791066202051788986426960935796927738180831688497683293306590464598379493141645539253898709000874685535467854788184424886911457134522632486730390913239660179785071885982403741669161655812015114272497907946919026898579927936299607156006210124954460880383605958519412435713868501997649784658832599101777001703519408664662715322044086646014163774269660274683400619225321.0 11620128128044940816.0) 20637030084881771176788188367974505419050866216433677435050410899110162793040751338330447574748263391136356400036001988938659722098883893353523409458775455519257672423829361150611806294256710309281788819450225670112435352092313483086404714074567539245791066202051788986426960935796927738180831688497683293306590464598379493141645539253898709000874685535467854788184424886911457134522632486730390913239660179785071885982403741669161655812015114272497907946919026898579927936299607156006210124954460880383605958519412435713868501997649784658832599101777001703519408664662715322044086646014163774269671894811528664166137.0)
+  (num-test (+ -9838804688358141062268493389453191808060717708062736103828856866310283812230958467655270667206937622979717683919584610288962829724022506216738929136418489468786902364550847498615864720240589837282441807174290461916292258263929411081218952357662703079709351365960916688275651864441386750529258343003652300629003597744958152243494244227986280506395347894285277364095898602965258114321853474000520432831298793365139040664543928707100657375292032051256485942532600998813627925626928634068613637417702688610315924917761411247617905738119218110678854564441914784262998574445847209847985439514580300936248281049628734475702.0 2380166482232871816.0) -9838804688358141062268493389453191808060717708062736103828856866310283812230958467655270667206937622979717683919584610288962829724022506216738929136418489468786902364550847498615864720240589837282441807174290461916292258263929411081218952357662703079709351365960916688275651864441386750529258343003652300629003597744958152243494244227986280506395347894285277364095898602965258114321853474000520432831298793365139040664543928707100657375292032051256485942532600998813627925626928634068613637417702688610315924917761411247617905738119218110678854564441914784262998574445847209847985439514580300936245900883146501603886.0)
+  (num-test (+ -30961575335426221869515496362216292453766907587859856766456625722888557357647164641922707199324601608700561081422636642523431947551124957385652791834855425829101761914145137205962610515642614866296480715893528289170482422505734612327038754622917335073993027434927547277037587173529054849390646376806910407207016292483185533697336599641898250465186168797820802225861771331652801064811222606773495565340386327294310913503461903243119204619412324538886439122443769008953829820425376589389335553937319588224864611583436327810214798652896733118881040503785110481197462772022447173744898802421806800203373153221004361953729.0 -10586442965055062759.0) -30961575335426221869515496362216292453766907587859856766456625722888557357647164641922707199324601608700561081422636642523431947551124957385652791834855425829101761914145137205962610515642614866296480715893528289170482422505734612327038754622917335073993027434927547277037587173529054849390646376806910407207016292483185533697336599641898250465186168797820802225861771331652801064811222606773495565340386327294310913503461903243119204619412324538886439122443769008953829820425376589389335553937319588224864611583436327810214798652896733118881040503785110481197462772022447173744898802421806800203383739663969417016488.0)
+  (num-test (+ 8835746018617511846981408800319983340292665114153404569022025834059427359831684523399830234196625160662387716033871154398104436720494608541518837969397374272734698261557358249258503982414578618525420572597611597792132117034895074841909295420434392963714805547538976612884853497014341345150095544449860198192757839489063747595073430612069212219930749783824683135433987509303139260133564905961552149844964215891730262218278214035649706577154652729844092199333026620127958228847111442161350881527928460177763370427262298116900358910460957772350452949782281117704005514462730290063772968929608448642592954601418753021512.0 -12227722924075527556.0) 8835746018617511846981408800319983340292665114153404569022025834059427359831684523399830234196625160662387716033871154398104436720494608541518837969397374272734698261557358249258503982414578618525420572597611597792132117034895074841909295420434392963714805547538976612884853497014341345150095544449860198192757839489063747595073430612069212219930749783824683135433987509303139260133564905961552149844964215891730262218278214035649706577154652729844092199333026620127958228847111442161350881527928460177763370427262298116900358910460957772350452949782281117704005514462730290063772968929608448642580726878494677493956.0)
+  (num-test (+ -5455184800550144006991157215735481579353213544152145628297990102571936052187486515129266239245491863623978659179559754999567936067584384479787934704340911556625153536160778495579370425428019248950494107696016864499055854257192071541354806671987402367524770228296322497224645429524493838356022616251290117624472061673033274133156467148770562815676767117605001434288573911556053311048284534341905722947046607192815465807736361991479044698448267471087552952494477144251510778491315012457514838113324210534577956298926109164909779987221094000880908857594198276812276890284008572664102792405452379662935026125770444036994.0 -7349798942312432150.0) -5455184800550144006991157215735481579353213544152145628297990102571936052187486515129266239245491863623978659179559754999567936067584384479787934704340911556625153536160778495579370425428019248950494107696016864499055854257192071541354806671987402367524770228296322497224645429524493838356022616251290117624472061673033274133156467148770562815676767117605001434288573911556053311048284534341905722947046607192815465807736361991479044698448267471087552952494477144251510778491315012457514838113324210534577956298926109164909779987221094000880908857594198276812276890284008572664102792405452379662942375924712756469144.0)
+  (num-test (+ 27233955893140063612427006607965940109569052437681267421929959186535416115028420267622879017163568256526042146282241931623674996867133390355390677118211537487769195270234259640386625552763891339073878417517169618832945750393661600092643257470064376916337734385887099957095417541169462231630821139075814859604097878094729685589777579267192538715202397220666651307185763054526407234767132218634060693076054116575833737797189157152326979078121760900891899319809724675232853322526718686306470372869701173824664984405178677187081936624687293494821338781534163633206006387449585716391843039459733925494003066841874935048611.0 -66646390577667468207341453008390168215.0) 27233955893140063612427006607965940109569052437681267421929959186535416115028420267622879017163568256526042146282241931623674996867133390355390677118211537487769195270234259640386625552763891339073878417517169618832945750393661600092643257470064376916337734385887099957095417541169462231630821139075814859604097878094729685589777579267192538715202397220666651307185763054526407234767132218634060693076054116575833737797189157152326979078121760900891899319809724675232853322526718686306470372869701173824664984405178677187081936624687293494821338781534163633206006387449585716391776393069156258025795725388866544880396.0)
+  (num-test (+ 15030400024888781078933103028897733817304421960545019199443871381537070197157227994520524631721701055962609956080413517776229513420814407790533237358129529547793422514837651333555776540939235592155512951229106778709351772195248438493792786143040421233061520515971787881798980515709417481015662862327435825812557205663033601853937647320838585333754027488605638576977560072206293290493215523194883494322543800546276353830683084405428005815296131527861252717516620765986589669237487765523936713749717927502645633123584240464131140829496052170285171610845098023517906586134613874506419828208611247177336492131262918439281.0 -164048419232636429449474429717211197442.0) 15030400024888781078933103028897733817304421960545019199443871381537070197157227994520524631721701055962609956080413517776229513420814407790533237358129529547793422514837651333555776540939235592155512951229106778709351772195248438493792786143040421233061520515971787881798980515709417481015662862327435825812557205663033601853937647320838585333754027488605638576977560072206293290493215523194883494322543800546276353830683084405428005815296131527861252717516620765986589669237487765523936713749717927502645633123584240464131140829496052170285171610845098023517906586134613874506255779789378610747887017701545707241839.0)
+  (num-test (+ -10227062646189307616073129048534031298512434237226774743330733206156788005874968173984804649812506029813402205606562016228122184161577517837608957023376079537037472977098465137152327215807765130656192272994478964341604278041664840636982572214751638093860605132350960802560601354006634296348422600320863531059118477125143903734159707623839282511184908969206873548650544269932394344952983661665472663102992782521888857016369837211403335306200813816060883478434441858442549261115972947741929087886423170398410216855322384956160289855500229952405068604320121652911887067414460828300146993858360430784079225137421074839819.0 117460076430162201914796277915447781936.0) -10227062646189307616073129048534031298512434237226774743330733206156788005874968173984804649812506029813402205606562016228122184161577517837608957023376079537037472977098465137152327215807765130656192272994478964341604278041664840636982572214751638093860605132350960802560601354006634296348422600320863531059118477125143903734159707623839282511184908969206873548650544269932394344952983661665472663102992782521888857016369837211403335306200813816060883478434441858442549261115972947741929087886423170398410216855322384956160289855500229952405068604320121652911887067414460828300029533781930268582164428859505627057883.0)
+  (num-test (+ 27989453264793973121573869640708223239762902243991948581280654553806618470632044367386680716040316895884976837122054709584963028986161694425215067648887944710852278135008221491665079705797192389681328802747226171436158375378499411314855257919224316919346771317457123252623293612958336691335423245293660257386649100685560072354549579281852792682734916555498283053758141666658137856828164206947320523255487437004565021167276952652515632644458005291855624829941937578229983628962137595011570216766689546500517528191189928660433013004254032861383790553611840534023221000900694995707453499030166286828319347894538505334235.0 -59175168207571178843658955348404514921.0) 27989453264793973121573869640708223239762902243991948581280654553806618470632044367386680716040316895884976837122054709584963028986161694425215067648887944710852278135008221491665079705797192389681328802747226171436158375378499411314855257919224316919346771317457123252623293612958336691335423245293660257386649100685560072354549579281852792682734916555498283053758141666658137856828164206947320523255487437004565021167276952652515632644458005291855624829941937578229983628962137595011570216766689546500517528191189928660433013004254032861383790553611840534023221000900694995707394323861958715649475688939190100819314.0)
+  (num-test (+ 1178650930337394440162727078866515771626896502845852711186000991913866844090831426017480263676964607121490209778220339316756171449922437605552456088105443130477974682689512446683178356259305893852096425478878588001446154476458310269704392486398646169362313605456233489086567865316333034897433650974160168545492823208575634152241341906068149887959566983066154182855136114289266802474404127414747112706158621650063987662749553991791509795764642256261917497984177610694405881831052199417235241109412927893781778469398975117797578753730248539151297798807326284978255001046995523851829184120171969918537718488250577987049.0 -151873924489040812813761508259707631973.0) 1178650930337394440162727078866515771626896502845852711186000991913866844090831426017480263676964607121490209778220339316756171449922437605552456088105443130477974682689512446683178356259305893852096425478878588001446154476458310269704392486398646169362313605456233489086567865316333034897433650974160168545492823208575634152241341906068149887959566983066154182855136114289266802474404127414747112706158621650063987662749553991791509795764642256261917497984177610694405881831052199417235241109412927893781778469398975117797578753730248539151297798807326284978255001046995523851677310195682929105723956979990870355076.0)
+  (num-test (+ 28233332719950979786871881804755080223325040620170668729385709165879717973040387558150293205758215739710262749733170837042434162049732587908182282319848154049410849721309988807368466228286699721201975848741931128639324322061892706638973259354962358866000024260698793885547287093369940035337370984725857550291339492871017395328145015077506882578124550084937438336881072124376107623716831044079223921566902242543198986921476998895559488862309653154914291349588095330683589871173449191854284433182368052817373384461363574550061788800329400860372148193491004593903732351395815409821222597665222975816418433744748143385431.0 -43245950360315656184924888243641533635.0) 28233332719950979786871881804755080223325040620170668729385709165879717973040387558150293205758215739710262749733170837042434162049732587908182282319848154049410849721309988807368466228286699721201975848741931128639324322061892706638973259354962358866000024260698793885547287093369940035337370984725857550291339492871017395328145015077506882578124550084937438336881072124376107623716831044079223921566902242543198986921476998895559488862309653154914291349588095330683589871173449191854284433182368052817373384461363574550061788800329400860372148193491004593903732351395815409821179351714862660160233508856504501851796.0)
+  (num-test (+ 17311283930487575047109155431670372891723312431004343097275158353815289445461275098157423001160013464866170709729134076291306322952612660169010483426086431377525432637844274608988581691477819008626983761905899834444008235608280930166913911248710072733217113558125600345343437000427963292980921009445490627620344145866648036116660335905940809860199697939729919140888034303887423527841395304960072549430314367914315102150378504502158659627719016733307736583749830415574905929299482373462584995162798576853564481617711234957058703455021082855018642616999836886763535412642684228990890160568207941504887072856663966242787.0 1954009743321912552050341299974626734964446274711484506734354360114801426013796892421541915293157994203607853436799102383078659985249097057923578528366737.0) 17311283930487575047109155431670372891723312431004343097275158353815289445461275098157423001160013464866170709729134076291306322952612660169010483426086431377525432637844274608988581691477819008626983761905899834444008235608280930166913911248710072733217113558125600345343437000427963292980921009445490627620344145866648036116660335905940809860199697939729919140888034303887423527841395304960072549430314367914315102150378504502158659627719016733307736583749830417528915672621394925512926295137425311818010756329195741691413063569822508868815535038541752179921529616250537665789992543646867926753984130780242494609524.0)
+  (num-test (+ 1135960177108146621604027872788612991247811085764456406834564014092038611848908717507207251239454266163702244932570537009884467598603226302482406831131219148530146321028801515381981782506355042255201016953375149829517466449677312249611502599434850555618739830488706171667035140895674806873502543300909514568759918040129665855731078258004983486524477103833885001539135541445685573269814159175744401893663504523858005835387122082112362666991112899837534230326730196110477118156871579503345757821268248575583821695674912517830056856597644827244194658166928026249459511837772775196175188368236573504643083995409774002567.0 -5513982495816270388232134254127393284677692173792609278582774509636977743203029647121158805174638642867428501907786521939155900331399058909602425073976766.0) 1135960177108146621604027872788612991247811085764456406834564014092038611848908717507207251239454266163702244932570537009884467598603226302482406831131219148530146321028801515381981782506355042255201016953375149829517466449677312249611502599434850555618739830488706171667035140895674806873502543300909514568759918040129665855731078258004983486524477103833885001539135541445685573269814159175744401893663504523858005835387122082112362666991112899837534230326730190596494622340601191271211503693874963897891647903065633935055547219619901624214547537008122851610816644409270867409653249212336242105584174392984700025801.0)
+  (num-test (+ -30369736932762868789456108597366835061749107555998091727589163626331595118680326568212941898571309672187038272915036839449380083450246957904300051802617002374912724325419651633014408152565340519439718081357147324136023867003917288524338643759680061563616479323818330115572573568245719292922176485298767387601922362893307843067637295955606642841006993776777666041277965868780958830666697755738164183356399977211227424725670822944234275611849032230010745799964550976844117943559190671369193871330514473741920389633762695829790016565565261170688485790141638094160105909405353382982945608773290740598479367828342651860878.0 3451570547959142767282758882796967240086418127970526029661337442068316209707489088420708984628065070358319478649952710478991064476168799556496237099109563.0) -30369736932762868789456108597366835061749107555998091727589163626331595118680326568212941898571309672187038272915036839449380083450246957904300051802617002374912724325419651633014408152565340519439718081357147324136023867003917288524338643759680061563616479323818330115572573568245719292922176485298767387601922362893307843067637295955606642841006993776777666041277965868780958830666697755738164183356399977211227424725670822944234275611849032230010745799964550973392547395600047904086434988533547233655502261663236666168452574497249051463199397369432653466095035551085874733030235129782226264429679811332105552751315.0)
+  (num-test (+ 24749014370880469345815230363662696846133977441600857690896762642529872426102613384561609594131771018575590861342023688138502403609639138062665279129058939911797019091643704220495944170754490238422880589600838613701783818105188827633578438439212856537589855796204839275633245851474930725845096235668385012500773524750522781174430369067441632028068262240870795850561389232369373523415592833273932285308223863420210049445377497367753786125779044716949754454461623397410528064697616617917065021866397277409044449982605591256067763430930720398889239414812509701319783809830072841056369381573100589260104551934136733317845.0 -9461623592584966196513107657889418526847060851423069480904645009418813160370721071067349946095573698635859409908288864150475056170059858850823883834932131.0) 24749014370880469345815230363662696846133977441600857690896762642529872426102613384561609594131771018575590861342023688138502403609639138062665279129058939911797019091643704220495944170754490238422880589600838613701783818105188827633578438439212856537589855796204839275633245851474930725845096235668385012500773524750522781174430369067441632028068262240870795850561389232369373523415592833273932285308223863420210049445377497367753786125779044716949754454461623387948904472112650421403957363976978750561983598559536110351422754012117560028168168347462563605746085173970662932767505231098044419200245701110252898385714.0)
+  (num-test (+ 19070246171469235561279483225919489206942407814032615339351735800304747459507922411906751965555240682457214768298108831815622470433175555196912899313888991765436434867025639919521068437191248198117664398275835972573354886915721765715992151871453808224011999677700078879590132676060988550961950472536029228350169237717222998397029428440792110955380302156159849645211726041489206565536560827557279129751110297078563108009278363910936720061216511798518178957070787710331228500533067546198458251241005176280410230146430275074766072259256583499095689284871987010372039977403712023630453400259082684930755893684499232318008.0 12330599952818018622104330691506128012101935028731995985677032980931398338453806827555760801312052792065671886621851470997557806941112316627790755867100463.0) 19070246171469235561279483225919489206942407814032615339351735800304747459507922411906751965555240682457214768298108831815622470433175555196912899313888991765436434867025639919521068437191248198117664398275835972573354886915721765715992151871453808224011999677700078879590132676060988550961950472536029228350169237717222998397029428440792110955380302156159849645211726041489206565536560827557279129751110297078563108009278363910936720061216511798518178957070787722661828453351086168302788942747133188382345258878426260751799053190654921952902516840632788322424832043075598645481924397816889626043072521475255099418471.0)
+  (num-test (+ -20895998178036569919774658790651496115060841511658297683195804524712012347695091074325978179977718571444320688167469052862702339462089668992243209990795362064005869602003990235714500149401994013174762139297327430396441552225926368085284222509085197484452650071390132794942944512235132641643003294762547138305644086106533258432786768644384855008506026923783604514268955071498269812887794817192371944269611642901807443894686178438687102834127061425955994253034824027771176714559050403098437684091684851207513969915720607528045624635094984539637789113651579846373399975502788877555747414523231999341294756679330384323996.0 764238600803843266244444637050072967342049538611688895792923539838804953492110953673720766879606601435939162680753428779068917662740403667549850724878795.0) -20895998178036569919774658790651496115060841511658297683195804524712012347695091074325978179977718571444320688167469052862702339462089668992243209990795362064005869602003990235714500149401994013174762139297327430396441552225926368085284222509085197484452650071390132794942944512235132641643003294762547138305644086106533258432786768644384855008506026923783604514268955071498269812887794817192371944269611642901807443894686178438687102834127061425955994253034824027006938113755207136853993047041611883865464431304031711735122084796290031047526835439930812966766798539563626196802318635454314336600891089129479659445201.0)
+  (num-test (+ 6243894672855694190803081952962387322599009058758027960092936187687064819462191583137945440936085088260632250436567758576422207449236613172605950116622271404444221039084346501796818945639456207912207604248991842124079786471250102192718092353598850889806607728696519257402580732995770031331187089424192803722612735557735028710899438934171272639518928194764526910590046378401600819132587804143949995694950116915803127294011661411525934100144319021440919928013617766507409909846670172516021888661284467975865076091834094160862228180625536450124272957206172214541444266874056050295270719541605687740822711659847211976891.0 11877496607682442993105675644902145742318375725225741293060927105303783712520284640625374957608051032540491531573337817824773543104969422017506696018037874641947740606655370938613842356322585858034851150595788166740174872996252792014218946552442572806242471174234462119454014379628228878122072189387777413014452140618318641689597452676091677588204537830401725113931418426919671512011822864583481449136550835952005765386885680701637038206002172218712504732572449659704181315669255320876647592649071711438131711904976335957846353867776093588236311654631696625859173554395714740218099921290128795607292259527492722462071.0) 18121391280538137183908757597864533064917384783983769253153863292990848531982476223763320398544136120801123782009905576401195750554206035190112646134660146046391961645739717440410661301962042065947058754844780008864254659467502894206937038906041423696049078902930981376856595112623998909453259278811970216737064876176053670400496891610262950227723466025166252024521464805321272331144410668727431444831500952867808892680897342113162972306146491240153424660586067426211591225515925493392669481310356179413996787996810430118708582048401630038360584611837868840400617821269770790513370640831734483348114971187339934438962.0)
+  (num-test (+ -24023960171862805266003610953999097357395283354964456554686635290239019705581779621120391229617494503580661676939681517550103414632840981987397485411400553792707518662609532504246677658012933762605038799352109564432278094548068984563394926376371580465135388578139331334464060067790936072127680597181415407099723844313625277987147283697141407959289588588489162704824409673099509423520008795428217612706997355591985894255450783091681112776112997887084157623388943538145736618168104404283342039105202585543852590302154958791010622670839015475427693311663800177428904406869645066988663292128104453773413982185343111560886.0 -31939808827732134714870375774276102357277346245583282398423150631754622253109692213928642228787888509211781331649081002266227303203259124984426497846441848502574293640959494009564992092503141598640200823656998243767453860939156780549404892392521391484933772285520949470194562525777116137058001008184603332597820522016200623301007194309404025522056113671560767212894303567191067178003014955596425115379852712737129325098876542459702682095445350281859042779889411325882123213577906096942649941285655935053362468972482748617111598313960198743596285343178242282172686940700127068972627110105953098737923773182254460772630.0) -55963768999594939980873986728275199714672629600547738953109785921993641958691471835049033458405383012792443008588762519816330717836100106971823983257842402295281812303569026513811669750516075361245239623009107808199731955487225765112799818768892971950069160863660280804658622593568052209185681605366018739697544366329825901288154478006545433481345702260049929917718713240290576601523023751024642728086850068329115219354327325551383794871558348168943200403278354864027859831746010501225991980390858520597215059274637707408122220984799214219023978654842042459601591347569772135961290402234057552511337755367597572333516.0)
+  (num-test (+ 14513652183174940741664411990199277445706189147726874603036586212536012746892966848269748909379750612027025331446918381470766609543142456872580466135425754204680927122749772612276850998180593344389487924747722210296498854143380696064338777945015153982467675141485724865534995199700908286263993697988986805404864429385840512740226775506122190698806967785494289035976495492863456705096841250592980439363856397663738211335801835896091823148249303370609165910779981271035234045185574995335952208702661648744928539539455138167482396767268362221492607154709559716065850417221174683768503217544145599044845325824451589309835.0 -12814535978730024053359592817368712576084646962861720729844389627130663192435154658607204342320327460695280260731620465435530495952836598646143907272825807563512741964987882356778796849529260646503692618525570185450780889283642116889481314560395290434301143877809550098309214046129802023655714098730144464028249594406616074059558969757405392170810220921023905546104487938441503430332099605473144930508420331873995741851604525954472341693863067199617721032815462094767522339305487934030130207039176659398466616780628644572276059410087128533031562978399689702766028716401176531098447698206272762966470643604141938670152.0) 1699116204444916688304819172830564869621542184865153873192196585405349554457812189662544567059423151331745070715297916035236113590305858226436558862599946641168185157761890255498054148651332697885795306222152024845717964859738579174857463384619863548166531263676174767225781153571106262608279599258842341376614834979224438680667805748716798527996746864470383489872007554421953274764741645119835508855436065789742469484197309941619481454386236170991444877964519176267711705880087061305822001663484989346461922758826493595206337357181233688461044176309870013299821700819998152670055519337872836078374682220309650639683.0)
+  (num-test (+ 11356479761814008572465147431830778885327227506593483181241437802252618729479905490826767363633131720717461693888023278837835457496021519184903984385091047829540007466025527592005114414671285638168997562037691602144751434208304408870143450743278437854754504713023422097017723330207792526222436928747286558205279330508360438281011315147578105966454344087225699378388309094140949428028313539634103047841948634832398526343605363013644180832752120081735152285507591096001749463421326282317713079361827765412853023201330345752038722069405404812511739634687282327711258974520622248165974215116400638833123609666501349513623.0 -2451734542868054449539778460457497703609327132304922810342762480808881050209276687756391911546806187586640918078231508181876445466503459873508196878629364924241891220686182517218825181707207808769770392864734466652524094735160185556148554260517746279303022469784592528209667497664672945900929888144529727881050106027775707933311860110618130543481573815538047460723253898548348335762406437618625388229555824532715231231491787570056329865617082709588903922431713098922691537317839185452018617461891748518176708607861270770493263960554805373552348256747200291438630960804647686832667981625018361034564086859426490014044.0) 8904745218945954122925368971373281181717900374288560370898675321443737679270628803070375452086325533130820775809791770655959012029518059311395787506461682905298116245339345074786289232964077829399227169172957135492227339473144223313994896482760691575451482243238829568808055832543119580321507040602756830324229224480584730347699455036959975422972770271687651917665055195592601092265907102015477659612392810299683295112113575443587850967135037372146248363075877997079057926103487096865694461899936016894676314593469074981545458108850599438959391377940082036272628013715974561333306233491382277798559522807074859499579.0)
+  (num-test (+ -1814184401790217165873937825605141478060935014868566665644215718762341535891730598045990231798382966074312671040257824056876679135909008140059087311700216658095793352051583071432744886316274989901835606602224927350560604355249919901932382803472476702792978322468747380191775778902733911968522382089332819162367884984027854067607561808704316828316820133400099093450636968732151876570835173932998599031643640476109466728761033062776578175554441947411139184426213290292577467587355369954997241091769769542810051228504545831588488726789173405585678190671534386784806998695797717346491308862362775748058331375692317599945.0 15466182953987394334491149436346080039471412309427279110582769586053943302670765125931570041904640518032832554998553018838321871748542118021556398569294085708441934948186080236498081517178574839977996802813431873543309853609838200338534343580791382510179184571852290959723696010410340740895530535423959476873857191548113125728667781953125153120447892632916574768078583174099545013854248664119997703948998871566374080719541931440495888606776561795893839624084254684939434035018741535261951124673664746010067859317726891535170781460914710499572006592206360512398012457295755926986236618644330364227754380084585899275327.0) 13651998552197177168617211610740938561410477294558712444938553867291601766779034527885579810106257551958519883958295194781445192612633109881497311257593869050346141596134497165065336630862299850076161196211206946192749249254588280436601960777318905807386206249383543579531920231507606828927008153334626657711489306564085271661060220144420836292131072499516475674627946205367393137283413490186999104917355231090264613990780898377719310431222119848482700439658041394646856567431386165306953883581894976467257808089222345703582292734125537093986328401534826125613205458599958209639745309781967588479696048708893581675382.0)
+  (num-test (+ -27127130599753372624001250456405972983012981437652156246797208697430661165612459362971759027335854588888552031022264244768883843080959804690580574272908031271224646245152017114094021048441971097191444782106551075175878815012595015584723250801765859461211934306789890718268168352614164589637346918581658850565274510502652089457352942736418509881708568727739912127781455473660768550022762222130489047215089836402367851853412705556570667960548570630054608024914653686223423908494006675057953013815512203710764854485332282975729323105427143207127239069826750682633272289409910001698385240596625059970587393681128674617278.0 5719655139276246085992066702308194672442413085748146924567717361937179810269300239821879673460959112727066470468217892213025828988023367028158410455624528688729907493639908638553730770145274142147983721694721139760883483821883267129411125364089207412089113869427479340283853501026803387874124668123626271531796990801822527792189514551888019206405597994403243358155410088320317141454525417323186389587327532772638942220300149829241141659063128602316305332848477566686425551944956989370838072872906293845914921103561360871571846865478762953536949621421094416539099628942010528483544062050170673327754206501716239719529.0) -21407475460477126538009183754097778310570568351904009322229491335493481355343159123149879353874895476161485560554046352555858014092936437662422163817283502582494738751512108475540290278296696955043461060411829935414995331190711748455312125437676652049122820437362411377984314851587361201763222250458032579033477519700829561665163428184530490675302970733336668769626045385340451408568236804807302657627762303629728909633112555727329526301485442027738302692066176119536998356549049685687114940942605909864849933381770922104157476239948380253590289448405656266094172660467899473214841178546454386642833187179412434897749.0))
+
+(test (+ 1 #f) 'error)
+(test (+ 1 #t) 'error)
+(test (+ 1 + 2) 'error)
+(test (+ 1 - 2) 'error)
+(test (+ 1 2 . 3) 'error)
+(test (+ 1 . 2) 'error)
+;; check error arg number
+(catch #t (lambda () (+ 1 #())) (lambda (type info) (test (apply format #f info) "+ second argument, #(), is a vector but should be a number")))
+(catch #t (lambda () (+ 1.0 #())) (lambda (type info) (test (apply format #f info) "+ second argument, #(), is a vector but should be a number")))
+(catch #t (lambda () (+ 23 #())) (lambda (type info) (test (apply format #f info) "+ second argument, #(), is a vector but should be a number")))
+(catch #t (lambda () (+ #() 1)) (lambda (type info) (test (apply format #f info) "+ first argument, #(), is a vector but should be a number")))
+(catch #t (lambda () (+ #() 1.0)) (lambda (type info) (test (apply format #f info) "+ first argument, #(), is a vector but should be a number")))
+(catch #t (lambda () (+ 1 2 #())) (lambda (type info) (test (apply format #f info) "+ third argument, #(), is a vector but should be a number")))
+(catch #t (lambda () (+ 1 2 3 #())) (lambda (type info) (test (apply format #f info) "+ fourth argument, #(), is a vector but should be a number")))
+
+(num-test (+ most-positive-fixnum most-positive-fixnum) 1.844674407370955e+19)
+(num-test (+ most-negative-fixnum most-positive-fixnum) -1)
+;;; these 4 are a problem (the overflow stuff in gcc gives inccorect results)
+;(num-test (+ most-positive-fixnum 1) 9.223372036854776e+18)
+;(num-test (- most-negative-fixnum 1) -9.223372036854776e+18)
+;(num-test (+ most-negative-fixnum -1 most-positive-fixnum) (+ most-negative-fixnum most-positive-fixnum -1))
+;(num-test (+ most-negative-fixnum -100000 most-positive-fixnum) (+ most-negative-fixnum most-positive-fixnum -100000))
+
+;;; an optimizer test
+(let ()
+  (define (hi a b c)
+    (+ (+ 1 (* 2 b))
+       (+ a (* b c))
+       (+ (* a b) c)
+       (+ (* a 3) 4)))
+  (num-test (hi 5 6 7) 116))
+
+(for-each
+ (lambda (arg)
+   (test (+ arg +nan.0) 'error)
+   (test (+ +nan.0 arg) 'error)
+   (test (+ arg +inf.0) 'error)
+   (test (+ +inf.0 arg) 'error)
+   (test (+ arg) 'error)
+   (test (+ 0 arg) 'error)
+   (test (+ 0.0 arg) 'error)
+   (test (+ 1 arg) 'error)
+   (test (+ 1/2 arg) 'error)
+   (test (+ 1.0 arg) 'error)
+   (test (+ 1+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(unless with-bignums
+  ;; g_add|subtract_x1
+  (test (let ((false #f)) (define (func) (do () ((not false) (+ (*s7* 'most-positive-fixnum) 1)))) (type-of (func))) 'float?)
+  (test (let ((false #f)) (define (func) (do () ((not false) (- (*s7* 'most-negative-fixnum) 1)))) (type-of (func))) 'float?))
+
+
+;;; --------------------------------------------------------------------------------
+;;; -
+;;; --------------------------------------------------------------------------------
+
+(num-test (- -0) 0)
+(num-test (- -0.0) 0.0)
+(num-test (- -0.0+0.00000001i) 0.0-0.00000001i)
+(num-test (- -1.0 0.0) -1.0)
+(num-test (- -1.0) 1.0)
+(num-test (- -1.0+1.0i -1.0+1.0i) 0.0)
+(num-test (- -1.0+1.0i 0) -1.0+1.0i)
+(num-test (- -1.0+1.0i 0.0) -1.0+1.0i)
+(num-test (- -1.0+1.0i 0.0) -1.0+1.0i)
+(num-test (- -1.0+1.0i 0.0+1.0i) -1.0)
+(num-test (- -1.0+1.0i 1) -2.0+1.0i)
+(num-test (- -1.0+1.0i 1.0) -2.0+1.0i)
+(num-test (- -1.0+1.0i 1.0+1.0i) -2.0)
+(num-test (- -1.0+1.0i 1/1) -2.0+1.0i)
+(num-test (- -1.0+1.0i 123.4) -124.4+1.0i)
+(num-test (- -1.0+1.0i 1234) -1235.0+1.0i)
+(num-test (- -1.0+1.0i 1234/11) -113.18181818181819+1.0i)
+(num-test (- -1.0+1.0i) 1.0-1.0i)
+(num-test (- -10) 10)
+(num-test (- -10/3) 10/3)
+(num-test (- -1234000000) 1234000000)
+(num-test (- -1234000000.0) 1234000000.0)
+(num-test (- -1234000000/10) 1234000000/10)
+(num-test (- -2 0) -2)
+(num-test (- -2) 2)
+(num-test (- -2/2 0/1) -2/2)
+(num-test (- 0 -1.0+1.0i) 1.0-1.0i)
+(num-test (- 0 0) 0)
+(num-test (- 0 0.0) 0.0)
+(num-test (- 0 1 -1.0+1.0i) 0.0-1.0i)
+(num-test (- 0 1 0.0) -1.0)
+(num-test (- 0 1 1) -2)
+(num-test (- 0 1 1.0+1.0i) -2.0-1.0i)
+(num-test (- 0 1 123.4) -124.4)
+(num-test (- 0 1 1234/11) -1245/11)
+(num-test (- 0 1.0 -1.0+1.0i) 0.0-1.0i)
+(num-test (- 0 1.0 0.0) -1.0)
+(num-test (- 0 1.0 1) -2.0)
+(num-test (- 0 1.0 1.0+1.0i) -2.0-1.0i)
+(num-test (- 0 1.0 123.4) -124.4)
+(num-test (- 0 1.0 1234/11) -113.18181818181819)
+(num-test (- 0 1.0+1.0i -1.0+1.0i) 0.0-2.0i)
+(num-test (- 0 1.0+1.0i 0.0) -1.0-1.0i)
+(num-test (- 0 1.0+1.0i 1) -2.0-1.0i)
+(num-test (- 0 1.0+1.0i 1.0+1.0i) -2.0-2.0i)
+(num-test (- 0 1.0+1.0i 123.4) -124.4-1.0i)
+(num-test (- 0 1.0+1.0i 1234/11) -113.18181818181819-1.0i)
+(num-test (- 0 123.4) -123.4)
+(num-test (- 0 1234/11) -1234/11)
+(num-test (- 0.0 -1.0+1.0i -1.0+1.0i) 2.0-2.0i)
+(num-test (- 0.0 -1.0+1.0i 0.0) 1.0-1.0i)
+(num-test (- 0.0 -1.0+1.0i 1) 0.0-1.0i)
+(num-test (- 0.0 -1.0+1.0i 1.0+1.0i) 0.0-2.0i)
+(num-test (- 0.0 -1.0+1.0i 123.4) -122.4-1.0i)
+(num-test (- 0.0 -1.0+1.0i 1234/11) -111.18181818181819-1.0i)
+(num-test (- 0.0 0 -1.0+1.0i) 1.0-1.0i)
+(num-test (- 0.0 0 0.0) 0.0)
+(num-test (- 0.0 0 1) -1.0)
+(num-test (- 0.0 0 1.0+1.0i) -1.0-1.0i)
+(num-test (- 0.0 0 123.4) -123.4)
+(num-test (- 0.0 0 1234/11) -112.18181818181819)
+(num-test (- 0.0 0.0 -1.0+1.0i) 1.0-1.0i)
+(num-test (- 0.0 0.0 0.0) 0.0)
+(num-test (- 0.0 0.0 1) -1.0)
+(num-test (- 0.0 0.0 1.0+1.0i) -1.0-1.0i)
+(num-test (- 0.0 0.0 123.4) -123.4)
+(num-test (- 0.0 0.0 1234/11) -112.18181818181819)
+(num-test (- 0.0 0.0+1.0i -1.0+1.0i) 1.0-2.0i)
+(num-test (- 0.0 0.0+1.0i 0.0) 0.0-1.0i)
+(num-test (- 0.0 0.0+1.0i 1) -1.0-1.0i)
+(num-test (- 0.0 0.0+1.0i 1.0+1.0i) -1.0-2.0i)
+(num-test (- 0.0 0.0+1.0i 123.4) -123.4-1.0i)
+(num-test (- 0.0 0.0+1.0i 1234/11) -112.18181818181819-1.0i)
+(num-test (- 0.0 1 -1.0+1.0i) 0.0-1.0i)
+(num-test (- 0.0 1 0.0) -1.0)
+(num-test (- 0.0 1 1.0) -2.0)
+(num-test (- 0.0 1 1/1) -2.0)
+(num-test (- 0.0 1 1234) -1235.0)
+(num-test (- 0.0 1) -1.0)
+(num-test (- 0.0 1.0 0) -1.0)
+(num-test (- 0.0 1.0 0.0+1.0i) -1.0-1.0i)
+(num-test (- 0.0 1.0 1.0) -2.0)
+(num-test (- 0.0 1.0 1/1) -2.0)
+(num-test (- 0.0 1.0 1234) -1235.0)
+(num-test (- 0.0 1.0) -1.0)
+(num-test (- 0.0 1.0+1.0i 0) -1.0-1.0i)
+(num-test (- 0.0 1.0+1.0i 0.0+1.0i) -1.0-2.0i)
+(num-test (- 0.0 1.0+1.0i 1.0) -2.0-1.0i)
+(num-test (- 0.0 1.0+1.0i 1/1) -2.0-1.0i)
+(num-test (- 0.0 1.0+1.0i 1234) -1235.0-1.0i)
+(num-test (- 0.0 1.0+1.0i) -1.0-1.0i)
+(num-test (- 0.0 123.4 -1.0+1.0i) -122.4-1.0i)
+(num-test (- 0.0 123.4 0.0) -123.4)
+(num-test (- 0.0 123.4 1) -124.4)
+(num-test (- 0.0 123.4 1.0+1.0i) -124.4-1.0i)
+(num-test (- 0.0 123.4 123.4) -246.8)
+(num-test (- 0.0 123.4 1234/11) -235.58181818181819)
+(num-test (- 0.0 1234 -1.0+1.0i) -1233.0-1.0i)
+(num-test (- 0.0 1234 0.0) -1234.0)
+(num-test (- 0.0 1234 1) -1235.0)
+(num-test (- 0.0 1234 1.0+1.0i) -1235.0-1.0i)
+(num-test (- 0.0 1234 123.4) -1357.4)
+(num-test (- 0.0 1234 1234/11) -1346.18181818181824)
+(num-test (- 0.0 1234/11 -1.0+1.0i) -111.18181818181819-1.0i)
+(num-test (- 0.0 1234/11 0.0) -112.18181818181819)
+(num-test (- 0.0 1234/11 1) -113.18181818181819)
+(num-test (- 0.0 1234/11 1.0+1.0i) -113.18181818181819-1.0i)
+(num-test (- 0.0 1234/11 123.4) -235.58181818181819)
+(num-test (- 0.0 1234/11 1234/11) -224.36363636363637)
+(num-test (- 0.0) -0.0)
+(num-test (- 0.0+1.0i -1.0+1.0i) 1.0)
+(num-test (- 0.0+1.0i 0.0) 0.0+1.0i)
+(num-test (- 0.0+1.0i 1) -1.0+1.0i)
+(num-test (- 0.0+1.0i 1.0+1.0i) -1.0)
+(num-test (- 0.0+1.0i 123.4) -123.4+1.0i)
+(num-test (- 0.0+1.0i 1234/11) -112.18181818181819+1.0i)
+(num-test (- 0/1) 0/1)
+(num-test (- 1 0) 1)
+(num-test (- 1 0.0+1.0i) 1.0-1.0i)
+(num-test (- 1 1 0) 0)
+(num-test (- 1 1 0.0+1.0i) 0.0-1.0i)
+(num-test (- 1 1 1.0) -1.0)
+(num-test (- 1 1 1/1) -1)
+(num-test (- 1 1 1234) -1234)
+(num-test (- 1 1) 0)
+(num-test (- 1 1.0 0) 0.0)
+(num-test (- 1 1.0 0.0+1.0i) 0.0-1.0i)
+(num-test (- 1 1.0 1.0) -1.0)
+(num-test (- 1 1.0 1/1) -1.0)
+(num-test (- 1 1.0 1234) -1234.0)
+(num-test (- 1 1.0) 0.0)
+(num-test (- 1 1.0+1.0i 0) 0.0-1.0i)
+(num-test (- 1 1.0+1.0i 0.0+1.0i) 0.0-2.0i)
+(num-test (- 1 1.0+1.0i 1.0) -1.0-1.0i)
+(num-test (- 1 1.0+1.0i 1/1) -1.0-1.0i)
+(num-test (- 1 1.0+1.0i 1234) -1234.0-1.0i)
+(num-test (- 1 1.0+1.0i) 0.0-1.0i)
+(num-test (- 1 123.4) -122.4)
+(num-test (- 1 1234/11) -1223/11)
+(num-test (- 1.0 -1.0+1.0i 0) 2.0-1.0i)
+(num-test (- 1.0 -1.0+1.0i 0.0+1.0i) 2.0-2.0i)
+(num-test (- 1.0 -1.0+1.0i 1.0) 1.0-1.0i)
+(num-test (- 1.0 -1.0+1.0i 1/1) 1.0-1.0i)
+(num-test (- 1.0 -1.0+1.0i 1234) -1232.0-1.0i)
+(num-test (- 1.0 -1.0+1.0i) 2.0-1.0i)
+(num-test (- 1.0 0 0) 1.0)
+(num-test (- 1.0 0 0.0+1.0i) 1.0-1.0i)
+(num-test (- 1.0 0 1.0) 0.0)
+(num-test (- 1.0 0 1/1) 0.0)
+(num-test (- 1.0 0 1234) -1233.0)
+(num-test (- 1.0 0) 1.0)
+(num-test (- 1.0 0.0 0) 1.0)
+(num-test (- 1.0 0.0 0.0+1.0i) 1.0-1.0i)
+(num-test (- 1.0 0.0 1.0) 0.0)
+(num-test (- 1.0 0.0 1/1) 0.0)
+(num-test (- 1.0 0.0 1234) -1233.0)
+(num-test (- 1.0 0.0) 1.0)
+(num-test (- 1.0 0.0+1.0i 0) 1.0-1.0i)
+(num-test (- 1.0 0.0+1.0i 0.0+1.0i) 1.0-2.0i)
+(num-test (- 1.0 0.0+1.0i 1.0) 0.0-1.0i)
+(num-test (- 1.0 0.0+1.0i 1/1) 0.0-1.0i)
+(num-test (- 1.0 0.0+1.0i 1234) -1233.0-1.0i)
+(num-test (- 1.0 0.0+1.0i) 1.0-1.0i)
+(num-test (- 1.0 1 0) 0.0)
+(num-test (- 1.0 1 0.0+1.0i) 0.0-1.0i)
+(num-test (- 1.0 1 1.0) -1.0)
+(num-test (- 1.0 1 1/1) -1.0)
+(num-test (- 1.0 1 1234) -1234.0)
+(num-test (- 1.0 1) 0.0)
+(num-test (- 1.0 1.0 0) 0.0)
+(num-test (- 1.0 1.0 0.0+1.0i) 0.0-1.0i)
+(num-test (- 1.0 1.0 1.0) -1.0)
+(num-test (- 1.0 1.0 1/1) -1.0)
+(num-test (- 1.0 1.0 1234) -1234.0)
+(num-test (- 1.0 1.0) 0.0)
+(num-test (- 1.0 1.0+1.0i 0) 0.0-1.0i)
+(num-test (- 1.0 1.0+1.0i 0.0+1.0i) 0.0-2.0i)
+(num-test (- 1.0 1.0+1.0i 1.0) -1.0-1.0i)
+(num-test (- 1.0 1.0+1.0i 1/1) -1.0-1.0i)
+(num-test (- 1.0 1.0+1.0i 1234) -1234.0-1.0i)
+(num-test (- 1.0 1.0+1.0i) 0.0-1.0i)
+(num-test (- 1.0 123.4 -1.0+1.0i) -121.4-1.0i)
+(num-test (- 1.0 123.4 0.0) -122.4)
+(num-test (- 1.0 123.4 1) -123.4)
+(num-test (- 1.0 123.4 1.0+1.0i) -123.4-1.0i)
+(num-test (- 1.0 123.4 123.4) -245.8)
+(num-test (- 1.0 123.4 1234/11) -234.58181818181819)
+(num-test (- 1.0 1234 -1.0+1.0i) -1232.0-1.0i)
+(num-test (- 1.0 1234 0.0) -1233.0)
+(num-test (- 1.0 1234 1) -1234.0)
+(num-test (- 1.0 1234 1.0+1.0i) -1234.0-1.0i)
+(num-test (- 1.0 1234 123.4) -1356.4)
+(num-test (- 1.0 1234 1234/11) -1345.18181818181824)
+(num-test (- 1.0 1234/11 -1.0+1.0i) -110.18181818181819-1.0i)
+(num-test (- 1.0 1234/11 0.0) -111.18181818181819)
+(num-test (- 1.0 1234/11 1) -112.18181818181819)
+(num-test (- 1.0 1234/11 1.0+1.0i) -112.18181818181819-1.0i)
+(num-test (- 1.0 1234/11 123.4) -234.58181818181819)
+(num-test (- 1.0 1234/11 1234/11) -223.36363636363637)
+(num-test (- 1.0) -1.0)
+(num-test (- 1.0+1.0i -1.0+1.0i 0) 2.0)
+(num-test (- 1.0+1.0i -1.0+1.0i 0.0+1.0i) 2.0-1.0i)
+(num-test (- 1.0+1.0i -1.0+1.0i 1.0) 1.0)
+(num-test (- 1.0+1.0i -1.0+1.0i 1/1) 1.0)
+(num-test (- 1.0+1.0i -1.0+1.0i 1234) -1232.0)
+(num-test (- 1.0+1.0i -1.0+1.0i) 2.0)
+(num-test (- 1.0+1.0i 0 0) 1.0+1.0i)
+(num-test (- 1.0+1.0i 0 0.0+1.0i) 1.0)
+(num-test (- 1.0+1.0i 0 1.0) 0.0+1.0i)
+(num-test (- 1.0+1.0i 0 1/1) 0.0+1.0i)
+(num-test (- 1.0+1.0i 0 1234) -1233.0+1.0i)
+(num-test (- 1.0+1.0i 0) 1.0+1.0i)
+(num-test (- 1.0+1.0i 0.0 0) 1.0+1.0i)
+(num-test (- 1.0+1.0i 0.0 0.0+1.0i) 1.0)
+(num-test (- 1.0+1.0i 0.0 1.0) 0.0+1.0i)
+(num-test (- 1.0+1.0i 0.0 1/1) 0.0+1.0i)
+(num-test (- 1.0+1.0i 0.0 1234) -1233.0+1.0i)
+(num-test (- 1.0+1.0i 0.0) 1.0+1.0i)
+(num-test (- 1.0+1.0i 0.0+1.0i 0) 1.0)
+(num-test (- 1.0+1.0i 0.0+1.0i 0.0+1.0i) 1.0-1.0i)
+(num-test (- 1.0+1.0i 0.0+1.0i 1.0) 0.0)
+(num-test (- 1.0+1.0i 0.0+1.0i 1/1) 0.0)
+(num-test (- 1.0+1.0i 0.0+1.0i 1234) -1233.0)
+(num-test (- 1.0+1.0i 0.0+1.0i) 1.0)
+(num-test (- 1.0+1.0i 1 0) 0.0+1.0i)
+(num-test (- 1.0+1.0i 1 0.0+1.0i) 0.0)
+(num-test (- 1.0+1.0i 1 1.0) -1.0+1.0i)
+(num-test (- 1.0+1.0i 1 1/1) -1.0+1.0i)
+(num-test (- 1.0+1.0i 1 1234) -1234.0+1.0i)
+(num-test (- 1.0+1.0i 1) 0.0+1.0i)
+(num-test (- 1.0+1.0i 1.0 0) 0.0+1.0i)
+(num-test (- 1.0+1.0i 1.0 0.0+1.0i) 0.0)
+(num-test (- 1.0+1.0i 1.0 1.0) -1.0+1.0i)
+(num-test (- 1.0+1.0i 1.0 1/1) -1.0+1.0i)
+(num-test (- 1.0+1.0i 1.0 1234) -1234.0+1.0i)
+(num-test (- 1.0+1.0i 1.0) 0.0+1.0i)
+(num-test (- 1.0+1.0i 1.0+1.0i 0) 0.0)
+(num-test (- 1.0+1.0i 1.0+1.0i 0.0+1.0i) 0.0-1.0i)
+(num-test (- 1.0+1.0i 1.0+1.0i 1.0) -1.0)
+(num-test (- 1.0+1.0i 1.0+1.0i 1/1) -1.0)
+(num-test (- 1.0+1.0i 1.0+1.0i 1234) -1234.0)
+(num-test (- 1.0+1.0i 1.0+1.0i) 0.0)
+(num-test (- 1.0+1.0i 123.4 -1.0+1.0i) -121.4)
+(num-test (- 1.0+1.0i 123.4 0.0) -122.4+1.0i)
+(num-test (- 1.0+1.0i 123.4 1) -123.4+1.0i)
+(num-test (- 1.0+1.0i 123.4 1.0+1.0i) -123.4)
+(num-test (- 1.0+1.0i 123.4 123.4) -245.8+1.0i)
+(num-test (- 1.0+1.0i 123.4 1234/11) -234.58181818181819+1.0i)
+(num-test (- 1.0+1.0i 1234 -1.0+1.0i) -1232.0)
+(num-test (- 1.0+1.0i 1234 0.0) -1233.0+1.0i)
+(num-test (- 1.0+1.0i 1234 1) -1234.0+1.0i)
+(num-test (- 1.0+1.0i 1234 1.0+1.0i) -1234.0)
+(num-test (- 1.0+1.0i 1234 123.4) -1356.4+1.0i)
+(num-test (- 1.0+1.0i 1234 1234/11) -1345.18181818181824+1.0i)
+(num-test (- 1.0+1.0i 1234/11 -1.0+1.0i) -110.18181818181819)
+(num-test (- 1.0+1.0i 1234/11 0.0) -111.18181818181819+1.0i)
+(num-test (- 1.0+1.0i 1234/11 1) -112.18181818181819+1.0i)
+(num-test (- 1.0+1.0i 1234/11 1.0+1.0i) -112.18181818181819)
+(num-test (- 1.0+1.0i 1234/11 123.4) -234.58181818181819+1.0i)
+(num-test (- 1.0+1.0i 1234/11 1234/11) -223.36363636363637+1.0i)
+(num-test (- 1.0+1.0i) -1.0-1.0i)
+(num-test (- 10/3) -10/3)
+(num-test (- 123.4 -1.0+1.0i 0) 124.4-1.0i)
+(num-test (- 123.4 -1.0+1.0i 0.0+1.0i) 124.4-2.0i)
+(num-test (- 123.4 -1.0+1.0i 1.0) 123.4-1.0i)
+(num-test (- 123.4 -1.0+1.0i 1/1) 123.4-1.0i)
+(num-test (- 123.4 -1.0+1.0i 1234) -1109.59999999999991-1.0i)
+(num-test (- 123.4 -1.0+1.0i) 124.4-1.0i)
+(num-test (- 123.4 0 0) 123.4)
+(num-test (- 123.4 0 0.0+1.0i) 123.4-1.0i)
+(num-test (- 123.4 0 1.0) 122.4)
+(num-test (- 123.4 0 1/1) 122.4)
+(num-test (- 123.4 0 1234) -1110.59999999999991)
+(num-test (- 123.4 0) 123.4)
+(num-test (- 123.4 0.0 0) 123.4)
+(num-test (- 123.4 0.0 0.0+1.0i) 123.4-1.0i)
+(num-test (- 123.4 0.0 1.0) 122.4)
+(num-test (- 123.4 0.0 1/1) 122.4)
+(num-test (- 123.4 0.0 1234) -1110.59999999999991)
+(num-test (- 123.4 0.0) 123.4)
+(num-test (- 123.4 0.0+1.0i 0) 123.4-1.0i)
+(num-test (- 123.4 0.0+1.0i 0.0+1.0i) 123.4-2.0i)
+(num-test (- 123.4 0.0+1.0i 1.0) 122.4-1.0i)
+(num-test (- 123.4 0.0+1.0i 1/1) 122.4-1.0i)
+(num-test (- 123.4 0.0+1.0i 1234) -1110.59999999999991-1.0i)
+(num-test (- 123.4 0.0+1.0i) 123.4-1.0i)
+(num-test (- 123.4 1 0) 122.4)
+(num-test (- 123.4 1 0.0+1.0i) 122.4-1.0i)
+(num-test (- 123.4 1 1.0) 121.4)
+(num-test (- 123.4 1 1/1) 121.4)
+(num-test (- 123.4 1 1234) -1111.59999999999991)
+(num-test (- 123.4 1) 122.4)
+(num-test (- 123.4 1.0 0) 122.4)
+(num-test (- 123.4 1.0 0.0+1.0i) 122.4-1.0i)
+(num-test (- 123.4 1.0 1.0) 121.4)
+(num-test (- 123.4 1.0 1/1) 121.4)
+(num-test (- 123.4 1.0 1234) -1111.59999999999991)
+(num-test (- 123.4 1.0) 122.4)
+(num-test (- 123.4 1.0+1.0i 0) 122.4-1.0i)
+(num-test (- 123.4 1.0+1.0i 0.0+1.0i) 122.4-2.0i)
+(num-test (- 123.4 1.0+1.0i 1.0) 121.4-1.0i)
+(num-test (- 123.4 1.0+1.0i 1/1) 121.4-1.0i)
+(num-test (- 123.4 1.0+1.0i 1234) -1111.59999999999991-1.0i)
+(num-test (- 123.4 1.0+1.0i) 122.4-1.0i)
+(num-test (- 123.4 123.4 -1.0+1.0i) 1.0-1.0i)
+(num-test (- 123.4 123.4 0.0) 0.0)
+(num-test (- 123.4 123.4 1) -1.0)
+(num-test (- 123.4 123.4 1.0+1.0i) -1.0-1.0i)
+(num-test (- 123.4 123.4 123.4) -123.4)
+(num-test (- 123.4 123.4 1234/11) -112.18181818181819)
+(num-test (- 123.4 1234 -1.0+1.0i) -1109.59999999999991-1.0i)
+(num-test (- 123.4 1234 0.0) -1110.59999999999991)
+(num-test (- 123.4 1234 1) -1111.59999999999991)
+(num-test (- 123.4 1234 1.0+1.0i) -1111.59999999999991-1.0i)
+(num-test (- 123.4 1234 123.4) -1234.0)
+(num-test (- 123.4 1234 1234/11) -1222.78181818181815)
+(num-test (- 123.4 1234/11 -1.0+1.0i) 12.21818181818182-1.0i)
+(num-test (- 123.4 1234/11 0.0) 11.21818181818182)
+(num-test (- 123.4 1234/11 1) 10.21818181818182)
+(num-test (- 123.4 1234/11 1.0+1.0i) 10.21818181818182-1.0i)
+(num-test (- 123.4 1234/11 123.4) -112.18181818181819)
+(num-test (- 123.4 1234/11 1234/11) -100.96363636363635)
+(num-test (- 1234 -1.0+1.0i) 1235.0-1.0i)
+(num-test (- 1234 0.0) 1234.0)
+(num-test (- 1234 1) 1233)
+(num-test (- 1234 1.0+1.0i) 1233.0-1.0i)
+(num-test (- 1234 123.4) 1110.59999999999991)
+(num-test (- 1234 1234/11) 12340/11)
+(num-test (- 1234/11 0) 1234/11)
+(num-test (- 1234/11 0.0+1.0i) 112.18181818181819-1.0i)
+(num-test (- 1234/11 1.0) 111.18181818181819)
+(num-test (- 1234/11 1/1) 1223/11)
+(num-test (- 1234/11 1234) -12340/11)
+(num-test (- 1234000000) -1234000000)
+(num-test (- 1234000000/10) -1234000000/10)
+(num-test (- 2/2) -2/2)
+(num-test (- 1/2 0.5e0) 0.0e0)
+(num-test (- 1000000000000000000/3 1000000000000000001/3) -1/3)
+(num-test (- 3 0 3 5 -6) 1)
+(num-test (- 3 4) -1 )
+(num-test (- 3) -3 )
+
+(call-with-exit
+ (lambda (ok)
+   (for-each-permutation
+    (lambda args
+      (unless (= (apply - args) (- (car args) (apply + (cdr args))))
+	(format *stderr* "~A: ~A != ~A?~%" (port-line-number) (apply - args) (- (car args) (apply + (cdr args))))
+	(ok)))
+    '(1 1/2 0.5 1+i))))
+
+(call-with-exit
+ (lambda (ok)
+   (for-each-permutation
+    (lambda args
+      (unless (= (apply - args) (+ (car args) (- (apply + (cdr args)))))
+	(format *stderr* "~A: (- ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply - args))
+	(ok)))
+    '(1 1/2 0.5 1+i -1/2 -1 -0.5 -1-i))))
+
+(num-test (- -1.797693134862315699999999999999999999998E308 -9223372036854775808) -1.797693134862315699999999999999999999998E308)
+(num-test (- -9223372036854775808 -9223372036854775808) 0)
+(num-test (- -9223372036854775808 5.551115123125783999999999999999999999984E-17) -9.223372036854775808000000000000000055511E18)
+(num-test (- -9223372036854775808 9223372036854775807 -9223372036854775808) -9223372036854775807)
+(if with-bignums (num-test (- -9223372036854775808) 9223372036854775808))
+(num-test (- 1.110223024625156799999999999999999999997E-16 -9223372036854775808) 9.223372036854775808000000000000000111022E18)
+(num-test (- 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) 5.545694112263356477829399999999999999977E-17)
+(num-test (- 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) -5.551115123125783999999999999999999999984E-17)
+(num-test (- 9223372036854775807 9223372036854775807) 0)
+(num-test (- .(1.1)) -1.1)
+(num-test (- 1. .()) -1.0)
+(num-test (- 1/9223372036854775807 1/9223372036854775807) 0)
+(num-test (- 1/98947 2/97499 3/76847) -36656755224/741360956847391)
+(num-test (- 500009/500029 500057/500041) -18001284/250035001189)
+;;; (test (let () (define (func) (do () (#t (- 1855077841/1311738121 -1 4478554083/3166815962)))) (define (hi) (func)) (hi)) 4154033219546687401/4154033219546687402)
+;;; this ^ depends on treating it as (- r1 (+ r2 r3)) not (- (- r1 r2) r3)
+;(test (- 9007199254740996.0 9007199254740995) 1.0)
+
+(unless (or with-bignums (not (provided? 'overflow-checks)))
+  (num-test (- 8 -1/9223372036854775807 1/9223372036854775807) 8.0)
+;      (num-test (- most-positive-fixnum most-negative-fixnum) 1.8446744073709551615E19)
+;      (num-test (- most-negative-fixnum most-positive-fixnum) -1.8446744073709551615E19)
+;;; currently s7's optimizer screws up these cases
+      )
+
+(num-test (- -0.011326914400453525E0 -0.6668141757661364E0) 6.554872613656828749999999999999999999976E-1)
+(num-test (- -0.46185382764946437E0 0.7488210697846337E0) -1.210674897434098070000000000000000000001E0)
+(num-test (- -0.35834120541234993E0 -0.30919976341834987E0) -4.914144199400005999999999999999999999972E-2)
+(num-test (- 0.44705025064976966E0 -0.9277893553610955E0) 1.374839606010865160000000000000000000002E0)
+(num-test (- -0.47647537517067917E0 0.29158058381073604E0) -7.680559589814152099999999999999999999997E-1)
+(num-test (- -0.021697999002707746E0 0.1779871773524142E0) -1.996851763551219460000000000000000000001E-1)
+(num-test (- 0.4179484378019861E0 9.9990307469939E9) -9.999030746575951861270279525000000000019E9)
+(num-test (- -0.7475415524823718E0 1.3993312799214797E9) -1.399331280669021252482371799999999999998E9)
+(num-test (- 0.2519442433861928E0 -6.699632771871848E9) 6.699632772123792243386192799999999999993E9)
+(num-test (- -0.5124988631497671E0 2.7959244812290273E9) -2.795924481741526163149767100000000000009E9)
+(num-test (- -0.6870193827604301E0 4.851102442573468E9) -4.851102443260487591073418381249999999995E9)
+(num-test (- 0.7609656780357723E0 7.481252865855436E8) -7.481252858245779544715519187499999999991E8)
+(num-test (- -0.6301276042170191E0 -7.099314875214215E-11) -6.301276041460259512478578500000000000002E-1)
+(num-test (- -0.4139053484357884E0 -2.897413526398709E-11) -4.139053484068142647360129100000000000006E-1)
+(num-test (- -0.6944623060197281E0 -3.291569879873739E-11) -6.94462305986812401201262610000000000001E-1)
+(num-test (- -0.2057822500703933E0 3.6505182026159854E-11) -2.057822501068984820261598540000000000004E-1)
+(num-test (- -0.8792706674467908E0 8.094527736950817E-11) -8.792706675277360773695081699999999999978E-1)
+(num-test (- -0.6888184243601332E0 9.127622796988807E-11) -6.888184244514094279698880700000000000006E-1)
+(num-test (- -0.980711030497252E0 8.752272461345245E19) -8.752272461345245000098071103049725200009E19)
+(num-test (- 0.8035082489836539E0 -3.903355151264917E19) 3.90335515126491700008035082489836539001E19)
+(num-test (- -0.7537841372394811E0 -5.879942447417834E19) 5.879942447417833999924621586276051889998E19)
+(num-test (- -0.6877475951546845E0 -2.3972266191169642E19) 2.397226619116964199931225240484531550001E19)
+(num-test (- -0.43128282112433525E0 -5.422824998003439E19) 5.422824998003438999956871717887566474998E19)
+(num-test (- 0.29538116818276694E0 1.1291858990580939E19) -1.129185899058093899970461883181723306002E19)
+(num-test (- 0.9166687388673976E0 6.395175407123937E-21) 9.166687388673975999936048245928760629984E-1)
+(num-test (- 0.41840538498193025E0 -2.6655662412599155E-21) 4.18405384981930250002665566241259915501E-1)
+(num-test (- -0.8036940092501853E0 6.7473779576832565E-21) -8.036940092501853000067473779576832565009E-1)
+(num-test (- 0.8555054025209989E0 -7.939970418096797E-21) 8.55505402520998900007939970418096796999E-1)
+(num-test (- 0.3365495704567003E0 8.694519827555395E-21) 3.365495704567002999913054801724446050001E-1)
+(num-test (- -0.7430322011471231E0 7.430332379292914E-22) -7.430322011471231000007430332379292914019E-1)
+(num-test (- 5.102372414731216E9 -0.5073635765350494E0) 5.102372415238580007199111899999999999994E9)
+(num-test (- 4.629827365822252E9 0.6534380055543355E0) 4.629827365168814268005234812499999999993E9)
+(num-test (- 7.218192507117569E9 0.9781542046565127E0) 7.21819250613941476507004979999999999999E9)
+(num-test (- 6.595760326622413E8 0.7339510561932947E0) 6.595760319282902834902380148437500000014E8)
+(num-test (- 7.191166637703489E9 0.80792475493853E0) 7.191166636895564548650337188817616151937E9)
+(num-test (- -7.95531405213956E9 0.5353636841430115E0) -7.955314052674923429931585718750000000006E9)
+(num-test (- 5.438904545553836E8 6.533536518165114E9) -5.98964606360973083972930908203125E9)
+(num-test (- -7.389650313101625E8 -9.983943153365381E9) 9.244978122055218499999999999999999999979E9)
+(num-test (- 8.364404619492165E9 -7.600563055115287E9) 1.596496767460745161181640624999999999997E10)
+(num-test (- 2.070813748323649E9 6.421052769114957E9) -4.350239020791307926177978515625E9)
+(num-test (- -2.8555256820439434E9 -3.4077342921686625E8) -2.514752252827077150000000000000000000005E9)
+(num-test (- 9.147878229420991E8 8.439982790150545E9) -7.525194967208446025848388671875E9)
+(num-test (- -4.315772980070098E9 -6.48869466068404E-11) -4.315772980070097999935113053393159599999E9)
+(num-test (- -3.5186299785635023E9 3.990046539849716E-11) -3.518629978563502300039900465398497159997E9)
+(num-test (- 2.5645532837267537E9 8.566645694205622E-13) 2.564553283726753699999143335430579437802E9)
+(num-test (- 6.145110896031829E9 -9.242734002954773E-11) 6.145110896031828880402485933779547730013E9)
+(num-test (- -6.6836855975624E9 9.117930361283473E-11) -6.683685597562399864287956647362834729995E9)
+(num-test (- -1.7472828462085754E8 -5.125838712019503E-11) -1.747282846208575399487416128798049699998E8)
+(num-test (- 9.05675399397055E9 9.086705650502484E19) -9.0867056495968086006029449462890625E19)
+(num-test (- -5.834806594586836E9 9.981576053842906E19) -9.981576054426386659458683599999999999999E19)
+(num-test (- 3.047010922754272E9 1.1715352070471352E19) -1.171535206742434107724572801589965820312E19)
+(num-test (- 7.294295638574767E9 2.845702947515113E19) -2.845702946785683436142523288726806640625E19)
+(num-test (- 8.264143132493019E9 -1.6322956072452289E19) 1.632295608071643213249301910400390625E19)
+(num-test (- -9.597823287256088E9 3.954126758718671E19) -3.95412675967845332872560880000000000001E19)
+(num-test (- 3.229389511771705E9 -4.329831377266493E-21) 3.229389511771705150604248046879329831377E9)
+(num-test (- 6.897089200279753E9 2.4428208790287663E-21) 6.897089200279752731323242187497557179116E9)
+(num-test (- 2.3579775300187545E9 4.729400988996349E-21) 2.357977530018754499999999999995270599018E9)
+(num-test (- 1.6718929117460046E9 5.8162277016717065E-21) 1.671892911746004599999999999994183772301E9)
+(num-test (- 2.537177500868296E9 1.4856605280697543E-21) 2.537177500868296146392822265623514339469E9)
+(num-test (- 6.117674696930935E9 -1.6187214719634357E-21) 6.117674696930934906005859375001618721474E9)
+(num-test (- 4.1877888304549216E-11 -0.06920550501017497E0) 6.920550505205285830454921600000000000007E-2)
+(num-test (- 9.61054846124015E-11 0.885309193732889E0) -8.85309193636783481398417376384291797877E-1)
+(num-test (- 2.5559085051828467E-11 -0.8112181469812297E0) 8.112181470067887850518284670000000000006E-1)
+(num-test (- -1.4549570208293283E-12 -0.5049325945871657E0) 5.049325945857107429791706717000000000005E-1)
+(num-test (- -7.091628047158497E-11 0.61946884965934E0) -6.194688497302562955729347334266968816526E-1)
+(num-test (- 2.877466355456826E-11 0.4496491857374E0) -4.49649185708625317645189543551619872451E-1)
+(num-test (- 1.3041612488449928E-12 5.408018587130755E9) -5.40801858713075542449820755750115500719E9)
+(num-test (- -5.379752339715717E-11 -4.009594691514288E9) 4.009594691514287999946202476602842829998E9)
+(num-test (- 7.023042501342336E-12 -3.4153434285746374E9) 3.415343428574637400007023042501342336004E9)
+(num-test (- 6.968174934871611E-11 4.713087404332662E9) -4.713087404332661628653462781901283890003E9)
+(num-test (- -5.153562653896506E-11 -8.44732228013254E8) 8.447322280132540463885888851797849400006E8)
+(num-test (- -8.424177457818745E-11 1.6817117809824567E9) -1.681711780982456700084241774578187449998E9)
+(num-test (- 3.374755984316538E-11 8.893678266883364E-11) -5.518922282566826000000000000000000000009E-11)
+(num-test (- -8.684123447823306E-11 -7.888825869147879E-11) -7.952975786754269999999999999999999999987E-12)
+(num-test (- 7.788477523205632E-11 1.741674745286914E-11) 6.046802777918717999999999999999999999988E-11)
+(num-test (- 6.546622477606044E-11 -4.7719651007530584E-11) 1.131858757835910240000000000000000000001E-10)
+(num-test (- -1.8595152377503265E-11 5.7288738553553045E-11) -7.588389093105630999999999999999999999984E-11)
+(num-test (- -8.184033550427558E-11 -8.834399228929296E-11) 6.503656785017380000000000000000000000234E-12)
+(num-test (- 5.749469292140762E-11 7.493129199779113E19) -7.493129199779112999999999999994250530697E19)
+(num-test (- -5.2285095120702066E-11 -2.0611179974216552E19) 2.061117997421655199999999999994771490491E19)
+(num-test (- -8.84727820032067E-11 4.7423077384022024E19) -4.742307738402202400000000000008847278205E19)
+(num-test (- 3.437676989338625E-11 -3.5368755480277647E19) 3.536875548027764700000000000003437676988E19)
+(num-test (- 2.2665031619145437E-11 -6.072845659234921E19) 6.072845659234921000000000000002266503153E19)
+(num-test (- -8.429070146313393E-11 5.134329153614969E18) -5.134329153614969000000000000084290701453E18)
+(num-test (- -9.009531819191212E-11 2.301790665456671E-22) -9.009531819214229906654566710000000000025E-11)
+(num-test (- -2.706942469371907E-11 9.282350542107287E-21) -2.706942470300142054210728700000000000001E-11)
+(num-test (- 5.358266626996117E-11 -4.409057695582885E-22) 5.358266627040207576955828850000000000004E-11)
+(num-test (- -7.189537285608088E-11 9.569273217393917E-21) -7.189537286565015321739391700000000000027E-11)
+(num-test (- -4.160295905335358E-11 5.930867524794025E-21) -4.160295905928444752479402499999999999992E-11)
+(num-test (- 6.7922062777334035E-12 -7.747524338474154E-22) 6.792206278508155933847415400000000000006E-12)
+(num-test (- -9.038821102045805E19 0.04779131019959271E0) -9.038821102045805000004779131019959271002E19)
+(num-test (- 2.2020595055495963E19 -0.424631558292516E0) 2.202059505549596300042463155829251600002E19)
+(num-test (- -8.164003027214308E19 0.6832198147365239E0) -8.164003027214308000068321981473652389997E19)
+(num-test (- -3.878233560364984E19 -0.28756619113600546E0) -3.878233560364983999971243380886399453999E19)
+(num-test (- 7.0829003521450525E19 -0.6071548125948544E0) 7.08290035214505250006071548125948544E19)
+(num-test (- 5.968540808784698E19 0.7674294173432648E0) 5.968540808784697999923257058265673519995E19)
+(num-test (- -2.2143621795153547E19 -2.443529365769125E9) -2.214362179271001763423087500000000000004E19)
+(num-test (- -9.77092538926342E18 5.903189771537687E8) -9.770925389853738977153768658638000488281E18)
+(num-test (- 9.974714452399537E19 -6.980456691485629E9) 9.974714453097582669148562899999999999991E19)
+(num-test (- 1.7428950527159094E18 3.68843657888816E9) 1.742895049027472821111839771270751953125E18)
+(num-test (- -1.1094381875350845E19 -7.157723640671709E9) -1.109438186819312135932829100000000000002E19)
+(num-test (- -3.638795590369631E19 6.9246542750294075E9) -3.638795591062096427502940750000000000005E19)
+(num-test (- -5.66543282261991E19 -5.1005028153082024E-11) -5.665432822619909999999999999994899497189E19)
+(num-test (- -3.901527864456216E19 -1.064153465992923E-12) -3.901527864456215999999999999999893584646E19)
+(num-test (- 1.1477489418879848E19 3.327888063907735E-11) 1.147748941887984799999999999996672111937E19)
+(num-test (- 3.508978072054437E19 9.238453417997638E-11) 3.508978072054436999999999999990761546584E19)
+(num-test (- -4.7642024461416964E19 -4.758309941438892E-11) -4.764202446141696399999999999995241690065E19)
+(num-test (- -8.307715835429606E19 3.313910202186439E-11) -8.307715835429606000000000000003313910214E19)
+(num-test (- 2.704675010192592E18 -2.6840207147078365E19) 2.9544882157270957E19)
+(num-test (- -9.860969100714668E18 -4.719594638795429E19) 3.7334977287239622E19)
+(num-test (- 7.87799781828944E18 -6.657221298850535E19) 7.4450210806794789744E19)
+(num-test (- -3.3937781740759863E19 4.783805995045389E19) -8.1775841691213753E19)
+(num-test (- -1.0747572720102216E19 -1.7144708598072445E19) 6.397135877970229E18)
+(num-test (- 1.3938845733158445E19 5.604369854609131E19) -4.2104852812932865E19)
+(num-test (- 6.0938348303695315E19 1.1005522580049531E-21) 6.0938348303695315E19)
+(num-test (- -2.4870844028694925E19 1.5391650322730598E-22) -2.4870844028694925E19)
+(num-test (- 7.323118607079343E19 6.637280375859432E-21) 7.323118607079343E19)
+(num-test (- -4.181201584825501E19 4.768935182006663E-21) -4.181201584825501E19)
+(num-test (- 4.1225910279381205E19 6.117191687463543E-21) 4.1225910279381205E19)
+(num-test (- 6.438313875980151E17 -1.4883489002691529E-21) 6.438313875980151E17)
+(num-test (- -4.573961206963222E-21 0.3586300020381973E0) -3.586300020381973000045739612069632220001E-1)
+(num-test (- 7.74206782371325E-22 0.23168389210368656E0) -2.316838921036865599992257932176286750005E-1)
+(num-test (- 8.572446613640605E-21 0.6114581963443891E0) -6.114581963443890999914275533863593949978E-1)
+(num-test (- -8.539467934859551E-21 0.33474735899049E0) -3.347473589904900182020371578704711119401E-1)
+(num-test (- -5.55811309570968E-21 -0.9637216018651454E0) 9.637216018651453999944418869042903199998E-1)
+(num-test (- -6.705839413964189E-21 0.3787619614522374E0) -3.787619614522374000067058394139641890005E-1)
+(num-test (- 1.338539206480238E-22 6.683968625235106E9) -6.683968625235106468200683593749866146082E9)
+(num-test (- -9.64078167549023E-21 3.291420859310843E9) -3.291420859310842990875244140634640781671E9)
+(num-test (- -9.26536204591093E-22 2.9839295142529476E8) -2.98392951425294760000000000000926536205E8)
+(num-test (- -3.647737608953592E-21 6.115300020921433E8) -6.115300020921432971954345703161477376078E8)
+(num-test (- 1.4069763806331204E-21 -1.183109060480878E9) 1.18310906048087800000000000000140697638E9)
+(num-test (- -6.0037865798761924E-21 -7.442246743849378E9) 7.442246743849377999999999999993996213425E9)
+(num-test (- -5.994118986299138E-21 -9.091558282012836E-11) 9.091558281413424101370086199999999999991E-11)
+(num-test (- 6.969393585974241E-21 3.435352867093995E-11) -3.435352866397055641402575899999999999989E-11)
+(num-test (- -6.278554484817533E-22 -4.7211920270841604E-11) 4.721192027021374855151824670000000000001E-11)
+(num-test (- -8.603262886304741E-21 1.7296517702077242E-11) -1.729651771068050488630474100000000000006E-11)
+(num-test (- 4.104502790901735E-21 -4.8473213720301105E-11) 4.847321372440560779090173499999999999986E-11)
+(num-test (- -4.449725859444968E-21 -8.944265568403936E-11) 8.944265567958963414055503200000000000002E-11)
+(num-test (- 4.828216540804827E-21 -1.1712152029346877E19) 1.1712152029346877E19)
+(num-test (- -5.65034940464881E-21 -9.445303840982011E19) 9.445303840982011E19)
+(num-test (- -7.24107519738777E-21 2.340578690102746E19) -2.340578690102746E19)
+(num-test (- 1.7659593956231534E-21 -8.048768257390671E18) 8.048768257390671E18)
+(num-test (- -3.0538518255248124E-21 8.834631867521575E19) -8.834631867521575E19)
+(num-test (- 8.57952908388053E-21 -5.730742870111307E19) 5.730742870111307E19)
+(num-test (- -4.5090103564928485E-21 1.8907114777916313E-21) -6.399721834284479799999999999999999999996E-21)
+(num-test (- -3.8487625143236447E-22 5.354282198078924E-21) -5.739158449511288470000000000000000000003E-21)
+(num-test (- 2.6660110440404615E-22 3.833744224501756E-22) -1.167733180461294499999999999999999999996E-22)
+(num-test (- -7.503762004261027E-22 -9.623906576475644E-21) 8.873530376049541300000000000000000000014E-21)
+(num-test (- -9.113431042260725E-21 -3.5516521546085545E-21) -5.561778887652170499999999999999999999997E-21)
+(num-test (- -3.4813735333296525E-21 -2.6602650182385188E-21) -8.211085150911336999999999999999999999942E-22)
+
+(num-test (- 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99) -4948)
+
+(unless (or with-bignums (not (provided? 'overflow-checks)))
+  (num-test (- 1/9223372036854775807 1/9223372036854775806) -1.1754943508223e-38)
+  (num-test (- 1/98947 2/97499 3/76847 4/61981 5/59981 6/66601) -0.00028742959363084)
+  (num-test (- 1/98947 2/97499 3/76847 4/61981 5/59981) -0.00019734085622449)
+  (num-test (- 1/98947 2/97499 3/76847 4/61981) -0.00011398112564314)
+  (num-test (- 500009/500029 500057/500041 500083/500069) -1.00009999119288)
+  (num-test (- 98947 2/97499 76847 4/61981 5/59981) 22099.999831591)
+  (test (< (abs (- (/ 1/98947 2/97499 3/76847 4/61981) 195556288.07955816413500830)) 1e-8) #t))
+
+(when with-bignums
+  (num-test (- 9223372036854775807 .1)  9.223372036854775806899999999999999994449E18)
+  (num-test (- .1 9223372036854775807) -9.223372036854775806899999999999999994449E18)
+  (num-test (- 8796093022208 1855077841/1311738121) 11538170533090478113327/1311738121)
+  (num-test (- 8796093022208 (bignum 1855077841/1311738121)) (bignum 11538170533090478113327/1311738121))
+  (num-test (- -4611686018427387904 4611686018427387906) -9223372036854775810)
+  (num-test (- -9223372036854775800 10) -9223372036854775810)
+  (num-test (- 1/9223372036854775807 1/9223372036854775806) -1/85070591730234615838173535747377725442)
+  (num-test (- 1/98947 2/97499 3/76847 4/61981 5/59981 6/66601) -52761146275983172771170709/183561983334767209753061626751)
+  (num-test (- 1/98947 2/97499 3/76847 4/61981 5/59981) -543899925850203550003/2756144552405627689570151)
+  (num-test (- 1e40+1e30i 1e40-1e30i) 0+2e30i)
+  (num-test (- 2 12345678901234567890+12345678901234567890i) -12345678901234567888-12345678901234567890i)
+  (num-test (- 500009/500029 500057/500041 500083/500069) -125047255383687283/125034753009582041)
+  (num-test (- 9223372036854775807 -9223372036854775808) 18446744073709551615)
+  (num-test (- 98947 2/97499 76847 4/61981 5/59981) 8010593845541429507/362470312515139)
+  (num-test (- most-negative-fixnum) 9223372036854775808)
+  (num-test (- 3872339191937382556 13437882608410293981) -9565543416472911425)
+  (num-test (- 12702320881720530101 13823645380834800545) -1121324499114270444)
+  (num-test (- 10222969257152373972 -3454292165863475982) 13677261423015849954)
+  (num-test (- 591233951053628288 -17639978232337836611) 18231212183391464899)
+  (num-test (- -7878405903223218778 9050739027069287469) -16929144930292506247)
+  (num-test (- 11347120771894057376 8443917396834074370) 2903203375059983006)
+  (num-test (- 7831959259127703467 -257470007821066702597399141202130667973) 257470007821066702605231100461258371440)
+  (num-test (- 1092406341647857980 -325710450166845666190895573961860069495) 325710450166845666191987980303507927475)
+  (num-test (- -4220606126689357919 73461013742902296577411907972196819778) -73461013742902296581632514098886177697)
+  (num-test (- -5112059189225304080 334306213789148650102245018234146620793) -334306213789148650107357077423371924873)
+  (num-test (- 3093346224554776175 -204967241927023874963787190016588249299) 204967241927023874966880536241143025474)
+  (num-test (- -5735747638156472357 -3881750746805128137401544408305666047) 3881750746805128131665796770149193690)
+  (num-test (- 17639095392510638323 13312205908441007415860933757605397223142073616822325142416364932887680287063250296996056787873086490231950036662943632990219865746131453861285495087665017) -13312205908441007415860933757605397223142073616822325142416364932887680287063250296996056787873086490231950036662943632990219865746131436222190102577026694)
+  (num-test (- 16304056910692545233 1463591032326743052350022746892396184459320617971409440301562638996633667625451301419074212369365394140737678584830314878769698416417465834928609990708982) -1463591032326743052350022746892396184459320617971409440301562638996633667625451301419074212369365394140737678584830314878769698416417449530871699298163749)
+  (num-test (- -10347586523508777315 12614325304787850623826535169596975975360455924114817820074336137897280818245940873677389644701038550150832199897314137414727161192173691528917744363375331) -12614325304787850623826535169596975975360455924114817820074336137897280818245940873677389644701038550150832199897314137414727161192173701876504267872152646)
+  (num-test (- 16875252323587344863 -10230183557696638447600885112945653217398839137450096120772416948425622105048400944465287395231588821521217980407867153259741079758527788318592431794213674) 10230183557696638447600885112945653217398839137450096120772416948425622105048400944465287395231588821521217980407867153259741079758527805193844755381558537)
+  (num-test (- 8574302739232756920 2945205250727759066959418729185252318153395797902208079569164623770839848878181416073351760975066439564334127158302281471631001294503759011790017443478716) -2945205250727759066959418729185252318153395797902208079569164623770839848878181416073351760975066439564334127158302281471631001294503750437487278210721796)
+  (num-test (- -17657597319577965851 -470389901349206124503884936612357721199915776516939967013182926735009022045917047211666512521578494339222795740836335004070464944715357800461845632614015) 470389901349206124503884936612357721199915776516939967013182926735009022045917047211666512521578494339222795740836335004070464944715340142864526054648164)
+  (num-test (- 11472336850218354926 16764018932433717867649699977474298016589762238077229911249331402108995850754999065988360217500238643747316139204767820295123085026049273617874157749889925712672510963712964034497935503076689670786498045302562704435768723916334451317158760704743066709581593570757498670622547878516907127632802801541072452593999435195637193819500375063696114131057474475407791672955417184592088612921927282233762919112197264895445408873539746256555444555901857369535350160665235184955438709679669964546134487688796078142789125799020704969226557493354453298489954288702387159956161243151013189140749021799388406290339231792790773612376) -16764018932433717867649699977474298016589762238077229911249331402108995850754999065988360217500238643747316139204767820295123085026049273617874157749889925712672510963712964034497935503076689670786498045302562704435768723916334451317158760704743066709581593570757498670622547878516907127632802801541072452593999435195637193819500375063696114131057474475407791672955417184592088612921927282233762919112197264895445408873539746256555444555901857369535350160665235184955438709679669964546134487688796078142789125799020704969226557493354453298489954288702387159956161243151013189140749021799388406290327759455940555257450)
+  (num-test (- 12682607562584942903 32133619583510009354538204193505267426986629771080807813988708187761849276650847958886764459302043799013813125903744946349479743277662066609741649009023451783267511140245797235200413941774959851628239089013586399425314412329003636059313583335807925401822165199322334470452126484173417518861322963430951772895619791799137157183662289329901964728384697377777905235894234370773419160283767144177627084271804319157013765325677633945370597318765372346484383325176768117059688792498687750479618961541872574768601477738410497806623403054372221338126223825515939164627992974469102910882915893925327931884157735553718792115929) -32133619583510009354538204193505267426986629771080807813988708187761849276650847958886764459302043799013813125903744946349479743277662066609741649009023451783267511140245797235200413941774959851628239089013586399425314412329003636059313583335807925401822165199322334470452126484173417518861322963430951772895619791799137157183662289329901964728384697377777905235894234370773419160283767144177627084271804319157013765325677633945370597318765372346484383325176768117059688792498687750479618961541872574768601477738410497806623403054372221338126223825515939164627992974469102910882915893925327931884145052946156207173026)
+  (num-test (- 14621880654476679971 -10075923784619510279100488003620810539888599376089081798647754628017452762406215094511315867213396543200861274584884759429891242650999761503100661310915213260386281412125687376866399124849043409890009033179987278297335571911640353059036551139958369871790768643514550179661619387008678118363266091945225880595898524898713646458647465935791224159084684209727153050053537752111696883536364966526666445737103854446009305531519860527938394412863332757413309423156200192973778629503534709731073637828912608835085933003410694216843775182940057891552358942312728978810053715387504707194992816961400377579655168106377696154728) 10075923784619510279100488003620810539888599376089081798647754628017452762406215094511315867213396543200861274584884759429891242650999761503100661310915213260386281412125687376866399124849043409890009033179987278297335571911640353059036551139958369871790768643514550179661619387008678118363266091945225880595898524898713646458647465935791224159084684209727153050053537752111696883536364966526666445737103854446009305531519860527938394412863332757413309423156200192973778629503534709731073637828912608835085933003410694216843775182940057891552358942312728978810053715387504707194992816961400377579669789987032172834699)
+  (num-test (- -3220156644655019630 -8347829670073174550775641165362740628312221836466572623516708794243074870361401136762432100726575330214254748615114820602945887237367461962207075265579588481261313345359877816874924645801358760718027997416917747796144940020489321523749233377708490614979453376328244189926517907474704635785063100359787580409065317918203485474119227673185211436285930586838616288721370975925191964611302275354365110550116042403226844820172448647475637867255305805337047967053177320593337377763657329816935516961201488840745892529800883680912275812320160312651894919502389242002380151562481051684439333368396132543667539444686619670713) 8347829670073174550775641165362740628312221836466572623516708794243074870361401136762432100726575330214254748615114820602945887237367461962207075265579588481261313345359877816874924645801358760718027997416917747796144940020489321523749233377708490614979453376328244189926517907474704635785063100359787580409065317918203485474119227673185211436285930586838616288721370975925191964611302275354365110550116042403226844820172448647475637867255305805337047967053177320593337377763657329816935516961201488840745892529800883680912275812320160312651894919502389242002380151562481051684439333368396132543664319288041964651083)
+  (num-test (- 11628988978410243120 21091260149209133824278525560739673446778991946138130571540201996950100883736332286627324787663044982195445635023357027423513202277912840570399895946346028843517588470258087913846945044832851780108963206182331994065720076983528527849542421619745503796476103034657238118665288185878258232226731582201217795631247916614224227701409259346052937919425072595891571572960468193421257458185693656090215937518204243652916583730260295885562094977775951577484951577581277292356830523013216949489797535362720471761788697932265967910160407593278848113303674799017334692501935041730808945554336564957621028111014116286675587727714) -21091260149209133824278525560739673446778991946138130571540201996950100883736332286627324787663044982195445635023357027423513202277912840570399895946346028843517588470258087913846945044832851780108963206182331994065720076983528527849542421619745503796476103034657238118665288185878258232226731582201217795631247916614224227701409259346052937919425072595891571572960468193421257458185693656090215937518204243652916583730260295885562094977775951577484951577581277292356830523013216949489797535362720471761788697932265967910160407593278848113303674799017334692501935041730808945554336564957621028111002487297697177484594)
+  (num-test (- -15960716439913426281 18799211173341989380260980155501104944815245973352765317821146163884181375747259542484535639646490774929026134833947975785613727050541297797675705933339289016115326958150660323801621778641184271728990164666383865587422591755046779736996211052149338115836473967202556153668963815595875844414662034458693455631979862997316049580586739835122770408911308146605671192538040301857163633538268589024651373766021087864982140201615461513687698136663128896835597598904095187715456109340116329587986878167776146023396961265667934659006280575496363066974484893764810659481361856335795455814679851690737943592227795474197104696127) -18799211173341989380260980155501104944815245973352765317821146163884181375747259542484535639646490774929026134833947975785613727050541297797675705933339289016115326958150660323801621778641184271728990164666383865587422591755046779736996211052149338115836473967202556153668963815595875844414662034458693455631979862997316049580586739835122770408911308146605671192538040301857163633538268589024651373766021087864982140201615461513687698136663128896835597598904095187715456109340116329587986878167776146023396961265667934659006280575496363066974484893764810659481361856335795455814679851690737943592243756190637018122408)
+  (num-test (- -181065640455671431985325539445069267017 14120143334024043377) -181065640455671431999445682779093310394)
+  (num-test (- -91295299684959299024846233061686623774 6891102275697080803) -91295299684959299031737335337383704577)
+  (num-test (- -252582289949155881579950873916766853744 883304029266526072) -252582289949155881580834177946033379816)
+  (num-test (- -10104159950635417603045689770006558103 17251490913777465304) -10104159950635417620297180683784023407)
+  (num-test (- 288463495341489091297108607960869684860 -16376960611483226267) 288463495341489091313485568572352911127)
+  (num-test (- 204661965092367792468062569536290631004 7774991291341524479) 204661965092367792460287578244949106525)
+  (num-test (- 174559967167400201536723778015754014369 168183438971818617783400303174116396891) 6376528195581583753323474841637617478)
+  (num-test (- -253300708624436983509156598368557395374 -77166863757693227553099778725240875400) -176133844866743755956056819643316519974)
+  (num-test (- -38587765028356074196061530813295290944 5999161273284748726648331130480323187) -44586926301640822922709861943775614131)
+  (num-test (- -236400856885875891058508662756360145662 222191413471626205952456600591947275777) -458592270357502097010965263348307421439)
+  (num-test (- 212937903940173587742882129816769611096 336470165768472077447806282475185249734) -123532261828298489704924152658415638638)
+  (num-test (- -264812595676159375893264580577855253845 -247068943830535581577267897204259299723) -17743651845623794315996683373595954122)
+  (num-test (- -1725732715479127274526681751197327660 -2279805492899538651574406423954277869507456204136276822451602661149698386520868702017367409743272511010382761246500508887739763323997191435566266331339917) 2279805492899538651574406423954277869507456204136276822451602661149698386520868702017367409743272511010382761246500507162007047844869916908884515134012257)
+  (num-test (- -220007189346579184019349894240059989979 9116030813176547770422918633286023943039811682891023288884273747820892639481842291616424036020927750322528731882517057595815179415042385175627374957565803) -9116030813176547770422918633286023943039811682891023288884273747820892639481842291616424036020927750322528731882517277603004525994226404525521615017555782)
+  (num-test (- 139683266109784685815165642637380856544 5782493350903499652295971390391981928106911831248674750993968151944332845911526084530951283012280786005612601970108688202931002414214353708335212597807345) -5782493350903499652295971390391981928106911831248674750993968151944332845911526084530951283012280786005612601970108548519664892629528538542692575216950801)
+  (num-test (- 239160165978290709841254489756277328273 5152132850125501873897264811465207492706871561577273155117982457627773151595716641409297120994045059130053034927464958986304380141364542178714472948085275) -5152132850125501873897264811465207492706871561577273155117982457627773151595716641409297120994045059130053034927464719826138401850654700924224716670757002)
+  (num-test (- 315772704643232632782106484978382006176 -3689252327480456512393153800679864208480329729627292260734151097785848947569336194072922395859496552999163037466184616218582046814434719444842678248982224) 3689252327480456512393153800679864208480329729627292260734151097785848947569336194072922395859496552999163037466184931991286690047067501551327656630988400)
+  (num-test (- 82735713197488344149642668226610301853 -12473025194535761005577066561696471986140205263843017221991729197337093872383371857001077050460827652296473928714097816492579684543651922277865558518876774) 12473025194535761005577066561696471986140205263843017221991729197337093872383371857001077050460827652296473928714097899228292882031996071920533785129178627)
+  (num-test (- 63472235942371758467270296983419551089 -7866520408163137968600317959735552406794938230345293650627055135268307695389903092041438746530663083967329111232451176014649873249349534808700483360707382397988918594143264031213181385790969271527978925616276399184489007642142996251807222768397530946779296600805549276528669432847672215219943599871223372831999133812100481632278022608906065923652981249057846548868473376683960144009223047416366697876553049362242497225174860431577034875737250719899362881567590934060155436179316063810148362442197071642183371654740845983314705249832168923202400873364289483910868432511677656218937984504828452980698439495961392749596) 7866520408163137968600317959735552406794938230345293650627055135268307695389903092041438746530663083967329111232451176014649873249349534808700483360707382397988918594143264031213181385790969271527978925616276399184489007642142996251807222768397530946779296600805549276528669432847672215219943599871223372831999133812100481632278022608906065923652981249057846548868473376683960144009223047416366697876553049362242497225174860431577034875737250719899362881567590934060155436179316063810148362442197071642183371654740845983314705249832168923202400873364289483910868432511677656219001456740770824739165709792944812300685)
+  (num-test (- -284018520801241078671538235859630240269 -5529748211779294240854894683633173443789067073881249229985499707296461959655918837051490512357840133495603640185675483847478587849599477020706893805485599954539589062532211767295361120129440287144117406526027552427750375526095104163474774446716012360038076376952619723549765229763943818011605991300849052030142173100367582906381575666628005795818339029350398340616624791399526643991489247585213423174803853961438830286737553181353007081438503238779644371968004083452645077716952159339978836669723137339898471600546912430030276920763475622536295311290657163861398519747560279682401429552174530714298081464588450842581) 5529748211779294240854894683633173443789067073881249229985499707296461959655918837051490512357840133495603640185675483847478587849599477020706893805485599954539589062532211767295361120129440287144117406526027552427750375526095104163474774446716012360038076376952619723549765229763943818011605991300849052030142173100367582906381575666628005795818339029350398340616624791399526643991489247585213423174803853961438830286737553181353007081438503238779644371968004083452645077716952159339978836669723137339898471600546912430030276920763475622536295311290657163861398519747560279682117411031373289635626543228728820602312)
+  (num-test (- -171812101820192353275910956459431262142 11401673303315394031728944442295528921842441448377692701102691446500671963119794838260543877466107345474902885032629120622020177051592733148817057943390167845763358795044702079370835841331467130719834250134674578757640577473495192331790176510774020541399177011446664359866582351045889299070080989390219063301859447807907203943168891690028442190793548699886572720360741686677780644932612683647303776634496172481504075784427704287335805355801794320914944330891519283383694196486986108936857630373759865062862204149003789919218681050221366182434949855054760827976853645027544605870235074909890698574792562001595287630131) -11401673303315394031728944442295528921842441448377692701102691446500671963119794838260543877466107345474902885032629120622020177051592733148817057943390167845763358795044702079370835841331467130719834250134674578757640577473495192331790176510774020541399177011446664359866582351045889299070080989390219063301859447807907203943168891690028442190793548699886572720360741686677780644932612683647303776634496172481504075784427704287335805355801794320914944330891519283383694196486986108936857630373759865062862204149003789919218681050221366182434949855054760827976853645027544605870406887011710890928068472958054718892273)
+  (num-test (- -243638660221338112796448050030955119997 -32214383478080953899491069562585164652288236626686985994647827422262342469970423345510055643470262764747630363450204055220886177681745412924556264758690138113272748656941509018308925555317383307928766093730384151056027828368474245304944063213926492719166086055718735381341569379006804236876950175122702350552198046290567043195716369691666842524594399597143281611765509174168738392889075290806378316647736667077047013214732267367344808724905727602402784621437141760604478301412768904784950365257469208085143467704875589485635570084387755189599791857576855454112556762755762408826226326879491415484319411662301650468948) 32214383478080953899491069562585164652288236626686985994647827422262342469970423345510055643470262764747630363450204055220886177681745412924556264758690138113272748656941509018308925555317383307928766093730384151056027828368474245304944063213926492719166086055718735381341569379006804236876950175122702350552198046290567043195716369691666842524594399597143281611765509174168738392889075290806378316647736667077047013214732267367344808724905727602402784621437141760604478301412768904784950365257469208085143467704875589485635570084387755189599791857576855454112556762755762408825982688219270077371522963612270695348951)
+  (num-test (- -126332081511349770866908261827634312283 31497387372874133218238910173378055967910722258532087598053588964599898753455370244114881403020152175272452951858324158004662566613339529101292284073176382818309096142522412043073218657587031893636358434796164444941535757484360125937835242214199979245499374972029624710574236962978707708765065292759037309958875006017588240959790355958632745299212449602934380927677385974488564420550408281673927387615657765312151272852486266800510090872812376232597458154951925709496664568906509814364388823105469855516803225244972466742963619633076158367569109107733990828830121948130235858799809203410103682003414364238243553515261) -31497387372874133218238910173378055967910722258532087598053588964599898753455370244114881403020152175272452951858324158004662566613339529101292284073176382818309096142522412043073218657587031893636358434796164444941535757484360125937835242214199979245499374972029624710574236962978707708765065292759037309958875006017588240959790355958632745299212449602934380927677385974488564420550408281673927387615657765312151272852486266800510090872812376232597458154951925709496664568906509814364388823105469855516803225244972466742963619633076158367569109107733990828830121948130235858799935535491615031774281272500071187827544)
+  (num-test (- 219979452670016849533060110266815720199 3900115048441644499033281842448985956665866771934663536385503692700586024397767816761943054115584011069129310718114010862034970648115172218305599786238607524420973404711138276011261135403209178420948996472570042497859127324157786975578751148348046315727383390370594954695454631662061021971027739429505825056455676233533511412589936865597034183410893428831818716136282201523804692574965779771140320669492229416601369453681528301333865290947482219850340728455965391492610516639151652595539203632139883064874286555941718154489936421274731413286355640404192677546692090304496817063325766995908926108582896362623757323811) -3900115048441644499033281842448985956665866771934663536385503692700586024397767816761943054115584011069129310718114010862034970648115172218305599786238607524420973404711138276011261135403209178420948996472570042497859127324157786975578751148348046315727383390370594954695454631662061021971027739429505825056455676233533511412589936865597034183410893428831818716136282201523804692574965779771140320669492229416601369453681528301333865290947482219850340728455965391492610516639151652595539203632139883064874286555941718154489936421274731413286355640404192677546692090304496817063105787543238909259049836252356941603612)
+  (num-test (- 585873325961105129055557280004608765382109855007674169500308242261038324959928764512890600512016613154122762798104714052579267789493643522748210870974797 -1855792162818946202) 585873325961105129055557280004608765382109855007674169500308242261038324959928764512890600512016613154122762798104714052579267789493645378540373689920999)
+  (num-test (- -3026050092505200332789765255096964033685859497096213532090644235603419347590512426830117415222669642053441336442247132403948783838396746566100575461602162 18009081534399282710) -3026050092505200332789765255096964033685859497096213532090644235603419347590512426830117415222669642053441336442247132403948783838396764575182109860884872)
+  (num-test (- -11124638695599888462310706699308855434715251048597328942409434888923094027849143412724699165971400546471660924330688750607774759764580214088920441698992069 -4827559068742614723) -11124638695599888462310706699308855434715251048597328942409434888923094027849143412724699165971400546471660924330688750607774759764580209261361372956377346)
+  (num-test (- 4950293428090696283711882613183655723616682297360442241017758383241177602498881186549809051670562038601658285833496694108818253845693871318067007752043113 17597810481352184048) 4950293428090696283711882613183655723616682297360442241017758383241177602498881186549809051670562038601658285833496694108818253845693853720256526399859065)
+  (num-test (- -5733769947958740467479139247420201065087494801172241127791526686385518674532830661413722661802560247463032020003355494614502034002778775472609306735864748 -3892174127829225880) -5733769947958740467479139247420201065087494801172241127791526686385518674532830661413722661802560247463032020003355494614502034002778771580435178906638868)
+  (num-test (- 8320894458193427045187598554188178307429755504967209344418448624882517461814957461249858674758807195827056824653471934409067429988676743031117653237018365 -12861394200627120797) 8320894458193427045187598554188178307429755504967209344418448624882517461814957461249858674758807195827056824653471934409067429988676755892511853864139162)
+  (num-test (- 13033402737450594044106258936169013897237368708138118260402180886096095497725071502601849887805439844083105685971731015312020770945603825344926844435936044 236396022362585261770052671762207864597) 13033402737450594044106258936169013897237368708138118260402180886096095497725071502601849887805439844083105685971730778915998408360342055292255082228071447)
+  (num-test (- 12170667278114656173974716189098171384426379753661081475485441559687661443127166543908925678856145097632475832903680828294561265828775791256812588754280222 -276673555533799047589626400978981416789) 12170667278114656173974716189098171384426379753661081475485441559687661443127166543908925678856145097632475832903681104968116799627823380883213567735697011)
+  (num-test (- -12755594876262399860618168642932232021734362385933348033134635580177924615701078617214764415318471507488803810365565826229169313660087149542130819663319659 -157671440495648010763311068579191828684) -12755594876262399860618168642932232021734362385933348033134635580177924615701078617214764415318471507488803810365565668557728818012076386231062240471490975)
+  (num-test (- 8664063140780163008577373335591938905735059211566906376953760862047748343846207426667781783874718320339071949903053785280430612875488847226724390758938740 54361107931665215623681874454167019934) 8664063140780163008577373335591938905735059211566906376953760862047748343846207426667781783874718320339071949903053730919322681210273223544849936591918806)
+  (num-test (- 3699576825118349347309026261327541749454660339251578894574483235547605815416603169143590292164644149607672871236942391817131531474661895913650810587431606 -50508350367572393968128467319633674717) 3699576825118349347309026261327541749454660339251578894574483235547605815416603169143590292164644149607672871236942442325481899047055864042118130221106323)
+  (num-test (- 5626548453644136572409808769267055618695663227750732922630041368983808478347120771651822300668480671524976882745306794511840379704578900504784165956486985 170502882789371639987361620116696459267) 5626548453644136572409808769267055618695663227750732922630041368983808478347120771651822300668480671524976882745306624008957590332938913143164049260027718)
+  (num-test (- -10859007735074693411217019392659638207496329895257318665547454149984863458541990037760564769787816800806064437172810158051442267508476778676439633382657890 -7558060977666720080449823996328496253877735754811271086853901493753796001778345391546991917892931500169890406340928835457635973812901681485438886367096185) -3300946757407973330767195396331141953618594140446047578693552656231067456763644646213572851894885300636174030831881322593806293695575097191000747015561705)
+  (num-test (- 9842028993407961669727766131360795288615020071102475108883839785397865740828387076847892646234215787999498419839351470775471313077046438080666908734795616 8259939762466350877481193620364896193464602165170783019804380181692322874550956777598992104871440502758410340359413403619753571535498118388286469082729503) 1582089230941610792246572510995899095150417905931692089079459603705542866277430299248900541362775285241088079479938067155717741541548319692380439652066113)
+  (num-test (- 3122315115429970622394662815735050825423438028108957393747131991771456957037829402044934484343765915727397519247940959221091465331254497476137639859816450 10737995515603450913722681305571315249864367824351372254572936648132763616823019940208526402092654554035074813865303483747097673960803093638463005072804384) -7615680400173480291328018489836264424440929796242414860825804656361306659785190538163591917748888638307677294617362524526006208629548596162325365212987934)
+  (num-test (- 11618335890332522671268040181306950825004789685088262996478365976802329054158653675768163009290064139158450983598701977173152384425333441365287895694522192 -13130287008197231017935223399369698658354829835061356451363818961959486828237111511740029441613108087354987794332115218978284937263725126538295501305403242) 24748622898529753689203263580676649483359619520149619447842184938761815882395765187508192450903172226513438777930817196151437321689058567903583396999925434)
+  (num-test (- -4829477140897377009195646150061276059814366801005389903693533021027427566117360765323647260121062827801190746646296803957067548167571028717513392985791293 10716557117391614298810040587314742187092120526669273567183969821384063434473189717686678450880765426943205955814024872764413373364846268902370055526485180) -15546034258288991308005686737376018246906487327674663470877502842411491000590550483010325711001828254744396702460321676721480921532417297619883448512276473)
+  (num-test (- 1560421244904974852620371975782132605421448226892487453928759432083522187778803424020804578027100625536441377609275030418285893555753560195716001014786650 -11797558308994912054526619290334311429749533070145154703018977152548370444659962978040151671210413666186432921816690953994784423526183449271023503069393845) 13357979553899886907146991266116444035170981297037642156947736584631892632438766402060956249237514291722874299425965984413070317081937009466739504084180495)
+  (num-test (- -7701347923966912534344428538744620884561375267012102797292378941649984539207353887059064943586048644516121387166836442084007442716291792933061162738380376 5290969389374230541016502448421359606252744677802288901830045825873182202718418905866055323957065013553046698199939002159982374580735362593037515863844280108947533575824820196689891621498006303535207762625068798755031433921940066544809959896067184147997503827988613858484669349726945188167613248195147619673963531690938913245110754715059472477991342216448470339490385593605806518967792963339193162830698488489270925945408227996742278697477358272529028932771642478870844024835907350391770605391526921411004262446196112836319091260967898895009427182171643279100998182191816962677328417390867021108292139204864164048286) -5290969389374230541016502448421359606252744677802288901830045825873182202718418905866055323957065013553046698199939002159982374580735362593037515863844280108947533575824820196689891621498006303535207762625068798755031433921940066544809959896067184147997503827988613858484669349726945188167613248195147619673963531690938913245110754715059472477991342216448470339490385593605806518967792963339193162830698488489270925945408227996742278697477358272529028932771642486572191948802819884736199144136147805972379529458298910128698032910952438102363314241236586865149642698313204129513770501398309737400085072266026902428662)
+  (num-test (- 9733743430220591762422540139212426729307515492818443460852332805653889275463385649305231919846970974905736816260992940027028218064265519723018527155353151 -29407855293830047984154639411082591337348779678279017647951764366455421210163494489475996514661359700145916243499452007595041420522019751347743105082745321262372977262641488359297167392118038994384136863563032667040671405618315550876997904307423736276844997706938133936081058323434935833614475654922773162140266784233792639117145232791514703532554345086520312281500696798706889025860427142771458666376271994240028586899592254884476941388776984078337603148583453255593120138178690189726206775893096279000909079330468718593887702543025737308336025198677457129910473491269839827087491228569718246503140134413881896746751) 29407855293830047984154639411082591337348779678279017647951764366455421210163494489475996514661359700145916243499452007595041420522019751347743105082745321262372977262641488359297167392118038994384136863563032667040671405618315550876997904307423736276844997706938133936081058323434935833614475654922773162140266784233792639117145232791514703532554345086520312281500696798706889025860427142771458666376271994240028586899592254884476941388776984078337603148583453265326863568399281952148746915105523008308424572148912179446220508196915012771721674503909376976881448397006656088080431255597936310768659857432409052099902)
+  (num-test (- -276731217243271862683214238489380950428392903790808046630969592255272629537001990355375434170910931115552132394269672247616298060929507021008951190291387 100289083769237476480554074865040988004216167545459907207847010762380733541100608695693297149249375537088329431700364201275915507683345148401600569951338052791424407090330310974243070931256108167365334162914085216447196038922091547331474328250886730614683299908003398886233860613008266913065047699535081030427106800418656336608005860846045905149012346378286475449307630537665901621055008855374148058291266835796203075976592585729940879567246284967856356337849150102261744547461816282538319258966892339056695718919291240188920586288417893106046698069355647145603908383687239983874164793005765733782432717429040621674) -100289083769237476480554074865040988004216167545459907207847010762380733541100608695693297149249375537088329431700364201275915507683345148401600569951338052791424407090330310974243070931256108167365334162914085216447196038922091547331474328250886730614683299908003398886233860613008266913065047699535081030427106800418656336608005860846045905149012346378286475449307630537665901621055008855374148058291266835796203075976592585729940879567246284967856356337849150378992961790733678965752557748347842767449599509727337871158512841561047430108037053444789818056535023935819634253546412409303826663289453726380230913061)
+  (num-test (- 8505070389896098095621766692413480203366379968950158493268895987250690600795955783113900096527432416791184386061684833478921638080978014176210898461637606 -16410711613672171332126342754193842244915477287016327757357714698751777287458963458682349581881560880814595167244857846847668988374679430572782121021084683986742283012573569894084166107235597351093334125816075658348307113218478800035703971671113417712009419861470917307849916674203301497919242668373376352901312309673053175315189945730756118172940886476343290174961420986113367531057713782438374928471960914578818951372282574754612716278516397754222547513576728677459134022062202283647690649100602260948409511070624300011106517649666031530376191755817891213910847547809248990517666613043010292627100428536737652546738) 16410711613672171332126342754193842244915477287016327757357714698751777287458963458682349581881560880814595167244857846847668988374679430572782121021084683986742283012573569894084166107235597351093334125816075658348307113218478800035703971671113417712009419861470917307849916674203301497919242668373376352901312309673053175315189945730756118172940886476343290174961420986113367531057713782438374928471960914578818951372282574754612716278516397754222547513576728685964204411958300379269457341514082464314789480020782793280002504900356632326331974869717987741343264338993635052202500091964648373605114604747636114184344)
+  (num-test (- -12618010259109779267590315037969998053964054382853891516547435925972388025118492931596200697357628900783311183940584302426381939302632641549019984810957030 -30500906828861638007306362171210132987300359439962044769219457463653547834815716264412200930088623097530758080891972640000479943534665059199377729854850415258341537838023739964147532129877743393965857370995558748807382396090020006195649251292012405690725917389684473999400905751109361754679152179983739269026226054012963756892488872262522587481931950410504651253101938824790285623805566521723062029033001745636445860437154344665483641408727637784045030118212476306906983993748299291616038887011943864441807818857508443930272872365334665976442185494702520760793786640113779099219233665607521784524244604432396247693263) 30500906828861638007306362171210132987300359439962044769219457463653547834815716264412200930088623097530758080891972640000479943534665059199377729854850415258341537838023739964147532129877743393965857370995558748807382396090020006195649251292012405690725917389684473999400905751109361754679152179983739269026226054012963756892488872262522587481931950410504651253101938824790285623805566521723062029033001745636445860437154344665483641408727637784045030118212476294288973734638520024025723849041945810477753436003616927382836946392946640857949253898501823403164885856802595158634931239225582481891603055412411436736233)
+  (num-test (- 793528769616879938852241178439496352527042950647521648629732169156958768358523029837406526207126598190786120139491813624819360632811627576064199559812277 -7357484069649002655190557040768215614708659708788999334802985986235721030962928900092675952032143512196279092521450986819067071570862007086586132687661085824939677603953832219860573980632016025218580608321648907608385784471745482257672314890331358256478273312255285010343369949412955387472116587504557483184506548209831317705115523967163525846685455369176657510129844566195941925821733027993620517287411895496215426174909366458092382652675628195464969405904518323018004882611048769247228828875493680284766874334247375868318795940759082324831733175858991629741478124633015067484305547002438816473086042218906532116413) 7357484069649002655190557040768215614708659708788999334802985986235721030962928900092675952032143512196279092521450986819067071570862007086586132687661085824939677603953832219860573980632016025218580608321648907608385784471745482257672314890331358256478273312255285010343369949412955387472116587504557483184506548209831317705115523967163525846685455369176657510129844566195941925821733027993620517287411895496215426174909366458092382652675628195464969405904518323811533652227928708099470007314990032811809824981769024498050965097717850683354763013265517836868076315419135206976119171821799449284713618283106091928690)
+  (num-test (- 30958566711373255787092081401292877738974978442987704470984765018293851031728996862405055424093249924047528792113585028592262445810946419909807061004531455817427671594281537965628880611732831524185850161910304038646992464838306728350704966234151134620041799373762432970330864023007632010865749239024802839173884778578927209741320635135275002489733299806669933393428518104197594560039136096527206600870299327752296492029012993590212340409989598323540081430189567580333356380487749078595746626408529223195894600223743978246922817054226858311823994547784553612982586322603593335538875728113115443554199017672360091721648 9164115638960783470) 30958566711373255787092081401292877738974978442987704470984765018293851031728996862405055424093249924047528792113585028592262445810946419909807061004531455817427671594281537965628880611732831524185850161910304038646992464838306728350704966234151134620041799373762432970330864023007632010865749239024802839173884778578927209741320635135275002489733299806669933393428518104197594560039136096527206600870299327752296492029012993590212340409989598323540081430189567580333356380487749078595746626408529223195894600223743978246922817054226858311823994547784553612982586322603593335538875728113115443554189853556721130938178)
+  (num-test (- -22540807692474380279530794404584230073523360203115293035869063366926380719566516089428840111682263403627532047214106171892715667227836310498366393991106231487046533598391969789120283294510723096483520917309134391072655861112766764278247568027435618337967113341863713181603534251049249873125130781073437913954718595729437608729446837417196899902194261111827656247095442897532040935029872731410799530408713850806239149348700486268275019296069828199088780767614008685960242354118969741283398882689239770114582524756296906388861630890288875920861344939520380841337675934551587994259348267613541166769237154904791412049964 16928681651977808800) -22540807692474380279530794404584230073523360203115293035869063366926380719566516089428840111682263403627532047214106171892715667227836310498366393991106231487046533598391969789120283294510723096483520917309134391072655861112766764278247568027435618337967113341863713181603534251049249873125130781073437913954718595729437608729446837417196899902194261111827656247095442897532040935029872731410799530408713850806239149348700486268275019296069828199088780767614008685960242354118969741283398882689239770114582524756296906388861630890288875920861344939520380841337675934551587994259348267613541166769254083586443389858764)
+  (num-test (- -5403850875869356031749551669837202919756114555261706106905659104903792701565965475066159243529680606410723686422444947172225540145977333194008702465610630608545009270872541652430806931212184915840724378685979865349848151917650322286497417985248678815214889868576385900691591784772762893647315325310416150353725001943778473686980157692817497562783521120544549784746647104651038037129984152623720529803205580894126664077380391379306511348324442512538418658728022685805514196592544294177914956734669359073791151050869328577099869772182315103156047405800398706114122356939316464974680113324979723289916823063616573634058 -10755560408227106818) -5403850875869356031749551669837202919756114555261706106905659104903792701565965475066159243529680606410723686422444947172225540145977333194008702465610630608545009270872541652430806931212184915840724378685979865349848151917650322286497417985248678815214889868576385900691591784772762893647315325310416150353725001943778473686980157692817497562783521120544549784746647104651038037129984152623720529803205580894126664077380391379306511348324442512538418658728022685805514196592544294177914956734669359073791151050869328577099869772182315103156047405800398706114122356939316464974680113324979723289906067503208346527240)
+  (num-test (- 16201587974698660164372991183566748501003872177894450603471850345714117528335101264234127789041855420954511595895378320972957964222386731614839583078498685801156670229700092209313747849610762975747730086443186821337319452128253859293962343891549207804191088925361935683615063225197130192492652062735684739784075955094308092423304262201429421582566117390598395895220976999990205945523225411701169301910362640419341608407294018105959688929256136725564385243617240412649023368133778798063226772467915584333795357813292935080009919284755332034998122912861893282865727947810588086156919649131720183722427134042574317487793 -126159569916621842) 16201587974698660164372991183566748501003872177894450603471850345714117528335101264234127789041855420954511595895378320972957964222386731614839583078498685801156670229700092209313747849610762975747730086443186821337319452128253859293962343891549207804191088925361935683615063225197130192492652062735684739784075955094308092423304262201429421582566117390598395895220976999990205945523225411701169301910362640419341608407294018105959688929256136725564385243617240412649023368133778798063226772467915584333795357813292935080009919284755332034998122912861893282865727947810588086156919649131720183722427260202144234109635)
+  (num-test (- -9976758107386398142455037422077809088581080675608340830198269021688955930541332630075972471934165382030070969307731206728197760190279942894255740733209190331510591013089699837164445642396864912572863786290237335963836376543389815671640509582958465164874961381137096877288362944469137669502842448492172241151419831252572392809173900377271652074261706120638052379886108764460001026094198502028776365675088466580595870167840105746912975236851293882732079317535103041585285239081516202482201377111734010788198635874359396626004300532752450289119192633850562141516671742961938277967783337559307443617308447853505824391099 13449070890444925581) -9976758107386398142455037422077809088581080675608340830198269021688955930541332630075972471934165382030070969307731206728197760190279942894255740733209190331510591013089699837164445642396864912572863786290237335963836376543389815671640509582958465164874961381137096877288362944469137669502842448492172241151419831252572392809173900377271652074261706120638052379886108764460001026094198502028776365675088466580595870167840105746912975236851293882732079317535103041585285239081516202482201377111734010788198635874359396626004300532752450289119192633850562141516671742961938277967783337559307443617321896924396269316680)
+  (num-test (- -8570952518585194406209873586517687582701183275108243979199329595605282282125006489076327154374449108678257552384372919282846744626955206382078850958298637157198962032090439427286914716782317030245513658212430127586764421559372214829010306717557679285031617989735914399954286846456953917915955558448774972943731602144914068097214910567329340361564904028964471241318105967747431610163083002382821902859161510204381788262611298660559327478615315484763561786397041779926288206767156863141140852268323253657685018587945456372648431446464389004257999049529945532453598011773843788498650935959375182414447893892341891463988 4431555062692055371) -8570952518585194406209873586517687582701183275108243979199329595605282282125006489076327154374449108678257552384372919282846744626955206382078850958298637157198962032090439427286914716782317030245513658212430127586764421559372214829010306717557679285031617989735914399954286846456953917915955558448774972943731602144914068097214910567329340361564904028964471241318105967747431610163083002382821902859161510204381788262611298660559327478615315484763561786397041779926288206767156863141140852268323253657685018587945456372648431446464389004257999049529945532453598011773843788498650935959375182414452325447404583519359)
+  (num-test (- 4117976000917214601143188578494558474138167055110060832594841842655428229500889876131794484851166401425675703592388271925904534237338595998991043982676292549088043959446082382516734793718348862105938692342851330680670593768890094290655852108130945387988863730762717733881418314989528719379494082656897158942547008663543153236129762264443358316776532465284014215413819415615612452225913947961681691310132286840303081453109375175436902292224029179426794714036524361081174901146731799945483243427138748119832116750910126386838614645397770107366925613473924955965862778639046707637382775371488874447622330992324750207465 329466253508616383200261654231797136951) 4117976000917214601143188578494558474138167055110060832594841842655428229500889876131794484851166401425675703592388271925904534237338595998991043982676292549088043959446082382516734793718348862105938692342851330680670593768890094290655852108130945387988863730762717733881418314989528719379494082656897158942547008663543153236129762264443358316776532465284014215413819415615612452225913947961681691310132286840303081453109375175436902292224029179426794714036524361081174901146731799945483243427138748119832116750910126386838614645397770107366925613473924955965862778639046707637053309117980258064422069338092953070514)
+  (num-test (- 28857935543824608075326348244201981931023939250259142606733822094071772153858420201297951828741003977413353359215638528196235956061529059419904405354390715114239219947402126760298132539402386106279333968395498788354937020337343839325588433318100331044091923709732742795159387846354148919054314582749477292946200912006940503778924320301062789466388997936618573519744795661160190636101768486096961991215006236190655062992372061052426455063703038765465688361316141792840153608145888307784845264037109867657483109819380082597605481013612040648149090345778910883349230476481347645708269410828528742743794495302359380494607 126536164564464424337714470705049463978) 28857935543824608075326348244201981931023939250259142606733822094071772153858420201297951828741003977413353359215638528196235956061529059419904405354390715114239219947402126760298132539402386106279333968395498788354937020337343839325588433318100331044091923709732742795159387846354148919054314582749477292946200912006940503778924320301062789466388997936618573519744795661160190636101768486096961991215006236190655062992372061052426455063703038765465688361316141792840153608145888307784845264037109867657483109819380082597605481013612040648149090345778910883349230476481347645708142874663964278319456780831654331030629)
+  (num-test (- 3146199586408378667812619157270468624370984629500707476575291934586478540055436137993431548830607708293475788354970610669452058906009873485175438772484599603993015239438297747261356407887781450787482447252615210880612867127689283653562498484594955015919746443263740095372831444793239911996227663006098501180972347442107190398034048225264564325230296723559400768342331039755765597288518435463475921534765025262262798267314969774604439319964638461636007229819888743218820584570149249791727508891676067767073852694327748467914037392778283816153183422263956621516748627574334199731850712255885395479903525322397561293553 -169494171680584797187706369710105239124) 3146199586408378667812619157270468624370984629500707476575291934586478540055436137993431548830607708293475788354970610669452058906009873485175438772484599603993015239438297747261356407887781450787482447252615210880612867127689283653562498484594955015919746443263740095372831444793239911996227663006098501180972347442107190398034048225264564325230296723559400768342331039755765597288518435463475921534765025262262798267314969774604439319964638461636007229819888743218820584570149249791727508891676067767073852694327748467914037392778283816153183422263956621516748627574334199732020206427565980277091231692107666532677)
+  (num-test (- -17024716654716744558842421452239026542281806678754026383430912733874686056449261218428541803113383766132449624540209841726047308927951820311213785345168358108138304716549475322223600292513384537980742126687035576531330089447100646214364923043445903103768701639992829171572718403272488931980504461938688955457870904289239032709146514866818331202329982821151580491257491540240579366183525075936339515949345815704583685855315810611089822402567649542290589282153225725537026309623090382054078872576985425957096858376112688308214148412270019118710904983829984589093557307164347051152307499446188262820058714564165108542508 -26845770031559702758807696432929071597) -17024716654716744558842421452239026542281806678754026383430912733874686056449261218428541803113383766132449624540209841726047308927951820311213785345168358108138304716549475322223600292513384537980742126687035576531330089447100646214364923043445903103768701639992829171572718403272488931980504461938688955457870904289239032709146514866818331202329982821151580491257491540240579366183525075936339515949345815704583685855315810611089822402567649542290589282153225725537026309623090382054078872576985425957096858376112688308214148412270019118710904983829984589093557307164347051152280653676156703117299906867732179470911)
+  (num-test (- -20875354448001792153279041347864644172439177882677780548397567327274288309764204295853633150227327732322157811413794613378828291977852467550695289535036337326494269114787031260705326469002279939986228049380615128280814933748700667874022724707001736732724010699175779382411342385842744973636495738468838244099596215421975861650998954057316519632062827510021706536194961332185926551767127180751211669386674770139039516623606727799489291663572125587356845055646322930167536458093283930082765496058330805117442824718962237069840252138957395570892073194575112213410604881673785921789655406716271370732069643455590690035701 -321447426701397438572265325285879998363) -20875354448001792153279041347864644172439177882677780548397567327274288309764204295853633150227327732322157811413794613378828291977852467550695289535036337326494269114787031260705326469002279939986228049380615128280814933748700667874022724707001736732724010699175779382411342385842744973636495738468838244099596215421975861650998954057316519632062827510021706536194961332185926551767127180751211669386674770139039516623606727799489291663572125587356845055646322930167536458093283930082765496058330805117442824718962237069840252138957395570892073194575112213410604881673785921789333959289569973293497378130304810037338)
+  (num-test (- -6750548706930727136186675393752693335334383613941059024795513640678178119089262068912855951615043660442324823673049951182143778744824110223137384940032268718291241014850714197673735719784663896993460156686600813524168487673234842233781654493200950459723884918456280719440022930492599128086690014332139955274261568563155723011697763382009890186816226119314994799655369791620499988988986590903148198659095740939986627235565633349906453726759224441608018598520571182643709143072528030332708598472074166415467718451869993686505339408706320298338691467040585228617379086727764240955696690287600957842671916189752415855520 132223863177855649509430852484092802671) -6750548706930727136186675393752693335334383613941059024795513640678178119089262068912855951615043660442324823673049951182143778744824110223137384940032268718291241014850714197673735719784663896993460156686600813524168487673234842233781654493200950459723884918456280719440022930492599128086690014332139955274261568563155723011697763382009890186816226119314994799655369791620499988988986590903148198659095740939986627235565633349906453726759224441608018598520571182643709143072528030332708598472074166415467718451869993686505339408706320298338691467040585228617379086727764240955828914150778813492181347042236508658191)
+  (num-test (- 15737797902964168014939893286340956118635524170934156177365242966267432695262586636031957242055461736359478270642576860414422844075672388559647477705484719667060463718865742735598799928335211410004369240278699196301127699945374217439676378682879115442203681638050752745036508637214733712716867800216723838016099572951915042604603457902610639317648800296497583507890473114507231814851908526534709496988648572353272479026750068932474334642929727977996779536604912743446197670724757690108283368934769626461285961947257397454619164856011847736479229692086038931510067165282571276049292116713101550911614590774659556899356 -6114512833799784097991148713266650451765474382378581896952003894922931741133332233338460555227243451198289670274036744955599177213449957470212981501678055) 15737797902964168014939893286340956118635524170934156177365242966267432695262586636031957242055461736359478270642576860414422844075672388559647477705484719667060463718865742735598799928335211410004369240278699196301127699945374217439676378682879115442203681638050752745036508637214733712716867800216723838016099572951915042604603457902610639317648800296497583507890473114507231814851908526534709496988648572353272479026750068932474334642929727977996779536604912749560710504524541788099432082201420078226760344325839294406623059778943588869811463030546594158753518363572241550086037072312278764361572060987641058577411)
+  (num-test (- -26633154627863501044020127597209297142657179797586777727331879111280843451446814109347357601013807189824906954310855123313836812409388745541128842840054310853220032505914307470215180950497357091093642400638925719682307925365402618310180378684705799724964274776149984064608716300479893889145492885897234574442542501896696821902329473018442082678749291668341477914681413039643187020003425962922948452894682558162414623956491734656939841377698702802567258906642912449969621455596132708975438173455827361542712483153981422051943690720556013580161324856788091093465837542336129629269227369781823515673967591796132853515009 3321161637038961370471515250185392889390643163295535903347391615170504064647249127732639364682803744773593849851778894972403397573953564801884397178069327) -26633154627863501044020127597209297142657179797586777727331879111280843451446814109347357601013807189824906954310855123313836812409388745541128842840054310853220032505914307470215180950497357091093642400638925719682307925365402618310180378684705799724964274776149984064608716300479893889145492885897234574442542501896696821902329473018442082678749291668341477914681413039643187020003425962922948452894682558162414623956491734656939841377698702802567258906642912453290783092635094079446953423641220250933355646449517325399335305891060078227410452589427455776269582315929979481048122342185221089627532393680530031584336)
+  (num-test (- 27668394897866653012794531261739800318882766882548843941974485394983434533400277607364280566269718161470415771058329222680901477416257843578362127708934184467195154000133252468684612556324066063725677629160438683034201285122508880444372096430021219637788794365539396242345208611990491721052691567092029622640533057073151980959055665792776356282961971341363712186503783566960850166774438868528799819047163739437906559674823146932668464230936946321915236658512741918196732794332451120218658490129307932187658010681746557120172585093207839141764683325214902696969028472942954863209641597556494684135445935915485525220911 204625459185084436546676461283890328511903949966691877662249903659689934813784661695047569885195881142676761876303280806728760511429260843727967794322777) 27668394897866653012794531261739800318882766882548843941974485394983434533400277607364280566269718161470415771058329222680901477416257843578362127708934184467195154000133252468684612556324066063725677629160438683034201285122508880444372096430021219637788794365539396242345208611990491721052691567092029622640533057073151980959055665792776356282961971341363712186503783566960850166774438868528799819047163739437906559674823146932668464230936946321915236658512741917992107335147366683671982028845417603675754060715054679457922681433517904327980021630167332811773147330266192986906360790827734172706185092187517730898134)
+  (num-test (- 18944451653774463090918576081661764936021793389045063662102219434278236461286997354190032851092512146937346521704215170240383659165117708716738711782597164244188741818096207452074083439983059414271417130274747048227795964884943105011205424198661201055104372863019759130697888820715782179466491256695453118035286889359217448004524564796840711987314064158194625731263591557915838970249677548534895064545467992194029425250039951132361639559343536937119283951538321037694842089561504643350632756961329867761604760788760440497535611072991056505806805291706178639395690245460397975614715123591611301423752799666149495108752 994321141213369910357526037382331323092462599623554452705525887587326552002660849455542761618020243106424015447778226642816634338781654345001677083881111) 18944451653774463090918576081661764936021793389045063662102219434278236461286997354190032851092512146937346521704215170240383659165117708716738711782597164244188741818096207452074083439983059414271417130274747048227795964884943105011205424198661201055104372863019759130697888820715782179466491256695453118035286889359217448004524564796840711987314064158194625731263591557915838970249677548534895064545467992194029425250039951132361639559343536937119283951538321036700520948348134732993106719578998544669142161165205987792009723485664504503145955836163417021375447139036382527836488480774976962642098454664472411227641)
+  (num-test (- -25075128489482657321316021943980016828761861550379828525731288423212311433274066958090940464803020097932875912251380196071686918459370667428905844496548191635733867314315152547202859654044591981512687559437417616479425752991419002108503390319869665933757684966460526631533822984311725217788657567199485442486045019468844265484117570385156844404625735176559901986920712550964238722824122000259551821135404274194791706113272773768366572120227974096419295159271316157215551931810740200836725504693738229444336470213883741520460842708733150362983831267583568258736572295448486287825894301201018490203520738439038977754991 -7402949251688548738762242219263594861535354011996392637087346760786292549376145193266590582054224293289596877537643409310483743293801574030358189880866069) -25075128489482657321316021943980016828761861550379828525731288423212311433274066958090940464803020097932875912251380196071686918459370667428905844496548191635733867314315152547202859654044591981512687559437417616479425752991419002108503390319869665933757684966460526631533822984311725217788657567199485442486045019468844265484117570385156844404625735176559901986920712550964238722824122000259551821135404274194791706113272773768366572120227974096419295159271316149812602680122191462074483285430143367908982458217491104433114081922440600986838638000992986204512279005851608750182484990717275196401946708080849096888922)
+  (num-test (- -26509487378481600038412836495388065888781507388737194948728047318975269277448073484403390476243134990463394380967295356958474984927721196047241216945988250219075749832868804186657201899994373052648345989716938779173325348547767647529160988985542438998030764420175306438858518207072038513664360905985908879070216069156102379349899544471658754952888660878997691670566078979940005195987259493512159628198906090101827331841914429358969184839073862821059400943312264269215878469013316796620921077244799814690434355127994011220041638393750697699141479399553359747084811371804524490919966410379714725200415331414459870271869 -9247155945465656153397925559476432992975541781462281935278489123804934847762489500833913193183733932905776020790478662969835879365116238125565077744775032) -26509487378481600038412836495388065888781507388737194948728047318975269277448073484403390476243134990463394380967295356958474984927721196047241216945988250219075749832868804186657201899994373052648345989716938779173325348547767647529160988985542438998030764420175306438858518207072038513664360905985908879070216069156102379349899544471658754952888660878997691670566078979940005195987259493512159628198906090101827331841914429358969184839073862821059400943312264259968722523547660643222995517768366821714892573665712075941552514588815849936651978565640166563350878466028503700441303440543835360084177205849382125496837)
+  (num-test (- -17010604274474750006607667808593883725990508452473783283717890546525148212376267233909567638545898628257361383837671935903199638230375408397752251127816717091041943873728526445398525706450929660366518707254053655364610471112296477865068960744948010561798109833411657930112293904378353445961131058136287425064317621271289456901138718557297733713446119244533144377470099270824020439428168481914824420861176457152299497728390918971852021025089592998997807574907789524112450146545688385954763667980124432645276563626082835790429598328230426471161191074551543308732791287559033843466623138171520961684959997180979203053477 -17319079025684619178510812811805110270463447771889107440996086020812918555191263705580533644731591929176480040622705607552852994906782176254877135818109655911838591767583157894999741648979817400330572419476101372927546509769818404491634583907246692993992514876697330603464497645633398167129555001859772111887143352351860130929715392173452396253437927361301990735683539169040916027268831202732178553152351117118606495416985612909248422655861312689027789401950549626643389790516560291620711705848717875304929186131258525831197192620523261738944873398924939726689336762464320190834794155527335576391767307110012289717973) 308474751209869171903145003211226544472939319415324157278195474287770342814996471670966006185693300919118656785033671649653356676406767857124884690292938820796647893854631449601215942528887739964053712222047717562936038657521926626565623162298682432194405043285672673352203741255044721168423943723484686822825731080570674028576673616154662539991808116768846358213439898216895587840662720817354132291174659966306997688594693937396401630771719690029981827042760102530939643970871905665948037868593442659652622505175690040767594292292835267783682324373396417956545474905286347368171017355814614706807309929033086664496)
+  (num-test (- -28362352496476494327713713233021518136860402239251781438945998574753662942796270292818595738100959519541952077905620088422871490191217157269435052965329201030095268586136492980900212955645939325800541690754639292707053269767151001292253701853012092829784482071789669480438026889625605099744553642207773753943711175375843649210118677569597324789367425691177169929576236753018329085700397911235750600921874606148324025962628852167093806152864269874177214562322576097931390470469397118268354868919899638376323751276807304678316688836173746719723312665764603485606350244811113608471530958617108833879194264695174468397461 -4081062111675377984305281082755054920741203741273067094307824323728798665450292976016160959354997082250970415737745853292134965575242789548167162064123232363464302136338349828801951197252612093077640695564825095503535921549690447893467349156939791370286866987224201115453216606688305427702274940837032716124925028835914047967887674858015919302546781010326385758988488478290741665427521820112231266659657169118374988259423444686317389869729817643396097464874333968181509317307320406521221309011946212308190273531009796563611621389720223920155554879800901239072885025170342349379379336047732368458185953903872634982504) -24281290384801116343408432150266463216119198497978714344638174251024864277345977316802434778745962437290981662167874235130736524615974367721267890901205968666630966449798143152098261758393327232722900995189814197203517348217460553398786352696072301459497615084565468364984810282937299672042278701370741037818786146539929601242231002711581405486820644680850784170587748274727587420272876091123519334262217437029949037703205407480776416283134452230781117097448242129749881153162076711747133559907953426068133477745797508114705067446453522799567757785963702246533465219640771259092151622569376465421008310791301833414957)
+  (num-test (- 10367142604728811799331249565431331488313655422005202933702176605382043644320209814639311439871418581341534233560256605231366966869093495784665834232350567124110194965198962966795893926025854156729633358240069116588609932539289897499402463770167927610848388138020589286461244557962368497723086593344721146859584146431437967506007518396464517349944129896971137720357645026281243138165214047233258394590454775153944241555543594427555914116439316287902470043292624597940465373006598913770411505099332700167695871387948271302951230983772351549087620538875967635100644404345317626621438913980275970160864401622986870735123 -13323117602411502623386235160326625769048477819798659261203460002048250420188223753407093545503703207645050883770850457071863684414849353264890601744588860687970804808452855795406182324143949747985869939791374195222513169904228914579995165180964917538177994190229733465224857616114628815752065632238207474599531507602861647623695058640735949593381112671690796335596142010430124683781417828023076027476816068202219709673411776556090962187853799456968290579708094595903778622705850818245685205707447012659247018940946510378371952655457988959551256869060428488498330109152756599450626641948447980234503249330875085656261) 23690260207140314422717484725757957257362133241803862194905636607430294064508433568046404985375121788986585117331107062303230651283942849049556435976939427812080999773651818762202076250169803904715503298031443311811123102443518812079397628951132845149026382328250322751686102174076997313475152225582928621459115654034299615129702577037200466943325242568661934055953787036711367821946631875256334422067270843356163951228955370983646876304293115744870760623000719193844243995712449732016096710806779712826942890328894781681323183639230340508638877407936396123598974513498074226072065555928723950395367650953861956391384)
+  (num-test (- -25321281404861286799950777949097462701962113587443565138655462269365151737118518315058035825695270231347401755128007072923189452859397209062457461602335603630181865680063451525170253746137368267674863889514153713728814272332433431604233690200451816570240227260445028630591376891139306370205846627093813889699170594185178241812081296510140572331372738998993116117098817936927692238682202717231675283209016857095739468507690090676681400453024293870135659990528969837132054786661560150259115734877162158755858653364070279937027014730947342216816307219127474721622123875699701715404820384545693058511056735799834754890692 -15870257059811626693754498423136372480069134596343998984549199283973854570508228359295418026089909378687774627821225399931314225867711515277913855368473873536462450935842786002269065816311054834857109074848803122494252885020527074586145467185882674518032764708782999568002770206995683800833252068328835778749976046128872525287656002968632147457840467536682726059599593635219947081138082647985895437016641903078766878782632503812736486529143041369932038649270950453231711525943737962179463585338023463992816994328519710963267459007592689204838965317062070771191372220277256094361390952025057574056586665509010902583686) -9451024345049660106196279525961090221892978991099566154106262985391297166610289955762617799605360852659627127306781672991875226991685693784543606233861730093719414744220665522901187929826313432817754814665350591234561387311906357018088223014569142052207462551662029062588606684143622569372594558764978110949194548056305716524425293541508424873532271462310390057499224301707745157544120069245779846192374954016972589725057586863944913923881252500203621341258019383900343260717822188079652149539138694763041659035550568973759555723354653011977341902065403950430751655422445621043429432520635484454470070290823852307006)
+  (num-test (- -10064759312484387184876313010284016458560725440641239737323234767636591183611201479885347260175161165340917225306019885202675573016295152797559983194160634880140345743489989007821872426587698574795394887035658449467358615185057180305109018898637903449135520486663185036663238956537895356325733583128141439025002140924158670346599492383552938312402521066705186885506193758499006001382444818328802338159713646715901977137011576113434170842422373328479181457354927400927267448788528116619711184792932525071391797130057189079431487557270366699175956757661488296856660145077706273571985222726397848614141194988258117115194 -3689074607001776735792882994440038588887963294487080609346609068733026224735369468180206799966728461935654851527895876039403151156669223687679382665269013769686991783531091821265184956524448064027733731862929686596729449196238312997460578818232100254940830907672953344544031914926653652310468671685310332327057444910423081752028857828828473637496272809899061573593874011995802487442092326045415689987885712749026491545159340468151000027397821404233369034594141219014219707193746581364791219277489927025992135462852894714639406751538919395016165215641239054420028872350709704191189169571752512626755385998505584006855) -6375684705482610449083430015843977869672762146154159127976625698903564958875832011705140460208432703405262373778124009163272421859625929109880600528891621110453353959958897186556687470063250510767661155172728762870629165988818867307648440080405803194194689578990231692119207041611241704015264911442831106697944696013735588594570634554724464674906248256806125311912319746503203513940352492283386648171827933966875485591852235645283170815024551924245812422760786181913047741594781535254919965515442598045399661667204294364792080805731447304159791542020249242436631272726996569380796053154645335987385808989752533108339)
+  (num-test (- -4621513851362114851854472268081584822344822740665629177305004335694395719163541988311496405455186973857145245414214464449674464879082042971313025249648887349614046805778335573547862191522938924075560443632614665169520240664970180760364771373836023824195690134618554368845612471858027311791638881380352344527105480173917778084361560336490212845414303819150625355111300877737042696291233444311426721588476948565949641149735838580313236869041013210454558557732497012037162735013212361842433337324577522358968152852532145622765032318936569346015498130151789662274686368870963891262060214274101000058555635785833724062234 20283847238128227963042817384468009365120280641032764409860857066215336820785816567924217697745867082423864450685360959383940995237907453126362378908108545669654749698030305432673477271848544313029448526561606175059997663752601262173667861202924953502866611309434183496911206954880840674239880495147451496219568787221129244201657487090244435562896841733049066453539864301122516559479757096183362477594406691085946787803323712522074578611082872627361465163804239673539339633332349145205596371287028267780080937728455742966681547897652607170788637996317683436193829274172400558140357237480809582038468874094877651383053) -24905361089490342814897289652549594187465103381698393587165861401909732539949358556235714103201054056281009696099575423833615460116989496097675404157757433019268796503808641006221339463371483237105008970194220840229517904417571442934032632576760977327062301444052737865756819426738867986031519376527803840746674267395047022286019047426734648408311145552199691808651165178859559255770990540494789199182883639651896428953059551102387815480123885837816023721536736685576502368345561507048029708611605790139049090580987888589446580216589176516804136126469473098468515643043364449402417451754910582097024509880711375445287)
+  (num-test (- 8229768172162771789/4094631553683915058 14916542302144281688/9648520391570031013) 18327341244785642013243791303754634353/39507136041685332578233153660317693754)
+  (num-test (- 13554976081719376860/5850035209629724601 -6813034992928443315/16012083383654426278) 256899901877002811987490932642058619395/93671251573905451634945335611797465078)
+  (num-test (- -221798849980968127/896588178875000428 -10118632981534633697/16809799818197706916) 333990778095757160537366868413422249/941966737890699707694484674257410003)
+  (num-test (- -10398409463665680242/10672871071680021919 908300169382593227/1663860017749090135) -2076589873614048366639515256135965791/1366012573135328609279238070700513005)
+  (num-test (- -2198518713248421187/494031967775171833 162489257999262168/3608560229859558061) -8013762081101965644053022173225152351/1782744111192743850497670941715295813)
+  (num-test (- 4025149216228566945/640594137312937394 5467380276809034025/15813352732084653151) 60148732603712157399679443099667862845/10129941051434949990590527231467828494)
+  (num-test (- 45649282670476595/278386580761220266717341154184065537 -8637266763647548631/320617180101036447149595031898805939080) 17040443444897688379155017841073877168061229451634462447/89255520501631886327999278515127058459530587144975987720686743155549485960)
+  (num-test (- 5648415331928005377/86815630814151297970860026950116430492 -3858618729527320883/27855468652821710859204555976171379400) 123081918822962876101148539477322308270739795776139149559/604572520679633516300271119677141637780408278090307422820905500994965166200)
+  (num-test (- 9781572955588417059/112881800445343004034168709823458687843 -5059688483724168531/4577416283528891230944530353546966748) 615921077060787960354561606126348783111829996215681822765/516706991472571912574910836774186280180852506048696459094758451180832844564)
+  (num-test (- -4967914039344839478/238170260180199675500515253723794945205 1851848905279976507/5731170327270969184071911155742503278) -469527297115675955424190428047537920421409443442551107819/1364994327983166854234805393053180119374354994464588574791772715189542881990)
+  (num-test (- -16853061581795824324/96404437352723357070647888504166371117 2887610208906060444/32980643277330946266739822018299212963) -834203249643667606680245846951263316484378801689149307960/3179480358681967952651970543397987660141008737601948320258541111852875189671)
+  (num-test (- -10766003534404571638/1736320411127247334175538439020437437 -220564366893542891/24024005562370344889629855466198025799) -11228676451427374102904112111967705085778332338188090365/1813624835433832784217556253227924899981441517333394378436857197512671181)
+  (num-test (- -4039872531792560303/2717817538621352660433068255065439787147153801016478776178010367557953211548 -17969900169229544519/10371230759745501411127733226376204123221866394120596070959771442399588297129) 6940459580028931824293913174633904994365279610168782399332846513086074139209123514834476635325/28187112855925579976299840753672542065528422968220885043792832460046226866036339425358907691441054924266606457279617295071355282523744922239122018045692)
+  (num-test (- 11905720953886477738/26349991043344773150817457299711471013733618033386232710348739943906972457535 -1868508269239354100/7915113871665192715310471309271830385175189228544536787145345883401181858893) 15941145914794937177093386304443205602552827651536706608400845076162777444155363739893353329726/23173686625047977587990304423741788120258508897732978034793987736019678129860415537604628640859289817332994555163435451240013483415438259775849311623195)
+  (num-test (- -2449440712560236858/3924161613720467738425590715321110829708355586356453490516463081317902575263 3313932993860824279/18392642760231276916239249302906853654153090246504347205856270072174622214792) -19352032211145724571420568734409847660231095572377236173431089875006133635431666731719362137971/24058567564857748536604240288023690440577404826273237225585673569644473540232022448230431237781096357243673961302816983638647478040822458289501843963432)
+  (num-test (- 2375854596996813469/17171542567603713573317138241061150416263899780234956304631913156611236192733 -1690236091628058998/115698505401619203741389026136939663329574241316722960060260525901879106902321) 303906786920788985464713527121698374469813384178920405503303785899916213843318155692692663023083/1986721810512032345893371071989737461519340072368099757524397292434629497187713075053126253107235936414498803590298681018206068059043963268488989361033293)
+  (num-test (- -9066703779833220052/53996509329904595759286231403247566365148374715934463324003880626270687736687 10104829441267883881/34350188217372122913844475743718288066233853695548819225257606841719829170673) -857068498550946301314281599902676812596945461499639532351672507051201056365247232693696093577243/1854790258563312749374056592838765632813507083399863975139987272744324437901043103651094837595789610803765303659351781344942305171362498886075754606580351)
+  (num-test (- -712905705954993103/38361275706852471555340413672243335795384295466685977818182375699688812583403 -3487523845474404757/24004509207225606167828624323100421869226668573968691661898194620137716910067) 116672912187985693533424614379662678476187446315443107971581372764612623068602629062267386180170/920843595906060126846114857872490000269306626188013726759480780006531676144330596572087176480154495471428384288229491172449159350622326294294528887818001)
+  (num-test (- -104068455909264700529593875361271227125/3443783531459345396 94266182755532992545775726171008609186/10986871169556601787) -1468019045636814162670978305715811638938423723806410280031/37836405995984502494576730289263822652)
+  (num-test (- 6250188382163250356218308848100308290/74975517450841979 10057222263694104272437942231238950849/1377150882331486572) 7853407001895533030925726629648778749078643531548391709/103252600010686800286181264132405988)
+  (num-test (- -325869560300902552275820653500571757882/6390430580148850471 94468553562411191993094256419298214695/11908765973274803007) -4484399064985071999330976874105690617426359030318059422519/76102142247451389303559481900024166297)
+  (num-test (- -93570528036598407567281714804477572547/1681213810574384291 -244906502561054838674546679498356325029/6878656438675875801) -231899320744132980638168050942881155823492361410591515708/11564492202898292712047439710761442091)
+  (num-test (- -81411835730261219386583131450337332863/716127167248934 305772198898084305417824619321954306670/5852119619187572757) -476650772889757879179369019399921041943854248979406203071/4190861845290706865359628655691038)
+  (num-test (- 8378821874364768218652992773582270365/264620166167099506 -235085292482743132422942426826553295351/5218853722286899445) 105936154887632142427944491040385766054707164161382644031/1381013939193345109641609957531174170)
+  (num-test (- -46932041053326337601984043288899377207/83004348019257810472659105973646518650 -172752976692389001100875729845538600392/64697064048458368935602368307247306331) 11302882932785858045495103305619355060523322049764297548269071809310077113283/5370137620102451116225827082734739449691101289924623877117727128768254573150)
+  (num-test (- -5215113722152182902641295804790889582/37267147737183802417372262122851319461 -174324915479281952095382231256728338942/198797486533978895289571841018885549001) 1819946959828587625889363843813156766676787993042778284071188313098762447560/2469538433480866339929667414220581052912334718874062150193407525506073469487)
+  (num-test (- -308468863588547635528373349890793262605/277175417813474671446046438490775760091 -88071245580784145343997181342216325733/109042592277517238289414020635536175644) -9225060231388102579469362745283215538990500777711808852192407359260779270917/30223926073985207174135233898799350451872811382182855106546181559011381423604)
+  (num-test (- -139281160373255540085888405052544101003/21590054032847718908692432707921390245 -175128181843395150044469443628898278945/101874815793501611839718166887463701141) -10408215647857282226079103083273257459322595128147732742048301223816698452898/2199482777568107961766315941206227462112836158088743951492692685709912769545)
+  (num-test (- -13653637423911886957204229566898836211/6724361745919744069899921221745423919 60537422461958273742622747790343370991/323722395245687564470126807800714703749) -4827063738484690108652046326448960810791170812913084889649499536314520788768/2176826490887613088066161490358401961235974091796973399049221882998503572331)
+  (num-test (- 207284509647982883454717074874778610186/315575836476247924963087075944676754095 59454580888278446469281150437143941047/3799382139920332759258392540934029749) -17974876032324524053425850245755672169670471578477359535347261991433397414151/1198993196898275844180025803639723883733761367273976879884312817813487572155)
+  (num-test (- -149255714031984711085009662216310611563/61209488724728410476016289765233999883959861482512968048939594260689484910535 -206353007879160639705730135450663155/12341134377195982958424940281067948493740598784362073339140017508008773524522) -1829354061323966095884091779117676852909282652562065419187935424186237303685407507859167669375269438805585201409961/755394525511335693198081866608161950899365908489933659716533239785460293292606918153507868614180865950008697266433342863460741791684603303270127798639270)
+  (num-test (- 286228990947356503137685907205210886138/64525193112922470913382853022276019736227442678252533126077234112153953877503 -93778927468512815169462456699065596479/70019706577332037325570327903202382111804035215024271930215402736305222068556) 26092773364888269343302672267572690894453186378630697330693315371426642609003667116358459590920104883240139740188665/4518035088612517412858008269349176355736855744033363257986123715832709510554983209440815107866748014413528943649032845277041680450752670951433682692095668)
+  (num-test (- 128067958966292694713545212085241612749/50804897676960765097908813878456128842417954009101908722816951877006748778869 -331437715897535092432788513322484606485/102911257177761006574263802557003927106564530572416215828322919550454967864323) 30018293903870953799879886574342637699455128356488843398998059810000258259055116602688738404467489640369684487419392/5228395890723542025866546462435908982096651119675992137235094920338650164475761939608730060759309002063498665792819192135030537577109853650729817121390687)
+  (num-test (- 27065789167947870065829490227927612633/10795458608984562931374526676297845621730864739104955678079256994070639461197 53314096352440087811254806167289750292/44807028208492548064750449353871285104149154384082409595945081934090139448067) 637187458285170434834128234123875152637450428605039275620795715002449318075555518355578432548587274399560043210887/483712418416385035748598509413117409273155809870339120248356475239836262578288026980177669113025449532258001487616187498682131415946755647640047843156199)
+  (num-test (- 275528434092876314751862670579225752027/23290954563951481764306221308726902093226107549717031306984541394996363441752 118398743375843543978994815511147957868/26050691402435592629863948804505350954161759382372519491414484055670238339031) 4420086456754111377514058698455330162869575963826459083894390154200727636413353382047981846196341965799691593361101/606745469813648893293125236863835131523556569847025597910312571817347251611730291043895952533706547565767925058454286630395458711598751591845070996622312)
+  (num-test (- -263828172858355421790882308711676546531/27836884730007976814146538035133148053942251062564400015534567388490010158584 31580638196736633522674344981675107601/26210154715367115936541726366619494863883445533448748701891278370021519416412) -1948520953518189888695889830515156795224640917019574042614412953331052369986548949517168001067643449389746489215939/182402263891837359872743630675214135004512597266032306942151126033873543370078488920825920736994254287019873146147276876145783659805845233146169813070152)
+  (num-test (- 43029409555492054023102681165249027816896930295612442385573977041111849786681/17478431621804970398 -63831159286570708329826084149841946467426290005331979697932225104261019322894/15909114936773208135) 1800228375210677909820927489860838061135888931548234366640994061734196466170531105718785437541747/278066377585826623354880511023167787730)
+  (num-test (- -34677827126365037739221949705076349308552841821108642369491195428278121711851/12321935233094032355 2466652720703038662112375481129216761044838204088317060529010755963314905661/458077759838279587) -46279076433142446690218423399092373290016631287423134630356063713373023144989129659854095947192/5644404488448083755690706619714037385)
+  (num-test (- 75657421640076548917316021979547903196453821552146142751737530624725671569062/5416811919979369403 -51031635143911513328361770575139950616395278082588474953679149885798666896870/16274277637120569843) 1507698654622877634185545368063085304919907004898369478770589865697455127479301592176158803465876/88154701093808389139357381843158713729)
+  (num-test (- -86696779369804422745383183615836359604633179506005810847902134850836986706763/15354752711854066426 83875579121692496325618937810567731584819474189441279434601944065565889174333/1890321146489013312) -725886765676185953186290796464189476910148783977596698524963064505627422317719186476684911836457/14512706875163632554860591439823131456)
+  (num-test (- -2824584270835350806110810310308644313069326027498380007733023821989145840779/3128200028313826545 -16485532380752962986834975164722153533427821569516340079793116204530103476885/4044901389917631001) 40144878017198534388242075435853869853984060096218401720566307902396394251666454424383286522546/12653260642466969643085415999628721545)
+  (num-test (- -71140717297594692514165816539390347954764512441693085945645019026357644035048/15130773661553937219 106518314860779634188990156539381479314908411240039365434170935270962911954978/11202282371121185733) -267626990691150539404999353980899804835901788880218020004516046839225745741587662342920970677374/18833244338916713919008552672213388503)
+  (num-test (- -31372444086039981530710911528326367048894875160807395940269724829549418985367/149682691887362386596593782520991059630 13980025800771566396092717430902170466939197897483207383178768135899198010674/143215924045734814208985239450703841431) -6585601463869631351127457963734548845246885851328680299125624347680443020577881573937479731612385878788264587830797/21436945032301618223045694723696447349670080755369221855700055538448185530530)
+  (num-test (- 60002561005149795132492915799111287923312170708430066011808292212167201814322/16346766380600148228286881361520329811 104734497917913613491539581495799848702023341599268915776996571583385896191203/61937476024742321910315674059586179787) 19844918952732846654680216616282727016967753441473733514766184661191061075852141231786969917096326062063227788681/10024529215648371311559365663430434349900555024451481776473735938354274557)
+  (num-test (- 78980655687309201443760271907411093305339297143458162112992101000746746121121/24094471248783344167514231679460830840 10562090177736342378322146805187203837437609238688017154037816697523731420573/74961473522415640988394298626742882726) 2833009175986364875175323375606672657538996734036576482627590142336455915129629838687125527863027857335645122892263/903078534276138789186206765245648729133926893901427360507431923032322034920)
+  (num-test (- 96507496069338193466683209170737942070468924698476218759487496209308948365/19252547784216386872197161331387216893 12563973560096321588715986952435909079270363887929001032891628645353358046011/79879611474172059435223762585596250921) -234179520035021783886726161079163865833895106001667476480293126893061678147610754451356994012799045797572757769658/1537886036891137155393554113191390737924110193971845147480358562685078008453)
+  (num-test (- -95307376781556674397571761484869767912211504027346871580288574968524683908606/128329921725822403056205582017133271311 36170894925879686192917617159219095595164782822289198001474013555499918728596/240886887357120796976726436320063138705) -27600105449672599524131749634403660999916186956076872373762346977331203119722064380924286397976905109959929163304586/30912995399316310109755266138690547023211992922143297688759057498082990192255)
+  (num-test (- -22104893896795356297688360407985617971036912713007110938688208155601366216839/5790727918973991999188987227357894380 -2339372311396919406471876113751500811577555408710269902369834593304924842262/12937689744925498650506694361349920911) -90813196841584888136609582546105640167792279132393576014002859436259486025871518847027719826829986116492656710923/24972880404321196721702428178050372850585634300866259560981343234830460060)
+  (num-test (- -3426218098660813853559652497557253942819662042768623922183022792185928242671/2077407536662385613357832628600529321326686191757127715026249042748302985178 102639297566540827510784861997871251414598617775200449087621943894148321803293/83089038429507982364103335021257902316010144851865721965726693103637274338545) -497904817589969304680335736144278473886197067420059149312627956679073246109792679236301202959163792633927112737045328517845259242265445360227131779644849/172609794647490471018785535271654901168315737813115654161745630290269473799997219289162551586864155467201760250711449118429648095083028041134558889086010)
+  (num-test (- 1543899448831604569141696144740105016328586790221799945430718394112623114412/1094690716976737526626281319975432667416762320123576900412499904933271786567 -101835025746074730017715423582062511397387458863000475669454309217160145993/55116548932808468782187525862059393507883043749327746382569396580129398962) 196572266866178229534134252625134989714563665559807019513454337864363053729628560611312158082929567528955985669620113192156991984486011150099776316375/60335574468539540262844259780498204139853746803235564167348945699931512713417761400790104247218084745081610815218855896912895393599203789305655343454)
+  (num-test (- -37581128364300495505521143552535972339959603365602244668159915869829949338997/42947503543372015019662104425995959382231280059683481488692141811517675950053 -64888994735350842409379226446854438865448614840503930577860382883594178287934/83188698741706753136718468601650233481619465918167616089202536622553688681087) -339504834548876267781536981106771553482515399809961247195394672491113984585270709765073243997043174508213253440272888923497173265137136111635177948889237/3572746933977957867604303713153220827104741303667912510494658617478381525690274918494624922428110123336345510454960178899375325287131764283538305257747611)
+  (num-test (- -16230533405187239318665866908175768720879595131719076634847964191318368133798/22572606803697929681675696479626869642065470042484269772607381297011844085929 -3238806615045730440879378702226410558103197865253164974472379309242480970831/7167633180423354812410246140643720752789573307606828791458541239290047771821) -43226201536346598702395278529841763047400215735214225929426206339139243925579733185594282160061132691154727543083543034702325848468839969037250195569159/161792165494835249202675342837643048016103040739685489755239980324180308179745586573032524649518850731442178659412287492012066453331740508600962908806709)
+  (num-test (- -58154703770626762920775801228739843350302933064569814497417973139312614069763/25655935043535628671780902110427599603857741303802203417196105196580175051005 2291927744682353823611191393035210406213286149316388597509251757479544491322/2075117977066796442381930295725401140983312287419314083032058820231519915051) -2848879691864593463404526996418656511058536739346277043463623510210968076493148319480555434626780964688210750895957968447300033820091387019574369485421/845064952814266442598400897276554701819815257830830535600041451476645443978805142044657833921127247033533628716506571358424324423237490438402971304385)
+  (num-test (- 16233726784138742204308718138203086218138595789383817317246449554340898453104/16370584482945481446847872945862788646563748664837147378940234530469832625057 14431071141710676049963542765626402177344958369162454874051268130438178883381/21166786163219212747261378458659387864767326410261049063051557406799162784072) 107370754167217929909136144689909613387440429633745577224054233373886366171618903318258855919060113440621302505589923655976636732694637334616990468681771/346512661117421566971293748815177161526095870176610277140325665174756629068111228154091043637596506814557119477231243643171068111260010676990408227692104)
+
+  (num-test (- 3872339191937382556.0 13437882608410293981.0) -9565543416472911425.0)
+  (num-test (- 12702320881720530101.0 13823645380834800545.0) -1121324499114270444.0)
+  (num-test (- 10222969257152373972.0 -3454292165863475982.0) 13677261423015849954.0)
+  (num-test (- 591233951053628288.0 -17639978232337836611.0) 18231212183391464899.0)
+  (num-test (- -7878405903223218778.0 9050739027069287469.0) -16929144930292506247.0)
+  (num-test (- 11347120771894057376.0 8443917396834074370.0) 2903203375059983006.0)
+  (num-test (- 7831959259127703467.0 -257470007821066702597399141202130667973.0) 257470007821066702605231100461258371440.0)
+  (num-test (- 1092406341647857980.0 -325710450166845666190895573961860069495.0) 325710450166845666191987980303507927475.0)
+  (num-test (- -4220606126689357919.0 73461013742902296577411907972196819778.0) -73461013742902296581632514098886177697.0)
+  (num-test (- -5112059189225304080.0 334306213789148650102245018234146620793.0) -334306213789148650107357077423371924873.0)
+  (num-test (- 3093346224554776175.0 -204967241927023874963787190016588249299.0) 204967241927023874966880536241143025474.0)
+  (num-test (- -5735747638156472357.0 -3881750746805128137401544408305666047.0) 3881750746805128131665796770149193690.0)
+  (num-test (- 17639095392510638323.0 13312205908441007415860933757605397223142073616822325142416364932887680287063250296996056787873086490231950036662943632990219865746131453861285495087665017.0) -13312205908441007415860933757605397223142073616822325142416364932887680287063250296996056787873086490231950036662943632990219865746131436222190102577026694.0)
+  (num-test (- 16304056910692545233.0 1463591032326743052350022746892396184459320617971409440301562638996633667625451301419074212369365394140737678584830314878769698416417465834928609990708982.0) -1463591032326743052350022746892396184459320617971409440301562638996633667625451301419074212369365394140737678584830314878769698416417449530871699298163749.0)
+  (num-test (- -10347586523508777315.0 12614325304787850623826535169596975975360455924114817820074336137897280818245940873677389644701038550150832199897314137414727161192173691528917744363375331.0) -12614325304787850623826535169596975975360455924114817820074336137897280818245940873677389644701038550150832199897314137414727161192173701876504267872152646.0)
+  (num-test (- 16875252323587344863.0 -10230183557696638447600885112945653217398839137450096120772416948425622105048400944465287395231588821521217980407867153259741079758527788318592431794213674.0) 10230183557696638447600885112945653217398839137450096120772416948425622105048400944465287395231588821521217980407867153259741079758527805193844755381558537.0)
+  (num-test (- 8574302739232756920.0 2945205250727759066959418729185252318153395797902208079569164623770839848878181416073351760975066439564334127158302281471631001294503759011790017443478716.0) -2945205250727759066959418729185252318153395797902208079569164623770839848878181416073351760975066439564334127158302281471631001294503750437487278210721796.0)
+  (num-test (- -17657597319577965851.0 -470389901349206124503884936612357721199915776516939967013182926735009022045917047211666512521578494339222795740836335004070464944715357800461845632614015.0) 470389901349206124503884936612357721199915776516939967013182926735009022045917047211666512521578494339222795740836335004070464944715340142864526054648164.0)
+  (num-test (- 11472336850218354926.0 16764018932433717867649699977474298016589762238077229911249331402108995850754999065988360217500238643747316139204767820295123085026049273617874157749889925712672510963712964034497935503076689670786498045302562704435768723916334451317158760704743066709581593570757498670622547878516907127632802801541072452593999435195637193819500375063696114131057474475407791672955417184592088612921927282233762919112197264895445408873539746256555444555901857369535350160665235184955438709679669964546134487688796078142789125799020704969226557493354453298489954288702387159956161243151013189140749021799388406290339231792790773612376.0) -16764018932433717867649699977474298016589762238077229911249331402108995850754999065988360217500238643747316139204767820295123085026049273617874157749889925712672510963712964034497935503076689670786498045302562704435768723916334451317158760704743066709581593570757498670622547878516907127632802801541072452593999435195637193819500375063696114131057474475407791672955417184592088612921927282233762919112197264895445408873539746256555444555901857369535350160665235184955438709679669964546134487688796078142789125799020704969226557493354453298489954288702387159956161243151013189140749021799388406290327759455940555257450.0)
+  (num-test (- 12682607562584942903.0 32133619583510009354538204193505267426986629771080807813988708187761849276650847958886764459302043799013813125903744946349479743277662066609741649009023451783267511140245797235200413941774959851628239089013586399425314412329003636059313583335807925401822165199322334470452126484173417518861322963430951772895619791799137157183662289329901964728384697377777905235894234370773419160283767144177627084271804319157013765325677633945370597318765372346484383325176768117059688792498687750479618961541872574768601477738410497806623403054372221338126223825515939164627992974469102910882915893925327931884157735553718792115929.0) -32133619583510009354538204193505267426986629771080807813988708187761849276650847958886764459302043799013813125903744946349479743277662066609741649009023451783267511140245797235200413941774959851628239089013586399425314412329003636059313583335807925401822165199322334470452126484173417518861322963430951772895619791799137157183662289329901964728384697377777905235894234370773419160283767144177627084271804319157013765325677633945370597318765372346484383325176768117059688792498687750479618961541872574768601477738410497806623403054372221338126223825515939164627992974469102910882915893925327931884145052946156207173026.0)
+  (num-test (- 14621880654476679971.0 -10075923784619510279100488003620810539888599376089081798647754628017452762406215094511315867213396543200861274584884759429891242650999761503100661310915213260386281412125687376866399124849043409890009033179987278297335571911640353059036551139958369871790768643514550179661619387008678118363266091945225880595898524898713646458647465935791224159084684209727153050053537752111696883536364966526666445737103854446009305531519860527938394412863332757413309423156200192973778629503534709731073637828912608835085933003410694216843775182940057891552358942312728978810053715387504707194992816961400377579655168106377696154728.0) 10075923784619510279100488003620810539888599376089081798647754628017452762406215094511315867213396543200861274584884759429891242650999761503100661310915213260386281412125687376866399124849043409890009033179987278297335571911640353059036551139958369871790768643514550179661619387008678118363266091945225880595898524898713646458647465935791224159084684209727153050053537752111696883536364966526666445737103854446009305531519860527938394412863332757413309423156200192973778629503534709731073637828912608835085933003410694216843775182940057891552358942312728978810053715387504707194992816961400377579669789987032172834699.0)
+  (num-test (- -3220156644655019630.0 -8347829670073174550775641165362740628312221836466572623516708794243074870361401136762432100726575330214254748615114820602945887237367461962207075265579588481261313345359877816874924645801358760718027997416917747796144940020489321523749233377708490614979453376328244189926517907474704635785063100359787580409065317918203485474119227673185211436285930586838616288721370975925191964611302275354365110550116042403226844820172448647475637867255305805337047967053177320593337377763657329816935516961201488840745892529800883680912275812320160312651894919502389242002380151562481051684439333368396132543667539444686619670713.0) 8347829670073174550775641165362740628312221836466572623516708794243074870361401136762432100726575330214254748615114820602945887237367461962207075265579588481261313345359877816874924645801358760718027997416917747796144940020489321523749233377708490614979453376328244189926517907474704635785063100359787580409065317918203485474119227673185211436285930586838616288721370975925191964611302275354365110550116042403226844820172448647475637867255305805337047967053177320593337377763657329816935516961201488840745892529800883680912275812320160312651894919502389242002380151562481051684439333368396132543664319288041964651083.0)
+  (num-test (- 11628988978410243120.0 21091260149209133824278525560739673446778991946138130571540201996950100883736332286627324787663044982195445635023357027423513202277912840570399895946346028843517588470258087913846945044832851780108963206182331994065720076983528527849542421619745503796476103034657238118665288185878258232226731582201217795631247916614224227701409259346052937919425072595891571572960468193421257458185693656090215937518204243652916583730260295885562094977775951577484951577581277292356830523013216949489797535362720471761788697932265967910160407593278848113303674799017334692501935041730808945554336564957621028111014116286675587727714.0) -21091260149209133824278525560739673446778991946138130571540201996950100883736332286627324787663044982195445635023357027423513202277912840570399895946346028843517588470258087913846945044832851780108963206182331994065720076983528527849542421619745503796476103034657238118665288185878258232226731582201217795631247916614224227701409259346052937919425072595891571572960468193421257458185693656090215937518204243652916583730260295885562094977775951577484951577581277292356830523013216949489797535362720471761788697932265967910160407593278848113303674799017334692501935041730808945554336564957621028111002487297697177484594.0)
+  (num-test (- -15960716439913426281.0 18799211173341989380260980155501104944815245973352765317821146163884181375747259542484535639646490774929026134833947975785613727050541297797675705933339289016115326958150660323801621778641184271728990164666383865587422591755046779736996211052149338115836473967202556153668963815595875844414662034458693455631979862997316049580586739835122770408911308146605671192538040301857163633538268589024651373766021087864982140201615461513687698136663128896835597598904095187715456109340116329587986878167776146023396961265667934659006280575496363066974484893764810659481361856335795455814679851690737943592227795474197104696127.0) -18799211173341989380260980155501104944815245973352765317821146163884181375747259542484535639646490774929026134833947975785613727050541297797675705933339289016115326958150660323801621778641184271728990164666383865587422591755046779736996211052149338115836473967202556153668963815595875844414662034458693455631979862997316049580586739835122770408911308146605671192538040301857163633538268589024651373766021087864982140201615461513687698136663128896835597598904095187715456109340116329587986878167776146023396961265667934659006280575496363066974484893764810659481361856335795455814679851690737943592243756190637018122408.0)
+  (num-test (- -181065640455671431985325539445069267017.0 14120143334024043377.0) -181065640455671431999445682779093310394.0)
+  (num-test (- -91295299684959299024846233061686623774.0 6891102275697080803.0) -91295299684959299031737335337383704577.0)
+  (num-test (- -252582289949155881579950873916766853744.0 883304029266526072.0) -252582289949155881580834177946033379816.0)
+  (num-test (- -10104159950635417603045689770006558103.0 17251490913777465304.0) -10104159950635417620297180683784023407.0)
+  (num-test (- 288463495341489091297108607960869684860.0 -16376960611483226267.0) 288463495341489091313485568572352911127.0)
+  (num-test (- 204661965092367792468062569536290631004.0 7774991291341524479.0) 204661965092367792460287578244949106525.0)
+  (num-test (- 174559967167400201536723778015754014369.0 168183438971818617783400303174116396891.0) 6376528195581583753323474841637617478.0)
+  (num-test (- -253300708624436983509156598368557395374.0 -77166863757693227553099778725240875400.0) -176133844866743755956056819643316519974.0)
+  (num-test (- -38587765028356074196061530813295290944.0 5999161273284748726648331130480323187.0) -44586926301640822922709861943775614131.0)
+  (num-test (- -236400856885875891058508662756360145662.0 222191413471626205952456600591947275777.0) -458592270357502097010965263348307421439.0)
+  (num-test (- 212937903940173587742882129816769611096.0 336470165768472077447806282475185249734.0) -123532261828298489704924152658415638638.0)
+  (num-test (- -264812595676159375893264580577855253845.0 -247068943830535581577267897204259299723.0) -17743651845623794315996683373595954122.0)
+  (num-test (- -1725732715479127274526681751197327660.0 -2279805492899538651574406423954277869507456204136276822451602661149698386520868702017367409743272511010382761246500508887739763323997191435566266331339917.0) 2279805492899538651574406423954277869507456204136276822451602661149698386520868702017367409743272511010382761246500507162007047844869916908884515134012257.0)
+  (num-test (- -220007189346579184019349894240059989979.0 9116030813176547770422918633286023943039811682891023288884273747820892639481842291616424036020927750322528731882517057595815179415042385175627374957565803.0) -9116030813176547770422918633286023943039811682891023288884273747820892639481842291616424036020927750322528731882517277603004525994226404525521615017555782.0)
+  (num-test (- 139683266109784685815165642637380856544.0 5782493350903499652295971390391981928106911831248674750993968151944332845911526084530951283012280786005612601970108688202931002414214353708335212597807345.0) -5782493350903499652295971390391981928106911831248674750993968151944332845911526084530951283012280786005612601970108548519664892629528538542692575216950801.0)
+  (num-test (- 239160165978290709841254489756277328273.0 5152132850125501873897264811465207492706871561577273155117982457627773151595716641409297120994045059130053034927464958986304380141364542178714472948085275.0) -5152132850125501873897264811465207492706871561577273155117982457627773151595716641409297120994045059130053034927464719826138401850654700924224716670757002.0)
+  (num-test (- 315772704643232632782106484978382006176.0 -3689252327480456512393153800679864208480329729627292260734151097785848947569336194072922395859496552999163037466184616218582046814434719444842678248982224.0) 3689252327480456512393153800679864208480329729627292260734151097785848947569336194072922395859496552999163037466184931991286690047067501551327656630988400.0)
+  (num-test (- 82735713197488344149642668226610301853.0 -12473025194535761005577066561696471986140205263843017221991729197337093872383371857001077050460827652296473928714097816492579684543651922277865558518876774.0) 12473025194535761005577066561696471986140205263843017221991729197337093872383371857001077050460827652296473928714097899228292882031996071920533785129178627.0)
+  (num-test (- 63472235942371758467270296983419551089.0 -7866520408163137968600317959735552406794938230345293650627055135268307695389903092041438746530663083967329111232451176014649873249349534808700483360707382397988918594143264031213181385790969271527978925616276399184489007642142996251807222768397530946779296600805549276528669432847672215219943599871223372831999133812100481632278022608906065923652981249057846548868473376683960144009223047416366697876553049362242497225174860431577034875737250719899362881567590934060155436179316063810148362442197071642183371654740845983314705249832168923202400873364289483910868432511677656218937984504828452980698439495961392749596.0) 7866520408163137968600317959735552406794938230345293650627055135268307695389903092041438746530663083967329111232451176014649873249349534808700483360707382397988918594143264031213181385790969271527978925616276399184489007642142996251807222768397530946779296600805549276528669432847672215219943599871223372831999133812100481632278022608906065923652981249057846548868473376683960144009223047416366697876553049362242497225174860431577034875737250719899362881567590934060155436179316063810148362442197071642183371654740845983314705249832168923202400873364289483910868432511677656219001456740770824739165709792944812300685.0)
+  (num-test (- -284018520801241078671538235859630240269.0 -5529748211779294240854894683633173443789067073881249229985499707296461959655918837051490512357840133495603640185675483847478587849599477020706893805485599954539589062532211767295361120129440287144117406526027552427750375526095104163474774446716012360038076376952619723549765229763943818011605991300849052030142173100367582906381575666628005795818339029350398340616624791399526643991489247585213423174803853961438830286737553181353007081438503238779644371968004083452645077716952159339978836669723137339898471600546912430030276920763475622536295311290657163861398519747560279682401429552174530714298081464588450842581.0) 5529748211779294240854894683633173443789067073881249229985499707296461959655918837051490512357840133495603640185675483847478587849599477020706893805485599954539589062532211767295361120129440287144117406526027552427750375526095104163474774446716012360038076376952619723549765229763943818011605991300849052030142173100367582906381575666628005795818339029350398340616624791399526643991489247585213423174803853961438830286737553181353007081438503238779644371968004083452645077716952159339978836669723137339898471600546912430030276920763475622536295311290657163861398519747560279682117411031373289635626543228728820602312.0)
+  (num-test (- -171812101820192353275910956459431262142.0 11401673303315394031728944442295528921842441448377692701102691446500671963119794838260543877466107345474902885032629120622020177051592733148817057943390167845763358795044702079370835841331467130719834250134674578757640577473495192331790176510774020541399177011446664359866582351045889299070080989390219063301859447807907203943168891690028442190793548699886572720360741686677780644932612683647303776634496172481504075784427704287335805355801794320914944330891519283383694196486986108936857630373759865062862204149003789919218681050221366182434949855054760827976853645027544605870235074909890698574792562001595287630131.0) -11401673303315394031728944442295528921842441448377692701102691446500671963119794838260543877466107345474902885032629120622020177051592733148817057943390167845763358795044702079370835841331467130719834250134674578757640577473495192331790176510774020541399177011446664359866582351045889299070080989390219063301859447807907203943168891690028442190793548699886572720360741686677780644932612683647303776634496172481504075784427704287335805355801794320914944330891519283383694196486986108936857630373759865062862204149003789919218681050221366182434949855054760827976853645027544605870406887011710890928068472958054718892273.0)
+  (num-test (- -243638660221338112796448050030955119997.0 -32214383478080953899491069562585164652288236626686985994647827422262342469970423345510055643470262764747630363450204055220886177681745412924556264758690138113272748656941509018308925555317383307928766093730384151056027828368474245304944063213926492719166086055718735381341569379006804236876950175122702350552198046290567043195716369691666842524594399597143281611765509174168738392889075290806378316647736667077047013214732267367344808724905727602402784621437141760604478301412768904784950365257469208085143467704875589485635570084387755189599791857576855454112556762755762408826226326879491415484319411662301650468948.0) 32214383478080953899491069562585164652288236626686985994647827422262342469970423345510055643470262764747630363450204055220886177681745412924556264758690138113272748656941509018308925555317383307928766093730384151056027828368474245304944063213926492719166086055718735381341569379006804236876950175122702350552198046290567043195716369691666842524594399597143281611765509174168738392889075290806378316647736667077047013214732267367344808724905727602402784621437141760604478301412768904784950365257469208085143467704875589485635570084387755189599791857576855454112556762755762408825982688219270077371522963612270695348951.0)
+  (num-test (- -126332081511349770866908261827634312283.0 31497387372874133218238910173378055967910722258532087598053588964599898753455370244114881403020152175272452951858324158004662566613339529101292284073176382818309096142522412043073218657587031893636358434796164444941535757484360125937835242214199979245499374972029624710574236962978707708765065292759037309958875006017588240959790355958632745299212449602934380927677385974488564420550408281673927387615657765312151272852486266800510090872812376232597458154951925709496664568906509814364388823105469855516803225244972466742963619633076158367569109107733990828830121948130235858799809203410103682003414364238243553515261.0) -31497387372874133218238910173378055967910722258532087598053588964599898753455370244114881403020152175272452951858324158004662566613339529101292284073176382818309096142522412043073218657587031893636358434796164444941535757484360125937835242214199979245499374972029624710574236962978707708765065292759037309958875006017588240959790355958632745299212449602934380927677385974488564420550408281673927387615657765312151272852486266800510090872812376232597458154951925709496664568906509814364388823105469855516803225244972466742963619633076158367569109107733990828830121948130235858799935535491615031774281272500071187827544.0)
+  (num-test (- 219979452670016849533060110266815720199.0 3900115048441644499033281842448985956665866771934663536385503692700586024397767816761943054115584011069129310718114010862034970648115172218305599786238607524420973404711138276011261135403209178420948996472570042497859127324157786975578751148348046315727383390370594954695454631662061021971027739429505825056455676233533511412589936865597034183410893428831818716136282201523804692574965779771140320669492229416601369453681528301333865290947482219850340728455965391492610516639151652595539203632139883064874286555941718154489936421274731413286355640404192677546692090304496817063325766995908926108582896362623757323811.0) -3900115048441644499033281842448985956665866771934663536385503692700586024397767816761943054115584011069129310718114010862034970648115172218305599786238607524420973404711138276011261135403209178420948996472570042497859127324157786975578751148348046315727383390370594954695454631662061021971027739429505825056455676233533511412589936865597034183410893428831818716136282201523804692574965779771140320669492229416601369453681528301333865290947482219850340728455965391492610516639151652595539203632139883064874286555941718154489936421274731413286355640404192677546692090304496817063105787543238909259049836252356941603612.0)
+  (num-test (- 585873325961105129055557280004608765382109855007674169500308242261038324959928764512890600512016613154122762798104714052579267789493643522748210870974797.0 -1855792162818946202.0) 585873325961105129055557280004608765382109855007674169500308242261038324959928764512890600512016613154122762798104714052579267789493645378540373689920999.0)
+  (num-test (- -3026050092505200332789765255096964033685859497096213532090644235603419347590512426830117415222669642053441336442247132403948783838396746566100575461602162.0 18009081534399282710.0) -3026050092505200332789765255096964033685859497096213532090644235603419347590512426830117415222669642053441336442247132403948783838396764575182109860884872.0)
+  (num-test (- -11124638695599888462310706699308855434715251048597328942409434888923094027849143412724699165971400546471660924330688750607774759764580214088920441698992069.0 -4827559068742614723.0) -11124638695599888462310706699308855434715251048597328942409434888923094027849143412724699165971400546471660924330688750607774759764580209261361372956377346.0)
+  (num-test (- 4950293428090696283711882613183655723616682297360442241017758383241177602498881186549809051670562038601658285833496694108818253845693871318067007752043113.0 17597810481352184048.0) 4950293428090696283711882613183655723616682297360442241017758383241177602498881186549809051670562038601658285833496694108818253845693853720256526399859065.0)
+  (num-test (- -5733769947958740467479139247420201065087494801172241127791526686385518674532830661413722661802560247463032020003355494614502034002778775472609306735864748.0 -3892174127829225880.0) -5733769947958740467479139247420201065087494801172241127791526686385518674532830661413722661802560247463032020003355494614502034002778771580435178906638868.0)
+  (num-test (- 8320894458193427045187598554188178307429755504967209344418448624882517461814957461249858674758807195827056824653471934409067429988676743031117653237018365.0 -12861394200627120797.0) 8320894458193427045187598554188178307429755504967209344418448624882517461814957461249858674758807195827056824653471934409067429988676755892511853864139162.0)
+  (num-test (- 13033402737450594044106258936169013897237368708138118260402180886096095497725071502601849887805439844083105685971731015312020770945603825344926844435936044.0 236396022362585261770052671762207864597.0) 13033402737450594044106258936169013897237368708138118260402180886096095497725071502601849887805439844083105685971730778915998408360342055292255082228071447.0)
+  (num-test (- 12170667278114656173974716189098171384426379753661081475485441559687661443127166543908925678856145097632475832903680828294561265828775791256812588754280222.0 -276673555533799047589626400978981416789.0) 12170667278114656173974716189098171384426379753661081475485441559687661443127166543908925678856145097632475832903681104968116799627823380883213567735697011.0)
+  (num-test (- -12755594876262399860618168642932232021734362385933348033134635580177924615701078617214764415318471507488803810365565826229169313660087149542130819663319659.0 -157671440495648010763311068579191828684.0) -12755594876262399860618168642932232021734362385933348033134635580177924615701078617214764415318471507488803810365565668557728818012076386231062240471490975.0)
+  (num-test (- 8664063140780163008577373335591938905735059211566906376953760862047748343846207426667781783874718320339071949903053785280430612875488847226724390758938740.0 54361107931665215623681874454167019934.0) 8664063140780163008577373335591938905735059211566906376953760862047748343846207426667781783874718320339071949903053730919322681210273223544849936591918806.0)
+  (num-test (- 3699576825118349347309026261327541749454660339251578894574483235547605815416603169143590292164644149607672871236942391817131531474661895913650810587431606.0 -50508350367572393968128467319633674717.0) 3699576825118349347309026261327541749454660339251578894574483235547605815416603169143590292164644149607672871236942442325481899047055864042118130221106323.0)
+  (num-test (- 5626548453644136572409808769267055618695663227750732922630041368983808478347120771651822300668480671524976882745306794511840379704578900504784165956486985.0 170502882789371639987361620116696459267.0) 5626548453644136572409808769267055618695663227750732922630041368983808478347120771651822300668480671524976882745306624008957590332938913143164049260027718.0)
+  (num-test (- -10859007735074693411217019392659638207496329895257318665547454149984863458541990037760564769787816800806064437172810158051442267508476778676439633382657890.0 -7558060977666720080449823996328496253877735754811271086853901493753796001778345391546991917892931500169890406340928835457635973812901681485438886367096185.0) -3300946757407973330767195396331141953618594140446047578693552656231067456763644646213572851894885300636174030831881322593806293695575097191000747015561705.0)
+  (num-test (- 9842028993407961669727766131360795288615020071102475108883839785397865740828387076847892646234215787999498419839351470775471313077046438080666908734795616.0 8259939762466350877481193620364896193464602165170783019804380181692322874550956777598992104871440502758410340359413403619753571535498118388286469082729503.0) 1582089230941610792246572510995899095150417905931692089079459603705542866277430299248900541362775285241088079479938067155717741541548319692380439652066113.0)
+  (num-test (- 3122315115429970622394662815735050825423438028108957393747131991771456957037829402044934484343765915727397519247940959221091465331254497476137639859816450.0 10737995515603450913722681305571315249864367824351372254572936648132763616823019940208526402092654554035074813865303483747097673960803093638463005072804384.0) -7615680400173480291328018489836264424440929796242414860825804656361306659785190538163591917748888638307677294617362524526006208629548596162325365212987934.0)
+  (num-test (- 11618335890332522671268040181306950825004789685088262996478365976802329054158653675768163009290064139158450983598701977173152384425333441365287895694522192.0 -13130287008197231017935223399369698658354829835061356451363818961959486828237111511740029441613108087354987794332115218978284937263725126538295501305403242.0) 24748622898529753689203263580676649483359619520149619447842184938761815882395765187508192450903172226513438777930817196151437321689058567903583396999925434.0)
+  (num-test (- -4829477140897377009195646150061276059814366801005389903693533021027427566117360765323647260121062827801190746646296803957067548167571028717513392985791293.0 10716557117391614298810040587314742187092120526669273567183969821384063434473189717686678450880765426943205955814024872764413373364846268902370055526485180.0) -15546034258288991308005686737376018246906487327674663470877502842411491000590550483010325711001828254744396702460321676721480921532417297619883448512276473.0)
+  (num-test (- 1560421244904974852620371975782132605421448226892487453928759432083522187778803424020804578027100625536441377609275030418285893555753560195716001014786650.0 -11797558308994912054526619290334311429749533070145154703018977152548370444659962978040151671210413666186432921816690953994784423526183449271023503069393845.0) 13357979553899886907146991266116444035170981297037642156947736584631892632438766402060956249237514291722874299425965984413070317081937009466739504084180495.0)
+  (num-test (- -7701347923966912534344428538744620884561375267012102797292378941649984539207353887059064943586048644516121387166836442084007442716291792933061162738380376.0 5290969389374230541016502448421359606252744677802288901830045825873182202718418905866055323957065013553046698199939002159982374580735362593037515863844280108947533575824820196689891621498006303535207762625068798755031433921940066544809959896067184147997503827988613858484669349726945188167613248195147619673963531690938913245110754715059472477991342216448470339490385593605806518967792963339193162830698488489270925945408227996742278697477358272529028932771642478870844024835907350391770605391526921411004262446196112836319091260967898895009427182171643279100998182191816962677328417390867021108292139204864164048286.0) -5290969389374230541016502448421359606252744677802288901830045825873182202718418905866055323957065013553046698199939002159982374580735362593037515863844280108947533575824820196689891621498006303535207762625068798755031433921940066544809959896067184147997503827988613858484669349726945188167613248195147619673963531690938913245110754715059472477991342216448470339490385593605806518967792963339193162830698488489270925945408227996742278697477358272529028932771642486572191948802819884736199144136147805972379529458298910128698032910952438102363314241236586865149642698313204129513770501398309737400085072266026902428662.0)
+  (num-test (- 9733743430220591762422540139212426729307515492818443460852332805653889275463385649305231919846970974905736816260992940027028218064265519723018527155353151.0 -29407855293830047984154639411082591337348779678279017647951764366455421210163494489475996514661359700145916243499452007595041420522019751347743105082745321262372977262641488359297167392118038994384136863563032667040671405618315550876997904307423736276844997706938133936081058323434935833614475654922773162140266784233792639117145232791514703532554345086520312281500696798706889025860427142771458666376271994240028586899592254884476941388776984078337603148583453255593120138178690189726206775893096279000909079330468718593887702543025737308336025198677457129910473491269839827087491228569718246503140134413881896746751.0) 29407855293830047984154639411082591337348779678279017647951764366455421210163494489475996514661359700145916243499452007595041420522019751347743105082745321262372977262641488359297167392118038994384136863563032667040671405618315550876997904307423736276844997706938133936081058323434935833614475654922773162140266784233792639117145232791514703532554345086520312281500696798706889025860427142771458666376271994240028586899592254884476941388776984078337603148583453265326863568399281952148746915105523008308424572148912179446220508196915012771721674503909376976881448397006656088080431255597936310768659857432409052099902.0)
+  (num-test (- -276731217243271862683214238489380950428392903790808046630969592255272629537001990355375434170910931115552132394269672247616298060929507021008951190291387.0 100289083769237476480554074865040988004216167545459907207847010762380733541100608695693297149249375537088329431700364201275915507683345148401600569951338052791424407090330310974243070931256108167365334162914085216447196038922091547331474328250886730614683299908003398886233860613008266913065047699535081030427106800418656336608005860846045905149012346378286475449307630537665901621055008855374148058291266835796203075976592585729940879567246284967856356337849150102261744547461816282538319258966892339056695718919291240188920586288417893106046698069355647145603908383687239983874164793005765733782432717429040621674.0) -100289083769237476480554074865040988004216167545459907207847010762380733541100608695693297149249375537088329431700364201275915507683345148401600569951338052791424407090330310974243070931256108167365334162914085216447196038922091547331474328250886730614683299908003398886233860613008266913065047699535081030427106800418656336608005860846045905149012346378286475449307630537665901621055008855374148058291266835796203075976592585729940879567246284967856356337849150378992961790733678965752557748347842767449599509727337871158512841561047430108037053444789818056535023935819634253546412409303826663289453726380230913061.0)
+  (num-test (- 8505070389896098095621766692413480203366379968950158493268895987250690600795955783113900096527432416791184386061684833478921638080978014176210898461637606.0 -16410711613672171332126342754193842244915477287016327757357714698751777287458963458682349581881560880814595167244857846847668988374679430572782121021084683986742283012573569894084166107235597351093334125816075658348307113218478800035703971671113417712009419861470917307849916674203301497919242668373376352901312309673053175315189945730756118172940886476343290174961420986113367531057713782438374928471960914578818951372282574754612716278516397754222547513576728677459134022062202283647690649100602260948409511070624300011106517649666031530376191755817891213910847547809248990517666613043010292627100428536737652546738.0) 16410711613672171332126342754193842244915477287016327757357714698751777287458963458682349581881560880814595167244857846847668988374679430572782121021084683986742283012573569894084166107235597351093334125816075658348307113218478800035703971671113417712009419861470917307849916674203301497919242668373376352901312309673053175315189945730756118172940886476343290174961420986113367531057713782438374928471960914578818951372282574754612716278516397754222547513576728685964204411958300379269457341514082464314789480020782793280002504900356632326331974869717987741343264338993635052202500091964648373605114604747636114184344.0)
+  (num-test (- -12618010259109779267590315037969998053964054382853891516547435925972388025118492931596200697357628900783311183940584302426381939302632641549019984810957030.0 -30500906828861638007306362171210132987300359439962044769219457463653547834815716264412200930088623097530758080891972640000479943534665059199377729854850415258341537838023739964147532129877743393965857370995558748807382396090020006195649251292012405690725917389684473999400905751109361754679152179983739269026226054012963756892488872262522587481931950410504651253101938824790285623805566521723062029033001745636445860437154344665483641408727637784045030118212476306906983993748299291616038887011943864441807818857508443930272872365334665976442185494702520760793786640113779099219233665607521784524244604432396247693263.0) 30500906828861638007306362171210132987300359439962044769219457463653547834815716264412200930088623097530758080891972640000479943534665059199377729854850415258341537838023739964147532129877743393965857370995558748807382396090020006195649251292012405690725917389684473999400905751109361754679152179983739269026226054012963756892488872262522587481931950410504651253101938824790285623805566521723062029033001745636445860437154344665483641408727637784045030118212476294288973734638520024025723849041945810477753436003616927382836946392946640857949253898501823403164885856802595158634931239225582481891603055412411436736233.0)
+  (num-test (- 793528769616879938852241178439496352527042950647521648629732169156958768358523029837406526207126598190786120139491813624819360632811627576064199559812277.0 -7357484069649002655190557040768215614708659708788999334802985986235721030962928900092675952032143512196279092521450986819067071570862007086586132687661085824939677603953832219860573980632016025218580608321648907608385784471745482257672314890331358256478273312255285010343369949412955387472116587504557483184506548209831317705115523967163525846685455369176657510129844566195941925821733027993620517287411895496215426174909366458092382652675628195464969405904518323018004882611048769247228828875493680284766874334247375868318795940759082324831733175858991629741478124633015067484305547002438816473086042218906532116413.0) 7357484069649002655190557040768215614708659708788999334802985986235721030962928900092675952032143512196279092521450986819067071570862007086586132687661085824939677603953832219860573980632016025218580608321648907608385784471745482257672314890331358256478273312255285010343369949412955387472116587504557483184506548209831317705115523967163525846685455369176657510129844566195941925821733027993620517287411895496215426174909366458092382652675628195464969405904518323811533652227928708099470007314990032811809824981769024498050965097717850683354763013265517836868076315419135206976119171821799449284713618283106091928690.0)
+  (num-test (- 30958566711373255787092081401292877738974978442987704470984765018293851031728996862405055424093249924047528792113585028592262445810946419909807061004531455817427671594281537965628880611732831524185850161910304038646992464838306728350704966234151134620041799373762432970330864023007632010865749239024802839173884778578927209741320635135275002489733299806669933393428518104197594560039136096527206600870299327752296492029012993590212340409989598323540081430189567580333356380487749078595746626408529223195894600223743978246922817054226858311823994547784553612982586322603593335538875728113115443554199017672360091721648.0 9164115638960783470.0) 30958566711373255787092081401292877738974978442987704470984765018293851031728996862405055424093249924047528792113585028592262445810946419909807061004531455817427671594281537965628880611732831524185850161910304038646992464838306728350704966234151134620041799373762432970330864023007632010865749239024802839173884778578927209741320635135275002489733299806669933393428518104197594560039136096527206600870299327752296492029012993590212340409989598323540081430189567580333356380487749078595746626408529223195894600223743978246922817054226858311823994547784553612982586322603593335538875728113115443554189853556721130938178.0)
+  (num-test (- -22540807692474380279530794404584230073523360203115293035869063366926380719566516089428840111682263403627532047214106171892715667227836310498366393991106231487046533598391969789120283294510723096483520917309134391072655861112766764278247568027435618337967113341863713181603534251049249873125130781073437913954718595729437608729446837417196899902194261111827656247095442897532040935029872731410799530408713850806239149348700486268275019296069828199088780767614008685960242354118969741283398882689239770114582524756296906388861630890288875920861344939520380841337675934551587994259348267613541166769237154904791412049964.0 16928681651977808800.0) -22540807692474380279530794404584230073523360203115293035869063366926380719566516089428840111682263403627532047214106171892715667227836310498366393991106231487046533598391969789120283294510723096483520917309134391072655861112766764278247568027435618337967113341863713181603534251049249873125130781073437913954718595729437608729446837417196899902194261111827656247095442897532040935029872731410799530408713850806239149348700486268275019296069828199088780767614008685960242354118969741283398882689239770114582524756296906388861630890288875920861344939520380841337675934551587994259348267613541166769254083586443389858764.0)
+  (num-test (- -5403850875869356031749551669837202919756114555261706106905659104903792701565965475066159243529680606410723686422444947172225540145977333194008702465610630608545009270872541652430806931212184915840724378685979865349848151917650322286497417985248678815214889868576385900691591784772762893647315325310416150353725001943778473686980157692817497562783521120544549784746647104651038037129984152623720529803205580894126664077380391379306511348324442512538418658728022685805514196592544294177914956734669359073791151050869328577099869772182315103156047405800398706114122356939316464974680113324979723289916823063616573634058.0 -10755560408227106818.0) -5403850875869356031749551669837202919756114555261706106905659104903792701565965475066159243529680606410723686422444947172225540145977333194008702465610630608545009270872541652430806931212184915840724378685979865349848151917650322286497417985248678815214889868576385900691591784772762893647315325310416150353725001943778473686980157692817497562783521120544549784746647104651038037129984152623720529803205580894126664077380391379306511348324442512538418658728022685805514196592544294177914956734669359073791151050869328577099869772182315103156047405800398706114122356939316464974680113324979723289906067503208346527240.0)
+  (num-test (- 16201587974698660164372991183566748501003872177894450603471850345714117528335101264234127789041855420954511595895378320972957964222386731614839583078498685801156670229700092209313747849610762975747730086443186821337319452128253859293962343891549207804191088925361935683615063225197130192492652062735684739784075955094308092423304262201429421582566117390598395895220976999990205945523225411701169301910362640419341608407294018105959688929256136725564385243617240412649023368133778798063226772467915584333795357813292935080009919284755332034998122912861893282865727947810588086156919649131720183722427134042574317487793.0 -126159569916621842.0) 16201587974698660164372991183566748501003872177894450603471850345714117528335101264234127789041855420954511595895378320972957964222386731614839583078498685801156670229700092209313747849610762975747730086443186821337319452128253859293962343891549207804191088925361935683615063225197130192492652062735684739784075955094308092423304262201429421582566117390598395895220976999990205945523225411701169301910362640419341608407294018105959688929256136725564385243617240412649023368133778798063226772467915584333795357813292935080009919284755332034998122912861893282865727947810588086156919649131720183722427260202144234109635.0)
+  (num-test (- -9976758107386398142455037422077809088581080675608340830198269021688955930541332630075972471934165382030070969307731206728197760190279942894255740733209190331510591013089699837164445642396864912572863786290237335963836376543389815671640509582958465164874961381137096877288362944469137669502842448492172241151419831252572392809173900377271652074261706120638052379886108764460001026094198502028776365675088466580595870167840105746912975236851293882732079317535103041585285239081516202482201377111734010788198635874359396626004300532752450289119192633850562141516671742961938277967783337559307443617308447853505824391099.0 13449070890444925581.0) -9976758107386398142455037422077809088581080675608340830198269021688955930541332630075972471934165382030070969307731206728197760190279942894255740733209190331510591013089699837164445642396864912572863786290237335963836376543389815671640509582958465164874961381137096877288362944469137669502842448492172241151419831252572392809173900377271652074261706120638052379886108764460001026094198502028776365675088466580595870167840105746912975236851293882732079317535103041585285239081516202482201377111734010788198635874359396626004300532752450289119192633850562141516671742961938277967783337559307443617321896924396269316680.0)
+  (num-test (- -8570952518585194406209873586517687582701183275108243979199329595605282282125006489076327154374449108678257552384372919282846744626955206382078850958298637157198962032090439427286914716782317030245513658212430127586764421559372214829010306717557679285031617989735914399954286846456953917915955558448774972943731602144914068097214910567329340361564904028964471241318105967747431610163083002382821902859161510204381788262611298660559327478615315484763561786397041779926288206767156863141140852268323253657685018587945456372648431446464389004257999049529945532453598011773843788498650935959375182414447893892341891463988.0 4431555062692055371.0) -8570952518585194406209873586517687582701183275108243979199329595605282282125006489076327154374449108678257552384372919282846744626955206382078850958298637157198962032090439427286914716782317030245513658212430127586764421559372214829010306717557679285031617989735914399954286846456953917915955558448774972943731602144914068097214910567329340361564904028964471241318105967747431610163083002382821902859161510204381788262611298660559327478615315484763561786397041779926288206767156863141140852268323253657685018587945456372648431446464389004257999049529945532453598011773843788498650935959375182414452325447404583519359.0)
+  (num-test (- 4117976000917214601143188578494558474138167055110060832594841842655428229500889876131794484851166401425675703592388271925904534237338595998991043982676292549088043959446082382516734793718348862105938692342851330680670593768890094290655852108130945387988863730762717733881418314989528719379494082656897158942547008663543153236129762264443358316776532465284014215413819415615612452225913947961681691310132286840303081453109375175436902292224029179426794714036524361081174901146731799945483243427138748119832116750910126386838614645397770107366925613473924955965862778639046707637382775371488874447622330992324750207465.0 329466253508616383200261654231797136951.0) 4117976000917214601143188578494558474138167055110060832594841842655428229500889876131794484851166401425675703592388271925904534237338595998991043982676292549088043959446082382516734793718348862105938692342851330680670593768890094290655852108130945387988863730762717733881418314989528719379494082656897158942547008663543153236129762264443358316776532465284014215413819415615612452225913947961681691310132286840303081453109375175436902292224029179426794714036524361081174901146731799945483243427138748119832116750910126386838614645397770107366925613473924955965862778639046707637053309117980258064422069338092953070514.0)
+  (num-test (- 28857935543824608075326348244201981931023939250259142606733822094071772153858420201297951828741003977413353359215638528196235956061529059419904405354390715114239219947402126760298132539402386106279333968395498788354937020337343839325588433318100331044091923709732742795159387846354148919054314582749477292946200912006940503778924320301062789466388997936618573519744795661160190636101768486096961991215006236190655062992372061052426455063703038765465688361316141792840153608145888307784845264037109867657483109819380082597605481013612040648149090345778910883349230476481347645708269410828528742743794495302359380494607.0 126536164564464424337714470705049463978.0) 28857935543824608075326348244201981931023939250259142606733822094071772153858420201297951828741003977413353359215638528196235956061529059419904405354390715114239219947402126760298132539402386106279333968395498788354937020337343839325588433318100331044091923709732742795159387846354148919054314582749477292946200912006940503778924320301062789466388997936618573519744795661160190636101768486096961991215006236190655062992372061052426455063703038765465688361316141792840153608145888307784845264037109867657483109819380082597605481013612040648149090345778910883349230476481347645708142874663964278319456780831654331030629.0)
+  (num-test (- 3146199586408378667812619157270468624370984629500707476575291934586478540055436137993431548830607708293475788354970610669452058906009873485175438772484599603993015239438297747261356407887781450787482447252615210880612867127689283653562498484594955015919746443263740095372831444793239911996227663006098501180972347442107190398034048225264564325230296723559400768342331039755765597288518435463475921534765025262262798267314969774604439319964638461636007229819888743218820584570149249791727508891676067767073852694327748467914037392778283816153183422263956621516748627574334199731850712255885395479903525322397561293553.0 -169494171680584797187706369710105239124.0) 3146199586408378667812619157270468624370984629500707476575291934586478540055436137993431548830607708293475788354970610669452058906009873485175438772484599603993015239438297747261356407887781450787482447252615210880612867127689283653562498484594955015919746443263740095372831444793239911996227663006098501180972347442107190398034048225264564325230296723559400768342331039755765597288518435463475921534765025262262798267314969774604439319964638461636007229819888743218820584570149249791727508891676067767073852694327748467914037392778283816153183422263956621516748627574334199732020206427565980277091231692107666532677.0)
+  (num-test (- -17024716654716744558842421452239026542281806678754026383430912733874686056449261218428541803113383766132449624540209841726047308927951820311213785345168358108138304716549475322223600292513384537980742126687035576531330089447100646214364923043445903103768701639992829171572718403272488931980504461938688955457870904289239032709146514866818331202329982821151580491257491540240579366183525075936339515949345815704583685855315810611089822402567649542290589282153225725537026309623090382054078872576985425957096858376112688308214148412270019118710904983829984589093557307164347051152307499446188262820058714564165108542508.0 -26845770031559702758807696432929071597.0) -17024716654716744558842421452239026542281806678754026383430912733874686056449261218428541803113383766132449624540209841726047308927951820311213785345168358108138304716549475322223600292513384537980742126687035576531330089447100646214364923043445903103768701639992829171572718403272488931980504461938688955457870904289239032709146514866818331202329982821151580491257491540240579366183525075936339515949345815704583685855315810611089822402567649542290589282153225725537026309623090382054078872576985425957096858376112688308214148412270019118710904983829984589093557307164347051152280653676156703117299906867732179470911.0)
+  (num-test (- -20875354448001792153279041347864644172439177882677780548397567327274288309764204295853633150227327732322157811413794613378828291977852467550695289535036337326494269114787031260705326469002279939986228049380615128280814933748700667874022724707001736732724010699175779382411342385842744973636495738468838244099596215421975861650998954057316519632062827510021706536194961332185926551767127180751211669386674770139039516623606727799489291663572125587356845055646322930167536458093283930082765496058330805117442824718962237069840252138957395570892073194575112213410604881673785921789655406716271370732069643455590690035701.0 -321447426701397438572265325285879998363.0) -20875354448001792153279041347864644172439177882677780548397567327274288309764204295853633150227327732322157811413794613378828291977852467550695289535036337326494269114787031260705326469002279939986228049380615128280814933748700667874022724707001736732724010699175779382411342385842744973636495738468838244099596215421975861650998954057316519632062827510021706536194961332185926551767127180751211669386674770139039516623606727799489291663572125587356845055646322930167536458093283930082765496058330805117442824718962237069840252138957395570892073194575112213410604881673785921789333959289569973293497378130304810037338.0)
+  (num-test (- -6750548706930727136186675393752693335334383613941059024795513640678178119089262068912855951615043660442324823673049951182143778744824110223137384940032268718291241014850714197673735719784663896993460156686600813524168487673234842233781654493200950459723884918456280719440022930492599128086690014332139955274261568563155723011697763382009890186816226119314994799655369791620499988988986590903148198659095740939986627235565633349906453726759224441608018598520571182643709143072528030332708598472074166415467718451869993686505339408706320298338691467040585228617379086727764240955696690287600957842671916189752415855520.0 132223863177855649509430852484092802671.0) -6750548706930727136186675393752693335334383613941059024795513640678178119089262068912855951615043660442324823673049951182143778744824110223137384940032268718291241014850714197673735719784663896993460156686600813524168487673234842233781654493200950459723884918456280719440022930492599128086690014332139955274261568563155723011697763382009890186816226119314994799655369791620499988988986590903148198659095740939986627235565633349906453726759224441608018598520571182643709143072528030332708598472074166415467718451869993686505339408706320298338691467040585228617379086727764240955828914150778813492181347042236508658191.0)
+  (num-test (- 15737797902964168014939893286340956118635524170934156177365242966267432695262586636031957242055461736359478270642576860414422844075672388559647477705484719667060463718865742735598799928335211410004369240278699196301127699945374217439676378682879115442203681638050752745036508637214733712716867800216723838016099572951915042604603457902610639317648800296497583507890473114507231814851908526534709496988648572353272479026750068932474334642929727977996779536604912743446197670724757690108283368934769626461285961947257397454619164856011847736479229692086038931510067165282571276049292116713101550911614590774659556899356.0 -6114512833799784097991148713266650451765474382378581896952003894922931741133332233338460555227243451198289670274036744955599177213449957470212981501678055.0) 15737797902964168014939893286340956118635524170934156177365242966267432695262586636031957242055461736359478270642576860414422844075672388559647477705484719667060463718865742735598799928335211410004369240278699196301127699945374217439676378682879115442203681638050752745036508637214733712716867800216723838016099572951915042604603457902610639317648800296497583507890473114507231814851908526534709496988648572353272479026750068932474334642929727977996779536604912749560710504524541788099432082201420078226760344325839294406623059778943588869811463030546594158753518363572241550086037072312278764361572060987641058577411.0)
+  (num-test (- -26633154627863501044020127597209297142657179797586777727331879111280843451446814109347357601013807189824906954310855123313836812409388745541128842840054310853220032505914307470215180950497357091093642400638925719682307925365402618310180378684705799724964274776149984064608716300479893889145492885897234574442542501896696821902329473018442082678749291668341477914681413039643187020003425962922948452894682558162414623956491734656939841377698702802567258906642912449969621455596132708975438173455827361542712483153981422051943690720556013580161324856788091093465837542336129629269227369781823515673967591796132853515009.0 3321161637038961370471515250185392889390643163295535903347391615170504064647249127732639364682803744773593849851778894972403397573953564801884397178069327.0) -26633154627863501044020127597209297142657179797586777727331879111280843451446814109347357601013807189824906954310855123313836812409388745541128842840054310853220032505914307470215180950497357091093642400638925719682307925365402618310180378684705799724964274776149984064608716300479893889145492885897234574442542501896696821902329473018442082678749291668341477914681413039643187020003425962922948452894682558162414623956491734656939841377698702802567258906642912453290783092635094079446953423641220250933355646449517325399335305891060078227410452589427455776269582315929979481048122342185221089627532393680530031584336.0)
+  (num-test (- 27668394897866653012794531261739800318882766882548843941974485394983434533400277607364280566269718161470415771058329222680901477416257843578362127708934184467195154000133252468684612556324066063725677629160438683034201285122508880444372096430021219637788794365539396242345208611990491721052691567092029622640533057073151980959055665792776356282961971341363712186503783566960850166774438868528799819047163739437906559674823146932668464230936946321915236658512741918196732794332451120218658490129307932187658010681746557120172585093207839141764683325214902696969028472942954863209641597556494684135445935915485525220911.0 204625459185084436546676461283890328511903949966691877662249903659689934813784661695047569885195881142676761876303280806728760511429260843727967794322777.0) 27668394897866653012794531261739800318882766882548843941974485394983434533400277607364280566269718161470415771058329222680901477416257843578362127708934184467195154000133252468684612556324066063725677629160438683034201285122508880444372096430021219637788794365539396242345208611990491721052691567092029622640533057073151980959055665792776356282961971341363712186503783566960850166774438868528799819047163739437906559674823146932668464230936946321915236658512741917992107335147366683671982028845417603675754060715054679457922681433517904327980021630167332811773147330266192986906360790827734172706185092187517730898134.0)
+  (num-test (- 18944451653774463090918576081661764936021793389045063662102219434278236461286997354190032851092512146937346521704215170240383659165117708716738711782597164244188741818096207452074083439983059414271417130274747048227795964884943105011205424198661201055104372863019759130697888820715782179466491256695453118035286889359217448004524564796840711987314064158194625731263591557915838970249677548534895064545467992194029425250039951132361639559343536937119283951538321037694842089561504643350632756961329867761604760788760440497535611072991056505806805291706178639395690245460397975614715123591611301423752799666149495108752.0 994321141213369910357526037382331323092462599623554452705525887587326552002660849455542761618020243106424015447778226642816634338781654345001677083881111.0) 18944451653774463090918576081661764936021793389045063662102219434278236461286997354190032851092512146937346521704215170240383659165117708716738711782597164244188741818096207452074083439983059414271417130274747048227795964884943105011205424198661201055104372863019759130697888820715782179466491256695453118035286889359217448004524564796840711987314064158194625731263591557915838970249677548534895064545467992194029425250039951132361639559343536937119283951538321036700520948348134732993106719578998544669142161165205987792009723485664504503145955836163417021375447139036382527836488480774976962642098454664472411227641.0)
+  (num-test (- -25075128489482657321316021943980016828761861550379828525731288423212311433274066958090940464803020097932875912251380196071686918459370667428905844496548191635733867314315152547202859654044591981512687559437417616479425752991419002108503390319869665933757684966460526631533822984311725217788657567199485442486045019468844265484117570385156844404625735176559901986920712550964238722824122000259551821135404274194791706113272773768366572120227974096419295159271316157215551931810740200836725504693738229444336470213883741520460842708733150362983831267583568258736572295448486287825894301201018490203520738439038977754991.0 -7402949251688548738762242219263594861535354011996392637087346760786292549376145193266590582054224293289596877537643409310483743293801574030358189880866069.0) -25075128489482657321316021943980016828761861550379828525731288423212311433274066958090940464803020097932875912251380196071686918459370667428905844496548191635733867314315152547202859654044591981512687559437417616479425752991419002108503390319869665933757684966460526631533822984311725217788657567199485442486045019468844265484117570385156844404625735176559901986920712550964238722824122000259551821135404274194791706113272773768366572120227974096419295159271316149812602680122191462074483285430143367908982458217491104433114081922440600986838638000992986204512279005851608750182484990717275196401946708080849096888922.0)
+  (num-test (- -26509487378481600038412836495388065888781507388737194948728047318975269277448073484403390476243134990463394380967295356958474984927721196047241216945988250219075749832868804186657201899994373052648345989716938779173325348547767647529160988985542438998030764420175306438858518207072038513664360905985908879070216069156102379349899544471658754952888660878997691670566078979940005195987259493512159628198906090101827331841914429358969184839073862821059400943312264269215878469013316796620921077244799814690434355127994011220041638393750697699141479399553359747084811371804524490919966410379714725200415331414459870271869.0 -9247155945465656153397925559476432992975541781462281935278489123804934847762489500833913193183733932905776020790478662969835879365116238125565077744775032.0) -26509487378481600038412836495388065888781507388737194948728047318975269277448073484403390476243134990463394380967295356958474984927721196047241216945988250219075749832868804186657201899994373052648345989716938779173325348547767647529160988985542438998030764420175306438858518207072038513664360905985908879070216069156102379349899544471658754952888660878997691670566078979940005195987259493512159628198906090101827331841914429358969184839073862821059400943312264259968722523547660643222995517768366821714892573665712075941552514588815849936651978565640166563350878466028503700441303440543835360084177205849382125496837.0)
+  (num-test (- -17010604274474750006607667808593883725990508452473783283717890546525148212376267233909567638545898628257361383837671935903199638230375408397752251127816717091041943873728526445398525706450929660366518707254053655364610471112296477865068960744948010561798109833411657930112293904378353445961131058136287425064317621271289456901138718557297733713446119244533144377470099270824020439428168481914824420861176457152299497728390918971852021025089592998997807574907789524112450146545688385954763667980124432645276563626082835790429598328230426471161191074551543308732791287559033843466623138171520961684959997180979203053477.0 -17319079025684619178510812811805110270463447771889107440996086020812918555191263705580533644731591929176480040622705607552852994906782176254877135818109655911838591767583157894999741648979817400330572419476101372927546509769818404491634583907246692993992514876697330603464497645633398167129555001859772111887143352351860130929715392173452396253437927361301990735683539169040916027268831202732178553152351117118606495416985612909248422655861312689027789401950549626643389790516560291620711705848717875304929186131258525831197192620523261738944873398924939726689336762464320190834794155527335576391767307110012289717973.0) 308474751209869171903145003211226544472939319415324157278195474287770342814996471670966006185693300919118656785033671649653356676406767857124884690292938820796647893854631449601215942528887739964053712222047717562936038657521926626565623162298682432194405043285672673352203741255044721168423943723484686822825731080570674028576673616154662539991808116768846358213439898216895587840662720817354132291174659966306997688594693937396401630771719690029981827042760102530939643970871905665948037868593442659652622505175690040767594292292835267783682324373396417956545474905286347368171017355814614706807309929033086664496.0)
+  (num-test (- -28362352496476494327713713233021518136860402239251781438945998574753662942796270292818595738100959519541952077905620088422871490191217157269435052965329201030095268586136492980900212955645939325800541690754639292707053269767151001292253701853012092829784482071789669480438026889625605099744553642207773753943711175375843649210118677569597324789367425691177169929576236753018329085700397911235750600921874606148324025962628852167093806152864269874177214562322576097931390470469397118268354868919899638376323751276807304678316688836173746719723312665764603485606350244811113608471530958617108833879194264695174468397461.0 -4081062111675377984305281082755054920741203741273067094307824323728798665450292976016160959354997082250970415737745853292134965575242789548167162064123232363464302136338349828801951197252612093077640695564825095503535921549690447893467349156939791370286866987224201115453216606688305427702274940837032716124925028835914047967887674858015919302546781010326385758988488478290741665427521820112231266659657169118374988259423444686317389869729817643396097464874333968181509317307320406521221309011946212308190273531009796563611621389720223920155554879800901239072885025170342349379379336047732368458185953903872634982504.0) -24281290384801116343408432150266463216119198497978714344638174251024864277345977316802434778745962437290981662167874235130736524615974367721267890901205968666630966449798143152098261758393327232722900995189814197203517348217460553398786352696072301459497615084565468364984810282937299672042278701370741037818786146539929601242231002711581405486820644680850784170587748274727587420272876091123519334262217437029949037703205407480776416283134452230781117097448242129749881153162076711747133559907953426068133477745797508114705067446453522799567757785963702246533465219640771259092151622569376465421008310791301833414957.0)
+  (num-test (- 10367142604728811799331249565431331488313655422005202933702176605382043644320209814639311439871418581341534233560256605231366966869093495784665834232350567124110194965198962966795893926025854156729633358240069116588609932539289897499402463770167927610848388138020589286461244557962368497723086593344721146859584146431437967506007518396464517349944129896971137720357645026281243138165214047233258394590454775153944241555543594427555914116439316287902470043292624597940465373006598913770411505099332700167695871387948271302951230983772351549087620538875967635100644404345317626621438913980275970160864401622986870735123.0 -13323117602411502623386235160326625769048477819798659261203460002048250420188223753407093545503703207645050883770850457071863684414849353264890601744588860687970804808452855795406182324143949747985869939791374195222513169904228914579995165180964917538177994190229733465224857616114628815752065632238207474599531507602861647623695058640735949593381112671690796335596142010430124683781417828023076027476816068202219709673411776556090962187853799456968290579708094595903778622705850818245685205707447012659247018940946510378371952655457988959551256869060428488498330109152756599450626641948447980234503249330875085656261.0) 23690260207140314422717484725757957257362133241803862194905636607430294064508433568046404985375121788986585117331107062303230651283942849049556435976939427812080999773651818762202076250169803904715503298031443311811123102443518812079397628951132845149026382328250322751686102174076997313475152225582928621459115654034299615129702577037200466943325242568661934055953787036711367821946631875256334422067270843356163951228955370983646876304293115744870760623000719193844243995712449732016096710806779712826942890328894781681323183639230340508638877407936396123598974513498074226072065555928723950395367650953861956391384.0)
+  (num-test (- -25321281404861286799950777949097462701962113587443565138655462269365151737118518315058035825695270231347401755128007072923189452859397209062457461602335603630181865680063451525170253746137368267674863889514153713728814272332433431604233690200451816570240227260445028630591376891139306370205846627093813889699170594185178241812081296510140572331372738998993116117098817936927692238682202717231675283209016857095739468507690090676681400453024293870135659990528969837132054786661560150259115734877162158755858653364070279937027014730947342216816307219127474721622123875699701715404820384545693058511056735799834754890692.0 -15870257059811626693754498423136372480069134596343998984549199283973854570508228359295418026089909378687774627821225399931314225867711515277913855368473873536462450935842786002269065816311054834857109074848803122494252885020527074586145467185882674518032764708782999568002770206995683800833252068328835778749976046128872525287656002968632147457840467536682726059599593635219947081138082647985895437016641903078766878782632503812736486529143041369932038649270950453231711525943737962179463585338023463992816994328519710963267459007592689204838965317062070771191372220277256094361390952025057574056586665509010902583686.0) -9451024345049660106196279525961090221892978991099566154106262985391297166610289955762617799605360852659627127306781672991875226991685693784543606233861730093719414744220665522901187929826313432817754814665350591234561387311906357018088223014569142052207462551662029062588606684143622569372594558764978110949194548056305716524425293541508424873532271462310390057499224301707745157544120069245779846192374954016972589725057586863944913923881252500203621341258019383900343260717822188079652149539138694763041659035550568973759555723354653011977341902065403950430751655422445621043429432520635484454470070290823852307006.0)
+  (num-test (- -10064759312484387184876313010284016458560725440641239737323234767636591183611201479885347260175161165340917225306019885202675573016295152797559983194160634880140345743489989007821872426587698574795394887035658449467358615185057180305109018898637903449135520486663185036663238956537895356325733583128141439025002140924158670346599492383552938312402521066705186885506193758499006001382444818328802338159713646715901977137011576113434170842422373328479181457354927400927267448788528116619711184792932525071391797130057189079431487557270366699175956757661488296856660145077706273571985222726397848614141194988258117115194.0 -3689074607001776735792882994440038588887963294487080609346609068733026224735369468180206799966728461935654851527895876039403151156669223687679382665269013769686991783531091821265184956524448064027733731862929686596729449196238312997460578818232100254940830907672953344544031914926653652310468671685310332327057444910423081752028857828828473637496272809899061573593874011995802487442092326045415689987885712749026491545159340468151000027397821404233369034594141219014219707193746581364791219277489927025992135462852894714639406751538919395016165215641239054420028872350709704191189169571752512626755385998505584006855.0) -6375684705482610449083430015843977869672762146154159127976625698903564958875832011705140460208432703405262373778124009163272421859625929109880600528891621110453353959958897186556687470063250510767661155172728762870629165988818867307648440080405803194194689578990231692119207041611241704015264911442831106697944696013735588594570634554724464674906248256806125311912319746503203513940352492283386648171827933966875485591852235645283170815024551924245812422760786181913047741594781535254919965515442598045399661667204294364792080805731447304159791542020249242436631272726996569380796053154645335987385808989752533108339.0)
+  (num-test (- -4621513851362114851854472268081584822344822740665629177305004335694395719163541988311496405455186973857145245414214464449674464879082042971313025249648887349614046805778335573547862191522938924075560443632614665169520240664970180760364771373836023824195690134618554368845612471858027311791638881380352344527105480173917778084361560336490212845414303819150625355111300877737042696291233444311426721588476948565949641149735838580313236869041013210454558557732497012037162735013212361842433337324577522358968152852532145622765032318936569346015498130151789662274686368870963891262060214274101000058555635785833724062234.0 20283847238128227963042817384468009365120280641032764409860857066215336820785816567924217697745867082423864450685360959383940995237907453126362378908108545669654749698030305432673477271848544313029448526561606175059997663752601262173667861202924953502866611309434183496911206954880840674239880495147451496219568787221129244201657487090244435562896841733049066453539864301122516559479757096183362477594406691085946787803323712522074578611082872627361465163804239673539339633332349145205596371287028267780080937728455742966681547897652607170788637996317683436193829274172400558140357237480809582038468874094877651383053.0) -24905361089490342814897289652549594187465103381698393587165861401909732539949358556235714103201054056281009696099575423833615460116989496097675404157757433019268796503808641006221339463371483237105008970194220840229517904417571442934032632576760977327062301444052737865756819426738867986031519376527803840746674267395047022286019047426734648408311145552199691808651165178859559255770990540494789199182883639651896428953059551102387815480123885837816023721536736685576502368345561507048029708611605790139049090580987888589446580216589176516804136126469473098468515643043364449402417451754910582097024509880711375445287.0))
+
+(test (- - 1) 'error)
+(test (-) 'error)
+(test (- 1 #f) 'error)
+(test (- 1 #t) 'error)
+(test (- 1 + 2) 'error)
+(test (- 1 - 2) 'error)
+(test (- 1 2 . 3) 'error)
+(test (- 1 . 2) 'error)
+(unless with-bignums
+  (test (- most-negative-fixnum) 'error)
+  (test (- most-positive-fixnum) (+ most-negative-fixnum 1)))
+
+(catch #t (lambda () (- 1 #())) (lambda (type info) (test (apply format #f info) "- second argument, #(), is a vector but should be a number")))
+(catch #t (lambda () (- #() 1)) (lambda (type info) (test (apply format #f info) "- first argument, #(), is a vector but should be a number")))
+(catch #t (lambda () (- 1 2 #())) (lambda (type info) (test (apply format #f info) "- third argument, #(), is a vector but should be a number")))
+(catch #t (lambda () (- 1 2 3 #())) (lambda (type info) (test (apply format #f info) "- fourth argument, #(), is a vector but should be a number")))
+
+(for-each
+ (lambda (arg)
+   (test (- arg +nan.0) 'error)
+   (test (- +nan.0 arg) 'error)
+   (test (- arg +inf.0) 'error)
+   (test (- +inf.0 arg) 'error)
+   (test (- arg) 'error)
+   (test (- 1 arg) 'error)
+   (test (- 1/2 arg) 'error)
+   (test (- 1.0 arg) 'error)
+   (test (- 1+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; /
+;;; --------------------------------------------------------------------------------
+
+(num-test (/ -0.0+0.00000001i) 0.0-100000000.0i)
+(num-test (/ -1.0) -1.0)
+(num-test (/ -1.0+1.0i -1.0+1.0i) 1.0)
+(num-test (/ -1.0+1.0i 0.0+1.0i) 1.0+1.0i)
+(num-test (/ -1.0+1.0i 1) -1.0+1.0i)
+(num-test (/ -1.0+1.0i 1.0) -1.0+1.0i)
+(num-test (/ -1.0+1.0i 1.0+1.0i) 0.0+1.0i)
+(num-test (/ -1.0+1.0i 1/1) -1.0+1.0i)
+(num-test (/ -1.0+1.0i 123.4) -0.00810372771475+0.00810372771475i)
+(num-test (/ -1.0+1.0i 1234) -0.00081037277147+0.00081037277147i)
+(num-test (/ -1.0+1.0i 1234/11) -0.00891410048622+0.00891410048622i)
+(num-test (/ -1.0+1.0i) -0.5-0.5i)
+(num-test (/ -10) -1/10)
+(num-test (/ -10/3) -3/10)
+(num-test (/ -10 3) -10/3)
+(num-test (/ -1234000000.0) -0.00000000081037)
+(num-test (/ -2) -1/2)
+(num-test (/ 0 -1.0+1.0i) 0.0)
+(num-test (/ 0 1 -1.0+1.0i) 0.0)
+(num-test (/ 0 1 1) 0)
+(num-test (/ 0 1 1.0+1.0i) 0.0)
+(num-test (/ 0 1 123.4) 0.0)
+(num-test (/ 0 1 1234/11) 0)
+(num-test (/ 0 1.0 -1.0+1.0i) 0.0)
+(num-test (/ 0 1.0 1) 0.0)
+(num-test (/ 0 1.0 1.0+1.0i) 0.0)
+(num-test (/ 0 1.0 123.4) 0.0)
+(num-test (/ 0 1.0 1234/11) 0.0)
+(num-test (/ 0 1.0+1.0i -1.0+1.0i) 0.0)
+(num-test (/ 0 1.0+1.0i 1) 0.0)
+(num-test (/ 0 1.0+1.0i 1.0+1.0i) 0.0)
+(num-test (/ 0 1.0+1.0i 123.4) 0.0)
+(num-test (/ 0 1.0+1.0i 1234/11) 0.0)
+(num-test (/ 0 1/1 -1.0+1.0i) 0.0)
+(num-test (/ 0 1234) 0)
+(num-test (/ 0.0 -1.0+1.0i -1.0+1.0i) 0.0)
+(num-test (/ 0.0 1 -1.0+1.0i) 0.0)
+(num-test (/ 0.0 1 1.0) 0.0)
+(num-test (/ 0.0 1 1/1) 0.0)
+(num-test (/ 0.0 1 1234) 0.0)
+(num-test (/ 0.0 1) 0.0)
+(num-test (/ 0.0 1.0 0.0+1.0i) 0.0)
+(num-test (/ 0.0 1.0 1.0) 0.0)
+(num-test (/ 0.0 1.0 1/1) 0.0)
+(num-test (/ 0.0 1.0 1234) 0.0)
+(num-test (/ 0.0 1.0) 0.0)
+(num-test (/ 0.0 1/1 -1.0+1.0i) 0.0)
+(num-test (/ 0.0 1234 -1.0+1.0i) 0.0)
+(num-test (/ 0.0+0.00000001i) 0.0-100000000.0i)
+(num-test (/ 0.0+1.0i 0.0+1.0i) 1.0)
+(num-test (/ 0.0+1.0i 1.0) 0.0+1.0i)
+(num-test (/ 0.0+1.0i 1/1) 0.0+1.0i)
+(num-test (/ 0.0+1.0i 1234) 0.0+0.00081037277147i)
+(num-test (/ 1 -1.0+1.0i) -0.5-0.5i)
+(num-test (/ 1 1 -1.0+1.0i) -0.5-0.5i)
+(num-test (/ 1 1 1) 1)
+(num-test (/ 1 1 1.0+1.0i) 0.5-0.5i)
+(num-test (/ 1 1 123.4) 0.00810372771475)
+(num-test (/ 1 1 1234/11) 11/1234)
+(num-test (/ 1 1.0 -1.0+1.0i) -0.5-0.5i)
+(num-test (/ 1 1.0 1) 1.0)
+(num-test (/ 1 1.0 1.0+1.0i) 0.5-0.5i)
+(num-test (/ 1 1.0 123.4) 0.00810372771475)
+(num-test (/ 1 1.0 1234/11) 0.00891410048622)
+(num-test (/ 1 1.0+1.0i -1.0+1.0i) -0.5)
+(num-test (/ 1 1.0+1.0i 1) 0.5-0.5i)
+(num-test (/ 1 1.0+1.0i 1.0+1.0i) 0.0-0.5i)
+(num-test (/ 1 1.0+1.0i 123.4) 0.00405186385737-0.00405186385737i)
+(num-test (/ 1 1.0+1.0i 1234/11) 0.00445705024311-0.00445705024311i)
+(num-test (/ 1 123.4) 0.00810372771475)
+(num-test (/ 1 1234/11) 11/1234)
+(num-test (/ 1.0 -1.0+1.0i 0.0+1.0i) -0.5+0.5i)
+(num-test (/ 1.0 -1.0+1.0i 1.0) -0.5-0.5i)
+(num-test (/ 1.0 -1.0+1.0i 1/1) -0.5-0.5i)
+(num-test (/ 1.0 -1.0+1.0i 1234) -0.00040518638574-0.00040518638574i)
+(num-test (/ 1.0 -1.0+1.0i) -0.5-0.5i)
+(num-test (/ 1.0 0.0+1.0i 0.0+1.0i) -1.0)
+(num-test (/ 1.0 0.0+1.0i 1.0) 0.0-1.0i)
+(num-test (/ 1.0 0.0+1.0i 1/1) 0.0-1.0i)
+(num-test (/ 1.0 0.0+1.0i 1234) 0.0-0.00081037277147i)
+(num-test (/ 1.0 0.0+1.0i) 0.0-1.0i)
+(num-test (/ 1.0 1 0.0+1.0i) 0.0-1.0i)
+(num-test (/ 1.0 1 1.0) 1.0)
+(num-test (/ 1.0 1 1/1) 1.0)
+(num-test (/ 1.0 1 1234) 0.00081037277147)
+(num-test (/ 1.0 1) 1.0)
+(num-test (/ 1.0 1.0 0.0+1.0i) 0.0-1.0i)
+(num-test (/ 1.0 1.0 1.0) 1.0)
+(num-test (/ 1.0 1.0 1/1) 1.0)
+(num-test (/ 1.0 1.0 1234) 0.00081037277147)
+(num-test (/ 1.0 1.0) 1.0)
+(num-test (/ 1.0 1.0+1.0i 0.0+1.0i) -0.5-0.5i)
+(num-test (/ 1.0 1.0+1.0i 1.0) 0.5-0.5i)
+(num-test (/ 1.0 1.0+1.0i 1/1) 0.5-0.5i)
+(num-test (/ 1.0 1.0+1.0i 1234) 0.00040518638574-0.00040518638574i)
+(num-test (/ 1.0 1.0+1.0i) 0.5-0.5i)
+(num-test (/ 1.0 1/1 0.0+1.0i) 0.0-1.0i)
+(num-test (/ 1.0 123.4 0.0+1.0i) 0.0-0.00810372771475i)
+(num-test (/ 1.0 123.4 1.0) 0.00810372771475)
+(num-test (/ 1.0 123.4 1/1) 0.00810372771475)
+(num-test (/ 1.0 123.4 1234) 0.00000656704029)
+(num-test (/ 1.0 123.4) 0.00810372771475)
+(num-test (/ 1.0 1234 0.0+1.0i) 0.0-0.00081037277147i)
+(num-test (/ 1.0 1234 1.0) 0.00081037277147)
+(num-test (/ 1.0 1234 1/1) 0.00081037277147)
+(num-test (/ 1.0 1234 1234) 0.00000065670403)
+(num-test (/ 1.0 1234) 0.00081037277147)
+(num-test (/ 1.0 1234/11 0.0+1.0i) 0.0-0.00891410048622i)
+(num-test (/ 1.0 1234/11 1.0) 0.00891410048622)
+(num-test (/ 1.0 1234/11 1/1) 0.00891410048622)
+(num-test (/ 1.0 1234/11 1234) 0.00000722374432)
+(num-test (/ 1.0 1234/11) 0.00891410048622)
+(num-test (/ 1.0+1.0i -1.0+1.0i -1.0+1.0i) -0.5+0.5i)
+(num-test (/ 1.0+1.0i -1.0+1.0i 1) -0.0-1.0i)
+(num-test (/ 1.0+1.0i -1.0+1.0i 1.0+1.0i) -0.5-0.5i)
+(num-test (/ 1.0+1.0i -1.0+1.0i 123.4) -0.0-0.00810372771475i)
+(num-test (/ 1.0+1.0i -1.0+1.0i 1234/11) -0.0-0.00891410048622i)
+(num-test (/ 1.0+1.0i 0.0+1.0i -1.0+1.0i) -1.0)
+(num-test (/ 1.0+1.0i 0.0+1.0i 1) 1.0-1.0i)
+(num-test (/ 1.0+1.0i 0.0+1.0i 1.0+1.0i) 0.0-1.0i)
+(num-test (/ 1.0+1.0i 0.0+1.0i 123.4) 0.00810372771475-0.00810372771475i)
+(num-test (/ 1.0+1.0i 0.0+1.0i 1234/11) 0.00891410048622-0.00891410048622i)
+(num-test (/ 1.0+1.0i 1 -1.0+1.0i) -0.0-1.0i)
+(num-test (/ 1.0+1.0i 1 1) 1.0+1.0i)
+(num-test (/ 1.0+1.0i 1 1.0+1.0i) 1.0)
+(num-test (/ 1.0+1.0i 1 123.4) 0.00810372771475+0.00810372771475i)
+(num-test (/ 1.0+1.0i 1 1234/11) 0.00891410048622+0.00891410048622i)
+(num-test (/ 1.0+1.0i 1.0 -1.0+1.0i) -0.0-1.0i)
+(num-test (/ 1.0+1.0i 1.0 1) 1.0+1.0i)
+(num-test (/ 1.0+1.0i 1.0 1.0+1.0i) 1.0)
+(num-test (/ 1.0+1.0i 1.0 123.4) 0.00810372771475+0.00810372771475i)
+(num-test (/ 1.0+1.0i 1.0 1234/11) 0.00891410048622+0.00891410048622i)
+(num-test (/ 1.0+1.0i 1.0+1.0i -1.0+1.0i) -0.5-0.5i)
+(num-test (/ 1.0+1.0i 1.0+1.0i 1) 1.0)
+(num-test (/ 1.0+1.0i 1.0+1.0i 1.0+1.0i) 0.5-0.5i)
+(num-test (/ 1.0+1.0i 1.0+1.0i 123.4) 0.00810372771475)
+(num-test (/ 1.0+1.0i 1.0+1.0i 1234/11) 0.00891410048622)
+(num-test (/ 1.0+1.0i 1/1 -1.0+1.0i) -0.0-1.0i)
+(num-test (/ 1.0+1.0i 123.4 -1.0+1.0i) -0.0-0.00810372771475i)
+(num-test (/ 1.0+1.0i 123.4 1) 0.00810372771475+0.00810372771475i)
+(num-test (/ 1.0+1.0i 123.4 1.0+1.0i) 0.00810372771475)
+(num-test (/ 1.0+1.0i 123.4 123.4) 0.00006567040287+0.00006567040287i)
+(num-test (/ 1.0+1.0i 123.4 1234/11) 0.00007223744316+0.00007223744316i)
+(num-test (/ 1.0+1.0i 1234 -1.0+1.0i) -0.0-0.00081037277147i)
+(num-test (/ 1.0+1.0i 1234 1) 0.00081037277147+0.00081037277147i)
+(num-test (/ 1.0+1.0i 1234 1.0+1.0i) 0.00081037277147)
+(num-test (/ 1.0+1.0i 1234 123.4) 0.00000656704029+0.00000656704029i)
+(num-test (/ 1.0+1.0i 1234 1234/11) 0.00000722374432+0.00000722374432i)
+(num-test (/ 1.0+1.0i 1234/11 -1.0+1.0i) -0.0-0.00891410048622i)
+(num-test (/ 1.0+1.0i 1234/11 1) 0.00891410048622+0.00891410048622i)
+(num-test (/ 1.0+1.0i 1234/11 1.0+1.0i) 0.00891410048622)
+(num-test (/ 1.0+1.0i 1234/11 123.4) 0.00007223744316+0.00007223744316i)
+(num-test (/ 1.0+1.0i 1234/11 1234/11) 0.00007946118748+0.00007946118748i)
+(num-test (/ 1.0+1.0i) 0.5-0.5i)
+(num-test (/ 10/3) 3/10)
+(num-test (/ 10 -3) -10/3)
+(num-test (/ 11) 1/11)
+(num-test (/ 123.4 -1.0+1.0i 0.0+1.0i) -61.7+61.7i)
+(num-test (/ 123.4 -1.0+1.0i 1.0) -61.7-61.7i)
+(num-test (/ 123.4 -1.0+1.0i 1/1) -61.7-61.7i)
+(num-test (/ 123.4 -1.0+1.0i 1234) -0.05000000000000-0.05000000000000i)
+(num-test (/ 123.4 -1.0+1.0i) -61.7-61.7i)
+(num-test (/ 123.4 0.0+1.0i 0.0+1.0i) -123.4)
+(num-test (/ 123.4 0.0+1.0i 1.0) 0.0-123.4i)
+(num-test (/ 123.4 0.0+1.0i 1/1) 0.0-123.4i)
+(num-test (/ 123.4 0.0+1.0i 1234) 0.0-0.1i)
+(num-test (/ 123.4 0.0+1.0i) 0.0-123.4i)
+(num-test (/ 123.4 1 0.0+1.0i) 0.0-123.4i)
+(num-test (/ 123.4 1 1.0) 123.4)
+(num-test (/ 123.4 1 1/1) 123.4)
+(num-test (/ 123.4 1 1234) 0.1)
+(num-test (/ 123.4 1) 123.4)
+(num-test (/ 123.4 1.0 0.0+1.0i) 0.0-123.4i)
+(num-test (/ 123.4 1.0 1.0) 123.4)
+(num-test (/ 123.4 1.0 1/1) 123.4)
+(num-test (/ 123.4 1.0 1234) 0.1)
+(num-test (/ 123.4 1.0) 123.4)
+(num-test (/ 123.4 1.0+1.0i 0.0+1.0i) -61.7-61.7i)
+(num-test (/ 123.4 1.0+1.0i 1.0) 61.7-61.7i)
+(num-test (/ 123.4 1.0+1.0i 1/1) 61.7-61.7i)
+(num-test (/ 123.4 1.0+1.0i 1234) 0.05000000000000-0.05000000000000i)
+(num-test (/ 123.4 1.0+1.0i) 61.7-61.7i)
+(num-test (/ 123.4 1/1 0.0+1.0i) 0.0-123.4i)
+(num-test (/ 123.4 123.4 0.0+1.0i) 0.0-1.0i)
+(num-test (/ 123.4 123.4 1.0) 1.0)
+(num-test (/ 123.4 123.4 1/1) 1.0)
+(num-test (/ 123.4 123.4 1234) 0.00081037277147)
+(num-test (/ 123.4 123.4) 1.0)
+(num-test (/ 123.4 1234 0.0+1.0i) 0.0-0.1i)
+(num-test (/ 123.4 1234 1.0) 0.1)
+(num-test (/ 123.4 1234 1/1) 0.1)
+(num-test (/ 123.4 1234 1234) 0.00008103727715)
+(num-test (/ 123.4 1234) 0.1)
+(num-test (/ 123.4 1234/11 0.0+1.0i) 0.0-1.10000000000000i)
+(num-test (/ 123.4 1234/11 1.0) 1.10000000000000)
+(num-test (/ 123.4 1234/11 1/1) 1.10000000000000)
+(num-test (/ 123.4 1234/11 1234) 0.00089141004862)
+(num-test (/ 123.4 1234/11) 1.10000000000000)
+(num-test (/ 1234 0.0+1.0i) 0.0-1234.0i)
+(num-test (/ 1234 1.0) 1234.0)
+(num-test (/ 1234 1/1) 1234)
+(num-test (/ 1234 1234) 1)
+(num-test (/ 1234/11 -1.0+1.0i) -56.09090909090909-56.09090909090909i)
+(num-test (/ 1234/11 1) 1234/11)
+(num-test (/ 1234/11 1.0+1.0i) 56.09090909090909-56.09090909090909i)
+(num-test (/ 1234/11 123.4) 0.90909090909091)
+(num-test (/ 1234/11 1234/11) 1)
+(num-test (/ 1234000000.0) 0.00000000081037)
+(num-test (/ 2) 1/2)
+(num-test (/ 2/2) 2/2)
+(num-test (/ 1/2 1+i 1-i) 0.25)
+
+(num-test (/ (bignum 1/3) 1/0+i) +nan.0+nan.0i)
+(num-test (let () (define (func) (/ (bignum 1/3) 1/0+i)) (define (hi) (func)) (hi)) +nan.0+nan.0i)
+
+(when (provided? 'overflow-checks)
+  (num-test (/ 2/9223372036854775807 2) 1/9223372036854775807)
+  (num-test (/ -63/288230376151711744 -63) 1/288230376151711744))
+
+(unless (or with-bignums (not (provided? 'overflow-checks)))
+  (num-test (/ 1/2305843009213693952 -1 4194304/2097151) -2.168403310995243176730312012479018335398E-19)
+  (num-test (/ 1/2199023255552 -63 8388608/4194303) -3.609105098938467225452985162735872325445E-15)
+  (num-test (/ 1/17179869184 -1 1073741824/536870911) -2.91038304025235949890060282996273599565E-11))
+
+(test (nan? (/ 3 1/0+i 5/2)) #t)
+(test (nan? (/ 3 1/0+i (bignum 5/2))) #t)
+(test (nan? (/ (bignum 2.0) -1 1/0+i (bignum 1/3))) #t)
+(test (nan? (/ (bignum 2) (* -1 1/0+i (bignum 1/3)))) #t)
+(test (nan? (/ (bignum 2/3) (* -1 1/0+i (bignum 1/3)))) #t)
+(test (nan? (/ (bignum 2/3+i) (* -1 1/0+i (bignum 1/3)))) #t)
+(test (nan? (/ 2.0 (* -1/3 1/0+i))) #t)
+(test (nan? (/ 3/4 -inf.0+i)) #t)
+
+(for-each-permutation
+ (lambda args
+   (if (not (= (apply / args) (/ (car args) (apply * (cdr args)))))
+       (format #t "~A: ~A != ~A?~%" (port-line-number) (apply / args) (/ (car args) (apply * (cdr args))))))
+ '(1 1/2 0.5 1+i))
+
+(num-test (/ -9223372036854775808 5.551115123125783999999999999999999999984E-17) -1.661534994731144452653560599947843044136E35)
+(num-test (/ 1.110223024625156799999999999999999999997E-16 -9223372036854775808) -1.203706215242022689593248685469006886702E-35)
+(num-test (/ 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) 3.689348814741910322817021726897015792169E19)
+(num-test (/ 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) 5.000E-1)
+(num-test (/ 9223372036854775807 9223372036854775807) 1)
+(num-test (/ (* 2 3 4 5 6 7 8 9 10) (* 2 (expt (log 2) 11))) 102247563.00527)
+(num-test (/ 1 (/ 1 1234)) 1234)
+(num-test (/ 1.0 (/ 1.0 1.0+1.0i)) 1.0+1.0i)
+(num-test (/ 1.0 (/ 1.0 pi)) pi)
+(num-test (/ 1/123412341234) 123412341234)
+(num-test (/ 1/98947 2/97499 3/76847) 7492505653/593682)
+(num-test (/ 123412341234) 1/123412341234)
+(num-test (/ 500009/500029 500057/500041) 250025000369/250043001653)
+(num-test (/ -9223372036854775808 -9223372036854775808 4) 1/4)
+(num-test (/ -9223372036854775808 2) -4611686018427387904)
+(num-test (/ 0 -00-1i) 0.0)
+(num-test (/ 0+i) 0-1i)
+(num-test (/ 0-i) 0+i)
+(num-test (/ 1+i) 1/2-1/2i);
+(num-test (/ 1.0 1/524288 1/19073486328125) 1.000000000000000024754073164739868757037E19)
+(num-test (/ 1/10 010) 1/100)
+(num-test (/ 1/9223372036854775807 1/9223372036854775807) 1)
+(num-test (/ 1234567890/9223372036854775807 123456789/9223372036854775807) 10)
+(num-test (/ 2 -9223372036854775808) -1/4611686018427387904)
+(num-test (/ 2 most-negative-fixnum) -1/4611686018427387904)
+(num-test (/ 3 most-negative-fixnum) (/ 3.0 most-negative-fixnum))
+(num-test (/ 1 most-negative-fixnum) (/ 1.0 most-negative-fixnum))
+(num-test (/ 1 most-negative-fixnum) (/ most-negative-fixnum))
+(num-test (/ 1 most-positive-fixnum) (/ most-positive-fixnum))
+(num-test (/ (- most-positive-fixnum 1) most-negative-fixnum) -4611686018427387903/4611686018427387904)
+(num-test (/ most-positive-fixnum (+ most-negative-fixnum 1)) -1)
+(num-test (/ 1 1) (/ 1))
+(num-test (/ 1 0+i) (/ 0+i))
+(when (provided? 'overflow-checks)
+  (num-test (/ 2/9223372036854775807 2/3) 3/9223372036854775807))
+(num-test (/ 9223372036854775807/123456789 9223372036854775807/123456789) 1)
+(num-test (/ 9223372036854775807/1234567890 9223372036854775807/12345678900) 10)
+(num-test (/ most-negative-fixnum 2) -4611686018427387904)
+(num-test (/ most-negative-fixnum most-negative-fixnum 2) 1/2)
+(num-test (/ most-negative-fixnum most-negative-fixnum) 1)
+(num-test (/ (/ (- most-positive-fixnum))) -9223372036854775807)
+(num-test (/ most-negative-fixnum 864691128455135232) -32/3)
+(when with-bignums
+  (test (/ 1 (*s7* 'most-negative-fixnum)) -1/9223372036854775808) ; most-negative-fixnum here is a bignum
+  (test (/ (*s7* 'most-negative-fixnum)) -1/9223372036854775808)
+  (test (/ -9223372036854775808) -1/9223372036854775808)
+  (test (/ 1 -9223372036854775808) -1/9223372036854775808))
+(num-test (/(*(/(*)))) 1)
+(num-test (/ 12341234/111 123456789 12341234/111) 1/123456789)
+(num-test (/ 1e63 1e-63) 1e126)
+(num-test (/ 1e154 1e-154) 1e308) ; else inf
+(num-test (/ 1e-200 1e200) 0.0)
+;;; inaccuracies creep in (/ 1e-200 1e123) => 9.8813129168249e-324
+;;; or (/ 10e307 1e309) => 0.0 and (/ 10e308 1e308) => inf
+;;; might be neat to handle these (if exps= just divide mant?
+
+(when with-bignums (test (nan? (/ 9223372036854775806 +inf.0 (bignum 1+i))) #f))
+
+(when with-bignums
+  (test (type-of (/ (bignum 1))) 'integer?)
+  (test (type-of (/ (bignum 0))) 'error) ; division-by-zero
+  (test (type-of (/ (bignum 0.0))) 'error) ; division-by-zero
+  (test (type-of (/ (bignum -1))) 'integer?)
+  (test (type-of (/ (bignum 2))) 'rational?)
+  (test (type-of (/ (bignum 1/2))) 'integer?)
+  (test (type-of (/ 1 (bignum 1))) 'integer?)
+  (test (type-of (/ 1 (bignum 1/2))) 'integer?)
+  (test (type-of (/ (bignum 1) 1)) 'integer?))
+(test (type-of (/ 1)) 'integer?)
+(test (type-of (/ 0)) 'error)
+(test (type-of (/ -1)) 'integer?)
+(test (type-of (/ 1/2)) 'integer?)
+
+(num-test (/ -0.651381628953465E0 -0.9237050214744277E0) 7.051835962889135018948026610294923703508E-1)
+(num-test (/ 0.5067986732438687E0 0.6260017267692811E0) 8.095803119575965307784422745290898299591E-1)
+(num-test (/ -0.8399445051045212E0 0.1829250718359493E0) -4.591740742120902283769244624290448381427E0)
+(num-test (/ -0.5987041550692662E0 -0.4124053212463479E0) 1.451737221187875469260813375116670894624E0)
+(num-test (/ 0.5861382519823647E0 -0.7560374696447822E0) -7.752767230673855251634630463492900473644E-1)
+(num-test (/ -0.012882644582824954E0 -0.4671067448591679E0) 2.757965866390787237919533761751626109973E-2)
+(num-test (/ -0.7830198970435231E0 2.1690164135025935E9) -3.610022921767930828778117437420472499541E-10)
+(num-test (/ -0.2339206226652567E0 2.729373380002701E9) -8.570488170622710029144125942503181451939E-11)
+(num-test (/ -0.2285806315782951E0 -2.602073870582813E9) 8.784555817667757706754728345837912936962E-11)
+(num-test (/ -0.5298716781559242E0 1.3509547453340487E9) -3.922201539215168658138266422439019362809E-10)
+(num-test (/ 0.7287190523338418E0 -8.244205871151566E9) -8.839166121309546680006433484161854320415E-11)
+(num-test (/ 0.18973054487786212E0 6.557593452200545E9) 2.893295326415727180554709812740977209383E-11)
+(num-test (/ 0.5084032300982587E0 4.5431682148621014E-11) 1.119049980221104893780059617560389832312E10)
+(num-test (/ 0.6621212705475221E0 -1.838873437953206E-11) -3.6006897314505184969089186237646638616E10)
+(num-test (/ -0.4041791750277005E0 7.707875701307648E-11) -5.243716825365141031107302892929967408104E9)
+(num-test (/ -0.09569063343466655E0 4.789751448902253E-11) -1.9978204392338054187984205729651608099E9)
+(num-test (/ -0.6471008513340974E0 1.890250884404079E-11) -3.423359600956370337454713673029890117878E10)
+(num-test (/ -0.4301276572683971E0 9.134844738134672E-11) -4.708647706651977799170970961042517830565E9)
+(num-test (/ -0.5061027989171409E0 4.246468515299164E19) -1.191820443490291421327933820140392588455E-20)
+(num-test (/ -0.9601783702217944E0 7.495754288877955E19) -1.280962973461506313537075112900039769719E-20)
+(num-test (/ -0.6477754868655262E0 -8.507334914535449E19) 7.614317449272520944989386124046318248581E-21)
+(num-test (/ 0.1934462826116784E0 3.6173521417193476E19) 5.347731573618163299262146929108634114511E-21)
+(num-test (/ -0.7794308505212441E0 4.172217291786081E19) -1.868145391314406352823434511710862322776E-20)
+(num-test (/ -0.8462346361305484E0 7.378170819620111E19) -1.146943675904374803577079154661818066039E-20)
+(num-test (/ 0.9783005897625496E0 6.175045007596078E-21) 1.584280905740958108982369263614665552851E20)
+(num-test (/ -0.9700832605850568E0 -1.7695051741124812E-21) 5.4822290139480091183029856440319954731E20)
+(num-test (/ 0.07062591404368701E0 -8.855398515753737E-21) -7.975464223100026969579387130724758972895E18)
+(num-test (/ 0.4751383409805402E0 -8.1371029771106E-21) -5.839158510308749293926976970601471638106E19)
+(num-test (/ -0.5103510786836052E0 8.302178001281015E-21) -6.147195092719750272554937885528717433502E19)
+(num-test (/ 0.7148807879199733E0 4.338856119331781E-21) 1.647625015115898182854639201045676562387E20)
+(num-test (/ 4.180670608983218E9 -0.8621420131862095E0) -4.849167010818503318377538718886882159085E9)
+(num-test (/ 3.202209376555907E9 0.008113117870009012E0) 3.946952858152361317410218375892707092144E11)
+(num-test (/ 7.767843042272955E9 -0.04145956871894663E0) -1.87359475322354819500790198613468533242E11)
+(num-test (/ 1.1937839884817846E9 0.45557753834605563E0) 2.620374992181877679062077123717269598672E9)
+(num-test (/ -2.4205138097471213E9 -0.3737757916008485E0) 6.475844247109412171348144805246962117951E9)
+(num-test (/ -7.534066568550288E9 -0.3609372553147958E0) 2.087361849632108651836399241353567759856E10)
+(num-test (/ 6.098867840095913E9 3.0464612528039427E9) 2.001951554277132357084991750811780094278E0)
+(num-test (/ 4.956687716396978E9 7.035407926465974E9) 7.045345157244949942198957065331702603612E-1)
+(num-test (/ 6.969049109639194E9 -8.115758334653503E9) -8.587058438990264159516222429259889060394E-1)
+(num-test (/ -8.0699835500126705E9 -1.1896420666819375E9) 6.783539163608157717597859343396495021042E0)
+(num-test (/ -2.229793060172571E9 -2.658809828346301E9) 8.386433043838395143199282594014446842336E-1)
+(num-test (/ 3.0672739776038485E9 -7.988270854370873E9) -3.839722054398737311833139439634292109412E-1)
+(num-test (/ 2.477055391151669E9 -1.3522358047779648E-11) -1.831822070085178675709536653203693354871E20)
+(num-test (/ 1.1318646612469008E9 -8.457695758685169E-11) -1.338265992938554414702828284241585726631E19)
+(num-test (/ -7.978772126259147E9 6.210468872769038E-11) -1.284729428601367805018001112036580297153E20)
+(num-test (/ -9.057338243339752E9 7.364415429198257E-11) -1.22987877726580108212627205863468836645E20)
+(num-test (/ -5.341117220720213E9 4.7359651161519756E-11) -1.127777990277920421924982539741683693507E20)
+(num-test (/ 5.838003830912871E9 -5.0625478501901024E-11) -1.153175042225753978331600642680269130096E20)
+(num-test (/ 6.407156672927742E9 5.006339136594536E19) 1.279808758079079048751288572047629634958E-10)
+(num-test (/ 4.687485139826675E8 -3.5561755068968083E19) -1.318125365504547538826162177354689732851E-11)
+(num-test (/ -5.838044723576891E9 -6.843985743599882E19) 8.530182473036721969937888742798001972008E-11)
+(num-test (/ 3.9279221543350096E9 -5.882918042982924E19) -6.676826237652909876656284584084555589571E-11)
+(num-test (/ -9.686323716926361E9 -3.44800215666902E19) 2.809256861452760638746791455737599480861E-10)
+(num-test (/ 7.301304808910639E9 1.2845297359643038E19) 5.684029419085037872687787191413868358377E-10)
+(num-test (/ 4.380345662298534E9 -4.352751895415198E-21) -1.006339384266859136854551985691861659542E30)
+(num-test (/ 8.239490918139045E9 3.2397577733346748E-21) 2.543242888698483402490821850315555889368E30)
+(num-test (/ 3.8980499504872713E9 8.311650110069505E-21) 4.689862901910189296816144765858628505003E29)
+(num-test (/ -9.425472285331268E9 -3.294031046828316E-21) 2.861379310436876111669825630018089608938E30)
+(num-test (/ 2.517833161624173E9 3.6891560299469316E-21) 6.824957093669990747641669780362243770063E29)
+(num-test (/ -5.463519676339016E9 -7.298583081866205E-22) 7.485726496576409428699223883071063828111E30)
+(num-test (/ 1.39357009199772E-11 0.417842407627649E0) 3.335157146709649079791043787228216537723E-11)
+(num-test (/ 8.58494900746665E-11 -0.6481371063028898E0) -1.324557554872456302657963676252150750478E-10)
+(num-test (/ -9.310282234439046E-11 0.9146343299129254E0) -1.017923986663107128254299604028521252096E-10)
+(num-test (/ -8.800556770159418E-11 -0.9305573406536135E0) 9.457296596014170681132977631993414317205E-11)
+(num-test (/ -1.3361456473382827E-11 0.06420301636905124E0) -2.081125970247038707404762086321230923761E-10)
+(num-test (/ 6.1406425153971765E-12 -0.3082496074575478E0) -1.992100676476244033296635444865296145538E-11)
+(num-test (/ -3.6962256202372035E-11 3.089420488573177E9) -1.196413901541863127466123235969256148157E-20)
+(num-test (/ -6.145126590884831E-11 -6.225608984106817E9) 9.870723661849873241350389006374300024184E-21)
+(num-test (/ 9.052281678541901E-11 -6.9187138778508625E9) -1.308376359878287335554324548627653637652E-20)
+(num-test (/ -3.4950245360118636E-11 7.543342567738434E9) -4.633257080169574405642456881139071687897E-21)
+(num-test (/ -3.482822570743636E-11 -3.87599225187502E9) 8.985628309909063146939690605121402184145E-21)
+(num-test (/ -9.42226868788213E-11 7.501937454180854E9) -1.25597803839741017709728590003874245271E-20)
+(num-test (/ -4.8165035309367155E-11 9.484620130429997E-11) -5.078225026096383416618039442767276425835E-1)
+(num-test (/ 6.880022773725747E-11 -9.699156104509544E-11) -7.093424107822057000929770558471489984227E-1)
+(num-test (/ 1.5817962388036865E-11 -7.11651152335492E-11) -2.222712959309569253469449863287830842251E-1)
+(num-test (/ -7.0140750853949335E-12 -4.4677941652531186E-11) 1.569919030725435801904141818366904619636E-1)
+(num-test (/ -2.6947489262085355E-11 8.365454450205894E-11) -3.221282169723859093984652053864584015511E-1)
+(num-test (/ 8.703167674410303E-11 -4.88739813223768E-11) -1.780736383435491638475146912252252561499E0)
+(num-test (/ 1.165112061543483E-12 -5.899528740399518E19) -1.974923952086012268924127751659019857389E-32)
+(num-test (/ 7.126386981630328E-12 5.091741402945837E19) 1.399597194293359595983101664952569614126E-31)
+(num-test (/ -7.132349854872655E-13 7.70347159367981E19) -9.258617712985762871283798832641751905855E-33)
+(num-test (/ 4.507266517270466E-11 -1.6192737232544485E19) -2.78351118315665136913517665604742725923E-30)
+(num-test (/ -3.025128309814261E-11 -5.606736896306867E19) 5.395523930874836927233660478269495795871E-31)
+(num-test (/ -5.390258677516223E-11 6.628750121976767E18) -8.131636550373975963243412569165785520017E-30)
+(num-test (/ -8.484515181627938E-11 6.226893371743352E-21) -1.362559895457550846279271972989853630227E10)
+(num-test (/ 5.110456708789676E-11 -7.434814854731122E-21) -6.873683889434922905934754874417370413592E9)
+(num-test (/ -7.784815533665352E-11 -8.942884975553875E-21) 8.705038200698988300091363733020271337225E9)
+(num-test (/ 6.06871371776654E-11 -8.4720755768444E-21) -7.163195916657483482294943699821186479438E9)
+(num-test (/ 6.395725883763629E-11 3.2465500186809204E-21) 1.970006883295217146112013920243427167994E10)
+(num-test (/ 8.23766365482318E-11 3.5665958051648335E-21) 2.309671211661863324131996575306264215863E10)
+(num-test (/ -6.882125490660233E19 0.680553203393516E0) -1.011254587641810638505458546065261498221E20)
+(num-test (/ -8.955858402134752E19 0.11144092291315044E0) -8.036418012361891226885340978581557821805E20)
+(num-test (/ 4.517225460957592E19 -0.5804969398143229E0) -7.781652496570381006264991321295105224966E19)
+(num-test (/ -9.741926397385082E19 -0.9037000739789977E0) 1.078004381972805693752225428081454781542E20)
+(num-test (/ 9.654390326446178E19 -0.061963385089831124E0) -1.558079874501654704495847314268744072438E21)
+(num-test (/ 9.50855454738802E19 0.30375471599023185E0) 3.130339727036137864357134952530976170215E20)
+(num-test (/ 4.323538184184934E19 -2.6027608151521606E9) -1.661135421670382968923474255247239383096E10)
+(num-test (/ 4.0554081767557594E17 4.814123702784068E9) 8.423979995384136048633041200603888010585E7)
+(num-test (/ 5.12727309625028E19 1.761988796449604E9) 2.909935129316203535920673855950717437829E10)
+(num-test (/ -7.335661993746345E19 -4.961351435504E9) 1.478561252736806087045652086640747044774E10)
+(num-test (/ 3.7135994768593306E18 3.273427798269768E8) 1.134468118961482490398408895662653948827E10)
+(num-test (/ 1.3911083524706402E19 8.651242909451927E9) 1.607986698594236535694138981270724564992E9)
+(num-test (/ 6.473382688386894E19 -3.700509647679497E-11) -1.74932193257385527761113361595002688054E30)
+(num-test (/ 7.25328632809461E19 6.793518758100849E-11) 1.0676773828651782212117989476182162163E30)
+(num-test (/ 7.053090091571119E19 8.009021819073383E-11) 8.806431360661641824334823520600629499368E29)
+(num-test (/ -1.6322872380348074E19 1.234889420758779E-11) -1.32180842316378978004378947103470484747E30)
+(num-test (/ -7.716951191497702E19 -2.473367210466666E-11) 3.120018393888910452644610629695438606501E30)
+(num-test (/ -2.1174708383466066E19 -9.66632270128099E-11) 2.190565020207733610503619470750854251338E29)
+(num-test (/ 4.0902039392392786E18 -5.029423690873208E19) -8.132549951322828067822875337940065787516E-2)
+(num-test (/ 1.4562115759233494E17 4.2665150414889705E19) 3.413117173530803542079920263107168159861E-3)
+(num-test (/ -3.309692589578652E19 1.1329455009949342E19) -2.92131667999222745140457080629099499358E0)
+(num-test (/ 3.059130103268258E19 -7.719433592654628E19) -3.962894513632647141286488246687660445133E-1)
+(num-test (/ 5.622979366632147E19 -8.407251901594788E19) -6.688248945610292804540334084533940238665E-1)
+(num-test (/ -7.457587910839625E18 1.102755747735572E19) -6.762683328700153669243467171164281736437E-1)
+(num-test (/ 1.2026615920578564E19 -3.77964792582931E-21) -3.181940793583240608441984111790776956096E39)
+(num-test (/ -2.74643694419756E19 2.538907641816601E-22) -1.08173960287601117923133084738647095934E41)
+(num-test (/ 8.267361397156658E18 -4.986401395715489E-21) -1.657981526368955793956856573504468676464E39)
+(num-test (/ 9.876393891158812E19 -5.792612775193684E-22) -1.704998119925007613535922021885867984527E41)
+(num-test (/ 3.927461252713038E17 4.810589424292295E-21) 8.164199656866003466542429981600313024025E37)
+(num-test (/ 7.29943837795987E19 -4.8820727437034755E-21) -1.495151498382347474354240468822304376928E40)
+(num-test (/ -7.837850970911807E-21 0.41514160181315674E0) -1.887994587070894820872902637806483134671E-20)
+(num-test (/ 1.1499234744049124E-21 0.4643166529612681E0) 2.476593219457143961012942936990797968514E-21)
+(num-test (/ -1.094368243984769E-21 0.9008053219044149E0) -1.214877640455251662856715755193246361763E-21)
+(num-test (/ 2.4821206327531197E-21 0.22988631081892086E0) 1.079716588565493668307955174993650571244E-20)
+(num-test (/ -4.56226662576732E-22 0.6695285124602162E0) -6.814148375851898788485451948577541009839E-22)
+(num-test (/ 6.442796853653397E-21 -0.0419134640377401E0) -1.537166397855380228851954699451812058468E-19)
+(num-test (/ -5.584403218169678E-21 -8.092869169805251E9) 6.900399723506295845105466793248363429626E-31)
+(num-test (/ -9.796722996869492E-21 -3.2988270899833827E9) 2.969759471970033259328414098139420231204E-30)
+(num-test (/ 9.441829923771915E-22 5.464575083746736E9) 1.727825087783076315606418411938950517056E-31)
+(num-test (/ -6.419360319610147E-21 -7.333962810289677E9) 8.752921831841952013186922455457072581443E-31)
+(num-test (/ 7.973734412555454E-21 -9.367577614661436E9) -8.512055880994845185202464827966401354632E-31)
+(num-test (/ 8.105484193881594E-21 -8.664550975192905E9) -9.354765431108951260398341387461553707907E-31)
+(num-test (/ -5.3151708182942476E-21 -3.406928289732576E-11) 1.560106455516695805992469791379650741489E-10)
+(num-test (/ -7.026602845639829E-21 -9.92483846943868E-11) 7.079815824989676856562805642631867847741E-11)
+(num-test (/ -5.901970468193158E-21 2.074489043942647E-11) -2.845023686881582124910812196899705492945E-10)
+(num-test (/ -6.40466723844613E-21 -2.551008177490094E-11) 2.510641594550905909683475044031419810602E-10)
+(num-test (/ 8.056066940872177E-21 4.645883100460603E-11) 1.734022739417072488146823616965762354533E-10)
+(num-test (/ 7.453765056481805E-21 6.956136187014756E-11) 1.071538114851171096483487539186715128913E-10)
+(num-test (/ 7.357434693258832E-21 -7.093525088486332E19) -1.037204295675341715303117810431180096085E-40)
+(num-test (/ -3.3759558579798473E-21 9.991075630444324E19) -3.378971376908405498870850768959668870304E-41)
+(num-test (/ 6.908026973557955E-21 -4.20805893397862E19) -1.641618399822784611549409240045335916762E-40)
+(num-test (/ 5.181767322756247E-21 7.46986056263721E19) 6.936899664063931551045422017869651239957E-41)
+(num-test (/ -5.7217313601659264E-21 5.604979023134118E19) -1.020830111326005351069300302415295512527E-40)
+(num-test (/ -9.340193892824771E-21 9.147101848766205E19) -1.021109641857175884684740262364588092125E-40)
+(num-test (/ 8.331002176099931E-21 2.0276444314093977E-21) 4.108709617449606347005645831416724715479E0)
+(num-test (/ -3.747505523684784E-21 4.394623185543803E-21) -8.527478615259381231018127145394525879915E-1)
+(num-test (/ -3.310403953328861E-21 2.3420390876737627E-21) -1.413470838617356120752866783055539347411E0)
+(num-test (/ 6.23845405853013E-21 -8.933620117412232E-21) -6.983119918397872761237650028889120834928E-1)
+(num-test (/ -4.276770609150315E-21 6.853299965034864E-21) -6.240454424832049912604789277138688124888E-1)
+(num-test (/ -8.847946637724495E-21 6.33827952828724E-21) -1.395953996386055439061738621964402924048E0)
+
+(when with-bignums ; from futilitycloset I think
+  (let-temporarily (((*s7* 'bignum-precision) 2048))
+    (test (object->string (/ 1.0 999999999999999999999998999999999999999999999999)) "1.00000000000000000000000100000000000000000000000200000000000000000000000300000000000000000000000500000000000000000000000800000000000000000000001300000000000000000000002100000000000000000000003400000000000000000000005500000000000000000000008900000000000000000000014400000000000000000000023300000000000000000000037700000000000000000000061000000000000000000000098700000000000000000000159700000000000000000000258400000000000000000000418100000000000000000000676500000000000000000001094600000000000000000001771100000000000000000002865700000000000000000004636800000000000000000007502500000000000000000012139300000000000000001E-48")))
+
+(for-each
+ (lambda (num-and-val)
+   (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 '/ num (/ num) val)))
+ (vector (list 1 1) (list 2 1/2) (list 3 1/3) (list -1 -1) (list -2 -1/2) (list -3 -1/3) (list 9223372036854775807 1/9223372036854775807)
+	 (list 1/2 2) (list 1/3 3) (list -1/2 -2)
+	 (list -1/3 -3) (list 1/9223372036854775807 9223372036854775807) (list 1.0 1.0) (list 2.0 0.5)
+	 (list -2.0 -0.5) (list 1e+16 1e-16) (list +inf.0 0.0) (list -inf.0 0.0) (list 0+1i 0-1i)
+	 (list 0+2i 0-0.5i) (list 0-1i 0+1i) (list 1+1i 0.5-0.5i) (list 1-1i 0.5+0.5i) (list -1+1i -0.5-0.5i)
+	 (list -1-1i -0.5+0.5i) (list 0.1+0.1i 5-5i) (list 1e+16+1e+16i 5e-17-5e-17i) (list 1e-16+1e-16i 5e+15-5e+15i)
+	 ))
+
+(num-test (/ -8) -1/8)
+(num-test (/ 0 2/3) 0)
+(num-test (/ 1e-10 1e10) 1e-20)
+(num-test (/ 4 2) 2)
+(num-test (/ -9223372036854775808 -9223372036854775808) 1)
+(num-test (/ -9223372036854775808 9223372036854775807) -9223372036854775808/9223372036854775807)
+(num-test (/ most-positive-fixnum most-positive-fixnum) 1)
+(num-test (/ (/ 1 most-positive-fixnum)) most-positive-fixnum)
+(num-test (/ (/ -1 most-positive-fixnum)) (- most-positive-fixnum))
+(num-test (/ (/ most-positive-fixnum) 1) 1/9223372036854775807) ; why isn't this a ratio in the non-bignum case?
+
+(let () ; check g_divide_by_2 opt
+  (define (f1)
+    (let ((x (/ 1 6917529027641081856)))
+      (/ x 2)))
+  (if with-bignums
+     (test (f1) 1/13835058055282163712)
+     (test (f1) 7.228014483236696e-20))
+
+  (define (f2)
+    (let ((x (/ 2 6917529027641081856)))
+      (/ x 2)))
+  (test (f2) 1/6917529027641081856)
+
+  (define (f3)
+    (let*  ((y (/ (*s7* 'most-positive-fixnum) 2))
+	    (x (/ 1 y)))
+      (/ x 2)))
+  (test (f3) 1/9223372036854775807)
+
+  (define (f-1)
+    (let ((x (/ 1 -6917529027641081856)))
+      (/ x 2)))
+  (if with-bignums
+    (test (f-1) -1/13835058055282163712)
+    (test (f-1) -7.228014483236696e-20))
+
+  (define (f-2)
+    (let ((x (/ 2 -6917529027641081856)))
+      (/ x 2)))
+  (test (f-2) -1/6917529027641081856)
+
+  (define (f-3)
+    (let*  ((y (/ (+ (*s7* 'most-negative-fixnum) 1) 2))
+	    (x (/ 1 y)))
+      (/ x 2)))
+  (test (f-3) -1/9223372036854775807))
+
+(unless (or with-bignums (not (provided? 'overflow-checks)))
+  (num-test (/ -1024 1/9765625 1/512 1/1953125) -1e19)
+  (num-test (/ 1/19073486328125 -524288) -1e-19)
+  (num-test (/ 1/19073486328125 524288) 1e-19)
+  (num-test (/ 1/524288 -19073486328125) -1e-19)
+  (num-test (/ 1/524288 19073486328125) 1e-19)
+  (num-test (/ 1/9223372036854775807 1/3) 3.2526065174565e-19)
+  (num-test (/ 1/9223372036854775807 1/9223372036854775806) 1.0)
+  (num-test (/ 1/98947 2/97499 3/76847 4/61981 5/59981 6/66601) 2.6040239996689e+16)
+  (num-test (/ 1/98947 2/97499 3/76847 4/61981 5/59981) 2345932343059.9)
+  (num-test (/ 1/98947 2/97499 3/76847 4/61981) 464392992878593/2374728) ;195556288.07955 -- seems to fit
+  (num-test (/ 1024 1/9765625 1/512 1/1953125) 1e19)
+  (num-test (/ 500009/500029 500057/500041 500083/500069) 0.999900013909921)
+  (num-test (/ 98947 2/97499 76847 4/61981 5/59981) 11667778186668.0)
+  (num-test (/ 3037000500 1/3037000500) 9.22337203700025E18))
+
+(when with-bignums
+  (num-test (/ 1/9223372036854775807 1+1i 1-1i) 5.421010862427522170625011179760852311177E-20)
+  (num-test (/ (/ 1 most-positive-fixnum) most-negative-fixnum) -1/85070591730234615856620279821087277056)
+  (num-test (/ 1.0e308+1.0e308i 2.0e308+2.0e308i) (/ 1.0e307+1.0e307i 2.0e307+2.0e307i))
+  (num-test (/ (+ 1.2345e-15 1 -1)) 8.1004455245038e+14)
+  (num-test (/ -1.797693134862315699999999999999999999998E308 -9223372036854775808) 1.949062802279999590850112500817203908808E289)
+  (num-test (/ -1/19073486328125 524288) -1/10000000000000000000)
+  (num-test (/ -1/524288 19073486328125) -1/10000000000000000000)
+  (num-test (/ -1024 1/9765625 1/512 1/1953125) -10000000000000000000)
+  (num-test (/ -21 -1/2432902008176640000) 51090942171709440000)
+  (num-test (/ -21 1/2432902008176640000) -51090942171709440000)
+  (num-test (/ -2432902008176640000 -1/21) 51090942171709440000)
+  (num-test (/ -2432902008176640000 1/21) -51090942171709440000)
+  (num-test (/ -9223372036854775808 -9223372036854775808 -9223372036854775808) -1/9223372036854775808)
+  (num-test (/ -9223372036854775808 -9223372036854775808) 1)
+  (num-test (/ -9223372036854775808 9223372036854775807 -9223372036854775808) 1/9223372036854775807)
+  (num-test (/ 0+1e20i 0-1e20i) -1.0)
+  (num-test (/ 1 1000000000 1000000000 1000000000) 1/1000000000000000000000000000)
+  (num-test (/ 1.0e20+i 1.0e20+i) 1.0)
+  (num-test (/ 1/1024 9765625 -512 1953125) -1/10000000000000000000)
+  (num-test (/ 1/1024 9765625 512 1953125) 1/10000000000000000000)
+  (num-test (/ 1/19073486328125 524288) 1/10000000000000000000)
+  (num-test (/ 1/524288 19073486328125) 1/10000000000000000000)
+  (num-test (/ 1/9223372036854775807 1/3) 3/9223372036854775807)
+  (num-test (/ 1/9223372036854775807 1/9223372036854775806) 9223372036854775806/9223372036854775807)
+  (num-test (/ 1/98947 2/97499 3/76847 4/61981 5/59981 6/66601) 1855154611405774907304533/71241840)
+  (num-test (/ 1/98947 2/97499 3/76847 4/61981 5/59981) 27854756105850886733/11873640)
+  (num-test (/ 1024 1/9765625 1/512 1/1953125) 10000000000000000000)
+  (num-test (/ 132120577/12 33292289/6 260046847/4) 264241154/8657554783862783)
+  (num-test (/ 1e20 0+i) 0-1e20i)
+  (num-test (/ 21 -1/2432902008176640000) -51090942171709440000)
+  (num-test (/ 21 1/2432902008176640000) 51090942171709440000)
+  (num-test (/ 2432902008176640000 -1/21) -51090942171709440000)
+  (num-test (/ 2432902008176640000 1/21) 51090942171709440000)
+  (num-test (/ 500009/500029 500057/500041 500083/500069) 125029751909525461/125042254395637199)
+  (num-test (/ 9223372036854775807 -9223372036854775808) -9223372036854775807/9223372036854775808)
+  (num-test (/ 98947 2/97499 76847 4/61981 5/59981) 35865350012435458633/3073880)
+  (num-test (/ most-negative-fixnum) -1/9223372036854775808)
+  (num-test (/ 10105597264942543888 14352488138967388642) 5052798632471271944/7176244069483694321)
+  (num-test (/ -17631701977702695093 3931860028646338313) -17631701977702695093/3931860028646338313)
+  (num-test (/ -1606495881715082381 16324360910828438638) -1606495881715082381/16324360910828438638)
+  (num-test (/ -7960193178071300653 -10280747961248435844) 7960193178071300653/10280747961248435844)
+  (num-test (/ -11544909483975853384 -16041992360613233027) 11544909483975853384/16041992360613233027)
+  (num-test (/ -5758820541298901548 -2596462557714095861) 5758820541298901548/2596462557714095861)
+  (num-test (/ -13056342734667572546 46502284983183419157350605242474199851) -13056342734667572546/46502284983183419157350605242474199851)
+  (num-test (/ 12668118634717482325 -338544675918656078399121171905238525746) -12668118634717482325/338544675918656078399121171905238525746)
+  (num-test (/ -16738429327795346815 164053836541028518093058940786011794219) -16738429327795346815/164053836541028518093058940786011794219)
+  (num-test (/ -9884600460121235549 -53914696297933680001835530599748561584) 9884600460121235549/53914696297933680001835530599748561584)
+  (num-test (/ 6753521264659576004 71759828079371803409570464915096122874) 3376760632329788002/35879914039685901704785232457548061437)
+  (num-test (/ -6072478784520825268 83641961138289700975241455431547940418) -3036239392260412634/41820980569144850487620727715773970209)
+  (num-test (/ -6708950756971973620 -9847903810677323447803434015107261150885944735136350527205856921771320298384705376646797569973415403097847060539915279223391112430240736564839483430569706) 3354475378485986810/4923951905338661723901717007553630575442972367568175263602928460885660149192352688323398784986707701548923530269957639611695556215120368282419741715284853)
+  (num-test (/ 11263779860755455072 2292311486393743282743453705144070351222990311578446825826935237655927864700827857707370158936582804478427014131790879562565658386819339761919809732496450) 1877296643459242512/382051914398957213790575617524011725203831718596407804304489206275987977450137976284561693156097134079737835688631813260427609731136556626986634955416075)
+  (num-test (/ 9956488981426387585 -12351244248621474338537656633137999145154500022264356186225225426288301330225259889671144104952158102155582320296061124840400655528634050137479515338944145) -1991297796285277517/2470248849724294867707531326627599829030900004452871237245045085257660266045051977934228820990431620431116464059212224968080131105726810027495903067788829)
+  (num-test (/ -14875992781716065391 4906952781757522095285156014969507916562921709689447567404076064849249737893410245743456952512717420040816186768213920574809530298070437840356629617118643) -2125141825959437913/700993254536788870755022287852786845223274529955635366772010866407035676841915749391922421787531060005830883824030560082115647185438633977193804231016949)
+  (num-test (/ 16043178952268979636 -4962728781666935768923030490263743715131420507991284894489828489607808897271220927863958149140648859077934323268424257800724618076505149638049461104621679) -5347726317422993212/1654242927222311922974343496754581238377140169330428298163276163202602965757073642621319383046882953025978107756141419266908206025501716546016487034873893)
+  (num-test (/ -14889985628902581941 3075736124701105220602924325296812116294816310089906623707854625135862902005059305428034753787024827094954645083406870532379125275086885405969947540175361) -14889985628902581941/3075736124701105220602924325296812116294816310089906623707854625135862902005059305428034753787024827094954645083406870532379125275086885405969947540175361)
+  (num-test (/ -1719613957783789857 19860562547348050982501313785551054055826630539673708970554435103060535649825139319625648954889488501680865494719253019921780044205805557658109807483499994523398090829033362953135186523580359552555144614353929273831853529446536288544481045105104526669277307473478898498061888931858821517694257595658138564305517447595298378933983614114298000880741350618424855028965861930329619462261269994651112266861896630584883581092431090390354633458596611690990999635499563944625720180529318327647519405136188243979680965052005899543797270970540925042201315580510136864931200059448645464256385079735225156720340173280541113382758) -1719613957783789857/19860562547348050982501313785551054055826630539673708970554435103060535649825139319625648954889488501680865494719253019921780044205805557658109807483499994523398090829033362953135186523580359552555144614353929273831853529446536288544481045105104526669277307473478898498061888931858821517694257595658138564305517447595298378933983614114298000880741350618424855028965861930329619462261269994651112266861896630584883581092431090390354633458596611690990999635499563944625720180529318327647519405136188243979680965052005899543797270970540925042201315580510136864931200059448645464256385079735225156720340173280541113382758)
+  (num-test (/ -10969623867482498359 1292477254230352575769754773488799598312602810841892384475535212194939033905139960602724737178675944133847094464739764817257836826367652752931492512753561670732296265459534230949226553571982695924178928914002527460943582374603078611662312521259541641138419845784008028215876048965254023368247445173694441960256131358058174374542730502334351759171930973722361567186133851896057677818979314942434199157003833234473048838906103902832115569853657335216793235394595479328932380393044485884605451918890395812628720641212850763944658735838941829604119213195707479940053016354291972875689927240247563236506479099606571912595) -10969623867482498359/1292477254230352575769754773488799598312602810841892384475535212194939033905139960602724737178675944133847094464739764817257836826367652752931492512753561670732296265459534230949226553571982695924178928914002527460943582374603078611662312521259541641138419845784008028215876048965254023368247445173694441960256131358058174374542730502334351759171930973722361567186133851896057677818979314942434199157003833234473048838906103902832115569853657335216793235394595479328932380393044485884605451918890395812628720641212850763944658735838941829604119213195707479940053016354291972875689927240247563236506479099606571912595)
+  (num-test (/ -3716891004757979686 -19452372993227550502015765258932159656814363741878583541173956168837566077148160901999018823586675966076058615847408138956450751813058209394199427182041779436168298455103717521843644244801542056954603631432685194627158423459586845252167819811850263444712218938833443253125954475476481099092216538126519474183531297423759923656571895377587989169731023397615799830371852298135015608612181670362528239430952907458704415974164085176066242388561893721949244663406941558257051263727439679525692652639731850971185056484335828001005009903973037524233097329857690857731943951449292814500362180170793919266389501882641682782987) 3716891004757979686/19452372993227550502015765258932159656814363741878583541173956168837566077148160901999018823586675966076058615847408138956450751813058209394199427182041779436168298455103717521843644244801542056954603631432685194627158423459586845252167819811850263444712218938833443253125954475476481099092216538126519474183531297423759923656571895377587989169731023397615799830371852298135015608612181670362528239430952907458704415974164085176066242388561893721949244663406941558257051263727439679525692652639731850971185056484335828001005009903973037524233097329857690857731943951449292814500362180170793919266389501882641682782987)
+  (num-test (/ -4863232114852441787 -22963038454503597269981750990033903654256693514059439027985256604978917966584414065892146187253799108250061573972673983350956191446047978392921074610323648301008272837432907303975548030552369880338022067315042332692023645592417869181836251486577977896077712912433381480614752789750181208326525834629219729662085632321271870762094800588296544243340047360684854239747242066367921596241226349790282723168222543448385227922748241223520686047460119733024390425165073367321644498280127168757335614077882325524816799960018589278475564547840614315473357481582710826551932681173443524724802157570101916268510464302946527662720) 4863232114852441787/22963038454503597269981750990033903654256693514059439027985256604978917966584414065892146187253799108250061573972673983350956191446047978392921074610323648301008272837432907303975548030552369880338022067315042332692023645592417869181836251486577977896077712912433381480614752789750181208326525834629219729662085632321271870762094800588296544243340047360684854239747242066367921596241226349790282723168222543448385227922748241223520686047460119733024390425165073367321644498280127168757335614077882325524816799960018589278475564547840614315473357481582710826551932681173443524724802157570101916268510464302946527662720)
+  (num-test (/ -16248276650501285553 -3381199474840825715485713565301777938368574604710714363907009216856320913536015299178065264912798511857598595067318796576494480424838898250138649774858742984769125731728430552285782315111538920026330816414650913188340281906359149109963139438960274321560117812365241840204034925444652058916966934904097509799291744775242863360284348334605170437300543978049053839829106628489146216325576991696936733592366926096500684308845306493636196092408597450926695579897293944488261001228478152650490677071497874746121221519036861983646423005753475340900508665494162949119110128646472783016552527735050067363030838015919512260159) 16248276650501285553/3381199474840825715485713565301777938368574604710714363907009216856320913536015299178065264912798511857598595067318796576494480424838898250138649774858742984769125731728430552285782315111538920026330816414650913188340281906359149109963139438960274321560117812365241840204034925444652058916966934904097509799291744775242863360284348334605170437300543978049053839829106628489146216325576991696936733592366926096500684308845306493636196092408597450926695579897293944488261001228478152650490677071497874746121221519036861983646423005753475340900508665494162949119110128646472783016552527735050067363030838015919512260159)
+  (num-test (/ 18296946401228630959 3302341071702763311560113831030141639804425031433511503765833897787925467295486187687396312611805794369889470239777040624530990622212474466940548049117664906468330871893337410618797113677420975837622378808494314918471282099855916016026079371666730617071364751834080179173620476977670099126230223862266413091012344741482772771219725893630556702028108027870656512750807359335108428687238687397060104669074315031780019301768744978815422943986587389425726602444937024004102212071953113581935989741954695450085391443134273670514145585869912689150728183940456773133212037846765421397201956541430155664614978559762638030787) 494512064898071107/89252461397371981393516590027841665940660135984689500101779294534808796413391518586145846286805562009997012709183163260122459206005742553160555352678855808282927861402522632719426949018308675022638442670499846349147872489185295027460164307342344070731658506806326491329016769648045137814222438482763957110567901209229264128951884483611636667622381298050558284128400198900948876451006451010731354180245251757615676197345101215643660079567205064579073691957971270919029789515458192258971242965998775552705010579544169558662544475293781424031100761728120453327924649671534200578302755582200815017962566988101692919751)
+  (num-test (/ -60488682170925814337492051725122486652 14880088785789146426) -30244341085462907168746025862561243326/7440044392894573213)
+  (num-test (/ 126617729996196635247771282957911941277 -7166506344996883172) -126617729996196635247771282957911941277/7166506344996883172)
+  (num-test (/ -278675896803726074870988122161067771390 7744689831802931490) -27867589680372607487098812216106777139/774468983180293149)
+  (num-test (/ -283351838662873779255871649630248958879 6912311315831153835) -14913254666467041013466928927907839941/363805858727955465)
+  (num-test (/ -9715584046609700027352634666499181378 3368831995960494221) -9715584046609700027352634666499181378/3368831995960494221)
+  (num-test (/ -137493547985106345282009151869389470397 -1916381539906956855) 137493547985106345282009151869389470397/1916381539906956855)
+  (num-test (/ -328662747577960331872949773416436800743 -231069430804205460334599495337085157308) 328662747577960331872949773416436800743/231069430804205460334599495337085157308)
+  (num-test (/ 213595640581249636406536485951630735277 -48492294677143227478357598229530842959) -213595640581249636406536485951630735277/48492294677143227478357598229530842959)
+  (num-test (/ 85922846498729014445816145204889624189 193533957681757355413031965695625196813) 85922846498729014445816145204889624189/193533957681757355413031965695625196813)
+  (num-test (/ 24053342958857142686054803491202486471 196417511107100936775397820630955772553) 24053342958857142686054803491202486471/196417511107100936775397820630955772553)
+  (num-test (/ 102038936612518756467074084117019701214 -111946989731587760700903475996379168167) -102038936612518756467074084117019701214/111946989731587760700903475996379168167)
+  (num-test (/ -3006867214208872584699983438179656913 -234257597822744479264249663225224173340) 3006867214208872584699983438179656913/234257597822744479264249663225224173340)
+  (num-test (/ -279839802710533516603863620922251878907 -3244112647743502769852782626803305310331045534071805654982307107362388474314396636799597033636575215617240554815450017779373048313695795886893032630263219) 279839802710533516603863620922251878907/3244112647743502769852782626803305310331045534071805654982307107362388474314396636799597033636575215617240554815450017779373048313695795886893032630263219)
+  (num-test (/ 123635964546481689465778244982425098404 7701433613491146708866098469269971554817017737111287276993583150548359764165526640986060909954451793171933304569726872785964805121981749276421956645830854) 61817982273240844732889122491212549202/3850716806745573354433049234634985777408508868555643638496791575274179882082763320493030454977225896585966652284863436392982402560990874638210978322915427)
+  (num-test (/ 166158110049010486343321316578688184578 4093720847216792748840371965199135052196058344862447621818024731938681519017878880275303125899149558774718190527651555811733139227128378041055212888819294) 83079055024505243171660658289344092289/2046860423608396374420185982599567526098029172431223810909012365969340759508939440137651562949574779387359095263825777905866569613564189020527606444409647)
+  (num-test (/ 147416259636838312272435267341375281181 -11266711292262839805944890501811605204323255169233519804446548849178247889563130015168799346120099052214488209897402054530713234143622703174309015777885801) -147416259636838312272435267341375281181/11266711292262839805944890501811605204323255169233519804446548849178247889563130015168799346120099052214488209897402054530713234143622703174309015777885801)
+  (num-test (/ 102557200511608632541115941654031896919 3866177549962722728707550488877109233779215384377007088712280650225992470307822792085413087509167847767889824884877044539352696974351192629898363157976511) 102557200511608632541115941654031896919/3866177549962722728707550488877109233779215384377007088712280650225992470307822792085413087509167847767889824884877044539352696974351192629898363157976511)
+  (num-test (/ 47794953079190110032282671989549362415 3802290983508829335098916118339496411537222492645529399519373082799614656011270200284796148989094312601047370399228868583158444769807910513767845541589667) 47794953079190110032282671989549362415/3802290983508829335098916118339496411537222492645529399519373082799614656011270200284796148989094312601047370399228868583158444769807910513767845541589667)
+  (num-test (/ -169956065319483471022234920202991103615 -9934427489865644196610501807375648335352544234206717324511161205173460054921759084767897792996557220898467288533128078406604709773449948420404563411793533441010236017064154469575084055359823982786110746700747423674942932421964955746280671982635899487781780756099620799397239156211815110739544719746684712086075069101799537802834839550142629064374734870047412916259754010150500874430055034366305216104752636211802195447299210332237598443674867760860326529472901775427058078447963316168327741049511844237329137194533000697525539835371015163158135757326482343130221118201740819963770851200676279882978581431999960842565) 33991213063896694204446984040598220723/1986885497973128839322100361475129667070508846841343464902232241034692010984351816953579558599311444179693457706625615681320941954689989684080912682358706688202047203412830893915016811071964796557222149340149484734988586484392991149256134396527179897556356151219924159879447831242363022147908943949336942417215013820359907560566967910028525812874946974009482583251950802030100174886011006873261043220950527242360439089459842066447519688734973552172065305894580355085411615689592663233665548209902368847465827438906600139505107967074203032631627151465296468626044223640348163992754170240135255976595716286399992168513)
+  (num-test (/ -83006311763073652927964071041666508273 13480787677843057038436344704360462056114592749322481662307876594244244638227291805757775026215166740035048814729231681821563443093991755779505400592913963236010573873554317250153995160235771659208137440518282824497744092608999871327127239673370293239927529076145825972430101380272357235582367639159280348164804218713823424182167974242317526959809443701996053548231667727254858428867000011055354779789221097183515832386890638024105232865079002765479933320220378271026425568216748186200736499581088153390350474814123049637951929317200314355414551809067125550551841102097159644340520444983020267926123546444838010089690) -83006311763073652927964071041666508273/13480787677843057038436344704360462056114592749322481662307876594244244638227291805757775026215166740035048814729231681821563443093991755779505400592913963236010573873554317250153995160235771659208137440518282824497744092608999871327127239673370293239927529076145825972430101380272357235582367639159280348164804218713823424182167974242317526959809443701996053548231667727254858428867000011055354779789221097183515832386890638024105232865079002765479933320220378271026425568216748186200736499581088153390350474814123049637951929317200314355414551809067125550551841102097159644340520444983020267926123546444838010089690)
+  (num-test (/ -312626207169475064151212222217866488926 6989069923898656093413456232544365450599471748502878018530391549015151484336014906416216966193568842618920902504390187814247729346977677905224098932673981665869061845335443588666641982676550205160521286690015544764015602751932938178737949961754714143180917985455875095030469699198116593730005119922928175789172042067281849364217595912265452199938281052984802042194034638773435768458457616208103331213440768472281882976004050012769415198321241810008696147179275528426468408383757692656341606162350211696837361434874035354680073309142183699892959618671515841112321607728427286289324836870027735590091451421689980776552) -52104367861579177358535370369644414821/1164844987316442682235576038757394241766578624750479669755065258169191914056002484402702827698928140436486817084065031302374621557829612984204016488778996944311510307555907264777773663779425034193420214448335924127335933791988823029789658326959119023863486330909312515838411616533019432288334186653821362631528673677880308227369599318710908699989713508830800340365672439795572628076409602701350555202240128078713647162667341668794902533053540301668116024529879254737744734730626282109390267693725035282806226905812339225780012218190363949982159936445252640185386934621404547714887472811671289265015241903614996796092)
+  (num-test (/ -151709660794612786408772973806200383563 -26960472721919005254400858042130056790831511338891584787669209989714807518625849812230185079206081782191501696661436514815190623849929065098497737155759771863508038766934134444191240792356114381746781342181881402424707118515655119761011977116554236461222788625158348668147995099157685699761135150772589445239536582228655532345059046596356954495360132444243748421428095867292294626357084961338288369883088525401649234025290736504802104065029036642533076183281468647642956623788270236516849523210698622687255735945678505925047193818483603361307498423724202227256505312543145618362906047473400380196192622607541097732443) 151709660794612786408772973806200383563/26960472721919005254400858042130056790831511338891584787669209989714807518625849812230185079206081782191501696661436514815190623849929065098497737155759771863508038766934134444191240792356114381746781342181881402424707118515655119761011977116554236461222788625158348668147995099157685699761135150772589445239536582228655532345059046596356954495360132444243748421428095867292294626357084961338288369883088525401649234025290736504802104065029036642533076183281468647642956623788270236516849523210698622687255735945678505925047193818483603361307498423724202227256505312543145618362906047473400380196192622607541097732443)
+  (num-test (/ 138834496986391136939574372853300933725 -8052690543272184576133758511645801940246473546142520821850130421981395129853341888352999304040698251945886555605291324954368612109314080471658982022831338507499254609048475429862437003158379101603576571787302167207044118847876475134352180874260998595377014195145760071923429129767580115085764485254455919915567128572731355497418831212259648020550107573824886521471697331410754043280744066090848295906051303624846301488010249980896364883452154860562864255354208802313850527991005497484253401461375477060954782095047043919500670383372218536999834862885439984085848342867301834247551832677237328664699302165347765799113) -15426055220710126326619374761477881525/894743393696909397348195390182866882249608171793613424650014491331266125539260209816999922671188694660654061733921258328263179123257120052406553558092370945277694956560941714429159667017597677955952952420811351911893790983097386126039131208251222066153001577238417785769269903307508901676196053917161768879507458730303483944157647912473294224505567508202765169052410814601194893697860451787872032878450144847205144609778916664544040542605794984506984917261578755812650058665667277498250377940152830784550531343894115991055630042596913170777759429209493331565094260318589092694172425853026369851633255796149751755457)
+  (num-test (/ 276499207940187081393841843387608369874 27347897028734618663428054896349668572244941195143856840032842195489553215406302254043947382368793914074147314353589439281000471813879502242851166670252197853998033813694814376228360691543987661407996785043637351295817024680721181205269262470473172181965930243852520386958529041036476807810647578694133804796395977642274699322030062940721165202488695975750512485574440928370802874677938542169620505668128224812441566912043326338714451629730522324228356364241376445033028898865300103247057378058702233150414643818049655628999871012383236520330575609745427181485617250755214922048672375947942288446974485524776744246517) 8919329288393131657865865915729302254/882190226733374795594453383753215115233707780488511510968801361144824297271171040453030560721573997228198300463019014170354853929479983943317779570008135414645097864957897237942850344888515731013161186614310882299865065312281328425976427821628166844579546136898468399579307388420531509929375728344972058219238579923944345139420324610991005329112538579862919757599175513818412995957352856199020016311875104026207792481033655688345627471926791042717043753685205691775258996737590325911195399292216201069368214316711279213838705516528491500655825019669207328435019911314684352324150721804772331885386273726605701427307)
+  (num-test (/ -8979365591106781219797187096315899769868799444656824967426553299158070014074001230883484015880186603742048949313393413640240595706939311540002219411120389 -1698360947072008877) 1282766513015254459971026728045128538552685634950974995346650471308295716296285890126212002268598086248864135616199059091462942243848473077143174201588627/242622992438858411)
+  (num-test (/ -12831814656788829919185319784994714617782749504716966706877579983082880759985031662545957372565411439648298939198657738497464024214657609856476819270030801 454910754379715) -273017333123166594025219569893504566335803180951424823550586808150699590637979397075445901543944924247836147642524632733988596259886332124605889771702783/9678952220845)
+  (num-test (/ -7834266257250691217409788323211914445703052638619784568844628449769010091330019095736167988675873769434766592786720961949649685040028101508217441360672222 -428418418877192732) 3917133128625345608704894161605957222851526319309892284422314224884505045665009547868083994337936884717383296393360480974824842520014050754108720680336111/214209209438596366)
+  (num-test (/ 5737805823029931079838944835405107564434908634489801628049345331760087020955028323378020396677249341204498685189403657652738071833877470777083253103936452 9588993061977446661) 5737805823029931079838944835405107564434908634489801628049345331760087020955028323378020396677249341204498685189403657652738071833877470777083253103936452/9588993061977446661)
+  (num-test (/ -4001605821592542867351046644170905984672346731784670159062281252096012802838642896466582343641124674682428297533953704119505640938363392225910275838094045 15760991890495426717) -4001605821592542867351046644170905984672346731784670159062281252096012802838642896466582343641124674682428297533953704119505640938363392225910275838094045/15760991890495426717)
+  (num-test (/ 2876630161532936743269451364955814480771395635620140205538288339793482694260173239474830738010159518887660000673207712630507802368373928478641773477534499 -6788234478844960330) -2876630161532936743269451364955814480771395635620140205538288339793482694260173239474830738010159518887660000673207712630507802368373928478641773477534499/6788234478844960330)
+  (num-test (/ 6230070442453337264527950102774203962152836811174649694700041895216739851602598854067104967963392074425258687296947909484969927078206601660837276754799333 190237375887614033974333796608341639595) 6230070442453337264527950102774203962152836811174649694700041895216739851602598854067104967963392074425258687296947909484969927078206601660837276754799333/190237375887614033974333796608341639595)
+  (num-test (/ -12098771374444180013224380531550204930654718468097503123335711776524055419889032578894177605164827523969169377266342179411916625188550162928371789854647472 -41681385674896602840749705069663453185) 12098771374444180013224380531550204930654718468097503123335711776524055419889032578894177605164827523969169377266342179411916625188550162928371789854647472/41681385674896602840749705069663453185)
+  (num-test (/ 13185465843955116174925558412278612918939024395488172088108029202384613698982949554556435640011161663974075894844304583900497170806796813871943782330552768 -155202352609947911537719051033334010254) -6592732921977558087462779206139306459469512197744086044054014601192306849491474777278217820005580831987037947422152291950248585403398406935971891165276384/77601176304973955768859525516667005127)
+  (num-test (/ 12784980722915659825738808684740823452025110516624579136271791852138148426775553817114893299569867520414470532361018804123866264934222335562072872489963044 -249441012384365373362771955533424187237) -12784980722915659825738808684740823452025110516624579136271791852138148426775553817114893299569867520414470532361018804123866264934222335562072872489963044/249441012384365373362771955533424187237)
+  (num-test (/ 8517839393030302736298983538193047531846908718502576675615969705563208303329257882565359266876007571790337440612227785062203468682754778416335180236967433 -23101645464137481399279134347982485126) -8517839393030302736298983538193047531846908718502576675615969705563208303329257882565359266876007571790337440612227785062203468682754778416335180236967433/23101645464137481399279134347982485126)
+  (num-test (/ -10157767522292361462005308817460390811646115952647174687477824271227382383351453540195549992670001314693794150879368708343715654899952822395459036505947192 -25611473771508763579433379623726126173) 10157767522292361462005308817460390811646115952647174687477824271227382383351453540195549992670001314693794150879368708343715654899952822395459036505947192/25611473771508763579433379623726126173)
+  (num-test (/ -8580252632668820290302987230726290672170301642399871646484841866604753910447257372311950907045477729554307803379310475132687855999835211879267570997069974 5347050029330174629945013741349819215851040371727058829687387719215168997632386672310746837193930669173408831178932364105722911104309540550576485594530627) -8580252632668820290302987230726290672170301642399871646484841866604753910447257372311950907045477729554307803379310475132687855999835211879267570997069974/5347050029330174629945013741349819215851040371727058829687387719215168997632386672310746837193930669173408831178932364105722911104309540550576485594530627)
+  (num-test (/ 7706102251141221799524762336156378964168657337573751909064577951085535246905735244239132983582998872001001594454632956803416956154262109939446710205558308 6334400709835247308796432875490978646658012545184955441452799118298109610816693049400832749087993843490999852355789914065232784070007399786089389453289854) 3853051125570610899762381168078189482084328668786875954532288975542767623452867622119566491791499436000500797227316478401708478077131054969723355102779154/3167200354917623654398216437745489323329006272592477720726399559149054805408346524700416374543996921745499926177894957032616392035003699893044694726644927)
+  (num-test (/ 12609622044672092190084693450911157599596799695538449568681964257744962273690941575572590166273187189250007688411096790312605666562908125521094386992971478 -8237858212652788898158635047388584411011830102060269605835391741772914864422465141467281143809161251942948659243584296367296559912373856433388249393853968) -6304811022336046095042346725455578799798399847769224784340982128872481136845470787786295083136593594625003844205548395156302833281454062760547193496485739/4118929106326394449079317523694292205505915051030134802917695870886457432211232570733640571904580625971474329621792148183648279956186928216694124696926984)
+  (num-test (/ -9988492519236282081446302885464711911055350309732728352574982611126604133339499170845224383282665522673248920309221355720665956477799939031063172954469785 -1878204914631111607000020160429571305542722711529281855381736226230242796648854769713662269068364131804626863789957256573308715572826753755672493154125086) 9988492519236282081446302885464711911055350309732728352574982611126604133339499170845224383282665522673248920309221355720665956477799939031063172954469785/1878204914631111607000020160429571305542722711529281855381736226230242796648854769713662269068364131804626863789957256573308715572826753755672493154125086)
+  (num-test (/ -10729942326579120947061030583094707809945059776287551713953926998992375520903658867971835616518813070294302895655369081976222497359056962112544408591462495 -4917625712783289245414023733273041940212797202855299465496072729329693853584860839801663152618595377553772371725021213143455497822882736730281253858119747) 10729942326579120947061030583094707809945059776287551713953926998992375520903658867971835616518813070294302895655369081976222497359056962112544408591462495/4917625712783289245414023733273041940212797202855299465496072729329693853584860839801663152618595377553772371725021213143455497822882736730281253858119747)
+  (num-test (/ 8114113595157517238445304590338354472776364877475201453112450680537221171989478096363668912966343706408770932684807802285529572133696646343108263717309148 5443953102973235688784499815692116502566847594605098596244123647428188581304528525010862185203718640610834003873728718183528722470626702382993497913086105) 8114113595157517238445304590338354472776364877475201453112450680537221171989478096363668912966343706408770932684807802285529572133696646343108263717309148/5443953102973235688784499815692116502566847594605098596244123647428188581304528525010862185203718640610834003873728718183528722470626702382993497913086105)
+  (num-test (/ -7125100205152691887479515774712530950031072786448635736036405923401522078562323494262148946679985384635556474075282302608446439950458673260234175964199684 -23871420315894180764743988478670341498770583257649869670486332228804693253344466615199983955886679924409910043885402198203427975742868174334723967563526738510726448815413356678504144193747696164586135745786501041060322480940451156015256191962506052700295351077719851275026974629635679531161390660244641370183176979934485671396035404817388717005746812037357500295693454623478902942336087760288091719793968445716246099043828787040340339906538864570506773535078524092440112404847904632624419421052178754041718790915772437556681684830937503838434712179830722395832238257078212535157309743054115702650740005055678387806081) 7125100205152691887479515774712530950031072786448635736036405923401522078562323494262148946679985384635556474075282302608446439950458673260234175964199684/23871420315894180764743988478670341498770583257649869670486332228804693253344466615199983955886679924409910043885402198203427975742868174334723967563526738510726448815413356678504144193747696164586135745786501041060322480940451156015256191962506052700295351077719851275026974629635679531161390660244641370183176979934485671396035404817388717005746812037357500295693454623478902942336087760288091719793968445716246099043828787040340339906538864570506773535078524092440112404847904632624419421052178754041718790915772437556681684830937503838434712179830722395832238257078212535157309743054115702650740005055678387806081)
+  (num-test (/ 4801495919363827077158204249631885157347198552733998896638174958434968555935827788499392382851493568264006507028024783408190862186734863708684652212703744 29234959990138609668202089052356468732793041824333219340488007351402997202222578434579705387840772390513345507274006495462445058795870182760749392281528881636623188890883479914921272700981309656920982410970774047916714087713562927554033500521877735827036675598267184309367127514966388636440710253467328441763131873309183205727440365838789320851968108312559316922678357314418486932673434031479515016224407618177089903730349114511598373251388750023508633761000320088841886505077453257141723747388913336375142897897501529451618927178835485127020789481918641637409265186365292847057986276062625965612268181771076051892980) 1200373979840956769289551062407971289336799638183499724159543739608742138983956947124848095712873392066001626757006195852047715546683715927171163053175936/7308739997534652417050522263089117183198260456083304835122001837850749300555644608644926346960193097628336376818501623865611264698967545690187348070382220409155797222720869978730318175245327414230245602742693511979178521928390731888508375130469433956759168899566796077341781878741597159110177563366832110440782968327295801431860091459697330212992027078139829230669589328604621733168358507869878754056101904544272475932587278627899593312847187505877158440250080022210471626269363314285430936847228334093785724474375382362904731794708871281755197370479660409352316296591323211764496569015656491403067045442769012973245)
+  (num-test (/ 10769619761532897875307527770350128978615798426116103116325434914975512103385205123955114305107607195469345895102375220593168903042839441996791318999499708 -7224105715967976893083374742254251507019823877014718307738328810406361200631626366722837314776666720638271529652546975342143108973422364041422652163016078890272393678677152791565494865444430757858556891645947268886646732022748338160528677218733159766121781240328812893374941548395710123982510227501927393735585082736583984561348450061452997663109932611188779299623613963995350679177776686423432406091192517292522853783968685873925548901506191291253596763183277703635837071862492572256145656312023955675669362656148946145528559574994353884313568526553663370513565393821926602014407548325293145102073923450066319746913) -10769619761532897875307527770350128978615798426116103116325434914975512103385205123955114305107607195469345895102375220593168903042839441996791318999499708/7224105715967976893083374742254251507019823877014718307738328810406361200631626366722837314776666720638271529652546975342143108973422364041422652163016078890272393678677152791565494865444430757858556891645947268886646732022748338160528677218733159766121781240328812893374941548395710123982510227501927393735585082736583984561348450061452997663109932611188779299623613963995350679177776686423432406091192517292522853783968685873925548901506191291253596763183277703635837071862492572256145656312023955675669362656148946145528559574994353884313568526553663370513565393821926602014407548325293145102073923450066319746913)
+  (num-test (/ 1505915608160301518246681692927442986955390537144107830770082927276722640395785957392652130911646706470337068266772174699405268120590454296080828168261019 31152879253507543898583880698200027990847289346701738353567402100527465991154555548630544962150902011282973749886327325250084401181379196961322399337408341296727915922288276602390334861175305055229766353672502691855637668618950047400571070157436221479289152631256433294884836727331457389922838951144187501751190662594278336543502171639899940796536926507796271202659224890656712231014450702948847764643603683153113663072089256293587951842007583210791100743318865647555912543508324790181772321217524164822106191538518498016236866957803105254555578252294418243701672226181762763332992886540089416888889135117147250495261) 1505915608160301518246681692927442986955390537144107830770082927276722640395785957392652130911646706470337068266772174699405268120590454296080828168261019/31152879253507543898583880698200027990847289346701738353567402100527465991154555548630544962150902011282973749886327325250084401181379196961322399337408341296727915922288276602390334861175305055229766353672502691855637668618950047400571070157436221479289152631256433294884836727331457389922838951144187501751190662594278336543502171639899940796536926507796271202659224890656712231014450702948847764643603683153113663072089256293587951842007583210791100743318865647555912543508324790181772321217524164822106191538518498016236866957803105254555578252294418243701672226181762763332992886540089416888889135117147250495261)
+  (num-test (/ -4912349668310730778272626761660101328812783790262451913449395750351147048676353891314609774894027305081515542385381430403698808605768281804457186380542764 6582102431028556562269167182029950958541569095123705594954788174046339660437206159173417583841743892857066740116322758515837624700881569925244230209567223461401193316695082415261197843574563450002486582967745135870782254839990479649574452750850133306720341823136645982650022199634379361313745598455049448887744206616434903460504591098363901961758069797933831934878649993183747273660007900662110776570580293994733189753806312784239743585453090900671308673380802381312083077891736513388250097195232616017027333586286786139736783210630705878401429301217589001317082952461701571026008195534878902572422952568763551674434) -2456174834155365389136313380830050664406391895131225956724697875175573524338176945657304887447013652540757771192690715201849404302884140902228593190271382/3291051215514278281134583591014975479270784547561852797477394087023169830218603079586708791920871946428533370058161379257918812350440784962622115104783611730700596658347541207630598921787281725001243291483872567935391127419995239824787226375425066653360170911568322991325011099817189680656872799227524724443872103308217451730252295549181950980879034898966915967439324996591873636830003950331055388285290146997366594876903156392119871792726545450335654336690401190656041538945868256694125048597616308008513666793143393069868391605315352939200714650608794500658541476230850785513004097767439451286211476284381775837217)
+  (num-test (/ -11503235648135220410087372678575470255397243144180272745183844970864347348074104828328211521698012119761674096067066173927209129755062269068090560678650614 -5548338218081690289723998288742945948643693817491921699797822887914665364835947234564530865119623677435878746610856459141463506776423054050179729345956931675338102809929977610828639446535095411122377961067651902947030310564736893080382424590568134091858634304377553326990788802662029347894499019277621467098333287442862683493159356014650672092060912274570436879076161496563079759704321556494898013269338428360856068237785049960484767969682269790642298701577934519452927652996671267126348627432295779183359417597868330923329974640383630473044712419371517153268338860560601603043892503067815822312755611206254762903436) 5751617824067610205043686339287735127698621572090136372591922485432173674037052414164105760849006059880837048033533086963604564877531134534045280339325307/2774169109040845144861999144371472974321846908745960849898911443957332682417973617282265432559811838717939373305428229570731753388211527025089864672978465837669051404964988805414319723267547705561188980533825951473515155282368446540191212295284067045929317152188776663495394401331014673947249509638810733549166643721431341746579678007325336046030456137285218439538080748281539879852160778247449006634669214180428034118892524980242383984841134895321149350788967259726463826498335633563174313716147889591679708798934165461664987320191815236522356209685758576634169430280300801521946251533907911156377805603127381451718)
+  (num-test (/ -22964048032108117904633365483799091488990853392670636861794813863757795874434768543212887316456319246155824842161717179767513360050328383696194174741889496306018655333450647372293193335577883672679165775070112770359697627614883420620410888137853011387271594559450892054491963940112235887802995117234918878648066362268919389271696465517050425727202664230530633207566444357393843669758809938086228366322548799235049875711702216182219182908217345405023677260470015666831191434586902791186444958476491096759363292487221288620810273243009200212776634572092195691654105986099646006756823055390654876878195583529521482548988 10644501761877612307) -22964048032108117904633365483799091488990853392670636861794813863757795874434768543212887316456319246155824842161717179767513360050328383696194174741889496306018655333450647372293193335577883672679165775070112770359697627614883420620410888137853011387271594559450892054491963940112235887802995117234918878648066362268919389271696465517050425727202664230530633207566444357393843669758809938086228366322548799235049875711702216182219182908217345405023677260470015666831191434586902791186444958476491096759363292487221288620810273243009200212776634572092195691654105986099646006756823055390654876878195583529521482548988/10644501761877612307)
+  (num-test (/ -19058897134776675884737764093896349427183484738023061956638485191239529906311503740032626797095131123523175909943402828257449376045336777553758951620699386266853663342003969442142858702229701661125904623724248177901462857013835790939020450746503125344631958534655024089231193396521561965297735217497608287565163852923704017958259400904834287026933197193592591423799328167149965328232560408884408251535373934831244856695227539243433290481951528897142697352526450162440279318507285454432916819060795455956931254810171588139618689138022062041222735056137988435900866680084665165131313435515187611756148824388549448126467 -8326067459929079652) 19058897134776675884737764093896349427183484738023061956638485191239529906311503740032626797095131123523175909943402828257449376045336777553758951620699386266853663342003969442142858702229701661125904623724248177901462857013835790939020450746503125344631958534655024089231193396521561965297735217497608287565163852923704017958259400904834287026933197193592591423799328167149965328232560408884408251535373934831244856695227539243433290481951528897142697352526450162440279318507285454432916819060795455956931254810171588139618689138022062041222735056137988435900866680084665165131313435515187611756148824388549448126467/8326067459929079652)
+  (num-test (/ 25828007361450952719858846443651616751980622231808382804245407702688699228397920589229449608543284896555585501243582045708656531815385828908740757435341854996277769645696261182122648194952548457487178342682313459444433667556195761154944956714756269417591048771194019245925463541886773351873002480266654825771525233808830260734678788520487541379982691221386179066818743751876186761036101255542680066874888848011074569355779905086056095043888696435054884292698783753890317487209955316141370052511469715869816445031102161253514609763532756500340262263800747279044587806090353812452308490155782240390040070679663451429071 -16419739031141199968) -25828007361450952719858846443651616751980622231808382804245407702688699228397920589229449608543284896555585501243582045708656531815385828908740757435341854996277769645696261182122648194952548457487178342682313459444433667556195761154944956714756269417591048771194019245925463541886773351873002480266654825771525233808830260734678788520487541379982691221386179066818743751876186761036101255542680066874888848011074569355779905086056095043888696435054884292698783753890317487209955316141370052511469715869816445031102161253514609763532756500340262263800747279044587806090353812452308490155782240390040070679663451429071/16419739031141199968)
+  (num-test (/ -1669696848499325185991294008037906453080648048592518700324899343297324898656645662186964240087582483813312797482298159224575128489696846451225871663856944749639170892311973606684486632224811435175199158920841554176114937196187087530038509898368755036744105403511353564606301040888877621412514452110348953863172547944175251415725815533087344857665837809749724257466399374547882097484009980477192931829030533366309859182367479867549644502538060694266048652224732348150866071381652452605392696555259221463464108413747443898588713629829490175098280805280460168541344102200890646453100478450456898359263676257882174308268 -3154577849943484396) 417424212124831296497823502009476613270162012148129675081224835824331224664161415546741060021895620953328199370574539806143782122424211612806467915964236187409792723077993401671121658056202858793799789730210388544028734299046771882509627474592188759186026350877838391151575260222219405353128613027587238465793136986043812853931453883271836214416459452437431064366599843636970524371002495119298232957257633341577464795591869966887411125634515173566512163056183087037716517845413113151348174138814805365866027103436860974647178407457372543774570201320115042135336025550222661613275119612614224589815919064470543577067/788644462485871099)
+  (num-test (/ -2215504974719141921873290809898041836016933916943403987778356628123168736190963062169230280020568365292362281642280014010817115943641228422541948070912910166283758843455538187697141038676028739959626556519808411324617157646799936128314485433146912658200236754847332237438334421065771940922444296618134121662770699950019164632463150784605652351782139277998735272280336096528241168196650073301607171613955878761317417480490869592669781417658461696905996344800864447403426286476662235990122025654999230690604488053668524888833992415515434190712628587043474760836969696399229242018051635699746048823240033842587927229964 -11305319675542865070) 1107752487359570960936645404949020918008466958471701993889178314061584368095481531084615140010284182646181140821140007005408557971820614211270974035456455083141879421727769093848570519338014369979813278259904205662308578823399968064157242716573456329100118377423666118719167210532885970461222148309067060831385349975009582316231575392302826175891069638999367636140168048264120584098325036650803585806977939380658708740245434796334890708829230848452998172400432223701713143238331117995061012827499615345302244026834262444416996207757717095356314293521737380418484848199614621009025817849873024411620016921293963614982/5652659837771432535)
+  (num-test (/ 24358677073350645219370308521851912760304925518671532565724702185818845784332554892130070740233218685874351979772556877899278790031132507391155876157108663291716896413773711734271947599485714147026138105714458778787734198938526335256418673319464023475137997251085298903419563039860433435847755093653670989129405749785476487449599232956305952768800154351414655365461746574761818724131185410194605648466196476174400166047788352670171627261342369793028465418799251589432585363577887467959594667618177199696618852093807640490831859585621198048572586882398004957371434677752931134884039120875470266936204172511104679441462 8754800987327220648) 12179338536675322609685154260925956380152462759335766282862351092909422892166277446065035370116609342937175989886278438949639395015566253695577938078554331645858448206886855867135973799742857073513069052857229389393867099469263167628209336659732011737568998625542649451709781519930216717923877546826835494564702874892738243724799616478152976384400077175707327682730873287380909362065592705097302824233098238087200083023894176335085813630671184896514232709399625794716292681788943733979797333809088599848309426046903820245415929792810599024286293441199002478685717338876465567442019560437735133468102086255552339720731/4377400493663610324)
+  (num-test (/ -26302114071841994464108666310942614602208671348774320769941579409198660404735714925432808094014718434192516800374483192192707032773903982752997957629389083405320034044554226640590549491188742685901503166669355807243735533977994184111229208270447279559478659750835531593667003322059717930484363943660175452777363121025595100592911646539549735930625865256846706785601753749996181113742254145758187876411260965175520035400453360390392991183382425735199046574346992179663247011131958270717402007532256308394559029768974932620173103778338779940189812875680687510582798628982957687329572431433891809534332514765287899172737 196971971351558855568201373145365478995) -26302114071841994464108666310942614602208671348774320769941579409198660404735714925432808094014718434192516800374483192192707032773903982752997957629389083405320034044554226640590549491188742685901503166669355807243735533977994184111229208270447279559478659750835531593667003322059717930484363943660175452777363121025595100592911646539549735930625865256846706785601753749996181113742254145758187876411260965175520035400453360390392991183382425735199046574346992179663247011131958270717402007532256308394559029768974932620173103778338779940189812875680687510582798628982957687329572431433891809534332514765287899172737/196971971351558855568201373145365478995)
+  (num-test (/ -25700334917103749626396366612061842558162882395534131493737229591609654899446089376271023701490708870843231350129849819430092002268875830384992877382393956173037794109904701961390126146975281052960293513473777226100954163054292968509501976296424278813632162404905591038465215586347229260479401862039805429711982871702185657527199220459658257385112793877259572278229045135617281858788415643567614198333459934599272409406206213115625226065750113120833933806486512117533453281522448845990642550827848765145774541658722594353290694745164913189694785762218575339370800538946514325662656804799046877175035545715523049884960 56325873113907570153638933263921340484) -6425083729275937406599091653015460639540720598883532873434307397902413724861522344067755925372677217710807837532462454857523000567218957596248219345598489043259448527476175490347531536743820263240073378368444306525238540763573242127375494074106069703408040601226397759616303896586807315119850465509951357427995717925546414381799805114914564346278198469314893069557261283904320464697103910891903549583364983649818102351551553278906306516437528280208483451621628029383363320380612211497660637706962191286443635414680648588322673686291228297423696440554643834842700134736628581415664201199761719293758886428880762471240/14081468278476892538409733315980335121)
+  (num-test (/ -25716495567761925495340309269248196976121711927176026606462843116646034561721958499564011513233986043633061335866265799467020807570689498961190839877265773450484494789052182300993137822542881883769593344810286970036960228835955266304979090841345697560418139960733748874044680214388098802745248923989851173047158103142988835055585349795022662576576434371181693607267864646932929998659458265265400181839509356921460222604661909947838434113964465769102604033848276159366897885013231683417270877512514679528402888899725431524867260144325739317224922955028035417867933390409466302057857579158202739536568407090965929352402 -92089830031261826185903006947297196357) 25716495567761925495340309269248196976121711927176026606462843116646034561721958499564011513233986043633061335866265799467020807570689498961190839877265773450484494789052182300993137822542881883769593344810286970036960228835955266304979090841345697560418139960733748874044680214388098802745248923989851173047158103142988835055585349795022662576576434371181693607267864646932929998659458265265400181839509356921460222604661909947838434113964465769102604033848276159366897885013231683417270877512514679528402888899725431524867260144325739317224922955028035417867933390409466302057857579158202739536568407090965929352402/92089830031261826185903006947297196357)
+  (num-test (/ 6427758281007308443295844679532867042370757542760390680622584758338041709910068192973790897624827722686313216884084305612889554116246627679267186323854642904894988936981064543865794245002470271142875081223308666588659587718561791667575945670118263124267218395749059879636505504607358472659126298770422135028955713148882314050530771750859372048576074912599265823577267962213046012777760882389021047579367276198483178024744924299929585515193595330026399302022065656106472153858484998010254767462854235008343139218888170221421046454280858208068658907389288543063912721882521711363713136166478126504226820360347652405439 80854661163518168674595213426641201760) 6427758281007308443295844679532867042370757542760390680622584758338041709910068192973790897624827722686313216884084305612889554116246627679267186323854642904894988936981064543865794245002470271142875081223308666588659587718561791667575945670118263124267218395749059879636505504607358472659126298770422135028955713148882314050530771750859372048576074912599265823577267962213046012777760882389021047579367276198483178024744924299929585515193595330026399302022065656106472153858484998010254767462854235008343139218888170221421046454280858208068658907389288543063912721882521711363713136166478126504226820360347652405439/80854661163518168674595213426641201760)
+  (num-test (/ 1960728263483597985471065015024594804771170333646104429205729831998416939777820080209106943861368202560376682136488253096512360698625765514606930980274938979705620987031595592685578710084284618125325617453699875318678007463857705931376750632972266553809944621631324385690517092215690694024807784270742388108802858889381036105223858467345514041786882957807868961085072340965930749117411726729713477739990680381647988935514765113077094375924848051541167125595015542791382355149166582367766443782842193396221676952668624805183924877889696428989259842153378327156342464279071638070457876940165186524833987190050817072048 91266493124541431873557009470479491083) 1960728263483597985471065015024594804771170333646104429205729831998416939777820080209106943861368202560376682136488253096512360698625765514606930980274938979705620987031595592685578710084284618125325617453699875318678007463857705931376750632972266553809944621631324385690517092215690694024807784270742388108802858889381036105223858467345514041786882957807868961085072340965930749117411726729713477739990680381647988935514765113077094375924848051541167125595015542791382355149166582367766443782842193396221676952668624805183924877889696428989259842153378327156342464279071638070457876940165186524833987190050817072048/91266493124541431873557009470479491083)
+  (num-test (/ 4941680418946960910262990974014623728051861920391294141439502190044830922127013115391726343950340163023958511659132792063033185693862678433421115681422259770928656196358763089894449447854011668445981430826871764812047994423858851467292757304285634515474652989618200442851239459073981986390515468331839802701176644729973346052528164203299481240263263697394061787580128379398464090163611942724580936445878570184925290925246112514015572149640886198984723311273144361235138411362294735799814160816806773736605477503201836095726740734281001021071803299510239436683913500734680524381145064985356627091311888606290704759943 291575320383555320391938911470370670502) 1647226806315653636754330324671541242683953973463764713813167396681610307375671038463908781316780054341319503886377597354344395231287559477807038560474086590309552065452921029964816482618003889481993810275623921604015998141286283822430919101428544838491550996539400147617079819691327328796838489443946600900392214909991115350842721401099827080087754565798020595860042793132821363387870647574860312148626190061641763641748704171338524049880295399661574437091048120411712803787431578599938053605602257912201825834400612031908913578093667007023934433170079812227971166911560174793715021661785542363770629535430234919981/97191773461185106797312970490123556834)
+  (num-test (/ -17803449239532304707372697093467431202778585961066204978641168716990033159088600623106396534094218402005803618121159982050197012697237961155375180768349707725936023283589475384693590539312637333226292265409814019687105755522332846972859860649558844229320481883408457674560284773922666633054564243260924189551494368660033292970122831009582038986061326503238023206238467592238752824663935316307653075615249537594229930297642710570473007696494702367783692850946455203144153509057520651038068881755863521371187245025834292163874467913915588768778393773565536027848586260129438664753479013894698439967637389690509120223682 -10962227285754340409566802000064407225866105372406170304563353147415988225079632767886653994299800743521362563345682593189107807948342418743229049299449088) 8901724619766152353686348546733715601389292980533102489320584358495016579544300311553198267047109201002901809060579991025098506348618980577687590384174853862968011641794737692346795269656318666613146132704907009843552877761166423486429930324779422114660240941704228837280142386961333316527282121630462094775747184330016646485061415504791019493030663251619011603119233796119376412331967658153826537807624768797114965148821355285236503848247351183891846425473227601572076754528760325519034440877931760685593622512917146081937233956957794384389196886782768013924293130064719332376739506947349219983818694845254560111841/5481113642877170204783401000032203612933052686203085152281676573707994112539816383943326997149900371760681281672841296594553903974171209371614524649724544)
+  (num-test (/ -11349783565099575757929584771389010505157850113880084607145768380886038854233583951229136273631022011781914171912628263930864052254964518914857757025547156428098062812984733912827827545722979442676567330004437902674729872754963478834939047061999292143602525229120558979819117729589695377623970606315287270030693151486803968345724658003068961239204812937084581894755863859944500186226990319892122692007317326534880413455575446314965159569830188583093978564829748603480193166063624130610256395632946002879039047154077629561745862713628266069928068634042545592328263646730943717246953000457159714049930890865576634096206 -5169948998417532948043886408019867395123131165917923418040862036041756675786217242743410895008311710518018466892169868028617239526646914529999134517417939) 11349783565099575757929584771389010505157850113880084607145768380886038854233583951229136273631022011781914171912628263930864052254964518914857757025547156428098062812984733912827827545722979442676567330004437902674729872754963478834939047061999292143602525229120558979819117729589695377623970606315287270030693151486803968345724658003068961239204812937084581894755863859944500186226990319892122692007317326534880413455575446314965159569830188583093978564829748603480193166063624130610256395632946002879039047154077629561745862713628266069928068634042545592328263646730943717246953000457159714049930890865576634096206/5169948998417532948043886408019867395123131165917923418040862036041756675786217242743410895008311710518018466892169868028617239526646914529999134517417939)
+  (num-test (/ -4372008041495429462966226028389793326873997497126815043214338280101332483009650104005998792061125254101227371430911497751865710691604158789733634394053254604723940088324934622768312096370232736965692181452463495731681105253628558429524788376108667441329817524961077744083376843098018692898745743361309486938506049017980865957895278210133305721083115513131884239744064081819033733041876411992332060293539102545847193260167588667810376670587099064558298380310132769718526554738650709745767046942440481512965138461694790645096012018276362849398785863823724642554436182185786302301222529261914437437947741031113015699315 -13213007132248918651858333568248204618745148942720942572088217188768868803339938910599097839075045781852237705726227293430250507070717570662238736211897310) 874401608299085892593245205677958665374799499425363008642867656020266496601930020801199758412225050820245474286182299550373142138320831757946726878810650920944788017664986924553662419274046547393138436290492699146336221050725711685904957675221733488265963504992215548816675368619603738579749148672261897387701209803596173191579055642026661144216623102626376847948812816363806746608375282398466412058707820509169438652033517733562075334117419812911659676062026553943705310947730141949153409388488096302593027692338958129019202403655272569879757172764744928510887236437157260460244505852382887487589548206222603139863/2642601426449783730371666713649640923749029788544188514417643437753773760667987782119819567815009156370447541145245458686050101414143514132447747242379462)
+  (num-test (/ -24003371850945507239307096734506644624830254935119140199726507920301383328662376914775504920527918338079792692943250446679097229950654636321252144129692109999375967030689211646504258922323499994340282315270808545865248969923421472430657741998787024263629527291510416193284540865950122841477102934165296344839654902079279846705581902668360663987722715177845485423354226653585575109653937253382583158263755381721094429734122004436184054214443676096492583897635497699417294183504529284810360226314491839533303380490277211336049582128602304906849999737224506976061216780230350942535246958957024226614847691329767208211525 10686139440491678930358521446524488461285005495304677740436234635584738003880529034339295291091217655777627375148264449580064000634364863951333061091724053) -1263335360576079328384584038658244453938434470269428431564553048436914912034861942882921311606732544109462773312802655088373538418455507174802744427878532105230314054246800612973908364332815789175804332382674133992907840522285340654245144315725632855980501436395285062804449519260532781130373838640278754991560784319962097195030626456229508630932774483044499232808117192293977637350207223862241218855987125353741812091269579180851792327075982952446978099875552510495647062289712067621597906648131149449121230552119853228213135901505384468781578933538131946108485093696334260133434050471422327716570931122619326747975/562428391604825206860974812974973076909737131331825144233486033451828315993712054438910278478485139777769861849908655241056000033387624418491213741669687)
+  (num-test (/ 11114571678097117920369007866358540243142633567044843952020632081573546909920632543585596494530749645890342978505657174505155646987551523455565703297238406590291026899487431109110746657023874064284362499621762851387854720746040865741433394111425240861542892218169985953747711593827913014379823797703717216676877313898809377467394109623799717556800777662963842899812297087284510893865429864819927951428138755600792987191034272014681606301885821862650098620488569288170357746018556395309910262410994899971436293672676949544989196526035130226777567220128838888396668158456237490064462262193759918857287915854681904206680 4808076329737968688023887165061921594706561818755147855784713748545995818001333418509444774306288638038607173052166709335820929501845348060033808100812677) 11114571678097117920369007866358540243142633567044843952020632081573546909920632543585596494530749645890342978505657174505155646987551523455565703297238406590291026899487431109110746657023874064284362499621762851387854720746040865741433394111425240861542892218169985953747711593827913014379823797703717216676877313898809377467394109623799717556800777662963842899812297087284510893865429864819927951428138755600792987191034272014681606301885821862650098620488569288170357746018556395309910262410994899971436293672676949544989196526035130226777567220128838888396668158456237490064462262193759918857287915854681904206680/4808076329737968688023887165061921594706561818755147855784713748545995818001333418509444774306288638038607173052166709335820929501845348060033808100812677)
+  (num-test (/ -27971792815424016824370019866875377333122266892537700816201893161065327053508379094007350664178576160161460501442627646041422270472469587140689725524176629653056006769618104516779694726446739085332330345789012312708713495757968594985567285237456431009983022526625885024663335598317191838389804118084831445251467492693688286258834282078888862754754572546522075833632779922232880101875914894393005204887265821991459415144492487189071888581048779385051174007698853920104709378859053075296413813207007405843448595681090932498329066591349910723578718333092115184652723310842559914379989208301125396793101430807658654849482 3169580893680227534064172567436590084742349042688765883461923377455374714865282199177755353861979892274552092801376364846717140845237173266602633583445110) -4661965469237336137395003311145896222187044482089616802700315526844221175584729849001225110696429360026910083573771274340237045078744931190114954254029438275509334461603017419463282454407789847555388390964835385451452249292994765830927880872909405168330503754437647504110555933052865306398300686347471907541911248782281381043139047013148143792459095424420345972272129987038813350312652482398834200814544303665243235857415414531511981430174796564175195667949808986684118229809842179216068968867834567640574765946848488749721511098558318453929786388848685864108787218473759985729998201383520899465516905134609775808247/528263482280037922344028761239431680790391507114794313910320562909229119144213699862959225643663315379092015466896060807786190140872862211100438930574185)
+  (num-test (/ -138888658164471549506154385143989713534453638138516110941977029 48484067562152384719540184707188444570280914254129306788137384972303743285284814 56428088099244342456240635263153370817851703737803685168591843059886944388583310 6984617762898435035101945891920384937438416626357047934508608980105797822504000 90193136183227859939744547239819443586783276313678017953708293432043879247302040 70539472782976230144489157899475475029273447055080677052149474853222128626227832 2525164589393997980217929709704832829968554364529060039097810436136432713906553063644429644328565051224269893261942396763235990073001625976866246420775436 15614337547041181126817477188043219628044963126229393225781917631975649438502836750353253851523795212263078850399716875892512719059737913422781999218667136371648316387382440793865460028660248325297931269646982047533754121791358966254514009830876592200454797694143082163294323565673200905929297174223061890100210054105027025488322289599106119653451218493916291922340123640475500240519924011764050880374885136181582395113140580448936759383024305870622004464940344826337458060607492042593813585998516868215921180540240201095202617277388950504036371411600204964284568597705251929695275183521036281637399204541958859605054) -138888658164471549506154385143989713534453638138516110941977029/4793535847709521198063287553243915170068914691727215964454867625024011698922303669226389748584276840530192157568469968220857898703102351955898913589325705637953049380748829567692600765708909637920797057370082064005557328769108356548100875674196976079597658854339583183901899349355521527519781721778545444496852540362424465770767219571362842157786846795990148969989617793004579188905882473140017509154008696803103206996067638134383708975696867028865870695941933200225325283190379262695816923376790224594063264297952504481719779782130509306530621779762254864669078635401870023086312919956154224782043667754741333688780367667466505233610011253346902821033707597517691608103391952937194719540981992469020284583499872663129517095879706480339710037976698298522952071766717472040399518290905103777436461474880898550115925718887748413534479076504168236430697214654069473800915087572730747027455509241250627470590715812698745630545585772046458363388764449879417348554556621640336029897762172500880501074103433267444717053504878282494505367980026597725927414511391047010801407870379019921551218005714825277162504166028680939100225793768617321830389705750902850499916610355200000)
+  (num-test (/ 2902267908619179684129536324641634394442732593027015198805855082 4748067699021154152763168285921806700655154833226062437593302484475663167752990 92172802787151156076284963978247829387076983213530315481815585776147505007251090 15808981285029107672090190966349736198141855760941720122983980047623201110025085 60559202289239963744584432021634662330089323842876293477363484160210450706125345 20641717016962556495214267565148984505293698026059157698737040675346468206231142 142380249473014630955299439077662853963947100833592874440361316474000948841420058017600161066408668117933232436922811486348705081331372574460204309908598 22418721268614574393232189860262616514600143215945007038687873335656746730488694050883006164427390756358558140145027011322151188565843290717535647848841274550496431839061217253488169143292339455650565906288959125935798633464526818546688779845699340483771625364583343140648892889571715648295855169294054985996834093294240640072029711789359793649773566295329912082241637482772608479106201840565936084243727069954911883243252762742415647868355726139789907900798435783365130277592703989608678774745914668128791639635886550753850811717805962562157686110637810320436812644047534536168343578232389700410352900247092236175044) 1451133954309589842064768162320817197221366296513507599402927541/13803211377640454778526029288269623376813125655593684775595099045285713415153039020789267800416616529908688645478733023490751981264976732618374046330204398361829051480928696426688037404239513603403603849882719851670264413777889524531938606364925013854252374108222701436535488401321603495905123597139234414735397259257280679663147039651553472142280954446675036289021783142392760217244908768132158498744301278889276778209560846418263599491357632762902447742083022806085077053406738681250354036208472026046315736408632370478801849290705001622808552373129971427533249307210975612625050706661691322027927380443494854794852235813844542319971019369687589916047377092369702778251658652143114091304960406840026816351348391618676357634544120732441610431417230403811846208113160343697557236265319994702483700922393762500190362776377442551539417224595247790865885105594005740401824824367904020732469833438717527758468635665777261969819260766044978137909489986407113029460354144391595512642835261443393260585888868936164331461486646676578398836326366036777321522851855085808626766493197635871100152761464712744017549919220291986785134521319127277292845352756807452050073157340000)
+  (num-test (/ 7798204144688205291220879078360728451593323170355809361079096742 35808393784851478122520372074317359817820799318259895240196875729073154197251420 58532175726063855694248618287185551673975962776708803423334853085996022345828434 97834368697888769536063057370864051207348099191057106781292664602519775900739777 92489021460656714290092899983209031746574776013841975324837145038810562509209529 71083733375588666647468985607775761710974844539643116636307037921671845148256816 6123989271760127932230015643359630675168106436173654465119508990415235040641894537960236511442249258231302028977221206744158863083898145166446430168108 -27418900206398855942064397259705713102524342707255992250395147550519659429645343464288092288218160406382406024735131578979728501208163782063519839258876833755387025755815673514708453862847139552613587001235204464673999898312854941659541050445981594990466469147364579547089805525464252876345032296745312923488525701877655352034887018931755379078328147999631937419977103372927428613463482328465834563846802083044643719319690088670748858904291298575733560600669924511028715689681303059001186388754140003746463568171428267337107394361025465082282061651196456268663181772211292647101192148287507051053367729008997838464209) -3899102072344102645610439539180364225796661585177904680539548371/113184205287561573324139833190653102440730360395399197973956984769580868365256138025034414373155098575475566747215877030265786675432252675717351889433714136838615056208470421665419618669892136317438270826178251174708190860235979949204785938786562420189510825909814566675745650194525647207897976611434325225523578368855952217879373499055292850828774005130267218801086474623429504045290678320168493275019256514768273116059350700654655821674309331585233552793659038912697151359657915391954687630783641745610431060563252789714638916120291482852533638921356624929690158752601417722733222880768367060672103351737811624242610815140332559619520810810999145535251960674284283045907801934328911198563750515779896457101601178888594882087326241517566336011980952110586199881600553269825310575512911473547251704677890770772166895623118832621335417348044312911888377718725944255218219811801447500167145561774582342171995333086224230231746597452848775656030037837271428187450747141983599129861631612369300880722326218963779650411119279310045263996988089484063433088077868691314162108392639864773907107325220582413508233901954483499166402135445110435112499264825479433389003494762240)
+  (num-test (/ 6291885367078853457481986049409245691302078375827782321496819120 20959289231548357352292073342856567687394126070322865796282035211176720583560298 24366038587110130209541647226271577368736240640393242419005751016119649778306566 40118119174220166901790237425673316895032570534639145502274313654443256239236466 73598137358602854818844747625643480865061277528564461120022408463105339470504117 36695182446520138181079917512512743290981469731336486456411609014364293489978544 8671667981598505073194269824535189054936442262459158402875147736469644925300845122881093216273840895555488593258562684601176239455526568314028830532770 15920064019095473156324398162334173238735268739049399738654357508344572552411935473846021991360836375685872129737682603096450566258725052013769725919038955505690389573813769125933987978360857342250911865713011888064725725934341157729878064563080803955584985269499994186472079783942404183377695242296289152788154908185130552013951432753148997632323578507137074131845177376689609114975253308906745794984371839952312988353950198030866538756253618535421214253194954603293145507537939731320546686208032528588232652963255550963088571344119439249328480867640436815434047309164687808223851012490130534705427647158409623238123) 1439421788255379275215959765325419043929720157723371200401/1747562187028503746686299553853635643553063923188506902759251937250022196751705340155682655202720363192751787186892107863159676381018035068965958466119538181810433273947829904580526582292369320932134048728374142501965682147541817431447933591106030690334465450755701191781243754499216697336293783127396687916725975251100500896467549458036395977769801208905203001097425041200299917628353220804629035768571072498715030261324138691471497255335498185741379289492513543474304524261634247519034231348033379344777678679950561777846684978640375273167561174451700942154388980887510088060818147834369595669846115248027925007288445161871535514130090907585140894883683709507099726386549038354860875469377442908932714711235823032704493155679240378374325069782368108779247450762222838197717507164088182062062215767468125843278459189085290703729281279344184417197883359351058003644499215541300350121854220342250451978930421772367851329849662028719768708399155817754711362398236471946313773603716759409265530444582884661320404389499624411965234669344882203618613097197387901166904575791500958722726774956950592290330175936039556139052663816485140080963740296685158607671768592)
+  (num-test (/ 7377598052472799909620353419322603137723415431070641423056433630 50990728761110292768803869421408199244526424730838143228662194914314857136430737 89434155113971221138805303763480423496687322824531744020762041598590716339098287 91343386111124700155689622654961840380754244946720984970313893805578518003516073 5641075230099727784981579696383316732450130418277879081291954534985607255267932 91040802121912074401640073226003257602385910518707524375098380810792151468159323 59272268188012925764499414539835790113036863511169317924034366016920114706179376837448098952655862721652129333873020625135398431500899131874782270590048 26690053756452308398721390096804652429111408747235998849320348549870126230712525274708597346508961935323823048352116439255386668122483555236157562141222434006899926132549352821247340442387991613448730451171206857242290791156220288682675982609964518905569737166444127835826079348146626921864776959482079234994631361894786436656768739968380067890165160954836874044821979903056957225885565092422439358816023307475581832942250031121721325840673134241504501661692722633100336840768527354183989544434614842654682324213774503456414914613412547380720171088896588158750436205804689590730033393056191028424154915201435563063992) 3688799026236399954810176709661301568861707715535320711528216815/169215718032454146095901737002485678790901914179482864125777331106759302744215797822810809511498045518338288799757661725047129775976254373463314416017128993811694804386237923340900604770406784566473173755998386770282409830097844352035251738093305402541509197084964701114515390028814839744480965823142680384744649624767291550851759670297818996073873968006960956353033659153219390871979066743795530136868490210455800714335529013059123604101460242870160400211866883478263106349349114199154533363251799944090298252763172390952446660627602934622584400932001701907172000401485323481964448487312714644861543740014645407417493588261100128985848137181719614326345024112347151970444057551896842474702539258687521054961314443551837168457190568932765925484427579811571491887599619302241390226818415165012748654917331557679228501007751078584244340346651276906088856205294333241792044902850102153793417101337667969641035858108457362954650972654353600494166650067557014544136240962457086782865870886529792004619668808741311540795514394731398977642092124679638585188974746423756335151669217754388004341907440529525288302872368689364872785975840444000802518095138062596107983803117056)
+  (num-test (/ -239344771695510351349291992975349015183687755312261264640655565 59880027487583466136533364102518649070390160795136023810470091681171428955831193 48344457085007359228086666145324485903333773379391455489556219681156342646858065 96824393663737121700189215323825147927318524415097221824671795011444303522438090 73240728471954064253765051525185557601431281145369716902120469411886093226662465 53476482728312567840603110355495270554470432250981685279567813448298175801364992 2468459436652089730331798017030410049989399340882712030505584719342958436741536069714790640546086933185494149096286590992747248311590137695839482679011866 -20583944357058654336975302336113341974001469085102805363209530168831840401111182124827636905521584509677325966689931599005216123375088335255672290604710305325984961984791919524676460851699284525672773368217606895110240237523696098521003978238685169880199868729577660354717875890521074505342309726366304528678619465048659607726264456481345739318939431629704180230985397408136331466856633265343276511285483458860216756106887559724757372775728879136089013590836231272961497930729470443491032308329051560641396901204040829291495325588896591482909336032903587307512310970849256645908744180630660878534263566681640143534823) 15956318113034023423286132865023267678912517020817417642710371/3718709813392127924163278362562751486187605430152002432053108623099406465632705761508167478249438322470295467114170871555665890539409511492475240415534629792791729596612426725326976353265532166735941330128195885206087665506220364347120981130748862937276841801804372097254983242962029582754709606117339082763083905960784323141929645331591164015455383939302728076410053178677168172481507115685831178503426055335630689722163467637005123748113214310366231893390818795405612007113310547901224920768646006621130651182788173442625298859454337696280614462941186626306295514630883052819172301830539345633711941340491653447613466053205836875456839023743314390098829184111583809697328393569588632000669468187410368485286035179259523632217543401146996259011916302393091677624838641658623073752023082344005134299104409908004250830639232078441523519412192782367689826532215394196055149255026188549091956300108740792221660678858924234682223183500313556198187095251404633698868186071148295957994257417049500872570631774233307260384902571112475241073598945295745287525486108978093728296107260155093397986671349139935376427469718767763295900745932105722655724205000829205748307261900800)
+
+  (num-test (/ 7013212896988366906/12397903473277899947 818833870013215068/2125577647443895255) 7453564285301859120853045020886215515/5075911640537211768265804260348400698)
+  (num-test (/ -15781329068048599432/14942574238341613337 4388772934226358350/2640112802717985697) -20832244458230302534551181278529162052/32789782692450857054331267544650656975)
+  (num-test (/ -9015230453321124271/17425619133302730035 -10422000746814766599/14972344381173680534) 134979135022768387806775446187867640714/181609815620990738305316999098032100965)
+  (num-test (/ -14741075237791868512/12448692140900938227 -1090381863721238817/1060836378253796023) 15637868866825840780217685066084527776/13573828137487503515304766902031557459)
+  (num-test (/ -7371815071140740177/4722722556038701367 3872455829192658988/994203944294825175) -7329087620340161131469364260313555975/18288534491791723206480607737200436596)
+  (num-test (/ -9856364379969390509/7988230468709836259 -7208901117187058135/7430860779232874136) 1093153305924514768551484985555671272/859497963436269188803272225817371895)
+  (num-test (/ -16740689272507881147/56924866550406451570641164619431212169 -14712532880452686095/143481612520580129383584255576273223983) 2401981091525408257128502717450566513166280001357873948501/837508970838236191644285394369194561392491093277901090055)
+  (num-test (/ 1874027699956565000/65960003455647360668413772300355814843 -172394881832672950/2006879686300828197846469567507151887) -75218962452157875130617756878839223573611935155763100/227423340028380523596387094039260091189651621559491937)
+  (num-test (/ 851521912886492079/58839621451933520132430725102159653727 -5525838657334730480/268863138354222710211869290179088409033) -228942853876053297959532391872114722003932597144466549607/325138254802036127673497464266072288930584674567672498960)
+  (num-test (/ 2130823024472312937/30463932363736038600114358208342163020 413938864244113775/131673792970459944919771618253738144891) 280573549781056638388629087822719475587456644826399754867/12610205563054396144647765193069861697742251186477600500)
+  (num-test (/ 17234694073181371137/253506951459931119968572673772742357160 8407879684613951161/42697666588937447817581914537644794355) 147176244259806896721181660841298454615950364713859506327/426291189417673978158704851675227114861497071554451732552)
+  (num-test (/ 14739301038477826821/4801125431810347467140397350459581435 -1752125940488995048/127905197451270157484305628763539243969) -1885233209620217720514367144506571751170505057476450692549/8412176412616337518572109406238500578932979745867733880)
+  (num-test (/ 9194848570227974720/45448499872046683203864930109076126035374684748838016011669264943000310475483 -4572473918523931944/28941042619577200519536336906341131911598596429670188136734086846500956354149) -33263563043940787786171015409141766453199063320923723716765930467953050399983260590187417389160/25976510037621464639740779963549572814837984766154635046133743883024710122710674726552171566119)
+  (num-test (/ -2662376868940711929/2674240208804755702377222409224408783678596883960539287029565653749020338064 -5046618244273151929/26826013625152995057141957222948811537350409769204161465077735924332004069058) 35710479080747854012875521001477955195584454274704368888444222736697434540936425667291700196441/6747934713661461716612153292457811722283965560031580498434684530869001786777260513409206862728)
+  (num-test (/ 646980248518054663/28444849537262537816809349756569888989442483441699293309597267649158853799707 -10174938507557455325/16470612178414296088079890015341965945714023680627341561729034923083435428747) -10656160760434978971303471120231114671340660575734505071429575384684610862775940451177787597261/289424594898370460244167952344748286246980979584479610186308309369583658143095854438992150589775)
+  (num-test (/ 1268676597518744714/6024937921458004492480888468749320142603908196076058575752452561172018490893 17823595902143962912/85935047374548136904062562443188289405155329832270007415035044821925251080203) 18170630585125644385503771892175817370913744757273904248648000044618805359154885235028182716157/17897676474595109057512045856227678061218241143085827332930191066967148125532813505892133626736)
+  (num-test (/ -3035741006152688190/58890268425224581569217175195410848521985674465189565646495474378301884202047 -4870935665435665519/47998868922405332801456101880162843269583282603435159879276723163289928325531) 145712134636693761356266465698326002831562744975420904782663360472436650653549187025441059178890/286850708819506259357726384810790881448875152111132928069815447961129371272624891025817707117393)
+  (num-test (/ -4420263280205408439/38682162086456801604593696710774835436326970692840048042132553053971380151628 -758651402628235427/1755534012040040367913026343944696058732638465867705260088080517539506722166) 3879961265286134914514096239640695384126081133972137242327715997675029567458817030555062379437/14673138261791601182714628661554161812345431143865809776872034934342213839184709418896670662578)
+  (num-test (/ -312487180249669742743295380499853180353/9828632991038934281 -86131955660561774942466932680637336739/10268762916730341592) 3208856768501438660232746468300370677374054716853273141976/846559380988100144557815474234956961169507773676687849659)
+  (num-test (/ 105376075880566042097567073713047434893/11411565636673693365 -220737802783327232867818580441304577024/5817406274606660773) -613015445021032499619145665530563205764250055719854552289/2518963924957071797477174332253152325843619212749200245760)
+  (num-test (/ -311533429150518992652072799089375050497/4403073054828470603 -320230219907951760832723580313293021909/1370493254961533625) 426954463345823097468320537904981772054351338526938461625/1409997052618498081840381197699863669488222338862641441127)
+  (num-test (/ 305676222727436457375950609916137360009/2001517485431820526 324338803123828318219640932070020543912/11123178903397935211) 3400091311912189654145957985944153094384781502787164376899/649169785656371151621897383467144093766684841422885937712)
+  (num-test (/ 8845112929712368402815105446090151026/8124751572615311799 -107609110538267962880281203537194473336/8714443449141779053) -38540118213625599008519681983731393728094066419546629189/437148645036763776481446937412401903340367189496615845732)
+  (num-test (/ 152921217721894690043853278309581658066/11705615305395353865 184187448038871874764725486848823516773/4171619104693691390) 127585814672335876029018138907883882524550368713261650348/431205482165106014329333719781838993214328411764819575529)
+  (num-test (/ 16414254293541341780725162107696242521/155838132618727968561620486302365154071 323320173010032367023620851618405869489/49801924105617352177018959505967933104) 817461446577249670665800625691379410535771218196808189195363718417488315184/50385611999847495177988476252475899813264458225659097815552272081452203039719)
+  (num-test (/ -188149667625860588508273820953820709614/21438745582767797684161462130971215025 128458309657689922121539794960212789849/134174286369366827879740776978166655691) -25244847384333405496229128525982900130397411994350175944375943735942831513274/2753985018743617742875555653653797261370358442640799457019039857068516281225)
+  (num-test (/ 1218460641064115152742257147372113443/1773382194117714970762642066492794929 -105212349758139121832338365854603836112/35045896682356785176328011712384921341) -42702045738251194875426595475683618047253961691478453648029952948483687063/186581707662369193907913729212042024270164277319717456729276609131940676048)
+  (num-test (/ 1467722271775252460214852151179762687/1747611358981474614363356529179985509 25495740211005247928144692929451604259/29615224810946461612486375021101910565) 14488975012885720730598332784736375353299643425098519766594278819666029385/14852215066131169889445443721709162270198753408805825268529301698140894277)
+  (num-test (/ 6278399735526726207674375684072448068/13890681759576280617381650633747782321 -112063146811220963294237186476216238443/46495820670393894026441353693945662660) -291919348200099113895651901892723884699250237261456280525601785996696740880/1556633509331345870779770006255469001211806559199158615405344674499795966203)
+  (num-test (/ 248406099260780863433196593538936526373/315762135750029127758352280023694126018 -24578051912523675039725210046249323571/3033769619337997374435389027823294736) -376803438597807975522050212312559316811899647514236724224019181136008036264/3880409082236781853269738100403484871805889674074731389226471480469265885139)
+  (num-test (/ -305871752543087256004326578375555909668/80170799467978436032303243749692785696371676780847080230403479135749775915991 -208573266832391890136462745593008906685/96016271562601269514856687672805175650907293023094157826925793080307407361434) 29368665255505841438632782694581946057561031972462112644657516768267440383833513431444679871238206541553985530943912/16721485549600848123731461311227384049611071114404954309505697259277905994635125654414916826332204568970567318299835)
+  (num-test (/ -171651126582338417143004525987733942986/48126955023093310081685702171788275811688444573315712039582092051531229683107 32570134112026732491936310765048378699/18584159151613423191553551933672204731023422884196280183931777685641069715348) -3189991854959918631828923606391779823799241149346421336570141741355492000935500642040047513113849334779592681149128/1567501379505627719887579027549074087653888429037997616626567546431482074522690424133509833932668944596793898937793)
+  (num-test (/ -31304786393644787215292629624842492472/10539846271603297974613179098685212701091372728582260780054561526149580513583 43496364289252206338797704034889660065/966865502932307025364733802774045297740949567802356684866342045679773834966) -30267518040679809082934454680954168768135550720881039440573156734314284479043791824457029301083428211405425375952/458444992982373700837242411005687390212275114474481688646320865335043970683786989531994936463047685893258985162895)
+  (num-test (/ 124366625369659591476708994326732418029/107684759001536292829359995221778346870065030877016948429894748600664800488759 -90949754058598173499067700725927605729/79727020098830307921496202496061295138733611655702270828135321391380898414003) -9915380440470549523296226431396644117384598256053664887332801972488440466568616812942647849957495261151611303260087/9793902347049141646079571573977765974008832433473016883117384010293158932212528563016145547341801740792289848500311)
+  (num-test (/ 26792084925762094333829722201654015569/6815899891200140342329613369008754659665480100088941978786466272502677117648 179968988142253715757129058636648023126/97033837835570527321466682927970125702018459951415339098532052222053589117353) 866579607987744230609336186273867662887766686833260209925103055244528379635362816895584608387230956963010276689619/408883535566062149539621907018509777969515872715944952500700527207173412646715462423653890585029605025758308909216)
+  (num-test (/ 320794852821756057819990044473359503428/42380074203350930293358543616207018031675687905746455222111844144668904183229 -11813439835454851567822019323728871339/51852159737956631156972450987013128151750117741949546305537111598356497409240) -5544635317209327550045071802859986261979158492907374734760649234578367469399038563605323839330681533705071632958240/166884818941132804535892580774781586387104334774784737031184369589400544303785250219152004898392301479219940857877)
+  (num-test (/ 63160395612932962868082774785156358041658469338654564454114468396132462549944/5671929772244157797 19541045450680948617094710246839287171374470593288265457341382295544977156173/10827756125123268218) 227961786821047895774887365257727015864174017882302289602409601101722343657899277052494444293264/36945145824164509580938949252327087600266044162541122809277442696583642758457532273140841543627)
+  (num-test (/ 31389399613343712511677734270541516183531975055644318154870016415582858008412/11320913214023484367 -95931706646769408081251897664360951854776052790951374912970042200868629796051/14301831604104230477) -149641969141325406602881756591195860220337618158488775091717625369334526143115090325362684257508/362011508473745439254610688691597507367516106821889963803421575701854031622412859179610532278239)
+  (num-test (/ -50845041077039215658764589763556935122444212169574762080162289087527164772395/482986173890811026 -51342299909113507561385579724776151277474630060658338514843664853027455595538/3864573616937705869) 196494404298439669659681446421686066898686292162412914850963937042669022612531239234324840686255/24797620991857267698917294149872672843409173617406514673128342148521539559341861421304646801988)
+  (num-test (/ 76283614020376921713154299810619585257752996149145061806263596894412414185408/337890011287912517039286436540240936661 70530558237421368381589233382700323659036925075366138096846582768833233488577/12121510300837787759729092713205686989) 924672613133132744522463879340347327755455994321131972145048214329608890428265966744607561005512244129921459256512/23831571118985077324412202325831974453532679575894228007993082738742295289254461850021038245882565939546151124021397)
+  (num-test (/ 13518475961402756750057330871273933874583566313800024119371308450919239424622/71146816100737230880567880716110051085 -11914742388051168959634071864657967837347162591767656949770878950409478930980/166466796775669753065110807850377519909) -1125188695291804746273664719520877594103080002716204716437885631737502681157239448228517736957154781558316254899699/423847992785167635691798025732868758201476408654527740579259436528169254792708107390082891890404030666159494556650)
+  (num-test (/ -53624051286117226406327700847140806598091981633622544805551583455315188018537/149060170957501829683988930330276188371 -49540630291338976658332195799658601133012561780540500265134312414843218811481/313014990314092319823049811442768272842) 16785131893926373429171158665038393627227592608630727377590747943991201054188961463248027101037470630205119769672154/7384534820569381535972144752572408048556227885764547207137140227958732266609348654686668662110083737942669493487451)
+  (num-test (/ 2634758410586745842739353561704344884865889793873131750193619887157306355755/83106075320614705363810122092414199463231740446254118542567688658288107572919 10787649314660479714744029413883607304719873485501736976813666398631455642569/2439964488756696481271244145022481444549967702052558191280867337292105066432) 2142905652761565172685487282499186838096673751132490328620490049367034561455889328384026705096013173825469773464105722689198047146574263705663366838720/298839732158850477765824602476778580028064205733214070073086531571837859351705342746223206218407306637658483098569582239416197836311325170250187389329637)
+  (num-test (/ -1907320079310938642409293211056905401889419041722087613680756850005726714712/10387378553621846874105702088597026076825105075730032753153301604042569998683 113647247724474559442709588703965365251731833799417671287796250968092484717057/58756890421232187224353930678527831208703723187770044891160428018937233424397) -37356065632762902117955690133395145368676268194116097031480521390942668514422835237280325034441435052929702455487858500299401976652159912902024146542888/393498994563785425899168694480259206994308562177080555315323154941891277193612821825931878224565302417504072329241812530787363937691786269618438039211977)
+  (num-test (/ -54987418627898620923060954379316763081930842855917193391807940070173620336071/17370345837184638879794373707261631548922174314274224219546763452439685451597 107349939397731511365417710412808670916754334908520065561311453951414109180973/7800708635318451621630266369706695626474649690647985662113853436261704078874) -428940831324519456770429889832838610542119304716244392653623661175655561457214418178921042544524225772650432309479656622489393939407340321261255371264054/1864705572939408818246392762570376592749103793151936455808919833872532407312841098160841844995663367019074328670998871082130543124576872890789577304863881)
+
+
+  (test (= -98781233389595723930250385525631360344437602649022271391716773162526352115087074898920261954897888235939429993829738630297052776667061779065100945771127020439712527398509771853491319737304616607041615012797134365574007368603232768089410097730646360760856052946465578073788924743642391638455649511108051053789425902013657106523269224045822294981391380222050223141347787674321888089837786284947870569165079491411110074602544203383038299901291952931113248943344436935596614205784436844912243069019367149526328612664067719765890897558075277707055756274228634652905751880612235340874976952880431555921814590049070979276358637989837532124647692152520447680373275200239544449293834424643702763974403094033892112967196087310232853165951285609426599617479356206218697586025251765476179158153123631158173662488102357611674821528467825910806391548770908013608889792001203039243914696463472490444573930050190716726220002151679336252008777326482398042427845860796285369622627679324605214987983884122808994422164327311297556122943400093231935477754959547620500784989043704825777186301417894825200797719289692636286337716705491307686644214213732116277102140558505945554566856673724837541141206267647285222293953181717113434757149921850120377706206012113994795124049471433490016083401216757825264766474891405185591236321448744678896448941259668731597494947127423662646933419809756274038044752395708014998820826196523041220918922611359697502638594907608648168849193813197790291360087857093790119162389573209640804111261616771827989939551840471235079945175327536638365874717775169210186608268924244639016270610098894971732892267642318266405837012482726627199088381027028630711279130575230815976484191675172279903609489448225149181063260231957171204855841611039996959582465138269247794842445177715476581512709861409446684911276158067098438009067149531119008707418601627426255891/2063950098473886055933596136103014753954685977787179797499441692283103642150668140884348149132839387663291870239435604463778573480782766958396423322880804442523056530013282118705429274303746421980903580754656364533869319744640130831962767797772323836293079599182477171562218297208495122660799328579852852969560730744211066545295945803939271680397511478811389399527913043145952054883289558914237172406636283114284363301999238526952309439259354223729114988806937903509692118585280437646676248013406270664905997291670857985754768850507766359973207600149782819306010561088246502918148146264806947375101624011387317921439210509902170092173796154464078297852707797984007992277904626058467143192149921546030028316990855470478894515952884526783686210401408859364838148201339959570732480920969000913791571631154267939054105878236201498477027265774680071188764947522112650857013491135901945605796776829525789886482760578142306057177990048751864852763036720112071475134369179525117161001517868525821398753039187062869247457336940152614866298628205010037695017885878296140891234142925514925051385440766473260338168038302226808098439763889250948602137806546736025439919604390464712793474019469457135856879584745805794574609707742445431851999335443724488636749987837445626810087003490329257105472274738811579817454656532496370562155449815456374456838912258383282154811001588175608617475540639254689723629881619252699580383612847920348111900440075645703960104081690968807839189109040568288972353424306876947127635585164905071821419089229871978994388197349499565628906992171901547121903117815637249359328193980583892566359962066242217169190169986105579733710057404319381685578470983838597020624234209884597110721892707818651210378187525863009879314177842634871978427592746452643603586344401223449546482306838947819060455178762434166799996220143825677025686435609179225302671777326568324855229172912876656233006785717920665743720753617646617017219230313226844735567400507490772935145894670445831971526014183234960075574401616682479457962912905141754252265169682318523572680657053374002911007741991220001444440319448034755483178790032581428679303588017268970 0) #f)
+
+  (num-test (/ 10105597264942543888.0 14352488138967388642.0) 5052798632471271944/7176244069483694321)
+  (num-test (/ -17631701977702695093.0 3931860028646338313.0) -17631701977702695093/3931860028646338313)
+  (num-test (/ -1606495881715082381.0 16324360910828438638.0) -1606495881715082381/16324360910828438638)
+  (num-test (/ -7960193178071300653.0 -10280747961248435844.0) 7960193178071300653/10280747961248435844)
+  (num-test (/ -11544909483975853384.0 -16041992360613233027.0) 11544909483975853384/16041992360613233027)
+  (num-test (/ -5758820541298901548.0 -2596462557714095861.0) 5758820541298901548/2596462557714095861)
+  (num-test (/ -13056342734667572546.0 46502284983183419157350605242474199851.0) -13056342734667572546/46502284983183419157350605242474199851)
+  (num-test (/ 12668118634717482325.0 -338544675918656078399121171905238525746.0) -12668118634717482325/338544675918656078399121171905238525746)
+  (num-test (/ -16738429327795346815.0 164053836541028518093058940786011794219.0) -16738429327795346815/164053836541028518093058940786011794219)
+  (num-test (/ -9884600460121235549.0 -53914696297933680001835530599748561584.0) 9884600460121235549/53914696297933680001835530599748561584)
+  (num-test (/ 6753521264659576004.0 71759828079371803409570464915096122874.0) 3376760632329788002/35879914039685901704785232457548061437)
+  (num-test (/ -6072478784520825268.0 83641961138289700975241455431547940418.0) -3036239392260412634/41820980569144850487620727715773970209)
+  (num-test (/ -6708950756971973620.0 -9847903810677323447803434015107261150885944735136350527205856921771320298384705376646797569973415403097847060539915279223391112430240736564839483430569706.0) 3354475378485986810/4923951905338661723901717007553630575442972367568175263602928460885660149192352688323398784986707701548923530269957639611695556215120368282419741715284853)
+  (num-test (/ 11263779860755455072.0 2292311486393743282743453705144070351222990311578446825826935237655927864700827857707370158936582804478427014131790879562565658386819339761919809732496450.0) 1877296643459242512/382051914398957213790575617524011725203831718596407804304489206275987977450137976284561693156097134079737835688631813260427609731136556626986634955416075)
+  (num-test (/ 9956488981426387585.0 -12351244248621474338537656633137999145154500022264356186225225426288301330225259889671144104952158102155582320296061124840400655528634050137479515338944145.0) -1991297796285277517/2470248849724294867707531326627599829030900004452871237245045085257660266045051977934228820990431620431116464059212224968080131105726810027495903067788829)
+  (num-test (/ -14875992781716065391.0 4906952781757522095285156014969507916562921709689447567404076064849249737893410245743456952512717420040816186768213920574809530298070437840356629617118643.0) -2125141825959437913/700993254536788870755022287852786845223274529955635366772010866407035676841915749391922421787531060005830883824030560082115647185438633977193804231016949)
+  (num-test (/ 16043178952268979636.0 -4962728781666935768923030490263743715131420507991284894489828489607808897271220927863958149140648859077934323268424257800724618076505149638049461104621679.0) -5347726317422993212/1654242927222311922974343496754581238377140169330428298163276163202602965757073642621319383046882953025978107756141419266908206025501716546016487034873893)
+  (num-test (/ -14889985628902581941.0 3075736124701105220602924325296812116294816310089906623707854625135862902005059305428034753787024827094954645083406870532379125275086885405969947540175361.0) -14889985628902581941/3075736124701105220602924325296812116294816310089906623707854625135862902005059305428034753787024827094954645083406870532379125275086885405969947540175361)
+  (num-test (/ -1719613957783789857.0 19860562547348050982501313785551054055826630539673708970554435103060535649825139319625648954889488501680865494719253019921780044205805557658109807483499994523398090829033362953135186523580359552555144614353929273831853529446536288544481045105104526669277307473478898498061888931858821517694257595658138564305517447595298378933983614114298000880741350618424855028965861930329619462261269994651112266861896630584883581092431090390354633458596611690990999635499563944625720180529318327647519405136188243979680965052005899543797270970540925042201315580510136864931200059448645464256385079735225156720340173280541113382758.0) -1719613957783789857/19860562547348050982501313785551054055826630539673708970554435103060535649825139319625648954889488501680865494719253019921780044205805557658109807483499994523398090829033362953135186523580359552555144614353929273831853529446536288544481045105104526669277307473478898498061888931858821517694257595658138564305517447595298378933983614114298000880741350618424855028965861930329619462261269994651112266861896630584883581092431090390354633458596611690990999635499563944625720180529318327647519405136188243979680965052005899543797270970540925042201315580510136864931200059448645464256385079735225156720340173280541113382758)
+  (num-test (/ -10969623867482498359.0 1292477254230352575769754773488799598312602810841892384475535212194939033905139960602724737178675944133847094464739764817257836826367652752931492512753561670732296265459534230949226553571982695924178928914002527460943582374603078611662312521259541641138419845784008028215876048965254023368247445173694441960256131358058174374542730502334351759171930973722361567186133851896057677818979314942434199157003833234473048838906103902832115569853657335216793235394595479328932380393044485884605451918890395812628720641212850763944658735838941829604119213195707479940053016354291972875689927240247563236506479099606571912595.0) -10969623867482498359/1292477254230352575769754773488799598312602810841892384475535212194939033905139960602724737178675944133847094464739764817257836826367652752931492512753561670732296265459534230949226553571982695924178928914002527460943582374603078611662312521259541641138419845784008028215876048965254023368247445173694441960256131358058174374542730502334351759171930973722361567186133851896057677818979314942434199157003833234473048838906103902832115569853657335216793235394595479328932380393044485884605451918890395812628720641212850763944658735838941829604119213195707479940053016354291972875689927240247563236506479099606571912595)
+  (num-test (/ -3716891004757979686.0 -19452372993227550502015765258932159656814363741878583541173956168837566077148160901999018823586675966076058615847408138956450751813058209394199427182041779436168298455103717521843644244801542056954603631432685194627158423459586845252167819811850263444712218938833443253125954475476481099092216538126519474183531297423759923656571895377587989169731023397615799830371852298135015608612181670362528239430952907458704415974164085176066242388561893721949244663406941558257051263727439679525692652639731850971185056484335828001005009903973037524233097329857690857731943951449292814500362180170793919266389501882641682782987.0) 3716891004757979686/19452372993227550502015765258932159656814363741878583541173956168837566077148160901999018823586675966076058615847408138956450751813058209394199427182041779436168298455103717521843644244801542056954603631432685194627158423459586845252167819811850263444712218938833443253125954475476481099092216538126519474183531297423759923656571895377587989169731023397615799830371852298135015608612181670362528239430952907458704415974164085176066242388561893721949244663406941558257051263727439679525692652639731850971185056484335828001005009903973037524233097329857690857731943951449292814500362180170793919266389501882641682782987)
+  (num-test (/ -4863232114852441787.0 -22963038454503597269981750990033903654256693514059439027985256604978917966584414065892146187253799108250061573972673983350956191446047978392921074610323648301008272837432907303975548030552369880338022067315042332692023645592417869181836251486577977896077712912433381480614752789750181208326525834629219729662085632321271870762094800588296544243340047360684854239747242066367921596241226349790282723168222543448385227922748241223520686047460119733024390425165073367321644498280127168757335614077882325524816799960018589278475564547840614315473357481582710826551932681173443524724802157570101916268510464302946527662720.0) 4863232114852441787/22963038454503597269981750990033903654256693514059439027985256604978917966584414065892146187253799108250061573972673983350956191446047978392921074610323648301008272837432907303975548030552369880338022067315042332692023645592417869181836251486577977896077712912433381480614752789750181208326525834629219729662085632321271870762094800588296544243340047360684854239747242066367921596241226349790282723168222543448385227922748241223520686047460119733024390425165073367321644498280127168757335614077882325524816799960018589278475564547840614315473357481582710826551932681173443524724802157570101916268510464302946527662720)
+  (num-test (/ -16248276650501285553.0 -3381199474840825715485713565301777938368574604710714363907009216856320913536015299178065264912798511857598595067318796576494480424838898250138649774858742984769125731728430552285782315111538920026330816414650913188340281906359149109963139438960274321560117812365241840204034925444652058916966934904097509799291744775242863360284348334605170437300543978049053839829106628489146216325576991696936733592366926096500684308845306493636196092408597450926695579897293944488261001228478152650490677071497874746121221519036861983646423005753475340900508665494162949119110128646472783016552527735050067363030838015919512260159.0) 16248276650501285553/3381199474840825715485713565301777938368574604710714363907009216856320913536015299178065264912798511857598595067318796576494480424838898250138649774858742984769125731728430552285782315111538920026330816414650913188340281906359149109963139438960274321560117812365241840204034925444652058916966934904097509799291744775242863360284348334605170437300543978049053839829106628489146216325576991696936733592366926096500684308845306493636196092408597450926695579897293944488261001228478152650490677071497874746121221519036861983646423005753475340900508665494162949119110128646472783016552527735050067363030838015919512260159)
+  (num-test (/ 18296946401228630959.0 3302341071702763311560113831030141639804425031433511503765833897787925467295486187687396312611805794369889470239777040624530990622212474466940548049117664906468330871893337410618797113677420975837622378808494314918471282099855916016026079371666730617071364751834080179173620476977670099126230223862266413091012344741482772771219725893630556702028108027870656512750807359335108428687238687397060104669074315031780019301768744978815422943986587389425726602444937024004102212071953113581935989741954695450085391443134273670514145585869912689150728183940456773133212037846765421397201956541430155664614978559762638030787.0) 494512064898071107/89252461397371981393516590027841665940660135984689500101779294534808796413391518586145846286805562009997012709183163260122459206005742553160555352678855808282927861402522632719426949018308675022638442670499846349147872489185295027460164307342344070731658506806326491329016769648045137814222438482763957110567901209229264128951884483611636667622381298050558284128400198900948876451006451010731354180245251757615676197345101215643660079567205064579073691957971270919029789515458192258971242965998775552705010579544169558662544475293781424031100761728120453327924649671534200578302755582200815017962566988101692919751)
+  (num-test (/ -60488682170925814337492051725122486652.0 14880088785789146426.0) -30244341085462907168746025862561243326/7440044392894573213)
+  (num-test (/ 126617729996196635247771282957911941277.0 -7166506344996883172.0) -126617729996196635247771282957911941277/7166506344996883172)
+  (num-test (/ -278675896803726074870988122161067771390.0 7744689831802931490.0) -27867589680372607487098812216106777139/774468983180293149)
+  (num-test (/ -283351838662873779255871649630248958879.0 6912311315831153835.0) -14913254666467041013466928927907839941/363805858727955465)
+  (num-test (/ -9715584046609700027352634666499181378.0 3368831995960494221.0) -9715584046609700027352634666499181378/3368831995960494221)
+  (num-test (/ -137493547985106345282009151869389470397.0 -1916381539906956855.0) 137493547985106345282009151869389470397/1916381539906956855)
+  (num-test (/ -328662747577960331872949773416436800743.0 -231069430804205460334599495337085157308.0) 328662747577960331872949773416436800743/231069430804205460334599495337085157308)
+  (num-test (/ 213595640581249636406536485951630735277.0 -48492294677143227478357598229530842959.0) -213595640581249636406536485951630735277/48492294677143227478357598229530842959)
+  (num-test (/ 85922846498729014445816145204889624189.0 193533957681757355413031965695625196813.0) 85922846498729014445816145204889624189/193533957681757355413031965695625196813)
+  (num-test (/ 24053342958857142686054803491202486471.0 196417511107100936775397820630955772553.0) 24053342958857142686054803491202486471/196417511107100936775397820630955772553)
+  (num-test (/ 102038936612518756467074084117019701214.0 -111946989731587760700903475996379168167.0) -102038936612518756467074084117019701214/111946989731587760700903475996379168167)
+  (num-test (/ -3006867214208872584699983438179656913.0 -234257597822744479264249663225224173340.0) 3006867214208872584699983438179656913/234257597822744479264249663225224173340)
+  (num-test (/ -279839802710533516603863620922251878907.0 -3244112647743502769852782626803305310331045534071805654982307107362388474314396636799597033636575215617240554815450017779373048313695795886893032630263219.0) 279839802710533516603863620922251878907/3244112647743502769852782626803305310331045534071805654982307107362388474314396636799597033636575215617240554815450017779373048313695795886893032630263219)
+  (num-test (/ 123635964546481689465778244982425098404.0 7701433613491146708866098469269971554817017737111287276993583150548359764165526640986060909954451793171933304569726872785964805121981749276421956645830854.0) 61817982273240844732889122491212549202/3850716806745573354433049234634985777408508868555643638496791575274179882082763320493030454977225896585966652284863436392982402560990874638210978322915427)
+  (num-test (/ 166158110049010486343321316578688184578.0 4093720847216792748840371965199135052196058344862447621818024731938681519017878880275303125899149558774718190527651555811733139227128378041055212888819294.0) 83079055024505243171660658289344092289/2046860423608396374420185982599567526098029172431223810909012365969340759508939440137651562949574779387359095263825777905866569613564189020527606444409647)
+  (num-test (/ 147416259636838312272435267341375281181.0 -11266711292262839805944890501811605204323255169233519804446548849178247889563130015168799346120099052214488209897402054530713234143622703174309015777885801.0) -147416259636838312272435267341375281181/11266711292262839805944890501811605204323255169233519804446548849178247889563130015168799346120099052214488209897402054530713234143622703174309015777885801)
+  (num-test (/ 102557200511608632541115941654031896919.0 3866177549962722728707550488877109233779215384377007088712280650225992470307822792085413087509167847767889824884877044539352696974351192629898363157976511.0) 102557200511608632541115941654031896919/3866177549962722728707550488877109233779215384377007088712280650225992470307822792085413087509167847767889824884877044539352696974351192629898363157976511)
+  (num-test (/ 47794953079190110032282671989549362415.0 3802290983508829335098916118339496411537222492645529399519373082799614656011270200284796148989094312601047370399228868583158444769807910513767845541589667.0) 47794953079190110032282671989549362415/3802290983508829335098916118339496411537222492645529399519373082799614656011270200284796148989094312601047370399228868583158444769807910513767845541589667)
+  (num-test (/ -169956065319483471022234920202991103615.0 -9934427489865644196610501807375648335352544234206717324511161205173460054921759084767897792996557220898467288533128078406604709773449948420404563411793533441010236017064154469575084055359823982786110746700747423674942932421964955746280671982635899487781780756099620799397239156211815110739544719746684712086075069101799537802834839550142629064374734870047412916259754010150500874430055034366305216104752636211802195447299210332237598443674867760860326529472901775427058078447963316168327741049511844237329137194533000697525539835371015163158135757326482343130221118201740819963770851200676279882978581431999960842565.0) 33991213063896694204446984040598220723/1986885497973128839322100361475129667070508846841343464902232241034692010984351816953579558599311444179693457706625615681320941954689989684080912682358706688202047203412830893915016811071964796557222149340149484734988586484392991149256134396527179897556356151219924159879447831242363022147908943949336942417215013820359907560566967910028525812874946974009482583251950802030100174886011006873261043220950527242360439089459842066447519688734973552172065305894580355085411615689592663233665548209902368847465827438906600139505107967074203032631627151465296468626044223640348163992754170240135255976595716286399992168513)
+  (num-test (/ -83006311763073652927964071041666508273.0 13480787677843057038436344704360462056114592749322481662307876594244244638227291805757775026215166740035048814729231681821563443093991755779505400592913963236010573873554317250153995160235771659208137440518282824497744092608999871327127239673370293239927529076145825972430101380272357235582367639159280348164804218713823424182167974242317526959809443701996053548231667727254858428867000011055354779789221097183515832386890638024105232865079002765479933320220378271026425568216748186200736499581088153390350474814123049637951929317200314355414551809067125550551841102097159644340520444983020267926123546444838010089690.0) -83006311763073652927964071041666508273/13480787677843057038436344704360462056114592749322481662307876594244244638227291805757775026215166740035048814729231681821563443093991755779505400592913963236010573873554317250153995160235771659208137440518282824497744092608999871327127239673370293239927529076145825972430101380272357235582367639159280348164804218713823424182167974242317526959809443701996053548231667727254858428867000011055354779789221097183515832386890638024105232865079002765479933320220378271026425568216748186200736499581088153390350474814123049637951929317200314355414551809067125550551841102097159644340520444983020267926123546444838010089690)
+  (num-test (/ -312626207169475064151212222217866488926.0 6989069923898656093413456232544365450599471748502878018530391549015151484336014906416216966193568842618920902504390187814247729346977677905224098932673981665869061845335443588666641982676550205160521286690015544764015602751932938178737949961754714143180917985455875095030469699198116593730005119922928175789172042067281849364217595912265452199938281052984802042194034638773435768458457616208103331213440768472281882976004050012769415198321241810008696147179275528426468408383757692656341606162350211696837361434874035354680073309142183699892959618671515841112321607728427286289324836870027735590091451421689980776552.0) -52104367861579177358535370369644414821/1164844987316442682235576038757394241766578624750479669755065258169191914056002484402702827698928140436486817084065031302374621557829612984204016488778996944311510307555907264777773663779425034193420214448335924127335933791988823029789658326959119023863486330909312515838411616533019432288334186653821362631528673677880308227369599318710908699989713508830800340365672439795572628076409602701350555202240128078713647162667341668794902533053540301668116024529879254737744734730626282109390267693725035282806226905812339225780012218190363949982159936445252640185386934621404547714887472811671289265015241903614996796092)
+  (num-test (/ -151709660794612786408772973806200383563.0 -26960472721919005254400858042130056790831511338891584787669209989714807518625849812230185079206081782191501696661436514815190623849929065098497737155759771863508038766934134444191240792356114381746781342181881402424707118515655119761011977116554236461222788625158348668147995099157685699761135150772589445239536582228655532345059046596356954495360132444243748421428095867292294626357084961338288369883088525401649234025290736504802104065029036642533076183281468647642956623788270236516849523210698622687255735945678505925047193818483603361307498423724202227256505312543145618362906047473400380196192622607541097732443.0) 151709660794612786408772973806200383563/26960472721919005254400858042130056790831511338891584787669209989714807518625849812230185079206081782191501696661436514815190623849929065098497737155759771863508038766934134444191240792356114381746781342181881402424707118515655119761011977116554236461222788625158348668147995099157685699761135150772589445239536582228655532345059046596356954495360132444243748421428095867292294626357084961338288369883088525401649234025290736504802104065029036642533076183281468647642956623788270236516849523210698622687255735945678505925047193818483603361307498423724202227256505312543145618362906047473400380196192622607541097732443)
+  (num-test (/ 138834496986391136939574372853300933725.0 -8052690543272184576133758511645801940246473546142520821850130421981395129853341888352999304040698251945886555605291324954368612109314080471658982022831338507499254609048475429862437003158379101603576571787302167207044118847876475134352180874260998595377014195145760071923429129767580115085764485254455919915567128572731355497418831212259648020550107573824886521471697331410754043280744066090848295906051303624846301488010249980896364883452154860562864255354208802313850527991005497484253401461375477060954782095047043919500670383372218536999834862885439984085848342867301834247551832677237328664699302165347765799113.0) -15426055220710126326619374761477881525/894743393696909397348195390182866882249608171793613424650014491331266125539260209816999922671188694660654061733921258328263179123257120052406553558092370945277694956560941714429159667017597677955952952420811351911893790983097386126039131208251222066153001577238417785769269903307508901676196053917161768879507458730303483944157647912473294224505567508202765169052410814601194893697860451787872032878450144847205144609778916664544040542605794984506984917261578755812650058665667277498250377940152830784550531343894115991055630042596913170777759429209493331565094260318589092694172425853026369851633255796149751755457)
+  (num-test (/ 276499207940187081393841843387608369874.0 27347897028734618663428054896349668572244941195143856840032842195489553215406302254043947382368793914074147314353589439281000471813879502242851166670252197853998033813694814376228360691543987661407996785043637351295817024680721181205269262470473172181965930243852520386958529041036476807810647578694133804796395977642274699322030062940721165202488695975750512485574440928370802874677938542169620505668128224812441566912043326338714451629730522324228356364241376445033028898865300103247057378058702233150414643818049655628999871012383236520330575609745427181485617250755214922048672375947942288446974485524776744246517.0) 8919329288393131657865865915729302254/882190226733374795594453383753215115233707780488511510968801361144824297271171040453030560721573997228198300463019014170354853929479983943317779570008135414645097864957897237942850344888515731013161186614310882299865065312281328425976427821628166844579546136898468399579307388420531509929375728344972058219238579923944345139420324610991005329112538579862919757599175513818412995957352856199020016311875104026207792481033655688345627471926791042717043753685205691775258996737590325911195399292216201069368214316711279213838705516528491500655825019669207328435019911314684352324150721804772331885386273726605701427307)
+  (num-test (/ -8979365591106781219797187096315899769868799444656824967426553299158070014074001230883484015880186603742048949313393413640240595706939311540002219411120389.0 -1698360947072008877.0) 1282766513015254459971026728045128538552685634950974995346650471308295716296285890126212002268598086248864135616199059091462942243848473077143174201588627/242622992438858411)
+  (num-test (/ -12831814656788829919185319784994714617782749504716966706877579983082880759985031662545957372565411439648298939198657738497464024214657609856476819270030801.0 454910754379715.0) -273017333123166594025219569893504566335803180951424823550586808150699590637979397075445901543944924247836147642524632733988596259886332124605889771702783/9678952220845)
+  (num-test (/ -7834266257250691217409788323211914445703052638619784568844628449769010091330019095736167988675873769434766592786720961949649685040028101508217441360672222.0 -428418418877192732.0) 3917133128625345608704894161605957222851526319309892284422314224884505045665009547868083994337936884717383296393360480974824842520014050754108720680336111/214209209438596366)
+  (num-test (/ -4001605821592542867351046644170905984672346731784670159062281252096012802838642896466582343641124674682428297533953704119505640938363392225910275838094045.0 15760991890495426717.0) -4001605821592542867351046644170905984672346731784670159062281252096012802838642896466582343641124674682428297533953704119505640938363392225910275838094045/15760991890495426717)
+  (num-test (/ 2876630161532936743269451364955814480771395635620140205538288339793482694260173239474830738010159518887660000673207712630507802368373928478641773477534499.0 -6788234478844960330.0) -2876630161532936743269451364955814480771395635620140205538288339793482694260173239474830738010159518887660000673207712630507802368373928478641773477534499/6788234478844960330)
+  (num-test (/ 6230070442453337264527950102774203962152836811174649694700041895216739851602598854067104967963392074425258687296947909484969927078206601660837276754799333.0 190237375887614033974333796608341639595.0) 6230070442453337264527950102774203962152836811174649694700041895216739851602598854067104967963392074425258687296947909484969927078206601660837276754799333/190237375887614033974333796608341639595)
+  (num-test (/ -12098771374444180013224380531550204930654718468097503123335711776524055419889032578894177605164827523969169377266342179411916625188550162928371789854647472.0 -41681385674896602840749705069663453185.0) 12098771374444180013224380531550204930654718468097503123335711776524055419889032578894177605164827523969169377266342179411916625188550162928371789854647472/41681385674896602840749705069663453185)
+  (num-test (/ 13185465843955116174925558412278612918939024395488172088108029202384613698982949554556435640011161663974075894844304583900497170806796813871943782330552768.0 -155202352609947911537719051033334010254.0) -6592732921977558087462779206139306459469512197744086044054014601192306849491474777278217820005580831987037947422152291950248585403398406935971891165276384/77601176304973955768859525516667005127)
+  (num-test (/ 12784980722915659825738808684740823452025110516624579136271791852138148426775553817114893299569867520414470532361018804123866264934222335562072872489963044.0 -249441012384365373362771955533424187237.0) -12784980722915659825738808684740823452025110516624579136271791852138148426775553817114893299569867520414470532361018804123866264934222335562072872489963044/249441012384365373362771955533424187237)
+  (num-test (/ 8517839393030302736298983538193047531846908718502576675615969705563208303329257882565359266876007571790337440612227785062203468682754778416335180236967433.0 -23101645464137481399279134347982485126.0) -8517839393030302736298983538193047531846908718502576675615969705563208303329257882565359266876007571790337440612227785062203468682754778416335180236967433/23101645464137481399279134347982485126)
+  (num-test (/ -10157767522292361462005308817460390811646115952647174687477824271227382383351453540195549992670001314693794150879368708343715654899952822395459036505947192.0 -25611473771508763579433379623726126173.0) 10157767522292361462005308817460390811646115952647174687477824271227382383351453540195549992670001314693794150879368708343715654899952822395459036505947192/25611473771508763579433379623726126173)
+  (num-test (/ -8580252632668820290302987230726290672170301642399871646484841866604753910447257372311950907045477729554307803379310475132687855999835211879267570997069974.0 5347050029330174629945013741349819215851040371727058829687387719215168997632386672310746837193930669173408831178932364105722911104309540550576485594530627.0) -8580252632668820290302987230726290672170301642399871646484841866604753910447257372311950907045477729554307803379310475132687855999835211879267570997069974/5347050029330174629945013741349819215851040371727058829687387719215168997632386672310746837193930669173408831178932364105722911104309540550576485594530627)
+  (num-test (/ 7706102251141221799524762336156378964168657337573751909064577951085535246905735244239132983582998872001001594454632956803416956154262109939446710205558308.0 6334400709835247308796432875490978646658012545184955441452799118298109610816693049400832749087993843490999852355789914065232784070007399786089389453289854.0) 3853051125570610899762381168078189482084328668786875954532288975542767623452867622119566491791499436000500797227316478401708478077131054969723355102779154/3167200354917623654398216437745489323329006272592477720726399559149054805408346524700416374543996921745499926177894957032616392035003699893044694726644927)
+  (num-test (/ 12609622044672092190084693450911157599596799695538449568681964257744962273690941575572590166273187189250007688411096790312605666562908125521094386992971478.0 -8237858212652788898158635047388584411011830102060269605835391741772914864422465141467281143809161251942948659243584296367296559912373856433388249393853968.0) -6304811022336046095042346725455578799798399847769224784340982128872481136845470787786295083136593594625003844205548395156302833281454062760547193496485739/4118929106326394449079317523694292205505915051030134802917695870886457432211232570733640571904580625971474329621792148183648279956186928216694124696926984)
+  (num-test (/ -9988492519236282081446302885464711911055350309732728352574982611126604133339499170845224383282665522673248920309221355720665956477799939031063172954469785.0 -1878204914631111607000020160429571305542722711529281855381736226230242796648854769713662269068364131804626863789957256573308715572826753755672493154125086.0) 9988492519236282081446302885464711911055350309732728352574982611126604133339499170845224383282665522673248920309221355720665956477799939031063172954469785/1878204914631111607000020160429571305542722711529281855381736226230242796648854769713662269068364131804626863789957256573308715572826753755672493154125086))
+
+(let ((val1 (catch #t (lambda () (/ 1.0 0.0)) (lambda args 'error)))
+      (val2 (catch #t (lambda () (/ 1.0 -0.0)) (lambda args 'error))))
+  (test (equal? val1 val2) #t))
+
+(test (/ "hi") 'error)
+(test (/ -0) 'error)
+(test (/ 0) 'error)
+(test (/ 0.0) 'error)
+(test (/ 1.0 0) 'error)
+(test (/) 'error)
+(test (/ 0/3) 'error)
+(test (/ 0 1 "hi") 'error)
+(test (/ 2/3 0) 'error)
+(test (/ 0 0) 'error)
+(test (/ 1 0) 'error)
+(test (/ 0 0.0) 'error)
+(test (/ 1 0.0) 'error)
+(test (/ 0.0 0.0) 'error)
+(test (/ 1.0 0.0) 'error)
+(test (/ 0 1 2 3 0 4) 'error)
+(test (/ 0.0 1 2.0 3 0.0 4) 'error)
+(let ((NaN 1/0)) (test (nan? (/ 0 1 NaN 2 3)) #t))
+(let ((NaN 1/0)) (test (nan? (/ 0.0 1.0 NaN 1+i)) #t))
+(test (/ 1/9223372036854775807 0) 'error)
+(test (/ 1/9223372036854775807 0.0) 'error)
+(when with-bignums
+  (test (/ (bignum 1.0) (bignum 0)) 'error)
+  (test (/ (bignum 1.0) (bignum -0.0)) 'error)
+  (test (/ 9223372036854775807123123123 0) 'error))
+
+(catch #t (lambda () (/ 1 #())) (lambda (type info) (test (apply format #f info) "/ second argument, #(), is a vector but should be a number")))
+(catch #t (lambda () (/ #() 1)) (lambda (type info) (test (apply format #f info) "/ first argument, #(), is a vector but should be a number")))
+(catch #t (lambda () (/ 1 2 #())) (lambda (type info) (test (apply format #f info) "/ third argument, #(), is a vector but should be a number")))
+(catch #t (lambda () (/ 1 2 3 #())) (lambda (type info) (test (apply format #f info) "/ fourth argument, #(), is a vector but should be a number")))
+
+(for-each
+ (lambda (arg)
+   (test (/ arg +nan.0) 'error)
+   (test (/ +nan.0 arg) 'error)
+   (test (/ arg +inf.0) 'error)
+   (test (/ +inf.0 arg) 'error)
+   (test (/ 0 arg +nan.0) 'error)
+   (test (/ +nan.0 0 arg) 'error)
+   (test (/ arg +inf.0 0) 'error)
+   (test (/ 0 +inf.0 arg) 'error)
+   (test (/ 0 arg) 'error)
+   (test (/ 0.0 arg) 'error)
+   (test (/ 1/2 arg) 'error)
+   (test (/ 1+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(test (nan? (/ 0 +nan.0)) #t)
+(test (zero? (/ 0 +inf.0)) #t)
+(test (zero? (/ 3 +inf.0)) #t)
+(test (negative? (/ +inf.0 2.0)) #f)
+(test (negative? (/ +inf.0 -2.0)) #t)
+(test (negative? (/ -inf.0 2)) #t)
+(test (negative? (/ -inf.0 -2)) #f)
+(test (negative? (/ +inf.0 -2)) #t)
+(test (nan? (/ +nan.0)) #t)
+(test (/ +inf.0) 0.0)
+(num-test (/ -inf.0) 0.0)
+
+(for-each
+ (lambda (arg)
+   (test (/ arg) 'error))
+ (list "hi" () (integer->char 65) 0 0.0 0+0i -0.0 -0 0-0i #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+       #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(test (immutable? (/ 1.0 +nan.0)) #t)
+(test (let () (define (func) (immutable? (/ 1.0 +nan.0))) (define (hi) (func)) (hi)) #t)
+
+;;; from guile irc
+(test (boolean? (let ((x (/ 1e-300 1e8))) x)) #f)
+
+(when with-bignums
+  (let-temporarily (((*s7* 'bignum-precision) 512))
+    (let* ((rats (map bignum
+                   (list 2/3
+		         5/8
+		         12/19
+		         53/84
+		         253/401
+		         665/1054
+		         12941/20511
+		         15601/24727
+		         79335/125743
+		         190537/301994
+		         7161071/11350029
+		         10400200/16483927
+		         10781274/17087915
+		         53715833/85137581
+		         171928773/272500658
+		         397573379/630138897
+		         4201378396/6659027209
+		         6189245291/9809721694
+		         6586818670/10439860591
+		         65470613321/103768467013
+		         137528045312/217976794617
+		         615582794569/975675645481
+		         753110839881/1193652440098
+		         5409303924479/8573543875303
+		         11571718688839/18340740190704
+		         52449289519716/83130157078217
+		         326267455807135/517121682660006
+		         483615324366283/766512153894657
+		         3816473305410548/6048967074079039
+		         6234549927241963/9881527843552324
+		         111738283365989051/177100989030047175
+		         130441933147714940/206745572560704147
+		         397560349370386783/630118245525664765
+		         3447601211185766107/5464318637170278738
+		         4640282259296926456/7354673373747273033
+		         22803850947114245497/36143248623210700400
+		         50247984153525417450/79641170620168673833
+		         205632218873398596256/325919355854421968365
+		         5680010011095224105765/9002602871306688466954
+		         7530699980955811472069/11935877073996486182239
+		         23414628818361028801231/37111308645407146420177
+		         31150961018190238869556/49373105075258054570781
+		         1534133422091150914676569/2431543945117495582118873
+		         1721039188200292347893905/2727782575569043909543559
+		         3473229337418774934657366/5504938256213345873657899
+		         154574280995644579711687565/244994438954031520405061896
+		         171940427682738454384974395/272519130235098249773351391
+		         522767741723052913024237917/828567267217721441067369971
+		         2438425051595107335801557824/3864812267597295609689840565
+		         8360810638231427833453149306/13251571337227329711204261637
+		         25605199656417336413383685835/40583281278899710574680154882
+		         62532402744384260909046316717/99111513429841767911321781937
+		         201880404458020531058243690939/319972870696382667546684028520
+		         378155609259623725703103696043/599362460113865624518687902158
+		         2180796053156940756896192173706/3456479965974452268626125476129
+		         30909300353456794322249794127927/48990081983756197385284444567964
+		         72722580972698292428980549124384/115262563797384656113699516516573
+		         253438635377865553122983825848491/401690733307859070263635245069941
+		         579599851728429398674948200821366/918644030413102796640970006656455
+		         2391121987886415887128773352409848/3789838685449795842677579543142393
+		         8658726883466670304288180833845151/13723757414280836847692013404326603
+		         13440970859239502078545727538664847/21303434785180428533047172490611389
+		         42714034565604922122765955968404389/67700143040991081441819097014976560
+		         114701132837575264289752140366548320/181796994337792815792410118554318291
+		         845621964428631772151030938534242629/1340279103405540791988689926895204597
+		         960323097266207036440783078900790949/1522076097743333607781100045449522888
+		         6836962813701024519375233692672084963/10836329678541128070260110436700978507
+		         14634248724668256075191250464244960875/23194735454825589748301320918851479902
+		         51700032084971999781389768164307758537/81942612140761230922945173238704941101
+		         229231662975523486756566339893048870935/363323589794154975118123224355821745701
+		         724760772286874203975897537379209410467/1148718646068400566529013525387318698302
+		         1360755729128472664464206788894048264735/2156746803310104260960438025216078994304
+		         6167783688800764861832724692955402469407/9775705859308817610370765626251634675518
+		         28435404464167678210479364512746335244699/45069049768544731377148664330740395536983
+		         34603188152968443072312089205701737714106/54844755627853548987519429956992030212501
+		         144580536300674537151081081515762353325831/229154728370723013560448485454219755525522
+		         792109057809309571900029585990215242057367/1255463153109322165777281287185082838052612
+		         1907982376372936661174533424217656928480502/3024080518587943907662978975235597217368769
+		         27503862327030422828343497525037412240784395/43592590413340536873058986940483443881215378
+		         31319827079776296150692564373472726097745399/49640751450516424688384944890954638315952916
+		         221146771934807009716022484038526739612698295/350509340672202916726357593211918065429039181
+		         252466599014583305866715048411999465710443694/400150092122719341414742538102872703744992097
+		         2555985817225609354817843048493467383202182339/4051141672677709838835810325919681675765873886
+		         2808452416240192660684558096905466848912626033/4451291764800429180250552864022554379510865983
+		         50299676893308884586455330695886403814716824900/79723101674285005903095209014303106127450595597
+		         72767296223230425871931795471130138606017833164/115333435792688439345099631926483541163537523461
+		         148343044862701044404548149039165744060948292361/235118163350177307870449816716989636706585912905
+		         590563727034563984957508038059757509394880543411/936021361635908802301548714003935992446832785637
+		         1550580840017760484596044169668976645517675504708/2457612485764860659689096693368334799470374920545
+		         26950438007336492223090258922432360483195364123447/42715433619638540017016192501265627583443206434902
+		       )))
+	   (fifth (/ (log (bignum "2.0")) (log (bignum "3.0"))))
+	   (c-fifth (complex fifth fifth))
+	   (p-fifth (make-polar (* (sqrt 2.0) fifth) (/ pi 4)))
+	   (last-rat 26950438007336492223090258922432360483195364123447/42715433619638540017016192501265627583443206434902))
+      (for-each
+       (lambda (a b)
+	 (if (not (< (abs (- b fifth)) (abs (- a fifth))))
+	     (format #t ";fifth: ~A is not better than ~A??~%" b a))
+	 (if (not (< (magnitude (- (complex b b) c-fifth)) (magnitude (- (complex a a) c-fifth))))
+	     (format #t ";rectangular fifth: ~A is not better than ~A??~%" b a))
+	 (let ((pa (make-polar (* (sqrt 2.0) a) (/ pi 4)))
+	       (pb (make-polar (* (sqrt 2.0) b) (/ pi 4))))
+	   (if (not (< (magnitude (- pb p-fifth)) (magnitude (- pa p-fifth))))
+	       (format #t ";polar fifth: ~A is not better than ~A??~%" b a)))
+	 (if (not (< (abs (- b last-rat)) (abs (- a last-rat))))
+	     (format #t ";- last: ~A is not better than ~A??~%" b a))
+	 (if (not (< (magnitude (sqrt (- b last-rat))) (magnitude (sqrt (- a last-rat)))))
+	     (format #t ";sqrt last: ~A is not better than ~A??~%" b a)))
+       rats (cdr rats)))))
+
+(if with-bignums
+    (num-test (- 2 (* 3796553736732654909229441/2684568892382786771291329 3796553736732654909229441/2684568892382786771291329)) 1/7206910137949342581102166717750576215502190586241))
+
+(test (catch #t (lambda () (/ 1 0)) (lambda (type info) (apply format #f info))) "/: division by zero, (/ 1 0)")
+(test (catch #t (lambda () (quotient 1.5 0.0)) (lambda (type info) (apply format #f info))) "quotient: division by zero, (quotient 1.5 0.0)")
+(test (catch #t (lambda () (remainder 4.1 0)) (lambda (type info) (apply format #f info))) "remainder: division by zero, (remainder 4.1 0)")
+(test (catch #t (lambda () (/ 0)) (lambda (type info) (apply format #f info))) "/: division by zero, (/ 0)")
+(test (catch #t (lambda () (/ 1.0 0.0)) (lambda (type info) (apply format #f info))) "/: division by zero, (/ 1.0 0.0)")
+(test (catch #t (lambda () (/ 0.0)) (lambda (type info) (apply format #f info))) "/: division by zero, (/ 0.0)")
+(test (catch #t (lambda () (expt 0 -1)) (lambda (type info) (apply format #f info))) "expt: division by zero, (expt 0 -1)")
+(test (catch #t (lambda () (expt 0.0 -123)) (lambda (type info) (apply format #f info))) "expt: division by zero, (expt 0.0 -123)")
+(let () ; try to hit make_ratio_with_div_check
+  (define (g) (do ((i 0 (+ i 1))) ((= i 1)) (display (/ 1 i))))
+  (test (catch #t (lambda () (g)) (lambda (type info) (apply format #f info))) "/: division by zero, (/ 1 0)"))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; random
+;;; --------------------------------------------------------------------------------
+
+(let ()
+  (define (v n range chker) ; chi^2 or mus-random
+    (let ((hits (make-vector 100 0)))
+      (do ((i 0 (+ 1 i )))
+	  ((= i n))
+	(let ((y (random range)))
+	  (if (not (chker y))
+	      (format #t ";(random ~A) -> ~A?~%" range y))
+	  (let ((iy (min 99 (floor (* 100 (/ y range))))))
+	    (vector-set! hits iy (+ 1 (vector-ref hits iy))))))
+      (let ((sum 0.0)
+	    (p (/ n 100.0)))
+	(do ((i 0 (+ 1 i)))
+	    ((= i 100) sum)
+	  (let ((num (- (vector-ref hits i) p)))
+	    (set! sum (+ sum (/ (* num num) p))))))))
+
+  (num-test (random 0) 0)
+  (num-test (random 0.0) 0.0)
+
+  (let ()
+    (define (rtest) (- (random 2.0) 1.0))
+    (do ((i 0 (+ i 1)))
+	((= i 100))
+      (let ((val (rtest)))
+	(if (or (> val 1.0)
+		(< val -1.0))
+	    (format #t "(- (random 2.0) 1.0): ~A~%" i val)))))
+
+  (let ((vr (v 1000
+	       1.0
+	       (lambda (val)
+		 (and (real? val)
+		      (not (negative? val))
+		      (<= val 1.0))))))
+    (if (or (< vr 40)
+	    (> vr 400))
+	(format #t ";(random 1.0) not so random? ~A~%" vr)))
+
+  (let ((vr (v 1000
+	       100
+	       (lambda (val)
+		 (and (integer? val)
+		      (not (negative? val))
+		      (<= val 100))))))
+    (if (or (< vr 40)
+	    (> vr 400))
+	(format #t ";(random 100) not so random? ~A~%" vr)))
+
+  (let ((vr (v 1000
+	       1/2
+	       (lambda (val)
+		 (and (rational? val)
+		      (not (negative? val))
+		      (<= val 1/2))))))
+    (if (or (< vr 40)
+	    (> vr 400))
+	(format #t ";(random 1/2) not so random? ~A~%" vr)))
+
+  (let ((vr (v 1000
+	       -10.0
+	       (lambda (val)
+		 (and (real? val)
+		      (not (positive? val))
+		      (>= val -10.0))))))
+    (if (or (< vr 40)
+	    (> vr 400))
+	(format #t ";(random -10.0) not so random? ~A~%" vr)))
+
+  (let ((imax 0.0)
+	(rmax 0.0)
+	(imin 100.0)
+	(rmin 100.0))
+    (do ((i 0 (+ i 1)))
+	((= i 100))
+      (let ((val (random 1+i)))
+	(set! imax (max imax (imag-part val)))
+	(set! imin (min imin (imag-part val)))
+	(set! rmax (max rmax (real-part val)))
+	(set! rmin (min rmin (real-part val)))))
+    (if (or (> imax 1.0)
+	    (< imin 0.0)
+	    (> rmax 1.0)
+	    (< rmin 0.0)
+	    (< rmax 0.001)
+	    (< imax 0.001))
+	(format #t ";(random 1+i): ~A ~A ~A ~A~%" rmin rmax imin imax)))
+
+  (let ((imax 0.0)
+	(rmax 0.0)
+	(imin 100.0)
+	(rmin 100.0))
+    (do ((i 0 (+ i 1)))
+	((= i 100))
+      (let ((val (random 0+i)))
+	(set! imax (max imax (imag-part val)))
+	(set! imin (min imin (imag-part val)))
+	(set! rmax (max rmax (real-part val)))
+	(set! rmin (min rmin (real-part val)))))
+    (if (or (> imax 1.0)
+	    (< imin 0.0)
+	    (> rmax 0.0)
+	    (< rmin 0.0)
+	    (< imax 0.001))
+	(format #t ";(random 0+i): ~A ~A ~A ~A~%" rmin rmax imin imax)))
+
+  (let ((imax 0.0)
+	(rmax 0.0)
+	(imin 100.0)
+	(rmin 100.0))
+    (do ((i 0 (+ i 1)))
+	((= i 100))
+      (let ((val (random 10.0+100.0i)))
+	(set! imax (max imax (imag-part val)))
+	(set! imin (min imin (imag-part val)))
+	(set! rmax (max rmax (real-part val)))
+	(set! rmin (min rmin (real-part val)))))
+    (if (or (> imax 100.0)
+	    (< imin 0.0)
+	    (> rmax 10.0)
+	    (< rmin 0.0)
+	    (< imax 0.1)
+	    (< rmax 0.01))
+	(format #t ";(random 100+10i): ~A ~A ~A ~A~%" rmin rmax imin imax)))
+
+
+  (do ((i 0 (+ i 1)))
+      ((= i 100))
+    (let ((val (random 1.0+1.0i)))
+      (if (or (not (complex? val))
+	      (> (real-part val) 1.0)
+	      (> (imag-part val) 1.0)
+	      (< (real-part val) 0.0))
+	  (format #t ";(random 1.0+1.0i) -> ~A?~%" val))))
+
+  (let ((rs (random-state 12345678)))
+    (do ((i 0 (+ i 1)))
+	((= i 100))
+      (let ((val (random 1.0 rs)))
+	(if (or (not (real? val))
+		(negative? val)
+		(> val 1.0))
+	    (format #t ";(random 1.0 rs) -> ~A?~%" val)))))
+
+  (when with-bignums
+    (num-test (random (bignum "0")) 0)
+    (num-test (random (bignum "0.0")) 0.0)
+
+    (let ((vr (v 1000
+		 (bignum "1.0")
+		 (lambda (val)
+		   (and (real? val)
+			(not (negative? val))
+			(<= val 1.0))))))
+      (if (or (< vr 40)
+	      (> vr 400))
+	  (format #t ";(big-random 1.0) not so random? ~A~%" vr)))
+
+    (let ((vr (v 1000
+		 (bignum "100")
+		 (lambda (val)
+		   (and (integer? val)
+			(not (negative? val))
+			(<= val 100))))))
+      (if (or (< vr 40)
+	      (> vr 400))
+	  (format #t ";(big-random 100) not so random? ~A~%" vr)))
+
+    (let ((vr (v 1000
+		 (bignum "1/2")
+		 (lambda (val)
+		   (and (rational? val)
+			(not (negative? val))
+			(<= val 1/2))))))
+      (if (or (< vr 40)
+	      (> vr 400))
+	  (format #t ";(big-random 1/2) not so random? ~A~%" vr)))
+
+    (let ((vr (v 1000
+		 (bignum "-10.0")
+		 (lambda (val)
+		   (and (real? val)
+			(not (positive? val))
+			(>= val -10.0))))))
+      (if (or (< vr 40)
+	      (> vr 400))
+	  (format #t ";(big-random -10.0) not so random? ~A~%" vr)))
+
+    (do ((i 0 (+ i 1)))
+	((= i 100))
+      (let ((val (random (bignum "1.0+1.0i"))))
+	(if (or (not (complex? val))
+		(> (real-part val) 1.0)
+		(> (imag-part val) 1.0)
+		(< (real-part val) 0.0))
+	    (format #t ";(big-random 1.0+1.0i) -> ~A?~%" val))))
+
+    (let ((rs (random-state (bignum "12345678"))))
+      (do ((i 0 (+ i 1)))
+	  ((= i 100))
+	(let ((val (random (bignum "1.0") rs)))
+	  (if (or (not (real? val))
+		  (negative? val)
+		  (> val 1.0))
+	      (format #t ";(big-random 1.0 rs) -> ~A?~%" val)))
+	(let ((val (random 1.0 rs)))
+	  (if (or (not (real? val))
+		  (negative? val)
+		  (> val 1.0))
+	      (format #t ";(big-random small-1.0 rs) -> ~A?~%" val)))))
+
+    (let ((rs (random-state 1234)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 100))
+	(let ((val (random (bignum "1.0") rs)))
+	  (if (or (not (real? val))
+		  (negative? val)
+		  (> val 1.0))
+	      (format #t ";(big-random 1.0 small-rs) -> ~A?~%" val)))
+	(let ((val (random 1.0 rs)))
+	  (if (or (not (real? val))
+		  (negative? val)
+		  (> val 1.0))
+	      (format #t ";(random small-1.0 rs) -> ~A?~%" val)))))
+    ))
+
+(test (random 0 #t) 'error)
+(test (random 0.0 #(1 2)) 'error)
+(test (nan? (random 1/0)) #t)
+(test (zero? (random 1e-30)) #f)
+(test (= (random 0) (random 1)) #t)
+
+(let ((size 20)) ; check add_i_random_i and subtract cases
+  (define (cr)
+    (let ((fv (make-float-vector size))
+  	  (iv (make-int-vector size))
+   	  (iv1 (make-int-vector size))
+          (ivmn 100) (ivmx -100) (iv1mn 100) (iv1mx -100) (fvmn 100.0) (fvmx -100.0))
+      (do ((i 0 (+ i 1)))
+  	  ((= i size))
+        (int-vector-set! iv i (+ 3 (random 9)))
+        (int-vector-set! iv1 i (- (random 9) 3))
+        (float-vector-set! fv i (- (random 9.0) 3.0)))
+      (do ((i 0 (+ i 1)))
+  	  ((= i size))
+        (set! ivmn (min ivmn (iv i)))
+        (set! ivmx (max ivmx (iv i)))
+        (set! iv1mn (min iv1mn (iv1 i)))
+        (set! iv1mx (max iv1mx (iv1 i)))
+        (set! fvmn (min fvmn (fv i)))
+        (set! fvmx (max fvmx (fv i))))
+      (if (= ivmn ivmx) (format *stderr* "iv only value: ~S~%" ivmn))
+      (if (= iv1mn iv1mx) (format *stderr* "iv1 only value: ~S~%" iv1mn))
+      (if (= fvmn fvmx) (format *stderr* "fv only value: ~S~%" fvmn))
+      (do ((i 0 (+ i 1)))
+  	  ((= i size))
+        (if (or (>= (int-vector-ref iv i) 12) (< (int-vector-ref iv i) 3))
+    	    (format *stderr* "iv[~D] is ~A?~%" i (int-vector-ref iv i)))
+        (if (or (>= (int-vector-ref iv1 i) 6) (< (int-vector-ref iv1 i) -3))
+  	    (format *stderr* "iv1[~D] is ~A?~%" i (int-vector-ref iv1 i)))
+        (if (or (>= (float-vector-ref fv i) 6.0) (< (float-vector-ref fv i) -3.0))
+  	    (format *stderr* "iv1[~D] is ~A?~%" i (float-vector-ref fv i))))))
+  (cr))
+
+(unless with-bignums
+  (test ((object->string (random-state 1234) :readable) 1) #\r) ; print-readably here
+  (test ((object->string (random-state 1234)) 1) #\<)) ; write (#t as default) here
+(test (random-state 1.0) 'error)
+(test (random-state 1+i) 'error)
+(test (random-state 3/4) 'error)
+(test (random-state 1/0) 'error)
+(test (random-state (real-part (log 0))) 'error)
+(test (random-state? (random-state 100)) #t)
+(test (random-state?) 'error)
+(test (random-state? (random-state 100) 100) 'error)
+(test (equal? (random-state 1234) #f) #f)
+(unless with-bignums
+  (test (random-state -1) 'error)
+  (test (random-state -1 123) 'error)
+  (test (random-state 1 -123) 'error)
+  (test (random-state 1 most-negative-fixnum) 'error)
+  (test (random-state -9223372036854775808) 'error)
+
+  (let ((r1 (random-state 100))
+	(r2 (random-state 100))
+	(r3 (random-state 200)))
+    (test (random-state? r3) #t)
+    (test (equal? r1 r2) #t)
+    (test (equal? r1 r3) #f)
+    (random 1.0 r1)
+    (test (equal? r1 r2) #f)
+    (random 1.0 r2)
+    (test (equal? r1 r2) #t)
+    (test (equal? (copy r1) r1) #t)
+    (test (random-state? r2) #t)
+    (test (random-state? (copy r1)) #t)))
+(test (let () (define (func) (+ -1 (random 1))) (func)) -1) ; add_i_random test
+
+(test (complex? (random 1+i (random-state 1234))) #t)
+(when with-bignums
+  (test (complex? (random (bignum "1+i") (random-state 1234))) #t)
+  (test (real? (random (bignum "1.5") (random-state 1234))) #t)
+  (test (rational? (random (bignum "1/2") (random-state 1234))) #t)
+  (test (integer? (random (bignum "100") (random-state 1234))) #t)
+  (test (complex? (random (bignum "1+i") (random-state (bignum "1234")))) #t)
+  (test (real? (random (bignum "1.5") (random-state (bignum "1234")))) #t)
+  (test (rational? (random (bignum "1/2") (random-state (bignum "1234")))) #t)
+  (test (integer? (random (bignum "100") (random-state (bignum "1234")))) #t))
+
+(for-each
+ (lambda (arg)
+   (test (random arg) 'error)
+   (test (random 1.0 arg) 'error)
+   (test (random-state arg) 'error)
+   (test (random-state->list arg) 'error)
+   (test (random-state? arg) #f)
+   )
+ (list "hi" _ht_ _undef_ _null_ _c_obj_ () '(1 2) #f (integer->char 65) 'a-symbol (make-vector 3) abs #\f (lambda (a) (+ a 1)) (if #f #f) :hi #<eof> #<undefined>))
+
+(test (random-state->list #f 1234) 'error)
+(unless with-bignums
+  (test (car (random-state->list (random-state 1234))) 1234)
+  (test (pair? (random-state->list)) #t)
+  (test (random-state? (random-state)) #t)
+  (let ((r (random-state))
+        (iv (int-vector 0 0))
+        (p (random-state->list)))
+    (copy r iv)
+    (test (and (= (iv 0) (p 0)) (= (iv 1) (p 1))) #t)
+    (let ((r1 (apply random-state (map values iv))))
+      (test (equal? r r1) #t))
+    (test (random-state? r) #t)
+    (test (length r) 2)
+    (let ((v (vector 1 2)))
+      (copy r v)
+      (let ((r1 (apply random-state (map values v))))
+        (test (equal? r r1) #t)))
+    (for-each (lambda (arg) (test (copy r arg) 'error))
+      (list "12" (inlet 'a 1) (hash-table 'a 1) pi))))
+
+(let ((r1 (random-state 1234))
+      (r2 (random-state 1234)))
+  (test (eq? r1 r2) #f)
+  (unless with-bignums (test (equal? r1 r2) #t))
+  (test (eq? r2 r2) #t)
+  (test (equal? r1 r1) #t)
+  (test ((object->string r1 #f) 1) #\<) ; display, not write
+  (let ((val1 (random 10000000 r1))
+	(val2 (random 10000000 r2)))
+    (test val1 val2)))
+
+(let ((r1 (random-state 1234))
+      (r2 (random-state 1234567)))
+  (let ((val1 (random 10000000 r1))
+	(val2 (random 10000000 r2)))
+    (let ((val3 (random 10000000 r1))
+	  (val4 (random 10000000 r2)))
+      (let ((val5 (random 10000000 r1))
+	    (val6 (random 10000000 r2)))
+	(test (or (not (= val1 val2)) ; might be equal by chance...
+		  (not (= val3 val4))
+		  (not (= val5 val6)))
+	      #t)))))
+
+(unless with-bignums
+  (let ((r1 (make-vector 10)))
+    (let* ((rs1 (random-state 12345))
+	   (rs2 (copy rs1))
+	   (rs3 (apply random-state (random-state->list rs1)))
+	   (rs4 #f)
+	   (rs5 #f))
+      (do ((i 0 (+ i 1)))
+	  ((= i 10))
+	(set! (r1 i) (random 1.0 rs1))
+	(if (= i 3)
+	    (set! rs4 (copy rs1)))
+	(if (= i 5)
+	    (set! rs5 (apply random-state (random-state->list rs1)))))
+      (do ((i 0 (+ i 1)))
+	  ((= i 10))
+	(let ((v1 (random 1.0 rs2))
+	      (v2 (random 1.0 rs3)))
+	  (if (not (= v1 v2 (r1 i)))
+	      (format #t ";random v1: ~A, v2: ~A, r1[~A]: ~A~%" v1 v2 i (r1 i))))
+	(if (> i 3)
+	    (let ((v3 (random 1.0 rs4)))
+	      (if (not (= v3 (r1 i)))
+		  (format #t ";random v3: ~A, r1[~A]: ~A~%" v3 i (r1 i)))))
+	(if (> i 5)
+	    (let ((v4 (random 1.0 rs5)))
+	      (if (not (= v4 (r1 i)))
+		  (format #t ";random v4: ~A, r1[~A]: ~A~%" v4 i (r1 i)))))))))
+
+(do ((i 0 (+ i 1)))
+    ((= i 20))              ; this was ((+ i 100)) !! -- surely a warning would be in order?
+  (let ((val (random -1.0)))
+    (test (and (real? val) (<= val 0.0) (>= val -1.0)) #t))
+  (let ((val (random -100)))
+    (test (and (integer? val) (<= val 0) (>= val -100)) #t))
+  (let ((val (random most-negative-fixnum)))
+    (test (and (integer? val) (<= val 0)) #t))
+  (let ((val (random most-positive-fixnum)))
+    (test (and (integer? val) (>= val 0)) #t))
+  (let ((val (random pi)))
+    (test (and (real? val) (>= val 0) (< val pi)) #t))
+  (let ((val (random 3/4)))
+    (test (and (rational? val) (>= val 0) (< val 3/4)) #t))
+  (test (let ((x (random most-positive-fixnum))) (integer? x)) #t)
+  (if with-bignums
+      (begin
+	(let ((val (random (expt 2 70))))
+	  (test (and (integer? val) (>= val 0)) #t))
+	(let ((val (random 1180591620717411303424.0)))
+	  (test (and (real? val) (>= val 0.0)) #t)))))
+
+(when with-bignums
+  (let ((r1 (random-state (expt 2 70))))
+    (test (random-state? r1) #t)
+    (test ((object->string r1) 1) #\<)
+    (test (eq? r1 r1) #t)
+    (test (equal? r1 r1) #t)
+    (let ((val1 (random 10000000 r1))
+	  (val2 (random 10000000 r1)))
+      (test (not (= val1 val2)) #t))))
+
+(let () ; optimizer tests
+  (define (f1) (- (random 100) 50))
+  (define (f2) (- (random 1.0) 0.5))
+  (define (f3) (random 100))
+  (define (f4) (random 1.0))
+  (do ((i 0 (+ i 1)))
+      ((= i 20))
+    (let ((v1 (f1))
+	  (v2 (f2))
+	  (v3 (f3))
+	  (v4 (f4)))
+      (if (not (<= -50 v1 50)) (format *stderr* ";f1: sub_random_ic: ~A~%" v1))
+      (if (not (<= 0 v3 100)) (format *stderr* ";f3: random_ic: ~A~%" v3))
+      (if (not (<= -0.5 v2 0.5)) (format *stderr* ";f2: sub_random_rc: ~A~%" v2))
+      (if (not (<= 0.0 v4 1.0)) (format *stderr* ";f4: random_rc: ~A~%" v4)))))
+
+(test (real-part (random 0+i)) 0.0)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; string->number
+;;; number->string
+;;; --------------------------------------------------------------------------------
+
+(test (string->number "+#.#") #f)
+(test (string->number "-#.#") #f)
+(test (string->number "#.#") #f)
+(test (string->number "#") #f)
+
+(for-each
+ (lambda (n)
+   (if (not (eqv? n (string->number (number->string n))))
+       (format #t ";(string->number (number->string ~A)) = ~A?~%" n (string->number (number->string n)))))
+ (list 1 2 3 10 1234 1234000000 500029 0/1 0/2 0/3 0/10 0/1234 0/1234000000 0/500029
+       1/1 1/2 1/3 1/10 1/1234 1/1234000000 1/500029 2/1 2/2 2/3 2/10 2/1234
+       2/1234000000 2/500029 3/1 3/2 3/3 3/10 3/1234 3/1234000000 3/500029
+       10/1 10/2 10/3 10/10 10/1234 10/1234000000 10/500029 1234/1 1234/2 1234/3
+       1234000000/10 1234000000/1234 1234000000/1234000000 1234000000/500029
+       500029/1 500029/2 500029/3 500029/10 500029/1234 500029/1234000000 500029/500029))
+
+(let ((fequal? (lambda (a b) (< (magnitude (- a b)) 1e-14))))
+  (for-each
+   (lambda (x)
+     (if (not (fequal? x (string->number (number->string x))))
+	 (format #t ";(string->number (number->string ~A)) -> ~A?~%" x (string->number (number->string x)))))
+   (list 0.000000 1.000000 3.141593 2.718282 1234.000000 1234000000.000000 0.000000+0.000000i 0.000000+0.000000i 0.000000+1.000000i
+	 0.000000+3.141593i 0.000000+2.718282i 0.000000+1234.000000i 0.000000+1234000000.000000i 0.000000+0.000000i 0.000000+0.000000i
+	 0.000000+1.000000i 0.000000+3.141593i 0.000000+2.718282i 0.000000+1234.000000i 0.000000+1234000000.000000i 1.000000+0.000000i
+	 1.000000+0.000000i 1.000000+1.000000i 1.000000+3.141593i 1.000000+2.718282i 1.000000+1234.000000i 1.000000+1234000000.000000i
+	 3.141593+0.000000i 3.141593+0.000000i 3.141593+1.000000i 3.141593+3.141593i 3.141593+2.718282i 3.141593+1234.000000i
+	 3.141593+1234000000.000000i 2.718282+0.000000i 2.718282+0.000000i 2.718282+1.000000i 2.718282+3.141593i 2.718282+2.718282i
+	 2.718282+1234.000000i 2.718282+1234000000.000000i 1234.000000+0.000000i 1234.000000+0.000000i 1234.000000+1.000000i
+	 1234.000000+3.141593i 1234.000000+2.718282i 1234.000000+1234.000000i 1234.000000+1234000000.000000i 1234000000.000000+0.000000i
+	 1234000000.000000+0.000000i 1234000000.000000+1.000000i 1234000000.000000+3.141593i 1234000000.000000+2.718282i 1234000000.000000+1234.000000i
+	 1234000000.000000+1234000000.000000i)))
+
+(test (string->number "1+1+i") #f)
+(test (string->number "1+i+i") #f)
+(test (string->number "1+.i") #f)
+(test (string->number ".") #f)
+(test (string->number "8.41470984807896506652502321630298999622563060798371065672751709991910404391239668948639743543052695.") #f)
+(test (string->number "8.41470184807816506652502321630218111622563060718371065672751701111110404311231668148631743543052695" 9) #f)
+(test (number->string -9223372036854775808) "-9223372036854775808")
+(test (number->string 9223372036854775807) "9223372036854775807")
+
+(test (number->string 123 8) "173")
+(test (number->string 123 16) "7b")
+(test (number->string 123 2) "1111011")
+(test (number->string -123 8) "-173")
+(test (number->string -123 16) "-7b")
+(test (number->string -123 2) "-1111011")
+
+(test (number->string 0 8) "0")
+(test (number->string 0 2) "0")
+(test (number->string 0 16) "0")
+(test (number->string 1 8) "1")
+(test (number->string 1 2) "1")
+(test (number->string 1 16) "1")
+(test (number->string -1 8) "-1")
+(test (number->string -1 2) "-1")
+(test (number->string -1 16) "-1")
+(test (string->number "- 1") #f)
+(num-test (string->number "1+0i") 1.0)
+(num-test (string->number "0-0i") 0.0)
+(num-test (string->number "0-0e10i") 0.0)
+(num-test (string->number "0-0e40i") 0.0)
+(num-test (string->number "0-0e100i") 0.0)
+(test (string->number "0e10e100") #f)
+
+(test (equal? (string->number (number->string -1e19)) -1e19) #t)
+(test (equal? (string->number (number->string 1e308)) 1e308) #t)
+(test (equal? (string->number (number->string 9.22e18)) 9.22e18) #t)
+
+;;; @ exponent added 26-Mar-12
+(when (provided? '@-exponent)
+  (num-test 0.0 0@0)
+  (num-test 0.0 0@-0)
+  (num-test 0.0 0@+0)
+  (num-test 1.0 1@0)
+  (num-test 10.0 1@1)
+  (num-test 10.0 1@+1)
+  (num-test 0.1 1@-1)
+
+  (num-test (string->number "1@0" 16) 1.0)
+  (num-test (string->number "e@0" 16) 14.0)
+  (num-test (string->number "a@1" 16) 160.0)
+  (num-test (string->number "#xa@1") 160.0)
+  (num-test (string->number ".a@0" 12) 0.83333333333333)
+  (num-test (string->number "a.@0" 16) 10.0)
+  (num-test (string->number "0a" 16) 10)
+  (num-test (string->number "a@-1" 16) 0.625)
+
+  (num-test 1@0+1@0i 1+1i)
+  (num-test (string->number "1@1" 12) 12.0)
+  (num-test (string->number "1@-1" 16) 0.0625)
+  (num-test (string->number "1.0@1+0.1@2i" 16) 16+16i)
+  (num-test (string->number "#b.0@2") 0.0)
+  (num-test (string->number ".2@-22") 2e-23)
+  (num-test (string->number "+02@02") 200.0)
+  (num-test (string->number "2fe2@2" 16) 3138048.0)
+  (num-test (string->number "1@-0-bc/di" 16) 1-14.461538461538i)
+  (num-test (string->number ".f-a.c1@0i" 16) 0.9375-10.75390625i)
+  (num-test (string->number "df2@2-ccfi" 16) 913920-3279i)
+  (num-test (string->number "0/0de-0@2i" 16) 0.0)
+  (num-test (string->number "-1a12cd.@1" 16) -27339984.0)
+  (num-test (string->number "fb/2ea+2@+1i" 16) 0.33646112600536+32i)
+  (num-test (string->number "af.e0@-0+0b/efefd11i" 16) 175.875+4.3721589140015e-08i)
+  (num-test (string->number "bb10@1-i" 12) 247248-1i)
+  (num-test (string->number "b.+0@01i" 12) 11.0)
+  (num-test (string->number "-0@-0221" 12) 0.0)
+  (num-test (string->number "-a-01@2i" 12) -10-144i)
+  (num-test (string->number "-111@-1-1i" 10) -11.1-1i)
+  (num-test (string->number "122@9-2@0i" 10) 122000000000-2i)
+  (num-test (string->number "-0@+10-20i" 10) 0-20i)
+  (num-test (string->number "+2@-909221" 10) 0.0))
+
+(when (provided? 'dfls-exponents)
+  (for-each
+    (lambda (exponent)
+      (num-test (string->number (string-append "2" exponent "2") 10) 200.0) ; 2 * e2=100
+      (num-test (string->number (string-append "2" exponent "-3") 10) 0.002)
+      (num-test (string->number (string-append "1" exponent "1") 10) 10.0)
+      (num-test (string->number (string-append "-111" exponent "-1-1i") 10) -11.1-1i)
+      (num-test (string->number (string-append "122" exponent "9-2" exponent "0i") 10) 122000000000-2i)
+      (num-test (string->number (string-append "-0" exponent "+10-20i") 10) 0-20i)
+      (num-test (string->number (string-append "+2" exponent "-909221") 10) 0.0))
+    (list "e" "E" "d" "D" "f" "F" "s" "S" "l" "L")))
+
+;; s7.html claims this '=' is guaranteed...
+(test (= .6 (string->number ".6")) #t)
+(test (= 0.60 (string->number "0.60")) #t)
+(test (= 60e-2 (string->number "60e-2")) #t)
+(test (= 0.11 (string->number "0.11")) #t)
+(test (= 0.999 (string->number "0.999")) #t)
+(test (= 100.000 (string->number "100.000")) #t)
+(test (= 1e10 (string->number "1e10")) #t)
+(test (= 0.18 (string->number "0.18")) #t)
+(test (= 0.3 (string->number "0.3")) #t)
+(test (= 0.333 (string->number "0.333")) #t)
+(test (= -1/10 (string->number "-1/10")) #t)
+(test (= -110 (string->number "-110")) #t)
+(test (= 1+i (string->number "1+i")) #t)
+(test (= 0.6-.1i (string->number "0.6-.1i")) #t)
+
+;; but is this case also guaranteed??  maybe use equivalent? here
+(unless with-bignums
+  (test (= .6 (string->number (number->string .6))) #t)
+  (test (= 0.6 (string->number (number->string 0.6))) #t)
+  (test (= 0.60 (string->number (number->string 0.60))) #t)
+  (test (= 60e-2 (string->number (number->string 60e-2))) #t)
+  (test (= 0.6-.1i (string->number (number->string 0.6-.1i))) #t))
+(test (= 0.11 (string->number (number->string 0.11))) #t)
+(test (= 0.999 (string->number (number->string 0.999))) #t)
+(test (= 100.000 (string->number (number->string 100.000))) #t)
+(test (= 1e10 (string->number (number->string 1e10))) #t)
+(test (= 0.18 (string->number (number->string 0.18))) #t)
+(test (equivalent? 0.3 (string->number (number->string 0.3))) #t)
+(test (= 0.333 (string->number (number->string 0.333))) #t)
+(test (= -1/10 (string->number (number->string -1/10))) #t)
+(test (= -110 (string->number (number->string -110))) #t)
+(test (= 1+i (string->number (number->string 1+i))) #t)
+
+(test (nan? (string->number "+nan.1")) #t) ; was error
+(test (string->number "+.nan.0") #f)
+(test (string->number "+nan.0+") #f)
+(test (string->number "+nan.0i") #f)
+(test (nan? (string->number "+nan.00")) #t) ; was an error, but now the 00 = "payload" = 0
+(test (string->number "+nan.01i") #f)
+(test (string->number "+inf.1") #f)
+(test (string->number "+inf.i") #f)
+(test (string->number "+inf.0.") #f)
+(test (string->number "+inf.0#i") #f)
+(test (string->number "+nan.0+ii") #f)
+(test (string->number "+nan.0+3.3/2i") #f)
+(test (string->number "+nan.0+#x12i") #f)
+(test (string->number "1+in") #f)
+(test (string->number "1+infi") #f)
+(test (string->number "1+nani") #f)
+(test (string->number "+nan+nani") #f)
+(test (equivalent? (string->number "#x+nan.0+i") +nan.0+1.0i) #t)
+(test (equivalent? (string->number "#x+nan.0+12i") +nan.0+18.0i) #t)
+(test (equivalent? (string->number "#x+12/11+i") 1.0588235294117647+1.0i) #t)
+(test (string->number "#x1.2+i") 1.125+1.0i)
+(test (string->number "#x1e2+i") 482.0+1.0i)
+(test (string->number "#x12+i") 18.0+1.0i)
+(test (string->number "#x12+12i") 18.0+18.0i)
+(test (equivalent? (string->number "+nan.0+i") +nan.0+1.0i) #t)
+(test (equivalent? (string->number "-nan.0+i") +nan.0+1.0i) #t)
+(test (equivalent? (string->number "+nan.0+3i") +nan.0+3.0i) #t)
+(test (equivalent? (string->number "+nan.0-3i") +nan.0-3.0i) #t)
+(test (equivalent? (string->number "+nan.0+3.1i") +nan.0+3.1i) #t)
+(test (equivalent? (string->number "+nan.0-3.1i") +nan.0-3.1i) #t)
+(test (equivalent? (string->number "+nan.0+1/2i") +nan.0+0.5i) #t)
+(test (equivalent? (string->number "-nan.0+1/2i") +nan.0+0.5i) #t)
+(test (equivalent? (string->number "+nan.0-1e3i") +nan.0-1000.0i) #t)
+(test (equivalent? (string->number "+nan.0+nan.0i") +nan.0+nan.0i) #t)
+(test (equivalent? (string->number "+nan.0-nan.0i") +nan.0+nan.0i) #t)
+(test (equivalent? (string->number "+nan.0+inf.0i") +nan.0+inf.0i) #t)
+(test (equivalent? (string->number "+nan.0-inf.0i") +nan.0-inf.0i) #t)
+(test (string->number "+inf.0+i") +inf.0+1.0i)
+(test (string->number "-inf.0+i") -inf.0+1.0i)
+(test (string->number "+inf.0+3i") +inf.0+3.0i)
+(test (string->number "+inf.0-3i") +inf.0-3.0i)
+(test (string->number "+inf.0+3.1i") +inf.0+3.1i)
+(test (string->number "+inf.0-3.1i") +inf.0-3.1i)
+(test (string->number "+inf.0+1/2i") +inf.0+0.5i)
+(test (string->number "-inf.0+1/2i") -inf.0+0.5i)
+(test (string->number "+inf.0-1e3i") +inf.0-1000.0i)
+(test (equivalent? (string->number "+inf.0+nan.0i") +inf.0+nan.0i) #t)
+(test (equivalent? (string->number "+inf.0-nan.0i") +inf.0+nan.0i) #t)
+(test (string->number "+inf.0+inf.0i") +inf.0+inf.0i)
+(test (string->number "+inf.0-inf.0i") +inf.0-inf.0i)
+(test (string->number "0-inf.0i") 0.0-inf.0i)
+(test (string->number "0+inf.0i") 0.0+inf.0i)
+(test (equivalent? (string->number "0-nan.0i") 0.0+nan.0i) #t)
+(test (equivalent? (string->number "1/2-nan.0i") 0.5+nan.0i) #t)
+(test (equivalent? (string->number "1e3-nan.0i") 1000.0+nan.0i) #t)
+(test (equivalent? (string->number "1.2-nan.0i") 1.2+nan.0i) #t)
+(test (string->number "#xa.5+b.5i") 10.3125+11.3125i)
+
+(when with-bignums
+  (test (let () (define (f) (number->string pi)) (define (g) (f)) (g)) "3.141592653589793238462643383279502884195E0"))
+
+(test (= 0.6 0.600) #t)
+(test (= 0.6 6e-1 60e-2 .06e1 6.e-1) #t)
+(test (= 0.6 6e-1 60e-2 .06e1 600e-3 6000e-4 .0006e3) #t)
+(test (= 0.3 0.3000) #t)
+(test (= 0.345 0.345000 345.0e-3) #t)
+
+(test (let ()
+	(define (func)
+	  (with-output-to-string
+	    (lambda ()
+	      (do ((i 0 (+ i 1)))
+		  ((= i 1))
+		(display (number->string -1.0))))))
+	(define (hi) (func) (func)) (hi) (hi))
+      "-1.0")
+
+(let-temporarily (((*s7* 'float-format-precision) 64))
+  (test (equivalent? (string->number (number->string 0.00001 2) 2) 0.00001) #t) ; 0 if default
+  (string->number (number->string 0.0001 2) 2) 0.0001)
+(test (equivalent? (string->number (number->string 0.00001 2) 2) 0.00001) #f)
+
+(test (string->number #u(0 0 0 0 0) #\a) 'error)
+(test (string->number "" "") 'error)
+
+#|
+;; scheme spec says (eqv? (number->string (string->number num radix) radix) num) is always #t
+;;   (also that radix is 10 if num is inexact)
+;; currently in s7, if m below is 0, s7 is ok, but if there's a true integer part, we sometimes lose by 1e-15 or so
+(let ()
+  (do ((m 0 (+ m 1)))
+      ((= m 10))
+    (do ((i 0 (+ i 1)))
+	((= i 10))
+      (do ((j 0 (+ j 1)))
+	  ((= j 10))
+	(do ((k 0 (+ k 1)))
+	    ((= k 10))
+	  (let* ((str (string (integer->char (+ (char->integer #\0) i))
+			      (integer->char (+ (char->integer #\0) j))
+			      (integer->char (+ (char->integer #\0) k))))
+		 (strd (string (integer->char (+ (char->integer #\0) m))))
+		 (str1 (string-append strd "." str))
+		 (str2 (string-append (if (= m 0) "" strd) "." str "000"))
+		 (str3 (string-append strd str "e-3"))
+		 (str4 (string-append strd str ".e-3"))
+		 (str5 (string-append "0.0" strd str "e2"))
+		 (str6 (string-append ".00000" strd str "e6"))
+		 (str7 (string-append strd str "00e-5"))
+		 (args (list (string->number str1)
+			     (string->number str2)
+			     (string->number str3)
+			     (string->number str4)
+			     (string->number str5)
+			     (string->number str6)
+			     (string->number str7))))
+	    (if (not (apply = args))
+		(format #t "~A.~A: ~{~D~^~4T~}~%" strd str
+			(map (lambda (val)
+			       (let ((ctr 0))
+				 (for-each
+				  (lambda (arg)
+				    (if (not (equal? val arg))
+					(set! ctr (+ ctr 1))))
+				  args)
+				 ctr))
+			     args)))))))))
+
+(do ((i 0 (+ i 1)))
+    ((= i 1000))
+  (let ((n (complex
+	    (if (> (random 10) 2)
+		(case (random 3)
+		  ((0)
+		   (- (random 100.0) 50.0))
+		  ((1)
+		   (- (random 100) 50))
+		  (else
+		   (rationalize (- (random 10.0) 5.0))))
+		((float-vector +nan.0 +inf.0 -inf.0) (random 3)))
+	    (if (> (random 10) 2)
+		(case (random 3)
+		  ((0)
+		   (- (random 100.0) 50.0))
+		  ((1)
+		   (- (random 100) 50))
+		  (else
+		   (rationalize (- (random 10.0) 5.0))))
+		((float-vector +nan.0 +inf.0 -inf.0) (random 3))))))
+    (let ((str (number->string n)))
+      (let ((new-n (string->number str)))
+	(unless (equivalent? n new-n)
+	  (format *stderr* "~A: ~S ~A~%" n str new-n))))))
+|#
+
+(test (number->string 1/0) "+nan.0")
+(test (number->string 1/0 2) "+nan.0")
+(test (number->string 1/0 10) "+nan.0")
+(test (number->string 1/0 16) "+nan.0")
+(unless with-bignums (test (number->string 1000000000000000000000000000000000/0) 'error))
+(test (number->string 0/1000000000000000000000000000000000) "0")
+(test (object->string 1/0) "+nan.0")
+(test (format #f "~F" 1/0) "+nan.0")
+(test (format #f "~E" 1/0) "+nan.0")
+(test (format #f "~G" 1/0) "+nan.0")
+(test (format #f "~D" 1/0) "+nan.0")
+(test (format #f "~X" 1/0) "+nan.0")
+(test (format #f "~B" 1/0) "+nan.0")
+(test (format #f "~O" 1/0) "+nan.0")
+(test (format #f "~A" 1/0) "+nan.0")
+(test (format #f "~S" 1/0) "+nan.0")
+(test (format #f "~P" 1/0) "s")
+(test (nan? (string->number "+nan.0")) #t)
+(test (nan? (string->number "+nan.0" 2)) #t)
+(test (equivalent? +nan.0 (string->number "+nan.0")) #t)
+(test (equivalent? (string->number "+inf.0") +inf.0) #t)
+
+(test (number->string (real-part (log 0.0))) "-inf.0")
+(test (number->string (real-part (log 0.0)) 2) "-inf.0")
+(test (number->string (real-part (log 0.0)) 16) "-inf.0")
+(test (number->string (- (real-part (log 0.0)))) "+inf.0")
+(test (number->string (- (real-part (log 0.0))) 2) "+inf.0")
+(test (format #f "~G" (real-part (log 0))) "-inf.0")
+(test (format #f "~E" (real-part (log 0))) "-inf.0")
+(test (format #f "~F" (real-part (log 0))) "-inf.0")
+(test (format #f "~D" (real-part (log 0))) "-inf.0")
+(test (format #f "~X" (real-part (log 0))) "-inf.0")
+(test (format #f "~B" (real-part (log 0))) "-inf.0")
+(test (format #f "~O" (real-part (log 0))) "-inf.0")
+(test (format #f "~A" (real-part (log 0))) "-inf.0")
+(test (format #f "~S" (real-part (log 0))) "-inf.0")
+(test (format #f "~P" (real-part (log 0))) "s")
+(test (infinite? (string->number "+inf.0")) #t)
+(test (infinite? (string->number "+inf.0" 16)) #t)
+(test (infinite? (string->number "-inf.0")) #t)
+(test (infinite? (string->number "-inf.0" 16)) #t)
+(test (negative? (string->number "-inf.0")) #t)
+
+(test (let () (define (func) (with-output-to-string (lambda () (do ((i 0 (+ i 1))) ((= i 1)) (display (number->string +nan.0)))))) (func)) "+nan.0")
+(test (let () (define (func) (with-output-to-string (lambda () (do ((i 0 (+ i 1))) ((= i 1)) (display (number->string (- +nan.0))))))) (func)) "-nan.0")
+(test (let () (define (func) (with-output-to-string (lambda () (do ((i 0 (+ i 1))) ((= i 1)) (display (number->string +inf.0)))))) (func)) "+inf.0")
+(test (let () (define (func) (with-output-to-string (lambda () (do ((i 0 (+ i 1))) ((= i 1)) (display (number->string -inf.0)))))) (func)) "-inf.0")
+(test (let () (define (func) (with-output-to-string (lambda () (do ((i 0 (+ i 1))) ((= i 1)) (display (number->string (complex 4 0))))))) (func)) "4")
+
+(test (number->string 0+0/0i 2) "0.0+nan.0i")
+(test (number->string (complex 0 +inf.0) 2) "0.0+inf.0i")
+
+;; (s7 NaNs are not signed)
+(test (number->string (complex 0 -nan.0)) "0.0+nan.0i")
+(test (number->string (complex 0 -inf.0)) "0.0-inf.0i")
+(test (number->string (complex +nan.0 +nan.0)) "+nan.0+nan.0i")
+(test (number->string (complex +nan.0 -nan.0)) "+nan.0+nan.0i")
+(test (number->string (complex +nan.0 +inf.0)) "+nan.0+inf.0i")
+(test (number->string (complex +nan.0 -inf.0)) "+nan.0-inf.0i")
+(test (number->string (complex -nan.0 +nan.0)) "+nan.0+nan.0i")
+(test (number->string (complex -nan.0 -nan.0)) "+nan.0+nan.0i")
+(test (number->string (complex -nan.0 +inf.0)) "+nan.0+inf.0i")
+(test (number->string (complex -nan.0 -inf.0)) "+nan.0-inf.0i")
+(test (number->string (complex +inf.0 +nan.0)) "+inf.0+nan.0i")
+(test (number->string (complex +inf.0 -nan.0)) "+inf.0+nan.0i")
+(test (number->string (complex +inf.0 +inf.0)) "+inf.0+inf.0i")
+(test (number->string (complex +inf.0 -inf.0)) "+inf.0-inf.0i")
+(test (number->string (complex -inf.0 +nan.0)) "-inf.0+nan.0i")
+(test (number->string (complex -inf.0 -nan.0)) "-inf.0+nan.0i")
+(test (number->string (complex -inf.0 +inf.0)) "-inf.0+inf.0i")
+(test (number->string (complex -inf.0 -inf.0)) "-inf.0-inf.0i")
+
+(test (number->string (complex 0 -nan.0) 8) "0.0+nan.0i")
+(test (number->string (complex 0 -inf.0) 8) "0.0-inf.0i")
+(test (number->string (complex +nan.0 +nan.0) 8) "+nan.0+nan.0i")
+(test (number->string (complex +nan.0 -nan.0) 8) "+nan.0+nan.0i")
+(test (number->string (complex +nan.0 +inf.0) 8) "+nan.0+inf.0i")
+(test (number->string (complex +nan.0 -inf.0) 8) "+nan.0-inf.0i")
+(test (number->string (complex -nan.0 +nan.0) 8) "+nan.0+nan.0i")
+(test (number->string (complex -nan.0 -nan.0) 8) "+nan.0+nan.0i")
+(test (number->string (complex -nan.0 +inf.0) 8) "+nan.0+inf.0i")
+(test (number->string (complex -nan.0 -inf.0) 8) "+nan.0-inf.0i")
+(test (number->string (complex +inf.0 +nan.0) 8) "+inf.0+nan.0i")
+(test (number->string (complex +inf.0 -nan.0) 8) "+inf.0+nan.0i")
+(test (number->string (complex +inf.0 +inf.0) 8) "+inf.0+inf.0i")
+(test (number->string (complex +inf.0 -inf.0) 8) "+inf.0-inf.0i")
+(test (number->string (complex -inf.0 +nan.0) 8) "-inf.0+nan.0i")
+(test (number->string (complex -inf.0 -nan.0) 8) "-inf.0+nan.0i")
+(test (number->string (complex -inf.0 +inf.0) 8) "-inf.0+inf.0i")
+(test (number->string (complex -inf.0 -inf.0) 8) "-inf.0-inf.0i")
+
+(test (equal? 0.0 0e0) #t)
+(test (equal? 0.0 -0.0) #t)
+(test (eqv? 0.0 -0.0) #t)
+(test (equal? 0.0 0e-0) #t)
+(test (equal? 0.0 .0e+0) #t)
+(test (equal? 0.0 00000000000000000000000000000000000000000000000000000e100) #t)
+(test (equal? 0.0 .0000000000000000000000000000000000000000000000000000e100) #t)
+(test (equal? 0.0 00000000000000000000000000000000000000000000000000000.0000000000000000000000000000000000000000000000000000000000e100) #t)
+(test (equal? 0.0 0e100000000000000000000000000000000000000000000000000000000000000000000000) #t)
+
+(num-test 0 0/1000000000)
+(num-test 0 0/100000000000000000000000000000000000000)
+(num-test 0 0/100000000000000000000000000000000000000000000000000000000000000)
+(num-test 0 0/100000000000000000000000000000000000000000000000000000000000000000000)
+(num-test 0 -0/100000000000000000000000000000000000000000000000000000000000000000000)
+
+(num-test 0 0/1000000000+0/1000000000i)
+(num-test 0 0/100000000000000000000000000000000000000-0/100000000000000000000000000000000000000i)
+(num-test 0 0/100000000000000000000000000000000000000000000000000000000000000+0/100000000000000000000000000000000000000000000000000000000000000i)
+(num-test 0 0/100000000000000000000000000000000000000000000000000000000000000000000-0/100000000000000000000000000000000000000000000000000000000000000000000i)
+
+(num-test 0 0+0/1000000000i)
+(num-test 0 0-0/100000000000000000000000000000000000000i)
+(num-test 0 0+0/100000000000000000000000000000000000000000000000000000000000000i)
+(num-test 0 0-0/100000000000000000000000000000000000000000000000000000000000000000000i)
+
+(num-test 0 0/1000000000+0i)
+(num-test 0 0/100000000000000000000000000000000000000-0i)
+(num-test 0 0/100000000000000000000000000000000000000000000000000000000000000+0i)
+(num-test 0 0/100000000000000000000000000000000000000000000000000000000000000000000-0i)
+
+(when with-bignums
+  (test (< 0 1000000000000000000000000000000000) #t)
+  (test (> 0 -1000000000000000000000000000000000) #t))
+
+#|
+;;; are these worth fixing?
+:(* 0 1000000000000000000000000000000000)
++nan.0
+:(* 0.0 1000000000000000000000000000000000)
++nan.0
+:(integer? 1000000000000000000000000000000000)
+#f
+:(positive? 1/1000000000000000000000000000000000)
+#f
+:(exact? 1/1000000000000000000000000000000000)
+#f
+:(floor  1/1000000000000000000000000000000000)
+;floor argument 1, +nan.0, is out of range (argument is NaN)
+etc....
+
+10000000000000000000000000000/10000000000000000000000000000
+|#
+
+(test (equal? 0.0 0.0e10) #t)
+(test (equal? 0.0 0e100) #t)
+(test (equal? 0.0 0.0e1000) #t)
+(test (equal? 0.0 0e+1000) #t)
+(test (equal? 0.0 0.0e-1) #t)
+(test (equal? 0.0 0e-10) #t)
+(test (equal? 0.0 0.0e-100) #t)
+(test (equal? 0.0 0e-1000) #t)
+(test (equal? 0.0 0.0e0123456789) #t)
+
+(test (equal? 0.0 0-0e10i) #t)
+(test (equal? 0.0 0-0.0e100i) #t)
+(test (equal? 0.0 0-0e1000i) #t)
+(test (equal? 0.0 0-0.0e+1000i) #t)
+(test (equal? 0.0 0-0e-1i) #t)
+(test (equal? 0.0 0-0.0e-10i) #t)
+(test (equal? 0.0 0-0e-100i) #t)
+(test (equal? 0.0 0-0.0e-1000i) #t)
+(test (equal? 0.0 0.0+0e0123456789i) #t)
+(num-test 0.0 1e-1000)
+
+(num-test 0e123412341231231231231231231231231231 0.0)
+(num-test 0e-123412341231231231231231231231231231 0.0)
+(num-test 0.00000e123412341231231231231231231231231231 0.0)
+(num-test .0e-123412341231231231231231231231231231 0.0)
+(num-test 2e-123412341231231231231 0.0)
+(num-test 2e-123412341231231231231231231231231231 0.0)
+(num-test 2.001234e-123412341231231231231 0.0)
+(num-test .00122e-123412341231231231231231231231231231 0.0)
+(num-test 2e00000000000000000000000000000000000000001 20.0)
+(num-test 2e+00000000000000000000000000000000000000001 20.0)
+(num-test 2e-00000000000000000000000000000000000000001 0.2)
+(num-test 2e-9223372036854775807 0.0)
+(num-test 2000.000e-9223372036854775807 0.0)
+
+(unless with-bignums
+  (test (infinite? 2e123412341231231231231) #t)
+  (test (infinite? 2e12341234123123123123123123) #t)
+  (test (infinite? 2e12341234123123123123213123123123) #t)
+  (test (infinite? 2e9223372036854775807) #t))
+
+;;  (do ((i 0 (+ i 1)) (n 1 (* n 2))) ((= i 63)) (display n) (display " ") (display (number->string n 16)) (newline))
+
+(test (number->string 3/4 2) "11/100")
+(test (number->string 3/4 8) "3/4")
+(test (number->string 3/4 16) "3/4")
+(test (number->string -3/4 2) "-11/100")
+(test (number->string -3/4 8) "-3/4")
+(test (number->string -3/4 16) "-3/4")
+
+(num-test (string->number "1/2") 1/2)
+(test (nan? (string->number "1/0")) #t)
+(test (nan? (string->number "0/0")) #t)
+(test (nan? 0/0) #t)
+(test (string->number "1.0/0.0") #f)
+(test (string->number "'1") #f)
+(test (string->number "`1") #f)
+(test (string->number ".@0") #f)
+(test (string->number "+.@0") #f)
+(test (string->number "+.-i") #f)
+(test (string->number "+.-0i") #f)
+(num-test (string->number "10111/100010" 2) 23/34)
+(num-test (string->number "27/42" 8) 23/34)
+(num-test (string->number "17/22" 16) 23/34)
+(num-test (string->number "-10111/100010" 2) -23/34)
+(num-test (string->number "-27/42" 8) -23/34)
+(num-test (string->number "-17/22" 16) -23/34)
+(num-test (string->number "11/100" 2) 3/4)
+
+(test (number->string 23/34 2) "10111/100010")
+(test (number->string 23/34 8) "27/42")
+(test (number->string 23/34 16) "17/22")
+(test (number->string -23/34 2) "-10111/100010")
+(test (number->string -23/34 8) "-27/42")
+(test (number->string -23/34 16) "-17/22")
+
+(test (number->string -1 16) "-1")
+;(test (number->string #xffffffffffffffff 16) "-1") -- is this a bug?
+(unless with-bignums
+  ;(test (= #xffffffffffffffff -1) #t) ; this is an overflow
+  (test (= #x8000000000000000 -9223372036854775808) #t))
+(test (= #x7fffffffffffffff 9223372036854775807) #t)
+(test (number->string 9223372036854775807 16) "7fffffffffffffff")
+(test (number->string -9223372036854775808 16) "-8000000000000000")
+(test (number->string #o777777777777777777777) "9223372036854775807")
+(unless with-bignums
+  (test (number->string #o1000000000000000000000) "-9223372036854775808")
+  (test (number->string #b1000000000000000000000000000000000000000000000000000000000000000) "-9223372036854775808"))
+
+(num-test (string->number "3/4+1/2i") 0.75+0.5i)
+(num-test (string->number "3/4+i") 0.75+i)
+(num-test (string->number "0+1/2i") 0+0.5i)
+(test (string->number "3+0i/4") #f)
+(num-test (string->number "3/4+0i") 0.75)
+
+(test (string->number " 1.0") #f)
+(test (string->number "1.0 ") #f)
+(test (string->number "1.0 1.0") #f)
+;(test (string->number (string #\1 (integer->char 0) #\0)) 1) ; ?? Guile returns #f
+(test (string->number "1+1 i") #f)
+(test (string->number "1+ei") #f)
+(test (string->number "#b1") 1)
+(test (string->number " #b1") #f)
+(test (string->number "#b1 ") #f)
+(test (string->number "#b1 1") #f)
+(test (string->number "#b 1") #f)
+(test (string->number "# b1") #f)
+(test (string->number "#b12") #f)
+(test (string->number "000+1") #f)
+(test (string->number (string (integer->char 216))) #f) ; slashed 0
+(test (string->number (string (integer->char 189))) #f) ; 1/2 as single char
+(test (string->number (string #\1 (integer->char 127) #\0)) #f) ; backspace
+(test (string->number (string #\1)) 1)
+
+(test (string->number "1\
+2") 12)
+
+(test (string->number "1E1") 10.0)
+(test (string->number "1e1") 10.0)
+(num-test (string->number "1234567890123456789012345678901234567890.123456789e-30") 1234567890.1235)
+(num-test (string->number "123456789012345678901234567890123456789012345678901234567890.123456789e-50") 1234567890.1235)
+(num-test (- 1234567890123456789012345678901234567890123456789012345678901234567890.123456789e-60 12345678901234567890123456789012345678901234567890.123456789e-40) 0.0)
+(num-test (string->number "#b000100111110110010011010100001.10111010011000100e1" 2) 167136579.45612)
+(num-test (string->number "000100111110110010011010100001.10111010011000100e1" 2) 167136579.45612)
+(num-test (string->number "#b1010100100110001111001001100101010011111010100110110.00011001001011101111101111111000110100100111011100100e-59") 5.163418497654431203689554326589836167902E-3)
+(num-test (string->number "#b01010011000101001010000101011001111110000010110010.1000000000111001011010110110011111101011100000100e-3") 4.567403573967031260951910866285885504112E13)
+
+(num-test 0000000000000000000000000001.0 1.0)
+(num-test 1.0000000000000000000000000000 1.0)
+(num-test 1000000000000000000000000000.0e-40 1.0e-12)
+(num-test 0.0000000000000000000000000001e40 1.0e12)
+(num-test 1.0e00000000000000000001 10.0)
+(num-test 12341234.56789e12 12341234567889999872.0)
+(num-test -1234567890123456789.0 -1234567890123456768.0)
+(num-test 12345678901234567890.0 12345678901234567168.0)
+(num-test 123.456e30 123456000000000012741097792995328.0)
+(num-test 12345678901234567890.0e12 12345678901234569054409354903552.0)
+(num-test 1.234567890123456789012e30 1234567890123456849145940148224.0)
+(num-test 1e20 100000000000000000000.0)
+(num-test 1234567890123456789.0 1234567890123456768.0)
+(num-test 123.456e16 1234560000000000000.0)
+(num-test 98765432101234567890987654321.0e-5 987654321012345728401408.0)
+(num-test 98765432101234567890987654321.0e-10 9876543210123456512.0)
+(num-test 0.00000000000000001234e20 1234.0)
+(num-test 0.000000000000000000000000001234e30 1234.0)
+(num-test 0.0000000000000000000000000000000000001234e40 1234.0)
+(num-test 0.000000000012345678909876543210e15 12345.678909877)
+(num-test 98765432101234567890987654321.0e-20 987654321.012346)
+(num-test 98765432101234567890987654321.0e-29 0.98765432101235)
+(num-test 98765432101234567890987654321.0e-30 0.098765432101235)
+(num-test 98765432101234567890987654321.0e-28 9.8765432101235)
+(num-test 1.0123456789876543210e1 10.12345678987654373771)
+(num-test 1.0123456789876543210e10 10123456789.87654304504394531250)
+(num-test 0.000000010000000000000000e10 100.0)
+(num-test 0.000000010000000000000000000000000000000000000e10 100.0)
+(num-test 0.000000012222222222222222222222222222222222222e10 122.22222222222222)
+(num-test 0.000000012222222222222222222222222222222222222e17 1222222222.222222)
+(num-test (- (string->number "769056139124082.") (string->number "769056139124080.")) 2.0)
+
+(num-test (string->number "0000000000000000000000000001.0") 1.0)
+(num-test (string->number "1.0000000000000000000000000000") 1.0)
+(num-test (string->number "1000000000000000000000000000.0e-40") 1.0e-12)
+(num-test (string->number "0.0000000000000000000000000001e40") 1.0e12)
+(num-test (string->number "1.0e00000000000000000001") 10.0)
+(num-test (string->number "12341234.56789e12") 12341234567889999872.0)
+(num-test (string->number "-1234567890123456789.0") -1234567890123456768.0)
+(num-test (string->number "12345678901234567890.0") 12345678901234567168.0)
+(num-test (string->number "123.456e30") 123456000000000012741097792995328.0)
+(num-test (string->number "12345678901234567890.0e12") 12345678901234569054409354903552.0)
+(num-test (string->number "1.234567890123456789012e30") 1234567890123456849145940148224.0)
+(num-test (string->number "1e20") 100000000000000000000.0)
+(num-test (string->number "1234567890123456789.0") 1234567890123456768.0)
+(num-test (string->number "123.456e16") 1234560000000000000.0)
+(num-test (string->number "98765432101234567890987654321.0e-5") 987654321012345728401408.0)
+(num-test (string->number "98765432101234567890987654321.0e-10") 9876543210123456512.0)
+(num-test (string->number "0.00000000000000001234e20") 1234.0)
+(num-test (string->number "0.000000000000000000000000001234e30") 1234.0)
+(num-test (string->number "0.0000000000000000000000000000000000001234e40") 1234.0)
+(num-test (string->number "0.000000000012345678909876543210e15") 12345.678909877)
+(num-test (string->number "98765432101234567890987654321.0e-20") 987654321.012346)
+(num-test (string->number "98765432101234567890987654321.0e-29") 0.98765432101235)
+(num-test (string->number "98765432101234567890987654321.0e-30") 0.098765432101235)
+(num-test (string->number "98765432101234567890987654321.0e-28") 9.8765432101235)
+(num-test (string->number "1.0123456789876543210e1") 10.12345678987654373771)
+(num-test (string->number "1.0123456789876543210e10") 10123456789.87654304504394531250)
+(num-test (string->number "0.000000010000000000000000e10") 100.0)
+(num-test (string->number "0.000000010000000000000000000000000000000000000e10") 100.0)
+(num-test (string->number "0.000000012222222222222222222222222222222222222e10") 122.22222222222222)
+(num-test (string->number "0.000000012222222222222222222222222222222222222e17") 1222222222.222222)
+(num-test (string->number "1.1001001000011111101101010100010001000010110100010011" 2) 1.5707963267949)
+
+(num-test #x0000000000000000000000000001.0 1.0)
+(num-test #x1.0000000000000000000000000000 1.0)
+;(test (number->string 1222222222.222222 16) "48d9a18e.38e38c")
+(num-test (string->number (number->string 1222222222.222222222222222222 16) 16) 1222222222.222222222222222222)
+
+(if with-bignums
+    (num-test (string->number "179769313486231570814527423731704356798070567525844996598917476803157260780028538760589558632766878171540458953514382464234321326889464182768467546703537516986049910576551282076245490090389328944075868508455133942304583236903222948165808559332123348274797826204144723168738177180919299881250404026184124858368.0")
+	      179769313486231570814527423731704356798070567525844996598917476803157260780028538760589558632766878171540458953514382464234321326889464182768467546703537516986049910576551282076245490090389328944075868508455133942304583236903222948165808559332123348274797826204144723168738177180919299881250404026184124858368.0)
+    (num-test (string->number "179769313486231570814527423731704356798070567525844996598917476803157260780028538760589558632766878171540458953514382464234321326889464182768467546703537516986049910576551282076245490090389328944075868508455133942304583236903222948165808559332123348274797826204144723168738177180919299881250404026184124858368.0")
+	      1.7976931348623e+308))
+
+(when with-bignums
+  (num-test (string->number (number->string (bignum "12345.67890987654321") 2) 2) 12345.67890987654321)
+  (test (number->string 1234.5678909876543212345 16) "4.d291614dc3ab1f80e55a563311b8f308@2")
+  (test (number->string -1234.5678909876543212345 16) "-4.d291614dc3ab1f80e55a563311b8f308@2")
+  (test (number->string 1234.5678909876543212345e8 16) "1.cbe991a6ac3f35c11868cb7e3fb75536@9")
+  (test (number->string 1234.5678909876543212345e-8 16) "c.f204983a27e1eff701c562a870641e5@-5")
+  (test (number->string 123456789098765432.12345e-8 16) "4.99602d2fcd6e9e1748ba5adccc12c5a8@7")
+  (test (number->string 123456789098765432.1e20 16) "9.49b0f70beeac8895e74b18b968@30"))
+
+(num-test (string->number "12345678900000000000.0") 1.23456789e+19)
+(num-test (string->number "1234567890000000000000000000000000000000000000000000000000000000000000.0") 1.23456789e+69)
+(num-test (string->number "1234567890000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000.0") 1.23456789e+129)
+
+(num-test (string->number "1.1e4" 5) 750.0)
+(num-test (string->number "1.1e4" 4) 320.0)
+(num-test (string->number "1.1e4" 3) 108.0)
+(num-test (string->number "1.1e4" 2) 24.0)
+
+(num-test #b111111111111111111111111111111111111111111111111111111111111111 most-positive-fixnum)
+(num-test #o777777777777777777777 most-positive-fixnum)
+(num-test #x7fffffffffffffff most-positive-fixnum)
+(num-test #o-1000000000000000000000 most-negative-fixnum)
+(num-test #x-8000000000000000 most-negative-fixnum)
+(num-test #b-1000000000000000000000000000000000000000000000000000000000000000 most-negative-fixnum)
+
+(test (number->string 1.0 most-negative-fixnum) 'error)
+(test (number->string 1.0 most-positive-fixnum) 'error)
+(test (string->number "1.0" most-negative-fixnum) 'error)
+(test (string->number "1.0" most-positive-fixnum) 'error)
+(test (number->string 16 17) 'error)
+(test (number->string -0. 11 -) 'error)
+(test (string->number "11" 2 -) 'error)
+
+(test (string->number "1.0F") #f)
+(test (string->number "1F") #f)
+(test (string->number "1d") #f)
+(test (string->number "1.0L") #f)
+(test (string->number "1.0+1.0Ei") #f)
+(test (string->number "0xff") #f)
+
+;; duplicate various non-digit chars
+(for-each
+ (lambda (str)
+   (test (string->number str) #f))
+ (list "..1" "1.." "1..2" "++1" "+-1" "-+1" "--1" "-..1" "+..1" "1+i+" "1+i."
+       "1++i" "1--i" "1.ee1" "1+1..i" "1+ii" "1+1ee1i" "1e1e1" "1+2i.i"
+       "1//2" "1+.1/2i" "1+1//2i" "1+1/2" "1i" "1ii" "1+.i" "1+..i"))
+
+(test (number->string most-positive-fixnum 2) "111111111111111111111111111111111111111111111111111111111111111")
+(test (number->string most-positive-fixnum 8) "777777777777777777777")
+(test (number->string most-positive-fixnum 16) "7fffffffffffffff")
+(test (number->string most-positive-fixnum 10) "9223372036854775807")
+(test (number->string most-negative-fixnum 10) "-9223372036854775808")
+(test (number->string most-negative-fixnum 8) "-1000000000000000000000")
+(test (number->string most-negative-fixnum 16) "-8000000000000000")
+(test (number->string most-negative-fixnum 2) "-1000000000000000000000000000000000000000000000000000000000000000")
+
+(test (string->number "111111111111111111111111111111111111111111111111111111111111111" 2) most-positive-fixnum)
+(test (string->number "777777777777777777777" 8) most-positive-fixnum)
+(test (string->number "7fffffffffffffff" 16) most-positive-fixnum)
+(test (string->number "9223372036854775807" 10) most-positive-fixnum)
+(test (string->number "-9223372036854775808" 10) most-negative-fixnum)
+(test (string->number "-1000000000000000000000" 8) most-negative-fixnum)
+(test (string->number "-8000000000000000" 16) most-negative-fixnum)
+(test (string->number "-1000000000000000000000000000000000000000000000000000000000000000" 2) most-negative-fixnum)
+
+(test (string->number (string #\1 #\. #\0 (integer->char 128) #\1)) #f)
+(test (string->number (string #\1 #\. #\0 (integer->char 20) #\1)) #f)
+(test (string->number (string #\1 #\. #\0 (integer->char 200) #\1)) #f)
+(test (string->number (string #\1 #\. #\0 (integer->char 255) #\1)) #f)
+(test (string->number (string #\1 #\. #\0 (integer->char 2) #\1)) #f)
+(test (string->number (string #\1 #\. (integer->char 128) #\1)) #f)
+(test (string->number (string #\1 #\. (integer->char 20) #\1)) #f)
+(test (string->number (string #\1 #\. (integer->char 200) #\1)) #f)
+(test (string->number (string #\1 #\. (integer->char 255) #\1)) #f)
+(test (string->number (string #\1 #\. (integer->char 2) #\1)) #f)
+(test (string->number (string #\1 (integer->char 128) #\1)) #f)
+(test (string->number (string #\1 (integer->char 20) #\1)) #f)
+(test (string->number (string #\1 (integer->char 200) #\1)) #f)
+(test (string->number (string #\1 (integer->char 255) #\1)) #f)
+(test (string->number (string #\1 (integer->char 2) #\1)) #f)
+(test (string->number (string (integer->char 128) #\1)) #f)
+(test (string->number (string (integer->char 20) #\1)) #f)
+(test (string->number (string (integer->char 200) #\1)) #f)
+(test (string->number (string (integer->char 255) #\1)) #f)
+(test (string->number (string (integer->char 2) #\1)) #f)
+(test (string->number (string (integer->char 128) #\/ #\2)) #f)
+(test (string->number (string (integer->char 20) #\/ #\2)) #f)
+(test (string->number (string (integer->char 200) #\/ #\2)) #f)
+(test (string->number (string (integer->char 255) #\/ #\2)) #f)
+(test (string->number (string (integer->char 2) #\/ #\2)) #f)
+(do ((i 103 (+ i 1)))
+    ((= i 256))
+  (test (string->number (string (integer->char i))) #f)
+  (test (string->number (string (integer->char i) #\. #\0)) #f))
+(test (string->number "1,000") #f)
+(test (string->number "1 000") #f)
+(test (string->number "1 / 2") #f)
+(test (string->number "1 .2") #f)
+(test (string->number "1:") #f)
+(test (string->number "2/") #f)
+(test (string->number "2@") #f)
+
+(num-test #b1.0e8 256.0)
+(num-test #o1.0e8 16777216.0)
+(num-test #x1.0e8 1.056640625) ; e is a digit
+
+(if with-bignums
+    (num-test #b1.1111111111111111111111111111111111111111111111111110011101010100100100011001011011111011000011001110110101010011110011000100111E1023 1.7976931348623156E308))
+
+(test (number->string 1/9 2) "1/1001")
+(test (number->string -11/4 2) "-1011/100")
+(test (number->string -11/4 8) "-13/4")
+(test (number->string -15/4 16) "-f/4")
+(test (string->number "f/4" 16) 15/4)
+(test (string->number "#b'0") #f)
+(test (equivalent? (string->number "#b0/0") +nan.0) #t)
+(test (equivalent? (string->number "#b-1/0") +nan.0) #t)
+(test (string->number "1e1/2") #f)
+(test (string->number "1e#b0") #f)
+(test (string->number "#B0") #f)
+(test (string->number "0+I") #f)
+
+(num-test (string->number "#x10+10i") 16+16i)
+(num-test 00-10e+001i 0-100i)
+(num-test (string->number "#x+e/00011ee0") 7/36720)
+(num-test (string->number "-1.-00.0e+10i") -1.0)
+(num-test (string->number "#x+1e1.+e10i") 481+3600i)
+(num-test (string->number "#xe/e+e/ei") 1+1i)
+(num-test (string->number "1e-0-.11e+1i") 1-1.1i)
+(num-test (string->number "00.-1.1e-00i") 0-1.1i)
+(num-test (string->number "+01.e+1+.00i") 10.0)
+(num-test (string->number "#x1e0/e+0/ei") 34.285714285714)
+(num-test (string->number "+01e0+00.i") 1.0)
+(num-test (string->number "+0/0100+0i") 0.0)
+(num-test (string->number "#x-e1e/eee") -139/147)
+(num-test (string->number "#x-0101.+00/11i") -257.0)
+(num-test (string->number "#x+ee.-e00e0110i") 238-3759014160i)
+(num-test (string->number "#x-e0/1ee") -112/247)
+
+(num-test (string->number "+01e01+0/1i") 10.0)
+(num-test (string->number "1.-0.0e+00i") 1.0)
+(num-test (string->number "#x1/7e2") 1/2018)
+
+(num-test (string->number "0.1e00" 2) 0.5)
+(num-test (string->number "10.101" 2) 2.625)
+(num-test (string->number "0e1010" 2) 0.0)
+(num-test (string->number ".1e010" 2) 512.0)
+(num-test (string->number "1/000100" 2) 1/4)
+(num-test (string->number "1000e+03" 2) 64.0)
+(num-test (string->number "-1e+1-1i" 2) -2-1i)
+(num-test (string->number ".1-110e03i" 2) 0.5-48i)
+(num-test (string->number "1e9" 2) 512.0)
+
+(num-test (string->number "52/7" 8) 6)
+(num-test (string->number "130." 8) 88.0)
+(num-test (string->number "121.-16i" 8) 81-14i)
+(num-test (string->number "12/15150" 8) 1/676)
+(num-test (string->number "612444175735" 8) 52958395357)
+(num-test (string->number "31005331+.4i" 8) 6556377+0.5i)
+(num-test (string->number "42220e-2" 8) 274.25)
+(num-test (string->number "1e9" 8) 134217728.0)
+(test (string->number "1e9" 12) #f) ; this may not be ideal...
+(num-test (string->number "1b9/64" 12) 15/4)
+(num-test (string->number "a880+i" 12) 18528+1i)
+(num-test (string->number "dc-i" 16) 220-1i)
+(num-test (string->number "dcd-fi" 16) 3533-15i)
+(num-test (string->number "d/ebee" 16) 1/4646)
+(num-test (string->number "a.d-ci" 16) 10.8125-12i)
+(num-test (string->number "fac/ed" 16) 4012/237)
+(num-test (string->number "-ccdebef.a" 16) -214821871.625)
+(num-test (string->number "+dfefc/c" 16) 76437)
+(num-test (string->number "acd/eabf" 16) 79/1717)
+(num-test (string->number "-1e-1-1e-1i") -0.1-0.1i)
+(num-test (string->number "+1e+1+1e+1i") 10+10i)
+(unless with-bignums (test (= 1e19 .1e20) #t))
+
+(test (string->number "15+b7a9+8bbi-95+4e" 16) #f)
+(num-test (string->number "776.0a9b863471095a93" 12) 1098.0752175102)
+(num-test (string->number "a72972b301/398371448" 12) 54708015601/1637213240)
+(num-test (string->number "+ac946/b72ddf4847ce6" 16) 353443/1611261179739763)
+(num-test (string->number "b85.361c23cec099e742" 15) 2600.2272029731)
+(num-test (string->number "ade2411.a1422432dea8" 15) 1.24494541672338806082296187159063753079E8)
+(num-test (string->number "da99007963b182/8a66b" 15) 26681038227104972/440201)
+(num-test (string->number "74cc.d+b44.02a11ee5i" 15) 24717.866666667+2539.0118742348i)
+(num-test (string->number "d+7a5d40di" 14) 13+58313541i)
+(test (number->string 2000000000000000000.0 16) "1.bc16d674ec8@15")
+(test (string->number "1.bc16d674ec8@15" 16) 2e+18)
+(num-test (string->number "e.d6ed7c4c5387@14" 16) 1069303079659341600.0)
+(test (number->string 2e18+2e18i 16) "1.bc16d674ec8@15+1.bc16d674ec8@15i")
+(if with-bignums
+    (test (number->string 1069303079659341600.0 16) "e.d6ed7c4c53872@14")
+    (test (number->string 1069303079659341600.0 16) "e.d6ed7c4c5387@14")) ; @ exponent needed here
+
+(test (nan? (string->number "5639d72702b62527/0" 14)) #t)
+(test (nan? (string->number "-28133828f9421ef5/0" 16)) #t)
+(test (nan? (string->number "+4a11654f7e00d5f2/0" 16)) #t)
+
+(when (and with-bignums (not pure-s7))
+  (test (number->string (/ most-positive-fixnum most-negative-fixnum) 2) "-111111111111111111111111111111111111111111111111111111111111111/1000000000000000000000000000000000000000000000000000000000000000")
+  (test (string->number "-111111111111111111111111111111111111111111111111111111111111111/1000000000000000000000000000000000000000000000000000000000000000" 2) -9223372036854775807/9223372036854775808)
+  (num-test (string->number "b2706b3d3e8e46ad5aae" 15) 247500582888444441302414)
+  (num-test (string->number "ceec932122d7c22289da9144.4b7836de0a2f5ef" 16) 6.403991331575236168367699181229480307503E28)
+  (num-test (string->number "c23177c20fb1296/fcf15a82c8544613721236e2" 16) 437284287268358475/39141000511500755277510679409)
+
+  (num-test (string->number "775f81b8fee51b723f" 16) 2202044529881940455999)
+  (num-test (string->number "5d9eb6d6496f5c9b6e" 16) 1726983762769631550318)
+  (num-test (string->number "+775f81b8fee51b723f" 16) 2202044529881940455999)
+  (num-test (string->number "+5d9eb6d6496f5c9b6e" 16) 1726983762769631550318)
+  (num-test (string->number "-775f81b8fee51b723f" 16) -2202044529881940455999)
+  (num-test (string->number "-5d9eb6d6496f5c9b6e" 16) -1726983762769631550318)
+  (num-test (string->number "+d053d635e581a5c4/d7" 16) 15011577509928084932/215)
+  (num-test (string->number "+a053a635a581a5a4/a7" 16) 11552760218475668900/167)
+  (num-test (string->number "-d053d635e581a5c4/d7" 16) -15011577509928084932/215)
+  (num-test (string->number "-a053a635a581a5a4/a7" 16) -11552760218475668900/167)
+  (num-test (string->number "+6/a47367025481df6c8" 16) 1/31599808811326133196)
+  (num-test (string->number "d053d635e581a5c4/d7" 16) 15011577509928084932/215)
+  (num-test (string->number "+074563336d48564b774" 16) 2146033681147780970356)
+  (num-test (string->number "e/4246061597ec79345a" 15) 7/204584420774687563055)
+  (num-test (string->number "c57252467ff.cfd94d" 16) 1.3568424830975811909496784210205078125E13)
+  (num-test (string->number "f309e9b9ba.7c52ff2" 16) 1.043843365306485641427338123321533203125E12)
+  (num-test (string->number "+42e-0106653" 10) 4.199999999999999999999999999999999999999E-106652)
+  (test (infinite? (string->number "8e7290491476" 10)) #t)
+  (num-test (string->number "4ff7da4d/ab09e16255c06a55c5cb7193ebb2fbb" 16) 1341643341/14209330580250438592763227155654717371)
+
+  (num-test (string->number "#x400000000000000000") (expt 2 70))
+
+  (for-each
+   (lambda (op)
+     (if (not (= (op (bignum 1e19)) (op (bignum .1e20))))
+	 (format #t ";(~A 1e19) = ~A, but (~A .1e20) = ~A?~%"
+			op (op 1e19)
+			op (op .1e20))))
+   (list floor ceiling truncate round inexact->exact exact->inexact))
+
+  (for-each
+   (lambda (op)
+     (if (not (= (op (bignum -1e19)) (op (bignum -.1e20))))
+	 (format #t ";(~A -1e19) = ~A, but (~A -.1e20) = ~A?~%"
+			op (op -1e19)
+			op (op -.1e20))))
+   (list floor ceiling truncate round inexact->exact exact->inexact)))
+
+(num-test #b+01 1)
+(num-test #b-01 -1)
+
+(num-test #b1.0e-8 0.00390625)
+(num-test #o1.0e-8 5.9604644775391e-08)
+
+(num-test #b-.1 -0.5)
+(num-test #o-.1 -0.125)
+(num-test #x-.1 -0.0625)
+
+(num-test #b+.1 +0.5)
+(num-test #o+.1 +0.125)
+(num-test #x+.1 +0.0625)
+
+(num-test #b+.1e+1 1.0)
+(num-test #o+.1e+1 1.0)
+
+(num-test #b000000001 1)
+(num-test #b1e1 2.0)
+(num-test #b1.e1 2.0)
+
+(num-test #x-AAF -2735)
+(num-test #x-aAf -2735)
+
+(num-test #b1+1.1i 1+1.5i)  ; yow...
+(num-test #xf/c 5/4)
+(num-test #x+f/c 5/4)
+(num-test #x-f/c -5/4)
+
+(num-test #b0/1 0)
+;(test #b0/0 'division-by-zero) ; read-error
+(num-test #o7/6 7/6)
+(num-test #o11/2 9/2)
+(num-test #x11/2 17/2)
+(num-test #b111/11 7/3)
+(num-test #b111111111111111111111111111111111111111111111111111111111111111/111 1317624576693539401)
+(num-test (* 1317624576693539401 7) most-positive-fixnum)
+(num-test #o777777777777777777777/7 1317624576693539401)
+(num-test #x7fffffffffffffff/7 1317624576693539401)
+(num-test (string->number "#x1234/12") (string->number "1234/12" 16))
+
+(test (equal? 0.0 #b0e0) #t)
+(test (equal? 0.0 #b0e-0) #t)
+(test (equal? 0.0 #b.0e+0) #t)
+(test (equal? 0.0 #b00000000000000000000000000000000000000000000000000000e100) #t)
+(test (equal? 0.0 #b.0000000000000000000000000000000000000000000000000000e100) #t)
+(test (equal? 0.0 #b00000000000000000000000000000000000000000000000000000.0000000000000000000000000000000000000000000000000000000000e100) #t)
+(test (equal? 0.0 #b0e100000000000000000000000000000000000000000000000000000000000000000000000) #t)
+(num-test 0 #b0/1000000000)
+(num-test 0 #b0/100000000000000000000000000000000000000)
+(num-test 0 #b0/100000000000000000000000000000000000000000000000000000000000000)
+(num-test (string->number "#b0/100000000000000000000000000000000000000000000000000000000000000000000") 0)
+(num-test (string->number "#b-0/100000000000000000000000000000000000000000000000000000000000000000000") 0)
+
+(test (equal? 0.0 #b0.0e10) #t)
+(test (equal? 0.0 #b0e100) #t)
+(test (equal? 0.0 #b0.0e1000) #t)
+(test (equal? 0.0 #b0e+1000) #t)
+(test (equal? 0.0 #b0.0e-1) #t)
+(test (equal? 0.0 #b0e-10) #t)
+(test (equal? 0.0 #b0.0e-100) #t)
+(test (equal? 0.0 #b0e-1000) #t)
+(test (equal? 0.0 #b0.0e0123456789) #t)
+
+(test (equal? 0.0 #b0-0e10i) #t)
+(test (equal? 0.0 #b0-0.0e100i) #t)
+(test (equal? 0.0 #b0-0e1000i) #t)
+(test (equal? 0.0 #b0-0.0e+1000i) #t)
+(test (equal? 0.0 #b0-0e-1i) #t)
+(test (equal? 0.0 #b0-0.0e-10i) #t)
+(test (equal? 0.0 #b0-0e-100i) #t)
+(test (equal? 0.0 #b0-0.0e-1000i) #t)
+(test (equal? 0.0 #b0.0+0e0123456789i) #t)
+(num-test 0.0 #b1e-1000)
+
+(num-test #b+0+i 0+1i)
+(num-test #b0.-i 0-1i)
+(num-test #b0/01 0)
+(num-test #b-0/1 0)
+(num-test #b1.+.1i 1+0.5i)
+(num-test 1e-0 1.0)
+(num-test #b0100/10 2)
+(num-test #b0e+1-0.i 0.0)
+(num-test #b.1-0/01i 0.5)
+(num-test #b0e+1-0.i 0.0)
+(num-test #b1.+01.e+1i 1+2i)
+(num-test #b0+.0e10101i 0.0)
+(num-test #b00e+0-.00e11i 0.0)
+(num-test #b-000e+10110001 0.0)
+
+(test (number? ''1) #f)
+(test (symbol? ''1) #f)
+(test (string->number "''1") #f)
+
+(test 00 0)
+(test (string->number "00") 0)
+(test 000 0)
+(test (string->number "000") 0)
+(test 00.00 0.0)
+(test (string->number "00.00") 0.0)
+(test (number? '0-0) #f)
+(test (string->number "0-0") #f)
+(test (number? '00-) #f)
+(test (string->number "00-") #f)
+
+(num-test #o-11 -9)
+(num-test #o-0. 0.0)
+(num-test #o+.0 0.0)
+(num-test #xe/1 14)
+(num-test #xe/a 7/5)
+(num-test #xfad 4013)
+(num-test #xd/1 13)
+(num-test #x0/f 0)
+(num-test #x+00 0)
+(num-test #x.c0 0.75)
+(num-test #x-fc -252)
+(test (= 0e-1 0.0) #t)
+;;; (/ (/ 0))??
+(num-test #x.a+i 0.625+1i)
+(num-test #b1.+i 1+1i)
+(num-test 0.e-0 0.0)
+(num-test #o12+i 10+i)
+(num-test #o12+12i 10+10i)
+(num-test #o12/12 1)
+
+(let ((str (make-string 3)))
+   (set! (str 0) #\#)
+   (set! (str 1) #\b)
+   (set! (str 2) #\null)
+   (test (string->number str) #f))
+(let ((str (make-string 4)))
+   (set! (str 0) #\#)
+   (set! (str 1) #\b)
+   (set! (str 2) #\0)
+   (set! (str 3) #\null)          ; #\space here -> #f
+   (test (string->number str) 0)) ; this is consistent with other (non-#) cases
+
+(do ((i 2 (+ i 1)))
+    ((= i 17))
+  (num-test (string->number (number->string 12345.67890987654321 i) i) 12345.67890987654321))
+
+(let ()
+  (define make-number
+    (let ()
+      (define (digit->char digit)
+	(if (< digit 10)
+	    (integer->char (+ (char->integer #\0) digit))
+	    (integer->char (+ (char->integer #\a) (- digit 10)))))
+
+      (define (exponent-marker)
+	(string-ref "eE" (random 2)))
+
+      (lambda (radix)
+	(let* ((max-len (+ 1 (vector-ref (vector 0 0 62 39 31 26 23 22 20 19 18 17 17 16 16 15 15) radix)))
+	       (int-len (floor (* max-len (random 1.0) (random 1.0) (random 1.0))))
+	       (frac-len (floor (* max-len (random 1.0) (random 1.0) (random 1.0))))
+	       (exp-len 1)
+	       (has-frac (> (random 1.0) 0.2))
+	       (has-exp (and (<= radix 10)
+			     (< int-len 9)
+			     (> (random 1.0) 0.5)))
+	       (signed (> (random 1.0) 0.5))
+	       (exp-signed (> (random 1.0) 0.5)))
+	  (if (and (= int-len 0)
+		   (or (not has-frac)
+		       (= frac-len 0)))
+	      (set! int-len 1))
+	  (let ((str (make-string (+ int-len
+				     (if signed 1 0)
+				     (if has-frac (+ frac-len 1) 0) ; extra 1 for "."
+				     (if has-exp (+ (+ exp-len 1)   ; extra 1 for exponent char
+						    (if exp-signed 1 0))
+					 0))))
+		(loc 0))
+
+	    (if signed
+		(begin
+		  (set! (str 0) #\-)
+		  (set! loc (+ loc 1))))
+
+	    (do ((i 0 (+ i 1)))
+		((= i int-len))
+	      (set! (str loc) (digit->char (random radix)))
+	      (set! loc (+ loc 1)))
+
+	    (if has-frac
+		(begin
+		  (set! (str loc) #\.)
+		  (set! loc (+ loc 1))
+		  (do ((i 0 (+ i 1)))
+		      ((= i frac-len))
+		    (set! (str loc) (digit->char (random radix)))
+		    (set! loc (+ loc 1)))))
+
+	    (if has-exp
+		(begin
+		  (set! (str loc) (exponent-marker))
+		  (set! loc (+ loc 1))
+		  (if exp-signed
+		      (begin
+			(set! (str loc) #\-)
+			(set! loc (+ loc 1))))
+		  (do ((i 0 (+ i 1)))
+		      ((= i exp-len))
+		    (set! (str loc) (digit->char (random 10)))
+		    (set! loc (+ loc 1)))))
+
+	    str)))))
+
+  (let ((tries 1000))
+    (do ((i 0 (+ i 1)))
+	((= i tries))
+      (let ((rad (+ 2 (random 15))))
+	(let ((str (make-number rad)))
+	  (if (not (number? (string->number str rad)))
+	      (format #t ";(1) trouble in string->number ~A ~S: ~A~%"
+		      rad str
+		      (string->number str rad))
+	      (if (not (string? (number->string (string->number str rad) rad)))
+		  (format #t ";(2) trouble in number->string ~A ~S: ~A ~S~%"
+			  rad str
+			  (string->number str rad)
+			  (number->string (string->number str rad) rad))
+		  (if (not (number? (string->number (number->string (string->number str rad) rad) rad)))
+		      (format #t ";(3) trouble in number->string ~A ~S: ~A ~S ~A~%"
+			      rad str
+			      (string->number str rad)
+			      (number->string (string->number str rad) rad)
+			      (string->number (number->string (string->number str rad) rad) rad))
+		      (let ((diff (abs (- (string->number (number->string (string->number str rad) rad) rad) (string->number str rad)))))
+			(if (> diff 2e-5)
+			    (format #t "(string->number ~S ~D): ~A, n->s: ~S, s->n: ~A, diff: ~A~%"
+				    str rad
+				    (string->number str rad)
+				    (number->string (string->number str rad) rad)
+				    (string->number (number->string (string->number str rad) rad) rad)
+				    diff)))))))))))
+
+(let ()
+  (define (no-char str radix)
+    (let ((len (length str)))
+      (do ((i 0 (+ i 1)))
+	  ((= i len))
+	(if (and (not (char=? (str i) #\.))
+		 (>= (string->number (string (str i)) 16) radix))
+	    (format #t ";~S in base ~D has ~C?" str radix (str i))))))
+
+  (no-char (number->string (* 1.0 2/3) 9) 9)
+  (no-char (number->string (string->number "0.05" 9) 9) 9)
+  ;; (number->string (string->number "-5L-4" 9) 9) -> "-0.00049" if rounding is stupid
+  ;; (number->string (string->number "5.e-8" 6) 6) -> "0.000000046"
+  (no-char (number->string (* 1.0 6/7) 7) 7)
+
+  (do ((i 2 (+ i 1)))
+      ((= i 17))
+    (no-char (number->string (* 1.0 (/ 1 i)) i) i)
+    (no-char (number->string (* 1.0 (/ 1 (* i i))) i) i)
+    (no-char (number->string (* 0.99999999999999 (/ 1 i)) i) i)
+    (no-char (number->string (* 0.999999 (/ 1 i)) i) i)))
+
+(let ((happy #t))
+  (do ((i 2 (+ i 1)))
+      ((or (not happy)
+	   (= i 17)))
+    (if (not (eqv? 3/4 (string->number (number->string 3/4 i) i)))
+	(begin
+	  (set! happy #f)
+	  (format #t ";(string<->number 3/4 ~A) -> ~A?~%" i (string->number (number->string 3/4 i) i))))
+    (if (not (eqv? 1234/11 (string->number (number->string 1234/11 i) i)))
+	(begin
+	  (set! happy #f)
+	  (format #t ";(string<->number 1234/11 ~A) -> ~A?~%" i (string->number (number->string 1234/11 i) i))))
+    (if (not (eqv? -1234/11 (string->number (number->string -1234/11 i) i)))
+	(begin
+	  (set! happy #f)
+	  (format #t ";(string<->number -1234/11 ~A) -> ~A?~%" i (string->number (number->string -1234/11 i) i))))))
+
+(test (< (abs (- (string->number "3.1415926535897932384626433832795029") 3.1415926535897932384626433832795029)) 1e-7) #t)
+
+(num-test (string->number "111.01" 2) 7.25)
+(num-test (string->number "-111.01" 2) -7.25)
+(num-test (string->number "0.001" 2) 0.125)
+(num-test (string->number "1000000.001" 2) 64.125)
+
+(num-test (string->number "111.01" 8) 73.015625)
+(num-test (string->number "-111.01" 8) -73.015625)
+(num-test (string->number "0.001" 8) 0.001953125)
+(num-test (string->number "1000000.001" 8) 262144.001953125)
+
+(num-test (string->number "111.01" 16) 273.00390625)
+(num-test (string->number "-111.01" 16) -273.00390625)
+(num-test (string->number "0.001" 16) 0.000244140625)
+(num-test (string->number "1000000.001" 16) 16777216.000244)
+
+(num-test (string->number "11.+i" 2) 3+1i)
+(num-test (string->number "0+.1i" 2) 0+0.5i)
+(num-test (string->number "1.+0.i" 2) 1.0)
+(num-test (string->number ".01+.1i" 2) 0.25+0.5i)
+(num-test (string->number "1+0.i" 2) 1.0)
+(num-test (string->number "1+0i" 2) 1.0)
+
+(test (number->string 0.75 2) "0.11")
+(test (number->string 0.125 8) "0.1")
+(test (number->string 12.5 8) "14.4")
+(test (number->string 12.5 16) "c.8")
+(test (number->string 12.5 2) "1100.1")
+(test (number->string -12.5 8) "-14.4")
+(test (number->string -12.5 16) "-c.8")
+(test (number->string -12.5 2) "-1100.1")
+(test (number->string 12.0+0.75i 2) "1100.0+0.11i")
+(test (number->string -12.5-3.75i 2) "-1100.1-11.11i")
+(test (number->string 12.0+0.75i 8) "14.0+0.6i")
+(test (number->string -12.5-3.75i 8) "-14.4-3.6i")
+(test (number->string 12.0+0.75i 16) "c.0+0.ci")
+(test (number->string -12.5-3.75i 16) "-c.8-3.ci")
+(test (string->number "2/#b1" 10) #f)
+(test (string->number "2.i" 10) #f)
+(num-test (string->number "6+3.i" 10) 6+3i)
+(num-test (string->number "-61" 7) -43)
+(num-test (string->number "10100.000e11+011110111.1010110e00i" 2) 40960+247.671875i)
+(num-test (string->number "+4a00/b" 16) 18944/11)
+
+(num-test (string->number "9-9.e+9i" 10) 9-9000000000i)
+(num-test (string->number "-9+9e-9i" 10) -9+9e-09i)  ; why the 09?
+
+(num-test +2-0.e-1i 2.0)
+(num-test +2.-0e-1i 2.0)
+
+;; weird cases:
+(num-test (string->number "#b1000" 8) 8)
+(num-test (string->number "#b1000" 2) 8)
+(num-test (string->number "#b1000" 16) 8)
+(num-test (string->number "11" 2) 3)
+(num-test (string->number "#x11" 2) 17)
+(num-test (string->number "#b11" 16) 3)
+(num-test (string->number "#xffff" 2) 65535)
+(num-test (string->number "#xffff" 10) 65535)
+(num-test (string->number "#xffff" 6) 65535)
+(num-test (string->number "#xffff" 16) 65535)
+(num-test (string->number "#x35/3de" 10) 53/990)
+
+(test (string->number "#x#|1|#1") #f)
+(test (string->number "#||#1") #f)
+(test (string->number "#<") #f)
+(test (string->number "+.e1") #f)
+(test (string->number ".e1") #f)
+
+(num-test (string->number "4\x32;\x37;") 427)
+(num-test (string->number "\x32;.\x39;") 2.9)
+(num-test (string->number "4\x31;+3\x36;i") 41+36i)
+
+(when with-bignums
+  (num-test (string->number "101461074055444526136" 8) 1181671265888545886)
+  (num-test (string->number "-67330507011755171566102306711560321" 8) -35128577239298592313751007322321)
+  (num-test (string->number "35215052773447206642040260+177402503313573563274751i" 8) 1.38249897923920622272688E23+1.176027342049207220713E21i)
+  ;; there is some randomness here: 1.0e309 -> inf, but 1.0e310 -> -nan and others equally scattered
+  )
+
+(test (string=? (substring (number->string pi 16) 0 14) "3.243f6a8885a3") #t)
+
+(for-each
+ (lambda (expchar)
+   (let ((exponent (string expchar)))
+     (do ((base 2 (+ base 1)))
+	 ((= base 11))
+       (let ((val (string->number (string-append "1" exponent "1") base)))
+	 (if (and (number? val)
+		  (> (abs (- val base)) 1e-9))
+	     (format #t ";(string->number ~S ~A) returned ~A?~%"
+		     (string-append "1" exponent "1") base (string->number (string-append "1" exponent "1") base)))))
+
+     (do ((base 2 (+ base 1)))
+	 ((= base 11))
+       (let ((val (string->number (string-append "1.1" exponent "1") base)))
+	 (if (and (number? val)
+		  (> (abs (- val (+ base 1))) 1e-9))
+	     (format #t ";(string->number ~S ~A) returned ~A?~%"
+		     (string-append "1.1" exponent "1") base (string->number (string-append "1.1" exponent "1") base)))))
+
+     (do ((base 2 (+ base 1)))
+	 ((= base 11))
+       (let ((val (string->number (string-append "1" exponent "+1") base)))
+	 (if (and (number? val)
+		  (> (abs (- val base)) 1e-9))
+	     (format #t ";(string->number ~S ~A) returned ~A?~%"
+		     (string-append "1" exponent "+1") base (string->number (string-append "1" exponent "+1") base)))))
+					; in base 16 this is still not a number because of the + (or -)
+					; but "1e+1i" is a number -- gad!
+
+     (do ((base 2 (+ base 1)))
+	 ((= base 11))
+       (let ((val (string->number (string-append "1" exponent "-1+1i") base)))
+	 (if (and (number? val)
+		  (> (magnitude (- val (complex (/ base) 1))) 1e-6))
+	     (format #t ";(string->number ~S ~A) returned ~A?~%"
+		     (string-append "1" exponent "-1+1i") base (string->number (string-append "1" exponent "-1+1i") base)))))))
+
+ (list #\e #\d #\f #\s #\l))
+
+(test (< (abs (- (string->number "3.1415926535897932384626433832795029" 10) 3.1415926535897932384626433832795029)) 1e-7) #t)
+(num-test (string->number "2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427" 16) 2.4433976119657)
+(num-test (string->number "2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427" 11) 2.6508258818757)
+
+(let ((happy #t))
+  (do ((i 2 (+ i 1)))
+      ((or (not happy)
+	   (= i 17)))
+    (let ((val (+ 1.0 i)))
+      (do ((k 1 (+ k 1))
+	   (incr (/ 1.0 i) (/ incr i)))
+	  ((< incr 1e-14))
+	(set! val (+ val incr)))
+      (if (> (abs (- val (string->number "11.111111111111111111111111111111111111111111111111111111111111111111111111111111111111" i))) 1e-7)
+	  (begin
+	    (set! happy #f)
+	    (display "(string->number 11.111... ") (display i) (display ") -> ")
+	    (display (string->number "11.111111111111111111111111111111111111111111111111111111111111111111111111111111111111" i))
+	    (display " but expected ") (display val) (newline))))
+
+    (let* ((digits "00123456789abcdef")
+	   (str (make-string 80 (string-ref digits i))))
+      (string-set! str 2 #\.)
+      (let ((val (exact->inexact (* i i))))
+	(if (> (abs (- val (string->number str i))) 1e-7)
+	    (begin
+	      (set! happy #f)
+	      (format #t ";(string->number ~S ~A) -> ~A (expected ~A)?~%" str i (string->number str i) val)))))
+
+    (let* ((radlim (list 0 0 62 39 31 26 23 22 20 19 18 17 17 16 16 15 15))
+	   (digits "00123456789abcdef"))
+      (do ((k (- (list-ref radlim i) 3) (+ k 1)))
+	  ((= k (+ (list-ref radlim i) 4)))
+	(let ((str (make-string (+ k 3) (string-ref digits i))))
+	  (string-set! str 2 #\.)
+	  (let ((val (exact->inexact (* i i))))
+	    (if (> (abs (- val (string->number str i))) 1e-7)
+		(begin
+		  (set! happy #f)
+		  (format #t ";(string->number ~S ~A) -> ~A (expected ~A)?~%" str i (string->number str i) val)))))))))
+
+(let ((happy #t))
+  (do ((i 2 (+ i 1)))
+      ((or (not happy)
+	   (= i 17)))
+    (if (> (abs (- 0.75 (string->number (number->string 0.75 i) i))) 1e-6)
+	(begin
+	  (set! happy #f)
+	  (format #t ";(string->number (number->string 0.75 ~A) ~A) -> ~A?~%" i i (string->number (number->string 0.75 i) i))))
+
+    (if (> (abs (- 1234.75 (string->number (number->string 1234.75 i) i))) 1e-6)
+	(begin
+	  (set! happy #f)
+	  (format #t ";(string->number (number->string 1234.75 ~A) ~A) -> ~A?~%" i i (string->number (number->string 1234.75 i) i))))
+
+    (if (> (abs (- -1234.25 (string->number (number->string -1234.25 i) i))) 1e-6)
+	(begin
+	  (set! happy #f)
+	  (format #t ";(string->number (number->string -1234.75 ~A) ~A) -> ~A?~%" i i (string->number (number->string -1234.75 i) i))))
+
+    (let ((val (string->number (number->string 12.5+3.75i i) i)))
+      (if (or (not (number? val))
+	      (> (abs (- (real-part val) 12.5)) 1e-6)
+	      (> (abs (- (imag-part val) 3.75)) 1e-6))
+	  (begin
+	    (set! happy #f)
+	    (format #t ";(string->number (number->string 12.5+3.75i ~A) ~A) -> ~A?~%" i i (string->number (number->string 12.5+3.75i i) i)))))
+
+    (let ((happy #t))
+      (do ((base 2 (+ base 1)))
+	  ((or (not happy)
+	       (= base 11))) ;;; see s7.c for an explanation of this limit
+	(do ((i 0 (+ i 1)))
+	    ((= i 10))
+	  (let* ((rl (- (random 200.0) 100.0))
+		 (im (- (random 200.0) 100.0))
+		 (rlstr (number->string rl base))
+		 (imstr (number->string im base))
+		 (val (complex rl im))
+		 (str (string-append rlstr
+				     (if (or (negative? im)
+					     (char=? (string-ref imstr 0) #\-)) ; sigh -- -0.0 is not negative!
+					 "" "+")
+				     imstr
+				     "i")))
+	    (let* ((sn (string->number str base))
+		   (nsn (and (number? sn) (number->string sn base)))
+		   (nval (and (string? nsn) (string->number nsn base))))
+	      (if (or (not nval)
+		      (> (abs (- (real-part nval) (real-part val))) 1e-3)
+		      (> (abs (- (imag-part nval) (imag-part val))) 1e-3))
+		  (begin
+		    (set! happy #f)
+		    (format #t ";(number<->string ~S ~A) -> ~A? [~A ~S]~%" str base nval sn nsn)
+		    )))))))))
+
+
+(let ((val (number->string 1.0-1.0i)))
+  (if (and (not (string=? val "1-1i"))
+	   (not (string=? val "1.0-1.0i"))
+	   (not (string=? val "1-i"))
+	   (not (string=? val "1.0-i")))
+      (begin
+	(display "(number->string 1.0-1.0i) returned ") (display val) (display "?") (newline))))
+
+(let ()
+  (define (make-integer str j digits radix zero-ok)
+    (do ((k 0 (+ k 1)))
+	((= k digits))
+      (if zero-ok
+	  (set! (str j) (#(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\a #\b #\c #\d #\e #\f) (random radix)))
+	  (set! (str j) (#(#\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\a #\b #\c #\d #\e #\f) (random (- radix 1)))))
+      (set! j (+ j 1)))
+    j)
+
+  (define (make-ratio str j ndigits ddigits radix)
+    (set! j (make-integer str j (+ 1 ndigits) radix #t))
+    (set! (str j) #\/)
+    (make-integer str (+ j 1) (+ 1 ddigits) radix #f))
+
+  (define (make-real str j digits edigits radix)
+    (let ((nj (make-integer str j (random digits) radix #t)))
+      (set! (str nj) #\.)
+      (set! j (make-integer str (+ nj 1) (+ (if (= j nj) 1 0) (random digits)) radix #t))
+      (if (and (> edigits 0)
+	       (<= radix 10))
+	  (begin
+	    (set! (str j) #\e)
+	    (set! j (make-integer str (+ j 1) (+ 1 (random edigits)) radix #t))))
+      j))
+
+  (define (make-complex str j digits edigits radix)
+    (set! j (make-real str j digits edigits radix))
+    (set! (str j) (#(#\+ #\-) (random 2)))
+    (set! j (make-real str (+ j 1) digits edigits radix))
+    (set! (str j) #\i)
+    (+ j 1))
+
+  (let ((str (make-string 512))
+	(max-digits 10)
+	(edigits 2))
+
+    (do ((i 0 (+ i 1)))
+	((= i 100))
+      (let ((j 0)
+	    (radix (+ 2 (random 15)))
+	    (choice (case (random 10)
+		      ((0 1) 'integer)
+		      ((2 3) 'ratio)
+		      ((4 5 6) 'real)
+		      (else 'complex))))
+
+	;; possible #x etc
+	(if (> (random 10) 7)
+	    (begin
+	      (set! (str j) #\#)
+	      (set! j (+ j 1))
+	      (let ((rchoice (random 3)))
+		(set! (str j) (#(#\b #\o #\x) rchoice))
+		(set! radix (#(2 8 16) rchoice)))
+	      (set! j (+ j 1))))
+
+	;; possible sign
+	(if (> (random 10) 5)
+	    (begin
+	      (set! (str j) (#(#\+ #\-) (random 2)))
+	      (set! j (+ j 1))))
+
+	(set! j (case choice
+		  ((integer) (make-integer str j (+ 1 (random max-digits)) radix #t))
+		  ((ratio)   (make-ratio str j (random max-digits) (random max-digits) radix))
+		  ((real)    (make-real str j max-digits edigits radix))
+		  ((complex) (make-complex str j max-digits edigits radix))))
+
+	(let ((num (catch #t (lambda () (string->number (substring str 0 j) radix)) (lambda args 'error))))
+	  (if (not (number? num))
+	      (format *stderr* "(string->number ~S ~D) ~60T~A~%" (substring str 0 j) radix num)))))))
+
+(let ((string->number-2 (lambda (str radix)
+			  (let ((old-str (if (string? str) (string-copy str) str)))
+			    (let ((val (string->number str radix)))
+			      (if (not (string=? str old-str))
+				  (error 'string->number-messed-up)
+				  val)))))
+      (string->number-1 (lambda (str)
+			  (let ((old-str (if (string? str) (string-copy str) str)))
+			    (let ((val (string->number str)))
+			      (if (not (string=? str old-str))
+				  (error 'string->number-messed-up)
+				  val))))))
+
+  (num-test (string->number-1 "100") 100)
+  (num-test (string->number-2 "100" 16) 256)
+  (num-test (string->number-2 "100" 2) 4)
+  (num-test (string->number-2 "100" 8) 64)
+  (num-test (string->number-2 "100" 10) 100)
+  (num-test (string->number-2 "11" 16) 17)
+  (num-test (string->number-2 "-11" 16) -17)
+  (num-test (string->number-2 "+aa" 16) 170)
+  (num-test (string->number-2 "-aa" 16) -170)
+
+  (for-each
+   (lambda (str rval fval)
+     (let ((happy #t))
+       (do ((radix 3 (+ radix 1)))
+	   ((or (not happy)
+		(= radix 16)))
+	 (let ((val (string->number-2 str radix)))
+	   (if (and (number? val)
+		    (not (fval val (rval radix) radix)))
+	       (begin
+		 (display "(string->number \"") (display str) (display "\" ") (display radix) (display ") = ") (display val) (display "?") (newline)
+		 (set! happy #f)))))))
+   (list "101"
+	 "201.02"
+	 "1/21"
+	 "2e1"
+	 "10.1e-1"
+	 )
+   (list (lambda (radix) (+ 1 (* radix radix)))
+	 (lambda (radix) (+ 1.0 (* 2 radix radix) (/ 2.0 (* radix radix))))
+	 (lambda (radix) (/ 1 (+ 1 (* 2 radix))))
+	 (lambda (radix) (if (< radix 15) (* 2 radix) (+ 1 (* 14 radix) (* 2 radix radix))))
+	 (lambda (radix) (+ 1 (/ 1.0 (* radix radix))))
+	 )
+   (list (lambda (a b radix) (= a b))
+	 (lambda (a b radix) (< (abs (- a b)) (/ 1.0 (* radix radix))))
+	 (lambda (a b radix) (= a b))
+	 (lambda (a b radix) (= a b))
+	 (lambda (a b radix) (< (abs (- a b)) (/ 1.0 (* radix radix radix))))
+	 ))
+
+  (test (string->number-2 "34" 2) #f)
+  (test (string->number-2 "19" 8) #f)
+  (test (string->number-2 "1c" 10) #f)
+  (num-test (string->number-2 "1c" 16) 28)
+
+  (test (string->number-1 "") #f)
+  (test (string->number-1 ".") #f)
+  (test (string->number-1 "d") #f)
+  (test (string->number-1 "D") #f)
+  (test (string->number-1 "i") #f)
+  (test (string->number-1 "I") #f)
+  (test (string->number-1 "3i") #f)
+  (test (string->number-1 "3I") #f)
+  (test (string->number-1 "33i") #f)
+  (test (string->number-1 "33I") #f)
+  (test (string->number-1 "3.3i") #f)
+  (test (string->number-1 "3.3I") #f)
+  (test (string->number-1 "-") #f)
+  (test (string->number-1 "+") #f)
+
+  (test (string->number "1e0+i") 1+i)
+  (test (string->number "1+ie0") #f)
+  (test (string->number "1+e0") #f)
+  (test (string->number "1+1e0i") 1+i)
+  (test (string->number "1+1e0e0i") #f)
+  (test (string->number "1+1e00i") 1+i)
+  (test (string->number "1L") #f)
+  (test (string->number "1.L") #f)
+
+  (num-test (string->number-1 "3.4e3") 3400.0)
+  (num-test (string->number-1 "0") 0))
+
+(test (let* ((str "1+0i") (x (string->number str))) (and (number? x) (string=? str "1+0i"))) #t)
+
+(for-each
+ (lambda (n)
+   (let ((nb
+	  (catch #t
+		 (lambda ()
+		   (number? n))
+		 (lambda args
+		   'error))))
+     (if (not nb)
+	 (begin
+	   (display "(number? ") (display n) (display ") returned #f?") (newline)))))
+     (list 1 -1 +1 +.1 -.1 .1 .0 0. 0.0 -0 +0 -0. +0.
+	   +1.1 -1.1 1.1
+	   '1.0e2 '-1.0e2 '+1.0e2
+	   '1.1e-2 '-1.1e-2 '+1.1e-2
+	   '1.1e+2 '-1.1e+2 '+1.1e+2
+	   '1/2 '-1/2 '+1/2
+	   '1.0+1.0i '1.0-1.0i '-1.0-1.0i '-1.0+1.0i
+	   '1+i '1-i '-1-i '-1+i
+	   '2/3+i '2/3-i '-2/3+i
+	   '1+2/3i '1-2/3i '2/3+2/3i '2.3-2/3i '2/3-2.3i
+	   '2e2+1e3i '2e2-2e2i '2.0e2+i '1+2.0e2i '2.0e+2-2.0e-1i '2/3-2.0e3i '2e-3-2/3i
+	   '-2.0e-2-2.0e-2i '+2.0e+2+2.0e+2i '+2/3-2/3i '2e2-2/3i
+	   '1e1-i '1.-i '.0+i '-.0-1e-1i '1.+.1i '0.-.1i
+	   '.1+.0i '1.+.0i '.1+.1i '1.-.1i '.0+.00i '.10+.0i '-1.+.0i '.1-.01i '1.0+.1i
+	   '1e1+.1i '-1.-.10i '1e01+.0i '0e11+.0i '1.e1+.0i '1.00-.0i '-1e1-.0i '1.-.1e0i
+	   '1.+.001i '1e10-.1i '1e+0-.1i '-0e0-.1i
+	   '-1.0e-1-1.0e-1i '-111e1-.1i '1.1-.1e11i '-1e-1-.11i '-1.1-.1e1i '-.1+.1i))
+
+(for-each
+ (lambda (n rl im)
+   (if (not (number? n))
+       (begin
+	 (display "(number? ") (display n) (display ") returned #f?") (newline))
+       (begin
+	 (if (> (abs (- (real-part n) rl)) .000001)
+	     (begin
+	       (display "real-part: ") (display n) (display " ") (display (real-part n)) (display " ") (display rl) (newline)))
+	 (if (> (abs (- (imag-part n) im)) .000001)
+	     (begin
+	       (display "imag-part: ") (display n) (display " ") (display (imag-part n)) (display " ") (display im) (newline)))
+	 )))
+ (list 1 -1 +1 +.1 -.1 .1 .0 0. 0.0 -0 +0 -0. +0.
+       +1.1 -1.1 1.1
+       '1.0e2 '-1.0e2 '+1.0e2
+       '1.1e-2 '-1.1e-2 '+1.1e-2
+       '1.1e+2 '-1.1e+2 '+1.1e+2
+       '1/2 '-1/2 '+1/2
+
+       '1.0+1.0i '1.0-1.0i '-1.0-1.0i '-1.0+1.0i
+       '1+i '1-i '-1-i '-1+i
+       '2/3+i '2/3-i '-2/3+i
+       '1+2/3i '1-2/3i '2/3+2/3i '2.3-2/3i '2/3-2.3i
+       '2e2+1e3i '2e2-2e2i '2.0e2+i '1+2.0e2i '2.0e+2-2.0e-1i '2/3-2.0e3i '2e-3-2/3i
+       '-2.0e-2-2.0e-2i '+2.0e+2+2.0e+2i '+2/3-2/3i '2e2-2/3i
+       '1e1-i '1.-i '.0+i '-.0-1e-1i '1.+.1i '0.-.1i
+       '.1+.0i '1.+.0i '.1+.1i '1.-.1i '.0+.00i '.10+.0i '-1.+.0i '.1-.01i '1.0+.1i
+       '1e1+.1i '-1.-.10i '1e01+.0i '0e11+.0i '1.e1+.0i '1.00-.0i '-1e1-.0i '1.-.1e0i
+       '1.+.001i '1e10-.1i '1e+0-.1i '-0e0-.1i
+       '-1.0e-1-1.0e-1i '-111e1-.1i '1.1-.1e11i '-1e-1-.11i '-1.1-.1e1i)
+
+ (list 1.0 -1.0 1.0 0.1 -0.1 0.1 0.0 0.0 0.0 0.0 0.0 -0.0 0.0 1.1 -1.1 1.1 100.0 -100.0
+       100.0 0.011 -0.011 0.011 110.0 -110.0 110.0 0.5 -0.5 0.5
+       1.0 1.0 -1.0 -1.0 1.0 1.0 -1.0
+       -1.0 0.66666666666667 0.66666666666667 -0.66666666666667 1.0 1.0 0.66666666666667
+       2.3 0.66666666666667 200.0 200.0 200.0 1.0 200.0 0.66666666666667 0.002 -0.02 200.0
+       0.66666666666667 200.0 10.0 1.0 0.0 -0.0 1.0 0.0 0.1 1.0 0.1 1.0 0.0 0.1 -1.0 0.1
+       1.0 10.0 -1.0 10.0 0.0 10.0 1.0 -10.0 1.0 1.0 10000000000.0 1.0 -0.0 -0.1 -1110.0
+       1.1 -0.1 -1.1)
+
+ (list 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0
+       0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 -1.0
+       -1.0 1.0 1.0 -1.0 -1.0 1.0 1.0 -1.0 1.0 0.66666666666667 -0.66666666666667
+       0.66666666666667 -0.66666666666667 -2.3 1000.0 -200.0 1.0 200.0 -0.2 -2000.0
+       -0.66666666666667 -0.02 200.0 -0.66666666666667 -0.66666666666667 -1.0 -1.0 1.0
+       -0.1 0.1 -0.1 0.0 0.0 0.1 -0.1 0.0 0.0 0.0 -0.01 0.1 0.1 -0.1 0.0 0.0 0.0 0.0
+       0.0 -0.1 0.001 -0.1 -0.1 -0.1 -0.1 -0.1 -10000000000.0 -0.11 -1.0))
+
+
+(for-each
+ (lambda (n name)
+   (if (number? n)
+       (begin
+	 (display "(number? ") (display name) (display ") returned #t?") (newline)))
+   (if (or (not (symbol? n))
+	   (boolean? n))
+       (begin
+	 (display "(symbol? ") (display name) (display ") returned #f?") (newline)))
+   (if (number? (string->number name))
+       (begin
+	 (display "(string->number ") (display name) (display ") returned ") (display (string->number name)) (display "?") (newline))))
+
+ (list '1e '--1 '++1 '+. '+.+ '.. '.- '1e- '+ '- '-e1
+       '1/2/3 '1/2+/2 '/2 '2/ '1+2 '1/+i '1/2e1 '1/2.
+       '1..0 '1.+0 '1--1 '1+- '1.0++i '1.0-ie++2 '1+1 '1.0. '1.0e
+       '1ee2 '1.0e2e2 '1es2 '1e1.0 '1.0.0 '1/2.0 '1+i2 '1+1.0i0
+       '+.i 'i 'e 'e1 '1e.1 '1+.i '1.0e.1
+       '-.1ei '-1.0+1.0 '1.0+1.0i+1.0 '1.1/2 '1/2.0
+       '1/e '1/i 'e/i '1e2/3 '2/1e2 '1e2+1e2ii '1i-1.0 '1.0-i/2
+       '1/2i '2i/3 '2+/i '2+2/i '2+2/-i '2/- '2/+ '2/+3
+       '1e1.0 '1e1e2 '1+ie2 '1ei1 '1e/2 '0-- '1+ '1- '.1. '.1+
+       '1//2 '1/-/2 '1/2/ '1// '+/1 '.0.
+       '+0ei '0e++i '+0e+i '0e+-i '+0e-i '+00ei '+.0ei '0+0ei '-01ei '+.1ei
+       '1-1ei '-1.ei '0+.i '0-.i '1+e0i '1+/0i '1-/0i '1+e1i '1+/1i '10+.i
+       '.0+.i '-0+.i '.1+.i '0.+.i '00-.i '.1-.i '1.-.i '1e++0i '1e--1i '.1e++i
+       '+10e+i '1+0e+i '+01e+i '+0e+-i '.1e+-i '1-10ei '0e++00i '1e--.1i '1.e-+1i
+       '1-0.e+i '1.+1e+i '-1.e--i '1.e+-.0i '1-e+01i '1-/101i '1+/10i '1-e10i
+       '-1+e+1i '.1-e-1i '1-/0e1i '1e10+.i '1/1.1+i '1/11.+i
+       '1/2e1-i '-1.0e-1-1-1.0e-1i '-1.0e-1-1.0e-1-1i
+       '1.0e2/3 '-1e--1.e1i '-11e--1e1i '1e--1.1e1i '1.e-1-1.ei '-1.e--1.ei
+       '-1.1e1-e1i '-1.e1-e-1i '.1e1-e-11i
+       '3.-3. '1'2 '+-2 '1?
+       '1a '1.a '-a '+a '1.. '..1 '-..1 '1ee1 '1ef2 '1+ief2 '1.+ '1.0- '1/2+/3
+       '1'2 '1-i. '1-ie '1... '1/1/1/1 '1//1 '-.e1
+       )
+ (list "1e" "--1" "++1" "+." "+.+" ".." ".-" "1e-" "+" "-" "-e1"
+       "1/2/3" "1/2+/2" "/2" "2/" "1+2" "1/+i" "1/2e1" "1/2."
+       "1..0" "1.+0" "1--1" "1+-" "1.0++i" "1.0-ie++2" "1+1" "1.0." "1.0e"
+       "1ee2" "1.0e2e2" "1es2" "1e1.0" "1.0.0" "1/2.0" "1+i2" "1+1.0i0"
+       "+.i" "i" "e" "e1" "1e.1" "1+.i" "1.0e.1"
+       "-.1ei" "-1.0+1.0" "1.0+1.0i+1.0" "1.1/2" "1/2.0"
+       "1/e" "1/i" "e/i" "1e2/3" "2/1e2" "1e2+1e2ii" "1i-1.0" "1.0-i/2"
+       "1/2i" "2i/3" "2+/i" "2+2/i" "2+2/-i" "2/-" "2/+" "2/+3"
+       "1e1.0" "1e1e2" "1+ie2" "1ei1" "1e/2" "0--" "1+" "1-" ".1." ".1+"
+       "1//2" "1/-/2" "1/2/" "1//" "+/1" ".0."
+       "+0ei" "0e++i" "+0e+i" "0e+-i" "+0e-i" "+00ei" "+.0ei" "0+0ei" "-01ei" "+.1ei"
+       "1-1ei" "-1.ei" "0+.i" "0-.i" "1+e0i" "1+/0i" "1-/0i" "1+e1i" "1+/1i" "10+.i"
+       ".0+.i" "-0+.i" ".1+.i" "0.+.i" "00-.i" ".1-.i" "1.-.i" "1e++0i" "1e--1i" ".1e++i"
+       "+10e+i" "1+0e+i" "+01e+i" "+0e+-i" ".1e+-i" "1-10ei" "0e++00i" "1e--.1i" "1.e-+1i"
+       "1-0.e+i" "1.+1e+i" "-1.e--i" "1.e+-.0i" "1-e+01i" "1-/101i" "1+/10i" "1-e10i"
+       "-1+e+1i" ".1-e-1i" "1-/0e1i" "1e10+.i" "1/1.1+i" "1/11.+i"
+       "1/2e1-i" "-1.0e-1-1-1.0e-1i" "-1.0e-1-1.0e-1-1i"
+       "1.0e2/3" "-1e--1.e1i" "-11e--1e1i" "1e--1.1e1i" "1.e-1-1.ei" "-1.e--1.ei"
+       "-1.1e1-e1i" "-1.e1-e-1i" ".1e1-e-11i"
+       "3.-3." "'1'2" "'+-2" "'1?"
+       "1a" "1.a" "-a" "+a" "1.." "..1" "-..1" "1ee1" "1ef2" "1+ief2" "1.+" "1.0-" "1/2+/3"
+       "'1'2" "1-i." "1-ie" "1..." "1/1/1/1" "1//1" "-.e1"
+       ))
+
+(let ((val (catch #t
+		  (lambda ()
+		    (= 1
+
+		       01 +1 1.
+
+		       001 +01 1/1 1.0 1e0 01. +1. #b1 #o1 #x1 2/2 3/3 4/4 5/5 6/6 7/7 8/8 9/9
+		       1E0 1e0
+
+		       0001 +001 1/01 .1e1 01/1 +1/1 1.00 1e00 01.0 +1.0 1e+0 1e-0 01e0 +1e0 1.e0 001. +01. 1+0i 1-0i
+		       #b+1 #b01 #b1. #o+1 #o01 #o1. #x+1 #x01 #x1.
+		       +1E0 +1e0 +2/2 +3/3 +4/4 +5/5 +6/6 +7/7 +8/8 +9/9
+		       .1E1 0001 001. 01.0 01/1 01E0
+		       02/2 03/3 04/4 05/5 06/6 07/7 08/8 09/9
+		       1.E0 1/01 1E+0 1E-0 1E00
+		       2/02 3/03 4/04 5/05 6/06 7/07 8/08 9/09
+
+		       11/11 00001 +0001 1/001 .1e01 01/01 +1/01 .1e+1 10e-1 0.1e1 +.1e1 .10e1 001/1 +01/1 10/10 1.000 1e000
+		       01.00 +1.00 1e+00 1e-00 01e00 +1e00 1.e00 001.0 +01.0 01e+0 +1e+0 1.e+0 01e-0 +1e-0 1.e-0 001e0 +01e0
+		       1.0e0 01.e0 +1.e0 0001. +001. 1+00i 1-00i 1+.0i 1-.0i 01+0i +1+0i 1.+0i 01-0i +1-0i 1.-0i 1+0.i 1-0.i
+
+		       11/011 011/11 +11/11 000001 +00001 1/0001 .1e001 01/001 +1/001 .1e+01 10e-01 0.1e01 +.1e01 .10e01 001/01
+		       +01/01 0.1e+1 +.1e+1 .10e+1 010e-1 +10e-1 10.e-1 00.1e1 +0.1e1 0.10e1 +.10e1 .100e1 0001/1 +001/1 10/010
+		       010/10 +10/10 1.0000 1e0000 01.000 +1.000 1e+000 1e-000 01e000 +1e000 1.e000 001.00 +01.00 01e+00 +1e+00
+		       1.e+00 01e-00 +1e-00 1.e-00 001e00 +01e00 1.0e00 01.e00 +1.e00 0001.0 +001.0 001e+0 +01e+0 1.0e+0 01.e+0
+		       +1.e+0 001e-0 +01e-0 1.0e-0 01.e-0 +1.e-0 0001e0 +001e0 1.00e0 01.0e0 +1.0e0 001.e0 +01.e0 00001. +0001.
+		       1+0e1i 1-0e1i 1+0/1i 1-0/1i 1+000i 1-000i 1+.00i 1-.00i 01+00i +1+00i 1.+00i 01-00i +1-00i 1.-00i 1+0.0i
+		       1-0.0i 01+.0i +1+.0i 1.+.0i 01-.0i +1-.0i 1.-.0i 001+0i +01+0i 1/1+0i 1.0+0i 1e0+0i 01.+0i +1.+0i 001-0i
+		       +01-0i 1/1-0i 1.0-0i 1e0-0i 01.-0i +1.-0i 1+0e0i 1-0e0i 1+00.i 1-00.i 01+0.i +1+0.i 1.+0.i 01-0.i +1-0.i
+		       1.-0.i
+
+		       111/111 11/0011 011/011 +11/011 0011/11 +011/11 101/101 0000001 +000001 1/00001 .1e0001 01/0001 +1/0001
+		       .1e+001 10e-001 0.1e001 +.1e001 .10e001 001/001 +01/001 0.1e+01 +.1e+01 .10e+01 010e-01 +10e-01 10.e-01
+		       00.1e01 +0.1e01 0.10e01 +.10e01 .100e01 0001/01 +001/01 00.1e+1 +0.1e+1 0.10e+1 +.10e+1 .100e+1 0010e-1
+		       +010e-1 10.0e-1 010.e-1 +10.e-1 000.1e1 +00.1e1 00.10e1 +0.10e1 0.100e1 +.100e1 .1000e1 00001/1 +0001/1
+		       110/110 10/0010 010/010 +10/010 0010/10 +010/10 100/100 1.00000 1e00000 01.0000 +1.0000 1e+0000 1e-0000
+		       01e0000 +1e0000 1.e0000 001.000 +01.000 01e+000 +1e+000 1.e+000 01e-000 +1e-000 1.e-000 001e000 +01e000
+		       1.0e000 01.e000 +1.e000 0001.00 +001.00 001e+00 +01e+00 1.0e+00 01.e+00 +1.e+00 001e-00 +01e-00 1.0e-00
+		       01.e-00 +1.e-00 0001e00 +001e00 1.00e00 01.0e00 +1.0e00 001.e00 +01.e00 00001.0 +0001.0 0001e+0 +001e+0
+		       1.00e+0 01.0e+0 +1.0e+0 001.e+0 +01.e+0 0001e-0 +001e-0 1.00e-0 01.0e-0 +1.0e-0 001.e-0 +01.e-0 00001e0
+		       +0001e0 1.000e0 01.00e0 +1.00e0 001.0e0 +01.0e0 0001.e0 +001.e0 000001. +00001. 1+0e11i 1-0e11i 1+0/11i
+		       1-0/11i 1+0e01i 1-0e01i 1+0/01i 1-0/01i 1+0e+1i 1-0e+1i 1+0e-1i 1-0e-1i 1+00e1i 1-00e1i 1+.0e1i 1-.0e1i
+		       01+0e1i +1+0e1i 1.+0e1i 01-0e1i +1-0e1i 1.-0e1i 1+0.e1i 1-0.e1i 1+00/1i 1-00/1i 01+0/1i +1+0/1i 1.+0/1i
+		       01-0/1i +1-0/1i 1.-0/1i 1+0e10i 1-0e10i 1+0/10i 1-0/10i 1+0000i 1-0000i 1+.000i 1-.000i 01+000i +1+000i
+		       1.+000i 01-000i +1-000i 1.-000i 1+0.00i 1-0.00i 01+.00i +1+.00i 1.+.00i 01-.00i +1-.00i 1.-.00i 001+00i
+		       +01+00i 1/1+00i 1.0+00i 1e0+00i 01.+00i +1.+00i 001-00i +01-00i 1/1-00i 1.0-00i 1e0-00i 01.-00i +1.-00i
+		       1+0e00i 1-0e00i 1+00.0i 1-00.0i 01+0.0i +1+0.0i 1.+0.0i 01-0.0i +1-0.0i 1.-0.0i 001+.0i +01+.0i 1/1+.0i
+		       1.0+.0i 1e0+.0i 01.+.0i +1.+.0i 001-.0i +01-.0i 1/1-.0i 1.0-.0i 1e0-.0i 01.-.0i +1.-.0i 0001+0i +001+0i
+		       1/01+0i .1e1+0i 01/1+0i +1/1+0i 1.00+0i 1e00+0i 01.0+0i +1.0+0i 1e+0+0i 1e-0+0i 01e0+0i +1e0+0i 1.e0+0i
+		       001.+0i +01.+0i 1+0e+0i 1-0e+0i 0001-0i +001-0i 1/01-0i .1e1-0i 01/1-0i +1/1-0i 1.00-0i 1e00-0i 01.0-0i
+		       +1.0-0i 1e+0-0i 1e-0-0i 01e0-0i +1e0-0i 1.e0-0i 001.-0i +01.-0i 1+0e-0i 1-0e-0i 1+00e0i 1-00e0i 1+.0e0i
+		       1-.0e0i 01+0e0i +1+0e0i 1.+0e0i 01-0e0i +1-0e0i 1.-0e0i 1+0.e0i 1-0.e0i 1+000.i 1-000.i 01+00.i +1+00.i
+		       1.+00.i 01-00.i +1-00.i 1.-00.i 001+0.i +01+0.i 1/1+0.i 1.0+0.i 1e0+0.i 01.+0.i +1.+0.i 001-0.i +01-0.i
+		       1/1-0.i 1.0-0.i 1e0-0.i 01.-0.i +1.-0.i
+
+		       111/0111 0111/111 +111/111 11/00011 011/0011 +11/0011 0011/011 +011/011 00011/11 +0011/11 101/0101 0101/101
+		       +101/101 00000001 +0000001 1/000001 .1e00001 01/00001 +1/00001 .1e+0001 10e-0001 0.1e0001 +.1e0001 .10e0001
+		       001/0001 +01/0001 0.1e+001 +.1e+001 .10e+001 010e-001 +10e-001 10.e-001 00.1e001 +0.1e001 0.10e001 +.10e001
+		       .100e001 0001/001 +001/001 00.1e+01 +0.1e+01 0.10e+01 +.10e+01 .100e+01 0010e-01 +010e-01 10.0e-01 010.e-01
+		       +10.e-01 000.1e01 +00.1e01 00.10e01 +0.10e01 0.100e01 +.100e01 .1000e01 00001/01 +0001/01 000.1e+1 +00.1e+1
+		       00.10e+1 +0.10e+1 0.100e+1 +.100e+1 .1000e+1 00010e-1 +0010e-1 10.00e-1 010.0e-1 +10.0e-1 0010.e-1 +010.e-1
+		       0000.1e1 +000.1e1 000.10e1 +00.10e1 00.100e1 +0.100e1 0.1000e1 +.1000e1 .10000e1 000001/1 +00001/1 110/0110
+		       0110/110 +110/110 10/00010 010/0010 +10/0010 0010/010 +010/010 00010/10 +0010/10 100/0100 0100/100 +100/100
+		       1.000000 1e000000 01.00000 +1.00000 1e+00000 1e-00000 01e00000 +1e00000 1.e00000 001.0000 +01.0000 01e+0000
+		       +1e+0000 1.e+0000 01e-0000 +1e-0000 1.e-0000 001e0000 +01e0000 1.0e0000 01.e0000 +1.e0000 0001.000 +001.000
+		       001e+000 +01e+000 1.0e+000 01.e+000 +1.e+000 001e-000 +01e-000 1.0e-000 01.e-000 +1.e-000 0001e000 +001e000
+		       1.00e000 01.0e000 +1.0e000 001.e000 +01.e000 00001.00 +0001.00 0001e+00 +001e+00 1.00e+00 01.0e+00 +1.0e+00
+		       001.e+00 +01.e+00 0001e-00 +001e-00 1.00e-00 01.0e-00 +1.0e-00 001.e-00 +01.e-00 00001e00 +0001e00 1.000e00
+		       01.00e00 +1.00e00 001.0e00 +01.0e00 0001.e00 +001.e00 000001.0 +00001.0 00001e+0 +0001e+0 1.000e+0 01.00e+0
+		       +1.00e+0 001.0e+0 +01.0e+0 0001.e+0 +001.e+0 00001e-0 +0001e-0 1.000e-0 01.00e-0 +1.00e-0 001.0e-0 +01.0e-0
+		       0001.e-0 +001.e-0 000001e0 +00001e0 1.0000e0 01.000e0 +1.000e0 001.00e0 +01.00e0 0001.0e0 +001.0e0 00001.e0
+		       +0001.e0 0000001. +000001.))
+		  (lambda args 'error))))
+  (if (not (eq? val #t))
+      (format #t ";funny 1's are not all equal to 1? ~A~%" val)))
+
+(num-test (string->number "2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427") 2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427)
+
+;; from testbase-report.ps Vern Paxson (with some changes)
+;; resultant strings are thanks to clisp
+(let ((cases
+       (list
+	(list '(* 49517601571415211 (expt 2 -94)) "2.5e-12")
+	(list '(* 49517601571415211 (expt 2 -95)) "1.25e-12")
+	(list '(* 54390733528642804 (expt 2 -133)) "4.995e-24")
+	(list '(* 71805402319113924 (expt 2 -157)) "3.9305e-31")
+	(list '(* 40435277969631694 (expt 2 -179)) "5.27705e-38")
+	(list '(* 57241991568619049 (expt 2 -165)) "1.223955e-33")
+	(list '(* 65224162876242886 (expt 2.0 58)) "1.8799585e+34")
+	(list '(* 70173376848895368 (expt 2 -138)) "2.01387715e-25")
+	(list '(* 37072848117383207 (expt 2 -99)) "5.849064105e-14")
+	(list '(* 56845051585389697 (expt 2 -176)) "5.9349003055e-37")
+	(list '(* 54791673366936431 (expt 2 -145)) "1.22847180395e-27")
+	(list '(* 66800318669106231 (expt 2 -169)) "8.927076718085e-35")
+	(list '(* 66800318669106231 (expt 2 -170)) "4.4635383590425e-35")
+	(list '(* 66574323440112438 (expt 2 -119)) "1.00169908625495e-19")
+	(list '(* 65645179969330963 (expt 2 -173)) "5.482941262802465e-36")
+	(list '(* 61847254334681076 (expt 2 -109)) "9.529078328103644e-17")
+	(list '(* 39990712921393606 (expt 2 -145)) "8.966227936640557e-28")
+	(list '(* 59292318184400283 (expt 2 -149)) "8.308623441805854e-29")
+	(list '(* 69116558615326153 (expt 2 -143)) "6.1985873566126555e-27")
+	(list '(* 69116558615326153 (expt 2 -144)) "3.0992936783063277e-27")
+	(list '(* 39462549494468513 (expt 2 -152)) "6.912351250617602e-30")
+	(list '(* 39462549494468513 (expt 2 -153)) "3.456175625308801e-30")
+	(list '(* 50883641005312716 (expt 2 -172)) "8.5e-36")
+	(list '(* 38162730753984537 (expt 2 -170)) "2.55e-35")
+	(list '(* 50832789069151999 (expt 2 -101)) "2.005e-14")
+	(list '(* 51822367833714164 (expt 2 -109)) "7.984499999999999e-17")
+	(list '(* 66840152193508133 (expt 2 -172)) "1.11655e-35")
+	(list '(* 55111239245584393 (expt 2 -138)) "1.581615e-25")
+	(list '(* 71704866733321482 (expt 2 -112)) "1.3809855e-17")
+	(list '(* 67160949328233173 (expt 2 -142)) "1.20464045e-26")
+	(list '(* 53237141308040189 (expt 2 -152)) "9.325140545e-30")
+	(list '(* 62785329394975786 (expt 2 -112)) "1.2092014595e-17")
+	(list '(* 48367680154689523 (expt 2 -77)) "3.20070458385e-07")
+	(list '(* 42552223180606797 (expt 2 -102)) "8.391946324355e-15")
+	(list '(* 63626356173011241 (expt 2 -112)) "1.2253990460585e-17")
+	(list '(* 43566388595783643 (expt 2 -99)) "6.87356414897605e-14")
+	(list '(* 54512669636675272 (expt 2 -159)) "7.459816430480385e-32")
+	(list '(* 52306490527514614 (expt 2 -167)) "2.7960588398142556e-34")
+	(list '(* 52306490527514614 (expt 2 -168)) "1.3980294199071278e-34")
+	(list '(* 41024721590449423 (expt 2 -89)) "6.627901237305737e-11")
+	(list '(* 37664020415894738 (expt 2 -132)) "6.917788004396807e-24")
+	(list '(* 37549883692866294 (expt 2 -93)) "3.791569310834971e-12")
+	(list '(* 69124110374399839 (expt 2 -104)) "3.408081767659137e-15")
+	(list '(* 69124110374399839 (expt 2 -105)) "1.7040408838295685e-15")
+	(list '(* 9 (expt 10 26)) "9e+26")
+	(list '(* 79 (expt 10 -8)) "7.9e-07")
+	(list '(* 393 (expt 10.0 26)) "3.93e+28")
+	(list '(* 9171 (expt 10 -40)) "9.171e-37")
+	(list '(* 56257 (expt 10 -16)) "5.6257e-12")
+	(list '(* 281285 (expt 10 -17)) "2.81285e-12")
+	(list '(* 4691113 (expt 10 -43)) "4.691113e-37")
+	(list '(* 29994057 (expt 10 -15)) "2.9994057e-08")
+	(list '(* 834548641 (expt 10 -46)) "8.34548641e-38")
+	(list '(* 1058695771 (expt 10 -47)) "1.058695771e-38")
+	(list '(* 87365670181 (expt 10 -18)) "8.7365670181e-08")
+	(list '(* 872580695561 (expt 10 -36)) "8.72580695561e-25")
+	(list '(* 6638060417081 (expt 10 -51)) "6.638060417081e-39")
+	(list '(* 88473759402752 (expt 10 -52)) "8.8473759402752e-39")
+	(list '(* 412413848938563 (expt 10 -27)) "4.12413848938563e-13")
+	(list '(* 5592117679628511 (expt 10 -48)) "5.592117679628511e-33")
+	(list '(* 83881765194427665 (expt 10 -50)) "8.388176519442766e-34")
+					;(list '(* 638632866154697279 (expt 10 -35)) "6.3863286615469725e-18")
+					;(list '(* 3624461315401357483 (expt 10 -53)) "3.6244613154013574e-35")
+					;(list '(* 75831386216699428651 (expt 10 -30)) "7.583138621669942e-11")
+					;(list '(* 356645068918103229683 (expt 10 -42)) "3.566450689181032e-22")
+					;(list '(* 7022835002724438581513 (expt 10 -33)) "7.022835002724439e-12")
+	(list '(* 7 (expt 10 -27)) "7e-27")
+	(list '(* 37 (expt 10 -29)) "3.7e-28")
+	(list '(* 743 (expt 10 -18)) "7.43e-16")
+	(list '(* 7861 (expt 10 -33)) "7.861e-30")
+	(list '(* 46073 (expt 10 -30)) "4.6073e-26")
+	(list '(* 774497 (expt 10 -34)) "7.74497e-29")
+	(list '(* 8184513 (expt 10 -33)) "8.184513e-27")
+	(list '(* 89842219 (expt 10 -28)) "8.9842219e-21")
+	(list '(* 449211095 (expt 10 -29)) "4.49211095e-21")
+	(list '(* 8128913627 (expt 10 -40)) "8.128913627e-31")
+	(list '(* 87365670181 (expt 10 -18)) "8.7365670181e-08")
+	(list '(* 436828350905 (expt 10 -19)) "4.36828350905e-08")
+	(list '(* 5569902441849 (expt 10 -49)) "5.569902441849e-37")
+	(list '(* 60101945175297 (expt 10 -32)) "6.0101945175297e-19")
+	(list '(* 754205928904091 (expt 10 -51)) "7.54205928904091e-37")
+	(list '(* 5930988018823113 (expt 10 -37)) "5.930988018823113e-22")
+	(list '(* 51417459976130695 (expt 10 -27)) "5.14174599761307e-11")
+	(list '(* 826224659167966417 (expt 10 -41)) "8.262246591679665e-24")
+					;(list '(* 9612793100620708287 (expt 10 -57)) "9.612793100620708e-39")
+					;(list '(* 93219542812847969081 (expt 10 -39)) "9.321954281284797e-20")
+					;(list '(* 544579064588249633923 (expt 10 -48)) "5.445790645882496e-28")
+					;(list '(* 4985301935905831716201 (expt 10 -48)) "4.9853019359058315e-27")
+	(list '(* 12676506 (expt 2 -102)) "2.499999999549897e-24")
+	(list '(* 12676506 (expt 2 -103)) "1.2499999997749484e-24")
+	(list '(* 15445013 (expt 2.0 86)) "1.1949999999989506e+33")
+	(list '(* 13734123 (expt 2 -138)) "3.941499999999621e-35")
+	(list '(* 12428269 (expt 2 -130)) "9.13084999999985e-33")
+	(list '(* 15334037 (expt 2 -146)) "1.719004999999994e-37")
+	(list '(* 11518287 (expt 2 -41)) "5.237910499999998e-06")
+	(list '(* 12584953 (expt 2 -145)) "2.82164405e-37")
+	(list '(* 15961084 (expt 2 -125)) "3.752432815e-31")
+	(list '(* 14915817 (expt 2 -146)) "1.6721209165e-37")
+	(list '(* 10845484 (expt 2 -102)) "2.13889458145e-24")
+	(list '(* 16431059 (expt 2 -61)) "7.125835945615e-12")
+	(list '(* 16093626 (expt 2.0 69)) "9.500000001279935e+27")
+	(list '(* 9983778 (expt 2.0 25)) "335000000004096.0")
+	(list '(* 12745034 (expt 2.0 104)) "2.5850000000046706e+38")
+	(list '(* 12706553 (expt 2.0 72)) "6.000500000000674e+28")
+	(list '(* 11005028 (expt 2.0 45)) "3.8720500000001465e+20")
+	(list '(* 15059547 (expt 2.0 71)) "3.555835000000006e+28")
+	(list '(* 16015691 (expt 2 -99)) "2.5268305000000024e-23")
+	(list '(* 8667859 (expt 2.0 56)) "6.24585065e+23")
+	(list '(* 14855922 (expt 2 -82)) "3.072132665e-18")
+	(list '(* 14855922 (expt 2 -83)) "1.5360663325e-18")
+	(list '(* 10144164 (expt 2 -110)) "7.81477968335e-27")
+	(list '(* 13248074 (expt 2.0 95)) "5.248102799365e+35")
+	(list '(* 5 (expt 10 -20)) "5e-20")
+	(list '(* 67 (expt 10.0 14)) "6.7e+15")
+	(list '(* 985 (expt 10.0 15)) "9.85e+17")
+	(list '(* 7693 (expt 10 -42)) "7.693e-39")
+	(list '(* 55895 (expt 10 -16)) "5.5895e-12")
+	(list '(* 996622 (expt 10 -44)) "9.96622e-39")
+	(list '(* 7038531 (expt 10 -32)) "7.038531e-26")
+	(list '(* 60419369 (expt 10 -46)) "6.0419369e-39")
+	(list '(* 702990899 (expt 10 -20)) "7.02990899e-12")
+	(list '(* 6930161142 (expt 10 -48)) "6.930161142e-39")
+	(list '(* 25933168707 (expt 10.0 13)) "2.5933168707e+23")
+	(list '(* 596428896559 (expt 10.0 20)) "5.96428896559e+31")
+	(list '(* 3 (expt 10 -23)) "3e-23")
+	(list '(* 57 (expt 10.0 18)) "5.7e+19")
+	(list '(* 789 (expt 10 -35)) "7.89e-33")
+	(list '(* 2539 (expt 10 -18)) "2.539e-15")
+	(list '(* 76173 (expt 10.0 28)) "7.6173e+32")
+	(list '(* 887745 (expt 10 -11)) "8.87745e-06")
+	(list '(* 5382571 (expt 10 -37)) "5.382571e-31")
+	(list '(* 82381273 (expt 10 -35)) "8.2381273e-28")
+	(list '(* 750486563 (expt 10 -38)) "7.50486563e-30")
+	(list '(* 3752432815 (expt 10 -39)) "3.752432815e-30")
+	(list '(* 75224575729 (expt 10 -45)) "7.5224575729e-35")
+	(list '(* 459926601011 (expt 10.0 15)) "4.59926601011e+26") ; 10.0 (and 2.0 above) because we aren't interested here in numeric overflows
+	)))
+  (let ((maxdiff 0.0)
+	(maxdiff-case ()))
+    (do ((lst cases (cdr lst)))
+	((null? lst))
+      (let* ((form (caar lst))
+	     (str (cadar lst))
+	     (num (eval form))
+	     (fnum (* 1.0 num))
+	     (n2s (number->string fnum))
+	     (s2n (string->number n2s))
+	     (mnum (string->number str))
+	     (diff (let ()
+		     (if (not (string? n2s))
+			 (format #t "(number->string ~A) #f?~%" fnum))
+		     (if (not (number? s2n))
+			 (format #t "(string->number ~S) #f?~%" n2s))
+		     (/ (abs (- mnum s2n)) (max (expt 2 -31.0) (abs fnum))))))
+	(if (> diff maxdiff)
+	    (begin
+	      (set! maxdiff diff)
+	      (set! maxdiff-case (car lst))))))
+    (if (> maxdiff 1e-15) ; we're only interested in real problems
+	(format #t ";number->string rounding checks worst case relative error ~A ~A ~S~%" maxdiff (car maxdiff-case) (cadr maxdiff-case)))
+    ))
+
+
+#|
+;;; here's code to generate all (im)possible numbers (using just a few digits) of a given length
+
+(define file (open-output-file "ntest.scm"))
+(define chars (list #\1 #\0 #\9 #\# #\. #\+ #\- #\/ #\b #\x #\o #\e))
+
+(define (all-syms len with-file)
+  (let ((sym (make-string len))
+	(num-chars (length chars))
+	(ctrs (make-vector len 0)))
+    (do ((i 0 (+ i 1)))
+	((= i (expt num-chars len)))
+      (let ((carry #t))
+	(do ((k 0 (+ k 1)))
+	    ((or (= k len)
+		 (not carry)))
+	  (vector-set! ctrs k (+ 1 (vector-ref ctrs k)))
+	  (if (= (vector-ref ctrs k) num-chars)
+	      (vector-set! ctrs k 0)
+	      (set! carry #f)))
+	(do ((k 0 (+ k 1)))
+	    ((= k len))
+	  (string-set! sym k (list-ref chars (vector-ref ctrs k)))))
+      (let ((tag (catch #t (lambda () (string->number sym)) (lambda args (car args)))))
+	(if (not with-file)
+	    (if (and (number? tag)
+		     (= tag 1))
+		(format #t "~S " sym))
+	    (begin
+	      (if (number? tag)
+		  (format file "(if (not (number? (string->number ~S))) (begin (display ~S) (display #\\space)))" sym sym)
+		  (format file "(if (number? (string->number ~S)) (begin (display ~S) (display #\\space)))" sym sym))
+	      (newline file)))))))
+
+(do ((len 1 (+ len 1)))
+    ((= len 12))
+  (all-syms len #f))
+
+(close-output-port file)
+|#
+
+(let ()
+  (define (~ !) (* 2 !))
+  (test (~ 3) 6)
+  (define (~~ !) (* 2 !))
+  (test (~~ 3) 6)
+  (define (\x00 !) (* 2 !))
+  (test (\x00 3) 6))
+
+(for-each
+ (lambda (n name)
+   (if (number? n)
+       (format #t ";(number? ~A) returned #t?~%" name)))
+ (list
+  'a9 'aa 'aA 'a! 'a$ 'a% 'a& 'a* 'a+ 'a- 'a. 'a/ 'a: 'a< 'a= 'a> 'a? 'a@ 'a^ 'a_ 'a~ 'A9 'Aa 'AA 'A! 'A$ 'A% 'A& 'A* 'A+ 'A- 'A. 'A/ 'A: 'A< 'A= 'A> 'A? 'A@ 'A^ 'A_ 'A~ '!9 '!a '!A '!! '!$ '!% '!& '!* '!+ '!- '!. '!/ '!: '!< '!= '!> '!? '!@ '!^ '!_ '!~ '$9 '$a '$A '$! '$$ '$% '$& '$* '$+ '$- '$. '$/ '$: '$< '$= '$> '$? '$@ '$^ '$_ '$~ '%9 '%a '%A '%! '%$ '%% '%& '%* '%+ '%- '%. '%/ '%: '%< '%= '%> '%? '%@ '%^ '%_ '%~ '&9 '&a '&A '&! '&$ '&% '&& '&* '&+ '&- '&. '&/ '&: '&< '&= '&> '&? '&@ '&^ '&_ '&~ '*9 '*a '*A '*! '*$ '*% '*& '** '*+ '*- '*. '*/ '*: '*< '*= '*> '*? '*@ '*^ '*_ '*~ '/9 '/a '/A '/! '/$ '/% '/& '/* '/+ '/- '/. '// '/: '/< '/= '/> '/? '/@ '/^ '/_ '/~ ':9 ':a ':A ':! ':$ ':% ':& ':* ':+ ':- ':. ':/ ':: ':< ':= ':> ':? ':@ ':^ ':_ ':~ '<9 '<a '<A '<! '<$ '<% '<& '<* '<+ '<- '<. '</ '<: '<< '<= '<> '<? '<@ '<^ '<_ '<~ '=9 '=a '=A '=! '=$ '=% '=& '=* '=+ '=- '=. '=/ '=: '=< '== '=> '=? '=@ '=^ '=_ '=~ '>9 '>a '>A '>! '>$ '>% '>& '>* '>+ '>- '>. '>/ '>: '>< '>= '>> '>? '>@ '>^ '>_ '>~ '?9 '?a '?A '?! '?$ '?% '?& '?* '?+ '?- '?. '?/ '?: '?< '?= '?> '?? '?@ '?^ '?_ '?~ '^9 '^a '^A '^! '^$ '^% '^& '^* '^+ '^- '^. '^/ '^: '^< '^= '^> '^? '^@ '^^ '^_ '^~ '_9 '_a '_A '_! '_$ '_% '_& '_* '_+ '_- '_. '_/ '_: '_< '_= '_> '_? '_@ '_^ '__ '_~ '~9 '~a '~A '~! '~$ '~% '~& '~* '~+ '~- '~. '~/ '~: '~< '~= '~> '~? '~@ '~^ '~_ '~~)
+
+ (list
+  "'a9" "'aa" "'aA" "'a!" "'a$" "'a%" "'a&" "'a*" "'a+" "'a-" "'a." "'a/" "'a:" "'a<" "'a=" "'a>" "'a?" "'a@" "'a^" "'a_" "'a~" "'A9" "'Aa" "'AA" "'A!" "'A$" "'A%" "'A&" "'A*" "'A+" "'A-" "'A." "'A/" "'A:" "'A<" "'A=" "'A>" "'A?" "'A@" "'A^" "'A_" "'A~" "'!9" "'!a" "'!A" "'!!" "'!$" "'!%" "'!&" "'!*" "'!+" "'!-" "'!." "'!/" "'!:" "'!<" "'!=" "'!>" "'!?" "'!@" "'!^" "'!_" "'!~" "'$9" "'$a" "'$A" "'$!" "'$$" "'$%" "'$&" "'$*" "'$+" "'$-" "'$." "'$/" "'$:" "'$<" "'$=" "'$>" "'$?" "'$@" "'$^" "'$_" "'$~" "'%9" "'%a" "'%A" "'%!" "'%$" "'%%" "'%&" "'%*" "'%+" "'%-" "'%." "'%/" "'%:" "'%<" "'%=" "'%>" "'%?" "'%@" "'%^" "'%_" "'%~" "'&9" "'&a" "'&A" "'&!" "'&$" "'&%" "'&&" "'&*" "'&+" "'&-" "'&." "'&/" "'&:" "'&<" "'&=" "'&>" "'&?" "'&@" "'&^" "'&_" "'&~" "'*9" "'*a" "'*A" "'*!" "'*$" "'*%" "'*&" "'**" "'*+" "'*-" "'*." "'*/" "'*:" "'*<" "'*=" "'*>" "'*?" "'*@" "'*^" "'*_" "'*~" "'/9" "'/a" "'/A" "'/!" "'/$" "'/%" "'/&" "'/*" "'/+" "'/-" "'/." "'//" "'/:" "'/<" "'/=" "'/>" "'/?" "'/@" "'/^" "'/_" "'/~" "':9" "':a" "':A" "':!" "':$" "':%" "':&" "':*" "':+" "':-" "':." "':/" "'::" "':<" "':=" "':>" "':?" "':@" "':^" "':_" "':~" "'<9" "'<a" "'<A" "'<!" "'<$" "'<%" "'<&" "'<*" "'<+" "'<-" "'<." "'</" "'<:" "'<<" "'<=" "'<>" "'<?" "'<@" "'<^" "'<_" "'<~" "'=9" "'=a" "'=A" "'=!" "'=$" "'=%" "'=&" "'=*" "'=+" "'=-" "'=." "'=/" "'=:" "'=<" "'==" "'=>" "'=?" "'=@" "'=^" "'=_" "'=~" "'>9" "'>a" "'>A" "'>!" "'>$" "'>%" "'>&" "'>*" "'>+" "'>-" "'>." "'>/" "'>:" "'><" "'>=" "'>>" "'>?" "'>@" "'>^" "'>_" "'>~" "'?9" "'?a" "'?A" "'?!" "'?$" "'?%" "'?&" "'?*" "'?+" "'?-" "'?." "'?/" "'?:" "'?<" "'?=" "'?>" "'??" "'?@" "'?^" "'?_" "'?~" "'^9" "'^a" "'^A" "'^!" "'^$" "'^%" "'^&" "'^*" "'^+" "'^-" "'^." "'^/" "'^:" "'^<" "'^=" "'^>" "'^?" "'^@" "'^^" "'^_" "'^~" "'_9" "'_a" "'_A" "'_!" "'_$" "'_%" "'_&" "'_*" "'_+" "'_-" "'_." "'_/" "'_:" "'_<" "'_=" "'_>" "'_?" "'_@" "'_^" "'__" "'_~" "'~9" "'~a" "'~A" "'~!" "'~$" "'~%" "'~&" "'~*" "'~+" "'~-" "'~." "'~/" "'~:" "'~<" "'~=" "'~>" "'~?" "'~@" "'~^" "'~_" "'~~"))
+
+					;(let ((initial-chars "aA!$%&*/:<=>?^_~")
+					;      (subsequent-chars "9aA!$%&*+-./:<=>?@^_~"))
+					;  (do ((i 0 (+ i 1)))
+					;      ((= i (string-length initial-chars)))
+					;    (do ((k 0 (+ k 1)))
+					;	((= k (string-length subsequent-chars)))
+					;      (format #t "'~A " (string (string-ref initial-chars i) (string-ref subsequent-chars k))))))
+
+
+(for-each
+ (lambda (z)
+   (if (not (zero? z))
+       (format #t "~A is not zero?~%" z))
+   (if (and (real? z) (positive? z))
+       (format #t "~A is positive?~%" z))
+   (if (and (real? z) (negative? z))
+       (format #t "~A is negative?~%" z)))
+ '(0 -0 +0 0.0 -0.0 +0.0 0/1 -0/1 +0/24 0+0i 0-0i -0-0i +0-0i 0.0-0.0i -0.0+0i #b0 #o-0 #x000 000/111))
+
+
+(for-each
+ (lambda (x)
+   (if (string->number x)
+       (format #t ";(string->number ~A) returned ~A~%" x (string->number x))))
+ '("" "q" "1q" "6+7iq" "8+9q" "10+11" "13+" "18@19q" "20@q" "23@"
+   "+25iq" "26i" "-q" "-iq" "i" "5#.0" "8/" "10#11" ".#" "."
+   "3.4q" "15.16e17q" "18.19e+q" ".q" ".17#18" "10q" "#b2" "#b12" "#b-12"
+   "#b3" "#b4" "#b5" "#b6" "#b7" "#b8" "#b9" "#ba" "#bb" "#bc"
+   "#bd" "#be" "#bf" "#q" "#xag" "#x1x"
+   "#o8" "#o9" "#o#"
+   "-#b1" "+#b1" "#b1/#b2" "#b1+#b1i" "1+#bi" "1+#b1i" "1#be1" "#b" "#o" "#" "1+ie1" "1+i1" "1e+1i"
+   "#b#b" "1e3e4" "1.0e-3e+4" "1e3s" "1e3s3" "1e-i" "#be1" "1/i" "1/e1" "1+e1"
+   "1e+" "1e1+" "1e1e1" "1e-+1" "1e0x1" "1e-" "1/#o2" "-#xae" "-#o-7"
+   "12@12i"))
+
+(for-each
+ (lambda (couple)
+   (apply
+    (lambda (x y)
+      (let ((xx (string->number x)))
+	(if (or (not xx)
+		(not y)
+		(and (rational? y)
+		     (not (eqv? xx y)))
+		(> (abs (- xx y)) 1e-12))
+	    (format #t ";(string->number ~A) returned ~A but expected ~A (~A ~A ~A ~A)~%"
+		    x (string->number x) y
+		    xx (eq? xx #f)
+		    (if (and xx y) (and (rational? y) (not (eqv? xx y))) #f)
+		    (if (and xx y) (abs (- xx y)) #f)))))
+    couple))
+ '(
+   ("#b0" 0)  ("#b1" 1) ("#o0" 0) ("#b-1" -1) ("#b+1" 1)
+   ("#o1" 1)  ("#o2" 2) ("#o3" 3) ("#o-1" -1)
+   ("#o4" 4)  ("#o5" 5) ("#o6" 6)
+   ("#o7" 7)
+   ("#xa" 10) ("#xb" 11) ("#x-1" -1) ("#x-a" -10)
+   ("#xc" 12) ("#xd" 13)
+   ("#xe" 14) ("#xf" 15) ("#x-abc" -2748)
+   ("#b1010" 10)
+   ("#o12345670" 2739128)
+   ("#x1234567890abcdef" 1311768467294899695)
+   ("1" 1) ("23" 23) ("-1" -1)
+   ("-45" -45)                      ;("2#" 20.0) ("2##" 200.0) ("12##" 1200.0) ; this # = 0 is about the stupidest thing I've ever seen
+   ("#xA" 10) ("#xB" 11) ("#x-1" -1) ("#x-A" -10)
+   ("#xC" 12) ("#xD" 13)
+   ("#xE" 14) ("#xF" 15) ("#x-ABC" -2748)
+   ("#xaBC" 2748) ("#xAbC" 2748) ("#xabC" 2748) ("#xABc" 2748)
+   ("1/1" 1) ("1/2" 1/2) ("-1/2" -1/2)
+   ("1e2" 100.0)
+   ("1e+2" 100.0) ("1e-2" 0.01)
+   (".1" .1) (".0123456789" 123456789e-10)
+   (".0123456789e10" 123456789.0)
+   ("3." 3.0) ("3.e0" 3.0)
+   ("1+i" 1+1i) ("1-i" 1-1i)
+   ))
+
+;;; some schemes are case insensitive throughout -- they accept 0+I, #X11 etc
+
+(for-each
+ (lambda (arg)
+   (test (string->number arg) 'error))
+ (list -1 #f #\a 1 _ht_ _undef_ _null_ _c_obj_ #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi abs #(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+
+(for-each
+ (lambda (arg)
+   (test (string->number "123" arg) 'error)
+   (test (string->number "1" arg) 'error))
+ (list -1 0 1 17 #f _ht_ _undef_ _null_ _c_obj_ #\a #(1 2 3) 3.14 3/4 1.5+0.3i 1+i () "" "12" #() :hi most-positive-fixnum most-negative-fixnum 'hi abs #(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+
+;; (string->number "0" 1) ?? why not?
+
+(for-each
+ (lambda (arg)
+   (test (number->string arg) 'error))
+ (list #\a #(1 2 3) () _ht_ _undef_ _null_ _c_obj_ 'hi abs "hi" #(()) #f (list 1 2 3) '(1 . 2) (lambda () 1)))
+
+(for-each
+ (lambda (arg)
+   (test (number->string 123 arg) 'error))
+ (list -1 17 most-positive-fixnum most-negative-fixnum 0 1 512 _ht_ _undef_ _null_ _c_obj_ #\a #f #(1 2 3) 3.14 2/3 1.5+0.3i 1+i () 'hi abs "hi" #(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+
+(test (string->number "34.1" (+ 5 (expt 2 32))) 'error)
+(test (number->string 34.1 (+ 5 (expt 2 32))) 'error)
+(test (string->number) 'error)
+(test (string->number 'symbol) 'error)
+(test (string->number "1.0" "1.0") 'error)
+(test (number->string) 'error)
+(test (number->string "hi") 'error)
+(test (number->string 1.0+23.0i 1.0+23.0i 1.0+23.0i) 'error)
+(test (string->number "") #f)
+(test (string->number "" 8) #f)
+(test (string->number (make-string 0)) #f)
+(test (string->number (string #\null)) #f)
+(test (string->number (string)) #f)
+(test (string->number (substring "hi" 0 0)) #f)
+(test (string->number (string (integer->char 30))) #f)
+(test (string->number "123" 10+0i) 'error) ; a real in s7
+
+(when with-bignums
+  (test (number->string -46116860184273879035/27670116110564327424) "-46116860184273879035/27670116110564327424")
+  (test (number->string 123 (bignum "10")) "123")
+  (test (number->string 123 (bignum "2")) "1111011")
+  (test (string->number "123" (bignum "10")) 123)
+  (test (string->number "1111011" (bignum "2")) 123)
+  (test (number->string 123 (bignum "17")) 'error)
+  (test (number->string 123 (bignum "-1")) 'error)
+  (test (number->string 123 (bignum "1")) 'error)
+  (test (number->string 123 (bignum "1/2")) 'error)
+  (test (string->number "101" (bignum "17")) 'error)
+  (test (string->number "101" (bignum "1")) 'error)
+  (test (string->number "101" (bignum "-1")) 'error)
+  (test (string->number "101" (bignum "1/2")) 'error))
+
+(num-test (- (string->number "11880772664.84631001" 10) (string->number "1.188077266484631001E10" 10)) 0.0)
+(num-test (- (string->number "11880772.66484631001" 10) (string->number "1.188077266484631001E7" 10)) 0.0)
+(if with-bignums
+    (num-test (- (string->number "118807726648463.1001" 10) (string->number "1.188077266484631001E14" 10)) 0.0)
+    (test (> (abs (- (string->number "118807726648463.1001" 10) (string->number "1.188077266484631001E14" 10))) 1e-1) #f))
+(if with-bignums
+    (num-test (- (string->number "118807726648463.1001" 9) (string->number "1.188077266484631001E14" 9)) 0.0)
+    (test (> (abs (- (string->number "118807726648463.1001" 9) (string->number "1.188077266484631001E14" 9))) 1e-1) #f))
+(num-test (- (string->number "11880772664.84631001" 9) (string->number "1.188077266484631001E10" 9)) 0.0)
+(num-test (- (string->number "11880772.66484631001" 9) (string->number "1.188077266484631001E7" 9)) 0.0)
+
+#|
+(num-test (- (string->number "1188077266484631001.") (string->number "1.188077266484631001E18")) 0.0)
+(num-test (- (string->number "1188077266484631001." 10) (string->number "1.188077266484631001E18" 10)) 0.0)
+(num-test (- (string->number "118807726648463100.1" 10) (string->number "1.188077266484631001E17" 10)) 0.0)
+(num-test (- (string->number "118807726648463100100." 9) (string->number "1.188077266484631001E20" 9)) 0.0)
+(num-test (- (string->number "1188077266484631001." 9) (string->number "1.188077266484631001E18" 9)) 0.0)
+(num-test (- (string->number "118807726648463100.1" 9) (string->number "1.188077266484631001E17" 9)) 0.0)
+;; (num-test (- (string->number "1177077266474631001000." 8) (string->number "1.177077266474631001E21" 8)) 0.0)
+;; a fake unfortunately -- actually all of these are not what they appear to be
+|#
+
+(num-test 111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111e-300 1.111111111111111111111111111111111111113E-1)
+(num-test 0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e300 1.0)
+(num-test 0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e309 1.0)
+(num-test 0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000123e309 1.23)
+(num-test -.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000123456e312 -1234.56)
+
+(num-test (string->number "111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111e-300") 1.111111111111111111111111111111111111113E-1)
+(num-test (string->number "0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e300") 1.0)
+(num-test (string->number "0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e309") 1.0)
+(num-test (string->number "0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000123e309") 1.23)
+(num-test (string->number "-.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000123456e312") -1234.56)
+
+(num-test #b0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e300 1.0)
+(num-test #o0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e300 1.0)
+(num-test #x0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e300 1.0)
+
+(num-test 0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e600 10.0)
+
+(num-test 1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-300 1.0)
+(num-test 1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-309 1.0)
+(num-test -1234000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-309 -1.234)
+
+(num-test (string->number "1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-300") 1.0)
+(num-test (string->number "1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-309") 1.0)
+(num-test (string->number "-1234000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-309") -1.234)
+
+(num-test 1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-300 1.0)
+(num-test (string->number "1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-300") 1.0)
+
+(num-test 1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-309 1.0)
+(num-test (string->number "1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-309") 1.0)
+
+(num-test (string->number "7218817.36503571385593731949749063134519967478471341285646368059547752954588980538968510599079437e7") 7.218817365035713855937319497490631345183E13)
+(num-test (string->number "-8209943b.31283867353472bb21b" 12) -2.928292312585025742274395996260284298851E8)
+(test (string->number "-8209943b.31283867353472bc21b" 12) #f)
+(num-test (string->number "-25708892.1b6583269007366320788640bb79398b32a42" 12) -8.835044616346879740283599816201349374646E7)
+(test (string->number "-25708892.1b6583269007366320788640bb79398b32ac2" 12) #f)
+(num-test (string->number "9418.b89a40b0211a01147b75b23a529b0382775b32b+45936610b.a936586185a57b00ba4a90a139343235054b2i" 12) 1.614897792919114090019672485580641433273E4+1.926841115897881740778679262842131716289E9i)
+
+(num-test (string->number "1.0e0000000000000000000000000000000000001") 10.0)
+
+(num-test 00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 10.0)
+(num-test (string->number "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001") 10.0)
+
+(num-test (string->number "\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+1.00000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+00e0000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0000000000000000000000000000000000000000\
+0001") 10.0)
+
+;;; this whitespace handling only works in string constants in s7, not in arbitrary code.
+
+(num-test 00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001/00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 1)
+(num-test (string->number "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001/00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001") 1)
+
+#|
+;;; if not gmp:
+:(string->number "0.999999999999999")
+1.0
+:(number->string 0.999999999999999)
+"1.0"
+also
+:(string->number ".0999999999999995")
+                 0.099999999999999
+:(string->number ".0999999999999996")
+                 0.1
+:(string->number ".0fffffffffff" 16)
+0.062499999999996
+:(string->number ".0ffffffffffff" 16)
+0.0625
+but
+:(number->string 0.062499999999996 16)
+"0.0ffffffffffee"
+:(number->string (string->number ".0fffffffffff" 16)  16)
+"0.0fffffffffff"
+ the 0.624... version is actually an approximation (off by 4.4408920985006e-16)
+:(number->string 0.062499999999996 16)
+"0.0ffffffffffedfc506118a9ea64de0c590"
+more non-gmp:
+:9999999999999999999
+-8446744073709551617
+:9999999999999999991
+-8446744073709551625
+:-9999999999999999991
+8446744073709551625
+:9223372036854775810
+-9223372036854775806
+etc
+|#
+
+(when with-bignums
+  (test (char=? ((number->string 9.999999999999999) 0) #\9) #t)
+  (test (char=? ((number->string 0.999999999999999999) 3) #\9) #t)
+  (num-test -0.1e309 -1e308)
+  (num-test .01e310 1e308)
+  (num-test .1e310 1e309)
+  (num-test 0.0e310 0.0))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; bignum
+;;; bignum?
+;;; --------------------------------------------------------------------------------
+
+(when with-bignums
+  (test (bignum? (bignum "2")) #t)
+  (test (bignum (bignum 1)) 1)
+
+  (num-test (bignum "6/3") 2)
+  (num-test (bignum "+3/6") 1/2)
+  (num-test (bignum "7447415382/3") 2482471794)
+
+  (for-each
+   (lambda (n)
+     (test (bignum? n) #f))
+   (list 0 1 -1 1/3 1.0 1+i 1073741824 1.0e8 1+1.0e8i "hi" () (integer->char 65) #f #t '(1 2) 'a-symbol _ht_ _undef_ _null_ _c_obj_ (cons 1 2) (make-vector 3) abs))
+
+  (for-each
+   (lambda (n)
+     (test (bignum? n) #t))
+   (list 1.0e30 -1.0e20+i 1.0+1.0e80i 1e100 1267650600228229401496703205376 -1267650600228229401496703205376
+	 1180591620717411303424/3 3/1180591620717411303424 1180591620717411303424/1180591620717411303423
+	 1267650600228229401496703205376.99 -1267650600228229401496703205376.88 0.1231231231231231231231231231))
+  (for-each
+   (lambda (n)
+     (test (bignum n) 'error)
+     (test (bignum "1.0" n) 'error))
+   (list "hi" (integer->char 65) #f #t '(1 2) 'a-symbol (cons 1 2) () _ht_ _undef_ _null_ _c_obj_ (make-vector 3) abs))
+
+  (test (bignum?) 'error)
+  (test (bignum? 1 2) 'error)
+  (test (bignum? 1) #f)
+  (test (bignum? (bignum 1)) #t)
+  (test (bignum? (bignum 1/2)) #t)
+  (test (bignum? (bignum 1.5)) #t)
+  (test (bignum? (bignum 1+i)) #t)
+
+  (test (bignum) 'error)
+  (test (bignum "hi" "ho") 'error)
+  (test (bignum "") 'error)
+  (test (bignum " ") 'error)
+  (test (bignum " 1 ") 'error)
+  (test (bignum "abc") 'error)
+  (test (bignum "1/2/3") 'error)
+
+  (test (bignum "1.0") (bignum 1.0)))
+
+
+;;; coverage tests for relops
+;;; from:
+#|
+(define ops '(= < > <= >=))
+(define args '(1 -1 1/2 -1/2 1.5 -1.5 1+i 1-i m1))
+(define real-args '(1 -1 1/2 -1/2 1.5 -1.5 m1))
+(require mockery.scm)
+(define m1 ((*mock-number* 'mock-number) 3))
+
+(call-with-output-file "tdata.scm"
+  (lambda (p)
+
+    (format p "(require mockery.scm)~%")
+    (format p "(define m1 ((*mock-number* 'mock-number) 3))~%")
+    (format p "(define with-bignums (provided? 'gmp))~%")
+    (format p "(define-macro (test expr res)~%")
+    (format p "  `(let ((val (catch #t (lambda () ,expr) (lambda (type info) 'error))))~%")
+    (format p "     (unless (eq? val ,res)~%")
+    (format p "        (format *stderr* \"~~S -> ~~S?~~%\" ',expr val))))~%")
+
+    (for-each
+     (lambda (op)
+       (for-each
+	(lambda (arg1)
+	  (for-each
+	   (lambda (arg2)
+	     (let ((result (catch #t
+			     (lambda ()
+			       (apply (symbol->value op) (list (if (symbol? arg1) (symbol->value arg1) arg1)
+							       (if (symbol? arg2) (symbol->value arg2) arg2))))
+			     (lambda (type info)
+					;(apply format #t info)
+			       ''error))))
+	       (format p "(test (~S ~S ~S) ~S)~%" op arg1 arg2 result)
+	       (when (and (number? arg1)
+			  (number? arg2))
+		 (format p "(when with-bignums~%")
+		 (format p "  (test (~S (bignum ~S) ~S) ~S)~%" op arg1 arg2 result)
+		 (format p "  (test (~S ~S (bignum ~S)) ~S)~%" op arg1 arg2 result)
+		 (format p "  (test (~S (bignum ~S) (bignum ~S)) ~S))~%" op arg1 arg2 result))))
+	   (if (eq? op '=) args real-args)))
+	(if (eq? op '=) args real-args)))
+     ops)))
+|#
+
+(set! (*s7* 'autoloading?) #t) ; t101 turns this off in one test!
+
+(let ()
+  (require mockery.scm)
+  (define m1 ((*mock-number* 'mock-number) 3))
+  (define with-bignums (provided? 'gmp))
+  (define-macro (test1 expr res)
+    `(let ((val (catch #t (lambda () ,expr) (lambda (type info) 'error))))
+       (unless (equal? val ,res)
+	 (format *stderr* "~S -> ~S?~%" ',expr val))))
+  (test1 (= 1 1) #t)
+  (when with-bignums
+    (test1 (= (bignum 1) 1) #t)
+    (test1 (= 1 (bignum 1)) #t)
+    (test1 (= (bignum 1) (bignum 1)) #t))
+  (test1 (= 1 -1) #f)
+  (when with-bignums
+    (test1 (= (bignum 1) -1) #f)
+    (test1 (= 1 (bignum -1)) #f)
+    (test1 (= (bignum 1) (bignum -1)) #f))
+  (test1 (= 1 1/2) #f)
+  (when with-bignums
+    (test1 (= (bignum 1) 1/2) #f)
+    (test1 (= 1 (bignum 1/2)) #f)
+    (test1 (= (bignum 1) (bignum 1/2)) #f))
+  (test1 (= 1 -1/2) #f)
+  (when with-bignums
+    (test1 (= (bignum 1) -1/2) #f)
+    (test1 (= 1 (bignum -1/2)) #f)
+    (test1 (= (bignum 1) (bignum -1/2)) #f))
+  (test1 (= 1 1.5) #f)
+  (when with-bignums
+    (test1 (= (bignum 1) 1.5) #f)
+    (test1 (= 1 (bignum 1.5)) #f)
+    (test1 (= (bignum 1) (bignum 1.5)) #f))
+  (test1 (= 1 -1.5) #f)
+  (when with-bignums
+    (test1 (= (bignum 1) -1.5) #f)
+    (test1 (= 1 (bignum -1.5)) #f)
+    (test1 (= (bignum 1) (bignum -1.5)) #f))
+  (test1 (= 1 1.0+1.0i) #f)
+  (when with-bignums
+    (test1 (= (bignum 1) 1.0+1.0i) #f)
+    (test1 (= 1 (bignum 1.0+1.0i)) #f)
+    (test1 (= (bignum 1) (bignum 1.0+1.0i)) #f))
+  (test1 (= 1 1.0-1.0i) #f)
+  (when with-bignums
+    (test1 (= (bignum 1) 1.0-1.0i) #f)
+    (test1 (= 1 (bignum 1.0-1.0i)) #f)
+    (test1 (= (bignum 1) (bignum 1.0-1.0i)) #f))
+  (test1 (= 1 m1) #f)
+  (test1 (= -1 1) #f)
+  (when with-bignums
+    (test1 (= (bignum -1) 1) #f)
+    (test1 (= -1 (bignum 1)) #f)
+    (test1 (= (bignum -1) (bignum 1)) #f))
+  (test1 (= -1 -1) #t)
+  (when with-bignums
+    (test1 (= (bignum -1) -1) #t)
+    (test1 (= -1 (bignum -1)) #t)
+    (test1 (= (bignum -1) (bignum -1)) #t))
+  (test1 (= -1 1/2) #f)
+  (when with-bignums
+    (test1 (= (bignum -1) 1/2) #f)
+    (test1 (= -1 (bignum 1/2)) #f)
+    (test1 (= (bignum -1) (bignum 1/2)) #f))
+  (test1 (= -1 -1/2) #f)
+  (when with-bignums
+    (test1 (= (bignum -1) -1/2) #f)
+    (test1 (= -1 (bignum -1/2)) #f)
+    (test1 (= (bignum -1) (bignum -1/2)) #f))
+  (test1 (= -1 1.5) #f)
+  (when with-bignums
+    (test1 (= (bignum -1) 1.5) #f)
+    (test1 (= -1 (bignum 1.5)) #f)
+    (test1 (= (bignum -1) (bignum 1.5)) #f))
+  (test1 (= -1 -1.5) #f)
+  (when with-bignums
+    (test1 (= (bignum -1) -1.5) #f)
+    (test1 (= -1 (bignum -1.5)) #f)
+    (test1 (= (bignum -1) (bignum -1.5)) #f))
+  (test1 (= -1 1.0+1.0i) #f)
+  (when with-bignums
+    (test1 (= (bignum -1) 1.0+1.0i) #f)
+    (test1 (= -1 (bignum 1.0+1.0i)) #f)
+    (test1 (= (bignum -1) (bignum 1.0+1.0i)) #f))
+  (test1 (= -1 1.0-1.0i) #f)
+  (when with-bignums
+    (test1 (= (bignum -1) 1.0-1.0i) #f)
+    (test1 (= -1 (bignum 1.0-1.0i)) #f)
+    (test1 (= (bignum -1) (bignum 1.0-1.0i)) #f))
+  (test1 (= -1 m1) #f)
+  (test1 (= 1/2 1) #f)
+  (when with-bignums
+    (test1 (= (bignum 1/2) 1) #f)
+    (test1 (= 1/2 (bignum 1)) #f)
+    (test1 (= (bignum 1/2) (bignum 1)) #f))
+  (test1 (= 1/2 -1) #f)
+  (when with-bignums
+    (test1 (= (bignum 1/2) -1) #f)
+    (test1 (= 1/2 (bignum -1)) #f)
+    (test1 (= (bignum 1/2) (bignum -1)) #f))
+  (test1 (= 1/2 1/2) #t)
+  (when with-bignums
+    (test1 (= (bignum 1/2) 1/2) #t)
+    (test1 (= 1/2 (bignum 1/2)) #t)
+    (test1 (= (bignum 1/2) (bignum 1/2)) #t))
+  (test1 (= 1/2 -1/2) #f)
+  (when with-bignums
+    (test1 (= (bignum 1/2) -1/2) #f)
+    (test1 (= 1/2 (bignum -1/2)) #f)
+    (test1 (= (bignum 1/2) (bignum -1/2)) #f))
+  (test1 (= 1/2 1.5) #f)
+  (when with-bignums
+    (test1 (= (bignum 1/2) 1.5) #f)
+    (test1 (= 1/2 (bignum 1.5)) #f)
+    (test1 (= (bignum 1/2) (bignum 1.5)) #f))
+  (test1 (= 1/2 -1.5) #f)
+  (when with-bignums
+    (test1 (= (bignum 1/2) -1.5) #f)
+    (test1 (= 1/2 (bignum -1.5)) #f)
+    (test1 (= (bignum 1/2) (bignum -1.5)) #f))
+  (test1 (= 1/2 1.0+1.0i) #f)
+  (when with-bignums
+    (test1 (= (bignum 1/2) 1.0+1.0i) #f)
+    (test1 (= 1/2 (bignum 1.0+1.0i)) #f)
+    (test1 (= (bignum 1/2) (bignum 1.0+1.0i)) #f))
+  (test1 (= 1/2 1.0-1.0i) #f)
+  (when with-bignums
+    (test1 (= (bignum 1/2) 1.0-1.0i) #f)
+    (test1 (= 1/2 (bignum 1.0-1.0i)) #f)
+    (test1 (= (bignum 1/2) (bignum 1.0-1.0i)) #f))
+  (test1 (= 1/2 m1) #f)
+  (test1 (= -1/2 1) #f)
+  (when with-bignums
+    (test1 (= (bignum -1/2) 1) #f)
+    (test1 (= -1/2 (bignum 1)) #f)
+    (test1 (= (bignum -1/2) (bignum 1)) #f))
+  (test1 (= -1/2 -1) #f)
+  (when with-bignums
+    (test1 (= (bignum -1/2) -1) #f)
+    (test1 (= -1/2 (bignum -1)) #f)
+    (test1 (= (bignum -1/2) (bignum -1)) #f))
+  (test1 (= -1/2 1/2) #f)
+  (when with-bignums
+    (test1 (= (bignum -1/2) 1/2) #f)
+    (test1 (= -1/2 (bignum 1/2)) #f)
+    (test1 (= (bignum -1/2) (bignum 1/2)) #f))
+  (test1 (= -1/2 -1/2) #t)
+  (when with-bignums
+    (test1 (= (bignum -1/2) -1/2) #t)
+    (test1 (= -1/2 (bignum -1/2)) #t)
+    (test1 (= (bignum -1/2) (bignum -1/2)) #t))
+  (test1 (= -1/2 1.5) #f)
+  (when with-bignums
+    (test1 (= (bignum -1/2) 1.5) #f)
+    (test1 (= -1/2 (bignum 1.5)) #f)
+    (test1 (= (bignum -1/2) (bignum 1.5)) #f))
+  (test1 (= -1/2 -1.5) #f)
+  (when with-bignums
+    (test1 (= (bignum -1/2) -1.5) #f)
+    (test1 (= -1/2 (bignum -1.5)) #f)
+    (test1 (= (bignum -1/2) (bignum -1.5)) #f))
+  (test1 (= -1/2 1.0+1.0i) #f)
+  (when with-bignums
+    (test1 (= (bignum -1/2) 1.0+1.0i) #f)
+    (test1 (= -1/2 (bignum 1.0+1.0i)) #f)
+    (test1 (= (bignum -1/2) (bignum 1.0+1.0i)) #f))
+  (test1 (= -1/2 1.0-1.0i) #f)
+  (when with-bignums
+    (test1 (= (bignum -1/2) 1.0-1.0i) #f)
+    (test1 (= -1/2 (bignum 1.0-1.0i)) #f)
+    (test1 (= (bignum -1/2) (bignum 1.0-1.0i)) #f))
+  (test1 (= -1/2 m1) #f)
+  (test1 (= 1.5 1) #f)
+  (when with-bignums
+    (test1 (= (bignum 1.5) 1) #f)
+    (test1 (= 1.5 (bignum 1)) #f)
+    (test1 (= (bignum 1.5) (bignum 1)) #f))
+  (test1 (= 1.5 -1) #f)
+  (when with-bignums
+    (test1 (= (bignum 1.5) -1) #f)
+    (test1 (= 1.5 (bignum -1)) #f)
+    (test1 (= (bignum 1.5) (bignum -1)) #f))
+  (test1 (= 1.5 1/2) #f)
+  (when with-bignums
+    (test1 (= (bignum 1.5) 1/2) #f)
+    (test1 (= 1.5 (bignum 1/2)) #f)
+    (test1 (= (bignum 1.5) (bignum 1/2)) #f))
+  (test1 (= 1.5 -1/2) #f)
+  (when with-bignums
+    (test1 (= (bignum 1.5) -1/2) #f)
+    (test1 (= 1.5 (bignum -1/2)) #f)
+    (test1 (= (bignum 1.5) (bignum -1/2)) #f))
+  (test1 (= 1.5 1.5) #t)
+  (when with-bignums
+    (test1 (= (bignum 1.5) 1.5) #t)
+    (test1 (= 1.5 (bignum 1.5)) #t)
+    (test1 (= (bignum 1.5) (bignum 1.5)) #t))
+  (test1 (= 1.5 -1.5) #f)
+  (when with-bignums
+    (test1 (= (bignum 1.5) -1.5) #f)
+    (test1 (= 1.5 (bignum -1.5)) #f)
+    (test1 (= (bignum 1.5) (bignum -1.5)) #f))
+  (test1 (= 1.5 1.0+1.0i) #f)
+  (when with-bignums
+    (test1 (= (bignum 1.5) 1.0+1.0i) #f)
+    (test1 (= 1.5 (bignum 1.0+1.0i)) #f)
+    (test1 (= (bignum 1.5) (bignum 1.0+1.0i)) #f))
+  (test1 (= 1.5 1.0-1.0i) #f)
+  (when with-bignums
+    (test1 (= (bignum 1.5) 1.0-1.0i) #f)
+    (test1 (= 1.5 (bignum 1.0-1.0i)) #f)
+    (test1 (= (bignum 1.5) (bignum 1.0-1.0i)) #f))
+  (test1 (= 1.5 m1) #f)
+  (test1 (= -1.5 1) #f)
+  (when with-bignums
+    (test1 (= (bignum -1.5) 1) #f)
+    (test1 (= -1.5 (bignum 1)) #f)
+    (test1 (= (bignum -1.5) (bignum 1)) #f))
+  (test1 (= -1.5 -1) #f)
+  (when with-bignums
+    (test1 (= (bignum -1.5) -1) #f)
+    (test1 (= -1.5 (bignum -1)) #f)
+    (test1 (= (bignum -1.5) (bignum -1)) #f))
+  (test1 (= -1.5 1/2) #f)
+  (when with-bignums
+    (test1 (= (bignum -1.5) 1/2) #f)
+    (test1 (= -1.5 (bignum 1/2)) #f)
+    (test1 (= (bignum -1.5) (bignum 1/2)) #f))
+  (test1 (= -1.5 -1/2) #f)
+  (when with-bignums
+    (test1 (= (bignum -1.5) -1/2) #f)
+    (test1 (= -1.5 (bignum -1/2)) #f)
+    (test1 (= (bignum -1.5) (bignum -1/2)) #f))
+  (test1 (= -1.5 1.5) #f)
+  (when with-bignums
+    (test1 (= (bignum -1.5) 1.5) #f)
+    (test1 (= -1.5 (bignum 1.5)) #f)
+    (test1 (= (bignum -1.5) (bignum 1.5)) #f))
+  (test1 (= -1.5 -1.5) #t)
+  (when with-bignums
+    (test1 (= (bignum -1.5) -1.5) #t)
+    (test1 (= -1.5 (bignum -1.5)) #t)
+    (test1 (= (bignum -1.5) (bignum -1.5)) #t))
+  (test1 (= -1.5 1.0+1.0i) #f)
+  (when with-bignums
+    (test1 (= (bignum -1.5) 1.0+1.0i) #f)
+    (test1 (= -1.5 (bignum 1.0+1.0i)) #f)
+    (test1 (= (bignum -1.5) (bignum 1.0+1.0i)) #f))
+  (test1 (= -1.5 1.0-1.0i) #f)
+  (when with-bignums
+    (test1 (= (bignum -1.5) 1.0-1.0i) #f)
+    (test1 (= -1.5 (bignum 1.0-1.0i)) #f)
+    (test1 (= (bignum -1.5) (bignum 1.0-1.0i)) #f))
+  (test1 (= -1.5 m1) #f)
+  (test1 (= 1.0+1.0i 1) #f)
+  (when with-bignums
+    (test1 (= (bignum 1.0+1.0i) 1) #f)
+    (test1 (= 1.0+1.0i (bignum 1)) #f)
+    (test1 (= (bignum 1.0+1.0i) (bignum 1)) #f))
+  (test1 (= 1.0+1.0i -1) #f)
+  (when with-bignums
+    (test1 (= (bignum 1.0+1.0i) -1) #f)
+    (test1 (= 1.0+1.0i (bignum -1)) #f)
+    (test1 (= (bignum 1.0+1.0i) (bignum -1)) #f))
+  (test1 (= 1.0+1.0i 1/2) #f)
+  (when with-bignums
+    (test1 (= (bignum 1.0+1.0i) 1/2) #f)
+    (test1 (= 1.0+1.0i (bignum 1/2)) #f)
+    (test1 (= (bignum 1.0+1.0i) (bignum 1/2)) #f))
+  (test1 (= 1.0+1.0i -1/2) #f)
+  (when with-bignums
+    (test1 (= (bignum 1.0+1.0i) -1/2) #f)
+    (test1 (= 1.0+1.0i (bignum -1/2)) #f)
+    (test1 (= (bignum 1.0+1.0i) (bignum -1/2)) #f))
+  (test1 (= 1.0+1.0i 1.5) #f)
+  (when with-bignums
+    (test1 (= (bignum 1.0+1.0i) 1.5) #f)
+    (test1 (= 1.0+1.0i (bignum 1.5)) #f)
+    (test1 (= (bignum 1.0+1.0i) (bignum 1.5)) #f))
+  (test1 (= 1.0+1.0i -1.5) #f)
+  (when with-bignums
+    (test1 (= (bignum 1.0+1.0i) -1.5) #f)
+    (test1 (= 1.0+1.0i (bignum -1.5)) #f)
+    (test1 (= (bignum 1.0+1.0i) (bignum -1.5)) #f))
+  (test1 (= 1.0+1.0i 1.0+1.0i) #t)
+  (when with-bignums
+    (test1 (= (bignum 1.0+1.0i) 1.0+1.0i) #t)
+    (test1 (= 1.0+1.0i (bignum 1.0+1.0i)) #t)
+    (test1 (= (bignum 1.0+1.0i) (bignum 1.0+1.0i)) #t))
+  (test1 (= 1.0+1.0i 1.0-1.0i) #f)
+  (when with-bignums
+    (test1 (= (bignum 1.0+1.0i) 1.0-1.0i) #f)
+    (test1 (= 1.0+1.0i (bignum 1.0-1.0i)) #f)
+    (test1 (= (bignum 1.0+1.0i) (bignum 1.0-1.0i)) #f))
+  (test1 (= 1.0+1.0i m1) #f)
+  (test1 (= 1.0-1.0i 1) #f)
+  (when with-bignums
+    (test1 (= (bignum 1.0-1.0i) 1) #f)
+    (test1 (= 1.0-1.0i (bignum 1)) #f)
+    (test1 (= (bignum 1.0-1.0i) (bignum 1)) #f))
+  (test1 (= 1.0-1.0i -1) #f)
+  (when with-bignums
+    (test1 (= (bignum 1.0-1.0i) -1) #f)
+    (test1 (= 1.0-1.0i (bignum -1)) #f)
+    (test1 (= (bignum 1.0-1.0i) (bignum -1)) #f))
+  (test1 (= 1.0-1.0i 1/2) #f)
+  (when with-bignums
+    (test1 (= (bignum 1.0-1.0i) 1/2) #f)
+    (test1 (= 1.0-1.0i (bignum 1/2)) #f)
+    (test1 (= (bignum 1.0-1.0i) (bignum 1/2)) #f))
+  (test1 (= 1.0-1.0i -1/2) #f)
+  (when with-bignums
+    (test1 (= (bignum 1.0-1.0i) -1/2) #f)
+    (test1 (= 1.0-1.0i (bignum -1/2)) #f)
+    (test1 (= (bignum 1.0-1.0i) (bignum -1/2)) #f))
+  (test1 (= 1.0-1.0i 1.5) #f)
+  (when with-bignums
+    (test1 (= (bignum 1.0-1.0i) 1.5) #f)
+    (test1 (= 1.0-1.0i (bignum 1.5)) #f)
+    (test1 (= (bignum 1.0-1.0i) (bignum 1.5)) #f))
+  (test1 (= 1.0-1.0i -1.5) #f)
+  (when with-bignums
+    (test1 (= (bignum 1.0-1.0i) -1.5) #f)
+    (test1 (= 1.0-1.0i (bignum -1.5)) #f)
+    (test1 (= (bignum 1.0-1.0i) (bignum -1.5)) #f))
+  (test1 (= 1.0-1.0i 1.0+1.0i) #f)
+  (when with-bignums
+    (test1 (= (bignum 1.0-1.0i) 1.0+1.0i) #f)
+    (test1 (= 1.0-1.0i (bignum 1.0+1.0i)) #f)
+    (test1 (= (bignum 1.0-1.0i) (bignum 1.0+1.0i)) #f))
+  (test1 (= 1.0-1.0i 1.0-1.0i) #t)
+  (when with-bignums
+    (test1 (= (bignum 1.0-1.0i) 1.0-1.0i) #t)
+    (test1 (= 1.0-1.0i (bignum 1.0-1.0i)) #t)
+    (test1 (= (bignum 1.0-1.0i) (bignum 1.0-1.0i)) #t))
+  (test1 (= 1.0-1.0i m1) #f)
+  (test1 (= m1 1) #f)
+  (test1 (= m1 -1) #f)
+  (test1 (= m1 1/2) #f)
+  (test1 (= m1 -1/2) #f)
+  (test1 (= m1 1.5) #f)
+  (test1 (= m1 -1.5) #f)
+  (test1 (= m1 1.0+1.0i) #f)
+  (test1 (= m1 1.0-1.0i) #f)
+  (test1 (= m1 m1) #t)
+  (test1 (< 1 1) #f)
+  (when with-bignums
+    (test1 (< (bignum 1) 1) #f)
+    (test1 (< 1 (bignum 1)) #f)
+    (test1 (< (bignum 1) (bignum 1)) #f))
+  (test1 (< 1 -1) #f)
+  (when with-bignums
+    (test1 (< (bignum 1) -1) #f)
+    (test1 (< 1 (bignum -1)) #f)
+    (test1 (< (bignum 1) (bignum -1)) #f))
+  (test1 (< 1 1/2) #f)
+  (when with-bignums
+    (test1 (< (bignum 1) 1/2) #f)
+    (test1 (< 1 (bignum 1/2)) #f)
+    (test1 (< (bignum 1) (bignum 1/2)) #f))
+  (test1 (< 1 -1/2) #f)
+  (when with-bignums
+    (test1 (< (bignum 1) -1/2) #f)
+    (test1 (< 1 (bignum -1/2)) #f)
+    (test1 (< (bignum 1) (bignum -1/2)) #f))
+  (test1 (< 1 1.5) #t)
+  (when with-bignums
+    (test1 (< (bignum 1) 1.5) #t)
+    (test1 (< 1 (bignum 1.5)) #t)
+    (test1 (< (bignum 1) (bignum 1.5)) #t))
+  (test1 (< 1 -1.5) #f)
+  (when with-bignums
+    (test1 (< (bignum 1) -1.5) #f)
+    (test1 (< 1 (bignum -1.5)) #f)
+    (test1 (< (bignum 1) (bignum -1.5)) #f))
+  (test1 (< 1 m1) #t)
+  (test1 (< -1 1) #t)
+  (when with-bignums
+    (test1 (< (bignum -1) 1) #t)
+    (test1 (< -1 (bignum 1)) #t)
+    (test1 (< (bignum -1) (bignum 1)) #t))
+  (test1 (< -1 -1) #f)
+  (when with-bignums
+    (test1 (< (bignum -1) -1) #f)
+    (test1 (< -1 (bignum -1)) #f)
+    (test1 (< (bignum -1) (bignum -1)) #f))
+  (test1 (< -1 1/2) #t)
+  (when with-bignums
+    (test1 (< (bignum -1) 1/2) #t)
+    (test1 (< -1 (bignum 1/2)) #t)
+    (test1 (< (bignum -1) (bignum 1/2)) #t))
+  (test1 (< -1 -1/2) #t)
+  (when with-bignums
+    (test1 (< (bignum -1) -1/2) #t)
+    (test1 (< -1 (bignum -1/2)) #t)
+    (test1 (< (bignum -1) (bignum -1/2)) #t))
+  (test1 (< -1 1.5) #t)
+  (when with-bignums
+    (test1 (< (bignum -1) 1.5) #t)
+    (test1 (< -1 (bignum 1.5)) #t)
+    (test1 (< (bignum -1) (bignum 1.5)) #t))
+  (test1 (< -1 -1.5) #f)
+  (when with-bignums
+    (test1 (< (bignum -1) -1.5) #f)
+    (test1 (< -1 (bignum -1.5)) #f)
+    (test1 (< (bignum -1) (bignum -1.5)) #f))
+  (test1 (< -1 m1) #t)
+  (test1 (< 1/2 1) #t)
+  (when with-bignums
+    (test1 (< (bignum 1/2) 1) #t)
+    (test1 (< 1/2 (bignum 1)) #t)
+    (test1 (< (bignum 1/2) (bignum 1)) #t))
+  (test1 (< 1/2 -1) #f)
+  (when with-bignums
+    (test1 (< (bignum 1/2) -1) #f)
+    (test1 (< 1/2 (bignum -1)) #f)
+    (test1 (< (bignum 1/2) (bignum -1)) #f))
+  (test1 (< 1/2 1/2) #f)
+  (when with-bignums
+    (test1 (< (bignum 1/2) 1/2) #f)
+    (test1 (< 1/2 (bignum 1/2)) #f)
+    (test1 (< (bignum 1/2) (bignum 1/2)) #f))
+  (test1 (< 1/2 -1/2) #f)
+  (when with-bignums
+    (test1 (< (bignum 1/2) -1/2) #f)
+    (test1 (< 1/2 (bignum -1/2)) #f)
+    (test1 (< (bignum 1/2) (bignum -1/2)) #f))
+  (test1 (< 1/2 1.5) #t)
+  (when with-bignums
+    (test1 (< (bignum 1/2) 1.5) #t)
+    (test1 (< 1/2 (bignum 1.5)) #t)
+    (test1 (< (bignum 1/2) (bignum 1.5)) #t))
+  (test1 (< 1/2 -1.5) #f)
+  (when with-bignums
+    (test1 (< (bignum 1/2) -1.5) #f)
+    (test1 (< 1/2 (bignum -1.5)) #f)
+    (test1 (< (bignum 1/2) (bignum -1.5)) #f))
+  (test1 (< 1/2 m1) #t)
+  (test1 (< -1/2 1) #t)
+  (when with-bignums
+    (test1 (< (bignum -1/2) 1) #t)
+    (test1 (< -1/2 (bignum 1)) #t)
+    (test1 (< (bignum -1/2) (bignum 1)) #t))
+  (test1 (< -1/2 -1) #f)
+  (when with-bignums
+    (test1 (< (bignum -1/2) -1) #f)
+    (test1 (< -1/2 (bignum -1)) #f)
+    (test1 (< (bignum -1/2) (bignum -1)) #f))
+  (test1 (< -1/2 1/2) #t)
+  (when with-bignums
+    (test1 (< (bignum -1/2) 1/2) #t)
+    (test1 (< -1/2 (bignum 1/2)) #t)
+    (test1 (< (bignum -1/2) (bignum 1/2)) #t))
+  (test1 (< -1/2 -1/2) #f)
+  (when with-bignums
+    (test1 (< (bignum -1/2) -1/2) #f)
+    (test1 (< -1/2 (bignum -1/2)) #f)
+    (test1 (< (bignum -1/2) (bignum -1/2)) #f))
+  (test1 (< -1/2 1.5) #t)
+  (when with-bignums
+    (test1 (< (bignum -1/2) 1.5) #t)
+    (test1 (< -1/2 (bignum 1.5)) #t)
+    (test1 (< (bignum -1/2) (bignum 1.5)) #t))
+  (test1 (< -1/2 -1.5) #f)
+  (when with-bignums
+    (test1 (< (bignum -1/2) -1.5) #f)
+    (test1 (< -1/2 (bignum -1.5)) #f)
+    (test1 (< (bignum -1/2) (bignum -1.5)) #f))
+  (test1 (< -1/2 m1) #t)
+  (test1 (< 1.5 1) #f)
+  (when with-bignums
+    (test1 (< (bignum 1.5) 1) #f)
+    (test1 (< 1.5 (bignum 1)) #f)
+    (test1 (< (bignum 1.5) (bignum 1)) #f))
+  (test1 (< 1.5 -1) #f)
+  (when with-bignums
+    (test1 (< (bignum 1.5) -1) #f)
+    (test1 (< 1.5 (bignum -1)) #f)
+    (test1 (< (bignum 1.5) (bignum -1)) #f))
+  (test1 (< 1.5 1/2) #f)
+  (when with-bignums
+    (test1 (< (bignum 1.5) 1/2) #f)
+    (test1 (< 1.5 (bignum 1/2)) #f)
+    (test1 (< (bignum 1.5) (bignum 1/2)) #f))
+  (test1 (< 1.5 -1/2) #f)
+  (when with-bignums
+    (test1 (< (bignum 1.5) -1/2) #f)
+    (test1 (< 1.5 (bignum -1/2)) #f)
+    (test1 (< (bignum 1.5) (bignum -1/2)) #f))
+  (test1 (< 1.5 1.5) #f)
+  (when with-bignums
+    (test1 (< (bignum 1.5) 1.5) #f)
+    (test1 (< 1.5 (bignum 1.5)) #f)
+    (test1 (< (bignum 1.5) (bignum 1.5)) #f))
+  (test1 (< 1.5 -1.5) #f)
+  (when with-bignums
+    (test1 (< (bignum 1.5) -1.5) #f)
+    (test1 (< 1.5 (bignum -1.5)) #f)
+    (test1 (< (bignum 1.5) (bignum -1.5)) #f))
+  (test1 (< 1.5 m1) #t)
+  (test1 (< -1.5 1) #t)
+  (when with-bignums
+    (test1 (< (bignum -1.5) 1) #t)
+    (test1 (< -1.5 (bignum 1)) #t)
+    (test1 (< (bignum -1.5) (bignum 1)) #t))
+  (test1 (< -1.5 -1) #t)
+  (when with-bignums
+    (test1 (< (bignum -1.5) -1) #t)
+    (test1 (< -1.5 (bignum -1)) #t)
+    (test1 (< (bignum -1.5) (bignum -1)) #t))
+  (test1 (< -1.5 1/2) #t)
+  (when with-bignums
+    (test1 (< (bignum -1.5) 1/2) #t)
+    (test1 (< -1.5 (bignum 1/2)) #t)
+    (test1 (< (bignum -1.5) (bignum 1/2)) #t))
+  (test1 (< -1.5 -1/2) #t)
+  (when with-bignums
+    (test1 (< (bignum -1.5) -1/2) #t)
+    (test1 (< -1.5 (bignum -1/2)) #t)
+    (test1 (< (bignum -1.5) (bignum -1/2)) #t))
+  (test1 (< -1.5 1.5) #t)
+  (when with-bignums
+    (test1 (< (bignum -1.5) 1.5) #t)
+    (test1 (< -1.5 (bignum 1.5)) #t)
+    (test1 (< (bignum -1.5) (bignum 1.5)) #t))
+  (test1 (< -1.5 -1.5) #f)
+  (when with-bignums
+    (test1 (< (bignum -1.5) -1.5) #f)
+    (test1 (< -1.5 (bignum -1.5)) #f)
+    (test1 (< (bignum -1.5) (bignum -1.5)) #f))
+  (test1 (< -1.5 m1) #t)
+  (test1 (< m1 1) #f)
+  (test1 (< m1 -1) #f)
+  (test1 (< m1 1/2) #f)
+  (test1 (< m1 -1/2) #f)
+  (test1 (< m1 1.5) #f)
+  (test1 (< m1 -1.5) #f)
+  (test1 (< m1 m1) #f)
+  (test1 (> 1 1) #f)
+  (when with-bignums
+    (test1 (> (bignum 1) 1) #f)
+    (test1 (> 1 (bignum 1)) #f)
+    (test1 (> (bignum 1) (bignum 1)) #f))
+  (test1 (> 1 -1) #t)
+  (when with-bignums
+    (test1 (> (bignum 1) -1) #t)
+    (test1 (> 1 (bignum -1)) #t)
+    (test1 (> (bignum 1) (bignum -1)) #t))
+  (test1 (> 1 1/2) #t)
+  (when with-bignums
+    (test1 (> (bignum 1) 1/2) #t)
+    (test1 (> 1 (bignum 1/2)) #t)
+    (test1 (> (bignum 1) (bignum 1/2)) #t))
+  (test1 (> 1 -1/2) #t)
+  (when with-bignums
+    (test1 (> (bignum 1) -1/2) #t)
+    (test1 (> 1 (bignum -1/2)) #t)
+    (test1 (> (bignum 1) (bignum -1/2)) #t))
+  (test1 (> 1 1.5) #f)
+  (when with-bignums
+    (test1 (> (bignum 1) 1.5) #f)
+    (test1 (> 1 (bignum 1.5)) #f)
+    (test1 (> (bignum 1) (bignum 1.5)) #f))
+  (test1 (> 1 -1.5) #t)
+  (when with-bignums
+    (test1 (> (bignum 1) -1.5) #t)
+    (test1 (> 1 (bignum -1.5)) #t)
+    (test1 (> (bignum 1) (bignum -1.5)) #t))
+  (test1 (> 1 m1) #f)
+  (test1 (> -1 1) #f)
+  (when with-bignums
+    (test1 (> (bignum -1) 1) #f)
+    (test1 (> -1 (bignum 1)) #f)
+    (test1 (> (bignum -1) (bignum 1)) #f))
+  (test1 (> -1 -1) #f)
+  (when with-bignums
+    (test1 (> (bignum -1) -1) #f)
+    (test1 (> -1 (bignum -1)) #f)
+    (test1 (> (bignum -1) (bignum -1)) #f))
+  (test1 (> -1 1/2) #f)
+  (when with-bignums
+    (test1 (> (bignum -1) 1/2) #f)
+    (test1 (> -1 (bignum 1/2)) #f)
+    (test1 (> (bignum -1) (bignum 1/2)) #f))
+  (test1 (> -1 -1/2) #f)
+  (when with-bignums
+    (test1 (> (bignum -1) -1/2) #f)
+    (test1 (> -1 (bignum -1/2)) #f)
+    (test1 (> (bignum -1) (bignum -1/2)) #f))
+  (test1 (> -1 1.5) #f)
+  (when with-bignums
+    (test1 (> (bignum -1) 1.5) #f)
+    (test1 (> -1 (bignum 1.5)) #f)
+    (test1 (> (bignum -1) (bignum 1.5)) #f))
+  (test1 (> -1 -1.5) #t)
+  (when with-bignums
+    (test1 (> (bignum -1) -1.5) #t)
+    (test1 (> -1 (bignum -1.5)) #t)
+    (test1 (> (bignum -1) (bignum -1.5)) #t))
+  (test1 (> -1 m1) #f)
+  (test1 (> 1/2 1) #f)
+  (when with-bignums
+    (test1 (> (bignum 1/2) 1) #f)
+    (test1 (> 1/2 (bignum 1)) #f)
+    (test1 (> (bignum 1/2) (bignum 1)) #f))
+  (test1 (> 1/2 -1) #t)
+  (when with-bignums
+    (test1 (> (bignum 1/2) -1) #t)
+    (test1 (> 1/2 (bignum -1)) #t)
+    (test1 (> (bignum 1/2) (bignum -1)) #t))
+  (test1 (> 1/2 1/2) #f)
+  (when with-bignums
+    (test1 (> (bignum 1/2) 1/2) #f)
+    (test1 (> 1/2 (bignum 1/2)) #f)
+    (test1 (> (bignum 1/2) (bignum 1/2)) #f))
+  (test1 (> 1/2 -1/2) #t)
+  (when with-bignums
+    (test1 (> (bignum 1/2) -1/2) #t)
+    (test1 (> 1/2 (bignum -1/2)) #t)
+    (test1 (> (bignum 1/2) (bignum -1/2)) #t))
+  (test1 (> 1/2 1.5) #f)
+  (when with-bignums
+    (test1 (> (bignum 1/2) 1.5) #f)
+    (test1 (> 1/2 (bignum 1.5)) #f)
+    (test1 (> (bignum 1/2) (bignum 1.5)) #f))
+  (test1 (> 1/2 -1.5) #t)
+  (when with-bignums
+    (test1 (> (bignum 1/2) -1.5) #t)
+    (test1 (> 1/2 (bignum -1.5)) #t)
+    (test1 (> (bignum 1/2) (bignum -1.5)) #t))
+  (test1 (> 1/2 m1) #f)
+  (test1 (> -1/2 1) #f)
+  (when with-bignums
+    (test1 (> (bignum -1/2) 1) #f)
+    (test1 (> -1/2 (bignum 1)) #f)
+    (test1 (> (bignum -1/2) (bignum 1)) #f))
+  (test1 (> -1/2 -1) #t)
+  (when with-bignums
+    (test1 (> (bignum -1/2) -1) #t)
+    (test1 (> -1/2 (bignum -1)) #t)
+    (test1 (> (bignum -1/2) (bignum -1)) #t))
+  (test1 (> -1/2 1/2) #f)
+  (when with-bignums
+    (test1 (> (bignum -1/2) 1/2) #f)
+    (test1 (> -1/2 (bignum 1/2)) #f)
+    (test1 (> (bignum -1/2) (bignum 1/2)) #f))
+  (test1 (> -1/2 -1/2) #f)
+  (when with-bignums
+    (test1 (> (bignum -1/2) -1/2) #f)
+    (test1 (> -1/2 (bignum -1/2)) #f)
+    (test1 (> (bignum -1/2) (bignum -1/2)) #f))
+  (test1 (> -1/2 1.5) #f)
+  (when with-bignums
+    (test1 (> (bignum -1/2) 1.5) #f)
+    (test1 (> -1/2 (bignum 1.5)) #f)
+    (test1 (> (bignum -1/2) (bignum 1.5)) #f))
+  (test1 (> -1/2 -1.5) #t)
+  (when with-bignums
+    (test1 (> (bignum -1/2) -1.5) #t)
+    (test1 (> -1/2 (bignum -1.5)) #t)
+    (test1 (> (bignum -1/2) (bignum -1.5)) #t))
+  (test1 (> -1/2 m1) #f)
+  (test1 (> 1.5 1) #t)
+  (when with-bignums
+    (test1 (> (bignum 1.5) 1) #t)
+    (test1 (> 1.5 (bignum 1)) #t)
+    (test1 (> (bignum 1.5) (bignum 1)) #t))
+  (test1 (> 1.5 -1) #t)
+  (when with-bignums
+    (test1 (> (bignum 1.5) -1) #t)
+    (test1 (> 1.5 (bignum -1)) #t)
+    (test1 (> (bignum 1.5) (bignum -1)) #t))
+  (test1 (> 1.5 1/2) #t)
+  (when with-bignums
+    (test1 (> (bignum 1.5) 1/2) #t)
+    (test1 (> 1.5 (bignum 1/2)) #t)
+    (test1 (> (bignum 1.5) (bignum 1/2)) #t))
+  (test1 (> 1.5 -1/2) #t)
+  (when with-bignums
+    (test1 (> (bignum 1.5) -1/2) #t)
+    (test1 (> 1.5 (bignum -1/2)) #t)
+    (test1 (> (bignum 1.5) (bignum -1/2)) #t))
+  (test1 (> 1.5 1.5) #f)
+  (when with-bignums
+    (test1 (> (bignum 1.5) 1.5) #f)
+    (test1 (> 1.5 (bignum 1.5)) #f)
+    (test1 (> (bignum 1.5) (bignum 1.5)) #f))
+  (test1 (> 1.5 -1.5) #t)
+  (when with-bignums
+    (test1 (> (bignum 1.5) -1.5) #t)
+    (test1 (> 1.5 (bignum -1.5)) #t)
+    (test1 (> (bignum 1.5) (bignum -1.5)) #t))
+  (test1 (> 1.5 m1) #f)
+  (test1 (> -1.5 1) #f)
+  (when with-bignums
+    (test1 (> (bignum -1.5) 1) #f)
+    (test1 (> -1.5 (bignum 1)) #f)
+    (test1 (> (bignum -1.5) (bignum 1)) #f))
+  (test1 (> -1.5 -1) #f)
+  (when with-bignums
+    (test1 (> (bignum -1.5) -1) #f)
+    (test1 (> -1.5 (bignum -1)) #f)
+    (test1 (> (bignum -1.5) (bignum -1)) #f))
+  (test1 (> -1.5 1/2) #f)
+  (when with-bignums
+    (test1 (> (bignum -1.5) 1/2) #f)
+    (test1 (> -1.5 (bignum 1/2)) #f)
+    (test1 (> (bignum -1.5) (bignum 1/2)) #f))
+  (test1 (> -1.5 -1/2) #f)
+  (when with-bignums
+    (test1 (> (bignum -1.5) -1/2) #f)
+    (test1 (> -1.5 (bignum -1/2)) #f)
+    (test1 (> (bignum -1.5) (bignum -1/2)) #f))
+  (test1 (> -1.5 1.5) #f)
+  (when with-bignums
+    (test1 (> (bignum -1.5) 1.5) #f)
+    (test1 (> -1.5 (bignum 1.5)) #f)
+    (test1 (> (bignum -1.5) (bignum 1.5)) #f))
+  (test1 (> -1.5 -1.5) #f)
+  (when with-bignums
+    (test1 (> (bignum -1.5) -1.5) #f)
+    (test1 (> -1.5 (bignum -1.5)) #f)
+    (test1 (> (bignum -1.5) (bignum -1.5)) #f))
+  (test1 (> -1.5 m1) #f)
+  (test1 (> m1 1) #t)
+  (test1 (> m1 -1) #t)
+  (test1 (> m1 1/2) #t)
+  (test1 (> m1 -1/2) #t)
+  (test1 (> m1 1.5) #t)
+  (test1 (> m1 -1.5) #t)
+  (test1 (> m1 m1) #f)
+  (test1 (<= 1 1) #t)
+  (when with-bignums
+    (test1 (<= (bignum 1) 1) #t)
+    (test1 (<= 1 (bignum 1)) #t)
+    (test1 (<= (bignum 1) (bignum 1)) #t))
+  (test1 (<= 1 -1) #f)
+  (when with-bignums
+    (test1 (<= (bignum 1) -1) #f)
+    (test1 (<= 1 (bignum -1)) #f)
+    (test1 (<= (bignum 1) (bignum -1)) #f))
+  (test1 (<= 1 1/2) #f)
+  (when with-bignums
+    (test1 (<= (bignum 1) 1/2) #f)
+    (test1 (<= 1 (bignum 1/2)) #f)
+    (test1 (<= (bignum 1) (bignum 1/2)) #f))
+  (test1 (<= 1 -1/2) #f)
+  (when with-bignums
+    (test1 (<= (bignum 1) -1/2) #f)
+    (test1 (<= 1 (bignum -1/2)) #f)
+    (test1 (<= (bignum 1) (bignum -1/2)) #f))
+  (test1 (<= 1 1.5) #t)
+  (when with-bignums
+    (test1 (<= (bignum 1) 1.5) #t)
+    (test1 (<= 1 (bignum 1.5)) #t)
+    (test1 (<= (bignum 1) (bignum 1.5)) #t))
+  (test1 (<= 1 -1.5) #f)
+  (when with-bignums
+    (test1 (<= (bignum 1) -1.5) #f)
+    (test1 (<= 1 (bignum -1.5)) #f)
+    (test1 (<= (bignum 1) (bignum -1.5)) #f))
+  (test1 (<= 1 m1) #t)
+  (test1 (<= -1 1) #t)
+  (when with-bignums
+    (test1 (<= (bignum -1) 1) #t)
+    (test1 (<= -1 (bignum 1)) #t)
+    (test1 (<= (bignum -1) (bignum 1)) #t))
+  (test1 (<= -1 -1) #t)
+  (when with-bignums
+    (test1 (<= (bignum -1) -1) #t)
+    (test1 (<= -1 (bignum -1)) #t)
+    (test1 (<= (bignum -1) (bignum -1)) #t))
+  (test1 (<= -1 1/2) #t)
+  (when with-bignums
+    (test1 (<= (bignum -1) 1/2) #t)
+    (test1 (<= -1 (bignum 1/2)) #t)
+    (test1 (<= (bignum -1) (bignum 1/2)) #t))
+  (test1 (<= -1 -1/2) #t)
+  (when with-bignums
+    (test1 (<= (bignum -1) -1/2) #t)
+    (test1 (<= -1 (bignum -1/2)) #t)
+    (test1 (<= (bignum -1) (bignum -1/2)) #t))
+  (test1 (<= -1 1.5) #t)
+  (when with-bignums
+    (test1 (<= (bignum -1) 1.5) #t)
+    (test1 (<= -1 (bignum 1.5)) #t)
+    (test1 (<= (bignum -1) (bignum 1.5)) #t))
+  (test1 (<= -1 -1.5) #f)
+  (when with-bignums
+    (test1 (<= (bignum -1) -1.5) #f)
+    (test1 (<= -1 (bignum -1.5)) #f)
+    (test1 (<= (bignum -1) (bignum -1.5)) #f))
+  (test1 (<= -1 m1) #t)
+  (test1 (<= 1/2 1) #t)
+  (when with-bignums
+    (test1 (<= (bignum 1/2) 1) #t)
+    (test1 (<= 1/2 (bignum 1)) #t)
+    (test1 (<= (bignum 1/2) (bignum 1)) #t))
+  (test1 (<= 1/2 -1) #f)
+  (when with-bignums
+    (test1 (<= (bignum 1/2) -1) #f)
+    (test1 (<= 1/2 (bignum -1)) #f)
+    (test1 (<= (bignum 1/2) (bignum -1)) #f))
+  (test1 (<= 1/2 1/2) #t)
+  (when with-bignums
+    (test1 (<= (bignum 1/2) 1/2) #t)
+    (test1 (<= 1/2 (bignum 1/2)) #t)
+    (test1 (<= (bignum 1/2) (bignum 1/2)) #t))
+  (test1 (<= 1/2 -1/2) #f)
+  (when with-bignums
+    (test1 (<= (bignum 1/2) -1/2) #f)
+    (test1 (<= 1/2 (bignum -1/2)) #f)
+    (test1 (<= (bignum 1/2) (bignum -1/2)) #f))
+  (test1 (<= 1/2 1.5) #t)
+  (when with-bignums
+    (test1 (<= (bignum 1/2) 1.5) #t)
+    (test1 (<= 1/2 (bignum 1.5)) #t)
+    (test1 (<= (bignum 1/2) (bignum 1.5)) #t))
+  (test1 (<= 1/2 -1.5) #f)
+  (when with-bignums
+    (test1 (<= (bignum 1/2) -1.5) #f)
+    (test1 (<= 1/2 (bignum -1.5)) #f)
+    (test1 (<= (bignum 1/2) (bignum -1.5)) #f))
+  (test1 (<= 1/2 m1) #t)
+  (test1 (<= -1/2 1) #t)
+  (when with-bignums
+    (test1 (<= (bignum -1/2) 1) #t)
+    (test1 (<= -1/2 (bignum 1)) #t)
+    (test1 (<= (bignum -1/2) (bignum 1)) #t))
+  (test1 (<= -1/2 -1) #f)
+  (when with-bignums
+    (test1 (<= (bignum -1/2) -1) #f)
+    (test1 (<= -1/2 (bignum -1)) #f)
+    (test1 (<= (bignum -1/2) (bignum -1)) #f))
+  (test1 (<= -1/2 1/2) #t)
+  (when with-bignums
+    (test1 (<= (bignum -1/2) 1/2) #t)
+    (test1 (<= -1/2 (bignum 1/2)) #t)
+    (test1 (<= (bignum -1/2) (bignum 1/2)) #t))
+  (test1 (<= -1/2 -1/2) #t)
+  (when with-bignums
+    (test1 (<= (bignum -1/2) -1/2) #t)
+    (test1 (<= -1/2 (bignum -1/2)) #t)
+    (test1 (<= (bignum -1/2) (bignum -1/2)) #t))
+  (test1 (<= -1/2 1.5) #t)
+  (when with-bignums
+    (test1 (<= (bignum -1/2) 1.5) #t)
+    (test1 (<= -1/2 (bignum 1.5)) #t)
+    (test1 (<= (bignum -1/2) (bignum 1.5)) #t))
+  (test1 (<= -1/2 -1.5) #f)
+  (when with-bignums
+    (test1 (<= (bignum -1/2) -1.5) #f)
+    (test1 (<= -1/2 (bignum -1.5)) #f)
+    (test1 (<= (bignum -1/2) (bignum -1.5)) #f))
+  (test1 (<= -1/2 m1) #t)
+  (test1 (<= 1.5 1) #f)
+  (when with-bignums
+    (test1 (<= (bignum 1.5) 1) #f)
+    (test1 (<= 1.5 (bignum 1)) #f)
+    (test1 (<= (bignum 1.5) (bignum 1)) #f))
+  (test1 (<= 1.5 -1) #f)
+  (when with-bignums
+    (test1 (<= (bignum 1.5) -1) #f)
+    (test1 (<= 1.5 (bignum -1)) #f)
+    (test1 (<= (bignum 1.5) (bignum -1)) #f))
+  (test1 (<= 1.5 1/2) #f)
+  (when with-bignums
+    (test1 (<= (bignum 1.5) 1/2) #f)
+    (test1 (<= 1.5 (bignum 1/2)) #f)
+    (test1 (<= (bignum 1.5) (bignum 1/2)) #f))
+  (test1 (<= 1.5 -1/2) #f)
+  (when with-bignums
+    (test1 (<= (bignum 1.5) -1/2) #f)
+    (test1 (<= 1.5 (bignum -1/2)) #f)
+    (test1 (<= (bignum 1.5) (bignum -1/2)) #f))
+  (test1 (<= 1.5 1.5) #t)
+  (when with-bignums
+    (test1 (<= (bignum 1.5) 1.5) #t)
+    (test1 (<= 1.5 (bignum 1.5)) #t)
+    (test1 (<= (bignum 1.5) (bignum 1.5)) #t))
+  (test1 (<= 1.5 -1.5) #f)
+  (when with-bignums
+    (test1 (<= (bignum 1.5) -1.5) #f)
+    (test1 (<= 1.5 (bignum -1.5)) #f)
+    (test1 (<= (bignum 1.5) (bignum -1.5)) #f))
+  (test1 (<= 1.5 m1) #t)
+  (test1 (<= -1.5 1) #t)
+  (when with-bignums
+    (test1 (<= (bignum -1.5) 1) #t)
+    (test1 (<= -1.5 (bignum 1)) #t)
+    (test1 (<= (bignum -1.5) (bignum 1)) #t))
+  (test1 (<= -1.5 -1) #t)
+  (when with-bignums
+    (test1 (<= (bignum -1.5) -1) #t)
+    (test1 (<= -1.5 (bignum -1)) #t)
+    (test1 (<= (bignum -1.5) (bignum -1)) #t))
+  (test1 (<= -1.5 1/2) #t)
+  (when with-bignums
+    (test1 (<= (bignum -1.5) 1/2) #t)
+    (test1 (<= -1.5 (bignum 1/2)) #t)
+    (test1 (<= (bignum -1.5) (bignum 1/2)) #t))
+  (test1 (<= -1.5 -1/2) #t)
+  (when with-bignums
+    (test1 (<= (bignum -1.5) -1/2) #t)
+    (test1 (<= -1.5 (bignum -1/2)) #t)
+    (test1 (<= (bignum -1.5) (bignum -1/2)) #t))
+  (test1 (<= -1.5 1.5) #t)
+  (when with-bignums
+    (test1 (<= (bignum -1.5) 1.5) #t)
+    (test1 (<= -1.5 (bignum 1.5)) #t)
+    (test1 (<= (bignum -1.5) (bignum 1.5)) #t))
+  (test1 (<= -1.5 -1.5) #t)
+  (when with-bignums
+    (test1 (<= (bignum -1.5) -1.5) #t)
+    (test1 (<= -1.5 (bignum -1.5)) #t)
+    (test1 (<= (bignum -1.5) (bignum -1.5)) #t))
+  (test1 (<= -1.5 m1) #t)
+  (test1 (<= m1 1) #f)
+  (test1 (<= m1 -1) #f)
+  (test1 (<= m1 1/2) #f)
+  (test1 (<= m1 -1/2) #f)
+  (test1 (<= m1 1.5) #f)
+  (test1 (<= m1 -1.5) #f)
+  (test1 (<= m1 m1) #t)
+  (test1 (>= 1 1) #t)
+  (when with-bignums
+    (test1 (>= (bignum 1) 1) #t)
+    (test1 (>= 1 (bignum 1)) #t)
+    (test1 (>= (bignum 1) (bignum 1)) #t))
+  (test1 (>= 1 -1) #t)
+  (when with-bignums
+    (test1 (>= (bignum 1) -1) #t)
+    (test1 (>= 1 (bignum -1)) #t)
+    (test1 (>= (bignum 1) (bignum -1)) #t))
+  (test1 (>= 1 1/2) #t)
+  (when with-bignums
+    (test1 (>= (bignum 1) 1/2) #t)
+    (test1 (>= 1 (bignum 1/2)) #t)
+    (test1 (>= (bignum 1) (bignum 1/2)) #t))
+  (test1 (>= 1 -1/2) #t)
+  (when with-bignums
+    (test1 (>= (bignum 1) -1/2) #t)
+    (test1 (>= 1 (bignum -1/2)) #t)
+    (test1 (>= (bignum 1) (bignum -1/2)) #t))
+  (test1 (>= 1 1.5) #f)
+  (when with-bignums
+    (test1 (>= (bignum 1) 1.5) #f)
+    (test1 (>= 1 (bignum 1.5)) #f)
+    (test1 (>= (bignum 1) (bignum 1.5)) #f))
+  (test1 (>= 1 -1.5) #t)
+  (when with-bignums
+    (test1 (>= (bignum 1) -1.5) #t)
+    (test1 (>= 1 (bignum -1.5)) #t)
+    (test1 (>= (bignum 1) (bignum -1.5)) #t))
+  (test1 (>= 1 m1) #f)
+  (test1 (>= -1 1) #f)
+  (when with-bignums
+    (test1 (>= (bignum -1) 1) #f)
+    (test1 (>= -1 (bignum 1)) #f)
+    (test1 (>= (bignum -1) (bignum 1)) #f))
+  (test1 (>= -1 -1) #t)
+  (when with-bignums
+    (test1 (>= (bignum -1) -1) #t)
+    (test1 (>= -1 (bignum -1)) #t)
+    (test1 (>= (bignum -1) (bignum -1)) #t))
+  (test1 (>= -1 1/2) #f)
+  (when with-bignums
+    (test1 (>= (bignum -1) 1/2) #f)
+    (test1 (>= -1 (bignum 1/2)) #f)
+    (test1 (>= (bignum -1) (bignum 1/2)) #f))
+  (test1 (>= -1 -1/2) #f)
+  (when with-bignums
+    (test1 (>= (bignum -1) -1/2) #f)
+    (test1 (>= -1 (bignum -1/2)) #f)
+    (test1 (>= (bignum -1) (bignum -1/2)) #f))
+  (test1 (>= -1 1.5) #f)
+  (when with-bignums
+    (test1 (>= (bignum -1) 1.5) #f)
+    (test1 (>= -1 (bignum 1.5)) #f)
+    (test1 (>= (bignum -1) (bignum 1.5)) #f))
+  (test1 (>= -1 -1.5) #t)
+  (when with-bignums
+    (test1 (>= (bignum -1) -1.5) #t)
+    (test1 (>= -1 (bignum -1.5)) #t)
+    (test1 (>= (bignum -1) (bignum -1.5)) #t))
+  (test1 (>= -1 m1) #f)
+  (test1 (>= 1/2 1) #f)
+  (when with-bignums
+    (test1 (>= (bignum 1/2) 1) #f)
+    (test1 (>= 1/2 (bignum 1)) #f)
+    (test1 (>= (bignum 1/2) (bignum 1)) #f))
+  (test1 (>= 1/2 -1) #t)
+  (when with-bignums
+    (test1 (>= (bignum 1/2) -1) #t)
+    (test1 (>= 1/2 (bignum -1)) #t)
+    (test1 (>= (bignum 1/2) (bignum -1)) #t))
+  (test1 (>= 1/2 1/2) #t)
+  (when with-bignums
+    (test1 (>= (bignum 1/2) 1/2) #t)
+    (test1 (>= 1/2 (bignum 1/2)) #t)
+    (test1 (>= (bignum 1/2) (bignum 1/2)) #t))
+  (test1 (>= 1/2 -1/2) #t)
+  (when with-bignums
+    (test1 (>= (bignum 1/2) -1/2) #t)
+    (test1 (>= 1/2 (bignum -1/2)) #t)
+    (test1 (>= (bignum 1/2) (bignum -1/2)) #t))
+  (test1 (>= 1/2 1.5) #f)
+  (when with-bignums
+    (test1 (>= (bignum 1/2) 1.5) #f)
+    (test1 (>= 1/2 (bignum 1.5)) #f)
+    (test1 (>= (bignum 1/2) (bignum 1.5)) #f))
+  (test1 (>= 1/2 -1.5) #t)
+  (when with-bignums
+    (test1 (>= (bignum 1/2) -1.5) #t)
+    (test1 (>= 1/2 (bignum -1.5)) #t)
+    (test1 (>= (bignum 1/2) (bignum -1.5)) #t))
+  (test1 (>= 1/2 m1) #f)
+  (test1 (>= -1/2 1) #f)
+  (when with-bignums
+    (test1 (>= (bignum -1/2) 1) #f)
+    (test1 (>= -1/2 (bignum 1)) #f)
+    (test1 (>= (bignum -1/2) (bignum 1)) #f))
+  (test1 (>= -1/2 -1) #t)
+  (when with-bignums
+    (test1 (>= (bignum -1/2) -1) #t)
+    (test1 (>= -1/2 (bignum -1)) #t)
+    (test1 (>= (bignum -1/2) (bignum -1)) #t))
+  (test1 (>= -1/2 1/2) #f)
+  (when with-bignums
+    (test1 (>= (bignum -1/2) 1/2) #f)
+    (test1 (>= -1/2 (bignum 1/2)) #f)
+    (test1 (>= (bignum -1/2) (bignum 1/2)) #f))
+  (test1 (>= -1/2 -1/2) #t)
+  (when with-bignums
+    (test1 (>= (bignum -1/2) -1/2) #t)
+    (test1 (>= -1/2 (bignum -1/2)) #t)
+    (test1 (>= (bignum -1/2) (bignum -1/2)) #t))
+  (test1 (>= -1/2 1.5) #f)
+  (when with-bignums
+    (test1 (>= (bignum -1/2) 1.5) #f)
+    (test1 (>= -1/2 (bignum 1.5)) #f)
+    (test1 (>= (bignum -1/2) (bignum 1.5)) #f))
+  (test1 (>= -1/2 -1.5) #t)
+  (when with-bignums
+    (test1 (>= (bignum -1/2) -1.5) #t)
+    (test1 (>= -1/2 (bignum -1.5)) #t)
+    (test1 (>= (bignum -1/2) (bignum -1.5)) #t))
+  (test1 (>= -1/2 m1) #f)
+  (test1 (>= 1.5 1) #t)
+  (when with-bignums
+    (test1 (>= (bignum 1.5) 1) #t)
+    (test1 (>= 1.5 (bignum 1)) #t)
+    (test1 (>= (bignum 1.5) (bignum 1)) #t))
+  (test1 (>= 1.5 -1) #t)
+  (when with-bignums
+    (test1 (>= (bignum 1.5) -1) #t)
+    (test1 (>= 1.5 (bignum -1)) #t)
+    (test1 (>= (bignum 1.5) (bignum -1)) #t))
+  (test1 (>= 1.5 1/2) #t)
+  (when with-bignums
+    (test1 (>= (bignum 1.5) 1/2) #t)
+    (test1 (>= 1.5 (bignum 1/2)) #t)
+    (test1 (>= (bignum 1.5) (bignum 1/2)) #t))
+  (test1 (>= 1.5 -1/2) #t)
+  (when with-bignums
+    (test1 (>= (bignum 1.5) -1/2) #t)
+    (test1 (>= 1.5 (bignum -1/2)) #t)
+    (test1 (>= (bignum 1.5) (bignum -1/2)) #t))
+  (test1 (>= 1.5 1.5) #t)
+  (when with-bignums
+    (test1 (>= (bignum 1.5) 1.5) #t)
+    (test1 (>= 1.5 (bignum 1.5)) #t)
+    (test1 (>= (bignum 1.5) (bignum 1.5)) #t))
+  (test1 (>= 1.5 -1.5) #t)
+  (when with-bignums
+    (test1 (>= (bignum 1.5) -1.5) #t)
+    (test1 (>= 1.5 (bignum -1.5)) #t)
+    (test1 (>= (bignum 1.5) (bignum -1.5)) #t))
+  (test1 (>= 1.5 m1) #f)
+  (test1 (>= -1.5 1) #f)
+  (when with-bignums
+    (test1 (>= (bignum -1.5) 1) #f)
+    (test1 (>= -1.5 (bignum 1)) #f)
+    (test1 (>= (bignum -1.5) (bignum 1)) #f))
+  (test1 (>= -1.5 -1) #f)
+  (when with-bignums
+    (test1 (>= (bignum -1.5) -1) #f)
+    (test1 (>= -1.5 (bignum -1)) #f)
+    (test1 (>= (bignum -1.5) (bignum -1)) #f))
+  (test1 (>= -1.5 1/2) #f)
+  (when with-bignums
+    (test1 (>= (bignum -1.5) 1/2) #f)
+    (test1 (>= -1.5 (bignum 1/2)) #f)
+    (test1 (>= (bignum -1.5) (bignum 1/2)) #f))
+  (test1 (>= -1.5 -1/2) #f)
+  (when with-bignums
+    (test1 (>= (bignum -1.5) -1/2) #f)
+    (test1 (>= -1.5 (bignum -1/2)) #f)
+    (test1 (>= (bignum -1.5) (bignum -1/2)) #f))
+  (test1 (>= -1.5 1.5) #f)
+  (when with-bignums
+    (test1 (>= (bignum -1.5) 1.5) #f)
+    (test1 (>= -1.5 (bignum 1.5)) #f)
+    (test1 (>= (bignum -1.5) (bignum 1.5)) #f))
+  (test1 (>= -1.5 -1.5) #t)
+  (when with-bignums
+    (test1 (>= (bignum -1.5) -1.5) #t)
+    (test1 (>= -1.5 (bignum -1.5)) #t)
+    (test1 (>= (bignum -1.5) (bignum -1.5)) #t))
+  (test1 (>= -1.5 m1) #f)
+  (test1 (>= m1 1) #t)
+  (test1 (>= m1 -1) #t)
+  (test1 (>= m1 1/2) #t)
+  (test1 (>= m1 -1/2) #t)
+  (test1 (>= m1 1.5) #t)
+  (test1 (>= m1 -1.5) #t)
+  (test1 (>= m1 m1) #t)
+
+  (test1 (min 1 1) 1)
+  (when with-bignums
+    (test1 (min (bignum 1) 1) 1)
+    (test1 (min 1 (bignum 1)) 1)
+    (test1 (min (bignum 1) (bignum 1)) 1))
+  (test1 (min 1 -1) -1)
+  (when with-bignums
+    (test1 (min (bignum 1) -1) -1)
+    (test1 (min 1 (bignum -1)) -1)
+    (test1 (min (bignum 1) (bignum -1)) -1))
+  (test1 (min 1 1/2) 1/2)
+  (when with-bignums
+    (test1 (min (bignum 1) 1/2) 1/2)
+    (test1 (min 1 (bignum 1/2)) 1/2)
+    (test1 (min (bignum 1) (bignum 1/2)) 1/2))
+  (test1 (min 1 -1/2) -1/2)
+  (when with-bignums
+    (test1 (min (bignum 1) -1/2) -1/2)
+    (test1 (min 1 (bignum -1/2)) -1/2)
+    (test1 (min (bignum 1) (bignum -1/2)) -1/2))
+  (test1 (min 1 1.5) 1)
+  (when with-bignums
+    (test1 (min (bignum 1) 1.5) 1)
+    (test1 (min 1 (bignum 1.5)) 1)
+    (test1 (min (bignum 1) (bignum 1.5)) 1))
+  (test1 (min 1 -1.5) -1.5)
+  (when with-bignums
+    (test1 (min (bignum 1) -1.5) -1.5)
+    (test1 (min 1 (bignum -1.5)) -1.5)
+    (test1 (min (bignum 1) (bignum -1.5)) -1.5))
+  (test1 (min 1 m1) 1)
+  (test1 (min -1 1) -1)
+  (when with-bignums
+    (test1 (min (bignum -1) 1) -1)
+    (test1 (min -1 (bignum 1)) -1)
+    (test1 (min (bignum -1) (bignum 1)) -1))
+  (test1 (min -1 -1) -1)
+  (when with-bignums
+    (test1 (min (bignum -1) -1) -1)
+    (test1 (min -1 (bignum -1)) -1)
+    (test1 (min (bignum -1) (bignum -1)) -1))
+  (test1 (min -1 1/2) -1)
+  (when with-bignums
+    (test1 (min (bignum -1) 1/2) -1)
+    (test1 (min -1 (bignum 1/2)) -1)
+    (test1 (min (bignum -1) (bignum 1/2)) -1))
+  (test1 (min -1 -1/2) -1)
+  (when with-bignums
+    (test1 (min (bignum -1) -1/2) -1)
+    (test1 (min -1 (bignum -1/2)) -1)
+    (test1 (min (bignum -1) (bignum -1/2)) -1))
+  (test1 (min -1 1.5) -1)
+  (when with-bignums
+    (test1 (min (bignum -1) 1.5) -1)
+    (test1 (min -1 (bignum 1.5)) -1)
+    (test1 (min (bignum -1) (bignum 1.5)) -1))
+  (test1 (min -1 -1.5) -1.5)
+  (when with-bignums
+    (test1 (min (bignum -1) -1.5) -1.5)
+    (test1 (min -1 (bignum -1.5)) -1.5)
+    (test1 (min (bignum -1) (bignum -1.5)) -1.5))
+  (test1 (min -1 m1) -1)
+  (test1 (min 1/2 1) 1/2)
+  (when with-bignums
+    (test1 (min (bignum 1/2) 1) 1/2)
+    (test1 (min 1/2 (bignum 1)) 1/2)
+    (test1 (min (bignum 1/2) (bignum 1)) 1/2))
+  (test1 (min 1/2 -1) -1)
+  (when with-bignums
+    (test1 (min (bignum 1/2) -1) -1)
+    (test1 (min 1/2 (bignum -1)) -1)
+    (test1 (min (bignum 1/2) (bignum -1)) -1))
+  (test1 (min 1/2 1/2) 1/2)
+  (when with-bignums
+    (test1 (min (bignum 1/2) 1/2) 1/2)
+    (test1 (min 1/2 (bignum 1/2)) 1/2)
+    (test1 (min (bignum 1/2) (bignum 1/2)) 1/2))
+  (test1 (min 1/2 -1/2) -1/2)
+  (when with-bignums
+    (test1 (min (bignum 1/2) -1/2) -1/2)
+    (test1 (min 1/2 (bignum -1/2)) -1/2)
+    (test1 (min (bignum 1/2) (bignum -1/2)) -1/2))
+  (test1 (min 1/2 1.5) 1/2)
+  (when with-bignums
+    (test1 (min (bignum 1/2) 1.5) 1/2)
+    (test1 (min 1/2 (bignum 1.5)) 1/2)
+    (test1 (min (bignum 1/2) (bignum 1.5)) 1/2))
+  (test1 (min 1/2 -1.5) -1.5)
+  (when with-bignums
+    (test1 (min (bignum 1/2) -1.5) -1.5)
+    (test1 (min 1/2 (bignum -1.5)) -1.5)
+    (test1 (min (bignum 1/2) (bignum -1.5)) -1.5))
+  (test1 (min 1/2 m1) 1/2)
+  (test1 (min -1/2 1) -1/2)
+  (when with-bignums
+    (test1 (min (bignum -1/2) 1) -1/2)
+    (test1 (min -1/2 (bignum 1)) -1/2)
+    (test1 (min (bignum -1/2) (bignum 1)) -1/2))
+  (test1 (min -1/2 -1) -1)
+  (when with-bignums
+    (test1 (min (bignum -1/2) -1) -1)
+    (test1 (min -1/2 (bignum -1)) -1)
+    (test1 (min (bignum -1/2) (bignum -1)) -1))
+  (test1 (min -1/2 1/2) -1/2)
+  (when with-bignums
+    (test1 (min (bignum -1/2) 1/2) -1/2)
+    (test1 (min -1/2 (bignum 1/2)) -1/2)
+    (test1 (min (bignum -1/2) (bignum 1/2)) -1/2))
+  (test1 (min -1/2 -1/2) -1/2)
+  (when with-bignums
+    (test1 (min (bignum -1/2) -1/2) -1/2)
+    (test1 (min -1/2 (bignum -1/2)) -1/2)
+    (test1 (min (bignum -1/2) (bignum -1/2)) -1/2))
+  (test1 (min -1/2 1.5) -1/2)
+  (when with-bignums
+    (test1 (min (bignum -1/2) 1.5) -1/2)
+    (test1 (min -1/2 (bignum 1.5)) -1/2)
+    (test1 (min (bignum -1/2) (bignum 1.5)) -1/2))
+  (test1 (min -1/2 -1.5) -1.5)
+  (when with-bignums
+    (test1 (min (bignum -1/2) -1.5) -1.5)
+    (test1 (min -1/2 (bignum -1.5)) -1.5)
+    (test1 (min (bignum -1/2) (bignum -1.5)) -1.5))
+  (test1 (min -1/2 m1) -1/2)
+  (test1 (min 1.5 1) 1)
+  (when with-bignums
+    (test1 (min (bignum 1.5) 1) 1)
+    (test1 (min 1.5 (bignum 1)) 1)
+    (test1 (min (bignum 1.5) (bignum 1)) 1))
+  (test1 (min 1.5 -1) -1)
+  (when with-bignums
+    (test1 (min (bignum 1.5) -1) -1)
+    (test1 (min 1.5 (bignum -1)) -1)
+    (test1 (min (bignum 1.5) (bignum -1)) -1))
+  (test1 (min 1.5 1/2) 1/2)
+  (when with-bignums
+    (test1 (min (bignum 1.5) 1/2) 1/2)
+    (test1 (min 1.5 (bignum 1/2)) 1/2)
+    (test1 (min (bignum 1.5) (bignum 1/2)) 1/2))
+  (test1 (min 1.5 -1/2) -1/2)
+  (when with-bignums
+    (test1 (min (bignum 1.5) -1/2) -1/2)
+    (test1 (min 1.5 (bignum -1/2)) -1/2)
+    (test1 (min (bignum 1.5) (bignum -1/2)) -1/2))
+  (test1 (min 1.5 1.5) 1.5)
+  (when with-bignums
+    (test1 (min (bignum 1.5) 1.5) 1.5)
+    (test1 (min 1.5 (bignum 1.5)) 1.5)
+    (test1 (min (bignum 1.5) (bignum 1.5)) 1.5))
+  (test1 (min 1.5 -1.5) -1.5)
+  (when with-bignums
+    (test1 (min (bignum 1.5) -1.5) -1.5)
+    (test1 (min 1.5 (bignum -1.5)) -1.5)
+    (test1 (min (bignum 1.5) (bignum -1.5)) -1.5))
+  (test1 (min 1.5 m1) 1.5)
+  (test1 (min -1.5 1) -1.5)
+  (when with-bignums
+    (test1 (min (bignum -1.5) 1) -1.5)
+    (test1 (min -1.5 (bignum 1)) -1.5)
+    (test1 (min (bignum -1.5) (bignum 1)) -1.5))
+  (test1 (min -1.5 -1) -1.5)
+  (when with-bignums
+    (test1 (min (bignum -1.5) -1) -1.5)
+    (test1 (min -1.5 (bignum -1)) -1.5)
+    (test1 (min (bignum -1.5) (bignum -1)) -1.5))
+  (test1 (min -1.5 1/2) -1.5)
+  (when with-bignums
+    (test1 (min (bignum -1.5) 1/2) -1.5)
+    (test1 (min -1.5 (bignum 1/2)) -1.5)
+    (test1 (min (bignum -1.5) (bignum 1/2)) -1.5))
+  (test1 (min -1.5 -1/2) -1.5)
+  (when with-bignums
+    (test1 (min (bignum -1.5) -1/2) -1.5)
+    (test1 (min -1.5 (bignum -1/2)) -1.5)
+    (test1 (min (bignum -1.5) (bignum -1/2)) -1.5))
+  (test1 (min -1.5 1.5) -1.5)
+  (when with-bignums
+    (test1 (min (bignum -1.5) 1.5) -1.5)
+    (test1 (min -1.5 (bignum 1.5)) -1.5)
+    (test1 (min (bignum -1.5) (bignum 1.5)) -1.5))
+  (test1 (min -1.5 -1.5) -1.5)
+  (when with-bignums
+    (test1 (min (bignum -1.5) -1.5) -1.5)
+    (test1 (min -1.5 (bignum -1.5)) -1.5)
+    (test1 (min (bignum -1.5) (bignum -1.5)) -1.5))
+  (test1 (min -1.5 m1) -1.5)
+  (test1 (min m1 1) 1)
+  (test1 (min m1 -1) -1)
+  (test1 (min m1 1/2) 1/2)
+  (test1 (min m1 -1/2) -1/2)
+  (test1 (min m1 1.5) 1.5)
+  (test1 (min m1 -1.5) -1.5)
+  (test1 (min m1 m1) 3)
+  (test1 (max 1 1) 1)
+  (when with-bignums
+    (test1 (max (bignum 1) 1) 1)
+    (test1 (max 1 (bignum 1)) 1)
+    (test1 (max (bignum 1) (bignum 1)) 1))
+  (test1 (max 1 -1) 1)
+  (when with-bignums
+    (test1 (max (bignum 1) -1) 1)
+    (test1 (max 1 (bignum -1)) 1)
+    (test1 (max (bignum 1) (bignum -1)) 1))
+  (test1 (max 1 1/2) 1)
+  (when with-bignums
+    (test1 (max (bignum 1) 1/2) 1)
+    (test1 (max 1 (bignum 1/2)) 1)
+    (test1 (max (bignum 1) (bignum 1/2)) 1))
+  (test1 (max 1 -1/2) 1)
+  (when with-bignums
+    (test1 (max (bignum 1) -1/2) 1)
+    (test1 (max 1 (bignum -1/2)) 1)
+    (test1 (max (bignum 1) (bignum -1/2)) 1))
+  (test1 (max 1 1.5) 1.5)
+  (when with-bignums
+    (test1 (max (bignum 1) 1.5) 1.5)
+    (test1 (max 1 (bignum 1.5)) 1.5)
+    (test1 (max (bignum 1) (bignum 1.5)) 1.5))
+  (test1 (max 1 -1.5) 1)
+  (when with-bignums
+    (test1 (max (bignum 1) -1.5) 1)
+    (test1 (max 1 (bignum -1.5)) 1)
+    (test1 (max (bignum 1) (bignum -1.5)) 1))
+  (test1 (max 1 m1) 3)
+  (test1 (max -1 1) 1)
+  (when with-bignums
+    (test1 (max (bignum -1) 1) 1)
+    (test1 (max -1 (bignum 1)) 1)
+    (test1 (max (bignum -1) (bignum 1)) 1))
+  (test1 (max -1 -1) -1)
+  (when with-bignums
+    (test1 (max (bignum -1) -1) -1)
+    (test1 (max -1 (bignum -1)) -1)
+    (test1 (max (bignum -1) (bignum -1)) -1))
+  (test1 (max -1 1/2) 1/2)
+  (when with-bignums
+    (test1 (max (bignum -1) 1/2) 1/2)
+    (test1 (max -1 (bignum 1/2)) 1/2)
+    (test1 (max (bignum -1) (bignum 1/2)) 1/2))
+  (test1 (max -1 -1/2) -1/2)
+  (when with-bignums
+    (test1 (max (bignum -1) -1/2) -1/2)
+    (test1 (max -1 (bignum -1/2)) -1/2)
+    (test1 (max (bignum -1) (bignum -1/2)) -1/2))
+  (test1 (max -1 1.5) 1.5)
+  (when with-bignums
+    (test1 (max (bignum -1) 1.5) 1.5)
+    (test1 (max -1 (bignum 1.5)) 1.5)
+    (test1 (max (bignum -1) (bignum 1.5)) 1.5))
+  (test1 (max -1 -1.5) -1)
+  (when with-bignums
+    (test1 (max (bignum -1) -1.5) -1)
+    (test1 (max -1 (bignum -1.5)) -1)
+    (test1 (max (bignum -1) (bignum -1.5)) -1))
+  (test1 (max -1 m1) 3)
+  (test1 (max 1/2 1) 1)
+  (when with-bignums
+    (test1 (max (bignum 1/2) 1) 1)
+    (test1 (max 1/2 (bignum 1)) 1)
+    (test1 (max (bignum 1/2) (bignum 1)) 1))
+  (test1 (max 1/2 -1) 1/2)
+  (when with-bignums
+    (test1 (max (bignum 1/2) -1) 1/2)
+    (test1 (max 1/2 (bignum -1)) 1/2)
+    (test1 (max (bignum 1/2) (bignum -1)) 1/2))
+  (test1 (max 1/2 1/2) 1/2)
+  (when with-bignums
+    (test1 (max (bignum 1/2) 1/2) 1/2)
+    (test1 (max 1/2 (bignum 1/2)) 1/2)
+    (test1 (max (bignum 1/2) (bignum 1/2)) 1/2))
+  (test1 (max 1/2 -1/2) 1/2)
+  (when with-bignums
+    (test1 (max (bignum 1/2) -1/2) 1/2)
+    (test1 (max 1/2 (bignum -1/2)) 1/2)
+    (test1 (max (bignum 1/2) (bignum -1/2)) 1/2))
+  (test1 (max 1/2 1.5) 1.5)
+  (when with-bignums
+    (test1 (max (bignum 1/2) 1.5) 1.5)
+    (test1 (max 1/2 (bignum 1.5)) 1.5)
+    (test1 (max (bignum 1/2) (bignum 1.5)) 1.5))
+  (test1 (max 1/2 -1.5) 1/2)
+  (when with-bignums
+    (test1 (max (bignum 1/2) -1.5) 1/2)
+    (test1 (max 1/2 (bignum -1.5)) 1/2)
+    (test1 (max (bignum 1/2) (bignum -1.5)) 1/2))
+  (test1 (max 1/2 m1) 3)
+  (test1 (max -1/2 1) 1)
+  (when with-bignums
+    (test1 (max (bignum -1/2) 1) 1)
+    (test1 (max -1/2 (bignum 1)) 1)
+    (test1 (max (bignum -1/2) (bignum 1)) 1))
+  (test1 (max -1/2 -1) -1/2)
+  (when with-bignums
+    (test1 (max (bignum -1/2) -1) -1/2)
+    (test1 (max -1/2 (bignum -1)) -1/2)
+    (test1 (max (bignum -1/2) (bignum -1)) -1/2))
+  (test1 (max -1/2 1/2) 1/2)
+  (when with-bignums
+    (test1 (max (bignum -1/2) 1/2) 1/2)
+    (test1 (max -1/2 (bignum 1/2)) 1/2)
+    (test1 (max (bignum -1/2) (bignum 1/2)) 1/2))
+  (test1 (max -1/2 -1/2) -1/2)
+  (when with-bignums
+    (test1 (max (bignum -1/2) -1/2) -1/2)
+    (test1 (max -1/2 (bignum -1/2)) -1/2)
+    (test1 (max (bignum -1/2) (bignum -1/2)) -1/2))
+  (test1 (max -1/2 1.5) 1.5)
+  (when with-bignums
+    (test1 (max (bignum -1/2) 1.5) 1.5)
+    (test1 (max -1/2 (bignum 1.5)) 1.5)
+    (test1 (max (bignum -1/2) (bignum 1.5)) 1.5))
+  (test1 (max -1/2 -1.5) -1/2)
+  (when with-bignums
+    (test1 (max (bignum -1/2) -1.5) -1/2)
+    (test1 (max -1/2 (bignum -1.5)) -1/2)
+    (test1 (max (bignum -1/2) (bignum -1.5)) -1/2))
+  (test1 (max -1/2 m1) 3)
+  (test1 (max 1.5 1) 1.5)
+  (when with-bignums
+    (test1 (max (bignum 1.5) 1) 1.5)
+    (test1 (max 1.5 (bignum 1)) 1.5)
+    (test1 (max (bignum 1.5) (bignum 1)) 1.5))
+  (test1 (max 1.5 -1) 1.5)
+  (when with-bignums
+    (test1 (max (bignum 1.5) -1) 1.5)
+    (test1 (max 1.5 (bignum -1)) 1.5)
+    (test1 (max (bignum 1.5) (bignum -1)) 1.5))
+  (test1 (max 1.5 1/2) 1.5)
+  (when with-bignums
+    (test1 (max (bignum 1.5) 1/2) 1.5)
+    (test1 (max 1.5 (bignum 1/2)) 1.5)
+    (test1 (max (bignum 1.5) (bignum 1/2)) 1.5))
+  (test1 (max 1.5 -1/2) 1.5)
+  (when with-bignums
+    (test1 (max (bignum 1.5) -1/2) 1.5)
+    (test1 (max 1.5 (bignum -1/2)) 1.5)
+    (test1 (max (bignum 1.5) (bignum -1/2)) 1.5))
+  (test1 (max 1.5 1.5) 1.5)
+  (when with-bignums
+    (test1 (max (bignum 1.5) 1.5) 1.5)
+    (test1 (max 1.5 (bignum 1.5)) 1.5)
+    (test1 (max (bignum 1.5) (bignum 1.5)) 1.5))
+  (test1 (max 1.5 -1.5) 1.5)
+  (when with-bignums
+    (test1 (max (bignum 1.5) -1.5) 1.5)
+    (test1 (max 1.5 (bignum -1.5)) 1.5)
+    (test1 (max (bignum 1.5) (bignum -1.5)) 1.5))
+  (test1 (max 1.5 m1) 3)
+  (test1 (max -1.5 1) 1)
+  (when with-bignums
+    (test1 (max (bignum -1.5) 1) 1)
+    (test1 (max -1.5 (bignum 1)) 1)
+    (test1 (max (bignum -1.5) (bignum 1)) 1))
+  (test1 (max -1.5 -1) -1)
+  (when with-bignums
+    (test1 (max (bignum -1.5) -1) -1)
+    (test1 (max -1.5 (bignum -1)) -1)
+    (test1 (max (bignum -1.5) (bignum -1)) -1))
+  (test1 (max -1.5 1/2) 1/2)
+  (when with-bignums
+    (test1 (max (bignum -1.5) 1/2) 1/2)
+    (test1 (max -1.5 (bignum 1/2)) 1/2)
+    (test1 (max (bignum -1.5) (bignum 1/2)) 1/2))
+  (test1 (max -1.5 -1/2) -1/2)
+  (when with-bignums
+    (test1 (max (bignum -1.5) -1/2) -1/2)
+    (test1 (max -1.5 (bignum -1/2)) -1/2)
+    (test1 (max (bignum -1.5) (bignum -1/2)) -1/2))
+  (test1 (max -1.5 1.5) 1.5)
+  (when with-bignums
+    (test1 (max (bignum -1.5) 1.5) 1.5)
+    (test1 (max -1.5 (bignum 1.5)) 1.5)
+    (test1 (max (bignum -1.5) (bignum 1.5)) 1.5))
+  (test1 (max -1.5 -1.5) -1.5)
+  (when with-bignums
+    (test1 (max (bignum -1.5) -1.5) -1.5)
+    (test1 (max -1.5 (bignum -1.5)) -1.5)
+    (test1 (max (bignum -1.5) (bignum -1.5)) -1.5))
+  (test1 (max -1.5 m1) 3)
+  (test1 (max m1 1) 3)
+  (test1 (max m1 -1) 3)
+  (test1 (max m1 1/2) 3)
+  (test1 (max m1 -1/2) 3)
+  (test1 (max m1 1.5) 3)
+  (test1 (max m1 -1.5) 3)
+  (test1 (max m1 m1) 3)
+
+  ;; coverage tests for /
+  (define-macro (test2 expr res)
+    `(let ((val (catch #t (lambda () ,expr) (lambda (type info) 'error))))
+       (unless (equivalent? val ,res)
+	 (format *stderr* "~S -> ~S (~S)?~%" ',expr val (magnitude (- val ,res))))))
+
+  (define old-eps (*s7* 'equivalent-float-epsilon))
+  (set! (*s7* 'equivalent-float-epsilon) 1e-12)
+
+  (test (/ 1 1) 1)
+  (when with-bignums
+    (test (/ (bignum 1) 1) 1)
+    (test (/ 1 (bignum 1)) 1)
+    (test (/ (bignum 1) (bignum 1)) 1))
+  (test (/ 1 -1) -1)
+  (when with-bignums
+    (test (/ (bignum 1) -1) -1)
+    (test (/ 1 (bignum -1)) -1)
+    (test (/ (bignum 1) (bignum -1)) -1))
+  (test (/ 1 1/2) 2)
+  (when with-bignums
+    (test (/ (bignum 1) 1/2) 2)
+    (test (/ 1 (bignum 1/2)) 2)
+    (test (/ (bignum 1) (bignum 1/2)) 2))
+  (test (/ 1 -1/2) -2)
+  (when with-bignums
+    (test (/ (bignum 1) -1/2) -2)
+    (test (/ 1 (bignum -1/2)) -2)
+    (test (/ (bignum 1) (bignum -1/2)) -2))
+  (test2 (/ 1 1.5) 0.6666666666666666)
+  (when with-bignums
+    (test2 (/ (bignum 1) 1.5) 0.6666666666666666)
+    (test2 (/ 1 (bignum 1.5)) 0.6666666666666666)
+    (test2 (/ (bignum 1) (bignum 1.5)) 0.6666666666666666))
+  (test2 (/ 1 -1.5) -0.6666666666666666)
+  (when with-bignums
+    (test2 (/ (bignum 1) -1.5) -0.6666666666666666)
+    (test2 (/ 1 (bignum -1.5)) -0.6666666666666666)
+    (test2 (/ (bignum 1) (bignum -1.5)) -0.6666666666666666))
+  (test (/ 1 1.0+1.0i) 0.5-0.5i)
+  (when with-bignums
+    (test (/ (bignum 1) 1.0+1.0i) 0.5-0.5i)
+    (test (/ 1 (bignum 1.0+1.0i)) 0.5-0.5i)
+    (test (/ (bignum 1) (bignum 1.0+1.0i)) 0.5-0.5i))
+  (test (/ 1 1.0-1.0i) 0.5+0.5i)
+  (when with-bignums
+    (test (/ (bignum 1) 1.0-1.0i) 0.5+0.5i)
+    (test (/ 1 (bignum 1.0-1.0i)) 0.5+0.5i)
+    (test (/ (bignum 1) (bignum 1.0-1.0i)) 0.5+0.5i))
+  (test (/ 1 m1) 1/3)
+  (test (/ -1 1) -1)
+  (when with-bignums
+    (test (/ (bignum -1) 1) -1)
+    (test (/ -1 (bignum 1)) -1)
+    (test (/ (bignum -1) (bignum 1)) -1))
+  (test (/ -1 -1) 1)
+  (when with-bignums
+    (test (/ (bignum -1) -1) 1)
+    (test (/ -1 (bignum -1)) 1)
+    (test (/ (bignum -1) (bignum -1)) 1))
+  (test (/ -1 1/2) -2)
+  (when with-bignums
+    (test (/ (bignum -1) 1/2) -2)
+    (test (/ -1 (bignum 1/2)) -2)
+    (test (/ (bignum -1) (bignum 1/2)) -2))
+  (test (/ -1 -1/2) 2)
+  (when with-bignums
+    (test (/ (bignum -1) -1/2) 2)
+    (test (/ -1 (bignum -1/2)) 2)
+    (test (/ (bignum -1) (bignum -1/2)) 2))
+  (test2 (/ -1 1.5) -0.6666666666666666)
+  (when with-bignums
+    (test2 (/ (bignum -1) 1.5) -0.6666666666666666)
+    (test2 (/ -1 (bignum 1.5)) -0.6666666666666666)
+    (test2 (/ (bignum -1) (bignum 1.5)) -0.6666666666666666))
+  (test2 (/ -1 -1.5) 0.6666666666666666)
+  (when with-bignums
+    (test2 (/ (bignum -1) -1.5) 0.6666666666666666)
+    (test2 (/ -1 (bignum -1.5)) 0.6666666666666666)
+    (test2 (/ (bignum -1) (bignum -1.5)) 0.6666666666666666))
+  (test (/ -1 1.0+1.0i) -0.5+0.5i)
+  (when with-bignums
+    (test (/ (bignum -1) 1.0+1.0i) -0.5+0.5i)
+    (test (/ -1 (bignum 1.0+1.0i)) -0.5+0.5i)
+    (test (/ (bignum -1) (bignum 1.0+1.0i)) -0.5+0.5i))
+  (test (/ -1 1.0-1.0i) -0.5-0.5i)
+  (when with-bignums
+    (test (/ (bignum -1) 1.0-1.0i) -0.5-0.5i)
+    (test (/ -1 (bignum 1.0-1.0i)) -0.5-0.5i)
+    (test (/ (bignum -1) (bignum 1.0-1.0i)) -0.5-0.5i))
+  (test (/ -1 m1) -1/3)
+  (test (/ 1/2 1) 1/2)
+  (when with-bignums
+    (test (/ (bignum 1/2) 1) 1/2)
+    (test (/ 1/2 (bignum 1)) 1/2)
+    (test (/ (bignum 1/2) (bignum 1)) 1/2))
+  (test (/ 1/2 -1) -1/2)
+  (when with-bignums
+    (test (/ (bignum 1/2) -1) -1/2)
+    (test (/ 1/2 (bignum -1)) -1/2)
+    (test (/ (bignum 1/2) (bignum -1)) -1/2))
+  (test (/ 1/2 1/2) 1)
+  (when with-bignums
+    (test (/ (bignum 1/2) 1/2) 1)
+    (test (/ 1/2 (bignum 1/2)) 1)
+    (test (/ (bignum 1/2) (bignum 1/2)) 1))
+  (test (/ 1/2 -1/2) -1)
+  (when with-bignums
+    (test (/ (bignum 1/2) -1/2) -1)
+    (test (/ 1/2 (bignum -1/2)) -1)
+    (test (/ (bignum 1/2) (bignum -1/2)) -1))
+  (test2 (/ 1/2 1.5) 0.3333333333333333)
+  (when with-bignums
+    (test2 (/ (bignum 1/2) 1.5) 0.3333333333333333)
+    (test2 (/ 1/2 (bignum 1.5)) 0.3333333333333333)
+    (test2 (/ (bignum 1/2) (bignum 1.5)) 0.3333333333333333))
+  (test2 (/ 1/2 -1.5) -0.3333333333333333)
+  (when with-bignums
+    (test2 (/ (bignum 1/2) -1.5) -0.3333333333333333)
+    (test2 (/ 1/2 (bignum -1.5)) -0.3333333333333333)
+    (test2 (/ (bignum 1/2) (bignum -1.5)) -0.3333333333333333))
+  (test (/ 1/2 1.0+1.0i) 0.25-0.25i)
+  (when with-bignums
+    (test (/ (bignum 1/2) 1.0+1.0i) 0.25-0.25i)
+    (test (/ 1/2 (bignum 1.0+1.0i)) 0.25-0.25i)
+    (test (/ (bignum 1/2) (bignum 1.0+1.0i)) 0.25-0.25i))
+  (test (/ 1/2 1.0-1.0i) 0.25+0.25i)
+  (when with-bignums
+    (test (/ (bignum 1/2) 1.0-1.0i) 0.25+0.25i)
+    (test (/ 1/2 (bignum 1.0-1.0i)) 0.25+0.25i)
+    (test (/ (bignum 1/2) (bignum 1.0-1.0i)) 0.25+0.25i))
+  (test (/ 1/2 m1) 1/6)
+  (test (/ -1/2 1) -1/2)
+  (when with-bignums
+    (test (/ (bignum -1/2) 1) -1/2)
+    (test (/ -1/2 (bignum 1)) -1/2)
+    (test (/ (bignum -1/2) (bignum 1)) -1/2))
+  (test (/ -1/2 -1) 1/2)
+  (when with-bignums
+    (test (/ (bignum -1/2) -1) 1/2)
+    (test (/ -1/2 (bignum -1)) 1/2)
+    (test (/ (bignum -1/2) (bignum -1)) 1/2))
+  (test (/ -1/2 1/2) -1)
+  (when with-bignums
+    (test (/ (bignum -1/2) 1/2) -1)
+    (test (/ -1/2 (bignum 1/2)) -1)
+    (test (/ (bignum -1/2) (bignum 1/2)) -1))
+  (test (/ -1/2 -1/2) 1)
+  (when with-bignums
+    (test (/ (bignum -1/2) -1/2) 1)
+    (test (/ -1/2 (bignum -1/2)) 1)
+    (test (/ (bignum -1/2) (bignum -1/2)) 1))
+  (test2 (/ -1/2 1.5) -0.3333333333333333)
+  (when with-bignums
+    (test2 (/ (bignum -1/2) 1.5) -0.3333333333333333)
+    (test2 (/ -1/2 (bignum 1.5)) -0.3333333333333333)
+    (test2 (/ (bignum -1/2) (bignum 1.5)) -0.3333333333333333))
+  (test2 (/ -1/2 -1.5) 0.3333333333333333)
+  (when with-bignums
+    (test2 (/ (bignum -1/2) -1.5) 0.3333333333333333)
+    (test2 (/ -1/2 (bignum -1.5)) 0.3333333333333333)
+    (test2 (/ (bignum -1/2) (bignum -1.5)) 0.3333333333333333))
+  (test (/ -1/2 1.0+1.0i) -0.25+0.25i)
+  (when with-bignums
+    (test (/ (bignum -1/2) 1.0+1.0i) -0.25+0.25i)
+    (test (/ -1/2 (bignum 1.0+1.0i)) -0.25+0.25i)
+    (test (/ (bignum -1/2) (bignum 1.0+1.0i)) -0.25+0.25i))
+  (test (/ -1/2 1.0-1.0i) -0.25-0.25i)
+  (when with-bignums
+    (test (/ (bignum -1/2) 1.0-1.0i) -0.25-0.25i)
+    (test (/ -1/2 (bignum 1.0-1.0i)) -0.25-0.25i)
+    (test (/ (bignum -1/2) (bignum 1.0-1.0i)) -0.25-0.25i))
+  (test (/ -1/2 m1) -1/6)
+  (test (/ 1.5 1) 1.5)
+  (when with-bignums
+    (test (/ (bignum 1.5) 1) 1.5)
+    (test (/ 1.5 (bignum 1)) 1.5)
+    (test (/ (bignum 1.5) (bignum 1)) 1.5))
+  (test (/ 1.5 -1) -1.5)
+  (when with-bignums
+    (test (/ (bignum 1.5) -1) -1.5)
+    (test (/ 1.5 (bignum -1)) -1.5)
+    (test (/ (bignum 1.5) (bignum -1)) -1.5))
+  (test (/ 1.5 1/2) 3.0)
+  (when with-bignums
+    (test (/ (bignum 1.5) 1/2) 3.0)
+    (test (/ 1.5 (bignum 1/2)) 3.0)
+    (test (/ (bignum 1.5) (bignum 1/2)) 3.0))
+  (test (/ 1.5 -1/2) -3.0)
+  (when with-bignums
+    (test (/ (bignum 1.5) -1/2) -3.0)
+    (test (/ 1.5 (bignum -1/2)) -3.0)
+    (test (/ (bignum 1.5) (bignum -1/2)) -3.0))
+  (test (/ 1.5 1.5) 1.0)
+  (when with-bignums
+    (test (/ (bignum 1.5) 1.5) 1.0)
+    (test (/ 1.5 (bignum 1.5)) 1.0)
+    (test (/ (bignum 1.5) (bignum 1.5)) 1.0))
+  (test (/ 1.5 -1.5) -1.0)
+  (when with-bignums
+    (test (/ (bignum 1.5) -1.5) -1.0)
+    (test (/ 1.5 (bignum -1.5)) -1.0)
+    (test (/ (bignum 1.5) (bignum -1.5)) -1.0))
+  (test (/ 1.5 1.0+1.0i) 0.75-0.75i)
+  (when with-bignums
+    (test (/ (bignum 1.5) 1.0+1.0i) 0.75-0.75i)
+    (test (/ 1.5 (bignum 1.0+1.0i)) 0.75-0.75i)
+    (test (/ (bignum 1.5) (bignum 1.0+1.0i)) 0.75-0.75i))
+  (test (/ 1.5 1.0-1.0i) 0.75+0.75i)
+  (when with-bignums
+    (test (/ (bignum 1.5) 1.0-1.0i) 0.75+0.75i)
+    (test (/ 1.5 (bignum 1.0-1.0i)) 0.75+0.75i)
+    (test (/ (bignum 1.5) (bignum 1.0-1.0i)) 0.75+0.75i))
+  (test (/ 1.5 m1) 0.5)
+  (test (/ -1.5 1) -1.5)
+  (when with-bignums
+    (test (/ (bignum -1.5) 1) -1.5)
+    (test (/ -1.5 (bignum 1)) -1.5)
+    (test (/ (bignum -1.5) (bignum 1)) -1.5))
+  (test (/ -1.5 -1) 1.5)
+  (when with-bignums
+    (test (/ (bignum -1.5) -1) 1.5)
+    (test (/ -1.5 (bignum -1)) 1.5)
+    (test (/ (bignum -1.5) (bignum -1)) 1.5))
+  (test (/ -1.5 1/2) -3.0)
+  (when with-bignums
+    (test (/ (bignum -1.5) 1/2) -3.0)
+    (test (/ -1.5 (bignum 1/2)) -3.0)
+    (test (/ (bignum -1.5) (bignum 1/2)) -3.0))
+  (test (/ -1.5 -1/2) 3.0)
+  (when with-bignums
+    (test (/ (bignum -1.5) -1/2) 3.0)
+    (test (/ -1.5 (bignum -1/2)) 3.0)
+    (test (/ (bignum -1.5) (bignum -1/2)) 3.0))
+  (test (/ -1.5 1.5) -1.0)
+  (when with-bignums
+    (test (/ (bignum -1.5) 1.5) -1.0)
+    (test (/ -1.5 (bignum 1.5)) -1.0)
+    (test (/ (bignum -1.5) (bignum 1.5)) -1.0))
+  (test (/ -1.5 -1.5) 1.0)
+  (when with-bignums
+    (test (/ (bignum -1.5) -1.5) 1.0)
+    (test (/ -1.5 (bignum -1.5)) 1.0)
+    (test (/ (bignum -1.5) (bignum -1.5)) 1.0))
+  (test (/ -1.5 1.0+1.0i) -0.75+0.75i)
+  (when with-bignums
+    (test (/ (bignum -1.5) 1.0+1.0i) -0.75+0.75i)
+    (test (/ -1.5 (bignum 1.0+1.0i)) -0.75+0.75i)
+    (test (/ (bignum -1.5) (bignum 1.0+1.0i)) -0.75+0.75i))
+  (test (/ -1.5 1.0-1.0i) -0.75-0.75i)
+  (when with-bignums
+    (test (/ (bignum -1.5) 1.0-1.0i) -0.75-0.75i)
+    (test (/ -1.5 (bignum 1.0-1.0i)) -0.75-0.75i)
+    (test (/ (bignum -1.5) (bignum 1.0-1.0i)) -0.75-0.75i))
+  (test (/ -1.5 m1) -0.5)
+  (test (/ 1.0+1.0i 1) 1.0+1.0i)
+  (when with-bignums
+    (test (/ (bignum 1.0+1.0i) 1) 1.0+1.0i)
+    (test (/ 1.0+1.0i (bignum 1)) 1.0+1.0i)
+    (test (/ (bignum 1.0+1.0i) (bignum 1)) 1.0+1.0i))
+  (test (/ 1.0+1.0i -1) -1.0-1.0i)
+  (when with-bignums
+    (test (/ (bignum 1.0+1.0i) -1) -1.0-1.0i)
+    (test (/ 1.0+1.0i (bignum -1)) -1.0-1.0i)
+    (test (/ (bignum 1.0+1.0i) (bignum -1)) -1.0-1.0i))
+  (test (/ 1.0+1.0i 1/2) 2.0+2.0i)
+  (when with-bignums
+    (test (/ (bignum 1.0+1.0i) 1/2) 2.0+2.0i)
+    (test (/ 1.0+1.0i (bignum 1/2)) 2.0+2.0i)
+    (test (/ (bignum 1.0+1.0i) (bignum 1/2)) 2.0+2.0i))
+  (test (/ 1.0+1.0i -1/2) -2.0-2.0i)
+  (when with-bignums
+    (test (/ (bignum 1.0+1.0i) -1/2) -2.0-2.0i)
+    (test (/ 1.0+1.0i (bignum -1/2)) -2.0-2.0i)
+    (test (/ (bignum 1.0+1.0i) (bignum -1/2)) -2.0-2.0i))
+  (test2 (/ 1.0+1.0i 1.5) 0.6666666666666666+0.6666666666666666i)
+  (when with-bignums
+    (test2 (/ (bignum 1.0+1.0i) 1.5) 0.6666666666666666+0.6666666666666666i)
+    (test2 (/ 1.0+1.0i (bignum 1.5)) 0.6666666666666666+0.6666666666666666i)
+    (test2 (/ (bignum 1.0+1.0i) (bignum 1.5)) 0.6666666666666666+0.6666666666666666i))
+  (test2 (/ 1.0+1.0i -1.5) -0.6666666666666666-0.6666666666666666i)
+  (when with-bignums
+    (test2 (/ (bignum 1.0+1.0i) -1.5) -0.6666666666666666-0.6666666666666666i)
+    (test2 (/ 1.0+1.0i (bignum -1.5)) -0.6666666666666666-0.6666666666666666i)
+    (test2 (/ (bignum 1.0+1.0i) (bignum -1.5)) -0.6666666666666666-0.6666666666666666i))
+  (test (/ 1.0+1.0i 1.0+1.0i) 1.0)
+  (when with-bignums
+    (test (/ (bignum 1.0+1.0i) 1.0+1.0i) 1.0)
+    (test (/ 1.0+1.0i (bignum 1.0+1.0i)) 1.0)
+    (test (/ (bignum 1.0+1.0i) (bignum 1.0+1.0i)) 1.0))
+  (test (/ 1.0+1.0i 1.0-1.0i) 0.0+1.0i)
+  (when with-bignums
+    (test (/ (bignum 1.0+1.0i) 1.0-1.0i) 0.0+1.0i)
+    (test (/ 1.0+1.0i (bignum 1.0-1.0i)) 0.0+1.0i)
+    (test (/ (bignum 1.0+1.0i) (bignum 1.0-1.0i)) 0.0+1.0i))
+  (test2 (/ 1.0+1.0i m1) 0.3333333333333333+0.3333333333333333i)
+  (test (/ 1.0-1.0i 1) 1.0-1.0i)
+  (when with-bignums
+    (test (/ (bignum 1.0-1.0i) 1) 1.0-1.0i)
+    (test (/ 1.0-1.0i (bignum 1)) 1.0-1.0i)
+    (test (/ (bignum 1.0-1.0i) (bignum 1)) 1.0-1.0i))
+  (test (/ 1.0-1.0i -1) -1.0+1.0i)
+  (when with-bignums
+    (test (/ (bignum 1.0-1.0i) -1) -1.0+1.0i)
+    (test (/ 1.0-1.0i (bignum -1)) -1.0+1.0i)
+    (test (/ (bignum 1.0-1.0i) (bignum -1)) -1.0+1.0i))
+  (test (/ 1.0-1.0i 1/2) 2.0-2.0i)
+  (when with-bignums
+    (test (/ (bignum 1.0-1.0i) 1/2) 2.0-2.0i)
+    (test (/ 1.0-1.0i (bignum 1/2)) 2.0-2.0i)
+    (test (/ (bignum 1.0-1.0i) (bignum 1/2)) 2.0-2.0i))
+  (test (/ 1.0-1.0i -1/2) -2.0+2.0i)
+  (when with-bignums
+    (test (/ (bignum 1.0-1.0i) -1/2) -2.0+2.0i)
+    (test (/ 1.0-1.0i (bignum -1/2)) -2.0+2.0i)
+    (test (/ (bignum 1.0-1.0i) (bignum -1/2)) -2.0+2.0i))
+  (test2 (/ 1.0-1.0i 1.5) 0.6666666666666666-0.6666666666666666i)
+  (when with-bignums
+    (test2 (/ (bignum 1.0-1.0i) 1.5) 0.6666666666666666-0.6666666666666666i)
+    (test2 (/ 1.0-1.0i (bignum 1.5)) 0.6666666666666666-0.6666666666666666i)
+    (test2 (/ (bignum 1.0-1.0i) (bignum 1.5)) 0.6666666666666666-0.6666666666666666i))
+  (test2 (/ 1.0-1.0i -1.5) -0.6666666666666666+0.6666666666666666i)
+  (when with-bignums
+    (test2 (/ (bignum 1.0-1.0i) -1.5) -0.6666666666666666+0.6666666666666666i)
+    (test2 (/ 1.0-1.0i (bignum -1.5)) -0.6666666666666666+0.6666666666666666i)
+    (test2 (/ (bignum 1.0-1.0i) (bignum -1.5)) -0.6666666666666666+0.6666666666666666i))
+  (test (/ 1.0-1.0i 1.0+1.0i) 0.0-1.0i)
+  (when with-bignums
+    (test (/ (bignum 1.0-1.0i) 1.0+1.0i) 0.0-1.0i)
+    (test (/ 1.0-1.0i (bignum 1.0+1.0i)) 0.0-1.0i)
+    (test (/ (bignum 1.0-1.0i) (bignum 1.0+1.0i)) 0.0-1.0i))
+  (test (/ 1.0-1.0i 1.0-1.0i) 1.0)
+  (when with-bignums
+    (test (/ (bignum 1.0-1.0i) 1.0-1.0i) 1.0)
+    (test (/ 1.0-1.0i (bignum 1.0-1.0i)) 1.0)
+    (test (/ (bignum 1.0-1.0i) (bignum 1.0-1.0i)) 1.0))
+  (test2 (/ 1.0-1.0i m1) 0.3333333333333333-0.3333333333333333i)
+  (test (/ m1 1) 3)
+  (test (/ m1 -1) -3)
+  (test (/ m1 1/2) 6)
+  (test (/ m1 -1/2) -6)
+  (test (/ m1 1.5) 2.0)
+  (test (/ m1 -1.5) -2.0)
+  (test (/ m1 1.0+1.0i) 1.5-1.5i)
+  (test (/ m1 1.0-1.0i) 1.5+1.5i)
+  (test (/ m1 m1) 1)
+  (set! (*s7* 'equivalent-float-epsilon) old-eps)
+
+;; coverage tests for -
+  (test (- 1 1) 0)
+  (when with-bignums
+    (test (- (bignum 1) 1) 0)
+    (test (- 1 (bignum 1)) 0)
+    (test (- (bignum 1) (bignum 1)) 0))
+  (test (- 1 -1) 2)
+  (when with-bignums
+    (test (- (bignum 1) -1) 2)
+    (test (- 1 (bignum -1)) 2)
+    (test (- (bignum 1) (bignum -1)) 2))
+  (test (- 1 1/2) 1/2)
+  (when with-bignums
+    (test (- (bignum 1) 1/2) 1/2)
+    (test (- 1 (bignum 1/2)) 1/2)
+    (test (- (bignum 1) (bignum 1/2)) 1/2))
+  (test (- 1 -1/2) 3/2)
+  (when with-bignums
+    (test (- (bignum 1) -1/2) 3/2)
+    (test (- 1 (bignum -1/2)) 3/2)
+    (test (- (bignum 1) (bignum -1/2)) 3/2))
+  (test (- 1 1.5) -0.5)
+  (when with-bignums
+    (test (- (bignum 1) 1.5) -0.5)
+    (test (- 1 (bignum 1.5)) -0.5)
+    (test (- (bignum 1) (bignum 1.5)) -0.5))
+  (test (- 1 -1.5) 2.5)
+  (when with-bignums
+    (test (- (bignum 1) -1.5) 2.5)
+    (test (- 1 (bignum -1.5)) 2.5)
+    (test (- (bignum 1) (bignum -1.5)) 2.5))
+  (test (- 1 1.0+1.0i) 0.0-1.0i)
+  (when with-bignums
+    (test (- (bignum 1) 1.0+1.0i) 0.0-1.0i)
+    (test (- 1 (bignum 1.0+1.0i)) 0.0-1.0i)
+    (test (- (bignum 1) (bignum 1.0+1.0i)) 0.0-1.0i))
+  (test (- 1 1.0-1.0i) 0.0+1.0i)
+  (when with-bignums
+    (test (- (bignum 1) 1.0-1.0i) 0.0+1.0i)
+    (test (- 1 (bignum 1.0-1.0i)) 0.0+1.0i)
+    (test (- (bignum 1) (bignum 1.0-1.0i)) 0.0+1.0i))
+  (test (- 1 m1) -2)
+  (test2 (- 1 +nan.0) +nan.0)
+  (when with-bignums
+    (test2 (- (bignum 1) +nan.0) +nan.0)
+    (test2 (- 1 (bignum +nan.0)) +nan.0)
+    (test2 (- (bignum 1) (bignum +nan.0)) +nan.0))
+  (test (- -1 1) -2)
+  (when with-bignums
+    (test (- (bignum -1) 1) -2)
+    (test (- -1 (bignum 1)) -2)
+    (test (- (bignum -1) (bignum 1)) -2))
+  (test (- -1 -1) 0)
+  (when with-bignums
+    (test (- (bignum -1) -1) 0)
+    (test (- -1 (bignum -1)) 0)
+    (test (- (bignum -1) (bignum -1)) 0))
+  (test (- -1 1/2) -3/2)
+  (when with-bignums
+    (test (- (bignum -1) 1/2) -3/2)
+    (test (- -1 (bignum 1/2)) -3/2)
+    (test (- (bignum -1) (bignum 1/2)) -3/2))
+  (test (- -1 -1/2) -1/2)
+  (when with-bignums
+    (test (- (bignum -1) -1/2) -1/2)
+    (test (- -1 (bignum -1/2)) -1/2)
+    (test (- (bignum -1) (bignum -1/2)) -1/2))
+  (test (- -1 1.5) -2.5)
+  (when with-bignums
+    (test (- (bignum -1) 1.5) -2.5)
+    (test (- -1 (bignum 1.5)) -2.5)
+    (test (- (bignum -1) (bignum 1.5)) -2.5))
+  (test (- -1 -1.5) 0.5)
+  (when with-bignums
+    (test (- (bignum -1) -1.5) 0.5)
+    (test (- -1 (bignum -1.5)) 0.5)
+    (test (- (bignum -1) (bignum -1.5)) 0.5))
+  (test (- -1 1.0+1.0i) -2.0-1.0i)
+  (when with-bignums
+    (test (- (bignum -1) 1.0+1.0i) -2.0-1.0i)
+    (test (- -1 (bignum 1.0+1.0i)) -2.0-1.0i)
+    (test (- (bignum -1) (bignum 1.0+1.0i)) -2.0-1.0i))
+  (test (- -1 1.0-1.0i) -2.0+1.0i)
+  (when with-bignums
+    (test (- (bignum -1) 1.0-1.0i) -2.0+1.0i)
+    (test (- -1 (bignum 1.0-1.0i)) -2.0+1.0i)
+    (test (- (bignum -1) (bignum 1.0-1.0i)) -2.0+1.0i))
+  (test (- -1 m1) -4)
+  (test2 (- -1 +nan.0) +nan.0)
+  (when with-bignums
+    (test2 (- (bignum -1) +nan.0) +nan.0)
+    (test2 (- -1 (bignum +nan.0)) +nan.0)
+    (test2 (- (bignum -1) (bignum +nan.0)) +nan.0))
+  (test (- 1/2 1) -1/2)
+  (when with-bignums
+    (test (- (bignum 1/2) 1) -1/2)
+    (test (- 1/2 (bignum 1)) -1/2)
+    (test (- (bignum 1/2) (bignum 1)) -1/2))
+  (test (- 1/2 -1) 3/2)
+  (when with-bignums
+    (test (- (bignum 1/2) -1) 3/2)
+    (test (- 1/2 (bignum -1)) 3/2)
+    (test (- (bignum 1/2) (bignum -1)) 3/2))
+  (test (- 1/2 1/2) 0)
+  (when with-bignums
+    (test (- (bignum 1/2) 1/2) 0)
+    (test (- 1/2 (bignum 1/2)) 0)
+    (test (- (bignum 1/2) (bignum 1/2)) 0))
+  (test (- 1/2 -1/2) 1)
+  (when with-bignums
+    (test (- (bignum 1/2) -1/2) 1)
+    (test (- 1/2 (bignum -1/2)) 1)
+    (test (- (bignum 1/2) (bignum -1/2)) 1))
+  (test (- 1/2 1.5) -1.0)
+  (when with-bignums
+    (test (- (bignum 1/2) 1.5) -1.0)
+    (test (- 1/2 (bignum 1.5)) -1.0)
+    (test (- (bignum 1/2) (bignum 1.5)) -1.0))
+  (test (- 1/2 -1.5) 2.0)
+  (when with-bignums
+    (test (- (bignum 1/2) -1.5) 2.0)
+    (test (- 1/2 (bignum -1.5)) 2.0)
+    (test (- (bignum 1/2) (bignum -1.5)) 2.0))
+  (test (- 1/2 1.0+1.0i) -0.5-1.0i)
+  (when with-bignums
+    (test (- (bignum 1/2) 1.0+1.0i) -0.5-1.0i)
+    (test (- 1/2 (bignum 1.0+1.0i)) -0.5-1.0i)
+    (test (- (bignum 1/2) (bignum 1.0+1.0i)) -0.5-1.0i))
+  (test (- 1/2 1.0-1.0i) -0.5+1.0i)
+  (when with-bignums
+    (test (- (bignum 1/2) 1.0-1.0i) -0.5+1.0i)
+    (test (- 1/2 (bignum 1.0-1.0i)) -0.5+1.0i)
+    (test (- (bignum 1/2) (bignum 1.0-1.0i)) -0.5+1.0i))
+  (test (- 1/2 m1) -5/2)
+  (test2 (- 1/2 +nan.0) +nan.0)
+  (when with-bignums
+    (test2 (- (bignum 1/2) +nan.0) +nan.0)
+    (test2 (- 1/2 (bignum +nan.0)) +nan.0)
+    (test2 (- (bignum 1/2) (bignum +nan.0)) +nan.0))
+  (test (- -1/2 1) -3/2)
+  (when with-bignums
+    (test (- (bignum -1/2) 1) -3/2)
+    (test (- -1/2 (bignum 1)) -3/2)
+    (test (- (bignum -1/2) (bignum 1)) -3/2))
+  (test (- -1/2 -1) 1/2)
+  (when with-bignums
+    (test (- (bignum -1/2) -1) 1/2)
+    (test (- -1/2 (bignum -1)) 1/2)
+    (test (- (bignum -1/2) (bignum -1)) 1/2))
+  (test (- -1/2 1/2) -1)
+  (when with-bignums
+    (test (- (bignum -1/2) 1/2) -1)
+    (test (- -1/2 (bignum 1/2)) -1)
+    (test (- (bignum -1/2) (bignum 1/2)) -1))
+  (test (- -1/2 -1/2) 0)
+  (when with-bignums
+    (test (- (bignum -1/2) -1/2) 0)
+    (test (- -1/2 (bignum -1/2)) 0)
+    (test (- (bignum -1/2) (bignum -1/2)) 0))
+  (test (- -1/2 1.5) -2.0)
+  (when with-bignums
+    (test (- (bignum -1/2) 1.5) -2.0)
+    (test (- -1/2 (bignum 1.5)) -2.0)
+    (test (- (bignum -1/2) (bignum 1.5)) -2.0))
+  (test (- -1/2 -1.5) 1.0)
+  (when with-bignums
+    (test (- (bignum -1/2) -1.5) 1.0)
+    (test (- -1/2 (bignum -1.5)) 1.0)
+    (test (- (bignum -1/2) (bignum -1.5)) 1.0))
+  (test (- -1/2 1.0+1.0i) -1.5-1.0i)
+  (when with-bignums
+    (test (- (bignum -1/2) 1.0+1.0i) -1.5-1.0i)
+    (test (- -1/2 (bignum 1.0+1.0i)) -1.5-1.0i)
+    (test (- (bignum -1/2) (bignum 1.0+1.0i)) -1.5-1.0i))
+  (test (- -1/2 1.0-1.0i) -1.5+1.0i)
+  (when with-bignums
+    (test (- (bignum -1/2) 1.0-1.0i) -1.5+1.0i)
+    (test (- -1/2 (bignum 1.0-1.0i)) -1.5+1.0i)
+    (test (- (bignum -1/2) (bignum 1.0-1.0i)) -1.5+1.0i))
+  (test (- -1/2 m1) -7/2)
+  (test2 (- -1/2 +nan.0) +nan.0)
+  (when with-bignums
+    (test2 (- (bignum -1/2) +nan.0) +nan.0)
+    (test2 (- -1/2 (bignum +nan.0)) +nan.0)
+    (test2 (- (bignum -1/2) (bignum +nan.0)) +nan.0))
+  (test (- 1.5 1) 0.5)
+  (when with-bignums
+    (test (- (bignum 1.5) 1) 0.5)
+    (test (- 1.5 (bignum 1)) 0.5)
+    (test (- (bignum 1.5) (bignum 1)) 0.5))
+  (test (- 1.5 -1) 2.5)
+  (when with-bignums
+    (test (- (bignum 1.5) -1) 2.5)
+    (test (- 1.5 (bignum -1)) 2.5)
+    (test (- (bignum 1.5) (bignum -1)) 2.5))
+  (test (- 1.5 1/2) 1.0)
+  (when with-bignums
+    (test (- (bignum 1.5) 1/2) 1.0)
+    (test (- 1.5 (bignum 1/2)) 1.0)
+    (test (- (bignum 1.5) (bignum 1/2)) 1.0))
+  (test (- 1.5 -1/2) 2.0)
+  (when with-bignums
+    (test (- (bignum 1.5) -1/2) 2.0)
+    (test (- 1.5 (bignum -1/2)) 2.0)
+    (test (- (bignum 1.5) (bignum -1/2)) 2.0))
+  (test (- 1.5 1.5) 0.0)
+  (when with-bignums
+    (test (- (bignum 1.5) 1.5) 0.0)
+    (test (- 1.5 (bignum 1.5)) 0.0)
+    (test (- (bignum 1.5) (bignum 1.5)) 0.0))
+  (test (- 1.5 -1.5) 3.0)
+  (when with-bignums
+    (test (- (bignum 1.5) -1.5) 3.0)
+    (test (- 1.5 (bignum -1.5)) 3.0)
+    (test (- (bignum 1.5) (bignum -1.5)) 3.0))
+  (test (- 1.5 1.0+1.0i) 0.5-1.0i)
+  (when with-bignums
+    (test (- (bignum 1.5) 1.0+1.0i) 0.5-1.0i)
+    (test (- 1.5 (bignum 1.0+1.0i)) 0.5-1.0i)
+    (test (- (bignum 1.5) (bignum 1.0+1.0i)) 0.5-1.0i))
+  (test (- 1.5 1.0-1.0i) 0.5+1.0i)
+  (when with-bignums
+    (test (- (bignum 1.5) 1.0-1.0i) 0.5+1.0i)
+    (test (- 1.5 (bignum 1.0-1.0i)) 0.5+1.0i)
+    (test (- (bignum 1.5) (bignum 1.0-1.0i)) 0.5+1.0i))
+  (test (- 1.5 m1) -1.5)
+  (test2 (- 1.5 +nan.0) +nan.0)
+  (when with-bignums
+    (test2 (- (bignum 1.5) +nan.0) +nan.0)
+    (test2 (- 1.5 (bignum +nan.0)) +nan.0)
+    (test2 (- (bignum 1.5) (bignum +nan.0)) +nan.0))
+  (test (- -1.5 1) -2.5)
+  (when with-bignums
+    (test (- (bignum -1.5) 1) -2.5)
+    (test (- -1.5 (bignum 1)) -2.5)
+    (test (- (bignum -1.5) (bignum 1)) -2.5))
+  (test (- -1.5 -1) -0.5)
+  (when with-bignums
+    (test (- (bignum -1.5) -1) -0.5)
+    (test (- -1.5 (bignum -1)) -0.5)
+    (test (- (bignum -1.5) (bignum -1)) -0.5))
+  (test (- -1.5 1/2) -2.0)
+  (when with-bignums
+    (test (- (bignum -1.5) 1/2) -2.0)
+    (test (- -1.5 (bignum 1/2)) -2.0)
+    (test (- (bignum -1.5) (bignum 1/2)) -2.0))
+  (test (- -1.5 -1/2) -1.0)
+  (when with-bignums
+    (test (- (bignum -1.5) -1/2) -1.0)
+    (test (- -1.5 (bignum -1/2)) -1.0)
+    (test (- (bignum -1.5) (bignum -1/2)) -1.0))
+  (test (- -1.5 1.5) -3.0)
+  (when with-bignums
+    (test (- (bignum -1.5) 1.5) -3.0)
+    (test (- -1.5 (bignum 1.5)) -3.0)
+    (test (- (bignum -1.5) (bignum 1.5)) -3.0))
+  (test (- -1.5 -1.5) 0.0)
+  (when with-bignums
+    (test (- (bignum -1.5) -1.5) 0.0)
+    (test (- -1.5 (bignum -1.5)) 0.0)
+    (test (- (bignum -1.5) (bignum -1.5)) 0.0))
+  (test (- -1.5 1.0+1.0i) -2.5-1.0i)
+  (when with-bignums
+    (test (- (bignum -1.5) 1.0+1.0i) -2.5-1.0i)
+    (test (- -1.5 (bignum 1.0+1.0i)) -2.5-1.0i)
+    (test (- (bignum -1.5) (bignum 1.0+1.0i)) -2.5-1.0i))
+  (test (- -1.5 1.0-1.0i) -2.5+1.0i)
+  (when with-bignums
+    (test (- (bignum -1.5) 1.0-1.0i) -2.5+1.0i)
+    (test (- -1.5 (bignum 1.0-1.0i)) -2.5+1.0i)
+    (test (- (bignum -1.5) (bignum 1.0-1.0i)) -2.5+1.0i))
+  (test (- -1.5 m1) -4.5)
+  (test2 (- -1.5 +nan.0) +nan.0)
+  (when with-bignums
+    (test2 (- (bignum -1.5) +nan.0) +nan.0)
+    (test2 (- -1.5 (bignum +nan.0)) +nan.0)
+    (test2 (- (bignum -1.5) (bignum +nan.0)) +nan.0))
+  (test (- m1 1) 2)
+  (test (- m1 -1) 4)
+  (test (- m1 1/2) 5/2)
+  (test (- m1 -1/2) 7/2)
+  (test (- m1 1.5) 1.5)
+  (test (- m1 -1.5) 4.5)
+  (test (- m1 1.0+1.0i) 2.0-1.0i)
+  (test (- m1 1.0-1.0i) 2.0+1.0i)
+  (test (- m1 m1) 0)
+  (test2 (- m1 +nan.0) +nan.0)
+  (test2 (- +nan.0 1) +nan.0)
+  (when with-bignums
+    (test2 (- (bignum +nan.0) 1) +nan.0)
+    (test2 (- +nan.0 (bignum 1)) +nan.0)
+    (test2 (- (bignum +nan.0) (bignum 1)) +nan.0))
+  (test2 (- +nan.0 -1) +nan.0)
+  (when with-bignums
+    (test2 (- (bignum +nan.0) -1) +nan.0)
+    (test2 (- +nan.0 (bignum -1)) +nan.0)
+    (test2 (- (bignum +nan.0) (bignum -1)) +nan.0))
+  (test2 (- +nan.0 1/2) +nan.0)
+  (when with-bignums
+    (test2 (- (bignum +nan.0) 1/2) +nan.0)
+    (test2 (- +nan.0 (bignum 1/2)) +nan.0)
+    (test2 (- (bignum +nan.0) (bignum 1/2)) +nan.0))
+  (test2 (- +nan.0 -1/2) +nan.0)
+  (when with-bignums
+    (test2 (- (bignum +nan.0) -1/2) +nan.0)
+    (test2 (- +nan.0 (bignum -1/2)) +nan.0)
+    (test2 (- (bignum +nan.0) (bignum -1/2)) +nan.0))
+  (test2 (- +nan.0 1.5) +nan.0)
+  (when with-bignums
+    (test2 (- (bignum +nan.0) 1.5) +nan.0)
+    (test2 (- +nan.0 (bignum 1.5)) +nan.0)
+    (test2 (- (bignum +nan.0) (bignum 1.5)) +nan.0))
+  (test2 (- +nan.0 -1.5) +nan.0)
+  (when with-bignums
+    (test2 (- (bignum +nan.0) -1.5) +nan.0)
+    (test2 (- +nan.0 (bignum -1.5)) +nan.0)
+    (test2 (- (bignum +nan.0) (bignum -1.5)) +nan.0))
+  (test2 (- +nan.0 1.0+1.0i) +nan.0-1.0i)
+  (when with-bignums
+    (test2 (- (bignum +nan.0) 1.0+1.0i) +nan.0-1.0i)
+    (test2 (- +nan.0 (bignum 1.0+1.0i)) +nan.0-1.0i)
+    (test2 (- (bignum +nan.0) (bignum 1.0+1.0i)) +nan.0-1.0i))
+  (test2 (- +nan.0 1.0-1.0i) +nan.0+1.0i)
+  (when with-bignums
+    (test2 (- (bignum +nan.0) 1.0-1.0i) +nan.0+1.0i)
+    (test2 (- +nan.0 (bignum 1.0-1.0i)) +nan.0+1.0i)
+    (test2 (- (bignum +nan.0) (bignum 1.0-1.0i)) +nan.0+1.0i))
+  (test2 (- +nan.0 m1) +nan.0)
+  (test2 (- +nan.0 +nan.0) +nan.0)
+  (when with-bignums
+    (test2 (- (bignum +nan.0) +nan.0) +nan.0)
+    (test2 (- +nan.0 (bignum +nan.0)) +nan.0)
+    (test2 (- (bignum +nan.0) (bignum +nan.0)) +nan.0))
+
+  ;; coverage tests for +
+  (test (+ 1 1) 2)
+  (when with-bignums
+    (test (+ (bignum 1) 1) 2)
+    (test (+ 1 (bignum 1)) 2)
+    (test (+ (bignum 1) (bignum 1)) 2))
+  (test (+ 1 -1) 0)
+  (when with-bignums
+    (test (+ (bignum 1) -1) 0)
+    (test (+ 1 (bignum -1)) 0)
+    (test (+ (bignum 1) (bignum -1)) 0))
+  (test (+ 1 1/2) 3/2)
+  (when with-bignums
+    (test (+ (bignum 1) 1/2) 3/2)
+    (test (+ 1 (bignum 1/2)) 3/2)
+    (test (+ (bignum 1) (bignum 1/2)) 3/2))
+  (test (+ 1 -1/2) 1/2)
+  (when with-bignums
+    (test (+ (bignum 1) -1/2) 1/2)
+    (test (+ 1 (bignum -1/2)) 1/2)
+    (test (+ (bignum 1) (bignum -1/2)) 1/2))
+  (test (+ 1 1.5) 2.5)
+  (when with-bignums
+    (test (+ (bignum 1) 1.5) 2.5)
+    (test (+ 1 (bignum 1.5)) 2.5)
+    (test (+ (bignum 1) (bignum 1.5)) 2.5))
+  (test (+ 1 -1.5) -0.5)
+  (when with-bignums
+    (test (+ (bignum 1) -1.5) -0.5)
+    (test (+ 1 (bignum -1.5)) -0.5)
+    (test (+ (bignum 1) (bignum -1.5)) -0.5))
+  (test (+ 1 1.0+1.0i) 2.0+1.0i)
+  (when with-bignums
+    (test (+ (bignum 1) 1.0+1.0i) 2.0+1.0i)
+    (test (+ 1 (bignum 1.0+1.0i)) 2.0+1.0i)
+    (test (+ (bignum 1) (bignum 1.0+1.0i)) 2.0+1.0i))
+  (test (+ 1 1.0-1.0i) 2.0-1.0i)
+  (when with-bignums
+    (test (+ (bignum 1) 1.0-1.0i) 2.0-1.0i)
+    (test (+ 1 (bignum 1.0-1.0i)) 2.0-1.0i)
+    (test (+ (bignum 1) (bignum 1.0-1.0i)) 2.0-1.0i))
+  (test (+ 1 m1) 4)
+  (test2 (+ 1 +nan.0) +nan.0)
+  (when with-bignums
+    (test2 (+ (bignum 1) +nan.0) +nan.0)
+    (test2 (+ 1 (bignum +nan.0)) +nan.0)
+    (test2 (+ (bignum 1) (bignum +nan.0)) +nan.0))
+  (test (+ -1 1) 0)
+  (when with-bignums
+    (test (+ (bignum -1) 1) 0)
+    (test (+ -1 (bignum 1)) 0)
+    (test (+ (bignum -1) (bignum 1)) 0))
+  (test (+ -1 -1) -2)
+  (when with-bignums
+    (test (+ (bignum -1) -1) -2)
+    (test (+ -1 (bignum -1)) -2)
+    (test (+ (bignum -1) (bignum -1)) -2))
+  (test (+ -1 1/2) -1/2)
+  (when with-bignums
+    (test (+ (bignum -1) 1/2) -1/2)
+    (test (+ -1 (bignum 1/2)) -1/2)
+    (test (+ (bignum -1) (bignum 1/2)) -1/2))
+  (test (+ -1 -1/2) -3/2)
+  (when with-bignums
+    (test (+ (bignum -1) -1/2) -3/2)
+    (test (+ -1 (bignum -1/2)) -3/2)
+    (test (+ (bignum -1) (bignum -1/2)) -3/2))
+  (test (+ -1 1.5) 0.5)
+  (when with-bignums
+    (test (+ (bignum -1) 1.5) 0.5)
+    (test (+ -1 (bignum 1.5)) 0.5)
+    (test (+ (bignum -1) (bignum 1.5)) 0.5))
+  (test (+ -1 -1.5) -2.5)
+  (when with-bignums
+    (test (+ (bignum -1) -1.5) -2.5)
+    (test (+ -1 (bignum -1.5)) -2.5)
+    (test (+ (bignum -1) (bignum -1.5)) -2.5))
+  (test (+ -1 1.0+1.0i) 0.0+1.0i)
+  (when with-bignums
+    (test (+ (bignum -1) 1.0+1.0i) 0.0+1.0i)
+    (test (+ -1 (bignum 1.0+1.0i)) 0.0+1.0i)
+    (test (+ (bignum -1) (bignum 1.0+1.0i)) 0.0+1.0i))
+  (test (+ -1 1.0-1.0i) 0.0-1.0i)
+  (when with-bignums
+    (test (+ (bignum -1) 1.0-1.0i) 0.0-1.0i)
+    (test (+ -1 (bignum 1.0-1.0i)) 0.0-1.0i)
+    (test (+ (bignum -1) (bignum 1.0-1.0i)) 0.0-1.0i))
+  (test (+ -1 m1) 2)
+  (test2 (+ -1 +nan.0) +nan.0)
+  (when with-bignums
+    (test2 (+ (bignum -1) +nan.0) +nan.0)
+    (test2 (+ -1 (bignum +nan.0)) +nan.0)
+    (test2 (+ (bignum -1) (bignum +nan.0)) +nan.0))
+  (test (+ 1/2 1) 3/2)
+  (when with-bignums
+    (test (+ (bignum 1/2) 1) 3/2)
+    (test (+ 1/2 (bignum 1)) 3/2)
+    (test (+ (bignum 1/2) (bignum 1)) 3/2))
+  (test (+ 1/2 -1) -1/2)
+  (when with-bignums
+    (test (+ (bignum 1/2) -1) -1/2)
+    (test (+ 1/2 (bignum -1)) -1/2)
+    (test (+ (bignum 1/2) (bignum -1)) -1/2))
+  (test (+ 1/2 1/2) 1)
+  (when with-bignums
+    (test (+ (bignum 1/2) 1/2) 1)
+    (test (+ 1/2 (bignum 1/2)) 1)
+    (test (+ (bignum 1/2) (bignum 1/2)) 1))
+  (test (+ 1/2 -1/2) 0)
+  (when with-bignums
+    (test (+ (bignum 1/2) -1/2) 0)
+    (test (+ 1/2 (bignum -1/2)) 0)
+    (test (+ (bignum 1/2) (bignum -1/2)) 0))
+  (test (+ 1/2 1.5) 2.0)
+  (when with-bignums
+    (test (+ (bignum 1/2) 1.5) 2.0)
+    (test (+ 1/2 (bignum 1.5)) 2.0)
+    (test (+ (bignum 1/2) (bignum 1.5)) 2.0))
+  (test (+ 1/2 -1.5) -1.0)
+  (when with-bignums
+    (test (+ (bignum 1/2) -1.5) -1.0)
+    (test (+ 1/2 (bignum -1.5)) -1.0)
+    (test (+ (bignum 1/2) (bignum -1.5)) -1.0))
+  (test (+ 1/2 1.0+1.0i) 1.5+1.0i)
+  (when with-bignums
+    (test (+ (bignum 1/2) 1.0+1.0i) 1.5+1.0i)
+    (test (+ 1/2 (bignum 1.0+1.0i)) 1.5+1.0i)
+    (test (+ (bignum 1/2) (bignum 1.0+1.0i)) 1.5+1.0i))
+  (test (+ 1/2 1.0-1.0i) 1.5-1.0i)
+  (when with-bignums
+    (test (+ (bignum 1/2) 1.0-1.0i) 1.5-1.0i)
+    (test (+ 1/2 (bignum 1.0-1.0i)) 1.5-1.0i)
+    (test (+ (bignum 1/2) (bignum 1.0-1.0i)) 1.5-1.0i))
+  (test (+ 1/2 m1) 7/2)
+  (test2 (+ 1/2 +nan.0) +nan.0)
+  (when with-bignums
+    (test2 (+ (bignum 1/2) +nan.0) +nan.0)
+    (test2 (+ 1/2 (bignum +nan.0)) +nan.0)
+    (test2 (+ (bignum 1/2) (bignum +nan.0)) +nan.0))
+  (test (+ -1/2 1) 1/2)
+  (when with-bignums
+    (test (+ (bignum -1/2) 1) 1/2)
+    (test (+ -1/2 (bignum 1)) 1/2)
+    (test (+ (bignum -1/2) (bignum 1)) 1/2))
+  (test (+ -1/2 -1) -3/2)
+  (when with-bignums
+    (test (+ (bignum -1/2) -1) -3/2)
+    (test (+ -1/2 (bignum -1)) -3/2)
+    (test (+ (bignum -1/2) (bignum -1)) -3/2))
+  (test (+ -1/2 1/2) 0)
+  (when with-bignums
+    (test (+ (bignum -1/2) 1/2) 0)
+    (test (+ -1/2 (bignum 1/2)) 0)
+    (test (+ (bignum -1/2) (bignum 1/2)) 0))
+  (test (+ -1/2 -1/2) -1)
+  (when with-bignums
+    (test (+ (bignum -1/2) -1/2) -1)
+    (test (+ -1/2 (bignum -1/2)) -1)
+    (test (+ (bignum -1/2) (bignum -1/2)) -1))
+  (test (+ -1/2 1.5) 1.0)
+  (when with-bignums
+    (test (+ (bignum -1/2) 1.5) 1.0)
+    (test (+ -1/2 (bignum 1.5)) 1.0)
+    (test (+ (bignum -1/2) (bignum 1.5)) 1.0))
+  (test (+ -1/2 -1.5) -2.0)
+  (when with-bignums
+    (test (+ (bignum -1/2) -1.5) -2.0)
+    (test (+ -1/2 (bignum -1.5)) -2.0)
+    (test (+ (bignum -1/2) (bignum -1.5)) -2.0))
+  (test (+ -1/2 1.0+1.0i) 0.5+1.0i)
+  (when with-bignums
+    (test (+ (bignum -1/2) 1.0+1.0i) 0.5+1.0i)
+    (test (+ -1/2 (bignum 1.0+1.0i)) 0.5+1.0i)
+    (test (+ (bignum -1/2) (bignum 1.0+1.0i)) 0.5+1.0i))
+  (test (+ -1/2 1.0-1.0i) 0.5-1.0i)
+  (when with-bignums
+    (test (+ (bignum -1/2) 1.0-1.0i) 0.5-1.0i)
+    (test (+ -1/2 (bignum 1.0-1.0i)) 0.5-1.0i)
+    (test (+ (bignum -1/2) (bignum 1.0-1.0i)) 0.5-1.0i))
+  (test (+ -1/2 m1) 5/2)
+  (test2 (+ -1/2 +nan.0) +nan.0)
+  (when with-bignums
+    (test2 (+ (bignum -1/2) +nan.0) +nan.0)
+    (test2 (+ -1/2 (bignum +nan.0)) +nan.0)
+    (test2 (+ (bignum -1/2) (bignum +nan.0)) +nan.0))
+  (test (+ 1.5 1) 2.5)
+  (when with-bignums
+    (test (+ (bignum 1.5) 1) 2.5)
+    (test (+ 1.5 (bignum 1)) 2.5)
+    (test (+ (bignum 1.5) (bignum 1)) 2.5))
+  (test (+ 1.5 -1) 0.5)
+  (when with-bignums
+    (test (+ (bignum 1.5) -1) 0.5)
+    (test (+ 1.5 (bignum -1)) 0.5)
+    (test (+ (bignum 1.5) (bignum -1)) 0.5))
+  (test (+ 1.5 1/2) 2.0)
+  (when with-bignums
+    (test (+ (bignum 1.5) 1/2) 2.0)
+    (test (+ 1.5 (bignum 1/2)) 2.0)
+    (test (+ (bignum 1.5) (bignum 1/2)) 2.0))
+  (test (+ 1.5 -1/2) 1.0)
+  (when with-bignums
+    (test (+ (bignum 1.5) -1/2) 1.0)
+    (test (+ 1.5 (bignum -1/2)) 1.0)
+    (test (+ (bignum 1.5) (bignum -1/2)) 1.0))
+  (test (+ 1.5 1.5) 3.0)
+  (when with-bignums
+    (test (+ (bignum 1.5) 1.5) 3.0)
+    (test (+ 1.5 (bignum 1.5)) 3.0)
+    (test (+ (bignum 1.5) (bignum 1.5)) 3.0))
+  (test (+ 1.5 -1.5) 0.0)
+  (when with-bignums
+    (test (+ (bignum 1.5) -1.5) 0.0)
+    (test (+ 1.5 (bignum -1.5)) 0.0)
+    (test (+ (bignum 1.5) (bignum -1.5)) 0.0))
+  (test (+ 1.5 1.0+1.0i) 2.5+1.0i)
+  (when with-bignums
+    (test (+ (bignum 1.5) 1.0+1.0i) 2.5+1.0i)
+    (test (+ 1.5 (bignum 1.0+1.0i)) 2.5+1.0i)
+    (test (+ (bignum 1.5) (bignum 1.0+1.0i)) 2.5+1.0i))
+  (test (+ 1.5 1.0-1.0i) 2.5-1.0i)
+  (when with-bignums
+    (test (+ (bignum 1.5) 1.0-1.0i) 2.5-1.0i)
+    (test (+ 1.5 (bignum 1.0-1.0i)) 2.5-1.0i)
+    (test (+ (bignum 1.5) (bignum 1.0-1.0i)) 2.5-1.0i))
+  (test (+ 1.5 m1) 4.5)
+  (test2 (+ 1.5 +nan.0) +nan.0)
+  (when with-bignums
+    (test2 (+ (bignum 1.5) +nan.0) +nan.0)
+    (test2 (+ 1.5 (bignum +nan.0)) +nan.0)
+    (test2 (+ (bignum 1.5) (bignum +nan.0)) +nan.0))
+  (test (+ -1.5 1) -0.5)
+  (when with-bignums
+    (test (+ (bignum -1.5) 1) -0.5)
+    (test (+ -1.5 (bignum 1)) -0.5)
+    (test (+ (bignum -1.5) (bignum 1)) -0.5))
+  (test (+ -1.5 -1) -2.5)
+  (when with-bignums
+    (test (+ (bignum -1.5) -1) -2.5)
+    (test (+ -1.5 (bignum -1)) -2.5)
+    (test (+ (bignum -1.5) (bignum -1)) -2.5))
+  (test (+ -1.5 1/2) -1.0)
+  (when with-bignums
+    (test (+ (bignum -1.5) 1/2) -1.0)
+    (test (+ -1.5 (bignum 1/2)) -1.0)
+    (test (+ (bignum -1.5) (bignum 1/2)) -1.0))
+  (test (+ -1.5 -1/2) -2.0)
+  (when with-bignums
+    (test (+ (bignum -1.5) -1/2) -2.0)
+    (test (+ -1.5 (bignum -1/2)) -2.0)
+    (test (+ (bignum -1.5) (bignum -1/2)) -2.0))
+  (test (+ -1.5 1.5) 0.0)
+  (when with-bignums
+    (test (+ (bignum -1.5) 1.5) 0.0)
+    (test (+ -1.5 (bignum 1.5)) 0.0)
+    (test (+ (bignum -1.5) (bignum 1.5)) 0.0))
+  (test (+ -1.5 -1.5) -3.0)
+  (when with-bignums
+    (test (+ (bignum -1.5) -1.5) -3.0)
+    (test (+ -1.5 (bignum -1.5)) -3.0)
+    (test (+ (bignum -1.5) (bignum -1.5)) -3.0))
+  (test (+ -1.5 1.0+1.0i) -0.5+1.0i)
+  (when with-bignums
+    (test (+ (bignum -1.5) 1.0+1.0i) -0.5+1.0i)
+    (test (+ -1.5 (bignum 1.0+1.0i)) -0.5+1.0i)
+    (test (+ (bignum -1.5) (bignum 1.0+1.0i)) -0.5+1.0i))
+  (test (+ -1.5 1.0-1.0i) -0.5-1.0i)
+  (when with-bignums
+    (test (+ (bignum -1.5) 1.0-1.0i) -0.5-1.0i)
+    (test (+ -1.5 (bignum 1.0-1.0i)) -0.5-1.0i)
+    (test (+ (bignum -1.5) (bignum 1.0-1.0i)) -0.5-1.0i))
+  (test (+ -1.5 m1) 1.5)
+  (test2 (+ -1.5 +nan.0) +nan.0)
+  (when with-bignums
+    (test2 (+ (bignum -1.5) +nan.0) +nan.0)
+    (test2 (+ -1.5 (bignum +nan.0)) +nan.0)
+    (test2 (+ (bignum -1.5) (bignum +nan.0)) +nan.0))
+  (test (+ 1.0+1.0i 1) 2.0+1.0i)
+  (when with-bignums
+    (test (+ (bignum 1.0+1.0i) 1) 2.0+1.0i)
+    (test (+ 1.0+1.0i (bignum 1)) 2.0+1.0i)
+    (test (+ (bignum 1.0+1.0i) (bignum 1)) 2.0+1.0i))
+  (test (+ 1.0+1.0i -1) 0.0+1.0i)
+  (when with-bignums
+    (test (+ (bignum 1.0+1.0i) -1) 0.0+1.0i)
+    (test (+ 1.0+1.0i (bignum -1)) 0.0+1.0i)
+    (test (+ (bignum 1.0+1.0i) (bignum -1)) 0.0+1.0i))
+  (test (+ 1.0+1.0i 1/2) 1.5+1.0i)
+  (when with-bignums
+    (test (+ (bignum 1.0+1.0i) 1/2) 1.5+1.0i)
+    (test (+ 1.0+1.0i (bignum 1/2)) 1.5+1.0i)
+    (test (+ (bignum 1.0+1.0i) (bignum 1/2)) 1.5+1.0i))
+  (test (+ 1.0+1.0i -1/2) 0.5+1.0i)
+  (when with-bignums
+    (test (+ (bignum 1.0+1.0i) -1/2) 0.5+1.0i)
+    (test (+ 1.0+1.0i (bignum -1/2)) 0.5+1.0i)
+    (test (+ (bignum 1.0+1.0i) (bignum -1/2)) 0.5+1.0i))
+  (test (+ 1.0+1.0i 1.5) 2.5+1.0i)
+  (when with-bignums
+    (test (+ (bignum 1.0+1.0i) 1.5) 2.5+1.0i)
+    (test (+ 1.0+1.0i (bignum 1.5)) 2.5+1.0i)
+    (test (+ (bignum 1.0+1.0i) (bignum 1.5)) 2.5+1.0i))
+  (test (+ 1.0+1.0i -1.5) -0.5+1.0i)
+  (when with-bignums
+    (test (+ (bignum 1.0+1.0i) -1.5) -0.5+1.0i)
+    (test (+ 1.0+1.0i (bignum -1.5)) -0.5+1.0i)
+    (test (+ (bignum 1.0+1.0i) (bignum -1.5)) -0.5+1.0i))
+  (test (+ 1.0+1.0i 1.0+1.0i) 2.0+2.0i)
+  (when with-bignums
+    (test (+ (bignum 1.0+1.0i) 1.0+1.0i) 2.0+2.0i)
+    (test (+ 1.0+1.0i (bignum 1.0+1.0i)) 2.0+2.0i)
+    (test (+ (bignum 1.0+1.0i) (bignum 1.0+1.0i)) 2.0+2.0i))
+  (test (+ 1.0+1.0i 1.0-1.0i) 2.0)
+  (when with-bignums
+    (test (+ (bignum 1.0+1.0i) 1.0-1.0i) 2.0)
+    (test (+ 1.0+1.0i (bignum 1.0-1.0i)) 2.0)
+    (test (+ (bignum 1.0+1.0i) (bignum 1.0-1.0i)) 2.0))
+  (test (+ 1.0+1.0i m1) 4.0+1.0i)
+  (test2 (nan? (+ 1.0+1.0i +nan.0)) #t)
+  (when with-bignums
+    (test2 (nan? (+ (bignum 1.0+1.0i) +nan.0)) #t)
+    (test2 (nan? (+ 1.0+1.0i (bignum +nan.0))) #t)
+    (test2 (nan? (+ (bignum 1.0+1.0i) (bignum +nan.0))) #t))
+  (test (+ 1.0-1.0i 1) 2.0-1.0i)
+  (when with-bignums
+    (test (+ (bignum 1.0-1.0i) 1) 2.0-1.0i)
+    (test (+ 1.0-1.0i (bignum 1)) 2.0-1.0i)
+    (test (+ (bignum 1.0-1.0i) (bignum 1)) 2.0-1.0i))
+  (test (+ 1.0-1.0i -1) 0.0-1.0i)
+  (when with-bignums
+    (test (+ (bignum 1.0-1.0i) -1) 0.0-1.0i)
+    (test (+ 1.0-1.0i (bignum -1)) 0.0-1.0i)
+    (test (+ (bignum 1.0-1.0i) (bignum -1)) 0.0-1.0i))
+  (test (+ 1.0-1.0i 1/2) 1.5-1.0i)
+  (when with-bignums
+    (test (+ (bignum 1.0-1.0i) 1/2) 1.5-1.0i)
+    (test (+ 1.0-1.0i (bignum 1/2)) 1.5-1.0i)
+    (test (+ (bignum 1.0-1.0i) (bignum 1/2)) 1.5-1.0i))
+  (test (+ 1.0-1.0i -1/2) 0.5-1.0i)
+  (when with-bignums
+    (test (+ (bignum 1.0-1.0i) -1/2) 0.5-1.0i)
+    (test (+ 1.0-1.0i (bignum -1/2)) 0.5-1.0i)
+    (test (+ (bignum 1.0-1.0i) (bignum -1/2)) 0.5-1.0i))
+  (test (+ 1.0-1.0i 1.5) 2.5-1.0i)
+  (when with-bignums
+    (test (+ (bignum 1.0-1.0i) 1.5) 2.5-1.0i)
+    (test (+ 1.0-1.0i (bignum 1.5)) 2.5-1.0i)
+    (test (+ (bignum 1.0-1.0i) (bignum 1.5)) 2.5-1.0i))
+  (test (+ 1.0-1.0i -1.5) -0.5-1.0i)
+  (when with-bignums
+    (test (+ (bignum 1.0-1.0i) -1.5) -0.5-1.0i)
+    (test (+ 1.0-1.0i (bignum -1.5)) -0.5-1.0i)
+    (test (+ (bignum 1.0-1.0i) (bignum -1.5)) -0.5-1.0i))
+  (test (+ 1.0-1.0i 1.0+1.0i) 2.0)
+  (when with-bignums
+    (test (+ (bignum 1.0-1.0i) 1.0+1.0i) 2.0)
+    (test (+ 1.0-1.0i (bignum 1.0+1.0i)) 2.0)
+    (test (+ (bignum 1.0-1.0i) (bignum 1.0+1.0i)) 2.0))
+  (test (+ 1.0-1.0i 1.0-1.0i) 2.0-2.0i)
+  (when with-bignums
+    (test (+ (bignum 1.0-1.0i) 1.0-1.0i) 2.0-2.0i)
+    (test (+ 1.0-1.0i (bignum 1.0-1.0i)) 2.0-2.0i)
+    (test (+ (bignum 1.0-1.0i) (bignum 1.0-1.0i)) 2.0-2.0i))
+  (test (+ 1.0-1.0i m1) 4.0-1.0i)
+  (test2 (+ 1.0-1.0i +nan.0) +nan.0-1.0i)
+  (when with-bignums
+    (test2 (+ (bignum 1.0-1.0i) +nan.0) +nan.0-1.0i)
+    (test2 (+ 1.0-1.0i (bignum +nan.0)) +nan.0-1.0i)
+    (test2 (+ (bignum 1.0-1.0i) (bignum +nan.0)) +nan.0-1.0i))
+  (test (+ m1 1) 4)
+  (test (+ m1 -1) 2)
+  (test (+ m1 1/2) 7/2)
+  (test (+ m1 -1/2) 5/2)
+  (test (+ m1 1.5) 4.5)
+  (test (+ m1 -1.5) 1.5)
+  (test (+ m1 1.0+1.0i) 4.0+1.0i)
+  (test (+ m1 1.0-1.0i) 4.0-1.0i)
+  (test (+ m1 m1) 6)
+  (test2 (+ m1 +nan.0) +nan.0)
+
+  (test2 (let () (define (func) (+ -nan.0 (bignum 1+i))) (define (hi) (func)) (hi)) +nan.0+1.0i)
+  (test2 (let () (define (func) (+ (bignum -nan.0) (bignum 1+i))) (define (hi) (func)) (hi)) +nan.0+1.0i)
+  (test2 (let () (define (func) (+ -nan.0 1+i)) (define (hi) (func)) (hi)) +nan.0+1.0i)
+  (test2 (let () (define (func) (+ (bignum -nan.0) 1+i)) (define (hi) (func)) (hi)) +nan.0+1.0i)
+  (test2 (+ +nan.0 1+i) +nan.0+1.0i)
+  (test2 (+ +nan.0 (bignum 1+i)) +nan.0+1.0i)
+  (test2 (+ (bignum +nan.0) (bignum 1+i)) +nan.0+1.0i)
+  (test2 (+ (bignum +nan.0) 1+i) +nan.0+1.0i)
+
+  (test2 (let () (define (func) (- -nan.0 (bignum 1+i))) (define (hi) (func)) (hi)) +nan.0-1.0i)
+  (test2 (let () (define (func) (- (bignum -nan.0) (bignum 1+i))) (define (hi) (func)) (hi)) +nan.0-1.0i)
+  (test2 (let () (define (func) (- -nan.0 1+i)) (define (hi) (func)) (hi)) +nan.0-1.0i)
+  (test2 (let () (define (func) (- (bignum -nan.0) 1+i)) (define (hi) (func)) (hi)) +nan.0-1.0i)
+  (test2 (- +nan.0 1+i) +nan.0-1.0i)
+  (test2 (- +nan.0 (bignum 1+i)) +nan.0-1.0i)
+  (test2 (- (bignum +nan.0) (bignum 1+i)) +nan.0-1.0i)
+  (test2 (- (bignum +nan.0) 1+i) +nan.0-1.0i)
+
+  (test2 (let () (define (func) (* +nan.0 (bignum 1+i))) (define (hi) (func)) (hi)) +nan.0+nan.0i)
+  )
+
+
+;;; --------------------------------------------------------------------------------
+;;; errors
+;;; --------------------------------------------------------------------------------
+
+(let ()
+  (for-each
+
+   (lambda (op)
+     (for-each
+
+      (lambda (arg)
+	(let ((val (catch #t (lambda () (op arg)) (lambda args 'error))))
+	  (if (not (eq? val 'error))
+	      (format #t "(~A ~A) -> ~A (expected 'error)~%" op arg val)))
+	(let ((val (catch #t (lambda () (op 0 arg)) (lambda args 'error))))
+	  (if (not (eq? val 'error))
+	      (format #t "(~A 0 ~A) -> ~A (expected 'error)~%" op arg val)))
+	(let ((val (catch #t (lambda () (op 0 1 arg)) (lambda args 'error))))
+	  (if (not (eq? val 'error))
+	      (format #t "(~A 0 1 ~A) -> ~A (expected 'error)~%" op arg val)))
+	(if with-bignums
+	    (let ((val (catch #t (lambda () (op (expt 2 60) arg)) (lambda args 'error))))
+	      (if (not (eq? val 'error))
+		  (format #t "(~A 2^60 ~A) -> ~A (expected 'error)~%" op arg val)))))
+
+      (list "hi" () #\a (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs #t _ht_ _undef_ _null_ _c_obj_ :hi (if #f #f) (lambda (a) (+ a 1)) #<undefined> #<unspecified> #<eof> :rest)))
+
+   (list exact? inexact? zero? positive? negative? even? odd? quotient remainder modulo truncate floor ceiling round
+	 abs max min gcd lcm expt exact->inexact inexact->exact rationalize numerator denominator imag-part real-part
+	 magnitude angle make-polar complex sqrt exp log sin cos tan asin acos atan number->string
+	 + - * / < > <= >= =)))
+
+(let ((d 3.14)
+      (i 32)
+      (r 2/3)
+      (c 1.5+0.3i))
+  (let ((check-vals (lambda (name)
+		      (if (or (not (= d 3.14)) ; (> (abs (- d 3.14)) 1e-16) ; (- 3.14 (bignum "3.14")) is around 1e-17!
+			      (not (= i 32))
+			      (not (= r 2/3))
+			      (not (= c 1.5+0.3i))) ; (> (magnitude (- c 1.5+0.3i)) 1e-16))
+			  (begin
+			    (display name) (display " changed ")
+			    (if (not (= i 32))
+				(begin (display "stored integer to: ") (display i))
+				(if (not (= r 2/3))
+				    (begin (display "stored ratio to: ") (display r))
+				    (if (not (= d 3.14))
+					(begin (display "stored real to: ") (display d))
+					(begin (display "stored complex to: ") (display c)))))
+			    (display "?") (newline))))))
+    (for-each
+     (lambda (op)
+       (let ((x (catch #t (lambda () (op i)) (lambda args 'error))))
+	 (check-vals op))
+       (let ((x (catch #t (lambda () (op r)) (lambda args 'error))))
+	 (check-vals op))
+       (let ((x (catch #t (lambda () (op d)) (lambda args 'error))))
+	 (check-vals op))
+       (let ((x (catch #t (lambda () (op c)) (lambda args 'error))))
+	 (check-vals op))
+       (let ((x (catch #t (lambda () (op i d)) (lambda args 'error))))
+	 (check-vals op))
+       (let ((x (catch #t (lambda () (op r d)) (lambda args 'error))))
+	 (check-vals op))
+       (let ((x (catch #t (lambda () (op d d)) (lambda args 'error))))
+	 (check-vals op))
+       (let ((x (catch #t (lambda () (op c d)) (lambda args 'error))))
+	 (check-vals op)))
+     (list
+      number->string string->number complex magnitude abs exp make-polar angle
+      sin cos tan sinh cosh tanh atan sqrt log asinh acosh atanh acos asin
+      number? integer? real? complex? rational? even? odd? zero? positive? negative? real-part imag-part
+      numerator denominator rationalize exact? inexact? exact->inexact inexact->exact floor ceiling truncate round
+      logior logxor logand lognot logbit? ash integer-length
+      + - * / quotient remainder
+      expt = max min modulo < > <= >= lcm gcd
+      ))))
+
+(when with-bignums
+  (test (bignum "1/3.0") 'error)
+
+  (let ((d (bignum "3.14"))
+	(i (bignum "32"))
+	(r (bignum "2/3"))
+	(c (bignum "1.5+0.3i")))
+    (let ((check-vals (lambda (name)
+			(if (or (not (= d (bignum "3.14"))) ; see above
+				(not (= i 32))
+				(not (= r 2/3))
+				(not (= c (bignum "1.5+0.3i"))))
+			    (begin
+			      (display name) (display " changed ")
+			      (if (not (= i 32))
+				  (begin (display "stored integer to: ") (display i))
+				  (if (not (= r 2/3))
+				      (begin (display "stored ratio to: ") (display r))
+				      (if (not (= d 3.14))
+					  (begin (display "stored real to: ") (display d))
+					  (begin (display "stored complex to: ") (display c)))))
+			      (display "?") (newline))))))
+      (for-each
+       (lambda (op)
+	 (let ((x (catch #t (lambda () (op i)) (lambda args 'error))))
+	   (check-vals op))
+	 (let ((x (catch #t (lambda () (op r)) (lambda args 'error))))
+	   (check-vals op))
+	 (let ((x (catch #t (lambda () (op d)) (lambda args 'error))))
+	   (check-vals op))
+	 (let ((x (catch #t (lambda () (op c)) (lambda args 'error))))
+	   (check-vals op))
+	 (let ((x (catch #t (lambda () (op i d)) (lambda args 'error))))
+	   (check-vals op))
+	 (let ((x (catch #t (lambda () (op r d)) (lambda args 'error))))
+	   (check-vals op))
+	 (let ((x (catch #t (lambda () (op d d)) (lambda args 'error))))
+	   (check-vals op))
+	 (let ((x (catch #t (lambda () (op c d)) (lambda args 'error))))
+	   (check-vals op)))
+       (list
+	number->string string->number complex magnitude abs exp make-polar angle
+	sin cos tan sinh cosh tanh atan sqrt log asinh acosh atanh acos asin
+	number? integer? real? complex? rational? even? odd? zero? positive? negative? real-part imag-part
+	numerator denominator rationalize exact? inexact? exact->inexact inexact->exact floor ceiling truncate round
+	logior logxor logand lognot logbit? ash integer-length
+	+ - * / quotient remainder
+	expt = max min modulo < > <= >= lcm gcd
+	))))
+
+  (for-each
+   (lambda (arg)
+     (test (bignum "1.0" arg) 'error))
+   (list -1 0 #\a #(1 2 3) 2/3 1.5+0.3i 1+i () 'hi abs "hi" #(()) (list 1 2 3) '(1 . 2) (lambda () 1))))
+
+
+
+#|
+(let ((funcs (list
+	      make-polar complex magnitude angle real-part imag-part numerator denominator rationalize abs
+	      exp log sin cos tan asin acos atan sinh cosh tanh asinh acosh atanh sqrt floor ceiling truncate
+	      round lcm gcd + - * / max min quotient remainder modulo = < > <= >= even? odd? zero? positive? negative?
+	      infinite? inexact->exact exact->inexact integer-length logior logxor logand lognot logbit?
+	      ash integer-decode-float exact? inexact? number? integer? real? complex? rational? nan?; number->string expt
+	      ))
+      (func-names (list
+		   'make-polar 'complex 'magnitude 'angle 'real-part 'imag-part 'numerator 'denominator 'rationalize 'abs
+		   'exp 'log 'sin 'cos 'tan 'asin 'acos 'atan 'sinh 'cosh 'tanh 'asinh 'acosh 'atanh 'sqrt 'floor 'ceiling 'truncate
+		   'round 'lcm 'gcd '+ '- '* '/ 'max 'min 'quotient 'remainder 'modulo '= '< '> '<= '>= 'even? 'odd? 'zero? 'positive? 'negative?
+		   'infinite? 'inexact->exact 'exact->inexact 'integer-length 'logior 'logxor 'logand 'lognot 'logbit?
+		   'ash 'integer-decode-float 'exact? 'inexact? 'number? 'integer? 'real? 'complex? 'rational? 'nan?; 'number->string 'expt
+		   ))
+      (args (list 0 1 -1)))
+  (define (for-each-subset-permuted func name args)
+    (let* ((ar (arity func))
+	   (min-args (car ar))
+	   (max-args (min 1000 (cdr ar))))
+      (if (= min-args 0) (set! min-args 1))
+      (for-each-subset
+       (lambda s-args
+	 (if (<= min-args (length s-args) max-args)
+	     (for-each-permutation
+	      (lambda p-args
+		(catch #t
+		  (lambda ()
+		    (let ((val (apply func p-args)))
+		      (format #t "(let ((new-val (catch-it (~A ~{~A~^ ~})))) " name p-args)
+		      (if (not (number? val))
+			  (format #t "(if (not (equal? new-val ~A)) (format #t \"(~A ~{~A~^ ~}) -> ~~A~~%\" new-val)))~%" val name p-args)
+			  (if (nan? val)
+			      (format #t "(if (not (nan? new-val)) (format #t \"(~A ~{~A~^ ~}) -> ~~A, not NaN?~~%\" new-val)))~%" name p-args)
+			      (if (infinite? val)
+				  (format #t "(if (not (infinite? new-val)) (format #t \"(~A ~{~A~^ ~}) -> ~~A, not inf?~~%\" new-val)))~%" name p-args)
+				  (format #t "(if (> (magnitude (- new-val ~A)) 1e-6) (format #t \"(~A ~{~A~^ ~}) -> ~~A, not ~A~~%\" new-val)))~%" val name p-args val))))))
+		  (lambda e-args (format *stderr* "~A~%" e-args) ''error)))
+	      s-args)))
+       args)))
+
+  (with-output-to-file "t248.data"
+    (lambda ()
+      (format #t "(define-macro (catch-it tst)~%  `(catch #t (lambda () ,tst) (lambda args 'error)))~%")
+      (for-each
+       (lambda (func name)
+	 (for-each-subset-permuted func name args))
+       funcs func-names))))
+|#
+
+;(gc)
+
+;;; --------------------------------------------------------------------------------
+;;;
+;;; fft from s7.html
+
+(define* (cfft! data n (dir 1)) ; (complex data)
+  (if (not n) (set! n (length data)))
+  (do ((i 0 (+ i 1))
+       (j 0))
+      ((= i n))
+    (if (> j i)
+	(let ((temp (data j)))
+	  (set! (data j) (data i))
+	  (set! (data i) temp)))
+    (let ((m (/ n 2)))
+      (do ()
+	  ((or (< m 2) (< j m)))
+	(set! j (- j m))
+	(set! m (/ m 2)))
+      (set! j (+ j m))))
+  (let ((ipow (floor (log n 2)))
+	(prev 1))
+    (do ((lg 0 (+ lg 1))
+	 (mmax 2 (* mmax 2))
+	 (pow (/ n 2) (/ pow 2))
+	 (theta (complex 0.0 (* pi dir)) (* theta 0.5)))
+	((= lg ipow))
+      (let ((wpc (exp theta))
+	    (wc 1.0))
+	(do ((ii 0 (+ ii 1)))
+	    ((= ii prev))
+	  (do ((jj 0 (+ jj 1))
+	       (i ii (+ i mmax))
+	       (j (+ ii prev) (+ j mmax)))
+	      ((>= jj pow))
+	    (let ((tc (* wc (data j))))
+	      (set! (data j) (- (data i) tc))
+	      (set! (data i) (+ (data i) tc))))
+	  (set! wc (* wc wpc)))
+	(set! prev mmax))))
+  data)
+
+(test (equivalent? (cfft! (list 0.0 1+i 0.0 0.0)) '(1+1i -1+1i -1-1i 1-1i)) #t)
+(test (equivalent? (cfft! (vector 0.0 1+i 0.0 0.0)) #(1+1i -1+1i -1-1i 1-1i)) #t)
+
+(let ((size 32))
+  (let ((v (make-vector size)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (set! (v i) (random 1.0)))
+    (let ((copy-v (copy v)))
+      (cfft! v size)
+      (cfft! v size -1)
+      (do ((i 0 (+ i 1)))
+	  ((= i size))
+	(set! (v i) (/ (v i) size))
+	(if (or (> (abs (imag-part (v i))) 1e-14)
+		(> (magnitude (- (v i) (copy-v i))) 1e-14))
+	    (format *stderr* ";cfft! reals: ~D: ~A ~A~%" i (v i) (copy-v i)))))))
+
+(let ((size 32))
+  (let ((v (make-vector size)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (set! (v i) (random 100)))
+    (let ((copy-v (copy v)))
+      (cfft! v size)
+      (cfft! v size -1)
+      (do ((i 0 (+ i 1)))
+	  ((= i size))
+	(set! (v i) (/ (v i) size))
+	(if (or (> (abs (imag-part (v i))) 1e-12)
+		(> (magnitude (- (v i) (copy-v i))) 1e-12))
+	    (format *stderr* ";cfft! ints: ~D: ~A ~A~%" i (v i) (copy-v i)))))))
+
+(let ((size 32))
+  (let ((v (make-vector size)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (set! (v i) (random 1+i)))
+    (let ((copy-v (copy v)))
+      (cfft! v size)
+      (cfft! v size -1)
+      (do ((i 0 (+ i 1)))
+	  ((= i size))
+	(set! (v i) (/ (v i) size))
+	(if (> (magnitude (- (v i) (copy-v i))) 1e-12)
+	    (format *stderr* ";cfft! complex: ~D: ~A ~A~%" i (v i) (copy-v i)))))))
+
+(when with-bignums
+  (let ((size 32))
+    (let ((data (make-vector size)))
+      (do ((i 0 (+ i 1)))
+	  ((= i size))
+	(set! (data i) (complex (bignum (number->string (random 1.0)))
+				(bignum (number->string (random 1.0))))))
+      (let ((old-data (copy data)))
+	(cfft! data size)
+	(cfft! data size -1)
+	(do ((i 0 (+ i 1)))
+	    ((= i size))
+	  (set! (data i) (/ (data i) size))
+	  (if (> (magnitude (- (data i) (old-data i))) 1e-14)
+	      (format *stderr* ";cfft! big: ~D: ~A~%" i (magnitude (- (old-data i) (data i))))))))))
+#|
+;;; 1048576 forces us to 4608000, 32568 512000
+(let ((size 65536))
+  (let ((v (make-vector size)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (set! (v i) (random 1+i)))
+    (let ((copy-v (copy v)))
+      (cfft! v size)
+      (cfft! v size -1)
+      (do ((i 0 (+ i 1)))
+	  ((= i size))
+	(set! (v i) (/ (v i) size))
+	(if (> (magnitude (- (v i) (copy-v i))) 1e-10)
+	    (format *stderr* "~D: ~A (~A ~A)~%" (magnitude (- (v i) (copy-v i))) i (v i) (copy-v i)))))))
+|#
+
+(define khar car)
+(load "stuff.scm")
+(let ()
+  ;(load "stuff.scm" (curlet))
+
+  ;; this tickled a tree-cyclic? bug
+  (when full-s7test
+    (let ()
+      (define (char-permute op . args)
+	(let ((form `(let ()
+		       (define (t1)
+			 (let ((x #\a) (y #\A) (fv (make-float-vector 4)))
+			   (do ((i 0 (+ i 1))
+				(x1 1.0 (+ x1 1.0)))
+			       ((= i 4) fv)
+			     (if (,op ,@args)
+				 (float-vector-set! fv i x1)
+				 (float-vector-set! fv i 0.0)))))
+		       (define (t2)
+			 (let ((x #\a) (y #\A) (fv (make-float-vector 4)))
+			   (do ((i 0 (+ i 1))
+				(x1 1.0 (+ x1 1.0)))
+			       ((= i 4) fv)
+			     (if (apply ,op (list ,@args))
+				 (float-vector-set! fv i x1)
+				 (float-vector-set! fv i 0.0)))))
+		       (let ((v1 (t1))
+			     (v2 (t2)))
+			 (if (not (equivalent? v1 v2))
+			     (format *stderr* "char-permute ~A, ~A -> ~A ~A~%" op args v1 v2))))))
+	  (eval (copy form :readable))))
+
+      (for-each
+       (lambda (op)
+	 (for-each-subset
+	  (lambda s-args
+	    (if (= (length s-args) 2)
+		(for-each-permutation
+		 (lambda args
+		   (apply char-permute op args))
+		 s-args)))
+	  (list 'x 'y #\b #\newline)))
+       (if (provided? 'pure-s7)
+	   (list 'char=? 'char<? 'char<=? 'char>? 'char>=?)
+	   (list 'char=? 'char<? 'char<=? 'char>? 'char>=? 'char-ci=? 'char-ci<? 'char-ci<=? 'char-ci>? 'char-ci>=?)))))
+
+  (typed-let ((i 0 integer?)
+	      (x () list?))
+     (test (set! i 3) 3)
+     (test  (set! i pi) 'error)
+     (test (set! x (list 3)) '(3))
+     (when with-bignums (test (set! i (bignum 3)) 3))
+     (test (set! x pi) 'error))
+
+  (let ((i 0))
+    (typed-let ((i () list?))
+      (set! i ()))
+    (set! i 2))
+  (typed-let ((i 0)
+	      (x pi real?))
+    (test (set! i ()) ())
+    (test (set! x ()) 'error))
+
+  (let ()
+    (define f
+      (let ((+signature+ '(integer? #t #t))) ; this is inconsistent with vector/hash-table sigs -- maybe if func itself use in error checks?
+	(lambda (y z)
+	  (let ((x y))
+	    (set! (setter 'x)
+		  (if (not (integer? x))
+		      (error "x is supposed to be an integer")
+		      (lambda (s v)
+			(if (integer? v) v x))))
+	    (set! x z)
+	    x))))
+    (test (f 0 2) 2)
+    (test (f 0 "2") 0)
+    (test (f "0" 2) 'error))
+
+  (let ((lt (with-let (inlet 'a 0)
+	      (set! (setter 'a)
+		    (lambda (s v)
+		      32))
+	      (curlet))))
+    (test (lt 'a) 0)
+    (set! (lt 'a) 1)
+    (test (lt 'a) 32))
+
+  (test (typed-inlet (i 0 integer?)) (inlet 'i 0))
+  (test (let () (define (f124) (equal? (typed-inlet (i 0 integer?)) (inlet 'i 0))) (f124)) #t)
+  (test (typed-inlet (i "a" integer?)) 'error)
+  (let ((lt (typed-inlet (a 0 integer?))))
+    (set! (lt 'a) 32)
+    (test (lt 'a) 32))
+
+  (test (first '(1 2 3 4 5 6 7 8 9 10)) 1)
+  (test (second '(1 2 3 4 5 6 7 8 9 10)) 2)
+  (test (third '(1 2 3 4 5 6 7 8 9 10)) 3)
+  (test (fourth '(1 2 3 4 5 6 7 8 9 10)) 4)
+  (test (fifth '(1 2 3 4 5 6 7 8 9 10)) 5)
+  (test (sixth '(1 2 3 4 5 6 7 8 9 10)) 6)
+  (test (seventh '(1 2 3 4 5 6 7 8 9 10)) 7)
+  (test (eighth '(1 2 3 4 5 6 7 8 9 10)) 8)
+  (test (ninth '(1 2 3 4 5 6 7 8 9 10)) 9)
+  (test (tenth '(1 2 3 4 5 6 7 8 9 10)) 10)
+  (test (first #(1 2 3 4 5 6 7 8 9 10)) 1)
+  (test (second #(1 2 3 4 5 6 7 8 9 10)) 2)
+  (test (third #(1 2 3 4 5 6 7 8 9 10)) 3)
+  (test (fourth #(1 2 3 4 5 6 7 8 9 10)) 4)
+  (test (fifth #(1 2 3 4 5 6 7 8 9 10)) 5)
+  (test (sixth #(1 2 3 4 5 6 7 8 9 10)) 6)
+  (test (seventh #(1 2 3 4 5 6 7 8 9 10)) 7)
+  (test (eighth #(1 2 3 4 5 6 7 8 9 10)) 8)
+  (test (ninth #(1 2 3 4 5 6 7 8 9 10)) 9)
+  (test (tenth #(1 2 3 4 5 6 7 8 9 10)) 10)
+  (test (first "1234567890") #\1)
+  (test (second "1234567890") #\2)
+  (test (third "1234567890") #\3)
+  (test (fourth "1234567890") #\4)
+  (test (fifth "1234567890") #\5)
+  (test (sixth "1234567890") #\6)
+  (test (seventh "1234567890") #\7)
+  (test (eighth "1234567890") #\8)
+  (test (ninth "1234567890") #\9)
+  (test (tenth "1234567890") #\0)
+
+  (for-each (lambda (obj)
+	      (test (empty? obj) #t)
+	      (test (not (sequence? obj)) #f))
+	    (list "" () #() (hash-table) (inlet) (if with-block (block) (float-vector)) (float-vector) #2d()))
+
+  (for-each (lambda (obj)
+	      (test (empty? obj) #f)
+	      (test (not (sequence? obj)) #t)
+	      (test (not (applicable? obj)) #f))
+	    (list abs (lambda () 1) quasiquote))
+
+  (for-each (lambda (obj)
+	      (test (empty? obj) #f)
+	      (test (indexable? obj) #f)
+	      (test (applicable? obj) #f)
+	      (test (not (sequence? obj)) #t))
+	    (list #\null #\a 1 'a-symbol 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f)))
+  (test (sequence?) 'error)
+  (test (sequence? () '(1)) 'error)
+
+  (test (->predicate 1) integer?)
+  (test (->predicate (curlet)) let?)
+  (test (->predicate #<eof>) eof-object?)
+  (test (->predicate (cons 1 2)) pair?)
+  (test (->predicate :hi) keyword?)
+  (test (->predicate #\a) char?)
+  (test (->predicate) 'error)
+
+  (when with-block
+    (add-predicate block?)
+    (test (->predicate (block 1 2)) block?))
+
+  (test (let ((a 1) (b "hi")) (value->symbol "hi")) 'b)
+
+  (test (typeq? 1 2) #t)
+  (test (typeq? #\a #\space #\b) #t)
+  (test (typeq?) #t)
+  (test (typeq? 1.2) #t)
+  (test (typeq? 1 1/2) #f)
+  (test (typeq? "hi" "" (string #\null) "abc") #t)
+  (test (typeq? 1.0 pi) #t)
+  (test (typeq? #<unspecified> (if #f #f)) #t)
+
+  (test (let ((x 1)) (typecase x ((integer?) 32) ((real? string?) 2) (else 0))) 32)
+  (test (let ((x 1.0)) (typecase x ((integer?) 32) ((real? string?) 2) (else 0))) 2)
+  (test (let ((x ())) (typecase x ((integer?) 32) ((real? string?) 2) (else 0))) 0)
+  (test (let ((x "hi")) (typecase x ((integer?) 32) ((real? string?) 2) (else 0))) 2)
+  (test (let ((x 0)) (typecase (set! x (+ x 1)) ((even?) -1) ((odd?) 1))) 1)
+
+  ;; 2^n and 2^n-1 are tested above as are log-n-of et al and the ldb/dpb functions
+  (test (lognand 1 2) -1)
+  (test (lognand -1 1) -2)
+  (test (lognand -1 -2) 1)
+  (test (lognand 123 321) -66)
+
+  (test (lognor -1 -2) 0)
+  (test (lognor 1 2) -4)
+  (test (lognor 123 321) -380)
+  (test (lognor 0 1) -2)
+
+  (test (logeqv 1) 1)
+  (test (logeqv) -1)
+  (test (logeqv 1 2) -4)
+  (test (logeqv -1 2) 2)
+  (test (logeqv -1 123 321) -315)
+  (test (logeqv 1 2 3 4) -5)
+  (test (logeqv 1 2 3 4 5) 1)
+
+  (test (iota 0) ())
+  (test (iota 3) '(0 1 2))
+  (test (iota -1) 'error)
+  (test (iota 3 -2) '(-2 -1 0))
+
+  (test (union vector '(1 2 3) #() #(4 2 1)) #(1 2 3 4))
+  (test (union string '(#\a) #(#\b) "abcde") "abcde")
+  (test (union vector) #())
+  (test (equal? (union list '(1 2 3) ()) '(1 2 3)) #t)
+  (test (let? (union inlet (inlet 'a 2) (inlet 'b 3))) #t)
+  (test ((union inlet '(a 1) #(b 2)) 'b) 2)
+  (test ((union hash-table (hash-table 'a 1) (hash-table 'a 1 'b 2)) 'b) 2)
+
+  (test (intersection vector) #())
+  (test (intersection list '(1 2 3) #()) ())
+  (test (intersection list '(1 2 3) #(4 5 1 9)) '(1)) ; pair: unbound variable
+  (num-test ((intersection float-vector '(1 2 3) #(4 5 1 9 3)) 0) 1.0)
+  (test (intersection (lambda x (subvector (apply vector x) 0 4 '(2 2))) '(1 2 3 4 5) #(4 5 1 9 3)) #2d((1 3) (4 5)))
+  (when with-block
+    (test (block? (intersection block '(1.0 2.0) #(1.0))) #t)
+    (test (block? (intersection block (block 1.0 2.0) #(2.0))) #t))
+  (test (intersection list '(1 2 3) '(3 2 1)) '(1 2 3))
+  (test (intersection inlet (inlet 'a 1 'b 2) (inlet 'b 3)) (inlet))
+  (test (intersection inlet (inlet 'a 1 'b 2) (inlet 'b 2)) (inlet 'b 2))
+
+  (test (symmetric-difference list '(1 2 3)) '(1 2 3))
+  (test (symmetric-difference list ()) ())
+  (test (symmetric-difference list '(1 2 3) '(1 2 4)) '(3 4))
+  (test (symmetric-difference list '(1 2 3) '(1 2 4) '(3 1 5)) '(1 4 5))
+
+  (test (asymmetric-difference list '(1 2 3) '(1 2 4)) '(4))
+  (test (asymmetric-difference list ()) ())
+  (test (asymmetric-difference list '(1 2 3)) ())
+
+  (test (null? (cl-set-difference list () ())) #t)
+  (test (null? (cl-set-difference list () '(1 2 3))) #t)
+  (test (null? (cl-set-difference list '(1 2 3 4) '(4 3 2 1))) #t)
+  (test (null? (cl-set-difference list '(1 2 3 4) '(2 4 3 1))) #t)
+  (test (null? (cl-set-difference list '(1 2 3 4) '(1 3 4 2))) #t)
+  (test (null? (cl-set-difference list '(1 2 3 4) '(1 3 2 4))) #t)
+
+  (test (power-set list ()) '(()))
+  (test (power-set list '(1)) '(() (1)))
+  (test (power-set list '(1 2)) '(() (2) (1) (1 2)))
+  (test (power-set list '(1 2 3)) '(() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3)))
+
+  (test (apply union list (power-set list '(1 2 3))) '(3 2 1))
+
+  ;; this used to be built into s7.c
+  (test (let ((a 1) (b 2)) (multiple-value-set! (a b) (values 32 64)) (+ a b)) 96)
+  (test (let ((a 1) (b 2)) (multiple-value-set! (a b) (values 32 64) (set! a (+ b 1))) (+ a b)) 129)
+  (test (let ((a 1) (b 2)) (multiple-value-set! (a b) (values 32 64 12) (+ a b))) 'error) ; was  96)
+  (test (let ((a 1) (b 2)) (multiple-value-set! (a b) (values 32)) (cons a b)) 'error)    ; was  '(32 . #f))
+
+  (test (multiple-value-set! #() "1234" #(0 1 2 3 4)) 'error)
+  (test (multiple-value-set! "" #(0 1 2 3 4) :readable) 'error)
+  (test (multiple-value-set! () #(0 1 2 3 4) :readable) 'error)
+  (test (multiple-value-set! () ()) ())
+  (test (multiple-value-set! () () 1 2) 2)
+
+  (test (hash-table->alist (hash-table)) ())
+  (test (hash-table->alist (hash-table 'a 1)) '((a . 1)))
+  (test (let ((lst (hash-table->alist (hash-table 'a 1 'b 2))))
+	  (or (equal? lst '((a . 1) (b . 2)))
+	      (equal? lst '((b . 2) (a . 1)))))
+	#t)
+
+  (test (merge-hash-tables (hash-table) (hash-table 'a 1)) (hash-table 'a 1))
+  (test (merge-hash-tables (hash-table 'a 1 'b 2) (hash-table 'a 1)) (hash-table 'a 1 'b 2))
+  (test (union hash-table (hash-table 'a 1 'b 2) (hash-table 'a 1)) (hash-table 'a 1 'b 2))
+  (test (with-let (union inlet (inlet 'a 1) (inlet 'b 2)) (+ a b)) 3)
+  (let ()
+    (define e (let ((e's (list (inlet 'a 1 'b 2) (inlet 'a 3 'b 4))))
+		(lambda (sym)
+		  (apply values (map (lambda (e1)
+				       (if (defined? sym e1)
+					   (e1 sym)
+					   (values)))
+				     e's)))))
+    (test (+ (e 'a) (e 'b)) 10))
+
+  (test (find-if (lambda (x) (= x 3)) '(1 2 3 4)) 3)
+  (test (find-if (lambda (x) (= x 3)) '(1 2 5 4)) #f)
+  (test (find-if (lambda (x) (= x 3)) ()) #f)
+
+  (test (index-if (lambda (x) (= x 3)) '(1 2 3 4)) 2)
+  (test (index-if (lambda (x) (= x 1)) '(1 2 3 4)) 0)
+  (test (index-if (lambda (x) (= x 3)) '(1 2 5 4)) #f)
+  (test (index-if (lambda (x) (= x 3)) ()) #f)
+  (test (index-if (lambda (x) (equal? (cdr x) 2)) (hash-table 'a 1 'b 2)) 'b)
+
+  (test (count-if (lambda (x) (= x 3)) ()) 0)
+  (test (count-if (lambda (x) (= x 3)) '(1 2)) 0)
+  (test (count-if (lambda (x) (= x 3)) '(3 3)) 2)
+
+  (test (every? (lambda (x) (= x 3)) ()) #t)
+  (test (every? (lambda (x) (= x 3)) '(1 2)) #f)
+  (test (every? (lambda (x) (= x 3)) '(1 3)) #f)
+  (test (every? (lambda (x) (= x 3)) '(3 3 3)) #t)
+
+  (test (any? (lambda (x) (= x 3)) ()) #f)
+  (test (any? (lambda (x) (= x 3)) '(1 2)) #f)
+  (test (not (any? (lambda (x) (= x 3)) '(1 3))) #f)
+  (test (not (any? (lambda (x) (= x 3)) '(3 3 3))) #f)
+
+  (test (collect-if list (lambda (x) (> x 3)) ()) ())
+  (test (collect-if list (lambda (x) (> x 3)) '(1)) ())
+  (test (collect-if list (lambda (x) (> x 3)) '(1 3 4)) '(4))
+  (test (collect-if list (lambda (x) (> x 3)) '(1 3 4 2 1 5 1)) '(4 5))
+  (test (collect-if list integer? 1) 'error)
+
+  (test (collect-if inlet (let ((syms ()))
+				  (lambda (x)
+				    (and (not (memq (car x) syms))
+					 (set! syms (cons (car x) syms)))))
+		    (inlet 'a 1 'b 2 'a 3))
+	(inlet 'b 2 'a 1))
+  ;; i.e. clean out shadowed vars, ((inlet 'a 1 'b 2 'a 3) 'a) -> 3
+
+  (test (remove-if list (lambda (x) (> x 3)) ()) ())
+  (test (remove-if list (lambda (x) (> x 3)) '(1)) '(1))
+  (test (remove-if list (lambda (x) (> x 3)) '(1 3 4)) '(1 3))
+  (test (remove-if list (lambda (x) (> x 3)) '(1 3 4 2 1 5 1)) '(1 3 2 1 1))
+  (test (let ((e (inlet 'a 1 'b 2 'c 3)))
+	  (remove-if inlet (lambda (x) (= (cdr x) 2)) e))
+	(inlet 'a 1 'c 3))
+  (test (let ((ht (hash-table 'a 1 'b 2 'c 3)))
+	  (remove-if hash-table (lambda (x) (= (cdr x) 2)) ht))
+	(hash-table 'a 1 'c 3))
+  (test (remove-if vector (lambda (x) (integer? x)) #(() #\a 3/2 2 21 "hi")) #(() #\a 3/2 "hi"))
+  (test (remove-if list integer? 1) 'error)
+
+  (test (nonce list ()) ())
+  (test (nonce list '(1 2)) '(1 2))
+  (test (nonce list '(1 1)) ())
+  (test (nonce list '(1 2 3 1 3 1 1)) '(2))
+
+  (test (member? 1 ()) #f)
+  (test (member? 1 '(2 3)) #f)
+  (test (member? 1 '(2 1 3)) 1)
+
+  (test (concatenate list ()) ())
+  (test (concatenate list () #() "") ())
+  (test (concatenate vector '(1) #() "2") #(1 #\2))
+  (test (concatenate string '(#\1 #\2) "34" #(#\5)) "12345")
+  (test (concatenate inlet (inlet 'a 1) (inlet 'b 2 'a 3)) (inlet 'a 1 'b 2 'a 3))
+
+  (test (full-find-if (lambda (x) (and (integer? x) (= x 1))) '(2 (3 (4 5) 6 1))) 1)
+  (test (full-find-if (lambda (x) (and (integer? x) (= x 1))) '(2 (3 (4 5) 6))) #f)
+
+  (test (full-count-if (lambda (x) (and (integer? x) (= x 1))) '(1 2 (3 4 1) (5 (6 (1))))) 3)
+  (test (let ((l1 '(1 2))) (full-count-if (lambda (x) (and (integer? x) (= x 2))) (list 1 l1 2 l1 3 l1))) 4)
+
+  (test (full-index-if (lambda (x) (and (integer? x) (= x 3))) '(1 2 3)) '(2))
+  (test (full-index-if (lambda (x) (= (cdr x) 3)) (hash-table 'a 1 'b 3)) '(b))
+  (test (full-index-if (lambda (x) (and (integer? x) (= x 3))) '(1 (2 3))) '(1 1))
+  (test (full-index-if (lambda (x) (and (integer? x) (= x 3))) '((1 (2 (3))))) '(0 1 1 0))
+  (test (full-index-if (lambda (x) (and (integer? x) (= x 3))) #((1 (2 #(3))))) '(0 1 1 0))
+  (test (full-index-if (lambda (x) (and (integer? x) (= x 3))) (hash-table 'a 1 'b #(1 2 3))) '(b 2))
+  (test (full-index-if (lambda (x) (and (integer? x) (= x 4))) (hash-table 'a 1 'b #(1 2 3))) #f)
+
+  (test (let ((lst (list 1 2))) (set-cdr! lst lst) (let ((i (make-complete-iterator lst))) (map values i))) '(1))
+  (test (let ((lst (list 1 2))) (set-cdr! (cdr lst) lst) (let ((i (make-complete-iterator lst))) (map values i))) '(1 2))
+  (test (let ((lst (list 1 2 3))) (set-cdr! (cddr lst) lst) (let ((i (make-complete-iterator lst))) (map values i))) '(1 2 3))
+  (test (let ((lst (list 1 2 3 4))) (set-cdr! (cdddr lst) lst) (let ((i (make-complete-iterator lst))) (map values i))) '(1 2 3 4))
+  (test (let ((v '(1 2 . 3))) (let ((i (make-complete-iterator v))) (map values i))) '(1 2 3))
+  (test (let ((v '(1 2 #(4 5) ("67")))) (let ((i (make-complete-iterator v))) (map values i))) '(1 2 #(4 5) 4 5 ("67") "67" #\6 #\7))
+  (test (let ((v (list (circular-list 1)))) (let ((iter (make-complete-iterator v))) (map values iter))) (list (circular-list 1) 1))
+  (test (let ((v (list (circular-list 1 2)))) (let ((iter (make-complete-iterator v))) (map values iter))) (list (circular-list 1 2) 1 2))
+
+  (test (let ((v (cons 3 (circular-list 1)))) (let ((iter (make-complete-iterator v))) (map values iter))) '(3 1))
+  (test (let ((v (cons 3 (circular-list 1 2)))) (let ((iter (make-complete-iterator v))) (map values iter))) '(3 1 2))
+  (test (let ((v (list 3 (circular-list 1)))) (let ((iter (make-complete-iterator v))) (map values iter))) (list 3 (circular-list 1) 1))
+  (test (let ((v (list 3 (circular-list 1 2)))) (let ((iter (make-complete-iterator v))) (map values iter))) (list 3 (circular-list 1 2) 1 2))
+
+  (test (let ((v (vector (list 4 5) (circular-list 1 2 3) (cons 6 (cons 7 8)))))
+	  (let ((iter (make-complete-iterator v)))
+	    (map values iter)))
+	(list (list 4 5) 4 5 (circular-list 1 2 3) 1 2 3 (cons 6 (cons 7 8)) 6 7 8))
+
+  (test (let ((lst (list 1 2))) (let ((v (list lst lst))) (let ((iter (make-complete-iterator v))) (map values iter))))	'((1 2) 1 2))
+
+  (test (let ((lst (circular-list 1)))
+    (let ((v (list lst lst)))
+      (let ((iter (make-complete-iterator v)))
+	(map values iter))))
+	(list (circular-list 1) 1))
+
+  (let ((v (circular-list 1))) (set-car! v v) (test (let ((i5 (make-complete-iterator v))) (map values i5)) ()))
+  (let ((v (vector 1))) (set! (v 0) v) (test (let ((i4 (make-complete-iterator v))) (map values i4)) ()))
+
+  (let ((v (vector 1)) (lst (circular-list 2)))
+    (set! (v 0) lst) (set-car! lst v)
+    (test (let ((i1 (make-complete-iterator v))) (map values i1)) (list lst))) ; not v because it's the outermost container?
+
+  (let ((v (vector 1)) (lst (circular-list 2)))
+    (set! (v 0) lst) (set-car! lst v)
+    (test (let ((i2 (make-complete-iterator (list v)))) (map values i2)) (list v lst)))
+
+  (let ((v (vector 1 2)))
+    (set! (v 1) v) (set! (v 0) v)
+    (test (let ((i3 (make-complete-iterator (list v)))) (map values i3)) (list v)))
+
+  (test (safe-find-if (lambda (x) (and (integer? x) (= x 1))) '(2 (3 (4 5) 6 1))) 1)
+  (test (safe-find-if (lambda (x) (and (integer? x) (= x 1))) '(2 (3 (4 5) 6))) #f)
+  (test (safe-find-if (lambda (x) (and (integer? x) (= x 1))) (circular-list 2 3 1 4)) 1)
+  (test (safe-find-if (lambda (x) (and (integer? x) (= x 1))) (vector 2 (circular-list 2 3 1 4) 3)) 1)
+  (test (safe-find-if (lambda (x) (and (integer? x) (= x 1))) (vector 2 (circular-list 2 3 4) 3)) #f)
+  (test (let ((v (vector 1 2))) (set! (v 1) v) (safe-find-if (lambda (x) (and (integer? x) (= x 1))) v)) 1)
+  (test (let ((v (vector 1 2)) (lst (list 1 2))) (set! (v 1) lst) (set! (lst 1) v) (safe-find-if (lambda (x) (and (integer? x) (= x 1))) v)) 1)
+
+  (test (safe-count-if (lambda (x) (and (integer? x) (= x 1))) '(2 (3 (4 5) 6 1))) 1)
+  (test (safe-count-if (lambda (x) (and (integer? x) (= x 1))) '(2 (3 (4 5) 6))) 0)
+  (test (safe-count-if (lambda (x) (and (integer? x) (= x 1))) (circular-list 2 3 1 4)) 1)
+  (test (safe-count-if (lambda (x) (and (integer? x) (= x 1))) (vector 2 (circular-list 2 3 1 4) 3)) 1)
+  (test (safe-count-if (lambda (x) (and (integer? x) (= x 1))) (vector 2 (circular-list 2 3 4) 3)) 0)
+  (test (safe-count-if (lambda (x) (and (integer? x) (= x 1))) (vector 2 #(1) (circular-list 2 1 3 1 4) 3)) 3)
+  (test (let ((v (vector 1 2))) (set! (v 1) v) (safe-count-if (lambda (x) (and (integer? x) (= x 1))) v)) 1)
+  (test (let ((v (vector 1 2)) (lst (list 1 2))) (set! (v 1) lst) (set! (lst 1) v) (safe-count-if (lambda (x) (and (integer? x) (= x 1))) v)) 2)
+
+  (let ((x 1)
+	(y 2))
+    (let*-temporarily ((x 32) (y x))
+      (test (list x y) '(32 32)))
+    (test (list x y) '(1 2)))
+
+  (let ((a (vector 1 2 3))
+	(x 1)
+	(y 32)
+	(z 0))
+    (let*-temporarily (((a x) y) (z (a x)))
+      (test (list (a x) y z) '(32 32 32)))
+    (test (list (a x) y z) '(2 32 0)))
+
+  (test (make-directory-iterator #\a) 'error)
+  (test (catch #t
+	  (lambda ()
+	    (let ((f (make-directory-iterator (append "/home/" username "/libxm"))))
+	      (f)
+	      ((iterator-sequence f) #<eof>)
+	      #f))
+	  (lambda args #f))
+	#f)
+
+  (let ((a 3))
+    (let/setter ((a 1)
+		 (b 2 (lambda (s v)
+			(+ v a))))
+      (set! a (+ a 1))
+      (set! b (+ a b))
+      (test (list a b) '(2 7))))
+
+  (let ()
+    (let/setter ((a 1 (lambda (s v)
+			(- v 1)))
+		 (b 2 (lambda (s v)
+			(+ v 1))))
+      (set! a (+ a 1))
+      (set! b (+ a b))
+      (test (list a b) '(1 4))))
+
+  (let ()
+    (define-macro (inlet/setter . fields)
+      ;; (inlet/setter (name value [setter]) ...)
+      (let ((setters (map (lambda (binding)
+			    (and (pair? (cddr binding))
+				 (caddr binding)))
+			  fields))
+	    (gsetters (gensym))
+	    (glet (gensym)))
+	`(let ((,gsetters (list ,@setters))
+	       (,glet (inlet ,@(map (lambda (binding)
+				      `(cons ',(car binding) ,(cadr binding)))
+				    fields))))
+	   ,@(do ((setter setters (cdr setter))
+		  (var fields (cdr var))
+		  (i 0 (+ i 1))
+		  (result ()))
+		 ((null? setter)
+		  (reverse result))
+	       (if (car setter)
+		   (set! result (cons `(set! (setter (quote ,(caar var)) ,glet) (list-ref ,gsetters ,i)) result))))
+	   ,glet)))
+
+    (let ((lt (inlet/setter (a 1) (b 2 (lambda (s v) (+ v 1))))))
+      (set! (lt 'a) 21)
+      (set! (lt 'b) 3)
+      (test (list (lt 'a) (lt 'b)) '(21 4))))
+
+
+  (test (let ((x 32))
+	  (define gx (elambda () (*env* 'x)))
+	  (let ((x 100))
+	    (let ((x 12))
+	      (gx))))
+	12)
+  (test (let ()
+	  (define hi (elambda (x) (string->symbol "b")))
+	  (eq? (hi 1) 'b))
+	#t)
+  (test (let ()
+	  (define hi (elambda (x) (+ (*env* 'y) x)))
+	  (let ((y 3)) (hi 1)))
+	4)
+  (test (letrec ((efunc (elambda (x) (if (= x 0) 0 (efunc (- x 1)))))) (efunc 3)) 0)
+  (test (let ((y 1)) (define hi (elambda (x z) (if (= x z) (display "oops")) (+ z x (*env* 'y)))) (hi 2 3)) 6)
+  (test (let ((y 1)) (define hi (elambda (x z) (if (= x z) (display "oops")) (+ z x (*env* 'y)))) (let ((y 12)) (hi 2 3))) 17)
+
+  (test (let ((vals #(0 0 0)))
+	  (define rx (rlambda ((a (+ c 1))) (+ a 2)))
+	  (set! (vals 0) (rx 5))
+	  (let ((c 3))
+	    (set! (vals 1) (rx))) ; error if lambda* not rlambda
+	  (let ((c 5))
+	    (set! (vals 2) (rx)))
+	  vals)
+	#(7 6 8))
+  (test (let ((x 3)) (define rx (rlambda ((a x)) (if (> a 0) (rx (- a 1)) 0))) (rx)) 0)
+  (test (let () (define rx (rlambda ((a x)) (if (> a 0) (let ((x (- x 1))) (rx)) 0))) (let ((x 3)) (rx))) 0)
+
+
+  (test (let ((a 1) (b 2)) (eval-case 1 ((a) 123) ((b) 321) (else 0))) 123)
+  (test (let ((a 1) (b 2) (c 3)) (eval-case 3 ((a c) 123) ((b) 321) (else 0))) 123)
+  (test (let ((a 1) (b 2)) (eval-case 3 ((a) 123) ((b) 321) (((+ a b)) -1) (else 0))) -1)
+  (test (let ((a 1) (b 2)) (eval-case 6 ((a (* (+ a 2) b)) 123) ((b) 321) (((+ a b)) -1) (else 0))) 123)
+  (test (let ((a 1) (b 2) (c 5)) (eval-case (set! c (+ c 1)) ((a (* (+ a 2) b)) 123) ((b) 321) (((+ a b)) -1) (else 0))) 123)
+  (test (let ((a 1) (b 2) (c 5)) (eval-case (set! c (+ c 1)) ((b) 321) ((+ a b) -1) ((a (* (+ a 2) b)) 123) (((+ a b)) -1) (else 0))) 123)
+
+  (test (linearize (circular-list 1 2 3)) '(1 2 3))
+  (test (linearize ()) ())
+  (test (linearize (let ((lst (list 1 2 3 4))) (set-cdr! (list-tail lst 3) (cdr lst)) lst)) '(1 2 3 4))
+
+  (test (flatten-let (with-let (inlet) (let ((x 1)) (curlet)))) (inlet 'x 1))
+  (test (flatten-let (with-let (inlet) (let ((x 1)) (let ((y 2)) (curlet))))) (inlet 'x 1 'y 2))
+
+  (test (clamp 1 0 3) 1)
+  (test (clamp 1 2 3) 2)
+  (test (clamp 1 4 3) 3)
+
+  (test (n-choose-k 4 4) 1)
+  (test (n-choose-k 4 3) 4)
+  (test (n-choose-k 4 2) 6)
+  (test (n-choose-k 4 1) 4)
+  (test (n-choose-k 4 0) 1)
+
+  (load "reactive.scm")
+  (test (let ((a 1) (b 2) (c 3)) (reactive-set! a (+ b c)) (set! b 4) (set! c 5) a) 9)
+  (test (let ((a 1) (b 2) (c 3)) (reactive-set! b (+ c 4)) (reactive-set! a (+ b c)) (set! c 5) a) 14)
+  (test (let ((expr 21) (symbol 1)) (reactive-set! expr (* symbol 2)) (set! symbol 3) expr) 6)
+  (test (let ((a 21) (b 1)) (reactive-set! a (* b 2)) (set! b 3) a) 6)
+  (test (let ((s 21) (v 1)) (reactive-set! s (* v 2)) (set! v 3) s) 6)
+  (test (let ((a 21) (v 1)) (reactive-set! a (* v 2)) (set! v 3) a) 6)
+  (test (let ((symbol 21) (nv 1)) (reactive-set! symbol (* nv 2)) (set! nv 3) symbol) 6)
+  (test (let ((outer 0)) (let ((nv 21) (sym 1)) (let ((inner 1)) (reactive-set! nv (* sym 2)) (set! sym 3) nv))) 6)
+  (test (let ((a 1) (b 2)) (reactive-set! b (+ a 4)) (let ((a 10)) (set! a (+ b 5)) (list a b))) '(10 5))
+  (test (let ((a 1) (b 2)) (reactive-set! b (+ a 4)) (list (let ((b 10)) (set! a (+ b 5)) a) b)) '(15 19))
+
+  (test (let ((a 1) (b 2) (c 3)) (reactive-set! b (+ c 4)) (let ((a 0)) (reactive-set! a (+ b c)) (set! c 5) a)) 14)
+  (test (let ((a 1) (b 2) (c 3)) (reactive-set! a (reactive-set! b (+ c 4))) (list a b c)) '(7 7 3))
+  (test (let ((a 1) (b 2) (c 3)) (reactive-set! a (+ 1 (reactive-set! b (+ c 4)))) (list a b c)) '(8 7 3))
+
+  (test (let ((a 1) (x 0)) (reactive-set! x (* a 2)) (reactive-set! a (* x 2)) (set! x 2) a) 4)
+  (test (let ((a 1)) (let ((b 0) (c 0)) (reactive-set! b (* a 2)) (reactive-set! c (* a 3)) (let ((x 0)) (reactive-set! x (+ a b c)) (set! a 2) x))) 12)
+  (test (let ((x 0)) (let ((a 1)) (reactive-set! x (* 2 a)) (set! a 2)) x) 4)
+
+  (test (let ((x 0) (a 1)) (reactive-set! x (+ a 1)) (reactive-set! a (+ x 2)) (set! a 3) (set! x 4) (list x a)) (list 4 6))
+  (test (let ((x 0) (a 1) (b 0)) (reactive-set! x (+ a 2)) (let ((x 2)) (reactive-set! x (+ a 1)) (set! a 4) (set! b x)) (list x a b)) (list 6 4 5))
+  (test (let ((x 0)) (reactive-set! x (* 3 2)) x) 6)
+  (test (let ((x 0)) (reactive-set! x (* pi 2)) x) (* pi 2))
+  (test (let ((x 0)) (let ((a 1)) (reactive-set! x a) (set! a 2)) x) 2)
+  (test (let ((a 21) (b 1)) (set! (setter 'b) (lambda (x y) (* 2 y))) (reactive-set! a (* b 2)) (set! b 3) a) 6) ; old setter ignored
+  (test (let ((a 21) (b 1)) (set! (setter 'b) (lambda (x y) (* 2 y))) (let ((b 2)) (reactive-set! a (* b 2)) (set! b 3) a)) 6)
+
+  (test (reactive-let () 3) 3)
+  (test (let ((a 1)) (reactive-let ((b (+ a 1))) b)) 2)
+  (test (let ((a 1)) (+ (reactive-let ((b (+ a 1))) (set! a 3) b) a)) 7)
+  (test (let ((a 1)) (+ (reactive-let ((b (+ a 1)) (a 0)) (set! a 3) b) a)) 3)
+  (test (let ((a 1)) (reactive-let ((a 2) (b (* a 3))) (set! a 3) b)) 3)
+  (test (let ((a 1) (b 2)) (reactive-let ((a (* b 2)) (b (* a 3))) (set! a 3) b)) 3)
+  (test (let ((a 1) (b 2)) (reactive-let ((a (* b 2)) (b (* a 3))) (set! b 3) a)) 4)
+  (test (let ((a 1) (b 2)) (reactive-let ((a (* b 2))) (set! b 3) a)) 6)
+  (test (let ((a 1)) (reactive-let ((b (+ a 1))) (set! a 3) b)) 4)
+  (test (let ((a 1)) (reactive-let ((b (+ a 1)) (c (* a 2))) (set! a 3) (+ c b))) 10)
+  (test (let ((a 1) (d 2)) (reactive-let ((b (+ a d)) (c (* a d)) (d 0)) (set! a 3) (+ b c))) 11)
+  ;(test (let ((a 1) (d 2)) (reactive-let ((b (+ a d)) (c (* a d)) (d 0)) (set! a 3)) (setter 'a)) #f)
+  (test (let ((a 1) (d 2)) (reactive-let ((b (+ a d)) (c (* a d)) (d 0)) (set! a 3) (set! d 12) (+ b c))) 11)
+  (test (let ((a 1) (b 2)) (+ (reactive-let ((b (+ a 1)) (c (* b 2))) (set! a 3) (+ b c)) a b)) 13)  ;c=4 because it watches the outer b
+  (test (let ((a 1)) (reactive-let ((b (* a 2))) (reactive-let ((c (* a 3))) (set! a 2) (+ b c)))) 10)
+  (test (let ((a 1)) (reactive-let ((b (* a 2))) (let ((d (reactive-let ((c (* a 3))) c))) (set! a 2) (+ b d)))) 7)
+  (test (let ((a 1)) (reactive-let ((b (* a 2))) (+ (reactive-let ((c (* a 3))) c) (set! a 2) b))) 9) ; a=2 is added to b=4 and c=3
+  (test (let ((a 1)) (reactive-let ((b (+ a 1))) (reactive-let ((c (* b 2))) (begin (set! a 3) (+ c b))))) 12)
+  (test (reactive-let ((a (lambda (b) b))) (a 1)) 1)
+  (test (reactive-let ((a (let ((b 1) (c 2)) (+ b c)))) a) 3)
+  (test (let ((b 1)) (reactive-let ((a (let ((b 1) (c 2)) (+ b c))) (c (* b 2))) (set! b 43) c)) 86)
+  (num-test (let ((x 0.0)) (reactive-let ((y (sin x))) (set! x 1.0) y)) (sin 1.0))
+  (test (let ((a 1)) (reactive-let ((b a) (c a)) (set! a 3) (list b c))) '(3 3))
+  (test (let ((a 1)) (reactive-let ((b a)) (reactive-let ((c (* b a))) (set! a 3) (list b c)))) '(3 9))
+  (test (let ((a 1) (b 2)) (reactive-let ((c a) (d (* b a))) (set! a 3) (list a b c d))) '(3 2 3 6))
+  (test (let ((a 1)) (reactive-let ((b (* a 2)) (c (* a 3)) (d (* a 4))) (set! a 2) (list a b c d))) '(2 4 6 8))
+  (test (let ((b 2)) (reactive-let ((a (* b 2))) (+ (reactive-let ((a (* b 3))) (set! b 3) a) a))) 15)
+
+  (test (let ((a 1)) (reactive-let* ((b a) (c (* b a))) (set! a 3) (list b c))) '(3 9))
+  (test (let ((a 1)) (reactive-let* ((b a) (x (+ a b))) (set! a 3) (list b x))) '(3 6))
+  (num-test (let ((x 0.0)) (reactive-let* ((y x) (z (* y (cos x)))) (set! x 1.0) z)) (cos 1.0))
+  (test (let ((a 1) (b 32)) (reactive-let* ((b a) (c (+ b 1))) c)) 2)
+
+#|
+  (let ((e (let ((a 1) (b 2)) (reactive-lambda* (s v) ((curlet) s)) (curlet)))) ; constant let
+    (test (set! (e 'a) 32) 1)
+    (set! (e 'b) 12)
+    (test (e 'b) 2)
+    (test (with-let e (set! a 32) a) 1))
+
+  (let ()
+    (define (make-library)
+      (let ((A 1.0)             ; define a library with 2 globals (A and B) and a function (f1)
+	    (B 2.0))
+	(reactive-lambda* (s v) ; make sure B is always twice A
+	  (case s
+	    ((A) (set! B (* 2 v)))
+	    ((B) (set! A (/ v 2))))
+	  v)
+	(define (f1 x)
+	  (+ A (* B x)))
+	(curlet)))
+    (with-let (make-library)
+      (num-test (f1 3.0) 7.0)
+      (set! A 3.0)
+      (num-test B 6.0)
+      (num-test (f1 3.0) 21.0)
+      (set! B 4.0)
+      (num-test (f1 3.0) 14.0)))
+|#
+  (let ((lst ()))
+    (call-with-input-vector
+     (vector 1 2 3 4)
+     (lambda (p)
+       (do ((i 0 (+ i 1)))
+	   ((= i 4))
+	 (set! lst (cons (read p) lst)))))
+    (test lst '(4 3 2 1)))
+
+  (test (call-with-output-vector
+	 (lambda (p)
+	   (do ((i 0 (+ i 1)))
+	       ((= i 4))
+	     (write (* i 2) p)
+	     (display (* i 4) p)
+	     (format p "~A" i))))
+	#(0 0 "0" 2 4 "1" 4 8 "2" 6 12 "3"))
+
+  (test (subsequence (list 1 2 3 4)) (list 1 2 3 4))
+  (test (subsequence (list 1 2 3 4) 1) (list 2 3 4))
+  (test (subsequence (list 1 2 3 4) 1 3) (list 2 3))
+  (test (subsequence (list 1 2 3 4) 3 3) ())
+  (test (subsequence #(1 2 3 4) 2) #(3 4))
+  (test (subsequence "1234" 1) "234")
+  (when with-block (test (subsequence (block .1 .2 .3 .4) 1 3) (block .2 .3)))
+  (let ((e (openlet (inlet 'value #(1 2 3 4)))))
+    (test (subsequence e 1 3) #(2 3))
+    (test (subsequence e 1) #(2 3 4))
+    (test (apply subsequence e ()) #(1 2 3 4))
+    (test (subsequence e) #(1 2 3 4)))
+  (when full-s7test
+    (test (pair? (member :heap-size (*s7*->list))) #t))
+
+  ;; sandbox
+  (test (sandbox '(+ 1 2)) 3)
+;  (test (sandbox '(let ((x (floor pi))) (+ x 1))) 4)
+;  (test (sandbox '(+ 1 x)) "error: 'x is unbound in (+ 1 x)") ; this now includes the file name and line number
+;  (test (sandbox '(let ((p (open-output-string))) (display (+ 2 3) p) (get-output-string p))) "5")
+  (test (sandbox '(begin (define-macro (_mx_ x) `(+ ,x 1)) (_mx_ 2))) 3)
+  (test (sandbox '(let ((_fx_ (lambda (x) (+ x 1)))) (_fx_ 2))) 3)
+
+  ;; *1*
+  (test (sandbox '(set! (*s7* 'autoloading?) #t)) #f)
+  (test (sandbox '(,file-exists? "lint.scm")) #f) ; unquote
+  (if (provided? 'snd) (test (sandbox '(set! *clm-srate* ())) #f))
+
+  ;; *2*
+  (test (sandbox `(eval '(+ 1 2))) #f)
+  (test (sandbox '(open-input-file "lint.scm")) #f)
+  (test (sandbox '(error (exit))) #f)
+  (test (sandbox '(error)) "error: error: not enough arguments: (error)")
+  (test (sandbox '(exit)) #f)
+  (test (sandbox '(begin (define-macro (mx x) `(,file-exists? ,x)) (mx "lint.scm"))) #f)
+  (test (sandbox '(begin (define-macro (mx x) `(,(symbol "file" "-exists?") ,x)) (mx "lint.scm"))) #f)
+  (test (let ((fx exit)) (sandbox '(fx))) "error: unbound variable fx in (fx)")
+  (test (sandbox '(let ((_fxex_ exit)) (_fxex_))) #f)
+  (test (sandbox '((symbol->value 'exit))) #f)
+  ;(begin (define _fxit_ exit) (test (sandbox '(_fxit_)) #f)) ; or4 unbound var in this context
+  (test (sandbox '(begin (define-macro (_mx_ x) `(,(string->symbol "file-exists?") ,x)) (_mx_ "lint.scm"))) #f)
+  (test (sandbox '(begin (set! baddies ()) (let ((abs #_exit)) (abs 1)))) #f)
+
+  ;; *3*
+  (test (let-temporarily ((abs exit)) (sandbox '(abs 1))) #f)
+
+  ;; *4*
+  (test (sandbox '(let ((abs #_exit)) (abs 1))) #f)
+  (test (sandbox '(begin (define-macro (mx x) `(#_file-exists? ,x)) (mx "lint.scm"))) #f)
+
+
+  (test (cdr-assoc 'a '((a . 1) (b . 2))) 1)
+  (test (cdr-assoc 'c '((a . 1) (b . 2))) #f)
+  (test (cdr-assoc 'c ()) #f)
+  (test (adjoin 'a ()) '(a))
+  (test (adjoin 'a '(a)) '(a))
+  (test (adjoin 'a '(b a c)) '(b a c))
+  (test (adjoin 'a '(b c)) '(a b c)))
+
+(let ()
+  (require write.scm)
+  (define (ppc obj) (pp obj))
+  (test (let ((i 3)) (ppc i)) "3")
+
+  (if (not (string=? (pp '(lambda* (a b) (+ a b) (* 1 2))) "(lambda* (a b)\n  (+ a b)\n  (* 1 2))"))
+      (format *stderr* "pp 1~%"))
+  (if (not (string=? (pp '(let ((a 1) (b 2)) (+ a b))) "(let ((a 1)\n      (b 2))\n  (+ a b))"))
+      (format *stderr* "pp 2~%"))
+  (if (not (string=? (pp '(let () (+ a b))) "(let ()\n  (+ a b))"))
+      (format *stderr* "pp 2a~%"))
+  (if (not (string=? (pp '(begin (+ 1 2) (* 2 3))) "(begin\n  (+ 1 2)\n  (* 2 3))"))
+      (format *stderr* "pp 3~%"))
+  (if (not (string=? (pp '(case a ((a b c) 1) ((d) 2) (else 3))) "(case a\n  ((a b c) 1)\n  ((d) 2)\n  (else 3))"))
+      (format *stderr* "pp 4: ~A~%" (pp '(case a ((a b c) 1) ((d) 2) (else 3)))))
+  (if (not (string=? (pp '(cond ((> a 1) 2) ((< a 3) 3) (#t 4))) "(cond ((> a 1) 2)\n      ((< a 3) 3)\n      (#t 4))"))
+      (format *stderr* "pp 5~%"))
+  (if (not (string=? (pp '(catch 'x (lambda () 32) (lambda args 'error))) "(catch 'x\n  (lambda ()\n    32)\n  (lambda args\n    'error))"))
+      (format *stderr* "pp 6~%"))
+  (if (not (string=? (pp '(if a '(1 2 3))) "(if a '(1 2 3))"))
+      (format *stderr* "pp7~%"))
+  (if (not (= ((funclet pretty-print) '*pretty-print-length*) 100))
+      (format *stderr* "*pretty-print-length*: ~A~%" ((funclet pretty-print) '*pretty-print-length*)))
+  (if (not (= ((funclet pretty-print) '*pretty-print-spacing*) 2))
+      (format *stderr* "*pretty-print-spacing*: ~A~%" ((funclet pretty-print) '*pretty-print-spacing*)))
+  (if (not (string=? (pp '(+ pi +nan.0 1.123456)) "(+ pi +nan.0 1.123456)"))
+      (format *stderr* "pp8~%"))
+  (if (not (string=? (pp 3.1415123123213) "3.1415"))
+      (format *stderr* "pp9: ~A~%" (pp 3.1415123123213)))
+  (let-temporarily ((((funclet pretty-print) '*pretty-print-float-format*) "~,12F"))
+    (if (not (string=? (pp 3.1415123123213) "3.141512312321"))
+	(format *stderr* "pp10: ~A~%" (pp 3.1415123123213))))
+  ;(set! ((funclet pretty-print) '*pretty-print-spacing*) 8)
+  (let-temporarily ((((funclet pretty-print) '*pretty-print-spacing*) 8))
+    (if (not (string=? (pp '(let () (+ a b))) "(let ()\n        (+ a b))"))
+        (format *stderr* "pp 11~%")))
+  (if (not (string-wi=? (pp (let ((<1> (hash-table))) (set! (<1> 'a) <1>) <1>)) "(let ((<1> (hash-table)))\n  (set! (<1> 'a) <1>)\n  <1>)\n"))
+      (format *stderr* "pp cyclic hash: ~S\n" (pp (let ((<1> (hash-table))) (set! (<1> 'a) <1>) <1>))))
+  (let ((lt (openlet (inlet 'pretty-print (lambda* (obj port (col 0))
+					    (display "(special-inlet)" port))))))
+    (test (with-output-to-string (lambda () (pretty-print lt))) "(special-inlet)"))
+
+  (test (let () (define (func) (let ((x #f) (i 0)) (list (values (ldb 0+1e18i `((x 1))) (block-ref (documentation)))))) (define (hi) (func)) (hi)) 'error) ;safe_closure_aa_a bug
+  (if (not (= ((funclet pretty-print) '*pretty-print-spacing*) 2))
+      (format *stderr* "*pretty-print-spacing*: ~A~%" ((funclet pretty-print) '*pretty-print-spacing*)))
+
+  (test (pretty-print (hash-table 'a 2.0) (open-output-function (lambda (a) (values a (+ a 1))))) 'error) ; test of function output char mv check
+  (let () ; op_safe_c_sp_mv followed later by cdr of value picking up uncleared mv bit
+    (define (_f8_ x) (let-temporarily ((x (+ x 1))) (values x x)))
+    (define (func) (let ((x #f)) (do ((i 0 (+ i 1))) ((= i 1)) (pretty-print (list-values #t (_f8_ 1)) #f))))
+    (test (func) #t)) ; #t = do loop value
+
+  (test (pp (list #_if (list '> 3 2) #_case abs)) "(#_if (> 3 2) #_case abs)")
+  (test (pp (list #_set! 'sym 32)) "(#_set! sym 32)")
+  (test (pp (list 'set! 'sym 32)) "(set! sym 32)")
+  (test (string-wi=? (pp (list #_catch #t (list #_lambda () (list 'abs 'x)) (list #_lambda (list 'type 'info) #f)))
+                     "(#_catch #t (#_lambda () (abs x)) (#_lambda (type info) #f))") #t)
+  (test (string-wi=? (pp (list '#_define 'x 32)) "(#_define x 32)") #t)
+  (test (string-wi=? (pp (list 'define 'x 32)) "(define x 32)") #t)
+  (test (string-wi=? (pp (list #_unless (list '< 2 1) (list 'display 'ok) #f)) "(#_unless (< 2 1) (display ok) #f)") #t)
+  (test (string-wi=? (pp (list 'when (list '< 2 1) (list 'display 'ok))) "(when (< 2 1) (display ok))") #t)
+  (test (string-wi=? (pp (list #_letrec (list (list 'i 32) (list 'j 12)) (list '+ 'i 'j))) "(#_letrec ((i 32) (j 12)) (+ i j))") #t)
+  (test (string-wi=? (pp (list #_let* 'loop (list (list 'i 10) (list 'j 12)) (list '+ 'i 'j))) "(#_let* loop ((i 10) (j 12)) (+ i j))") #t)
+  (test (string-wi=? (pp (list #_and (list 'or #t) #f)) "(#_and (or #t) #f)") #t)
+  )
+
+(let ()
+  (require r7rs.scm)
+
+   ;;; boolean=?
+  (test (boolean=? #f #f) #t)
+  (test (boolean=? #f #t) #f)
+  (test (boolean=? #f #f #f) #t)
+  (test (boolean=? #t #t) #t)
+  (test (boolean=? #f #f #t #f) #f)
+  (test (boolean=? #f (values) #f) #f)
+  (test (boolean=? 1 #t) #f)
+					;(test (boolean=?) 'error)
+					;(test (boolean=? #f) 'error)
+  (for-each
+   (lambda (arg)
+     (if (boolean=? #f arg)
+	 (format #t ";(boolean=? #f ~A) -> #t?~%" arg)))
+   (list "hi" '(1 2) () "" #() (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+	 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi (if #f #f) #<eof> #<undefined> #<unspecified>))
+
+  (test (boolean=? #f #false) #t)
+  (test (boolean=? #t #true) #t)
+
+   ;;; symbol=?
+  (test (symbol=? 'hi 'hi) #t)
+  (test (symbol=? 'hi 'hi 'hi) #t)
+  (test (symbol=? 'hi 'hi 'ho) #f)
+  (test (symbol=? 'hi 'hi pi) #f)
+  (test (symbol=? #f 'hi) #f)
+  (for-each
+   (lambda (arg)
+     (if (symbol=? 'abs arg)
+	 (format #t ";(symbol=? 'abs ~A) -> #t?~%" arg)))
+   (list "hi" (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+	 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) #<eof> #<undefined>))
+					;(test (symbol=?) 'error)
+					;(test (symbol=? 'hi) 'error)
+  (test (symbol=? :hi :hi) #t)
+  (test (symbol=? :hi hi:) #f)
+
+  (let ()
+    (test (provided? 'locals) #f)
+    (provide 'locals)
+    (test (provided? 'locals) #t)
+    (test (pair? (memq 'locals (features))) #t)
+    (test (pair? (memq 'locals *features*)) #t)
+    (test (equal? (features) *features*) #t))
+  (test (memq 'locals (features)) #f)
+  (test (equal? (features) *features*) #t)
+
+  ;; from chibi scheme I think
+  (let*-values (((root rem) (exact-integer-sqrt 32)))
+    (test (* root rem) 35))
+  (test (let ((a 'a) (b 'b) (x 'x) (y 'y))
+	  (let*-values (((a b) (values x y))
+			((x y) (values a b)))
+	    (list a b x y)))
+	'(x y x y))
+
+  (test (force (r7rs-delay (+ 1 2))) 3)
+  (test (let ((p (r7rs-delay (+ 1 2)))) (list (force p) (force p))) '(3 3))
+  (let ()
+    (define integers
+      (letrec ((next
+		(lambda (n)
+		  (r7rs-delay (cons n (next (+ n 1)))))))
+	(next 0)))
+    (define head (lambda (stream) (car (force stream))))
+    (define tail (lambda (stream) (cdr (force stream))))
+    (test (head (tail (tail integers))) 2)
+
+    (define (stream-filter p? s)
+      (delay-force
+       (if (null? (force s))
+	   (r7rs-delay '())
+	   (let ((h (car (force s)))
+		 (t (cdr (force s))))
+	     (if (p? h)
+		 (r7rs-delay (cons h (stream-filter p? t)))
+		 (stream-filter p? t))))))
+    (test (head (tail (tail (stream-filter odd? integers)))) 5))
+
+  (let ()
+    (define radix (make-parameter 10 (lambda (x) (if (and (integer? x) (<= 2 x 16)) x (error 'wrong-type-arg "invalid radix")))))
+    (define (f n) (number->string n (radix)))
+    (test (f 12) "12")
+    (test (parameterize ((radix 2)) (f 12)) "1100")
+    (test (f 12) "12"))
+
+  (let ()
+    (define plus
+      (case-lambda
+       (() 0)
+       ((x) x)
+       ((x y) (+ x y))
+       ((x y z) (+ (+ x y) z))
+       (args (apply + args))))
+    (test (plus) 0)
+    (test (plus 1) 1)
+    (test (plus 1 2) 3)
+    (test (plus 1 2 3) 6)
+    (test (plus 1 2 3 4) 10)
+
+    (define mult
+      (case-lambda
+       (() 1)
+       ((x) x)
+       ((x y) (* x y))
+       ((x y . z) (apply mult (* x y) z))))
+    (test (mult) 1)
+    (test (mult 1) 1)
+    (test (mult 1 2) 2)
+    (test (mult 1 2 3) 6)
+    (test (mult 1 2 3 4) 24))
+
+  (test (let () (define-values (x y) (values 1 2)) (+ x y)) 3)
+  ;; from Guile:
+  (test (let () (define-values () (values)) #f) #f) ; just avoid dumb error
+  (test (let () (define-values (x) 1) x) 1)
+  (test (let () (define-values (x y) (values 2 3)) (+ x y)) 5)
+  (test (let () (define-values (x y z) (values 4 5 6)) (+ x y z)) 15)
+  (test (let () (define-values (x . y) (values 'a 'b 'c 'd)) (list x y)) '(a (b c d)))
+  (test (let () (define-values (x y . z) (values 'x 'y 'z 'w)) (list x y z)) '(x y (z w)))
+  (test (let () (define-values x (values 1 2 3)) x) '(1 2 3))
+
+  (test (call-with-values (lambda () (exact-integer-sqrt 4)) list) '(2 0))
+  (test (call-with-values (lambda () (exact-integer-sqrt 5)) list) '(2 1))
+
+  (test (let-values (((x) (values 1))) x) 1)
+  (test (let-values ((x (values 1))) x) '(1))
+  (test (let-values (((x) (values 1)) ((y) (values 2))) (list x y)) '(1 2))
+  (test (let ((x 32)) (let-values (((x) (values 1)) ((y) (values (+ x 1)))) (list x y))) '(1 33))
+  (test (let-values (((x y) (values 1 2))) (list x y)) '(1 2))
+  (test (let ((d 32)) (let-values (((a) 1) ((c d e) (values 3 4 5)) ((b) d)) (+ a b (* c d e))))
+	(let ((d 32))
+	  (with-let (apply sublet (curlet)
+			   (list ((lambda (a) (values :a a)) 1)
+				 ((lambda (c d e) (values :c c :d d :e e)) (values 3 4 5))
+				 ((lambda (b) (values :b b)) d))) (+ a b (* c d e)))))
+  (test (let ((a 32) (b -1)) (let-values (((a b) (values 1 2)) ((x y) (values a b))) (list a b x y)))
+	(let ((a 32) (b -1))
+	  (with-let (apply sublet (curlet)
+			   (list ((lambda (a b) (values :a a :b b)) (values 1 2))
+				 ((lambda (x y) (values :x x :y y)) (values a b))))
+	    (list a b x y))))
+  (test (let ((a 1)) (let ((b (let-values (((a . b) (values 2 3)) (c (begin (set! a 9) 4))) (list a b c)))) (cons a b))) '(9 2 (3) (4)))
+  (test (let* ((a 1) (b (let-values (((a . b) (values 2 3)) (c (begin (set! a 9) 4))) (list a b c)))) (cons a b)) '(9 2 (3) (4)))
+  (test (let-values (((a b c) (values 1 2 3)) ((d . e) (values 4 5))) (list a b c d e)) '(1 2 3 4 (5)))
+  (test (let-values (((a b c) (values 1 2 3)) ((d . e) (values 4 5 6))) (list a b c d e)) '(1 2 3 4 (5 6)))
+  ;; a=1 here, so use aa
+  (test (let-values (((aa b) (values 1 2)) ((c d) (values aa 4))) (+ aa b c d)) 'error) ; 'a not in scope
+
+  (let () ; from bug-guile
+    (define* (newton-sqrt x (tolerance 0.001) (guess 1))
+      (if (< (abs (- x (* guess guess))) tolerance)
+          (values guess (abs (- x (* guess guess))) tolerance)
+          (newton-sqrt x tolerance (/ (+ guess (/ x guess)) 2))))
+
+    (let-values (((root diff tolerance) (newton-sqrt 1000)))
+      (num-test (exact->inexact diff) 3.6992436605487455e-4)
+      (test tolerance 0.001)
+      (test (< diff tolerance) #t)
+      (test (< diff (inexact->exact tolerance)) #t)
+      (test (< (exact->inexact diff) tolerance) #t)))
+
+  (test (let*-values (((x) (values 1))) x) 1)
+  (test (let*-values ((x (values 1))) x) '(1))
+  (test (let*-values (((x) (values 1)) ((y) (values 2))) (list x y)) '(1 2))
+  (test (let*-values (((x) (values 1)) ((y) (values (+ x 1)))) (list x y)) '(1 2))
+  (test (let*-values (((x y) (values 1 2))) (list x y)) '(1 2))
+  (test (let*-values (((a) 1) ((c d e) (values 3 4 5)) ((b) d)) (+ a b (* c d e)))
+	(let ((a 1)) ((lambda (c d e) (let ((b d)) (+ a b (* c d e)))) (values 3 4 5))))
+  (test (let*-values (((a b) (values 1 2)) ((x y) (values a b))) (list a b x y))
+	((lambda (a b) ((lambda (x y) (list a b x y)) (values a b))) (values 1 2)))
+  (test (let ((a 1)) (let ((b (let*-values (((a . b) (values 2 3)) (c (begin (set! a 9) 4))) (list a b c)))) (cons a b))) '(1 9 (3) (4)))
+  (test (let* ((a 1) (b (let*-values (((a . b) (values 2 3)) (c (begin (set! a 9) 4))) (list a b c)))) (cons a b)) '(1 9 (3) (4)))
+
+  (test (vector-copy #()) #())
+  (test (vector-copy #(a b c)) #(a b c))
+  (test (vector-copy #(a b c) 1) #(b c))
+  (test (vector-copy #(a b c) 1 2) #(b))
+
+  (let ((e (box 1)))
+    (test (box? e) #t)
+    (test (unbox e) 1)
+    (test (e 'value) 1)
+    (set-box! e 2)
+    (test (unbox e) 2))
+
+  (let () ; R Adamkovic
+    (define-record-type <proxy> (make-proxy type) proxy? (type proxy-type))
+    (let ((proxies (list (make-proxy 'one)
+                         (make-proxy 'two))))
+    (test (proxy-type (list-ref proxies 0)) 'one)
+    (test (proxy-type (list-ref proxies 1)) 'two)
+    (test (proxy? (list-ref proxies 0)) #t)
+    (test (proxy? (list-ref proxies 1)) #t)))
+
+  ;; from bug-guile
+  (let ()
+    (define (x y) (foo y))
+    (define-record-type q (make-q foo) q? (foo foo))
+    (test (x (make-q "1")) "1"))
+  )
+
+
+;;; -------------------------------- debug.scm --------------------------------
+(unless (or with-windows (positive? (*s7* 'profile)))
+  (require debug.scm)
+
+  (let ()
+  (define (string-wid=? s1 s2) ; ignore white-space and after ;
+    (let-temporarily (((*s7* 'debug) 1))
+      (let ((iter1 (make-iterator s1))
+	    (iter2 (make-iterator s2)))
+	(let wi-loop ((i1 (iterate iter1)) (i2 (iterate iter2)))
+	  (cond ((eq? i1 #\;)
+		 (let bloop ((c (iterate iter1)))
+		   (if (eq? c #<eof>)
+		       (error 'missing-newline "can't find end of comment")
+		       (if (char=? c #\newline)
+			   (wi-loop (iterate iter1) i2)
+			   (bloop (iterate iter1))))))
+
+		((eq? i2 #\;)
+		 (let bloop ((c (iterate iter2)))
+		   (if (eq? c #<eof>)
+		       (error 'missing-newline "can't find end of comment")
+		       (if (char=? c #\newline)
+			   (wi-loop i1 (iterate iter2))
+			   (bloop (iterate iter2))))))
+
+		((eq? i1 i2)
+		 (or (eq? i1 #<eof>)
+		     (wi-loop (iterate iter1) (iterate iter2))))
+
+		((and (char? i1)
+		      (char-whitespace? i1))
+		 (wi-loop (iterate iter1) i2))
+
+		(else
+		 (and (char? i2)
+		      (char-whitespace? i2)
+		      (wi-loop i1 (iterate iter2)))))))))
+
+  (define-macro (db-test test expected)
+    `(let-temporarily (((*s7* 'debug) 1))
+       (let ((result (call-with-output-string
+		      (lambda (p)
+			(let-temporarily (((debug-port) p))
+			  ,test)))))
+	 (unless (string-wid=? result ,expected)
+	   (format *stderr* "~S -> ~S~%" ',test result)))))
+
+  (define (g1 a) (+ a 1))
+  (define (g2 b) (g1 (+ b 1)))
+  (define (g3 c) (g2 (+ c 1)))
+
+
+  (set! ((funclet trace-in) '*debug-max-spaces*) 40)
+
+  (set! (*s7* 'debug) 2)
+  (define (g l1 l2) (car l1))
+  (db-test (g '(1 2 3) '(4 5)) "(g (quote (1 2 3)) (quote (4 5)))    ; g: s7test.scm[49] called from s7test.scm[50]\n  -> 1")
+
+  (unless (string=? (object->string (procedure-source g)) "(lambda (l1 l2) (trace-in (curlet)) (car l1))")
+    (format *stderr* "source g: ~S~%" (procedure-source g)))
+
+  (set! (*s7* 'debug) 1)
+  (define (h)
+    (let-temporarily (((*s7* 'debug) 3))
+      (for-each (lambda (x)
+		  (+ x 1)) ; this fools (*function* (curlet)) -- 'h
+		(list 1 2))))
+  (trace h)
+  (db-test (h)
+"(h)    ; h: s7test.scm[90932] called from line 91217?
+  -> #<unspecified>")
+
+  (set! (debug-stack) (make-vector 64 #f))
+
+  (set! (*s7* 'debug) 2)
+  (define (factorial n)
+    (if (<= n 1)
+	1
+	(begin
+	  (show-debug-stack)
+	  (let ((f (factorial (- n 1))))
+	    (* n f)))))
+
+  (db-test (factorial 4) "(factorial 4)    ; factorial: s7test.scm[74] called from s7test.scm[82]
+  stack:
+    (factorial 4)
+
+  (factorial 3)    ; factorial: s7test.scm[74] called from s7test.scm[82]
+    stack:
+      (factorial 4)
+      (factorial 3)
+
+    (factorial 2)    ; factorial: s7test.scm[74] called from s7test.scm[82]
+      stack:
+        (factorial 4)
+        (factorial 3)
+        (factorial 2)
+
+      (factorial 1)    ; factorial: s7test.scm[74] called from s7test.scm[82]
+        -> 1
+      -> 2
+    -> 6
+  -> 24")
+
+
+  (define-macro (mac x) `(+ ,x 1))
+					;(display (object->string mac)) (newline)
+
+  (db-test (mac (+ 2 3)) "(mac (+ 2 3))    ; mac: s7test.scm[107] called from s7test.scm[110]
+  -> (+ (+ 2 3) 1)")
+
+
+  (set! (*s7* 'debug) 3)
+  (define sf (let ((object->string (lambda (obj . arg)
+				     "#<secret function!>")))
+	       (openlet (lambda (x)
+			  (+ x 1)))))
+  (db-test (object->string sf) "(_ sf ())    ; called from s7test.scm[124]
+  -> \"#<secret function!>\"")
+
+  (set! (*s7* 'debug) 1)
+
+  (define lt (inlet 'func (define (func x) (+ x 1))))
+  (trace (lt 'func))
+  (db-test ((lt 'func) 3) "(func 3)    ; func: s7test.scm[132] called from s7test.scm[133]
+  -> 4")
+
+  (define lt1 (let ()
+		(define (func1 y) (* y 2))
+		(curlet)))
+  (trace (with-let lt1 func1))
+  (db-test ((with-let lt1 func1) 4) "(func1 4)    ; func1: s7test.scm[140] called from s7test.scm[142]
+  -> 8")
+
+  (define func2 (dilambda (lambda (x) (+ x 1)) (lambda (x y) (* x y))))
+  (db-test (func2 3) "")
+  (db-test (set! (func2 3) 4) "")
+  (trace func2)
+  (db-test (func2 3) "(func2 3)    ; func2: s7test.scm[150] called from s7test.scm[152]
+  -> 4")
+  (db-test (set! (func2 3) 4) "")
+
+  (define ht (hash-table 'a (inlet 'func3 (define (func3 z) (- z 1)))))
+  (db-test (((ht 'a) 'func3) 3) "")
+  (trace ((ht 'a) 'func3))
+  (db-test (((ht 'a) 'func3) 4) "(func3 4)    ; func3: s7test.scm[161] called from s7test.scm[163]
+  -> 3")
+
+  (trace abs)
+  (db-test (abs -23) "(abs -23)    ; abs: s7test.scm[165] called from s7test.scm[167]
+  -> 23")
+
+  (define v (make-vector 3 #f))
+  (set! (vector-ref v 2) 3)
+  (db-test v "")
+  (trace vector-ref)
+  (db-test (vector-ref v 0) "(vector-ref #(#f #f 3) 0)    ; vector-ref: s7test.scm[164] called from s7test.scm[165]
+  -> #f")
+  (set! (vector-ref v 1) 2)
+  (unless (equal? v #(#f 2 3)) (format *stderr* "v: ~S~%" v))
+
+  (trace g1)
+  (db-test (g3 2) "(g1 4)    ; g1: s7test.scm[169] called from s7test.scm[170]
+  -> 5")
+
+					;(set! (*s7* 'debug) 3)
+
+
+  (define (f) (let-temporarily (((*s7* 'debug) 3)) (for-each (lambda (x) x) (list 1 2 3))))
+  (trace f)
+  (db-test (f) "(f)    ; f: s7test.scm[91037] called from line 91207?
+  -> #<unspecified>")
+
+  (set! (*s7* 'debug) 1)
+
+  (define func5 (dilambda (lambda (a) a)
+			  (lambda (a b) (* a b))))
+  (trace (setter func5))
+  (db-test (set! (func5 6) 3) "(_ 6 3)    ; _: s7test.scm[194] called from s7test.scm[195]
+  -> 18")
+  (db-test (func5 3) "")
+
+  (define* (func6 a (b 3)) (+ a b))
+  (trace func6)
+  (db-test (func6 2) "(func6 2 3)    ; func6: s7test.scm[200] called from s7test.scm[201]
+  -> 5")
+  (db-test (func6 :b 3 :a 2) "(func6 2 3)    ; func6: s7test.scm[200] called from s7test.scm[202]
+  -> 5")
+
+  (define (func7 . args) (apply + args))
+  (trace func7)
+  (db-test (func7 1 2 3) "(func7 1 2 3)    ; func7: s7test.scm[207] called from s7test.scm[208]
+  -> 6")
+
+  (define (func8 a . b) (cons a b))
+  (trace func8)
+  (db-test (func8 1 2 3) "(func8 1 2 3)    ; func8: s7test.scm[212] called from s7test.scm[213]
+  -> (1 2 3)")
+  (db-test (func8 '(1 4) 2 3) "(func8 (quote (1 4)) 2 3)    ; func8: s7test.scm[212] called from s7test.scm[214]
+  -> ((1 4) 2 3)")
+
+  (define func9 (let ((local 0)) (lambda (x) (set! local (+ local 1)) (+ local x))))
+  (trace func9)
+  (db-test (func9 2) "(func9 2)    ; func9: s7test.scm[219] called from s7test.scm[220]
+  -> 3")
+  (db-test (func9 2) "(func9 2)    ; func9: s7test.scm[219] called from s7test.scm[221]
+  -> 4")
+
+
+  (define-macro (mac1 x) `(+ ,x 1))
+  (trace mac1)
+  (db-test (mac1 2) "(mac1 2)    ; called from s7test.scm[228]
+  -> (+ 2 1)")
+
+  (define* (func11 a (b 1)) (+ a b))
+  (trace func11)
+  (db-test (func11 2) "(func11 2 1)    ; func11: s7test.scm[232] called from s7test.scm[233]
+  -> 3")
+  (db-test (func11 2 3) "(func11 2 3)    ; func11: s7test.scm[232] called from s7test.scm[234]
+  -> 5")
+
+  (define-macro* (mac3 a (b 1)) `(+ ,a ,b))
+  (trace mac3)
+  (db-test (mac3 2) "(mac3 2 1)    ; called from s7test.scm[241]
+  -> (+ 2 1)")
+  (db-test (mac3 2 3) "(mac3 2 3)    ; called from s7test.scm[242]
+  -> (+ 2 3)")
+
+  (define mac4 (macro (x) `(+ ,x 1)))
+  (trace mac4)
+  (db-test (mac4 3) "(mac4 3)    ; called from s7test.scm[247]
+  -> (+ 3 1)")
+
+
+  (untrace abs)
+  (db-test (abs -24) "")
+
+  (untrace g1)
+  (db-test (g3 2) "")
+
+  (untrace vector-ref)
+  (db-test (set! (vector-ref v 1) 2) "")
+
+  (untrace (setter func5))
+  (db-test (set! (func5 6) 3) "")
+
+  (untrace (lt 'func))
+  (db-test ((lt 'func) 3) "")
+
+  (untrace (with-let lt1 func1))
+  (db-test ((with-let lt1 func1) 4) "")
+
+  (untrace func2)
+  (db-test (func2 3) "")
+  (db-test (set! (func2 3) 4) "")
+
+  (untrace ((ht 'a) 'func3))
+  (db-test (((ht 'a) 'func3) 4) "")
+
+  (untrace func6)
+  (db-test (func6 2) "")
+  (db-test (func6 :b 3 :a 2) "")
+
+  (untrace func7)
+  (db-test (func7 1 2 3) "")
+
+  (untrace func8)
+  (db-test (func8 1 2 3) "")
+
+  (untrace func9)
+  (db-test (func9 2) "")
+  (db-test (func9 2) "")
+
+  (untrace mac1)
+  (db-test (mac1 2) "")
+
+  (untrace func11)
+  (db-test (func11 2 3) "")
+
+  (untrace mac3)
+  (db-test (mac3 2) "")
+
+
+  (define var1 32)
+  (watch var1)
+  (db-test (set! var1 12) "var1 set! to 12")
+  (unwatch var1)
+  (db-test (set! var1 10) "")
+
+  (let ((var2 10))
+    (watch var2)
+    (db-test (set! var2 12) "var2 set! to 12")
+    (unwatch var2)
+    (db-test (set! var2 10) ""))
+
+  (let ((lt (inlet 'var3 1)))
+    (watch (lt 'var3))
+    (db-test (let-set! lt 'var3 12) "var3 set! to 12")
+    (db-test (with-let lt (set! var3 12)) "var3 set! to 12")
+    (unwatch (lt 'var3))
+    (db-test (let-set! lt 'var3 10) "")
+    (db-test (with-let lt (set! var3 10)) ""))
+
+  (let ((ht (hash-table 'lt (inlet 'var4 1))))
+    (watch ((ht 'lt) 'var4))
+    (db-test (set! ((ht 'lt) 'var4) 12) "var4 set! to 12")
+    (unwatch ((ht 'lt) 'var4))
+    (db-test (set! ((ht 'lt) 'var4) 10) ""))
+
+  (define var5 3)
+  (set! (setter 'var5) (lambda (s v) (* v 2)))
+  (db-test (set! var5 4) "")
+  (watch var5)
+  (db-test (set! var5 5) "var5 set! to 5")
+  (unwatch var5)
+  (db-test (set! var5 6) "")
+
+  (unless with-bignums
+    (define (gerr x) (+ x "sa"))
+    (trace gerr)
+    (db-test (catch #t
+	     (lambda ()
+	       (gerr 3))
+	     (lambda (type info)
+	       (apply format (debug-port) info)))
+	   "(gerr 3)    ; gerr: s7test.scm[342] called from s7test.scm[348]
+          + second argument, \"sa\", is a string but should be a number"))
+  (unless (= ((funclet trace-in) '*debug-spaces*) 0)
+    (format *stderr* "spaces: ~S~%" ((funclet trace-in) '*debug-spaces*)))
+
+  (define (gmv x y)
+    (values x y))
+  (trace gmv)
+  (define (cgmv)
+    (list (gmv 1 2)))
+  (db-test (cgmv) "(gmv 1 2)    ; gmv: s7test.scm[401] called from s7test.scm[401]
+  -> (values 1 2)")
+
+  ))
+;;; end debug.scm
+
+;;; -------------------------------- profile.scm --------------------------------
+(let ()
+  (let-temporarily (((*s7* 'profile) 1))
+    (define (g1 x)
+      x)
+    (define (f)
+      (do ((i 0 (+ i 1)))
+	  ((= i 10))
+	(g1 i)))
+    (f)
+    (let ((str (call-with-output-string
+		(lambda (p)
+		  (let-temporarily (((profile-port) p))
+                    (show-profile))))))
+      (clear-profile)
+      (let ((pos (string-position "cells" str))) ; cells allocated changes
+        (set! str (substring str 0 pos)))
+      (test (string-wi=? str "info:  f:  calls 1, time 0.0000  0.0000  g1: calls 10, time 0.0000 0.0000") #t))
+
+    (define (g2 x)
+      (+ x 1))
+    (define (g3 x)
+      (+ (g2 x) 1))
+    (define (g4 x)
+      (+ (g3 x) 1))
+    (define (f1)
+      (do ((i 0 (+ i 1)))
+	  ((= i 3))
+	(g4 (- i 1))))
+    (f1)
+    (let ((str (call-with-output-string
+		(lambda (p)
+		  (let-temporarily (((profile-port) p))
+ 		    (show-profile))))))
+      (clear-profile)
+      (let ((pos (string-position "cells" str)))
+        (set! str (substring str 0 pos)))
+      (test (string-wi=? str "info:  f1: calls 1, time 0.0000  0.0000  g4: calls 3, time 0.0000  0.0000
+                               g3: calls 3, time 0.0000  0.0000  g2: calls 3, time 0.0000  0.0000") #t))))
+
+
+;;; --------------------------------------------------------------------------------
+;;;
+;;; cload c-define tests
+;;;   (see libc.scm et al below)
+
+(when (provided? 'snd)
+  (load "cload.scm")
+
+  (c-define '((double j0 (double))
+	      (double j1 (double))
+	      (double erf (double))
+	      (double erfc (double))
+	      (double lgamma (double)))
+	    "m" "math.h")
+  (num-test (m:j0 1.0) 0.76519768655797)
+  (num-test (m:j1 1.0) 0.44005058574493)
+  (num-test (m:j0 1/2) 0.93846980724081)
+  (num-test (m:erf 1.0) 0.84270079294971)
+  (num-test (m:erf 2) 0.99532226501895)
+  (num-test (m:erfc 1.0) 0.15729920705029)
+  (num-test (m:lgamma 2/3) 0.30315027514752)
+
+  (let ()
+    (c-define '(char* getenv (char*)))
+    (c-define '(int setenv (char* char* int)))
+    (test (string? (getenv "HOST")) #t))
+
+  (test (defined? 'setenv) #f)
+
+  (let ()
+    (define local-file-exists? (let () ; define F_OK and access only within this let
+				 (c-define '((int F_OK) (int access (char* int))) "" "unistd.h")
+				 (lambda (arg) (= (access arg F_OK) 0))))
+
+    (define delete-file (let ()
+			  (c-define '(int unlink (char*)) "" "unistd.h")
+			  (lambda (file) (= (unlink file) 0)))) ; 0=success
+
+    (test (local-file-exists? "s7test.scm") #t))
+
+  (c-define
+   '((in-C "static struct timeval overall_start_time;  \n\
+           static bool time_set_up = false;           \n\
+           static double get_internal_real_time(void) \n\
+           {                                          \n\
+            struct timezone z0;                       \n\
+            struct timeval t0;                        \n\
+            double secs;                              \n\
+            if (!time_set_up) {gettimeofday(&overall_start_time, &z0); time_set_up = true;} \n\
+            gettimeofday(&t0, &z0);                   \n\
+            secs = difftime(t0.tv_sec, overall_start_time.tv_sec);\n\
+            return(secs + 0.000001 * (t0.tv_usec - overall_start_time.tv_usec)); \n\
+           }")
+     (double get_internal_real_time (void)))
+   "" '("time.h" "sys/time.h"))
+
+  (define-macro (new-time func)
+    `(let ((start (get_internal_real_time)))
+       ,func
+       (- (get_internal_real_time) start)))
+
+  (test (real? (new-time (do ((i 0 (+ i 1))) ((= i 30) i)))) #t)
+
+  (when (provided? 'linux)
+    (c-define '(int getpid (void)) "" "unistd.h")
+    (call-with-input-file (format #f "/proc/~D/status" (getpid))
+      (lambda (p)
+	(let ((name (substring (read-line p) 6)))
+	  (do ((str (read-line p) (read-line p)))
+	      ((eof-object? str))
+	    (if (string=? (substring str 0 6) "VmRSS:")
+		(let ((size (with-input-from-string (substring str 7) read)))
+		  (format #t "~%~A size: ~A kB, time: ~A~%" name size (*s7* 'cpu-time))))))))))
+
+
+;;; --------------------------------------------------------------------------------
+
+(when with-block
+(let ()
+  (define (catch1)
+    (catch #t
+      (lambda ()
+	(asdf 21))
+      (lambda args
+	12)))
+
+  (with-output-to-file "tmp343.scm"
+    (lambda ()
+      (display "
+        (catch #t
+          (lambda ()
+            (asdf-tmp343 21))
+          (lambda args
+            12))
+       ")))
+
+  (let ((val1 (catch1))
+	(val2 (eval-string "(catch1)"))
+	(val3 (eval-string "
+     	          (catch #t
+	            (lambda ()
+		      (asdf 21))
+	            (lambda args
+		      12))
+                   "))
+	(val4 (eval '(catch1)))
+	(val5 (eval '(catch #t
+		       (lambda ()
+			 (asdf 21))
+		       (lambda args
+			 12))))
+	(val6 (load "tmp343.scm"))
+	(val7 (sload "tmp343.scm"))
+	(val8 (scall catch1 ()))
+	(val9 (eval (call-with-input-file "tmp343.scm" read)))
+	(val10 (eval (call-with-input-file "tmp343.scm" sread)))
+	(val11 (swind (lambda () #f) catch1 (lambda () #f)))
+	(val12 (seval '(catch #t
+			 (lambda ()
+			   (asdf 21))
+			 (lambda args
+			   12))))
+	(val13 (sevalstr "
+	          (catch #t
+	            (lambda ()
+		      (asdf 21))
+	            (lambda args
+		      12))
+                   ")))
+    (test (list val1 val2 val3 val4 val5 val6 val7 val8 val9 val10 val11 val12 val13) '(12 12 12 12 12 12 12 12 12 12 12 12 12)))
+
+  (delete-file "tmp343.scm")
+
+  (define (catch2)
+    (catch #t
+      (lambda ()
+	(asdf 21))
+      (lambda args
+	(catch #t
+	  (lambda ()
+	    (fdsa 12))
+	  (lambda args
+	    32)))))
+
+  (with-output-to-file "tmp343.scm"
+    (lambda ()
+      (display "
+        (catch #t
+          (lambda ()
+            (asdf 21))
+          (lambda args
+            (catch #t
+      	      (lambda ()
+      	        (fdsa 12))
+      	      (lambda args
+      	        32))))
+              ")))
+
+  (let ((val1 (catch2))
+	(val2 (eval-string "(catch2)"))
+	(val3 (eval-string "
+              (catch #t
+                (lambda ()
+                  (asdf 21))
+                (lambda args
+                  (catch #t
+      	            (lambda ()
+	              (fdsa 12))
+	            (lambda args
+	              32))))
+                    "))
+	(val4 (eval '(catch2)))
+	(val5 (eval '(catch #t
+		       (lambda ()
+			 (asdf 21))
+		       (lambda args
+			 (catch #t
+			   (lambda ()
+			     (fdsa 12))
+			   (lambda args
+			     32))))))
+	(val6 (load "tmp343.scm"))
+	(val7 (sload "tmp343.scm"))
+	(val8 (scall catch2 ()))
+	(val9 (eval (call-with-input-file "tmp343.scm" read)))
+	(val10 (eval (call-with-input-file "tmp343.scm" sread)))
+	(val11 (swind (lambda () #f) catch2 (lambda () #f)))
+	(val12 (seval '(catch #t
+			 (lambda ()
+			   (asdf 21))
+			 (lambda args
+			   (catch #t
+			     (lambda ()
+			       (fdsa 12))
+			     (lambda args
+			       32))))))
+	(val13 (sevalstr "
+                (catch #t
+                  (lambda ()
+                    (asdf 21))
+                  (lambda args
+                    (catch #t
+              	(lambda ()
+              	  (fdsa 12))
+              	(lambda args
+              	  32))))
+                ")))
+
+    (test (list val1 val2 val3 val4 val5 val6 val7 val8 val9 val10 val11 val12 val13) '(32 32 32 32 32 32 32 32 32 32 32 32 32)))
+
+  (delete-file "tmp343.scm")
+
+  (define (catch3)
+    (catch #t
+      (lambda ()
+	(asdf 21))
+      (lambda args
+	(catch #t
+	  (lambda ()
+	    (fdsa 12))
+	  (lambda args
+	    (catch #t
+	      (lambda ()
+		(sfsa 32))
+	      (lambda args
+		64)))))))
+
+  (with-output-to-file "tmp343.scm"
+    (lambda ()
+      (display "(catch #t
+                  (lambda ()
+                    (asdf 21))
+                  (lambda args
+                    (catch #t
+              	(lambda ()
+              	  (fdsa 12))
+              	(lambda args
+              	  (catch #t
+              	    (lambda ()
+              	      (sfsa 32))
+              	    (lambda args
+              	      64))))))
+                ")))
+
+  (let ((val1 (catch3))
+	(val2 (eval-string "(catch3)"))
+	(val3 (eval-string "
+                (catch #t
+                  (lambda ()
+                    (asdf 21))
+                  (lambda args
+                    (catch #t
+              	(lambda ()
+              	  (fdsa 12))
+              	(lambda args
+              	  (catch #t
+              	    (lambda ()
+              	      (sfsa 32))
+              	    (lambda args
+              	      64))))))
+                           "))
+	(val4 (eval '(catch3)))
+	(val5 (eval '(catch #t
+		       (lambda ()
+			 (asdf 21))
+		       (lambda args
+			 (catch #t
+			   (lambda ()
+			     (fdsa 12))
+			   (lambda args
+			     (catch #t
+			       (lambda ()
+				 (sfsa 32))
+			       (lambda args
+				 64))))))))
+	(val6 (load "tmp343.scm"))
+	(val7 (sload "tmp343.scm"))
+	(val8 (scall catch3 ()))
+	(val9 (eval (call-with-input-file "tmp343.scm" read)))
+	(val10 (eval (call-with-input-file "tmp343.scm" sread)))
+	(val11 (swind (lambda () #f) catch3 (lambda () #f)))
+	(val12 (seval '(catch #t
+			 (lambda ()
+			   (asdf 21))
+			 (lambda args
+			   (catch #t
+			     (lambda ()
+			       (fdsa 12))
+			     (lambda args
+			       (catch #t
+				 (lambda ()
+				   (sfsa 32))
+				 (lambda args
+				   64))))))))
+	(val13 (sevalstr "
+                (catch #t
+                  (lambda ()
+                    (asdf 21))
+                  (lambda args
+                    (catch #t
+              	(lambda ()
+              	  (fdsa 12))
+              	(lambda args
+              	  (catch #t
+              	    (lambda ()
+              	      (sfsa 32))
+              	    (lambda args
+              	      64))))))
+                    ")))
+    (test (list val1 val2 val3 val4 val5 val6 val7 val8 val9 val10 val11 val12 val13) '(64 64 64 64 64 64 64 64 64 64 64 64 64)))))
+
+
+;;; --------------------------------------------------------------------------------
+
+(let ((e (openlet (inlet 'absolute-value (lambda (x) (abs x))))))
+  (test (+ 3 ((e 'absolute-value) -3)) 6)
+  (test (catch #t (lambda () (+ ((e 'absolute-value) -3) 32)) (lambda args "oops")) 35)
+  (test (catch #t (lambda () (+ ((e 'absolute-value) "oops") 32)) (lambda args 35)) 35))
+
+(let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (if (negative? x) (- x) x)))))))
+  (test (+ 3 (abs e)) 6)
+  (test (catch #t (lambda () (+ (abs e) 32)) (lambda args "oops")) 35)
+  (set! (e 'x) "oops")
+  (test (catch #t (lambda () (+ (abs e) 32)) (lambda args 35)) 35))
+
+(test (+ 32 (call-with-exit
+	     (lambda (return)
+	       (let ((e (lambda (x) (return (if (negative? x) (- x) x)))))
+		 (+ 123 (e -321)))))) 353)
+(test (+ 32 (catch #t
+	      (lambda ()
+		(let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (error 'oops (if (negative? x) (- x) x))))))))
+		  (+ 123 (abs e) -321)))
+	      (lambda args 3))) 35)
+(test (+ 32 (catch #t
+	      (lambda ()
+		(let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (throw 'oops (if (negative? x) (- x) x))))))))
+		  (+ 123 (abs e) -321)))
+	      (lambda args 3))) 35)
+(test (+ 32 (call-with-exit
+	     (lambda (return)
+	       (let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (return (if (negative? x) (- x) x))))))))
+		 (+ 123 (abs e) -321))))) 35)
+(test (+ 32 (call-with-exit
+	     (lambda (return)
+	       (let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (return (if (negative? x) (- x) x))))))))
+		 (+ 123 (eval `(abs e)) -321))))) 35)
+(test (+ 32 (catch #t
+	      (lambda ()
+		(call-with-exit
+		 (lambda (return)
+		   (let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (return (if (negative? x) (- x) x))))))))
+		     (+ 123 (error 'oops (abs e)) -321)))))
+	      (lambda args 3))) 35)
+(test (+ 32 (call-with-exit
+	     (lambda (return)
+	       (let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (return (if (negative? x) (- x) x))))))))
+		 (let ((e1 (openlet (inlet 'abs (lambda (x) (abs e))))))
+		   (+ 123 (abs e1) -321)))))) 35)
+(test (+ 32 (call-with-exit
+	     (lambda (return)
+	       (let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (return (if (negative? x) (- x) x))))))))
+		 (let ((e1 (openlet (inlet 'abs (lambda (x) (abs e))))))
+		   (let ((e2 (openlet (inlet 'abs (lambda (x) (abs e1))))))
+		     (+ 123 (abs e2) -321))))))) 35)
+
+(let () ; optimize these things
+  (define (tst-it)
+    (+ 32 (call-with-exit
+	   (lambda (return)
+	     (let ((e (openlet (inlet 'x -3 'abs (lambda (e)
+						   (let ((x (e 'x)))
+						     (return (if (negative? x) (- x) x))))))))
+	       (+ 123 (abs e) -321))))))
+  (test (tst-it) 35)) ; (+ 123 3 -321 32) is -163
+
+(let ()
+  (define (tst-it1)
+    (+ 32 (catch 'ok
+	    (lambda ()
+	      (let ((e (openlet (inlet 'x -3 'abs (lambda (e)
+						    (let ((x (e 'x)))
+						      (throw 'ok (if (negative? x) (- x) x))))))))
+		(+ 123 (abs e) -321)))
+	    (lambda (type info)
+	      (car info)))))
+  (test (tst-it1) 35))
+
+(let ()
+  (define (tst-it2)
+    (+ 32 (call/cc
+	   (lambda (return)
+	     (let ((e (openlet (inlet 'x -3 'abs (lambda (e)
+						   (let ((x (e 'x)))
+						     (return (if (negative? x) (- x) x))))))))
+	       (+ 123 (abs e) -321))))))
+  (test (tst-it2) 35))
+
+
+
+;;; reader-cond
+
+(test (eval-string "(reader-cond)") 'error) ; eval-string else (reader-cond) is not wrapped in catch
+(test (let () (define (func) (do ((x 0 (+ x 1)) (i 0 (+ i 1))) ((>= x 1) (reader-cond (symbol +iterator+ (bignum 1234) `(x 1)))))) (func) (func)) 'error) ;op_dox_no_body
+
+(define (rt2)
+  (reader-cond ((> 3 2) `(+ 1 2))
+	       (#t 'error)))
+(test (rt2) '(+ 1 2))
+(define (rt3)
+  (reader-cond ((> 3 2) (+ 1 2))
+	       (#t 'error)))
+(test (rt3) 3)
+
+(define (rt2)
+  (reader-cond ((> 3 2))
+	       (#t 'error)))
+(test (rt2) #t)
+
+(define (rt2)
+  (reader-cond ((> 3 2)
+		(values 1 2 3))
+	       (#t 'error)))
+(test (+ (rt2) 4) 10)
+
+(define (rt2)
+  (reader-cond ((assq 'x '((a . 3) (x . 4))) => cdr)
+	       (#t 'error)))
+(test (+ (rt2) 2) 6)
+
+(let ()
+  (define (f1)
+    (let ((x 1)
+	  (y 1))
+      (reader-cond ((not (provided? 'asdf))
+		    (set! x (+ x 1))
+		    (set! x (+ x 1)))
+		   (#t (set! x (- x 1))))
+      (reader-cond ((provided? 'asdf)
+		    (set! y (+ y 1))
+		    (set! y (+ y 1)))
+		   (#t (set! y (- y 1))))
+      (list x y)))
+  (f1)
+  (test (f1) (list 3 0)))
+
+(test (list 1 (reader-cond ((> 3 2) 2 3 4)) 5) (list 1 2 3 4 5))
+
+(define-expansion (__exp1__) (values 1 2 3))
+
+(test
+ (begin
+   (reader-cond
+    ((> pi 3)
+     (reader-cond
+      ((= pi 3) #f)
+      ((not (= pi 3)) 32)))
+    (else #f)))
+ 32)
+
+(define-expansion (s7test-comment str) (values)) ; this must be at the top-level, "comment" used as local var in lint.scm
+(test (+ 1 (s7test-comment "one") 2 (s7test-comment "two")) 3)
+
+#|
+(let ()
+  (test (abs (+ 2 -3)) (+ 1))
+
+  (define-macro (protected-let vars . body)
+    ;; locals outside this let are not changed (and aren't accessible),
+    ;;   and we'll protect the current rootlet values of built-ins
+    `(with-let (inlet :in (apply inlet ',(map (lambda (f)
+						(values (car f) ((rootlet) (car f))))
+					      (unlet))))
+       (dynamic-wind
+	   (lambda ()
+	     #f)
+	   (lambda ()
+	     (let ,vars ,@body))
+	   (lambda ()
+	     (for-each
+	      (lambda (f) ; if any built-in's value has changed in the protected-let, reset it
+		(let ((value-before-let (in (car f))))
+		  (unless (equal? (symbol->value (car f)) value-before-let)
+		    (apply set! (list (car f)
+				      (if (eq? value-before-let #<undefined>) ; it was not changed before
+					  (cdr f)                             ;   so use the start-up value
+					  value-before-let))))))
+	      (unlet))))))
+
+  (let ((abs 32))
+    (let ((val (protected-let ()
+			      (set! abs 64)
+			      (set! + 0)
+			      (test (- + abs) -64)
+			      12)))
+      (test (+ val abs) 44)))
+  (test (abs (+ 2 -3)) (+ 1))
+
+  (define-macro (local-let vars . body)
+    ;; locals outside this let are accessible and can be changed, but we'll protect them and the current rootlet values of built-ins
+    `(let ((in (apply inlet (curlet) ',(map (lambda (f)
+					      (values (car f) ((rootlet) (car f))))
+					    (unlet)))))
+       (dynamic-wind
+	   (lambda ()
+	     #f)
+	   (lambda ()
+	     (let ,vars ,@body))
+	   (lambda ()
+	     (let ((out (unlet)))
+	       (when (out 'set!)            ; in case set! was changed -- see example below
+		 (eval `(define set! #_set!) (rootlet)))
+	       (for-each
+		(lambda (f)
+		  (let ((value-before-let (in (car f))))
+		    (unless (or (equal? (symbol->value (car f)) value-before-let)
+				(eq? 'set! (car f)))
+		      (apply #_set! (list (car f)
+					  (if (eq? value-before-let #<undefined>)
+					      (cdr f)
+					      value-before-let))))))
+		(inlet in out)))))))
+
+  (let ((abs 32)
+	(a 20))
+    (let ((val (local-let ()
+			  (set! abs 64)
+			  (set! + 0)
+			  (set! a 1)
+			  (test (- + abs) -64)
+			  12)))
+      (test (+ abs a val) 64)))
+  (test (abs -1) (+ 1)))
+|#
+
+(let ()
+  (define (f1) (let ((lst (list 1 2 (reader-cond ((> 1 0) 3) (else 4)) 5 6))) lst))
+  (test (f1) '(1 2 3 5 6))
+  (define (f2) (let ((lst (list 1 2 (reader-cond ((> 1 0) 3 4)) 5 6))) lst))
+  (test (f2) '(1 2 3 4 5 6))
+  (define (f3) (list (__exp1__) 5))
+  (test (f3) '(1 2 3 5))
+  (define (f4) (+ (__exp1__) (__exp1__)))
+  (test (f4) 12)
+  (define (f5) (let ((lst (list (reader-cond ((> 1 0) (__exp1__)) (else 4)) 5 6))) lst))
+  (test (f5) '(1 2 3 5 6))
+  (define (f6) (let ((lst ((reader-cond ((> 1 0) list) (else cons)) 1 2))) lst))
+  (test (f6) '(1 2))
+  (define (f7) (let ((lst ((reader-cond ((= 1 0) vector) ((< 1 0) list) (else cons)) 1 2))) lst))
+  (test (f7) '(1 . 2))
+  (define (f8) (let ((lst ((reader-cond ((> 1 0) quote)) (+ 2 3)))) lst))
+  (test (f8) '(+ 2 3))
+  (define (f9) (let ((lst ((reader-cond ((= 1 0) #f) (else quote)) (2 3)))) lst)) ; this changed -- original made no sense 13-Aug-23
+  (test (f9) '(2 3))
+  (define (f10) (let ((lst (vector 0 (reader-cond ((> 1 0) (+ 2 3))) 2))) lst))
+  (test (f10) #(0 5 2))
+  (define (f11) (let ((lst `(0 ,(reader-cond ((> 1 0) (+ 2 3))) 2))) lst))
+  (test (f11) '(0 5 2)))
+
+(test (let ((v (vector 1 (reader-cond (#t 32)) 890))) v) #(1 32 890))
+(test (let ((v (vector 1 (reader-cond (#t 2 3)) 4))) v) #(1 2 3 4))
+(test (let ((v (vector 1 (reader-cond ((+ 2 3))) 4))) v) #(1 5 4))
+;;; even worse:
+;;  (define (reader-cond ((display "defining hiho\n" *stderr*) hiho)) (lambda () "hiho"))
+;;  (format *stderr* "~S~%" (hiho))
+(test (let () (define (f a (reader-cond ((provided? 'surreals) b))) a) (f 1)) 1)
+
+(test (let ((x #f)) (define (fop5 x y) (apply x (list y))) (fop5 ((let () reader-cond) (#t 0 (values 2 3))))) 'error) ;splice_in_values eval_macro_mv case
+(test (do ((i 0 (+ i 1))) ((= i 1)) ((let () reader-cond) (#t (values #f #f) 3))) #t) ; splice_in_values  eval_macro_mv!
+(test ((lambda args (car args)) (call-with-exit (lambda (_x_) (((vector reader-cond) 0) (#t 3 (apply values (make-list 2 1)) 3))))) 3) ; here we return values via reader-cond
+(test (let ((x ((let () reader-cond) (#t (values 1 2 3 4) 3)))) x) 'error)
+   ;; -> (let ((x (values #f 3))) x): "let: can't bind x to (values #f 3)" since we return #f for the (values 1 2 3 4) in splice_in_values and reader-cond adds the values
+
+(define-expansion (reader-if test true . false)
+  (let ((test-val (eval test)))
+    (if test-val
+	true
+	(and (pair? false)
+	     (car false)))))
+
+(define-expansion (reader-when test . true)
+  (if (null? true)
+      (error 'syntax-error "reader-when has no body?")
+      (let ((test-val (eval test)))
+	(if test-val
+	    (apply values true)
+	    (values)))))
+
+(define-expansion (reader-case select . clauses)
+  (if (null? clauses)
+      (error 'syntax-error "reader-case has no clauses")
+      (let ((key (eval select)))
+	(call-with-exit
+	 (lambda (return)
+	   (for-each
+	    (lambda (clause)
+	      (if (or (eq? (car clause) 'else)
+		      (memv key (car clause)))
+		  (return (apply values (cdr clause)))))
+	    clauses)
+	   (values))))))
+
+(define-expansion (evaporates) (values))
+(test (abs -1 (evaporates)) 1)
+
+(define global-val 0)
+
+(when (eq? (rootlet) (curlet))
+
+  (test (reader-if (= global-val 0) (display "ok1" #f)) "ok1")
+  (test (display (reader-if (= global-val 2) "oops" "2") #f) "2")
+
+  (test (reader-cond ((= global-val 0) (display "ok2" #f))) "ok2")
+  (test (with-output-to-string (lambda () (reader-cond ((= global-val 0) (display "o") (display "k") (display "3"))))) "ok3")
+  (reader-cond ((= global-val 3) (display "oops1\n")))
+  (reader-if (= global-val 3) (display "oops2\n"))
+  (test (display (reader-cond ((= global-val 0) "ok4") (else "oops3")) #f) "ok4")
+  (test (display (reader-if (= global-val 0) "ok5" "oops5") #f) "ok5")
+
+  (define (gf11 a)
+    (reader-cond ((= global-val 0) (let ((b (+ a 1))) (* 2 b)))
+		 (else (* a 3))))
+  (test (display (gf11 1) #f) 4)
+  (define (gf12 a)
+    (reader-if (= global-val 0) (let ((b (+ a 1))) (* 2 b)) (* a 3)))
+  (test (display (gf12 1) #f) 4)
+  (define (gf13 a)
+    (reader-cond ((= global-val 0) (set! a (+ a 1)) (* 2 a))
+		 (else (* a 3))))
+  (test (display (gf13 1) #f) 4)
+  (test (reader-when (= global-val 0) (display "ok6" #f)) "ok6")
+  (test (display (reader-when (= global-val 0) "ok7") #f) "ok7")
+  (reader-when (= global-val 1) (display "oops7\n"))
+  (test (display (reader-when (= global-val 1) "oops8")) 'error) ; error because global-val not = 1 -> not enough arguments to display
+  (test (eval-string "(reader-when (= global-val 0))") 'error)   ; no body
+  (test (with-output-to-string (lambda () (reader-when (= global-val 0) (display (+ global-val 1)) (display "ok8")))) "1ok8")
+  (test (display (list (reader-cond ((= global-val 0) 1 2 3))) #f) '(1 2 3))
+  (test (display (list (reader-when (= global-val 0) 1 2 3)) #f) '(1 2 3)) ; does this make sense??
+
+  (define (gf14 a)
+    (reader-when (= global-val 0) (set! a  (+ a 1)) (* 2 a)))
+  (test (gf14 1) 4)
+
+  (test (with-output-to-string (lambda () (values (display "o") (display "k") (display "9")))) "ok9")
+
+  (test (reader-case global-val ((0) (display "ok10" #f)) (else (display "oops10\n"))) "ok10")
+  (reader-case global-val ((1) (display "oops111\n")) ((2) (display "oops112\n")))
+  (test (reader-case global-val ((1 2 3) (display "oops114\n")) ((0) (display "ok11" #f)) (else (display "oops115\n"))) "ok11")
+  (test (reader-case global-val ((1) (display "oops15\n")) (else (display "ok12" #f))) "ok12")
+  (test (eval-string "(reader-case global-val)") 'error) ; error reader-case has no clauses
+  (test (display (reader-case global-val ((0) "ok13") (else "oops13")) #f) "ok13")
+  (test (display (reader-cond ((= global-val 0) (reader-if (= global-val 1) "3" "ok14"))) #f) "ok14")
+  (test (reader-cond ((= global-val 0) (display (reader-if (= global-val 1) "3" "ok15") #f))) "ok15")
+)
+;;; end reader-cond
+
+
+(let ()
+  (define (test-abs)
+    (define (abs x) (+ x 1))
+    (test (abs -1) 0))
+  (test-abs)
+
+  (define (test-sin)
+    (let ((sin (lambda (x) (+ x 2))))
+      (test (sin -1) 1)))
+  (test-sin)
+
+  (define (test-cos)
+    (define cos (lambda (x) (+ x 3)))
+    (test (cos -1) 2))
+  (test-cos)
+
+  (define test-log
+    (lambda ()
+      (define log (let () (lambda (x) (+ x 4))))
+      (test (log -1) 3)))
+  (test-log)
+
+  (define test-tan
+    (let ((tan (lambda (x) (+ x 5))))
+      (lambda ()
+	(test (tan -1) 4))))
+  (test-tan)
+
+  (define (test-acos)
+    (let ()
+      (define (acos x) (+ x 6))
+      (test (acos -1) 5)))
+  (test-acos)
+
+  (define (test-acos1)
+    (let ()
+      (if #f (define (acos x) (+ x 6)))
+      (test (acos 1) 0)))
+  (test-acos1)
+
+  (define (test-acos2)
+    (let ()
+      (if #t (define (acos x) (+ x 6)))
+      (test (acos -3) 3)))
+  (test-acos2)
+
+  (define (test-atan)
+    (define (atan x) (+ x 7))
+    (test (atan -1) 6))
+  (test-atan)
+
+  (define (test-atan1)
+    (if #f (define (atan x) (+ x 7)))
+    (test (atan 0) 0))
+  (test-atan1)
+
+  (define (test-asin)
+    (define asin (let () (lambda (x) (+ x 8))))
+    (test (asin -1) 7))
+  (test-asin)
+
+  (define test-sinh
+    (lambda ()
+      (define sinh (lambda (x) (+ x 9)))
+      (test (sinh -1) 8)))
+  (test-sinh))
+
+(unless with-bignums
+  (let ()
+    (define-class quaternion ()
+      '((r 0) (i 0) (j 0) (k 0))
+      (list (list 'real-part (lambda (obj) (obj 'r)))
+	    (list 'imag-part (lambda (obj) (vector (obj 'i) (obj 'j) (obj 'k))))
+
+	    (list 'number? (lambda (obj) #t))
+	    (list 'complex? (lambda (obj) #f))
+	    (list 'real? (lambda (obj) #f))
+	    (list 'integer? (lambda (obj) #f))
+	    (list 'rational? (lambda (obj) #f))
+
+	    (list '+ (lambda orig-args
+		       (let add ((r ()) (i ()) (j ()) (k ()) (args orig-args))
+			 (if (null? args)
+			     (make-quaternion (apply + r) (apply + i) (apply + j) (apply + k))
+			     (let ((n (car args)))
+			       (cond
+				((real? n) (add (cons n r) i j k (cdr args)))
+				((complex? n) (add (cons (real-part n) r) (cons (imag-part n) i) j k (cdr args)))
+				((quaternion? n) (add (cons (n 'r) r) (cons (n 'i) i) (cons (n 'j) j) (cons (n 'k) k) (cdr args)))
+				((openlet? n)
+				 (if (eq? n (car orig-args))
+				     (error 'missing-method "+ can't handle these arguments: ~A" args)
+				     (apply (n '+) (make-quaternion (apply + r) (apply + i) (apply + j) (apply + k)) (cdr args))))
+
+				;; this code is trying to make sure we don't start bouncing:
+				;; if (+ q1 o1) goes to (o1 '+) which also can't handle this
+				;; combination, don't bounce back here!
+				;; In the current case, it would be (+ o1 q1) bouncing us here.
+				;; we're assuming (+ a b c) = (+ (+ a b) c), and that any other
+				;; + method will behave that way.  I think the optimizer also
+				;; assumes that (+ a b) = (+ b a).
+
+				(else (error 'wrong-type-arg "+ argument ~A is not a number" n))))))))
+
+	    (list '- (lambda args
+		       (let ((first (car args)))
+			 (if (null? (cdr args)) ; (- q) is not the same as (- q 0)
+			     (make-quaternion (- (first 'r)) (- (first 'i)) (- (first 'j)) (- (first 'k)))
+			     (let ((q (cond ((real? first) (make-quaternion first 0 0 0))
+					    ((complex? first) (make-quaternion (real-part first) (imag-part first) 0 0))
+					    (else (copy first))))
+				   (n (apply + (cdr args))))
+			       (cond ((real? n) (set! (q 'r) (- (q 'r) n)) q)
+				     ((complex? n) (make-quaternion (- (q 'r) (real-part n)) (- (q 'i) (imag-part n)) (q 'j) (q 'k)))
+				     ((quaternion? n) (make-quaternion (- (q 'r) (n 'r)) (- (q 'i) (n 'i)) (- (q 'j) (n 'j)) (- (q 'k) (n 'k))))
+				     (else (apply (n '-) (list q n)))))))))
+	    ))
+
+    (let ((old-make-quaternion make-quaternion))
+      (varlet (outlet (curlet))
+	(cons 'make-quaternion (lambda args
+				 (let ((q (apply old-make-quaternion args)))
+				   (if (or (not (real? (q 'r)))
+					   (not (real? (q 'i)))
+					   (not (real? (q 'j)))
+					   (not (real? (q 'k))))
+				       (error 'wrong-type-arg "quaternion fields should all be real: ~A" q)
+				       q))))))
+
+
+    (define-class pfloat () ; don't clobber built-in float?!
+      '((x 0.0))
+      (list (list '+ (lambda orig-args
+		       (let add ((x ()) (args orig-args))
+			 (if (null? args)
+			     (make-pfloat (apply + x))
+			     (let ((n (car args)))
+			       (cond
+				((pfloat? n) (add (cons (n 'x) x) (cdr args)))
+				((real? n) (add (cons n x) (cdr args)))
+				((complex? n) (add (cons (real-part n) x) (cdr args)))
+				((openlet? n)
+				 (if (eq? n (car orig-args))
+				     (error 'missing-method "+ can't handle these arguments: ~A" args)
+				     (apply (n '+) (make-pfloat (apply + x)) (cdr args))))
+				(else (error 'wrong-type-arg "+ argument ~A is not a number" n))))))))
+	    (list 'number? (lambda (obj) #t))))
+
+
+    (let ((q1 (make-quaternion 1.0 1.0 0.0 0.0)))
+      (test (complex? q1) #f)
+      (test (number? q1) #t)
+      (test (quaternion? q1) #t)
+      (test (quaternion? 1) #f)
+      (test (quaternion? 1+i) #f)
+      (test (integer? q1) #f)
+      (test (real? q1) #f)
+      (test (rational? q1) #f)
+
+      (test (real-part q1) 1.0)
+      (test (imag-part q1) #(1.0 0.0 0.0))
+
+      (test (eq? q1 q1) #t)
+      (test (eqv? q1 q1) #t)
+      (test (equal? q1 q1) #t)
+
+      (let ((q2 (make-quaternion 1.0 1.0 0.0 0.0)))
+	(test (eq? q1 q2) #f)
+	(test (eqv? q1 q2) #f)
+	(test (equal? q1 q2) #t)
+	(set! (q2 'r) 2.0)
+	(test (equal? q1 q2) #f)
+
+	(test (+ q1) q1)
+	(test (+ 1 q1) q2)
+	(test (+ q1 1) q2)
+	(test (+ 1/2 q1 1/2) q2)
+	(test (+ .5 1/2 q1) q2)
+	(test (+ 1+i q1 0-i) q2)
+	(test (+ 1.0 q1) q2)
+	(test (+ q1 1+i 0-i) q2)
+	(test (+ 0+i q1 1 0-i) q2)
+
+	(test (- q1) (make-quaternion -1.0 -1.0 0.0 0.0))
+	(test (- q1 1) (make-quaternion 0.0 1.0 0.0 0.0))
+	(test (- q1 1 0.0+i) (make-quaternion 0.0 0.0 0.0 0.0))
+	(test (- 1 q1) (make-quaternion 0.0 -1.0 0.0 0.0))
+
+
+	(test (+ (make-pfloat 1.0) 1.0) (make-pfloat 2.0))
+	(test (+ (make-quaternion 1 0 0 0) (make-pfloat 1.0)) 'error)
+	(test (+ (make-pfloat 1.0) 2 (make-quaternion 1 1 1 1)) 'error)
+	(test (+ 1 (make-pfloat 1.0) 2 (make-quaternion 1 1 1 1)) 'error)
+
+	(test (make-quaternion 1 2+i 0 0) 'error)
+	(test (make-quaternion 1 2 3 "hi") 'error)
+
+	(let () (define (a1 q) (+ q 1)) (test (a1 q1) (make-quaternion 2.0 1.0 0.0 0.0)))
+	(let () (define (a1 q) (+ q 1)) (test (a1 (+ q1 1)) (make-quaternion 3.0 1.0 0.0 0.0)))
+	(let () (define (a1 q) (+ q 1)) (test (a1 (- q1 1)) q1))
+	(let () (define (a1 q) (+ q 1)) (test (a1 (+ 1 q1)) (make-quaternion 3.0 1.0 0.0 0.0)))
+	(let () (define (a1 q) (+ q 1)) (test (a1 (- 1 q1)) (make-quaternion 1.0 -1.0 0.0 0.0)))
+	(let () (define (a1 q) (+ q 1)) (test (a1 (+ q1 q1)) (make-quaternion 3.0 2.0 0.0 0.0)))
+	(let () (define (a1 q) (+ 1 q)) (test (a1 q1) (make-quaternion 2.0 1.0 0.0 0.0)))
+	(let () (define (a1 q) (+ q q)) (test (a1 q1) (make-quaternion 2.0 2.0 0.0 0.0)))
+	(let () (define (a1 q) (- q 1)) (test (a1 q1) (make-quaternion 0.0 1.0 0.0 0.0)))
+	(let () (define (a2 q p) (+ q p)) (test (a2 q1 q2) (make-quaternion 3.0 2.0 0.0 0.0)))
+	(let () (define (a2 q p) (+ q p)) (test (a2 (+ 1 q1) (+ q2 1)) (make-quaternion 5.0 2.0 0.0 0.0)))
+	)))
+
+  (let ((e1 (openlet
+	     (inlet
+	      'x 3
+	      '* (lambda args
+		   (if (number? (car args))    ; are we the first?
+		       (apply * (car args) ((cadr args) 'x) (cddr args))
+		       (apply * ((car args) 'x) (cdr args))))))))
+    (let ((e2 (copy e1)))
+      (set! (e2 'x) 4)
+      (test (* 2 e1 e2 5) 120)
+      (test (* e1 e2 5) 60)
+      (test (* e1 e2) 12)
+      (test (* e1) 3)
+      (test (* 2 e1 e2) 24)
+      (test (* 2 e1 4) 24)
+      (test (* e1 2 e2 e1) 72))))
+
+(let ()
+  (begin
+    (define fvector? #f)
+    (define make-fvector #f)
+    (let ((type (gensym))
+	  (->float (lambda (x)
+		     (if (real? x)
+			 (* x 1.0)
+			 (error 'wrong-type-arg "fvector new value is not a real: ~A" x)))))
+      (set! make-fvector
+	    (lambda* (len (init 0.0))
+	      (openlet
+	       (inlet 'v (make-vector len (->float init))
+			     'type type
+			     'length (lambda (e) len)
+			     'let-set-fallback (lambda (fv i val) (#_vector-set! (fv 'v) i (->float val)))
+			     'let-ref-fallback (lambda (fv i) (#_vector-ref (fv 'v) i))))))
+      (set! fvector? (lambda (p) (and (let? p) (eq? (p 'type) type))))))
+  (let ((f (make-fvector 10)))
+    (test (fvector? f) #t)
+    (test (length f) 10)
+    (test (f 0) 0.0)
+    (set! (f 1) 123)
+    (test (f 1) 123.0)))
+
+(define-macro (_do4_ . args)
+  `(do ((__var__ #f)
+        (_i_ 0 (+ _i_ 1)))
+       ((= _i_ 1) __var__)
+     (set! __var__ ,@args)))
+
+(let ()
+  (define (baser-method func)
+    (lambda largs
+      (if (let? (car largs))
+	  (apply func ((car largs) 'c) (cdr largs))
+	  (if (let? (cadr largs))
+	      (apply func (car largs) ((cadr largs) 'c) (cddr largs))
+	      (if (let? (caddr largs))
+		  (apply func (car largs) (cadr largs) ((caddr largs) 'c) (cdddr largs))
+		  (apply func (car largs) (cadr largs) (caddr largs) ((cadddr largs) 'c) (cddddr largs)))))))
+  (test (numerator (openlet (inlet 'c 1/9223372036854775807 'numerator (baser-method numerator)))) 1)
+  (test (cdaadr (openlet (inlet 'c '((1 (2)) (((3) 4))) 'cdaadr (baser-method cdaadr)))) '(4))
+  (test (cadadr (openlet (inlet 'c '((1 2) (3 4)) 'cadadr (baser-method cadadr)))) 4)
+  (test (caadar (openlet (inlet 'c '((1 (2)) (((3) 4))) 'caadar (baser-method caadar)))) 2)
+  (test (caaadr (openlet (inlet 'c '((1 (2)) (((3) 4))) 'caaadr (baser-method caaadr)))) '(3))
+  (test (boolean? (openlet (inlet 'c #f 'boolean? (baser-method boolean?)))) #t)
+  (test (number->string (openlet (inlet 'c 1/9223372036854775807 'number->string (baser-method number->string)))) "1/9223372036854775807")
+  (test (lognot (openlet (inlet 'c '9223372036854775807 'lognot (baser-method lognot)))) -9223372036854775808)
+  (unless pure-s7 (test (vector-length (openlet (inlet 'c #() 'vector-length (baser-method vector-length)))) 0))
+  (test (round (openlet (inlet 'c 1/9223372036854775807 'round (baser-method round)))) 0)
+  ;(test (string-upcase (openlet (inlet 'c #u(104 105 52 53 53) 'string-upcase (baser-method string-upcase)))) "HI455")
+  (test (vector? (openlet (inlet 'c #() 'vector? (baser-method vector?)))) #t)
+  (test (null? (openlet (inlet 'c () 'null? (baser-method null?)))) #t)
+  (test (keyword? (openlet (inlet 'c ':key 'keyword? (baser-method keyword?)))) #t)
+  (test (real? (openlet (inlet 'c 1/9223372036854775807 'real? (baser-method real?)))) #t)
+  (test (length (openlet (inlet 'c () 'length (baser-method length)))) 0)
+  (test (pair? (openlet (inlet 'c '(1) 'pair? (baser-method pair?)))) #t)
+  (test (number? (openlet (inlet 'c 1/9223372036854775807 'number? (baser-method number?)))) #t)
+  (test (odd? (openlet (inlet 'c '9223372036854775807 'odd? (baser-method odd?)))) #t)
+  ;(test (symbol (openlet (inlet 'c #u(104 105 52 53 53) 'symbol (baser-method symbol)))) 'hi455)
+  (test (cdar (openlet (inlet 'c '((1 2)) 'cdar (baser-method cdar)))) '(2))
+  (test (even? (openlet (inlet 'c -9223372036854775808 'even? (baser-method even?)))) #t)
+  (test (caar (openlet (inlet 'c '((1 2)) 'caar (baser-method caar)))) 1)
+  (test (negative? (openlet (inlet 'c -1/9223372036854775807 'negative? (baser-method negative?)))) #t)
+  (test (floor (openlet (inlet 'c 1/9223372036854775807 'floor (baser-method floor)))) 0)
+  (test (positive? (openlet (inlet 'c 1/9223372036854775807 'positive? (baser-method positive?)))) #t)
+  (test (string (openlet (inlet 'c #\a 'string (baser-method string)))) "a")
+  (test (rational? (openlet (inlet 'c 1/9223372036854775807 'rational? (baser-method rational?)))) #t)
+  ;(unless pure-s7 (test (string-copy (openlet (inlet 'c #u(104 105 52 53 53) 'string-copy (baser-method string-copy)))) "hi455"))
+  ;(test (string->keyword (openlet (inlet 'c #u(104 105 52 53 53) 'string->keyword (baser-method string->keyword)))) :hi455)
+  (unless pure-s7 (test (inexact? (openlet (inlet 'c 1.5+1i 'inexact? (baser-method inexact?)))) #t))
+  (test (char? (openlet (inlet 'c #\a 'char? (baser-method char?)))) #t)
+  (test (exact? (openlet (inlet 'c 1/9223372036854775807 'exact? (baser-method exact?)))) #t)
+  ;(test (format (openlet (inlet 'c #u(104 105 52 53 53) 'format (baser-method format)))) "hi455")
+  (test (cadar (openlet (inlet 'c '((1 2)) 'cadar (baser-method cadar)))) '2)
+  (test (char-lower-case? (openlet (inlet 'c #\a 'char-lower-case? (baser-method char-lower-case?)))) #t)
+  (test (char-upcase (openlet (inlet 'c #\a 'char-upcase (baser-method char-upcase)))) #\A)
+  (test (byte-vector? (openlet (inlet 'c #u(104 105 52 53 53) 'byte-vector? (baser-method byte-vector?)))) #t)
+  ;(unless pure-s7 (test (string->list (openlet (inlet 'c #u(104 105 52 53 53) 'string->list (baser-method string->list)))) '(#\h #\i #\4 #\5 #\5)))
+  (test (denominator (openlet (inlet 'c 1/9223372036854775807 'denominator (baser-method denominator)))) 9223372036854775807)
+  (test (integer-length (openlet (inlet 'c '9223372036854775807 'integer-length (baser-method integer-length)))) 63)
+  (test (integer? (openlet (inlet 'c '9223372036854775807 'integer? (baser-method integer?)))) #t)
+  (test (char->integer (openlet (inlet 'c #\a 'char->integer (baser-method char->integer)))) 97)
+  (test (min (openlet (inlet 'c 1/9223372036854775807 'real? (lambda (obj) (#_real? (obj 'c))) 'min (baser-method min)))) 1/9223372036854775807)
+  (test (ceiling (openlet (inlet 'c 1/9223372036854775807 'ceiling (baser-method ceiling)))) 1)
+  (test (max (openlet (inlet 'c 1/9223372036854775807 'real? (lambda (obj) (#_real? (obj 'c))) 'max (baser-method max)))) 1/9223372036854775807)
+  (test (car (openlet (inlet 'c '(1) 'car (baser-method car)))) 1)
+  (test (char-alphabetic? (openlet (inlet 'c #\a 'char-alphabetic? (baser-method char-alphabetic?)))) #t)
+  (test (modulo 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 'modulo (baser-method modulo)))) 0)
+  ;(test (substring #u(104 105 52 53 53) (openlet (inlet 'c '0 'substring (baser-method substring)))) "hi455")
+  ;(test (char-position #\a (openlet (inlet 'c #u(97 0 98) 'char-position (baser-method char-position)))) 0)
+  (test (assv 1 (openlet (inlet 'c '((1 2)) 'assv (baser-method assv)))) '(1 2))
+  (test (assq 1 (openlet (inlet 'c '((1 2)) 'assq (baser-method assq)))) '(1 2))
+  (test (rationalize 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 'rationalize (baser-method rationalize)))) 0)
+  (test (subvector #(1 2) 0 1 (openlet (inlet 'c '(1) 'subvector (baser-method subvector)))) #(1))
+  ;(test (string>=? #u(52 53 104 105 53) (openlet (inlet 'c #u(52 53 104 105 53) 'string>=? (baser-method string>=?)))) #t)
+  ;(test (string<=? #u(52 53 104 105 53) (openlet (inlet 'c #u(52 53 104 105 53) 'string<=? (baser-method string<=?)))) #t)
+  ;(test (fill! #u(97 97 97 97 97) (openlet (inlet 'c 120 'fill! (baser-method fill!)))) 120)
+  (test (string #\a (openlet (inlet 'c #\a 'string (baser-method string)))) "aa")
+  (test (logbit? 9223372036854775807 (openlet (inlet 'c '0 'logbit? (baser-method logbit?)))) #t)
+  (test (remainder 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 'remainder (baser-method remainder)))) 0)
+  ;(if (not pure-s7) (test (string-ci>? #u(0 0 0 0 0) (openlet (inlet 'c #u(0) 'string-ci>? (baser-method string-ci>?)))) #t))
+  ;(if (not pure-s7) (test (string-ci=? #u(0 0 0 0 0) (openlet (inlet 'c #u(0 0 0 0 0) 'string-ci=? (baser-method string-ci=?)))) #t))
+  ;(test (string-ref #u(0 0 0 0 0) (openlet (inlet 'c '0 'string-ref (baser-method string-ref)))) #\null)
+  ;(test (string-position #u(0 0 0 0 0) (openlet (inlet 'c #u(0 0 0 0 0) 'string-position (baser-method string-position)))) 0)
+  ;(test (string>? #u(0 0 0 0 0) (openlet (inlet 'c #u(0) 'string>? (baser-method string>?)))) #t)
+  ;(test (string>=? #u(52 53 104 105 53) #u(52 53 104 105 53) (openlet (inlet 'c #u(52 53 104 105 53) 'string>=? (baser-method string>=?)))) #t)
+  (unless with-bignums
+    (test (logxor (openlet (inlet 'c '9223372036854775807 'logxor (baser-method logxor)))) 9223372036854775807)
+    (test (> 1/9223372036854775807 (openlet (inlet 'c -1/9223372036854775807 '> (baser-method >)))) #t)
+    (test (= 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 '= (baser-method =)))) #t)
+    (test (< 1/9223372036854775807 (openlet (inlet 'c 1e+18 '< (baser-method <)))) #t)
+    (test (/ 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 '/ (baser-method /)))) 1)
+    (test (- 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 '- (baser-method -)))) 0)
+    (test (+ 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 '+ (baser-method +)))) 2/9223372036854775807)
+    (test (= 1/9223372036854775807 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 '= (baser-method =)))) #t)
+    (test (+ -1 (openlet (inlet 'c -1 '+ (baser-method +)))) -2)
+    (test (- -1 (openlet (inlet 'c -1 '- (baser-method -)))) 0)
+    (test (* (openlet (inlet 'c 2.0 '* (baser-method *))) 2.0) 4.0)
+    (test (let ((x (openlet (inlet 'c -1 '- (baser-method -))))) (- x 1)) -2)
+    (test (let ((x (openlet (inlet 'c 1.0 '- (baser-method -))))) (- 1.0 x)) 0.0)
+    (test (* 3.0 (openlet (inlet 'c 2.0 '* (baser-method *))) 2.0) 12.0))
+  (test (symbol->string (openlet (inlet 'c 'a 'symbol->string (baser-method symbol->string)))) "a")
+  (test (let? (outlet (openlet (inlet 'c (curlet) 'outlet (baser-method outlet)))) ) #t)
+  (test (c-pointer? (c-pointer (openlet (inlet 'c 0 'c-pointer (baser-method c-pointer))))) #t))
+
+(let ((e (openlet (inlet 'x (list 1 2 3) 'make-iterator (let ((+iterator+ #t)) (lambda (y) (#_make-iterator (y 'x))))))))
+  (test (map (lambda (z) (+ z 1)) e) '(2 3 4)))
+
+(let ()
+  (let ((x (openlet (inlet 'integer? (lambda (y) #t)))))
+    (define (func)
+      (let ((z (vector (integer? x) (vector (integer? x)))))
+	(test (z 0) ((z 1) 0))))
+    (func)))
+
+(let ()
+  (require mockery.scm)
+  (let ((v ((*mock-vector* 'make-mock-vector) 10 0)))
+    (test (vector? v) #t)
+    (let-temporarily (((*s7* 'print-length) 32))
+      (test (object->string v) "#(0 0 0 0 0 0 0 0 0 0)"))
+    (test (length v) 10)
+    (test (vector-length v) 10)
+    (test (vector-dimensions v) '(10))
+    (test (vector-set! v 0 1) 1)
+    (test (vector-ref v 0) 1)
+    (test (v 0) 1)
+    (test (set! (v 1) 2) 2)
+    (test (v 1) 2)
+    (fill! v 0)
+    (test (v 'value) #(0 0 0 0 0 0 0 0 0 0))
+    (test (equivalent? v #(0 0 0 0 0 0 0 0 0 0)) #t)
+    (test (equivalent? #(0 0 0 0 0 0 0 0 0 0) v) #t)
+    (test (equivalent? v ((*mock-vector* 'make-mock-vector) 10 0)) #t)
+    (unless pure-s7 (vector-fill! v 3 1 4))
+    (unless pure-s7 (test (v 'value) #(0 3 3 3 0 0 0 0 0 0)))
+    (unless pure-s7 (test (vector->list v) '(0 3 3 3 0 0 0 0 0 0)))
+    (unless pure-s7 (test (map (lambda (a) (+ a 1)) v) '(1 4 4 4 1 1 1 1 1 1)))
+    (do ((i 0 (+ i 1)))
+	((= i 10))
+      (set! (v i) i))
+    (test (v 'value) #(0 1 2 3 4 5 6 7 8 9))
+    (for-each (lambda (x) (test (integer? x) #t)) v)
+    (let ((v1 (subvector v 2 5 '(3))))
+      (test v1 #(2 3 4)))
+    (sort! v >)
+    (test (v 'value) #(9 8 7 6 5 4 3 2 1 0))
+    (test (reverse v) #(0 1 2 3 4 5 6 7 8 9))
+    (test (let* ((y (list 1)) (x ((*mock-vector* 'mock-vector) y))) (set! (y 0) x) (null? (cyclic-sequences x))) #f)
+
+    (let ((v1 ((*mock-vector* 'make-mock-vector) 10 1)))
+      (let ((v2 ((*mock-vector* 'make-mock-vector) 10 1)))
+	(set! (v1 3) 32)
+	(test (equal? (v1 'value) (v2 'value)) #f)))
+#|
+    (let ((v1 #(1 2 3))
+	  (v2 ((*mock-vector* 'make-mock-vector) 2 4)))
+      (test (vector-append v1 v2) #(1 2 3 4 4))
+      (test (vector-append v2 v1) #(4 4 1 2 3))
+      (test (vector-append v1 v1 v2) #(1 2 3 1 2 3 4 4))
+      (test (vector-append v2 v2 v1) #(4 4 4 4 1 2 3)))
+|#
+    (let ((v1 ((*mock-vector* 'mock-vector) 0 1 2 3 4)))
+      (test (subsequence v1 0 2) #(0 1))))
+
+  (let ((v1 ((*mock-vector* 'mock-vector) 1 2 3 4))
+	(v2 ((*mock-vector* 'mock-vector) 2 3 4))
+	(v3 #(1 2 3 4))
+	(v4 #(2 3 4)))
+    (vector-set! v2 0 v1)
+    (vector-set! v1 0 v2)
+    (vector-set! v4 0 v3)
+    (vector-set! v3 0 v4)
+    (test (equivalent? v1 v3) #f))
+
+  (let ()
+    (define (vset v i j k)
+      (let ((x 3.0))
+	(vector-set! v 0 x)
+	(vector-set! v j (vector-ref v i))
+	(vector-set! v i (+ (vector-ref v j) x))
+	(vector-set! v k x)))
+    (let ((v (vector 1 2 0)) (i 0) (j 1) (k 2)) (vset v i j k) (test (equivalent? v #(6.0 3.0 3.0)) #t))
+    (let ((v ((*mock-vector* 'mock-vector) 1 2 0)) (i 0) (j 1) (k 2)) (vset v i j k) (test (equivalent? v #(6.0 3.0 3.0)) #t))
+    (let ((v (vector 1 2 0))
+	  (i ((*mock-number* 'mock-number) 0))
+	  (j ((*mock-number* 'mock-number) 1))
+	  (k ((*mock-number* 'mock-number) 2)))
+      (vset v i j k) (test (equivalent? v #(6.0 3.0 3.0)) #t))
+    (let ((v ((*mock-vector* 'mock-vector) 1 2 0))
+	  (i ((*mock-number* 'mock-number) 0))
+	  (j ((*mock-number* 'mock-number) 1))
+	  (k ((*mock-number* 'mock-number) 2)))
+      (vset v i j k) (test (equivalent? v #(6.0 3.0 3.0)) #t))
+    (let ((v (vector 1 2 0)) (i 0) (j ((*mock-number* 'mock-number) 1)) (k 2)) (vset v i j k) (test (equivalent? v #(6.0 3.0 3.0)) #t)))
+
+  (test (+ ((*mock-number* 'mock-number) 1) ((*mock-number* 'mock-number) 2)) 3)
+  (unless with-bignums (test (pair? (memv (log ((*mock-number* 'mock-number) 2) ((*mock-number* 'mock-number) 2)) '(1 1.0))) #t))
+  (test (let () (define (func) (with-let (mock-number 0) (make-polar 3 (cddadr #())))) (define (hi) (func)) (hi)) 'error)
+
+  (test (/ ((*mock-number* 'mock-number) 0) 1) 0)
+  (test (/ ((*mock-number* 'mock-number) 0) ((*mock-number* 'mock-number) 1-i) ((*mock-number* 'mock-number) 3/4)) 0.0)
+  (test (make-float-vector 0 ((*mock-number* 'mock-number) 3)) #())
+
+  (test (= ((*mock-number* 'mock-number) 0) ((*mock-number* 'mock-number) 0) ((*mock-number* 'mock-number) 0)) #t)
+  (test (= ((*mock-number* 'mock-number) 0) ((*mock-number* 'mock-number) 0) #\a) 'error)
+  (test (nan? (/ 0 1-1i +inf.0 +nan.0)) #t)
+  (test (nan? (/ ((*mock-number* 'mock-number) 0) ((*mock-number* 'mock-number) 1-1i) ((*mock-number* 'mock-number) +inf.0) ((*mock-number* 'mock-number) +nan.0))) #t)
+  (test (/ ((*mock-number* 'mock-number) 0) ((*mock-number* 'mock-number) 0.0)) 'error)
+  (test (/ 0.0 0) 'error)
+  (test (/ ((*mock-number* 'mock-number) 0.0) ((*mock-number* 'mock-number) 0)) 'error)
+
+  (let ((X ((*mock-number* 'mock-number) 0)))
+    (define (f1) (do ((i 0 (+ i 1))) ((= i 1) (= X 1))))
+    (test (f1) #f)) ; testing fx_c_equal_ic
+
+  (test (length (append '(1) ((*mock-number* 'mock-number) 1))) -1) ; '(1 . 1)
+  (test (number? (append ((*mock-number* 'mock-number) 1))) #t)
+  (test (append ((*mock-number* 'mock-number) 1) ()) 'error)
+  (test (fill! ((*mock-number* 'mock-number) 1) #\a) 'error)
+  (test (reverse! ((*mock-number* 'mock-number) 1) #\a) 'error)
+
+  (test (string=? "hi" ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #t)
+  (test (string=? "hi" ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "ho")) #f)
+  (test (string=? "hi" ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") "hi") #t)
+  (test (string=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") "hi") #t)
+  (test (string=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #t)
+  (test (string<=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #t)
+  (test (string>=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #t)
+  (test (string>=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hj")) #f)
+  (test (string>=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hj") 1) 'error)
+  (test (string>=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hj") ((*mock-number* 'mock-number) 1)) 'error)
+  (test (string<? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #f)
+  (test (string>? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #f)
+  (test (string<? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hih") ((*mock-string* 'mock-string) "hihi")) #t)
+  (test (string>? ((*mock-string* 'mock-string) "hihi") ((*mock-string* 'mock-string) "hih") ((*mock-string* 'mock-string) "hi")) #t)
+  (test (string>? ((*mock-string* 'mock-string) "hihi") ((*mock-string* 'mock-string) "hih") ((*mock-string* 'mock-string) "hih")) #f)
+  (test (string>? ((*mock-string* 'mock-string) "hihi") ((*mock-string* 'mock-string) "hih") ((*mock-string* 'mock-string) "hih") #\a) 'error)
+  (test (string>? ((*mock-string* 'mock-string) "hihi") ((*mock-string* 'mock-string) "hih") ((*mock-string* 'mock-string) "hih") ((*mock-number* 'mock-number) 1)) 'error)
+
+  (test (char=? #\i ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i)) #t)
+  (test (char=? #\i ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\k)) #f)
+  (test (char=? #\i ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) #\i) #t)
+  (test (char=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) #\i) #t)
+  (test (char=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i)) #t)
+  (test (char<=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i)) #t)
+  (test (char>=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i)) #t)
+  (test (char>=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\j)) #f)
+  (test (char>=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\j) 1) 'error)
+  (test (char>=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\j) ((*mock-number* 'mock-number) 1)) 'error)
+  (test (char<? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i)) #f)
+  (test (char>? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i)) #f)
+  (test (char<? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\p)) #t)
+  (test (char>? ((*mock-char* 'mock-char) #\p) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\i)) #t)
+  (test (char>? ((*mock-char* 'mock-char) #\p) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\m)) #f)
+  (test (char>? ((*mock-char* 'mock-char) #\p) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\m) "a") 'error)
+  (test (char>? ((*mock-char* 'mock-char) #\p) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\m) ((*mock-number* 'mock-number) 1)) 'error)
+
+  (test (string-ci=? "hi" ((*mock-string* 'mock-string) "HI") ((*mock-string* 'mock-string) "hi")) #t)
+  (test (string-ci=? "hi" ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "ho")) #f)
+  (test (string-ci=? "hi" ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") "HI") #t)
+  (test (string-ci=? ((*mock-string* 'mock-string) "HI") ((*mock-string* 'mock-string) "hi") "hi") #t)
+  (test (string-ci=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "HI") ((*mock-string* 'mock-string) "hi")) #t)
+  (test (string-ci<=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #t)
+  (test (string-ci>=? ((*mock-string* 'mock-string) "HI") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #t)
+  (test (string-ci>=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hj")) #f)
+  (test (string-ci>=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hj") 1) 'error)
+  (test (string-ci>=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "HI") ((*mock-string* 'mock-string) "hj") ((*mock-number* 'mock-number) 1)) 'error)
+  (test (string-ci<? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #f)
+  (test (string-ci<? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hih") "hi") #f)
+  (test (string-ci>? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "HI")) #f)
+  (test (string-ci<? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "HIH") ((*mock-string* 'mock-string) "hihi")) #t)
+  (test (string-ci<? ((*mock-string* 'mock-string) "hi") "HIH" ((*mock-string* 'mock-string) "hihi")) #t)
+  (test (string-ci>? ((*mock-string* 'mock-string) "hihi") ((*mock-string* 'mock-string) "hih") ((*mock-string* 'mock-string) "HI")) #t)
+  (test (string-ci>? ((*mock-string* 'mock-string) "HIHI") ((*mock-string* 'mock-string) "hih") ((*mock-string* 'mock-string) "hih")) #f)
+  (test (string-ci>? ((*mock-string* 'mock-string) "hihi") ((*mock-string* 'mock-string) "HIH") ((*mock-string* 'mock-string) "hih") #\a) 'error)
+  (test (string-ci>? ((*mock-string* 'mock-string) "hihi") ((*mock-string* 'mock-string) "hih") ((*mock-string* 'mock-string) "HIH") ((*mock-number* 'mock-number) 1)) 'error)
+
+  (test (with-let ((*mock-string* 'mock-string) "1234") (substring "asdf" 2)) "df") ; there are a million more of these
+  (test (#_with-input-from-string ((*mock-string* 'mock-string) "1234") (lambda () (read-line))) "1234")
+
+  (test (let ((str ((*mock-string* 'mock-string) "1234"))) (fill! ms ms)) 'error)
+  (test (let ((str ((*mock-string* 'mock-string) "1234"))
+	      (chr ((*mock-char* 'mock-char) #\a)))
+	  (string-fill! str chr))
+	#\a)
+  (test (let ((str ((*mock-char* 'mock-char) #\a))) (string-fill! str #\a)) 'error)
+  (let ((str ((*mock-string* 'mock-string) "1234"))
+	(chr ((*mock-char* 'mock-char) #\a))
+	(num ((*mock-number* 'mock-number) 1)))
+    (test (string-fill! "123" #\a str) 'error)
+    (test (string-fill! "123" #\a 0 str) 'error)
+    (test (string-fill! "123" #\a 0 chr) 'error)
+    (test (string-fill! "123" #\a chr) 'error)
+    (test (string-fill! "123" str) 'error)
+    (test (string-fill! str #\a chr) 'error)
+    (test (string-fill! str chr num) #\a)
+    (test (string-fill! str num) 'error)
+    (test (string-fill! num #\a) 'error)
+    (test (string-fill! num chr) 'error)
+    (unless pure-s7
+      (test (string-fill! "123" #\a num) #\a)
+      (test (string-fill! "123" #\a 0 num) #\a)))
+
+  (test (object->string ((*mock-number* 'mock-number) 1) :readable)
+	"(openlet (immutable! (sublet *mock-number* :value 1 :mock-type 'mock-number?)))")
+  (test (object->string (sublet ((*mock-number* 'mock-number) 1) :asdf 2) :readable)
+	"(openlet (sublet *mock-number* :asdf 2))")
+  (test (object->string (sublet (inlet :asdf 3) :mn ((*mock-number* 'mock-number) 1)) :readable)
+	"(sublet (inlet :asdf 3) :mn (openlet (immutable! (sublet *mock-number* :value 1 :mock-type 'mock-number?))))")
+  (test (format #f "~W" ((*mock-number* 'mock-number) 1))
+	"(openlet (immutable! (sublet *mock-number* :value 1 :mock-type 'mock-number?)))")
+
+  (test (char-ci=? #\i ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\I)) #t)
+  (test (char-ci=? #\i ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\k)) #f)
+  (test (char-ci=? #\I ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) #\i) #t)
+  (test (char-ci=? ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\i) #\i) #t)
+  (test (char-ci=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\i)) #t)
+  (test (char-ci<=? ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i)) #t)
+  (test (char-ci>=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\i)) #t)
+  (test (char-ci>=? ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\j)) #f)
+  (test (char-ci>=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\J) 1) 'error)
+  (test (char-ci>=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\J) ((*mock-number* 'mock-number) 1)) 'error)
+  (test (char-ci<? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\i)) #f)
+  (test (char-ci>? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\i)) #f)
+  (test (char-ci<? ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\p)) #t)
+  (test (char-ci>? ((*mock-char* 'mock-char) #\P) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\i)) #t)
+  (test (char-ci>? ((*mock-char* 'mock-char) #\p) ((*mock-char* 'mock-char) #\M) ((*mock-char* 'mock-char) #\m)) #f)
+  (test (char-ci>? ((*mock-char* 'mock-char) #\p) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\M) "a") 'error)
+  (test (char-ci>? ((*mock-char* 'mock-char) #\p) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\m) ((*mock-number* 'mock-number) 1)) 'error)
+
+  (let ((c1 ((*mock-c-pointer* 'mock-c-pointer) 0 1 2 3 4)))
+    (test (c-pointer? c1) #t)
+    (test (c-pointer-type c1) 1)
+    (test (c-pointer-info c1) 2)
+    (test (c-pointer-weak1 c1) 3)
+    (test (c-pointer-weak2 c1) 4)
+    (test (pair? (member (object->string c1) '("#<c_pointer (nil)>" "#<c_pointer 0x0>"))) #t)
+    (test (fill! c1 #\a) 'error)
+    (test (reverse! c1 #\a) 'error))
+
+  (unless with-bignums
+    (let ((rs ((*mock-random-state* 'mock-random-state) 1234)))
+      (test (random-state? rs) #t)
+      (test (object->string rs) "#<random-state 1234 1675393560>")
+      (test (random-state->list rs) '(1234 1675393560))
+      (test (integer? (random rs)) 'error)
+      (test (integer? (random 100 rs)) #t)))
+
+  (let ((iter ((*mock-iterator* 'make-mock-iterator) "1234")))
+    (test (iterator? iter) #t)
+    (test (object->string iter) "#<iterator: string>")
+    (test (iterator-sequence iter) "1234")
+    (test (iterator-at-end? iter) #f)
+    (test (iterate iter) #\1))
+
+  (let ((L ((*mock-pair* 'mock-pair) 1 2 3)))
+    (let ((iter ((*mock-iterator* 'make-mock-iterator) L)))
+      (test (iterate iter) 1)
+      (test (iterate iter) 2)
+      (test (iterate iter) 3)
+      (test (iterate iter) #<eof>)))
+
+  (test (with-let ((*mock-number* 'mock-number) 0) (random 1)) 0)
+  (test (with-let ((*mock-char* 'mock-char) #\i) (char? 123)) #f)
+
+  (define (stretchable-vector)
+    (let ((local-ref (lambda (obj index)
+		       (if (>= index (length (obj 'value)))
+			   (obj 'initial-element)
+			   (#_vector-ref (obj 'value) index))))
+	  (local-set! (lambda (obj index val)
+			(if (>= index (length (obj 'value)))
+			    (set! (obj 'value) (copy (obj 'value) (make-vector (+ index 8) (obj 'initial-element)))))
+			(#_vector-set! (obj 'value) index val))))
+      (openlet
+       (sublet (*mock-vector* 'mock-vector-class)
+	 'value (vector)
+	 'mock-type 'mock-vector?
+	 'object->string (lambda* (obj (w #t)) (format #f "#<stretchable-vector: ~S>" (obj 'value)))
+	 'initial-element #f
+	 'vector-ref local-ref
+	 'let-ref-fallback local-ref
+	 'vector-set! local-set!
+	 'let-set-fallback local-set!))))
+
+  (let ((v1 (stretchable-vector))
+	(ind 12))
+    (test (vector-length v1) 0)
+    (test ((*mock-vector* 'mock-vector?) v1) #t)
+    (test (v1 123) #f)
+    (test (vector-length v1) 0)
+    (test (object->string v1) "#<stretchable-vector: #()>")
+    (set! (v1 ind) 32)
+    (test (v1 ind) 32)
+    (test (length v1) 20)
+    (test (v1 11) #f))
+
+  (let ((ht ((*mock-hash-table* 'mock-hash-table) 'a 1 'b 2)))
+    (test (ht 'a) 1)
+    (test (hash-table? ht) #t)
+    (test ((*mock-hash-table* 'mock-hash-table?) ht) #t)
+    (test (vector? ht) #f)
+    (test (equivalent? ht (hash-table 'a 1 'b 2)) #t)
+    (test (hash-table-ref ht 'b) 2)
+    (hash-table-set! ht 'c 3)
+    (test (ht 'c) 3)
+    (test (ht 'd) #f)
+    (set! (ht 'c) 32)
+    (test (hash-table-ref ht 'c) 32)
+    (test (length ht) (*s7* 'default-hash-table-length))
+    (test (hash-table-entries ht) 3)
+    (let ((ht1 (copy ht)))
+      (test (hash-table-ref ht1 'b) 2)
+      (test (hash-table-entries ht1) 3))
+    (let ((hti (make-iterator ht)))
+      (for-each (lambda (x)
+		  (if (not (equal? x (hti)))
+		      (format *stderr* "hti not ~A~%" x)))
+		ht))
+    (fill! ht ())
+    (test (hash-table-entries ht) 3))
+
+  (test (let ((v (vector 0 0))) (copy ((*mock-hash-table* 'mock-hash-table) 'b 2) v) v) #((b . 2) 0))
+  (test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (with-let ((*mock-hash-table* 'mock-hash-table) 'b 2) (undefined-function '(4) 1)))) (f)) 'error)
+  (test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (with-let ((*mock-hash-table* 'mock-hash-table) 'b 2) (undefined-function 4)))) (f)) 'error)
+
+  (unless pure-s7 (test (let ((e (openlet (inlet 'fill! (lambda (obj val) (string-fill! (obj 'value) val)) 'value "01234")))) (vector-fill! e #\a) (e 'value)) 'error))
+  (test (let ((e (openlet (inlet 'call/cc (lambda (obj) 32))))) (call/cc e)) 32)
+  (test (let ((e (openlet (inlet 'call-with-current-continuation (lambda (obj) 32))))) (call/cc e)) 32)
+
+  (let () ; from tmock, op_simple_do has_fn problem
+    (define dolph-1
+      (lambda (N gamma)
+        (let ((w (make-vector 256 1.0)))
+	  (do ((i 0 (+ i 1)))
+	      ((= i N))
+	    (set! (w i) (abs i)))
+          w)))
+    (dolph-1 (expt 2 8) 0.5)
+    (dolph-1 ((*mock-number* 'mock-number) (expt 2 8)) 0.5))
+
+  (define (gloomy-hash-table)
+    (openlet
+     (sublet (*mock-hash-table* 'mock-hash-table-class)
+       'value #f
+       'mock-type 'mock-hash-table?
+       'false (gensym)
+       'not-a-key #f
+       'hash-table-ref (lambda (obj key)
+			 (let ((val (#_hash-table-ref (obj 'value) key)))
+			   (if (eq? val (obj 'false))
+			       #f
+			       (or val (obj 'not-a-key)))))
+       'hash-table-key? (lambda (obj key)
+			  (#_hash-table-ref (obj 'value) key)))))
+
+  (define* (make-gloomy-hash-table (len 511) not-a-key)
+    (let ((ht (gloomy-hash-table)))
+      (set! (ht 'value) (make-hash-table len))
+      (set! (ht 'mock-type) 'mock-hash-table?)
+      (set! (ht 'not-a-key) not-a-key)
+      ht))
+
+  (define (hash-table-key? obj key) ((obj 'hash-table-key?) obj key))
+
+  (let ((ht (make-gloomy-hash-table :not-a-key 'nope)))
+    (test (hash-table-key? ht 'a) #f)
+    (test (hash-table-ref ht 'a) 'nope)
+    (hash-table-set! ht 'a 1)
+    (test (not (hash-table-key? ht 'a)) #f)
+    (test (ht 'a) 1))
+
+  (let ((s ((*mock-string* 'mock-string) #\a #\b #\c)))
+    (test (length s) 3)
+    (unless pure-s7 (test (string-length s) 3))
+    (test (string? s) #t)
+    (test (equivalent? s "abc") #t)
+    (test ((*mock-string* 'mock-string?) s) #t)
+    (test (string-append "asd" ((*mock-string* 'mock-string) "hi")) "asdhi")
+    (test (append "asd" ((*mock-string* 'mock-string) "hi")) "asdhi")
+    (test ((*mock-vector* 'mock-vector?) s) #f)
+    (test (string-ref s 0) #\a)
+    (test (string-set! s 0 #\A) #\A)
+    (test (s 0) #\A)
+    (test (set! (s 1) #\B) #\B)
+    (test (s 1) #\B)
+    (unless pure-s7 (test (string->list s) '(#\A #\B #\c)))
+    (test (string-append s "d") "ABcd")
+    (test (string-append "d" s "e") "dABce")
+    (test (string-append "d" "f" s) "dfABc")
+    (test (string-append "d" "f" s "gh") "dfABcgh")
+    (test (reverse s) "cBA")
+    (test (copy s) "ABc")
+    (test (string-copy s) "ABc")
+    (test (object->string s) "\"ABc\"")
+    (test (string=? s "ABc") #t)
+    (test (string=? "ABc" s) #t)
+    (test (string=? s "ABC") #f)
+    (test (substring s 0 1) "A")
+    (test (string-downcase s) "abc")
+    (test (string-upcase s) "ABC")
+    (test (string->symbol s) 'ABc)
+    (test (gensym? (gensym s)) #t)
+    (test (string->keyword s) :ABc)
+    (test (map values s) '(#\A #\B #\c))
+    (test (string>? s "ABC") #t)
+    (test (string-ci>? s "ABC") #f)
+    (test (string<? s "ABC") #f)
+    (test (string-ci<=? s "ABC") #t)
+    (test (string>=? s "ABC") #t)
+    (test (string-ci>=? s "ABC") #t)
+    (test (string<=? s "ABC") #f)
+    (test (string-ci<=? s "ABC") #t)
+    (test (call-with-input-string s read) 'ABc)
+    (test (with-input-from-string s read) 'ABc)
+    (test (let ((p (open-input-string s))) (let ((r (read p))) (close-input-port p) r)) 'ABc)
+    (unless pure-s7
+      (string-fill! s #\1)
+      (test (s 0) #\1)
+      (test (string->number s) 111))
+    (fill! s #\2)
+    (test (s 1) #\2)
+    (for-each (lambda (c) (if (not (char=? c #\2)) (format *stderr* ";fill! mock-string: ~C~%" c))) s)
+    (test (format #f s) "222")
+    (test (format #f "~A" s) "222")
+    (test (format s) 'error)
+    (test (eval-string s) 222)
+    (test (string-position "2" s) 0)
+    (test (string->byte-vector s) #u(50 50 50)))
+
+  (let ((c ((*mock-char* 'mock-char) #\a)))
+    (test (char? c) #t)
+    (test ((*mock-char* 'mock-char?) c) #t)
+    (test (equivalent? c #\a) #t)
+    (test (fill! c 123) 'error)
+    (test (reverse! c 123) 'error)
+    (test (char-upcase c) #\A)
+    (test (char-downcase c) #\a)
+    (test (char->integer c) 97)
+    (test (char-upper-case? c) #f)
+    (test (char-lower-case? c) #t)
+    (test (char-alphabetic? c) #t)
+    (test (char-numeric? c) #f)
+    (test (char-whitespace? c) #f)
+    (test (char=? c #\A) #f)
+    (test (char=? c #\a) #t)
+    (test (char<? c #\b) #t)
+    (test (char<=? c #\b) #t)
+    (test (char>? c #\b) #f)
+    (test (char>=? c #\b) #f)
+    (test (char-ci=? c #\A) #t)
+    (test (char-ci=? c #\a) #t)
+    (test (char-ci<? c #\b) #t)
+    (test (char-ci<=? c #\b) #t)
+    (test (char-ci>? c #\b) #f)
+    (test (char-ci>=? c #\b) #f)
+    (test (char-position c "abc") 0)
+    (test (char-position ((*mock-char* 'mock-char) #\b) "hoho" 63) #f)
+    (test (char-position #\null "hoho" ((*mock-char* 'mock-char) #\b)) 'error)
+    (test (char-position ((*mock-char* 'mock-char) #\null) "hoho" ((*mock-char* 'mock-char) #\b)) 'error)
+    (test (object->string c #f) "a")
+    (test (copy c) #\a)
+    (test (string c #\b) "ab")
+    (test (string #\c c) "ca")
+    (test (string #\a c c #\b) "aaab")
+    (test (format #f "~C" c) (format #f "~C" (c 'value)))
+    (let ((str "0123"))
+      (string-set! str 1 c)
+      (test str "0a23"))
+    )
+
+  (let ()
+    (define (char-ci=? . chars) (apply char=? (map char-upcase chars)))
+    (define (f) (let ((c ((*mock-char* 'mock-char) #\a))) (char-ci=? c #\a)))
+    (test (f) #t))
+
+  (let ((mock-number (*mock-number* 'mock-number))
+	(mock-number? (*mock-number* 'mock-number?)))
+
+    (test ((lambda () (gcd (mock-number 1-i) ((lambda (a) (values a (+ a 1))) 2)))) 'error)
+    (test (let () (define (func) (vector (values (lcm (mock-number 2.0) (values 1 2 3 4 5 6 7 8 9 10))))) (func)) 'error)
+
+    (let ((i (mock-number 32))
+	  (x (mock-number pi))
+	  (z (mock-number 1+i))
+	  (r (mock-number 3/2)))
+      (let ((nums (list i r x z))
+	    (rnums (list i r x)))
+	(define (practically-equal? tst l1 l2)
+	  (call-with-exit
+	   (lambda (quit)
+	     (for-each (lambda (n1 n2)
+			 (when (not (number-ok? tst n1 n2))
+			   (format *stderr* ";~S: ~A ~A~%" tst n1 n2)
+			   (quit #f)))
+		       l1 l2)
+	     #t)))
+	(test (map mock-number? nums) '(#t #t #t #t))
+	(test (equivalent? i 32) #t)
+	(if with-bignums
+	    (test (map object->string nums) '("32" "3/2" "3.141592653589793238462643383279502884195E0" "1.0+1.0i"))
+	    (test (map object->string nums) '("32" "3/2" "pi" "1.0+1.0i")))
+	(test (equivalent? (map copy nums) (list 32 3/2 pi 1+1i)) #t)
+	(test (practically-equal? 'real-part (map real-part nums) (list 32 3/2 pi 1.0)) #t)
+	(test (map imag-part nums) '(0 0 0.0 1.0))
+	(test (numerator i) 32)
+	(test (numerator r) 3)
+	(test (denominator i) 1)
+	(test (denominator r) 2)
+	(test (even? i) #t)
+	(test (odd? i) #f)
+	(test (map zero? nums) '(#f #f #f #f))
+	(test (map positive? rnums) '(#t #t #t))
+	(test (map negative? rnums) '(#f #f #f))
+	(test (map infinite? nums) '(#f #f #f #f))
+	(test (map nan? nums) '(#f #f #f #f))
+	(num-test (make-polar i r) (make-polar 32 3/2))
+	(num-test (make-polar x i) (make-polar pi 32))
+	(num-test (complex i r) (complex 32 3/2))
+	(test (practically-equal? 'magnitude (map magnitude nums) (list 32 3/2 pi (sqrt 2))) #t)
+	(test (practically-equal? 'angle (map angle nums) '(0 0 0.0 0.7853981633974483)) #t)
+	(num-test (rationalize x) (rationalize pi))
+
+        (test (let () (define (func) (>= (mock-number 4/3) (call-with-exit (lambda (return) (return 1 2))))) (func)) #f)
+        (test (let () (define (func) (> (mock-number 4/3) (call-with-exit (lambda (return) (return 1 2))))) (func)) #f)
+        (test (let () (define (func) (<= (mock-number 4/3) (call-with-exit (lambda (return) (return 3 2)))))(func)) #f)
+        (test (let () (define (func) (< (mock-number 4/3) (call-with-exit (lambda (return) (return 3 2))))) (func)) #f)
+        (test (let () (define (func) (max (mock-number 4/3) (call-with-exit (lambda (return) (return 1 2))))) (func)) 2)
+        (test (let () (define (func) (min (mock-number 4/3) (call-with-exit (lambda (return) (return 2 1))))) (func)) 1)
+        (test (let () (define (func) (min (mock-number 4) (call-with-exit (lambda (return) (return 2 1))))) (func)) 1)
+        (test (let () (define (func) (+ (mock-number 4) (call-with-exit (lambda (return) (return 2 1))))) (func)) 7)
+        (test (let () (define (func) (+ (mock-number 4) (call-with-exit (lambda (return) (return 1 2))))) (func)) 7)
+        (test (let () (define (func) (>= (mock-number 4) (call-with-exit (lambda (return) (return 1 2))))) (func)) #f)
+        (test (let () (define (func) (>= (mock-number 4) (call-with-exit (lambda (return) (return 2 1))))) (func)) #t)
+        (test (let () (define (func) (>= (mock-number 4) (call-with-exit (lambda (return) (return (mock-number 1) 2))))) (func)) #f)
+        (test (let () (define (func) (>= 4 (call-with-exit (lambda (return) (return 1 2))))) (func)) #f)
+        (test (let () (define (func) (>= (mock-number 4) 3 (call-with-exit (lambda (return) (return 1 0 2))))) (func)) #f)
+        (test (let () (define (func) (< (mock-number 4) (call-with-exit (lambda (return) (return 5 6))))) (func)) #t)
+        (test (let () (define (func) (< 4 (call-with-exit (lambda (return) (return (mock-number 5) 6))))) (func)) #t)
+        (test (let () (define (func) (< 4 (call-with-exit (lambda (return) (return 5 (mock-number 6)))))) (func)) #t)
+
+	(test (practically-equal? 'abs (map abs rnums) '(32 3/2 3.141592653589793)) #t)
+	(test (practically-equal? 'exp (map exp nums) '(78962960182680.69 4.481689070338065 23.14069263277927 1.468693939915885+2.287355287178842i)) #t)
+	(test (practically-equal? 'log (map log nums) '(3.465735902799727 0.4054651081081644 1.1447298858494 0.3465735902799727+0.7853981633974483i)) #t)
+	(test (practically-equal? 'sin (map sin nums) '(0.5514266812416906 0.9974949866040544 1.224646799147353e-16 1.298457581415977+0.6349639147847361i)) #t)
+	(test (practically-equal? 'cos (map cos nums) '(0.8342233605065102 0.07073720166770291 -1.0 0.8337300251311491-0.9888977057628651i)) #t)
+	(test (practically-equal? 'tan (map tan nums) '(0.6610060414837631 14.10141994717172 -1.224646799147353e-16 0.2717525853195117+1.083923327338695i)) #t)
+	(test (practically-equal? 'asin (map asin nums) '(1.570796326794897-4.158638853279167i 1.570796326794897-0.9624236501192069i
+							  1.570796326794897-1.811526272460853i 0.6662394324925153+1.061275061905036i)) #t)
+	(test (practically-equal? 'acos (map acos nums) '(0+4.158638853279167i 0+0.9624236501192069i 0+1.811526272460853i 0.9045568943023813-1.061275061905036i)) #t)
+	(test (practically-equal? 'atan (map atan nums) '(1.539556493364628 0.9827937232473291 1.262627255678912 1.017221967897851+0.4023594781085251i)) #t)
+	(test (practically-equal? 'sinh (map sinh nums) '(39481480091340.34 2.129279455094817 11.54873935725775 0.6349639147847361+1.298457581415977i)) #t)
+	(test (practically-equal? 'cosh (map cosh nums) '(39481480091340.34 2.352409615243247 11.59195327552152 0.8337300251311491+0.9888977057628651i)) #t)
+	(test (practically-equal? 'tanh (map tanh nums) '(1.0 0.9051482536448664 0.99627207622075 1.083923327338695+0.2717525853195117i)) #t)
+	(test (practically-equal? 'asinh (map asinh nums) '(4.15912713462618 1.194763217287109 1.862295743310848 1.061275061905036+0.6662394324925153i)) #t)
+	(test (practically-equal? 'acosh (map acosh nums) '(4.158638853279167 0.9624236501192069 1.811526272460853 1.061275061905036+0.9045568943023813i)) #t)
+	(test (practically-equal? 'atanh (map atanh nums) '(0.03126017849066698+1.570796326794897i 0.8047189562170503+1.570796326794897i
+                                                            0.3297653149566991+1.570796326794897i 0.4023594781085251+1.017221967897851i)) #t)
+	(test (practically-equal? 'sqrt (map sqrt nums) '(5.656854249492381 1.224744871391589 1.772453850905516 1.09868411346781+0.4550898605622273i)) #t)
+	(test (practically-equal? 'expt (map (lambda (n) (expt n 2)) nums) '(1024 9/4 9.869604401089358 1.224606353822377e-16+2i)) #t)
+	(test (practically-equal? 'expt (map (lambda (n) (expt n r)) nums) '(181.0193359837562 1.837117307087384 5.568327996831708
+                                                                             0.6435942529055828+1.553773974030037i)) #t)
+	(test (map floor rnums) '(32 1 3))
+	(test (map ceiling rnums) '(32 2 4))
+	(test (map truncate rnums) '(32 1 3))
+	(test (map round rnums) '(32 2 3))
+	(test (integer->char (mock-number (char->integer #\a))) #\a)
+	(test (practically-equal? 'exact->inexact (map exact->inexact rnums) '(32.0 1.5 3.141592653589793)) #t)
+	(unless (provided? 'pure-s7) (test (integer-length i) 6))
+	(test (integer-decode-float x) (if with-bignums '(267257146016241686964920093290467695825 -126 1) '(7074237752028440 -51 1)))
+	(test (map number? nums) '(#t #t #t #t))
+	(test (map integer? nums) '(#t #f #f #f))
+	(test (map real? nums) '(#t #t #t #f))
+	(test (map complex? nums) '(#t #t #t #t))
+	(test (map rational? nums) '(#t #t #f #f))
+	(unless pure-s7
+	  (let-temporarily (((*s7* 'default-rationalize-error) 1e-12))
+	    (test (map inexact->exact rnums) '(32 3/2 4272943/1360120)))
+	  (test (map exact? nums) '(#t #t #f #f))
+	  (test (map inexact? nums) '(#f #f #t #t)))
+
+	(test (ash 1 i) 4294967296)
+	(test (ash i -3) 4)
+	(test (logbit? i 1) #f)
+	(test (logbit? 1 i) #f)
+	(if with-bignums
+	    (test (map number->string nums) '("32" "3/2" "3.141592653589793238462643383279502884195E0" "1.0+1.0i"))
+	    (test (map number->string nums) '("32" "3/2" "3.141592653589793" "1.0+1.0i")))
+	(test (every? number? (map random nums)) #t)
+	(test (quotient i r) 21)
+	(test (remainder i r) 1/2)
+	(test (modulo i r) 1/2)
+	(test (lognot i) -33)
+	(test (logior i 2) 34)
+	(test (logior 1 i 2 3) (logior 1 32 2 3))
+	(test (logior 1 7 i 62) (logior 1 7 32 62))
+	(test (logior (mock-number 1) (mock-number 8) 2 4 16 (mock-number 32)) 63)
+	(test (logxor (mock-number 1) (mock-number 7) 2 4 16 (mock-number 32)) (logxor 1 7 2 4 16 32))
+	(test (logand 63 15 31 127) (logand 63 (mock-number 15) (mock-number 31) 127))
+        (test (+ (mock-number 4/3) (values)) 'error)
+        (test (+ (mock-number 4/3) (values) 1) 'error)
+	(num-test (apply + nums) 37.6415926535898+1i)
+	(num-test (apply - nums) 26.35840734641021-1i)
+	(num-test (apply * nums) 150.7964473723101+150.7964473723101i)
+	(num-test (apply / nums) 3.3953054526271-3.3953054526271i)
+	(num-test (apply max rnums) 32)
+	(num-test (apply min rnums) 3/2)
+	(num-test (min 65 i) 32)
+	(test (apply < rnums) #f)
+	(test (apply > rnums) #f)
+	(test (apply <= rnums) #f)
+	(test (apply >= rnums) #f)
+	(test (< 1 3 i 47) #t)
+	(test (> 5/2 r 1/2 (/ i 100)) #t)
+	(test (<= 1.0 2.0 3.0 x) #t)
+	(test (>= 101.231 i 4 x 5/2 r) #t)
+	(test (> x z) 'error)
+	(test (> i 0) #t)
+	(test (< 0 i) #t)
+	(test (>= x 0.0) #t)
+	(test (<= 0.0 x) #t)
+	(test (apply = nums) #f)
+	(test (= i 32) #t)
+	(test (= 33 i) #f)
+	(test (= r 1/2) #f)
+	(test (lcm i 3/2) (lcm i r))
+	(test (lcm 3/2 i) (lcm r i))
+	(test (lcm 33 2 i) (lcm 2 i 33))
+	(test (lcm 33 x) 'error)
+	(test (apply lcm nums) 'error)
+	(test (lcm i 0 x) 'error)
+	(test (lcm 9 0 r) 0)
+	(test (gcd i 3/2) (gcd i r))
+	(test (gcd i 3/2) (gcd 32 3/2))
+	(test (gcd 3/2 i) (gcd r i))
+	(test (gcd 33 2 i) (gcd 2 i 33))
+	(test (gcd 33 x) 'error)
+	(test (apply gcd nums) 'error)
+	(test (gcd i 0 x) 'error)
+	(test (gcd 9 0 r) 3/2)
+
+	(unless with-bignums (test (<= +nan.0 (mock-number 1)) #f))
+	(test (<= 1 (mock-number 1)) #t)
+	(test (<= 1 (mock-number 1+i)) 'error)
+	(test (vector-ref #(0 1) (mock-number 0)) 0)
+	(test (vector-ref #(0 1) (mock-number 0+i)) 'error)
+
+	(test (format #f "~D" ((*mock-number* 'mock-number) 123)) "123")
+	(test (format #f "~F" ((*mock-number* 'mock-number) 1.23)) (format #f "~F" 1.23))
+	(test (format #f "~G" ((*mock-number* 'mock-number) 1.23)) (format #f "~G" 1.23))
+;	(test (format #f "~A" ((*mock-number* 'mock-number) 1.23)) (format #f "~A" 1.23))
+;	(test (format #f "~A" r) "3/2")
+	(test (format #f "~S" r) "3/2")
+
+	(let ((index (mock-number 2))
+	      (v #(0 1 2 3 4))
+	      (s "01234")
+	      (p (list 0 1 2 3 4)))
+	  (test (string-ref s index) #\2)
+	  (test (list-ref p index) 2)
+	  (test (vector-ref v index) 2)
+	  (test (s index) #\2)
+	  (test (p index) 2)
+	  (test (v index) 2)
+	  (test (subvector #(0 1 2 3) (mock-number 1) 4 '(3)) #(1 2 3))
+	  (unless pure-s7
+	    (test (vector->list #(0 1 2 3 4) (mock-number 1) (mock-number 3)) '(1 2))
+	    (test (vector->list #(0 1 2 3 4) index) '(2 3 4))
+	    (test (vector->list #(0 1 2 3 4) index index) ())
+	    (test (string->list "01234" index) '(#\2 #\3 #\4))
+	    (test (string->list "01234" 0 index) '(#\0 #\1)))
+	  (test (list-tail p index) '(2 3 4))
+	  (test (substring "01234" index) "234")
+	  (test (substring "01234" 0 index) "01")
+	  (test (substring "01234" index (mock-number 3)) "2")
+	  (test (let ((dest (make-string 3))) (copy "01234" dest index) dest) "234")
+	  (test (let ((dest (make-string 2))) (copy "01234" dest 0 index) dest) "01")
+	  (unless pure-s7 (test (let ((str "01234")) (string-fill! str #\a index) str) "01aaa"))
+	  (unless pure-s7 (test (let ((vec #(0 1 2 3 4))) (vector-fill! vec 5 (mock-number 0) (mock-number 3)) vec) #(5 5 5 3 4)))
+	  (test (let ((vec #2d((0 1 2) (3 4 5)))) (vector-ref vec (mock-number 1) index)) 5)
+	  )
+	(let ()
+	  (define mock-number (*mock-number* 'mock-number))
+	  (define (f) (with-let (mock-number 4/3) value))
+	  (define (g) (f))
+	  (test (g) 4/3)
+	  (test (with-let (mock-number 4/3) (random-state? (byte-vector))) #f))
+
+	(test (let ((vec ((*mock-vector* 'mock-vector) 10 11 12))) (vec ((*mock-number* 'mock-number) 1))) 11)
+	(test (let () (define (func) (copy ((*mock-string* 'mock-string) #\h #\o #\h #\o) #i(1 2))) (func)) #i(104 111))
+
+	(let ()
+	  (define-constant fv #(1 2 3))
+	  (define (func)
+	    (do ((i 0 (+ i 1)))
+		((= i 1)
+		 (vector-ref fv (mock-number 0)))))
+	  (test (func) 1))
+
+	(test-wi (object->string
+		  (vector (let ((<1> #f)
+			        (<2> (vector #f)))
+ 			    (set! <1> (make-iterator <2>))
+			    (set! (<2> 0) <1>)
+			    <1>)
+			  ((*mock-hash-table* 'mock-hash-table) 'b 2)) :readable)
+		 "(let ((<3> (vector #f #f))
+                        (<1> #f)
+                        (<2> (vector #f)))
+                    (set! <1> (make-iterator <2>))
+                    (set! (<3> 0) <1>)
+                    (set! (<3> 1) (openlet (sublet *mock-hash-table* :value (hash-table 'b 2) :mock-type 'mock-hash-table?)))
+                    (set! (<2> 0) <1>)
+                    <3>)")
+	(test-wi (object->string
+		  (vector (let ((<1> #f)
+				(<2> (vector #f)))
+			    (set! <1> (make-iterator <2>))
+			    (set! (<2> 0) <1>)
+			    <1>)
+			  ((*mock-pair* 'mock-pair) 1 2)) :readable)
+		 "(let ((<3> (vector #f #f))
+                        (<1> #f)
+                        (<2> (vector #f)))
+                    (set! <1> (make-iterator <2>))
+                    (set! (<3> 0) <1>)
+                    (set! (<3> 1) (openlet (sublet *mock-pair* :value (list 1 2) :mock-type 'mock-pair?)))
+                    (set! (<2> 0) <1>)
+                    <3>)")
+
+	(test (vector? (make-vector i)) #t)
+	(test (string? (make-string i)) #t)
+	(test (hash-table? (make-hash-table i)) #t)
+	(test (pair? (make-list i)) #t)
+
+	(define (p1-check . args)
+	  (if (> (magnitude (- (apply * args) 0.25+0.25i)) 1e-15)
+	      (format #t "~A: (* ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply * args)))
+	  (if (not (= (apply + args) 3+i))
+	      (format #t "~A: (+ ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply + args)))
+	  (if (not (= (apply - args) (- (car args) (apply + (cdr args)))))
+	      (format #t "~A: ~A != ~A? [- args: ~S]~%" (port-line-number) (apply - args) (- (car args) (apply + (cdr args))) args))
+	  (if (not (= (apply / args) (/ (car args) (apply * (cdr args)))))
+	      (format #t "~A: ~A != ~A? [/ args: ~S]~%" (port-line-number) (apply / args) (/ (car args) (apply * (cdr args))) args)))
+
+	(for-each
+	 (lambda (lst)
+	   (for-each-permutation p1-check lst))
+	 (list
+	  (list 1 1/2 0.5 1+i)
+	  (list (mock-number 1) 1/2 0.5 1+i)
+	  (list 1 (mock-number 1/2) 0.5 1+i)
+	  (list 1 1/2 (mock-number 0.5) 1+i)
+	  (list 1 1/2 0.5 (mock-number 1+i))
+	  (list (mock-number 1)
+		(mock-number 1/2)
+		(mock-number 0.5)
+		(mock-number 1+i))))
+
+        (test (catch #t (lambda () (+ (openlet (outlet (mock-number 1-i))) 1)) (lambda (type info) type)) 'wrong-type-arg) ; not stack overflow
+
+	)))
+
+  (let ()
+    (define mock-number (*mock-number* 'mock-number))
+    (test (let () (define (func) (* (mock-number 4/3) -1)) (define (hi) (func) (func)) (hi) (hi)) -4/3)
+    (test (let () (define (func) (* (mock-number 1-i) 0)) (define (hi) (func) (func)) (hi) (hi)) 0.0)
+    (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (byte-vector-ref #u(0 1) (mock-number 0))))) (define (hi) (func) (func)) (hi) (hi)) 0)
+    (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (int-vector-ref #i(0 1) (mock-number 0))))) (define (hi) (func) (func)) (hi) (hi)) 0)
+    (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (float-vector-ref #r(0 1) (mock-number 0))))) (define (hi) (func) (func)) (hi) (hi)) 0.0)
+
+    (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (vector-ref #(0 1) (mock-number 0))))) (define (hi) (func) (func)) (hi) (hi)) 0)
+    (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (string-ref "abc" (mock-number 0))))) (define (hi) (func) (func)) (hi) (hi)) #\a)
+    (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (list-ref '(0 1) (mock-number 0))))) (define (hi) (func) (func)) (hi) (hi)) 0)
+
+    (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (byte-vector-set! #u(0 1) (mock-number 0) 0)))) (define (hi) (func) (func)) (hi) (hi)) 0)
+    (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (byte-vector-set! #u(0 1) 0 (mock-number 0))))) (define (hi) (func) (func)) (hi) (hi)) 0)
+    (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (int-vector-set! #i(0 1) (mock-number 0) 0)))) (define (hi) (func) (func)) (hi) (hi)) 0)
+    (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (int-vector-set! #i(0 1) 0 (mock-number 0))))) (define (hi) (func) (func)) (hi) (hi)) 0)
+    (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (float-vector-set! #r(0 1) (mock-number 0) 0.0)))) (define (hi) (func) (func)) (hi) (hi)) 0.0)
+    (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (float-vector-set! #r(0 1) 0 (mock-number 0.0))))) (define (hi) (func) (func)) (hi) (hi)) 0.0)
+
+    (test (equivalent? (let ()
+			 (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (vector-set! #(0 1) 0 (mock-number 0)))))
+			 (define (hi) (func) (func)) (hi) (hi))
+		       (mock-number 0))
+	  #t)
+    (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (vector-set! #(0 1) (mock-number 0) 0)))) (define (hi) (func) (func)) (hi) (hi)) 0)
+    (test (let ((str "abs")) (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (string-set! str (mock-number 0) #\d)))) (define (hi) (func) (func)) (hi) (hi)) #\d)
+    (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (list-set! '(0 1) (mock-number 0) 0)))) (define (hi) (func) (func)) (hi) (hi)) 0)
+    (test (equivalent? (let ()
+			 (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (list-set! '(0 1) 0 (mock-number 0)))))
+			 (define (hi) (func) (func)) (hi) (hi))
+		       (mock-number 0))
+	  #t)
+
+    (test (with-let (mock-number 0) (append)) ())
+    (test (with-let (mock-number 2.0) (integer? #<unspecified>)) #f)
+    (test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (logxor ((*mock-number* 'mock-number) 4/3)))) (f)) 'error)
+    (test (let () (_do4_ (logxor (mock-number 4/3)))) 'error)
+    (test (let () (define (func) (_do4_ (logior (mock-number 4/3) 1))) (define (hi) (func) (func)) (hi) (hi)) 'error)
+    (test (let () (define (func) (lcm (mock-number 4/3))) (define (hi) (func) (func)) (hi) (hi)) 4/3)
+    )
+
+  (let ()
+    (let ((lst '(1 2 3)))
+      (list-set! lst ((inlet 'i 2) 'i) 32)
+      (test lst '(1 2 32)))
+    (let ((lst '((1 2 3))))
+      (list-set! lst 0 ((inlet 'i 2) 'i) 32)
+      (test lst '((1 2 32))))
+    (let ((lst '((1 2 3))))
+      (list-set! lst ((inlet 'i 0) 'i) ((inlet 'i 2) 'i) 32)
+      (test lst '((1 2 32))))
+    (let ((i0 ((*mock-number* 'mock-number) 0))
+	  (i1 ((*mock-number* 'mock-number) 1))
+	  (i2 ((*mock-number* 'mock-number) 2))
+	  (lst '((0 1 2) (3 4 5))))
+      (list-set! lst i0 i1 32)
+      (test lst '((0 32 2) (3 4 5)))))
+
+  (let ((mock-pair (*mock-pair* 'mock-pair))
+	(mock-pair? (*mock-pair* 'mock-pair?)))
+    (let ((lst (mock-pair 1 2 3)))
+
+      (test (pair? lst) #t)
+      (test (mock-pair? lst) #t)
+      (test ((outlet (mock-pair 1 2)) 'value) #<undefined>)
+      (test (equivalent? (list 1 2 3) lst) #t)
+      (test (equivalent? lst (mock-pair 1 2 3)) #t)
+      ;(test (integer? (pair-line-number lst)) #t)
+      (unless pure-s7 (test (list->string (mock-pair #\a #\b #\c)) "abc"))
+      (test (object->string lst) "(1 2 3)")
+      (test (list? lst) #t)
+      (test (null? lst) #f)
+      (test (car lst) 1)
+      (test (cdr lst) '(2 3))
+      (test (length lst) 3)
+      (test (arity lst) (cons 1 1))
+      (test (reverse lst) '(3 2 1))
+      (unless pure-s7 (test (list->vector lst) #(1 2 3)))
+      (test (map values lst) '(1 2 3))
+      (test (memq 2 lst) '(2 3))
+      (test (memv 3 lst) '(3))
+      (test (member 1 lst) '(1 2 3))
+      (test (list-tail lst 1) '(2 3))
+      (test (cadr lst) 2)
+      (test (caddr lst) 3)
+      (test (cddr lst) '(3))
+      (test (cdddr lst) ())
+      (test (list-ref lst 1) 2)
+      (set-car! lst 4)
+      (test (car lst) 4)
+      (list-set! lst 2 32)
+      (test (caddr lst) 32)
+      (set-cdr! lst ())
+      (test (length lst) 1)
+      (set! lst (apply mock-pair '((a . 1) (b . 2) (c . 3))))
+      (test (assq 'a lst) '(a . 1))
+      (test (assv 'b lst) '(b . 2))
+      (test (assoc 'c lst) '(c . 3))
+      (fill! lst 1)
+      (test (car lst) 1)
+      (set! lst (mock-pair 1 2 3))
+      (reverse! lst)
+      (test (copy lst) '(3 2 1))
+      (set! lst (apply mock-pair (sort! lst <)))
+      (test (copy lst) '(1 2 3))
+      (set! (lst 0) 4)
+      (test (lst 0) 4)
+      (test (list-tail lst 0) '(4 2 3))
+      (for-each (lambda (x) (if (not (integer? x)) (format *stderr* ";for-each mock-pair: ~A~%" x))) (mock-pair 1 2 3))
+      (test (subvector #(0 1 2 3) 0 2 (mock-pair 2)) #(0 1))
+      (test (caar (apply mock-pair '((a) b c d e f g))) 'a)
+      (test (cadr (apply mock-pair '(a b c d e f g))) 'b)
+      (test (cdar (apply mock-pair '((a b) c d e f g))) '(b))
+      (test (cddr (apply mock-pair '(a b c d e f g))) '(c d e f g))
+      (test (caaar (apply mock-pair '(((a)) b c d e f g))) 'a)
+      (test (caadr (apply mock-pair '(a (b) c d e f g))) 'b)
+      (test (cadar (apply mock-pair '((a b) c d e f g))) 'b)
+      (test (caddr (apply mock-pair '(a b c d e f g))) 'c)
+      (test (cdaar (apply mock-pair '(((a b)) c d e f g))) '(b))
+      (test (cdadr (apply mock-pair '(a (b c) d e f g))) '(c))
+      (test (cddar (apply mock-pair '((a b c) d e f g))) '(c))
+      (test (cdddr (apply mock-pair '(a b c d e f g))) '(d e f g))
+      (test (caaaar (apply mock-pair '((((a))) b c d e f g))) 'a)
+      (test (caaadr (apply mock-pair '(a ((b)) c d e f g))) 'b)
+      (test (caadar (apply mock-pair '((a (b)) c d e f g))) 'b)
+      (test (caaddr (apply mock-pair '(a b (c) d e f g))) 'c)
+      (test (cadaar (apply mock-pair '(((a b)) c d e f g))) 'b)
+      (test (cadadr (apply mock-pair '(a (b c) d e f g))) 'c)
+      (test (caddar (apply mock-pair '((a b c) d e f g))) 'c)
+      (test (cadddr (apply mock-pair '(a b c d e f g))) 'd)
+      (test (cdaaar (apply mock-pair '((((a b))) c d e f g))) '(b))
+      (test (cdaadr (apply mock-pair '(a ((b c)) d e f g))) '(c))
+      (test (cdadar (apply mock-pair '((a (b c)) d e f g))) '(c))
+      (test (cdaddr (apply mock-pair '(a b (c d) e f g))) '(d))
+      (test (cddaar (apply mock-pair '(((a b c)) d e f g))) '(c))
+      (test (cddadr (apply mock-pair '(a (b c d) e f g))) '(d))
+      (test (cdddar (apply mock-pair '((a b c d) e f g))) '(d))
+      (test (cddddr (apply mock-pair '(a b c d e f g))) '(e f g))
+      (test (cyclic-sequences (mock-pair 1 2 3)) ())
+      (test (let ((y (mock-pair (make-circular-list 3)))) (let ((x (cyclic-sequences y))) (length x))) 1)
+      (test (subsequence ((*mock-pair* 'mock-pair) 1 2 3 4) 2) '(3 4))
+      ))
+
+  (let ((mock-pair (*mock-pair* 'mock-pair)))
+    (let ((L1 (mock-pair 1)) ; make a list of mock-pairs, mock-pair copies its arglist as a normal list
+  	  (L2 (mock-pair 2))
+  	  (L3 (mock-pair 3)))
+      (set-cdr! L1 L2)
+      (set-cdr! L2 L3)
+      (test (length L1) 3)
+      (test (equivalent? (map sin L1) (map (lambda (x) (sin x)) L1)) #t)
+      (test (let loop ((p L1) (sum 0))
+  	      (if (null? p)
+  	 	  sum
+  	  	  (loop (cdr p) (+ sum (car p)))))
+  	    6)
+      (test (+ (car L1) (cadr L1) (caddr L1)) 6)))
+
+  (test (let ((lst ((*mock-pair* 'mock-pair) 1 2 3))) (append lst '(4 5 6))) '(1 2 3 4 5 6)) ; why were these commented out?
+  (test (let ((lst ((*mock-pair* 'mock-pair) 1 2 3))) (append '(4 5 6) lst ())) '(4 5 6 1 2 3))
+  (test (let ((lst ((*mock-pair* 'mock-pair) 1 2 3))) (append '(4 5 6) lst)) '(4 5 6 1 2 3))
+  (test (sort! 'begin ((*mock-pair* 'mock-pair) 1 2)) 'error)
+
+  (let ((immutable-list-class
+	 (sublet (*mock-pair* 'mock-pair-class)
+	   'object->string   (lambda (obj . args)
+			       (apply #_object->string (obj 'value) args))
+	   'let-set-fallback (lambda (obj i val)
+			       (set! (obj 'value) (append (copy (obj 'value) (make-list (+ i 1))) (list-tail (obj 'value) (+ i 1))))
+			       (list-set! (obj 'value) i val))
+	   'list-set!        (lambda (obj i val)
+			       (set! (obj 'value) (append (copy (obj 'value) (make-list (+ i 1))) (list-tail (obj 'value) (+ i 1))))
+			       (list-set! (obj 'value) i val))
+	   'set-car!         (lambda (obj val)
+			       (set! (obj 'value) (cons val (cdr (obj 'value)))))
+	   'set-cdr!         (lambda (obj val)
+			       (set! (obj 'value) (cons (car (obj 'value)) val)))
+	   'fill!            (lambda (obj val)
+			       (set! (obj 'value) (fill! (copy (obj 'value)) val)))
+	   'reverse!         (lambda (obj)
+			       (set! (obj 'value) (reverse (obj 'value))))
+	   'sort!            (lambda (obj func)
+			       (set! (obj 'value) (sort! (copy (obj 'value)) func))))))
+
+    (define (immutable-list lst)
+      (openlet
+       (sublet immutable-list-class
+	 'value lst
+	 'mock-type 'mock-pair?)))
+
+    (let ((L1 (immutable-list (list 1 2 3 4 5))))
+      (let ((L2 (cdr L1))
+	    (L3 (cons 0 (L1 'value))))
+	(list-set! L1 0 32)
+	(test (L1 'value) '(32 2 3 4 5))
+	(test L2 '(2 3 4 5))
+	(test L3 '(0 1 2 3 4 5))
+	(set! (L1 2) 32)
+	(test (L1 'value) '(32 2 32 4 5))
+	(test L2 '(2 3 4 5))
+	(test L3 '(0 1 2 3 4 5))
+	(set-cdr! L1 3)
+	(test (L1 'value) '(32 . 3))
+	(test L2 '(2 3 4 5))
+	(set! L1 (immutable-list (list 1 2 3 4 5)))
+	(set! L2 (cddr L1))
+	(set! L3 (cons 0 (L1 'value)))
+	(sort! L1 >)
+	(test (L1 'value) '(5 4 3 2 1))
+	(test L2 '(3 4 5))
+	(test L3 '(0 1 2 3 4 5))
+	(reverse! L1)
+	(test (L1 'value) '(1 2 3 4 5))
+	(test L2 '(3 4 5))
+	(test (object->string L1) "(1 2 3 4 5)")
+	)))
+
+  (let ((mock-symbol (*mock-symbol* 'mock-symbol))
+	(mock-symbol? (*mock-symbol* 'mock-symbol?)))
+    (let ((sym (mock-symbol 'a)))
+      (test (symbol? sym) #t)
+      (test (mock-symbol? sym) #t)
+      (test (equivalent? sym 'a) #t)
+      (test (fill! sym #\a) 'error)
+      (test (reverse! sym #\a) 'error)
+      (test (keyword? sym) #f)
+      (test (gensym? sym) #f)
+      (test (symbol->string sym) "a")
+      (let ((a 32))
+	(test (let ((a 32)) (symbol->value sym (curlet))) 32)
+	(test (symbol->dynamic-value sym) 32)
+	(test (defined? sym) #t)
+	(test (symbol->keyword sym) :a)
+	(test (provided? sym) #f)))
+    (let ((sym (mock-symbol :a)))
+      (test (keyword? sym) #t)
+      (test (keyword->symbol sym) 'a))
+    ;(let () (define* (f1 a b) (+ a b)) (test (f1 (mock-symbol :a) 3 :b 2) 5)) -- changed my mind again 20-Jan-19
+
+    (test (with-let (mock-symbol 'c) (float-vector? (provide 'pizza))) #f)
+    (test (with-let (mock-symbol 'c) (provide 'pizza)) 'pizza)
+    (test (let () (define (func) (with-let (mock-symbol 'c) (provide 'pizza))) (func)) 'pizza)
+    (test (let () (define (func) (with-let (mock-symbol 'c) (float-vector? (provide 'pizza)))) (func)) #f)
+    )
+
+  (let ((mock-port (*mock-port* 'mock-port))
+	(mock-port? (*mock-port* 'mock-port?)))
+    (let ((ip (open-input-string "0123456789"))
+	  (op (open-output-string)))
+      (let ((mip (mock-port ip))
+	    (mop (mock-port op)))
+	(test (mock-port? mip) #t)
+	(test (mock-port? ip) #f)
+	(test (mock-port? mop) #t)
+	(test (input-port? mip) #t)
+	(test (output-port? mip) #f)
+	(test (input-port? mop) #f)
+	(test (output-port? mop) #t)
+	(if (not pure-s7) (test (char-ready? mip) #t))
+	(test (char-ready? mop) 'error)
+	(test (port-closed? mip) #f)
+	(test (port-closed? mop) #f)
+;	(test (port-line-number mip) 0) ; ??
+	(test (port-filename mip) "")
+	(test (read-char mip) #\0)
+	(test (read-byte mip) (char->integer #\1))
+	(test (peek-char mip) #\2)
+	(test (read-string 3 mip) "234")
+	(test (read-line mip) "56789")
+	(close-input-port mip)
+	(test (port-closed? mip) #t)
+	(test (port-closed? ip) #t)
+	(write-char #\a mop)
+	(test (get-output-string mop) "a")
+	(write-byte (char->integer #\b) mop)
+	(test (get-output-string mop) "ab")
+	(write-string "cde" mop)
+	(test (get-output-string mop) "abcde")
+	(display #\f mop)
+	(write 'g mop)
+	(test (get-output-string mop) "abcdefg")
+	(format mop "~C~C" #\h #\i)
+	(test (get-output-string mop) "abcdefghi")
+	(test (flush-output-port mop) op)
+	(close-output-port mop)
+	(test (port-closed? mop) #t)
+	(test (port-closed? op) #t)
+	(set! mip (mock-port (open-input-string "(+ 1 2)")))
+	(test (eval (read mip)) 3)
+	(close-input-port mip)
+	))
+      (test (with-let (mock-port (open-input-string "asdf")) (append (block) (block))) (block))
+      (when full-s7test
+        (let ((imfi (mock-port (open-input-string "asdf")))) ; pair_to_port GC problem in fx_c_opaaq
+          (define (func) (object->string (make-list (*s7* 'rootlet-size) imfi)))
+          (do ((i 0 (+ i 1))) ((= i 10)) (func))))
+      (test (catch #t
+              (lambda ()
+                (with-let (mock-port (open-input-string "asdf")) (append "hi" (block))))
+              (lambda (type info)
+                (apply format #f info)))
+             "block-append first argument, \"hi\", is a string but should be a block"))
+
+  (let ()
+    (define mock-hash-table (*mock-hash-table* 'mock-hash-table))
+    (define mock-pair (*mock-pair* 'mock-pair))
+    (define mock-vector (*mock-vector* 'mock-vector))
+    (define mock-string (*mock-string* 'mock-string))
+    (define mock-char (*mock-char* 'mock-char))
+    (define mock-number (*mock-number* 'mock-number))
+    (define mock-symbol (*mock-symbol* 'mock-symbol))
+    (define mock-port (*mock-port* 'mock-port))
+    (define mock-c-pointer (*mock-c-pointer* 'mock-c-pointer))
+    (define mock-random-state (*mock-random-state* 'mock-random-state))
+
+    (test (copy (mock-pair '(2 3 4)) cond (mock-vector 1 2 3 4)) 'error)
+    (test (subvector (vector #f) (mock-vector 1 2 3 4)) 'error)
+    (test (subvector (vector #f) (mock-pair '(1 2 3 4))) 'error)
+    (test (list-tail (vector 1 '(3)) (mock-pair '(2 3 4))) 'error)
+    (test (list-tail '(3) (mock-pair '(2 3 4))) 'error)
+    (test (list-tail (+) (mock-pair '(2 3 4))) 'error)
+    (test (make-string 10001 (mock-number 0)) 'error)
+    (test (copy (mock-string #\h #\o #\h #\o) 0/0+i (mock-hash-table 'b 2)) 'error)
+    (test (copy (string (integer->char 255)) (list ()) (mock-vector 1 2 3 4)) 'error)
+    (test (apply '(()) (mock-pair '(2 3 4)) (expt 2 32) `((1))) 'error)
+    (test (list-set! `(x . 1) (mock-pair '(2 3 4)) #f) 'error)
+    (test (object->string "asdf" #f (mock-number 80)) "asdf")
+    (test (write-char (integer->char 123) (mock-char #\b)) 'error)
+    (test (write-char (mock-char #\c) (mock-char #\d)) 'error)
+    (test (string (mock-char #\a) #\b (mock-char #\c)) "abc")
+    (test (format #f "symbol: ~S" (mock-symbol 'a)) "symbol: a")
+    (test (format (mock-symbol 'b) "symbol: ~S" (mock-symbol 'a)) 'error)
+    (test (format #f (mock-symbol 'b) (mock-symbol 'a)) 'error)
+    (test (write-byte (mock-port *stdout*)) 'error)
+    (test (call-with-output-string (lambda (p) (write-byte (mock-number 123) (mock-port p)))) (string (integer->char 123)))
+    (unless pure-s7
+      (test (let ((str "123")) (string-fill! str (mock-string #\a))) 'error)
+      (test (let ((str "123")) (string-fill! str #\b (mock-string #\a))) 'error))
+    (test (with-let (mock-number 2.0) (make-hash-table)) (make-hash-table))
+    (test (make-hash-table (mock-number 2) (mock-number 8)) 'error)
+    (test (let () (define (func) (let ((x #f)) (catch 'oops
+						 (lambda () (values (display (cons x x) (mock-port (open-output-string)))))
+						 (lambda args (format *stderr* "~A~%" args)))))
+	       (define (hi) (func) (func)) (hi) (hi)) '(#f . #f))
+    (test (with-let (mock-port (open-output-string)) (newline) #f) #f)
+    (test (let ((x #f) (i 0)) (begin (append (vector-fill! #i() (mock-vector 1 2 3 4))))) 'error)
+    (test (iterator? (let () (define (func) (make-iterator (mock-string #\h #\o #\h #\o) `((1)))) (define (hi) (func) (func)) (hi) (hi))) #t)
+    (test (gensym? (with-let (mock-string #\h #\o #\h #\o) (gensym))) #t)
+    (test (append #i() (mock-vector 1 2 3)) #i(1 2 3))
+    (test (let () (define (func) (let ((x #f) (i 0)) (begin (append (int-vector) (mock-vector 1 2 3 4))))) (define (hi) (func) (func)) (hi) (hi)) #i(1 2 3 4))
+    (test (let () (define (func) (let ((x #f) (i 0)) (begin (append (vector) (mock-pair '(2 3 4)))))) (define (hi) (func) (func)) (hi) (hi)) #((2 3 4)))
+    (test (let () (define (func) (append (make-vector '(2 3) 0) (mock-vector 1 2 3 4))) (define (hi) (func) (func)) (hi) (hi)) #(0 0 0 0 0 0 1 2 3 4))
+    (test (sort! (list) (mock-pair '(2 3 4))) 'error)
+    (test (let () (define (func) (let ((x #f)) (write (cons x x) (mock-port (open-output-string))))) (define (hi) (func) (func)) (hi) (hi)) '(#f . #f))
+    (test (with-let (mock-hash-table 'b 2) (object->string `((set! x (+ x 1)) (* x 2)))) "((set! x (+ x 1)) (* x 2))")
+    (test (with-let (mock-hash-table 'b 2) `(+ ,a1 ,b)) '(+ #f 2)) ; let-ref-fallback for 'a1 (undefined), hash-table-ref -> #f for undefined
+    (test (with-let (mock-hash-table 'b 2) (set! ((curlet) b) 3)) 3)
+    (test (with-let (mock-hash-table 'b 2) (set! b 3)) 3)
+    (test (let ((mh (mock-hash-table 'b 2))) (with-let mh (set! b 3)) (mh 'b)) 3)
+    (test (with-let (mock-hash-table 'b 2) (copy '(15 26))) '(15 26))
+    (test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 2)) (with-let (mock-hash-table 'basf 2) (set! basf 3)))) (f) (f)) #t)
+    (test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 2)) (with-let (mock-hash-table 'basf 2) (set! basf pi)))) (f) (f)) #t)
+    (test (let () (define (f2) (do ((i 0 (+ i 1))) ((= i 2)) (with-let (mock-hash-table 'basf 2) (set! basf (* 2 3))))) (f2) (f2)) #t)
+    (test (let () (define (f3) (do ((i 0 (+ i 1))) ((= i 2)) (with-let (mock-hash-table 'basf 2) (set! basf (let () 3))))) (f3) (f3)) #t)
+    (test (let () (define (f4) (do ((i 0 (+ i 1))) ((= i 2)) (with-let (mock-hash-table 'basf 2) (set! basf (* 3 basf))))) (f4) (f4)) #t)
+
+    (test (let? (append () (mock-vector 2 3 4))) #t)
+    (test (let? (let () (define (f) (append () (mock-vector 2 3 4))) (f))) #t)
+    (test (let? (append (mock-vector 1 2 3))) #t)
+    (test (let? (append (mock-vector))) #t) ; a mock-vector with #() as 'value
+    (test (with-let (*mock-vector* 'mock-vector-class) (append)) ()) ; redundant
+    (test (with-let (*mock-vector* 'mock-vector-class) (vector-append)) #())
+    ;; ? is this inconsistent with:
+    (test (append (mock-vector 1 2) (mock-vector 3 4 5)) #(1 2 3 4 5))
+    (test (append (mock-vector 1 2) (vector 3 4 5)) #(1 2 3 4 5))
+
+    (test (let? (append () (mock-pair 2 3 4))) #t)
+    (test (let? (let () (define (f) (append () (mock-pair 2 3 4))) (f))) #t)
+    (test (let? (append (mock-pair 1 2 3))) #t)
+    (test (let? (append (mock-pair))) #t) ; a mock-pair with #() as 'value
+    (test (with-let (*mock-pair* 'mock-pair-class) (append)) ())
+    (test (append (mock-pair 1 2) (mock-pair 3 4 5)) '(1 2 3 4 5))
+    (test (append (mock-pair 1 2) (list 3 4 5)) '(1 2 3 4 5))
+
+    (test (let? (append () (mock-string "234"))) #t)
+    (test (let? (let () (define (f) (append () (mock-string "234"))) (f))) #t)
+    (test (let? (append (mock-string "234"))) #t)
+    (test (let? (append (mock-string ""))) #t)
+    (test (with-let (*mock-string* 'mock-string-class) (append)) ()) ; (append)
+    (test (append (mock-string "1") (mock-string "234")) "1234")
+    (test (append (mock-string "1") (string #\2 #\3 #\4)) "1234")
+
+    (let ((H ((*mock-hash-table* 'make-hash-table) 8 eq? (cons symbol? integer?))))
+      (test (hash-table-key-typer H) symbol?)
+      (test (hash-table-value-typer H) integer?)
+      (test (set! (H 'a) 123) 123)
+      (test (H 'a) 123)
+      (test (set! (H 'b) #\a) 'error))
+
+    (let ((imfo (immutable! (mock-port (open-output-string)))))
+      (test (with-let imfo (integer? (append))) #f)
+      (test (pair? (append '(1 2 3) imfo)) #t))
+    (test (subvector #(123 223) 0 0 (sublet (mock-pair '(2 3 4)) (mock-random-state 1234))) 'error)
+
+    (let ((_df_ (mock-pair '((2 3 4)))))
+      (define (_fnc5_ x) (not (pair? x)))
+      (test (_fnc5_ _df_) (let () (define (func) (_fnc5_ _df_)) (define (hi) (func)) (hi))))
+
+    (test (with-let (mock-pair 0 1) (object->string 123)) "123")
+    (test (with-let (mock-number 0) (object->string 123)) "123")
+    (test (with-let (mock-string #\0 #\1) (object->string 123)) "123")
+    (test (let () (define (func) (#_call-with-input-string (mock-string "asdf") (lambda (x) (read-char x)))) (func)) #\a)
+    (test (with-let (mock-char #\1) (object->string 123)) "123")
+    (test (with-let (mock-vector 0 1) (object->string 123)) "123")
+    (test (with-let (mock-symbol 'a) (object->string 123)) "123")
+    (test (with-let (mock-port (open-input-string "123")) (object->string 123)) "123")
+    (test (with-let (mock-c-pointer 0) (object->string 123)) "123")
+    (unless with-bignums (test (int-vector? ((*mock-vector* 'make-mock-vector) 3 1 integer?)) #t)) ; bignum=int but not int-vector element
+    (test (hash-table? ((*mock-hash-table* 'make-mock-hash-table) 8 eq? (cons symbol? integer?))) #t)
+    (test (string-fill! (symbol->string 'x) (sublet (mock-number 0) (immutable! (mock-random-state 123456)))) 'error)
+    (test (sqrt (openlet (with-let (mock-number 2.0) (lambda (y) (+ x y))))) 'error)
+    (test (with-let (mock-vector 1) (vector-length '(1))) 'error)
+
+    (let ((V ((*mock-vector* 'make-mock-vector) 8 'a symbol?)))
+      (test (vector-typer V) symbol?)
+      (test (set! (V 0) 'b) 'b)
+      (test (V 0) 'b)
+      (test (set! (V 1) 123) 'error)) ;vector-set! third argument 123, is an integer, but the vector's element type checker, symbol?, rejects it
+
+    (unless with-bignums
+      (let ((mn (sublet (mock-number 3) :mock-number mock-number)))
+        (test (with-let mn (abs (openlet (inlet 'abs (lambda (val) 0))))) 0)
+        (test (with-let mn (abs -1)) 1)
+        (test (with-let mn (abs (mock-number -1))) 1)
+        (test (with-let mn (abs (openlet (inlet 'length (lambda (obj) 0))))) 'error)
+        (test (with-let mn (+ (mock-number -1) 3 (openlet (inlet '+ (lambda args (+ (car args) 4)))))) 6)
+        (test (with-let mn (+ 3 (mock-number -1) (openlet (inlet '+ (lambda args (+ (car args) 4)))))) 6)
+        (test (with-let mn (+ (openlet (inlet '+ (lambda args (apply + 4 (cdr args))))) 3 (mock-number -1))) 6)))
+
+    (test (with-output-to-string
+	    (lambda ()
+	      (display (openlet (with-let (mock-c-pointer 0) (lambda () 1))))
+	      (write (openlet (with-let (mock-c-pointer 0) (lambda () 1))))
+	      (display (object->string (openlet (with-let (mock-c-pointer 0) (lambda () 1)))))
+	      (format () "~A" (openlet (with-let (mock-c-pointer 0) (lambda () 1))))))
+	  "#<lambda ()>#<lambda ()>#<lambda ()>#<lambda ()>")
+    (test (with-output-to-string
+	    (lambda ()
+	      (display (openlet (with-let (mock-number 0) (lambda () 1))))
+	      (write (openlet (with-let (mock-number 0) (lambda () 1))))
+	      (display (object->string (openlet (with-let (mock-number 0) (lambda () 1)))))
+	      (format () "~A" (openlet (with-let (mock-number 0) (lambda () 1))))))
+	  "#<lambda ()>#<lambda ()>#<lambda ()>#<lambda ()>")
+
+    (let ((imfi (immutable! (mock-port (open-input-string "asdf")))))
+      (test (type-of (display imfi #f)) (type-of (let () (define (func) (display imfi #f)) (define (hi) (func) (func)) (hi) (hi)))))
+
+    (when with-bignums
+      (test (+ 2 (mock-number (bignum "1"))) (bignum "3"))
+      (test (bignum (mock-string #\1)) (bignum "1")))
+
+    (test (float-vector (mock-number 1.0)) #r(1.0))
+    (test (float-vector 0.0 (mock-number 1.0)) #r(0.0 1.0))
+    (test (float-vector 0.0 (mock-number 1.0) 2.0) #r(0.0 1.0 2.0))
+    (test (float-vector (mock-number 1.0) 2.0 (mock-number 3.0)) #r(1.0 2.0 3.0))
+    (test (float-vector (mock-number 1+i)) 'error)
+
+    (test (int-vector (mock-number 1)) #i(1))
+    (test (int-vector 0 (mock-number 1)) #i(0 1))
+    (test (int-vector 0 (mock-number 1) 2) #i(0 1 2))
+    (test (int-vector (mock-number 1) 2 (mock-number 3)) #i(1 2 3))
+    (test (int-vector (mock-number 2/3)) 'error)
+
+    (test (byte-vector (mock-number 1)) #u(1))
+    (test (byte-vector 0 (mock-number 1)) #u(0 1))
+    (test (byte-vector 0 (mock-number 1) 2) #u(0 1 2))
+    (test (byte-vector (mock-number 1) 2 (mock-number 3)) #u(1 2 3))
+    (test (byte-vector (mock-number -123)) 'error)
+    (test (byte-vector (mock-number 1234)) 'error)
+
+;    (test (object->string (openlet (c-pointer 2 #(1) (mock-char #\b))) :readable) "(c-pointer 2 (vector 1) #\\b)")
+    (test (atan (openlet (sublet (mock-c-pointer 1 'integer? ((*mock-number* 'mock-number) 2.0))))) 'error)
+    (test (let ((x #f)) (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (set! x (denominator (mock-number 2/3))))) (f) x) 3)
+    (test (tree-memq (mock-symbol 'a) (list 'b (list (mock-symbol 'a)))) #f)
+    (test (let ((sym (mock-symbol 'a))) (tree-memq sym (list 'b (list sym)))) #t)
+    (test (let ((sym (mock-symbol 'a))) (tree-memq sym (list 'b (list 'a)))) #f)  ; ??
+    (test (let ((mp (mock-pair 1 2 3))) (reverse! mp) (mp 'value)) '(3 2 1))
+
+    (test (format #f "~D" (mock-number 17)) "17")
+    (test (format #f "~X" (mock-number 17)) "11")
+    (test (format #f "~B" (mock-number 17)) "10001")
+    (test (format #f "~O" (mock-number 17)) "21")
+    (test (format #f "~A" (mock-number 17)) "17")
+    (test (format #f "~S" (mock-number 17)) "17")
+    (test (format #f "~W" (mock-number 17)) "(openlet (immutable! (sublet *mock-number* :value 17 :mock-type 'mock-number?)))")
+    (test (format #f "~F" (mock-number 1.5)) "1.500000")
+    (test (format #f "~G" (mock-number 1.5)) "1.5")
+    (test (format #f "~E" (mock-number 1.5)) "1.500000e+00")
+    (test (format #f "~C" (mock-char #\a)) "a")
+    (let ((r (mock-number 1.23)))
+      (test (format #f "~D" ((*mock-number* 'mock-number) 123)) "123")
+      (test (format #f "~F" r) "1.230000")
+      (test (format #f "~G" r) "1.23")
+      (test (format #f "~A" r) "1.23")
+      (test (format #f "~S" r) "1.23")
+      (test (format #f "~F ~F" r r) "1.230000 1.230000"))
+    (test (format #f (mock-string "~A ~A") 1 2) "1 2")
+    (test (format #f (mock-string "~A ~A") 1 (mock-string "2")) "1 2")
+    (test (format #f "symbol: ~S" (mock-symbol 'a)) "symbol: a")
+    (test (format #f "~S" (mock-number 3/2)) "3/2")
+    (test (format #f "~W" (mock-number 3/2)) "(openlet (immutable! (sublet *mock-number* :value 3/2 :mock-type 'mock-number?)))")
+    (test (format #f "~A" (mock-string #\a #\b #\c)) "abc")
+    (test (format #f "~A" (mock-pair 1 2 3)) "(1 2 3)")
+    (test (format #f "~A" (mock-char #\a)) "a")
+    (test (format #f "~A" (mock-symbol 'asdf)) "asdf")
+    (test (format #f "~A" (mock-hash-table 'a 1)) "(hash-table 'a 1)")
+    (test (format #f "~A" (mock-vector 1 2 3)) "#(1 2 3)")
+    (test (pair? (member (format #f "~A" (mock-c-pointer 0)) '("#<c_pointer (nil)>" "#<c_pointer 0x0>") string=?)) #t)
+    (test (format #f "~A" (mock-port (open-input-string "1234"))) "#<input-string-port>")
+    (test (format #f "~A ~F" (mock-string #\1 #\2) (mock-number 12)) "12 12")
+    (test (let () (define (f) (format #f "~A" (mock-number 1))) (f)) "1")
+    (test (with-let (mock-symbol 'c) (setter (lambda* ((a 1) (b 2)) (+ a b)))) #f)
+    (test (object->string (sublet (mock-symbol 'c))) "c")
+    (test (copy (sublet (mock-hash-table))) (hash-table))
+    (test (copy (sublet (mock-vector 1 2))) #(1 2))
+    (test (write-char (sublet (mock-port (open-output-string)))) 'error)
+    (test (display 3 (sublet (mock-number 1-i))) 'error)
+    (test (display (lambda () 1) (sublet (mock-number 1-i))) 'error)
+    (test (format (sublet (mock-symbol 'c)) (mock-number 4/3)) 'error)
+    (test (subvector (sublet (mock-number 2.0)) `((1) . x)) 'error)
+    (test (abs (openlet (c-pointer 0 #f (mock-number 4/3)))) 'error)
+    (test (format #f "~S" (openlet (with-let (mock-hash-table 'b 2) (lambda () 0)))) "#<lambda ()>")
+    (test (with-output-to-string (lambda () (display (openlet (c-pointer 1 2 (mock-number 1234) ()))))) "#<c_pointer 0x1>")
+    (test (with-output-to-string (lambda () (display (openlet (c-pointer 1 2 (mock-random-state 1234) ()))))) "#<c_pointer 0x1>")
+
+    ;; these are aimed at the gmp version
+    (num-test (- 1.0 (mock-number 2.0) (mock-number -3.0)) 2.0)
+    (num-test (- (mock-number 1.0)) -1.0)
+    (num-test (let () (define (func) (- 1/2 (mock-number 3/4) 5/4)) (define (hi) (func)) (hi) (hi)) -3/2)
+    (num-test (lcm -3/4 (mock-number 4/3)) 12)
+    (num-test (lcm (mock-number 12) (mock-number 6) (mock-number 9)) 36)
+    (num-test (let () (define (func) (lcm -3/4 (mock-number 4/3))) (define (hi) (func) (func)) (hi) (hi)) 12)
+    (num-test (min 1 (mock-number -2) 3) -2)
+    (num-test (max 1 (mock-number -2) 3) 3)
+    (test (< 1 (mock-number -2) 3) #f)
+    (test (> 1 (mock-number -2) 3) #f)
+    (test (<= 1 (mock-number -2) 3) #f)
+    (test (>= 1 (mock-number -2) 3) #f)
+    (num-test (+ 1.0 (mock-number 2.0) (mock-number -3.0)) 0.0)
+    (num-test (* 1.0 (mock-number 2.0) (mock-number -3.0)) -6.0)
+    (num-test (/ 1.0 (mock-number 2.0) (mock-number -2.0)) -0.25)
+    (num-test (let () (define (func) (min 1 (mock-number -2) 3)) (define (hi) (func) (func)) (hi) (hi)) -2)
+    (test (let () (define (func) (> 1 (mock-number -2) 3)) (define (hi) (func) (func)) (hi) (hi)) #f)
+    (num-test (let () (define (func) (+ 1.0 (mock-number 2.0) (mock-number -3.0))) (define (hi) (func) (func)) (hi) (hi)) 0.0)
+    (test (logior 1 (mock-number 2) 3) 3)
+    (test (logxor 1 (mock-number 2) 3) 0)
+    (test (logand 1 (mock-number 2) 3) 0)
+    (test (let () (define (f) (logand 1 (mock-number 2) 3)) (define (g) (f)) (g) (g)) 0)
+    (test (let () (define (f) (logior 1 (mock-number 0))) (f)) 1)
+    (test (= 1 (mock-number 1)) #t)
+    (test (= 1 (mock-number -2) 3) #f)
+
+    ;; make sure this doesn't cause infinite recursion
+    (test (string? (object->string
+		    (vector (mock-pair '(2 3 4))
+			    (let ((<1> #f)
+				  (<2> (list #f #f #f)))
+			      (set! <1> (c-pointer 1 <2> #f))
+			      (set! (<2> 2) <1>)
+			      <1>)
+			    (mock-hash-table 'b 2))
+		    :readable))
+	  #t)
+    (test (string? (object->string
+		    (list (mock-vector 1 2 3 4)
+			  (mock-hash-table 'b 2)
+			  (let ((<1> (hash-table)))
+			    (set! (<1> 'a) <1>)
+			    <1>))
+		    :readable))
+	  #t)
+    (test (with-output-to-string (lambda () (display (openlet (with-let (mock-string #\h #\o #\h #\o) (define-macro (_m1_ a) `(+ ,a 1))))))) "_m1_")
+
+    ;; test that op_if_is_type_s|opsq include method check
+    (test (hash-table? (mock-hash-table 'b 2)) #t)
+    (test (hash-table->alist (mock-hash-table 'b 2)) '((b . 2)))
+    (test (map values (mock-hash-table 'b 2)) '((b . 2)))
+    (test ((lambda () (map values (mock-hash-table 'b 2)))) '((b . 2)))
+    (test ((lambda (a) (map values a)) (mock-hash-table 'b 2)) '((b . 2)))
+    (test ((lambda (a) (if (hash-table? a) (map values a))) (mock-hash-table 'b 2)) '((b . 2)))
+    (test (let () (define (f a) (if (hash-table? a) (map values a))) (f (mock-hash-table 'b 2))) '((b . 2)))
+    (test (let () (define (f a) (if (hash-table? a) (map values a))) (define (g) (f (mock-hash-table 'b 2))) (g)) '((b . 2)))
+    (test (let ()
+	    (define hash-table->alist
+	      (lambda (table)
+		(if (hash-table? table)
+		    (map values table)
+		    (error 'wrong-type-arg "hash-table->alist argument, ~A, is not a hash-table" table))))
+	    (hash-table->alist (mock-hash-table 'b 2))
+	    (hash-table->alist (mock-hash-table 'b 2)))
+	  '((b . 2)))
+    (test ((lambda () (hash-table->alist (mock-hash-table 'b 2)))) '((b . 2)))
+
+    (test (let () (define (func) (with-let (mock-hash-table) (undefined-function))) (define (hi) (func)) (hi)) 'error)
+    (test (let () (define (func) (with-let (mock-hash-table) (undefined-function 0))) (define (hi) (func)) (hi)) 'error)
+    (test (let () (define (func) (with-let (mock-hash-table) (let ((x 1)) (undefined-function x)))) (define (hi) (func)) (hi)) 'error)
+    (test (let () (define (func) (with-let (mock-hash-table) (let ((x 1)) (undefined-function (+ x 1))))) (define (hi) (func)) (hi)) 'error)
+    (test (let () (define (func) (clamp #f (vector (inlet :a 1 :b 2 :c 3) #f #f) (mock-hash-table 'b 2))) (define (hi) (func)) (hi)) 'error)
+
+    (test (getenv (outlet (mock-string #\h #\o #\h #\o))) 'error)
+    (test (sort! (list 1 2) (mock-vector 1 2 3)) 'error)
+    (test (let () (let ((p (mock-pair '(1 2 3)))) (call-with-exit (lambda (x) (x (khar p)))))) '(1 2 3)) ; depends on khar before mockery
+    (test (sort! or (mock-pair '(2 3 4))) 'error))
+
+  ;; owbug
+  (when full-s7test
+    (let ()
+      (load "write.scm")
+
+      (define mock-number (*mock-number* 'mock-number))
+      (define-constant bigrat 1/2)
+      (define-constant bigcmp 1+2i)
+      (define x #f)
+      (define (free2) (x i))
+
+      (define (checked-eval code)
+	(and (< (length code) 100)
+	     (null? (cyclic-sequences code))
+	     (eval code)))
+
+      (define (f)
+	(catch #t
+	  (lambda ()
+	    (let ((x #f) (i 0))
+	      (let ()
+		(let-temporarily ((x 1234))
+		  (call/cc (lambda (goto) (goto 1)))
+		  (pp (weak-hash-table `(+ x 1) (substring "0123" 2)
+				       (string #\c #\null #\b) (subvector #i2d((1 2) (3 4)) 0 4 '(4))
+				       (begin (make-hook) (begin (ow!) #f) 1/2 (checked-eval `(+ 1 2)))))))))
+	  (lambda args #f)))
+
+      (define (f1)
+	(catch #t
+	  (lambda ()
+	    (let ((x #f) (i 0))
+	      (let ()
+		(let-temporarily ((x 1234))
+		  (call/cc (lambda (goto) (goto 1)))
+		  (begin (ash 1 43)
+			 (begin (ow!) #f)
+			 (subvector (vector 1 2 3 4 5 6) 0 6 '(2 3))
+			 (substring "0123" 2)
+			 #x123.123
+			 (make-iterator (list 11 22 33)))
+		  (empty? (make-vector (make-list 10 2))
+			  (make-vector '(2 3) boolean?)
+			  #\A)))))
+	  (lambda args #f)))
+
+      (define (f2)
+	(catch #t
+	  (lambda ()
+	    (let ((x #f) (i 0))
+	      (let ()
+		(let-temporarily ((x 1234))
+		  (call/cc (lambda (goto) (goto 1)))
+		  (c-object? 1)
+		  (lambda sym-args sym-args)
+		  #i2d((101 201) (3 4))
+		  (begin (ow!) #f)
+		  bigrat
+		  (make-float-vector '(128 3) pi)
+		  (expt 2 32)
+		  (mock-number 1+i)
+		  `(+ ,a ,@b)
+		  bigcmp
+		  (char-whitespace?)))))
+	  (lambda args #f)))
+
+      (define (f3)
+	(catch #t
+	  (lambda ()
+	    (let ((x #f) (i 0))
+	      (let ()
+		(let-temporarily ((x 1234))
+		  (call/cc (lambda (goto) (goto 1)))
+		  (with-baffle
+		    (begin (ow!) #f)
+		    "ra"
+		    (string-position #xfeed 'ho :a
+				     (let-temporarily ((x #(1)) (i 0)) (free2))
+				     pi #r()
+				     (let ((<1> #f)
+					   (<2> (vector #f)))
+				       (set! <1> (make-iterator <2>))
+				       (set! (<2> 0) <1>)
+				       <1>)
+				     (openlet (inlet 'zero? (lambda (x)
+							      (if (number? x)
+								  (= x 0.0)
+								  (error 'wrong-type-arg "not a number")))))))))))
+	  (lambda args #f)))
+
+      (define (g)
+	(do ((i 0 (+ i 1)))
+	    ((= i 1000))
+	  (if (> (random 10) 5) (f))
+	  (if (> (random 10) 5) (f1))
+	  (if (> (random 10) 5) (f2))
+	  (if (> (random 10) 5) (f3))))
+      (g)))) ; mockery.scm
+
+;(let () (define (f1) (with-let (inlet '+ (lambda args (apply * args))) (+ 1 2 3 4))) (test (with-let (inlet '+ (lambda args (apply * args))) (+ 1 2 3 4)) (f1)))
+;as elsewhere stated, this is documented -- not sure it needs to be fixed
+
+(set! (*s7* 'print-length) 123123)
+(when (and (not with-bignums)
+	   (not pure-s7))
+  (let ()
+    (require stuff.scm mockery.scm)
+    (define (write-func1 port name expr c method)
+      (format port "(define (~A x) ~S)~%" name expr)
+      (format port "(let ((val1 (~A ~S))~%" name c)
+      (format port "      (val2 (let ((x ~S)) ~S)))~%" c expr)
+      (format port "  (let ((val3 (~A (make-object 'x ~S '~A (make-method ~A (lambda (e) (e 'x)))))))~%" name c method method)
+      (format port "    (if (or (not (equivalent? val1 val2))~%")
+      (format port "            (not (equivalent? val2 val3)))~%")
+      (format port "        (format *stderr* \"~A: opt ~~A, unopt ~~A, env ~~A~~%\" val1 val2 val3))))~%~%" name))
+
+    (define* (write-func2 port name expr c1 c2 method method2)
+      (format port "(define (~A x y) ~S)~%" name expr)
+      (format port "(let ((val1 (~A ~S ~S))~%" name c1 c2)
+      (format port "      (val2 (let ((x ~S) (y ~S)) ~S)))~%" c1 c2 expr)
+      (format port "  (let ((val3 (~A (make-object 'x ~S '~A (make-method ~A (lambda (e) (e 'x))))~%" name c1 method method)
+      (format port "                    (make-object 'y ~S '~A (make-method ~A (lambda (e) (e 'y)))))))~%" c2 (or method2 method) (or method2 method))
+      (format port "    (let ((val4 (~A ~S (make-object 'y ~S '~A (make-method ~A (lambda (e) (e 'y)))))))~%" name c1 c2 (or method2 method) (or method2 method))
+      (format port "      (let ((val5 (~A (make-object 'x ~S '~A (make-method ~A (lambda (e) (e 'x)))) ~S)))~%" name c1 method method c2)
+      (format port "        (if (or (not (equivalent? val1 val2))~%")
+      (format port "                (not (equivalent? val2 val3))~%")
+      (format port "                (not (equivalent? val3 val4))~%")
+      (format port "                (not (equivalent? val4 val5)))~%")
+      (format port "        (format *stderr* \"~A: opt ~~A, unopt ~~A, exy ~~A, ecy ~~A, exc ~~A~~%\" val1 val2 val3 val4 val5))))))~%~%" name))
+
+    (call-with-output-file
+	"t923.scm"
+      (lambda (p)
+	(format p "(require stuff.scm)~%~%")
+	(format p "(let-temporarily (((*s7* 'debug) 0)) (define (make-object . args) (openlet (apply inlet args))))~%")
+	(format p "(define (make-method f accessor)
+                     (lambda args
+                       (if (null? args)
+                           (f)
+	                   (if (let? (car args))
+	                       (apply f (accessor (car args)) (cdr args))
+	                       (if (or (null? (cdr args))
+		                       (not (let? (cadr args))))
+		                    (apply f (map (lambda (arg)
+				                    (if (openlet? arg)
+				                        (coverlet arg)
+				                        arg))
+				                  args))
+		                    (apply f (car args) (accessor (cadr args)) (cddr args)))))))")
+	(format p "(let ()~%")
+	(write-func1 p "+_1s" '(+ 1 x) 3 '+)
+	(write-func1 p "+_s1" '(+ x 1) 3 '+)
+	(write-func1 p "+_s12" '(+ (+ x) 1) 3 '+)
+	(write-func1 p "+_sf" '(+ x 2.0) 3 '+)
+	(write-func1 p "+_fs" '(+ 2.0 x) 3 '+)
+	(write-func2 p "+_xy" '(+ x y) 3 4 '+)
+	(write-func2 p "+_xy1" '(+ 5 x y) 3 4 '+)
+	(write-func2 p "+_xy2" '(+ 5 3 x 2 y) 3 4 '+)
+
+	(write-func1 p "-_s1" '(- x 1) 3 '-)
+	(write-func1 p "-_s1" '(- x 6) 3 '-)
+	(write-func1 p "-_s1" '(- (- x) 1) 3 '-)
+	(write-func1 p "-_1s" '(- 1 x) 3 '-)
+	(write-func1 p "-_sf" '(- x 2.0) 3 '-)
+	(write-func1 p "-_fs" '(- 2.0 x) 3 '-)
+	(write-func2 p "-_xy" '(- x y) 3 4 '-)
+
+	(write-func1 p "*_s" '(* x) 3 '*)
+	(write-func1 p "*_2s" '(* 2 x) 3 '*)
+	(write-func1 p "*_s2" '(* x 2) 3 '*)
+	(write-func1 p "*_sf" '(* x 2.0) 3 '*)
+	(write-func1 p "*_fs" '(* 2.0 x) 3 '*)
+	(write-func1 p "*_xx" '(* x x) 3 '*)
+	(write-func1 p "*_xnk" '(+ (* x 2) 3) 3 '*)
+	(write-func1 p "-_fss" '(- 2.0 (* x x)) 3 '*)
+	(write-func2 p "*_xy" '(* x y) 3 4 '*)
+	(write-func2 p "*1xy" '(* (- 1.0 x) y) 3.0 4 '- '*)
+	(write-func2 p "r2cos" '(* -2.0 x (cos y)) 3.0 1.8 '* 'cos)
+	(write-func1 p "fsf" '(+ 3.5 (* x 4.5)) 5.0 '*)
+
+	(write-func1 p "/_s" '(/ x) 3 '/)
+	(write-func1 p "/_1s" '(/ 1 x) 3 '/)
+	(write-func1 p "/_1.0s" '(/ 1.0 x) 3 '/)
+	(write-func1 p "/_2s" '(/ 2 x) 3 '/)
+	(write-func1 p "/_s2" '(/ x 2) 3 '/)
+	(write-func1 p "/_sf" '(/ x 2.0) 3 '/)
+	(write-func1 p "/_fs" '(/ 2.0 x) 3 '/)
+	(write-func2 p "/_xy" '(/ x y) 3 4 '/)
+
+	(write-func2 p "s_cos_s" '(* x (cos y)) 3.1 1.8 '* 'cos)
+	(write-func2 p "s_sin_s" '(* x (sin y)) 3.1 1.8 '* 'sin)
+
+	(write-func1 p "min_2f" '(min x 1.0) 3.1 'min)
+	(write-func1 p "max_2f" '(max 1.0 x) 3.1 'max)
+	(write-func1 p "min_2f1" '(min x 1.0) 3.1 'min)
+	(write-func1 p "max_2f1" '(max 1.0 x) 3.1 'max)
+	(write-func1 p "modsi0" '(zero? (modulo x 3)) 5 'modulo)
+	(write-func1 p "neglen" '(negative? (length x)) #(0 1) 'length)
+	(write-func1 p "eqzlen" '(= (length x) 0) #() 'length)
+	(write-func1 p "zlen" '(zero? (length x)) #() 'length)
+
+	(write-func1 p "=x" '(= x 1) 1 '=)
+	(write-func1 p "<x" '(< x 1) 1 '<)
+	(write-func1 p "<=x" '(<= x 1) 1 '<=)
+	(write-func1 p ">=x" '(>= x 1) 1 '>=)
+	(write-func1 p ">x" '(> x 1) 1 '>)
+
+	(write-func1 p "=len" '(= (length x) 6) #(0 1 2 3 4 5) 'length)
+	(write-func1 p "<len" '(< (length x) 6) #(0 1 2 3 4 5) 'length)
+	(write-func1 p ">len" '(> (length x) 6) #(0 1 2 3 4 5) 'length)
+	(write-func1 p "<=len" '(<= (length x) 6) #(0 1 2 3 4 5 ) 'length)
+	(write-func1 p "<=len" '(<= (length x) 6) #(0 1 2 3 4 5) 'length)
+	(write-func1 p ">=len" '(>= (length x) 6) #(0 1 2 3 4 5) 'length)
+
+	(for-each ; ints
+	 (lambda (f1)
+	   (write-func1 p (string-append (symbol->string f1) "_si") `(,f1 x) -3 f1))
+	 (list 'real-part 'imag-part 'numerator 'denominator 'even? 'odd? 'zero? 'positive? 'negative? 'infinite? 'nan?
+	       'magnitude 'angle 'rationalize 'abs 'exp 'log 'sin 'cos 'tan 'asin 'acos 'atan 'sinh 'cosh 'tanh 'asinh 'acosh 'atanh 'sqrt
+	       'floor 'ceiling 'truncate 'round 'inexact->exact 'exact->inexact 'integer-length 'logior 'logxor 'logand 'lognot
+	       'number? 'integer? 'real? 'complex? 'rational? 'exact? 'inexact? 'number->string))
+
+	(for-each ; reals
+	 (lambda (f1)
+	   (write-func1 p (string-append (symbol->string f1) "_sf") `(,f1 x) 3.14 f1))
+	 (list 'real-part 'imag-part 'zero? 'positive? 'negative? 'infinite? 'nan?
+	       'magnitude 'angle 'rationalize 'abs 'exp 'log 'sin 'cos 'tan 'asin 'acos 'atan 'sinh 'cosh 'tanh 'asinh 'acosh 'atanh 'sqrt
+	       'floor 'ceiling 'truncate 'round 'inexact->exact 'exact->inexact 'integer-decode-float
+	       'number? 'integer? 'real? 'complex? 'rational? 'exact? 'inexact? 'number->string))
+
+	(for-each
+	 (lambda (f1)
+	   (write-func1 p (string-append (symbol->string f1) "_si") `(,f1 x 3) 4 f1))
+	 (list 'log 'logior 'logxor 'logand 'modulo 'remainder 'quotient 'max 'min 'lcm 'gcd 'expt 'ash))
+
+	(for-each
+	 (lambda (f1)
+	   (write-func2 p (string-append (symbol->string f1) "_xy") `(,f1 x y) 3 4 f1))
+	 (list 'complex 'expt 'lcm 'gcd 'max 'min 'quotient 'remainder 'modulo
+	       '= '< '> '<= '>= 'ash 'logbit?))
+
+	(for-each
+	 (lambda (f1)
+	   (write-func1 p (string-append (symbol->string f1) "_x0") `(,f1 x 0) 3 f1))
+	 (list 'complex 'expt 'lcm 'gcd 'max 'min '= '< '> '<= '>= 'ash 'logbit?))
+
+	(for-each
+	 (lambda (f1)
+	   (write-func2 p (string-append (symbol->string f1) "_xy") `(,f1 x y) 3.14 4.2 f1))
+	 (list 'complex 'expt 'max 'min 'quotient 'remainder 'modulo
+	       '= '< '> '<= '>=))
+
+	(for-each
+	 (lambda (f1)
+	   (write-func1 p (string-append (symbol->string f1) "_c") `(,f1 x) #\a f1))
+	 (list 'char-upcase 'char-downcase 'char->integer 'char-upper-case? 'char-lower-case? 'char-alphabetic?
+	       'char-numeric? 'char-whitespace? 'char?))
+
+	(for-each
+	 (lambda (f2)
+	   (write-func2 p (string-append (symbol->string f2) "_xy") `(,f2 x y) #\a #\space f2))
+	 (list 'char=? 'char<? 'char>? 'char<=? 'char>=? 'string))
+
+	(for-each
+	 (lambda (f1)
+	   (write-func1 p (string-append (symbol->string f1) "_xc") `(,f1 x #\b) #\a f1))
+	 (list 'char=? 'char<? 'char>? 'char<=? 'char>=?))
+
+	(write-func1 p "intchar" '(integer->char x) 92 'integer->char)
+	(write-func2 p "charpos" '(char-position x y) #\a "dsafa" 'char-position 'char-position)
+
+	(for-each
+	 (lambda (f1)
+	   (write-func1 p (string-append (symbol->string f1) "_c") `(,f1 x) "asd" f1))
+	 (list 'string? 'string-downcase 'string-upcase 'string->list 'string-length 'string-copy))
+
+	(for-each
+	 (lambda (f2)
+	   (write-func2 p (string-append (symbol->string f2) "_xy") `(,f2 x y) "Aasd" "basd" f2))
+	 (list 'string=? 'string<? 'string>? 'string<=? 'string>=? 'string-ci=? 'string-ci<? 'string-ci>? 'string-ci<=? 'string-ci>=? 'string-append))
+
+	(for-each
+	 (lambda (f1)
+	   (write-func1 p (string-append (symbol->string f1) "_xc") `(,f1 x "asbda") "asda" f1))
+	 (list 'string=? 'string<? 'string>? 'string<=? 'string>=? 'string-ci=? 'string-ci<? 'string-ci>? 'string-ci<=? 'string-ci>=?))
+
+	(write-func1 p "lst0" '(list-ref x 0) '(list 0 1 3) 'list-ref)
+	(write-func1 p "lst1" '(list-set! x 0 1) '(list 0 1 3) 'list-set!)
+	(write-func1 p "vct0" '(vector-ref x 0) '(vector 0 1 3 4 5 6 7 8) 'vector-ref)
+	(write-func1 p "vct1" '(vector-ref x 1) '(vector 0 1 3 4 5 6 7 8) 'vector-ref)
+	(write-func1 p "vct2" '(vector-ref x 2) '(vector 0 1 3 4 5 6 7 8) 'vector-ref)
+	(write-func1 p "vct3" '(vector-ref x 3) '(vector 0 1 3 4 5 6 7 8) 'vector-ref)
+	(write-func1 p "vct4" '(vector-ref x 4) '(vector 0 1 3 4 5 6 7 8) 'vector-ref)
+
+	(write-func1 p "arit" '(aritable? x 1) abs 'aritable?)
+	(write-func1 p "arty" '(arity x) abs 'arity)
+	(write-func1 p "bool" '(boolean? x) #f 'boolean?)
+	(write-func1 p "cc" '(continuation? x) #f 'continuation?)
+	(write-func1 p "eof" '(eof-object? x) #<eof> 'eof-object?)
+	(write-func1 p "gen" '(gensym? x) ''a 'gensym?)
+	(write-func1 p "df" '(defined? x) ''format 'defined?)
+	(write-func1 p "key" '(keyword? x) ':a 'keyword?)
+	(write-func1 p "keysym" '(keyword->symbol x) ':a 'keyword->symbol)
+	(write-func1 p "intchr" '(integer->char x) 95 'integer->char)
+					;(write-func1 p "gens" '(gensym x) "asdf" 'gensym) -- can't be the same (this is like calling random)
+					;(write-func1 p "evl" '(eval x) ''(+ 1 2) 'eval) -- env evals to itself
+	(write-func1 p "evlstr" '(eval-string x) "(+ 1 2)" 'eval-string)
+	(write-func1 p "rev" '(reverse x) #(0 1 2) 'reverse)
+	(write-func1 p "symb" `(symbol x) "asdf" 'symbol)
+	(write-func1 p "mb" '(member 1 x) '(list 0 1 2) 'member)
+	(write-func1 p "mq" '(memq 1 x) '(list 0 1 2) 'memq)
+	(write-func1 p "mv" '(memv 1 x) '(list 0 1 2) 'memv)
+	(write-func1 p "ac" '(assoc 1 x) '(list (cons 0 1) (cons 1 2) (cons 2 3)) 'assoc)
+	(write-func1 p "aq" '(assq 1 x) '(list (cons 0 1) (cons 1 2) (cons 2 3)) 'assq)
+	(write-func1 p "av" '(assv 1 x) '(list (cons 0 1) (cons 1 2) (cons 2 3)) 'assv)
+	(write-func1 p "srt" '(sort! x <) #(0 1 2) 'sort!)
+
+	(for-each
+	 (lambda (f1)
+	   (write-func1 p (string-append (symbol->string f1) "_x") `(,f1 x) abs f1))
+	 (list 'documentation 'funclet
+	       'setter 'procedure-source 'dilambda?))
+
+	(for-each
+	 (lambda (f1)
+	   (write-func1 p (string-append (symbol->string f1) "_x") `(,f1 x) ''abs f1))
+	 (list 'symbol->dynamic-value 'symbol->keyword 'symbol->string 'symbol->value 'symbol?))
+
+	(for-each
+	 (lambda (f1)
+	   (write-func1 p (string-append (symbol->string f1) "_x") `(,f1 x) #(0 1 2) f1))
+	 (list 'vector->list 'vector-dimensions  'vector-length 'vector?))
+
+	(write-func1 p "vs" '(vector-set! x 0 1) (vector 0 1) 'vector-set!)
+	(write-func1 p "vf" '(vector-fill! x 0) (vector 0 1) 'vector-fill!)
+	;(write-func2 p "va" '(vector-append x y) (vector 0 1) (vector 2 3) 'vector-append 'vector-append)
+
+	(write-func1 p "cwof" '(call-with-output-file x (lambda (p) (display 12 p))) "tmp1.r5rs" 'call-with-output-file)
+	(write-func1 p "cwif" '(call-with-input-file x (lambda (p) (read p))) "tmp1.r5rs" 'call-with-input-file)
+	(write-func1 p "cwis" '(call-with-input-string x (lambda (p) (read p))) "123" 'call-with-input-string)
+	(write-func1 p "wof" '(with-output-to-file x (lambda () (display 12))) "tmp1.r5rs" 'with-output-to-file)
+	(write-func1 p "wif" '(with-input-from-file x (lambda () (read))) "tmp1.r5rs" 'with-input-from-file)
+	(write-func1 p "wis" '(with-input-from-string x (lambda () (read))) "123" 'with-input-from-string)
+
+	(write-func1 p "fvr" '(float-vector-ref x 0) '(float-vector 0 1) 'float-vector-ref)
+	(write-func1 p "fvs" '(float-vector-set! x 0 1.0) '(float-vector 0 1) 'float-vector-set!) ; g_vct_set_three clm2xen.c 9507
+	(write-func1 p "fvq" '(float-vector? x) '(float-vector 0 1) 'float-vector?)
+
+	(for-each
+	 (lambda (f1)
+	   (write-func1 p (string-append (symbol->string f1) "_x") `(,f1 x) '(hash-table 'a 1 'b 2) f1))
+	 (list 'hash-table-entries 'hash-table?))
+	(write-func1 p "htr" '(hash-table-ref x 'a) '(hash-table 'a 1 'b 2) 'hash-table-ref)
+	(write-func1 p "hts" '(hash-table-set! x 'a 1) '(hash-table 'a 1 'b 2) 'hash-table-set!)
+
+	(write-func1 p "lstail" '(list-tail x 2) '(list 0 1 2 3) 'list-tail)
+	(write-func1 p "op1" '(let ((p (open-input-file x))) (close-input-port p)) "tmp1.r5rs" 'open-input-file)
+	(write-func1 p "op1" '(let ((p (open-input-string x))) (close-input-port p)) "tmp1.r5rs" 'open-input-string)
+;	(write-func1 p "mapx" '(map abs x) #(-1 -2 -3) 'map)
+;	(write-func1 p "forx" '(let ((sum 0)) (for-each (lambda (n) (set! sum (+ sum n))) x) sum) #(1 2 3) 'for-each)
+
+	(write-func1 p "strfil" '(string-fill! x #\a) '(make-string 3) 'string-fill!)
+;	(write-func1 p "strfil" '(string-fill! (make-string 3) x) #\a 'string-fill!)
+	(write-func1 p "lststr" '(list->string x) '(list #\a #\b) 'list->string)
+	(write-func1 p "substr" '(substring x 1) "asdf" 'substring)
+	(write-func2 p "makstr" `(make-string x y) 3 #\a 'make-string)
+
+	(write-func1 p "n?" '(null? x) '(list) 'null?)
+	(write-func1 p "nl?" '(null? x) '(list 1) 'null?)
+	(write-func1 p "npa" '(not (pair? (car x))) '(list 1 2) 'car)
+	(write-func1 p "npa1" '(not (pair? (car x))) '(list (list 1 2)) 'car)
+	(write-func1 p "ft" '(format #f x) "test" 'format)
+	(write-func1 p "sca" '(set-car! x 1) '(list 1 2) 'set-car!)
+	(write-func1 p "scd" '(set-cdr! x 1) '(list 1 2) 'set-cdr!)
+	(write-func1 p "nnd" '(not (null? (cdr x))) '(list 1) 'cdr)
+	(write-func1 p "nnd1" '(not (null? (cdr x))) '(list 1 2) 'cdr)
+;	(write-func2 p "strref" `(string-ref x y) "asdf" 1 'string-ref)
+;	(write-func2 p "strset" `(string-set! x y #\a) "asdf" 1 'string-set!)
+	(write-func1 p "objstr" `(object->string x) 12 'object->string)
+	(write-func1 p "newstr" `(call-with-output-string (lambda (p) (newline x))) #f 'newline)
+
+	(write-func1 p "ftn" '(format #f x) "test~%" 'format)
+					;(write-func1 p "stk" '(stacktrace x) 2 'stacktrace)
+	(write-func1 p "symstr" '(symbol->string x) ''a 'symbol->string)
+	(write-func1 p "mrns" '(random-state x) 123 'random-state)
+	(write-func1 p "mrnx" '(random-state 123 x) 123 'random-state)
+	(write-func1 p "a1y" '(assoc (+ 0 1) x) '(list (cons 0 1) (cons 1 2) (cons 2 3)) 'assoc)
+	(write-func1 p "mba" '(member 'a x) '(list 0 'a 2) 'member)
+
+	(write-func1 p ">xf" '(> x 2.0) 3.0 '>)
+	(write-func1 p "=rx" '(= 3/2 x) 2/3 '=)
+	(write-func1 p "-*x" '(- (* x 2.0) 3.0) 4.0 '*)
+	(write-func1 p "-_rs" '(- 2/3 x) 3 '-)
+	(write-func1 p "-_rf" '(- 12 x) 3 '-)
+	(write-func1 p "-_cs" '(- 1+i x) 3 '-)
+	(write-func1 p "+_rs" '(+ 2/3 x) 3 '+)
+	(write-func1 p "+_cs" '(+ 1+i x) 3 '+)
+	(write-func1 p "*_rs" '(* 2/3 x) 3 '*)
+	(write-func1 p "*_cs" '(* 1+i x) 3 '*)
+	(write-func1 p "+_si" '(+ x 12) 3 '+)
+
+	(for-each
+	 (lambda (f1 lst)
+	   (write-func1 p (string-append (symbol->string f1) "_x") `(,f1 x) lst f1))
+	 (list 'car 'cdr 'caar 'cadr 'cdar 'cddr 'caaar 'caadr 'cadar 'caddr 'cdaar 'cdadr 'cddar 'cdddr 'caaaar 'caaadr 'caadar
+	       'caaddr 'cadaar 'cadadr 'caddar 'cadddr 'cdaaar 'cdaadr 'cdadar 'cdaddr 'cddaar 'cddadr 'cdddar 'cddddr )
+	 (list ''(a) ''(a b) ''((a) b c) ''(a b c) ''((a . aa) b c) ''(a b . c) ''(((a)) b c) ''(a (b) c)
+	       ''((a aa) b c) ''(a b c) ''(((a . aa)) b c) ''(a (b . bb) c) ''((a aa . aaa) b c) ''(a b c . d)
+	       ''((((a))) b c) ''(a ((b)) c) ''((a (aa)) b c) ''(a b (c)) ''(((a aa)) b c) ''(a (b bb) c) ''((a aa aaa) b c)
+	       ''(a b c d) ''((((a . aa))) b c) ''(a ((b . bb)) c) ''((a (aa . aaa)) b c) ''(a b (c . cc)) ''(((a aa . aaa)) b c)
+	       ''(a (b bb . bbb) c) ''((a aa aaa . aaaa) b c) ''(a b c d . e)))
+
+	(write-func1 p "np" '(not (pair? x)) '(list 1) 'pair?)
+	(write-func1 p "nn" '(not (null? x)) () 'null?)
+	(write-func1 p "ns" '(not (symbol? x)) '(quote q) 'symbol?)
+	(write-func1 p "nx" '(not (number? x)) 3 'number?)
+	(write-func1 p "nr" '(not (real? x)) 3 'real?)
+	(write-func1 p "nm" '(not (rational? x)) 3 'rational?)
+	(write-func1 p "ni" '(not (integer? x)) 3 'integer?)
+	(write-func1 p "nb" '(not (boolean? x)) #f 'boolean?)
+	(write-func1 p "ny" '(not (string? x)) "a" 'string?)
+	(write-func1 p "nc" '(not (char? x)) #\a 'char?)
+	(write-func1 p "ne" '(not (eof-object? x)) #<eof> 'eof-object?)
+	(write-func1 p "nl" '(not (list? x)) '(list 1) 'list?)
+	(write-func1 p "nl1" '(not (proper-list? x)) '(cons 1 2) 'proper-list?)
+	(write-func1 p "scar" '(set! (car x) 2) '(list 0 1) 'set-car!)
+
+	(format p ")~%")
+	))
+    (load "t923.scm" (curlet))))
+
+(let ()
+  (define (call-with-input-vector v proc)
+    (let ((i -1))
+      (proc (openlet
+	     (inlet 'read (lambda (p) (v (set! i (+ i 1))))
+		    'read-byte (lambda (p) (v (set! i (+ i 1))))
+		    'read-char (lambda (p) (v (set! i (+ i 1))))
+		    'read-line (lambda (p) (v (set! i (+ i 1))))
+		    'close-input-port (lambda (p) p)
+		    'read-string (lambda (p) (v (set! i (+ i 1)))))))))
+  (define (call-with-output-vector proc)
+    (let* ((size 1)
+	   (v (make-vector size #f))
+	   (i 0)
+	   (write-to-vector (lambda (obj p)
+			      (when (= i size) ; make the vector bigger to accommodate the output
+				    (set! v (copy v (make-vector (set! size (* size 2)) #f))))
+			      (set! (v i) obj)
+			      (set! i (+ i 1))
+			      #<unspecified>))) ; that's what write/display return!
+      (proc (openlet
+	     (inlet 'write (lambda* (obj p) ((if (not (let? p)) write write-to-vector) obj p))
+		    'display (lambda* (obj p) ((if (not (let? p)) display write-to-vector) obj p))
+		    'format (lambda (p . args)
+			      (if (not (let? p))
+				  (apply format p args)
+				  (write (apply format #f args) p)))
+		    'write-byte (lambda* (obj p) ((if (not (let? p)) write write-to-vector) obj p))
+		    'write-char (lambda* (obj p) ((if (not (let? p)) write write-to-vector) obj p))
+		    'close-output-port (lambda (p) p)
+		    'flush-output-port (lambda (p) p)
+		    'write-string (lambda* (obj p) ((if (not (let? p)) write write-to-vector) obj p)))))
+      (subvector v 0 i)))
+  (let ((lst ()))
+    (call-with-input-vector
+     (vector 1 2 3 4 5)
+     (lambda (p)
+       (set! lst (cons (read p) lst))
+       (set! lst (cons (read-byte p) lst))
+       (set! lst (cons (read-char p) lst))
+       (set! lst (cons (read-line p) lst))
+       (set! lst (cons (read-string p) lst))
+       (close-input-port p)))
+    (test lst '(5 4 3 2 1)))
+  (test (call-with-output-vector
+	 (lambda (p)
+	   (write 2 p)
+	   (display 4 p)
+	   (format p "~C" #\a)
+	   (write-byte 8 p)
+	   (write-char #\a p)
+	   (write-string "a" p)
+	   (flush-output-port p)
+	   (close-output-port p)))
+	#(2 4 "a" 8 #\a "a")))
+
+(let ()
+(let-temporarily (((*s7* 'debug) 0))
+  (define (open-output-log name)
+    ;; return a soft output port that does not hold its output file open
+    (define (logit name str)
+      (let ((p (open-output-file name "a")))
+	(display str p)
+	(close-output-port p)))
+    (openlet
+     (inlet :name name
+	    :format (lambda (p str . args) (logit (p 'name) (apply format #f str args)))
+	    :write (lambda (obj p)         (logit (p 'name) (object->string obj #t)))
+	    :display (lambda (obj p)       (logit (p 'name) (object->string obj #f)))
+	    :write-string (lambda (str p)  (logit (p 'name) str))
+	    :write-char (lambda (ch p)     (logit (p 'name) (string ch)))
+	    :newline (lambda (p)           (logit (p 'name) (string #\newline)))
+	    :close-output-port (lambda (p) #f)
+	    :flush-output-port (lambda (p) #f))))
+
+  (if (file-exists? "s7-test.log")
+      (delete-file "s7-test.log"))
+  (let ((elog (open-output-log "s7-test.log")))
+    (format elog "this is a test~%")
+    (format elog "all done!~%"))
+  (let ((p (open-input-file "s7-test.log")))
+    (test (read-line p) "this is a test")
+    (test (read-line p) "all done!")
+    (test (eof-object? (read-line p)) #t)
+    (close-input-port p)))
+)
+
+;;; *s7* --------
+
+(define-constant *s7*-length 62)
+
+(test (let? *s7*) #t)
+(test (outlet *s7*) (rootlet))
+(test (defined? 'heap-size *s7*) #t)
+(test (defined? '_x_ *s7*) #f)
+(let ((hpsize (*s7* 'heap-size)))
+  (test (let-ref *s7* 'heap-size) hpsize)
+  (test (with-let *s7* heap-size) hpsize)
+  (test ((sublet *s7* 'a 1) 'heap-size) hpsize)
+  (test (eval-string "heap-size" *s7*) hpsize)
+  (test (symbol->value 'heap-size *s7*) hpsize))
+(test (length *s7*) *s7*-length)
+(test (equal? *s7* *s7*) #t)
+(test (type-of *s7*) 'let?)
+(test (fill! *s7* #f) 'error)
+(test (set! *s7* 3) 'error)
+(test (let-temporarily ((*s7* 3)) 1) 'error)
+(test (define *s7* 3) 'error)
+(let ((old-pl (*s7* 'print-length)))
+  (let-temporarily (((*s7* 'print-length) 32))
+    (unless (provided? 'snd)
+      ;; print-length is a top-level function in Snd, so (with-let *s7* print-length) sees Snd's print-length
+      ;;   if *s7* were a real let, this would not happen
+      (test (eval-string "print-length" *s7*) 32)
+      (test (with-let *s7* print-length) 32)
+      (test (with-let (sublet *s7*) print-length) 32))
+    (test (let ((s7 *s7*)) (s7 'print-length)) 32)
+    (test (let-set! *s7* 'print-length 8) 8)
+    (test (let-ref *s7* 'print-length) 8)
+    (test (with-let *s7* (+ print-length 1)) 9)
+    (test ((sublet *s7*) 'print-length) 8)
+    (when full-s7test
+      (test ((inlet *s7*) 'print-length) 8) ; this calls each *s7* field, including memory-usage!
+      (test (with-let (inlet *s7*) print-length) 8)))
+  (test (*s7* 'print-length) old-pl)
+  (test (coverlet *s7*) 'error)
+  (test (openlet *s7*) *s7*)
+  (test (*s7* 'print-length) old-pl))
+(test (object->string *s7*) "*s7*")
+(test (object->string *s7* :readable) "*s7*")
+(test (catch #t (lambda () (cutlet *s7* 'print-length)) (lambda (type info) (apply format #f info))) "can't cutlet *s7* (it is immutable)")
+(test (catch #t (lambda () (varlet *s7* 'asdf 3)) (lambda (type info) (apply format #f info))) "can't (varlet *s7* asdf 3), *s7* is immutable")
+(test (help *s7*) "*s7* is a let that gives access to s7's internal state: e.g. (*s7* 'print-length)")
+
+(let ((iter (make-iterator *s7*)))
+  (test (iterator? iter) #t)
+  (test (eq? (iterator-sequence iter) *s7*) #t)
+  (let ((val (iter)))
+    (test (eq? (car val) 'accept-all-keyword-arguments) #t)
+    (test (boolean? (cdr val)) #t)
+    (set! val (iter))
+    (test (eq? (car val) 'autoloading?) #t)
+    (test (boolean? (cdr val)) #t)))
+
+(let ((iter (make-iterator *s7* (cons #f #f))))
+  (test (eq? (iterator-sequence iter) *s7*) #t)
+  (let ((val (iter)))
+    (test (eq? (car val) 'accept-all-keyword-arguments) #t)
+    (test (boolean? (cdr val)) #t)
+    (set! val (iter))
+    (test (eq? (car val) 'autoloading?) #t)
+    (test (boolean? (cdr val)) #t)))
+
+(test (length (object->let *s7*)) (+ *s7*-length 6))
+(test (with-let *s7* (define asdf 321)) 'error)
+(test ((object->let (make-iterator *s7*)) 'sequence) *s7*)
+(when full-s7test
+  (test (length (let->list *s7*)) *s7*-length)
+  (test (length (map values *s7*)) *s7*-length))
+(test (copy (inlet 'a 1) *s7*) 'error)
+(test (vector? (copy *s7* (make-vector 4))) #t)
+(test (load "reactive.scm" *s7*) 'error)
+(test (set! (setter *s7*) #f) 'error)
+(test (set! (outlet *s7*) (curlet)) 'error)
+
+(test (integer? (*s7* 'stack-top)) #t)
+(test (integer? (*s7* 'stack-size)) #t)
+(test (integer? (*s7* 'max-stack-size)) #t)
+(test (integer? (*s7* 'max-heap-size)) #t)
+(test (integer? (*s7* 'max-port-data-size)) #t)
+(test (integer? (*s7* 'output-port-data-size)) #t)
+(test (integer? (*s7* 'rootlet-size)) #t)
+(test (integer? (*s7* 'heap-size)) #t)
+(test (integer? (*s7* 'free-heap-size)) #t)
+(test (integer? (*s7* 'gc-freed)) #t)
+(test (integer? (*s7* 'gc-total-freed)) #t)
+(test (pair? (*s7* 'gc-info)) #t)
+(test (positive? (car (*s7* 'gc-info))) #t)
+(test (positive? (cadr (*s7* 'gc-info))) #t)
+(set! (*s7* 'gc-info) #f) ; same as (set! (*s7* 'gc-info) '(0 0))
+(test (car (*s7* 'gc-info)) 0)
+(test (cadr (*s7* 'gc-info)) 0)
+(test (set! (*s7* 'gc-info) ()) 'error)
+(test (set! (*s7* 'gc-info) '(0 0)) #f)
+(let ((ticks/second (caddr (*s7* 'gc-info))))
+  (test (set! (*s7* 'gc-info) '(0 0 -100)) #f) ; make sure third is ignored
+  (test (caddr (*s7* 'gc-info)) ticks/second))
+(test (integer? (*s7* 'gc-temps-size)) #t)
+(test (real? (*s7* 'gc-resize-heap-fraction)) #t)
+(test (real? (*s7* 'gc-resize-heap-by-4-fraction)) #t)
+(test (real? (*s7* 'cpu-time)) #t)
+(test (integer? (*s7* 'max-string-length)) #t)
+(test (integer? (*s7* 'max-format-length)) #t)
+(test (integer? (*s7* 'max-list-length)) #t)
+(test (integer? (*s7* 'max-vector-length)) #t)
+(test (integer? (*s7* 'max-vector-dimensions)) #t)
+(test (integer? (*s7* 'default-hash-table-length)) #t)
+(test (integer? (*s7* 'initial-string-port-length)) #t)
+(test (real? (*s7* 'equivalent-float-epsilon)) #t)
+(test (real? (*s7* 'hash-table-float-epsilon)) #t)
+(test (integer? (*s7* 'float-format-precision)) #t)
+(test (random-state? (*s7* 'default-random-state)) #t)
+(test (integer? (*s7* 'debug)) #t)
+(test (*s7* 'symbol-quote?) #f)
+(test (*s7* 'symbol-printer) #f)
+(test (*s7* 'stacktrace-defaults) '(3 45 80 45 #t))
+(test (set! (*s7* 'stacktrace-defaults) pi) 'error)
+(test (set! (*s7* 'stacktrace-defaults) '(30)) 'error)
+(test (set! (*s7* 'stacktrace-defaults) '(30 50 80 50 #f pi)) 'error)
+(test (set! (*s7* 'stacktrace-defaults) '(3.0 45 80 45 #f)) 'error)
+(test (set! (*s7* 'stacktrace-defaults) '(3 45.0 80 45 #f)) 'error)
+(test (set! (*s7* 'stacktrace-defaults) '(3 45 80.0 45 #f)) 'error)
+(test (set! (*s7* 'stacktrace-defaults) '(3 45 80 45.0 #f)) 'error)
+(test (set! (*s7* 'stacktrace-defaults) '(3 45 80 45 12)) 'error)
+(let ((L (*s7* 'stacktrace-defaults)))
+  (set-car! L 1+i) ; make sure (*s7* 'stacktrace-defaults) returns a copy of the list
+  (test (integer? (car (*s7* 'stacktrace-defaults))) #t))
+(catch #t
+  (lambda ()
+    (set! (*s7* 'stacktrace-defaults) '(100 #() 1 2 3)))
+  (lambda (type info)
+    (test (apply format #f info)
+          "(set! (*s7* 'stacktrace-defaults) '(100 #() 1 2 3)): the second list element #() is a vector but should be an integer (cols-for-data)")))
+(test (set! (*s7* 'autoloading?) "asdf") 'error)
+(test (let ((hist (*s7* 'history))) (or (not hist) (pair? hist))) #t)
+(test (let ((size (*s7* 'history-size))) (or (not size) (integer? size))) #t)
+(test (boolean? (*s7* 'undefined-identifier-warnings)) #t)
+(test (boolean? (*s7* 'undefined-constant-warnings)) #t)
+(test (boolean? (*s7* 'accept-all-keyword-arguments)) #t)
+(test (boolean? (*s7* 'muffle-warnings?)) #t)
+(test (integer? (*s7* ':print-length)) #t)
+(test (integer? (*s7* :print-length)) #t)
+(test (eqv? (*s7* 'print-length) (*s7* :print-length)) #t)
+(test (boolean? (*s7* 'openlets)) #t)
+(test (string? (*s7* 'version)) #t)
+(test (set! (*s7* 'version) "hi") 'error)
+(test (integer? (*s7* 'major-version)) #t)
+(test (set! (*s7* 'major-version) 32) 'error)
+(test (integer? (*s7* 'minor-version)) #t)
+(test (set! (*s7* 'minor-version) 32) 'error)
+(test (or (not (*s7* 'profile-prefix)) (symbol? (*s7* 'profile-prefix))) #t)
+(let-temporarily (((*s7* 'profile-prefix) 'my-name))
+  (test (*s7* 'profile-prefix) 'my-name)
+  (set! (*s7* 'profile-prefix) #f)
+  (test (*s7* 'profile-prefix) #f))
+
+(let ((__s7__ *s7*)) (test (__s7__ 'heap-size) (*s7* 'heap-size)))
+(test (let () (define (func) (with-let *s7* letrec*)) (func) (func)) letrec*) ; fx_with_let_s bug
+(test (let () (define (f) (with-let (inlet 'x #<undefined>) x)) (f) (f)) #<undefined>)
+(test (let ((I (inlet 'x #<undefined>))) (define (f) (with-let I x)) (f) (f)) #<undefined>)
+
+(let-temporarily (((*s7* 'safety) -1))
+  (test (*s7* 'safety) -1))
+
+(when (provided? 'history)
+  (test (boolean? (*s7* 'history-enabled)) #t)
+  (let-temporarily (((*s7* 'history-enabled) #t))
+    (test (*s7* 'history-enabled) #t)))
+
+(let ()
+  (catch 'one
+    (lambda ()
+      (catch 'two
+	(lambda ()
+	  (catch 'three
+	    (lambda ()
+              (let ((cs (*s7* 'catches)))
+                (test (or (equal? cs '(three two one)) (equal? cs '(three two one string-read-error #t #t))) #t)))
+	    (lambda a a))) (lambda a a))) (lambda a a)))
+
+(test (vector? (*s7* 'gc-protected-objects)) #t)
+(test (list? (*s7* 'file-names)) #t)
+(test (list? (*s7* 'filenames)) #t)
+(test (boolean? (*s7* 'gc-stats)) #f)
+(test (real? (*s7* 'default-rationalize-error)) #t)
+(test (set! (*s7* 'max-format-arg) 12) 'error)
+(test (cutlet *s7* 'let-ref-fallback) 'error)
+(test (varlet *s7* 'let-ref-fallback 123) 'error)
+(test (cutlet *s7* 'let-set-fallback) 'error)
+(test (varlet *s7* 'let-set-fallback 123) 'error)
+(test (let-set! *s7* 'let-ref-fallback #t) 'error)
+(test (type-of *s7*) 'let?)
+(test (let-set! *s7* 'a 1) 'error)
+(test (reverse! *s7*) 'error)
+(test (fill! *s7* #f) 'error)
+(test (copy (inlet 'let-ref-fallback #f) *s7*) 'error)
+(test (copy '((let-set-fallback . 32)) *s7*) 'error)
+(test (let ((e (let () (define-constant a 1) (curlet)))) (let-set! e 'a 2) e) 'error)
+(test (let ((e (let () (define-constant a 1) (curlet)))) (set! (e 'a) 2) e) 'error)
+(test (let ((e (let () (define-constant a 1) (curlet)))) (with-let e (set! a 2)) e) 'error)
+(test (fill! (let ((a 1)) (set! (setter 'a) integer?) (curlet)) #f) 'error)
+(test (let-set! (let ((a 1)) (set! (setter 'a) integer?) (curlet)) 'a #f) 'error)
+(test (let ((a 1)) (set! (setter 'a) integer?) (let ((a #f)) a)) #f)
+(test (let () (define-constant a 3) (let ((a #f)) a)) 'error)
+(test (let ((e (let () (define-constant a 1) (curlet)))) (fill! e 2) e) 'error)
+(test (copy '((a . #f)) (let ((a 1)) (set! (setter 'a) integer?) (curlet))) 'error)
+(test (defined? 'print-length *s7*) #t)
+(test (defined? :print-length *s7*) #t)
+(test (defined? 'asdf *s7*) #f)
+(test (defined? :asdf *s7*) #f) ; maybe inconsistent
+
+(test (setter current-input-port) set-current-input-port)
+(set! (setter current-input-port) #f)
+(test (setter current-input-port) #f)
+(set! (setter current-input-port) set-current-input-port)
+
+(let-temporarily (((*s7* 'default-hash-table-length) 31)
+		  ((*s7* 'hash-table-float-epsilon) 1e-4)
+		  ((*s7* 'equivalent-float-epsilon) .1)
+		  ((*s7* 'gc-stats) #f)
+		  ((*s7* 'max-stack-size) 8192)
+		  ((*s7* 'safety) 1)
+		  ((*s7* 'default-rationalize-error) .1))
+  (let ((ht (make-hash-table))) (test (length ht) 32))
+  (let ((ht (hash-table 'a 1))) (test (length ht) 32))
+  (let ((ht (hash-table :a 1))) (test (length ht) 32))
+  (let ((ht (make-hash-table))) (set! (ht 3.0) 'x) (set! (ht 3.00005) 'y) (test (ht 3.00001) #f))
+  (test (equivalent? 1.0 1.01) #t)
+  (test (rationalize 3.14159) 16/5))
+(let ((ht (make-hash-table))) (test (length ht) (*s7* 'default-hash-table-length)))
+(let ((ht (make-hash-table))) (set! (ht 3.0) 'x) (set! (ht 3.05) 'y) (test (ht 3.01) #f))
+(test (equivalent? 1.0 1.01) #f)
+(test (rationalize 3.14159) 314159/100000)
+
+(let-temporarily (((*s7* 'float-format-precision) 123123123))
+  (test (*s7* 'float-format-precision) 128))
+(let ((lim (*s7* 'float-format-precision)))
+  (test (set! (*s7* 'float-format-precision) -123) 'error)
+  (test (*s7* 'float-format-precision) lim))
+
+
+;; max-vector-length
+(let-temporarily (((*s7* 'max-vector-length) 123))
+  (test (make-vector 256) 'error)
+  (test (make-float-vector 256) 'error)
+  (test (make-int-vector 256) 'error)
+  (test (make-byte-vector 256) 'error)
+  (test (make-hash-table 256) 'error)
+  (test (make-weak-hash-table 256) 'error)
+  (test (symbol-table) 'error))
+
+(let-temporarily (((*s7* 'max-vector-length) 3))
+  (test (vector 1 2 3 4) 'error)
+  (test (float-vector 1 2 3 4) 'error)
+  (test (int-vector 1 2 3 4) 'error)
+  (test (byte-vector 1 2 3 4) 'error)
+  (test (string->byte-vector "12345") 'error)
+  (test (eval-string "#(1 2 3 4)") 'error)
+  (test (eval-string "#r(1 2 3 4)") 'error)
+  (test (eval-string "#i(1 2 3 4)") 'error)
+  (test (eval-string "#u(1 2 3 4)") 'error)
+  (test (list->vector '(1 2 3 4 5)) 'error)
+  (test (hash-table 'a 1 'b 2 'c 3 'd 4) 'error)
+  (test (weak-hash-table 'a 1 'b 2 'c 3 'd 4) 'error)
+  (test (append (vector 1 2) (vector 3 4)) 'error)
+  (test (vector-append (vector 1 2) (vector 3 4)) 'error))
+
+
+;; max-vector-dimensions
+(let-temporarily (((*s7* 'max-vector-dimensions) 1))
+  (test (make-vector '(2 3)) 'error)
+  (test (make-float-vector '(2 3)) 'error)
+  (test (make-int-vector '(2 3)) 'error)
+  (test (subvector (vector 1 2 3 4) 0 4 '(2 2)) 'error))
+
+
+;; max-format-length
+(when (= (*s7* 'debug) 0)
+  (let-temporarily (((*s7* 'max-format-length) 12))
+    (test (format #f "~NC" 256 #\a) 'error)))
+
+
+;; max-string-length
+(let-temporarily (((*s7* 'max-string-length) 12))
+  (test (append (make-string 9 #\a) (make-string 9 #\b)) 'error)
+  (test (string-append (make-string 9 #\a) (make-string 9 #\b)) 'error)
+  (test (let ((port (open-output-string)))
+          (display "aaaaaaaaa" port)
+          (display "bbbbbb" port)
+          (get-output-string port))
+        'error)
+  (test (make-string 24 #\a) 'error)
+  (test (call-with-input-file "s7test.scm"
+          (lambda (port)
+            (read-string 20 port)))
+        'error)
+  (test (call-with-output-string
+          (lambda (p)
+            (display "aaaaaaaa" p)
+            (display "bbbbbbbbb" p)))
+        'error)
+  (test (byte-vector->string #u(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)) 'error)
+  (test (symbol->string (symbol "aaaaaaaaa" "bbbbbbbbb")) 'error)
+  (test (string #\a #\a #\a #\a #\a #\a #\a #\a #\a #\a #\a #\a #\a #\a #\a) 'error)
+  (test (list->string '(#\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\a #\b #\c #\d #\e)) 'error)
+  (let ((str "0123456789"))
+    (test (string-append str str str) 'error))
+  (test (make-string 256) 'error))
+
+(let-temporarily (((*s7* 'max-string-length) 3))
+  (test (port-filename) 'error))
+
+;; max-list-length
+(let-temporarily (((*s7* 'max-list-length) 1))
+  (test (make-list 256) 'error))
+
+(let-temporarily (((*s7* 'max-list-length) 3))
+  (test (vector->list #(a b c d)) 'error)
+  (test (string->list "abcdef") 'error))
+
+
+#|
+;;; these could be checked for max-*, but are tricky or dubious etc
+
+(let-temporarily (((*s7* 'max-string-length) 3))
+  (number->string pi)
+  (object->string pi)
+  "asdfghj") ; complicated and hard to test
+
+(let-temporarily (((*s7* 'max-string-length) 12))
+  (format #f "~W" (vector pi))
+  (format #f "~NC" 80 #\-)
+  (stacktrace)
+  (call-with-input-file "s7test.scm" (lambda (port) (read-line port))) ; complicated
+  (documentation 'abs)
+  (help 'abs)
+  (system "ls tools" #t) ; s7.c 36742
+  (*s7* 'version))
+
+(let-temporarily (((*s7* 'max-vector-length) 3))
+  (*s7* 'gc-protected-objects) ; s7.c 93115, copied before len known
+  (append (hash-table 'a 1 'b 2) (hash-table 'c 3 'd 4)))) ; s7.c 50065, but it's in a loop
+
+(let-temporarily (((*s7* 'max-list-length) 3))
+  (map (lambda (a) (values a a)) "12")
+  (let->list (inlet 'a 1 'b 2 'c 3 'd 4)) ; s7.c ca 9980, but len not always easily available
+  '(a b c d)
+  (list 1 2 3 4)         ; just copies args
+  (list-values 1 2 3 4)
+  (append '(1 2) '(3 4))
+  (map (lambda (a) (values a a)) '(1 2))
+  (map (lambda (a) (values a a)) #(1 2 3 4))
+  (directory->list "tools")   ; s7.c 36801, but kinda dumb
+  (*s7* 'stacktrace-defaults) ; 5
+  (*s7* 'file-names) ; 4 in t651
+  ;; also c-types, file-names, stack-entries and history
+  ;;      cyclic-sequences? procedure-source? signature? read? cons!?!
+  ;;      (*function* 'arglist)?
+  ;;      *features*
+  )
+|#
+
+(test (*s7* 14) 'error)
+(test (*s7* (list 1)) 'error)
+(test (set! (*s7* 14) 1) 'error)
+(when full-s7test
+  (test (string? (with-output-to-string (lambda () (let-temporarily (((*s7* 'safety) -1)) (*s7* 'memory-usage))))) #t))
+(test (set! (*s7* 'hash-table-float-epsilon) 10) 10)
+(test (set! (*s7* 'hash-table-float-epsilon) 1/10000) 1/10000)
+(test (set! (*s7* 'hash-table-float-epsilon) -.1) 'error)
+(test (set! (*s7* 'equivalent-float-epsilon) -.1) 'error)
+(test (set! (*s7* 'default-rationalize-error) -.1) 'error)
+(test (set! (*s7* 'bignum-precision) -10) 'error)
+(test (set! (*s7* 'bignum-precision) .1) 'error)
+(when full-s7test
+  (test (pair? (append '(1) *s7* ())) #t)
+  (test (string? (format #f "~W" (inlet *s7*))) #t))
+
+(when (provided? 'number-separator)
+  (let-temporarily (((*s7* 'number-separator) #\null))
+    (test (*s7* 'number-separator) #\null)
+    (test (eval-string "12,321") 'error) ; unbound variable
+    (set! (*s7* 'number-separator) #\,)
+    (test (eval-string "12,321") 12321)
+    (test (eval-string "12,321.5") 12321.5)
+    (test (eval-string "12,321+inf.0i") 12321+inf.0i)
+    (test (eval-string "1,23,456,7890") 1234567890)
+    (set! (*s7* 'number-separator) #\_)
+    (test (eval-string "_123") 'error)
+    (test (eval-string "1_2_3") 123)
+    (test (eval-string "#x16_2") #x162)
+    (test (eval-string "123_") 'error)
+    (test (eval-string "1__2") 'error)
+    (test (eval-string "1+_3i") 'error)
+    (test (eval-string "1/_2") 'error)
+    (test (eval-string "1_2+i") 12.0+1.0i)
+    (test (eval-string "1+1_2i") 1.0+12.0i)
+    (test (eval-string "12_3/3_4") 123/34)
+    (test (string->number "a_b_c@1" 16) #xabc@1)
+    (test (string->number "a_b_c@1" 12) #f)
+    (test (string->number "1_2@1" 2) #f)
+    (test (string->number "1_1@1" 2) 6.0)
+    (num-test (eval-string "1.0@2_3") 1.0e23)
+    (num-test (eval-string "1.0e2_3") 1.0e23))
+  (let-temporarily (((*s7* 'number-separator) #\a))
+    (test (eval-string "a1") 'error) ; unbound variable a1
+    (test (eval-string "1a") 'error) ; unbound variable 1a
+    (test (eval-string "1a1") 11)
+    (test (eval-string "1a+i") 'error) ; unbound variable 1a+i
+    (test (eval-string "1a1/2a2") 1/2))
+  (let-temporarily (((*s7* 'number-separator) #\'))
+    (test (eval-string "10'10'10") 101010))
+
+  (test (set! (*s7* 'number-separator) #\.) 'error)
+  (test (set! (*s7* 'number-separator) #\e) 'error)
+  (test (set! (*s7* 'number-separator) #\E) 'error)
+  (test (set! (*s7* 'number-separator) #\@) 'error))
+
+(let ((v ()))
+  (let ((val1 (object->string (do ((i 1 (+ i 1))) ((= i 4) v) (set! v (cons (sin i) v))))))
+    (set! v ())
+    (let ((val2 (let-temporarily (((*s7* 'float-format-precision) 3))
+		  (object->string (do ((i 1 (+ i 1))) ((= i 4) v) (set! v (cons (sin i) v)))))))
+      (test val1 "(0.1411200080598672 0.9092974268256817 0.8414709848078965)")
+      (test val2 "(0.141 0.909 0.841)")
+      (test (<= (length val1) (length val2)) #f))))
+
+(for-each
+ (lambda (field)
+   (for-each
+    (lambda (arg)
+      (test (set! (*s7* field) arg) 'error))
+    (list "hi" (integer->char 65) (list 1 2) #t (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+	  3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) #<eof> #<undefined>)))
+ '(print-length safety cpu-time heap-size free-heap-size gc-freed gc-total-freed max-string-length max-list-length max-vector-length max-vector-dimensions
+   default-hash-table-length initial-string-port-length gc-protected-objects file-names rootlet-size c-types stack-top stack-size stacktrace-defaults max-stack-size
+   catches exits float-format-precision bignum-precision))
+
+(for-each
+ (lambda (field)
+   (let ((old-val (*s7* field)))
+     (test (set! (*s7* field) -12) 'error)
+     (test (set! (*s7* field) 0) 'error)
+     (set! (*s7* field) old-val)))
+ '(max-string-length max-list-length max-vector-length max-vector-dimensions bignum-precision
+   default-hash-table-length initial-string-port-length max-stack-size))
+
+(for-each
+ (lambda (field)
+   (let ((old-val (*s7* field)))
+     (test (set! (*s7* field) -12) 'error)
+     (set! (*s7* field) old-val)))
+ '(print-length float-format-precision))
+
+(for-each
+ (lambda (field)
+   (for-each
+    (lambda (arg)
+      (test (set! (*s7* field) arg) 'error))
+    (list "hi" (integer->char 65) (list 1 2) #t (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand
+	  1.0+1.0i #\f (lambda (a) (+ a 1)) #<eof> #<undefined>)))
+ '(default-rationalize-error default-random-state equivalent-float-epsilon hash-table-float-epsilon))
+
+(for-each
+ (lambda (field)
+   (for-each
+    (lambda (arg)
+      (test (set! (*s7* field) arg) 'error))
+    (list "hi" (integer->char 65) (list 1 2) (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand
+	  3/4 3.14 1.0+1.0i #\f (lambda (a) (+ a 1)) #<eof> #<undefined>)))
+ '(undefined-identifier-warnings undefined-constant-warnings gc-stats accept-all-keyword-arguments muffle-warnings?))
+
+(test (set! (*s7* 123) 0) 'error)
+(test (set! (*s7* #(123)) 0) 'error)
+(test (let () (define (f) (set! (*s7* #(123)) 0)) (f) (f)) 'error)
+(test (let () (define (f) (set! (*s7* #(123)) 0)) (catch #t f (lambda args #f)) (f)) 'error)
+
+(let-temporarily (((*s7* :print-length) 123))
+  (test (*s7* :print-length) 123)
+  (set! (*s7* :print-length) 321)
+  (test (*s7* :print-length) 321))
+
+(test (set! #_abs 32) 'error)
+(test (define (#_abs a) (= a 1)) 'error)
+(test #|a|#|b|#|c|# 'error) ; unbound variable |b|#|c|#
+
+(test (catch #t
+	(lambda ()
+	  (let-temporarily (((*s7* 'undefined-identifier-warnings) #t)
+			    ((*s7* 'autoloading?) #f))
+	    (define (func)
+	      (+ 1 (asdf123 3)))
+	    (define (hi) (func))
+	    (hi)))
+	(lambda (type info)
+	  type))
+      'unbound-variable)
+
+(gc #t)
+
+(let ()
+  (define (f)
+    (let-temporarily (((*s7* 'safety) 1))
+      (format #f "~A" (quasiquote quote))))
+  (f)) ; check unheap bug (s7_is_valid)
+
+(let ()
+  (define (s7-field-test)
+    (for-each
+     (lambda (arg)
+       (catch #t (lambda () (let-temporarily (((*s7* 'accept-all-keyword-arguments) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'autoloading?) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'bignum-precision) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'c-types) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'catches) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'cpu-time) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'debug) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'default-hash-table-length) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'default-random-state) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'default-rationalize-error) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'equivalent-float-epsilon) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'expansions?) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'file-names) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'float-format-precision) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'free-heap-size) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'gc-freed) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'gc-info) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'gc-protected-objects) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'gc-resize-heap-by-4-fraction) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'gc-resize-heap-fraction) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'gc-stats) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'gc-temps-size) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'gc-total-freed) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'hash-table-float-epsilon) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'heap-size) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'history) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'history-enabled) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'history-size) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'initial-string-port-length) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'major-version) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'minor-version) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'max-format-length) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'max-heap-size) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'max-list-length) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'max-port-data-size) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'max-stack-size) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'max-string-length) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'max-vector-dimensions) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'max-vector-length) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'memory-usage) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'most-negative-fixnum) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'most-positive-fixnum) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'muffle-warnings?) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'openlets) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'output-port-data-size) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'print-length) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'profile) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'profile-info) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'profile-prefix) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'rootlet-size) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'safety) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'stack) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'stack-size) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'stack-top) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'stacktrace-defaults) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'symbol-printer) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'symbol-quote?) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'undefined-constant-warnings) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'undefined-identifier-warnings) arg)) #f)) (lambda (type info) #f))
+       (catch #t (lambda () (let-temporarily (((*s7* 'version) arg)) #f)) (lambda (type info) #f)))
+     (vector #f #t () #\a #<undefined> #<unspecified> #<eof> 1 2/3 1.0 1+i (list 0) 'a set!
+	     "11" #(1+i 2+i) #i(312 1234) #r(1.5 2.5) #u(1 2) #2i((1 2) (3 4)) (hash-table 'a 1 'b 2)
+	     (inlet 'a 1 'b 2) (c-pointer 0) (random-state 1234) (lambda () 1) (lambda* ((a 21)) (+ a 1))
+	     (macro (a) `(+ ,a 1)) (macro* ((a 32)) `(+ ,a 1)) quasiquote
+	     (bacro (a) `(+ ,a 1)) (bacro* ((a 32)) `(+ ,a 1)) (open-output-string) (open-input-string "1234")
+	     abs + make-hash-table map port-line-number (call/cc (lambda (c) c)) (call-with-exit (lambda (c) c))
+	     (make-iterator '(1 2 3)))))
+  (s7-field-test))
+
+(when full-s7test
+  (let ((mem (*s7* 'memory-usage)))
+    (test (pair? (mem 'approximate-s7-size)) #t)
+    (test (let? (mem 'free-lists)) #t)
+    (test (mem 'asdf) #<undefined>))
+  (test (*s7* :asdf) #<undefined>))
+
+(for-each
+ (lambda (f)
+   (catch #t
+     (lambda ()
+       (set! (*s7* f) 123)
+       (format *stderr* "oops: set! (*s7* '~S) did not fail!~%" f))
+     (lambda (t i)
+       (unless (eq? t 'immutable-error)
+	 (format *stderr* "~S: ~S ~S~%" f t i)))))
+ '(catches cpu-time c-types file-names free-heap-size gc-freed gc-total-freed gc-protected-objects memory-usage
+   most-negative-fixnum most-positive-fixnum rootlet-size stack stack-size stack-top version major-version minor-version))
+
+(let ((s7g (dilambda
+	    (lambda ()
+	      (*s7* 'gc-freed))
+	    (lambda (val)
+	      (set! (*s7* 'gc-freed) val)))))
+  (catch #t
+    (lambda ()
+      (let-temporarily (((s7g) 123))
+	(display 'oops *stderr*)))
+    (lambda (type info)
+      (unless (string=? (apply format #f info) "can't set (*s7* 'gc-freed)")
+	(format *stderr* "set s7g: ~A~%" (apply format #f info))))))
+
+(let ()
+  (define (func) (hash-table (copy (*s7* 'gc-protected-objects) '((x))) (values 2 3) 0))
+  (test (func) (hash-table '(#f) 2 3 0)))
+
+(let () ; check op_let_temp_s7_direct and unwinders
+  (define (f1)
+    (let-temporarily (((*s7* 'openlets) #f))
+      (*s7* 'openlets)))
+  (test (*s7* 'openlets) #t)
+  (test (f1) #f)
+  (test (*s7* 'openlets) #t)
+  (test (f1) #f)
+  (test (*s7* 'openlets) #t)
+
+  (define (f2)
+    (call-with-exit
+     (lambda (return)
+       (let-temporarily (((*s7* 'openlets) #f))
+	 (return (*s7* 'openlets))))))
+  (test (*s7* 'openlets) #t)
+  (test (f2) #f)
+  (test (*s7* 'openlets) #t)
+  (test (f2) #f)
+  (test (*s7* 'openlets) #t)
+
+  (define (f3)
+    (call/cc
+     (lambda (return)
+       (let-temporarily (((*s7* 'openlets) #f))
+	 (return (*s7* 'openlets))))))
+  (test (*s7* 'openlets) #t)
+  (test (f3) #f)
+  (test (*s7* 'openlets) #t)
+  (test (f3) #f)
+  (test (*s7* 'openlets) #t))
+
+(test (let () (define* (v3 x y) (values x y)) (define (func) (list (let-temporarily (((*s7* 'openlets) #f)) (v3)))) (func) (func)) (list #f #f)) ; unwinder mv check
+
+(test (*s7* 'symbol-quote?) #f)
+
+
+;;; --------------------------------------------------------------------------------
+;; it's documented that this kind of stuff may be optimized out, so these can do anything
+;(test (let ((x (abs -1)) (sba abs)) (set! abs odd?) (let ((y (abs 1))) (set! abs sba) (list x y abs))) (list 1 #t abs))
+;(test (let () (define (hi z) (abs z)) (let ((x (hi -1)) (sba abs)) (set! abs odd?) (let ((y (hi 1))) (set! abs sba) (list x y)))) (list 1 #t))
+;(test (let () (define (hi z) (abs z)) (let ((x (hi -1)) (sba abs)) (set! abs (lambda (a b) (+ a b))) (let ((y (hi 1))) (set! abs sba) (list x y)))) 'error)
+;(set! abs #_abs)
+;(test (let () (define (hi) (let ((cond 3)) (set! cond 4) cond)) (hi)) 4)
+;(test (let ((old+ +) (j 0)) (do ((i 0 (+ i 1))) ((or (< i -3) (> i 3))) (set! + -) (set! j (old+ j i))) (set! + old+) j) -6)
+
+(let ()
+  (define (freef) (local-func 0))
+  (test (freef) 'error)
+  (define (local-func x) (+ x 1))
+  (test (freef) 1)
+  (set! local-func (lambda (x y) (+ x y)))
+  (test (freef) 'error)
+  (set! local-func (lambda (x) (+ x 2)))
+  (test (freef) 2)
+  (set! local-func 2)
+  (test (freef) 'error))
+
+(let ()
+  (define (freeg) (+ local-var 1))
+  (define (freeh) (set! local-var 2))
+  (test (freeg) 'error)
+  (test (freeh) 'error)
+  (define local-var 1)
+  (test (freeg) 2)
+  (test (freeh) 2))
+
+(let () ; new_s7_optimize
+  (define (f1)
+    (do ((i 0 (+ i 1)))
+	((= i 10))
+      (if (< i 0) (format *stderr* "oops~%"))))
+
+  (f1)  ; opt_dotimes create/store
+  (f1)  ; opt_dotimes restore
+
+  (define (f2 seq item start end)
+    (do ((i start (+ i 1)))
+	((= i end))
+      (set! (seq i) item)))
+
+  (f2 (list 1 2 3) 4 0 3)   ; opt_dotimes create/store
+  (f2 (vector 1 2 3) 4 0 3) ; opt_dotimes fallback
+
+  (define (f3)
+    (do ((i 0 (+ i 1))
+	 (j 0 (+ j 1)))
+	((= i 10))
+      (if (not (= i j)) (format *stderr* "oops~%"))))
+
+  (f3)  ; dox_ex create/store
+  (f3)  ; dox_ex restore
+
+  (define (f4)
+    (let ((v (make-vector 10)))
+      (do ((i 0 (+ i 1)))
+	  ((= i 10))
+	(vector-set! v i i))))
+
+  (f4)  ; simple_do_ex create/store
+  (f4)  ; simple_do_ex restore
+
+  (define (f5 x)
+    (let ((y 0))
+      (do ((i 0 (+ i 1))
+	   (j 0 (+ j 1)))
+	  ((= i 10))
+	(set! y (+ i x)))))
+
+  (f5 0)
+  (f5 2)
+  (f5 1/2) ; dox_ex fallback
+  (f5 pi))
+
+
+;;; bizarre optimizer checks
+(test (let () (define (func x) (if (pair? (cdr /)) 3)) (define (hi) (func (integer->char 255))) (catch #t (lambda () (hi) (func (integer->char 255))) (lambda arg #f))) #f)
+(test (catch #t (lambda () (define (func x) (cond (case `((1)) (if x y) =>))) (define (hi) (func ())) (hi)) (lambda args 'error)) 'error)
+(let ()
+  (define (func x)
+    (case x
+      ((#t) (- (cdaadr)))
+      (('(((x 1) 2) 3)) (cadddr or (list (list 1 2)) (<= (sort!))))
+      (else (cond (case / #() let* 0+1/0i (list (list 1)) (lambda* / (caadar (read-byte // (assv)))))))))
+  (define (hi)
+    (func 1+0/0i))
+  (hi)
+  (func 1+0/0i))
+
+(test (let ()
+	(define (f1 a b)
+	  (list a b))
+	(define (f2)
+	  (when #f (define f2_c 2))
+	  (f1 f2_c #f))
+	(f2)) 'error)
+
+(test (let ()
+	(define (f1 a b)
+	  (list a b))
+	(define (f3)
+	  (if #f (define f3_c 2))
+	  (f1 f3_c f3_c))
+	(f3)) 'error)
+
+(test (let ()
+	(define (f4 a b)
+	  (catch #t (lambda () a) (lambda args (display (ow!)))))
+	(define (f5)
+	  (when #f (define f5_c 50))
+	  (f4 f5_c (lambda () 1)))
+	(f5)) 'error)
+
+(test (let ()
+	(define (f6)
+	  (and #f (define f7_c 50))
+	  (+ f7_c ((lambda () 1))))
+	(f6)) 'error)
+
+(test (let () (define (func x) (call-with-exit (lambda ((i 0 (+ i 1))) #f))) (define (hi) (func begin)) (hi) (func begin)) 'error)
+(test (let () (define (func x) (if (cond (cddr => (lambda))) (cddddr `(((+ x 1)))))) (define (hi) (func '((x 1) (y) . 2))) (hi) (func '((x 1) (y) . 2))) 'error)
+(test (let () (define (func x) (if (memq / (quote . "")) (assv '()))) (define (hi) (func x y z)) (hi) (func x y z)) 'error)
+(test (let () (define (func x) (cond (case / (set! _settee_ (caadr))))) (define (hi) (func 0/0+0/0i)) (hi) (func 0/0+0/0i)) 'error)
+(test (let () (define (func x) (object->string (list  (funclet  /)))) (define (hi) (func abs)) (hi)) "((rootlet))")
+(test (let () (define (func x) (cdadar (not (eq? / '())))) (define (hi) (func '((())))) (hi)) 'error)
+(test (let () (define (func x) (append (inlet 'integer? (lambda (f) #f)) (hash-table `((+ x 1)) '(((x 1) 2) 3)))) (define (hi) (func 1)) (hi)) 'error)
+(test (let () (define (func x) (float-vector? (<= / (let-ref 1+0/0i 0)))) (define (hi) (func 0/0+i)) (hi)) 'error)
+(test (let () (set! else #(0 0)) (define (func x) (car (boolean? (char=? (else ()) (= i 2))))) (define (hi) (func '(()))) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (logior // (+)))) (define (hi) (func 0+1/0i)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (int-vector-ref /(asinh (logand))))) (define (hi) (func 0+1/0i)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (logxor /(lognot (gcd))))) (define (hi) (func (list (list 1 2)))) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (int-vector-set! / 1 2))) (define (hi) (func 1.5)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (quote . /))) (define (hi) (func (integer->char 255))) (hi)) 'error)
+(test (let () (define (func x) (cond ((if if . :readable) #f))) (define (hi) (func begin)) (hi)) 'error)
+(test (let () (define (func x) (if (not . /) x)) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (set! (with-let / begin `(+ ,a ,b ,@c) #<undefined>) #f)) (define (hi) (func #f)) (hi)) 'error)
+(test (procedure? (let () (define (func) (cond (case 'x (lambda / x)))) (func))) #t)
+(test (procedure? (let () (define (func x) (cond (case / (lambda* abs /)) (else #f))) (define (hi) (func #f)) (hi))) #t)
+(test (let () (define (func x) (let () (define _x_ (lambda* . let*)))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (set! (with-let . ()) #f)) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (call/cc (lambda (_x_) (acosh (unlet))))) (define (hi) (func #f)) (hi)) 'error)
+(test (procedure? (let () (define (func x) (cond (case '((x 1) y . 2) 1/0+i :readable (lambda / macroexpand `(x 1))) (else #f))) (define (hi) (func #f)) (hi))) #t)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (member :rest (cons 1 2) /))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (char-numeric?  (make-vector 3)  1.5  `((+ x 1))  ))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (procedure? //))) (define (hi) (func #f)) (hi)) 'error)
+;(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (char-numeric? (char-ready?  )))) (define (hi) (func #f)) (hi)) 'error) ;#t if opt
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (iterator-at-end? /))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (hash-table-ref /(flush-output-port  )))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (let () (set! ((dilambda / (let ((x 3)) (lambda (y) (+ x y)))  )) 3))) (define (hi) (func #f)) (hi)) 6) ;!
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (unlet /(immutable?  )))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (catch #f (vector-ref #(1 2) 0 1.0+1.0i) (vector-ref #(1 2) 0 1.0+1.0i))) (define (hi) (func #f)) (hi)) 'error)
+(test ((vector abs log) 0 -1) 1) ; weird...
+(test (vector-ref (vector abs log) 0 -1) 1) ;'error
+(test (let () (define (func x) (cond (lambda (if x y) 0 1.0+1.0i (string>=? / `((+ x 1)) x y z (integer->char 255))) (else #f))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (format  `((x))  (list 1)  cons  else  (read  (string-append  /))))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (<= -1 (round /)))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (byte-vector-ref (make-string 3) 0))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (char-ci<? (null? i) (quote . let)))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (int-vector-ref #i2d((1 2) (3 4)) 0))) (define (hi) (func #f)) (hi)) #t)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (denominator (sqrt (hash-table-ref (if x y) 0+0/0i))))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (and  `((x)) (string (integer->char 255))))) (define (hi) (func #f)) (hi)) #t)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (string>? (null? i) (object->let /)) (string>? (null? i) (object->let /)))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) / (letrec . #t))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) :readable `((x . 1)) (provide (quote /)))) (define (hi) (func #f)) (hi)) 1)
+(test (let () (define (func x) (iterator-sequence (string-ci<=? (do ((i 0 (+ i 1))) ((= i 1) i) (when (+ i 1) `(+ x 1) (list 1) (- i 1)))))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (continuation? (do ((i 0 (+ i 1))) ((= i 1) i)  (unless   (+ i 1)  quasiquote  )))) (define (hi) (func #f)) (hi)) #f)
+(test (let () (define (func x) (error `(x 1) (null? i) (list 1 2) (lambda . /))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) / (case / (if x y) #2d((1 2) (3 4)) (x => y)))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (char>=? (inlet 'a 1) (hook-functions (output-port?))) (vector? (letrec))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (letrec // . letrec)) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (for-each quasiquote (object->let /))) (define (hi) (func #f)) (hi)) #<unspecified>)
+(test (let () (define (func x) (provided? (eval-string  (do ((i 0 (+ i 1))) ((= i 1) i) (case))))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (cond (denominator 1 . 2))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (when denominator 1 . 2)) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (case 0 ((0) 1 . 2))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (case denominator ((0) 1) (else 1 . 2))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (cond (denominator . 2))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (when denominator . 2)) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (case 0 ((0) . 2))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (case denominator ((0) 1) (else . 2))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (string? (object->string (hash-table (list-values (object->let /)))))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (sort! / (lambda (zero? i) (zero? i)))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (string>? (string) (read-line)))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 3)) (let-set! cons '() macroexpand))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (hash-table-set! cons -1 ()))) (f)) 'error)
+(test (let () (define (func x) (call-with-values  quasiquote  macroexpand  )) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (modulo (expt 2 32) (make-iterator (list 1 2 3))))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (< (read-char (cond (boolean? lambda* (lambda (a) (values a (+ a 1))) `(+ ,a ,b) 0+0/0i))))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (exact->inexact (cond (continuation? lambda (lambda (a) (values a (+ a 1))) (values "ho") `(x) `(+ ,a ,b))))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) 0 (cond (quote (define _definee_ 0))))) (define (hi) (func #f)) (hi)) 1)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) 0 (cond '(define _definee_ 0)))) (define (hi) (func #f)) (hi)) 1)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (let* ()))) (define (hi) (func #f)) (hi)) 'error) ; not 0!
+(test (let () (define (func x) (input-port? (c-pointer (values 1 2) begin))) (define (hi) (func #f)) (hi)) #f) ; not 'error
+(test (let () (define (func x) (member letrec '#())) (define (hi) (func #f)) (hi)) 'error) ; not #f
+(test (let () (define (func abs) (abs 1)) (define (hi) (func '(1 2 3))) (hi)) 2)
+(test (let () (define (hi) ((lambda (abs) (abs 1)) '(1 2 3))) (hi)) 2)
+(test (let () (define (func x) ((lambda (values) (values "ho")) '((x 1) 2))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (multiple-value-bind (values) '((x 1) 2) (values "ho"))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (multiple-value-bind (list) macroexpand '((1 2) (3 4)) (length (list)))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (multiple-value-bind (hash-table) (integer->char 255) (pair? (hash-table? (let* () 0+1/0i (hash-table)))))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (multiple-value-bind (list) -1 `((1) . x) #() (make-iterator (list 1 2 3)) (random-state 1234) 1234)) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (char-numeric? most-negative-fixnum))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (char-alphabetic? (list)))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (char-whitespace? (make-hash-table)))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (vector->list (values 1 2) #(1 2))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (truncate (/ (values 1 2) 0))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (fill! (values 1 2) `(+ x 1))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (not (zero? :readable))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (exact->inexact 1.0+123.0i))) (define (hi) (func #f)) (hi)) 1)
+(test (let () (define (func x) (inlet 'if 3)) (define (hi) (func #f)) (hi)) (inlet 'if 3))
+(test ((let () (define (func x) (inlet ':allow-other-keys 3)) (define (hi) (func #f)) (hi)) 'allow-other-keys) 3)
+(test (let () (define (func x) (vector (setter car) (quote (null? i) #r2d((.1 .2) (.3 .4))))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (c-pointer? begin (member let-temporarily (values 1 2)))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (integer? (assoc (values) '((x 1) (y) . 2) cons))) (define (hi) (func #f)) (hi)) #f)
+(test (let () (define-macro (_mac_ x) `(+ ,x 1)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) 1) (_mac_ +inf.0 . #x123.123))) (define (hi) (func #f)) (hi))) 'error)
+(test (let () (define (func x) (reverse! (write-string (symbol->string :allow-other-keys) #f))) (define (hi) (func #f)) (hi)) "syek-rehto-wolla:") ; copied we hope
+(test (symbol->string :allow-other-keys) ":allow-other-keys")
+(test (let () (define (func x) (with-let (openlet (inlet 'abs (lambda (x) (- x)))) '(- 1) (abs 1+1i))) (define (hi) (func #f)) (hi)) -1-i)
+(test (let ((x #f)) (define (func) (member "c" '(x) (lambda (a b) (call/cc (lambda (return) (return #f)))))) (define (hi) (func)) (hi)) #f)
+(test (let ((x #f)) (define (func) (assoc "c" '((x . 1)) (lambda (a b) (call/cc (lambda (return) (return #t)))))) (define (hi) (func)) (hi)) '(x . 1))
+(let ((imp '(0 1))) (define (func) (list (hash-table-ref imp imp) #u(0 1) #r())) (define (hi) (func)) (test (hi) 'error))
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (fill! (curlet) (list-values letrec cond)))) (define (hi) (func)) (hi)) 'error)
+(let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (eval-string (object->string (curlet)))))) (define (hi) (func)) (test (hi) (inlet 'i 0)))
+(test (let () (define (func) (hash-table-entries (string-ref (iterator-sequence (symbol? x)) #i2d((101 201) (3 4))))) (func)) 'error)
+(test (let () (define (_fnc3_ x) (* x 2.0)) (define (f) (_fnc3_ (inlet :a (hash-table 'b 1)))) (f)) 'error)
+(test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (let-temporarily ((i 0 (+ i 1))) #i(1) 1)))) (define (hi) (func)) (hi)) 'error)
+(unless with-bignums (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (log 1 (abs x))))) (define (hi) (func)) (hi)) 0))
+(test (let () (define (f) (with-input-from-string '(+ x 1) (cdaar))) (f)) 'error)
+(let ((v (make-vector '(2 2)))) (test (member 1 (list 3 2) (lambda (a b) (immutable? (list v -1/2 (+ 1 2))))) #f)) ; list_3_direct
+(test (let () (define (func) (let ((x #f)) (if (car (list 1)) (string=? let (abs))))) (func) (func)) 'error)
+
+(test (let ((+ -)) (define (f x) (+ x 1)) (object->string f :readable)) "(let ((+ #_-)) (lambda (x) (+ x 1)))") ; can also be -
+(test (let () (define (func) (let ((+ -)) (+ (begin (real-part (random 0+i))) 'value "") (string->symbol (case)))) (define (hi) (func)) (hi)) 'error)
+(test (let () (define (func) (let ((+ -)) (+ (begin (real-part (random 0+i)) 0) 'value "") (string->symbol (case)))) (define (hi) (func)) (hi)) 'error)
+(test (let ((_f_ (lambda () (>= (cond (immutable! "asdf") (immutable! (hash-table 'a 1))) (caadar(caadr)))))) (_f_) (_f_)) 'error)
+(test (let () (define (!f!) (let ((!x! (map (lambda (!a!) (dynamic-wind + + +)) '(0)))) (car !x!))) (!f!)) 0)
+(test (let () (define (!f!) (let ((!x! (map (lambda (!a!) (dynamic-wind lcm gcd *)) '(0)))) (car !x!))) (!f!)) 0)
+(test (let () (define (func) (cdddr (c-pointer (bignum 1) (vector) (vector 1) (vector 2)) (adjoin (list 1) (list 1 2)))) (define (hi) (func)) (hi)) 'error)
+
+(test (let () (define (func) (let ((+ -)) (let ((cons list)) (cons  #o123 +documentation+ 0-i)))) (func) (func)) 'error)
+(test (let () (define (func) (let ((+ -)) (+ (bignum 1234.1234) 100 .0-) (string-ci=? (ash (open-input-string (documentation)))))) (func) (func)) 'error)
+(test (let () (define (func) (let ((+ -)) (let ((cons list)) (+ 100 0+. #r2d((.1 .2) (.3 .4)))))) (func) (func)) 'error)
+
+(test (let () (define (func) (let ((x #f) (i 0)) (case x (else (string->number))))) (func)) 'error)
+(test (let () (define (func) (apply + (string-ref ((if (> 3 2) abs log) 1) 0))) (func)) 'error)
+(test (let () (define (func) (apply char? (list (string-ref ((if (> 3 2) string string) #\a) 0)))) (func)) #t)
+(test (let () (define (func) (list (values (string-ref  ___lst 0 ) cond (help) (string-upcase 1001 (make-vector 3 :rest keyword?) when (list))))) (func)) 'error)
+
+(when with-block
+  (let ()
+    (define (fibf n) (if (< n 2.0) n (+ (fibf (- n 1.0)) (fibf (- n 2.0)))))
+    (define (clamp minimum x maximum) (min maximum (max x minimum)))
+    (define (func) (clamp (fibf 8.0) 0 (tree-count 0 (vector-dimensions (block)))))
+    (define (hi) (func))
+    (test (hi) 1))
+  (test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (for-each (lambda s s) (object->let (block)))))) (define (hi) (func)) (hi)) #<unspecified>))
+
+(test (let ((x #f)) (define (func) (call-with-exit (lambda (x) (char-ci>? (call-with-output-string x))))) (define (hi) (func)) (hi)) 'error)
+(test (let ((x #f)) (define (func) (call-with-exit (lambda (x) (char-ci>? (with-output-to-string x))))) (define (hi) (func)) (hi)) 'error)
+(test (let ((x #f)) (define (func) (call-with-exit (lambda (x) (char-ci>? (with-output-to-file "/dev/null" x))))) (define (hi) (func)) (hi)) 'error)
+(unless (or pure-s7 immutable-unquote) (test (let ((x #f)) (define (func) (let () (vector (quasiquote (fill! (with-baffle (unquote))))))) (define (hi) (func)) (hi)) 'error))
+(test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (indexable?)))) (define (hi) (func)) (hi)) 'error)
+
+(test (let () (let-temporarily () (define x 2)) (+ x 1)) 3)
+(test (let ((y 1)) (let-temporarily ((y 3)) (define x y)) (+ x y)) 4)
+
+(test (let ((x -1)) (define (func) (with-let (inlet 'a 1) (+ x 1))) (define (hi) (func)) (hi)) 'error)
+(test (let ((x -1)) (define (func) (with-let (inlet 'a 1) (+ 2 x 1))) (define (hi) (func)) (hi)) 'error)
+(test (let ((x -1)) (define (func) (with-let (inlet 'a 1) (+ 3 2 x 1))) (define (hi) (func)) (hi)) 'error)
+(test (let ((x -1)) (define (func) (with-let (inlet 'a 1) (abs x))) (define (hi) (func)) (hi)) 'error)
+(test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (with-let (inlet 'a 1) (setter x))))) (define (hi) (func)) (hi)) 'error)
+(test (let ((x -1)) (define (func) (with-let (inlet 'a 1) (with-let (inlet 'b 1) (+ b 1)) (+ x 1))) (define (hi) (func)) (hi)) 'error)
+(test (let ((x -1)) (define (func) (with-let (inlet 'a 1) (let ((x 1)) (+ x 1)))) (define (hi) (func)) (hi)) 2)
+(test (let ((x -1)) (define (func) (with-let (inlet 'a 1) (let ((x 1)) (with-let (inlet 'b 1) (+ b 1)) (+ x 1)))) (define (hi) (func)) (hi)) 2)
+(test (let ((x -1)) (define (func) (with-let (inlet 'a 1) (let ((x 1)) (with-let (inlet 'b 1) (+ b 1)))) (+ x 1)) (define (hi) (func)) (hi)) 0)
+(test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (atanh (with-let (inlet 'integer? (lambda (f) #f)) (+ x 1)))))) (define (hi) (func)) (hi)) 'error)
+(test (let () (define (func) (call-with-exit (lambda (_x_) 1 . 2))) (define (hi) (func)) (hi)) 'error)
+(test (let () (define (func) (list (quote 1 abs) (quote 1))) (define (hi) (func)) (hi)) 'error)
+
+(test (with-let (inlet) (let () (signature abs) . if)) 'error)
+(test (with-let (inlet) (let* () (signature abs) . if)) 'error)
+(test (with-let (inlet) (letrec () (signature abs) . if)) 'error)
+(test (let-temporarily ((__var__ 1)) (signature abs) . if) 'error)
+(test (with-let (inlet 'i 0) 1 cons . 2) 'error)
+;;; opt3 as lambda arglen
+(test (dynamic-wind (lambda () (open-input-string (format #f "~W" (car (list (the (lambda args args) #i(1)) (or)))))) (lambda () #f) (lambda () #f)) 'error)
+(test (call-with-exit (lambda (goto) (goto (with-input-from-string (lambda (a) (values a (+ a 1))) 2) (cadar (unless))))) 'error)
+
+(test (let () (define (f) (let ((_x_ (+ _x_ 1.0))) 1)) (f)) 'error)
+(test (let () (define (f) (define _x_ (let-ref (cdr _x_) 'a))) (f)) 'error)
+(test (let () (define (f) (define _x_ (define _x_ 1))) (f)) 1)
+(test (let () (define (f y) (define _x_ (* y (cos _x_))) 1) (f 1)) 'error)
+(test (let () (define (f y) (define _x_ (* _x_ y)) 1) (f 1)) 'error)
+(test (let () (define (f) (define _x_ (+ _x_ 123)) 1) (f)) 'error)
+(test (let () (define (f) (define _x_ (+ _x_ 1)) 1) (f)) 'error)
+(test (let () (define (f) (define _x_ (+ 1 _x_)) 1) (f)) 'error)
+(test (let () (define (f) (define _x_ (* .1 _x_)) 1) (f)) 'error)
+(test (let () (define (f) (define _x_ (+ .1 _x_)) 1) (f)) 'error)
+(test (let () (define (f) (define _x_ (+ _x_ .1)) 1) (f)) 'error)
+
+(test (let () (define (func) (clamp 1 (values 1 2 3 4 5 6) 2)) (func)) 'error)
+(test (let () (define (func) (clamp 1 (values 1 2) 2)) (func)) 'error)
+(test (let () (define (clf a b c d e f g) (+ a b c d e f g)) (define (func) (clf 1 (values 1 2) 2)) (func)) 'error)
+(test (let () (define (clf a b c d e f g) (+ a b c d e f g)) (define (func) (clf 1 (values 1 2 3 4) 2)) (func)) 'error)
+(test (let () (define (clf a b c d e f g) (+ a b c d e f g)) (define (func) (clf 1 (values 1 2 3 4 5) 2)) (func)) 18)
+
+(test (let () (define (f) (let-ref (cdr cond) 291.071044921875)) (f) (f)) 'error)
+(test (let () (define (f) (let-ref (cdr cond) :asdf)) (f) (f)) 'error)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (set!))) (define (hi) (func)) (hi)) 'error)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (list 1) (byte-vector 0 1 2))))) (define (hi) (func)) (hi)) #t)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (c-pointer 1234) #i(1))))) (define (hi) (func)) (hi)) #t)
+(test (let () (define (func) (let ((x #f)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (let _let_ #x123.123))))) (define (hi) (func)) (hi)) 'error)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (immutable! (float-vector 0 1 2)) #_cons)))) (define (hi) (func)) (hi)) #t)
+(test (let () (define (func) (let ((x #f)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (let-temporarily ((x 1234)) (+ x 1)) _undef_))))) (define (hi) (func)) (hi)) #t)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (list 1 2) and)))) (define (hi) (func)) (hi)) #t)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (string #\c #\b) '((1 (2)) (((3) 4))))))) (define (hi) (func)) (hi)) #t)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if 1 (* 2 x 3.0 4))))) (define (hi) (func)) (hi)) 'error)
+(test (let () (define (func) (let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (let _let_ #x123.123))))) (define (hi) (func)) (hi)) 'error)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (hash-table-set! (immutable! (hash-table 'a 1)) 'x 3)))) (define (hi) (func)) (hi)) 'error)
+(test (let () (define (func) (let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (cond (set! __var__ . #x123)))))) (define (hi) (func)) (hi)) 'error)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (not :readable #i()) (vector))))) (define (hi) (func)) (hi)) 'error)
+(test (let () (define (func) (let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (truncate (min +nan.0 123)))))) (define (hi) (func)) (hi)) 'error)
+(test (eval-string "(let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (cond-expand (x => y) (values 1 2) #\\newline `(+ ,a ,b)))))") 'error)
+(test (let ((s (list (list 1 2)))) (define (func) (eq? (caar s) `(1))) (define (hi) (func)) (hi)) #f)
+(test (let () (define (func) (list + (assoc (setter car) '((111 . 2222) (3 . 4))))) (func)) (list + #f)) ; op_c_s_op_opsq_cq
+(when with-block
+  (test (let ()
+	  (define (f)
+	    (do ((i 0 (+ i 1))) ((= i 1))
+	      (if (= (immutable! (block 0.0 1.0 2.0))
+		     (make-iterator #(10 20)))
+		  (integer? (setter kar)))))
+	  (f))
+	'error)) ; opt2 fx overwrite complaint
+(test (let () (define (func) (do ((x 0.0 (+ x 0.1)) (i 0 (+ i 1))) ((>= x .1)
+		(with-baffle (byte-vector #\backspace (+ x 1) 1 "STR1" (list ())))))) (define (hi) (func)) (hi))
+      'error)
+
+(let ()
+  (define (_d5_ . args)
+    (let ((__var__ #f))
+      (let doer ((_i_ 0))
+        (if (= _i_ 1)
+	    __var__
+	    (begin
+	      (set! __var__ (values (define b1 2)))
+	      (doer (+ _i_ 1)))))))
+  (test (_d5_ 1) 2))
+
+(test (multiple-value-bind lambda #f (call-with-exit (lambda (return) (return 1)))) 'error)
+(unless (or pure-s7 immutable-unquote)
+  (test (let ((x #f) (i 0)) (if (not x) (begin (quasiquote (type-of `((x)) "" #r2d((.1 .2) (.3 .4)) unquote))))) 'error)
+  (test (let () (define (func) (let ((x #f) (i 0)) (let () (values (zero? (quasiquote (unquote . #x123.123))))))) (define (hi) (func)) (hi)) 'error))
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (fill! (immutable! (list 0 1 2)) (call/cc (lambda (return) (return 1 2)))))) (define (hi) (func)) (hi)) 'error)
+(test (let () (define (func) (member 1 '(2 3) (lambda (a b) (do ((i 0 (+ i 1))) ((= i 1) 1) (/ (random 1)))))) (define (hi) (func)) (hi)) 'error)
+(define-expansion (_do1_ . args)
+  `(with-output-to-string
+     (lambda ()
+       (do ((i 0 (+ i 1)))
+	   ((= i 1))
+	 ,@(map (lambda (x)
+		  `(display ,x))
+		args)))))
+(test (let () (define (func) (let ((x #f) (i 0)) (let () (_do1_ (make-vector (do ())) (make-byte-vector (hash-table-ref)))))) (define (hi) (func)) (hi)) 'error)
+(test (string? (_do1_ (map cons (let ((<1> #f) (<2> (vector #f))) (set! <1> (make-iterator <2>)) (set! (<2> 0) <1>) <1>) "aa"))) #t)
+(test (_do1_ (for-each cons (let ((<1> #f) (<2> (vector #f))) (set! <1> (make-iterator <2>)) (set! (<2> 0) <1>) <1>) "aa")) "#<unspecified>")
+;;; ^ these are regression tests for an over-eager free_cell use
+
+(let ()
+  (let ((x 1)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (clamp 0 x 10)))) (define (hi) (func)) (hi))
+  (test (let ((x 1)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) 1) (clamp 0 (make-iterator (list 1)) 0))) (define (hi) (func)) (hi)) 'error))
+
+(when with-block
+  (test (let () (define (func x) (syntax? (values -1 (copy (block) (vector))))) (define (hi) (func #f)) (display (hi)) (newline)) 'error))
+
+(test (dynamic-wind (lambda () (int-vector (cons x x) (call/cc (call-with-exit (lambda (goto) goto))))) (lambda () #f) (lambda () #f)) 'error)
+
+(when (defined? 's7-optimize)
+  (test (s7-optimize '((cdadr (cddddr (symbol->string (min '((x 1 . 2) . 3) #<undefined> '((x 1) . 2))))))) #<undefined>) ; #<undefined> is s7-optimize's error value
+  (test (s7-optimize '((set! (cyclic-sequences . 0+0/0i) #f))) #<undefined>)
+  (test (s7-optimize (list (catch #t (lambda () (with-input-from-string "(if (not) (cadddr (rational?)))" read)) (lambda args args)))) #<undefined>)
+  (test ((s7-optimize '((inlet 'if 3))) 'if) 'error)
+  )
+
+;;; null sc->args in unbound_variable:
+(test (let () (define (func) (inexact->exact (letrec ((x 1234) (y 1/2)) +documentation+ (list)))) (define (hi) (func) (func)) (hi) (hi)) 'error)
+(test (let () (define (func) (char-alphabetic? (letrec ((x 1234) (y 1/2)) (_definee_ x) 0+i (exact->inexact)))) (define (hi) (func) (func)) (hi) (hi)) 'error)
+
+;;; same as above but change location of test
+(let () (define (func x) (object->string (list  (funclet  /)))) (define (hi) (func abs)) (test (hi) "((rootlet))"))
+(let () (define (func x) (cdadar (not (eq? / '())))) (define (hi) (func '((())))) (test (hi) 'error))
+(let () (define (func x) (append (inlet 'integer? (lambda (f) #f)) (hash-table `((+ x 1)) '(((x 1) 2) 3)))) (define (hi) (func 1)) (test (hi) 'error))
+(let () (define (func x) (float-vector? (<= / (let-ref 1+0/0i 0)))) (define (hi) (func 0/0+i)) (test (hi) 'error))
+(let () (set! else #(0 0)) (define (func x) (car (boolean? (char=? (else ()) (= i 2))))) (define (hi) (func '(()))) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (logior // (+)))) (define (hi) (func 0+1/0i)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (int-vector-ref /(asinh (logand))))) (define (hi) (func 0+1/0i)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (logxor /(lognot (gcd))))) (define (hi) (func (list (list 1 2)))) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (int-vector-set! / 1 2))) (define (hi) (func 1.5)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (quote . /))) (define (hi) (func (integer->char 255))) (test (hi) 'error))
+(let () (define (func x) (cond ((if if . :readable) #f))) (define (hi) (func begin)) (test (hi) 'error))
+(let () (define (func x) (if (not . /) x)) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (set! (with-let / begin `(+ ,a ,b ,@c) #<undefined>) #f)) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (let () (define _x_ (lambda* . let*)))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (set! (with-let . ()) #f)) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (call/cc (lambda (_x_) (acosh (unlet))))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (member :rest (cons 1 2) /))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (char-numeric?  (make-vector 3)  1.5  `((+ x 1))  ))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (procedure? //))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (iterator-at-end? /))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (hash-table-ref /(flush-output-port  )))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (let () (set! ((dilambda / (let ((x 3)) (lambda (y) (+ x y)))  )) 3))) (define (hi) (func #f)) (test (hi) 6))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (unlet /(immutable?  )))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (catch #f (vector-ref #(1 2) 0 1.0+1.0i) (vector-ref #(1 2) 0 1.0+1.0i))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (cond (lambda (if x y) 0 1.0+1.0i (string>=? / `((+ x 1)) x y z (integer->char 255))) (else #f))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (format  `((x))  (list 1)  cons  else  (read  (string-append  /))))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (<= -1 (round /)))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (byte-vector-ref (make-string 3) 0))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (char-ci<? (null? i) (quote . let)))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (int-vector-ref #i2d((1 2) (3 4)) 0))) (define (hi) (func #f)) (test (hi) #t))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (denominator (sqrt (hash-table-ref (if x y) 0+0/0i))))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (and  `((x)) (string (integer->char 255))))) (define (hi) (func #f)) (test (hi) #t))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (string>? (null? i) (object->let /)) (string>? (null? i) (object->let /)))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) / (letrec . #t))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) :readable `((x . 1)) (provide (quote /)))) (define (hi) (func #f)) (test (hi) 1))
+(let () (define (func x) (iterator-sequence (string-ci<=? (do ((i 0 (+ i 1))) ((= i 1) i) (when (+ i 1) `(+ x 1) (list 1) (- i 1)))))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (continuation? (do ((i 0 (+ i 1))) ((= i 1) i)  (unless   (+ i 1)  quasiquote  )))) (define (hi) (func #f)) (test (hi) #f))
+(let () (define (func x) (error `(x 1) (null? i) (list 1 2) (lambda . /))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) / (case / (if x y) #2d((1 2) (3 4)) (x => y)))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (char>=? (inlet 'a 1) (hook-functions (output-port?))) (vector? (letrec))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (letrec // . letrec)) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (for-each quasiquote (object->let /))) (define (hi) (func #f)) (test (hi) #<unspecified>))
+(let () (define (func x) (provided? (eval-string  (do ((i 0 (+ i 1))) ((= i 1) i) (case))))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (cond (denominator 1 . 2))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (when denominator 1 . 2)) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (case 0 ((0) 1 . 2))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (case denominator ((0) 1) (else 1 . 2))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (cond (denominator . 2))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (when denominator . 2)) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (case 0 ((0) . 2))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (case denominator ((0) 1) (else . 2))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (string? (object->string (hash-table (list-values (object->let /)))))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (sort! / (lambda (zero? i) (zero? i)))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (string>? (string) (read-line)))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 3)) (let-set! cons '() macroexpand))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (call-with-values  quasiquote  macroexpand  )) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (modulo (expt 2 32) (make-iterator (list 1 2 3))))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (< (read-char (cond (boolean? lambda* (lambda (a) (values a (+ a 1))) `(+ ,a ,b) 0+0/0i))))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (exact->inexact (cond (continuation? lambda (lambda (a) (values a (+ a 1))) (values "ho") `(x) `(+ ,a ,b))))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) 0 (cond (quote (define _definee_ 0))))) (define (hi) (func #f)) (test (hi) 1))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) 0 (cond '(define _definee_ 0)))) (define (hi) (func #f)) (test (hi) 1))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (let* ()))) (define (hi) (func #f)) (test (hi) 'error)) ; not 0!
+(let () (define (func x) (input-port? (c-pointer (values 1 2) begin))) (define (hi) (func #f)) (test (hi) #f))
+(let () (define (func x) (member letrec '#())) (define (hi) (func #f)) (test (hi) 'error)) ; not #f
+(let () (define (func abs) (abs 1)) (define (hi) (func '(1 2 3))) (test (hi) 2))
+(let () (define (hi) ((lambda (abs) (abs 1)) '(1 2 3))) (test (hi) 2))
+(let () (define (func x) ((lambda (values) (values "ho")) '((x 1) 2))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (multiple-value-bind (values) '((x 1) 2) (values "ho"))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (multiple-value-bind (list) macroexpand '((1 2) (3 4)) (length (list)))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (multiple-value-bind (hash-table) (integer->char 255) (pair? (hash-table? (let* () 0+1/0i (hash-table)))))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (multiple-value-bind (list) -1 `((1) . x) #() (make-iterator (list 1 2 3)) (random-state 1234) 1234)) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (char-numeric? most-negative-fixnum))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (char-alphabetic? (list)))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (char-whitespace? (make-hash-table)))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (vector->list (values 1 2) #(1 2))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (truncate (/ (values 1 2) 0))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (fill! (values 1 2) `(+ x 1))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (not (zero? :readable))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (exact->inexact 1.0+123.0i))) (define (hi) (func #f)) (test (hi) 1))
+(let () (define (func x) (inlet 'if 3)) (define (hi) (func #f)) (test (hi) (inlet 'if 3)))
+(test (inlet 'if 3) (inlet 'if 3))
+(test (apply (lambda (g) (inlet :if 32)) (list 2)) (inlet 'if 32))
+(test (apply (lambda (g) (inlet ':if 32)) (list 2)) (inlet 'if 32))
+(test (inlet  :if `((x))) (inlet 'if '((x))))
+(let () (define (func x) (vector (setter car) (quote (null? i) #r2d((.1 .2) (.3 .4))))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (c-pointer? begin (member let-temporarily (values 1 2)))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func x) (integer? (assoc (values) '((x 1) (y) . 2) cons))) (define (hi) (func #f)) (test (hi) #f))
+(let () (define-macro (_mac_ x) `(+ ,x 1)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) 1) (_mac_ +inf.0 . #x123.123))) (define (hi) (func #f)) (test (hi) 'error)) 'error)
+(let () (define (func x) (reverse! (write-string (symbol->string :allow-other-keys) #f))) (define (hi) (func #f)) (test (hi) "syek-rehto-wolla:"))
+(let () (define (func x) (with-let (openlet (inlet 'abs (lambda (x) (- x)))) '(- 1) (abs 1+1i))) (define (hi) (func #f)) (test (hi) -1-i))
+(let ((x #f)) (define (func) (member "c" '(x) (lambda (a b) (call/cc (lambda (return) (return #f)))))) (define (hi) (func)) (test (hi) #f))
+(let ((x #f)) (define (func) (assoc "c" '((x . 1)) (lambda (a b) (call/cc (lambda (return) (return #t)))))) (define (hi) (func)) (test (hi) '(x . 1)))
+(let ((imp '(0 1))) (define (func) (list (hash-table-ref imp imp) #u(0 1) #r())) (define (hi) (func)) (test (hi) 'error))
+(let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (let-temporarily ((i 0 (+ i 1))) #i(1) 1)))) (define (hi) (func)) (test (hi) 'error))
+(when with-block
+  (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (for-each (lambda s s) (object->let (block)))))) (define (hi) (func)) (test (hi) #<unspecified>)))
+(let ((x #f)) (define (func) (call-with-exit (lambda (x) (char-ci>? (call-with-output-string x))))) (define (hi) (func)) (test (hi) 'error))
+(let ((x #f)) (define (func) (call-with-exit (lambda (x) (char-ci>? (with-output-to-string x))))) (define (hi) (func)) (test (hi) 'error))
+(let ((x #f)) (define (func) (call-with-exit (lambda (x) (char-ci>? (with-output-to-file "/dev/null" x))))) (define (hi) (func)) (test (hi) 'error))
+(let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (indexable?)))) (define (hi) (func)) (test (hi) 'error))
+(let ((x -1)) (define (func) (with-let (inlet 'a 1) (+ x 1))) (define (hi) (func)) (test (hi) 'error))
+(let ((x -1)) (define (func) (with-let (inlet 'a 1) (+ 2 x 1))) (define (hi) (func)) (test (hi) 'error))
+(let ((x -1)) (define (func) (with-let (inlet 'a 1) (+ 3 2 x 1))) (define (hi) (func)) (test (hi) 'error))
+(let ((x -1)) (define (func) (with-let (inlet 'a 1) (abs x))) (define (hi) (func)) (test (hi) 'error))
+(let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (with-let (inlet 'a 1) (setter x))))) (define (hi) (func)) (test (hi) 'error))
+(let ((x -1)) (define (func) (with-let (inlet 'a 1) (with-let (inlet 'b 1) (+ b 1)) (+ x 1))) (define (hi) (func)) (test (hi) 'error))
+(let ((x -1)) (define (func) (with-let (inlet 'a 1) (let ((x 1)) (+ x 1)))) (define (hi) (func)) (test (hi) 2))
+(let ((x -1)) (define (func) (with-let (inlet 'a 1) (let ((x 1)) (with-let (inlet 'b 1) (+ b 1)) (+ x 1)))) (define (hi) (func)) (test (hi) 2))
+(let ((x -1)) (define (func) (with-let (inlet 'a 1) (let ((x 1)) (with-let (inlet 'b 1) (+ b 1)))) (+ x 1)) (define (hi) (func)) (test (hi) 0))
+(let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (atanh (with-let (inlet 'integer? (lambda (f) #f)) (+ x 1)))))) (define (hi) (func)) (test (hi) 'error))
+(let () (define (func) (call-with-exit (lambda (_x_) 1 . 2))) (define (hi) (func)) (test (hi) 'error))
+(let () (define (func) (list (quote 1 abs) (quote 1))) (define (hi) (func)) (test (hi) 'error))
+(let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (set!))) (define (hi) (func)) (test (hi) 'error))
+(let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (list 1) (byte-vector 0 1 2))))) (define (hi) (func)) (test (hi) #t))
+(let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (c-pointer 1234) #i(1))))) (define (hi) (func)) (test (hi) #t))
+(let () (define (func) (let ((x #f)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (let _let_ #x123.123))))) (define (hi) (func)) (test (hi) 'error))
+(let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (immutable! (float-vector 0 1 2)) #_cons)))) (define (hi) (func)) (test (hi) #t))
+(let () (define (func) (let ((x #f)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (let-temporarily ((x 1234)) (+ x 1)) _undef_))))) (define (hi) (func)) (test (hi) #t))
+(let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (list 1 2) and)))) (define (hi) (func)) (test (hi) #t))
+(let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (string #\c #\b) '((1 (2)) (((3) 4))))))) (define (hi) (func)) (test (hi) #t))
+(let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if 1 (* 2 x 3.0 4))))) (define (hi) (func)) (test (hi) 'error))
+(let () (define (func) (let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (let _let_ #x123.123))))) (define (hi) (func)) (test (hi) 'error))
+(let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (hash-table-set! (immutable! (hash-table 'a 1)) 'x 3)))) (define (hi) (func)) (test (hi) 'error))
+(let () (define (func) (let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (cond (set! __var__ . #x123)))))) (define (hi) (func)) (test (hi) 'error))
+(let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (not :readable #i()) (vector))))) (define (hi) (func)) (test (hi) 'error))
+(let () (define (func) (let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (truncate (min +nan.0 123)))))) (define (hi) (func)) (test (hi) 'error))
+(unless with-bignums
+  (test (let () (define (func) (let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 1)) (let ((j 0)) (truncate (exp #x123.123)))))) (define (hi) (func)) (hi)) 'error)
+  (let () (define (func) (let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 1)) (let ((j 0)) (truncate (exp #x123.123)))))) (define (hi) (func)) (test (hi) 'error))
+  (let ((__var__ 1)) ; int matters
+    (test (member 1 (list 3 2) (lambda (a b) (immutable? (set! __var__ pi)))) '(3 2))
+    (test (member 1 (list 3 2) (lambda (a b) (immutable? (set! __var__ pi)))) '(3 2)))) ; will fail if immutable not passed through by opt_set_p_d(p)_f(s)
+(test (let ((a 3) (b 2)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (+ (logand (ash 1 b) a) (random 1) 123 123)))) (define (hi) (func)) (hi)) #t)
+(test (let ((a 3) (b 2)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (+ 123 (logand (ash 1 b) a) (random 1) 123)))) (define (hi) (func)) (hi)) #t)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (+ (floor a) (random 1) 1 1)))) (define (hi) (func)) (hi)) #t)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (+ (floor a) (round pi) 1 1 1)))) (define (hi) (func)) (hi)) #t)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (+ (round pi) 1 1 1 1)))) (define (hi) (func)) (hi)) #t)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (+ (round pi) (round pi) (round pi) 1)))) (define (hi) (func)) (hi)) #t)
+(test (let ((x 1.0)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (+ 1.0 x x x)))) (define (hi) (func)) (hi)) #t)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (+ (round pi) 1 (round pi) (round pi))))) (define (hi) (func)) (hi)) #t)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (+ (round pi) (round pi) (round pi) (round pi))))) (define (hi) (func)) (hi)) #t)
+(test (let () (define (func) (_do1_ (char-position #\delete ims -123))) (define (hi) (func)) (hi)) 'error)
+
+(let () ; from Kjetil Matheussen, op_closure*_fx can occur if 0 args, but it goes to op_unknown_fx which needs to check for that case
+  (define* (func1 (a1 -1)) ((lambda () 50)))
+  (define (func2) (set! *last-func* func2))
+  (define *last-func* func1)
+  ((lambda () (func2) (*last-func*))))
+
+(let ()
+  (define (f1 in)
+    (let loop ()
+      (let ((c (read-char in)))
+        (cond ((eof-object? c) 'done)
+              ((char=? c #\newline) 'done)
+              (else (loop))))))
+  (test (call-with-input-string "01234" f1) 'done)
+
+  (define (f2)
+    (let ((c (read-char)))
+      (cond ((eof-object? c) 'done)
+            ((char=? c #\newline) 'done)
+            (else (f2)))))
+  (test (with-input-from-string "01234" f2) 'done))
+
+(when with-block
+  (test (let () (define (func) (do () ((not false) (tree-memq (values #\c 3 1.2) (vector-dimensions (block)))))) (define (hi) (func)) (hi)) 'error)
+  (test (let ()
+	  (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (tree-count ((lambda (a) (values a (+ a 1))) 2) (vector-dimensions (block))))))
+	  (define (hi) (func)) (hi)) 'error)
+  (test (let () (define (func) (append (values "" (block)) (list :go))) (define (hi) (func)) (hi)) 'error) ; plist clobbered
+  (test (let ((b (block 1 2 3))) (define (func) (call-with-exit (lambda (x) (x (unspecified? (c-pointer-weak1 b)))))) (func)) 'error))
+
+(test (let () (define (func x i) (float-vector-set! x i (catch #t (lambda () (float-vector-ref x i)) (lambda args 'error)))) (define (hi) (func #r(1 2 3) 3)) (hi)) 'error)
+(test (let () (define (func) (undefined? (list-ref (list #f (make-iterator (list #f))) 1 ()))) (define (hi) (func)) (hi)) 'error) ; safe_c_opaaaq sc->code != code bug
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (if (eq? #<unspecified> (values)) (outlet "")))) (define (hi) (func)) (hi)) 'error) ; s7_is_eq b_pp_f
+(test (let ((__var__ -1.0)) (define (func) (do ((_i_ 0 (+ _i_ 1))) ((= _i_ 1) __var__) (set! __var__ -123))) (define (hi) (func) (func)) (hi) (hi)) -123)
+
+(test (let ((vvv (let ((v (make-vector '(2 2)))) (set! (v 0 0) "asd") (set! (v 0 1) #r(4 5 6)) (set! (v 1 0) '(1 2 3)) (set! (v 1 1) 32) v)))
+	(define (f) (do ((i 0 (+ i 1))) ((= i 1)) (vector-set! vvv (abs x) `(x 1) '(15 26 . 36))))
+	(f))
+      'error)
+(test (let () (define (func) (_do4_ (float-vector-ref #r2d((.1 .2) (.3 .4)) __var2__))) (define (hi) (func) (func)) (hi) (hi)) 'error)
+
+(test (let () (define (f) (c-pointer pi pi (values 1 2))) (f)) 'error)
+(num-test (let () (define (f) (+ pi pi (values 1 2))) (f)) (+ 3 (* 2 pi)))
+(when with-block ; block copy is technically unsafe
+  (test (let () (define (f) (let-ref (char-ci>? (copy (block) #u()) (string #\c #\null #\b) (make-vector 3 'a symbol?)))) (f)) 'error))
+
+(let ()
+  (define (f1) (>= +signature+ pi pi 0))
+  (define (f2) (float-vector-ref let-temporarily +signature+ pi #\e))
+  (define (f3) (* when case => #r2d((0.1 0.2) (0.3 0.4))))
+  (test (f1)'error)
+  (test (f2)'error)
+  (test (f3)'error))
+
+(test (c-pointer-weak1 "asdf") 'error)
+(test (char>? #\a #f) 'error)
+(test (int-vector-set! '(a) 1 0) 'error)
+(test (vector-length 0) 'error)
+(test (= 1 ()) 'error)
+(test (string=? "asdf" 1) 'error)
+(test (hash-table-entries ()) 'error)
+(test (append #(0) pi) 'error)
+(test (> 0 '(1)) 'error)
+(test (string>? "asdf" '(1)) 'error)
+(test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (hash-table-entries x))) (f ())) 'error)
+(test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (numerator x))) (f "asdf")) 'error)
+(test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (denominator x))) (f "asdf")) 'error)
+(test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (c-pointer-weak1 x))) (f "asdf")) 'error)
+(test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (c-pointer-weak2 x))) (f "asdf")) 'error)
+(test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (car x))) (f (hash-table))) 'error)
+(test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (number->string x))) (f #f)) 'error)
+(test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (number->string 12 x))) (f 10000)) 'error)
+(test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (string->number x))) (f 123)) 'error)
+(test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (symbol->string x))) (f ())) 'error)
+(test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (iterate x))) (f ())) 'error)
+(test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (round x))) (f ())) 'error)
+(test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (cdr x))) (f :a)) 'error)
+(test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (cadr x))) (f :a)) 'error)
+(test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (cdar x))) (f :a)) 'error)
+(test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (caddr x))) (f :a)) 'error)
+(test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (/ 1 x))) (f 0)) 'error)
+(test (char=? #\a ()) 'error)
+(test (let () (define (f a b) (member a b)) (f 0 123.0)) 'error)
+(test (byte-vector-ref (random 1) (expt 2 32) '(+ x 1)) 'error)
+(test (memq 0 2) 'error)
+(test (let () (define (f x) (int-vector-ref x 0)) (f (c-pointer 1))) 'error)
+(test (let () (define (f x) (float-vector-ref x 0)) (f (c-pointer 1))) 'error)
+(test (let () (define (f x) (int-vector-ref #(0) x)) (f (c-pointer 1))) 'error)
+(test (- 1 #f) 'error)
+(test (port-position (values)) 'error)
+(test (= 1 "asdf") 'error)
+(test (else (list ())) 'error)
+(test (+ 1 (openlet (inlet 'a 1))) 'error)
+(test (byte-vector-ref (openlet (inlet 'a 1)) 0) 'error)
+(test (vector-set! (vector 1) () 1) 'error)
+(test (sort! #(1 2 3) cons) 'error)
+(test (* 3 (make-iterator '(1 2))) 'error)
+(unless with-bignums (test (random-state 123 1+i) 'error))
+(test (apply abs "asdf") 'error)
+
+;;; this is from snd-test, but hits an interesting fx_tree problem
+(let ()
+  (define integrate-envelope
+    (let ((+documentation+ "(integrate-envelope env) -> area under env"))
+      (lambda (env1)
+	(let integrate-envelope-1 ((e env1) (sum 0.0000))
+        (if (or (null? e) (null? (cddr e)))
+            sum
+            (integrate-envelope-1 (cddr e) (+ sum (* (+ (cadr e) (cadddr e)) 0.5 (- (caddr e) (car e))))))))))
+
+  (if (not (equal? (integrate-envelope '(0 0 1 1)) 0.5))
+      (format *stderr* "integrate-envelope: ~A?" (integrate-envelope '(0 0 1 1)))))
+
+(test (let () (define (f a b) (+ (* (- b a) b) a)) (f 2 5)) 17) ; c_op_opssq_sq_s
+(let ((v (make-float-vector '(2 2) 1.0))                        ; fx_c_aa_indirect
+      (temp 0.0))
+  (define (f rl wr wi j)
+    (set! temp (+ (* wr (float-vector-ref rl 1 j)) (* wi (float-vector-ref rl 0 j)))))
+  (f v 1.0 2.0 1)
+  (num-test (f v 1.0 2.0 1) 3.0))
+
+(let () ; fx_s0_cdr
+  (define (lookup key table) ; i.e. assq!
+    (let loop ((x table))
+      (if (null? x)          ; (and (pair? x) ...
+	  #f
+	  (let ((pair (car x)))
+	    (if (eq? (car pair) key)
+		pair
+		(loop (cdr x)))))))
+
+  (test (lookup 'a '((b 1) (a 2))) '(a 2)))
+
+(let () ; (copy func) after func use -- clearing all opts is a problem, here OP_IF -> OP_IF_IS_TYPE needs to be reset
+  (define h->a
+    (let ((+documentation+ "(h->a table) returns the contents of table as an association list:\n\
+                              (h->a (hash-table 'a 1)) -> '((a . 1))"))
+      (lambda (table)
+	(if (hash-table? table)
+	    (map values table)
+	    (error 'wrong-type-arg "h->a argument, ~A, is not a hash-table" table)))))
+  (define (func)
+    (h->a (hash-table 'a 1)))
+  (func)
+  (define (func1)
+    (call-with-output-file "/dev/null" (copy h->a)))
+  (test (func1) 'error))
+
+;;; clumsy test, but will hang in older s7's
+(define global_fi
+  (let ((+documentation+ "docs"))
+    (lambda (par_f lst)
+      (do ((p lst (cdr p)))
+	  ((or (not (pair? p))
+	       (par_f (car p)))
+	   (and (pair? p)
+		(car p)))))))
+
+(define (par_f)
+  (let ((items (list 1 (list 2 3 4))))
+    (global_fi (lambda (x)
+		 (not (or (symbol? x)
+			  (memq x '(#f #t () #<unspecified> #<undefined> #<eof>)))))
+	       (cadr items))))
+(par_f)
+(par_f)
+
+(let () ; from radium, opt2_sym overwrite
+  (define (quantitize-note start end q max-length type)
+    (define new-start (quantitize start q))
+    (define new-end (quantitize end q))
+    (if (>= new-start new-end)
+	(set! new-end (quantitize new-end q))))
+  (define (roundup A)
+    (floor (+ A 0.5)))
+  (define (quantitize Place Q)
+    (* (roundup (/ Place Q))
+       Q))
+  (quantitize-note 7 8 2 4194175/65534 2)
+  (quantitize-note 7 8 2 4194175/65534 2))
+
+;;; check cond=>opt result
+(let ()
+  (define (f) (cond ((= 1 2) => (lambda (s) s))))
+  (test (f) #<unspecified>)
+  (test (f) #<unspecified>))
+
+;;; some clm optimizer stuff
+(let ()
+  (define (fdo1)
+    (let ((sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 10) sum)
+	(do ((j 0 (+ j 1)))
+	    ((= j 3))
+	  (set! sum (+ sum j))))))
+
+  (let ((sum (fdo1)))
+    (if (not (= sum 30))
+	(format *stderr* "fdo1: ~A~%" sum)))
+
+  (define (fdo2)
+    (let ((sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 10) sum)
+	(do ((j 0 (+ j 1)))
+	    ((= j 3))
+	  (set! sum (+ sum i j))))))
+
+  (let ((sum (fdo2)))
+    (if (not (= sum 165))
+	(format *stderr* "fdo2: ~A~%" sum)))
+
+  (define (fdo3)
+    (let ((sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 10) sum)
+	(do ((j 0 (+ j 1)))
+	    ((= j 3))
+	  (do ((k 0 (+ k 1)))
+	      ((= k 2))
+	    (set! sum (+ sum 1)))))))
+
+  (let ((sum (fdo3)))
+    (if (not (= sum 60))
+	(format *stderr* "fdo3: ~A~%" sum)))
+
+  (define (fdo4)
+    (do ((i 0 (+ i 1)))
+	((= i 10) i)
+      (do ((j 0 (+ j 1)))
+	  ((= j 3)))))
+
+  (let ((sum (fdo4)))
+    (if (not (= sum 10))
+	(format *stderr* "fdo4: ~A~%" sum)))
+
+  (define (fdo5)
+    (let ((sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 10) sum)
+	(do ((j 0 (+ j 1)))
+	    ((= j 3))
+	  (set! sum (+ sum j))
+	  (set! sum (+ sum i))))))
+
+  (let ((sum (fdo5)))
+    (if (not (= sum 165))
+	(format *stderr* "fdo5: ~A~%" sum)))
+
+  (define (fdo6)
+    (let ((sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3))
+	(if (zero? sum)
+	    (do ((j 0 (+ j 1)))
+		((= j 3))
+	      (set! sum (+ sum j)))))
+      sum))
+
+  (let ((sum (fdo6)))
+    (if (not (= sum 3))
+	(format *stderr* "fdo6: ~A~%" sum)))
+
+  (define (f1)
+    (let ((x 0))
+      (do ((i 0 (+ i 1/2)))
+	  ((= i 3) x)
+	(set! x (+ x i)))))
+  (f1)
+
+  (define (fdo7)
+    (let ((sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) sum)
+	(if (zero? sum)
+	    (do ((j 0 (+ j 1)))
+		((= j 3))
+	      (set! sum (+ sum j)))))))
+
+  (let ((sum (fdo7)))
+    (if (not (= sum 3))
+	(format *stderr* "fdo7: ~A~%" sum)))
+
+  (define (fdo8)
+    (let ((sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) (set! sum (+ sum 1)) (* sum 2))
+	(if (zero? sum)
+	    (do ((j 0 (+ j 1)))
+		((= j 3))
+	      (set! sum (+ sum j)))))))
+
+  (let ((sum (fdo8)))
+    (if (not (= sum 8))
+	(format *stderr* "fdo8: ~A~%" sum)))
+
+  (define (fdo9)
+    (let ((sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) sum)
+	(do ()
+	    ((> (* sum 3) i))
+	  (set! sum (+ sum 1))))))
+
+  (let ((sum (fdo9)))
+    (if (not (= sum 1))
+	(format *stderr* "fdo9: ~A~%" sum)))
+
+  (define (fdo10)
+    (let ((sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) sum)
+	(do ((k 1))
+	    ((> sum 3))
+	  (set! sum (+ sum k))))))
+
+  (let ((sum (fdo10)))
+    (if (not (= sum 4))
+	(format *stderr* "fdo10: ~A~%" sum)))
+
+  (define (fdo11)
+    (let ((sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) sum)
+	(do ((k 1 (+ k 1))
+	     (j 2 (+ j 2)))
+	    ((> k 3))
+	  (set! sum (+ sum k j))))))
+
+  (let ((sum (fdo11)))
+    (if (not (= sum 54))
+	(format *stderr* "fdo11: ~A~%" sum)))
+
+  (define (fdo12)
+    (let ((sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) sum)
+	(do ((k 1 (+ k 1))
+	     (j 2 (+ j k)))
+	    ((> k 3))
+	  (set! sum (+ sum k j))))))
+
+  (let ((sum (fdo12)))
+    (if (not (= sum 48))
+	(format *stderr* "fdo12: ~A~%" sum)))
+
+  (define size 100)
+
+  (define (ft1)
+    (let ((sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 10) sum)
+	(do ((k 0 (+ k 1)))
+	    ((= k size))
+	  (set! sum (+ sum 1))))))
+
+  (let ((sum (ft1)))
+    (if (not (= sum (* size 10)))
+	(format *stderr* "ft1: ~A~%" sum)))
+
+  (define (fcond1)
+    (let ((res 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 1))
+	(cond ((zero? i) (set! res (+ i 21)))
+	      (else (set! res -1))))
+      res))
+
+  (let ((res (fcond1)))
+    (if (not (= res 21))
+	(format *stderr* "fcond1: ~A~%" res)))
+
+  (define (fcond2)
+    (let ((res 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 1))
+	(cond ((negative? i) (set! res (+ i 21)))
+	      (else (set! res -1))))
+      res))
+
+  (let ((res (fcond2)))
+    (if (not (= res -1))
+	(format *stderr* "fcond2: ~A~%" res)))
+
+  (define (fcond3)
+    (let ((res 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i 1))
+	(cond ((negative? i) (set! res (+ i 21)))
+	      ((> i 4) (set! res 100))))
+      res))
+
+  (let ((res (fcond3)))
+    (if (not (zero? res))
+	(format *stderr* "fcond3: ~A~%" res)))
+  )
+
+
+;;; --------------------------------------------------------------------------------
+;;; libm
+
+(unless (provided? 'windows)
+  (let ()
+    (require libm.scm)
+    (when (and (defined? '*libm*)
+	       (procedure? (*libm* 'remquo))) ; ignore ancient versions of libm
+      (with-let (sublet *libm*)
+
+	;; __DBL_DENORM_MIN__ comes from gcc
+	;; these tests come from the autotester (I also tried those in glibc 2-17 math/libm-test.inc)
+
+	;; just representative values -- maybe catch more possibilities?
+	(unless (provided? 'solaris)
+	  (num-test __DBL_DENORM_MIN__ 4.9406564584125e-324)
+	  (num-test __DBL_MAX__ 1.7976931348623e+308)
+	  (num-test __DBL_MIN__ 2.2250738585072e-308)
+	  (num-test __DBL_EPSILON__ 2.2204460492503e-16)
+	  (num-test __DBL_MIN_10_EXP__ -307)
+	  (num-test __DBL_MAX_10_EXP__ 308)
+	  (num-test __DBL_DIG__ 15)
+	  (num-test __DBL_MANT_DIG__ 53)
+	  (num-test __DBL_MIN_EXP__ -1021)
+	  (num-test __DBL_MAX_EXP__ 1024)
+	  (reader-cond ((not (provided? 'openbsd)) (num-test __SIZEOF_DOUBLE__ 8)))
+	  (reader-cond ((not (provided? 'openbsd)) (num-test __SIZEOF_LONG_LONG__ 8)))
+	  (num-test __LONG_LONG_MAX__ 9223372036854775807))
+
+	(reader-cond ((provided? 'linux)
+		      (num-test FP_NAN 0)
+		      (num-test FP_INFINITE 1)
+		      (num-test FP_ZERO 2)
+		      (num-test FP_SUBNORMAL 3)
+		      (num-test FP_NORMAL 4))
+		     ((provided? 'freebsd)
+		      (num-test FP_NAN 2)
+		      (num-test FP_INFINITE 1)
+		      (num-test FP_ZERO 16)
+		      (num-test FP_SUBNORMAL 8)
+		      (num-test FP_NORMAL 4))
+		     ((provided? 'osx)
+		      (num-test FP_NAN 1)
+		      (num-test FP_INFINITE 2)
+		      (num-test FP_ZERO 3)
+		      (num-test FP_SUBNORMAL 5)
+		      (num-test FP_NORMAL 4)))
+
+	(num-test M_E (exp 1.0))
+	(num-test M_LOG2E (/ (log 2)))
+	(num-test M_LOG10E (/ (log 10)))
+	(num-test M_LN2 (log 2))
+	(num-test M_LN10 (log 10))
+	(num-test M_PI pi)
+	(num-test M_PI_2 (/ pi 2))
+	(num-test M_PI_4 (/ pi 4))
+	(num-test M_1_PI (/ pi))
+	(num-test M_2_PI (/ 2 pi))
+	(num-test M_2_SQRTPI (/ 2 (sqrt pi)))
+	(num-test M_SQRT2 (sqrt 2))
+	(num-test M_SQRT1_2 (/ (sqrt 2)))
+
+	(num-test (j0 -1) 0.76519768655797)
+	(num-test (j0 0) 1.0)
+	(num-test (j0 1) 0.76519768655797)
+	(num-test (j0 1.5) 0.51182767173592)
+	(num-test (j0 -1234567.5) -0.00056797538542782)
+	(num-test (j0 32.75) 0.11922756341796)
+	(num-test (j0 3) -0.26005195490193)
+	(num-test (j0 +inf.0) 0.0)
+	(test (nan? (j0 +nan.0)) #t)
+        (test (catch #t (lambda () (j0 #\a)) (lambda (t i) (apply format #f i))) "(*libm* 'j0) argument, #\\a, is a character but should be a real")
+
+	(num-test (j1 -42) 0.045993888221887)
+	(num-test (j1 -1) -0.44005058574493)
+	(num-test (j1 0) 0.0)
+	(num-test (j1 3/4) 0.34924360217486)
+	(num-test (j1 -63) 0.057696680293944)
+	(num-test (j1 +inf.0) 0.0)
+	(test (nan? (j1 +nan.0)) #t)
+	(num-test (j1 32.75) 0.074086803054576)
+	(num-test (j1 1.5) 0.5579365079101)
+
+	(test (nan? (erf +nan.0)) #t)
+	(num-test (erf -1) -0.84270079294971)
+	(num-test (erf 0) 0.0)
+	(num-test (erf 1.5) 0.96610514647531)
+	(num-test (erf 3/4) 0.71115563365352)
+	(num-test (erf -63) -1.0)
+	(num-test (erf 3.1415926535898) 0.99999112385363)
+	(num-test (erf +inf.0) 1.0)
+
+	(num-test (erfc +inf.0) 0.0)
+	(test (nan? (erfc +nan.0)) #t)
+	(num-test (erfc 1234567.6) 0.0)
+	(num-test (erfc 1.5) 0.033894853524689)
+	(num-test (erfc -1.5) 1.9661051464753)
+	(num-test (erfc 3.0) 2.2090496998585e-05)
+
+	(num-test (lgamma +inf.0) +inf.0)
+	(test (nan? (lgamma +nan.0)) #t)
+	(num-test (lgamma 1.5) -0.12078223763525)
+	(num-test (lgamma 3/4) 0.2032809514313)
+	(num-test (lgamma 32.75) 80.688603510529)
+	(num-test (lgamma 1.5) -0.12078223763525)
+	(num-test (lgamma -1.5) 0.86004701537648)
+
+	(num-test (fabs -1) 1.0)
+	(num-test (fabs 0) 0.0)
+	(num-test (fabs +inf.0) +inf.0)
+	(test (nan? (fabs +nan.0)) #t)
+	(num-test (fabs 1234567.6) 1234567.6)
+	(num-test (fabs -1234567.6) 1234567.6)
+	(num-test (fabs -1.5) 1.5)
+
+	(num-test (ceil -1) -1.0)
+	(num-test (ceil 0) 0.0)
+	(num-test (ceil +inf.0) +inf.0)
+	(test (nan? (ceil +nan.0)) #t)
+	(num-test (ceil 1234567.6) 1234568.0)
+	(num-test (ceil -1234567.6) -1234567.0)
+	(num-test (ceil 1234567.5) 1234568.0)
+	(num-test (ceil -1234567.5) -1234567.0)
+	(num-test (ceil 32.75) 33.0)
+
+	(unless (provided? 'netbsd)
+	  (num-test (nearbyint 1.5) 2.0)
+	  (num-test (nearbyint 3/4) 1.0)
+	  (num-test (nearbyint -63) -63.0)
+	  (num-test (nearbyint +inf.0) +inf.0)
+	  (test (nan? (nearbyint +nan.0)) #t)
+	  (num-test (nearbyint 1234567.6) 1234568.0)
+	  (num-test (nearbyint 1234567.5) 1234568.0)
+	  (num-test (nearbyint -1234567.5) -1234568.0)
+	  (num-test (nearbyint 1/9223372036854775807) 0.0))
+
+	(num-test (rint +inf.0) +inf.0)
+	(test (nan? (rint +nan.0)) #t)
+	(num-test (rint 1234567.6) 1234568.0)
+	(num-test (rint -1234567.6) -1234568.0)
+	(num-test (rint 1234567.5) 1234568.0)
+	(num-test (rint -1234567.5) -1234568.0)
+	(num-test (rint 32.75) 33.0)
+	(num-test (rint 1.5) 2.0)
+
+	(num-test (llrint 3.1415926535898) 3)
+	(num-test (llrint 1.5707963267949) 2)
+	(num-test (llrint 1234567.6) 1234568)
+	(num-test (llrint -1234567.6) -1234568)
+	(num-test (llrint 1234567.5) 1234568)
+	(num-test (llrint -1234567.5) -1234568)
+	(num-test (llrint 32.75) 33)
+
+	(num-test (llround 1.5) 2)
+	(num-test (llround 3/4) 1)
+	(num-test (llround 1234567.6) 1234568)
+	(num-test (llround -1234567.6) -1234568)
+	(num-test (llround 1234567.5) 1234568)
+	(num-test (llround -1234567.5) -1234568)
+	(num-test (llround 32.75) 33)
+
+	(num-test (trunc 1.5707963267949) 1.0)
+	(num-test (trunc +inf.0) +inf.0)
+	(test (nan? (trunc +nan.0)) #t)
+	(num-test (trunc 1234567.6) 1234567.0)
+	(num-test (trunc -1234567.6) -1234567.0)
+	(num-test (trunc 1234567.5) 1234567.0)
+	(num-test (trunc -1234567.5) -1234567.0)
+	(num-test (trunc 32.75) 32.0)
+	(num-test (trunc 1.5) 1.0)
+	(num-test (trunc -1.5) -1.0)
+
+	(test (nan? (fmod +nan.0 -42.0)) #t)
+	(num-test (fmod 3.1415926535898 3) 0.14159265358979)
+	(num-test (fmod 32.75 -1.5) 1.25)
+	(num-test (fmod 32.75 1.5) 1.25)
+
+	(num-test (ldexp -1 6) -64.0)
+	(num-test (ldexp 0 6) 0.0)
+	(num-test (ldexp 6 6) 384.0)
+	(num-test (ldexp 3.0 1) 6.0)
+	(num-test (ldexp 6 0) 6.0)
+	(num-test (ldexp +inf.0 -1) +inf.0)
+	(test (nan? (ldexp +nan.0 -1)) #t)
+
+	(num-test (scalbn 1.5 3) 12.0)
+	(num-test (scalbn 3.0 6) 192.0)
+	(num-test (scalbn 1.5 1) 3.0)
+	(num-test (scalbn 6 -1) 3.0)
+
+	(unless (provided? 'netbsd)
+	  (num-test (scalbln +inf.0 -42) +inf.0)
+	  (test (nan? (scalbln +nan.0 -42)) #t)
+	  (num-test (scalbln 3.0 3) 24.0)
+	  (num-test (scalbln 0 -42) 0.0)
+	  (num-test (scalbln -1.5 6) -96.0)
+	  (num-test (scalbln 3.0 6) 192.0)
+	  (num-test (scalbln 1 -1) 0.5)
+	  (num-test (scalbln 1.5 -1) 0.75))
+
+	(num-test (exp2 -1) 0.5)
+	(num-test (exp2 0) 1.0)
+	(num-test (exp2 1.5) 2.8284271247462)
+	(num-test (exp2 3/4) 1.6817928305074)
+	(num-test (exp2 6) 64.0)
+	(num-test (exp2 +inf.0) +inf.0)
+	(test (nan? (exp2 +nan.0)) #t)
+
+	(num-test (expm1 +inf.0) +inf.0)
+	(test (nan? (expm1 +nan.0)) #t)
+	(num-test (expm1 -1) -0.63212055882856)
+	(num-test (expm1 0) 0.0)
+	(num-test (expm1 1) 1.718281828459)
+	(num-test (expm1 1.5) 3.4816890703381)
+	(num-test (expm1 3/4) 1.1170000166127)
+	(num-test (expm1 -63) -1.0)
+
+	(num-test (log10 +inf.0) +inf.0)
+	(test (nan? (log10 +nan.0)) #t)
+	(num-test (log10 32.75) 1.5152113043278)
+	(num-test (log10 1.5) 0.17609125905568)
+	(num-test (log10 1) 0.0)
+	(num-test (log10 1234567.6) 6.0915148751535)
+
+	(num-test (log1p +inf.0) +inf.0)
+	(if (provided? 'linux) (test (nan? (log1p +nan.0)) #t))
+	(num-test (log1p 1234567.6) 14.02623215528)
+	(num-test (log1p 0.0) 0.0)
+	(num-test (log1p 1) 0.69314718055995)
+	(num-test (log1p 1.5) 0.91629073187416)
+	(num-test (log1p 3/4) 0.55961578793542)
+
+	(num-test (log2 +inf.0) +inf.0)
+	(test (nan? (log2 +nan.0)) #t)
+	(num-test (log2 1234567.6) 20.235574404197)
+	(num-test (log2 1) 0.0)
+	(num-test (log2 32.75) 5.0334230015375)
+	(num-test (log2 1.5) 0.58496250072116)
+
+	(num-test (ilogb 3.1415926535898) 1)
+	(num-test (ilogb 1.5707963267949) 0)
+	(num-test (ilogb +inf.0) 2147483647)
+	(num-test (ilogb +nan.0) (if (or (provided? 'freebsd) (provided? 'solaris)) 2147483647 -2147483648))
+	(num-test (ilogb 1234567.6) 20)
+	(num-test (ilogb -1234567.6) 20)
+	(num-test (ilogb 1) 0)
+	(num-test (ilogb 3.0) 1)
+
+	(num-test (cbrt +inf.0) +inf.0)
+	(test (nan? (cbrt +nan.0)) #t)
+	(num-test (cbrt 1234567.6) 107.27658956435)
+	(num-test (cbrt -1) -1.0)
+	(num-test (cbrt 0) 0.0)
+	(num-test (cbrt 1) 1.0)
+	(num-test (cbrt 1.5) 1.1447142425533)
+	(num-test (cbrt 3.0) 1.4422495703074)
+
+	(num-test (hypot 0 -42.0) 42.0)
+	(num-test (hypot 1 3) 3.1622776601684)
+	(num-test (hypot 1.5 3) 3.3541019662497)
+	(num-test (hypot 3/4 3) 3.0923292192132)
+	(num-test (hypot +inf.0 -1.5) +inf.0)
+	(test (nan? (hypot +nan.0 -1.5)) #t)
+	(num-test (hypot 1.5 32.75) 32.784333148625)
+
+	(unless (provided? 'netbsd)
+	  (num-test (fma 3.0 3 -42.0) -33.0)
+	  (num-test (fma 6 -42 -42.0) -294.0)
+	  (num-test (fma 1.5 -42 -42.0) -105.0)
+	  (num-test (fma -1.5 -42 -42.0) 21.0)
+	  (num-test (fma 3.0 -42 -42.0) -168.0)
+	  (num-test (fma +inf.0 1.5 -42.0) +inf.0))
+
+	(test (nan? (pow +nan.0 -42.0)) #t)
+	(num-test (pow 1 3) 1.0)
+	(num-test (pow 1.5 3) 3.375)
+	(num-test (pow 3/4 3) 0.421875)
+	(num-test (pow -63 3) -250047.0)
+	(num-test (pow 6 3) 216.0)
+	(num-test (pow 0.0 3.0) 0.0)
+
+	(num-test (fdim 1.5 -42) 43.5)
+	(num-test (fdim -1.5 -42) 40.5)
+	(num-test (fdim 3.0 -42) 45.0)
+	(num-test (fdim 0 -42.0) 42.0)
+	(test (nan? (fdim 0.0 +nan.0)) #t)
+	(num-test (fdim 1 6) 0.0)
+	(num-test (fdim 32.75 6) 26.75)
+
+	(num-test (tgamma 1.5) 0.88622692545276)
+	(num-test (tgamma 3/4) 1.2254167024652)
+	(num-test (tgamma 3.1415926535898) 2.28803779534)
+	(num-test (tgamma 1.5707963267949) 0.89056089038154)
+	(num-test (tgamma +inf.0) +inf.0)
+	(test (nan? (tgamma +nan.0)) #t)
+	(num-test (tgamma -1.5) 2.3632718012074)
+	(num-test (tgamma 3.0) 2.0)
+
+	(num-test (copysign -1.5 3) 1.5)
+	(num-test (copysign 3/4 -42.0) -0.75)
+	(num-test (copysign +inf.0 3.0) +inf.0)
+	(test (nan? (copysign +nan.0 3.0)) #t)
+	(num-test (copysign 1.5 3.0) 1.5)
+	(num-test (copysign -1.5 3.0) 1.5)
+
+	(num-test (nextafter 1 -42) 1.0)
+	(num-test (nextafter 1.5 -42) 1.5)
+	(num-test (nextafter 3/4 -42) 0.75)
+	(test (nan? (nextafter +nan.0 -1.5)) #t)
+	(num-test (nextafter 0 -1.5) -4.9406564584125e-324)
+
+	(num-test (nexttoward 0 -42) -4.9406564584125e-324)
+	(num-test (nexttoward 1.5 3) 1.5)
+
+	(unless (provided? 'solaris)
+	  (num-test (isfinite +inf.0) 0)
+	  (num-test (isfinite +nan.0) 0)
+	  (num-test (isfinite 1234567.6) 1)
+	  (num-test (isfinite -1234567.6) 1)
+	  (num-test (isfinite 9223372036854775807) 1)
+
+	  (num-test (isinf +inf.0) 1)
+	  (num-test (isinf +nan.0) 0)
+	  (num-test (isinf 1234567.6) 0)
+	  (num-test (isinf -9223372036854775807) 0)
+	  (num-test (isinf -1) 0)
+	  (num-test (isinf 0) 0)
+
+	  (num-test (isnan +inf.0) 0)
+	  (num-test (isnan +nan.0) 1)
+	  (num-test (isnan 1234567.6) 0)
+
+	  (num-test (isnormal +inf.0) 0)
+	  (num-test (isnormal +nan.0) 0)
+	  (num-test (isnormal 1234567.6) 1)
+	  (num-test (isnormal 0) 0)
+	  (num-test (isnormal 1.0e-307) 1)
+	  (num-test (isnormal 1.0e-308) 0)
+	  (num-test (isnormal 1.0e-310) 0)
+	  (num-test (isnormal 1.0e-321) 0)
+
+	  (when (defined? 'signbit)
+	    (num-test (signbit 1.5) 0)
+	    (num-test (signbit 0) 0)
+	    (num-test (signbit +inf.0) 0)
+	    (num-test (signbit +nan.0) 0)))
+
+	(num-test (floor 1.5) 1.0)
+	(num-test (floor 3/4) 0.0)
+	(num-test (floor -63) -63.0)
+	(num-test (floor +inf.0) +inf.0)
+	(test (nan? (floor +nan.0)) #t)
+	(num-test (floor 1234567.6) 1234567.0)
+	(num-test (floor -1234567.6) -1234568.0)
+	(num-test (floor 1234567.5) 1234567.0)
+	(num-test (floor -1234567.5) -1234568.0)
+	(num-test (floor 32.75) 32.0)
+	(num-test (floor -1.5) -2.0)
+
+	(num-test (round +inf.0) +inf.0)
+	(test (nan? (round +nan.0)) #t)
+	(num-test (round 1234567.6) 1234568.0)
+	(num-test (round -1234567.6) -1234568.0)
+	(num-test (round 1234567.5) 1234568.0)
+	(num-test (round -1234567.5) -1234568.0)
+	(num-test (round 32.75) 33.0)
+	(num-test (round 1.5) 2.0)
+	(num-test (round -1.5) -2.0)
+
+	(test (nan? (remainder +nan.0 -42)) #t)
+	(num-test (remainder 1234567.6 -42) 19.600000000093)
+	(num-test (remainder -63 3.0) 0.0)
+	(num-test (remainder 32.75 3.0) -0.25)
+	(test (nan? (remainder 3.0 +nan.0)) #t)
+	(num-test (remainder -1.5 3/4) 0.0)
+
+	(num-test (exp 1.5707963267949) 4.8104773809654)
+	(num-test (exp +inf.0) +inf.0)
+	(test (nan? (exp +nan.0)) #t)
+	(num-test (exp -1) 0.36787944117144)
+	(num-test (exp 0) 1.0)
+	(num-test (exp 1.5) 4.4816890703381)
+	(num-test (exp 3/4) 2.1170000166127)
+
+	(num-test (log 6) 1.7917594692281)
+	(num-test (log 3.1415926535898) 1.1447298858494)
+	(num-test (log 1.5707963267949) 0.45158270528945)
+	(num-test (log +inf.0) +inf.0)
+	(test (nan? (log +nan.0)) #t)
+	(num-test (log 1234567.6) 14.02623134528)
+	(num-test (log 32.75) 3.4889029620813)
+	(num-test (log 1.5) 0.40546510810816)
+
+	(num-test (sqrt 0.0) 0.0)
+	(num-test (sqrt 1) 1.0)
+	(num-test (sqrt 1.5) 1.2247448713916)
+	(num-test (sqrt 3/4) 0.86602540378444)
+	(num-test (sqrt 6) 2.4494897427832)
+	(num-test (sqrt 3.1415926535898) 1.7724538509055)
+	(num-test (sqrt 1.5707963267949) 1.2533141373155)
+	(num-test (sqrt +inf.0) +inf.0)
+	(test (nan? (sqrt +nan.0)) #t)
+	(num-test (sqrt 1234567.6) 1111.1109755555)
+
+	(num-test (cos 0.0) 1.0)
+	(num-test (cos 1) 0.54030230586814)
+	(num-test (cos 1.5) 0.070737201667703)
+	(num-test (cos 3/4) 0.73168886887382)
+	(num-test (cos -63) 0.98589658158255)
+	(num-test (cos 6) 0.96017028665037)
+	(num-test (cos 3.1415926535898) -1.0)
+	(num-test (cos 1.5707963267949) 6.1232339957368e-17)
+	(test (nan? (cos +nan.0)) #t)
+	(num-test (cos 1234567.6) -0.97435594756269)
+
+	(num-test (sin 0.0) 0.0)
+	(num-test (sin 1) 0.8414709848079)
+	(num-test (sin 1.5) 0.99749498660405)
+	(num-test (sin 3/4) 0.68163876002333)
+	(num-test (sin -63) -0.16735570030281)
+	(num-test (sin 6) -0.27941549819893)
+	(num-test (sin 3.1415926535898) 1.2246467991474e-16)
+	(num-test (sin 1.5707963267949) 1.0)
+	(test (nan? (sin +nan.0)) #t)
+	(num-test (sin 1234567.6) -0.22501219400117)
+
+	(num-test (tan 0.0) 0.0)
+	(num-test (tan 1) 1.5574077246549)
+	(num-test (tan 1.5) 14.101419947172)
+	(num-test (tan 3/4) 0.93159645994407)
+	(num-test (tan -63) -0.16974975208269)
+	(num-test (tan 6) -0.29100619138475)
+	(num-test (tan 3.1415926535898) -1.2246467991474e-16)
+	(test (nan? (tan +nan.0)) #t)
+	(num-test (tan 1234567.6) 0.23093428491305)
+
+	(num-test (sinh 0.0) 0.0)
+	(num-test (sinh 1) 1.1752011936438)
+	(num-test (sinh 1.5) 2.1292794550948)
+	(num-test (sinh 3/4) 0.82231673193583)
+	(num-test (sinh -63) -1.1468915797348e+27)
+	(num-test (sinh 6) 201.71315737028)
+	(num-test (sinh 3.1415926535898) 11.548739357258)
+	(num-test (sinh 1.5707963267949) 2.3012989023073)
+	(num-test (sinh +inf.0) +inf.0)
+	(test (nan? (sinh +nan.0)) #t)
+	(num-test (sinh 1234567.6) +inf.0)
+
+	(num-test (tanh 0.0) 0.0)
+	(num-test (tanh 1) 0.76159415595576)
+	(num-test (tanh 1.5) 0.90514825364487)
+	(num-test (tanh 3/4) 0.63514895238729)
+	(num-test (tanh -63) -1.0)
+	(num-test (tanh 6) 0.9999877116508)
+	(num-test (tanh 3.1415926535898) 0.99627207622075)
+	(num-test (tanh 1.5707963267949) 0.91715233566727)
+	(num-test (tanh +inf.0) 1.0)
+	(test (nan? (tanh +nan.0)) #t)
+	(num-test (tanh 1234567.6) 1.0)
+
+	(num-test (acos 1) 0.0)
+	(num-test (acos 3/4) 0.72273424781342)
+	(test (nan? (acos 1.5707963267949)) #t)
+	(num-test (acos -1) 3.1415926535898)
+	(num-test (acos 0) 1.5707963267949)
+
+	(num-test (asin 0.0) 0.0)
+	(num-test (asin 1) 1.5707963267949)
+	(test (nan? (asin +inf.0)) #t)
+	(test (nan? (asin +nan.0)) #t)
+	(num-test (asin 3/4) 0.84806207898148)
+
+	(num-test (atan 0.0) 0.0)
+	(num-test (atan 1) 0.78539816339745)
+	(num-test (atan 1.5) 0.98279372324733)
+	(num-test (atan 3/4) 0.64350110879328)
+	(num-test (atan -63) -1.5549246438031)
+	(num-test (atan 6) 1.4056476493803)
+	(num-test (atan 3.1415926535898) 1.2626272556789)
+	(num-test (atan 1.5707963267949) 1.0038848218539)
+	(num-test (atan +inf.0) 1.5707963267949)
+	(test (nan? (atan +nan.0)) #t)
+	(num-test (atan 1234567.6) 1.5707955167947)
+
+	(test (nan? (atan2 +nan.0 3.0)) #t)
+	(num-test (atan2 -1 3) -0.32175055439664)
+	(num-test (atan2 -1 32.75) -0.030524866917203)
+	(num-test (atan2 0.0 3) 0.0)
+	(num-test (atan2 1 3) 0.32175055439664)
+	(num-test (atan2 1.5 3) 0.46364760900081)
+	(num-test (atan2 3/4 3) 0.24497866312686)
+	(num-test (atan2 -63 3) -1.5232132235179)
+
+	(num-test (acosh 1) 0.0)
+	(num-test (acosh 1.5) 0.96242365011921)
+	(num-test (acosh 6) 2.4778887302885)
+	(num-test (acosh 3.1415926535898) 1.8115262724609)
+	(num-test (acosh 1.5707963267949) 1.0232274785476)
+	(num-test (acosh +inf.0) +inf.0)
+	(test (nan? (acosh +nan.0)) #t)
+	(num-test (acosh 1234567.6) 14.71937852584)
+
+	(num-test (asinh 0.0) 0.0)
+	(num-test (asinh 1) 0.88137358701954)
+	(num-test (asinh 1.5) 1.1947632172871)
+	(num-test (asinh 3/4) 0.69314718055995)
+	(num-test (asinh -63) -4.8363448891593)
+	(num-test (asinh 6) 2.4917798526449)
+	(num-test (asinh 3.1415926535898) 1.8622957433108)
+	(num-test (asinh 1.5707963267949) 1.2334031175112)
+	(num-test (asinh +inf.0) +inf.0)
+	(test (nan? (asinh +nan.0)) #t)
+	(num-test (asinh 1234567.6) 14.71937852584)
+
+	(num-test (atanh 0.0) 0.0)
+	(num-test (atanh 3/4) 0.97295507452766)
+	(test (nan? (atanh +nan.0)) #t)
+
+	(equivalent? (remquo -42.0 -42.0) '(0.0 1))
+	(equivalent? (remquo 1234567.5 3) '(1.5 2))
+	(equivalent? (remquo 3.1415926535898 3) '(0.14159265358979 1))
+	(equivalent? (remquo -63 3.0) '(0.0 -5))
+	(equivalent? (remquo 1 -1.5) '(-0.5 -1))
+	(equivalent? (remquo 3/4 1.5) '(0.75 0))
+
+	(equivalent? (frexp 0.0) '(0.0 0))
+	(equivalent? (frexp 1) '(0.5 1))
+	(equivalent? (frexp 1.5) '(0.75 1))
+	(equivalent? (frexp 3/4) '(0.75 0))
+	(equivalent? (frexp -63) '(-0.984375 6))
+	(equivalent? (frexp 6) '(0.75 3))
+	(equivalent? (frexp 3.1415926535898) '(0.78539816339745 2))
+	(equivalent? (frexp 1.5707963267949) '(0.78539816339745 1))
+	(equivalent? (frexp +inf.0) '(+inf.0 0))
+	(equivalent? (frexp +nan.0) '(+nan.0 0))
+	(equivalent? (frexp 1234567.6) '(0.58868770599365 21))
+
+        (test (catch #t (lambda () (modf #\a)) (lambda (t i) (apply format #f i))) "(*libm* 'modf) argument, #\\a, is a character but should be a real")
+	(equivalent? (modf 0.0) '(0.0 0.0))
+	(equivalent? (modf 1) '(0.0 1.0))
+	(equivalent? (modf 1.5) '(0.5 1.0))
+	(equivalent? (modf 3/4) '(0.75 0.0))
+	(equivalent? (modf -63) '(0.0 -63.0))
+	(equivalent? (modf 6) '(0.0 6.0))
+	(equivalent? (modf 3.1415926535898) '(0.14159265358979 3.0))
+	(equivalent? (modf 1.5707963267949) '(0.5707963267949 1.0))
+	(equivalent? (modf +inf.0) '(0.0 +inf.0))
+	(equivalent? (modf +nan.0) '(+nan.0 +nan.0))
+	(equivalent? (modf 1234567.6) '(0.60000000009313 1234567.0))))))
+
+;; now check for leaks
+(test (defined? 'remquo) #f)
+(test (defined? 'M_LN2) #f)
+(num-test (sin 1+i) 1.298457581415977+0.6349639147847361i)
+(test (integer? (round 123.3)) #t)
+
+
+;;; --------------------------------------------------------------------------------
+;;; libc
+
+(unless (provided? 'windows)
+  (let ()
+    (require libc.scm)
+    (when (and (defined? '*libc*)
+	       (procedure? (*libc* 'passwd.pw_name)))
+      (with-let (sublet *libc*)
+
+	(test (let ((buf (make-string 20 #\null)))
+		(strcat buf "All ")
+		(strcat buf "for ")
+		(strcat buf "one.")
+		(substring buf 0 12))
+	      "All for one.")
+	(test (strcmp "a" "b") -1)
+	(test (strcmp "a" "a") 0)
+	(test (strncmp "1234" "1235" 3) 0)
+	(test (strcpy (make-string 3) "123") "123")
+	(test (strlen "123") 3)
+	(test (strchr "12345" (char->integer #\3)) "345")
+	(test (strspn "12345" "123") 3)
+	(test (isalpha (char->integer #\.)) 0)
+	(test (zero? (isdigit (char->integer #\2))) #f)
+	(test (integer->char (toupper (char->integer #\a))) #\A)
+	(test (let ((buf (malloc 3)))
+		(memset buf 90 3)
+		(let ((result (c-pointer->string buf 3)))
+		  (free buf)
+		  result))
+	      "ZZZ")
+
+	(define get-environment-variable getenv)
+	(define get-environment-variables getenvs)
+	(define* (set-environment-variable x v (overwrite #t)) (setenv x v (if overwrite 1 0)))
+	(define delete-environment-variable unsetenv)
+
+	(define (file-exists? file)
+	  (= (access file F_OK) 0))
+
+	(define delete-file unlink)
+	;; system can be used as is
+
+	(define* (ls dir-name (port *stderr*))
+	  (let ((dir (opendir dir-name)))
+	    (do ((p (read_dir dir) (read_dir dir)))
+		((= (length p) 0))
+	      (format port "~A " p))
+	    (closedir dir)))
+
+	(define (directory->list dir-name)
+	  (let ((lst ())
+		(dir (opendir dir-name)))
+	    (do ((p (read_dir dir) (read_dir dir)))
+		((= (length p) 0))
+	      (if (not (member p '("." "..")))
+		  (set! lst (cons p lst)))) ; read_dir in libc.scm returns dpos->d_name
+	    (closedir dir)
+	    lst))
+
+	(define (memory-rusage)
+	  (let ((v (rusage.make)))
+	    (getrusage RUSAGE_SELF v)
+	    (let ((mem (rusage.ru_maxrss v)))
+	      (free v)
+	      (* 1024 mem))))
+
+	(define (os-type) (car (uname)))
+	(define (cpu-architecture) (cadr (uname)))
+	(define (machine-name) (caddr (uname)))
+	(define (os-version) (string-append (list-ref (uname) 3) " " (list-ref (uname) 4)))
+	(define (implementation-name) "s7")
+	(define (implementation-version) (substring (*s7* 'version) 3 7))
+
+	(reader-cond ((and (not (provided? 'openbsd)) (not (provided? 'solaris)))
+		      (define (word-size) __WORDSIZE)))
+	(reader-cond ((and (not (provided? 'openbsd)) (not (provided? 'solaris)))
+		      (define (little-endian?) (= __BYTE_ORDER __LITTLE_ENDIAN))))
+
+	(define (daytime)
+	  (let ((timestr (make-string 64))
+		(p #f))
+	    (let ((len (strftime timestr 64 "%a %d-%b-%Y %H:%M %Z"
+				 (localtime
+				  (set! p (time.make (time (c-pointer 0 'time_t*))))))))
+	      (time.free p)
+	      (substring timestr 0 len))))
+
+	(define (write-date file)
+	  (let ((buf (stat.make)))
+	    (let ((res (and (stat file buf)
+			    (stat.st_mtime buf))))
+	      (stat.free buf)
+	      res)))
+
+	(define (file-write-date->string file)
+	  (let ((timestr (make-string 64))
+		(p #f))
+	    (let ((len (strftime timestr 64 "%a %d-%b-%Y %H:%M %Z"
+				 (localtime
+				  (set! p (time.make (write-date file)))))))
+	      (time.free p)
+	      (substring timestr 0 len))))
+
+	(define (copy-file in-file out-file)
+	  (with-let (sublet *libc*
+		      (inlet 'in-file in-file 'out-file out-file))
+	    (let ((infd (open in-file O_RDONLY 0)))
+	      (if (= infd -1)
+		  (error 'io-error "can't find ~S~%" in-file)
+		  (let ((outfd (creat out-file #o666)))
+		    (if (= outfd -1)
+			(begin
+			  (close infd)
+			  (error 'io-error "can't open ~S~%" out-file))
+			(let* ((BUF_SIZE 1024)
+			       (buf (malloc BUF_SIZE)))
+			  (do ((num (read infd buf BUF_SIZE) (read infd buf BUF_SIZE)))
+			      ((or (<= num 0)
+				   (not (= (write outfd buf num) num)))))
+			  (close outfd)
+			  (close infd)
+			  (free buf)
+			  out-file)))))))
+
+	(define (tty-direct) ; run in a non-GUI repl
+	  (with-let (sublet *libc*)
+	    (call-with-exit
+	     (lambda (quit)
+	       (let ((saved (termios.make))
+		     (fn (fileno stdin)))
+		 (define (tty_reset fd)
+		   (tcsetattr fd TCSAFLUSH saved))
+		 (define (sigcatch no)
+		   (tty_reset fn)
+		   (quit))
+		 (if (or (equal? (signal SIGINT sigcatch) SIG_ERR)
+			 (equal? (signal SIGQUIT sigcatch) SIG_ERR)
+			 (equal? (signal SIGTERM sigcatch) SIG_ERR)
+			 (negative? (tcgetattr fn saved)))
+		     (quit))
+		 (let ((buf (termios.make))
+		       (c (string #\null #\null)))
+		   (let ((cc (string->c-pointer c)))
+		     (tcgetattr fn buf)
+		     (termios.set_c_lflag buf (logand (termios.c_lflag buf) (lognot (logior ECHO ICANON))))
+		     (termios.set_c_cc buf VMIN 1)
+		     (termios.set_c_cc buf VTIME 0)
+		     (if (negative? (tcsetattr fn TCSAFLUSH buf))
+			 (quit))
+		     (do ((i (read fn cc 1) (read fn cc 1)))
+			 ((not (= i 1))
+			  (tty_reset fn)
+			  (quit))
+		       (format *stderr* "got ~C~%" (c 0))))))))))
+
+	;; to write a directory files + file size:
+	(test (string? (with-output-to-string
+			 (lambda ()
+			   (ftw (append "/home/" username "/sf1")
+				(lambda (a b c)
+				  (format () "~A ~A~%" a ((*libc* 'stat.st_size) b))
+				  0) 10))))
+	      #t)
+
+	(define (directory? file)
+	  (let ((buf (stat.make)))
+	    (let ((result (and (stat file buf)
+			       (S_ISDIR (stat.st_mode buf)))))
+	      (free buf)
+	      result)))
+
+	(define* (home-directory name)
+	  (if (not name)
+	      (getenv "HOME")
+	      (passwd.pw_dir (getpwnam name))))
+
+	(define (file-length file)
+	  (let ((buf (stat.make)))
+	    (stat file buf)
+	    (let ((result (stat.st_size buf)))
+	      (free buf)
+	      result)))
+
+	(define (fgrep func wildfile)
+	  (for-each
+	   (lambda (file)
+	     (call-with-input-file file
+	       (lambda (port)
+		 (do ((str (read-line port) (read-line port))
+		      (line 1 (+ line 1)))
+		     ((eof-object? str))
+		   (when (func str)
+		     (format *stderr* "~S[~D]: ~S~%" file line str))))))
+	   (let ((g (glob.make)))
+	     (glob wildfile 0 g)
+	     (let ((res (glob.gl_pathv g)))
+	       (globfree g)
+	       res))))
+	;; (fgrep (lambda (str) (string-position "legendre" str)) "lib*.scm")
+
+	(define (system-limits)
+	  (list 'arg-max (sysconf _SC_ARG_MAX)
+		'login-max (sysconf _SC_LOGIN_NAME_MAX)
+		'open-max (sysconf _SC_OPEN_MAX)
+		'groups-max (sysconf _SC_NGROUPS_MAX)
+		'page-size (sysconf _SC_PAGESIZE)))
+
+	(define (open-file filename)
+	  (catch 'io-error
+	    (lambda ()
+	      (open-input-file filename))
+	    (lambda (type info)
+	      (let ((new-filename #f)
+		    (err ((*libc* 'errno))))
+		(list type filename ((*libc* 'strerror) err))))))
+
+	(test (open-file "!asdf!") (list 'io-error "!asdf!" "No such file or directory"))
+	(test (string? (getcwd (make-string 1024 #\space) 1024)) #t)
+	(test (string? (get-environment-variable "HOME")) #t)
+	(test (integer? (random)) #t)
+	(test ((localeconv) 'decimal_point) ".")
+	(test (string? (getlogin)) #t)
+	(test (integer? (getpid)) #t)
+	(test (integer? _POSIX_VERSION) #t)
+	(if (provided? 'linux) (test (>= __GLIBC__ 2) #t))
+	;(test (c-null? (c-pointer 0)) #t)
+	(test (fnmatch "*.c" "s7.c" FNM_PATHNAME) 0)
+	(test (string? (realpath "s7.c" (string))) #t) ; second arg is simply ignored
+	(test (string? (realpath "s7.c" #f)) #t)
+	(let ((log (getlogin)))  ; this is null in an emacs shell!
+	  (when (and (string? log)
+		     (> (string-length log) 0))
+	    (test (passwd.pw_name (getpwnam (getlogin))) (getlogin))
+	    (test (string? (passwd.pw_shell (getpwnam (getlogin)))) #t)))
+	(reader-cond ((not (provided? 'openbsd))
+		      (test (string? (let ((w (wordexp.make)))
+				       (wordexp "~/cl/snd-gdraw" w 0)
+				       (let ((res (car (wordexp.we_wordv w))))
+					 (wordfree w)
+					 (wordexp.free w)
+					 res)))
+			    #t)))
+	(test (pair? (system-limits)) #t)
+	(test (> (file-length "s7test.scm") 4000000) #t)
+	(test (string? (home-directory)) #t)
+	(test (directory? (home-directory)) #t)
+	(test (string? (file-write-date->string "s7test.scm")) #t)
+	(if (provided? 'linux) (test (string? (car (command-line))) #t))
+	(test (string? (daytime)) #t)
+	(reader-cond ((and (not (provided? 'openbsd)) (not (provided? 'solaris)))
+		      (test (not (member (word-size) '(32 64))) #f)))
+	(reader-cond ((provided? 'linux) (test (os-type) "Linux"))
+		     ((provided? 'osx) (test (os-type) "Darwin"))
+		     ((provided? 'freebsd) (test (os-type) "FreeBSD"))
+		     ((provided? 'netbsd) (test (os-type) "NetBSD"))
+		     ((provided? 'openbsd) (test (os-type) "OpenBSD"))
+		     ((provided? 'solaris) (test (os-type) "SunOS"))
+		     (#t (test (os-type) "Unknown")))
+	(test (integer? (memory-rusage)) #t)
+	(test (file-exists? "s7test.scm") #t)
+	(test (atoi "123") 123)
+	(test (llabs -1234) 1234)
+	(test (strtod "1.5") 1.5)
+	(test CLOCKS_PER_SEC (if (provided? 'openbsd) 100 1000000))
+	(test (*libc* 'INT8_MIN) -128)
+	(test (not (member (group.gr_name (getgrnam "wheel")) '("" "wheel"))) #f)
+	(test (not (member (group.gr_name (getgrgid 0)) '("root" "wheel"))) #f)
+	(test (not (memv (group.gr_gid (getgrnam "root")) '(0 -1))) #f)
+	(test (let ((g (glob.make))) (glob "s7t*.scm" 0 g) (let ((res (glob.gl_pathv g))) (globfree g) (free g) res)) '("s7test.scm"))
+	(test (fegetround) 0)
+	(test (let* ((p (fenv_t.make))
+		     (result (fegetenv p)))
+		(free p)
+		result)
+	      0)
+	(test (let ((file (fopen "s7test.scm" "r")))
+		(let ((c (getc file)))
+		  (fclose file)
+		  (integer->char c)))
+	      #\;)
+
+	))))
+
+(if (defined? '*libc*) (format *stderr* "*libc* is defined~%"))
+(if (equal? (arity random) '(0 . 0)) (format *stderr* "libc random is global~%"))
+
+
+;;; --------------------------------------------------------------------------------
+;;; libgsl
+
+(when (or (provided? 'linux)
+	  (provided? 'osx))
+  (let ()
+    (require libgsl.scm)
+    (when (and (defined? '*libgsl*)
+	       (procedure? (*libgsl* 'gsl_vector_equal)))
+      (with-let (sublet *libgsl*)
+
+	(define (eigenvalues M)
+	  (with-let (sublet *libgsl* (inlet 'M M))
+	    (let* ((len (sqrt (length M)))
+		   (gm (gsl_matrix_alloc len len))
+		   (m (float-vector->gsl_matrix M gm))
+		   (evl (gsl_vector_complex_alloc len))
+		   (evc (gsl_matrix_complex_alloc len len))
+		   (w (gsl_eigen_nonsymmv_alloc len)))
+
+	      (gsl_eigen_nonsymmv m evl evc w)
+	      (gsl_eigen_nonsymmv_free w)
+	      (gsl_eigen_nonsymmv_sort evl evc GSL_EIGEN_SORT_ABS_DESC)
+
+	      (let ((vals (make-vector len)))
+		(do ((i 0 (+ i 1)))
+		    ((= i len))
+		  (set! (vals i) (gsl_vector_complex_get evl i)))
+		(gsl_matrix_free gm)
+		(gsl_vector_complex_free evl)
+		(gsl_matrix_complex_free evc)
+		vals))))
+
+	(test (eigenvalues (float-vector 3 1 1 3)) #(4.0 2.0))
+	(test (eigenvalues (float-vector 1 2 4 3)) #(5.0 -1.0))
+
+	(num-test GSL_CONST_CGS_LIGHT_YEAR 9.460536207070001e+17)
+	(num-test (GSL_SIGN -123) -1)
+	(test (GSL_IS_ODD 4) #f)
+	(test (integer? GSL_SF_FACT_NMAX) #t)
+
+	(num-test (gsl_sf_airy_Ai -500.0 GSL_MODE_DEFAULT) 0.07259012010418163)
+	(num-test (gsl_sf_airy_Bi -500.0 GSL_MODE_DEFAULT) -0.0946885701328829)
+	(num-test (gsl_sf_airy_Ai_scaled -5.0 GSL_MODE_DEFAULT) 0.3507610090241141)
+	(num-test (gsl_sf_airy_Bi_scaled -5.0 GSL_MODE_DEFAULT) -0.1383691349016009)
+	(num-test (gsl_sf_airy_Ai_deriv -5.0 GSL_MODE_DEFAULT) 0.3271928185544435)
+	(num-test (gsl_sf_airy_Bi_deriv -5.0 GSL_MODE_DEFAULT) 0.778411773001899)
+	(num-test (gsl_sf_airy_Ai_deriv_scaled -5.0 GSL_MODE_DEFAULT) 0.3271928185544435)
+	(num-test (gsl_sf_airy_Bi_deriv_scaled -5.0 GSL_MODE_DEFAULT) 0.778411773001899)
+	(num-test (gsl_sf_airy_zero_Ai_deriv 2) -3.248197582179837)
+	(num-test (gsl_sf_airy_zero_Bi_deriv 2) -4.073155089071828)
+	(num-test (gsl_sf_bessel_J0 1.0) 0.7651976865579666)
+	(num-test (let ((sfr (gsl_sf_result.make)))
+		    (gsl_sf_bessel_J0_e 1.0 sfr)
+		    (let ((result (gsl_sf_result.val sfr)))
+		      (free sfr)
+		      result))
+		  0.7651976865579666)
+	(num-test (let ((sfr (gsl_sf_result.make)))
+		    (gsl_sf_bessel_J0_e 1.0 sfr)
+		    (let ((result (gsl_sf_result.err sfr)))
+		      (free sfr)
+		      result))
+		  6.72613016567227e-16)
+	(num-test (gsl_sf_bessel_J0 .1) 0.9975015620660401)
+	(num-test (gsl_sf_bessel_J1 .1) 0.049937526036242)
+	(num-test (gsl_sf_bessel_Jn 45 900.0) 0.02562434700634277)
+	(num-test (gsl_sf_bessel_Y0 .1) -1.534238651350367)
+	(num-test (gsl_sf_bessel_Y1 .1) -6.458951094702027)
+	(num-test (gsl_sf_bessel_Yn 4 .1) -305832.2979335312)
+	(num-test (gsl_sf_bessel_I0_scaled .1) 0.9071009257823011)
+	(num-test (gsl_sf_bessel_I1_scaled .1) 0.04529844680880932)
+	(num-test (gsl_sf_bessel_In_scaled 4 .1) 2.35752586200546e-07)
+	(num-test (gsl_sf_bessel_I0 .1) 1.002501562934096)
+	(num-test (gsl_sf_bessel_I1 .1) 0.05006252604709269)
+	(num-test (gsl_sf_bessel_In 4 .1) 2.605469021299657e-07)
+	(num-test (gsl_sf_bessel_K0_scaled .1) 2.682326102262894)
+	(num-test (gsl_sf_bessel_K1_scaled .1) 10.8901826830497)
+	(num-test (gsl_sf_bessel_Kn_scaled 4 .1) 530040.2483725621)
+	(num-test (gsl_sf_bessel_K0 .1) 2.427069024702016)
+	(num-test (gsl_sf_bessel_K1 .1) 9.853844780870606)
+	(num-test (gsl_sf_bessel_Kn 4 .1) 479600.2497925678)
+	(num-test (gsl_sf_bessel_j0 1.0) 0.8414709848078965)
+	(num-test (gsl_sf_bessel_j1 1.0) 0.3011686789397567)
+	(num-test (gsl_sf_bessel_j2 1.0) 0.06203505201137386)
+	(num-test (gsl_sf_bessel_jl 5 1.0) 9.256115861125814e-05)
+	(num-test (gsl_sf_bessel_zero_J0 1) 2.404825557695771)
+	(num-test (gsl_sf_bessel_zero_Jnu 5 5) 22.21779994656127)
+	(num-test (gsl_sf_hydrogenicR_1 3 2) 0.02575994825614847)
+	(num-test (gsl_sf_dilog -3.0) -1.939375420766708)
+	(let ((s1 (gsl_sf_result.make))
+	      (s2 (gsl_sf_result.make)))
+	  (gsl_sf_complex_dilog_e 0.99999 (/ pi 2) s1 s2)
+	  (num-test (gsl_sf_result.val s1) -0.2056132926277968)
+	  (num-test (gsl_sf_result.val s2) 0.9159577401813151)
+	  (free s1)
+	  (free s2))
+	(let ((s1 (gsl_sf_result.make))
+	      (s2 (gsl_sf_result.make)))
+	  (gsl_sf_complex_spence_xy_e 0.5 0.0 s1 s2)
+	  (num-test (gsl_sf_result.val s1) 0.5822405264650126)
+	  (num-test (gsl_sf_result.val s2) 0.0)
+	  (free s1)
+	  (free s2))
+	(num-test (gsl_sf_lngamma -0.1) 2.368961332728787)
+	(num-test (gsl_sf_gamma 9.0) 40320.0)
+	(num-test (gsl_sf_gammastar 9.0) 1.009298426421819)
+	(num-test (gsl_sf_gammainv -1.0) 0.0)
+	(let ((s1 (gsl_sf_result.make))
+	      (s2 (gsl_sf_result.make)))
+	  (gsl_sf_lngamma_complex_e 5.0 2.0 s1 s2)
+	  (num-test (gsl_sf_result.val s1) 2.748701756133804)
+	  (num-test (gsl_sf_result.val s2) 3.073843410049702)
+	  (free s1)
+	  (free s2))
+	(num-test (gsl_sf_taylorcoeff 10 5) 2.691144455467373)
+	(num-test (gsl_sf_choose 7 3) 35.0)
+	(num-test (gsl_sf_poch 7 3) 504.0000000000001)
+	(num-test (gsl_sf_gamma_inc_P 1.0 10.0) 0.9999546000702381)
+	(num-test (gsl_sf_lnbeta 0.1 1.0) 2.302585092994044)
+	(num-test (gsl_sf_beta 100.1 -1.2) 1203.895236907804)
+	(num-test (gsl_sf_hyperg_0F1 1 0.5) 1.56608292975635)
+	(num-test (gsl_sf_hyperg_1F1 1 1.5 1) 2.030078469278705)
+	(num-test (gsl_sf_hyperg_U_int 100 100 1) 0.009998990209084679)
+	(num-test (gsl_sf_hyperg_2F1 1 1 1 0.5) 2.0)
+	(num-test (gsl_sf_legendre_P1 -0.5) -0.5)
+	(num-test (gsl_sf_legendre_sphPlm 10 0 -0.5) -0.2433270236930014)
+	(num-test (gsl_sf_legendre_Q0 -0.5) -0.5493061443340549)
+	(num-test (gsl_sf_clausen (+ (* 2 pi) (/ pi 3))) 1.014941606409653)
+	(num-test (gsl_sf_coupling_3j 0 1 1 0 1 -1) 0.7071067811865476)
+	(num-test (gsl_sf_dawson 0.5) 0.4244363835020223)
+	(num-test (gsl_sf_multiply -3 2) -6.0)
+	(num-test (gsl_sf_ellint_E (/ pi 2) 0.5 GSL_MODE_DEFAULT) 1.467462209339427)
+	(num-test (gsl_sf_erfc -10) 2.0)
+	(num-test (gsl_sf_exp_mult 10 -2) -44052.93158961344)
+	(num-test (gsl_sf_expm1 -.001) -0.0009995001666250082)
+	(num-test (gsl_sf_Shi -1) -1.057250875375728)
+	(num-test (gsl_sf_fermi_dirac_0 -1) 0.3132616875182229)
+	(num-test (gsl_sf_gegenpoly_1 1.0 1.0) 2.0)
+
+	(let ((p (float-vector 1.0 -2.0 1.0)) (res (vector 0.0 0.0)))
+	  (gsl_poly_complex_solve (wrap-double* p) 3 res)
+	  (test res #(1.0 1.0)))
+	(let ((p (float-vector 1 -1 1 -1 1 -1 1 -1 1 -1 1)))
+	  (num-test (gsl_poly_eval (wrap-double* p) 11 1.0) 1.0))
+	(let ((p (float-vector 2.1 -1.34 0.76 0.45)))
+	  (num-test (gsl_poly_complex_eval (wrap-double* p) 4 0.49+0.95i) 0.3959142999999998-0.6433305000000001i))
+	(let ((res (float-vector 0.0 0.0)))
+	  (let ((err (gsl_poly_solve_quadratic 4.0 -20.0 26.0 (wrap-double* res))))
+	    (test err 0)))
+	(let ((res (float-vector 0.0 0.0)))
+	  (let ((err (gsl_poly_solve_quadratic 4.0 -20.0 21.0 (wrap-double* res))))
+	    (test res (float-vector 1.5 3.5))))
+	(let ((res (float-vector 0.0 0.0 0.0)))
+	  (let ((err (gsl_poly_solve_cubic -51 867 -4913 (wrap-double* res))))
+	    (test res (float-vector 17.0 17.0 17.0))))
+	(let ((res (vector 0.0 0.0)))
+	  (let ((err (gsl_poly_complex_solve_quadratic 4.0 -20.0 26.0 res)))
+	    (test res #(2.5-0.5i 2.5+0.5i))))
+	(let ((res (vector 0.0 0.0 0.0))) ; workspace handling is internal
+	  (let ((err (gsl_poly_complex_solve_cubic -51 867 -4913 res)))
+	    (test res #(17.0 17.0 17.0))))
+
+	(num-test (gsl_hypot3 1.0 1.0 1.0) (sqrt 3))
+	(num-test (gsl_hypot 1.0 1.0) (sqrt 2))
+	(test (nan? (gsl_nan)) #t)
+	(test (infinite? (gsl_posinf)) #t)
+	(test (gsl_frexp 2.0) '(0.5 2))
+	(num-test (gsl_pow_2 4) 16.0)
+
+	(num-test (gsl_cdf_ugaussian_P 0.0) 0.5)
+	(num-test (gsl_cdf_ugaussian_P 0.5) 0.691462461274013)
+	(num-test (gsl_cdf_ugaussian_Q 0.5) 0.3085375387259869)
+	(num-test (gsl_cdf_ugaussian_Pinv 0.5) 0.0)
+	(num-test (gsl_cdf_ugaussian_Qinv 0.5) 0.0)
+	(num-test (gsl_cdf_exponential_P 0.1 0.7) 0.1331221002498184)
+	(num-test (gsl_cdf_exponential_Q 0.1 0.7) 0.8668778997501816)
+	(num-test (gsl_cdf_exponential_Pinv 0.13 0.7) 0.09748344713345537)
+	(num-test (gsl_cdf_exponential_Qinv 0.86 0.7) 0.1055760228142086)
+	(num-test (gsl_cdf_exppow_P -0.1 0.7 1.8) 0.4205349082867516)
+	(num-test (gsl_cdf_exppow_Q -0.1 0.7 1.8) 0.5794650917132484)
+	(num-test (gsl_cdf_tdist_P 0.0 1.0) 0.5)
+	(num-test (gsl_cdf_tdist_Q 0.0 1.0) 0.5)
+	(num-test (gsl_cdf_fdist_P 0.0 1.0 1.3) 0.0)
+	(num-test (gsl_cdf_fdist_Q 0.0 1.0 1.3) 1.0)
+	(num-test (gsl_cdf_fdist_Pinv 0.0 1.0 1.3) 0.0)
+	(num-test (gsl_cdf_fdist_Qinv 1.0 1.0 1.3) 0.0)
+	(num-test (gsl_cdf_gamma_P 0 1 1) 0.0)
+	(num-test (gsl_cdf_gamma_Q 0 1 1) 1.0)
+	(num-test (gsl_cdf_chisq_P 0 13) 0.0)
+	(num-test (gsl_cdf_chisq_Q 0 13) 1.0)
+	(num-test (gsl_cdf_beta_P 0 1.2 1.3) 0.0)
+	(num-test (gsl_cdf_beta_Q 0 1.2 1.3) 1.0)
+
+	(when full-s7test
+	  ;; this is *very* slow!
+	  (let ((d (gsl_dht_new 128 1.0 1.0))
+		(f_in (make-float-vector 128 0.0))
+		(f_out (make-float-vector 128 0.0)))
+	    (do ((i 0 (+ i 1)))
+		((= i 128))
+	      (let ((x (gsl_dht_x_sample d i)))
+		(set! (f_in i) (* x (- 1.0 (* x x))))))
+	    (gsl_dht_apply d (wrap-double* f_in) (wrap-double* f_out))
+	    (let ((res (list (f_out 0) (f_out 5))))
+	      (gsl_dht_free d)
+	      (num-test (res 0) 0.05727421417071144)
+	      (num-test (res 1) -0.0001908501261051786))))
+
+	(num-test (gsl_stats_mean (wrap-double* (float-vector 1.0 2.0 3.0 4.0)) 1 4) 2.5)
+	(num-test (gsl_stats_skew (wrap-double* (float-vector 1.0 2.0 3.0 4.0)) 1 4) 0.0)
+	(num-test (gsl_stats_max (wrap-double* (float-vector 1.0 2.0 3.0 4.0)) 1 4) 4.0)
+
+	(let ((rng (gsl_rng_alloc gsl_rng_default)))
+	  (test (real? (gsl_ran_exponential rng 1.0)) #t)
+	  (gsl_rng_free rng))
+
+	(num-test (gsl_complex_log 1+i) (log 1+i))
+	(num-test (gsl_complex_abs 1+i) (magnitude 1+i))
+	(num-test (gsl_complex_sin 1+i) (sin 1+i))
+
+	(let ((gs (gsl_cheb_alloc 40)))
+	  (gsl_cheb_init gs (lambda (x) x) -1.0 1.0)
+	  (num-test (gsl_cheb_eval gs -1.0) -1.0)
+	  (num-test (gsl_cheb_eval gs 0.0) 0.0)
+	  (num-test (gsl_cheb_eval gs 1.0) 1.0)
+	  (gsl_cheb_free gs))
+
+	(let ((x (float-vector 0.0))
+	      (y (float-vector 0.0)))
+	  (gsl_deriv_central (lambda (x) (expt x 1.5)) 2.0 1e-8 (wrap-double* x) (wrap-double* y))
+	  (num-test (x 0) (* 1.5 (sqrt 2)))
+	  (gsl_deriv_forward (lambda (x) (expt x 1.5)) 0.0 1e-8 (wrap-double* x) (wrap-double* y))
+	  (test (< (x 0) 1e-5) #t))
+
+	(let ((f (float-vector -1 3 0 4 2 6)))
+	  (gsl_sort (wrap-double* f) 1 6)
+	  (test f (float-vector -1 0 2 3 4 6)))
+
+	(let ((g1 (gsl_vector_alloc 3))
+	      (g2 (gsl_vector_alloc 3))
+	      (f1 (make-float-vector 3)))
+	  (gsl_vector_add (float-vector->gsl_vector (float-vector 0 1 2) g1)
+			  (float-vector->gsl_vector (float-vector 3 4 5) g2))
+	  (gsl_vector->float-vector g1 f1)
+	  (gsl_vector_free g1)
+	  (gsl_vector_free g2)
+	  (test f1 (float-vector 3 5 7)))
+
+	(let ((f (make-float-vector '(3 3))))
+	  (let ((g (gsl_matrix_alloc 3 3)))
+	    (gsl_matrix_set_identity g)
+	    (do ((i 0 (+ i 1)))
+		((= i 3)
+		 (gsl_matrix_free g))
+	      (do ((j 0 (+ j 1)))
+		  ((= j 3))
+		(set! (f i j) (gsl_matrix_get g i j)))))
+	  (test (equivalent? f #2d((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))) #t))
+
+	(let ((f (make-vector '(3 3))))
+	  (let ((g (gsl_matrix_complex_alloc 3 3)))
+	    (gsl_matrix_complex_set_identity g)
+	    (gsl_matrix_complex_scale g 1+i)
+	    (do ((i 0 (+ i 1)))
+		((= i 3)
+		 (gsl_matrix_complex_free g))
+	      (do ((j 0 (+ j 1)))
+		  ((= j 3))
+		(set! (f i j) (gsl_matrix_complex_get g i j)))))
+	  (test (equivalent? f #2d((1+i 0.0 0.0) (0.0 1+i 0.0) (0.0 0.0 1+i))) #t))
+
+	(let ((Y (float-vector 0.554))
+	      (A (float-vector -0.047))
+	      (X (float-vector 0.672)))
+	  (cblas_dgemv 101 111 1 1 -0.3 (wrap-double* A) 1 (wrap-double* X) -1 -1 (wrap-double* Y) -1)
+	  (num-test (Y 0) -0.5445248))
+
+	(let ((Y (float-vector 0.348 0.07))
+	      (A (float-vector 0.932 -0.724))
+	      (X (float-vector 0.334 -0.317))
+	      (alpha (float-vector 0 .1))
+	      (beta (float-vector 1 0)))
+	  (cblas_zgemv 101 111 1 1 (wrap-double* alpha) (wrap-double* A) 1 (wrap-double* X) -1 (wrap-double* beta) (wrap-double* Y) -1)
+	  (num-test (Y 0) 0.401726)
+	  (num-test (Y 1) 0.078178))
+
+	(test (let ((f (float-vector 0 1 2 3 4))) (gsl_interp_bsearch (wrap-double* f) 1.5 0 4)) 1)
+
+	(let ((x (make-float-vector 10))
+	      (y (make-float-vector 10)))
+	  (do ((i 0 (+ i 1)))
+	      ((= i 10))
+	    (set! (x i) (+ i (* 0.5 (sin i))))
+	    (set! (y i) (+ i (cos (* i i)))))
+	  (let ((acc (gsl_interp_accel_alloc))
+		(spline (gsl_spline_alloc gsl_interp_cspline 10)))
+	    (gsl_spline_init spline (wrap-double* x) (wrap-double* y) 10)
+	    (let ((res (gsl_spline_eval spline (x 5) acc)))
+	      (gsl_spline_free spline)
+	      (gsl_interp_accel_free acc)
+	      (num-test res 5.991202811863474))))
+
+	(let ((c (gsl_combination_alloc 6 3))
+	      (data #2d((0 1 2) (0 1 3) (0 1 4) (0 1 5)
+			(0 2 3) (0 2 4) (0 2 5) (0 3 4)
+			(0 3 5) (0 4 5) (1 2 3) (1 2 4)
+			(1 2 5) (1 3 4) (1 3 5) (1 4 5)
+			(2 3 4) (2 3 5) (2 4 5) (3 4 5)))
+	      (iv (make-int-vector 3 0)))
+	  (gsl_combination_init_first c)
+	  (do ((i 0 (+ i 1)))
+	      ((= i 20))
+	    ((*libgsl* 'gsl_combination->int-vector) c iv)
+	    (if (not (equivalent? iv (data i)))
+		(format *stderr* ";gsl_combination: ~A ~A~%" iv (data i)))
+	    (gsl_combination_next c))
+	  (gsl_combination_free c))
+
+	(let ((p (gsl_permutation_alloc 3))
+	      (data (make-int-vector 18 0)))
+	  (gsl_permutation_init p)
+	  (do ((pp GSL_SUCCESS (gsl_permutation_next p))
+	       (i 0 (+ i 3)))
+	      ((not (= pp GSL_SUCCESS)))
+	    (set! (data i) (gsl_permutation_get p 0))
+	    (set! (data (+ i 1)) (gsl_permutation_get p 1))
+	    (set! (data (+ i 2)) (gsl_permutation_get p 2)))
+	  (gsl_permutation_free p)
+	  (test (equivalent? data #(0 1 2 0 2 1 1 0 2 1 2 0 2 0 1 2 1 0)) #t))
+
+	(let ((N 50))
+	  (let ((t (make-float-vector N 0.0)))
+	    (do ((i 0 (+ i 1)))
+		((= i N))
+	      (set! (t i) (/ 1.0 (* (+ i 1) (+ i 1)))))
+	    (let ((zeta_2 (/ (* pi pi) 6.0)))
+	      (let ((accel (float-vector 0.0))
+		    (err (float-vector 0.0))
+		    (w (gsl_sum_levin_u_alloc N)))
+		(gsl_sum_levin_u_accel (wrap-double* t) N w (wrap-double* accel) (wrap-double* err))
+		(num-test zeta_2 (accel 0))
+		(gsl_sum_levin_u_free w)))))
+
+	(let ((data (float-vector 0 0  1 0  1 1  0 -1)) ; complex data as rl+im coming and going
+	      (output (make-float-vector 8 0.0)))
+	  (gsl_dft_complex_forward (wrap-double* data) 1 4 (wrap-double* output))
+	  ;; = -1 in snd terminology: (cfft! (vector 0 1 1+i 0-i) 4 -1): #(2.0 0-2i 0+2i -2.0)
+	  (test (equivalent? output (float-vector 2.0 0.0  0.0 -2.0  0.0 2.0  -2.0 0.0)) #t))
+	(let ((data (float-vector 0 0  1 0  1 1  0 -1))) ; complex data as rl+im coming and going
+	  (gsl_fft_complex_radix2_forward (wrap-double* data) 1 4)
+	  (test (equivalent? data (float-vector 2.0 0.0  0.0 -2.0  0.0 2.0  -2.0 0.0)) #t))
+
+	(let ((data (make-float-vector 256))
+	      (w (gsl_wavelet_alloc gsl_wavelet_daubechies 4))
+	      (work (gsl_wavelet_workspace_alloc 256)))
+	  (do ((i 0 (+ i 1)))
+	      ((= i 256))
+	    (set! (data i) (sin (* i (/ pi 128)))))
+	  (gsl_wavelet_transform_forward w (wrap-double* data) 1 256 work)
+	  (gsl_wavelet_transform_inverse w (wrap-double* data) 1 256 work)
+	  (gsl_wavelet_free w)
+	  (gsl_wavelet_workspace_free work)
+	  data)
+
+	(let ((h (gsl_histogram_alloc 10))
+	      (data (make-int-vector 10)))
+	  (gsl_histogram_set_ranges_uniform h 0.0 1.0)
+	  (do ((i 0 (+ i 1)))
+	      ((= i 50))
+	    (gsl_histogram_increment h (random 1.0)))
+	  (do ((i 0 (+ i 1)))
+	      ((= i 10))
+	    (set! (data i) (round (gsl_histogram_get h i))))
+	  (gsl_histogram_free h)
+	  data)
+
+	(let ((a_data (float-vector 0.18 0.60 0.57 0.96  0.41 0.24 0.99 0.58  0.14 0.30 0.97 0.66  0.51 0.13 0.19 0.85))
+	      (b_data (float-vector 1 2 3 4)))
+	  (let ((m (gsl_matrix_alloc 4 4))
+		(b (gsl_vector_alloc 4)))
+	    (let ((x (gsl_vector_alloc 4))
+		  (p (gsl_permutation_alloc 4)))
+	      (do ((i 0 (+ i 1)))
+		  ((= i 4))
+		(do ((j 0 (+ j 1)))
+		    ((= j 4))
+		  (gsl_matrix_set m i j (a_data (+ j (* i 4))))))
+	      (do ((i 0 (+ i 1)))
+		  ((= i 4))
+		(gsl_vector_set b i (b_data i)))
+	      (gsl_linalg_LU_decomp m p) ; int-by-ref is internal
+	      (gsl_linalg_LU_solve m p b x)
+	      (do ((i 0 (+ i 1)))
+		  ((= i 4))
+		(set! (b_data i) (gsl_vector_get x i)))
+	      (gsl_permutation_free p)
+	      (gsl_vector_free x)
+	      (gsl_vector_free b)
+	      (gsl_matrix_free m)
+	      b_data)))
+
+	(when (>= gsl-version 1.16)
+	  (let ()
+	    (define (dofit T X y c cov)
+	      (let ((work (gsl_multifit_robust_alloc T (car (gsl_matrix_size X)) (cdr (gsl_matrix_size X)))))
+		(let ((s (gsl_multifit_robust X y c cov work)))
+		  (gsl_multifit_robust_free work)
+		  s)))
+	    (let* ((n 30)
+		   (p 2)
+		   (a 1.45)
+		   (b 3.88)
+		   (X (gsl_matrix_alloc n p))
+		   (x (gsl_vector_alloc n))
+		   (y (gsl_vector_alloc n))
+		   (c (gsl_vector_alloc p))
+		   (c_ols (gsl_vector_alloc p))
+		   (cov (gsl_matrix_alloc p p))
+		   (gv (gsl_vector_alloc p))
+		   (r (gsl_rng_alloc gsl_rng_default)))
+	      (do ((i 0 (+ i 1)))
+		  ((= i (- n 3)))
+		(let* ((dx (/ 10.0 (- n 1.0)))
+		       (ei (gsl_rng_uniform r))
+		       (xi (+ -5.0 (* i dx)))
+		       (yi (+ b (* a xi))))
+		  (gsl_vector_set x i xi)
+		  (gsl_vector_set y i (+ yi ei))))
+	      (gsl_vector_set x (- n 3) 4.7)
+	      (gsl_vector_set y (- n 3) -8.3)
+	      (gsl_vector_set x (- n 2) 3.5)
+	      (gsl_vector_set y (- n 2) -6.7)
+	      (gsl_vector_set x (- n 1) 4.1)
+	      (gsl_vector_set y (- n 1) -6.0)
+	      (do ((i 0 (+ i 1)))
+		  ((= i n))
+		(let ((xi (gsl_vector_get x i)))
+		  (gsl_matrix_set X i 0 1.0)
+		  (gsl_matrix_set X i 1 xi)))
+	      (dofit gsl_multifit_robust_ols X y c_ols cov)
+	      (dofit gsl_multifit_robust_bisquare X y c cov)
+	      (do ((i 0 (+ i 1)))
+		  ((= i n))
+		(let ((xi (gsl_vector_get x i))
+		      (yi (gsl_vector_get y i))
+		      (y_ols (float-vector 0.0))
+		      (y_rob (float-vector 0.0))
+		      (y_err (float-vector 0.0)))
+		  (gsl_vector_set gv 0 (gsl_matrix_get X i 0))
+		  (gsl_vector_set gv 1 (gsl_matrix_get X i 1))
+		  (gsl_multifit_robust_est gv c cov (wrap-double* y_rob) (wrap-double* y_err))
+		  (gsl_multifit_robust_est gv c_ols cov (wrap-double* y_ols) (wrap-double* y_err))))
+	      (gsl_matrix_free X)
+	      (gsl_matrix_free cov)
+	      (gsl_vector_free c_ols)
+	      (gsl_vector_free x)
+	      (gsl_vector_free y)
+	      (gsl_vector_free c)
+	      (gsl_vector_free gv)
+	      (gsl_rng_free r))))
+
+	(let ()
+	  (gsl_rng_env_setup)
+	  (let* ((T gsl_rng_default)
+		 (r (gsl_rng_alloc T))
+		 (x 0)
+		 (y 0)
+		 (dx (float-vector 0.0))
+		 (dy (float-vector 0.0)))
+	    (do ((i 0 (+ i 1)))
+		((= i 10))
+	      (gsl_ran_dir_2d r (wrap-double* dx) (wrap-double* dy))
+	      (set! x (+ x (dx 0)))
+	      (set! y (+ y (dy 0))))
+	    (gsl_rng_free r)))
+
+	(let ((f_size 2)
+	      (T gsl_multimin_fminimizer_nmsimplex))
+	  (define (simple-abs x)
+	    (let ((u (gsl_vector_get x 0))
+		  (v (gsl_vector_get x 1)))
+	      (let ((a (- u 1))
+		    (b (- v 2)))
+		(+ (abs a) (abs b)))))
+	  (let ((x (gsl_vector_alloc f_size))
+		(step_size (gsl_vector_alloc f_size))
+		(s (gsl_multimin_fminimizer_alloc T 2)))
+	    (gsl_vector_set x 0 1.0)
+	    (gsl_vector_set x 1 2.0)
+	    (gsl_vector_set step_size 0 1)
+	    (gsl_vector_set step_size 1 1)
+	    (gsl_multimin_fminimizer_set s simple-abs x step_size)
+	    (do ((i 0 (+ i 1)))
+		((= i 10))
+	      (gsl_multimin_fminimizer_iterate s))
+	    (let ((result (abs (gsl_multimin_fminimizer_fval s))))
+	      (gsl_multimin_fminimizer_free s)
+	      (gsl_vector_free x)
+	      (gsl_vector_free step_size)
+	      (num-test result 0.0))))
+
+	(let ((n 4)
+	      (x (float-vector 1970 1980 1990 2000))
+	      (y (float-vector 12 11 14 13))
+	      (w (float-vector 0.1 0.2 0.3 0.4))
+	      (c0 (float-vector 0.0))
+	      (c1 (float-vector 0.0))
+	      (cov00 (float-vector 0.0))
+	      (cov01 (float-vector 0.0))
+	      (cov11 (float-vector 0.0))
+	      (chisq (float-vector 0.0)))
+	  (gsl_fit_wlinear (wrap-double* x) 1 (wrap-double* w) 1 (wrap-double* y) 1 n
+			   (wrap-double* c0) (wrap-double* c1) (wrap-double* cov00) (wrap-double* cov01) (wrap-double* cov11) (wrap-double* chisq))
+	  (num-test (+ (c0 0) (c1 0)) -106.54))
+
+	(let ((c (gsl_multiset_calloc 4 2)))
+	  (test (list (gsl_multiset_n c) (gsl_multiset_k c)) '(4 2))
+	  (gsl_multiset_free c))
+
+	(let ((x (gsl_vector_alloc 2))
+	      (factor 1.0)
+	      (T gsl_multiroot_fsolver_dnewton))
+	  (define (rosenb x f)
+	    (let ((x0 (gsl_vector_get x 0))
+		  (x1 (gsl_vector_get x 1)))
+	      (let ((y0 (- 1 x0))
+		    (y1 (* 10 (- x1 (* x0 x0)))))
+		(gsl_vector_set f 0 y0)
+		(gsl_vector_set f 1 y1)
+		GSL_SUCCESS)))
+	  (gsl_vector_set x 0 -1.2)
+	  (gsl_vector_set x 1 1.0)
+	  (let ((s (gsl_multiroot_fsolver_alloc T 2)))
+	    (gsl_multiroot_fsolver_set s rosenb x)
+	    (do ((i 0 (+ i 1)))
+		((= i 10))
+	      (gsl_multiroot_fsolver_iterate s))
+	    (let ((residual (abs (gsl_vector_get (gsl_multiroot_fsolver_f s) 0))))
+	      (gsl_multiroot_fsolver_free s)
+	      (gsl_vector_free x)
+	      (test residual 0.0))))
+	))))
+
+#|
+;;; test of local autoload from johnm (no good way to test this here -- maybe set up a dummy library?):
+(autoload 'gsl_integration_qags "libgsl.scm")
+(autoload 'gsl_integration_workspace_alloc "libgsl.scm")
+(autoload 'gsl_integration_workspace_free "libgsl.scm")
+(autoload 'double* "libgsl.scm")
+
+(define (integrate f)
+  (let ((workspace (gsl_integration_workspace_alloc 1000)))
+    (gsl_integration_workspace_free workspace)))
+
+(define (f x)
+ (/ (log x) (sqrt x)))
+
+(test (integrate f) #<unspecified>)
+(test (integrate f) #<unspecified>) ; this call is not redundant
+|#
+
+(test (defined? 'CLOCKS_PER_SEC (rootlet)) #f) ; autoloader can cause endless confusion here!
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; libgdbm
+
+(when (and (provided? 'linux)
+	   (provided? 'system-extras)
+	   (or (file-exists? "/usr/local/lib/libgdbm.a")
+	       (file-exists? "/usr/lib/x86_64-linux-gnu/libgdbm.a")))
+  (let ()
+    (require libgdbm.scm)
+    (when (and (defined? '*libgdbm*)
+	       (procedure? (*libgdbm* 'gdbm_store)))
+      (with-let (sublet *libgdbm*)
+	(let ((gfile (gdbm_open "test.gdbm" 1024 GDBM_NEWDB #o664 (lambda (str) (format *stderr* "str: ~S~%" str)))))
+	  (gdbm_store gfile "1" "1234" GDBM_REPLACE)
+	  (gdbm_fetch gfile "1")
+	  (gdbm_close gfile))
+
+	(define *db*
+	  (openlet
+	   (inlet :file (gdbm_open "test.gdbm" 1024 GDBM_NEWDB #o664
+				   (lambda (str) (format *stderr* "gdbm error: ~S~%" str)))
+
+		  :let-ref-fallback (lambda (obj sym)
+				      (with-input-from-string
+					  (gdbm_fetch (obj 'file) (symbol->string sym))
+					(lambda () (eval (read)))))
+
+		  :let-set-fallback (lambda (obj sym val)
+				       (gdbm_store (obj 'file)
+						   (symbol->string sym)
+						   (object->string val :readable)
+						   GDBM_REPLACE)
+				       val)
+
+		  :make-iterator (lambda (obj)
+				   (let ((key #f)
+					 (length (lambda (obj) (expt 2 20))))
+				     (#_make-iterator
+				      (openlet
+				       (let ((+iterator+ #t))
+					 (lambda ()
+					   (if key
+					       (set! key (gdbm_nextkey (obj 'file) (cdr key)))
+					       (set! key (gdbm_firstkey (obj 'file))))
+					   (if (pair? key)
+					       (cons (string->symbol (car key))
+						     (with-input-from-string
+							 (gdbm_fetch (obj 'file) (car key))
+						       (lambda () (eval (read)))))
+					       key))))))))))
+
+	(set! (*db* 'str) "123") ; add a variable named 'hi with the value "123"
+	(test (*db* 'str) "123")
+	(set! (*db* 'int) 432)
+	(test (*db* 'int) 432)
+	(test (with-let *db* (+ int (length str))) 435)
+	(test (let ((lst (map values *db*)))
+		(or (equal? lst '((str . "123") (int . 432)))
+		    (equal? lst '((int . 432) (str . "123")))))
+	      #t)
+
+	(gdbm_close (*db* 'file))))))
+
+
+;;; --------------------------------------------------------------------------------
+;;; libutf8proc (now moved to utf8-tests.scm)
+  (when (and full-s7test (provided? 'system-extras) (not (provided? 'osx)) (file-exists? "utf8-tests.scm"))
+    (load "utf8-tests.scm"))
+;;; --------------------------------------------------------------------------------
+
+(test (procedure? (symbol->value-anywhere 'getchar)) #t)
+(test (integer? (symbol->value-anywhere 'GSL_SUCCESS)) #t)
+(test (integer? (symbol->value-anywhere 'most-positive-fixnum)) #t)
+
+(test (let? (cdr (assoc "libc.scm" *libraries*))) #t)
+
+;;; regex
+(let ()
+  (require libc.scm)
+
+  (test (with-let (sublet *libc*)
+    (define rg (regex.make))
+    (regcomp rg "a.b" 0)
+    (let ((res (regexec rg "acb" 0 0))) ; 0 = match
+      (regfree rg)
+      (regex.free rg)
+      res))
+    0)
+
+  (unless (provided? 'osx)
+    (test (with-let (sublet *libc*)
+	    (define rg (regex.make))
+	    (let ((res (regcomp rg "colou\\?r" 0)))
+	      (if (not (zero? res))
+		  (error 'regex-error "~S: ~S~%" "colou\\?r" (regerror res rg)))
+	      (set! res (regexec rg "The color green" 1 0))
+	      (if (and (integer? res)
+		       (not (zero? res)))
+		  (error 'regex-error "~S: ~S~%" "colou\\?r" (regerror res rg)))
+	      (regfree rg)
+	      (regex.free rg)
+	      res))
+	  #i(4 9))
+
+    (test (with-let (sublet *libc*)
+	    (define rg (regex.make))
+	    (let ((res (regcomp rg "\\(ba\\(na\\)*s \\|nefer\\(ti\\)* \\)*" 0)))
+	      (if (not (zero? res))
+		  (error 'regex-error "~S~%" (regerror res rg)))
+	      (set! res (regexec rg "bananas nefertiti" 3 0))
+	      (if (and (integer? res)
+		       (not (zero? res)))
+		  (error 'regex-error "~S~%" (regerror res rg)))
+	      (regfree rg)
+	      (regex.free rg)
+	      res))
+	  #i(0 8 0 8 4 6)))
+
+  (test (procedure? (*libc* 'memcpy)) #t)
+  (test ((rootlet) 'memcpy) #<undefined>)
+  (test (with-let (rootlet) memcpy) 'error)
+  (test (procedure? (with-let *libc* memcpy)) #t))
+
+
+;;; -------------------------------- case.scm --------------------------------
+(let ()
+  (require case.scm)
+  (define (scase x)
+    (case* x
+      ((a b) 'a-or-b)
+      ((1 2/3 3.0) => (lambda (a) (* a 2)))
+      ((pi) 1 123)
+      (("string1" "string2"))
+      ((#<symbol?>) 'symbol!)
+      (((+ x #<symbol?>)) 'got-list)
+      ((#(1 x 3)) 'got-vector)
+      (((+ #<>)) 'empty)
+      (((* #<x:symbol?> #<x>)) 'got-label)
+      (((#<> #<x:> #<x>)) 'repeated)
+      (((#<symbol?> #<symbol?>)) 'two)
+      (((#<x:> #<x>)) 'pair)
+      ((#(#<x:> #<x>)) 'vector)
+      ((#(#<symbol?> #<...> #<number?>)) 'vectsn)
+      ((#(#<...> #<number?>)) 'vectstart)
+      ((#(#<string?> #<char-whitespace?> #<...>)) 'vectstr)
+      (else 'oops)))
+
+  (test (scase 3.0) 6.0)
+  (test (scase 'pi) 123)
+  (test (scase "string1") "string1")
+  (test (scase "string3") 'oops)
+  (test (scase 'a) 'a-or-b)
+  (test (scase 'abc) 'symbol!)
+  (test (scase #()) 'oops)
+  (test (scase '(+ x z)) 'got-list)
+  (test (scase #(1 x 3)) 'got-vector)
+  (test (scase '(+ x 3)) 'oops)
+  (test (scase '(+ x)) 'empty)
+  (test (scase '(* z z)) 'got-label)
+  (test (scase '(* z x)) 'oops)
+  (test (scase '(+ (abs x) (abs x))) 'repeated)
+  (test (scase '(+ (abs x) (abs y))) 'oops)
+  (test (scase '(a b)) 'two)
+  (test (scase '(1 1)) 'pair)
+  (test (scase '(1 1 2)) 'oops)
+  (test (scase #(1 1)) 'vector)
+  (test (scase #(a b c 3)) 'vectsn)
+  (test (scase #(1 b 2)) 'vectstart)
+  (test (scase #("asdf" #\space +nan.0 #<eof>)) 'vectstr)
+  (test (scase #(a 3)) 'vectsn)
+  (test (scase #(1)) 'vectstart)
+  (test (scase #("asdf" #\space)) 'vectstr)
+  (test (scase #("asdf")) 'oops)
+
+  (define (scase5 x)
+    (case* x
+      (((#<symbol?> #<...> #<symbol?>)) 'ok)))
+  (test (scase5 '(a)) #<unspecified>)
+
+  (let ((local-func (lambda (key) (eqv? key 1))))
+    (define (scase1 x)
+      (case* x
+	((2 3 a) 'oops)
+	((#<local-func>) 'yup)))
+    (test (scase1 2) 'oops)
+    (test (scase1 32) #<unspecified>)
+    (test (scase1 1) 'yup))
+
+  (define scase2
+    (let ((local-func (lambda (key) (eqv? key 1))))
+      (lambda (x)
+	(case* x
+	  ((2 3 a) 'oops)
+	  ((#<local-func>) 'yup)))))
+  (test (scase2 2) 'oops)
+  (test (scase2 32) #<unspecified>)
+  (test (scase2 1) 'yup)
+
+  (define (scase3 x)
+    (let ((local-func (lambda (key) (eqv? key 1))))
+      (case* x
+	((2 3 a) 'oops)
+	((#<local-func>) 'yup))))
+  (test (scase3 2) 'oops)
+  (test (scase3 32) #<unspecified>)
+  (test (scase3 1) 'yup)
+
+  (define (scase4 x)
+    (let ((local-func (lambda (key) (eqv? key 1))))
+      (case* x
+	((2 3 a) 'oops)
+	((#<local-func) 'yup)))) ; deliberate spelling error
+  (test (catch #t (lambda () (scase4 1)) (lambda (type info) type)) 'wrong-type-arg)
+
+  (define (ecase x)
+    (case* x
+      (((#<symbol?> #<...> #<symbol?>)) 'both-symbol)
+      (((#<symbol?> #<...>)) 'car-symbol)
+      (((#<...> #<symbol?> #<symbol?>)) 'two-symbols)
+      (((#<...> #<symbol?>)) 'end-symbol)
+      (else #f)))
+
+  (test (ecase '(a b 1)) 'car-symbol)
+  (test (ecase '(1 2 c)) 'end-symbol)
+  (test (ecase '(a 1 2 3 c)) 'both-symbol)
+  (test (ecase '(1 2 3 b c)) 'two-symbols)
+
+  (define (scase6 x)
+    (case* x
+      (((#<x:> #<x> #<...>)) 'ok)
+      (else 'oops)))
+  (test (scase6 '(a a)) 'ok)
+
+  (define (scase7 x)
+    (case* x
+      (((#<...> #<x:> #<x>)) 'ok)
+      (else 'oops)))
+  (test (scase7 '(a a)) 'ok)
+
+  (define (scase8 x)
+    (case* x
+      (((#<x:> #<...> #<x>)) 'ok)
+      (else 'oops)))
+  (test (scase8 '(a a)) 'ok)
+
+  (define (scase10 x)
+    (case* x
+      ((#<x>) 1)
+      (else 'oops)))
+  (test (scase10 1) 'oops)
+
+  (define (scase11 x)
+    (case* x
+      ((#<...>) 1)
+      (else 'oops)))
+  (test (scase11 1) 'oops)
+
+  (define (scase12 x)
+    (case* x
+      (((#<y:> #<zzz>)) 1)
+      (else 'oops)))
+  (test (catch #t (lambda () (scase12 '(1 2))) (lambda (type info) type)) 'unbound-variable)
+
+  (define (scase13 x)
+    (case* x
+      ((#<>) 'ok) ; matches anything! as does #<label:>
+      (else 'oops)))
+  (test (scase13 '(a a)) 'ok)
+  (test (scase13 1+i) 'ok)
+  (test (scase13 #(1 2 3)) 'ok)
+
+  (define (scase14 x)
+    (case* x
+      (((#<y:> #<y:>)) 1)
+      (else 'oops)))
+  (test (catch #t (lambda () (scase14 '(1 1))) (lambda (type info) type)) 'syntax-error) ; duplicate identifier currently uses this error type
+
+  (define uniquify
+    (let ()
+      (define (uniq-1 lst new-lst)
+	(case* lst
+          ((())
+	   (reverse new-lst))
+	  (((#<>))
+	   (reverse (cons (car lst) new-lst)))
+	  (((#<x:> #<x> #<...>))
+	   (uniq-1 (cdr lst) new-lst))
+	  (else
+	   (uniq-1 (cdr lst) (cons (car lst) new-lst)))))
+      (lambda (lst)
+	(uniq-1 lst ()))))
+
+  (test (uniquify '(a a b b b b a a c c)) '(a b a c))
+  (test (uniquify '((+ a 1) (+ a 1) (* b 2) (* b 2) c a a)) '((+ a 1) (* b 2) c a))
+  (test (uniquify '(a b b c)) '(a b c))
+  (test (uniquify '(a)) '(a))
+  (test (uniquify ()) ())
+
+  (let ((x '(+ 2 3)))
+    (test (case* x
+	    (((+ #<> #<>)) (apply + (cdr x)))
+	    (else (error 'out-of-range "unimplemented")))
+	  5))
+
+  (test (case* '(a b a) (((#<start:...> #<symbol?>)) #<start>)) '(a b))
+  (test (case* '(a) (((#<start:...> #<symbol?>)) #<start>)) ())
+  (test (case* '(a b) (((#<start:...> #<symbol?>)) #<start>)) '(a))
+  (test (case* '(a b a) (((#<symbol?> #<end:...>)) #<end>)) '(b a))
+  (test (case* '(a) (((#<symbol?> #<end:...>)) #<end>)) ())
+  (test (case* '(a b) (((#<symbol?> #<end:...>)) #<end>)) '(b))
+  (test (case* '(a b a) (((#<symbol?> #<middle:...> #<symbol?>)) #<middle>)) '(b))
+  (test (case* '(a a) (((#<symbol?> #<middle:...> #<symbol?>)) #<middle>)) ())
+  (test (case* '(a b c a) (((#<symbol?> #<middle:...> #<symbol?>)) #<middle>)) '(b c))
+
+  (test (case* #(a b a) ((#(#<start:...> #<symbol?>)) #<start>)) '(a b))
+  (test (case* #(a) ((#(#<start:...> #<symbol?>)) #<start>)) ())
+  (test (case* #(a b) ((#(#<start:...> #<symbol?>)) #<start>)) '(a))
+  (test (case* #(a b a) ((#(#<symbol?> #<end:...>)) #<end>)) '(b a))
+  (test (case* #(a) ((#(#<symbol?> #<end:...>)) #<end>)) ())
+  (test (case* #(a b) ((#(#<symbol?> #<end:...>)) #<end>)) '(b))
+  (test (case* #(a b a) ((#(#<symbol?> #<middle:...> #<symbol?>)) #<middle>)) '(b))
+  (test (case* #(a a) ((#(#<symbol?> #<middle:...> #<symbol?>)) #<middle>)) ())
+  (test (case* #(a b c a) ((#(#<symbol?> #<middle:...> #<symbol?>)) #<middle>)) '(b c))
+
+  (define (palindrome? x) ; x can be a list or a vector
+    (case* x
+      ((() (#<>)
+	#() #(#<>))
+       #t)
+      (((#<x:> #<middle:...> #<x>)
+	#(#<x:> #<middle:...> #<x>))
+       (palindrome? #<middle>))
+      (else #f)))
+
+  (test (palindrome? '(a b a)) #t)
+  (test (palindrome? '(a b c a)) #f)
+  (test (palindrome? '(a b c b a)) #t)
+  (test (palindrome? '(a)) #t)
+  (test (palindrome? ()) #t)
+
+  (test (palindrome? #(a b a)) #t)
+  (test (palindrome? #(a b c a)) #f)
+  (test (palindrome? #(a b c b a)) #t)
+  (test (palindrome? #(a)) #t)
+  (test (palindrome? #()) #t)
+
+  (define (scase15 x)
+    (case* x
+      (((+ #<x:> #<x>)) (* 2 #<x>))
+      (((#<x:> #<y:>)) (list #<y> #<x>))
+      (else 'oops)))
+  (test (scase15 '(1 2)) '(2 1))
+  (test (scase15 '(+ 1 1)) 2)
+  (test (scase15 '(+ (* 2 3) (* 2 3))) 12)
+
+  (define (scase16 x)
+    (case* x
+      (((+ (* #<symbol?> 2) 3)) 0)
+      (else 1)))
+  (test (scase16 '(+ (* y 2) 3)) 0)
+  (test (scase16 '(+ (* y 1) 3)) 1)
+
+  (define (scase17 x)
+    (let ((a1 3))
+      (case* x
+	(((+ #<add1:symbol?> (* #<mul1:number?> 2))) (+ #<mul1> (* #<add1> 2)))
+	(else 'oops))))
+  (test (scase17 '(+ a1 (* 5 2))) 11)
+
+  (let ((a1 3))
+    (define (scase18 x)
+      (case* x
+	(((+ #<add1:symbol?> (* #<mul1:number?> 2))) (quote (+ #<mul1> (* #<add1> 2))))
+	(else 'oops)))
+    (test (eval (scase18 '(+ a1 (* 5 2)))) 11))
+
+  (define (scase19 x)
+    (case* x
+      (((#<integer?> . #<symbol?>)) 'ok)
+      (else #f)))
+  (test (scase19 (cons 1 'a)) 'ok)
+  (test (scase19 (list 1 'a)) #f)
+
+  (define (scase20 x)
+    (case* x
+     ((#(+ (* #<symbol?> 2) 3)) 0)
+     (else 1)))
+  (test (scase20 #(+ (* y 2) 3)) 0)
+  (test (scase20 #(+ (* y 1) 3)) 1)
+
+  (define (scase21 x)
+    (let ((pair2? (lambda (p)
+		    (= (length p) 2))))
+      (case* x
+        (((+ #<pair2?> 3)) #t)
+        (else #f))))
+  (test (scase21 '(+ (abs x) 3)) #t)
+  (test (scase21 '(+ (* 2 x) 3)) #f)
+
+  (define (scase22 x)
+    (letrec ((symbols?
+	      (lambda (x)
+	        (or (null? x)
+		    (and (pair? x)
+		         (symbol? (car x))
+			 (symbols? (cdr x)))))))
+    (case* x
+      ((#<symbols?>) #t)
+      (else #f))))
+  (test (scase22 '(+ a b c)) #t)
+  (test (scase22 '(+ a b 3))#f)
+
+  (define (scase23 x)
+    (let ((numeric-op? (lambda (x)
+		         (let ((func (symbol->value x)))
+		  	   (and (signature func)
+			        (memq (car (signature func)) '(number? complex? real? float? rational? integer? byte?)))))))
+      (case* x
+        (((#<numeric-op?> #<number?>)
+	  (#<numeric-op?> #<number?> #<number?>)) #t)
+        (else #f))))
+  (test (scase23 '(+ 1 2)) #t)
+  (test (scase23 '(floor 32.1)) #t)
+  (test (scase23 '(abs)) #f)
+
+  (define (case-reverse x) ; maybe the least efficient reverse ever
+    (case* x
+      (((#<>) ()) x)
+      (((#<first:> #<rest:...>))
+       (append (case-reverse #<rest>)
+	       (list (quote #<first>))))))
+  (test (case-reverse '(a b c)) '(c b a))
+  (test (case-reverse '(a b)) '(b a))
+
+  (define (scase24 x)
+    (case* x
+      (((+ #<rest:...>))
+       (+ (apply values #<rest>)))
+      (else 'oops)))
+  (test (scase24 '(+ 1 2 3)) 6)
+  (test (let ((a 1) (b 2) (c 3)) (scase24 `(+ ,a ,b ,c))) 6)
+
+  (define (scase25 x)
+    (case* x
+      (((#<symbol?> #<ellip1:...> (+ #<ellip2:...>))) (append #<ellip1> #<ellip2>))
+      (else #f)))
+  (test (scase25 '(a b c d (+ 1 2))) '(b c d 1 2))
+
+  (define (scase26 x)
+    (case* x
+      (((if (not #<test:>) (begin #<body:...>))) (cons 'unless (cons '#<test> #<body>)))
+      (((if (not #<test:>) #<body:>)) (cons 'unless (list '#<test> '#<body>)))
+      (((if #<test:> (begin #<body:...>))) (cons 'when (cons '#<test> #<body>)))
+      (((if #<test:> #<body:>)) (cons 'when (list '#<test> '#<body>)))))
+  (test (scase26 '(if (not (> i 3)) (display i)))                   '(unless (> i 3) (display i)))
+  (test (scase26 '(if (not (> i 3)) (begin (display i) (newline)))) '(unless (> i 3) (display i) (newline)))
+  (test (scase26 '(if (> i 3) (display i)))                         '(when (> i 3) (display i)))
+  (test (scase26 '(if (> i 3) (begin (display i) (newline))))       '(when (> i 3) (display i) (newline)))
+
+  (define (scase27 x)
+    (let ((efunc? (lambda (x)
+ 		    (and (pair? x)
+		         (number? (car x))))))
+      (case* x
+        (((#<label,efunc?:...>)) #t)
+        (else #f))))
+  (test (scase27 '(1 2 3)) #t)
+  (test (scase27 '(a 2 3)) #f)
+  (test (scase27 '(3)) #t)
+  (test (scase27 ()) #f)
+
+  (define (scase29 x)
+    (let ((match? ((funclet 'case*) 'case*-match?)))
+      (let ((multiplier? (lambda (x)
+			   (or (match? x '(* 1 #<integer?>))
+			       (match? x '(* 2 #<integer?>))))))
+      (case* x
+        (((+ #<integer?> #<multiplier?> #<integer?>)) #t)
+        (else #f)))))
+
+  (test (scase29 '(+ 1 (* 1 2) 3)) #t)
+  (test (scase29 '(+ 1 (* 3 2) 3)) #f)
+
+  (define (scase30 x)
+    (let ((match? ((funclet 'case*) 'case*-match?)))
+      (match? x '(+ #<symbol?> 1))))
+
+  (test (scase30 '(+ a 1)) #t)
+  (test (scase30 '(+ 1 1)) #f)
+
+  (define* (scase31 x (e (curlet)))
+    (let ((match? ((funclet 'case*) 'case*-match?))
+          (labels ((funclet 'case*) 'case*-labels)))
+      (and (match? x '(#<symbol?> #<ellip1:...> (+ #<ellip2:...>)))
+           (append (cadr (labels 'ellip1)) (cadr (labels 'ellip2))))))
+
+  (test (scase31 '(a b c d (+ 1 2))) '(b c d 1 2))
+
+  (define (scase32 x)
+    (let ((match? ((funclet 'case*) 'case*-match?))
+          (labels ((funclet 'case*) 'case*-labels)))
+      (if (match? x '(if #<test:> (begin #<body:...>)))
+	  (cons 'when (cons (labels 'test) (cadr (labels 'body)))))))
+
+  (test (scase32 '(if (> i 3) (begin (display i) (newline)))) '(when (> i 3) (display i) (newline)))
+  (test (scase32 '(if 32/15 (begin (display i) (newline)))) '(when 32/15 (display i) (newline)))
+
+  (test (let ((match? ((funclet 'case*) 'case*-match?)))
+	  (match? (make-list 256 1) (let ((<1> (list #f))) (set-cdr! <1> <1>) (let ((<L> (list #f #f))) (set-cdr! (cdr <L>) <1>) <L>))))
+	'error) ; cyclic pattern
+
+  (define (scase33 x)
+    (case* x
+      ((#<"a.b">) #t)
+      (else #f)))
+
+  (test (scase33 "a1b") #t)
+  (test (scase33 "abc") #f)
+  (test (scase33 "a123b") #f)
+  (test (scase33 'a1b) #f)
+
+  (define (scase34 x)
+    (case* x
+      ((#<reg:"a.b">) #<reg>)
+      (else #f)))
+
+  (test (scase34 "a1b") "a1b")
+
+  (define (scase35 x)
+    (let ((quotes? (lambda (x)
+		     (char-position #\" x))))
+      (case* x
+        ((#<"^dog">)         'dog0)
+        ((#<"gray\|grey">)   'graey) ; basic regex so it needs \
+        ((#<"h\(a\|e\)y">)   'haey)
+        ((#<"p[ae]y">)       'paey)
+        ((#<"b[aeiou]bble">) 'bxbble)
+        ((#<"z\{3,6\}">)     'zzz)
+        ((#<"\d">)           'digit)
+        ((#<"<>">)           'brackets)
+        ((#<quotes?>)        'quotes)
+        ((#<"[^i*&2@]">)     'not-i)
+        (else #f))))
+
+  (test (scase35 "dog") 'dog0)
+  (test (scase35 "i7+") 'not-i)
+  (unless (provided? 'osx)
+    (test (scase35 "gray") 'graey)
+    (test (scase35 "hay") 'haey))
+  (test (scase35 "pay") 'paey)
+  (test (scase35 "bubble") 'bxbble)
+  (test (scase35 "ab0d") 'digit)
+  (test (scase35 "+-<>-+") 'brackets)
+  (test (scase35 "zzzz") 'zzz)
+  (test (scase35 (string #\a #\")) 'quotes)
+
+  (define (scase36 x)
+    (case* x
+      (((equal? #<reg:"a.b"> #<reg>)) #t)
+      (else #f)))
+
+  (test (scase36 '(equal? "a1b" "a1b")) #t)
+  (test (scase36 '(equal? "a1b" "a2b")) #f)
+
+  (define match-lambda
+    (let* ((match? ((funclet 'case*) 'case*-match?))
+	   (labels ((funclet 'case*) 'case*-labels))
+	   (match-lambda-helper
+	    (lambda (arg)
+	      (cond ((null? arg) ())
+		    ((match? arg '(+ #<a:> (+ #<b:...>))) (apply + (labels 'a) (cadr (labels 'b))))
+		    ((match? arg '(+ #<> #<>)) (apply + (cdr arg)))
+		    (else #f)))))
+      (macro (arg)
+        `(((funclet 'match-lambda) 'match-lambda-helper) ',arg))))
+
+  (test (match-lambda ()) ())
+  (test (match-lambda (+ 1 2)) 3)
+  (test (match-lambda (+ 1 (+ 2 3))) 6)
+
+  (define match+
+    (let* ((match? ((funclet 'case*) 'case*-match?))
+	   (labels ((funclet 'case*) 'case*-labels)))
+      (macro (arg)
+        (cond ((null? arg) ())
+	      ((match? arg '(+ #<a:> (+ #<b:...>))) `(+ ,(labels 'a) ,@(cadr (labels 'b))))
+	      ((match? arg '(+ #<> #<>)) `(+ ,@(cdr arg)))
+	      (else #f)))))
+
+  (test (match+ ()) ())
+  (test (match+ (+ 1 2)) 3)
+  (test (match+ (+ 1 (+ 2 3))) 6)
+
+  (define (scase37 x)
+    (case* x
+	   ((#<undefined>) 'undef)
+	   ((#<unspecified>) 'unspec)
+	   ((#<...>) 'ellipsis)
+	   (((#<a:> 3)) '(label3 #<a>))
+	   ((#<a:>) '(alabel #<a>))
+	   (else #f)))
+
+  (test (scase37 #<undefined>) 'undef)
+  (test (scase37 #<unspecified>) 'unspec)
+  (test (scase37 #<bignum:32>) '(alabel #<bignum:32>))
+  (test (scase37 #<b>) '(alabel #<b>))
+  (test (scase37 #<...>) 'ellipsis)
+  (test (scase37 '(#<a:> 3)) '(label3 #<a>))
+  (test (scase37 '(#<> 3)) '(label3 #<>))
+
+  (define (hlt x)
+    (case* (with-input-from-string (object->string x) read)
+      (((hash-table 'a #<integer?>)) 'hash-table)
+      (((inlet 'a #<integer?>)) 'inlet)
+      (else #f)))
+
+  (test (hlt (inlet 'a 1)) 'inlet)
+  (test (hlt (hash-table 'a 1)) 'hash-table)
+
+  (test (case* 32 ((1 2) 3)) #<unspecified>)
+  (test (case* 32 ((a 32))) 32)
+  (test (case* 32 ((1 32) => (lambda (x) (+ x 1)))) 33)
+
+  (define (fcase1 x)
+    (case* x
+      ((#<zero?>) "0")
+      ((#<integer?>)
+       (case* x
+         ((1) "1")
+         ((#<negative?>) "-")
+         ((#<positive?>) "+")
+         (else "oops")))
+      (else "?")))
+
+  (test (fcase1 0) "0")
+  (test (fcase1 1) "1")
+  (test (fcase1 2) "+")
+  (test (fcase1 -1) "-")
+  (test (fcase1 1+i) "?")
+
+  (define fcase2
+    (let ()
+      (define (is-zero x)
+        (zero? x))
+      (define (is-integer x)
+        (case* x
+  	  ((1) "1")
+  	  ((#<negative?>) "-")
+  	  ((#<positive?>) "+")
+  	  (else "oops")))
+      (lambda (x)
+        (case* x
+  	  ((#<is-zero>) "0")
+  	  ((#<integer?>) (is-integer x))
+  	  (else "?")))))
+
+  (test (fcase2 0) "0")
+  (test (fcase2 1) "1")
+  (test (fcase2 2) "+")
+  (test (fcase2 -1) "-")
+  (test (fcase2 1+i) "?")
+ )
+
+
+;;; --------------------------------------------------------------------------------
+
+(set! (*s7* 'print-length) 1024)
+
+(define need-lint-line-numbers #f)
+;(let ()
+  (require lint.scm)
+  (set! *report-repeated-code-fragments* #f)
+  (set! *report-combinable-lets* #t)
+  (set! *report-splittable-lets* #t)
+  (set! (setter /) #f)      ; clear stuff from above
+
+  (define lint-test
+    (letrec ((no-lines
+	      (lambda (s)
+		(let* ((pos (string-position "(line " s))
+		       (epos (and pos (string-position "): " s (+ pos 1))))) ; might be "):" unrelated to (line...)!
+		  (if (and pos epos)
+		      (no-lines (string-append (substring s 0 (- pos 1)) (substring s (+ epos 1)))) ; sometimes there are two "(line ...)" intrusions
+		      s)))))
+      (lambda (str1 str2)
+	;(format *stderr* "str1: ~A~%" str1)
+	(let ((result (call-with-output-string
+		       (lambda (op)
+			 (call-with-input-string str1
+			   (lambda (ip)
+			     (lint ip op)))))))
+	  (unless (string-wi=? result str2)
+	    (set! result (no-lines result))
+	    (unless (string-wi=? result str2)
+	      (format *stderr* ";~D (lint ~S) ->~%    ~S~%    ~S~%~%" (port-line-number) str1 str2 result)))))))
+
+  (lint-test "(+ 1 2)"			" +: perhaps (+ 1 2) -> 3")
+  (lint-test "(+ 1 (+ 2 3))"		" +: perhaps (+ 1 (+ 2 3)) -> 6")
+  (lint-test "(+ 1 (+ x 3))"		" +: perhaps (+ 1 (+ x 3)) -> (+ 4 x)")
+  (lint-test "(+ x)"			" +: perhaps (+ x) -> x")
+  (lint-test "(+ (+ (+ x 2) 3) 4)"	" +: perhaps (+ (+ (+ x 2) 3) 4) -> (+ 9 x)")
+  (lint-test "(+ 1 2 x -3)"		" +: perhaps (+ 1 2 x -3) -> x")
+  (lint-test "(+ 1/2 -1/2)"		" +: perhaps (+ 1/2 -1/2) -> 0")
+  (lint-test "(+ 1/3 2/3)"		" +: perhaps (+ 1/3 2/3) -> 1")
+  (lint-test "(+ (log x) (log 3))"	" +: perhaps (+ (log x) (log 3)) -> (log (* x 3))")
+  (lint-test "(+ x 0 (+ 0 0))"		" +: perhaps (+ x 0 (+ 0 0)) -> x")
+  (lint-test "(+ x #(a))"		" +: in (+ x #(a)), +'s second argument should be a number, but #(a) is a vector?")
+  (lint-test "(+ x 2.0 -2)"		" +: perhaps (+ x 2.0 -2) -> (inexact (* x 1))")
+  (lint-test "(+ x (+ y z) (+ a b))"    " +: perhaps (+ x (+ y z) (+ a b)) -> (+ x y z a b)")
+  (lint-test "(+ (- x) y)"              " +: perhaps (+ (- x) y) -> (- y x)")
+  (lint-test "(+ x (- y))"              " +: perhaps (+ x (- y)) -> (- x y)")
+  (lint-test "(+ x (+ y 2) (+ z 3))"	" +: perhaps (+ x (+ y 2) (+ z 3)) -> (+ 5 x y z)")
+  (lint-test "(+ 1 (* 2 (+ x)) (+ y z))" " +: perhaps (+ 1 (* 2 (+ x)) (+ y z)) -> (+ 1 (* 2 x) y z)")
+  (lint-test "(+ x (- y) (- a b) w)"    " +: perhaps (+ x (- y) (- a b) w) -> (- (+ w a x) y b)")
+  (lint-test "(+ x (- 1))"		" +: perhaps (+ x (- 1)) -> (- x 1)")
+  (lint-test "(+ -1 x)"                 " +: perhaps (+ -1 x) -> (- x 1)")
+  (lint-test "(+ x -1)"                 " +: perhaps (+ x -1) -> (- x 1)")
+  (lint-test "(+ (/ a b) (/ c b))"      " +: perhaps (+ (/ a b) (/ c b)) -> (/ (+ a c) b)")
+  (lint-test "(+ (/ a b d) (/ c b d))"  " +: perhaps (+ (/ a b d) (/ c b d)) -> (/ (+ a c) b d)")
+  (lint-test "(+ (* a b) (* c a))"      " +: perhaps (+ (* a b) (* c a)) -> (* a (+ b c))")
+  (lint-test "(+ x (- (+ y z) w))"      " +: perhaps (+ x (- (+ y z) w)) -> (- (+ z y x) w)")
+  (lint-test "(+ (- (+ y z) w v) x)"    " +: perhaps (+ (- (+ y z) w v) x) -> (- (+ x y z) w v)")
+  (lint-test "(+ (- (+ a b) c d e) (- (+ y z) w v))" " +: perhaps (+ (- (+ a b) c d e) (- (+ y z) w v)) -> (- (+ y z a b) c d e w v)")
+  (lint-test "(+ x (- (+ y z) w) v)"    " +: perhaps (+ x (- (+ y z) w) v) -> (- (+ v z y x) w)")
+  (lint-test "(+ (- x) (- y))"          " +: perhaps (+ (- x) (- y)) -> (- (+ x y))")
+  (lint-test "(+ (- x) (- y) (- z))"    " +: perhaps (+ (- x) (- y) (- z)) -> (- (+ x y z))")
+  (lint-test "(+ (- x) (- y z))"        " +: perhaps (+ (- x) (- y z)) -> (- y x z)")
+  (lint-test "(+ (- x) (- x z))"        " +: perhaps (+ (- x) (- x z)) -> (- z)")
+  (lint-test "(+ (- x z) (- y))"        " +: perhaps (+ (- x z) (- y)) -> (- x z y)")
+  (lint-test "(+ (- y z) (- y))"        " +: perhaps (+ (- y z) (- y)) -> (- z)")
+  (lint-test "(+ (- x 1) 1000)"         " +: perhaps (+ (- x 1) 1000) -> (+ x 999)")
+  (lint-test "(+ (- 1 x) 1000)"         " +: perhaps (+ (- 1 x) 1000) -> (- 1001 x)")
+  (lint-test "(+ (- x y 1) 2 z)"        " +: perhaps (+ (- x y 1) 2 z) -> (- (+ x z 1) y)")
+  (lint-test "(+ (- x 1) (- 1 x) 2)"    " +: perhaps (+ (- x 1) (- 1 x) 2) -> 2")
+  (lint-test "(+ (- x 1) x)"            "")
+  (lint-test "(+ (- x 1) (- 1 x))"      " +: perhaps (+ (- x 1) (- 1 x)) -> 0")
+  (lint-test "(+ (- x y z) (- z y x))"  " +: perhaps (+ (- x y z) (- z y x)) -> (- (+ y y))")
+  (lint-test "(+ (- 0 x y) x y z)"      " +: perhaps (+ (- 0 x y) x y z) -> z")
+  (lint-test "(+ (- 1 x y) x y z)"      " +: perhaps (+ (- 1 x y) x y z) -> (+ z 1)")
+  (lint-test "(+ -1 (- x y))"           " +: perhaps (+ -1 (- x y)) -> (- x y 1)")
+  (lint-test "(+ (- x) -1)"             " +: perhaps (+ (- x) -1) -> (- -1 x)")
+  (lint-test "(+ (- -1 x) (- y -1))"    " +: perhaps (+ (- -1 x) (- y -1)) -> (- y x)")
+  (lint-test "(+ (- -1 x) (- -1 y))"    " +: perhaps (+ (- -1 x) (- -1 y)) -> (- -2 x y)")
+  (lint-test "(+ (- x 2) (- 1 y 3 4))"  " +: perhaps (+ (- x 2) (- 1 y 3 4)) -> (- x y 8)")
+  (lint-test "(+ (- x (random y)) (random y))" "")
+  (lint-test "(+ (- x (abs y)) (abs y))" " +: perhaps (+ (- x (abs y)) (abs y)) -> x")
+  (lint-test "(+ (* a b) (* b c))"      " +: perhaps (+ (* a b) (* b c)) -> (* b (+ a c))")
+  (lint-test "(+ (* a b b) (* b c))"    " +: perhaps (+ (* a b b) (* b c)) -> (* b (+ (* a b) c))")
+  (lint-test "(+ (* a b c) (* b c))"    " +: perhaps (+ (* a b c) (* b c)) -> (* b c (+ a 1))")
+  (lint-test "(+ (* a b) (* a b c d))"  " +: perhaps (+ (* a b) (* a b c d)) -> (* a b (+ 1 (* c d)))")
+  (lint-test "(+ (* a b) (* c d))"      "")
+  (lint-test "(+ (* a b) (* a b))"      " +: perhaps (+ (* a b) (* a b)) -> (* a b 2)")
+  (lint-test "(+ (* x 2) 3 (* 4 x x))"  " +: perhaps (+ (* x 2) 3 (* 4 x x)) -> (+ 3 (* x (+ 2 (* x 4))))")
+  (lint-test "(+ -1 (* x -2) 3 (* 4 x x x))" " +: perhaps (+ -1 (* x -2) 3 (* 4 x x x)) -> (+ 2 (* x (+ -2 (* x (* x 4)))))")
+  (lint-test "(+ (* x 65536) (* x 256) x)" " +: perhaps (+ (* x 65536) (* x 256) x) -> (* x 65793)")
+  (lint-test "(+ x x x x)"              " +: perhaps (+ x x x x) -> (* x 4)")
+  (lint-test "(+ n (if (= 0 m) 0 1))"   " +: perhaps (+ n (if (= 0 m) 0 1)) -> (if (= 0 m) n (+ n 1))")
+  (lint-test "(if (= m 0) n (+ n 1))"   "")
+  (lint-test "(+ n (if x 0 y))"         " +: perhaps (+ n (if x 0 y)) -> (if x n (+ n y))")
+  (lint-test "(+ n (if x y 0))"         " +: perhaps (+ n (if x y 0)) -> (if x (+ n y) n)")
+  (lint-test "(+ (if x 0 y) n)"         " +: perhaps (+ (if x 0 y) n) -> (if x n (+ y n))")
+  (lint-test "(+ (if x y 0) n)"         " +: perhaps (+ (if x y 0) n) -> (if x (+ y n) n)")
+  (lint-test "(+ x (if y #() 0))"
+	     " +: in (+ x (if y #() 0)), +'s second argument should be a number, but #() is a vector?
+               +: perhaps (+ x (if y #() 0)) -> (if y (+ x #()) x)")
+  (lint-test "(+ 1 (if x 0 #()))"
+	     " +: in (+ 1 (if x 0 #())), +'s second argument should be a number, but #() is a vector?
+               +: perhaps (+ 1 (if x 0 #())) -> (if x 1 (+ 1 #()))")
+  (lint-test "(+ 1 (if x #() 0))"
+	     " +: in (+ 1 (if x #() 0)), +'s second argument should be a number, but #() is a vector?
+               +: perhaps (+ 1 (if x #() 0)) -> (if x (+ 1 #()) 1)")
+  (lint-test "(+ n (make-rectangular 0.0 0.0))" " +: perhaps (+ n (make-rectangular 0.0 0.0)) -> (+ n 0.0)")
+  (lint-test "(+ (log a) (log b))"      " +: perhaps (+ (log a) (log b)) -> (log (* a b))")
+
+  (lint-test "(* 2 3)"			" *: perhaps (* 2 3) -> 6")
+  (lint-test "(* 2 (+))"		" *: perhaps (* 2 (+)) -> 0")
+  (lint-test "(* (* 2 3) 4)"		" *: perhaps (* (* 2 3) 4) -> 24")
+  (lint-test "(* (* x 3) 4)"		" *: perhaps (* (* x 3) 4) -> (* 12 x)")
+  (lint-test "(* x)"			" *: perhaps (* x) -> x")
+  (lint-test "(* x (*))"		" *: perhaps (* x (*)) -> x")
+  (lint-test "(* 2 x 3 y 1/6)"		" *: perhaps (* 2 x 3 y 1/6) -> (* x y)")
+  (lint-test "(* x -1)"			" *: perhaps (* x -1) -> (- x)")
+  (lint-test "(* -1 x y)"               " *: perhaps (* -1 x y) -> (- (* x y))")
+  (lint-test "(* x 1 1 1)"		" *: perhaps (* x 1 1 1) -> x")
+  (lint-test "(* x 1 1.0 1)"		" *: perhaps (* x 1 1.0 1) -> (* x 1.0)")
+  (lint-test "(* x y 2 0)"		" *: perhaps (* x y 2 0) -> 0")
+  (lint-test "(* -1 x -1 -1)"		" *: perhaps (* -1 x -1 -1) -> (- x)")
+  (lint-test "(* x (* y z) a)"          " *: perhaps (* x (* y z) a) -> (* x y z a)")
+  (lint-test "(* (- x) (- y))"          " *: perhaps (* (- x) (- y)) -> (* x y)")
+  (lint-test "(* 2.0 (inexact x))"      " *: perhaps (* 2.0 (inexact x)) -> (* 2.0 x)")
+  (lint-test "(* (inexact x) 2.0)"      " *: perhaps (* (inexact x) 2.0) -> (* x 2.0)")
+  (lint-test "(* (exp a) (exp b))"      " *: perhaps (* (exp a) (exp b)) -> (exp (+ a b))")
+  (lint-test "(* (expt x z) (expt y z))" " *: perhaps (* (expt x z) (expt y z)) -> (expt (* x y) z)")
+  (lint-test "(* (expt x z) (expt x y))" " *: perhaps (* (expt x z) (expt x y)) -> (expt x (+ z y))")
+  (lint-test "(* 2.0 (random 1.0))"     " *: perhaps (* 2.0 (random 1.0)) -> (random 2.0)")
+  (lint-test "(* (gcd a b) (lcm a b))"	" *: perhaps (* (gcd a b) (lcm a b)) -> (abs (* a b))")
+  (lint-test "(* (/ x) (/ y z))"        " *: perhaps (* (/ x) (/ y z)) -> (/ y x z)")
+  (lint-test "(* (/ x) (/ x z))"        " *: perhaps (* (/ x) (/ x z)) -> (/ z)")
+  (lint-test "(* (/ x z) (/ y))"        " *: perhaps (* (/ x z) (/ y)) -> (/ x z y)")
+  (lint-test "(* (/ y z) (/ y))"        " *: perhaps (* (/ y z) (/ y)) -> (/ z)")
+  (lint-test "(* (/ x z) (/ y w v))"    " *: perhaps (* (/ x z) (/ y w v)) -> (/ (* x y) z w v)")
+  (lint-test "(* (/ x y) y)"            " *: perhaps (* (/ x y) y) -> x")
+  (lint-test "(* (/ x y) (/ y x))"      " *: perhaps (* (/ x y) (/ y x)) -> 1")
+  (lint-test "(* (/ x 2) 2)"            " *: perhaps (* (/ x 2) 2) -> x")
+  (lint-test "(* (/ 2 x) 3/4)"          " *: perhaps (* (/ 2 x) 3/4) -> (/ 3/2 x)")
+  (lint-test "(* (/ x) (/ y))"          " *: perhaps (* (/ x) (/ y)) -> (/ 1 x y)")
+  (lint-test "(* (/ x y) z (/ y x))"    " *: perhaps (* (/ x y) z (/ y x)) -> z")
+  (lint-test "(* (/ x y z) z (/ y x))"  " *: perhaps (* (/ x y z) z (/ y x)) -> 1")
+  (lint-test "(* (/ x a) z (/ y x))"    " *: perhaps (* (/ x a) z (/ y x)) -> (/ (* z y) a)")
+  (lint-test "(* n (if x 0 1))"         " *: perhaps (* n (if x 0 1)) -> (if x 0 (* n 1))")
+  (lint-test "(* n (if x y 1))"         " *: perhaps (* n (if x y 1)) -> (if x (* n y) n)")
+  (lint-test "(* n (if x y 0))"         " *: perhaps (* n (if x y 0)) -> (if x (* n y) 0)")
+  (lint-test "(* n (if x 0 y))"         " *: perhaps (* n (if x 0 y)) -> (if x 0 (* n y))")
+  (lint-test "(* n (if x 1 y))"         " *: perhaps (* n (if x 1 y)) -> (if x n (* n y))")
+  (lint-test "(* (if x 0 y) n)"         " *: perhaps (* (if x 0 y) n) -> (if x 0 (* y n))")
+  (lint-test "(* (if x y 0) n)"         " *: perhaps (* (if x y 0) n) -> (if x (* y n) 0)")
+  (lint-test "(* (if x 1 y) n)"         " *: perhaps (* (if x 1 y) n) -> (if x n (* y n))")
+  (lint-test "(* (if x y 1) n)"         " *: perhaps (* (if x y 1) n) -> (if x (* y n) n)")
+  (lint-test "(* (if x w y) n)"         "")
+  (lint-test "(* x (if y 0 z) w)"       " *: perhaps (* x (if y 0 z) w) -> (if y 0 (* z x w))")
+  (lint-test "(* (if y z 0) x w)"       " *: perhaps (* (if y z 0) x w) -> (if y (* z x w) 0)")
+  (lint-test "(* (sqrt x) (sqrt y))"    " *: perhaps (* (sqrt x) (sqrt y)) -> (sqrt (* x y))")
+  (lint-test "(* a (/ 1 b))"            " *: perhaps (* a (/ 1 b)) -> (/ a b)")
+  (lint-test "(* (/ 1 a) a)"            " *: perhaps (* (/ 1 a) a) -> 1")
+  (lint-test "(* a (/ 1 a))"            " *: perhaps (* a (/ 1 a)) -> 1")
+  (lint-test "(* a (/ a))"              " *: perhaps (* a (/ a)) -> 1")
+  (lint-test "(* (/ a) a)"              " *: perhaps (* (/ a) a) -> 1")
+  (lint-test "(* a (/ b))"              " *: perhaps (* a (/ b)) -> (/ a b)")
+  (lint-test "(* (sqrt x) (sqrt y))"    " *: perhaps (* (sqrt x) (sqrt y)) -> (sqrt (* x y))")
+
+  (lint-test "(- 1 2)"			" -: perhaps (- 1 2) -> -1")
+  (lint-test "(- 1 (- 1 2))"		" -: perhaps (- 1 (- 1 2)) -> 2")
+  (lint-test "(- x (- 2 0))"		" -: perhaps (- x (- 2 0)) -> (- x 2)")
+  (lint-test "(- (- x))"		" -: perhaps (- (- x)) -> x")
+  (lint-test "(- 0 x)"			" -: perhaps (- 0 x) -> (- x)")
+  (lint-test "(- x 0)"			" -: perhaps (- x 0) -> x")
+  (lint-test "(- (- y x))"		" -: perhaps (- (- y x)) -> (- x y)")
+  (lint-test "(- 3/2 1/2)"		" -: perhaps (- 3/2 1/2) -> 1")
+  (lint-test "(- (- x y) z)"		" -: perhaps (- (- x y) z) -> (- x y z)")
+  (lint-test "(- x 0 (+ 3 2))"		" -: perhaps (- x 0 (+ 3 2)) -> (- x 5)")
+  (lint-test "(- 5 x (+ 3 2))"		" -: perhaps (- 5 x (+ 3 2)) -> (- x)")
+  (lint-test "(- x 0 0 0)"		" -: perhaps (- x 0 0 0) -> x")
+  (lint-test "(- 0 0 0 x)"		" -: perhaps (- 0 0 0 x) -> (- x)")
+  (lint-test "(- 0.0 x)"		"")
+  (lint-test "(- x (+ 0 x))"		" -: perhaps (- x (+ 0 x)) -> 0")
+  (lint-test "(- (abs x) (abs x) y)"	" -: perhaps (- (abs x) (abs x) y) -> (- y)")
+  (lint-test "(- (abs x) (abs x) (abs x) y)" " -: perhaps (- (abs x) (abs x) (abs x) y) -> (- (+ (abs x) y))")
+  (lint-test "(- (- x) y)" " -: perhaps (- (- x) y) -> (- (+ x y))")
+  (lint-test "(- x (truncate x))"       " -: perhaps (- x (truncate x)) -> (remainder x 1)")
+  (lint-test "(- x (+ y z))"            " -: perhaps (- x (+ y z)) -> (- x y z)")
+  (lint-test "(- x (- y))"              " -: perhaps (- x (- y)) -> (+ x y)")
+  (lint-test "(- x x)"                  " -: this looks odd: (- x x) -: perhaps (- x x) -> 0")
+  (lint-test "(- (- x y) z w)"          " -: perhaps (- (- x y) z w) -> (- x y z w)")
+  (lint-test "(- (- x y) (+ z w))"      " -: perhaps (- (- x y) (+ z w)) -> (- x y z w)")
+  (lint-test "(- x -1)"                 "") ;lengths match
+  (lint-test "(- x (if y 0 z))"         " -: perhaps (- x (if y 0 z)) -> (if y x (- x z))")
+  (lint-test "(- x (if y z 0))"         " -: perhaps (- x (if y z 0)) -> (if y (- x z) x)")
+  (lint-test "(- (floor (- x)))"        " -: perhaps (- (floor (- x))) -> (ceiling x)")
+  (lint-test "(- (floor (- (+ x y))))"  " -: perhaps (- (floor (- (+ x y)))) -> (ceiling (+ x y))")
+  (lint-test "(- (- x) 1)"              "") ; lengths match
+  (lint-test "(- (log a) (log b))"      " -: perhaps (- (log a) (log b)) -> (log (/ a b))")
+  (lint-test "(- (* b a) (* c a))"      " -: perhaps (- (* b a) (* c a)) -> (* a (- b c))")
+  (lint-test "(- (* a b) (* c a))"      " -: perhaps (- (* a b) (* c a)) -> (* a (- b c))")
+  (lint-test "(- (* b a) (* a c))"      " -: perhaps (- (* b a) (* a c)) -> (* a (- b c))")
+  (lint-test "(- (* a b) (* a c))"      " -: perhaps (- (* a b) (* a c)) -> (* a (- b c))")
+  (lint-test "(- (/ a b) (/ c b))"      " -: perhaps (- (/ a b) (/ c b)) -> (/ (- a c) b)")
+  (lint-test "(- (random x) 1 (random x))" "")
+  (lint-test "(- (+ x y) (+ y x))"      " -: perhaps (- (+ x y) (+ y x)) -> 0")
+  (lint-test "(- (+ x 1) (+ y x))"      " -: perhaps (- (+ x 1) (+ y x)) -> (- 1 y)")
+  (lint-test "(- x (+ y x 1))"          " -: perhaps (- x (+ y x 1)) -> (- (+ y 1))")
+  (lint-test "(- 0 0 x)"                " -: perhaps (- 0 0 x) -> (- x)")
+  (lint-test "(- 0 0 x y)"              " -: perhaps (- 0 0 x y) -> (- (+ x y))")
+  (lint-test "(- (+ x 1) (- x y) 1)"    " -: perhaps (- (+ x 1) (- x y) 1) -> y")
+  (lint-test "(- (+ x z) (- x y) 0)"    " -: perhaps (- (+ x z) (- x y) 0) -> (+ z y)")
+  (lint-test "(- (+ x 1) (- x y) 2)"    " -: perhaps (- (+ x 1) (- x y) 2) -> (- y 1)")
+  (lint-test "(- (+ x 1) (- x y) -2)"   " -: perhaps (- (+ x 1) (- x y) -2) -> (+ y 3)")
+  (lint-test "(- (+ x z 2) x y 1)"      " -: perhaps (- (+ x z 2) x y 1) -> (- (+ z 1) y)")
+  (lint-test "(- (+ x z) x y 1)"        " -: perhaps (- (+ x z) x y 1) -> (- z y 1)")
+  (lint-test "(- (+ x z w) x y 1)"      " -: perhaps (- (+ x z w) x y 1) -> (- (+ w z) y 1)")
+  (lint-test "(- (+ x z) x y)"          " -: perhaps (- (+ x z) x y) -> (- z y)")
+  (lint-test "(- (+ x z w) x y)"        " -: perhaps (- (+ x z w) x y) -> (- (+ w z) y)")
+  (lint-test "(- -9223372036854775808)"
+	     "- argument, -9223372036854775808, is out of range (most-negative-fixnum can't be negated)
+              -: perhaps (- -9223372036854775808) -> +nan.0")
+  (lint-test "(- (*s7* 'most-negative-fixnum))"
+	     "- argument, -9223372036854775808, is out of range (most-negative-fixnum can't be negated)
+              -: perhaps (- (*s7* 'most-negative-fixnum)) -> +nan.0")
+  (lint-test "(/ 2 3)"			" /: perhaps (/ 2 3) -> 2/3")
+  (lint-test "(/ 1 x)"			" /: perhaps (/ 1 x) -> (/ x)")
+  (lint-test "(/ 2)"			" /: perhaps (/ 2) -> 1/2")
+  (lint-test "(/ 0 2 x)"		" /: perhaps (/ 0 2 x) -> 0")
+  (lint-test "(/ 0 x)"                  " /: perhaps (/ 0 x) -> 0")
+  (lint-test "(/ x (- x))"              " /: perhaps (/ x (- x)) -> -1")
+  (lint-test "(/ (/ x))"		" /: perhaps (/ (/ x)) -> x")
+  (lint-test "(/ (log x) (log 2))"	" /: perhaps (/ (log x) (log 2)) -> (log x 2)")
+  (lint-test "(/ (log x) (log y))"	" /: perhaps (/ (log x) (log y)) -> (log x y)")
+  (lint-test "(/ x (/ y))"		" /: perhaps (/ x (/ y)) -> (* x y)")
+  (lint-test "(/ x (/ 1 y z))"          " /: perhaps (/ x (/ 1 y z)) -> (* x y z)")
+  (lint-test "(/ x 1 1 1)"		" /: perhaps (/ x 1 1 1) -> x")
+  (lint-test "(/ x a (* b 1 c) d)"	" /: perhaps (/ x a (* b 1 c) d) -> (/ x a b c d)")
+  (lint-test "(/ 0 a (* b 1 c) d)"	" /: perhaps (/ 0 a (* b 1 c) d) -> 0")
+  (lint-test "(/ x x)"			" /: this looks odd: (/ x x) /: perhaps (/ x x) -> 1")
+  (lint-test "(/ 0)"			" /: attempt to invert zero: (/ 0)")
+  (lint-test "(/ x y 2 0)"		" /: attempt to divide by 0: (/ x y 2 0)")
+  (lint-test "(/ (/ 1 a) (/ b c d))"    " /: perhaps (/ (/ 1 a) (/ b c d)) -> (/ (* c d) (* a b))")
+  (lint-test "(/ (/ a) (/ b))"          " /: perhaps (/ (/ a) (/ b)) -> (/ b a)")
+  (lint-test "(/ (/ a b c) (/ d e f))"  " /: perhaps (/ (/ a b c) (/ d e f)) -> (/ (* a e f) (* b c d))")
+  (lint-test "(/ (/ a b) c)"            " /: perhaps (/ (/ a b) c) -> (/ a b c)")
+  (lint-test "(/ a b a)"                " /: perhaps (/ a b a) -> (/ b)")
+  (lint-test "(/ a b a c)"              " /: perhaps (/ a b a c) -> (/ 1 b c)")
+  (lint-test "(/ a (* b a))"            " /: perhaps (/ a (* b a)) -> (/ b)")
+  (lint-test "(/ a (* b a c))"          " /: perhaps (/ a (* b a c)) -> (/ 1 b c)")
+  (lint-test "(/ 2.0 (inexact x))"      " /: perhaps (/ 2.0 (inexact x)) -> (/ 2.0 x)")
+  (lint-test "(/ (inexact x) 2.0)"      " /: perhaps (/ (inexact x) 2.0) -> (/ x 2.0)")
+  (lint-test "(/ (- x) (- y))"          " /: perhaps (/ (- x) (- y)) -> (/ x y)")
+  (lint-test "(/ x (/ y z))"            " /: perhaps (/ x (/ y z)) -> (/ (* x z) y)")
+  (lint-test "(/ 3 (/ -3 x))"           " /: perhaps (/ 3 (/ -3 x)) -> (- x)")
+  (lint-test "(/ 2/3 (/ 3/2 x))"        " /: perhaps (/ 2/3 (/ 3/2 x)) -> (* 4/9 x)")
+  (lint-test "(/ x (* y z))"            "")
+  (lint-test "(/ x (/ y))"              " /: perhaps (/ x (/ y)) -> (* x y)")
+  (lint-test "(/ (* x y) (* z y))"      " /: perhaps (/ (* x y) (* z y)) -> (/ x z)")
+  (lint-test "(/ (* 12 (log x)) (log 2))" " /: perhaps (/ (* 12 (log x)) (log 2)) -> (* 12 (log x 2))")
+  (lint-test "(/ (* x y) (log 2))"      "")
+  (lint-test "(/ (expt x y))"           " /: perhaps (/ (expt x y)) -> (expt x (- y))")
+  (lint-test "(/ (expt 10 6))"          " /: perhaps (/ (expt 10 6)) -> (expt 10 (- 6))")
+  (lint-test "(/ (exp x))"              " /: perhaps (/ (exp x)) -> (exp (- x))")
+  (lint-test "(/ x (sqrt x))"           " /: perhaps (/ x (sqrt x)) -> (sqrt x)")
+  (lint-test "(/ (sqrt x) x)"           " /: perhaps (/ (sqrt x) x) -> (/ (sqrt x))")
+  (lint-test "(/ (sqrt x) (sqrt y))"    " /: perhaps (/ (sqrt x) (sqrt y)) -> (sqrt (/ x y))")
+  (lint-test "(/ (/ x))"                " /: perhaps (/ (/ x)) -> x")
+  (lint-test "(/ (/ 1 x))"              " /: perhaps (/ (/ 1 x)) -> x")
+  (lint-test "(/ (/ 1 x y))"            " /: perhaps (/ (/ 1 x y)) -> (* x y)")
+  (lint-test "(/ (/ z x))"              " /: perhaps (/ (/ z x)) -> (/ x z)")
+  (lint-test "(/ (/ z x y))"            " /: perhaps (/ (/ z x y)) -> (/ (* x y) z)")
+  (lint-test "(/ 1 (/ 1 x y))"          " /: perhaps (/ 1 (/ 1 x y)) -> (* x y)")
+  (lint-test "(/ x y (length z))"       " /: (length z) will cause division by 0 if z is empty")
+  (lint-test "(/ (length x))"           " /: (length x) will cause division by 0 if x is empty")
+  (lint-test "(/ (length x) z)"         "")
+  (lint-test "(/ (- (* a a) (* b b)) (- a b))" " /: perhaps (/ (- (* a a) (* b b)) (- a b)) -> (+ a b)")
+  (lint-test "(/ (- (* a a) (* b b)) (+ a b))" " /: perhaps (/ (- (* a a) (* b b)) (+ a b)) -> (- a b)")
+  (lint-test "(/ (expt a b) (expt a c))" " /: perhaps (/ (expt a b) (expt a c)) -> (expt a (- b c))")
+  (lint-test "(/ (exp a) (exp b))"      " /: perhaps (/ (exp a) (exp b)) -> (exp (- a b))")
+
+  (lint-test "(/ (exact->inexact x) 10)"        " /: perhaps (/ (exact->inexact x) 10) -> (/ x 10.0)")
+  (lint-test "(+ (exact->inexact x) 10)"        " +: perhaps (+ (exact->inexact x) 10) -> (+ x 10.0)")
+  (lint-test "(+ 10 (exact->inexact x))"        " +: perhaps (+ 10 (exact->inexact x)) -> (+ 10.0 x)")
+  (lint-test "(* (exact->inexact x) 10)"        " *: perhaps (* (exact->inexact x) 10) -> (* x 10.0)")
+  (lint-test "(* (exact->inexact x) 10 10.0)"   " *: perhaps (* (exact->inexact x) 10 10.0) -> (* x 10 10.0)")
+  (lint-test "(* 10 (exact->inexact x) 10.0)"   " *: perhaps (* 10 (exact->inexact x) 10.0) -> (* 10 x 10.0)")
+  (lint-test "(* 10.0 (exact->inexact x) 10.0)" " *: perhaps (* 10.0 (exact->inexact x) 10.0) -> (* 10.0 x 10.0)")
+
+  (lint-test "(exact->inexact (/ x 32))"        " exact->inexact: perhaps (exact->inexact (/ x 32)) -> (/ x 32.0)")
+  (lint-test "(exact->inexact (real-part x))"   "") ; if complex?
+  (lint-test "(exact->inexact (random 10))"     "") ; this can't be changed to (random 10.0)
+  (lint-test "(exact->inexact 1.234)"           " exact->inexact: perhaps (exact->inexact 1.234) -> 1.234")
+  (lint-test "(exact->inexact (float-vector-ref x 0))" " exact->inexact: perhaps (exact->inexact (float-vector-ref x 0)) -> (float-vector-ref x 0)")
+  (lint-test "(exact->inexact (* 1.234 w))"      " exact->inexact: perhaps (exact->inexact (* 1.234 w)) -> (* 1.234 w)")
+
+  (lint-test "(inexact (+ 1.0 x))"              " inexact: perhaps (inexact (+ 1.0 x)) -> (+ 1.0 x)")
+  (lint-test "(inexact (random 10))"            "")
+  (lint-test "(inexact? (random 10))"           "") ; this should be #f
+  (lint-test "(inexact? 1.0)"                   " inexact?: perhaps (inexact? 1.0) -> #t")
+
+  (lint-test "(inexact->exact (numerator x))"   " inexact->exact: perhaps (inexact->exact (numerator x)) -> (numerator x)")
+  (lint-test "(inexact->exact (random 10))"     " inexact->exact: perhaps (inexact->exact (random 10)) -> (random 10)")
+  (lint-test "(inexact->exact (floor x))"       " inexact->exact: perhaps (inexact->exact (floor x)) -> (floor x)")
+  (lint-test "(inexact->exact 1.5)"	        " inexact->exact: perhaps (inexact->exact 1.5) -> 3/2")
+  (lint-test "(inexact->exact (floor x))"       " inexact->exact: perhaps (inexact->exact (floor x)) -> (floor x)")
+  (lint-test "(inexact->exact 2/3)"	        " inexact->exact: perhaps (inexact->exact 2/3) -> 2/3")
+  (lint-test "(inexact->exact 2)"               " inexact->exact: perhaps (inexact->exact 2) -> 2")
+  (lint-test "(inexact->exact (int-vector-ref x 0))" " inexact->exact: perhaps (inexact->exact (int-vector-ref x 0)) -> (int-vector-ref x 0)")
+  (lint-test "(inexact->exact (floor 23))"      " inexact->exact: perhaps (inexact->exact (floor 23)) -> 23")
+
+  (lint-test "(exact (round x))"                " exact: perhaps (exact (round x)) -> (round x)")
+  (lint-test "(exact? 1.0)"                     " exact?: perhaps (exact? 1.0) -> #f")
+
+  (lint-test "(sin (asin x))"		" sin: perhaps (sin (asin x)) -> x")
+  (lint-test "(sin 0)"			" sin: perhaps (sin 0) -> 0")
+  (lint-test "(sin pi)"			" sin: perhaps (sin pi) -> 0.0")
+  (lint-test "(cos 0)"			" cos: perhaps (cos 0) -> 1")
+  (lint-test "(cos (acos (+ x 1)))"	" cos: perhaps (cos (acos (+ x 1))) -> (+ x 1)")
+  (lint-test "(cos (* pi 1))"		" cos: perhaps (cos (* pi 1)) -> -1.0")
+  (lint-test "(cos (- (* x y)))"	" cos: perhaps (cos (- (* x y))) -> (cos (* x y))")
+  (lint-test "(cos 0)"			" cos: perhaps (cos 0) -> 1")
+  (lint-test "(exp (* (+ x y) (log (+ y 1))))" " exp: perhaps (exp (* (+ x y) (log (+ y 1)))) -> (expt (+ y 1) (+ x y))")
+  (lint-test "(exp (* (log x) a))"	" exp: perhaps (exp (* (log x) a)) -> (expt x a)")
+  (lint-test "(exp (log (* x y)))"      " exp: perhaps (exp (log (* x y))) -> (* x y)")
+  (lint-test "(acosh (cosh 0))"		" acosh: perhaps (acosh (cosh 0)) -> (acosh 1)")
+  (lint-test "(exp (log 1))"		" exp: perhaps (exp (log 1)) -> 1")
+  (lint-test "(exp 0.0)"		" exp: perhaps (exp 0.0) -> 1.0")
+  (lint-test "(exp (+ (* 0.5 (log hi)) (* 0.5 (log lo))))" " exp: perhaps (exp (+ (* 0.5 (log hi)) (* 0.5 (log lo)))) -> (expt (* hi lo) 0.5)")
+  (lint-test "(sin x 0.0)"		" sin: sin has too many arguments: (sin x 0.0)")
+  (lint-test "(sin)"			" sin: sin needs 1 argument: (sin)")
+  (lint-test "(/ (sin x) (cos x))"      " /: perhaps (/ (sin x) (cos x)) -> (tan x)")
+
+  (lint-test "(log 1)"			" log: perhaps (log 1) -> 0")
+  (lint-test "(log (exp 0))"		" log: perhaps (log (exp 0)) -> 0")
+  (lint-test "(log (exp (* x y)))"	" log: perhaps (log (exp (* x y))) -> (* x y)")
+  (lint-test "(log (* x 1) (- x 0))"	" log: perhaps (log (* x 1) (- x 0)) -> 1.0")
+  (lint-test "(log 2 2)"		" log: perhaps (log 2 2) -> 1")
+  (lint-test "(log pi pi)"		" log: perhaps (log pi pi) -> 1.0")
+  (lint-test "(log (* x pi) (* x pi))"	" log: perhaps (log (* x pi) (* x pi)) -> 1.0")
+  (lint-test "(log (* x pi))"		"")
+  (lint-test "(log (sqrt x))"           " log: perhaps (log (sqrt x)) -> (* 1/2 (log x))")
+  (lint-test "(log (expt x y))"         " log: perhaps (log (expt x y)) -> (* y (log x))")
+  (lint-test "(log (expt x y) z)"       " log: perhaps (log (expt x y) z) -> (* y (log x z))")
+  (lint-test "(log (/ 1 a))"            " log: perhaps (log (/ 1 a)) -> (- (log a))")
+  (lint-test "(log (/ a))"              " log: perhaps (log (/ a)) -> (- (log a))")
+
+  (lint-test "(sqrt 4)"			" sqrt: perhaps (sqrt 4) -> 2")
+  (if (not with-bignums) (lint-test "(sqrt 3)" ""))
+  (lint-test "(sqrt 4.0)"		"")
+  (lint-test "(sqrt (* (+ x 1) (+ x 1)))" "") ; tricky case, x might be -2 for example
+  (lint-test "(sqrt)"			" sqrt: sqrt needs 1 argument: (sqrt)")
+  (lint-test "(sqrt (- x 0))"		" sqrt: perhaps (sqrt (- x 0)) -> (sqrt x)")
+  (lint-test "(sqrt (exp x))"           " sqrt: perhaps (sqrt (exp x)) -> (exp (/ x 2))")
+  (lint-test "(complex (- x 0) 2)"	" complex: perhaps (complex (- x 0) 2) -> (complex x 2)")
+
+  (lint-test "(floor 3.4)"		" floor: perhaps (floor 3.4) -> 3")
+  (lint-test "(round 3.4+i)"		" round: in (round 3.4+1.0i), round's argument should be real, but 3.4+1.0i is complex?")
+  (lint-test "(ceiling (floor 2.1))"	" ceiling: perhaps (ceiling (floor 2.1)) -> 2")
+  (lint-test "(ceiling (floor x))"	" ceiling: perhaps (ceiling (floor x)) -> (floor x)")
+  (lint-test "(truncate 2/3)"		" truncate: perhaps (truncate 2/3) -> 0")
+  (lint-test "(truncate (/ 2 3))"	" truncate: perhaps (truncate (/ 2 3)) -> 0")
+  (lint-test "(truncate (/ 12 (* 2 3)))" " truncate: perhaps (truncate (/ 12 (* 2 3))) -> 2")
+  (lint-test "(truncate (* 2.0 (inexact->exact (log 3))))" " truncate: perhaps (truncate (* 2.0 (inexact->exact (log 3)))) -> (truncate (* 2.0 (log 3)))")
+  (lint-test "(truncate (inexact->exact (log 3)))" " truncate: perhaps (truncate (inexact->exact (log 3))) -> (truncate (log 3))")
+  (lint-test "(round (random 10))"      " round: perhaps (round (random 10)) -> (random 10)")
+  (lint-test "(floor (random 10.0))"    " floor: perhaps (floor (random 10.0)) -> (random 10)")
+
+  (lint-test "(abs (magnitude 1+i))"	" abs: perhaps (abs (magnitude 1.0+1.0i)) -> (magnitude 1.0+1.0i)")
+  (lint-test "(magnitude 2/3)"		" magnitude: perhaps use abs here: (magnitude 2/3) magnitude: perhaps (magnitude 2/3) -> 2/3")
+  (lint-test "(abs (- (* 2 x)))"	" abs: perhaps (abs (- (* 2 x))) -> (abs (* 2 x))")
+  (lint-test "(abs (* (+ x 1) 1))"	" abs: perhaps (abs (* (+ x 1) 1)) -> (abs (+ x 1))")
+  (lint-test "(magnitude (real-part z))" " magnitude: perhaps use abs here: (magnitude (real-part z))")
+  (lint-test "(abs (denominator x))"    " abs: perhaps (abs (denominator x)) -> (denominator x)")
+  (lint-test "(abs (modulo x 2))"       " abs: perhaps (abs (modulo x 2)) -> (modulo x 2)")
+  (lint-test "(abs () ())"              " abs: abs has too many arguments: (abs () ())
+                                          abs: in (abs () ()), abs's first argument should be real, but () is null?")
+  (lint-test "(abs -9223372036854775808)" "abs argument, (-9223372036854775808), is out of range (result is too large) abs: perhaps (abs -9223372036854775808) -> +nan.0")
+  (lint-test "(abs (abs x))"           " abs: perhaps (abs (abs x)) -> (abs x)")
+
+  (lint-test "(real-part 3.0)"		" real-part: perhaps (real-part 3.0) -> 3.0")
+  (lint-test "(imag-part 3.0)"		" imag-part: perhaps (imag-part 3.0) -> 0.0")
+  (lint-test "(real-part (abs x))"	" real-part: perhaps (real-part (abs x)) -> (abs x)")
+  (lint-test "(imag-part (abs x))"	" imag-part: perhaps (imag-part (abs x)) -> 0.0")
+  (lint-test "(imag-part (sin x))"	"")
+  (lint-test "(real-part 1+i)"		"")
+  (lint-test "(imag-part x)"		"")
+  (lint-test "(real-part x)"		"")
+  (lint-test "(imag-part (vector-ref x i))" "")
+  (lint-test "(imag-part (x i))"	"")
+
+  (lint-test "(string? (number->string x))" " string?: number->string always returns a string, so (string? (number->string x)) -> #t")
+  (lint-test "(number? (string->number x))" " number?: string->number returns either #f or a number, so (number? (string->number x)) -> (string->number x)")
+
+  (lint-test "(numerator 1/3)"		" numerator: perhaps (numerator 1/3) -> 1")
+  (lint-test "(numerator 3)"		" numerator: perhaps (numerator 3) -> 3")
+  (lint-test "(numerator (floor x))"	" numerator: perhaps (numerator (floor x)) -> (floor x)")
+  (lint-test "(denominator (floor x))"	" denominator: perhaps (denominator (floor x)) -> 1")
+  (lint-test "(denominator 3)"		" denominator: perhaps (denominator 3) -> 1")
+  (lint-test "(denominator (round (+ x 1)))" " denominator: perhaps (denominator (round (+ x 1))) -> 1")
+  (lint-test "(numerator (round (+ x 1)))" " numerator: perhaps        (numerator (round (+ x 1))) -> (round (+ x 1))")
+  (lint-test "(> (numerator x) 0)"       " >: perhaps (> (numerator x) 0) -> (> x 0)")
+  (lint-test "(negative? (numerator x))" " negative?: perhaps (negative? (numerator x)) -> (negative? x)")
+
+  (lint-test "(random 0)"		" random: perhaps (random 0) -> 0")
+  (lint-test "(random 0.0)"		" random: perhaps (random 0.0) -> 0.0")
+  (lint-test "(random x)"		"")
+  (lint-test "(random 1)"		" random: perhaps (random 1) -> 0")
+  (lint-test "(random -1)"		" random: perhaps (random -1) -> 0")
+  (lint-test "(random 0 y)"		"")
+
+  (lint-test "(lognot 1)"		" lognot: perhaps (lognot 1) -> -2")
+  (lint-test "(lognot 1/2)"		" lognot: in (lognot 1/2), lognot's argument should be an integer, but 1/2 is rational?")
+  (if with-bignums
+      (lint-test "(ash 2 64)"		" ash: perhaps (ash 2 64) -> 36893488147419103232")
+      (lint-test "(ash 2 64)"		""))
+  (lint-test "(ash 1 7)"		" ash: perhaps (ash 1 7) -> 128")
+  (lint-test "(ash x 0)"                " ash: perhaps (ash x 0) -> x")
+  (lint-test "(quotient (remainder x y) y)" " quotient: perhaps (quotient (remainder x y) y) -> 0")
+
+  (lint-test "(positive? (remainder x 2))" "")
+  (lint-test "(zero? (remainder x 2))"   " zero?: perhaps (assuming x is an integer) (zero? (remainder x 2)) -> (even? x)")
+  (lint-test "(negative? (remainder x 3))" "")
+  (lint-test "(negative? (modulo x 4))"  " negative?: perhaps (negative? (modulo x 4)) -> #f")
+  (lint-test "(positive? (modulo x -4))" " positive?: perhaps (positive? (modulo x -4)) -> #f")
+  (lint-test "(positive? (modulo x 4))"  " positive?: perhaps (positive? (modulo x 4)) -> #t")
+  (lint-test "(negative? (modulo x -4))" " negative?: perhaps (negative? (modulo x -4)) -> #t")
+  (lint-test "(ash 0 x)"                " ash: perhaps (ash 0 x) -> 0")
+  (lint-test "(modulo (abs x) y)"       " modulo: perhaps (modulo (abs x) y) -> (modulo x y)")
+
+  (lint-test "(complex 1.0 0)"		" complex: perhaps (complex 1.0 0) -> 1.0")
+  (lint-test "(expt 0 x)"		" expt: perhaps (expt 0 x) -> 0")
+  (lint-test "(expt x 0)"		" expt: perhaps (expt x 0) -> 1")
+  (lint-test "(expt (* 2 x) 1)"		" expt: perhaps (expt (* 2 x) 1) -> (* 2 x)")
+  (lint-test "(expt (* 2 x) -1)"	" expt: perhaps (expt (* 2 x) -1) -> (/ (* 2 x))")
+  (lint-test "(expt 2 3)"		" expt: perhaps (expt 2 3) -> 8")
+  (lint-test "(expt 1/2 -2)"		" expt: perhaps (expt 1/2 -2) -> 4")
+  (lint-test "(expt 2 1/2)"		"")
+  (lint-test "(expt 1.0 1.0)"		"")
+  (lint-test "(expt 0 0)"		" expt: perhaps (expt 0 0) -> 1")
+  (lint-test "(expt (expt x y) z)"      " expt: perhaps (expt (expt x y) z) -> (expt x (* y z))")
+  (lint-test "(expt (exp a) b)"         " expt: perhaps (expt (exp a) b) -> (exp (* a b))")
+
+  (lint-test "(angle -1)"		" angle: perhaps (angle -1) -> pi")
+  (lint-test "(angle 0.0)"		" angle: perhaps (angle 0.0) -> 0.0")
+  (lint-test "(angle pi)"		" angle: perhaps (angle pi) -> 0.0")
+
+  (lint-test "(atan x 0.0)"		"")
+  (lint-test "(atan (/ x y))"		" atan: perhaps (atan (/ x y)) -> (atan x y)")
+
+  (lint-test "(logior x (logior y z))"	" logior: perhaps (logior x (logior y z)) -> (logior x y z)")
+  (lint-test "(logior x 3 7 3 1 x)"	" logior: perhaps (logior x 3 7 3 1 x) -> (logior 7 x)")
+  (lint-test "(logior x)"		" logior: perhaps (logior x) -> x")
+  (lint-test "(logior x -1 2 y)"	" logior: perhaps (logior x -1 2 y) -> -1")
+  (lint-test "(logior 6 2)"		" logior: perhaps (logior 6 2) -> 6")
+  (lint-test "(logior)"			" logior: perhaps (logior) -> 0")
+  (lint-test "(logior x 0 y)"		" logior: perhaps (logior x 0 y) -> (logior x y)")
+
+  (lint-test "(logand x 3 7 3 1 x)"	" logand: perhaps (logand x 3 7 3 1 x) -> (logand 1 x)")
+  (lint-test "(logand 3 91 2)"		" logand: perhaps (logand 3 91 2) -> 2")
+  (lint-test "(logand)"			" logand: perhaps (logand) -> -1")
+  (lint-test "(logand (* x 3))"		" logand: perhaps (logand (* x 3)) -> (* x 3)")
+  (lint-test "(logand (* x 3) 0 y)"	" logand: perhaps (logand (* x 3) 0 y) -> 0")
+  (lint-test "(logand -1 x -1 y)"	" logand: perhaps (logand -1 x -1 y) -> (logand x y)")
+  (lint-test "(logand x (logand y 1))"	" logand: perhaps (logand x (logand y 1)) -> (logand x y 1)")
+  (lint-test "(logand x (logand y 0))"	" logand: perhaps (logand x (logand y 0)) -> 0")
+
+  (lint-test "(logxor x y x z)"		"")
+  (lint-test "(logxor 2 4 1)"		" logxor: perhaps (logxor 2 4 1) -> 7")
+  (lint-test "(logxor x)"		" logxor: perhaps (logxor x) -> x")
+  (lint-test "(logxor x x)"		" logxor: perhaps (logxor x x) -> 0")
+  (lint-test "(integer-length 1)"       " integer-length: perhaps (integer-length 1) -> 1")
+
+  (lint-test "(gcd x (gcd x y))"	" gcd: perhaps (gcd x (gcd x y)) -> (gcd x y)")
+  (lint-test "(lcm x (lcm x y))"	" lcm: perhaps (lcm x (lcm x y)) -> (lcm x y)")
+  (lint-test "(gcd x x)"		" gcd: perhaps (gcd x x) -> (abs x)")
+  (lint-test "(gcd)"			" gcd: perhaps (gcd) -> 0")
+  (lint-test "(lcm)"			" lcm: perhaps (lcm) -> 1")
+  (lint-test "(gcd x y 1 3)"		" gcd: perhaps (gcd x y 1 3) -> 1")
+  (lint-test "(lcm x y 0 3)"		" lcm: perhaps (lcm x y 0 3) -> 0")
+  (lint-test "(gcd 12 18)"		" gcd: perhaps (gcd 12 18) -> 6")
+  (lint-test "(gcd x 0)"		" gcd: perhaps (gcd x 0) -> (abs x)")
+  (lint-test "(lcm 12 18)"		" lcm: perhaps (lcm 12 18) -> 36")
+  (lint-test "(lcm x)"			" lcm: perhaps (lcm x) -> (abs x)")
+  (lint-test "(lcm x x x)"		" lcm: perhaps (lcm x x x) -> (abs x)")
+  (lint-test "(if (negative? (gcd x y)) a b)" " if: perhaps (negative? (gcd x y)) -> #f if: perhaps (if (negative? (gcd x y)) a b) -> b")
+  (lint-test "(gcd (random x) (random x))" "")
+
+  (lint-test "(max x)"			" max: perhaps (max x) -> x")
+  (lint-test "(max 3 4 5)"		" max: perhaps (max 3 4 5) -> 5")
+  (lint-test "(max 3 x 4 5)"		" max: perhaps (max 3 x 4 5) -> (max 5 x)")
+  (lint-test "(max 3.0 x 4/5 5)"	" max: perhaps (max 3.0 x 4/5 5) -> (max 5 x)")
+  (lint-test "(min 3.0 x 4/5 5)"	" min: perhaps (min 3.0 x 4/5 5) -> (min 4/5 x)")
+  (lint-test "(max 3.0 x x 5)"		" max: it looks odd to have repeated arguments in (max 3.0 x x 5) max: perhaps (max 3.0 x x 5) -> (max 5 x)")
+  (lint-test "(max 3 (max 4 x) y)"	" max: perhaps (max 3 (max 4 x) y) -> (max 4 x y)")
+  (lint-test "(max 4 (min 3 x) y)"	" max: perhaps (max 4 (min 3 x) y) -> (max 4 y)")
+  (lint-test "(min 4 (max 3 x) y)"	"")
+  (lint-test "(min (max x 3) 4 y)"	"")
+  (lint-test "(min 3 (max 4 x) y)"	" min: perhaps (min 3 (max 4 x) y) -> (min 3 y)")
+  (lint-test "(max (min x 3) (min x 3))" " max: this looks odd: (max (min x 3) (min x 3)) max: perhaps (max (min x 3) (min x 3)) -> (min x 3)")
+  (lint-test "(min x (max y x))"	" min: perhaps (min x (max y x)) -> x")
+  (lint-test "(max (min y x) x)"	" max: perhaps (max (min y x) x) -> x")
+  (lint-test "(max 3 (min x 3))"        " max: perhaps (max 3 (min x 3)) -> 3")
+  (lint-test "(min x (max y z (+ 21 x) x (* y z)))" " min: perhaps (min x (max y z (+ 21 x) x (* y z))) -> x")
+  (lint-test "(max 0 (string-length x))" " max: perhaps (max 0 (string-length x)) -> (string-length x)")
+  (lint-test "(max (string-length x) -1 y)" " max: perhaps (max (string-length x) -1 y) -> (max (string-length x) y)")
+
+  (lint-test "(equal? x y z)"		" equal?: equal? has too many arguments: (equal? x y z)")
+  (lint-test "(= 1 y 2)"		" =: this comparison can't be true: (= 1 y 2)")
+  (lint-test "(= x 1.5)"		" =: = can be troublesome with floats: (= x 1.5)")
+  (lint-test "(= x 0.0)"		"")
+  (lint-test "(= x 1.0 x)"		" =: it looks odd to have repeated arguments in (= x 1.0 x)")
+  (lint-test "(= x x)"                  " =: this looks odd: (= x x), perhaps use (not (nan? x))")
+  (lint-test "(= (- x y) 0)"		" =: perhaps (= (- x y) 0) -> (= x y)")
+  (lint-test "(= 0.0 (- x y))"		" =: perhaps (= 0.0 (- x y)) -> (= x y)")
+  (lint-test "(= (- (abs x) 2) 0)"	" =: perhaps (= (- (abs x) 2) 0) -> (= (abs x) 2)")
+  (lint-test "(= (length x) 0)"         " =: perhaps (assuming x is a list), (= (length x) 0) -> (null? x)")
+  (lint-test "(= (length x) 1)"         " =: perhaps (assuming x is a list), (= (length x) 1) -> (and (pair? x) (null? (cdr x)))")
+
+  (lint-test "(> (- fltdur 50868) 256)" " >: perhaps (> (- fltdur 50868) 256) -> (> fltdur 51124)")
+  (lint-test "(= (- fltdur 50868) 256)" " =: perhaps (= (- fltdur 50868) 256) -> (= fltdur 51124)")
+  (lint-test "(= (- fltdur 50868) 0)"   " =: perhaps (= (- fltdur 50868) 0) -> (= fltdur 50868)")
+  (lint-test "(< 256 (- fltdur 50868))" " <: perhaps (< 256 (- fltdur 50868)) -> (> fltdur 51124)")
+  (lint-test "(= 256 (- fltdur 50868))" " =: perhaps (= 256 (- fltdur 50868)) -> (= fltdur 51124)")
+  (lint-test "(> (+ fltdur 50868) 256)" " >: perhaps (> (+ fltdur 50868) 256) -> (> fltdur -50612)")
+  (lint-test "(= (+ fltdur 50868) 256)" " =: perhaps (= (+ fltdur 50868) 256) -> (= fltdur -50612)")
+  (lint-test "(= (+ fltdur 50868) 0)"   " =: perhaps (= (+ fltdur 50868) 0) -> (= fltdur -50868)")
+  (lint-test "(< 256 (+ fltdur 50868))" " <: perhaps (< 256 (+ fltdur 50868)) -> (> fltdur -50612)")
+  (lint-test "(= 256 (+ fltdur 50868))" " =: perhaps (= 256 (+ fltdur 50868)) -> (= fltdur -50612)")
+
+  (lint-test "(zero? (- x))"            " zero?: perhaps (zero? (- x)) -> (zero? x)")
+  (lint-test "(zero? (- x y))"          " zero?: perhaps (zero? (- x y)) -> (= x y)")
+  (lint-test "(zero? (- x y z))"        " zero?: perhaps (zero? (- x y z)) -> (= x (+ y z))")
+  (lint-test "(zero? (abs x))"          " zero?: perhaps (zero? (abs x)) -> (zero? x)")
+  (lint-test "(zero? (imag-part x))"    " zero?: perhaps (zero? (imag-part x)) -> (real? x)")
+  (lint-test "(positive? (- x))"        " positive?: perhaps (positive? (- x)) -> (negative? x)")
+  (lint-test "(positive? (- x y))"      " positive?: perhaps (positive? (- x y)) -> (> x y)")
+  (lint-test "(positive? (- x y z))"    " positive?: perhaps (positive? (- x y z)) -> (> x (+ y z))")
+  (lint-test "(negative? (- x))"        " negative?: perhaps (negative? (- x)) -> (positive? x)")
+  (lint-test "(negative? (- x y))"      " negative?: perhaps (negative? (- x y)) -> (< x y)")
+  (lint-test "(negative? (- x y z))"    " negative?: perhaps (negative? (- x y z)) -> (< x (+ y z))")
+  (lint-test "(negative? (string-length s))" " negative?: string-length can't be negative: (negative? (string-length s))")
+  (lint-test "(not (positive? (- n 2)))" " not: perhaps (positive? (- n 2)) -> (> n 2)")
+
+  (lint-test "(+ 1 +i)"                 " +: +i is not a number")
+  (lint-test "(let ((|ABS| abs)) |ABS|)"
+	     " let: | is not a special character, so |ABS| is not the symbol ABS
+               let: perhaps (let ((|ABS| abs)) |ABS|) -> abs")
+
+  (lint-test "(char? '#\\a)"
+	     " char?: perhaps (char? '#\\a) -> #t
+               char?: (char? '#\\a) is always #t
+               char?: quote is not needed here: '#\\a")
+  (lint-test "(string? '\"a\")"
+	     " string?: perhaps (string? '\"a\") -> #t
+               string?: (string? '\"a\") is always #t
+               string?: quote is not needed here: '\"a\"")
+
+  (lint-test "(memq 1.0 x)"		" memq: (memq 1.0 x): perhaps memq -> memv")
+  (lint-test "(assq \"test\" x)"	" assq: (assq \"test\" x): perhaps assq -> assoc")
+  (lint-test "(assq (cons 1 2) x)"	" assq: (assq (cons 1 2) x): perhaps assq -> assoc")
+  (lint-test "(assv #(a) x)"		" assv: (assv #(a) x): perhaps assv -> assoc")
+  (lint-test "(member 'a x (lambda (a b c) (eq? a b)))" " member: member equality function (optional third arg) should take two arguments")
+  (lint-test "(member 'a x (lambda (a b) (eq? a (car b))))" " member: member might perhaps be assq")
+  (lint-test "(member y x (lambda (a b) (equal? a (car b))))" " member: member might perhaps be assoc")
+  (lint-test "(member 1 x (lambda (a b) (> a b)))" " member: perhaps (lambda (a b) (> a b)) -> >")
+  (lint-test "(member 1 x (lambda (a b) (> b a)))" " member: perhaps (lambda (a b) (> b a)) -> <")
+  (lint-test "(member (abs x) lt (lambda (a b) (< b 2)))" " member: a is ignored, so perhaps (member #f ...)")
+  (lint-test "(member 1 x abs)"		" member: abs is a questionable member function")
+  (lint-test "(member x (list \"asdf\"))"
+	     " member: perhaps (member x (list \"asdf\")) -> (string=? x \"asdf\")
+               member: perhaps (list \"asdf\") -> '(\"asdf\")")
+  (lint-test "(member x (list \"asd\" \"abc\" \"asd\"))"
+	     " member: duplicated entry \"asd\" in (list \"asd\" \"abc\" \"asd\")
+               member: perhaps (list \"asd\" \"abc\" \"asd\") -> '(\"asd\" \"abc\" \"asd\")")
+  (lint-test "(memq x '(1))"		" memq: perhaps (memq x '(1)) -> (= x 1)")
+  (lint-test "(memq x '(begin))"	" memq: perhaps (memq x '(begin)) -> (eq? x 'begin)")
+  (lint-test "(memq x (list 'car))"
+	     " memq: perhaps (memq x (list 'car)) -> (eq? x 'car)
+               memq: perhaps (list 'car) -> '(car)")
+  (lint-test "(memq x '(a 'b c))"       " memq: stray quote? (memq x '(a 'b c))
+                                          memq: memq should be member in (memq x '(a 'b c))
+                                          memq: pointless list member: 'b in (memq x '(a 'b c))")
+  (lint-test "(memq x '(a ,b c))"
+	     (if (or pure-s7 immutable-unquote)
+		 " memq: memq should be member in (memq x '(a ,b c)) memq: pointless list member: ,b in (memq x '(a ,b c))"
+		 " memq: memq should be member in (memq x '(a (unquote b) c)) memq: stray comma? (memq x '(a (unquote b) c))"))
+  (lint-test "(memq x '(a (+ 1 2) 3))" "memq: memq should be member in (memq x '(a (+ 1 2) 3))  memq: pointless list member: (+ 1 2) in (memq x '(a (+ 1 2) 3))")
+  (lint-test "(memq x '(a #(a)))"       " memq: memq should be member in (memq x '(a #(a)))
+                                          memq: pointless list member: #(a) in (memq x '(a #(a)))")
+  (lint-test "(memv x '(#f #\\c a 1 () :a))"  "")
+  (lint-test "(memq x '(a b a c))"      " memq: duplicated entry a in '(a b a c)")
+  (lint-test "(assq x '((a . 1)))"      "")
+  (lint-test "(member x (list \"a\" \"b\"))" " member: perhaps (list \"a\" \"b\") -> '(\"a\" \"b\")")
+  (lint-test "(memq x (list 'a 'b 'x))" " memq: perhaps (list 'a 'b 'x) -> '(a b x)")
+  (lint-test "(memq x (map car y))"     " memq: perhaps use assoc: (memq x (map car y)) -> (assq x y)")
+  (lint-test "(memq #t (map null? items))"  " memq: perhaps (memq #t (map null? items)) -> (memq () items)")
+  (lint-test "(memq #t (map cadr items))"   " memq: perhaps avoid 'map: (memq #t (map cadr items)) -> (member #t items (lambda (a b) (cadr b)))")
+  (lint-test "(memq #t (map b items))"   " memq: perhaps avoid 'map: (memq #t (map b items)) -> (member #t items (lambda (a c) (b c)))")
+  (lint-test "(member x (map floor items))" " member: perhaps avoid 'map: (member x (map floor items)) -> (member x items (lambda (a b) (equal? a (floor b))))")
+  (lint-test "(member x (map b items))" " member: perhaps avoid 'map: (member x (map b items)) -> (member x items (lambda (a c) (equal? a (b c))))")
+  (lint-test "(member x (cons y z))"        " member: perhaps avoid 'cons: (member x (cons y z)) -> (or (equal? x y) (member x z))")
+  (lint-test "(member x (append (list x) y))"
+	     " member: perhaps (member x (append (list x) y)) -> (or (equal? x x) (member x y))
+               member: perhaps (append (list x) y) -> (cons x y)")
+  (lint-test "(memq (string->symbol x) (map string->symbol y))" " memq: perhaps (memq (string->symbol x) (map string->symbol y)) -> (member x y string=?)")
+  (lint-test "(memv #\\= (string->list x))" " memv: perhaps (memv #\\= (string->list x)) -> (char-position #\\= x)")
+  (lint-test "(memv #\\= (string->list x start end))"  " memv: perhaps (memv #\\= (string->list x start end)) -> (char-position #\\= x start end)")
+  (lint-test "(memv (string-ref s 0) (string->list x))" " memv: perhaps (memv (string-ref s 0) (string->list x)) -> (char-position (string-ref s 0) x)")
+  (lint-test "(memv (string-ref x 0) '(+ -))" " memv: memv could be memq in (memv (string-ref x 0) '(+ -))
+                                                memv: perhaps (memv (string-ref x 0) '(+ -)) -> #f")
+  (lint-test "(memv (string-ref x 0) '(#\\+ -))" " memv: perhaps (memv (string-ref x 0) '(#\\+ -)) -> (memv (string-ref x 0) '(#\\+))")
+  (lint-test "(memq expr '(#t #f))"     " memq: perhaps (memq expr '(#t #f)) -> (boolean? expr)")
+  (lint-test "(member (denominator k/n) '(1 2 3 4 6))" " member: (member (denominator k/n) '(1 2 3 4 6)): perhaps member -> memv
+                                                         member: member could be memv in (member (denominator k/n) '(1 2 3 4 6))")
+
+  (lint-test "(member x '(1 0))"                    " member: member could be memv in (member x '(1 0))")
+  (lint-test "(memq (strname 0) '(#\\{ #\\[ #\\())" " memq: memq should be memv in (memq (strname 0) '(#\\{ #\\[ #\\())")
+  (lint-test "(member (car op) '(x y z))"           " member: member could be memq in (member (car op) '(x y z))")
+  (lint-test "(memv (car op) '(x y z))"             " memv: memv could be memq in (memv (car op) '(x y z))")
+  (lint-test "(member (car tail) '(:x :y :z))"      " member: member could be memq in (member (car tail) '(:x :y :z))")
+  (lint-test "(member x (list 1 0))"                " member: member could be memv in (member x (list 1 0))
+                                                      member: perhaps (list 1 0) -> '(1 0)")
+  (lint-test "(memq (strname 0) (list #\\{ #\\[ #\\())" " memq: memq should be memv in (memq (strname 0) (list #\\{ #\\[ #\\())
+                                                          memq: perhaps (list #\\{ #\\[ #\\() -> '(#\\{ #\\[ #\\()")
+  (lint-test "(member (car op) (list x y z))"       "")
+  (lint-test "(member (car op) (list \"a\" (f x)))" "")
+  (lint-test "(member (car op) (list \"a\" #(1)))"  " member: perhaps (list \"a\" #(1)) -> '(\"a\" #(1)) member: #(1) could be #i(1)")
+  (lint-test "(member (car op) '(\"a\" #()))"       "")
+  (lint-test "(memq (car op) '(\"a\" #()))"         " memq: memq should be member in (memq (car op) '(\"a\" #()))
+                                                      memq: pointless list member: \"a\" in (memq (car op) '(\"a\" #()))")
+  (lint-test "(member (car op) '(#f ()))"           " member: member could be memq in (member (car op) '(#f ()))")
+  (lint-test "(assq c '((#\\b . 2) (#\\o . 8) (#\\d . 10)))" " assq: assq should be assv in (assq c '((#\\b . 2) (#\\o . 8) (#\\d . 10)))")
+  (lint-test "(assq (string-ref name 0) bad-var-names)" "") ; this is ok in s7
+  (lint-test "(assoc order '((1 . 1.0) (2 . 1.3)) =)" "")
+  (lint-test "(assoc order '((1 . 1.0) (2 . 1.3)))" " assoc: assoc could be assv in (assoc order '((1 . 1.0) (2 . 1.3)))")
+  (lint-test "(assq order '((1 . 1.0) (2 . 1.3)))"  " assq: assq should be assv in (assq order '((1 . 1.0) (2 . 1.3)))")
+  (lint-test "(assq c (list '(#\\b . 2) '(#\\o . 8) '(#\\d . 10)))"
+                                                    " assq: assq should be assv in (assq c (list '(#\\b . 2) '(#\\o . 8) '(#\\d . 10)))
+                                                      assq: perhaps (list '(#\\b . 2) '(#\\o . 8) '(#\\d . 10)) -> '((#\\b . 2) (#\\o . 8) (#\\d . 10))")
+  (lint-test "(assoc order (list '(1 . 1.0) '(2 . 1.3)))" " assoc: assoc could be assv in (assoc order (list '(1 . 1.0) '(2 . 1.3)))
+                                                            assoc: perhaps (list '(1 . 1.0) '(2 . 1.3)) -> '((1 . 1.0) (2 . 1.3))")
+  (lint-test "(assoc x y string-position)" "") ; 'not in car sig
+  (lint-test "(assv order (list '(a . 1.0) '(b . 1.3)))"  " assv: assv should be assoc in (assv order (list '(a . 1.0) '(b . 1.3)))
+                                                            assv: perhaps (list '(a . 1.0) '(b . 1.3)) -> '((a . 1.0) (b . 1.3))")
+  (lint-test "(member (car (string->list S)) (string->list x))"
+	     " member: perhaps (member (car (string->list S)) (string->list x)) -> (char-position (car (string->list S)) x)
+               member: perhaps (car (string->list S)) -> (string-ref S 0)")
+  (lint-test "(memq x '(a #<eof> #<undefined> #<unspecified>))" "")
+  (lint-test "(member x '(a #<eof> #<undefined> #<unspecified>))" " member: member could be memq in (member x '(a #<eof> #<undefined> #<unspecified>))")
+  (lint-test "(memq x '(a #<eof> #t #<unspecified>))" "")
+  (lint-test "(member x '(a #<eof> #t #<unspecified>))" " member: member could be memq in (member x '(a #<eof> #t #<unspecified>))")
+
+  (lint-test "(if #f x y)"		" if: if test is never true: (if #f x y) if: perhaps (if #f x y) -> y")
+  (lint-test "(if #t #f)"		" if: if test is never false: (if #t #f)  if: perhaps (if #t #f) -> #f")
+  (lint-test "(if x #f #t)"		" if: perhaps (if x #f #t) -> (not x)")
+  (lint-test "(if x #t #t)"		" if: if is not needed here: (if x #t #t) -> #t")
+  (lint-test "(if x #f #f)"		" if: if is not needed here: (if x #f #f) -> #f")
+  (lint-test "(if x (+ y 1) (+ y 1))"	" if: if is not needed here: (if x (+ y 1) (+ y 1)) -> (+ y 1)")
+  (lint-test "(if #f #f)"		" if: perhaps (if #f #f) -> #<unspecified>")
+  (lint-test "(if #f x)"		" if: if test is never true: (if #f x)  if: perhaps (if #f x) -> #<unspecified>")
+  (lint-test "(if #t x y)"		" if: if test is never false: (if #t x y)  if: perhaps (if #t x y) -> x")
+  (lint-test "(if x #t #f)"		" if: perhaps (if x #t #f) -> x")
+  (lint-test "(if x y #f)"		" if: perhaps (if x y #f) -> (and x y)")
+  (lint-test "(if x y #t)"		" if: perhaps (if x y #t) -> (or (not x) y)")
+  (lint-test "(if x #f y)"		" if: perhaps (if x #f y) -> (and (not x) y)")
+  (lint-test "(if x #t y)"		" if: perhaps (if x #t y) -> (or x y)")
+  (lint-test "(if (not x) y #t)"	" if: perhaps (if (not x) y #t) -> (or x y)")
+  (lint-test "(if (not x) #f y)"	" if: perhaps (if (not x) #f y) -> (and x y)")
+  (lint-test "(if x x y)"               " if: perhaps (if x x y) -> (or x y)")
+  (lint-test "(if (not x) y x)"         " if: perhaps (if (not x) y x) -> (or x y)")
+  (lint-test "(if (< 1 2) x y)"		" if: perhaps (< 1 2) -> #t  if: perhaps (if (< 1 2) x y) -> x")
+  (lint-test "(if (and x z) y #f)"      " if: perhaps (if (and x z) y #f) -> (and x z y)")
+  (lint-test "(if (and x z) (and y w) #f)" " if: perhaps (if (and x z) (and y w) #f) -> (and x z y w)")
+  (lint-test "(if (or x z) #t y)"       " if: perhaps (if (or x z) #t y) -> (or x z y)")
+  (lint-test "(if (or x z) #t (or y w))" " if: perhaps (if (or x z) #t (or y w)) -> (or x z y w)")
+  (lint-test "(if (not (or x z)) y #t)" " if: perhaps (if (not (or x z)) y #t) -> (or x z y)")
+  (lint-test "(if (not (and x z)) #f y)" " if: perhaps (if (not (and x z)) #f y) -> (and x z y)")
+  (lint-test "(if (cons 1 2) x y)"	" if: if test is never false: (if (cons 1 2) x y)")
+  (lint-test "(if (getenv x) x w)"      "") ; changed 6-May-22
+  (lint-test "(if y)"			" if: if has too few clauses: (if y)")
+  (lint-test "(if y z a b)"		" if: if has too many clauses: (if y z a b)")
+  (lint-test "(if x y (if z y))"	" if: perhaps (if x y (if z y)) -> (if (or x z) y)")
+  (lint-test "(if x y (if x y))"	" if: perhaps (if x y (if x y)) -> (if x y) if: weird repetition! perhaps (if x y (if x y)) -> (if x y)")
+  (lint-test "(if x (if x y))"		" if: perhaps (if x (if x y)) -> (if x y)")
+  (lint-test "(if x (set! y #t) (set! y #f))" " if: perhaps (if x (set! y #t) (set! y #f)) -> (set! y x)")
+  (lint-test "(if x (f 1 2 1) (f 1 2 2))" " if: perhaps (if x (f 1 2 1) (f 1 2 2)) -> (f 1 2 (if x 1 2))")
+  (lint-test "(if x (f 1 1 1) (f 1 2 1))" " if: perhaps (if x (f 1 1 1) (f 1 2 1)) -> (f 1 (if x 1 2) 1)")
+  (lint-test "(if x (f (+ x 1) (* y 2) (+ x 1)) (f (+ x 1) (+ x 1) (+ x 1)))"
+	     " if: perhaps (if x (f (+ x 1) (* y 2) (+ x 1)) (f (+ x 1) (+ x 1) (+ x 1))) -> (f (+ x 1) (if x (* y 2) (+ x 1)) (+ x 1))")
+  (lint-test "(if (and (= x y) z) (+ x 1) #f)" " if: perhaps (if (and (= x y) z) (+ x 1) #f) -> (and (= x y) z (+ x 1))")
+  (lint-test "(if x (f y) (else z))"    " if: else (as car of false branch of if) makes no sense: (if x (f y) (else z))")
+
+  (lint-test "(if old (list form) (cons form old))" " if: perhaps (if old (list form) (cons form old)) -> (cons form (if old () old))")
+  (lint-test "(if old (cons form old) (list form))" " if: perhaps (if old (cons form old) (list form)) -> (cons form (or old ()))")
+  (lint-test "(if (not x) (list y) (cons y x))"     " if: perhaps (if (not x) (list y) (cons y x)) -> (cons y (or x ()))")
+  (lint-test "(if (not x) (cons y x) (list y))"     " if: perhaps (if (not x) (cons y x) (list y)) -> (cons y (if (not x) x ()))")
+  (lint-test "(if (float-vector-ref fv 0) 0 1)"     " if: if test is never false: (if (float-vector-ref fv 0) 0 1)")
+
+  (lint-test "(if x (set! y #f) (set! y #t))" " if: perhaps (if x (set! y #f) (set! y #t)) -> (set! y (not x))")
+  (lint-test "(if x (set! y x) (set! y 21))"  " if: perhaps (if x (set! y x) (set! y 21)) -> (set! y (or x 21))")
+  (lint-test "(if x (set! y z) (set! y w))"   " if: perhaps (if x (set! y z) (set! y w)) -> (set! y (if x z w))")
+  (lint-test "(if x (+ y 1) (- y 1))"    " if: perhaps (if x (+ y 1) (- y 1)) -> ((if x + -) y 1)")
+  (lint-test "(if x (set! y 1) (set! y (+ x 1)))" " if: perhaps (if x (set! y 1) (set! y (+ x 1))) -> (set! y (if x 1 (+ x 1)))")
+  (lint-test "(if x (set! y (+ x 1)) (set! y 1))" " if: perhaps (if x (set! y (+ x 1)) (set! y 1)) -> (set! y (if x (+ x 1) 1))")
+  (lint-test "(if x (or y z) (and y z))"      " if: perhaps (if x (or y z) (and y z)) -> ((if x or and) y z)")
+  (lint-test "(if x (or (f y) z) (and y (f z)))" "")
+  (lint-test "(if (positive? x) (log x) (exp x))" " if: perhaps (if (positive? x) (log x) (exp x)) -> ((if (positive? x) log exp) x)")
+
+  (lint-test "(if x (if y z))"		" if: perhaps (if x (if y z)) -> (if (and x y) z)")
+  (lint-test "(if (cadr x) (if (cadr x) 0))" " if: perhaps (if (cadr x) (if (cadr x) 0)) -> (if (cadr x) 0)")
+  (lint-test "(if (cadr x) 3 (if (not (cadr x)) 4))" " if: perhaps (if (cadr x) 3 (if (not (cadr x)) 4)) -> (if (cadr x) 3 4)")
+  (lint-test "(if (cadr x) 3 (if (not (cadr x)) 4 5))" " if: perhaps (if (cadr x) 3 (if (not (cadr x)) 4 5)) -> (if (cadr x) 3 4)")
+  (lint-test "(if x x y)"		" if: perhaps (if x x y) -> (or x y)")
+  (lint-test "(if (not x) x y)"         " if: perhaps (if (not x) x y) -> (and x y)")
+  (lint-test "(if x (not x) y)"         " if: perhaps (if x (not x) y) -> (and (not x) y)")
+  (lint-test "(if (not x) y x)"         " if: perhaps (if (not x) y x) -> (or x y)")
+  (lint-test "(if x y (not x))"         " if: perhaps (if x y (not x)) -> (or (not x) y)")
+
+  (lint-test "(if a A A)"               " if: if is not needed here: (if a A A) -> A")
+  (lint-test "(if A A (if B B C))"      " if: perhaps (if A A (if B B C)) -> (or A (if B B C))  if: perhaps (if B B C) -> (or B C)")
+  (lint-test "(if a (if b A) A)"        " if: perhaps (if a (if b A) A) -> (if (or (not a) b) A)")
+  (lint-test "(if a (if (not a) B) A)"  " if: perhaps (if a (if (not a) B) A) -> (if (not a) A)")
+  (lint-test "(if a (if (not a) B C) A)"  " if: perhaps (if a (if (not a) B C) A) -> (if a C A)")
+  (lint-test "(if a A (if b B A))"      " if: perhaps (if a A (if b B A)) -> (if (or a (not b)) A B)")
+  (lint-test "(if a A (if b A B))"      " if: perhaps (if a A (if b A B)) -> (if (or a b) A B)")
+  (lint-test "(if a (if b B A) A)"      " if: perhaps (if a (if b B A) A) -> (if (and a b) B A)")
+  (lint-test "(if a (if b A B) A)"      " if: perhaps (if a (if b A B) A) -> (if (and a (not b)) B A)")
+  (lint-test "(if a A (if (not a) B))"  " if: perhaps (if a A (if (not a) B)) -> (if a A B)")
+
+  (lint-test "(if A (if B C D) D)"        " if: perhaps (if A (if B C D) D) -> (if (and A B) C D)")
+  (lint-test "(if A (if B C D) C)"        " if: perhaps (if A (if B C D) C) -> (if (and A (not B)) D C)")
+  (lint-test "(if A B (if C B D))"        " if: perhaps (if A B (if C B D)) -> (if (or A C) B D)")
+  (lint-test "(if A B (if C D B))"        " if: perhaps (if A B (if C D B)) -> (if (or A (not C)) B D)")
+  (lint-test "(if A (and B C) (and B D))" " if: perhaps (if A (and B C) (and B D)) -> (and B (if A C D))")
+  (lint-test "(if A (or B C) (or B D))"   " if: perhaps (if A (or B C) (or B D)) -> (or B (if A C D))")
+  (lint-test "(if A (and B C) (and D C))" " if: perhaps (if A (and B C) (and D C)) -> (and (if A B D) C)")
+  (lint-test "(if A (or B C) (or D C))"   " if: perhaps (if A (or B C) (or D C)) -> (or (if A B D) C)")
+
+  (lint-test "(if a (if b A B) (if b B A))"
+	     " if: perhaps (if a (if b A B) (if b B A)) -> (if (eq? (not a) (not b)) A B)")
+  (lint-test "(if (not a) (if b A B) (if b B A))"
+	     " if: perhaps (if (not a) (if b A B) (if b B A)) -> (if (eq? (not a) (not b)) B A)")
+  (lint-test "(if (not a) (if (not b) A B) (if (not b) B A))"
+	     " if: perhaps (if (not a) (if (not b) A B) (if (not b) B A)) -> (if (eq? (not a) (not b)) A B)")
+  (lint-test "(if a (if (not b) A B) (if (not b) B A))"
+	     " if: perhaps (if a (if (not b) A B) (if (not b) B A)) -> (if (eq? (not a) (not b)) B A)")
+  (lint-test "(if a (if b A B) (if b A B))"
+	     " if: if is not needed here: (if a (if b A B) (if b A B)) -> (if b A B)")
+  (lint-test "(if test (< a b) (> b a))"        " if: if is not needed here: (if test (< a b) (> b a)) -> (< a b)")
+  (lint-test "(if test (< a b c) (> c b a))"    " if: if is not needed here: (if test (< a b c) (> c b a)) -> (< a b c)")
+  (lint-test "(if test (* a b) (* b a))"        " if: if is not needed here: (if test (* a b) (* b a)) -> (* a b)")
+  (lint-test "(if test (< a b) (not (>= a b)))"
+	     " if: if is not needed here: (if test (< a b) (not (>= a b))) -> (< a b)
+               if: perhaps (not (>= a b)) -> (< a b)")
+
+  (lint-test "(if A (if B C #f) #f)"    " if: perhaps (if A (if B C #f) #f) -> (and A B C)            if: perhaps (if B C #f) -> (and B C)")
+  (lint-test "(if A (if B #f D) #f)"    " if: perhaps (if A (if B #f D) #f) -> (and A (not B) D)      if: perhaps (if B #f D) -> (and (not B) D)")
+  (lint-test "(if A #f (if C #f D))"    " if: perhaps (if A #f (if C #f D)) -> (and (not (or A C)) D) if: perhaps (if C #f D) -> (and (not C) D)")
+  (lint-test "(if A #f (if C D #f))"    " if: perhaps (if A #f (if C D #f)) -> (and (not A) C D)      if: perhaps (if C D #f) -> (and C D)")
+  (lint-test "(if A (if B d c) (if B d a))" " if: perhaps (if A (if B d c) (if B d a)) -> (if B d (if A c a))")
+  (lint-test "(if A (if B c a) (if B d a))" " if: perhaps (if A (if B c a) (if B d a)) -> (if B (if A c d) a)")
+
+  (lint-test "(if (> (random 10) 1) (> (random 10) 1) x)" "")
+  (lint-test "(if (assq (string->symbol x) y) (assq (string->symbol x) y) z)"
+	     " if: perhaps (if (assq (string->symbol x) y) (assq (string->symbol x) y) z) -> (or (assq (string->symbol x) y) z)")
+  (lint-test "(if x y x)"		" if: perhaps (if x y x) -> (and x y)")
+  (lint-test "(if (> x 1) (> x 1) (< x 2))" " if: perhaps (if (> x 1) (> x 1) (< x 2)) -> #t")
+  (lint-test "(if x x x)"		" if: perhaps (if x x x) -> x  if: if is not needed here: (if x x x) -> x")
+  (lint-test "(if x x)"			" if: perhaps (if x x) -> (or x #<unspecified>)")
+  (lint-test "(if (> x 1) (> x 1))"	" if: perhaps (if (> x 1) (> x 1)) -> (or (> x 1) #<unspecified>)")
+  (lint-test "(if (display x) (display x) y)" "")
+  (lint-test "(if (= x 1) 2 (if (= x 3) 2 3))"
+	     "if: perhaps (if (= x 1) 2 (if (= x 3) 2 3)) -> (case x ((1) 2) ((3) 2) (else 3))
+	      if: perhaps (if (= x 1) 2 (if (= x 3) 2 3)) -> (if (member x '(1 3) =) 2 3)")
+  (lint-test "(if a b (if c d (if e f g)))" " if: perhaps use cond: (if a b (if c d (if e f g))) -> (cond (a b) (c d) (e f) (else g))")
+  (lint-test "(if a b (if c d (if e f)))" " if: perhaps use cond: (if a b (if c d (if e f))) -> (cond (a b) (c d) (e f))")
+  (lint-test "(if a (begin (b) c) (if d e (if f g (begin (h) i))))"
+	     " if: perhaps use cond: (if a (begin (b) c) (if d e (if f g (begin (h) i)))) -> (cond (a (b) c) (d e) (f g) (else (h) i))")
+  (lint-test "(if (f x) (g (f x)))"     " if: perhaps (if (f x) (g (f x))) -> (cond ((f x) => g))")
+  (lint-test "(if (f x) (g (f x)) z)"   " if: perhaps (if (f x) (g (f x)) z) -> (cond ((f x) => g) (else z))")
+  (lint-test "(if x (set! y z) (set! w z))" "")
+  (lint-test "(if x (set! y x) (set! y #f))" " if: perhaps (if x (set! y x) (set! y #f)) -> (set! y x)")
+  (lint-test "(if x (set! y z) (set! y w))" " if: perhaps (if x (set! y z) (set! y w)) -> (set! y (if x z w))")
+  (lint-test "(if x (set! y (+ 1 z)) (set! y (+ 1 w)))" " if: perhaps (if x (set! y (+ 1 z)) (set! y (+ 1 w))) -> (set! y (+ 1 (if x z w)))")
+  (lint-test "(if (< x y) (set! x y))"    " if: perhaps (if (< x y) (set! x y)) -> (set! x (max x y))")
+  (lint-test "(if (<= y x) (set! x y))"   " if: perhaps (if (<= y x) (set! x y)) -> (set! x (min x y))")
+  (lint-test "(if (> x y) (set! x y))"    " if: perhaps (if (> x y) (set! x y)) -> (set! x (min x y))")
+  (lint-test "(if (>= y x) (set! x y))"   " if: perhaps (if (>= y x) (set! x y)) -> (set! x (max x y))")
+  (lint-test "(if (< x y) x y)"           " if: perhaps (if (< x y) x y) -> (min x y)")
+  (lint-test "(if (< x y) y x)"           " if: perhaps (if (< x y) y x) -> (max y x)")
+  (lint-test "(if (> x y) x y)"           " if: perhaps (if (> x y) x y) -> (max x y)")
+  (lint-test "(if (> x y) y x)"           " if: perhaps (if (> x y) y x) -> (min y x)")
+  (lint-test "(if (= x y) x y)"           " if: perhaps (if (= x y) x y) -> y")
+  (lint-test "(if (= x y) y x)"           " if: perhaps (if (= x y) y x) -> x")
+  (lint-test "(if (pair? x) #t #f)"       " if: perhaps (if (pair? x) #t #f) -> (pair? x)")
+  (lint-test "(if (pair? x) #t z)"        " if: perhaps (if (pair? x) #t z) -> (or (pair? x) z)")
+  (lint-test "(if x (not y) (not z))"     "")
+  (lint-test "(if (and (symbol? name) (not (defined? name))) 3 2)" "")
+  (lint-test "(if (and (symbol? name) (not (constant? name))) 3 2)" "")
+  (lint-test "(if (and (let? obj) (defined? 'value obj)) 3 2)" "")
+  (lint-test "(define (f1 snd progress) (let ((fc (list 1.0 progress 0.0))) fc))"
+	     " f1: perhaps (let ((fc (list 1.0 progress 0.0))) fc) -> (list 1.0 progress 0.0)")
+  (lint-test "(define (f1 snd) (let ((fc (list 1.0 :progress 0.0))) (copy fc)))"
+	     "f1: perhaps (let ((fc (list 1.0 :progress 0.0))) (copy fc)) -> (copy (list 1.0 :progress 0.0))
+              f1: fc can probably be moved to f1's closure")
+
+  (lint-test "(if (> (vector-ref ind i) (vector-ref ind j)) (vector-set! ind i (vector-ref ind j)))"
+	     " if: perhaps (if (> (vector-ref ind i) (vector-ref ind j)) (vector-set! ind i... ->
+                 (vector-set! ind i (min (vector-ref ind i) (vector-ref ind j)))")
+  (lint-test "(if (<= (list-ref ind i) (list-ref ind j)) (list-set! ind i (list-ref ind j)))"
+	     " if: perhaps (if (<= (list-ref ind i) (list-ref ind j)) (list-set! ind i (list-ref ind j))) ->
+                 (list-set! ind i (max (list-ref ind i) (list-ref ind j)))")
+  (lint-test "(if (<= (list-ref ind i) 32) (list-set! ind i 32))"
+	     " if: perhaps (if (<= (list-ref ind i) 32) (list-set! ind i 32)) -> (list-set! ind i (max (list-ref ind i) 32))")
+  (lint-test "(if (<= 32 (list-ref ind i)) (list-set! ind i 32))"
+	     " if: perhaps (if (<= 32 (list-ref ind i)) (list-set! ind i 32)) -> (list-set! ind i (min 32 (list-ref ind i)))")
+  (lint-test "(if (> 32 (list-ref ind i)) (list-set! ind i 32))"
+	     " if: perhaps (if (> 32 (list-ref ind i)) (list-set! ind i 32)) -> (list-set! ind i (max 32 (list-ref ind i)))")
+
+  (lint-test "(if (eq? (car sv) 'list-values) 'list (car sv))"
+	     " if: perhaps use case: (if (eq? (car sv) 'list-values) 'list (car sv)) -> (case (car sv) ((list-values) 'list) (else))")
+  (lint-test "(if (eq? (car sv) 'list-values) (car sv) 'list)"
+	     " if: perhaps use case: (if (eq? (car sv) 'list-values) (car sv) 'list) -> (case (car sv) ((list-values)) (else 'list))")
+  (lint-test "(let ((q (car sv))) (if (eq? q 'list-values) 'list q))"
+	     " let: perhaps use case: (let ((q (car sv))) (if (eq? q 'list-values) 'list q)) -> (case (car sv) ((list-values) 'list) (else))")
+  (lint-test "(let ((q (car sv))) (if (eq? q 'list-values) q 'list))"
+	     " let: perhaps use case: (let ((q (car sv))) (if (eq? q 'list-values) q 'list)) -> (case (car sv) ((list-values)) (else 'list))")
+  (lint-test "(if (eq? (caddr x) 'a) b (caddr x))"
+	     " if: perhaps use case: (if (eq? (caddr x) 'a) b (caddr x)) -> (case (caddr x) ((a) b) (else))")
+  (lint-test "(let ((q (caddr x))) (if (eq? q 'a) b q))"
+	     " let: perhaps use case: (let ((q (caddr x))) (if (eq? q 'a) b q)) -> (case (caddr x) ((a) b) (else))")
+  (lint-test "(let ((q (read-char sv))) (if (eof-object? q) 0 q))"
+	     " let: perhaps use case: (let ((q (read-char sv))) (if (eof-object? q) 0 q)) -> (case (read-char sv) ((#<eof>) 0) (else))")
+  (lint-test "(let ((q (f x))) (if (null? q) 0 q))"
+	     " let: perhaps use case: (let ((q (f x))) (if (null? q) 0 q)) -> (case (f x) ((()) 0) (else))")
+  (lint-test "(let* ((p 32) (q (* p (car sv)))) (if (= q 0) q p))"
+	     " let*: perhaps use case: (let* ((p 32) (q (* p (car sv)))) (if (= q 0) q p)) -> (let ((p 32)) (case (* p (car sv)) ((0)) (else p)))")
+  (lint-test "(let ((q (read-char sv))) (if (eof-object? q) 0 (f q)))"
+	     " let: perhaps use case: (let ((q (read-char sv))) (if (eof-object? q) 0 (f q))) -> (case (read-char sv) ((#<eof>) 0) (else => f))")
+  (lint-test "(let ((q (read-char sv))) (if (eof-object? q) (f q) 0))"
+	     " let: perhaps use case: (let ((q (read-char sv))) (if (eof-object? q) (f q) 0)) -> (case (read-char sv) ((#<eof>) => f) (else 0))")
+  (lint-test "(if (null? (f x)) 0 (f x))" " if: perhaps use case: (if (null? (f x)) 0 (f x)) -> (case (f x) ((()) 0) (else))")
+  (lint-test "(if (null? (caddr x)) 0 (caddr x))" " if: perhaps use case: (if (null? (caddr x)) 0 (caddr x)) -> (case (caddr x) ((()) 0) (else))")
+  (lint-test "(if (null? (caddr x)) () (caddr x))" " if: perhaps use case: (if (null? (caddr x)) () (caddr x)) -> (case (caddr x) ((()) ()) (else))")
+  (lint-test "(if (eq? (car sv) 'a) 'list (f (car sv)))"
+	     " if: perhaps use case: (if (eq? (car sv) 'a) 'list (f (car sv))) -> (case (car sv) ((a) 'list) (else => f))")
+  (lint-test "(if (eq? (car sv) 'a) (f (car sv)) 'list)"
+	     " if: perhaps use case: (if (eq? (car sv) 'a) (f (car sv)) 'list) -> (case (car sv) ((a) => f) (else 'list))")
+  (lint-test "(let ((q (car sv))) (cond ((eq? q 'list-values) 'list) (else q)))"
+	     " let: perhaps use case: (let ((q (car sv))) (cond ((eq? q 'list-values) 'list) (else q))) -> (case (car sv) ((list-values) 'list) (else))")
+
+  (lint-test "(if A (f x) (or (f x) (g y)))" " if: perhaps (if A (f x) (or (f x) (g y))) -> (or (f x) (and (not A) (g y)))")
+  (lint-test "(if A (or (f x) (g y)) (f x))" " if: perhaps (if A (or (f x) (g y)) (f x)) -> (or (f x) (and A (g y)))")
+  (lint-test "(if A (f x) (or (f x) (g y) (h z)))" " if: perhaps (if A (f x) (or (f x) (g y) (h z))) -> (or (f x) (and (not A) (or (g y) (h z))))")
+  (lint-test "(if A (or (f x) (g y) (h z)) (f x))" " if: perhaps (if A (or (f x) (g y) (h z)) (f x)) -> (or (f x) (and A (or (g y) (h z))))")
+  (lint-test "(if A (or (f x) (h z)) (or (f x) (g y)))" " if: perhaps (if A (or (f x) (h z)) (or (f x) (g y))) -> (or (f x) (if A (h z) (g y)))")
+  (lint-test "(if A (and (f x) (h z)) (and (f x) (g y)))" " if: perhaps (if A (and (f x) (h z)) (and (f x) (g y))) -> (and (f x) (if A (h z) (g y)))")
+  (lint-test "(if A (f x) (begin (f x) (g y)))" " if: perhaps (if A (f x) (begin (f x) (g y))) -> (begin (f x) (when (not A) (g y)))")
+  (lint-test "(if A (begin (f x) (g y)) (f x))" " if: perhaps (if A (begin (f x) (g y)) (f x)) -> (begin (f x) (when A (g y)))")
+  (lint-test "(if A (f x) (begin (f x) (g y) (h z)))" " if: perhaps (if A (f x) (begin (f x) (g y) (h z))) -> (begin (f x) (when (not A) (g y) (h z)))")
+  (lint-test "(if A (begin (f x) (g y) (h z)) (f x))" " if: perhaps (if A (begin (f x) (g y) (h z)) (f x)) -> (begin (f x) (when A (g y) (h z)))")
+
+  (lint-test "(if x (set! a (* 2 b)) (set! a (* 3 b)))" " if: perhaps (if x (set! a (* 2 b)) (set! a (* 3 b))) -> (set! a (* (if x 2 3) b))")
+  (lint-test "(if x y (cond ((= y z) 2) (else 3)))"
+	     " if: perhaps (if x y (cond ((= y z) 2) (else 3))) -> (cond (x y) ((= y z) 2) (else 3))")
+  (lint-test "(if x y (cond ((= y z) 2) ((= y 2) 3)))"
+	     " if: perhaps (if x y (cond ((= y z) 2) ((= y 2) 3))) -> (cond (x y) ((= y z) 2) ((= y 2) 3))")
+  (lint-test "(if (eof-object? x) 32 (case x ((#\\a) 3) (else 4)))"
+	     " if: perhaps (if (eof-object? x) 32 (case x ((#\\a) 3) (else 4))) -> (case x ((#<eof>) 32) ((#\\a) 3) (else 4))
+               if: perhaps (case x ((#\\a) 3) (else 4)) -> (if (eqv? x #\\a) 3 4)")
+  (lint-test "(if (< x 0) (if (< y 0) (if (< z 0) (+ a b c d e f g h i j k l m n o p q r s) z) y) x)"
+	     " if: perhaps (if (< x 0) (if (< y 0) (if (< z 0) (+ a b c d e f g h i j k l m n o p q r... ->
+                 (cond ((>= x 0) x) ((>= y 0) y) ((>= z 0) z) (else (+ a b c d e f g h i j k l m n o p q r s)))
+               if: surely there's a better name for this variable than l")
+  (lint-test "(if (< x 0) (if (< y 0) y (if (< z 0) z (+ a b c d e f g h i j k l m n o p q r s))) x)"
+	     " if: perhaps (if (< x 0) (if (< y 0) y (if (< z 0) z (+ a b c d e f g h i j k l m n o p... ->
+                 (cond ((>= x 0) x) ((< y 0) y) ((< z 0) z) (else (+ a b c d e f g h i j k l m n o p q r s)))
+               if: surely there's a better name for this variable than l")
+  (lint-test "(if (< x 0) x (if (< y 0) (if (< z 0) (+ a b c d e f g h i j k l m n o p q r s) z) y))"
+	     " if: perhaps (if (< x 0) x (if (< y 0) (if (< z 0) (+ a b c d e f g h i j k l m n o p q... ->
+                 (cond ((< x 0) x) ((>= y 0) y) ((>= z 0) z) (else (+ a b c d e f g h i j k l m n o p q r s)))
+               if: surely there's a better name for this variable than l")
+  (lint-test "(if (< x 1) (let ((y (+ x 1)) (z (- x 1))) (+ y z)) (let ((y (+ x 1)) (z (+ x 2))) (- y z)))"
+	     " if: perhaps (if (< x 1) (let ((y (+ x 1)) (z (- x 1))) (+ y z)) (let ((y (+ x 1)) (z... ->
+                 (let ((y (+ x 1))) (if (< x 1) (let ((z (- x 1))) (+ y z)) (let ((z (+ x 2))) (- y z))))
+               if: perhaps (let ((y (+ x 1)) (z (- x 1))) (+ y z)) -> (+ (+ x 1) (- x 1))
+               if: perhaps (let ((y (+ x 1)) (z (+ x 2))) (- y z)) -> (- (+ x 1) (+ x 2))")
+  (lint-test "(if (< x 1) (let ((y (+ x 1)) (z (- x 1))) (+ y z)) (let ((y (+ x 1)) (z (- x 1))) (- y z)))"
+	     " if: perhaps (if (< x 1) (let ((y (+ x 1)) (z (- x 1))) (+ y z)) (let ((y (+ x 1)) (z... ->
+                 (let ((<1> (< x 1))) (let ((y (+ x 1)) (z (- x 1))) ((if <1> + -) y z)))
+               if: perhaps (let ((y (+ x 1)) (z (- x 1))) (+ y z)) -> (+ (+ x 1) (- x 1))
+               if: perhaps (let ((y (+ x 1)) (z (- x 1))) (- y z)) -> (- (+ x 1) (- x 1))")
+  (lint-test "(if (> (+ a b) 3) (let ((a x) (c y)) (* a (log c))) (let ((b z) (c y)) (+ b (log c))))"
+	     "if: perhaps (if (> (+ a b) 3) (let ((a x) (c y)) (* a (log c))) (let ((b z) (c y)) (+... ->
+    (let ((c y))
+      (if (> (+ a b) 3)
+          (let ((a x))
+            (* a (log c)))
+          (let ((b z))
+            (+ b (log c)))))
+            if: perhaps (let ((a x) (c y)) (* a (log c))) -> (* x (log y))
+            if: perhaps (let ((b z) (c y)) (+ b (log c))) -> (+ z (log y))")
+
+  (lint-test "(if (> (+ a b) 3) (let ((a (+ x 1)) (c y)) (* a (log c))) (let ((a (+ x 1)) (c y)) (+ a (log c))))"
+	     " if: perhaps (if (> (+ a b) 3) (let ((a (+ x 1)) (c y)) (* a (log c))) (let ((a (+ x... ->
+                (let ((<1> (> (+ a b) 3))) (let ((a (+ x 1)) (c y)) ((if <1> * +) a (log c))))
+               if: perhaps (let ((a (+ x 1)) (c y)) (* a (log c))) -> (* (+ x 1) (log y))
+               if: perhaps (let ((a (+ x 1)) (c y)) (+ a (log c))) -> (+ (+ x 1) (log y))")
+  (lint-test "(let ((a (f x)) (b (g y)) (c (g z))) (h a b c))"
+	     " let: perhaps (let ((a (f x)) (b (g y)) (c (g z))) (h a b c)) -> (h (f x) (g y) (g z))")
+
+  (lint-test "(if a (if b d e) (if c d e))"     " if: perhaps (if a (if b d e) (if c d e)) -> (if (if a b c) d e)")
+  (lint-test "(if a (if b d) (if c d))"         " if: perhaps (if a (if b d) (if c d)) -> (if (if a b c) d)")
+  (lint-test "(if a (if (f b) d) (if (f c) d))" " if: perhaps (if a (if (f b) d) (if (f c) d)) -> (if (if a (f b) (f c)) d)")
+  (lint-test "(if a (if b c d) d)"              " if: perhaps (if a (if b c d) d) -> (if (and a b) c d)")
+
+  (lint-test "(if x y (if (not x) z w))"        " if: perhaps (if x y (if (not x) z w)) -> (if x y z)")
+  (lint-test "(if x y (if (not x) z))"          " if: perhaps (if x y (if (not x) z)) -> (if x y z)")
+  (lint-test "(if x y (if x z))"                " if: perhaps (if x y (if x z)) -> (if x y)")
+  (lint-test "(if x y (if x z w))"              " if: perhaps (if x y (if x z w)) -> (if x y w)")
+  (lint-test "(if x (if x z w) y)"              " if: perhaps (if x (if x z w) y) -> (if x z y)")
+  (lint-test "(if x (if x z w))"                " if: perhaps (if x (if x z w)) -> (if x z w)")
+  (lint-test "(if x (if x z) w)"                " if: perhaps (if x (if x z) w) -> (if x z w)")
+  (lint-test "(if x (if x y))"                  " if: perhaps (if x (if x y)) -> (if x y)")
+  (lint-test "(if x (if (not x) z w) y)"        " if: perhaps (if x (if (not x) z w) y) -> (if x w y)")
+  (lint-test "(if x (if (not x) z w))"          " if: perhaps (if x (if (not x) z w)) -> w")
+  (lint-test "(if x (if (not x) z) w)"          " if: perhaps (if x (if (not x) z) w) -> (if (not x) w)")
+
+  (lint-test "(if A (and B C) (and B D))"       " if: perhaps (if A (and B C) (and B D)) -> (and B (if A C D))")
+  (lint-test "(if A (and B C E) (and B D E))"   " if: perhaps (if A (and B C E) (and B D E)) -> (and B (if A C D) E)")
+  (lint-test "(if A (list B C) (list B D))"     " if: perhaps (if A (list B C) (list B D)) -> (list B (if A C D))")
+  (lint-test "(if A (+ B C) (+ B D))"           " if: perhaps (if A (+ B C) (+ B D)) -> (+ B (if A C D))")
+  (lint-test "(if A (< B C) (< B D))"           " if: perhaps (if A (< B C) (< B D)) -> (< B (if A C D))")
+
+  (lint-test "(if A (list B C E) (list B D))"   "") ; used to suggest values here
+  (lint-test "(if A (+ B C E) (+ B D))"         " if: perhaps (if A (+ B C E) (+ B D)) -> (+ B (if A (+ C E) D))")
+  (lint-test "(if A (< B C E) (< B D))"         "")
+  (lint-test "(if A (and B C E) (and B D))"     " if: perhaps (if A (and B C E) (and B D)) -> (and B (if A (and C E) D))")
+  (lint-test "(if A (and B C E) (and B D F))"   " if: perhaps (if A (and B C E) (and B D F)) -> (and B (if A (and C E) (and D F)))")
+  (lint-test "(if A (or B C E) (or B D))"       " if: perhaps (if A (or B C E) (or B D)) -> (or B (if A (or C E) D))")
+  (lint-test "(if A (or B C E) (or B D F))"     " if: perhaps (if A (or B C E) (or B D F)) -> (or B (if A (or C E) (or D F)))")
+  (lint-test "(if A (or B C E) (or B C D F))"   " if: perhaps (if A (or B C E) (or B C D F)) -> (or B C (if A E (or D F)))")
+  (lint-test "(if A (or B C) (or B C D F))"     "")
+  (lint-test  "(if A (+ B E C) (+ D E C))"      " if: perhaps (if A (+ B E C) (+ D E C)) -> (+ (if A B D) E C)")
+  (lint-test  "(if A (+ B B E C) (+ D D E C))"  " if: perhaps (if A (+ B B E C) (+ D D E C)) -> (+ (if A (+ B B) (+ D D)) E C)")
+  (lint-test "(if A (if B C D) (if (not B) C D))" " if: perhaps (if A (if B C D) (if (not B) C D)) -> (if (eq? (not A) (not B)) C D)")
+  (lint-test "(if A (if (not B) C D) (if B C D))" " if: perhaps (if A (if (not B) C D) (if B C D)) -> (if (not (eq? (not A) (not B))) C D)")
+  (lint-test "(if A (if B C D) (if E C D))"      " if: perhaps (if A (if B C D) (if E C D)) -> (if (if A B E) C D)")
+  (lint-test "(+ (if A B C) (if A C D) y)"       " +: perhaps (+ (if A B C) (if A C D) y) -> (+ (if A (values B C) (values C D)) y)")
+  (lint-test "(if A (cond (C D) (else F)) B)"    " if: perhaps (if A (cond (C D) (else F)) B) -> (cond ((not A) B) (C D) (else F))")
+  (lint-test "(if A (cond (C D) (else F)))"      " if: perhaps (if A (cond (C D) (else F))) -> (cond ((not A) #<unspecified>) (C D) (else F))")
+
+  (lint-test "(if (code-constant? setv) (list 'fill! (cadr body) (cadddr body) start end) (list 'copy (cadr setv) (cadr body) start end))" "")
+  (lint-test "(if (code-constant? setv) (list 'fill! (cadr body) (cadddr body) start end start end) (list 'copy (cadr setv) (cadr body) start end start end))"
+	     " if: perhaps (if (code-constant? setv) (list 'fill! (cadr body) (cadddr body) start end... ->
+                 (list (if (code-constant? setv) (values 'fill! (cadr body) (cadddr body)) (values 'copy (cadr setv) (cadr body))) start end start end)")
+  (lint-test "(if (code-constant? setv) (list 'fill! start end (cadr body) (cadddr body) start end) (list 'fill! start end (cadr setv) (cadr body) start end))" "")
+  (lint-test "(if (code-constant? setv) (list 'fill! start end start (cadr body) (cadddr body)) (list 'fill! start end start (cadr setv) (cadr body)))"
+	     " if: perhaps (if (code-constant? setv) (list 'fill! start end start (cadr body) (cadddr... ->
+                 (list 'fill! start end start (if (code-constant? setv) (values (cadr body) (cadddr body)) (values (cadr setv) (cadr body))))")
+
+  (lint-test "(if x (begin (f y)) (begin (g y)))"
+	     " if: perhaps (if x (begin (f y)) (begin (g y))) -> (begin ((if x f g) y))
+               if: begin could be omitted: (begin (f y))
+               if: begin could be omitted: (begin (g y))")
+  (lint-test "(if x (f 2 y) (f 4 y))" " if: perhaps (if x (f 2 y) (f 4 y)) -> (f (if x 2 4) y)")
+  (lint-test "(if x (f 2 y) (f 4 z))" "")
+  (lint-test "(if x (let ((z (log y))) (f 2 y z)) (let ((z (log y))) (f 4 y z)))"
+	     " if: perhaps (if x (let ((z (log y))) (f 2 y z)) (let ((z (log y))) (f 4 y z))) -> (let ((<1> x)) (let ((z (log y))) (f (if <1> 2 4) y z)))
+               if: perhaps (let ((z (log y))) (f 2 y z)) -> (f 2 y (log y))
+               if: perhaps (let ((z (log y))) (f 4 y z)) -> (f 4 y (log y))")
+  (lint-test "(if restarting? (eq? 'ronly opt) (eq? 'sonly opt))"
+	     " if: perhaps (if restarting? (eq? 'ronly opt) (eq? 'sonly opt)) -> (eq? (if restarting? 'ronly 'sonly) opt)")
+
+  (lint-test "(if x (let* ((y (f x)) (z (g x))) (display y) (list y z)) (let* ((y (f x)) (z (g x))) (display z) (list y z)))"
+	     " if: perhaps (if x (let* ((y (f x)) (z (g x))) (display y) (list y z)) (let* ((y (f x))... ->
+                 (let ((<1> x)) (let* ((y (f x)) (z (g x))) (display (if <1> y z)) (list y z)))")
+  (lint-test "(if x (let ((y (f x))) (display y) (list z)) (let ((y (g x))) (display y) (list z)))"
+	     " if: perhaps (if x (let ((y (f x))) (display y) (list z)) (let ((y (g x))) (display y)... -> (let ((y ((if x f g) x))) (display y) (list z))
+               if: perhaps (let ((y (f x))) (display y) (list z)) -> (let () (display (f x)) (list z))
+               if: perhaps (let ((y (g x))) (display y) (list z)) -> (let () (display (g x)) (list z))")
+  (lint-test "(if x (let ((y (f x))) (display y) z) (let ((y (g x))) (f y) z))"
+	     " if: perhaps (let ((y (f x))) (display y) z) -> (let () (display (f x)) z)
+               if: perhaps, assuming f is not a macro, (let ((y (g x))) (f y) z) -> (let () (f (g x)) z)")
+  (lint-test "(if x (let ((y (abs x))) (display z) y) (let ((y (log x))) (display z) y))"
+	     " if: perhaps (if x (let ((y (abs x))) (display z) y) (let ((y (log x))) (display z) y)) ->
+                 (let ((y ((if x abs log) x))) (display z) y)")
+  (lint-test "(if x (let loop1 ((x y)) (if (null? x) 1 (loop1 (cdr x)))) (let loop2 ((x z)) (if (null? x) 1 (loop2 (cdr x)))))"
+	     " loop1: perhaps (let loop1 ((x y)) (if (null? x) 1 (loop1 (cdr x)))) -> (do ((x y (cdr x))) ((null? x) 1))
+               loop2: perhaps (let loop2 ((x z)) (if (null? x) 1 (loop2 (cdr x)))) -> (do ((x z (cdr x))) ((null? x) 1))")
+  (lint-test "(let loop ((x y)) (case x ((1) (display b)) (else (display c) (loop (+ x 1)))))"
+	     " loop: perhaps (let loop ((x y)) (case x ((1) (display b)) (else (display c) (loop (+ x 1))))) ->
+                 (do ((x y (+ x 1))) ((memv x '(1)) (display b)) (display c))")
+  (lint-test "(let loop ((x y)) (when (zero? x) (loop (- x 1))))"
+	     " loop: perhaps (let loop ((x y)) (when (zero? x) (loop (- x 1)))) -> (do ((x y (- x 1))) ((not (zero? x))))")
+  (lint-test "(let loop ((x y)) (unless (zero? x) (loop (- x 1))))"
+	     " loop: perhaps (let loop ((x y)) (unless (zero? x) (loop (- x 1)))) -> (do ((x y (- x 1))) ((zero? x)))")
+  (lint-test "(let loop ((x y)) (when (zero? x) (display b) (loop (- x 1)) x))" "")
+  (lint-test "(let loop ((x y)) (when (zero? x) (display b) (loop (- x 1))))"
+	     " loop: perhaps (let loop ((x y)) (when (zero? x) (display b) (loop (- x 1)))) -> (do ((x y (- x 1))) ((not (zero? x))) (display b))")
+
+  (lint-test "(if polar
+                (let ((vals (parse-polar-coordinates points 3d)))
+                  (set! (bezier-x xpath) (car vals))
+                  (set! (bezier-y xpath) (cadr vals))
+                  (set! (bezier-z xpath) (caddr vals))
+                  (set! (bezier-v xpath) (cadddr vals)))
+                (let ((vals (parse-cartesian-coordinates points 3d)))
+                  (set! (bezier-x xpath) (car vals))
+                  (set! (bezier-y xpath) (cadr vals))
+                  (set! (bezier-z xpath) (caddr vals))
+                  (set! (bezier-v xpath) (cadddr vals))))"
+	     " if: perhaps (if polar (let ((vals (parse-polar-coordinates points 3d))) (set!... ->
+                (let ((vals ((if polar parse-polar-coordinates parse-cartesian-coordinates) points 3d)))
+                  (set! (bezier-x xpath) (car vals))
+                  (set! (bezier-y xpath) (cadr vals))
+                  (set! (bezier-z xpath) (caddr vals))
+                  (set! (bezier-v xpath) (cadddr vals)))")
+  (lint-test "(if (< x 1) (let ((a 32) (b 31)) (f a b)) (let ((a 31) (b 32)) (f a b)))"
+	     " if: perhaps (let ((a 32) (b 31)) (f a b)) -> (f 32 31)
+               if: perhaps (let ((a 31) (b 32)) (f a b)) -> (f 31 32)")
+  (lint-test "(if (< x 1) (let ((a 32) (b 31) (c 12)) (f a b c)) (let ((a 32) (b 31) (c 11)) (f a b c)))"
+	     " if: perhaps (if (< x 1) (let ((a 32) (b 31) (c 12)) (f a b c)) (let ((a 32) (b 31) (c... ->
+                 (let ((a 32) (b 31) (c (if (< x 1) 12 11))) (f a b c))
+               if: perhaps (let ((a 32) (b 31) (c 12)) (f a b c)) -> (f 32 31 12)
+               if: perhaps (let ((a 32) (b 31) (c 11)) (f a b c)) -> (f 32 31 11)")
+  (lint-test "(if x (for-each (lambda (x) (display (+ x a))) (f y)) (for-each (lambda (x) (display (+ x a))) (g y)))"
+	     " if: perhaps (if x (for-each (lambda (x) (display (+ x a))) (f y)) (for-each (lambda... ->
+                 (for-each (lambda (x) (display (+ x a))) ((if x f g) y))")
+  (lint-test "(cond (x (for-each (lambda (x) (display (+ x a))) (f y))) (else (for-each (lambda (x) (display (+ x a))) (g y))))"
+	     " cond: perhaps (cond (x (for-each (lambda (x) (display (+ x a))) (f y))) (else (for-each... ->
+                 (for-each (lambda (x) (display (+ x a))) (if x (f y) (g y)))")
+  (lint-test "(if x (for-each (lambda (x) (display (+ x a))) (f y)) (for-each (lambda (x) (display (+ x b))) (f y)))"
+	     " if: perhaps (if x (for-each (lambda (x) (display (+ x a))) (f y)) (for-each (lambda... ->
+                 (for-each (lambda (x) (display (+ x (if x a b)))) (f y))")
+  (lint-test "(let loop ((lst x) (res ())) (if (null? lst) (reverse res) (loop (cdr lst) (cons (car lst) res))))"
+	     " loop: perhaps (let loop ((lst x) (res ())) (if (null? lst) (reverse res) (loop (cdr lst)... -> (copy x)")
+  (lint-test "(let loop ((lst x) (res ())) (if (not (pair? lst)) (reverse res) (loop (cdr lst) (cons (caar lst) res))))"
+	     " loop: perhaps (let loop ((lst x) (res ())) (if (not (pair? lst)) (reverse res) (loop... -> (map car x)")
+  (lint-test "(let loop ((lst x) (res ())) (if (not (pair? lst)) (reverse res) (loop (cdr lst) (append (z w (car lst) v) res))))"
+	     " loop: perhaps (let loop ((lst x) (res ())) (if (not (pair? lst)) (reverse res) (loop... -> (map (lambda (<1>) (apply values (z w <1> v))) x)")
+  (lint-test "(let loop ((lst x) (res ())) (if (not (pair? lst)) (reverse res) (loop (cons (caar lst) res) (cdr lst))))" "") ; reversed loop args so nothing to rewrite
+  (lint-test "(let loop ((res ()) (lst x)) (if (pair? lst) (loop (let ((a (g (car lst)))) (cons a res)) (cdr lst)) (reverse! res)))"
+	     " loop: perhaps (let loop ((res ()) (lst x)) (if (pair? lst) (loop (let ((a (g (car... -> (map (lambda (<1>) (let ((a (g <1>))) a)) x)
+               let: perhaps (let ((a (g (car lst)))) (cons a res)) -> (cons (g (car lst)) res)")
+  (lint-test "(let loop ((res ()) (lst x)) (if (pair? lst) (loop (let ((a (g (cadar lst)))) (if (g a) (cons a res) res)) (cdr lst)) (reverse! res)))"
+	     " loop: perhaps (let loop ((res ()) (lst x)) (if (pair? lst) (loop (let ((a (g (cadar... ->
+                 (map (lambda (<1>) (let ((a (g (cadr <1>)))) (if (g a) a (values)))) x)")
+  (lint-test "(let loop ((lst x) (res ())) (if (null? lst) (reverse res) (loop (cdr lst) (if (g z) res (cons (car lst) res)))))"
+	     " loop: perhaps (let loop ((lst x) (res ())) (if (null? lst) (reverse res) (loop (cdr lst)... -> (map (lambda (<1>) (if (g z) (values) <1>)) x)")
+  (lint-test "(let loop ((lst x) (res ())) (cond ((null? lst) (reverse res)) (else (loop (cdr lst) (cons (car lst) res)))))"
+	     " loop: perhaps (let loop ((lst x) (res ())) (cond ((null? lst) (reverse res)) (else (loop... -> (copy x)")
+  (lint-test "(let loop ((x y)) (if (null? x) () (let ((p (car x))) (cons p (loop (cdr x))))))"
+	     " loop: perhaps (let loop ((x y)) (if (null? x) () (let ((p (car x))) (cons p (loop (cdr... -> (copy y)")
+  (lint-test "(let name ((name 3)) name)"
+	     " let: perhaps (let name ((name 3)) name) -> (let ((name 3)) name)
+               let: let variable name is declared twice
+               let: name not used, value: (let name ((name 3)) name)
+               let: perhaps (let name ((name 3)) name) -> 3")
+
+  (lint-test "(if (char=? (str i) #\\]) (set! (str i) #\\)) (if (char=? (str i) #\\[) (set! (str i) #\\()))"
+	     " if: perhaps (if (char=? (str i) #\\]) (set! (str i) #\\)) (if (char=? (str i) #\\[) (set!... ->
+                (case (str i) ((#\\]) (set! (str i) #\\))) ((#\\[) (set! (str i) #\\()))")
+  (lint-test "(if (char=? (str i) #\\]) (set! (str i) #\\)) (if (char=? (str i) #\\[) (set! (str i) #\\() (set! x y)))"
+	     " if: perhaps (if (char=? (str i) #\\]) (set! (str i) #\\)) (if (char=? (str i) #\\[) (set!... ->
+                (case (str i) ((#\\]) (set! (str i) #\\))) ((#\\[) (set! (str i) #\\()) (else (set! x y)))")
+  (lint-test "(if (char=? (str i) #\\]) (set! (str i) #\\)) (if (char=? (str i) #\\[) (set! (str i) #\\() (if (char=? (str i) #\\a) (set! x y))))"
+	     " if: perhaps use cond: (if (char=? (str i) #\\]) (set! (str i) #\\)) (if (char=? (str i) #\\[) (set!... ->
+                 (cond ((char=? (str i) #\\]) (set! (str i) #\\))) ((char=? (str i) #\\[) (set! (str i) #\\()) ((char=? (str i) #\\a) (set! x y)))
+               if: perhaps (if (char=? (str i) #\\]) (set! (str i) #\\)) (if (char=? (str i) #\\[) (set!... ->
+                 (case (str i) ((#\\]) (set! (str i) #\\))) ((#\\[) (set! (str i) #\\()) ((#\\a) (set! x y)))")
+  (lint-test "(if (= x 1) 2 (if (= x 3) 3 4))" " if: perhaps (if (= x 1) 2 (if (= x 3) 3 4)) -> (case x ((1) 2) ((3) 3) (else 4))")
+  (lint-test "(if (null? (f x)) 0 (if (eof-object? (f x)) 1 (f x)))"
+	     " if: perhaps (if (null? (f x)) 0 (if (eof-object? (f x)) 1 (f x))) -> (case (f x) ((()) 0) ((#<eof>) 1) (else))
+               if: perhaps use case: (if (eof-object? (f x)) 1 (f x)) -> (case (f x) ((#<eof>) 1) (else))")
+  (lint-test "(if (null? (f x)) 0 (if (eof-object? (f x)) (g (f x)) (f x)))"
+	     " if: perhaps (if (null? (f x)) 0 (if (eof-object? (f x)) (g (f x)) (f x))) -> (case (f x) ((()) 0) ((#<eof>) => g) (else))
+               if: perhaps use case: (if (eof-object? (f x)) (g (f x)) (f x)) -> (case (f x) ((#<eof>) (g (f x))) (else))")
+
+  (lint-test "(if z (f y) (f x))"                 " if: perhaps (if z (f y) (f x)) -> (f (if z y x))")
+  (lint-test "(if z (f y) (g y))"                 " if: perhaps (if z (f y) (g y)) -> ((if z f g) y)")
+  (lint-test "(if z (f (g y)) (f (h y)))"         " if: perhaps (if z (f (g y)) (f (h y))) -> (f ((if z g h) y))")
+  (lint-test "(if z (f (g x)) (f (h x)))"         " if: perhaps (if z (f (g x)) (f (h x))) -> (f ((if z g h) x))")
+  (lint-test "(if z (f (h x)) (g (h x)))"         " if: perhaps (if z (f (h x)) (g (h x))) -> ((if z f g) (h x))")
+  (lint-test "(if z (f (g (h x))) (f (g (h y))))" " if: perhaps (if z (f (g (h x))) (f (g (h y)))) -> (f (g (h (if z x y))))")
+  (lint-test "(if z (f (g (h x))) (f (g (j x))))" " if: perhaps (if z (f (g (h x))) (f (g (j x)))) -> (f (g ((if z h j) x)))")
+  (lint-test "(if z (f (g (h x))) (f (j (h x))))" " if: perhaps (if z (f (g (h x))) (f (j (h x)))) -> (f ((if z g j) (h x)))")
+  (lint-test "(if z (f (g (h x))) (h (g (h x))))" " if: perhaps (if z (f (g (h x))) (h (g (h x)))) -> ((if z f h) (g (h x)))")
+
+  (lint-test "(begin (if A (f B) (g C)) (if (and A D) (g Z)) X)"
+	     " begin: perhaps (... (if A (f B) (g C)) (if (and A D) (g Z)) ...) -> (... (if A (begin (f B) (when D (g Z))) (g C)) ...)")
+  (lint-test "(begin (if A (f B)) (if (and A C) (g D) (h E)) X)" "")
+  (lint-test "(begin (if A (f B)) (if (and A C) (g D) (h E)))" "")
+  (lint-test "(begin (if A (f B) (z G)) (if (and A C) (g D) (h E)))" "")
+  (lint-test "(begin (if A (f B)) (when (and A C) (g D) (h E)) X)"
+	     " begin: perhaps (... (if A (f B)) (when (and A C) (g D) (h E)) ...) -> (... (when A (f B) (when C (g D) (h E))) ...)")
+  (lint-test "(begin (when A (f B)) (when (and A C) (g D) (h E)) X)"
+	     " begin: perhaps (... (when A (f B)) (when (and A C) (g D) (h E)) ...) -> (... (when A (f B) (when C (g D) (h E))) ...)")
+  (lint-test "(begin (when A (f B)) (when (and A C) (g D) (h E)))"
+	     " begin: perhaps (... (when A (f B)) (when (and A C) (g D) (h E)) ...) -> (... (when A (f B) (when C (g D) (h E))))")
+  (lint-test "(begin (if (and A B) (f C)) (if A (g E)))"
+	     " begin: perhaps (... (if (and A B) (f C)) (if A (g E)) ...) -> (... (when A (when B (f C)) (g E)))")
+  (lint-test "(begin (if (and A B) (f C)) (if A (g E) (h F)) X)"
+	     " begin: perhaps (... (if (and A B) (f C)) (if A (g E) (h F)) ...) -> (... (if A (begin (when B (f C)) (g E)) (h F)) ...)")
+
+  (lint-test "(begin (if (and A B) (f C)) (if (and B A) (g E) (h F)) X)"
+	     " begin: perhaps
+                 (... (if (and A B) (f C)) (if (and B A) (g E) (h F)) ...) ->
+                 (... (if (and A B) (begin (f C) (g E)) (begin (h F))) ...)")
+  (lint-test "(begin (if (and A B) (f C)) (if (and C B A) (g E) (h F)) X)" "")
+  (lint-test "(begin (if (and A B C) (f C)) (if (and B A) (g E) (h F)) X)"
+	     " begin: perhaps
+                 (... (if (and A B C) (f C)) (if (and B A) (g E) (h F)) ...) ->
+                 (... (if (and A B) (begin (when C (f C)) (g E)) (h F)) ...)")
+  (lint-test "(begin (if (and A B) (f C)) (if (and B C) (g E) (h F)) X)" "")
+  (lint-test "(begin (if (and A B) (f C)) (when (and B C) (g E)))"
+	     " begin: perhaps
+                 (... (if (and A B) (f C)) (when (and B C) (g E)) ...) ->
+                 (... (when B (when A (f C)) (when C (g E))))")
+  (lint-test "(begin (if (and A B C) (f C)) (when (and B C D) (g E)))"
+	     " begin: perhaps
+                 (... (if (and A B C) (f C)) (when (and B C D) (g E)) ...) ->
+                 (... (when (and B C) (when A (f C)) (when D (g E))))")
+
+  (lint-test "(if x (display y) (begin (set! z y) (display y)))"
+	     " if: perhaps (if x (display y) (begin (set! z y) (display y))) -> (begin (unless x (set! z y)) (display y))")
+  (lint-test "(if x (begin (set! z y) (display y)) (display y))"
+	     " if: perhaps (if x (begin (set! z y) (display y)) (display y)) -> (begin (when x (set! z y)) (display y))")
+  (lint-test "(if x (begin (display y) (set! y z)) (begin (display y) (set! z y)))"
+	     " if: perhaps (if x (begin (display y) (set! y z)) (begin (display y) (set! z y))) ->
+                 (begin (display y) (if x (set! y z) (set! z y)))")
+  (lint-test "(if x (begin (display y) (set! y z) (display x)) (begin (display y) (set! z y) (display x)))"
+	     " if: perhaps (if x (begin (display y) (set! y z) (display x)) (begin (display y) (set!... ->
+                 (begin (display y) (if x (set! y z) (set! z y)) (display x))")
+
+  (lint-test "(if x (begin (display x) y) y)" " if: perhaps (if x (begin (display x) y) y) -> (begin (if x (display x)) y)")
+  (lint-test "(if x (begin (set! x y) (display x) y) y)" " if: perhaps (if x (begin (set! x y) (display x) y) y) -> (begin (when x (set! x y) (display x)) y)")
+  (lint-test "(if (not x) (begin (display x) y) y)" " if: perhaps (if (not x) (begin (display x) y) y) -> (begin (if (not x) (display x)) y)")
+  (lint-test "(if (not x) (begin (set! x y) (display x) y) y)" " if: perhaps (if (not x) (begin (set! x y) (display x) y) y) -> (begin (unless x (set! x y) (display x)) y)")
+  (lint-test "(if x y (begin (display x) y))" " if: perhaps (if x y (begin (display x) y)) -> (begin (if (not x) (display x)) y)")
+  (lint-test "(if x y (begin (set! x y) (display x) y))" " if: perhaps (if x y (begin (set! x y) (display x) y)) -> (begin (unless x (set! x y) (display x)) y)")
+  (lint-test "(if (not x) y (begin (display x) y))" " if: perhaps (if (not x) y (begin (display x) y)) -> (begin (if x (display x)) y)")
+  (lint-test "(if (not x) y (begin (set! x y) (display x) y))" " if: perhaps (if (not x) y (begin (set! x y) (display x) y)) -> (begin (when x (set! x y) (display x)) y)")
+  (lint-test "(if (not x) (begin (display 32) y) (begin (display x) y))"
+	     " if: perhaps (if (not x) (begin (display 32) y) (begin (display x) y)) -> (begin (display (or x 32)) y)")
+  (lint-test "(if x (begin (display 32) y) (begin (display x) y))"
+	     " if: perhaps (if x (begin (display 32) y) (begin (display x) y)) -> (begin (display (if x 32 x)) y)")
+  (lint-test "(if x (begin (set! y x) (set! j x) k) (begin (set! m x) (set! j x) k))"
+             " if: perhaps (if x (begin (set! y x) (set! j x) k) (begin (set! m x) (set! j x) k)) ->
+	         (begin (if x (begin (set! y x) (set! j x)) (begin (set! m x) (set! j x))) k)") ; not ideal, but at least not wrong
+
+  (lint-test "(if A (let () (display x)))"
+	     " if: perhaps (if A (let () (display x))) -> (when A (display x))
+               if: pointless let: (let () (display x))")
+  (lint-test "(if A B (let () (display x)))"
+	     " if: perhaps (if A B (let () (display x))) -> (if A B (begin (display x)))
+               if: pointless let: (let () (display x))")
+  (lint-test "(if A (let () (set! x z) (display x)) (let () (write y)))"
+	     " if: perhaps (if A (let () (set! x z) (display x)) (let () (write y))) -> (if A (begin (set! x z) (display x)) (begin (write y)))
+               if: let could be begin: (let () (set! x z) (display x)) -> (begin (set! x z) (display x))
+               if: pointless let: (let () (write y))")
+  (lint-test "(if A (if B (+ x 1)) (if B (- x 1)))"
+	     " if: perhaps (if A (if B (+ x 1)) (if B (- x 1))) -> (if B (if A (+ x 1) (- x 1)))")
+  (lint-test "(if A (begin (f x) (g y)) (begin (f x) (g z)))"
+	     " if: perhaps (if A (begin (f x) (g y)) (begin (f x) (g z))) -> (begin (f x) (g (if A y z)))")
+  (lint-test "(if A (begin (f x) (g y)) (begin (f y) (g y)))"
+	     " if: perhaps (if A (begin (f x) (g y)) (begin (f y) (g y))) -> (begin (f (if A x y)) (g y))")
+  (lint-test "(if A (begin (f x) (g y) (h z)) (begin (f x) (g x) (h z)))"
+	     " if: perhaps (if A (begin (f x) (g y) (h z)) (begin (f x) (g x) (h z))) -> (begin (f x) (g (if A y x)) (h z))")
+  (lint-test "(if (not x) (display (+ y 1)) (display x))"
+	     " if: perhaps (if (not x) (display (+ y 1)) (display x)) -> (display (or x (+ y 1)))")
+  (lint-test "(if (not x) (set! y z) (set! y x))" " if: perhaps (if (not x) (set! y z) (set! y x)) -> (set! y (or x z))")
+  (lint-test "(if a A (if b A (if c A B)))"
+	     " if: perhaps use cond: (if a A (if b A (if c A B))) -> (cond (a A) (b A) (c A) (else B))
+               if: perhaps (if a A (if b A (if c A B))) -> (if (or a b c) A B)
+               if: perhaps (if b A (if c A B)) -> (if (or b c) A B)")
+  (lint-test "(begin (if x (display x) y) z)" " begin: this branch is pointless: y in (if x (display x) y)")
+  (lint-test "(begin (if x z (display x)) z)" " begin: this branch is pointless: z in (if x z (display x))")
+  (lint-test "(begin (if x (begin (display x) z)) z)"
+	     " begin: this is pointless: z in (begin (display x) z)
+               begin:  perhaps (if x (begin (display x) z)) -> (when x (display x) z)")
+  (lint-test "(begin (if x (begin (display y) (+ x 1)) (begin (display x) z)) z)"
+	     " begin: this is pointless: (+ x 1) in (begin (display y) (+ x 1))
+               begin: this is pointless: z in (begin (display x) z)")
+  (lint-test "(begin (let () (display x)) y)"
+	     " begin: perhaps (begin (let () (display x)) y) -> (let () (display x) y)
+               begin: pointless let: (let () (display x))")
+
+  (lint-test "(let ((list x)) (if (null? list) 3 2))"
+	     " let: perhaps (let ((list x)) (if (null? list) 3 2)) -> (if (null? x) 3 2)")
+  (lint-test "(null? (string->list x))" " null?: perhaps (null? (string->list x)) -> (zero? (length x))")
+  (lint-test "(memq x (if (memq y '(< <=)) '(< <=) '(> >=)))" "") ; this is checking the ->simple-type escape
+  (lint-test "(if q `(not ,op ,x) `(not ,op ,y))" "") ; make sure we don't try to rewrite quasiquote
+
+  (let-temporarily ((*report-one-armed-if* #t))
+    (lint-test "(if a (begin (set! x y) z))"       " if: perhaps (if a (begin (set! x y) z)) -> (when a (set! x y) z)")
+    (lint-test "(if (not a) (begin (set! x y) z))" " if: perhaps (if (not a) (begin (set! x y) z)) -> (unless a (set! x y) z)")
+    (lint-test "(if a (set! x y))"                 " if: perhaps (if a (set! x y)) -> (when a (set! x y))")
+    (lint-test "(if (not a) (set! x y))"           " if: perhaps (if (not a) (set! x y)) -> (unless a (set! x y))"))
+
+  (let-temporarily ((*report-doc-strings* #t))
+    (lint-test "(let () (define (hiho a) \"hiho is a function\" (+ a 1)) (hiho 1))"
+	       " let: perhaps (... (define (hiho a) \"hiho is a function\" (+ a 1)) (hiho 1)) -> (... (let ((a 1)) (+ a 1)))
+                 hiho: old-style doc string: \"hiho is a function\", use '+documentation+:
+     (define hiho
+      (let ((+documentation+ \"hiho is a function\"))
+        (lambda (a)
+          (+ a 1))))"))
+
+  (let-temporarily ((*report-undefined-identifiers* #t))
+    (lint-test "(let ((x 1)) (cdr? x))"
+	       " let: perhaps, assuming cdr? is not a macro, (let ((x 1)) (cdr? x)) -> (cdr? 1)
+                 this identifier was not defined: cdr?")
+    (lint-test "(let ((x 1)) (+ x (aaa)))"       " this identifier was not defined: aaa")
+    (lint-test "(let ((x 1)) (+ x (zzz) (aaa)))" " the following identifiers were not defined: aaa zzz")
+    (lint-test "(let ((example 32)) (+ exampl (* 2 example) (sqrt example)))" " this identifier was not defined: exampl"))
+
+  (let-temporarily ((*report-shadowed-variables* #t))
+    (lint-test "(let ((x 1)) (+ (let ((x 2)) (+ x 1)) x))"
+	       " let: let variable x in (x 2) shadows an earlier declaration  let: perhaps (let ((x 2)) (+ x 1)) -> (+ 2 1)"))
+
+  (lint-test "(when (not a) (set! x y))"   " when: perhaps (when (not a) (set! x y)) -> (unless a (set! x y))")
+  (lint-test "(unless (not a) (set! x y))" " unless: perhaps (unless (not a) (set! x y)) -> (when a (set! x y))")
+
+  (lint-test "(begin (if x (y)) (if x (z)) 32)" " begin: perhaps (... (if x (y)) (if x (z)) ...) -> (... (when x (y) (z)) ...)")
+  (lint-test "(begin (if x (y)) (if x (z)))"    " begin: perhaps (... (if x (y)) (if x (z)) ...) -> (... (when x (y) (z)) ...)")
+  (lint-test "(begin (if x (y)) (if x (z)) (v) (if x (w)))" " begin: perhaps (... (if x (y)) (if x (z)) ...) -> (... (when x (y) (z)) ...)")
+  (lint-test "(begin (if x (y)) (if x (z)) (v) (if x (w)) 12)" " begin: perhaps (... (if x (y)) (if x (z)) ...) -> (... (when x (y) (z)) ...)")
+
+  (lint-test "(begin (if (< x 0) (display y)) (if (< x 0) z))"
+	     " begin: perhaps (... (if (< x 0) (display y)) (if (< x 0) z) ...) ->
+               (... (when (< x 0) (display y) z) ...)")
+  (lint-test "(begin (if (< x 0) (display y) (display (- y 1))) (if (< x 0) z))"
+	     " begin: perhaps (if (< x 0) (display y) (display (- y 1))) -> (display (if (< x 0) y (- y 1)))
+              begin: perhaps  (... (if (< x 0) (display y) (display (- y 1))) (if (< x 0) z) ...) ->
+                (... (if (< x 0) (begin (display y) z) (begin (display (- y 1)))) ...)")
+  (lint-test "(begin (if (< x 0) (begin (display y) (set! y 3)) (display (- y 1))) (if (< x 0) z (begin (display (+ z 1)) (- z 1))))"
+	     " begin: perhaps (... (if (< x 0) (begin (display y) (set! y 3)) (display (- y 1))) (if (<... ->
+               (... (if (< x 0) (begin (display y) (set! y 3) z) (begin (display (- y 1)) (display (+ z 1)) (- z 1))) ...)")
+
+  (lint-test "(cond . 1)"		" cond: cond is messed up: (cond . 1)")
+  (lint-test "(cond 1)"			" cond: cond is messed up: (cond 1)")
+  (lint-test "(cond ((< 3 1) 2))"
+	     " cond: cond test (< 3 1) is never true: (cond ((< 3 1) 2))
+               cond: cond test is always false: ((< 3 1) 2)
+               cond: perhaps (cond ((< 3 1) 2)) -> (cond)")
+  (lint-test "(cond (else 2) (x 3))"	" cond: cond else clause is not the last:  (cond (else 2) (x 3))")
+  (lint-test "(cond (x => abs))"	"")
+  (lint-test "(cond (x))"               " cond: perhaps (cond (x)) -> x")
+  (lint-test "(cond (x =>))"		" cond: cond => target is messed up:  (x =>)")
+  (lint-test "(cond (x #f) (#t #t))"	" cond: perhaps (cond (x #f) (#t #t)) -> (not x)")
+  (lint-test "(cond (x #t) (else #f))"	" cond: perhaps (cond (x #t) (else #f)) -> x")
+  (lint-test "(cond (x #t) (else y))"   "")
+  (lint-test "(cond (x #f) (else y))"   " cond: perhaps (cond (x #f) (else y)) -> (and (not x) y)")
+  (lint-test "(cond (x #f) (else (f y) g))" " cond: perhaps (cond (x #f) (else (f y) g)) -> (and (not x) (begin (f y) g))")
+  (lint-test "(cond (x #t) (else #t))"  " cond: perhaps (cond (x #t) (else #t)) -> #t")
+  (lint-test "(cond ((not x) #f) (else y))" " cond: perhaps (cond ((not x) #f) (else y)) -> (and x y)")
+  (lint-test "(cond ((null? x) #t) (else y))"
+	     " cond: this #t could be omitted: ((null? x) #t) cond: perhaps (cond ((null? x) #t) (else y)) -> (or (null? x) y)")
+  (lint-test "(cond ((= x 1) 2) (else 2))" " cond: perhaps (cond ((= x 1) 2) (else 2)) -> 2")
+  (lint-test "(cond ((and (display x) x) 32) (#t 32))"
+	     " cond: perhaps (cond ((and (display x) x) 32) (#t 32)) -> (begin (and (display x) x) 32)")
+  (lint-test "(cond (x y) (z 32) (else 32))" " cond: this clause could be omitted: (z 32)")
+  (lint-test "(cond ((= x 1) (display \"a\") 32) (#t (display \"a\") 32))"
+	     " cond: perhaps (cond ((= x 1) (display \"a\") 32) (#t (display \"a\") 32)) ->  (begin (display \"a\") 32)")
+  (lint-test "(cond ((= x 1) 32))"      " cond: perhaps (cond ((= x 1) 32)) -> (if (= x 1) 32)")
+  (lint-test "(cond ((and (display 32) (= x 1)) 1) (#t 1))"
+	     " cond: perhaps (cond ((and (display 32) (= x 1)) 1) (#t 1)) -> (begin (and (display 32) (= x 1)) 1)")
+  (lint-test "(cond ((< x 1) 2) (else (cond ((< y 3) 2) (#t 4))))"
+	     " cond: else clause could be folded into the outer cond:
+                (cond ((< x 1) 2) (else (cond ((< y 3) 2) (#t 4)))) -> (cond ((< x 1) 2) ((< y 3) 2) (#t 4))")
+  (lint-test "(cond ((< x 2) 3) ((> x 0) 4) ((< x 2) 5))"
+	     " cond: cond test (< x 2) is never true: (cond ((< x 2) 3) ((> x 0) 4) ((< x 2) 5))
+               cond: cond test repeated: ((< x 2) 5)
+               cond: cond test is always false: ((< x 2) 5)
+               cond: perhaps (cond ((< x 2) 3) ((> x 0) 4) ((< x 2) 5)) -> (cond ((< x 2) 3) ((> x 0) 4))")
+  (lint-test "(cond ((< x 1) (+ x 1)) ((> x 1) (+ x 1)) (#t 2))"
+	     " cond: perhaps (cond ((< x 1) (+ x 1)) ((> x 1) (+ x 1)) (#t 2)) -> (cond ((not (= x 1)) (+ x 1)) (#t 2))")
+  (lint-test "(cond ((= x 3) 4) ((= x 2) 4) ((= x 1) 4) (else 5))"
+	     " cond: perhaps (cond ((= x 3) 4) ((= x 2) 4) ((= x 1) 4) (else 5)) -> (case x ((3 2 1) 4) (else 5))")
+  (lint-test "(cond ((= x 3) 3) ((= x 2) 4) ((= x 1) 4) (else 5))"
+	     " cond: perhaps (cond ((= x 3) 3) ((= x 2) 4) ((= x 1) 4) (else 5)) -> (case x ((3) 3) ((2 1) 4) (else 5))")
+  (lint-test "(cond ((= x 3) 3) ((= x 2) 4) ((= x 1) 4))"
+	     " cond: perhaps (cond ((= x 3) 3) ((= x 2) 4) ((= x 1) 4)) -> (case x ((3) 3) ((2 1) 4))")
+  (lint-test "(cond (a) (b) (c))"	" cond: perhaps (cond (a) (b) (c)) -> (cond ((or a b c)))")
+  (lint-test "(cond ((= x 0) x) ((= x 1) (= x 1)))"
+	     " cond: no need to repeat the test:  ((= x 1) (= x 1)) -> ((= x 1))
+               cond: perhaps use case instead of cond: (cond ((= x 0) x) ((= x 1) (= x 1))) -> (case x ((0)) ((1) (= x 1)))")
+  (lint-test "(cond (x => expt))"	" cond: => target (expt) may be unhappy: (x => expt)")
+  (lint-test "(cond (x (abs x)))"
+	     " in (cond (x (abs x))), perhaps change x to (real? x)
+               cond: perhaps use => here: (x (abs x)) -> (x => abs)")
+  (lint-test "(cond ((> x 2) (not (> x 2))))" " cond: perhaps replace (not (> x 2)) with #f")
+  (lint-test "(cond (x #t) (y #t) (else #f))"
+	     " cond: perhaps (cond (x #t) (y #t) (else #f)) -> (or x y)
+               cond: perhaps (cond (x #t) (y #t) (else #f)) -> (or x (and y #t))")
+  (lint-test "(cond (x #f) (y #f) (else #t))" " cond: perhaps (cond (x #f) (y #f) (else #t)) -> (not (or x y))")
+  (lint-test "(cond (x y) ('else z))" " cond: odd cond clause test: is 'else supposed to be else? ('else z)")
+  (lint-test "(cond ((x) y) ((not (x)) z))"   " cond: perhaps (cond ((x) y) ((not (x)) z)) -> (cond ((x) y) (else z))")
+
+  (lint-test "(cond (x (let ((z w)) (+ x z)) y) (else 2))"
+	     " in (cond (x (let ((z w)) (+ x z)) y) (else 2)), perhaps change x to (number? x)
+               cond: this could be omitted: (let ((z w)) (+ x z))
+               cond: perhaps (let ((z w)) (+ x z)) -> (+ x w)")
+  (lint-test "(cond (x (if x y z) (+ x 1)) (z 2))"             " cond: this could be omitted: (if x y z)")
+  (lint-test "(cond ((g x) `(c ,x) `(c ,y)))"
+	     " cond: perhaps (list-values 'c x) -> (list 'c x)
+               cond: perhaps (list-values 'c y) -> (list 'c y)
+               cond: perhaps (cond ((g x) (list-values 'c x) (list-values 'c y))) -> (when (g x) (list-values 'c x) (list-values 'c y))")
+  (lint-test "(cond ((= x 1) 2) ((= x 2) 3))" " cond: perhaps use case instead of cond: (cond ((= x 1) 2) ((= x 2) 3)) -> (case x ((1) 2) ((2) 3))")
+  (lint-test "(cond ((= x y) (begin (display x) y)) (else x))" " cond: redundant begin: (begin (display x) y)")
+  (lint-test "(cond ((= x y) y) (else (begin (display x) x)))"
+	     " cond: redundant begin: (begin (display x) x) cond: display returns its first argument, so this could be omitted: x")
+  (lint-test "(cond ((= x y) z) (else #<unspecified>))"        " cond: this #<unspecified> is redundant: (else #<unspecified>)")
+  (lint-test "(cond (x y) (y z (else 3)))" " cond: this could be omitted: z cond: perhaps cond else clause is misplaced: (else 3) in (y z (else 3))")
+  (lint-test "(cond (x y) (y z (#t 3)))" " cond: this could be omitted: z cond: perhaps cond else clause is misplaced: (#t 3) in (y z (#t 3))")
+  (lint-test "(cond (< x 1) (else 1))"   " cond: strange cond test: < in (< x 1) is a procedure  cond: this could be omitted: x")
+  (lint-test "(cond ((memq x '(a b)) 3) ((eq? x 'c) 4) ((or (eq? x 'd) (eq? 'e x)) 5) (else 6))"
+	     " cond: perhaps use case instead of cond:
+                (cond ((memq x '(a b)) 3) ((eq? x 'c) 4) ((or (eq? x 'd) (eq? 'e x)) 5)... -> (case x ((a b) 3) ((c) 4) ((d e) 5) (else 6))")
+  (lint-test "(cond ((eq? x 'a) 1) ((not x) 2) (else 3))"
+	     " cond: perhaps use case instead of cond: (cond ((eq? x 'a) 1) ((not x) 2) (else 3)) -> (case x ((a) 1) ((#f) 2) (else 3))")
+  (lint-test "(cond ((eof-object? x) 1) ((null? x) 2) ((not x) 3) (else 4))"
+	     " cond: perhaps use case instead of cond:
+               (cond ((eof-object? x) 1) ((null? x) 2) ((not x) 3) (else 4)) -> (case x ((#<eof>) 1) ((()) 2) ((#f) 3) (else 4))")
+  (lint-test "(cond ((or (null? x) (not x)) 1) ((eq? x 'a) 3) (else 2))"
+	     " cond: perhaps use case instead of cond:
+               (cond ((or (null? x) (not x)) 1) ((eq? x 'a) 3) (else 2)) -> (case x ((() #f) 1) ((a) 3) (else 2))")
+  (lint-test "(cond ((= x 0) 1) ((= x 2) 2) ((= x 3) (cond ((not y) 1) ((null? y) 2) ((eq? y 'a) 3) (else 4))) (else 5))"
+	     " cond: perhaps use case instead of cond:
+               (cond ((not y) 1) ((null? y) 2) ((eq? y 'a) 3) (else 4)) -> (case y ((#f) 1) ((()) 2) ((a) 3) (else 4))
+               cond: perhaps use case instead of cond: (cond ((= x 0) 1) ((= x 2) 2) ((= x 3) (cond ((not y) 1) ((null? y) 2)... ->
+               (case x ((0) 1) ((2) 2) ((3) (cond ((not y) 1) ((null? y) 2) ((eq? y 'a) 3) (else 4))) (else 5))
+               cond: perhaps (cond ((= x 0) 1) ((= x 2) 2) ((= x 3) (cond ((not y) 1) ((null? y) 2)... ->
+               (cond ((= x 0) 1) ((= x 2) 2) ((not (= x 3)) 5) ((not y) 1) ((null? y) 2) ((eq? y 'a) 3) (else 4))")
+  (lint-test "(cond ((equal? x 'a) 1) ((equal? x 1) 2) (else 3))"
+	     " cond: equal? could be eq? in (equal? x 'a)
+               cond: equal? could be eqv? in (equal? x 1)
+               cond: perhaps use case instead of cond: (cond ((equal? x 'a) 1) ((equal? x 1) 2) (else 3)) -> (case x ((a) 1) ((1) 2) (else 3))")
+  (lint-test "(cond ((= x 1) 1) (t 2))" " cond: odd cond clause test: is t supposed to be #t? (t 2)")
+  (lint-test "(cond (t 2))"             " cond: odd cond clause test: is t supposed to be #t? (t 2)")
+  (lint-test "(cond ((memq x '(a b)) => car) ((eq? x 'c) 2))" "") ; this should not got to case because the => operator won't work the same
+  (lint-test "(cond ((char=? c #\\a) (set! x y)) ((char=? c #\\b) (set! y x)) (else (set! x z)))"
+	     " cond: perhaps use case instead of cond: (cond ((char=? c #\\a) (set! x y)) ((char=? c #\\b) (set! y x)) (else (set!... ->
+                 (case c ((#\\a) (set! x y)) ((#\\b) (set! y x)) (else (set! x z)))")
+  (lint-test "(cond ((char-ci=? c #\\a) (set! x y)) ((char=? c #\\b) (set! y x)) (else (set! x z)))"
+	     " cond: perhaps use case instead of cond: (cond ((char-ci=? c #\\a) (set! x y)) ((char=? c #\\b) (set! y x)) (else... ->
+                 (case c ((#\\a #\\A) (set! x y)) ((#\\b) (set! y x)) (else (set! x z)))")
+  (lint-test "(cond ((null? x) 1) ((= x 1) 2) ((boolean? x) 3) (else 4))"
+	     " cond: perhaps use case instead of cond: (cond ((null? x) 1) ((= x 1) 2) ((boolean? x) 3) (else 4)) ->
+                 (case x ((()) 1) ((1) 2) ((#t #f) 3) (else 4))")
+  (lint-test "(cond ((< x 1) 1) ((string? y) 2))" "") ; check a simplification bug
+  (lint-test "(cond ((eof-object? x)) ((zero? x)))"
+	     " cond: perhaps use case instead of cond: (cond ((eof-object? x)) ((zero? x))) -> (case x ((#<eof>) #t) ((0 0.0) #t))")
+
+  (lint-test "(cond ((= x 0) 0) ((not (= x 1)) 1))"
+	     " cond: perhaps use case instead of cond: (cond ((= x 0) 0) ((not (= x 1)) 1)) -> (case x ((0) 0) ((1) #<unspecified>) (else 1))")
+  (lint-test "(cond ((= x 0) 0) ((not (= x 1)) 1) (else 2))"
+	     " cond: perhaps use case instead of cond: (cond ((= x 0) 0) ((not (= x 1)) 1) (else 2)) -> (case x ((0) 0) ((1) 2) (else 1))")
+  (lint-test "(cond ((= x 0) 0) ((not (= x 1)) 1) ((= x 1) 2))"
+	     " cond: perhaps use case instead of cond: (cond ((= x 0) 0) ((not (= x 1)) 1) ((= x 1) 2)) -> (case x ((0) 0) ((1) 2) (else 1))
+             cond: perhaps (cond ((= x 0) 0) ((not (= x 1)) 1) ((= x 1) 2)) -> (cond ((= x 0) 0) ((not (= x 1)) 1) (#t 2))")
+  (lint-test "(cond ((= x 0) 0) ((not (= x 1)) 1) ((= x 2) 2))"
+	     " cond: perhaps use case instead of cond: (cond ((= x 0) 0) ((not (= x 1)) 1) ((= x 2) 2)) -> (case x ((0) 0) ((1) #<unspecified>) (else 1))")
+  (lint-test "(cond ((= x 1) 1) ((not (= x 1)) 2))"
+	     " cond: perhaps (cond ((= x 1) 1) ((not (= x 1)) 2)) -> (cond ((= x 1) 1) (else 2))
+              cond: perhaps (cond ((= x 1) 1) ((not (= x 1)) 2)) -> (cond ((= x 1) 1) (#t 2))")
+  (lint-test "(cond ((eq? x 'a) 1) ((not (eq? x 'b)) 2) (else 3))"
+	     " cond: perhaps use case instead of cond: (cond ((eq? x 'a) 1) ((not (eq? x 'b)) 2) (else 3)) -> (case x ((a) 1) ((b) 3) (else 2))")
+  (lint-test "(cond ((= (f1 32) 0) 1) ((zero? (f1 32)) 2) ((not (memv (f1 32) '(2 3 4))) 5) (else 6))"
+	     " cond: perhaps use case instead of cond: (cond ((= (f1 32) 0) 1) ((zero? (f1 32)) 2) ((not (memv (f1 32) '(2 3 4)))... ->
+               (case (f1 32) ((0) 1) ((0 0.0) 2) ((2 3 4) 6) (else 5))")
+  (lint-test "(cond ((= x 1) 1) ((not (= x 2)) 2) ((not (= x 3)) 3))"
+	     " cond: perhaps use case instead of cond: (cond ((= x 1) 1) ((not (= x 2)) 2) ((not (= x 3)) 3)) -> (case x ((1) 1) ((2) 3) (else 2))")
+
+  (lint-test "(cond ((= 3 (length eq)) (caddr eq)) (else #f))"
+	     " cond: perhaps (cond ((= 3 (length eq)) (caddr eq)) (else #f)) -> (and (= 3 (length eq)) (caddr eq))")
+  (lint-test "(cond ((= 3 (length eq)) (caddr eq)) (else #t))"
+	     " cond: perhaps (cond ((= 3 (length eq)) (caddr eq)) (else #t)) -> (or (not (= 3 (length eq))) (caddr eq))")
+  (lint-test "(cond ((= x y) #f) (else (abs x)))" " cond: perhaps (cond ((= x y) #f) (else (abs x))) -> (and (not (= x y)) (abs x))")
+  (lint-test "(cond ((and (= x y) z) (+ x 1)) (else #f))"
+	     " cond: perhaps (cond ((and (= x y) z) (+ x 1)) (else #f)) -> (and (= x y) z (+ x 1))")
+  (lint-test "(cond (a A) (else A))"    " cond: perhaps (cond (a A) (else A)) -> A")
+  (lint-test "(cond ((a)) (else A))"    " cond: perhaps (cond ((a)) (else A)) -> (or (a) A)")
+  (lint-test "(cond (a A) (else (if b B)))"
+	     " cond: else clause could be folded into the outer cond: (cond (a A) (else (if b B))) -> (cond (a A) (b B))")
+  (lint-test "(cond (a A) (else (if b B C)))"
+	     " cond: else clause could be folded into the outer cond: (cond (a A) (else (if b B C))) -> (cond (a A) (b B) (else C))")
+  (lint-test "(cond (a A) (else (if b (begin (B) D) (begin (C) E))))"
+	     " cond: else clause could be folded into the outer cond:
+                (cond (a A) (else (if b (begin (B) D) (begin (C) E)))) -> (cond (a A) (b (B) D) (else (C) E))")
+  (lint-test "(cond (a A) (else (when b B)))"
+	     " cond: else clause could be folded into the outer cond: (cond (a A) (else (when b B))) -> (cond (a A) (b B))")
+  (lint-test "(cond (a A) (else (unless b B)))"
+	     " cond: else clause could be folded into the outer cond: (cond (a A) (else (unless b B))) -> (cond (a A) ((not b) B))")
+  (lint-test "(cond (A) (B) (else C))"  " cond: perhaps (cond (A) (B) (else C)) -> (or A B C)")
+  (lint-test "(cond (A) (B) (else (C) D))"  " cond: perhaps (cond (A) (B) (else (C) D)) -> (or A B (begin (C) D))")
+  (lint-test "(cond (A) (B) (C))"       " cond: perhaps (cond (A) (B) (C)) -> (cond ((or A B C)))") ; (or A B C #<unspecified>) ??
+  (lint-test "(cond ((A) B) ((or C D)) (else E))"
+	     " cond: perhaps (cond ((A) B) ((or C D)) (else E)) -> (cond ((A) B) (else (or C D E)))")
+
+  (lint-test "(cond (A (cond (B c) (else D))) (else E))"
+	     " cond: perhaps (cond (A (cond (B c) (else D))) (else E)) -> (cond ((not A) E) (B c) (else D))")
+  (lint-test "(cond (A (cond (B c) (else D))))"
+	     " cond: perhaps (cond (A (cond (B c) (else D)))) -> (if A (cond (B c) (else D)))
+               cond: perhaps (cond (A (cond (B c) (else D)))) -> (cond ((not A) #<unspecified>) (B c) (else D))")
+  (lint-test "(cond (A B) (C (cond (D d) (else E))) (else F))"
+	     " cond: perhaps (cond (A B) (C (cond (D d) (else E))) (else F)) -> (cond (A B) ((not C) F) (D d) (else E))")
+  (lint-test "(cond (A B) (C (if D d E)) (else F))"
+	     " cond: perhaps (cond (A B) (C (if D d E)) (else F)) -> (cond (A B) ((not C) F) (D d) (else E))")
+  (lint-test "(cond (A B) ((not C) (cond (D d) (else E))) (else F))"
+	     " cond: perhaps (cond (A B) ((not C) (cond (D d) (else E))) (else F)) -> (cond (A B) (C F) (D d) (else E))")
+  (lint-test "(cond (A B) ((< C 1) (cond (D d) (else E))) (else F))"
+	     " cond: perhaps (cond (A B) ((< C 1) (cond (D d) (else E))) (else F)) -> (cond (A B) ((>= C 1) F) (D d) (else E))")
+
+  (lint-test "(cond (W X) (A B) (C D) (else B))"
+	     " cond: perhaps (cond (W X) (A B) (C D) (else B)) -> (cond (W X) ((or A (not C)) B) (else D))")
+  (lint-test "(cond (W X) (A #f) (C D) (else #f))"
+	     " cond: perhaps (cond (W X) (A #f) (C D) (else #f)) -> (cond (W X) ((or A (not C)) #f) (else D))")
+  (lint-test "(cond (Y #t) (W X) (A #f) (C #t) (else #f))"
+	     " cond: perhaps (cond (Y #t) (W X) (A #f) (C #t) (else #f)) -> (cond ... ((or A (not C)) #f) (else #t))")
+  (lint-test "(cond (W #t) (A B) (C #t) (else B))"
+	     " cond: perhaps (cond (W #t) (A B) (C #t) (else B)) -> (cond (W #t) ((or A (not C)) B) (else #t))")
+  (lint-test "(cond (W B) (A B) (C #t) (else B))"
+	     " cond: perhaps (cond (W B) (A B) (C #t) (else B)) -> (cond ((or W A) B) (C #t) (else B))
+               cond: perhaps (cond (W B) (A B) (C #t) (else B)) -> (cond (W B) ((or A (not C)) B) (else #t))")
+
+  (lint-test "(cond ((string=? x \"a\") 1) ((string=? x \"b\") 2) ((string=? x \"c\") 3) (else 4))"
+	     " cond: perhaps (cond ((string=? x \"a\") 1) ((string=? x \"b\") 2) ((string=? x \"c\") 3) (else 4)) ->
+                 (cond ((assq (string->symbol x) '((a . 1) (b . 2) (c . 3))) => cdr) (else 4))")
+  (lint-test "(cond ((any-op x) 1) ((eq? x 'b) 2) ((eq? x 'c) 3) (else 4))"
+	     " cond: perhaps (cond ((any-op x) 1) ((eq? x 'b) 2) ((eq? x 'c) 3) (else 4)) ->
+                 (cond ((any-op x) 1) ((assq x '((b . 2) (c . 3))) => cdr) (else 4))")
+  (lint-test "(cond ((= order 1) 1.0) ((= order 2) 1.3) ((< order 9) 1.5) (else 1.8))"
+	     " cond: perhaps (cond ((= order 1) 1.0) ((= order 2) 1.3) ((< order 9) 1.5) (else 1.8)) ->
+                 (cond ((assoc order '((1 . 1.0) (2 . 1.3)) =) => cdr) ((< order 9) 1.5) (else 1.8))")
+  (lint-test "(cond ((= order 1) 1.0) ((= order 2) 1.3) ((< order 9) 1.5))"
+	     " cond: perhaps (cond ((= order 1) 1.0) ((= order 2) 1.3) ((< order 9) 1.5)) ->
+                 (cond ((assoc order '((1 . 1.0) (2 . 1.3)) =) => cdr) ((< order 9) 1.5))")
+  (lint-test "(cond ((< order 8) 1.6) ((= order 1) 1.0) ((= order 2) 1.3) ((< order 9) 1.5))"
+	     " cond: perhaps (cond ((< order 8) 1.6) ((= order 1) 1.0) ((= order 2) 1.3) ((< order 9) 1.5)) ->
+                 (cond ((< order 8) 1.6) ((assoc order '((1 . 1.0) (2 . 1.3)) =) => cdr) ((< order 9) 1.5))")
+  (lint-test "(cond ((and (integer? x) (exact? x) (integer? y) (exact? y)) 2) (else 3))"
+	     " cond: perhaps (cond ((and (integer? x) (exact? x) (integer? y) (exact? y)) 2) (else 3)) ->
+                (cond ((and (integer? x) (integer? y)) 2) (else 3))")
+  (lint-test "(cond ((and (integer? x) (exact? y) (integer? y) (exact? x)) 2) (else 3))"
+	     " cond: perhaps (cond ((and (integer? x) (exact? y) (integer? y) (exact? x)) 2) (else 3)) ->
+                (cond ((and (integer? x) (integer? y)) 2) (else 3))")
+  (lint-test "(cond ((integer? x) (+ x 1)) ((real? x) (- x 1.0)) (else (+ x 1)))"
+	     " cond: perhaps (cond ((integer? x) (+ x 1)) ((real? x) (- x 1.0)) (else (+ x 1))) ->
+                (if (or (integer? x) (not (real? x))) (+ x 1) (- x 1.0))")
+  (lint-test "(cond ((complex? x) (+ x 1)) ((not (integer? x)) 0) (else (+ x 1)))"
+	     " cond: perhaps (cond ((complex? x) (+ x 1)) ((not (integer? x)) 0) (else (+ x 1))) ->
+                (if (complex? x) (+ x 1) 0)")
+  (lint-test "(cond (A a) (B b) (else a))"    " cond: perhaps (cond (A a) (B b) (else a)) -> (if (or A (not B)) a b)")
+  (lint-test "(cond (A #f) (B b) (else #f))"  " cond: perhaps (cond (A #f) (B b) (else #f)) -> (and (not A) B b)")
+  (lint-test "(cond (A #f) (B #t) (else #f))"
+	     " cond: perhaps (cond (A #f) (B #t) (else #f)) -> (and (not A) B)
+               cond: perhaps (cond (A #f) (B #t) (else #f)) -> (and (not A) B)")
+  (lint-test "(cond (A #t) (B b) (else #t))"  " cond: perhaps (cond (A #t) (B b) (else #t)) -> (or A (not B) b)")
+  (lint-test "(cond (A #t) (B #f) (else #t))" " cond: perhaps (cond (A #t) (B #f) (else #t)) -> (or A (not B))")
+  (lint-test "(cond (A a) (B a) (else b))"    " cond: perhaps (cond (A a) (B a) (else b)) -> (cond ((or A B) a) (else b))")
+  (lint-test "(cond ((and A B) c) (B d) (else e))" " cond: perhaps (cond ((and A B) c) (B d) (else e)) -> (cond (B (if A c d)) (else e))")
+  (lint-test "(cond ((and A B) c) (A d) (else e))" " cond: perhaps (cond ((and A B) c) (A d) (else e)) -> (cond (A (if B c d)) (else e))")
+  (lint-test "(cond (A B) ((or A C) D))" " cond: perhaps (cond (A B) ((or A C) D)) -> (cond (A B) (C D))")
+  (lint-test "(cond (A B) ((or A C) D) (C E))"
+	     " cond: cond test C is never true: (cond (A B) ((or A C) D) (C E))
+               cond: cond test is always false: (C E)
+               cond: perhaps (cond (A B) ((or A C) D) (C E)) -> (cond (A B) (C D))")
+  (lint-test "(cond ((< x 1) 21) ((< x 2) 32) ((or (< x 1) (> x 3)) 33))"
+	     " cond: perhaps (cond ((< x 1) 21) ((< x 2) 32) ((or (< x 1) (> x 3)) 33)) -> (cond ((assoc x '((1 . 21) (2 . 32)) <) => cdr) ((> x 3) 33))")
+  (lint-test "(cond ((not x) (display (+ y 1))) (else (display x)))"
+	     " cond: perhaps (cond ((not x) (display (+ y 1))) (else (display x))) -> (display (if (not x) (+ y 1) x))
+               cond: perhaps (cond ((not x) (display (+ y 1))) (else (display x))) -> (if x (display x) (display (+ y 1)))")
+  (lint-test "(cond ((not x) (display (+ y 1)) z) (else (display x) a))"
+	     " cond: perhaps (cond ((not x) (display (+ y 1)) z) (else (display x) a)) -> (cond (x (display x) a) (else (display (+ y 1)) z))")
+  (lint-test "(begin (cond (x y) (z (display a) (+ a 1))) z)"
+	     " begin: this is pointless: y in (x y)
+               begin: this is pointless: (+ a 1) in (z (display a) (+ a 1))")
+  (lint-test "(begin (cond ((A) (f B)) ((< C 1) (cond ((D) (f d)) (else (f E))))) x)"
+	     " begin: perhaps (cond ((D) (f d)) (else (f E))) -> (f (if (D) d E))
+               begin: perhaps (cond ((A) (f B)) ((< C 1) (cond ((D) (f d)) (else (f E))))) -> (cond ((A) (f B)) ((>= C 1)) ((D) (f d)) (else (f E)))")
+  (lint-test "(cond ((A) (f B)) ((< C 1) (cond ((D) (f d)) (else (f E)))))"
+	     " cond: perhaps (cond ((D) (f d)) (else (f E))) -> (f (if (D) d E))
+               cond: perhaps (cond ((A) (f B)) ((< C 1) (cond ((D) (f d)) (else (f E))))) -> (cond ((A) (f B)) ((>= C 1) #<unspecified>) ((D) (f d)) (else (f E)))")
+  (lint-test "(cond ((= x 0) 1) ((= x 3) (cond ((not y) 1) ((pair? y) 2) ((eq? y 'a) 3) (else 4))) ((< x 200) 2) (else 5))"
+	     " cond: perhaps (cond ((= x 0) 1) ((= x 3) (cond ((not y) 1) ((pair? y) 2) ((eq? y 'a) 3)... ->
+                (cond ((= x 0) 1) ((not (= x 3)) (if (< x 200) 2 5)) ((not y) 1) ((pair? y) 2) ((eq? y 'a) 3) (else 4))")
+  (lint-test "(cond ((pair? x) 3) ((eq? x 'a) z) ((eq? x 'b) (* 2 z)) ((eq? x 'c) (display z)))"
+	     " cond: possibly use case at the end:
+                (cond ((pair? x) 3) ((eq? x 'a) z) ((eq? x 'b) (* 2 z)) ((eq? x 'c)... ->
+                (if (pair? x) 3 (case x ((a) z) ((b) (* 2 z)) ((c) (display z))))")
+  (lint-test "(cond ((pair? x) 3) ((eq? x 'a) z) ((eq? x 'b) (* 2 z)) ((eq? x 'c) (display z)) (else (display y)))"
+	     " cond: possibly use case at the end:
+                (cond ((pair? x) 3) ((eq? x 'a) z) ((eq? x 'b) (* 2 z)) ((eq? x 'c)... ->
+                (if (pair? x) 3 (case x ((a) z) ((b) (* 2 z)) ((c) (display z)) (else (display y))))")
+  (lint-test "(cond ((pair? x) #f) ((eq? x 'a) z) ((eq? x 'b) (* 2 z)) ((eq? x 'c) (display z)))"
+	     " cond: possibly use case at the end:
+                (cond ((pair? x) #f) ((eq? x 'a) z) ((eq? x 'b) (* 2 z)) ((eq? x 'c)... ->
+                (and (not (pair? x)) (case x ((a) z) ((b) (* 2 z)) ((c) (display z))))")
+  (lint-test "(cond ((pair? x) 3) ((integer? x) 4) ((eq? x 'a) z) ((eq? x 'b) (* 2 z)) ((eq? x 'c) (display z)))"
+	     " cond: possibly use case at the end:
+                (cond ((pair? x) 3) ((integer? x) 4) ((eq? x 'a) z) ((eq? x 'b) (* 2 z))... ->
+                (cond ((pair? x) 3) ((integer? x) 4) (else (case x ((a) z) ((b) (* 2 z)) ((c) (display z)))))")
+  (lint-test "(cond ((< x 1) (+ x 1)) (else (+ x 2)))"
+	     " cond: perhaps (cond ((< x 1) (+ x 1)) (else (+ x 2))) -> (+ x (if (< x 1) 1 2))")
+  (lint-test "(cond ((< x 1) (fx1 x y z)) (else (fx1 x z z)))"
+	     " cond: perhaps (cond ((< x 1) (fx1 x y z)) (else (fx1 x z z))) -> (fx1 x (if (< x 1) y z) z)")
+  (lint-test "(cond ((< x 1) (fx1 x y z)) (else (fx1 x z a z)))"
+	     " cond: perhaps (cond ((< x 1) (fx1 x y z)) (else (fx1 x z a z))) -> (fx1 x (if (< x 1) y (values z a)) z)")
+  (lint-test "(cond ((< x 1) (fx1 x y z)) (else (fx1 z z y z)))"
+	     " cond: perhaps (cond ((< x 1) (fx1 x y z)) (else (fx1 z z y z))) -> (fx1 (if (< x 1) x (values z z)) y z)")
+  (lint-test "(cond ((< x 1) (fx1 x z)) (else (fx1 x z)))"
+	     " cond: perhaps (cond ((< x 1) (fx1 x z)) (else (fx1 x z))) -> (fx1 x z)")
+  (lint-test "(cond ((< x 1) (fx1 x y y z)) (else (fx1 x y z)))"
+	     " cond: perhaps (cond ((< x 1) (fx1 x y y z)) (else (fx1 x y z))) -> (fx1 x y (if (< x 1) (values y z) z))")
+  (lint-test "(cond ((< x 1) (fx1 x y y z)) (else (fx1 x z)))"
+	     " cond: perhaps (cond ((< x 1) (fx1 x y y z)) (else (fx1 x z))) -> (fx1 x (if (< x 1) (values y y z) z))")
+  (lint-test "(cond ((< x 1) (fx1 x y z)) (else (fx1 x y y z)))"
+	     " cond: perhaps (cond ((< x 1) (fx1 x y z)) (else (fx1 x y y z))) -> (fx1 x y (if (< x 1) z (values y z)))")
+  (lint-test "(cond ((< x 1) (list x)) (else (list x y)))" "")
+  (lint-test "(cond ((< x 1) (list x y)) (else (list x)))" "")
+  (lint-test "(cond ((< x 1) (+ x 1)) ((< y 1) (+ x 3)) (else (+ x 2)))"
+	     " cond: perhaps (cond ((< x 1) (+ x 1)) ((< y 1) (+ x 3)) (else (+ x 2))) -> (+ x (cond ((< x 1) 1) ((< y 1) 3) (else 2)))")
+  (lint-test "(cond ((< x 1) (+ x 1 y)) ((< y 1) (+ x 3 y)) (else (+ x 2 y)))"
+	     " cond: perhaps (cond ((< x 1) (+ x 1 y)) ((< y 1) (+ x 3 y)) (else (+ x 2 y))) -> (+ x (cond ((< x 1) 1) ((< y 1) 3) (else 2)) y)")
+  (lint-test "(cond (else (+ x 1)))" " cond: perhaps (cond (else (+ x 1))) -> (+ x 1)")
+  (lint-test "(cond ((< x 1) (log x 2)) ((< x 2) (log x 3)) (else (error 'oops)))"
+	     " cond: perhaps (cond ((< x 1) (log x 2)) ((< x 2) (log x 3)) (else (error 'oops))) -> (log x (cond ((< x 1) 2) ((< x 2) 3) (else (error 'oops))))")
+
+  (lint-test "(cond (X (f y z)) (else (g y z)))" " cond: perhaps (cond (X (f y z)) (else (g y z))) -> ((cond (X f) (else g)) y z)")
+  (lint-test "(cond (X (f y z)) (Y (g y z)))" "")
+  (lint-test "(cond (X (f y z)) (Y (f y z)) (Z (f y z)))"
+	     " cond: perhaps (cond (X (f y z)) (Y (f y z)) (Z (f y z))) -> (if (or X Y Z) (f y z))
+               cond: perhaps (cond (X (f y z)) (Y (f y z)) (Z (f y z))) -> (cond ((or X Y Z) (f y z)))")
+  (lint-test "(cond (X (g y a)) (else (g y z)))" " cond: perhaps (cond (X (g y a)) (else (g y z))) -> (g y (if X a z))")
+;  (lint-test "(cond ((not x) (cdr x)) (else (display y)))" " cond: x in (cdr x) should be a pair, but it is #f?")
+  (lint-test "(cond ((pair? x) 3) ((eq? x 'a) 4) ((eq? x 'b) 5) ((eq? x 'c) 6))"
+	     " cond: perhaps (cond ((pair? x) 3) ((eq? x 'a) 4) ((eq? x 'b) 5) ((eq? x 'c) 6)) ->
+                 (cond ((pair? x) 3) ((assq x '((a . 4) (b . 5) (c . 6))) => cdr))")
+  (lint-test "(cond ((pair? x) 3) ((eq? x 'a) 4) ((eq? x 'b) 5) ((eq? x 'c) 6) (else #f))"
+	     " cond: perhaps (cond ((pair? x) 3) ((eq? x 'a) 4) ((eq? x 'b) 5) ((eq? x 'c) 6) (else #f)) ->
+                 (cond ((pair? x) 3) ((assq x '((a . 4) (b . 5) (c . 6))) => cdr) (else #f))")
+  (lint-test "(cond ((pair? x) 3) ((eq? x 'a) 4) ((eq? x 'b) 5) ((eq? x 'c) 6) ((eq? x 'd) 7))"
+	     " cond: perhaps (cond ((pair? x) 3) ((eq? x 'a) 4) ((eq? x 'b) 5) ((eq? x 'c) 6) ((eq? x... ->
+                 (cond ((pair? x) 3) ((assq x '((a . 4) (b . 5) (c . 6) (d . 7))) => cdr))")
+  (lint-test "(cond ((= i n) #f) ((pred? (vector-ref v i)) #t) (else (loop (+ 1 i))))"
+	     " cond: perhaps (cond ((= i n) #f) ((pred? (vector-ref v i)) #t) (else (loop (+ 1 i)))) ->
+                 (and (not (= i n)) (or (pred? (vector-ref v i)) (loop (+ 1 i))))")
+  (lint-test "(cond ((= i n) #f) ((pred? (vector-ref v i))) (else (loop (+ 1 i))))"
+	     " cond: perhaps (cond ((= i n) #f) ((pred? (vector-ref v i))) (else (loop (+ 1 i)))) ->
+                 (and (not (= i n)) (or (pred? (vector-ref v i)) (loop (+ 1 i))))")
+  (lint-test "(cond ((= i n) #t) ((pred? (vector-ref v i)) (loop (+ 1 i))) (else #f))"
+	     " cond: this #t could be omitted: ((= i n) #t)
+               cond: perhaps (cond ((= i n) #t) ((pred? (vector-ref v i)) (loop (+ 1 i))) (else #f)) ->
+                 (or (= i n) (and (pred? (vector-ref v i)) (loop (+ 1 i))))")
+  (lint-test "(cond ((= i n)) ((pred? (vector-ref v i)) (loop (+ 1 i))) (else #f))"
+	     " cond: perhaps (cond ((= i n)) ((pred? (vector-ref v i)) (loop (+ 1 i))) (else #f)) ->
+                 (or (= i n) (and (pred? (vector-ref v i)) (loop (+ 1 i))))")
+  (lint-test "(cond (A #f) (B #t) (else C))" " cond: perhaps (cond (A #f) (B #t) (else C)) -> (and (not A) (or B C))")
+  (lint-test "(cond (A #t) (B C) (else #f))" " cond: perhaps (cond (A #t) (B C) (else #f)) -> (or A (and B C))")
+  (lint-test "(cond (A #f) (B) (else C))"    " cond: perhaps (cond (A #f) (B) (else C)) -> (and (not A) (or B C))")
+  (lint-test "(cond (A) (B C) (else #f))"    " cond: perhaps (cond (A) (B C) (else #f)) -> (or A (and B C))")
+  (lint-test "(cond ((getenv s) x) ((= y z) w))" "")
+  (lint-test "(cond (A #f) (B #f))"          " cond: perhaps (cond (A #f) (B #f)) -> (if (or A B) #f)")
+  (lint-test "(cond (A C) (B C))"            " cond: perhaps (cond (A C) (B C)) -> (if (or A B) C)")
+
+  (lint-test "(cond ((and (pair? x) (pair? y) (pair? z)) 32) ((and (pair? x) (pair? y) (pair? w)) 12) ((and (pair? x) (pair? y) (pair? v)) 2))"
+	     " cond: perhaps
+    (cond ((and (pair? x) (pair? y) (pair? z)) 32) ((and (pair? x) (pair? y)... ->
+    (cond ((not (and (pair? x) (pair? y))) #<unspecified>)
+          ((pair? z) 32)
+          ((pair? w) 12)
+          ((pair? v) 2))")
+  (lint-test "(cond ((and (pair? x) (pair? y) (pair? z)) 32) ((and (pair? x) (pair? w)) 12) ((pair? x) 2))"
+	     " cond: perhaps
+    (cond ((and (pair? x) (pair? y) (pair? z)) 32) ((and (pair? x) (pair? w))... ->
+    (cond ((not (pair? x)) #<unspecified>)
+          ((and (pair? y) (pair? z)) 32)
+          ((pair? w) 12)
+          (else 2))")
+  (lint-test "(cond ((pair? z) 32) ((and (pair? x) (pair? w)) 12) ((pair? x) 2))"
+	     " cond: perhaps
+    (cond ((pair? z) 32) ((and (pair? x) (pair? w)) 12) ((pair? x) 2)) ->
+    (cond ((pair? z) 32) ((not (pair? x)) #<unspecified>) ((pair? w) 12) (else 2))")
+  (lint-test "(cond ((pair? z) 32) ((and (pair? x) (pair? w)) 12) ((pair? x) 2) (else 0))"
+	     " cond: perhaps
+    (cond ((pair? z) 32) ((and (pair? x) (pair? w)) 12) ((pair? x) 2) (else 0)) ->
+    (cond ((pair? z) 32) ((not (pair? x)) 0) ((pair? w) 12) (else 2))")
+  (lint-test "(cond ((and x (pair? y)) 1) ((and x (string? y)) 2) ((and x (char? y)) 3) (else 4))"
+	     " cond: perhaps
+    (cond ((and x (pair? y)) 1) ((and x (string? y)) 2) ((and x (char? y)) 3)... ->
+    (cond ((not x) 4) ((pair? y) 1) ((string? y) 2) ((char? y) 3) (else 4))")
+
+  (lint-test "(cond ((= x y) 2) ((= x 2) #f) (else #t))"
+	     " cond: perhaps (cond ((= x y) 2) ((= x 2) #f) (else #t)) -> (cond ((= x y) 2) (else (not (= x 2))))")
+  (lint-test "(cond ((= x y) 2) ((= x 2) #t) (else #f))"
+	     " cond: this #t could be omitted: ((= x 2) #t)
+               cond: perhaps (cond ((= x y) 2) ((= x 2) #t) (else #f)) -> (cond ((= x y) 2) (else (= x 2)))")
+  (lint-test "(cond ((not x) y) (else z))" " cond: perhaps (cond ((not x) y) (else z)) -> (if x z y)")
+  (lint-test "(cond ((not x) (f z) y) (else z))" " cond: perhaps (cond ((not x) (f z) y) (else z)) -> (cond (x z) (else (f z) y))")
+  (lint-test "(cond ((not x)) (else z))" " cond: perhaps (cond ((not x)) (else z)) -> (or (not x) z)")
+  (lint-test "(cond ((not x)) (else (f y) z))" " cond: perhaps (cond ((not x)) (else (f y) z)) -> (or (not x) (begin (f y) z))")
+
+  (lint-test "(cond ((memq x y) z) (else (f x) z))" " cond: perhaps (cond ((memq x y) z) (else (f x) z)) -> (begin (if (not (memq x y)) (f x)) z)")
+  (lint-test "(cond (x (f y) z) (else z))" " cond: perhaps (cond (x (f y) z) (else z)) -> (begin (if x (f y)) z)")
+  (lint-test "(cond ((memq x y) (display y) z) (else (f x) z))"
+	     " cond: perhaps (cond ((memq x y) (display y) z) (else (f x) z)) -> (begin (if (memq x y) (display y) (f x)) z)")
+  (lint-test "(cond (x (f y) z) (else (g y) (h y) z))"
+	     " cond: perhaps (cond (x (f y) z) (else (g y) (h y) z)) -> (begin (if x (f y) (begin (g y) (h y))) z)")
+  (lint-test "(cond (x (f y) (g x) z) (else (g y) (h y) z))"
+	     " cond: perhaps (cond (x (f y) (g x) z) (else (g y) (h y) z)) -> (begin (if x (begin (f y) (g x)) (begin (g y) (h y))) z)")
+  (lint-test "(cond (x (f y) (g x) z) (else z))" " cond: perhaps (cond (x (f y) (g x) z) (else z)) -> (begin (if x (begin (f y) (g x))) z)")
+  (lint-test "(cond ((f x) (display y) z) ((h x) (f x) (display y) z) (else z))"
+	     " cond: perhaps (cond ((f x) (display y) z) ((h x) (f x) (display y) z) (else z)) ->
+                (begin (cond ((f x) (display y)) ((h x) (f x) (display y))) z)")
+  (lint-test "(let ((x 2)) (cond (A B) (C => (let ((y 4)) (lambda (n) (lambda (m) (+ n m x y)))))))"
+	     " let: perhaps move the let into the '(C => (let ((y 4)) (lambda (n) (lambda (m) (+ n m x y))))) branch:
+                (let ((x 2)) (cond (A B) (C => (let ((y 4)) (lambda (n) (lambda (m) (+ n m... ->
+                (cond ... (C => (let ((x 2)) (let ((y 4)) (lambda (n) (lambda (m) (+ n m x y)))))) ...)")
+
+  (lint-test "(cond (A a) (B b) (else (if C (c) (d)) #t))"
+	     " cond: else clause could be folded into the outer cond:
+                (cond (A a) (B b) (else (if C (c) (d)) #t)) -> (cond (A a) (B b) (C (c) #t) (else (d) #t))")
+  (lint-test "(cond (A a) (B b) (else (if C (c)) #t))"
+	     " cond: else clause could be folded into the outer cond:
+                (cond (A a) (B b) (else (if C (c)) #t)) -> (cond (A a) (B b) (C (c) #t) (else #t))")
+  (lint-test "(cond (A a) (B b) (else (cond (C (c)) (else (d))) #t))"
+	     " cond: else clause could be folded into the outer cond:
+                (cond (A a) (B b) (else (cond (C (c)) (else (d))) #t)) -> (cond (A a) (B b) (C (c) #t) (else (d) #t))
+               cond: perhaps (cond (C (c)) (else (d))) -> ((cond (C c) (else d)))")
+  (lint-test "(cond (A a) (B b) (else (cond (C (c)) (D (d))) #t))"
+	     " cond: else clause could be folded into the outer cond:
+                (cond (A a) (B b) (else (cond (C (c)) (D (d))) #t)) -> (cond (A a) (B b) (C (c) #t) (D (d) #t) (else #t))")
+  (lint-test "(cond (A a) (B b) (else (when C (c) (d)) #t))"
+	     " cond: else clause could be folded into the outer cond:
+                (cond (A a) (B b) (else (when C (c) (d)) #t)) -> (cond (A a) (B b) (C (c) (d) #t) (else #t))")
+  (lint-test "(cond (A a) (B b) (else (unless C (c) (d)) #t))"
+	     " cond: else clause could be folded into the outer cond:
+                (cond (A a) (B b) (else (unless C (c) (d)) #t)) -> (cond (A a) (B b) ((not C) (c) (d) #t) (else #t))")
+
+  (lint-test "(begin (if (> x 1) (set! x y)) (if (> x 1) (display x)))"
+	     " begin: perhaps (... (if (> x 1) (set! x y)) (if (> x 1) (display x)) ...) -> (... (when (> x 1) (set! x y) (when (> x 1) (display x))) ...)")
+  (lint-test "(begin (if (> x 1) (display x)) (if (> x 1) (set! x y)))"
+	     " begin: perhaps (... (if (> x 1) (display x)) (if (> x 1) (set! x y)) ...) -> (... (when (> x 1) (display x) (set! x y)) ...)")
+  (lint-test "(cond ((> x 1) (set! x y)) ((> x 1) (display x)))"
+	     " cond: cond test (> x 1) is never true: (cond ((> x 1) (set! x y)) ((> x 1) (display x)))
+               cond: cond test repeated: ((> x 1) (display x))
+               cond: cond test is always false: ((> x 1) (display x))
+               cond: perhaps (cond ((> x 1) (set! x y)) ((> x 1) (display x))) -> (cond ((> x 1) (set! x y)))")
+  (lint-test "(cond (A (f x) => y))" " cond: '=> has no effect here: (A (f x) => y) cond: perhaps (cond (A (f x) => y)) -> (when A (f x) => y)")
+
+  (lint-test "(when (and (< x 1) y) (if z (display z)))"
+	     " when: perhaps (when (and (< x 1) y) (if z (display z))) -> (when (and (< x 1) y z) (display z))")
+  (lint-test "(when y (if z (display z)))"
+	     " when: perhaps (when y (if z (display z))) -> (when (and y z) (display z))")
+  (lint-test "(when y (if (or (< x 1) z) (display z)))"
+	     " when: perhaps (when y (if (or (< x 1) z) (display z))) -> (when (and y (or (< x 1) z)) (display z))")
+  (lint-test "(when (and (< x 1) y) (when z (display z) x))"
+	     " when: perhaps (when (and (< x 1) y) (when z (display z) x)) -> (when (and (< x 1) y z) (display z) x)")
+  (lint-test "(when x (when y z))" " when: perhaps (when x (when y z)) -> (when (and x y) z)")
+  (lint-test "(unless x (unless y z))" " unless: perhaps (unless x (unless y z)) -> (unless (or x y) z)")
+  (lint-test "(unless (and (< x 1) y) (if z (display z)))"
+	     " unless: perhaps (unless (and (< x 1) y) (if z (display z))) -> (when (and (not (and (< x 1) y)) z) (display z))")
+  (lint-test "(unless y (if z (display z)))"
+	     " unless: perhaps (unless y (if z (display z))) -> (when (and (not y) z) (display z))")
+  (lint-test "(unless y (if (or (< x 1) z) (display z)))"
+	     " unless: perhaps (unless y (if (or (< x 1) z) (display z))) -> (when (and (not y) (or (< x 1) z)) (display z))")
+  (lint-test "(unless (and (< x 1) y) (when z (display z) x))"
+	     " unless: perhaps (unless (and (< x 1) y) (when z (display z) x)) -> (when (and (not (and (< x 1) y)) z) (display z) x)")
+  (lint-test "(unless (and (< x 1) y) (unless z (display z) x))"
+	     " unless: perhaps (unless (and (< x 1) y) (unless z (display z) x)) -> (unless (or (and (< x 1) y) z) (display z) x)")
+  (lint-test "(when (< x 2) (cond ((= x 0) 1) ((negative? x) 2) (else 3)))"
+	     " when: perhaps (when (< x 2) (cond ((= x 0) 1) ((negative? x) 2) (else 3))) -> (cond ((>= x 2) #<unspecified>) ((= x 0) 1) ((negative? x) 2) (else 3))")
+  (lint-test "(unless (< x 2) (cond ((= x 0) 1) ((negative? x) 2) (else 3)))"
+	     " unless: perhaps (unless (< x 2) (cond ((= x 0) 1) ((negative? x) 2) (else 3))) -> (when (>= x 2) (cond ((= x 0) 1) ((negative? x) 2) (else 3)))
+               unless: perhaps (unless (< x 2) (cond ((= x 0) 1) ((negative? x) 2) (else 3))) -> (cond ((< x 2) #<unspecified>) ((= x 0) 1) ((negative? x) 2) (else 3))")
+  (lint-test "(unless (and x (not y)) (display z))"       " unless: perhaps (unless (and x (not y)) (display z)) -> (when (or (not x) y) ...)")
+  (lint-test "(unless (and (not x) y) (display z))"       " unless: perhaps (unless (and (not x) y) (display z)) -> (when (or x (not y)) ...)")
+  (lint-test "(unless (and (not x) (not y)) (display z))" " unless: perhaps (unless (and (not x) (not y)) (display z)) -> (when (or x y) ...)")
+  (lint-test "(when (and (not x) (not y)) (display z))"
+	     " when: perhaps (when (and (not x) (not y)) (display z)) -> (unless (or x y) ...)
+               when: perhaps (and (not x) (not y)) -> (not (or x y))")
+  (lint-test "(when A (unless B (display C) (f D E)))"
+	     " when: perhaps (when A (unless B (display C) (f D E))) -> (when (and A (not B)) (display C) (f D E))")
+  (lint-test "(unless A (when B (display C) (f D E)))"
+	     " unless: perhaps (unless A (when B (display C) (f D E))) -> (when (and (not A) B) (display C) (f D E))")
+  (lint-test "(when A (unless (odd? B) (display C) (f D E)))"
+	     " when: perhaps (when A (unless (odd? B) (display C) (f D E))) -> (when (and A (even? B)) (display C) (f D E))
+               when: perhaps (unless (odd? B) (display C) (f D E)) -> (when (even? B) (display C) (f D E))")
+  (lint-test "(unless (< x y) (cond ((A B) (C D)) (else E)))"
+	     " unless: perhaps (unless (< x y) (cond ((A B) (C D)) (else E))) -> (when (>= x y) (cond ((A B) (C D)) (else E)))
+               unless: perhaps (unless (< x y) (cond ((A B) (C D)) (else E))) -> (cond ((< x y) #<unspecified>) ((A B) (C D)) (else E))")
+  (lint-test "(unless (< x 1) (cond ((integer? x) 1) (else 2)))"
+	     " unless: perhaps (unless (< x 1) (cond ((integer? x) 1) (else 2))) -> (when (>= x 1) (cond ((integer? x) 1) (else 2)))
+               unless: perhaps (unless (< x 1) (cond ((integer? x) 1) (else 2))) -> (cond ((< x 1) #<unspecified>) ((integer? x) 1) (else 2))")
+  (lint-test "(when (< x 1) (cond ((integer? x) 1) (else 2)))"
+             " when: perhaps (when (< x 1) (cond ((integer? x) 1) (else 2))) -> (cond ((>= x 1) #<unspecified>) ((integer? x) 1) (else 2))")
+  (lint-test "(unless (< y 3) 32)" " unless: perhaps (unless (< y 3) 32) -> (when (>= y 3) 32)")
+  (lint-test "(if (< x 1) (cond ((integer? x) 1) (else 2)))"
+             " if: perhaps (if (< x 1) (cond ((integer? x) 1) (else 2))) -> (cond ((>= x 1) #<unspecified>) ((integer? x) 1) (else 2))")
+  (lint-test "(cond ((< x 1) (cond ((integer? x) 1) (else 2))))"
+	     " cond: perhaps (cond ((< x 1) (cond ((integer? x) 1) (else 2)))) -> (if (< x 1) (cond ((integer? x) 1) (else 2)))
+               cond: perhaps (cond ((< x 1) (cond ((integer? x) 1) (else 2)))) -> (cond ((>= x 1) #<unspecified>) ((integer? x) 1) (else 2))")
+  (lint-test "(if (and (< x 1) y) (when z (display z) x))"
+	     " if: perhaps (if (and (< x 1) y) (when z (display z) x)) -> (when (and (< x 1) y z) (display z) x)")
+  (lint-test "(if (and (< x 1) y) (unless z (display z) x))"
+	     " if: perhaps (if (and (< x 1) y) (unless z (display z) x)) -> (when (and (< x 1) y (not z)) (display z) x)")
+  (lint-test "(let ((x (g y))) (when x (display x)) (when x (set! y x)))"
+	     " let: perhaps (... (when x (display x)) (when x (set! y x)) ...) -> (when x (display x) (set! y x))")
+  (lint-test "(let ((x (g y))) (unless x (display x)) (unless x (set! y x)))"
+	     " let: perhaps (... (unless x (display x)) (unless x (set! y x)) ...) -> (unless x (display x) (set! y x))")
+  (lint-test "(begin (and x (display y)) (log z))" " begin: perhaps (and x (display y)) -> (if x (display y))")
+  (lint-test "(begin (or x (display y)) (log z))"  " begin: perhaps (or x (display y)) -> (if (not x) (display y))")
+  (lint-test "(begin (if x #f (display y)) y)"
+	     " begin: this branch is pointless: #f in (if x #f (display y))
+               begin: perhaps (if x #f (display y)) -> (unless x (display y))")
+  (lint-test "(begin (if x (display y) #f) y)"
+	     " begin: this branch is pointless: #f in (if x (display y) #f)
+               begin: perhaps (if x (display y) #f) -> (when x (display y))")
+  (lint-test "(begin (if x #f (begin (display y) (read z))) y)"
+	     " begin: this branch is pointless: #f in (if x #f (begin (display y) (read z)))
+               begin: perhaps (if x #f (begin (display y) (read z))) -> (unless x (display y) (read z))")
+  (lint-test "(begin (if (not x) #f (begin (display y) (read z))) y)"
+	     " begin: this branch is pointless: #f in (if (not x) #f (begin (display y) (read z)))
+               begin: perhaps (if (not x) #f (begin (display y) (read z))) -> (when x (display y) (read z))")
+
+  (lint-test "(car (cons 1 2))"		" car: (car       (cons 1 2)) is the same as 1")
+  (lint-test "(car (string->list x))"   " car: perhaps (car (string->list x)) -> (string-ref x 0)")
+  (lint-test "(car (string->list (symbol->string x)))" " car: perhaps (car (string->list (symbol->string x))) -> (string-ref (symbol->string x) 0)")
+  (lint-test "(set-car! (list-tail x y) z)" " set-car!: perhaps (set-car! (list-tail x y) z) -> (list-set! x y z)")
+  (lint-test "(set-car! (cdr x) y)"     " set-car!: perhaps (set-car! (cdr x) y) -> (list-set! x 1 y)")
+  (lint-test "(set-car! (cddr (cdddr x)) y)" " set-car!: perhaps (set-car! (cddr (cdddr x)) y) -> (list-set! x 5 y)")
+  (lint-test "(begin (set-car! x (car y)) (set-cdr! x (cdr y)))" " begin: perhaps ...(set-car! x (car y)) (set-cdr! x (cdr y)) -> (copy y x)")
+  (lint-test "(car (list-tail x y))"    " car: perhaps (car (list-tail x y)) -> (list-ref x y)")
+  (lint-test "(car (list x y))"         " car: perhaps (car (list x y)) -> x")
+  (lint-test "(car (append x y))"       " car: perhaps (car (append x y)) -> (car x)")
+  (lint-test "(caddr (vector->list x))" " caddr: perhaps (caddr (vector->list x)) -> (vector-ref x 2)")
+  (lint-test "(and x x y)"		" and: perhaps (and x x y) -> (and x y)")
+  (lint-test "(or x x y)"		" or: perhaps (or x x y) -> (or x y)")
+  (lint-test "(or x (or x y))"		" or: perhaps (or x (or x y)) -> (or x y)")
+  (lint-test "(< x 1 2 0 y)"		" <: this comparison can't be true: (< x 1 2 0 y)")
+  (lint-test "(< (- x y) 0)"            " <: perhaps (< (- x y) 0) -> (< x y)")
+  (lint-test "(> (- (log x) (log y)) 0.0)" " >: perhaps (> (- (log x) (log y)) 0.0) -> (> (log x) (log y))
+                                             >: perhaps (- (log x) (log y)) -> (log (/ x y))")
+  (lint-test "(< 0 (- x y))"            " <: perhaps (< 0 (- x y)) -> (> x y)")
+  (lint-test "(> x (- y 1))"            "") ; only optimizable if x and y are known to be integers
+  (lint-test "(< x 1 2 y)"		"")
+  (lint-test "(< x 1 y)"		"")
+  (lint-test "(< 0 (floor x) 1)"        " <: perhaps (< 0 (floor x) 1) -> #f")
+  (lint-test "(< x x)"                  " <: this looks odd: (< x x)")
+  (lint-test "(< x y x)"                " <: it looks odd to have repeated arguments in (< x y x) <: perhaps (< x y x) -> #f")
+  (lint-test "(< x x y)"                " <: it looks odd to have repeated arguments in (< x x y) <: perhaps (< x x y) -> #f")
+  (lint-test "(<= x x y z)"             " <=: it looks odd to have repeated arguments in (<= x x y z) <=: perhaps (<= x x y z) -> (= x y z)")
+  (lint-test "(<= x y x z x)"           " <=: it looks odd to have repeated arguments in (<= x y x z x) <=: perhaps (<= x y x z x) -> (= x y z)")
+  (lint-test "(<= x x x)"               " <=: it looks odd to have repeated arguments in (<= x x x) <=: perhaps (<= x x x) -> #t")
+  (lint-test "(> x y z y)"              " >: it looks odd to have repeated arguments in (> x y z y) >: perhaps (> x y z y) -> #f")
+  (lint-test "(char>? x #\\a #\\b y)"	" char>?: this comparison can't be true: (char>? x #\\a #\\b y)")
+  (lint-test "(< (char->integer x) 95)" " <: perhaps (< (char->integer x) 95) -> (char<? x #\\_)")
+  (lint-test "(>= (char->integer x) 90 (char->integer y))" " >=: perhaps (>= (char->integer x) 90 (char->integer y)) -> (char>=? x #\\Z y)")
+  (lint-test "(> (abs x) -1)"           " >: abs can't be negative: (> (abs x) -1)")
+  (lint-test "(or (= (denominator n) 1) (= (denominator n) 0))"
+	     " or: perhaps (or (= (denominator n) 1) (= (denominator n) 0)) -> (member (denominator n) '(1 0) =)
+               or: perhaps (= (denominator n) 1) -> (integer? n)
+               or: denominator is never 0: (= (denominator n) 0)")
+  (lint-test "(or (> (denominator n) 0) (<= (denominator n) 0))"
+	     " or: perhaps (or (> (denominator n) 0) (<= (denominator n) 0)) -> #t
+               or: denominator is always > than 0: (> (denominator n) 0)
+               or: denominator is never <= than 0: (<= (denominator n) 0)")
+
+  (lint-test "(string>? \"a\" x \"b\" y)" " string>?: this comparison can't be true: (string>? \"a\" x \"b\" y)")
+  (lint-test "(copy (copy x))"		" copy: (copy (copy x)) could be (copy x)")
+  (lint-test "(copy (copy x) (list 1))" " copy: (copy (copy x) (list 1)) could be (copy x (list 1))")
+  (lint-test "(copy (copy x) y)"        " copy: (copy (copy x) y) could be (copy x y)")
+  (lint-test "(copy (copy x y 1 2))"    " copy: (copy (copy x y 1 2)) could be (copy x y 1 2)")
+  (lint-test "(copy x x)"               " copy: (copy x x) is a no-op")
+  (lint-test "(copy x x 0)"             " copy: (copy x x 0) is a no-op")
+  (lint-test "(copy x y 1 0)"           " copy: these copy indices make no sense: (copy x y 1 0)")
+  (lint-test "(copy x y 0 0)"           " copy: these copy indices make no sense: (copy x y 0 0)")
+
+  (lint-test "(string-ref (symbol->string 'abs) 1)"
+	     " string-ref: perhaps (string-ref (symbol->string 'abs) 1) -> #\\b
+               string-ref: perhaps (symbol->string 'abs) -> \"abs\"")
+  (lint-test "(string-ref (substring x 1) 2)"       " string-ref: perhaps (string-ref (substring x 1) 2) -> (string-ref x (+ 2 1))")
+  (lint-test "(string-ref (make-string 3 #\\a) 1)"  " string-ref: perhaps (string-ref (make-string 3 #\\a) 1) -> #\\a")
+  (lint-test "(string-ref (round x) str)"
+	     " string-ref: in (string-ref (round x) str), string-ref's first argument should be a string, but (round x) is an integer?")
+  (lint-test "(string-ref x (cons 1 2))"
+	     " string-ref: in (string-ref x (cons 1 2)), string-ref's second argument should be an integer, but (cons 1 2) is a pair?")
+  (lint-test "(string-copy (string-copy x))" " string-copy: (string-copy (string-copy x)) could be (string-copy x)")
+
+  (lint-test "(string-append x)"        " string-append: perhaps (string-append x) -> x, or use copy")
+  (lint-test "(string-append \"\" \"\" x)" " string-append: perhaps (string-append \"\" \"\" x) -> x, or use copy")
+  (lint-test "(string-append \"\" \"\")" " string-append: perhaps (string-append \"\" \"\") -> \"\"")
+  (lint-test "(string-append \"\" (string-append x y) \"\")" " string-append: perhaps (string-append \"\" (string-append x y) \"\") -> (string-append x y)")
+  (lint-test "(string-append \"123\" \"456\")" " string-append: perhaps (string-append \"123\" \"456\") -> \"123456\"")
+  (lint-test "(string-append x (string-append y z))" " string-append: perhaps (string-append x (string-append y z)) -> (string-append x y z)")
+  (lint-test "(string-append x \"a\" \"bc\" y)" " string-append: perhaps (string-append x \"a\" \"bc\" y) -> (string-append x \"abc\" y)")
+
+  (lint-test "(vector-append)"	" vector-append: perhaps (vector-append) -> #()")
+  (lint-test "(vector-append x)" " vector-append: perhaps (vector-append x) -> (copy x)")
+  (lint-test "(vector-append #(1 2) (vector-append #(3)))"
+	     " vector-append: perhaps (vector-append #(1 2) (vector-append #(3))) -> #(1 2 3)
+               vector-append: #(1 2) could be #i(1 2)
+               vector-append: #(3) could be #i(3)")
+  (lint-test "(vector-append x (vector-append y z))" " vector-append: perhaps (vector-append x (vector-append y z)) -> (vector-append x y z)")
+  (lint-test "(vector-append v1 (apply vector-append vs))"
+	     " vector-append: perhaps (vector-append v1 (apply vector-append vs)) -> (vector-append v1 (apply values vs))")
+
+  (lint-test "(object->string (object->string x))" " object->string: (object->string (object->string x)) could be (object->string x)")
+  (lint-test "(object->string x :else)" " object->string: bad second argument: :else")
+  (lint-test "(display (format #f str x))" " display: perhaps (display (format #f str x)) -> (format () str x)")
+  (lint-test "(display (apply format #f str x) p)" " display: perhaps (display (apply format #f str x) p) -> (apply format p str x)")
+
+  (lint-test "(reverse (reverse x))"	" reverse: (reverse (reverse x)) could be (copy x)")
+  (lint-test "(reverse (cdr (reverse x)))" " reverse: perhaps (reverse (cdr (reverse x))) -> (copy x (make-list (- (length x) 1)))")
+  (lint-test "(reverse (cons x (reverse y)))" " reverse: perhaps (reverse (cons x (reverse y))) -> (append y (list x))")
+  (lint-test "(reverse (list-tail (reverse slist) index))"
+	     " reverse: perhaps (reverse (list-tail (reverse slist) index)) -> (copy slist (make-list (- (length slist) index)))")
+  (lint-test "(reverse (append (reverse b) res))" " reverse: perhaps (reverse (append (reverse b) res)) -> (append (reverse res) b)")
+  (lint-test "(reverse (reverse! x))" " reverse: (reverse (reverse! x)) could be (copy x)")
+  (lint-test "(reverse (string->list x))" " reverse: perhaps less consing: (reverse (string->list x)) -> (string->list (reverse x))")
+  (lint-test "(reverse '(1 2 3))" " reverse: perhaps (reverse '(1 2 3)) -> '(3 2 1)")
+  (lint-test "(reverse (sort! x <))" " reverse: possibly (reverse (sort! x <)) -> (sort! x >)")
+  (lint-test "(reverse (map abs (sort! x <)))" " reverse: possibly (reverse (map abs (sort! x <))) -> (map abs (sort! x >))")
+
+;  (lint-test "(let ((v (list 1 2))) (reverse! v) v)" "")
+;  (lint-test "(let ((v1 (list 1 2))) (set! v1 (reverse! v1)))" "")
+
+  (lint-test "(vector->list (list->vector x))"   " vector->list: (vector->list (list->vector x)) could be (copy x)")
+  (lint-test "(string->number (number->string x))" " string->number: (string->number (number->string x)) could be x")
+  (lint-test "(string->number \"123\" 21)"       " string->number: string->number radix should be between 2 and 16: (string->number \"123\" 21)")
+  (lint-test "(string->number (string num-char))"
+	     " string->number: perhaps (string->number (string num-char)) -> (- (char->integer num-char) (char->integer #\\0))")
+  (lint-test "(string->number (or (f x) \"4\"))" " string->number: perhaps (string->number (or (f x) \"4\")) -> (cond ((f x) => string->number) (else 4))")
+  (lint-test "(length (string->list x))"         " length: perhaps (length (string->list x)) -> (length x)")
+  (lint-test "(length (vector->list x))"         " length: perhaps (length (vector->list x)) -> (length x)")
+  (lint-test "(length (vector->list x 1))"       " length: perhaps (length (vector->list x 1)) -> (- (length x) 1)")
+  (lint-test "(length (vector->list x 1 3))"     " length: perhaps (length (vector->list x 1 3)) -> 2")
+  (lint-test "(length (vector->list x y 3))"     " length: perhaps (length (vector->list x y 3)) -> (- 3 y)")
+  (lint-test "(list->string (vector->list x))"   " list->string: perhaps (list->string (vector->list x)) -> (copy x (make-string (length x)))")
+  (lint-test "(list->vector (string->list x))"   " list->vector: perhaps (list->vector (string->list x)) -> (copy x (make-vector (length x)))")
+  (lint-test "(vector->list (make-vector 3 #f))" " vector->list: perhaps (vector->list (make-vector 3 #f)) -> (make-list 3 #f)")
+  (lint-test "(list->vector (make-list 3 #f))"   " list->vector: perhaps (list->vector (make-list 3 #f)) -> (make-vector 3 #f)")
+  (lint-test "(list->string (reverse x))"        " list->string: perhaps (list->string (reverse x)) -> (reverse (list->string x))")
+  (lint-test "(define (getservent) (getserv))"   " getservent: (define (getservent) (getserv)) could probably be (define getservent getserv)")
+  (lint-test "(< (char->integer key) 256)"       " <: perhaps (< (char->integer key) 256) -> #t")
+  (lint-test "(require \"repl.scm\")"            " require: require's arguments should be symbols: (require \"repl.scm\")")
+  (lint-test "(list-ref (cddr f) (- (length f) 3))" " list-ref: perhaps (list-ref (cddr f) (- (length f) 3)) -> (list-ref f (- (length f) 1))")
+  (lint-test "(list-ref (cdddr f) 2)"            " list-ref: perhaps (list-ref (cdddr f) 2) -> (list-ref f 5)")
+  (lint-test "(list-ref (cdr f) (- len 1))"      " list-ref: perhaps (list-ref (cdr f) (- len 1)) -> (list-ref f len)")
+
+(lint-test "(let ((lst '(1 2 3))) (+ (list-ref lst 0) (list-ref lst 1) (list-ref lst 2) (list-ref lst 3)))"
+" let: perhaps (list-ref lst 0) -> (car lst) let: lst could be a vector, rather than a list")
+
+(lint-test "(let ((lst '((1) 2 3))) (+ (list-ref (list-ref lst 0) 0) (list-ref (list-ref lst 0) 1) (list-ref (list-ref lst 0) 2) (list-ref (list-ref lst 0) 3)))"
+" let: perhaps (list-ref (list-ref lst 0) 0) -> (caar lst)
+ let: lst could be a vector, rather than a list
+ let: lst is not set, and is always accessed via (list-ref lst 0)
+     so its binding could probably be (lst (list-ref '((1) 2 3) 0)) in (let ((lst '((1) 2 3))) (+ (list-ref (list-ref lst 0) 0) (list-ref...")
+
+(lint-test "(let ((lst '((1) 2 3))) (+ (list-ref (list-ref lst 1) 0) (list-ref (list-ref lst 1) 1) (list-ref (list-ref lst 1) 2) (list-ref (list-ref lst 1) 3)))"
+" let: perhaps (list-ref (list-ref lst 1) 0) -> (caadr lst)
+ let: lst could be a vector, rather than a list
+ let: lst is not set, and is always accessed via (list-ref lst 1)
+     so its binding could probably be (lst (list-ref '((1) 2 3) 1)) in (let ((lst '((1) 2 3))) (+ (list-ref (list-ref lst 1) 0) (list-ref...")
+
+(lint-test "(let ((lst '((1) 2 3))) (+ (list-ref (list-ref lst 2) 0) (list-ref (list-ref lst 3) 1) (list-ref (list-ref lst 4) 2) (list-ref (list-ref lst 2) 3)))"
+" let: perhaps (list-ref (list-ref lst 2) 0) -> (car (list-ref lst 2))
+ let: lst could be a vector, rather than a list
+")
+
+  (lint-test "(list->vector (reverse (vector->list x)))"
+	     " list->vector: perhaps (list->vector (reverse (vector->list x))) -> (reverse x)
+               list->vector: perhaps less consing: (reverse (vector->list x)) -> (vector->list (reverse x))")
+  (lint-test "(list->vector (reverse! (vector->list x)))"
+	     " list->vector: perhaps (list->vector (reverse! (vector->list x))) -> (reverse x)
+               list->vector: perhaps less consing: (reverse! (vector->list x)) -> (vector->list (reverse x))")
+  (lint-test "(list->vector (copy (vector->list x)))" " list->vector: perhaps (list->vector (copy (vector->list x))) -> (copy x)")
+  (lint-test "(list->string (reverse (string->list (substring str 1))))"
+	     " list->string: perhaps (list->string (reverse (string->list (substring str 1)))) -> (reverse (substring str 1))
+               list->string: perhaps less consing: (reverse (string->list (substring str 1))) -> (string->list (reverse (substring str 1)))")
+  (lint-test "(list->string (cdr (string->list x)))" " list->string: perhaps (list->string (cdr (string->list x))) -> (substring x 1)")
+  (lint-test "(list->vector (list-tail (vector->list x) y))"
+	     " list->vector: perhaps (list->vector (list-tail (vector->list x) y)) -> (copy x (make-vector (- (length x) y))) ")
+  (lint-test "(string->list \"123\")" " string->list: perhaps (string->list \"123\") -> '(#\\1 #\\2 #\\3)")
+  (lint-test "(list->vector '(1 2 3))" " list->vector: perhaps (list->vector '(1 2 3)) -> #(1 2 3)")
+  (lint-test "(list->vector (cons x '()))"
+	     " list->vector: perhaps (list->vector (cons x '())) -> (vector x)
+               list->vector: perhaps (cons x '()) -> (list x)
+               list->vector: quote is not needed here: '()")
+  (lint-test "(list->vector (list x y z))" " list->vector: perhaps (list->vector (list x y z)) -> (vector x y z)")
+  (lint-test "(list->vector (append (vector->list x) (vector->list y)))"
+	     " list->vector: perhaps (list->vector (append (vector->list x) (vector->list y))) -> (append x y)
+               list->vector: perhaps (append (vector->list x) (vector->list y)) -> (vector->list (append x y))")
+  (lint-test "(list->string '(#\\a #\\b #\\c))" " list->string: perhaps (list->string '(#\\a #\\b #\\c)) -> \"abc\"")
+  (lint-test "(list->string (cons x '()))"
+	     " list->string: perhaps (list->string (cons x '())) -> (string x)
+               list->string: perhaps (cons x '()) -> (list x)
+               list->string: quote is not needed here: '()")
+  (lint-test "(list->string (list x y z))" " list->string: perhaps (list->string (list x y z)) -> (string x y z)")
+  (lint-test "(list->vector (sort! (vector->list x) y))" " list->vector: perhaps (list->vector (sort! (vector->list x) y)) -> (sort! x y)")
+  (lint-test "(list->string (sort! (string->list x) y))" " list->string: perhaps (list->string (sort! (string->list x) y)) -> (sort! x y)")
+  (lint-test "(string->list x y y)" " string->list: these string->list indices make no sense: (string->list x y y)")
+  (lint-test "(symbol->keyword (string->symbol x))" " symbol->keyword: perhaps (symbol->keyword (string->symbol x)) -> (string->keyword x)")
+  (lint-test "(vector->list (vector a b c))" " vector->list: perhaps (vector->list (vector a b c)) -> (list a b c)")
+  (lint-test "(vector->list (vector-copy v start end))" " vector->list: perhaps (vector->list (vector-copy v start end)) -> (vector->list v start end)")
+  (lint-test "(string->list (string a b c))"  " string->list: perhaps (string->list (string a b c)) -> (list a b c)")
+  (lint-test "(list->string (list a b c))" " list->string: perhaps (list->string (list a b c)) -> (string a b c)")
+  (lint-test "(list->string (make-list a b))" " list->string: perhaps (list->string (make-list a b)) -> (make-string a b)")
+
+  (lint-test "(string->symbol (string-append x y z))" " string->symbol: perhaps (string->symbol (string-append x y z)) -> (symbol x y z)")
+  (lint-test "(symbol (string-append x y z))" " symbol: perhaps (symbol (string-append x y z)) -> (symbol x y z)")
+  (lint-test "(symbol (string-append x y z) a)" "")
+  (lint-test "(string->symbol \"a\")" " string->symbol: perhaps (string->symbol \"a\") -> 'a")
+  (lint-test "(symbol \"a\")" " symbol: perhaps (symbol \"a\") -> 'a")
+  (lint-test "(symbol \"a\" \"b\")" " symbol: perhaps (symbol \"a\" \"b\") -> 'ab")
+  (lint-test "(symbol \"a b\")" "")
+  (lint-test "(string->symbol (apply string-append x))" " string->symbol: perhaps (string->symbol (apply string-append x)) -> (apply symbol x)")
+  (lint-test "(symbol (apply string-append x))" " symbol: perhaps (symbol (apply string-append x)) -> (apply symbol x)")
+  (lint-test "(string->symbol (if (null? x) \"abc\" x))"
+	     " string->symbol: perhaps (string->symbol (if (null? x) \"abc\" x)) -> (if (null? x) 'abc (string->symbol x))")
+  (lint-test "(string->symbol (if (not (null? x)) x \"abc\"))"
+	     " string->symbol: perhaps (string->symbol (if (not (null? x)) x \"abc\")) -> (if (not (null? x)) (string->symbol x) 'abc)")
+  (lint-test "(string->symbol (if (null? x) \"abc\" \"x\"))"
+	     " string->symbol: perhaps (string->symbol (if (null? x) \"abc\" \"x\")) -> (if (null? x) 'abc 'x)")
+
+  (lint-test "(equal? x (list 1 2))"                              " equal?: perhaps (list 1 2) -> '(1 2)")
+  (lint-test "(equal? x (list (list 1 2) (list 3 4)))"            " equal?: perhaps (list (list 1 2) (list 3 4)) -> '((1 2) (3 4))")
+  (lint-test "(equal? x (vector (list 1 2) (list 3 4)))"          " equal?: perhaps (vector (list 1 2) (list 3 4)) -> #((1 2) (3 4))")
+  (lint-test "(equal? x (list (vector 1 2) (list 3 (list 4 5))))" " equal?: perhaps (list (vector 1 2) (list 3 (list 4 5))) -> '(#(1 2) (3 (4 5)))")
+
+  (lint-test "(car (reverse x))"    " car: perhaps use 'last from srfi-1, or (car (reverse x)) -> (list-ref x (- (length x) 1))")
+  (lint-test "(caddr (reverse! x))" " caddr: perhaps (caddr (reverse! x)) -> (list-ref x (- (length x) 3))")
+
+  (lint-test "(append 3)"		" append: perhaps (append 3) -> 3")
+  (lint-test "(append)"			" append: perhaps (append) -> ()")
+  (lint-test "(append (append))"	" append: perhaps (append (append)) -> ()")
+  (lint-test "(append '(1) (append '(2)))"
+	     " append: append does not copy its last argument, so (append '(1) (append '(2))) is dangerous
+               append: perhaps (append '(1) (append '(2))) -> (list 1 2)")
+  (lint-test "(append x (append))"	" append: perhaps clearer: (append x (append)) -> (copy x)")
+  (lint-test "(append '(1 2) (list))"   " append: perhaps clearer: (append '(1 2) (list)) -> (copy '(1 2)) append: perhaps (list) -> (); there is only one nil")
+  (lint-test "(append x '())"		" append: perhaps clearer: (append x '()) -> (copy x)  append: quote is not needed here: '()")
+  (lint-test "(append '(1) (append 2))" " append: perhaps (append '(1) (append 2)) -> (cons 1 2)")
+  (lint-test "(append '(1) (append '(2) '(3)) '(4))"
+	     " append: append does not copy its last argument, so (append '(1) (append '(2) '(3)) '(4)) is dangerous
+               append: perhaps (append '(1) (append '(2) '(3)) '(4)) -> (list 1 2 3 4)")
+  (lint-test "(append (list x y) (list z))" " append: perhaps (append (list x y) (list z)) -> (list x y z)")
+  (lint-test "(append '(1 2) (list 3))" " append: perhaps (append '(1 2) (list 3)) -> (list 1 2 3)")
+  (lint-test "(append '(1) '(2 3))"
+	     " append: append does not copy its last argument, so (append '(1) '(2 3)) is dangerous
+               append: perhaps (append '(1) '(2 3)) -> (list 1 2 3)")
+  (lint-test "(append '(x) '((+ 1 2) #(a)))"
+	     " append: append does not copy its last argument, so (append '(x) '((+ 1 2) #(a))) is dangerous
+               append: perhaps (append '(x) '((+ 1 2) #(a))) -> (list 'x '(+ 1 2) #(a))")
+             ;; (equal? (list 'x '(+ 1 2) #(a)) (append '(x) '((+ 1 2) #(a)))) -> #t
+  (lint-test "(append (list x) (list y z) (list 1))" " append: perhaps (append (list x) (list y z) (list 1)) -> (list x y z 1)")
+  (lint-test "(append (list x y) '(z))"
+	     " append: append does not copy its last argument, so (append (list x y) '(z)) is dangerous
+               append: perhaps (append (list x y) '(z)) -> (list x y 'z)")
+  (lint-test "(append (list x) y)"      " append: perhaps (append (list x) y) -> (cons x y)")
+  (lint-test "(append (list x) (list y z))" " append: perhaps (append (list x) (list y z)) -> (list x y z)")
+  (lint-test "(append () '(1 2) 1)"	" append: perhaps (append () '(1 2) 1) -> (append '(1 2) 1)")
+  (lint-test "(append '() (append) (list 1) (list) () (list 2) ())"
+	     " append: perhaps (append '() (append) (list 1) (list) () (list 2) ()) -> (list 1 2)
+               append: quote is not needed here: '()
+               append: perhaps (list) -> (); there is only one nil")
+  (lint-test "(append x y (append))"    " append: perhaps (append x y (append)) -> (append x y ())")
+  (lint-test "(append x y ())"          "")
+  (lint-test "(append (list x) y (list z))" " append: perhaps (append (list x) y (list z)) -> (cons x (append y (list z)))")
+  (lint-test "(append x (list y) z)"    " append: perhaps (append x (list y) z) -> (append x (cons y z))")
+  (lint-test "(append '(x) y)"          " append: perhaps (append '(x) y) -> (cons 'x y)")
+  (lint-test "(append '(0) y)"          " append: perhaps (append '(0) y) -> (cons 0 y)")
+  (lint-test "(begin (set! x (append x y)) (set! x (append x z w)))"
+	     " begin: perhaps (set! x (append x y)) (set! x (append x z w)) -> (set! x (append x y z w))")
+  (lint-test "(append x (copy y) z)" " append: perhaps (append x (copy y) z) -> (append x y z)")
+  (lint-test "(append x (copy y))" "")
+  (lint-test "(append (cons x y) z)" " append: perhaps (append (cons x y) z) -> (cons x (append y z))")
+  (lint-test "(append (list x y) (list z))" " append: perhaps (append (list x y) (list z)) -> (list x y z)")
+  (lint-test "(append (list x y) (cons z ()))"
+	     " append: perhaps (append (list x y) (cons z ())) -> (list x y z)
+               append: perhaps (cons z ()) -> (list z)")
+  (lint-test "(append (list w) (list x y) (list z))" " append: perhaps (append (list w) (list x y) (list z)) -> (list w x y z)")
+  (lint-test "(append (list w) (list x y) (cons z ()))"
+	     " append: perhaps (append (list w) (list x y) (cons z ())) -> (list w x y z)
+               append: perhaps (cons z ()) -> (list z)")
+  (lint-test "(append (cons x ()) (list y w z))"
+	     " append: perhaps (append (cons x ()) (list y w z)) -> (list x y w z)
+               append: perhaps (cons x ()) -> (list x)")
+  (lint-test "(append (cons a ()) c)"
+	     " append: perhaps (append (cons a ()) c) -> (cons a c)
+               append: perhaps (cons a ()) -> (list a)")
+  (lint-test "(append (list a b) (cons c d))" " append: perhaps (append (list a b) (cons c d)) -> (cons a (cons b (cons c d)))")
+  (lint-test "(append (apply append x) y)" " append: perhaps (append (apply append x) y) -> (append (apply values x) y)")
+  (lint-test "(append (cons x y) z w)" " append: perhaps (append (cons x y) z w) -> (cons x (append y z w))")
+  (lint-test "(append (list 'p) (list 'q) (list 'r) (list #f) x)"
+	     " append: perhaps (append (list 'p) (list 'q) (list 'r) (list #f) x) -> (cons 'p (cons 'q (cons 'r (cons #f x))))")
+  (lint-test "(append \"hi\" \"\")" " append: perhaps clearer: (append \"hi\" \"\") -> (copy \"hi\")")
+  (lint-test "(append #(1 2 3) #())" " append: perhaps clearer: (append #(1 2 3) #()) -> (copy #(1 2 3)) append: #(1 2 3) could be #i(1 2 3)")
+  (lint-test "(append #(1 2 3) (vector))" " append: perhaps clearer: (append #(1 2 3) (vector)) -> (copy #(1 2 3)) append: #(1 2 3) could be #i(1 2 3)")
+  (lint-test "(append \"hi\" (string))" " append: perhaps clearer: (append \"hi\" (string)) -> (copy \"hi\") append: (string) could be \"\"")
+  (lint-test "(append x (list))"  " append: perhaps clearer: (append x (list)) -> (copy x) append: perhaps (list) -> (); there is only one nil")
+
+  (lint-test "(cons x (list y z))"      " cons: perhaps (cons x (list y z)) -> (list x y z)")
+  (lint-test "(cons x (list))"          " cons: perhaps (cons x (list)) -> (list x)  cons: perhaps (list) -> (); there is only one nil")
+  (lint-test "(cons 1 ())"              " cons: perhaps (cons 1 ()) -> (list 1)")
+  (lint-test "(cons a (cons b (cons c ())))" " cons: perhaps (cons a (cons b (cons c ()))) -> (list a b c)")
+  (lint-test "(cons a (cons b (list c)))"    " cons: perhaps (cons a (cons b (list c))) -> (list a b c)")
+  (lint-test "(cons a (cons b (list c d)))"  " cons: perhaps (cons a (cons b (list c d))) -> (list a b c d)")
+  (lint-test "(cons a (cons b c))" "")
+  (lint-test "(cons a (cons b (cons c '())))" " cons: perhaps (cons a (cons b (cons c '()))) -> (list a b c) cons: quote is not needed here: '()")
+  (lint-test "(cons (car x) (cdr x))"     " cons: possibly (cons (car x) (cdr x)) -> (copy x)")
+  (lint-test "(cons (cadar x) (cddar x))" " cons: possibly (cons (cadar x) (cddar x)) -> (copy (cdar x))")
+  (lint-test "(set! x (cons a (list)))" " set!: perhaps (cons a (list)) -> (list a) set!: perhaps (list) -> (); there is only one nil")
+  (lint-test "(set! x (cons a (list b c)))" " set!: perhaps (cons a (list b c)) -> (list a b c)")
+  (lint-test "(set! x (cons a (cons b (list c d))))" " set!: perhaps (cons a (cons b (list c d))) -> (list a b c d)")
+  (lint-test "(set! x (cons a (cons b ())))" " set!: perhaps (cons a (cons b ())) -> (list a b)")
+  (lint-test "(cons 'x (or y (list 'z)))" "") ; quote for list here is incorrect
+
+  (lint-test "`(,@x ,@(map (lambda (z) `(,z ,@z)) y))"
+	     " list-values: perhaps (list-values (apply-values x) (apply-values (map (lambda (z) (list-values... -> (append x (map (lambda (z) (cons z z)) y))
+               list-values: perhaps (list-values z (apply-values z)) -> (cons z z)")
+  (lint-test "`(,@x ,@(map (lambda (z) `(,@z ,@z)) y))"
+	     " list-values: perhaps (list-values (apply-values x) (apply-values (map (lambda (z) (list-values... -> (append x (map (lambda (z) (append z z)) y))
+               list-values: perhaps (list-values (apply-values z) (apply-values z)) -> (append z z)")
+  (lint-test "`(,@x ,@(map (lambda (z) `(,@z ,@z ,@x)) y))"
+	     " list-values: perhaps (list-values (apply-values z) (apply-values z) (apply-values x)) -> (append z z x)")
+  (lint-test "(append `(,x) z)" " append: perhaps (append (list x) z) -> (cons x z) append: perhaps (list-values x) -> (list x)")
+  (lint-test "(values `(x ,@y))"
+	     " values: perhaps (values (list-values 'x (apply-values y))) -> (cons 'x y)
+               values: perhaps (list-values 'x (apply-values y)) -> (cons 'x y)")
+  (lint-test "(values `(x ,y) a)"
+	     " values: perhaps (values (list-values 'x y) a) -> (values (list 'x y) a)
+               values: perhaps (list-values 'x y) -> (list 'x y)")
+  (lint-test "(values `(,x ,@y) z)"
+	     " values: perhaps (values (list-values x (apply-values y)) z) -> (values (cons x y) z)
+               values: perhaps (list-values x (apply-values y)) -> (cons x y)")
+  (lint-test "(values `(,@x ,@y) `(,x z))"
+             " values: perhaps (values (list-values (apply-values x) (apply-values y)) (list-values x 'z)) -> (values (append x y) (list x 'z))
+               values: perhaps (list-values (apply-values x) (apply-values y)) -> (append x y)
+               values: perhaps (list-values x 'z) -> (list x 'z)")
+  (lint-test "(values (values 1))" "values: perhaps (values (values 1)) -> (values 1) values: perhaps (values 1) -> 1")
+  (lint-test "(define (g x) `(+ ,y ,@(map f x)))" " g: perhaps (list-values '+ y (apply-values (map f x))) -> (cons '+ (cons y (map f x)))")
+  (lint-test "(define (g x) `(+ ,@(map f x)))" " g: perhaps (list-values '+ (apply-values (map f x))) -> (cons '+ (map f x))")
+  (lint-test "(define (g x) `(,e ,@(map f x)))" " g: perhaps (list-values e (apply-values (map f x))) -> (cons e (map f x))")
+  (lint-test "(define (g x) `(f ,@x ,@y))" " g: perhaps (list-values 'f (apply-values x) (apply-values y)) -> (cons 'f (append x y))")
+  (lint-test "(define (g x) `(display ,(map f x)))" " g: perhaps (list-values 'display (map f x)) -> (list 'display (map f x))")
+  (lint-test "(define-macro (g x) `(f ,x))" " define-macro: perhaps (define-macro (g x) (list-values 'f x)) -> (define g f)
+              g: perhaps (list-values 'f x) -> (list 'f x)")
+  (lint-test "(define-macro (g x) `(,@x ,y))" " g: perhaps (list-values (apply-values x) y) -> (append x (list y))")
+  (lint-test "(define-macro (g x) `(,@x z))" " g: perhaps (list-values (apply-values x) 'z) -> (append x (list 'z))")
+  (lint-test "(define-macro (g x) `(,@x ,(f y)))" " g: perhaps (list-values (apply-values x) (f y)) -> (append x (list (f y)))")
+  (lint-test "(define-macro (g x) `(+ ,y ,@(map f x)))" " g: perhaps (list-values '+ y (apply-values (map f x))) -> (cons '+ (cons y (map f x)))")
+  (lint-test "(define-macro (g x) `(,@x ,y ,@z))" " g: perhaps (list-values (apply-values x) y (apply-values z)) -> (append x (cons y z))")
+  (lint-test "(define-macro (g x) `(,@x ,@y ,z))" " g: perhaps (list-values (apply-values x) (apply-values y) z) -> (append x y (list z))")
+  (lint-test "(define f `((cond . ,forced-indent) (case . ,print-case) (let . ,let-expr)))" "")
+  (lint-test "(define f `((cond . ,forced-indent) (let . ,let-expr)))"
+	     " f: perhaps (list-values (<list*> (list-values 'cond) forced-indent) (<list*>... ->
+                  (list (<list*> (list 'cond) forced-indent) (<list*> (list 'let) let-expr))")
+
+  (lint-test "(set! x `(f . (,g . 100)))" " set!: perhaps (list-values 'f g) -> (list 'f g)")
+  (lint-test "(set! x `(f . (g . 100)))"  " set!: perhaps (list-values 'f 'g) -> (list 'f 'g)")
+  (lint-test "(set! x `(f . g))"  " set!: perhaps (list-values 'f) -> (list 'f)")
+  (lint-test "(set! x `((f . (,g . 100)) (f1 . (,g1 . 1001))))"
+	     " set!: perhaps (list-values (<list*> (list-values 'f g) 100) (<list*> (list-values 'f1... -> (list (<list*> (list 'f g) 100) (<list*> (list 'f1 g1) 1001))")
+  (lint-test "(set! x `((f . (g . 100)) (f1 . (g1 . 1001))))"
+	     " set!: perhaps (list-values (<list*> (list-values 'f 'g) 100) (<list*> (list-values 'f1... -> (list (<list*> (list 'f 'g) 100) (<list*> (list 'f1 'g1) 1001))")
+  (lint-test "(sort! x abs)"		" sort!: abs is a questionable sort! function")
+  (lint-test "(sort! x (lambda (a b) (< a b)))" " sort!: perhaps (lambda (a b) (< a b)) -> <")
+  (lint-test "(sort! x (lambda (a b) (< b a)))" " sort!: perhaps (lambda (a b) (< b a)) -> >")
+  (lint-test "(abs 1 2)"		" abs: abs has too many arguments: (abs 1 2)")
+  (lint-test "(-)"			" -: - needs at least 1 argument: (-)")
+  (lint-test "(modulo 3)"		" modulo: modulo needs 2 arguments: (modulo 3)")
+
+  (lint-test "(let () (define* (f1 a b) (+ a b)) (f1 :c 1))"
+	     " let: perhaps (... (define* (f1 a b) (+ a b)) (f1 :c 1)) -> (... (let ((a :c) (b 1)) (+ a b)))
+               let: f1 keyword argument :c (in (f1 :c 1)) does not match any argument in (a b)")
+  (lint-test "(let () (define (f2 a b) (+ a b)) (f2 1 2 3))"
+	     " let: perhaps (... (define (f2 a b) (+ a b)) (f2 1 2 3)) -> (... (let ((a 1) (b 2)) (+ a b)))
+               f2: leaving aside +'s optional args, f2 could be (define f2 +)
+               let: f2 has too many arguments: (f2 1 2 3)")
+  (lint-test "(let () (define* (f3 a . b) (+ a b)) (f3 1 2 3))" "")
+  (lint-test "(let () (define* (f4 (a #f)) a) (f4))"
+	      " let: perhaps (... (define* (f4 (a #f)) a) (f4)) -> (... (let ((a #f)) a))
+                f4: the default argument value is #f in define*, so (a #f) can be a")
+  (lint-test "(let () (define (f1 a) a) 32)" " let: f1 not used, value: (define (f1 a) a)")
+
+  (lint-test "(letrec ((f1 (lambda (a) a))) 32)"
+	     " letrec: letrec could be let: (letrec ((f1 (lambda (a) a))) 32)
+               letrec: f1 not used, initially: (lambda (a) a) from letrec")
+  (lint-test "(letrec ((x 32) (f1 (let ((y 1)) (lambda (z) (+ x y z)))) (f2 (f1 x))) (+ x f2))"
+	     " letrec: in (letrec ((x 32) (f1 (let ((y 1)) (lambda (z) (+ x y z)))) (f2 (f1 x))) (+...,
+                 letrec should be letrec* because x is used in f2's value (not a function): (f1 x)")
+  (lint-test "(letrec* ((f1 (lambda (x) (+ x (f2 x)))) (f2 (lambda (x) (+ x (f1 x))))) (+ (f1 2) (f2 1)))"
+	     " letrec*: letrec* could be letrec: (letrec* ((f1 (lambda (x) (+ x (f2 x)))) (f2 (lambda (x) (+ x (f1 x)))))...")
+  ;; test shadowing checks
+  (lint-test "(letrec ((f1 (lambda (x) (* x (f1 2))))) (lambda (y) (+ y (f1 y))))"
+	     " letrec: perhaps (letrec ((f1 (lambda (x) (* x (f1 2))))) (lambda (y) (+ y (f1 y)))) -> (lambda (y) (+ y (let f1 ((x y)) (* x (f1 2)))))")
+  (lint-test "(letrec ((f1 (lambda (x) (* x z (f1 2))))) (lambda (y) (let ((z 3)) (+ y (f1 y)))))"
+	     " letrec: z can be moved to the enclosing function's closure")
+  (lint-test "(letrec ((f1 (lambda (x) (* x z (f1 2))))) (lambda (y) (let* ((z 3)) (+ y (f1 y)))))"
+	     " letrec: let* could be let: (let* ((z 3)) (+ y (f1 y)))")
+  (lint-test "(letrec ((f1 (lambda (x) (* x z (f1 2))))) (lambda (y) (letrec ((z 3)) (+ y (f1 y)))))"
+	     " letrec: letrec could be let: (letrec ((z 3)) (+ y (f1 y)))")
+  (lint-test "(letrec ((f1 (lambda (x) (* x z (f1 2))))) (lambda (y) (do ((z 3)) () (+ y (f1 y)))))" "")
+  (lint-test "(letrec ((f1 (lambda (x) (* x z (f1 2))))) (lambda (y) (lambda (z) (+ y (f1 y)))))" "")
+  (lint-test "(letrec ((f1 (lambda (x z) (* x z (f1 2))))) (lambda (y) (let ((z (g 3))) (+ z (f1 y)))))"
+	     " letrec: perhaps (letrec ((f1 (lambda (x z) (* x z (f1 2))))) (lambda (y) (let ((z (g 3)))... ->
+                 (lambda (y) (let ((z (g 3))) (+ z (let f1 ((x y)) (* x z (f1 2))))))")
+
+  (lint-test "(let () (define x 3) 32)"
+	     " let: x not used, initially: 3 from define
+               let: perhaps (let () (define x 3) 32) -> (let ((x 3)) ...)")
+  (lint-test "(let ((z 1)) (define x 12) (define (y a) a) 32)"
+	     " let: perhaps (... (define x 12) (define (y a) a) 32) -> (... (let ((x 12)) ...))
+               let: y not used, value: (define (y a) a)
+               let: x not used, initially: 12 from define
+               let: z not used, initially: 1 from let
+               let: perhaps (let ((z 1)) (define x 12) (define (y a) a) 32) -> (let ((z 1) (x 12)) ...)")
+  (lint-test "(let ((z 1)) (define x 12) (define (y a) a) (+ z 32))"
+	     " let: perhaps (... (define x 12) (define (y a) a) (+ z 32)) -> (... (let ((x 12)) ...))
+               let: y not used, value: (define (y a) a)
+               let: x not used, initially: 12 from define
+               let: perhaps (let ((z 1)) (define x 12) (define (y a) a) (+ z 32)) -> (let ((z 1) (x 12)) ...)")
+  (lint-test "(let* ((a 1) (b 2) (c (+ a 1))) (* c 2))"
+	     " let*: b not used, initially: 2 from let*
+               let*: perhaps restrict a which is not used in the let* body (let* ((a 1) (b 2) (c (+ a 1))) (* c 2)) -> (let* ((b 2) (c (let ((a 1)) (+ a 1)))) ...)
+               let*: perhaps split this let*: (let* ((a 1) (b 2) (c (+ a 1))) (* c 2)) -> (let ((a 1) (b 2)) (let ((c (+ a 1))) ...))
+               let*: perhaps (let* ((a 1) (b 2) (c (+ a 1))) (* c 2)) -> (let* ((a 1) (b 2)) (* (+ a 1) 2))")
+  (lint-test "(let () (define (f4 a . b) (+ a b)) (f4))" " let: f4 needs 1 argument: (f4)")
+  (lint-test "(let ((a)) #f)" " let: let variable value is missing? (a)")
+  (lint-test "(let ((a . 1)) #f)"	" let: let binding is an improper list? (a . 1)")
+  (lint-test "(let ((a 1) . b) a)"      " let: let is messed up: (let ((a 1) . b) a)")
+  (lint-test "(let ((1 2)) #f)"		" let: let variable is not a symbol? (1 2)")
+  (lint-test "(let ((pi 2)) #f)"	" let: can't bind a constant: (pi 2)")
+  (lint-test "(let ((:a 1)) :a)"        " let: let variable is a keyword? (:a 1) let: perhaps (let ((:a 1)) :a) -> 1")
+  (lint-test "(let ((a 2) (a 3)) a)"	" let: let variable a is declared twice let: a not used, initially: 2 from let")
+  (lint-test "(let (a) a)"		" let: let is messed up: (let (a) a)")
+  (lint-test "(let ((a 1) (set! a 2)))" " let: let is messed up:  (let ((a 1) (set! a 2)))")
+  (lint-test "(let ((a 1)) (set! a 2))"
+	     " let: a set, but not used: (set! a 2)
+               let: perhaps (let ((a 1)) (set! a 2)) -> 2
+               let: set! is pointless in (set! a 2): use 2")
+  (lint-test "(let ((a 1) (b (display 2))) (set! a 2))"
+	     " let: b not used, initially: (display 2) from let
+               let: a set, but not used: (set! a 2)
+               let: perhaps (let ((a 1) (b (display 2))) (set! a 2)) -> (let ((b (display 2))) 2)
+               let: set! is pointless in (set! a 2): use 2")
+  (lint-test "(let ((a 1)) #f)"		" let: a not used, initially: 1 from let")
+  (lint-test "(let :x ((i y)) (x i))"	" let: bad let name: :x")
+  (lint-test "(let xx () z)"
+	     " let: perhaps (let xx () z) -> z
+               let: xx not used, value: (let xx () z)")
+  (lint-test "(let ((x (log y))) x)"    " let: perhaps (let ((x (log y))) x) -> (log y)")
+  (lint-test "(let* ((x (log y))) x)"   " let*: let* could be let: (let* ((x (log y))) x) let*: perhaps (let* ((x (log y))) x) -> (log y)")
+  (lint-test "(let* ((y 3) (x (log y))) x)"
+	     " let*: perhaps restrict y which is not used in the let* body (let* ((y 3) (x (log y))) x) -> (let ((x (let ((y 3)) (log y)))) ...)
+	       let*: perhaps substitute y into x: (let* ((y 3) (x (log y))) x) -> (let ((x (log 3))) ...)
+               let*: perhaps (let* ((y 3) (x (log y))) x) -> (let ((y 3)) (log y))")
+  (lint-test "(let ((y 3) (x (log z))) x)" " let: y not used, initially: 3 from let")
+  (lint-test "(let* ((z 3) (y z) (x (log y))) x)"
+	     " let*: perhaps restrict z, y which are not used in the let* body (let* ((z 3) (y z) (x (log y))) x) -> (let ((x (let ((y (let ((z 3)) z))) (log y)))) ...)
+               let*: perhaps substitute y into x: (let* ((z 3) (y z) (x (log y))) x) -> (let* ((z 3) (x (log z))) ...)
+               let*: perhaps (let* ((z 3) (y z) (x (log y))) x) -> (let* ((z 3) (y z)) (log y))")
+  (lint-test "(let* ((x 1) (x (+ x 1))) x)"
+	     " let*: let* variable x is declared twice
+               let*: perhaps (let* ((x 1) (x (+ x 1))) x) -> (let ((x 1)) (+ x 1))")
+  (lint-test "(let* ((x 1) (x (+ y 1))) x)"
+	     " let*: let* could be let: (let* ((x 1) (x (+ y 1))) x)
+               let*: let* variable x is declared twice
+               let*: x not used, initially: 1 from let*
+               let*: perhaps (let* ((x 1) (x (+ y 1))) x) -> (let ((x 1)) (+ y 1))")
+  (lint-test "(let* ((a 1) (b (+ a 2))) (let* ((c (+ b 3)) (d (+ c 4))) (+ a b c d)))"
+	     " let*: perhaps (let* ((c (+ b 3)) (d (+ c 4))) (+ a b c d)) -> (let ((c (+ b 3))) (+ a b c (+ c 4)))
+               let*: perhaps (let* ((a 1) (b (+ a 2))) (let* ((c (+ b 3)) (d (+ c 4))) (+ a b c d))) ->
+                 (let* ((a 1) (b (+ a 2)) (c (+ b 3)) (d (+ c 4))) (+ a b c d))")
+  (lint-test "(let* ((a 1) (b (+ a 2))) (let* ((c (+ b 3)) (d (+ c 4))) (display a) (+ a b c d)))"
+	     " let*: perhaps (let* ((a 1) (b (+ a 2))) (let* ((c (+ b 3)) (d (+ c 4))) (display a) (+ a... ->
+                 (let* ((a 1) (b (+ a 2)) (c (+ b 3)) (d (+ c 4))) (display a) ...)")
+  (lint-test "(let* ((a 1) (b (+ a 1))) b)"
+	     " let*: perhaps restrict a which is not used in the let* body (let* ((a 1) (b (+ a 1))) b) -> (let ((b (let ((a 1)) (+ a 1)))) ...)
+	       let*: perhaps substitute a into b: (let* ((a 1) (b (+ a 1))) b) -> (let ((b (+ 1 1))) ...)
+               let*: perhaps (let* ((a 1) (b (+ a 1))) b) -> (let ((a 1)) (+ a 1))")
+  (lint-test "(let* ((a 1) (b (+ a 1))) (+ a b))" " let*: perhaps (let* ((a 1) (b (+ a 1))) (+ a b)) -> (let ((a 1)) (+ a (+ a 1)))")
+  (lint-test "(let ((x (assoc y z))) (if x (cdr x)))"
+	     " let: perhaps (let ((x (assoc y z))) (if x (cdr x))) -> (cond ((assoc y z) => cdr))")
+  (lint-test "(let ((x (assoc y z))) (if x (cdr x) 32))"
+	     " let: perhaps (let ((x (assoc y z))) (if x (cdr x) 32)) -> (cond ((assoc y z) => cdr) (else 32))")
+  (lint-test "(let ((x (f y))) (and x (g x)))" " let: perhaps (let ((x (f y))) (and x (g x))) -> (cond ((f y) => g) (else #f))")
+  (lint-test "(let ((x (f y))) (and x (g x)))" " let: perhaps (let ((x (f y))) (and x (g x))) -> (cond ((f y) => g) (else #f))")
+  (lint-test "(let ((x (f y))) (or (not x) (g x)))" " let: perhaps (let ((x (f y))) (or (not x) (g x))) -> (cond ((f y) => g) (else #t))")
+  (lint-test "(let* ((x (f y))) (and x (g x)))"
+	     " let*: let* could be let: (let* ((x (f y))) (and x (g x)))
+               let*: perhaps (let* ((x (f y))) (and x (g x))) -> (cond ((f y) => g) (else #f))")
+  (lint-test "(let* ((x (f y))) (or (not x) (g x)))"
+	     " let*: let* could be let: (let* ((x (f y))) (or (not x) (g x)))
+               let*: perhaps (let* ((x (f y))) (or (not x) (g x))) -> (cond ((f y) => g) (else #t))")
+  (lint-test "(let* ((x (log 2)) (y (+ x 1))) (display y))"
+	     " let*: perhaps restrict x which is not used in the let* body
+                  (let* ((x (log 2)) (y (+ x 1))) (display y)) -> (let ((y (let ((x (log 2))) (+ x 1)))) ...)
+                let*: perhaps substitute x into y: (let* ((x (log 2)) (y (+ x 1))) (display y)) -> (let ((y (+ (log 2) 1))) ...)
+                let*: perhaps (let* ((x (log 2)) (y (+ x 1))) (display y)) -> (let ((x (log 2))) (display (+ x 1)))")
+  (lint-test "(let* ((z 1) (w (read p)) (v (read p)) (y (+ z w)) (x (< y 3))) (if x (f x)))"
+	     " let*: v not used, initially: (read p) from let*
+               let*: perhaps restrict z, y which are not used in the let* body
+                  (let* ((z 1) (w (read p)) (v (read p)) (y (+ z w)) (x (< y 3))) (if x (f x))) ->
+                  (let* ((w (read p)) (v (read p)) (x (let ((y (let ((z 1)) (+ z w)))) (< y 3)))) ...)
+               let*: perhaps substitute y into x:
+                  (let* ((z 1) (w (read p)) (v (read p)) (y (+ z w)) (x (< y 3))) (if x (f x))) ->
+                  (let* ((z 1) (w (read p)) (v (read p)) (x (< (+ z w) 3))) ...)
+               let*: perhaps (let* ((z 1) (w (read p)) (v (read p)) (y (+ z w)) (x (< y 3))) (if x (f x))) ->
+                  (let* ((z 1) (w (read p)) (v (read p)) (y (+ z w))) (cond ((< y 3) => f)))")
+  (lint-test "(let* ((z 1) (w (read p)) (y (+ z w)) (x (< y 3))) (if x (f x)))"
+	     " let*: perhaps restrict z, w, y which are not used in the let* body
+                 (let* ((z 1) (w (read p)) (y (+ z w)) (x (< y 3))) (if x (f x))) ->
+                 (let ((x (let ((y (let* ((w (read p)) (z 1)) (+ z w)))) (< y 3)))) ...)
+               let*: perhaps substitute w into y:
+                 (let* ((z 1) (w (read p)) (y (+ z w)) (x (< y 3))) (if x (f x))) ->
+                 (let* ((z 1) (y (+ z (read p))) (x (< y 3))) ...)
+               let*: perhaps (let* ((z 1) (w (read p)) (y (+ z w)) (x (< y 3))) (if x (f x))) ->
+                  (let* ((z 1) (w (read p)) (y (+ z w))) (cond ((< y 3) => f)))")
+  (lint-test "(let* ((a (car x)) (b (+ a 1))) (do ((i 0 (+ i 1))) ((= i b)) (display i)))"
+	     " let*: perhaps restrict a which is not used in the let* body
+                 (let* ((a (car x)) (b (+ a 1))) (do ((i 0 (+ i 1))) ((= i b)) (display i))) -> (let ((b (let ((a (car x))) (+ a 1)))) ...)
+               let*: perhaps (let* ((a (car x)) (b (+ a 1))) (do ((i 0 (+ i 1))) ((= i b)) (display i))) -> (let ((a (car x))) (do ((b (+ a 1)) (i 0 (+ i 1))) ...))
+               let*: perhaps substitute a into b: (let* ((a (car x)) (b (+ a 1))) (do ((i 0 (+ i 1))) ((= i b)) (display i))) -> (let ((b (+ (car x) 1))) ...)")
+  (lint-test "(let ((x (f y))) (if x (g x) x))"
+	     " let: perhaps (let ((x (f y))) (if x (g x) x)) -> (cond ((f y) => g) (else #f))
+               let: perhaps (if x (g x) x) -> (and x (g x))")
+  (lint-test "(let ((x (assoc y z))) (if (pair? x) (g x) x))"
+	     " let: perhaps (let ((x (assoc y z))) (if (pair? x) (g x) x)) -> (cond ((assoc y z) => g) (else #f))")
+  (lint-test "(let ((x (assoc y z))) (if (null? x) (g x)))"
+	     " let: in (if (null? x) (g x)), x can't be null because assoc in (x (assoc y z)) only returns #f or a pair")
+  (lint-test "(let ((x (g y))) (if x x (g z)))"
+	     " let: perhaps (let ((x (g y))) (if x x (g z))) -> (or (g y) (g z))
+               let: perhaps (if x x (g z)) -> (or x (g z))")
+  (lint-test "(let ((x (g y))) (if x #t #f))" " let: perhaps (let ((x (g y))) (if x #t #f)) -> (g y) let: perhaps (if x #t #f) -> x")
+  (lint-test "(let ((x (g y))) (if x (car (cddr x)) z))"
+	     " let: perhaps (let ((x (g y))) (if x (car (cddr x)) z)) -> (cond ((g y) => caddr) (else z))
+               let: perhaps (car (cddr x)) -> (caddr x)")
+  (lint-test "(let ((x (f y))) (if (not x) y (g x)))"
+	     " let: perhaps (let ((x (f y))) (if (not x) y (g x))) -> (cond ((f y) => g) (else y))
+               let: perhaps use case: (let ((x (f y))) (if (not x) y (g x))) -> (case (f y) ((#f) y) (else => g))")
+  (lint-test "(let ((x (f y))) (cond (x (g x))))"
+             " let: perhaps (let ((x (f y))) (cond (x (g x)))) -> (cond ((f y) => g))
+               let: perhaps use => here: (x (g x)) -> (x => g)")
+  (lint-test "(let ((x (f y))) (cond (x (g x)) (else y)))"
+	     " let: perhaps (let ((x (f y))) (cond (x (g x)) (else y))) -> (cond ((f y) => g) (else y))
+               let: perhaps use => here: (x (g x)) -> (x => g)")
+  (lint-test "(let ((x (f y))) (cond (x x) (else y)))"
+	     " let: perhaps (let ((x (f y))) (cond (x x) (else y))) -> (or (f y) y)
+               let: no need to repeat the test: (x x) -> (x)")
+  (lint-test "(let ((x (f y))) (cond (x x) (else (g y) y)))"
+	     " let: perhaps (let ((x (f y))) (cond (x x) (else (g y) y))) -> (or (f y) (begin (g y) y))
+               let: no need to repeat the test: (x x) -> (x)")
+  (lint-test "(let ((x (f y))) (cond (x (g x)) (y z) (else y)))"
+	     " let: perhaps (let ((x (f y))) (cond (x (g x)) (y z) (else y))) -> (cond ((f y) => g) (y z) (else y))
+               let: perhaps use => here: (x (g x)) -> (x => g)")
+  (lint-test "(let ((x (f y))) (cond (x (set-cdr! x y)) (else y)))"
+	     " in (cond (x (set-cdr! x y)) (else y)), perhaps change x to (pair? x)")
+  (lint-test "(let () (let ((a x)) (+ a 1)))"
+	     " let: pointless let: (let () (let ((a x)) (+ a 1)))
+               let: perhaps (let () (let ((a x)) (+ a 1))) -> (let ((a x)) (+ a 1))
+               let: perhaps (let ((a x)) (+ a 1)) -> (+ x 1)")
+  (lint-test "(let ((a x)) (let () (+ a 1)))"
+	     " let: pointless let: (let ((a x)) (let () (+ a 1))) -> (let ((a x)) (+ a 1))
+               let: perhaps (let ((a x)) (let () (+ a 1))) -> (let () (+ x 1))
+               let: pointless let: (let () (+ a 1))
+               let: perhaps (let () (+ a 1)) -> (+ a 1)")
+  (lint-test "(let ((x 32)) (define x 33) x)"
+	     " let: perhaps omit x and return 33
+               let: let variable x is redefined in the let body.  Perhaps use set! instead: (set! x 33)
+               let: x not used, initially: 32 from let")
+  (lint-test "(let ((x 32)) (define (x y) (+ y 33)) (x 1))"
+	     " let: perhaps (... (define (x y) (+ y 33)) (x 1)) -> (... (let ((y 1)) (+ y 33)))
+               let: let variable x is declared twice
+               let: x not used, initially: 32 from let")
+  (lint-test "(let ((x (assq 'a y))) (set! z (if x (cadr x) 0)))"
+	     " let: perhaps (let ((x (assq 'a y))) (set! z (if x (cadr x) 0))) -> (set! z (cond ((assq 'a y) => cadr) (else 0)))")
+  (lint-test "(let ((x (assq 'a y))) (g (if x (cadr x) 0) y))"
+	      " let: perhaps (let ((x (assq 'a y))) (g (if x (cadr x) 0) y)) -> (g (cond ((assq 'a y) => cadr) (else 0)) y)")
+  (lint-test "(let ((x (assq 'a y))) (g (if x (cadr x)) y))"
+	     " let: perhaps (let ((x (assq 'a y))) (g (if x (cadr x)) y)) -> (g (cond ((assq 'a y) => cadr)) y)")
+  (lint-test "(let ((x 1) (y 2) (z 3)) (+ x y z))"  " let: perhaps (let ((x 1) (y 2) (z 3)) (+ x y z)) -> (+ 1 2 3)")
+  (lint-test "(let ((x 1)) (set! y x))" " let: perhaps (let ((x 1)) (set! y x)) -> (set! y 1)")
+  (lint-test "(let ((x (f 0)) (y (f 1))) (or x y))"
+	     " let: perhaps, ignoring short-circuit issues, (let ((x (f 0)) (y (f 1))) (or x y)) -> (or (f 0) (f 1))")
+  (lint-test "(let ((x (undo-edit))) (set! y (or y x)))"
+	     " let: perhaps, ignoring short-circuit issues, (let ((x (undo-edit))) (set! y (or y x))) -> (set! y (or y (undo-edit)))
+               let: perhaps (set! y (or y x)) -> (if (not y) (set! y x))")
+  (lint-test "(let ((x #(0 a))) (fill! x 1) (f x (x 1)))"
+	     " let: perhaps (let ((x #(0 a))) (fill! x 1) (f x (x 1))) -> (let ((x #(1 1))) (f x (x 1)))")
+  (lint-test "(let ((x (make-vector 3))) (fill! x 1) (f x (x 1)))"
+	     " let: perhaps (let ((x (make-vector 3))) (fill! x 1) (f x (x 1))) -> (let ((x (make-vector 3 1))) (f x (x 1)))")
+  (lint-test "(let ((x (make-list 3 9))) (fill! x 1) (f x (x 1)))"
+	     " let: perhaps (let ((x (make-list 3 9))) (fill! x 1) (f x (x 1))) -> (let ((x (make-list 3 1))) (f x (x 1)))")
+  (lint-test "(let ((v (make-vector 3))) (vector-fill! v 3))"
+	     " let: perhaps (let ((v (make-vector 3))) (vector-fill! v 3)) -> (vector-fill! (make-vector 3) 3)
+               let: perhaps (let ((v (make-vector 3))) (vector-fill! v 3)) -> (let () 3)")
+
+  (lint-test "(let ((x 1)) (set! x 2) (+ x 1))"
+	     " let: perhaps (let ((x 1)) (set! x 2) (+ x 1)) -> (let ((x 2)) (+ x 1))")
+  (lint-test "(let ((y 3) (x 1)) (set! x 2) (+ x y))"
+	     " let: perhaps (let ((y 3) (x 1)) (set! x 2) (+ x y)) -> (let ((y 3) (x 2)) (+ x y))")
+  (lint-test "(let ((y 3) (x 1)) (set! x 2) (display x) (+ x y))"
+	     " let: perhaps (let ((y 3) (x 1)) (set! x 2) (display x) (+ x y)) -> (let ((y 3) (x 2)) (display x) ...)")
+
+  (lint-test "(let ((x (f y))) (if x (g x) (set! x 3)))" "") ; too complicated to deal with this
+  (lint-test "(let* ((x (f y))) (if x (g x) (set! x 3)))" " let*: let* could be let: (let* ((x (f y))) (if x (g x) (set! x 3)))")
+  (lint-test "(let* ((z 1) (x (< z 2))) (if x (f x)))"
+	     " let*: perhaps restrict z which is not used in the let* body (let* ((z 1) (x (< z 2))) (if x (f x))) -> (let ((x (let ((z 1)) (< z 2)))) ...)
+	       let*: perhaps substitute z into x: (let* ((z 1) (x (< z 2))) (if x (f x))) -> (let ((x (< 1 2))) ...)
+               let*: perhaps (let* ((z 1) (x (< z 2))) (if x (f x))) -> (let ((z 1)) (cond ((< z 2) => f)))")
+  (lint-test "(let* ((z 1) (y (+ z 2)) (x (< y 3))) (if x (f x)))"
+	     " let*: perhaps restrict z, y which are not used in the let* body
+                 (let* ((z 1) (y (+ z 2)) (x (< y 3))) (if x (f x))) -> (let ((x (let ((y (let ((z 1)) (+ z 2)))) (< y 3)))) ...)
+	       let*: perhaps substitute z into y: (let* ((z 1) (y (+ z 2)) (x (< y 3))) (if x (f x))) -> (let* ((y (+ 1 2)) (x (< y 3))) ...)
+               let*: perhaps (let* ((z 1) (y (+ z 2)) (x (< y 3))) (if x (f x))) -> (let* ((z 1) (y (+ z 2))) (cond ((< y 3) => f)))")
+  (lint-test "(let f0 ((i 1)) (if (> i 0) (f0 #() (- i 1))))" " let: f0 has too many arguments: (f0 #() (- i 1))")
+  (lint-test "(letrec ((f0 (lambda (i) (if (> i 0) (f0 #() (- i 1)))))) (f0 1))"
+	     " letrec: perhaps (letrec ((f0 (lambda (i) (if (> i 0) (f0 #() (- i 1)))))) (f0 1)) -> (let f0 ((i 1)) (if (> i 0) (f0 #() (- i 1))))")
+  (lint-test "(letrec ((f0 (lambda () (if (> i 0) (f0))))) (f0))"
+	     " letrec: perhaps (letrec ((f0 (lambda () (if (> i 0) (f0))))) (f0)) -> (let f0 () (if (> i 0) (f0)))")
+  (lint-test "(let ((a 0)) (display x) (set! a 2) (+ a 1))"
+	     " let: perhaps change a's initial value to 2, and remove (set! a 2) in (let ((a 0)) (display x) (set! a 2) (+ a 1))")
+  (lint-test "(let ((x (string->number z))) (if (number? x) (g x)))"
+	     " let: perhaps (let ((x (string->number z))) (if (number? x) (g x))) -> (cond ((string->number z) => g))")
+  (lint-test "(let ((x (memq a z))) (if (list? x) (g x)))"
+	     " let: in (if (list? x) (g x)), x can't be null so pair? might be better
+               let: perhaps (let ((x (memq a z))) (if (list? x) (g x))) -> (cond ((memq a z) => g))")
+
+  (lint-test "(let () (error 'oops \"an error\") #t)"
+	     " let: let could be begin: (let () (error 'oops \"an error\") #t) -> (begin (error 'oops \"an error\") #t)
+               let: (error 'oops \"an error\") makes this pointless: #t")
+  (lint-test "(let () (error 'oops \"an error\") (display \"oops\") #t)"
+	     " let: let could be begin: (let () (error 'oops \"an error\") (display \"oops\") #t) -> (begin (error 'oops \"an error\") (display \"oops\") #t)
+               let: (error 'oops \"an error\") makes the rest of the body unreachable: (... (display \"oops\") ...)")
+  (lint-test "(let ((a 1)) (let ((b 2)) (let ((c 3)) (let ((d 4)) (+ a b c d)))))"
+	     " let: perhaps (let ((d 4)) (+ a b c d)) -> (+ a b c 4)
+               let: perhaps move 'c into the inner let: (let ((c 3)) (let ((d 4)) (+ a b c d))) -> (let ((c 3) (d 4)) (+ a b c d))
+               let: perhaps (let ((c 3)) (let ((d 4)) (+ a b c d))) -> (let ((c 3) (d 4)) (+ a b c d))
+               let: perhaps (let ((b 2)) (let ((c 3)) (let ((d 4)) (+ a b c d)))) -> (let ((b 2) (c 3) (d 4)) (+ a b c d))
+               let: perhaps (let ((a 1)) (let ((b 2)) (let ((c 3)) (let ((d 4)) (+ a b c d))))) -> (let ((a 1) (b 2) (c 3) (d 4)) (+ a b c d))")
+  (lint-test "(let ((a 1)) (let ((b 2)) (let ((c 3) (d 4)) (display a) (+ b c d))))"
+	     " let: perhaps move 'b into the inner let: (let ((b 2)) (let ((c 3) (d 4)) (display a) (+ b c d))) -> (let ((b 2) (c 3) (d 4)) (display a) (+ b c d))
+               let: perhaps (let ((b 2)) (let ((c 3) (d 4)) (display a) (+ b c d))) -> (let ((b 2) (c 3) (d 4)) (display a) ...)
+               let: perhaps (let ((a 1)) (let ((b 2)) (let ((c 3) (d 4)) (display a) (+ b c d)))) -> (let ((a 1) (b 2) (c 3) (d 4)) (display a) ...)")
+  (lint-test "(let ((a 1) (b 2)) (let ((c 3) (d 4)) (display a) (+ b c d)))"
+	     " let: perhaps move 'b into the inner let: (let ((a 1) (b 2)) (let ((c 3) (d 4)) (display a) (+ b c d))) -> (let ((b 2) (c 3) (d 4)) (display a) (+ b c d))
+               let: perhaps move 'a into the inner let: (let ((a 1) (b 2)) (let ((c 3) (d 4)) (display a) (+ b c d))) -> (let ((a 1) (c 3) (d 4)) (display a) (+ b c d))
+               let: perhaps (let ((a 1) (b 2)) (let ((c 3) (d 4)) (display a) (+ b c d))) -> (let ((a 1) (b 2) (c 3) (d 4)) (display a) ...)")
+  (lint-test "(let ((x 1) (y x)) (+ x y))"
+	     " let: x in (y x) does not appear to be defined in the calling environment
+               let: perhaps (let ((x 1) (y x)) (+ x y)) -> (+ 1 x)")
+  (lint-test "(let ((x 3)) (+ x (let ((x 1) (y x)) (+ x y))))"
+	     " let: x in (y x) refers to the caller's x, not the let variable
+               let: perhaps (let ((x 1) (y x)) (+ x y)) -> (+ 1 x)")
+  (lint-test "(let ((x 0)) (define* (f52 (a 2)) (if (zero? a) x (f52 (- a 1)))) (display x) (if (zero? x) (+ 1 (f52 x))))"
+	     " let: perhaps (... (define* (f52 (a 2)) (if (zero? a) x (f52 (- a 1)))) (display x) (if... ->
+                  (... (display x) (if (zero? x) (+ 1 (let* f52 ((a x)) (if (zero? a) x (f52 (- a 1)))))))
+               f52: perhaps (define* (f52 (a 2)) (if (zero? a) x (f52 (- a 1)))) -> (define* (f52 (a 2)) (do ((a a (- a 1))) ((zero? a) x)))
+               let: x is 0, so (zero? x) is #t")
+  (lint-test "(let ((x 0)) (define (f52) (if (zero? a) x (f52))) (f52))"
+	     " let: perhaps (... (define (f52) (if (zero? a) x (f52))) (f52)) -> (... (let f52 () (if (zero? a) x (f52))))
+               x is used only in f52")
+  (lint-test "(let ((x 0)) (define (f52 x) (if (zero? a) x (f52 x))) (f52 x))"
+	     " let: the inner function f52 could be moved to an outer letrec:
+                 (let ((x 0)) (define (f52 x) (if (zero? a) x (f52 x))) (f52 x)) -> (letrec ((f52 (lambda (x) (if (zero? a) x (f52 x))))) (let ((x 0)) ...))
+               let: perhaps (... (define (f52 x) (if (zero? a) x (f52 x))) (f52 x)) -> (... (let f52 ((x x)) (if (zero? a) x (f52 x))))
+               f52: perhaps (define (f52 x) (if (zero? a) x (f52 x))) -> (define (f52 x) (do ((x x)) ((zero? a) x)))")
+  (lint-test "(let ((x 0)) (define* (f52 (a 2)) (if (zero? a) x (f52 (- a 1)))) (if (zero? x) (+ 1 (f52 x))))"
+	     " let: perhaps (... (define* (f52 (a 2)) (if (zero? a) x (f52 (- a 1)))) (if (zero? x) (+... ->
+                 (... (if (zero? x) (+ 1 (let* f52 ((a x)) (if (zero? a) x (f52 (- a 1)))))))
+               f52: perhaps (define* (f52 (a 2)) (if (zero? a) x (f52 (- a 1)))) -> (define* (f52 (a 2)) (do ((a a (- a 1))) ((zero? a) x)))
+               let: x is 0, so (zero? x) is #t")
+  (lint-test "(define (f x) (let ((y 2)) (set! x (+ x y)) (set! y (+ y 1)) (set! x (+ x 1)) (display x)))"
+	     " f: (set! y (+ y 1)) in (let ((y 2)) (set! x (+ x y)) (set! y (+ y 1)) (set! x (+ x 1)) (display x)) could be omitted
+               f: this let could be tightened:
+     (let ((y 2)) (set! x (+ x y)) (set! y (+ y 1)) (set! x (+ x 1)) (display x)) ->
+     (let ((y 2))
+       (set! x (+ x y))
+       (set! y (+ y 1)))
+     (set! x (+ x 1)) ...")
+
+  (lint-test "(define (f a) (let ((x 1) (y 2) (z (vector 3))) (vector-set! z 0 (+ x 1)) (display y) (newline) (+ y (vector-ref z 0))))"
+	     " f: y can probably be moved to f's closure
+               f: x can be moved to f's closure
+               f: x is only used in expression 1 (of 4), (vector-set! z 0 (+ x 1)) of
+                 (let ((x 1) (y 2) (z (vector 3))) (vector-set! z 0 (+ x 1)) (display y)...
+               f: the scope of x could be reduced:
+    (let ((x 1) (y 2) (z (vector 3))) (vector-set! z 0 (+ x 1)) (display y)... ->
+    (let ((y 2)
+          (z (vector 3)))
+      (let ((x 1))
+        (vector-set! z 0 (+ x 1)))
+      (display y)
+      ...)")
+  (lint-test "(define (f a) (let ((x 1) (y 2) (z (vector 3 4))) (vector-set! z 0 (+ x 1)) (display (vector-ref z x)) (set! y (+ y 1)) (newline) (+ y 1)))"
+	     "f: x can be moved to f's closure
+              f: x is only used in expressions 1 and 2 (of 5), (vector-set! z 0 (+ x 1)) (display (vector-ref z x)) of
+                 (let ((x 1) (y 2) (z (vector 3 4))) (vector-set! z 0 (+ x 1)) (display...
+              f: the scope of x, z could be reduced:
+    (let ((x 1) (y 2) (z (vector 3 4))) (vector-set! z 0 (+ x 1)) (display... ->
+    (let ((y 2))
+      (let ((x 1)
+            (z (vector 3 4)))
+        (vector-set! z 0 (+ x 1))
+        (display (vector-ref z x)))
+      (set! y (+ y 1))
+      ...)")
+  (lint-test "(define (f a) (let* ((x 1) (y (+ x 2)) (z (vector 3))) (vector-set! z 0 (+ x 1)) (display y) (newline) (+ y x)))"
+	     "f: perhaps split this let*: (let* ((x 1) (y (+ x 2)) (z (vector 3))) (vector-set! z 0 (+ x 1))... ->
+                 (let ((x 1)) (let ((y (+ x 2)) (z (vector 3))) ...))
+	      f: the scope of z could be reduced:
+    (let* ((x 1) (y (+ x 2)) (z (vector 3))) (vector-set! z 0 (+ x 1))... ->
+    (let* ((x 1)
+           (y (+ x 2)))
+      (let ((z (vector 3)))
+        (vector-set! z 0 (+ x 1)))
+      (display y)
+      ...)")
+  (lint-test "(define (f x) (let ((y #f)) (set! z (+ z 1)) (display z) (f z) (if z? (begin (set! y (g x)) (display y)))))"
+             " f:  perhaps (if z? (begin (set! y (g x)) (display y))) -> (when z? (set! y (g x)) (display y))
+               f: y is only used in expression 4 (of 4),
+                 (if z? (begin (set! y (g x)) (display y))) of
+                   (let ((y #f)) (set! z (+ z 1)) (display z) (f z) (if z? (begin (set! y (g...")
+  (lint-test "(define (f x) (let* ((z x) (y #f)) (set! z (+ z 1)) (display z) (f z) (if z? (begin (set! y (g x)) (display y)))))"
+             " f: let* could be let: (let* ((z x) (y #f)) (set! z (+ z 1)) (display z) (f z) (if z? (begin...
+               f:  perhaps (if z? (begin (set! y (g x)) (display y))) -> (when z? (set! y (g x)) (display y))
+               f: y is only used in expression 4 (of 4),
+                 (if z? (begin (set! y (g x)) (display y))) of
+                   (let* ((z x) (y #f)) (set! z (+ z 1)) (display z) (f z) (if z? (begin...")
+  (lint-test "(let ((x (f y))) (g (car x)) (h (caar x)) (j (caddar x)))"
+	     " let: x is not set, and is always accessed via (car x) so its binding could probably be
+                 (x (car (f y))) in (let ((x (f y))) (g (car x)) (h (caar x)) (j (caddar x)))")
+  (lint-test "(let ((x (f y))) (g (cddar x)) (h (caar x)) (j (caddar x)))"
+	     " let: x is not set, and is always accessed via (car x) so its binding could probably be
+                 (x (car (f y))) in (let ((x (f y))) (g (cddar x)) (h (caar x)) (j (caddar x)))")
+  (lint-test "(let ((x 2)) (g (+ x x)) (h (+ x x)) (j (+ x x)))"
+	     " let: x is not set, and is always accessed via (+ x x) so its binding could probably be
+                 (x (+ 2 2)) in (let ((x 2)) (g (+ x x)) (h (+ x x)) (j (+ x x)))")
+  (lint-test "(let ((x 2)) (g (< 0 x 1)) (h (> 1 x 0)) (j (< 0 x 1)))"
+	     " let: x is not set, and is always accessed via (< 0 x 1) so its binding could probably be (x (< 0 2 1)) in
+                 (let ((x 2)) (g (< 0 x 1)) (h (> 1 x 0)) (j (< 0 x 1)))")
+  (lint-test "(let ((x (f y))) (g (cddr x)) (h (caar x)) (j (caddar x)))" "")
+  (lint-test "(let ((x (f y))) (g (cddar x)) (h (caadr x)) (j (caddar x)))" "")
+  (lint-test "(let ((x (f y))) (g (abs (car x))) (h (caar x)) (j (caddar x)))"
+	     " let: x is not set, and is always accessed via (car x) so its binding could probably be (x (car (f y))) in
+                 (let ((x (f y))) (g (abs (car x))) (h (caar x)) (j (caddar x)))")
+
+  (lint-test "(let ((a (car x))) (if b (display (g a b))))"
+	     " let: perhaps move the let to the true branch:
+                 (let ((a (car x))) (if b (display (g a b)))) -> (if b (let ((a (car x))) (display (g a b))))")
+  (lint-test "(let ((a (car x))) (if b (+ a (f a)) (display c)))"
+	     " let: perhaps move the let to the true branch:
+                 (let ((a (car x))) (if b (+ a (f a)) (display c))) -> (if b (let ((a (car x))) (+ a (f a))) (display c))")
+  (lint-test "(let ((a (car x))) (if b (begin (display x) (+ a (f a))) (display c)))"
+	     " let: perhaps move the let to the true branch:
+                 (let ((a (car x))) (if b (begin (display x) (+ a (f a))) (display c))) -> (if b (let ((a (car x))) (display x) (+ a (f a))) (display c))")
+  (lint-test "(let ((a (car x))) (when b (display (g a b))))"
+	     " let: perhaps move the let inside the when: (let ((a (car x))) (when b (display (g a b)))) -> (when b (let ((a (car x))) (display (g a b))))")
+  (lint-test "(let ((a (car x))) (cond (b (display (g a b))) (else (set! y z) (display x))))"
+	     " let: perhaps move the let into the '(b (display (g a b))) branch:
+                 (let ((a (car x))) (cond (b (display (g a b))) (else (set! y z) (display x)))) ->
+                 (cond (b (let ((a (car x))) (display (g a b)))) ...)")
+  (lint-test "(let ((a (car x))) (case b ((0) (display (g a b))) (else (set! y z) (display x))))"
+	     " let: perhaps move the let into the '((0) (display (g a b))) branch:
+                 (let ((a (car x))) (case b ((0) (display (g a b))) (else (set! y z)... ->
+                 (case b ((0) (let ((a (car x))) (display (g a b)))) ...)")
+  (lint-test "(if z (let () (* 2 y)))"
+	     " if: perhaps (if z (let () (* 2 y))) -> (when z (* 2 y))
+               if: pointless let: (let () (* 2 y))
+               if: perhaps (let () (* 2 y)) -> (* 2 y)")
+  (lint-test "(if z (let () (display y) (* 2 y)))"
+	     " if: perhaps (if z (let () (display y) (* 2 y))) -> (when z (display y) (* 2 y))
+               if: let could be begin: (let () (display y) (* 2 y)) -> (begin (display y) (* 2 y))")
+
+  (lint-test "(let ((v 3)) v)" " let: perhaps (let ((v 3)) v) -> 3") ; this aimed at a lint bug
+  (lint-test "(let ((v (make-vector 3))) #f)" " let: v not used, initially: (make-vector 3) from let") ; also same bug
+  (lint-test "(let () (abs -1))"
+	     " let: pointless let: (let () (abs -1))
+               let: perhaps (let () (abs -1)) -> (abs -1)
+               let: perhaps (abs -1) -> 1")
+
+  (lint-test "(eq? x '())"              " eq?: perhaps (eq? x '()) -> (null? x) eq?: quote is not needed here: '()")
+  (lint-test "(equal? x '#())"          " equal?: quote is not needed here: '#()")
+  (lint-test "(equal? x '\"\")"         " equal?: quote is not needed here: '\"\"")
+  (lint-test "(eq? x '#<unspecified>)"  " eq?: quote is not needed here: '#<unspecified>")
+  (lint-test "(eq? x '#t)"              " eq?: quote is not needed here: '#t")
+  (lint-test "(eq? x '#f)"              " eq?: perhaps (eq? x '#f) -> (not x) eq?: quote is not needed here: '#f")
+  (lint-test "(equal? x '(1))"          "")
+  (lint-test "(eqv? x '3)"              " eqv?: quote is not needed here: '3")
+  (lint-test "(eq? x 'x)"               "")
+  (lint-test "(eq? x 1.5)"		" eq?: eq? should be eqv? in (eq? x 1.5)")
+  (lint-test "(eq? 3 x)"		" eq?: eq? should be eqv? in (eq? 3 x)")
+  (lint-test "(eq? x (not x))"		" eq?: this looks odd: (eq? x (not x))")
+  (lint-test "(eq? #(a) #(a))"
+	     " eq?: this looks odd: (eq? #(a) #(a)) eq?: perhaps (eq? #(a) #(a)) -> #f eq?: eq? should be equal? in (eq? #(a) #(a))")
+  (lint-test "(eq? #() ())"		" eq?: perhaps (eq? #() ()) -> #f eq?: eq? should be equal? in (eq? #() ()) eq?: perhaps (eq? #() ()) -> #f")
+  (lint-test "(eqv? x #())"             " eqv?: eqv? should be equal? in (eqv? x #())")
+  (lint-test "(eq? x \"\")"             " eq?: eq? should be equal? in (eq? x \"\")")
+  (lint-test "(eq? #() (vector))"       " eq?: eq? should be equal? in (eq? #() (vector))")
+  (lint-test "(eq? () (list))"          " eq?: perhaps (eq? () (list)) -> #t eq?: perhaps (list) -> (); there is only one nil")
+  (lint-test "(eqv? x (string))"        " eqv?: eqv? should be equal? in (eqv? x (string)) eqv?: (string) could be \"\"")
+  (lint-test "(eq? (symbol->string x) z)" " eq?: eq? should be equal? in (eq? (symbol->string x) z)")
+  (lint-test "(eq? (symbol? x) #t)"	" eq?: perhaps (eq? (symbol? x) #t) -> (symbol? x)")
+  (lint-test "(eq? (symbol? x) #f)"	" eq?: perhaps (eq? (symbol? x) #f) -> (not (symbol? x))")
+  (lint-test "(eq? (memq x y) #t)"      " eq?: perhaps (eq? (memq x y) #t) -> #f")
+  (lint-test "(eq? x '())"		" eq?: perhaps (eq? x '()) -> (null? x) eq?: quote is not needed here: '()")
+  (lint-test "(eq? '() x)"              " eq?: perhaps (eq? '() x) -> (null? x) eq?: quote is not needed here: '()")
+  (lint-test "(eq? x '#\\a)"            " eq?: eq? should be eqv? in (eq? x '#\\a) eq?: quote is not needed here: '#\\a")
+  (lint-test "(eq? x x)"                " eq?: this looks odd: (eq? x x), isn't it always #t?")
+  (lint-test "(eqv? x ())"		" eqv?: eqv? could be null?: (eqv? x ()) -> (null? x)")
+  (lint-test "(eqv? x '())"		" eqv?: eqv? could be null?: (eqv? x '()) -> (null? x) eqv?: quote is not needed here:  '()")
+  (lint-test "(eqv? x #(a))"		" eqv?: eqv? should be equal? in (eqv? x #(a))")
+  (lint-test "(eqv? x 'a)"		" eqv?: eqv? could be eq? in (eqv? x 'a)")
+  (lint-test "(eqv? x #f)"              " eqv?: eqv? could be not: (eqv? x #f) -> (not x)")
+  (lint-test "(equal? x 'a)"		" equal?: equal? could be eq? in (equal? x 'a)")
+  (lint-test "(equal? x (integer->char 96))" " equal?: equal? could be eqv? in (equal? x (integer->char 96)) equal?: perhaps (integer->char 96) -> #\\`")
+  (lint-test "(equal? x #f)"            " equal?: equal? could be not: (equal? x #f) -> (not x)")
+  (lint-test "(equal? #f x)"            " equal?: equal? could be not: (equal? #f x) -> (not x)")
+  (lint-test "(equal? x ())"            " equal?: equal? could be null?: (equal? x ()) -> (null? x)")
+  (lint-test "(equal? x '())"           " equal?: equal? could be null?: (equal? x '()) -> (null? x) equal?: quote is not needed here:  '()")
+  (lint-test "(equal? (expt x y) z)"    " equal?: equal? could be eqv? in (equal? (expt x y) z)")
+  (lint-test "(equivalent? x 0)"     "")
+  (lint-test "(equivalent? (abs x) 0.0)"   "")
+  (lint-test "(equal? (floor x) (round y))" " equal?: equal? could be eqv? or = in (equal? (floor x) (round y))")
+  (lint-test "(equal? (string x) (string-append y z))" " equal?: equal? could be string=? in (equal? (string x) (string-append y z))")
+  (lint-test "(eqv? (integer->char x) #\\null)" " eqv?: eqv? could be char=? in (eqv? (integer->char x) #\\null)")
+  (lint-test "(eq? #\\space (string-ref x 0))" " eq?: eq? should be eqv? or char=? in (eq? #\\space (string-ref x 0))")
+  (lint-test "(eq? (sin x) (cos y))"    " eq?: eq? should be eqv? or = in (eq? (sin x) (cos y))")
+  (lint-test "(eqv? #\\Space x)"        " reader: unknown # object: #\\Space  perhaps use #\\space instead")
+  (lint-test "(equal? (length x) (length y))"                 " equal?: equal? could be eqv? in (equal? (length x) (length y))")
+  (lint-test "(equal? (string->number x) (string->number y))" " equal?: equal? could be eqv? in (equal? (string->number x) (string->number y))")
+  (lint-test "(eqv? \":\" (string-ref s 0))"
+	     " eqv?: this can't be right: (eqv? \":\" (string-ref s 0))
+               eqv?: eqv? should be equal? in (eqv? \":\" (string-ref s 0))
+               eqv?: perhaps (eqv? \":\" (string-ref s 0)) -> #f")
+  (lint-test "(eqv? \"a\" (string))"
+	     " eqv?: (eqv? \"a\" (string)) is #f
+               eqv?: eqv? should be equal? or string=? in (eqv? \"a\" (string))
+               eqv?: (string) could be \"\"")
+  (lint-test "(eqv? (string) \"a\")"
+	     " eqv?: (eqv? (string) \"a\") is #f
+               eqv?: eqv? should be equal? or string=? in (eqv? (string) \"a\")
+               eqv?: (string) could be \"\"")
+  (lint-test "(eqv? \"a\" (substring x 2 3))"
+	     " eqv?: perhaps (eqv? \"a\" (substring x 2 3)) -> (char=? #\\a (string-ref x 2))
+               eqv?: eqv? should be equal? or string=? in (eqv? \"a\" (substring x 2 3))")
+  (lint-test "(eqv? (string #\\a) (substring x 2 3))"
+	     " eqv?: perhaps (eqv? (string #\\a) (substring x 2 3)) -> (char=? #\\a (string-ref x 2))
+               eqv?: eqv? should be equal? or string=? in (eqv? (string #\\a) (substring x 2 3))
+               eqv?: (string #\\a) could be \"a\"")
+  (lint-test "(eqv? (substring x 0 1) (string #\\a))"
+	     " eqv?: perhaps (eqv? (substring x 0 1) (string #\\a)) -> (char=? #\\a (string-ref x 0))
+               eqv?: eqv? should be equal? or string=? in (eqv? (substring x 0 1) (string #\\a))
+               eqv?: (string #\\a) could be \"a\"")
+  (lint-test "(string=? \"a\" (substring x 2 3))" " string=?: perhaps (string=? \"a\" (substring x 2 3)) -> (char=? #\\a (string-ref x 2))")
+  (lint-test "(string=? (string) \"a\")" " string=?: (string=? (string) \"a\") is #f  string=?: (string) could be \"\"")
+  (lint-test "(string=? (string y) (substring x 2 3))" " string=?: perhaps (string=? (string y) (substring x 2 3)) -> (char=? y (string-ref x 2))")
+  (lint-test "(string=? (string x) (string y))" " string=?: perhaps (string=? (string x) (string y)) -> (char=? x y)")
+  (lint-test "(string=? (substring y 0 1) (substring x 2 3))"
+	     " string=?: perhaps (string=? (substring y 0 1) (substring x 2 3)) -> (char=? (string-ref y 0) (string-ref x 2))")
+
+  (lint-test "(char-ci=? x #\\return)"  " char-ci=?: char-ci=? could be char=? here: (char-ci=? x #\\return)")
+  (lint-test "(equal? (vector-copy #(a b c)) #(a b c))" " equal?: perhaps (equal? (vector-copy #(a b c)) #(a b c)) -> (equal? #(a b c) #(a b c))")
+  (lint-test "(not (equal? v (copy v)))" " not: perhaps (equal? v (copy v)) -> (equal? v v)")
+
+  (lint-test "(eq? (floor x) 'a)"            " eq?: eq? should be eqv? in (eq? (floor x) 'a) eq?: perhaps (eq? (floor x) 'a) -> #f")
+  (lint-test "(eq? (floor pi) #t)"           " eq?: eq? should be eqv? in (eq? (floor pi) #t) eq?: perhaps (eq? (floor pi) #t) -> #f")
+  (lint-test "(eqv? (string->symbol x) 123)" " eqv?: perhaps (eqv? (string->symbol x) 123) -> #f")
+  (lint-test "(eq? 'a (integer->char 48))"
+	     " eq?: eq? should be eqv? in (eq? 'a (integer->char 48))
+               eq?: perhaps (eq? 'a (integer->char 48)) -> #f
+               eq?: perhaps (integer->char 48) -> #\\0")
+  (lint-test "(equal? (string->symbol x) 123)"
+	     " equal?: equal? could be eqv? in (equal? (string->symbol x) 123)
+               equal?: perhaps (equal? (string->symbol x) 123) -> #f")
+  (lint-test "(equal? (floor pi) (list 1 2))"
+	     " equal?: equal? could be eqv? in (equal? (floor pi) (list 1 2))
+               equal?: perhaps (equal? (floor pi) (list 1 2)) -> #f
+               equal?: perhaps (list 1 2) -> '(1 2)")
+  (lint-test "(equivalent? (list 1 2) (vector 1 2))"
+	     " equivalent?: perhaps (equivalent? (list 1 2) (vector 1 2)) -> #f
+               equivalent?: perhaps (list 1 2) -> '(1 2)
+               equivalent?: perhaps (vector 1 2) -> #(1 2)")
+  (lint-test "(eq? x 'a)" "")
+  (lint-test "(equal? '(1 2) '(1 2))" " equal?: perhaps (equal? '(1 2) '(1 2)) -> #t")
+  (lint-test "(equal? '(1 2) #(1 2))"
+	     " equal?: perhaps (equal? '(1 2) #(1 2)) -> #f
+               equal?: perhaps (equal? '(1 2) #(1 2)) -> #f
+               equal?: #(1 2) could be #i(1 2)")
+  (lint-test "(equal? '(1 . 2) (cons 1 2))" "")
+
+  (lint-test "(map abs '(1 2) '(3 4))"	" map: map has too many arguments in:  (map abs '(1 2) '(3 4))")
+  (lint-test "(map (lambda (a b) a) '(1 2))" " map: map has too few arguments in:  (map (lambda (a b) a) '(1 2))")
+  (lint-test "(map (lambda (a) (abs a)) '(1 2 3))" " map: perhaps (lambda (a) (abs a)) -> abs")
+  (lint-test "(map abs (vector->list #(1 2)))"
+	     " map:  (vector->list #(1 2)) could be simplified to:  #(1 2) ; (map accepts non-list sequences)
+               map: perhaps (vector->list #(1 2)) -> '(1 2)
+               map: #(1 2) could be #i(1 2)")
+  (lint-test "(begin (map g123 x) x)"	" begin: map could be for-each: (for-each g123 x)")
+  (lint-test "(map log x x)"            "")
+  (lint-test "(map f (map g h))"        " map: perhaps (map f (map g h)) -> (map (lambda (<1>) (f (g <1>))) h)")
+  (lint-test "(for-each x (map g h))"   " for-each: perhaps (for-each x (map g h)) -> (for-each (lambda (<1>) (x (g <1>))) h)")
+  (lint-test "(map f (map (lambda (x) (g x y)) h))" " map: perhaps (map f (map (lambda (x) (g x y)) h)) -> (map (lambda (<1>) (f (g <1> y))) h)")
+  (lint-test "(map (lambda (x) (f x y)) (map g h))" " map: perhaps (map (lambda (x) (f x y)) (map g h)) -> (map (lambda (<1>) (f (g <1>) y)) h)")
+  (lint-test "(map (lambda (x) (f x y)) (map (lambda (y) (g z y)) h))"
+	     " map: perhaps (map (lambda (x) (f x y)) (map (lambda (y) (g z y)) h)) -> (map (lambda (<1>) (f (g z <1>) y)) h)")
+  (lint-test "(map f (map (lambda (x) (g 'x x)) h))" " map: perhaps (map f (map (lambda (x) (g 'x x)) h)) -> (map (lambda (<1>) (f (g 'x <1>))) h)")
+  (lint-test "(map (lambda (x) (display 1) (f x)) (map g h))"
+	     " map: perhaps (map (lambda (x) (display 1) (f x)) (map g h)) -> (map (lambda (<1>) (display 1) (f (g <1>))) h)")
+  (lint-test "(map (lambda (x) (display 1) (f x)) (map (lambda (y) (+ y 1)) h))"
+	     " map: perhaps (map (lambda (x) (display 1) (f x)) (map (lambda (y) (+ y 1)) h)) -> (map (lambda (<1>) (display 1) (f (+ <1> 1))) h)")
+  (lint-test "(map (lambda (x) x) lst)" " map: perhaps (map (lambda (x) x) lst) -> lst")
+  (lint-test "(for-each (lambda (x) (+ (abs x) 1)) lst)" " for-each: pointless for-each: (for-each (lambda (x) (+ (abs x) 1)) lst)")
+  (lint-test "(for-each x #\\a)"        " for-each: in (for-each x #\\a), for-each's second argument should be a sequence, but #\\a is a char?")
+  (lint-test "(map f (cdr (vector->list v)))"
+	     " map: map accepts vector arguments, so perhaps (cdr (vector->list v)) -> (subvector v 1 (length v))")
+  (lint-test "(for-each f (list-tail (string->list str) x))"
+	     " for-each: for-each accepts string arguments, so perhaps (list-tail (string->list str) x) -> (substring str x)")
+  (lint-test "(map char-downcase (string->list str))"
+	     " map: (string->list str) could be simplified to: str ; (map accepts non-list sequences)
+               map: perhaps (map char-downcase (string->list str)) -> (string->list (string-downcase str))")
+  (lint-test "(for-each display (list a))"
+	     " for-each: perhaps (for-each display (list a)) -> (display a)
+               for-each: perhaps (for-each display (list a)) -> (format () \"~A\" a)")
+  (lint-test "(map display (vector 'a 'b 'c))" " map: perhaps (vector 'a 'b 'c) -> #(a b c)")
+  (lint-test "(map (lambda (v) #f) y)" " map: perhaps (map (lambda (v) #f) y) -> (make-list (abs (length y)) #f)")
+  (lint-test "(map abs ())" " map: this (map abs ()) has no effect (null arg)")
+  (lint-test "(map fnc '(2))" " map: perhaps (map fnc '(2)) -> (list (fnc 2))")
+  (lint-test "(for-each fnc (list x) '(2))" " for-each: perhaps (for-each fnc (list x) '(2)) -> (fnc x 2)")
+  (lint-test "(for-each display #())"
+	     " for-each: this (for-each display #()) has no effect (zero length arg)
+               for-each: perhaps (for-each display #()) -> (format () \"~{~A~}\" #())")
+  (lint-test "(for-each display \"\")"
+	     " for-each: this (for-each display \"\") has no effect (zero length arg)
+               for-each: perhaps (for-each display \"\") -> (format () \"~{~A~}\" \"\")")
+  (lint-test "(for-each display ())"
+	     " for-each: this (for-each display ()) has no effect (null arg)
+               for-each: perhaps (for-each display ()) -> (format () \"~{~A~}\" ())")
+  (lint-test "(for-each fxy ())"  " for-each: this (for-each fxy ()) has no effect (null arg)")
+  (lint-test "(for-each fxy '())"
+	     " for-each: this (for-each fxy '()) has no effect (null arg)
+               for-each: quote is not needed here: '()")
+  (lint-test "(for-each fxy #())" " for-each: this (for-each fxy #()) has no effect (zero length arg)")
+  (lint-test "(map car (list (cons a b)))" "  map: perhaps (map car (list (cons a b))) -> (list (car (cons a b)))")
+  (lint-test "(map abs #(1))" " map: perhaps (map abs #(1)) -> (list (abs 1)) map: #(1) could be #i(1)")
+
+  (lint-test "(catch #(a) (lambda () #f) (lambda a a))" " catch: catch tag #(a) is unreliable (catch uses eq? to match tags)")
+  (lint-test "(catch x (lambda () #f) (lambda a a))" "")
+  (lint-test "(catch 'hi x y)" "")
+
+  (lint-test "(car #(a))"		" car: in (car #(a)), car's argument should be a pair, but #(a) is a vector?")
+  (unless pure-s7
+    (lint-test "(vector->list 1.4)"     " vector->list: in (vector->list 1.4), vector->list's argument should be a vector, but 1.4 is a float?"))
+  (lint-test "(vector-set! #(0 a) 0 2)"
+	     " vector-set!: #(0 a) is a constant, so vector-set! is problematic, and #(0 a) is discarded; perhaps (vector-set! #(0 a) 0 2) -> 2")
+  (lint-test "(list-set! (list 0 1) 0 2)" " list-set!: (list 0 1) is simply discarded; perhaps (list-set! (list 0 1) 0 2) -> 2")
+  (lint-test "(string-set! (make-string 3) 0 #\\a)"
+	     " string-set!: (make-string 3) is simply discarded; perhaps (string-set! (make-string 3) 0 #\\a) -> #\\a")
+  (lint-test "(let ((x '(0 1))) (list-set! x 0 3.1))"
+             "let: perhaps (let ((x '(0 1))) (list-set! x 0 3.1)) -> (list-set! '(0 1) 0 3.1)
+	      let: x's value, '(0 1), is a literal constant, so this set! is trouble: (list-set! x 0 3.1)")
+  (lint-test "(let ((c #(0 a))) (vector-set! c 0 1))"
+	     "let: perhaps (let ((c #(0 a))) (vector-set! c 0 1)) -> (vector-set! #(0 a) 0 1)
+	      let: c's value, #(0 a), is a literal constant, so this set! is trouble: (vector-set! c 0 1)")
+  (lint-test "(let ((x (vector 0 1))) (vector-set! x 0 1))"
+	     " let: perhaps (let ((x (vector 0 1))) (vector-set! x 0 1)) -> (vector-set! (vector 0 1) 0 1)")
+  (lint-test "(let ((x (vector 0 1))) (string-set! x 0 #\\a))"
+	     " let: perhaps (let ((x (vector 0 1))) (string-set! x 0 #\\a)) -> (string-set! (vector 0 1) 0 #\\a)
+	       let: x is a vector, but string-set! in (string-set! x 0 #\\a) wants a string?")
+  (lint-test "(list-set! (cdr x) 0 y)" " list-set!: perhaps (list-set! (cdr x) 0 y) -> (list-set! x 1 y)")
+
+  (lint-test "(vector-set! (vector-ref x 0) 1 2)"      " vector-set!: perhaps (vector-set! (vector-ref x 0) 1 2) -> (set! (x 0 1) 2)")
+  (lint-test "(int-vector-set! (vector-ref x 0) 1 2)"  " int-vector-set!: perhaps (int-vector-set! (vector-ref x 0) 1 2) -> (set! (x 0 1) 2)")
+  (lint-test "(hash-table-set! (vector-ref x 0) 'a 2)" " hash-table-set!: perhaps (hash-table-set! (vector-ref x 0) 'a 2) -> (set! ((x 0) 'a) 2)")
+  (lint-test "(let-set! (vector-ref x 0) 'a 2)"        " let-set!: perhaps (let-set! (vector-ref x 0) 'a 2) -> (set! ((x 0) 'a) 2)")
+
+  (lint-test "(+ . 1)"   " +: unexpected dot:  (+ . 1)")
+  (lint-test "(or . 0)"  " or: unexpected dot: (or . 0)")
+  (lint-test "(not . 0)" " not: unexpected dot: (not . 0)")
+  (lint-test "(and . 0)" " and: unexpected dot: (and . 0)")
+
+  (lint-test "(length (a . b))"         " length: missing quote? (a . b) in (length (a . b))")
+  (unless (or pure-s7 immutable-unquote)
+    (lint-test "(length ,a)"
+	       (if immutable-unquote
+		   " length: stray comma? ,a in (length ,a)"
+		   " length: stray comma? (unquote a) in (length (unquote a))")))
+  (lint-test "(make-vector (length (append x y)))" " make-vector: perhaps (length (append x y)) -> (+ (length x) (length y))")
+  (lint-test "(make-float-vector 3 0.0)"      " make-float-vector: 0.0 is the default initial value in (make-float-vector 3 0.0)")
+  (lint-test "(make-vector 3 #<unspecified>)" " make-vector: #<unspecified> is the default initial value in (make-vector 3 #<unspecified>)")
+
+  (lint-test "(set! a b c)"		" set!: set! has too many arguments: (set! a b c)")
+  (lint-test "(set! a)"			" set!: set! has too few arguments: (set! a)")
+  (lint-test "(set! (vector-ref v 0) 3)" " set!: perhaps (set! (vector-ref v 0) 3) -> (vector-set! v 0 3)")
+  (lint-test "(set! pi 3)"		" set!: can't set! (set! pi 3) (it is a constant)")
+  (lint-test "(set! if 3)"              " set!: bad idea: (set! if 3)")
+  (lint-test "(set! abs 3)"             " set!: not recommended: (set! abs 3)")
+  (lint-test "(set! 3 1)"		" set!: can't set! (set! 3 1)")
+  (lint-test "(set! () 3)"              " set!: can't set! (set! () 3)")
+  (lint-test "(set! a a)"		" set!: pointless set! (set! a a)")
+  (lint-test "(set! a (copy a))"	" set!: pointless set! (set! a (copy a))")
+  (lint-test "(set! x (if y x 1))"      " set!: perhaps (set! x (if y x 1)) -> (if (not y) (set! x 1))")
+  (lint-test "(set! x (if y 1 x))"      " set!: perhaps (set! x (if y 1 x)) -> (if y (set! x 1))")
+  (lint-test "(set! x (and x y))"       " set!: perhaps (set! x (and x y)) -> (if x (set! x y))")
+  (lint-test "(set! x (and y x))"       " set!: perhaps (set! x (and y x)) -> (if (not y) (set! x #f))")
+  (lint-test "(set! x (or x y))"        " set!: perhaps (set! x (or x y)) -> (if (not x) (set! x y))")
+  (lint-test "(set! x (or y x))"        "")
+  (lint-test "(set! x (cond (z w) (else x)))" " set!: perhaps (set! x (cond (z w) (else x))) -> (if z (set! x w))")
+  (lint-test "(set! x (cond (z x) (else w)))" " set!: perhaps (set! x (cond (z x) (else w))) -> (if (not z) (set! x w))")
+
+  (lint-test "(begin (set! x (cons 1 z)) (set! x (cons 2 x)))" " begin: perhaps (set! x (cons 1 z)) (set! x (cons 2 x)) -> (set! x (cons 2 (cons 1 z)))")
+  (lint-test "(begin (set! x 0) (set! x 1))" " begin: this could be omitted: (set! x 0)")
+  (lint-test "(begin (set! x y) (set! x y))"
+	     " begin: this pair of set!s looks odd: (... (set! x y) (set! x y) ...)
+	       begin: this could be omitted: (set! x y)")
+  (lint-test "(begin (set! x y) (set! y x))" " begin: this pair of set!s looks odd: (... (set! x y) (set! y x) ...)")
+  (lint-test "(begin (set! x y) (set! x (+ x 1)))" " begin: perhaps (set! x y) (set! x (+ x 1)) -> (set! x (+ y 1))")
+  (lint-test "(quote 3)"		" quote: quote is not needed here: (quote 3)")
+  (lint-test "(quote . 3)"		" quote: stray dot in quote's arguments? (quote . 3)")
+  (lint-test "(quote 3 4)"		" quote: quote has too many arguments: (quote 3 4)")
+  (lint-test "'#(a)"			" #_quote: quote is not needed here: '#(a)")
+
+  (lint-test "(let () (when a (+ x 1)) y)"
+	     " let: let could be begin: (let () (when a (+ x 1)) y) -> (begin (when a (+ x 1)) y)
+               let: this could be omitted: (when a (+ x 1))")
+  (lint-test "(let () (unless a (+ x 1)) y)"
+	     " let: let could be begin: (let () (unless a (+ x 1)) y) -> (begin (unless a (+ x 1)) y)
+               let: this could be omitted: (unless a (+ x 1))")
+  (lint-test "(let () (cond ((< x y) 3) ((< y z) 4)) (+ x 1))"
+	     " let: let could be begin: (let () (cond ((< x y) 3) ((< y z) 4)) (+ x 1)) -> (begin (cond ((< x y) 3) ((< y z) 4)) (+ x 1))
+               let: this could be omitted: (cond ((< x y) 3) ((< y z) 4))")
+  (lint-test "(let () (case x ((0) 1) (else 2)) x)"
+	     " let: let could be begin: (let () (case x ((0) 1) (else 2)) x) -> (begin (case x ((0) 1) (else 2)) x)
+               let: this could be omitted: (case x ((0) 1) (else 2))
+               let: perhaps (case x ((0) 1) (else 2)) -> (if (eqv? x 0) 1 2)")
+  (lint-test "(begin (let ((a (+ x 1)) (b 2)) (+ a b)) 32)"
+	     " begin: perhaps (begin (let ((a (+ x 1)) (b 2)) (+ a b)) 32) -> (let ((a (+ x 1)) (b 2)) (+ a b) 32)
+	       begin: this could be omitted: (let ((a (+ x 1)) (b 2)) (+ a b))
+               begin: perhaps (let ((a (+ x 1)) (b 2)) (+ a b)) -> (+ (+ x 1) 2)")
+  (lint-test "(begin (if x y z) a)" " begin: this could be omitted: (if x y z)")
+  (lint-test "(lambda (a) (if x y z) a)" " lambda: this could be omitted: (if x y z)")
+  (lint-test "(lambda (a) (case x ((0) 1) (else x)) a)"
+	     " lambda: this could be omitted: (case x ((0) 1) (else x))
+               lambda: perhaps (case x ((0) 1) (else x)) -> (if (eqv? x 0) 1 x)
+               lambda: in (else x), the result can be omitted")
+  (lint-test "(let () (do ((i 0 (+ i 1))) ((= i 1))) x)"
+	     " let: let could be begin: (let () (do ((i 0 (+ i 1))) ((= i 1))) x) -> (begin (do ((i 0 (+ i 1))) ((= i 1))) x)
+               let: this could be omitted: (do ((i 0 (+ i 1))) ((= i 1)))
+               let: this do-loop could probably be replaced by the end test in a let: (do ((i 0 (+ i 1))) ((= i 1)))
+               let: do is unnecessary: (do ((i 0 (+ i 1))) ((= i 1)))")
+  (lint-test "(let () (write-byte i) (write-byte i) (write-byte i) (write-byte i) (write-byte i) (newline))"
+	     " let: let could be begin: (let () (write-byte i) (write-byte i) (write-byte i) (write-byte i)... ->
+                 (begin (write-byte i) (write-byte i) (write-byte i) (write-byte i)...
+               let: perhaps (write-byte i)... -> (do ((<1> 0 (+ <1> 1))) ((= <1> 5)) (write-byte i))")
+  (lint-test "(let () (write-byte 0) (write-byte 0) (write-byte 0) (write-byte 0) (write-byte 0))"
+	     " let: let could be begin: (let () (write-byte 0) (write-byte 0) (write-byte 0) (write-byte 0)... ->
+                 (begin (write-byte 0) (write-byte 0) (write-byte 0) (write-byte 0)...
+               let: perhaps (write-byte 0)... -> (do ((i 0 (+ i 1))) ((= i 5)) (write-byte 0))")
+  (lint-test "(let () (write-byte 0) (write-byte 1) (write-byte 2) (write-byte 3) (write-byte 4))"
+	     " let: let could be begin: (let () (write-byte 0) (write-byte 1) (write-byte 2) (write-byte 3)... ->
+                 (begin (write-byte 0) (write-byte 1) (write-byte 2) (write-byte 3)...
+               let: perhaps (write-byte 0)... -> (for-each write-byte '(0 1 2 3 4))")
+  (lint-test "(let () (write-byte 0) (write-byte 1) (write-byte 2) (write-byte 3) (write-byte (* x 2)))"
+	      " let: let could be begin: (let () (write-byte 0) (write-byte 1) (write-byte 2) (write-byte 3)... ->
+                (begin (write-byte 0) (write-byte 1) (write-byte 2) (write-byte 3)...
+                let: perhaps (write-byte 0)... -> (for-each write-byte (vector 0 1 2 3 (* x 2)))
+                let: in (write-byte (* x 2)), write-byte's argument should be a byte, but (* x 2) is a number?")
+  (lint-test "(let () (writ 0) (writ 1) (writ 2) (writ 3) (writ (* x 2)))"
+	     " let: assuming writ is not a macro, perhaps (... (writ 0) ...) -> (for-each writ (vector 0 1 2 3 (* x 2)))")
+  (lint-test "(let () (writ 0) (writ 1) (writ) (writ 3) (writ (* x 2)))" "")
+  (lint-test "(let () (writ 0 x) (writ 1 x) (writ 2 x) (writ 3 x) (writ 4 x))"
+	     " let: perhaps (writ 0 x)... -> (for-each (lambda (arg) (writ arg x)) '(0 1 2 3 4))")
+  (lint-test "(let () (writ x 0) (writ x 1) (writ x 2) (writ x 3) (writ x (* x 2)))"
+	      " let: assuming writ is not a macro, perhaps (... (writ x 0) ...) -> (for-each (lambda (arg) (writ x arg)) (vector 0 1 2 3 (* x 2)))")
+  (lint-test "(let () (writ x 0) (writ x 1) (writ y 2) (writ x 3) (writ x (* x 2)))" "")
+  (lint-test "(let () (writ (display x) 0) (writ (display x) 1) (writ (display x) 2) (writ (display x)))" "")
+
+  (lint-test "(case 3)"			" case: case is messed up:  (case 3)")
+  (lint-test "(case 3 ((0) #t))"
+	     " case: perhaps (case 3 ((0) #t)) -> (if (eqv? 3 0) #t)
+               case: case selector is a constant: (case 3 ((0) #t))")
+  (lint-test "(case (list 1) ((0) #t))"
+	     " case: perhaps (case (list 1) ((0) #t)) -> (if (eqv? (list 1) 0) #t)
+               case: case selector may not work with eqv: (list 1)
+               case: case key 0 in ((0) #t) is pointless")
+  (lint-test "(case x (0))"		" case: bad case key 0 in (0)")
+  (lint-test "(case x ((0)))"		"") ; result can be null
+  (lint-test "(case x ((0) 1) ((1) 2) ((3 0) 4))" " case: repeated case key 0 in ((3 0) 4)")
+  (lint-test "(case x ((0) 1) ((1) 2) ((3 . 0) 4))" " case: stray dot in case case key list:  ((3 . 0) 4)")
+  (lint-test "(case x ((#(a)) 2))"
+	     " case: perhaps (case x ((#(a)) 2)) -> (if (eqv? x #(a)) 2)
+               case: case key #(a) in ((#(a)) 2) is unlikely to work (case uses eqv? but #(a) is a vector?)")
+  (lint-test "(case x ((+nan.0) 1) ((()) 2))" " case: case key +nan.0 in ((+nan.0) 1) is unlikely to work")
+;  (lint-test "(case x ((1 +nan.0) 2) ((+nan.0) 3) ((-nan.0) 4))" "")
+  (lint-test "(case x (else 2) ((0) 1))" " case: case else clause is not the last: ((else 2) ((0) 1))")
+  (lint-test "(case x ((0) 32) (else 32))" " case: perhaps (case x ((0) 32) (else 32)) -> 32")
+  (lint-test "(case (string->symbol x) ((a) 1) ((2 3) 3))" " case: case key 2 in ((2 3) 3) is pointless  case: case key 3 in ((2 3) 3) is pointless")
+  (lint-test "(case c ((a) b) (else (begin (display d) e)))"
+	     " case: perhaps (case c ((a) b) (else (begin (display d) e))) -> (if (eq? c 'a) b (begin (display d) e))
+               case: redundant begin: (begin (display d) e)")
+  (lint-test "(case x ((0) 32) ((1) 32))" "case: perhaps merge keys (1) with (0): (case x ((0) 32) ((1) 32)) -> (case x ((0 1) 32))")
+  (lint-test "(case x ((0) 32) (else (case x ((1) 32))))"
+	     " case: perhaps (case x ((0) 32) (else (case x ((1) 32)))) -> (if (eqv? x 0) 32 (case x ((1) 32)))
+               case: perhaps (case x ((1) 32)) -> (if (eqv? x 1) 32)
+               case: perhaps merge keys (1) with (0): (case x ((0) 32) (else (case x ((1) 32)))) -> (case x ((0 1) 32))")
+  (lint-test "(case x ((0) 32) (else (case x ((1) 32)) x))"
+	     " case: this could be omitted: (case x ((1) 32))
+               case: perhaps (case x ((1) 32)) -> (if (eqv? x 1) 32)")
+  (lint-test "(case x ((0) (display 1) 2) (else (display 1) 2))"
+	     " case: perhaps (case x ((0) (display 1) 2) (else (display 1) 2)) ->  (begin (display 1) 2)")
+  (lint-test "(case x (else (case x ((0) 1))))"
+	     " case: perhaps (case x ((0) 1)) -> (if (eqv? x 0) 1)
+               case: perhaps (case x (else (case x ((0) 1)))) -> (case x ((0) 1))")
+  (lint-test "(case x (else (case x (else 1))))" " case: perhaps (case x (else 1)) -> 1  case: perhaps (case x (else (case x (else 1)))) -> 1")
+  (lint-test "(case x ((0) 1) ((1 2) 1))"        " case: perhaps merge keys (1 2) with (0): (case x ((0) 1) ((1 2) 1)) -> (case x ((0 1 2) 1))")
+  (lint-test "(case x ((a b a) 1) ((c) 2))"      " case: repeated case key a in ((a b a) 1)")
+  (lint-test "(case x ((3) 2) ((4 8) 3) ((1) 3) ((0) 2))"
+	     " case: perhaps merge keys (1) with (4 8), (0) with (3):
+                (case x ((3) 2) ((4 8) 3) ((1) 3) ((0) 2)) -> (case x ((0 3) 2) ((1 4 8) 3))")
+  (lint-test "(case x ((#\\1) 2) ((#\\space #\\c) 3) ((#\\x) 3) ((#\\null) 2))"
+	     " case: perhaps merge keys (#\\x) with (#\\space #\\c), (#\\null) with (#\\1):
+                 (case x ((#\\1) 2) ((#\\space #\\c) 3) ((#\\x) 3) ((#\\null) 2)) -> (case x ((#\\null #\\1) 2) ((#\\space #\\c #\\x) 3))")
+  (lint-test "(case ((1) 1) (t 2))"     " case: bad case key t in (t 2)")
+  (lint-test "(case x ((a) #t) (else #f))"   " case: perhaps (case x ((a) #t) (else #f)) -> (eq? x 'a)")
+  (lint-test "(case x ((a b) #f) (else #t))" " case: perhaps (case x ((a b) #f) (else #t)) -> (not (memq x '(a b)))")
+  (lint-test "(case x ((1 2) #t) (else #f))" " case: perhaps (case x ((1 2) #t) (else #f)) -> (memv x '(1 2))")
+  (lint-test "(case x ((2) #f) (else #t))"   " case: perhaps (case x ((2) #f) (else #t)) -> (not (eqv? x 2))")
+  (lint-test "(case x ((1) y) ((2) z) (#t 3))" " case: bad case key #t in (#t 3)")
+  (lint-test "(case x ((a) y) ((b) z) (else (if (eq? x 'c) 32 (+ x 1))))"
+	     " case: perhaps (case x ((a) y) ((b) z) (else (if (eq? x 'c) 32 (+ x 1)))) -> (case x ((a) y) ((b) z) ((c) 32) (else (+ x 1)))")
+  (lint-test "(case x ((a) y) ((b) z) (else (if (eq? x 'c) 32)))"
+	     " case: perhaps (case x ((a) y) ((b) z) (else (if (eq? x 'c) 32))) -> (case x ((a) y) ((b) z) ((c) 32))")
+  (lint-test "(case x ((a) (+ y 1) z) ((b) (display x)) (else c))"
+	     " case: perhaps use => here: (case x ((a) (+ y 1) z) ((b) (display x)) (else c)) -> (case x ... ((b) => display) ...)
+               case: this could be omitted: (+ y 1)")
+  (lint-test "(begin (case x ((a) (+ y 1) z) ((b) (display x)) (else c)) (display x))"
+	     " begin: this case clause can be omitted: ((a) (+ y 1) z)
+               begin: this case clause can be omitted: (else c)
+               begin: perhaps use => here: (case x ((a) (+ y 1) z) ((b) (display x)) (else c)) -> (case x ... ((b) => display) ...)
+               begin: this could be omitted: (+ y 1)")
+  (lint-test "(case x (else 3))" " case: perhaps (case x (else 3)) -> 3")
+  (lint-test "(case x ((1) (+ x 1)) (else (+ x 3)))"
+	     " case: perhaps (case x ((1) (+ x 1)) (else (+ x 3))) -> (+ x (if (eqv? x 1) 1 3))")
+  (lint-test "(case x ((#\\a #\\b) (+ x 1)) (else (+ x 3)))"
+	     " case: perhaps (case x ((#\\a #\\b) (+ x 1)) (else (+ x 3))) -> (+ x (if (memv x '(#\\a #\\b)) 1 3))")
+  (lint-test "(case (+ x 1) ((1) (fx1 x y z)) ((2 3) (fx1 x y a)) (else (fx1 x y a b)))"
+	     " case: perhaps (case (+ x 1) ((1) (fx1 x y z)) ((2 3) (fx1 x y a)) (else (fx1 x y a b))) -> (fx1 x y (case (+ x 1) ((1) z) ((2 3) a) (else (values a b))))")
+  (lint-test "(case x ((symbol) (display x) (+ x 1)))" " case: perhaps (case x ((symbol) (display x) (+ x 1))) -> (when (eq? x 'symbol) (display x) (+ x 1))")
+  (lint-test "(case x ((:symbol) (display x) (+ x 1)))" " case: perhaps (case x ((:symbol) (display x) (+ x 1))) -> (when (eq? x :symbol) (display x) (+ x 1))")
+  (lint-test "(case x ((0) (log x 2)) ((1) (log x 3)) (else (error 'oops)))"
+	     " case: perhaps (case x ((0) (log x 2)) ((1) (log x 3)) (else (error 'oops))) -> (log x (case x ((0) 2) ((1) 3) (else (error 'oops))))")
+  (lint-test "(case x ((a) (f y z)) (else (g y z)))" " case: perhaps (case x ((a) (f y z)) (else (g y z))) -> ((if (eq? x 'a) f g) y z)")
+  (lint-test "(case x ((a b) (f y z)) (else (g y z)))" " case: perhaps (case x ((a b) (f y z)) (else (g y z))) -> ((case x ((a b) f) (else g)) y z)")
+  (lint-test "(case x ((a) (f y a)) (else (f y z)))" " case: perhaps (case x ((a) (f y a)) (else (f y z))) -> (f y (if (eqv? x a) a z))")
+
+  (lint-test "(case (abs x) ((integer?) 1) ((x) 2) ((1) 3))"
+	      "case: case key integer? in ((integer?) 1) is pointless
+               case: case key x in ((x) 2) is pointless")
+  (lint-test "(case (floor x) ((1 2) 3) ((a b) 4))"
+	     " case: case key a in ((a b) 4) is pointless
+               case: case key b in ((a b) 4) is pointless")
+  (lint-test "(define (f x) (case x ((0 0.0) 32) ((0.5 1/2) 54) ((0+i 1) 12)))" "")
+  (lint-test "(define (g x) (case x ((-0 0) 0) ((+inf.0) 1)))" "g: repeated case key 0 in ((0 0) 0)")
+  (lint-test "(define (h x) (case x ((-0 -0.0) 1) ((1 3/3) 32)))" " h: repeated case key 1 in ((1 1) 32)")
+
+  (lint-test "(if (not sym) (set! sym (eqv-selector p)) (equal? sym (eqv-selector p)))" "")
+  (lint-test "(cond (X (f y z)) (else (set! y z)))" "")
+  (lint-test "(case x ((a) (set! y z)) (else (g y z)))" " case: perhaps (case x ((a) (set! y z)) (else (g y z))) -> (if (eq? x 'a) (set! y z) (g y z))")
+  (lint-test "(case (pair? x) ((#f) y) (else z))" " case: perhaps (case (pair? x) ((#f) y) (else z)) -> (if (not (pair? x)) y z)")
+  (lint-test "(case x ((#f) y) (else z))" " case: perhaps (case x ((#f) y) (else z)) -> (if (not x) y z)")
+
+  (lint-test "(case arg-count
+                ((0) (call-case 0))
+                ((1) (call-case 1))
+                ((2) (call-case 2))
+                ((3) (call-case 3))
+                ((4) (call-case 4))
+                ((5) (call-case 5))
+                ((6) (call-case 6))
+                (else 12))"
+	     " case: perhaps use => here: (case arg-count ((0) (call-case 0)) ((1) (call-case 1)) ((2) (call-case... ->
+                (case arg-count ((0 1 2 3 4 5 6) => call-case) ...)")
+  (lint-test "(case x ((0) (f 0)) ((1) z) (else y))"
+	     " case: perhaps use => here: (case x ((0) (f 0)) ((1) z) (else y)) -> (case x ((0) => f) ...)")
+  (lint-test "(case x ((0) (f 0)) ((1) z) ((2) (f 2)) (else y))"
+	     " case: perhaps use => here: (case x ((0) (f 0)) ((1) z) ((2) (f 2)) (else y)) -> (case x ((0 2) => f) ...)")
+  (lint-test "(case x ((0) (f 0)) ((1) z) ((2) (f 2)))"
+	     " case: perhaps use => here: (case x ((0) (f 0)) ((1) z) ((2) (f 2))) -> (case x ((0 2) => f) ...)")
+  (lint-test "(case x ((3) (g 3)) ((0) (f 0)) ((1) z) ((2) (f 2)))"
+	     " case: perhaps use => here: (case x ((3) (g 3)) ((0) (f 0)) ((1) z) ((2) (f 2))) -> (case x ((3) => g) ((0 2) => f) ...)")
+  (lint-test "(case x ((3) (f 3)) ((0) (f 0)) ((2) (f 2)))"
+	     " case: perhaps use => here: (case x ((3) (f 3)) ((0) (f 0)) ((2) (f 2))) -> (case x ((3 0 2) => f))")
+  (lint-test "(case x ((3) (f 3)) ((0) (f x)) ((2) (f 2)))"
+	     " case: perhaps use => here: (case x ((3) (f 3)) ((0) (f x)) ((2) (f 2))) -> (case x ((3 0 2) => f))")
+  (lint-test "(case x ((1 2 3) (f x)) ((0) (f x)) ((4) (f 4)))"
+	     " case: perhaps use => here: (case x ((1 2 3) (f x)) ((0) (f x)) ((4) (f 4))) -> (case x ((1 2 3 0 4) => f))
+               case: perhaps merge keys (0) with (1 2 3): (case x ((1 2 3) (f x)) ((0) (f x)) ((4) (f 4))) -> (case x ((0 1 2 3) (f x)) ((4) (f 4)))")
+  (lint-test "(case x ((0 1) (abs x)))"
+	     " case: perhaps use => here: (case x ((0 1) (abs x))) -> (case x ((0 1) => abs))
+               case: perhaps (case x ((0 1) (abs x))) -> (if (memv x '(0 1)) (abs x))")
+  (lint-test "(case i ((x) x) ((y) y) ((z) z))"
+	     " case: perhaps use => here: (case i ((x) x) ((y) y) ((z) z)) -> (case i ((x y z) => symbol->value))")
+  (lint-test "(case selector ((add-external!) add-external!) ((defun!) defun!) ((depgraph) depgraph) ((a) 1) (else 'oops))"
+	     " case: perhaps use => here: (case selector ((add-external!) add-external!) ((defun!) defun!)... ->
+                 (case selector ((add-external! defun! depgraph) => symbol->value) ...)")
+
+  (lint-test "(case x ((0) 0) ((1 2) x) (else x))"
+	     " case: in ((0) 0), the result can be omitted
+               case: in ((1 2) x), the result can be omitted
+               case: in (else x), the result can be omitted
+               case: perhaps (case x ((0) 0) ((1 2) x) (else x)) -> (case x ((0) 0) (else x))")
+
+  (lint-test "(begin (if (= x 1) (display y)) (if (= x 2) (f y)) (if (= x 3) (display z)) (f x))"
+	     " begin: perhaps (... (if (= x 1) (display y)) (if (= x 2) (f y)) ...) ->
+                 (case x ((1) (display y)) ((2) (f y)) ((3) (display z)))")
+  (lint-test "(begin (if (eq? x 'a) (display y)) (if (eqv? x 2) (f y)) (if (char=? x #\\3) (display z)) (f x))"
+	     " begin: perhaps (... (if (eq? x 'a) (display y)) (if (eqv? x 2) (f y)) ...) ->
+                 (case x ((a) (display y)) ((2) (f y)) ((#\\3) (display z)))")
+  (lint-test "(let ((x 2)) (case y ((A) B) ((C D) => (lambda (m) (+ m x)))))"
+	     " let: perhaps move the let into the '((C D) => (lambda (m) (+ m x))) branch:
+                 (let ((x 2)) (case y ((A) B) ((C D) => (lambda (m) (+ m x))))) ->
+                 (case y ... ((C D) => (let ((x 2)) (lambda (m) (+ m x)))) ...)")
+
+  (lint-test "(do ())"			" do: do is messed up:  (do ())")
+  (lint-test "(do () ())"		" do: infinite loop: (do () ())")
+  (lint-test "(do () (#f))"		" do: infinite loop: (do () (#f))")
+  (lint-test "(do () (#f) (+ x 2))"	" do: infinite loop: (do () (#f) (+ x 2)) do: this could be omitted: (+ x 2)")
+  (lint-test "(call-with-exit (lambda (quit) (do () () (quit))))" "")
+  (lint-test "(call-with-exit (lambda (quit) (do ((i 0 (quit))) ())))" "")
+  (lint-test "(do ((x 2) y) ())"	" do: do binding is not a list? y do: x not used, initially: 2 from do")
+  (lint-test "(do ((x 2 1)) () x)"	" do: this could be omitted: x")
+  (lint-test "(do ((x 2 1)) () (display 1))" " do: x set, but not used: 2 from do")
+  (lint-test "(do ((x 2)) () (display 1))" " do: x not used, initially: 2 from do")
+  (lint-test "(do ((i 0 (+ i 1))) ((+ i 10) i))" " do: end test is never false: (+ i 10)")
+  (lint-test "(do ((i 0 (+ i 1))) (#f i))" " do: result is unreachable: (#f i)")
+  (lint-test "(do ((i 0 (+ i 0))) ((= i 10) i))" " do: perhaps (+ i 0) -> i")
+  (lint-test "(do ((i 0 (+ i 1))) ((= i 0)) (display i))"
+	     " do: do is a no-op because (= i 0) is true at the start: (do ((i 0 (+ i 1))) ((= i 0)) (display i))")
+  (lint-test "(do ((i 0 (+ i 1))) ((>= 0 i)) (display i))"
+	     " do: do is a no-op because (>= 0 i) is true at the start: (do ((i 0 (+ i 1))) ((>= 0 i)) (display i))")
+  (lint-test "(do ((i 0 (+ i 1))) ((= i 1)) (display i))" " do: do is unnecessary: (do ((i 0 (+ i 1))) ((= i 1)) (display i))")
+  (lint-test "(do ((i 0 (+ i 1))) ((= 1 i)) (display i))" " do: do is unnecessary: (do ((i 0 (+ i 1))) ((= 1 i)) (display i))")
+  (lint-test "(do ((i 0 (+ i 1))) ((= i len)) (string-set! s i #\\a))"
+	     " do: perhaps (do ((i 0 (+ i 1))) ((= i len)) (string-set! s i #\\a)) ->  (fill! s #\\a 0 len)")
+  (lint-test "(do ((i 2 (+ i 1))) ((= i len)) (string-set! s i #\\a))"
+	     " do: perhaps (do ((i 2 (+ i 1))) ((= i len)) (string-set! s i #\\a)) -> (fill! s #\\a 2 len)")
+  (lint-test "(do ((i 2 (+ i 10))) ((= i len)) (string-set! s i #\\a))" "")
+
+  (lint-test "(do ((i 0 (+ i 1))) ((= i len)) (vector-set! v0 i (vector-ref v1 i)))"
+	     " do: perhaps (do ((i 0 (+ i 1))) ((= i len)) (vector-set! v0 i (vector-ref v1 i))) ->  (copy v1 v0 0 len)")
+  (lint-test "(do ((x 0 (+ x 1)))  ((>= x c) #f) (vector-set! array x (list-ref cells x)))"
+	     " do: perhaps (do ((x 0 (+ x 1))) ((>= x c) #f) (vector-set! array x (list-ref cells x))) -> (copy cells array 0 c)")
+  (lint-test "(do ((i start (- i 1))) ((< i 0)) (string-set! s i (string-ref t i)))"
+	     " do: perhaps (do ((i start (- i 1))) ((< i 0)) (string-set! s i (string-ref t i))) -> (copy t s 0 (+ start 1))")
+  (lint-test "(do ((i (- (length t) 1) (- i 1))) ((negative? i)) (string-set! s i (string-ref t i)))"
+	     " do: perhaps (do ((i (- (length t) 1) (- i 1))) ((negative? i)) (string-set! s i... -> (copy t s)")
+  (lint-test "(do ((i (- end 1) (- i 1))) ((< i 1)) (float-vector-set! s i (float-vector-ref t i)))"
+	     " do: perhaps (do ((i (- end 1) (- i 1))) ((< i 1)) (float-vector-set! s i... -> (copy t s 1 end)")
+
+  (lint-test "(do ((i 0 (+ 1 1))) ((= i 3) z))" " do: perhaps (+ 1 1) -> 2")
+  (lint-test "(do ((x lst (cdr lst))) ((null? x) y))" " do: this looks suspicious: (x lst (cdr lst))")
+  (lint-test "(do ((i 0 (+ i 1))) ((>= i len)) (display i))" "")
+  (lint-test "(do ((i 0 (+ i 1))) ((< i len)) (display i))" " do: do step looks like it doesn't match end test: (+ i 1) -> (< i len)")
+  (lint-test "(do ((i 0 (- i 1))) ((<= i len)) (display i))" "")
+  (lint-test "(do ((i 0 (- i 1))) ((> i len)) (display i))" " do: do step looks like it doesn't match end test: (- i 1) -> (> i len)")
+  (lint-test "(do ((i 0 (+ i 1))) (= i 10) (display i))"
+	     "do: this could be omitted: i
+              do: perhaps missing parens: (= i 10)
+              do: do is a no-op because = is true at the start: (do ((i 0 (+ i 1))) (= i 10) (display i))
+              do: strange do end-test: = in (= i 10) is a procedure")
+  (lint-test "(do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 10)) (display i))" " do: j set, but not used: 0 from do")
+  (lint-test "(let ((x #t)) (do ((i 0 (+ i 1))) (x) (display i)))"
+	     " let: perhaps (let ((x #t)) (do ((i 0 (+ i 1))) (x) (display i))) -> (do ((x #t) (i 0 (+ i 1))) ...)")
+  (lint-test "(do ((i 0 (display i))) ((x y) z))" "")
+  (lint-test "(do ((i 0 (+ i 1))) (abs i) (display i))"
+	     " do: do is a no-op because abs is true at the start: (do ((i 0 (+ i 1))) (abs i) (display i))
+	       do: strange do end-test: abs in (abs i) is a procedure")
+  (lint-test "(begin (do ((i 0 (+ i 1))) ((= i 10) i) (display i)) x)"
+	     " begin: perhaps (begin (do ((i 0 (+ i 1))) ((= i 10) i) (display i)) x) -> (do ((i 0 (+ i 1))) ((= i 10) i x) (display i))
+               begin: (do ((i 0 (+ i 1))) ((= i 10) i) (display i)): result i is not used")
+  (lint-test "(do ((p (list 1) (cdr p))) ((null? p)) (display p))" " do: do is unnecessary: (do ((p (list 1) (cdr p))) ((null? p)) (display p))")
+  (lint-test "(do ((p (list 1) (cdr p))) ((null? p)) (set! y (log z 2)) (do ((z z (+ z 1))) ((= z 0)) (display z)) (display x))"
+	     " do: do is unnecessary: (do ((p (list 1) (cdr p))) ((null? p)) (set! y (log z 2)) (do ((z z (+ z...
+               do: perhaps (do ((p (list 1) (cdr p))) ((null? p)) (set! y (log z 2)) (do ((z z (+ z... ->
+                 (for-each (lambda ([p]) (set! y (log z 2)) (do ((z z (+ z 1))) ((= z 0)) (display z)) (display x)) (list 1))")
+  (lint-test "(do ((i 0 (+ i 1))) ((= i 3) ()) (display i))" "")
+  (lint-test "(do ((x y (cdr x))) ((null? x)) (let ((y x)) (car y)))"
+             " do: this do-loop could probably be replaced by the end test in a let: (do ((x y (cdr x))) ((null? x)) (let ((y x)) (car y)))
+               do: this could be omitted: (let ((y x)) (car y)) do: perhaps (let ((y x)) (car y)) -> (car x)")
+  (lint-test "(do ((i 0 (+ i 1))) ((= i 3) ()))" " do: this do-loop could be replaced by (): (do ((i 0 (+ i 1))) ((= i 3) ()))")
+  (lint-test "(do ((i 0 (+ i 1))) ((= i 3) #t))"
+	     " do: this do-loop could be replaced by #t: (do ((i 0 (+ i 1))) ((= i 3) #t))
+               do: return value is redundant: ((= i 3) #t)")
+  (lint-test "(do ((i 0 (+ i 1))) ((vector-ref v i) (vector-ref v i)))" " do: return value is redundant: ((vector-ref v i) (vector-ref v i))")
+  (lint-test "(do ((i 0 (+ i 1))) ((= i 3) (not (= i 3))) (display i))" " do: perhaps use => here: ((= i 3) (not (= i 3))) -> ((= i 3) => not)")
+
+  (lint-test "(begin (do ((i 0 (+ i 1))) ((= i 3)) (display i)) 32)"
+	     " begin: perhaps (begin (do ((i 0 (+ i 1))) ((= i 3)) (display i)) 32) -> (do ((i 0 (+ i 1))) ((= i 3) 32) (display i))")
+  (lint-test "(begin (do ((i 0 (+ i 1))) ((= i 3) (display x)) (display i)) 32)"
+	     " begin: perhaps (begin (do ((i 0 (+ i 1))) ((= i 3) (display x)) (display i)) 32) ->
+                 (do ((i 0 (+ i 1))) ((= i 3) (display x) 32) (display i))")
+  (lint-test "(begin (do () ((= i 3)) (display i)) 32)" " begin: perhaps (begin (do () ((= i 3)) (display i)) 32) -> (do () ((= i 3) 32) (display i))")
+  (lint-test "(let ((x 2)) (do ((x 0 (+ x 1))) ((= x 2)) (display x)) (display x))" "") ; x shadowed if moved into do
+
+  (lint-test "(let ((xx 0)) (do ((x 1 (+ x 1)) (y x (- y 1))) ((= x 3) xx) (display y)))"
+	     " let: x in (y x (- y 1)) does not appear to be defined in the calling environment
+               let: perhaps (let ((xx 0)) (do ((x 1 (+ x 1)) (y x (- y 1))) ((= x 3) xx) (display y))) -> (do ((xx 0) (x 1 (+ x 1)) (y x (- y 1))) ...)")
+  (lint-test "(let ((x 0)) (do ((x 1 (+ x 1)) (y x (- y 1))) ((= x 3)) (display y)))"
+	     " let: x in (y x (- y 1)) refers to the caller's x, not the do-loop variable")
+  (lint-test "(let ((x 0)) (do ((x x (+ x 1)) (y x (- y 1))) ((= x 3)) (display y)))" "")
+  (lint-test "(let ((a 1) (b 2)) (do ((x a (+ x 1)) (y (+ b 1) (+ y 1))) ((= i 3)) (display (+ x y))))"
+	     " let: perhaps (let ((a 1) (b 2)) (do ((x a (+ x 1)) (y (+ b 1) (+ y 1))) ((= i 3))... -> (do ((x 1 (+ x 1)) (y (+ 2 1) (+ y 1))) ...)")
+  (lint-test "(let ((a 1)) (do ((i a (+ i 1))) ((= i 3)) (display i)))"
+	     " let: perhaps (let ((a 1)) (do ((i a (+ i 1))) ((= i 3)) (display i))) -> (do ((i 1 (+ i 1))) ...)")
+  (lint-test "(let ((a 1)) (do ((i a (+ i 1)) (j 0 (+ j 1))) ((= i 3)) (display (+ i j))))"
+	     " let: perhaps (let ((a 1)) (do ((i a (+ i 1)) (j 0 (+ j 1))) ((= i 3)) (display (+ i j)))) -> (do ((i 1 (+ i 1)) (j 0 (+ j 1))) ...)")
+  (lint-test "(let ((a 1)) (do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 3)) (display (+ a i j))))"
+	     " let: perhaps (let ((a 1)) (do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 3)) (display (+ a i j)))) -> (do ((a 1) (i 0 (+ i 1)) (j 0 (+ j 1))) ...)")
+  (lint-test "(let ((a 1)) (do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 3)) (display (+ a i j))) 32)"
+	     " let: perhaps (let ((a 1)) (do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 3)) (display (+ a i... -> (do ((a 1) (i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 3) 32) ...)")
+  (lint-test "(do ((i 0 (+ i j)) (j 0 (+ j 1))) ((= i 10)) (display i))"  ; displays 00136
+	     " do: perhaps (do ((i 0 (+ i j)) (j 0 (+ j 1))) ((= i 10)) (display i)) ->
+                 (do ((i 0) (j 0 (+ j 1))) ((= i 10)) (display i) (set! i (+ i j)))")
+  (lint-test "(do ((i 0 j) (j 0 (+ j 1))) ((= i 2)) (display i))"
+	     " do: perhaps (do ((i 0 j) (j 0 (+ j 1))) ((= i 2)) (display i)) ->
+                (do ((i 0) (j 0 (+ j 1))) ((= i 2)) (display i) (set! i j))")
+  (lint-test "(do ((i 0 (+ i 1)) (j 1)) ((= i 3)) (display (+ i j)) (set! j (+ j 1)))"
+	     " do: perhaps move (set! j (+ j 1)) to j's step expression: (j 1 (+ j 1))")
+  (lint-test "(do ((i 0 (+ i 1)) (j 1)) ((= i 3)) (display (+ i j)) (set! j (+ j i)))" "")
+  (lint-test "(do ((i 0 (+ i 1)) (j 1 (+ j 1))) ((= i 3)) (display (+ i j)) (set! j (+ j 1)))"
+	     " do: perhaps move (set! j (+ j 1)) to j's step expression: (j 1 (+ 2 j))")
+  (lint-test "(do ((i 0 (+ i 1)) (j 1 0)) ((= i 3)) (display (+ i j)) (set! j (+ j i)))"
+	     " do: this set! is pointless: (set! j (+ j i))")
+  (lint-test "(do ((i 0 (+ i 1)) (j 1 0)) ((= i 3)) (display (+ i j)) (set! j (display (+ j i))))"
+	      " do: this set! is pointless: (set! j (display (+ j i))); perhaps replace it with (display (+ j i))")
+  (lint-test "(do ((i 0 (+ i j)) (j 0 (+ k 1)) (k 1)) ((= i 10)) (display (+ i j k)))"
+	     " do: perhaps (do ((i 0 (+ i j)) (j 0 (+ k 1)) (k 1)) ((= i 10)) (display (+ i j k))) ->
+                (do ((i 0) (j 0) (k 1)) ((= i 10)) (display (+ i j k)) (set! i (+ i j)) (set! j (+ k 1)))")
+  (lint-test "(do ((i 0 j) (j 1 i) (k 0 (+ k 1))) ((= k 4)) (display (+ i j)))"
+	     " do: this do loop is unreadable; perhaps (do ((i 0 j) (j 1 i) (k 0 (+ k 1))) ((= k 4)) (display (+ i j))) ->
+    (let <1> ((i 0)
+              (j 1)
+              (k 0))
+      (if (= k 4)
+          ()
+          (begin
+            (display (+ i j))
+            (<1> j i (+ k 1)))))")
+  (lint-test "(do ((i 0 j) (j 1 i) (k 0 (+ k 1))) ((= k 5) (set! x k) (+ k 1)) (display (+ i j)))"
+	     " do: this do loop is unreadable; perhaps (do ((i 0 j) (j 1 i) (k 0 (+ k 1))) ((= k 5) (set! x k) (+ k 1)) (display... ->
+    (let <1> ((i 0)
+              (j 1)
+              (k 0))
+      (if (= k 5)
+          (begin
+            (set! x k)
+            (+ k 1))
+          (begin
+            (display (+ i j))
+            (<1> j i (+ k 1)))))")
+  (lint-test "(do ((i 0 (+ i 1))) ((= i 3)) (let ((a 12)) (set! a (+ a i)) (display a)))"
+	     " do: perhaps (let ((a 12)) (set! a (+ a i)) (display a)) -> (let ((a (+ 12 i))) (display a))
+	       do: perhaps (do ((i 0 (+ i 1))) ((= i 3)) (let ((a 12)) (set! a (+ a i)) (display a))) ->
+                (do ((i 0 (+ i 1)) (a 12 12)) ((= i 3)) (set! a (+ a i)) ...)")
+  (lint-test "(do ((i 0 (+ i 1))) ((= i 3)) (let () (set! a (+ a i)) (display a)))"
+	     " do: pointless let: (let () (set! a (+ a i)) (display a))
+               do: perhaps (do ((i 0 (+ i 1))) ((= i 3)) (let () (set! a (+ a i)) (display a))) ->
+                (do ((i 0 (+ i 1))) ((= i 3)) (set! a (+ a i)) ...)")
+  (lint-test "(do () ((= i 3)) (let ((a 12)) (set! a (+ a i)) (display a)))"
+	     " do: perhaps (let ((a 12)) (set! a (+ a i)) (display a)) -> (let ((a (+ 12 i))) (display a))
+	       do: perhaps (do () ((= i 3)) (let ((a 12)) (set! a (+ a i)) (display a))) ->
+                (do ((a 12 12)) ((= i 3)) (set! a (+ a i)) ...)")
+  (lint-test "(do ((i 0 (+ i 1))) ((= i 3)) (let ((j (abs x))) (display (+ i j (* 2 j)))))"
+	     " do: perhaps (do ((i 0 (+ i 1))) ((= i 3)) (let ((j (abs x))) (display (+ i j (* 2 j))))) ->
+                 (do ((i 0 (+ i 1)) (j (abs x) (abs x))) ((= i 3)) (display (+ i j (* 2 j))))")
+  (lint-test "(do ((i 0 (+ i 1))) ((= i 3)) (let ((a 12) (b 1)) (set! a (+ a b i)) (display a)))"
+	     " do: perhaps combine these two lines: (set! a (+ a b i)) (display a)
+               do: perhaps (do ((i 0 (+ i 1))) ((= i 3)) (let ((a 12) (b 1)) (set! a (+ a b i))... ->
+                (do ((i 0 (+ i 1)) (a 12 12) (b 1 1)) ((= i 3)) (set! a (+ a b i)) ...)")
+  (lint-test "(do ((i 0 j) (j 1 i) (k 0 (+ k 1))) ((= k 4) (+ i j k)))"
+	     " do: this do loop is unreadable; perhaps (do ((i 0 j) (j 1 i) (k 0 (+ k 1))) ((= k 4) (+ i j k))) ->
+                 (let <1> ((i 0) (j 1) (k 0)) (if (= k 4) (+ i j k) (<1> j i (+ k 1))))")
+  (lint-test "(let ((x (log y))) (do ((i 0 (+ i 1))) ((= i 3)) (display (+ i x))) (abs y))"
+	     " let: perhaps (let ((x (log y))) (do ((i 0 (+ i 1))) ((= i 3)) (display (+ i x))) (abs y)) ->
+                 (do ((x (log y)) (i 0 (+ i 1))) ((= i 3) (abs y)) ...)")
+  (lint-test "(let ((x (log y))) (do ((i 0 (+ i 1))) ((= i 3)) (display (+ i x))) (abs x))"
+	     " let: perhaps (let ((x (log y))) (do ((i 0 (+ i 1))) ((= i 3)) (display (+ i x))) (abs x)) ->
+                 (do ((x (log y)) (i 0 (+ i 1))) ((= i 3) (abs x)) ...)")
+  (lint-test "(let ((x (log y))) (do ((i 0 (+ i x))) ((= i 3)) (display i)))"
+	     " let: perhaps (let ((x (log y))) (do ((i 0 (+ i x))) ((= i 3)) (display i))) ->
+                 (do ((x (log y)) (i 0 (+ i x))) ...)")
+  (lint-test "(let ((x (log y))) (do ((i 0 (+ i 1))) ((= i 3) x) (display i)))"
+	     " let: perhaps (let ((x (log y))) (do ((i 0 (+ i 1))) ((= i 3) x) (display i))) ->
+                 (do ((x (log y)) (i 0 (+ i 1))) ...)")
+  (lint-test "(let ((x (log y))) (do ((i 0 (+ i 1))) ((= i 3)) (display x)))"
+	     " let: perhaps (let ((x (log y))) (do ((i 0 (+ i 1))) ((= i 3)) (display x))) ->
+                 (do ((x (log y)) (i 0 (+ i 1))) ...)")
+  (lint-test "(let ((x (log y))) (do () ((= i 3)) (display x)))"
+	     " let: perhaps (let ((x (log y))) (do () ((= i 3)) (display x))) -> (do ((x (log y))) ...)")
+  (lint-test "(let ((x (log y)) (z (log w))) (do () ((= i 3)) (display x)) (display x) (cdr v))"
+	     " let: z not used, initially: (log w) from let")
+  (lint-test "(let ((x (log y))) (do ((x 0 (+ x 1))) ((= i 3)) (display x)))"
+	     " let: x not used, initially: (log y) from let")
+  (lint-test "(let ((a 1)) (do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 3)) (display (+ a i j))) 32)"
+	     " let: perhaps (let ((a 1)) (do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 3)) (display (+ a i... ->
+                 (do ((a 1) (i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 3) 32) ...)")
+  (lint-test "(let ((x (length y))) (do ((i 0 (+ i 1))) ((= i x)) (display i)))"
+	     " let: perhaps (let ((x (length y))) (do ((i 0 (+ i 1))) ((= i x)) (display i))) -> (do ((x (length y)) (i 0 (+ i 1))) ...)")
+  (lint-test "(let ((x (length y))) (do ((i 0 (+ i 1))) ((= i x) (display x)) (display i)) (log x))"
+	     " let: perhaps (let ((x (length y))) (do ((i 0 (+ i 1))) ((= i x) (display x)) (display... ->
+                  (do ((x (length y)) (i 0 (+ i 1))) ((= i x) (display x) (log x)) ...)")
+
+  (lint-test "(do ((p lst (cdr p))) ((null? p)) (display (car p)))"
+	     " do: perhaps (do ((p lst (cdr p))) ((null? p)) (display (car p))) -> (for-each (lambda ([p]) (display [p])) lst)")
+  (lint-test "(do ((p lst (cdr p))) ((not (pair? p))) (if (cadar p) (display (cdddar p))))"
+	     " do: perhaps (do ((p lst (cdr p))) ((not (pair? p))) (if (cadar p) (display (cdddar p)))) ->
+                 (for-each (lambda ([p]) (if (cadr [p]) (display (cdddr [p])))) lst)")
+  (lint-test "(do ((i 0 (+ i 1))) ((= i (vector-length x))) (find (vector-ref x i)))"
+	     " do: perhaps (do ((i 0 (+ i 1))) ((= i (vector-length x))) (find (vector-ref x i))) -> (for-each (lambda ([x]) (find [x])) x)")
+  (lint-test "(let ((n (length v))) (do ((j 0 (+ j 1))) ((= j n)) (let ((x (vector-ref v j))) (f (car x) (cdr x)))))"
+	     " let: perhaps (do ((j 0 (+ j 1))) ((= j n)) (let ((x (vector-ref v j))) (f (car x) (cdr x)))) ->
+                 (for-each (lambda ([v]) (let ((x [v])) (f (car x) (cdr x)))) v)
+               let: perhaps (let ((n (length v))) (do ((j 0 (+ j 1))) ((= j n)) (let ((x (vector-ref v... ->
+                 (do ((n (length v)) (j 0 (+ j 1))) ...)")
+  (lint-test "(do ((dist 0.01) (i 0 (+ i 1)) (beg2 (+ beg 2.36) (+ beg2 dist)) (af .1 (* af .85))) ((= i 20)) (savannah-8 beg2 (* amp af)) (set! dist (+ dist .001)))"
+	     " do: perhaps (do ((dist 0.01) (i 0 (+ i 1)) (beg2 (+ beg 2.36) (+ beg2 dist)) (af 0.1... ->
+                 (do ((dist 0.01) (i 0 (+ i 1)) (beg2 (+ beg 2.36)) (af 0.1 (* af 0.85))) ((= i 20))
+                     (savannah-8 beg2 (* amp af)) (set! dist (+ dist 0.001)) (set! beg2 (+ beg2 dist)))")
+  (lint-test "(do ((r ()) (i 0 (+ i 1))) ((= i 3) r) (set! r (append r (list i))))"
+	     " do: perhaps (set! r (append r ...)) -> (set! r (cons ... r)), reversing r at the end")
+
+  (lint-test "(do ((j m (- j 1)) (a '() (cons '() a))) ((= j 0) a))"
+	     " do: quote is not needed here: '() do: quote is not needed here: '()
+               do: perhaps (do ((j m (- j 1)) (a '() (cons '() a))) ((= j 0) a)) -> (make-list m '())")
+  (lint-test "(do ((j 0 (+ 1 j)) (a () (cons () a))) ((>= j 10) a))"
+	     " do: perhaps (do ((j 0 (+ 1 j)) (a () (cons () a))) ((>= j 10) a)) -> (make-list 10 ())")
+  (lint-test "(do ((j 10 (- j 1)) (a () (cons 1 a))) ((<= j 3) a))"
+	     " do: perhaps (do ((j 10 (- j 1)) (a () (cons 1 a))) ((<= j 3) a)) -> (make-list 7 1)")
+  (lint-test "(do ((j 10 (- 1 j)) (a () (cons () a))) ((<= j 3) a))"
+	     " do: do is unnecessary: (do ((j 10 (- 1 j)) (a () (cons () a))) ((<= j 3) a))")
+  (lint-test "(do ((j m (- j 1)) (a () (cons () a))) ((< j 0) a))"
+	     " do: perhaps (do ((j m (- j 1)) (a () (cons () a))) ((< j 0) a)) -> (make-list (+ m 1) ())")
+  (lint-test "(do ((j 0 (+ 1 j)) (a () (cons () a))) ((> j 10) a))"
+	     " do: perhaps (do ((j 0 (+ 1 j)) (a () (cons () a))) ((> j 10) a)) -> (make-list 11 ())")
+  (lint-test "(do ((j 0 (+ 1 j)) (a () (cons () a))) ((> j len) a))"
+	     " do: perhaps (do ((j 0 (+ 1 j)) (a () (cons () a))) ((> j len) a)) -> (make-list (+ len 1) ())")
+  (lint-test "(do ((j 10 (- j 1)) (a () (cons () a))) ((< j 0) a))"
+	     " do: perhaps (do ((j 10 (- j 1)) (a () (cons () a))) ((< j 0) a)) -> (make-list 11 ())")
+  (lint-test "(do ((j 10 (- j 1)) (a (list) (cons 'abs a))) ((< j 0) a))"
+	     " do: perhaps (list) -> (); there is only one nil
+               do: perhaps (do ((j 10 (- j 1)) (a (list) (cons 'abs a))) ((< j 0) a)) -> (make-list 11 'abs)")
+  (lint-test "(do ((i (- end 1) (- i 1)) (ans () (cons (string-ref s i) ans))) ((< i start) ans))"
+	     " do: perhaps (do ((i (- end 1) (- i 1)) (ans () (cons (string-ref s i) ans))) ((< i... ->
+                 (do ((i (- end 1) (- i 1)) (ans ())) ((< i start) ans) (set! ans (cons (string-ref s i) ans)))
+               do: perhaps (do ((i (- end 1) (- i 1)) (ans () (cons (string-ref s i) ans))) ((< i start) ans)) -> string->list")
+  (lint-test "(do ((i 10 (- i 1)) (ans () (cons (vector-ref s i) ans))) ((< i 0) ans))"
+	     " do: perhaps (do ((i 10 (- i 1)) (ans () (cons (vector-ref s i) ans))) ((< i 0) ans)) ->
+                 (do ((i 10 (- i 1)) (ans ())) ((< i 0) ans) (set! ans (cons (vector-ref s i) ans)))
+               do: perhaps (do ((i 10 (- i 1)) (ans () (cons (vector-ref s i) ans))) ((< i 0) ans)) -> vector->list")
+  (lint-test "(do ((k r (- k 1)) (r () (cons (vector-ref v (- k 1)) r))) ((= k 10) r))"
+	     "do: perhaps (do ((k r (- k 1)) (r () (cons (vector-ref v (- k 1)) r))) ((= k 10) r)) ->
+                (do ((k r (- k 1)) (r ())) ((= k 10) r) (set! r (cons (vector-ref v (- k 1)) r)))
+              do: perhaps (do ((k r (- k 1)) (r () (cons (vector-ref v (- k 1)) r))) ((= k 10) r)) -> vector->list")
+  (lint-test "(do ((i (- len 1) (- i 1)) (result () (cons (f (vector-ref v i)) result))) ((negative? i) result))"
+	     " do: perhaps (do ((i (- len 1) (- i 1)) (result () (cons (f (vector-ref v i)) result)))... ->
+                (do ((i (- len 1) (- i 1)) (result ())) ((negative? i) result) (set! result (cons (f (vector-ref v i)) result)))
+               do: perhaps (do ((i (- len 1) (- i 1)) (result () (cons (f (vector-ref v i)) result))) ((negative? i) result)) -> (map f v)")
+  (lint-test "(do ((ds () (cons d ds)) (d 0 (+ d 1))) ((= d r) ds))"
+	     " do: perhaps (do ((ds () (cons d ds)) (d 0 (+ d 1))) ((= d r) ds)) ->
+                (do ((ds ()) (d 0 (+ d 1))) ((= d r) ds) (set! ds (cons d ds)))")
+
+  (lint-test "(define (f x y) (do ((i 0 (+ i 1))) ((= i 10)) (display (* x y i))))"
+	     " f: (* x y) in (* x y i) is constant in the do loop")
+  (lint-test "(define (f1 x y) (do ((i 0 (+ i 1))) ((= i 10)) (display (- x y i))))"
+	     " f1: (- x y) in (- x y i) is constant in the do loop")
+  (lint-test "(define (f2 x y) (do ((i 0 (+ i 1))) ((= i 10)) (display (* i 12 (+ x y)))))"
+	     " f2: (* 12 (+ x y)) in (* i 12 (+ x y)) is constant in the do loop")
+  (lint-test "(define (f3 x y) (do ((i 0 (+ i 1))) ((= i 10)) (display (* i 12 (random x)))))" "")
+  (lint-test "(define (f4 x y) (do ((i 0 (+ i 1))) ((= i 10)) (display (* i 12 (eval x)))))" "")
+  (lint-test "(define (g x) (do ((i 0 (+ i 1))) ((= i 10)) (display (abs x))))" "")
+  (lint-test "(define (g2 y) (do ((i 0 (+ i 1))) ((= i 10)) (define z 21) (display (+ x y z i))))"
+	     " g2: (+ x y) in (+ x y z i) is constant in the do loop")
+  (lint-test "(define (g3 y) (do ((i 0 (+ i 1))) ((= i 10)) (display (- x (/ (abs y) (floor x)) i))))"
+	     " g3: (- x (/ (abs y) (floor x))) in (- x (/ (abs y) (floor x)) i) is constant in the do loop")
+  (lint-test "(define (g4 y) (do ((i 0 (+ i 1))) ((= i 10)) (display (- y (/ (abs i) (floor x))))))" "")
+  (lint-test "(define (h1 snd chn) (do ((n2 (floor (/ n 2.0))) (i 0 (+ i 1))) ((= i n))
+                (set! (fr (if (< i n2) i (- (+ i out-n) n 1))) (edot-product (* freq 0.0-1.0i i) in-data))))"
+	     " h1: (+ n 1) in (- (+ i out-n) n 1) is constant in the do loop
+               h1: (* freq 0.0-1.0i) in (* freq 0.0-1.0i i) is constant in the do loop")
+  (lint-test "(define (h3) (do ((x 3) (i 0 (+ i 1))) ((= i 3)) (when (> x 0) (set! x (- x))))) (define (h4) (do ((abs 0 (+ abs 1))) ((= abs 3) 32) (display abs)))" "")
+  (lint-test "(define (h5) (do ((abs 0 (+ abs 1))) ((= abs 3) 32) (display '(32))))" "")
+  (lint-test "(define (h6 v) (do ((j 0) (i 0 (+ i 1))) ((= i 3)) (float-vector-set! v j (* 2 (float-vector-ref v j)))))" "")
+
+  (lint-test "(let loop ((i 0) (lst ())) (if (= i 10) lst (loop (+ i 1) (cons 1 lst))))"
+	     " loop: perhaps (let loop ((i 0) (lst ())) (if (= i 10) lst (loop (+ i 1) (cons 1 lst)))) ->
+                 (do ((i 0 (+ i 1)) (lst () (cons 1 lst))) ((= i 10) lst))
+               loop: perhaps (let loop ((i 0) (lst ())) (if (= i 10) lst (loop (+ i 1) (cons 1 lst)))) -> (make-list 10 1)")
+  (lint-test "(let ((x (f y))) (display x) (define z (f x)) (do ((i 0 (+ i 1))) ((= i 3)) (display (+ x z i))))"
+	     " let: the scope of z could be reduced: (... (define z (f x)) (do ((i 0 (+ i 1))) ((= i 3)) (display (+ x z i)))) ->
+                 (... (let ((z (f x))) (do ((i 0 (+ i 1))) ((= i 3)) (display (+ x z i)))))
+               let: (define z (f x)) occurs in the midst of the body;
+                 perhaps use let: (let ((z (f x))) (do ((i 0 (+ i 1))) ((= i 3)) (display (+ x z i))))
+               let: (+ x z) in (+ x z i) is constant in the do loop")
+  (lint-test "(let () (display x) (define z (f x)) (do ((i z (+ i 1))) ((= i 3)) (display (+ z i))))"
+	     " let: the scope of z could be reduced: (... (define z (f x)) (do ((i z (+ i 1))) ((= i 3)) (display (+ z i)))) ->
+                 (... (let ((z (f x))) (do ((i z (+ i 1))) ((= i 3)) (display (+ z i)))))
+               let: (define z (f x)) occurs in the midst of the body;
+                 perhaps use let: (let ((z (f x))) (do ((i z (+ i 1))) ((= i 3)) (display (+ z i))))")
+  (lint-test "(let () (display x) (define z (f x)) (do ((i z (+ i 1)) (j 0)) ((= i 3)) (display (+ z i))))"
+	     " let: the scope of z could be reduced: (... (define z (f x)) (do ((i z (+ i 1)) (j 0)) ((= i 3)) (display (+ z i)))) ->
+                 (... (let ((z (f x))) (do ((i z (+ i 1)) (j 0)) ((= i 3)) (display (+ z i)))))
+               let: (define z (f x)) occurs in the midst of the body;
+                 perhaps use let: (let ((z (f x))) (do ((i z (+ i 1)) (j 0)) ((= i 3)) (display (+ z i))))
+               let: j not used, initially: 0 from do")
+
+  (lint-test "(let ((x (make-vector 3 0)) (y (* 2 x))) (set! x (reverse x)) (vector-ref x y))"
+	     " let: x in (y (* 2 x)) does not appear to be defined in the calling environment
+               let: perhaps combine these two lines: (set! x (reverse x)) (vector-ref x y)")
+  (lint-test "(let ((x (make-vector 3 0)) (y (* 2 z))) (set! x (reverse x)) (vector-ref x y))"
+	     " let: perhaps (let ((x (make-vector 3 0)) (y (* 2 z))) (set! x (reverse x)) (vector-ref x y)) ->
+                 (let ((x (reverse (make-vector 3 0))) (y (* 2 z))) (vector-ref x y))")
+  (lint-test "(let ((x (make-vector 3 0)) (y (* 2 z))) (set! x (f x y x)) (vector-ref x y))" "")
+  (lint-test "(let ((x (make-vector 3 0)) (y (* 2 z))) (set! x (f x y)))"
+	     " let: perhaps (let ((x (make-vector 3 0)) (y (* 2 z))) (set! x (f x y))) -> (let ((x (make-vector 3 0)) (y (* 2 z))) (f x y))
+               let: set! is pointless in (set! x (f x y)): use (f x y)")
+  (lint-test "(let ((x (make-vector 3 0))) (set! x (f x y)))"
+	     " let: perhaps (let ((x (make-vector 3 0))) (set! x (f x y))) -> (f (make-vector 3 0) y)
+               let: set! is pointless in (set! x (f x y)): use (f x y)")
+
+  ;(lint-test "(byte-vector 3213)"	" byte-vector: byte-vector's argument should be a byte?: 3213: (byte-vector 3213)")
+  (lint-test "(make-byte-vector 0)"     " make-byte-vector: perhaps (make-byte-vector 0) -> #u()")
+  (lint-test "(make-byte-vector 3 (random 256))" "")
+  (lint-test "(make-byte-vector 3 (random 257))"
+	     " make-byte-vector: in (make-byte-vector 3 (random 257)), make-byte-vector's second argument should be a byte, but (random 257) is an integer?")
+
+  (lint-test "(let ())"			" let: let is messed up:  (let ())")
+  (lint-test "(let ((x (lambda (a) (x 1)))) x)"
+	     " let: let variable x is called in its binding?  Perhaps let should be letrec: ((x (lambda (a) (x 1))))
+               let: perhaps (let ((x (lambda (a) (x 1)))) x) -> (lambda (a) (x 1))")
+  (lint-test "(let* ((x 1)) x)"		" let*: let* could be let: (let* ((x 1)) x) let*: perhaps (let* ((x 1)) x) -> 1")
+  (lint-test "(let* ((x 1) (x x)) x)"	" let*: let* variable x is declared twice let*: perhaps (let* ((x 1) (x x)) x) -> (let ((x 1)) x)")
+  (lint-test "(let* ((x (g g0)) (y (g g0))) (+ x y))"
+	     " let*: perhaps (let* ((x (g g0)) (y (g g0))) (+ x y)) -> (let ((x (g g0))) (+ x (g g0)))")
+  (lint-test "(let* ((x 0) (y (g 0))) (+ x y))"
+	     " let*: perhaps (let* ((x 0) (y (g 0))) (+ x y)) -> (let ((x 0)) (+ x (g 0)))")
+  (lint-test "(let ((x 0)) (let ((y (g 0))) (+ x y)))"
+	     " let: perhaps (let ((y (g 0))) (+ x y)) -> (+ x (g 0))
+               let: perhaps move 'x into the inner let: (let ((x 0)) (let ((y (g 0))) (+ x y))) -> (let ((x 0) (y (g 0))) (+ x y))
+               let: perhaps (let ((x 0)) (let ((y (g 0))) (+ x y))) -> (let* ((x 0) (y (g 0))) (+ x y))")
+
+  (lint-test "(let* ((a 1) (b (+ a 1))) (let ((c (+ a b))) (display c)))"
+	     " let*: perhaps (let ((c (+ a b))) (display c)) -> (display (+ a b))
+               let*: perhaps (let* ((a 1) (b (+ a 1))) (let ((c (+ a b))) (display c))) -> (let* ((a 1) (b (+ a 1)) (c (+ a b))) (display c))")
+  (lint-test "(let* ((a 1) (b (+ a 1))) (let* ((c (+ a b)) (d (+ c 1))) (display d)) (display a))"
+	     " let*: perhaps restrict c which is not used in the let* body
+                 (let* ((c (+ a b)) (d (+ c 1))) (display d)) -> (let ((d (let ((c (+ a b))) (+ c 1)))) ...)
+               let*: perhaps substitute c into d: (let* ((c (+ a b)) (d (+ c 1))) (display d)) -> (let ((d (+ (+ a b) 1))) ...)
+               let*: perhaps (let* ((c (+ a b)) (d (+ c 1))) (display d)) -> (let ((c (+ a b))) (display (+ c 1)))")
+  (lint-test "(let* ((a 1) (b (+ a 1))) (let ((c (+ a b)) (d a)) (display (+ c d))))"
+	     " let*: perhaps (let ((c (+ a b)) (d a)) (display (+ c d))) -> (display (+ (+ a b) a))")
+  (lint-test "(let* ((x (log y 2)) (y (log y 2)) (z (f x))) (+ x y z z))" " let*: y's value (log y 2) could be x")
+  (lint-test "(let* ((x (log a 2)) (y (log y 2)) (z (log y 2))) (+ x y z z))"
+	     " let*: perhaps split this let*: (let* ((x (log a 2)) (y (log y 2)) (z (log y 2))) (+ x y z z)) ->
+                 (let ((y (log y 2))) (let ((x (log a 2)) (z (log y 2))) ...))")
+  (lint-test "(let* ((a 12) (b (+ a 1)) (c 20) (d (+ c 1))) (+ b d))"
+	     " let*: perhaps restrict a, c which are not used in the let* body
+                 (let* ((a 12) (b (+ a 1)) (c 20) (d (+ c 1))) (+ b d)) -> (let* ((b (let ((a 12)) (+ a 1))) (d (let ((c 20)) (+ c 1)))) ...)
+               let*: perhaps split this let*: (let* ((a 12) (b (+ a 1)) (c 20) (d (+ c 1))) (+ b d)) -> (let ((a 12) (c 20)) (let ((b (+ a 1)) (d (+ c 1))) ...))
+               let*: perhaps substitute a into b, c into d: (let* ((a 12) (b (+ a 1)) (c 20) (d (+ c 1))) (+ b d)) -> (let* ((b (+ 12 1)) (d (+ 20 1))) ...)
+               let*: perhaps (let* ((a 12) (b (+ a 1)) (c 20) (d (+ c 1))) (+ b d)) -> (let* ((a 12) (b (+ a 1)) (c 20)) (+ b (+ c 1)))")
+  (lint-test "(let ((a 1)) (let ((b (+ a 1))) (+ a b)))"
+	     " let: perhaps (let ((b (+ a 1))) (+ a b)) -> (+ a (+ a 1))
+               let: perhaps (let ((a 1)) (let ((b (+ a 1))) (+ a b))) -> (let* ((a 1) (b (+ a 1))) (+ a b))")
+  (lint-test "(let ((a 1)) (let ((b 2)) (+ a b)))"
+	     " let: perhaps (let ((b 2)) (+ a b)) -> (+ a 2)
+               let: perhaps move 'a into the inner let: (let ((a 1)) (let ((b 2)) (+ a b))) -> (let ((a 1) (b 2)) (+ a b))
+               let: perhaps (let ((a 1)) (let ((b 2)) (+ a b))) -> (let ((a 1) (b 2)) (+ a b))")
+  (lint-test "(let ((a 1)) (let* ((b (+ a 1)) (c (* b 2))) (display (+ a b c))))"
+	     " let: perhaps (let* ((b (+ a 1)) (c (* b 2))) (display (+ a b c))) -> (let ((b (+ a 1))) (display (+ a b (* b 2))))
+               let: perhaps (let ((a 1)) (let* ((b (+ a 1)) (c (* b 2))) (display (+ a b c)))) ->
+                 (let* ((a 1) (b (+ a 1)) (c (* b 2))) (display (+ a b c)))")
+  (lint-test "(let ((x 1) (y 2)) (set! x (* y 2)) x)"
+	     " let: set! returns the new value, so this could be omitted: x
+               let: perhaps (let ((x 1) (y 2)) (set! x (* y 2)) x) -> (let ((y 2)) (* y 2))")
+  (lint-test "(let ((x (read-byte)) (y 2)) (set! x (* y x)) x)"
+	     " let: set! returns the new value, so this could be omitted: x
+               let: perhaps (let ((x (read-byte)) (y 2)) (set! x (* y x)) x) -> (let ((x (read-byte)) (y 2)) (* y x))")
+  (lint-test "(let ((x (read-byte)) (y 2)) (set! x (* y 2)))"
+	     " let: x set, but not used: (set! x (* y 2))
+               let: perhaps (let ((x (read-byte)) (y 2)) (set! x (* y 2))) -> (let ((x (read-byte)) (y 2)) (* y 2))
+               let: set! is pointless in (set! x (* y 2)): use (* y 2)")
+  (lint-test "(let ((x 1) (y 2)) (set! x (* y x)) x)"
+	     " let: set! returns the new value, so this could be omitted: x
+               let: perhaps (let ((x 1) (y 2)) (set! x (* y x)) x) -> (let ((x 1) (y 2)) (* y x))")
+  (lint-test "(let ((x 1)) (set! x (* 2 x)) x)"
+	     " let: set! returns the new value, so this could be omitted: x
+               let: perhaps (let ((x 1)) (set! x (* 2 x)) x) -> (let ((x (* 2 1))) x)")
+  (lint-test "(let ((x 1)) (set! x 2) x)"
+	     " let: set! returns the new value, so this could be omitted: x
+               let: perhaps (let ((x 1)) (set! x 2) x) -> (let ((x 2)) x)")
+  (lint-test "(let ((x 1) (y (f g 2))) (let loop ((a (+ x 1)) (b y)) (loop a b)))"
+	     " let: perhaps (let ((x 1) (y (f g 2))) (let loop ((a (+ x 1)) (b y)) (loop a b))) -> (let loop ((a (+ 1 1)) (b (f g 2))) (loop a b))")
+  (lint-test "(let loop ((i 0)) (+ i 1))" " let: loop not used, value: (let loop ((i 0)) (+ i 1))")
+
+  (lint-test "(let () (define x 43) (display (+ x x)))"
+	     " let: perhaps (let () (define x 43) (display (+ x x))) -> (let ((x 43)) ...)")
+  (lint-test "(let ((x 43)) (define y 44) (display (+ x y)))"
+	     " let: perhaps (let ((x 43)) (define y 44) (display (+ x y))) -> (let ((x 43) (y 44)) ...)")
+  (lint-test "(lambda () (let ((x 43)) (define y 44) (display (+ x y))))"
+	     " lambda: y can be moved to lambda's closure
+               lambda: x can be moved to lambda's closure
+               lambda: perhaps (let ((x 43)) (define y 44) (display (+ x y))) -> (let ((x 43) (y 44)) ...)")
+  (lint-test "(let () (define x 3) (define (y a) a) (g z))"
+	     " let: perhaps (... (define x 3) (define (y a) a) (g z)) -> (... (let ((x 3)) ...))
+               let: y not used, value: (define (y a) a)
+               let: x not used, initially: 3 from define
+               let: perhaps (let () (define x 3) (define (y a) a) (g z)) -> (let ((x 3)) ...)")
+  (lint-test "(let* ((x y) (a (* 2 x))) (+ (f a (+ a 1)) (* 3 x)))"
+	     " let*: assuming we see all set!s, the binding (x y) is pointless: perhaps (let* ((x y) (a (* 2 x))) (+ (f a (+ a 1)) (* 3 x))) ->
+                 (let ((a (* 2 y))) (+ (f a (+ a 1)) (* 3 y)))")
+  (lint-test "(let* ((x y) (a (* 2 (+ x y)))) (+ (f a (+ a 1)) (* 3 x)))"
+	     " let*: assuming we see all set!s, the binding (x y) is pointless: perhaps (let* ((x y) (a (* 2 (+ x y)))) (+ (f a (+ a 1)) (* 3 x))) ->
+                 (let ((a (* 2 (+ y y)))) (+ (f a (+ a 1)) (* 3 y)))")
+  (lint-test "(let* ((x y) (a (* 2 x))) (set! x (* 3 x)) (+ (f a (+ a 1)) (* 3 x)))" "")
+  (lint-test "(let* ((x y) (a (* 2 x))) (set! y (* 3 x)) (+ (f a (+ a 1)) (* 3 x)))" "")
+  (lint-test "(let* ((x y) (a (* 2 x))) (cons (push! a x) (* 3 x)))" "")
+  (lint-test "(let* ((x y) (a (* 2 x))) (cons (push! a y) (* 3 x)))" "")
+  (lint-test "(let ((x y) (a (* 2 y))) (+ (f a (+ a 1)) (* 3 x)))" "")
+  (lint-test "(let ((x y) (a (* 2 y))) (+ (f a (+ a 1)) (* 3 y x)))" "")
+  (lint-test "(let ((x y) (a (* 2 y))) (set! x (* 3 x)) (+ (f a (+ a 1)) (* 3 x)))"
+	     " let: perhaps (let ((x y) (a (* 2 y))) (set! x (* 3 x)) (+ (f a (+ a 1)) (* 3 x))) ->
+                (let ((x (* 3 y)) (a (* 2 y))) (+ (f a (+ a 1)) (* 3 x)))")
+  (lint-test "(let ((x y) (a (* 2 y))) (set! y (* 3 x)) (+ (f a (+ a 1)) (* 3 x)))"
+	     " let: x is not set, and is always accessed via (* 3 x) so its binding could probably be (x (* 3 y)) in
+                 (let ((x y) (a (* 2 y))) (set! y (* 3 x)) (+ (f a (+ a 1)) (* 3 x)))")
+
+  (lint-test "(let ((old-x x)) (set! x 12) (display (log x)) (set! x old-x))"
+	     " let: perhaps use let-temporarily here:
+                 (let ((old-x x)) (set! x 12) (display (log x)) (set! x old-x)) -> (let-temporarily ((x 12)) (display (log x)))")
+  (lint-test "(let ((old-x x)) (set! x 12) (display (log x)) (set! x 1) (set! x old-x))"
+	     " let: this could be omitted: (set! x 1)
+               let: perhaps use let-temporarily here:
+                 (let ((old-x x)) (set! x 12) (display (log x)) (set! x 1) (set! x old-x)) -> (let-temporarily ((x 12)) (display (log x)) (set! x 1))")
+  (lint-test "(let ((old-x x) (z (f 3))) (set! x z) (display (log x)) (set! x old-x))"
+	     " let: perhaps use let-temporarily here:
+                 (let ((old-x x) (z (f 3))) (set! x z) (display (log x)) (set! x old-x)) -> (let ((z (f 3))) (let-temporarily ((x z)) (display (log x))))")
+  (lint-test "(let ((z (f 3)) (old-x x)) (set! x z) (display (log x)) (set! x old-x))"
+	     " let: perhaps use let-temporarily here:
+                 (let ((z (f 3)) (old-x x)) (set! x z) (display (log x)) (set! x old-x)) -> (let ((z (f 3))) (let-temporarily ((x z)) (display (log x))))")
+  (lint-test "(let ((old-p (*s7* 'print-length))) (set! (*s7* 'print-length) 32) (display x) (set! (*s7* 'print-length) old-p))"
+	     " let: perhaps use let-temporarily here: (let ((old-p (*s7* 'print-length))) (set! (*s7* 'print-length) 32)... ->
+                 (let-temporarily (((*s7* 'print-length) 32)) (display x))")
+  (lint-test "(let ((b 32)) (let ((ob b) (res 0)) (set! b 31) (set! res (+ b 1)) (set! b ob) res))"
+	     " let: perhaps use let-temporarily here: (let ((ob b) (res 0)) (set! b 31) (set! res (+ b 1)) (set! b ob) res) ->
+                (let ((res 0)) (let-temporarily ((b 31)) (set! res (+ b 1)) res))")
+  (lint-test "(define equalize-panes (let ((equalize-sound (lambda (ind) (let-temporarily (((channel-style ind) channels-combined))))))
+                (lambda* (snd) (if snd (equalize-sound snd) (for-each equalize-sound (sounds))))))" "")
+  (lint-test "(let-temporarily () 3)" " let-temporarily: let-temporarily with no vars? (let-temporarily () 3)")
+  (lint-test "(let-temporarily)" " let-temporarily: let-temporarily is messed up: (let-temporarily)")
+
+  (lint-test "(null? (let ((p (lambda (x) (not ((if (path? obj) path? picture?) x))))) (filt p (cons obj more-objs))))"
+	     " null?: perhaps (null? (let ((p (lambda (x) (not ((if (path? obj) path? picture?) x)))))... ->
+                 (let ... (null? (filt p (cons obj more-objs))))")
+  (lint-test "((if y +) 2 3)" " (if y +): y better not be #f here: ((if y +) 2 3)")
+  (lint-test "((if y abs -))" " (if y abs -): abs in (if y abs -) can't be called with 0 arguments: ((if y abs -))
+              (if y abs -): - in (if y abs -) can't be called with 0 arguments: ((if y abs -))")
+  (lint-test "((if y abs exp) 1.0 2.0)" " (if y abs exp): abs in (if y abs exp) can't be called with 2 arguments: ((if y abs exp) 1.0 2.0)
+               (if y abs exp): exp in (if y abs exp) can't be called with 2 arguments: ((if y abs exp) 1.0 2.0)")
+
+  (lint-test "((if y string=? string>?) 1 2)" " (if y string=? string>?): in ((if y string=? string>?) 1 2),
+              ((if y string=? string>?) 1 2)'s first argument should be a string, but 1 is an integer?
+              (if y string=? string>?): in ((if y string=? string>?) 1 2),
+              ((if y string=? string>?) 1 2)'s second argument should be a string, but 2 is an integer?
+              (if y string=? string>?): in ((if y string=? string>?) 1 2),
+              ((if y string=? string>?) 1 2)'s first argument should be a string, but 1 is an integer?
+              (if y string=? string>?): in ((if y string=? string>?) 1 2),
+              ((if y string=? string>?) 1 2)'s second argument should be a string, but 2 is an integer?")
+  (lint-test "((if y abs +) 1.0 2.0)" "(if y abs +): abs in (if y abs +) can't be called with 2 arguments: ((if y abs +) 1.0 2.0)")
+  (lint-test "((if y 32 #<eof>) 1.0 2.0)"
+	     " (if y 32 #<eof>): 32 in (if y 32 #<eof>) can't be called with 2 arguments: ((if y 32 #<eof>) 1.0 2.0)
+               (if y 32 #<eof>): #<eof> in (if y 32 #<eof>) can't be called with 2 arguments: ((if y 32 #<eof>) 1.0 2.0)")
+
+  (lint-test "(let () (define-constant _cons_ 32) (define (_cons_ a_) (+ 1 a)))"
+	     " let: _cons_ in (define (_cons_ a_) (+ 1 a)) is already a constant, defined 32
+               let: let variable _cons_ is declared twice
+               let: _cons_ not used, initially: 32 from define-constant")
+  (lint-test "(let ((x 32)) (display x) (define-constant x 2) (f x))" " let: let variable x is later redefined as a constant")
+  (lint-test "(let ((x 32)) (display x) (define x 2) (f x))"
+	     " let: (define x 2) occurs in the midst of the body; perhaps use let: (let ((x 2)) (f x))
+               let: let variable x is redefined in the let body.  Perhaps use set! instead: (set! x 2)")
+
+  (lint-test "(let ((a 1)) (display (f b)) (let ((b 2)) (display (+ a b))) (display c))"
+	     " let: perhaps (let ((b 2)) (display (+ a b))) -> (display (+ a 2))
+                let: perhaps move 'a into the inner let:
+                  (let ((a 1)) (display (f b)) (let ((b 2)) (display (+ a b))) (display c)) -> (let ((a 1) (b 2)) (display (+ a b)))")
+  (lint-test "(let ((a 1)) (display (f b)) (let ((b (+ a 1))) (display (+ a b))) (display c))"
+	     " let: perhaps (let ((b (+ a 1))) (display (+ a b))) -> (display (+ a (+ a 1)))")
+  (lint-test "(let ((a 1)) (f x) (let ((c 0)) (let ((b (+ c a))) (display b)) (let ((b (+ 1 a))) (display b))))"
+	     " let: perhaps (let ((b (+ c a))) (display b)) -> (display (+ c a))
+               let: perhaps (let ((b (+ 1 a))) (display b)) -> (display (+ 1 a))
+               let: perhaps move 'a into the inner let:
+                 (let ((a 1)) (f x) (let ((c 0)) (let ((b (+ c a))) (display b)) (let ((b... ->
+                 (let ((a 1) (c 0)) (let ((b (+ c a))) (display b)) (let ((b (+ 1 a)))...")
+  (lint-test "(let ((a 1)) (display (f b)) (let ((b 2)) (do () () (display (+ a b)))) (display c))"
+	     " let: perhaps (let ((b 2)) (do () () (display (+ a b)))) -> (do ((b 2)) ...)")
+  (lint-test "(let ((a 1)) (display (f b)) (let ((b 2)) (lambda () (display (+ a b)))) (display c))"
+	     " let: this has no effect: (lambda () (display (+ a b)))")
+  (lint-test "(let ((a 1)) (display (f b)) (let ((b 2)) (let loop () (display (+ a b)))) (display c))"
+	     " let: loop not used, value: (let loop () (display (+ a b)))")
+  (lint-test "(let* ((x 1) (a 1)) (display (f x)) (let ((b 2)) (display (+ a b))) (display c))"
+	     " let*: let* could be let: (let* ((x 1) (a 1)) (display (f x)) (let ((b 2)) (display (+ a b)))...
+               let*: perhaps (let ((b 2)) (display (+ a b))) -> (display (+ a 2))
+               let*: perhaps move 'a into the inner let: (let* ((x 1) (a 1)) (display (f x)) (let ((b 2)) (display (+ a b)))... ->
+                  (let ((a 1) (b 2)) (display (+ a b)))")
+  (lint-test "(lambda () (let ((a 1)) (define (f211 x) (+ x 1)) (display a) (let ((b 2)) (display (f211 (+ a b))))))"
+	      " lambda: the inner function f211 could be moved outside the lambda: (lambda () (let ((a 1)) (define (f211 x) (+ x 1)) (display a) (let ((b 2))... ->
+                  (let () (define (f211 x) (+ x 1)) (lambda () ...))
+                lambda: perhaps move 'f211 into the inner let: (lambda () (let ((a 1)) (define (f211 x) (+ x 1)) (display a) (let ((b 2))... ->
+                  (let ((f211 (lambda (x) (+ x 1))) (b 2)) (display (f211 (+ a b))))
+                lambda: a can probably be moved to lambda's closure")
+  (lint-test "(let () (let ((a 1)) (let ((f212 (lambda (x) (+ x 1)))) (display a) (let ((b 2)) (display (f212 (+ a b)))))))"
+	     " let: pointless let: (let () (let ((a 1)) (let ((f212 (lambda (x) (+ x 1)))) (display a) (let...
+               let: perhaps (let ((a 1)) (let ((f212 (lambda (x) (+ x 1)))) (display a) (let ((b 2))... ->
+                 (let* ((a 1) (f212 (lambda (x) (+ x 1)))) (display a) ...)")
+  (lint-test "(lambda* ((a 1)) (define f213 (lambda (x) (+ x 1))) (let () (display a) (let ((b 2)) (display (f213 (+ a b))))))"
+	     " lambda*: the inner function f213 could be moved outside the lambda*: (lambda* ((a 1)) (define f213 (lambda (x) (+ x 1))) (let () (display a)... ->
+                 (let () (define f213 (lambda (x) (+ x 1))) (lambda* ((a 1)) ...))
+               lambda*: pointless let: (let () (display a) (let ((b 2)) (display (f213 (+ a b)))))")
+  (lint-test "(let ((a 1)) (let ((f214 (lambda (x) (+ x 1))) (f22 (lambda (x) (+ x 2)))) (* a (f214 1) (f22 2))))"
+	     " let: perhaps move 'a into the inner let: (let ((a 1)) (let ((f214 (lambda (x) (+ x 1))) (f22 (lambda (x) (+ x 2))))... ->
+                 (let ((a 1) (f214 (lambda (x) (+ x 1))) (f22 (lambda (x) (+ x 2)))) (* a...")
+  (lint-test "(define (f216 a) (define (f217 x) (+ x 1)) (display a) (let ((b 2)) (display (f217 (+ a b)))))"
+	     " define: the inner function f217 could be moved to f216's closure: (define (f216 a) (define (f217 x) (+ x 1)) (display a) (let ((b 2))... ->
+                 (define f216 (let () (define (f217 x) (+ x 1)) (lambda (a) ...)))
+               f216: perhaps move 'f217 into the inner let: (define (f216 a) (define (f217 x) (+ x 1)) (display a) (let ((b 2))... ->
+                 (let ((f217 (lambda (x) (+ x 1))) (b 2)) (display (f217 (+ a b))))")
+  (lint-test "(define f218 (lambda (a) (define (f219 x) (+ x 1)) (display a) (let ((b 2)) (display (f219 (+ a b))))))"
+	     " f218: the inner function f219 could be moved outside the lambda: (lambda (a) (define (f219 x) (+ x 1)) (display a) (let ((b 2)) (display... ->
+                 (let () (define (f219 x) (+ x 1)) (lambda (a) ...))
+               f218: perhaps move 'f219 into the inner let: (lambda (a) (define (f219 x) (+ x 1)) (display a) (let ((b 2)) (display... ->
+                 (let ((f219 (lambda (x) (+ x 1))) (b 2)) (display (f219 (+ a b))))")
+  (lint-test "(define f220 (lambda (a) (if x (begin (define (f221 x) (+ x 1)) (display a) (let ((b 2)) (display (f221 (+ a b))))))))"
+	      " f220:  perhaps (if x (begin (define (f221 x) (+ x 1)) (display a) (let ((b 2)) (display... ->
+                  (when x (define (f221 x) (+ x 1)) (display a) (let ((b 2)) (display (f221...
+                f220: perhaps move 'f221 into the inner let:
+                  (lambda (a) (if x (begin (define (f221 x) (+ x 1)) (display a) (let ((b... ->
+                  (let ((f221 (lambda (x) (+ x 1))) (b 2)) (display (f221 (+ a b))))")
+  (lint-test "(let* ((x (log y)) (a (+ x 1)) (a (* x 2))) (+ a 1))"
+	     " let*: let* variable a is declared twice
+               let*: a not used, initially: (+ x 1) from let*
+               let*: perhaps
+                 (let* ((x (log y)) (a (+ x 1)) (a (* x 2))) (+ a 1)) -> (let* ((x (log y)) (a (+ x 1))) (+ (* x 2) 1))")
+  (lint-test "(let* ((x (log y)) (a (+ x 1)) (a (* y 2))) (+ a 1))"
+	     " let*: let* variable a is declared twice
+               let*: a not used, initially: (+ x 1) from let*
+               let*: perhaps restrict x which is not used in the let* body
+                 (let* ((x (log y)) (a (+ x 1)) (a (* y 2))) (+ a 1)) -> (let* ((a (let ((x (log y))) (+ x 1))) (a (* y 2))) ...)
+               let*: perhaps substitute x into a: (let* ((x (log y)) (a (+ x 1)) (a (* y 2))) (+ a 1)) -> (let* ((a (+ (log y) 1)) (a (* y 2))) ...)
+               let*: perhaps (let* ((x (log y)) (a (+ x 1)) (a (* y 2))) (+ a 1)) -> (let* ((x (log y)) (a (+ x 1))) (+ (* y 2) 1))")
+  (lint-test "(let* ((x (log y)) (a (+ y 1)) (a (* x 2))) (+ a 1))"
+	     " let*: let* variable a is declared twice
+               let*: a not used, initially: (+ y 1) from let*
+               let*: perhaps restrict x which is not used in the let* body
+                 (let* ((x (log y)) (a (+ y 1)) (a (* x 2))) (+ a 1)) -> (let* ((a (+ y 1)) (a (let ((x (log y))) (* x 2)))) ...)
+               let*: perhaps (let* ((x (log y)) (a (+ y 1)) (a (* x 2))) (+ a 1)) -> (let* ((x (log y)) (a (+ y 1))) (+ (* x 2) 1))")
+  (lint-test "(let* ((x (log y)) (a (+ y 1)) (b (* x a))) (+ b 1))"
+	     " let*: perhaps restrict x, a which are not used in the let* body
+                 (let* ((x (log y)) (a (+ y 1)) (b (* x a))) (+ b 1)) -> (let ((b (let* ((a (+ y 1)) (x (log y))) (* x a)))) ...)
+               let*: perhaps substitute a into b:
+                 (let* ((x (log y)) (a (+ y 1)) (b (* x a))) (+ b 1)) -> (let* ((x (log y)) (b (* x (+ y 1)))) ...)
+               let*: perhaps
+                 (let* ((x (log y)) (a (+ y 1)) (b (* x a))) (+ b 1)) -> (let* ((x (log y)) (a (+ y 1))) (+ (* x a) 1))")
+  (lint-test "(let* ((x (log y)) (a (+ x 1)) (b (* x a))) (+ b 1))"
+	     " let*: perhaps restrict a which is not used in the let* body
+                 (let* ((x (log y)) (a (+ x 1)) (b (* x a))) (+ b 1)) -> (let* ((x (log y)) (b (let ((a (+ x 1))) (* x a)))) ...)
+               let*: perhaps substitute a into b:
+                 (let* ((x (log y)) (a (+ x 1)) (b (* x a))) (+ b 1)) -> (let* ((x (log y)) (b (* x (+ x 1)))) ...)
+               let*: perhaps
+                 (let* ((x (log y)) (a (+ x 1)) (b (* x a))) (+ b 1)) -> (let* ((x (log y)) (a (+ x 1))) (+ (* x a) 1))")
+  (lint-test "(let* ((a (log x)) (b (f100 a))) (* b 2))"
+	     " let*: perhaps restrict a which is not used in the let* body
+                 (let* ((a (log x)) (b (f100 a))) (* b 2)) -> (let ((b (let ((a (log x))) (f100 a)))) ...)
+               let*: perhaps substitute a into b: (let* ((a (log x)) (b (f100 a))) (* b 2)) -> (let ((b (f100 (log x)))) ...)
+               let*: perhaps (let* ((a (log x)) (b (f100 a))) (* b 2)) -> (let ((a (log x))) (* (f100 a) 2))")
+  (lint-test "(let ((a (log x))) (let ((b (+ a 1))) (* b 2)))"
+	     " let: perhaps (let ((b (+ a 1))) (* b 2)) -> (* (+ a 1) 2)
+               let: perhaps
+                 (let ((a (log x))) (let ((b (+ a 1))) (* b 2))) -> (let* ((a (log x)) (b (+ a 1))) (* b 2))")
+  (lint-test "(let* ((a (log x)) (b (log y)) (c (+ a b))) (* c 2))"
+	     " let*: perhaps restrict a, b which are not used in the let* body
+                 (let* ((a (log x)) (b (log y)) (c (+ a b))) (* c 2)) -> (let ((c (let* ((b (log y)) (a (log x))) (+ a b)))) ...)
+               let*: perhaps substitute b into c:
+                 (let* ((a (log x)) (b (log y)) (c (+ a b))) (* c 2)) -> (let* ((a (log x)) (c (+ a (log y)))) ...)
+               let*: perhaps
+                 (let* ((a (log x)) (b (log y)) (c (+ a b))) (* c 2)) -> (let* ((a (log x)) (b (log y))) (* (+ a b) 2))")
+  (lint-test "(let* ((a (log x)) (b (read)) (c (+ a b))) (* 2 c))"
+	     " let*: perhaps restrict a, b which are not used in the let* body
+                 (let* ((a (log x)) (b (read)) (c (+ a b))) (* 2 c)) -> (let ((c (let* ((b (read)) (a (log x))) (+ a b)))) ...)
+               let*: perhaps substitute b into c:
+                 (let* ((a (log x)) (b (read)) (c (+ a b))) (* 2 c)) -> (let* ((a (log x)) (c (+ a (read)))) ...)
+               let*: perhaps
+                 (let* ((a (log x)) (b (read)) (c (+ a b))) (* 2 c)) -> (let* ((a (log x)) (b (read))) (* 2 (+ a b)))")
+  (lint-test "(let* ((a (read)) (b (read)) (c (+ a b))) (* 2 c))"
+	     " let*: perhaps restrict b which is not used in the let* body
+                 (let* ((a (read)) (b (read)) (c (+ a b))) (* 2 c)) -> (let* ((a (read)) (c (let ((b (read))) (+ a b)))) ...)
+               let*: perhaps substitute b into c:
+                 (let* ((a (read)) (b (read)) (c (+ a b))) (* 2 c)) -> (let* ((a (read)) (c (+ a (read)))) ...)
+               let*: perhaps
+                 (let* ((a (read)) (b (read)) (c (+ a b))) (* 2 c)) -> (let* ((a (read)) (b (read))) (* 2 (+ a b)))")
+  (lint-test "(let ((x (log y))) (let ((z (+ x y))) (* z 2)))"
+	     " let: perhaps (let ((z (+ x y))) (* z 2)) -> (* (+ x y) 2)
+                let: perhaps (let ((x (log y))) (let ((z (+ x y))) (* z 2))) -> (let* ((x (log y)) (z (+ x y))) (* z 2))")
+  (lint-test "(let* ((a (read)) (b (read)) (c (* a 2))) (+ c b))"
+	     " let*: perhaps (let* ((a (read)) (b (read)) (c (* a 2))) (+ c b)) -> (let* ((a (read)) (b (read))) (+ (* a 2) b))")
+  (lint-test "(let* ((a (read)) (b (read)) (c (* b 2)) (d (* a 2))) (+ c d))"
+	     " let*: perhaps restrict b which is not used in the let* body
+                 (let* ((a (read)) (b (read)) (c (* b 2)) (d (* a 2))) (+ c d)) -> (let* ((a (read)) (c (let ((b (read))) (* b 2))) (d (* a 2))) ...)
+               let*: perhaps split this let*: (let* ((a (read)) (b (read)) (c (* b 2)) (d (* a 2))) (+ c d)) ->
+                 (let* ((a (read)) (b (read))) (let ((c (* b 2)) (d (* a 2))) ...))
+               let*: perhaps substitute b into c:
+                 (let* ((a (read)) (b (read)) (c (* b 2)) (d (* a 2))) (+ c d)) -> (let* ((a (read)) (c (* (read) 2)) (d (* a 2))) ...)
+               let*: perhaps
+                 (let* ((a (read)) (b (read)) (c (* b 2)) (d (* a 2))) (+ c d)) -> (let* ((a (read)) (b (read)) (c (* b 2))) (+ c (* a 2)))")
+  (lint-test "(let* ((x (f a)) (y (car x)) (z (cadr x)) (w (caddr x))) (g x y z w))"
+	     " let*: perhaps split this let*: (let* ((x (f a)) (y (car x)) (z (cadr x)) (w (caddr x))) (g x y z w)) ->
+                 (let ((x (f a))) (let ((y (car x)) (z (cadr x)) (w (caddr x))) ...))
+               let*: perhaps (let* ((x (f a)) (y (car x)) (z (cadr x)) (w (caddr x))) (g x y z w)) ->
+                 (let* ((x (f a)) (y (car x)) (z (cadr x))) (g x y z (caddr x)))")
+  (lint-test "(let* ((x (f a)) (y (car x)) (x (cadr x)) (w (caddr x))) (g x y z w))"
+	     " let*: let* variable x is declared twice
+               let*: perhaps (let* ((x (f a)) (y (car x)) (x (cadr x)) (w (caddr x))) (g x y z w)) ->
+                 (let* ((x (f a)) (y (car x)) (x (cadr x))) (g x y z (caddr x)))")
+  (lint-test "(let* ((x (f a)) (y (display x)) (z (cadr x)) (w (caddr x))) (g x y z w))"
+	     " let*: perhaps split this let*: (let* ((x (f a)) (y (display x)) (z (cadr x)) (w (caddr x))) (g x y z w)) ->
+                 (let* ((x (f a)) (y (display x))) (let ((z (cadr x)) (w (caddr x))) ...))
+               let*: perhaps (let* ((x (f a)) (y (display x)) (z (cadr x)) (w (caddr x))) (g x y z w)) ->
+                 (let* ((x (f a)) (y (display x)) (z (cadr x))) (g x y z (caddr x)))")
+
+  (lint-test "(let* ((a 1)) (do ((i a (+ i 1))) ((= i 3)) (display i)))"
+	     " let*: let* could be let: (let* ((a 1)) (do ((i a (+ i 1))) ((= i 3)) (display i)))")
+  (lint-test "(let* ((z (log w)) (x (log z))) (do ((i 0 (+ x z))) ((= i 3)) (display x)))"
+	     " let*: perhaps (let* ((z (log w)) (x (log z))) (do ((i 0 (+ x z))) ((= i 3)) (display x))) ->
+                 (let ((z (log w))) (do ((x (log z)) (i 0 (+ x z))) ...))")
+  (lint-test "(let* ((x (log z))) (do ((i 0 (+ x z))) ((= i 3)) (display x)))"
+	      " let*: let* could be let: (let* ((x (log z))) (do ((i 0 (+ x z))) ((= i 3)) (display x)))
+                let*: perhaps (let* ((x (log z))) (do ((i 0 (+ x z))) ((= i 3)) (display x))) -> (do ((x (log z)) (i 0 (+ x z))) ...)")
+  (lint-test "(let* ((a (log b)) (z (log w)) (x (log z))) (do ((i 0 (+ x z a))) ((= i 3)) (display x)))"
+	     " let*: perhaps split this let*: (let* ((a (log b)) (z (log w)) (x (log z))) (do ((i 0 (+ x z a))) ((= i... ->
+                 (let ((z (log w))) (let ((a (log b)) (x (log z))) ...))
+               let*: perhaps (let* ((a (log b)) (z (log w)) (x (log z))) (do ((i 0 (+ x z a))) ((= i... ->
+                 (let* ((a (log b)) (z (log w))) (do ((x (log z)) (i 0 (+ x z a))) ...))")
+  (lint-test "(let* ((z (log w)) (x (log z))) (do () ((= i 3) z) (display x)))"
+	     " let*: perhaps (let* ((z (log w)) (x (log z))) (do () ((= i 3) z) (display x))) -> (let ((z (log w))) (do ((x (log z))) ...))")
+  (lint-test "(let* ((x (log z))) (do () ((= i 3) z) (display x)))"
+	     " let*: let* could be let: (let* ((x (log z))) (do () ((= i 3) z) (display x)))
+               let*: perhaps (let* ((x (log z))) (do () ((= i 3) z) (display x))) -> (do ((x (log z))) ...)")
+  (lint-test "(let* ((a (log b)) (z (log w)) (x (log z))) (do () ((= i 3) (+ a z)) (display x)))"
+	      " let*: perhaps split this let*:
+                  (let* ((a (log b)) (z (log w)) (x (log z))) (do () ((= i 3) (+ a z))... -> (let ((z (log w))) (let ((a (log b)) (x (log z))) ...))
+                let*: perhaps (let* ((a (log b)) (z (log w)) (x (log z))) (do () ((= i 3) (+ a z))... ->
+                  (let* ((a (log b)) (z (log w))) (do ((x (log z))) ...))")
+
+  (lint-test "(let* ((a 1) (b (f a)) (c 2) (e 0) (d (g (+ a b c)))) (display d) (* a b c d e))"
+	     " let*: perhaps split this let*: (let* ((a 1) (b (f a)) (c 2) (e 0) (d (g (+ a b c)))) (display d) (* a b c... ->
+                 (let ((a 1) (c 2) (e 0)) (let* ((b (f a)) (d (g (+ a b c)))) ...))")
+  (lint-test "(let* ((a 1) (b (f a)) (c 2) (d (g (+ a b c))) (e (+ d 1))) (display d) (* a b c d e))"
+	     " let*: perhaps split this let*: (let* ((a 1) (b (f a)) (c 2) (d (g (+ a b c))) (e (+ d 1))) (display d) (*... ->
+                 (let ((a 1) (c 2)) (let* ((b (f a)) (d (g (+ a b c))) (e (+ d 1))) ...))")
+  (lint-test "(let* ((a 1) (b (f a)) (c 2) (d (g (+ a b c))) (e (+ d 1)) (f (+ d 2))) (display d) (* a b c d e f))"
+	     " let*: perhaps split this let*: (let* ((a 1) (b (f a)) (c 2) (d (g (+ a b c))) (e (+ d 1)) (f (+ d 2)))... ->
+                 (let ((a 1) (c 2)) (let* ((b (f a)) (d (g (+ a b c)))) (let ((e (+ d 1)) (f (+ d 2))) ...)))")
+  (lint-test "(let* ((a 1) (b (f a)) (d (g (+ a b c))) (e (+ d 1)) (f (+ d 2))) (display d) (* a b d e f))"
+	     " let*: perhaps split this let*: (let* ((a 1) (b (f a)) (d (g (+ a b c))) (e (+ d 1)) (f (+ d 2))) (display... ->
+                 (let* ((a 1) (b (f a)) (d (g (+ a b c)))) (let ((e (+ d 1)) (f (+ d 2))) ...))")
+  (lint-test "(let* ((a 1) (b (f a)) (d 3) (e (+ d 1)) (f (+ d 2))) (display d) (* a b d e f))"
+	     " let*: perhaps split this let*:
+                 (let* ((a 1) (b (f a)) (d 3) (e (+ d 1)) (f (+ d 2))) (display d) (* a b d... ->
+                 (let ((a 1) (d 3)) (let ((b (f a))) (let ((e (+ d 1)) (f (+ d 2))) ...)))")
+  (lint-test "(let* ((a 1) (d 3) (e (+ d 1)) (f (+ d 2))) (display d) (* a d e f))"
+	     " let*: perhaps split this let*: (let* ((a 1) (d 3) (e (+ d 1)) (f (+ d 2))) (display d) (* a d e f)) ->
+                 (let ((a 1) (d 3)) (let ((e (+ d 1)) (f (+ d 2))) ...))")
+  (lint-test "(let* ((d 3) (e (+ d 1)) (f (+ d 2))) (display d) (* d e f))"
+	     " let*: perhaps split this let*: (let* ((d 3) (e (+ d 1)) (f (+ d 2))) (display d) (* d e f)) ->
+                 (let ((d 3)) (let ((e (+ d 1)) (f (+ d 2))) ...))")
+  (lint-test "(let* ((d 3) (e (+ d 1))) (display d) (* d e))" "")
+  (lint-test "(let* ((a 3) (b (set! c 1)) (c 3))  (display a) (* a b c))"
+	     " let*: perhaps split this let*: (let* ((a 3) (b (set! c 1)) (c 3)) (display a) (* a b c)) ->
+                 (let ((b (set! c 1))) (let ((a 3) (c 3)) ...))")
+  (lint-test "(let* ((f 3) (a (set! c 1)) (c 3) (b 4) (d 5))  (display a) (* a c b d f))"
+	     " let*: perhaps split this let*: (let* ((f 3) (a (set! c 1)) (c 3) (b 4) (d 5)) (display a) (* a c b d f)) ->
+                 (let ((f 3) (b 4) (d 5)) (let* ((a (set! c 1)) (c 3)) ...))")
+  (lint-test "(let* ((f (+ a 1)) (a (+ c 1)) (c 3)) (display a) (* a c f))" "")
+
+  (lint-test "(letrec () 1)"		" letrec: letrec could be let: (letrec () 1)")
+  (lint-test "(letrec* ((a (lambda b (a 1)))) a)" " letrec*: letrec* could be letrec: (letrec* ((a (lambda b (a 1)))) a)")
+  (lint-test "(letrec* ((x 12) (x y)) x)"
+	     " letrec*: letrec* could be let*: (letrec* ((x 12) (x y)) x)
+               letrec*: letrec* variable x is declared twice
+               letrec*: x not used, initially: 12 from letrec*")
+  (lint-test "(letrec ((x x)) x)"       " letrec: (x x) is the same as (x #<undefined>) in letrec")
+  (lint-test "(letrec* ((x x)) x)"
+	     " letrec*: letrec* could be letrec: (letrec* ((x x)) x) letrec*: (x x) is the same as (x #<undefined>) in letrec*")
+  (lint-test "(letrec* ((x 1) (y (log 2))) (+ (g x) y))" " letrec*: letrec* could be let: (letrec* ((x 1) (y (log 2))) (+ (g x) y))")
+  (lint-test "(letrec ((f (lambda (z) (+ (f z) 1)))) (lambda (x) (* (f x) x)))"
+	     " letrec: perhaps (letrec ((f (lambda (z) (+ (f z) 1)))) (lambda (x) (* (f x) x))) -> (lambda (x) (* (let f ((z x)) (+ (f z) 1)) x))")
+
+  (lint-test "(begin . 1)"		" begin: stray dot in begin?        (begin . 1)")
+  (lint-test "(begin (map abs x) #f)"	" begin: this could be omitted: (map abs x)")
+  (lint-test "(begin (map display x) #f)" " begin: map could be for-each: (for-each display x)")
+  (lint-test "(begin 1 #f)"		" begin: this could be omitted: 1")
+  (lint-test "(begin (+ x y) 3)"	" begin: this could be omitted: (+ x y)")
+  (lint-test "(begin (display 1) (begin #f))" " begin: redundant begin: (begin #f)  begin: begin could be omitted: (begin #f)")
+  (lint-test "(begin (lambda (x) (log x 4)) 32)" " begin: this has no effect: (lambda (x) (log x 4))")
+
+  (lint-test "(let () (display 1) (begin (display 1) #f))"
+	     " let: let could be begin: (let () (display 1) (begin (display 1) #f)) -> (begin (display 1) (begin (display 1) #f))
+               let: redundant begin: (begin (display 1) #f)")
+  (lint-test "(if (< x 1) (begin x) y)" " if: begin could be omitted: (begin x)")
+  (lint-test "(if (< x 1) (begin (display 1) x) y)" "")
+  (lint-test "(let ((menu (lw6-current-menu))) (if menu (begin #f)))"
+             " let: perhaps (let ((menu (lw6-current-menu))) (if menu (begin #f))) -> (if (lw6-current-menu) (begin #f))
+               let:  perhaps (if menu (begin #f)) -> (when menu #f)
+               let: begin could be omitted: (begin #f)")
+  (lint-test "(let ((menu (lw6-current-menu))) (when menu (begin #f)))"
+	     " let: perhaps (let ((menu (lw6-current-menu))) (when menu (begin #f))) -> (when (lw6-current-menu) (begin #f))
+               let: redundant begin: (begin #f)
+               let: begin could be omitted: (begin #f)")
+  (lint-test "(let ((vec (vector-ref matrix x))) (if vec (vector-set! (vector-ref matrix x) y value)))"
+	     " let: perhaps (let ((vec (vector-ref matrix x))) (if vec (vector-set! (vector-ref matrix... ->
+                 (if (vector-ref matrix x) (vector-set! (vector-ref matrix x) y value))
+               let: perhaps (vector-set! (vector-ref matrix x) y value) -> (set! (matrix x y) value)")
+  (lint-test "(let ((menu (g-menu))) (if menu (display #f)) 32)"
+	     " let: perhaps (let ((menu (g-menu))) (if menu (display #f)) 32) -> (let () (if (g-menu) (display #f)) 32)")
+  (lint-test "(let ((menu (g-menu))) (cond (menu (display menu)) (else (display x))) 32)"
+	     " let: perhaps (let ((menu (g-menu))) (cond (menu (display menu)) (else (display x))) 32) -> (let () (cond ((g-menu) => display) (else (display x))) 32)
+               let: perhaps (cond (menu (display menu)) (else (display x))) -> (display (if menu menu x))
+               let: perhaps use => here: (menu (display menu)) -> (menu => display)")
+  (lint-test "(let ((A (abs x)) (B (abs y))) (if A (f A)))"
+	     " let: perhaps (let ((A (abs x)) (B (abs y))) (if A (f A))) -> (let ((B (abs y))) (cond ((abs x) => f)))
+               let: B not used, initially: (abs y) from let
+               let: A is never #f, so (if A (f A)) -> (f A)")
+
+  (lint-test "(format)" " format: format needs at least 2 arguments: (format) format: format has too few arguments: (format)")
+  (lint-test "(format \"buffer?\")"
+	     " format: format needs at least 2 arguments: (format \"buffer?\")
+               format: in (format \"buffer?\"), format's argument should be an output-port or a boolean, but \"buffer?\" is a string?
+               format: perhaps (format \"buffer?\") -> \"buffer?\"")
+  (lint-test "(format (format #f str))"
+	     " format: format needs at least 2 arguments: (format (format #f str))
+               format: in (format (format #f str)), format's argument should be an output-port or a boolean, but (format #f str) is a string?
+               format: redundant format: (format (format #f str))")
+  (lint-test "(format #f \"~H\" 1)"	" format: unrecognized format directive: H in \"~H\", (format #f \"~H\" 1)")
+  (lint-test "(format #f \"~^\")"	" format: ~^ has ~^ outside ~{~}?")
+  (lint-test "(format #f \"~A\")"	" format: format has too few arguments: (format #f \"~A\")")
+  (lint-test "(format #f \"~A\" 1 2)"	" format: format has too many arguments: (format #f \"~A\" 1 2)")
+  (lint-test "(format #f \"asdf~\")"	" format: format control string ends in tilde: (format #f \"asdf~\")")
+  (lint-test "(format #f \"~{~A\" 1)"	" format: format has 1 unmatched {: (format #f \"~{~A\" 1)")
+  (lint-test "(format #f \"123\")"	" format: (format #f \"123\") could be \"123\", (format is a no-op here)")
+  (lint-test "(format #f \"~nD\" 1 2)"	"")
+  (lint-test "(format #f \"~n,nD\" 1 2 3)" "")
+  (lint-test "(format #f \"~%~&\")"     " format: ~%~& in ~%~& could be ~%")
+  (lint-test "(format #f \"~~%~&\")"    "")
+  (lint-test "(format #f \"1~%~&2\")"   " format: ~%~& in 1~%~&2 could be ~%")
+  (lint-test "(format #f \"~nT\" 1 2)"	" format: format has too many arguments: (format #f \"~nT\" 1 2)")
+  (lint-test "(format #f \"~nD\" 1)"	" format: format has too few arguments: (format #f \"~nD\" 1)")
+  (lint-test "(format 1)"
+	     " format: format needs at least 2 arguments: (format 1)
+               format: in (format 1), format's argument should be an output-port or a boolean, but 1 is an integer?
+               format: format with one argument takes a string: (format 1)")
+  (lint-test "(format #f \"~NC ~W\" 1 #\\c 2)" "")
+  (lint-test "(format #f \"~4,3F\" x)"  "")
+  (lint-test "(format #f \"~32T\")"     "")
+  (lint-test "(format #f \"~a\\x00;b\" x)"
+	     " format: #\\null in a format control string will confuse both lint and format: \"~a\\x00;b\" in (format #f \"~a\\x00;b\" x)")
+  (lint-test "(let () (format #t \"~A\" x) x)"
+	     " let: let could be begin: (let () (format #t \"~A\" x) x) -> (begin (format #t \"~A\" x) x)
+               let: perhaps use () with format since the string value is discarded: (format () \"~A\" x)")
+  (lint-test "(format #f \"~A\" (number->string x))" " format: format argument (number->string x) could be x")
+  (lint-test "(format #f \"~A\" (number->string x 16))"
+	     " format: format argument (number->string x 16) could use the format directive ~X and change the argument to x")
+  (lint-test "(format #f \"~A\" (symbol->string 'x))"
+	     " format: format argument (symbol->string 'x) could be 'x  format: perhaps (symbol->string 'x) -> \"x\"")
+  (lint-test "(format #f \"~A\" (make-string len c))"
+	     " format: format argument (make-string len c) could use the format directive ~NC and change the argument to ... len c ...")
+  (lint-test "(format #f \"~A\" (make-string len #\\space))"
+	     " format: format argument (make-string len #\\space) could use the format directive ~NC and change the argument to ... len #\\space ...")
+  (lint-test "(f \"*****************************\")" " f: perhaps \"*****************************\" -> (format #f \"~NC\" 29 #\\*)")
+  (lint-test "(format #f \"~A~%\" (apply string-append x))" " format: use ~{...~} rather than string-append: (apply string-append x)")
+  (lint-test "(format #f \"~A\" (symbol->string x))" " format: format argument (symbol->string x) could be x")
+  (lint-test "(format #f \"~S\" (symbol->string x))" "")
+  (lint-test "(format #f \"~A\" (string->symbol x))"
+	     " format: perhaps (format #f \"~A\" (string->symbol x)) -> (object->string (string->symbol x) #f)
+               format: format argument (string->symbol x) could be x")
+  (lint-test "(format #f \"~A\" x)" " format: perhaps (format #f \"~A\" x) -> (object->string x #f)")
+  (lint-test "(format #f \"~S\" x)" " format: perhaps (format #f \"~S\" x) -> (object->string x)")
+  (lint-test "(format t \" \")" " format: 't in (format t \" \") should probably be #t")
+  (lint-test "(format #f \"~A ~S\" (symbol->string x) (string->symbol x))" " format: format argument (symbol->string x) could be x")
+  (lint-test "(format #f \"~S~A\" (symbol->string x) (string->symbol x))" " format: format argument (string->symbol x) could be x")
+  (lint-test "(format #f \"this is~% a test~%\")" "format: format is not needed in (format #f \"this is~% a test~%\"): perhaps use \"this is\\n a test\\n\" instead")
+  (lint-test "(format p \"~%~S\" (object->string (car expr) #t 60))" "")
+  (lint-test "(format #f \"~12,'-T~A\" 123)" "")
+
+  (lint-test "(for-each (lambda (x) (display x)) args)"
+	     " for-each: perhaps (for-each (lambda (x) (display x)) args) -> (format () \"~{~A~}\" args) for-each: perhaps (lambda (x) (display x)) -> display")
+  (lint-test "(for-each (lambda (x) (display #\\space) (write x)) args)"
+	     " for-each: perhaps (for-each (lambda (x) (display #\\space) (write x)) args) -> (format () \"~{ ~S~}\" args)")
+  (lint-test "(for-each (lambda (x) (newline port) (write-char x port)) args)"
+	     " for-each: perhaps (for-each (lambda (x) (newline port) (write-char x port)) args) -> (format port \"~{~%~C~}\" args)")
+  (lint-test "(for-each (lambda (x) (newline port) (display (number->string x 16) port)) args)"
+	     " for-each: perhaps (for-each (lambda (x) (newline port) (display (number->string x 16) port))... -> (format port \"~{~%~X~}\" args)")
+  (lint-test "(values 1)"               " values: perhaps (values 1) -> 1")
+  (lint-test "(call-with-values p c)"                    " call-with-values: perhaps (call-with-values p c) -> (c (p))")
+  (lint-test "(call-with-values log c)"                  " call-with-values: log does not return multiple values")
+  (lint-test "(call-with-values (lambda x 0) list)"      " call-with-values: (lambda x 0)'s parameter x will always be ()")
+  (lint-test "(call-with-values (lambda (x) 0) list)"    " call-with-values: (lambda (x) 0) requires too many arguments")
+  (lint-test "(call-with-values (lambda () (f x)) cons)" " call-with-values: perhaps (call-with-values (lambda () (f x)) cons) -> (cons (f x))")
+  (lint-test "(call-with-values (lambda () (read-char p)) cons)" " call-with-values: (read-char p) does not return multiple values")
+  (lint-test "(call-with-values (lambda () (values 1 2 3)) list)"
+	     " call-with-values: perhaps (call-with-values (lambda () (values 1 2 3)) list) -> (list 1 2 3)")
+  (lint-test "(call-with-values (lambda () (values 1 2)) abs)"
+	     " call-with-values: call-with-values consumer abs wants 1 value, but producer (lambda () (values 1 2)) returns 2
+               call-with-values: perhaps (call-with-values (lambda () (values 1 2)) abs) -> (abs 1 2)")
+
+  (lint-test "(let () (define (fv a) (values (+ a 1) (- a 1))) (define (fw a b) (list (+ a 1) b)) (fw (fv 1)))" "")
+  (lint-test "(let () (define (fv a) (values (+ a 1) (- a 1))) (list (fv 1)))"
+	     " let: perhaps (... (define (fv a) (values (+ a 1) (- a 1))) (list (fv 1))) -> (... (list (let ((a 1)) (values (+ a 1) (- a 1)))))")
+  (unless (provided? 'snd)
+    (lint-test "(let () (define (fv) (values 1 -1)) (call-with-values fv list))"
+	       " let: perhaps (call-with-values fv list) -> (list (fv))")
+    (lint-test "(let () (define (fv) (values 1 -1)) (define (fw a b) (list (+ a 1) b)) (call-with-values fv fw))"
+	       " let: perhaps (call-with-values fv fw) -> (fw (fv))"))
+  (lint-test "(receive (value submitter) (current-input-status elt) #f)"
+	     " receive: perhaps (call-with-values (lambda () (current-input-status elt)) (lambda (value... ->
+                ((lambda (value submitter) #f) (current-input-status elt))")
+
+  (lint-test "(multiple-value-bind (a b) (f) b)"
+	     " multiple-value-bind: perhaps (multiple-value-bind (a b) (f) b) -> ((lambda (a b) b) (f))")
+  (lint-test "(multiple-value-bind (a b) (values 2 3) b)"
+	     " multiple-value-bind: perhaps (multiple-value-bind (a b) (values 2 3) b) -> ((lambda (a b) b) (values 2 3))")
+  (lint-test "(multiple-value-bind (a b c d) (values 2 (values 3 4) 5) (+ a b c d))"
+	     " multiple-value-bind: perhaps (multiple-value-bind (a b c d) (values 2 (values 3 4) 5) (+ a b c d)) ->
+                 ((lambda (a b c d) (+ a b c d)) (values 2 (values 3 4) 5))
+	       multiple-value-bind: perhaps (values 2 (values 3 4) 5) -> (values 2 3 4 5)")
+  (lint-test "(multiple-value-bind (a b) (values 1 2 3) b)"
+	     " multiple-value-bind: multiple-value-bind wants 2 values, but (values 1 2 3) returns 3
+               multiple-value-bind: perhaps (multiple-value-bind (a b) (values 1 2 3) b) -> ((lambda (a b) b) (values 1 2 3))")
+  (lint-test "(multiple-value-bind (a b) (f) (cons a b))"
+	     " multiple-value-bind: perhaps (multiple-value-bind (a b) (f) (cons a b)) -> (cons (f))")
+  (lint-test "(multiple-value-bind (a b) (values 1 2) (cons a b))"
+	     " multiple-value-bind: perhaps (multiple-value-bind (a b) (values 1 2) (cons a b)) -> (cons (values 1 2))")
+  (lint-test "(multiple-value-bind (a b) (f) b)" " multiple-value-bind: perhaps (multiple-value-bind (a b) (f) b) -> ((lambda (a b) b) (f))")
+
+  (lint-test "(let () (define (f1) (values 2 3 4)) (multiple-value-bind (a b) (f1) (+ a b)))"
+	     " let: perhaps (... (define (f1) (values 2 3 4)) (multiple-value-bind (a b) (f1) (+ a b))) ->
+                 (... (multiple-value-bind (a b) (values 2 3 4) (+ a b)))
+               let: multiple-value-bind wants 2 values, but (f1) returns 3
+               let: perhaps (multiple-value-bind (a b) (f1) (+ a b)) -> ((lambda (a b) (+ a b)) (f1))")
+  (lint-test "(let () (define (f1) (values 2)) (multiple-value-bind (a b) (f1) (+ a b)))"
+	     " let: perhaps (... (define (f1) (values 2)) (multiple-value-bind (a b) (f1) (+ a b))) ->
+                 (... (multiple-value-bind (a b) (values 2) (+ a b)))
+               f1: perhaps (values 2) -> 2
+               let: multiple-value-bind wants 2 values, but (f1) returns 1
+               let: perhaps (multiple-value-bind (a b) (f1) (+ a b)) -> ((lambda (a b) (+ a b)) (f1))")
+  (lint-test "(let () (multiple-value-bind (a b) ((lambda () (values 1 2 3))) (+ a b)))"
+	     " let: pointless let: (let () (multiple-value-bind (a b) ((lambda () (values 1 2 3))) (+ a b)))
+               let: multiple-value-bind wants 2 values, but ((lambda () (values 1 2 3))) returns 3
+               let: perhaps (multiple-value-bind (a b) ((lambda () (values 1 2 3))) (+ a b)) ->
+                 ((lambda (a b) (+ a b)) ((lambda () (values 1 2 3))))
+               let: perhaps ((lambda () (values 1 2 3))) -> (values 1 2 3)")
+
+  (lint-test "(let*-values (((a b) (f x))) (+ a b))"
+	     " let*-values: perhaps (let*-values (((a b) (f x))) (+ a b)) -> ((lambda (a b) (+ a b)) (f x))")
+  (lint-test "(let*-values (((a) (f x))) (+ a b))"
+	     " let*-values: perhaps (let*-values (((a) (f x))) (+ a b)) -> (let ((a (f x))) (+ a b))")
+  (lint-test "(let*-values ((a (f x))) (apply + a))"
+	     " let*-values: perhaps (let*-values ((a (f x))) (apply + a)) -> ((lambda a (apply + a)) (f x))")
+  (lint-test "(let*-values (((a b) (f x)) ((c) (g y))) (+ a b c))"
+	     " let*-values: perhaps (let*-values (((a b) (f x)) ((c) (g y))) (+ a b c)) ->
+               ((lambda (a b) (let ((c (g y))) (+ a b c))) (f x))")
+  (lint-test "(let*-values (((a) (f x)) ((c d) (g y))) (display c) (+ a b c))"
+	     " let*-values: perhaps (let*-values (((a) (f x)) ((c d) (g y))) (display c) (+ a b c)) ->
+               (let ((a (f x))) ((lambda (c d) (display c) (+ a b c)) (g y)))")
+  (lint-test "(let*-values (((a . b) (f x)) (c (g y))) (display c) (+ a b c))"
+	     " let*-values: perhaps (let*-values (((a . b) (f x)) (c (g y))) (display c) (+ a b c)) ->
+               ((lambda (a . b) ((lambda c (display c) (+ a b c)) (g y))) (f x))")
+  (lint-test "(let*-values (((a . b) (f x)) (c (g y)) ((d e f) (h a b))) (display c) (+ a b c))"
+	     " let*-values: perhaps (let*-values (((a . b) (f x)) (c (g y)) ((d e f) (h a b))) (display c) (+... ->
+               ((lambda (a . b) ((lambda c ((lambda (d e f) (display c) (+ a b c)) (h a b))) (g y))) (f x))")
+
+  (lint-test "(let-values (((x) (values 1))) x)"
+	      " let-values: perhaps (let-values (((x) (values 1))) x) -> ((lambda (x) x) (values 1))
+                let-values: perhaps (values 1) -> 1")
+  (lint-test "(let-values ((x (values 1))) x)"
+	     " let-values: perhaps (let-values ((x (values 1))) x) -> ((lambda x x) (values 1))
+               let-values: perhaps (values 1) -> 1")
+  (lint-test "(let-values (((x) (values 1)) ((y) (values 2))) (list x y))"
+	     " let-values: perhaps (let-values (((x) (values 1)) ((y) (values 2))) (list x y)) ->
+                (with-let (apply sublet (curlet)
+                            (list ((lambda (x) (values :x x)) (values 1))
+                                  ((lambda (y) (values :y y)) (values 2))))
+                  (list x y))
+               let-values: perhaps (values 1) -> 1
+               let-values: perhaps (values 2) -> 2")
+  (lint-test "(let ((x 32)) (let-values (((x) (values 1)) ((y) (values (+ x 1)))) (list x y)))"
+	     " let: perhaps (let-values (((x) (values 1)) ((y) (values (+ x 1)))) (list x y)) ->
+                 (with-let (apply sublet (curlet)
+                             (list ((lambda (x) (values :x x)) (values 1))
+                                   ((lambda (y) (values :y y)) (values (+ x 1)))))
+                  (list x y))
+               let: perhaps (values 1) -> 1
+               let: perhaps (values (+ x 1)) -> (+ x 1)")
+  (lint-test "(let-values (((x y) (values 1 2))) (list x y))"
+	     " let-values: perhaps (let-values (((x y) (values 1 2))) (list x y)) -> ((lambda (x y) (list x y)) (values 1 2))")
+  (lint-test "(let ((d 32)) (let-values (((a) 1) ((c d e) (values 3 4 5)) ((b) d)) (+ a b (* c d e))))"
+	     " let: perhaps (let-values (((a) 1) ((c d e) (values 3 4 5)) ((b) d)) (+ a b (* c d e))) ->
+                 (with-let (apply sublet (curlet)
+                             (list ((lambda (a) (values :a a)) 1)
+                                   ((lambda (c d e) (values :c c :d d :e e)) (values 3 4 5))
+                                   ((lambda (b) (values :b b)) d)))
+                  (+ a b (* c d e)))")
+  (lint-test "(let ((a 32) (b -1)) (let-values (((a b) (values 1 2)) ((x y) (values a b))) (list a b x y)))"
+	     " let: perhaps (let-values (((a b) (values 1 2)) ((x y) (values a b))) (list a b x y)) ->
+                 (with-let (apply sublet (curlet)
+                             (list ((lambda (a b) (values :a a :b b)) (values 1 2))
+                                   ((lambda (x y) (values :x x :y y)) (values a b))))
+                   (list a b x y))")
+
+  (lint-test "(let () (define-values (x y) (values 3 2)) (+ x y))"
+	     " let: perhaps (define-values (x y) (values 3 2)) -> (varlet (curlet) ((lambda (x y) (curlet)) (values 3 2)))")
+  (lint-test "(define (sequence-map/maker maker proc seq . opts) (let-optionals opts ((start 0) (end (sequence-length seq))) maker))"
+	     " define: perhaps (define (sequence-map/maker maker proc seq . opts) (let-optionals opts... ->
+                 (define* (sequence-map/maker maker proc seq (start 0) (end (sequence-length seq))) ...)")
+
+  (lint-test "(open-output-file x \"fb+\")" " open-output-file: unexpected mode: (open-output-file x \"fb+\")")
+  (lint-test "(vector 1 2 . 3)"         " vector: unexpected dot: (vector 1 2 . 3)")
+
+  (lint-test "(begin (display x) (newline) (display y) (newline))"
+	     " begin: perhaps (... (display x) (newline) (display y) (newline)) ->  (format () \"~A~%~A~%\" x y)")
+  (lint-test "(begin (display x) (newline) (display y) (newline) 32)"
+	     " begin: perhaps (... (display x) (newline) (display y) (newline)) ->  (format () \"~A~%~A~%\" x y)")
+  (lint-test "(begin (write x p) (newline p) (write-char #\\a p) (write-string \"bc\" p))"
+	     " begin: perhaps (... (write x p) (newline p) (write-char #\\a p) (write-string \"bc\" p)) ->  (format p \"~S~%abc\" x)")
+  (lint-test "(begin (newline) (set! x 1) (display x) (newline) (newline))"
+	     " begin: perhaps (... (display x) (newline) (newline)) -> (format () \"~A~%~%\" x)")
+  (lint-test "(begin (write-string x p y z) (write-string \"1234\" p 1) (write-string \"5678\" p 2 3) (write-string \"abc\" p 2 z))"
+	      " begin: perhaps
+                   (... (write-string x p y z) (write-string \"1234\" p 1) (write-string \"5678\"... ->
+                   (format p \"~A2347~A\" (substring x y z) (substring \"abc\" 2 z))")
+  (lint-test "(display x #f)" " display: (display x #f) could be x")
+  (lint-test "(read-line in-port 'concat)"
+	     "read-line: in (read-line in-port 'concat), read-line's second argument should be a boolean, but 'concat is a symbol?
+              read-line: the third argument should be boolean (#f=default, #t=include trailing newline): (read-line in-port 'concat)")
+  (lint-test "(begin (display (number->string x)) (display #\\space) (display (number->string y 8)))"
+	     " begin: perhaps (... (display (number->string x)) (display #\\space) (display... -> (format () \"~A ~O\" x y)")
+
+  (lint-test "(let ((f2 (lambda (x) (display (+ x 1))))) (f2 1) (f2 3) (f2 4))"
+	     " let: perhaps (let ((f2 (lambda (x) (display (+ x 1))))) (f2 1) (f2 3) (f2 4)) -> (for-each (lambda (x) (display (+ x 1))) '(1 3 4))")
+  (lint-test "(let ((f2 (lambda (x) (display x)))) (f2 'a) (f2 'b) (f2 'c))"
+	     " let: perhaps (lambda (x) (display x)) -> display
+               let: perhaps (let ((f2 (lambda (x) (display x)))) (f2 'a) (f2 'b) (f2 'c)) -> (for-each (lambda (x) (display x)) '(a b c))")
+  (lint-test "(let ((f2 (lambda (x) (display (+ x 1))))) (f2 a) (f2 b) (f2 (f c)))"
+	     " let: perhaps (let ((f2 (lambda (x) (display (+ x 1))))) (f2 a) (f2 b) (f2 (f c))) -> (for-each (lambda (x) (display (+ x 1))) (list a b (f c)))")
+
+  (lint-test "(+ 1 (begin (x y) #\\a))" " +: in (+ 1 (begin (x y) #\\a)), +'s second argument should be a number, but #\\a is a char?")
+  (lint-test "(+ 1 (cond ((x 1) 3) ((x 2) 1+i) ((x 3) '(1 2))))"
+	      " +: in (+ 1 (cond ((x 1) 3) ((x 2) 1.0+1.0i) ((x 3) '(1 2)))), +'s second argument should be a number, but '(1 2) is a pair?")
+  (lint-test "(+ 1 (cond ((x 1) 3) ((x 2) 1+i) ((x 3) 1/2)))" "")
+
+  (lint-test "(substring x 0)"		" substring: perhaps clearer:  (substring x 0) -> (copy x)")
+  (lint-test "(substring (substring x 1) 2)" " substring: perhaps (substring (substring x 1) 2) -> (substring x 3)")
+  (lint-test "(substring (substring x 2 6) 1)" " substring: perhaps (substring (substring x 2 6) 1) -> (substring x 3 6)")
+  (lint-test "(substring (substring x 2) 1 6)"  " substring: perhaps (substring (substring x 2) 1 6) -> (substring x 3 8)")
+  (lint-test "(substring (substring x 2 6) 1 3)" " substring: perhaps (substring (substring x 2 6) 1 3) -> (substring x 3 5)")
+  (lint-test "(substring (substring x 2) 1 4)" " substring: perhaps (substring (substring x 2) 1 4) -> (substring x 3 6)")
+  (lint-test "(substring (substring x x1) x2 y2)" " substring: perhaps (substring (substring x x1) x2 y2) -> (substring x (+ x2 x1) (+ y2 x1))")
+  (lint-test "(substring x (+ y 1) (+ y 1))" " substring: leaving aside errors, (substring x (+ y 1) (+ y 1)) is \"\"")
+  (lint-test "(substring x 0 (length x))" " substring: perhaps (substring x 0 (length x)) -> (substring x 0)")
+  (lint-test "(let ((len (string-length x))) (substring x 1 len))"
+	     " let: perhaps (let ((len (string-length x))) (substring x 1 len)) -> (substring x 1 (string-length x))
+               let: perhaps, if len is still (string-length x), (substring x 1 len) -> (substring x 1)")
+  (lint-test "(substring (string-append str (make-string len #\\space)) 0 len)"
+	     " substring: perhaps (substring (string-append str (make-string len #\\space)) 0 len) -> (copy str (make-string len #\\space))")
+  (lint-test "(substring \"--------\" x)" " substring: perhaps (substring \"--------\" x) -> (make-string (- 8 x) #\\-)")
+  (lint-test "(substring \"--------\" x y)" " substring: perhaps (substring \"--------\" x y) -> (make-string (- y x) #\\-)")
+
+  (lint-test "(list-tail x 0)"		" list-tail: perhaps (list-tail x 0) -> x")
+  (lint-test "(list-tail x 1)"		" list-tail: perhaps (list-tail x 1) -> (cdr x)")
+  (lint-test "(list-tail x 2)"		" list-tail: perhaps (list-tail x 2) -> (cddr x)")
+  (lint-test "(list-tail (list-tail x 1) 2)"
+	     " list-tail: perhaps (list-tail (list-tail x 1) 2) -> (list-tail x 3)
+               list-tail: perhaps (list-tail x 1) -> (cdr x)")
+  (lint-test "(list-tail (list-tail x y) z)" " list-tail: perhaps (list-tail (list-tail x y) z) -> (list-tail x (+ y z))")
+
+  (lint-test "(list (f (g x y) z (* a b)) (f (g x y) z (* a b)) (f (g x y) z (* a b)) (f (g x y) z (* a b)))"
+	     " list: perhaps (list (f (g x y) z (* a b)) (f (g x y) z (* a b)) (f (g x y) z (* a b)) (f... ->
+                 (let ((<1> (lambda () (f (g x y) z (* a b))))) (list (<1>) (<1>) (<1>) (<1>)))")
+  (lint-test "(list (f 'a) (f 'b) (f 'c))" " list: perhaps (list (f 'a) (f 'b) (f 'c)) -> (map f '(a b c))")
+  (lint-test "(list (f a) (f b) (f c))"    " list: perhaps (list (f a) (f b) (f c)) -> (map f (list a b c))")
+  (lint-test "(vector 12 12 12 12 12 12)" " vector: perhaps (vector 12 12 12 12 12 12) -> (make-vector 6 12)")
+  (lint-test "(vector (car x) (car x) (car x) (car x))" " vector: perhaps (vector (car x) (car x) (car x) (car x)) -> (make-vector 4 (car x))")
+  (lint-test "(vector #(1 2) #(1 2) #(1 2) #(1 2))"
+	     " vector: perhaps (vector #(1 2) #(1 2) #(1 2) #(1 2)) -> (make-vector 4 #(1 2))
+               or wrap (copy #(1 2)) in a function and call that 4 times
+               vector: #(1 2) could be #i(1 2) vector: #(1 2) could be #i(1 2) vector: #(1 2) could be #i(1 2) vector: #(1 2) could be #i(1 2)")
+  (lint-test "((list 1 2 3) x)"         " (list 1 2 3): perhaps use vector here: ((list 1 2 3) x)")
+  (lint-test "(int-vector 0 0 0 0)"     " int-vector: perhaps (int-vector 0 0 0 0) -> (make-int-vector 4)")
+  (lint-test "(unless x)"		" unless: unless is messed up:  (unless x)")
+  (lint-test "(unless (abs x) #f)"	" unless: unless test is never false: (unless (abs x) #f)")
+  (lint-test "(with-let x)"		" with-let: with-let is messed up:  (with-let x)")
+  (lint-test "(with-let (curlet) x)"	" with-let: with-let is not needed here:  (with-let (curlet) x)")
+  (lint-test "(object->string x y)"	"")
+  (lint-test "(object->string x :readable)" "")
+
+  (lint-test "(or)"			" or: perhaps (or) -> #f")
+  (lint-test "(or x)"			" or: perhaps (or x) -> x")
+  (lint-test "(or 'a)"			" or: perhaps (or 'a) -> 'a")
+  (lint-test "(or 'a 'b)"		" or: perhaps (or 'a 'b) -> 'a")
+  (lint-test "(or x x)"			" or: perhaps (or x x) -> x")
+  (lint-test "(or x x y)"		" or: perhaps (or x x y) -> (or x y)")
+  (lint-test "(or x y z z y)"           " or: perhaps (or x y z z y) -> (or x y z)")
+  (lint-test "(or (and x (or y z)) x)" "") ; these 3 hit the (cur 0) code and the 8-way var code
+  (lint-test "(or (and x y z) x z)" "")    ;   I think these results are correct -- many truths...
+  (lint-test "(or (and x y z) x)" "")
+  (lint-test "(or (and x y) (and x z))" " or: perhaps (or (and x y) (and x z)) -> (and x (or y z))")
+  (lint-test "(or 1 x)"			" or: perhaps (or 1 x) -> 1")
+  (lint-test "(or (or y) x)"		" or: perhaps (or (or y) x) -> (or y x)")
+  (lint-test "(or (or y x) x)"		" or: perhaps (or (or y x) x) -> (or y x)")
+  (lint-test "(or x (not x))"		"")
+  (lint-test "(or x (and x y))"		" or: perhaps (or x (and x y)) -> x")
+  (lint-test "(or (and x y) y)"         " or: perhaps (or (and x y) y) -> y")
+  (lint-test "(or x #f y)"		" or: perhaps (or x #f y) -> (or x y)")
+  (lint-test "(or x #f)"		" or: perhaps (or x #f) -> x")
+  (lint-test "(or x y #f)"              " or: perhaps (or x y #f) -> (or x y)")
+  (lint-test "(or x #t)"                "")
+  (lint-test "(or #t (display \"oops\"))" " or: perhaps (or #t (display \"oops\")) -> #t")
+  (lint-test "(or (pair? x) #t (even? y))" " or: perhaps (or (pair? x) #t (even? y)) -> (or (pair? x) #t)")
+  (lint-test "(or x (not (and x y)))"	"") ; someday?
+  (lint-test "(or (pair? x) (list? x))" " or: perhaps (or (pair? x) (list? x)) -> (list? x)")
+  (lint-test "(or (number? x) (rational? x))" " or: perhaps (or (number? x) (rational? x)) -> (number? x)")
+  (lint-test "(or (pair? x) (null? x))" " or: perhaps (or (pair? x) (null? x)) -> (list? x)")
+  (lint-test "(or (list? x) (list? x))" " or: perhaps (or (list? x) (list? x)) -> (list? x)")
+  (lint-test "(or #f (= x 1))"		" or: perhaps (or #f (= x 1)) -> (= x 1)")
+  (lint-test "(or (integer? (cadr x)) (number? (cadr x)))"
+	     " or: perhaps (or (integer? (cadr x)) (number? (cadr x))) -> (number? (cadr x))")
+  (lint-test "(or (eq? x 'a) (eq? x 'b) (eq? x 'c))"
+	     " or: perhaps (or (eq? x 'a) (eq? x 'b) (eq? x 'c)) -> (memq x '(a b c))")
+  (lint-test "(or (= x 1) (= x 2) (= x 3))"
+	     " or: perhaps (or (= x 1) (= x 2) (= x 3)) -> (member x '(1 2 3) =)")
+  (lint-test "(or (equal? x #()) (equal? x #(a)))"
+	     " or: perhaps (or (equal? x #()) (equal? x #(a))) -> (member x '(#() #(a)))")
+  (lint-test "(or (string=? x \"a\") (string=? x \"b\"))"
+	     " or: perhaps (or (string=? x \"a\") (string=? x \"b\")) -> (member x '(\"a\" \"b\") string=?)")
+  (lint-test "(or (char=? (cadr x) #\\a) (char=? (cadr x) #\\b))"
+	     " or: perhaps (or (char=? (cadr x) #\\a) (char=? (cadr x) #\\b)) ->  (memv (cadr x) '(#\\a #\\b))")
+  (lint-test "(or (= (let ((z 1)) (display z) z) 1) (= (let ((z 1)) (display z) z) 2))"
+	     " or: perhaps (or (= (let ((z 1)) (display z) z) 1) (= (let ((z 1)) (display z) z) 2)) -> (member (let ((z 1)) (display z) z) '(1 2) =)
+                or: display returns its first argument, so this could be omitted: z  or: display returns its first argument, so this could be omitted: z")
+  (lint-test "(or (not (null? x)) (not (pair? x)))" " or: perhaps (or (not (null? x)) (not (pair? x))) -> #t")
+  (lint-test "(or (not (symbol? x)) (keyword? x))" "")
+  (lint-test "(or (not (= x 1)) (not (= y 1)))" " or: perhaps (or (not (= x 1)) (not (= y 1))) -> (not (= x 1 y))")
+  (lint-test "(or (char=? x #\\a) (char=? x #\\A))" " or: perhaps (or (char=? x #\\a) (char=? x #\\A)) -> (char-ci=? x #\\A)")
+  (lint-test "(or (string=? x \"a\") (string=? x \"A\"))" " or: perhaps (or (string=? x \"a\") (string=? x \"A\")) -> (string-ci=? x \"A\")")
+  (lint-test "(or (< x y) (= x y))"     " or: perhaps (or (< x y) (= x y)) -> (<= x y)")
+  (lint-test "(or (eq? x #t) (eqv? #f x))" " or: perhaps (or (eq? x #t) (eqv? #f x)) -> (boolean? x) or: eqv? could be not: (eqv? #f x) -> (not x)")
+  (lint-test "(and (< x 1) (string? y))" "") ; check a simplification bug
+  (lint-test "(or (< x 1) (string? y))"  "")
+  (lint-test "(or (= x 1) (= x 1))"      " or: perhaps (or (= x 1) (= x 1)) -> (= x 1)")
+  (lint-test "(or (= (length val) 20) (= (length val) 21))" " or: perhaps (or (= (length val) 20) (= (length val) 21)) -> (<= 20 (length val) 21)")
+  (lint-test "(or (not (= x 1)) (not (= y 1)))" " or: perhaps (or (not (= x 1)) (not (= y 1))) -> (not (= x 1 y))")
+  (lint-test "(or (not (= x 1)) (not (= x 2)))" " or: perhaps (or (not (= x 1)) (not (= x 2))) -> #t")
+  (lint-test "(or (not (= x y)) (not (= x z)))" " or: perhaps (or (not (= x y)) (not (= x z))) -> (not (= x y z))")
+  (lint-test "(or () (= x 1))"            " or: perhaps (or () (= x 1)) -> ()")
+  (lint-test "(or #f #f)"                 " or: perhaps (or #f #f) -> #f")
+  (lint-test "(or (and (= n 2) (= d 2)) (and (= n 4) (= d 4)))" " or: perhaps (or (and (= n 2) (= d 2)) (and (= n 4) (= d 4))) -> (or (= n 2 d) (= n 4 d))")
+  (lint-test "(or (= n 2 d) (= n 4 d))" "")
+  (lint-test "(or (< x 1) (>= x 1))"      " or: perhaps (or (< x 1) (>= x 1)) -> #t")
+  (lint-test "(or (< x 1) (< x 2))"       " or: perhaps (or (< x 1) (< x 2)) -> (< x 2)")
+  (lint-test "(or (< x 1) (> x 2))"       " or: perhaps (or (< x 1) (> x 2)) -> (not (<= 1 x 2))")
+  (lint-test "(or (<= x 1) (< x 1))"      " or: perhaps (or (<= x 1) (< x 1)) -> (<= x 1)")
+  (lint-test "(or (< x 2) (> x 1))"       " or: perhaps (or (< x 2) (> x 1)) -> #t")
+  (lint-test "(or (<= x 1) (<= 2 x))"     " or: perhaps (or (<= x 1) (<= 2 x)) -> (not (< 1 x 2))")
+  (lint-test "(or (< x 3) (> 2 x))"       " or: perhaps (or (< x 3) (> 2 x)) -> (< x 3)")
+  (lint-test "(or (char<? x #\\1) (char>=? x #\\1))" " or: perhaps (or (char<? x #\\1) (char>=? x #\\1)) -> #t")
+  (lint-test "(or (string<? x \"1\") (string<? x \"2\"))" " or: perhaps (or (string<? x \"1\") (string<? x \"2\")) -> (string<? x \"2\")")
+  (lint-test "(or (integer? x) (< x 3) (> x 12))"  " or: perhaps (or (integer? x) (< x 3) (> x 12)) -> (or (integer? x) (not (<= 3 x 12)))")
+  (lint-test "(or (zero? x) (positive? x))" " or: perhaps (or (zero? x) (positive? x)) -> (not (negative? x))")
+  (lint-test "(or (zero? x) (negative? x))" " or: perhaps (or (zero? x) (negative? x)) -> (not (positive? x))")
+
+  (lint-test "(and (<= x y) (<= y z) (f x y z))" " and: perhaps (and (<= x y) (<= y z) (f x y z)) -> (and (<= x y z) (f x y z))")
+  (lint-test "(and (<= x y) (<= y z))"           " and: perhaps (and (<= x y) (<= y z)) -> (<= x y z)")
+  (lint-test "(or (< x y) (> x z))"              " or: perhaps (or (< x y) (> x z)) -> (not (<= y x z))")
+  (lint-test "(or (>= x y) (<= x z))"            " or: perhaps (or (>= x y) (<= x z)) -> (not (> y x z))")
+  (lint-test "(or (< (car v1) (car v2)) (> (car v1) (car v2)))"
+	     " or: perhaps (or (< (car v1) (car v2)) (> (car v1) (car v2))) -> (not (= (car v1) (car v2)))")
+  (lint-test "(or (< (car v1) (car v2)) (>= (car v1) (car v2)))"
+	     " or: perhaps (or (< (car v1) (car v2)) (>= (car v1) (car v2))) -> #t")
+  (lint-test "(or (<= (car v1) (car v2)) (>= (car v1) (car v2)))"
+	     " or: perhaps (or (<= (car v1) (car v2)) (>= (car v1) (car v2))) -> #t")
+
+  (lint-test "(or (and A B) (and (not A) (not B)))" " or: perhaps (or (and A B) (and (not A) (not B))) -> (eq? (not A) (not B))")
+  (lint-test "(or (and A (not B)) (and (not A) B))" " or: perhaps (or (and A (not B)) (and (not A) B)) -> (not (eq? (not A) (not B)))")
+  (lint-test "(or (and A B) (and (not A) C))"       " or: perhaps (or (and A B) (and (not A) C)) -> (if A B C)")
+  (lint-test "(if (or (and A B) (and (not A) C)) 32)"  " or: perhaps (or (and A B) (and (not A) C)) -> (if A B C)")
+  (lint-test "(or (and (not A) B) (and A C))"       " or: perhaps (or (and (not A) B) (and A C)) -> (if A C B)")
+  (lint-test "(or (and A B) (and A C))"  " or: perhaps (or (and A B) (and A C)) -> (and A (or B C))")
+  (lint-test "(or (and A B) (and C B))"  " or: perhaps (or (and A B) (and C B)) -> (and (or A C) B)")
+  (lint-test "(and (or A B) (or A C))"   " and: perhaps (and (or A B) (or A C)) -> (or A (and B C))")
+  (lint-test "(and (or A B) (or C B))"   " and: perhaps (and (or A B) (or C B)) -> (or (and A C) B)")
+  (lint-test "(or (not A) (and A B))"    " or: perhaps (or (not A) (and A B)) -> (or (not A) B)")
+  (lint-test "(or A (and (not A) B))"    " or: perhaps (or A (and (not A) B)) -> (or A B)")
+  (lint-test "(and A (not A))"           " and: perhaps (and A (not A)) -> #f")
+  (lint-test "(or (and x y) (and x z) (and x w))" " or: perhaps (or (and x y) (and x z) (and x w)) -> (and x (or y z w))")
+  (lint-test "(or (and x y) (and z y) (and w y))" " or: perhaps (or (and x y) (and z y) (and w y)) -> (and (or x z w) y)")
+  (lint-test "(or (and x y w) (and x z) (and x a b))" " or: perhaps (or (and x y w) (and x z) (and x a b)) -> (and x (or (and y w) z (and a b)))")
+
+  (lint-test "(or (and (eq? x 'a) (< y 1)) (and (memq x '(b c)) (< y 2) (> z 1)) (and (null? x) (< y 3)))"
+	     " or: perhaps (or (and (eq? x 'a) (< y 1)) (and (memq x '(b c)) (< y 2) (> z 1)) (and... ->
+                (case x ((a) (< y 1)) ((b c) (and (< y 2) (> z 1))) ((()) (< y 3)) (else #f))")
+  (lint-test "(or (and (eq? x 'a) (< y 1)) (and (memq x '(b c)) (< y 2) (> z 1)) (< y 3))" "")
+  (lint-test "(or (eq? x 'a) (eq? x 'b) (eq? x 'c) (and (< z 3) (< y 4)))"
+	     " or: perhaps (or (eq? x 'a) (eq? x 'b) (eq? x 'c) (and (< z 3) (< y 4))) -> (or (memq x '(a b c)) (and (< z 3) (< y 4)))")
+  (lint-test "(or (< y 4) (eq? x 'a) (eq? x 'b) (eq? x 'c))" " or: perhaps (or (< y 4) (eq? x 'a) (eq? x 'b) (eq? x 'c)) -> (or (< y 4) (memq x '(a b c)))")
+  (lint-test "(or (> y 32) (eq? x 'a) (eq? x 'b) (eq? x 'c) (and (< z 3) (< y 4)))"
+	     " or: perhaps (or (> y 32) (eq? x 'a) (eq? x 'b) (eq? x 'c) (and (< z 3) (< y 4))) -> (or (> y 32) (memq x '(a b c)) (and (< z 3) (< y 4)))")
+  (lint-test "(or (> y 32) (> z 32) (eq? x 'a) (eq? x 'b) (eq? x 'c) (< z 3) (< y 4))"
+	     " or: perhaps (or (> y 32) (> z 32) (eq? x 'a) (eq? x 'b) (eq? x 'c) (< z 3) (< y 4)) -> (or (> y 32) (> z 32) (memq x '(a b c)) (< z 3) (< y 4))")
+  (lint-test "(or (> y 32) (> z 32) (eq? x 'a) (eq? x 'b) (eq? x 'c) (< z 3) (> z 4))"
+	     " or: perhaps (or (> y 32) (> z 32) (eq? x 'a) (eq? x 'b) (eq? x 'c) (< z 3) (> z 4)) ->
+                (or (> y 32) (> z 32) (memq x '(a b c)) (not (<= 3 z 4)))")
+  (lint-test "(or (and (eq? x 'a) (< y 1)) (and (eq? x 'b) (< z 2)) (and (eq? x 'a) (< w 2)))" "")
+  (lint-test "(or (not (= x y)) (not (= x z)))" " or: perhaps (or (not (= x y)) (not (= x z))) -> (not (= x y z))")
+  (lint-test "(or (not x) (< x 1))" " in (or (not x) (< x 1)), perhaps change (not x) to (not (real? x))")
+  (lint-test "(or (not x) (boolean? x))" " or: perhaps (or (not x) (boolean? x)) -> (boolean? x)")
+  (lint-test "(or (not x) (< x 1) y)" " in (or (not x) (< x 1) y), perhaps change (not x) to (not (real? x))")
+  (lint-test "(or (not (eq? val1 val2)) (not (eq? val2 val3)))" ; don't combine here into one eq?
+	     " or: perhaps (or (not (eq? val1 val2)) (not (eq? val2 val3))) -> (not (and (eq? val1 val2) (eq? val2 val3)))")
+
+  (lint-test "(and x (x))" " in (and x (x)), perhaps change x to (procedure? x)")
+  (lint-test "(if x (x))"  " in (if x (x)), perhaps change x to (procedure? x)")
+
+  (lint-test "(not (or (not x) (not y)))" " not: perhaps (not (or (not x) (not y))) -> (and x y)")
+  (lint-test "(not (or (not (< x y)) (not (equal? a b)) (not z)))"
+	     " not: perhaps (not (or (not (< x y)) (not (equal? a b)) (not z))) -> (and (< x y) (equal? a b) z)")
+  (lint-test "(not (and (not x) (not y)))" " not: perhaps (not (and (not x) (not y))) -> (or x y)")
+  (lint-test "(not (and (not (< x y)) (not (equal? a b)) (not z)))"
+	     " not: perhaps (not (and (not (< x y)) (not (equal? a b)) (not z))) -> (or (< x y) (equal? a b) z)")
+  (lint-test "(not (or (not x) (< y z) (not (< z x))))"
+	     " in (and x (< z x)), perhaps change x to (real? x)
+               not: perhaps (not (or (not x) (< y z) (not (< z x)))) -> (and x (>= y z) (< z x))")
+  (lint-test "(not (and (> x 2) (< x 5)))" " not: perhaps (not (and (> x 2) (< x 5))) -> (not (> 5 x 2))")
+  (lint-test "(not (and (> x 2) (not z)))" " not: perhaps (not (and (> x 2) (not z))) -> (or (<= x 2) z)")
+  (lint-test "(not (> x 1))"		" not: perhaps (not (> x 1)) -> (<= x 1)")
+  (lint-test "(not (<= 1 x 2))"         "")
+  (lint-test "(not (exact? x))"		" not: perhaps (not (exact? x)) -> (inexact? x)")
+  (lint-test "(not (not x))"		" paranoia: if you want a boolean, (not (not x)) -> (and x #t) not: perhaps (not (not x)) -> x")
+  (lint-test "(not (not (list? x)))"    " paranoia: list? returns a boolean, so (not (not (list? x))) -> (list? x) not: perhaps (not (not (list? x))) -> (list? x)")
+  (lint-test "(not (zero? (logand x (ash 1 z))))" " not: perhaps (not (zero? (logand x (ash 1 z)))) -> (logbit? x z)")
+  (lint-test "(not (zero? (logand x 64)))" " not: perhaps (not (zero? (logand x 64))) -> (logbit? x 6)")
+  (lint-test "(not x y)"		" not: not has too many arguments: (not x y)")
+  (lint-test "(not (+ x y))"            " not: (not (+ x y)) can't be true (+ never returns #f) not: perhaps (not (+ x y)) -> #f")
+  (lint-test "(not (list x y))"         " not: (not (list x y)) can't be true (list never returns #f) not: perhaps (not (list x y)) -> #f")
+  (lint-test "(not (if (f x) #t x))"
+	     " not: perhaps (not (if (f x) #t x)) -> (if (f x) #f (not x))
+               not: perhaps (if (f x) #t x) -> (or (f x) x)")
+  (lint-test "(not (begin (f x) x))" " not: perhaps (not (begin (f x) x)) -> (begin (f x) (not x))")
+  (lint-test "(not (case x ((0) (f x)) ((1) (not x))))"
+	     " not: perhaps (not (case x ((0) (f x)) ((1) (not x)))) -> (case x ((0) (not (f x))) ((1) x))
+               not: perhaps use => here: (case x ((0) (f x)) ((1) (not x))) -> (case x ((0) => f) ((1) => not))
+               not: in ((1) (not x)), perhaps replace (not x) with #f")
+  (lint-test "(not (cond ((f x) x) ((g x) (not x)) (else (error 'oops))))"
+	     " not: perhaps (not (cond ((f x) x) ((g x) (not x)) (else (error 'oops)))) -> (cond ((f x) (not x)) ((g x) x) (else (error 'oops)))")
+
+  (lint-test "(or (not (< x 2)) (not (> x 1)))" " or: perhaps (or (not (< x 2)) (not (> x 1))) -> (not (< 1 x 2))") ; confusing...
+  (lint-test "(or (string? x) (string=? x \"\"))" " or: perhaps (or (string? x) (string=? x \"\")) -> (string? x)")
+  (lint-test "(or (number? x) (= x 1.0))" " or: perhaps (or (number? x) (= x 1.0)) -> (number? x)")
+  (lint-test "(or (not x) (not (pair? x)))" " or: perhaps (or (not x) (not (pair? x))) -> (not (pair? x))")
+  (lint-test "(or (null? x) (not (list? x)))" " or: perhaps (or (null? x) (not (list? x))) -> (not (pair? x))")
+  (lint-test "(or (null? x) (not (string? x)))" " or: perhaps (or (null? x) (not (string? x))) -> (not (string? x))")
+  (lint-test "(or (null? x) (not (pair? x)))" " or: perhaps (or (null? x) (not (pair? x))) -> (not (pair? x))")
+  (lint-test "(or (pair? x) (not (pair? x)))" " or: perhaps (or (pair? x) (not (pair? x))) -> #t")
+  (lint-test "(or (let? x) (not (let? x)))" " or: perhaps (or (let? x) (not (let? x))) -> #t")
+
+  (lint-test "(or (< x y) (and (>= x y) (= x 3)))" " or: perhaps (or (< x y) (and (>= x y) (= x 3))) -> (or (< x y) (= x 3))")
+  (lint-test "(or (symbol? x) (and (not (symbol? x)) (= x 3)))" " or: perhaps (or (symbol? x) (and (not (symbol? x)) (= x 3))) -> (or (symbol? x) (= x 3))")
+  (lint-test "(or (< x y) (and (>= x y)))" " or: perhaps (or (< x y) (and (>= x y))) -> #t  or: perhaps (or (< x y) (and (>= x y))) -> #t")
+  (lint-test "(or (< x y) (and (= x 3)))" " or: perhaps (or (< x y) (and (= x 3))) -> (or (< x y) (= x 3))")
+  (lint-test "(or (< x y) (and (>= x y) (= x 3) (= y 1)))" " or: perhaps (or (< x y) (and (>= x y) (= x 3) (= y 1))) -> (or (< x y) (and (= x 3) (= y 1)))")
+  (lint-test "(or (< x y) (and (>= x y) (= x 1) (= y 3)))" " or: perhaps (or (< x y) (and (>= x y) (= x 1) (= y 3))) -> (or (< x y) (and (= x 1) (= y 3)))")
+  (lint-test "(and (< x y) (or (>= x y) (= x 3)))" " and: perhaps (and (< x y) (or (>= x y) (= x 3))) -> (and (< x y) (= x 3))")
+  (lint-test "(and (symbol? x) (or (not (symbol? x)) (eq? x 'a)))" " and: perhaps (and (symbol? x) (or (not (symbol? x)) (eq? x 'a))) -> (and (symbol? x) (eq? x 'a))")
+  (lint-test "(if (symbol? x) (or (not (symbol? x)) (eq? x 'a)) #f)"
+	     " and: perhaps (and (symbol? x) (or (not (symbol? x)) (eq? x 'a))) -> (and (symbol? x) (eq? x 'a))
+               if: perhaps (if (symbol? x) (or (not (symbol? x)) (eq? x 'a)) #f) -> (and (symbol? x) (or (not (symbol? x)) (eq? x 'a)))")
+  (lint-test "(if (symbol? x) x (if (not (symbol? x)) 32))"  " if: perhaps (if (symbol? x) x (if (not (symbol? x)) 32)) -> (if (symbol? x) x 32)")
+  (lint-test "(cond ((symbol? x) x) ((not (symbol? x)) 32))"
+	     " cond: perhaps (cond ((symbol? x) x) ((not (symbol? x)) 32)) -> (cond ((symbol? x) x) (else 32))
+               cond: perhaps (cond ((symbol? x) x) ((not (symbol? x)) 32)) -> (cond ((symbol? x) x) (#t 32))")
+  (lint-test "(cond ((< x y) 32) ((>= x y) 45))" " cond: perhaps (cond ((< x y) 32) ((>= x y) 45)) -> (cond ((< x y) 32) (else 45))")
+
+  (lint-test "(and)"			" and: perhaps (and) -> #t")
+  (lint-test "(and x)"			" and: perhaps (and x) -> x")
+  (lint-test "(and x #t)"		"")
+  (lint-test "(and x #f)"               " and: perhaps (and x #f) -> #f")
+  (lint-test "(and #f (display \"oops\"))" " and: perhaps (and #f (display \"oops\")) -> #f")
+  (lint-test "(and (pair? x) #f (even? y))" " and: perhaps (and (pair? x) #f (even? y)) -> #f")
+  (lint-test "(and x (not x))"		" and: perhaps (and x (not x)) -> #f")
+  (lint-test "(and x (and x y))"	" and: perhaps (and x (and x y)) -> (and x y)")
+  (lint-test "(and x (or x y))"         " and: perhaps (and x (or x y)) -> x")
+  (lint-test "(and (or x y) x)"         " and: perhaps (and (or x y) x) -> x")
+  (lint-test "(and (or x y) (or x z))"  " and: perhaps (and (or x y) (or x z)) -> (or x (and y z))")
+  (lint-test "(and (number? x) (pair? x))" " and: perhaps (and (number? x) (pair? x)) -> #f")
+  (lint-test "(and x (pair? x))"        " and: perhaps (and x (pair? x)) -> (pair? x)")
+  (lint-test "(and x (or y 123) z)"	" and: perhaps (and x (or y 123) z) -> (and x z)")
+  (lint-test "(and (pair? x) (list? x))" " and: perhaps (and (pair? x) (list? x)) -> (pair? x)")
+  (lint-test "(and (number? x) (rational? x))" " and: perhaps (and (number? x) (rational? x)) -> (rational? x)")
+  (lint-test "(and (pair? x) (null? x))" " and: perhaps (and (pair? x) (null? x)) -> #f")
+  (lint-test "(and (list? x) (list? x))" " and: perhaps (and (list? x) (list? x)) -> (list? x)")
+  (lint-test "(and 3.1 #f (= x 1))"	" and: perhaps (and 3.1 #f (= x 1)) -> #f")
+  (lint-test "(and 3.1 #t (= x 1))"	" and: perhaps (and 3.1 #t (= x 1)) -> (= x 1)")
+  (lint-test "(and (number? (cadr x)) (integer? (cadr x)))" " and: perhaps (and (number? (cadr x)) (integer? (cadr x))) -> (integer? (cadr x))")
+  (lint-test "(and x y x)"		"")
+  (lint-test "(and x y y)"		" and: perhaps (and x y y) -> (and x y)")
+  (lint-test "(and x y x y)"		" and: perhaps (and x y x y) -> (and x y)")
+  (lint-test "(and x #f y)"		" and: perhaps (and x #f y) -> #f")
+  (lint-test "(and x y #t z)"		" and: perhaps (and x y #t z) -> (and x y z)")
+  (lint-test "(and x y z z y)"          " and: perhaps (and x y z z y) -> (and x y z y)")
+  (lint-test "(and (g x) (g y) (g x))"	"")
+  (lint-test "(and (cadr x) (car y) (cadr x))" "")
+  (lint-test "(and (cadr x) (car y) (cadr x) (car y))" " and: perhaps (and (cadr x) (car y) (cadr x) (car y)) -> (and (cadr x) (car y))")
+  (lint-test "(and (g x) #f (g y))"	" and: perhaps (and (g x) #f (g y)) -> (and (g x) #f)")
+  (lint-test "(and x (or y 123 z))"	" and: perhaps (and x (or y 123 z)) -> (and x (or y 123))")
+  (lint-test "(and x (or y 123 z) w)"	" and: perhaps (and x (or y 123 z) w) -> (and x w)")
+  (lint-test "(and x (or (g y) z) w)"	"")
+  (lint-test "(and (integer? x) (number? x))" " and: perhaps (and (integer? x) (number? x)) -> (integer? x)")
+  (lint-test "(and x y #t)"		"")
+  (lint-test "(and x y (integer? 1))"	" and: perhaps (and x y (integer? 1)) -> (and x y #t)")
+  (lint-test "(and x (or x))"		" and: perhaps (and x (or x)) -> x")
+  (lint-test "(and (cadr x) (cadr x))"  " and: perhaps (and (cadr x) (cadr x)) -> (cadr x)")
+  (lint-test "(and (< x y) (< y z))"	" and: perhaps (and (< x y) (< y z)) -> (< x y z)")
+  (lint-test "(and (< x y) (< y z))"	" and: perhaps (and (< x y) (< y z)) -> (< x y z)")
+  (lint-test "(and (< y z) (< x y))"	" and: perhaps (and (< y z) (< x y)) -> (< x y z)")
+  (lint-test "(and (< x y) (< x y))"    " and: perhaps (and (< x y) (< x y)) -> (< x y)")
+  (lint-test "(and (< x y) (< y x))"    " and: perhaps (and (< x y) (< y x)) -> #f")
+  (lint-test "(and (< x y) (< z x))"    " and: perhaps (and (< x y) (< z x)) -> (< z x y)")
+  (lint-test "(and (= x y) (= y z))"	" and: perhaps (and (= x y) (= y z)) -> (= x y z)")
+  (lint-test "(and (= x y) (= x z))"    " and: perhaps (and (= x y) (= x z)) -> (= x y z)")
+  (lint-test "(and (= x y) (= y x))"    " and: perhaps (and (= x y) (= y x)) -> (= x y)")
+  (lint-test "(and (= x y) (= z x))"    " and: perhaps (and (= x y) (= z x)) -> (= z x y)")
+  (lint-test "(and (>= x y) (>= z x))"	" and: perhaps (and (>= x y) (>= z x)) -> (>= z x y)")
+  (lint-test "(and (>= x y) (>= x z))"	" and: perhaps (and (>= x y) (>= x z)) -> (>= x (max y z))")
+  (lint-test "(and (= x y) (= x z))"	" and: perhaps (and (= x y) (= x z)) -> (= x y z)")
+  (lint-test "(and (< x y) (> z y))"	" and: perhaps (and (< x y) (> z y)) -> (< x y z)")
+  (lint-test "(and (< x y) (< y (let ((z 1)) (display z) z)))" " and: display returns its first argument, so this could be omitted: z")
+  (lint-test "(and (pair? x) (null? x))"              " and: perhaps (and (pair? x) (null? x)) -> #f")
+  (lint-test "(and (> x 1) (> x 2))"                  " and: perhaps (and (> x 1) (> x 2)) -> (> x 2)")
+  (lint-test "(and (< x 1) (< x 2))"                  " and: perhaps (and (< x 1) (< x 2)) -> (< x 1)")
+  (lint-test "(and (< x 1) (< 2 x))"                  " and: perhaps (and (< x 1) (< 2 x)) -> #f")
+  (lint-test "(and (> x 1) (> 2 x))"                  " and: perhaps (and (> x 1) (> 2 x)) -> (> 2 x 1)")
+  (lint-test "(and (< x y) (< x z))"                  " and: perhaps (and (< x y) (< x z)) -> (< x (min y z))")
+  (lint-test "(and (= x 0) (zero? y))"                " and: perhaps (and (= x 0) (zero? y)) -> (= 0 x y)")
+  (lint-test "(and (= 0 x) (= y 0) (zero? z))"        " and: perhaps (and (= 0 x) (= y 0) (zero? z)) -> (= 0 x y z)")
+  (lint-test "(and (= x 0) (zero? x))"                " and: perhaps (and (= x 0) (zero? x)) -> (= 0 x)")
+  (lint-test "(and (integer? x) (exact? x))"          " and: perhaps (and (integer? x) (exact? x)) -> (integer? x)")
+  (lint-test "(and (integer? x) #t)"                  " and: perhaps (and (integer? x) #t) -> (integer? x)")
+  (lint-test "(and (inexact? x) (real? x))"           " and: perhaps (and (inexact? x) (real? x)) -> (and (real? x) (inexact? x))")
+  (lint-test "(and (infinite? x) (number? x))"        " and: perhaps (and (infinite? x) (number? x)) -> (infinite? x)")
+  (lint-test "(and (not (= x 1)) (not (= x 2)))"      " and: perhaps (and (not (= x 1)) (not (= x 2))) -> (not (member x '(1 2) =))")
+  (lint-test "(and (not (list? x)) (not (pair? x)))"  " and: perhaps (and (not (list? x)) (not (pair? x))) -> (not (list? x))")
+  (lint-test "(and (not (null? x)) (not (pair? x)))"  " and: perhaps (and (not (null? x)) (not (pair? x))) -> (not (list? x))")
+  (lint-test "(and (not (null? x)) (not (list? x)))"  " and: perhaps (and (not (null? x)) (not (list? x))) -> (not (list? x))")
+  (lint-test "(and (zero? x) (zero? y))"              " and: perhaps (and (zero? x) (zero? y)) -> (= 0 x y)")
+  (lint-test "(and (string? x) (string=? x \"\"))"    " and: perhaps (and (string? x) (string=? x \"\")) -> (equal? x \"\")")
+  (lint-test "(and (number? x) (= x 1.0))"            " and: perhaps (and (number? x) (= x 1.0)) -> (memv x '(1 1.0))")
+  (lint-test "(and (real? x) (= x 1))"                " and: perhaps (and (real? x) (= x 1)) -> (memv x '(1 1.0))")
+  (lint-test "(and (integer? x) (= x 1))"             " and: perhaps (and (integer? x) (= x 1)) -> (eqv? x 1)")
+  (lint-test "(and (integer? x) (= x y))"             " and: perhaps (and (integer? x) (= x y)) -> (eqv? x y)")
+  (lint-test "(and (complex? x) (= x y))"             "")
+  (lint-test "(and (symbol? x) (eq? x 'a))"           " and: perhaps (and (symbol? x) (eq? x 'a)) -> (eq? x 'a)")
+  (lint-test "(and (keyword? x) (eq? x :a))"          " and: perhaps (and (keyword? x) (eq? x :a)) -> (eq? x :a)")
+  (lint-test "(or (= x 1) (not (and (not (= y 2)) (not (= z 3)))))"
+	     " or: perhaps (or (= x 1) (not (and (not (= y 2)) (not (= z 3))))) -> (or (= x 1) (= y 2) (= z 3))")
+  (lint-test "(and (= x 1) (not (or (not (= y 2)) (not (= z 3)))))"
+	     " and: perhaps (and (= x 1) (not (or (not (= y 2)) (not (= z 3))))) -> (and (= x 1) (= y 2) (= z 3))")
+  (lint-test "(and (pair? x) (not (list? x)))"        " and: perhaps (and (pair? x) (not (list? x))) -> #f")
+  (lint-test "(and (list? x) (not (pair? x)))"        " and: perhaps (and (list? x) (not (pair? x))) -> (null? x)")
+  (lint-test "(and (not (null? x)) (list? x))"        " and: perhaps (and (not (null? x)) (list? x)) -> (pair? x)")
+  (lint-test "(and (pair? x) (not (null? x)))"        " and: perhaps (and (pair? x) (not (null? x))) -> (pair? x)")
+  (lint-test "(and (pair? x) (not (string? x)))"      " and: perhaps (and (pair? x) (not (string? x))) -> (pair? x)")
+  (lint-test "(and (not (pair? x)) (symbol? x))"      " and: perhaps (and (not (pair? x)) (symbol? x)) -> (symbol? x)")
+  (lint-test "(and (not (eof-object? x)) (char=? x #\\a))" " and: perhaps (and (not (eof-object? x)) (char=? x #\\a)) -> (eqv? x #\\a)")
+  (lint-test "(and (real? x) (not (rational? x)))"    " and: perhaps (and (real? x) (not (rational? x))) -> (float? x)")
+  (lint-test "(and (list? x) (not (proper-list? x)))" "")
+  (lint-test "(and (real? x) (not (integer? x)))" "")
+  (lint-test "(and (number? x) (inexact? x) (real? x))" " and: perhaps (and (number? x) (inexact? x) (real? x)) -> (and (real? x) (inexact? x))")
+  (lint-test "(and (not (complex? x)) (real? x))"     " and: perhaps (and (not (complex? x)) (real? x)) -> #f")
+  (lint-test "(and (pair? x) (eq? x #<unspecified>))" " and: perhaps (and (pair? x) (eq? x #<unspecified>)) -> #f")
+  (lint-test "(and (eq? x 'a) (pair? x))"             " and: perhaps (and (eq? x 'a) (pair? x)) -> #f")
+  (lint-test "(and (not (pair? x)) (or (not (pair? y)) (not (pair? z))))"
+	     " and: perhaps (and (not (pair? x)) (or (not (pair? y)) (not (pair? z)))) -> (not (or (pair? x) (and (pair? y) (pair? z))))")
+  (lint-test "(or (not (pair? x)) (and (not (pair? y)) (not (pair? z))))"
+	     " or: perhaps (or (not (pair? x)) (and (not (pair? y)) (not (pair? z)))) -> (not (and (pair? x) (or (pair? y) (pair? z))))")
+  (lint-test "(if (and (not (pair? x)) (not (pair? z))) 1 2)" " if: perhaps (and (not (pair? x)) (not (pair? z))) -> (not (or (pair? x) (pair? z)))")
+  (lint-test "(if (or (not (pair? x)) (not (pair? z))) 2 1)"  " if: perhaps (or (not (pair? x)) (not (pair? z))) -> (not (and (pair? x) (pair? z)))")
+  (lint-test "(and (number? port) (exact? port) (integer? port))"  " and: perhaps (and (number? port) (exact? port) (integer? port)) -> (integer? port)")
+  (lint-test "(and (number? port) (integer? port) (exact? port))"  " and: perhaps (and (number? port) (integer? port) (exact? port)) -> (integer? port)")
+  (lint-test "(and (integer? port) (number? port) (real? port))"   " and: perhaps (and (integer? port) (number? port) (real? port)) -> (integer? port)")
+  (lint-test "(and (real? port) (number? port) (integer? port))"   " and: perhaps (and (real? port) (number? port) (integer? port)) -> (integer? port)")
+  (lint-test "(and (real? port) (integer? port) (integer? port))"  " and: perhaps (and (real? port) (integer? port) (integer? port)) -> (integer? port)")
+  (lint-test "(and (real? port) (number? port) (integer? port) (even? port))"
+	     " and: perhaps (and (real? port) (number? port) (integer? port) (even? port)) -> (and (integer? port) (even? port))")
+  (lint-test "(and (real? port) (number? port) (integer? port) (even? port) (positive? port))"
+	     " and: perhaps (and (real? port) (number? port) (integer? port) (even? port) (positive? port)) ->
+                 (and (integer? port) (even? port) (positive? port))")
+  (lint-test "(and (integer? x) (< x 12) (> x 3))" " and: perhaps (and (integer? x) (< x 12) (> x 3)) -> (and (integer? x) (> 12 x 3))")
+  (lint-test "(and (equal? (car a) (car b)) (equal? (cdr a) (cdr b)))"
+	     " and: perhaps (and (equal? (car a) (car b)) (equal? (cdr a) (cdr b))) -> (equal? a b)")
+  (lint-test "(and (equal? (caadr a) (caadr b)) (equal? (cdadr a) (cdadr b)))"
+	     " and: perhaps (and (equal? (caadr a) (caadr b)) (equal? (cdadr a) (cdadr b))) -> (equal? (cadr a) (cadr b))")
+  (lint-test "(and (equal? (car x) (car original)) (equal? (cdr x) (cdr original)))"
+	     " and: perhaps (and (equal? (car x) (car original)) (equal? (cdr x) (cdr original))) -> (equal? x original)")
+  (lint-test "(and (complex? x) (immutable? x))" "") ; x=2
+  (lint-test "(and (char-alphabetic? x) (immutable? x))" "") ; x=#\a
+  (lint-test "(and (continuation? x) (procedure? x))" "") ; x is continuation
+  (lint-test "(and (not (constant? x)) (symbol? x))" "") ; x=:constant
+  (lint-test "(and (exact? x) (odd? x))" "") ; x=1
+  (lint-test "(and (directory? x) (file-exists? x))" "and: perhaps (and (directory? x) (file-exists? x)) -> (directory? x)")
+  (lint-test "(and (not (float? x)) (real? x))" "") ; x=pi
+  (lint-test "(and (not (sequence? x)) (proper-list? x))" "and: perhaps (and (not (sequence? x)) (proper-list? x)) -> #f")
+  (lint-test "(and (real? x) (not (nan? x)))" "") ; x=nan.0
+
+  (lint-test "(and t! (string? t!))"                   " and: perhaps (and t! (string? t!)) -> (string? t!)")
+  (lint-test "(and t! (string? t!) v (string? v))"     " and: perhaps (and t! (string? t!) v (string? v)) -> (and (string? t!) (string? v))")
+  (lint-test "(and v (boolean? v) (not (equal? v w)))" " and: perhaps (and v (boolean? v) (not (equal? v w))) -> (and (eq? v #t) (not (equal? v w)))")
+  (lint-test "(and x (< x 2))"                         " in (and x (< x 2)), perhaps change x to (real? x)")
+  (lint-test "(and w x (substring s 0 x))"             " in (and x (substring s 0 x)), perhaps change x to (integer? x)")
+  (lint-test "(and x (+ (log x) 1))"                   " in (and x (+ (log x) 1)), perhaps change x to (number? x)")
+  (lint-test "(and z x (+ (log x) 1))"                 " in (and z x (+ (log x) 1)), perhaps change x to (number? x)")
+  (lint-test "(when x (display (log x)))"              " in (when x (display (log x))), perhaps change x to (number? x)")
+  (lint-test "(and x (substring s 0 x))"               " in (and x (substring s 0 x)), perhaps change x to (integer? x)")
+  (lint-test "(and v (v 100))"                         " in (and v (v 100)), perhaps change v to (procedure? v) ; or maybe sequence?")
+  (lint-test "(when x (substring y x))"                " in (when x (substring y x)), perhaps change x to (integer? x)")
+  (lint-test "(cond (x (+ 1 (abs x))) (else y))"       " in (cond (x (+ 1 (abs x))) (else y)), perhaps change x to (real? x)")
+  (lint-test "(and t! v (string? t!) (string? v))"
+	     " in (and t! v (string? t!) (string? v)), perhaps change (and ... t! ... (string? t!)) to (string? t!)
+               in (and t! v (string? t!) (string? v)), perhaps change (and ... v ... (string? v)) to (string? v)")
+  (lint-test "(and (number? a!) (positive? a!))" " in (and (number? a!) (positive? a!)), perhaps change (number? a!) to (real? a!)")
+  (lint-test "(and (number? x) (< x 1))"       " in (and (number? x) (< x 1)), perhaps change (number? x) to (real? x)")
+  (lint-test "(and (number? x) (even? x))" " in (and (number? x) (even? x)), perhaps change (number? x) to (integer? x)")
+  (lint-test "(and (list? arg2) (pair? arg2) (memq (car arg2) '(x y)))"
+	     " and: perhaps (and (list? arg2) (pair? arg2) (memq (car arg2) '(x y))) -> (and (pair? arg2) (memq (car arg2) '(x y)))")
+  (lint-test "(and (eq? val1 val2) (eq? val2 val3))" "")  ; don't combine these!
+  (lint-test "(and (equal? val1 val2) (equal? val2 val3))" "")
+
+  (lint-test "(and (pair? x) (not (pair? (car x))) (not y) (not (pair? (cdr x))) (string? z))"
+	     " and: perhaps (and (pair? x) (not (pair? (car x))) (not y) (not (pair? (cdr x))) (string? z)) ->
+                (and (pair? x) (not (or (pair? (car x)) y (pair? (cdr x)))) (string? z))")
+
+  (lint-test "(and (integer? val) (or (= val 100) (= val 120)))"
+             " and: perhaps (and (integer? val) (or (= val 100) (= val 120))) -> (memv val '(100 120))
+               in (and (integer? val) (member val '(100 120) =)), perhaps change (member val '(100 120) =) to (memv ...)
+               and: perhaps (and (integer? val) (or (= val 100) (= val 120))) -> (and (integer? val) (member val '(100 120) =))")
+  (lint-test "(and (integer? x) (= x 0))"          " and: perhaps (and (integer? x) (= x 0)) -> (eqv? x 0)")
+  (lint-test "(and (real? x) (= x 0))"             " and: perhaps (and (real? x) (= x 0)) -> (memv x '(0 0.0))")
+  (lint-test "(and (integer? x) (= x 2/3))"        " and: (and (integer? x) (= x 2/3)), but 2/3 is not integer?")
+  (lint-test "(and (integer? x) (= (* 2 y) x))"    " and: perhaps (and (integer? x) (= (* 2 y) x)) -> (eqv? x (* 2 y))")
+  (lint-test "(and (exact? x) (= x 0))"            " and: perhaps (and (exact? x) (= x 0)) -> (eqv? x 0)")
+  (lint-test "(and (symbol? x) (memq x '(a b c)))" " and: perhaps (and (symbol? x) (memq x '(a b c))) -> (memq x '(a b c))")
+  (lint-test "(and (not (eof-object? x)) (or (char=? x #\\space) (char=? x #\\a)))"
+             " and: perhaps (and (not (eof-object? x)) (or (char=? x #\\space) (char=? x #\\a))) -> (memv x '(#\\space #\\a))
+               and: perhaps (and (not (eof-object? x)) (or (char=? x #\\space) (char=? x #\\a))) -> (and (not (eof-object? x)) (memv x '(#\\space #\\a)))")
+
+  (lint-test "(or (pair? x) (not (pair? (car x))) (not y) (not (pair? (cdr x))) (string? z))"
+	     " or: perhaps (or (pair? x) (not (pair? (car x))) (not y) (not (pair? (cdr x))) (string? z)) ->
+                  (or (pair? x) (not (and (pair? (car x)) y (pair? (cdr x)))) (string? z))")
+  (lint-test "(or (not (list? info))
+		  (not (list? diff))
+		  (not (eq? (car diff) 'filter))
+		  (fnq (caar info) 1.0)
+		  (fnq (caadr info) 0.5)
+		  (fnq (caaddr info) 0.25)
+		  (not (= (cadar info) 0))
+		  (not (= (cadadr info) 1))
+		  (not (= (cadr (caddr info)) 1)))"
+	   " in (and (list? info) (list? diff) (eq? (car diff) 'filter)), perhaps change (list? diff) to (pair? diff)
+             or: perhaps (or (not (list? info)) (not (list? diff)) (not (eq? (car diff) 'filter))... ->
+                (or (not (and (list? info)
+                              (list? diff)
+                              (eq? (car diff) 'filter)))
+                    (fnq (caar info) 1.0)
+                    (fnq (caadr info) 0.5)
+                    (fnq (caaddr info) 0.25)
+                    (not (and (= (cadar info) 0)
+                              (= (cadadr info) 1)
+                              (= (cadr (caddr info)) 1))))")
+
+  (lint-test "(cond ((number? x) (< x 1)) ((number? y) (display (abs y))))"
+	     " in (cond ((number? x) (< x 1)) ((number? y) (display (abs y)))), perhaps change (number? x) to (real? x)
+               in (cond ((number? x) (< x 1)) ((number? y) (display (abs y)))), perhaps change (number? y) to (real? y)")
+  (lint-test "(cond ((number? y) (display (abs y))) ((number? x) (< x 1)))"
+	     " in (cond ((number? y) (display (abs y))) ((number? x) (< x 1))), perhaps change (number? y) to (real? y)
+               in (cond ((number? y) (display (abs y))) ((number? x) (< x 1))), perhaps change (number? x) to (real? x)")
+  (lint-test "(cond ((number? (car x)) (< (car x) 1)) ((number? (vector-ref z y)) (display (abs (vector-ref z y)))))"
+	     " in (cond ((number? (car x)) (< (car x) 1)) ((number? (vector-ref z y))..., perhaps change (number? (car x)) to (real? (car x))
+               in (cond ((number? (car x)) (< (car x) 1)) ((number? (vector-ref z y))..., perhaps change (number? (vector-ref z y)) to (real? (vector-ref z y))")
+  (lint-test "(cond ((not x) y) ((string=? x z) z))" " in (cond ((not x) y) ((string=? x z) z)), perhaps change (not x) to (not (string? x))")
+
+  (lint-test "(and (number? x) (display (abs x)))" " in (and (number? x) (display (abs x))), perhaps change (number? x) to (real? x)")
+  (lint-test "(and (number? x) x (display (abs x)))" " in (and (number? x) x (display (abs x))), perhaps change x to (real? x)")
+  (lint-test "(and (number? (car x)) (display (abs (car x))))"
+	     " in (and (number? (car x)) (display (abs (car x)))), perhaps change (number? (car x)) to (real? (car x))")
+  (lint-test "(and (number? (car x)) (display (abs (car x))) y)"
+	     " in (and (number? (car x)) (display (abs (car x))) y), perhaps change (number? (car x)) to (real? (car x))")
+
+  (lint-test "(or (not (number? x)) (display (abs x)))"
+	     " in (or (not (number? x)) (display (abs x))), perhaps change (not (number? x)) to (not (real? x))")
+  (lint-test "(or (not (number? (car x))) (display (abs (car x))))"
+	     " in (or (not (number? (car x))) (display (abs (car x)))), perhaps change (not (number? (car x))) to (not (real? (car x)))")
+  (lint-test "(or (not (number? (car x))) (display (abs (car x))) y)"
+	     " in (or (not (number? (car x))) (display (abs (car x))) y), perhaps change (not (number? (car x))) to (not (real? (car x)))")
+
+  (lint-test "(if (number? x) (display (abs x)))" " in (if (number? x) (display (abs x))), perhaps change (number? x) to (real? x)")
+  (lint-test "(if (not (number? x)) x (display (abs x)))"
+	     " in (if (not (number? x)) x (display (abs x))), perhaps change (not (number? x)) to (not (real? x))")
+  (lint-test "(if (number? (car x)) (display (abs (car x))))"
+	     " in (if (number? (car x)) (display (abs (car x)))), perhaps change (number? (car x)) to (real? (car x))")
+  (lint-test "(if (not (number? (car x))) x (display (abs (car x))))"
+	     " in (if (not (number? (car x))) x (display (abs (car x)))), perhaps change (not (number? (car x))) to (not (real? (car x)))")
+
+  (lint-test "(string-append x (if y z) x)"
+	     " string-append: in (string-append x (if y z) x), string-append's second argument should be a string, but #<unspecified> is untyped")
+  (lint-test "(string-append x (if y z w) x)" "")
+  (lint-test "(string-append str (apply string-append strs))"
+	     " string-append: perhaps (string-append str (apply string-append strs)) -> (string-append str (apply values strs))")
+  (lint-test "(string-append (apply string-append strs) str1 str2)"
+	     " string-append: perhaps (string-append (apply string-append strs) str1 str2) -> (string-append (apply values strs) str1 str2)")
+
+  (lint-test "(car (car x))"                 " car: perhaps (car (car x)) -> (caar x)")
+  (lint-test "(cdr (cadr x))"                " cdr: perhaps (cdr (cadr x)) -> (cdadr x)")
+  (lint-test "(car (car (cdr x)))"           " car: perhaps (car (car (cdr x))) -> (caadr x)")
+  (lint-test "(car (car (cdr (cdr x))))"     " car: perhaps (car (car (cdr (cdr x)))) -> (caaddr x)")
+  (lint-test "(car (cadr (cdr x)))"          " car: perhaps (car (cadr (cdr x))) -> (caaddr x)")
+  (lint-test "(cddar (car x))"               " cddar: perhaps (cddar (car x)) -> (cddaar x)")
+  (lint-test "(cadr (car (cdr x)))"          " cadr: perhaps (cadr (car (cdr x))) -> (cadadr x)")
+  (lint-test "(cddddr (cddr x))"             " cddddr: perhaps (cddddr (cddr x)) -> (list-tail x 6)")
+  (lint-test "(car (cddddr (cddr x)))"       " car: perhaps (car (cddddr (cddr x))) -> (list-ref x 6)")
+  (lint-test "(cadr (cddr (cdddr x)))"       " cadr: perhaps (cadr (cddr (cdddr x))) -> (list-ref x 6)")
+  (lint-test "(cadr (cddr (cdddr (cdr x))))" " cadr: perhaps (cadr (cddr (cdddr (cdr x)))) -> (list-ref x 7)")
+  (lint-test "(cddddr (cdddr (cddddr x)))"   " cddddr: perhaps (cddddr (cdddr (cddddr x))) -> (list-tail x 11)")
+  (lint-test "(car (caddr x))"               " car: perhaps (car (caddr x)) -> (caaddr x)")
+  (lint-test "(cdr (caadr x))"               " cdr: perhaps (cdr (caadr x)) -> (cdaadr x)")
+  (lint-test "(car (cadddr x))"              "")
+  (lint-test "(cdr (caaddr x))"              "")
+  (lint-test "(cadr (cddr x))"               " cadr: perhaps (cadr (cddr x)) -> (cadddr x)")
+  (lint-test "(cddr (cadr x))"               " cddr: perhaps (cddr (cadr x)) -> (cddadr x)")
+  (lint-test "(caddr (cddr x))"              " caddr: perhaps (caddr (cddr x)) -> (list-ref x 4)")
+  (lint-test "(cdddr (cadr x))"              "")
+  (lint-test "(caddr (cdr x))"               " caddr: perhaps (caddr (cdr x)) -> (cadddr x)")
+  (lint-test "(cdddr (car x))"               " cdddr: perhaps (cdddr (car x)) -> (cdddar x)")
+
+  (lint-test "(let ((x 3) (y 5)) (set! x (+ x y)) (+ x y))"  " let: set! returns the new value, so this could be omitted: (+ x y)")
+  (lint-test "(let ((x 3)) (set! x (+ x 1)) x)"
+	     " let: set! returns the new value, so this could be omitted: x
+               let: perhaps (let ((x 3)) (set! x (+ x 1)) x) -> (let ((x (+ 3 1))) x)")
+  (lint-test "(let ((x (list 1 2))) (set-car! x 3) (car x))" " let: set-car! returns the new value, so this could be omitted: (car x)")
+  (lint-test "(let ((x (list 1 2))) (set-cdr! x 3) (cdr y))" "")
+  (lint-test "(let ((g (make-oscil)) (v (make-vector 3))) (fill! v g) (oscil-bank v))" "")
+  (lint-test "(begin (vector-set! x 0 32) (vector-ref x 0))"
+	     " begin: vector-set! returns the new value, so this could be omitted: (vector-ref x 0)")
+  (lint-test "(begin (list-set! x (* y 2) 32) (list-ref x (* y 2)))"
+	     " begin: list-set! returns the new value, so this could be omitted: (list-ref x (* y 2))")
+  (lint-test "(let () (vector-set! x 0 32) (vector-ref x 0))"
+	     " let: let could be begin: (let () (vector-set! x 0 32) (vector-ref x 0)) -> (begin (vector-set! x 0 32) (vector-ref x 0))
+               let: vector-set! returns the new value, so this could be omitted: (vector-ref x 0)")
+  (lint-test "(let () (list-set! x (* y 2) 32) (list-ref x (* y 2)))"
+	     " let: let could be begin: (let () (list-set! x (* y 2) 32) (list-ref x (* y 2))) -> (begin (list-set! x (* y 2) 32) (list-ref x (* y 2)))
+               let: list-set! returns the new value, so this could be omitted: (list-ref x (* y 2))")
+  (lint-test "(begin (vector-set! x 0 (* y 2)) (* y 2))"
+	     " begin: vector-set! returns the new value, so this could be omitted: (* y 2)")
+  (lint-test "(begin (z 1) (do ((i 0 (+ i 1))) ((= i n) 32)))"
+	     " begin: this do-loop could be replaced by 32: (do ((i 0 (+ i 1))) ((= i n) 32))")
+  (lint-test "(vector-set! v i (vector-ref v i))"
+	     " vector-set!: redundant vector-set!: (vector-set! v i (vector-ref v i))")
+  (lint-test "(list-set! v (+ i 1) (list-ref v (+ i 1)))"
+	     " list-set!: redundant list-set!: (list-set! v (+ i 1) (list-ref v (+ i 1)))")
+  (lint-test "(string-set! v (+ i 1) (string-ref v (+ i 1)))"
+	     " string-set!: redundant string-set!: (string-set! v (+ i 1) (string-ref v (+ i 1)))")
+  (lint-test "(vector-ref (vector-ref x 0) y)"
+	     " vector-ref: perhaps (vector-ref (vector-ref x 0) y) -> (x 0 y)")
+  (lint-test "(vector-ref (make-vector 3) 1)"
+	     " vector-ref: this doesn't make much sense: (vector-ref (make-vector 3) 1)")
+  (lint-test "(list-ref (list-ref (list-ref (cadr x) (+ y 1)) (+ y 2)) (+ y 3))"
+	     " list-ref: perhaps (list-ref (list-ref (list-ref (cadr x) (+ y 1)) (+ y 2)) (+ y 3)) ->  ((cadr x) (+ y 1) (+ y 2) (+ y 3))")
+  (if (not pure-s7) (lint-test "(current-output-port 123)" " current-output-port: too many arguments: (current-output-port 123)"))
+  (lint-test "(copy (owlet))" " copy: (copy (owlet)) could be (owlet): owlet is copied internally")
+  (lint-test "(gcd x '(asd))" " gcd: in (gcd x '(asd)), gcd's second argument should be rational, but '(asd) is a list?")
+
+  (lint-test "(string #\\null)"	"")
+  (lint-test "(string (char->integer x))" " string: in (string (char->integer x)), string's argument should be a char, but (char->integer x) is an integer?")
+  (lint-test "(string (string-ref x 0))" " string: perhaps (string (string-ref x 0)) -> (substring x 0 1)")
+  (lint-test "(string (string-ref x 0) #\\a)" "")
+  (lint-test "(string (char-downcase (string-ref x 1)) (char-downcase (string-ref x 2)))"
+	     " string: perhaps (string (char-downcase (string-ref x 1)) (char-downcase (string-ref x 2))) ->
+                 (string-downcase (string (string-ref x 1) (string-ref x 2)))")
+
+  (lint-test "(+ 1 (dynamic-wind (lambda () #f) (lambda () #()) (lambda () #f)))"
+	     " +: in (+ 1 (dynamic-wind (lambda () #f) (lambda () #()) (lambda () #f))), +'s second argument should be a number, but #() is a vector?
+               +: this dynamic-wind is pointless, (dynamic-wind (lambda () #f) (lambda () #()) (lambda () #f)) -> #()")
+  (lint-test "(+ 1 (do () ((x) (display 3) #())))" " +: in (+ 1 (do () ((x) (display 3) #()))), +'s second argument should be a number, but #() is a vector?")
+  (lint-test "(+ 1 (case x ((0) 1) ((1) #()) (else 2)))" " +: in (+ 1 (case x ((0) 1) ((1) #()) (else 2))), +'s second argument should be a number, but #() is a vector?")
+  (lint-test "(+ 1 (values 2 3) #\\a)"  " +: in (+ 1 (values 2 3) #\\a), +'s fourth argument should be a number, but #\\a is a char?")
+  (lint-test "(+ 1 (values 2 #\\a) x)"  " +: in (+ 1 (values 2 #\\a) x), +'s third argument should be a number, but #\\a is a char?")
+  (lint-test "(let () ((lambda (a b) (+ (* 2 a) b)) (values 1 2)))" " let: pointless let: (let () ((lambda (a b) (+ (* 2 a) b)) (values 1 2)))")
+
+  (lint-test "(close-output-port 022120)"
+	     " close-output-port: in (close-output-port 22120), close-output-port's argument should be an output-port or #f, but 22120 is an integer?")
+  (lint-test "(close-input-port (log 32))"
+	     " close-input-port: in (close-input-port (log 32)), close-input-port's argument should be an input-port, but (log 32) is a number?")
+
+  (lint-test "(+ 1 (call-with-exit (lambda (rtn) (+ x (rtn #\\a)))))"
+	     " +: in (+ 1 (call-with-exit (lambda (rtn) (+ x (rtn #\\a))))), +'s second argument should be a number, but #\\a is a char?")
+  (lint-test "(call-with-exit (lambda (p) (+ x 1)))"
+	      " call-with-exit: call-with-exit exit function p appears to be unused: (call-with-exit (lambda (p) (+ x 1)))
+                call-with-exit: p not used, initially: :call/exit from call-with-exit")
+  (lint-test "(call-with-exit (lambda (return) (display x) (return (+ x y))))" " call-with-exit: return is redundant here: (return (+ x y))")
+  (lint-test "(call-with-exit (lambda (p) (+ p 1)))"  " call-with-exit: p is a continuation, but + in (+ p 1) wants a number?")
+  (lint-test "(begin (call-with-exit (lambda (quit) (if (< x 0) (quit (+ x 1))) (display x))) (+ x 2))"
+	     " begin: this call-with-exit return value will be ignored: (quit (+ x 1))")
+  (lint-test "(define (k1) (call-with-exit (lambda (quit) (display 'start) (quit 32) (newline))))" " k1: (quit 32) makes this pointless: (newline)")
+
+  (lint-test "(+ 1 (call/cc (lambda (c) (if x c (c 2)))))" "")
+  (lint-test "(+ 1 (call/cc (lambda (c) (if x (c 1) 2))))" " +: perhaps call/cc could be call-with-exit: (call/cc (lambda (c) (if x (c 1) 2)))")
+  (lint-test "(call/cc (lambda (p) (+ x (p 1))))" " call/cc: perhaps call/cc could be call-with-exit: (call/cc (lambda (p) (+ x (p 1))))")
+  (lint-test "(call/cc (lambda (p) p))" "")
+  (lint-test "(call/cc (lambda (p) (lambda () p)))" "")
+  (lint-test "(call/cc (lambda (p) (+ p 1)))"  " call/cc: p is a continuation, but + in (+ p 1) wants a number?")
+
+  (lint-test "(call-with-output-file file (lambda (p) (+ x 1)))"
+	     " call-with-output-file: p not used, initially: (open-output-file) from call-with-output-file")
+  (lint-test "(call-with-input-file \"file\" (lambda (p) (read-char p)))"
+	     " call-with-input-file: perhaps (call-with-input-file \"file\" (lambda (p) (read-char p))) -> (call-with-input-file \"file\" read-char)")
+
+  (lint-test "(with-output-to-string (lambda () (display object)))"
+	     " with-output-to-string: perhaps (with-output-to-string (lambda () (display object))) -> (object->string object #f)")
+  (lint-test "(with-output-to-string (lambda () (write (car defs)) (newline)))"
+	     " with-output-to-string: perhaps (with-output-to-string (lambda () (write (car defs)) (newline))) -> (format #f \"~S~%\" (car defs))")
+  (lint-test "(with-output-to-string (lambda () (write answer)))"
+	     " with-output-to-string: perhaps (with-output-to-string (lambda () (write answer))) -> (object->string answer)")
+  (lint-test "(call-with-output-string (lambda (p) (display object p)))"
+	     " call-with-output-string: perhaps (call-with-output-string (lambda (p) (display object p))) -> (object->string object #f)")
+
+  (lint-test "(quasiquote 1 2)"		" quasiquote: quasiquote has too many arguments: (quasiquote 1 2)")
+  (lint-test "(apply + 1)"		" apply: last argument should be a list:  (apply + 1)")
+  (lint-test "(apply (lambda (x) (abs x)) y)"
+	     " apply: perhaps (assuming y is a list of one element) (apply (lambda (x) (abs x)) y) -> (abs (car y))
+               apply: perhaps (lambda (x) (abs x)) -> abs")
+  (lint-test "(apply (lambda (x) (f x)) y)"
+	     " apply: perhaps (assuming y is a list of one element) (apply (lambda (x) (f x)) y) -> (f (car y))
+               apply: perhaps (lambda (x) (f x)) -> f")
+  (lint-test "(apply (lambda (x) x) y)" " apply: perhaps (assuming y is a list of one element) (apply (lambda (x) x) y) -> (car y)")
+  (lint-test "(apply log (list x y))"   " apply: perhaps (apply log (list x y)) -> (log x y)")
+  (lint-test "(apply + 1 2 ())"         " apply: perhaps (apply + 1 2 ()) -> (+ 1 2)")
+  (lint-test "(apply + '(1 2 3))"       " apply: perhaps (apply + '(1 2 3)) -> (+ 1 2 3)")
+  (lint-test "(apply eq? '(a b))"       " apply: perhaps (apply eq? '(a b)) -> (eq? 'a 'b)")
+  (lint-test "(apply f '(a b (c)))"     " apply: perhaps (apply f '(a b (c))) -> (f 'a 'b '(c))")
+  (lint-test "(apply f ())"             " apply: perhaps (apply f ()) -> (f)")
+  (lint-test "(apply list x)"           " apply: perhaps (apply list x) -> x")
+  (lint-test "(apply real? 1 3 rest)"   " apply: too many arguments for real?: (apply real? 1 3 rest)")
+  (lint-test "(apply f)"                " apply: perhaps (apply f) -> (f)")
+  (lint-test "(apply + (cons a b))"     " apply: perhaps (apply + (cons a b)) -> (apply + a b)")
+  (lint-test "(apply string (reverse chars))" " apply: perhaps (apply string (reverse chars)) -> (reverse (apply string chars))")
+  (lint-test "(apply + x y ())"         " apply: perhaps (apply + x y ()) -> (+ x y)")
+  (lint-test "(apply log x '())"        " apply: perhaps (apply log x '()) -> (log x) apply: quote is not needed here: '()")
+  (lint-test "(apply f (append (list y z) a b))" " apply: perhaps (apply f (append (list y z) a b)) -> (apply f y z (append a b))")
+  (lint-test "(apply f (append (list y z)))"     " apply: perhaps (apply f (append (list y z))) -> (apply f y z ()) apply: perhaps (append (list y z)) -> (list y z)")
+  (lint-test "(apply f (append (list y z) a))"
+	     " apply: perhaps (apply f (append (list y z) a)) -> (apply f y z a)
+               apply: perhaps (append (list y z) a) -> (cons y (cons z a))")
+  (lint-test "(apply map f (list x y))" " apply: perhaps (apply map f (list x y)) -> (map f x y)")
+  (lint-test "(apply string-append (map (lambda (x) (string-append x \" \")) input-files))"
+	     " apply: perhaps (apply string-append (map (lambda (x) (string-append x \" \")) input-files)) -> (format #f \"~{~A ~}\" input-files)")
+  (lint-test "(apply string-append (map symbol->string args))"
+	     " apply: perhaps (apply string-append (map symbol->string args)) -> (format #f \"~{~A~}\" args)")
+  (lint-test "(apply f y z (list a b))" " apply: perhaps (apply f y z (list a b)) -> (f y z a b)")
+  (lint-test "(apply append (map vector->list args))"
+	     " apply: perhaps (apply append (map vector->list args)) -> (vector->list (apply append args))")
+  (lint-test "(apply f (cons a (cons b c)))" " apply: perhaps (apply f (cons a (cons b c))) -> (apply f a b c)")
+  (lint-test "(apply car x)" " apply: perhaps (apply car x) -> (car (car x))")
+  (lint-test "(apply string (map char-downcase x))"
+	     " apply: perhaps, assuming x is a list, (apply string (map char-downcase x)) -> (string-downcase (apply string x))")
+  (lint-test "(apply f `(x ,y ,@z))"
+	     " apply: perhaps (apply f (list-values 'x y (apply-values z))) -> (apply f 'x y z)
+               apply: perhaps (list-values 'x y (apply-values z)) -> (cons 'x (cons y z))")
+  (lint-test "(apply f `(,@(list x y)))"
+	      " apply: perhaps (apply f (list-values (apply-values (list x y)))) -> (apply f (list x y))
+                apply: perhaps (list-values (apply-values (list x y))) -> (list x y)")
+  (lint-test "(apply f `(x (,y 1) ,z))" " apply: perhaps (apply f (list-values 'x (list-values y 1) z)) -> (f 'x (list y 1) z)")
+  (lint-test "(apply make-string tcnt initializer)" "")
+  (lint-test "(apply cons x y)" " apply: perhaps (apply cons x y) -> (cons x (car y))")
+  (lint-test "(apply string (make-list pad #\\null))" " apply: perhaps (apply string (make-list pad #\\null)) -> (make-string pad #\\null)")
+  (lint-test "(let ((v (vector 1 2 3))) (apply v (make-list 1 0)))"   ; don't complain here that v is not a procedure!
+	     " let: perhaps (let ((v (vector 1 2 3))) (apply v (make-list 1 0))) -> (apply (vector 1 2 3) (make-list 1 0))")
+  (lint-test "(apply (lambda (x) (+ x 1)) y ())" " apply: perhaps (apply (lambda (x) (+ x 1)) y ()) -> ((lambda (x) (+ x 1)) y)")
+  (lint-test "(apply append (map list x))" " apply: perhaps (apply append (map list x)) -> x")
+  (lint-test "(apply f (car x) (cdr x))" " apply: perhaps (apply f (car x) (cdr x)) -> (apply f x)")
+
+  (lint-test "(eval '(+ 1 2))"          " eval: perhaps (eval '(+ 1 2)) -> (+ 1 2)")
+  (lint-test "(eval 32)"                " eval: this eval is pointless; perhaps (eval 32) -> 32")
+  (lint-test "(eval 'x)"                " eval: perhaps (eval 'x) -> x")
+  (lint-test "(eval (string->symbol \"x\"))" " eval: perhaps (eval (string->symbol \"x\")) -> x eval: perhaps (string->symbol \"x\") -> 'x")
+  (lint-test "(eval 'x env)"            " eval: perhaps (eval 'x env) -> (env 'x)")
+  (lint-test "(eval (read (open-input-string expr)))"    " eval: perhaps (eval (read (open-input-string expr))) -> (eval-string expr)")
+  (lint-test "(eval (call-with-input-string port read))" " eval: perhaps (eval (call-with-input-string port read)) -> (eval-string port)")
+  (lint-test "(eval '(begin (display (* x y)) z) env)"   " eval: perhaps (eval '(begin (display (* x y)) z) env) -> (with-let env (display (* x y)) z)")
+  (lint-test "(eval (list '* 2 x))"     " eval: perhaps (eval (list '* 2 x)) -> (* 2 (eval x))")
+  (lint-test "(eval (string->symbol str))" " eval: perhaps (eval (string->symbol str)) -> (eval-string str)")
+
+  (lint-test "(write-char x (current-output-port))"
+	     " write-char: (current-output-port) is the default port for write-char: (write-char x (current-output-port))")
+  (lint-test "(with-let 123 123)"	" with-let: with-let: first argument should be an environment:  (with-let 123 123)")
+  (lint-test "(with-let (rootlet) 1)"	"")
+  (lint-test "(with-let e (define b (+ a 1)) (display a))" " with-let: b not used, initially: (+ a 1) from define")
+  (lint-test "(string-length \"asdf\")" " string-length: perhaps (string-length \"asdf\") -> 4")
+  (lint-test "(> 0 (string-length x))"  " >: string-length can't be negative: (> 0 (string-length x))")
+  (lint-test "(< (string-length x) 0)"  " <: string-length can't be negative: (< (string-length x) 0)")
+
+  (lint-test "(round '(1))"		" round: in (round '(1)), round's argument should be real, but '(1) is a list?")
+  (lint-test "(round '1.2)"		" round: quote is not needed here: '1.2")
+  (lint-test "(round (integer->char 96))"
+	     " round: in (round (integer->char 96)), round's argument should be real, but (integer->char 96) is a char?
+               round: perhaps (integer->char 96) -> #\\`")
+
+  (lint-test "(integer->char (+ (char->integer #\\space) 215))"
+	     " integer->char: perhaps (integer->char (+ (char->integer #\\space) 215)) -> #\\xf7")
+  (let-temporarily ((*report-sloppy-assoc* #t))
+    (lint-test "(char->integer (read-char p))"
+	       " char->integer: in (char->integer (read-char p)), char->integer's argument should be a char, but (read-char p) might also be an eof-object?
+                 char->integer: perhaps (char->integer (read-char p)) -> (read-byte p)"))
+  (lint-test "(write-char (integer->char c))" " write-char: perhaps (write-char (integer->char c)) -> (write-byte c)")
+
+  (lint-test "(let ((v (make-vector 3))) (vector-set! v 3.14 #\\a))"
+	     "let: perhaps (let ((v (make-vector 3))) (vector-set! v 3.14 #\\a)) -> (vector-set! (make-vector 3) 3.14 #\\a)
+	      let: in (vector-set! v 3.14 #\\a), vector-set!'s second argument should be an integer, but 3.14 is a float?")
+  (lint-test "(let ((v (make-float-vector 3))) (float-vector-set! v 3.14 1))"
+	     "let: perhaps (let ((v (make-float-vector 3))) (float-vector-set! v 3.14 1)) -> (float-vector-set! (make-float-vector 3) 3.14 1)
+              let: in (float-vector-set! v 3.14 1), float-vector-set!'s second argument should be an integer, but 3.14 is a float?")
+  (lint-test "(let ((v (make-float-vector 3))) (float-vector-set! v 1 3.14))"
+	     "let: perhaps (let ((v (make-float-vector 3))) (float-vector-set! v 1 3.14)) -> (float-vector-set! (make-float-vector 3) 1 3.14)")
+  (lint-test "(let ((v (make-float-vector 3))) (float-vector-set! v 1 #\\a))"
+	     "let: perhaps (let ((v (make-float-vector 3))) (float-vector-set! v 1 #\\a)) -> (float-vector-set! (make-float-vector 3) 1 #\\a)
+	      let: in (float-vector-set! v 1 #\\a), float-vector-set!'s third argument should be real, but #\\a is a char?")
+  (lint-test "(vector-set! (vector-ref a i) j x)" " vector-set!: perhaps (vector-set! (vector-ref a i) j x) -> (set! (a i j) x)")
+  (lint-test "(vector-set! (vector-copy doc) i newval)"
+	     " vector-set!: (vector-copy doc) is simply discarded; perhaps (vector-set! (vector-copy doc) i newval) -> newval")
+
+  (lint-test "(reverse! #i(1 2))"
+	     " reverse!: perhaps (reverse! #i(2 1)) -> #i(2 1)
+               reverse!: #i(2 1) is a constant, so (reverse! #i(2 1)) is problematic")
+  (lint-test "(sort! #r(0 1 2) <)" " sort!: #r(0.0 1.0 2.0) is a constant, so (sort! #r(0.0 1.0 2.0) <) is problematic")
+  (lint-test "(string-fill! \"123\" #\\c)" " string-fill!: 123 is a constant, so (string-fill! \"123\" #\\c) is problematic")
+  (lint-test "(list-fill! '(1 2 3) 1)" " list-fill!: '(1 2 3) is a constant, so (list-fill! '(1 2 3) 1) is problematic")
+  (lint-test "(vector-fill! #(0 a) 2)" " vector-fill!: #(0 a) is a constant, so (vector-fill! #(0 a) 2) is problematic")
+  (lint-test "(fill! #r(0 1 2) <)" " fill!: #r(0.0 1.0 2.0) is a constant, so (fill! #r(0.0 1.0 2.0) <) is problematic")
+  (lint-test "(set-car! '(1 2) 3)" " set-car!: '(1 2) is a constant, so (set-car! '(1 2) 3) is problematic")
+  (lint-test "(set-cdr! '(1 2) 3)" " set-cdr!: '(1 2) is a constant, so (set-cdr! '(1 2) 3) is problematic")
+  (lint-test "(let ((x #r(1 2))) (vector-set! x 0 1))"
+	     " let: perhaps (let ((x #r(1.0 2.0))) (vector-set! x 0 1)) -> (vector-set! #r(1.0 2.0) 0 1)
+               let: x's value, #r(1.0 2.0), is a literal constant, so this set! is trouble: (vector-set! x 0 1)
+               let: x is a float-vector, so perhaps use float-vector-set!, not vector-set!")
+  (lint-test "(int-vector-set! #i(0 1) 0 1)"
+	     " int-vector-set!: #i(0 1) is a constant, so int-vector-set! is problematic, and #i(0 1) is discarded; perhaps (int-vector-set! #i(0 1) 0 1) -> 1")
+  (lint-test "(float-vector-set! #r(0 1) 0 1)"
+	     " float-vector-set!: #r(0.0 1.0) is a constant, so float-vector-set! is problematic, and #r(0.0 1.0) is discarded; perhaps (float-vector-set! #r(0.0 1.0) 0 1) -> 1")
+  (lint-test "(list-set! '(1 2) 0 1)"
+	     " list-set!: '(1 2) is a constant, so list-set! is problematic, and '(1 2) is discarded; perhaps (list-set! '(1 2) 0 1) -> 1")
+  (lint-test "(string-set! \"123\" 0 #\\c)"
+	     " string-set!: \"123\" is a constant, so string-set! is problematic, and \"123\" is discarded; perhaps (string-set! \"123\" 0 #\\c) -> #\\c")
+  (lint-test "(vector-set! #(1 2) 0 32)"
+	     " vector-set!: #(1 2) is a constant, so vector-set! is problematic, and #(1 2) is discarded; perhaps (vector-set! #(1 2) 0 32) -> 32
+               vector-set!: #(1 2) could be #i(1 2)")
+  (lint-test "(int-vector-set! #r(0 1) 0 1)"
+	     " int-vector-set!: in (int-vector-set! #r(0.0 1.0) 0 1),
+               int-vector-set!'s first argument should be an int-vector, but #r(0.0 1.0) is a float-vector?
+               int-vector-set!: #r(0.0 1.0) is a constant, so int-vector-set! is problematic, and #r(0.0 1.0) is discarded; perhaps (int-vector-set! #r(0.0 1.0) 0 1) -> 1")
+  (lint-test "(float-vector-set! #i(0 1) 0 1)"
+	     " float-vector-set!: in (float-vector-set! #i(0 1) 0 1),
+               float-vector-set!'s first argument should be a float-vector, but #i(0 1) is an int-vector?
+               float-vector-set!: #i(0 1) is a constant, so float-vector-set! is problematic, and #i(0 1) is discarded; perhaps (float-vector-set! #i(0 1) 0 1) -> 1")
+  (lint-test "(float-vector-set! #(0 1) 0 1)"
+	     " float-vector-set!: in (float-vector-set! #(0 1) 0 1),
+               float-vector-set!'s first argument should be a float-vector, but #(0 1) is a vector?
+               float-vector-set!: #(0 1) is a constant, so float-vector-set! is problematic, and #(0 1) is discarded; perhaps (float-vector-set! #(0 1) 0 1) -> 1
+               float-vector-set!: #(0 1) could be #i(0 1)")
+  (lint-test "(vector-set! (make-vector 1) 0 1)"
+	     " vector-set!: (make-vector 1) is simply discarded; perhaps (vector-set! (make-vector 1) 0 1) -> 1")
+  (lint-test "(vector-set! #(0) 1 2)" " vector-set!: index 1 is too large in (vector-set! #(0) 1 2) vector-set!: #(0) could be #i(0)")
+  (lint-test "(int-vector-set! (float-vector 0 1) 0 1)"
+	     " int-vector-set!: in (int-vector-set! (float-vector 0 1) 0 1), int-vector-set!'s first argument should be an int-vector, but (float-vector 0 1) is a float-vector?
+               int-vector-set!: (float-vector 0 1) is simply discarded; perhaps (int-vector-set! (float-vector 0 1) 0 1) -> 1")
+  (lint-test "(set! (#(1 a) 0) 32)" " set!: #(1 a) is a constant so (set! (#(1 a) 0) 32) is problematic")
+
+  (lint-test "(string-downcase \"SPEAK SOFTLY\")" " string-downcase: perhaps (string-downcase \"SPEAK SOFTLY\") -> \"speak softly\"")
+  (lint-test "(vector-length (copy arr))"                  " vector-length: perhaps (vector-length (copy arr)) -> (vector-length arr)")
+  (lint-test "(vector-length (copy src dest))"             " vector-length: perhaps (vector-length (copy src dest)) -> (vector-length dest)")
+  (lint-test "(vector-length (vector-copy arr start))"     " vector-length: perhaps (vector-length (vector-copy arr start)) -> (- (vector-length arr) start)")
+  (lint-test "(vector-length (vector-copy arr start end))" " vector-length: perhaps (vector-length (vector-copy arr start end)) -> (- end start)")
+  (lint-test "(odd? (- x 1))"  " odd?: perhaps (odd? (- x 1)) -> (even? x)")
+  (lint-test "(even? (+ 2 x))" " even?: perhaps (even? (+ 2 x)) -> (even? x)")
+  (lint-test "(even? (- 1 x))" " even?: perhaps (even? (- 1 x)) -> (odd? x)")
+  (lint-test "(even? (- 1 2))" " even?: perhaps (even? (- 1 2)) -> #f even?: perhaps (- 1 2) -> -1")
+  (lint-test "(string-append str (format () str arg))" "") ; 19-Mar-24
+  (lint-test "(not (peek-char))"
+	     " not: (not (peek-char)) can't be true (peek-char never returns #f)
+               not: perhaps (not (peek-char)) -> #f")
+  (lint-test "(number->string saturation 10)" " number->string: 10 is the default radix for number->string: (number->string saturation 10)")
+  (lint-test "(<= (string-length m) 0)" " <=: string-length is never negative, so (<= (string-length m) 0) -> (= (string-length m) 0)")
+  (lint-test "(>= (vector-length m) 0)" " >=: vector-length is never negative, so (>= (vector-length m) 0) -> #t")
+  (lint-test "(<= 0 (string-length m))" " <=: string-length is never negative, so (<= 0 (string-length m)) -> #t")
+  (lint-test "(>= 0 (vector-length m))" " >=: vector-length is never negative, so (>= 0 (vector-length m)) -> (= 0 (vector-length m))")
+  (lint-test "(cdr (or (assq 'cpu annot) '(_ . 0)))"
+	     " cdr: perhaps (cdr (or (assq 'cpu annot) '(_ . 0))) -> (cond ((assq 'cpu annot) => cdr) (else 0))")
+  (lint-test "(cdr (or (memv #\\. file) (cons #\\. file)))"
+	     " cdr: perhaps (cdr (or (memv #\\. file) (cons #\\. file))) -> (cond ((memv #\\. file) => cdr) (else file))")
+  (lint-test "(number->string (cdr (or (assv i alist) (cons 0 0))))"
+	     " number->string: perhaps (cdr (or (assv i alist) (cons 0 0))) -> (cond ((assv i alist) => cdr) (else 0))")
+  (lint-test "(cdr (or (assoc n oi) `(,n)))"
+	     " cdr: perhaps (cdr (or (assoc n oi) (list-values n))) -> (cond ((assoc n oi) => cdr) (else (list)))
+               cdr: perhaps (list-values n) -> (list n)")
+  (lint-test "(cdr (or (assoc n oi) (list n y)))"
+	     " cdr: perhaps (cdr (or (assoc n oi) (list n y))) -> (cond ((assoc n oi) => cdr) (else (list y)))")
+  (lint-test "(cdr (or (assoc n oi) (list n y z)))"
+	     " cdr: perhaps (cdr (or (assoc n oi) (list n y z))) -> (cond ((assoc n oi) => cdr) (else (list y z)))")
+  (lint-test "(cdr (or (find i alist) (error 'oops)))"
+	     " cdr: perhaps (cdr (or (find i alist) (error 'oops))) -> (cond ((find i alist) => cdr) (else (error 'oops)))")
+  (lint-test "(cadr (or (find i alist) '(1 2 3)))"
+	     " cadr: perhaps (cadr (or (find i alist) '(1 2 3))) -> (cond ((find i alist) => cadr) (else 2))")
+  (lint-test "(list->vector (reverse nts))" " list->vector: perhaps (list->vector (reverse nts)) -> (reverse (list->vector nts))")
+  (lint-test "(cadr (reverse (f x)))" " cadr: perhaps (cadr (reverse (f x))) -> (let ((<1> (f x))) (list-ref <1> (- (length <1>) 2)))")
+  (lint-test "(begin (if x (error 'oops)) (if x y))"
+	     " begin: x is #f in (if x y)
+               begin: perhaps (... (if x (error 'oops)) (if x y) ...) -> (... (when x (error 'oops) y) ...)")
+  (let-temporarily ((*report-sloppy-assoc* #t))
+    (lint-test "(round (char-position #\\a \"asb\"))"
+	       " round: in (round (char-position #\\a \"asb\")), round's argument should be real, but (char-position #\\a \"asb\") might also be #f"))
+  (lint-test "(string-ref (char-position #\\a \"asb\") 1)"
+	     " string-ref: in (string-ref (char-position #\\a \"asb\") 1),
+                 string-ref's first argument should be a string, but (char-position #\\a \"asb\") is an integer or #f")
+  (lint-test "(char-position \"xyz\" \"asb\")" "")
+  (lint-test "(if (null? (cons x y)) 1.0 0.0)" " if: perhaps (null? (cons x y)) -> #f  if: perhaps (if (null? (cons x y)) 1.0 0.0) -> 0.0")
+  (lint-test "(if (null (cdr x)) 0)"	       " if: misspelled 'null? in (null (cdr x))?")
+  (lint-test "(list-set x 1 y)"                " list-set: misspelled 'list-set! in (list-set x 1 y)?")
+  (lint-test "(string-index path #\\/)"        " string-index: perhaps (string-index path #\\/) -> (char-position #\\/ path)")
+  (lint-test "(string-index path #\\/ start end)" " string-index: perhaps (string-index path #\\/ start end) -> (char-position #\\/ path start end)")
+  (lint-test "(cons* x y)"                     " cons*: perhaps (cons* x y) -> (cons x y)")
+  (lint-test "(if (pair? (sin x)) 1.0 0.0)"    " if: perhaps (pair? (sin x)) -> #f  if: perhaps (if (pair? (sin x)) 1.0 0.0) -> 0.0")
+  (lint-test "(if (number? (sin x)) 1.0)"      " if: perhaps (number? (sin x)) -> #t if: perhaps (if (number? (sin x)) 1.0) -> 1.0")
+  (lint-test "(if (number? (car x)) 1.0)"      "")
+  (lint-test "(if (real? (sin x)) 1.0)"	       "")
+  (lint-test "(let ((list x)) (null? list))"
+	     " let: perhaps (let ((list x)) (null? list)) -> (null? x)")
+  (lint-test "(set! x (real? (imag-part z)))" "set!: perhaps (real? (imag-part z)) -> #t set!: (real? (imag-part z)) is always #t")
+  (lint-test "(let ((x (char? (string-ref z y)))) x)"
+	     " let: perhaps (char? (string-ref z y)) -> #t
+               let: (char? (string-ref z y)) is always #t
+               let: perhaps (let ((x (char? (string-ref z y)))) x) -> (char? (string-ref z y))")
+  (lint-test "(case (number? (log x y)) ((#f) 0) ((#t) 1))" " case: perhaps (number? (log x y)) -> #t case: (number? (log x y)) is always #t")
+  (lint-test "(let () (define (f9 x) (write x)) (f9 (vector? (vector))))"
+	     " let: perhaps (... (define (f9 x) (write x)) (f9 (vector? (vector)))) -> (... (let ((x (vector? (vector)))) (write x)))
+               f9: leaving aside write's optional arg, f9 could be (define f9 write)
+               let: perhaps (vector? (vector)) -> #t
+               let: (vector? (vector)) is always #t")
+  (lint-test "(display (string? (string)))"
+	     " display: perhaps (string? (string)) -> #t
+               display: (string? (string)) is always #t
+               display: (string) could be \"\"")
+  (lint-test "(if (number? 1.0) 1.0 0.0)"             " if: perhaps (number? 1.0) -> #t  if: perhaps (if (number? 1.0) 1.0 0.0) -> 1.0")
+  (lint-test "(if (pair? 1.0) 1.0 0.0)"               " if: perhaps (pair? 1.0) -> #f  if: perhaps (if (pair? 1.0) 1.0 0.0) -> 0.0")
+  (lint-test "(if (symbol? (string->symbol x)) 0 1)"  " if: perhaps (symbol? (string->symbol x)) -> #t  if: perhaps (if (symbol? (string->symbol x)) 0 1) -> 0")
+  (lint-test "(if (symbol? (symbol->string x)) 0 1)"  " if: perhaps (symbol? (symbol->string x)) -> #f  if: perhaps (if (symbol? (symbol->string x)) 0 1) -> 1")
+  (lint-test "(and (symbol? x) (gensym? x))"          " and: perhaps (and (symbol? x) (gensym? x)) -> (gensym? x)")
+  (lint-test "(integer? (*s7* 'vector-print-length))" " integer?: unknown *s7* field: 'vector-print-length")
+  (lint-test "(dynamic-wind (lambda () (+)) (lambda () (list)) (lambda () #f))"
+	     " dynamic-wind: this could be omitted: (+) in (lambda () (+))
+               dynamic-wind: this dynamic-wind is pointless, (dynamic-wind (lambda () (+)) (lambda () (list)) (lambda () #f)) -> (list)
+               dynamic-wind: perhaps (lambda () (+)) -> +
+               dynamic-wind: perhaps (+) -> 0
+               dynamic-wind: perhaps (lambda () (list)) -> list
+               dynamic-wind: perhaps (list) -> (); there is only one nil")
+  (lint-test "(lambda args (apply + args))"           " lambda: perhaps (lambda args (apply + args)) -> +")
+  (lint-test "(let ((x 1) (y '(1 2))) `(,x ,@y))"
+             " let: perhaps (list-values x (apply-values y)) -> (cons x y)")
+
+  (lint-test "(display #\\escape)" "")
+  ;; these tickled a lint bug
+  (lint-test "(define :xxx 321)"	" define: keywords are constants :xxx")
+  (lint-test "(define (:yyy a) a)"	" define: keywords are constants :yyy")
+  (lint-test "(cons ((pair? x) 2) y)"   " cons: cons's argument ((pair? x) 2) looks odd: pair? returns boolean? which is not applicable")
+  (lint-test "(cons ((g x) y) (else #f))" " cons: else (as car of second argument to cons) makes no sense: (cons ((g x) y) (else #f))")
+
+  (lint-test "(let ((r (make-random-state 123 432))) (random 1.0 r))"
+	     " let: make-random-state is deprecated; use random-state
+               let: perhaps (let ((r (make-random-state 123 432))) (random 1.0 r)) -> (random 1.0 (make-random-state 123 432))")
+  (lint-test "(let ((c (current-environment))) (defined? 'x c))"
+	     " let: current-environment is deprecated; use curlet
+               let: perhaps (let ((c (current-environment))) (defined? 'x c)) -> (defined? 'x (current-environment))")
+
+  (lint-test "(let ((x 1) (y 2)) (if (= x 1) (begin (define (f1) x) (define (f2) (+ x 1)))) (f1 1))"
+             " let:  perhaps (if (= x 1) (begin (define (f1) x) (define (f2) (+ x 1)))) -> (when (= x 1) (define (f1) x) (define (f2) (+ x 1)))
+               let: f1 has too many arguments: (f1 1)
+               let: y not used, initially: 2 from let")
+  ;; ideally we'd also point out that f2 is unused
+  (lint-test "(let ((x 1) (y 2)) (when (= x 1) (begin (define (f1) x) (define (f2) (+ x 1)))) (f1 1))"
+	     " let: redundant begin: (begin (define (f1) x) (define (f2) (+ x 1)))
+               let: f1 has too many arguments: (f1 1)
+               let: y not used, initially: 2 from let")
+  ;; and here also
+
+  (lint-test "(defmacro hi ())"		" defmacro: defmacro declaration is messed up:  (defmacro hi ())")
+  (lint-test "(defmacro (hi x) `(+ ,x 1))" " defmacro: defmacro used where s7 uses define-defmacro: (defmacro (hi x) (list-values '+ x 1))?")
+  (lint-test "(defmacro hi (a b a) a)"	" defmacro: defmacro parameter is repeated: (a b a) hi: defmacro parameter a is declared twice")
+  (lint-test "(defmacro hi (a b) `(+ ,a ,b))"
+	     " defmacro: defmacro is deprecated; perhaps (defmacro hi (a b) (list-values '+ a b)) -> (define-macro (hi a b) (list-values '+ a b))
+               defmacro: perhaps (define-macro (hi a b) (list-values '+ a b)) -> (define hi +)")
+  (lint-test "(defmacro hi a `(+ ,a ,b))"
+	     " defmacro: defmacro is deprecated; perhaps (defmacro hi a (list-values '+ a b)) -> (define-macro (hi . a) (list-values '+ a b))")
+  (lint-test "(defmacro* mac1 (a :key b :optional c . d) `(list ,a ,b ,c ,@d))"
+	     " defmacro*: defmacro* is deprecated; perhaps (defmacro* mac1 (a :key b :optional c . d) (list-values 'list a b c... ->
+                 (define-macro* (mac1 a b c . d) (list-values 'list a b c (apply-values d)))")
+
+  (lint-test "(define)"			" define: (define) makes no sense")
+  (lint-test "(define a)"		" define: (define a) has no value?")
+  (lint-test "(let () (define (f a) (+ a b)) (define b 21) (f 1))" " let: b is used before it is defined: (define b 21)")
+  (lint-test "(define a . b)"		" define: (define a . b) makes no sense")
+  (lint-test "(define a b c)"		" define: (define a b c) has too many values?")
+  (lint-test "(define a a)"		" define: this define is either not needed, or is an error: (define a a)")
+  (lint-test "(define #(a) 2)"		" define: strange form: (define #(a) 2)")
+  (lint-test "(define (f1 a) (abs a))"  " f1: f1 could be (define f1 abs)")
+  (lint-test "(define (f1 a b) \"a docstring\" (log a b))" " f1: f1 could be (define f1 log)")
+  (lint-test "(let () (define (f1 a b) (* 2 (log a b))) (define (f2 a b) (f1 a b)) (f2 1 2))"
+	     " let: perhaps change f2 to a let:
+                 (let () (define (f1 a b) (* 2 (log a b))) (define (f2 a b) (f1 a b)) (f2 1 2)) -> (... (let ((a 1) (b 2)) ...))
+	       f2: f2 could be (define f2 f1) f1 is called only in f2")
+  (lint-test "(define (f x) (define aaa 1) (define aaa 2) (+ aaa 1))"
+	     " f: perhaps (... (define aaa 1) (define aaa 2) (+ aaa 1)) -> (... (let ((aaa 1) (aaa 2)) ...))
+               f: define variable aaa is redefined in the define body.  Perhaps use set! instead: (set! aaa 2)
+               f: aaa not used, initially: 1 from define")
+  (lint-test "(lambda ())"		  " lambda: lambda is messed up in        (lambda ())")
+  (lint-test "(lambda (a b a) a)"         " lambda: lambda parameter is repeated: (a b a) lambda: lambda parameter a is declared twice")
+  (lint-test "((lambda () 32) 0)"         " (lambda () 32): perhaps ((lambda () 32) 0) -> 32")
+  (lint-test "((lambda x x) 1 2 3)"       " (lambda x x): perhaps ((lambda x x) 1 2 3) -> (list 1 2 3)")
+  (lint-test "((lambda (a b) (+ a b)) 1)" " (lambda (a b) (+ a b)): perhaps (lambda (a b) (+ a b)) -> +")
+  (lint-test "((lambda* ((a 1) b) (+ a b)) (values 2 3))" "")
+  (lint-test "(lambda* (:key a :optional b :rest c :allow-other-keys) a)" " lambda*: :key is no longer accepted: (:key a :optional b :rest ...")
+  (lint-test "(lambda* (a :rest) a)"	" lambda*: :rest parameter needs a name: (a :rest)")
+  (lint-test "(lambda* (a :rest (b 1)) b)" " lambda*: :rest parameter can't specify a default value: (a :rest (b 1))")
+  (lint-test "(lambda* (a :allow-other-keys b) a)" " lambda*: :allow-other-keys should be at the end of the parameter list:(a :allow-other-keys b)")
+  (lint-test "(lambda (a :b c) a)"	" lambda: lambda arglist can't handle keywords (use lambda*)")
+  (lint-test "(lambda (a b) (>= b a))"	" lambda: perhaps (lambda (a b) (>= b a)) -> <=")
+  (lint-test "(lambda (a b c) (/ a b c))" " lambda: perhaps (lambda (a b c) (/ a b c)) -> /")
+  (lint-test "(lambda (a . b) (apply + a b))" " lambda: perhaps (lambda (a . b) (apply + a b)) -> +")
+  (lint-test "(lambda args (apply and args))" "")
+  (lint-test "(lambda (x y) (and x y))"  "")
+  (lint-test "((lambda (x) x) 32)"       " (lambda (x) x): perhaps ((lambda (x) x) 32) -> 32")
+  (lint-test "((lambda (x) (cdr (cdr (car x)))) z)"
+	     " (lambda (x) (cdr (cdr (car x)))): perhaps ((lambda (x) (cdr (cdr (car x)))) z) -> (let ((x z)) (cdr (cdr (car x))))
+               (lambda (x) (cdr (cdr (car x)))): perhaps (lambda (x) (cdr (cdr (car x)))) -> cddar
+               (lambda (x) (cdr (cdr (car x)))): perhaps (cdr (cdr (car x))) -> (cddar x)")
+  (lint-test "((lambda () (+ x y)))"                " (lambda () (+ x y)): perhaps ((lambda () (+ x y))) -> (+ x y)")
+  (lint-test "((lambda () (define (f123 x) (+ x 1)) (f123 32)))"
+	     " (lambda () (define (f123 x) (+ x 1)) (f123 32)): perhaps ((lambda () (define (f123 x) (+ x 1)) (f123 32))) -> (let () (define (f123 x) (+ x 1)) (f123 32))
+               (lambda () (define (f123 x) (+ x 1)) (f123 32)): the inner function f123 could be moved outside the lambda:
+                 (lambda () (define (f123 x) (+ x 1)) (f123 32)) -> (let () (define (f123 x) (+ x 1)) (lambda () ...))
+               (lambda () (define (f123 x) (+ x 1)) (f123 32)): perhaps (... (define (f123 x) (+ x 1)) (f123 32)) -> (... (let ((x 32)) (+ x 1)))")
+  (lint-test "((lambda (x) (+ x 1)) y)"             " (lambda (x) (+ x 1)): perhaps ((lambda (x) (+ x 1)) y) -> (let ((x y)) (+ x 1))")
+  (lint-test "((lambda x (+ (car x) 1)) y)"         " (lambda x (+ (car x) 1)): perhaps ((lambda x (+ (car x) 1)) y) -> (let ((x (list y))) (+ (car x) 1))")
+  (lint-test "((lambda x (+ (car x) 1)) y z)"       " (lambda x (+ (car x) 1)): perhaps ((lambda x (+ (car x) 1)) y z) -> (let ((x (list y z))) (+ (car x) 1))")
+  (lint-test "((lambda x (+ (car x) 1)))"           " (lambda x (+ (car x) 1)): perhaps ((lambda x (+ (car x) 1))) -> (let ((x (list))) (+ (car x) 1))")
+  (lint-test "((lambda (x . y) (+ x (car y))) a b)"
+	     " (lambda (x . y) (+ x (car y))): perhaps ((lambda (x . y) (+ x (car y))) a b) -> (let ((x a) (y (list b))) (+ x (car y)))")
+  (lint-test "((lambda* ((x 1)) (+ x 1)))"          " (lambda* ((x 1)) (+ x 1)): perhaps ((lambda* ((x 1)) (+ x 1))) -> (let ((x 1)) (+ x 1))")
+  (lint-test "((lambda* ((x 1)) (+ x 1)) y)"        " (lambda* ((x 1)) (+ x 1)): perhaps ((lambda* ((x 1)) (+ x 1)) y) -> (let ((x y)) (+ x 1))")
+  (lint-test "((lambda* (x (y 1)) (+ x y)) z)"      " (lambda* (x (y 1)) (+ x y)): perhaps ((lambda* (x (y 1)) (+ x y)) z) -> (let* ((x z) (y 1)) (+ x y))")
+  (lint-test "((lambda* (x (y 1)) (+ x y)) a b)"    " (lambda* (x (y 1)) (+ x y)): perhaps ((lambda* (x (y 1)) (+ x y)) a b) -> (let* ((x a) (y b)) (+ x y))")
+  (lint-test "((lambda* (x (y 1)) (+ x y)))"        " (lambda* (x (y 1)) (+ x y)): perhaps ((lambda* (x (y 1)) (+ x y))) -> (let* ((x #f) (y 1)) (+ x y))")
+
+  (lint-test "(lambda (i) (define (fdo x) (+ x 1)) (if (= i 3) (display (fdo i)) (loop (+ i 1))))"
+	     " lambda: the inner function fdo could be moved outside the lambda:
+                 (lambda (i) (define (fdo x) (+ x 1)) (if (= i 3) (display (fdo i)) (loop... ->
+                 (let () (define (fdo x) (+ x 1)) (lambda (i) ...))
+               lambda: perhaps (... (define (fdo x) (+ x 1)) (if (= i 3) (display (fdo i)) (loop (+ i 1)))) ->
+                 (... (if (= i 3) (display (let ((x i)) (+ x 1))) (loop (+ i 1))))")
+  (lint-test "(lambda (i) (define (fdo x) (+ (fdi x) 1)) (define (fdi y) (* y 2)) (if (= i 3) (display (fdo i)) (loop (+ i 1))))"
+	     " lambda: the inner functions fdo, fdi could be moved outside the lambda:
+                 (lambda (i) (define (fdo x) (+ (fdi x) 1)) (define (fdi y) (* y 2)) (if (=... ->
+                 (let () (define (fdo x) (+ (fdi x) 1)) (define (fdi y) (* y 2)) (lambda (i) ...))")
+  (lint-test "(lambda (i) (define (fdo x) (+ (fdi x) i)) (define (fdi y) (* y 2)) (if (= i 3) (display (fdo i)) (loop (+ i 1))))"
+	     " lambda: the inner function fdi could be moved outside the lambda:
+                 (lambda (i) (define (fdo x) (+ (fdi x) i)) (define (fdi y) (* y 2)) (if (=... ->
+                 (let () (define (fdi y) (* y 2)) (lambda (i) ...))")
+  (lint-test "(lambda (i) (let ((y 32)) (define (fdo x) (+ x 1)) (if (= i y) (display (fdo i)) (loop (+ i 1)))))"
+	     " lambda: the inner function fdo could be moved outside the lambda:
+                 (lambda (i) (let ((y 32)) (define (fdo x) (+ x 1)) (if (= i y) (display... -> (let () (define (fdo x) (+ x 1)) (lambda (i) ...))
+               lambda: perhaps (... (define (fdo x) (+ x 1)) (if (= i y) (display (fdo i)) (loop (+ i 1)))) ->
+                 (... (if (= i y) (display (let ((x i)) (+ x 1))) (loop (+ i 1))))
+               lambda: y can be moved to lambda's closure")
+  (lint-test "(let ((y 33)) (define (fdo x) (+ x 1)) (if (= i y) (display (fdo i)) (loop (+ i 1))))"
+	     " let: the inner function fdo could be moved into the let:
+                 (let ((y 33)) (define (fdo x) (+ x 1)) (if (= i y) (display (fdo i)) (loop... -> (let ((y 33) (fdo (lambda (x) (+ x 1)))) ...)
+               let: perhaps (... (define (fdo x) (+ x 1)) (if (= i y) (display (fdo i)) (loop (+ i 1)))) ->
+                 (... (if (= i y) (display (let ((x i)) (+ x 1))) (loop (+ i 1))))")
+  (lint-test "(let* ((y 34) (z (log y))) (define (fdo x) (+ x 1)) (if (= z y) (display (fdo y)) (loop (+ i 1))))"
+	     " let*: the inner function fdo could be moved out of the let*:
+                 (let* ((y 34) (z (log y))) (define (fdo x) (+ x 1)) (if (= z y) (display... -> (let ((fdo (lambda (x) (+ x 1)))) (let* ((y 34) (z (log y))) ...))
+               let*: perhaps (... (define (fdo x) (+ x 1)) (if (= z y) (display (fdo y)) (loop (+ i 1)))) ->
+                 (... (if (= z y) (display (let ((x y)) (+ x 1))) (loop (+ i 1))))")
+  (lint-test "(define (fda y) (define (fdo x) (+ x 1)) (if (= y 3) (display (fdo y))))"
+	     " define: the inner function fdo could be moved to fda's closure:
+                 (define (fda y) (define (fdo x) (+ x 1)) (if (= y 3) (display (fdo y)))) -> (define fda (let () (define (fdo x) (+ x 1)) (lambda (y) ...)))
+               define: perhaps (define (fda y) (define (fdo x) (+ x 1)) (if (= y 3) (display (fdo y)))) ->
+                 (define (fda y) (if (= y 3) (display (let ((x y)) (+ x 1)))))")
+  (lint-test "(define* (fda (y 32) :rest z) (define (fdo x) (+ x 1)) (if (= y 3) (display (fdo z))))"
+	     " define*: the inner function fdo could be moved to fda's closure:
+                 (define* (fda (y 32) :rest z) (define (fdo x) (+ x 1)) (if (= y 3)... -> (define fda (let () (define (fdo x) (+ x 1)) (lambda* ((y 32) :rest z) ...)))
+               define*: perhaps (define* (fda (y 32) :rest z) (define (fdo x) (+ x 1)) (if (= y 3)... ->
+                 (define* (fda (y 32) :rest z) (if (= y 3) (display (let ((x z)) (+ x 1)))))")
+  (lint-test "(define (fda y . z) (define (fdo x) (+ x 1)) (if (= y 3) (display (fdo y))))"
+	     " define: the inner function fdo could be moved to fda's closure:
+                 (define (fda y . z) (define (fdo x) (+ x 1)) (if (= y 3) (display (fdo y)))) ->
+                 (define fda (let () (define (fdo x) (+ x 1)) (lambda (y . z) ...)))
+               define: perhaps (define (fda y . z) (define (fdo x) (+ x 1)) (if (= y 3) (display (fdo y)))) ->
+                 (define (fda y . z) (if (= y 3) (display (let ((x y)) (+ x 1)))))")
+  (lint-test "(define (fda y z) (define (fdo . x) (list x 1)) (if (= y 3) (display (fdo y))))"
+	     " define: the inner function fdo could be moved to fda's closure:
+                 (define (fda y z) (define (fdo . x) (list x 1)) (if (= y 3) (display (fdo y)))) ->
+                 (define fda (let () (define (fdo . x) (list x 1)) (lambda (y z) ...)))")
+  (lint-test "(define (fda z) (define (fdo x . y) (list x y)) (if (= z 3) (display (fdo z))))"
+	     " define: the inner function fdo could be moved to fda's closure:
+                 (define (fda z) (define (fdo x . y) (list x y)) (if (= z 3) (display (fdo z)))) ->
+                 (define fda (let () (define (fdo x . y) (list x y)) (lambda (z) ...)))")
+  (lint-test "(define (fda . z) (define (fdo x) (+ x 1)) (if (= y 3) (display (fdo y))))"
+	     " define: the inner function fdo could be moved to fda's closure:
+                 (define (fda . z) (define (fdo x) (+ x 1)) (if (= y 3) (display (fdo y)))) ->
+                 (define fda (let () (define (fdo x) (+ x 1)) (lambda z ...)))
+               define: perhaps (define (fda . z) (define (fdo x) (+ x 1)) (if (= y 3) (display (fdo y)))) ->
+                 (define (fda . z) (if (= y 3) (display (let ((x y)) (+ x 1)))))")
+  (lint-test "(lambda (i) (let ((y 32)) (define (fdo i) (+ i 1)) (if (= i y) (display (fdo i)) (loop (+ i 1)))))"
+	     " lambda: the inner function fdo could be moved outside the lambda:
+                 (lambda (i) (let ((y 32)) (define (fdo i) (+ i 1)) (if (= i y) (display... -> (let () (define (fdo i) (+ i 1)) (lambda (i) ...))
+               lambda: perhaps (... (define (fdo i) (+ i 1)) (if (= i y) (display (fdo i)) (loop (+ i 1)))) ->
+                 (... (if (= i y) (display (let ((i i)) (+ i 1))) (loop (+ i 1))))
+               lambda: y can be moved to lambda's closure")
+  (lint-test "(lambda (i) (let ((y 32)) (define fdo (lambda (i) (+ i 1))) (if (= i y) (display (fdo i)) (loop (+ i 1)))))"
+	     " lambda: the inner function fdo could be moved outside the lambda:
+                 (lambda (i) (let ((y 32)) (define fdo (lambda (i) (+ i 1))) (if (= i y)... -> (let () (define fdo (lambda (i) (+ i 1))) (lambda (i) ...))
+               lambda: y can be moved to lambda's closure")
+  (lint-test "(define (f x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (if (= i y) (display (fdo i)) (loop (+ i 1)))))"
+	     " define: the local function fdo could be moved to f's closure:
+                 (define (f x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (if (= i y)... ->
+                 (define f (let ((fdo (lambda (i) (+ i 1)))) (lambda (x) ...)))
+               f: y can be moved to f's closure")
+  (lint-test "(define (f x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (define (fdi i) (+ i 2)) (if (= i y) (display (fdo (fdi i))) (loop (+ i 1)))))"
+	     " define: the inner function fdi could be moved to f's closure:
+                 (define (f x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (define (fdi i) (+... ->
+                 (define f (let () (define (fdi i) (+ i 2)) (lambda (x) ...)))
+               define: the local function fdo could be moved to f's closure:
+                 (define (f x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (define (fdi i) (+... ->
+                 (define f (let ((fdo (lambda (i) (+ i 1)))) (lambda (x) ...)))
+               f: perhaps (... (define (fdi i) (+ i 2)) (if (= i y) (display (fdo (fdi i))) (loop (+... ->
+                 (... (if (= i y) (display (fdo (let ((i i)) (+ i 2)))) (loop (+ i 1))))
+               f: y can be moved to f's closure")
+  (lint-test "(lambda (x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (if (= i y) (display (fdo i)) (loop (+ i 1)))))"
+	     " lambda: the local function fdo could be moved outside the lambda:
+                 (lambda (x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (if (= i y) (display... ->
+                 (let ((fdo (lambda (i) (+ i 1)))) (lambda (x) ...))
+               lambda: y can be moved to lambda's closure")
+  (lint-test "(lambda (x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (define (fdi i) (+ i 2)) (if (= i y) (display (fdo (fdi i))) (loop (+ i 1)))))"
+	     " lambda: the inner function fdi could be moved outside the lambda:
+                 (lambda (x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (define (fdi i) (+ i... ->
+                 (let () (define (fdi i) (+ i 2)) (lambda (x) ...))
+               lambda: the local function fdo could be moved outside the lambda:
+                 (lambda (x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (define (fdi i) (+ i... ->
+                 (let ((fdo (lambda (i) (+ i 1)))) (lambda (x) ...))
+               lambda: perhaps (... (define (fdi i) (+ i 2)) (if (= i y) (display (fdo (fdi i))) (loop (+... ->
+                 (... (if (= i y) (display (fdo (let ((i i)) (+ i 2)))) (loop (+ i 1))))
+               lambda: y can be moved to lambda's closure")
+
+  (lint-test "(let () (define (f1 a) a) (f1 2 3))"
+	     " let: perhaps (... (define (f1 a) a) (f1 2 3)) -> (... (let ((a 2)) a))
+               let: f1 has too many arguments: (f1 2 3)")
+  (lint-test "(let () (define-macro (m1 a) a) (m1 2 3))" " let: m1 has too many arguments: (m1 2 3)")
+  (lint-test "(let () (define-macro (m2 b) `(let ((a 12)) (+ a ,b))) (let ((a 1) (+ *)) (+ a (m2 a))))"
+	     " let: possible problematic macro expansion: (m2 a) may collide with subsequently defined 'a, +")
+  (lint-test "(let () (define-macro (m3 b) `(let ((a 12)) (+ (symbol->value ,b) a))) (let ((a 1)) (+ a (m3 'a))))"
+	     " let: possible problematic macro expansion: (m3 'a) could conceivably collide with subsequently defined 'a")
+  (lint-test "(define-macro (f . x) `(+ ,@x))"
+	     " define-macro: perhaps (define-macro (f . x) (list-values '+ (apply-values x))) -> (define f +)
+               f: perhaps (list-values '+ (apply-values x)) -> (cons '+ x)")
+  (lint-test "(define-macro (f a . x) `(+ ,a ,@x))"
+	     " define-macro: perhaps (define-macro (f a . x) (list-values '+ a (apply-values x))) -> (define f +)
+               f: perhaps (list-values '+ a (apply-values x)) -> (cons '+ (cons a x))")
+  (lint-test "(define-macro (m1 a) `((,a b c)))" " m1: perhaps (list-values (list-values a 'b 'c)) -> (list (list a 'b 'c))")
+
+  (lint-test "(define pi (acos -1))" " define: (acos -1) is one of its many names, but pi is a predefined constant pi: perhaps (acos -1) -> pi")
+  (lint-test "(+ x (atan 0 -1))"     " +: perhaps (+ x (atan 0 -1)) -> (+ x pi)")
+  (lint-test "(define (f1) 32)" "")
+  (lint-test "(define (f2 a) a)" "")
+  (lint-test "(define (f3 . a) a)" "")
+  (lint-test "(define (f4 a b) a)" "")
+  (lint-test "(define (f5 a . b) a)" "")
+  (lint-test "(define (f6 a b . c) a)" "")
+
+  (lint-test "(define* (f1) 32)" " f1: define* could be define")
+  (lint-test "(define* (f2 a) a)" "")
+  (lint-test "(define* (f3 . a) a)" " f3: define* could be define")
+  (lint-test "(define* (f4 a (b 2)) a)" "")
+  (lint-test "(define* (f5 a :rest b) a)" "")
+  (lint-test "(define* (f6 a b :allow-other-keys) a)" "")
+
+  (lint-test "(define f1 (lambda () 32))" "")
+  (lint-test "(define f2 (lambda (a) a))" "")
+  (lint-test "(define f3 (lambda a a))" "")
+  (lint-test "(define f4 (lambda (a b) a))" "")
+  (lint-test "(define f5 (lambda (a . b) a))" "")
+
+  (lint-test "(define-macro (f1) 32)" " define-macro: perhaps (define-macro (f1) 32) -> (define f1 32) or (define (f1) 32)")
+  (lint-test "(define-macro (m1) 32)" " define-macro: perhaps (define-macro (m1) 32) -> (define m1 32) or (define (m1) 32)")
+  (lint-test "(define-macro (m2) 'a)" "")
+  (lint-test "(define-macro (m3) ''a)"
+	     " define-macro: perhaps (define-macro (m3) ''a) -> (define m3 'a) or (define (m3) 'a)
+               m3: returns a list constant: ''a")
+  (lint-test "(define-macro (m4 a) `(abs ,a))"
+	     " define-macro: perhaps (define-macro (m4 a) (list-values 'abs a)) -> (define m4 abs)
+               m4: perhaps (list-values 'abs a) -> (list 'abs a)")
+  (lint-test "(define-macro (m5 a) `(log ,a 2))" " define-macro: perhaps (define-macro (m5 a) (list-values 'log a 2)) -> (define (m5 a) (log a 2))")
+  (lint-test "(define-macro (m6 a) `(+ ,a ,a))" "")  ; here a might be (display 32) -- should happen twice
+  (lint-test "(define-macro (m7 a b) `(set! ,a ,b))" " define-macro: perhaps (define-macro (m7 a b) (list-values 'set! a b)) -> (define m7 set!)")
+  (lint-test "(define-macro (m8 a) `(lambda () ,a))" "")
+  (lint-test "(define-macro (m8 a) `(let () ,a))" "")
+  (lint-test "(define-macro (m9 a b) `(+ ,a (* ,b 2)))" "")
+  (lint-test "(define-macro (m10 a) `(+ ,a x))" " define-macro: perhaps (define-macro (m10 a) (list-values '+ a 'x)) -> (define (m10 a) (+ a x))")
+  (lint-test "(define-macro (m11) (- -1 (* -2 (expt 2 28))))"
+	     " define-macro: perhaps (define-macro (m11) (- -1 (* -2 (expt 2 28)))) ->
+                 (define m11 (- -1 (* -2 (expt 2 28)))) or (define (m11) (- -1 (* -2 (expt 2 28))))")
+  (lint-test "(define-macro (f2 a) a)" "")
+  (lint-test "(define-macro (f3 . a) a)" "")
+  (lint-test "(define-macro (f4 a b) a)" "")
+  (lint-test "(define-macro (f5 a . b) a)" "")
+  (lint-test "(define-macro (f6 a b . c) a)" "")
+  (unless (or pure-s7 immutable-unquote)
+    (lint-test "(define-macro (mac a) `(+ ,,a 1))"
+	       (if immutable-unquote
+		   " mac: define-macro probably has too many unquotes: (list-values '+ ,a 1)"
+		   " mac: define-macro probably has too many unquotes: (list-values '+ (unquote a) 1)")))
+  (lint-test "(define-macro (m a) `(+ 1 a))"
+	     " define-macro: missing comma? (define-macro (m a) '(+ 1 a))
+               m: returns a list constant: '(+ 1 a)")
+  (lint-test "(define-macro (m a) `(+ 1 ,a (* a 2)))"
+             " define-macro: perhaps (define-macro (m a) (list-values '+ 1 a '(* a 2))) -> (define (m a) (+ 1 a (* a 2)))
+               define-macro: missing comma? (define-macro (m a) (list-values '+ 1 a '(* a 2)))")
+  (lint-test "(define-macro (m1 x) `(begin (vector-set! ,x 0 1)))"
+	     " m1: pointless begin: (list-values 'begin (list-values 'vector-set! x 0 1)) -> (list-values 'vector-set! x 0 1)
+               m1: perhaps (list-values 'begin (list-values 'vector-set! x 0 1)) -> (list 'begin (list 'vector-set! x 0 1))")
+  (lint-test "(let ((a 1)) (define (f1 b) (+ a b)) (f1 0))"
+	     " let: perhaps (... (define (f1 b) (+ a b)) (f1 0)) -> (... (let ((b 0)) (+ a b)))
+               a is used only in f1")
+  (lint-test "(let f1 ((a 1)) a)" " let: f1 not used, value: (let f1 ((a 1)) a) let: perhaps (let f1 ((a 1)) a) -> 1")
+  (lint-test "(let f1 ((a 1)) (f1 a))" "")
+  (lint-test "(let f1 ((a 1)) (+ a (f1)))" " let: f1 needs 1 argument:  (f1)")
+  (lint-test "(let f1 ((a 1)) (f1 a 2))" " let: f1 has too many arguments: (f1 a 2)")
+  (lint-test "(define f7 (let ((a 1)) (lambda () a)))" "")
+  (lint-test "(let () (define f7 (let ((a 1)) (lambda () a))) (f7))" "")
+;  (lint-test "(let () (define f7 (let ((a 1)) (lambda () a))) (f7 1))" "...")
+
+  (lint-test "(let () (define (f1) 32) (f1))" " let: perhaps (... (define (f1) 32) (f1)) -> (... 32)")
+  (lint-test "(let () (define (f1) 32) (f1 32))"
+	     " let: perhaps (... (define (f1) 32) (f1 32)) -> (... 32)
+               let: f1 has too many arguments: (f1 32)")
+  (lint-test "(let () (define (f2 a) a) (f2))"
+	     " let: perhaps (... (define (f2 a) a) (f2)) -> (... (let () a))
+               let: f2 needs 1 argument: (f2)")
+  (lint-test "(let () (define (f2 a) a) (f2 3))" " let: perhaps (... (define (f2 a) a) (f2 3)) -> (... (let ((a 3)) a))")
+  (lint-test "(let () (define (f2 a) a) (f2 3 32))"
+	     " let: perhaps (... (define (f2 a) a) (f2 3 32)) -> (... (let ((a 3)) a))
+               let: f2 has too many arguments: (f2 3 32)")
+  (lint-test "(let () (define (f3 . a) a) (f3))" "")
+  (lint-test "(let () (define (f3 . a) a) (f3 1))" "")
+  (lint-test "(let () (define (f3 . a) a) (f3 1 2 3))" "")
+  (lint-test "(let () (define (f4 a b) a) (f4))"
+	     " let: perhaps (... (define (f4 a b) a) (f4)) -> (... (let () a))
+               let: f4 needs 2 arguments: (f4)")
+  (lint-test "(let () (define (f4 a b) a) (f4 1))"
+	     " let: perhaps (... (define (f4 a b) a) (f4 1)) -> (... (let ((a 1)) a))
+               let: f4 needs 2 arguments: (f4 1)")
+  (lint-test "(let () (define (f4 a b) a) (f4 1 2))"
+	     " let: perhaps (... (define (f4 a b) a) (f4 1 2)) -> (... (let ((a 1) (b 2)) a))
+               let: f4's parameter 2 is not used, but a value is passed: 2")
+  (lint-test "(let () (define (f4 a b) a) (f4 1 2 3))"
+	     " let: perhaps (... (define (f4 a b) a) (f4 1 2 3)) -> (... (let ((a 1) (b 2)) a))
+               let: f4 has too many arguments: (f4 1 2 3)
+               let: f4's parameter 2 is not used, but a value is passed: 2")
+
+  (lint-test "(let () (define (f5 a . b) a) (f5))"         " let: f5 needs 1 argument:  (f5)")
+  (lint-test "(let () (define (f5 a . b) a) (f5 1))" "")
+  (lint-test "(let () (define (f5 a . b) a) (f5 1 2))"     " let: f5's parameter 2 is not used, but a value is passed: 2")
+  (lint-test "(let () (define (f5 a . b) a) (f5 1 2 3 4))" " let: f5's parameter 2 is not used, but a value is passed: 2")
+  (lint-test "(let () (define (f6 a b . c) a) (f6))"       " let: f6 needs 2 arguments:  (f6)")
+  (lint-test "(let () (define (f6 a b . c) a) (f6 1))"     " let: f6 needs 2 arguments:  (f6 1)")
+  (lint-test "(let () (define (f6 a b . c) a) (f6 1 2))"   " let: f6's parameter 2 is not used, but a value is passed: 2")
+  (lint-test "(let () (define (f6 a b . c) a) (f6 1 2 3))"
+	     " let: f6's parameter 2 is not used, but a value is passed: 2
+               let: f6's parameter 3 is not used, but a value is passed: 3")
+  (lint-test "(let () (define (f6 a b . c) a) (f6 1 2 3 4))"
+	     " let: f6's parameter 2 is not used, but a value is passed: 2
+               let: f6's parameter 3 is not used, but a value is passed: 3")
+
+  (lint-test "(let () (define (f7 x) (+ x 1)) (f7 3) 4)"
+	     " let: perhaps (... (define (f7 x) (+ x 1)) (f7 3) 4) -> (... (let ((x 3)) (+ x 1)) 4)
+               let: this could be omitted: (f7 3)")
+  (lint-test "(let () (define* (f7 x) (+ x 1)) (f7 3) 4)"
+	     " let: perhaps (... (define* (f7 x) (+ x 1)) (f7 3) 4) -> (... (let ((x 3)) (+ x 1)) 4)
+               let: this could be omitted: (f7 3)")
+  (lint-test "(let () (define (f7 x) (display x)) (f7 3) 4)"
+	     " let: perhaps (... (define (f7 x) (display x)) (f7 3) 4) -> (... (let ((x 3)) (display x)) 4)
+               f7: leaving aside display's optional arg, f7 could be (define f7 display)")
+  (lint-test "(let () (define (f a b) (min b a)) (f x y))"
+	     " let: perhaps (... (define (f a b) (min b a)) (f x y)) -> (... (let ((a x) (b y)) (min b a)))
+               f: leaving aside min's optional args, f could be (define f min)")
+  (lint-test "(let () (define (f a b) (< b a)) (f x y))"
+	     " let: perhaps (... (define (f a b) (< b a)) (f x y)) -> (... (let ((a x) (b y)) (< b a)))
+               f: leaving aside <'s optional args, f could be (define f >)")
+  (lint-test "(let () (define (f a b) (eq? b a)) (f x y))"
+	     " let: perhaps (... (define (f a b) (eq? b a)) (f x y)) -> (... (let ((a x) (b y)) (eq? b a)))
+               f: f could be (define f eq?)")
+  (lint-test "(let () (define (f7 x) (+ x 1)) (f7 (display 3)) 4)"
+	     " let: perhaps (... (define (f7 x) (+ x 1)) (f7 (display 3)) 4) -> (... (let ((x (display 3))) (+ x 1)) 4)")
+  (lint-test "(let () (define* (f7 x) (+ x 1)) (let ((y 3)) (f7 y) 4))"
+	     " let: perhaps (let ((y 3)) (f7 y) 4) -> (let () (f7 3) 4)
+	       let: this could be omitted:  (f7 y)")
+  (lint-test "(let () (define (f1 . x) (apply + x)) (f1 1 2))" " f1: f1 could be (define f1 +)")
+  (lint-test "(let () (define (f1 a . b) (apply + a b)) (f1 1 2))" " f1: f1 could be (define f1 +)")
+  (lint-test "(let () (define (f1 x) (abs x)) (f1 1))"
+	     " let: perhaps (... (define (f1 x) (abs x)) (f1 1)) -> (... (let ((x 1)) (abs x)))
+               f1: f1 could be (define f1 abs)")
+  (lint-test "(let () (define (f1 x) (cdr (car x))) (f1 z))"
+	     " let: perhaps (... (define (f1 x) (cdr (car x))) (f1 z)) -> (... (let ((x z)) (cdr (car x))))
+               f1: f1 could be (define f1 cdar)
+               f1: perhaps (cdr (car x)) -> (cdar x)")
+
+  (lint-test "(begin (define* (f1) 32) (f1))" " f1: define* could be define")
+  (lint-test "(begin (define* (f1) 32) (f1 :a 1))"
+	     " f1: define* could be define begin: f1 has too many arguments: (f1 :a 1) begin: f1 keyword argument :a (in (f1 :a 1)) does not match any argument in ()")
+  (lint-test "(begin (define* (f2 a) a) (f2))" "")
+  (lint-test "(begin (define* (f2 a) a) (f2 1))" "")
+  (lint-test "(begin (define* (f2 a) a) (f2 :a 1))" "")
+  (lint-test "(begin (define* (f2 a) a) (f2 :b 1))" " begin: f2 keyword argument :b (in (f2 :b 1)) does not match any argument in (a)")
+  (lint-test "(begin (define* (f2 a) a) (f2 :a 1 2))"
+	     " begin: f2 has too many arguments: (f2 :a 1 2) begin: non-keyword argument 2 follows previous keyword")
+  (lint-test "(begin (define* (f2 a) a) (f2 :a 1 :a 2))" " begin: f2 has too many arguments: (f2 :a 1 :a 2) begin: :a is repeated in (:a 1 :a 2)")
+  (lint-test "(begin (define* (f2 a) a) (f2 1 2))" " begin: f2 has too many arguments: (f2 1 2)")
+  (lint-test "(begin (define* (f3 . a) a) (f3))" " f3: define* could be define")
+  (lint-test "(let ((f3 (lambda* a a))) (f3 1))" " let: lambda* could be lambda let: perhaps (let ((f3 (lambda* a a))) (f3 1)) -> ((lambda* a a) 1)")
+  (lint-test "(begin (define* (f3 . a) a) (f3 :a 1))" " f3: define* could be define")
+  (lint-test "(begin (define* (f3 . a) a) (f3 1 2))" " f3: define* could be define")
+  (lint-test "(begin (define* (f4 a (b 2)) a) (f4))" "")
+  (lint-test "(begin (define* (f4 a (b 2)) a) (f4 :a 1))" "")
+  (lint-test "(begin (define* (f4 a (b 2)) a) (f4 :b 1))" "")
+  (lint-test "(begin (define* (f4 a (b 2)) a) (f4 :c 1))" " begin: f4 keyword argument :c (in (f4 :c 1)) does not match any argument in (a (b 2))")
+  (lint-test "(begin (define* (f4 a (b 2)) a) (f4 :a 1 :c 2))" " begin: f4 keyword argument :c (in (f4 :a 1 :c 2)) does not match any argument in (a (b 2))")
+  (lint-test "(begin (define* (f4 a (b 2)) a) (f4 :a 1 :b 2))" "")
+  (lint-test "(begin (define* (f4 a (b 2)) a) (f4 1 :a 1 :b 2))" " begin: f4 has too many arguments: (f4 1 :a 1 :b 2)")
+  (lint-test "(begin (define* (f5 a :rest b) a) (f5))" "")
+  (lint-test "(begin (define* (f5 a :rest b) a) (f5 1))" "")
+  (lint-test "(begin (define* (f5 a :rest b) a) (f5 1 2 3))" "")
+  (lint-test "(begin (define* (f5 a :rest b) a) (f5 :b 1))" "")
+  (lint-test "(begin (define* (f5 a :rest b) a) (f5 :a 1 2 3))" " begin: non-keyword argument 2 follows previous keyword")
+  (lint-test "(begin (define* (f6 a b :allow-other-keys) a) (f6))" "")
+  (lint-test "(begin (define* (f6 a b :allow-other-keys) a) (f6 :a 1 :b 2 :c 3))" "")
+  (lint-test "(let () (define (f8 a) (+ a 1)) (string-ref (f8 1) 2))"
+	     " let: perhaps (... (define (f8 a) (+ a 1)) (string-ref (f8 1) 2)) -> (... (string-ref (let ((a 1)) (+ a 1)) 2))
+               let: in (string-ref (f8 1) 2), string-ref's first argument should be a string, but (f8 1) is a number?")
+  (lint-test "(begin (define (f11 x) (+ x 1)) (f11 (integer->char 32)))"
+	     " begin: in (f11 (integer->char 32)), f11's argument should be a number, but (integer->char 32) is a char?
+               begin: perhaps (integer->char 32) -> #\\space")
+  (lint-test "(begin (define (f12 x) (log x 2)) (f12 \"asdf\"))"
+	     " begin: in (f12 \"asdf\"), f12's argument should be a number, but \"asdf\" is a string?")
+  (lint-test "(+ a #\\a 2)" " +: in (+ a #\\a 2), +'s second argument should be a number, but #\\a is a char?")
+  (lint-test "(begin (define (f13 x) (string-ref x 0)) (f13 #i(0 1 2)))"
+	     " begin: in (f13 #i(0 1 2)), f13's argument should be a string, but #i(0 1 2) is an int-vector?")
+  (lint-test "(begin (define (f14 x) (float-vector-set! v x 1.0)) (f14 1+i))"
+	     " begin: in (f14 1.0+1.0i), f14's argument should be an integer, but 1.0+1.0i is complex?")
+  (lint-test "(begin (define (f14 x) (float-vector-set! x 1 1.0)) (f14 1+i))"
+	     " begin: in (f14 1.0+1.0i), f14's argument should be a float-vector, but 1.0+1.0i is complex?")
+  (lint-test "(begin (define (f14 x) (* 2 (float-vector-set! x 1 1.0))) (f14 1+i))"
+	      " begin: in (f14 1.0+1.0i), f14's argument should be a float-vector, but 1.0+1.0i is complex?")
+  (lint-test "(begin (define (f15 x) (* 2 (+ x 1))) (f15 #()))"
+	     " begin: in (f15 #()), f15's argument should be a number, but #() is a vector?")
+  (lint-test "(begin (define (f16 x) (vector-set! v 1 x)) (f16 #f))" "")
+  (lint-test "(begin (define (f16 y x) (vector-set! v (f y) 2) (vector-set! v (f y) x)) (f16 0 #f))" "")
+  (lint-test "(begin (define (f16 y x z) (vector-set! z (f y) x)) (f16 0 #f #()))" "")
+
+  (lint-test "(let ((fv (float-vector 1 2 3))) (fv 1))" " let: perhaps (let ((fv (float-vector 1 2 3))) (fv 1)) -> ((float-vector 1 2 3) 1)")
+  (lint-test "(let ((fv (inlet 'a 1))) (fv 'a))" " let: perhaps (let ((fv (inlet 'a 1))) (fv 'a)) -> ((inlet 'a 1) 'a)")
+  (lint-test "(let ((fv (float-vector 1 2 3))) (fv -1))"
+	     " let: perhaps (let ((fv (float-vector 1 2 3))) (fv -1)) -> ((float-vector 1 2 3) -1)
+               let: fv's index -1 is negative")
+  (lint-test "(let ((fv (float-vector 1 2 3))) (fv 10))"
+	     " let: perhaps (let ((fv (float-vector 1 2 3))) (fv 10)) -> ((float-vector 1 2 3) 10)
+               let: fv has length 3, but index is 10")
+  (lint-test "(let ((fv (float-vector 1 2 3))) (set! (fv 1) #\\a))"  " let: fv wants real, but the value in (set! (fv 1) #\\a) is a char?")
+  (lint-test "(let ((fv (float-vector 1 2 3))) (set! (fv 10) 1.5))"  " let: fv has length 3, but index is 10")
+  (lint-test "(let ((fv (make-float-vector 3))) (set! (fv 10) 1.5))" " let: fv has length 3, but index is 10")
+  (lint-test "(let ((fv (make-float-vector 3))) (set! (fv 0) (floor x)))" "")
+  (lint-test "(let ((fv (make-float-vector 3))) (+ 1 (fv 3)))"       " let: fv has length 3, but index is 3")
+  (lint-test "(let ((fv (make-string 3))) (+ 1 (fv 1)))"             "") ; someday...
+
+  (lint-test "(let () (define (f8 a b) (+ 1 (f8 2 3))) (f8 1 2))"
+	     " let: perhaps (... (define (f8 a b) (+ 1 (f8 2 3))) (f8 1 2)) -> (... (let f8 ((a 1) (b 2)) (+ 1 (f8 2 3))))
+               let: f8's parameter 1 is not used, but a value is passed: 1
+               let: f8's parameter 2 is not used, but a value is passed: 2")
+  (lint-test "(let () (define (f8 a b) ((lambda (c) (f8 c 3)) 1)) (f8 1 2))"
+	     " let: perhaps (... (define (f8 a b) ((lambda (c) (f8 c 3)) 1)) (f8 1 2)) -> (... (let f8 ((a 1) (b 2)) ((lambda (c) (f8 c 3)) 1)))
+               f8: perhaps ((lambda (c) (f8 c 3)) 1) -> (let ((c 1)) (f8 c 3))
+               let: f8's parameter 1 is not used, but a value is passed: 1
+               let: f8's parameter 2 is not used, but a value is passed: 2")
+  (lint-test "(let () (define (f1) 32) (set! f1 4) (+ 1 f1))" "")
+  (lint-test "(let () (define (f1) 32) (+ 1 f1))" " let: f1 is a procedure, but + in (+ 1 f1) wants a number?")
+  (lint-test "(let () (define f10 (lambda (a) a)) (set! f10 (lambda (a b) (+ a b))) (f10 1 2))"
+	     " let: perhaps (lambda (a b) (+ a b)) -> +")
+  (lint-test "(begin (define (f20 x y) (+ y 1)) (f20 (+ z 1) z))" " begin: f20's parameter 1 is not used, but a value is passed: (+ z 1)")
+  (lint-test "(begin (define (f21 x y) (set! x 3) (+ y 1)) (f21 (+ z 1) z))"
+	     " f21: perhaps (set! x 3) -> (let ((x 3)) ...)
+	       begin: f21's parameter 1's value is not used, but a value is passed: (+ z 1)")
+  (lint-test "(begin (define (f22 x) (case y ((0) `(+ ,x 1)) (else #f))) (f22 2))"
+	     " f22: perhaps (case y ((0) (list-values '+ x 1)) (else #f)) -> (and (eqv? y 0) (list-values '+ x 1))")
+  (lint-test "(begin (define (f23 x) (+ y 1)) (define (f24 x) (f23 (+ x 1))) (f24 0))"
+	     " f24: f23's parameter 1 is not used, but a value is passed: (+ x 1)")
+  (unless (or pure-s7 immutable-unquote)
+    (lint-test "(begin (define x 1) `#(,x))" ; this can be expanded: (lambda (x) #((unquote x)))
+	       (if immutable-unquote
+		   " begin: quasiquoted vectors are not supported: #(,x) perhaps use `(vector ...) rather than `#(...)"
+		   " begin: quasiquoted vectors are not supported: #((unquote x)) perhaps use `(vector ...) rather than `#(...)")))
+  (lint-test "(begin (define-macro (m1 x y) `(+ ,y 1)) (m1 a b))"
+	     " begin: perhaps (define-macro (m1 x y) (list-values '+ y 1)) -> (define (m1 x y) (+ y 1))
+               begin: m1's parameter 1 is not used, but a value is passed: a")
+  (lint-test "(begin (define (f30 x) (if (> x 0) (f30 #() (- x 1)))) (f30 1))" " f30: f30 has too many arguments: (f30 #() (- x 1))")
+
+  (lint-test "(let () (define plus (case-lambda (() 0) ((x y) x) ((x y) (+ x y)) ((x y z) (+ x y z)) (args (apply + args)))) (plus))"
+	     " plus: repeated parameter list? (x y) in (case-lambda (() 0) ((x y) x) ((x y) (+ x y)) ((x y z) (+ x y z)) (args (apply + args)))
+               case-lambda: perhaps (lambda (x y) (+ x y)) -> +
+               case-lambda: perhaps (lambda (x y z) (+ x y z)) -> +
+               case-lambda: perhaps (lambda args (apply + args)) -> +
+               let: perhaps (let () (define plus (case-lambda (() 0) ((x y) x) ((x y) (+ x y)) ((x y... ->
+                 (let ((plus (case-lambda (() 0) ((x y) x) ((x y) (+ x y)) ((x y z) (+ x y z)) (args (apply + args))))) ...)")
+  (lint-test "(case-lambda ((a b) (+ a b)))"
+	     " case-lambda: perhaps (lambda (a b) (+ a b)) -> +
+               case-lambda: perhaps (case-lambda ((a b) (+ a b))) -> (lambda (a b) (+ a b))")
+  (lint-test "(case-lambda \"a doc string\" ((a b) (+ a b)))"
+	     " case-lambda: perhaps (lambda (a b) (+ a b)) -> +
+               case-lambda: perhaps (case-lambda \"a doc string\" ((a b) (+ a b))) -> (let ((+documentation+ \"a doc string\")) (lambda (a b) (+ a b)))")
+  (lint-test "(case-lambda (() (display x #f)) ((y) (display x y)))"
+	     " case-lambda: (display x #f) could be x
+               case-lambda: perhaps (case-lambda (() (display x #f)) ((y) (display x y))) -> (lambda* (y) (display x y))")
+  (lint-test "(case-lambda (() (+ x 0)) ((y) (+ x y)))"
+	     " case-lambda: perhaps (+ x 0) -> x
+               case-lambda: perhaps (case-lambda (() (+ x 0)) ((y) (+ x y))) -> (lambda* ((y 0)) (+ x y))")
+  (lint-test "(case-lambda ((x) (log x 2)) ((x y) (log x y)))"
+	     " case-lambda: perhaps (lambda (x y) (log x y)) -> log
+               case-lambda: perhaps (case-lambda ((x) (log x 2)) ((x y) (log x y))) -> (lambda* (x (y 2)) (log x y))")
+  (lint-test "(case-lambda ((x) (log x 2)) ((y x) (log x y)))" "")
+  (lint-test "(case-lambda ((x) (log x 2)) ((y x z) (log x y)))" "")
+
+  (lint-test "(let loop ((pi 1.0) (+ pi 1)))"
+	     " let: can't bind a constant: (pi 1.0)
+               let: let binding is messed up: (+ pi 1)
+               let: loop not used, value: (let loop ((pi 1.0) (+ pi 1)))")
+  (lint-test "(define (f12 pi) pi)"             " define: f12 parameter can't be a constant: (f12 pi)")
+  (lint-test "(define* (f12 (pi 1.0)) pi)"      "f12: parameter can't be a constant: ((pi 1.0))")
+  (lint-test "(define* (bpar1 lst) (set! (lst 2) (* 2 (lst 2))) lst)" "") ; default = #f
+  (lint-test "(define* (bpar1 (lst '(0 1 2 3))) (set! (lst 2) (* 2 (lst 2))) lst)"
+	     "bpar1: lst's default value, '(0 1 2 3), is a literal constant, so this set! is trouble: (set! (lst 2) (* 2 (lst 2)))")
+  (lint-test "(define (f12 :key) :key)"         " define: f12 parameter can't be a keyword: (f12 :key)")
+  (lint-test "(define :a 3)"                    " define: keywords are constants :a")
+  (lint-test "(let () (define pi 3) pi)"
+	     " let: pi is a constant: (define pi 3)
+               let: perhaps omit pi and return 3
+               let: perhaps (let () (define pi 3) pi) -> (let ((pi 3)) ...)")
+  (lint-test "(let () (define-constant __lt1__ 32) (set! __lt1__ 3) (+ __lt1__ 1))"
+	     " let: can't set! __lt1__ in (set! __lt1__ 3) (it is a constant: 32)")
+  (lint-test "(let () (define (f1 x) (+ x 1)) f1)" " let: perhaps omit f1, and change (define (f1 x) ...) -> (lambda (x) ...)")
+  (lint-test "(let () (define (f1 x) (f2 (+ x 1))) (define (f2 x) x) (f1 3))" "")
+  (lint-test "(let () (define (f1 a) (let ((a (vector->list a))) (car a))) (f1 #(a)))"
+	     " let: perhaps (... (define (f1 a) (let ((a (vector->list a))) (car a))) (f1 #(a))) -> (... (let ((a #(a))) (let ((a (vector->list a))) (car a))))
+               f1: perhaps (let ((a (vector->list a))) (car a)) -> (car (vector->list a))")
+  (lint-test "(car (vector->list a))"           " car: perhaps (car (vector->list a)) -> (vector-ref a 0)")
+
+  (lint-test "(null? (list))"                   " null?: perhaps (null? (list)) -> #t null?: perhaps (list) -> (); there is only one nil")
+  (lint-test "(null? (list 1))"                 " null?: perhaps (null? (list 1)) -> #f null?: perhaps (list 1) -> '(1)")
+  (lint-test "(pair? (list 1))"                 " pair?: perhaps (pair? (list 1)) -> #t pair?: perhaps (list 1) -> '(1)")
+  (lint-test "(proper-list? (list))"
+	     " proper-list?: perhaps (proper-list? (list)) -> #t
+               proper-list?: (proper-list? (list)) is always #t
+               proper-list?: perhaps (list) -> (); there is only one nil")
+  (lint-test "(proper-list? (list 1))"
+	     " proper-list?: perhaps (proper-list? (list 1)) -> #t
+               proper-list?: (proper-list? (list 1)) is always #t
+               proper-list?: perhaps (list 1) -> '(1)")
+  (lint-test "(or (list? e) (null? e))"         " or: perhaps (or (list? e) (null? e)) -> (list? e)")
+  (lint-test "(or (list? e) (pair? e))"         " or: perhaps (or (list? e) (pair? e)) -> (list? e)")
+  (lint-test "(or (proper-list? e) (null? e))"  " or: perhaps (or (proper-list? e) (null? e)) -> (proper-list? e)")
+  (lint-test "(or (proper-list? e) (pair? e))" "")
+  (lint-test "(and (list? e) (null? e))"        " and: perhaps (and (list? e) (null? e)) -> (null? e)")
+  (lint-test "(and (list? e) (pair? e))"        " and: perhaps (and (list? e) (pair? e)) -> (pair? e)")
+  (lint-test "(and (proper-list? e) (null? e))" " and: perhaps (and (proper-list? e) (null? e)) -> (null? e)")
+  (lint-test "(and (proper-list? e) (pair? e))" "")
+  (lint-test "(let ((x 1/2)) (integer? x))"     " let: perhaps (let ((x 1/2)) (integer? x)) -> (integer? 1/2)  let: x is 1/2, so (integer? x) is #f")
+  (lint-test "(let ((x 1/2)) (real? x))"        " let: perhaps (let ((x 1/2)) (real? x)) -> (real? 1/2) let: x is rational, so (real? x) is #t")
+  (lint-test "(let ((x 1/2)) (rational? x))"    " let: perhaps (let ((x 1/2)) (rational? x)) -> (rational? 1/2) let: x is rational, so (rational? x) is #t")
+  (lint-test "(let ((x 1/2)) (pair? x))"        " let: perhaps (let ((x 1/2)) (pair? x)) -> (pair? 1/2) let: x is rational, so (pair? x) is #f")
+  (lint-test "(let ((x ())) (list? x))"         " let: perhaps (let ((x ())) (list? x)) -> (list? ())")
+  (lint-test "(let ((x (list 1))) (list? x))"   " let: perhaps (let ((x (list 1))) (list? x)) -> (list? (list 1))")
+  (lint-test "(let ((x \"a\") (y \"\")) (eq? x y))" " let: perhaps (let ((x \"a\") (y \"\")) (eq? x y)) -> (eq? \"a\" \"\")")
+  (lint-test "(let ((x 12)) (set! x 32) (integer? x))"
+	     " let: x is an integer, so (integer? x) is #t
+               let: perhaps (let ((x 12)) (set! x 32) (integer? x)) -> (let ((x 32)) (integer? x))")
+  (lint-test "(and (char-alphabetic? x) (char? x))" " and: perhaps (and (char-alphabetic? x) (char? x)) -> (char-alphabetic? x)")
+  (lint-test "(or (char-numeric? x) (char? x))"   " or: perhaps (or (char-numeric? x) (char? x)) -> (char? x)")
+  (lint-test "(or (char-numeric? x) (char-whitespace? x))" "")
+  (lint-test "(and (char-alphabetic? x) (pair? x))" " and: perhaps (and (char-alphabetic? x) (pair? x)) -> #f")
+  (lint-test "(and (char? x) (char-numeric? x))" "")
+  (let-temporarily ((*report-sloppy-assoc* #t))
+    (lint-test "(char=? #\\a (read-char p))"
+	       " char=?: in (char=? #\\a (read-char p)), char=?'s second argument should be a char, but (read-char p) might also be an eof-object?")
+    (lint-test "(< (string->number x) 0)"
+	       " <: in (< (string->number x) 0), <'s first argument should be real, but (string->number x) might also be #f"))
+  (lint-test "(vector-ref v (+ i 1))" "")
+
+  (lint-test "(or (number? x) (nan? x))"         " or: perhaps (or (number? x) (nan? x)) -> (number? x)")
+  (lint-test "(and (infinite? x) (nan? x))"      " and: perhaps (and (infinite? x) (nan? x)) -> #f")
+  (lint-test "(and (real? x) (nan? x))" "")
+  (lint-test "(and (< x 3) (< x 4))"             " and: perhaps (and (< x 3) (< x 4)) -> (< x 3)")
+  (lint-test "(and (inexact? x) (exact? x))"     " and: perhaps (and (inexact? x) (exact? x)) -> #f")
+  (lint-test "(and (inexact? x) (rational? x))"  " and: perhaps (and (inexact? x) (rational? x)) -> #f")
+  (lint-test "(and (inexact? x) (even? x))"      " and: perhaps (and (inexact? x) (even? x)) -> #f")
+  (lint-test "(and (integer? x) (even? x))" "")
+  (lint-test "(and (odd? x) (integer? x))"       " and: perhaps (and (odd? x) (integer? x)) -> (odd? x)")
+  (lint-test "(and (odd? x) (even? x))"          " and: perhaps (and (odd? x) (even? x)) -> #f")
+  (lint-test "(and (inexact? x) (float? x))"     " and: perhaps (and (inexact? x) (float? x)) -> (float? x)")
+  (lint-test "(or (inexact? x) (float? x))"      " or: perhaps (or (inexact? x) (float? x)) -> (inexact? x)")
+  (lint-test "(or (float? x) (inexact? x))"      " or: perhaps (or (float? x) (inexact? x)) -> (inexact? x)")
+  (lint-test "(and (float? x) (inexact? x))"     " and: perhaps (and (float? x) (inexact? x)) -> (float? x)")
+  (lint-test "(and (symbol? x) (defined? x))" "") ; this avoids a type error if not a symbol, so can't be reduced
+  (lint-test "(and (defined? x) (symbol? x))"    " and: perhaps (and (defined? x) (symbol? x)) -> (defined? x)")
+  (lint-test "(and (negative? x) (not (real? x)))" " and: perhaps (and (negative? x) (not (real? x))) -> #f")
+  (lint-test "(and (positive? x) (real? x))"     " and: perhaps (and (positive? x) (real? x)) -> (positive? x)")
+  (lint-test "(or (real? x) (zero? x))"          " or: perhaps (or (real? x) (zero? x)) -> (real? x)")
+  (lint-test "(and (zero? x) (negative? x))"     " and: perhaps (and (zero? x) (negative? x)) -> #f")
+  (unless pure-s7
+    (lint-test "(and (real? x) (not (inexact? x)))" " and: perhaps (and (real? x) (not (inexact? x))) -> (rational? x)")
+    (lint-test "(and (exact? x) (not (inexact? x)))" " and: perhaps (and (exact? x) (not (inexact? x))) -> (exact? x)"))
+  (lint-test "(and (real? x) (not (zero? x)))" "") ; this is correct
+  (lint-test "(and (even? x) (not (real? x)))"   " and: perhaps (and (even? x) (not (real? x))) -> #f")
+  (lint-test "(and (exact? x) (zero? x))"        " and: perhaps (and (exact? x) (zero? x)) -> (eqv? x 0)")
+  (lint-test "(and (zero? x) (inexact? x))"      " and: perhaps (and (zero? x) (inexact? x)) -> (eqv? x 0.0)")
+  (lint-test "(and (pair? x) (+ x 1))"           "in (and (pair? x) (+ x 1)), x is a pair, but + wants a number?")
+  (lint-test "(and (boolean? x) (not x))"        " and: perhaps (and (boolean? x) (not x)) -> (not x)")
+  (lint-test "(and (boolean? x) (eq? x #f))"     " and: perhaps (and (boolean? x) (eq? x #f)) -> (eq? x #f) and: perhaps (eq? x #f) -> (not x)")
+  (lint-test "(and (symbol? id) (not (member id x)))"  " in (and (symbol? id) (not (member id x))), perhaps change (member id x) to (memq ...)")
+  (lint-test "(and (symbol? id) (not (equal? id x)))"  " in (and (symbol? id) (not (equal? id x))), perhaps change (equal? id x) to (eq? ...)")
+  (lint-test "(and (boolean? id) (not (member id x)))" " in (and (boolean? id) (not (member id x))), perhaps change (member id x) to (memq ...)")
+  (lint-test "(and (number? id) (not (equal? id x)))"  " in (and (number? id) (not (equal? id x))), perhaps change (equal? id x) to (eqv? ...)")
+  (lint-test "(and (symbol? id) (member id x))"        " in (and (symbol? id) (member id x)), perhaps change (member id x) to (memq ...)")
+  (lint-test "(and (symbol? id) (memq id x))"          " and: perhaps (and (symbol? id) (memq id x)) -> (memq id x)")
+  (lint-test "(and (symbol? id) (memv id x))"          " in (and (symbol? id) (memv id x)), perhaps change (memv id x) to (memq ...)")
+  (lint-test "(and (symbol? id) (equal? id x))"        " in (and (symbol? id) (equal? id x)), perhaps change (equal? id x) to (eq? ...)")
+  (lint-test "(and (boolean? id) (member id x))"       " in (and (boolean? id) (member id x)), perhaps change (member id x) to (memq ...)")
+  (lint-test "(and (number? id) (equal? id x))"        " in (and (number? id) (equal? id x)), perhaps change (equal? id x) to (eqv? ...)")
+  (lint-test "(and (integer? x) (number? y) (< y 3))"
+	     " in (and (integer? x) (number? y) (< y 3)), perhaps change (number? y) to (real? y)")
+  (lint-test "(or (integer? x) (not (number? y)) (< y 3))"
+	     " in (or (integer? x) (not (number? y)) (< y 3)), perhaps change (not (number? y)) to (not (real? y))")
+  (lint-test "(or (not (number? x)) (> x 2))" " in (or (not (number? x)) (> x 2)), perhaps change (not (number? x)) to (not (real? x))")
+  (lint-test "(or (integer? x) (not (number? y)) (< y 3))"
+	     " in (or (integer? x) (not (number? y)) (< y 3)), perhaps change (not (number? y)) to (not (real? y))")
+  (lint-test "(and (integer? x) (number? y) (< y 3))"
+	     " in (and (integer? x) (number? y) (< y 3)), perhaps change (number? y) to (real? y)")
+  (lint-test "(and (string? (car c)) (string=? (car c) \" \"))"
+	     " and: perhaps (and (string? (car c)) (string=? (car c) \" \")) -> (equal? (car c) \" \")")
+  (lint-test "(and (list? x) (equal? x '(1 2)))" " and: perhaps (and (list? x) (equal? x '(1 2))) -> (equal? x '(1 2))")
+  (lint-test "(and (char? x) (char=? x #\\a))"  " and: perhaps (and (char? x) (char=? x #\\a)) -> (eqv? x #\\a)")
+
+  (lint-test "(if (number? x) (member x y) 0)"  " in (if (number? x) (member x y) 0), perhaps change (member x y) to (memv ...)")
+  (lint-test "(if (number? x) (< x y) 0)"       " in (if (number? x) (< x y) 0), perhaps change (number? x) to (real? x)")
+  (lint-test "(if (not (number? x)) 0 (< x y))" " in (if (not (number? x)) 0 (< x y)), perhaps change (not (number? x)) to (not (real? x))")
+  (lint-test "(cond ((number? x) (< x y)) (else x))" " in (cond ((number? x) (< x y)) (else x)), perhaps change (number? x) to (real? x)")
+
+  (lint-test "(list? (make-list 1))"             " list?: perhaps (list? (make-list 1)) -> #t list?: (list? (make-list 1)) is always #t")
+  (lint-test "(number? (+ 1 x))"                 " number?: perhaps (number? (+ 1 x)) -> #t number?: (number? (+ 1 x)) is always #t")
+  (lint-test "(number? (make-list 1))"           " number?: perhaps (number? (make-list 1)) -> #f number?: (number? (make-list 1)) is always #f")
+  (lint-test "(pair? (member x y))"              " pair?: member returns either #f or a pair, so (pair? (member x y)) -> (member x y)")
+  (lint-test "(null? (member x y))" 	         " null?: perhaps (null? (member x y)) -> #f null?: (null? (member x y)) is always #f")
+  (lint-test "(integer? (char-position x y))"    " integer?: char-position returns either #f or an integer, so (integer? (char-position x y)) -> (char-position x y)")
+  (let-temporarily ((*report-sloppy-assoc* #t))
+    (lint-test "(car (member x y))"
+	       " car: in (car (member x y)), car's argument should be a pair, but (member x y) might also be #f
+                 car: (car (member x y)) is x, or an error"))
+  (lint-test "(if (and x (pair? x) (symbol? (cadr x))) x)" " if: perhaps (and x (pair? x) (symbol? (cadr x))) -> (and (pair? x) (symbol? (cadr x)))")
+  (lint-test "(catch #t (lambda () (char=? (read-char p) #\\newline)) (lambda arg 'error))" "")
+  (lint-test "(if (and (<= 12 x) (<= x 15)) 2 3)" " if: perhaps (and (<= 12 x) (<= x 15)) -> (<= 12 x 15)")
+  (lint-test "(and x (set! x (zero? (random 2))) (not x))" "")
+  (lint-test "(string-append x , \"b\")" "")
+  (unless (or pure-s7 immutable-unquote)
+    (lint-test "(string-append x , y)"
+	       (if immutable-unquote
+		   " string-append: stray comma? ,y in (string-append x ,y)"
+		   " string-append: stray comma? (unquote y) in (string-append x (unquote y))")))
+  (lint-test "`(+ ,x 1)" "")
+  (lint-test "(let ((x (list 23 1 3))) (sort! x <) x)" "")
+  (lint-test "(let ((x (list 23 1 3))) (reverse! x) x)" " let: reverse! might leave x in an undefined state; perhaps (set! x (reverse! x))")
+  (lint-test "(let () (define (f x) (if (pair? x) (reverse! x))) (f (vector 1 2)))"
+	     " let: perhaps (... (define (f x) (if (pair? x) (reverse! x))) (f (vector 1 2))) -> (... (let ((x (vector 1 2))) (if (pair? x) (reverse! x))))
+               f: if x (a function argument) is a pair, (reverse! x) is ill-advised")
+  (lint-test "(if (and (list? x) (car x)) 3)" " in (and (list? x) (car x)), perhaps change (list? x) to (pair? x)")
+  (lint-test "(if (and (list? x) (not (null? x)) (car x)) 3)" " if: perhaps (and (list? x) (not (null? x)) (car x)) -> (and (pair? x) (car x))")
+  (lint-test "(and (pair? obj) (not (null? obj)) (pair? x))" " and: perhaps (and (pair? obj) (not (null? obj)) (pair? x)) -> (and (pair? obj) (pair? x))")
+
+  (lint-test "(if x (map f x))" " in (if x (map f x)), perhaps change x to (sequence? x)")
+  (lint-test "(let ((x 0)) (/ 21 x))" " let: perhaps (let ((x 0)) (/ 21 x)) -> (/ 21 0) let: x is 0, so (/ 21 x) is an error")
+  (lint-test "(cond ((> x 0) => abs) (else y))" " cond: in ((> x 0) => abs), (> x 0) returns a a boolean, but abs expects real?")
+
+  (lint-test "(for-each (lambda (x) (display x port)) (list y z 123))"
+	     " for-each: perhaps (for-each (lambda (x) (display x port)) (list y z 123)) -> (format port \"~{~A~}\" (list y z 123))")
+  (lint-test "(for-each (lambda (x) (write-string x port)) (list y z \"123\"))"
+	     " for-each: perhaps (for-each (lambda (x) (write-string x port)) (list y z \"123\")) -> (format port \"~{~A~}\" (list y z \"123\"))")
+  (lint-test "(map (cut a) (list packages))" " map: perhaps (map (cut a) (list packages)) -> (list ((cut a) packages))")
+  (lint-test "(map abs (list packages))" " map: perhaps (map abs (list packages)) -> (list (abs packages))")
+  (lint-test "(map string->symbol (list \"IOPAD\" \"IPAD\" \"OPAD\" \"HIGH\" \"LOW\"))"
+	     " map: perhaps (map string->symbol (list \"IOPAD\" \"IPAD\" \"OPAD\" \"HIGH\" \"LOW\")) -> '(IOPAD IPAD OPAD HIGH LOW)
+               map: perhaps (list \"IOPAD\" \"IPAD\" \"OPAD\" \"HIGH\" \"LOW\") -> '(\"IOPAD\" \"IPAD\" \"OPAD\" \"HIGH\" \"LOW\")")
+  (lint-test "(list->string (list h1 h2))" " list->string: perhaps (list->string (list h1 h2)) -> (string h1 h2)")
+
+  (lint-test "(string-append (list->string (make-list indent #\\space)) str)"
+	     " string-append: perhaps (list->string (make-list indent #\\space)) -> (make-string indent #\\space)")
+  (lint-test "(string-append (string #\\C) \"ZLl*()def\")"
+	     " string-append: perhaps (string-append (string #\\C) \"ZLl*()def\") -> \"CZLl*()def\"
+               string-append: (string #\\C) could be \"C\"")
+  (lint-test "(string-append \"USER \" user (string #\\return) (string #\\newline))"
+	     " string-append: perhaps (string-append \"USER \" user (string #\\return) (string #\\newline)) ->
+                (string-append \"USER \" user (string #\\return #\\newline))")
+  (lint-test "(define (indent->string indent) (string-append (make-string (quotient indent 8) #\\tab) (make-string (modulo indent 8) #\\space)))"
+	     " indent->string: perhaps (string-append (make-string (quotient indent 8) #\\tab) (make-string... ->
+                 (format #f \"~NC~NC\" (quotient indent 8) #\\tab (modulo indent 8) #\\space)")
+
+  (lint-test "(string=? (string (string-ref file-line 0)) \"*\")"
+	     " string=?: perhaps (string=? (string (string-ref file-line 0)) \"*\") -> (char=? #\\* (string-ref file-line 0))
+               string=?: perhaps (string (string-ref file-line 0)) -> (substring file-line 0 1)")
+  (lint-test "(string=? (symbol->string a) (symbol->string b))" " string=?: perhaps (string=? (symbol->string a) (symbol->string b)) -> (eq? a b)")
+  (lint-test "(string=? (substring s 0 1) \"#\")" " string=?: perhaps (string=? (substring s 0 1) \"#\") -> (char=? #\\# (string-ref s 0))")
+  (lint-test "(string=? \"#\" (string (string-ref s 0)))"
+	     " string=?: perhaps (string=? \"#\" (string (string-ref s 0))) -> (char=? #\\# (string-ref s 0))
+               string=?: perhaps (string (string-ref s 0)) -> (substring s 0 1)")
+  (lint-test "(string=? \"\" (string-copy \"\"))" " string=?: perhaps (string=? \"\" (string-copy \"\")) -> (string=? \"\" \"\")")
+
+  (lint-test "(char=? #\\a (char-downcase x))" " char=?: perhaps (char=? #\\a (char-downcase x)) -> (char-ci=? #\\a x)")
+  (lint-test "(string=? x (string-downcase y))" "")
+  (lint-test "(string=? (string-downcase x) (string-downcase y))" " string=?: perhaps (string=? (string-downcase x) (string-downcase y)) -> (string-ci=? x y)")
+
+  (lint-test "(for-each display (list 1 a #\\newline))"
+	     " for-each: perhaps (for-each display (list 1 a #\\newline)) -> (format () \"~A~A~A\" 1 a #\\newline)")
+  (lint-test "(for-each write-string (list a \"asdf\" (substring x 1)))"
+	     " for-each: perhaps (for-each write-string (list a \"asdf\" (substring x 1))) -> (format () \"~A~A~A\" a \"asdf\" (substring x 1))")
+  (lint-test "(for-each write (append b (list 1 a #\\newline)))"
+	     " for-each: perhaps (for-each write (append b (list 1 a #\\newline))) -> (format () \"~{~S~}\" (append b (list 1 a #\\newline)))")
+  (lint-test "(for-each write-char (append b (list a #\\newline)))"
+	     " for-each: perhaps (for-each write-char (append b (list a #\\newline))) -> (format () \"~{~A~}\" (append b (list a #\\newline)))")
+
+  ;; recursion->for-each
+  (lint-test "(let f ((v (list 0 1 2))) (if (pair? v) (begin (g (car v)) (f (cdr v)))))"
+	     " f: perhaps (let f ((v (list 0 1 2))) (if (pair? v) (begin (g (car v)) (f (cdr v))))) -> (for-each g (list 0 1 2))
+               let:  perhaps (if (pair? v) (begin (g (car v)) (f (cdr v)))) -> (when (pair? v) (g (car v)) (f (cdr v)))")
+  (lint-test "(define (f v) (if (pair? v) (begin (g (car v)) (f (cdr v)))))"
+	     " f: perhaps (define (f v) (if (pair? v) (begin (g (car v)) (f (cdr v))))) -> (define (f v) (for-each g v))
+               f:  perhaps (if (pair? v) (begin (g (car v)) (f (cdr v)))) -> (when (pair? v) (g (car v)) (f (cdr v)))")
+  (lint-test "(let f ((v (list 0 1 2))) (when (pair? v) (g (car v)) (f (cdr v))))"
+	     " f: perhaps (let f ((v (list 0 1 2))) (when (pair? v) (g (car v)) (f (cdr v)))) -> (for-each g (list 0 1 2))")
+  (lint-test "(define (f v) (when (not (null? v)) (g (cadar v)) (f (cdr v))))"
+	     " f: perhaps (define (f v) (when (not (null? v)) (g (cadar v)) (f (cdr v)))) -> (define (f v) (for-each (lambda (<1>) (g (cadr <1>))) v))
+               f: perhaps (when (not (null? v)) (g (cadar v)) (f (cdr v))) -> (unless (null? v) (g (cadar v)) (f (cdr v)))")
+  (lint-test "(let f ((v (list 0 1 2))) (when (pair? v) (let ((g (car v))) (display g) (f (cdr v)))))"
+	     " f: perhaps (let f ((v (list 0 1 2))) (when (pair? v) (let ((g (car v))) (display g)... ->
+                 (for-each (lambda (<1>) (let ((g <1>)) (display g))) (list 0 1 2))
+               let: perhaps (let ((g (car v))) (display g) (f (cdr v))) -> (let () (display (car v)) (f (cdr v)))")
+
+  ;; recursion->do
+  (lint-test "(let f ((v ()) (i 0)) (if (= i 3) (reverse v) (f (cons x v) (+ i 1))))"
+	     " f: perhaps (let f ((v ()) (i 0)) (if (= i 3) (reverse v) (f (cons x v) (+ i 1)))) ->
+                 (do ((v () (cons x v)) (i 0 (+ i 1))) ((= i 3) (reverse v)))")
+  (lint-test "(define (lref lst ind) (if (zero? ind) (car lst) (lref (cdr lst) (- ind 1))))"
+	     " lref: perhaps (define (lref lst ind) (if (zero? ind) (car lst) (lref (cdr lst) (- ind 1)))) ->
+                 (define (lref lst ind) (do ((lst lst (cdr lst)) (ind ind (- ind 1))) ((zero? ind) (car lst))))")
+  (lint-test "(let loop ((a b) (c d)) (if (> a 1) (begin (display c) (loop (- a 1) (cdr c))) (+ a 1)))"
+	     " loop: perhaps (let loop ((a b) (c d)) (if (> a 1) (begin (display c) (loop (- a 1) (cdr... ->
+                 (do ((a b (- a 1)) (c d (cdr c))) ((<= a 1) (+ a 1)) (display c))")
+  (lint-test "(let loop ((a b) (c d)) (if (< a 1) (+ a 1) (begin (display c) (loop (- a 1) (cdr c)))))"
+	     " loop: perhaps (let loop ((a b) (c d)) (if (< a 1) (+ a 1) (begin (display c) (loop (- a... ->
+                 (do ((a b (- a 1)) (c d (cdr c))) ((< a 1) (+ a 1)) (display c))")
+  (lint-test "(define (loop a) (if (< a 0) (car c) (loop (f1 a))))"
+	     " loop: perhaps (define (loop a) (if (< a 0) (car c) (loop (f1 a)))) ->
+                 (define (loop a) (do ((a a (f1 a))) ((< a 0) (car c))))")
+  (lint-test "(let loop ((a b) (c d)) (if (> a 1) (begin (display c) (loop (- a 1) c)) (+ a 1)))"
+	     " loop: perhaps (let loop ((a b) (c d)) (if (> a 1) (begin (display c) (loop (- a 1) c))... ->
+                 (do ((a b (- a 1)) (c d)) ((<= a 1) (+ a 1)) (display c))")
+  (lint-test "(let loop ((a b) (c d)) (if (< a 1) (+ a 1) (begin (display c) (loop (- a c) (abs c)))))" "")
+  (lint-test "(define (f12 x y) (if (positive? x) (+ x y) (f12 1 x)))" "")
+  (lint-test "(define loop (lambda (a . b) (if (< a 0) (car c) (loop (f11 a b)))))" "")
+  (lint-test "(define loop (lambda (a) (if (< a 0) (car c) (loop (f1 a)))))"
+	     " loop: perhaps (lambda (a) (if (< a 0) (car c) (loop (f1 a)))) -> (lambda (a) (do ((a a (f1 a))) ((< a 0) (car c))))")
+  (lint-test "(define* (f52 (a 2)) (if (zero? a) x (f52 (- a 1))))"
+	     " f52: perhaps (define* (f52 (a 2)) (if (zero? a) x (f52 (- a 1)))) -> (define* (f52 (a 2)) (do ((a a (- a 1))) ((zero? a) x)))")
+  (lint-test "(define (loop a) (if (< a 0) (car c) (or (pair? a) (loop (f1 a)))))" "")
+  (lint-test "(define (loop a) (cond ((< a 0) (car c)) (else (loop (f1 a)))))"
+	     " loop: perhaps (define (loop a) (cond ((< a 0) (car c)) (else (loop (f1 a))))) ->
+                 (define (loop a) (do ((a a (f1 a))) ((< a 0) (car c))))")
+  (lint-test "(define (loop a) (cond ((< a 0)) (else (loop (f1 a)))))"
+	     " loop: perhaps (define (loop a) (cond ((< a 0)) (else (loop (f1 a))))) -> (define (loop a) (do ((a a (f1 a))) ((< a 0) #t)))
+               loop: perhaps (cond ((< a 0)) (else (loop (f1 a)))) -> (or (< a 0) (loop (f1 a)))")
+
+  (lint-test "(define make-rectangular (lambda args 32))" " top-level redefinition of built-in function make-rectangular: (define make-rectangular (lambda args 32))")
+  (lint-test "(define abs (lambda args 32))" " top-level redefinition of built-in function abs: (define abs (lambda args 32))")
+
+  ;; this is a write.scm lint-pp bug regression test
+  (lint-test "(define (any-random amount e) (letrec ((next-random (lambda () (let ((x 32)) (if (<= y (envelope-interp x e)) (next-random)))))) (next-random)))"
+	     " any-random: perhaps (letrec ((next-random (lambda () (let ((x 32)) (if (<= y (envelope-interp... ->
+    (let next-random ()
+      (let ((x 32))
+        (if (<= y (envelope-interp x e))
+            (next-random))))
+               any-random: x can probably be moved to any-random's closure")
+
+  (lint-test "(let ()
+                (define (f11 a b) (if (positive? a) (+ a b) b))
+                (define (f14 x y) (if (positive? x) (+ x y) y))
+                (+ (f11 1 2) (f14 1 2)))"
+	     " let: perhaps embed f14:
+                 (let () (define (f11 a b) (if (positive? a) (+ a b) b)) (define (f14 x y)... ->
+                   (... (+ (f11 1 2) (let ((x 1) (y 2)) (if (positive? x) (+ x y) y))))
+               f14: f14 could be (define f14 f11)")
+  (lint-test "(let ((x (let () (define (f11 a b) (if (positive? a) (+ a b) b)) (f11 1 2))))
+                (define (f14 x y) (if (positive? x) (+ x y) y))
+                (+ x (f14 1 2)))"
+	     " let: perhaps (... (define (f11 a b) (if (positive? a) (+ a b) b)) (f11 1 2)) -> (... (let ((a 1) (b 2)) (if (positive? a) (+ a b) b)))
+               let: the inner function f14 could be moved into the let:
+                 (let ((x (let () (define (f11 a b) (if (positive? a) (+ a b) b)) (f11 1... ->
+                 (let ((x (let () (define (f11 a b) (if (positive? a) (+ a b) b)) (f11 1 2))) (f14 (lambda (x y) (if (positive? x) (+ x y) y)))) ...)
+               let: perhaps (... (define (f14 x y) (if (positive? x) (+ x y) y)) (+ x (f14 1 2))) ->
+                 (... (+ x (let ((x 1) (y 2)) (if (positive? x) (+ x y) y))))
+               f14: f14 is the same as f11")
+  (lint-test "(let ()
+                (define (f11 a b) (define (f12 a b) (if (positive? a) (+ a b) b)) (f12 a b))
+                (define (f14 x y) (if (positive? x) (+ x y) y))
+                (+ (f11 1 2) (f14 1 2)))"
+	     " let: perhaps embed f14:
+                (let () (define (f11 a b) (define (f12 a b) (if (positive? a) (+ a b) b))... ->
+                (... (+ (f11 1 2) (let ((x 1) (y 2)) (if (positive? x) (+ x y) y))))
+                let: the inner function f12 could be moved to f11's closure:
+                (define (f11 a b) (define (f12 a b) (if (positive? a) (+ a b) b)) (f12 a b)) ->
+                (define f11 (let ()
+                  (define (f12 a b) (if (positive? a) (+ a b) b))
+                  (lambda (a b)...)))
+                let: perhaps
+                  (define (f11 a b) (define (f12 a b) (if (positive? a) (+ a b) b)) (f12 a b)) ->
+                  (define (f11 a b) (if (positive? a) (+ a b) b))
+                  f14: f14 is the same as f12 (line 1)")
+  (lint-test "(let ()
+                (define (f11 a b) (if (positive? a) (+ a b) b))
+                (define (f14 y x) (if (positive? x) (+ x y) y))
+                (+ (f11 1 2) (f14 1 2)))"
+	     " let: perhaps embed f14:
+                 (let () (define (f11 a b) (if (positive? a) (+ a b) b)) (define (f14 y x)... ->
+                   (... (+ (f11 1 2) (let ((y 1) (x 2)) (if (positive? x) (+ x y) y))))")
+               ; f14: perhaps (if (positive? x) (+ x y) y) -> (f11 x y)
+  (lint-test "(let ()
+                (define (f11 b a) (if (positive? a) (+ a b) b))
+                (define (f14 x y) (if (positive? x) (+ x y) y))
+                (+ (f11 1 2) (f14 1 2)))"
+	     " let: perhaps embed f14:
+                 (let () (define (f11 b a) (if (positive? a) (+ a b) b)) (define (f14 x y)... ->
+                    (... (+ (f11 1 2) (let ((x 1) (y 2)) (if (positive? x) (+ x y) y))))")
+               ; f14: perhaps (if (positive? x) (+ x y) y) -> (f11 y x)
+  (lint-test "(let ()
+                (define (f1 x) (set! x 32) (log x 2.0))
+                (define (f2 y) (set! y 32) (log y 2.0))
+                (+ (f1 0) (f2 0)))"
+	     " let: perhaps embed f2:
+                 (let () (define (f1 x) (set! x 32) (log x 2.0)) (define (f2 y) (set! y 32)... ->
+                 (... (+ (f1 0) (let ((y 0)) (set! y 32) (log y 2.0))))
+               f1: perhaps (set! x 32) -> (let ((x 32)) ...)
+               f2: f2 could be (define f2 f1)
+               f2: perhaps (set! y 32) -> (let ((y 32)) ...)")
+  (lint-test "(let ()
+                (define (f11 a b) (if (positive? a) (+ a b) b))
+                (let ((z (if (positive? a1) (+ a1 b1) b1)))
+                  (+ z (f11 1 2))))" "") ;" perhaps (if (positive? a1) (+ a1 b1) b1) -> (f11 a1 b1)") -- code fragments turned off now
+  (lint-test "(let ()
+                (define (f11 a b) (if (positive? a) (+ a b) b))
+                (define f14 (lambda (x y) (if (positive? x) (+ x y) y)))
+                (+ (f11 1 2) (f14 1 2)))"
+	     " let: the scope of f14 could be reduced:
+                 (... (define f14 (lambda (x y) (if (positive? x) (+ x y) y))) (+ (f11 1 2) (f14 1 2))) ->
+                 (... (let ((f14 (lambda (x y) (if (positive? x) (+ x y) y)))) (+ (f11 1 2) (f14 1 2))))")
+               ; f14: perhaps (if (positive? x) (+ x y) y) -> (f11 x y)
+  (lint-test "(let ()
+                (define f11 (let () (lambda (a b) (if (positive? a) (+ a b) b))))
+                (define (f14 x y) (if (positive? x) (+ x y) y))
+                (+ (f11 1 2) (f14 1 2)))"
+	     " let: perhaps embed f14: (let () (define f11 (let () (lambda (a b) (if (positive? a) (+ a b) b))))... ->
+                  (... (+ (f11 1 2) (let ((x 1) (y 2)) (if (positive? x) (+ x y) y))))
+               f11: pointless let: (let () (lambda (a b) (if (positive? a) (+ a b) b)))")
+               ; f14: f14 could be (define f14 f11)
+  (lint-test "(let ()
+                (define (f11 a b) (if (positive? a) (+ a b) b))
+                (define (f14 x y) (if (positive? x) (+ x (log y)) (log y)))
+                (+ (f11 1 2) (f14 1 2)))"  "") ; f14: perhaps (if (positive? x) (+ x (log y)) (log y)) -> (f11 x (log y))
+  (lint-test "(let () (define union (let ((z 32)) (set! x (lambda (y) (+ z y))) (lambda args args))) (union 1 2))" "")
+  (lint-test "(let ()
+                (define (f11 a b) (let ((z (+ a 1))) (if (positive? z) (+ a b) b)))
+                (define (f14 x y) (let ((w (+ x 1))) (if (positive? w) (+ x y) y)))
+                (+ (f11 1 2) (f14 1 2)))"
+	     " f11: perhaps (let ((z (+ a 1))) (if (positive? z) (+ a b) b)) -> (if (positive? (+ a 1)) (+ a b) b)
+               f14: f14 could be (define f14 f11)
+               f14: perhaps (let ((w (+ x 1))) (if (positive? w) (+ x y) y)) -> (if (positive? (+ x 1)) (+ x y) y)")
+  (lint-test "(let ()
+                (define (f11 a b) (let ((z (+ a 1))) (if (positive? z) (+ a b) b)))
+                (define (f14 x . y) (let ((w (+ x 1))) (if (positive? w) (+ x y) y)))
+                (+ (f11 1 2) (f14 1 2)))"
+	     " f11: perhaps (let ((z (+ a 1))) (if (positive? z) (+ a b) b)) -> (if (positive? (+ a 1)) (+ a b) b)
+               f14: perhaps (let ((w (+ x 1))) (if (positive? w) (+ x y) y)) -> (if (positive? (+ x 1)) (+ x y) y)")
+  (lint-test "(let ()
+                (define (f11 a b) (let ((z (+ a 1))) (if (positive? z) (+ a b) b)))
+                (define (f14 x y z) (let ((w (+ x 1))) (if (positive? w) (+ x y) y)))
+                (+ (f11 1 2) (f14 1 2 3)))"
+	     " f11: perhaps (let ((z (+ a 1))) (if (positive? z) (+ a b) b)) -> (if (positive? (+ a 1)) (+ a b) b)
+               f14: perhaps (let ((w (+ x 1))) (if (positive? w) (+ x y) y)) -> (if (positive? (+ x 1)) (+ x y) y)
+               let: f14's parameter 3 is not used, but a value is passed: 3")
+  ; f14: perhaps (let ((w (+ x 1))) (if (positive? w) (+ x y) y)) -> (f11 x y)
+  (lint-test "(let ()
+                (define (f11 a b) (let ((z (+ a 1))) (if (positive? z) (+ a b) b)))
+                (define (f14 x y) (let ((w (+ x 1)) (ww 1)) (if (positive? w) (+ x y) y)))
+                (+ (f11 1 2) (f14 1 2)))"
+	     " f11: perhaps (let ((z (+ a 1))) (if (positive? z) (+ a b) b)) -> (if (positive? (+ a 1)) (+ a b) b)
+               f14: ww not used, initially: 1 from let
+               f14: ww can be moved to f14's closure")
+  (lint-test "(let ()
+                (define (f12 a b) (let* ((z (+ a 1)) (zz z)) (if (positive? z) (+ a b) zz)))
+                (define (f15 x y) (let* ((w (+ x 1)) (ww w)) (if (positive? w) (+ x y) ww)))
+                (+ (f12 1 2) (f15 1 2)))"
+	     " f12: perhaps (let* ((z (+ a 1)) (zz z)) (if (positive? z) (+ a b) zz)) -> (let ((z (+ a 1))) (if (positive? z) (+ a b) z))
+               f15: f15 could be (define f15 f12)
+               f15: perhaps (let* ((w (+ x 1)) (ww w)) (if (positive? w) (+ x y) ww)) -> (let ((w (+ x 1))) (if (positive? w) (+ x y) w))")
+
+  (lint-test "(let ()
+                (define (f16 x) (do ((i 0 (+ i 1))) ((= i x)) (display i)))
+                (define (f17 y) (do ((k 0 (+ k 1))) ((= k y)) (display k)))
+                (f16 2) (f17 2))"               " f17: f17 could be (define f17 f16)")
+  (lint-test "(let ()
+                (define (f18 a b) (let ((z (lambda (c) (+ c 1)))) (if (positive? (z 1)) (+ a b) b)))
+                (define (f19 x y) (let ((w (lambda (d) (+ d 1)))) (if (positive? (w 1)) (+ x y) y)))
+                (+ (f18 1 2) (f19 1 2)))"
+	     " let: the local function z could be moved to f18's closure:
+                 (define (f18 a b) (let ((z (lambda (c) (+ c 1)))) (if (positive? (z 1)) (+... ->
+                 (define f18 (let ((z (lambda (c) (+ c 1)))) (lambda (a b) ...)))
+               f18: perhaps (let ((z (lambda (c) (+ c 1)))) (if (positive? (z 1)) (+ a b) b)) -> (if (positive? (let ((c 1)) (+ c 1))) (+ a b) b)
+               let: the local function w could be moved to f19's closure:
+                 (define (f19 x y) (let ((w (lambda (d) (+ d 1)))) (if (positive? (w 1)) (+... ->
+                 (define f19 (let ((w (lambda (d) (+ d 1)))) (lambda (x y) ...)))
+               f19: f19 could be (define f19 f18)
+               f19: perhaps (let ((w (lambda (d) (+ d 1)))) (if (positive? (w 1)) (+ x y) y)) -> (if (positive? (let ((d 1)) (+ d 1))) (+ x y) y)")
+
+  (lint-test "(let ()
+                (define (f20 a) (define (f20a b) (+ (* 2 b) a)) (f20a a))
+                (define (f21 x) (define (f21a c) (+ (* 2 c) x)) (f21a x))
+                (+ (f20 1) (f21 2)))"
+	      " let: perhaps (define (f20 a) (define (f20a b) (+ (* 2 b) a)) (f20a a)) -> (define (f20 a) (let ((b a)) (+ (* 2 b) a)))
+                let: perhaps (define (f21 x) (define (f21a c) (+ (* 2 c) x)) (f21a x)) -> (define (f21 x) (let ((c x)) (+ (* 2 c) x)))")
+  ; f21: f21 could be (define f21 f20)
+  (lint-test "(let ()
+                (define (f20 a) (define f20a (lambda (b) (+ (* 2 b) a))) (f20a a))
+                (define (f21 x) (define f21a (lambda (c) (+ (* 2 c) x))) (f21a x))
+                (+ (f20 1) (f21 2)))" "")
+  ; f21: f21 could be (define f21 f20)
+  (lint-test "(let ()
+                (define (f22 a) (lambda (b) (+ (* 2 b) a)))
+                (define (f23 x) (lambda (c) (+ (* 2 c) x)))
+                (+ ((f22 1) 2) ((f23 2) 3)))"
+	     "let: perhaps embed f23:
+                 (let () (define (f22 a) (lambda (b) (+ (* 2 b) a))) (define (f23 x)... ->
+                   (... (+ ((f22 1) 2) ((let ((x 2)) (lambda (c) (+ (* 2 c) x))) 3)))
+              f23: f23 could be (define f23 f22)")
+  (lint-test "(let ()
+                (define (f22 a) (lambda* ((b 21)) (+ (* 2 b) a)))
+                (define (f23 x) (lambda* ((c 21)) (+ (* 2 c) x)))
+                (+ ((f22 1) 2) ((f23 2) 3)))"
+	     "let: perhaps embed f23:
+                 (let () (define (f22 a) (lambda* ((b 21)) (+ (* 2 b) a))) (define (f23 x)... ->
+                   (... (+ ((f22 1) 2) ((let ((x 2)) (lambda* ((c 21)) (+ (* 2 c) x))) 3)))
+              f23: f23 could be (define f23 f22)")
+  (lint-test "(let ()
+                (define (f1 x)   (abs (* 2 (+ (car x) 1))))
+                (define (f2 . x) (abs (* 2 (+ (car x) 1))))
+                (+ (f1 '(2)) (f2 3)))" "") ; these should not match!
+  (lint-test "(let ()
+                (define (f1 . x)   (abs (* 2 (+ (car x) 1))))
+                (define (f2 x) (abs (* 2 (+ (car x) 1))))
+                (+ (f1 2) (f2 '(3))))"  ; these should not match!
+	     " let: perhaps embed f2:
+                (let () (define (f1 . x) (abs (* 2 (+ (car x) 1)))) (define (f2 x) (abs (*... -> (... (+ (f1 2) (let ((x '(3))) (abs (* 2 (+ (car x) 1))))))")
+  (lint-test "(let ()
+                (define (f24 aa) (let ((z (+ aa 1))) (if (positive? z) (f24 (+ aa 1)) 0)))
+                (define (f25 x) (let ((w (+ x 1))) (if (positive? w) (f25 (+ x 1)) 0)))
+                (+ (f24 2) (f25 2)))"
+	     " f25: f25 could be (define f25 f24)")
+  (lint-test "(let ()
+                (define* (f26 (aa 1)) (let ((z (+ aa 1))) (if (positive? z) (f26 (+ aa 1)) 0)))
+                (define* (f27 (x 1)) (let ((w (+ x 1))) (if (positive? w) (f27 (+ x 1)) 0)))
+                (+ (f26 2) (f27 2)))"
+	     " f27: f27 could be (define f27 f26)")
+  (lint-test "(let ()
+                (define (f31 a b) (if (> a 0) (+ a b) b))
+                (define (f32 x y) (if (< 0 y) (+ x y) y))
+                (+ (f31 1 2) (f32 1 2)))"       "")
+  (lint-test "(let () (define (f32) (let ((xx 1)) (set! xx 2) (+ xx 1))) (f32) 3)"
+	     " let: perhaps (... (define (f32) (let ((xx 1)) (set! xx 2) (+ xx 1))) (f32) 3) -> (... (let ((xx 1)) (set! xx 2) (+ xx 1)) 3)
+               f32: perhaps (let ((xx 1)) (set! xx 2) (+ xx 1)) -> (let ((xx 2)) (+ xx 1))
+               let: this could be omitted: (f32)")
+  (lint-test "(let ((xx 1)) (set! xx 2) (abs xx) xx)"
+	     " let: this could be omitted: (abs xx)
+               let: perhaps (let ((xx 1)) (set! xx 2) (abs xx) xx) -> (let ((xx 2)) (abs xx) ...)")
+  (lint-test "(let () (define (f32) (let ((xx 1)) (set! xxx 2) (+ xx 1))) (f32) 3)"
+	     " let: perhaps (... (define (f32) (let ((xx 1)) (set! xxx 2) (+ xx 1))) (f32) 3) ->
+                 (... (let ((xx 1)) (set! xxx 2) (+ xx 1)) 3)
+               f32: xx can be moved to f32's closure")
+  (lint-test "(let () (define (f32 x) (let ((xx (car x))) (vector-set! xx 0 2) xx)) (f32 (list (vector 1))) 3)"
+	     " let: perhaps (... (define (f32 x) (let ((xx (car x))) (vector-set! xx 0 2) xx)) (f32... ->
+                 (... (let ((x (list (vector 1)))) (let ((xx (car x))) (vector-set! xx 0 2) xx)) 3)")
+  (lint-test "(let () (define* (f1 x (y 0)) (+ x y 1)) (+ (f1 2) (f1 2 3) (f1 3) (f1 4) (f1 5) (f1 6)))" "")
+  (lint-test "(let () (define (f21 x) (+ x (let ((f21 (lambda (y) (+ x y)))) (f21 x 1)))) (f21 1))"
+	     " let: perhaps (... (define (f21 x) (+ x (let ((f21 (lambda (y) (+ x y)))) (f21 x 1))))... ->
+                 (... (let f21 ((x 1)) (+ x (let ((f21 (lambda (y) (+ x y)))) (f21 x 1)))))
+               f21: let variable f21 in (f21 (lambda (y) (+ x y))) shadows the current function?
+               f21: perhaps (let ((f21 (lambda (y) (+ x y)))) (f21 x 1)) -> ((lambda (y) (+ x y)) x 1)
+               f21: f21 has too many arguments: (f21 x 1)
+               f21: perhaps (let ((f21 (lambda (y) (+ x y)))) (f21 x 1)) -> (let ((y x)) (+ x y))")
+
+  (lint-test "(let* ((x 32) (fx (lambda (z) (+ x z)))) (+ x (fx)))" " let*: fx needs 1 argument: (fx)")
+  (lint-test "(let* ((x 32) (fx (lambda (z) (+ x z)))) (+ x (fx 1 2)))" " let*: fx has too many arguments: (fx 1 2)")
+  (lint-test "(let ((x 32) (fx (lambda (z) (+ x z)))) (+ x (fx 1 2)))" " let: fx has too many arguments: (fx 1 2)")
+
+  (lint-test "(define (f11 a b) (define (f120 a b) (if (positive? a) (+ a b) b)) (f120 a b))"
+	     " define: the inner function f120 could be moved to f11's closure:
+                 (define (f11 a b) (define (f120 a b) (if (positive? a) (+ a b) b)) (f120 a b)) ->
+                 (define f11 (let () (define (f120 a b) (if (positive? a) (+ a b) b)) (lambda (a b) ...)))
+               define: perhaps (define (f11 a b) (define (f120 a b) (if (positive? a) (+ a b) b)) (f120 a b)) ->
+                 (define (f11 a b) (if (positive? a) (+ a b) b))")
+  (lint-test "(define (f11 a b) (define (f121 a b) (if (positive? a) (+ a b) b)) (f121 b a))"
+	     " define: the inner function f121 could be moved to f11's closure:
+                 (define (f11 a b) (define (f121 a b) (if (positive? a) (+ a b) b)) (f121 b a)) ->
+                 (define f11 (let () (define (f121 a b) (if (positive? a) (+ a b) b)) (lambda (a b) ...)))
+               define: perhaps (define (f11 a b) (define (f121 a b) (if (positive? a) (+ a b) b)) (f121 b a)) ->
+                 (define (f11 a b) (let ((a b) (b a)) (if (positive? a) (+ a b) b)))")
+  (lint-test "(define (f11 a b) (define (f122 a b) (display a) (if (positive? a) (+ a b) b)) (f122 a b))"
+	     " define: the inner function f122 could be moved to f11's closure:
+                 (define (f11 a b) (define (f122 a b) (display a) (if (positive? a) (+ a b)... ->
+                 (define f11 (let () (define (f122 a b) (display a) (if (positive? a) (+ a b) b)) (lambda (a b) ...)))
+               define: perhaps (define (f11 a b) (define (f122 a b) (display a) (if (positive? a) (+ a b)... ->
+                 (define (f11 a b) (display a) (if (positive? a) (+ a b) b))")
+  (lint-test "(define (f11 a b) (define (f123) (if (positive? a) (+ a b) b)) (f123))"
+	     " define: perhaps (define (f11 a b) (define (f123) (if (positive? a) (+ a b) b)) (f123)) ->
+                 (define (f11 a b) (if (positive? a) (+ a b) b))")
+  (lint-test "(define (f11 a b) (define (f124 x y) (if (positive? x) (+ x y) x)) (f124 (+ a 1) (* b 2)))"
+	     " define: the inner function f124 could be moved to f11's closure:
+                 (define (f11 a b) (define (f124 x y) (if (positive? x) (+ x y) x)) (f124... ->
+                 (define f11 (let () (define (f124 x y) (if (positive? x) (+ x y) x)) (lambda (a b) ...)))
+               define: perhaps (define (f11 a b) (define (f124 x y) (if (positive? x) (+ x y) x)) (f124... ->
+                 (define (f11 a b) (let ((x (+ a 1)) (y (* b 2))) (if (positive? x) (+ x y) x)))")
+  (lint-test "(define (f11 a b) (define (f125 x y) (if (positive? x) (+ x y) (f125 1 x))) (f125 (+ a 1) (* b 2)))"
+	     " define: the inner function f125 could be moved to f11's closure:
+                 (define (f11 a b) (define (f125 x y) (if (positive? x) (+ x y) (f125 1... ->
+                 (define f11 (let () (define (f125 x y) (if (positive? x) (+ x y) (f125 1 x))) (lambda (a b) ...)))
+               define: perhaps (define (f11 a b) (define (f125 x y) (if (positive? x) (+ x y) (f125 1... ->
+                 (define (f11 a b) (let f125 ((x (+ a 1)) (y (* b 2))) (if (positive? x) (+ x y) (f125 1 x))))")
+  (lint-test "(define (f11 a b) (define (f126 x y) (if (positive? x) (+ x y) (f126 1 x))) (+ a (f126 (+ a 1) (* b 2))))"
+	     " define: the inner function f126 could be moved to f11's closure:
+                 (define (f11 a b) (define (f126 x y) (if (positive? x) (+ x y) (f126 1... ->
+                 (define f11 (let () (define (f126 x y) (if (positive? x) (+ x y) (f126 1 x))) (lambda (a b) ...)))
+               define: perhaps (define (f11 a b) (define (f126 x y) (if (positive? x) (+ x y) (f126 1... ->
+                 (define (f11 a b) (+ a (let f126 ((x (+ a 1)) (y (* b 2))) (if (positive? x) (+ x y) (f126 1 x)))))")
+  (lint-test "(define (f11 a b) (define (f127 x y) (if (positive? x) (+ x y) (f127 1 x))) (display b) (+ a (f127 (+ a 1) (* b 2))))"
+	     " define: the inner function f127 could be moved to f11's closure:
+                 (define (f11 a b) (define (f127 x y) (if (positive? x) (+ x y) (f127 1... ->
+                 (define f11 (let () (define (f127 x y) (if (positive? x) (+ x y) (f127 1 x))) (lambda (a b) ...)))
+               define: perhaps (define (f11 a b) (define (f127 x y) (if (positive? x) (+ x y) (f127 1... ->
+                 (define (f11 a b) (display b) (+ a (let f127 ((x (+ a 1)) (y (* b 2))) (if (positive? x) (+ x y) (f127 1 x)))))")
+  (lint-test "(define (f11) (define (f128) (if (positive? a) (+ a b) (f128))) (f128))"
+	     " define: the inner function f128 could be moved to f11's closure:
+                 (define (f11) (define (f128) (if (positive? a) (+ a b) (f128))) (f128)) ->
+                 (define f11 (let () (define (f128) (if (positive? a) (+ a b) (f128))) (lambda () ...)))
+               define: perhaps (define (f11) (define (f128) (if (positive? a) (+ a b) (f128))) (f128)) ->
+                 (define (f11) (if (positive? a) (+ a b) (f11)))")
+
+  (lint-test "(lambda (y) (let ((z 3)) (+ z (f1 y))))" " lambda: z can probably be moved to lambda's closure")
+  (lint-test "(lambda (y) (let ((z (lambda () 32))) (+ (z) (f1 y))))"
+	     " lambda: the local function z could be moved outside the lambda:
+                 (lambda (y) (let ((z (lambda () 32))) (+ (z) (f1 y)))) -> (let ((z (lambda () 32))) (lambda (y) ...))
+               lambda: perhaps (let ((z (lambda () 32))) (+ (z) (f1 y))) -> (+ (let () 32) (f1 y))")
+  (lint-test "(lambda (y) (letrec ((z 3)) (+ z (f1 y))))" " lambda: letrec could be let: (letrec ((z 3)) (+ z (f1 y)))")
+  (lint-test "(lambda (y) (letrec ((z (lambda () 32))) (+ (z) (f1 y))))"
+	     " lambda: the local function z could be moved outside the lambda:
+                 (lambda (y) (letrec ((z (lambda () 32))) (+ (z) (f1 y)))) -> (letrec ((z (lambda () 32))) (lambda (y) ...))
+               lambda: letrec could be let: (letrec ((z (lambda () 32))) (+ (z) (f1 y)))
+               lambda: perhaps (letrec ((z (lambda () 32))) (+ (z) (f1 y))) -> (+ (let z () 32) (f1 y))")
+  (lint-test "(define (lr1 y) (letrec ((z (lambda () 32))) (+ (z) (f1 y))))"
+	     " define: the local function z could be moved to lr1's closure:
+                 (define (lr1 y) (letrec ((z (lambda () 32))) (+ (z) (f1 y)))) -> (define lr1 (letrec ((z (lambda () 32))) (lambda (y) ...)))
+               lr1: letrec could be let: (letrec ((z (lambda () 32))) (+ (z) (f1 y)))
+               lr1: perhaps (letrec ((z (lambda () 32))) (+ (z) (f1 y))) -> (+ (let z () 32) (f1 y))")
+  (lint-test "(define (lr1 y) (letrec ((z (lambda () (z 32)))) (+ (z) (f1 y))))"
+	     " define: the local function z could be moved to lr1's closure:
+                (define (lr1 y) (letrec ((z (lambda () (z 32)))) (+ (z) (f1 y)))) -> (define lr1 (letrec ((z (lambda () (z 32)))) (lambda (y) ...)))
+               lr1: perhaps (letrec ((z (lambda () (z 32)))) (+ (z) (f1 y))) -> (+ (let z () (z 32)) (f1 y))")
+  (lint-test "(define (lr1 y) (letrec ((z (lambda () (z 32)))) (+ (z) (f1 y))))"
+	     " define: the local function z could be moved to lr1's closure:
+                (define (lr1 y) (letrec ((z (lambda () (z 32)))) (+ (z) (f1 y)))) -> (define lr1 (letrec ((z (lambda () (z 32)))) (lambda (y) ...)))
+               lr1: perhaps (letrec ((z (lambda () (z 32)))) (+ (z) (f1 y))) -> (+ (let z () (z 32)) (f1 y))")
+  (lint-test "(define (lr1 y) (letrec ((z1 (lambda () (z2 32))) (z2 (lambda () (z1 12)))) (+ (z1) (z2) (f1 y))))"
+	     " define: the local functions z2, z1 could be moved to lr1's closure:
+                 (define (lr1 y) (letrec ((z1 (lambda () (z2 32))) (z2 (lambda () (z1... ->
+                 (define lr1 (letrec ((z2 (lambda () (z1 12))) (z1 (lambda () (z2 32)))) (lambda (y) ...)))")
+  (lint-test "(define (lr1 y) (letrec ((z1 (lambda () (z2 y))) (z2 (lambda () (z1 12)))) (+ (z1) (z2) (f1 y))))" "")
+
+  (lint-test "(let () (define (f40 x) (+ x 1)) (define (f41 y z) (y (+ z 1))) (f41 f40 2))"
+	     " let: perhaps change f41 to a let: (let () (define (f40 x) (+ x 1)) (define (f41 y z) (y (+ z 1))) (f41 f40 2)) -> (... (let ((y f40) (z 2)) ...))")
+  (lint-test "(let () (define (f41 y z) (y (+ z 1))) (f41 abs 2))"
+	     " let: perhaps (... (define (f41 y z) (y (+ z 1))) (f41 abs 2)) -> (... (let ((y abs) (z 2)) (y (+ z 1))))")
+  (lint-test "(let () (define (f42 y z) (y (+ z 1))) (f42 (lambda (a) (+ a 1)) 2))"
+	     " let: perhaps (... (define (f42 y z) (y (+ z 1))) (f42 (lambda (a) (+ a 1)) 2)) -> (... (let ((y (lambda (a) (+ a 1))) (z 2)) (y (+ z 1))))")
+
+  (lint-test "(define f43 (letrec ((f0 (lambda (a) (+ a 1)))) (lambda (b) (f0 (+ b 1)))))"
+	     " define: perhaps (letrec ((f0 (lambda (a) (+ a 1)))) (lambda (b) (f0 (+ b 1)))) -> (lambda (b) (let f0 ((a (+ b 1))) (+ a 1)))
+               define: letrec could be let: (letrec ((f0 (lambda (a) (+ a 1)))) (lambda (b) (f0 (+ b 1))))
+               define: perhaps (define f43 (letrec ((f0 (lambda (a) (+ a 1)))) (lambda (b) (f0 (+ b 1))))) -> (define (f43 b) (let f0 ((a (+ b 1))) (+ a 1)))")
+  (lint-test "(define f43 (letrec ((f0 (lambda (a b) (+ (f0 a b) 1)))) (lambda (b) (f0 b 0))))"
+	     " define: perhaps (letrec ((f0 (lambda (a b) (+ (f0 a b) 1)))) (lambda (b) (f0 b 0))) ->
+                 (lambda (b) (let f0 ((a b) (b 0)) (+ (f0 a b) 1)))
+               define: perhaps (define f43 (letrec ((f0 (lambda (a b) (+ (f0 a b) 1)))) (lambda (b) (f0 b... ->
+                 (define (f43 b) (let f0 ((a b) (b 0)) (+ (f0 a b) 1)))")
+  (lint-test "(define f43 (letrec ((f0 (lambda (a) (+ a 1)))) (lambda (b) (if (> b 0) (f0 (+ b 1))))))"
+	     " define: perhaps (letrec ((f0 (lambda (a) (+ a 1)))) (lambda (b) (if (> b 0) (f0 (+ b 1))))) -> (lambda (b) (if (> b 0) (let f0 ((a (+ b 1))) (+ a 1))))
+               define: letrec could be let: (letrec ((f0 (lambda (a) (+ a 1)))) (lambda (b) (if (> b 0) (f0 (+ b 1)))))
+               define: perhaps (define f43 (letrec ((f0 (lambda (a) (+ a 1)))) (lambda (b) (if (> b 0)... -> (define (f43 b) (if (> b 0) (let f0 ((a (+ b 1))) (+ a 1))))")
+
+  (lint-test "(lambda (c) (letrec ((f0 (lambda (a) (+ a 1)))) (f0 (+ c 1))))"
+	     " lambda: the local function f0 could be moved outside the lambda:
+                 (lambda (c) (letrec ((f0 (lambda (a) (+ a 1)))) (f0 (+ c 1)))) -> (letrec ((f0 (lambda (a) (+ a 1)))) (lambda (c) ...))
+               lambda: letrec could be let: (letrec ((f0 (lambda (a) (+ a 1)))) (f0 (+ c 1)))
+               lambda: perhaps (letrec ((f0 (lambda (a) (+ a 1)))) (f0 (+ c 1))) -> (let f0 ((a (+ c 1))) (+ a 1))")
+  (lint-test "(lambda (c) (letrec ((f0 (lambda (a) (+ a c 1)))) (let ((c 32)) (f0 (+ c 1)))))"
+	     " lambda: letrec could be let: (letrec ((f0 (lambda (a) (+ a c 1)))) (let ((c 32)) (f0 (+ c 1))))
+               lambda: perhaps (let ((c 32)) (f0 (+ c 1))) -> (f0 (+ 32 1))")
+  (lint-test "(letrec ((auto-save-func (lambda () (if auto-saving (in 1.0 auto-save-func))))) (lambda () (in 1.0 auto-save-func)))" "") ; don't rewrite this one!
+  (lint-test "(let ((x (lambda (y) (+ y (x (- y 1)))))) (x 2))"
+	     " let: let variable x is called in its binding?  Perhaps let should be letrec: ((x (lambda (y) (+ y (x (- y 1))))))
+               let: perhaps (let ((x (lambda (y) (+ y (x (- y 1)))))) (x 2)) -> (let ((y 2)) (+ y (x (- y 1))))")
+  (lint-test "(let () (define (f60 x) (* 2 x)) (+ 1 (f60 y)))"
+	     " let: perhaps (... (define (f60 x) (* 2 x)) (+ 1 (f60 y))) -> (... (+ 1 (let ((x y)) (* 2 x))))")
+  (lint-test "(let () (define f60 (let ((a (lambda (x) (* 2 x)))) a)) (+ 1 (f60 y)))"
+	     " f60: perhaps (let ((a (lambda (x) (* 2 x)))) a) -> (lambda (x) (* 2 x))")
+  (lint-test "(let ((x 2)) (let loop ((y x)) (if (positive? y) (loop (- y 1)) 0)))"
+	     " loop: perhaps (let loop ((y x)) (if (positive? y) (loop (- y 1)) 0)) -> (do ((y x (- y 1))) ((not (positive? y)) 0))
+               let: perhaps (let ((x 2)) (let loop ((y x)) (if (positive? y) (loop (- y 1)) 0))) -> (let loop ((y 2)) (if (positive? y) (loop (- y 1)) 0))")
+  (lint-test "(let ((f60 (lambda (x) (* 2 x)))) (+ 1 (f60 y)))"
+	     " let: perhaps (let ((f60 (lambda (x) (* 2 x)))) (+ 1 (f60 y))) -> (+ 1 (let ((x y)) (* 2 x)))")
+  (lint-test "(define (f61 x) (let loop ((y x)) (if (positive? y) (loop (- y 1)) 0)))"
+	     " define: perhaps (define (f61 x) (let loop ((y x)) (if (positive? y) (loop (- y 1)) 0))) -> (define (f61 y) (if (positive? y) (f61 (- y 1)) 0))
+               loop: perhaps (let loop ((y x)) (if (positive? y) (loop (- y 1)) 0)) -> (do ((y x (- y 1))) ((not (positive? y)) 0))")
+  (lint-test "(define (f61 x) (let loop ((x x)) (if (positive? x) (loop (- x 1)) 0)))"
+	     " define: perhaps (define (f61 x) (let loop ((x x)) (if (positive? x) (loop (- x 1)) 0))) -> (define (f61 x) (if (positive? x) (f61 (- x 1)) 0))
+               loop: perhaps (let loop ((x x)) (if (positive? x) (loop (- x 1)) 0)) -> (do ((x x (- x 1))) ((not (positive? x)) 0))")
+  (lint-test "(define (f61) (let loop () (if (positive? x) (loop) 0)))"
+	     " define: perhaps (define (f61) (let loop () (if (positive? x) (loop) 0))) -> (define (f61) (if (positive? x) (f61) 0))")
+  (lint-test "(define (rep x) (f x) (f x) (f x) (f x) (f x))" "rep: perhaps (f x)... -> (do ((i 0 (+ i 1))) ((= i 5)) (f x))")
+  (lint-test "(define (rep1 lim)
+                (let ((sum 0))
+                  (do ((i 0 (+ i 1))) ((= i lim)) (set! sum (+ sum i)))
+                  (do ((i 0 (+ i 1))) ((= i lim)) (set! sum (+ sum i)))
+                  (do ((i 0 (+ i 1))) ((= i lim)) (set! sum (+ sum i)))
+                  (do ((i 0 (+ i 1))) ((= i lim)) (set! sum (+ sum i)))
+                  sum))"
+	     "rep1: perhaps (do ((i 0 (+ i 1))) ((= i lim)) (set! sum (+ sum i)))... ->
+                (do ((<1> 0 (+ <1> 1))) ((= <1> 4)) (do ((i 0 (+ i 1))) ((= i lim)) (set! sum (+ sum i))))")
+
+  (lint-test "(let () (define (get-xyzzy a) (+ 1 (car a)))
+                      (define (set-xyzzy a b) (cons (+ a 1) b))
+                (set-xyzzy x (get-xyzzy y)))"
+	     "let: perhaps change set-xyzzy to a let:
+                 (let () (define (get-xyzzy a) (+ 1 (car a))) (define (set-xyzzy a b) (cons... -> (... (let ((a x) (b (get-xyzzy y))) ...))
+	      let: perhaps use dilambda and generalized set! for get-xyzzy and set-xyzzy:
+              replace (get-xyzzy ...) with (xyzzy ...) and (set-xyzzy ... b) with (set! (xyzzy ...) b)
+              (define xyzzy (dilambda (lambda (a) (+ 1 (car a))) (lambda (a b) (cons (+ a 1) b))))")
+  (lint-test "(let () (define (xyzzy-ref a) (+ 1 (car a)))
+                      (define (xyzzy-set! a b) (cons (+ a 1) b))
+                (xyzzy-set! x (xyzzy-ref y)))"
+	     "let: perhaps change xyzzy-set! to a let:
+                 (let () (define (xyzzy-ref a) (+ 1 (car a))) (define (xyzzy-set! a b)... -> (... (let ((a x) (b (xyzzy-ref y))) ...))
+	      let: perhaps use dilambda and generalized set! for xyzzy-ref and xyzzy-set!:
+              replace (xyzzy-ref ...) with (xyzzy ...) and (xyzzy-set! ... b) with (set! (xyzzy ...) b)
+              (define xyzzy (dilambda (lambda (a) (+ 1 (car a))) (lambda (a b) (cons (+ a 1) b))))")
+  (lint-test "(let () (define (get-xyzzy) (+ 1 (car a)))
+                      (define (set-xyzzy b) (set! z b))
+                (set-xyzzy x) (get-xyzzy))"
+	     "let: perhaps use dilambda and generalized set! for get-xyzzy and set-xyzzy:
+              replace (get-xyzzy) with (xyzzy) and (set-xyzzy b) with (set! (xyzzy) b)
+              (define xyzzy (dilambda (lambda () (+ 1 (car a))) (lambda (b) (set! z b))))")
+  (lint-test "(let () (define (xyzzy-ref xyzzy b) (+ b (car xyzzy)))
+                      (define (xyzzy-set! xyzzy b c) (list (+ xyzzy c) b))
+                (xyzzy-set! obj (xyzzy-ref obj y) z))"
+	     "let: perhaps change xyzzy-set! to a let:
+                (let () (define (xyzzy-ref xyzzy b) (+ b (car xyzzy))) (define (xyzzy-set!... -> (... (let ((xyzzy obj) (b (xyzzy-ref obj y)) (c z)) ...))
+	      let: perhaps use dilambda and generalized set! for xyzzy-ref and xyzzy-set!:
+              replace (xyzzy-ref ...) with (xyzzy ...) and (xyzzy-set! ... c) with (set! (xyzzy ...) c)
+              (define xyzzy (dilambda (lambda (<1> b) (+ b (car <1>))) (lambda (<1> b c) (list (+ <1> c) b))))")
+  (lint-test "(let () (define (xyz-get-zy xyzzy b) (+ b (car xyzzy)))
+                      (define (xyz-set-zy xyzzy b c) (list (+ xyzzy c) b))
+                (xyz-set-zy obj (xyz-get-zy obj y) z))"
+	     "let: perhaps change xyz-set-zy to a let:
+                (let () (define (xyz-get-zy xyzzy b) (+ b (car xyzzy))) (define... -> (... (let ((xyzzy obj) (b (xyz-get-zy obj y)) (c z)) ...))
+	      let: perhaps use dilambda and generalized set! for xyz-get-zy and xyz-set-zy:
+              replace (xyz-get-zy ...) with (xyz-zy ...) and (xyz-set-zy ... c) with (set! (xyz-zy ...) c)
+               (define xyz-zy (dilambda (lambda (xyzzy b) (+ b (car xyzzy))) (lambda (xyzzy b c) (list (+ xyzzy c) b))))")
+  (lint-test "(begin (define x (let ((y 0)) (dilambda (lambda () y) (lambda (z) (set! y z))))) (or (> (x) 0) (= (x) 0)))"
+	     " begin: perhaps (or (> (x) 0) (= (x) 0)) -> (>= (x) 0)")
+  (lint-test "(let* ((x 32) (dx (dilambda (lambda (z) (+ x z)) (lambda (z) (set! x z))))) (set! (dx) 3) x)" "")
+
+  (lint-test "(let () (define (f104 x) (log x 8)) (define (f105 y) (+ y (f104 y))) (f105 (f104 3)))"
+	     " let: perhaps change f105 to a let: (let () (define (f104 x) (log x 8)) (define (f105 y) (+ y (f104 y))) (f105... ->
+                (... (let ((y (f104 3))) ...))")
+  (lint-test "(let () (define (f104 x) (log x 8)) (define (f105 y) (+ y (f105 y))) (f105 (f104 3)))"
+	     " let: perhaps change f105 to a named let: (let () (define (f104 x) (log x 8)) (define (f105 y) (+ y (f105 y))) (f105... ->
+                (... (let f105 ((y (f104 3))) ...))")
+  (lint-test "(let () (define (f104 x) (log x 8)) (define (f105 y) (+ y (f104 y))) (+ 1 (f105 (f104 3))))"
+	     " let: perhaps embed f105: (let () (define (f104 x) (log x 8)) (define (f105 y) (+ y (f104 y))) (+ 1... ->
+                (... (+ 1 (let ((y (f104 3))) (+ y (f104 y)))))")
+  (lint-test "(let () (define (f104 x) (log x 8)) (define (f105 y) (+ y (f105 y))) (+ 1 (f105 (f104 3))))"
+	     " let: perhaps embed f105: (let () (define (f104 x) (log x 8)) (define (f105 y) (+ y (f105 y))) (+ 1... ->
+                (... (+ 1 (let f105 ((y (f104 3))) (+ y (f105 y)))))")
+
+  (lint-test "(define (f70 a b) (let ((a a) (b b)) (+ a b)))"
+	     " define: in (define (f70 a b) (let ((a a) (b b)) (+ a b))) this let binding is pointless: (a a)
+               define: in (define (f70 a b) (let ((a a) (b b)) (+ a b))) this let binding is pointless: (b b)
+               f70: perhaps (let ((a a) (b b)) (+ a b)) -> (+ a b)")
+  (lint-test "(let () (define f74 (lambda (b) (let loop ((c b)) (loop (+ c 1))))) (f74 2))"
+	     " let: perhaps (define f74 (lambda (b) (let loop ((c b)) (loop (+ c 1))))) -> (define (f74 c) (f74 (+ c 1)))")
+  (lint-test "(let () (define f74 (lambda (b) (let loop ((b b)) (loop (+ b 1))))) (f74 2))"
+	     " let: perhaps (define f74 (lambda (b) (let loop ((b b)) (loop (+ b 1))))) -> (define (f74 b) (f74 (+ b 1)))")
+  (lint-test "(let () (define f74 (lambda (b) (let loop ((b b) (c 0)) (loop (+ b c))))) (f74 2))"
+	     " f74: loop needs 2 arguments: (loop (+ b c))
+               let: a toss-up -- perhaps (define f74 (lambda (b) (let loop ((b b) (c 0)) (loop (+ b c))))) -> (define* (f74 b (c 0)) (f74 (+ b c)))")
+
+  (lint-test "(let () (define (f1 x) (+ x 1)) (define (f2 a) (+ (a 1) 1)) (let ((b (f1 2))) (f2 f1) (+ b (f1 2) (f1 2) (f1 2))))" "")
+  (lint-test "(let () (define (f1 x) (+ x 1)) (let ((b (f1 2))) (+ b (f1 2) (f1 2) (f1 2))))" " let: f1's 'x parameter is always 2 (4 calls)")
+
+  (lint-test "(let ((s s)) (- (expt s 3) (expt s 2)))"
+	     " let: perhaps omit this useless let: (let ((s s)) (- (expt s 3) (expt s 2))) -> (- (expt s 3) (expt s 2))")
+  (lint-test "(let ((x x)) (vector-set! x 0 1) x)"
+	     " let: perhaps omit this useless let: (let ((x x)) (vector-set! x 0 1) x) -> (begin (vector-set! x 0 1) x)")
+  (lint-test "(let ((abs abs)) (+ x y))"
+	     " let: perhaps omit this useless let: (let ((abs abs)) (+ x y)) -> (+ x y)
+               let: abs not used, initially: abs from let")
+  (lint-test "(let ((x y)) (display (abs x)) x)" "")
+  (lint-test "(let ((v V)) (vector-set! v 0 1) v)" "")
+  (lint-test "(let ((car car)) (lambda (x) (car x)))"
+	     " let: perhaps omit this useless let: (let ((car car)) (lambda (x) (car x))) -> (lambda (x) (car x))
+               let: perhaps (lambda (x) (car x)) -> car")
+  (lint-test "(let ((abc 'abc)) (eq? x abc))"
+	     " let: perhaps (let ((abc 'abc)) (eq? x abc)) -> (eq? x 'abc)
+               let: pointless local variable: abc, just use 'abc directly")
+
+  (lint-test "(define (f x) (define y (g x)) (h (+ y x)))" "")
+  (lint-test "(define (f x) (define y (g x)) (define z (h x)) (w (+ y x z)))"
+	     " f: perhaps (... (define y (g x)) (define z (h x)) (w (+ y x z))) -> (... (let ((y (g x)) (z (h x))) ...))
+               f: the scope of z could be reduced: (... (define z (h x)) (w (+ y x z))) -> (... (let ((z (h x))) (w (+ y x z))))")
+  (lint-test "(define (f x) (define y (g x)) (define z (h y)) (w (+ y x z)))"
+	     " f: perhaps (... (define y (g x)) (define z (h y)) (w (+ y x z))) -> (... (let* ((y (g x)) (z (h y))) ...))
+               f: the scope of z could be reduced: (... (define z (h y)) (w (+ y x z))) -> (... (let ((z (h y))) (w (+ y x z))))")
+  (lint-test "(define (f x) (define y (g x)) (define z (lambda (a) (if w (z (- a 1))))) (z (+ y x)))"
+	     " f: perhaps (... (define y (g x)) (define z (lambda (a) (if w (z (- a 1))))) (z (+ y x))) -> (... (let ((y (g x))) ...))
+               f: the scope of z could be reduced:
+                 (... (define z (lambda (a) (if w (z (- a 1))))) (z (+ y x))) -> (... (letrec ((z (lambda (a) (if w (z (- a 1)))))) (z (+ y x))))
+               z: perhaps (lambda (a) (if w (z (- a 1)))) -> (lambda (a) (do ((a a (- a 1))) ((not w))))")
+  (lint-test "(define (f x) (define y (g x)) (define z (lambda (a) (if y (z (- a 1))))) (z (+ y x)))"
+	     " f: perhaps (... (define y (g x)) (define z (lambda (a) (if y (z (- a 1))))) (z (+ y x))) -> (... (let ((y (g x))) ...))
+               f: the scope of z could be reduced:
+                (... (define z (lambda (a) (if y (z (- a 1))))) (z (+ y x))) -> (... (letrec ((z (lambda (a) (if y (z (- a 1)))))) (z (+ y x))))
+               z: perhaps (lambda (a) (if y (z (- a 1)))) -> (lambda (a) (do ((a a (- a 1))) ((not y))))")
+
+  (lint-test "(lambda (a . opt) (let ((ip (if (null? opt) (current-input-port) (car opt)))) (read ip)))"
+	     " :lambda: perhaps (lambda (a . opt) (let ((ip (if (null? opt) (current-input-port) (car... -> (lambda* (a (ip (current-input-port))) ...)
+                lambda: perhaps (let ((ip (if (null? opt) (current-input-port) (car opt)))) (read ip)) -> (read (if (null? opt) (current-input-port) (car opt)))")
+  (lint-test "(lambda opt (let ((ip (if (null? opt) (current-input-port) (car opt)))) (read ip)))"
+	     " :lambda: perhaps (lambda opt (let ((ip (if (null? opt) (current-input-port) (car opt))))... -> (lambda* ((ip (current-input-port))) ...)
+                lambda: perhaps (let ((ip (if (null? opt) (current-input-port) (car opt)))) (read ip)) -> (read (if (null? opt) (current-input-port) (car opt)))")
+  (lint-test "(define (f204 b . opt) (let ((ip (if (null? opt) (current-input-port) (car opt)))) (read ip)))"
+	     " f204: perhaps (define (f204 b . opt) (let ((ip (if (null? opt) (current-input-port) (car... -> (define* (f204 b (ip (current-input-port))) ...)
+               f204: perhaps (let ((ip (if (null? opt) (current-input-port) (car opt)))) (read ip)) -> (read (if (null? opt) (current-input-port) (car opt)))")
+  (lint-test "(define (f205 b . opt) (let ((ip (if (null? opt) #f (car opt)))) (read ip)))"
+	     " f205: perhaps (define (f205 b . opt) (let ((ip (if (null? opt) #f (car opt)))) (read ip))) -> (define* (f205 b ip) ...)
+               f205: perhaps (if (null? opt) #f (car opt)) -> (and (not (null? opt)) (car opt))
+               f205: perhaps (let ((ip (if (null? opt) #f (car opt)))) (read ip)) -> (read (if (null? opt) #f (car opt)))")
+  (lint-test "(define f206 (lambda (c . opt) (let ((ip (if (null? opt) (current-input-port) (car opt)))) (read ip))))"
+	     " :lambda: perhaps (lambda (c . opt) (let ((ip (if (null? opt) (current-input-port) (car... -> (lambda* (c (ip (current-input-port))) ...)
+               f206: perhaps (let ((ip (if (null? opt) (current-input-port) (car opt)))) (read ip)) -> (read (if (null? opt) (current-input-port) (car opt)))")
+  (lint-test "(define (f207 b . opt) (let* ((ip (if (null? opt) #f (car opt))) (op (port? ip))) (read ip)))"
+	     " f207: perhaps (define (f207 b . opt) (let* ((ip (if (null? opt) #f (car opt))) (op... -> (define* (f207 b ip) (let ((op (port? ip))) ...))
+               f207: perhaps (if (null? opt) #f (car opt)) -> (and (not (null? opt)) (car opt))
+               f207: op not used, initially: (port? ip) from let*")
+  (lint-test "(define (f208 b . opt) (let* ((ip (if (null? opt) #f (car opt))) (op (port? ip)) (op2 op)) (read ip)))"
+	     " f208: perhaps (define (f208 b . opt) (let* ((ip (if (null? opt) #f (car opt))) (op... -> (define* (f208 b ip) (let* ((op (port? ip)) (op2 op)) ...))
+               f208: perhaps (if (null? opt) #f (car opt)) -> (and (not (null? opt)) (car opt))
+               f208: op2 not used, initially: op from let*
+               f208: perhaps restrict op which is not used in the let* body
+                 (let* ((ip (if (null? opt) #f (car opt))) (op (port? ip)) (op2 op)) (read ip)) ->
+                 (let* ((ip (if (null? opt) #f (car opt))) (op2 (let ((op (port? ip))) op))) ...)")
+  (lint-test "(define (f210 b . opt) (let ((ip (if (null? opt) 0 (car opt)))) (g ip) (f ip)))"
+	     " f210: perhaps (define (f210 b . opt) (let ((ip (if (null? opt) 0 (car opt)))) (g ip) (f ip))) -> (define* (f210 b (ip 0)) ...)")
+  (lint-test "(define (f210 b . opt) (let ((ip (if (not (pair? opt)) 0 (car opt)))) (g ip) (f ip)))"
+	     " f210: perhaps (define (f210 b . opt) (let ((ip (if (not (pair? opt)) 0 (car opt)))) (g... -> (define* (f210 b (ip 0)) ...)")
+  (lint-test "(define (f210 b . opt) (let ((ip (if (pair? opt) (car opt) 0))) (g ip) (f ip)))"
+	     " f210: perhaps (define (f210 b . opt) (let ((ip (if (pair? opt) (car opt) 0))) (g ip) (f ip))) -> (define* (f210 b (ip 0)) ...)")
+  (lint-test "(define (f210 b . opt) (let ((ip (if (not (null? opt)) (car opt) 0))) (g ip) (f ip)))"
+	     " f210: perhaps (define (f210 b . opt) (let ((ip (if (not (null? opt)) (car opt) 0))) (g... -> (define* (f210 b (ip 0)) ...)
+               f210: perhaps (if (not (null? opt)) (car opt) 0) -> (if (null? opt) 0 (car opt))")
+  (lint-test "(define (f210 . opt) (let ((ip (if (null? opt) 0 (car opt)))) (g ip) (f ip)))"
+	     " f210: perhaps (define (f210 . opt) (let ((ip (if (null? opt) 0 (car opt)))) (g ip) (f ip))) -> (define* (f210 (ip 0)) ...)")
+  (lint-test "(define (f210 . opt) (let ((ip (if (null? opt) #f (car opt)))) (g ip) (f ip)))"
+	     " f210: perhaps (define (f210 . opt) (let ((ip (if (null? opt) #f (car opt)))) (g ip) (f ip))) -> (define* (f210 ip) ...)
+               f210: perhaps (if (null? opt) #f (car opt)) -> (and (not (null? opt)) (car opt))")
+
+  (lint-test "(define f230 (lambda* (:allow-other-keys) 1))" " lambda*: :allow-other-keys can't be the only parameter: (:allow-other-keys)")
+  (lint-test "(define* (f230 :allow-other-keys) 1)"          " f230: :allow-other-keys can't be the only parameter: (:allow-other-keys)")
+  (lint-test "(define f230 (lambda* (:rest) 1))"             " lambda*: :rest parameter needs a name: (:rest)")
+  (lint-test "(define* (f230 :rest) 1)"                      " f230: :rest parameter needs a name: (:rest)")
+
+  (let-temporarily ((*report-clobbered-function-return-value* #t))
+    (lint-test "(let ((v #f)) (define (f80) (display v) \"a string\") (set! v (f80)) (string-set! v 0 #\\a))"
+	       " let: perhaps (... (define (f80) (display v) \"a string\") (set! v (f80)) (string-set! v 0... ->
+                   (... (set! v (let () (display v) \"a string\")) (string-set! v 0 #\\a))
+                 f80: returns a string constant: \"a string\"
+                 let: (set! v (f80)) returns a constant sequence, but (string-set! v 0 #\\a) appears to clobber it")
+    (lint-test "(let ((v #f)) (define (f81) (display v) '(0 1 2 3)) (set! v (f81)) (list-set! v 0 32))"
+	       " let: perhaps (... (define (f81) (display v) '(0 1 2 3)) (set! v (f81)) (list-set! v 0 32)) ->
+                   (... (set! v (let () (display v) '(0 1 2 3))) (list-set! v 0 32))
+                 f81: returns a list constant: '(0 1 2 3)
+                 let: (set! v (f81)) returns a constant sequence, but (list-set! v 0 32) appears to clobber it"))
+
+  (let-temporarily ((*report-shadowed-variables* #t))
+    (lint-test "(let ((f33 33)) (define f33 4) (g f33 1))"
+	       " let: let variable f33 in (define f33 4) shadows an earlier declaration
+                   let: let variable f33 is redefined in the let body.  Perhaps use set! instead: (set! f33 4)
+                   let: f33 not used, initially: 33 from let")
+    (lint-test "(let ((f33 33)) (define (f33 x) (+ x 4)) (g f33 1))"
+	       " let: let variable f33 in (define (f33 x) (+ x 4)) shadows an earlier declaration
+                 let: let variable f33 is declared twice
+                 let: f33 not used, initially: 33 from let")
+    (lint-test "(let ((f33 33)) (if (g x) (begin (define f33 4) (g f33)) 4))"
+	       " let: perhaps move the let to the true branch:
+                   (let ((f33 33)) (if (g x) (begin (define f33 4) (g f33)) 4)) -> (if (g x) (let ((f33 33)) (define f33 4) (g f33)) 4)
+	         let: begin variable f33 in (define f33 4) shadows an earlier declaration
+                 let: let variable f33 is redefined in the let body.  Perhaps use set! instead: (set! f33 4)
+                 let: f33 not used, initially: 33 from let")
+    ;; check built-in names
+    (lint-test "(define abs 3)" " top-level redefinition of built-in function abs: (define abs 3)")
+    (lint-test "(define* (abs (ab 1)) (+ ab 1))" " top-level redefinition of built-in function abs: (define* (abs (ab 1)) (+ ab 1))")
+    (lint-test "(define (f x abs y) (+ x (- abs y)))" " define: f parameter abs shadows built-in abs")
+    (lint-test "(let ((abs 3)) (f abs))"
+	       " let: let variable abs shadows built-in abs
+                 let: perhaps, assuming f is not a macro, (let ((abs 3)) (f abs)) -> (f 3)")
+    (lint-test "(do ((abs 0 (+ abs 1))) ((= abs 3) 32) (display abs))" " do: do variable abs shadows built-in abs")
+    (lint-test "(let abs ((i 10)) (if (positive? i) (abs (- i 1))))"
+	       " let: let named-let-function-name abs shadows built-in abs
+	         abs: perhaps (let abs ((i 10)) (if (positive? i) (abs (- i 1)))) -> (do ((i 10 (- i 1))) ((not (positive? i))))")
+    (lint-test "(let* abs ((i 10) (j i)) (if (positive? i) (abs (- i j) j)))" " let*: let* named-let*-function-name abs shadows built-in abs")
+    (lint-test "(f (lambda (abs) (+ abs 1)))" " lambda: :lambda parameter abs shadows built-in abs")
+    (lint-test "(map (lambda (abs) (car abs)) lst)"
+	       " map: perhaps (lambda (abs) (car abs)) -> car
+                 lambda: :lambda parameter abs shadows built-in abs")
+    (lint-test "(call-with-exit (lambda (abs) (abs 1)))"
+	       " call-with-exit: call-with-exit exit-function abs shadows built-in abs
+                 call-with-exit: abs is redundant here: (abs 1)")
+    (lint-test "(call/cc (lambda (abs) (abs 1)))"
+	       " call/cc: call/cc continuation abs shadows built-in abs
+                 call/cc: perhaps call/cc could be call-with-exit: (call/cc (lambda (abs) (abs 1)))
+                 call/cc: abs is redundant here: (abs 1)")
+    (lint-test "(call-with-output-file x (lambda (abs) (read abs)))"
+	       " call-with-output-file: call-with-output-file port abs shadows built-in abs
+                 call-with-output-file: perhaps (call-with-output-file x (lambda (abs) (read abs))) -> (call-with-output-file x read)
+                 call-with-output-file: abs is an output-port, but read in (read abs) wants an input-port?"))
+  (lint-test "(call-with-input-file file (lambda (p) (write c p) (write-string str p)))"
+	     " call-with-input-file: p is an input-port, but write-string in (write-string str p) wants an output-port or #f
+               call-with-input-file: p is an input-port, but write in (write c p) wants an output-port or #f")
+  (lint-test "(call-with-input-string str (lambda (p) (write c p) (read p)))"
+	     " call-with-input-string: p is an input-port, but write in (write c p) wants an output-port or #f")
+  (lint-test "(call-with-output-string (lambda (p) (write c p) (read p)))"
+	     " call-with-output-string: p is an output-port, but read in (read p) wants an input-port?")
+  (lint-test "(call-with-output-file file (lambda (p) (read p) (write c p)))"
+	     " call-with-output-file: p is an output-port, but read in (read p) wants an input-port?")
+
+  (let-temporarily ((*report-func-as-arg-arity-mismatch* #t))
+    (lint-test "(let () (define (f43 x) (+ x 1)) (define (f44 y z) (y (+ z 1) abs)) (f44 f43 2))"
+	       " let: perhaps change f44 to a let:
+                  (let () (define (f43 x) (+ x 1)) (define (f44 y z) (y (+ z 1) abs)) (f44... -> (... (let ((y f43) (z 2)) ...))
+                 let: f44's parameter y is passed f43 and called (y (+ z 1) abs), but f43 takes only 1 argument")
+    (lint-test "(let () (define (f45 x) (+ x 1)) (define (f46 y z) (if z (y))) (f46 f45 2))"
+	       " let: perhaps change f46 to a let:
+                  (let () (define (f45 x) (+ x 1)) (define (f46 y z) (if z (y))) (f46 f45 2)) -> (... (let ((y f45) (z 2)) ...))
+                 let: f46's parameter y is passed f45 and called (y), but f45 needs 1 argument")
+    (lint-test "(let () (define (f47 y z) (y (+ z 1) abs)) (f47 abs 2))"
+	       " let: perhaps (... (define (f47 y z) (y (+ z 1) abs)) (f47 abs 2)) -> (... (let ((y abs) (z 2)) (y (+ z 1) abs)))
+                 let: f47's parameter y is passed abs and called (y (+ z 1) abs), but abs takes only 1 argument")
+    (lint-test "(let () (define (f48 y z) (if z (y))) (f48 abs 2))"
+	       " let: perhaps (... (define (f48 y z) (if z (y))) (f48 abs 2)) -> (... (let ((y abs) (z 2)) (if z (y))))
+                 let: f48's parameter y is passed abs and called (y), but abs needs 1 argument")
+    (lint-test "(let () (define (f49 y z) (y (+ z 1))) (f49 (lambda () (+ a 1)) 2))"
+	       " let: perhaps (... (define (f49 y z) (y (+ z 1))) (f49 (lambda () (+ a 1)) 2)) -> (... (let ((y (lambda () (+ a 1))) (z 2)) (y (+ z 1))))
+                 let: f49's parameter y is passed (lambda () (+ a 1)) and called (y (+ z 1)), but (lambda () (+ a 1)) takes only 0 arguments")
+    (lint-test "(let () (define (f50 y z) (y (+ z 1))) (f50 (lambda (a b) (+ a 1)) 2))"
+	       " let: perhaps (... (define (f50 y z) (y (+ z 1))) (f50 (lambda (a b) (+ a 1)) 2)) ->
+                   (... (let ((y (lambda (a b) (+ a 1))) (z 2)) (y (+ z 1))))
+                 let: f50's parameter y is passed (lambda (a b) (+ a 1)) and called (y (+ z 1)), but (lambda (a b) (+ a 1)) needs 2 arguments"))
+
+  (let-temporarily ((*report-boolean-functions-misbehaving* #t))
+    (lint-test "(let () (define (f80? x) (if z (display x) (string-append x y z))) (display x) f80?)"
+	       " let: f80? looks boolean, but it can return (string-append x y z)"))
+
+  (let-temporarily ((*report-nested-if* 3))
+    (lint-test "(if (< x y) (display z) (if (> x y) (+ w 1) (when (= x y) 0)))"
+	       " if: perhaps (if (< x y) (display z) (if (> x y) (+ w 1) (when (= x y) 0))) ->
+                  (cond ((< x y) (display z)) ((> x y) (+ w 1)) (else (when (= x y) 0)))"))
+
+  (lint-test "(let () (define x 2) (display x) (set! y 32) (display y) (* y (log y)))"
+	     " let: perhaps (... (define x 2) (display x) (set! y 32) (display y) (* y (log y))) -> (... (let ((x 2)) ...))
+               let: the scope of x could be reduced: (... (define x 2) (display x) ...) -> (... (let ((x 2)) (display x)) ...)
+               let: perhaps (let () (define x 2) (display x) (set! y 32) (display y) (* y (log y))) -> (let ((x 2)) ...)")
+  (lint-test "(let () (display 32) (define x 2) (define (f101 y) (+ x y)) (display 41) (f101 2))"
+	     " let: perhaps move x into f101's closure: (... (define x 2) (define (f101 y) (+ x y)) ...) ->
+                 (... (define f101 (let ((x 2)) (lambda (y) (+ x y)))) ...)
+               let: (define x 2) occurs in the midst of the body; perhaps use let: (let ((x 2)) (define (f101 y) (+ x y)) (display 41) (f101 2))
+               x is used only in f101")
+  (lint-test "(let () (display 33) (define x 2) (define x (+ x y)) (display 43))"
+	     " let: use set! to redefine x: (... (define x (+ x y)) ...) -> (... (set! x (+ x y)) ...)
+               let: (define x 2) occurs in the midst of the body; perhaps use let: (let ((x 2)) (define x (+ x y)) (display 43))
+               let: let variable x is redefined in the let body.  Perhaps use set! instead: (set! x (+ x y))
+               let: x not used, initially: (+ x y) from define")
+  (lint-test "(let () (display 34) (define x 2) (define f101 (lambda (y) (+ x y))) (display 41) (f101 2))"
+	     " let: perhaps move x into f101's closure: (... (define x 2) (define f101 (lambda (y) (+ x y))) ...) ->
+                 (... (define f101 (let ((x 2)) (lambda (y) (+ x y)))) ...)
+               let: the scope of f101 could be reduced:
+                 (... (define f101 (lambda (y) (+ x y))) (display 41) (f101 2)) ->
+                 (... (let ((f101 (lambda (y) (+ x y)))) (display 41) (f101 2)))
+               let: (define x 2) occurs in the midst of the body; perhaps use let: (let ((x 2)) (define f101 (lambda (y) (+ x y))) (display 41) (f101 2))")
+  (lint-test "(let ((x (read-byte)) (y (read-byte))) (- x y))"
+	     " let: order of evaluation of let's bindings is unspecified, so (let ((x (read-byte)) (y (read-byte))) (- x y)) is trouble
+               let: perhaps (let ((x (read-byte)) (y (read-byte))) (- x y)) -> (- (read-byte) (read-byte))
+               let: in \"(let ((x (read-byte)) (y (read-byte))) (- x y))\", let should be let*")
+  (lint-test "(list (read port) (read-char port))"
+	     " list: order of evaluation of list's arguments is unspecified, so (list (read port) (read-char port)) is trouble")
+  (lint-test "(list (read port) (read-char))" "")
+  (lint-test "(list (set! x 3) (+ x 1))"
+	     " list: order of evaluation of list's arguments is unspecified, so (list (set! x 3) (+ x 1)) is trouble")
+  (lint-test "(list (throw 'oops) 1 2)" "")
+  (lint-test "(list (throw 'oops) 1 (read-byte))"
+	     " list: order of evaluation of list's arguments is unspecified, so (list (throw 'oops) 1 (read-byte)) is trouble")
+  (lint-test "(values (read) (read-char) (read-string 2))"
+	     " values: order of evaluation of values's arguments is unspecified, so (values (read) (read-char) (read-string 2)) is trouble")
+  (lint-test "(letrec ((a (read)) (b (read-char)) (c (read-string 2))) (list a b c))"
+	     " letrec: order of evaluation of letrec's bindings is unspecified, so (letrec ((a (read)) (b (read-char)) (c (read-string 2))) (list a b c)) is trouble
+               letrec: letrec could be let: (letrec ((a (read)) (b (read-char)) (c (read-string 2))) (list a b c))")
+
+  (lint-test "(call-with-input-file caaaar)"
+	     " call-with-input-file: call-with-input-file needs 2 arguments: (call-with-input-file caaaar)
+               call-with-input-file: in (call-with-input-file caaaar), call-with-input-file's argument  should be a string, but caaaar is a procedure?")
+
+  (lint-test "(and (< 0 x) (< x 1))"   " and: perhaps (and (< 0 x) (< x 1)) -> (< 0 x 1)")
+  (lint-test "(and (< 1 x) (< x 1))"   " and: perhaps (and (< 1 x) (< x 1)) -> #f")
+  (lint-test "(and (< 1 x) (< x 0))"   " and: perhaps (and (< 1 x) (< x 0)) -> #f")
+  (lint-test "(and (<= 0 x) (<= x 1))" " and: perhaps (and (<= 0 x) (<= x 1)) -> (<= 0 x 1)")
+  (lint-test "(and (<= 1 x) (<= x 1))" " and: perhaps (and (<= 1 x) (<= x 1)) -> (= 1 x)")
+  (lint-test "(and (<= 1 x) (<= x 0))" " and: perhaps (and (<= 1 x) (<= x 0)) -> #f")
+  (lint-test "(and (< 0 x) (<= x 1))"  "")
+  (lint-test "(and (< 1 x) (<= x 1))"  " and: perhaps (and (< 1 x) (<= x 1)) -> #f")
+  (lint-test "(and (< 1 x) (<= x 0))"  " and: perhaps (and (< 1 x) (<= x 0)) -> #f")
+  (lint-test "(and (<= 0 x) (< x 1))"  "")
+  (lint-test "(and (<= 1 x) (< x 1))"  " and: perhaps (and (<= 1 x) (< x 1)) -> #f")
+  (lint-test "(and (<= 1 x) (< x 0))"  " and: perhaps (and (<= 1 x) (< x 0)) -> #f")
+  (lint-test "(or (< 0 x) (< x 1))"    " or: perhaps (or (< 0 x) (< x 1)) -> #t")
+  (lint-test "(or (< 1 x) (< x 1))"    " or: perhaps (or (< 1 x) (< x 1)) -> (not (= x 1))")
+  (lint-test "(or (< 1 x) (< x 0))"    " or: perhaps (or (< 1 x) (< x 0)) -> (not (>= 1 x 0))")
+  (lint-test "(or (<= 0 x) (<= x 1))"  " or: perhaps (or (<= 0 x) (<= x 1)) -> #t")
+  (lint-test "(or (<= 1 x) (<= x 1))"  " or: perhaps (or (<= 1 x) (<= x 1)) -> #t")
+  (lint-test "(or (<= 1 x) (<= x 0))"  " or: perhaps (or (<= 1 x) (<= x 0)) -> (not (> 1 x 0))")
+  (lint-test "(or (< 0 x) (<= x 1))"   " or: perhaps (or (< 0 x) (<= x 1)) -> #t")
+  (lint-test "(or (< 1 x) (<= x 1))"   " or: perhaps (or (< 1 x) (<= x 1)) -> #t")
+  (lint-test "(or (< 1 x) (<= x 0))"   "")
+  (lint-test "(or (<= 0 x) (< x 1))"   " or: perhaps (or (<= 0 x) (< x 1)) -> #t")
+  (lint-test "(or (<= 1 x) (< x 1))"   " or: perhaps (or (<= 1 x) (< x 1)) -> #t")
+  (lint-test "(or (<= 1 x) (< x 0))"   "")
+  (lint-test "(or (< x 0) (> x 9))"    " or: perhaps (or (< x 0) (> x 9)) -> (not (<= 0 x 9))")
+  (lint-test "(or (> 0 x) (> x 9))"    " or: perhaps (or (> 0 x) (> x 9)) -> (not (<= 0 x 9))")
+  (lint-test "(or (>= 0 x) (>= x 9))"  " or: perhaps (or (>= 0 x) (>= x 9)) -> (not (< 0 x 9))")
+  (lint-test "(or (> x 9) (< x 0))"    " or: perhaps (or (> x 9) (< x 0)) -> (not (>= 9 x 0))")
+  (lint-test "(or (< x 3.0) (> x 3.0))" " or: perhaps (or (< x 3.0) (> x 3.0)) -> (not (= x 3.0))")
+  (lint-test "(or (< x 3.0) (= x 3.0))" " or: perhaps (or (< x 3.0) (= x 3.0)) -> (<= x 3.0) or: = can be troublesome with floats: (= x 3.0)")
+  (lint-test "(and (< 0 x) (> x 0))"   " and: perhaps (and (< 0 x) (> x 0)) -> (< 0 x)")
+  (lint-test "(or (< 0 x) (> x 0))"    " or: perhaps (or (< 0 x) (> x 0)) -> (> x 0)")
+  (lint-test "(and (<= 0 x) (>= x 0))" " and: perhaps (and (<= 0 x) (>= x 0)) -> (<= 0 x)")
+  (lint-test "(or (<= 0 x) (>= x 0))"  " or: perhaps (or (<= 0 x) (>= x 0)) -> (>= x 0)")
+  (lint-test "(and (<= 0 x) (> x 0))"  " and: perhaps (and (<= 0 x) (> x 0)) -> (> x 0)")
+  (lint-test "(or (<= 0 x) (> x 0))"   " or: perhaps (or (<= 0 x) (> x 0)) -> (>= x 0)")
+  (lint-test "(and (< 0 x) (>= x 0))"  " and: perhaps (and (< 0 x) (>= x 0)) -> (> x 0)")
+  (lint-test "(or (< 0 x) (>= x 0))"   " or: perhaps (or (< 0 x) (>= x 0)) -> (>= x 0)")
+  (lint-test "(and (< x 0) (> x 0))"   " and: perhaps (and (< x 0) (> x 0)) -> #f")
+  (lint-test "(or (< x 0) (> x 0))"    " or: perhaps (or (< x 0) (> x 0)) -> (not (= x 0))")
+  (lint-test "(and (<= x 0) (>= x 0))" " and: perhaps (and (<= x 0) (>= x 0)) -> (= x 0)")
+  (lint-test "(or (<= x 0) (>= x 0))"  " or: perhaps (or (<= x 0) (>= x 0)) -> #t")
+  (lint-test "(and (<= x 0) (> x 0))"  " and: perhaps (and (<= x 0) (> x 0)) -> #f")
+  (lint-test "(or (<= x 0) (> x 0))"   " or: perhaps (or (<= x 0) (> x 0)) -> #t")
+  (lint-test "(and (< x 0) (>= x 0))"  " and: perhaps (and (< x 0) (>= x 0)) -> #f")
+  (lint-test "(or (< x 0) (>= x 0))"   " or: perhaps (or (< x 0) (>= x 0)) -> #t")
+
+  (lint-test "(< 0 x 1)"  "")
+  (lint-test "(< 1 x 1)"  " <: it looks odd to have repeated arguments in (< 1 x 1) <: this comparison can't be true: (< 1 x 1) <: perhaps (< 1 x 1) -> #f")
+  (lint-test "(< 1 x 0)"  " <: this comparison can't be true: (< 1 x 0)") ; return #f!
+  (lint-test "(<= 0 x 1)" "")
+  (lint-test "(<= 1 x 1)" " <=: it looks odd to have repeated arguments in (<= 1 x 1) <=: perhaps (<= 1 x 1) -> (= 1 x)")
+  (lint-test "(<= 1 x 0)" " <=: this comparison can't be true: (<= 1 x 0)")
+
+  (lint-test "(if (>= (length x) 1) y z)" " if: perhaps (assuming x is a proper list), (>= (length x) 1) -> (pair? x)")
+;  (lint-test "(if (> (length x) 1) y z)"  " if: perhaps (assuming x is a proper list), (> (length x) 1) -> (and (pair? x) (pair? (cdr x)))")
+  (lint-test "(if (< (length x) 1) y z)"  " if: perhaps (assuming x is a proper list), (< (length x) 1) -> (null? x)")
+  (lint-test "(if (<= (length x) 1) y z)" " if: perhaps (assuming x is a proper list), (<= (length x) 1) -> (or (null? x) (null? (cdr x)))")
+  (lint-test "(if (= (length x) 1) y z)"  " if: perhaps (assuming x is a list), (= (length x) 1) -> (and (pair? x) (null? (cdr x)))")
+  (lint-test "(if (>= (length x) 0) y z)" " if: perhaps (assuming x is a proper list), (>= (length x) 0) -> (list? x)")
+  (lint-test "(if (> (length x) 0) y z)"  " if: perhaps (assuming x is a proper list), (> (length x) 0) -> (pair? x)")
+  (lint-test "(if (< (length x) 0) y z)"  " if: perhaps (< (length x) 0) -> (and (pair? x) (not (proper-list? x)))")
+  (lint-test "(if (<= (length x) 0) y z)" " if: perhaps (assuming x is a proper list), (<= (length x) 0) -> (null? x)")
+  (lint-test "(if (= (length x) 0) y z)"  " if: perhaps (assuming x is a list), (= (length x) 0) -> (null? x)")
+  (lint-test "(if (>= 0 (length x)) y z)" " if: perhaps (assuming x is a proper list), (>= 0 (length x)) -> (null? x)")
+  (lint-test "(if (> 0 (length x)) y z)"  " if: perhaps (> 0 (length x)) -> (and (pair? x) (not (proper-list? x)))")
+  (lint-test "(if (< 0 (length x)) y z)"  " if: perhaps (assuming x is a proper list), (< 0 (length x)) -> (pair? x)")
+  (lint-test "(if (<= 0 (length x)) y z)" " if: perhaps (assuming x is a proper list), (<= 0 (length x)) -> (list? x)")
+  (lint-test "(if (= 0 (length x)) y z)"  " if: perhaps (assuming x is a list), (= 0 (length x)) -> (null? x)")
+  (lint-test "(if (>= 1 (length x)) y z)" " if: perhaps (assuming x is a proper list), (>= 1 (length x)) -> (or (null? x) (null? (cdr x)))")
+  (lint-test "(if (> 1 (length x)) y z)"  " if: perhaps (assuming x is a proper list), (> 1 (length x)) -> (null? x)")
+;  (lint-test "(if (< 1 (length x)) y z)"  " if: perhaps (assuming x is a proper list), (< 1 (length x)) -> (and (pair? x) (pair? (cdr x)))")
+  (lint-test "(if (<= 1 (length x)) y z)" " if: perhaps (assuming x is a proper list), (<= 1 (length x)) -> (pair? x)")
+  (lint-test "(if (= 1 (length x)) y z)"  " if: perhaps (assuming x is a list), (= 1 (length x)) -> (and (pair? x) (null? (cdr x)))")
+  (lint-test "(if (null? x) () (map abs x))" " if: perhaps (if (null? x) () (map abs x)) -> (map abs x)")
+
+  (lint-test "(< (vector-length x) 1)" " <: perhaps (< (vector-length x) 1) -> (equal? x #())")
+  (lint-test "(> 1 (string-length x))" " >: perhaps (> 1 (string-length x)) -> (string=? x \"\")")
+  (lint-test "(zero? (string-length x))" " zero?: perhaps (zero? (string-length x)) -> (string=? x \"\")")
+  (lint-test " (string-length (make-string 3))" " string-length: perhaps (string-length (make-string 3)) -> 3")
+  (lint-test " (vector-length (make-vector 10))" " vector-length: perhaps (vector-length (make-vector 10)) -> 10")
+  (lint-test " (max (log x) :minlog)" " max: in (max (log x) :minlog), max's second argument should be real, but :minlog is a keyword?")
+
+  (lint-test "(member outport (list *stderr* *stdout*))" "") ; not '(*stderr*...)!
+  (lint-test "(define ((foo x) y) (list x y))"
+	     " define: perhaps (define ((foo x) y) (list x y)) -> (define (foo x) (lambda (y) (list x y)))")
+  (lint-test "(let () (define ((foo x) y) (list x y)) (foo 1 2))"
+	     " let: perhaps (define ((foo x) y) (list x y)) -> (define (foo x) (lambda (y) (list x y)))")
+  (lint-test "(define ((foo x) y) (+ (* -1 x) y))"
+	     " define: perhaps (define ((foo x) y) (+ (* -1 x) y)) -> (define (foo x) (lambda (y) (+ (* -1 x) y)))
+               foo: perhaps (+ (* -1 x) y) -> (- y x)")
+
+  ;; this needs work (never #f vars are tricky)
+  (lint-test "(equal? x abs)" " equal?: equal? could be eq? in (equal? x abs)")
+  (lint-test "(equal? x begin)" " equal?: equal? could be eq? in (equal? x begin)")
+  (lint-test "(equal? x lint)" "")
+  (lint-test "(string x #\\xd)" " #\\xd is #\\return")
+
+  (lint-test "(let ((x ())) (set! x (cons 1 x)) (if x 3 2))"
+	     " let: x is never #f, so (if x 3 2) -> 3
+               let: perhaps (let ((x ())) (set! x (cons 1 x)) (if x 3 2)) -> (let ((x (cons 1 ()))) (if x 3 2))")
+  (lint-test "(let ((x ())) (if x 3 2))"
+	     " let: perhaps (let ((x ())) (if x 3 2)) -> (if () 3 2)
+               let: x is never #f, so (if x 3 2) -> 3")
+  (lint-test "(let ((x ())) (if (pair? x) 3 2))" " let: perhaps (let ((x ())) (if (pair? x) 3 2)) -> (if (pair? ()) 3 2)")
+  (lint-test "(let ((x 0)) (if x 3 2))"
+	     " let: perhaps (let ((x 0)) (if x 3 2)) -> (if 0 3 2)
+               let: x is never #f, so (if x 3 2) -> 3")
+  (lint-test "(let ((x 0)) (if (zero? x) 3 2))"
+	     " let: perhaps (let ((x 0)) (if (zero? x) 3 2)) -> (if (zero? 0) 3 2)
+               let: x is 0, so (zero? x) is #t")
+  (lint-test "(let ((x 0)) (set! x ()) (if x 3 2))" " let: perhaps (let ((x 0)) (set! x ()) (if x 3 2)) -> (let ((x ())) (if x 3 2))")
+  (lint-test "(let ((x 0)) (set! x ()) (if (null? x) 3 2))"
+	     " let: perhaps (let ((x 0)) (set! x ()) (if (null? x) 3 2)) -> (let ((x ())) (if (null? x) 3 2))")
+  (lint-test "(let ((x 0)) (display x) (set! x ()) (if (null? x) 3 2))"
+	     " let: perhaps combine these two lines: (set! x ()) (if (null? x) 3 2)")
+  (lint-test "(let ((x 0)) (when x 3))" " let: perhaps (let ((x 0)) (when x 3)) -> (when 0 3) let: x is never #f, so (when x 3) -> 3")
+  (lint-test "(let ((x 0)) (when (zero? x) 3))"
+	     " let: perhaps (let ((x 0)) (when (zero? x) 3)) -> (when (zero? 0) 3)
+               let: x is 0, so (zero? x) is #t")
+  (lint-test "(let ((x 0)) (set! x ()) (unless x 3))"  " let: perhaps (let ((x 0)) (set! x ()) (unless x 3)) -> (let ((x ())) (unless x 3))")
+
+  (lint-test "(let ((x 0)) (cond (x 3) (else 4)))" " let: perhaps (let ((x 0)) (cond (x 3) (else 4))) -> (cond (0 3) (else 4))")
+  (lint-test "(let ((x 0)) (cond ((zero? x) 3) (else 4)))" " let: x is 0, so (zero? x) is #t")
+  (lint-test "(let ((x 0)) (set! x ()) (cond (x 3) (else 4)))"
+	     " let: perhaps (let ((x 0)) (set! x ()) (cond (x 3) (else 4))) -> (let ((x ())) (cond (x 3) (else 4)))")
+
+  (lint-test "(let ((x 0)) (case x ((0) 3) (else 4)))" " let: perhaps (case x ((0) 3) (else 4)) -> (if (eqv? x 0) 3 4)")
+  (lint-test "(let ((x 0)) (do ((i x (+ i 1))) ((= i 0))))"
+	     " let: this do-loop could probably be replaced by the end test in a let: (do ((i x (+ i 1))) ((= i 0)))
+               let: perhaps (let ((x 0)) (do ((i x (+ i 1))) ((= i 0)))) -> (do ((i 0 (+ i 1))) ...)")
+
+  (lint-test "(let ((x 32)) (display x) (set! y (f x)) (g (+ x 1) y) (a y) (f y) (g y) (h y) (i y) (set! x 3) (display x) (h y x))"
+	     " let: perhaps add a new binding for x to replace (set! x 3):
+                 (let ((x 32)) (display x) (set! y (f x)) (g (+ x 1) y) (a y) (f y) (g y)... ->
+                 (let ... (let ((x 3)) ...))")
+  (lint-test "(let ((x 32)) (set! y (f 1)) (a y) (f y) (g y) (h y) (i y) (set! x (+ x 1)) (display x) (h y x))"
+	     " let: perhaps move the x binding to replace (set! x (+ x 1)):
+                 (let ((x 32)) (set! y (f 1)) (a y) (f y) (g y) (h y) (i y) (set! x (+ x... ->
+                 (let () ... (let ((x (+ 32 1))) ...))")
+
+  (lint-test "(let loop ((x y)) (if (null? x) () (cons (car x) (loop (cdr x)))))"
+	     " loop: perhaps (let loop ((x y)) (if (null? x) () (cons (car x) (loop (cdr x))))) -> (copy y)")
+  (lint-test "(let loop ((x y)) (if (null? x) () (cons (string (car x)) (loop (cdr x)))))"
+	     " loop: perhaps (let loop ((x y)) (if (null? x) () (cons (string (car x)) (loop (cdr x))))) -> (map string y)")
+  (lint-test "(let loop ((x y)) (cond ((null? x) ()) (else (cons (abs (car x)) (loop (cdr x))))))"
+	     " loop: perhaps (let loop ((x y)) (cond ((null? x) ()) (else (cons (abs (car x)) (loop... -> (map abs y)")
+  (lint-test "(let loop ((x y)) (when (pair? x) (display (car x)) (loop (cdr x))))"
+	     " loop: perhaps (let loop ((x y)) (when (pair? x) (display (car x)) (loop (cdr x)))) -> (for-each display y)")
+  (lint-test "(let loop ((x y)) (unless (null? x) (display (car x)) (loop (cdr x))))"
+	     " loop: perhaps (let loop ((x y)) (unless (null? x) (display (car x)) (loop (cdr x)))) -> (for-each display y)")
+  (lint-test "(let loop ((x y)) (case x ((0 1) x) (else (loop (+ x 1)))))"
+	     " loop: perhaps (let loop ((x y)) (case x ((0 1) x) (else (loop (+ x 1))))) -> (do ((x y (+ x 1))) ((memv x '(0 1)) x))
+               let: perhaps (case x ((0 1) x) (else (loop (+ x 1)))) -> (if (memv x '(0 1)) x (loop (+ x 1)))
+               let: in ((0 1) x), the result can be omitted")
+
+  (lint-test "(if (or (eq? x abs) (eq? x case) (eq? x null?)) 3 2)" "")
+  (lint-test "(cond ((eq? x begin) 1) ((eq? x reader-cond) 2) ((eq? x lint) 3))" "")
+  (lint-test "(cond ((eq? x 'begin) 1) ((eq? x 'reader-cond) 2) ((eq? x 'lint) 3))"
+	     " cond: perhaps use case instead of cond:
+               (cond ((eq? x 'begin) 1) ((eq? x 'reader-cond) 2) ((eq? x 'lint) 3)) -> (case x ((begin) 1) ((reader-cond) 2) ((lint) 3))")
+
+  (lint-test "(let ((x (getenv \"HOME\"))) (if x (display x)))"
+	     " let: perhaps (let ((x (getenv \"HOME\"))) (if x (display x))) -> (cond ((getenv \"HOME\") => display))")
+
+  (lint-test "(and-let* ((x (f y))) (abs x))" " and-let*: perhaps (and-let* ((x (f y))) (abs x)) -> (cond ((f y) => abs))")
+  (lint-test "(let () (define* (f51 (a 3)) (if (zero? a) 3 (f51 (- a 1)))) (f51 -1))"
+	     " let: perhaps (... (define* (f51 (a 3)) (if (zero? a) 3 (f51 (- a 1)))) (f51 -1)) ->
+                 (... (let* f51 ((a -1)) (if (zero? a) 3 (f51 (- a 1)))))
+               f51: perhaps (define* (f51 (a 3)) (if (zero? a) 3 (f51 (- a 1)))) -> (define* (f51 (a 3)) (do ((a a (- a 1))) ((zero? a) 3)))")
+  (lint-test "(let () (define* (f51 (a 3) b) (if (zero? a) 3 (f51 (- a 1)))) (f51 -1))"
+	     " let: perhaps (... (define* (f51 (a 3) b) (if (zero? a) 3 (f51 (- a 1)))) (f51 -1)) ->
+                 (... (let* f51 ((a -1) (b #f)) (if (zero? a) 3 (f51 (- a 1)))))")
+  (lint-test "(let () (define* (f51 (a 3) (b 32)) (if (zero? a) 3 (f51 (- a 1)))) (f51 -1))"
+	     " let: perhaps (... (define* (f51 (a 3) (b 32)) (if (zero? a) 3 (f51 (- a 1)))) (f51 -1)) ->
+                 (... (let* f51 ((a -1) (b 32)) (if (zero? a) 3 (f51 (- a 1)))))")
+  (lint-test "(let () (lambda (a b) (+ a (* 2 b))))" " let: pointless let: (let () (lambda (a b) (+ a (* 2 b))))")
+  (lint-test "(let () (define (f x) x) (do ((i 0 (+ i 1))) ((= i 10)) (f i)))"
+	     " let: this do-loop could probably be replaced by the end test in a let: (do ((i 0 (+ i 1))) ((= i 10)) (f i))
+               let: this could be omitted: (f i)
+               let: perhaps (do ((i 0 (+ i 1))) ((= i 10)) (f i)) -> (do ((i 0 (+ i 1))) ((= i 10)) i)")
+  (lint-test "(let () (define (f x) (abs (* 2 x))) (do ((i 0 (+ i 1))) ((= i 10)) (f i)))"
+	     " let: this do-loop could probably be replaced by the end test in a let: (do ((i 0 (+ i 1))) ((= i 10)) (f i))
+               let: this could be omitted: (f i)
+               let: perhaps (do ((i 0 (+ i 1))) ((= i 10)) (f i)) -> (do ((i 0 (+ i 1))) ((= i 10)) (abs (* 2 i)))")
+
+  (lint-test "(let () (define (f202 x) (x 1 2)) (f202 (lambda (a b) a)) (f202 (lambda (a b) (+ a 1))))"
+	     " let: f202 parameter x is a function whose parameter 2 is never used")
+  (lint-test "(let () (define (f202 x) (x 1 2)) (f202 (lambda (a b) a)) (f202 (lambda (c d) (+ c 1))))"
+	     " let: f202 parameter x is a function whose parameter 2 is never used")
+  (lint-test "(let () (define (f202 x) (x 1 2)) (f202 (lambda (a b) a)) (f202 (lambda (c d) (+ d 1))))" "")
+  (lint-test "(let () (define (f201 x) (g (f x))) (f201 1) (f201 1) (f201 1))" " let: f201's 'x parameter is always 1 (3 calls)")
+
+  (lint-test "(string->symbol (let ((s (copy vstr))) (set! (s (+ pos 1)) #\\s) s))"
+	     " string->symbol: perhaps
+                (string->symbol (let ((s (copy vstr))) (set! (s (+ pos 1)) #\\s) s)) ->
+                (let ((s (copy vstr))) (set! (s (+ pos 1)) #\\s) (string->symbol s))")
+
+  (lint-test "(apply env-channel
+                (make-env :envelope '(0 0 1 1)
+                          :length (if (and (> (length args) 1) (number? (cadr args))) (cadr args)
+                                      (framples (if (> (length args) 2) (caddr args) (selected-sound))))) args)"
+	     " apply: perhaps (apply env-channel (make-env ...) args) ->
+                 (let ((<1> (make-env ...))) (apply env-channel <1> args))")
+  (let-temporarily ((*report-bloated-arg* 50))
+    (lint-test "(apply env-channel
+                  (make-env :envelope '(0 0 1 1)
+                            :length (if (and (> (length args) 1) (number? (cadr args))) (cadr args)
+                                        (framples (if (> (length args) 2) (caddr args) (selected-sound))))) args)" ""))
+
+  (lint-test "(let ((x 1)) (and x (< x 1)))"
+	     " in (and x (< x 1)), perhaps change x to (real? x)
+               let: x is an integer, so (and x (< x 1)) -> (< x 1)")
+  (lint-test "(let ((x 1)) (and (< x 1) x))" "") ; this is correct -- we want to return x so the trailing x is not redundant
+  (lint-test "(let ((x 1)) (and x (< x 1) x))"
+	     " in (and x (< x 1)), perhaps change x to (real? x)
+               let: x is an integer, so (and x (< x 1) x) -> (and (< x 1) x)")
+  (lint-test "(let ((x 1)) (not x))" " let: perhaps (let ((x 1)) (not x)) -> (not 1) let: x is an integer, so (not x) -> #f")
+  (lint-test "(gensym 'ok)" " gensym: in (gensym 'ok), gensym's argument should be a string, but 'ok is a symbol?")
+  (lint-test "(string-ref 'ok 0)"
+	     " string-ref: in (string-ref 'ok 0), string-ref's first argument should be a string, but 'ok is a symbol?
+               string-ref: (string-ref 'ok 0): string-ref first argument, ok, is a symbol but should be a string")
+  (lint-test "(+ 2 #X11)" " reader: unknown # object: #X11 use #x11 not #X11 +: perhaps (+ 2 17) -> 19")
+
+  (lint-test "(let ((l 1)) (+ l 1))" " let: perhaps (let ((l 1)) (+ l 1)) -> (+ 1 1) let: \"l\" is a really bad variable name")
+  (lint-test "(let ((let 1)) (+ let 1))" " let: perhaps (let ((let 1)) (+ let 1)) -> (+ 1 1) let: let variable named let is asking for trouble")
+  (lint-test "(define (f12 l) (log (abs l)))" " f12: \"l\" is a really bad variable name")
+  (let-temporarily ((*report-bad-variable-names* '(info data)))
+    (lint-test "(let ((data 1)) (+ data 32))"
+	       " let: perhaps (let ((data 1)) (+ data 32)) -> (+ 1 32)
+                 let: surely there's a better name for this variable than data")
+    (lint-test "(let ((info1 32) (info-1 31)) (+ info1 info-1))"
+	       " let: perhaps (let ((info1 32) (info-1 31)) (+ info1 info-1)) -> (+ 32 31)
+                 let: surely there's a better name for this variable than info-1
+                 let: surely there's a better name for this variable than info1")
+    (lint-test "(let ((compute-x 32)) (+ compute-x x))"
+	       " let: perhaps (let ((compute-x 32)) (+ compute-x x)) -> (+ 32 x)
+                 let: surely there's a better name for this variable than compute-x"))
+  (lint-test "(set! else #f)" " set!: bad idea: (set! else #f)")
+  (lint-test "(define (f12 else) (log (abs else)))" " f12: surely there's a better name for this variable than else")
+  (lint-test "(define (f12 => else) (+ => else))"
+	     " f12: leaving aside +'s optional args, f12 could be (define f12 +)
+               f12: surely there's a better name for this variable than else")
+  (lint-test "(let ((else #f)) (or 3 else))"
+	     " let: perhaps, ignoring short-circuit issues, (let ((else #f)) (or 3 else)) -> (or 3 #f)
+               let: perhaps (or 3 else) -> 3
+               let: surely there's a better name for this variable than else")
+  (lint-test "(define else 32)" " define: redefinition of else is a bad idea: (define else 32)")
+
+  (let-temporarily ((*report-built-in-functions-used-as-variables* #t))
+    (lint-test "(let ((list 3)) (display list))"
+	       " let: perhaps (let ((list 3)) (display list)) -> (display 3)
+                 let: let variable named list is asking for trouble")
+    (lint-test "(let ((cond 3)) (display cond))"
+	       " let: perhaps (let ((cond 3)) (display cond)) -> (display 3)
+                 let: let variable named cond is asking for trouble")
+    (lint-test "(let () (define (f50 abs) (abs -1)) (f50 positive?))"
+	       " let: perhaps (... (define (f50 abs) (abs -1)) (f50 positive?)) -> (... (let ((abs positive?)) (abs -1)))
+                 let: f50's parameter abs is called (abs -1) : find a less confusing parameter name!
+                 f50: f50 parameter named abs is asking for trouble")
+    (lint-test "(let () (define (f50 abs) (positive? abs)) (f50 -1))"
+	       " let: perhaps (... (define (f50 abs) (positive? abs)) (f50 -1)) -> (... (let ((abs -1)) (positive? abs)))
+                 f50: f50 could be (define f50 positive?)
+                 f50: f50 parameter named abs is asking for trouble")
+    (lint-test "(let append ((x y)) (if (null? x) () (append (cdr y))))"
+	       " append: perhaps (let append ((x y)) (if (null? x) () (append (cdr y)))) -> (do ((x y (cdr y))) ((null? x) ()))
+                 let: let variable named append is asking for trouble")
+    (lint-test "(let () (define (f list) (+ list 1)) (f list))"
+	       " let: perhaps (... (define (f list) (+ list 1)) (f list)) -> (... (let ((list list)) (+ list 1)))
+               f: f parameter named list is asking for trouble
+               let: in (f list), f's argument should be a number, but list is a procedure?"))
+
+  (lint-test "(error 'error \"ERROR SOMEWHERE UP TO HERE\")" " error: There's no need to shout: (error 'error \"ERROR SOMEWHERE UP TO HERE\")")
+  (lint-test "(display \"ERROR: oops\" port)" " display: There's no need to shout: (display \"ERROR: oops\" port)")
+  (lint-test "(throw 'oops \"throw: ~A~%\" x)" "")
+  (lint-test "(throw 'oops \"throw: ~A~%\" x y)" " throw: throw has too many arguments: (throw 'oops \"throw: ~A~%\" x y)")
+  (lint-test "(error 'oops \"error: ~A ~A~%\" x)" " error: error has too few arguments: (error 'oops \"error: ~A ~A~%\" x)")
+  (lint-test "(catch #f (lambda () 1) (lambda args 2))" " catch: catch tag #f makes this catch a no-op")
+
+  (lint-test "(define (f75) \"a string\")" " f75: returns a string constant: \"a string\"")
+  (lint-test "(define (f75) #i(0 1 2 3))"   " f75: returns an int-vector constant: #i(0 1 2 3)")
+  (lint-test "(define (f75) '(0 1 2 3))"   " f75: returns a list constant: '(0 1 2 3)")
+  (lint-test "(define (f75 x) (if x '(0 1 2 3) (+ x 1)))" " f75: returns a list constant: '(0 1 2 3)")
+
+  (lint-test "(define (f73 x) (let ((result 0)) (if (positive? x) (set! result 32) (set! result -1))))"
+	     " f73: perhaps (if (positive? x) (set! result 32) (set! result -1)) -> (set! result (if (positive? x) 32 -1))
+               f73: result set, but not used: (set! result -1) (set! result 32)")
+  (lint-test "(do ((res 0 (+ res 1))) ((= res 3)) (set! res (+ res 32)))"
+	     " do: perhaps move (set! res (+ res 32)) to res's step expression: (res 0 (+ 33 res))")
+  (lint-test "(begin (define res 0) (set! res (+ res 32)))" "")
+  (lint-test "(cond ((string=? x \"a\") 1) ((string=? \"b\" x) 2)((string=? x \"c\") 3) ((string=? \"a\" x) 4))"
+	     " cond: cond test (string=? \"a\" x) is never true: (cond ((string=? x \"a\") 1) ((string=? \"b\" x) 2) ((string=? x \"c\") 3)...
+               cond: cond test is always false: ((string=? \"a\" x) 4)
+               cond: perhaps (cond ((string=? x \"a\") 1) ((string=? \"b\" x) 2) ((string=? x \"c\") 3)... ->
+              (cond ((string=? x \"a\") 1) ((string=? \"b\" x) 2) ((string=? x \"c\") 3))")
+  (lint-test "(cond ((string=? x \"a\") 1) ((string=? \"b\" x) 2)((string=? x \"c\") 3) ((string=? x \"a\") 4))"
+	     " cond: cond test (string=? x \"a\") is never true: (cond ((string=? x \"a\") 1) ((string=? \"b\" x) 2) ((string=? x \"c\") 3)...
+               cond: cond test repeated: ((string=? x \"a\") 4)
+               cond: cond test is always false: ((string=? x \"a\") 4)
+               cond: perhaps (cond ((string=? x \"a\") 1) ((string=? \"b\" x) 2) ((string=? x \"c\") 3)... ->
+              (cond ((string=? x \"a\") 1) ((string=? \"b\" x) 2) ((string=? x \"c\") 3))")
+  (lint-test "(cond ((< x 3) 1) ((> 2 x) 2) ((< x 1) 3))" "")
+  (let-temporarily ((*report-unused-parameters* #t))
+    (lint-test "(define (f74 x) (let ((lst (list 1 2 3 4 5 6 7 8))) (list-ref lst 2)))"
+	       " f74: perhaps (list-ref lst 2) -> (caddr lst)
+                 f74: lst can be moved to f74's closure
+                 f74: x not used")
+    (lint-test "(let () (define (f75 x) (let ((lst (list 1 2 3 4 5 6 7 8))) (list-ref lst 2))) (f75 2))"
+	       " let: perhaps (... (define (f75 x) (let ((lst (list 1 2 3 4 5 6 7 8))) (list-ref lst... ->
+                   (... (let ((x 2)) (let ((lst (list 1 2 3 4 5 6 7 8))) (list-ref lst 2))))
+                 f75: perhaps (list-ref lst 2) -> (caddr lst)
+                 f75: lst can be moved to f75's closure
+                 f75: x not used
+                 let: f75's parameter 1 is not used, but a value is passed: 2"))
+
+  (let-temporarily ((*report-loaded-files* #t))
+    (call-with-output-file "tmp1.r5rs"
+      (lambda (p)
+	(format p "(define (f x) (and (< x 3) (> x 0)))~%")))
+    (lint-test "(load \"tmp1.r5rs\")" " --------------------- ;tmp1.r5rs f: perhaps (and (< x 3) (> x 0)) -> (< 0 x 3)"))
+
+  (lint-test "(or (< x 3) (> 3 x))" " or: perhaps (or (< x 3) (> 3 x)) -> (< x 3)")
+  (lint-test "(and (< x 3) (> 3 x))" " and: perhaps (and (< x 3) (> 3 x)) -> (< x 3)")
+  (lint-test "(case x ((1) (f 1)) ((2) (f 2)) (else (f 3)))"
+	     " case: perhaps (case x ((1) (f 1)) ((2) (f 2)) (else (f 3))) -> (f (case x ((1) 1) ((2) 2) (else 3)))
+               case: perhaps use => here: (case x ((1) (f 1)) ((2) (f 2)) (else (f 3))) -> (case x ((1 2) => f) ...)")
+  (lint-test "(case x ((1) (f 1)) ((2) (f 2)) (else (error 'oops)))"
+	     " case: perhaps (case x ((1) (f 1)) ((2) (f 2)) (else (error 'oops))) -> (f (case x ((1) 1) ((2) 2) (else (error 'oops))))
+               case: perhaps use => here: (case x ((1) (f 1)) ((2) (f 2)) (else (error 'oops))) -> (case x ((1 2) => f) ...)")
+  (lint-test "(cond ((< x a) (f 1)) ((< x b) (f 2)) (else (f 3)))"
+	     " cond: perhaps (cond ((< x a) (f 1)) ((< x b) (f 2)) (else (f 3))) -> (f (cond ((< x a) 1) ((< x b) 2) (else 3)))")
+  (let-temporarily ((*report-sloppy-assoc* #t))
+    (lint-test "(- (cond ((char-position c dline id-pos)) (else 0)) 1)"
+               " -: in (- (cond ((char-position c dline id-pos)) (else 0)) 1), -'s first argument should be a number, but (char-position c dline id-pos) might also be #f
+                 -: perhaps (cond ((char-position c dline id-pos)) (else 0)) -> (or (char-position c dline id-pos) 0)"))
+  (lint-test "(begin (cond ((find-sound v) => close-sound)) (display x))" "") ; check for side-effect confusion
+
+  (lint-test "(let ((p (open-output-file str))) (display 32 p) x)"
+	     " let: in (let ((p (open-output-file str))) (display 32 p) x) perhaps p is opened via (open-output-file str), but never closed")
+  (lint-test "(let ((p #f)) (if x (set! p (open-output-file str))) (display 32 p) x)"
+	     " let: in (let ((p #f)) (if x (set! p (open-output-file str))) (display 32 p) x)
+                 perhaps p is opened via (set! p (open-output-file str)), but never closed")
+
+  (lint-test "(define (listtail x k) (if (zero? k) x (listtail (cdr x) (- k 1))))"
+	     " listtail: perhaps (define (listtail x k) (if (zero? k) x (listtail (cdr x) (- k 1)))) ->
+                 (define (listtail x k) (do ((x x (cdr x)) (k k (- k 1))) ((zero? k) x)))
+               listtail: listtail is the same as the built-in function list-tail")
+  ;; too tricky!  (lint-test "(define (mdi) (define reader1 (lambda* (quit) (reader1))))" "")
+
+  (lint-test "(truncate (/ x y))"               " truncate: perhaps (truncate (/ x y)) -> (quotient x y)")
+  (lint-test "(- x (* y (quotient x y)))"       "-: perhaps (- x (* y (quotient x y))) -> (remainder x y)")
+  (lint-test "(- x (* (quotient x y) y))"       "-: perhaps (- x (* (quotient x y) y)) -> (remainder x y)")
+  (lint-test "(cdr '(a))"                       " cdr: perhaps (cdr '(a)) -> ()")
+  (lint-test "(char-upcase #\\a)"               " char-upcase: perhaps (char-upcase #\\a) -> #\\A")
+  (lint-test "(char-upper-case? #\\a)"          " char-upper-case?: perhaps (char-upper-case? #\\a) -> #f")
+  (lint-test "(load \"\")"                      " load: load needs a real file name, not the empty string: (load \"\")")
+  (lint-test "(load)"                           " load: load needs at least 1 argument: (load)")
+  (lint-test "(write-byte 300)"
+	     " write-byte: in (write-byte 300), write-byte's argument should be a byte, but 300 is an integer?
+               write-byte: write-byte argument must be (<= 0 byte 255): (write-byte 300)")
+  (lint-test "(write-byte 95 (current-output-port))"
+	     " write-byte: (current-output-port) is the default port for write-byte: (write-byte 95 (current-output-port))")
+  (lint-test "(peek-char (current-input-port))"
+             "peek-char: (current-input-port) is the default port for peek-char: (peek-char (current-input-port))")
+  (lint-test "(write-char #\\newline)"          " write-char: perhaps (write-char #\\newline) -> (newline)")
+  (lint-test "(write-char #\\newline port)"     " write-char: perhaps (write-char #\\newline port) -> (newline port)")
+  (lint-test "(write-string \"\n\")"            " write-string: perhaps (write-string \"\n\") -> (newline)")
+  (lint-test "(write-string \"\")"              " write-string: (write-string \"\") is pointless")
+  (lint-test "(char? #\\a)"                     " char?: perhaps (char? #\\a) -> #t")
+  (lint-test "(symbol->string (keyword->symbol :hi))" " symbol->string: perhaps (keyword->symbol :hi) -> 'hi")
+  (lint-test "(string->keyword (string-append \":\" z))" " string->keyword: string->keyword prepends #\\: for you: (string->keyword (string-append \":\" z))")
+  (lint-test "(string->keyword (symbol->string sym))" " string->keyword: perhaps (string->keyword (symbol->string sym)) -> (symbol->keyword sym)")
+  (lint-test "(keyword->symbol (string->keyword str))" " keyword->symbol: perhaps (keyword->symbol (string->keyword str)) -> (string->symbol str)")
+  (lint-test "(symbol->keyword (string->symbol str))" " symbol->keyword: perhaps (symbol->keyword (string->symbol str)) -> (string->keyword str)")
+  (lint-test "(keyword->symbol :hi)"            " keyword->symbol: perhaps (keyword->symbol :hi) -> 'hi")
+  (lint-test "(symbol->keyword 'hiho)"          " symbol->keyword: perhaps (symbol->keyword 'hiho) -> :hiho")
+  (lint-test "(positive? 1.0)"                  " positive?: perhaps (positive? 1.0) -> #t")
+  (lint-test "(list? 'a)"                       " list?: perhaps (list? 'a) -> #f")
+  (lint-test "(pair? 'a)"                       " pair?: perhaps (pair? 'a) -> #f")
+  (lint-test "(proper-list? '(this - that))"    " proper-list?: perhaps (proper-list? '(this - that)) -> #t")
+  (lint-test "(symbol? 'let)"                   " symbol?: perhaps (symbol? 'let) -> #t")
+  (lint-test "(keyword? :rest)"                 " keyword?: perhaps (keyword? :rest) -> #t")
+  (lint-test "(char? 'a)"                       " char?: perhaps (char? 'a) -> #f")
+  (lint-test "(lcm 3/4 2)"                      " lcm: perhaps (lcm 3/4 2) -> 6")
+  (lint-test "(string->list \"12345\" 2 1)"     " string->list: these string->list indices make no sense: (string->list \"12345\" 2 1)")
+  (lint-test "(list->vector '(1 2 3))"          " list->vector: perhaps (list->vector '(1 2 3)) -> #(1 2 3)")
+  (lint-test "(port-filename *stdout*)"         " port-filename: (port-filename *stdout*): \"*stdout*\"")
+  (lint-test "(call-with-input-string \"(+ 1 2 3)\" (lambda () (*s7* 'version)))"
+	     " call-with-input-string: call-with-input-string argument should be a function of one argument: (lambda () (*s7* 'version))")
+  (lint-test "(call-with-input-file tmp-output-file (lambda () (*s7* 'version)))"
+	     " call-with-input-file: call-with-input-file argument should be a function of one argument: (lambda () (*s7* 'version))")
+  (lint-test "(vector? vector?)"                " vector?: perhaps (vector? vector?) -> #f")
+  (lint-test "(vector? begin)"                  " vector?: perhaps (vector? begin) -> #f")
+  (lint-test "(procedure? apply)"               " procedure?: perhaps (procedure? apply) -> #t")
+  (lint-test "(dilambda? quasiquote)"           " dilambda?: perhaps (dilambda? quasiquote) -> #f")
+  (lint-test "(number? most-negative-fixnum)"   " number?: perhaps (number? most-negative-fixnum) -> #t")
+  (lint-test "(complex? pi)"                    " complex?: perhaps (complex? pi) -> #t")
+  (lint-test "(vector-ref #(hi) 0)"             " vector-ref: perhaps (vector-ref #(hi) 0) -> 'hi")
+  (lint-test "(hash-table 'a 3 'b)"             " hash-table: key with no value? (hash-table 'a 3 'b)")
+  (lint-test "(hash-table 'a 1 'b 2 'a 3)"      " hash-table: repeated key a in (hash-table 'a 1 'b 2 'a 3)")
+  (lint-test "(hash-table :a 1 'b 2 'a 3)"      " hash-table: repeated key a in (hash-table :a 1 'b 2 'a 3)")
+  (lint-test "(inlet 'a 1 'b 2 'a 3)"           " inlet: repeated key a in (inlet 'a 1 'b 2 'a 3)")
+  (lint-test "(inlet 'a 1 'b)"                  "inlet: no value for last entry 'b in (inlet 'a 1 'b)")
+  ;(lint-test "(sublet (curlet) 'a 1 'b 2 'a 3)" " sublet: repeated key a in (sublet (curlet) 'a 1 'b 2 'a 3)")
+  (lint-test "(sublet (curlet) 'a 1)"           "")
+  (lint-test "(sublet 'a 1)"
+	     " sublet: in (sublet 'a 1), sublet's first argument should be a let or null, but 'a is a symbol?
+               sublet: in (sublet 'a 1), sublet's second argument should be a pair or a symbol, but 1 is an integer?")
+  (lint-test "(close-output-port (current-output-port))"
+	     " close-output-port: (current-output-port) is the default port for close-output-port: (close-output-port (current-output-port))")
+  (lint-test "(string-ref \"\" 0)"              " string-ref: (string-ref \"\" 0) is an error")
+  (lint-test "(string-ref \"abc\" -1)"          " string-ref: (string-ref \"abc\" -1): string-ref second argument, -1, is out of range (it is negative)")
+  (lint-test "(vector-ref #() 0)"               " vector-ref: (vector-ref #() 0) is an error")
+  (lint-test "(string-ref \"abc\" 1)"           " string-ref: perhaps (string-ref \"abc\" 1) -> #\\b")
+  (lint-test "    (dilambda 1 2)"
+	     " dilambda: in (dilambda 1 2), dilambda's first argument should be a procedure, but 1 is an integer?
+               dilambda: in (dilambda 1 2), dilambda's second argument should be a procedure, but 2 is an integer?")
+  (lint-test "(let ((v (float-vector 1 2 3))) (vector-set! v 0 12) v)" " let: v is a float-vector, so perhaps use float-vector-set!, not vector-set!")
+  (lint-test "(let ((v (int-vector 1 2 3))) (+ (vector-ref v 1) (int-vector-ref v 0)))" " let: v is an int-vector, so perhaps use int-vector-ref, not vector-ref")
+  (lint-test "(let ((v (vector 1 2 3))) (float-vector-set! v 0 12) v)" " let: v is a vector, so use vector-set!, not float-vector-set!")
+  (lint-test "(nth 1 lst)"  " nth: perhaps (nth 1 lst) -> (list-ref lst 1)")
+  (lint-test "(sort lst <)" " sort: perhaps (sort lst <) -> (sort! (copy lst) <)")
+  (lint-test "(sort (map car lst) (lambda (a b) (< (car a) (car b))))" " sort: use sort! here: (sort (map car lst) (lambda (a b) (< (car a) (car b))))")
+  (lint-test "(display x (newline))"
+	     " display: in (display x (newline)), display's second argument should be an output-port or #f, but (newline) is a char?")
+  (lint-test "(let ((p (open-input-string str))) (display x))"
+	     " let: in (let ((p (open-input-string str))) (display x)) perhaps p is opened via (open-input-string str), but never closed
+               let: p not used, initially: (open-input-string str) from let")
+  (lint-test "(let ((p (open-output-string))) (display x))"
+	     " let: in (let ((p (open-output-string))) (display x)) perhaps p is opened via (open-output-string), but never closed
+               let: p not used, initially: (open-output-string) from let")
+  (lint-test "(let ((p (open-input-string str))) (display x) (close-output-port p))"
+	     " let: in (let ((p (open-input-string str))) (display x) (close-output-port p)) p is opened and closed, but never used
+               let: p is an input-port, but close-output-port in (close-output-port p) wants an output-port or #f")
+  (lint-test "(let ((p (open-output-string))) (display x) (close-input-port p))"
+	     " let: in (let ((p (open-output-string))) (display x) (close-input-port p)) p is opened and closed, but never used
+               let: p is an output-port, but close-input-port in (close-input-port p) wants an input-port?")
+  (lint-test "(let ((p (open-output-string))) (display x) (close-output-port p))"
+	     " let: in (let ((p (open-output-string))) (display x) (close-output-port p)) p is opened and closed, but never used")
+  (lint-test "(let ((p (open-input-string str))) (display x) (close-input-port p))"
+	     " let: in (let ((p (open-input-string str))) (display x) (close-input-port p)) p is opened and closed, but never used")
+  (lint-test "(let ((p (open-output-string))) (display val p) (close-output-port p))"
+	     " p: (let ((p (open-output-string))) (display val p) (close-output-port p)) is missing get-output-string")
+  (lint-test "(let ((p (open-output-string))) (display val p) (fos val (close-output-port p)))"
+	     " p: (let ((p (open-output-string))) (display val p) (fos val... is missing get-output-string")
+  (lint-test "(let ((s (open-output-string))) (write obj s) (let ((result (get-output-string s))) (close-output-port s) result))"
+	     " s: perhaps (let ((s (open-output-string))) (write obj s) (let ((result... -> (object->string obj)")
+  (lint-test "(let ((x '(1 2 3))) (display (car x)) (display (list-ref x y)) (list-ref x 1))" " let: x could be a vector, rather than a list")
+  (lint-test "(let ((x '(1 2 3))) (display (car x)) (display (x y)) (x 1))" " let: x could be a vector, rather than a list")
+  (lint-test "(display 123 #f)" " display: (display 123 #f) could be 123")
+  (lint-test "(write 123 #f)"   " write: (write 123 #f) could be 123")
+  (lint-test "(newline #f)"     " newline: (newline #f) is a no-op, returning #<unspecified>")
+  (unless with-bignums (lint-test "(define (func x) (if (or x 1/0+i) 3))" " func: perhaps (or x +nan.0+1.0i) -> (or x +nan.0+1.0i)")) ; infinite loop
+  (lint-test "(if (and x 1/0) 3)" " if: perhaps (and x +nan.0) -> (and x +nan.0)")
+  (lint-test "(cond ((number? x) 4) ((integer? x) 3) ((list? x) 0) ((pair? x) 1))"
+	     " cond: (number? x) makes (integer? x) pointless in (cond ((number? x) 4) ((integer? x) 3) ((list? x) 0) ((pair? x) 1))
+               cond: (list? x) makes (pair? x) pointless in (cond ((number? x) 4) ((integer? x) 3) ((list? x) 0) ((pair? x) 1))
+                  (r5rs list? is proper-list? in s7)")
+  (lint-test "(cond-expand (s7 (define (f x) (* x 23))) (else))" "")
+  (lint-test "(cond-expand (s7))" " cond-expand: pointless cond-expand: (cond-expand (s7))")
+  (lint-test "(cond-expand ((or s7 guile)))"  " cond-expand: pointless cond-expand: (cond-expand ((or s7 guile)))")
+  (lint-test "(macroexpand (abs x))" " macroexpand: macroexpand's argument should be an expression whose car is a macro: (macroexpand (abs x))")
+  (lint-test "(macroexpand macroexpand)" " macroexpand: macroexpand's argument should be an expression whose car is a macro: (macroexpand macroexpand)")
+  (lint-test "(let () (define-macro (f1 x) `(g ,x ,x)) (macroexpand (f1 a)))" "")
+  (lint-test "(let ((fv (float-vector 1.0 2.0))) (equal? fv X))"
+	     " let: perhaps (let ((fv (float-vector 1.0 2.0))) (equal? fv X)) -> (equal? (float-vector 1.0 2.0) X)
+               let: perhaps use equivalent? in (equal? fv X)")
+  (lint-test "(let ((fv (float-vector 1.0 2.0)) (iv (int-vector 1 2))) (equal? fv iv))"
+	     " let: perhaps (let ((fv (float-vector 1.0 2.0)) (iv (int-vector 1 2))) (equal? fv iv)) -> (equal? (float-vector 1.0 2.0) (int-vector 1 2))
+               let: perhaps use equivalent? in (equal? fv iv)")
+  (lint-test "(begin (let loop ((x y)) (if (null? x) 1 (loop (cdr x)))) x)"
+	     " begin: this could be omitted: (let loop ((x y)) (if (null? x) 1 (loop (cdr x))))
+               loop: perhaps (let loop ((x y)) (if (null? x) 1 (loop (cdr x)))) -> (do ((x y (cdr x))) ((null? x) 1))")
+  (lint-test "(begin (do ((x y (cdr x))) ((null? x) 1)) x)"
+	     " begin: this could be omitted: (do ((x y (cdr x))) ((null? x) 1))
+               begin: this do-loop could be replaced by 1: (do ((x y (cdr x))) ((null? x) 1))")
+  (lint-test "(begin (do ((x y (cdr x)) (i 0 ( i 1)) (j 1 (+ j i))) ((null? x) 1)) j)"
+	     " begin: (do ((x y (cdr x)) (i 0 (i 1)) (j 1 (+ j i))) ((null? x) 1)): result 1 is not used
+               begin: perhaps (do ((x y (cdr x)) (i 0 (i 1)) (j 1 (+ j i))) ((null? x) 1)) ->
+                 (do ((x y (cdr x)) (i 0 (i 1)) (j 1)) ((null? x) 1) (set! j (+ j i)))
+               begin: j set, but not used: 1 from do")
+  (lint-test "(begin (define (f300 x) (if (null? x) 0 (f300 (cdr x)))) (display x) (f300 '(1)) x)"
+	     " f300: perhaps (define (f300 x) (if (null? x) 0 (f300 (cdr x)))) -> (define (f300 x) (do ((x x (cdr x))) ((null? x) 0)))")
+  (lint-test "(let ((is-running? (f x))) (g is-running? 0))"
+	     " let: perhaps (let ((is-running? (f x))) (g is-running? 0)) -> (g (f x) 0)
+               let: 'is-running? is redundant: perhaps use 'running?")
+
+  (lint-test "(begin (for-each f (list x y)) (values))" " begin: (values) is redundant; for-each returns #<unspecified>")
+  (lint-test "(begin (map f x) #t)"
+	     " begin: map could be for-each: (for-each f x)
+               begin: #t is probably redundant; map can't return #f")
+  (lint-test "(begin (set! y (map f x)) #t)"  " begin: #t is probably redundant; map can't return #f")
+
+  (lint-test "(cond (A =>) (else B))"          " cond: cond => target is messed up: (A =>)")
+  (lint-test "(case x ((A) =>) (else B))"      " case: perhaps (case x ((A) =>) (else B)) -> (if (eq? x 'A) => B) case: case => target is messed up: ((A) =>)")
+  (lint-test "(do ((i 0 (+ i 1))) (i =>))"
+	     " do: do-result => target is messed up: (i =>)
+	       do: do is a no-op because i is true at the start: (do ((i 0 (+ i 1))) (i =>))")
+  (lint-test "(cond (A => . B) (else B))"      " cond: cond => target is messed up: (A => . B)")
+  (lint-test "(case x ((A) => . B) (else B))"  " case: case => target is messed up: ((A) => . B)")
+  (lint-test "(do ((i 0 (+ i 1))) (i => . B))" " do: do is messed up: (do ((i 0 (+ i 1))) (i => . B))")
+
+  (when (provided? 'snd)
+    (lint-test "(begin (cond ((find-sound \"test.snd\") => close-sound)) (display x))" "")
+    (lint-test "(if (real? (oscil x)) 1.0 0.0)" " if: perhaps (real? (oscil x)) -> #t  if: perhaps (if (real? (oscil x)) 1.0 0.0) -> 1.0")
+    (lint-test "(if (pair? (oscil x)) 1.0 0.0)" " if: perhaps (pair? (oscil x)) -> #f  if: perhaps (if (pair? (oscil x)) 1.0 0.0) -> 0.0")
+    (lint-test "(if (float? (oscil x)) 1.0 0.0)" " if: perhaps (float? (oscil x)) -> #t if: perhaps (if (float? (oscil x)) 1.0 0.0) -> 1.0")
+    (lint-test "(radians->hz 3.4+i)" " radians->hz: in (radians->hz 3.4+1.0i), radians->hz's argument should be real, but 3.4+1.0i is complex?")
+    (lint-test "(string-ref (radians->hz x) 3)"
+	       " string-ref: in (string-ref (radians->hz x) 3), string-ref's first argument should be a string, but (radians->hz x) is a float?")
+    (lint-test "(set! (print-length) \"asd\")" " set!: print-length: new value should be an integer?: string?: (set! (print-length) \"asd\")")
+    (lint-test "(set! (print-length) 9)" "")
+    (lint-test "(set! (show-indices) 32)" " set!: show-indices: new value should be a boolean?: integer?: (set! (show-indices) 32)")
+    (lint-test "(set! (show-indices) #t)" "")
+    (lint-test "(mus-header-type-name 121)" " mus-header-type-name: mus-header-type-name's argument, 121, should be an integer between 1 and 70")
+    (lint-test "(mus-header-type-name 2)" "")
+    (lint-test "(mus-header-type-name 3.5)" " mus-header-type-name: in (mus-header-type-name 3.5), mus-header-type-name's argument should be an integer, but 3.5 is a float?")
+    (lint-test "(mus-header-type-name mus-aiff)" ""))
+
+  ;; lint regression tests
+  (lint-test "(define (func x) (if (*  (call/cc (lambda (go) (go 9) 0))  '((1 (2)) (((3) 4)))  1(/  )) (iterator-sequence 1-)))"
+             " func: if test is never false: (if (* (call/cc (lambda (go) (go 9) 0)) '((1 (2)) (((3) 4))) 1 (/))...
+               func: in (* (call/cc (lambda (go) (go 9) 0)) '((1 (2)) (((3) 4))) 1 (/)),
+                 *'s second argument should be a number, but '((1 (2)) (((3) 4))) is a list?
+               func: perhaps (* (call/cc (lambda (go) (go 9) 0)) '((1 (2)) (((3) 4))) 1 (/)) -> (* (call/cc (lambda (go) (go 9) 0)) '((1 (2)) (((3) 4))))
+               func: perhaps call/cc could be call-with-exit: (call/cc (lambda (go) (go 9) 0))
+               func: (go 9) makes this pointless: 0
+               func: / needs at least 1 argument: (/)")
+  (lint-test "(define (func x) (if (string-position -) (begin . 0) (hash-table //(round))))"
+	     " func: string-position needs at least 2 arguments: (string-position -)
+               func: in (string-position -), string-position's argument should be a string, but - is a procedure?
+               func: stray dot in begin? (begin . 0)
+               func: round needs 1 argument: (round)")
+  (lint-test "(define (func x) (if (string->symbol) (cond . 3/4)))"
+	     " func: if test is never false: (if (string->symbol) (cond . 3/4))
+               func: string->symbol needs 1 argument: (string->symbol)
+               func: cond is messed up: (cond . 3/4)")
+  (lint-test "(define (func x) (if (expt 2) (cond 0 1/1.2 when . and)))"
+	     " func: if test is never false: (if (expt 2) (cond 0 1/1.2 when . and))
+               func: expt needs 2 arguments: (expt 2)
+               func: cond is messed up: (cond 0 1/1.2 when . and)")
+  (lint-test "(define (func x) (if (imag-part (define-macro  `(((+ x 1))) '((x . 1) . 2) 1.2.3)) (cond (list 1 2) `(1) . =>)))"
+	     " func: if test is never false: (if (imag-part (define-macro '(((+ x 1))) '((x . 1) . 2) 1.2.3)) (cond...
+               #_quote: strange parameter for define-macro: (((+ x 1)))
+               func: cond is messed up: (cond (list 1 2) '(1) . =>)")
+  (unless pure-s7
+    (lint-test "(define (func x) (if (inexact->exact /i-) (defined? +--) (cond . else)))"
+	       " func: if test is never false: (if (inexact->exact /i-) (defined? +--) (cond . else))
+               func: cond is messed up: (cond . else)"))
+  (lint-test "(define (func x) (if (let-set! /+0) (begin .(cdddar . and)) (port-line-number 2(exp 1))))"
+	     " func: let-set! needs 3 arguments: (let-set! /+0)
+               func: stray dot in begin? (begin cdddar . and)
+               func: in (port-line-number 2 (exp 1)), port-line-number's first argument should be an input-port, but 2 is an integer?")
+  (unless with-bignums
+    (lint-test "(define (func x) (if (char<? (vector (defined?))) (define-constant +(random-state->list -)) (hash-table? (define-macro* + (list ()) `(x 1) :hi 1+0/0i))))"
+	       " func: char<? needs at least 2 arguments: (char<? (vector (defined?)))
+                 func: in (char<? (vector (defined?))), char<?'s argument should be a char, but (vector (defined?)) is a vector?
+                 func: defined? needs at least 1 argument: (defined?)
+                 +: in (random-state->list -), random-state->list's argument should be a random-state, but - is a procedure?
+                 func: + in (define-macro* + (list ()) '(x 1) :hi 1.0+nan.0i) is already a constant, defined (random-state->list -)
+                 func: (define-macro* + (list ()) '(x 1) :hi 1.0+nan.0i) is messed up
+                 func: + not used, initially: (random-state->list -) from define-constant")
+    (lint-test "(define (func x) (if (or . 1+0/0i) (caaddr (caaadr /)))) (define (hi) (func (make-hook '(0 0 #f))))"
+	     " func: unexpected dot: (or . 1.0+nan.0i)
+               func: in (caaadr /), caaadr's argument should be a pair, but / is a procedure?
+               hi: func's parameter 1 is not used, but a value is passed: (make-hook '(0 0 #f))")
+    (lint-test "(define (func x) (when 0 1+0/0i `((+ x 1)) => . with-let))" " func: when is messed up: (when 0 1.0+nan.0i '((+ x 1)) => . with-let)")
+    (lint-test "(define (func x) (if (ceiling (denominator)) (with-let .0+) (cdaadr (floor (random 0/0+0i +inf.0)))))"
+	     " func: if test is never false: (if (ceiling (denominator)) (with-let .0+) (cdaadr (floor (random +nan.0...
+               func: denominator needs 1 argument: (denominator)
+               func: with-let is messed up: (with-let .0+)
+               func: in (cdaadr (floor (random +nan.0 +inf.0))), cdaadr's argument should be a pair, but (floor (random +nan.0 +inf.0)) is an integer?
+               func: in (random +nan.0 +inf.0), random's second argument should be a random-state, but +inf.0 is a float?")
+    (lint-test "(define (func x) (if (begin 2(caaar 2)) (make-list (unless +)) (char-upper-case? 0i2 0+1/0i
+                 `(((x 1))) (cons 1 2) (string (or / (let ((x 3)) (lambda (y) (+ x y))) . =>)))))"
+	       " func: this could be omitted: 2
+                 func: in (caaar 2), caaar's argument should be a pair, but 2 is an integer?
+                 func: unless is messed up: (unless +)
+                 func: char-upper-case? has too many arguments: (char-upper-case? 0i2 0.0+nan.0i '(((x 1))) (cons 1 2) (string (or / (let...
+                 func: missing quote? (or / (let ((x 3)) (lambda (y) (+ x y))) . =>) in (string (or / (let ((x 3)) (lambda (y) (+ x y))) . =>))
+                 func: unexpected dot: (or / (let ((x 3)) (lambda (y) (+ x y))) . =>)")
+    (lint-test "(define (func x) (if (arity (apply +)) (caaadr /) (begin .. when `((x . 1)) . 0/0+0/0i)))"
+	       " func: perhaps (apply +) -> (+)
+                 func: in (caaadr /), caaadr's argument should be a pair, but / is a procedure?
+                 func: stray dot in begin? (begin .. when (list-values (<list*> (list-values 'x) 1)) . +nan.0+nan.0i)"))
+
+  (lint-test "(define (func x) (if (even? (asinh .0)) (when (real?))))"
+	     " func: perhaps (if (even? (asinh 0.0)) (when (real?))) -> (when (and (even? (asinh 0.0)) (real?)))
+               func: in (even? (asinh 0.0)), even?'s argument should be an integer, but (asinh 0.0) is a number?
+               func: perhaps (asinh 0.0) -> 0.0
+               func: when is messed up: (when (real?))")
+  (lint-test "(define (func x) (if (boolean?) (unless /)))"
+	     " func: perhaps (if (boolean?) (unless /)) -> (when (and (boolean?) (not /)))
+               func: boolean? needs 1 argument: (boolean?)
+               func: unless is messed up: (unless /)")
+  (lint-test "(define (func x) (cond ((output-port? i) (char-numeric? /i(denominator))) (else (if +/ 1 . #f))))"
+	     " func: char-numeric? has too many arguments: (char-numeric? /i (denominator))
+               func: denominator needs 1 argument: (denominator)
+               func: if has too few clauses: (if +/ 1 . #f)")
+  (lint-test "(define (func x) (do . unless))"  " func: do is messed up: (do . unless)")
+  (lint-test "(define (func x) (lambda* (lambda args args) . -1))"  " func: lambda* is messed up in (lambda* (lambda args args) . -1)")
+  (lint-test "(define (func x) (if (or . set!) (sublet 2)))"
+	     " func: unexpected dot: (or . set!)
+               func: in (sublet 2), sublet's argument should be a let or null, but 2 is an integer?")
+  (lint-test "(define (func x) (case x ((else) (char>? 11/(setter))) ((-1) (load - -1 3/4)) (else (positive? (format 0(inlet (make-list)))))))"
+	     " func: in (char>? 11/ (setter)),  char>?'s second argument should be a char, but (setter) is #f or a procedure?
+               func: setter needs at least 1 argument: (setter)
+               func: load has too many arguments: (load - -1 3/4)
+               func: in (load - -1 3/4), load's first argument should be a string, but - is a procedure?
+               func: in (load - -1 3/4), load's second argument should be a let, but -1 is an integer?
+               func: perhaps (- -1 3/4) -> -7/4
+               func: in (positive? (format 0 (inlet (make-list)))), positive?'s argument should be real, but (format 0 (inlet (make-list))) is a string?
+               func: in (format 0 (inlet (make-list))), format's first argument should be an output-port or a boolean, but 0 is an integer?
+               func: make-list needs at least 1 argument: (make-list)")
+  (lint-test "(zero? (system str))" "")
+  (lint-test "(define (func x) (if (- 2(+)) (lambda 1.)))"
+	     " func: if test is never false: (if (- 2 (+)) (lambda 1.0))
+               func: perhaps (- 2 (+)) -> 2
+               func: lambda is messed up in (lambda 1.0)")
+  (unless (or pure-s7 with-bignums)
+    (lint-test "(define (func x) (if (string-ci>=?) (dilambda? (char-numeric? 20+)) (* 1 enver quasiquote 0+0/0i /0/01(/))))"
+	       " func: string-ci>=? needs at least 2 arguments: (string-ci>=?)
+               func: (dilambda? (char-numeric? 20+)) is always #f
+               func: perhaps (* 1 enver quasiquote 0.0+nan.0i /0/01 (/)) -> (* enver quasiquote 0.0+nan.0i /0/01)
+               func: / needs at least 1 argument: (/)"))
+  (lint-test "(define (func x) (if (continuation?) (when (continuation? 0-2))))"
+	     " func: perhaps (if (continuation?) (when (continuation? 0-2))) -> (when (and (continuation?) (continuation? 0-2)))
+               func: continuation? needs 1 argument: (continuation?)
+               func: when is messed up: (when (continuation? 0-2))")
+  (lint-test "(define (func x) (if (close-input-port) (caaddr /) (with-input-from-file 0(let (make-dilambda (lambda () 1) (lambda (a) a)) (set! i01+)))))"
+	     " func: if test is never false: (if (close-input-port) (caaddr /) (with-input-from-file 0 (let...
+               func: close-input-port needs 1 argument: (close-input-port)
+               func: in (caaddr /), caaddr's argument should be a pair, but / is a procedure?
+               func: in (with-input-from-file 0 (let (make-dilambda (lambda () 1) (lambda (a) a))...,
+                   with-input-from-file's first argument should be a string, but 0 is an integer?
+               func: let is messed up: (let (make-dilambda (lambda () 1) (lambda (a) a)) (set! i01+))")
+  (lint-test "(define (func x) (cond ((byte-vector-ref) (iterator? 12.)) (else (unless .+2 '((x 1) y . 2) 1 - or case quote . __asdf__))))"
+	     " func: cond test (byte-vector-ref) is never false: (cond ((byte-vector-ref) (iterator? 12.0)) (else (unless .+2 '((x 1) y ....
+               func: byte-vector-ref needs at least 2 arguments: (byte-vector-ref)
+               func: unless is messed up: (unless .+2 '((x 1) y . 2) 1 - or case quote . __asdf__)")
+  (lint-test "(define (func x) (lambda* .(lcm . do)))" " func: lambda* is messed up in (lambda* lcm . do)")
+  (lint-test "(define (func x) (let . `(((x 1))) ))" "func: let is messed up: (let #_quote (((x 1))))")
+  (lint-test "(define (func x) (do . 1))" " func: do is messed up: (do . 1)")
+  (lint-test "(define (func x) (unless 1 (let ((x 3)) (lambda (y) (+ x y))) let* `(+ x 1) . \"\"))"
+	     " func: unless is messed up: (unless 1 (let ((x 3)) (lambda (y) (+ x y))) let* '(+ x 1) . \"\")")
+  (lint-test "(define (func x) (when `((x)) when '((())) and . case))" "func: when is messed up: (when '((x)) when '((())) and . case)")
+  (lint-test "(define (func x) (do . 0)) (define (hi) (func (define-macro (_m1_ a) `(+ ,a 1)))) (hi)"
+	     " func: do is messed up: (do . 0)
+               hi: func's parameter 1 is not used, but a value is passed: (define-macro (_m1_ a) (list-values '+ a 1))
+               hi: perhaps (define-macro (_m1_ a) (list-values '+ a 1)) -> (define (_m1_ a) (+ a 1))")
+  (lint-test "(define (func x) (unless .(atan . __asdf__)))" " func: unless is messed up: (unless atan . __asdf__)")
+  (lint-test "(define (func x) (floor (* +.(inexact->exact))))" " func: inexact->exact needs 1 argument: (inexact->exact)")
+  (lint-test "(define (func x) (if (proper-list? ) (and / when '((())) () begin) (call-with-input-string (stacktrace +0 -1 1 20100))))"
+	     " func: proper-list? needs 1 argument: (proper-list?)
+               func: call-with-input-string needs 2 arguments: (call-with-input-string (stacktrace 0 -1 1 20100))")
+  (lint-test "(define (func x) (if (lambda*  +i  . begin  ) (symbol->value i-/)))" " func: lambda* is messed up in (lambda* +i . begin)")
+  (lint-test "(define (func x) (let . '((()))  ))" "func: let is messed up: (let #_quote ((())))")
+  (lint-test "(define (func x) (if (defined? +) (when (string=?  +))))"
+	     " func: perhaps (if (defined? +) (when (string=? +))) -> (when (and (defined? +) (string=? +)))
+               func: in (defined? +), defined?'s argument should be a symbol, but + is a procedure?
+               func: when is messed up: (when (string=? +))")
+  (unless pure-s7
+    (lint-test "(define (func x) (if (asinh /(inexact?  1)) (cos (string-ci>? 1)) (int-vector 1(set! .--(cond .(char-alphabetic? .+))))))"
+	     " func: if test is never false: (if (asinh / (inexact? 1)) (cos (string-ci>? 1)) (int-vector 1 (set! .--...
+               func: asinh has too many arguments: (asinh / (inexact? 1))
+               func: in (asinh / (inexact? 1)), asinh's first argument should be a number, but / is a procedure?
+               func: in (cos (string-ci>? 1)), cos's argument should be a number, but (string-ci>? 1) is a boolean?
+               func: string-ci>? needs at least 2 arguments: (string-ci>? 1)
+               func: in (string-ci>? 1), string-ci>?'s argument should be a string, but 1 is an integer?
+               func: cond is messed up: (cond char-alphabetic? .+)"))
+  (lint-test "(define (func x) (if (help 11) (make-iterator (letrec* 2)) (byte-vector (case -(dilambda i let +i (list (list 1)) let . cons  )))))"
+	     " func: perhaps (help 11) -> #f
+               func: perhaps (if (help 11) (make-iterator (letrec* 2)) (byte-vector (case - (dilambda i... ->
+               (byte-vector (case - (dilambda i let +i (list (list 1)) let . cons)))
+               func: in (make-iterator (letrec* 2)), make-iterator's argument should be a sequence, but 2 is an integer?
+               func: letrec* is messed up: (letrec* 2)
+               func: bad case key dilambda in (dilambda i let +i (list (list 1)) let . cons)
+               func: stray dot? (i let +i (list (list 1)) let . cons)")
+  (lint-test "(cddr (cddar :hi))"
+	     " cddr: :hi can't be a pair
+               cddr: in (cddar :hi), cddar's argument should be a pair, but :hi is a keyword?")
+
+  (lint-test "(subvector v 0)" " subvector: perhaps (subvector v 0) -> (subvector v)")
+  (lint-test "(subvector v 0 (length v))" " subvector: perhaps (subvector v 0 (length v)) -> (subvector v)")
+  (lint-test "(subvector v 0 6 '(6))" " subvector: perhaps (subvector v 0 6 '(6)) -> (subvector v 0 6)")
+  (lint-test "(subvector v 1 5 '(4))" " subvector: perhaps (subvector v 1 5 '(4)) -> (subvector v 1 5)")
+
+  ;; this tickles an infinite recursion bug that is still in lint, but hacked around for now
+  (lint-test "(let* ((seed 0)
+                     (hashfn (lambda (obj)
+                               (cond  ((string? obj) (let ((sl (string-length obj))) (+ (if (> sl 0) (hashfn obj) seed) (if (> sl 1) (hashfn obj) seed))))
+                                      ((else #f))))))
+               (modulo (hashfn obj) size))"
+	     " let*: perhaps restrict seed which is not used in the let* body
+                 (let* ((seed 0) (hashfn (lambda (obj) (cond ((string? obj) (let ((sl... ->
+                  (let ((hashfn (let ((seed 0))
+                      (lambda (obj)
+                        (cond ((string? obj)
+                                 (let ((sl (string-length obj)))
+                                   (+ (if (> sl 0) (hashfn obj) seed) (if (> sl 1) (hashfn obj) seed))))
+                              ((else #f))))))) ...)")
+  (let-temporarily ((*report-combinable-lets* #f))
+    (lint-test "(define (f) (let ((div 0)) (do ((i 0 (+ i 1))) ((= i div)) (display i))))" ""))
+  (lint-test "(define (f scheme-name i len) (do () ((>= i len)) (let ((c (string-ref scheme-name i))) (if (alphanumeric? c) (display c)))))" "")
+  (lint-test "(let ((sv (subvector v 0 0))) (vector-ref sv 1))"
+	     "let: perhaps (let ((sv (subvector v 0 0))) (vector-ref sv 1)) -> (vector-ref (subvector v 0 0) 1)")
+  (lint-test "(let ((iter (make-iterator '(1 2 3)))) (iterator-at-end? iter))"
+	     "let: perhaps (let ((iter (make-iterator '(1 2 3)))) (iterator-at-end? iter)) -> (iterator-at-end? (make-iterator '(1 2 3)))")
+
+; TODO:
+;  (lint-test "(and (string? x) (= (length x) 0))" "")  ; " and: perhaps (assuming x is a list), (= (length x) 0) -> (null? x) which is ridiculous
+;  (lint-test "(and (vector? x) (zero? (length x)))" "") ; same as above, should be -> (equal? x #())
+;  (lint-test "(and (list? x) (= 0 (length x)))" "") ; same as above (so the parenthetical remark is ridiculous)
+;  (lint-test "(and (list? x) (> (length x) 0))" "") ;  " and: perhaps (assuming x is a proper list), (> (length x) 0) -> (pair? x)
+;  (lint-test "(or (list? x) (> (length x) 0))" "") ; " or: perhaps (assuming x is a proper list), (> (length x) 0) -> (pair? x)
+;  (lint-test "(if (integer? x) (rational? x))" "") ; -> (or (integer? x) #<unspecified>)??
+
+#|
+  ;; these are currently special cases
+  (lint-test "(pair? (cons 1 2))" "")
+  (lint-test "(number? (cons x y))" "")
+  (lint-test "(not (cons x y))" "")
+|#
+
+  (lint-test "(not (and (file-exists? x) (directory? x)))" " not: perhaps (not (and (file-exists? x) (directory? x))) -> (not (directory? x))")
+  (lint-test "(and (openlet? x) (defined? 'y x))" "")
+  (lint-test "(or (= x y) (not (= x y 0)))" "") ; -> #t? (either x=y(incl 0) or x!=y)
+  (lint-test "(and (= x1 x2) (or (not (= y1 y2)) (= y1 y2 0)))" "")
+  (lint-test "(or (float? x) (not (real? x)))" "")
+  (lint-test "(or (real? x) (not (float? x)))" " or: perhaps (or (real? x) (not (float? x))) -> #t")
+
+  (let ()
+    (define (glint str1)
+      (let ((result (call-with-output-string
+		     (lambda (op)
+		       (call-with-input-string str1
+			 (lambda (ip)
+			   (lint ip op)))))))
+	(if (string=? result "")
+	    (format *stderr* ";(glint ~S) -> ~S~%" str1 result))))
+    (glint "(define (func x) (if (string-position -) (begin . 0) (hash-table //(round))))")
+    (glint "(define (func x) (if (* (call/cc (lambda (go) (go 9) 0)) '((1 (2)) (((3) 4))) 1(/)) (iterator-sequence 1-)))")
+    (glint "(define (func x) (if (string->symbol) (cond . 3/4)))")
+    (glint "(define (func x) (if (expt 2) (cond 0 1/1.2 when . and)))")
+    (glint "(define (func x) (if (imag-part (define-macro `(((+ x 1))) '((x . 1) . 2) 1.2.3)) (cond (list 1 2) `(1) . =>)))")
+    (glint "(define (func x) (if (inexact->exact /i-) (defined? +--) (cond . else)))")
+    (glint "(define (func x) (if (let-set! /+0) (begin .(cdddar . and)) (port-line-number 2(exp 1))))")
+    (glint "(define (func x) (if (char<? (vector (defined?))) (define-constant +(random-state->list -)) (hash-table? (define-macro* + (list ()) `(x 1) :hi 1+0/0i))))")
+    (glint "(define (func x) (if (arity (apply +)) (caaadr /) (begin .. when `((x . 1)) . 0/0+0/0i)))")
+    (glint "(define (func x) (if (even? (asinh .0)) (when (real?))))")
+    (glint "(define (func x) (if (boolean?) (unless /)))")
+    (glint "(define (func x) (cond ((output-port? i) (char-numeric? /i(denominator))) (else (if +/ 1 . #f))))")
+    (glint "(define (func x) (do . unless))")
+    (glint "(define (func x) (lambda* (lambda args args) . -1))")
+    (glint "(define (func x) (if (or . set!) (sublet 2)))")
+    (glint "(define (func x) (if (or . 1+0/0i) (caaddr (caaadr /)))) (define (hi) (func (make-hook '(0 0 #f))))")
+    (glint "(define (func x) (case x ((else) (char>? 11/(setter))) ((-1) (load - -1 3/4)) (else (positive? (format 0(inlet (make-list)))))))")
+    (glint "(define (func x) (if (- 2(+)) (lambda 1.)))")
+    (glint "(define (func x) (when 0 1+0/0i `((+ x 1)) => . with-let))")
+    (glint "(define (func x) (if (string-ci>=?) (dilambda? (char-numeric? 20+)) (* 1 enver quasiquote 0+0/0i /0/01(/))))")
+    (glint "(define (func x) (if (continuation?) (when (continuation? 0-2))))")
+    (glint "(define (func x) (if (close-input-port) (caaddr /) (with-input-from-file 0(let (make-dilambda (lambda () 1) (lambda (a) a)) (set! i01+)))))")
+    (glint "(define (func x) (cond ((byte-vector-ref) (iterator? 12.)) (else (unless .+2 '((x 1) y . 2) 1 - or case quote . __asdf__))))")
+    (glint "(define (func x) (lambda* .(lcm . do)))")
+    (glint "(define (func x) (let . `(((x 1)))))")
+    (glint "(define (func x) (do . 1))")
+    (glint "(define (func x) (unless 1 (let ((x 3)) (lambda (y) (+ x y))) let* `(+ x 1) . \"\"))")
+    (glint "(define (func x) (when `((x)) when '((())) and . case))")
+    (glint "(define (func x) (do . 0)) (define (hi) (func (define-macro (_m1_ a) `(+ ,a 1)))) (hi)")
+    (glint "(define (func x) (unless .(atan . __asdf__)))")
+    (glint "(define (func x) (floor (* +.(inexact->exact))))")
+    (glint "(define (func x) (if (proper-list?) (and / when '((())) () begin) (call-with-input-string (stacktrace +0 -1 1 20100))))")
+    (glint "(define (func x) (if (ceiling (denominator)) (with-let .0+) (cdaadr (floor (random 0/0+0i +inf.0)))))")
+    (glint "(define (func x) (if (begin 2(caaar 2)) (make-list (unless +))
+        (char-upper-case? 0i2 0+1/0i `(((x 1))) (cons 1 2) (string (or / (let ((x 3)) (lambda (y) (+ x y))) . =>)))))")
+    (glint "(define (func x) (if (lambda* +i . begin) (symbol->value i-/)))")
+    (glint "(define (func x) (let . '((()))))")
+    (glint "(define (func x) (if (defined? +) (when (string=? +))))")
+    (glint "(define (func x) (if (asinh /(inexact? 1)) (cos (string-ci>? 1)) (int-vector 1(set! .--(cond .(char-alphabetic? .+))))))")
+    (glint "(define (func x) (if (help 11) (make-iterator (letrec* 2)) (byte-vector (case -(dilambda i let +i (list (list 1)) let . cons)))))")
+    (glint "(define (func x) (cond ((log) (*s7* (quote))) (else (string-ci>? 01(* (numerator (memq 1i(proper-list? (cdr 1)))))))))")
+    (glint "(define (func x) (define* pi))")
+    (glint "(define (func x) (if (char=? 2) (string->number (string>=? 21 1/1.2 -1)) (hash-table? /+(assoc 2i(list . or)))))")
+    (glint "(define (func x) (if (random-state->list (list (list 1)) set! do (list (list 1 2)))
+        (define-macro +(defmacro* 21)) (substring 1+02(getenv 0(write () . defmacro*)))))")
+    (glint "(define (func x) (if (char-downcase) (float-vector-set! (setter))
+        (signature -(do `((1)) (string #\\a #\\null #\\b) i+ \"hi\" (do define-bacro* -(length))))))")
+    (glint "(define (func x) (if (apply -+) (floor ii.) (eval (string->symbol \"\" 1.2.3 i))))")
+    (glint "(define (func x) (if (string>=? 0i) (number->string 2(real? 1)) (/ +2(logand))))")
+    (glint "(define (func x) (case x ((define-macro) (list? 01)) ((`((+ x 1))) (/ 2 -1)) (else (char-downcase +00+(eval)))))")
+    (glint "(define (func x) (cond ((byte-vector-set! 1) (multiple-value-bind -0 (values) 2)) (else (car 1+ `(x) '((x 1) (y) . 2) +nan.0))))")
+    (glint "(define (func x) (case x ((define*) (current-input-port .1+)) (((values #\\c 3 1.2))
+         (symbol .2/)) (else (documentation 2-2i(char=? (+ (reverse (list-tail (reverse /)))))))))")
+    (glint "(define (func x) (if (values i-(caaaar)) (cdaddr ++) (assv +(list (quote 2)))))")
+    (glint "(define (func x) (/ 0(/ 0 (let-temporarily))))")
+    (glint "(define (func x) (cond ((when 1/1.2 #2d((1 2) (3 4)) /1) (openlet (caadar 0))) (else (let*-values (string-ci=? 0-(min //))))))")
+    (glint "(define (func x) (cond ((let* 'hi (let)) (make-rectangular +)) (else (cutlet 002 define-bacro #<unspecified> i(list-ref '((x 1) 2) macroexpand #t)))))")
+    (glint "(if x (int-vector-set! z 0 1) (begin .1 (let ((x 3)) (lambda (y) (+ x y))) . #t))")
+    (glint "(define (func x) (if (real?) (string-ci<=? 0 1/0+i 1.5 '(1 2 . 3) '(- 1) '((x 1) (y) . 2) (values #\\c 3 1.2) 0) (string-ci>=? . macroexpand)))")
+    (glint "(define (func x) (if (call-with-input-file (string #\\a #\\null #\\b) '((x 1 . 2) . 3) -1 (>= /)) (let . +inf.0) (let ..(let? 0(cddr (procedure?))))))")
+    (glint "(define (func x) (if (caadar 2) (make-list i)))")
+    (glint "(define (func x) (cond ((for-each `(x) `(((+ x 1))) 3/4 2) (cddadr 02)) (else (let / :hi (lambda args args) define-bacro))))")
+    (glint "(define (func x) (if (cyclic-sequences .i/) (string-set! i) (proper-list? -
+        (getenv 0 +nan.0 (values) '((1 (2)) (((3) 4))) 'hi (symbol->keyword (cond . '((x 1) y . 2)))))))")
+    (glint "(define (func x) (case x ((#t) (dynamic-wind -1-)) (((values \"hi\")) (input-port? +/)) (else (or +i (memq define-macro '((x 1) y . 2))))))")
+    (glint "(define (func x) (if (and -(not)) (input-port? .i abs +inf.0 define-macro*) (quote 0///i.)))")
+    (glint "(define (func x) (let* '((x 1) (y) . 2) (let* 0)))")
+    (glint "(define (func x) (char-ci>? (inexact->exact (/ 1 3/4))))")
+    (glint "(define (func x) (cond ((number?) (1- #t lambda* '(- 1) let* i(let-values))) (else (cdaaar -(char? (append `((x)) `((set! x (+ x 1)) (* x 2)) (cons)))))))")
+    (glint "(define (func x) (if (cons / `(x 1) '((()))) (get-output-string -(file-exists? -i)) (case 1(int-vector-set! (not 1)))))")
+    (glint "(define (func x) (if (char-ci<? 0) (gensym (substring /.)) (reverse (cons /-00(reverse!)))))")
+    (glint "(define (func x) (case x ((quasiquote) (caddr `(x 1) /)) (((vector 1 '(3))) (string-copy (ash 2(unless))))
+         (else (length /(with-output-to-string (lambda ()))))))")
+    (glint "(define (func x) (if (case . '(1 2 . 3)) (system (sequence?'string->byte-vector 0/0+0i let
+        (values #\\c 3 1.2) (make-dilambda (lambda () 1) (lambda (a) a)) (sublet /))) (hook-functions 20120i 0+0/0i)))")
+    (glint "(define (func x) (if (string-copy (ash 2(unless))) (caddr `(x 1) /) (length /(with-output-to-string (lambda ())))))")
+    (glint "(define (func x) (if (vector-append 210) (port-closed? / (define-macro (_m1_ a) `(+ ,a 1)) .-) (define-constant .-(gensym . 1+1/0i))))")
+    (glint "(define (func x) (if (number? +) (when (= ..)))) ")
+    (glint "(define (func x) (cond ((tan) (denominator -+0 begin `((x . 1)))) (else (let `((set! x (+ x 1)) (* x 2)) (let ii. (list 1) '(- 1) \"hi\" or -)))))")
+    (glint " (define (func x) (if (boolean? i(let)) (when (eq? ++.))))")
+    (glint "(define (func x) (if (immutable?) (complex do 0+0/0i (cons 1 2) /2.) (not (immutable?))))")
+    (glint "(define (func x) (case x (('(- 1)) (string-position 2)) ((#<eof>) (caar 0
+        (iterator-sequence))) (else (do '((1 (2)) (((3) 4))) (call/cc (lambda (go) (go 9) 0)) (let (system  `(1) 0/0+0i 1+1/0i '((x 1) (y . 2)) 0))))))")
+    (glint "(define (func x) (if (not) (not) (car '((x 1) . 2) '((x 1) 2) `(x 1) (char-numeric? +2))))")
+    (glint "(define (func x) (if (zero?) (zero?) (zero? (floor -+2+))))")
+    (glint "(define (func x) (if (not) (not) (not i/))) (define (hi) (func 1/0+i))")
+    (glint "(define (func x) (if (not) (not) (or .(or -+/ 1/1.2 '((x 1) (y . 2)) `((set! x (+ x 1)) (* x 2)) let* (define-macro (_m1_ a) `(+ ,a 1)) unless))))")
+    (glint "(define (func x) (if (string? 1i0) (string? 1i0) (and . else)))")
+    (glint "(define (func x) (case x (((values 1 2)) (sort! (string-set! .2)))
+        (((call/cc (lambda (go) (go 9) 0))) (sort! (string-set! .2))) (else (sort! /- 3/4 :hi '(()) if . 1+0/0i))))")
+    (glint "(let () (define (func x) (if (integer? 1 '((x 1) (y . 2))) (integer? 1 '((x 1) (y . 2))) (= 1))))")
+    (glint "(define (func x) (if (number? +) (number? +) (nan? . ())))")
+    (glint "(define (func x) (if (boolean? .(varlet)) (boolean? .(varlet)) (if . and)))")
+    (glint "(define (func x) (if (complex? i-) (complex? i-) (or (positive?))))")
+    (glint "(define (func x) (if (case 0/0+i (values) 1+1/0i (integer-decode-float)) (case 0/0+i (values) 1+1/0i (integer-decode-float))))")
+    (glint "(define (func x) (catch case 1 1.0+1.0i (values) 0/0+i (hash-table)))")
+    (glint "(define (func x) (if (string? +.) (string? +.) (string=? +.)))")
+    (glint "(define (func x) (if (real? -) (real? -) (= -)))")
+    (glint "(define (func x) (if (memq) (memq) (round 0+0/0i (set! _x1_ 3) (list (list 1)) (make-hook '(0 0 #f)) 2
+         else 0(int-vector 2 letrec - quasiquote (set! _x1_ 3) quote #<eof>))))")
+    (glint "(define (func x) (if (char-ci=? 1 0) (char-ci=? 1 0) (case 0(immutable? '((x 1) 2) -1 1.0+1.0i macroexpand i(logbit? (output-port? (char-whitespace? .2)))))))")
+    (glint "(define (func x) (if (sqrt 0.1) (sqrt 0.1) (with-baffle + (define _h1_ 3) (let))))")
+    (glint "(define (func x) (case x (((values)) (sqrt 0.1)) ((`((x 1))) (sqrt 0.1)) (else (with-baffle + (define _h1_ 3) (let)))))")
+    (glint "(define (func x) (if (copy 0+) (copy 0+) (length (values #\\c 3 1.2) (set! _x1_ 3) if ++i
+         (gensym? and (set! _x1_ 3) (integer->char 255) let* 0(integer? i.))))) ")
+    (glint "(define (func x) (if (char->integer 1.) (char->integer 1.) (reverse 0 \"hi\" 0+0/0i (set! _x1_ 3)
+         (integer->char 255) 1+0/0i '(- 1) => (let* 1 +nan.0 (set! _x1_ 3) `(x) 0(peek-char 2))))) ")
+    (glint "(define (func x) (if (list-tail (equivalent?)) (list-tail (equivalent?)) (lcm 20 (set! _x1_ 3) (integer-length (set! _x1_ 3) let* begin ii))))")
+    (glint "(define (func x) (case x ((`(+ x 1)) (list-tail (equivalent?))) (('((x 1) . 2))
+         (list-tail (equivalent?))) (else (lcm 20 (set! _x1_ 3) (integer-length (set! _x1_ 3) let* begin ii)))))")
+    (glint "(define (func x) (if (letrec - '((x 1) y . 2) '((x 1) . 2) #<eof> (define _h1_ 3) (do)) (letrec - '((x 1) y . 2) '((x 1) . 2) #<eof> (define _h1_ 3) (do))))")
+    (glint "(define (func x) (case x (((values \"hi\")) (letrec - '((x 1) y . 2) '((x 1) . 2) #<eof>
+         (define _h1_ 3) (do))) ((`(x . 1)) (letrec - '((x 1) y . 2) '((x 1) . 2) #<eof> (define _h1_ 3) (do))) (else (keyword? ./(char-position .(varlet 2-..))))))")
+    (glint "(define (func x) (if (vector-set! 1+(string->list)) (vector-set! 1+(string->list))
+         (make-string (set! _x1_ 3) (floor i0/ let* 0/0+i -1 (set! _x1_ 3) `(x 1)))))")
+    (glint "(define (func x) (case x ((#f) (vector-set! 1+(string->list))) (('((x 1 . 2) . 3))
+        (vector-set! 1+(string->list))) (else (make-string (set! _x1_ 3) (floor i0/ let* 0/0+i -1 (set! _x1_ 3) `(x 1))))))")
+    (glint "(define (func x) (if (char-ci=? 0(provided?)) (char-ci=? 0(provided?)) (if else)))")
+    (glint "(define (func x) (let* `(x 1) (do (list (list 1 2)) quote 0/0+i (define _h1_ 3))))")
+    (glint "(define (func x) (if (list->vector (list-tail (vector->list 0))) (list->vector (list-tail (vector->list 0)))))")
+    (glint "(define (func x) (case x ((''2) (list->vector (list-tail (vector->list 0)))) ((`((+ x 1))) (list->vector (list-tail (vector->list 0)))) (else (/ /1-+))))")
+    (glint "(define (func x) (if (not -) (not -) (and (and))))")
+    (glint "(define (func x) (reverse (cdr (reverse))))")
+    (glint "(define (func x) (if (cdr) (cdr) (format +i0/(outlet (do `(x) (string (integer->char 255)) -1 (define _h1_ 3) (do 0-))))))")
+    (glint "(define (func x) (if (string-append (string-append . 1/0+i)) (string-append (string-append . 1/0+i))))")
+    (glint "(map 2(list-tail (string->list i)))")
+    (glint "(for-each +(list-tail (string->list -)))")
+    (glint "(char-alphabetic? (letrec (list (list 1)) (values 1 2) (*s7* 'print-length) (define _h1_ 3) (let* 2 begin 0+1/0i (define* (_d1_ (a 1)) (+ a 1)) 0+0/0i 1212)))")
+    (glint "(with-baffle 1i 0+0/0i '((1 (2)) (((3) 4))) '((x . 1) . 2) 3/4 -1 unless (define _h1_ 3) (let 1))")
+    (glint "(when 00/(cond . +i))")
+    (glint "(letrec* - (define _h1_ 3) 1.5 (define _h1_ 3) (do '((()))))")
+    (glint "(map +(list-tail (vector->list //1(port-line-number ./))))")
+    (glint "(asin (procedure-source (string-append (string-append . when))))")
+    (glint "(for-each 1(list-tail (string->list (funclet (with-input-from-file .(signature))))))")
+    (glint "(eval (list 02(quote)))")
+    (glint "(string-append +0 (integer->char 255) (string-append . 1))")
+    (glint "(vector-append (vector-append . 1.2.3))")
+    (glint "(reverse! (map 0(sort!)))")
+    (glint "(append i2(append . #<unspecified>))")
+    (glint "(cadr (do (list (list 1)) `((+ x 1)) '(()) (list (list 1 2)) (do 00- #(1 2) or (lambda* ((a 1)) (+ a 1)) #() /100(number? (dilambda 1/)))))")
+    (glint "(do (list (list 1)) '((x 1) . 2) ..(case i/ 1.5 let . '(1 2 . 3)))")
+    (glint "(pair-line-number i2(outlet (c-pointer? (for-each if +nan.0 `(1) (quote \"\" #2d((1 2) (3 4))
+                   '((x 1) (y . 2)) (let ((x 3)) (lambda (y) (+ x y))) i/(char-downcase (logior 2(hash-table))))))))")
+    (glint "(when -(cond 2/1 (lambda args args) . 0))")
+    (glint "(string-ci>=? (cdaadr 1/+ `(x 1) `(1) #f case --+/-0(number? 0 1 '((x . 1) . 2) .-(eval (read (open-input-string))))))")
+    (glint "(make-hash-table ++0.(string-append \"hi\" (string)))")
+    (glint "(map (*s7* 'print-length) '((x 1) . 2) letrec* `(((x 1))) 0/0+i '(- 1) (quote #() #<eof> 1/1.2 +inf.0 i020))")
+    (glint "(multiple-value-bind 0(expt (map 2(quote))))")
+    (glint "(documentation (do () `((x 1)) (integer->char 255) . =>))")
+    (glint "(let*-values ((x)) (list ()) do -/(proper-list? -0(iterator? .-.-0(input-port? i0))))")
+    (glint "(logand .-0+11 'hi (1) i12(let-values ((1) . x)))")
+    (glint "(let-values ((x . 1) . 2) (make-dilambda (lambda () 1) (lambda (a) a)) 2.(cons* .210/))")
+    (glint "(/ i0+(let*-values ((x 1 . 2) . 3) #(1 2) '((1 (2)) (((3) 4))) and ((set! x (+ x 1)) (* x 2)) (proper-list?)))")
+    (glint "(let ((x 1) (y) . 2) (define _h1_ 3) (list 1 2) 2)")
+    (glint "(case .. ((x 1) 2) quasiquote -1234 (x 1) 10(abs 2))")
+    (glint "(let + (((x 1))) (unless 01001/i(outlet 2 (string (integer->char 255)) (lambda args args) (define-macro (_m1_ a) `(+ ,a 1)) 'hi (append (do +)))))")
+    (glint "(let? i0..-(let* '((())) (do ((set! x (+ x 1)) (* x 2)) (char-upper-case? (memq (string->symbol (proper-list? -)))))))")
+    (glint "(eqv? i.(write-byte (symbol-table (string>=? (call-with-exit i0(> 12+.(multiple-value-bind 2 -1 ((x 1) . 2))))))))")
+    (glint "(case .2i1./ ((x 1) 2) (x 1) (complex? 2))")
+    (glint "(let ((x #f)) (*s7* 'print-length) . else)")
+    (glint "(int-vector (let ((x . 1) . 2) (do (float-vector? -))))")
+    (glint "(when 0(let (((+ x 1))) +i :hi --(get-output-string #(#(0)) ((1)) (- 1) 1.0+1.0i (cddadr))))")
+    (glint "(let* + (((+ x 1))) (if ((x 1) (y . 2)) letrec* 0/0+i or))")
+    (glint "(caddr (letrec* i+ (((x 1) 2) 3) '((1 2) (3 4)) (define _h1_ 3) (do ((x . 1) . 2) 221.)))")
+    (glint "(let* (define-macro (_m1_ a) `(+ ,a 1)) (do (((+ x 1))) #() \"hi\" 0i #() let #2d((1 2) (3 4)) 0 /1))")
+    (glint "(eof-object? 0-+(let and ((x 1) (y . 2)) (unless +2+0(read -0(do (vector? 1 1.0+1.0i (pi 0) and .0))))))")
+    (glint "(aritable? +02(not (begin 1i __asdf__ (make-dilambda (lambda () 1) (lambda (a) a)) -1 ((x 1) (y) . 2) . 1234)))")
+    (glint "(let* + ((set! x (+ x 1)) (* x 2)) (when))")
+    (glint "(catch (lambda* ((a 1)) (+ a 1)) + (cons 1 2) (integer->char 255) lambda -.2.1++.(lambda*))")
+    (glint "(number? i0(cadr /(help (do ((x . 1)) (((x 1))) #2d((1 2) (3 4)) letrec*))))")
+    (glint "(do (+ x 1) 'hi (- 1) case ((x . 1) . 2) (integer->char 255) letrec .(string-downcase .(keyword? i)))")
+    (glint "(set-current-error-port (let i (((+ x 1))) #f ((x . 1) . 2) i+1.i(string-ci>? let* -1 -1 ((x))
+                    (current-output-port (abs x) 1.5 #() (x (y 1)) '((1 (2)) (((3) 4)))))))")
+    (glint "(string-downcase (open-input-file i(let /12 (((+ x 1))) __asdf__ do (*s7* 'print-length))))")
+    (glint "(read-char /2(equivalent? /(c-pointer? (iterate (let i. (((+ x 1))) ((x 1) y . 2) do (set-current-input-port .11))))))")
+    (glint "(do 'hi () 1/1.2 - or ((x 1) 2) most-negative-fixnum (cddaar /1(cosh do (list (list 1 2)) () '((())) begin 1 and 00.(length .i))))")
+    (glint "(expt .+/+(call-with-exit (lambda (x) ((x 1 . 2) . 3) -+)))")
+    (glint "(cdr -(lambda (define _h1_ 3) (not)))")
+    (glint "(zero? (- . (x . y)))")
+    (glint "(vector? 1./.1(int-vector-ref 1/(list-ref .(string-upcase -.(make-rectangular (let (pi 0) (do ((set! x (+ x 1)) (* x 2)) pi 1)))))))")
+    (glint "(if 0.(if (not 00.)))")
+    (glint "(let + (((+ x 1))) (when 2))")
+    (glint "(vector-length (copy .(gensym . pi)))")
+    (glint "(lambda 1-1/.0i/-i(let))")
+    (glint "(angle i+.(let ((x 1) (y) . 2) (define* (_d1_ (a 1)) (+ a 1)) 1(logxor)))")
+    (glint "(open-output-string (logxor ((x . 1)) ((set! x (+ x 1)) (* x 2)) pi #<unspecified> (define-macro (_m1_ a) `(+ ,a 1)) 1(call-with-values (values) (lambda))))")
+    (glint "(proper-list? (lambda* ..2(let ((x 1) . 2) (string #\\a #\\null #\\b) i1)))")
+    (glint "(lognot -(case i quote 00 (x y) => (set! _x1_ 3) .(string-ci>=? -/0 #2d((1 2) (3 4)) (((x 1) 2) 3) (- 1) 0/0+0/0i (float-vector-ref =>))))")
+    (glint "(string-append +(let* ''2 (define-macro (_m1_ a) `(+ ,a 1)) +inf.0 ((x 1) 2)
+                     21 case -1234 (define _h1_ 3) 0 +-(eval 02-(float-vector 2 (values \"hi\") (list (list 1)) ((x 1) . 2) +inf.0 -+2.))))")
+    (glint "(or -1i1 (or . 0))")
+    (glint "(caaaar '((1 2) (3 4)) (list 1 2) (char-lower-case? /+/. \"hi\" (pi 0) ((x . 1)) i/(make-list (set-current-error-port 12(when .1(when (not)))))))")
+    (glint "(cond (#t ()) 'hi ((x . 1)) i.1.)")
+    (glint "(cond (#t ()) ((x . 1) . 2) define x (cons 1 2) /-/(port-filename (x 1) ((set! x (+ x 1)) (* x 2)) (- 1) (- 1) .ii1(hash-table-entries 10)))")
+    (glint "(cond /2 (#t ()))")
+    (glint "(assv /2(map i (x 1) (make-dilambda (lambda () 1) (lambda (a) a)) 12+i1+/1(make-rectangular /2(cond (x . 1) (#t ()) (cdddar)))))")
+    (glint "(gc i/(case 1 (integer->char 255) (else ())))")
+    (glint "(list->string +(flush-output-port (case //2- (list 1) (else ()))))")
+    (glint "(cond (((+ x 1))) (else ()) (flush-output-port))")
+    (glint "(even? /(subvector 0-(list->string 1(cond ((i 0 (+ i 1))) ((x . 1) . 2) (#t ())))))")
+    (glint "(cond ((x 1) (y) . 2) (else (f x) B) ((x 1) (y) . 2))")
+    (glint "(cons +1.(list 02/ (pi 0) `(+ ,a ,@b) ((null? i) i) 2201))")
+    (glint "(let* / ((1)) (unless (unless '((())) x y z 1+0/0i most-negative-fixnum /)))")
+    (glint "(define* ((x . 1)) letrec ((1)) (pi 0) let (+ x 1) (x . 1) set! x quasiquote (f x) i `(+ ,a ,@b) )")
+    (glint "(define* , `(+ ,a ,b ,@c) (define* macroexpand macroexpand \"\"))")
+    (glint "(define* ((i 0 (+ i 1))) (define* 3/4 unless (call/cc (lambda (go) (go 9) 0)) or ' `(+ ,a ,@b) 1.0+1.0i abs (abs x) (A (f x) B) () ((1) . x) ))")
+    (glint "(define* , (else ()) ,(lambda))")
+    (glint "(cond ` (#t ()) (abs x) (= i 2) ((+ x 1)) (else (f x) B) ((x 1) (y) . 2) (A (f x) B))")
+    (glint "(unless (set! _x1_ 3) `(+ ,a ,@b) `(+ ,a ,@b) `(+ ,a ,@b) `(+ ,a ,b) (((x 1))) (vector 1 '(3)) (else (f x) B) +nan.0 ((x 1)))")
+    (glint "(lambda* .(:allow-other-keys (integer->char 255) define x (lambda args args) \" \"))")
+    (glint "(begin (define* (_d1_ (a 1)) (+ a 1)) (f x) (define* (_d1_ (a 1)) (+ a 1)) (else (f x) B) (- 1) ' ((x 1) 2) (A (f x) B) `(+ ,a ,b ,@c) #(1 2) .\" ` `  \")")
+    (glint "(define-macro* (null? i) #t (list 1 2) (define* (_d1_ (a 1)) (+ a 1)) ((x 1 . 2) . 3) ' 1 defmacro #f if (#t ()) quasiquote (quote ))")
+    (glint "(define-bacro (pi) (let .' define x cons or (#t ()) defmacro (x . y) (string (integer->char 255)) ((x 1 . 2) . 3) ,\"\"))")
+    (glint "(cond `(+ ,a ,@b) ((x 1) (y) . 2) (else (f x) B) ((x 1) (y) . 2))")
+    (glint "(lambda* lambda* -1 (= i 2) (- i 1) cons \"   \")")
+    (glint "(define-macro (pi) (quote))")
+    (glint "(cond (1) (else))")
+    (glint "(pair? (defmacro* define  #(#(0)) 3/4 `(+ ,a ,b ,@c) `(+ ,a b ,@c ',d) ((x 1 . 2) . 3) set! x))")
+    (glint "(list-values (apply-values))")
+    (glint "(list-values (begin (f x) B) +nan.0 (apply-values))")
+    (glint "(symbol->value (vector->list quasiquote (list-values -1.3 (apply-values))))")
+    (glint "(define-macro (list (list 1 2)) (list-values))")
+    (glint "(define-bacro  (x => y)  (cond   ((x 1) . 2)  ))")
+    (glint "(int-vector-set! ((+ x 1)) \"hi\" '(string #\\a #\\null #\\b) 3/4 (((+ x 1))) (1) (do (#t ()) #() (= i 2)))")
+    (glint "(list-values (list-values . -1))")
+    (glint "(lambda* `(string>? +inf.0 ((set! x (+ x 1)) (* x 2)) macroexpand `(+ ,a ,b ,@c) (()) pi (pi 0) (= i 2) let (1) begin (1 2 . 3) if cond (begin (f x) B) (()) (define-macro (_m1_ a) `(+ ,a 1)) (x y) (values \"hi\") ((+ x 1)) :hi ((set! x (+ x 1)) (* x 2)) +inf.0 (()) (pi 0) ((x 1 . 2) . 3) (x y) (x . 1) ((x . 1) . 2) +nan.0 (if x y) `(+ ,a b ,@c ',d) (make-dilambda (lambda () 1) (lambda (a) a)) with-let ))")
+    )
+
+  (let ((out-vars (*lint* 'out-vars)))
+    (test (out-vars 'hi '(a b) '(+ a b)) '(() ()))
+    (test (out-vars 'hi '(a b) '(set! a b)) '(() ()))
+    (test (out-vars 'hi '(a b) '(set! c (+ a b))) '(() (c)))
+    (test (out-vars 'hi '(a b) '(set! a (+ b c))) '((c) ()))
+    (test (out-vars 'hi '(a b) '(set! c (+ (* a b) c))) '((c) (c)))
+    (test (out-vars 'hi '(a b) '(set! (c 0) (+ (* a b) c))) '((c) (c)))
+    (test (out-vars 'hi '(a b) '(let ((c 1)) (+ (* a b) c))) '(() ()))
+    (test (out-vars 'hi '(a b) '(let ((c (+ a b))) (set! c (* a b)))) '(() ()))
+    (test (out-vars 'hi '(a b) '(let loop ((c (+ a b))) (set! c (loop a)))) '(() ()))
+    (test (out-vars 'hi '(a b) '(let loop ((c (+ a b))) (set! c (loop d)))) '((d) ()))
+    (test (out-vars 'hi '(a b) '(let ((c (+ a b)) (d 1)) (set! c (loop d)))) '((loop) ()))
+    (test (out-vars 'hi '(a b) '(let ((c (+ a b)) (d 1)) (set! e d) (+ a b c d))) '(() (e)))
+    (test (out-vars 'hi '(a b) '(let ((c (+ a b)) (d 1)) (set! e d) (+ a b c d e f g))) '((g f e) (e)))
+    (test (out-vars 'hi '(a b) '(let ((c 1) (d (+ c 1))) (+ (* a b) c))) '((c) ()))
+    (test (out-vars 'hi '(a b) '(let* ((c 1) (d (+ c 1))) (+ (* a b) c))) '(() ()))
+    (test (out-vars 'hi '(a b) '(let ((g 1)) (let ((c g)) (* c g)))) '(() ()))
+    (test (out-vars 'hi '(a b) '(let ((g 1)) (letrec ((c g)) (* c g)))) '(() ()))
+    (test (out-vars 'hi '(a b) '(do ((i 0 (+ i 1))) ((= i 10) i) (display i))) '(() ()))
+    (test (out-vars 'hi '(a b) '(do ((i 0 (+ i j))) ((= i 10) i) (display i))) '((j) ()))
+    (test (out-vars 'hi '(a b) '(do ((i 0 (+ i j)) (j 2)) ((= i 10) i) (display i))) '(() ()))
+    (test (out-vars 'hi '(a b) '(do ((i 0 (+ i j)) (j 2)) ((= i 10) k) (display i))) '((k) ()))
+    (test (out-vars 'hi '(a b) '(do ((i 0 (+ i j)) (j 2)) ((= i 10) k) (set! n i))) '((k) (n)))
+    (test (out-vars 'hi '(a b) '(lambda () (+ a b))) '(() ()))
+    (test (out-vars 'hi '(a b) '(lambda (c) (+ a b c))) '(() ()))
+    (test (out-vars 'hi '(a b) '(lambda c (+ a b c))) '(() ()))
+    (test (out-vars 'hi '(a b) '(lambda (c . d) (+ a b c d))) '(() ()))
+    (test (out-vars 'hi '(a b) '(lambda (c . d) (set! e (+ a b c d)))) '(() (e)))
+    (test (out-vars 'hi '(a b) '(lambda* ((c 1) (d 2)) (+ a b c d))) '(() ()))
+    (test (out-vars 'hi '(a b) '(let () (define c 1) (+ a b c))) '(() ()))
+    (test (out-vars 'hi '(a b) '(let () (define c 1) (+ a b c d))) '((d) ()))
+    (test (out-vars 'hi '(a b) '(let* () (define c 1) (+ a b c d))) '((d) ()))
+    (test (out-vars 'hi '(a b) '(let () (define (c s) (* s 2)) (+ a b (c d)))) '((d) ())))
+
+
+;  (define fmatch (*lint* 'function-match))
+;  (define walkfunc (*lint* 'lint-walk-function))
+;  (define (f1 x) (if (< x 3) (+ x 1) (+ x 2)))
+;  (let ((e (walkfunc 'define 'f1 '(x) '((if (< x 3) (+ x 1) (+ x 2))) '(define (f1 x) (if (< x 3) (+ x 1) (+ x 2))) ())))
+;    (fmatch 'tester '(if (< y 3) (+ y 1) (+ y 2)) e))
+;  (define sequal? (*lint* 'structures-equal?))
+;  (sequal? '(if (< y 3) (+ y 1) (+ y 2)) '(if (< x 3) (+ x 1) (+ x 2)) '((y . :unset)) () ())
+;  (sequal? '(and x y) '(and a b) '((x . a) (y . b)) () ())
+
+
+  (define f321
+    (let ((+signature+ '(float? integer?)))
+      (lambda (int)
+	(if (integer? int)
+	    (* 1.0 int)
+	    (error 'wrong-type-arg "~A: ~A is not an integer" f321 int)))))
+  (lint-test "(string-ref (f321 3) 2)" " string-ref: in (string-ref (f321 3) 2), string-ref's first argument should be a string, but (f321 3) is a float?")
+
+  (when full-s7test
+    (let ((result (call-with-output-string
+		   (lambda (op)
+		     (catch #t
+		       (lambda ()
+			 (lint "lint.scm" op))
+		       (lambda (type info)
+			 (format *stderr* "~A: ~S~%" type (apply format #f info))))))))
+      (when (string? result)
+	(format *stderr* "lint(lint): ~S~%" (length result))));) ; 77629 11-Sep-23
+
+  (set! reader-cond #f)
+  (set! *#readers* ()))
+;;; end lint
+(set! (hook-functions *read-error-hook*) ())
+(set! *#readers* ())
+;;; shouldn't lint clear these?
+(set! ((funclet pretty-print) '*pretty-print-spacing*) 2)
+(set! ((funclet pretty-print) '*pretty-print-left-margin*) 2)
+;(if (defined? 'pp-testing) (exit))
+
+;;; --------------------------------------------------------------------------------
+
+(test (let () (define (f) (write (vector 1.0) (openlet (inlet 'write for-each)))) (f)) 'error) ; fx_c_aa unstack gc_protect bug
+;; gets error "vector-ref second argument, (write . for-each), is a pair but should be an integer" because it's iterating over the let
+(test (write (vector 1.0) (openlet (inlet 'write for-each))) 'error)         ; same as above without the fx_c_aa call but pointless since 'write is no longer global
+
+(define _x3x3_ with-baffle)
+(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (vector) (_x3x3_ (reverse (caaar (+ i 1)))))) (func)) 'error) ; fx_c_optcq bug
+
+(let ()
+  (define (func)
+    (catch #t
+      (lambda () (let ((x (list (newline (open-output-function #_+))))) x))
+      (lambda (type info) 'error)))
+  (test (func) (list #\newline))) ; function_write* unstack+save sc->args|code
+
+(let-temporarily (((setter quasiquote) (lambda args args)))
+  (test (let () (define (f) (set! (quasiquote 1) (setter 'i))) (f) (f)) '(1 #f)) ; set_opsaq_a -> set_pair3 c_macro branch */
+  (test (let () (define (f) (set! (quasiquote 'a 0) 3)) (f) (f)) '(a 0 3)))      ; op_set_opsaaq_a -> set_pair4 same */
+
+(test (c-pointer? (coverlet (c-pointer 1 2 (inlet 'aaa 1)))) #t)
+;;; next two redefine let-ref and let-set! which messes up lint optimization above
+(test (#_eval '(define x 3) (null-environment)) 3)
+(test (#_eval '(< x 4) (null-environment)) 'error)
+(test (object->string (null-environment)) "(inlet 'x 3)")
+(test (#_eval '(let ((y 2)) ((lambda z z) x y)) (null-environment)) '(3 2))
+
+(test (let ((equal? #f)) (member 3 '(1 2 3))) '(3))
+(test (let ((eqv? #f)) (case 1 ((1) 1))) 1) ; scheme wg
+(test (let ((eqv? equal?)) (case "asd" (("asd") 1) (else 2))) 2)
+(test (let ((eq? #f)) (memq 'a '(a b c))) '(a b c))
+
+(test (let () (define (func) ((lambda (if) (if (> 3 2) + -)) 3)) (func)) 'error)
+(test (let () (define (func) ((lambda (list) (list (> 3 2) + -)) 3)) (func)) 'error)
+(test (let ((if #t)) (or if)) #t)
+(test (let ((if +)) (if 1 2 3)) 6)
+(test (if (let ((if 3)) (> 2 if)) 4 5) 5)
+(test (let ((quote 1)) (+ quote 1)) 2)
+;(test (let ((quote -)) '32) -32) ; this doesn't work in general (op_quote_unchecked and quote->fx_q elsewhere)
+(test (do ((do 1)) (#t do)) 1)
+(test (do ((do 1 (+ do do))) ((> do 3) do)) 4)
+(test (do ((do 1 do) (j do do)) (do do)) 1)
+(test (do ((do do do)) (do do)) do)
+(test (do ((do do do)) (do do do)) do) ; ok ok!
+(test (or (let ((or #t)) or)) #t)
+(test (and (let ((and #t)) and)) #t)
+(test (let ((=> 3) (cond 4)) (+ => cond)) 7)
+(test (case 1 ((1 2) (let ((case 3)) (+ case 1))) ((3 4) 0)) 4)
+(test (let ((lambda 4)) (+ lambda 1)) 5)
+(test (let ((define 1)) define) 1)
+
+;; define => tests
+(let ((=> 32)) (test (cond (1 =>)) 32))
+(let () (test (cond (1 => abs)) 1))
+(let () (define => 32) (test (cond (1 => abs)) abs))
+(let () (test (cond (1 => abs)) 1))
+(define => 32)
+(test (cond (1 =>)) 32)
+(set! => #<undefined>)
+(test (cond (1 => abs)) 1)
+
+(test (let () (define (hi a) (let ((pair? +)) (pair? a 1))) (hi 2)) 3)
+(test ((lambda (let) (let* ((letrec 1)) (+ letrec let))) 123) 124)
+;(test (member quasiquote (list 1) (lambda 'ho '(1 2))) 'error) ; 29-May-21 qq uses #_quote if quote is not a global
+
+(test (let ((begin 3)) (+ begin 1)) 4)
+(test ((lambda (let*) (let ((letrec 1)) (+ letrec let*))) 123) 124)
+(test ((lambda (quote) (+ quote 1)) 2) 3)
+(test ((lambda (quote . args) (list quote args)) 1 2 3) '(1 (2 3)))
+(test (let ((do 1) (map 2) (for-each 3) (quote 4)) (+ do map for-each quote)) 10)
+(test ((lambda lambda lambda) 'x) '(x))
+(test ((lambda (begin) (begin 1 2 3)) (lambda lambda lambda)) '(1 2 3))
+(test (let* ((let 3) (x let)) (+ x let)) 6)
+(test (((lambda case lcm))) 1)
+(test (((lambda let* *))) 1)
+(test (do ((i 0 1) '(list)) (#t quote)) 'error)
+(test ((lambda (let) (+)) 0) 0)
+(test (let () (define (hi cond) (+ cond 1)) (hi 2)) 3)
+(test (let () (define* (hi (cond 1)) (+ cond 1)) (hi 2)) 3)
+(test (let () (define* (hi (cond 1)) (+ cond 1)) (hi)) 2)
+(test (let () ((lambda (cond) (+ cond 1)) 2)) 3)
+(test (let () ((lambda* (cond) (+ cond 1)) 2)) 3)
+(test (let () (define-macro (hi cond) `(+ 1 ,cond)) (hi 2)) 3)
+(test (let () (define-macro* (hi (cond 1)) `(+ 1 ,cond)) (hi)) 2)
+(test (let () (define (hi abs) (+ abs 1)) (hi 2)) 3)
+(test (let () (define (hi if) (+ if 1)) (hi 2)) 3)
+
+(test (let () (define* (hi (lambda 1)) (+ lambda 1)) (hi)) 2)
+(test (do ((i 0 0) '(+ 0 1)) ((= i 0) i)) 'error)
+(test (let () (define (cond a) a) (cond 1)) 1)
+(test (let ((cond 1)) (+ cond 3)) 4)
+(test (let () (define (tst cond) (if cond 0 1)) (tst #f)) 1)
+(test (let () (define (tst fnc) (fnc ((> 0 1) 2) (#t 3))) (tst cond)) 3)
+(test (let () (define (tst fnc) (fnc ((> 0 1) 2) (#t 3))) (define (val) cond) (tst (val))) 3)
+(test (let () (define-macro (hi a) `(let ((lambda +)) (lambda ,a 1))) (hi 2)) 3)
+(test ((let ((do or)) do) 1 2) 1)
+
+(test (let () (define (hi) (let ((oscil *)) (if (< 3 2) (+ 1 2) (oscil 4 2)))) (hi) (hi)) 8)
+(test (let () (define (hi) (let ((oscil *)) (if (< 3 2) (+ 1 2) (oscil 4 2)))) (hi) (hi) (hi) (hi)) 8)
+(test (let ((x 12)) (define (hi env) (set! x (env 0)) x) (hi '(1 2 3)) (hi '(1 2 3))) 1)
+(test (let ((x 12)) (define (hi env) (set! x (+ x (env 0))) x) (hi '(1 2 3)) (hi '(1 2 3))) 14)
+(test (let ((x 12)) (define (hi env) (set! x (+ (env 0) x)) x) (hi '(1 2 3)) (hi '(1 2 3))) 14)
+(test (let ((x 12)) (define (hi env) (set! x (+ x (env 0))) x) (hi '(1 2 3)) (hi '(1 2 3)) (hi '(1 2 3))) 15)
+(test (let ((x 12)) (define (hi env) (set! x (+ (env 0) x)) x) (hi '(1 2 3)) (hi '(1 2 3)) (hi '(1 2 3))) 15)
+
+(test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i (env 1 2)))) ((> i (env 4 5)) (env 1 2 3)) (+ x (env 1)))) (hi) (hi)) 6)
+(test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i 3))) ((> i (env 4 5)) (env 1 2 3)) (+ x (env 1)))) (hi) (hi)) 6)
+(test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i 3))) ((> i (env 4 5)) (env 1 2 3)) (+ x 1))) (hi) (hi)) 6)
+(test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i 3))) ((> i 9) (env 1 2 3)) (+ x 1))) (hi) (hi)) 6)
+(test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i 3))) ((> i 9) (+ 1 2 3)) (+ x 1))) (hi) (hi)) 6)
+(test (let * ((i 0)) (if (< i 1) (* (+ i 1))) i) 0)
+(test (let ((car if)) (car #t 0 1)) 0)
+(test (call-with-exit (lambda (abs) (abs -1))) -1)
+
+(test (let ((sqrt (lambda (a) (* a a)))) `(+ ,@(map sqrt '(1 4 9)) 2)) '(+ 1 16 81 2))
+(test (let ((sqrt (lambda (a) (* a a)))) `(+ ,(sqrt 9) 4)) '(+ 81 4))
+(test `(+ ,(let ((sqrt (lambda (a) (* a a)))) (sqrt 9)) 4) '(+ 81 4))
+(test `(+ (let ((sqrt (lambda (a) (* a a)))) ,(sqrt 9)) 4) '(+ (let ((sqrt (lambda (a) (* a a)))) 3) 4))
+(test (let ((sqrt (lambda (a) (* a a)))) `(+ ,(apply values (map sqrt '(1 4 9))) 2)) '(+ 1 16 81 2))
+(unless immutable-unquote (test (let ((sqrt (lambda (a) (* a a)))) `(+ (unquote (apply values (map sqrt '(1 4 9)))) 2)) '(+ 1 16 81 2)))
+
+(test ((((eval lambda) lcm gcd))) 0)
+(test ((((lambda - -) -) 0) 1) -1)
+
+(test (let () (define (hi) (let ((oscil >)) (or (< 3 2) (oscil 4 2)))) (hi) (hi)) #t)
+(test (let () (define (hi) (let ((oscil >)) (and (< 2 3) (oscil 4 2)))) (hi) (hi)) #t)
+(test (procedure? (let ()  (let* cons () (lambda* (a . b) (cons a b))))) #t) ; fixup_closure_star_aa bug (needed arity check)
+(test ((lambda* ((- 0)) -) :- 1) 1)
+
+(let ()
+  (define-macro (i_ arg)
+    `(with-let (unlet) ,arg))
+
+  (define-bacro* (mac b)
+    `((i_ let) ((a 12))
+      ((i_ +) a ,(symbol->value b))))
+  ;; this assumes the 'b' value is a symbol: (let ((a 1)) (mac (* a 2))) is an error -- see s7.html for a better version
+  (test (let ((a 32)
+	      (+ -))
+	  (mac a))
+	44))
+
+;(define (hi) (do ((i 0 (+ i 1))) ((= i 200000) i) (abs i)))
+;(test (hi) 200000)
+
+(let ()
+  (define-macro (cube x) `(with-let (inlet :x ,x) (* x x x)))
+  (test (cube 2) 8)
+  (let ((x 2)) (test (cube (set! x (+ x 1))) 27))
+
+  (define-macro (pop! sym)
+    `(with-let (#_inlet :e (#_curlet) :result (#_car ,sym))
+       (with-let e (#_set! ,sym (#_cdr ,sym)))
+       result))
+
+  (test (let ((lst '(1 2 3))) (list (pop! lst) lst)) '(1 (2 3)))
+  (test (let ((lst (vector (list 1 2 3)))) (list (pop! (lst 0)) lst)) '(1 #((2 3))))
+  (test (let ((result '(1 2 3))) (list (pop! result) result)) '(1 (2 3)))
+  (test (let ((cdr '(1 2 3))) (list (pop! cdr) cdr)) '(1 (2 3)))
+
+  (define-macro (pushnew! val lst)
+    `(set! ,lst (with-let (inlet :val ,val :lst ,lst)
+		  (if (not (member val lst))
+		      (cons val lst)
+		      lst))))
+
+  (test (let ((lst (list 1 2))) (pushnew! 3 lst)) '(3 1 2))
+  (test (let ((val (list 1 2)) (lst 3)) (pushnew! lst val)) '(3 1 2))
+  (test (let ((lst (list 1 2)) (val 3)) (pushnew! val lst)) '(3 1 2))
+  (test (let ((lst (list 1 2)) (member 3)) (pushnew! member lst)) '(3 1 2))
+  )
+
+(test (let ((x 2) (display 3)) (with-let (sublet (curlet) (unlet)) (display x))) 2) ; (unlet () ...) -- curlet but with globals in original values
+(test (let ((y 2)) (let ((x 1)) (let ((display 3)) (with-let (sublet (curlet) (unlet)) (display (+ x y)))))) 3)
+
+(test (let ()
+	(define-immaculo (hi a) `(let ((b 23)) (+ b ,a)))
+	(let ((+ *)
+	      (b 12))
+	  (hi b)))
+      35)
+#|
+(test (let ()
+	(define-clean-macro (hi a) `(+ ,a 1))
+	(let ((+ *)
+	      (a 12))
+	  (hi a)))
+      13)
+|#
+(test (let ()
+	(define-immaculo (hi a) `(+ ,a 1))
+	(let ((+ *)
+	      (a 12))
+	  (hi a)))
+      13)
+#|
+(test (let ()
+	(define-clean-macro (mac a . body)
+	  `(+ ,a ,@body))
+	(let ((a 2)
+	      (+ *))
+	  (mac a (- 5 a) (* a 2))))
+      9)
+|#
+(test (let ()
+	(define-macro (mac b)
+	  `(let ((a 12))
+	     (,+ a ,b)))
+	(let ((a 1)
+	      (+ *))
+	  (mac a)))
+      24)
+
+(test (let ()
+	(define-macro (mac b)
+	  `(let ((a 12))
+	     (+ a ,b)))
+	(let ((a 1)
+	      (+ *))
+	  (mac a)))
+      144)
+
+(test (let ()
+	(define-immaculo (mac c d) `(let ((a 12) (b 3)) (+ a b ,c ,d)))
+	(let ((a 21) (b 10) (+ *)) (mac a b)))
+      46)
+
+(let ()
+  (define-macro (pure-let bindings . body)
+    `(with-let (unlet)
+       (let ,bindings ,@body)))
+  (test (let ((+ *) (lambda abs)) (pure-let ((x 2)) ((lambda (y) (+ x y)) 3))) 5))
+
+(test (let ((name '+))
+	(let ((+ *))
+	  (eval (list name 2 3))))
+      6)
+(test (let ((name +))
+	(let ((+ *))
+	  (eval (list name 2 3))))
+      5)
+;; why is this considered confusing?  It has nothing to do with eval!
+
+(test (let ((call/cc (lambda (x)
+		       (let ((c (call/cc x))) c))))
+	(call/cc (lambda (r) (r 1))))
+      1)
+
+; (test (with-let (sublet (curlet) (cons '+ (lambda args (apply * args)))) (+ 1 2 3 4)) 24) ; not sure about this -- the inner '+ might be optimized
+
+(let ()
+  (define-macro (when1 expr . body)
+    `(#_if ,expr (#_begin ,@body)))
+  (let ((if 32) (begin +))
+    (test (when1 (> 2 1) 1 2 3) 3)
+    (test (when1 (> 1 2) 3 4 5) #<unspecified>))
+  (test (when1 (> 2 1) 3) 3))
+
+(test (let ((car 1) (cdr 2) (list '(1 2 3))) (+ car cdr (cadr list))) 5)
+(test (letrec ((null? (lambda (car cdr) (+ car cdr)))) (null? 1 2)) 3)
+(test (letrec ((append (lambda (car list) (car list)))) (append cadr '(1 2 3))) 2)
+(test (let () (define (hi) (let ((car 1) (cdr 2) (list '(1 2 3))) (+ car cdr (cadr list)))) (hi)) 5)
+(test (let () (define (hi) (letrec ((null? (lambda (car cdr) (+ car cdr)))) (null? 1 2))) (hi)) 3)
+(test (let () (define (hi) (letrec ((append (lambda (car list) (car list)))) (append cadr '(1 2 3)))) (hi)) 2)
+
+(let ()
+  (test ((lambda 'a (eval-string "1")) (curlet) 1) 'error)
+  (test ((lambda 'a (eval-string "a")) (curlet) 1) 'error))
+
+;;; check optimizer
+(let ((lst (list 1 2 3))
+      (old-lambda lambda)
+      (ho #f)
+      (val #f))
+  (let* ((lambda 1))
+    (define (hi)
+      (for-each (lambda (a) (display a)) lst))
+    (set! val (+ lambda 2))
+    (set! ho hi))
+  (test val 3)
+  (test (ho) #<unspecified>))
+
+(when with-block ; optimize_safe_c_func_three_args[71842]: overwrite has_fx: opt2_sym (fvset1 '((x 1)) imh111)
+  (let ()
+    (define (func)
+      (do ()
+	  ((not #f)
+	   (make-string 3 #\space)
+	   (with-let (block)
+	     (let ((fvset1 float-vector-set!))
+	       (define-constant imh111 (hash-table))
+	       (subsequence fvset1 `((x 1)) imh111))))))
+    (test (func) 'error))
+  (let ((block-ref 123))
+    (test (#_block-ref (block 1 2) 0) 1.0)
+    (test (block-ref (block 1 2) 0) 'error)))
+
+(let ()
+  (define mac (let ((var (gensym)))
+		(define-macro (mac-inner b)
+		  `(#_let ((,var 12)) (#_+ ,var ,b)))
+		mac-inner))
+  (test (let ((a 1) (+ *) (let /)) (mac a)) 13)
+  (test (let ((a 1) (+ *) (let /)) (mac (mac a))) 25))
+
+(let () ; from Kjetil Matheussen
+  (define-expansion (push2! list el) `(set! ,list (cons ,el ,list)))
+  (define aa '())
+  (define (afunction) (define a 'a) (push2! aa a))
+  (define (<_>2 a b) (string->symbol (string-append (symbol->string a) (symbol->string b))))
+  (define-expansion (<ra2> command . args) `( ,(<_>2 'ra2: (keyword->symbol command)) ,@args))
+  (define (get-all-lines-in-file2 wfilename) (<ra2> :open-file-for-reading2 wfilename)))
+
+(test ((lambda () ((let () cond) (call-with-exit 32)))) 32)
+(test (let ((begin +)) (with-let (unlet) (begin 1 2))) 2)
+(test (let () (define (f x) (let > (begin (vector-dimensions 22)))) (f 0)) 'error)
+(test (let () (define (f x) (let asd ())) (f 1)) 'error)
+(test (let () (define (f x) (hook *)) (f #f)) 'error)
+(test (let ((e (sublet () '(a . 1)))) (define (f x) (e *)) (f 1)) 'error)
+(test (let () (define (f) (eval (lambda 2.(hash-table-ref 1-)))) (f)) 'error)
+(test (let () (eval (lambda 2.(hash-table-ref 1-)))) 'error)
+(test (let () (define (f) (eval (lambda 2 #f))) (f)) 'error)
+(test (let () (define (f) (eval (lambda #f))) (f)) 'error)
+(test (let () (define (f) (eval (lambda))) (f)) 'error)
+(test (let () ((lambda () (eval (lambda 2 #f))))) 'error)
+(test (let () (define (f x) (help (lambda  `(x 1) 12))) (f (string #\a))) 'error)
+(test (let () (define (func x) (* +(quote (vector? )))) (func '((x 1) (y) . 2))) 'error)
+(test (let () (define (func x) (* +(quote i))) (func cond))  'error)
+(test (let ((i 1)) (define (func x) (begin i(let -))) (func macroexpand))  'error)
+(test (let ((i 1)) (define (func x) (if (* i '((x 1) (y) . 2) ) (atan (procedure? 2(sin ))))) (func '(values #\c 3 1.2))) 'error)
+(test (let ((i 1)) (define (func x) (* 1- '(values #\c 3 1.2) )) (func set!))  'error)
+(test (let ((dynamic-wind 1)) (+ dynamic-wind 2)) 3)
+(test (list (call-with-exit (lambda quote ((car quote) 1 2 3)))) '(1 2 3))
+(test (call-with-exit (lambda* (quote (ho 1)) (quote ho))) 1)
+(test (lambda 'ho (hash-table 'a 1) . #<unspecified>) 'error) ; stray dot check
+
+(test (let () (define (func) (do ((var #f) (i 0 (+ i 1))) ((= i 1) var) (for-each or #((define x 3))))) (func)) #f) ;fx_tree problem
+;; same problem but uncaught currently:
+;;   (let ((arg #((define x 3))) (asdf or) (fdsa for-each)) (define (func) (do ((var #f) (i 0 (+ i 1))) ((= i 1) var) (fdsa asdf arg))) (func))
+;; the problem is several-fold:
+;; (map or #((+ 1 2))) -> '(3)
+;;   but (map + #((1 2))) -> error: + argument, (1 2), is a pair but should be a number
+;; so syntax is special in this context because we want things like
+;;   (define-macro (enum . args) `(for-each define ',args (iota (length ',args)))) ; stuff.scm
+;; to work in for-each, which means the list is evaluated, or more clear:
+;;   (apply or '((define asdf 4))) -> 4, and (map or '((define asdf 4))) -> '(4) and (map (macro (x) x) '((define xx 3))) -> '(3)
+;;   (let () (define (func) (do ((var #f) (i 0 (+ i 1))) ((= i 1) var) (for-each or #((provide 'snd-dsp.scm))))) (func))
+;;   (let () (define (func) (do ((var #f) (i 0 (+ i 1))) ((= i 1) var) (for-each or #((define x 3))))) (func))
+;; the "solution" is to use pairs, not vectors in cases like this, and don't get cute with names
+;; another possibility: if syntax seen as map/for-each first arg, make sure any additions to curlet are at end of slot list
+
+(let-temporarily (((setter abs) catch)) (define (func) (set! (abs x) 1)) (catch #t func (lambda args 'error)) (test (func) 'error))
+(test (let ((var begin)) (abs (+ 1 (var 2)))) 3)
+(test (let ((var begin)) (define (f) (abs (+ 1 (var 2)))) (define (hi) (f)) (hi) (hi)) 3)
+(test (let ((var begin)) (define (f) (abs (+ 1 (apply var '(2))))) (define (hi) (f)) (hi) (hi)) 3)
+(test (let () (define var begin) (define (f a) (a 0)) (f var)) 0)
+(test (let () (define var begin) (define (f a) (a #t 0)) (f var)) 0)
+(test (let () (define var begin) (define (f a) (a 0)) (f var)) 0)
+(test (let ((x cond)) (define (f a) (a (#t 2))) (f cond)) 2)
+(test (let ((x cond)) (define (f a) (a (#t 2))) (f x)) 2)
+(test (let ((x cond)) (define (f a) (a ((> 3 2) 1))) (f cond)) 1)
+(test (let ((x cond)) (define (f a) (a ((> 3 2) 1))) (f x)) 1)
+(test (let ((x when)) (define (f a) (a #t 2)) (f x)) 2)
+(test (let ((x or)) (define (f a) (a #t)) (f x)) #t)
+(test (let ((x begin)) (define (f a) (a #t 2)) (f x)) 2)
+(test (let ((x begin)) (define (f a) (a #t)) (f x)) #t)
+(test (let ((x #f)) (define (f a) (a 3)) (set! x begin) (f x)) 3)
+(test (let () (define var cond) (define (f a) (a (#t 0))) (f var)) 0)
+(test (let () (define var when) (define (f a) (a #t 0)) (f var)) 0)
+(test (let () (define (f x) (x 12)) (f begin)) 12)
+(test (let () (define (f x) (x 12)) (f values)) 12)
+
+;;; quote stuff
+
+(when full-s7test ; try to call with quote still global
+  (test (system "./repl -e '(let ((quote 32)) (+ quote 1))'" #t) "33\n")
+  (test (system "./repl -e '(let ((quote 32)) (define (f) (+ quote 1)) (f)))'" #t) "33\n")
+  (test (system "./repl -e '(let ((quote 32)) (define (f z) (+ z 1)) (f quote))'" #t) "33\n")
+  (test (system "./repl -e '(let ((quote (lambda (x) (+ x 1)))) (quote 32))'" #t) "33\n")
+  (test (system "./repl -e '(let ((quote (lambda (x) (+ x 1)))) (define (f) (quote 32)) (f))'" #t) "33\n")
+  (test (system "./repl -e '(let () (define (f) (let ((quote 32)) (+ quote 1))) (f))'" #t) "33\n")
+  (test (system "./repl -e '(let () (define (f) (let ((quote 32)) (+ quote 1))) (define (g) (f)) (g) (g))'" #t) "33\n")
+  (test (system "./repl -e '((lambda (quote) (+ quote 1)) 32)'" #t) "33\n"))
+
+(test (let ((when -)) (when 32)) -32)
+;(test (let ((quote -)) '32) -32)
+;(test (let () (define (f) (let ((quote -)) '32)) (f)) -32)
+(test (apply (apply apply lambda (quote '(1)))) 'error)
+(test (let ('a 3) 1) 'error)
+(test (let (' 1) quote) 'error)
+(test (let () (define (func x) (let () (define _x_ (lambda* '((x 1 . 2) . 3) `((x)) (reverse! /))))) (define (hi) (func #f)) (hi)) 'error)
+(test (call-with-output-file "/dev/null" (lambda* '(- 1) (vector 1 '(3)) '((1)))) 'error)
+;(test (let ((x #f) (i 0)) (call/cc (lambda* quote `((1) . x)))) 'error)
+;(test (let () (define (func) (let ((x #f) (i 0)) (call/cc (lambda* quote `((1) . x) (begin))))) (define (hi) (func)) (hi)) 'error)
+(let () (define (func x) (let () (define _x_ (lambda* '((x 1 . 2) . 3) `((x)) (reverse! /))))) (define (hi) (func #f)) (test (hi) 'error))
+(let () (define (func) (with-output-to-string (lambda* (if) ((if (> 3 2) + -) 3 2)))) (test (func) 'error)) ;(if (< 3 2) + -)... within lambda* (if) in with-output-to-string
+(let () (define (func) (with-output-to-file "/dev/null" (macro* (if) ((if (> 3 2) + -) 3 2)))) (test (func) 'error))
+
+(test (let ((max min) (min max)) (min 10 (max 100 5))) 10)
+(test (let ((max min) (min max)) (min 10 (max 12 15))) 12)
+(test ((let ((mx max)) (lambda* ((max min) (min mx)) (min 10 (max 100 5))))) 10)
+(test ((let ((mx max)) (lambda* ((max min) (min mx)) (min 10 (max 12 15))))) 12)
+(test (let ((max min) (min max)) (define (func) (min 10 (max 100 5))) (define (hi) (func)) (hi)) 10)
+(test (let ((max min) (min max)) (define (func) (min 10 (max 12 15))) (define (hi) (func)) (hi)) 12)
+(test (let ((f +)) (f 3 (let () (set! f -) 4))) 7)
+
+(let ((f #_abs)) (test (set! #_abs +) 'error) (set! abs +) (test (eq? f abs) #f) (test (eq? f #_abs) #t) (set! abs #_abs))
+(when (zero? (*s7* 'debug)) (test (let ((+ -)) (define (f x) (#_+ x 1)) (object->string f :readable)) "(lambda (x) (#_+ x 1))"))
+
+(let () (define-macro (q x) `(symbol? ',x)) (let ((quote "Friends, Romans, countrymen")) (test (q 123) #f))) ; an error in Guile ("Friends..." is applied to 123)
+;; if 123 -> quote, returns #t
+(let ((quote "Friends, Romans, countrymen")) (test 'x 'x))
+
+(test (let ((quote 32)) (+ quote 1)) 33)
+(test (let (' 32) (+ quote 1)) 'error)
+(test (let ((quote 32)) (define (f) (+ quote 1)) (f)) 33)
+(test (let ((quote 32)) (define (f z) (+ z 1)) (f quote)) 33)
+(test (let ((quote (lambda (x) (+ x 1)))) (quote 32)) 33)
+(test (let ((quote (lambda (x) (+ x 1)))) (define (f) (quote 32)) (f)) 33)
+(test (let ((quote (lambda (x) (+ x 1)))) (define (f) (do ((i 0 (+ i 1))) ((= i 1) (quote 32)))) (f)) 33)
+(test (let () (define (f) (let ((quote 32)) (+ quote 1))) (f)) 33)
+(test (let () (define (f) (let ((quote 32)) (+ quote 1))) (define (g) (f)) (g) (g)) 33)
+(test ((lambda (quote) (+ quote 1)) 32) 33)
+(test (let () (define quote 32) (+ quote 1)) 33)
+(test (apply quote '(33)) 33)
+(test (let ((quote length)) (apply quote (list (make-list 33 1)))) 33)
+(test (let () (+ (let () (define quote 32) quote) '1)) 33)
+
+(test (catch #t (lambda () ((lambda quote (abs (quote __a__))))) (lambda (type info) type)) 'unbound-variable)
+(test (catch #t (lambda () ((lambda quote (+ (quote __a__ 1))))) (lambda (type info) type)) 'unbound-variable)
+(test (catch #t (lambda () ((lambda quote (+ 1 (quote __a__))))) (lambda (type info) type)) 'unbound-variable)
+(test (catch #t (lambda () ((lambda quote (+ (quote __a__) (quote __a__))))) (lambda (type info) type)) 'unbound-variable)
+(test (catch #t (lambda () ((lambda quote (+ 1 (quote __a__) (quote __a__))))) (lambda (type info) type)) 'unbound-variable)
+(test (catch #t (lambda () ((lambda quote (+ 1 (quote __a__) 3)))) (lambda (type info) type)) 'unbound-variable)
+(test (catch #t (lambda () ((lambda quote (+ 1 2 (quote __a__) 3)))) (lambda (type info) type)) 'unbound-variable)
+(test (catch #t (lambda () ((lambda quote (vector (quote __a__) 1 2)))) (lambda (type info) type)) 'unbound-variable)
+(test (catch #t (lambda () ((lambda* 'x (abs (quote __a__))))) (lambda (type info) type)) 'syntax-error)
+(test (catch #t (lambda () ((lambda* 'x (+ (quote __a__) 1)))) (lambda (type info) type)) 'syntax-error)
+(test (catch #t (lambda () ((lambda* 'x (+ 1 (quote __a__))))) (lambda (type info) type)) 'syntax-error)
+(test (catch #t (lambda () ((lambda* 'x (vector (quote __a__) 1 2)))) (lambda (type info) type)) 'syntax-error)
+
+;(test (catch #t (lambda ()
+
+(test (call-with-exit (lambda* (quote value) (let ((i 32)) (set! (setter 'i) integer?) (curlet)) 100)) 100)
+(let () (define (func) (call-with-exit (lambda* (quote value) (let ((i 32)) (set! (setter (quote i)) integer?) (curlet)) 100))) (func) (test (func) 32))
+(test (cond (call-with-exit 32)) 32)
+(test ((lambda () ((let () cond) (call-with-exit 32)))) 32)
+
+;; error from unrecognized float-vector-set!
+(define fvset float-vector-set!)
+(define undef #<undefined>)
+(catch #t (lambda () (s7-optimize (list (catch #t (lambda () (with-input-from-string "(fvset undef 0 12345)" read)) (lambda args ()))))) (lambda arg 'error))
+(define htset hash-table-set!)
+(let ((a1 (immutable! (hash-table 'a 1))))
+  (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (htset a1 'asdf 32))) (func)) 'error))
+
+;;; these 4 lines go together
+(define-expansion (_mem2_ . args)
+  `(begin (format #f "~S~%" args) ((lambda (a b) ,@args) 1 3) ((lambda (a b) ,@args) 1 2) #f))
+(let ((args #(1 2))) (define (func) (_mem2_ 1 2)) (define (hi) (func)) (hi))
+(let ((args #(1 2))) (define (func) (_mem2_ 1 2)) (define (hi) (func)) (hi))
+
+(let ()
+  (define-macro (mc0 x) `(cond ((= ,x 0) 0) (else 1)))
+  (let ((else #f)) (test (mc0 1) #<unspecified>))
+  (define-macro (mc1 x) `(with-let (rootlet) (cond ((= ,x 0) 0) (else 1))))
+  (let ((else #f)) (test (mc1 1) 1))
+  (define-macro (mc2 x) `(with-let (unlet) (cond ((= ,x 0) 0) (else 1))))
+  (let ((else #f)) (test (mc2 1) 1))
+  (define-macro (mc3 x) `(with-let (inlet :y (+ y 1)) (cond ((= ,x 0) y) (else (+ y 1)))))
+  (let ((else #f) (y 2)) (test (mc3 1) 4))
+  (define-macro (mc4 x) `(#_cond ((#_= ,x 0) 0) (#_else 1)))
+  (let ((else #f)) (test (mc4 1) 1))
+  (test (let ((else 1)) #_else) :else) ; #t or :else = initial value, 'else = global_value
+  (test (let-temporarily ((else #f)) (mc1 1)) #<unspecified>) ; we set the global slot
+  (test (mc1 (let-temporarily ((else #f)) 1)) 1)
+  (test (let-temporarily ((else #f)) (mc4 1)) 1))
+
+(let ()
+  (define (cwv p c) (c (p)))
+  (cwv (lambda () #f) and)
+  (define (g) (sort! (make-vector 3) cwv))
+  (test (g) 'error)
+
+  (call-with-values (lambda () #f) and)
+  (define (f) (sort! (make-hash-table) call-with-values))
+  (test (f) 'error))
+
+(test (let () (define (f) (let ((apply cons)) (apply abs -1))) (f)) (cons abs -1))
+(let () ; s7.html examples
+  (define-macro (my-unless condition . body)
+   `(with-let (inlet (unlet) :condition ,condition) ; here unlet protects body (format below)
+      (if (not condition) (begin ,@body))))
+
+  (let ((not (lambda (x) x))
+        (begin 32)
+        (format abs))
+    (test (my-unless #t (format #f "oops")) #<unspecified>)
+    (test (my-unless #f (format #f "ok")) "ok"))
+
+  (let ((format abs))
+    (let ((not (lambda (x) x)))
+      (test (my-unless #t (format #f "oops")) #<unspecified>)
+      (test (my-unless #f (format #f "ok")) "ok")))
+
+  (define my-unless-2
+    (let ((op1 (lambda (x) (not x))))
+      (define-macro (_ condition . body)
+        `(with-let (inlet (unlet) (funclet my-unless-2) :condition ,condition) ; funclet to get my-unless-2's version of op1
+  	 (if (op1 condition) (begin ,@body))))))
+
+  (let ((op1 (lambda (x) x)))
+    (test (my-unless-2 #t (format #f "oops")) #<unspecified>)
+    (test (my-unless-2 #f (format #f "ok")) "ok"))
+
+  (define my-unless-3
+    (let ((op1 (lambda (x) x)))
+      (define-macro (_ condition . body)
+        `(with-let (inlet (unlet) :condition ,condition :local-env (curlet)) ; curlet to get local version of op1
+  	 (if ((with-let local-env op1) condition) (begin ,@body))))))
+
+  (let ((op1 (lambda (x) (not x))))
+    (test (my-unless-3 #t (format #f "oops")) #<unspecified>)
+    (test (my-unless-3 #f (format #f "ok")) "ok"))
+  )
+
+(test (map when (vector #f #t #f) (list 1 2 3)) '(#<unspecified> 2 #<unspecified>))
+;; (for-each with-let (list (inlet 'x 1) (inlet 'x 2)) (list '(display x) '(display x))): "12"
+
+
+;;; various ways to define an 'or' macro
+;;; too easy:
+;;; (define-macro (or1 . args) `(#_or ,@args))
+;;; (define or2 #_or)
+
+#|
+;;;    Clinger and Wand, "Hygienic Macro Technology" say this is "a perfectly reliable or macro":
+
+(define-syntax or (syntax-rules ()
+  ((or) #false)         ; #f
+  ((or ?e) ?e)
+  ((or ?e1 ?e2 ?e3 ...) ; ?e3 looks pointless to me (or even wrong -- what about the (or ?e1 ?e2) case?)
+   (let ((temp ?e1))
+     (if temp temp (or ?e2 ?e3 ...))))))
+
+;;; but how is that better than:
+
+(define-macro (or3 . args)
+  (and (not (null? args))
+       (let ((temp (gensym)))
+	 `(let ((,temp ,(car args)))
+	    (if ,temp ,temp (or3 ,@(cdr args)))))))
+
+;;; they say they want "automatic translation", but define-syntax defines its own (very special and tricky)
+;;;   language, where words like "identifier" have a meaning that is not that of Scheme, and utter
+;;;   kludges like "...".  I'm happier with code that is simply Scheme where I know what is happening
+;;;   as opposed to opaque renaming as in define-syntax where the developer of the syntax-* macros has
+;;;   to intuit what I want.  What if the top-level value of abs is not the built-in value?  What
+;;;   if a variable should be taken from a specific environment (i.e. it is not "free") that is not
+;;;   the top-level, the current, or the macro definition environment?  But the whole approach of syntax-* macros
+;;;   strikes me as funny: the problem is names; we'll fix that by conjuring up more names!
+;;;   Even C has dynamic loading, and in Scheme it's the norm; there's no notion of a "whole program"
+;;;   so how can they guarantee their conjured-up names won't become ambiguous?  Rather than going back to
+;;;   the start, they decided to include time-stamps ("wraps"?) and (I think) syntax-objects (I'm going by the
+;;;   article mentioned above), and more kludges like a list of "identifiers", and datum->syntax; their "automatic translation"
+;;;   is leaking at every pore.  To fix the original ambiguity, don't invent some write-only,
+;;;   intricate, special language; fix the ambiguity!  That is, either place the values (not
+;;;   the names) in the code tree, or include the environment (as a value, if necessary) and specify
+;;;   the variable name within that environment as a normal symbol.  See below for examples.
+;;;   The macros below are inspired by the "or" and "loop" macros in the article mentioned, and
+;;;   other random examples (the "local" and "global" example, etc).
+;;; currently s7 guarantees that the symbol returned by gensym is unique, but doesn't check for a subsequent
+;;;   explicit use of that symbol, even one that adds it to some other environment (thus making it ambiguous).
+;;;   The idea of gensym is that the user agrees not to deliberately use its style of names, so maybe this
+;;;   is not problematic -- at least the renaming is explicit.
+|#
+
+(let ((or7 (macro args
+	     (and (not (null? args))
+		  (let ((temp (gensym)))
+		    `(let ((,temp ,(car args)))
+		       (if ,temp ,temp (or7 ,@(cdr args))))))))
+      (or7-rd (macro (val)
+		(let ((temp (gensym)))
+		  `(let ((,temp ,val))
+		     (or7 (< ,temp 0) (> ,temp 100)))))))
+  (test (or7) #f)
+  (test (or7 (or7-rd 1)) #f)
+  (test (or7 (or7-rd -1)) #t)
+  (test (or7 (or7-rd 1) (or7-rd -1)) #t)
+  (test (or7 (or7-rd -1) (or7-rd 1)) #t))
+
+(let ((or6 32))
+  (let* ((e #f)
+	 (or6 (macro args
+	        (and (not (null? args))
+		     (let ((temp (gensym)))
+		       `(#_let ((,temp ,(car args)))
+			      (if ,temp ,temp ((,e 'or6) ,@(cdr args)))))))) ; or6 not defined yet, so use let-ref
+	 (or6-rd (macro (val)
+		   (let ((temp (gensym)))
+		     `(#_let ((,temp ,val))
+			     (,or6 (< ,temp 0) (> ,temp 100))))))) ;here or6 is defined so we can use "," directly
+    (set! e (curlet))
+
+    (let ((e 12))
+      (test (or6 (or6-rd -1) (or6-rd 1)) #t))
+    ;; (let (({gensym}-18 (or6-rd -1))) (if {gensym}-18 {gensym}-18 ((#1=(inlet 'or6-rd #<macro (val)>) 'or6) (or6-rd 1))))
+
+    (let ((or6 32)
+	  (let 1))
+      (test ((e 'or6)) #f)
+      (test ((e 'or6) (or6-rd 1)) #f)
+      (test ((e 'or6) (or6-rd -1)) #t)
+      (test ((e 'or6) (or6-rd 1) (or6-rd -1)) #t)
+      (test ((e 'or6) (or6-rd -1) (or6-rd 1)) #t))))
+
+(let ()
+  (define-macro (or4 . args)
+    (let ((e (#_curlet)))
+      (#_and (#_not (#_null? args))
+	     (#_let ((or4 (#_gensym))) ; local or4
+		    `(#_let ((,or4 ,(#_car args)))
+			    (#_if ,or4 ,or4 ((,e 'or4) ,@(#_cdr args))))))))
+
+  (define-macro (or4-rd val)
+    (let ((temp (gensym)))
+      `(let ((,temp ,val)
+	     (car 1)
+	     (cdr 2)
+	     (let 3)
+	     (and 4)
+	     (e 5))
+	 (or4 (< ,temp 0) (> ,temp 100)))))
+
+  (test (or4) #f)
+  (test (or4 (or4-rd 1)) #f)
+  (test (or4 (or4-rd 1) (or4-rd -1)) #t)
+  (test (or4 (or4-rd -1) (or4-rd 1)) #t))
+
+(let ((or8 32))
+  (let ((for8 (let* ((e #f)
+		     (or8 (macro args
+			    (and (not (null? args))
+				 (let ((temp (gensym)))
+				   `(let ((,temp ,(car args)))
+				      (if ,temp ,temp ((,e 'or8) ,@(cdr args)))))))))
+		(set! e (curlet))
+		(let ((or8 12))
+		  (lambda (val)
+		    ((e 'or8) (< val 0) (> val 100)))))))
+    (let ((or8 12))
+      (test (for8 1) #f)
+      (test (for8 -1) #t))))
+
+(let ((free-var #f))
+  (define-macro (mac1 val)
+    `(or ,val free-var))
+  (test (mac1 #f) #f)
+  (let ((free-var #t))
+    (test (mac1 #f) #t)))
+
+(let ()  ; while loop with exit and continue (from stuff.scm)
+  (define-macro (while test . body)
+    (let ((loop (gensym)))
+      `(#_call-with-exit
+         (#_lambda (exit)
+           (#_let ,loop ()
+	     (#_call-with-exit
+	      (#_lambda (continue)
+	        (#_do ()
+	              ((#_not ,test) (exit))
+	          ,@body)))
+	     (,loop))))))
+  (let ((i 0)
+        (j 0)
+	(loop 3))
+    (while (< i 5)
+      (set! i (+ i 1))
+      (when (> i 3) (exit))
+      (when (= i 2) (continue))
+      (set! loop 32)
+      (let ((k 0))
+	(while (< k 5)
+          (set! k (+ k 1))
+	  (when (> k 3) (exit))
+	  (when (= k 2) (continue))
+	  (set! j (+ j 1)))))
+
+    (test (list i j loop) '(4 4 32))
+    ))
+
+(let ((global 100))
+  (define-macro (tst x y)
+    (let ((local (gensym)))
+      `(let ((,local ,x))         ; arg 'x
+	 (+ ,global ,y ,local)))) ; definition-time 'global, arg 'y, local 'local
+   (let ((local 10)
+         (global 1000)
+         (x 10000))
+     (test (+ x (tst 1 local)) 10111)))
+
+(let ((mac (macro x `(+ ,@x 4))))
+  (test (macroexpand (mac 1 2 3)) '(+ 1 2 3 4))
+  (let ((list-values 'oops)
+	(apply-values 32)
+	(quote 12))
+    (test (object->string (procedure-source mac)) "(macro x (#_list-values '+ (#_apply-values x) 4))")
+    (test (mac 1 2 3) 10)))
+
+;; (curlet) is (rootlet) here
+(immutable! 'abs)
+(test (immutable? 'abs) #t)
+(test (with-let (rootlet) (immutable? 'abs)) #t)
+(test (set! abs 3) 'error)
+(test (with-let (rootlet) (define (abs x) 1)) 'error) ; here and below this check is confused by the test macro's local let
+(test (with-let (rootlet) (define-macro (abs x) 1)) 'error)
+(test (copy (inlet 'abs (lambda (x) 1)) (rootlet)) 'error) ; abs set immutable above
+(test (with-let (rootlet) (define abs (lambda (x) 1))) 'error)
+(test (with-let-(rootlet) (apply define (list 'abs 1))) 'error)
+(test (cutlet (rootlet) 'abs) 'error)
+(test (set! ((unlet) 'abs) 2) 'error)
+(test (let () (define + -) (with-let (unlet) (+ (openlet (unlet)) 2))) 'error)
+(test (varlet (rootlet) 'abs 1) 'error)
+(test (let-set! (rootlet) 'abs 3) 'error)
+(test (set! (with-let (rootlet) abs) 3) 'error)
+(test (cutlet (rootlet) 'abs) 'error)
+(test (cutlet (rootlet) 'cosh) (rootlet))
+(test ((rootlet) 'cosh) #<undefined>)
+(define cosh #_cosh)
+
+(when full-s7test
+  (let ((port (open-input-string (format #f "~W" (let->list (rootlet))))))
+    (let ((res (read port)))
+      (close-input-port port)
+      res))) ;read-error if string trouble
+
+#|
+;;; built-in C functions have an aggressive take
+;;; on "lexical scope": if gcd appears as the car of an expression in a function, and
+;;; at that point in the overall s7 process gcd has not been redefined, then the function
+;;; can embed the actual gcd function in that part of its source (as if it was (#_gcd ...)).
+;;; Hence a subsequent (set! gcd +) has no effect on any call that lexically (textually)
+;;; preceded that set!.  This is different from the handling of scheme-defined functions
+;;; where (define (a) 0) (define (b) (a)) (define (c) 1) (set! a c) (b) -> 1.
+;;; The decision as to when to replace the 'gcd with the gcd function is up to the optimizer, so
+;;; consistency here is considered of no importance compared to speed -- either don't (set! gcd +)
+;;; or do it before using gcd in any way.
+
+(test (let ()
+	(define (gset-test)
+	  (let-temporarily ((gcd +))
+	    (do ((sum 0)
+		 (x 12)
+		 (y 4)
+		 (i 0 (+ i 1)))
+		((= i 3)
+		 sum)
+	      (set! sum (+ sum (gcd x y)))
+	      (set! gcd +))))
+	(define (gset-test-1) (gset-test))
+	(gset-test-1))
+      36 or 12 -- who knows)
+
+(let ()
+  (define %gcd gcd)
+  (define (gset-test-x)
+    (let ((sum 0)
+	  (x 12)
+	  (y 4))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) sum)
+	(set! sum (+ sum (%gcd x y))))))
+  (define (gset-test-1x) (gset-test-x))
+
+  (define (gset-test-a)
+    (let ((sum 0)
+	  (x 12)
+	  (y 4))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) sum)
+	(set! sum (+ sum (gcd x y))))))
+  (define (gset-test-1a) (gset-test-a))
+
+  (define (gset-test-b)
+    (let ((sum 0)
+	  (x 12)
+	  (y 4))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) sum)
+	(set! sum (+ sum (gcd x y)))
+	(set! gcd +))))
+  (define (gset-test-1b) (gset-test-b))
+
+  (define (gset-test-c)
+    (let ((sum 0)
+	  (x 12)
+	  (y 4))
+      (do ((i 0 (+ i 1)))
+	  ((= i 3) sum)
+	(set! sum (+ sum (gcd x y))))))
+  (define (gset-test-1c) (gset-test-c))
+
+  (let* ((x (gset-test-1x))
+	 (a (gset-test-1a))
+	 (b (gset-test-1b))
+	 (c (gset-test-1c))
+	 (a (gset-test-1a)))
+    (set! %gcd +)
+    (let ((xx (gset-test-1x)))
+      (display (list x a b c a xx))
+      (newline))))
+
+
+;;; s7:    12 12 12 12 12 12 12
+;;; guile: 12 12 36 48 48 12 48
+|#
+
+;;; --------------------------------------------------------------------------------
+
+(when full-s7test
+  (set! + #_+) ; could be - in some cases when we get here
+  ;; here's a reasonably complete test of part of the 'or handling
+  (let ((ops #(not = null? eof-object? boolean? eq? eqv? equal? memq memv member char=? string=? char-ci=? string-ci=? zero?))
+	(op-args #(2 3 2 2 2 3 3 3 3 3 3 3 3 3 3 2))
+	(xvals #(0 10000 1.0 10000.0 1+i 1/2 #\a #\A "a" "A" "" #() #(#f) #<eof> () #f #t a b (1 10000)))
+	(yvals #(0 10000 1.0 10000.0 1+i 1/2 #\a #\A "a" "A" "" #() #(#f) #<eof> () #f #t a b (1 10000)))
+	;; val list must be repeated else we'll get bogus eq? -> #t hits
+	(val-quoted #(#f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #t #t #t)))
+    (for-each
+     (lambda (t1 t1-args)
+       (for-each
+	(lambda (t2 t2-args)
+	  (for-each
+	   (lambda (x)
+	     (for-each
+	      (lambda (y q)
+		(catch #t
+		  (lambda ()
+		    (let ((f1 (if (= t1-args 2) `(,t1 x) (if q `(,t1 x ',y) `(,t1 x ,y))))
+			  (f2 (if (= t2-args 2) `(,t2 x) (if q `(,t2 x ',y) `(,t2 x ,y))))
+			  (x1 (if q `(x ',x) `(x ,x))))
+		      (let ((result (eval `(let (,x1) (or ,f1 ,f2))))) ; check for errors in basic expr
+			(let ((val (call-with-output-string
+				    (lambda (op)
+				      (call-with-input-string (format #f "(let (~S) (or ~S ~S))" x1 f1 f2)
+					(lambda (ip)
+					  (lint ip op)))))))
+			  (when (positive? (length val))
+			    (let ((pos (and (not (string-position "let: " val)) ; ignore various eqx problems that lint will report
+					    (string-position " -> " val))))
+			      (when pos
+				(let ((form (with-input-from-string (substring val (+ pos 3)) read)))
+				  (let ((new-val (eval form)))
+				    (when (not (eq? (not result) (not new-val)))
+				      (format *stderr* "(let (~S) (or ~S ~S)) -> ~S~%  ~A -> ~S~%"
+					      x1 f1 f2 result
+					      (substring val (+ pos 3)) new-val)))))))))))
+		  (lambda (type info)
+		    'error)))
+	      yvals val-quoted))
+	   xvals))
+	ops op-args))
+     ops op-args)))
+
+(unless (defined? 'aux-counter)
+  ;; these confuse t101.scm test suite do loops using +
+  (let ((old+ +))
+    (define (f x) (with-let (unlet) (+ x 1)))
+    (set! + -)
+    (test (+ 1 1) 0)
+    (test (f 1) 2)
+    (set! + old+))
+
+  (let ((old+ +))
+    (let ((f #f))
+      (let ((+ -))
+        (set! f (lambda (a) (+ 1 a))))
+      (test (f 2) -1)
+      (set! + *)
+      (test (f 2) -1)
+      (set! + old+)))
+
+  ;(display integer?) (newline) (display (eq? integer? #_integer?)) (newline) ; integer? #t
+  ;(let () (define (func1) (let ((+ -)) (with-let (curlet) (integer? (+))))) 'error) ; "-: not enough arguments"
+  ;(let () (define (func2) (let ((+ -)) (with-let (curlet) (#_integer? (+))))) (test (func2) #t)) ; this looks like a bug
+  ;; see s7.c ca 73050 -- this has a big effect on tall/snd-test etc -- need to track where it affects +->local
+  )
+
+#|
+(define (mu) ; infinite loop if bignums
+  (let* ((x 1)
+	 (xp (+ x 1)))
+    (do ()
+	((<= xp 1) (list (* 2 x) (* 2.0 x)))
+      (set! x (/ x 2))
+      (set! xp (+ x 1)))))
+
+; (1/1152921504606846976 8.673617379884e-19)
+
+smallest positive normalized fp	2-1022 = 2.225 10-308
+largest normalized fp  2+1023 (2 - 2-52) 2+1024 - 2+971 = 1.798 10+308
+smallest positive denormal  2-1023 2-52	 2-1075 = 2.470 10-324
+largest denormal  2-1023 (1 - 2-52)	 2-1023 - 2-1075 = 1.113 10-308
+largest fp integer	 2+1024 - 2+971 = 1.798 10+308
+gap from largest fp integer to previous fp integer	2+971 = 1.996 10+292
+largest fp integer with a predecessor	2+53 - 1 = 9,007,199,254,740,991
+
+#x7ff0000000000000 +inf
+#xfff0000000000000 -inf
+#x7ff8000000000000 nan
+#xfff8000000000000 -nan
+
+;; this works but has the same results as (let () (load "s7test.scm" (curlet)))
+;;  some minor (*function* (curlet)) mis-assumption at 27547
+(let ()
+  (call-with-input-file "s7test.scm"
+     (lambda (p)
+       (do ((form (read p) (read p)))
+	   ((eq? form #<eof>))
+	 (eval form)))))
+
+(when full-s7test
+  (for-each
+   (lambda (s)
+     (if (and (setter s)
+              (not (char=? #\* ((symbol->string s) 0))))
+	 (format *stderr* "~A " s)))
+   (symbol-table))
+
+  (for-each
+   (lambda (s)
+     (if (and (procedure? (symbol->value s))
+              (let ((p (signature (symbol->value s))))
+                (and (pair? p) (pair? (car p)) (memq 'boolean? (car p)))))
+	 (format *stderr* "~A " s)))
+   (symbol-table))
+
+(for-each
+ (lambda (s)
+   (if (and (dilambda? (symbol->value s))
+	    (defined? (symbol "*" (symbol->string s) "*")))
+       (format *stderr* "~A " s)))
+ (symbol-table))
+
+(let ((vars (make-vector 32 0)))
+  (for-each
+   (lambda (s)
+     (let ((len (min (length (symbol->string s)) 31)))
+       (set! (vars len) (+ (vars len) 1))))
+   (symbol-table))
+  (do ((i 0 (+ i 1)))
+      ((= i 32))
+    (format *stderr* "~D: ~D~%" i (vars i))))
+
+(let ((st (symbol-table)))
+  (for-each
+   (lambda (s)
+     (if (and (keyword? s)
+	      (not (eq? s (symbol->value s))))
+	 (format *stderr* "~S: ~S~%" s (symbol->value s))))
+   st))
+|#
+
+(if (provided? 'debugging)
+    (format #t "~%;all done! (debugging flag is on)~%")
+    (format #t "~%;all done!~%"))
+
+;(close-output-port error-port)
+
+(when (> (*s7* 'profile) 0)
+  (set! (profile-port) *stderr*)
+  (show-profile 200))
+
+(when (provided? 'debugging)
+  ;(define full-s7test #t)
+
+  (when full-s7test ; show memory usage
+    (do ((x 0.0) (i 0 (+ i 1))) ((= i 256)) (set! x (complex i i))) ; clear temps
+    (gc) (gc)
+    (set! (current-output-port) *stdout*)
+    (set! (*s7* 'safety) 1)
+    ;; (display (*s7* 'memory-usage)) (newline)
+    (pretty-print (*s7* 'memory-usage) *stderr*)
+    (newline))
+
+  (when full-s7test ; analyze some type (35=input-string-port)
+    (do ((x 0.0) (i 0 (+ i 1))) ((= i 256)) (set! x (complex i i))) ; clear temps
+    (gc) (gc)
+    (set! (current-output-port) *stdout*)
+    (set! (*s7* 'safety) 1)
+    (heap-analyze)
+    (heap-scan 34))) ; 34=output port, 19-string 33=c-pointer, 35=input port
+
+;; finally make *features* circular
+(let ((old-features (copy *features*)))
+  (set-cdr! *features* *features*)
+  (provide 'xyz)
+  (provided? 'xyz)
+  (test (provided? 'xyz) #t)
+  (set! *features* old-features))
+
+(if s7test-exits (exit))
+
+
+#|
+;; here's a C program that checks that (exit) calls dynamic-wind "after" funcs and atexit C funcs:
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <unistd.h>
+#include "s7.h"
+static void bye(void) {fprintf(stderr, "all done\n");}
+int main(void)
+{
+  s7_scheme *sc = s7_init();
+  atexit(bye);
+  s7_eval_c_string(sc, "(dynamic-wind \
+                          (lambda () (display 'init) (newline)) \
+                          (lambda () (display 'exit) (newline) (exit #t)) \
+                          (lambda () (display 'quit) (newline)))");
+}
+/* gcc -o exiter exit.c s7.o -Wl,-export-dynamic -lm -I. -ldl */
+|#
diff --git a/s7/s7webserver/Makefile b/s7/s7webserver/Makefile
new file mode 100644
index 0000000..910ee40
--- /dev/null
+++ b/s7/s7webserver/Makefile
@@ -0,0 +1,42 @@
+# QTVERSION can also be set to 4
+QTVERSION=5
+
+CC ?= gcc
+CCC ?= g++
+PKG ?= pkg-config
+MOC ?= moc #-qt$(QTVERSION)
+QMAKE ?= qmake #-qt$(QTVERSION)
+
+QTLDFLAGS=`$(PKG) --libs Qt$(QTVERSION)Network`
+QTCFLAGS=`$(PKG) --cflags Qt$(QTVERSION)Network`
+
+OPTIMIZE=-O2
+
+all: s7webserver
+
+clean:
+	rm -fr *.o mus-config.h master.tar.gz qhttpserver-master.tar.gz qhttpserver-master s7webserver moc_s7webserver.cpp
+
+s7webserver: s7webserver.o qhttpserver-master/lib/libqhttpserver.a s7.o mus-config.h
+	$(CCC) s7webserver.o $(QTLDFLAGS) qhttpserver-master/lib/libqhttpserver.a s7.o -ldl -o s7webserver
+
+s7webserver.o: s7webserver.h s7webserver.cpp moc_s7webserver.cpp qhttpserver-master/lib/libqhttpserver.a mus-config.h
+	$(CCC) -c s7webserver.cpp $(QTCFLAGS) $(OPTIMIZE) -Iqhttpserver-master/src -I. -I.. -Wall -Werror -Wno-error=unused-variable -Wno-error=unused-function -fPIC
+
+moc_s7webserver.cpp: s7webserver.h qhttpserver-master/lib/libqhttpserver.a mus-config.h
+	$(MOC) -DCOMPILING_S7WEBSERVER s7webserver.h -o moc_s7webserver.cpp
+
+s7.o: ../s7.c ../s7.h mus-config.h
+	$(CC) -c ../s7.c $(OPTIMIZE) -I. -I..
+
+mus-config.h:
+	touch mus-config.h
+
+qhttpserver-master/lib/libqhttpserver.a:
+	rm -fr qhttpserver-master.tar.gz qhttpserver-master
+	wget https://github.com/kmatheussen/qhttpserver/archive/master.tar.gz
+	mv master.tar.gz qhttpserver-master.tar.gz
+	tar xvzf qhttpserver-master.tar.gz
+	echo "CONFIG += staticlib" >> qhttpserver-master/src/src.pro
+	cd qhttpserver-master && $(QMAKE)
+	cd qhttpserver-master && make
diff --git a/s7/s7webserver/README b/s7/s7webserver/README
new file mode 100644
index 0000000..b028095
--- /dev/null
+++ b/s7/s7webserver/README
@@ -0,0 +1,53 @@
+Quick start
+===========
+
+make
+./s7webserver -verbose
+
+Then you can either access it by opening s7webserver_repl.html in a browser,
+or run the s7webserver_repl.py script.
+  
+s7webserver uses qhttpserver, written by Nikhil Marathe:
+https://github.com/kmatheussen/qhttpserver/archive/master.tar.gz
+This package is automatically downloaded and compiled when writing "make".
+
+
+
+Some ways to access the server
+==============================
+
+* Using curl:
+curl -i -X POST -H "Content-Type: text/plain" -d '(display 50)' http://localhost:6080
+
+* Using s7webserver_repl.py:
+./s7webserver_repl.py
+
+* Using a browser:
+firefox s7webserver_repl.html
+
+
+
+The C API
+=========
+
+if you want to include s7webserver in your own program (see s7webserver.h):
+
+  s7webserver *s7webserver_create(s7_scheme *s7, int portnum, bool find_first_free_portnum);
+    
+  void s7webserver_call_very_often(void);  // Should be called approx. 20 times per second in non-qt programs.
+  
+  void s7webserver_set_verbose(s7webserver *s7server, bool verbose);
+    
+  void s7webserver_set_very_verbose(s7webserver *s7webserver, bool very_verbose);
+  
+  int s7webserver_get_portnumber(s7webserver *s7webserver);
+    
+  void s7webserver_delete(s7webserver *s7server);
+
+
+
+CREDITS
+=======
+s7: Bill Schottstaedt: bil@ccrma.stanford.edu
+s7webserver: Kjetil Matheussen: k.s.matheussen@notam02.no
+
diff --git a/s7/s7webserver/jqconsole.min.js b/s7/s7webserver/jqconsole.min.js
new file mode 100644
index 0000000..107e23d
--- /dev/null
+++ b/s7/s7webserver/jqconsole.min.js
@@ -0,0 +1 @@
+(function(){var t,e,i,s,r,o,n,h,p,c,a,l,u,_,f,m,d,$,y,v,g,x,b,k,w,C,T,S,M,P,H,E,L,I,W,D,A,R=function(t,e){return function(){return t.apply(e,arguments)}},U=[].slice;t=jQuery;I=0;W=1;D=2;w=13;H=9;x=46;g=8;T=37;P=39;E=38;b=40;C=36;k=35;M=33;S=34;p="jqconsole-";r=""+p+"cursor";o=""+p+"header";c=""+p+"prompt";h=""+p+"old-prompt";n=""+p+"input";s=""+p+"blurred";y="keypress";m="<span/>";_="<div/>";f=":empty";L="\n";u=">>> ";l="... ";a=2;i=""+p+"ansi-";d="";$=/\[(\d*)(?:;(\d*))*m/;e=function(){t.prototype.COLORS=["black","red","green","yellow","blue","magenta","cyan","white"];function t(){this.stylize=R(this.stylize,this);this._closeSpan=R(this._closeSpan,this);this._openSpan=R(this._openSpan,this);this.getClasses=R(this.getClasses,this);this._style=R(this._style,this);this._color=R(this._color,this);this._remove=R(this._remove,this);this._append=R(this._append,this);this.klasses=[]}t.prototype._append=function(t){t=""+i+t;if(this.klasses.indexOf(t)===-1){return this.klasses.push(t)}};t.prototype._remove=function(){var t,e,s,r,o,n;s=1<=arguments.length?U.call(arguments,0):[];n=[];for(r=0,o=s.length;r<o;r++){e=s[r];if(e==="fonts"||e==="color"||e==="background-color"){n.push(this.klasses=function(){var s,r,o,n;o=this.klasses;n=[];for(s=0,r=o.length;s<r;s++){t=o[s];if(t.indexOf(e)!==i.length){n.push(t)}}return n}.call(this))}else{e=""+i+e;n.push(this.klasses=function(){var i,s,r,o;r=this.klasses;o=[];for(i=0,s=r.length;i<s;i++){t=r[i];if(t!==e){o.push(t)}}return o}.call(this))}}return n};t.prototype._color=function(t){return this.COLORS[t]};t.prototype._style=function(t){if(t===""){t=0}t=parseInt(t);if(isNaN(t)){return}switch(t){case 0:return this.klasses=[];case 1:return this._append("bold");case 2:return this._append("lighter");case 3:return this._append("italic");case 4:return this._append("underline");case 5:return this._append("blink");case 6:return this._append("blink-rapid");case 8:return this._append("hidden");case 9:return this._append("line-through");case 10:return this._remove("fonts");case 11:case 12:case 13:case 14:case 15:case 16:case 17:case 18:case 19:this._remove("fonts");return this._append("fonts-"+(t-10));case 20:return this._append("fraktur");case 21:return this._remove("bold","lighter");case 22:return this._remove("bold","lighter");case 23:return this._remove("italic","fraktur");case 24:return this._remove("underline");case 25:return this._remove("blink","blink-rapid");case 28:return this._remove("hidden");case 29:return this._remove("line-through");case 30:case 31:case 32:case 33:case 34:case 35:case 36:case 37:this._remove("color");return this._append("color-"+this._color(t-30));case 39:return this._remove("color");case 40:case 41:case 42:case 43:case 44:case 45:case 46:case 47:this._remove("background-color");return this._append("background-color-"+this._color(t-40));case 49:return this._remove("background-color");case 51:return this._append("framed");case 53:return this._append("overline");case 54:return this._remove("framed");case 55:return this._remove("overline")}};t.prototype.getClasses=function(){return this.klasses.join(" ")};t.prototype._openSpan=function(t){return'<span class="'+this.getClasses()+'">'+t};t.prototype._closeSpan=function(t){return""+t+"</span>"};t.prototype.stylize=function(t){var e,i,s,r,o,n;t=this._openSpan(t);s=0;while((s=t.indexOf(d,s))&&s!==-1){if(i=t.slice(s).match($)){n=i.slice(1);for(r=0,o=n.length;r<o;r++){e=n[r];this._style(e)}t=this._closeSpan(t.slice(0,s))+this._openSpan(t.slice(s+1+i[0].length))}else{s++}}return this._closeSpan(t)};return t}();A=function(t,e){return'<span class="'+t+'">'+(e||"")+"</span>"};v=function(){function i(i,s,r,n){this._HideComposition=R(this._HideComposition,this);this._ShowComposition=R(this._ShowComposition,this);this._UpdateComposition=R(this._UpdateComposition,this);this._EndComposition=R(this._EndComposition,this);this._StartComposition=R(this._StartComposition,this);this._CheckComposition=R(this._CheckComposition,this);this._ProcessMatch=R(this._ProcessMatch,this);this._HandleKey=R(this._HandleKey,this);this._HandleChar=R(this._HandleChar,this);this.isMobile=!!navigator.userAgent.match(/iPhone|iPad|iPod|Android/i);this.isIos=!!navigator.userAgent.match(/iPhone|iPad|iPod/i);this.isAndroid=!!navigator.userAgent.match(/Android/i);this.$window=t(window);this.header=s||"";this.prompt_label_main=typeof r==="string"?r:u;this.prompt_label_continue=n||l;this.indent_width=a;this.state=W;this.input_queue=[];this.input_callback=null;this.multiline_callback=null;this.history=[];this.history_index=0;this.history_new="";this.history_active=false;this.shortcuts={};this.$container=t("<div/>").appendTo(i);this.$container.css({top:0,left:0,right:0,bottom:0,position:"absolute",overflow:"auto"});this.$console=t('<pre class="jqconsole"/>').appendTo(this.$container);this.$console.css({margin:0,position:"relative","min-height":"100%","box-sizing":"border-box","-moz-box-sizing":"border-box","-webkit-box-sizing":"border-box"});this.$console_focused=true;this.$input_container=t(_).appendTo(this.$container);this.$input_container.css({position:"absolute",width:1,height:0,overflow:"hidden"});this.$input_source=this.isAndroid?t("<input/>"):t("<textarea/>");this.$input_source.attr({wrap:"off",autocapitalize:"off",autocorrect:"off",spellcheck:"false",autocomplete:"off"});this.$input_source.css({position:"absolute",width:2});this.$input_source.appendTo(this.$input_container);this.$composition=t(_);this.$composition.addClass(""+p+"composition");this.$composition.css({display:"inline",position:"relative"});this.matchings={openings:{},closings:{},clss:[]};this.ansi=new e;this._InitPrompt();this._SetupEvents();this.Write(this.header,o);t(i).data("jqconsole",this)}i.prototype.ResetHistory=function(){return this.SetHistory([])};i.prototype.ResetShortcuts=function(){return this.shortcuts={}};i.prototype.ResetMatchings=function(){return this.matchings={openings:{},closings:{},clss:[]}};i.prototype.Reset=function(){if(this.state!==W){this.ClearPromptText(true)}this.state=W;this.input_queue=[];this.input_callback=null;this.multiline_callback=null;this.ResetHistory();this.ResetShortcuts();this.ResetMatchings();this.$prompt.detach();this.$input_container.detach();this.$console.html("");this.$prompt.appendTo(this.$console);this.$input_container.appendTo(this.$container);this.Write(this.header,o);return void 0};i.prototype.GetHistory=function(){return this.history};i.prototype.SetHistory=function(t){this.history=t.slice();return this.history_index=this.history.length};i.prototype._CheckKeyCode=function(t){if(isNaN(t)){t=t.charCodeAt(0)}else{t=parseInt(t,10)}if(!(0<t&&t<256)||isNaN(t)){throw new Error("Key code must be a number between 0 and 256 exclusive.")}return t};i.prototype._LetterCaseHelper=function(t,e){e(t);if(65<=t&&t<=90){e(t+32)}if(97<=t&&t<=122){return e(t-32)}};i.prototype.RegisterShortcut=function(t,e){var i,s=this;t=this._CheckKeyCode(t);if(typeof e!=="function"){throw new Error("Callback must be a function, not "+e+".")}i=function(t){if(!(t in s.shortcuts)){s.shortcuts[t]=[]}return s.shortcuts[t].push(e)};this._LetterCaseHelper(t,i);return void 0};i.prototype.UnRegisterShortcut=function(t,e){var i,s=this;t=this._CheckKeyCode(t);i=function(t){if(t in s.shortcuts){if(e){return s.shortcuts[t].splice(s.shortcuts[t].indexOf(e),1)}else{return delete s.shortcuts[t]}}};this._LetterCaseHelper(t,i);return void 0};i.prototype.GetColumn=function(){var t;this.$prompt_right.detach();this.$prompt_cursor.text("");t=this.$console.text().split(L);this.$prompt_cursor.html("&nbsp;");this.$prompt_cursor.after(this.$prompt_right);return t[t.length-1].length};i.prototype.GetLine=function(){return this.$console.text().split(L).length-1};i.prototype.ClearPromptText=function(t){if(this.state===W){throw new Error("ClearPromptText() is not allowed in output state.")}this.$prompt_before.html("");this.$prompt_after.html("");this.$prompt_label.text(t?"":this._SelectPromptLabel(false));this.$prompt_left.text("");this.$prompt_right.text("");return void 0};i.prototype.GetPromptText=function(e){var i,s,r,o,n;if(this.state===W){throw new Error("GetPromptText() is not allowed in output state.")}if(e){this.$prompt_cursor.text("");n=this.$prompt.text();this.$prompt_cursor.html("&nbsp;");return n}else{o=function(e){var i;i=[];e.children().each(function(){return i.push(t(this).children().last().text())});return i.join(L)};s=o(this.$prompt_before);if(s){s+=L}r=this.$prompt_left.text()+this.$prompt_right.text();i=o(this.$prompt_after);if(i){i=L+i}return s+r+i}};i.prototype.SetPromptText=function(t){if(this.state===W){throw new Error("SetPromptText() is not allowed in output state.")}this.ClearPromptText(false);this._AppendPromptText(t);this._ScrollToEnd();return void 0};i.prototype.SetPromptLabel=function(t,e){this.prompt_label_main=t;if(e!=null){this.prompt_label_continue=e}return void 0};i.prototype.Write=function(e,i,s){var r;if(s==null){s=true}if(s){e=this.ansi.stylize(t(m).text(e).html())}r=t(m).html(e);if(i!=null){r.addClass(i)}return this.Append(r)};i.prototype.Append=function(e){var i;i=t(e).insertBefore(this.$prompt);this._ScrollToEnd();this.$prompt_cursor.detach().insertAfter(this.$prompt_left);return i};i.prototype.Input=function(t){var e,i,s,r,o=this;if(this.state===D){s=this.input_callback;r=this.multiline_callback;i=this.history_active;e=this.async_multiline;this.AbortPrompt();this.input_queue.unshift(function(){return o.Prompt(i,s,r,e)})}else if(this.state!==W){this.input_queue.push(function(){return o.Input(t)});return}this.history_active=false;this.input_callback=t;this.multiline_callback=null;this.state=I;this.$prompt.attr("class",n);this.$prompt_label.text(this._SelectPromptLabel(false));this.Focus();this._ScrollToEnd();return void 0};i.prototype.Prompt=function(t,e,i,s){var r=this;if(this.state!==W){this.input_queue.push(function(){return r.Prompt(t,e,i,s)});return}this.history_active=t;this.input_callback=e;this.multiline_callback=i;this.async_multiline=s;this.state=D;this.$prompt.attr("class",c+" "+this.ansi.getClasses());this.$prompt_label.text(this._SelectPromptLabel(false));this.Focus();this._ScrollToEnd();return void 0};i.prototype.AbortPrompt=function(){if(this.state!==D){throw new Error("Cannot abort prompt when not in prompt state.")}this.Write(this.GetPromptText(true)+L,h);this.ClearPromptText(true);this.state=W;this.input_callback=this.multiline_callback=null;this._CheckInputQueue();return void 0};i.prototype.Focus=function(){if(!this.IsDisabled()){this.$input_source.focus()}return void 0};i.prototype.SetIndentWidth=function(t){return this.indent_width=t};i.prototype.GetIndentWidth=function(){return this.indent_width};i.prototype.RegisterMatching=function(t,e,i){var s;s={opening_char:t,closing_char:e,cls:i};this.matchings.clss.push(i);this.matchings.openings[t]=s;return this.matchings.closings[e]=s};i.prototype.UnRegisterMatching=function(t,e){var i;i=this.matchings.openings[t].cls;delete this.matchings.openings[t];delete this.matchings.closings[e];return this.matchings.clss.splice(this.matchings.clss.indexOf(i),1)};i.prototype.Dump=function(){var e,i;e=this.$console.find("."+o).nextUntil("."+c).addBack();return function(){var s,r,o;o=[];for(s=0,r=e.length;s<r;s++){i=e[s];if(t(i).is("."+h)){o.push(t(i).text().replace(/^\s+/,">>> "))}else{o.push(t(i).text())}}return o}().join("")};i.prototype.GetState=function(){if(this.state===I){return"input"}else if(this.state===W){return"output"}else{return"prompt"}};i.prototype.Disable=function(){this.$input_source.attr("disabled",true);return this.$input_source.blur()};i.prototype.Enable=function(){return this.$input_source.attr("disabled",false)};i.prototype.IsDisabled=function(){return Boolean(this.$input_source.attr("disabled"))};i.prototype.MoveToStart=function(t){this._MoveTo(t,true);return void 0};i.prototype.MoveToEnd=function(t){this._MoveTo(t,false);return void 0};i.prototype.Clear=function(){this.$console.find("."+o).nextUntil("."+c).addBack().text("");this.$prompt_cursor.detach();return this.$prompt_after.before(this.$prompt_cursor)};i.prototype._CheckInputQueue=function(){if(this.input_queue.length){return this.input_queue.shift()()}};i.prototype._InitPrompt=function(){this.$prompt=t(A(n)).appendTo(this.$console);this.$prompt_before=t(m).appendTo(this.$prompt);this.$prompt_current=t(m).appendTo(this.$prompt);this.$prompt_after=t(m).appendTo(this.$prompt);this.$prompt_label=t(m).appendTo(this.$prompt_current);this.$prompt_left=t(m).appendTo(this.$prompt_current);this.$prompt_right=t(m).appendTo(this.$prompt_current);this.$prompt_right.css({position:"relative"});this.$prompt_cursor=t(A(r,"&nbsp;"));this.$prompt_cursor.insertBefore(this.$prompt_right);this.$prompt_cursor.css({color:"transparent",display:"inline",zIndex:0});if(!this.isMobile){return this.$prompt_cursor.css("position","absolute")}};i.prototype._SetupEvents=function(){var t=this;if(this.isMobile){this.$console.click(function(e){e.preventDefault();return t.Focus()})}else{this.$console.mouseup(function(e){var i;if(e.which===2){return t.Focus()}else{i=function(){if(!window.getSelection().toString()){e.preventDefault();return t.Focus()}};return setTimeout(i,0)}})}this.$input_source.focus(function(){var e,i;t._ScrollToEnd();t.$console_focused=true;t.$console.removeClass(s);i=function(){if(t.$console_focused){return t.$console.removeClass(s)}};setTimeout(i,100);e=function(){if(t.isIos&&t.$console_focused){return t.$input_source.hide()}};return setTimeout(e,500)});this.$input_source.blur(function(){var e;t.$console_focused=false;if(t.isIos){t.$input_source.show()}e=function(){if(!t.$console_focused){return t.$console.addClass(s)}};return setTimeout(e,100)});this.$input_source.bind("paste",function(){var e;e=function(){if(t.in_composition){return}t._AppendPromptText(t.$input_source.val());t.$input_source.val("");return t.Focus()};return setTimeout(e,0)});this.$input_source.keypress(this._HandleChar);this.$input_source.keydown(this._HandleKey);this.$input_source.keydown(this._CheckComposition);this.$input_source.bind("compositionstart",this._StartComposition);this.$input_source.bind("compositionend",function(e){return setTimeout(function(){return t._EndComposition(e)},0)});if(this.isAndroid){this.$input_source.bind("input",this._StartComposition);return this.$input_source.bind("input",this._UpdateComposition)}else{return this.$input_source.bind("text",this._UpdateComposition)}};i.prototype._HandleChar=function(t){var e;if(this.state===W||t.metaKey||t.ctrlKey){return true}e=t.which;if(e===8||e===9||e===13){return false}this.$prompt_left.text(this.$prompt_left.text()+String.fromCharCode(e));this._ScrollToEnd();return false};i.prototype._HandleKey=function(e){var i;if(this.state===W){return true}i=e.keyCode||e.which;setTimeout(t.proxy(this._CheckMatchings,this),0);if(e.altKey){return true}else if(e.ctrlKey||e.metaKey){return this._HandleCtrlShortcut(i)}else if(e.shiftKey){switch(i){case w:this._HandleEnter(true);break;case H:this._Unindent();break;case E:this._MoveUp();break;case b:this._MoveDown();break;case M:this._ScrollPage("up");break;case S:this._ScrollPage("down");break;default:return true}return false}else{switch(i){case w:this._HandleEnter(false);break;case H:this._Indent();break;case x:this._Delete(false);break;case g:this._Backspace(false);break;case T:this._MoveLeft(false);break;case P:this._MoveRight(false);break;case E:this._HistoryPrevious();break;case b:this._HistoryNext();break;case C:this.MoveToStart(false);break;case k:this.MoveToEnd(false);break;case M:this._ScrollPage("up");break;case S:this._ScrollPage("down");break;default:return true}return false}};i.prototype._HandleCtrlShortcut=function(t){var e,i,s,r;switch(t){case x:this._Delete(true);break;case g:this._Backspace(true);break;case T:this._MoveLeft(true);break;case P:this._MoveRight(true);break;case E:this._MoveUp();break;case b:this._MoveDown();break;case k:this.MoveToEnd(true);break;case C:this.MoveToStart(true);break;default:if(t in this.shortcuts){r=this.shortcuts[t];for(i=0,s=r.length;i<s;i++){e=r[i];e.call(this)}return false}else{return true}}return false};i.prototype._HandleEnter=function(t){var e,i,s=this;this._EndComposition();if(t){return this._InsertNewLine(true)}else{i=this.GetPromptText();e=function(t){var e,r,o,n,h,c;if(t!==false){s.MoveToEnd(true);s._InsertNewLine(true);c=[];for(o=n=0,h=Math.abs(t);0<=h?n<h:n>h;o=0<=h?++n:--n){if(t>0){c.push(s._Indent())}else{c.push(s._Unindent())}}return c}else{r=s.state===I?"input":"prompt";s.Write(s.GetPromptText(true)+L,""+p+"old-"+r);s.ClearPromptText(true);if(s.history_active){if(!s.history.length||s.history[s.history.length-1]!==i){s.history.push(i)}s.history_index=s.history.length}s.state=W;e=s.input_callback;s.input_callback=null;if(e){e(i)}return s._CheckInputQueue()}};if(this.multiline_callback){if(this.async_multiline){return this.multiline_callback(i,e)}else{return e(this.multiline_callback(i))}}else{return e(false)}}};i.prototype._GetDirectionals=function(e){var i,s,r,o,n,h,p,c;o=e?this.$prompt_left:this.$prompt_right;i=e?this.$prompt_right:this.$prompt_left;r=e?this.$prompt_before:this.$prompt_after;s=e?this.$prompt_after:this.$prompt_before;h=e?t.proxy(this.MoveToStart,this):t.proxy(this.MoveToEnd,this);n=e?t.proxy(this._MoveLeft,this):t.proxy(this._MoveRight,this);c=e?"last":"first";p=e?"prependTo":"appendTo";return{$prompt_which:o,$prompt_opposite:i,$prompt_relative:r,$prompt_rel_opposite:s,MoveToLimit:h,MoveDirection:n,which_end:c,where_append:p}};i.prototype._VerticalMove=function(t){var e,i,s,r,o,n,h,p;p=this._GetDirectionals(t),s=p.$prompt_which,e=p.$prompt_opposite,i=p.$prompt_relative,o=p.MoveToLimit,r=p.MoveDirection;if(i.is(f)){return}n=this.$prompt_left.text().length;o();r();h=s.text();e.text(t?h.slice(n):h.slice(0,n));return s.text(t?h.slice(0,n):h.slice(n))};i.prototype._MoveUp=function(){return this._VerticalMove(true)};i.prototype._MoveDown=function(){return this._VerticalMove()};i.prototype._HorizontalMove=function(e,i){var s,r,o,n,h,p,c,a,l,u,_,d,$,y;y=this._GetDirectionals(i),h=y.$prompt_which,r=y.$prompt_opposite,n=y.$prompt_relative,o=y.$prompt_rel_opposite,d=y.which_end,_=y.where_append;a=i?/\w*\W*$/:/^\w*\W*/;l=h.text();if(l){if(e){$=l.match(a);if(!$){return}$=$[0];u=r.text();r.text(i?$+u:u+$);c=$.length;return h.text(i?l.slice(0,-c):l.slice(c))}else{u=r.text();r.text(i?l.slice(-1)+u:u+l[0]);return h.text(i?l.slice(0,-1):l.slice(1))}}else if(!n.is(f)){p=t(m)[_](o);p.append(t(m).text(this.$prompt_label.text()));p.append(t(m).text(r.text()));s=n.children()[d]().detach();this.$prompt_label.text(s.children().first().text());h.text(s.children().last().text());return r.text("")}};i.prototype._MoveLeft=function(t){return this._HorizontalMove(t,true)};i.prototype._MoveRight=function(t){return this._HorizontalMove(t)};i.prototype._MoveTo=function(t,e){var i,s,r,o,n,h,p;h=this._GetDirectionals(e),r=h.$prompt_which,i=h.$prompt_opposite,s=h.$prompt_relative,n=h.MoveToLimit,o=h.MoveDirection;if(t){p=[];while(!(s.is(f)&&r.text()==="")){n(false);p.push(o(false))}return p}else{i.text(this.$prompt_left.text()+this.$prompt_right.text());return r.text("")}};i.prototype._Delete=function(t){var e,i,s;i=this.$prompt_right.text();if(i){if(t){s=i.match(/^\w*\W*/);if(!s){return}s=s[0];return this.$prompt_right.text(i.slice(s.length))}else{return this.$prompt_right.text(i.slice(1))}}else if(!this.$prompt_after.is(f)){e=this.$prompt_after.children().first().detach();return this.$prompt_right.text(e.children().last().text())}};i.prototype._Backspace=function(e){var i,s,r;setTimeout(t.proxy(this._ScrollToEnd,this),0);s=this.$prompt_left.text();if(s){if(e){r=s.match(/\w*\W*$/);if(!r){return}r=r[0];return this.$prompt_left.text(s.slice(0,-r.length))}else{return this.$prompt_left.text(s.slice(0,-1))}}else if(!this.$prompt_before.is(f)){i=this.$prompt_before.children().last().detach();this.$prompt_label.text(i.children().first().text());return this.$prompt_left.text(i.children().last().text())}};i.prototype._Indent=function(){var t;return this.$prompt_left.prepend(function(){var e,i,s;s=[];for(t=e=1,i=this.indent_width;1<=i?e<=i:e>=i;t=1<=i?++e:--e){s.push(" ")}return s}.call(this).join(""))};i.prototype._Unindent=function(){var t,e,i,s,r;t=this.$prompt_left.text()+this.$prompt_right.text();r=[];for(e=i=1,s=this.indent_width;1<=s?i<=s:i>=s;e=1<=s?++i:--i){if(!/^ /.test(t)){break}if(this.$prompt_left.text()){this.$prompt_left.text(this.$prompt_left.text().slice(1))}else{this.$prompt_right.text(this.$prompt_right.text().slice(1))}r.push(t=t.slice(1))}return r};i.prototype._InsertNewLine=function(e){var i,s,r;if(e==null){e=false}r=this._SelectPromptLabel(!this.$prompt_before.is(f));i=t(m).appendTo(this.$prompt_before);i.append(t(m).text(r));i.append(t(m).text(this.$prompt_left.text()));this.$prompt_label.text(this._SelectPromptLabel(true));if(e&&(s=this.$prompt_left.text().match(/^\s+/))){this.$prompt_left.text(s[0])}else{this.$prompt_left.text("")}return this._ScrollToEnd()};i.prototype._AppendPromptText=function(t){var e,i,s,r,o,n;i=t.split(L);this.$prompt_left.text(this.$prompt_left.text()+i[0]);o=i.slice(1);n=[];for(s=0,r=o.length;s<r;s++){e=o[s];this._InsertNewLine();n.push(this.$prompt_left.text(e))}return n};i.prototype._ScrollPage=function(t){var e;e=this.$container[0].scrollTop;if(t==="up"){e-=this.$container.height()}else{e+=this.$container.height()}return this.$container.stop().animate({scrollTop:e},"fast")};i.prototype._ScrollToEnd=function(){var t;this.$container.scrollTop(this.$container[0].scrollHeight);t=this.$prompt_cursor.position();this.$input_container.css({left:t.left,top:t.top});return setTimeout(this.ScrollWindowToPrompt.bind(this),50)};i.prototype.ScrollWindowToPrompt=function(){var t,e,i,s,r,o;e=this.$prompt_cursor.height();o=this.$window.scrollTop();r=this.$window.scrollLeft();t=document.documentElement.clientHeight;s=this.$prompt_cursor.offset();i=s.top-2*e;if(this.isMobile&&(typeof orientation!=="undefined"&&orientation!==null)){if(o<s.top||o>s.top){return this.$window.scrollTop(i)}}else{if(o+t<s.top){return this.$window.scrollTop(s.top-t+e)}else if(o>i){return this.$window.scrollTop(s.top)}}};i.prototype._SelectPromptLabel=function(t){if(this.state===D){if(t){return" \n"+this.prompt_label_continue}else{return this.prompt_label_main}}else{if(t){return"\n "}else{return" "}}};i.prototype._Wrap=function(t,e,i){var s,r;r=t.html();s=r.slice(0,e)+A(i,r[e])+r.slice(e+1);return t.html(s)};i.prototype._WalkCharacters=function(t,e,i,s,r){var o,n,h;n=r?t.length:0;t=t.split("");h=function(){var e,i,s,o;if(r){s=t,t=2<=s.length?U.call(s,0,i=s.length-1):(i=0,[]),e=s[i++]}else{o=t,e=o[0],t=2<=o.length?U.call(o,1):[]}if(e){n=n+(r?-1:+1)}return e};while(o=h()){if(o===e){s++}else if(o===i){s--}if(s===0){return{index:n,current_count:s}}}return{index:-1,current_count:s}};i.prototype._ProcessMatch=function(e,i,s){var r,o,n,h,p,c,a,l,u,_,f,m,d=this;_=i?[e["closing_char"],e["opening_char"]]:[e["opening_char"],e["closing_char"]],h=_[0],l=_[1];f=this._GetDirectionals(i),n=f.$prompt_which,o=f.$prompt_relative;p=1;c=false;u=n.html();if(!i){u=u.slice(1)}if(s&&i){u=u.slice(0,-1)}m=this._WalkCharacters(u,h,l,p,i),a=m.index,p=m.current_count;if(a>-1){this._Wrap(n,a,e.cls);c=true}else{r=o.children();r=i?Array.prototype.reverse.call(r):r;r.each(function(s,r){var o,n;o=t(r).children().last();u=o.html();n=d._WalkCharacters(u,h,l,p,i),a=n.index,p=n.current_count;if(a>-1){if(!i){a--}d._Wrap(o,a,e.cls);c=true;return false}})}return c};i.prototype._CheckMatchings=function(e){var i,s,r,o,n,h,p;r=e?this.$prompt_left.text().slice(this.$prompt_left.text().length-1):this.$prompt_right.text()[0];p=this.matchings.clss;for(n=0,h=p.length;n<h;n++){i=p[n];t("."+i,this.$console).contents().unwrap()}if(s=this.matchings.closings[r]){o=this._ProcessMatch(s,true,e)}else if(s=this.matchings.openings[r]){o=this._ProcessMatch(s,false,e)}else if(!e){this._CheckMatchings(true)}if(e){if(o){return this._Wrap(this.$prompt_left,this.$prompt_left.html().length-1,s.cls)}}else{if(o){return this._Wrap(this.$prompt_right,0,s.cls)}}};i.prototype._HistoryPrevious=function(){if(!this.history_active){return}if(this.history_index<=0){return}if(this.history_index===this.history.length){this.history_new=this.GetPromptText()}return this.SetPromptText(this.history[--this.history_index])};i.prototype._HistoryNext=function(){if(!this.history_active){return}if(this.history_index>=this.history.length){return}if(this.history_index===this.history.length-1){this.history_index++;return this.SetPromptText(this.history_new)}else{return this.SetPromptText(this.history[++this.history_index])}};i.prototype._CheckComposition=function(t){var e;e=t.keyCode||t.which;if(e===229){if(this.in_composition){return this._UpdateComposition()}else{return this._StartComposition()}}};i.prototype._StartComposition=function(){if(this.in_composition){return}this.in_composition=true;this._ShowComposition();return setTimeout(this._UpdateComposition,0)};i.prototype._EndComposition=function(){if(!this.in_composition){return}this._HideComposition();this.$prompt_left.text(this.$prompt_left.text()+this.$composition.text());this.$composition.text("");this.$input_source.val("");return this.in_composition=false};i.prototype._UpdateComposition=function(t){var e,i=this;e=function(){if(!i.in_composition){return}return i.$composition.text(i.$input_source.val())};return setTimeout(e,0)};i.prototype._ShowComposition=function(){this.$composition.css("height",this.$prompt_cursor.height());this.$composition.empty();return this.$composition.appendTo(this.$prompt_left)};i.prototype._HideComposition=function(){return this.$composition.detach()};return i}();t.fn.jqconsole=function(t,e,i){return new v(this,t,e,i)};t.fn.jqconsole.JQConsole=v;t.fn.jqconsole.Ansi=e}).call(this);
\ No newline at end of file
diff --git a/s7/s7webserver/s7webserver.cpp b/s7/s7webserver/s7webserver.cpp
new file mode 100644
index 0000000..84a3914
--- /dev/null
+++ b/s7/s7webserver/s7webserver.cpp
@@ -0,0 +1,338 @@
+/*
+  Written by Kjetil Matheussen: k.s.matheussen@notam02.no
+
+  See s7webserver.h for instructions on how to compile the server.
+*/
+
+
+#include <unistd.h>
+
+#include "s7.h"
+
+#define COMPILING_S7WEBSERVER 1
+#include "s7webserver.h"
+#include "moc_s7webserver.cpp"
+
+#include <QCoreApplication>
+
+#include <qhttpserver.h>
+#include <qhttprequest.h>
+#include <qhttpresponse.h>
+
+
+S7WebServer::S7WebServer(s7_scheme *s7, int portnumber)
+  : s7(s7)
+  , portnumber(portnumber)
+  , verbose(false)
+  , very_verbose(false)
+{
+  QHttpServer *server = new QHttpServer(this);
+  connect(server, SIGNAL(newRequest(QHttpRequest*, QHttpResponse*)),
+          this, SLOT(handleRequest(QHttpRequest*, QHttpResponse*)));
+  
+  has_started = server->listen(QHostAddress::Any, portnumber);
+}
+
+
+void S7WebServer::handleRequest(QHttpRequest *req, QHttpResponse *resp)
+{
+  new S7WebServerResponder(this, req, resp);
+}
+
+
+// function written by Rick Taube for common music (https://ccrma.stanford.edu/software/snd/snd/s7.html#repl)
+static bool is_balanced(std::string str)
+{
+  int parens = 0;
+  int quotes = 0;
+  unsigned i = 0;
+  while (i < str.size())
+    {
+      if (str[i] == ';')
+	{
+	  for (i = i + 1; i < str.size(); i++)
+	    {
+	      if (str[i] == '\n')
+		break;
+	    }
+	}
+      else if (str[i] == '"')
+	{
+	  if (i == 0 || str[i - 1] != '\\')
+	    {
+	      quotes = 1;
+	      for (i = i + 1; i < str.size(); i++)
+		{
+		  if (str[i] == '"' && str[i - 1] != '\\')
+		    {
+		      quotes = 0;
+		      break;
+		    }
+		}
+	      if (quotes)
+		return false;
+	    }
+	}
+      else if (str[i] == '(')
+	parens++;
+      else if (str[i] == ')')
+	parens--;
+      i++;
+    }
+  return (parens == 0) && (quotes == 0);
+}
+
+
+// function written by Rick Taube for common music (https://ccrma.stanford.edu/software/snd/snd/s7.html#repl)
+static bool is_white(std::string str)
+{
+  for (unsigned i = 0; (i < str.size() && str[i] != ';'); i++)
+    if (str[i] != ' ' && str[i] != '\n' && str[i] != '\t')
+      return false;
+  return true;
+}
+
+
+S7WebServerResponder::S7WebServerResponder(S7WebServer *s7webserver, QHttpRequest *request, QHttpResponse *response)
+  : s7webserver(s7webserver)
+  , request(request)
+  , response(response)
+{
+  if (s7webserver->very_verbose)
+    printf("responder got something\n");
+  
+  response->setHeader("Content-Type", "text/plain");
+  response->setHeader("Access-Control-Allow-Origin", "*");
+
+  response->writeHead(200);
+  
+  connect(request, SIGNAL(data(const QByteArray&)), this, SLOT(accumulate(const QByteArray&)));
+  connect(request, SIGNAL(end()), this, SLOT(reply()));
+  connect(response, SIGNAL(done()), this, SLOT(deleteLater()));
+}
+
+
+void S7WebServerResponder::accumulate(const QByteArray &data)
+{
+  s7webserver->input_code_so_far += data.data();
+  if (s7webserver->very_verbose)
+    printf("code so far: %s\n",s7webserver->input_code_so_far.c_str());
+}
+
+
+static void my_print(s7_scheme *sc, unsigned char c, s7_pointer port)
+{
+  
+  S7WebServerResponder *current_responder = static_cast<S7WebServerResponder*>(s7_c_pointer(s7_name_to_value(sc, "s7webserver-current-responder")));
+
+  if (current_responder==NULL || current_responder->s7webserver->verbose)
+    putchar(c);
+
+  if (current_responder != NULL) {
+    current_responder->response->write(QByteArray().append(c));
+    current_responder->response->flush();
+    current_responder->response->waitForBytesWritten();
+  }
+}
+
+
+static void set_s7webserver_current_responder(s7_scheme *sc, S7WebServerResponder *responder){
+  s7_pointer current_responder = s7_make_c_pointer(sc, responder);
+  s7_symbol_set_value(sc, s7_make_symbol(sc, "s7webserver-current-responder"), current_responder);
+}
+
+void S7WebServerResponder::reply()
+{
+  if (s7webserver->very_verbose)
+    printf("Code so far: -%s-\n",s7webserver->input_code_so_far.c_str());
+
+  if (!is_balanced(s7webserver->input_code_so_far)) {
+    response->end(QByteArray("")); //-unbalanced, waiting for more input-"));
+    s7webserver->input_code_so_far += "\n";
+    return;
+  }
+
+  if(is_white(s7webserver->input_code_so_far)) {
+    response->end(QByteArray(""));
+    s7webserver->input_code_so_far = "";
+    return;
+  }
+
+  // Code in here mostly copied from   https://ccrma.stanford.edu/software/snd/snd/s7.html#Cerrors
+
+
+  // evaluate with error handling
+  {
+    s7_scheme *s7 = s7webserver->s7;
+    
+    int gc_loc = -1;
+
+    /* trap error messages */
+    s7_pointer old_port = s7_set_current_error_port(s7, s7_open_output_string(s7));
+    if (old_port != s7_nil(s7))
+      gc_loc = s7_gc_protect(s7, old_port);
+        
+
+    {
+      // call eval
+      set_s7webserver_current_responder(s7, this);
+
+      s7_pointer result = s7_eval_c_string(s7, s7webserver->input_code_so_far.c_str());
+
+      set_s7webserver_current_responder(s7, NULL);
+
+      {
+        const char *result_as_string = s7_object_to_c_string(s7, result);
+        if (s7webserver->verbose)
+          printf("result: %s\n",result_as_string);
+        
+        {
+          QByteArray array("result: ");
+          array.append(QByteArray(result_as_string));
+
+          {
+            /* look for error messages */
+            const char *errmsg = s7_get_output_string(s7, s7_current_error_port(s7));
+            
+            /* if we got something, wrap it in "[]" */
+            if ((errmsg) && (*errmsg)) {
+              if (s7webserver->verbose)
+                fprintf(stdout, "error message: [%s]\n", errmsg);
+              array.append(QByteArray(errmsg));
+            }
+          }
+          
+          response->end(array);
+        }
+      }
+    }
+
+    s7_close_output_port(s7, s7_current_error_port(s7));
+    s7_set_current_error_port(s7, old_port);
+
+    if (gc_loc != -1)
+      s7_gc_unprotect_at(s7, gc_loc);
+  }
+
+  s7webserver->input_code_so_far = "";
+}
+
+
+S7WebServer *s7webserver_create(s7_scheme *s7, int portnum, bool find_first_free_portnum){
+  
+  // Start QCoreApplication if it hasn't already been started.
+  if (QCoreApplication::instance()==NULL){
+    static int argc = 1;
+    static const char *argv[1] = {"snd"};
+    new QCoreApplication(argc, (char**)argv);
+  }
+
+  s7_define_variable(s7, "s7webserver-current-responder", s7_make_c_pointer(s7, NULL));
+  
+  s7_set_current_output_port(s7, s7_open_output_function(s7, my_print));
+
+ try_again:
+  
+  S7WebServer *s7webserver = new S7WebServer(s7, portnum); 
+
+  if (s7webserver->has_started==false) {
+    delete s7webserver;
+    s7webserver = NULL;
+    
+    if (find_first_free_portnum) {
+      printf("s7webserver: Failed to open port %d, trying port %d instead.\n",portnum,portnum+1);
+      portnum++;
+      goto try_again;
+    }
+  }
+
+  return s7webserver;
+}
+
+void s7webserver_call_very_often(void){
+  QCoreApplication::processEvents();
+}
+
+void s7webserver_set_verbose(S7WebServer *s7webserver, bool verbose) {
+  s7webserver->verbose = verbose;
+}
+
+
+void s7webserver_set_very_verbose(S7WebServer *s7webserver, bool very_verbose) {
+  s7webserver->very_verbose = very_verbose;
+}
+
+int s7webserver_get_portnumber(S7WebServer *s7webserver){
+  return s7webserver->portnumber;
+}
+
+void s7webserver_delete(S7WebServer *s7webserver){
+  delete s7webserver;
+}
+
+
+#ifdef WITH_MAIN
+
+#define OPTARGS_CHECK_GET(wrong,right) (lokke==argc-1?(fprintf(stderr,"Must supply argument for '%s'\n",argv[lokke]),exit(-4),wrong):right)
+
+#define OPTARGS_BEGIN(das_usage) {int lokke;const char *usage=das_usage;for(lokke=1;lokke<argc;lokke++){char *a=argv[lokke];if(!strcmp("--help",a)||!strcmp("-h",a)){fprintf(stderr,"%s",usage);exit(0);
+#define OPTARG(name,name2) }}else if(!strcmp(name,a)||!strcmp(name2,a)){{
+#define OPTARG_GETINT() OPTARGS_CHECK_GET(0,atoll(argv[++lokke]))
+//int optargs_inttemp;
+//#define OPTARG_GETINT() OPTARGS_CHECK_GET(0,(optargs_inttemp=strtol(argv[++lokke],(char**)NULL,10),errno!=0?(perror("strtol"),0):optargs_inttemp))
+#define OPTARG_GETFLOAT() OPTARGS_CHECK_GET(0.0f,atof(argv[++lokke]))
+#define OPTARG_GETSTRING() OPTARGS_CHECK_GET("",argv[++lokke])
+#define OPTARG_GETBOOL() ({const char *response = OPTARG_GETSTRING(); !strcasecmp(response,"false") ? false : !strcasecmp(response,"true") ? true : (fprintf(stderr,"Argument for '%s' must be \"false\" or \"true\"\n",argv[lokke-1]), exit(-5) , false);})
+#define OPTARG_LAST() }}else if(lokke==argc-1 && argv[lokke][0]!='-'){lokke--;{
+#define OPTARGS_ELSE() }else if(1){
+#define OPTARGS_END }else{fprintf(stderr,"%s",usage);exit(-1);}}}
+
+static const char *g_usage_string = ""
+  "Usage: s7webserver [--verbose] [--very-verbose] [--search-for-first-free-portnum false-or-true] [portnumber]\n" 
+  "\n"                                                                  
+  "Default values:\n"                                                  
+  "  verbose: false\n"                                                 
+  "  very-verbose: false\n"                                            
+  "  search-for-first-free-portnum: true\n"
+  "  portnumber: 6080\n"                                               
+  "\n"                                                                 
+  "If \'search-for-first-free-portnum\' is set, s7webserver will search for the next free port number starting at \'portnumber\'.\n" 
+  "\n";
+                                                                        
+int main(int argc, char **argv){
+
+  int portnumber = 6080;
+  bool verbose = false;
+  bool very_verbose = false;
+  bool find_first_free_portnum = true;
+
+  OPTARGS_BEGIN(g_usage_string)
+  {
+    OPTARG("--verbose","-v") verbose = true;
+    OPTARG("--very-verbose","-vv") very_verbose = true;
+    OPTARG("--search-for-first-free-portnum", "-s") find_first_free_portnum=OPTARG_GETBOOL();
+    OPTARG_LAST() portnumber=OPTARG_GETINT();
+  }OPTARGS_END;
+
+  QCoreApplication app(argc, argv);
+
+  s7_scheme *s7 = s7_init();
+  if (s7==NULL) {
+    fprintf(stderr, "Can't start s7 scheme");
+    return -2;
+  }
+  
+  s7webserver_t *s7webserver = s7webserver_create(s7, portnumber, find_first_free_portnum);
+  if (s7webserver==NULL){
+    fprintf(stderr, "Unable to start server. Port may be in use\n");
+    return -3;
+  }
+  
+  s7webserver_set_verbose(s7webserver, verbose);
+  s7webserver_set_very_verbose(s7webserver, very_verbose);
+  
+  printf("S7 server started on port %d. (verbose=%s) (very_verbose=%s) (--search-for-first-free-portnum=%s)\n", s7webserver->portnumber, s7webserver->verbose==true?"true":"false", s7webserver->very_verbose==true?"true":"false", find_first_free_portnum==true?"true":"false");
+
+  app.exec();
+}
+#endif
diff --git a/s7/s7webserver/s7webserver.h b/s7/s7webserver/s7webserver.h
new file mode 100644
index 0000000..7ff1220
--- /dev/null
+++ b/s7/s7webserver/s7webserver.h
@@ -0,0 +1,91 @@
+/*
+The C API:
+
+  s7webserver *s7webserver_create(s7_scheme *s7, int portnum, bool find_first_free_portnum);
+
+  void s7webserver_call_very_often(void);  // Should be called approx. 20 times per second in non-qt programs.
+
+  void s7webserver_set_verbose(s7webserver *s7server, bool verbose);
+
+  void s7webserver_set_very_verbose(s7webserver *s7webserver, bool very_verbose);
+
+  int s7webserver_get_portnumber(s7webserver *s7webserver);
+
+  void s7webserver_delete(s7webserver *s7server);
+*/
+
+
+#ifndef S7WEBSERVER_H
+#define S7WEBSERVER_H
+
+#ifdef __cplusplus
+
+#ifdef COMPILING_S7WEBSERVER
+
+#include "qhttpserverfwd.h"
+
+#include <QObject>
+#include <QScopedPointer>
+
+
+struct S7WebServer : public QObject
+{
+  Q_OBJECT
+
+public:
+  S7WebServer(s7_scheme *s7, int portnumber);
+  s7_scheme *s7;
+  int portnumber;
+  bool verbose;
+  bool very_verbose;
+  bool has_started;
+  std::string input_code_so_far;
+                  
+private slots:
+  void handleRequest(QHttpRequest *req, QHttpResponse *resp);
+};
+
+
+class S7WebServerResponder : public QObject
+{
+  Q_OBJECT
+
+public:
+  S7WebServerResponder(S7WebServer *s7server, QHttpRequest *req, QHttpResponse *resp);
+
+  S7WebServer *s7webserver;
+  
+private:
+  QScopedPointer<QHttpRequest> request;
+  
+public:
+  QHttpResponse *response;
+
+signals:
+  void done();
+             
+private slots:
+  void accumulate(const QByteArray &data);
+  void reply();
+};
+
+#endif // COMPILING_S7WEBSERVER
+
+extern "C" {
+
+#endif // __cplusplus
+
+typedef struct S7WebServer s7webserver_t;
+
+s7webserver_t *s7webserver_create(s7_scheme *s7, int portnumber, bool find_first_free_portnum);
+void s7webserver_call_very_often(void); // Should be called approx. 20 times per second in non-qt programs.
+void s7webserver_set_verbose(s7webserver_t *s7server, bool verbose); // default is false
+void s7webserver_set_very_verbose(s7webserver_t *s7webserver, bool very_verbose); // default is false
+int s7webserver_get_portnumber(s7webserver_t *s7webserver);
+void s7webserver_delete(s7webserver_t *s7server);
+  
+#ifdef __cplusplus
+}
+#endif // __cplusplus
+
+#endif // S7WEBSERVER_H
diff --git a/s7/s7webserver/s7webserver_repl.html b/s7/s7webserver/s7webserver_repl.html
new file mode 100644
index 0000000..e58fc68
--- /dev/null
+++ b/s7/s7webserver/s7webserver_repl.html
@@ -0,0 +1,122 @@
+<!DOCTYPE html>
+
+<!-- This file is based on the "echo.html" example in jq-console: http://replit.github.io/jq-console/ -->
+
+<html>
+  <head>
+    <style>
+    html, body {
+      background-color: #333;
+      color: white;
+      font-family: monospace;
+      margin: 0;
+      padding: 0;
+    }
+    /* The console container element */
+    #console {
+      height: 400px;
+      width: 750px;
+      position:relative;
+      background-color: black;
+      border: 2px solid #CCC;
+      margin: 0 auto;
+      margin-top: 50px;
+    }
+    /* The inner console element. */
+    .jqconsole {
+        padding: 10px;
+    }
+    /* The cursor. */
+    .jqconsole-cursor {
+        background-color: gray;
+    }
+    /* The cursor color when the console looses focus. */
+    .jqconsole-blurred .jqconsole-cursor {
+        background-color: #666;
+    }
+    /* The current prompt text color */
+    .jqconsole-prompt {
+        color: #0d0;
+    }
+    /* The command history */
+    .jqconsole-old-prompt {
+        color: #0b0;
+        font-weight: normal;
+    }
+    /* The text color when in input mode. */
+    .jqconsole-input {
+        color: #dd0;
+    }
+    /* Previously entered input. */
+    .jqconsole-old-input {
+        color: #bb0;
+        font-weight: normal;
+    }
+    /* The text color of the output. */
+    .jqconsole-output {
+        color: white;
+    }
+    </style>
+  </head>
+  <body>
+
+    <div id="console"></div>
+    <script src="http://ajax.googleapis.com/ajax/libs/jquery/2.1.0/jquery.min.js" type="text/javascript" charset="utf-8"></script>
+    <script src="jqconsole.min.js" type="text/javascript" charset="utf-8"></script>
+    <script>
+
+     $(function () {
+         function formatErrorMessage(jqXHR, exception) { // function copied from http://stackoverflow.com/questions/377644/jquery-ajax-error-handling-show-custom-exception-messages
+             if (jqXHR.status === 0) {
+                 return ('Not connected.\nPlease verify your network connection.');
+             } else if (jqXHR.status == 404) {
+                 return ('The requested page not found. [404]');
+             } else if (jqXHR.status == 500) {
+                 return ('Internal Server Error [500].');
+             } else if (exception === 'parsererror') {
+                 return ('Requested JSON parse failed.');
+             } else if (exception === 'timeout') {
+                 return ('Time out error.');
+             } else if (exception === 'abort') {
+                 return ('Ajax request aborted.');
+             } else {
+                 return ('Uncaught Error.\n' + jqXHR.responseText);
+             }
+         }
+
+        var jqconsole = $('#console').jqconsole('S7 scheme\n', '>>> ');
+        var startPrompt = function () {
+          // Start the prompt with history enabled.
+          jqconsole.Prompt(true, function (input) {
+            // Output input with the class jqconsole-output.
+              $.ajax({
+                  type: "POST",
+                  contentType: "text/plain",
+                  data: input,
+                  dataType: "text",
+                  url: url.value,
+                  success: function (data, status, xhr) {
+                      jqconsole.Write(data+"\n");
+                  },
+                  error: function (xhr, status, thrown) {
+                      jqconsole.Write(formatErrorMessage(xhr, status)+"\n")
+                  }
+              });
+
+            startPrompt();
+          });
+        };
+        startPrompt();
+      });
+    </script>
+
+    <center>
+      URL: <input type="text" id="TEXTBOX_ID" value="http://localhost:6080">
+      <script type="text/javascript">
+        var url = document.getElementById('TEXTBOX_ID');
+      </script>
+      <br>
+    </center>
+
+</body>
+</html>
diff --git a/s7/s7webserver/s7webserver_repl.py b/s7/s7webserver/s7webserver_repl.py
new file mode 100755
index 0000000..b1acaf1
--- /dev/null
+++ b/s7/s7webserver/s7webserver_repl.py
@@ -0,0 +1,67 @@
+#! /usr/bin/env python
+
+# Written by Kjetil Matheussen: k.s.matheussen@notam02.no
+
+
+import sys
+import urllib2
+import readline
+
+headers = {"Content-type": "text/plain", "Accept": "text/plain"}
+
+def post(url, data):
+    request = urllib2.Request(url, data, headers)
+    try:
+        response = urllib2.urlopen(request)
+    except urllib2.URLError:
+        print "<Unable to contact Radium>"
+        return
+
+    all_data = ""
+
+    data = response.read(1)
+    while data:
+        all_data = all_data + data
+        sys.stdout.write( '%s' % data )
+        sys.stdout.flush()
+        data = response.read(1)
+    response.close()
+
+    return all_data
+
+
+def get_input(prompt):
+    try:
+        return raw_input(prompt)
+    except EOFError:
+        sys.exit(0)
+
+
+def start(prompt, url):
+    line = get_input(prompt)
+    while True:
+        result = post(url, line)
+        if result=="":
+            line = get_input("")
+        else:
+            print
+            line = get_input(prompt)
+
+
+if __name__ == "__main__":
+
+    prompt = "s7> "
+    url = "http://localhost:6080"
+
+    if len(sys.argv)>1:
+        if (sys.argv[1].startswith("-")):
+            print "Usage: s7repl <prompt> <url>"
+            print "       Default value for <prompt> is \"s7> \""
+            print "       Default value for <url> is http://localhost:6080"
+            sys.exit(0)
+        prompt = sys.argv[1]
+
+    if len(sys.argv)>2:
+        url = sys.argv[2]
+
+    start(prompt, url)
diff --git a/s7/snd-lint.scm b/s7/snd-lint.scm
new file mode 100644
index 0000000..1a74bbe
--- /dev/null
+++ b/s7/snd-lint.scm
@@ -0,0 +1,271 @@
+;;; Snd extensions for lint
+
+(require lint.scm)
+;;; *lint* is the lint environment, so everything in lint.scm is accessible here
+
+;;; --------------------------------
+;;; this sends lint's output to the Snd repl's widget
+(define (snd-lint file)
+  (lint file (openlet 
+	      (inlet :name "lint-output-port"
+		     :format            (lambda (p str . args) (snd-print (apply format #f str args)))
+		     :write             (lambda (obj p)	       (snd-print (object->string obj #t)))
+		     :display           (lambda (obj p)	       (snd-print (object->string obj #f)))
+		     :write-string      (lambda (str p)        (snd-print str))
+		     :write-char        (lambda (ch p)	       (snd-print (string ch)))
+		     :newline           (lambda (p)	       (snd-print (string #\newline)))
+		     :close-output-port (lambda (p) #f)
+		     :flush-output-port (lambda (p) #f)))))
+
+
+;;; ---------------- deprecated funcs ----------------
+;;; Snd deprecated funcs, to be reported by lint
+
+(let ((deprecated-ops '((data-format . sample-type)
+			(mus-sound-frames . mus-sound-framples)
+			(mus-sound-data-format . mus-sound-sample-type)
+			(mus-data-format-name . mus-sample-type-name)
+			(mus-data-format->string . mus-sample-type->string)
+			(default-output-data-format . default-output-sample-type)
+			(channel->vct . channel->float-vector)
+			(vct->channel . float-vector->channel)
+			(region->vct . region->float-vector)
+			(mix->vct . mix->float-vector)
+			(transform->vct . transform->float-vector)
+			(make-vct . make-float-vector)
+			(vct-add! . float-vector-add!)
+			(vct-subtract! . float-vector-subtract!)
+			(vct-copy . copy)
+			(vct-length . length)
+			(vct-multiply! . float-vector-multiply!)
+			(vct-offset! . float-vector-offset!)
+			(vct-ref . float-vector-ref)
+			(vct-scale! . float-vector-scale!)
+			(vct-abs! . float-vector-abs!)
+			(vct-fill! . fill!)
+			(vct-set! . float-vector-set!)
+			(vct-peak . float-vector-peak)
+			(vct-peak-and-location . float-vector-peak-and-location)
+			(vct-equal? . equal?)
+			(vct? . float-vector?)
+			(list->vct . list->float-vector)
+			(vct->list . float-vector->list)
+			(vector->vct . vector->float-vector)
+			(vct->vector . float-vector->vector)
+			(vct-move! . float-vector-move!)
+			(vct-subseq . float-vector-subseq)
+			(vct-reverse! . reverse!)
+			(vct->string . float-vector->string)
+			(vct* . float-vector*)
+			(vct+ . float-vector+))))
+
+  (define (snd-lint-deprecate caller head form env)
+    ((*lint* 'lint-format) "~A is deprecated; use ~A" caller head (cond ((assq head deprecated-ops) => cdr))))
+
+  (for-each (lambda (op)
+	      (hash-table-set! (*lint* 'special-case-functions) (car op) snd-lint-deprecate))
+	    deprecated-ops))
+
+
+;;; ---------------- snd-display ----------------
+;;; check snd-display using format's lint code
+
+(hash-table-set! (*lint* 'special-case-functions) 'snd-display
+		 (hash-table-ref (*lint* 'special-case-functions) 'format))
+
+
+;;; ---------------- defgenerator ----------------
+;;; a lint walker for defgenerator (it defines various functions in the current environment)
+
+(let ()
+  (define (get-generator caller form env)
+    (with-let (sublet *lint* :caller caller :form form :env env)
+      (when (pair? (cdr form))
+	(let ((name (symbol->string ((if (pair? (cadr form)) caadr cadr) form))))
+	  
+	  (if (and (pair? (cadr form))
+		   (pair? (cdadr form)))
+	      (lint-walk caller (cdadr form) env))
+	  
+	  (let ((gen? (symbol name "?"))
+		(gen-make (symbol "make-" name)))
+	    (list (make-fvar gen? 'define (list 'x) `(define (,gen? x) (let? x)) env)
+		  (make-fvar gen-make 'define* (list :rest 'x :allow-other-keys) `(define* (,gen-make :rest x :allow-other-keys) (apply inlet x)) env)))))))
+  
+  (hash-table-set! (*lint* 'walker-functions) 'defgenerator
+		   (lambda (caller form env)
+		     (append (get-generator caller form env) env))))
+
+	
+;;; ---------------- no side effect Snd functions ----------------
+;;; Snd functions that don't affect anything outside or mess with their arguments
+
+(let ((h (*lint* 'no-side-effect-functions)))
+  (for-each
+   (lambda (s)
+     (hash-table-set! h s #t))
+   '(all-chans all-pass-bank? all-pass? apropos array-interp ask-about-unsaved-edits ask-before-overwrite
+     asymmetric-fm? axis-color axis-info axis-label-font axis-numbers-font basic-color
+     beats-per-measure beats-per-minute bes-i0 bes-i1 bes-in bes-j0 bes-j1 bes-jn bes-k0 bes-k1 bes-kn bes-y0 bes-y1 bes-yn
+     bold-peaks-font channel-amp-envs channel-data channel-properties channel-property channel-style
+     channel-sync channel-widgets channels channels-equal? channels=? chans clipping
+     clm-table-size color->list color-cutoff color-inverted color-scale
+     color? colormap colormap-name colormap-ref colormap-size colormap? comb-bank?
+     comb? combined-data-color comment contrast-control contrast-control-amp contrast-control-bounds contrast-control?
+     contrast-enhancement convolve? count-matches current-font
+     current-time cursor cursor-color cursor-location-offset cursor-position cursor-size cursor-style
+     cursor-update-interval dac-combines-channels dac-size data-color data-location data-size db->linear
+     default-output-chans default-output-header-type default-output-sample-type default-output-srate degrees->radians delay?
+     dialog-widgets disk-kspace dot-product dot-size
+     edit-fragment edit-fragment-type-name edit-list->function edit-properties edit-property
+     edit-tree edits edot-product env? enved-base enved-clip?
+     enved-envelope enved-filter enved-filter-order enved-in-dB enved-power enved-style enved-target
+     enved-wave? enved-waveform-color envelope-interp eps-bottom-margin eps-file eps-left-margin
+     eps-size erf erfc even-multiple even-weight expand-control expand-control-bounds
+     expand-control-hop expand-control-jitter expand-control-length expand-control-ramp expand-control? feql ffeql
+     fffneq ffneq fft-log-frequency fft-log-magnitude fft-window fft-window-alpha
+     fft-window-beta fft-with-phases file->frample? file->sample? file-name file-write-date filter-control-coeffs filter-control-envelope
+     filter-control-in-dB filter-control-in-hz filter-control-order filter-control-waveform-color filter-control? filter? filtered-comb-bank?
+     filtered-comb? find-dialog find-mark find-sound fir-filter? firmant? float-vector-equal? float-vector-max float-vector-min float-vector-peak
+     float-vector-peak-and-location fneq foreground-color formant-bank? formant? frample
+     framples ftell fveql get-internal-real-time getcwd getpid granulate? graph-color graph-cursor
+     graph-style graphs-horizontal grid-density gsl-ellipj gsl-ellipk gsl-roots header-type html-dir html-program hz->radians
+     identity iir-filter? initial-beg initial-dur 
+     integer->mark integer->mix integer->region integer->sound integer->transform just-sounds key-binding
+     ladspa-dir left-sample lgamma linear->db lisp-graph-style lisp-graph?
+     listener-color listener-colorized listener-font listener-prompt listener-selection listener-text-color little-endian?
+     localtime locsig-ref locsig-reverb-ref locsig-type locsig? log-freq-start main-menu main-widgets 
+
+     make-env make-pulsed-env make-one-pole make-fir-coeffs make-formant make-all-pass-bank make-iir-filter make-filter 
+     make-comb make-polywave make-bezier make-delay make-nrxycos make-moving-norm make-nrxysin make-firmant 
+     make-sawtooth-wave make-color make-graph-data make-oscil make-oscil-bank make-two-zero make-fft-window make-moving-max 
+     make-filtered-comb-bank make-filtered-comb make-nsin make-rand-interp make-one-pole-all-pass make-rand make-formant-bank 
+     make-all-pass make-table-lookup make-one-zero make-notch make-square-wave make-moving-average make-polyshape
+     make-triangle-wave make-comb-bank make-ncos make-rxyk!sin make-fir-filter make-two-pole make-asymmetric-fm 
+     make-rxyk!cos make-pulse-train 
+
+     mark->integer mark-color mark-home mark-hook mark-name mark-properties
+     mark-property mark-sample mark-sync mark-sync-max mark-tag-height mark-tag-width mark?
+     marks max-regions max-transform-peaks maxamp maxamp-position menu-widgets min-dB mix->integer mix-color mix-dialog-mix mix-drag-hook mix-home
+     mix-length mix-name mix-properties mix-property mix-sampler? mix-sync mix-sync-max mix-tag-height mix-tag-width mix-tag-y mix-waveform-height mix? mixes
+     move-sound? moving-average? moving-max? moving-norm? mus-alsa-buffer-size
+     mus-alsa-buffers mus-alsa-capture-device mus-alsa-device mus-alsa-playback-device mus-alsa-squelch-warning mus-array-print-length mus-bytes-per-sample
+     mus-channel mus-channels mus-chebyshev-t-sum mus-chebyshev-tu-sum mus-chebyshev-u-sum mus-clipping mus-data
+     mus-describe mus-error-type->string mus-expand-filename mus-file-buffer-size mus-file-clipping mus-file-name
+     mus-float-equal-fudge-factor mus-frequency mus-generator? mus-header-raw-defaults mus-header-type->string mus-header-type-name mus-header-writable
+     mus-hop mus-increment mus-input? mus-interp-type mus-interpolate mus-length ;mus-location 
+     mus-max-malloc mus-max-table-size mus-name mus-offset mus-order
+     mus-output? mus-phase mus-ramp mus-sample-type->string mus-sample-type-name mus-scaler
+     mus-sound-chans mus-sound-comment mus-sound-data-location mus-sound-datum-size mus-sound-duration mus-sound-frames
+     mus-sound-framples mus-sound-header-type mus-sound-length mus-sound-loop-info mus-sound-mark-info mus-sound-maxamp mus-sound-maxamp-exists?
+     mus-sound-path mus-sound-sample-type mus-sound-samples mus-sound-srate
+     mus-sound-type-specifier mus-sound-write-date mus-srate mus-type mus-width mus-xcoeff mus-xcoeffs
+     mus-ycoeff mus-ycoeffs mus_header_t? ncos? notch? nrxycos? nrxysin?
+     nsin? odd-multiple odd-weight one-pole-all-pass? one-pole? one-zero? oscil-bank?
+     oscil? partials->polynomial partials->wave pausing peak-env-dir peaks-font
+     phase-partials->wave phase-vocoder-amp-increments phase-vocoder-amps phase-vocoder-freqs phase-vocoder-phase-increments phase-vocoder-phases phase-vocoder?
+     phases-get-peak play-arrow-size player-home player? players playing polyshape?
+     polywave? position->x position->y position-color pulse-train? pulsed-env? radians->degrees radians->hz rand-interp?
+     rand? readin? region->integer region-chans region-framples region-graph-style region-home
+     region-maxamp region-maxamp-position region-position region-sample region-sampler? region-srate region?
+     regions reverb-control-decay reverb-control-feedback reverb-control-length reverb-control-length-bounds reverb-control-lowpass reverb-control-scale
+     reverb-control-scale-bounds reverb-control? right-sample rxyk!cos? rxyk!sin? sample sample-type
+     sampler-at-end? sampler-home sampler-position sampler? samples samples->seconds sash-color
+     sawtooth-wave? script-arg script-args search-procedure seconds->samples selected-channel selected-data-color
+     selected-graph-color selected-sound selection selection-chans selection-creates-region selection-framples selection-maxamp
+     selection-maxamp-position selection-member? selection-position selection-srate selection? short-file-name
+     sinc-width singer-filter singer-nose-filter snd->sample? snd-gcs snd-global-state snd-help snd-tempnam
+     snd-url snd-urls snd-version sound->integer sound-file-extensions sound-file?
+     sound-files-in-directory sound-loop-info sound-properties sound-property sound-widgets sound? soundfont-info
+     sounds spectro-hop spectro-x-angle spectro-x-scale spectro-y-angle spectro-y-scale spectro-z-angle
+     spectro-z-scale spectrum-end spectrum-start speed-control speed-control-bounds speed-control-style
+     speed-control-tones square-wave? srate src? ssb-am? strftime sync-max sync-style syncd-marks table-lookup? tap? temp-dir
+     text-focus-color time-graph-style time-graph-type time-graph? tiny-font tmpnam tracking-cursor-style
+     transform->integer transform-graph-style transform-graph-type transform-graph?
+     transform-normalization transform-sample transform-size transform-type transform? triangle-wave? two-pole?
+     two-zero? variable-graph? wave-train? wavelet-type
+     wavo-hop wavo-trace widget-position widget-size widget-text window-height window-width
+     window-x window-y with-background-processes with-file-monitor with-gl with-inset-graph with-interrupts
+     with-menu-icons with-mix-tags with-pointer-focus with-relative-panes with-smpte-label with-toolbar with-tooltips
+     with-tracking-cursor with-verbose-cursor x->position x-axis-label x-axis-style x-bounds x-position-slider
+     x-zoom-slider y->position y-axis-label y-bounds y-position-slider y-zoom-slider zoom-color
+     zoom-focus-style zoom-one-pixel)))
+
+
+;;; ---------------- Snd makers ----------------
+(let ((h (*lint* 'makers)))
+  (for-each
+   (lambda (s)
+     (hash-table-set! h s #t))
+   '(make-env make-pulsed-env make-one-pole make-fir-coeffs make-convolve make-wave-train make-formant make-all-pass-bank 
+     make-iir-filter make-filter make-comb make-sample->file make-polywave make-bezier make-delay make-nrxycos make-moving-norm 
+     make-nrxysin make-firmant make-sawtooth-wave make-color make-player make-graph-data make-oscil make-oscil-bank 
+     make-two-zero make-fft-window make-moving-max make-filtered-comb-bank make-filtered-comb make-nsin make-rand-interp 
+     make-one-pole-all-pass make-rand make-formant-bank make-readin make-all-pass make-phase-vocoder make-table-lookup 
+     make-one-zero make-notch make-square-wave make-file->frample make-moving-average make-granulate make-polyshape 
+     make-locsig make-triangle-wave make-mix-sampler make-move-sound make-comb-bank make-ncos make-rxyk!sin 
+     make-variable-graph make-fir-filter make-file->sample make-ssb-am make-two-pole make-region-sampler 
+     make-frample->file make-asymmetric-fm make-sampler make-region make-snd->sample make-src make-rxyk!cos make-pulse-train)))
+
+
+;;; ---------------- Snd booleans ----------------
+;;; add Snd/clm type checkers to lint's table (lint assumes that these take one argument)
+
+(for-each (lambda (tchk)
+	    (hash-table-set! (*lint* 'booleans) tchk #t))
+	  '(all-pass? all-pass-bank? asymmetric-fm? comb? comb-bank? convolve? delay? env? file->sample? filter? filtered-comb?
+	    filtered-comb-bank? fir-filter? firmant? formant-bank? formant? granulate? iir-filter? locsig? move-sound? moving-average?
+	    moving-max? moving-norm? mus-generator? mus-input? mus-output? ncos? notch? nrxycos? nrxysin? nsin? one-pole? one-pole-all-pass? 
+	    one-zero? oscil? oscil-bank? phase-vocoder? polyshape? polywave? pulse-train? pulsed-env? rand-interp? rand? readin?
+	    rxyk!cos? rxyk!sin? sample->file? sawtooth-wave? square-wave? src? ssb-am? table-lookup? tap? triangle-wave? two-pole?
+	    two-zero? wave-train? file->frample? frample->file?
+
+	    mark? mix? mix-sampler? region?))
+
+#|
+;;; a more complicated search:
+
+(let ((old-do-walker (hash-table-ref (*lint* 'walker-functions) 'do)))
+  ;; look for forms like (do ((i 0 (+ i 1))) ((= i 123)) (float-vector-set! v i (* .2 (float-vector-ref v i))))
+
+  (hash-table-set! (*lint* 'walker-functions) 'do
+		   (lambda (caller form env)
+		     (when (and (pair? (cdr form))
+				(pair? (cddr form)))
+		       (let ((vars (cadr form))
+			     (end+res (caddr form))
+			     (body (cdddr form)))
+			 (when (and (pair? vars)
+				    (null? (cdr vars))
+				    (pair? body)
+				    (null? (cdr body))
+				    (pair? (car body))
+				    (eq? (caar body) 'float-vector-set!)
+					;(eqv? 0 (cadar vars)) -- we'll use subvector if not 0
+				    (pair? (cddar vars))
+				    (eqv? (length (caddar vars)) 3))
+			   (let ((stepper (caddar vars))
+				 (expr (cdar body))
+				 (end (car end+res)))
+			     (when (and (eq? (car stepper) '+)
+					(memq (caar vars) stepper)
+					(memv 1 stepper)
+					(eqv? (length end) 3)
+					(memq (caar vars) end)
+					(memq (car end) '(= >=))
+					(symbol? (car expr))
+					(eq? (cadr expr) (caar vars))
+					(pair? (caddr expr)))
+			       (let ((ref (caddr expr)))
+				 (when (and (eq? (car ref) '*)
+					    (or (and (pair? (cadr ref))
+						     (eq? (caadr ref) 'float-vector-ref)
+						     (eq? (cadadr ref) (car expr))
+						     (eq? (caddr (cadr ref)) (caar vars)))
+						(and (pair? (caddr ref))
+						     (eq? (caaddr ref) 'float-vector-ref)
+						     (eq? (cadr (caddr ref)) (car expr))
+						     (eq? (caddr (caddr ref)) (caar vars)))))
+				   (format *stderr* "possible float-vector-scale: ~A~%" form))))))))
+		       (old-do-walker caller form env))))
+|#
diff --git a/s7/stuff.scm b/s7/stuff.scm
new file mode 100644
index 0000000..68215e9
--- /dev/null
+++ b/s7/stuff.scm
@@ -0,0 +1,1745 @@
+;; some useful (or at least amusing) functions and macros
+
+(provide 'stuff.scm)
+
+(when (provided? 'pure-s7)
+  (define (let->list e) (reverse! (map values e))))
+
+
+;;; ----------------
+(define empty?
+  (let ((+documentation+ "(empty? obj) returns #t if obj is an empty sequence"))
+    (lambda (obj)
+      (and (not (pair? obj))
+	   (if (hash-table? obj)
+	       (zero? (hash-table-entries obj)) ; length here is table size
+	       (eqv? (length obj) 0))))))
+
+(define applicable? arity)
+
+(define (nth-value n . args) ; untested...
+  (and (> (length args) n)
+       (list-ref args n)))
+
+(define indexable?
+  (let ((+documentation+ "(indexable? obj) returns #t if obj can be applied to an index: (obj 0)"))
+    (lambda (obj)
+      (and (sequence? obj)
+	   (applicable? obj)))))
+
+(define (ow!)
+  (call-with-output-string
+   (lambda (p)
+     (let ((ow (owlet))
+	   (elist (list (rootlet))))
+
+       ;; show current error data
+       (format p "error: ~A" (ow 'error-type))
+       (let ((info (ow 'error-data)))
+	 (if (and (pair? info)
+		  (string? (car info)))
+	     (format p ": ~A" (catch #t
+				(lambda ()
+				  (apply format #f info))
+				(lambda args
+				  "<error in format>")))
+	     (if (not (null? info))
+		 (format p ": ~A" info))))
+
+       (format p "~%error-code: ~S" (ow 'error-code))
+       (when (ow 'error-line)
+	 (format p "~%error-file/line: ~A[~A]" (ow 'error-file) (ow 'error-line)))
+
+       ;; show history, if available
+       (when (pair? (ow 'error-history)) ; a circular list, starts at error-code, entries stored backwards
+	 (let ((history ())
+	       (lines ())
+	       (files ())
+	       (start (ow 'error-history)))
+	   (do ((x (cdr start) (cdr x))
+		(i 0 (+ i 1)))
+	       ((or (eq? x start)
+		    (= i (*s7* 'history-size)))
+		(format p "~%error-history:~%    ~S" (car start))
+		(do ((expr history (cdr expr))
+		     (line lines (cdr line))
+		     (f files (cdr f)))
+		    ((null? expr))
+		  (if (and (integer? (car line))
+			   (string? (car f))
+			   (not (string=? (car f) "*stdout*")))
+		      (format p "~%    ~A~40T;~A[~A]" (object->string (car expr) #t 60) (car f) (car line))
+		      (if (not (null? (car expr)))
+			  (format p "~%    ~A" (object->string (car expr) #t 60)))))
+		(format p "~%"))
+	     (set! history (cons (car x) history))
+	     (set! lines (cons (and (pair? (car x)) (pair-line-number (car x))) lines))
+	     (set! files (cons (and (pair? (car x)) (pair-filename (car x))) files)))))
+
+       (let-temporarily (((*s7* 'print-length) 8))
+	 (do ((e (outlet ow) (outlet e)))
+	     ((memq e elist))
+	   (if (and (number? (length e)) ; with-let + mock-data + length method?
+		    (> (length e) 0))
+	       (format p "~%~{~A~| ~}~%" e)
+	       (format p "e: ~S~%" e))
+	   (set! elist (cons e elist))))))))
+
+#|
+(set! (hook-functions *error-hook*)
+      (list (lambda (hook)
+	      (apply format *stderr* (hook 'data))
+	      (newline *stderr*)
+	      (when ((owlet) 'error-line)
+		(format *stderr* "~S line ~A~%" ((owlet) 'error-file) ((owlet) 'error-line)))
+	      (do ((e (outlet (owlet)) (outlet e)))
+		  ((eq? e (rootlet)))
+		(format *stderr* "~{  ~A~%~}~%" e))
+	      (format *stderr* "~%~A~%" (stacktrace)))))
+|#
+
+;;; ----------------
+(define-macro (typed-let vals . body) ; vals: ((var init [type])...)...) as in (typed-let ((i 0 integer?))...)
+  `(let ,(map (lambda (val)
+		 (list (car val) (cadr val)))
+	       vals)
+     ,@(map (lambda (val)
+	      (if (pair? (cddr val))
+		  (let ((init-args (if (pair? (caddr val)) ; setter: (lambda (s v [e]) ...)
+				       (if (eqv? (length (cadr (caddr val))) 3)
+					   (list (list 'quote (car val)) (car val) (list 'curlet))
+					   (list (list 'quote (car val)) (car val)))
+				       (list (car val))))) ; setter: integer? etc
+		    `(begin
+		       (unless (,(caddr val) ,@init-args) ; check initial value (already set)
+			 (error 'wrong-type "typed-let: '~S initial value ~S is not ~S" ',(car val) ,(car val) ,(caddr val)))
+		       (set! (setter ',(car val)) ,(caddr val))))
+		  (values)))
+	    vals)
+     ,@body))
+
+(define-macro (typed-inlet . vals) ; vals: ((var init [type])...)...) as in (typed-inlet (i 0 integer?)...)
+  (let ((e (gensym)))
+    `(let ((,e (typed-let ,vals (curlet))))
+       (set! (outlet ,e) (rootlet)) ; mimic (inlet ...)
+       ,e)))
+
+
+;;; ----------------
+(define (first obj)  (if (sequence? obj) (obj 0) (error 'wrong-type-arg "first argument, ~S, is not a sequence" obj)))
+(define (second obj) (if (sequence? obj) (obj 1) (error 'wrong-type-arg "second argument, ~S, is not a sequence" obj)))
+(define (third obj)  (if (sequence? obj) (obj 2) (error 'wrong-type-arg "third argument, ~S, is not a sequence" obj)))
+(define (fourth obj) (if (sequence? obj) (obj 3) (error 'wrong-type-arg "fourth argument, ~S, is not a sequence" obj)))
+(define (fifth obj)  (if (sequence? obj) (obj 4) (error 'wrong-type-arg "fifth argument, ~S, is not a sequence" obj)))
+(define (sixth obj)  (if (sequence? obj) (obj 5) (error 'wrong-type-arg "sixth argument, ~S, is not a sequence" obj)))
+(define (seventh obj)(if (sequence? obj) (obj 6) (error 'wrong-type-arg "seventh argument, ~S, is not a sequence" obj)))
+(define (eighth obj) (if (sequence? obj) (obj 7) (error 'wrong-type-arg "eighthment, ~S, is not a sequence" obj)))
+(define (ninth obj)  (if (sequence? obj) (obj 8) (error 'wrong-type-arg "ninth argument, ~S, is not a sequence" obj)))
+(define (tenth obj)  (if (sequence? obj) (obj 9) (error 'wrong-type-arg "tenth argument, ~S, is not a sequence" obj)))
+
+(define (built-in? x)
+  (not (undefined? (eval-string (string-append "#_" (object->string x)))))) ; just a guess...
+
+#|
+(define (the type expr)
+  (if (type expr)
+      expr
+      (error 'bad-type "~S is ~S but should be ~S" expr (type-of expr) type)))
+|#
+(define (the type expr)
+  (let ((e expr)
+	(bp type))
+    (if (and (procedure? bp)
+	     (signature bp)
+	     (eq? 'boolean? (car (signature bp))))
+	(let ((result (if (= (car (arity bp)) 1)
+			  (type e)
+			  (bp 'the e))))
+	  (if result e (error 'bad-type "~S is ~S but should be ~S in (the ~S ~S)" e (type-of e) bp type expr)))
+	(error 'bad-type "~S is not a boolean procedure, (the ~S ~S)" bp type expr))))
+
+(define iota
+  (let ((+documentation+ "(iota n (start 0) (incr 1)) returns a list counting from start for n:\n\
+    (iota 3) -> '(0 1 2)"))
+    (lambda* (n (start 0) (incr 1))
+      (if (or (not (integer? n))
+	      (< n 0))
+	  (error 'wrong-type-arg "iota length ~A should be a non-negative integer" n))
+      (let ((lst (make-list n)))
+	(do ((p lst (cdr p))
+	     (i start (+ i incr)))
+	    ((null? p) lst)
+	  (set! (car p) i))))))
+
+;(define cdr* list-tail)
+
+(define make-circular-list
+  (let ((+documentation+ "(make-circular-list n init) returns a circular list with n entries initialized to init:\n\
+    (make-circular-list 3 #f) -> #1=(#f #f #f . #1#)"))
+    (lambda* (n init)
+      (let ((lst (make-list n init)))
+	(set-cdr! (list-tail lst (- n 1)) lst)))))
+
+(define circular-list
+  (let ((+documentation+ "(circular-list . objs) returns a circular list with objs:\n\
+    (circular-list 1 2) -> #1=(1 2 . #1#)"))
+    (lambda objs
+      (let ((lst (copy objs)))
+	(set-cdr! (list-tail lst (- (length lst) 1)) lst)))))
+
+(define circular-list?
+  (let ((+documentation+ "(circular-list? obj) returns #t if obj is a circular list"))
+    (lambda (obj)
+      (catch #t
+	(lambda () (infinite? (length obj)))
+	(lambda args #f)))))
+
+(define linearize
+  (let ((+documentation+ " (linearize lst) turns a circular list into normal list:\n\
+    (linearize (circular-list 1 2)) -> '(1 2)"))
+    (lambda (lst)
+      (let lin-1 ((lst lst)
+                  (result ())
+                  (sofar ()))
+        (if (or (not (pair? lst)) (memq lst sofar))
+            (reverse! result)
+            (lin-1 (cdr lst) (cons (car lst) result) (cons lst sofar)))))))
+
+(define cyclic?
+  (let ((+documentation+ "(cyclic obj) returns #t if the sequence obj contains any cycles"))
+    (lambda (obj)
+      (pair? (cyclic-sequences obj)))))
+
+(define copy-tree
+  (let ((+documentation+ "(copy-tree lst) returns a full copy of lst"))
+    (lambda (lis)
+      (if (pair? lis)
+	  (copy lis :readable)
+	  lis))))
+
+(define tree-member tree-memq)
+
+(define adjoin
+  (let ((+documentation+ "(adjoin obj lst) adds obj to lst if it is not already in lst, returning the new list"))
+    (lambda (obj lst)
+      (if (member obj lst) lst (cons obj lst)))))
+
+(define (cdr-assoc obj lst)
+  (cond ((assoc obj lst) => cdr)
+	(else #f)))
+
+
+;;; this used to be built into s7.c, but no one uses it.
+(define-macro (multiple-value-set! vars expr . body)
+  (if (pair? vars)
+      (let ((local-vars (map (lambda (n) (gensym)) vars)))
+	`((lambda ,local-vars
+	    ,@(map (lambda (n ln) `(set! ,n ,ln)) vars local-vars)
+	    ,@body)
+	  ,expr))
+      (if (and (null? vars) (null? expr))
+	  (cons 'begin body)
+	  (error 'syntax-error "multiple-value-set! vars/exprs messed up"))))
+
+
+
+;;; ----------------
+(define-macro (fully-macroexpand form)
+  (list 'quote
+        (let expand ((form form))
+          (cond ((not (pair? form)) form)
+                ((and (symbol? (car form))
+                      (macro? (symbol->value (car form))))
+                 (expand (apply macroexpand (list form))))
+                ((and (eq? (car form) 'set!)
+                      (pair? (cdr form))
+                      (pair? (cadr form))
+                      (macro? (symbol->value (caadr form))))
+                 (expand
+                  (apply macroexpand
+                         (list (cons (setter (symbol->value (caadr form)))
+                               (append (cdadr form) (copy (cddr form))))))))
+                (else (cons (expand (car form)) (expand (cdr form))))))))
+
+(define-macro (define-with-macros name&args . body)
+  `(apply define ',name&args (list (fully-macroexpand `(begin ,,@body)))))
+
+(define setf
+  (let ((args (gensym))
+	(name (gensym)))
+    (apply define-bacro `((,name . ,args)
+			  (unless (null? ,args)
+			    (apply set! (car ,args) (cadr ,args) ())
+			    (apply setf (cddr ,args)))))))
+
+
+(define-macro* (incf sym (inc 1))
+  `(set! ,sym (+ ,sym ,inc))) ; or (list-values set! sym (list-values + sym inc))
+
+;; (define-bacro* (incf-1 sym (inc 1)) (apply set! sym (list + sym inc) ()))
+
+(define-macro* (decf sym (dec 1))
+  `(set! ,sym (- ,sym ,dec)))
+
+(define-macro (shiftf . places)
+  (let ((tmp (gensym)))
+    `(let ((,tmp ,(car places)))
+       ,@(map (lambda (a b)
+		`(set! ,a ,b))
+	      places
+	      (cdr places))
+       ,tmp)))
+
+(define-macro (rotatef . places)
+  (let ((tmp (gensym))
+	(last (places (- (length places) 1))))
+    `(let ((,tmp ,(car places)))
+       ,@(map (lambda (a b)
+		`(set! ,a ,b))
+	      places
+	      (cdr places))
+       (set! ,last ,tmp))))
+
+#|
+(define (rotate! lst)
+  (if (and (pair? lst)
+	   (pair? (cdr lst)))
+      (let ((lr (reverse! lst)))
+	(cons (car lr) (reverse! (cdr lr))))
+      lst))
+|#
+
+(define-macro (progv vars vals . body)
+  `(apply (apply lambda ,vars ',body) ,vals))
+
+;; these also appear to work:
+;;   (define-macro (progv vars vals . body) `((apply lambda ,vars ',body) (apply values ,vals)))
+;;   (define-macro (progv vars vals . body) `((apply lambda ,vars ',body) `,@,vals))
+
+
+(define-macro (symbol-set! var val) ; like CL's set
+  `(apply set! ,var ',val ()))
+
+(define-macro (value->symbol expr)
+  `(let ((val ,expr)
+	 (e1 (curlet)))
+     (call-with-exit
+      (lambda (return)
+	(do ((e e1 (outlet e))) ()
+	  (for-each
+	   (lambda (slot)
+	     (if (equal? val (cdr slot))
+		 (return (car slot))))
+	   e)
+	  (if (eq? e (rootlet))
+	      (return #f)))))))
+
+(define-macro (enum . args)
+  `(for-each define ',args (iota (length ',args))))
+
+(define-macro (destructuring-bind lst expr . body) ; if only there were some use for this!
+  (cons 'let
+	(cons (let flatten ((lst1 lst)
+			    (lst2 (eval expr))
+			    (args ()))
+		(cond ((null? lst1) args)
+		      ((not (pair? lst1)) (cons (list lst1 lst2) args))
+		      (else (flatten (car lst1) (car lst2)
+				     (flatten (cdr lst1) (cdr lst2) args)))))
+	      body)))
+
+#|
+;; kinda ugly!
+(define-macro (and-map func args)
+  `(let and-map-loop ((args ,args))
+     (or (null? args)
+	 (and (eval (list ,func (car args)))
+	      (and-map-loop (cdr args))))))
+|#
+
+(define-macro (and-let* vars . body)      ; bind vars, if any is #f stop, else evaluate body with those bindings
+  (if (list? vars)
+      `(let () (and ,@(map (lambda (v) (cons 'define v)) vars) (begin ,@body)))
+      (error 'wrong-type-arg "and-let* var list is ~S" vars)))
+
+(define-macro (let*-temporarily vars . body)
+  `(with-let (#_inlet :orig (#_curlet)
+		      :saved (#_list ,@(map car vars)))
+     (dynamic-wind
+	 (lambda () #f)
+	 (lambda ()
+	   (with-let orig
+	     ,@(map (lambda (v)
+		      `(set! ,(car v) ,(cadr v)))
+		    vars)
+	     ,@body))
+	 (lambda ()
+	   ,@(map (let ((ctr -1))
+		    (lambda (v)
+		      (if (symbol? (car v))
+			  `(set! (orig ',(car v)) (list-ref saved ,(set! ctr (+ ctr 1))))
+			  `(set! (with-let orig ,(car v)) (list-ref saved ,(set! ctr (+ ctr 1)))))))
+		  vars)))))
+
+(define-macro (let/setter vars . body)
+  (let ((setters (map (lambda (binding)
+			 (and (pair? (cddr binding))
+			      (caddr binding)))
+		       vars))
+	(gsetters (gensym)))
+    `(let ((,gsetters (list ,@setters))
+	   ,@(map (lambda (binding)
+		    (list (car binding) (cadr binding)))
+		  vars))
+       ,@(do ((s setters (cdr s))
+	      (var vars (cdr var))
+	      (i 0 (+ i 1))
+	      (result ()))
+	     ((null? s)
+	      (reverse result))
+	   (if (car s)
+	       (set! result (cons `(set! (setter (quote ,(caar var))) (list-ref ,gsetters ,i)) result))))
+       ,@body)))
+
+(define-macro (while test . body)      ; while loop with predefined break and continue
+  (let ((loop (gensym)))
+    `(call-with-exit
+      (lambda (break)
+	(let ,loop ()
+	  (call-with-exit
+	   (lambda (continue)
+	     (do ()
+		 ((not ,test) (break))
+	       ,@body)))
+	  (,loop))))))
+
+(define-macro (anaphoric-when test . body) ; use "test-result" as the variable holding the test result
+  `(let ((test-result ,test))
+     (when test-result ,@body)))
+
+(define-macro (do* spec end . body)
+  `(let* ,(map (lambda (var)
+		 (list (car var) (cadr var)))
+	       spec)
+     (do () ,end
+       ,@body
+       ,@(map (lambda (var)
+		(if (pair? (cddr var))
+		    `(set! ,(car var) ,(caddr var))
+		    (values)))
+	      spec))))
+
+(define-macro (string-case selector . clauses)
+  (cons 'case       ; case with string constant keys
+	(cons (list 'symbol selector)
+	      (map (lambda (clause)
+		     (if (pair? (car clause))
+			 (cons (map symbol (car clause)) (cdr clause))
+			 clause))
+		   clauses))))
+
+(define-macro (eval-case key . clauses) ; case with evaluated key-lists
+  (let ((select (gensym)))
+    `(let ((,select ,key))
+       (cond ,@(map (lambda (lst)
+		      (if (not (pair? (car lst)))
+			  lst
+			  (cons `(member ,select (list ,@(car lst)))
+				(cdr lst))))
+		    clauses)))))
+
+
+
+;;; ----------------
+(define hash-table->alist
+  (let ((+documentation+ "(hash-table->alist table) returns the contents of table as an association list:\n\
+    (hash-table->alist (hash-table '(a . 1))) -> '((a . 1))"))
+    (lambda (table)
+      (if (hash-table? table)
+	  (map values table)
+	  (error 'wrong-type-arg "hash-table->alist argument, ~A, is not a hash-table" table)))))
+
+(define merge-hash-tables append)
+
+
+;;; ----------------
+(define-macro (c?r path)
+  (define (X-marks-the-spot accessor tree)
+    (if (pair? tree)
+	(or (X-marks-the-spot (cons 'car accessor) (car tree))
+	    (X-marks-the-spot (cons 'cdr accessor) (cdr tree)))
+	(and (eq? tree 'X) accessor)))
+  (let ((body 'lst))
+    (for-each
+     (lambda (f)
+       (set! body (list f body)))
+     (reverse (X-marks-the-spot () path)))
+    `(dilambda
+      (lambda (lst)
+	,body)
+      (lambda (lst val)
+	(set! ,body val)))))
+
+
+
+;;; ----------------
+(define find-if
+  (let ((+documentation+ "(find-if func sequence) applies func to each member of sequence.\n\
+If func approves of one, find-if returns that member of the sequence"))
+    (lambda (f sequence)
+      (call-with-exit
+       (lambda (return)
+	 (for-each (lambda (arg)
+		     (if (f arg)
+			 (return arg)))
+		   sequence)
+	 #f)))))
+
+(define member?
+  (let ((+documentation+ "(member? obj sequence) returns #t if obj is an element of sequence"))
+    (lambda (obj sequence)
+      (find-if (lambda (x) (equal? x obj)) sequence))))
+
+
+(define index-if
+  (let ((+documentation+ "(index-if func sequence) applies func to each member of sequence.\n\
+If func approves of one, index-if returns the index that gives that element's position.\n\
+    (index-if (lambda (x) (= x 32)) #(0 1 32 4)) -> 2\n\
+    (index-if (lambda (x) (= (cdr x) 32)) (hash-table '(a . 1) '(b . 32))) -> 'b"))
+    (lambda (f sequence)
+      (call-with-exit
+       (lambda (return)
+	 (if (or (hash-table? sequence)
+		 (let? sequence))
+	     (for-each (lambda (arg)
+			 (if (f arg) (return (car arg))))
+		       sequence)
+	     (let ((position 0))
+	       (for-each (lambda (arg)
+			   (if (f arg) (return position))
+			   (set! position (+ position 1)))
+			 sequence)))
+	 #f)))))
+
+(define count-if
+  (let ((+documentation+ "(count-if func sequence) applies func to each member of sequence, returning the number of times func approves."))
+    (lambda (f sequence)
+      (let ((count 0))
+	(for-each (lambda (arg)
+		    (if (f arg)
+			(set! count (+ count 1))))
+		  sequence)
+	count))))
+
+(define every?
+  (let ((+documentation+ "(every? func sequence) returns #t if func approves of every member of sequence"))
+    (lambda (f sequence)
+      (call-with-exit
+       (lambda (return)
+	 (for-each (lambda (arg) (if (not (f arg)) (return #f))) sequence)
+	 #t)))))
+
+(define any?
+  (let ((+documentation+ "(any? func sequence) returns #t if func approves of any member of sequence"))
+    (lambda (f sequence)
+      (call-with-exit
+       (lambda (return)
+	 (for-each (lambda (arg) (if (f arg) (return #t))) sequence)
+	 #f)))))
+
+(define collect-if
+  (let ((+documentation+ "(collect-if type func sequence) gathers the elements of sequence that satisfy func, and returns them via type:\n\
+    (collect-if list integer? #(1.4 2/3 1 1+i 2)) -> '(1 2)"))
+    (lambda (type f sequence)
+      (unless (sequence? sequence)
+	(error 'wrong-type-arg "collect-if: sequence arg is ~A" sequence))
+      (if (eq? type hash-table)
+	  (apply hash-table (map (lambda (arg) (if (f arg) (values (car arg) (cdr arg)) (values))) sequence))
+	  (apply type (map (lambda (arg) (if (f arg) arg (values))) sequence))))))
+
+;;; if type=list, this is slightly wasteful because list currently copies its args, so:
+;;;   ((if (eq? type list) values (values apply type)) ...) would work
+;;;
+;;; to return (f arg) rather than arg, (apply type (map f sequence))
+
+(define remove-if
+  (let ((+documentation+ "(remove-if type f sequence) returns via type the elements of sequence that do not satisfy func:\n\
+    (remove-if list integer? #(1.4 2/3 1 1+i 2)) -> '(1.4 2/3 1+1i)"))
+    (lambda (type f sequence)
+      (unless (sequence? sequence)
+	(error 'wrong-type-arg "remove-if: sequence arg is ~A" sequence))
+      (collect-if type (lambda (obj) (not (f obj))) sequence))))
+
+(define nonce
+  (let ((+documentation+ "(nonce type sequence) returns via type the elements of sequence that occur only once"))
+    (lambda (type sequence)
+      (collect-if type (lambda (obj) (= (count-if (lambda (x) (equal? x obj)) sequence) 1)) sequence))))
+
+
+(define full-find-if
+  (let ((+documentation+ "(full-find-if func sequence) searches sequence, and recursively any sequences it contains, for an element that satisfies func"))
+    (lambda (f sequence)
+      (if (and (procedure? f)
+	       (aritable? f 1))
+	  (if (sequence? sequence)
+	      (call-with-exit
+	       (lambda (return)
+		 (let full-find-if-1 ((seq sequence))
+		   (for-each
+		    (lambda (x)
+		      (if (f x)
+			  (return x)
+			  (if (sequence? x) (full-find-if-1 x))))
+		    seq))
+		 #f))
+	      (error 'wrong-type-arg "full-find-if second argument, ~A, is not a sequence" sequence))
+	  (error 'wrong-type-arg "full-find-if first argument, ~A, is not a procedure of one argument" f)))))
+
+(define full-count-if
+  (let ((+documentation+ "(full-count-if func sequence) searches sequence, and recursively any sequences it contains, returning the number of elements that satisfy func"))
+    (lambda (f sequence)
+      (let ((count 0))
+	(full-find-if (lambda (x) (if (f x) (set! count (+ count 1))) #f) sequence)
+	count))))
+
+(define full-index-if
+  (let ((+documentation+ "(full-index-if func sequence) searches sequence, and recursively any sequences it contains, returning the indices of the first element that satisfies func:\n\
+    (full-index-if (lambda (x) (and (integer? x) (= x 3))) '(1 (2 3))) -> '(1 1)"))
+    (lambda (f sequence)
+      (call-with-exit
+       (lambda (return)
+	 (letrec ((full-index-if-1
+		   (lambda (f seq path)
+		     (if (or (hash-table? seq)
+			     (let? seq))
+			 (for-each (lambda (arg)
+				     (if (f arg)
+					 (return (reverse (cons (car arg) path)))
+					 (if (indexable? (cdr arg))
+					     (full-index-if-1 f (cdr arg) (cons (car arg) path)))))
+				   seq)
+			 (let ((position 0))
+			   (for-each (lambda (arg)
+				       (if (f arg)
+					   (return (reverse (cons position path)))
+					   (if (indexable? arg)
+					       (full-index-if-1 f arg (cons position path))))
+				       (set! position (+ position 1)))
+				     seq))))))
+	   (full-index-if-1 f sequence ())
+	   #f))))))
+
+
+(define (make-complete-iterator obj)
+  (let ((iters ())
+	(cycles (cyclic-sequences obj))
+	(seen-cycles ()))
+
+    (define (make-careful-iterator p)
+      (if (not (pair? p))
+	  (make-iterator p)
+	  (let ((len (length p)))
+	    (make-iterator
+	     (cond ((infinite? len)      ; circular list
+		    (let ((cur p)
+			  (+iterator+ #t))
+		      (lambda ()
+			(if (memq cur seen-cycles)
+			    #<eof>
+			    (let ((result (car cur)))
+			      (if (memq cur cycles)
+				  (set! seen-cycles (cons cur seen-cycles)))
+			      (set! cur (cdr cur))
+			      result)))))
+		   ((positive? len)      ; normal list
+		    p)
+		   (else
+		    (let ((cur p)        ; dotted list
+			  (+iterator+ #t))
+		      (lambda ()
+			(if (pair? cur)
+			    (let ((result (car cur)))
+			      (set! cur (cdr cur))
+			      result)
+			    (let ((result cur))
+			      (set! cur #<eof>)
+			      result))))))))))
+
+    (make-iterator
+     (let ((iter (make-careful-iterator obj))
+	   (+iterator+ #t))
+       (define (iterloop) ; define returns the new value
+	 (define (iter-memq p q)
+	   (and (pair? q)
+		(or (eq? p (iterator-sequence (car q)))
+		    (iter-memq p (cdr q)))))
+	 (let ((result (iter)))
+	   (cond ((length result)
+		  (if (or (memq result seen-cycles)             ; we've dealt with it already, so skip it
+			  (eq? result (iterator-sequence iter))
+			  (iter-memq result iters))             ; we're dealing with it the right now
+		      (iterloop)                                ; this means the outermost sequence is ignored if encountered during the traversal
+		      (begin
+			(set! iters (cons iter iters))
+			(set! iter (make-careful-iterator result))
+			result)))
+
+		 ((not (eq? result #<eof>))
+		  result)
+
+		 ((null? iters)
+		  #<eof>)
+
+		 (else
+		  (set! seen-cycles (cons (iterator-sequence iter) seen-cycles))
+		  (set! iter (car iters))
+		  (set! iters (cdr iters))
+		  (iterloop)))))))))
+
+
+(define safe-find-if
+  (let ((+documentation+ "(safe-find-if func sequence) searches sequence, and recursively any sequences it contains, for an element that satisfies func.\
+Unlike full-find-if, safe-find-if can handle any circularity in the sequences."))
+    (lambda (f sequence)
+      (let ((iter (make-complete-iterator sequence)))
+	(let loop ((x (iter)))
+	  (if (f x) x
+	      (and (not (and (eq? x #<eof>)
+			     (iterator-at-end? iter)))
+		   (loop (iter)))))))))
+
+(define (safe-count-if f sequence)
+  ;; currently the complete-iterator above skips repetitions, including the outer sequence,
+  ;;   so this count will be off if there are repeated cycles?
+  ;; Perhaps make an iterator that returns everything.
+  (if (sequence? sequence)
+      (if (procedure? f)
+	  (let ((count 0))
+	    (safe-find-if (lambda (x) (if (f x) (set! count (+ count 1))) #f) sequence)
+	    count)
+	  (error 'wrong-type-arg "safe-count-if first argument, ~A, should be a function" f))
+      (error 'wrong-type-arg "safe-count-if second argument, ~A, should be a sequence" sequence)))
+
+
+;;; ----------------
+(define sequences->list
+  (let ((+documentation+ "(sequences->list . sequences) returns a list of elements of all the sequences:\n\
+    (sequences->list \"hi\" #(0 1) (hash-table 'a 2)) -> '(#\\h #\\i 0 1 (a . 2))"))
+    (lambda sequences
+      (apply append
+	     (map (lambda (sequence)
+		    (map values sequence))
+		  sequences)))))
+
+(define concatenate
+  (let ((+documentation+ "(concatenate type . sequences) concatenates sequences returning an object of type:\n\
+    (concatenate vector '(1 2) #(3 4)) -> #(1 2 3 4)"))
+    (lambda (type . sequences)
+      (apply type (apply sequences->list sequences)))))
+
+(define intersection
+  (let ((+documentation+ "(intersection type . sequences) returns via type the intersection of the sequences:\n\
+    (intersection vector '(1 2 3) #(2 3 4)) -> #(2 3)"))
+    (lambda (type . sequences)
+      (if (every? sequence? sequences)
+	  (apply type (let ((lst ()))
+			(if (pair? sequences)
+			    (for-each (lambda (obj)
+					(if (every? (lambda (seq)
+						      (member? obj seq))
+						    (cdr sequences))
+					    (set! lst (cons obj lst))))
+				      (car sequences)))
+			(reverse lst)))
+	  (error 'wrong-type-arg "intersection arguments should be sequences: ~A" sequences)))))
+
+(define union
+  (let ((+documentation+ "(union type . sequences) returns via type the union of the sequences:\n\
+    (union vector '(1 2 3) #(2 3 4)) -> #(1 2 3 4)"))
+    (lambda (type . sequences)
+      (apply type (let ((lst ()))
+		    (for-each (lambda (obj)
+				(if (not (member obj lst))
+				    (set! lst (cons obj lst))))
+			      (apply sequences->list sequences))
+		    (if (eq? type hash-table)
+			(map (lambda (x) (values (car x) (cdr x))) (reverse lst))
+			(reverse lst)))))))
+
+(define asymmetric-difference
+  (let ((+documentation+ "(asymmetric-difference type . sequences) returns the elements in the rest of the sequences that are not in the first:\n\
+    (asymmetric-difference vector '(1 2 3) #(2 3 4) '(1 5)) -> #(4 5)"))
+    (lambda (type . sequences) ; complement, elements in B's not in A
+      (if (not (and (pair? sequences)
+		    (pair? (cdr sequences))))
+	  (type)
+	  (collect-if type (lambda (obj)
+			     (not (member obj (car sequences))))
+		      (apply union list (cdr sequences)))))))
+
+(define cl-set-difference
+  (let ((+documentation+ "(cl-set-difference type . sequences) returns the elements in the first sequence that are not in the rest of the sequences:\n\
+    (cl-set-difference vector '(1 2 3) #(2 3 4) '(1 5)) -> #()"))
+    (lambda (type . sequences)     ; CL: elements in A not in B's
+      (if (not (and (pair? sequences)
+		    (pair? (cdr sequences))))
+	  (type)
+	  (let ((others (apply union list (cdr sequences))))
+	    (collect-if type (lambda (obj)
+			       (not (member obj others)))
+			(car sequences)))))))
+
+(define symmetric-difference
+  (let ((+documentation+ "(symmetric-difference type . sequences) returns the elements that are in an odd number of the sequences:\n\
+    (symmetric-difference vector '(1 2 3) #(2 3 4) '(5)) -> #(1 4 5)"))
+    (lambda (type . sequences)  ; xor, elements in an odd number of sequences (logxor A B...)
+      (let ((all (apply sequences->list sequences)))
+	(collect-if type (lambda (obj)
+			   (odd? (count-if (lambda (x)
+					     (equal? x obj))
+					   all)))
+		    (apply union list sequences))))))
+
+(define power-set
+  (let ((+documentation+ "(power-set type . sequences) returns the power set of the union of the elements in the sequences."))
+    (lambda (type . sequences) ; ignoring repeats
+      (apply type
+	     (let pset ((set (apply union list sequences)))
+	       (if (null? set)
+		   '(())
+		   (let ((rest (pset (cdr set))))
+		     (append rest (map (lambda (subset) (cons (car set) subset)) rest)))))))))
+
+;;; ----------------
+;;;   now superseded by built-in type-of
+(define ->predicate
+  (let ((predicates (list integer? rational? real? complex? number?
+			  byte-vector? string?
+			  float-vector? int-vector? vector?
+			  null? proper-list? pair? list?
+			  keyword? gensym? symbol?
+			  char? string?
+			  hash-table?
+			  iterator?
+			  continuation?
+			  input-port? output-port?
+			  let?
+			  dilambda? procedure? macro?
+			  boolean?
+			  random-state?
+			  eof-object?
+			  c-object?
+			  c-pointer?
+			  (lambda (obj)
+			    (eq? obj #<unspecified>))
+			  (lambda (obj)
+			     (eq? obj #<undefined>))
+			  (lambda (obj)
+			    (memq obj (list quote if when unless begin set! let let* letrec letrec* cond and or case do
+					    lambda lambda* define define* define-macro define-macro* define-bacro define-bacro*
+					    define-constant with-baffle macroexpand with-let)))))
+	(+documentation+ "(->predicate obj) returns the type predicate function for obj: (->predicate 31) -> integer?"))
+    (lambda (obj)
+      (find-if (lambda (pred) (pred obj)) predicates))))
+
+(define add-predicate
+  (let ((+documentation+ "(add-predicate p) adds p (a boolean function of one argument) to the list of predicates used by ->predicate"))
+    (lambda (p)
+      (if (and (procedure? p)
+	       (aritable? p 1))
+	  (let ((e (funclet ->predicate)))
+	    (set! (e 'predicates) (cons p (e 'predicates))))
+	  (error 'wrong-type-arg "add-predicate argument, ~A, is not a procedure of one argument" p)))))
+
+(define typeq?
+  (let ((+documentation+ "(typeq? . objs) returns #t if all objs have the same type (as determined by ->predicate)"))
+    (lambda objs
+      (or (null? objs)
+	  (every? (->predicate (car objs)) (cdr objs))))))
+
+(define-macro (typecase expr . clauses) ; actually type=any boolean func
+  (let ((obj (gensym)))
+    `(begin                             ; normally this would be (let ((,obj ,expr)) ...)
+       (define ,obj ,expr)              ;   but use begin so that internal defines are not blocked
+       (cond ,@(map (lambda (clause)
+		      (if (memq (car clause) '(#t else))
+			  clause
+			  (cons (if (= (length (car clause)) 1)
+				    (list (caar clause) obj)
+				    (cons 'or (map (lambda (type)
+						     (list type obj))
+						   (car clause))))
+				(cdr clause))))
+		    clauses)))))
+
+
+
+;;; ----------------
+(define 2^n?
+  (let ((+documentation+ "(2^n? x) returns #t if x is a power of 2"))
+    (lambda (x)
+      (and (integer? x)
+	   (not (zero? x))
+	   (zero? (logand x (- x 1)))))))
+
+(define (2^n-1? x)
+  (and (integer? x)
+       (zero? (logand x (+ x 1)))))
+
+(define (2-ruler n) ; translated from CLOCC cllib/math.lisp, ruler
+  ;; The exponent of the largest power of 2 which divides the given number.
+  (- (integer-length (logand n (- n))) 1))
+
+(define (lognand . ints)  ; viewed as (not (and ...))
+  (lognot (apply logand ints)))
+
+(define (lognor . ints)
+  (lognot (apply logior ints)))
+
+(define (logeqv . ints)
+  (lognot (apply logxor (if (odd? (length ints))
+			    (values -1 ints) ; Clisp does it this way
+			    ints))))
+
+(define (log-none-of . ints)  ; bits on in none of ints
+  (lognot (apply logior ints)))
+
+(define log-all-of logand)    ; bits on in all of ints
+(define log-any-of logior)    ; bits on in at least 1 of ints
+
+(define (log-n-of n . ints)   ; return the bits on in exactly n of ints
+  (cond ((not (integer? n))
+	 (error 'wrong-type-arg "log-n-of first argument, ~A, should be an integer" n))
+	((not (every? integer? ints))
+	 (error 'wrong-type-arg "log-n-of ints arguments, ~A, should all be integers" ints))
+	((not (positive? n))
+	 (error 'out-of-range "log-n-of first argument should be positive: ~A" n))
+	(else
+	 (let ((len (length ints)))
+	   (cond ((= len 0) (if (= n 0) -1 0))
+		 ((= n 0)   (lognot (apply logior ints)))
+		 ((= n len) (apply logand ints))
+		 ((> n len) 0)
+		 (#t
+		  (do ((1s 0)
+		       (prev ints)
+		       (nxt (cdr ints))
+		       (ln (- len 1))
+		       (nn (- n 1))
+		       (i 0 (+ i 1)))
+		      ((= i len) 1s)
+		    (let ((cur (ints i)))
+		      (if (= i 0)
+			  (set! 1s (logior 1s (logand cur (apply log-n-of nn nxt))))
+			  (let ((mid (cdr prev)))
+			    (set! (cdr prev) (if (= i ln) () (cdr mid)))
+			    (set! 1s (logior 1s (logand cur (apply log-n-of nn ints))))
+			    (set! (cdr prev) mid)
+			    (set! prev mid)))))))))))
+
+;; from Rick
+(define (byte siz pos) ;; -> cache size, position and mask.
+  (list siz pos (ash (- (ash 1 siz) 1) pos)))
+
+(define (ldb bytespec integer)
+  (ash (logand integer (caddr bytespec))
+       (- (cadr bytespec))))
+
+(define (dpb integer bytespec into)
+  (logior (ash (logand integer (- (ash 1 (car bytespec)) 1)) (cadr bytespec))
+	  (logand into (lognot (caddr bytespec)))))
+
+
+;;; ----------------
+(define-macro* (define-class class-name inherited-classes (slots ()) (methods ()))
+  `(let ((outer-env (outlet (curlet)))
+	 (new-methods ())
+	 (new-slots ()))
+
+     (for-each
+      (lambda (class)
+	;; each class is a set of nested environments, the innermost (first in the list)
+	;;   holds the local slots which are copied each time an instance is created,
+	;;   the next holds the class slots (global to all instances, not copied);
+	;;   these hold the class name and other such info.  The remaining environments
+	;;   hold the methods, with the localmost method first.  So in this loop, we
+	;;   are gathering the local slots and all the methods of the inherited
+	;;   classes, and will splice them together below as a new class.
+
+	(set! new-slots (append (let->list class) new-slots))
+	(do ((e (outlet (outlet class)) (outlet e)))
+	    ((or (not (let? e))
+		 (eq? e (rootlet))))
+	  (set! new-methods (append (let->list e) new-methods))))
+      ,inherited-classes)
+
+     (let ((remove-duplicates
+	    (lambda (lst)         ; if multiple local slots with same name, take the localmost
+	      (letrec ((rem-dup
+			(lambda (lst nlst)
+			  (cond ((null? lst) nlst)
+				((assq (caar lst) nlst) (rem-dup (cdr lst) nlst))
+				(else (rem-dup (cdr lst) (cons (car lst) nlst)))))))
+		(reverse (rem-dup lst ()))))))
+       (set! new-slots
+	     (remove-duplicates
+	      (append (map (lambda (slot)
+			     (if (pair? slot)
+				 (cons (car slot) (cadr slot))
+				 (cons slot #f)))
+			   ,slots)                    ; the incoming new slots, #f is the default value
+		      new-slots)))                    ; the inherited slots
+
+       (set! new-methods
+	     (remove-duplicates
+	      (append (map (lambda (method)
+			     (if (pair? method)
+				 (cons (car method) (cadr method))
+				 (cons method #f)))
+			   ,methods)                     ; the incoming new methods
+
+		      ;; add an object->string method for this class (this is already a generic function).
+		      (list (cons 'object->string
+				  (lambda (obj . rest)
+				    (if (and (pair? rest)
+					     (eq? (car rest) :readable))    ; write readably
+					(format #f "(make-~A~{ :~A ~W~^~})"
+						',class-name
+						(map (lambda (slot)
+						       (values (car slot) (cdr slot)))
+						     obj))
+					(format #f "#<~A: ~{~A~^ ~}>"
+						',class-name
+						(map (lambda (slot)
+						       (list (car slot) (cdr slot)))
+						     obj))))))
+		      (reverse! new-methods)))))                  ; the inherited methods, shadowed automatically
+
+     (let ((new-class (openlet
+                       (apply sublet                             ; the local slots
+			      (sublet                            ; the global slots
+				  (apply inlet                   ; the methods
+					 new-methods)
+				'class-name ',class-name         ; class-name slot
+				'inherited ,inherited-classes
+				'inheritors ())                  ; classes that inherit from this class
+			      new-slots))))
+
+       (varlet outer-env
+	 ',class-name new-class                                  ; define the class as class-name in the calling environment
+
+	 ;; define class-name? type check
+	 (symbol (symbol->string ',class-name) "?")
+	 (lambda (obj)
+	   (and (let? obj)
+		(eq? (obj 'class-name) ',class-name))))
+
+       (varlet outer-env
+	 ;; define the make-instance function for this class.
+	 ;;   Each slot is a keyword argument to the make function.
+	 (symbol "make-" (symbol->string ',class-name))
+	 (apply lambda* (map (lambda (slot)
+			       (if (pair? slot)
+				   (list (car slot) (cdr slot))
+				   (list slot #f)))
+			     new-slots)
+		`((let ((new-obj (copy ,,class-name)))
+		    ,@(map (lambda (slot)
+			     `(set! (new-obj ',(car slot)) ,(car slot)))
+			   new-slots)
+		    new-obj))))
+
+       ;; save inheritance info for this class for subsequent define-method
+       (letrec ((add-inheritor (lambda (class)
+				 (for-each add-inheritor (class 'inherited))
+				 (if (not (memq new-class (class 'inheritors)))
+				     (set! (class 'inheritors) (cons new-class (class 'inheritors)))))))
+	 (for-each add-inheritor ,inherited-classes))
+
+       ',class-name)))
+
+(define-macro (define-generic name)    ; (define (genfun any) ((any 'genfun) any))
+  `(define ,name
+     (lambda args
+       (let ((gf ((car args) ',name))) ; get local definition
+	 (if (not (eq? gf ,name))      ; avoid infinite recursion
+             (apply gf args)
+	     (error 'syntax-error "attempt to call generic function wrapper recursively"))))))
+
+(define-macro (define-slot-accessor name slot)
+  `(define ,name (dilambda
+		  (lambda (obj) (obj ',slot))
+		  (lambda (obj val) (set! (obj ',slot) val)))))
+
+(define-macro (define-method name-and-args . body)
+  `(let* ((outer-env (outlet (curlet)))
+	  (method-name (car ',name-and-args))
+	  (method-args (cdr ',name-and-args))
+	  (object (caar method-args))
+	  (class (symbol->value (cadar method-args)))
+	  (old-method (class method-name))
+	  (method (apply lambda* method-args ',body)))
+
+     ;; define the method as a normal-looking function
+     ;;   s7test.scm has define-method-with-next-method that implements call-next-method here
+     ;;   it also has make-instance
+     (varlet outer-env
+       method-name (apply lambda* method-args
+			  `(((,object ',method-name)
+			     ,@(map (lambda (arg)
+				      (if (pair? arg) (car arg) arg))
+				    method-args)))))
+
+     ;; add the method to the class
+     (varlet (outlet (outlet class)) method-name method)
+
+     ;; if there are inheritors, add it to them as well, but not if they have a shadowing version
+     (for-each
+      (lambda (inheritor)
+	(if (not (eq? (inheritor method-name) #<undefined>)) ; defined? goes to the global env
+	    (if (eq? (inheritor method-name) old-method)
+		(set! (inheritor method-name) method))
+	    (varlet (outlet (outlet inheritor)) method-name method)))
+      (class 'inheritors))
+
+     method-name))
+
+(define (all-methods obj method)
+  ;; for arbitrary method combinations: this returns a list of all the methods of a given name
+  ;;   in obj's class and the classes it inherits from (see example below)
+  (if (symbol? method)
+      (let ((methods (let ((base-method (obj method)))
+		       (if (procedure? base-method) (list base-method) ()))))
+	(for-each
+	 (lambda (ancestor)
+	   (let ((next-method (ancestor method)))
+	     (if (and (procedure? next-method)
+		      (not (memq next-method methods)))
+		 (set! methods (cons next-method methods)))))
+	 (obj 'inherited))
+	(reverse methods))
+      (error 'wrong-type-arg "all-methods 'method argument should be a symbol: ~A" method)))
+
+
+
+;;; ----------------
+(define for-each-subset
+  (let ((+documentation+ "(for-each-subset func args) forms each subset of args, then applies func to the subsets that fit its arity"))
+    (lambda (func args)
+      (let subset ((source args)
+                   (dest ())
+                   (len 0))
+        (if (null? source)
+            (if (aritable? func len)
+                (apply func dest))
+            (begin
+              (subset (cdr source) (cons (car source) dest) (+ len 1))
+              (subset (cdr source) dest len)))))))
+
+(define for-each-permutation
+  (let ((+documentation+ "(for-each-permutation func vals) applies func to every permutation of vals:\n\
+    (for-each-permutation (lambda args (format () \"~{~A~^ ~}~%\" args)) '(1 2 3))"))
+    (lambda (func vals)
+      (define (pinner cur nvals len)
+	(if (= len 1)
+	    (apply func (car nvals) cur)
+	    (do ((i 0 (+ i 1))                       ; I suppose a named let would be more Schemish
+		 (start nvals nvals))
+		((= i len))
+	      (set! nvals (cdr nvals))
+	      (let ((cur1 (cons (car nvals) cur)))  ; add (car nvals) to our arg list
+		(set! (cdr start) (cdr nvals))      ; splice out that element and
+		(pinner cur1 (cdr start) (- len 1)) ;   pass a smaller circle on down, "wheels within wheels"
+		(set! (cdr start) nvals)))))        ; restore original circle
+      (let ((len (length vals)))
+	(set-cdr! (list-tail vals (- len 1)) vals)    ; make vals into a circle
+	(pinner () vals len)
+	(set-cdr! (list-tail vals (- len 1)) ())))))    ; restore its original shape
+
+
+
+;;; ----------------
+(define (clamp minimum x maximum) ; if min>max maybe an error? (clamp 3 2 1) -> 1
+  (min maximum (max x minimum)))
+
+(define (1- x) (- x 1))
+(define (1+ x) (+ x 1))
+
+(define n-choose-k
+  (let ((+documentation+ "(n-choose-k n k) returns the binomial coefficient C(N,K)"))
+    (lambda (n k)
+      (if (not (integer? n))
+	  (error 'wrong-type-arg "n-choose-k 'n argument, ~A, should be an integer" n)
+	  (if (not (integer? k))
+	      (error 'wrong-type-arg "n-choose-k 'k argument, ~A, should be an integer" k)
+	      (let ((mn (min k (- n k))))
+		(if (or (negative? mn)
+			(negative? n))
+		    0
+		    (if (= mn 0)
+			1
+			(let ((mx (max k (- n k))))
+			  (do ((cnk (+ 1 mx))
+			       (i 2 (+ i 1)))
+			      ((> i mn) cnk)
+			    (set! cnk (/ (* cnk (+ mx i)) i))))))))))))
+
+;;; ----------------
+
+(define continuable-error
+  (let ((+documentation+ "(continuable-error . args) is (apply error args) wrapped in a continuation named 'continue."))
+    (lambda args
+      (call/cc
+       (lambda (continue)
+	 (apply error args))))))
+
+(define continue-from-error ; maybe arg for value to pass back
+  (let ((+documentation+ "(continue-from-error) tries to continue from the point of the earlier continuable-error"))
+    (lambda ()
+      (if (continuation? ((owlet) 'continue))
+	  (((owlet) 'continue))))))
+
+;;; ----------------
+
+(define (call-with-input-vector v proc)
+  (if (vector? v)
+      (let ((i -1))
+	(proc (openlet
+	       (inlet 'read (lambda (p)
+			      (v (set! i (+ i 1))))))))
+      (error 'wrong-type-arg "call-with-input-vector first argument, ~A, should be a vector" v)))
+
+(define (call-with-output-vector proc)
+  (let ((size 1)
+	(i 0))
+    (let* ((v (make-vector size #f))
+	   (write-to-vector (lambda (obj p)
+			      (when (= i size) ; make the vector bigger to accommodate the output
+				(set! v (copy v (make-vector (set! size (* size 2)) #f))))
+			      (set! (v i) obj)
+			      (set! i (+ i 1))
+			      #<unspecified>))) ; that's what write/display return!
+      (proc (openlet
+	     (inlet 'write (lambda* (obj p)
+			     ((if (not (let? p)) write write-to-vector) obj p))
+		    'display (lambda* (obj p)
+			       ((if (not (let? p)) display write-to-vector) obj p))
+		    'format (lambda (p . args)
+			      (if (not (let? p))
+				  (apply format p args)
+				  (write (apply format #f args) p))))))
+      (subvector v 0 i)))) ; ignore extra trailing elements (i = subvector length)
+
+
+
+;;; ----------------
+
+(define* (flatten-let e (n -1))
+  (if (not (let? e))
+      (error 'wrong-type-arg "flatten-let argument, ~A, is not a let" e)
+      (do ((slots ())
+	   (pe e (outlet pe))
+	   (i 0 (+ i 1)))
+	  ((or (eq? pe (rootlet))
+	       (= i n))
+	   (apply inlet slots))
+	(for-each (lambda (slot)
+		    (if (not (or (assq (car slot) slots)
+				 (immutable? (car slot)))) ; immutable symbol
+			(set! slots (cons slot slots))))
+		  pe))))
+
+(define* (owlets (ows 1)) (flatten-let (owlet) ows))
+
+
+
+;;; ----------------
+
+(define-macro (reflective-let vars . body)
+  `(let ,vars
+     ,@(map (lambda (vr)
+	      `(set! (setter ',(car vr))
+		     (lambda (s v)
+		       (format *stderr* "~S -> ~S~%" s v)
+		       v)))
+	    vars)
+     ,@body))
+
+#|
+(define-bacro (reflective-probe)
+  (with-let (inlet 'e (outlet (curlet)))
+    (for-each (lambda (var)
+		(format *stderr* "~S: ~S~%" (car var) (cdr var)))
+	      e)))
+|#
+;; ideally this would simply vanish, and make no change in the run-time state, but (values) here returns #<unspecified>
+;;   (let ((a 1) (b 2)) (list (set! a 3) (reflective-probe) b)) -> '(3 2) not '(3 #<unspecified> 2)
+;; perhaps if we want it to disappear:
+
+(define-bacro (reflective-probe . body)
+  (with-let (inlet :e (outlet (curlet))
+		   :body body)
+    (for-each (lambda (var)
+		(format *stderr* "~S: ~S~%" (car var) (cdr var)))
+	      e)
+    (cons 'begin body)))
+
+;; now (let ((a 1) (b 2)) (list (set! a 3) (reflective-probe b))) -> '(3 2)
+;; and (let ((a 1) (b 2)) (list (set! a 3) (reflective-probe) b)) -> '(3 () 2)
+;; or use it to print function args: (define (f a b) (reflective-probe) (+ a b))
+
+
+#|
+;; this tests a bacro for independence of any runtime names
+;; (bacro-shaker reactive-set! '(let ((a 21) (b 1)) (reactive-set! a (* b 2)) (set! b 3) a))
+
+(define (bacro-shaker bac example)
+
+  (define (swap-symbols old-code syms)
+    (if (null? old-code)
+	()
+	(if (symbol? old-code)
+	    (let ((x (assq old-code syms)))
+	      (if x
+		  (cdr x)
+		  (copy old-code)))
+	    (if (pair? old-code)
+		(cons (swap-symbols (car old-code) syms)
+		      (swap-symbols (cdr old-code) syms))
+		(copy old-code)))))
+
+  (let ((e (outlet (curlet)))
+	(source (cddr (cadr (caddr (procedure-source bac))))))
+    (let ((symbols (gather-symbols source (rootlet) () ()))
+	  (exsyms (gather-symbols (cadr example) (rootlet) () ())))
+      ;; now try each symbol at each position in exsyms, in all combinations
+
+      (let ((syms ()))
+	(for-each
+	 (lambda (s)
+	   (set! syms (cons (cons s s) syms)))
+	 exsyms)
+	(let ((result (eval example e)))
+
+	  (define (g . new-args)
+	    (for-each (lambda (a b)
+			(set-cdr! a b))
+		      syms new-args)
+	    (let ((code (swap-symbols example syms)))
+	      (let ((new-result (catch #t
+				  (lambda ()
+				    (eval code e))
+				  (lambda args
+				    args))))
+		(if (not (equal? result new-result))
+		    (format *stderr* "~A -> ~A~%~A -> ~A~%"
+			    example result
+			    code new-result)))))
+
+	  (define (f . args)
+	    (for-each-permutation g args))
+
+	  (let ((subsets ())
+		(func f)
+		(num-args (length exsyms))
+		(args symbols))
+	    (define (subset source dest len)
+	      (if (null? source)
+		  (begin
+		    (set! subsets (cons dest subsets))
+		    (if (= len num-args)
+			(apply func dest)))
+		  (begin
+		    (subset (cdr source) (cons (car source) dest) (+ len 1))
+		    (subset (cdr source) dest len))))
+	    (subset args () 0)))))))
+|#
+
+;;; ----------------
+
+(define* (subsequence obj (start 0) end)
+  (let ((new-len (let ((len (length obj)))
+		   (- (min len (or end len)) start))))
+    (if (negative? new-len)
+	(error 'out-of-range "end: ~A should be greater than start: ~A" (min len (or end len)) start))
+
+    (cond ((vector? obj)
+	   (subvector obj start (+ start new-len)))
+
+          ((string? obj)
+           (if (integer? end)
+               (substring obj start end)
+               (substring obj start)))
+
+          ((not (pair? obj))
+           (if (defined? 'value obj #t)
+	       (subsequence (obj 'value) start end)
+	       (if (defined? 'subsequence obj #t)
+		   ((obj 'subsequence) obj start end)
+		   #f)))
+
+          ((not end)
+	   (list-tail obj start))
+
+          (else
+           (do ((lst (make-list new-len #f))
+		(i 0 (+ i 1)))
+	       ((= i new-len) lst)
+	     (set! (lst i) (obj (+ i start))))))))
+
+;;; ----------------
+
+(define-macro (elambda args . body)  ; lambda but pass extra arg "*env*" = run-time env
+  `(define-bacro (,(gensym) ,@args)
+     `((lambda* ,(append ',args `((*env* (curlet))))
+	 ,'(begin ,@body))
+       ,,@args)))
+
+(define-macro* (rlambda args . body) ; lambda* but eval arg defaults in run-time env
+  (let ((arg-names (map (lambda (arg) (if (pair? arg) (car arg) arg)) args))
+	(arg-defaults (map (lambda (arg) (if (pair? arg) (list (car arg) (list 'eval (cadr arg))) arg)) args)))
+    `(define-bacro* (,(gensym) ,@arg-defaults)
+       `((lambda ,',arg-names ,'(begin ,@body)) ,,@arg-names))))
+
+
+;;; ----------------
+
+(unless (or (defined? 'apropos)
+	    (provided? 'snd))
+  (define* (apropos name (port *stdout*) (e (rootlet)))
+    (let ((ap-name (if (string? name)
+		       name
+		       (if (symbol? name)
+			   (symbol->string name)
+			   (error 'wrong-type-arg "apropos argument 1 should be a string or a symbol"))))
+	  (ap-env (if (let? e)
+		      e
+		      (error 'wrong-type-arg "apropos argument 3 should be an environment")))
+	  (ap-port (if (output-port? port)
+		       port
+		       (error 'wrong-type-arg "apropos argument 2 should be an output port"))))
+      (for-each
+       (lambda (binding)
+	 (if (and (pair? binding)
+		  (string-position ap-name (symbol->string (car binding))))
+	     (format ap-port "~A: ~A~%"
+		     (car binding)
+		     (if (procedure? (cdr binding))
+			 (documentation (cdr binding))
+			 (cdr binding)))))
+       ap-env))))
+
+#|
+(define* (apropos->list name (e (rootlet)))
+  (let ((ap-name (if (string? name)
+		     name
+		     (if (symbol? name)
+			 (symbol->string name)
+			 (error 'wrong-type-arg "apropos->let argument 1 should be a string or a symbol")))))
+    (map (lambda (binding)
+	   (if (and (pair? binding)
+		    (string-position ap-name (symbol->string (car binding))))
+	       (if (procedure? (cdr binding))
+		   (cons (car binding) (documentation (cdr binding)))
+		   binding)
+	       (values)))
+	 (if (let? e)
+	     e
+	     (error 'wrong-type-arg "apropos argument 2 should be an environment")))))
+|#
+
+
+;;; --------------------------------------------------------------------------------
+
+(define (*s7*->list) ; (let->list *s7*) flattened and using keywords
+  (do ((p (let->list *s7*) (cdr p))
+       (L ()))
+      ((null? p)
+       (reverse L))
+    (set! L (cons (cdar p)
+		  (cons (symbol->keyword (caar p))
+			L)))))
+
+
+;;; --------------------------------------------------------------------------------
+
+(define* (make-directory-iterator name (recursive #t))
+  (if (not (string? name))
+      (error 'wrong-type-arg "directory name should be a string: ~S" name)
+      (make-iterator
+       (with-let (sublet *libc* :name name :recursive recursive :NULL (c-pointer 0 'void*))
+	 (let ((dir (opendir name)))
+	   (if (equal? dir NULL)
+	       (error 'io-error "can't open ~S: ~S" name (strerror (errno)))
+	       (let ((+iterator+ #t))
+		 (define reader
+		   (let ((dirs ())
+			 (dir-names ())
+			 (dir-name name))
+		     (lambda* (quit)                   ; returned from with-let
+		       (if (eq? quit #<eof>)           ; caller requests cleanup and early exit
+			   (begin                      ;   via ((iterator-sequence iter) #<eof>)
+			     (closedir dir)
+			     (for-each closedir dirs)
+			     (set! dirs ())
+			     quit)
+			   (let ((file (read_dir dir)))
+			     (if (zero? (length file)) ; null filename => all done
+				 (begin
+				   (closedir dir)
+				   (if (null? dirs)
+				       #<eof>
+				       (begin          ; else pop back to outer dir
+					 (set! dir (car dirs))
+					 (set! dirs (cdr dirs))
+					 (set! dir-name (car dir-names))
+					 (set! dir-names (cdr dir-names))
+					 (reader))))
+				 (if (member file '("." "..") string=?)
+				     (reader)
+				     (let ((full-dir-name (string-append dir-name "/" file)))
+				       (if (and recursive
+						(reader-cond
+						 ((defined? 'directory?)
+						  (directory? full-dir-name))
+						 (#t (let* ((buf (stat.make))
+							    (result (and (stat full-dir-name buf)
+									 (S_ISDIR (stat.st_mode buf)))))
+						       (free buf)
+						       result))))
+					   (let ((new-dir (opendir full-dir-name)))
+					     (if (equal? new-dir NULL)  ; inner directory is unreadable?
+						 (format *stderr* "can't read ~S: ~S" file (strerror (errno)))
+						 (begin
+						   (set! dirs (cons dir dirs))
+						   (set! dir new-dir)
+						   (set! dir-names (cons dir-name dir-names))
+						   (set! dir-name full-dir-name)))
+					     (reader))
+					   (string-append dir-name "/" file)))))))))))))))))
+
+
+;;; --------------------------------------------------------------------------------
+
+(define (probe-eval val)
+  (let ((probe-let (inlet)))
+    (for-each
+     (lambda (sym)
+       (let ((func (symbol->value sym (rootlet))))
+	 (if (and (procedure? func)
+		  (not (immutable? sym))) ; apply-values etc
+	     (varlet probe-let sym
+		     (lambda args
+		       (let-temporarily (((*s7* 'openlets) #f))
+			 (let ((clean-args (map (lambda (arg)
+						  (if (eq? arg probe-let)
+						      (probe-let 'value)
+						      arg))
+						args)))
+			   (format *stderr* "(~S ~{~S~^ ~})~%" sym clean-args)
+			   (apply func clean-args))))))))
+     (symbol-table))
+    (varlet probe-let 'value val)
+    (openlet probe-let)))
+
+;;(define (call-any x) (+ x 21))
+;;(display (call-any (probe-eval 42))) -> (+ 42 21) 63
+
+
+;;; --------------------------------------------------------------------------------
+;;;
+#|
+;;; other make-hook possibilities.  Here is the original:
+
+(define make-hook
+  (let ((+documentation+ "(make-hook . pars) returns a new hook (a function) that passes the parameters to its function list."))
+    (lambda hook-args
+      (let ((body ()))
+        (apply lambda* hook-args
+               (copy '(let ((result #<unspecified>))
+                        (let ((hook (curlet)))
+                          (for-each (lambda (hook-function) (hook-function hook)) body)
+                          result))
+                     :readable)
+	       ())))))
+
+;;; but hooks need an indication that a name passed as an argument is not a parameter name even when it is defined (in rootlet for example)
+;;;   (define h (make-hook 'x)) (set! (hook-functions h) (list (lambda (hk) (set! (hk 'result) (hk 'abs))))) (h 123) -> abs
+;;; but the current s7.c version is much faster than using copy, and surely copy isn't needed here; the current version returns #<undefined> for anything that
+;;;  would otherwise be found in rootlet, but ideally we wouldn't have to create a new let, load up the fallback etc --
+;;;  maybe add a flag on the let (blocked?) or notice let-ref-fallback in lets (as opposed to sublet), then it could be in the let with result.
+
+;;; here is a macro make-hook:
+
+(define-macro (make-hook . hook-args)
+  `(let ((body ()))
+     (lambda* ,(map (lambda (p) (if (pair? p) (cadr p) (if (keyword? p) p (error 'wrong-type-arg "make-hook arg ~S?" p)))) hook-args)
+       (let ((result #<unspecified>))
+         (let ((hook (openlet (sublet (curlet) 'let-ref-fallback (lambda (e sym) #<undefined>)))))
+           (for-each (lambda (hook-function) (hook-function hook)) body)
+           result)))))
+
+;;; but this is much slower than the current apply lambda* version
+|#
+
+;;; --------------------------------------------------------------------------------
+
+(define null-environment
+  (let ((e #f))
+    (lambda ()
+      (or e
+	  (set! e (let ((lt (inlet)))
+		    (for-each (lambda (c)
+				(if (and (or (procedure? (cdr c))
+					     (macro? (cdr c)))
+					 (not (constant? (car c))))
+				    (varlet lt (car c) (symbol "[" (symbol->string (car c)) "]"))))
+			      (rootlet))
+		    (sublet lt)))))))
+
+;;; (sandbox '(let ((x 1)) (+ x 2))) -> 3
+;;; (sandbox '(let ((x 1)) (+ x 2) (exit))) -> #f
+
+;;; perhaps tgsl's (immutable-let (rootlet))?
+;;; perhaps use the blocking let?
+
+(define sandbox
+  (let ((+documentation+ "(sandbox code) evaluates code in an environment where nothing outside that code can be affected by its evaluation.")
+	(built-ins
+	 (let ((ht (make-hash-table))) ; bad guys removed
+	   (for-each
+	    (lambda (op)
+	      (set! (ht op) #t))
+	    '(symbol? gensym? keyword? let? openlet? iterator? macro? c-pointer? c-object? c-object-type immutable? constant?
+	      input-port? output-port? eof-object? integer? number? real? complex? rational? random-state?
+	      char? string? list? pair? vector? float-vector? int-vector? byte-vector? hash-table?
+	      continuation? procedure? dilambda? boolean? float? proper-list? sequence? null? gensym
+	      symbol->string string->keyword symbol->keyword byte-vector-ref byte-vector-set!
+	      inlet sublet coverlet openlet let-ref let-set! make-iterator iterate iterator-sequence
+	      iterator-at-end? provided? provide c-pointer c-pointer-type c-pointer-info port-line-number port-filename
+	      pair-line-number pair-filename port-closed? let->list char-ready? flush-output-port
+	      open-input-string open-output-string get-output-string quasiquote call-with-values multiple-value-bind
+	      newline write display read-char peek-char write-char write-string read-byte write-byte
+	      read-line read-string call-with-input-string with-input-from-string
+	      call-with-output-string with-output-to-string
+	      real-part imag-part numerator denominator even? odd? zero? positive?
+	      negative? infinite? nan? complex magnitude angle rationalize abs exp log sin cos tan asin
+	      acos atan sinh cosh tanh asinh acosh atanh sqrt expt floor ceiling truncate round lcm gcd
+	      + - * / max min quotient remainder modulo = < > <= >= logior logxor logand lognot ash
+	      random-state random inexact->exact exact->inexact integer-length make-polar make-rectangular
+	      logbit? integer-decode-float exact? inexact? random-state->list number->string string->number
+	      char-upcase char-downcase char->integer integer->char char-upper-case? char-lower-case?
+	      char-alphabetic? char-numeric? char-whitespace? char=? char<? char>? char<=? char>=?
+	      char-position string-position make-string string-ref string-set! string=? string<? string>?
+	      string<=? string>=? char-ci=? char-ci<? char-ci>? char-ci<=? char-ci>=? string-ci=? string-ci<?
+	      string-ci>? string-ci<=? string-ci>=? string-copy string-fill! list->string string-length
+	      string->list string-downcase string-upcase string-append substring string object->string
+	      format cons car cdr set-car! set-cdr! caar cadr cdar cddr caaar caadr cadar cdaar caddr
+	      cdddr cdadr cddar caaaar caaadr caadar cadaar caaddr cadddr cadadr caddar cdaaar cdaadr
+	      cdadar cddaar cdaddr cddddr cddadr cdddar assoc member list list-ref list-set! list-tail
+	      make-list length copy fill! reverse reverse! sort! append assq assv memq memv vector-append
+	      list->vector vector-fill! vector-length vector->list vector-ref vector-set! vector-dimension vector-dimensions
+	      make-vector subvector vector float-vector make-float-vector float-vector-set! vector-rank
+	      float-vector-ref int-vector make-int-vector int-vector-set! int-vector-ref string->byte-vector
+	      byte-vector make-byte-vector hash-table make-hash-table hash-table-ref weak-hash-table
+	      hash-table-set! hash-table-entries cyclic-sequences call/cc call-with-current-continuation
+	      call-with-exit apply for-each map dynamic-wind values type-of
+	      catch throw error documentation signature help procedure-source
+	      setter arity aritable? not eq? eqv? equal? equivalent?
+	      dilambda make-hook hook-functions stacktrace tree-leaves tree-memq tree-set-memq tree-cyclic? tree-count object->let
+	      pi most-positive-fixnum most-negative-fixnum ; +nan.0 +inf.0 -nan.0 -inf.0
+	      *stderr* *stdout* *stdin*
+	      apply-values list-values
+	      quote if begin let let* letrec letrec* cond case or and do set! unless when else
+	      with-let with-baffle
+	      lambda lambda* define define*
+	      define-macro define-macro* define-bacro define-bacro* macroexpand)) ; not sure about macroexpand
+	   ht))
+	(baddies (list #_eval #_eval-string #_load #_autoload #_define-constant #_define-expansion #_require
+		       #_string->symbol #_symbol->value #_symbol->dynamic-value #_symbol-table #_symbol #_keyword->symbol
+		       #_defined?
+		       #_call/cc #_gc #_read #_immutable!
+		       #_open-output-file #_call-with-output-file #_with-output-to-file
+		       #_open-input-file #_call-with-input-file #_with-input-from-file
+		       #_current-output-port #_current-error-port #_current-input-port
+		       #_set-current-output-port #_set-current-error-port #_set-current-input-port
+		       #_varlet #_cutlet #_rootlet #_curlet #_owlet #_outlet #_funclet
+		       #_exit #_emergency-exit #_dynamic_unwind
+		       (reader-cond
+			((provided? 'system-extras)
+			 #_getenv #_system #_delete-file #_directory->list #_directory? #_file-exists? #_file-mtime))
+		       )))
+    (lambda (code)
+      (if (tree-cyclic? code)
+	  (error 'wrong-type-arg "sandbox argument is circular: ~S~%" code))
+      (if (and (pair? code)
+	       (>= (length code) 10000))
+	  (error 'wrong-type-arg
+		 (let-temporarily (((*s7* 'print-length) 16))
+		   (format #f "sandbox code looks bogus: ~S~%" code))))
+      ;; block any change to calling program, or access to files, etc
+      (let ((new-code
+	     (call-with-exit
+	      (lambda (quit)
+		(let walk ((tree code))
+		  (cond ((symbol? tree)
+			 (let ((val (symbol->value tree)))
+			   ;; don't accept any symbol with an accessor
+			   (if (or ;(setter val)
+				   (setter tree)
+				   (memq tree '(*s7* unquote abort))
+				   (let? val))  ; not sure about this
+			       (quit #f))
+			   ;; don't accept anything except safe built-ins and local vars
+			   (if (not (or (hash-table-ref built-ins tree)
+					(eq? (symbol->value tree (outlet (funclet sandbox))) #<undefined>)))
+			       (quit #f))
+			   ;; if value is also in rootlet, check that it's safe (protect against (set! abs exit) sometime earlier)
+			   (if (or (procedure? val)
+				   (macro? val))
+			       (let ((unval (symbol->value tree (sublet (rootlet) (unlet))))) ; unlet returns the new unshadowing let
+				 (if (not (eq? val unval))
+				     (quit #f))))
+			   tree))
+
+			((memq tree baddies)  ; if tree is a bad procedure (probably via #_) quit
+			 (quit #f))
+
+			((not (pair? tree))
+			 tree)
+
+			((eq? 'quote (car tree)) ; tree-cyclic? ignores quoted lists
+			 (if (tree-cyclic? (cdr tree))
+			     (error 'wrong-type-arg "sandbox argument is circular: ~S~%" tree))
+			 tree)
+
+			(else
+			 ;; do we need to check IO ports and set! here?
+			 (cons (walk (car tree))
+			       (walk (cdr tree))))))))))
+	(and new-code
+	     ;; make sure *s7* will not call any outside code upon error, clear out readers, etc
+	     (let-temporarily ((*#readers* ())
+			       (*libraries* ())
+			       ((*s7* 'max-stack-size) 10000) ; block infinite recursion
+			       ((*s7* 'autoloading?) #f)      ; turn off the autoloader
+			       ((hook-functions *unbound-variable-hook*) ())
+			       ((hook-functions *missing-close-paren-hook*) ())
+			       ((hook-functions *load-hook*) ())
+			       ((hook-functions *error-hook*) ())
+			       ((hook-functions *read-error-hook*) ())
+			       ((hook-functions *rootlet-redefinition-hook*) ())
+			       (reader-cond ((not (provided? 'pure-s7))
+					     ((current-output-port) *stdout*)
+					     ((current-error-port) *stderr*))))
+	       (let-temporarily (((*s7* 'expansions?) #f))   ; turn off read-time macro expansion
+		 (catch #t
+		   (lambda ()
+		     (eval new-code (sublet (rootlet) (unlet))))
+		   (lambda args
+		     (format #f "error: ~A"
+			     (catch #t
+			       (lambda ()
+				 (apply format #f (cadr args)))
+			       (lambda args
+				 (copy "?")))))))))))))
diff --git a/s7/tools/auto-tester.scm b/s7/tools/auto-tester.scm
new file mode 100644
index 0000000..52e6c06
--- /dev/null
+++ b/s7/tools/auto-tester.scm
@@ -0,0 +1,1971 @@
+;;; this is an extension of tauto.scm, an auto-tester
+
+(define with-mock-data #f)
+;(set! (*s7* 'profile) 1)
+(when (provided? 'number-separator) (set! (*s7* 'number-separator) #\,))
+;(set! (*s7* 'gc-stats) 4) ; stack-stats
+
+(unless (defined? 'fuzzies)
+  (define fuzzies 100000))
+
+(define with-continuations #t)
+
+(for-each (lambda (x)
+	    (unless (memq (car x) '(*features* *libraries* *#readers*)) ; last 2 for sandbox
+	      (immutable! (car x))))
+	  (rootlet))
+
+(for-each (lambda (x)
+	    (when (syntax? (symbol->value x))
+	      (immutable! x)
+	      (immutable! (symbol->value x))))
+	  (symbol-table))
+
+(require libc.scm)
+
+(unless (file-exists? "~/cl/tmp1.r5rs")
+  (system "touch ~/cl/tmp1.r5rs"))
+
+;(define debugging (provided? 'debugging))
+;(when (provided? 'profiling) (load "profile.scm"))
+;(set! (hook-functions *load-hook*) (list (lambda (hook) (format () "loading ~S...~%" (hook 'name)))))
+
+(define-constant %features% (copy *features*))
+
+(define (daytime)
+  (with-let (sublet *libc*)
+    (let ((timestr (make-string 16))
+	  (p #f))
+      (let ((len (strftime timestr 16 "%H:%M"
+			   (localtime
+			    (set! p (time.make (time (c-pointer 0 'time_t*))))))))
+	(time.free p)
+	(substring timestr 0 len)))))
+
+(define (memory-rusage)
+  (with-let (sublet *libc*)
+    (let ((v (rusage.make)))
+      (getrusage RUSAGE_SELF v)
+      (let ((mem (rusage.ru_maxrss v)))
+	(free v)
+	mem)))) ; 99 414 [016] -- this is in kbytes
+
+(define-constant start-resident-size (memory-rusage))
+(format #t "size: ~S~%" start-resident-size)
+(define current-size start-resident-size)
+
+(define (cycler size)
+  (let ((cp-lst (make-list 3 #f))
+	(it-lst (make-list 3 #f)))
+    (let ((bases (vector (make-list 3 #f)
+			 (make-vector 3 #f)
+			 (hash-table 'a 1 'b 2 'c 3)
+			 (inlet 'a 1 'b 2 'c 3)
+			 (make-iterator it-lst)
+			 (c-pointer 1 cp-lst)))
+	  (sets ()))
+
+      (do ((blen (length bases))
+	   (i 0 (+ i 1)))
+	  ((= i size))
+	(let ((r1 (random blen))
+	      (r2 (random blen))
+	      (loc (random 3)))
+	  (let ((b1 (bases r1))
+		(b2 (bases r2)))
+	    (case (type-of b1)
+	      ((pair?)
+	       (if (> (random 10) 3)
+		   (begin
+		     (set! (b1 loc) b2)
+		     (set! sets (cons (list r1 loc r2) sets)))
+		   (begin
+		     (set-cdr! (cddr b1) (case loc ((0) b1) ((1) (cdr b1)) (else (cddr b1))))
+		     (set! sets (cons (list r1 (+ loc 3) r2) sets)))))
+
+	      ((vector?)
+	       (set! (b1 loc) b2)
+	       (set! sets (cons (list r1 loc r2) sets)))
+
+	      ((hash-table? let?)
+	       (let ((key (#(a b c) loc)))
+		 (set! (b1 key) b2)
+		 (set! sets (cons (list r1 key r2) sets))))
+
+	      ((c-pointer?)
+	       (set! (cp-lst loc) b2)
+	       (set! sets (cons (list r1 loc r2) sets)))
+
+	      ((iterator?)
+	       (set! (it-lst loc) b2)
+	       (set! sets (cons (list r1 loc r2) sets)))))))
+
+      (object->string (bases (random 6)) :readable))))
+
+(load "stuff.scm")
+(load "write.scm")
+;;(define (pp-checked obj) (let-temporarily ((((funclet pretty-print) '*pretty-print-cycles*) #t)) (pp obj)))
+;; #t is the default for print-cycles
+(require case.scm)
+(define match?  ((funclet 'case*) 'case*-match?))
+
+(when with-mock-data
+  (load "mockery.scm")
+  (define-constant mock-number (*mock-number* 'mock-number))
+  (define-constant mock-pair (*mock-pair* 'mock-pair))
+  (define-constant mock-string (*mock-string* 'mock-string))
+  (define-constant mock-char (*mock-char* 'mock-char))
+  (define-constant mock-vector (*mock-vector* 'mock-vector))
+  (define-constant mock-symbol (*mock-symbol* 'mock-symbol))
+  (define-constant mock-hash-table (*mock-hash-table* 'mock-hash-table))
+  (define-constant mock-c-pointer (*mock-c-pointer* 'mock-c-pointer))
+  (define-constant mock-port (*mock-port* 'mock-port))
+  (define-constant mock-random-state (*mock-random-state* 'mock-random-state)))
+
+;(define-constant _mv_ (if with-mock-data (mock-vector 1 2) (vector 1 2)))
+;(define-constant _v_ #(1 2))
+;(define-constant _mv_ (if with-mock-data (mock-number 1) 1))
+;(define-constant _v_ 1)
+
+;(define-constant _mv_ (if with-mock-data (let ((L1 (mock-pair 1 2))) (immutable! (L1 'value))) (immutable! (list 1 2))))
+;(define-constant _v_ (immutable! (list 1 2)))
+
+(define-constant _mv_ (if with-mock-data (let ((L1 (mock-hash-table 'a 2))) (immutable! (L1 'value))) (immutable! (hash-table 'a 2))))
+(define-constant _v_ (immutable! (hash-table 'a 2)))
+
+
+(set! (*s7* 'safety) 1) ; protect copy (in define-expansion evaluation) from circular lists
+
+(set! (*s7* 'max-stack-size) (* 4 32768))
+(set! (*s7* 'max-heap-size) (ash 1 23)) ; 16M = 1.4Gbytes?
+(set! (*s7* 'max-port-data-size) (ash 1 28))
+(set! (*s7* 'print-length) 4096)
+(set! (*s7* 'max-string-length) 500000)
+(set! (*s7* 'max-list-length) 10000)
+(set! (*s7* 'max-vector-length) 10000)
+(set! (*s7* 'max-vector-dimensions) 10)
+(set! (*s7* 'autoloading?) #f)
+(set! (*s7* 'equivalent-float-epsilon) 1.0e-6)
+(set! (current-output-port) #f)
+
+(define ostr "")
+(define estr "")
+(define nostr "")
+(define curstr "")
+(define last-func #f)
+
+(define error-type 'no-error)
+(define error-info #f)
+(define error-code "")
+(define false #f)
+(define-constant _undef_ (car (with-input-from-string "(#_asdf 1 2)" read)))
+(define (kar x) (car x)) ; not the same as (define kar car) -- subsequent setter below affects car in the latter case
+(set! (setter kar) (lambda (sym e) (error 'oops "kar not settable: ~A" ostr)))
+(define-constant _1234_ 1234)
+(define-constant _dilambda_ (dilambda (lambda (x) (+ x 1)) (lambda (x y) (+ x y))))
+(define-constant _dl_ (let ((x #f)) (dilambda (lambda () x) (lambda (y) (set! x y)))))
+(define __var2__ 3)
+(set! (setter '__var2__) (let ((+signature+ '(boolean? #t))) (lambda (s v) (if (integer? v) v 3))))
+(define _definee_ #f)
+(define x 0)
+(define my-let let)
+(define my-with-baffle with-baffle)
+(define* (my-make-byte-vector size (init 0)) (make-byte-vector size init))
+(define* (my-make-string size (init #\a)) (make-string size init))
+
+(define-constant Hk (make-hook 'x))
+(set! (hook-functions Hk) (list (lambda (h)
+				  (set! (h 'result) (+ (h 'x) 1)))))
+
+(define-constant V_1 (let ((v (make-vector 8))) (set! (vector-typer v) symbol?) v))
+(define-constant V_2 (let ((v (make-vector 1))) (set! (v 0) v) v))
+
+(define-constant H_1
+  (let ((H (hash-table 'v1 1 'v2 2 'v3 3))
+	(last-key #f))
+    (define (valtyp val)
+      (or (memq last-key '(#f v1))
+	  (and (eq? last-key 'v2)
+	       (<= 0 val 32))))
+    (define (keytyp key)
+      (set! last-key key)
+      #t)
+    (set! (hash-table-key-typer H) keytyp)
+    (set! (hash-table-value-typer H) valtyp)
+    (immutable! H)))
+
+(define-constant H_2 (immutable! (make-hash-table 8 eq? (cons symbol? integer?))))
+(define-constant H_3 (immutable! (make-hash-table 8 (cons equal? hash-code))))
+(define-constant H_4 (immutable! (make-hash-table 8
+						  (let ((eqf (lambda (a b) (equal? a b)))
+							(mapf (lambda (a) (hash-code a))))
+						    (cons eqf mapf)))))
+(define-constant H_5 (let ((H (make-hash-table 8
+					       (let ((eqf (lambda (a b) (equal? a b)))
+						     (mapf (lambda (a) (hash-code a))))
+						 (cons eqf mapf))))
+			   (last-key #f))
+		       (define (valtyp val)
+			 (or (memq last-key '(#f v1))
+			     (and (eq? last-key 'v2)
+				  (<= 0 val 32))))
+		       (define (keytyp key)
+			 (set! last-key key)
+			 #t)
+		       (set! (hash-table-key-typer H) keytyp)
+		       (set! (hash-table-value-typer H) valtyp)
+		       (immutable! H)))
+(define-constant H_6 (let ((h (make-hash-table 8 eq? (cons symbol? hash-table?))))
+		       (hash-table-set! h 'a h)
+		       (immutable! h)))
+(define-constant L_6 (let ((L (inlet 'a #f))) (let-set! L 'a L) (immutable! L)))
+
+(define fvref float-vector-ref)
+(define ivref int-vector-ref)
+(define bvref byte-vector-ref)
+(define vref vector-ref)
+(define ivset int-vector-set!)
+(define bvset byte-vector-set!)
+(define vset vector-set!)
+(define adder +)
+
+(define (_vals_) (values #f 1 2))
+(define (_vals1_) (values 1 #f 2))
+(define (_vals2_) (values 1 2 #f))
+(define (finite? n) (not (or (nan? n) (infinite? n))))
+(define (more-values) (values 1 2 3 4))
+(define (_vals3_ x) (values x x))
+(define (_vals4_ x y) (values x y))
+(define (_vals5_ x y z) (values x y z))
+(define (_vals6_ w x y z) (values w x y z))
+
+(define* (_vals3s_ x) (values x x))
+(define* (_vals4s_ x y) (values x y))
+(define* (_vals5s_ x y z) (values x y z))
+(define* (_vals6s_ w x y z) (values w x y z))
+
+(define (_svals3_ x) (* x x))
+(define (_svals4_ x y) (* x y))
+(define (_svals5_ x y z) (* x y z))
+(define (_svals6_ w x y z) (* w x y z))
+
+(define* (_svals3s_ x) (* x x))
+(define* (_svals4s_ x y) (* x y))
+(define* (_svals5s_ x y z) (* x y z))
+(define* (_svals6s_ w x y z) (* w x y z))
+
+(define (fop1 x y z)
+  (+ (floor (* x y)) z)) ; op_opssqq_s
+(define (fop2 x y z)
+  (+ (* x y) (abs z)))   ; opssq_opsq
+(define (fop3 x y z)
+  (+ (abs x) (* y z)))   ; opsq_opssq
+(define (_h1_ x) (vector-ref x 0))
+(define (_h2_ x) (vector-ref x 1))
+(define (_ff_ x y) (+ (_h1_ x) (_h2_ y)))
+(define (tff) (_ff_ (vector 1 2) (vector 3 4))) ; c_ff
+(define (fop4 x y)       ; apply_ss
+  (apply x y))
+(define (fop5 x y)       ; apply_sl
+  (apply x (list y)))
+(define (fop6 x y)       ; apply_sa
+  (apply x (cons y ())))
+(define (fop7 x) (integer? x) (+ x 1))
+(define (tf7 y) (fop7 y))
+(define (fop8 x y) (integer? x) (+ x y))
+(define (tf8 y) (fop8 y y))
+(define (fop9 x y)
+  (integer? x)
+  (values x y))
+(define (tf9 y)
+  (let ((x 1))
+    (fop9 x y)))
+(define (tf10 x)
+  (fop9 x 1))
+(define fop13 ; op_closure_na
+  (lambda (i s L V S H E)
+    (vector (L (+ i 1)) (V (+ i 1)) (S (+ i 1)) (H (+ i 1)) (E (string->symbol s)))))
+(define (tf13 x)
+  (let ((L1 (list 1 2 3))
+	(V1 (vector 1 2 3))
+	(S1 "123")
+	(H1 (hash-table 1 1 2 2 3 3))
+	(E1 (inlet :a 1 :b 2)))
+    (fop13 x "a" L1 V1 S1 H1 E1) (vector 2 2 #\2 1 1)))
+(define* (fop14 par) ; safe_closure*_ka
+  (+ par 1))
+(define (tf14 x)
+  (fop14 :par x))
+(define (fop15 f a)   ; closure_fa
+  (f a))
+(define (tf15 y)
+  (fop15 (lambda (x) (+ x 1)) y))
+(define* (fop16 par)  ; closure_star_ka
+  (fop16-1 par))
+(define (tf16 x)
+  (fop16 :par x))
+(define (fop16-1 x) x)
+(define (fop17 a b c) ; closure_3s
+  (fop17-1 (+ a 1) b c))
+(define (tf17 x)
+  (fop17 x x x))
+(define (tf18 x)      ; closure_saa
+  (fop17 x (+ x 1) (* x 2)))
+(define (fop17-1 a b c)
+  (+ a b c))
+(define (fop19 a b)   ; closure_aa
+  (display a #f)
+  (fop19-1 a (+ b 1)))
+(define (tf19 x)
+  (fop19 (* x 2) (+ x 1)))
+(define (fop19-1 x y)
+  (+ x y))
+(define (fop20 a b)   ; cl_sas
+  (map list (car a) b))
+(define (tf20 x)
+  (fop20 (list (list 1 2 3)) x))
+(define (fop21 a b c d) ; closure_4s
+  (fop21-1 (+ a 1) b c d))
+(define (tf21 x)
+  (fop21 x x x x))
+(define (fop21-1 a b c d)
+  (+ a b c d))
+(define (fop22 a b)   ; apply_sl
+  (apply + (list a b)))
+(define (tf22 x)
+  (fop22 x x))
+(define (fop23 a)     ; apply_ss
+  (apply + a))
+(define (tf23 x)
+  (fop23 x))
+(define (fop24 a b c d e)
+  (+ a b c d e))
+(define (tf24 x)
+  (fop24 (fop24-1 x) (fop24-1 (+ x 1)) x x x)) ; any_closure_np
+(define (fop24-1 x)
+  (* x 2))
+(define (tf25 x)
+  (fop24 (fop24-1 x) (fop24-1 (+ x 1)) x x (values x x))) ; any_closure_np_mv
+(define (tf26 x)
+  (fop24 (fop24-1 x) x (values x x x)))
+(define (tf27 x)
+  (fop24 (values x x x) (fop24-1 x) (fop24-1 x)))
+(define (fop29 x)
+  (and (int-vector? x)
+       (sort! x (lambda (a b) (unless (and a b) (error "oops")) (< a b)))))
+(define (fop30 a b c)
+  (+ a b c))
+(define (tf30 x)
+  (let ((y (* x 2))
+	(z (+ x 1)))
+    (fop30 x y z))) ; safe_closure_3s_a
+(define (fop31 a b c)
+  (+ a b)
+  (max a b c))
+(define (tf31 x)
+  (let ((y (* x 2))
+	(z (+ x 1)))
+    (fop31 x y z))) ; safe_closure_3s
+(define (fop32-0 x) (vector-ref x 0))
+(define (fop32-1 x) (vector-ref x 1))
+(define (fop32 x) (+ (fop32-0 x) (fop32-1 x)))
+(define (tf32 x) (fop32 x)) ; fx_c_ff = op_safe_c_ff
+(define (fop33 x y) (abs y) (+ x 1))
+(define (tf33 x) (fop33 x 0))  ; op_safe_closure_sc
+(define* (fop34 x y) (abs y) (+ x y))
+(define (tf34 x) (fop34 (+ x 1) (* x 2))) ; op_safe_closure_star_aa
+
+(define (f40 c) ; assoc_if
+  (assoc c (list (cons 1 a) (cons 2 b) (cons 3 c) (cons 4 d)) (lambda* (a b) (= a b))))
+(define (f41 c) ; member_if
+  (member c (list 1 2 3 4 5) (lambda* (a b) (= a b))))
+
+(define (fequal? a b) (equal? a b))
+
+(define (sym1 . a) (copy a))
+(define (sym2 a . b) (cons a (copy b)))
+(define (sym3 a b . c) (list a b (copy c)))
+(define* (sym4 :rest a) (copy a))
+(define* (sym5 a :rest b) (cons a (copy b)))
+(define* (sym6 a b :rest c) (list a b (copy c)))
+;(define* (sym7 a :rest b :rest c) (list a b c))
+
+(define-macro (msym1 . a) `(list (list ,@a)))
+(define-macro (msym2 a . b) `(cons ,a (copy ,b))) ; these are confusing!
+(define-macro (msym3 a b . c) `(list ,a ,b (copy ,c)))
+(define-macro* (msym4 :rest a) `(copy ,a))
+(define-macro* (msym5 a :rest b) `(cons ,a (list (list ,@b))))
+;(define-macro* (msym6 a b :rest c) `(list ,a ,b (copy ,c)))
+;(define-macro* (msym7 a :rest b :rest c) `(list ,a ,@b ,@c))
+(define-macro (msym8 a) (let ((g (gensym))) `(let ((,g ,a)) (values a a))))
+
+(define (s7-print-length) (*s7* 'print-length))
+(define (s7-max-string-length) (*s7* 'max-string-length))
+(define (s7-max-list-length) (*s7* 'max-list-length))
+(define (s7-max-vector-length) (*s7* 'max-vector-length))
+(define (s7-max-vector-dimensions) (*s7* 'max-vector-dimensions))
+(define (s7-default-hash-table-length) (*s7* 'default-hash-table-length))
+(define (s7-initial-string-port-length) (*s7* 'initial-string-port-length))
+(define (s7-safety) (*s7* 'safety))
+(define (s7-autoloading?) (*s7* 'autoloading?))
+(define (s7-max-stack-size) (*s7* 'max-stack-size))
+(define (s7-stacktrace-defaults) (copy (*s7* 'stacktrace-defaults)))
+(define (s7-gc-stats) (*s7* 'gc-stats))
+(define (s7-undefined-identifier-warnings) (*s7* 'undefined-identifier-warnings))
+(define (s7-c-types) (*s7* 'c-types))
+(define (s7-profile-info) (*s7* 'profile-info))
+(define (s7-history-size) (*s7* 'history-size))
+(define (s7-default-rationalize-error) (*s7* 'default-rationalize-error))
+(define (s7-equivalent-float-epsilon) (*s7* 'equivalent-float-epsilon))
+(define (s7-hash-table-float-epsilon) (*s7* 'hash-table-float-epsilon))
+(define (s7-bignum-precision) (*s7* 'bignum-precision))
+(define (s7-float-format-precision) (*s7* 'float-format-precision))
+(define (s7-default-random-state) (*s7* 'default-random-state))
+(define (s7-cpu-time) (*s7* 'cpu-time))
+
+(define-macro (_mac_ x) `(+ ,x 1))
+(define-macro* (_mac*_ (x 1)) `(+ ,x 1))
+(define-macro* (_mac1*_ (x 1) :allow-other-keys) `(+ ,x 1))
+(define-bacro (_bac_ x) `(+ ,x 1))
+(define-bacro* (_bac*_ (x 1)) `(+ ,x 1))
+(define (_fnc_ x) (+ x 1))
+(define* (_fnc*_ (x 1)) (+ x 1))
+(define* (_fnc1*_ (x 1) :allow-other-keys) (+ x 1))
+(define (_fnc1_ x) (apply + (list x 1)))
+(define (_fnc2_ x) (- x 1))
+(define (_fnc3_ x) (* x 2.0))
+(define (_fnc4_ x) (/ x))
+(define (_fnc5_ x) (not (pair? x)))
+;(define (_fnc6_ x) (unless (let? x) (let-temporarily (((*s7* 'safety) 1)) (fill! x #\a))))
+;;; (define (_fnc7_ x) (let-temporarily (((*s7* 'safety) 1)) (reverse! x)))
+(define (_fnc8_ x) (let-temporarily ((x (+ x 1))) (values x x)))
+(define (_fnc9_ arg) (map values arg))
+
+(define (fib n)
+  (if (< n 2)
+      n
+      (+ (fib (- n 1))
+         (fib (- n 2)))))
+
+(define (fibr n)
+  (if (>= n 2)
+      (+ (fibr (- n 1))
+         (fibr (- n 2)))
+      n))
+
+(define (fibf n)
+  (if (< n 2.0)
+      n
+      (+ (fibf (- n 1.0))
+         (fibf (- n 2.0)))))
+
+
+(define (local-random . args)
+  (type-of (apply random args)))
+
+(define (local-read-string . args)
+  (with-input-from-file "/home/bil/cl/all-lg-results"
+    (lambda ()
+      (read-string (min 1000 (car args))))))
+
+(define (checked-eval code)
+  (and (pair? code)
+       (< (length code) 100)
+       (null? (cyclic-sequences code))
+       (eval code)))
+
+(define (local-varlet . args)
+  (let ((e (car args)))
+    (when (and (let? e)
+	       (not (eq? e (rootlet)))
+	       (not (defined? 'error-type e #t)))
+      (apply varlet e (cdr args)))))
+
+(define (local-let-set! . args)
+  (let ((e (car args)))
+    (when (and (let? e)
+	       (not (eq? e (rootlet)))
+	       (not (defined? 'error-type e #t)))
+      (apply let-set! e (cdr args)))))
+
+(define (checked-hash-table . args)
+  (let ((_h_ (make-hash-table (*s7* 'default-hash-table-length) equivalent?)))
+    (do ((key/value args (cddr key/value)))
+	((null? key/value) _h_)
+      (if (not (pair? (cdr key/value)))
+	  (error 'wrong-number-of-args "no value")
+	  (set! (_h_ (car key/value)) (cadr key/value))))))
+
+(define (checked-stacktrace . args)
+  (string? (apply stacktrace args)))
+(define (checked-random . args)
+  (number? (apply random args)))
+(define (checked-random-state . args)
+  (random-state? (apply random-state args)))
+(define (checked-random-state->list . args)
+  (list? (apply random-state->list args)))
+(define (checked-make-string . args)
+  (let-temporarily ((*s7* max-string-length 12))
+    (string? (apply make-string args))))
+(define (checked-current-input-port . args)
+  (input-port? (apply current-input-port args)))
+(define (checked-current-error-port . args)
+  (input-port? (apply current-error-port args)))
+(define (checked-funclet . args)
+  (let? (apply funclet . args)))
+(define (checked-hash-code . args)
+  (integer? (apply hash-code args)))
+(define (checked-*function* . args)
+  (procedure? (apply *function* args)))
+
+(define *read-file-name* "s7test.scm")
+;(define *read-file-name* "libdl.scm")
+
+
+(define (checked-read-char . args) (with-input-from-string "0123" (lambda () (apply read-char args))))
+(define (checked-read-byte . args) (with-input-from-string "0123" (lambda () (apply read-byte args))))
+(define (checked-read-line . args) (with-input-from-file *read-file-name* (lambda () (apply read-line args))))
+(define (checked-read-string . args) (with-input-from-file *read-file-name* (lambda () (apply read-string args))))
+(define (checked-read . args) (with-input-from-file "dsp.scm" (lambda () (apply read args))))
+
+(define (checked-reverse! . args) (reverse! (copy (car args))))
+(define (checked-port-line-number . args) (apply port-line-number args) 0)
+(define (checked-procedure-source . args) (copy (procedure-source (car args)) :readable))
+
+(load "s7test-block.so" (sublet (curlet) (cons 'init_func 'block_init)))
+
+(define-expansion (t725-comment . strs) (values)) ; this must be at the top-level, "comment" used as local var in lint.scm
+
+(define-expansion (_dw_ . args)
+  `(dynamic-wind #f (lambda () ,@args) #f))
+
+(define-expansion (_dw_out_ . args)
+  `(let ((_port_ #f)
+	 (_old_port_ #f))
+     (dynamic-wind
+	 (lambda ()
+	   (set! _old_port_ (current-output-port))
+	   (set! _port_ (open-output-string))
+	   (set! (current-output-port) _port_))
+	 (lambda ()
+	   ,@args
+	   (get-output-string _port_ #t))
+	 (lambda ()
+	   (close-output-port _port_)
+	   (set! (current-output-port) _old_port_)))))
+
+(define-expansion (_cw_ . args)
+  `(call-with-exit (lambda (_x_) (_x_ ,@args))))
+
+;;(define-expansion (_cc_ . args)
+;;  `(call/cc (lambda (_x_) (_x_ ,@args))))
+
+(define-expansion (_ct1_ . args)
+  `(catch #t (lambda () (call-with-exit (lambda (goto) (values ,@args)))) (lambda args 'error)))
+
+(define-expansion (_ct2_ . args)
+  `(catch #t (lambda () (call-with-exit (lambda (goto) (goto ,@args)))) (lambda args 'error)))
+
+(define-expansion (_ft1_ . args)
+  `(let ((_f_ (lambda () ,@args))) (_f_) (_f_)))
+
+(define-expansion (_ft2_ . args)
+  `(let () (define (_f_) ,@args) (define (g) (_f_)) (g) (g)))
+
+(define (_rf11_ i x) (if (> i 0) (_rf11_ (- i 1) x) (x)))
+(define-expansion (_rf1_ . args)
+  `(let ((y 0)) (_rf11_ 1 (lambda () ,@args))))
+
+(define-expansion (_rf3_ . args)
+  `(let ((y 0)) (_rf11_ 1 (lambda () (begin ,@args)))))
+
+(define (_rf22_ i x) (if (> i 0) (_rf22_ (- i 1) x) (x i)))
+(define-expansion (_rf2_ . args)
+  `(let () (_rf22_ 1 (lambda (y) (begin ,@args)))))
+
+(define-expansion (_do1_ . args)
+  `(with-output-to-string
+     (lambda ()
+       (do ((i 0 (+ i 1)))
+	   ((= i 1))
+	 (with-immutable (i)
+	   ,@(map (lambda (x)
+		    (list 'values x))
+		  args))))))
+
+(define-expansion (_do2_ . args)
+  `(with-output-to-string
+     (lambda ()
+       (with-immutable (i)
+         ,@(map (lambda (x)
+		  (list 'values x))
+		args)))))
+
+(define-expansion (_do4_ . args)
+  `(do ((__var__ #f)
+	(_i_ 0 (+ _i_ 1)))
+       ((= _i_ 1) __var__)
+     (set! __var__ ,@args)))
+
+(define-expansion (_do5_ . args)
+  `(let ((__var__ #f))
+     (let doer ((_i_ 0))
+       (if (= _i_ 1)
+	   __var__
+	   (begin
+	     (set! __var__ ,@args)
+	     (doer (+ _i_ 1)))))))
+
+(define-expansion (_do3_ . args)
+  `(let ((exiter (vector #f))) (do ,(car args) ((vector-ref exiter 0) 1) ,@(cdr args) (vector-set! exiter 0 #t))))
+
+(define-expansion (_cop1_ . args)
+  `(let ((x (begin ,@args)))
+     x))
+
+(define-expansion (_cop2_ . args)
+  `(let ((x (begin ,@args)))
+     (copy x)))
+
+(define-expansion (_rd3_ . args)
+  `(let ((port #f))
+     (dynamic-wind
+	 (lambda ()
+	   (set! port (open-input-string (format #f "~W" (car (list ,@args))))))
+	 (lambda ()
+	   (read port))
+	 (lambda ()
+	   (close-input-port port)))))
+
+(define-expansion (_rd4_ . args)
+  `(with-input-from-string
+       (object->string (car (list ,@args)) :readable) ; defaults to ~S
+     read))
+
+(define-expansion (_rd5_ . args)
+  `(let ((port #f))
+     (dynamic-wind
+	 (lambda ()
+	   (set! port (open-input-string (format #f "~S" (car (list ,@args))))))
+	 (lambda ()
+	   (read-line port))
+	 (lambda ()
+	   (close-input-port port)))))
+
+(define-expansion (_rd6_ . args)
+  `(with-input-from-string
+       (object->string (car (list ,@args)))
+     read-line))
+
+(define-expansion (_wr3_ . args)
+  `(format #f "~W" (car (list ,@args))))
+
+(define-expansion (_wr4_ . args)
+  `(object->string (car (list ,@args)) :readable))
+
+(define-expansion (_let1_ . args)
+  `(let-temporarily ((x 1)) (call-with-exit (lambda (go) (go ,@args)))))
+
+(define-expansion (_let2_ . args)
+  `(call-with-exit (lambda (go) (let-temporarily ((x 1)) (go ,@args)))))
+
+(define-expansion (_iter_ . args)
+  `(let ((erg (list-values ,@args)))
+     (let ((iter (if (iterator? erg) erg (make-iterator erg)))
+	   (result ()))
+       (do ((x (iter) (iter)))
+	   ((iterator-at-end? iter) (reverse result))
+	 (set! result (cons x result))))))
+
+(define-expansion (_map_ . args)
+  `(map values (list ,@args)))
+
+(define-expansion (_cat1_ . args)
+  `(catch #t
+     (lambda ()
+       (catch 'not-oops
+	 (lambda ()
+	   (throw 'oops ,@args))
+	 (lambda (t i)
+	   'error)))
+     (lambda (t i)
+       'error)))
+
+(define-expansion (_cat2_ . args)
+  `(catch #t
+     (lambda ()
+       (catch 'not-oops
+	 (lambda ()
+	   (error 'oops ,@args))
+	 (lambda (t i)
+	   'error)))
+     (lambda (t i)
+       'error)))
+
+(define-constant ims (immutable! (string #\a #\b #\c)))
+(define-constant imbv (immutable! (byte-vector 0 1 2)))
+(define-constant imbv2 (immutable! #u2d((1 2 3) (4 5 6))))
+(define-constant imbv3 (immutable! #u3d(((1 2 3) (1 2 4)) ((1 2 5) (1 2 6)) ((1 2 7) (1 2 8)))))
+(define-constant imv (immutable! (vector 0 1 2)))
+(define-constant imv2 (immutable! #2d((1 2 3) (4 5 6))))
+(define-constant imv3 (immutable! #3d(((1 2 3) (1 2 4)) ((1 2 5) (1 2 6)) ((1 2 7) (1 2 8)))))
+(define-constant imiv (immutable! (int-vector 0 1 2)))
+(define-constant imiv2 (immutable! #i2d((1 2 3) (4 5 6))))
+(define-constant imiv3 (immutable! #i3d(((1 2 3) (1 2 4)) ((1 2 5) (1 2 6)) ((1 2 7) (1 2 8)))))
+(define-constant imfv (immutable! (float-vector 0 1 2)))
+(define-constant imfv2 (immutable! #r2d((1 2 3) (4 5 6))))
+(define-constant imfv3 (immutable! #r3d(((1 2 3) (1 2 4)) ((1 2 5) (1 2 6)) ((1 2 7) (1 2 8)))))
+(define-constant imi (immutable! (inlet 'a 3 'b 2)))
+(define-constant ilt (immutable! (openlet (inlet 'let-ref-fallback (lambda (e sym) #<undefined>)))))
+
+(define-constant imh (immutable! (let ((H (make-hash-table 8 #f (cons symbol? integer?)))) (set! (H 'a) 1) (set! (H 'b) 2) H)))
+(define-constant imp (immutable! (cons 0 (immutable! (cons 1 (immutable! (cons 2 ())))))))
+(define-constant imb (immutable! (block 0.0 1.0 2.0)))
+(when with-mock-data
+  (define-constant imfi (immutable! (mock-port (open-input-string "asdf"))))
+  (define-constant imfo (immutable! (mock-port (open-output-string))))
+  (with-let imfo (set! (setter 'value) (lambda (obj field val) (error 'out-of-range "can't set imfo value"))))
+  (define-constant imr (immutable! (mock-random-state 123456))))
+
+(define-constant bigi0 (bignum 0))
+(define-constant bigi1 (bignum 1))
+(define-constant bigi2 (bignum 123))
+(define-constant bigf2 (bignum 123.0))
+(define-constant bigrat (bignum 1/2))
+(define-constant bigflt (bignum 1.5))
+(define-constant bigcmp (bignum 1+2i))
+
+(define-constant vvv (let ((v (make-vector '(2 2)))) (set! (v 0 0) "asd") (set! (v 0 1) #r(4 5 6)) (set! (v 1 0) '(1 2 3)) (set! (v 1 1) 32) v))
+(define-constant vvvi (let ((v (make-vector '(2 2)))) (set! (v 0 0) "asd") (set! (v 0 1) #r(4 5 6)) (set! (v 1 0) '(1 2 3)) (set! (v 1 1) 32) (immutable! v)))
+(define-constant vvvf (immutable! (vector abs log sin)))
+
+(define big-let (let ((e (inlet)))
+		  (let-temporarily (((*s7* 'print-length) 80))
+		    (do ((i 0 (+ i 1)))
+			((= i 100))
+		      (varlet e (symbol "abc" (number->string i)) i)))
+		  (immutable! e)))
+(define big-hash (let ((e (hash-table)))
+		   (let-temporarily (((*s7* 'print-length) 80))
+		     (do ((i 0 (+ i 1)))
+			 ((= i 100))
+		       (hash-table-set! e (symbol "abc" (number->string i)) i)))
+		   (immutable! e)))
+
+(define-constant a1 (immutable! (let ((H (make-hash-table 8 #f (cons real? integer?)))) (set! (H +nan.0) 1) H)))
+(define-constant a2 (immutable! (inlet :a (hash-table 'b 1))))
+(define-constant a3 (openlet (immutable! (inlet :a 1))))
+(define-constant a4 (subvector #i2d((1 2) (3 4))))
+(define-constant a5 (subvector #i2d((1 2) (3 4)) 0 4 '(4)))
+(define-constant a6 (subvector #i2d((1 2) (3 4)) 1 3 '(2 1)))
+
+(define int-var 1)
+(define float-var 1.0)
+(define ratio-var 1/2)
+(define complex-var 1+i)
+
+(define-constant x1 12345)
+(define-constant x2 32.123)
+(define-constant x3 2/31)
+(define-constant x4 32.0+2.0i)
+(define-constant x5 +nan.0)
+(define-constant x6 +inf.0)
+(define-constant x7 #\a)
+(define-constant x8 :hi)
+(define-constant x9 'hi)
+
+(define-constant gb1 'gb2)
+(define-constant gb2 'gb3)
+(define-constant gb3 '(+ 1 2))
+
+(define-constant typed-hash (make-hash-table 8 eq? (cons symbol? integer?)))
+(define-constant typed-vector (make-vector 8 'a symbol?))
+(define-constant typed-let1 (immutable! (let ((a 1)) (set! (setter 'a) integer?) (curlet))))
+(define-constant constant-let (immutable! (let () (define-constant a 1) (curlet))))
+
+(define-constant bight (let* ((size 10) ; was 1000 for a long time
+			      (ht (make-hash-table size)))
+			 (do ((i 0 (+ i 1)))
+			     ((= i size))
+			   (hash-table-set! ht (symbol (format #f "a~D" i)) i))
+			 (immutable! ht)))
+
+(define-constant fvset float-vector-set!)
+(define-constant htset hash-table-set!)
+
+(set! (hook-functions *unbound-variable-hook*) ())
+(define max-stack (*s7* 'stack-top))
+(define last-error-type #f)
+(define old-definee #f)
+(define-constant L0 (let ((a 1)) (immutable! 'a) (curlet)))
+(immutable! L0)
+
+(define (tp val) ; omits trailing " if val long and already a string
+  (let ((str (object->string val)))
+    (if (< (length str) 512)
+	str
+	(string-append (substring str 0 509) "..."))))
+
+(define (cons-r a b n) (if (= 0 n) (list a b) (cons (cons-r (+ a 1) (+ b 1) (- n 1)) (cons-r (- a 1) (- b 1) (- n 1)))))
+(define (list-r a b n) (if (= 0 n) (list a b) (list (list-r (+ a 1) (+ b 1) (- n 1)) (list-r (- a 1) (- b 1) (- n 1)))))
+
+(define with-bignums (provided? 'bignums))
+(define (bool/int? x) (or (boolean? x) (integer? x)))
+
+(set! (hook-functions *read-error-hook*) ())
+
+(define-macro (with-immutable objs . body)
+  `(let-temporarily (,@(map (lambda (obj)
+			      `((setter ',obj) (lambda (s v)
+						 (error 'immutable-object-error
+							"in with-immutable, can't set! ~A"
+							',obj))))
+			    objs))
+     ,@body))
+
+(immutable! 'cosh)
+
+(when (not (defined? 'loading-t718))
+(let ((functions (vector 'not '= '+ 'cdr 'real? 'rational? 'number? '> '- 'integer? 'apply 'subvector? 'subvector-position 'subvector-vector
+			  'abs '* 'null? 'imag-part '/ 'vector-set! 'equal? 'magnitude 'real-part 'pair? 'max 'nan? 'string->number 'list
+			  'negative? 'cons 'string-set! 'list-ref 'eqv? 'positive? '>= 'expt 'number->string 'zero? 'floor 'denominator 'integer->char
+			  'string? 'min '<= 'char->integer 'cos 'rationalize 'cadr 'sin 'char=?
+			  'list-set! 'defined? 'memq 'string-ref 'log
+			  'for-each 'map 'nan 'nan-payload
+			  'round 'ceiling 'truncate 'string=? 'atan 'eof-object? 'numerator 'char? 'cosh 'member 'vector
+			  'even? 'string-append 'char-upcase 'sqrt 'my-make-string
+			  'char-alphabetic? 'odd? 'call-with-exit 'tanh 'copy 'sinh 'make-vector
+			  'string 'char-ci=? 'caddr 'tan 'reverse 'cddr 'append 'vector? 'list? 'exp 'acos 'asin 'symbol? 'char-numeric? 'string-ci=?
+			  'char-downcase 'acosh 'vector-length 'asinh 'format
+			  'make-list 'goto?
+			  ;'sort! ; qsort_r has a memory leak if error raised by comparison function
+			  'atanh 'modulo 'make-polar 'gcd 'angle 'remainder 'quotient 'lcm
+			  'char-whitespace? 'assoc 'procedure? 'char<?
+			  'inexact->exact 'vector->list 'boolean? 'undefined? 'unspecified?
+			  'caar (if with-bignums '* 'ash) 'list-tail 'symbol->string 'string->symbol 'exact->inexact
+			  'object->string 'char>? 'symbol->value ;'symbol-initial-value -- needs GC protection normally
+			  'cadar 'integer-decode-float 'string-copy 'cdddr 'logand 'cadddr
+			  'with-input-from-string 'substring 'string->list 'char-upper-case?
+			  'hash-table-set! 'cddddr 'string<? 'dynamic-wind 'call-with-input-file 'error
+			  'lognot 'cdar 'char-ci>=? 'string>=?
+			  'dilambda 'string-ci<? 'char<=? 'logior 'char-ci<=? 'assv
+			  'string>? 'char-ci>? 'char-lower-case? 'string-ci>=? 'string-ci>? 'string<=? 'caadr 'char-ci<?
+			  ;'reverse! ; quasiquoted lists are problematic
+			  'string-ci<=? 'cadadr 'cdadr 'provided? 'caaaar 'caaddr 'caddar 'cdaaar 'cdaadr 'cdaddr 'cddar
+			  ;'fill! ; see _fnc6_
+			  'hash-table-ref 'list->vector 'caaadr 'caaar 'caadar 'cadaar 'cdadar 'cdddar 'string-fill! 'cdaar 'cddaar 'cddadr
+			  'symbol->keyword ; 'string->keyword 'symbol ; size grows
+			  'keyword->symbol 'keyword?
+			  'logxor  'memv 'char-ready?
+			  'exact? 'integer-length ;'port-filename ; -- (load (port-filename)) -> infinite loop
+			  'char>=?
+			  'string-length 'list->string 'inexact?
+			  'with-input-from-file 'type-of
+			  'vector-fill! 'vector-typer 'hash-table-key-typer 'hash-table-value-typer
+			  'peek-char
+			  'make-hash-table 'make-weak-hash-table 'weak-hash-table?
+			  ;'hash-code ; too many uninteresting diffs
+			  'macro?
+			  'quasiquote
+			  'immutable? 'char-position 'string-position
+			  'infinite?
+			  'vector-dimensions 'vector-dimension 'vector-rank 'get-output-string
+			  'sublet 'inlet
+
+			  'call-with-input-string 'documentation
+			  'continuation? 'hash-table? 'port-closed? 'port-position 'port-file 'port-string
+			  'output-port? 'input-port?
+			  ;'provide
+			  'call-with-output-string
+			  'checked-hash-table 'checked-stacktrace 'checked-random 'checked-random-state 'checked-random-state->list 'checked-make-string
+			  'checked-current-input-port 'checked-current-error-port 'checked-funclet 'checked-hash-code
+			  'with-output-to-string
+			  'dilambda?
+			  'hook-functions
+			  'c-pointer->list 'c-pointer-info 'c-pointer-type 'c-pointer-weak1 'c-pointer-weak2
+			  ;'show-profile
+
+			  ;'make-hook ; can get #=1(1 . #1#) as arglist!
+			  'let 'let* 'letrec 'letrec*
+			  ;'lambda 'lambda*  ; these cause built-ins to become locals if with-method=#f?
+			  ;'macro 'macro* 'bacro 'bacro* ; -- same as lambda above
+			  ;'define* 'define-macro 'define-macro* 'define-bacro 'define-bacro* 'define-constant
+			  'define
+			  ;'multiple-value-bind ; (multiple-value-bind (if) ...) gets all kinds of trouble
+			  'call-with-values
+			  'object->let
+
+			  'open-input-string 'open-output-string
+			  'open-input-file
+			  'open-input-function 'open-output-function
+			  'newline
+			  ;'random-state ; pointless diffs
+			  'gensym
+			  'case*
+			  ;'do
+			  ;'cond
+			  'case
+			  'or 'and 'when 'unless 'if 'begin
+			  'with-baffle 'let-temporarily 'with-let
+			  'byte-vector-set! 'my-make-byte-vector
+			  'write-char 'write-byte 'write-string
+			  (reader-cond (with-continuations 'call/cc))
+			  'file-mtime
+			  'write 'display
+			  (reader-cond ((not with-mock-data) 'outlet))
+			  'directory->list
+			  'set! ; this can clobber stuff making recreating a bug tricky
+			  'set-car!
+			  'call-with-output-file 'with-output-to-file
+			  ;'read-char 'read-byte 'read-line 'read-string 'read ; stdin=>hangs
+			  'checked-read-char 'checked-read-line 'checked-read-string 'checked-read-byte ;'checked-read
+			  'checked-reverse! 'checked-port-line-number 'checked-*function*
+			  'close-input-port
+			  ;'current-input-port ;-- too many (read...)
+			  ;'set-current-input-port ; -- collides with rd8 etc
+                          'set-cdr!
+                          ;'unlet ;-- spurious diffs
+                          ;'port-line-number ;-- too many spurious diffs
+			  'load  ; -- (load (port-filename)) ;'current-error-port ;-- spurious output
+			  ;'close-output-port
+			  'hash-table ; -- handled as equivalent via checked-hash-table
+			  'current-output-port
+			  'cutlet
+			  ;'set-current-error-port ;-- too many bogus eq? complaints (it returns previous port)
+			  ;'curlet ; (length (curlet)) too many times
+ 			  ;'open-output-file -- horrible arbitrary undeletable files
+			  ;'delete-file 'set-current-output-port
+			  'autoload
+			  ;'varlet ;-- error exits, chaos in rootlet (see local-varlet)
+			  ;'eval ; -- can't use if signature (circular program) or (make-list (max-list-len))
+			  'checked-eval
+			  ;'immutable! ;-- lots of complaints that are hard to reproduce
+			  'checked-procedure-source
+			  ;'owlet ;too many uninteresting diffs
+			  ;'gc  ; slower? and can be trouble if called within an expression
+			  ;'reader-cond ;-- cond test clause can involve unbound vars: (null? i) for example, and the bugs of eval-time reader-cond are too annoying
+			  ;'funclet ; '*function* ; tons of output in both cases, not interesting
+			  ;'random
+			  ;;; 'quote
+			  '*error-hook* ;'*autoload-hook*
+			  'cond-expand ; (cond-expand (reader-cond...)) too many times
+			  ;'random-state->list
+                          ;'pair-line-number 'pair-filename ; -- too many uninteresting diffs
+			  'let-set!
+			  ;'coverlet ;-- blocks block's equivalent?
+                          'help ;-- snd goes crazy
+			  'macroexpand ;-- uninteresting objstr stuff
+			  'signature ; -- circular lists cause infinite loops with (e.g.) for-each??
+			  'eval-string
+			  'tree-memq 'tree-set-memq 'tree-count 'tree-leaves
+			  'tree-cyclic?
+                          'require
+			  'else '_mac_ '_mac*_ '_bac_ '_bac*_ '_mac1*_ '_fnc1*_
+			  '_fnc_ '_fnc*_ '_fnc1_ '_fnc2_ '_fnc3_ '_fnc4_ '_fnc5_ '_fnc8_ '_fnc9_   ;'_fnc6_
+			  '=>
+
+			  'constant?
+			  '*unbound-variable-hook* '*load-hook* '*rootlet-redefinition-hook* '*missing-close-paren-hook*
+			  '*read-error-hook*
+			  '*after-gc-hook*
+			  '*autoload*
+			  'sequence? 'directory? 'hash-table-entries
+			  'arity 'logbit?
+			  'random-state? 'throw 'float-vector-set! 'make-iterator 'complex
+			  'let-ref 'int-vector 'aritable? 'gensym? 'syntax? 'iterator-at-end? 'let?
+			  'subvector 'float-vector 'iterator-sequence 'getenv 'float-vector-ref
+			  'cyclic-sequences 'let->list
+
+			  'setter 'int-vector?
+			  'int-vector-set! 'c-object? 'c-object-type 'proper-list?
+			  'symbol->dynamic-value
+			  'vector-append
+			  'flush-output-port 'c-pointer 'make-float-vector
+			  'iterate 'float-vector?
+			  'apply-values
+			  'values
+			  'byte-vector-ref 'file-exists? 'make-int-vector 'string-downcase 'string-upcase
+			  'byte-vector 'equivalent? 'make-byte-vector
+			  'c-pointer? 'int-vector-ref
+			  'float?
+			  'list-values 'byte-vector? 'openlet? 'iterator?
+			  (reader-cond ((not with-mock-data) 'openlet))
+			  'string->byte-vector 'byte-vector->string
+
+			  'checked-pp
+			  's7-undefined-identifier-warnings
+			  's7-profile-info
+			  's7-autoloading?
+			  's7-safety
+			  's7-c-types
+			  's7-initial-string-port-length 's7-history-size
+			  's7-default-rationalize-error 's7-equivalent-float-epsilon
+			  's7-hash-table-float-epsilon 's7-bignum-precision
+			  's7-float-format-precision
+			  's7-stacktrace-defaults
+
+			  'block 'make-block 'block? 'block-ref 'block-set!
+			  'blocks 'unsafe-blocks 'blocks1 'unsafe-blocks1 'blocks3 'unsafe-blocks3 'blocks4 'unsafe-blocks4 'blocks5
+			  'values2 'unsafe-values2
+			  'block-reverse! 'subblock 'block-append 'block-let
+			  ;'simple-block? 'make-simple-block ;'make-c-tag ; -- uninteresting diffs
+			  'make-cycle
+			  ;'make-c-tag1 ; from s7test.scm, as above
+
+			  'fvref 'ivref 'bvref 'vref 'fvset 'ivset 'bvset 'vset 'adder
+
+			  'undefined-function
+			  'subsequence
+			  'empty? 'indexable?
+			  ;'adjoin 'cdr-assoc
+			  'progv ;'value->symbol ;-- correctly different values sometimes, progv localizes
+			  'string-case 'concatenate
+			  '2^n? 'lognor 'ldb 'clamp
+			  ;'log-n-of ; uninteresting complaints
+			  ;'sandbox ;-- slow and talkative
+			  'circular-list? ;;'hash-table->alist -- hash map order problem
+			  'weak-hash-table 'byte? 'the 'lognand 'logeqv
+			  'local-random
+			  'local-read-string 'local-varlet 'local-let-set!
+			  ;'pp-checked
+			  'kar '_dilambda_ '_vals_ '_vals1_ '_vals2_
+                          '_vals3_ '_vals4_ '_vals5_ '_vals6_ '_vals3s_ '_vals4s_ '_vals5s_ '_vals6s_
+                          '_svals3_ '_svals4_ '_svals5_ '_svals6_ '_svals3s_ '_svals4s_ '_svals5s_ '_svals6s_
+			  'sym1 'sym2 'sym3 'sym4 'sym5 'sym6 'msym1 'msym2 'msym3  'msym5 ;'msym6 ;'msym4 'msym5 'msym6 'msym8
+			  'fop1 'fop2 'fop3 'tff 'fop4 'fop5 'fop6 'tf7 'tf8 'tf9 'tf10 'tf13 'tf14
+			  'tf15 'tf16 'tf17 'tf18 'tf19 'tf20 'tf21 'tf22 'tf23 'tf24 'tf25 'tf26 'tf27 'fop29
+			  'tf30 'tf31 'tf32 'tf33 'tf34 'f40 'f41
+			  'match?
+			  'catch 'length 'eq? 'car '< 'assq 'complex? 'vector-ref
+			  ;'linter ; infinite loop if cyclic code
+			  'ifa 'ifb ; see fix-op below
+
+			  '_asdf_
+			  'ims 'imbv 'imv 'imiv 'imfv 'imi 'imp 'imh 'ilt
+			  'imv2 'imv3 'imfv2 'imfv3 'imiv2 'imiv3 'imbv2 'imbv3
+			  'vvv 'vvvi 'vvvf 'typed-hash 'typed-vector 'typed-let 'constant-let 'bight
+			  'a1 'a2 'a3 'a4 'a5 'a6
+			  'gb1 'gb2 'gb3
+			  'cf00 'c-function-with-values 'c-macro-with-values 'safe-c-function-with-2-values
+
+			  'bignum 'symbol 'count-if ;'pretty-print
+			  'tree-member 'funclet? 'bignum? 'copy-tree
+			  ;'dynamic-unwind ; many swaps that are probably confused
+                          ;'function-open-output 'function-open-input 'function-get-output 'function-close-output ;see s7test, not set up for t725
+
+			  ))
+
+      (args (vector "-123" "1234" "-3/4" "-1" "1/2" "1+i" "1-i" "0+i" "0-i" "(expt 2 32)" "4294967297" "1001" "10001"
+		    "3441313796169221281/1720656898084610641" "1855077841/1311738121" "4478554083/3166815962" "20057446674355970889/10028723337177985444"
+		    "(cosh 128)" "(cosh (bignum 128.0))" "(bignum -1/2)" "123456789.123456789" "(bignum 1234)" "(bignum 1234.1234)" "(bignum 1+i)"
+		    "(bignum +inf.0)" "(bignum +nan.0)" "(bignum -inf.0)" "(bignum 0+i)" "(bignum 0.0)" "(bignum 0-i)"
+		    "(expt 2 -32)" "1/2+1/3i"
+		    "=>"
+		    "\"ho\"" ":ho" "ho:" "'ho" "(list 1)" "(list 1 2)" "(cons 1 2)" "()" "(list (list 1 2))" "(list (list 1))" "(list ())"
+		    "#f" "#t" "()" "#()" "\"\"" ; ":write" -- not this because sr2 calls write and this can be an arg to sublet redefining write
+		    ":readable" ":rest" ":allow-other-keys" ":display" ":write" ":if" "':abs" ":a" "a:" ":frequency" ":scaler" ; for blocks5 s7test.scm
+		    "1/0+i" "0+0/0i" "0+1/0i" "1+0/0i" "0/0+0/0i" "0/0+i" "+nan.0-3i" "+inf.0-nan.0i"
+		    "cons" "\"ra\"" "''2" "'a" "_!asdf!_" "let-ref-fallback"
+
+		    "#\\a" "#\\A" "#\\x" ;"\"str1\"" "\"STR1\"" "#\\0" "0+." ".0-" ;"#\\"
+		    "(make-hook)" "(make-hook '__x__)"
+		    "1+i" "0+i" "(ash 1 43)"  "(fib 8)" "(fibr 8)" "(fibf 8.0)"
+		    "(integer->char 255)" "(string (integer->char 255))" "(string #\\null)" "(byte-vector 0)"
+		    "pi" "+nan.0" "+nan.123" "+inf.0" "-inf.0" "-nan.0" "1.0e-309"
+		    "(list)" "(string)" "#r()" "#u()" "(vector)" "#i()" "(make-iterator #(10 20))" "#i(1)"
+		    "0" "1" "4" "1.0" "-1.0" "1.0+123.0i" "3/4" "(make-vector 3)" "(make-string 3 #\\space)" "(make-vector '(2 3))"
+		    "'((111 2222) (3 4))" "'((1 (2)) (((3) 4)))" "(byte-vector 255)" "(make-byte-vector '(2 3) 0)"
+		    "#(123 223)" "(vector 1 '(3))" "(let ((x 3)) (lambda (y) (+ x y)))" "abs" "(lambda sym-args sym-args)" "#u(0 1)"
+		    "'((1) (vector 1))" "(abs x)" "(symbol? x)" "(cons x x)" "(cons i i)" "(vector i x)" "(vector x i)"
+		    "(dilambda (lambda () 1) (lambda (a) a))" "quasiquote" "macroexpand" "(lambda* ((a 1) (b 2)) (+ a b))"
+		    "(dilambda (lambda args args) (lambda args args))" "(dilambda (lambda* (a b) a) (lambda* (a b c) c))"
+		    "((lambda (a) (+ a 1)) 2)" "((lambda* ((a 1)) (+ a 1)) 1)" "(lambda (a) (values a (+ a 1)))" "((lambda (a) (values a (+ a 1))) 2)"
+		    "(lambda a (copy a))" "(lambda (a . b) (cons a b))" "(lambda* (a . b) (cons a b))" "(lambda (a b . c) (list a b c))"
+		    "(define-macro (_m1_ a) `(+ ,a 1))" "(define-bacro (_b1_ a) `(* ,a 2))"
+		    "(macro (x) (let ((g (gensym))) (let ((,g ,x)) `(values g g))))"
+		    "((dilambda (lambda () 3) (lambda (x) x)))"
+		    "(macro (a) `(+ ,a 1))" "(bacro (a) `(* ,a 2))" "(macro* (a (b 1)) `(+ ,a ,b))" "(bacro* (a (b 2)) `(* ,a ,b))"
+		    "(macro a `(copy ,a))" "(macro (a . b) `(cons ,a ,b))" "(macro* (a . b) `(cons ,a ,b))" "(macro (a b . c) `(list ,a ,b ,c))"
+		    "(string #\\c #\\null #\\b)" "#2d((100 200) (3 4))" "#r(0 1)" "#i2d((101 201) (3 4))" "#r2d((.1 .2) (.3 .4))" "#i1d(15 25)"
+		    "(values 1 2)" "(values)" "(values #\\c 3 1.2)" "(values \"ho\")" "(values 1 2 3 4 5 6 7 8 9 10)" "(values (define b1 3))"
+		    "(apply values (make-list 128 1/2))"
+		    "(values 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65)"
+		    "(values (values 1 2 3))"
+		    "0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24"
+		    "(log 1.0) (log 2.0)"
+		    "(log 1.0) (log 2.0) (log 3.0)"
+		    "(log 1.0) (log 2.0) (log 3.0) (log 4.0)"
+		    "(log 1.0) (log 2.0) (log 3.0) (log 4.0) (log 5.0)"
+		    "(log 1.0) (log 2.0) (log 3.0) (log 4.0) (log 5.0) (log 6.0) (log 7.0) (log 8.0) (log 9.0) (log 10.0) (log 11.0) (log 12.0) (log 13.0) (log 14.0) (log 15.0) (log 16.0) (log 17.0) (log 18.0) (log 19.0) (log 20.0) (log 21.0) (log 22.0) (log 23.0) (log 24.0) (log 25.0) (log 26.0) (log 27.0) (log 28.0) (log 29.0) (log 30.0) (log 31.0) (log 32.0) (log 33.0) (log 34.0) (log 35.0) (log 36.0) (log 37.0) (log 38.0) (log 39.0) (log 40.0) (log 41.0) (log 42.0) (log 43.0) (log 44.0) (log 45.0) (log 46.0) (log 47.0) (log 48.0) (log 49.0) (log 50.0) (log 51.0) (log 52.0) (log 53.0) (log 54.0) (log 55.0) (log 56.0) (log 57.0) (log 58.0) (log 59.0) (log 60.0) (log 61.0) (log 62.0) (log 63.0) (log 64.0) (log 65.0) (log 66.0) (log 67.0) (log 68.0) (log 69.0) (log 70.0) (log 71.0) (log 72.0) (log 73.0) (log 74.0) (log 75.0) (log 76.0) (log 77.0) (log 78.0) (log 79.0) (log 80.0) (log 81.0) (log 82.0) (log 83.0) (log 84.0) (log 85.0) (log 86.0) (log 87.0) (log 88.0) (log 89.0) (log 90.0) (log 91.0) (log 92.0) (log 93.0) (log 94.0) (log 95.0) (log 96.0) (log 97.0) (log 98.0) (log 99.0) (log 100.0)"
+		    "`(x)" "`(+ x 1)" "`(x 1)" "`((x))" "`((+ x 1))" "`(((+ x 1)))" "`((set! x (+ x 1)) (* x 2))" "`((x 1))" "`(((x 1))) "
+		    "`(x . 1)" "`((x . 1))" "`(1)" "`((1))" "`((1) . x)" "'(- 1)"
+		    "(+ i 1)" "(pi)"
+		    "'(())" "'((()))" ;"(random-state 1234)"
+                    "((if (> 3 2) abs log) 1)" "((if (> 3 2) + -) 3 2)"
+		    "((if (> 3 2) or and) #t #f)"
+		    "float-var" "int-var" "ratio-var" "complex-var"
+		    (reader-cond ((provided? 'number-separator) "1,232"))
+		    "(eval-string \"(reader-cond ((provided? 'surreals) 123))\")"
+		    "(eval-string \"(t725-comment this is a comment)\")"
+
+                    "(apply + (make-list 2 3))" "(let ((a 1) (b 2) (c 3)) (+ a b c))" "(let ((x '(\"asdf\"))) (apply #_format #f x))"
+                    "(cons (cons + -) *)" "(list (list quasiquote +) -1)" "(let ((s '(1 2))) (list (car s) (cdr s)))"
+                    "(let ((i 3)) (list i (expt 2 i)))" "(more-values)" "(- (+ x x) (* x x))"
+
+		    "(c-pointer 0 'integer?)" "(c-pointer -1)" "(c-pointer 1234 1.0 2.0 3.0)" "(c-pointer (bignum 1) (vector) (vector 1) (vector 2))"
+		    "(inlet 'integer? (lambda (f) #f))" "(inlet 'a 1)"
+		    "(openlet (inlet 'abs (lambda (x) (if (real? x) (if (< x 0.0) (- x) x) (error 'wrong-type-arg \"not a real\")))))"
+		    "(openlet (inlet 'zero? (lambda (x) (if (number? x) (= x 0.0) (error 'wrong-type-arg \"not a number\")))))"
+		    "(inlet 'a (inlet 'b 1))" "(if (integer? (with-let ilt (abs -1))) (error 'oops \"oops ilt\"))"
+		    "(L0 'a)" "(L0 :a)" "(let-ref L0 (keyword->symbol :a))" "(let-ref L0 :a)" "(L0 ':a)" "(let-ref L0 'a)"
+		    "'(15 26 . 36)"
+		    ;" . " ; -- read-errors
+		    "((i 0 (+ i 1)))" "(= i 2)" "(zero? i)" "((null? i) i)"
+		    "(#t ())"
+		    "`(+ ,a ,@b)" "`(+ ,a ,b)" "`(+ ,a ,b ,@c)" "`(+ ,a b ,@c ',d)"
+		    "_definee_"
+		    "(hash-table 'a 1.5)" "(hash-table)" "(hash-table 'a (hash-table 'b 1))"
+		    "(weak-hash-table 1.0 'a 2.0 'b 3.0 'c)"
+		    "(make-iterator (list 11 22 33))" "(make-iterator (int-vector 1 2 3))" "(make-iterator (string #\\1))" "(make-iterator x)"
+		    "(make-iterator (make-vector '(2 3) #f))" "(make-iterator #r())"
+		    "(make-iterator (hash-table 'a -1/2 'b 2))"
+		    "(make-iterator (weak-hash-table 1.0 'a 2.0 'b 3.0 'c))"
+		    "(make-iterator (let ((lst '((a . 1) (b . 2) (c . 2)))
+                                          (+iterator+ #t))
+                                      (lambda ()
+                                        (if (pair? lst)
+                                            (let ((res (list (caar lst) (cdar lst))))
+                                              (set! lst (cdr lst)) res)
+                                            #<eof>))))"
+		    (reader-cond
+		     (with-continuations
+		    "(display (call/cc (lambda (return)
+					(let ((val \"line 1~%line 2~%line 3\"))
+					  (call-with-input-string val
+					    (lambda (p) (return 'oops)))))))"
+		    "(display (call-with-exit (lambda (return)
+					(let ((val \"line 1~%line 2~%line 3\"))
+					  (with-input-from-string val
+					    (lambda (p) (return 'oops)))))))"
+		    "(display (call/cc (lambda (return)
+					  (call-with-output-string
+					    (lambda (p) (return 'oops))))))"))
+
+		    "#<eof>" "#<undefined>" "#<unspecified>" "#unknown" "___lst" "#<bignum: 3>"
+		    "#<>" "#<label:>" "#<...>" "..." "(cons #_quote call-with-exit)" ; "(#_quote . call-with-exit)"
+		    "#_and" "'#_or" "#_abs" "#_+"
+		    "#o123" "#b101" "#\\newline" "#\\alarm" "#\\delete" "#_cons" "#x123.123" "#\\x65"
+		    "#i(60 0 0 0 0 1 0 0 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 0 0 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 1 1)"
+		    "#r(0.000000 0.303100 0.261228 0.917131 0.691793 -0.677124 0.027342 -0.014801 1.166154 0.416979 0.851167 1.410955 0.139409 -0.306122 1.416862 1.054300 0.792442 0.062922 1.507148 0.118287 1.375215 1.459904 1.620963 0.828106 -0.237368 0.987982 0.753194 0.096604 1.712227 1.239483 0.673351 0.871862 0.125962 0.260000 0.626286 0.147473 0.131774 0.201212 -0.194457 0.538798 0.418147 1.292448 0.871870 0.794549 0.988888 1.131816 -0.166311 0.052304 0.543793 -0.229410 0.113585 0.733683 0.271039 1.008427 1.788452 0.654055 0.106430 0.828086 0.097436 0.376461)"
+		    "(let ((x 0.0) (y 1.0)) (do ((.i 0 (#_+ .i 1))) ((#_= .i 2) (set! x (#_+ x y))) (set! x (#_* .i .1))))" ; if = is -, infinite loop
+		    "(values 60 0 0 0 0 1 0 0 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 0 0 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 1 1)"
+		    "(values 512 0 0 1 1 0 0 0 0 1 0 0 0 1 0 0 1 0 0 1 1 0 0 1 1 1 0 1 1 1 0 0 1 1 1 0 0 1 1 1 0 1 0 0 0 0 1 1 1 0 0 1 0 0 1 1 0 0 1 0 0 0 1 0 1 1 1 0 1 0 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 0 0 0 0 1 0 0 0 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 0 0 0 0 0 0 1 1 1 0 0 1 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 1 0 1 1 0 0 1 1 1 0 0 1 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 0 0 1 0 0 1 0 0 0 1 0 1 1 0 0 0 1 1 1 0 0 0 0 1 1 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 0 0 1 1 1 0 0 0 0 0 0 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 0 1 1 1 0 0 1 0 1 1 1 1 0 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 1 0 0 1 1 1 1 0 0 0 1 0 0 0 1 1 1 0 0 1 0 0 0 0 0 0 1 1 0 0 0 0 0 0 1 0 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 1 1 0 1 0 1 1 1 1 0 1 0 1 0 1 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 1 1 0 1 0 1 1 0 0 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 0 0 0 0 1 1 0 0 0 0 1 0 1 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 1 0 1 1 0 1 1 1 0 0 1 1 1 1 1 0 0 0 0 1 1 0 0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 1 1 1 0 0 0 0 0 1 0 1)"
+
+		    "(call-with-exit (lambda (goto) goto))"
+		    "(symbol->string 'x)" "(symbol \"a b\")" "(symbol \"(\\\")\")"
+		    "(call-with-exit (lambda (return) (return 'ce)))"
+		    "(call-with-exit (lambda (return) (let ((x 1) (y 2)) (return x y))))"
+		    (reader-cond
+		     (with-continuations
+		    "(with-baffle (call/cc (lambda (cc) (cc 1))))"
+		    "(call/cc (lambda (return) (return 'oops)))"
+		    "(call/cc (lambda (return) (let ((x 1) (y 2)) (return x y))))"))
+		    "(let ((x 1)) (dynamic-wind (lambda () (set! x 2)) (lambda () (+ x 1)) (lambda () (set! x 1))))"
+
+		    "(let-temporarily ((x 1)) x)" "(let-temporarily ((x #(1)) (i 0)) i)"
+
+		    "1+1e10i" "1e15-1e15i" ;"0+1e18i" "-1e18"
+		    ;"(random 1.0)" ; number->string so lengths differ
+		    "(random 1)" "(random 0)" "(random -1)"
+		    ;"(else ())" "(else (f x) B)"
+		    "(else)"
+		    "else" "x" "i" "j" "(+ x 1)" "(+ 1/2 x)" "(abs x)" "(+ x 1 2+i)" "(* 2 x 3.0 4)" "((x 1234))" "((x 1234) (y 1/2))" "'x" "(x 1)"
+		    "_undef_" "(begin |undef1|)" "(setter 'x)" "(setter 'i)"
+
+		    "+signature+" "+documentation+" "+setter+" "+iterator+"
+		    "(let ((+documentation+ \"help\")) (lambda (x) x))"
+		    "(let ((+iterator+ #t)) (lambda () #<eof>))"
+		    "(let ((+signature+ (list 'integer? 'integer?))) (lambda (x) (logand x 1)))"
+		    "(let ((x 1)) (let ((+setter+ (lambda (val) (set! x val)))) (lambda () x)))"
+
+		    "__var2__"
+		    ; "\"~S~%\"" "\"~A~D~X\"" "\"~{~A~^~}~%\"" "\"~NC~&\"" ; -- creates files by these names?
+		    "(call-with-input-file *read-file-name* (lambda (p) p))"
+		    "(call-with-output-string (lambda (p) p))"
+
+		    "ims" "imbv" "imv" "imiv" "imfv" "imi" "imp" "imh"
+		    "imv2" "imv3" "imfv2" "imfv3" "imiv2" "imiv3" "imbv2" "imbv3"
+		    "vvv" "vvvi" "vvvf" "typed-hash" "typed-vector" "typed-let1" "constant-let"
+		    "a1" "a2" "a3" "a4" "a5" "a6"
+		    "x1" "x2" "x3" "x4" "x5" "x6" "x7" "x8" "x9"
+
+		    "(make-hash-table 8 eq? (cons symbol? integer?))"
+		    "(make-hash-table 8 equivalent? (cons symbol? #t))"
+		    "(let ((a 1)) (set! (setter 'a) integer?) (curlet))"
+
+		    "bigi0" "bigi1" "bigi2" "bigrat" "bigflt" "bigcmp" "bigf2" "Hk"
+		    "(ims 1)" "(imbv 1)" "(imv 1)" "(imb 1)" "(imh 'a)" "(imi 'a)"
+		    "V_1" "V_2" "H_1" "H_2" "H_3" "H_4" "H_5" "H_6" "L_6"
+
+		    "(make-iterator (block 1 2 3))"
+		    "(vector-dimensions (block))"
+		    "(append (block) (block))"
+		    "(make-vector 3 (block 0.0) block?)"
+		    "(make-hash-table 8 #f (cons symbol? block?))"
+		    "(make-block 2)" "(block 1.0 2.0 3.0)" "(block)"
+		    "imb"
+		    "(provide 'asdf)" "*features*"
+
+		    (reader-cond
+		     (with-mock-data
+		      "imfi" "imfo" "imr"
+		      "(mock-number 0)" "(mock-number 1-i)" "(mock-number 4/3)" "(mock-number 2.0)"
+		      "(mock-string #\\h #\\o #\\h #\\o)"
+		      "(mock-pair 2 3 4)"
+		      "(mock-char #\\b)"
+		      "(mock-symbol 'c)"
+		      "(mock-vector 1 2 3 4)"
+		      "(mock-hash-table 'b 2)" "(mock-hash-table 'b (mock-number 2))"
+		      "(mock-c-pointer -1)"
+		      ;"(mock-port (open-input-port *read-file-name*))"
+		      "(mock-random-state 1234)"))
+		    "'value"
+
+		    "(subvector 0 3 (vector 0 1 2 3 4))" "(substring \"0123\" 2)" "(vector (lambda (a . b) a))"
+		    "(let-temporarily ((x 1234)) (+ x 1))"
+		    "(error 'oops \"an error!\")"
+		    "(define b2 32)"
+
+		    ;"quote" "'" "(quote)"
+		    ;"(quote . 1)" "(when)" "(when . 1)" ; -- inconsistent error checks if code unreachable
+		    ;"if" ; causes stack overflow when used as lambda arg name and (()... loop)
+		    "begin" "cond" "case" "when" "unless" "letrec" "letrec*" "or" "and" "let-temporarily"
+		    "catch" "call-with-exit" "map" "for-each"
+		    ;"lambda*" "lambda" ;-- cyclic body etc
+		    ;"let" "let*" ;"do" ; infinite loops
+		    "set!" "with-let" "values" "let-set!" ;"define" "define*" "define-macro" "define-macro*" "define-bacro" "define-bacro*"
+
+		    "(let ((L (list 1))) (set-cdr! L L) L)"
+		    "(let ((L (list 1 2))) (set-cdr! (cdr L) L) L)"
+		    "(let ((L (list 1 2 3))) (set-cdr! (cddr L) L) L)"
+		    "(let ((<1> (vector #f))) (set! (<1> 0) <1>) <1>)"
+		    "(let ((<1> (inlet :a #f))) (set! (<1> :a) <1>) <1>)"
+		    "(let ((<1> (hash-table))) (set! (<1> 'a) <1>) <1>)"
+		    "(let ((<1> #f) (<2> (vector #f))) (set! <1> (make-iterator <2>)) (set! (<2> 0) <1>) <1>)"
+		    "(let ((<1> (list 1 #f))) (set! (<1> 1) (let ((<L> (list #f 3))) (set-car! <L> <1>) <L>)) <1>)"
+		    "(let ((cp (list 1))) (set-cdr! cp cp) (list '+ 1 (list 'quote cp)))"
+		    "(let ((cp (list 1))) (set-cdr! cp cp) (list 'quote cp))"
+		    "(let ((cp (list 1))) (set-cdr! cp cp) (list (list quote cp)))"
+
+		    "(let ((lst (list '+ 1))) (set-cdr! (cdr lst) (cdr lst)) (apply lambda () lst ()))"
+		    "(let ((lst (list '+ 1))) (set-cdr! (cdr lst) (cdr lst)) (apply lambda* () lst ()))"
+
+		    "(gensym \"g_123\")"
+		    "(make-list 256 1)" "(make-list 512 '(1))" "big-let" "big-hash"
+		    "(make-vector 256 #f)" "(make-byte-vector 256 0)" "(make-float-vector 256 0.0)" "(make-int-vector 256 0)"
+		    "(make-vector '(2 3) 1)"             "(make-vector '(12 14) #<undefined>)"
+		    "(make-byte-vector '(2 3) 1)"        "(make-byte-vector '(4 32) 255)"
+		    "(make-string 256 #\\1)"             "(make-string 64 #\\a)"
+		    "(make-int-vector '(2 3) 1)"         "(make-int-vector '(2 128) -1)"
+		    "(make-float-vector '(2 3) 1)"       "(make-float-vector '(128 3) pi)"
+		    "(make-vector 3 'a symbol?)"         "(make-vector '(2 3 4 3 2 3 4) 1)"
+		    "(make-vector 3 1+i complex?)"       "(make-vector (make-list 10 2))"
+		    "(make-vector 3 #<eof> eof-object?)" "(make-vector (make-list 256 1))"
+		    "(make-vector 3 '(1) pair?)"
+		    "(make-vector 3 :rest keyword?)"
+		    "(make-vector '(2 3) #f boolean?)"
+		    "(make-vector '(2 3) 'a symbol?)"
+		    "(make-hash-table 8 #f (cons symbol? integer?))"
+		    "(let ((i 32)) (set! (setter 'i) integer?) (curlet))"
+		    "(let ((i 32)) (set! (setter 'i) integer?) (set! i 3) (curlet))"
+
+		    "(make-vector 3 #f bool/int?)"
+		    "(make-float-vector 3 1.0 (lambda (x) (< x pi)))"
+		    "(make-int-vector 3 1 (lambda (x) (< x 3)))"
+		    "(make-byte-vector 3 1 (lambda (x) (> x 0)))"
+		    "(let ((a 1.0)) (set! (setter 'a) (let ((+signature+ '(boolean? #t))) (lambda (x) (real? x)))) (curlet))"
+		    "(make-hash-table 8 #f (cons (lambda (x) (symbol? x)) (lambda (x) (integer? x))))"
+		    "(make-vector 3 #f (lambda (x) #f))" ; if not an error, someone forgot to call it
+		    "(make-hash-table 8 #f (cons (lambda (x) #f) (lambda (x) #f)))" ; same
+		    "(make-vector 3 #f (let ((calls 0)) (lambda (x) (set! calls (+ calls 1)) (= calls 1))))" ; 2 calls = error I hope
+
+		    ;"(write (vector 1.0) (openlet (inlet 'write for-each)))"
+
+		    "(immutable! #(1 2))" "(immutable! #r(1 2))" "(immutable! \"asdf\")" "(immutable! '(1 2))" "(immutable! (hash-table 'a 1))"
+		    ;"(immutable! 'x)"
+		    "(immutable! 'asdf)"
+		    "(lambda (x) (fill! (copy x) 0))"
+
+		    "(map (lambda (x) (catch #t (lambda () (vector->list x)) (lambda (t i) 'err))) (list #(1 2) 1))"
+		    ;"(symbol-table)" ; (make-list 123 (symbol-table))!
+
+		    "(cons-r 0 0 6)"
+		    "(list-r 0 0 6)"
+
+		    ;"(*s7* 'gc-info)"
+		    "(begin (real? (*s7* 'cpu-time)))" ; variable
+		    "(*s7* 'c-types)"
+		    ;"(copy (*s7* 'file-names))" ; one is *stdin* which can hang if read* gets it as the port
+		    ;"(*s7* 'gc-freed)" "(*s7* 'gc-total-freed)" "(*s7* 'free-heap-size)" ; variable
+		    ;"(copy (*s7* 'gc-protected-objects))"  ; access + element set => not protected! perhaps copy it?
+		    ;"(begin (let? (*s7* 'memory-usage)))" ; slow
+		    ;"(*s7* 'most-negative-fixnum)" "(*s7* 'most-positive-fixnum)"
+		    "(*s7* 'rootlet-size)"
+		    ;"(begin (list? (*s7* 'stack)))" "(begin (integer? (*s7* 'stack-size)))" ; variable, and stack can contain e.g. #<unused>
+		    "(*s7* 'version)"
+		    "(*s7* 'stacktrace-defaults)"
+		    "(begin (list? (*s7* 'catches)))"
+		    "(begin (integer? (*s7* 'stack-top)))"
+		    ;(reader-cond ((provided? 'debugging) "(when ((*s7* 'heap-size) < (ash 1 21)) (heap-analyze) (heap-scan 47))")) ;(+ 1 (random 47))))"))
+
+		    "(let loop ((i 2)) (if (> i 0) (loop (- i 1)) i))"
+
+		    ;"(rootlet)" ; why was this commented out? -- very verbose useless diffs
+		    ;"(unlet)"
+		    "(let? (curlet))"
+		    ;"*s7*"     ;variable
+
+		    "(symbol (make-string 130 #\\a))" "(symbol \"a\" \"b\")"
+		    "(symbol \"1\\\\\")" "#\\xff"  "#\\backspace" ":0" "(list (list 1 2) (cons 1 2))"
+		    "#i2d((1 1 1) (2 2 2) (1 1 1))" "(subvector (vector 1 2 3 4 5 6) 0 6 '(2 3))"
+		    "(let ((<1> (vector #f #f #f))) (set! (<1> 0) <1>) (set! (<1> 1) <1>) (set! (<1> 2) <1>) <1>)"
+		    "#i3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2)))"
+		    "(hash-table +nan.0 1)" "#\\7" "(inlet :a (hash-table 'b 1))" "(openlet (immutable! (inlet :a 1)))"
+		    "(subvector #i2d((1 2) (3 4)))" "(subvector #i2d((1 2) (3 4)) 0 4 '(4))" "(subvector #i2d((1 2) (3 4)) 1 3 '(2 1))"
+
+		    "my-let" "my-with-baffle" "fvset" "htset"
+		    "(catch #t (lambda () (+ 1 #(2))) (lambda (type info) 0))"
+		    "~/cl/tmp1.r5rs"
+		    (reader-cond (with-mock-data "(if (> (random 1.0) 0.5) _v_ _mv_)"))
+
+		    #f #f #f ; cyclic here (see get-arg)
+		    ))
+
+      (codes (vector
+	      (list (lambda (s) (string-append "(do ((x 0.0 (+ x 0.1)) (i 0 (+ i 1))) ((>= x .1) (with-immutable (i) " s ")))"))
+		    (lambda (s) (string-append "(let ((x 0.1) (i 1)) (with-immutable (i) " s "))")))
+	      (list (lambda (s) (string-append "(do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (with-immutable (i) (set! x " s ")))"))
+		    (lambda (s) (string-append "(let ((x 0) (i 0)) (with-immutable (i) (set! x " s ")))")))
+	      (list (lambda (s) (string-append "(cond (else " s "))"))
+                    (lambda (s) (string-append "(case x (else " s "))")))
+	      (list (lambda (s) (string-append "(case false ((#f) " s "))"))
+                    (lambda (s) (string-append "(case false ((1) #t) (else " s "))")))
+;	      (list (lambda (s) (string-append "(with-let (rootlet) " s ")"))
+;		    (lambda (s) (string-append "(with-let (sublet (rootlet)) " s ")")))
+	      (reader-cond
+	       (with-continuations
+		(list (lambda (s) (string-append "(call-with-exit (lambda (_x_) " s "))"))
+                      (lambda (s) (string-append "(call/cc (lambda (_x_) " s "))")))
+		(list (lambda (s) (string-append "(let () (let-temporarily ((x 1234)) (call-with-exit (lambda (goto) (goto x))) " s "))"))
+                      (lambda (s) (string-append "(let () (let-temporarily ((x 1234)) (call/cc (lambda (goto) (goto x))) " s "))")))))
+	      (list (lambda (s) (string-append "(if (not x) (begin " s "))"))
+                    (lambda (s) (string-append "(if x #<unspecified> (begin " s "))")))
+	      (list (lambda (s) (string-append "(cond ((not false) " s "))"))
+                    (lambda (s) (string-append "(unless false " s ")")))
+	      (list (lambda (s) (string-append "(let () (let-temporarily ((x 1)) " s "))"))
+                    (lambda (s) (string-append "(let ((x 1)) " s ")")))
+	      (list (lambda (s) (string-append "(_let1_ " s ")"))
+                    (lambda (s) (string-append "(_let2_ " s ")")))
+	      (list (lambda (s) (string-append "(_dw_ " s ")"))
+                    (lambda (s) (string-append "((lambda () " s "))")))
+	      (list (lambda (s) (string-append "(append " s ")"))
+                    (lambda (s) (string-append "(apply append (list " s "))")))
+	      (list (lambda (s) (string-append "(with-let (inlet 'i 0) " s ")"))
+                    (lambda (s) (string-append "(with-let (inlet) (let ((i 0)) " s "))")))
+	      (list (lambda (s) (string-append "(list (_cw_ " s "))"))
+                    (lambda (s) (string-append "(list (values " s "))")))
+	      (list (lambda (s) (string-append "(do () ((not false) " s "))"))
+                    (lambda (s) (string-append "(when (not false) " s ")")))
+	      (list (lambda (s) (string-append "(for-each display (list " s "))")) ; current-output-port is #f (set below)
+                    (lambda (s) (string-append "(for-each (lambda (x) (display x)) (list " s "))")))
+	      (list (lambda (s) (string-append "(_ct1_ " s ")"))
+                    (lambda (s) (string-append "(_ct2_ " s ")")))
+	      (list (lambda (s) (string-append "(with-output-to-string (lambda () " s "))"))
+                    (lambda (s) (string-append "(_dw_out_ " s ")")))
+	      (list (lambda (s) (string-append "(_rf1_ " s ")"))
+                    (lambda (s) (string-append "(_rf2_ " s ")")))
+	      (list (lambda (s) (string-append "(_rf1_ " s ")"))
+                    (lambda (s) (string-append "(_rf3_ " s ")")))
+	      (list (lambda (s) (string-append "(_do1_ " s ")"))
+                    (lambda (s) (string-append "(_do2_ " s ")")))
+	      (list (lambda (s) (string-append "(let ((lt (inlet 'a 1))) (set! (with-let lt a) " s "))"))
+		    (lambda (s) (string-append "(let ((lt (inlet 'a 1))) (set! (lt 'a) " s "))")))
+	      (list (lambda (s) (string-append "(let ((lt (inlet 'a 1))) (set! (with-let ((curlet) 'lt) a) " s "))"))
+		    (lambda (s) (string-append "(let ((lt (inlet 'a 1))) (set! (lt 'a) " s "))")))
+	      (list (lambda (s) (string-append "(set! (_dl_) " s ")"))
+		    (lambda (s) (string-append "(let ((v (vector 0))) (set! (v 0) " s "))")))
+	      (list (lambda (s) (string-append "(let ((x 1)) (immutable! 'x) (begin " s "))"))
+                    (lambda (s) (string-append "((lambda* ((x 1)) (immutable! 'x) " s "))")))
+	      (list (lambda (s) (string-append "(let ((f (lambda* (a (b 1)) (+ a b)))) (f :a " s "))"))
+		    (lambda (s) (string-append "(let ((f (lambda* (a (b 1)) (+ a b)))) (f a: " s "))")))
+	      (list (lambda (s) (string-append "(do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (with-immutable (i j) " s ")))"))
+                    (lambda (s) (string-append "(do ((i 0 (+ i 1))) ((= i 1)) (let ((j 0)) (with-immutable (i j) " s ")))")))
+	      (list (lambda (s) (string-append "(or (_cop1_ " s "))"))
+                    (lambda (s) (string-append "(and (_cop2_ " s "))")))
+	      (list (lambda (s) (string-append "(_do4_ " s ")"))
+                    (lambda (s) (string-append "(_do5_ " s ")")))
+	      (list (lambda (s) (string-append "(_ft1_ " s ")"))
+                    (lambda (s) (string-append "(_ft2_ " s ")")))
+	      (list (lambda (s) (string-append "(_rd3_ " s ")"))
+                    (lambda (s) (string-append "(_rd4_ " s ")")))
+	      (list (lambda (s) (string-append "(_rd5_ " s ")"))
+                    (lambda (s) (string-append "(_rd6_ " s ")")))
+;	      (list (lambda (s) (string-append "(_rd7_ " s ")"))
+;                    (lambda (s) (string-append "(_rd8_ " s ")")))
+;	      (list (lambda (s) (string-append "(format #f \"~S\" (list " s "))"))
+;		    (lambda (s) (string-append "(object->string (list " s "))")))
+;	      (list (lambda (s) (string-append "(_wr1_ " s ")"))
+;                    (lambda (s) (string-append "(_wr2_ " s ")")))
+	      (list (lambda (s) (string-append "(_wr3_ " s ")"))
+                    (lambda (s) (string-append "(_wr4_ " s ")")))
+	      (list (lambda (s) (string-append "(vector " s ")"))
+                    (lambda (s) (string-append "(apply vector (list " s "))")))
+	      (list (lambda (s) (string-append "(hash-table 'a " s ")"))
+                    (lambda (s) (string-append "(apply hash-table (list 'a " s "))")))
+	      (list (lambda (s) (string-append "(byte-vector " s ")"))
+                    (lambda (s) (string-append "(apply byte-vector (list " s "))")))
+	      (list (lambda (s) (string-append "(values " s ")"))
+                    (lambda (s) (string-append "(apply values (list " s "))")))
+	      (list (lambda (s) (string-append "(vector (values " s "))"))
+                    (lambda (s) (string-append "(apply vector (list " s "))")))
+	      (list (lambda (s) (string-append "(vector 1 (values " s "))"))
+                    (lambda (s) (string-append "(apply vector (list 1 " s "))")))
+	      (list (lambda (s) (string-append "(do ((i 0 (+ i 1))) ((= i 1)) (with-immutable (i) " s "))"))
+                    (lambda (s) (string-append "(let ((__x__ 1)) (do ((i 0 (+ i __x__))) ((= i __x__)) (with-immutable (i) " s ")))")))
+	      (list (lambda (s) (string-append "(cond ((eqv? x 0) " s "))"))
+                    (lambda (s) (string-append "(when (eqv? x 0) " s ")")))
+              (list (lambda (s) (string-append "((lambda (a) (and (int-vector? a) (sort! a >))) " s ")"))
+                    (lambda (s) (string-append "((lambda (a) (and (int-vector? a) (sort! a (lambda (x y) (not (<= x y)))))) " s ")")))
+	      (list (lambda (s) (string-append "(_iter_ " s ")"))
+                    (lambda (s) (string-append "(_map_ " s ")")))
+	      (list (lambda (s) (string-append "(_cat1_ " s ")"))
+                    (lambda (s) (string-append "(_cat2_ " s ")")))
+	      (list (lambda (s) s)
+                    (lambda (s) (string-append "(begin " s ")")))
+	      (list (lambda (s) (string-append "(let ((+ -)) " s ")"))
+                    (lambda (s) (string-append "(let () (define + -) " s ")")))
+	      (list (lambda (s) (string-append "(let ((+ -)) (let ((cons list)) " s "))"))
+                    (lambda (s) (string-append "(let ((cons list)) (let ((+ -)) " s "))")))
+	      (list (lambda (s) (string-append "(let () (with-baffle " s "))"))
+                    (lambda (s) (string-append "(let ((mwb with-baffle)) (mwb " s "))")))
+	      (list (lambda (s) (string-append "(let _L_ ((x 1)) (if (> x 0) (_L_ (- x 1)) " s "))"))
+                    (lambda (s) (string-append "(let* _L_ ((x 1)) (if (> x 0) (_L_ (- x 1)) " s "))")))
+	      (list (lambda (s) (string-append "(catch #t (lambda () (+ 1 #\\a)) (lambda (+t+ +i+) " s "))"))
+                    (lambda (s) (string-append "(catch #t (lambda () " s ") (lambda (type info) 'error))")))
+	      (list (lambda (s) (string-append "(let-temporarily ((x (list " s "))) x)"))
+		    (lambda (s) (string-append "(let ((x (list " s "))) x)")))
+	      (list (lambda (s) (string-append "(case 1 ((2 3 1) " s ") (else 'oops))"))
+		    (lambda (s) (string-append "(cond ((= 1 1) " s ") (else 'oops))")))
+	      (list (lambda (s) (string-append "(let ((one 1)) (case one ((2 3 1) => (lambda (i) " s ")) (else 'oops)))"))
+		    (lambda (s) (string-append "(let ((one 1)) (cond (one => (lambda (i) " s ")) (else 'oops)))")))
+	      (list (lambda (s) (string-append "(catch #t (lambda () (let-temporarily ((x (list " s "))) x)) (lambda (type info) 'error))"))
+		    (lambda (s) (string-append "(catch #t (lambda () (let ((x (list " s "))) x)) (lambda (type info) 'error))")))
+	      (list (lambda (s) (string-append "(do ((i 0 (+ i 1))) ((= i 1)) (with-immutable (i) " s "))"))
+                    (lambda (s) (string-append "(do ((j 0 (+ j 1))) ((= j 1)) (do ((i 0 (+ i 1))) ((= i 1)) (with-immutable (i j) " s ")))")))
+	      (list (lambda (s) (string-append "(do ((i 0 (- i 1))) ((= i -1)) (with-immutable (i) " s "))"))
+                    (lambda (s) (string-append "(do ((j 0 (+ j 1))) ((= j 1)) (do ((i 0 (- i 1))) ((= i -1)) (with-immutable (i j) " s ")))")))
+	      (list (lambda (s) (string-append "(do ((i -10 (+ i 1))) ((= i 0)) (with-immutable (i) " s "))"))
+                    (lambda (s) (string-append "(do ((j 0 (+ j 1))) ((= j 1)) (do ((i -10 (+ i 1))) ((= i 0)) (with-immutable (i j) " s ")))")))
+	      (list (lambda (s) (string-append "(do ((i -5 (+ i 1))) ((= i 5)) (with-immutable (i) " s "))"))
+                    (lambda (s) (string-append "(do ((j 0 (+ j 1))) ((= j 1)) (do ((i -5 (+ i 1))) ((= i 5)) (with-immutable (i j) " s ")))")))
+;	      (list (lambda (s) (string-append "(do ((i 0 (+ i 1))) ((= i 1)) (with-immutable (i) (apply values " s " ())))"))
+;                    (lambda (s) (string-append "(do ((j 0 (+ j 1))) ((= j 1)) (do ((i 0 (+ i 1))) ((= i 1)) (with-immutable (i j) (apply values " s " ()))))")))
+	      (list (let ((last-s "#f")) (lambda (s) (let ((res (string-append "(if (car (list " last-s ")) (begin " s "))"))) (set! last-s s) res)))
+                    (let ((last-s "#f")) (lambda (s) (let ((res (string-append "(if (not (car (list " last-s "))) #<unspecified> (begin " s "))"))) (set! last-s s) res))))
+
+	      (list (lambda (s) (string-append "(let ((s1 (begin " s ")) (s2 (copy s1))) (member s1 (list s2)))"))
+                    (lambda (s) (string-append "(let ((s1 (begin " s ")) (s2 (copy s1))) (member s1 (list s2) fequal?))")))
+	      (list (lambda (s) (string-append "(iterate (make-iterator (vector " s ")))"))
+		    (lambda (s) (string-append "(car (list " s "))")))
+	      (list (lambda (s) (string-append "(call-with-exit (lambda (return) (return " s ")))"))
+		    (lambda (s) (string-append "((lambda () (values " s ")))")))
+
+	      (list (lambda (s) (string-append "(let ((x #f)) (for-each (lambda (y) (set! x y)) (list " s ")) x)"))
+		    (lambda (s) (string-append "((lambda (x) (for-each (lambda y (set! x (car y))) (list " s ")) x) #f)")))
+
+	      (list (lambda (s) (string-append "(list (let () (let-temporarily (((*s7* 'openlets) #f)) " s ")))"))
+                    (lambda (s) (string-append "(list (let ((old #f)) (dynamic-wind (lambda () (set! old (*s7* 'openlets)) (set! (*s7* 'openlets) #f)) (lambda () " s ") (lambda () (set! (*s7* 'openlets) old)))))")))
+	      (list (lambda (s) (string-append "(list (let () (let-temporarily (((*s7* 'safety) 1)) " s ")))"))
+                    (lambda (s) (string-append "(list (let ((old #f)) (dynamic-wind (lambda () (set! old (*s7* 'safety))) (lambda () " s ") (lambda () (set! (*s7* 'safety) old)))))")))
+	      ;; perhaps function port (see _rd3_ for open-input-string), gmp?
+	      ))
+
+      (chars (vector #\( #\( #\) #\space))) ; #\' #\/ #\# #\, #\` #\@ #\. #\:))  ; #\\ #\> #\space
+
+  (let ((clen (length chars))
+	(flen (length functions))
+	(alen (length args))
+	(codes-len (length codes))
+	(args-ran (+ 1 (random 5)))
+	(both-ran (+ 3 (random 8))))
+
+    (define (get-arg)
+      (let ((str (args (random alen))))
+	(if (string? str) ; else #f -> cyclic struct
+	    str
+	    (cycler (+ 3 (random 3))))))
+
+    (define (rf-symbol->string sym)
+      (cond ((or (> (random 100) 5)
+		 (syntax? sym)
+		 (syntax? (symbol->value sym)))
+             (symbol->string sym))
+            ((< (random 10) 3)
+             (string-append "(let () " (symbol->string sym) ")"))
+            ((< (random 10) 3)
+             (string-append "((vector " (symbol->string sym) ") 0)"))
+            (else (string-append "#_" (symbol->string sym)))))
+
+    (define (fix-op op)
+      (case op
+	;((set!) "set! _definee_") ;"set!") ; block set! of our vars??
+	((let) "let ()")   ; need to block infinite loops like (let abs () (abs))
+	((let*) "let* ()")
+	((do) "_do3_")
+	((call-with-output-file) "call-with-output-file \"/dev/null\" ")
+	((with-output-to-file) "with-output-to-file \"/dev/null\" ")
+	((define define* define-macro define-macro* define-bacro define-bacro*) (format #f "~A _definee_ " op))
+	((eval) "checked-eval")
+	((ifa) "(if (integer? _definee_) + -)")
+	((ifb) "(if (integer? _definee_) when unless)")
+	(else => rf-symbol->string)))
+
+    (define make-expr
+      (let ((parens 1)
+	    (dqs 0)
+	    (j 1)
+	    (str (make-string 8192 #\space)))
+	(lambda (size)
+	  (set! parens 1)
+	  (set! dqs 0)
+	  (set! j 1)
+	  ;(fill! str #\space)
+	  (set! (str 0) #\()
+
+          (let ((opstr (fix-op (functions (random flen)))))
+            (string-copy opstr str j)
+            (set! j (+ j (length opstr))))
+
+	  (set! (str j) #\space)
+	  (set! j (+ j 1))
+
+	  (do ((k 1 (+ k 1)))
+	      ((= k size))
+
+	    (set! (str j) (chars (random clen)))
+	    (if (= dqs 1)
+		(if (and (char=? (str j) #\")
+			 (or (= j 0)
+			     (not (char=? (str (- j 1)) #\\))))
+		    (set! dqs 0))
+
+		;; else not in a string constant
+		(case (str j)
+		  ((#\()
+		   (set! parens (+ parens 1))
+
+                   (let ((opstr (fix-op (functions (random flen)))))
+                     (string-copy opstr str (+ j 1))
+                     (set! j (+ j 1 (length opstr))))
+		   (set! (str j) #\space))
+
+		  ((#\))
+		   (set! parens (- parens 1))
+		   (when (negative? parens)
+		     (set! (str j) #\space)
+		     (set! parens 0)))
+
+		  ((#\space)
+		   (let ((nargs (random args-ran)))
+		     (do ((n 0 (+ n 1)))
+			 ((= n nargs))
+
+                       (let ((argstr (get-arg)))
+                         (string-copy argstr str (+ j 1))
+                         (set! j (+ j (length argstr) 1)))
+		       ;(set! j (+ j 1))
+		       (set! (str j) #\space))))
+
+		  ((#\")
+		   (set! dqs 1))))
+
+	    (set! j (+ j 1)))
+
+	  (if (= dqs 1)
+	      (set! (str j) #\"))
+
+	  (if (> parens 0)
+	      (do ((k parens (- k 1))
+		   (n j (+ n 1)))
+		  ((= k 0)
+		   (set! j n))
+		(string-set! str n #\))))
+
+	  (substring str 0 j))))
+
+    (define type-eqv?
+      (let ()
+	(define (local-type-of obj)
+	  (if (openlet? obj)
+	      (catch #t
+		(lambda ()
+		  (type-of (obj 'value)))
+		(lambda (type info)
+		  'let?))
+	      (type-of obj)))
+	(lambda (v1 v2 v3 v4)
+	  (let ((v1-type (local-type-of v1)))
+	    (and (or (eq? v1-type (local-type-of v2)) (and (number? v1) (number? v2) (= v1 v2)))
+		 (or (eq? v1-type (local-type-of v3)) (and (number? v1) (number? v3) (= v1 v3)))
+		 (or (eq? v1-type (local-type-of v4)) (and (number? v1) (number? v4) (= v1 v4))))))))
+
+    (define (show-variables str)
+      (if (string-position "int-var" str) (format *stderr* "int-var: ~W~%" int-var))
+      (if (string-position "float-var" str) (format *stderr* "float-var: ~W~%" float-var))
+      (if (string-position "ratio-var" str) (format *stderr* "ratio-var: ~W~%" ratio-var))
+      (if (string-position "complex-var" str) (format *stderr* "complex-var: ~W~%" complex-var))
+      (if (string-position "imi" str) (format *stderr* "imi: ~W~%" imi))
+
+      (if (string-position "a1" str) (format *stderr* "a1: ~W~%" a1))
+      (if (string-position "a2" str) (format *stderr* "a2: ~W~%" a2))
+      (if (string-position "a3" str) (format *stderr* "a3: ~W~%" a3))
+      (if (string-position "a4" str) (format *stderr* "a4: ~W~%" a4))
+      (newline *stderr*)
+
+      (let ((tree (catch #t
+		    (lambda () ; try to catch read errors
+		      (eval-string (string-append "'" str)))
+		    ;;(with-input-from-string str read) -- causes missing close paren troubles with eval-time reader-cond (read error not caught)
+		    (lambda (t i)
+		      ()))))
+	(let walker ((p tree))
+	  (if (symbol? p)
+	      (if (or (setter p) (setter (symbol->value p)))
+		  (format *stderr* "(~S ~S ~S) " p (symbol->value p) (or (setter p) (setter (symbol->value p))))
+		  (format *stderr* "(~S ~S) " p (symbol->value p)))
+	      (when (pair? p)
+		(walker (car p))
+		(walker (cdr p)))))))
+
+    (define (same-type? val1 val2 val3 val4 str str1 str2 str3 str4)
+      (cond ((not (type-eqv? val1 val2 val3 val4))
+	     (unless (or (memq error-type '(out-of-range wrong-type-arg baffled!))
+			 ;; _rd3_ vs _rd4_ for example where one uses dynamic-wind which has built-in baffles
+			 (and (number? val1)
+			      (or (nan? val1)
+				  (infinite? val1)
+				  (and (equivalent? val1 val2)
+				       (equivalent? val1 val3)
+				       (equivalent? val1 val4))))
+			 (equal? val1 "0")
+			 ;(string-position "set! _definee_" str)
+			 (and (iterator? _definee_)
+			      (string-position "_definee_" str)))
+	       (let ((errstr (and (or (eq? val1 'error)
+				      (eq? val2 'error)
+				      (eq? val3 'error)
+				      (eq? val4 'error))
+				  (format #t "    from same-type type-eqv: ~S: ~S~%"
+					  error-type
+					  (if (pair? error-info)
+					      (catch #t
+						(lambda ()
+						  (tp (apply #_format #f error-info)))
+						(lambda (type info)
+						  error-info))
+					      error-info)))))
+		 (set! error-info #f)
+		 (set! error-code "")
+		 (unless (and errstr
+			      (or (not (string? errstr))
+				  (string-position "unbound" errstr)
+				  (string-position "circular" errstr)))
+		   (when (string-position "_definee_" str) (format *stderr* "_definee_: ~W~%" old-definee))
+		   (when (string-position "bigrat" str) (format *stderr* "bigrat: ~W" bigrat))
+		   (when (string-position "-inf.0" str) (format *stderr* "-inf.0: ~W" -inf.0))
+		   (show-variables str)
+		   (format *stderr* "~%~%~S~%~S~%~S~%~S~%    ~A~%    ~A~%    ~A~%    ~A~%"
+			   str1 str2 str3 str4
+			   (tp val1) (tp val2) (tp val3) (tp val4))
+		   (if (string? errstr) (display errstr *stderr*))))))
+
+	    ((or (catch #t
+		   (lambda ()
+		     (and (or (openlet? val1)
+			      (openlet? val3))
+			  (equivalent? v1 v2)
+			  (equivalent? v1 v3)
+			  (equivalent? v1 v4)))
+		   (lambda args
+		     #t)) ; (openlet? (openlet (inlet 'openlet? ()))) -> error: attempt to apply nil to (inlet 'openlet? ())
+		 (string-position "(set!" str1)
+		 (string-position "gensym" str1)))
+
+	    ((symbol? val1)
+	     (if (gensym? val1)
+		 (unless (and (gensym? val2)
+			      (gensym? val3)
+			      (gensym? val4))
+		   (format *stderr* "~%~%~S~%~S~%~S~%~S~%~S~%   ~A ~A ~A ~A~%"
+			   str str1 str2 str3 str4
+			   (tp val1) (tp val2) (tp val3) (tp val4)))
+		 (unless (and (eq? val1 val2)
+			      (eq? val1 val3)
+			      (eq? val1 val4))
+		   (when (string-position "_definee_" str) (format *stderr* "_definee_: ~W~%" old-definee))
+		   (show-variables str)
+		   (format *stderr* "~%~%~S~%~S~%~S~%~S~%~S~%   ~A ~A ~A ~A~%"
+			   str str1 str2 str3 str4
+			   (tp val1) (tp val2) (tp val3) (tp val4))
+		   (if (or (eq? val1 'error)
+			   (eq? val2 'error)
+			   (eq? val3 'error)
+			   (eq? val4 'error))
+		       (catch #t
+			 (lambda ()
+			   (show-variables str)
+			   (format *stderr* "    from same-type symbol: ~S: ~S~%" error-type
+				   (if (and (pair? error-info)
+					    (string? (car error-info)))
+				       (tp (catch #t
+					     (lambda ()
+					       (apply #_format #f error-info))
+					     (lambda (type info)
+					       (format *stderr* "format error symbol? in same-type\n"))))
+				       error-info)))
+			 (lambda args
+			   (format *stderr* "error in format in t725: ~S~%" (list str val1 val2 val3 val4))))))))
+
+	    ((sequence? val1) ; there are too many unreadable/unequivalent-but the same cases to check these by element (goto, continuation, ...)
+	     (let ((len1 (length val1)))
+	       (unless (or (provided? 'gmp)
+			   (let? val1)
+			   (hash-table? val1)
+			   (and (eqv? len1 (length val2))
+				(eqv? len1 (length val3))
+				(eqv? len1 (length val4)))
+			   (and (string? val1)
+				(string->number val1))
+			   ;(string-position "set! _definee_" str)
+			   (and (iterator? _definee_)
+				(string-position "_definee_" str)))
+		 (when (string-position "_definee_" str) (format *stderr* "_definee_: ~W~%" old-definee))
+		 (show-variables str)
+		 (format *stderr* "~%~%~S~%~S~%~S~%~S~%~S~%    ~A~%    ~A~%    ~A~%    ~A~%~%"
+			 str str1 str2 str3 str4
+			 (tp val1) (tp val2) (tp val3) (tp val4)))))
+
+	    ((number? val1)
+	     (when (or (and (nan? val1)
+			    (not (and (nan? val2) (nan? val3) (nan? val4))))
+		       (and (infinite? val1)
+			    (not (and (infinite? val2) (infinite? val3) (infinite? val4))))
+		       (and (finite? val1)
+			    (not (and (finite? val2) (finite? val3) (finite? val4))))
+		       (and (not (= val1 val2))
+			    (not (zero? val1))
+			    (finite? val1) (real? val1) (real? val2) (real? val3) (real? val4)
+			    (or (and (negative? val1) (or (positive? val2) (positive? val3) (positive? val4)))
+				(and (positive? val1) (or (negative? val2) (negative? val3) (negative? val4))))))
+	       (show-variables str)
+	       (format *stderr* "~%~%~S~%~S~%~S~%~S~%~S~%    ~A~%    ~A~%    ~A~%    ~A~%~%"
+		       str str1 str2 str3 str4
+		       (tp val1) (tp val2) (tp val3) (tp val4))))
+
+	    ((or (boolean? val1)
+		 (syntax? val1)
+		 (unspecified? val1)
+		 (char? val1)
+		 (memq val1 '(#<eof> ())))
+	     (unless (or (and (eq? val1 val2)
+			      (eq? val1 val3)
+			      (eq? val1 val4))
+			 ;(string-position "set! _definee_" str)
+			 (and (iterator? _definee_)
+			      (string-position "_definee_" str)))
+	       (when (string-position "_definee_" str) (format *stderr* "_definee_: ~W~%" old-definee))
+	       (show-variables str)
+	       (format *stderr* "~%~%~S~%~S~%~S~%~S~%~S~%   ~A ~A ~A ~A~%"
+		       str str1 str2 str3 str4
+		       (tp val1) (tp val2) (tp val3) (tp val4))))
+
+	    ((or (undefined? val1)
+		 (c-object? val1))
+	     (unless (and (equal? val1 val2)
+			  (equal? val1 val3)
+			  (equal? val1 val4))
+	       (show-variables str)
+	       (format *stderr* "~%~%~S~%~S~%~S~%~S~%~S~%   ~A ~A ~A ~A~%"
+		       str str1 str2 str3 str4
+		       (tp val1) (tp val2) (tp val3) (tp val4))))
+	  ))
+
+    (define (eval-it str)
+      (set! (current-output-port) #f)
+      (set! estr str)
+      (set! old-definee _definee_)
+      (when (and with-mock-data (output-port? imfo)) (get-output-string imfo #t))
+      (catch #t
+	(lambda ()
+	  (car (list (eval-string str))))
+	(lambda (type info)
+	  (set! error-type (copy type))
+	  (set! error-info (copy info))
+	  (set! error-code (copy str))
+	  (when (and last-error-type
+		     (not (eq? error-type last-error-type)))
+	    ;(format *stderr* "~S ~S~%" last-error-type error-type)
+	    (set! last-error-type error-type))
+	  (when (eq? type 'stack-too-big)
+					;     (not (string-position "lambda" str)))
+	    (format *stderr* "stack overflow from ~S~%" str)
+	    (abort))
+	  (when (eq? type 'heap-too-big)
+	    (format *stderr* "heap overflow from ~S~%" str)
+	    (pretty-print (*s7* 'memory-usage) *stderr*)
+	    (newline *stderr*)
+	    (format *stderr* "gc -> ")
+	    (do ((x 0.0) (i 0 (+ i 1))) ((= i 256)) (set! x (complex i i))) ; clear temps
+	    (gc) (gc)
+	    (pretty-print (*s7* 'memory-usage) *stderr*)
+	    (newline *stderr*)
+	    (display "stopping t725...\n" *stderr*)
+	    (abort)) ; to keep Linux from killing the X server!
+	  (unless (or (not (eq? type 'read-error))
+		      (string-position "junk" (car info))
+		      (string-position "clobbered" (car info))
+		      (string-position "unexpected" (car info))
+		      (string-position "eval-string" str))
+	    ;; "unexpected" close paren from: (eval-string (reverse (object->string ()))) -> (eval-string ")(")
+	    (if (and (pair? info) (string? (car info)))
+		(format *stderr* "read-error from ~S: ~S~%" str (catch #t
+								  (lambda ()
+								    (apply #_format #f info))
+								  (lambda args
+								    (format *stderr* "eval-it: inner format error\n"))))
+		(format *stderr* "read-error bad info\n")))
+          'error)))
+
+    (define (try-both str)
+      ;(format *stderr* "~A~%" str)
+      ;(if (string-position " # " str) (format *stderr* "try-both: ~A~%" str))
+      ;(if (> (random 1000) 990) (gc))
+      (set! nostr estr)
+      (set! ostr str)
+      (set! (current-output-port) #f)
+
+      (if (> (random 1.0) 0.5)
+	  (begin
+	    (set! int-var (random (ash 1 30)))
+	    (set! float-var (random 1.0e10))
+	    (set! ratio-var (/ (random (ash 1 30)) (+ 1 (random (ash 1 30)))))
+	    (set! complex-var (complex (random 1.0e10) (random 1.0e10))))
+	  (begin
+	    (set! int-var (random (ash 1 30)))
+	    (set! float-var (random -1.0e10))
+	    (set! ratio-var (/ (random (- (ash 1 30))) (+ 1 (random (ash 1 30)))))
+	    (set! complex-var (complex (random -1.0e10) (random -1.0e10)))))
+
+      (catch #t
+	(lambda ()
+	  (set! curstr str)
+	  ;; this is not the missing ) problem
+	  (s7-optimize (list (catch #t
+			       (lambda ()
+				 (with-input-from-string str read))
+			       (lambda args ())))))
+	(lambda args 'error))
+
+      (set! last-error-type #f)
+      (let* ((outer-funcs (codes (random codes-len)))
+	     (str1 (string-append "(let ((x #f) (i 0)) " ((car outer-funcs) str) ")"))
+	     (str2 (string-append "(let () (define (func) " str1 ") (func) (func))"))
+	     (str3 (string-append "(let ((x #f) (i 0)) " ((cadr outer-funcs) str) ")"))
+	     (str4 (string-append "(let () (define (func) " str3 ") (func) (func))")))
+	(let ((val1 (begin (set! curstr str1) (eval-it str1)))
+	      (val2 (begin (set! curstr str2) (eval-it str2)))
+	      (val3 (begin (set! curstr str3) (eval-it str3)))
+	      (val4 (begin (set! curstr str4) (eval-it str4))))
+	  ;(gc) (gc)
+	  (set! (*s7* 'print-length) 4096)
+	  (same-type? val1 val2 val3 val4 str str1 str2 str3 str4))
+	;(when (eq? outer-funcs last-func) (reseed))
+	(set! last-func outer-funcs))
+
+#|
+      (let ((size (memory-rusage)))
+	(if (> (- size current-size) 100)
+	    (format *stderr* "size: ~S -> ~S, ~S~%" current-size size estr))
+	(set! current-size size))
+|#
+
+      ;(unless (output-port? imfo) (format *stderr* "(new) imfo ~S -> ~S~%" estr imfo) (abort)) ; with-mock-data
+      (set! *features* (copy %features%))
+      (set! error-info #f)
+      (set! error-type 'no-error)
+      (set! error-code "")
+;     (when (pair? x) (format *stderr* "x is pair, estr: ~S~%" estr))
+      (set! x 0)
+#|
+      (when (string-position "H_" str)
+	(if (string-position "H_1" str) (fill! H_1 #f))
+	(if (string-position "H_2" str) (fill! H_2 #f))
+	(if (string-position "H_3" str) (fill! H_3 #f))
+	(if (string-position "H_4" str) (fill! H_4 #f))
+	(if (string-position "H_5" str) (fill! H_5 #f))
+	(when (string-position "H_6" str) (fill! H_6 #f) (hash-table-set! H_6 'a H_6)))
+|#
+      )
+
+    (define dots (vector "." "-" "+" "-" "." "-" "+" "-"))
+    (define (test-it)
+      (do ((m 0 (+ m 1))
+	   (n 0))
+	  (#f
+	   (format *stderr* "reached end of loop??~%"))
+
+	(when (= m 100000)
+	  (set! m 0)
+	  (set! n (+ n 1))
+	  (when (= n 8)
+	    (set! n 0)
+	    (format *stderr* " ~A " (daytime))
+;	    (format *stderr* " ~A " current-size)
+#|
+	    ;; these two tend to become seriously bloated -- maybe add setters
+	    (set! big-let (let ((e (inlet)))
+			    (let-temporarily (((*s7* 'print-length) 80))
+			      (do ((i 0 (+ i 1)))
+				  ((= i 100))
+				(varlet e (symbol "abc" (number->string i)) i)))
+			    e))
+	    (set! big-hash (let ((e (hash-table)))
+			     (let-temporarily (((*s7* 'print-length) 80))
+			       (do ((i 0 (+ i 1)))
+				   ((= i 100))
+				 (hash-table-set! e (symbol "abc" (number->string i)) i)))
+			     e))
+|#
+	    )
+	  (format *stderr* "~A" (vector-ref dots n)))
+
+	(catch #t
+	  (lambda ()
+	    (try-both (make-expr (+ 1 (random both-ran))))) ; min 1 here not 0, was 6
+	  (lambda (type info)
+	    (apply format *stderr* info)
+	    ))))
+
+    (test-it)))
+)
+
+#|
+functions currently omitted (from functions vector):
+unlet owlet *read-error-hook* set-current-output-port immutable! system close-output-port exit
+port-filename load string->keyword dynamic-unwind emergency-exit read set-current-error-port *autoload-hook*
+gc abort open-output-file set-current-input-port pair-line-number pair-filename coverlet delete-file curlet
+
+[read-line] [funclet] [port-line-number] [read-string] [varlet] [random-state] [random] [hash-code] [random-state->list] [current-input-port]
+[make-string] [symbol-table] [current-error-port] [eval] [read-byte] [stacktrace] [read-char] [reverse!] [procedure-source] [*function*]
+[provide] [rootlet] [symbol->dynamic-value] [set-cdr!] [make-hook]
+|#
diff --git a/s7/tools/compare-calls.scm b/s7/tools/compare-calls.scm
new file mode 100644
index 0000000..a58c9c3
--- /dev/null
+++ b/s7/tools/compare-calls.scm
@@ -0,0 +1,350 @@
+;; find where two callgrind runs differ, also combine n callgrind runs
+
+(define (compare-calls f1 f2)
+  (let ((h1 (with-input-from-file f1 read-calls))
+	(total-diff 0)
+	(diffs ())
+	(scl 1e-6))
+
+    (let ((h2 (with-input-from-file f2 read-calls)))
+      (for-each 
+       (lambda (kv1)
+	 (let ((kv2 (h2 (car kv1))))
+	   (let ((diff (if kv2 (- kv2 (cdr kv1)) (- (cdr kv1)))))
+	     (if (> (abs diff) 3e6)
+		 (begin
+		   (set! diffs (cons (list diff (car kv1) (cdr kv1) (or kv2 0)) diffs))
+		   (set! total-diff (+ total-diff diff)))))))
+       h1)
+      (for-each
+       (lambda (kv2)
+	 (let ((kv1 (h1 (car kv2))))
+	   (if (not kv1)
+	       (let ((diff (cdr kv2)))
+		 (if (> (abs diff) 3e6)
+		     (begin
+		       (set! diffs (cons (list diff (car kv2) 0 (cdr kv2)) diffs))
+		       (set! total-diff (+ total-diff diff))))))))
+       h2))
+		 
+    (let ((vals (sort! diffs (lambda (a b) (> (car a) (car b))))))
+      (format *stderr* "total: ~,3F~%" (* scl total-diff))
+      (for-each
+       (lambda (entry)
+	 (format *stderr* "~A~,3F~12T(~,3F~24T~,3F)~40T~A~%" 
+		 (if (negative? (entry 0)) "" " ")
+		 (* scl (entry 0)) 
+		 (* scl (entry 2)) 
+		 (* scl (entry 3)) 
+		 (entry 1)))
+       vals)))
+  (exit))
+
+(define (string->number-ignoring-commas str)
+  (let ((num 0)
+	(tens 1)
+	(len (length str)))
+    (do ((i (- len 1) (- i 1)))
+	((< i 0) num)
+      (if (char-numeric? (str i))
+	  (begin
+	    (set! num (+ num (* tens (- (char->integer (str i)) 48))))
+	    (set! tens (* 10 tens)))))))
+
+(define (read-calls)
+  ;; throw away the header
+  (do ((i 0 (+ i 1)))
+      ((= i 25))
+    (read-line))
+  ;; read about 500 lines and store in a hash table as (func . timing)
+  ;; names can match!
+  (let ((h (make-hash-table)))
+    (call-with-exit
+     (lambda (quit)
+       (do ((i 0 (+ i 1)))
+	   ((= i 500))
+	 (let ((line (read-line)))
+	   (if (eof-object? line)
+	       (quit))
+	   (let ((len (length line)))
+	     (do ((k 0 (+ k 1)))
+		 ((or (= k len)
+		      (not (char-whitespace? (line k))))
+		  (if (< k len)
+		      (let ((end (char-position #\space line k)))
+			(if end
+			    (let ((num (string->number-ignoring-commas (substring line k end))))
+			      (when num
+				(let ((func-end (char-position #\space line (+ end 2))))
+				  (when (and (integer? func-end)
+					     (> func-end (+ end 2)))
+				    (let ((func (substring line (+ end 2) func-end)))
+				      (let ((colon-pos (char-position #\: func)))
+					(if (integer? colon-pos)
+					    (let ((isra-pos (char-position #\. func colon-pos)))
+					      (if (integer? isra-pos)
+						  (set! func (substring func 0 isra-pos))))))
+				      (let ((sym (string->symbol func)))
+					(let ((curval (h sym)))
+					  (set! (h sym) (+ (or curval 0) num)))))))))))))))))))
+    h))
+    
+
+(define (get-overheads file)
+  (with-input-from-file file
+    (lambda ()
+      (let ((overheads ())
+	    (total 0))
+
+	(define (get-overheads-1 file line)
+	  (let ((len (min 20 (length line))))
+	    (do ((i 0 (+ i 1)))
+		((or (= i len)
+		     (not (char-whitespace? (line i))))
+		 (if (and (< i (- len 4))
+			  (char=? (line i) #\.)
+			  (char=? (line (+ i 1)) #\space)
+			  (char=? (line (+ i 2)) #\space)
+			  (char-alphabetic? (line (+ i 3))))
+		     (let ((next-line (read-line)))
+		       (let ((nlen (length next-line)))
+			 (if (char=? (next-line (- nlen 1)) #\{)
+			     (do ((j 0 (+ j 1)))
+				 ((or (= j nlen)
+				      (and (char-numeric? (next-line j))
+					   (let ((cost (string->number-ignoring-commas (substring next-line j (- nlen 3)))))
+					     (set! total (+ total cost))
+					     (set! overheads (cons (list cost (substring line (+ i 3) (min 80 (length line)))) overheads)))))))
+			     (get-overheads-1 file next-line)))))))))
+	
+	(do ((line (read-line) (read-line)))
+	    ((eof-object? line) overheads)
+	  (get-overheads-1 file line))
+			     
+	(set! overheads (sort! overheads (lambda (a b) (< (car a) (car b)))))
+	(format *stderr* "~{~^~A~%~}" (list-tail overheads (max 10 (- (length overheads) 20))))
+	(format *stderr* "total: ~A~%" total)))))
+
+
+(define (read-all-calls)
+  ;; throw away the header
+  (do ((i 0 (+ i 1)))
+      ((= i 25))
+    (read-line))
+  (let ((h (make-hash-table)))
+    (call-with-exit
+     (lambda (quit)
+       (do () ()
+	 (let ((line (read-line)))
+	   (if (or (eof-object? line)
+		   (and (= (length line) 80)
+			(char=? (line 0) #\-)))
+	       (quit))
+	   (let ((len (length line)))
+	     (do ((k 0 (+ k 1)))
+		 ((or (= k len)
+		      (not (char-whitespace? (line k))))
+		  (if (< k len)
+		      (let ((end (char-position #\space line k)))
+			(if end
+			    (let ((num (string->number-ignoring-commas (substring line k end))))
+			      (when num
+				(let ((func-end (char-position #\space line (+ end 2))))
+				  (when (and (number? func-end)
+					     (> func-end (+ end 2)))
+				    (let* ((name (substring line (+ end 2) func-end))
+					   (len (length name)))
+				      (if (and ;(not (char=? (name 0) #\?))
+					       (not (char=? (name 0) #\/))
+					       (or (< len 3)
+						   (not (char=? (name (- len 2)) #\')))
+					       (or (< len 8)
+						   (not (string=? "libgsl_" (substring name 0 7)))))
+					  (set! (h (string->symbol name)) num)))))))))))))))))
+    h))
+
+(define (combine . files)
+  (let ((tables (map (lambda (file)
+		       (with-input-from-file file
+			 read-all-calls))
+		     files)))
+    (let ((h (make-hash-table)))
+      (for-each
+       (lambda (file table)
+	 (for-each
+	  (lambda (entry)
+	    (let ((current-entry (h (car entry))))
+	      (if current-entry
+		  (set! (h (car entry)) 
+			(cons (max (cdr entry)
+				   (car current-entry))
+			      (cons (list file (cdr entry))
+				    (cdr current-entry))))
+		  (set! (h (car entry))
+			(cons (cdr entry)
+			      (list (list file (cdr entry))))))))
+	  table))
+       files tables)
+
+      (let ((v (copy h (make-vector (hash-table-entries h)))))
+	(set! v (sort! v (lambda (a b) (> (cadr a) (cadr b)))))
+	(call-with-output-file "test.table"
+	  (lambda (p)
+	    (for-each
+	     (lambda (entry)
+	       (format p "~A: ~A ~{~%~16T~{~A~32T ~A~}~}~%" (car entry) (cadr entry) (cddr entry)))
+	     v)))))))
+
+(define (combine-latest)
+  (let ((file-names (list 
+		     "v-index"
+		     "v-mac"
+		     "v-peak"
+		     "v-vect"
+		     "v-eq"
+		     "v-fft"
+		     "v-ref"
+		     "v-auto"
+		     "v-test"
+		     "v-cop"
+		     "v-lt"
+		     "v-form"
+		     "v-read"
+		     "v-map"
+		     "v-mat"
+		     "v-misc"
+		     "v-iter"
+		     "v-sort"
+		     "v-let"
+		     "v-hash"
+		     "v-gen"
+		     "v-all"
+		     "v-call"
+		     "v-sg"
+		     "v-dup"
+		     "v-set"
+		     "v-rec"
+		     "v-clo"
+		     "v-big"
+		     "v-shoot"
+		     "v-fb"
+		     "v-rclo"
+		     "v-case"
+		     ;"v-b"
+		     "v-io"
+		     "v-gc"
+		     "v-num"
+		     "v-mock"
+		     "v-str"
+		     "v-gsl"
+		     "v-list"
+		     "v-load"
+		     "v-cb"
+		     "v-ari"
+		     "v-exit"
+		     "v-left"
+		     "v-obj"
+		     "v-imp"
+		     "v-lamb"
+		     "v-hook"
+		     "v-star")))
+    (define (next-file f)
+      (let ((name (system (format #f "ls -t ~A*" f) #t)))
+	(let ((len (length name)))
+	  (do ((i 0 (+ i 1)))
+	      ((or (= i len)
+		   (and (char-numeric? (name i))
+			(char-numeric? (name (+ i 1)))))
+	       (string-append f (substring name i (+ i 2))))))))
+
+    (apply combine (map next-file file-names))))
+
+
+#|
+;;; show all timing test overheads
+
+(define (get-overheads file)
+  (with-input-from-file file
+    (lambda ()
+      (let ((overheads ())
+	    (total 0))
+
+	(define (get-overheads-1 file line)
+	  (let ((len (min 20 (length line))))
+	    (do ((i 0 (+ i 1)))
+		((or (= i len)
+		     (not (char-whitespace? (line i))))
+		 (if (and (< i (- len 4))
+			  (char=? (line i) #\.)
+			  (char=? (line (+ i 1)) #\space)
+			  (char=? (line (+ i 2)) #\space)
+			  (char-alphabetic? (line (+ i 3))))
+		     (let ((next-line (read-line)))
+		       (let ((nlen (length next-line)))
+			 (if (char=? (next-line (- nlen 1)) #\{)
+			     (do ((j 0 (+ j 1)))
+				 ((or (= j nlen)
+				      (and (char-numeric? (next-line j))
+					   (let ((cost (string->number-ignoring-commas (substring next-line j (- nlen 3)))))
+					     (set! total (+ total cost))
+					     (set! overheads (cons (list cost (substring line (+ i 3) (min 80 (length line)))) overheads)))))))
+			     (get-overheads-1 file next-line)))))))))
+	
+	(do ((line (read-line) (read-line)))
+	    ((eof-object? line))
+	  (get-overheads-1 file line))
+			     
+	(set! overheads (sort! overheads (lambda (a b) (< (car a) (car b)))))
+	(list-tail overheads (max 10 (- (length overheads) 20)))))))
+
+
+(define file-names '(("make-index.scm" . "/home/bil/motif-snd/v-index85")
+		     ("tmac.scm" . "/home/bil/motif-snd/v-mac85")
+		     ("tpeak.scm" . "/home/bil/motif-snd/v-peak85")
+		     ("tvect.scm" . "/home/bil/motif-snd/v-vect85")
+		     ("teq.scm" . "/home/bil/motif-snd/v-eq85")
+		     ("tfft.scm" . "/home/bil/motif-snd/v-fft85")
+		     ("tref.scm" . "/home/bil/motif-snd/v-ref85")
+		     ("tauto.scm" . "/home/bil/motif-snd/v-auto85")
+		     ("s7test.scm" . "/home/bil/motif-snd/v-test85")
+		     ("tcopy.scm" . "/home/bil/motif-snd/v-cop85")
+		     ("lt.scm" . "/home/bil/motif-snd/v-lt85")
+		     ("tform.scm" . "/home/bil/motif-snd/v-form85")
+		     ("tread.scm" . "/home/bil/motif-snd/v-read85")
+		     ("tmap.scm" . "/home/bil/motif-snd/v-map85")
+		     ("tmat.scm" . "/home/bil/motif-snd/v-mat85")
+		     ("tmisc.scm" . "/home/bil/motif-snd/v-misc85")
+		     ("titer.scm" . "/home/bil/motif-snd/v-iter85")
+		     ("tsort.scm" . "/home/bil/motif-snd/v-sort85")
+		     ("tlet.scm" . "/home/bil/motif-snd/v-let85")
+		     ("thash.scm" . "/home/bil/motif-snd/v-hash85")
+		     ("tmap-hash.scm" . "/home/bil/motif-snd/v-map-hash85")
+                     ("tmv.scm" . "/home/bil/motif-snd/v-mv85")
+		     ("tgen.scm" . "/home/bil/motif-snd/v-gen85")
+		     ("tall.scm" . "/home/bil/motif-snd/v-all85")
+		     ("snd-test.scm" . "/home/bil/motif-snd/v-call85")
+		     ("full-snd-test.scm" . "/home/bil/motif-snd/v-sg85")
+		     ("dup.scm" . "/home/bil/motif-snd/v-dup85")
+		     ("tset.scm" . "/home/bil/motif-snd/v-set85")
+		     ("trec.scm" . "/home/bil/motif-snd/v-rec85")
+		     ("tclo.scm" . "/home/bil/motif-snd/v-clo85")
+		     ("tbig.scm" . "/home/bil/motif-snd/v-big85")
+		     ("tshoot.scm" . "/home/bil/motif-snd/v-shoot85")
+		     ("fbench.scm" . "/home/bil/motif-snd/v-fb85")
+		     ("trclo.scm" . "/home/bil/motif-snd/v-rclo85")
+		     ("tcase.scm" . "/home/bil/motif-snd/v-case85")
+		     ;("test-all.scm" . "/home/bil/motif-snd/v-b85")
+		     ("tio.scm" . "/home/bil/motif-snd/v-io85")
+		     ("tgc.scm" . "/home/bil/motif-snd/v-gc85")
+		     ("tnum.scm" . "/home/bil/motif-snd/v-num85")
+		     ("tmock.scm" . "/home/bil/motif-snd/v-mock85")
+		     ("concordance.scm" . "/home/bil/motif-snd/v-str85")
+                     ("tgsl.scm" . "/home/bil/motif-snd/v-gsl85")
+		     ))
+
+(for-each (lambda (file)
+	    (format *stderr* "-------- ~S:\n~{~S~%~^~}~%" (car file) (reverse (get-overheads (cdr file)))))
+	  file-names)
+|#
+
+
diff --git a/s7/tools/concordance.scm b/s7/tools/concordance.scm
new file mode 100644
index 0000000..cde42d0
--- /dev/null
+++ b/s7/tools/concordance.scm
@@ -0,0 +1,716 @@
+;;; string and char timing
+
+(define (concord)
+  (call-with-output-file "test.cx"
+    (lambda (op)
+      (call-with-input-file "s7.c"
+	(lambda (ip)
+	  (let ((words (make-hash-table))
+		(cur-word (make-string 512))
+		(word "")
+		(cur-line 1)
+		(last-c #\null))
+	    (do ((cur-loc 0)
+		 (c (read-char ip) (read-char ip)))
+		((eof-object? c)
+		 (for-each (lambda (w)
+			     (format op "~A: ~S~%" (car w) (reverse (cdr w))))
+			   words))
+	      (if (or (char-alphabetic? c)
+		      (char=? c #\_)
+		      (and (char-numeric? c)
+			   (positive? (length cur-word))))
+		  (begin 
+		    (string-set! cur-word cur-loc c)
+		    (set! cur-loc (+ cur-loc 1)))
+		  (begin
+		    (cond ((char=? c #\newline)
+			   (set! cur-line (+ cur-line 1)))
+
+			  ((and (char=? c #\*)
+				(char=? last-c #\/))
+			   (let ((last-c1 #\null))
+			     (do ((c1 (read-char ip) (read-char ip)))
+				 ((and (char=? c1 #\/)
+				       (char=? last-c1 #\*)))
+			       (if (char=? c1 #\newline)
+				   (set! cur-line (+ cur-line 1)))
+			       (set! last-c1 c1))))
+
+			  ((and (char=? c #\")
+				(not (char=? last-c #\')))               ; '"' 
+			   (let ((last-c1 #\null)
+				 (last-c2 #\null))
+			     (do ((c1 (read-char ip) (read-char ip)))
+				 ((and (char=? c1 #\")
+				       (or (not (char=? last-c1 #\\))    ; \"
+					   (char=? last-c2 #\\))))       ; \\"
+			       (if (char=? c1 #\newline)
+				   (set! cur-line (+ cur-line 1)))
+			       (set! last-c2 last-c1)
+			       (set! last-c1 c1)))))
+		    (set! last-c c)
+		    (when (positive? cur-loc)
+		      (set! word (substring-uncopied cur-word 0 cur-loc)) ; hashing won't trigger a GC here, so this should be safe
+		      (hash-table-set! words word ; in non-code text we'd probably want string-downcase here and below
+				       (cons cur-line (or (hash-table-ref words word) ()))))
+		    (set! cur-loc 0))))))))))
+
+
+;;; --------------------------------
+
+(define (searcher)
+  ;; }\n}
+  (call-with-input-file "s7.c"
+    (lambda (p)
+      (let ((last1 "")
+	    (last-i 0))
+	(do ((this (read-line p) (read-line p))
+	     (line 0 (+ line 1)))
+	    ((eq? this #<eof>))
+	  (let ((len (length this)))
+	    (unless (or (= len 0)
+			(char=? (string-ref this 0) #\}))
+	      (do ((i 0 (+ i 1)))
+		  ((or (>= i len)
+		       (not (char-whitespace? (string-ref this i))))
+		   (when (and (< i len) ; i.e. not char-whitespace above
+		              (char=? (string-ref this i) #\})
+		              (> (length last1) 0)
+		              (char=? (string-ref last1 last-i) #\})
+			      (not (string-position "} while" last1)))
+	             (format () "~D ~S~%" line last1))
+		   (set! last-i i)
+		   (set! last1 this))))))))))
+
+
+;;; --------------------------------
+;;; various simple cases
+
+(define (strcop str) ; opt_dotimes
+  (let* ((len (length str))
+	 (new-str (make-string len)))
+    (do ((i 0 (+ i 1)))
+	((= i len) new-str)
+      (string-set! new-str i (string-ref str i)))))
+
+(define (strup str)
+  (let* ((len (length str))
+	 (new-str (make-string len)))
+    (do ((i 0 (+ i 1)))
+	((= i len) new-str)
+      (string-set! new-str i (char-upcase (string-ref str i))))))
+
+(define (let-strup str)
+  (let* ((len (length str))
+	 (new-str (make-string len)))
+    (let loop ((i 0))
+      (cond ((= i len) new-str)
+	    (else 
+	     (string-set! new-str i (char-upcase (string-ref str i)))
+	     (loop (+ i 1)))))))
+
+
+(define tc-cpos ; op_tc_if_a_z_if_a_z_la [opt]
+  (let ((len 0)
+	(c #f)
+	(str #f))
+    (define (cpos-1 pos)
+      (if (= pos len)
+	  #f
+	  (if (char=? c (string-ref str pos))
+	       pos
+	       (cpos-1 (+ pos 1)))))
+    (lambda (c1 str1)
+      (set! len (length str1))
+      (set! c c1)
+      (set! str str1)
+      (cpos-1 0))))
+
+(define rev-cpos  ; op_tc_if_a_z_if_a_la_z [opt, same as direct case]
+  (let ((len 0)
+	(c #f)
+	(str #f))
+    (define (cpos-rev pos)
+      (if (= pos len)
+	  #f
+	  (if (not (char=? c (string-ref str pos)))
+	      (cpos-rev (+ pos 1))
+	      pos)))
+    (lambda (c1 str1)
+      (set! len (length str1))
+      (set! c c1)
+      (set! str str1)
+      (cpos-rev 0))))
+
+(define tc2-cpos ; op_tc_if_a_z_if_a_z_laa
+  (let ((len 0)
+	(str #f))
+    (define (cpos-2 c pos)
+      (if (= pos len)
+	  #f
+	  (if (char=? c (string-ref str pos))
+	       pos
+	       (cpos-2 c (+ pos 1)))))
+    (lambda (c1 str1)
+      (set! len (length str1))
+      (set! str str1)
+      (cpos-2 c1 0))))
+
+(define cond2-cpos ; op_tc_cond_a_z_if_a_z_laa
+  (let ((len 0)
+	(str #f))
+    (define (cond2-cpos-2 c pos)
+      (cond ((= pos len) #f)
+	    ((char=? c (string-ref str pos)) pos)
+	    (else (cond2-cpos-2 c (+ pos 1)))))
+    (lambda (c1 str1)
+      (set! len (length str1))
+      (set! str str1)
+      (cond2-cpos-2 c1 0))))
+
+(define cond2-cposrev ; op_tc_cond_a_z_if_a_laa_z
+  (let ((len 0)
+	(str #f))
+    (define (cond2-cposrev-2 c pos)
+      (cond ((= pos len) #f)
+	    ((not (char=? c (string-ref str pos))) (cond2-cposrev-2 c (+ pos 1)))
+	    (else pos)))
+    (lambda (c1 str1)
+      (set! len (length str1))
+      (set! str str1)
+      (cond2-cposrev-2 c1 0))))
+
+(define tc3-cpos ; eval? (there is no op_tc_if_a_z_if_a_z_l3a)
+  (let ((len 0))
+    (define (cpos-3 c str pos)
+      (if (= pos len)
+	  #f
+	  (if (char=? c (string-ref str pos))
+	       pos
+	       (cpos-3 c str (+ pos 1)))))
+    (lambda (c1 str1)
+      (set! len (length str1))
+      (cpos-3 c1 str1 0))))
+
+(define and-cpos 
+  (let ((len 0)
+	(c #f)
+	(str #f))
+    (define (and-cpos-1 pos)
+      (and (< pos len)
+	   (if (char=? c (string-ref str pos))
+	       pos
+	       (and-cpos-1 (+ pos 1)))))
+    (lambda (c1 str1)
+      (set! len (length str1))
+      (set! c c1)
+      (set! str str1)
+      (and-cpos-1 0))))
+
+(define andrev-cpos 
+  (let ((len 0)
+	(c #f)
+	(str #f))
+    (define (andrev-cpos-1 pos)
+      (and (< pos len)
+	   (if (not (char=? c (string-ref str pos)))
+	       (andrev-cpos-1 (+ pos 1))
+	       pos)))
+    (lambda (c1 str1)
+      (set! len (length str1))
+      (set! c c1)
+      (set! str str1)
+      (andrev-cpos-1 0))))
+
+(define cond-cpos ; op_tc_if_a_z_if_a_z_la [opt]
+  (let ((len 0)
+	(c #f)
+	(str #f))
+    (define (cond-cpos-1 pos)
+      (cond ((= pos len)
+	     #f)
+	    ((char=? c (string-ref str pos))
+	     pos)
+	    (else (cond-cpos-1 (+ pos 1)))))
+    (lambda (c1 str1)
+      (set! len (length str1))
+      (set! c c1)
+      (set! str str1)
+      (cond-cpos-1 0))))
+
+(define condrev-cpos 
+  (let ((len 0)
+	(c #f)
+	(str #f))
+    (define (condrev-cpos-1 pos)
+      (cond ((= pos len)
+	     #f)
+	    ((not (char=? c (string-ref str pos)))
+	     (condrev-cpos-1 (+ pos 1)))
+	    (else pos)))
+    (lambda (c1 str1)
+      (set! len (length str1))
+      (set! c c1)
+      (set! str str1)
+      (condrev-cpos-1 0))))
+
+(define (do-cpos c str) ; op_dox
+  (do ((len (length str))
+       (i 0 (+ i 1)))
+      ((or (= i len)
+	   (char=? c (string-ref str i)))
+       (and (< i len)
+	    i))))
+
+(define (let-cpos c str)
+  (let ((len (length str)))
+    (let loop ((i 0))
+      (cond ((= i len) #f)
+	    ((char=? c (string-ref str i)) i)
+	    (else (loop (+ i 1)))))))
+
+(define (call-cpos c str)
+  (call-with-exit
+   (lambda (return)
+     (do ((len (length str))
+	  (i 0 (+ i 1)))
+	 ((= i len) #f)
+       (if (char=? c (string-ref str i))
+	   (return i))))))
+
+
+(define tc-spos ; op_tc_if_a_z_if_a_z_la, substr+start&end [opt]
+  (let ((len 0)
+	(flen 0)
+	(slen 0)
+	(find #f)
+	(str #f))
+    (define (spos-1 pos)
+      (if (= pos slen)
+	  #f
+	   (if (string=? find (substring str pos (+ pos flen)))
+	       pos
+	       (spos-1 (+ pos 1)))))
+    (lambda (find1 str1)
+      (set! len (length str1))
+      (set! flen (length find1))
+      (set! slen (- len flen -1))
+      (set! str str1)
+      (set! find find1)
+      (spos-1 0))))
+
+(define and-spos
+  (let ((len 0)
+	(flen 0)
+	(slen 0)
+	(find #f)
+	(str #f))
+    (define (and-spos-1 pos)
+      (and (< pos slen)
+	   (if (string=? find (substring str pos (+ pos flen)))
+	       pos
+	       (and-spos-1 (+ pos 1)))))
+    (lambda (find1 str1)
+      (set! len (length str1))
+      (set! flen (length find1))
+      (set! slen (- len flen -1))
+      (set! str str1)
+      (set! find find1)
+      (and-spos-1 0))))
+
+(define andrev-spos
+  (let ((len 0)
+	(flen 0)
+	(slen 0)
+	(find #f)
+	(str #f))
+    (define (andrev-spos-1 pos)
+      (and (< pos slen)
+	   (if (not (string=? find (substring str pos (+ pos flen))))
+	       (andrev-spos-1 (+ pos 1))
+	       pos)))
+    (lambda (find1 str1)
+      (set! len (length str1))
+      (set! flen (length find1))
+      (set! slen (- len flen -1))
+      (set! str str1)
+      (set! find find1)
+      (andrev-spos-1 0))))
+
+(define cond-spos ; op_tc_if_a_z_if_a_z_la [opt]
+  (let ((len 0)
+	(flen 0)
+	(slen 0)
+	(find #f)
+	(str #f))
+    (define (cond-spos-1 pos)
+      (cond ((= pos slen)
+	     #f)
+	    ((string=? find (substring str pos (+ pos flen)))
+	     pos)
+	    (else (cond-spos-1 (+ pos 1)))))
+    (lambda (find1 str1)
+      (set! len (length str1))
+      (set! flen (length find1))
+      (set! slen (- len flen -1))
+      (set! str str1)
+      (set! find find1)
+      (cond-spos-1 0))))
+
+(define (do-spos find str)
+  (let ((len (length str))
+	(flen (length find)))
+    (do ((slen (- len flen -1))
+	 (i 0 (+ i 1)))
+	((or (= i slen)
+	     (string=? find (substring str i (+ i flen))))
+	 (and (< i slen)
+	      i)))))
+
+(define (call-spos find str)
+  (let* ((len (length str))
+	 (flen (length find))
+	 (slen (- len flen -1)))
+    (call-with-exit
+     (lambda (return)
+       (do ((i 0 (+ i 1)))
+	   ((= i slen) #f)
+	 (if (string=? find (substring str i (+ i flen)))
+	     (return i)))))))
+
+
+(define (char-count c str)
+  (do ((pos (char-position c str 0) (char-position c str (+ pos 1)))
+       (count 0 (+ count 1)))
+      ((not pos) count)))
+
+(define (do-count c str)
+  (let ((len (length str)))
+    (do ((i 0 (+ i 1))
+	 (count 0))
+	((= i len) count)
+      (if (char=? c (string-ref str i))
+	  (set! count (+ count 1))))))
+
+(define tc-count
+  (let ((c #f)
+	(str #f)
+	(len 0))
+    (define (tc-count-1 pos count)
+      (if (= pos len)
+	  count
+	  (tc-count-1 (+ pos 1)
+		      (if (char=? c (string-ref str pos)) (+ count 1) count))))
+    (lambda (c1 str1)
+      (set! c c1)
+      (set! str str1)
+      (set! len (length str1))
+      (tc-count-1 0 0))))
+
+(define (let-count c str)
+  (let ((len (length str)))
+    (let loop ((pos 0) (count 0))
+      (if (= pos len)
+	  count
+	  (loop (+ pos 1)
+		(if (char=? c (string-ref str pos)) (+ count 1) count))))))
+    
+
+
+(let ((val (strcop "asdfghjkl")))
+  (unless (string=? val "asdfghjkl") (format *stderr* "strcop ~S: ~S~%" "asdfghjkl" val))
+  (set! val (strup "abcdefghij"))
+  (unless (string=? val "ABCDEFGHIJ") (format *stderr* "strup ~S: ~S~%" "abcdefghij" val))
+  (set! val (let-strup "abcdefghij"))
+  (unless (string=? val "ABCDEFGHIJ") (format *stderr* "let-strup ~S: ~S~%" "abcdefghij" val))
+
+  (set! val (tc-cpos #\a "123456789a12343"))
+  (unless (eqv? val 9) (format *stderr* "tc-cpos ~C ~S: ~S~%" #\a "123456789a12343" val))
+
+  (set! val (tc2-cpos #\a "123456789a12343"))
+  (unless (eqv? val 9) (format *stderr* "tc2-cpos ~C ~S: ~S~%" #\a "123456789a12343" val))
+
+  (set! val (cond2-cpos #\a "123456789a12343"))
+  (unless (eqv? val 9) (format *stderr* "cond2-cpos ~C ~S: ~S~%" #\a "123456789a12343" val))
+
+  (set! val (cond2-cposrev #\a "123456789a12343"))
+  (unless (eqv? val 9) (format *stderr* "cond2-cposrev ~C ~S: ~S~%" #\a "123456789a12343" val))
+
+  (set! val (tc3-cpos #\a "123456789a12343"))
+  (unless (eqv? val 9) (format *stderr* "tc3-cpos ~C ~S: ~S~%" #\a "123456789a12343" val))
+
+  (set! val (do-cpos #\a "123456789a12343"))
+  (unless (eqv? val 9) (format *stderr* "do-cpos ~C ~S: ~S~%" #\a "123456789a12343" val))
+
+  (set! val (let-cpos #\a "123456789a12343"))
+  (unless (eqv? val 9) (format *stderr* "let-cpos ~C ~S: ~S~%" #\a "123456789a12343" val))
+
+  (set! val (and-cpos #\a "123456789a12343"))
+  (unless (eqv? val 9) (format *stderr* "and-cpos ~C ~S: ~S~%" #\a "123456789a12343" val))
+
+  (set! val (andrev-cpos #\a "123456789a12343"))
+  (unless (eqv? val 9) (format *stderr* "andrev-cpos ~C ~S: ~S~%" #\a "123456789a12343" val))
+
+  (set! val (call-cpos #\a "123456789a12343"))
+  (unless (eqv? val 9) (format *stderr* "call-cpos ~C ~S: ~S~%" #\a "123456789a12343" val))
+
+  (set! val (cond-cpos #\a "123456789a12343"))
+  (unless (eqv? val 9) (format *stderr* "cond-cpos ~C ~S: ~S~%" #\a "123456789a12343" val))
+
+  (set! val (condrev-cpos #\a "123456789a12343"))
+  (unless (eqv? val 9) (format *stderr* "condrev-cpos ~C ~S: ~S~%" #\a "123456789a12343" val))
+
+  (set! val (rev-cpos #\a "123456789a12343"))
+  (unless (eqv? val 9) (format *stderr* "rev-cpos ~C ~S: ~S~%" #\a "123456789a12343" val))
+
+
+  (set! val (tc-spos "asdf" "fdsghjkasdfhjgfrkl"))
+  (unless (eqv? val 7) (format *stderr* "tc-spos ~S ~S: ~S~%" "asdf" "fdsghjkasdfhjgfrkl" val))
+
+  (set! val (do-spos "asdf" "fdsghjkasdfhjgfrkl"))
+  (unless (eqv? val 7) (format *stderr* "do-spos ~S ~S: ~S~%" "asdf" "fdsghjkasdfhjgfrkl" val))
+
+  (set! val (and-spos "asdf" "fdsghjkasdfhjgfrkl"))
+  (unless (eqv? val 7) (format *stderr* "and-spos ~S ~S: ~S~%" "asdf" "fdsghjkasdfhjgfrkl" val))
+
+  (set! val (tc-spos "asdf" "fdsghjkasdf"))
+  (unless (eqv? val 7) (format *stderr* "tc-spos ~S ~S: ~S~%" "asdf" "fdsghjkasdf" val))
+
+  (set! val (do-spos "asdf" "fdsghjkasdf"))
+  (unless (eqv? val 7) (format *stderr* "do-spos ~S ~S: ~S~%" "asdf" "fdsghjkasdf" val))
+
+  (set! val (and-spos "asdf" "fdsghjkasdf"))
+  (unless (eqv? val 7) (format *stderr* "and-spos ~S ~S: ~S~%" "asdf" "fdsghjkasdf" val))
+
+  (set! val (andrev-spos "asdf" "fdsghjkasdf"))
+  (unless (eqv? val 7) (format *stderr* "andrev-spos ~S ~S: ~S~%" "asdf" "fdsghjkasdf" val))
+
+  (set! val (tc-spos "asdf" "fdsghjkasd"))
+  (when val (format *stderr* "tc-spos ~S ~S: ~S~%" "asdf" "fdsghjkasd" val))
+
+  (set! val (do-spos "asdf" "fdsghjkasd"))
+  (when val (format *stderr* "do-spos ~S ~S: ~S~%" "asdf" "fdsghjkasd" val))
+
+  (set! val (and-spos "asdf" "fdsghjkasd"))
+  (when val (format *stderr* "and-spos ~S ~S: ~S~%" "asdf" "fdsghjkasd" val))
+
+  (set! val (andrev-spos "asdf" "fdsghjkasd"))
+  (when val (format *stderr* "andrev-spos ~S ~S: ~S~%" "asdf" "fdsghjkasd" val))
+
+  (set! val (call-spos "asdf" "fdsghjkasd"))
+  (when val (format *stderr* "call-spos ~S ~S: ~S~%" "asdf" "fdsghjkasd" val))
+
+  (set! val (cond-spos "asdf" "fdsghjkasd"))
+  (when val (format *stderr* "cond-spos ~S ~S: ~S~%" "asdf" "fdsghjkasd" val)))
+
+
+(define-macro (time . expr) 
+  `(let ((start (*s7* 'cpu-time)))
+     (do ((k 0 (+ k 1))) ((= k 4)) ,@expr)
+     (- (*s7* 'cpu-time) start)))
+
+(newline *stderr*)
+
+(define (simple-tests size)
+  (let ((bigstr (make-string size)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (string-set! bigstr i (integer->char (+ 33 (random 94)))))
+    (string-set! bigstr (- size 10) #\space)
+    (string-set! bigstr (- size 9) #\a)
+
+    (let ((t1 (time (strup bigstr)))
+	  (t2 (time (string-upcase bigstr)))
+	  (t3 (time (let-strup bigstr))))
+      (format *stderr* "strup: ~D ~D~%" (round (/ t1 t2)) (round (/ t3 t2)))
+
+      (set! t1 (time (strcop bigstr)))
+      (set! t2 (time (copy bigstr)))
+      (format *stderr* "strcop: ~D~%" (round (/ t1 t2)))
+
+      (set! t2 (* 0.5 (time (char-position #\space bigstr) (char-position #\space bigstr))))
+      (set! t1 (time (do-cpos #\space bigstr)))
+      (format *stderr* "do-cpos: ~D~%" (round (/ t1 t2)))
+
+
+      (set! t1 (time (tc-cpos #\space bigstr)))
+      (format *stderr* "tc-cpos: ~D~%" (round (/ t1 t2)))
+
+      (set! t1 (time (tc2-cpos #\space bigstr)))
+      (format *stderr* "tc2-cpos: ~D~%" (round (/ t1 t2)))
+
+      (set! t1 (time (cond2-cpos #\space bigstr)))
+      (format *stderr* "cond2-cpos: ~D~%" (round (/ t1 t2)))
+
+      (set! t1 (time (cond2-cposrev #\space bigstr)))
+      (format *stderr* "cond2-cposrev: ~D~%" (round (/ t1 t2)))
+
+      (set! t1 (time (tc3-cpos #\space bigstr)))
+      (format *stderr* "tc3-cpos: ~D~%" (round (/ t1 t2)))
+
+      (set! t1 (time (and-cpos #\space bigstr)))
+      (format *stderr* "and-cpos: ~D~%" (round (/ t1 t2)))
+
+      (set! t1 (time (andrev-cpos #\space bigstr)))
+      (format *stderr* "andrev-cpos: ~D~%" (round (/ t1 t2)))
+
+      (set! t1 (time (call-cpos #\space bigstr)))
+      (format *stderr* "call-cpos: ~D~%" (round (/ t1 t2)))
+
+      (set! t1 (time (cond-cpos #\space bigstr)))
+      (format *stderr* "cond-cpos: ~D~%" (round (/ t1 t2)))
+
+      (set! t1 (time (condrev-cpos #\space bigstr)))
+      (format *stderr* "condrev-cpos: ~D~%" (round (/ t1 t2)))
+
+      (set! t1 (time (rev-cpos #\space bigstr)))
+      (format *stderr* "rev-cpos: ~D~%" (round (/ t1 t2)))
+
+      (set! t1 (time (let-cpos #\space bigstr)))
+      (format *stderr* "let-cpos: ~D~%" (round (/ t1 t2)))
+
+
+      (set! t2 (* 0.5 (time (string-position " a" bigstr) (string-position " a" bigstr))))
+      (set! t1 (time (tc-spos " a" bigstr)))
+      (format *stderr* "tc-spos: ~D~%" (round (/ t1 t2)))
+
+      (set! t1 (time (do-spos " a" bigstr)))
+      (format *stderr* "do-spos: ~D~%" (round (/ t1 t2)))
+
+      (set! t1 (time (and-spos " a" bigstr)))
+      (format *stderr* "and-spos: ~D~%" (round (/ t1 t2)))
+
+      (set! t1 (time (andrev-spos " a" bigstr)))
+      (format *stderr* "andrev-spos: ~D~%" (round (/ t1 t2)))
+
+      (set! t1 (time (call-spos " a" bigstr)))
+      (format *stderr* "call-spos: ~D~%" (round (/ t1 t2)))
+
+      (set! t1 (time (cond-spos " a" bigstr)))
+      (format *stderr* "cond-spos: ~D~%" (round (/ t1 t2)))
+
+      (let ((c1 0) (c2 0) (c3 0) (c4 0) (t3 0) (t4 0))
+	(set! t1 (time (set! c1 (char-count #\a bigstr))))
+	(set! t2 (time (set! c2 (do-count #\a bigstr))))
+	(set! t3 (time (set! c3 (tc-count #\a bigstr))))
+	(set! t4 (time (set! c4 (let-count #\a bigstr))))
+	(format *stderr* "counts: ~S ~S ~S ~S, times: ~D ~D ~D~%" 
+		c1 c2 c3 c4 
+		(round (/ t2 t1)) (round (/ t3 t1)) (round (/ t4 t1)))))
+
+    (do ((i 0 (+ i 1)))
+	((= i 20))
+      (strup bigstr)
+      (string-upcase bigstr)
+      (tc-cpos #\space bigstr)
+      (do-cpos #\space bigstr)
+      (char-position #\space bigstr)
+      (tc-spos " a" bigstr)
+      (do-spos " a" bigstr)
+      (string-position " a" bigstr)
+      (strcop bigstr)
+      (copy bigstr))))
+
+
+;;; --------------------------------
+
+(define apropos
+  (let ((levenshtein
+	 (lambda (s1 s2)
+	   (let ((L1 (length s1))
+		 (L2 (length s2)))
+	     (cond ((zero? L1) L2)
+		   ((zero? L2) L1)
+		   (else (let ((distance (make-vector (list (+ L2 1) (+ L1 1)) 0)))
+			   (do ((i 0 (+ i 1)))
+			       ((> i L1))
+			     (vector-set! distance 0 i i))
+			   (do ((i 0 (+ i 1)))
+			       ((> i L2))
+			     (vector-set! distance i 0 i))
+			   (do ((i 1 (+ i 1)))
+			       ((> i L2))
+			     (do ((j 1 (+ j 1)))
+				 ((> j L1))
+			       (let ((c1 (+ (vector-ref distance i (- j 1)) 1))
+				     (c2 (+ (vector-ref distance (- i 1) j) 1))
+				     (c3 (if (char=? (string-ref s2 (- i 1)) (string-ref s1 (- j 1)))
+					     (vector-ref distance (- i 1) (- j 1))
+					     (+ (vector-ref distance (- i 1) (- j 1)) 1))))
+				 (vector-set! distance i j (min c1 c2 c3)))))
+			   (vector-ref distance L2 L1)))))))
+	
+	(make-full-let-iterator             ; walk the entire let chain
+	 (lambda* (lt (stop (rootlet)))
+	   (if (eq? stop lt)
+	       (make-iterator lt)
+	       (letrec ((iterloop
+			 (let ((iter (make-iterator lt))
+			       (+iterator+ #t))
+			   (lambda ()
+			     (let ((result (iter)))
+			       (if (and (eof-object? result)
+					(iterator-at-end? iter)
+					(not (eq? stop (iterator-sequence iter))))
+				   (begin
+				     (set! iter (make-iterator (outlet (iterator-sequence iter))))
+				     (iterloop))
+				   result))))))
+		 (make-iterator iterloop))))))
+    
+    (lambda* (name (e (curlet)))
+      (let ((ap-name (if (string? name) name
+			 (if (symbol? name)
+			     (symbol->string name)
+			     (error 'wrong-type-arg "apropos argument 1 should be a string or a symbol"))))
+	    (ap-env (if (let? e) e
+			(error 'wrong-type-arg "apropos argument 2 should be an environment"))))
+	(let ((strs ())
+	      (min2 (floor (log (length ap-name) 2))))
+	  (for-each
+	   (lambda (binding)
+	     (if (pair? binding)
+		 (let ((symbol-name (symbol->string (car binding))))
+		   (if (string-position ap-name symbol-name)
+		       (set! strs (cons (cons binding 0) strs))
+		       (let ((distance (levenshtein ap-name symbol-name)))
+			 (if (< distance min2)
+			     (set! strs (cons (cons binding distance) strs))))))))
+	   (make-full-let-iterator ap-env))
+	  
+	  (if (not (pair? strs))
+	      'no-match
+	      (let ((data "")
+		    (name-len (length name)))
+		(for-each (lambda (b)
+			    (set! data (string-append data
+						      (if (> (length data) 0) (string #\newline) "")
+						      (if (procedure? (cdar b))
+							  (let ((doc (documentation (cdar b)))) ; returns "" if no doc
+							    (if (positive? (length doc))
+								doc
+								(object->string (caar b))))
+							  (object->string (caar b))))))
+			  (sort! strs (lambda (a b)
+					(or (< (cdr a) (cdr b))
+					    (and (= (cdr a) (cdr b))
+						 (< (abs (- (length (symbol->string (caar a))) name-len))
+						    (abs (- (length (symbol->string (caar b))) name-len))))))))
+		data)))))))
+
+(define (apropos-test)
+  (do ((i 0 (+ i 1)))
+      ((= i 15))
+    (apropos "cadd")
+    (apropos "version")
+    (apropos "cd")))
+
+(concord)
+(simple-tests 100000)
+(searcher)
+(apropos-test)
+
+
+(#_exit)
+
diff --git a/s7/tools/dup.scm b/s7/tools/dup.scm
new file mode 100644
index 0000000..987f086
--- /dev/null
+++ b/s7/tools/dup.scm
@@ -0,0 +1,140 @@
+;;; dup.scm
+;;; (dup size file alloc-lines):
+;;;    find all matches of "size" successive lines in "file" ignoring empty lines and leading/trailing whitespace
+;;;    "alloc-lines" is any number bigger than the number of lines in "file"
+;;;    (dups 16 "s7.c" 91000) finds all 16-line matches in s7.c which (we wish) has less than 91000 lines in all
+
+(define dup
+  (let ((unique #f))
+
+    (define-constant (all-positive? start len)
+      (do ((j (+ start len) (- j 1)))
+	  ((or (vector-ref unique j)
+	       (= j start))
+	   j)))
+
+    (lambda (size file alloc-lines)
+      (let ((lines (make-vector alloc-lines ""))
+	    (original-lines (make-vector alloc-lines ""))
+	    (lens (make-int-vector alloc-lines))
+	    (linenums (make-int-vector alloc-lines))
+	    (size-1 0)
+	    (reported-already (make-vector alloc-lines #f)))
+	(set! unique (make-vector alloc-lines #f))
+
+	(call-with-input-file file
+	  (lambda (p)
+	    ;; get lines, original and trimmed
+	    (let ((total-lines
+		   (do ((i 0 (+ i 1))
+			(j 0)
+			(line (read-line p) (read-line p)))
+		       ((eq? line #<eof>) j)
+		     ;; save original lines
+		     (vector-set! original-lines i line)
+		     (let ((len (length line)))
+		       (when (> len 0)
+			 ;; trim leading whitespace
+			 (do ((k 0 (+ k 1)))
+			     ((or (= k len)
+				  (not (char-whitespace? (string-ref line k))))
+			      (when (> k 0)
+				(set! line (substring line k))
+				(set! len (- len k)))))
+			 ;; trim trailing whitespace
+			 (when (> len 0)
+			   (do ((j (- len 1) (- j 1)))
+			       ((or (< j 0)
+				    (not (char-whitespace? (string-ref line j))))
+				(unless (= j (- len 1))
+				  (set! line (substring line 0 (+ j 1)))
+				  (set! len (+ j 1)))))
+			   (when (> len 0)
+			     (int-vector-set! linenums j i)
+			     (vector-set! lines j line)
+			     (int-vector-set! lens j (length line))
+			     (set! j (+ j 1)))))))))
+
+	      (set! size (min size total-lines))
+	      (set! size-1 (- size 1))
+	      ;; (format *stderr* "lines: ~S~%" total-lines)         ; 84201 2-jul-19, 89690 29-Aug-20, 85715 28-May-22, 88607 17-Jan-24
+
+	      ;; mark unmatchable strings
+	      (let ((sortv (make-vector total-lines)))
+		(do ((i 0 (+ i 1)))
+		    ((= i total-lines))
+		  (vector-set! sortv i (cons (vector-ref lines i) i)))
+		(set! sortv (sort! sortv (lambda (a b)
+					   (string<? (car a) (car b)))))
+		(let ((unctr -1)
+		      (matches #f)
+		      (current (vector-ref sortv 0)))
+		  (for-each (lambda (srt)
+			      (if (string=? (car current) (car srt))
+				  (set! matches #t)
+				  (begin
+				    (unless matches
+				      (int-vector-set! lens (cdr current) unctr)
+				      (vector-set! unique (cdr current) #t) ; unique = (negative? (lens...))
+				      (set! unctr (- unctr 1)))
+				    (set! matches #f)
+				    (set! current srt))))
+			    sortv)
+		  ;; (format *stderr* "unmatched: ~D~%" (abs unctr)) ; 33796
+		  ))
+
+	      ;; look for matches
+	      (do ((first #t #t)
+		   (last-line (- total-lines size))
+		   (i 0 (+ i 1)))
+		  ((>= i last-line)) ; >= because i is set below
+		(unless (vector-ref reported-already i) ; this match was reported earlier
+		  (let ((j (all-positive? i size-1)))   ; is a match possible?
+		    (if (not (= j i))
+			(set! i j)
+			(let ((lenseq (subvector lens i (+ i size)))
+			      (lineseq (subvector lines i (+ size i))))
+			  (do ((k (+ i 1) (+ k 1)))
+			      ((or (>= i k)   ; i incremented by full-size when local matches end
+				   (>= k last-line)))
+			    (let ((jk (all-positive? k size-1)))
+			      (if (not (= jk k))
+				  (set! k jk)
+				  (when (and (equal? lenseq (subvector lens k (+ size k)))
+					     (equal? lineseq (subvector lines k (+ size k))))
+				    (vector-set! reported-already k #t)
+				    (let ((full-size size))
+				      (do ((nk (+ k size) (+ nk 1))
+					   (ni (+ i size) (+ ni 1)))  ; here if i==k we run to the end and quit
+					  ((or (= nk total-lines)
+					       (not (= (int-vector-ref lens ni) (int-vector-ref lens nk)))
+					       (not (string=? (vector-ref lines ni) (vector-ref lines nk))))
+					   (set! full-size (- nk k))))
+				      (if first
+					  (let ((first-line (int-vector-ref linenums i)))
+					    (vector-set! reported-already i #t)
+					    (format *stderr* "~NC~%~{~A~%~}~%  lines ~D ~D" 8 #\- ; lineseq
+						    (subvector original-lines first-line (int-vector-ref linenums (+ i size)))
+						    first-line
+						    (int-vector-ref linenums k))
+					    (set! first #f))
+					  (format *stderr* " ~D" (int-vector-ref linenums k)))
+				      (set! i (+ i full-size))
+				      (when (< size full-size)
+					(format *stderr* "[~D]" full-size)))))))
+			  (unless first
+			    (format *stderr* "~%")))))))))))))
+  )
+
+(set! (*s7* 'heap-size) 4096000)
+
+(dup 16 "s7.c" 110000)
+;(dup 12 "s7.c" 110000)
+;(dup 8 "s7.c" 110000)
+;(dup 12 "ffitest.c" 10000)
+;(dup 8 "ffitest.c" 10000)
+;(dup 1 "s7test.scm" 110000)
+
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(exit)
diff --git a/s7/tools/fbench.scm b/s7/tools/fbench.scm
new file mode 100644
index 0000000..5fa7696
--- /dev/null
+++ b/s7/tools/fbench.scm
@@ -0,0 +1,239 @@
+;;;  John Walker's Floating Point Benchmark, derived from...
+;;;
+;;;  Marinchip Interactive Lens Design System
+;;;
+;;;  By John Walker
+;;;     http://www.fourmilab.ch/
+;;;
+;;;  This program may be used, distributed, and modified freely as
+;;;  long as the origin information is preserved.
+;;;
+;;;  This is a complete optical design raytracing algorithm,
+;;;  stripped of its user interface and recast into Common Lisp.
+;;;  It not only determines execution speed on an extremely
+;;;  floating point (including trig function) intensive
+;;;  real-world application, it checks accuracy on an algorithm
+;;;  that is exquisitely sensitive to errors.  The performance of
+;;;  this program is typically far more sensitive to changes in
+;;;  the efficiency of the trigonometric library routines than the
+;;;  average floating point program.
+;;;
+;;;  Ported from the C language implementation in September 2005
+;;;  by John Walker.
+;;;
+;;;  Ported to s7 20-May-2019
+
+;;      Wavelengths of standard spectral lines in Angstroms
+(define spectral-line
+  '(( A-line . 7621.0 )	        ; A
+    ( B-line . 6869.955 )       ; B
+    ( C-line . 6562.816 )       ; C
+    ( D-line . 5895.944 )       ; D
+    ( E-line . 5269.557 )       ; E
+    ( F-line . 4861.344 )       ; F
+    ( Gprime-line . 4340.477 )  ; G'
+    ( H-line . 3968.494 )))     ; H
+
+(define D-light (cdr (assq 'D-line spectral-line)))
+(define C-light (cdr (assq 'C-line spectral-line)))
+(define F-light (cdr (assq 'F-line spectral-line)))
+
+;;      The test case used in this program is the design for a 4 inch
+;;      f/12 achromatic telescope objective used as the example in Wyld's
+;;      classic work on ray tracing by hand, given in Amateur Telescope
+;;      Making, Volume 3 (Volume 2 in the 1996 reprint edition).
+(define testcase
+  '(( 27.05 1.5137 63.6 0.52 )
+    ( -16.68 1 0 0.138 )
+    ( -16.68 1.6164 36.7 0.38 )
+    ( -78.1 1 0 0 )))
+
+(define default-iteration-count 100000)
+
+;;      Reference results.  These happen to be derived from a
+;;      run on Microsoft Quick BASIC on the IBM PC/AT.
+(define reference-results
+  '("   Marginal ray          47.09479120920   0.04178472683"
+    "   Paraxial ray          47.08372160249   0.04177864821"
+    "Longitudinal spherical aberration:        -0.01106960671"
+    "    (Maximum permissible):                 0.05306749907"
+    "Offense against sine condition (coma):     0.00008954761"
+    "    (Maximum permissible):                 0.00250000000"
+    "Axial chromatic aberration:                0.00448229032"
+    "    (Maximum permissible):                 0.05306749907"))
+
+(define current-surfaces 0)
+(define paraxial 0)
+(define clear-aperture 0)
+(define aberr-lspher 0)
+(define aberr-osc 0)
+(define aberr-lchrom 0)
+(define max-lspher 0)
+(define max-osc 0)
+(define max-lchrom 0)
+(define radius-of-curvature 0.0)
+(define object-distance 0.0)
+(define ray-height 0)
+(define axis-slope-angle 0)
+(define from-index 0)
+(define to-index 0)
+
+;;      Calculate passage through surface
+;;
+;;      If the variable paraxial is 1, the trace through the
+;;      surface will be done using the paraxial approximations.
+;;      Otherwise, the normal trigonometric trace will be done.
+;;
+;;      This subroutine takes the following global inputs:
+;;
+;;      radius-of-curvature     Radius of curvature of surface
+;;                              being crossed.  If 0, surface is
+;;                              plane.
+;;
+;;      object-distance         Distance of object focus from
+;;                              lens vertex.  If 0, incoming
+;;                              rays are parallel and
+;;                              the following must be specified:
+;;
+;;      ray-height              Height of ray from axis.  Only
+;;                              relevant if $object-distance == 0
+;;
+;;      axis-slope-angle        Angle incoming ray makes with axis
+;;                              at intercept
+;;
+;;      from-index              Refractive index of medium being left
+;;
+;;      to-index                Refractive index of medium being
+;;                              entered.
+;;
+;;      The outputs are the following global variables:
+;;
+;;      object-distance         Distance from vertex to object focus
+;;                              after refraction.
+;;
+;;      axis-slope-angle        Angle incoming ray makes with axis
+;;                              at intercept after refraction.
+
+(define (transit-surface)
+  (let ((iang-sin 0))
+    (if (= paraxial 1)
+	(if (= radius-of-curvature 0.0)
+	    (begin
+	      (set! object-distance (* object-distance (/ to-index from-index)))
+	      (set! axis-slope-angle (* axis-slope-angle (/ from-index to-index))))
+	    (begin
+	      (if (= object-distance 0.0)
+		  (begin
+		    (set! axis-slope-angle 0.0)
+		    (set! iang-sin (/ ray-height radius-of-curvature)))
+		  (set! iang-sin (* (/ (- object-distance radius-of-curvature) radius-of-curvature) axis-slope-angle)))
+	      (let ((rang-sin (* (/ from-index to-index) iang-sin))
+		    (old-axis-slope-angle axis-slope-angle))
+		(set! axis-slope-angle (- (+ axis-slope-angle iang-sin) rang-sin))
+		(if (not (= object-distance 0.0))
+		    (set! ray-height (* object-distance old-axis-slope-angle)))
+		(set! object-distance (/ ray-height axis-slope-angle)))))
+	(if (= radius-of-curvature 0.0)
+	    (let ((rang (- (asin (* (/ from-index to-index) (sin axis-slope-angle))))))
+	      (set! object-distance (/ (* object-distance to-index (cos rang)) (* from-index (cos axis-slope-angle))))
+	      (set! axis-slope-angle (- rang)))
+	    (begin
+	      (if (= object-distance 0.0)
+		  (begin
+		    (set! axis-slope-angle 0.0)
+		    (set! iang-sin (/ ray-height radius-of-curvature)))
+		  (set! iang-sin (* (/ (- object-distance radius-of-curvature) radius-of-curvature) (sin axis-slope-angle))))
+	      (let ((iang (asin iang-sin))
+		    (rang-sin (* (/ from-index to-index) iang-sin))
+		    (old-axis-slope-angle axis-slope-angle))
+		(set! axis-slope-angle (+ axis-slope-angle (- iang (asin rang-sin))))
+		(let ((sagitta (sin (/ (+ old-axis-slope-angle iang) 2.0))))
+		  (set! sagitta (* (* 2 radius-of-curvature) (* sagitta sagitta)))
+		  (set! object-distance (+ (/ (* radius-of-curvature (sin (+ old-axis-slope-angle iang))) (tan axis-slope-angle)) sagitta)))))))))
+
+;;	Perform ray trace in specific spectral line
+(define (trace-line line ray-h)
+  (set! object-distance 0.0)
+  (set! ray-height ray-h)
+  (set! from-index 1)
+  (for-each (lambda (surface)
+	      (set! radius-of-curvature (car surface))
+	      (set! to-index (cadr surface))
+	      (if (> to-index 1)
+		  (set! to-index (+ to-index (/ (* (- D-light line) (- (cadr surface) 1)) 
+						(* (- C-light F-light) (caddr surface))))))
+	      (transit-surface)
+	      (set! from-index to-index)
+	      (if (cdr surface)
+		  (set! object-distance (- object-distance (cadddr surface)))))
+	    testcase))
+
+;;	Set parameters for the design to be traced
+(set! clear-aperture 4)
+(define clear-aperture/2 (/ clear-aperture 2))
+(set! current-surfaces 4)
+
+(define (fbench iteration-count)
+  (let ((od-sa ()))
+    (do ((iteration 0 (+ iteration 1)))
+	((> iteration iteration-count))
+      (set! od-sa ())
+      (do ((jp 0 (+ jp 1)))
+	  ((> jp 1))
+	;;  Do main trace in D light
+	(set! paraxial jp)
+	(trace-line D-light clear-aperture/2)
+	;; (set! od-sa (append od-sa (list (list object-distance axis-slope-angle)))) ; yikes!
+	(set! od-sa (cons (list object-distance axis-slope-angle) od-sa)))
+      (set! od-sa (reverse! od-sa))
+      
+      (set! paraxial 0)
+      
+      ;;	Trace marginal ray in C
+      (trace-line C-light clear-aperture/2)
+      (let ((od-cline object-distance))
+	
+	;;	Trace marginal ray in F
+	(trace-line F-light clear-aperture/2)
+	(set! aberr-lspher (- (caadr od-sa) (caar od-sa)))
+	(set! aberr-osc (- 1 (/ (* (caadr od-sa) (cadadr od-sa)) (* (sin (cadar od-sa)) (caar od-sa)))))
+	(set! aberr-lchrom (- object-distance od-cline))
+	(set! max-lspher (sin (cadar od-sa)))
+	  
+	;;  D light
+	(set! max-lspher (/ 0.0000926 (* max-lspher max-lspher)))
+	(set! max-osc 0.0025)
+	(set! max-lchrom max-lspher)))
+    
+    (let ((results
+	   (list
+	    (format #f "   Marginal ray          ~14,11F  ~14,11F" (caar od-sa) (cadar od-sa))
+	    (format #f "   Paraxial ray          ~14,11F  ~14,11F" (caadr od-sa) (cadadr od-sa))
+	    (format #f "Longitudinal spherical aberration:      ~16,11F" aberr-lspher)
+	    (format #f "    (Maximum permissible):              ~16,11F" max-lspher)
+	    (format #f "Offense against sine condition (coma):  ~16,11F" aberr-osc)
+	    (format #f "    (Maximum permissible):              ~16,11F" max-osc)
+	    (format #f "Axial chromatic aberration:             ~16,11F" aberr-lchrom)
+	    (format #f "    (Maximum permissible):              ~16,11F" max-lchrom))))
+      
+      (unless (equal? results reference-results)
+	(do ((errors 0)
+	     (received results (cdr received))
+	     (expected reference-results (cdr expected))
+	     (line 1 (+ line 1)))
+	    ((null? received)
+	     (format #t "~D error~A in results.~%" errors (if (> errors 1) "s" ""))) 
+	  (unless (equal? (car expected) (car received))
+	    (set! errors (+ errors 1))
+	    (format () "Error in results in line ~D...~%" line)
+	    (format () "Expected: ~A~%" (car expected))
+	    (format () "Received: ~A~%" (car received))))))))
+
+
+(fbench 50000)
+;(fbench 1)
+
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(exit)
+
diff --git a/s7/tools/ffitest.c b/s7/tools/ffitest.c
new file mode 100644
index 0000000..76ea2c9
--- /dev/null
+++ b/s7/tools/ffitest.c
@@ -0,0 +1,2884 @@
+/* s7 ffi tester
+ *
+ * gcc -o ffitest ffitest.c -g3 -Wall s7.o -lm -I. -ldl -Wl,-export-dynamic
+ * gcc -o ffitest ffitest.c -g3 -Wall s7.o -DWITH_GMP -lgmp -lmpfr -lmpc -lm -I. -ldl -Wl,-export-dynamic
+ * gcc -o ffitest ffitest.c -fsanitize=address -fsanitize=bounds -fsanitize=pointer-compare -g3 -Wall -lasan -lubsan s7.o -lm -I. -ldl -Wl,-export-dynamic
+ * valgrind --leak-check=full --show-reachable=no --suppressions=/home/bil/cl/free.supp ffitest
+ */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <stdarg.h>
+#include <inttypes.h>
+
+#if WITH_GMP
+#include <gmp.h>
+#include <mpfr.h>
+#include <mpc.h>
+#endif
+
+#include "s7.h"
+
+#define ld64 PRId64
+
+#ifndef WITH_GMP
+  #define WITH_GMP 0
+#endif
+
+#define ld64 PRId64
+
+#define TO_STR(x) s7_object_to_c_string(sc, x)
+#define TO_S7_INT(x) s7_make_integer(sc, x)
+
+static s7_pointer a_function(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_car(args));
+}
+
+static s7_pointer test_hook_function(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer val;
+  val = s7_symbol_local_value(sc, s7_make_symbol(sc, "a"), s7_car(args));
+  if ((!s7_is_integer(val)) ||
+      (s7_integer(val) != 1))
+    {
+      char *s1;
+      s1 = TO_STR(val);
+      fprintf(stderr, "%d: (hook 'a) is %s\n", __LINE__, s1);
+      free(s1);
+    }
+  return(val);
+}
+
+static char last_c;
+static void my_print(s7_scheme *sc, unsigned char c, s7_pointer port)
+{
+  last_c = c;
+}
+
+static s7_pointer my_read(s7_scheme *sc, s7_read_t peek, s7_pointer port)
+{
+  return(s7_make_character(sc, '0'));
+}
+
+static s7_pointer my_error(s7_scheme *sc, s7_pointer args)
+{
+  s7_error(sc, s7_make_symbol(sc, "my-error"), s7_list(sc, 1, s7_make_integer(sc, 60)));
+  return(s7_f(sc));
+}
+
+static s7_pointer my_no_error(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_integer(sc, 30));
+}
+
+static s7_pointer my_error_handler(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_car(s7_cadr(args)));
+}
+
+static bool tested_begin_hook = false;
+static void test_begin_hook(s7_scheme *sc, bool *val)
+{
+  tested_begin_hook = true;
+}
+
+static s7_pointer test_error_handler(s7_scheme *sc, s7_pointer args)
+{
+  s7_display(sc, s7_make_symbol(sc, "error!"), s7_current_error_port(sc));
+  return(s7_f(sc));
+}
+
+static s7_pointer set_sym, set_val;
+static s7_pointer scheme_set_notification(s7_scheme *sc, s7_pointer args)
+{
+  set_sym = s7_car(args);
+  set_val = s7_cadr(args);
+  return(set_val);
+}
+
+
+typedef struct {
+  s7_double x;
+  s7_pointer data;
+} dax;
+
+static s7_int dax_type_tag = 0, dx_type_tag = 0;
+
+static s7_pointer dax_to_string(s7_scheme *sc, s7_pointer args)
+{
+  char *data_str, *str;
+  s7_pointer result;
+  int data_str_len;
+  dax *o = (dax *)s7_c_object_value(s7_car(args));
+  data_str = TO_STR(o->data);
+  data_str_len = strlen(data_str);
+  str = (char *)calloc(data_str_len + 32, sizeof(char));
+  snprintf(str, data_str_len + 32, "#<dax %.3f %s>", o->x, data_str);
+  free(data_str);
+  result = s7_make_string(sc, str);
+  free(str);
+  return(result);
+}
+
+static void free_dax(void *val)
+{
+  if (val) free(val);
+}
+
+static void mark_dax(void *val)
+{
+  dax *o = (dax *)val;
+  if (o) s7_mark(o->data);
+}
+
+static s7_pointer make_dax(s7_scheme *sc, s7_pointer args)
+{
+  dax *o;
+  o = (dax *)malloc(sizeof(dax));
+  o->x = s7_real(s7_car(args));
+  if (s7_cdr(args) != s7_nil(sc))
+    o->data = s7_car(s7_cdr(args));
+  else o->data = s7_nil(sc);
+  return(s7_make_c_object(sc, dax_type_tag, (void *)o));
+}
+
+static s7_pointer is_dax(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_boolean(sc,
+			 s7_is_c_object(s7_car(args)) &&
+			 s7_c_object_type(s7_car(args)) == dax_type_tag));
+}
+
+static s7_pointer dax_x(s7_scheme *sc, s7_pointer args)
+{
+  dax *o;
+  o = (dax *)s7_c_object_value(s7_car(args));
+  return(s7_make_real(sc, o->x));
+}
+
+static s7_pointer set_dax_x(s7_scheme *sc, s7_pointer args)
+{
+  dax *o;
+  o = (dax *)s7_c_object_value(s7_car(args));
+  o->x = s7_real(s7_car(s7_cdr(args)));
+  return(s7_car(s7_cdr(args)));
+}
+
+static s7_pointer dax_data(s7_scheme *sc, s7_pointer args)
+{
+  dax *o;
+  o = (dax *)s7_c_object_value(s7_car(args));
+  return(o->data);
+}
+
+static s7_pointer set_dax_data(s7_scheme *sc, s7_pointer args)
+{
+  dax *o;
+  o = (dax *)s7_c_object_value(s7_car(args));
+  o->data = s7_car(s7_cdr(args));
+  return(o->data);
+}
+
+static bool equal_dax(void *val1, void *val2) /* this is the old form of equal? */
+{
+  dax *d1, *d2;
+  if (val1 == val2)
+    return(true);
+  d1 = (dax *)val1;
+  d2 = (dax *)val2;
+  return((d1->x == d2->x) &&
+	 (d1->data == d2->data));  /* we want s7_is_equal here, but the interpreter is not passed to us */
+}
+
+static s7_pointer equality_dax(s7_scheme *sc, s7_pointer args) /* this is the new form of equal? */
+{
+  s7_pointer p1, p2;
+  dax *d1, *d2;
+  p1 = s7_car(args);      /* we know this is a dax object */
+  p2 = s7_cadr(args);
+  if (p1 == p2)
+    return(s7_t(sc));
+  if ((!s7_is_c_object(p2)) ||
+      (s7_c_object_type(p2) != dax_type_tag))
+    return(s7_f(sc));
+  d1 = (dax *)s7_c_object_value(p1);
+  d2 = (dax *)s7_c_object_value(p2);
+  return(s7_make_boolean(sc,       /* here we can call s7_is_equal */
+			 (d1->x == d2->x) &&
+			 (s7_is_equal(sc, d1->data, d2->data))));
+}
+
+
+static s7_pointer free_dx(s7_scheme *sc, s7_pointer obj)
+{
+  free(s7_c_object_value(obj));
+  return(NULL);
+}
+
+static s7_pointer mark_dx(s7_scheme *sc, s7_pointer obj)
+{
+  dax *o = (dax *)s7_c_object_value(obj);
+  if (o) s7_mark(o->data);
+  return(NULL);
+}
+
+static s7_pointer dx_to_list(s7_scheme *sc, s7_pointer obj)
+{
+  return(s7_nil(sc));
+}
+
+
+static s7_pointer plus(s7_scheme *sc, s7_pointer args)
+{
+  /* (define* (plus (red 32) blue) (+ (* 2 red) blue)) */
+  return(TO_S7_INT(2 * s7_integer(s7_car(args)) + s7_integer(s7_car(s7_cdr(args)))));
+}
+
+static s7_pointer plus1(s7_scheme *sc, s7_pointer args) /* check recursion in "unsafe" case */
+{
+  s7_pointer d;
+  if (s7_integer(s7_car(args)) == 4)
+    d = s7_apply_function_star(sc, s7_name_to_value(sc, "plus1"),
+			       s7_list(sc, 3,
+				       s7_make_integer(sc, 1),
+				       s7_make_integer(sc, 2),
+				       s7_make_integer(sc, 3)));
+  else d = s7_make_integer(sc, 0);
+  return(s7_make_integer(sc, s7_integer(s7_car(args)) +
+			 s7_integer(s7_cadr(args)) +
+			 s7_integer(s7_caddr(args)) +
+			 s7_integer(d)));
+}
+
+s7_pointer fs1(s7_scheme* sc, s7_pointer args) {if (s7_is_pair(args)) return(s7_car(args)); return s7_nil(sc);}
+s7_pointer fs2(s7_scheme* sc, s7_pointer args) {if (s7_is_pair(args)) return(s7_car(args)); return s7_nil(sc);}
+s7_pointer fs3(s7_scheme* sc, s7_pointer args) {if (s7_is_pair(args)) return(s7_car(args)); return s7_nil(sc);}
+s7_pointer fs31(s7_scheme* sc, s7_pointer args) {if (s7_is_pair(args)) return(s7_car(args)); return s7_nil(sc);}
+
+s7_pointer fs4(s7_scheme* sc, s7_pointer args) {if (s7_is_pair(args)) return(s7_car(args)); return s7_nil(sc);}
+s7_pointer fs5(s7_scheme* sc, s7_pointer args) {if (s7_is_pair(args)) return(s7_car(args)); return s7_nil(sc);}
+s7_pointer fs6(s7_scheme* sc, s7_pointer args) {if (s7_is_pair(args)) return(s7_car(args)); return s7_nil(sc);}
+s7_pointer fs61(s7_scheme* sc, s7_pointer args) {if (s7_is_pair(args)) return(s7_car(args)); return s7_nil(sc);}
+
+static s7_pointer mac_plus(s7_scheme *sc, s7_pointer args)
+{
+  /* (define-macro (plus a b) `(+ ,a ,b)) */
+  s7_pointer a, b;
+  a = s7_car(args);
+  b = s7_cadr(args);
+  return(s7_list(sc, 3, s7_make_symbol(sc, "+"),  a, b));
+}
+
+static s7_pointer mac_plus_mv(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_list(sc, 2, s7_make_symbol(sc, "+"), s7_values(sc, args))); /* s7_values is not a good idea here */
+}
+
+static s7_pointer open_plus(s7_scheme *sc, s7_pointer args)
+{
+  #define plus_help "(plus obj ...) applies obj's plus method to obj and any trailing arguments."
+  s7_pointer obj, method;
+  obj = s7_car(args);
+  if (s7_is_openlet(obj))
+    {
+      method = s7_method(sc, obj, s7_make_symbol(sc, "plus"));
+      if (s7_is_procedure(method))
+	return(s7_apply_function(sc, method, s7_cdr(args)));
+    }
+  return(s7_f(sc));
+}
+
+static s7_pointer g_car(s7_scheme *sc, s7_pointer args) {return(s7_car(s7_car(args)));}
+
+
+typedef struct {
+  size_t size;
+  double *data;
+} g_block;
+
+static s7_int g_block_type = 0;
+static s7_pointer g_block_methods;
+
+static s7_pointer g_make_block(s7_scheme *sc, s7_pointer args)
+{
+  #define g_make_block_help "(make-block size) returns a new block of the given size"
+  g_block *g;
+  s7_pointer new_g;
+  g = (g_block *)calloc(1, sizeof(g_block));
+  g->size = (size_t)s7_integer(s7_car(args));
+  g->data = (double *)calloc(g->size, sizeof(double));
+  new_g = s7_make_c_object(sc, g_block_type, (void *)g);
+  s7_c_object_set_let(sc, new_g, g_block_methods);
+  s7_openlet(sc, new_g);
+  return(new_g);
+}
+
+static s7_pointer g_to_block(s7_scheme *sc, s7_pointer args)
+{
+#define g_block_help "(block ...) returns a block c_object with the arguments as its contents."
+  s7_pointer p, b;
+  size_t i, len;
+  g_block *gb;
+  len = s7_list_length(sc, args);
+  b = g_make_block(sc, s7_cons(sc, s7_make_integer(sc, len), s7_nil(sc)));
+  gb = (g_block *)s7_c_object_value(b);
+  for (i = 0, p = args; i < len; i++, p = s7_cdr(p))
+    gb->data[i] = s7_number_to_real(sc, s7_car(p));
+  return(b);
+}
+
+static s7_pointer g_block_to_string(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_string(sc, "<block>"));
+}
+
+static void g_block_free(void *value)
+{
+  g_block *g = (g_block *)value;
+  free(g->data);
+  free(g);
+}
+
+static bool g_blocks_are_eql(void *val1, void *val2)
+{
+  s7_int i, len;
+  g_block *b1 = (g_block *)val1;
+  g_block *b2 = (g_block *)val2;
+  if (val1 == val2) return(true);
+  len = b1->size;
+  if (len != b2->size) return(false);
+  for (i = 0; i < len; i++)
+    if (b1->data[i] != b2->data[i])
+      return(false);
+  return(true);
+}
+
+static s7_pointer g_blocks_are_equal(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_boolean(sc, g_blocks_are_eql((void *)s7_c_object_value(s7_car(args)), (void *)s7_c_object_value(s7_cadr(args)))));
+}
+
+static s7_pointer g_blocks_are_equivalent(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer v1, v2, arg1, arg2;
+  g_block *g1, *g2;
+  bool result;
+  uint32_t gc1, gc2;
+  size_t len;
+  arg1 = s7_car(args);
+  arg2 = s7_cadr(args);
+  if (!s7_is_c_object(arg2))
+    return(s7_f(sc));
+  if (arg1 == arg2)
+    return(s7_make_boolean(sc, true));
+  if (s7_is_let(arg1))             /* (block-let (block)) */
+    return(s7_make_boolean(sc, false));    /* checked == above */
+  g1 = (g_block *)s7_c_object_value_checked(arg1, g_block_type);
+  if (!g1) return(s7_f(sc));
+  g2 = (g_block *)s7_c_object_value(arg2);
+  len = g1->size;
+  if (len != g2->size)
+    return(s7_make_boolean(sc, false));
+  v1 = s7_make_float_vector_wrapper(sc, len, g1->data, 1, NULL, false);
+  gc1 = s7_gc_protect(sc, v1);
+  v2 = s7_make_float_vector_wrapper(sc, len, g2->data, 1, NULL, false);
+  gc2 = s7_gc_protect(sc, v2);
+  result = s7_is_equivalent(sc, v1, v2);
+  s7_gc_unprotect_at(sc, gc1);
+  s7_gc_unprotect_at(sc, gc2);
+  return(s7_make_boolean(sc, result));
+}
+
+static void g_block_mark(void *val)
+{
+  /* nothing to mark */
+}
+
+static s7_pointer g_block_ref(s7_scheme *sc, s7_pointer args)
+{
+  g_block *g;
+  size_t index;
+  g = (g_block *)s7_c_object_value(s7_car(args));
+  index = (size_t)s7_integer(s7_cadr(args));
+  if (index < g->size)
+    return(s7_make_real(sc, g->data[index]));
+  return(s7_out_of_range_error(sc, "block-ref", 2, s7_cadr(args), "should be less than block length"));
+}
+
+static s7_pointer g_block_set(s7_scheme *sc, s7_pointer args)
+{
+  g_block *g;
+  s7_int index;
+  if (s7_list_length(sc, args) != 3)
+    return(s7_wrong_number_of_args_error(sc, "block-set! takes 3 arguments: ~S", args));
+  g = (g_block *)s7_c_object_value(s7_car(args));
+  index = s7_integer(s7_cadr(args));
+  if ((index >= 0) && (index < g->size))
+    {
+      g->data[index] = s7_number_to_real(sc, s7_caddr(args));
+      return(s7_caddr(args));
+    }
+  return(s7_out_of_range_error(sc, "block-set", 2, s7_cadr(args), "should be less than block length"));
+}
+
+static s7_pointer g_block_length(s7_scheme *sc, s7_pointer args)
+{
+  g_block *g = (g_block *)s7_c_object_value(s7_car(args));
+  return(s7_make_integer(sc, g->size));
+}
+
+static s7_pointer g_block_copy(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer obj, new_g;
+  g_block *g, *g1;
+  obj = s7_car(args);
+  g = (g_block *)s7_c_object_value(obj);
+  new_g = g_make_block(sc, s7_cons(sc, s7_make_integer(sc, g->size), s7_nil(sc)));
+  g1 = (g_block *)s7_c_object_value(new_g);
+  memcpy((void *)(g1->data), (void *)(g->data), g->size * sizeof(double));
+  return(new_g);
+}
+
+static s7_pointer g_block_reverse(s7_scheme *sc, s7_pointer args)
+{
+  size_t i, j;
+  s7_pointer obj, new_g;
+  g_block *g, *g1;
+  obj = s7_car(args);
+  g = (g_block *)s7_c_object_value(obj);
+  new_g = g_make_block(sc, s7_cons(sc, s7_make_integer(sc, g->size), s7_nil(sc)));
+  g1 = (g_block *)s7_c_object_value(new_g);
+  for (i = 0, j = g->size - 1; i < g->size; i++, j--)
+    g1->data[i] = g->data[j];
+  return(new_g);
+}
+
+static s7_pointer g_block_fill(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer obj;
+  size_t i;
+  double fill_val;
+  g_block *g;
+  obj = s7_car(args);
+  g = (g_block *)s7_c_object_value(obj);
+  fill_val = s7_number_to_real(sc, s7_cadr(args));
+  for (i = 0; i < g->size; i++)
+    g->data[i] = fill_val;
+  return(obj);
+}
+
+static bool symbol_func(const char *symbol_name, void *data)
+{
+  return(false);
+}
+
+static bool symbol_func_1(const char *symbol_name, void *data)
+{
+  return(false);
+}
+
+static s7_pointer our_abs(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_real(sc, (s7_Double)(1.0 + s7_number_to_real(sc, s7_car(args)))));
+}
+
+
+static s7_scheme *cur_sc;
+
+static const char *pretty_print(s7_scheme *sc, s7_pointer obj) /* (pretty-print obj) */
+{
+  return(s7_string(
+          s7_eval_c_string_with_environment(sc,
+            "(catch #t                                \
+               (lambda ()                             \
+                 (unless (defined? 'pp)		      \
+                   (load \"write.scm\"))	      \
+                 (pp obj))			      \
+               (lambda (type info)		      \
+                 (apply format #f info)))",
+	   s7_inlet(sc, s7_list(sc, 1, s7_cons(sc, s7_make_symbol(sc, "obj"), obj))))));
+}
+
+#if WITH_GMP
+static s7_pointer big_add_1(s7_scheme *sc, s7_pointer args)
+{
+  /* add 1 to either a normal number or a bignum */
+  s7_pointer x, n;
+  x = s7_car(args);
+  if (s7_is_big_integer(x))
+    {
+      mpz_t big_n;
+      mpz_init_set(big_n, *s7_big_integer(x));
+      mpz_add_ui(big_n, big_n, 1);
+      n = s7_make_big_integer(sc, &big_n);
+      mpz_clear(big_n);
+      return(n);
+    }
+  if (s7_is_big_ratio(x))
+    {
+      mpq_t big_q;
+      mpq_init(big_q);
+      mpq_set_si(big_q, 1, 1);
+      mpq_add(big_q, *s7_big_ratio(x), big_q);
+      mpq_canonicalize(big_q);
+      n = s7_make_big_ratio(sc, &big_q);
+      mpq_clear(big_q);
+      return(n);
+    }
+  if (s7_is_big_real(x))
+    {
+      mpfr_t big_x;
+      mpfr_init_set(big_x, *s7_big_real(x), MPFR_RNDN);
+      mpfr_add_ui(big_x, big_x, 1, MPFR_RNDN);
+      n = s7_make_big_real(sc, &big_x);
+      mpfr_clear(big_x);
+      return(n);
+    }
+  if (s7_is_big_complex(x))
+    {
+      mpc_t big_z;
+      mpc_init2(big_z, mpc_get_prec(*s7_big_complex(x)));
+      mpc_add_ui(big_z, *s7_big_complex(x), 1, MPC_RNDNN);
+      n = s7_make_big_complex(sc, &big_z);
+      mpc_clear(big_z);
+      return(n);
+    }
+  if (s7_is_integer(x))
+    return(s7_make_integer(sc, 1 + s7_integer(x)));
+  if (s7_is_rational(x))
+    return(s7_make_ratio(sc, s7_numerator(x) + s7_denominator(x), s7_denominator(x)));
+  if (s7_is_real(x))
+    return(s7_make_real(sc, 1.0 + s7_real(x)));
+  if (s7_is_complex(x))
+    return(s7_make_complex(sc, 1.0 + s7_real_part(x), s7_imag_part(x)));
+  return(s7_wrong_type_arg_error(sc, "add-1", 0, x, "a number"));
+}
+#endif
+
+static const char *snd_names[8] = {
+    "*clm-array-print-length*", "ws.scm",
+    "*clm-channels*", "ws.scm",
+    "zone-tailed-hawk", "animals.scm",
+    "zoom-spectrum", "examp.scm",
+};
+
+
+static s7_double opt_d_func(void) {return(1.0);}
+static s7_pointer g_d_func(s7_scheme *sc, s7_pointer args) {return(s7_make_real(sc, 1.0));}
+
+static s7_double opt_d_d_func(s7_double x) {return(x + 1.0);}
+static s7_pointer g_d_d_func(s7_scheme *sc, s7_pointer args) {return(s7_make_real(sc, s7_real(s7_car(args)) + 1.0));}
+
+static s7_double opt_d_dd_func(s7_double x, s7_double y) {return(x + y);}
+static s7_pointer g_d_dd_func(s7_scheme *sc, s7_pointer args) {return(s7_make_real(sc, s7_real(s7_car(args)) + s7_real(s7_cadr(args))));}
+
+static s7_double opt_d_ddd_func(s7_double x, s7_double y, s7_double z) {return(x + y + z);}
+static s7_pointer g_d_ddd_func(s7_scheme *sc, s7_pointer args) {return(s7_make_real(sc, s7_real(s7_car(args)) + s7_real(s7_cadr(args)) + s7_real(s7_caddr(args))));}
+
+static s7_double opt_d_dddd_func(s7_double w, s7_double x, s7_double y, s7_double z) {return(w + x + y + z);}
+static s7_pointer g_d_dddd_func(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_real(sc, s7_real(s7_car(args)) + s7_real(s7_cadr(args)) + s7_real(s7_caddr(args)) + s7_real(s7_cadddr(args))));
+}
+
+static s7_double opt_d_p_func(s7_pointer x) {return(s7_real(x));}
+static s7_pointer g_d_p_func(s7_scheme *sc, s7_pointer args) {return(s7_make_real(sc, s7_real(s7_car(args))));}
+
+static s7_int opt_i_i_func(s7_int x) {return(x + 1);}
+static s7_pointer g_i_i_func(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, s7_integer(s7_car(args)) + 1));}
+
+static s7_int opt_i_ii_func(s7_int x, s7_int y) {return(x + y);}
+static s7_pointer g_i_ii_func(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, s7_integer(s7_car(args)) + s7_integer(s7_cadr(args))));}
+
+static s7_double opt_d_id_func(s7_int x, s7_double y) {return(x + y);}
+static s7_pointer g_d_id_func(s7_scheme *sc, s7_pointer args) {return(s7_make_real(sc, s7_integer(s7_car(args)) + s7_real(s7_cadr(args))));}
+
+static s7_double opt_d_ip_func(s7_int x, s7_pointer y) {return(x + s7_real(y));}
+static s7_pointer g_d_ip_func(s7_scheme *sc, s7_pointer args) {return(s7_make_real(sc, s7_integer(s7_car(args)) + s7_real(s7_cadr(args))));}
+
+static s7_int opt_i_7d_func(s7_scheme *sc, s7_double x) {return((s7_int)x);}
+static s7_pointer g_i_7d_func(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, (s7_int)s7_real(s7_car(args))));}
+
+static s7_int opt_i_7p_func(s7_scheme *sc, s7_pointer x) {return(s7_integer(x));}
+static s7_pointer g_i_7p_func(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, s7_integer(s7_car(args))));}
+
+static s7_double opt_d_pd_func(s7_pointer x, s7_double y) {return(s7_real(x) + y);}
+static s7_pointer g_d_pd_func(s7_scheme *sc, s7_pointer args) {return(s7_make_real(sc, s7_real(s7_car(args)) + s7_real(s7_cadr(args))));}
+
+static s7_double opt_d_7pi_func(s7_scheme *sc, s7_pointer x, s7_int y) {return(s7_real(x) + y);}
+static s7_pointer g_d_7pi_func(s7_scheme *sc, s7_pointer args) {return(s7_make_real(sc, s7_real(s7_car(args)) + s7_integer(s7_cadr(args))));}
+
+static s7_double opt_d_7pid_func(s7_scheme *sc, s7_pointer x, s7_int y, s7_double z) {return(s7_real(x) + y + z);}
+static s7_pointer g_d_7pid_func(s7_scheme *sc, s7_pointer args) {return(s7_make_real(sc, s7_real(s7_car(args)) + s7_integer(s7_cadr(args)) + s7_real(s7_caddr(args))));}
+
+static bool opt_b_p_func(s7_pointer x) {return(s7_is_real(x));}
+static s7_pointer g_b_p_func(s7_scheme *sc, s7_pointer args) {return(s7_make_boolean(sc, s7_is_real(s7_car(args))));}
+
+static s7_pointer opt_p_d_func(s7_scheme *sc, s7_double x) {return(s7_make_real(sc, x));}
+static s7_pointer g_p_d_func(s7_scheme *sc, s7_pointer args) {return(s7_car(args));}
+
+static s7_double opt_d_v_func(void *x) {g_block *g = (g_block *)x; return(g->data[0]);}
+static s7_pointer g_d_v_func(s7_scheme *sc, s7_pointer args) {g_block *g; g = (g_block *)s7_c_object_value(s7_car(args)); return(s7_make_real(sc, g->data[0]));}
+
+static s7_double opt_d_vd_func(void *x, s7_double y) {g_block *g = (g_block *)x; return(y + g->data[0]);}
+static s7_pointer g_d_vd_func(s7_scheme *sc, s7_pointer args)
+{
+  g_block *g;
+  g = (g_block *)s7_c_object_value(s7_car(args));
+  return(s7_make_real(sc, s7_real(s7_cadr(args)) + g->data[0]));
+}
+
+static s7_double opt_d_vid_func(void *x, s7_int y, s7_double z) {g_block *g = (g_block *)x; return(z + g->data[y]);}
+static s7_pointer g_d_vid_func(s7_scheme *sc, s7_pointer args)
+{
+  g_block *g;
+  g = (g_block *)s7_c_object_value(s7_car(args));
+  return(s7_make_real(sc, s7_real(s7_caddr(args)) + g->data[s7_integer(s7_cadr(args))]));
+}
+
+static s7_double opt_d_vdd_func(void *x, s7_double y, s7_double z) {g_block *g = (g_block *)x; return(y + z + g->data[0]);}
+static s7_pointer g_d_vdd_func(s7_scheme *sc, s7_pointer args)
+{
+  g_block *g;
+  g = (g_block *)s7_c_object_value(s7_car(args));
+  return(s7_make_real(sc, s7_real(s7_cadr(args)) + s7_real(s7_caddr(args)) + g->data[0]));
+}
+
+/* s7_call_with_catch */
+static s7_pointer make_func, catcher1, catcher2;
+static s7_pointer ter_bad_func(s7_scheme *sc, s7_pointer args) {s7_eval_c_string(sc, "(/ 10 0)"); return(s7_t(sc));}
+static s7_pointer ter_error_handler(s7_scheme *sc, s7_pointer args) {return s7_f(sc);}
+static s7_pointer ter1_bad_func(s7_scheme *sc, s7_pointer args) {return(s7_call_with_catch(sc, s7_t(sc), make_func, catcher1));}
+static s7_pointer ter1_error_handler(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, 123));}
+
+static s7_pointer ter2_bad_func(s7_scheme *sc, s7_pointer args) {return(s7_wrong_type_error(sc, s7_make_symbol(sc, "ter2"), 0, args, s7_make_string(sc, "oops")));}
+static s7_pointer ter2_error_handler(s7_scheme *sc, s7_pointer args) {return(s7_apply_function(sc, s7_name_to_value(sc, "format"), s7_cons(sc, s7_f(sc), s7_cadr(args))));}
+
+/* another s7_call_with_catch case thanks to Woody Douglass */
+static int32_t wd_val = 0;
+static s7_pointer wd_inner_test(s7_scheme *s, s7_pointer args)
+{
+  s7_error(s, s7_make_symbol(s, "test-error"), s7_list(s, 1, s7_make_string(s, "TEST ERROR")));
+  return s7_nil(s);
+}
+static s7_pointer wd_test_fn(s7_scheme *s, s7_pointer args)
+{
+  wd_val = 1;
+  s7_call_with_catch(s, s7_t(s), s7_name_to_value(s, "wd-inner-test"), s7_name_to_value(s, "wd-inner-test-handler"));
+  wd_val = 2;
+  return s7_nil(s);
+}
+static s7_pointer wd_inner_test_handler(s7_scheme *s, s7_pointer args) {return s7_nil(s);}
+
+
+static int32_t wd1_val = 0, wd2_val = 0;
+static s7_pointer wd1_test_fn(s7_scheme *s, s7_pointer args)
+{
+  wd1_val = 1;
+  s7_call_with_catch(s, s7_t(s), s7_name_to_value(s, "wd1-inner-fn"), s7_name_to_value(s, "wd-inner-test-handler"));
+  wd1_val = 2;
+  return s7_nil(s);
+}
+static s7_pointer wd1_inner_fn(s7_scheme *s, s7_pointer args)
+{
+  wd2_val = 11;
+  s7_call_with_catch(s, s7_t(s), s7_name_to_value(s, "wd-inner-test"), s7_name_to_value(s, "wd-inner-test-handler"));
+  wd2_val = 12;
+  return s7_nil(s);
+}
+
+
+
+int main(int argc, char **argv)
+{
+  s7_scheme *sc;
+  s7_pointer p, p1, perm1, perm2;
+  s7_int i, gc_loc;
+  char *s1, *s2;
+
+  sc = s7_init();
+  cur_sc = sc;
+
+  {
+    char b1[32];
+    snprintf(b1, 32, "%d.%d", S7_MAJOR_VERSION, S7_MINOR_VERSION);
+    if (strcmp(b1, S7_VERSION) != 0) fprintf(stderr, "version mismatch: %d.%d != %s\n", S7_MAJOR_VERSION, S7_MINOR_VERSION, S7_VERSION);
+    if (strlen(S7_DATE) < 6) fprintf(stderr, "S7_DATE: %s\n", S7_DATE);
+  }
+
+  s7_set_history_enabled(sc, false);
+  if (s7_history_enabled(sc)) fprintf(stderr, "%d: history is enabled\n", __LINE__);
+
+  /* try each straight (no errors) case */
+
+  if (!s7_is_null(sc, s7_nil(sc)))
+    {fprintf(stderr, "%d: %s is not null?\n", __LINE__, s1 = TO_STR(s7_nil(sc))); free(s1);}
+
+  if (s7_is_pair(s7_nil(sc)))
+    {fprintf(stderr, "%d: %s is a pair?\n", __LINE__, s1 = TO_STR(s7_nil(sc))); free(s1);}
+
+  if (!s7_is_boolean(s7_t(sc)))
+    {fprintf(stderr, "%d: %s is not boolean?\n", __LINE__, s1 = TO_STR(s7_t(sc))); free(s1);}
+
+  if (!s7_is_boolean(s7_f(sc)))
+    {fprintf(stderr, "%d: %s is not boolean?\n", __LINE__, s1 = TO_STR(s7_f(sc))); free(s1);}
+
+  if (s7_boolean(sc, s7_f(sc)))
+    {fprintf(stderr, "%d: %s is #t?\n", __LINE__, s1 = TO_STR(s7_f(sc))); free(s1);}
+
+  if (!s7_boolean(sc, s7_t(sc)))
+    {fprintf(stderr, "%d: %s is #f?\n", __LINE__, s1 = TO_STR(s7_t(sc))); free(s1);}
+
+  p = s7_make_boolean(sc, true);
+  if (p != s7_t(sc))
+    {fprintf(stderr, "%d: %s is not #t?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_make_boolean(sc, false);
+  if (p != s7_f(sc))
+    {fprintf(stderr, "%d: %s is not #f?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_eq(s7_f(sc), s7_f(sc)))
+    {fprintf(stderr, "%d: (eq? %s %s) -> #f?\n", __LINE__, s1 = TO_STR(s7_f(sc)), s2 = TO_STR(s7_f(sc))); free(s1); free(s2);}
+
+  if (!s7_is_eqv(sc, s7_f(sc), s7_f(sc)))
+    {fprintf(stderr, "%d: (eqv? %s %s) -> #f?\n", __LINE__, s1 = TO_STR(s7_f(sc)), s2 = TO_STR(s7_f(sc))); free(s1); free(s2);}
+
+  if (!s7_is_equal(sc, s7_f(sc), s7_f(sc)))
+    {fprintf(stderr, "%d: (equal? %s %s) -> #f?\n", __LINE__, s1 = TO_STR(s7_f(sc)), s2 = TO_STR(s7_f(sc))); free(s1); free(s2);}
+
+  if (!s7_is_unspecified(sc, s7_unspecified(sc)))
+    {fprintf(stderr, "%d: %s is not #<unspecified>?\n", __LINE__, s1 = TO_STR(s7_unspecified(sc))); free(s1);}
+
+  if (s7_is_eq(s7_eof_object(sc), s7_undefined(sc)))
+    {fprintf(stderr, "%d: (eq? %s %s) -> #t?\n", __LINE__, s1 = TO_STR(s7_eof_object(sc)), s2 = TO_STR(s7_undefined(sc))); free(s1); free(s2);}
+
+  if (s7_is_eqv(sc, s7_eof_object(sc), s7_undefined(sc)))
+    {fprintf(stderr, "%d: (eqv? %s %s) -> #t?\n", __LINE__, s1 = TO_STR(s7_eof_object(sc)), s2 = TO_STR(s7_undefined(sc))); free(s1); free(s2);}
+
+  if (s7_is_equal(sc, s7_eof_object(sc), s7_undefined(sc)))
+    {fprintf(stderr, "%d: (equal? %s %s) -> #t?\n", __LINE__, s1 = TO_STR(s7_eof_object(sc)), s2 = TO_STR(s7_undefined(sc))); free(s1); free(s2);}
+
+  if (!s7_is_valid(sc, s7_t(sc)))
+    {fprintf(stderr, "%d: %s is not valid?\n", __LINE__, s1 = TO_STR(s7_t(sc))); free(s1);}
+  {
+    typedef struct fake_cell {
+      union {
+	uint64_t flag;
+	uint8_t type_field;
+      } tf;
+      int64_t hloc, i1, i2, i3;
+    } fake_cell;
+    fake_cell *x;
+    x = calloc(1, sizeof(fake_cell));
+    x->tf.flag = 53 + (1 << 11);
+    if (s7_is_valid(sc, (s7_pointer)x))
+      fprintf(stderr, "fake_cell is ok?\n");
+    if (!s7_is_provided(sc, "debugging"))
+      {
+	s1 = TO_STR((s7_pointer)x);
+	free(s1);
+      }
+    free(x);
+  }
+  if (s7_is_c_pointer(s7_t(sc)))
+    {fprintf(stderr, "%d: %s is a raw c pointer?\n", __LINE__, s1 = TO_STR(s7_t(sc))); free(s1);}
+
+  i = 32;
+  p = s7_make_c_pointer(sc, (void *)(&i));
+  if (!s7_is_c_pointer(p))
+    {fprintf(stderr, "%d: %s is not a raw c pointer?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  i = (*((int *)s7_c_pointer(p)));
+  if (i != 32)
+    fprintf(stderr, "%d: 32 -> %" ld64 " via raw c pointer?\n", __LINE__, i);
+
+  s7_provide(sc, "ffitest");
+  if (!s7_is_provided(sc, "ffitest"))
+    {fprintf(stderr, "%d: *features* %s doesn't provide 'ffitest?\n", __LINE__, s1 = TO_STR(s7_name_to_value(sc, "*features*"))); free(s1);}
+
+  p = s7_cons(sc, s7_f(sc), s7_t(sc));
+  gc_loc = s7_gc_protect(sc, p);
+  if (p != s7_gc_protected_at(sc, gc_loc))
+    {fprintf(stderr, "%d: %s is not gc protected at %" ld64 ": %s?\n", __LINE__, s1 = TO_STR(p), gc_loc, s2 = TO_STR(s7_gc_protected_at(sc, gc_loc))); free(s1); free(s2);}
+
+  if (s7_car(p) != s7_f(sc))
+    {fprintf(stderr, "%d: (car %s) is not #f?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_cdr(p) != s7_t(sc))
+    {fprintf(stderr, "%d: (cdr %s) is not #t?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_pair(p))
+    {fprintf(stderr, "%d: %s is not a pair?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_set_car(p, s7_eof_object(sc));
+  if (s7_car(p) != s7_eof_object(sc))
+    {fprintf(stderr, "%d: (car %s) is not #<eof>?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_set_cdr(p, s7_unspecified(sc));
+  if (s7_cdr(p) != s7_unspecified(sc))
+    {fprintf(stderr, "%d: (cdr %s) is not #<unspecified>?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_gc_unprotect_at(sc, gc_loc);
+
+  { /* force realloc of protected_objects array */
+    s7_int gc_locs[20];
+    for (i = 0; i < 18; i++) /* initial size = 16 */
+      gc_locs[i] = s7_gc_protect(sc, s7_cons(sc, s7_f(sc), s7_t(sc)));
+    for (i = 0; i < 18; i++)
+      s7_gc_unprotect_at(sc, gc_locs[i]);
+  }
+
+  p = TO_S7_INT(123);
+  gc_loc = s7_gc_protect(sc, p);
+
+  if (!s7_is_integer(p))
+    {fprintf(stderr, "%d: %s is not integral?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_rational(p))
+    {fprintf(stderr, "%d: %s is not rational?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_is_ratio(p))
+    {fprintf(stderr, "%d: %s is a ratio?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_real(p))
+    {fprintf(stderr, "%d: %s is not real?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_complex(p))
+    {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_number(p))
+    {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_integer(p) != 123)
+    {fprintf(stderr, "%d: %s is not 123?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s2 = s7_number_to_string(sc, p, 10);
+  if (strcmp(s2, "123") != 0)
+    {fprintf(stderr, "%d: (number->string %s) is not \"123\"?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  free(s2);
+
+  if (s7_number_to_integer(sc, p) != 123)
+    {fprintf(stderr, "%d: s7_number_to_integer %s is not 123?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_number_to_integer_with_caller(sc, p, "ffitest") != 123)
+    {fprintf(stderr, "%d: s7_number_to_integer_with_caller %s is not 123?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_string(s7_object_to_string(sc, p, false)))
+    {fprintf(stderr, "%s is not a string\n", s1 = TO_STR(s7_object_to_string(sc, p, false))); free(s1);}
+  if (strcmp(s7_string(s7_object_to_string(sc, p, true)), "123") != 0)
+    fprintf(stderr, "%s is not \"123\"", s7_string(s7_object_to_string(sc, p, true)));
+
+  s7_gc_unprotect_at(sc, gc_loc);
+
+
+  p = s7_make_ratio(sc, 123, 5);
+  gc_loc = s7_gc_protect(sc, p);
+
+  if (s7_is_integer(p))
+    {fprintf(stderr, "%d: %s is integral?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_rational(p))
+    {fprintf(stderr, "%d: %s is not rational?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_ratio(p))
+    {fprintf(stderr, "%d: %s is not a ratio?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_real(p))
+    {fprintf(stderr, "%d: %s is not real?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_complex(p))
+    {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_number(p))
+    {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_numerator(p) != 123)
+    {fprintf(stderr, "%d: (numerator %s) is not 123?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_denominator(p) != 5)
+    {fprintf(stderr, "%d: (denominator %s) is not 5?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s2 = s7_number_to_string(sc, p, 10);
+  if (strcmp(s2, "123/5") != 0)
+    {fprintf(stderr, "%d: (number->string %s) is not \"123/5\"?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  free(s2);
+
+  s7_gc_unprotect_at(sc, gc_loc);
+
+
+  p = s7_make_real(sc, 1.5);
+  gc_loc = s7_gc_protect(sc, p);
+
+  if (s7_is_integer(p))
+    {fprintf(stderr, "%d: %s is integral?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_is_rational(p))
+    {fprintf(stderr, "%d: %s is rational?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_is_ratio(p))
+    {fprintf(stderr, "%d: %s is a ratio?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_real(p))
+    {fprintf(stderr, "%d: %s is not real?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_complex(p))
+    {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_number(p))
+    {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_real(p) != 1.5)
+    {fprintf(stderr, "%d: %s is not 1.5?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s2 = s7_number_to_string(sc, p, 10);
+  if (strcmp(s2, "1.5") != 0)
+    {fprintf(stderr, "%d: (number->string %s) is not \"1.5\"?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  free(s2);
+
+  if (s7_number_to_real(sc, p) != 1.5)
+    {fprintf(stderr, "%d: s7_number_to_real %s is not 1.5?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_number_to_real_with_caller(sc, p, "ffitest") != 1.5)
+    {fprintf(stderr, "%d: s7_number_to_real_with_caller %s is not 1.5?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_number_to_real_with_location(sc, p, s7_make_symbol(sc, "ffitest")) != 1.5)
+    {fprintf(stderr, "%d: s7_number_to_real_with_location %s is not 1.5?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_gc_unprotect_at(sc, gc_loc);
+
+  p = s7_make_mutable_real(sc, 1.5);
+  if (!s7_is_real(p))
+    {fprintf(stderr, "%d: %s is not real?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_make_complex(sc, 1.0, 1.0);
+  gc_loc = s7_gc_protect(sc, p);
+
+  if (s7_is_integer(p))
+    {fprintf(stderr, "%d: %s is integral?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_is_rational(p))
+    {fprintf(stderr, "%d: %s is rational?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_is_ratio(p))
+    {fprintf(stderr, "%d: %s is a ratio?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_is_real(p))
+    {fprintf(stderr, "%d: %s is real?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_complex(p))
+    {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (!s7_is_number(p))
+    {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_real_part(p) != 1.0)
+    {fprintf(stderr, "%d: (real-part %s) is not 1.0?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_imag_part(p) != 1.0)
+    {fprintf(stderr, "%d: (imag-part %s) is not 1.0?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s2 = s7_number_to_string(sc, p, 10);
+  if (strcmp(s2, "1.0+1.0i") != 0)
+    {fprintf(stderr, "%d: (number->string %s) is not \"1.0+1.0i\"?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  free(s2);
+
+  s7_immutable(p);
+  if (!s7_is_immutable(p))
+    fprintf(stderr, "s7_immutable failed?\n");
+  s7_gc_unprotect_at(sc, gc_loc);
+
+  p = s7_signature(sc, s7_name_to_value(sc, "abs"));
+  if (!s7_is_pair(p))
+    {fprintf(stderr, "%d: %s is not a pair?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  {
+    s7_pointer p;
+    p = s7_shadow_rootlet(sc);
+    if ((!s7_is_null(sc, p)) &&
+	(!s7_is_let(p)))
+      {fprintf(stderr, "shadow rootlet is %s\n", s1 = TO_STR(p)); free(s1);}
+    s7_set_shadow_rootlet(sc, p);
+  }
+
+  if (s7_c_pointer(s7_make_c_pointer(sc, NULL)))
+    fprintf(stderr, "s7_c_pointer 0 is not null\n");
+  if (s7_c_pointer_type(s7_make_c_pointer_with_type(sc, NULL, s7_nil(sc), s7_f(sc))) != s7_nil(sc))
+    fprintf(stderr, "s7_c_pointer_type is not ()\n");
+  {
+    s7_pointer csc;
+    csc = s7_make_c_pointer_with_type(sc, (void *)sc, s7_make_symbol(sc, "s7_scheme*"), s7_f(sc));
+    if (!s7_is_c_pointer_of_type(csc, s7_make_symbol(sc, "s7_scheme*")))
+      {fprintf(stderr, "c-pointer type %s != s7_scheme*\n", s1 = TO_STR(s7_c_pointer_type(csc))); free(s1);}
+    s7_c_pointer_with_type(sc, csc, s7_make_symbol(sc, "s7_scheme*"), "ffitest", __LINE__);
+    csc = s7_make_c_pointer_wrapper_with_type(sc, (void *)sc, s7_make_symbol(sc, "s7_scheme*"), s7_f(sc));
+    if (!s7_is_c_pointer_of_type(csc, s7_make_symbol(sc, "s7_scheme*")))
+      {fprintf(stderr, "c-pointer wrapper type %s != s7_scheme*\n", s1 = TO_STR(s7_c_pointer_type(csc))); free(s1);}
+  }
+  if (!s7_is_int_vector(s7_make_int_vector(sc, 3, 1, NULL)))
+    fprintf(stderr, "s7_make_int_vector did not make an int-vector\n");
+  if (s7_is_float_vector(s7_make_int_vector(sc, 3, 1, NULL)))
+    fprintf(stderr, "s7_make_int_vector made a float-vector?\n");
+
+  {
+    s7_int* dims;
+    s7_pointer p;
+    s7_double *els;
+    uint8_t *bels;
+    dims = (s7_int *)malloc(2 * sizeof(s7_int));
+    dims[0] = 2;
+    dims[1] = 3;
+
+    p = s7_make_int_vector(sc, 6, 2, dims);
+    if (s7_vector_rank(p) != 2) fprintf(stderr, "int vector rank not 2?\n");
+    p = s7_make_float_vector(sc, 6, 2, dims);
+    if (s7_vector_rank(p) != 2) fprintf(stderr, "float vector rank not 2?\n");
+    if (s7_vector_dimension(p, 0) != 2) fprintf(stderr, "%d: s7_vector_dimension 0: %" ld64 "\n", __LINE__, s7_vector_dimension(p, 0));
+    if (s7_vector_dimension(p, 1) != 3) fprintf(stderr, "%d: s7_vector_dimension 1: %" ld64 "\n", __LINE__, s7_vector_dimension(p, 1));
+
+    p = s7_make_float_vector(sc, 6, 1, NULL);
+    s7_float_vector_set(p, 1, 32.0);
+    if (s7_float_vector_ref(p, 1) != 32.0) fprintf(stderr, "float_vector[1] not 32.0?\n");
+    els = s7_float_vector_elements(p);
+    if (els[1] != 32.0) fprintf(stderr, "float_vector els[1] not 32.0?\n");
+    if (!s7_is_float_vector(p)) fprintf(stderr, "not a float_vector?\n");
+
+    p = s7_make_byte_vector(sc, 6, 2, dims);
+    s7_byte_vector_set(p, 1, 32);
+    if (s7_byte_vector_ref(p, 1) != 32) fprintf(stderr, "byte_vector[1] not 32?\n");
+    bels = s7_byte_vector_elements(p);
+    if (bels[1] != 32) fprintf(stderr, "byte_vector bels[1] not 32?\n");
+    if (!s7_is_byte_vector(p)) fprintf(stderr, "not a byte_vector?\n");
+    free(dims); /* ?? */
+  }
+
+  {
+    s7_pointer p, q;
+    s7_int *els;
+    p = s7_make_int_vector(sc, 6, 1, NULL);
+    s7_int_vector_set(p, 1, 32);
+    if (s7_int_vector_ref(p, 1) != 32) fprintf(stderr, "int_vector[1] not 32?\n");
+    els = s7_int_vector_elements(p);
+    if (els[1] != 32) fprintf(stderr, "int_vector els[1] not 32?\n");
+    if (!s7_is_int_vector(p)) fprintf(stderr, "not an int_vector?\n");
+    q = s7_vector_to_list(sc, p);
+    if (!s7_is_pair(q)) {fprintf(stderr, "%d vector->list is not a list %s\n", __LINE__, s1 = TO_STR(q)); free(s1);}
+    if (s7_list_length(sc, q) != 6) {fprintf(stderr, "%d vector->list len != 6 %s\n", __LINE__, s1 = TO_STR(q)); free(s1);}
+    if (s7_vector_dimension(p, 0) != 6) fprintf(stderr, "%d: s7_vector_dimension: %" ld64 "\n", __LINE__, s7_vector_dimension(p, 0));
+  }
+
+  {
+    s7_int* dims;
+    s7_pointer p;
+    s7_pointer *els;
+    dims = (s7_int *)malloc(2 * sizeof(s7_int));
+    dims[0] = 2;
+    dims[1] = 3;
+    p = s7_make_normal_vector(sc, 6, 2, dims);
+    if (s7_vector_rank(p) != 2) fprintf(stderr, "vector rank not 2?\n");
+    if (s7_vector_dimension(p, 0) != 2) fprintf(stderr, "%d: s7_vector_dimension 0: %" ld64 "\n", __LINE__, s7_vector_dimension(p, 0));
+    if (s7_vector_dimension(p, 1) != 3) fprintf(stderr, "%d: s7_vector_dimension 1: %" ld64 "\n", __LINE__, s7_vector_dimension(p, 1));
+    s7_vector_set(sc, p, 1, s7_make_integer(sc, 1));
+    if (s7_integer(s7_vector_ref(sc, p, 1)) != 1) fprintf(stderr, "vector[1] not 1?\n");
+    els = s7_vector_elements(p);
+    if (s7_integer(els[1]) != 1) fprintf(stderr, "vector els[1] not 1?\n");
+    if (!s7_is_vector(p)) fprintf(stderr, "not a vector?\n");
+    free(dims); /* ?? */
+  }
+
+  {
+    s7_int len;
+    len = s7_integer(s7_starlet_ref(sc, s7_make_symbol(sc, "print-length")));
+    s7_starlet_set(sc, s7_make_symbol(sc, "print-length"), s7_make_integer(sc, len));
+  }
+
+  p = s7_rationalize(sc, 1.5, 1e-12);
+  gc_loc = s7_gc_protect(sc, p);
+  s1 = TO_STR(p);
+  if (strcmp(s1, "3/2") != 0)
+    fprintf(stderr, "%d: ratio is %s?\n", __LINE__, s1);
+  free(s1);
+  s7_gc_unprotect_at(sc, gc_loc);
+
+  s7_set_default_random_state(sc, 1234, 5678);
+  s7_random(sc, NULL);
+  s7_stacktrace(sc);
+
+  if (s7_list(sc, 0) != s7_nil(sc))
+    fprintf(stderr, "s7_list 0 is not ()\n");
+  if (s7_list_nl(sc, 0, NULL) != s7_nil(sc))
+    fprintf(stderr, "s7_list_nl 0 is not ()\n");
+
+  p = s7_make_vector(sc, 12);
+  gc_loc = s7_gc_protect(sc, p);
+
+  if (!s7_is_vector(p))
+    {fprintf(stderr, "%d: %s is not a vector?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_type_of(sc, p) != s7_make_symbol(sc, "vector?"))
+    fprintf(stderr, "type-of(vector) confused?\n");
+
+  if (s7_vector_rank(p) != 1)
+    {fprintf(stderr, "%d: (dimensions %s) is not 1?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_vector_set(sc, p, 1, s7_t(sc));
+  if (s7_vector_ref(sc, p, 1) != s7_t(sc))
+    {fprintf(stderr, "%d: (%s 1) is not #t?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_vector_fill(sc, p, TO_S7_INT(123));
+  if (s7_integer(s7_vector_ref(sc, p, 1)) != 123)
+    {fprintf(stderr, "%d: (%s 1) is not 123?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_gc_unprotect_at(sc, gc_loc);
+
+  p = s7_make_and_fill_vector(sc, 3, TO_S7_INT(3));
+  gc_loc = s7_gc_protect(sc, p);
+
+  if (s7_integer(s7_vector_ref(sc, p, 1)) != 3)
+    {fprintf(stderr, "%d: (%s 1) is not 3?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p1 = s7_vector_copy(sc, p);
+  if ((p == p1) ||
+      (!s7_is_vector(p1)))
+    {fprintf(stderr, "%d: copied vector: %s\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+  s7_gc_unprotect_at(sc, gc_loc);
+
+
+  p = s7_make_string(sc, "1234");
+  gc_loc = s7_gc_protect(sc, p);
+
+  if (!s7_is_string(p))
+    {fprintf(stderr, "%d: %s is not a string?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_string_length(p) != 4)
+    {fprintf(stderr, "%d: (length %s) is 4?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (strcmp(s7_string(p), "1234") != 0)
+    {fprintf(stderr, "%d: %s is not \"1234\"?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (strcmp(s7_string(s7_copy(sc, s7_cons(sc, p, s7_nil(sc)))), "1234") != 0)
+    {fprintf(stderr, "%d: copy(%s) is not \"1234\"?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_fill(sc, s7_cons(sc, p, s7_cons(sc, s7_make_character(sc, 'c'), s7_nil(sc))));
+  if (strcmp(s7_string(p), "cccc") != 0)
+    {fprintf(stderr, "%d: fill(%s) is not \"cccc\"?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_gc_unprotect_at(sc, gc_loc);
+
+  p = s7_make_permanent_string(sc, "asdf");
+  perm1 = p;
+  if (!s7_is_string(p))
+    {fprintf(stderr, "%d: %s is not a string?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_string_length(p) != 4)
+    {fprintf(stderr, "%d: (length %s) is 4?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  {
+    s7_int gc_loc;
+    s7_pointer q;
+    p = s7_make_string_with_length(sc, "asdf", 4);
+    gc_loc = s7_gc_protect(sc, p);
+    if (!s7_is_string(p))
+      {fprintf(stderr, "%d: %s is not a string?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+    if (s7_string_length(p) != 4)
+      {fprintf(stderr, "%d: (length %s) is 4?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+    s7_gc_protect_via_location(sc, q = s7_make_string(sc, "fdsa"), gc_loc);
+    if (q != s7_gc_protected_at(sc, gc_loc))
+      {fprintf(stderr, "%d: wrong thing at gc_loc? %s\n", __LINE__, s1 = TO_STR(s7_gc_protected_at(sc, gc_loc))); free(s1);}
+    s7_gc_unprotect_via_location(sc, gc_loc);
+    p = s7_make_string_wrapper(sc, "hiho");
+    if (!s7_is_string(p))
+      {fprintf(stderr, "%d: %s is not a string?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+    if (s7_string_length(p) != 4)
+      {fprintf(stderr, "%d: (length %s) is 4?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  }
+
+  p = s7_make_character(sc, 65);
+  if (!s7_is_character(p))
+    {fprintf(stderr, "%d: %s is not a character?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_character(p) != 'A')
+    {fprintf(stderr, "%d: %s is not #\\A?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+
+  p = s7_list(sc, 3, TO_S7_INT(1), TO_S7_INT(2), TO_S7_INT(3));
+  gc_loc = s7_gc_protect(sc, p);
+  if (s7_tree_memq(sc, s7_make_symbol(sc, "oops"), p))
+    fprintf(stderr, "'oops is in the list?\n");
+
+  if (!s7_is_list(sc, p))
+    {fprintf(stderr, "%d: %s is not a list?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_list_length(sc, p) != 3)
+    {fprintf(stderr, "%d: (length %s) is not 3?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_integer(s7_list_ref(sc, p, 1)) != 2)
+    {fprintf(stderr, "%d: (%s 1) is not 2?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_integer(s7_car(p)) != 1)
+    {fprintf(stderr, "%d: (car %s) is not 1?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_integer(s7_cadr(p)) != 2)
+    {fprintf(stderr, "%d: (cadr %s) is not 2?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_integer(s7_caddr(p)) != 3)
+    {fprintf(stderr, "%d: (caddr %s) is not 2?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_integer(s7_car(s7_cddr(p))) != 3)
+    {fprintf(stderr, "%d: (car (cddr %s)) is not 2?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_list_set(sc, p, 1, s7_f(sc));
+  if (s7_list_ref(sc, p, 1) != s7_f(sc))
+    {fprintf(stderr, "%d: (%s 1) is not #f?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_gc_unprotect_at(sc, gc_loc);
+
+  p = s7_make_list(sc, 3, s7_make_integer(sc, 123));
+  if (!s7_is_list(sc, p))
+    {fprintf(stderr, "%d: %s is not a list?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_list_length(sc, p) != 3)
+    {fprintf(stderr, "%d: (length %s) is not 3?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_integer(s7_list_ref(sc, p, 1)) != 123)
+    {fprintf(stderr, "%d: (%s 1) is not 123?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_list_nl(sc, 3, TO_S7_INT(1), TO_S7_INT(2), TO_S7_INT(3), NULL);
+  gc_loc = s7_gc_protect(sc, p);
+  if (!s7_is_list(sc, p))
+    {fprintf(stderr, "%d: %s is not a list?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_list_length(sc, p) != 3)
+    {fprintf(stderr, "%d: (length %s) is not 3?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_integer(s7_list_ref(sc, p, 1)) != 2)
+    {fprintf(stderr, "%d: (%s 1) is not 2?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  s7_gc_unprotect_at(sc, gc_loc);
+
+  {
+    s7_pointer array[3];
+    for (i = 1; i < 4; i++) array[i - 1] = s7_make_integer(sc, i);
+    p = s7_array_to_list(sc, 3, array);
+    gc_loc = s7_gc_protect(sc, p);
+    if (!s7_is_list(sc, p))
+      {fprintf(stderr, "%d: %s is not a list?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+    if (s7_list_length(sc, p) != 3)
+      {fprintf(stderr, "%d: (length %s) is not 3?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+    if (s7_integer(s7_list_ref(sc, p, 1)) != 2)
+      {fprintf(stderr, "%d: (%s 1) is not 2?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+    s7_gc_unprotect_at(sc, gc_loc);
+  }
+  p = s7_array_to_list(sc, 0, NULL);
+  if (!s7_is_null(sc, p))
+    {fprintf(stderr, "%d: %s is not null?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  {
+    s7_pointer c1, c2, c3, c12, c23, c123, c1234, c1d2, c2d3, c3d4, c12d3, c23d4, c123d4, c1234d5;
+    s7_gc_on(sc, false);
+    c1 = s7_list(sc, 1, TO_S7_INT(1));                                              /* (1) */
+    c2 = s7_list(sc, 1, TO_S7_INT(2));                                              /* (2) */
+    c3 = s7_list(sc, 1, TO_S7_INT(3));                                              /* (3) */
+    c12 = s7_list(sc, 2, TO_S7_INT(1), TO_S7_INT(2));                               /* (1 2) */
+    c23 = s7_list(sc, 2, TO_S7_INT(2), TO_S7_INT(3));                               /* (2 3) */
+    c123 = s7_list(sc, 3, TO_S7_INT(1), TO_S7_INT(2), TO_S7_INT(3));                /* (1 2 3) */
+    c1234 = s7_list(sc, 4, TO_S7_INT(1), TO_S7_INT(2), TO_S7_INT(3), TO_S7_INT(4)); /* (1 2 3 4) */
+    c1d2 = s7_cons(sc, TO_S7_INT(1), TO_S7_INT(2));                                 /* (1 . 2) */
+    c2d3 = s7_cons(sc, TO_S7_INT(2), TO_S7_INT(3));                                 /* (2 . 3) */
+    c3d4 = s7_cons(sc, TO_S7_INT(3), TO_S7_INT(4));                                 /* (3 . 4) */
+    c12d3 = s7_cons(sc, TO_S7_INT(1), s7_cons(sc, TO_S7_INT(2), TO_S7_INT(3)));     /* (1 2 . 3) */
+    c23d4 = s7_cons(sc, TO_S7_INT(2), s7_cons(sc, TO_S7_INT(3), TO_S7_INT(4)));     /* (2 3 . 4) */
+    c123d4 = s7_cons(sc, TO_S7_INT(1), s7_cons(sc, TO_S7_INT(2), s7_cons(sc, TO_S7_INT(3), TO_S7_INT(4))));                             /* (1 2 3 . 4) */
+    c1234d5 = s7_cons(sc, TO_S7_INT(1), s7_cons(sc, TO_S7_INT(2), s7_cons(sc, TO_S7_INT(3), s7_cons(sc, TO_S7_INT(4), TO_S7_INT(5))))); /* (1 2 3 4 . 5) */
+
+    if (s7_integer(p = s7_caar(s7_list(sc, 1, c1))) != 1)
+      {fprintf(stderr, "%d: caar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cadr(c12)) != 2)
+      {fprintf(stderr, "%d: cadr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cdar(s7_list(sc, 1, c1d2))) != 2)
+      {fprintf(stderr, "%d: cdar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cddr(c12d3)) != 3)
+      {fprintf(stderr, "%d: cddr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_caaar(s7_list(sc, 1, s7_list(sc, 1, c1)))) != 1)
+      {fprintf(stderr, "%d: caaar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_caadr(s7_list(sc, 2, TO_S7_INT(1), c2))) != 2)
+      {fprintf(stderr, "%d: caadr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cadar(s7_list(sc, 1, c12))) != 2)
+      {fprintf(stderr, "%d: cadar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cdaar(s7_list(sc, 1, s7_list(sc, 1, c1d2)))) != 2)
+      {fprintf(stderr, "%d: cdaar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_caddr(c123)) != 3)
+      {fprintf(stderr, "%d: caddr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cdddr(c123d4)) != 4)
+      {fprintf(stderr, "%d: cdddr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cdadr(s7_list(sc, 2, TO_S7_INT(1), c2d3))) != 3)
+      {fprintf(stderr, "%d: cdadr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cddar(s7_list(sc, 1, c12d3))) != 3)
+      {fprintf(stderr, "%d: cddar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_caaaar(s7_list(sc, 1, s7_list(sc, 1, s7_list(sc, 1, c1))))) != 1)
+      {fprintf(stderr, "%d: caaaar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_caaadr(s7_list(sc, 2, TO_S7_INT(1), s7_list(sc, 1, c2)))) != 2)
+      {fprintf(stderr, "%d: caaadr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_caadar(s7_list(sc, 1, s7_list(sc, 2, TO_S7_INT(1), c2)))) != 2)
+      {fprintf(stderr, "%d: caadar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cadaar(s7_list(sc, 1, s7_list(sc, 1, c12)))) != 2)
+      {fprintf(stderr, "%d: cadaar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_caaddr(s7_list(sc, 3, TO_S7_INT(1), TO_S7_INT(2), c3))) != 3)
+      {fprintf(stderr, "%d: caaddr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cadddr(c1234)) != 4)
+      {fprintf(stderr, "%d: cadddr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cadadr(s7_list(sc, 2, TO_S7_INT(1), c23))) != 3)
+      {fprintf(stderr, "%d: cadadr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_caddar(s7_list(sc, 1, c123))) != 3)
+      {fprintf(stderr, "%d: caddar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cdaaar(s7_list(sc, 1, s7_list(sc, 1, s7_list(sc, 1, c1d2))))) != 2)
+      {fprintf(stderr, "%d: cdaaar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cdaadr(s7_list(sc, 2, TO_S7_INT(1), s7_list(sc, 1, c2d3)))) != 3)
+      {fprintf(stderr, "%d: cdaadr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cdadar(s7_list(sc, 1, s7_list(sc, 2, TO_S7_INT(1), c2d3)))) != 3)
+      {fprintf(stderr, "%d: cdadar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cddaar(s7_list(sc, 1, s7_list(sc, 1, c12d3)))) != 3)
+      {fprintf(stderr, "%d: cddaar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cdaddr(s7_list(sc, 3, TO_S7_INT(1), TO_S7_INT(2), c3d4))) != 4)
+      {fprintf(stderr, "%d: cdaddr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cddddr(c1234d5)) != 5)
+      {fprintf(stderr, "%d: cdddd is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cddadr(s7_list(sc, 2, TO_S7_INT(1), c23d4))) != 4)
+      {fprintf(stderr, "%d: cddadr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if (s7_integer(p = s7_cdddar(s7_list(sc, 1, c123d4))) != 4)
+      {fprintf(stderr, "%d: cdddar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    p = s7_reverse(sc, c123);
+    s1 = TO_STR(p);
+    if (strcmp(s1, "(3 2 1)") != 0)
+      {fprintf(stderr, "%d: (reverse '(1 2 3)) is %s?\n", __LINE__, s1);}
+    free(s1);
+
+    p = s7_append(sc, c1, c2);
+    s1 = TO_STR(p);
+    if (strcmp(s1, "(1 2)") != 0)
+      {fprintf(stderr, "%d: (append '(1) '(2)) is %s?\n", __LINE__, s1);}
+    free(s1);
+
+    p = s7_list(sc, 2, s7_cons(sc, s7_make_symbol(sc, "a"), TO_S7_INT(32)), s7_cons(sc, s7_make_symbol(sc, "b"), TO_S7_INT(1)));
+    p1 = s7_assq(sc, s7_make_symbol(sc, "a"), p);
+    s1 = TO_STR(p1);
+    if (strcmp(s1, "(a . 32)") != 0)
+      {fprintf(stderr, "%d: (assq 'a '((a . 32) (b . 1)))) is %s?\n", __LINE__, s1);}
+    free(s1);
+
+    p1 = s7_assoc(sc, s7_make_symbol(sc, "b"), p);
+    s1 = TO_STR(p1);
+    if (strcmp(s1, "(b . 1)") != 0)
+      {fprintf(stderr, "%d: (assoc 'b '((a . 32) (b . 1))) is %s?\n", __LINE__, s1);}
+    free(s1);
+
+    p = s7_member(sc, TO_S7_INT(2), c1234);
+    s1 = TO_STR(p);
+    if (strcmp(s1, "(2 3 4)") != 0)
+      {fprintf(stderr, "%d: (member 2 '(1 2 3 4)) is %s?\n", __LINE__, s1);}
+    free(s1);
+
+    p = s7_list(sc, 2, s7_make_symbol(sc, "a"), s7_make_symbol(sc, "b"));
+    p1 = s7_memq(sc, s7_make_symbol(sc, "b"), p);
+    s1 = TO_STR(p1); /* s1 is "(b)" here but valgrind complains */
+    if (strcmp(s1, "(b)") != 0)
+      {fprintf(stderr, "%d: (memq 'b '(a b)) is %s?\n", __LINE__, s1);}
+    free(s1);
+
+    s7_set_car(c1234, s7_make_symbol(sc, "+"));
+    p = s7_eval(sc, c1234, s7_sublet(sc, s7_rootlet(sc), s7_nil(sc)));
+    if (s7_integer(p) != 9)
+      {fprintf(stderr, "%d: (eval '(+ 2 3 4)) is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+    s7_gc_on(sc, true);
+
+    p = s7_eval(sc, s7_cons(sc, s7_make_symbol(sc, "+"), /* s7.html example */
+               s7_cons(sc, s7_make_integer(sc, 1),
+                  s7_cons(sc, s7_make_integer(sc, 2), s7_nil(sc)))),
+               s7_nil(sc));
+    if (s7_integer(p) != 3)
+       {fprintf(stderr, "%d: (eval '(+ 1 2)) is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+    p = s7_eval_with_location(sc, s7_cons(sc, s7_make_symbol(sc, "+"),
+					  s7_cons(sc, s7_make_integer(sc, 1),
+						  s7_cons(sc, s7_make_integer(sc, 2), s7_nil(sc)))),
+			      s7_nil(sc), "ffitest", __FILE__, __LINE__);
+    if (s7_integer(p) != 3)
+       {fprintf(stderr, "%d: (eval '(+ 1 2)) is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+    p = s7_eval(sc, s7_cons(sc, s7_make_symbol(sc, "+"), /* s7.html example */
+               s7_cons(sc, s7_make_integer(sc, 1),
+                  s7_cons(sc, s7_make_integer(sc, 3), s7_nil(sc)))),
+               s7_rootlet(sc));
+    if (s7_integer(p) != 4)
+       {fprintf(stderr, "%d: (eval '(+ 1 3)) is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+    p = s7_eval_c_string(sc, "(+ 2 3)");
+    if (s7_integer(p) != 5)
+       {fprintf(stderr, "%d: (eval-string '(+ 2 3)) is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  }
+
+  s7_for_each_symbol_name(sc, symbol_func, NULL);
+  s7_for_each_symbol(sc, symbol_func_1, NULL);
+  s7_symbol_name(s7_make_symbol(sc, "a_symbol"));
+
+  {
+    const char *str = s7_symbol_name(s7_make_symbol(sc, "asdf"));
+    if (strcmp(str, "asdf") != 0)
+      fprintf(stderr, "%d: s7_symbol_name('asdf): %s\n", __LINE__, str);
+  }
+
+  p = s7_symbol_initial_value(s7_make_symbol(sc, "abs"));
+  if (p != s7_name_to_value(sc, "abs"))
+    {fprintf(stderr, "%d: s7_symbol_initial_value('abs): %s\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_symbol_set_initial_value(sc, s7_make_symbol(sc, "asdf"), s7_make_integer(sc, 321));
+  if (s7_integer(p) != 321)
+    {fprintf(stderr, "%d: s7_symbol_set_initial_value('asdf, 321): %s\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_make_hash_table(sc, 255);
+  gc_loc = s7_gc_protect(sc, p);
+
+  if (!s7_is_hash_table(p))
+    {fprintf(stderr, "%d: %s is not a hash-table?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_hash_table_ref(sc, p, s7_eof_object(sc)) != s7_f(sc))
+    {fprintf(stderr, "%d: (hash-table-ref %s #<eof>) is not #f?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_hash_table_set(sc, p, s7_eof_object(sc), s7_unspecified(sc));
+  if (s7_hash_table_ref(sc, p, s7_eof_object(sc)) != s7_unspecified(sc))
+    {fprintf(stderr, "%d: (hash-table-ref %s #<eof>) is not #<unspecified>?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  s7_gc_unprotect_at(sc, gc_loc);
+
+  p = s7_current_input_port(sc);
+  if (!s7_is_input_port(sc, p))
+    {fprintf(stderr, "%d: %s is not an input port?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  s7_port_line_number(sc, p);
+  s7_add_to_history(sc, s7_nil(sc));
+  s7_history(sc);
+
+  p = s7_current_output_port(sc);
+  if (!s7_is_output_port(sc, p))
+    {fprintf(stderr, "%d: %s is not an output port?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_name_to_value(sc, "abs");
+  if (!s7_is_procedure(p))
+    {fprintf(stderr, "%d: %s is not a procedure?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_make_symbol(sc, "abs");
+  if (!s7_is_symbol(p))
+    {fprintf(stderr, "%d: %s is not a symbol?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_is_syntax(p))
+    {fprintf(stderr, "%d: %s is syntax?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_gensym(sc, "abs");
+  if (!s7_is_symbol(p))
+    {fprintf(stderr, "%d: %s is not a symbol?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_make_keyword(sc, "key");
+  if (!s7_is_keyword(p))
+    {fprintf(stderr, "%d: %s is not a keyword?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_keyword_to_symbol(sc, p) != s7_make_symbol(sc, "key"))
+    fprintf(stderr, "%d: key->sym != sym?\n", __LINE__);
+
+  if (!s7_is_eq(p, p))
+    {fprintf(stderr, "%d: %s is not a self-eq??\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_rootlet(sc);
+  if (!s7_is_let(p))
+    {fprintf(stderr, "%d: %s is not an environment?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_curlet(sc);
+  if ((!s7_is_null(sc, p)) && (!s7_is_let(p)))
+    {fprintf(stderr, "%d: %s is not an environment?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_define_constant(sc, "a_constant", s7_t(sc));
+  if (!s7_is_immutable(s7_name_to_value(sc, "a_constant")))
+    {fprintf(stderr, "%d: a_constant is not a constant?\n", __LINE__);}
+  if (!s7_is_defined(sc, "a_constant"))
+    {fprintf(stderr, "%d: a_constant is not defined?\n", __LINE__);}
+  p = s7_symbol_table_find_name(sc, "a_constant");
+  if (!s7_is_symbol(p))
+    {fprintf(stderr, "%d: %s is not a symbol (from s7_symbol_find_name)?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_define_constant_with_documentation(sc, "another_constant", s7_t(sc), "another constant");
+  if (s7_name_to_value(sc, "another_constant") != s7_t(sc))
+    {fprintf(stderr, "%d: another_constant: %s?\n", __LINE__, s1 = TO_STR(s7_name_to_value(sc, "another_constant"))); free(s1);}
+  {
+    const char *s;
+    s = s7_documentation(sc, s7_make_symbol(sc, "another_constant"));
+    if ((!s) || (strcmp(s, "another constant") != 0))
+      fprintf(stderr, "%d: another_constant doc: %s\n", __LINE__, s);
+  }
+  s7_define_variable_with_documentation(sc, "another_variable", s7_t(sc), "another variable");
+  if (s7_name_to_value(sc, "another_variable") != s7_t(sc))
+    {fprintf(stderr, "%d: another_variable: %s?\n", __LINE__, s1 = TO_STR(s7_name_to_value(sc, "another_variable"))); free(s1);}
+  {
+    const char *s;
+    s = s7_documentation(sc, s7_make_symbol(sc, "another_variable"));
+    if ((!s) || (strcmp(s, "another variable") != 0))
+      fprintf(stderr, "%d: another_variable doc: %s\n", __LINE__, s);
+  }
+
+  s7_define_safe_function(sc, "a_function", a_function, 1, 0, false, "a function");
+  if (!s7_is_defined(sc, "a_function"))
+    {fprintf(stderr, "%d: a_function is not defined?\n", __LINE__);}
+  if (!s7_is_function(s7_name_to_value(sc, "a_function")))
+    {fprintf(stderr, "%d: a_function is not a function?\n", __LINE__);}
+
+  p = s7_apply_function(sc, s7_name_to_value(sc, "a_function"), s7_cons(sc, TO_S7_INT(32), s7_nil(sc)));
+  if (!s7_is_integer(p))
+    {fprintf(stderr, "%d: %s is not an integer?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_integer(p) != 32)
+    {fprintf(stderr, "%d: %s is not 32?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+
+  dax_type_tag = s7_make_c_type(sc, "dax");
+  s7_c_type_set_free(sc, dax_type_tag, free_dax);
+  s7_c_type_set_equal(sc, dax_type_tag, equal_dax);
+  s7_c_type_set_is_equal(sc, dax_type_tag, equality_dax);
+  s7_c_type_set_mark(sc, dax_type_tag, mark_dax);
+  s7_c_type_set_to_string(sc, dax_type_tag, dax_to_string);
+
+  s7_define_function(sc, "make-dax", make_dax, 2, 0, false, "(make-dax x data) makes a new dax");
+  s7_define_typed_function(sc, "dax?", is_dax, 1, 0, false, "(dax? anything) returns #t if its argument is a dax object", s7_make_signature(sc, 1, s7_t(sc)));
+  if (s7_car(s7_signature(sc, s7_name_to_value(sc, "dax?"))) != s7_t(sc))
+    {fprintf(stderr, "%d: dax? signature: %s\n", __LINE__, s1 = TO_STR(s7_signature(sc, s7_name_to_value(sc, "dax?")))); free(s1);}
+  p = s7_make_function(sc, "make-dax", make_dax, 2, 0, false, "(make-dax x data) makes a new dax");
+  if (!s7_is_procedure(p)) fprintf(stderr, "%d: make-dax is not a procedure\n", __LINE__);
+  p = s7_make_safe_function(sc, "make-dax", make_dax, 2, 0, false, "(make-dax x data) makes a new dax");
+  if (!s7_is_procedure(p)) fprintf(stderr, "%d: make-dax is not a (safe) procedure\n", __LINE__);
+
+  s7_define_variable(sc, "dax-x",
+                     s7_dilambda(sc, "dax-x", dax_x, 1, 0, set_dax_x, 2, 0, "dax x field (a real)"));
+
+  s7_define_variable(sc, "dax-xx",
+                     s7_typed_dilambda(sc, "dax-x", dax_x, 1, 0, set_dax_x, 2, 0, "dax x field (a real)",
+				       s7_make_signature(sc, 1, s7_make_symbol(sc, "real?")),
+				       s7_make_circular_signature(sc, 0, 1, s7_make_symbol(sc, "real?"))));
+
+  s7_define_variable(sc, "dax-data",
+                     s7_dilambda_with_environment(sc, s7_nil(sc), "dax-data", dax_data, 1, 0, set_dax_data, 2, 0, "dax data field"));
+
+  if (!s7_is_dilambda(s7_name_to_value(sc, "dax-x")))
+    {fprintf(stderr, "%d: dax-x is not a pws?\n", __LINE__);}
+
+  p = make_dax(sc, s7_cons(sc, s7_make_real(sc, 1.0), s7_cons(sc, TO_S7_INT(2), s7_nil(sc))));
+  gc_loc = s7_gc_protect(sc, p);
+
+  if (!s7_is_c_object(p))
+    {fprintf(stderr, "%d: %s is not a c_object?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p1 = s7_apply_function(sc, s7_name_to_value(sc, "dax?"), s7_cons(sc, p, s7_nil(sc)));
+  if (p1 != s7_t(sc))
+    {fprintf(stderr, "%d: %s is not a dax c_object?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s1 = TO_STR(p);
+  if (strcmp(s1, "#<dax 1.000 2>") != 0)
+    {fprintf(stderr, "%d: dax prints as %s?\n", __LINE__, s2 = TO_STR(p)); free(s2);}
+  free(s1);
+
+  p1 = s7_apply_function(sc, s7_name_to_value(sc, "dax-data"), s7_cons(sc, p, s7_nil(sc)));
+  if (!s7_is_integer(p1))
+    {fprintf(stderr, "%d: %s is not an integer?\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+  if (s7_integer(p1) != 2)
+    {fprintf(stderr, "%d: %s is not 2?\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+
+  s7_apply_function(sc, s7_setter(sc, s7_name_to_value(sc, "dax-data")), s7_cons(sc, p, s7_cons(sc, TO_S7_INT(32), s7_nil(sc))));
+  p1 = s7_apply_function(sc, s7_name_to_value(sc, "dax-data"), s7_cons(sc, p, s7_nil(sc)));
+  if (!s7_is_integer(p1))
+    {fprintf(stderr, "%d: %s is not an integer?\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+  if (s7_integer(p1) != 32)
+    {fprintf(stderr, "%d: %s is not 32?\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+
+  s7_gc_unprotect_at(sc, gc_loc);
+
+  s7_define_function(sc, "dx->list", dx_to_list, 1, 0, false, NULL);
+  dx_type_tag = s7_make_c_type(sc, "dx");
+  s7_c_type_set_gc_free(sc, dx_type_tag, free_dx);
+  s7_c_type_set_gc_mark(sc, dx_type_tag, mark_dx);
+  s7_c_type_set_getter(sc, dx_type_tag, s7_name_to_value(sc, "abs"));
+  s7_c_type_set_setter(sc, dx_type_tag, s7_name_to_value(sc, "list-ref"));
+  s7_c_type_set_to_list(sc, dx_type_tag, dx_to_list);
+
+  s7_define_function_star(sc, "plus", plus, "(red 32) blue", "an example of define* from C");
+  if (!s7_is_procedure(s7_name_to_value(sc, "plus")))
+    {fprintf(stderr, "%d: plus is not a function?\n", __LINE__);}
+
+  p = s7_apply_function(sc, s7_name_to_value(sc, "plus"), s7_cons(sc, TO_S7_INT(1), s7_cons(sc, TO_S7_INT(2), s7_nil(sc))));
+  if (!s7_is_integer(p))
+    {fprintf(stderr, "%d: %s is not an integer?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_integer(p) != 4)
+    {fprintf(stderr, "%d: %s is not 4?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  {
+    s7_int val;
+    val = s7_integer(s7_apply_function_star(sc, s7_name_to_value(sc, "plus"),
+					    s7_list(sc, 2, s7_make_integer(sc, 1), s7_make_integer(sc, 2))));
+    if (val != 4)
+      fprintf(stderr, "%d: plus: %" ld64 "\n", __LINE__, val);
+    val = s7_integer(s7_apply_function_star(sc, s7_name_to_value(sc, "plus"),
+					    s7_list(sc, 2, s7_make_keyword(sc, "blue"), s7_make_integer(sc, 2))));
+    if (val != 66)
+      fprintf(stderr, "%d: plus: %" ld64 "\n", __LINE__, val);
+    val = s7_integer(s7_apply_function_star(sc, s7_name_to_value(sc, "plus"),
+					    s7_list(sc, 2, s7_make_symbol(sc, ":blue"), s7_make_integer(sc, 2))));
+    if (val != 66)
+      fprintf(stderr, "%d: plus: %" ld64 "\n", __LINE__, val);
+    val = s7_integer(s7_apply_function_star(sc, s7_name_to_value(sc, "plus"),
+					    s7_list(sc, 2, s7_make_symbol(sc, "blue:"), s7_make_integer(sc, 2))));
+    if (val != 66)
+      fprintf(stderr, "%d: plus: %" ld64 "\n", __LINE__, val);
+  }
+
+  s7_define_function_star(sc, "plus1", plus1, "a b c", "an example of define* from C");
+  {
+    s7_int val;
+    val = s7_integer(s7_apply_function_star(sc, s7_name_to_value(sc, "plus1"),
+					    s7_list(sc, 3,
+						    s7_make_integer(sc, 4),
+						    s7_make_integer(sc, 5),
+						    s7_make_integer(sc, 6))));
+    if (val != 21)
+      fprintf(stderr, "plus1: %" ld64 "\n", val);
+
+    p = s7_make_c_object_without_gc(sc, dax_type_tag, perm2 = (void *)malloc(sizeof(dax)));
+    {
+      dax *o;
+      o = (dax *)malloc(sizeof(dax));
+      o->x = 1.0;
+      o->data = s7_nil(sc);
+      p = s7_make_c_object_with_let(sc, dax_type_tag, (void *)o, s7_sublet(sc, s7_curlet(sc), s7_nil(sc)));
+    }
+  }
+
+  {
+    s7_pointer old_port, val;
+    const char *doc;
+    old_port = s7_current_error_port(sc);
+
+    s7_define_function_star(sc, "fs1", fs1, "(opts (inlet 'f \"b\"))", NULL);
+    p = s7_make_symbol(sc, "fs1");
+    s7_set_documentation(sc, p, "new doc");
+    doc = s7_documentation(sc, p);
+    if ((!doc) || (strcmp(s7_documentation(sc, p), "new doc") != 0))
+      fprintf(stderr, "%d: s7_set_documentation: %s\n", __LINE__, s7_documentation(sc, p));
+    s7_define_typed_function_star(sc, "fs2", fs2, "", NULL, s7_make_signature(sc, 1, s7_t(sc)));
+    if (s7_car(s7_signature(sc, s7_name_to_value(sc, "fs2"))) != s7_t(sc))
+      {fprintf(stderr, "%d: fs2 signature: %s\n", __LINE__, s1 = TO_STR(s7_signature(sc, s7_name_to_value(sc, "fs2")))); free(s1);}
+    s7_set_current_error_port(sc, s7_f(sc));
+    s7_define_function_star(sc, "fs3", fs3, ":allow-other-keys", NULL);
+    s7_set_current_error_port(sc, old_port);
+    s7_define_function_star(sc, "fs31", fs31, "(a 32) :allow-other-keys", NULL);
+
+    s7_define_safe_function_star(sc, "fs4", fs4, "(opts (inlet 'f \"b\"))", NULL);
+    s7_define_safe_function_star(sc, "fs5", fs5, "", NULL);
+    s7_set_current_error_port(sc, s7_f(sc));
+    s7_define_safe_function_star(sc, "fs6", fs6, ":allow-other-keys", NULL);
+    s7_set_current_error_port(sc, old_port);
+    s7_define_safe_function_star(sc, "fs61", fs61, "(a #(0)) :allow-other-keys", NULL);
+    val = s7_make_function_star(sc, "fs4", fs4, "(opts (inlet 'f \"b\"))", NULL);
+    if (!s7_is_procedure(val)) fprintf(stderr, "%d: fs4 is not a procedure\n", __LINE__);
+    val = s7_make_safe_function_star(sc, "fs4", fs4, "(opts (inlet 'f \"b\"))", NULL);
+    if (!s7_is_procedure(val)) fprintf(stderr, "%d: fs4 is not a (safe) procedure\n", __LINE__);
+
+    val = s7_eval_c_string(sc, "(fs1)");
+    if (!s7_is_let(val)) {fprintf(stderr, "(fs1): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs1 #f)");
+    if (!s7_is_eq(val, s7_f(sc))) {fprintf(stderr, "(fs1 #f): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs2)");
+    if (!s7_is_null(sc, val)) {fprintf(stderr, "(fs2): %s\n", s1 = TO_STR(val)); free(s1);}
+
+    val = s7_eval_c_string(sc, "(fs31)");
+    if (s7_integer(val) != 32) {fprintf(stderr, "(fs31): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs31 32)");
+    if (s7_integer(val) != 32) {fprintf(stderr, "(fs31 32): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs31 :a 31)");
+    if (s7_integer(val) != 31) {fprintf(stderr, "(fs31 :a 31): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs31 :ignored #f)");
+    if (s7_integer(val) != 32) {fprintf(stderr, "(fs31 :ignored #f): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs31 :a 30 :ignored #f)");
+    if (s7_integer(val) != 30) {fprintf(stderr, "(fs31 :a 30 :ignored #f): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs31 :ignored #f :a 29)");
+    if (s7_integer(val) != 29) {fprintf(stderr, "(fs31 :ignored #f :a 29): %s\n", s1 = TO_STR(val)); free(s1);}
+
+    val = s7_eval_c_string(sc, "(fs4)");
+    if (!s7_is_let(val)) {fprintf(stderr, "(fs4): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs4 #f)");
+    if (!s7_is_eq(val, s7_f(sc))) {fprintf(stderr, "(fs4 #f): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs5)");
+    if (!s7_is_null(sc, val)) {fprintf(stderr, "(fs5): %s\n", s1 = TO_STR(val)); free(s1);}
+
+    val = s7_eval_c_string(sc, "(fs61)");
+    if (!s7_is_vector(val)) {fprintf(stderr, "(fs61): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs61 32)");
+    if (s7_integer(val) != 32) {fprintf(stderr, "(fs61 32): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs61 :a 31)");
+    if (s7_integer(val) != 31) {fprintf(stderr, "(fs61 :a 31): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs61 :ignored #f)");
+    if (!s7_is_vector(val)) {fprintf(stderr, "(fs61 :ignored #f): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs61 :a 30 :ignored #f)");
+    if (s7_integer(val) != 30) {fprintf(stderr, "(fs61 :a 30 :ignored #f): %s\n", s1 = TO_STR(val)); free(s1);}
+    val = s7_eval_c_string(sc, "(fs61 :ignored #f :a 29)");
+    if (s7_integer(val) != 29) {fprintf(stderr, "(fs61 :ignored #f :a 29): %s\n", s1 = TO_STR(val)); free(s1);}
+  }
+
+  p = s7_apply_function(sc, s7_name_to_value(sc, "plus"), s7_cons(sc, s7_make_keyword(sc, "blue"), s7_cons(sc, TO_S7_INT(2), s7_nil(sc))));
+  if (!s7_is_integer(p))
+    {fprintf(stderr, "%d: %s is not an integer?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_integer(p) != 66)
+    {fprintf(stderr, "%d: %s is not 66?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_define_variable(sc, "my-1", s7_make_integer(sc, 1));
+  p = s7_name_to_value(sc, "my-1");
+  if (!s7_is_integer(p))
+    {fprintf(stderr, "%d: %s is not an integer?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_integer(p) != 1)
+    {fprintf(stderr, "%d: %s is not 1?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_symbol_set_value(sc, s7_make_symbol(sc, "my-1"), s7_make_integer(sc, 32));
+  p = s7_name_to_value(sc, "my-1");
+  if (s7_integer(p) != 32)
+    {fprintf(stderr, "%d: %s is not 32?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+
+  s7_define_macro(sc, "mac-plus", mac_plus, 2, 0, false, "plus adds its two arguments");
+  p = s7_eval_c_string(sc, "(mac-plus 2 3)");
+  if (s7_integer(p) != 5)
+    {fprintf(stderr, "%d: %s is not 5?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  p1 = s7_apply_function(sc,
+	s7_name_to_value(sc, "mac-plus"),
+	s7_list(sc, 2, s7_make_integer(sc, 3), s7_make_integer(sc, 4)));
+  p = s7_eval(sc, p1, s7_rootlet(sc));
+  if ((!s7_is_integer(p)) ||
+      (s7_integer(p) != 7))
+    {char *s2; fprintf(stderr, "%d: %s -> %s is not 7?\n", __LINE__, s1 = TO_STR(p1), s2 = TO_STR(p)); free(s1); free(s2);}
+
+  s7_define_macro(sc, "mac-plus-mv", mac_plus_mv, 2, 0, false, "macro values test");
+  p = s7_eval_c_string(sc, "(let () (+ (mac-plus-mv 2 3)))");
+  if (s7_integer(p) != 5)
+    {fprintf(stderr, "%d: %s is not 5?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_values(sc, s7_list(sc, 2, s7_make_integer(sc, 1), s7_make_integer(sc, 2)));
+  if (!s7_is_multiple_value(p))
+    {fprintf(stderr, "%d: %s is not a multiple-values object?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  p = s7_values(sc, s7_nil(sc));
+  if ((!s7_is_unspecified(sc, p)) || (p == s7_unspecified(sc)))
+    {fprintf(stderr, "%d: %s is not a no-values object?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  p = s7_values(sc, s7_list(sc, 1, s7_f(sc)));
+  if (s7_is_multiple_value(p))
+    {fprintf(stderr, "%d: %s is a multiple-values object?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_define_semisafe_typed_function(sc, "open-plus", open_plus, 1, 0, true, plus_help, s7_make_circular_signature(sc, 1, 2, s7_make_symbol(sc, "number?"), s7_t(sc)));
+  p = s7_sublet(sc, s7_rootlet(sc), s7_cons(sc, s7_cons(sc, s7_make_symbol(sc, "plus"), s7_name_to_value(sc, "plus")), s7_nil(sc)));
+  s7_openlet(sc, p);
+  p1 = s7_apply_function(sc, s7_name_to_value(sc, "open-plus"), s7_list(sc, 3, p, s7_make_integer(sc, 2), s7_make_integer(sc, 3)));
+  if ((!s7_is_integer(p1)) ||
+      (s7_integer(p1) != 7))
+    {fprintf(stderr, "%d: %s is not 7?\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+
+
+  s7_eval_c_string(sc,  "(define my-vect (make-vector '(2 3 4) 0))");
+  s7_eval_c_string(sc,  "(set! (my-vect 1 1 1) 32)");
+  p1 = s7_name_to_value(sc, "my-vect");
+
+  p = s7_vector_ref_n(sc,  p1, 3, 0LL, 0LL, 0LL);
+  if (s7_integer(p) != 0)
+    {fprintf(stderr, "%d: %s is not 0?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_vector_ref_n(sc,  p1, 3, 0LL, 0LL, 0LL);
+  if (s7_integer(p) != 0)
+    {fprintf(stderr, "%d: %s is not 0?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_vector_ref_n(sc,  p1, 3, 1LL, 1LL, 1LL);
+  if (s7_integer(p) != 32)
+    {fprintf(stderr, "%d: %s is not 32?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  p = s7_vector_ref_n(sc,  p1, 3, 1LL, 1LL, 1LL);
+  if (s7_integer(p) != 32)
+    {fprintf(stderr, "%d: %s is not 32?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s7_vector_set_n(sc,  p1, TO_S7_INT(12), 3, 1LL, 1LL, 2LL);
+  p = s7_vector_ref_n(sc,  p1, 3, 1LL, 1LL, 2LL);
+  if (s7_integer(p) != 12)
+    {fprintf(stderr, "%d: %s is not 12?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  if (s7_vector_length(p1) != 24)
+    {fprintf(stderr, "%d: (length %s) is not 24?\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+  if (s7_vector_rank(p1) != 3)
+    {fprintf(stderr, "%d: (vector-dimensions %s) is not 3?\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+
+  {
+    s7_int *dims, *offs;
+    s7_pointer *els;
+    s7_int ndims;
+
+    ndims = s7_vector_rank(p1);
+    dims = (s7_int *)malloc(ndims * sizeof(s7_int));
+    offs = (s7_int *)malloc(ndims * sizeof(s7_int));
+    s7_vector_dimensions(p1, dims, ndims);
+    s7_vector_offsets(p1, offs, ndims);
+    els = s7_vector_elements(p1);
+
+    if (dims[0] != 2) fprintf(stderr, "%d: dims[0]: %" ld64 "?\n", __LINE__, dims[0]);
+    if (dims[1] != 3) fprintf(stderr, "%d: dims[1]: %" ld64 "?\n", __LINE__, dims[1]);
+    if (dims[2] != 4) fprintf(stderr, "%d: dims[2]: %" ld64 "?\n", __LINE__, dims[2]);
+    if (offs[0] != 12) fprintf(stderr, "%d: offs[0]: %" ld64 "?\n", __LINE__, offs[0]);
+    if (offs[1] != 4) fprintf(stderr, "%d: offs[1]: %" ld64 "?\n", __LINE__, offs[1]);
+    if (s7_integer(p = els[12 + 4 + 1]) != 32)
+      {fprintf(stderr, "%d: %s is not 32?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    free(dims);
+    free(offs);
+  }
+
+  s7_vector_fill(sc, p1, s7_t(sc));
+  p = s7_vector_ref_n(sc,  p1, 3, 1LL, 1LL, 1LL);
+  if (p != s7_t(sc))
+    {fprintf(stderr, "%d: %s is not #t?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+
+  {
+    s7_pointer new_env, old_env;
+    new_env = s7_sublet(sc, old_env = s7_curlet(sc), s7_nil(sc));
+    gc_loc = s7_gc_protect(sc, new_env);
+
+    s7_define(sc, new_env, s7_make_symbol(sc, "var1"), s7_make_integer(sc, 32));
+
+    if (new_env == s7_curlet(sc))
+      {fprintf(stderr, "%d: %s is the current env?\n", __LINE__, s1 = TO_STR(new_env)); free(s1);}
+
+    s1 = TO_STR(s7_let_to_list(sc, new_env));
+    if (strcmp(s1, "((var1 . 32))") != 0)
+      {fprintf(stderr, "%d: new-env is %s?\n", __LINE__, s1);}
+    free(s1);
+
+    p = s7_let_ref(sc, new_env, s7_make_symbol(sc, "var1"));
+    if (s7_integer(p) != 32)
+      {fprintf(stderr, "%d: %s is not 32?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    s7_let_set(sc, new_env, s7_make_symbol(sc, "var1"), TO_S7_INT(3));
+    p = s7_let_ref(sc, new_env, s7_make_symbol(sc, "var1"));
+    if (s7_integer(p) != 3)
+      {fprintf(stderr, "%d: %s is not 3?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    s7_set_curlet(sc, new_env);
+    p = s7_slot(sc, s7_make_symbol(sc, "var1"));
+    if (s7_integer(s7_slot_value(p)) != 3)
+      {fprintf(stderr, "%d: slot-value %s is not 3?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    s7_slot_set_value(sc, p, s7_f(sc));
+    p = s7_let_ref(sc, new_env, s7_make_symbol(sc, "var1"));
+    if (p != s7_f(sc))
+      {fprintf(stderr, "%d: set slot-value %s is not #f?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    if ((s7_outlet(sc, new_env) != old_env) && (old_env != s7_nil(sc)))
+      {fprintf(stderr, "%d: outer-env %s?\n", __LINE__, s1 = TO_STR(old_env)); free(s1);}
+
+    s7_make_slot(sc, new_env, s7_make_symbol(sc, "var2"), TO_S7_INT(-1));
+    p = s7_let_ref(sc, new_env, s7_make_symbol(sc, "var2"));
+    if (s7_integer(p) != -1)
+      {fprintf(stderr, "%d: make_slot %s is not -1?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    s7_symbol_set_value(sc, s7_make_symbol(sc, "var2"), s7_t(sc));
+    p = s7_symbol_local_value(sc, s7_make_symbol(sc, "var2"), new_env);
+    if (p != s7_t(sc))
+      {fprintf(stderr, "%d: set symbol-value %s is not #t?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+    p = s7_let_to_list(sc, new_env);
+    {
+      int gloc;
+      gloc = s7_gc_protect(sc, p);
+      s1 = TO_STR(p);
+      if ((strcmp(s1, "((var2 . #t) (var1 . #f))") != 0) && (strcmp(s1, "((var1 . #f) (var2 . #t))") != 0))
+	{fprintf(stderr, "%d: env->list: %s\n", __LINE__, s1);}
+      free(s1);
+      s7_gc_unprotect_at(sc, gloc);
+    }
+
+    s7_define_constant_with_environment(sc, new_env, "new-env-var", s7_make_integer(sc, 123));
+    if (s7_integer(s7_name_to_value(sc, "new-env-var")) != 123)
+      {fprintf(stderr, "%d: constant: %s\n", __LINE__, s1 = TO_STR(s7_name_to_value(sc, "new-env-var"))); free(s1);}
+
+    s7_set_curlet(sc, old_env);
+    s7_gc_unprotect_at(sc, gc_loc);
+  }
+
+  {
+    s7_pointer e, yp, old_e, arg;
+    e = s7_sublet(sc, s7_curlet(sc), s7_nil(sc));
+    s7_gc_protect_via_stack(sc, e);
+    old_e = s7_set_curlet(sc, e);
+    arg = s7_make_symbol(sc, "arg");
+    yp = s7_make_slot(sc, e, arg, s7_make_mutable_real(sc, 1.0));
+    s7_gc_protect_2_via_stack(sc, yp, old_e);
+    if (s7_real(s7_slot_value(yp)) != 1.0)
+      {fprintf(stderr, "%d: mutable real slot-value %s is not 1.0?\n", __LINE__, s1 = TO_STR(s7_slot_value(yp))); free(s1);}
+    s7_slot_set_real_value(sc, yp, 2.0);
+    if (s7_real(s7_slot_value(yp)) != 2.0)
+      {fprintf(stderr, "%d: mutable real slot-value %s is not 2.0?\n", __LINE__, s1 = TO_STR(s7_slot_value(yp))); free(s1);}
+    s7_varlet(sc, e, s7_make_symbol(sc, "new-var"), s7_make_integer(sc, 123));
+    if (s7_integer(s7_name_to_value(sc, "new-var")) != 123)
+      {fprintf(stderr, "%d: new-var: %s\n", __LINE__, s1 = TO_STR(s7_name_to_value(sc, "new-var"))); free(s1);}
+    s7_set_curlet(sc, old_e);
+    s7_gc_unprotect_via_stack(sc, e);
+  }
+
+  if (!s7_is_list(sc, p = s7_load_path(sc)))
+    {fprintf(stderr, "%d: %s is not a list?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  s7_add_to_load_path(sc, "/home/bil/");
+  if (!s7_is_pair(s7_member(sc, s7_make_string(sc, "/home/bil/"), s7_load_path(sc))))
+    {fprintf(stderr, "/home/bil/ not in *load-path*: %s\n", s1 = TO_STR(s7_load_path(sc))); free(s1);}
+
+  {
+    s7_pointer port;
+    port = s7_open_output_file(sc, "ffitest.scm", "w");
+
+    if (!s7_is_output_port(sc, port))
+      {fprintf(stderr, "%d: %s is not an output port?\n", __LINE__, s1 = TO_STR(port)); free(s1);}
+    else
+      {
+	/* (define loaded_var 321) hopefully */
+	gc_loc = s7_gc_protect(sc, port);
+	s7_write_char(sc, s7_make_character(sc, (uint8_t)'('), port);
+	s7_write(sc, s7_make_symbol(sc, "define"), port);
+	s7_write_char(sc, s7_make_character(sc, (uint8_t)' '), port);
+	s7_display(sc, s7_make_symbol(sc, "loaded_var"), port);
+	s7_write_char(sc, s7_make_character(sc, (uint8_t)' '), port);
+	s7_format(sc, s7_list(sc, 3, port, s7_make_string(sc, "~A)"), TO_S7_INT(321)));
+	s7_newline(sc, port);
+	s7_flush_output_port(sc, port);
+	s7_close_output_port(sc, port);
+	s7_gc_unprotect_at(sc, gc_loc);
+
+	s7_load(sc, "ffitest.scm");
+	if (!s7_is_defined(sc, "loaded_var"))
+	  {fprintf(stderr, "%d: load ffitest.scm unhappy?\n", __LINE__);}
+	else
+	  {
+	    if (s7_integer(p = s7_name_to_value(sc, "loaded_var")) != 321)
+	      {fprintf(stderr, "%d: %s is not 321?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+	    port = s7_open_input_file(sc, "ffitest.scm", "r");
+	    if (!s7_is_input_port(sc, port))
+	      {fprintf(stderr, "%d: %s is not an input port?\n", __LINE__, s1 = TO_STR(port)); free(s1);}
+	    else
+	      {
+		uint8_t c;
+		const char *filename;
+		gc_loc = s7_gc_protect(sc, port);
+		c = s7_character(s7_peek_char(sc, port));
+		if (c != (int)'(')
+		  {fprintf(stderr, "%d: peek-char sees %c?\n", __LINE__, (unsigned char)c);}
+
+		c = s7_character(s7_read_char(sc, port));
+		if (c != (uint8_t)'(')
+		  {fprintf(stderr, "%d: read-char sees %c?\n", __LINE__, (unsigned char)c);}
+
+		filename = s7_port_filename(sc, port);
+		if (strcmp(filename, "ffitest.scm") != 0)
+		  fprintf(stderr, "%d: s7_port_filename: %s\n", __LINE__, filename);
+
+		s7_close_input_port(sc, port);
+		s7_gc_unprotect_at(sc, gc_loc);
+
+		port = s7_open_input_file(sc, "ffitest.scm", "r");
+		gc_loc = s7_gc_protect(sc, port);
+
+		p = s7_read(sc, port);
+		s1 = TO_STR(p);
+		if (strcmp(s1, "(define loaded_var 321)") != 0)
+		  {fprintf(stderr, "%d: read file sees %s?\n", __LINE__, s1);}
+		free(s1);
+
+		s7_close_input_port(sc, port);
+		s7_gc_unprotect_at(sc, gc_loc);
+	      }
+	  }
+      }
+
+    {
+      s7_pointer e, val;
+      e = s7_inlet(sc, s7_nil(sc));
+      gc_loc = s7_gc_protect(sc, e);
+      val = s7_load_with_environment(sc, "~/ffitest.scm", e);
+      if (val)
+	fprintf(stderr, "%d: load ~/ffitest.scm found!?\n", __LINE__);
+      val = s7_load_with_environment(sc, "~/cl/ffitest.scm", e);
+      if (!val)
+	fprintf(stderr, "%d: load ~/cl/ffitest.scm not found\n", __LINE__);
+      else
+	{
+	  if (s7_symbol_local_value(sc, s7_make_symbol(sc, "loaded_var"), e) == s7_undefined(sc))
+	    {fprintf(stderr, "%d: load ~/ffitest.scm unhappy? %s\n", __LINE__, s1 = TO_STR(e)); free(s1);}
+	}
+      val = s7_load(sc, "/home/bil/snd-motif/");
+      if (val)
+	fprintf(stderr, "s7_load(directory) did not fail?\n");
+      s7_gc_unprotect_at(sc, gc_loc);
+    }
+
+    {
+      s7_pointer e;
+      unsigned char another_var[] = {0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x61, 0x6e, 0x6f, 0x74, /* (define another-var 123)\n */
+				     0x68, 0x65, 0x72, 0x2d, 0x76, 0x61, 0x72, 0x20, 0x31, 0x32, 0x33, 0x29,
+				     0x0a, 0};
+      unsigned int another_var_len = 25;
+      unsigned char yet_another_var[] = {0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x79, 0x65, 0x74, 0x2d, /* (define yet-another-var 123)\n */
+					 0x61, 0x6e, 0x6f, 0x74, 0x68, 0x65, 0x72, 0x2d, 0x76, 0x61, 0x72, 0x20,
+					 0x31, 0x32, 0x33, 0x29, 0x0a, 0};
+      unsigned int yet_another_var_len = 29;
+      unsigned char a_global_var[] = {0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x61, 0x2d, 0x67, 0x6c, /* (define a_global_var 321)\n */
+				      0x6f, 0x62, 0x61, 0x6c, 0x2d, 0x76, 0x61, 0x72, 0x20, 0x33, 0x32, 0x31,
+				      0x29, 0x0a, 0};
+      unsigned int a_global_var_len = 26;
+
+      unsigned char a_test_var[] = {0x28, 0x64, 0x65, 0x66, 0x69, 0x6e, 0x65, 0x20, 0x61, 0x2d, 0x74, 0x65,
+				    0x73, 0x74, 0x2d, 0x76, 0x61, 0x72, 0x20, 0x33, 0x32, 0x31, 0x29, 0x0a, 0};
+      unsigned int a_test_var_len = 24;
+
+      s7_load_c_string(sc, (const char *)another_var, another_var_len);
+      p = s7_symbol_value(sc, s7_make_symbol(sc, "another-var"));
+      if (s7_integer(p) != 123)
+	{fprintf(stderr, "load_c_string: %s\n", s1 = TO_STR(p)); free(s1);}
+
+      e = s7_inlet(sc, s7_nil(sc));
+      gc_loc = s7_gc_protect(sc, e);
+      s7_load_c_string_with_environment(sc, (const char *)yet_another_var, yet_another_var_len, e);
+      p = s7_symbol_local_value(sc, s7_make_symbol(sc, "yet-another-var"), e);
+      if (s7_integer(p) != 123)
+	{fprintf(stderr, "load_c_string_with_environment: %s\n", s1 = TO_STR(p)); free(s1);}
+      s7_gc_unprotect_at(sc, gc_loc);
+
+      s7_load_c_string_with_environment(sc, (const char *)a_global_var, a_global_var_len, s7_nil(sc));
+      p = s7_symbol_value(sc, s7_make_symbol(sc, "a-global-var"));
+      if (s7_integer(p) != 321)
+	{fprintf(stderr, "load_c_string_with_environment nil: %s\n", s1 = TO_STR(p)); free(s1);}
+
+      s7_load_c_string_with_environment(sc, (const char *)a_test_var, a_test_var_len, s7_rootlet(sc));
+      p = s7_symbol_value(sc, s7_make_symbol(sc, "a-test-var"));
+      if (s7_integer(p) != 321)
+	{fprintf(stderr, "load_c_string_with_environment rootlet: %s\n", s1 = TO_STR(p)); free(s1);}
+
+      s7_load_with_environment(sc, "~/cl/ffitest.scm", s7_rootlet(sc));  /* rootlet=segfault 10-Jul-21 */
+    }
+
+    port = s7_open_input_string(sc, "(+ 1 2)");
+    if (!s7_is_input_port(sc, port))
+      {fprintf(stderr, "%d: %s is not an input port?\n", __LINE__, s1 = TO_STR(port)); free(s1);}
+    gc_loc = s7_gc_protect(sc, port);
+    p = s7_read(sc, port);
+    s1 = TO_STR(p);
+    if (strcmp(s1, "(+ 1 2)") != 0)
+      {fprintf(stderr, "%d: read string sees %s?\n", __LINE__, s1);}
+    free(s1);
+    s7_close_input_port(sc, port);
+    s7_gc_unprotect_at(sc, gc_loc);
+
+    /* make sure s7_read does not ignore #<eof> */
+    port = s7_open_input_string(sc, "(define aaa 32)\n(define bbb 33)\n");
+    if (!s7_is_input_port(sc, port))
+      {fprintf(stderr, "%d: %s is not an input port?\n", __LINE__, s1 = TO_STR(port)); free(s1);}
+    gc_loc = s7_gc_protect(sc, port);
+    while(true)
+      {
+	s7_pointer code;
+	code = s7_read(sc, port);
+	if (code == s7_eof_object(sc)) break;
+	s7_eval(sc, code, s7_nil(sc));
+      }
+    s7_close_input_port(sc, port);
+    s7_gc_unprotect_at(sc, gc_loc);
+
+    port = s7_open_input_string(sc, "(define ccc 34)\n(define ddd 35)");
+    if (!s7_is_input_port(sc, port))
+      {fprintf(stderr, "%d: %s is not an input port?\n", __LINE__, s1 = TO_STR(port)); free(s1);}
+    gc_loc = s7_gc_protect(sc, port);
+    while(true)
+      {
+	s7_pointer code;
+	code = s7_read(sc, port);
+	if (code == s7_eof_object(sc)) break;
+	s7_eval(sc, code, s7_nil(sc));
+      }
+    s7_close_input_port(sc, port);
+    s7_gc_unprotect_at(sc, gc_loc);
+    {
+      s7_pointer val;
+      val = s7_name_to_value(sc, "aaa");
+      if ((!s7_is_integer(val)) || (s7_integer(val) != 32))
+	{fprintf(stderr, "aaa: %s\n", s1 = TO_STR(val)); free(s1);}
+      val = s7_name_to_value(sc, "bbb");
+      if ((!s7_is_integer(val)) || (s7_integer(val) != 33))
+	{fprintf(stderr, "bbb: %s\n", s1 = TO_STR(val)); free(s1);}
+      val = s7_name_to_value(sc, "ccc");
+      if ((!s7_is_integer(val)) || (s7_integer(val) != 34))
+	{fprintf(stderr, "ccc: %s\n", s1 = TO_STR(val)); free(s1);}
+      val = s7_name_to_value(sc, "ddd");
+      if ((!s7_is_integer(val)) || (s7_integer(val) != 35))
+	{fprintf(stderr, "ddd: %s\n", s1 = TO_STR(val)); free(s1);}
+    }
+
+    port = s7_open_output_string(sc);
+    if (!s7_is_output_port(sc, port))
+      {fprintf(stderr, "%d: %s is not an output port?\n", __LINE__, s1 = TO_STR(port)); free(s1);}
+    gc_loc = s7_gc_protect(sc, port);
+    s7_display(sc, s7_make_string(sc, "(+ 2 3)"), port);
+    {
+      const char *s2;
+      s7_pointer s3;
+      s2 = s7_get_output_string(sc, port);
+      if (strcmp(s2, "(+ 2 3)") != 0)
+	{fprintf(stderr, "%d: s7_get_output_string returns %s?\n", __LINE__, s2);}
+      s3 = s7_output_string(sc, port);
+      if ((!s7_is_string(s3)) ||
+	  (strcmp(s7_string(s3), "(+ 2 3)") != 0))
+	{fprintf(stderr, "%d: s7_output_string returns %s?\n", __LINE__, s2);}
+    }
+    s7_close_output_port(sc, port);
+    s7_gc_unprotect_at(sc, gc_loc);
+
+    p = s7_set_current_output_port(sc, s7_open_output_function(sc, my_print));
+    p1 = s7_open_input_function(sc, my_read);
+    gc_loc = s7_gc_protect(sc, p1);
+
+    s7_display(sc, s7_make_character(sc, '3'), s7_current_output_port(sc));
+    if (last_c != '3')
+      {fprintf(stderr, "%d: last_c: %c, c: %c\n", __LINE__, last_c, '3');}
+    last_c = s7_character(s7_read_char(sc, p1));
+    if (last_c != '0')
+      {fprintf(stderr, "%d: last_c: %c\n", __LINE__, last_c);}
+    s7_set_current_output_port(sc, p);
+    s7_gc_unprotect_at(sc, gc_loc);
+  }
+
+  {
+    s7_pointer port, val;
+    s7_autoload(sc, s7_make_symbol(sc, "auto_var"), s7_make_string(sc, "ffitest.scm"));
+    port = s7_open_output_file(sc, "ffitest.scm", "w");
+    gc_loc = s7_gc_protect(sc, port);
+    s7_display(sc, s7_make_string(sc, "(define auto_var 123)"), port);
+    s7_newline(sc, port);
+    s7_close_output_port(sc, port);
+    s7_gc_unprotect_at(sc, gc_loc);
+    val = s7_eval_c_string(sc, "(+ auto_var 1)");
+    if ((!s7_is_integer(val)) ||
+	(s7_integer(val) != 124))
+      {fprintf(stderr, "%d: auto_var+1 = %s?\n", __LINE__, s1 = TO_STR(val)); free(s1);}
+    s7_autoload_set_names(sc, snd_names, 8);
+  }
+
+  {
+    s7_pointer test_hook;
+    test_hook = s7_eval_c_string(sc, "(make-hook 'a 'b)");
+    s7_define_constant(sc, "test-hook", test_hook);
+    s7_hook_set_functions(sc, test_hook,
+			  s7_cons(sc, s7_make_function(sc, "test-hook-function", test_hook_function, 1, 0, false, "a test-hook function"),
+				  s7_hook_functions(sc, test_hook)));
+    s7_call(sc, test_hook, s7_list(sc, 2, TO_S7_INT(1), TO_S7_INT(2)));
+    s7_call_with_location(sc, test_hook, s7_list(sc, 2, TO_S7_INT(1), TO_S7_INT(2)), "ffitest", "ffitest.c", __LINE__);
+  }
+
+  {
+    s7_pointer x, kar; /* from s7.h */
+    kar = s7_make_function(sc, "kar", g_car, 1, 0, false, "(car obj)");
+    x = s7_call(sc, kar, s7_cons(sc, s7_cons(sc, s7_make_integer(sc, 123), s7_nil(sc)), s7_nil(sc)));
+    if ((!s7_is_integer(x)) ||
+	(s7_integer(x) != 123))
+      {fprintf(stderr, "s7_call x: %s\n", s1 = TO_STR(x)); free(s1);}
+  }
+
+  {
+    s7_pointer x, y, funcs;
+    funcs = s7_eval_c_string(sc, "(let ((x 0)) (list (lambda () (set! x 1)) (lambda () (set! x (+ x 1))) (lambda () (set! x (+ x 1))) (lambda () x)))");
+    gc_loc = s7_gc_protect(sc, funcs);
+    y = s7_dynamic_wind(sc, s7_car(funcs), s7_cadr(funcs), s7_caddr(funcs));
+    x = s7_call(sc, s7_cadddr(funcs), s7_nil(sc));
+    if ((!s7_is_integer(x)) ||
+	(!s7_is_integer(y)) ||
+	(s7_integer(x) != 3) ||
+	(s7_integer(y) != 2))
+      {fprintf(stderr, "s7_dynamic_wind: x: %s, y: %s\n", s1 = TO_STR(x), s2 = TO_STR(y)); free(s1); free(s2);}
+    y = s7_dynamic_wind(sc, s7_f(sc), s7_car(funcs), s7_cadr(funcs));
+    x = s7_call(sc, s7_cadddr(funcs), s7_nil(sc));
+    if ((!s7_is_integer(x)) ||
+	(!s7_is_integer(y)) ||
+	(s7_integer(x) != 2) ||
+	(s7_integer(y) != 1))
+      {fprintf(stderr, "s7_dynamic_wind (init #f): x: %s, y: %s\n", s1 = TO_STR(x), s2 = TO_STR(y)); free(s1); free(s2);}
+    y = s7_dynamic_wind(sc, s7_f(sc), s7_cadr(funcs), s7_f(sc));
+    x = s7_call(sc, s7_cadddr(funcs), s7_nil(sc));
+    if ((!s7_is_integer(x)) ||
+	(!s7_is_integer(y)) ||
+	(s7_integer(x) != 3) ||
+	(s7_integer(y) != 3))
+      {fprintf(stderr, "s7_dynamic_wind (init #f, finish #f): x: %s, y: %s\n", s1 = TO_STR(x), s2 = TO_STR(y)); free(s1); free(s2);}
+    y = s7_dynamic_wind(sc, s7_cadr(funcs), s7_cadr(funcs), s7_f(sc));
+    x = s7_call(sc, s7_cadddr(funcs), s7_nil(sc));
+    if ((!s7_is_integer(x)) ||
+	(!s7_is_integer(y)) ||
+	(s7_integer(x) != 5) ||
+	(s7_integer(y) != 5))
+      {fprintf(stderr, "s7_dynamic_wind (finish #f): x: %s, y: %s\n", s1 = TO_STR(x), s2 = TO_STR(y)); free(s1); free(s2);}
+    s7_gc_unprotect_at(sc, gc_loc);
+  }
+
+  if (s7_begin_hook(sc))
+    {fprintf(stderr, "%d: begin_hook is not null?\n", __LINE__);}
+  tested_begin_hook = false;
+  s7_set_begin_hook(sc, test_begin_hook);
+  s7_eval_c_string(sc, "(begin #f (+ 1 2))");
+  if (!tested_begin_hook)
+    {fprintf(stderr, "%d: begin_hook not called?\n", __LINE__);}
+  if (s7_begin_hook(sc) != test_begin_hook)
+    {fprintf(stderr, "%d: begin_hook was not set?\n", __LINE__);}
+  s7_set_begin_hook(sc, NULL);
+
+
+  p1 = s7_name_to_value(sc, "abs");
+  if (!s7_is_procedure(p1))
+    {fprintf(stderr, "%d: (procedure? abs) = #f?\n", __LINE__);}
+  if (s7_is_macro(sc, p1))
+    {fprintf(stderr, "%d: (macro? abs) = #t?\n", __LINE__);}
+
+  if (!s7_is_aritable(sc, p1, 1))
+    {fprintf(stderr, "%d: (aritable? abs 1) = #f?\n", __LINE__);}
+  if (s7_is_aritable(sc, p1, 2))
+    {fprintf(stderr, "%d: (aritable? abs 2) = #t?\n", __LINE__);}
+  p = s7_arity(sc, p1);
+  if ((!s7_is_pair(p)) || (s7_integer(s7_car(p)) != 1) || (s7_integer(s7_cdr(p)) != 1))
+    {fprintf(stderr, "%d: (arity abs) = %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_is_proper_list(sc, p))
+    fprintf(stderr, "%d: arity is a proper-list?\n", __LINE__);
+
+  p = s7_funclet(sc, p1);
+  if (p != s7_rootlet(sc))
+    {fprintf(stderr, "%d: (funclet abs) = %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  {
+    const char *s3;
+    s3 = s7_documentation(sc, p1);
+    if (strcmp(s3, "(abs x) returns the absolute value of the real number x") != 0)
+      {fprintf(stderr, "%d: (documentation abs) = %s?\n", __LINE__, s3);}
+
+    s3 = s7_help(sc, p1);
+    if (strcmp(s3, "(abs x) returns the absolute value of the real number x") != 0)
+      {fprintf(stderr, "%d: (help abs) = %s?\n", __LINE__, s3);}
+
+    s3 = s7_documentation(sc, s7_make_symbol(sc, "abs"));
+    if (strcmp(s3, "(abs x) returns the absolute value of the real number x") != 0)
+      {fprintf(stderr, "%d: (documentation 'abs) = %s?\n", __LINE__, s3);}
+  }
+
+  p = s7_eval_c_string(sc, "(lambda (a b . c) (+ a b (apply * c)))");
+  gc_loc = s7_gc_protect(sc, p);
+
+  if (!s7_is_procedure(p))
+    {fprintf(stderr, "%d: %s is not a procedure?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+  s1 = TO_STR(s7_closure_body(sc, p));
+  if (strcmp(s1, "((+ a b (apply * c)))") != 0)
+    {fprintf(stderr, "%d: s7_closure_body is %s?\n", __LINE__, s1);}
+  free(s1);
+
+  s1 = TO_STR(s7_closure_args(sc, p));
+  if (strcmp(s1, "(a b . c)") != 0)
+    {fprintf(stderr, "%d: s7_closure_args is %s?\n", __LINE__, s1);}
+  free(s1);
+
+  s1 = TO_STR(s7_closure_let(sc, p));
+  if (strcmp(s1, "(rootlet)") != 0)
+    {fprintf(stderr, "%d: s7_closure_let is %s?\n", __LINE__, s1);}
+  free(s1);
+
+  if (s7_closure_body(sc, s7_name_to_value(sc, "abs")) != s7_nil(sc))
+    fprintf(stderr, "closure_body(abs) is not nil?\n");
+  if (s7_closure_args(sc, s7_name_to_value(sc, "abs"))  != s7_nil(sc))
+    fprintf(stderr, "closure_args(abs) is not nil?\n");
+  if (s7_closure_let(sc, s7_name_to_value(sc, "abs"))  != s7_rootlet(sc))
+    fprintf(stderr, "closure_let(abs) is not rootlet?\n");
+
+  if (!s7_is_aritable(sc, p, 2))
+    {fprintf(stderr, "%d: aritable? lambda 2 = #f?\n", __LINE__);}
+  if (s7_is_aritable(sc, p, 1))
+    {fprintf(stderr, "%d: aritable? lambda 1 = #t?\n", __LINE__);}
+
+  s7_gc_unprotect_at(sc, gc_loc);
+
+  {
+    /* iterators */
+    s7_pointer iter, hash, x;
+    s7_int gc1, gc2;
+
+    /* iterate over list */
+    iter = s7_make_iterator(sc, s7_list(sc, 3, TO_S7_INT(1), TO_S7_INT(2), TO_S7_INT(3)));
+    if (!s7_is_iterator(iter))
+      {fprintf(stderr, "%d: %s is not an iterator\n", __LINE__, s1 = TO_STR(iter)); free(s1);}
+    if (s7_iterator_is_at_end(sc, iter))
+      {fprintf(stderr, "%d: %s is prematurely done\n", __LINE__, s1 = TO_STR(iter)); free(s1);}
+    x = s7_iterate(sc, iter);
+    if ((!s7_is_integer(x)) || (s7_integer(x) != 1))
+      {fprintf(stderr, "%d: %s should be 1\n", __LINE__, s1 = TO_STR(x)); free(s1);}
+    x = s7_iterate(sc, iter);
+    if ((!s7_is_integer(x)) || (s7_integer(x) != 2))
+      {fprintf(stderr, "%d: %s should be 2\n", __LINE__, s1 = TO_STR(x)); free(s1);}
+    x = s7_iterate(sc, iter);
+    if ((!s7_is_integer(x)) || (s7_integer(x) != 3))
+      {fprintf(stderr, "%d: %s should be 3\n", __LINE__, s1 = TO_STR(x)); free(s1);}
+    x = s7_iterate(sc, iter);
+    if ((x != s7_eof_object(sc)) || (!s7_iterator_is_at_end(sc, iter)))
+      {fprintf(stderr, "%d: %s should be #<eof> and iter should be done\n", __LINE__, s1 = TO_STR(x)); free(s1);}
+
+    /* iterate over hash table */
+    hash = s7_make_hash_table(sc, 8);
+    gc1 = s7_gc_protect(sc, hash);
+    s7_hash_table_set(sc, hash, s7_make_symbol(sc, "a"), s7_make_integer(sc, 1));
+    s7_hash_table_set(sc, hash, s7_make_symbol(sc, "b"), s7_make_integer(sc, 2));
+    iter = s7_make_iterator(sc, hash);
+    gc2 = s7_gc_protect(sc, iter);
+    x = s7_iterate(sc, iter);
+    if (!s7_is_pair(x))
+      {fprintf(stderr, "x: %s\n", s1 = TO_STR(x)); free(s1);}
+    x = s7_iterate(sc, iter);
+    if (!s7_is_pair(x))
+      {fprintf(stderr, "x: %s\n", s1 = TO_STR(x)); free(s1);}
+    x = s7_iterate(sc, iter);
+    if (!s7_is_eq(s7_eof_object(sc), x))
+      {fprintf(stderr, "x: %s\n", s1 = TO_STR(x)); free(s1);}
+    s7_gc_unprotect_at(sc, gc1);
+    s7_gc_unprotect_at(sc, gc2);
+  }
+
+  g_block_type = s7_make_c_type(sc, "<block>");
+  s7_c_type_set_free(sc, g_block_type, g_block_free);
+  s7_c_type_set_equal(sc, g_block_type, g_blocks_are_eql);
+  s7_c_type_set_is_equal(sc, g_block_type, g_blocks_are_equal);
+  s7_c_type_set_is_equivalent(sc, g_block_type, g_blocks_are_equivalent);
+  s7_c_type_set_mark(sc, g_block_type, g_block_mark);
+  s7_c_type_set_ref(sc, g_block_type, g_block_ref);
+  s7_c_type_set_set(sc, g_block_type, g_block_set);
+  s7_c_type_set_length(sc, g_block_type, g_block_length);
+  s7_c_type_set_copy(sc, g_block_type, g_block_copy);
+  s7_c_type_set_reverse(sc, g_block_type, g_block_reverse);
+  s7_c_type_set_fill(sc, g_block_type, g_block_fill);
+  s7_c_type_set_to_string(sc, g_block_type, g_block_to_string);
+
+  s7_define_function(sc, "make-block", g_make_block, 1, 0, false, g_make_block_help);
+  s7_define_function(sc, "block", g_to_block, 0, 0, true, g_block_help);
+
+  g_block_methods = s7_eval_c_string(sc, "(inlet (cons 'vector? (lambda (p) #t)))");
+  s7_gc_protect(sc, g_block_methods);
+
+  {
+    g_block *g;
+    s7_pointer gp;
+
+    gp = g_make_block(sc, s7_list(sc, 1, TO_S7_INT(32)));
+    gc_loc = s7_gc_protect(sc, gp);
+    if (!s7_is_c_object(gp))
+      {fprintf(stderr, "%d: g_block %s is not a c_object?\n", __LINE__, s1 = TO_STR(gp)); free(s1);}
+    g = (g_block *)s7_c_object_value(gp);
+    if (s7_c_object_type(gp) != g_block_type)
+      {fprintf(stderr, "%d: g_block types: %" ld64 " %" ld64 "\n", __LINE__, g_block_type, s7_c_object_type(gp));}
+    if (s7_c_object_value_checked(gp, g_block_type) != g)
+      {fprintf(stderr, "%d: checked g_block types: %" ld64 " %" ld64 "\n", __LINE__, g_block_type, s7_c_object_type(gp));}
+    if (s7_c_object_let(gp) != g_block_methods)
+      fprintf(stderr, "%d: s7_c_object_let trouble\n", __LINE__);
+    s7_gc_unprotect_at(sc, gc_loc);
+  }
+
+  {
+    s7_pointer old_port;
+    const char *errmsg = NULL;
+
+    old_port = s7_set_current_error_port(sc, s7_open_output_string(sc));
+    gc_loc = s7_gc_protect(sc, old_port);
+
+    s7_eval_c_string(sc, "(+ 1 #\\c)");
+    errmsg = s7_get_output_string(sc, s7_current_error_port(sc));
+    if (!errmsg)
+      fprintf(stderr, "%d: no error!\n", __LINE__);
+
+    s7_close_output_port(sc, s7_current_error_port(sc));
+    s7_set_current_error_port(sc, old_port);
+    s7_gc_unprotect_at(sc, gc_loc);
+  }
+
+  {
+    int gc_loc1;
+    s7_pointer old_port, result, func;
+    const char *errmsg = NULL;
+
+    s7_define_unsafe_typed_function(sc, "error-handler", test_error_handler, 1, 0, false, "our error handler", s7_make_signature(sc, 2, s7_t(sc), s7_t(sc)));
+
+    s7_eval_c_string(sc, "(set! (hook-functions *error-hook*)                                 \n\
+                            (list (lambda (hook)                                              \n\
+                                    (error-handler                                            \n\
+				     (string-append \"hook: \" (apply format #f (hook 'data)))) \n\
+                                    (set! (hook 'result) 'our-error))))");
+
+    old_port = s7_set_current_error_port(sc, s7_open_output_string(sc));
+    gc_loc = s7_gc_protect(sc, old_port);
+
+    result = s7_eval_c_string(sc, "(+ 1 #\\c)");
+    if (result != s7_make_symbol(sc, "our-error"))
+      {fprintf(stderr, "%d: error hook result: %s\n", __LINE__, s1 = TO_STR(result)); free(s1);}
+    errmsg = s7_get_output_string(sc, s7_current_error_port(sc));
+    if ((errmsg) && (*errmsg))
+      {
+	if (strcmp(errmsg, "error!") != 0)
+	  fprintf(stderr, "%d: error: %s\n", __LINE__, errmsg);
+      }
+    else fprintf(stderr, "%d: no error!\n", __LINE__);
+
+    s7_close_output_port(sc, s7_current_error_port(sc));
+    s7_set_current_error_port(sc, old_port);
+    s7_gc_unprotect_at(sc, gc_loc);
+
+
+    old_port = s7_set_current_error_port(sc, s7_open_output_string(sc));
+    gc_loc = s7_gc_protect(sc, old_port);
+
+    func = s7_eval_c_string(sc, "(lambda (x) (+ x 1))");
+    result = s7_call(sc, func, s7_list(sc, 1, s7_make_integer(sc, 2)));
+    if ((!s7_is_integer(result)) || (s7_integer(result) != 3))
+      {fprintf(stderr, "%d: s7_call (x+1) result: %s\n", __LINE__, s1 = TO_STR(result)); free(s1);}
+
+    result = s7_call(sc, func, s7_list(sc, 1, s7_make_vector(sc, 0)));
+    if (result != s7_make_symbol(sc, "our-error"))
+      {fprintf(stderr, "%d: s7_call error hook result: %s\n", __LINE__, s1 = TO_STR(result)); free(s1);}
+    errmsg = s7_get_output_string(sc, s7_current_error_port(sc));
+    if ((errmsg) && (*errmsg))
+      {
+	if (strcmp(errmsg, "error!") != 0)
+	  fprintf(stderr, "%d: error: %s\n", __LINE__, errmsg);
+      }
+    else fprintf(stderr, "%d: no error!\n", __LINE__);
+
+    s7_close_output_port(sc, s7_current_error_port(sc));
+    s7_set_current_error_port(sc, old_port);
+    s7_gc_unprotect_at(sc, gc_loc);
+
+
+    old_port = s7_set_current_error_port(sc, s7_open_output_string(sc));
+    gc_loc = s7_gc_protect(sc, old_port);
+
+    func = s7_eval_c_string(sc, "(let ((x 0)) (list (lambda () (set! x 1)) (lambda () (set! x (+ x #()))) (lambda () (set! x (+ x 1))) (lambda () x)))");
+    gc_loc1 = s7_gc_protect(sc, func);
+    result = s7_dynamic_wind(sc, s7_car(func), s7_cadr(func), s7_caddr(func));
+
+    if (result != s7_make_symbol(sc, "our-error"))
+      {fprintf(stderr, "%d: s7_dynamic_wind error hook result: %s\n", __LINE__, s1 = TO_STR(result)); free(s1);}
+    errmsg = s7_get_output_string(sc, s7_current_error_port(sc));
+    if ((errmsg) && (*errmsg))
+      {
+	if (strcmp(errmsg, "error!") != 0)
+	  fprintf(stderr, "%d: error: %s\n", __LINE__, errmsg);
+      }
+    else fprintf(stderr, "%d: no error!\n", __LINE__);
+
+    s7_close_output_port(sc, s7_current_error_port(sc));
+    s7_set_current_error_port(sc, old_port);
+    s7_gc_unprotect_at(sc, gc_loc);
+    s7_gc_unprotect_at(sc, gc_loc1);
+
+
+    s7_eval_c_string(sc, "(set! (hook-functions *error-hook*) ())");
+  }
+
+#if WITH_GMP
+  s7_define_function(sc, "add-1", big_add_1, 1, 0, false, "(add-1 num) adds 1 to num");
+  p = s7_eval_c_string(sc, "(add-1 (*s7* 'most-positive-fixnum))");
+  if ((!s7_is_bignum(p)) || (!s7_is_big_integer(p))) {fprintf(stderr, "add-1: %s\n", s1 = TO_STR(p)); free(s1);}
+  {
+    mpz_t val, val1;
+    mpz_init_set(val, *s7_big_integer(p));
+    mpz_init(val1);
+    mpz_set_si(val1, s7_integer(s7_starlet_ref(sc, s7_make_symbol(sc, "most-positive-fixnum"))));
+    mpz_add_ui(val1, val1, 1);
+    if (mpz_cmp(val, val1) != 0) {fprintf(stderr, "add-1: %s\n", s1 = TO_STR(p)); free(s1);}
+    mpz_clear(val);
+    mpz_clear(val1);
+  }
+#endif
+
+  s7_define_function(sc, "notify-C", scheme_set_notification, 2, 0, false, "called if notified-var is set!");
+  s7_define_variable(sc, "notified-var", s7_make_integer(sc, 0));
+  s7_set_setter(sc, s7_make_symbol(sc, "notified-var"), s7_name_to_value(sc, "notify-C"));
+  s7_eval_c_string(sc, "(set! notified-var 32)");
+  p = s7_name_to_value(sc, "notified-var");
+  if (s7_integer(p) != 32)
+    {fprintf(stderr, "%d: sym set: %s\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+  if (s7_integer(set_val) != 32)
+    {fprintf(stderr, "%d: sym val: %s\n", __LINE__, s1 = TO_STR(set_val)); free(s1);}
+  if (set_sym != s7_make_symbol(sc, "notified-var"))
+    {fprintf(stderr, "%d: sym: %s\n", __LINE__, s1 = TO_STR(set_sym)); free(s1);}
+
+  {
+    s7_pointer e, val;
+    e = s7_inlet(sc, s7_list(sc, 2, s7_make_symbol(sc, "init_func"), s7_make_symbol(sc, "block_init")));
+    gc_loc = s7_gc_protect(sc, e);
+    val = s7_load_with_environment(sc, "s7test-block.so", e);
+    if (!val)
+      fprintf(stderr, "can't load s7test-block.so\n");
+    s7_gc_unprotect_at(sc, gc_loc);
+  }
+
+  {
+    s7_pointer body, err, result;
+    s7_int gc_body, gc_err;
+    body = s7_eval_c_string(sc, "(lambda () (+ 1 2))");
+    gc_body = s7_gc_protect(sc, body);
+    err = s7_eval_c_string(sc, "(lambda (type info) 'oops)");
+    gc_err = s7_gc_protect(sc, err);
+    result = s7_call_with_catch(sc, s7_t(sc), body, err);                                                     /* Ln L */
+    if ((!s7_is_integer(result)) || (s7_integer(result) != 3))
+      {fprintf(stderr, "catch (3): %s\n", s1 = TO_STR(result)); free(s1);}
+    s7_gc_unprotect_at(sc, gc_body);
+    s7_gc_unprotect_at(sc, gc_err);
+
+    body = s7_eval_c_string(sc, "(lambda () (+ #f 2))");                                                      /* Le L */
+    gc_body = s7_gc_protect(sc, body);
+    result = s7_call_with_catch(sc, s7_t(sc), body, err);
+    if (result != s7_make_symbol(sc, "oops"))
+      {fprintf(stderr, "catch (oops): %s\n", s1 = TO_STR(result)); free(s1);}
+    s7_gc_unprotect_at(sc, gc_body);
+
+    body = s7_make_function(sc, "my-error", my_error, 0, 0, false, "call s7_error");
+    gc_body = s7_gc_protect(sc, body);
+    result = s7_call_with_catch(sc, s7_t(sc), body, s7_eval_c_string(sc, "(lambda (type info) (car info))")); /* Ce L */
+    if (s7_integer(result) != 60)
+      /* '(60) returned from my_error via its error handler, car(info) -> 60 above */
+      {fprintf(stderr, "%d: catch my_error via car: %s\n", __LINE__, s1 = TO_STR(result)); free(s1);}
+    s7_gc_unprotect_at(sc, gc_body);
+
+    err = s7_make_function(sc, "my-error-handler", my_error_handler, 2, 0, false, "handle error");
+    gc_err = s7_gc_protect(sc, err);
+    result = s7_call_with_catch(sc, s7_t(sc), body, err);                                                     /* Ce C */
+    if (s7_integer(result) != 60)
+      {fprintf(stderr, "%d: catch my_error via my_error_handler: %s\n", __LINE__, s1 = TO_STR(result)); free(s1);}
+
+    body = s7_make_function(sc, "my-no-error", my_no_error, 0, 0, false, "don't call s7_error");
+    gc_body = s7_gc_protect(sc, body);
+    result = s7_call_with_catch(sc, s7_t(sc), body, s7_eval_c_string(sc, "(lambda (type info) (car info))")); /* Cn L */
+    if (s7_integer(result) != 30)
+      {fprintf(stderr, "%d: catch my_no_error: %s\n", __LINE__, s1 = TO_STR(result)); free(s1);}
+
+    result = s7_call_with_catch(sc, s7_t(sc), s7_eval_c_string(sc, "(lambda () (+ #f 2))"), err);
+    if ((!s7_is_string(result)) || (strcmp(s7_string(result), "~A ~:D argument, ~S, is ~A but should be ~A") != 0))
+      {fprintf(stderr, "%d: catch (+ #f 2) via my_error_handler: %s\n", __LINE__, s1 = TO_STR(result)); free(s1);}
+    s7_gc_unprotect_at(sc, gc_err);
+
+    err = s7_make_function(sc, "my-error-handler", my_error_handler, 2, 0, false, "handle error");
+    gc_err = s7_gc_protect(sc, err);
+    result = s7_call_with_catch(sc, s7_t(sc), body, err);                                                     /* Cn C */
+    if (s7_integer(result) != 30)
+      {fprintf(stderr, "%d: catch my_error via my_error_handler: %s\n", __LINE__, s1 = TO_STR(result)); free(s1);}
+    s7_gc_unprotect_at(sc, gc_body);
+
+    body = s7_eval_c_string(sc, "(lambda () (+ 1 2))");
+    gc_body = s7_gc_protect(sc, body);
+    result = s7_call_with_catch(sc, s7_t(sc), body, err);                                                     /* Ln C */
+    if ((!s7_is_integer(result)) || (s7_integer(result) != 3))
+      {fprintf(stderr, "%d: catch (3): %s\n", __LINE__, s1 = TO_STR(result)); free(s1);}
+    s7_gc_unprotect_at(sc, gc_body);
+    s7_gc_unprotect_at(sc, gc_err);
+  }
+
+  {
+    s7_pointer make_func2, catcher2;
+    make_func2 = s7_make_function(sc, "bad-func-define", ter_bad_func, 0, 0, false, NULL);
+    catcher2 = s7_make_function(sc, "error-handler", ter_error_handler, 2, 0, false, NULL);
+    s7_call_with_catch(sc, s7_t(sc), make_func2, catcher2);
+    s7_call_with_catch(sc, s7_t(sc), make_func2, catcher2);
+  }
+
+  {
+    s7_pointer result1, result2;
+    s7_define_function(sc, "bad-func", ter_bad_func, 0, 0, false, NULL);
+    s7_define_function(sc, "error-handler", ter_error_handler, 2, 0, false, NULL);
+    result1 = s7_call_with_catch(sc, s7_t(sc), s7_name_to_value(sc, "bad-func"), s7_name_to_value(sc, "error-handler"));
+    result2 = s7_eval_c_string(sc, "(catch #t bad-func error-handler)");
+    if (result1 != result2)
+      {fprintf(stderr, "%d: %s != %s\n", __LINE__, s1 = TO_STR(result1), s2 = TO_STR(result2)); free(s1); free(s2);}
+  }
+
+  {
+    s7_pointer catcher, make_func1, val;
+    make_func = s7_make_function(sc, "bad", ter_bad_func, 0, 0, false, NULL);
+    catcher = s7_make_function(sc, "catcher", ter_error_handler, 2, 0, false, NULL);
+    make_func1 = s7_make_function(sc, "bad1", ter1_bad_func, 0, 0, false, NULL);
+    catcher1 = s7_make_function(sc, "catcher1", ter1_error_handler, 2, 0, false, NULL);
+    val = s7_call_with_catch(sc, s7_t(sc), make_func, catcher);
+    if (val != s7_f(sc)) {fprintf(stderr, "%d: %s should be #f\n", __LINE__, s1 = TO_STR(val)); free(s1);}
+    val = s7_call_with_catch(sc, s7_t(sc), make_func, catcher);
+    if (val != s7_f(sc)) {fprintf(stderr, "%d: %s should be #f\n", __LINE__, s1 = TO_STR(val)); free(s1);}
+    val = s7_call_with_catch(sc, s7_t(sc), make_func1, catcher1);
+    if (s7_integer(val) != 123) {fprintf(stderr, "%d: %s should be 123\n", __LINE__, s1 = TO_STR(val)); free(s1);}
+    val = s7_call_with_catch(sc, s7_t(sc), make_func1, catcher1);
+    if (s7_integer(val) != 123) {fprintf(stderr, "%d: %s should be 123\n", __LINE__, s1 = TO_STR(val)); free(s1);}
+    val = s7_call_with_catch(sc, s7_t(sc), make_func, catcher);
+    if (val != s7_f(sc)) {fprintf(stderr, "%d: %s should be #f\n", __LINE__, s1 = TO_STR(val)); free(s1);}
+
+    make_func = s7_make_function(sc, "bad2", ter2_bad_func, 0, 0, false, NULL);
+    catcher2 = s7_make_function(sc, "catcher2", ter2_error_handler, 2, 0, false, NULL);
+    val = s7_call_with_catch(sc, s7_t(sc), make_func, catcher2);
+    if (strcmp(s7_string(val), "ter2 argument, (), is nil but should be oops") != 0)
+      fprintf(stderr, "%d: %s is unexpected\n", __LINE__, s7_string(val));
+  }
+
+  {
+    s7_define_function(sc, "wd-test-fn", wd_test_fn, 0, 1, false, "call the inner test");
+    s7_define_function(sc, "wd-inner-test", wd_inner_test, 0, 0, false, "throw");
+    s7_define_function(sc, "wd-inner-test-handler", wd_inner_test_handler, 2, 0, false, "do nothing");
+    s7_eval_c_string(sc, "(wd-test-fn #f)");
+    if (wd_val != 2) fprintf(stderr, "%d: s7_call_with_catch wd_val(1): %d\n", __LINE__, wd_val);
+    s7_eval_c_string(sc, "(catch #t wd-test-fn (lambda (t i) 'oops))");
+    if (wd_val != 2) fprintf(stderr, "%d: s7_call_with_catch wd_val(2): %d\n", __LINE__, wd_val);
+    s7_eval_c_string(sc, "(call-with-exit wd-test-fn)");
+    if (wd_val != 2) fprintf(stderr, "%d: s7_call_with_catch wd_val(3): %d\n", __LINE__, wd_val);
+    s7_define_function(sc, "wd1-test-fn", wd1_test_fn, 1, 0, false, "call the inner test");
+    s7_define_function(sc, "wd1-inner-fn", wd1_inner_fn, 1, 0, false, "call the inner test");
+    s7_eval_c_string(sc, "(wd1-test-fn #f)");
+    if (wd1_val != 2) fprintf(stderr, "%d: s7_call_with_catch wd1_val: %d\n", __LINE__, wd1_val);
+    if (wd2_val != 12) fprintf(stderr, "%d: s7_call_with_catch wd2_val: %d\n", __LINE__, wd2_val);
+  }
+
+  {
+    const char *str;
+    s7_pointer obj;
+    obj = s7_eval_c_string(sc, "'(* 3 (+ 1 2))");
+    gc_loc = s7_gc_protect(sc, obj);
+    str = pretty_print(sc, obj);
+    s7_gc_unprotect_at(sc, gc_loc);
+    if ((!str) || (strcmp(str, "(* 3 (+ 1 2))") != 0))
+      fprintf(stderr, "pretty_print: \"%s\"\n", str);
+  }
+
+  {
+    s7_int size = 256, gc_loc, loc, code;
+    s7_pointer hasher, key, result;
+    hasher = s7_make_and_fill_vector(sc, size, s7_nil(sc));
+    gc_loc = s7_gc_protect(sc, hasher);
+    key = s7_make_integer(sc, 3);
+    code = s7_hash_code(sc, key, s7_f(sc));
+    loc = code % size;
+    s7_vector_set(sc, hasher, loc, s7_cons(sc, s7_cons(sc, key, s7_make_symbol(sc, "abc")), s7_vector_ref(sc, hasher, loc)));
+    result = s7_cdr(s7_assoc(sc, key, s7_vector_ref(sc, hasher, loc)));
+    if (result != s7_make_symbol(sc, "abc"))
+      {fprintf(stderr, "hash-code: %s\n", s1 = TO_STR(result)); free(s1);}
+    s7_gc_unprotect_at(sc, gc_loc);
+  }
+
+  {
+    s7_pointer p;
+    p = s7_random_state(sc, s7_cons(sc, s7_make_integer(sc, 123456), s7_cons(sc, s7_make_integer(sc, 654321), s7_nil(sc))));
+    if (!s7_is_random_state(p))
+      {fprintf(stderr, "%d: s7_random_state returned %s\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+    if (s7_type_of(sc, p) != s7_make_symbol(sc, "random-state?"))
+      {fprintf(stderr, "%d: s7_random_state returned %s\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+#if (!WITH_GMP)
+    {
+      s7_pointer q;
+      q = s7_random_state_to_list(sc, s7_cons(sc, p, s7_nil(sc)));
+      if (!s7_is_pair(q))
+	{fprintf(stderr, "%d: s7_random_state_to_list is %s\n", __LINE__, s1 = TO_STR(q)); free(s1);}
+    }
+#endif
+  }
+
+  {
+    s7_pointer lst;
+    s7_pointer arr[3];
+    lst = s7_list(sc, 3, s7_make_integer(sc, 1), s7_make_integer(sc, 2), s7_make_integer(sc, 3));
+    s7_list_to_array(sc, lst, arr, 3);
+    if (s7_integer(arr[1]) != 2) {fprintf(stderr, "arr[1]: %s\n", s1 = TO_STR(arr[1])); free(s1);}
+  }
+
+  {
+    s7_float_function func;
+    s7_pfunc sfunc;
+    s7_pointer symbol;
+    symbol = s7_define_safe_function(sc, "d-func", g_d_func, 0, 0, false, "d opt func");
+    s7_set_d_function(sc, s7_name_to_value(sc, "d-func"), opt_d_func);
+    func = s7_float_optimize(sc, s7_list(sc, 1, s7_list(sc, 1, symbol))); /* ((d-func)) -- the extra list layer is an historical artifact */
+    if ((!WITH_GMP) && (!func)) fprintf(stderr, "%d: d-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-d-func", g_d_d_func, 1, 0, false, "d-d opt func");
+    s7_set_d_d_function(sc, s7_name_to_value(sc, "d-d-func"), opt_d_d_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 2, symbol, s7_make_real(sc, 2.0)))); /* ((d-d-func 2.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-d-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-dd-func", g_d_dd_func, 2, 0, false, "d-dd opt func");
+    s7_set_d_dd_function(sc, s7_name_to_value(sc, "d-dd-func"), opt_d_dd_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 3, symbol, s7_make_real(sc, 2.0), s7_make_real(sc, 3.0)))); /* ((d-dd-func 2.0 3.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-dd-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-ddd-func", g_d_ddd_func, 3, 0, false, "d-ddd opt func");
+    s7_set_d_ddd_function(sc, s7_name_to_value(sc, "d-ddd-func"), opt_d_ddd_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 4, symbol, s7_make_real(sc, 2.0), s7_make_real(sc, 3.0), s7_make_real(sc, 4.0)))); /* ((d-ddd-func 2.0 3.0 4.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-ddd-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-dddd-func", g_d_dddd_func, 4, 0, false, "d-dddd opt func");
+    s7_set_d_dddd_function(sc, s7_name_to_value(sc, "d-dddd-func"), opt_d_dddd_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1,
+       s7_list(sc, 5, symbol, s7_make_real(sc, 2.0), s7_make_real(sc, 3.0), s7_make_real(sc, 4.0), s7_make_real(sc, 5.0)))); /* ((d-dddd-func 2.0 3.0 4.0 5.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-dddd-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "i-i-func", g_i_i_func, 1, 0, false, "i-i opt func");
+    s7_set_i_i_function(sc, s7_name_to_value(sc, "i-i-func"), opt_i_i_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 2, symbol, s7_make_integer(sc, 2)))); /* ((i-i-func 2)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: i-i-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "i-ii-func", g_i_ii_func, 2, 0, false, "i-ii opt func");
+    s7_set_i_ii_function(sc, s7_name_to_value(sc, "i-ii-func"), opt_i_ii_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 3, symbol, s7_make_integer(sc, 2), s7_make_integer(sc, 3)))); /* ((i-ii-func 2 3)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: i-ii-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-id-func", g_d_id_func, 2, 0, false, "d-id opt func");
+    s7_set_d_id_function(sc, s7_name_to_value(sc, "d-id-func"), opt_d_id_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 3, symbol, s7_make_integer(sc, 2), s7_make_real(sc, 3.0)))); /* ((d-id-func 2 3.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-id-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-ip-func", g_d_ip_func, 2, 0, false, "d-ip opt func");
+    s7_set_d_ip_function(sc, s7_name_to_value(sc, "d-ip-func"), opt_d_ip_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 3, symbol, s7_make_integer(sc, 2), s7_make_real(sc, 3.0)))); /* ((d-ip-func 2 3.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-ip-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "i-7d-func", g_i_7d_func, 1, 0, false, "i-7d opt func");
+    s7_set_i_7d_function(sc, s7_name_to_value(sc, "i-7d-func"), opt_i_7d_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 2, symbol, s7_make_real(sc, 2.0)))); /* ((i-7d-func 2.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: i-7d-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "i-7p-func", g_i_7p_func, 1, 0, false, "i-7p opt func");
+    s7_set_i_7p_function(sc, s7_name_to_value(sc, "i-7p-func"), opt_i_7p_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 2, symbol, s7_make_integer(sc, 2)))); /* ((i-7p-func 2)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: i-7p-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-p-func", g_d_p_func, 1, 0, false, "d-p opt func");
+    s7_set_d_p_function(sc, s7_name_to_value(sc, "d-p-func"), opt_d_p_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 2, symbol, s7_make_real(sc, 2.0)))); /* ((d-p-func 2.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-p-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-pd-func", g_d_pd_func, 2, 0, false, "d-pd opt func");
+    s7_set_d_pd_function(sc, s7_name_to_value(sc, "d-pd-func"), opt_d_pd_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 3, symbol, s7_make_real(sc, 2.0), s7_make_real(sc, 3.0)))); /* ((d-pd-func 2.0 3.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-pd-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-7pi-func", g_d_7pi_func, 2, 0, false, "d-7pi opt func");
+    s7_set_d_7pi_function(sc, s7_name_to_value(sc, "d-7pi-func"), opt_d_7pi_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 3, symbol, s7_make_real(sc, 2.0), s7_make_integer(sc, 3)))); /* ((d-7pi-func 2.0 3)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-7pi-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-7pid-func", g_d_7pid_func, 3, 0, false, "d-7pid opt func");
+    s7_set_d_7pid_function(sc, s7_name_to_value(sc, "d-7pid-func"), opt_d_7pid_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 4, symbol, s7_make_real(sc, 2.0), s7_make_integer(sc, 3), s7_make_real(sc, 4.0)))); /* ((d-7pid-func 2.0 3 4.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-7pid-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "b-p-func", g_b_p_func, 1, 0, false, "b-p opt func");
+    s7_set_b_p_function(sc, s7_name_to_value(sc, "b-p-func"), opt_b_p_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 2, symbol, s7_make_real(sc, 2.0)))); /* ((b-p-func 2.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: b-p-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "p-d-func", g_p_d_func, 1, 0, false, "p-d opt func");
+    s7_set_p_d_function(sc, s7_name_to_value(sc, "p-d-func"), opt_p_d_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 2, symbol, s7_make_real(sc, 2.0)))); /* ((p-d-func 2.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: p-d-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-v-func", g_d_v_func, 1, 0, false, "d-v opt func");
+    s7_set_d_v_function(sc, s7_name_to_value(sc, "d-v-func"), opt_d_v_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1, s7_list(sc, 2, symbol, s7_list(sc, 2, s7_make_symbol(sc, "block"), s7_make_integer(sc, 2))))); /* ((d-v-func (block 2))) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-v-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-vd-func", g_d_vd_func, 2, 0, false, "d-vd opt func");
+    s7_set_d_vd_function(sc, s7_name_to_value(sc, "d-vd-func"), opt_d_vd_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1,
+                              s7_list(sc, 3, symbol,
+                                             s7_list(sc, 2, s7_make_symbol(sc, "block"), s7_make_integer(sc, 2)),
+				             s7_make_real(sc, 0.0)))); /* ((d-vd-func (block 2) 0.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-vd-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-vid-func", g_d_vid_func, 3, 0, false, "d-vid opt func");
+    s7_set_d_vid_function(sc, s7_name_to_value(sc, "d-vid-func"), opt_d_vid_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1,
+                              s7_list(sc, 4, symbol,
+                                             s7_list(sc, 2, s7_make_symbol(sc, "block"), s7_make_integer(sc, 2)),
+				             s7_make_integer(sc, 0),
+				             s7_make_real(sc, 0.0)))); /* ((d-vid-func (block 2) 0 0.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-vid-func not optimized\n", __LINE__);
+
+    symbol = s7_define_safe_function(sc, "d-vdd-func", g_d_vdd_func, 3, 0, false, "d-vdd opt func");
+    s7_set_d_vdd_function(sc, s7_name_to_value(sc, "d-vdd-func"), opt_d_vdd_func);
+    sfunc = s7_optimize(sc, s7_list(sc, 1,
+                              s7_list(sc, 4, symbol,
+                                             s7_list(sc, 2, s7_make_symbol(sc, "block"), s7_make_integer(sc, 2)),
+				             s7_make_real(sc, 0.0),
+				             s7_make_real(sc, 0.0)))); /* ((d-vdd-func (block 2) 0.0 0.0)) */
+    if ((!WITH_GMP) && (!sfunc)) fprintf(stderr, "%d: d-vdd-func not optimized\n", __LINE__);
+  }
+
+  {
+    s7_pointer old_port, new_port, res;
+    new_port = s7_open_input_string(sc, "01234");
+    old_port = s7_set_current_input_port(sc, new_port);
+    res = s7_eval_c_string(sc, "(read-char)");
+    if (s7_character(res) != '0') {fprintf(stderr, "%d: read-char: %s\n", __LINE__, s1 = TO_STR(res)); free(s1);}
+    s7_set_current_input_port(sc, old_port);
+  }
+
+  {
+    s7_pointer res;
+    s7_define_function(sc, "abs", our_abs, 1, 0, false, "abs replacement"); /* make sure #_abs is not touched */
+    res = s7_eval_c_string(sc, "(#_abs -1.0)");
+    if (s7_real(res) != 1.0) {fprintf(stderr, "#_abs: %s?\n", s1 = TO_STR(res)); free(s1);}
+    res = s7_eval_c_string(sc, "(abs -1.0)");
+    if (s7_real(res) != 0.0) {fprintf(stderr, "(our_)abs: %s?\n", s1 = TO_STR(res)); free(s1);}
+  }
+
+  { /* check realloc'd large block handling in s7_free */
+    int i;
+    s7_int addrs[20000];
+
+    for (i = 0; i < 20000; i++)   /* gc_protected_objects */
+      addrs[i] = s7_gc_protect(sc, s7_cons(sc, s7_f(sc), s7_t(sc)));
+
+    for (i = 19999; i >= 0; i--)
+      s7_gc_unprotect_at(sc, addrs[i]);
+
+    for (i = 0; i < 10000; i++)   /* rootlet */
+      {
+	char buf[128];
+	snprintf(buf, 128, "sym-%d", i);
+	s7_define(sc, s7_nil(sc), s7_make_symbol(sc, (const char *)buf), s7_make_integer(sc, i));
+      }
+
+    for (i = 0; i < 10000; i++)   /* stack */
+      {
+	s7_pointer p = s7_make_vector(sc, 3);
+	s7_gc_protect_via_stack(sc, p);
+	s7_object_to_string(sc, p, false); /* for check_stack_size */
+      }}
+
+  s7_quit(sc);
+  free(perm1);
+  free(perm2);
+  s7_free(sc);
+
+  return(0);
+}
diff --git a/s7/tools/make-nrepl-bits.scm b/s7/tools/make-nrepl-bits.scm
new file mode 100644
index 0000000..1c09b72
--- /dev/null
+++ b/s7/tools/make-nrepl-bits.scm
@@ -0,0 +1,17 @@
+;;; xxd but in a way that mimimizes diffs by following the original's line lengths
+
+(call-with-output-file "nrepl-bits.h"
+  (lambda (op)
+    (call-with-input-file "nrepl.scm"
+      (lambda (ip)
+	(format op "/* created by make-nrepl-bits.scm reading nrepl.scm */~%")
+	(format op "unsigned char nrepl_scm[] = {~%  ")
+	(do ((c (read-char ip) (read-char ip))
+	     (i 0 (+ i 1)))
+	    ((eof-object? c)
+	     (format op "0};~%unsigned int nrepl_scm_len = ~D;~%" i))
+	  (format op "0x~X, " (char->integer c))
+	  (if (char=? c #\newline)
+	      (format op "~%  ")))))))
+
+
diff --git a/s7/tools/s7.def b/s7/tools/s7.def
new file mode 100644
index 0000000..0eeda47
--- /dev/null
+++ b/s7/tools/s7.def
@@ -0,0 +1,404 @@
+LIBRARY S7.DLL
+EXPORTS
+s7_init
+s7_free
+s7_f
+s7_t
+s7_nil
+s7_undefined
+s7_unspecified
+s7_is_unspecified
+s7_eof_object
+s7_is_null
+s7_is_valid
+s7_is_c_pointer
+s7_is_c_pointer_of_type
+s7_c_pointer
+s7_c_pointer_with_type
+s7_c_pointer_type
+s7_make_c_pointer
+s7_make_c_pointer_with_type
+s7_eval_c_string
+s7_eval_c_string_with_environment
+s7_object_to_string
+s7_object_to_c_string
+s7_load
+s7_load_with_environment
+s7_load_c_string
+s7_load_c_string_with_environment
+s7_load_path
+s7_add_to_load_path
+s7_autoload
+s7_autoload_set_names
+s7_quit
+s7_begin_hook
+s7_set_begin_hook
+s7_eval
+s7_eval_with_location
+s7_provide
+s7_is_provided
+s7_repl
+s7_error
+s7_wrong_type_arg_error
+s7_wrong_type_error
+s7_out_of_range_error
+s7_wrong_number_of_args_error
+s7_stacktrace
+s7_history
+s7_add_to_history
+s7_history_enabled
+s7_set_history_enabled
+s7_gc_on
+s7_gc_protect
+s7_gc_unprotect_at
+s7_gc_protected_at
+s7_gc_protect_via_stack
+s7_gc_unprotect_via_stack
+s7_gc_protect_via_location
+s7_gc_unprotect_via_location
+s7_is_eq
+s7_is_eqv
+s7_is_equal
+s7_is_equivalent
+s7_is_boolean
+s7_boolean
+s7_make_boolean
+s7_is_pair
+s7_cons
+s7_car
+s7_cdr
+s7_set_car
+s7_set_cdr
+s7_cadr
+s7_cddr
+s7_cdar
+s7_caar
+s7_caadr
+s7_caddr
+s7_cadar
+s7_caaar
+s7_cdadr
+s7_cdddr
+s7_cddar
+s7_cdaar
+s7_caaadr
+s7_caaddr
+s7_caadar
+s7_caaaar
+s7_cadadr
+s7_cadddr
+s7_caddar
+s7_cadaar
+s7_cdaadr
+s7_cdaddr
+s7_cdadar
+s7_cdaaar
+s7_cddadr
+s7_cddddr
+s7_cdddar
+s7_cddaar
+s7_is_list
+s7_is_proper_list
+s7_list_length
+s7_make_list
+s7_list
+s7_list_nl
+s7_array_to_list
+s7_list_to_array
+s7_reverse
+s7_append
+s7_list_ref
+s7_list_set
+s7_assoc
+s7_assq
+s7_member
+s7_memq
+s7_tree_memq
+s7_is_string
+s7_string
+s7_make_string
+s7_make_string_with_length
+s7_make_string_wrapper
+s7_make_string_wrapper_with_length
+s7_make_permanent_string
+s7_make_semipermanent_string
+s7_string_length
+s7_is_character
+s7_character
+s7_make_character
+s7_is_number
+s7_is_integer
+s7_integer
+s7_make_integer
+s7_is_real
+s7_real
+s7_make_real
+s7_make_mutable_real
+s7_number_to_real
+s7_number_to_real_with_caller
+s7_number_to_real_with_location
+s7_number_to_integer
+s7_number_to_integer_with_caller
+s7_is_rational
+s7_is_ratio
+s7_make_ratio
+s7_rationalize
+s7_numerator
+s7_denominator
+s7_random
+s7_random_state
+s7_random_state_to_list
+s7_set_default_random_state
+s7_is_random_state
+s7_is_complex
+s7_make_complex
+s7_real_part
+s7_imag_part
+s7_number_to_string
+s7_is_vector
+s7_vector_length
+s7_vector_rank
+s7_vector_dimension
+s7_vector_elements
+s7_int_vector_elements
+s7_byte_vector_elements
+s7_float_vector_elements
+s7_is_float_vector
+s7_is_int_vector
+s7_is_byte_vector
+s7_vector_ref
+s7_vector_set
+s7_vector_ref_n
+s7_vector_set_n
+s7_vector_dimensions
+s7_vector_offsets
+s7_int_vector_ref
+s7_int_vector_set
+s7_byte_vector_ref
+s7_byte_vector_set
+s7_float_vector_ref
+s7_float_vector_set
+s7_make_vector
+s7_make_int_vector
+s7_make_byte_vector
+s7_make_float_vector
+s7_make_normal_vector
+s7_make_float_vector_wrapper
+s7_make_and_fill_vector
+s7_vector_fill
+s7_vector_copy
+s7_vector_to_list
+s7_is_hash_table
+s7_make_hash_table
+s7_hash_table_ref
+s7_hash_table_set
+s7_hash_code
+s7_hook_functions
+s7_hook_set_functions
+s7_is_input_port
+s7_is_output_port
+s7_port_filename
+s7_port_line_number
+s7_current_input_port
+s7_set_current_input_port
+s7_current_output_port
+s7_set_current_output_port
+s7_current_error_port
+s7_set_current_error_port
+s7_close_input_port
+s7_close_output_port
+s7_open_input_file
+s7_open_output_file
+s7_open_input_string
+s7_open_output_string
+s7_get_output_string
+s7_output_string
+s7_flush_output_port
+s7_open_output_function
+s7_open_input_function
+s7_read_char
+s7_peek_char
+s7_read
+s7_newline
+s7_write_char
+s7_write
+s7_display
+s7_format
+s7_is_syntax
+s7_is_symbol
+s7_symbol_name
+s7_make_symbol
+s7_gensym
+s7_is_keyword
+s7_make_keyword
+s7_keyword_to_symbol
+s7_rootlet
+s7_shadow_rootlet
+s7_set_shadow_rootlet
+s7_curlet
+s7_set_curlet
+s7_outlet
+s7_sublet
+s7_inlet
+s7_varlet
+s7_let_to_list
+s7_is_let
+s7_let_ref
+s7_let_set
+s7_openlet
+s7_is_openlet
+s7_method
+s7_let_field_ref
+s7_let_field_set
+s7_starlet_ref
+s7_starlet_set
+s7_name_to_value
+s7_symbol_table_find_name
+s7_symbol_value
+s7_symbol_set_value
+s7_symbol_local_value
+s7_for_each_symbol_name
+s7_for_each_symbol
+s7_dynamic_wind
+s7_is_immutable
+s7_immutable
+s7_define
+s7_is_defined
+s7_define_variable
+s7_define_variable_with_documentation
+s7_define_constant
+s7_define_constant_with_documentation
+s7_define_constant_with_environment
+s7_is_function
+s7_is_procedure
+s7_is_macro
+s7_closure_body
+s7_closure_let
+s7_closure_args
+s7_funclet
+s7_is_aritable
+s7_arity
+s7_help
+s7_make_continuation
+s7_documentation
+s7_set_documentation
+s7_setter
+s7_set_setter
+s7_signature
+s7_make_signature
+s7_make_circular_signature
+s7_make_function
+s7_make_safe_function
+s7_make_typed_function
+s7_define_function
+s7_define_safe_function
+s7_define_typed_function
+s7_define_unsafe_typed_function
+s7_define_semisafe_typed_function
+s7_make_function_star
+s7_make_safe_function_star
+s7_define_function_star
+s7_define_safe_function_star
+s7_define_typed_function_star
+s7_define_macro
+s7_apply_function
+s7_apply_function_star
+s7_call
+s7_call_with_location
+s7_call_with_catch
+s7_is_dilambda
+s7_dilambda
+s7_typed_dilambda
+s7_dilambda_with_environment
+s7_values
+s7_is_multiple_value
+s7_make_iterator
+s7_is_iterator
+s7_iterator_is_at_end
+s7_iterate
+s7_copy
+s7_fill
+s7_type_of
+s7_mark
+s7_is_c_object
+s7_c_object_type
+s7_c_object_value
+s7_c_object_value_checked
+s7_make_c_object
+s7_make_c_object_with_let
+s7_make_c_object_without_gc
+s7_c_object_let
+s7_c_object_set_let
+s7_make_c_type
+s7_c_type_set_free
+s7_c_type_set_mark
+s7_c_type_set_equal
+s7_c_type_set_gc_free
+s7_c_type_set_gc_mark
+s7_c_type_set_is_equal
+s7_c_type_set_is_equivalent
+s7_c_type_set_ref
+s7_c_type_set_set
+s7_c_type_set_length
+s7_c_type_set_copy
+s7_c_type_set_fill
+s7_c_type_set_reverse
+s7_c_type_set_to_list
+s7_c_type_set_to_string
+s7_c_type_set_getter
+s7_c_type_set_setter
+s7_optimize
+s7_float_optimize
+s7_set_d_function
+s7_d_function
+s7_set_d_d_function
+s7_d_d_function
+s7_set_d_dd_function
+s7_d_dd_function
+s7_set_d_ddd_function
+s7_d_ddd_function
+s7_set_d_dddd_function
+s7_d_dddd_function
+s7_set_d_v_function
+s7_d_v_function
+s7_set_d_vd_function
+s7_d_vd_function
+s7_set_d_vdd_function
+s7_d_vdd_function
+s7_set_d_vid_function
+s7_d_vid_function
+s7_set_d_p_function
+s7_d_p_function
+s7_set_d_pd_function
+s7_d_pd_function
+s7_set_d_7pi_function
+s7_d_7pi_function
+s7_set_d_7pid_function
+s7_d_7pid_function
+s7_set_d_id_function
+s7_d_id_function
+s7_set_d_ip_function
+s7_d_ip_function
+s7_set_i_i_function
+s7_i_i_function
+s7_set_i_7d_function
+s7_i_7d_function
+s7_set_i_ii_function
+s7_i_ii_function
+s7_set_i_7p_function
+s7_i_7p_function
+s7_set_b_p_function
+s7_b_p_function
+s7_set_p_d_function
+s7_p_d_function
+s7_set_p_p_function
+s7_p_p_function
+s7_set_p_pp_function
+s7_p_pp_function
+s7_set_p_ppp_function
+s7_p_ppp_function
+s7_slot
+s7_slot_value
+s7_slot_set_value
+s7_make_slot
+s7_slot_set_real_value
diff --git a/s7/tools/t101.scm b/s7/tools/t101.scm
new file mode 100644
index 0000000..f041688
--- /dev/null
+++ b/s7/tools/t101.scm
@@ -0,0 +1,310 @@
+;;; try each s7test test macro (using repl, not snd)
+
+(define aux-counter 0)
+(system "make-repl")
+
+(let ((aux-file (format #f "t101-~D.scm" (set! aux-counter (+ aux-counter 1)))))
+  (call-with-output-file aux-file
+    (lambda (p)
+      (format p "(define aux-counter ~D)\n" aux-counter)
+      (format p "(set! (*s7* 'safety) 1)~%")
+      (format p "(load \"s7test.scm\")~%(exit)~%")))
+  (format *stderr* "~%~NC~%test: safety=1~%" 80 #\-)
+  (system (string-append "./repl " aux-file)))
+
+(let ((aux-file (format #f "t101-~D.scm" (set! aux-counter (+ aux-counter 1)))))
+  (call-with-output-file aux-file
+    (lambda (p)
+      (format p "(define aux-counter ~D)\n" aux-counter)
+      (format p "(set! (*s7* 'initial-string-port-length) 32)~%(set! (*s7* 'undefined-identifier-warnings) #t)~%(set! (*s7* 'hash-table-float-epsilon) 1e-3)~%")
+      (format p "(load \"s7test.scm\")~%(exit)~%")))
+  (format *stderr* "~%~NC~%test: port-length=32 etc~%" 80 #\-)
+  (system (string-append "./repl " aux-file)))
+
+(for-each
+ (lambda (test-case)
+   (let ((aux-file (format #f "t101-~D.scm" (set! aux-counter (+ aux-counter 1)))))
+     (call-with-output-file aux-file
+       (lambda (p)
+	 (format p "(define aux-counter ~D)\n" aux-counter)
+	 (format p "(define-macro (test tst expected) ~A)~%" test-case)
+	 (format p "(define-macro (num-test tst expected) ~A)~%" (string-append "`(nok? " (substring test-case 5)))
+	 (format p "(load \"s7test.scm\")~%(exit)~%")))
+     (format *stderr* "~%~NC~%test: ~S~%" 80 #\- test-case)
+     (system (string-append "./repl " aux-file))))
+ (list
+  "`(ok? ',tst (lambda () (eval ',tst)) ,expected)"
+  "`(ok? ',tst (lambda () ,tst) ,expected)"
+  "`(ok? ',tst (#_let () (define (_s7_) ,tst)) ,expected)"
+  "`(ok? ',tst (#_let () (define (_s7_) ,tst) (define (_call_) (_s7_))) ,expected)"
+  "`(ok? ',tst (lambda () (#_let ((_s7_ #f)) (set! _s7_ ,tst))) ,expected)"
+  "`(ok? ',tst (lambda () (#_let ((_s7_ ,tst)) _s7_)) ,expected)"
+  "`(ok? ',tst (lambda () (letrec ((_s7_ ,tst)) _s7_)) ,expected)"
+  "`(ok? ',tst (catch #t (lambda () (lambda* ((!a! ,tst)) !a!)) (lambda any (lambda () 'error))) ,expected)"
+  "`(ok? ',tst (lambda () (do ((!a! ,tst)) (#t !a!))) ,expected)"
+  "`(ok? ',tst (lambda () (do ((__i__ 0 (+ __i__ 1))) ((= __i__ 1) ,expected) ,tst)) ,expected)"
+  "`(ok? ',tst (lambda () (do ((__i__ 0 (+ __i__ 1))) ((= __i__ 2) ,expected) (let-temporarily (((*s7* 'safety) 1)) ,tst))) ,expected)"
+  "`(ok? ',tst (lambda () (#_let ((__x__ #f)) (define (__f__) (do ((__i__ 0 (+ __i__ 1))) ((= __i__ 1) __x__) (set! __x__ ,tst))) (__f__))) ,expected)"
+  ;;  "`(ok? ',tst (lambda () (#_let ((__x__ #f)) (define (__f__) (do ((__i__ 0 (+ __i__ 1))) ((= __i__ 2) __x__) (set! __x__ ,tst))) (__f__))) ,expected)"
+  "`(ok? ',tst (lambda () (define (!f!) (#_let ((!v! (vector #f))) (do ((!i! 0 (+ !i! 1))) ((= !i! 1) (!v! 0)) (vector-set! !v! 0 ,tst)))) (!f!)) ,expected)"
+  "`(ok? ',tst (lambda () (define (!f!) (#_let ((!v! #f)) (do ((!i! 0 (+ !i! 1))) ((= !i! 1) !v!) (set! !v! ,tst)))) (!f!)) ,expected)"
+  "`(ok? ',tst (lambda () (define (!f!) (#_let ((!x! (map (lambda (!a!) ,tst) '(0)))) (if (pair? !x!) (car !x!) #<no-value>))) (!f!)) ,expected)"
+  "`(ok? ',tst (lambda () (define (!f!) (#_let ((!x! #f)) (for-each (lambda (!a!) (set! !x! ,tst)) '(0)) !x!)) (!f!)) ,expected)"
+  "`(ok? ',tst (lambda () (call-with-exit (lambda (!a!) (!a! ,tst)))) ,expected)"
+  "`(ok? ',tst (lambda () (call/cc (lambda (!a!) (!a! ,tst)))) ,expected)"
+  "`(ok? ',tst (lambda () (values ,tst)) ,expected)"
+  "`(ok? ',tst (lambda () (car (list (values ,tst 0)))) ,expected)"
+  "`(ok? ',tst (lambda () ((lambda (!a! !b!) !b!) (values #f ,tst))) ,expected)"
+  "`(ok? ',tst (lambda () (define (_s7_ !a!) !a!) (_s7_ ,tst)) ,expected)"
+  "`(ok? ',tst (lambda () (define (_s7_ . !a!) (car !a!)) (_s7_ ,tst)) ,expected)"
+  "`(ok? ',tst (lambda () (#_let ((___x #f)) (set! ___x ,tst))) ,expected)"
+  "`(ok? ',tst (lambda () (#_let ((___x #(#f))) (set! (___x 0) ,tst))) ,expected)"
+  "`(ok? ',tst (lambda () (#_let ((___x #(#f))) (vector-set! ___x 0 ,tst))) ,expected)"
+  "`(ok? ',tst (lambda () (dynamic-wind #f (lambda () ,tst) #f)) ,expected)"
+  "`(ok? ',tst (lambda () (caadr (catch 'receive (lambda () (throw 'receive ,tst)) (lambda any any)))) ,expected)"
+  "`(ok? ',tst (lambda () (stacktrace (- (random 100) 50) (- (random 100) 50) (- (random 100) 50) (- (random 100) 50) (> (random 100) 50)) ,tst) ,expected)"
+  "`(ok? ',tst (lambda () (#_let ((__val__ (s7-optimize '(,tst)))) (if (eq? __val__ #<undefined>) ,tst __val__))) ,expected)"
+  "`(ok? ',tst (lambda () (#_let ((!x 0)) (set! (setter '!x) (lambda (_A _B) ,tst)) (set! !x 1))) ,expected)"
+  "`(ok? ',tst (lambda () (define* (fgh1 (!x ,tst)) !x) (fgh1)) ,expected)"
+  "`(ok? ',tst (lambda () (define !f (#_let ((!x ,tst)) (lambda () !x))) (!f)) ,expected)"
+  ;;  "`(ok? ',tst (lambda () (define !f (make-iterator (#_let ((+iterator+ #t)) (lambda () ,tst)))) (iterate !f)) ,expected)"
+  "`(ok? ',tst (lambda () (#_let ((!str (object->string ,tst :readable))) (eval-string !str))) ,expected)"
+  "`(ok? ',tst (lambda () (#_let ((!x 0)) (let-temporarily ((!x #f)) ,tst))) ,expected)"
+  "`(ok? ',tst (lambda () (#_let () (define h! (make-hook '!x)) (set! (hook-functions h!) (list (lambda (!h) (set! (!h 'result) ,tst)))) (h!))) ,expected)"
+  "`(ok? ',tst (lambda () (let-temporarily (((*s7* 'autoloading?) #f)) (with-let (sublet (curlet)) ,tst))) ,expected)"
+  "`(ok? ',tst (lambda () (let-temporarily (((*s7* 'safety) 1)) ,tst)) (let-temporarily (((*s7* 'safety) 1)) ,expected))"
+  ;; "`(ok? ',tst (lambda () (let* _L_ ((_Lx_ 1)) (if (> _Lx_ 0) (_L_ (- _Lx_ 1)) ,tst))) ,expected)"
+  ;; this confuses get-zero-count, but otherwise is ok: `(ok? ',tst (lambda () (gc) ,tst) ,expected)
+  ;; these are ok: "`(ok? ',tst (lambda () (define-macro (!m x) `(values ,x)) (!m ,tst)) ,expected)"
+  ;;               "`(ok? ',tst (lambda () (let ((!x 0)) (let-temporarily ((!x ,tst)) !x))) ,expected)"
+  ))
+
+(let ((aux-file (format #f "t101-~D.scm" (set! aux-counter (+ aux-counter 1)))))
+  (call-with-output-file aux-file
+    (lambda (p)
+      (format p "(define aux-counter ~D)\n" aux-counter)
+      (format p "(set! (*s7* 'debug) 1)~%(set! ((funclet trace-in) '*debug-port*) #f)~%")
+      (format p "(load \"s7test.scm\")~%(exit)~%")))
+  (format *stderr* "~%~NC~%test: debug=1~%" 80 #\-)
+  (system (string-append "./repl " aux-file)))
+
+(let ((aux-file (format #f "t101-~D.scm" (set! aux-counter (+ aux-counter 1)))))
+  (call-with-output-file aux-file
+    (lambda (p)
+      (format p "(define aux-counter ~D)\n" aux-counter)
+      (format p "(set! (*s7* 'debug) 2)~%(set! ((funclet trace-in) '*debug-port*) #f)~%")
+      (format p "(load \"s7test.scm\")~%(exit)~%")))
+  (format *stderr* "~%~NC~%test: debug=2~%" 80 #\-)
+  (system (string-append "./repl " aux-file)))
+
+(let ((aux-file (format #f "t101-~D.scm" (set! aux-counter (+ aux-counter 1)))))
+  (call-with-output-file aux-file
+    (lambda (p)
+      (format p "(define aux-counter ~D)\n" aux-counter)
+      (format p "(set! (*s7* 'profile) 1)~%")
+      (format p "(load \"s7test.scm\")~%(exit)~%")))
+  (format *stderr* "~%~NC~%test: profile=1~%" 80 #\-)
+  (system (string-append "./repl " aux-file)))
+
+#|
+;; this quits at the quoted circular list (car '#1= (2 . #1#))
+(set! (*s7* 'safety) 1)
+
+(define-macro (test tst expected)
+  (let ((_call_ (gensym))
+	(_caller_ (gensym)))
+    `(ok? ',tst
+	  (lambda ()
+	    (define (,_caller_) (,_call_ ,tst))
+	    (define (,_call_ x) x)
+	    (,_caller_)
+	    (,_caller_))
+	  ,expected)))
+
+(define-macro (num-test tst expected)
+  (let ((_call_ (gensym))
+	(_caller_ (gensym)))
+    `(nok? ',tst
+	  (lambda ()
+	    (define (,_caller_) (,_call_ ,tst))
+	    (define (,_call_ x) x)
+	    (,_caller_)
+	    (,_caller_))
+	  ,expected)))
+
+(load "s7test.scm")
+|#
+
+(format *stderr* "~NC ffitest ~NC~%" 20 #\- 20 #\-)
+(if (provided? 'linux)
+    (begin
+      (system "gcc -o ffitest ffitest.c -g -Wall s7.o -lm -I. -ldl -Wl,-export-dynamic")
+      (system "ffitest"))
+    (if (provided? 'freebsd)
+	(begin
+	  (system "cc -o ffitest ffitest.c -g -Wall s7.o -lm -I. -ldl -Wl,-export-dynamic")
+	  (system "ffitest"))
+	(if (provided? 'osx)
+	    (begin
+	      (system "gcc -o ffitest ffitest.c -g -Wall s7.o -lm -I.")
+	      (system "ffitest"))
+	    )))
+
+
+;(format *stderr* "~%~NC lint ~NC~%" 20 #\- 20 #\-)
+;(catch #t (lambda () (lint "snd-test.scm" #f)) (lambda (type info) (apply format #t info)))
+
+;(format *stderr* "~%~NC local s7test ~NC~%" 20 #\- 20 #\-)
+;(system "./snd -e '(let () (catch #t (lambda () (load \"s7test.scm\" (curlet))) (lambda args #f)) (exit))'")
+
+(format *stderr* "~NC s7test ~NC~%" 20 #\- 20 #\-)
+(system "./repl s7test.scm")
+
+(format *stderr* "~NC tpeak ~NC~%" 20 #\- 20 #\-)
+(system "./repl tpeak.scm")
+
+(format *stderr* "~NC lt ~NC~%" 20 #\- 20 #\-)
+(system "./repl lt.scm")
+
+(format *stderr* "~NC tcopy ~NC~%" 20 #\- 20 #\-)
+(system "./repl tcopy.scm")
+
+(format *stderr* "~NC tmap ~NC~%" 20 #\- 20 #\-)
+(system "./repl tmap.scm")
+
+(format *stderr* "~NC tmv ~NC~%" 20 #\- 20 #\-)
+(system "./repl tmv.scm")
+
+(format *stderr* "~NC tmat ~NC~%" 20 #\- 20 #\-)
+(system "./repl tmat.scm")
+
+(format *stderr* "~NC tobj ~NC~%" 20 #\- 20 #\-)
+(system "./repl tobj.scm")
+
+(format *stderr* "~NC tmac ~NC~%" 20 #\- 20 #\-)
+(system "./repl tmac.scm")
+
+(format *stderr* "~NC teq ~NC~%" 20 #\- 20 #\-)
+(system "./repl teq.scm")
+
+(format *stderr* "~NC titer ~NC~%" 20 #\- 20 #\-)
+(system "./repl titer.scm")
+
+(format *stderr* "~%~NC tform ~NC~%" 20 #\- 20 #\-)
+(system "./repl tform.scm")
+
+(format *stderr* "~%~NC tread ~NC~%" 20 #\- 20 #\-)
+(system "./repl tread.scm")
+
+(format *stderr* "~%~NC thash ~NC~%" 20 #\- 20 #\-)
+(system "./repl thash.scm")
+
+(format *stderr* "~%~NC tmap-hash ~NC~%" 20 #\- 20 #\-)
+(system "./repl tmap-hash.scm")
+
+(format *stderr* "~NC tauto ~NC~%" 20 #\- 20 #\-)
+(system "./repl tauto.scm")
+
+;(format *stderr* "~NC mauto ~NC~%" 20 #\- 20 #\-)
+;(system "./repl mauto.scm")
+
+(format *stderr* "~NC tset ~NC~%" 20 #\- 20 #\-)
+(system "./repl tset.scm")
+
+(format *stderr* "~NC dup ~NC~%" 20 #\- 20 #\-)
+(system "./repl dup.scm")
+
+(format *stderr* "~NC tref ~NC~%" 20 #\- 20 #\-)
+(system "./repl tref.scm")
+
+(format *stderr* "~NC tsort ~NC~%" 20 #\- 20 #\-)
+(system "./repl tsort.scm")
+
+(format *stderr* "~NC tclo ~NC~%" 20 #\- 20 #\-)
+(system "./repl tclo.scm")
+
+(format *stderr* "~NC tvect ~NC~%" 20 #\- 20 #\-)
+(system "./repl tvect.scm")
+
+(format *stderr* "~NC tgsl ~NC~%" 20 #\- 20 #\-)
+(system "./repl tgsl.scm")
+
+(format *stderr* "~NC tio ~NC~%" 20 #\- 20 #\-)
+(system "./repl tio.scm")
+
+(format *stderr* "~NC trclo ~NC~%" 20 #\- 20 #\-)
+(system "./repl trclo.scm")
+
+(format *stderr* "~NC fbench ~NC~%" 20 #\- 20 #\-)
+(system "./repl fbench.scm")
+
+(format *stderr* "~NC tstar ~NC~%" 20 #\- 20 #\-)
+(system "./repl tstar.scm")
+
+(format *stderr* "~NC tshoot ~NC~%" 20 #\- 20 #\-)
+(system "./repl tshoot.scm")
+
+(format *stderr* "~NC tnum ~NC~%" 20 #\- 20 #\-)
+(system "./repl tnum.scm")
+
+(format *stderr* "~NC tmock ~NC~%" 20 #\- 20 #\-)
+(system "./repl tmock.scm")
+
+(format *stderr* "~NC tstr ~NC~%" 20 #\- 20 #\-)
+(system "./repl concordance.scm")
+
+(format *stderr* "~NC tlist ~NC~%" 20 #\- 20 #\-)
+(system "./repl tlist.scm")
+
+(format *stderr* "~NC tload ~NC~%" 20 #\- 20 #\-)
+(system "./repl tload.scm")
+
+(format *stderr* "~NC tgc ~NC~%" 20 #\- 20 #\-)
+(system "./repl tgc.scm")
+
+(format *stderr* "~NC tio ~NC~%" 20 #\- 20 #\-)
+(system "./repl tio.scm")
+
+(format *stderr* "~NC tmisc ~NC~%" 20 #\- 20 #\-)
+(system "./repl tmisc.scm")
+
+(format *stderr* "~NC tleft ~NC~%" 20 #\- 20 #\-)
+(system "./repl tleft.scm")
+
+(format *stderr* "~NC tlamb ~NC~%" 20 #\- 20 #\-)
+(system "./repl tlamb.scm")
+
+(format *stderr* "~NC thook ~NC~%" 20 #\- 20 #\-)
+(system "./repl thook.scm")
+
+(format *stderr* "~NC tcase ~NC~%" 20 #\- 20 #\-)
+(system "./repl tcase.scm")
+
+(format *stderr* "~NC index ~NC~%" 20 #\- 20 #\-)
+(system "./snd make-index.scm")
+
+(format *stderr* "~NC tgen ~NC~%" 20 #\- 20 #\-)
+(system "./snd tgen.scm")
+
+(format *stderr* "~NC tall ~NC~%" 20 #\- 20 #\-)
+(system "./snd tall.scm")
+
+(format *stderr* "~NC snd-test ~NC~%" 20 #\- 20 #\-)
+(system "./snd -l snd-test.scm")
+
+(format *stderr* "~NC bench ~NC~%" 20 #\- 20 #\-)
+(system "(cd /home/bil/test/scheme/bench/src ; /home/bil/cl/repl test-all.scm)")
+
+(format *stderr* "~NC full s7test ~NC~%" 20 #\- 20 #\-)
+(system "./repl full-s7test.scm")
+
+(format *stderr* "~NC full s7test ~NC~%" 20 #\- 20 #\-)
+(system "gcc -o trepl ~/cl/trepl.c s7.o -O -Wl,-export-dynamic -lm -I. -ldl")
+(system "trepl")
+
+(format *stderr* "~NC valgrind leak check ~NC~%" 20 #\- 20 #\-)
+(system "valgrind --leak-check=full --show-reachable=no --suppressions=/home/bil/cl/free.supp ./repl s7test.scm")
+
+(format *stderr* "all done\n")
+
+(exit)
diff --git a/s7/tools/table.scm b/s7/tools/table.scm
new file mode 100755
index 0000000..41e6854
--- /dev/null
+++ b/s7/tools/table.scm
@@ -0,0 +1,29 @@
+(define (no-dashes-or-cr str)
+  (do ((len (length str))
+       (newstr "")
+       (last-ch #\-)
+       (i 0 (+ i 1)))
+      ((= i (- len 1)) 
+       newstr)
+    (let ((ch (string-ref str i)))
+      (if (and (or (not (char=? ch #\-))
+		   (char-alphabetic? last-ch))
+	       (not (char=? ch #\newline)))
+	  (set! newstr (string-append newstr (make-string 1 ch))))
+      (set! last-ch ch))))
+
+(let ((ctr 0))
+  (call-with-input-file 
+      "snd-test.scm"
+    (lambda (file)
+      (let loop ((line (read-line file #t)))
+	(set! ctr (+ ctr 1))
+	(or (eof-object? line)
+	    (let ((len (length line)))
+	      (if (and (> len 30)
+		       (string=? ";;; ---------------- test "
+				 (substring line 0 26)))
+		  (format () "~A ~48,1T[~D]~%" (no-dashes-or-cr line) ctr))
+	      (loop (read-line file #t))))))))
+
+(exit)
diff --git a/s7/tools/tall.scm b/s7/tools/tall.scm
new file mode 100644
index 0000000..23785bd
--- /dev/null
+++ b/s7/tools/tall.scm
@@ -0,0 +1,267 @@
+;(set! (*s7* 'gc-stats) #t)
+
+(define (safe-divide a b)
+  "divide but check for 0 denom"
+  (if (zero? b)
+      a
+      (/ a b)))
+
+(define (real-time) 
+  (* 1.0 (/ (get-internal-real-time) internal-time-units-per-second)))
+
+(define (hundred n) 
+  (round (* 1000 n)))
+
+(define-macro (time-it a) 
+  `(begin (gc) 
+     (let ((start (real-time))) 
+       ,a 
+       (- (real-time) start))))
+
+(define size 1000000)
+
+(define (test-do)
+  (do ((j 0 (+ j 1))) ((= j 1))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      i)))
+
+(let ((do1 (time-it (test-do))))
+  (format *stderr* "~15T~A" (hundred do1)))
+
+(define (test-*1)
+  (let ((x 1.0))
+    (do ((j 0 (+ j 1))) ((= j 1))
+      (do ((i 0 (+ i 1)))
+	  ((= i size))
+	(set! x (+ x (* i 2.0)))))))
+
+(let ((do1 (time-it (test-*1))))
+  (format *stderr* "~5T~A" (hundred do1)))
+
+
+(define (test-osc)
+  (let ((vals (make-float-vector size))
+	(osc (make-oscil :frequency 440))
+	(e1 (make-env '(0 0 1 1 2 0) :length size)))
+    (set! *output* vals)
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (outa i (* (env e1) (oscil osc))))
+    (set! *output* #f)))
+
+(let ((do1 (time-it (test-osc))))
+  (format *stderr* "~5T~A" (hundred do1)))
+
+
+(load "ws.scm")
+;;; from chk.scm
+;(set! *clm-file-buffer-size* (* 8 1024 1024))
+(set! *to-snd* #f)
+
+;(set! *clm-file-name* "/dev/null")
+
+(define calls ())
+(define last-caller #f)
+;(set! *clm-notehook* (lambda args (set! calls (cons (list (report_env_1) last-caller) calls)) (set! last-caller (car args))))
+
+(load "v.scm")
+
+(define (test-fmv)
+  (with-sound (:channels 1 :statistics #f :to-snd #f :play #f :sample-type mus-ldouble)
+    (fm-violin 0 20 440 .1)))
+
+(let ((do1 (time-it (test-fmv))))
+  (format *stderr* "~4T~A" (hundred do1)))
+
+(define (test-fm2)
+  (with-sound (:channels 2 :statistics #f :to-snd #f :play #f :sample-type mus-ldouble) 
+    (fm-violin 0 20 440 .1 :degree 45)))
+
+(let ((do1 (time-it (test-fm2))))
+  (format *stderr* "~4T~A" (hundred do1)))
+
+
+(define (test-fm1000)
+  (with-sound (:statistics #f :to-snd #f :play #f :sample-type mus-ldouble) 
+    (do ((i 0 (+ i 1))) ((= i 10000)) (fm-violin (* i .001) .01 440 .001))))
+
+(let ((do1 (time-it (test-fm1000))))
+  (format *stderr* "~4T~A" (hundred do1)))
+
+
+(load "jcrev.scm")
+
+(define (test-fmj)
+  (with-sound (:channels 1 :statistics #f :to-snd #f :play #f :sample-type mus-ldouble :reverb jc-reverb) 
+    (fm-violin 0 20 440 .1)))
+
+(let ((do1 (time-it (test-fmj))))
+  (format *stderr* "~4T~A" (hundred do1)))
+
+
+(load "nrev.scm")
+
+(define (test-fmn)
+  (with-sound (:channels 1 :statistics #f :to-snd #f :play #f :sample-type mus-ldouble :reverb nrev) 
+    (fm-violin 0 20 440 .1)))
+
+(let ((do1 (time-it (test-fmn))))
+  (format *stderr* "~4T~A" (hundred do1)))
+
+
+(load "expandn.scm")
+(if (not (file-exists? "oboe.snd"))
+    (system "cp ~/cl/oboe.snd ."))
+
+(define (test-exp)
+  (with-sound (:channels 1 :statistics #f :to-snd #f :play #f :sample-type mus-ldouble) 
+    (expandn 0 10 "oboe.snd" 1 :expand 4)))
+
+(let ((do1 (time-it (test-exp))))
+  (format *stderr* "~5T~A" (hundred do1)))
+
+
+(load "singer.scm")
+
+(define (test-sing)
+  (with-sound (:channels 1 :statistics #f :to-snd #f :play #f :sample-type mus-ldouble) 
+    (singer 0 .1 
+	    (list (list .4 ehh.shp test.glt 523.0 .8 0.0 .01) 
+		  (list .6 oo.shp test.glt 523.0 .7 .1 .01)))))
+
+(let ((do1 (time-it (test-sing))))
+  (format *stderr* "~4T ~A" (hundred do1)))
+
+
+(load "grani.scm")
+
+(define (test-gran)
+  (with-sound (:channels 2 :statistics #f :to-snd #f :play #f :sample-type mus-ldouble) 
+    (grani 0 1 .5 "oboe.snd" 
+	   :grain-envelope '(0 0 0.2 0.2 0.5 1 0.8 0.2 1 0))))
+
+(let ((do1 (time-it (test-gran))))
+  (format *stderr* "~5T~A" (hundred do1)))
+
+
+(load "fullmix.scm")
+(if (not (file-exists? "pistol.snd"))
+    (system "cp ~/cl/pistol.snd ."))
+(if (not (file-exists? "2.snd"))
+    (system "cp ~/cl/2.snd ."))
+
+(define (test-full)
+  (with-sound (:channels 2 :statistics #f :to-snd #f :play #f :sample-type mus-ldouble) 
+    (fullmix "pistol.snd" 0 2 0 #f .5)  
+    (fullmix "oboe.snd" 1 2 0 (list (list .1 (make-env '(0 0 1 1) :duration 2 :scaler .5))))))
+
+(let ((do1 (time-it (test-full))))
+  (format *stderr* "~4T~A" (hundred do1)))
+
+
+(define (test-fuller)
+  (with-sound (:channels 2 :statistics #f :to-snd #f :play #f :sample-type mus-ldouble) 
+    (fullmix "pistol.snd")
+    (fullmix "2.snd" .5 1)
+    (fullmix "2.snd" 1.5 1 0 #f 2.0)
+    (fullmix "oboe.snd" 1 2 0 (list (list .1 (make-env '(0 0 1 1) :duration 2 :scaler .5))))
+    (fullmix "pistol.snd" 2 1 0 #f .5)
+    (fullmix "2.snd" 0 2 0 (list (list .1 .2) (list .3 .4)) 2.0)
+    (fullmix "oboe.snd" 3 2 0 (list (list .1 (make-env '(0 0 1 1) :duration 2 :scaler .5))) .25)
+    (let ((e0->0 (make-env '(0 0 1 1) :duration 2))
+	  (e0->1 (make-env '(0 1 1 0) :duration 2))
+	  (e1->0 (make-env '(0 1 1 0) :duration 2))
+	  (e1->1 (make-env '(0 0 1 1) :duration 2)))
+      (fullmix "2.snd" 4 2 0 (list (list e0->0 e0->1) (list e1->0 e1->1))))
+    (let ((e0->0 (make-env '(0 0 1 1) :duration 2))
+	  (e0->1 (make-env '(0 1 1 0) :duration 2))
+	  (e1->0 (make-env '(0 1 1 0) :duration 2))
+	  (e1->1 (make-env '(0 0 1 1) :duration 2)))
+      (fullmix "2.snd" 6 2 0 (list (list e0->0 e0->1) (list e1->0 e1->1)) 2.0))))
+
+(let ((do1 (time-it (test-fuller))))
+  (format *stderr* "~4T ~A" (hundred do1)))
+
+
+
+(load "clm-ins.scm")
+
+(define (test-pins)
+  (with-sound (:channels 1 :statistics #f :to-snd #f :play #f :sample-type mus-ldouble) 
+    (pins 0 3 "oboe.snd" 1.0 :max-peaks 8)))
+
+(let ((do1 (time-it (test-pins))))
+  (format *stderr* "~5T ~A" (hundred do1)))
+
+
+
+(if (not (file-exists? "popi.scm"))
+    (system "cp ~/cl/popi.scm ."))
+
+(define (test-popi)
+  (load "popi.scm"))
+
+(let ((do1 (time-it (test-popi))))
+  (format *stderr* "~5T~A" (hundred do1)))
+
+
+
+;(set! *clm-file-buffer-size* (* 64 1024 1024))
+
+(load "piano.scm")
+
+(define (test-piano)
+  (with-sound (:channels 1 :statistics #f :to-snd #f :play #f :sample-type mus-ldouble) 
+    (p 0 3)))
+
+(let ((do1 (time-it (test-piano))))
+  (format *stderr* "~5T~A" (hundred do1)))
+
+
+(set! *clm-sample-type* mus-ldouble)
+(load "animals.scm") 
+
+(define test-bird calling-all-animals)
+
+(let ((do1 (time-it (test-bird))))
+  (format *stderr* "~4T~A~%" (hundred do1)))
+
+
+;(for-each
+; (lambda (n)
+;   (format #t "~A~%" n))
+; (sort! calls (lambda (a b) (< (car a) (car b)))))
+
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(#_exit)
+
+
+#|
+/home/bil/snd-12/ ./snd --version
+This is Snd version 12.13 of 6-July-12:
+
+/home/bil/snd-12/ ./snd t502.scm
+times are in milliseconds
+do:        15
+float-vector-set:   38
+float-vector ind:   59
+vset:      41
+*1:        52
+osc:       116
+fmv:       145, C: 107
+fm2:       159
+fm1000:    834
+fmj:       388
+fmn:       398
+expand:    588
+sing:      1853
+gran:      57
+full:      53
+fuller:    477
+pins:      1279
+popi:      1727
+piano:     10315
+bird:      8928
+|#
diff --git a/s7/tools/tari.scm b/s7/tools/tari.scm
new file mode 100644
index 0000000..f9e68a1
--- /dev/null
+++ b/s7/tools/tari.scm
@@ -0,0 +1,453 @@
+;;; numeric function simple timing tests
+
+;(set! (*s7* 'heap-size) (* 4 1024000))
+
+(define size 250000)
+(define int-limit 1000000)
+(define float-limit 1000.0)
+
+(define (make-ivals)
+  (let ((v (make-int-vector size))
+	(lim (* 2 int-limit)))
+    (do ((i 0 (+ i 1)))
+	((= i size) v)
+      (int-vector-set! v i (- (random lim) int-limit)))))
+(define ivals (make-ivals))
+
+(define (make-ivals1)
+  (let ((v (make-vector size))
+	(lim (* 2 int-limit)))
+    (do ((i 0 (+ i 1)))
+	((= i size) v)
+      (vector-set! v i (- (random lim) int-limit)))))
+(define ivals1 (make-ivals1))
+
+(define (make-fvals)
+  (let ((v (make-float-vector size))
+	(lim (* 2.0 float-limit)))
+    (do ((i 0 (+ i 1)))
+	((= i size) v)
+      (float-vector-set! v i (- (random lim) float-limit)))))
+(define fvals (make-fvals))
+
+(define (make-fvals1)
+  (let ((v (make-vector size))
+	(lim (* 2.0 float-limit)))
+    (do ((i 0 (+ i 1)))
+	((= i size) v)
+      (vector-set! v i (- (random lim) float-limit)))))
+(define fvals1 (make-fvals1))
+
+(define (make-ratvals)
+  (let ((v (make-vector size))
+	(lim (* 2 int-limit)))
+    (do ((i 0 (+ i 1)))
+	((= i size) v)
+      (vector-set! v i (/ (- (random lim) int-limit) (+ 1 (random int-limit)))))))
+(define ratvals (make-ratvals))
+
+(define (make-cvals)
+  (let ((v (make-vector size))
+	(lim (* 2.0 float-limit)))
+    (do ((i 0 (+ i 1)))
+	((= i size) v)
+      (vector-set! v i (complex (- (random lim) float-limit) (- (random lim) float-limit))))))
+(define cvals (make-cvals))
+
+
+;;; -------- min max --------
+(define (minmax v)
+  (let ((lo (v 0))
+	(hi (v 0)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (list lo hi))
+      (set! lo (min lo (v i)))
+      (set! hi (max hi (v i))))))
+
+(define (minmax1 v)
+  (let ((lo (v 0))
+	(hi (v 0)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (list lo hi))
+      (set! lo (min lo (v i) hi))
+      (set! hi (max hi lo (v i))))))
+
+(format *stderr* "int-minmax ~S~%" (minmax ivals))     ; min/max_i_ii
+(format *stderr* "int-minmax ~S~%" (minmax ivals1))    ; min/max_p_pp
+(format *stderr* "int-minmax1 ~S~%" (minmax1 ivals))   ; min/max_i_iii
+(format *stderr* "int-minmax1 ~S~%" (minmax1 ivals1))  ; g_min/max -> min/max_p_pp [perhaps min/max_3?]
+(format *stderr* "float-minmax ~S~%" (minmax fvals))   
+(format *stderr* "float-minmax ~S~%" (minmax fvals1))  
+(format *stderr* "float-minmax1 ~S~%" (minmax1 fvals)) 
+(format *stderr* "float-minmax1 ~S~%" (minmax1 fvals1))
+(format *stderr* "ratio-minmax ~S~%" (minmax ratvals)) 
+
+
+;;; -------- real-part imag-part --------
+
+(define (complex-minmax v)
+  (let ((rlo (real-part (v 0)))
+	(rhi (real-part (v 0)))
+	(ilo (imag-part (v 0)))
+	(ihi (imag-part (v 0))))
+    (do ((i 0 (+ i 1)))
+	((= i size) (list rlo ilo rhi ihi))
+      (set! rlo (min rlo (real-part (v i))))
+      (set! rhi (max rhi (real-part (v i))))
+      (set! ilo (min ilo (imag-part (v i))))
+      (set! ihi (max ihi (imag-part (v i)))))))
+
+(format *stderr* "complex-minmax ~S~%" (complex-minmax cvals))
+
+
+;;; -------- numerator denominator --------
+
+(define (numden-minmax v)
+  (let ((numlo (numerator (v 0)))
+	(numhi (numerator (v 0)))
+	(denlo (denominator (v 0)))
+	(denhi (denominator (v 0))))
+    (do ((i 0 (+ i 1)))
+	((= i size) (list numlo denlo numhi denhi))
+      (set! numlo (min numlo (numerator (v i))))
+      (set! numhi (max numhi (numerator (v i))))
+      (set! denlo (min denlo (denominator (v i))))
+      (set! denhi (max denhi (denominator (v i)))))))
+
+(format *stderr* "numden-minmax ~S~%" (numden-minmax ratvals))
+
+
+;;; -------- even? odd? --------
+
+(define (count-evens v)
+  (let ((even 0)
+	(odd 0))
+    (do ((i 0 (+ i 1)))
+	((= i size) (list even odd size (+ even odd)))
+      (if (even? (v i)) (set! even (+ even 1)))
+      (if (odd? (v i)) (set! odd (+ odd 1))))))
+
+(format *stderr* "evens: ~S~%" (count-evens ivals))
+(format *stderr* "evens1: ~S~%" (count-evens ivals1))
+
+
+;;; -------- zero? positive? negative? --------
+
+(define (count-zeros v)
+  (let ((zero 0)
+	(pos 0)
+	(neg 0))
+    (do ((i 0 (+ i 1)))
+	((= i size) (list zero pos neg size (+ zero pos neg)))
+      (if (zero? (v i)) (set! zero (+ zero 1)))
+      (if (positive? (v i)) (set! pos (+ pos 1)))
+      (if (negative? (v i)) (set! neg (+ neg 1))))))
+
+(format *stderr* "zeros: ~S~%" (count-zeros ivals))
+(format *stderr* "zeros1: ~S~%" (count-zeros ivals1))
+(format *stderr* "zerosf: ~S~%" (count-zeros fvals))
+(format *stderr* "zerosrat: ~S~%" (count-zeros ratvals))
+
+
+;;; -------- exact->inexact inexact->exact rationalize --------
+
+(define (inex v1 v2)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (exact->inexact (v1 i))
+    (inexact->exact (v2 i))
+    (rationalize (v2 i))))
+
+(inex ivals fvals)
+
+(define (inex? v1 v2)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (if (inexact? (v1 i)) (display "oops: inexact?"))
+    (if (exact? (v2 i)) (display "oops: exact"))))
+
+(inex? ivals fvals)
+
+
+;;; -------- integer? byte? number? real? float? complex? rational? infinite? nan? --------
+
+(define (bools)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (if (infinite? (fvals i)) (display "oops inf"))
+    (if (nan? (fvals i)) (display "oops nan"))
+    (if (integer? (fvals i)) (display "oops int"))
+    (if (byte? (cvals i)) (display "oops byte"))
+    (if (and (real? (cvals i)) (not (zero? (imag-part (cvals i))))) (display "oops real"))
+    (if (or (not (complex? (cvals i))) (not (number? (cvals i)))) (display "oops complex"))
+    (if (rational? (cvals i)) (display "oops rational"))
+    (if (float? (ivals1 i)) (display "oops float"))))
+
+(bools)
+
+
+;;; -------- ceiling truncate round floor --------
+
+(define (ceil/floor)
+  (let ((ints (make-int-vector 1)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (unless (integer? (ceiling (fvals i))) (display "oops: ceiling"))
+      (unless (integer? (floor (fvals i))) (display "oops: floor"))
+      (unless (integer? (truncate (fvals i))) (display "oops: truncate"))
+      (unless (integer? (round (fvals i))) (display "oops: round"))
+      (int-vector-set! ints 0 (ceiling (ratvals i)))
+      (int-vector-set! ints 0 (ceiling (fvals i)))
+      (int-vector-set! ints 0 (floor (fvals i)))
+      (int-vector-set! ints 0 (floor (ratvals i)))
+      (int-vector-set! ints 0 (round (fvals i)))
+      (int-vector-set! ints 0 (truncate (fvals i))))))
+
+(ceil/floor)
+
+
+;;; -------- abs magnitude --------
+
+(define (absmag)
+  (let ((fv (make-float-vector 1))
+	(iv (make-int-vector 1)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (if (not (= (abs (fvals i)) (magnitude (fvals i)))) (display "oops: abs"))
+      (if (not (real? (magnitude (cvals i)))) (display "oops: magnitude"))
+      (if (negative? (abs (ivals1 i))) (display "oops: abs neg"))
+      (if (negative? (abs (ratvals i))) (display "oops: abs neg rat"))
+      (int-vector-set! iv 0 (abs (ivals i)))
+      (float-vector-set! fv 0 (abs (fvals i))))))
+
+(absmag)
+(newline)
+
+
+;;; -------- exp sqrt --------
+
+(define (expsq)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (sqrt (ivals i))
+    (sqrt (fvals i))
+    (sqrt (cvals i))
+    (sqrt (ratvals i))
+    (exp (fvals i))
+    (exp (ivals i))
+    (exp (cvals i))))
+
+(expsq)
+
+
+;;; -------- sin etc --------
+
+(define (trigs1) ; this division into *_d_d here and *_p_p below doesn't save much -- most time is in libm */
+  (let ((fv (make-float-vector 1)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (sin (fvals i))
+      (float-vector-set! fv 0 (sin (fvals i)))
+      (cos (fvals i))
+      (float-vector-set! fv 0 (cos (fvals i)))
+      (tan (fvals i))
+      (float-vector-set! fv 0 (tan (fvals i)))
+      (atan (fvals i))
+      (float-vector-set! fv 0 (atan (fvals i) (fvals i)))
+      (tanh (fvals i))
+      (sinh (fvals i))
+      (float-vector-set! fv 0 (sinh (fvals i)))
+      (cosh (fvals i))
+      (float-vector-set! fv 0 (cosh (fvals i)))
+      (angle (fvals i))
+      )))
+
+(trigs1)
+
+(define (trigs2)
+  (let ((fv (make-float-vector 1)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (sin (cvals i))
+      (cos (cvals i))
+      (tan (cvals i))
+      (asin (fvals i))
+      (asin (cvals i))
+      (acos (fvals i))
+      (acos (cvals i))
+      (atan (cvals i))
+      (sinh (cvals i))
+      (cosh (cvals i))
+      (tanh (cvals i))
+      (asinh (fvals i))
+      (asinh (cvals i))
+      (acosh (fvals i))
+      (acosh (cvals i))
+      (atanh (fvals i))
+      (atanh (cvals i)))))
+
+(trigs2)
+
+
+;;; -------- lognot etc --------
+
+(define (logs)
+  (let ((iv (make-int-vector 1)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (int-vector-set! iv 0 (logand (ivals i) (ivals i)))
+      (logand (ivals1 i) (ivals1 i))
+      (int-vector-set! iv 0 (logior (ivals i) (ivals i)))
+      (logior (ivals1 i) (ivals1 i))
+      (int-vector-set! iv 0 (logxor (ivals i) (ivals i)))
+      (logxor (ivals1 i) (ivals1 i))
+      (int-vector-set! iv 0 (lognot (ivals i)))
+      (lognot (ivals1 i))
+      (logbit? (ivals i) 12)
+      (if (logbit? (ivals i) 12) (display "on" #f))
+      (int-vector-set! iv 0 (ash (ivals i) 2))
+      (int-vector-set! iv 0 (ash (ivals i) -2)))))
+
+(logs)
+
+
+;;; -------- relops --------
+
+(define (relops)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (< (ivals i) (ivals1 i))
+    (<= (ivals i) (ivals1 i))
+    (= (ivals i) (ivals1 i))
+    (> (ivals i) (ivals1 i))
+    (>= (ivals i) (ivals1 i))))
+
+(relops) ; a million more choices here
+
+
+;;; -------- quotient remainder modulo -------- 
+
+(define (unzero v)
+  (let ((v1 (copy v)))
+    (do ((i 0 (+ i 1)))
+	((= i (vector-length v1)) v1)
+      (if (zero? (v1 i))
+	  (set! (v1 i) 1)))))
+
+(define unzeros (unzero ivals)) ; avoid divide by zero error
+(define unzeros1 (unzero ivals1))
+(define funzeros (unzero fvals))
+
+(define (quorem)
+  (let ((iv (make-int-vector 1))
+	(fv (make-float-vector 1)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (int-vector-set! iv 0 (quotient (ivals i) (unzeros i)))
+      (int-vector-set! iv 0 (remainder (ivals i) (unzeros i)))
+      (int-vector-set! iv 0 (modulo (ivals i) (unzeros i)))
+      (quotient (ivals i) (unzeros1 i))
+      (remainder (ivals i) (unzeros1 i))
+      (modulo (ivals i) (unzeros1 i))
+      (quotient (ivals i) 3)
+      (remainder (ivals i) 3)
+      (modulo (ivals i) 3)
+      (float-vector-set! fv 0 (quotient (fvals i) (funzeros i)))
+      (float-vector-set! fv 0 (remainder (fvals i) (funzeros i)))
+      (float-vector-set! fv 0 (modulo (fvals i) (funzeros i))))))
+
+(quorem)
+
+
+;;; -------- gcd lcm --------
+
+(define (gcdlcm)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (gcd (ivals i) (ivals1 i))
+    (lcm (ivals i) (ivals1 i))))
+
+(gcdlcm)
+
+
+;;; -------- log --------
+
+(define log-size (floor (/ size 8)))
+
+(define (logtest)
+  (do ((i 0 (+ i 1)))
+      ((= i log-size))
+    (log (fvals i) 2)
+    (log (cvals i))
+    (log (ivals i))
+    (log (ratvals i))
+
+    (log (ivals i) (unzeros i))
+    (log (ivals i) (funzeros i))
+    (log (ivals i) (unzeros1 i))
+    (log (ivals i) (cvals i))
+
+    (log (fvals i) (unzeros i))
+    (log (fvals i) (funzeros i))
+    (log (fvals i) (unzeros1 i))
+    (log (fvals i) (cvals i))
+
+    (log (ratvals i) (unzeros i))
+    (log (ratvals i) (funzeros i))
+    (log (ratvals i) (unzeros1 i))
+    (log (ratvals i) (cvals i))
+
+    (log (cvals i) (unzeros i))
+    (log (cvals i) (funzeros i))
+    (log (cvals i) (unzeros1 i))
+    (log (cvals i) (cvals i))))
+
+(logtest)
+
+
+;;; -------- expt --------
+
+;(define zratvals (unzero ratvals))
+
+(define (exptest)
+  (do ((i 0 (+ i 1)))
+      ((= i log-size))
+    (expt (unzeros i) (ivals i))
+    (expt (unzeros i) (fvals i))
+    (expt (unzeros i) (ivals1 i))
+    (expt (unzeros i) (ratvals i))
+    (expt (unzeros i) (cvals i))
+
+    (expt (funzeros i) (ivals i))
+    (expt (funzeros i) (fvals i))
+    (expt (funzeros i) (ivals1 i))
+    (expt (funzeros i) (ratvals i))
+    (expt (funzeros i) (cvals i))
+
+    (expt (ratvals i) (ivals i))
+    (expt (ratvals i) (fvals i))
+    (expt (ratvals i) (ivals1 i))
+    (expt (ratvals i) (ratvals i))
+    (expt (ratvals i) (cvals i))
+
+    (expt (cvals i) (ivals i))
+    (expt (cvals i) (fvals i))
+    (expt (cvals i) (ivals1 i))
+    (expt (cvals i) (ratvals i))
+    (expt (cvals i) (cvals i))))
+
+(exptest)
+
+(fill! ratvals 0)
+(fill! cvals 0)
+(set! unzeros #f)
+(set! funzeros #f)
+(set! unzeros1 #f)
+(set! ivals #f)
+(set! fvals #f)
+(set! fvals1 #f)
+(set! ivals1 #f)
+(set! ratvals #f)
+(set! cvals #f)
+
+(exit)
diff --git a/s7/tools/tauto.scm b/s7/tools/tauto.scm
new file mode 100644
index 0000000..c3ab0c7
--- /dev/null
+++ b/s7/tools/tauto.scm
@@ -0,0 +1,342 @@
+(set! (*s7* 'heap-size) (* 3 1024000))
+(set! (hook-functions *unbound-variable-hook*) ())
+(set! (*s7* 'print-length) 6)
+;(set! (*s7* 'gc-stats) #t)
+
+(when (provided? 'snd)
+  (format *stderr* "this won't work in Snd!~%")
+  (exit))
+
+(define baddies '(exit emergency-exit abort autotest s7-optimize dynamic-unwind
+		  all delete-file system set-cdr! stacktrace test-sym
+		  cutlet varlet gc cond-expand reader-cond
+		  openlet coverlet eval vector list cons values hash-table
+		  symbol-table load throw error
+		  make-rectangular macro macro* bacro bacro*
+		  copy fill! hash-table-set! vector-set! let-set! list-values apply-values immutable!
+		  *unbound-variable-hook* *load-hook* *rootlet-redefinition-hook* *missing-close-paren-hook* *read-error-hook*
+		  tree-count ; signature is kinda silly here
+		  c-define-1 apropos map-values trace-in profile-in
+		  define-expansion substring-uncopied ; this because errmsg has "substring" not "substring-uncopied"
+		  heap-scan heap-analyze heap-holders heap-holder
+		  check check-funcs type-ok
+		  show-stack trace-in profile-in apply call-with-exit
+		  define-expansion call-with-current-continuation 
+		  vector-append append ; append gets uninteresting type conversion complaints
+		  call/cc call-with-output-string open-input-function open-output-function
+		  set-current-input-port ;set-current-output-port
+		  set-current-error-port))
+
+(let ((max-args 3))
+  (define-constant one 1)
+  
+  (define-constant auto-constants (list #f #t () #\a (/ (*s7* 'most-positive-fixnum)) (/ -1 (*s7* 'most-positive-fixnum)) 1.5+i
+					"hi455" :key hi: 'hi (list 1) (list 1 2) (cons 1 2) (list (list 1 2)) (list (list 1)) (list ()) #() 
+					1/0+i 0+0/0i 0+1/0i 1+0/0i 0/0+0i 0/0+0/0i 1+1/0i 0/0+i cons ''2 
+					1+i 1+1e10i 1e15+1e15i 0+1e18i 1e18 #\xff (string #\xff) 1e308 
+					;(*s7* 'most-positive-fixnum) (*s7* 'most-negative-fixnum) (- (*s7* 'most-positive-fixnum) 1) (+ (*s7* 'most-negative-fixnum) 1)
+					;most-negative-fixnum hangs expt in gmp
+					-1 0 0.0 1 1.5 1.0-1.0i 3/4 #\null -63 (make-hash-table) (hash-table '(a . 2) '(b . 3))
+					'((1 2) (3 4)) '((1 (2)) (((3) 4))) "" (list #i(1) "1") '(1 2 . 3) (list (cons 'a 2) (cons 'b 3))
+					#i(1 2) (vector 1 '(3)) (let ((x 3)) (lambda (y) (+ x y))) abs 'a 'b one
+					(lambda args args) (lambda* ((a 3) (b 2)) (+ a b)) (lambda () 3)
+					(sublet () 'a 1) ;(rootlet)
+					*load-hook*  *error-hook* 
+					(random-state 123)
+					quasiquote macroexpand begin let letrec* if case cond (call-with-exit (lambda (goto) goto))
+					(with-baffle (call/cc (lambda (cc) cc)))
+					(string #\a #\null #\b) #2d((1 2) (3 4)) (inlet 'a 2 'b 3)
+					#<undefined> #<unspecified> (make-int-vector 3) (make-float-vector 3 -1.4)
+					(make-vector '(2 3) "hi") #("hiho" "hi" "hoho") (subvector (make-int-vector '(2 3) 1))
+					(subvector (subvector (make-float-vector '(2 3) 1.0) 0 6) 0 4 '(2 2))
+					(vector-ref #2d((#i(1 2 3)) (#i(3 4 5))) 0 0) (define-macro (m a) `(+ ,a 1))
+					(c-pointer 0) (c-pointer -1) :readable :else (define-bacro* (m (a 1)) `(+ ,a 1))
+					(byte-vector 0 1 2) (byte-vector) (byte-vector 255 0 127) (make-iterator #((a . 2)))
+					(lambda (dir) 1.0) (float-vector) (make-float-vector '(2 32)) 
+					'((a . 1)) #i(1) '((((A . B) C . D) (E . F) G . H) ((I . J) K . L) (M . N) O . P)
+					#u(0 1 2) (openlet (inlet 'abs (lambda (x) (- x))))
+					(make-iterator (list 1 2 3)) (make-iterator "1") #<eof> #r2d((.1 .2) (.3 .4))
+					(dilambda (lambda () 1) (lambda (a) a))
+					(gensym)))
+  
+  (define car-auto-constants (car auto-constants))
+  (define-constant cdr-auto-constants (cdr auto-constants))
+  
+  (define low 0)
+  (define-constant auto-arglists (vector (make-list 1) (make-list 2) (make-list 3) (make-list 4) (make-list 5) (make-list 6)))
+  
+  (define-constant (autotest func args args-now args-left sig)
+    ;; args-left is at least 1, args-now starts at 0, args starts at ()
+    ;; (format *stderr* "~A: ~D ~D (~D ~D): ~A~%" func (length args) args-now low args-left args)
+    ;; (if (pair? args) (format *stderr* "~A " (car args)))
+    
+    (call-with-exit
+     (lambda (quit)
+       (if (>= args-now low)
+	   (catch #t 
+	     (lambda () 
+					;(format *stderr* "args: ~A~%" args)
+	       (apply func args))
+	     (lambda (type info)
+	       (if (and (positive? args-now)
+			(memq type '(wrong-type-arg wrong-number-of-args out-of-range syntax-error io-error
+				     division-by-zero format-error missing-method error invalid-exit-function)))
+		   (quit)))))
+       
+       (let ((c-args (vector-ref auto-arglists args-now)))
+	 (copy args c-args)
+	 
+	 (let ((p (list-tail c-args args-now))
+	       (checker (and (pair? sig) (car sig)))) ; see map-values
+
+	   (if (= args-left 1)
+	       (call-with-exit
+		(lambda (quit)
+		  (set-car! p car-auto-constants)
+		  (catch #t
+		    (lambda ()
+					;(format *stderr* "c-args: ~A~%" c-args)
+		      (apply func c-args))
+		    (lambda (type info)
+		      (if (or (memq type '(wrong-number-of-args out-of-range syntax-error io-error
+					   division-by-zero format-error error missing-method invalid-exit-function))
+			      (and (eq? type 'wrong-type-arg)
+				   (pair? (cdr info))
+				   (pair? (cddr info))
+				   (integer? (caddr info)) ; if just 1 arg, arg num can be omitted
+				   (< (caddr info) low)))
+			  (quit))))
+		  
+		  (if checker
+		      (for-each
+		       (lambda (c)
+			 (when (checker c)
+			   (catch #t 
+			     (lambda () 
+			       (set-car! p c)
+			       (apply func c-args))
+			     (lambda any 'error))))
+		       cdr-auto-constants)
+		      (for-each
+		       (lambda (c)
+			 (catch #t 
+			   (lambda () 
+			     (set-car! p c)
+			     (apply func c-args))
+			   (lambda any 'error)))
+		       cdr-auto-constants))))
+	       
+	       (let ((sig1 (if (pair? sig) (cdr sig) ()))
+		     (c-args1 c-args)
+		     (args-now1 (+ args-now 1))
+		     (args-left1 (- args-left 1)))
+		 (if checker
+		     (for-each
+		      (lambda (c)
+			(when (checker c)
+			  (set-car! p c)
+			  (autotest func c-args1 args-now1 args-left1 sig1)))
+		      auto-constants)
+		     (for-each
+		      (lambda (c)
+			(set-car! p c)
+			(autotest func c-args1 args-now1 args-left1 sig1))
+		      auto-constants)))))))))
+  
+  (define (map-values lst)
+    (do ((lst lst (cdr lst)))
+	((or (not (pair? lst))
+	     (not (car lst))
+	     (procedure? (car lst))) 
+	 lst)
+      (set-car! lst
+		(if (symbol? (car lst))
+		    (symbol->value (car lst))
+		    (and (pair? (car lst))
+			 (apply lambda '(x) (list (list 'or (list (caar lst) 'x) (list (cadar lst) 'x)))))))))
+
+  (define (test-sym sym)
+    (when (and (not (memq sym baddies))
+	       (defined? sym))
+      (let* ((f (symbol->value sym))
+	     (argn (and (or (procedure? f) (let? f)) (arity f))))
+	(if argn
+	    (let ((bottom (car argn))
+		  (top (min (cdr argn) max-args))
+		  (strname (symbol->string sym)))
+	      ;(unless (memv (strname 0) '(#\{ #\[ #\()) ; no longer relevant, setters start with #<, none with {
+		(if (< top bottom)
+		    (format *stderr* ";~A (bottom: ~A, top: ~A)...~%" sym bottom top))
+		(set! low bottom)
+		(if (positive? (cdr argn))
+		    (let ((sig (cond ((eq? sym 'append)
+				      (let ((lst (list 'list?)))
+					(set-cdr! lst lst)))
+				     (else (copy (signature f))))))
+		      (map-values sig)
+		      (autotest f () 0 top (if (pair? sig) (cdr sig) ())))))))));)
+  
+  (define (all)
+    (let ((st (symbol-table)))
+      ;(do ((i 0 (+ i 1))) ((= i 10))
+      (for-each test-sym st)));)
+					;(do ((i 0 (+ i 1)) (len (length st))) ((= i 1000)) (test-sym (st (random len))))
+					;(test-sym 'object->string)
+					;(test-sym 'for-each)
+					;(test-sym 'write)
+  (all))
+
+
+(let ((probes (vector #f #t () #\a #<undefined> #<unspecified> #<eof>
+		      0 1 2/3 1.0 1+i
+		      (list 0)
+		      'a set!
+		      "11" #(1+i 2+i) #i(312 1234) #r(1.5 2.5) #u(1 2) #2i((1 2) (3 4))
+		      (hash-table 'a 1 'b 2)
+		      (inlet 'a 1 'b 2)
+		      (c-pointer 0)
+		      (random-state 1234)
+		      (lambda () 1) (lambda* ((a 21)) (+ a 1))
+		      (macro (a) `(+ ,a 1)) (macro* ((a 32)) `(+ ,a 1)) quasiquote
+		      (bacro (a) `(+ ,a 1)) (bacro* ((a 32)) `(+ ,a 1))
+		      (open-output-string) (open-input-string "1234")
+		      abs + make-hash-table map port-line-number
+		      (call/cc (lambda (c) c)) (call-with-exit (lambda (c) c))
+		      (make-iterator '(1 2 3))))
+      (inputters '(read read-string read-line read-byte read-char))
+      (outputters '(write display write-string write-char write-byte newline))
+      (even-args '(hash-table weak-hash-table)))
+  
+  (define (type-ok probe types)
+    (and (pair? types)
+	 (or (memq (car types) '(#t values))
+	     ((symbol->value (car types)) probe)
+	     (type-ok probe (cdr types)))))
+
+  (define (check sym)
+    (let ((func (symbol->value sym)))
+      (when (and (procedure? func)
+		 (not (memq sym baddies)))
+	(let ((ari (arity func))
+	      (sig (signature func))
+	      (doc (documentation func)))
+	  (unless (or (string=? doc "")
+		      (string-position (symbol->string sym) doc))
+	    (format *stderr* "~A documentation does not mention it: ~S~%" sym doc))
+	  (when (pair? sig)
+	    (let ((res-types (if (pair? (car sig)) (car sig) (list (car sig)))))
+	      
+	      ;; 0 arg
+	      (catch #t
+		(lambda ()
+		  (let ((res (if (memq sym inputters)
+				 (let ((val #f)) (with-input-from-string "1234" (lambda () (set! val (func)))) val)
+				 (if (memq sym outputters)
+				     (let ((val #f)) (with-output-to-string (lambda () (set! val (func)))) val)
+				     (func)))))
+		    (unless (type-ok res res-types)
+		      (format *stderr* "(~A) -> ~S, but ~A is not in ~A~%" sym res (type-of res) res-types))))
+		(lambda (type info)
+		  (let ((errstr (apply format #f info)))
+		    (unless (string-position (symbol->string sym) errstr)
+		      (format *stderr* "(~A) -> ~S~%" sym errstr)))
+		  (when (and (eq? type 'wrong-number-of-args)
+			     (aritable? func 0))
+		    (format *stderr* "(~A) -> arg num error but arity: ~S~%" sym ari))))
+	      
+	      ;; 1 arg
+	      (let ((par1-types (and (pair? (cdr sig)) (if (pair? (cadr sig)) (cadr sig) (list (cadr sig))))))
+		(for-each 
+		 (lambda (probe1)
+		   (catch #t
+		     (lambda ()
+		       (let ((res (if (memq sym inputters)
+				      (let ((val #f)) (with-input-from-string "1234" (lambda () (set! val (func probe1)))) val)
+				      (if (memq sym outputters)
+					  (let ((val #f)) (with-output-to-string (lambda () (set! val (func probe1)))) val)
+					  (func probe1)))))
+			 (unless (type-ok res res-types)
+			   (format *stderr* "(~S ~S) -> ~S, but ~A is not in ~A~%" sym probe1 res (type-of res) res-types))
+			 (unless (type-ok probe1 par1-types)
+			   (format *stderr* "(~S ~S) ok, but ~A is not in ~S~%" sym probe1 (type-of probe1) par1-types)))
+		       
+		       ;; 2 args
+		       (let ((par2-types (and (pair? (cddr sig)) (if (pair? (caddr sig)) (caddr sig) (list (caddr sig))))))
+			 (for-each
+			  (lambda (probe2)
+			    (catch #t
+			      (lambda ()
+				(let ((res (if (memq sym inputters)
+					       (let ((val #f)) (with-input-from-string "1234" (lambda () (set! val (func probe1 probe2)))) val)
+					       (if (memq sym outputters)
+						   (let ((val #f)) (with-output-to-string (lambda () (set! val (func probe1 probe2)))) val)
+						   (func probe1 probe2)))))
+				  (unless (type-ok res res-types)
+				    (format *stderr* "(~S ~S ~S) -> ~S, but ~A is not in ~A~%" sym probe1 probe2 res (type-of res) res-types))
+				  (unless (type-ok probe2 par2-types)
+				    (format *stderr* "(~S ~S ~S) ok, but ~A is not in ~S~%" sym probe1 probe2 (type-of probe2) par2-types)))
+				
+				;; 3 args
+				(let ((par3-types (and (pair? (cdddr sig)) (if (pair? (cadddr sig)) (cadddr sig) (list (cadddr sig))))))
+				  (for-each
+				   (lambda (probe3)
+				     (catch #t
+				       (lambda ()
+					 (let ((res (if (memq sym inputters)
+							(let ((val #f)) (with-input-from-string "1234" (lambda () (set! val (func probe1 probe2 probe3)))) val)
+							(if (memq sym outputters)
+							    (let ((val #f)) (with-output-to-string (lambda () (set! val (func probe1 probe2 probe3)))) val)
+							    (func probe1 probe2 probe3)))))
+					   (unless (type-ok res res-types)
+					     (format *stderr* "(~S ~S ~S ~S) -> ~S, but ~A is not in ~A~%" sym probe1 probe2 probe3 res (type-of res) res-types))
+					   (unless (type-ok probe3 par3-types)
+					     (format *stderr* "(~S ~S ~S ~S) ok, but ~A is not in ~S~%" sym probe1 probe2 probe3 (type-of probe3) par3-types)))
+					 )
+				       (lambda (type info)
+					 (let ((errstr (apply format #f info)))
+					   (unless (string-position (symbol->string sym) errstr)
+					     (format *stderr* "(~S ~S ~S ~S) -> ~S~%" sym probe1 probe2 probe3 errstr)))
+					 (if (and (eq? type 'wrong-type-arg-error)
+						  (type-ok probe3 par3-types))
+					     (format *stderr* "(~S ~S ~S ~S) -> arg type error, but par-types: ~S~%" sym probe1 probe2 probe3 par3-types)
+					     (when (and (eq? type 'wrong-number-of-args)
+							(aritable? func 3))
+					       (format *stderr* "(~S ~S ~S ~S) -> arg num error but arity: ~S~%" sym probe1 probe2 probe3 ari))))))
+				   probes))
+				)
+			      (lambda (type info)
+				(let ((errstr (apply format #f info)))
+				  (unless (string-position (symbol->string sym) errstr)
+				    (format *stderr* "(~S ~S ~S) -> ~S~%" sym probe1 probe2 errstr)))
+				(if (and (eq? type 'wrong-type-arg-error)
+					 (type-ok probe2 par2-types))
+				    (format *stderr* "(~S ~S ~S) -> arg type error, but par-types: ~S~%" sym probe1 probe2 par2-types)
+				    (when (and (eq? type 'wrong-number-of-args)
+					       (aritable? func 2))
+				      (format *stderr* "(~S ~S ~S) -> arg num error but arity: ~S~%" sym probe1 probe2 ari))))))
+			  probes))
+		       )
+		     (lambda (type info)
+		       (let ((errstr (apply format #f info)))
+			 (unless (string-position (symbol->string sym) errstr)
+			   (format *stderr* "(~S ~S) -> ~S~%" func probe1 errstr)))
+		       (if (and (eq? type 'wrong-type-arg-error)
+				(type-ok probe1 par1-types))
+			   (format *stderr* "(~S ~S) -> arg type error, but par-types: ~S~%" sym probe1 par1-types)
+			   (when (and (eq? type 'wrong-number-of-args)
+				      (not (memq sym even-args))
+				      (aritable? func 1)
+				      (not (memq sym '(apply call-with-exit))))
+			     (format *stderr* "(~S ~S) -> arg num error but arity: ~S~%" sym probe1 ari))))))
+		 probes))))))))
+
+  (define (check-funcs)
+    (let ((syms (symbol-table)))
+      (for-each check syms)))
+  
+  (check-funcs))
+
+
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(exit)
diff --git a/s7/tools/tbig.scm b/s7/tools/tbig.scm
new file mode 100644
index 0000000..2ae9f1b
--- /dev/null
+++ b/s7/tools/tbig.scm
@@ -0,0 +1,2420 @@
+;; large structure tests
+
+(require libc.scm)
+
+(set! (*s7* 'max-vector-length) (ash 1 36))
+(set! (*s7* 'max-string-length) (ash 1 36))
+(set! (*s7* 'safety) -1)
+;; setting heap-size slows us down
+
+(define bold-text (format #f "~C[1m" #\escape))
+(define unbold-text (format #f "~C[22m" #\escape))  
+
+(define-macro (test a b)
+  (format *stderr* "~S~%" a)
+  `(if (not (equal? ,a ,b))
+       (format *stderr* "    ~A~S -> ~S?~A~%" bold-text ',a ,a unbold-text)))
+
+(define (clear-and-gc)
+  (let ((x 0+i)) (do ((i 0 (+ i 1))) ((= i 256)) (set! x (complex i i)))) ; clear temps
+  (gc) (gc))
+
+(define total-memory (with-let *libc* (* (sysconf _SC_PHYS_PAGES) (sysconf _SC_PAGESIZE)))) ; not quite what we want, but...
+;; there's no point in overallocating and looking for malloc->null -- malloc doesn't work that way in Linux
+
+(define big-size 2500000000)
+(define fft-size (ash 1 17))
+(define little-size 1000000)
+
+
+;; --------------------------------------------------------------------------------
+(format () "complex fft...~%")
+
+(define (complex-fft data n dir)
+  (when data
+    (do ((i 0 (+ i 1))
+	 (j 0))
+	((= i n))
+      (if (> j i)
+	  (let ((temp (vector-ref data j)))
+	    (vector-set! data j (vector-ref data i))
+	    (vector-set! data i temp)))
+      (let ((m (/ n 2)))
+	(do () 
+	    ((not (<= 2 m j)))
+	  (set! j (- j m))
+	  (set! m (/ m 2)))
+	(set! j (+ j m))))
+    (let ((ipow (floor (log n 2)))
+	  (prev 1))
+      (do ((lg 0 (+ lg 1))
+	   (mmax 2 (* mmax 2))
+	   (pow (/ n 2) (/ pow 2))
+	   (theta (complex 0.0 (* pi dir)) (* theta 0.5)))
+	  ((= lg ipow))
+	(let ((wpc (exp theta))
+	      (wc 1.0)
+	      (tc 0.0))
+	  (do ((ii 0 (+ ii 1)))
+	      ((= ii prev))
+	    (do ((jj 0 (+ jj 1))
+		 (i ii (+ i mmax))
+		 (j (+ ii prev) (+ j mmax)))
+		((>= jj pow))
+	      (set! tc (* wc (vector-ref data j)))
+	      (vector-set! data j (- (vector-ref data i) tc))
+	      (vector-set! data i (+ (vector-ref data i) tc)))
+	    (set! wc (* wc wpc)))
+	  (set! prev mmax))))
+    data))
+
+(define (complex-checker fvr)
+  (when fvr
+    (let ((pk 0.0)
+	  (mx 0.0)
+	  (mxloc 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! pk (magnitude (vector-ref fvr i)))
+	(when (> pk mx)
+	  (set! mx pk)
+	  (set! mxloc i)))
+      (format () "~A ~A~%" mxloc (/ (* 2 (sqrt mx)) fft-size))
+      (format () "~A ~A~%" (magnitude (fvr 4)) (magnitude (fvr (- fft-size 4)))))
+    (vector-set! fvr 4 0.0)
+    (vector-set! fvr (- fft-size 4) 0.0)
+    (let ((mx 0.0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! mx (max mx (magnitude (vector-ref fvr i)))))
+      (format () "noise: ~A~%" mx))))
+
+(define (complex-test)
+  (let ((fvr (make-vector fft-size 0.0 complex?))
+	(scl (/ (* 8.0 pi) fft-size)))
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x scl)))
+	((= i fft-size))
+      (vector-set! fvr i (sin x)))
+    (complex-fft fvr fft-size 1)
+    (complex-checker fvr)
+    (complex-fft #f 0 0)
+    (complex-checker #f)))
+(complex-test)
+(clear-and-gc)
+
+
+;; --------------------------------------------------------------------------------
+(format () "ratio fft...~%")
+
+(define (ratio-fft rl im n dir)
+  (when rl
+    (do ((i 0 (+ i 1))
+	 (j 0))
+	((= i n))
+      (if (> j i)
+	  (let ((tempr (vector-ref rl j))
+		(tempi (vector-ref im j)))
+	    (vector-set! rl j (vector-ref rl i))
+	    (vector-set! im j (vector-ref im i))
+	    (vector-set! rl i tempr)
+	    (vector-set! im i tempi)))
+      (let ((m (/ n 2)))
+	(do () 
+	    ((not (<= 2 m j)))
+	  (set! j (- j m))
+	  (set! m (/ m 2)))
+	(set! j (+ j m))))
+    (let ((ipow (floor (log n 2)))
+	  (prev 1))
+      (do ((lg 0 (+ lg 1))
+	   (mmax 2 (* mmax 2))
+	   (pow (/ n 2) (/ pow 2))
+	   (theta (rationalize (* pi dir)) (* theta 0.5)))
+	  ((= lg ipow))
+	(let ((wpr (rationalize (cos theta)))
+	      (wpi (rationalize (sin theta)))
+	      (wr 1)
+	      (wi 0))
+	  (do ((ii 0 (+ ii 1)))
+	      ((= ii prev))
+	    (do ((tempr 0)
+		 (tempi 0)
+		 (jj 0 (+ jj 1))
+		 (i ii (+ i mmax))
+		 (j (+ ii prev) (+ j mmax)))
+		((>= jj pow))
+	      (set! tempr (rationalize (- (* wr (vector-ref rl j)) (* wi (vector-ref im j)))))
+	      (set! tempi (rationalize (+ (* wr (vector-ref im j)) (* wi (vector-ref rl j)))))
+	      (vector-set! rl j (rationalize (- (vector-ref rl i) tempr)))
+	      (vector-set! rl i (rationalize (+ (vector-ref rl i) tempr)))
+	      (vector-set! im j (rationalize (- (vector-ref im i) tempi)))
+	      (vector-set! im i (rationalize (+ (vector-ref im i) tempi))))
+	    (let ((wtemp wr))
+	      (set! wr (rationalize (- (* wr wpr) (* wi wpi))))
+	      (set! wi (rationalize (+ (* wi wpr) (* wtemp wpi))))))
+	  (set! prev mmax))))
+    rl))
+
+(define (ratio-checker fvr fvi)
+  (when fvr
+    (let ((vr 0.0)
+	  (vi 0.0)
+	  (pk 0.0)
+	  (mx 0.0)
+	  (mxloc 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! vr (fvr i))
+	(set! vi (fvi i))
+	(set! pk (+ (* vr vr) (* vi vi)))
+	(when (> pk mx)
+	  (set! mx pk)
+	  (set! mxloc i)))
+      (format () "~A ~A~%" mxloc (/ (* 2 (sqrt mx)) fft-size))
+      (format () "~A ~A~%" (* 1.0 (fvi 4)) (* 1.0 (fvi (- fft-size 4)))))
+    (set! (fvr 4) 0)
+    (set! (fvi 4) 0)
+    (set! (fvr (- fft-size 4)) 0)
+    (set! (fvi (- fft-size 4)) 0)
+    (let ((mx 0.0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! mx (max mx (abs (vector-ref fvr i)) (abs (vector-ref fvi i)))))
+      (format () "noise: ~A~%" (* 1.0 mx)))))
+
+(define (ratio-test)
+  (let ((fvr (make-vector fft-size 0 rational?))
+	(fvi (make-vector fft-size 0 rational?))
+	(scl (/ (* 8.0 pi) fft-size)))
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x scl)))
+	((= i fft-size))
+      (vector-set! fvr i (rationalize (sin x))))
+    (ratio-fft fvr fvi fft-size 1)
+    (ratio-checker fvr fvi)
+    (ratio-fft #f #f fft-size 1)
+    (ratio-checker #f #f)))
+
+(ratio-test)
+(clear-and-gc)
+
+
+;; --------------------------------------------------------------------------------
+(format () "strings...~%")
+
+(when (> total-memory (* 4 big-size))
+  (clear-and-gc)
+  (let ((bigstr (make-string big-size)))
+    (define (big-string-filler)
+      ;(fill! bigstr #\null 0 big-size))
+      (do ((i 0 (+ i 1)))
+	  ((= i big-size))
+	(string-set! bigstr i #\null)))
+    (test (length bigstr) big-size)
+    (string-set! bigstr (- big-size 10000000) #\a)
+    (test (string-ref bigstr (- big-size 10000000)) #\a)
+    (set! bigstr (reverse! bigstr))
+    (test (string-ref bigstr (- 10000000 1)) #\a)
+    (fill! bigstr #\b)
+    (test (string-ref bigstr (- big-size 10000000)) #\b)
+    (test (char-position #\a bigstr) #f)
+    (do ((i (- (ash 1 31) 10) (+ i 1)))
+	((= i (+ (ash 1 31) 10)))
+      (string-set! bigstr i #\c))
+    (test (string-ref bigstr (ash 1 31)) #\c)
+    (do ((i (- (ash 1 31) 10) (+ i 1)))
+	((= i (+ (ash 1 31) 10)))
+      (set! (bigstr i) #\d))
+    (test (bigstr (ash 1 31)) #\d)
+    (let-temporarily (((*s7* 'print-length) 100))
+      (let ((big1 (copy bigstr)))
+	(test (equal? big1 bigstr) #t)
+	(test (string=? big1 bigstr) #t)
+	(test (string>? big1 bigstr) #f)
+					;(test (string-ci<=? big1 bigstr) #t)
+	(test (equivalent? big1 bigstr) #t)
+	(set! (big1 (- big-size 1)) #\f)
+	(test (equal? big1 bigstr) #f)
+	(test (string=? big1 bigstr) #f)
+	(test (equivalent? big1 bigstr) #f)
+	(let ((big2 (substring big1 (- (ash 1 31) 10) (+ (ash 1 31) 10))))
+	  (test big2 "dddddddddddddddddddd")
+	  (test (length big2) 20)
+	  (let ((big3 (make-string 20)))
+	    (copy bigstr big3 (- (ash 1 31) 10) (+ (ash 1 31) 10))
+	    (test (string=? big2 big3) #t)))))
+    (let ((p (call-with-output-string 
+	      (lambda (p)
+		(write-string bigstr p (- (ash 1 31) 10) (+ (ash 1 31) 10))))))
+      (test (length p) 20)
+      (test p "dddddddddddddddddddd"))
+    (big-string-filler)
+    ; -- why the do loop? (fill! bigstr #\null 0 big-size)
+    (let ((bv (string->byte-vector bigstr)))
+      (test (byte-vector? bv) #t)
+      (test (length bv) (length bigstr))
+      (let ((bvi (byte-vector-ref bv (- (ash 1 31) 100))))
+      (test bvi (char->integer (string-ref (byte-vector->string bv) (- (ash 1 31) 100)))))))
+  
+  (clear-and-gc)
+  (let ((size little-size))
+    (let ((vs (make-vector size)))
+      (let ((strs (make-vector 256)))
+	(do ((i 0 (+ i 1)))
+	    ((= i 256))
+	  (vector-set! strs i (make-string 200 (integer->char i))))
+	(define (string-sorter)
+	  (do ((i 0 (+ i 1)))
+	      ((= i size))
+	    (vector-set! vs i (copy (vector-ref strs (logand i #xff)) (make-string (+ 1 (random 200)))))))
+	(string-sorter)
+	(set! strs #f))
+      (sort! vs string<?)
+      (define (string-checker)
+	(do ((i 1 (+ i 1))
+	     (j 0 (+ j 1)))
+	    ((= i size))
+	  (if (string>? (vector-ref vs j) (vector-ref vs i))
+	      (display "oops"))))
+      (string-checker)
+      (fill! vs #f)))
+  
+  (clear-and-gc)
+  (let ((size little-size))
+    (let ((str (make-string size)))
+      (define (string-filler)
+	(do ((i 0 (+ i 1)))
+	    ((= i size))
+	  (string-set! str i #\a)))
+      (string-filler)
+      (let ((str1 (make-string size)))
+	(define (string-writer)
+	  (do ((i 0 (+ i 1))
+	       (j (integer->char (random 256)) (integer->char (random 256))))
+	      ((= i size))
+	    (string-set! str i (string-ref (make-string (+ 1 (random 200)) j) 0))
+	    (string-set! str1 i j)))
+	(string-writer)
+	(test (string=? str str1) #t))))
+  
+  (clear-and-gc)
+  (let ((bigstr (make-string (* 2 big-size))))
+    (test (length bigstr) (* 2 big-size))
+    (string-set! bigstr (- big-size 10000000) #\a)
+    (test (string-ref bigstr (- big-size 10000000)) #\a)
+    (do ((i (- (ash 1 32) 10) (+ i 1)))
+	((= i (+ (ash 1 32) 10)))
+      (string-set! bigstr i #\e))
+    (test (string-ref bigstr (ash 1 32)) #\e))
+  
+  (clear-and-gc)
+  (let ((rdstr (call-with-input-string (make-string big-size #\null)
+		 (lambda (p)
+		   (read-string (- big-size 10000000) p)))))
+    (test (length rdstr) (- big-size 10000000))
+    (test (string-ref rdstr 0) #\null))
+  (clear-and-gc)
+  (let ((wrtstr (call-with-output-string
+		 (lambda (p)
+		   (do ((i 0 (+ i 1)))
+		       ((>= i 25))
+		     (write-string (make-string 100000000 (integer->char (+ 32 i))) p))))))
+    (do ((i 0 (+ i 100000000))
+	 (j 0 (+ j 1)))
+	((>= i big-size))
+      (if (not (char=? (string-ref wrtstr i) (integer->char (+ 32 j))))
+	  (format () "~D: ~C (~C)~%" i (string-ref wrstr i) (integer->char (+ 32 j)))))))
+
+(when (> total-memory (* 4 big-size))
+  (clear-and-gc)
+  (let ((bigstr1 (make-string big-size #\+))
+	(bigstr2 (make-string big-size #\-)))
+    (let ((bigstr3 (append bigstr1 bigstr2)))
+      (test (length bigstr3) (* 2 big-size))
+      (test (string-ref bigstr3 (- big-size 1)) #\+)
+      (test (string-ref bigstr3 (+ big-size 1)) #\-)
+      (test (char-position #\- bigstr3) big-size))))
+(clear-and-gc)
+
+(let-temporarily (((*s7* 'max-format-length) (+ big-size 1)))
+  (let ((x (format #f "~NC" big-size #\a))) 
+    (test (length x) big-size)
+    (test (string-ref x 1000000) #\a)))
+
+(clear-and-gc)
+
+
+;; --------------------------------------------------------------------------------
+(format () "~%byte-vectors...~%")
+
+(when (> total-memory (* 4 big-size))
+  (let ((bigstr (make-byte-vector big-size)))
+    (test (length bigstr) big-size)
+    (byte-vector-set! bigstr (- big-size 10000000) 65)
+    (test (byte-vector-ref bigstr (- big-size 10000000)) 65)
+    (set! bigstr (reverse! bigstr))
+    (test (byte-vector-ref bigstr (- 10000000 1)) 65)
+    (fill! bigstr 66)
+    (test (byte-vector-ref bigstr (- big-size 10000000)) 66))
+  
+  (clear-and-gc)
+  (let ((size little-size))
+    (let ((vs (make-byte-vector size)))
+      (define (byte-vector-sorter)
+	(do ((i 0 (+ i 1)))
+	    ((= i size))
+	  (byte-vector-set! vs i (random 256))))
+      (byte-vector-sorter)
+      (sort! vs <)
+      (define (byte-vector-checker)
+ 	(let ((vj (byte-vector-ref vs 0)))
+ 	  (for-each
+ 	   (lambda (vi)
+ 	     (if (> vj vi) (display "oops"))
+ 	     (set! vj vi))
+ 	   (subvector vs 1 size))))
+      (byte-vector-checker)))
+  
+  (clear-and-gc)
+  (let ((size little-size))
+    (let ((str (make-byte-vector size)))
+      (define (byte-vector-filler)
+	(do ((i 0 (+ i 1)))
+	    ((= i size))
+	  (byte-vector-set! str i 65)))
+      (byte-vector-filler)
+      (let ((str1 (make-byte-vector size)))
+	(define (byte-vector-writer)
+	  (do ((i 0 (+ i 1))
+	       (j (random 256) (random 256)))
+	      ((= i size))
+	    (byte-vector-set! str i (byte-vector-ref (make-byte-vector (+ 1 (random 200)) j) 0))
+	    (byte-vector-set! str1 i j)))
+	(byte-vector-writer)
+	(test (equal? str str1) #t)))))
+
+
+;; --------------------------------------------------------------------------------
+(format () "~%float-vectors...~%")
+
+(when (> total-memory (* 18 big-size))
+  (format () "test 1~%")
+  (clear-and-gc)
+  (let ((bigfv (make-float-vector big-size 0.5)))
+    (let-temporarily (((*s7* 'print-length) 100))
+      (let ((big1 (copy bigfv)))
+	(test (equivalent? big1 bigfv) #t)
+	(set! (big1 (- big-size 1)) 0.25)
+	(test (equivalent? big1 bigfv) #f)
+	(let ((big2 (subvector big1 (- (ash 1 31) 10) (+ (ash 1 31) 10))))
+	  (test big2 (make-float-vector 20 0.5))
+	  (test (length big2) 20)
+	  (let ((big3 (make-float-vector 20 0.0)))
+	    (copy bigfv big3 (- (ash 1 31) 10) (+ (ash 1 31) 10))
+	    (test (equivalent? big2 big3) #t)))))
+
+    (define (big-float-vector-filler)
+      (do ((i 0 (+ i 1)))
+	  ((= i big-size))
+	(float-vector-set! bigfv i 1.0)))
+
+    (big-float-vector-filler)
+    (test (bigfv 1) 1.0)))
+
+(when (> total-memory (* 16 little-size))
+  (format () "test 2~%")
+  (clear-and-gc)
+  (let ((size little-size))
+    (let ((vs (make-float-vector size)))
+      (define (float-vector-sorter)
+	(do ((i 0 (+ i 1)))
+	    ((= i size))
+	  (float-vector-set! vs i (float-vector-ref (make-float-vector (+ 1 (random 200)) (random 100.0)) 0))))
+      (float-vector-sorter)
+      (sort! vs <)
+      (define (float-vector-checker)
+ 	(let ((vj (float-vector-ref vs 0)))
+ 	  (for-each
+ 	   (lambda (vi)
+ 	     (if (> vj vi) (display "oops"))
+ 	     (set! vj vi))
+ 	   (subvector vs 1 size))))
+      (float-vector-checker)))
+  
+  (clear-and-gc)
+  (let ((size little-size))
+    (let ((str (make-float-vector size)))
+      (define (float-vector-filler)
+	(do ((i 0 (+ i 1)))
+	    ((= i size))
+	  (float-vector-set! str i 5.0)))
+      (float-vector-filler)
+      (let ((str1 (make-float-vector size)))
+	(define (float-vector-writer)
+	  (do ((i 0 (+ i 1))
+	       (j (random 100.0) (random 100.0)))
+	      ((= i size))
+	    (float-vector-set! str i (float-vector-ref (make-float-vector (+ 1 (random 200)) j) 0))
+	    (float-vector-set! str1 i j)))
+	(float-vector-writer)
+	(test (equivalent? str str1) #t)))))
+
+(when (> total-memory (* 16 big-size))
+  (format () "test 3~%")
+  (clear-and-gc)
+  (let ((bigfv1 (make-float-vector (/ big-size 2) 1.0))
+	(bigfv2 (make-float-vector (/ big-size 2) 2.0)))
+    (let ((bigfv3 (append bigfv1 bigfv2)))
+      (test (length bigfv3) big-size)
+      (test (float-vector-ref bigfv3 (- (/ big-size 2) 1)) 1.0)
+      (test (float-vector-ref bigfv3 (+ (/ big-size 2) 1)) 2.0))))
+
+(when (> total-memory (* 32 big-size))
+  (format () "test 3a~%")
+  (clear-and-gc)
+  (let ((bigfv1 (make-float-vector (list 2 (/ big-size 2)) 1.0))
+	(bigfv2 (make-float-vector (list 2 (/ big-size 2)) 2.0)))
+    (test (float-vector-ref bigfv1 0 (- (/ big-size 2) 1)) 1.0)
+    (test (float-vector-ref bigfv2 1 (- (/ big-size 2) 1)) 2.0)
+    (let ((bigfv3 (append bigfv1 bigfv2)))
+      (test (length bigfv3) (* 2 big-size))
+      (test (float-vector-ref bigfv3 (- big-size 1)) 1.0)
+      (test (float-vector-ref bigfv3 (+ big-size 1)) 2.0))))
+
+(when (> total-memory (* 32 big-size))
+  (format () "test 3b~%")
+  (clear-and-gc)
+  (let ((bigfv1 (make-float-vector (* big-size 2) 1.0))
+	(bigfv2 (make-float-vector (* big-size 2) 2.0)))
+    (test (float-vector-ref bigfv1 (- (/ big-size 2) 1)) 1.0)
+    (test (float-vector-ref bigfv2 (- (/ big-size 2) 1)) 2.0)
+    (define (f-loop)
+      (do ((i (- (ash 1 32) 10) (+ i 1))
+	   (j 0 (+ j 1)))
+	  ((= i (+ (ash 1 32) 10)))
+	(set! (bigfv1 i) j)
+	(set! (bigfv2 i) (* (bigfv1 i) 2))))
+    (f-loop)
+    (test (subvector bigfv1 (- (ash 1 32) 10) (+ (ash 1 32) 10))
+	  (float-vector 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19))
+    (test (subvector bigfv2 (- (ash 1 32) 10) (+ (ash 1 32) 10))
+	  (float-vector 0 2 4 6 8 10 12 14 16 18 20 22 24 26 28 30 32 34 36 38))
+    (test (subvector bigfv1 (+ (ash 1 32) 5) (+ (ash 1 32) 10))
+	  (float-vector 15 16 17 18 19))))
+
+(when (> total-memory (* 9 big-size))
+  (format () "test 4~%")
+  (clear-and-gc)
+  (let ((bigfv (make-float-vector big-size)))
+    (test (length bigfv) big-size)
+    (float-vector-set! bigfv (- big-size 10000000) 1.0)
+    (test (float-vector-ref bigfv (- big-size 10000000)) 1.0)
+    (reverse! bigfv)
+    (test (float-vector-ref bigfv (- 10000000 1)) 1.0)
+    (fill! bigfv 0.0)
+    (test (bigfv (- big-size 10000000)) 0.0)
+    (do ((i (- (ash 1 31) 10) (+ i 1)))
+	((= i (+ (ash 1 31) 10)))
+      (float-vector-set! bigfv i 2.0))
+    (test (float-vector-ref bigfv (ash 1 31)) 2.0)
+    (do ((i (- (ash 1 31) 10) (+ i 1)))
+	((= i (+ (ash 1 31) 10)))
+      (set! (bigfv i) pi))
+    (test (equivalent? (bigfv (ash 1 31)) pi) #t)) ; pi might be bignum
+  (clear-and-gc))
+
+(define (float-vector-fft rl im n dir)
+  (when rl
+    (let ((tempr 0.0)
+	  (tempi 0.0)
+	  (m 0)
+	  (j 0)
+	  (ipw (floor (log n 2)))
+	  (prev 1)
+	  (wtemp 0.0)
+	  (wpr 0.0)
+	  (wpi 0.0)
+	  (wr 0.0)
+	  (wi 0.0)
+	  (mmax 2)
+	  (pw (/ n 2))
+	  (end 0)
+	  (theta (* pi dir)))
+      (do ((i 0 (+ i 1)))
+	  ((= i n))
+	(when (> j i)
+	  (set! tempr (float-vector-ref rl j))
+	  (set! tempi (float-vector-ref im j))
+	  (float-vector-set! rl j (float-vector-ref rl i))
+	  (float-vector-set! im j (float-vector-ref im i))
+	  (float-vector-set! rl i tempr)
+	  (float-vector-set! im i tempi))
+	(set! m (quotient n 2))
+	(do () 
+	    ((not (<= 2 m j)))
+	  (set! j (- j m))
+	  (set! m (quotient m 2)))
+	(set! j (+ j m)))
+      
+      (do ((lg 0 (+ lg 1)))
+	  ((= lg ipw))
+	(set! wpr (cos theta))
+	(set! wpi (sin theta))
+	(set! wr 1.0)
+	(set! wi 0.0)
+	(do ((ii 0 (+ ii 1)))
+	    ((= ii prev))
+	  (set! j (+ ii prev))
+	  (set! end (+ ii (* pw mmax)))
+	  (do ((i ii (+ i mmax)))
+	      ((= i end))
+	    (set! tempr (- (* wr (float-vector-ref rl j)) (* wi (float-vector-ref im j))))
+	    (set! tempi (+ (* wr (float-vector-ref im j)) (* wi (float-vector-ref rl j))))
+	    (float-vector-set! rl j (- (float-vector-ref rl i) tempr))
+	    (float-vector-set! rl i (+ (float-vector-ref rl i) tempr))
+	    (float-vector-set! im j (- (float-vector-ref im i) tempi))
+	    (float-vector-set! im i (+ (float-vector-ref im i) tempi))
+	    (set! j (+ j mmax)))
+	  (set! wtemp wr)
+	  (set! wr (- (* wr wpr) (* wi wpi)))
+	  (set! wi (+ (* wi wpr) (* wtemp wpi))))
+	(set! prev mmax)
+	(set! mmax (* mmax 2))
+	(set! pw (quotient pw 2))
+	(set! theta (* theta 0.5)))
+      rl)))
+
+(define (float-vector-checker fvr fvi)
+  (when fvr
+    (let ((vr 0.0)
+	  (vi 0.0)
+	  (pk 0.0)
+	  (mx 0.0)
+	  (mxloc 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! vr (float-vector-ref fvr i))
+	(set! vi (float-vector-ref fvi i))
+	(set! pk (+ (* vr vr) (* vi vi)))
+	(when (> pk mx)
+	  (set! mx pk)
+	  (set! mxloc i)))
+      (format () "~A ~A~%" mxloc (/ (* 2 (sqrt mx)) fft-size))
+      (format () "~A ~A~%" (fvi 4) (fvi (- fft-size 4))))
+    (float-vector-set! fvr 4 0.0)
+    (float-vector-set! fvi 4 0.0)
+    (float-vector-set! fvr (- fft-size 4) 0.0)
+    (float-vector-set! fvi (- fft-size 4) 0.0)
+    (let ((mx 0.0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! mx (max mx (abs (float-vector-ref fvr i)) (abs (float-vector-ref fvi i)))))
+      (format () "noise: ~A~%" mx))))
+
+(define (float-vector-test)
+  (let ((fvr (make-float-vector fft-size))
+	(fvi (make-float-vector fft-size 0.0))
+	(scl (/ (* 8.0 pi) fft-size)))
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x scl)))
+	((= i fft-size))
+      (float-vector-set! fvr i (sin x)))
+    (float-vector-fft fvr fvi fft-size 1)
+    (float-vector-checker fvr fvi)
+    (float-vector-fft #f #f fft-size 1)
+    (float-vector-checker #f #f)))
+
+(float-vector-test)
+(clear-and-gc)
+
+(define (float-2d-fft rl n dir)
+  (when rl
+    (let ((tempr 0.0)
+	  (tempi 0.0)
+	  (m 0)
+	  (j 0)
+	  (ipw (floor (log n 2)))
+	  (prev 1)
+	  (wtemp 0.0)
+	  (wpr 0.0)
+	  (wpi 0.0)
+	  (wr 0.0)
+	  (wi 0.0)
+	  (mmax 2)
+	  (pw (/ n 2))
+	  (end 0)
+	  (theta (* pi dir)))
+      (do ((i 0 (+ i 1)))
+	  ((= i n))
+	(when (> j i)
+	  (set! tempr (float-vector-ref rl 0 j))
+	  (set! tempi (float-vector-ref rl 1 j))
+	  (float-vector-set! rl 0 j (float-vector-ref rl 0 i))
+	  (float-vector-set! rl 1 j (float-vector-ref rl 1 i))
+	  (float-vector-set! rl 0 i tempr)
+	  (float-vector-set! rl 1 i tempi))
+	(set! m (quotient n 2))
+	(do () 
+	    ((not (<= 2 m j)))
+	  (set! j (- j m))
+	  (set! m (quotient m 2)))
+	(set! j (+ j m)))
+      
+      (do ((lg 0 (+ lg 1)))
+	  ((= lg ipw))
+	(set! wpr (cos theta))
+	(set! wpi (sin theta))
+	(set! wr 1.0)
+	(set! wi 0.0)
+	(do ((ii 0 (+ ii 1)))
+	    ((= ii prev))
+	  (set! j (+ ii prev))
+	  (set! end (+ ii (* pw mmax)))
+	  (do ((i ii (+ i mmax)))
+	      ((= i end))
+	    (set! tempr (- (* wr (float-vector-ref rl 0 j)) (* wi (float-vector-ref rl 1 j))))
+	    (set! tempi (+ (* wr (float-vector-ref rl 1 j)) (* wi (float-vector-ref rl 0 j))))
+	    (float-vector-set! rl 0 j (- (float-vector-ref rl 0 i) tempr))
+	    (float-vector-set! rl 0 i (+ (float-vector-ref rl 0 i) tempr))
+	    (float-vector-set! rl 1 j (- (float-vector-ref rl 1 i) tempi))
+	    (float-vector-set! rl 1 i (+ (float-vector-ref rl 1 i) tempi))
+	    (set! j (+ j mmax)))
+	  (set! wtemp wr)
+	  (set! wr (- (* wr wpr) (* wi wpi)))
+	  (set! wi (+ (* wi wpr) (* wtemp wpi))))
+	(set! prev mmax)
+	(set! mmax (* mmax 2))
+	(set! pw (quotient pw 2))
+	(set! theta (* theta 0.5)))
+      rl)))
+
+(define (float-2d-checker fvr)
+  (when fvr
+    (let ((vr 0.0)
+	  (vi 0.0)
+	  (pk 0.0)
+	  (mx 0.0)
+	  (mxloc 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! vr (float-vector-ref fvr 0 i))
+	(set! vi (float-vector-ref fvr 1 i))
+	(set! pk (+ (* vr vr) (* vi vi)))
+	(when (> pk mx)
+	  (set! mx pk)
+	  (set! mxloc i)))
+      (format () "~A ~A~%" mxloc (/ (* 2 (sqrt mx)) fft-size))
+      (format () "~A ~A~%" (fvr 1 4) (fvr 1 (- fft-size 4))))
+    (float-vector-set! fvr 0 4 0.0)
+    (float-vector-set! fvr 1 4 0.0)
+    (float-vector-set! fvr 0 (- fft-size 4) 0.0)
+    (float-vector-set! fvr 1 (- fft-size 4) 0.0)
+    (let ((mx 0.0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! mx (max mx (abs (float-vector-ref fvr 0 i)) (abs (float-vector-ref fvr 1 i)))))
+      (format () "noise: ~A~%" mx))))
+
+(define (float-2d-test skip)
+  (format *stderr* "float-2d ~A~%" skip)
+  (let ((fvr (make-float-vector (list skip fft-size) 0.0))
+	(scl (/ (* 8.0 pi) fft-size)))
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x scl)))
+	((= i fft-size))
+      (float-vector-set! fvr 0 i (sin x)))
+    (float-2d-fft fvr fft-size 1)
+    (float-2d-checker fvr)
+    (float-2d-fft #f fft-size 1)
+    (float-2d-checker #f)))
+
+(float-2d-test 2)
+(clear-and-gc)
+(let-temporarily ((fft-size 32))
+  (float-2d-test 2))
+
+;; now try a big float-vector, but same size fft
+(when (> total-memory (* 9 (ash 1 31)))
+  (float-2d-test (ash 1 14))) ; fft-size (ash 1 17) -> (* 8 (ash 1 31))
+(let-temporarily ((fft-size 32))
+  (float-2d-test 2))
+(clear-and-gc)
+
+
+;; --------------------------------------------------------------------------------
+(format () "~%int-vectors...~%")  
+
+(when (> total-memory (* 18 big-size))
+  (format () "test 1~%")
+  (clear-and-gc)
+  (let ((bigfv (make-int-vector big-size 5)))
+    (let-temporarily (((*s7* 'print-length) 100))
+      (let ((big1 (copy bigfv)))
+	(test (equivalent? big1 bigfv) #t)
+	(set! (big1 (- big-size 1)) 25)
+	(test (equivalent? big1 bigfv) #f)
+	(let ((big2 (subvector big1 (- (ash 1 31) 10) (+ (ash 1 31) 10))))
+	  (test big2 (make-int-vector 20 5))
+	  (test (length big2) 20)
+	  (let ((big3 (make-int-vector 20 0)))
+	    (copy bigfv big3 (- (ash 1 31) 10) (+ (ash 1 31) 10))
+	    (test (equivalent? big2 big3) #t)))))
+    (define (big-int-vector-filler)
+      (do ((i 0 (+ i 1)))
+	  ((= i big-size))
+	(int-vector-set! bigfv i 1)))
+    (big-int-vector-filler)
+    (test (bigfv 1) 1)))
+
+(when (> total-memory (* 16 little-size))
+  (format () "test 2~%")
+  (clear-and-gc)
+  (let ((size little-size))
+    (let ((vs (make-int-vector size)))
+      (define (int-vector-sorter)
+	(do ((i 0 (+ i 1)))
+	    ((= i size))
+	  (int-vector-set! vs i (int-vector-ref (make-int-vector (+ 1 (random 200)) (random 100)) 0))))
+      (int-vector-sorter)
+      (sort! vs <)
+      (define (int-vector-checker)
+ 	(let ((vj (int-vector-ref vs 0)))
+ 	  (for-each
+ 	   (lambda (vi)
+ 	     (if (> vj vi) (display "oops"))
+ 	     (set! vj vi))
+ 	   (subvector vs 1 size))))
+      (int-vector-checker)))
+  (sort! '(1 2 3) <) ; clear temp3...
+  (clear-and-gc)
+  
+  (clear-and-gc)
+  (let ((size little-size))
+    (let ((str (make-int-vector size)))
+      (define (int-vector-filler)
+	(do ((i 0 (+ i 1)))
+	    ((= i size))
+	  (int-vector-set! str i 5)))
+      (int-vector-filler)
+      (let ((str1 (make-int-vector size)))
+	(define (int-vector-writer)
+	  (do ((i 0 (+ i 1))
+	       (j (random 100) (random 100)))
+	      ((= i size))
+	    (int-vector-set! str i (int-vector-ref (make-int-vector (+ 1 (random 200)) j) 0))
+	    (int-vector-set! str1 i j)))
+	(int-vector-writer)
+	(test (equivalent? str str1) #t)))))
+(clear-and-gc)
+
+(when (> total-memory (* 16 big-size))
+  (format () "test 3~%")
+  (clear-and-gc)
+  (let ((bigfv1 (make-int-vector (/ big-size 2) 1))
+	(bigfv2 (make-int-vector (/ big-size 2) 2)))
+    (let ((bigfv3 (append bigfv1 bigfv2)))
+      (test (length bigfv3) big-size)
+      (test (int-vector-ref bigfv3 (- (/ big-size 2) 1)) 1)
+      (test (int-vector-ref bigfv3 (+ (/ big-size 2) 1)) 2))))
+
+(when (> total-memory (* 9 big-size))
+  (format () "test 4~%")
+  (clear-and-gc)
+  (let ((bigfv (make-int-vector big-size)))
+    (test (length bigfv) big-size)
+    (int-vector-set! bigfv (- big-size 10000000) 1)
+    (test (int-vector-ref bigfv (- big-size 10000000)) 1)
+    (reverse! bigfv)
+    (test (int-vector-ref bigfv (- 10000000 1)) 1)
+    (fill! bigfv 0)
+    (test (bigfv (- big-size 10000000)) 0)
+    (do ((i (- (ash 1 31) 10) (+ i 1)))
+	((= i (+ (ash 1 31) 10)))
+      (int-vector-set! bigfv i 2))
+    (test (int-vector-ref bigfv (ash 1 31)) 2)
+    (do ((i (- (ash 1 31) 10) (+ i 1)))
+	((= i (+ (ash 1 31) 10)))
+      (set! (bigfv i) 3))
+    (test (bigfv (ash 1 31)) 3))
+  (clear-and-gc))
+
+
+(define (int-vector-fft rl im n dir)
+  (when rl
+    (let ((tempr 0.0)
+	  (tempi 0.0)
+	  (tr 0)
+	  (ti 0)
+	  (m 0)
+	  (j 0)
+	  (ipw (floor (log n 2)))
+	  (prev 1)
+	  (wtemp 0.0)
+	  (wpr 0.0)
+	  (wpi 0.0)
+	  (wr 0.0)
+	  (wi 0.0)
+	  (mmax 2)
+	  (pw (/ n 2))
+	  (end 0)
+	  (theta (* pi dir)))
+      (do ((i 0 (+ i 1)))
+	  ((= i n))
+	(when (> j i)
+	  (set! tr (int-vector-ref rl j))
+	  (set! ti (int-vector-ref im j))
+	  (int-vector-set! rl j (int-vector-ref rl i))
+	  (int-vector-set! im j (int-vector-ref im i))
+	  (int-vector-set! rl i tr)
+	  (int-vector-set! im i ti))
+	(set! m (quotient n 2))
+	(do () 
+	    ((not (<= 2 m j)))
+	  (set! j (- j m))
+	  (set! m (quotient m 2)))
+	(set! j (+ j m)))
+      
+      (do ((lg 0 (+ lg 1)))
+	  ((= lg ipw))
+	(set! wpr (cos theta))
+	(set! wpi (sin theta))
+	(set! wr 1.0)
+	(set! wi 0.0)
+	(do ((ii 0 (+ ii 1)))
+	    ((= ii prev))
+	  (set! j (+ ii prev))
+	  (set! end (+ ii (* pw mmax)))
+	  (do ((i ii (+ i mmax)))
+	      ((= i end))
+	    (set! tempr (- (* wr (int-vector-ref rl j)) (* wi (int-vector-ref im j))))
+	    (set! tempi (+ (* wr (int-vector-ref im j)) (* wi (int-vector-ref rl j))))
+	    (int-vector-set! rl j (round (- (int-vector-ref rl i) tempr)))
+	    (int-vector-set! rl i (round (+ (int-vector-ref rl i) tempr)))
+	    (int-vector-set! im j (round (- (int-vector-ref im i) tempi)))
+	    (int-vector-set! im i (round (+ (int-vector-ref im i) tempi)))
+	    (set! j (+ j mmax)))
+	  (set! wtemp wr)
+	  (set! wr (- (* wr wpr) (* wi wpi)))
+	  (set! wi (+ (* wi wpr) (* wtemp wpi))))
+	(set! prev mmax)
+	(set! mmax (* mmax 2))
+	(set! pw (quotient pw 2))
+	(set! theta (* theta 0.5)))
+      rl)))
+
+(define (int-vector-checker fvr fvi)
+  (when fvr
+    (let ((vr 0)
+	  (vi 0)
+	  (pk 0)
+	  (mx 0)
+	  (mxloc 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! vr (int-vector-ref fvr i))
+	(set! vi (int-vector-ref fvi i))
+	(set! pk (+ (* vr vr) (* vi vi)))
+	(when (> pk mx)
+	  (set! mx pk)
+	  (set! mxloc i)))
+      (format () "~A ~A~%" mxloc (/ (* 2 (sqrt mx)) fft-size))
+      (format () "~A ~A~%" (fvi 4) (fvi (- fft-size 4))))
+    (int-vector-set! fvr 4 0)
+    (int-vector-set! fvi 4 0)
+    (int-vector-set! fvr (- fft-size 4) 0)
+    (int-vector-set! fvi (- fft-size 4) 0)
+    (let ((mx 0.0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! mx (max mx (abs (int-vector-ref fvr i)) (abs (int-vector-ref fvi i)))))
+      (format () "noise: ~A~%" mx))))
+
+(define (int-vector-test)
+  (let ((fvr (make-int-vector fft-size))
+	(fvi (make-int-vector fft-size 0))
+	(scl (/ (* 8.0 pi) fft-size)))
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x scl)))
+	((= i fft-size))
+      (int-vector-set! fvr i (round (* 1000.0 (sin x)))))
+    (int-vector-fft fvr fvi fft-size 1)
+    (int-vector-checker fvr fvi)
+    (int-vector-fft #f #f fft-size 1)
+    (int-vector-checker #f #f)))
+
+(int-vector-test)
+(clear-and-gc)
+
+
+;; --------------------------------------------------------------------------------
+(format () "~%vectors...~%")
+(when (> total-memory (* 9 big-size))
+  (let ((bigv (make-vector big-size 'a symbol?)))
+    (test (length bigv) big-size)
+    (vector-set! bigv (- big-size 10000000) 'asdf)
+    (test (vector-ref bigv (- big-size 10000000)) 'asdf)
+    (reverse! bigv)
+    (test (vector-ref bigv (- 10000000 1)) 'asdf)
+    (fill! bigv 'b)
+    (test (vector-ref bigv (- 10000000 1)) 'b)
+    ))
+(clear-and-gc)
+
+(define (v-loop-test)
+  (when (> total-memory (* 20 big-size))
+    (let ((v (make-vector big-size ())))
+      (do ((i 0 (+ i 1000)))
+	  ((= i big-size))
+	(vector-set! v i (* 2 i)))
+      (test (vector-ref v 100000000) (* 2 100000000))
+      (test (vector-ref v (- big-size 10000000)) (* 2 (- big-size 10000000))))))
+(v-loop-test)
+(clear-and-gc)
+
+(define (vector-fft rl im n dir)
+  (when rl
+    (let ((m 0)
+	  (j 0)
+	  (ipw (floor (log n 2)))
+	  (prev 1)
+	  (wtemp 0.0)
+	  (wpr 0.0)
+	  (wpi 0.0)
+	  (wr 0.0)
+	  (wi 0.0)
+	  (mmax 2)
+	  (pw (/ n 2))
+	  (end 0)
+	  (theta (* pi dir)))
+      (do ((tempr 0.0+i) 
+	   (tempi 0.0+i) 
+	   (i 0 (+ i 1)))
+	  ((= i n))
+	(when (> j i)
+	  (set! tempr (vector-ref rl j))
+	  (set! tempi (vector-ref im j))
+	  (vector-set! rl j (vector-ref rl i))
+	  (vector-set! im j (vector-ref im i))
+	  (vector-set! rl i tempr)
+	  (vector-set! im i tempi))
+	(set! m (quotient n 2))
+	(do () 
+	    ((not (<= 2 m j)))
+	  (set! j (- j m))
+	  (set! m (quotient m 2)))
+	(set! j (+ j m)))
+      
+      (do ((lg 0 (+ lg 1)))
+	  ((= lg ipw))
+	(set! wpr (cos theta))
+	(set! wpi (sin theta))
+	(set! wr 1.0)
+	(set! wi 0.0)
+	(do ((ii 0 (+ ii 1)))
+	    ((= ii prev))
+	  (set! j (+ ii prev))
+	  (set! end (+ ii (* pw mmax)))
+	  (do ((tempr 0.0+i)
+	       (tempi 0.0+i)
+	       (i ii (+ i mmax)))
+	      ((= i end))
+	    (set! tempr (- (* wr (vector-ref rl j)) (* wi (vector-ref im j))))
+	    (set! tempi (+ (* wr (vector-ref im j)) (* wi (vector-ref rl j))))
+	    (vector-set! rl j (- (vector-ref rl i) tempr))
+	    (vector-set! rl i (+ (vector-ref rl i) tempr))
+	    (vector-set! im j (- (vector-ref im i) tempi))
+	    (vector-set! im i (+ (vector-ref im i) tempi))
+	    (set! j (+ j mmax)))
+	  (set! wtemp wr)
+	  (set! wr (- (* wr wpr) (* wi wpi)))
+	  (set! wi (+ (* wi wpr) (* wtemp wpi))))
+	(set! prev mmax)
+	(set! mmax (* mmax 2))
+	(set! pw (quotient pw 2))
+	(set! theta (* theta 0.5)))
+      rl)))
+
+(define (vector-checker fvr fvi)
+  (when fvr
+    (let ((vr 0.0)
+	  (vi 0.0)
+	  (pk 0.0)
+	  (mx 0.0)
+	  (mxloc 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! vr (vector-ref fvr i))
+	(set! vi (vector-ref fvi i))
+	(set! pk (+ (* vr vr) (* vi vi)))
+	(when (> pk mx)
+	  (set! mx pk)
+	  (set! mxloc i)))
+      (format () "~A ~A~%" mxloc (/ (* 2 (sqrt mx)) fft-size))
+      (format () "~A ~A~%" (fvi 4) (fvi (- fft-size 4))))
+    (vector-set! fvr 4 0.0)
+    (vector-set! fvi 4 0.0)
+    (vector-set! fvr (- fft-size 4) 0.0)
+    (vector-set! fvi (- fft-size 4) 0.0)
+    (let ((mx 0.0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! mx (max mx (abs (vector-ref fvr i)) (abs (vector-ref fvi i)))))
+      (format () "noise: ~A~%" mx))))
+
+(define (vector-test)
+  (let ((fvr (make-vector fft-size 0.0 real?))
+	(fvi (make-vector fft-size 0.0 real?))
+	(scl (/ (* 8.0 pi) fft-size)))
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x scl)))
+	((= i fft-size))
+      (vector-set! fvr i (sin x)))
+    (vector-fft fvr fvi fft-size 1)
+    (vector-checker fvr fvi)
+    (vector-fft #f #f fft-size 1)
+    (vector-checker #f #f)))
+
+(vector-test)
+(clear-and-gc)
+
+
+(define (vector-2d-fft rl n dir)
+  (when rl
+    (let ((m 0)
+	  (j 0)
+	  (ipw (floor (log n 2)))
+	  (prev 1)
+	  (wtemp 0.0)
+	  (wpr 0.0)
+	  (wpi 0.0)
+	  (wr 0.0)
+	  (wi 0.0)
+	  (mmax 2)
+	  (pw (/ n 2))
+	  (end 0)
+	  (theta (* pi dir))
+	  (rl0 (subvector rl 0 fft-size))
+	  (rl1 (subvector rl fft-size (* 2 fft-size))))
+      (do ((tempr 0.0+i)
+	   (tempi 0.0+i)
+	   (i 0 (+ i 1)))
+	  ((= i n))
+	(when (> j i)
+	  (set! tempr (vector-ref rl0 j))
+	  (set! tempi (vector-ref rl1 j))
+	  (vector-set! rl0 j (vector-ref rl0 i))
+	  (vector-set! rl1 j (vector-ref rl1 i))
+	  (vector-set! rl0 i tempr)
+	  (vector-set! rl1 i tempi))
+	(set! m (quotient n 2))
+	(do () 
+	    ((not (<= 2 m j)))
+	  (set! j (- j m))
+	  (set! m (quotient m 2)))
+	(set! j (+ j m)))
+      
+      (do ((lg 0 (+ lg 1)))
+	  ((= lg ipw))
+	(set! wpr (cos theta))
+	(set! wpi (sin theta))
+	(set! wr 1.0)
+	(set! wi 0.0)
+	(do ((tempr 0.0+i)
+	     (tempi 0.0+i)
+	     (ii 0 (+ ii 1)))
+	    ((= ii prev))
+	  (set! j (+ ii prev))
+	  (set! end (+ ii (* pw mmax)))
+	  (do ((i ii (+ i mmax)))
+	      ((= i end))
+	    (set! tempr (- (* wr (vector-ref rl0 j)) (* wi (vector-ref rl1 j))))
+	    (set! tempi (+ (* wr (vector-ref rl1 j)) (* wi (vector-ref rl0 j))))
+	    (vector-set! rl0 j (- (vector-ref rl0 i) tempr))
+	    (vector-set! rl0 i (+ (vector-ref rl0 i) tempr))
+	    (vector-set! rl1 j (- (vector-ref rl1 i) tempi))
+	    (vector-set! rl1 i (+ (vector-ref rl1 i) tempi))
+	    (set! j (+ j mmax)))
+	  (set! wtemp wr)
+	  (set! wr (- (* wr wpr) (* wi wpi)))
+	  (set! wi (+ (* wi wpr) (* wtemp wpi))))
+	(set! prev mmax)
+	(set! mmax (* mmax 2))
+	(set! pw (quotient pw 2))
+	(set! theta (* theta 0.5)))
+      rl)))
+
+(define (vector-2d-checker fvr)
+  (when fvr
+    (let ((vr 0.0)
+	  (vi 0.0)
+	  (pk 0.0)
+	  (mx 0.0)
+	  (mxloc 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! vr (vector-ref fvr 0 i))
+	(set! vi (vector-ref fvr 1 i))
+	(set! pk (+ (* vr vr) (* vi vi)))
+	(when (> pk mx)
+	  (set! mx pk)
+	  (set! mxloc i)))
+      (format () "~A ~A~%" mxloc (/ (* 2 (sqrt mx)) fft-size))
+      (format () "~A ~A~%" (fvr 1 4) (fvr 1 (- fft-size 4))))
+    (vector-set! fvr 0 4 0.0)
+    (vector-set! fvr 1 4 0.0)
+    (vector-set! fvr 0 (- fft-size 4) 0.0)
+    (vector-set! fvr 1 (- fft-size 4) 0.0)
+    (let ((mx 0.0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! mx (max mx (abs (vector-ref fvr 0 i)) (abs (vector-ref fvr 1 i)))))
+      (format () "noise: ~A~%" mx))))
+
+(define (vector-2d-test skip)
+  (let ((fvr (make-vector (list skip fft-size) 0.0 real?))
+	(scl (/ (* 8.0 pi) fft-size)))
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x scl)))
+	((= i fft-size))
+      (vector-set! fvr 0 i (sin x)))
+    (vector-2d-fft fvr fft-size 1)
+    (vector-2d-checker fvr)
+    (vector-2d-fft #f fft-size 1)
+    (vector-2d-checker #f)))
+
+(vector-2d-test 2)
+(clear-and-gc)
+
+
+;; --------------------------------------------------------------------------------
+;; hash-tables round up to the next power of 2
+
+(format () "~%hash-tables...~%")
+
+(when (> total-memory (* 9 (ash 1 31)))
+  (clear-and-gc)
+  
+  (set! big-size 2000000000)
+  (let ((bigv (make-hash-table big-size)))
+    (test (length bigv) 2147483648)
+    (hash-table-set! bigv 'asdf 12)
+    (test (hash-table-ref bigv 'asdf) 12)
+    (hash-table-set! bigv (- big-size 10000000) 'asdf)
+    (test (hash-table-ref bigv (- big-size 10000000)) 'asdf)
+    (fill! bigv #f)
+    (test (hash-table-entries bigv) 0)
+    (test (length bigv) 2147483648))
+  (clear-and-gc)
+  )
+
+(when (> total-memory (* 9 (ash 1 32))) ; add some slack
+  (set! big-size 2500000000)
+  (let ((bigv (make-hash-table big-size)))
+    (test (length bigv) 4294967296)
+    (hash-table-set! bigv 'asdf 12)
+    (test (hash-table-ref bigv 'asdf) 12)
+    (hash-table-set! bigv (- big-size 10000000) 'asdf)
+    (test (hash-table-ref bigv (- big-size 10000000)) 'asdf)
+    )
+  (clear-and-gc)
+  )
+
+
+(define (hash-table-fft rl im n dir)
+  (when rl
+    (do ((i 0 (+ i 1))
+	 (j 0))
+	((= i n))
+      (if (> j i)
+	  (let ((tempr (hash-table-ref rl j))
+		(tempi (hash-table-ref im j)))
+	    (hash-table-set! rl j (hash-table-ref rl i))
+	    (hash-table-set! im j (hash-table-ref im i))
+	    (hash-table-set! rl i tempr)
+	    (hash-table-set! im i tempi)))
+      (let ((m (/ n 2)))
+	(do () 
+	    ((not (<= 2 m j)))
+	  (set! j (- j m))
+	  (set! m (/ m 2)))
+	(set! j (+ j m))))
+    (let ((ipow (floor (log n 2)))
+	  (prev 1))
+      (do ((mmax 2 (* mmax 2))
+	   (pow (/ n 2) (/ pow 2))
+	   (theta (* pi dir) (* theta 0.5))
+	   (lg 0 (+ lg 1))
+	   (wpr 0.0)
+	   (wpi 0.0)
+	   (wr 1.0 1.0)
+	   (wi 0.0 0.0)
+	   (wtemp 0.0+i))
+	  ((= lg ipow))
+	(set! wpr (cos theta))
+	(set! wpi (sin theta))
+	(do ((ii 0 (+ ii 1)))
+	    ((= ii prev))
+	  (do ((tempr 0.0+i)
+	       (tempi 0.0+i)
+	       (i ii (+ i mmax))
+	       (j (+ ii prev) (+ j mmax))
+	       (jj 0 (+ jj 1)))
+	      ((>= jj pow))
+	    (set! tempr (- (* wr (hash-table-ref rl j)) (* wi (hash-table-ref im j))))
+	    (set! tempi (+ (* wr (hash-table-ref im j)) (* wi (hash-table-ref rl j))))
+	    (hash-table-set! rl j (- (hash-table-ref rl i) tempr))
+	    (hash-table-set! rl i (+ (hash-table-ref rl i) tempr))
+	    (hash-table-set! im j (- (hash-table-ref im i) tempi))
+	    (hash-table-set! im i (+ (hash-table-ref im i) tempi)))
+	  (set! wtemp wr)
+	  (set! wr (- (* wr wpr) (* wi wpi)))
+	  (set! wi (+ (* wi wpr) (* wtemp wpi))))
+	(set! prev mmax)))
+    rl))
+
+(define (hash-test)
+  (let ((fvr (make-hash-table fft-size)) ; (make-hash-table fft-size #t (cons #t float?))
+	(fvi (make-hash-table fft-size))
+	(scl (/ (* 8.0 pi) fft-size))
+	(vr 0+i)
+	(vi 0+i)
+	(pk 0+i))
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x scl)))
+	((= i fft-size))
+      (hash-table-set! fvr i (sin x))
+      (hash-table-set! fvi i 0.0))
+    (hash-table-fft fvr fvi fft-size 1)
+    (do ((mx 0.0)
+	 (mxloc 0)
+	 (i 0 (+ i 1)))
+	((= i fft-size) 
+	 (format () "~A ~A~%" mxloc (/ (* 2 (sqrt mx)) fft-size)))
+      (set! vr (hash-table-ref fvr i))
+      (set! vi (hash-table-ref fvi i))
+      (set! pk (+ (* vr vr) (* vi vi)))
+      (when (> pk mx)
+	(set! mx pk)
+	(set! mxloc i)))
+    (hash-table-set! fvr 4 0.0)
+    (hash-table-set! fvi 4 0.0)
+    (hash-table-set! fvr (- fft-size 4) 0.0)
+    (hash-table-set! fvi (- fft-size 4) 0.0)
+    (do ((mx 0.0)
+	 (i 0 (+ i 1)))
+	((= i fft-size)
+	 (format () "noise: ~A~%" mx))
+      (set! mx (max mx (abs (hash-table-ref fvr i)) (abs (hash-table-ref fvi i)))))
+    (hash-table-fft #f #f fft-size 1)))
+(hash-test)
+(clear-and-gc)
+
+
+(define (hash-symbol-fft rl im n rl-syms im-syms dir)
+  (when rl
+    (do ((i 0 (+ i 1))
+	 (j 0))
+	((= i n))
+      (if (> j i)
+	  (let ((tempr (hash-table-ref rl (vector-ref rl-syms j)))
+		(tempi (hash-table-ref im (vector-ref im-syms j))))
+	    (hash-table-set! rl (vector-ref rl-syms j) (hash-table-ref rl (vector-ref rl-syms i)))
+	    (hash-table-set! im (vector-ref im-syms j) (hash-table-ref im (vector-ref im-syms i)))
+	    (hash-table-set! rl (vector-ref rl-syms i) tempr)
+	    (hash-table-set! im (vector-ref im-syms i) tempi)))
+      (let ((m (/ n 2)))
+	(do () 
+	    ((not (<= 2 m j)))
+	  (set! j (- j m))
+	  (set! m (/ m 2)))
+	(set! j (+ j m))))
+    (let ((ipow (floor (log n 2)))
+	  (prev 1))
+      (do ((mmax 2 (* mmax 2))
+	   (pow (/ n 2) (/ pow 2))
+	   (theta (* pi dir) (* theta 0.5))
+	   (lg 0 (+ lg 1))
+	   (wpr 0.0)
+	   (wpi 0.0)
+	   (wr 1.0 1.0)
+	   (wi 0.0 0.0)
+	   (wtemp 0.0+i))
+	  ((= lg ipow))
+	(set! wpr (cos theta))
+	(set! wpi (sin theta))
+	(do ((ii 0 (+ ii 1)))
+	    ((= ii prev))
+	  (do ((tempr 0.0+i)
+	       (tempi 0.0+i)
+	       (i ii (+ i mmax))
+	       (j (+ ii prev) (+ j mmax))
+	       (jj 0 (+ jj 1)))
+	      ((>= jj pow))
+	    (set! tempr (- (* wr (hash-table-ref rl (vector-ref rl-syms j))) (* wi (hash-table-ref im (vector-ref im-syms j)))))
+	    (set! tempi (+ (* wr (hash-table-ref im (vector-ref im-syms j))) (* wi (hash-table-ref rl (vector-ref rl-syms j)))))
+	    (hash-table-set! rl (vector-ref rl-syms j) (- (hash-table-ref rl (vector-ref rl-syms i)) tempr))
+	    (hash-table-set! rl (vector-ref rl-syms i) (+ (hash-table-ref rl (vector-ref rl-syms i)) tempr))
+	    (hash-table-set! im (vector-ref im-syms j) (- (hash-table-ref im (vector-ref im-syms i)) tempi))
+	    (hash-table-set! im (vector-ref im-syms i) (+ (hash-table-ref im (vector-ref im-syms i)) tempi)))
+	  (set! wtemp wr)
+	  (set! wr (- (* wr wpr) (* wi wpi)))
+	  (set! wi (+ (* wi wpr) (* wtemp wpi))))
+	(set! prev mmax)))
+    rl))
+
+(define (hash-symbol-test)
+  (let ((fvr (hash-table))
+	(fvi (hash-table))
+	(rl-syms (make-vector fft-size))
+	(im-syms (make-vector fft-size))
+	(scl (/ (* 8.0 pi) fft-size))
+	(vr 0+i)
+	(vi 0+i)
+	(pk 0+i))
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x scl)))
+	((= i fft-size))
+      (vector-set! rl-syms i (gensym "rl"))
+      (vector-set! im-syms i (gensym "im"))
+      (hash-table-set! fvr (vector-ref rl-syms i) (sin x))
+      (hash-table-set! fvi (vector-ref im-syms i) 0.0))
+    (hash-symbol-fft fvr fvi fft-size rl-syms im-syms 1)
+    (do ((mx 0.0)
+	 (mxloc 0)
+	 (i 0 (+ i 1)))
+	((= i fft-size) 
+	 (format () "~A ~A~%" mxloc (/ (* 2 (sqrt mx)) fft-size)))
+      (set! vr (hash-table-ref fvr (vector-ref rl-syms i)))
+      (set! vi (hash-table-ref fvi (vector-ref im-syms i)))
+      (set! pk (+ (* vr vr) (* vi vi)))
+      (when (> pk mx)
+	(set! mx pk)
+	(set! mxloc i)))
+    (hash-table-set! fvr (vector-ref rl-syms 4) 0.0)
+    (hash-table-set! fvi (vector-ref im-syms 4) 0.0)
+    (hash-table-set! fvr (vector-ref rl-syms (- fft-size 4)) 0.0)
+    (hash-table-set! fvi (vector-ref im-syms (- fft-size 4)) 0.0)
+    (do ((mx 0.0)
+	 (i 0 (+ i 1)))
+	((= i fft-size)
+	 (format () "noise: ~A~%" mx))
+      (set! mx (max mx (abs (hash-table-ref fvr (vector-ref rl-syms i))) (abs (hash-table-ref fvi (vector-ref im-syms i))))))
+    (fill! rl-syms #f)
+    (fill! im-syms #f)
+    (fill! fvr #f)
+    (fill! fvi #f)
+    (hash-symbol-fft #f #f fft-size #f #f 1)))
+(hash-symbol-test)
+(clear-and-gc)
+
+
+;; --------------------------------------------------------------------------------
+(format () "~%lets...~%")
+
+(define (let-fft rl im n rl-syms im-syms dir)
+  (when rl
+    (do ((i 0 (+ i 1))
+	 (j 0))
+	((= i n))
+      (if (> j i)
+	  (let ((tempr (let-ref rl (vector-ref rl-syms j)))
+		(tempi (let-ref im (vector-ref im-syms j))))
+	    (let-set! rl (vector-ref rl-syms j) (let-ref rl (vector-ref rl-syms i)))
+	    (let-set! im (vector-ref im-syms j) (let-ref im (vector-ref im-syms i)))
+	    (let-set! rl (vector-ref rl-syms i) tempr)
+	    (let-set! im (vector-ref im-syms i) tempi)))
+      (let ((m (/ n 2)))
+	(do () 
+	    ((not (<= 2 m j)))
+	  (set! j (- j m))
+	  (set! m (/ m 2)))
+	(set! j (+ j m))))
+    (let ((ipow (floor (log n 2)))
+	  (prev 1))
+      (do ((mmax 2 (* mmax 2))
+	   (pow (/ n 2) (/ pow 2))
+	   (theta (* pi dir) (* theta 0.5))
+	   (lg 0 (+ lg 1))
+	   (wpr 0.0)
+	   (wpi 0.0)
+	   (wr 1.0 1.0)
+	   (wi 0.0 0.0)
+	   (wtemp 0.0+i))
+	  ((= lg ipow))
+	(set! wpr (cos theta))
+	(set! wpi (sin theta))
+	(do ((ii 0 (+ ii 1)))
+	    ((= ii prev))
+	  (do ((tempr 0.0+i)
+	       (tempi 0.0+i)
+	       (i ii (+ i mmax))
+	       (j (+ ii prev) (+ j mmax))
+	       (jj 0 (+ jj 1)))
+	      ((>= jj pow))
+	    (set! tempr (- (* wr (let-ref rl (vector-ref rl-syms j))) (* wi (let-ref im (vector-ref im-syms j)))))
+	    (set! tempi (+ (* wr (let-ref im (vector-ref im-syms j))) (* wi (let-ref rl (vector-ref rl-syms j)))))
+	    (let-set! rl (vector-ref rl-syms j) (- (let-ref rl (vector-ref rl-syms i)) tempr))
+	    (let-set! rl (vector-ref rl-syms i) (+ (let-ref rl (vector-ref rl-syms i)) tempr))
+	    (let-set! im (vector-ref im-syms j) (- (let-ref im (vector-ref im-syms i)) tempi))
+	    (let-set! im (vector-ref im-syms i) (+ (let-ref im (vector-ref im-syms i)) tempi)))
+	  (set! wtemp wr)
+	  (set! wr (- (* wr wpr) (* wi wpi)))
+	  (set! wi (+ (* wi wpr) (* wtemp wpi))))
+	(set! prev mmax)))
+    rl))
+
+(define (let-test)
+  (let ((fvr (inlet))
+	(fvi (inlet))
+	(rl-syms (make-vector fft-size))
+	(im-syms (make-vector fft-size))
+	(scl (/ (* 8.0 pi) fft-size))
+	(vr 0+i)
+	(vi 0+i)
+	(pk 0+i))
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x scl)))
+	((= i fft-size))
+      (vector-set! rl-syms i (gensym "rl-"))
+      (vector-set! im-syms i (gensym "im-"))
+      (varlet fvr (vector-ref rl-syms i) (sin x))
+      (varlet fvi (vector-ref im-syms i) 0.0))
+    (let-fft fvr fvi fft-size rl-syms im-syms 1)
+    (do ((mx 0.0)
+	 (mxloc 0)
+	 (i 0 (+ i 1)))
+	((= i fft-size) 
+	 (format () "~A ~A~%" mxloc (/ (* 2 (sqrt mx)) fft-size)))
+      (set! vr (let-ref fvr (vector-ref rl-syms i)))
+      (set! vi (let-ref fvi (vector-ref im-syms i)))
+      (set! pk (+ (* vr vr) (* vi vi)))
+      (when (> pk mx)
+	(set! mx pk)
+	(set! mxloc i)))
+    (let-set! fvr (vector-ref rl-syms 4) 0.0)
+    (let-set! fvi (vector-ref im-syms 4) 0.0)
+    (let-set! fvr (vector-ref rl-syms (- fft-size 4)) 0.0)
+    (let-set! fvi (vector-ref im-syms (- fft-size 4)) 0.0)
+    (do ((mx 0.0)
+	 (i 0 (+ i 1)))
+	((= i fft-size)
+	 (format () "noise: ~A~%" mx))
+      (set! mx (max mx (abs (let-ref fvr (vector-ref rl-syms i))) (abs (let-ref fvi (vector-ref im-syms i))))))
+    (fill! rl-syms #f)
+    (fill! im-syms #f)
+    (let-fft #f #f fft-size #f #f 1)))
+(let-test)
+(clear-and-gc)
+
+
+(format () "~%sundries...~%")
+;(set! fft-size (ash 1 15))
+
+(define (string-fft rl im n dir)
+  (when rl
+    (let ((m 0)
+	  (j 0)
+	  (ipw (floor (log n 2)))
+	  (prev 1)
+	  (wtemp 0.0+i)
+	  (wpr 0.0)
+	  (wpi 0.0)
+	  (wr 0.0)
+	  (wi 0.0)
+	  (mmax 2)
+	  (pw (/ n 2))
+	  (end 0)
+	  (theta (* pi dir)))
+      (do ((tempr 0.0+i)
+	   (tempi 0.0+i)
+	   (i 0 (+ i 1)))
+	  ((= i n))
+	(when (> j i)
+	  (set! tempr (string->number (vector-ref rl j)))
+	  (set! tempi (string->number (vector-ref im j)))
+	  (vector-set! rl j (vector-ref rl i))
+	  (vector-set! im j (vector-ref im i))
+	  (vector-set! rl i (number->string tempr))
+	  (vector-set! im i (number->string tempi)))
+	(set! m (quotient n 2))
+	(do () 
+	    ((not (<= 2 m j)))
+	  (set! j (- j m))
+	  (set! m (quotient m 2)))
+	(set! j (+ j m)))
+      
+      (do ((lg 0 (+ lg 1)))
+	  ((= lg ipw))
+	(set! wpr (cos theta))
+	(set! wpi (sin theta))
+	(set! wr 1.0)
+	(set! wi 0.0)
+	(do ((ii 0 (+ ii 1)))
+	    ((= ii prev))
+	  (set! j (+ ii prev))
+	  (set! end (+ ii (* pw mmax)))
+	  (do ((tempr 0.0+i) 
+	       (tempi 0.0+i) 
+	       (i ii (+ i mmax)))
+	      ((= i end))
+	    (set! tempr (- (* wr (string->number (vector-ref rl j))) (* wi (string->number (vector-ref im j)))))
+	    (set! tempi (+ (* wr (string->number (vector-ref im j))) (* wi (string->number (vector-ref rl j)))))
+	    (vector-set! rl j (number->string (- (string->number (vector-ref rl i)) tempr)))
+	    (vector-set! rl i (number->string (+ (string->number (vector-ref rl i)) tempr)))
+	    (vector-set! im j (number->string (- (string->number (vector-ref im i)) tempi)))
+	    (vector-set! im i (number->string (+ (string->number (vector-ref im i)) tempi)))
+	    (set! j (+ j mmax)))
+	  (set! wtemp wr)
+	  (set! wr (- (* wr wpr) (* wi wpi)))
+	  (set! wi (+ (* wi wpr) (* wtemp wpi))))
+	(set! prev mmax)
+	(set! mmax (* mmax 2))
+	(set! pw (quotient pw 2))
+	(set! theta (* theta 0.5)))
+      rl)))
+
+(define (string-checker fvr fvi)
+  (when fvr
+    (let ((vr 0.0+i)
+	  (vi 0.0+i)
+	  (pk 0.0+i)
+	  (mx 0.0)
+	  (mxloc 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! vr (string->number (vector-ref fvr i)))
+	(set! vi (string->number (vector-ref fvi i)))
+	(set! pk (+ (* vr vr) (* vi vi)))
+	(when (> pk mx)
+	  (set! mx pk)
+	  (set! mxloc i)))
+      (format () "~A ~A~%" mxloc (/ (* 2 (sqrt mx)) fft-size))
+      (format () "~A ~A~%" (string->number (vector-ref fvi 4)) (string->number (vector-ref fvi (- fft-size 4)))))
+    (vector-set! fvr 4 "0.0")
+    (vector-set! fvi 4 "0.0")
+    (vector-set! fvr (- fft-size 4) "0.0")
+    (vector-set! fvi (- fft-size 4) "0.0")
+    (let ((mx 0.0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! mx (max mx (abs (string->number (vector-ref fvr i))) (abs (string->number (vector-ref fvi i))))))
+      (format () "noise: ~A~%" mx))))
+
+(define (string-test)
+  (let ((fvr (make-vector fft-size))
+	(fvi (make-vector fft-size "0.0"))
+	(scl (/ (* 8.0 pi) fft-size)))
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x scl)))
+	((= i fft-size))
+      (vector-set! fvr i (number->string (sin x))))
+    (string-fft fvr fvi fft-size 1)
+    (string-checker fvr fvi)
+    (string-fft #f #f fft-size 1)
+    (string-checker #f #f)
+    (fill! fvr #f)
+    (fill! fvi #f)))
+(string-test)
+
+
+(let-temporarily (((*s7* 'float-format-precision) 48))
+(format *stderr* "~%radix...~%")
+(define radix 2)
+(define (string-radix-fft rl im n dir)
+  (when rl
+    (let ((m 0)
+	  (j 0)
+	  (ipw (floor (log n 2)))
+	  (prev 1)
+	  (wtemp 0.0+i)
+	  (wpr 0.0)
+	  (wpi 0.0)
+	  (wr 0.0)
+	  (wi 0.0)
+	  (mmax 2)
+	  (pw (/ n 2))
+	  (end 0)
+	  (theta (* pi dir)))
+      (do ((tempr 0.0+i)
+	   (tempi 0.0+i)
+	   (i 0 (+ i 1)))
+	  ((= i n))
+	(when (> j i)
+	  (set! tempr (string->number (vector-ref rl j) radix))
+	  (set! tempi (string->number (vector-ref im j) radix))
+	  (vector-set! rl j (vector-ref rl i))
+	  (vector-set! im j (vector-ref im i))
+	  (vector-set! rl i (number->string tempr radix))
+	  (vector-set! im i (number->string tempi radix)))
+	(set! m (quotient n 2))
+	(do () 
+	    ((not (<= 2 m j)))
+	  (set! j (- j m))
+	  (set! m (quotient m 2)))
+	(set! j (+ j m)))
+      
+      (do ((lg 0 (+ lg 1)))
+	  ((= lg ipw))
+	(set! wpr (cos theta))
+	(set! wpi (sin theta))
+	(set! wr 1.0)
+	(set! wi 0.0)
+	(do ((ii 0 (+ ii 1)))
+	    ((= ii prev))
+	  (set! j (+ ii prev))
+	  (set! end (+ ii (* pw mmax)))
+	  (do ((tempr 0.0+i) 
+	       (tempi 0.0+i)
+	       (i ii (+ i mmax)))
+	      ((= i end))
+	    (set! tempr (- (* wr (string->number (vector-ref rl j) radix)) (* wi (string->number (vector-ref im j) radix))))
+	    (set! tempi (+ (* wr (string->number (vector-ref im j) radix)) (* wi (string->number (vector-ref rl j) radix))))
+	    (vector-set! rl j (number->string (- (string->number (vector-ref rl i) radix) tempr) radix))
+	    (vector-set! rl i (number->string (+ (string->number (vector-ref rl i) radix) tempr) radix))
+	    (vector-set! im j (number->string (- (string->number (vector-ref im i) radix) tempi) radix))
+	    (vector-set! im i (number->string (+ (string->number (vector-ref im i) radix) tempi) radix))
+	    (set! j (+ j mmax)))
+	  (set! wtemp wr)
+	  (set! wr (- (* wr wpr) (* wi wpi)))
+	  (set! wi (+ (* wi wpr) (* wtemp wpi))))
+	(set! prev mmax)
+	(set! mmax (* mmax 2))
+	(set! pw (quotient pw 2))
+	(set! theta (* theta 0.5)))
+      rl)))
+
+(define (string-radix-checker fvr fvi)
+  (when fvr
+    (let ((vr 0.0)
+	  (vi 0.0)
+	  (pk 0.0)
+	  (mx 0.0)
+	  (mxloc 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! vr (string->number (vector-ref fvr i) radix))
+	(set! vi (string->number (vector-ref fvi i) radix))
+	(set! pk (+ (* vr vr) (* vi vi)))
+	(when (> pk mx)
+	  (set! mx pk)
+	  (set! mxloc i)))
+      (format () "~A ~A~%" mxloc (/ (* 2 (sqrt mx)) fft-size))
+      (format () "~A ~A~%" (fvi 4) (fvi (- fft-size 4))))
+    (vector-set! fvr 4 "0.0")
+    (vector-set! fvi 4 "0.0")
+    (vector-set! fvr (- fft-size 4) "0.0")
+    (vector-set! fvi (- fft-size 4) "0.0")
+    (let ((mx 0.0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! mx (max mx (abs (string->number (vector-ref fvr i) radix)) (abs (string->number (vector-ref fvi i) radix)))))
+      (format () "noise: ~A~%" mx))))
+
+(define (string-radix-test)
+  (let ((fvr (make-vector fft-size))
+	(fvi (make-vector fft-size "0.0"))
+	(scl (/ (* 8.0 pi) fft-size)))
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x scl)))
+	((= i fft-size))
+      (vector-set! fvr i (number->string (sin x) radix)))
+    (string-radix-fft fvr fvi fft-size 1)
+    (string-radix-checker fvr fvi)
+    (fill! fvr #f)
+    (fill! fvi #f)
+    (string-radix-fft #f #f fft-size 1)
+    (string-radix-checker #f #f)))
+(string-radix-test))
+
+(clear-and-gc)
+
+
+(define (port-fft rl im n dir)
+  (when rl
+    (let ((m 0)
+	  (j 0)
+	  (ipw (floor (log n 2)))
+	  (prev 1)
+	  (wtemp 0.0+i)
+	  (wpr 0.0)
+	  (wpi 0.0)
+	  (wr 0.0)
+	  (wi 0.0)
+	  (mmax 2)
+	  (pw (/ n 2))
+	  (end 0)
+	  (theta (* pi dir)))
+      (do ((tempr 0.0+i) 
+	   (tempi 0.0+i) 
+	   (i 0 (+ i 1)))
+	  ((= i n))
+	(when (> j i)
+	  (set! tempr (with-input-from-string (vector-ref rl j) read))
+	  (set! tempi (with-input-from-string (vector-ref im j) read))
+	  (vector-set! rl j (vector-ref rl i))
+	  (vector-set! im j (vector-ref im i))
+	  (vector-set! rl i (number->string tempr))
+	  (vector-set! im i (number->string tempi)))
+	(set! m (quotient n 2))
+	(do () 
+	    ((not (<= 2 m j)))
+	  (set! j (- j m))
+	  (set! m (quotient m 2)))
+	(set! j (+ j m)))
+      
+      (do ((lg 0 (+ lg 1)))
+	  ((= lg ipw))
+	(set! wpr (cos theta))
+	(set! wpi (sin theta))
+	(set! wr 1.0)
+	(set! wi 0.0)
+	(do ((ii 0 (+ ii 1)))
+	    ((= ii prev))
+	  (set! j (+ ii prev))
+	  (set! end (+ ii (* pw mmax)))
+	  (do ((tempr 0.0+i) 
+	       (tempi 0.0+i)
+	       (i ii (+ i mmax)))
+	      ((= i end))
+	    (set! tempr (- (* wr (with-input-from-string (vector-ref rl j) read)) (* wi (with-input-from-string (vector-ref im j) read))))
+	    (set! tempi (+ (* wr (with-input-from-string (vector-ref im j) read)) (* wi (with-input-from-string (vector-ref rl j) read))))
+	    (vector-set! rl j (number->string (- (with-input-from-string (vector-ref rl i) read) tempr)))
+	    (vector-set! rl i (number->string (+ (with-input-from-string (vector-ref rl i) read) tempr)))
+	    (vector-set! im j (number->string (- (with-input-from-string (vector-ref im i) read) tempi)))
+	    (vector-set! im i (number->string (+ (with-input-from-string (vector-ref im i) read) tempi)))
+	    (set! j (+ j mmax)))
+	  (set! wtemp wr)
+	  (set! wr (- (* wr wpr) (* wi wpi)))
+	  (set! wi (+ (* wi wpr) (* wtemp wpi))))
+	(set! prev mmax)
+	(set! mmax (* mmax 2))
+	(set! pw (quotient pw 2))
+	(set! theta (* theta 0.5)))
+      rl)))
+
+(define (port-checker fvr fvi)
+  (when fvr
+    (let ((vr 0.0)
+	  (vi 0.0)
+	  (pk 0.0)
+	  (mx 0.0)
+	  (mxloc 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! vr (with-input-from-string (vector-ref fvr i) read))
+	(set! vi (with-input-from-string (vector-ref fvi i) read))
+	(set! pk (+ (* vr vr) (* vi vi)))
+	(when (> pk mx)
+	  (set! mx pk)
+	  (set! mxloc i)))
+      (format () "~A ~A~%" mxloc (/ (* 2 (sqrt mx)) fft-size))
+      (format () "~A ~A~%" (fvi 4) (fvi (- fft-size 4))))
+    (vector-set! fvr 4 "0.0")
+    (vector-set! fvi 4 "0.0")
+    (vector-set! fvr (- fft-size 4) "0.0")
+    (vector-set! fvi (- fft-size 4) "0.0")
+    (let ((mx 0.0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! mx (max mx (abs (with-input-from-string (vector-ref fvr i) read)) (abs (with-input-from-string (vector-ref fvi i) read)))))
+      (format () "noise: ~A~%" mx))))
+
+(define (port-test)
+  (let ((fvr (make-vector fft-size))
+	(fvi (make-vector fft-size "0.0"))
+	(scl (/ (* 8.0 pi) fft-size)))
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x scl)))
+	((= i fft-size))
+      (vector-set! fvr i (number->string (sin x))))
+    (port-fft fvr fvi fft-size 1)
+    (port-checker fvr fvi)
+    (port-fft #f #f fft-size 1)
+    (port-checker #f #f)
+    (fill! fvr #f)
+    (fill! fvi #f)))
+(port-test)
+
+
+;(define-expansion (new-value val)
+;  `(make-vector (make-list (+ 1 (random 4)) (+ 1 (random 4))) ,val))
+
+(define lists (make-vector 16))
+(do ((i 0 (+ i 1))
+     (j 1)
+     (k 1))
+    ((= i 16))
+  (set! (lists i) (make-list k j))
+  (set! j (+ j 1))
+  (when (= j 5) (set! j 1) (set! k (+ k 1))))
+
+(define-expansion (new-value val)
+  `(make-vector (vector-ref lists (random 16)) ,val))
+
+(define-expansion (old-value ref)
+  `((subvector ,ref 0 1) 0))
+
+(define (complex-2d-fft data n dir)
+  (when data
+    (do ((i 0 (+ i 1))
+	 (j 0))
+	((= i n))
+      (if (> j i)
+	  (let ((temp (vector-ref data j)))
+	    (vector-set! data j (vector-ref data i))
+	    (vector-set! data i temp)))
+      (let ((m (/ n 2)))
+	(do () 
+	    ((not (<= 2 m j)))
+	  (set! j (- j m))
+	  (set! m (/ m 2)))
+	(set! j (+ j m))))
+    (let ((ipow (floor (log n 2)))
+	  (prev 1))
+      (do ((lg 0 (+ lg 1))
+	   (mmax 2 (* mmax 2))
+	   (pow (/ n 2) (/ pow 2))
+	   (theta (complex 0.0 (* pi dir)) (* theta 0.5))
+	   (wpc 0.0)
+	   (wc 1.0 1.0))
+	  ((= lg ipow))
+	(set! wpc (exp theta))
+	(do ((ii 0 (+ ii 1)))
+	    ((= ii prev))
+	  (do ((tc 0.0+i)
+	       (jj 0 (+ jj 1))
+	       (i ii (+ i mmax))
+	       (j (+ ii prev) (+ j mmax)))
+	      ((>= jj pow))
+	    (set! tc (* wc (old-value (vector-ref data j))))
+	    (vector-set! data j (new-value (- (old-value (vector-ref data i)) tc)))
+	    (vector-set! data i (new-value (+ (old-value (vector-ref data i)) tc))))
+	  (set! wc (* wc wpc)))
+	(set! prev mmax)))
+    data))
+
+(define (complex-2d-checker fvr)
+  (when fvr
+    (let ((pk 0.0)
+	  (mx 0.0)
+	  (mxloc 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! pk (magnitude (old-value (vector-ref fvr i))))
+	(when (> pk mx)
+	  (set! mx pk)
+	  (set! mxloc i)))
+      (format () "~A ~A~%" mxloc (/ (* 2 (sqrt mx)) fft-size))
+      (format () "~A ~A~%" (magnitude (old-value (fvr 4))) (magnitude (old-value (fvr (- fft-size 4))))))
+    (vector-set! fvr 4 (new-value 0.0))
+    (vector-set! fvr (- fft-size 4) (new-value 0.0))
+    (let ((mx 0.0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! mx (max mx (magnitude (old-value (vector-ref fvr i))))))
+      (format () "noise: ~A~%" mx))))
+
+(define (complex-2d-test)
+  (let ((fvr (make-vector fft-size))
+	(scl (/ (* 8.0 pi) fft-size)))
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x scl)))
+	((= i fft-size))
+      (vector-set! fvr i (new-value (sin x))))
+    (complex-2d-fft fvr fft-size 1)
+    (complex-2d-checker fvr)
+    (complex-2d-fft #f fft-size 1)
+    (complex-2d-checker #f)
+    (fill! fvr #f)))
+(complex-2d-test)
+
+
+(clear-and-gc)
+;(set! fft-size (ash 1 17))
+(define (complex-hash-fft data n dir)
+  (when data
+    (do ((i 0 (+ i 1))
+	 (j 0))
+	((= i n))
+      (if (> j i)
+	  (let ((temp (vector-ref data j)))
+	    (vector-set! data j (vector-ref data i))
+	    (vector-set! data i temp)))
+      (let ((m (/ n 2)))
+	(do () 
+	    ((not (<= 2 m j)))
+	  (set! j (- j m))
+	  (set! m (/ m 2)))
+	(set! j (+ j m))))
+    (let ((ipow (floor (log n 2)))
+	  (prev 1))
+      (do ((mmax 2 (* mmax 2))
+	   (pow (/ n 2) (/ pow 2))
+	   (theta (complex 0.0 (* pi dir)) (* theta 0.5))
+	   (lg 0 (+ lg 1)))
+	  ((= lg ipow))
+	(let ((wpc (exp theta))
+	      (wc 1.0))
+	  (do ((ii 0 (+ ii 1)))
+	      ((= ii prev))
+	    (do ((i ii (+ i mmax))
+		 (j (+ ii prev) (+ j mmax))
+		 (jj 0 (+ jj 1)))
+		((>= jj pow))
+	      (let ((tc (* wc (hash-table-ref (vector-ref data j) 'z)))) ; this could be (data j 'z)!
+		(vector-set! data j (hash-table 'z (- (hash-table-ref (vector-ref data i) 'z) tc)))
+		(vector-set! data i (hash-table 'z (+ (hash-table-ref (vector-ref data i) 'z) tc)))))
+	    (set! wc (* wc wpc)))
+	  (set! prev mmax))))
+    data))
+
+(define (complex-hash-checker fvr)
+  (when fvr
+    (let ((pk 0.0)
+	  (mx 0.0)
+	  (mxloc 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! pk (magnitude (hash-table-ref (vector-ref fvr i) 'z)))
+	(when (> pk mx)
+	  (set! mx pk)
+	  (set! mxloc i)))
+      (format () "~A ~A~%" mxloc (/ (* 2 (sqrt mx)) fft-size))
+      (format () "~A ~A~%" 
+	      (magnitude (hash-table-ref (vector-ref fvr 4) 'z))
+	      (magnitude (hash-table-ref (vector-ref fvr (- fft-size 4)) 'z))))
+    (vector-set! fvr 4 (hash-table 'z 0.0))
+    (vector-set! fvr (- fft-size 4) (hash-table 'z 0.0))
+    (let ((mx 0.0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! mx (max mx (magnitude (hash-table-ref (vector-ref fvr i) 'z)))))
+      (format () "noise: ~A~%" mx))))
+
+(define (complex-hash-test)
+  (let ((fvr (make-vector fft-size))
+	(scl (/ (* 8.0 pi) fft-size)))
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x scl)))
+	((= i fft-size))
+      (vector-set! fvr i (hash-table 'z (sin x))))
+    (complex-hash-fft fvr fft-size 1)
+    (complex-hash-checker fvr)
+    (complex-hash-fft #f fft-size 1)
+    (complex-hash-checker #f)
+    (fill! fvr #f)))
+(complex-hash-test)
+
+(clear-and-gc)
+
+
+(define (iterator-vector-fft rl im n dir)
+  (when rl
+    (let ((m 0)
+	  (j 0)
+	  (ipw (floor (log n 2)))
+	  (prev 1)
+	  (wtemp 0.0+i)
+	  (wpr 0.0)
+	  (wpi 0.0)
+	  (wr 0.0)
+	  (wi 0.0)
+	  (mmax 2)
+	  (pw (/ n 2))
+	  (end 0)
+	  (theta (* pi dir))
+	  (tempbr #f)
+	  (tempbi #f))
+      (do ((tempr 0.0+i) 
+	   (tempi 0.0+i)
+	   (i 0 (+ i 1)))
+	  ((= i n))
+	(when (> j i)
+	  (set! tempbr (vector-ref rl j))
+	  (set! tempbi (vector-ref im j))
+	  (vector-set! rl j (vector-ref rl i))
+	  (vector-set! im j (vector-ref im i))
+	  (vector-set! rl i tempbr)
+	  (vector-set! im i tempbi))
+	(set! m (quotient n 2))
+	(do () 
+	    ((not (<= 2 m j)))
+	  (set! j (- j m))
+	  (set! m (quotient m 2)))
+	(set! j (+ j m)))
+      
+      (do ((lg 0 (+ lg 1)))
+	  ((= lg ipw))
+	(set! wpr (cos theta))
+	(set! wpi (sin theta))
+	(set! wr 1.0)
+	(set! wi 0.0)
+	(do ((ii 0 (+ ii 1)))
+	    ((= ii prev))
+	  (set! j (+ ii prev))
+	  (set! end (+ ii (* pw mmax)))
+	  (do ((tempr 0.0+i)
+	       (tempi 0.0+i)
+	       (i ii (+ i mmax)))
+	      ((= i end))
+	    (set! tempr (- (* wr (iterate (vector-ref rl j))) (* wi (iterate (vector-ref im j)))))
+	    (set! tempi (+ (* wr (iterate (vector-ref im j))) (* wi (iterate (vector-ref rl j)))))
+	    (vector-set! rl j (make-iterator (make-float-vector 2 (- (iterate (vector-ref rl i)) tempr))))
+	    (vector-set! rl i (make-iterator (make-float-vector 2 (+ (iterate (vector-ref rl i)) tempr))))
+	    (vector-set! im j (make-iterator (make-float-vector 2 (- (iterate (vector-ref im i)) tempi))))
+	    (vector-set! im i (make-iterator (make-float-vector 2 (+ (iterate (vector-ref im i)) tempi))))
+	    (set! j (+ j mmax)))
+	  (set! wtemp wr)
+	  (set! wr (- (* wr wpr) (* wi wpi)))
+	  (set! wi (+ (* wi wpr) (* wtemp wpi))))
+	(set! prev mmax)
+	(set! mmax (* mmax 2))
+	(set! pw (quotient pw 2))
+	(set! theta (* theta 0.5)))
+      rl)))
+
+(define (iterator-vector-checker fvr fvi)
+  (when fvr
+    (let ((vr 0.0+i)
+	  (vi 0.0+i)
+	  (pk 0.0+i)
+	  (mx 0.0)
+	  (mxloc 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! vr (iterate (vector-ref fvr i)))
+	(set! vi (iterate (vector-ref fvi i)))
+	(set! pk (+ (* vr vr) (* vi vi)))
+	(when (> pk mx)
+	  (set! mx pk)
+	  (set! mxloc i)))
+      (format () "~A ~A~%" mxloc (/ (* 2 (sqrt mx)) fft-size))
+      (format () "~A ~A~%" (iterate (vector-ref fvi 4)) (iterate (vector-ref fvi (- fft-size 4)))))
+    (vector-set! fvr 4 (make-iterator (make-float-vector 2 0.0)))
+    (vector-set! fvi 4 (make-iterator (make-float-vector 2 0.0)))
+    (vector-set! fvr (- fft-size 4) (make-iterator (make-float-vector 2 0.0)))
+    (vector-set! fvi (- fft-size 4) (make-iterator (make-float-vector 2 0.0)))
+    (let ((mx 0.0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! mx (max mx (abs (iterate (vector-ref fvr i))) (abs (iterate (vector-ref fvi i))))))
+      (format () "noise: ~A~%" mx))))
+
+(define (iterator-vector-test)
+  (let ((fvr (make-vector fft-size))
+	(fvi (make-vector fft-size))
+	(scl (/ (* 8.0 pi) fft-size)))
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x scl)))
+	((= i fft-size))
+      (vector-set! fvi i (make-iterator (make-float-vector 2 0.0)))
+      (vector-set! fvr i (make-iterator (make-float-vector 2 (sin x)))))
+    (iterator-vector-fft fvr fvi fft-size 1)
+    (iterator-vector-checker fvr fvi)
+    (iterator-vector-fft #f #f fft-size 1)
+    (iterator-vector-checker #f #f)
+    (fill! fvr #f)
+    (fill! fvi #f)))
+
+(iterator-vector-test)
+(clear-and-gc)
+
+(define (complex-closure-fft data n dir)
+  (when data
+    (do ((i 0 (+ i 1))
+	 (j 0))
+	((= i n))
+      (if (> j i)
+	  (let ((temp (vector-ref data j)))
+	    (vector-set! data j (vector-ref data i))
+	    (vector-set! data i temp)))
+      (let ((m (/ n 2)))
+	(do () 
+	    ((not (<= 2 m j)))
+	  (set! j (- j m))
+	  (set! m (/ m 2)))
+	(set! j (+ j m))))
+    (let ((ipow (floor (log n 2)))
+	  (prev 1))
+      (do ((mmax 2 (* mmax 2))
+	   (pow (/ n 2) (/ pow 2))
+	   (theta (complex 0.0 (* pi dir)) (* theta 0.5))
+	   (lg 0 (+ lg 1)))
+	  ((= lg ipow))
+	(let ((wpc (exp theta))
+	      (wc 1.0))
+	  (do ((ii 0 (+ ii 1)))
+	      ((= ii prev))
+	    (do ((i ii (+ i mmax))
+		 (j (+ ii prev) (+ j mmax))
+		 (jj 0 (+ jj 1)))
+		((>= jj pow))
+	      (let ((tc (* wc ((vector-ref data j))))) 
+		(vector-set! data j (let ((z (- ((vector-ref data i)) tc))) (lambda () z)))
+		(vector-set! data i (let ((z (+ ((vector-ref data i)) tc))) (lambda () z)))))
+	    (set! wc (* wc wpc)))
+	  (set! prev mmax))))
+    data))
+
+(define (complex-closure-checker fvr)
+  (when fvr
+    (let ((pk 0.0)
+	  (mx 0.0)
+	  (mxloc 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! pk (magnitude ((vector-ref fvr i))))
+	(when (> pk mx)
+	  (set! mx pk)
+	  (set! mxloc i)))
+      (format () "~A ~A~%" mxloc (/ (* 2 (sqrt mx)) fft-size))
+      (format () "~A ~A~%" 
+	      (magnitude ((vector-ref fvr 4)))
+	      (magnitude ((vector-ref fvr (- fft-size 4))))))
+    (vector-set! fvr 4 (let ((z 0.0)) (lambda () z)))
+    (vector-set! fvr (- fft-size 4) (let ((z 0.0)) (lambda () z)))
+    (let ((mx 0.0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! mx (max mx (magnitude ((vector-ref fvr i))))))
+      (format () "noise: ~A~%" mx))))
+
+(define (complex-closure-test)
+  (let ((fvr (make-vector fft-size))
+	(scl (/ (* 8.0 pi) fft-size)))
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x scl)))
+	((= i fft-size))
+      (vector-set! fvr i (let ((z (sin x))) (lambda () z))))
+    (complex-closure-fft fvr fft-size 1)
+    (complex-closure-checker fvr)
+    (complex-closure-fft #f fft-size 1)
+    (complex-closure-checker #f)
+    (fill! fvr #f)))
+(complex-closure-test)
+
+(clear-and-gc)
+
+;; --------------------------------------------------------------------------------
+
+(load "s7test-block.so" (sublet (curlet) (cons 'init_func 'block_init)))
+(format () "~%blocks...~%")
+
+(when (> total-memory (* 10 big-size))
+  (clear-and-gc)
+  (let ((bigv (make-block big-size)))
+    (test (length bigv) big-size)
+    (set! (bigv (- big-size 10000000)) 1.0)
+    (test (bigv (- big-size 10000000)) 1.0)
+    (reverse! bigv)
+    (test (bigv (- 10000000 1)) 1.0)
+    (fill! bigv 0.0); (- big-size 9000000))
+    (test (bigv (- big-size 10000000)) 0.0)
+    ))
+(clear-and-gc)
+
+(when (> total-memory (* (ash 1 33) 8))
+  (let ((b (make-block (ash 1 33))))
+    (set! (b (+ (ash 1 32) 10)) 1.0)
+    (test (b (+ (ash 1 32) 10)) 1.0))
+  (clear-and-gc))
+
+(define (block-fft rl im n dir)
+  (when rl
+    (do ((i 0 (+ i 1))
+	 (j 0))
+	((= i n))
+      (if (> j i)
+	  (let ((tempr (block-ref rl j))
+		(tempi (block-ref im j)))
+	    (block-set! rl j (block-ref rl i))
+	    (block-set! im j (block-ref im i))
+	    (block-set! rl i tempr)
+	    (block-set! im i tempi)))
+      (let ((m (/ n 2)))
+	(do () 
+	    ((not (<= 2 m j)))
+	  (set! j (- j m))
+	  (set! m (/ m 2)))
+	(set! j (+ j m))))
+    (let ((ipow (floor (log n 2)))
+	  (prev 1)
+	  (tempr 0.0)
+	  (tempi 0.0)
+	  (wtemp 0.0))
+      (do ((mmax 2 (* mmax 2))
+	   (pow (/ n 2) (/ pow 2))
+	   (theta (* pi dir) (* theta 0.5))
+	   (lg 0 (+ lg 1)))
+	  ((= lg ipow))
+	(let ((wpr (cos theta))
+	      (wpi (sin theta))
+	      (wr 1.0)
+	      (wi 0.0))
+	  (do ((ii 0 (+ ii 1)))
+	      ((= ii prev))
+	    (do ((i ii (+ i mmax))
+		 (j (+ ii prev) (+ j mmax))
+		 (jj 0 (+ jj 1)))
+		((>= jj pow))
+	      (set! tempr (- (* wr (block-ref rl j)) (* wi (block-ref im j))))
+	      (set! tempi (+ (* wr (block-ref im j)) (* wi (block-ref rl j))))
+	      (block-set! rl j (- (block-ref rl i) tempr))
+	      (block-set! rl i (+ (block-ref rl i) tempr))
+	      (block-set! im j (- (block-ref im i) tempi))
+	      (block-set! im i (+ (block-ref im i) tempi)))
+	    (set! wtemp wr)
+	    (set! wr (- (* wr wpr) (* wi wpi)))
+	    (set! wi (+ (* wi wpr) (* wtemp wpi))))
+	  (set! prev mmax))))
+    rl))
+
+(define (block-test)
+  (let ((fvr (make-block fft-size))
+	(fvi (make-block fft-size))
+	(scl (/ (* 8.0 pi) fft-size)))
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x scl)))
+	((= i fft-size))
+      (block-set! fvr i (sin x)))
+    (block-fft fvr fvi fft-size 1)
+    (do ((mx 0.0)
+	 (mxloc 0)
+	 (vr 0.0)
+	 (vi 0.0)
+	 (pk 0.0)
+	 (i 0 (+ i 1)))
+	((= i fft-size) 
+	 (format () "~A ~A~%" mxloc (/ (* 2 (sqrt mx)) fft-size)))
+      (set! vr (block-ref fvr i))
+      (set! vi (block-ref fvi i))
+      (set! pk (+ (* vr vr) (* vi vi)))
+      (when (> pk mx)
+	(set! mx pk)
+	(set! mxloc i)))
+    (set! (fvr 4) 0.0)
+    (set! (fvi 4) 0.0)
+    (set! (fvr (- fft-size 4)) 0.0)
+    (set! (fvi (- fft-size 4)) 0.0)
+    (do ((mx 0.0)
+	 (i 0 (+ i 1)))
+	((= i fft-size)
+	 (format () "noise: ~A~%" mx))
+      (set! mx (max mx (abs (block-ref fvr i)) (abs (block-ref fvi i)))))
+    (block-fft #f #f fft-size 1)))
+(block-test)
+
+(define (block-vector-fft rl im n dir)
+  (when rl
+    (let ((tempr 0.0)
+	  (tempi 0.0)
+	  (m 0)
+	  (j 0)
+	  (ipw (floor (log n 2)))
+	  (prev 1)
+	  (wtemp 0.0)
+	  (wpr 0.0)
+	  (wpi 0.0)
+	  (wr 0.0)
+	  (wi 0.0)
+	  (mmax 2)
+	  (pw (/ n 2))
+	  (end 0)
+	  (theta (* pi dir))
+	  (tempbr #f)
+	  (tempbi #f))
+      (do ((i 0 (+ i 1)))
+	  ((= i n))
+	(when (> j i)
+	  (set! tempbr (vector-ref rl j))
+	  (set! tempbi (vector-ref im j))
+	  (vector-set! rl j (vector-ref rl i))
+	  (vector-set! im j (vector-ref im i))
+	  (vector-set! rl i tempbr)
+	  (vector-set! im i tempbi))
+	(set! m (quotient n 2))
+	(do () 
+	    ((not (<= 2 m j)))
+	  (set! j (- j m))
+	  (set! m (quotient m 2)))
+	(set! j (+ j m)))
+      
+      (do ((lg 0 (+ lg 1)))
+	  ((= lg ipw))
+	(set! wpr (cos theta))
+	(set! wpi (sin theta))
+	(set! wr 1.0)
+	(set! wi 0.0)
+	(do ((ii 0 (+ ii 1)))
+	    ((= ii prev))
+	  (set! j (+ ii prev))
+	  (set! end (+ ii (* pw mmax)))
+	  (do ((i ii (+ i mmax)))
+	      ((= i end))
+	    (set! tempr (- (* wr (block-ref (vector-ref rl j) 0)) (* wi (block-ref (vector-ref im j) 0))))
+	    (set! tempi (+ (* wr (block-ref (vector-ref im j) 0)) (* wi (block-ref (vector-ref rl j) 0))))
+	    (vector-set! rl j (block (- (block-ref (vector-ref rl i) 0) tempr)))
+	    (vector-set! rl i (block (+ (block-ref (vector-ref rl i) 0) tempr)))
+	    (vector-set! im j (block (- (block-ref (vector-ref im i) 0) tempi)))
+	    (vector-set! im i (block (+ (block-ref (vector-ref im i) 0) tempi)))
+	    (set! j (+ j mmax)))
+	  (set! wtemp wr)
+	  (set! wr (- (* wr wpr) (* wi wpi)))
+	  (set! wi (+ (* wi wpr) (* wtemp wpi))))
+	(set! prev mmax)
+	(set! mmax (* mmax 2))
+	(set! pw (quotient pw 2))
+	(set! theta (* theta 0.5)))
+      rl)))
+
+(define (block-vector-checker fvr fvi)
+  (when fvr
+    (let ((vr 0.0)
+	  (vi 0.0)
+	  (pk 0.0)
+	  (mx 0.0)
+	  (mxloc 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! vr (block-ref (vector-ref fvr i) 0))
+	(set! vi (block-ref (vector-ref fvi i) 0))
+	(set! pk (+ (* vr vr) (* vi vi)))
+	(when (> pk mx)
+	  (set! mx pk)
+	  (set! mxloc i)))
+      (format () "~A ~A~%" mxloc (/ (* 2 (sqrt mx)) fft-size))
+      (format () "~A ~A~%" (fvi 4) (fvi (- fft-size 4))))
+    (vector-set! fvr 4 (block 0.0))
+    (vector-set! fvi 4 (block 0.0))
+    (vector-set! fvr (- fft-size 4) (block 0.0))
+    (vector-set! fvi (- fft-size 4) (block 0.0))
+    (let ((mx 0.0))
+      (do ((i 0 (+ i 1)))
+	  ((= i fft-size))
+	(set! mx (max mx (abs (block-ref (vector-ref fvr i) 0)) (abs (block-ref (vector-ref fvi i) 0)))))
+      (format () "noise: ~A~%" mx))))
+
+(define (block-vector-test)
+  (let ((fvr (make-vector fft-size))
+	(fvi (make-vector fft-size (block 0.0)))
+	(scl (/ (* 8.0 pi) fft-size)))
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x scl)))
+	((= i fft-size))
+      (vector-set! fvr i (block (sin x))))
+    (block-vector-fft fvr fvi fft-size 1)
+    (block-vector-checker fvr fvi)
+    (block-vector-fft #f #f fft-size 1)
+    (block-vector-checker #f #f)))
+
+(block-vector-test)
+;(clear-and-gc)
+
+;(clear-and-gc)
+;(*s7* 'memory-usage)
+
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(exit)
+
diff --git a/s7/tools/tcase.scm b/s7/tools/tcase.scm
new file mode 100644
index 0000000..0256086
--- /dev/null
+++ b/s7/tools/tcase.scm
@@ -0,0 +1,596 @@
+;(set! (*s7* 'profile) 1)
+(set! (*s7* 'heap-size) 1024000)
+
+(define-macro (test expr res)
+  `(let ((value ,expr))
+     (unless (equivalent? value ,res)
+       (format *stderr* "~S, expected: ~S, got: ~S~%" ',expr ,res value))))
+
+(require case.scm)
+(define (scase x)
+  (case* x
+      ((a b) 'a-or-b)
+      ((1 2/3 3.0) => (lambda (a) (* a 2)))
+      ((#_pi) 1 123)
+      (("string1" "string2"))
+      ((#<symbol?>) 'symbol!)
+      (((+ x #<symbol?>)) 'got-list)
+      ((#(1 x 3)) 'got-vector)
+      (((+ #<>)) 'empty)
+      (((* #<x:symbol?> #<x>)) 'got-label)
+      (((#<> #<x:> #<x>)) 'repeated)
+      (((#<symbol?> #<symbol?>)) 'two)
+      (((#<x:> #<x>)) 'pair)
+      ((#(#<x:> #<x>)) 'vector)
+      ((#(#<symbol?> #<...> #<number?>)) 'vectsn)
+      ((#(#<...> #<number?>)) 'vectstart)
+      ((#(#<string?> #<char-whitespace?> #<...>)) 'vectstr)
+      (else 'oops)))
+  
+(define (scase5 x)
+  (case* x
+    (((#<symbol?> #<...> #<symbol?>)) 'ok)))
+
+(let ((local-func (lambda (key) (eqv? key 1))))
+  (define (scase1 x)
+    (case* x
+      ((2 3 a) 'oops)
+      ((#<local-func>) 'yup))))
+
+(define scase2
+  (let ((local-func (lambda (key) (eqv? key 1))))
+    (lambda (x)
+      (case* x
+	((2 3 a) 'oops)
+	((#<local-func>) 'yup)))))
+
+(define (scase3 x)
+  (let ((local-func (lambda (key) (eqv? key 1))))
+    (case* x
+      ((2 3 a) 'oops)
+      ((#<local-func>) 'yup))))
+
+(define (ecase x)
+  (case* x
+    (((#<symbol?> #<...> #<symbol?>)) 'both-symbol)
+    (((#<symbol?> #<...>)) 'car-symbol)
+    (((#<...> #<symbol?> #<symbol?>)) 'two-symbols)
+    (((#<...> #<symbol?>)) 'end-symbol)
+    (else #f)))
+
+(define (scase6 x)
+  (case* x
+    (((#<x:> #<x> #<...>)) 'ok)
+    (else 'oops)))
+
+(define (scase7 x)
+  (case* x
+    (((#<...> #<x:> #<x>)) 'ok)
+    (else 'oops)))
+
+(define (scase8 x)
+  (case* x
+    (((#<x:> #<...> #<x>)) 'ok)
+    (else 'oops)))
+
+(define (scase9 x)
+  (case* x
+    ((#<y>) 1)
+    (else 'oops)))
+
+(define (scase10 x)
+  (case* x
+    ((#<x>) 1)
+    (else 'oops)))
+
+(define (scase11 x)
+  (case* x
+    ((#<...>) 1)
+    (else 'oops)))
+
+(define (scase12 x)
+  (case* x
+    (((#<y:> #<zzz>)) 1)
+    (else 'oops)))
+
+(define (scase13 x)
+  (case* x
+    ((#<>) 'ok) ; matches anything! as does #<label:>
+    (else 'oops)))
+
+(define (scase14 x)
+  (case* x
+    (((#<y:> #<y:>)) 1)
+    (else 'oops)))
+
+(define uniquify
+  (let ()
+    (define (uniq-1 lst new-lst)
+      (case* lst
+	((()) 
+	 (reverse new-lst))
+	(((#<>))
+	 (reverse (cons (car lst) new-lst)))
+	(((#<x:> #<x> #<...>))
+	 (uniq-1 (cdr lst) new-lst))
+	(else
+	 (uniq-1 (cdr lst) (cons (car lst) new-lst)))))
+    (lambda (lst)
+      (uniq-1 lst ()))))
+
+(define (palindrome? x) ; x can be a list or a vector
+  (case* x
+    ((() (#<>) 
+      #() #(#<>)) 
+     #t)
+    (((#<x:> #<middle:...> #<x>) 
+      #(#<x:> #<middle:...> #<x>))
+     (palindrome? #<middle>))
+    (else #f)))
+
+(define (scase15 x)
+  (case* x
+    (((+ #<x:> #<x>)) (* 2 #<x>))
+    (((#<x:> #<y:>)) (list #<y> #<x>))
+    (else 'oops)))
+
+(define (scase16 x)
+  (case* x
+    (((+ (* #<symbol?> 2) 3)) 0)
+    (else 1)))
+
+(define (scase17 x)
+  (let ((a1 3))
+    (case* x
+      (((+ #<add1:symbol?> (* #<mul1:number?> 2))) (+ #<mul1> (* #<add1> 2)))
+      (else 'oops))))
+
+(let ((a1 3))
+  (define (scase18 x)
+    (case* x
+      (((+ #<add1:symbol?> (* #<mul1:number?> 2))) (quote (+ #<mul1> (* #<add1> 2))))
+      (else 'oops))))
+
+(define (case-reverse x) ; maybe the least efficient reverse ever
+  (case* x
+    (((#<>) ()) x)
+    (((#<first:> #<rest:...>))
+     (append (case-reverse #<rest>) 
+	     (list (quote #<first>))))))
+
+(define (scase19 x)
+  (case* x
+    (((#<integer?> . #<symbol?>)) 'ok)
+    (else #f)))
+
+(define (scase20 x)
+  (case* x
+    ((#(+ (* #<symbol?> 2) 3)) 0)
+    (else 1)))
+
+(define scase21
+  (let ((pair2? (lambda (p) 
+		  (= (length p) 2))))
+    (lambda (x)
+      (case* x
+        (((+ #<pair2?> 3)) #t)
+	(else #f)))))
+
+(define scase22
+  (letrec ((symbols? 
+	    (lambda (x)
+	      (or (null? x)
+		  (and (pair? x)
+		       (and (symbol? (car x))
+			    (symbols? (cdr x))))))))
+    (lambda (x)
+      (case* x
+        ((#<symbols?>) #t)
+        (else #f)))))
+
+(define scase23
+  (let ((numeric-op? (lambda (x)
+		       (let ((func (symbol->value x)))
+			 (and (signature func)
+			      (memq (car (signature func)) '(number? complex? real? float? rational? integer? byte?)))))))
+    (lambda (x)
+      (case* x
+        (((#<numeric-op?> #<number?>)
+	  (#<numeric-op?> #<number?> #<number?>)) #t)
+        (else #f)))))
+
+(define (scase24 x)
+  (case* x
+    (((+ #<rest:...>))
+     (+ (apply values #<rest>)))
+    (else 'oops)))
+
+(define (scase25 x)
+  (case* x
+    (((#<symbol?> #<ellip1:...> (+ #<ellip2:...>))) (append #<ellip1> #<ellip2>))
+    (else #f)))
+
+(define (scase26 x)
+  (case* x
+    (((if (not #<test:>) (begin #<body:...>))) (cons 'unless (cons '#<test> #<body>)))
+    (((if (not #<test:>) #<body:>)) (cons 'unless (list '#<test> '#<body>)))
+    (((if #<test:> (begin #<body:...>))) (cons 'when (cons '#<test> #<body>)))
+    (((if #<test:> #<body:>)) (cons 'when (list '#<test> '#<body>)))))
+
+
+(define (scase27 x)
+  (let ((efunc? (lambda (x)
+		  (and (pair? x)
+		       (number? (car x))))))
+    (case* x
+      (((#<label,efunc?:...>)) #t)
+      (else #f))))
+
+(define (scase29 x)
+  (let ((match? ((funclet 'case*) 'case*-match?)))
+    (let ((multiplier? (lambda (x)
+			 (or (match? x '(* 1 #<integer?>))
+			     (match? x '(* 2 #<integer?>))))))
+      (case* x
+	(((+ #<integer?> #<multiplier?> #<integer?>)) #t)
+	(else #f)))))
+
+(define (scase30 x)
+  (let ((match? ((funclet 'case*) 'case*-match?)))
+    (match? x '(+ #<symbol?> 1))))
+
+(define* (scase31 x (e (curlet)))
+  (let ((match? ((funclet 'case*) 'case*-match?))
+        (labels ((funclet 'case*) 'case*-labels)))
+    (and (match? x '(#<symbol?> #<ellip1:...> (+ #<ellip2:...>)))
+         (append (cadr (labels 'ellip1)) (cadr (labels 'ellip2))))))
+
+(define (scase32 x)
+  (let ((match? ((funclet 'case*) 'case*-match?))
+        (labels ((funclet 'case*) 'case*-labels)))
+    (if (match? x '(if #<test:> (begin #<body:...>)))
+	(cons 'when (cons (labels 'test) (cadr (labels 'body)))))))
+
+(define (scase33 x)
+  (case* x
+    ((#<"a.b">) #t)
+    (else #f)))
+
+(define (scase34 x)
+  (case* x
+    ((#<reg:"a.b">) #<reg>)
+    (else #f)))
+
+(define (scase35 x)
+  (let ((quotes? (lambda (x)
+		   (char-position #\" x))))
+    (case* x
+      ((#<"^dog">) 'dog0)
+      ((#<"gray\|grey">) 'graey) ; basic regex so it needs \, apparently doesn't work in OSX?
+      ((#<"h\(a\|e\)y">) 'haey) 
+      ((#<"p[ae]y">) 'paey)
+      ((#<"b[aeiou]bble">) 'bxbble)
+      ((#<"z\{3,6\}">) 'zzz)
+      ((#<"\d">) 'digit)
+      ((#<"<>">) 'brackets)
+      ((#<quotes?>) 'quotes)
+      ((#<"[^i*&2@]">) 'not-i)
+      (else #f))))
+
+
+(test (scase 3.0) 6.0)
+(test (scase pi) 123)
+(test (scase "string1") "string1")
+(test (scase "string3") 'oops)
+(test (scase 'a) 'a-or-b)
+(test (scase 'abc) 'symbol!)
+(test (scase #()) 'oops)
+(test (scase '(+ x z)) 'got-list)
+(test (scase #(1 x 3)) 'got-vector)
+(test (scase '(+ x 3)) 'oops)
+(test (scase '(+ x)) 'empty)
+(test (scase '(* z z)) 'got-label)
+(test (scase '(* z x)) 'oops)
+(test (scase '(+ (abs x) (abs x))) 'repeated)
+(test (scase '(+ (abs x) (abs y))) 'oops)
+(test (scase '(a b)) 'two)
+(test (scase '(1 1)) 'pair)
+(test (scase '(1 1 2)) 'oops)
+(test (scase #(1 1)) 'vector)
+(test (scase #(a b c 3)) 'vectsn)
+(test (scase #(1 b 2)) 'vectstart)
+(test (scase #("asdf" #\space +nan.0 #<eof>)) 'vectstr)
+(test (scase #(a 3)) 'vectsn)
+(test (scase #(1)) 'vectstart)
+(test (scase #("asdf" #\space)) 'vectstr)
+(test (scase #("asdf")) 'oops)
+
+(test (scase5 '(a)) #<unspecified>)
+
+(test (scase2 2) 'oops)
+(test (scase2 32) #<unspecified>)
+(test (scase2 1) 'yup)
+(test (scase3 2) 'oops)
+(test (scase3 32) #<unspecified>)
+(test (scase3 1) 'yup)
+
+(test (scase6 '(a a)) 'ok)
+(test (scase7 '(a a)) 'ok)
+(test (scase8 '(a a)) 'ok)
+(test (catch #t (lambda () (scase9 1)) (lambda (type info) type)) 'oops)
+(test (catch #t (lambda () (scase10 1)) (lambda (type info) type)) 'oops)
+(test (catch #t (lambda () (scase11 1)) (lambda (type info) type)) 'oops)
+(test (catch #t (lambda () (scase12 '(1 2))) (lambda (type info) type)) 'unbound-variable)
+
+(test (ecase '(a b 1)) 'car-symbol)
+(test (ecase '(1 2 c)) 'end-symbol)
+(test (ecase '(a 1 2 3 c)) 'both-symbol)
+(test (ecase '(1 2 3 b c)) 'two-symbols)
+(test (scase13 '(a a)) 'ok)
+(test (scase13 1+i) 'ok)
+(test (scase13 #(1 2 3)) 'ok)
+(test (catch #t (lambda () (scase14 '(1 1))) (lambda (type info) type)) 'syntax-error) ; duplicate identifier currently uses this error type
+(test (uniquify '(a a b b b b a a c c)) '(a b a c))
+(test (uniquify '((+ a 1) (+ a 1) (* b 2) (* b 2) c a a)) '((+ a 1) (* b 2) c a))
+(test (uniquify '(a b b c)) '(a b c))
+(test (uniquify '(a)) '(a))
+(test (uniquify ()) ())
+
+(let ((x '(+ 2 3)))
+  (test (case* x
+	  (((+ #<> #<>)) (apply + (cdr x)))
+	  (else (error 'out-of-range "unimplemented")))
+	5))
+
+(test (palindrome? '(a b a)) #t)
+(test (palindrome? '(a b c a)) #f)
+(test (palindrome? '(a b c b a)) #t)
+(test (palindrome? '(a)) #t)
+(test (palindrome? ()) #t)
+
+(test (palindrome? #(a b a)) #t)
+(test (palindrome? #(a b c a)) #f)
+(test (palindrome? #(a b c b a)) #t)
+(test (palindrome? #(a)) #t)
+(test (palindrome? #()) #t)
+
+(test (case* '(a b a) (((#<start:...> #<symbol?>)) #<start>)) '(a b))
+(test (case* '(a) (((#<start:...> #<symbol?>)) #<start>)) ())
+(test (case* '(a b) (((#<start:...> #<symbol?>)) #<start>)) '(a))
+(test (case* '(a b a) (((#<symbol?> #<end:...>)) #<end>)) '(b a))
+(test (case* '(a) (((#<symbol?> #<end:...>)) #<end>)) ())
+(test (case* '(a b) (((#<symbol?> #<end:...>)) #<end>)) '(b))
+(test (case* '(a b a) (((#<symbol?> #<middle:...> #<symbol?>)) #<middle>)) '(b))
+(test (case* '(a a) (((#<symbol?> #<middle:...> #<symbol?>)) #<middle>)) ())
+(test (case* '(a b c a) (((#<symbol?> #<middle:...> #<symbol?>)) #<middle>)) '(b c))
+
+(test (case* #(a b a) ((#(#<start:...> #<symbol?>)) #<start>)) '(a b))
+(test (case* #(a) ((#(#<start:...> #<symbol?>)) #<start>)) ())
+(test (case* #(a b) ((#(#<start:...> #<symbol?>)) #<start>)) '(a))
+(test (case* #(a b a) ((#(#<symbol?> #<end:...>)) #<end>)) '(b a))
+(test (case* #(a) ((#(#<symbol?> #<end:...>)) #<end>)) ())
+(test (case* #(a b) ((#(#<symbol?> #<end:...>)) #<end>)) '(b))
+(test (case* #(a b a) ((#(#<symbol?> #<middle:...> #<symbol?>)) #<middle>)) '(b))
+(test (case* #(a a) ((#(#<symbol?> #<middle:...> #<symbol?>)) #<middle>)) ())
+(test (case* #(a b c a) ((#(#<symbol?> #<middle:...> #<symbol?>)) #<middle>)) '(b c))
+
+(test (scase15 '(1 2)) '(2 1))
+(test (scase15 '(+ 1 1)) 2)
+(test (scase15 '(+ (* 2 3) (* 2 3))) 12)
+(test (scase16 '(+ (* y 2) 3)) 0)
+(test (scase16 '(+ (* y 1) 3)) 1)
+
+(test (scase17 '(+ a1 (* 5 2))) 11)
+
+(test (case-reverse '(a b c)) '(c b a))
+(test (case-reverse '(a b)) '(b a))
+(test (scase19 (cons 1 'a)) 'ok)
+(test (scase19 (list 1 'a)) #f)
+(test (scase20 #(+ (* y 2) 3)) 0)
+(test (scase20 #(+ (* y 1) 3)) 1)
+(test (scase21 '(+ (abs x) 3)) #t)
+(test (scase21 '(+ (* 2 x) 3)) #f)
+(test (scase22 '(+ a b c)) #t)
+(test (scase22 '(+ a b 3)) #f)
+(test (scase23 '(+ 1 2)) #t)
+(test (scase23 '(floor 32.1)) #t)
+(test (scase23 '(abs)) #f)
+(test (scase24 '(+ 1 2 3)) 6)
+
+(test (scase25 '(a b c d (+ 1 2))) '(b c d 1 2))
+(test (scase26 '(if (not (> i 3)) (display i)))                   '(unless (> i 3) (display i)))
+(test (scase26 '(if (not (> i 3)) (begin (display i) (newline)))) '(unless (> i 3) (display i) (newline)))
+(test (scase26 '(if (> i 3) (display i)))                         '(when (> i 3) (display i)))
+(test (scase26 '(if (> i 3) (begin (display i) (newline))))       '(when (> i 3) (display i) (newline)))
+
+(test (scase27 '(1 2 3)) #t)
+(test (scase27 '(a 2 3)) #f)
+(test (scase27 '(3)) #t)
+(test (scase27 ()) #f)
+(test (scase29 '(+ 1 (* 1 2) 3)) #t)
+(test (scase29 '(+ 1 (* 3 2) 3)) #f)
+(test (scase30 '(+ a 1)) #t)
+(test (scase30 '(+ 1 1)) #f)
+(test (scase31 '(a b c d (+ 1 2))) '(b c d 1 2))
+(test (scase32 '(if (> i 3) (begin (display i) (newline)))) '(when (> i 3) (display i) (newline)))
+(test (scase32 '(if 32/15 (begin (display i) (newline)))) '(when 32/15 (display i) (newline)))
+(test (scase33 "a1b") #t)
+(test (scase33 "abc") #f)
+(test (scase33 "a123b") #f)
+(test (scase33 'a1b) #f)
+(test (scase34 "a1b") "a1b")
+(test (scase35 "dog") 'dog0)
+(test (scase35 "i7+") 'not-i)
+(test (scase35 "gray") 'graey)
+(test (scase35 "hay") 'haey)
+(test (scase35 "pay") 'paey)
+(test (scase35 "bubble") 'bxbble)
+(test (scase35 "ab0d") 'digit)
+(test (scase35 "+-<>-+") 'brackets)
+(test (scase35 "zzzz") 'zzz)
+(test (scase35 (string #\a #\")) 'quotes)
+
+
+(define (tst)
+  (do ((i 0 (+ i 1)))
+      ((= i 1000))
+    (scase 3.0) 
+    (scase pi) 
+    (scase "string1") 
+    (scase "string3") 
+    (scase 'a) 
+    (scase 'abc) 
+    (scase #())
+    (scase '(+ x z))
+    (scase #(1 x 3))
+    (scase '(+ x 3))
+    (scase '(+ x))
+    (scase '(* z z))
+    (scase '(* z x))
+    (scase '(+ (abs x)))
+    (scase '(+ (abs x)))
+    (scase '(a b))
+    (scase '(1 1))
+    (scase '(1 1 2))
+    (scase #(1 1))
+    (scase #(a b c 3))
+    (scase #(1 b 2))
+    (scase #("asdf" #\space +nan.0 #<eof>))
+    (scase #(a 3))
+    (scase #(1))
+    (scase #("asdf" #\space))
+    (scase #("asdf"))
+    
+    (scase5 '(a))
+    
+    (scase2 2) 
+    (scase2 32) 
+    (scase2 1) 
+    (scase3 2) 
+    (scase3 32) 
+    (scase3 1) 
+    
+    (scase6 '(a a))
+    (scase7 '(a a))
+    (scase8 '(a a))
+    (catch #t (lambda () (scase9 1)) (lambda (type info) type))
+    (catch #t (lambda () (scase10 1)) (lambda (type info) type))
+    (catch #t (lambda () (scase11 1)) (lambda (type info) type))
+    (catch #t (lambda () (scase12 '(1 2))) (lambda (type info) type))
+    
+    (ecase '(a b 1))
+    (ecase '(1 2 c))
+    (ecase '(a 1 2 3 c))
+    (ecase '(1 2 3 b c))
+    (scase13 '(a a))
+    (scase13 1+i)
+    (scase13 #(1 2 3))
+    (catch #t (lambda () (scase14 '(1 1))) (lambda (type info) type))
+    
+    (uniquify '(a a b b b b a a c c))
+    (uniquify '((+ a 1) (+ a 1) (* b 2) (* b 2) c a a))
+    (uniquify '(a b b c))
+    (uniquify '(a))
+    (uniquify ())
+    
+    (let ((x '(+ 2 3)))
+      (case* x
+	(((+ #<> #<>)) (apply + (cdr x)))
+	(else (error 'out-of-range "unimplemented"))))
+    
+    (palindrome? '(a b a)) 
+    (palindrome? '(a b c a))
+    (palindrome? '(a b c b a))
+    (palindrome? '(a))
+    (palindrome? ()) 
+    
+    (palindrome? #(a b a)) 
+    (palindrome? #(a b c a)) 
+    (palindrome? #(a b c b a))
+    (palindrome? #(a)) 
+    (palindrome? #())
+    
+    (case* '(a b a) (((#<start:...> #<symbol?>)) #<start>))
+    (case* '(a) (((#<start:...> #<symbol?>)) #<start>)) 
+    (case* '(a b) (((#<start:...> #<symbol?>)) #<start>))
+    (case* '(a b a) (((#<symbol?> #<end:...>)) #<end>))
+    (case* '(a) (((#<symbol?> #<end:...>)) #<end>))
+    (case* '(a b) (((#<symbol?> #<end:...>)) #<end>))
+    (case* '(a b a) (((#<symbol?> #<middle:...> #<symbol?>)) #<middle>))
+    (case* '(a a) (((#<symbol?> #<middle:...> #<symbol?>)) #<middle>))
+    (case* '(a b c a) (((#<symbol?> #<middle:...> #<symbol?>)) #<middle>)) 
+    
+    (case* #(a b a) ((#(#<start:...> #<symbol?>)) #<start>))
+    (case* #(a) ((#(#<start:...> #<symbol?>)) #<start>))
+    (case* #(a b) ((#(#<start:...> #<symbol?>)) #<start>)) 
+    (case* #(a b a) ((#(#<symbol?> #<end:...>)) #<end>)) 
+    (case* #(a) ((#(#<symbol?> #<end:...>)) #<end>)) 
+    (case* #(a b) ((#(#<symbol?> #<end:...>)) #<end>)) 
+    (case* #(a b a) ((#(#<symbol?> #<middle:...> #<symbol?>)) #<middle>)) 
+    (case* #(a a) ((#(#<symbol?> #<middle:...> #<symbol?>)) #<middle>))
+    (case* #(a b c a) ((#(#<symbol?> #<middle:...> #<symbol?>)) #<middle>))
+    
+    (scase15 '(1 2))
+    (scase15 '(+ 1 1))
+    (scase15 '(+ (* 2 3) (* 2 3))) 
+    (scase16 '(+ (* y 2) 3))
+    (scase16 '(+ (* y 1) 3))
+    
+    (scase17 '(+ a1 (* 5 2)))
+    
+    (case-reverse '(a b c))
+    (case-reverse '(a b)) 
+    (scase19 (cons 1 'a)) 
+    (scase19 (list 1 'a)) 
+    (scase20 #(+ (* y 2) 3))
+    (scase20 #(+ (* y 1) 3))
+    (scase21 '(+ (abs x) 3))
+    (scase21 '(+ (* 2 x) 3))
+    (scase22 '(+ a b c))
+    (scase22 '(+ a b 3))
+    (scase23 '(+ 1 2)) 
+    (scase23 '(floor 32.1)) 
+    (scase23 '(abs)) 
+    (scase24 '(+ 1 2 3))
+    
+    (scase25 '(a b c d (+ 1 2)))
+    (scase26 '(if (not (> i 3)) (display i)))
+    (scase26 '(if (not (> i 3)) (begin (display i) (newline))))
+    (scase26 '(if (> i 3) (display i)))
+    (scase26 '(if (> i 3) (begin (display i) (newline))))
+    
+    (scase27 '(1 2 3))
+    (scase27 '(a 2 3))
+    (scase27 '(3))
+    (scase27 ())
+    (scase29 '(+ 1 (* 1 2) 3))
+    (scase29 '(+ 1 (* 3 2) 3))
+    (scase30 '(+ a 1))
+    (scase30 '(+ 1 1))
+    (scase31 '(a b c d (+ 1 2)))
+    (scase32 '(if (> i 3) (begin (display i) (newline))))
+    (scase32 '(if 32/15 (begin (display i) (newline))))
+    (scase33 "a1b")
+    (scase33 "abc")
+    (scase33 "a123b")
+    (scase33 'a1b)
+    (scase34 "a1b")
+    (scase35 "dog")
+    (scase35 "i7+")
+    (scase35 "gray")
+    (scase35 "hay")
+    (scase35 "pay")
+    (scase35 "bubble")
+    (scase35 "ab0d")
+    (scase35 "+-<>-+")
+    (scase35 "zzzz")
+    (scase35 (string #\a #\"))
+    ))
+
+(tst)
+
+
+; (when (> (*s7* 'profile) 0) (show-profile 500))
+
+
+(exit)
diff --git a/s7/tools/tclo.scm b/s7/tools/tclo.scm
new file mode 100644
index 0000000..469dca8
--- /dev/null
+++ b/s7/tools/tclo.scm
@@ -0,0 +1,227 @@
+(set! (*s7* 'heap-size) (* 8 1024000))
+
+(define d1-size 200000)
+(define g-size 1000000)
+(define kf-size 30)
+(define k100-size 10000)
+
+(define* (f0 a b)
+  (display b #f))
+
+(define* (f1 a . b)
+  (display b #f))
+
+(define* (f2 a)
+  (display 2 #f))
+
+(define* (f3)
+  (display 3 #f))
+
+(define* (f4)
+  (apply + (list 1 2)))
+
+(define* (f5 (a 1))
+  (apply + (list a 2)))
+
+(define* (f6 a . b)          ; unsafe 
+  (apply values (cons a b)))
+
+(define* (f7 (a 1) (b 2))
+  (apply + (list a b)))
+
+(define* (f8 a b c)
+  (list a b c))
+
+(define* (f9 a :rest b)
+  (list a b))
+
+(define* (f10 a :allow-other-keys)
+  (display a #f))
+
+(define* (f11 . a)
+  (apply list a))
+
+(define* (tfib n (a 1) (b 1))
+  (if (= n 0)
+      a
+      (if (= n 1)
+	  b
+	  (tfib (- n 1) b (+ a b)))))
+
+(define (d1)
+  (tfib 35)
+  (let ((x 1) (y 2))
+    (do ((i 0 (+ i 1)))
+	((= i d1-size))
+      (f0 1 2)
+      (f0 x y)
+      (f0 :a x)
+      (f0 1)
+      (f0)
+      (f0 :a 1 2)
+      (f0 :b 1)
+      (f1 1 2 3)
+      (f1 1 2)
+      (f1 y x)
+      (f1 1)
+      (f1 :a 1)
+      (f1)
+      (f1 (- y 1))
+      (f2) (f2)
+      (f2 1)
+      (f2 :a 1)
+      (f3) (f3) (f3)
+      (f4) (f4) (f4)
+      (f5) (f5)
+      (f5 1)
+      (f5 (- x 1))
+      (f5 :a 1)
+      (f6 1 2 3)
+      (f6 1 2)
+      (f6 1)
+      (f6 :a 1)
+      (f6)
+      (f7 1 2)
+      (f7 1)
+      (f7)
+      (f8)
+      (f8 :b 2)
+      (f8 :c 3 :b 2 :a 1)
+      (f9)
+      (f9 1 x y)
+      (f10)
+      (f10 :a 2 :b 2)
+      (f11)
+      (f11 x)
+      (f11 x y))))
+
+(d1)
+
+;;; -------- comparison with non-key case: --------
+
+(define no-key-fib
+   (lambda (n)
+     (if (<= n 2) 1 (+ (no-key-fib (- n 2))
+                       (no-key-fib (- n 1))))))
+
+(define key-fib
+  (lambda* (n)
+    (if (<= n 2) 1 
+	(+ (key-fib :n (- n 2))
+           (key-fib :n (- n 1))))))
+
+(define (f12 a b)
+  (when (> a b)
+    (+ a b)))
+
+(define* (f13 a b)
+  (when (> a b)
+    (+ a b)))
+
+(define* (f14 (a 1) (b 0))
+  (when (> a b)
+    (+ a b)))
+
+
+(define size g-size)
+
+(define (g1)
+  (do ((i 0 (+ i 1)))
+      ((= i g-size))
+    (f12 i i)))
+
+(define (g2)
+  (do ((i 0 (+ i 1)))
+      ((= i g-size))
+    (f13 i i)))
+
+(define (g3)
+  (do ((i 0 (+ i 1)))
+      ((= i g-size))
+    (f13 :a i :b i)))
+
+(define (g4)
+  (do ((i 0 (+ i 1)))
+      ((= i g-size))
+    (f13 :b i :a i)))
+
+(define (g5)
+  (do ((i 0 (+ i 1)))
+      ((= i g-size))
+    (f14)))
+
+(define (g6)
+  (do ((i 0 (+ i 1)))
+      ((= i g-size))
+    (f14 i i)))
+
+(define (g7)
+  (do ((i 0 (+ i 1)))
+      ((= i g-size))
+    (f14 :a i)))
+
+
+;;; -------- 100 key args --------
+
+(define* (k100 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9
+	      a10 a11 a12 a13 a14 a15 a16 a17 a18 a19
+	      a20 a21 a22 a23 a24 a25 a26 a27 a28 a29
+	      a30 a31 a32 a33 a34 a35 a36 a37 a38 a39
+	      a40 a41 a42 a43 a44 a45 a46 a47 a48 a49
+	      a50 a51 a52 a53 a54 a55 a56 a57 a58 a59
+	      a60 a61 a62 a63 a64 a65 a66 a67 a68 a69
+	      a70 a71 a72 a73 a74 a75 a76 a77 a78 a79
+	      a80 a81 a82 a83 a84 a85 a86 a87 a88 a89
+	      a90 a91 a92 a93 a94 a95 a96 a97 a98 a99)
+  (+ a0 a1))
+
+(define (g100)
+  (let ((args (list :a0 1 :a1 1 :a2 1 :a3 1 :a4 1 :a5 1 :a6 1 :a7 1 :a8 1 :a9 1
+		    :a10 1 :a11 1 :a12 1 :a13 1 :a14 1 :a15 1 :a16 1 :a17 1 :a18 1 :a19 1
+		    :a20 1 :a21 1 :a22 1 :a23 1 :a24 1 :a25 1 :a26 1 :a27 1 :a28 1 :a29 1
+		    :a30 1 :a31 1 :a32 1 :a33 1 :a34 1 :a35 1 :a36 1 :a37 1 :a38 1 :a39 1
+		    :a40 1 :a41 1 :a42 1 :a43 1 :a44 1 :a45 1 :a46 1 :a47 1 :a48 1 :a49 1
+		    :a50 1 :a51 1 :a52 1 :a53 1 :a54 1 :a55 1 :a56 1 :a57 1 :a58 1 :a59 1
+		    :a60 1 :a61 1 :a62 1 :a63 1 :a64 1 :a65 1 :a66 1 :a67 1 :a68 1 :a69 1
+		    :a70 1 :a71 1 :a72 1 :a73 1 :a74 1 :a75 1 :a76 1 :a77 1 :a78 1 :a79 1
+		    :a80 1 :a81 1 :a82 1 :a83 1 :a84 1 :a85 1 :a86 1 :a87 1 :a88 1 :a89 1
+		    :a90 1 :a91 1 :a92 1 :a93 1 :a94 1 :a95 1 :a96 1 :a97 1 :a98 1 :a99 1)))
+  (do ((i 0 (+ i 1)))
+      ((= i k100-size))
+    (apply k100 args))))
+
+;;; --------------------------------
+(define (kcall)
+  (no-key-fib kf-size)
+  (key-fib kf-size))
+(kcall)
+
+(g1)
+(g2)
+(g3)
+(g4)
+(g5)
+(g6)
+(g7)
+
+(g100)
+
+
+;;; --------------------------------
+(define* (f2 x y)
+  (or (null? x)
+      (and (symbol? (car x))
+	   (f2 (cdr x) (+ y 1)))))
+
+(define (test2 lst)
+  (do ((i 0 (+ i 1)))
+      ((= i 100000))
+    (f2 lst 0)))
+
+(test2 (make-list 10 'a))
+
+;;; --------------------------------
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+
+(exit)
diff --git a/s7/tools/tcopy.scm b/s7/tools/tcopy.scm
new file mode 100644
index 0000000..fd46ecf
--- /dev/null
+++ b/s7/tools/tcopy.scm
@@ -0,0 +1,537 @@
+(set! (*s7* 'heap-size) (* 8 1024000))
+
+(when (provided? 'pure-s7)
+  (define (vector-append . args)
+    (if (null? args)
+	#()
+	(if (vector? (car args))
+	    (apply append args)
+	    (error 'wrong-type-arg "vector-append arguments should be vectors: ~A" args)))))
+
+
+(define (cpy1 x y) ; opt_dox
+  (do ((i 0 (+ i 1))
+       (len (length x)))
+      ((= i len) y)
+    (int-vector-set! y i (int-vector-ref x i))))
+
+(define (tst-cpy1)
+  (let ((x (make-int-vector 1000000 123))
+	(y (make-int-vector 1000000 0)))
+    (cpy1 x y)
+    (unless (equal? y (make-int-vector 1000000 123))
+      (format *stderr* "y1: ~S~%" y))))
+
+(tst-cpy1)
+
+(define (cpy2 x y) ; opt_dotimes
+  (let ((len (length x)))
+    (do ((i 0 (+ i 1)))
+	((= i len) y)
+      (int-vector-set! y i (int-vector-ref x i)))))
+
+(define (tst-cpy2)
+  (let ((x (make-int-vector 1000000 123))
+	(y (make-int-vector 1000000 0)))
+    (cpy2 x y)
+    (unless (equal? y (make-int-vector 1000000 123))
+      (format *stderr* "y2: ~S~%" y))))
+
+(tst-cpy2)
+
+;;; --------------------------------------------------------------------------------
+
+(define (cpy3 x y) ; opt_dotimes
+  (do ((len (length x))
+       (i 0 (+ i 1)))
+      ((= i len) y)
+    (float-vector-set! y i (float-vector-ref x i))))
+
+(define (tst-cpy3)
+  (let ((x (make-float-vector 1000000 123.0))
+	(y (make-float-vector 1000000 0.0)))
+    (cpy3 x y)
+    (unless (equal? y (make-float-vector 1000000 123.0))
+      (format *stderr* "y3: ~S~%" y))))
+
+(tst-cpy3)
+
+(define (cpy4 x y) ; opt_dotimes
+  (let ((len (length x)))
+    (do ((i 0 (+ i 1)))
+	((= i len) y)
+      (float-vector-set! y i (float-vector-ref x i)))))
+
+(define (tst-cpy4)
+  (let ((x (make-float-vector 1000000 123.0))
+	(y (make-float-vector 1000000 0.0)))
+    (cpy4 x y)
+    (unless (equal? y (make-float-vector 1000000 123.0))
+      (format *stderr* "y4: ~S~%" y))))
+
+(tst-cpy4)
+
+;;; --------------------------------------------------------------------------------
+
+(define (cpy5 x y)
+  (do ((len (length x))
+       (i 0 (+ i 1)))
+      ((= i len) y)
+    (vector-set! y i (vector-ref x i))))
+
+(define (tst-cpy5)
+  (let ((x (make-vector 1000000 'a))
+	(y (make-vector 1000000 #f)))
+    (cpy5 x y)
+    (unless (equal? y (make-vector 1000000 'a))
+      (format *stderr* "y5: ~S~%" y))))
+
+(tst-cpy5)
+
+(define (cpy6 x y) ; opt_do_copy
+  (let ((len (length x)))
+    (do ((i 0 (+ i 1)))
+	((= i len) y)
+      (vector-set! y i (vector-ref x i)))))
+
+(define (tst-cpy6)
+  (let ((x (make-vector 1000000 'a))
+	(y (make-vector 1000000 #f)))
+    (cpy6 x y)
+    (unless (equal? y (make-vector 1000000 'a))
+      (format *stderr* "y6: ~S~%" y))))
+
+(tst-cpy6)
+
+;;; --------------------------------------------------------------------------------
+
+(define (cpy7 x y)
+  (do ((len (length x))
+       (i 0 (+ i 1)))
+      ((= i len) y)
+    (string-set! y i (string-ref x i))))
+
+(define (tst-cpy7)
+  (let ((x (make-string 1000000 #\a))
+	(y (make-string 1000000 #\b)))
+    (cpy7 x y)
+    (unless (equal? y (make-string 1000000 #\a))
+      (format *stderr* "y7: ~S~%" y))))
+
+(tst-cpy7)
+
+(define (cpy8 x y) ; opt_do_copy
+  (let ((len (length x)))
+    (do ((i 0 (+ i 1)))
+	((= i len) y)
+      (string-set! y i (string-ref x i)))))
+
+(define (tst-cpy8)
+  (let ((x (make-string 1000000 #\a))
+	(y (make-string 1000000 #\b)))
+    (cpy8 x y)
+    (unless (equal? y (make-string 1000000 #\a))
+      (format *stderr* "y8: ~S~%" y))))
+
+(tst-cpy8)
+
+;;; --------------------------------------------------------------------------------
+
+(define (cpy9 x y)
+  (do ((len (length x))
+       (i 0 (+ i 1)))
+      ((= i len) y)
+    (list-set! y i (list-ref x i))))
+
+(define (tst-cpy9)
+  (let ((x (make-list 10000 #\a))
+	(y (make-list 10000 #\b)))
+    (cpy9 x y)
+    (unless (equal? y (make-list 10000 #\a))
+      (format *stderr* "y9: ~S~%" y))))
+
+(tst-cpy9)
+
+(define (cpy10 x y) ; opt_do_copy
+  (let ((len (length x)))
+    (do ((i 0 (+ i 1)))
+	((= i len) y)
+      (list-set! y i (list-ref x i)))))
+
+(define (tst-cpy10)
+  (let ((x (make-list 10000 #\a))
+	(y (make-list 10000 #\b)))
+    (cpy10 x y)
+    (unless (equal? y (make-list 10000 #\a))
+      (format *stderr* "y10: ~S~%" y))))
+
+(tst-cpy10)
+
+;;; --------------------------------------------------------------------------------
+
+(define (cpy11 x y)
+  (let loop ((x x) (y y))
+    (when (pair? x)
+      (set-car! y (car x))
+      (loop (cdr x) (cdr y))))
+  y)
+
+(define (tst-cpy11)
+  (let ((x (make-list 200000 #\a))
+	(y (make-list 200000 #\b)))
+    (cpy11 x y)
+    (unless (equal? y (make-list 200000 #\a))
+      (format *stderr* "y11: ~S~%" y))))
+
+(tst-cpy11)
+
+(define (cpy12 x y)
+  (let ((len (- (length x) 1)))
+    (when (>= len 0)
+      (let loop ((i 0))
+	(vector-set! y i (vector-ref x i))
+	(if (< i len)
+	    (loop (+ i 1))))))
+  y)
+
+(define (tst-cpy12)
+  (let ((x (make-vector 200000 #\a))
+	(y (make-vector 200000 #\b)))
+    (cpy12 x y)
+    (unless (equal? y (make-vector 200000 #\a))
+      (format *stderr* "y12: ~S~%" y))))
+
+(tst-cpy12)
+
+;;; --------------------------------------------------------------------------------
+
+(define (f1 v)
+  (do ((i 0 (+ i 1)))
+      ((= i 1000))
+    (vector-set! v i 2.0)))
+
+(define (ftest1)
+  (let ((v (make-vector 1000)))
+    (do ((i 0 (+ i 1)))
+	((= i 10000) v)
+      (f1 v))))
+
+(ftest1)
+
+
+(define (f2 v)
+  (do ((i 0 (+ i 1)))
+      ((= i 1000))
+    (string-set! v i #\a)))
+
+(define (ftest2)
+  (let ((v (make-string 1000)))
+    (do ((i 0 (+ i 1)))
+	((= i 10000) v)
+      (f2 v))))
+
+(ftest2)
+
+
+(define (f3 v)
+  (do ((i 0 (+ i 1)))
+      ((= i 1000))
+    (float-vector-set! v i 2.0)))
+
+(define (ftest3)
+  (let ((v (make-float-vector 1000)))
+    (do ((i 0 (+ i 1)))
+	((= i 10000) v)
+      (f3 v))))
+
+(ftest3)
+
+
+(define (f4 v)
+  (do ((i 0 (+ i 1)))
+      ((= i 1000))
+    (int-vector-set! v i 2)))
+
+(define (ftest4)
+  (let ((v (make-int-vector 1000)))
+    (do ((i 0 (+ i 1)))
+	((= i 10000) v)
+      (f4 v))))
+
+(ftest4)
+
+
+(define (f5 v)
+  (do ((i 0 (+ i 1)))
+      ((= i 1000))
+    (list-set! v i 2.0)))
+
+(define (ftest5)
+  (let ((v (make-list 1000)))
+    (do ((i 0 (+ i 1)))
+	((= i 1000) v)
+      (f5 v))))
+
+(ftest5)
+
+
+;;; --------------------------------------------------------------------------------
+
+(let ((new-env (sublet (curlet) (cons 'init_func 'block_init)))) ; load calls init_func if possible
+  ;; depends on running s7test first normally
+  (load "s7test-block.so" new-env))
+
+(define (test-copy size)
+  (let ((old-string (make-string size #\a))
+	(old-bvect (make-byte-vector size 1))
+	(old-pair (make-list size #\a))
+	(old-vector (make-vector size #\a char?))
+	(old-vectorf (make-vector size 1.0 real?))
+	(old-vectori (make-vector size 1 integer?))
+	(old-fvect (make-float-vector size 1.0))
+	(old-ivect (make-int-vector size 1))
+	(old-hash (make-hash-table size))
+	(old-let (inlet))
+	(old-block (make-block size)))
+
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (hash-table-set! old-hash (string->symbol (number->string i)) #\a)) ; gensym is slower, even with "" as prefix 
+    (copy old-hash old-let)
+
+    (let ((new-string (make-string size #\space))
+	  (new-bvect (make-byte-vector size 0))
+	  (new-pair (make-list size 1))
+	  (new-vector (make-vector size 1))
+	  (new-fvect (make-float-vector size 1.0))
+	  (new-ivect (make-int-vector size 1))
+	  (new-hash (make-hash-table (* size 2)))
+	  (new-let (inlet))
+	  (new-block (make-block size)))
+      
+      (copy old-string)
+      (copy old-pair)
+      (copy old-vector)
+      (copy old-fvect)
+      (copy old-ivect)
+      (copy old-hash)
+      (copy old-let)
+      (copy old-bvect)
+      (copy old-block)
+      
+      (length old-string)
+      (length old-pair)
+      (length old-vector)
+      (length old-fvect)
+      (length old-ivect)
+      (length old-hash)
+      (length old-let)
+      (length old-bvect)
+      (length old-block)
+      
+      (fill! old-string #\a)
+      (fill! new-string #\space)
+      (fill! old-pair #\a)
+      (fill! new-pair 1)
+      (fill! old-vector #\a)
+      (fill! new-vector 1)
+      (fill! old-fvect 1.0)
+      (fill! new-fvect 1.0)
+      (fill! old-ivect 1)
+      (fill! new-ivect 1)
+      (fill! old-bvect 1)
+      (fill! new-bvect 0)
+      (fill! old-block 0.0)
+      (fill! new-block 1.0)
+      
+      (copy old-string new-string)
+      (copy old-vector new-string)
+      (copy old-pair new-string)
+      (copy old-bvect new-string)
+      
+      (copy old-bvect new-bvect)
+      (copy old-ivect new-bvect)
+      (copy old-vectori new-bvect)
+      (copy old-string new-bvect)
+      
+      (copy old-pair new-pair)
+      (copy old-string new-pair)
+      (copy old-vector new-pair)
+      (copy old-hash new-pair)
+      (copy old-fvect new-pair)
+      (copy old-ivect new-pair)
+      (copy old-let new-pair)
+      (copy old-block new-pair)
+      (set! new-pair #f)
+      
+      (copy old-vector new-vector)
+      (copy old-pair new-vector)
+      (copy old-string new-vector)
+      (copy old-fvect new-vector)
+      (copy old-ivect new-vector)
+      (copy old-hash new-vector)
+      (copy old-let new-vector)
+      (copy old-block new-vector)
+      (set! new-vector #f)
+      
+      (copy old-fvect new-fvect)
+      (copy old-ivect new-fvect)
+      (copy old-vectorf new-fvect)
+      (copy old-block new-fvect)
+      
+      (copy old-ivect new-ivect)
+      ;;; (copy old-fvect new-ivect)
+      (copy old-vectori new-ivect)
+      (copy old-bvect new-ivect)
+      
+      (copy old-hash new-hash)
+      (copy old-let new-hash)
+      
+      (copy old-let new-let)
+      
+      (copy old-fvect new-block)
+      (copy old-block new-block))
+    
+    (let ((nsize (/ size 2))
+	  (start (/ size 4)))
+      (let ((new-string (make-string size #\space))
+	    (new-pair (make-list size 1))
+	    (new-vector (make-vector size 1))
+	    (new-fvect (make-float-vector size 1.0))
+	    (new-ivect (make-int-vector size 1))
+	    (new-hash (make-hash-table (* size 2)))
+	    (new-let (inlet))
+	    (new-bvect (make-byte-vector size 255))
+	    (new-block (make-block size)))
+	
+	(copy old-string new-string start (+ start nsize))
+	(copy old-vector new-string start (+ start nsize))
+	(copy old-pair new-string start (+ start nsize))
+	
+	(copy old-bvect new-bvect start (+ start nsize))
+	(copy old-vectori new-bvect start (+ start nsize))
+	(copy old-ivect new-bvect start (+ start nsize))
+	(copy old-string new-bvect start (+ start nsize))
+	
+	(copy old-pair new-pair start (+ start nsize))
+	(copy old-string new-pair start (+ start nsize))
+	(copy old-vector new-pair start (+ start nsize))
+	(copy old-hash new-pair start (+ start nsize))
+	(copy old-fvect new-pair start (+ start nsize))
+	(copy old-ivect new-pair start (+ start nsize))
+	(copy old-let new-pair start (+ start nsize))
+	(copy old-block new-pair start (+ start nsize))
+	(set! new-pair #f)
+	
+	(copy old-vector new-vector start (+ start nsize))
+	(copy old-pair new-vector start (+ start nsize))
+	(copy old-string new-vector start (+ start nsize))
+	(copy old-fvect new-vector start (+ start nsize))
+	(copy old-ivect new-vector start (+ start nsize))
+	(copy old-hash new-vector start (+ start nsize))
+	(copy old-let new-vector start (+ start nsize))
+	(copy old-block new-vector start (+ start nsize))
+	(set! new-vector #f)
+	
+	(copy old-fvect new-fvect start (+ start nsize))
+	(copy old-ivect new-fvect start (+ start nsize))
+	(copy old-vectorf new-fvect start (+ start nsize))
+	(copy old-block new-fvect start (+ start nsize))
+	
+	(copy old-ivect new-ivect start (+ start nsize))
+	;;;(copy old-fvect new-ivect start (+ start nsize))
+	(copy old-vectori new-ivect start (+ start nsize))
+	(copy old-bvect new-ivect start (+ start nsize))
+	
+	(copy old-hash new-hash start (+ start nsize))
+	(copy old-let new-hash start (+ start nsize))
+	
+	(copy old-let new-let start (+ start nsize))
+	
+	(copy old-fvect new-block start (+ start nsize))
+	(copy old-block new-block start (+ start nsize))))
+    
+    (reverse old-string)
+    (reverse old-pair)
+    (reverse old-vector)
+    (reverse old-fvect)
+    (reverse old-ivect)
+    (reverse old-hash)
+    (reverse old-bvect)
+    (reverse old-block)
+    
+    (reverse! old-string)
+    (reverse! old-pair)
+    (reverse! old-vector)
+    (reverse! old-fvect)
+    (reverse! old-ivect)
+    (reverse! old-bvect)
+    (reverse! old-block)
+    ))
+
+(define-expansion (test tst expected)
+  `(let ((val ,tst))
+     (unless (equal? val ,expected)
+       (format *stderr* "~S: ~S but expected ~S~%" ',tst val ,expected))))
+
+(define (test-append size)
+  (let ((strs ())
+	(vecs ())
+	(fvecs ())
+	(ivecs ())
+	(ifvecs ())
+	(allvecs ())
+	(bvecs ())
+	(lsts ()))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (set! strs (cons (make-string size (integer->char (+ 1 (random 255)))) strs))
+      (set! bvecs (cons (string->byte-vector (make-string size (integer->char (random 256)))) bvecs))
+      (set! vecs (cons (make-vector size i) vecs))
+      (set! ivecs (cons (make-int-vector size i) ivecs))
+      (set! fvecs (cons (make-float-vector size (* i 1.0)) fvecs))
+      (set! allvecs (cons (make-vector size (if (even? i) (* i 1.0) i)) allvecs))
+      (set! lsts (cons (make-list size i) lsts)))
+    (let ((lst (apply append lsts))
+	  (vec (apply vector-append vecs))
+	  (fvec (apply vector-append fvecs))
+	  (ivec (apply vector-append ivecs))
+	  (allvec (apply vector-append allvecs))
+	  (str (apply string-append strs))
+	  (bvec (apply vector-append bvecs)))
+      (test (vector? vec) #t)
+      (test (length vec) (* size size))
+      (test (float-vector? fvec) #t)
+      (test (length fvec) (* size size))
+      (test (int-vector? ivec) #t)
+      (test (length ivec) (* size size))
+      (test (vector? allvec) #t)
+      (test (length allvec) (* size size))
+      (test (pair? lst) #t)
+      (test (length lst) (* size size))
+      (test (string? str) #t)
+      (test (length str) (* size size))
+      (test (byte-vector? bvec) #t)
+      (test (length bvec) (* size size))
+      )))
+      
+(define (t)
+  (do ((i 0 (+ i 1)))
+      ((= i 10000))
+    (test-copy 100))
+  (do ((i 1 (* i 10)))
+      ((> i 1000))
+    (test-append i)))
+
+(t)
+
+#|
+(test-copy 1000000)
+;100000 : .089
+;1000000 : 1.7
+;10000000 : 121
+|#
+
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(exit)
diff --git a/s7/tools/teq.scm b/s7/tools/teq.scm
new file mode 100644
index 0000000..31aef9e
--- /dev/null
+++ b/s7/tools/teq.scm
@@ -0,0 +1,114 @@
+;;; cyclic/shared timing tests
+
+;(set! (*s7* 'heap-size) (* 2 1024000))
+
+;;; equal? write/object->string/format cyclic-sequences
+
+(define* (make-circular-list n init)
+  (let ((lst (make-list n init)))
+    (set-cdr! (list-tail lst (- n 1)) lst)))
+
+(define list-0 (list 1 2 3 4))
+(define vect-0 (vector 1 2 3 4))
+(define let-0 (inlet :a 1 :b 2))
+(define hash-0 (hash-table :a 1 :b 2))
+
+(define list-1 (make-circular-list 1))
+(set-car! list-1 #t)
+(define hash-1 (hash-table :a list-1))
+(define vect-1 (vector list-1))
+(define let-1 (inlet :a list-1))
+(define list-2 (list list-1 list-1))
+(define list-3 (make-circular-list 3))
+(define vect-2 (let* ((z (vector 1 2))
+		      (y (list 1 z 2))
+		      (x (hash-table 'x y)))
+		 (set! (z 1) x)
+		 z))
+(define vect-3 (let ((x '(1 2)))
+		 (vector x (list x x))))
+(define vect-4 (let ((v (vector 1 2 3 4))
+		     (lst (list 1 2)))
+		 (set-cdr! (cdr lst) lst)
+		 (set! (v 0) v)
+		 (set! (v 3) lst)))
+(define hash-2 (let ((h1 (make-hash-table 11)))
+		 (hash-table-set! h1 "hi" h1)))
+(define list-4 (let ()
+		 (define make-node list)
+		 (define prev (dilambda (lambda (node) (node 0)) (lambda (node val) (set! (node 0) val))))
+		 (define next (dilambda (lambda (node) (node 2)) (lambda (node val) (set! (node 2) val))))
+		 ;(define data (dilambda (lambda (node) (node 1)) (lambda (node val) (set! (node 1) val))))
+		 (let* ((head (make-node () 0 ()))
+			(cur head))
+		   (do ((i 1 (+ i 1)))
+		       ((= i 8))
+		     (let ((next-node (make-node cur i ())))
+		       (set! (next cur) next-node)
+		       (set! cur (next cur))))
+		   (set! (next cur) head)
+		   (set! (prev head) cur)
+		   head)))
+
+(define let-2 (let ((hi 3))
+		(let ((e (curlet)))
+		  (set! hi (curlet)) 
+		  e)))
+(define let-3 (let* ((e (inlet 'a 0 'b 1))
+		     (e1 (inlet 'a e)))
+		(set! (e 'b) e1)
+		e))
+(define let-4 (inlet :a vect-0 :b list-0))
+(define hash-3 (hash-table :a vect-0 :b list-0))
+(define hash-4 (hash-table :a hash-1))
+
+(define-constant teq-vars (list list-0 list-1 list-2 list-3 list-4
+			      vect-0 vect-1 vect-2 vect-3 vect-4
+			      hash-0 hash-1 hash-2 hash-3 hash-4
+			      let-0 let-1 let-2 let-3 let-4))
+
+;(format *stderr* "~A ~A ~A ~A ~A~%" (length hash-0) (length hash-1) (length hash-2) (length hash-3) (length hash-4))
+
+;(set! (*s7* 'initial-string-port-length) 64)
+
+(define (equal-tests size)
+  (let ((str #f)
+	(vj #f)
+	(p (open-output-string)))
+    (do ((i 0 (+ i 1)))                 ; nested for-each is almost as fast
+	((= i size))
+      (do ((a teq-vars (cdr a)))
+	  ((null? a))
+	(set! vj (car a))
+	(do ((b teq-vars (cdr b)))
+	    ((null? b))
+	  (if (equal? vj (car b))
+	      (if (not (eq? a b))
+		  (format *stderr* "oops!: ~A ~A~%" a b))))
+	(write vj p)
+	(get-output-string p #t)
+	(object->string vj)
+	(format #f "~A~%" vj)
+	(cyclic-sequences vj)))
+    (close-output-port p)))
+
+(equal-tests 20000)
+
+(define (equivalent-tests size)
+  (let ((vj #f))
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (do ((a teq-vars (cdr a)))
+	((null? a))
+      (set! vj (car a))
+      (do ((b teq-vars (cdr b)))
+	  ((null? b))
+	(if (equivalent? vj (car b))
+	    (if (not (eq? a b)) ; (and ...) would look nicer, but this way is much faster
+		(format *stderr* "oops!: ~A ~A~%" a b))))))))
+
+(equivalent-tests 20000)
+
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(exit)
diff --git a/s7/tools/tests7 b/s7/tools/tests7
new file mode 100755
index 0000000..06e93b8
--- /dev/null
+++ b/s7/tools/tests7
@@ -0,0 +1,194 @@
+#!/bin/csh -f
+
+touch mus-config.h
+cp tools/ffitest.c .
+cp tools/tauto.scm .
+cp ~/cl/t923.scm .
+cp ~/cl/t101.scm .
+cp tools/*.scm .
+# cp ~/cl/make-repl .
+cp ~/cl/low-primes.scm .
+cp ~/cl/full-s7test.scm .
+cp ~/cl/lt.scm .
+cp ~/cl/peak-phases.scm .
+cp ~/cl/arbtest.scm .
+cp ~/cl/threads.c .
+
+echo ' '
+echo '-------- base case --------'
+echo ' '
+gcc s7.c -c -I. -g3 -ldl -lm -Wl,-export-dynamic
+gcc -o repl repl.c -g3 -Wall s7.o -I. -lm -ldl -Wl,-export-dynamic
+repl s7test.scm
+sed 's/(define full-s7test #f)/(define full-s7test #t)/g' s7test.scm > fulltest.scm
+repl fulltest.scm
+repl tauto.scm
+
+echo ' '
+echo '-------- base case + nrepl --------'
+echo ' '
+gcc s7.c -c -I. -g3 -ldl -lm -Wl,-export-dynamic
+gcc -o nrepl nrepl.c -g3 -Wall s7.o -I. -Wl,-export-dynamic -lnotcurses-core -lm -ldl
+nrepl s7test.scm
+
+echo ' '
+echo '-------- with-gmp --------'
+echo ' '
+gcc s7.c -c -I. -g3 -DWITH_GMP -ldl -lm -Wl,-export-dynamic
+gcc -o repl repl.c -g3 -Wall s7.o -I. -lgmp -lmpfr -lmpc -lm -ldl -Wl,-export-dynamic
+repl s7test.scm
+
+echo ' '
+echo '-------- with-gmp precision --------'
+echo ' '
+gcc s7.c -c -I. -g3 -DWITH_GMP -DDEFAULT_BIGNUM_PRECISION=512 -ldl -lm -Wl,-export-dynamic
+gcc -o repl repl.c -g3 -Wall s7.o -I. -lgmp -lmpfr -lmpc -lm -ldl -Wl,-export-dynamic
+repl s7test.scm
+
+echo ' '
+echo '-------- libarb/flint --------'
+echo ' '
+gcc s7.c -c -I. -g3 -DWITH_GMP -DDEFAULT_BIGNUM_PRECISION=512 -ldl -lm -Wl,-export-dynamic
+gcc -o repl repl.c -g3 -Wall s7.o -I. -lgmp -lmpfr -lmpc -lm -ldl -Wl,-export-dynamic
+gcc -fPIC -c libarb_s7.c
+gcc libarb_s7.o -shared -o libarb_s7.so -L/usr/local/lib -lflint
+repl arbtest.scm
+
+echo ' '
+echo '-------- s7-debugging/system-extras --------'
+echo ' '
+gcc s7.c -c -I. -DS7_DEBUGGING -DWITH_SYSTEM_EXTRAS -g3 -ldl -lm -Wl,-export-dynamic
+gcc -o repl repl.c -g3 -Wall s7.o -I. -lm -ldl -Wl,-export-dynamic
+repl s7test.scm
+repl t101.scm
+
+echo ' '
+echo '-------- with-pure-s7 --------'
+echo ' '
+gcc s7.c -c -I. -DWITH_PURE_S7 -g3 -ldl -lm -Wl,-export-dynamic
+gcc -o repl repl.c -g3 -Wall s7.o -I. -lm -ldl -Wl,-export-dynamic
+repl s7test.scm
+repl fulltest.scm
+
+echo ' '
+echo '-------- with-history --------'
+echo ' '
+gcc s7.c -c -I. -DWITH_HISTORY -g3 -ldl -lm -Wl,-export-dynamic
+gcc -o repl repl.c -g3 -Wall s7.o -I. -lm -ldl -Wl,-export-dynamic
+repl s7test.scm
+
+echo ' '
+echo '-------- with-history size --------'
+echo ' '
+gcc s7.c -c -I. -DWITH_HISTORY -DDEFAULT_HISTORY_SIZE=32 -g3 -ldl -lm -Wl,-export-dynamic
+gcc -o repl repl.c -g3 -Wall s7.o -I. -lm -ldl -Wl,-export-dynamic
+repl s7test.scm
+
+echo ' '
+echo '-------- initial sizes --------'
+echo ' '
+gcc s7.c -c -I. -g3 -DINITIAL_HEAP_SIZE=32768 -DINITIAL_STACK_SIZE=512 -DINITIAL_PROTECTED_OBJECTS_SIZE=4 -DGC_TEMPS_SIZE=512 -DSYMBOL_TABLE_SIZE=10009 -DNUM_SMALL_INTS=256 -ldl -lm -Wl,-export-dynamic
+gcc -o repl repl.c -g3 -Wall s7.o -I. -lm -ldl -Wl,-export-dynamic
+repl s7test.scm
+
+echo ' '
+echo '-------- optimized/disable-deprecated --------'
+echo ' '
+gcc s7.c -c -I. -O2 -g -DDISABLE_DEPRECATED -fomit-frame-pointer -funroll-loops -Wall -march=native -ldl -lm -Wl,-export-dynamic 
+gcc -o repl repl.c -g -Wall s7.o -I. -lm -ldl -Wl,-export-dynamic
+repl s7test.scm
+repl fulltest.scm
+
+echo ' '
+echo '-------- with-main --------'
+echo ' '
+gcc s7.c -o repl -DWITH_MAIN -DUSE_SND=0 -I. -g3 -ldl -lm -Wl,-export-dynamic
+repl s7test.scm
+
+echo ' '
+echo '-------- max-string-input --------'
+echo ' '
+gcc s7.c -c -I. -DMAX_SIZE_FOR_STRING_PORT=1024 -DDEFAULT_PRINT_LENGTH=8 -g3 -ldl -lm -Wl,-export-dynamic
+gcc -o repl repl.c -g3 -Wall s7.o -I. -lm -ldl -Wl,-export-dynamic
+repl fulltest.scm
+
+echo ' '
+echo '-------- number-separator --------'
+echo ' '
+gcc s7.c -c -I. -DWITH_NUMBER_SEPARATOR=1 -g3 -ldl -lm -Wl,-export-dynamic
+gcc -o repl repl.c -g3 -Wall s7.o -I. -lm -ldl -Wl,-export-dynamic
+repl fulltest.scm
+
+echo ' '
+echo '-------- disable-autoload --------'
+echo ' '
+gcc s7.c -c -I. -DDISABLE_AUTOLOAD=1 -g3 -ldl -lm -Wl,-export-dynamic
+gcc -o repl repl.c -g3 -Wall s7.o -I. -lm -ldl -Wl,-export-dynamic
+repl fulltest.scm
+
+echo ' '
+echo '-------- silly stuff --------'
+echo ' '
+gcc s7.c -c -I. -DEXTRA_EXPONENT_MARKERS=1 -DS7_ALIGNED=1 -DWITH_VECTORIZE=0 -DWITH_MULTITHREAD_CHECKS=0 -DWITH_DTOA=0 -g3 -ldl -lm -Wl,-export-dynamic
+gcc -o repl repl.c -g3 -Wall s7.o -I. -lm -ldl -Wl,-export-dynamic
+repl s7test.scm
+
+echo ' '
+echo '-------- gc --------'
+echo ' '
+gcc s7.c -c -I. -DGC_RESIZE_HEAP_FRACTION=0.72 -DOUTPUT_PORT_DATA_SIZE=128 -g3 -ldl -lm -Wl,-export-dynamic
+gcc -o repl repl.c -g3 -Wall s7.o -I. -lm -ldl -Wl,-export-dynamic
+repl s7test.scm
+
+echo ' '
+echo '-------- disable-file-output --------'
+echo ' '
+gcc s7.c -c -I. -DDISABLE_FILE_OUTPUT=1 -g3 -ldl -lm -Wl,-export-dynamic
+# gcc -o repl repl.c -g3 -Wall s7.o -I. -lm -ldl -Wl,-export-dynamic
+# repl s7test.scm
+
+echo ' '
+echo '-------- valgrind --------'
+echo ' '
+gcc s7.c -c -I. -g3 -ldl -lm -Wl,-export-dynamic
+gcc -o repl repl.c -g3 -Wall s7.o -I. -lm -ldl -Wl,-export-dynamic
+valgrind repl s7test.scm
+valgrind repl fulltest.scm
+
+gcc -o nrepl s7.c -O2 -I. -Wl,-export-dynamic -lm -ldl -DWITH_MAIN -DWITH_NOTCURSES -lnotcurses-core
+
+echo ' '
+echo '-------- tcc --------'
+echo ' '
+tcc -o repl s7.c -I. -g3 -lm -DWITH_MAIN -ldl -rdynamic -DWITH_C_LOADER -DS7_DEBUGGING
+repl s7test.scm
+
+echo ' '
+echo '-------- fortify flags --------'
+echo ' '
+gcc -o repl s7.c -O2 -I. -g -DWITH_MAIN -Wl,-export-dynamic -lm -ldl -DWITH_C_LOADER -Wall -Wformat=2 -Wtrampolines -U_FORTIFY_SOURCE -D_FORTIFY_SOURCE=3 -D_GLIBCXX_ASSERTIONS -fstack-clash-protection -fstack-protector-strong -Wl,-z,noexecstack -Wl,-z,relro -Wl,-z,now -fcf-protection=full
+repl s7test.scm
+
+echo ' '
+echo '-------- main version --------'
+echo ' '
+gcc s7.c -c -DS7_DEBUGGING=1 -DWITH_HISTORY=1 -DGSL_DISABLE_DEPRECATED -DDISABLE_DEPRECATED -Wall -Wextra -I. -g3 -Wduplicated-cond -Wlogical-op -Wjump-misses-init -Wfatal-errors -Wformat -Wno-implicit-fallthrough -Wpointer-arith -Wduplicated-branches -Wdangling-else -Wno-unused-parameter -Wunused-function -DTRAP_SEGFAULT -DS7_ALIGNED=1 -DINITIAL_HEAP_SIZE=6400 -DNUM_SMALL_INTS=256 -DWITH_NUMBER_SEPARATOR -DWITH_IMMUTABLE_UNQUOTE=1 -Wunreachable-code -Wstrict-aliasing -Wcast-align -Wmissing-declarations -Wmissing-include-dirs -Wuninitialized -Wwrite-strings -Wdouble-promotion -DWITH_ALLOC_COUNTERS=0
+gcc -o repl repl.c -g3 -Wall s7.o -I. -Wl,-export-dynamic -lm -ldl
+repl s7test.scm
+
+# echo ' '
+# echo '-------- fsanitize=address --------'
+# echo ' '
+# gcc s7.c -c -I. -g3 -ldl -lm -Wl,-export-dynamic -fsanitize=address
+# gcc -o repl repl.c -g3 -Wall s7.o -I. -lm -ldl -Wl,-export-dynamic -fsanitize=address -lasan
+# repl s7test.scm
+# 
+# -fsanitize=leak
+# -fsanitize=undefined
+
+echo ' '
+echo '-------- threads --------'
+echo ' '
+gcc s7.c -c -I. -g3 -ldl -lm -Wl,-export-dynamic
+gcc -o threads threads.c s7.o -O -g -Wl,-export-dynamic -pthread -lm -I. -ldl
+threads
diff --git a/s7/tools/texit.scm b/s7/tools/texit.scm
new file mode 100644
index 0000000..1f58df9
--- /dev/null
+++ b/s7/tools/texit.scm
@@ -0,0 +1,205 @@
+(set! (*s7* 'heap-size) (* 3 1024000))
+
+(define size 100000)
+
+(define (memb x ls)
+  (call-with-exit
+   (lambda (break)
+     (do ((ls ls (cdr ls)))
+	 ((null? ls) #f)
+       (if (eq? x (car ls))
+	   (break ls))))))
+
+(define (membtest)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (memb 'd '(a b c))
+    (memb 'b '(a b c))))
+
+(membtest)
+
+
+(define (find-if f sequence)
+  (call-with-exit
+   (lambda (return)
+     (for-each (lambda (arg)
+		 (if (f arg)
+		     (return arg)))
+	       sequence)
+     #f)))
+
+(define (find-if-test)
+  (let ((lst '((#f 1) (#f 2) (3 3) (#f 4))))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (find-if car lst))))
+
+(find-if-test)
+
+
+(define-expansion (while test . body)      ; while loop with predefined break and continue.
+  `(call-with-exit
+    (lambda (break)
+      (let loop ()
+	(call-with-exit
+	 (lambda (continue)
+	   (do ()
+	       ((not ,test) (break))
+	     ,@body)))
+	(loop)))))
+
+(define (while-test)
+  (do ((i 0)
+       (k 0 (+ k 1)))
+      ((= k size))
+    (while (< i 100)
+      (when (= i 3) (set! i 0) (break))
+      (set! i (+ i 1))
+      (if (> i 3) (display "oops:while\n")))))
+
+(while-test)
+
+
+(define (dwfib n)
+  (dynamic-wind
+      (lambda () 
+	(if (negative? n) (display "oops")))
+      (lambda ()
+	(if (<= n 2)
+	    n
+	    (+ (dwfib (- n 1))
+               (dwfib (- n 2)))))
+      #f))
+
+(dwfib 28)
+
+
+(define lsize 100000)
+
+(define (f x a) (x a))
+
+(define (g1 lsize)
+  (do ((i 0 (+ i 1)))
+      ((= i lsize))
+    (f (lambda (b) (+ b 1)) 10)))
+
+(define (g2 lsize)
+  (let loop ((i lsize))
+    (when (>= i 0)
+      (f (lambda (b) (+ b 1)) 10)
+      (loop (- i 1)))))
+
+(define (g3 lsize)
+  (do ((i 0 (+ i 1)))
+      ((= i lsize))
+    (f (vector 11) 0)))
+
+(g1 lsize)
+(g2 lsize)
+(g3 lsize)
+
+
+(define (g31 g30 lsize)
+  (do ((i 0 (+ i 1)))
+      ((= i lsize))
+    (g30 i)))
+
+(g31 (lambda (x) (+ x 2)) lsize) ; fastest (more than 2x)
+
+
+(define (f2 a x) (x a)) ; op_closure_af?
+
+(define (g32 lsize)
+  (do ((i 0 (+ i 1)))
+      ((= i lsize))
+    (f2 10 (lambda (b) (+ b 1)))))
+
+(g32 lsize)
+
+
+(define (f1 x1 x2 a) ; eval_args [unk(unk a) OP_S_opSq?]
+  (x2 (x1 a)))
+
+(define (f11 x1 x2 a) ; no eval_args [eval->op_safe_c_pp]
+  (+ (x2 a) (x1 a)))
+
+(display (f1 (lambda (b) (+ b 1)) (lambda (c) (* c 2)) 10)) (newline)
+
+(define (g4 lsize)
+  (do ((i 0 (+ i 1)))
+      ((= i lsize))
+    (f1 (lambda (b) (+ b 1)) (lambda (c) (* c 2)) 10)))
+
+(define (g5 lsize)
+  (let loop ((i lsize))
+    (when (>= i 0)
+      (f1 (lambda (b) (+ b 1)) (lambda (c) (* c 2)) 10)
+      (loop (- i 1)))))
+
+(define (g6 lsize)
+  (let loop ((i lsize))
+    (when (>= i 0)
+      (f1 (lambda* (b (d 1)) (+ b d)) (macro (c) `(* ,c 2)) 10)
+      (loop (- i 1)))))
+
+(display (f1 (lambda* (b (d 1)) (+ b d)) (macro (c) `(* ,c 2)) 10)) (newline)
+(display (f1 (lambda* (b (d 1)) (+ b d)) (lambda (c) (* c 2)) 10)) (newline)
+
+(g4 lsize) ; (2x slower than g1)
+(g5 lsize) 
+(g6 lsize)  ; very slow, eval args (2x slower than g5)
+
+
+(define (tc-1 x y) 
+  (if (pair? x)
+      (tc-1 (cdr x) y) 
+      (begin (vector-set! y 0 32) y)))
+
+(define (g7)
+  (equal? (tc-1 '(1 2 3) #(1 2 3)) #(32 2 3)))
+
+(display (g7)) (newline)
+
+(define (g71)
+  (do ((i 0 (+ i 1)))
+      ((= i lsize))
+    (g7)))
+
+(g71)
+
+(define (g80)
+  (do ((i 0 (+ i 1)))
+      ((= i lsize))
+    ((lambda () (+ i 1)))))
+
+(g80)
+
+(define (g81)
+  (do ((i 0 (+ i 1)))
+      ((= i lsize))
+    ((lambda (x) (+ x 1)) i)))
+
+(g81)
+
+(define (g82)
+  (do ((i 0 (+ i 1)))
+      ((= i lsize))
+    ((lambda (x y) (+ x y)) i (+ i 1))))
+
+(g82)
+
+
+(define (g9)
+  (do ((i 0 (+ i 1)))
+      ((= i lsize))
+    (g10 + (lambda (x y) (* x y)))))
+
+(define (g10 f1 f2)
+  (- (f1 1 2) (f2 3 4)))
+
+(display (g10 + (lambda (x y) (* x y)))) (newline)
+
+(g9)
+
+
+(exit)
diff --git a/s7/tools/tfft.scm b/s7/tools/tfft.scm
new file mode 100644
index 0000000..496bace
--- /dev/null
+++ b/s7/tools/tfft.scm
@@ -0,0 +1,547 @@
+(define times 1000)
+(define size 1024)
+
+(define (b_fft areal aimag)
+  (let ((i 1)
+	(n (- (length areal) 1))
+        (j 1)
+        (k 0)
+        (m 0)
+	(ar areal)
+        (ai aimag)
+        (le 1)
+        (le1 0) 
+	(le2 0)
+        (ip 0)
+        (nv2 0)
+        (ur 0.0)
+        (ui 0.0)
+        (wr 0.0)
+        (wi 0.0)
+        (tr 0.0)
+        (ti 0.0))
+    ;; initialize
+    (set! nv2 (quotient n 2))
+    (do ()
+	((>= i n))
+      (set! m (+ m 1))
+      (set! i (+ i i)))
+    (set! i 1)
+    
+    (do ()
+	((>= i n))
+      (when (< i j)
+	(set! tr (float-vector-ref ar j))
+	(set! ti (float-vector-ref ai j))
+	(float-vector-set! ar j (float-vector-ref ar i))
+	(float-vector-set! ai j (float-vector-ref ai i))
+	(float-vector-set! ar i tr)
+	(float-vector-set! ai i ti))
+      (set! k nv2)
+      (do ()
+	  ((>= k j))
+	(set! j (- j k))
+	(set! k (quotient k 2)))
+      
+      (set! j (+ j k))
+      (set! i (+ i 1)))
+    
+    (do ((l 1 (+ l 1)))
+        ((> l m))  
+      (set! le1 le)
+      (set! le2 (+ le 1))
+      (set! le (* le 2))
+      (set! ur 1.0)
+      (set! ui 0.)
+      (set! wr (cos (/ pi le1)))
+      (set! wi (sin (/ pi le1)))
+      (do ((j1 1 (+ j1 1)))
+	  ((= j1 le2))
+	(do ((i1 j1 (+ i1 le)))
+	    ((> i1 n))
+	  (set! ip (+ i1 le1))
+	  (set! tr (- (* (float-vector-ref ar ip) ur)
+		      (* (float-vector-ref ai ip) ui)))
+	  (set! ti (+ (* (float-vector-ref ar ip) ui)
+		      (* (float-vector-ref ai ip) ur)))
+	  (float-vector-set! ar ip (- (float-vector-ref ar i1) tr))
+	  (float-vector-set! ai ip (- (float-vector-ref ai i1) ti))
+	  (float-vector-set! ar i1 (+ (float-vector-ref ar i1) tr))
+	  (float-vector-set! ai i1 (+ (float-vector-ref ai i1) ti))))
+      (set! tr (- (* ur wr) (* ui wi)))
+      (set! ti (+ (* ur wi) (* ui wr)))
+      (set! ur tr)
+      (set! ui ti))
+    #t))
+ 
+
+;;; --------------------------------------------------------------------------------
+(define* (cfft data n (dir 1)) ; complex data
+  (unless n (set! n (length data)))
+  (do ((i 0 (+ i 1))
+       (j 0))
+      ((= i n))
+    (if (> j i)
+	(let ((temp (data j)))
+	  (set! (data j) (data i))
+	  (set! (data i) temp)))
+    (do ((m (/ n 2) (/ m 2)))
+        ((or (< m 2) 
+             (< j m))
+         (set! j (+ j m)))
+     (set! j (- j m))))
+  (do ((ipow (floor (log n 2)))
+       (prev 1)
+       (lg 0 (+ lg 1))
+       (mmax 2 (* mmax 2))
+       (pow (/ n 2) (/ pow 2))
+       (theta (complex 0.0 (* pi dir)) (* theta 0.5)))
+      ((= lg ipow))
+    (do ((wpc (exp theta))
+         (wc 1.0)
+         (ii 0 (+ ii 1)))
+	((= ii prev)
+	 (set! prev mmax))
+      (do ((jj 0 (+ jj 1))
+           (i ii (+ i mmax))
+           (j (+ ii prev) (+ j mmax)))
+          ((>= jj pow))
+        (let ((tc (* wc (data j))))
+          (set! (data j) (- (data i) tc))
+          (set! (data i) (+ (data i) tc))))
+      (set! wc (* wc wpc))))
+  data)
+
+(unless (equivalent? (cfft (vector 0.0 1+i 0.0 0.0)) #(1+1i -1+1i -1-1i 1-1i))
+  (format *stderr* "cfft 1: ~S~%" (cfft (vector 0.0 1+i 0.0 0.0))))
+(let-temporarily (((*s7* 'equivalent-float-epsilon) 1e-14))
+  (unless (equivalent? (cfft (vector 0 0 1+i 0 0 0 1-i 0)) #(2 -2 -2 2 2 -2 -2 2))
+    (format *stderr* "cfft 2: ~S~%" (cfft (vector 0 0 1+i 0 0 0 1-i 0)))))
+
+
+;;; --------------------------------------------------------------------------------
+(define (fft-bench)
+  (let ((*re* (make-float-vector (+ size 1) 0.10))
+	(*im* (make-float-vector (+ size 1) 0.10)))
+    (do ((ntimes 0 (+ ntimes 1)))
+	((= ntimes times))
+      (b_fft *re* *im*)))
+
+  (let* ((n 256)
+	 (cdata (make-vector n 0.0)))
+    (do ((i 0 (+ i 1)))
+	((= i times))
+      (fill! cdata 0.0)
+      (vector-set! cdata 2 1+i)
+      (vector-set! cdata (- n 1) 1-i)
+      (cfft cdata))))
+ 
+(fft-bench)
+
+
+;;;--------------------------------------------------------------------------------
+;; 2D dft, real data, spot-checked against fftw ("backward", for "forward" case, use (- (im yout xout)...))
+(define (dft2 in)
+  (let* ((dims (vector-dimensions in))
+         (h (car dims))
+         (w (cadr dims))
+	 (ih (/ (* 2.0 pi) h))
+	 (iw (/ (* 2.0 pi) w))
+         (rl (make-float-vector dims))
+         (im (make-float-vector dims))
+	 (out (make-float-vector dims))
+	 (xw 0.0)
+	 (yh 0.0))
+    (do ((yout 0 (+ yout 1)))
+        ((= yout h) 
+	 (do ((i 0 (+ i 1)))
+	     ((= i h) 
+	      (list rl im out))
+	   (do ((j 0 (+ j 1)))
+	       ((= j w))
+	     (set! (out i j) (+ (* (rl i j) (rl i j)) 
+				(* (im i j) (im i j)))))))
+      (do ((xout 0 (+ xout 1)))
+          ((= xout w))
+	(set! xw (* xout iw))
+        (do ((yin 0 (+ yin 1)))
+            ((= yin h))
+	  (set! yh (* yout yin ih))
+          (do ((xin 0 (+ xin 1)))
+              ((= xin w))
+            (set! (rl yout xout) (+ (rl yout xout) 
+				    (* (in yin xin) 
+				       (cos (+ yh (* xw xin))))))
+            (set! (im yout xout) (+ (im yout xout) 
+				    (* (in yin xin) 
+				       (sin (+ yh (* xw xin))))))))))))
+
+(let ((vs (dft2 #r2d((1.0 0.0 -1.0 0.0)
+		     (0.0 0.0 0.0 0.0)
+		     (0.0 1.0 0.0 0.0)
+		     (0.0 0.0 0.0 0.0)))))
+  (let-temporarily (((*s7* 'equivalent-float-epsilon) 1.0e-14))
+    (unless (equivalent? (car vs) #r2d((1.0 2.0 -1.0 2.0) (-1.0 2.0 1.0 2.0) (1.0 2.0 -1.0 2.0) (-1.0 2.0 1.0 2.0)))
+      (format *stderr* "dft2 rl: ~S~%" (car vs)))
+    (unless (equivalent? (cadr vs) #r2d((0.0 1.0 0 -1.0) (0.0 -1.0 0.0 1.0) (0.0 1.0 0.0 -1.0) (0.0 -1.0 0.0 1.0)))
+      (format *stderr* "dft2 im: ~S~%" (cadr vs)))
+    (unless (equivalent? (caddr vs) #r2d((1.0 5.0 1.0 5.0) (1.0 5.0 1.0 5.0) (1.0 5.0 1.0 5.0) (1.0 5.0 1.0 5.0)))
+      (format *stderr* "dft2 out: ~S~%" (caddr vs)))))
+
+(define (test-dft2)
+  (let ((mat (make-float-vector '(16 16))))
+    (set! (mat 0 8) 1.0)
+    (dft2 mat)
+    (fill! mat 0.0)
+    (set! (mat 0 0) 1.0)
+    (set! (mat 8 8) 1.0)
+    (dft2 mat)
+    (fill! mat 0.0)
+    (set! (mat 0 0) 1.0)
+    (set! (mat 4 4) 0.5)
+    (set! (mat 8 8) 1.0)
+    (dft2 mat)
+    (fill! mat 0.0)
+    (set! (mat 0 0) 1.0)
+    (set! (mat 2 0) 0.5)
+    (set! (mat 8 8) 1.0)
+    (dft2 mat)))
+
+(test-dft2)
+
+
+;;; --------------------------------------------------------------------------------
+;; 3D dft as above but the "forward" case
+(define (dft3 in)
+  (let* ((dims (vector-dimensions in))
+         (h (car dims))
+         (w (cadr dims))
+	 (d (caddr dims))
+	 (ih (/ (* 2.0 pi) h))
+	 (iw (/ (* 2.0 pi) w))
+	 (id (/ (* 2.0 pi) d))
+         (rl (make-float-vector dims))
+         (im (make-float-vector dims))
+	 (out (make-float-vector dims)))
+    (do ((yout 0 (+ yout 1)))
+        ((= yout h) 
+	 (do ((i 0 (+ i 1)))
+	     ((= i h) 
+	      (list rl im out))
+	   (do ((j 0 (+ j 1)))
+	       ((= j w))
+	     (do ((k 0 (+ k 1)))
+	       ((= k d))
+	       (set! (out i j k) 
+		     (+ (* (rl i j k) (rl i j k)) 
+			(* (im i j k) (im i j k))))))))
+      (do ((xout 0 (+ xout 1)))
+          ((= xout w))
+	(do ((zout 0 (+ zout 1)))
+	    ((= zout d))
+	  (do ((yin 0 (+ yin 1)))
+	      ((= yin h))
+	    (do ((xin 0 (+ xin 1)))
+		((= xin w))
+	      (do ((zin 0 (+ zin 1)))
+		  ((= zin d))
+		(set! (rl yout xout zout)
+		      (+ (rl yout xout zout) 
+			 (* (in yin xin zin) 
+			    (cos (+ (* xout xin iw) 
+				    (* yout yin ih)
+				    (* zout zin id))))))
+		(set! (im yout xout zout)
+		      (- (im yout xout zout) 
+			 (* (in yin xin zin) 
+			    (sin (+ (* xout xin iw) 
+				    (* yout yin ih)
+				    (* zout zin id))))))))))))))
+
+(let ((vs (dft3 #r3d(((1.0 0.5 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0))
+		     ((0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0))
+		     ((0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0))
+		     ((0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0))))))
+  (let-temporarily (((*s7* 'equivalent-float-epsilon) 1.0e-14)
+                    ((*s7* 'print-length) 128))
+    (unless (equivalent? (car vs)
+			 #r3d(((1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0))
+			       ((1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0)) 
+			       ((1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0))
+			       ((1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0))))
+      (format *stderr* "dft3 rl: ~S~%" (car vs)))
+    (unless (equivalent? (cadr vs) 
+			 #r3d(((0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5))
+			      ((0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5))
+			      ((0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5))
+			      ((0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5))))
+      (format *stderr* "dft3 im: ~S~%" (cadr vs)))
+    (unless (equivalent? (caddr vs) 
+			 #r3d(((2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25))
+			      ((2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25))
+			      ((2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25)) 
+			      ((2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25))))
+      (format *stderr* "dft3 out: ~S~%" (caddr vs)))))
+
+(define (test-dft3)
+  (let ((mat (make-float-vector '(8 8 8) 0.0)))
+    ;(set! (mat 0 4 0) 1.0)
+    ;(dft3 mat)
+    ;(fill! mat 0.0)
+    (set! (mat 0 0 0) 1.0)
+    (set! (mat 4 4 4) 1.0)
+    (dft3 mat)))
+
+(test-dft3)
+
+;;; explicit case
+(define (dft3ex in)
+  (let* ((dims (vector-dimensions in))
+         (h (car dims))
+         (w (cadr dims))
+	 (d (caddr dims))
+	 (ih (/ (* 2.0 pi) h))
+	 (iw (/ (* 2.0 pi) w))
+	 (id (/ (* 2.0 pi) d))
+         (rl (make-float-vector dims))
+         (im (make-float-vector dims))
+	 (out (make-float-vector dims)))
+    (do ((yout 0 (+ yout 1)))
+        ((= yout h) 
+	 (do ((i 0 (+ i 1)))
+	     ((= i h) 
+	      (list rl im out))
+	   (do ((j 0 (+ j 1)))
+	       ((= j w))
+	     (do ((k 0 (+ k 1)))
+	       ((= k d))
+	       (float-vector-set! out i j k
+		     (+ (* (float-vector-ref rl i j k) (float-vector-ref rl i j k)) 
+			(* (float-vector-ref im i j k) (float-vector-ref im i j k))))))))
+      (do ((xout 0 (+ xout 1)))
+          ((= xout w))
+	(do ((zout 0 (+ zout 1)))
+	    ((= zout d))
+	  (do ((yin 0 (+ yin 1)))
+	      ((= yin h))
+	    (do ((xin 0 (+ xin 1)))
+		((= xin w))
+	      (do ((zin 0 (+ zin 1)))
+		  ((= zin d))
+		(float-vector-set! rl yout xout zout
+		      (+ (float-vector-ref rl yout xout zout) 
+			 (* (float-vector-ref in yin xin zin) 
+			    (cos (+ (* xout xin iw) 
+				    (* yout yin ih)
+				    (* zout zin id))))))
+		(float-vector-set! im yout xout zout
+		      (- (float-vector-ref im yout xout zout) 
+			 (* (float-vector-ref in yin xin zin) 
+			    (sin (+ (* xout xin iw) 
+				    (* yout yin ih)
+				    (* zout zin id))))))))))))))
+
+;;; implicit case
+(define (dft3ex-1 in)
+  (let* ((dims (vector-dimensions in))
+         (h (car dims))
+         (w (cadr dims))
+	 (d (caddr dims))
+	 (ih (/ (* 2.0 pi) h))
+	 (iw (/ (* 2.0 pi) w))
+	 (id (/ (* 2.0 pi) d))
+         (rl (make-float-vector dims))
+         (im (make-float-vector dims))
+	 (out (make-float-vector dims))
+	 (zd 0.0)
+	 (xw 0.0)
+	 (yh 0.0))
+    (do ((yout 0 (+ yout 1)))
+        ((= yout h) 
+	 (do ((i 0 (+ i 1)))
+	     ((= i h) 
+	      (list rl im out))
+	   (do ((j 0 (+ j 1)))
+	       ((= j w))
+	     (do ((k 0 (+ k 1)))
+	       ((= k d))
+	       (set! (out i j k)
+		     (+ (* (rl i j k) (rl i j k)) 
+			(* (im i j k) (im i j k))))))))
+      (do ((xout 0 (+ xout 1)))
+          ((= xout w))
+	(do ((zout 0 (+ zout 1)))
+	    ((= zout d))
+	  (set! zd (* zout id))
+	  (do ((yin 0 (+ yin 1)))
+	      ((= yin h))
+	    (set! yh (* yout yin ih))
+	    (do ((xin 0 (+ xin 1)))
+		((= xin w))
+	      (set! xw (+ yh (* xout xin iw)))
+	      (do ((zin 0 (+ zin 1)))
+		  ((= zin d))
+		(set! (rl yout xout zout)
+		      (+ (rl yout xout zout) 
+			 (* (in yin xin zin)
+			    (cos (+ xw (* zin zd))))))
+		(set! (im yout xout zout)
+		      (- (im yout xout zout) 
+			 (* (in yin xin zin)  
+			    (sin (+ xw (* zin zd))))))))))))))
+
+(define (check-dft3 name vs)
+  (let-temporarily (((*s7* 'equivalent-float-epsilon) 1.0e-14)
+                    ((*s7* 'print-length) 128))
+    (unless (equivalent? (car vs)
+			 #r3d(((1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0))
+			       ((1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0)) 
+			       ((1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0))
+			       ((1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0) (1.5 1.0 0.5 1.0))))
+      (format *stderr* "~A rl: ~S~%" name (car vs)))
+    (unless (equivalent? (cadr vs) 
+			 #r3d(((0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5))
+			      ((0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5))
+			      ((0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5))
+			      ((0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5) (0.0 -0.5 0.0 0.5))))
+      (format *stderr* "~A im: ~S~%" name (cadr vs)))
+    (unless (equivalent? (caddr vs) 
+			 #r3d(((2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25))
+			      ((2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25))
+			      ((2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25)) 
+			      ((2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25) (2.25 1.25 0.25 1.25))))
+      (format *stderr* "~A out: ~S~%" name (caddr vs)))))
+
+(check-dft3 "dft3ex" (dft3ex #r3d(((1.0 0.5 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0))
+				  ((0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0))
+				  ((0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0))
+				  ((0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0)))))
+
+(check-dft3 "dft3ex-1" (dft3ex-1 #r3d(((1.0 0.5 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0))
+				      ((0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0))
+				      ((0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0))
+				      ((0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0) (0.0 0.0 0.0 0.0)))))
+
+
+(define (test-dft3ex)
+  (let ((mat (make-float-vector '(9 9 9))))
+    (float-vector-set! mat 0 0 0 1.0)
+    (dft3ex mat))
+  (let ((mat (make-float-vector '(9 9 9))))
+    (float-vector-set! mat 0 0 0 1.0)
+    (dft3ex-1 mat)))
+
+(test-dft3ex)
+
+
+
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(exit)
+
+
+#|
+;;; fft3.c:
+#include <unistd.h>
+#include <stdio.h>
+#include <ctype.h>
+#include <string.h>
+#include <stdlib.h>
+#include <stdint.h>
+#include <inttypes.h>
+#include <complex.h>
+#include <fftw3.h>
+
+static fftw_complex *c_in_data = NULL, *c_out_data = NULL;
+static fftw_plan c_r_plan, c_i_plan;  
+static int last_c_fft_size = 0;   
+
+static void mus_fftw_with_imag(double *rl, double *im, int h, int w, int d, int dir)
+{
+  int i, j, k;
+
+  c_in_data = (fftw_complex *)fftw_malloc(w * h * d * sizeof(fftw_complex)); /* rl/im data is double */
+  c_out_data = (fftw_complex *)fftw_malloc(w * h * d * sizeof(fftw_complex));
+  c_r_plan = fftw_plan_dft_3d(h, w, d, c_in_data, c_out_data, FFTW_FORWARD, FFTW_ESTIMATE); 
+  c_i_plan = fftw_plan_dft_3d(h, w, d, c_in_data, c_out_data, FFTW_BACKWARD, FFTW_ESTIMATE);
+
+  for (i = 0; i < h; i++)
+    for (j = 0; j < w; j++)
+      for (k = 0; k < d; k++)
+	c_in_data[(i * w * d) + (j * d) + k] = rl[(i * w * d) + (j * d) + k] + _Complex_I * im[(i * w * d) + (j * d) + k];
+
+  if (dir == -1) 
+    fftw_execute(c_r_plan);
+  else fftw_execute(c_i_plan);
+
+  for (i = 0; i < h; i++)
+    for (j = 0; j < w; j++)
+      for (k = 0; k < d; k++)
+	{
+	  rl[(i * w * d) + (j * d) + k] = creal(c_out_data[(i * w * d) + (j * d) + k]);
+	  im[(i * w * d) + (j * d) + k] = cimag(c_out_data[(i * w * d) + (j * d) + k]);
+	}
+}
+
+int main(int argc, char **argv)
+{
+  double *rl, *im;
+  int h, w, d, i, j, k;
+  h = 4;
+  w = 4;
+  d = 4;
+  rl = (double *)calloc(h * w * d, sizeof(double));
+  im = (double *)calloc(h * w * d, sizeof(double));
+  
+  rl[0] = 1.0;
+  rl[1] = 0.5;
+
+  mus_fftw_with_imag(rl, im, h, w, d, -1);
+
+  fprintf(stderr, "#r3d(");
+  for (i = 0; i < h; i++)
+    {
+      fprintf(stderr, "(");
+      for (j = 0; j < w; j++)
+	{
+	  fprintf(stderr, "(");
+	  for (k = 0; k < d; k++)
+	    fprintf(stderr, "%.3f ", rl[(i * w * d) + (j * d) + k]);
+	  fprintf(stderr, ")");
+	}
+      fprintf(stderr, ")");
+    }
+  fprintf(stderr, ")\n");
+
+  fprintf(stderr, "#r3d(");
+  for (i = 0; i < h; i++)
+    {
+      fprintf(stderr, "(");
+      for (j = 0; j < w; j++)
+	{
+	  fprintf(stderr, "(");
+	  for (k = 0; k < d; k++)
+	    fprintf(stderr, "%.3f ", im[(i * w * d) + (j * d) + k]);
+	  fprintf(stderr, ")");
+	}
+      fprintf(stderr, ")");
+    }
+  fprintf(stderr, ")\n");
+
+  fprintf(stderr, "#r3d(");
+  for (i = 0; i < h; i++)
+    {
+      fprintf(stderr, "(");
+      for (j = 0; j < w; j++)
+	{
+	  fprintf(stderr, "(");
+	  for (k = 0; k < d; k++)
+	    fprintf(stderr, "%.3f ", 
+		    rl[(i * w * d) + (j * d) + k] * rl[(i * w * d) + (j * d) + k] + im[(i * w * d) + (j * d) + k] * im[(i * w * d) + (j * d) + k]);
+	  fprintf(stderr, ")");
+	}
+      fprintf(stderr, ")");
+    }
+  fprintf(stderr, ")\n");
+}
+|#
diff --git a/s7/tools/tform.scm b/s7/tools/tform.scm
new file mode 100644
index 0000000..6ae67c3
--- /dev/null
+++ b/s7/tools/tform.scm
@@ -0,0 +1,582 @@
+(when (provided? 'pure-s7)
+  (define-macro (cond-expand . clauses)
+    (letrec ((traverse (lambda (tree)
+			 (if (pair? tree)
+			     (cons (traverse (car tree))
+				   (if (null? (cdr tree)) () (traverse (cdr tree))))
+			     (if (memq tree '(and or not else))
+				 tree
+				 (and (symbol? tree) (provided? tree)))))))
+      `(cond ,@(map (lambda (clause)
+		      (cons (traverse (car clause))
+			    (if (null? (cdr clause)) '(#f) (cdr clause))))
+		    clauses)))))
+
+
+(load "s7test-block.so" (sublet (curlet) (cons 'init_func 'block_init))) ; load calls init_func if possible
+
+(load "mockery.scm")
+
+(define-constant one 1)
+
+(define mock-number (*mock-number* 'mock-number))
+(define mock-pair (*mock-pair* 'mock-pair))
+(define mock-string (*mock-string* 'mock-string))
+(define mock-char (*mock-char* 'mock-char))
+(define mock-vector (*mock-vector* 'mock-vector))
+(define mock-symbol (*mock-symbol* 'mock-symbol))
+(define mock-hash-table (*mock-hash-table* 'mock-hash-table))
+
+;;(openlet (inlet 'i 0 'list-set! (lambda (l . args) (apply #_list-set! l ((car args) 'i) (cdr args))))))
+
+(define-constant constants (vector #f #t () #\a (/ (*s7* 'most-positive-fixnum)) (/ -1 (*s7* 'most-positive-fixnum)) 1.5+i 
+			  "hi455" "\n  \t\x65;" :key hi: 'hi (list 1) (list 1 2) (cons 1 2) (list (list 1 2)) (list (list 1)) (list ()) #() 
+			  1/0+i 0+0/0i 0+1/0i 1+0/0i 0/0+0i 0/0+0/0i 1+1/0i 0/0+i cons ''2 
+			  1024 -1024 10000 10001 30000 512 -512 
+			  1+i 1+1e10i 1e15+1e15i 0+1e18i 1e18 #\xff (string #\xff) 1e308 
+			  (*s7* 'most-positive-fixnum) (*s7* 'most-negative-fixnum) (- (*s7* 'most-positive-fixnum) 1) (+ (*s7* 'most-negative-fixnum) 1)
+			  -1 0 0.0 1 1.5 1.0-1.0i 3/4 #\null -63 (make-hash-table) (hash-table '(a . 2) '(b . 3))
+			  '((1 2) (3 4)) '((1 (2)) (((3) 4))) "" (list #(1) "1") '(1 2 . 3) (list (cons 'a 2) (cons 'b 3))
+			  #(1 2) (vector 1 '(3)) (let ((x 3)) (lambda (y) (+ x y))) abs 'a 'b one apply 
+			  (lambda args args) (lambda* ((a 3) (b 2)) (+ a b)) (lambda () 3)
+			  (sublet () (cons 'a 1)) ;(rootlet)
+			  *load-hook*  *error-hook* (random-state 123)
+			  quasiquote macroexpand cond-expand begin let letrec* if case cond (call-with-exit (lambda (goto) goto))
+			  (with-baffle (call/cc (lambda (cc) cc)))
+			  (string #\a #\null #\b) #2d((1 2) (3 4)) (inlet 'a 2 'b 3)
+			  #<undefined> #<unspecified> (make-int-vector 3) (make-float-vector 3 -1.4)
+			  (make-vector '(2 3) "hi") #("hiho" "hi" "hoho") (subvector (make-int-vector '(2 3) 1) 0 6)
+			  (subvector (subvector (make-float-vector '(2 3) 1.0) 0 6) 0 4 '(2 2))
+			  (vector-ref #2d((#(1 2 3)) (#(3 4 5))) 0 0) (define-macro (m a) `(+ ,a 1))
+			  (c-pointer 0) (c-pointer -1) :readable else (define-bacro* (m (a 1)) `(+ ,a 1))
+			  (byte-vector 0 1 2) (byte-vector) (byte-vector 255 0 127) (make-iterator (vector '(a . 2)))
+			  (lambda (dir) 1.0) (float-vector) (make-float-vector '(2 2)) (int-vector 1 2 3) (int-vector)
+			  (inlet 'value 1 '+ (lambda args 1)) (inlet) (make-iterator (inlet 'a 1 'b 2) (cons #f #f))
+			  (make-iterator "123456") (make-iterator '(1 2 3)) (make-iterator (hash-table 'a 1 'b 2) (cons #f #f))
+			  (open-input-string "123123") (open-input-file "/home/bil/cl/4.aiff")
+			  (open-output-file "test.test") (open-output-string)
+			  
+			  ;(mock-number 0) (mock-number 2) (mock-number 1-i) (mock-number 4/3) (mock-number 2.0)
+			  (mock-string #\h #\o #\h #\o)
+			  (mock-pair '(2 3 4))
+			  (mock-char #\b)
+			  (mock-symbol 'c)
+			  (mock-vector 1 2 3 4)
+			  (mock-hash-table 'b 2)
+			  
+			  (make-block 4) (block) (make-iterator (block 1 2 3 4))
+			  ))
+(define-constant constants-len (length constants))
+
+(define-constant ctrl-chars (string ;#\A #\S #\C #\F #\E #\G #\O #\D #\B #\X #\W
+		    #\, #\{ #\} #\@ #\P #\*
+		    #\a #\s #\c #\f #\e #\g #\o #\d #\b #\x #\p #\n #\w
+		    #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
+		    #\~ #\T #\& #\% #\^ #\|
+		    #\~ #\~ #\~ #\~ 
+		    #\, #\, #\, #\, #\" #\" #\\ #\'
+		    #\+ #\- #\@ #\. #\/ #\; #\:
+		    ))
+(define-constant ctrl-chars-len (length ctrl-chars))
+
+(define (test-calls ctrl-str tries size1 op)
+  (do ((i 0 (+ i 1))
+       (x #f) (y #f) (z #f) (pos 0)
+       (cs constants)
+       (cs-len constants-len))
+      ((= i tries))
+    (do ((j 1 (+ j 1)))
+	((= j size1))
+      (string-set! ctrl-str j (string-ref ctrl-chars (random ctrl-chars-len))))
+    
+    (set! x (vector-ref cs (random cs-len)))
+    (set! y (vector-ref cs (random cs-len)))
+    (set! z (vector-ref cs (random cs-len)))
+    
+    (object->string x)
+    (display x op)
+    
+    (catch #t (lambda () (format #f "~{~^~S ~} ~{~|~S ~} ~W" x y z)) (lambda arg 'error))
+    (catch #t (lambda () (format #f ctrl-str)) (lambda arg 'error))
+    (catch #t (lambda () (format #f ctrl-str x)) (lambda arg 'error))
+    (catch #t (lambda () (format #f ctrl-str y)) (lambda arg 'error))
+    (catch #t (lambda () (format #f ctrl-str z)) (lambda arg 'error))
+    (set! pos (char-position #\~ ctrl-str 1))
+    (when pos
+      (catch #t (lambda () (format #f ctrl-str x z)) (lambda arg 'error))
+      (catch #t (lambda () (format #f ctrl-str x y)) (lambda arg 'error))
+      (catch #t (lambda () (format #f ctrl-str y z)) (lambda arg 'error))
+      (catch #t (lambda () (format #f ctrl-str z x)) (lambda arg 'error))
+      (when (char-position #\~ ctrl-str (+ pos 1))
+	(catch #t (lambda () (format #f ctrl-str x y z)) (lambda arg 'error))
+	(catch #t (lambda () (format #f ctrl-str z y x)) (lambda arg 'error))))))
+
+(define (test-chars)
+  (let ((op (open-output-string))
+	(total-size 15))
+    (do ((size 2 (+ size 1))
+	 (size1 3 (+ size1 1))
+	 (tries 4000 (+ tries 2000))
+	 (ctrl-str (make-string (+ total-size 1) #\space)))
+	((= size total-size))
+      (format *stderr* "~D " size)
+      (string-set! ctrl-str size1 #\null)
+      (string-set! ctrl-str 0 #\~)
+      (test-calls ctrl-str tries size1 op)
+      (get-output-string op #t))
+    (close-output-port op)))
+
+(test-chars)
+
+(define (f)
+  (do ((i 0 (+ i 1)))
+      ((= i 100000))
+    (format #f "~{.~{~A~}+~{~A~}~}" '((1 2) (3 4 5) (6 7 8) (9)))
+    (format #f "~{.~{+~{-~W~}~}~}" '(((1 2) (3 4 5))))
+    (format #f "~{.~{+~{-~A~}~}~}" '(((1 2) (3 4 5)) ((6) (7 8 9))))
+    (format #f "~9,9F" 3.14)
+    (format #f "~19,'xf" 3.14)
+    (format #f "~{~{~~~{~D~| ~}~| ~}~}" '(((1 2) (3 4))))
+    (format #f "~10,'\\T~&~20Tasdf~&")
+    (reader-cond
+     ((<= (*s7* 'major-version) 9)
+      (format #f "~D~*~Ctwo~P ~O ~X ~B ~,3E ~1,4F ~N,G" 23 32 #\a 2 95 95 9 pi pi 3 pi))
+     (#t 
+      (format #f "~:D~*~Ctwo~P ~O ~X ~B ~,3E ~1,4F ~N,G" 23 32 #\a 2 95 95 9 pi pi 3 pi)))
+    ))
+(f)
+
+(exit)
+
+;;; --------------------------------------------------------------------------------
+;;; these tests are not currently used
+
+(define size 1000000)
+
+(define (f1) ; [116] -> [78] (fixed c_function_chooser) -> [54] opt_p_call_cc
+  (let ((str ""))
+    (do ((i 0 (+ i 1)))
+	((= i size) str)
+      (set! str (format #f "just a bare string!"))))) ; ~% is turned into \n so that doesn't cost anything
+
+;(unless (string=? (f1) "just a bare string!") (format *stderr* "f1: ~S~%" (f1)))
+
+#|
+15,951,020  s7.c:opt_dotimes [/home/bil/motif-snd/repl]
+11,000,000  s7.c:opt_p_call_cc [/home/bil/motif-snd/repl]
+ 9,000,000  s7.c:g_format_just_control_string [/home/bil/motif-snd/repl]
+ 9,000,000  s7.c:opt_set_p_p_f [/home/bil/motif-snd/repl]
+ 6,895,119  s7.c:gc.isra.0 [/home/bil/motif-snd/repl]
+|#
+
+
+(define (f2) ; [309] -> [277 opt_p_call_ccs]
+  (let ((str "asdf")
+	(res ""))
+    (do ((i 0 (+ i 1)))
+	((= i size) res)
+      (set! res (format #f "~a" str))))) ; isn't this just copy? (for a string) and opt_p_call_ccs
+
+;(unless (string=? (f2) "asdf") (format *stderr* "f2: ~S~%" (f2)))
+
+#|
+67,538,352  s7.c:s7_object_to_string [/home/bil/motif-snd/repl]
+46,000,000  s7.c:string_to_port [/home/bil/motif-snd/repl]
+36,000,164  s7.c:block_to_string [/home/bil/motif-snd/repl]
+29,103,257  s7.c:gc.isra.0 [/home/bil/motif-snd/repl]
+24,000,000  s7.c:string_write_string [/home/bil/motif-snd/repl]
+15,951,020  s7.c:opt_dotimes [/home/bil/motif-snd/repl]
+15,149,728  memcpy
+15,000,000  s7.c:g_format_as_objstr [/home/bil/motif-snd/repl]
+15,000,000  s7.c:opt_p_call_ccs [/home/bil/motif-snd/repl]
+ 9,000,000  s7.c:opt_set_p_p_f [/home/bil/motif-snd/repl]
+|#
+
+
+(define (f3) ; [469]
+  (let ((str "asdf")
+	(res ""))
+    (do ((i 0 (+ i 1)))
+	((= i size) res)
+      (set! res (format #f "str: ~A" str))))) ; maybe extend g_format_as_objstr to include prestring?
+
+;(unless (string=? (f3) "str: asdf") (format *stderr* "f3: ~S~%" (f3)))
+
+#|
+237,610,187  s7.c:format_to_port_1 [/home/bil/motif-snd/repl]
+ 46,000,000  s7.c:string_to_port [/home/bil/motif-snd/repl]
+ 30,149,775  memcpy
+ 29,103,615  s7.c:gc.isra.0 [/home/bil/motif-snd/repl]
+ 29,000,000  s7.c:g_format_no_column [/home/bil/motif-snd/repl]
+ 24,000,000  s7.c:string_write_string [/home/bil/motif-snd/repl]
+ 21,001,261  strchr
+ 15,951,020  s7.c:opt_dotimes [/home/bil/motif-snd/repl]
+ 15,000,000  s7.c:opt_p_call_ccs [/home/bil/motif-snd/repl]
+  9,000,000  s7.c:opt_set_p_p_f [/home/bil/motif-snd/repl]
+|#
+
+
+(define (f4) ; [717]
+  (let ((str "asdf")
+	(res ""))
+    (do ((i 0 (+ i 1)))
+	((= i size) res)
+      (set! res (format #f "str: ~A ~C" str (string-ref str 0))))))
+
+;(unless (string=? (f4) "str: asdf a") (format *stderr* "f4: ~S~%" (f4)))
+
+#|
+333,610,119  s7.c:format_to_port_1 [/home/bil/motif-snd/repl]
+ 71,000,000  s7.c:opt_p_call_any [/home/bil/motif-snd/repl]         ; ccsc ideally
+ 46,149,893  memcpy
+ 46,000,000  s7.c:string_to_port [/home/bil/motif-snd/repl]
+ 42,001,811  strchr
+ 29,104,716  s7.c:gc.isra.0 [/home/bil/motif-snd/repl]
+ 29,000,000  s7.c:g_format_no_column [/home/bil/motif-snd/repl]
+ 24,000,000  s7.c:string_write_string [/home/bil/motif-snd/repl]
+ 18,000,000  s7.c:string_write_char [/home/bil/motif-snd/repl]
+ 15,951,020  s7.c:opt_dotimes [/home/bil/motif-snd/repl]
+ 10,000,000  s7.c:string_ref_p_pi_unchecked [/home/bil/motif-snd/repl]    ; str not set so string-ref is constant
+  9,000,000  s7.c:opt_set_p_p_f [/home/bil/motif-snd/repl]
+  8,000,000  s7.c:opt_p_pi_sc [/home/bil/motif-snd/repl]      ; calls string_ref_p_pi_unchecked
+  6,002,360  ?
+  6,000,000  format_to_port_1?
+  6,000,000  s7.c:opt_p_c [/home/bil/motif-snd/repl]          ; for opt_p_pi_sc!  why not just embed it?
+  4,000,098  ?
+  4,000,004  ./ctype/../include/ctype.h:__ctype_b_loc [/usr/lib/x86_64-linux-gnu/libc.so.6]
+  4,000,000  s7.c:opt_p_s [/home/bil/motif-snd/repl]
+|#
+
+
+(define (f5) ; [666]
+  (let ((str (list 1 2 3))
+	(res "")
+	(size2 (/ size 2)))
+    (do ((i 0 (+ i 1)))
+	((= i size2) res)
+      (set! res (format #f "(~{~A~^ ~})" str)))))
+
+;(unless (string=? (f5) "(1 2 3)") (format *stderr* "f5: ~S~%" (f5)))
+
+#|
+256,000,000  s7.c:format_to_port_1'2 [/home/bil/motif-snd/repl]
+204,109,962  s7.c:format_to_port_1 [/home/bil/motif-snd/repl]
+ 58,500,000  s7.c:integer_to_port [/home/bil/motif-snd/repl]
+ 27,000,000  s7.c:string_write_char [/home/bil/motif-snd/repl]
+ 15,650,121  ./string/../sysdeps/x86_64/multiarch/memmove-vec-unaligned-erms.S:__memcpy_avx_unaligned_erms [/usr/lib/x86_64-linux-gnu/libc.so.6]
+ 15,000,000  /usr/include/x86_64-linux-gnu/bits/string_fortified.h:integer_to_port
+ 14,500,000  s7.c:g_format_no_column [/home/bil/motif-snd/repl]
+ 14,113,341  s7.c:gc.isra.0 [/home/bil/motif-snd/repl]
+ 12,000,584  s7.c:s7_list_length [/home/bil/motif-snd/repl]
+ 11,000,000  s7.c:object_to_list [/home/bil/motif-snd/repl]
+ 10,502,830  ./string/../sysdeps/x86_64/multiarch/strchr-avx2.S:__strchr_avx2 [/usr/lib/x86_64-linux-gnu/libc.so.6]
+  7,950,972  s7.c:opt_dotimes [/home/bil/motif-snd/repl]
+  7,500,000  s7.c:opt_p_call_ccs [/home/bil/motif-snd/repl]
+  4,500,000  s7.c:opt_set_p_p_f [/home/bil/motif-snd/repl]
+|#
+
+
+(define (f6) ; [943]
+  (let ((res "")
+	(size2 (/ size 2)))
+    (do ((i 0 (+ i 1)))
+	((= i size2) res)
+      (set! res (format #f "~1,4F" pi)))))
+
+;(unless (string=? (f6) "3.1416") (format *stderr* "f6: ~S~%" (f6)))
+
+#|
+225,500,000  ./stdio-common/./stdio-common/printf_fp.c:__printf_fp_buffer_1.constprop.0.isra.0 [/usr/lib/x86_64-linux-gnu/libc.so.6]
+122,109,960  s7.c:format_to_port_1 [/home/bil/motif-snd/repl]
+114,524,056  ./stdio-common/./stdio-common/vfprintf-internal.c:__printf_buffer [/usr/lib/x86_64-linux-gnu/libc.so.6]
+ 63,000,000  ./stdlib/../sysdeps/x86_64/mul_1.S:__mpn_mul_1 [/usr/lib/x86_64-linux-gnu/libc.so.6]
+ 40,000,000  s7.c:format_numeric_arg [/home/bil/motif-snd/repl]
+ 36,519,357  ./stdio-common/./stdio-common/Xprintf_buffer_write.c:__printf_buffer_write [/usr/lib/x86_64-linux-gnu/libc.so.6]
+ 32,500,012  s7.c:number_to_string_base_10.isra.0 [/home/bil/motif-snd/repl]
+ 30,500,000  s7.c:format_number [/home/bil/motif-snd/repl]
+ 27,500,000  ./stdio-common/./stdio-common/printf_fp.c:__printf_fp_l_buffer [/usr/lib/x86_64-linux-gnu/libc.so.6]
+ 25,000,000  ./stdio-common/./stdio-common/printf_fp.c:hack_digit [/usr/lib/x86_64-linux-gnu/libc.so.6]
+ 19,507,657  ./debug/./debug/snprintf_chk.c:__snprintf_chk [/usr/lib/x86_64-linux-gnu/libc.so.6]
+ 19,009,424  ./string/../sysdeps/x86_64/multiarch/strchr-avx2.S:__strchrnul_avx2 [/usr/lib/x86_64-linux-gnu/libc.so.6]
+ 15,149,924  ./string/../sysdeps/x86_64/multiarch/memmove-vec-unaligned-erms.S:__memcpy_avx_unaligned_erms [/usr/lib/x86_64-linux-gnu/libc.so.6]
+ 14,500,000  s7.c:g_format_no_column [/home/bil/motif-snd/repl]
+ 14,113,761  s7.c:gc.isra.0 [/home/bil/motif-snd/repl]
+ 14,006,916  ./libio/./libio/vsnprintf.c:__vsnprintf_internal [/usr/lib/x86_64-linux-gnu/libc.so.6]
+ 12,000,000  s7.c:string_write_string [/home/bil/motif-snd/repl]
+ 11,000,000  ./stdlib/../sysdeps/ieee754/dbl-64/dbl2mpn.c:__mpn_extract_double [/usr/lib/x86_64-linux-gnu/libc.so.6]
+ 10,503,772  ./string/../sysdeps/x86_64/multiarch/strchr-avx2.S:__strchr_avx2 [/usr/lib/x86_64-linux-gnu/libc.
+|#
+
+
+(define (f7) ; [362]
+  (let ((res "")
+	(size2 (/ size 2)))
+    (do ((i 0 (+ i 1)))
+	((= i size2) res)
+      (set! res (format #f "~D is ~:D" 3 3)))))
+
+;(unless (string=? (f7) "3 is third") (format *stderr* "f7: ~S~%" (f7)))
+
+#|
+151,609,892  s7.c:format_to_port_1 [/home/bil/motif-snd/repl]
+ 35,500,000  s7.c:format_number [/home/bil/motif-snd/repl]
+ 35,500,000  s7.c:opt_p_call_any [/home/bil/motif-snd/repl]
+ 24,000,000  s7.c:string_write_string [/home/bil/motif-snd/repl]
+ 23,500,012  s7.c:number_to_string_base_10.isra.0 [/home/bil/motif-snd/repl]
+ 23,149,965  ./string/../sysdeps/x86_64/multiarch/memmove-vec-unaligned-erms.S:__memcpy_avx_unaligned_erms [/usr/lib/x86_64-linux-gnu/libc.so.6]
+ 14,500,000  s7.c:g_format_no_column [/home/bil/motif-snd/repl]
+ 14,114,301  s7.c:gc.isra.0 [/home/bil/motif-snd/repl]
+ 10,503,830  ./string/../sysdeps/x86_64/multiarch/strchr-avx2.S:__strchr_avx2 [/usr/lib/x86_64-linux-gnu/libc.so.6]
+  7,950,930  s7.c:opt_dotimes [/home/bil/motif-snd/repl]
+  6,000,000  s7.c:opt_p_c [/home/bil/motif-snd/repl]
+  4,500,000  s7.c:opt_set_p_p_f [/home/bil/motif-snd/repl]
+|#
+
+
+(define (f8) ; [375]
+  (let ((res "")
+	(size2 (/ size 2)))
+    (do ((i 0 (+ i 1)))
+	((= i size2) res)
+      (set! res (format #f "~ND" 20 1234)))))  ; "width field so string is 20 wide
+
+;(unless (string=? (f8) "                1234") (format *stderr* "f8: ~S~%" (f8)))
+
+#|
+114,109,824  s7.c:format_to_port_1 [/home/bil/motif-snd/repl]
+ 37,500,000  s7.c:integer_to_string [/home/bil/motif-snd/repl]
+ 35,500,000  s7.c:format_number [/home/bil/motif-snd/repl]
+ 35,500,000  s7.c:opt_p_call_any [/home/bil/motif-snd/repl]
+ 27,500,012  s7.c:number_to_string_base_10.isra.0 [/home/bil/motif-snd/repl]
+ 21,000,000  s7.c:local_memset [/home/bil/motif-snd/repl]
+ 14,500,000  s7.c:g_format_no_column [/home/bil/motif-snd/repl]
+ 14,114,316  s7.c:gc.isra.0 [/home/bil/motif-snd/repl]
+ 13,500,000  s7.c:insert_spaces [/home/bil/motif-snd/repl]
+ 13,149,880  ./string/../sysdeps/x86_64/multiarch/memmove-vec-unaligned-erms.S:__memcpy_avx_unaligned_erms [/usr/lib/x86_64-linux-gnu/libc.so.6]
+ 12,000,000  s7.c:string_write_string [/home/bil/motif-snd/repl]
+  8,500,000  s7.c:format_n_arg [/home/bil/motif-snd/repl]
+  7,950,930  s7.c:opt_dotimes [/home/bil/motif-snd/repl]
+  6,000,000  s7.c:opt_p_c [/home/bil/motif-snd/repl]
+  4,500,000  s7.c:opt_set_p_p_f [/home/bil/motif-snd/repl]
+|#
+
+
+(define (f9) ; [424]
+  (let ((res "")
+	(size2 (/ size 2)))
+    (do ((i 0 (+ i 1)))
+	((= i size2) res)
+      (set! res (format #f "~NC~D" 20 #\space 1234)))))  ; 20 spaces then 1234
+
+;(unless (string=? (f9) "                    1234") (format *stderr* "f9: ~S~%" (f9)))
+
+#|
+146,609,756  s7.c:format_to_port_1 [/home/bil/motif-snd/repl]
+ 39,500,000  s7.c:opt_p_call_any [/home/bil/motif-snd/repl]
+ 37,500,000  s7.c:integer_to_string [/home/bil/motif-snd/repl]
+ 35,500,000  s7.c:format_number [/home/bil/motif-snd/repl]
+ 35,500,000  s7.c:local_memset [/home/bil/motif-snd/repl]
+ 24,000,012  s7.c:number_to_string_base_10.isra.0 [/home/bil/motif-snd/repl]
+ 18,500,000  s7.c:format_append_chars [/home/bil/motif-snd/repl]
+ 14,500,000  s7.c:g_format_no_column [/home/bil/motif-snd/repl]
+ 14,114,451  s7.c:gc.isra.0 [/home/bil/motif-snd/repl]
+ 12,000,000  s7.c:string_write_string [/home/bil/motif-snd/repl]
+  8,500,000  s7.c:format_n_arg [/home/bil/motif-snd/repl]
+  7,950,930  s7.c:opt_dotimes [/home/bil/motif-snd/repl]
+  7,650,071  ./string/../sysdeps/x86_64/multiarch/memmove-vec-unaligned-erms.S:__memcpy_avx_unaligned_erms [/usr/lib/x86_64-linux-gnu/libc.so.6]
+  7,500,000  s7.c:opt_p_c [/home/bil/motif-snd/repl]
+  4,500,000  s7.c:opt_set_p_p_f [/home/bil/motif-snd/repl]
+|#
+
+
+(define (f10) ; [768]
+  (let ((res "")
+	(size2 (/ size 2)))
+    (do ((i 0 (+ i 1)))
+	((= i size2) res)
+      (set! res (format #f "~{~C~^ ~}" "hiho")))))
+
+;(unless (string=? (f10) "h i h o") (format *stderr* "f10: ~S~%" (f10)))
+
+#|
+367,000,000  s7.c:format_to_port_1'2 [/home/bil/motif-snd/repl]
+189,703,539  s7.c:format_to_port_1 [/home/bil/motif-snd/repl]
+ 63,000,000  s7.c:string_write_char [/home/bil/motif-snd/repl]
+ 42,500,000  s7.c:object_to_list [/home/bil/motif-snd/repl]
+ 29,094,117  s7.c:gc.isra.0 [/home/bil/motif-snd/repl]
+ 18,000,000  s7.c:opt_p_call_ppp [/home/bil/motif-snd/repl]
+ 14,500,000  s7.c:g_format_no_column [/home/bil/motif-snd/repl]
+  8,000,004  ./ctype/../include/ctype.h:__ctype_b_loc [/usr/lib/x86_64-linux-gnu/libc.so.6]
+  7,950,930  s7.c:opt_dotimes [/home/bil/motif-snd/repl]
+  7,650,227  ./string/../sysdeps/x86_64/multiarch/memmove-vec-unaligned-erms.S:__memcpy_avx_unaligned_erms [/usr/lib/x86_64-linux-gnu/libc.so.6]
+  4,500,000  s7.c:opt_p_c [/home/bil/motif-snd/repl]
+  4,500,000  s7.c:opt_set_p_p_f [/home/bil/motif-snd/repl]
+  4,000,002  ???:0x0000000000116e20 [???]
+  3,000,000  s7.c:check_free_heap_size [/home/bil/motif-snd/repl]
+|#
+
+
+(define (f11) ; [345]
+  (let ((res "")
+	(size10 (/ size 10)))
+    (do ((i 0 (+ i 1)))
+	((= i size10) res)
+      (set! res (format #f "~{~{~C~^ ~}~^...~}" (list "hiho" "test"))))))
+
+;(unless (string=? (f11) "h i h o...t e s t") (format *stderr* "f11: ~S~%" (f11)))
+
+#|
+217,500,010  s7.c:format_to_port_1'2 [/home/bil/motif-snd/repl]
+ 39,898,225  s7.c:format_to_port_1 [/home/bil/motif-snd/repl]
+ 25,200,000  s7.c:string_write_char [/home/bil/motif-snd/repl]
+ 19,200,000  s7.c:object_to_list [/home/bil/motif-snd/repl]
+  9,714,210  s7.c:gc.isra.0 [/home/bil/motif-snd/repl]
+  6,184,807  ./string/../sysdeps/x86_64/multiarch/memmove-vec-unaligned-erms.S:__memcpy_avx_unaligned_erms [/usr/lib/x86_64-linux-gnu/libc.so.6]
+  3,600,000  s7.c:opt_p_call_ppp [/home/bil/motif-snd/repl]
+  3,200,004  ./ctype/../include/ctype.h:__ctype_b_loc [/usr/lib/x86_64-linux-gnu/libc.so.6]
+  2,900,085  s7.c:list_p_pp [/home/bil/motif-snd/repl]
+  2,900,000  s7.c:g_format_no_column [/home/bil/motif-snd/repl]
+  2,108,641  ./string/../sysdeps/x86_64/multiarch/strchr-avx2.S:__strchr_avx2 [/usr/lib/x86_64-linux-gnu/libc.so.6]
+  1,900,692  s7.c:s7_list_length [/home/bil/motif-snd/repl]
+  1,600,002  ???:0x0000000000116e20 [???]
+  1,550,930  s7.c:opt_dotimes [/home/bil/motif-snd/repl]
+  1,200,000  s7.c:check_free_heap_size [/home/bil/motif-snd/repl]
+    900,000  s7.c:opt_set_p_p_f [/home/bil/motif-snd/repl]
+    802,400  ???:0x0000000000116b00 [???]
+    700,000  /usr/include/x86_64-linux-gnu/bits/string_fortified.h:format_to_port_1'2
+    700,000  s7.c:opt_p_pp_cc [/home/bil/motif-snd/repl]
+    600,000  s7.c:opt_p_c [/home/bil/motif-snd/repl]
+|#
+
+
+(define (f12) ; [443]
+  (let-temporarily (((*s7* 'print-length) 4))
+    (let ((res "")
+	  (size4 (/ size 4)))
+      (do ((i 0 (+ i 1)))
+	  ((= i size4) res)
+	(set! res (format #f "~{~A~| ~}" #(0 1 2 3 4 5 6 7 8)))))))
+
+;(unless (string=? (f12) "0 1 2 3 ...") (format *stderr* "f12: ~S~%" (f12)))
+
+#|
+178,750,000  s7.c:format_to_port_1'2 [/home/bil/motif-snd/repl]
+ 94,858,241  s7.c:format_to_port_1 [/home/bil/motif-snd/repl]
+ 39,000,000  s7.c:integer_to_port [/home/bil/motif-snd/repl]
+ 32,750,000  s7.c:s7_vector_to_list [/home/bil/motif-snd/repl]
+ 23,501,027  s7.c:gc.isra.0 [/home/bil/motif-snd/repl]
+ 13,500,000  s7.c:string_write_char [/home/bil/motif-snd/repl]
+ 10,000,000  /usr/include/x86_64-linux-gnu/bits/string_fortified.h:integer_to_port
+  9,000,000  s7.c:opt_p_call_ppp [/home/bil/motif-snd/repl]
+  7,584,709  ./string/../sysdeps/x86_64/multiarch/memmove-vec-unaligned-erms.S:__memcpy_avx_unaligned_erms [/usr/lib/x86_64-linux-gnu/libc.so.6]
+  7,250,000  s7.c:g_format_no_column [/home/bil/motif-snd/repl]
+  6,500,000  s7.c:object_to_list [/home/bil/motif-snd/repl]
+  6,000,000  s7.c:string_write_string [/home/bil/motif-snd/repl]
+  3,950,936  s7.c:opt_dotimes [/home/bil/motif-snd/repl]
+  2,250,000  s7.c:opt_p_c [/home/bil/motif-snd/repl]
+  2,250,000  s7.c:opt_set_p_p_f [/home/bil/motif-snd/repl]
+  1,500,000  s7.c:check_free_heap_size [/home/bil/motif-snd/repl]
+|#
+
+
+(define (f13) ; [352]
+  (let ((res "")
+	(size2 (/ size 2)))
+    (do ((i 0 (+ i 1)))
+	((= i size2) res)
+      (set! res (format #f "~B" 1234)))))
+
+;(unless (string=? (f13) "10011010010") (format *stderr* "f13: ~S~%" (f13)))
+
+#|
+108,000,144  s7.c:format_to_port_1 [/home/bil/motif-snd/repl]
+ 78,500,000  s7.c:integer_to_string_any_base [/home/bil/motif-snd/repl]
+ 43,000,000  s7.c:format_number [/home/bil/motif-snd/repl]
+ 32,967,791  s7.c:number_to_string_with_radix [/home/bil/motif-snd/repl]
+ 18,000,000  s7.c:opt_p_call_ppp [/home/bil/motif-snd/repl]
+ 14,500,000  s7.c:g_format_no_column [/home/bil/motif-snd/repl]
+ 14,114,539  s7.c:gc.isra.0 [/home/bil/motif-snd/repl]
+ 12,000,000  s7.c:string_write_string [/home/bil/motif-snd/repl]
+  7,950,972  s7.c:opt_dotimes [/home/bil/motif-snd/repl]
+  6,781,191  ./string/../sysdeps/x86_64/multiarch/memmove-vec-unaligned-erms.S:__memcpy_avx_unaligned_erms [/usr/lib/x86_64-linux-gnu/libc.so.6]
+  4,500,000  s7.c:opt_p_c [/home/bil/motif-snd/repl]
+  4,500,000  s7.c:opt_set_p_p_f [/home/bil/motif-snd/repl]
+|#
+
+
+(define (f14) ; [357]
+  (let ((res "")
+	(size2 (/ size 2)))
+    (do ((i 0 (+ i 1)))
+	((= i size2) res)
+      (set! res (format #f "~A ~* ~A" 1 2 3)))))
+
+;(unless (string=? (f14) "1  3") (format *stderr* "f14: ~S~%" (f14)))
+
+#|
+173,609,289  s7.c:format_to_port_1 [/home/bil/motif-snd/repl]
+ 39,500,000  s7.c:opt_p_call_any [/home/bil/motif-snd/repl]
+ 39,000,000  s7.c:integer_to_port [/home/bil/motif-snd/repl]
+ 21,011,634  ./string/../sysdeps/x86_64/multiarch/strchr-avx2.S:__strchr_avx2 [/usr/lib/x86_64-linux-gnu/libc.so.6]
+ 16,281,614  ./string/../sysdeps/x86_64/multiarch/memmove-vec-unaligned-erms.S:__memcpy_avx_unaligned_erms [/usr/lib/x86_64-linux-gnu/libc.so.6]
+ 14,500,000  s7.c:g_format_no_column [/home/bil/motif-snd/repl]
+ 14,114,923  s7.c:gc.isra.0 [/home/bil/motif-snd/repl]
+ 10,000,000  /usr/include/x86_64-linux-gnu/bits/string_fortified.h:integer_to_port
+  7,950,972  s7.c:opt_dotimes [/home/bil/motif-snd/repl]
+  7,500,000  s7.c:opt_p_c [/home/bil/motif-snd/repl]
+  4,500,000  s7.c:opt_set_p_p_f [/home/bil/motif-snd/repl]
+|#
+
+
+(define (f15) ; [478]
+  (let ((res "")
+	(size2 (/ size 2)))
+    (do ((i 0 (+ i 1)))
+	((= i size2) res)
+      (set! res (format #f "~A:~8T~A" 100 'a)))))
+
+;(unless (string=? (f15) "100:   a") (format *stderr* "f15: ~S~%" (f15)))
+
+#|
+217,609,212  s7.c:format_to_port_1 [/home/bil/motif-snd/repl]
+ 35,500,000  s7.c:opt_p_call_any [/home/bil/motif-snd/repl]
+ 33,150,402  ./string/../sysdeps/x86_64/multiarch/memmove-vec-unaligned-erms.S:__memcpy_avx_unaligned_erms [/usr/lib/x86_64-linux-gnu/libc.so.6]
+ 24,000,024  s7.c:string_write_string [/home/bil/motif-snd/repl]
+ 21,000,000  s7.c:format_numeric_arg [/home/bil/motif-snd/repl]
+ 19,500,012  s7.c:integer_to_port [/home/bil/motif-snd/repl]
+ 18,500,000  s7.c:format_append_chars [/home/bil/motif-snd/repl]
+ 18,000,037  s7.c:symbol_to_port [/home/bil/motif-snd/repl]
+ 15,500,000  s7.c:local_memset [/home/bil/motif-snd/repl]
+ 14,114,921  s7.c:gc.isra.0 [/home/bil/motif-snd/repl]
+ 10,512,314  ./string/../sysdeps/x86_64/multiarch/strchr-avx2.S:__strchr_avx2 [/usr/lib/x86_64-linux-gnu/libc.so.6]
+  9,500,000  s7.c:g_format_f [/home/bil/motif-snd/repl]
+  7,950,972  s7.c:opt_dotimes [/home/bil/motif-snd/repl]
+  6,500,001  /usr/include/x86_64-linux-gnu/bits/string_fortified.h:integer_to_port
+  6,000,000  s7.c:opt_p_c [/home/bil/motif-snd/repl]
+  4,500,000  s7.c:opt_set_p_p_f [/home/bil/motif-snd/repl]
+|#
+
+
+(define (test-all)
+  (unless (string=? (f1) "just a bare string!") (format *stderr* "f1: ~S~%" (f1)))
+  (unless (string=? (f2) "asdf") (format *stderr* "f2: ~S~%" (f2)))
+  (unless (string=? (f3) "str: asdf") (format *stderr* "f3: ~S~%" (f3)))
+  (unless (string=? (f4) "str: asdf a") (format *stderr* "f4: ~S~%" (f4)))
+  (unless (string=? (f5) "(1 2 3)") (format *stderr* "f5: ~S~%" (f5)))
+  (unless (string=? (f6) "3.1416") (format *stderr* "f6: ~S~%" (f6)))
+  (unless (string=? (f7) "3 is third") (format *stderr* "f7: ~S~%" (f7)))
+  (unless (string=? (f8) "                1234") (format *stderr* "f8: ~S~%" (f8)))
+  (unless (string=? (f9) "                    1234") (format *stderr* "f9: ~S~%" (f9)))
+  (unless (string=? (f10) "h i h o") (format *stderr* "f10: ~S~%" (f10)))
+  (unless (string=? (f11) "h i h o...t e s t") (format *stderr* "f11: ~S~%" (f11)))
+  (unless (string=? (f13) "10011010010") (format *stderr* "f13: ~S~%" (f13)))
+  (unless (string=? (f14) "1  3") (format *stderr* "f14: ~S~%" (f14)))
+  (unless (string=? (f15) "100:   a") (format *stderr* "f15: ~S~%" (f15)))
+  )
+
+;(test-all) ; [6556]
+
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(exit)
+
diff --git a/s7/tools/tgc.scm b/s7/tools/tgc.scm
new file mode 100644
index 0000000..89c2b5e
--- /dev/null
+++ b/s7/tools/tgc.scm
@@ -0,0 +1,166 @@
+(set! (*s7* 'heap-size) 128000) ; old-style -- makes little difference (30 in callgrind)
+(load "s7test-block.so" (sublet (curlet) (cons 'init_func 'block_init)))
+
+(define (check-cyclic p1)
+  (let ((c1 (cyclic-sequences p1))
+	(c2 (cyclic-sequences (copy p1)))
+	(c3 (cyclic-sequences (object->let p1))))
+    (unless (and (equal? c1 c2)
+		 (equal? c2 c3))
+      (format *stderr* "cyclic: ~S: ~S ~S ~S~%" p1 c1 c2 c3))))
+
+;(define wait-size 20000) ; this makes the gc work much harder (especially the mark process, mark_vector linearly etc)
+(if (defined? 'big-tgc)
+    (define-expansion (wait-size) 20000) ; plug in the constant to avoid endless lookups (this is cheating)
+    (define-expansion (wait-size) 200)) ; plug in the constant to avoid endless lookups (this is cheating)
+
+(define (tgc-cyclic tries)
+  (let ((wait (make-vector (wait-size) #f)))
+    (do ((i 0 (+ i 1)))
+	((= i tries))
+      (let ((p1 (cons 1 2))
+	    (p2 (make-list 7 1))
+	    (p3 (list 1 2)))
+	(set-cdr! (cdr p3) p3)
+	(check-cyclic p1)
+	(check-cyclic p2)
+	(check-cyclic p3)
+	(let ((v1 (vector 1 2))
+	      (v2 (make-vector 7 1))
+	      (v3 (vector 1 2 3))
+	      (v4 (make-vector '(3 2))))
+	  (vector-set! v3 2 v3)
+	  (check-cyclic v1)
+	  (check-cyclic v2)
+	  (check-cyclic v3)
+	  (check-cyclic v4)
+	  (check-cyclic (subvector v2 1 5))
+	  (check-cyclic (subvector v3 1))
+	  (let ((s1 (string #\a #\s #\d #\f)))
+	    (check-cyclic s1)
+	    (check-cyclic (substring s1 1))
+	    (let ((iv1 (int-vector 1 2))
+		  (iv2 (make-int-vector 7 1)))
+	      (check-cyclic iv1)
+	      (check-cyclic iv2)
+	      (check-cyclic (subvector iv2 1 5))
+	      (let ((h1 (hash-table 'a 1))
+		    (h2 (weak-hash-table 'b p1)))
+		(check-cyclic h1)
+		(check-cyclic h2)
+		(let ((i1 (inlet 'a 1 'b 2)))
+		  (check-cyclic i1)
+		  (let ((in1 (open-output-string)))
+		    (format in1 "asdf\n")
+		    (check-cyclic in1)
+		    (let ((in2 (open-input-string "asdf\n")))
+		      (read-line in2)
+		      (check-cyclic in2)
+		      (let ((c1 (c-pointer 0 integer? "info" (cons h1 h2) (vector p3 p2 p1))))
+			(check-cyclic c1)
+			(let ((cc (call/cc (lambda (ret) ret))))
+			  (check-cyclic cc)
+			  (let ((ex1 (call-with-exit 
+				      (lambda (go) 
+					(check-cyclic go)
+					go))))
+			    (let ((f1 (lambda (a b c) (+ a b c))))
+			      (check-cyclic f1)
+			      (let ((u1 #<asdf>))
+				(check-cyclic u1)
+				(let ((g1 (gensym)))
+				  (check-cyclic g1)
+				  (check-cyclic ())
+				  (check-cyclic #<unspecified)
+				  (check-cyclic when)
+				  (check-cyclic #<eof>)
+				  (check-cyclic #f)
+				  (check-cyclic #\a)
+				  (check-cyclic pi)
+				  (check-cyclic 1/2)
+				  (check-cyclic 1+i)
+				  (check-cyclic 'a)
+				  (check-cyclic (lambda (a) (+ a 1)))
+				  (let ((it1 (make-iterator '(1 2 3))))
+				    (check-cyclic it1)
+				    (let ((b1 (block 1 2 3)))
+				      (check-cyclic b1)
+				      (for-each 
+				       (lambda (a)
+					 (let ((pos (random (wait-size))))
+					   (if (eq? (vector-ref wait pos) #\c) ; just check that it hasn't been freed
+					       (format *stderr* "~S?" (vector-ref wait pos)))
+					   (vector-set! wait pos a))
+					 (dynamic-wind
+					     #f
+					     (lambda ()
+					       (catch #t
+						 (lambda ()
+						   (call-with-exit
+						    (lambda (r)
+						      (r a))))
+						 (lambda (type info)
+						   (format *stderr* "~A: ~A~%" type (apply format #f info)))))
+					     #f))
+				       (list p1 p2 p3 v1 v2 v3 v4 s1 iv2 iv2 h1 h2 i1 in1 in2 c1 cc ex1 u1 g1 it1 b1)))))))))))))))))))))
+
+(tgc-cyclic 25000)
+
+
+(define (tgc tries)
+  (do ((wait (make-vector (wait-size) #f))
+       (i 0 (+ i 1)))
+      ((= i tries))
+    (let ((p1 (cons 1 2))
+	  (p2 (list 1 1 1 1 1 1 1))
+	  (p3 (list 1 2))
+	  (v1 (vector 1 2))
+	  (v2 (make-vector 7 1))
+	  (v3 (vector 1 2 3))
+	  (v4 (make-vector '(3 2)))
+	  (s1 (string #\a #\s #\d #\f))
+	  (iv2 (make-int-vector 7 1))
+	  (h1 (hash-table 'a 1))
+	  (i1 (inlet 'a 1 'b 2))
+	  (in1 (open-output-string))
+	  (in2 (open-input-string "asdf\n"))
+	  (cc (call/cc (lambda (ret) ret)))
+	  (ex1 (call-with-exit 
+		(lambda (go) 
+		  go)))
+	  (f1 (lambda (a b c) (+ a b c)))
+	  (u1 #<asdf>)
+	  (g1 (gensym))
+	  (it1 (make-iterator '(1 2 3)))
+	  (b1 (block 1 2 3)))
+      (set-cdr! (cdr p3) p3)
+      (vector-set! v3 2 v3)
+      (format in1 "asdf\n")
+      (read-line in2)
+      (let* ((h2 (weak-hash-table 'b p1))
+	     (c1 (c-pointer 0 integer? "info" (cons h1 h2) (vector p3 p2 p1))))
+	(for-each 
+	 (lambda (a)
+	   (let ((pos (random (wait-size))))
+	     (if (eq? (vector-ref wait pos) #\c) ; just check that it hasn't been freed
+		 (format *stderr* "~S?" (vector-ref wait pos)))
+	     (vector-set! wait pos a))
+	   (dynamic-wind
+	       #f
+	       (lambda ()
+		 (catch #t
+		   (lambda ()
+		     (call-with-exit
+		      (lambda (r)
+			(r a))))
+		   (lambda (type info)
+		     (format *stderr* "~A: ~A~%" type (apply format #f info)))))
+	       #f))
+	 (list p1 p2 p3 v1 v2 v3 v4 s1 iv2 iv2 h1 h2 i1 in1 in2 c1 cc ex1 u1 g1 it1 b1))))))
+
+(if (defined? 'big-case)
+    (tgc 1000000)
+    (tgc 200000))
+;(tgc 1000000000)
+
+(exit)
diff --git a/s7/tools/tgen.scm b/s7/tools/tgen.scm
new file mode 100644
index 0000000..3e9029c
--- /dev/null
+++ b/s7/tools/tgen.scm
@@ -0,0 +1,393 @@
+(set! (*s7* 'heap-size) 128000)
+
+(unless (or (provided? 'snd)
+	    (provided? 'sndlib))
+  (format *stderr* "tgen depends on sndlib...~%")
+  (system "./snd -noinit tgen.scm")
+  (exit))
+
+(if (provided? 'snd)
+    (begin
+      (load "ws.scm")
+      (load "hooks.scm")
+      (reset-all-hooks)
+      (set! (auto-update) #f)
+      (set! (auto-update-interval) 0.0)
+      (set! *to-snd* #f))
+    (load "sndlib-ws.scm"))
+
+(load "generators.scm")
+
+(set! *clm-file-buffer-size* 16)
+(set! *clm-table-size* 16)
+(set! *clm-clipped* #f)
+;(set! (*s7* 'gc-stats) #t)
+
+(define start-run (get-internal-real-time))
+(define M (float-vector 0 0 1 10))
+(define P (float-vector 0 0 1 1))
+
+(set! (*s7* 'initial-string-port-length) 8192)
+
+(mus-sound-preload "1a.snd")
+
+(define (make-env-1 size) (make-env M :length 10))
+(define (make-pulsed-env-1 size) (make-pulsed-env P .01 1000.0))
+(define (make-delay-1 size) (make-delay 4))
+(define (make-comb-1 size) (make-comb .9 4))
+(define (make-filtered-comb-1 size) (make-filtered-comb .9 4))
+(define (make-notch-1 size) (make-notch .9 4))
+(define (make-all-pass-1 size) (make-all-pass .9 .4 4))
+(define (make-one-pole-all-pass-1 size) (make-one-pole-all-pass 4 .5))
+(define (make-moving-average-1 size) (make-moving-average 4))
+(define (make-moving-max-1 size) (make-moving-max 3))
+(define (make-moving-norm-1 size) (make-moving-norm 3))
+(define (make-one-pole-1 size) (make-one-pole .9 .4))
+(define (make-two-pole-1 size) (make-two-pole .9 .4 .1))
+(define (make-one-zero-1 size) (make-one-zero .9 .4))
+(define (make-two-zero-1 size) (make-two-zero .9 .4 .1))
+(define table-lookup-table (partials->wave '(1 1.0)))
+(define (make-table-lookup-1 size) (make-table-lookup 16 :wave table-lookup-table))
+(define (make-formant-1 size) (make-formant size .1))
+(define (make-firmant-1 size) (make-firmant size .1))
+(define fx (float-vector .1 -.2 .3))
+(define fy (float-vector -.1 .02 -.3))
+(define (make-filter-1 size) (make-filter 3 fx fy))
+(define (make-fir-filter-1 size) (make-fir-filter 3 fx))
+(define (make-iir-filter-1 size) (make-iir-filter 3 fx))
+(define (make-readin-1 size) (make-readin "1a.snd"))
+(define (io dir) .1)
+(define src-1 src)
+(define (make-src-1 size) (make-src io 2.0))
+(define (make-granulate-1 size) (make-granulate io 2.0 0.001 0.6 0.001 .4 0.0))
+(define (make-phase-vocoder-1 size) (make-phase-vocoder io 16))
+(define (make-ssb-am-1 size) (make-ssb-am 100.0 20))
+(define wt-train (make-float-vector 20 0.1))
+(define (make-wave-train-1 size) (make-wave-train 1000.0 0.0 wt-train))
+(define (make-convolve-1 size) (make-convolve io (make-float-vector 16 .2) 16))
+(define ob-freqs (float-vector 100.0 200.0))
+(define ob-amps (float-vector 0.5 0.5))
+(define (make-oscil-bank-1 size) (make-oscil-bank ob-freqs (float-vector 0.0 0.0) ob-amps))
+(define (make-formant-bank-1 size) (make-formant-bank (vector (make-formant 440.0 .95))))
+(define (make-comb-bank-1 size) (make-comb-bank (vector (make-comb .5 6))))
+(define (make-filtered-comb-bank-1 size) (make-filtered-comb-bank (vector (make-filtered-comb .5 6))))
+(define (make-all-pass-bank-1 size) (make-all-pass-bank (vector (make-all-pass .5 .4 6))))
+(define (make-rand-1 size) (set! (mus-rand-seed) 12345) (make-rand 5.0 0.1))
+(define (make-rand-interp-1 size) (set! (mus-rand-seed) 12345) (make-rand-interp 5.0 0.1))
+
+
+;;; we are creating millions of functions here, so we need to keep them from
+;;;   being removed from the heap, and make sure they're GC'd -- *safety*=1
+;;;   keeps them in the heap, but s7 continues to allocate space for each redefinition,
+;;;   hence the extra let below.
+
+
+(define-constant (vequal v1 v2)
+  (or (equivalent? v1 v2)
+      (float-vector-equal? v1 v2 1e-5))) ; "relative" equality: diff/mx
+
+;(set! (*s7* 'equivalent-float-epsilon) 1e-5)
+;(define vequal equivalent?)
+
+(define-constant (checkout str V v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12)
+  (unless (and (vequal V v1)
+	       (vequal v1 v2)
+	       (vequal v1 v3)
+	       (vequal v1 v4))
+    (format *stderr* "~S:~%    no do:  ~A~%    fv-set: ~A~%    outa->v:~A~%    outa:   ~A~%    list:   ~A~%" str V v1 v2 v3 v4))
+  (unless (vequal v5 v6) (format *stderr* "dox ~S:~%   fv-set: ~A~%    outa->v:~A~%" str v5 v6))
+  (unless (vequal v7 v8) (format *stderr* "let ~S:~%    ~A~%    ~A~%" str v7 v8))
+  (unless (vequal v9 v10) (format *stderr* "env let ~S:~%    ~A~%    ~A~%" str v9 v10))
+  (unless (vequal v11 v12) (format *stderr* "letx ~S:~%    ~A~%    ~A~%" str v11 v12)))
+
+(define-constant (checkout-1 str V v1 v2 v3 v4 v5 v6 v11 v12)
+  (unless (and (vequal V v1)
+	       (vequal v1 v2)
+	       (vequal v1 v3)
+	       (vequal v1 v4))
+    (format *stderr* "~S:~%    no do:  ~A~%    fv-set: ~A~%    outa->v:~A~%    outa:   ~A~%    list:   ~A~%" str V v1 v2 v3 v4))
+  (unless (vequal v5 v6) (format *stderr* "dox ~S:~%   fv-set: ~A~%    outa->v:~A~%" str v5 v6))
+  (unless (vequal v11 v12) (format *stderr* "letx ~S:~%    ~A~%    ~A~%" str v11 v12)))
+
+(define-constant F (make-env (float-vector 0.0 .1 1.0 1.0) :length 100))
+(define-constant K (float-vector 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0))
+(define-constant V (make-float-vector 10))
+(define-constant VV1 (make-float-vector 10))
+(define-constant VV4 (make-float-vector 10))
+(define-constant VV5 (make-float-vector 10))
+(define-constant VV6 (make-float-vector 10))
+(define-constant VV8 (make-float-vector 10))
+(define-constant VV10 (make-float-vector 10))
+(define-constant (Z) (mus-copy F))
+
+(define G #f)
+(define I #f)
+(define Ov (vector #f #f #f))
+(define-constant (O) (vector-set! Ov 1 (mus-copy I)) Ov)
+(define-constant (Q) (mus-copy G))
+
+(define (try1 form gen make-gen)
+  (let ((body
+    `(let ()
+       (define (tester-1)
+	 (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1) (v VV1))
+	   (do ((i 0 (+ i 1))) ((= i 10) v)
+	     (float-vector-set! v i ,form))))
+       
+       (define (tester-2)
+	 (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
+	   (set! *output* (make-float-vector 10))
+	   (do ((i 0 (+ i 1))) ((= i 10) *output*)
+	     (outa i ,form))))
+       
+       (define (tester-3)
+	 (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
+	   (set! *output* (make-float-vector 10))
+	   (do ((i 0 (+ i 1))) ((= i 10) *output*)
+	     (out-any i ,form 0))))
+       
+       (define (tester-4)
+	 (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
+	   (do ((i 0 (+ i 1)) (lst ())) ((= i 10) (apply float-vector (reverse! lst)))
+	     (set! lst (cons ,form lst)))))
+       
+       (define (tester-5)
+	 (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (y -0.5) (k 1) (v VV4))
+	   (set! *output* (make-sample->file "test.snd" 1 mus-ldouble mus-next "t816"))
+	   (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 10))
+	     (outa i ,form))
+	   (mus-close *output*)
+	   (file->array "test.snd" 0 0 10 v)))
+       
+       (define (tester-6)
+	 (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (k 1) (v VV5))
+	   (do ((i 0 (+ i 1)) (y -0.5) (x 0.0 (+ x 0.1))) ((= i 10) v)
+	     (float-vector-set! v i ,form))))
+       
+       (define (tester-11)
+	 (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (y -0.5) (k 1) (v VV6))
+	   (do ((i 0 (+ i 1))) ((= i 10) v)
+	     (let ((x (,gen o)))
+	       (float-vector-set! v i ,form)))))
+       
+       (define (tester-12)
+	 (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (y -0.5) (k 1))
+	   (set! *output* (make-float-vector 10))
+	   (do ((i 0 (+ i 1))) ((= i 10) *output*)
+	     (let ((x (,gen o)))
+	       (outa i ,form)))))
+       
+       (set! G (,make-gen 1000)) 
+       (set! I (,make-gen 500)) 
+       
+       (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
+	 (do ((i 0 (+ i 1))) ((= i 10))
+	   (float-vector-set! V i ,form)))
+       
+       (checkout-1 ',form V (tester-1) (tester-2) (tester-3) (tester-4) (tester-5) (tester-6) (tester-11) (tester-12))
+       )))
+    (define the-body (apply lambda () (list body)))
+    (the-body)))
+
+(define (try2 form gen make-gen)
+  (let ((body
+    `(let ()
+       (define (tester-1)
+	 (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1) (v VV1))
+	   (do ((i 0 (+ i 1))) ((= i 10) v)
+	     (float-vector-set! v i ,form))))
+       
+       (define (tester-2)
+	 (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
+	   (set! *output* (make-float-vector 10))
+	   (do ((i 0 (+ i 1))) ((= i 10) *output*)
+	     (outa i ,form))))
+       
+       (define (tester-3)
+	 (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
+	   (set! *output* (make-float-vector 10))
+	   (do ((i 0 (+ i 1))) ((= i 10) *output*)
+	     (out-any i ,form 0))))
+       
+       (define (tester-4)
+	 (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
+	   (do ((i 0 (+ i 1)) (lst ())) ((= i 10) (apply float-vector (reverse! lst)))
+	     (set! lst (cons ,form lst)))))
+       
+       (define (tester-5)
+	 (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (y -0.5) (k 1) (v VV4))
+	   (set! *output* (make-sample->file "test.snd" 1 mus-ldouble mus-next "t816"))
+	   (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 10))
+	     (outa i ,form))
+	   (mus-close *output*)
+	   (file->array "test.snd" 0 0 10 v)))
+       
+       (define (tester-6)
+	 (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (k 1) (v VV5))
+	   (do ((i 0 (+ i 1)) (y -0.5) (x 0.0 (+ x 0.1))) ((= i 10) v)
+	     (float-vector-set! v i ,form))))
+       
+       (define (tester-7)
+	 (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1) (v VV6))
+	   (do ((i 0 (+ i 1))) ((= i 10) v)
+	     (let ((z ,form))
+	       (float-vector-set! v i (,gen o z))))))
+       
+       (define (tester-8)
+	 (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
+	   (set! *output* (make-float-vector 10))
+	   (do ((i 0 (+ i 1))) ((= i 10) *output*)
+	     (let ((z ,form))
+	       (outa i (,gen o z))))))
+       
+       (define (tester-9)
+	 (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1) (v VV8))
+	   (do ((i 0 (+ i 1))) ((= i 10) v)
+	     (let ((z ,form))
+	       (float-vector-set! v i (* (env a) (,gen o z)))))))
+       
+       (define (tester-10)
+	 (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
+	   (set! *output* (make-float-vector 10))
+	   (do ((i 0 (+ i 1))) ((= i 10) *output*)
+	     (let ((z ,form))
+	       (outa i (* (env a) (,gen o z)))))))
+       
+       (define (tester-11)
+	 (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (y -0.5) (k 1) (v VV10))
+	   (do ((i 0 (+ i 1))) ((= i 10) v)
+	     (let ((x (,gen o)))
+	       (float-vector-set! v i ,form)))))
+       
+       (define (tester-12)
+	 (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (y -0.5) (k 1))
+	   (set! *output* (make-float-vector 10))
+	   (do ((i 0 (+ i 1))) ((= i 10) *output*)
+	     (let ((x (,gen o)))
+	       (outa i ,form)))))
+       
+       (set! G (,make-gen 1000)) 
+       (set! I (,make-gen 500)) 
+       
+       (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
+	 (do ((i 0 (+ i 1))) ((= i 10))
+	   (float-vector-set! V i ,form)))
+       
+       (checkout ',form V
+		 (tester-1) (tester-2) (tester-3) (tester-4) (tester-5) (tester-6) 
+		 (tester-7) (tester-8) (tester-9) (tester-10) (tester-11) (tester-12))
+       )))
+    (define the-body (apply lambda () (list body)))
+    (the-body)))
+
+(define (test-gen gen make-gen nargs)
+  (let ((args1 (list 1.5 (list gen 'p) '(env a) 'x 'i (list gen 'o) '(- 1.0 x) (list gen '(vector-ref oscs k))))
+	(args2 (list 1.5 (list gen 'q) '(env b) 'y 'i '(ina i K))))
+
+    (if (= nargs 1)
+	(begin
+	  (for-each 
+	   (lambda (a)
+	     (try1 a gen make-gen))
+	   args1)
+	  
+	  (for-each 
+	   (lambda (a) 
+	     (for-each 
+	      (lambda (b) 
+		(try1 (list '+ a b) gen make-gen)
+		(try1 (list '- a b) gen make-gen)
+		(try1 (list '* a b) gen make-gen)
+		(try1 (list 'cos (list '+ a b)) gen make-gen)
+		(try1 (list 'sin (list '* a b)) gen make-gen)
+		(try1 (list 'abs (list '* a b)) gen make-gen)
+		(try1 (list '* a (list 'abs b)) gen make-gen))
+	      args2))
+	   args1))
+	
+	(begin
+	  (for-each 
+	   (lambda (a)
+	     (try2 a gen make-gen)
+	     (try2 (list gen 'o a) gen make-gen)
+	     (try2 (list 'abs (list gen 'o a)) gen make-gen))
+	   args1)
+	  
+	  (for-each 
+	   (lambda (a) 
+	     (for-each 
+	      (lambda (b) 
+		(try2 (list '+ a b) gen make-gen)
+		(try2 (list '- a b) gen make-gen)
+		(try2 (list '* a b) gen make-gen)
+		(try2 (list 'cos (list '+ a b)) gen make-gen)
+		(try2 (list 'sin (list '* a b)) gen make-gen)
+		(try2 (list 'abs (list '* a b)) gen make-gen)
+		(try2 (list '* a (list 'abs b)) gen make-gen)
+		(try2 (list gen 'o (list '+ a b)) gen make-gen)
+		(try2 (list gen 'o (list '* a b)) gen make-gen)
+		(try2 (list '+ a (list gen 'o b)) gen make-gen)
+		(try2 (list '* a (list gen 'o b)) gen make-gen)
+		(try2 (list '+ (list gen 'o a) b) gen make-gen)
+		(try2 (list '* (list gen 'o a) b) gen make-gen)
+		(try2 (list '* (list 'abs (list gen 'o a)) b) gen make-gen))
+	      args2))
+	   args1)))
+    ))
+  
+(for-each 
+ (lambda (gen make-gen nargs)
+					;(gc)
+   (set! start-run (get-internal-real-time))
+   (test-gen gen make-gen nargs)
+   (format *stderr* "~A: ~20T~,3F~%" gen (* 1.0 (/ (- (get-internal-real-time) start-run) internal-time-units-per-second))))
+ 
+ '(;rand rand-interp ; the y-as-fm case will be different (ignore printout)
+   r2k!cos filter fir-filter iir-filter oscil
+	   one-pole-all-pass env pulsed-env 
+	   formant firmant 
+	   polywave polyshape ncos nsin nrxycos nrxysin rxyk!sin rxyk!cos asymmetric-fm square-wave triangle-wave pulse-train sawtooth-wave
+	   one-pole one-zero two-pole two-zero
+	   oscil-bank 
+	   delay comb notch all-pass filtered-comb
+	   moving-max moving-norm moving-average 
+	   table-lookup wave-train
+	   formant-bank comb-bank filtered-comb-bank all-pass-bank
+	   adjustable-oscil
+	   readin convolve src granulate ssb-am phase-vocoder
+	   )
+ 
+ '(;make-rand make-rand-interp ; the y-as-fm case will be different (ignore printout)
+   make-r2k!cos make-filter-1 make-fir-filter-1 make-iir-filter-1 make-oscil
+		make-one-pole-all-pass-1 make-env-1 make-pulsed-env-1 
+		make-formant-1 make-firmant-1 
+		make-polywave make-polyshape make-ncos make-nsin make-nrxycos make-nrxysin make-rxyk!sin make-rxyk!cos 
+		make-asymmetric-fm make-square-wave make-triangle-wave make-pulse-train make-sawtooth-wave
+		make-one-pole-1 make-one-zero-1 make-two-pole-1 make-two-zero-1
+		make-oscil-bank-1 
+		make-delay-1 make-comb-1 make-notch-1 make-all-pass-1 make-filtered-comb-1
+		make-moving-max-1 make-moving-norm-1 make-moving-average-1 
+		make-table-lookup-1 make-wave-train-1
+		make-formant-bank-1 make-comb-bank-1 make-filtered-comb-bank-1 make-all-pass-bank-1
+		make-adjustable-oscil
+		make-readin-1 make-convolve-1 make-src-1 make-granulate-1 make-ssb-am-1 make-phase-vocoder-1
+		)
+ 
+ '(;2 2 
+   2 2 2 2 2 
+     2 1 1 
+     2 2 
+     2 2 2 2 2 2 2 2 2 2 2 2 2 
+     2 2 2 2 
+     1 
+     2 2 2 2 2 
+     2 2 2 
+     2 2 
+     2 2 2 2 
+     2 
+     1 1 2 1 2 1
+     ))
+  
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(#_exit)
diff --git a/s7/tools/tgsl.scm b/s7/tools/tgsl.scm
new file mode 100644
index 0000000..7f5f9e8
--- /dev/null
+++ b/s7/tools/tgsl.scm
@@ -0,0 +1,592 @@
+;;; gsl cload timing tests
+
+(require libgsl.scm)
+(require libm.scm)
+
+(set! (*s7* 'heap-size) 1024000)
+
+
+(define libgsl:jn (*libgsl* 'gsl_sf_bessel_Jn))
+(define libm:jn (*libm* 'jn))
+
+(define (fm-cascade-component-m freq-we-want wc wm1 a wm2 b)
+  (let ((sum 0.0)
+	(mxa (ceiling (* 7 a)))
+	(mxb (ceiling (* 7 b))))
+    (do ((k (- mxa) (+ k 1)))
+	((>= k mxa))
+      (do ((j (- mxb) (+ j 1)))
+	  ((>= j mxb))
+	(set! sum (+ sum (* (libm:jn k a)
+			    (libm:jn j (* k b)))))))
+	      
+    sum))
+
+(define (fm-cascade-component-g freq-we-want wc wm1 a wm2 b)
+  (let ((sum 0.0)
+	(mxa (ceiling (* 7 a)))
+	(mxb (ceiling (* 7 b))))
+    (do ((k (- mxa) (+ k 1)))
+	((>= k mxa))
+      (do ((j (- mxb) (+ j 1)))
+	  ((>= j mxb))
+	(set! sum (+ sum (* (libgsl:jn k a)
+			    (libgsl:jn j (* k b)))))))
+	      
+    sum))
+
+(format *stderr* "~A ~A~%" (fm-cascade-component-m 2000 2000 500 1.5 50 1.0) (fm-cascade-component-g 2000 2000 500 1.5 50 1.0))
+
+
+(define (testfm)
+  (do ((i 0 (+ i 1)))
+      ((= i 1000))
+    (fm-cascade-component-m 2000 2000 500 1.5 50 1.0)
+    (fm-cascade-component-g 2000 2000 500 1.5 50 1.0)))
+
+(testfm)
+
+
+(define (immutable-let L)
+  (with-let L 
+    (for-each (lambda (f)
+                (immutable! (car f))
+                (immutable! (cdr f)))
+	      (curlet)))
+  L)
+
+(with-let (sublet (immutable-let *libgsl*))
+  
+  (define (eigenvalues M)
+    (let* ((len (sqrt (length M)))
+	   (gm (gsl_matrix_alloc len len))
+	   (m (float-vector->gsl_matrix M gm))
+	   (evl (gsl_vector_complex_alloc len))
+	   (evc (gsl_matrix_complex_alloc len len))
+	   (w (gsl_eigen_nonsymmv_alloc len)))
+      
+      (gsl_eigen_nonsymmv m evl evc w)
+      (gsl_eigen_nonsymmv_free w)
+      (gsl_eigen_nonsymmv_sort evl evc GSL_EIGEN_SORT_ABS_DESC)
+      
+      (let ((vals (make-vector len)))
+	(do ((i 0 (+ i 1)))
+	    ((= i len))
+	  (set! (vals i) (gsl_vector_complex_get evl i)))
+	(gsl_matrix_free gm)
+	(gsl_vector_complex_free evl)
+	(gsl_matrix_complex_free evc)
+	vals)))
+  
+  (format *stderr* "~S #(4.0 2.0)~%" (eigenvalues (float-vector 3 1 1 3)))
+
+  (define testla
+    (let ((fv (float-vector 1 2 4 3)))
+      (lambda ()
+	(do ((i 0 (+ i 1)))
+	    ((= i 30000))
+	  (eigenvalues fv)))))
+  (testla)
+
+  (define (num-test expr result)
+    expr)
+  (define (test expr result)
+    expr)
+
+  (define (testrst)
+    (let ((sfr (gsl_sf_result.make))
+	  (s1 (gsl_sf_result.make))
+	  (s2 (gsl_sf_result.make))
+	  (gs (gsl_cheb_alloc 40))
+	  (g1 (gsl_vector_alloc 3))
+	  (g2 (gsl_vector_alloc 3))
+	  (step_size (gsl_vector_alloc 2))
+	  (v1 (gsl_vector_alloc 2))
+	  (v2 (gsl_vector_alloc 2))
+	  (c1 (gsl_multiset_calloc 4 2))
+	  )
+      (do ((i 0 (+ i 1)))
+	  ((= i 3000))
+	(num-test (gsl_sf_airy_Ai -500.0 GSL_MODE_DEFAULT) 0.07259012010418163)
+	(num-test (gsl_sf_airy_Bi -500.0 GSL_MODE_DEFAULT) -0.0946885701328829)
+	(num-test (gsl_sf_airy_Ai_scaled -5.0 GSL_MODE_DEFAULT) 0.3507610090241141)
+	(num-test (gsl_sf_airy_Bi_scaled -5.0 GSL_MODE_DEFAULT) -0.1383691349016009)
+	(num-test (gsl_sf_airy_Ai_deriv -5.0 GSL_MODE_DEFAULT) 0.3271928185544435)
+	(num-test (gsl_sf_airy_Bi_deriv -5.0 GSL_MODE_DEFAULT) 0.778411773001899)
+	(num-test (gsl_sf_airy_Ai_deriv_scaled -5.0 GSL_MODE_DEFAULT) 0.3271928185544435)
+	(num-test (gsl_sf_airy_Bi_deriv_scaled -5.0 GSL_MODE_DEFAULT) 0.778411773001899)
+	(num-test (gsl_sf_airy_zero_Ai_deriv 2) -3.248197582179837)
+	(num-test (gsl_sf_airy_zero_Bi_deriv 2) -4.073155089071828)
+	(num-test (gsl_sf_bessel_J0 1.0) 0.7651976865579666)
+	(num-test (begin (gsl_sf_bessel_J0_e 1.0 sfr) (gsl_sf_result.val sfr)) 0.7651976865579666)
+	(num-test (begin (gsl_sf_bessel_J0_e 1.0 sfr) (gsl_sf_result.err sfr)) 6.72613016567227e-16)
+	(num-test (gsl_sf_bessel_J0 .1) 0.9975015620660401)
+	(num-test (gsl_sf_bessel_J1 .1) 0.049937526036242)
+	(num-test (gsl_sf_bessel_Jn 45 900.0) 0.02562434700634277)
+	(num-test (gsl_sf_bessel_Y0 .1) -1.534238651350367)
+	(num-test (gsl_sf_bessel_Y1 .1) -6.458951094702027)
+	(num-test (gsl_sf_bessel_Yn 4 .1) -305832.2979335312)
+	(num-test (gsl_sf_bessel_I0_scaled .1) 0.9071009257823011)
+	(num-test (gsl_sf_bessel_I1_scaled .1) 0.04529844680880932)
+	(num-test (gsl_sf_bessel_In_scaled 4 .1) 2.35752586200546e-07)
+	(num-test (gsl_sf_bessel_I0 .1) 1.002501562934096)
+	(num-test (gsl_sf_bessel_I1 .1) 0.05006252604709269)
+	(num-test (gsl_sf_bessel_In 4 .1) 2.605469021299657e-07)
+	(num-test (gsl_sf_bessel_K0_scaled .1) 2.682326102262894)
+	(num-test (gsl_sf_bessel_K1_scaled .1) 10.8901826830497)
+	(num-test (gsl_sf_bessel_Kn_scaled 4 .1) 530040.2483725621)
+	(num-test (gsl_sf_bessel_K0 .1) 2.427069024702016)
+	(num-test (gsl_sf_bessel_K1 .1) 9.853844780870606)
+	(num-test (gsl_sf_bessel_Kn 4 .1) 479600.2497925678)
+	(num-test (gsl_sf_bessel_j0 1.0) 0.8414709848078965)
+	(num-test (gsl_sf_bessel_j1 1.0) 0.3011686789397567)
+	(num-test (gsl_sf_bessel_j2 1.0) 0.06203505201137386)
+	(num-test (gsl_sf_bessel_jl 5 1.0) 9.256115861125814e-05)
+	(num-test (gsl_sf_bessel_zero_J0 1) 2.404825557695771)
+	(num-test (gsl_sf_bessel_zero_Jnu 5 5) 22.21779994656127)
+	(num-test (gsl_sf_hydrogenicR_1 3 2) 0.02575994825614847)
+	(num-test (gsl_sf_dilog -3.0) -1.939375420766708)
+	(gsl_sf_complex_dilog_e 0.99999 (/ pi 2) s1 s2)
+	(num-test (gsl_sf_result.val s1) -0.2056132926277968)
+	(num-test (gsl_sf_result.val s2) 0.9159577401813151)
+	(gsl_sf_complex_spence_xy_e 0.5 0.0 s1 s2)
+	(num-test (gsl_sf_result.val s1) 0.5822405264650126)
+	(num-test (gsl_sf_result.val s2) 0.0)
+	(num-test (gsl_sf_lngamma -0.1) 2.368961332728787)
+	(num-test (gsl_sf_gamma 9.0) 40320.0)
+	(num-test (gsl_sf_gammastar 9.0) 1.009298426421819)
+	(num-test (gsl_sf_gammainv -1.0) 0.0)
+	(gsl_sf_lngamma_complex_e 5.0 2.0 s1 s2)
+	(num-test (gsl_sf_result.val s1) 2.748701756133804)
+	(num-test (gsl_sf_result.val s2) 3.073843410049702)
+	(num-test (gsl_sf_taylorcoeff 10 5) 2.691144455467373)
+	(num-test (gsl_sf_choose 7 3) 35.0)
+	(num-test (gsl_sf_poch 7 3) 504.0000000000001)
+	(num-test (gsl_sf_gamma_inc_P 1.0 10.0) 0.9999546000702381)
+	(num-test (gsl_sf_lnbeta 0.1 1.0) 2.302585092994044)
+	(num-test (gsl_sf_beta 100.1 -1.2) 1203.895236907804)
+	(num-test (gsl_sf_hyperg_0F1 1 0.5) 1.56608292975635)
+	(num-test (gsl_sf_hyperg_1F1 1 1.5 1) 2.030078469278705)
+	(num-test (gsl_sf_hyperg_U_int 100 100 1) 0.009998990209084679)
+	(num-test (gsl_sf_hyperg_2F1 1 1 1 0.5) 2.0)
+	(num-test (gsl_sf_legendre_P1 -0.5) -0.5)
+	(num-test (gsl_sf_legendre_sphPlm 10 0 -0.5) -0.2433270236930014)
+	(num-test (gsl_sf_legendre_Q0 -0.5) -0.5493061443340549)
+	(num-test (gsl_sf_clausen (+ (* 2 pi) (/ pi 3))) 1.014941606409653)
+	(num-test (gsl_sf_coupling_3j 0 1 1 0 1 -1) 0.7071067811865476)
+	(num-test (gsl_sf_dawson 0.5) 0.4244363835020223)
+	(num-test (gsl_sf_multiply -3 2) -6.0)
+	(num-test (gsl_sf_ellint_E (/ pi 2) 0.5 GSL_MODE_DEFAULT) 1.467462209339427)
+	(num-test (gsl_sf_erfc -10) 2.0)
+	(num-test (gsl_sf_exp_mult 10 -2) -44052.93158961344)
+	(num-test (gsl_sf_expm1 -.001) -0.0009995001666250082)
+	(num-test (gsl_sf_Shi -1) -1.057250875375728)
+	(num-test (gsl_sf_fermi_dirac_0 -1) 0.3132616875182229)
+	(num-test (gsl_sf_gegenpoly_1 1.0 1.0) 2.0)
+	
+	(let ((p (float-vector 1.0 -2.0 1.0)) (res (vector 0.0 0.0)))
+	  (gsl_poly_complex_solve (wrap-double* p) 3 res)
+	  (test res #(1.0 1.0)))
+	(let ((p (float-vector 1 -1 1 -1 1 -1 1 -1 1 -1 1)))
+	  (num-test (gsl_poly_eval (wrap-double* p) 11 1.0) 1.0))
+	(let ((p (float-vector 2.1 -1.34 0.76 0.45)))
+	  (num-test (gsl_poly_complex_eval (wrap-double* p) 4 0.49+0.95i) 0.3959142999999998-0.6433305000000001i))
+	(let ((res (float-vector 0.0 0.0)))
+	  (let ((err (gsl_poly_solve_quadratic 4.0 -20.0 26.0 (wrap-double* res))))
+	    (test err 0)))
+	(let ((res (float-vector 0.0 0.0)))
+	  (let ((err (gsl_poly_solve_quadratic 4.0 -20.0 21.0 (wrap-double* res))))
+	    (test res (float-vector 1.5 3.5))))
+	(let ((res (float-vector 0.0 0.0 0.0)))
+	  (let ((err (gsl_poly_solve_cubic -51 867 -4913 (wrap-double* res))))
+	    (test res (float-vector 17.0 17.0 17.0))))
+	(let ((res (vector 0.0 0.0)))
+	  (let ((err (gsl_poly_complex_solve_quadratic 4.0 -20.0 26.0 res)))
+	    (test res #(2.5-0.5i 2.5+0.5i))))
+	(let ((res (vector 0.0 0.0 0.0))) ; workspace handling is internal
+	  (let ((err (gsl_poly_complex_solve_cubic -51 867 -4913 res)))
+	    (test res #(17.0 17.0 17.0))))
+	
+	(num-test (gsl_hypot3 1.0 1.0 1.0) (sqrt 3))
+	(num-test (gsl_hypot 1.0 1.0) (sqrt 2))
+	(test (nan? (gsl_nan)) #t)
+	(test (infinite? (gsl_posinf)) #t)
+	(test (gsl_frexp 2.0) '(0.5 2))
+	(num-test (gsl_pow_2 4) 16.0)
+	
+	(num-test (gsl_cdf_ugaussian_P 0.0) 0.5)
+	(num-test (gsl_cdf_ugaussian_P 0.5) 0.691462461274013)
+	(num-test (gsl_cdf_ugaussian_Q 0.5) 0.3085375387259869)
+	(num-test (gsl_cdf_ugaussian_Pinv 0.5) 0.0)
+	(num-test (gsl_cdf_ugaussian_Qinv 0.5) 0.0)
+	(num-test (gsl_cdf_exponential_P 0.1 0.7) 0.1331221002498184)
+	(num-test (gsl_cdf_exponential_Q 0.1 0.7) 0.8668778997501816)
+	(num-test (gsl_cdf_exponential_Pinv 0.13 0.7) 0.09748344713345537)
+	(num-test (gsl_cdf_exponential_Qinv 0.86 0.7) 0.1055760228142086)
+	(num-test (gsl_cdf_exppow_P -0.1 0.7 1.8) 0.4205349082867516)
+	(num-test (gsl_cdf_exppow_Q -0.1 0.7 1.8) 0.5794650917132484)
+	(num-test (gsl_cdf_tdist_P 0.0 1.0) 0.5)
+	(num-test (gsl_cdf_tdist_Q 0.0 1.0) 0.5)
+	(num-test (gsl_cdf_fdist_P 0.0 1.0 1.3) 0.0)
+	(num-test (gsl_cdf_fdist_Q 0.0 1.0 1.3) 1.0)
+	(num-test (gsl_cdf_fdist_Pinv 0.0 1.0 1.3) 0.0)
+	(num-test (gsl_cdf_fdist_Qinv 1.0 1.0 1.3) 0.0)
+	(num-test (gsl_cdf_gamma_P 0 1 1) 0.0)
+	(num-test (gsl_cdf_gamma_Q 0 1 1) 1.0)
+	(num-test (gsl_cdf_chisq_P 0 13) 0.0)
+	(num-test (gsl_cdf_chisq_Q 0 13) 1.0)
+	(num-test (gsl_cdf_beta_P 0 1.2 1.3) 0.0)
+	(num-test (gsl_cdf_beta_Q 0 1.2 1.3) 1.0)
+	
+	(num-test (gsl_stats_mean (wrap-double* (float-vector 1.0 2.0 3.0 4.0)) 1 4) 2.5)
+	(num-test (gsl_stats_skew (wrap-double* (float-vector 1.0 2.0 3.0 4.0)) 1 4) 0.0)
+	(num-test (gsl_stats_max (wrap-double* (float-vector 1.0 2.0 3.0 4.0)) 1 4) 4.0)
+	
+	(let ((rng (gsl_rng_alloc gsl_rng_default)))
+	  (test (real? (gsl_ran_exponential rng 1.0)) #t)
+	  (gsl_rng_free rng))
+	
+	(num-test (gsl_complex_log 1+i) (log 1+i))
+	(num-test (gsl_complex_abs 1+i) (magnitude 1+i))
+	(num-test (gsl_complex_sin 1+i) (sin 1+i))
+	
+	(gsl_cheb_init gs (lambda (x) x) -1.0 1.0)
+	(num-test (gsl_cheb_eval gs -1.0) -1.0)
+	(num-test (gsl_cheb_eval gs 0.0) 0.0)
+	(num-test (gsl_cheb_eval gs 1.0) 1.0)
+	
+	(let ((x (float-vector 0.0))
+	      (y (float-vector 0.0)))
+	  (gsl_deriv_central (lambda (x) (expt x 1.5)) 2.0 1e-8 (wrap-double* x) (wrap-double* y))
+	  (num-test (x 0) (* 1.5 (sqrt 2)))
+	  (gsl_deriv_forward (lambda (x) (expt x 1.5)) 0.0 1e-8 (wrap-double* x) (wrap-double* y))
+	  (test (< (x 0) 1e-5) #t))
+	
+	(let ((f (float-vector -1 3 0 4 2 6)))
+	  (gsl_sort (wrap-double* f) 1 6)
+	  (test f (float-vector -1 0 2 3 4 6)))
+	
+	(let ((f1 (make-float-vector 3)))
+	  (gsl_vector_add (float-vector->gsl_vector (float-vector 0 1 2) g1)
+			  (float-vector->gsl_vector (float-vector 3 4 5) g2))
+	  (gsl_vector->float-vector g1 f1)
+	  (test f1 (float-vector 3 5 7)))
+	
+	(let ((f (make-float-vector '(3 3))))
+	  (let ((g (gsl_matrix_alloc 3 3)))
+	    (gsl_matrix_set_identity g)
+	    (do ((i 0 (+ i 1)))
+		((= i 3)
+		 (gsl_matrix_free g))
+	      (do ((j 0 (+ j 1)))
+		  ((= j 3))
+		(set! (f i j) (gsl_matrix_get g i j)))))
+	  (test (equivalent? f #2d((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))) #t))
+	
+	(let ((f (make-vector '(3 3))))
+	  (let ((g (gsl_matrix_complex_alloc 3 3)))
+	    (gsl_matrix_complex_set_identity g)
+	    (gsl_matrix_complex_scale g 1+i)
+	    (do ((i 0 (+ i 1)))
+		((= i 3)
+		 (gsl_matrix_complex_free g))
+	      (do ((j 0 (+ j 1)))
+		  ((= j 3))
+		(set! (f i j) (gsl_matrix_complex_get g i j)))))
+	  (test (equivalent? f #2d((1+i 0.0 0.0) (0.0 1+i 0.0) (0.0 0.0 1+i))) #t))
+	
+	(let ((Y (float-vector 0.554))
+	      (A (float-vector -0.047))
+	      (X (float-vector 0.672)))
+	  (cblas_dgemv 101 111 1 1 -0.3 (wrap-double* A) 1 (wrap-double* X) -1 -1 (wrap-double* Y) -1)
+	  (num-test (Y 0) -0.5445248))
+	
+	(let ((Y (float-vector 0.348 0.07))
+	      (A (float-vector 0.932 -0.724))
+	      (X (float-vector 0.334 -0.317))
+	      (alpha (float-vector 0 .1))
+	      (beta (float-vector 1 0)))
+	  (cblas_zgemv 101 111 1 1 (wrap-double* alpha) (wrap-double* A) 1 (wrap-double* X) -1 (wrap-double* beta) (wrap-double* Y) -1)
+	  (num-test (Y 0) 0.401726)
+	  (num-test (Y 1) 0.078178))
+	
+	(test (let ((f (float-vector 0 1 2 3 4))) (gsl_interp_bsearch (wrap-double* f) 1.5 0 4)) 1)
+	
+	(let ((x (make-float-vector 10))
+	      (y (make-float-vector 10)))
+	  (do ((i 0 (+ i 1)))
+	      ((= i 10))
+	    (set! (x i) (+ i (* 0.5 (sin i))))
+	    (set! (y i) (+ i (cos (* i i)))))
+	  (let ((acc (gsl_interp_accel_alloc))
+		(spline (gsl_spline_alloc gsl_interp_cspline 10)))
+	    (gsl_spline_init spline (wrap-double* x) (wrap-double* y) 10)
+	    (let ((res (gsl_spline_eval spline (x 5) acc)))
+	      (gsl_spline_free spline)
+	      (gsl_interp_accel_free acc)
+	      (num-test res 5.991202811863474))))
+	
+	(let ((c (gsl_combination_alloc 6 3))
+	      (data #2d((0 1 2) (0 1 3) (0 1 4) (0 1 5)
+			(0 2 3) (0 2 4) (0 2 5) (0 3 4)
+			(0 3 5) (0 4 5) (1 2 3) (1 2 4)
+			(1 2 5) (1 3 4) (1 3 5) (1 4 5)
+			(2 3 4) (2 3 5) (2 4 5) (3 4 5)))
+	      (iv (make-int-vector 3 0)))
+	  (gsl_combination_init_first c)
+	  (do ((i 0 (+ i 1)))
+	      ((= i 20))
+	    ((*libgsl* 'gsl_combination->int-vector) c iv)
+	    (if (not (equivalent? iv (data i)))
+		(format *stderr* ";gsl_combination: ~A ~A~%" iv (data i)))
+	    (gsl_combination_next c))
+	  (gsl_combination_free c))
+	
+	(let ((p (gsl_permutation_alloc 3))
+	      (data (make-int-vector 18 0)))
+	  (gsl_permutation_init p)
+	  (do ((pp GSL_SUCCESS (gsl_permutation_next p))
+	       (i 0 (+ i 3)))
+	      ((not (= pp GSL_SUCCESS)))
+	    (set! (data i) (gsl_permutation_get p 0))
+	    (set! (data (+ i 1)) (gsl_permutation_get p 1))
+	    (set! (data (+ i 2)) (gsl_permutation_get p 2)))
+	  (gsl_permutation_free p)
+	  (test (equivalent? data #(0 1 2 0 2 1 1 0 2 1 2 0 2 0 1 2 1 0)) #t))
+	
+	(let ((N 50))
+	  (let ((t (make-float-vector N 0.0)))
+	    (do ((i 0 (+ i 1)))
+		((= i N))
+	      (set! (t i) (/ 1.0 (* (+ i 1) (+ i 1)))))
+	    (let ((zeta_2 (/ (* pi pi) 6.0)))
+	      (let ((accel (float-vector 0.0))
+		    (err (float-vector 0.0))
+		    (w (gsl_sum_levin_u_alloc N)))
+		(gsl_sum_levin_u_accel (wrap-double* t) N w (wrap-double* accel) (wrap-double* err))
+		(num-test zeta_2 (accel 0))
+		(gsl_sum_levin_u_free w)))))
+	
+	(let ((data (float-vector 0 0  1 0  1 1  0 -1)) ; complex data as rl+im coming and going
+	      (output (make-float-vector 8 0.0)))
+	  (gsl_dft_complex_forward (wrap-double* data) 1 4 (wrap-double* output))
+	  ;; = -1 in snd terminology: (cfft! (vector 0 1 1+i 0-i) 4 -1): #(2.0 0-2i 0+2i -2.0)
+	  (test (equivalent? output (float-vector 2.0 0.0  0.0 -2.0  0.0 2.0  -2.0 0.0)) #t))
+	(let ((data (float-vector 0 0  1 0  1 1  0 -1))) ; complex data as rl+im coming and going
+	  (gsl_fft_complex_radix2_forward (wrap-double* data) 1 4)
+	  (test (equivalent? data (float-vector 2.0 0.0  0.0 -2.0  0.0 2.0  -2.0 0.0)) #t))
+	
+	(let ((data (make-float-vector 256))
+	      (w (gsl_wavelet_alloc gsl_wavelet_daubechies 4))
+	      (work (gsl_wavelet_workspace_alloc 256)))
+	  (do ((i 0 (+ i 1)))
+	      ((= i 256))
+	    (set! (data i) (sin (* i (/ pi 128)))))
+	  (gsl_wavelet_transform_forward w (wrap-double* data) 1 256 work)
+	  (gsl_wavelet_transform_inverse w (wrap-double* data) 1 256 work)
+	  (gsl_wavelet_free w)
+	  (gsl_wavelet_workspace_free work)
+	  data)
+	
+	(let ((h (gsl_histogram_alloc 10))
+	      (data (make-int-vector 10)))
+	  (gsl_histogram_set_ranges_uniform h 0.0 1.0)
+	  (do ((i 0 (+ i 1)))
+	      ((= i 50))
+	    (gsl_histogram_increment h (random 1.0)))
+	  (do ((i 0 (+ i 1)))
+	      ((= i 10))
+	    (set! (data i) (round (gsl_histogram_get h i))))
+	  (gsl_histogram_free h)
+	  data)
+	
+	(let ((a_data (float-vector 0.18 0.60 0.57 0.96  0.41 0.24 0.99 0.58  0.14 0.30 0.97 0.66  0.51 0.13 0.19 0.85))
+	      (b_data (float-vector 1 2 3 4)))
+	  (let ((m (gsl_matrix_alloc 4 4))
+		(b (gsl_vector_alloc 4)))
+	    (let ((x (gsl_vector_alloc 4))
+		  (p (gsl_permutation_alloc 4)))
+	      (do ((i 0 (+ i 1)))
+		  ((= i 4))
+		(do ((j 0 (+ j 1)))
+		    ((= j 4))
+		  (gsl_matrix_set m i j (a_data (+ j (* i 4))))))
+	      (do ((i 0 (+ i 1)))
+		  ((= i 4))
+		(gsl_vector_set b i (b_data i)))
+	      (gsl_linalg_LU_decomp m p) ; int-by-ref is internal
+	      (gsl_linalg_LU_solve m p b x)
+	      (do ((i 0 (+ i 1)))
+		  ((= i 4))
+		(set! (b_data i) (gsl_vector_get x i)))
+	      (gsl_permutation_free p)
+	      (gsl_vector_free x)
+	      (gsl_matrix_free m)
+	      (gsl_vector_free b)
+	      b_data)))
+	
+	(when (>= gsl-version 1.16)
+	  (let ()
+	    (define (dofit T X y c cov)
+	      (let ((work (gsl_multifit_robust_alloc T (car (gsl_matrix_size X)) (cdr (gsl_matrix_size X)))))
+		(let ((s (gsl_multifit_robust X y c cov work)))
+		  (gsl_multifit_robust_free work)
+		  s)))
+	    (let* ((n 30)
+		   (p 2)
+		   (a 1.45)
+		   (b 3.88)
+		   (X (gsl_matrix_alloc n p))
+		   (x (gsl_vector_alloc n))
+		   (y (gsl_vector_alloc n))
+		   (c (gsl_vector_alloc p))
+		   (c_ols (gsl_vector_alloc p))
+		   (cov (gsl_matrix_alloc p p))
+		   (gv (gsl_vector_alloc p))
+		   (r (gsl_rng_alloc gsl_rng_default)))
+	      (do ((i 0 (+ i 1)))
+		  ((= i (- n 3)))
+		(let* ((dx (/ 10.0 (- n 1.0)))
+		       (ei (gsl_rng_uniform r))
+		       (xi (+ -5.0 (* i dx)))
+		       (yi (+ b (* a xi))))
+		  (gsl_vector_set x i xi)
+		  (gsl_vector_set y i (+ yi ei))))
+	      (gsl_vector_set x (- n 3) 4.7)
+	      (gsl_vector_set y (- n 3) -8.3)
+	      (gsl_vector_set x (- n 2) 3.5)
+	      (gsl_vector_set y (- n 2) -6.7)
+	      (gsl_vector_set x (- n 1) 4.1)
+	      (gsl_vector_set y (- n 1) -6.0)
+	      (do ((i 0 (+ i 1)))
+		  ((= i n))
+		(let ((xi (gsl_vector_get x i)))
+		  (gsl_matrix_set X i 0 1.0)
+		  (gsl_matrix_set X i 1 xi)))
+	      (dofit gsl_multifit_robust_ols X y c_ols cov)
+	      (dofit gsl_multifit_robust_bisquare X y c cov)
+	      (do ((i 0 (+ i 1)))
+		  ((= i n))
+		(let ((xi (gsl_vector_get x i))
+		      (yi (gsl_vector_get y i))
+		      (y_ols (float-vector 0.0))
+		      (y_rob (float-vector 0.0))
+		      (y_err (float-vector 0.0)))
+		  (gsl_vector_set gv 0 (gsl_matrix_get X i 0))
+		  (gsl_vector_set gv 1 (gsl_matrix_get X i 1))
+		  (gsl_multifit_robust_est gv c cov (wrap-double* y_rob) (wrap-double* y_err))
+		  (gsl_multifit_robust_est gv c_ols cov (wrap-double* y_ols) (wrap-double* y_err))))
+	      (gsl_matrix_free X)
+	      (gsl_matrix_free cov)
+	      (gsl_vector_free x)
+	      (gsl_vector_free y)
+	      (gsl_vector_free c)
+	      (gsl_vector_free gv)
+	      (gsl_vector_free c_ols)
+	      (gsl_rng_free r))))
+	
+	(let ()
+	  (gsl_rng_env_setup)
+	  (let* ((T gsl_rng_default)
+		 (r (gsl_rng_alloc T))
+		 (x 0)
+		 (y 0)
+		 (dx (float-vector 0.0))
+		 (dy (float-vector 0.0)))
+	    (do ((i 0 (+ i 1)))
+		((= i 10))
+	      (gsl_ran_dir_2d r (wrap-double* dx) (wrap-double* dy))
+	      (set! x (+ x (dx 0)))
+	      (set! y (+ y (dy 0))))
+	    (gsl_rng_free r)))
+	
+	(let ((T gsl_multimin_fminimizer_nmsimplex))
+	  (define (simple-abs x)
+	    (let ((u (gsl_vector_get x 0))
+		  (v (gsl_vector_get x 1)))
+	      (let ((a (- u 1))
+		    (b (- v 2)))
+		(+ (abs a) (abs b)))))
+	  (let ((s3 (gsl_multimin_fminimizer_alloc T 2)))
+	    (gsl_vector_set v2 0 1.0)
+	    (gsl_vector_set v2 1 2.0)
+	    (gsl_vector_set step_size 0 1)
+	    (gsl_vector_set step_size 1 1)
+	    (gsl_multimin_fminimizer_set s3 simple-abs v2 step_size)
+	    (do ((i 0 (+ i 1)))
+		((= i 10))
+	      (gsl_multimin_fminimizer_iterate s3))
+	  (let ((result (abs (gsl_multimin_fminimizer_fval s3))))
+	    (gsl_multimin_fminimizer_free s3)
+	    (num-test result 0.0))))
+	
+	(let ((n 4)
+	      (x (float-vector 1970 1980 1990 2000))
+	      (y (float-vector 12 11 14 13))
+	      (w (float-vector 0.1 0.2 0.3 0.4))
+	      (c0 (float-vector 0.0))
+	      (c1 (float-vector 0.0))
+	      (cov00 (float-vector 0.0))
+	      (cov01 (float-vector 0.0))
+	      (cov11 (float-vector 0.0))
+	      (chisq (float-vector 0.0)))
+	  (gsl_fit_wlinear (wrap-double* x) 1 (wrap-double* w) 1 (wrap-double* y) 1 n
+			   (wrap-double* c0) (wrap-double* c1) (wrap-double* cov00) (wrap-double* cov01) (wrap-double* cov11) (wrap-double* chisq))
+	  (num-test (+ (c0 0) (c1 0)) -106.54))
+
+	(test (list (gsl_multiset_n c1) (gsl_multiset_k c1)) '(4 2))
+	
+	(let ((factor 1.0)
+	      (T gsl_multiroot_fsolver_dnewton))
+	  (define (rosenb x f)
+	    (let ((x0 (gsl_vector_get x 0))
+		  (x1 (gsl_vector_get x 1)))
+	      (let ((y0 (- 1 x0))
+		    (y1 (* 10 (- x1 (* x0 x0)))))
+		(gsl_vector_set f 0 y0)
+		(gsl_vector_set f 1 y1)
+		GSL_SUCCESS)))
+	  (gsl_vector_set v1 0 -1.2)
+	  (gsl_vector_set v1 1 1.0)
+	  (let ((s (gsl_multiroot_fsolver_alloc T 2)))
+	    (gsl_multiroot_fsolver_set s rosenb v1)
+	    (do ((i 0 (+ i 1)))
+		((= i 10))
+	      (gsl_multiroot_fsolver_iterate s))
+	    (let ((residual (abs (gsl_vector_get (gsl_multiroot_fsolver_f s) 0))))
+	      (gsl_multiroot_fsolver_free s)
+	      (test residual 0.0)))))
+
+      (gsl_sf_result.free sfr)
+      (gsl_sf_result.free s1)
+      (gsl_sf_result.free s2)
+      (gsl_cheb_free gs)
+      (gsl_vector_free g1)
+      (gsl_vector_free g2)
+      (gsl_vector_free v1)
+      (gsl_multiset_free c1)
+      (gsl_vector_free v2)
+      (gsl_vector_free step_size)
+
+      ))
+  
+  (testrst))
+
+
+(require libm.scm)
+(define jn (*libm* 'jn)) ; coverage tests for opt_d_id*
+(define (f v) (do ((i 0 (+ i 1))) ((= i 1) v) (float-vector-set! v 0 (jn 0 1.0))))
+(let ((val (f (float-vector 0.0))))
+  (unless (equivalent? val #r(0.7651976865579666))
+    (format *stderr* "jn 1: ~S ~S~%" val (f (float-vector 0.0)))))
+(define (f1 v) (do ((i 0 (+ i 1))) ((= i 1) v) (float-vector-set! v 0 (jn (+ i 1) 1.0))))
+(let ((val (f1 (float-vector 0.0))))
+  (unless (equivalent? val #r(0.4400505857449335))
+    (format *stderr* "jn 2: ~S ~S~%" val (f (float-vector 0.0)))))
+(define (f2 v) (do ((i 0 (+ i 1))) ((= i 1) v) (float-vector-set! v 0 (jn i 1.0))))
+(let ((val (f2 (float-vector 0.0))))
+  (unless (equivalent? val #r(0.7651976865579666))
+    (format *stderr* "jn 3: ~S ~S~%" val (f (float-vector 0.0)))))
+
+(exit)
+
diff --git a/s7/tools/thash.scm b/s7/tools/thash.scm
new file mode 100644
index 0000000..bff2f30
--- /dev/null
+++ b/s7/tools/thash.scm
@@ -0,0 +1,328 @@
+(set! (*s7* 'heap-size) (* 12 1024000))
+
+(define (reader)
+  (let ((port (open-input-file "/home/bil/cl/bib"))
+	(counts (make-hash-table))
+	(start 0)
+	(end 0)
+	(new-pos 0))
+    (do ((line (read-line port) (read-line port)))
+	((eof-object? line))
+      (set! new-pos 0)
+      (do ((pos (char-position #\space line) (char-position #\space line (+ pos 1))))
+	  ((not pos))
+	(unless (= pos new-pos)
+	  (set! start 
+		(if (char-alphabetic? (string-ref line new-pos))
+		    new-pos
+		    (do ((k (+ new-pos 1) (+ k 1))) ; char-position here is slower!
+			((or (char-alphabetic? (string-ref line k))
+			     (>= k pos))
+			 k))))
+	  (set! end 
+		(if (char-alphabetic? (string-ref line (- pos 1)))
+		    pos
+		    (do ((k (- pos 2) (- k 1)))
+			((or (char-alphabetic? (string-ref line k))
+			     (<= k start))
+			 (+ k 1)))))
+	  (when (> end start)
+	    (let ((word (string->symbol (substring line start end))))
+	      (hash-table-set! counts word (+ (or (hash-table-ref counts word) 0) 1)))))
+	(set! new-pos (+ pos 1))))
+    (close-input-port port)
+    (sort! (copy counts (make-vector (hash-table-entries counts)))
+	   (lambda (a b) (> (cdr a) (cdr b))))))
+
+(format *stderr* "reader ")
+
+(let ((counts (reader)))
+  (unless (and (eq? (car (counts 0)) 'the)
+	       (= (cdr (counts 0)) 62063))
+    (do ((i 0 (+ i 1))) 
+	((= i 40)) 
+      (format *stderr* "~A: ~A~%" (car (counts i)) (cdr (counts i))))))
+
+;;; ----------------------------------------
+
+(define global-val 0) ; for reader-cond in s7test.scm
+
+(let ()
+  (define (walk p counts)
+    (if (pair? p)
+	(begin
+	  (walk (car p) counts)
+	  (if (pair? (cdr p))
+	      (walk (cdr p) counts)))
+	(hash-table-set! counts p (+ (or (hash-table-ref counts p) 0) 1))))
+  
+  (define (s7test-reader)
+    (let ((port (open-input-file "s7test.scm"))
+	  (counts (make-hash-table)))
+      (do ((expr (read port) (read port)))
+	  ((eof-object? expr) 
+	   (close-input-port port)
+	   counts)
+	(walk expr counts))))
+  
+  (define (sort-counts counts)
+    (let ((len (hash-table-entries counts)))
+      (do ((v (make-vector len))
+	   (h (make-iterator counts))
+	   (i 0 (+ i 1)))
+	  ((= i len)
+	   (sort! v (lambda (e1 e2) (> (cdr e1) (cdr e2))))
+	   v)
+	(vector-set! v i (iterate h)))))
+  
+  (sort-counts (s7test-reader)))
+
+;;; ----------------------------------------
+
+(let ()
+  (define (hash-ints calls)
+    (let ((counts (make-hash-table)))
+      (do ((i 0 (+ i 1))
+	   (z (random 100) (random 100)))
+	  ((= i calls) i)
+	(hash-table-set! counts z (+ (or (hash-table-ref counts z) 0) 1)))))
+
+  (let ((val (hash-ints 5000000)))
+    (unless (= val 5000000)
+      (format *stderr* "thash hash-ints: ~S?~%" val))))
+
+
+;;; ----------------------------------------
+
+(define symbols (make-vector 1))
+(define strings (make-vector 1))
+
+(define (test1 size)
+  (let ((int-hash (make-hash-table size))
+	(p (cons #f #f)))
+    (do ((i 0 (+ i 1))) 
+	((= i size))
+      (hash-table-set! int-hash i i))
+    (do ((i 0 (+ i 1)))	
+	((= i size))
+      (unless (= (hash-table-ref int-hash i) i)
+	  (display "oops")))
+    (for-each (lambda (key&value)
+		(unless (= (car key&value) (cdr key&value))
+		    (display "oops"))) ;(format *stderr* "hash iter ~A~%" key&value)))
+	      (make-iterator int-hash p))
+    (set! int-hash #f)))
+
+(define (test2 size)
+  (let ((int-hash (make-hash-table size =)))
+    (do ((i 0 (+ i 1))) 
+	((= i size)) 
+      (hash-table-set! int-hash i i))
+    (do ((i 0 (+ i 1)))	
+	((= i size))
+      (unless (= (hash-table-ref int-hash i) i)
+	  (display "oops")))
+    (set! int-hash #f)))
+
+(define (test3 size)
+  (let ((flt-hash (make-hash-table size)))
+    (do ((i 0 (+ i 1))) 
+	((= i size)) 
+      (hash-table-set! flt-hash (* i 2.0) i))
+    (do ((i 0 (+ i 1)))	
+	((= i size))
+      (unless (= (hash-table-ref flt-hash (* 2.0 i)) i)
+	  (display "oops")))
+    (set! flt-hash #f)))
+
+(define (random-string)
+  (let* ((len (+ 1 (random 8)))
+	 (s (make-string len)))
+    (do ((i 0 (+ i 1)))
+	((= i len) s)
+      (string-set! s i (integer->char (+ 20 (random 100)))))))
+
+(define (test4 size)
+  (let ((sym-hash (make-hash-table size)))
+    (do ((i 0 (+ i 1))) 
+	((= i size)) 
+      (hash-table-set! sym-hash (vector-set! symbols i (string->symbol (vector-set! strings i (number->string i)))) i))
+    (do ((i 0 (+ i 1))) 
+	((= i size)) 
+      (unless (= (hash-table-ref sym-hash (vector-ref symbols i)) i)
+	  (display "oops")))
+    (set! sym-hash #f)))
+
+(define (test5 size)
+  (let ((str-hash (make-hash-table size eq?))) ; string=? here is pessimal because number->string above ruins hash_map_string
+    (do ((i 0 (+ i 1))) 
+	((= i size)) 
+      (hash-table-set! str-hash (vector-ref strings i) i))
+    (do ((i 0 (+ i 1))) 
+	((= i size)) 
+      (unless (= (hash-table-ref str-hash (vector-ref strings i)) i)
+	  (display "oops")))
+    (set! str-hash #f)))
+
+(define (test6 size)
+  (let ((sym-hash (make-hash-table size eq?)))
+    (do ((i 0 (+ i 1))) 
+	((= i size)) 
+      (hash-table-set! sym-hash (vector-ref symbols i) i))
+    (do ((i 0 (+ i 1))) 
+	((= i size)) 
+      (unless (= (hash-table-ref sym-hash (vector-ref symbols i)) i)
+	  (display "oops")))
+    (set! sym-hash #f)))
+
+(define (test7 size)
+  (let ((chr-hash (make-hash-table 256 char=?)))
+    (do ((i 0 (+ i 1))) 
+	((= i 256)) 
+      (hash-table-set! chr-hash (integer->char i) i))
+    (do ((i 0 (+ i 1))) 
+	((= i 256)) 
+      (unless (= (hash-table-ref chr-hash (integer->char i)) i)
+	  (display "oops")))
+    (set! chr-hash #f)))
+
+(define (test8 size)
+  (let ((any-hash (make-hash-table size eq?)))
+    (if (= size 1)
+	(hash-table-set! any-hash (vector-set! strings 0 (list 0)) 0)
+	(begin
+	  (do ((i 0 (+ i 2)))
+	      ((= i size))
+	    (hash-table-set! any-hash (vector-set! strings i (list i)) i))
+	  (do ((j 1 (+ j 2)))
+	      ((>= j size))
+	    (hash-table-set! any-hash (vector-set! strings j (int-vector j)) j))))
+    (do ((i 0 (+ i 1))) 
+	((= i size)) 
+      (unless (= i (hash-table-ref any-hash (vector-ref strings i)))
+	  (display "oops")))
+    (set! any-hash #f)))
+
+(when (provided? 'pure-s7)
+  (define (vector-fill! vect val . args)
+    (if (vector? vect)
+	(apply fill! vect val args)
+	(error 'wrong-type-arg "vector-fill! argument should be a vector: ~A" str))))
+
+(define (test9 size)
+  (let ((any-hash1 (make-hash-table size eq?)))
+    (if (= size 1)
+	(hash-table-set! any-hash1 (vector-set! strings 0 (inlet 'a 0)) 0)
+	(begin
+	  (do ((i 0 (+ i 2)))
+	      ((= i size))
+	    (hash-table-set! any-hash1 (vector-set! strings i (inlet 'a i)) i))
+	  (do ((j 1 (+ j 2))
+	       (x 0.0 (+ x 2.0)))
+	      ((>= j size))
+	    (hash-table-set! any-hash1 (vector-set! strings j (float-vector x)) j))))
+    (do ((i 0 (+ i 1))) 
+	((= i size)) 
+      (unless (= i (hash-table-ref any-hash1 (vector-ref strings i)))
+	  (display "oops")))
+    (vector-fill! strings #f)
+    (set! any-hash1 #f)))
+
+(define (test10 size)
+  (let ((cmp-hash (make-hash-table size =)))
+    (do ((i 0 (+ i 1))) 
+	((= i size)) 
+      (hash-table-set! cmp-hash (complex i i) i))
+    (do ((i 0 (+ i 1))) 
+	((= i size)) 
+      (unless (= (hash-table-ref cmp-hash (complex i i)) i)
+	  (display "oops")))
+    (set! cmp-hash #f)))
+
+(define (test11 size)
+  (let ((int-hash (make-hash-table size equivalent?)))
+    (do ((i 0 (+ i 1))) 
+	((= i size)) 
+      (hash-table-set! int-hash i i))
+    (let-temporarily (((*s7* 'hash-table-float-epsilon) 1.0e-6))
+      (do ((i 0 (+ i 1)))	
+	  ((= i size))
+	(unless (= (hash-table-ref int-hash (+ i (random 9.0e-7))) i)
+	  (display "oops"))
+	(unless (= (hash-table-ref int-hash (- i (random 9.0e-7))) i)
+	  (display "oops"))
+	(when (hash-table-ref int-hash (- i 1.0e-5 (random 1.0e-6)))
+	  (display "oops")))
+      (set! int-hash #f))))
+
+(define (test12 size)
+  (let ((rat-hash (make-hash-table size eqv?)))
+    (do ((i 0 (+ i 1))) 
+	((= i size))
+      (hash-table-set! rat-hash (/ i 3) i))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (unless (= (hash-table-ref rat-hash (/ i 3)) i)
+	(display "oops")))
+    (set! rat-hash #f)))
+
+(define (test13 size)
+  (let ((vct-hash (make-hash-table size equal?)))
+    (do ((i 0 (+ i 1))) 
+	((= i size)) 
+      (hash-table-set! vct-hash (float-vector i) i))
+    (do ((i 0 (+ i 1)))	
+	((= i size))
+      (unless (= (hash-table-ref vct-hash (float-vector i)) i)
+	(display "oops")))
+    (set! vct-hash #f)))
+
+(define (random-string-1)
+  (let* ((len (+ 1 (random 20)))
+	 (s (make-string len)))
+    (do ((i 0 (+ i 1)))
+	((= i len) s)
+      (string-set! s i (integer->char (+ 20 (random 100)))))))
+  
+(define (test14 size)
+  (when (< size 1000000) ; random-string is not interesting in this context
+    (do ((i 0 (+ i 1))) 
+	((= i size)) 
+      (vector-set! strings i (random-string-1)))
+    (let ((str-hash (make-hash-table size string=?)))
+      (do ((i 0 (+ i 1))) 
+	  ((= i size)) 
+	(hash-table-set! str-hash (vector-ref strings i) i))
+      (do ((i 0 (+ i 1))) 
+	  ((= i size)) 
+	(unless (hash-table-ref str-hash (vector-ref strings i))
+	  (display "oops")))
+      (set! str-hash #f))))
+
+;; tmisc.scm has hash-table + typers
+
+(define (test-hash size)
+  (format *stderr* "~D " size)
+  (set! symbols (make-vector size))
+  (set! strings (make-vector size))
+  (test1 size)
+  (test2 size)
+  (test3 size)
+  (test4 size)
+  (test5 size)
+  (test6 size)
+  (test7 size)
+  (test8 size)
+  (test9 size)
+  (test10 size)
+  (test11 size)
+  (test12 size)
+  (test13 size)
+  (test14 size))
+
+(for-each test-hash (list 1 10 100 1000 10000 100000 1000000))
+(newline)
+
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(exit)
diff --git a/s7/tools/thook.scm b/s7/tools/thook.scm
new file mode 100644
index 0000000..4f0048c
--- /dev/null
+++ b/s7/tools/thook.scm
@@ -0,0 +1,195 @@
+;;; simple hook timing tests
+
+(let ((H (make-hook 'x)))
+  
+  (set! (hook-functions H)
+	(list (lambda (h)
+		(if (not (let? h))
+		    (display h)))
+	      (lambda (h)
+		(unless (let? h) 
+		  (newline)))))
+  
+  (define (thook)
+    (do ((i 0 (+ i 1)))
+	((= i 1000))
+      (H i)))
+  
+  (H 32)
+  (thook)
+  
+  (set! (car (hook-functions H))
+	(lambda (h)
+	  (let-ref h 'result)))
+  
+  (H 32)
+  (thook)
+  
+  (set! (hook-functions H) (cdr (hook-functions H)))
+  
+  (H 32)
+  (thook))
+
+
+;;; --------------------------------
+
+(let* ((size 100000)
+       (v (make-vector size)))
+  (define (tmake)
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (let ((j i))
+	(set! (v i) (make-hook 'x 'y))
+	(set! (hook-functions (v i)) 
+	      (list (lambda (h) 
+		      (let-set! h 'result j)))))))
+  
+  (define (trun)
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (unless (= ((v i) 0) i)
+	(format *stderr* "~D: ~D~%" i ((v i) 0)))
+      (let ((j i))
+	(set! (hook-functions (v i)) 
+	      (list (car (hook-functions (v i)))
+		    (lambda (h) 
+		      (let-set! h 'result (+ (let-ref h 'result) j))))))))
+  
+  (define (trun1)
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (unless (= ((v i) 0) (* 2 i))
+	(format *stderr* "~D: ~D~%" i ((v i) 0)))))
+  
+  
+  (tmake)
+  (trun)
+  (trun1))
+
+
+;;; --------------------------------
+(let ((hook-result #f))
+  (let-temporarily (((hook-functions *unbound-variable-hook*) ; variable
+		     (list (lambda (hook)
+			     (set! hook-result (let-ref hook 'variable))))))
+    (define (f)
+      (do ((i 0 (+ i 1)))
+	  ((= i 1000))
+	(let ((val (catch #t (lambda () (+ 1 _an_undefined_variable_i_hope_)) (lambda (type info) type))))
+	  (unless (eq? hook-result '_an_undefined_variable_i_hope_)
+	    (format *stderr* "unbound variable hook: ~S~%" val)))))
+  (f)
+  (f)))
+
+(let-temporarily (((hook-functions *missing-close-paren-hook*) ; no locals
+		   (list (lambda (h) 
+			   (let-set! h 'result 'incomplete-expr)))))
+  (define (f)
+    (do ((i 0 (+ i 1)))
+	((= i 1000))
+      (let ((val (catch #t (lambda () (eval-string "(+ 1 2")) (lambda args (car args)))))
+	(unless (eq? val 'incomplete-expr)
+	  (format *stderr* "missing close paren hook: ~S~%" val)))))
+  (f)
+  (f))
+
+(let ((hook-result #f))
+  (let-temporarily (((hook-functions *load-hook*) ; name
+		     (list (lambda (hook)
+			     (set! hook-result (let-ref hook 'name))))))
+    (with-output-to-file "load-hook-test.scm"
+      (lambda ()
+	(format #t "(define (load-hook-test val) (+ val 1))")))
+    (define (f)
+      (do ((i 0 (+ i 1)))
+	  ((= i 1000))
+	(load "load-hook-test.scm")
+	(unless (equal? hook-result "load-hook-test.scm")
+	  (format *stderr* "load hook: ~S~%" hook-result))))
+    (f)
+    (f)))
+
+(let ((hook-type #f)
+      (hook-data #f))
+    (define (f)
+      (do ((i 0 (+ i 1)))
+	  ((= i 1000))
+	(catch #t (lambda () 
+		    (let-temporarily (((hook-functions *error-hook*) ; type data -- why does this have to be in the catch?
+				       (list (lambda (hook)
+					       (set! hook-type (let-ref hook 'type))
+					       (set! hook-data (apply format #f (let-ref hook 'data)))))))
+		      (+ 1 #())))
+	       (lambda (type info)
+		 'error))
+	(unless (and (eq? hook-type 'wrong-type-arg)
+		     (equal? hook-data "+ second argument, #(), is a vector but should be a number"))
+	  (format *stderr* "error-hook: ~S ~S~%" hook-type hook-data))))
+    (f)
+    (f))
+
+
+(let ((hook-type #f)
+      (hook-data #f))
+  (define (f)
+    (do ((i 0 (+ i 1)))
+	((= i 1000))
+      (catch #t ; why can't this be 'read-error?
+	(lambda () 
+	  (let-temporarily (((hook-functions *read-error-hook*)
+			     (list (lambda (hook)
+				     (set! hook-type (hook 'type)) 
+				     ;; why isn't this 'read-error? #t=unknown_sharp_constant, #f=unknown_string_constant (read_string_constant)
+				     (set! hook-data (let-ref hook 'data))))))
+	    (eval-string "(+ 1 #T)")))
+	(lambda (type info)
+	  'error))
+      (unless (and (eq? hook-type #t)
+		   (string=? hook-data "T"))
+	(format *stderr* "error-hook: ~S ~S~%" hook-type hook-data))))
+  (f)
+  (f))
+
+;;; --------------------------------
+
+
+(let ((H3 (make-hook 'x '(y 32))))
+  
+  (set! (hook-functions H3)
+	(list (lambda (h)
+		(let-set! h 'result ((let-ref h 'x) (let-ref h 'y))))))
+  
+  (unless (= (H3 (lambda (y) (+ y 1))) 33) 
+    (format *stderr* "H3: ~S~%" (H3 (lambda (y) (+ y 1)))))
+  
+  (define H4 (make-hook 'z))
+  
+  (set! (hook-functions H4)
+	(list (lambda (h)
+		(let-set! h 'result (+ (let-ref h 'z) (H3 (lambda (y) (+ y 1))))))))
+  
+  (unless (= (H4 12) 45)
+    (format *stderr* "H4: ~S~%" (H4 12)))
+  
+  (define H5 (make-hook))
+  
+  (set! (hook-functions H5)
+	(list (lambda (h)
+		(let-set! h 'result 100))
+	      (lambda (h)
+		(let-set! h 'result
+		      (+ (sqrt (let-ref h 'result))
+			 (H4 12))))))
+  
+  (define (f)
+    (do ((i 0 (+ i 1)))
+	((= i 100000))
+      (unless (= (H5) 55)
+	(format *stderr* "H5: ~S~%" (H5)))))
+  (f)
+  (f))
+
+
+
+
+(exit)
diff --git a/s7/tools/timp.scm b/s7/tools/timp.scm
new file mode 100644
index 0000000..d97a576
--- /dev/null
+++ b/s7/tools/timp.scm
@@ -0,0 +1,887 @@
+;;; implicit ref/set -- tmisc.scm and tread.scm also have some
+
+(set! (*s7* 'heap-size) 1024000)
+(load "s7test-block.so" (sublet (curlet) (cons 'init_func 'block_init)))
+
+(define size 50000)
+
+(define (s1 obj val)
+  (set! (obj 'a) val))
+
+(define (s11 obj val)
+  (set! ((obj 'b) 'a) val))
+
+(define (s111 obj val)
+  (set! (obj 'b 'a) val))
+
+(define (s1111 obj sym val)
+  (set! (obj 'b sym) val))
+
+(define (s11111 obj sym val)
+  (set! (obj 'b (car sym)) val))
+
+
+(define (s2 obj val)
+  (set! (obj 'a) (+ (log 4 2) val)))
+
+(define (s22 obj val)
+  (set! ((obj 'b) 'a) (+ (log 4 2) val)))
+
+(define (s222 obj val)
+  (set! (obj 'b 'a) (+ (log 4 2) val)))
+
+(define (s2222 obj sym val)
+  (set! (obj 'b sym) (+ (log 4 2) val)))
+
+(define (s22222 obj sym val)
+  (set! (obj 'b (car sym)) (+ (log 4 2) val)))
+
+
+(define (s3 obj val)
+  (set! (obj 'b :a) val))
+
+
+(define (s4 obj val)
+  (set! (obj 'b 1) val))
+
+(define (s44 obj val)
+  (set! (obj 'b (- (log 4 2) 1)) val))
+
+(define (s444 obj val)
+  (set! (obj 'b 1) (car val)))
+
+(define (s4444 obj ind val)
+  (set! (obj 'b ind) val))
+
+
+(define (s5 obj val)
+  (set! (obj 0 1) val))
+
+(define (s55 obj val)
+  (set! (obj 0 (- (log 4 2) 1)) val))
+
+(define (s555 obj val)
+  (set! (obj 0 1) (car val)))
+
+(define (s5555 obj ind val)
+  (set! (obj 0 ind) val))
+
+
+(define (s6 obj val)
+  (set! (((obj 'b) 'b) 'a) val))
+
+(define (s66 obj val)
+  (set! (((obj 'b) 'b) 'a) val))
+
+(define (s666 obj val)
+  (set! (obj 'b 'b 'a) val))
+
+(define (s6666 obj val)
+  (set! ((obj 'b) 'b 'a) val))
+
+
+(define (s7 obj val)
+  (set! (list-ref (obj 0) 0) val))
+
+(define (s77 obj i1 i2 val)
+  (set! (list-ref (obj i1) i2) val))
+
+(define (s777 obj val)
+  (set! ((obj 0)) 32))
+
+
+(define (s8 obj val)
+  (set! (obj 0) val))
+
+(define (s88 obj ind val)
+  (set! (obj ind) val))
+
+(define (s888 obj ind val)
+  (set! (obj ind) (integer->char val)))
+
+(define (s8888 obj ind val)
+  (set! (obj (+ ind 1)) (integer->char val)))
+
+(define (stest)
+  (let ((table (hash-table 'a 1 'b (hash-table 'a 3)))
+	(table1 (hash-table 'b "12345"))
+	(table2 (vector (vector 1 2 3)))
+	(table3 (hash-table 'b (block 1 2 3)))
+	;; (table4 (hash-table 'b (let ((x (vector 1 2 3))) (dilambda (lambda (ind) (x ind)) (lambda (ind val) (set! (x ind) val))))))
+	(table5 (hash-table 'a 1 'b (hash-table 'a 3 'b (hash-table 'a 4))))
+	(table6 (vector (list 0 1) (list 2 3)))
+	(env (inlet 'a 1 'b (inlet 'a 4)))
+	(lst (list 0 1))
+	(lst1 (list dilambda_test)) ; from s7test-block
+	(lst2 (list (list 0 1)))
+	(str "0123456789")
+	(one 1))
+
+    (do ((i 0 (+ i 1)))
+	((= i size))
+
+      (s1 table 12)
+      (unless (= (table 'a) 12) (format *stderr* "[1]"))
+      (s11 table 12)
+      (unless (= ((table 'b) 'a) 12) (format *stderr* "[2]"))
+      (s111 table 12)
+      (unless (= (table 'b 'a) 12) (format *stderr* "[3]"))
+      (s1111 table 'a 12)
+      (unless (= (table 'b 'a) 12) (format *stderr* "[4]"))
+      (s11111 table '(a) 12)
+      (unless (= (table 'b 'a) 12) (format *stderr* "[5]"))
+
+      (s1 env 12)
+      (s11 env 12)
+      (s111 env 12)
+      (s1111 env 'a 12)
+      (s11111 env '(a) 12)
+
+      (s2 table 12)
+      (unless (= (table 'a) 14) (format *stderr* "[6]"))
+      (s22 table 12)
+      (unless (= ((table 'b) 'a) 14) (format *stderr* "[7]"))
+      (s222 table 12)
+      (unless (= (table 'b 'a) 14) (format *stderr* "[8]"))
+      (s2222 table 'a 12)
+      (unless (= (table 'b 'a) 14) (format *stderr* "[9]"))
+      (s22222 table '(a) 12)
+      (unless (= (table 'b 'a) 14) (format *stderr* "[10]"))
+
+      (s2 env 12)
+      (s22 env 12)
+      (s222 env 12)
+      (s2222 env 'a 12)
+      (s22222 env '(a) 12)
+
+      (s3 env 32)
+      (unless (= (env 'b 'a) 32) (format *stderr* "[11]"))
+
+      (s4 table1 #\a) ; set_implicit_string
+      (unless (char=? (table1 'b 1) #\a) (format *stderr* "[12]"))
+      (s44 table1 #\a)
+      (unless (char=? (table1 'b 1) #\a) (format *stderr* "[13]"))
+      (s444 table1 '(#\a))
+      (unless (char=? (table1 'b 1) #\a) (format *stderr* "[14]"))
+      (s4444 table1 1 #\a)
+      (unless (char=? (table1 'b 1) #\a) (format *stderr* "[15]"))
+
+      (s4 table3 23.0) ; set_implicit_c_object
+      (unless (= (table3 'b 1) 23.0) (format *stderr* "[16]"))
+      (s44 table3 23.0)
+      (unless (= (table3 'b 1) 23.0) (format *stderr* "[17]"))
+      (s444 table3 '(23.0))
+      (unless (= (table3 'b 1) 23.0) (format *stderr* "[18]"))
+      (s4444 table3 1 23.0)
+      (unless (= (table3 'b 1) 23.0) (format *stderr* "[19]"))
+
+;      (s4 table4 23.0) ; set_implicit_closure -- now an error
+;      (unless (= (table4 'b 1) 23.0) (format *stderr* "[20]"))
+;      (s44 table4 23.0)
+;      (unless (= (table4 'b 1) 23.0) (format *stderr* "[21]"))
+;      (s444 table4 '(23.0))
+;      (unless (= (table4 'b 1) 23.0) (format *stderr* "[22]"))
+;      (s4444 table4 1 23.0)
+;      (unless (= (table4 'b 1) 23.0) (format *stderr* "[23]"))
+
+      (s5 table2 #\a) ; set_implicit_vector
+      (unless (char=? (table2 0 1) #\a) (format *stderr* "[24]"))
+      (s55 table2 #\a)
+      (unless (char=? (table2 0 1) #\a) (format *stderr* "[25]"))
+      (s555 table2 '(#\a))
+      (unless (char=? (table2 0 1) #\a) (format *stderr* "[26]"))
+      (s5555 table2 1 #\a)
+      (unless (char=? (table2 0 1) #\a) (format *stderr* "[27]"))
+
+      (s6 table5 12)
+      (unless (= (((table5 'b) 'b) 'a) 12) (format *stderr* "[28]"))
+      (s66 table5 12)
+      (unless (= ((table5 'b) 'b 'a) 12) (format *stderr* "[29]"))
+      (s666 table5 12)
+      (unless (= (table5 'b 'b 'a) 12) (format *stderr* "[30]"))
+      (s6666 table5 12)
+      (unless (= (table5 'b 'b 'a) 12) (format *stderr* "[31]"))
+
+      (s7 table6 12)
+      (unless (= (table6 0 0) 12) (format *stderr* "[32]"))
+      (s77 table6 0 1 12)
+      (unless (= (table6 0 1) 12) (format *stderr* "[33]"))
+      (s777 lst1 12)
+
+      (s5 lst2 32)
+      (unless (= (cadar lst2) 32) (format *stderr* "[34]"))
+      (s55 lst2 12)
+      (unless (= (cadar lst2) 12) (format *stderr* "[35]"))
+      (s555 lst2 '(15))
+      (unless (= (cadar lst2) 15) (format *stderr* "[36]"))
+      (s5555 lst2 1 3)
+      (unless (= (cadar lst2) 3) (format *stderr* "[37]"))
+
+      (s8 str #\a)
+      (unless (char=? (str 0) #\a) (format *stderr* "[38]"))
+      (s88 str 1 #\b)
+      (unless (char=? (str one) #\b) (format *stderr* "[39]"))
+      (s888 str 2 (char->integer #\c))
+      (unless (char=? (str (+ one 1)) #\c) (format *stderr* "[40]"))
+      (s8888 str 2 (char->integer #\d))
+      (unless (char=? (str 3) #\d) (format *stderr* "[41]"))
+      (unless (string=? str "abcd456789") (format *stderr* "[42]"))
+
+      )))
+
+(stest)
+
+
+(define len 1000000)
+
+(define H (hash-table 'abs *))
+(define (fabsH x)
+  ((H 'abs) x 0.0001))
+
+(define (f6) ; [719] -> [515 if func_one_arg handles hash] -> [508]
+  (let ((sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i len) sum)
+      (set! sum (+ sum (fabsH i))))))
+
+;(f6)
+
+
+(define P (list + * -))
+(define (fabsP x)
+  ((P 1) x 0.0001))
+
+(define (f8) ; [700] -> [524 fx_implicit]
+  (let ((sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i len) sum)
+      (set! sum (+ sum (fabsP i))))))
+
+;(f8)
+
+
+(define V (vector + * -))
+(define (fabsV x)
+  ((V 1) x 0.0001))
+
+(define (f9) ; [685] -> [512 fx_implicit]
+  (let ((sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i len) sum)
+      (set! sum (+ sum (fabsV i))))))
+
+;(f9)
+
+
+(define C (make-cycle *))
+(define (fabsC x)
+  ((C) x 0.0001))
+
+(define (f10) ; [681] (there is no op_implicit_c_object_ref)
+  (let ((sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i len) sum)
+      (set! sum (+ sum (fabsC i))))))
+
+;(f10)
+
+
+;;; implicit arg cases (also included elsewhere)
+(define B (block .001 .0001 .00001)) ; C-object as arg
+(define (fabsB x)
+  (* x (B 1)))
+
+(define (f11) ; [591] no fx_*_ref?? block_ref_p_pp -> [519] fx_implicit_c_object_ref_a -- why not opt?
+  (let ((sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i len) sum)
+      (set! sum (+ sum (fabsB i))))))
+
+;(f11)
+
+
+(define P2 (list (list + * -) (list .001 .0001 .00001)))
+(define (fabsP2 x)
+  ((P2 0 1) x 0.0001))
+
+(define (f12) ; [797]
+  (let ((sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i len) sum)
+      (set! sum (+ sum (fabsP2 i))))))
+
+;(f12)
+
+
+(define V2 #2d((#_+ #_* #_-) (.001 .0001 .00001)))
+(define (fabsV2 x)
+  ((V2 0 1) x 0.0001))
+
+(define (f13) ; [778]
+  (let ((sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i len) sum)
+      (set! sum (+ sum (fabsV2 i))))))
+
+;(f13)
+
+
+(define (f14) ; [492]
+  (let ((sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i len) sum)
+      (set! sum (+ sum (* i (P2 1 1)))))))
+
+;(f14)
+
+
+(define (f15) ; [185] -- [738] if (vector (vector ...))
+  (let ((sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i len) sum)
+      (set! sum (+ sum (* i (V2 1 1)))))))
+
+;(f15)
+
+
+(define H2 (hash-table 'a .0001))
+(define (f16) ; [169] -- this is fully optimized!? -> [160] p_pp_sf_href!
+  (let ((sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i len) sum)
+      (set! sum (+ sum (* i (H2 'a)))))))
+
+;(f16)
+
+
+(define L2 (inlet 'a .0001))
+(define (f17) ; [173] (no lref) -> [167] lref -> [131 slot_ref]
+  (let ((sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i len) sum)
+      (set! sum (+ sum (* i (L2 'a)))))))
+
+;(f17)
+
+
+(define V3 (vector .0001))
+(define (f18) ; [148] (opt_p_pi_sc(t_vector_ref_p_pi_unchecked))
+  (let ((sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i len) sum)
+      (set! sum (+ sum (* i (V3 0)))))))
+
+;(f18)
+
+
+(define P3 (list .0001))
+(define (f19) ; [157] opt_p_pi_sc(list_ref_p_pi_unchecked)
+  (let ((sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i len) sum)
+      (set! sum (+ sum (* i (P3 0)))))))
+
+;(f19)
+
+
+(define B3 (block .0001))
+(define (f20) ; [114] d_7pi_sf(block_ref_d_7pi)
+  (let ((sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i len) sum)
+      (set! sum (+ sum (* i (B3 0)))))))
+
+;(f20)
+
+
+(define V4 #2d((.0001)))
+(define (f21) ; [185] opt_p_pii_sff(vector_ref_p_pii_direct)
+  (let ((sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i len) sum)
+      (set! sum (+ sum (* i (V4 0 0)))))))
+
+;(f21)
+
+
+;;; let cases
+(define L (inlet 'abs *))
+(define L_abs (L 'abs))
+
+(define (fabs x)
+  ((L 'abs) x 0.0001))
+  ;((if (integer? x) * /) x 0.0001))
+
+(define (fLabs x)
+  (L_abs x 0.0001))
+
+(define (frefabs x)
+  ((let-ref L 'abs) x 0.0001))
+
+
+(define (f1) ; [729] -> [507 fx_implicit_let_ref_c]
+  (let ((sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i len) sum)
+      (set! sum (+ sum (fabs i))))))
+
+;(f1)
+
+
+(define (f2) ; [298]
+  (let ((sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i len) sum)
+      (set! sum (+ sum (fLabs i))))))
+
+;(f2)
+
+
+(define (f3) ; [510]
+  (let ((sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i len) sum)
+      (set! sum (+ sum (frefabs i))))))
+
+;(f3)
+
+
+(define f4 ; [559]
+  (let ((L (openlet (inlet '+ (lambda (arg obj)
+				(#_+ arg (obj 'value)))
+			   'value 3))))
+    (lambda ()
+      (do ((i 0 (+ i 1)))
+	  ((= i len) (+ 1 L 2))
+	(unless (= (+ 1 L 2) 6) ; g_add_3 -> add_p_ppp -> 2 add_p_pp with a method call
+	  (display "f4 oops\n"))))))
+
+;(f4)
+
+
+(define (fabsL x)
+  ((L 'abs) x 0.0001))
+
+(define (f5) ; [512, 723 if set L to H in the loop, 693 if int *??] -> [503?]
+  (let ((sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i len) sum)
+      (set! sum (+ sum (fabsL i))))))
+
+;(f5)
+
+
+(define (fabs:L x)
+  ((L :abs) x 0.0001))
+
+(define (f22) ; [721] -> [504] (added keyword check)
+  (let ((sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i len) sum)
+      (set! sum (+ sum (fabs:L i))))))
+
+;(f22)
+
+
+(define size 1000000)
+
+(define (f23) ; [134] opt'd
+  (let ((sum 0.0)
+	(L (inlet 'multiply  *)))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (set! sum (+ sum ((let-ref L 'multiply) i 0.0001))))))
+
+;(display "f23 ") (display (f23)) (newline)
+
+
+(define (f24) ; [605] -> [134 opt'd]
+  (let ((sum 0.0)
+	(L (inlet 'multiply  *)))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (set! sum (+ sum ((L 'multiply) i 0.0001))))))
+
+;(display "f24 ") (display (f24)) (newline)
+
+
+; check if (L 'multiply) is changed opt process is not used (fx):
+
+(define (f24a) ; [690]
+  (let ((sum 0.0)
+	(L (inlet 'multiply  *))
+	(H (hash-table 'multiply +)))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (set! sum (+ sum ((L 'multiply) i 0.0001)))
+      (set! L H)))) ; apparently this blocks the optimizer -> op_x_aa etc
+
+;(display "f24a ") (display (f24a)) (newline)
+
+
+(define (f24b) ; [577]
+  (let ((sum 0.0)
+	(L (inlet 'multiply  *))
+	(L1 (inlet 'multiply  +)))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (set! sum (+ sum ((L 'multiply) i 0.0001)))
+      (set! L L1)))) ; same as above
+
+;(display "f24b ") (display (f24b)) (newline)
+
+
+(define (setL L)
+  (set! (L 'multiply) floor))
+
+(define (f24c-1) ; floor: too many arguments
+  (let ((sum 0.0)
+	(L (inlet 'multiply  *)))
+    (do ((i 0 (+ i 1)))
+	((= i 3) sum)
+      (set! sum (+ sum ((L 'multiply) i 0.0001)))
+      (setL L))))
+
+(define (f24c) (catch #t f24c-1 (lambda args 'error)))
+;(display "f24c ") (display (catch #t f24c-1 (lambda args 'error))) (newline)
+
+
+(define (f24d-1) ; same error as above
+  (let ((sum 0.0)
+	(L (inlet 'multiply  *)))
+    (do ((i 0 (+ i 1)))
+	((= i 3) sum)
+      (set! sum (+ sum ((L 'multiply) i 0.0001)))
+      (let-set! L 'multiply floor))))
+
+(define (f24d) (catch #t f24d-1 (lambda args 'error)))
+;(display "f24d ") (display (catch #t f24d-1 (lambda args 'error))) (newline)
+
+
+(define (f25) ; [638]
+  (let ((sum 0.0)
+	(L (inlet 'multiply  *)))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (set! sum (+ sum ((L 'multiply) i 0.0001)))
+      (let-set! L 'multiply +))))
+
+;(display "f25 ") (display (f25)) (newline)
+
+#|
+224,053,076  s7.c:eval.isra.0 [/home/bil/motif-snd/repl]  fx_c_scs = 125, op_x_aa = 188
+ 74,000,000  s7.c:fx_c_scs [/home/bil/motif-snd/repl]     let_set 60
+ 59,000,225  s7.c:add_p_pp [/home/bil/motif-snd/repl]
+ 47,999,952  s7.c:fx_implicit_let_ref_c [/home/bil/motif-snd/repl]
+ 46,999,953  s7.c:op_x_aa [/home/bil/motif-snd/repl]      implicit_let_ref aa="i 0.0001"
+ 27,000,000  s7.c:let_set_1 [/home/bil/motif-snd/repl]
+ 24,950,959  s7.c:g_add_x1 [/home/bil/motif-snd/repl]
+ 21,606,113  s7.c:gc.isra.0 [/home/bil/motif-snd/repl]
+ 21,000,687  /usr/include/x86_64-linux-gnu/bits/string_fortified.h:eval.isra.0
+ 19,999,980  s7.c:g_add [/home/bil/motif-snd/repl]
+ 16,000,016  s7.c:g_num_eq_2 [/home/bil/motif-snd/repl]
+ 13,000,000  s7.c:let_ref_p_pp [/home/bil/motif-snd/repl]
+|#
+
+
+(require libm.scm)
+
+(define (f26) ; if s7 sqrt via *libc**(!! sqrt_p_p) [195] sqrt=30 gc=30, via *libm*: [246] sqrt=43 (s7__sqrt)+21 overhead, gc=30
+  (let ((sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (set! sum (+ sum ((*libm* 'sqrt) (* 1.0 i)))))))
+
+;(display "f26 ") (display (f26)) (newline)
+
+
+(define (f27) ; [268]
+  (let ((sum 0.0)
+	(L3 (inlet 'x 1.0)))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (set! sum (+ sum (L3 'x)))
+      (set! (L3 'x) (* (L3 'x) 0.9999)))))
+
+;(display "f27 ") (display (f27)) (newline)   ; 9999.999999994685
+
+;;; (- 3.701520785793392e-44 (expt 0.9999 1000000)) 4.978412222288913e-59
+
+#|
+38,942,875  s7.c:opt_dotimes [/home/bil/motif-snd/repl]
+30,000,000  s7.c:opt_p_pp_sf_lref [/home/bil/motif-snd/repl]
+29,000,000  s7.c:opt_p_ppp_sff [/home/bil/motif-snd/repl]
+28,000,144  s7.c:add_p_pp [/home/bil/motif-snd/repl]
+26,000,160  s7.c:multiply_p_pp [/home/bil/motif-snd/repl]
+26,000,000  s7.c:let_set_1 [/home/bil/motif-snd/repl]            this could be simpler (key check, rootlet/unlet, slot search (save), slot setter in checked_slot_set)
+21,689,904  s7.c:gc.isra.0 [/home/bil/motif-snd/repl]
+18,000,044  s7.c:let_ref_p_pp [/home/bil/motif-snd/repl]
+17,000,000  s7.c:opt_p_pp_fc [/home/bil/motif-snd/repl]
+11,000,000  s7.c:opt_p_pp_sf_add [/home/bil/motif-snd/repl]
+ 9,000,000  s7.c:opt_p_c [/home/bil/motif-snd/repl]              'x in the let-refs, opt_p_pp_sf_lref [build this in], save slot for let-ref too
+ 9,000,000  s7.c:opt_set_p_p_f [/home/bil/motif-snd/repl]
+|#
+
+(define (f28) ; [86 via opt_p_pp_sc_slot_ref]
+  (let ((sum 0.0)
+	(L3 (inlet 'x 1.0)))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (set! sum (+ sum (let-ref L3 'x))))))
+
+;(display "f28 ") (display (f28)) (newline)
+
+
+(define (f29) ; [267 unopt'd except for fx*]
+  (let ((sum 0.0)
+	(L5 (inlet 'x 0.1))
+	(L3 (inlet 'x 1.0)))
+    (do ((i 0 (+ i 1))
+	 (L4 L3 L5))
+	((= i size) sum)
+      (set! sum (+ sum (let-ref L4 'x))))))
+
+;(display "f29 ") (display (f29)) (newline)
+
+
+(define (f30) ; [642 eval/inlet_p_pp, gc etc, let_set_1 and let_ref]
+  (let ((sum 0.0)
+	(L3 (inlet 'x 1.0)))
+    (do ((i 0 (+ i 1))
+	 (L4 L3 (inlet 'x 0.1)))
+	((= i size) sum)
+      (set! (L4 'x) (* 2.0 (L4 'x))) ; make sure it's a new inlet on each iteration
+      (set! sum (+ sum (let-ref L4 'x))))))
+
+;(display "f30 ") (display (f30)) (newline)
+
+
+(define (f31) ; [105 opt_p_pp_ss_lref let_ref_p_pp] -> [86 opt_p_pp_sc_slot_ref]
+  (let ((sum 0.0)
+	(L3 (inlet 'x 1.0)))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (set! sum (+ sum (let-ref L3 :x))))))
+
+;(display "f31 ") (display (f31)) (newline)
+
+
+(define (f32) ; [109 opt_p_pp_sf_lref let_ref_p_pp and opt_p_c for 'x (I assume)] -> [86 slot_ref]
+  (let ((sum 0.0)
+	(L3 (inlet 'x 1.0)))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (set! sum (+ sum (L3 'x))))))
+
+;(display "f32 ") (display (f32)) (newline)
+
+
+(define (f32a) ; [105] -> [86 slot_ref]
+  (let ((sum 0.0)
+	(L3 (inlet 'x 1.0)))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (set! sum (+ sum (L3 :x))))))
+
+;(display "f32a ") (display (f32a)) (newline)
+
+
+(define (f33) ; [410, 552 if varlet on every iteration, fx_implicit_let_ref_c]
+  (let ((sum 0.0)
+	(L3 (inlet 'x 1.0)))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (set! sum (+ sum (L3 'x)))
+      (when (= i 0) (varlet L3 'x 0.5)))))
+
+;(display "f33 ") (display (f33)) (newline)
+
+
+(define (f34) ; [123 let_set_1 from let_set] 64755 (let-set! L3 :x (+ (L3 'x) 1)) -> [82] slot_set and slot_ref
+  (let ((L3 (inlet 'x 0)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (L3 :x))
+      (let-set! L3 :x (+ (L3 'x) 1)))))
+
+;(display "f34 ") (display (f34)) (newline)
+
+#|
+29,000,026  s7.c:let_set_1 [/home/bil/motif-snd/repl]
+24,950,959  s7.c:g_add_xi [/home/bil/motif-snd/repl]
+19,000,000  s7.c:opt_p_ppp_ssf [/home/bil/motif-snd/repl]            let_set 64750 p_ppp_ok
+17,000,000  s7.c:opt_p_pi_fc [/home/bil/motif-snd/repl]
+ 8,000,008  s7.c:let_set [/home/bil/motif-snd/repl]
+ 7,000,094  s7.c:opt_dotimes [/home/bil/motif-snd/repl]
+ 6,924,479  s7.c:gc.isra.0 [/home/bil/motif-snd/repl]
+ 4,000,000  s7.c:opt_p_pp_sc_slot_ref [/home/bil/motif-snd/repl]     let-refs
+ 3,000,000  s7.c:add_p_pi [/home/bil/motif-snd/repl]
+
+  to:
+
+24,950,959  s7.c:g_add_xi [/home/bil/motif-snd/repl]
+17,000,000  s7.c:opt_p_pi_fc [/home/bil/motif-snd/repl]
+15,000,000  s7.c:opt_p_ppf_slot_set [/home/bil/motif-snd/repl]
+ 7,000,094  s7.c:opt_dotimes [/home/bil/motif-snd/repl]
+ 6,924,494  s7.c:gc.isra.0 [/home/bil/motif-snd/repl]
+ 4,000,000  s7.c:opt_p_pp_slot_ref [/home/bil/motif-snd/repl]
+ 3,000,000  s7.c:add_p_pi [/home/bil/motif-snd/repl]
+|#
+
+
+(define (f34a) ; [133] opt_p_ppp_sff -> let_set(_1) 64800 (let-set! L3 'x (+ (L3 'x) 1)) -> [82] as above
+  (let ((L3 (inlet 'x 1.0)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (L3 :x))
+      (let-set! L3 'x (+ (L3 'x) 1)))))
+
+;(display "f34a ") (display (f34a)) (newline)
+
+
+(define (f35) ; [141] -> [98]
+  (let ((L3 (inlet 'x 0)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (L3 :x))
+      (set! (L3 'x) (+ (L3 'x) 1)))))
+
+;(display "f35 ") (display (f35)) (newline)
+
+
+(define (f35a) ; [33] opt_p_pps_slot_set
+  (let ((L3 (inlet 'x 0)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (L3 :x))
+      (set! (L3 :x) i))))
+
+;(display "f35a ") (display (f35a)) (newline)
+
+
+(define (f35b) ; [66] -> [32] opt_p_ppc_slot_set -- twice as slow as f35i due to make_integer in opt_dotimes (set! is op_safe_do, let-set! is op_safe_dotimes in check_do)
+               ;      -> [14] if sequence allows op_safe_dotimes (set! (L :x) val) as opposed to (let-set! L :x val)
+               ;         but set! lacks has_fn and op_simple_do (the fallback) expects has_fn, so we lose
+  (let ((L3 (inlet 'x 0)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (L3 :x))
+      (set! (L3 :x) 0))))
+
+;(display "f35b ") (display (f35b)) (newline)
+
+
+(define (f35c) ; [98] opt_p_ppf_slot_set and opt_p_pp_slot_ref
+  (let ((L3 (inlet 'x 0)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (L3 :x))
+      (set! (L3 :x) (+ (L3 'x) 1)))))
+
+;(display "f35c ") (display (f35c)) (newline)
+
+
+(define (f35d) ; [61] 65890 -> [33] opt_p_pps_slot_set
+  (let ((L3 (inlet 'x 0)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (L3 :x))
+      (set! (L3 'x) i))))
+
+;(display "f35d ") (display (f35d)) (newline)
+
+
+(define (f35e) ; [45] ppf_slot_set -> [32] opt_p_ppc_slot_set
+  (let ((L3 (inlet 'x 0)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (L3 :x))
+      (set! (L3 'x) 0))))
+
+;(display "f35e ") (display (f35e)) (newline) ; 0
+
+
+(define (f35f) ; [63] -> [35] opt_p_pps_slot_set
+  (let ((L3 (inlet 'x 0)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (L3 :x))
+      (let-set! L3 'x i))))
+
+;(display "f35f ") (display (f35f)) (newline) ; 999999
+
+
+(define (f35g) ; [29] opt_p_ppf_slot_set + opt_p_c -> [16] opt_p_ppc_slot_set
+  (let ((L3 (inlet 'x 0)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (L3 :x))
+      (let-set! L3 'x 0))))
+
+;(display "f35g ") (display (f35g)) (newline) ; 0
+
+
+(define (f35h) ; [72] 64738 -> [35] opt_p_pps_slot_set
+  (let ((L3 (inlet 'x 0)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (L3 :x))
+      (let-set! L3 :x i))))
+
+;(display "f35h ") (display (f35h)) (newline) ; 999999
+
+
+(define (f35i) ; [58] opt_p_ppp_ssc + let_set_1 -> [16] opt_ppc_slot_set
+  (let ((L3 (inlet 'x 0)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (L3 :x))
+      (let-set! L3 :x 0))))
+
+;(display "f35i ") (display (f35i)) (newline)
+
+
+(define (test-all)
+  (unless (= (f1) 4.999994999999997e+7) (format *stderr* "f1 ~A\n" (f1)))
+  (unless (= (f2) 4.999994999999997e+7) (format *stderr* "f2 ~A\n" (f2)))
+  (unless (= (f3) 4.999994999999997e+7) (format *stderr* "f3 ~A\n" (f3)))
+  (unless (= (f4) 6) (format *stderr* "f4 ~A\n" (f4)))
+  (unless (= (f5) 4.999994999999997e+7) (format *stderr* "f5 ~A\n" (f5)))
+  (unless (= (f6) 4.999994999999997e+7) (format *stderr* "f6 ~A\n" (f6)))
+  (unless (= (f8) 4.999994999999997e+7) (format *stderr* "f8 ~A\n" (f8)))
+  (unless (= (f9) 4.999994999999997e+7) (format *stderr* "f9 ~A\n" (f9)))
+  (unless (= (f10) 4.999994999999997e+7) (format *stderr* "f10 ~A\n" (f10)))
+  (unless (= (f11) 4.999994999999997e+7) (format *stderr* "f11 ~A\n" (f11)))
+  (unless (= (f12) 4.999994999999997e+7) (format *stderr* "f12 ~A\n" (f12)))
+  (unless (= (f13) 4.999994999999997e+7) (format *stderr* "f13 ~A\n" (f13)))
+  (unless (= (f14) 4.999994999999997e+7) (format *stderr* "f14 ~A\n" (f14)))
+  (unless (= (f15) 4.999994999999997e+7) (format *stderr* "f15 ~A\n" (f15)))
+  (unless (= (f16) 4.999994999999997e+7) (format *stderr* "f16 ~A\n" (f16)))
+  (unless (= (f17) 4.999994999999997e+7) (format *stderr* "f17 ~A\n" (f17)))
+  (unless (= (f18) 4.999994999999997e+7) (format *stderr* "f18 ~A\n" (f18)))
+  (unless (= (f19) 4.999994999999997e+7) (format *stderr* "f19 ~A\n" (f19)))
+  (unless (= (f20) 4.999994999999997e+7) (format *stderr* "f20 ~A\n" (f20)))
+  (unless (= (f21) 4.999994999999997e+7) (format *stderr* "f21 ~A\n" (f21)))
+  (unless (= (f22) 4.999994999999997e+7) (format *stderr* "f22 ~A\n" (f22)))
+
+  (unless (equal? (f23) 4.999994999999997e+7) (display "f23: ") (display (f23)) (newline))
+  (unless (equal? (f24) 4.999994999999997e+7) (display "f24: ") (display (f24)) (newline))
+  (unless (equal? (f24a) 499999500104.7288) (display "f24a: ") (display (f24a)) (newline))
+  (unless (equal? (f24b) 499999500104.7288) (display "f24b: ") (display (f24b)) (newline))
+  (unless (equal? (f24c) 'error) (display "f24c: ") (display (f24c)) (newline))
+  (unless (equal? (f24d) 'error) (display "f24d: ") (display (f24d)) (newline))
+  (unless (equal? (f25) 499999500104.7288) (display "f25: ") (display (f25)) (newline))
+  (unless (equal? (f26) 6.666661664588418e+8) (display "f26: ") (display (f26)) (newline))
+  (unless (equal? (f27) 9999.999999994685) (display "f27: ") (display (f27)) (newline))
+  (unless (equal? (f28) 1000000.0) (display "f28: ") (display (f28)) (newline))
+  (unless (equal? (f29) 1.0000090000133294e+5) (display "f29: ") (display (f29)) (newline))
+  (unless (equal? (f30) 2.0000180000266587e+5) (display "f30: ") (display (f30)) (newline))
+  (unless (equal? (f31) 1000000.0) (display "f31: ") (display (f31)) (newline))
+  (unless (equal? (f32) 1000000.0) (display "f32: ") (display (f32)) (newline))
+  (unless (equal? (f32a) 1000000.0) (display "f32a: ") (display (f32a)) (newline))
+  (unless (equal? (f33) 500000.5) (display "f33: ") (display (f33)) (newline))
+  (unless (equal? (f34) 1000000) (display "f34: ") (display (f34)) (newline))
+  (unless (equal? (f34a) 1000001.0) (display "f34a: ") (display (f34a)) (newline))
+  (unless (equal? (f35) 1000000) (display "f35: ") (display (f35)) (newline))
+  (unless (equal? (f35a) 999999) (display "f35a: ") (display (f35a)) (newline))
+  (unless (equal? (f35b) 0) (display "f35b: ") (display (f35b)) (newline))
+  (unless (equal? (f35c) 1000000) (display "f35c: ") (display (f35c)) (newline))
+  (unless (equal? (f35d) 999999) (display "f35d: ") (display (f35d)) (newline))
+  (unless (equal? (f35e) 0) (display "f35e: ") (display (f35e)) (newline))
+  (unless (equal? (f35f) 999999) (display "f35f: ") (display (f35f)) (newline))
+  (unless (equal? (f35g) 0) (display "f35g: ") (display (f35g)) (newline))
+  (unless (equal? (f35h) 999999) (display "f35h: ") (display (f35h)) (newline))
+  (unless (equal? (f35i) 0) (display "f35i: ") (display (f35i)) (newline))
+)
+
+(test-all)
+
+(exit)
diff --git a/s7/tools/tio.scm b/s7/tools/tio.scm
new file mode 100644
index 0000000..e104e8b
--- /dev/null
+++ b/s7/tools/tio.scm
@@ -0,0 +1,358 @@
+(set! (*s7* 'heap-size) 128000)
+
+(define fsize 100000)
+(define ssize 500000)
+(define ssize/2 250000)
+
+(if (or (> (*s7* 'major-version) 10) 
+	(and (= (*s7* 'major-version) 10) (>= (*s7* 'minor-version) 9)))
+    (begin
+      (define (call-new-wis)
+	(let ((p (open-input-string "asdf")))
+	  (do ((i 0 (+ i 1)))
+	      ((= i ssize/2))
+	    (set! (port-string p) "asdf")
+	    (unless (char=? (read-char p) #\a)
+	      (format *stderr* "read-char trouble\n"))
+	    (unless (char=? (read-char p) #\s)
+	      (format *stderr* "read-char trouble\n"))
+	    (unless (char=? (read-char p) #\d)
+	      (format *stderr* "read-char trouble\n")))
+	  (close-input-port p)))
+      
+      (define (call-new-cwis) 
+	(let ((p (open-input-string "asdf"))
+	      (a (char->integer #\a))
+	      (s (char->integer #\s)))
+	  (do ((i 0 (+ i 1)))
+	      ((= i ssize/2))
+	    (set! (port-string p) "asdf")
+	    (unless (= (read-byte p) a)
+	      (format *stderr* "call read-char trouble\n"))
+	    (unless (= (read-byte p) s)
+	      (format *stderr* "call read-char trouble\n"))
+	    (unless (= (port-position p) 2)
+	      (format *stderr* "cwis position: ~A~%" (port-position p))))
+	  (close-input-port p)))
+
+      ;; include the old cases
+      (define (wis)
+	(with-input-from-string "asdf"
+	  (lambda ()
+	    (unless (char=? (read-char) #\a)
+	      (format *stderr* "read-char trouble\n"))
+	    (unless (char=? (read-char) #\s)
+	      (format *stderr* "read-char trouble\n"))
+	    (unless (char=? (read-char (current-input-port)) #\d)
+	      (format *stderr* "current-input-port trouble\n")))))
+      
+      (define (call-wis) 
+	(do ((i 0 (+ i 1)))
+	    ((= i ssize/2))
+	  (wis)))
+      
+      (define cwis
+	(let ((a (char->integer #\a))
+	      (s (char->integer #\s)))
+	  (lambda ()
+	    (call-with-input-string "asdf"
+	      (lambda (p)
+		(if (port-closed? p)
+		    (format *stderr* "cwis port closed\n"))
+		(unless (= (read-byte p) a)
+		  (format *stderr* "call read-char trouble\n"))
+		(unless (= (read-byte p) s)
+		  (format *stderr* "call read-char trouble\n"))
+		(unless (= (port-position p) 2)
+		  (format *stderr* "cwis position: ~A~%" (port-position p))))))))
+      
+      (define (call-cwis) 
+	(do ((i 0 (+ i 1)))
+	    ((= i ssize/2))
+	  (cwis))))
+
+    (begin
+      (define (wis)
+	(with-input-from-string "asdf"
+	  (lambda ()
+	    (unless (char=? (read-char) #\a)
+	      (format *stderr* "read-char trouble\n"))
+	    (unless (char=? (read-char) #\s)
+	      (format *stderr* "read-char trouble\n"))
+	    (unless (char=? (read-char (current-input-port)) #\d)
+	      (format *stderr* "current-input-port trouble\n")))))
+      
+      (define (call-wis) 
+	(do ((i 0 (+ i 1)))
+	    ((= i ssize))
+	  (wis)))
+      
+      (define cwis
+	(let ((a (char->integer #\a))
+	      (s (char->integer #\s)))
+	  (lambda ()
+	    (call-with-input-string "asdf"
+	      (lambda (p)
+		(if (port-closed? p)
+		    (format *stderr* "cwis port closed\n"))
+		(unless (= (read-byte p) a)
+		  (format *stderr* "call read-char trouble\n"))
+		(unless (= (read-byte p) s)
+		  (format *stderr* "call read-char trouble\n"))
+		(unless (= (port-position p) 2)
+		  (format *stderr* "cwis position: ~A~%" (port-position p))))))))
+      
+      (define (call-cwis) 
+	(do ((i 0 (+ i 1)))
+	    ((= i ssize))
+	  (cwis)))))
+
+(define (wif)
+  (with-input-from-file "t923.scm"
+    (lambda ()
+      (unless (string=? (read-line) "asdf")
+	(format *stderr* "file read-char trouble\n"))
+      (unless (eq? (read-line) #<eof>)
+	(format *stderr* "file read-line eof trouble\n")))))
+
+(define (call-wif) 
+  (do ((i 0 (+ i 1)))
+      ((= i fsize))
+    (wif)))
+
+(define (cwif)
+  (call-with-input-file "t923.scm"
+    (lambda (p)
+      (unless (string=? (port-filename p) "t923.scm")
+	(format *stderr* "cxif port filename: ~S~%" (port-filename p)))
+      (unless (string=? (read-string 5 p) "asdf\n")
+	(format *stderr* "file read-string trouble\n"))
+      (unless (eq? (read-string 1 p) #<eof>)
+	(format *stderr* "file read-string eof trouble\n")))))
+
+(define (call-cwif) 
+  (do ((i 0 (+ i 1)))
+      ((= i fsize))
+    (cwif)))
+
+
+(if (or (> (*s7* 'major-version) 10) 
+	(and (= (*s7* 'major-version) 10) (>= (*s7* 'minor-version) 9)))
+    (begin
+      (define (call-new-wos)
+	(let ((p (open-output-string)))
+	  (do ((i 0 (+ i 1)))
+	      ((= i ssize/2))
+	    (set! (port-string p) "ab")
+	    (unless (string=? (get-output-string p) "ab")
+	      (format *stderr* "write-char trouble\n")))
+	  (close-output-port p)))
+
+      (define (call-new-cwos)
+	(let ((p (open-output-string)))
+	  (do ((i 0 (+ i 1)))
+	      ((= i ssize/2))
+	    (set! (port-string p) "asdf")
+	    (unless (string=? (get-output-string p) "asdf")
+	      (format *stderr* "call write-string trouble\n")))))
+
+      (define (wos)
+	(with-output-to-string
+	  (lambda ()
+	    (write-char #\a)
+	    (write-char #\b)
+	    (flush-output-port (current-output-port))
+	    (unless (string=? (get-output-string (current-output-port)) "ab")
+	      (format *stderr* "write-char trouble\n")))))
+      
+      (define (call-wos) 
+	(do ((i 0 (+ i 1)))
+	    ((= i ssize/2))
+	  (wos)))
+      
+      (define (cwos)
+	(call-with-output-string
+	 (lambda (p)
+	   (write-string "asdf" p)
+	   (flush-output-port p)
+	   (unless (string=? (get-output-string p) "asdf")
+	     (format *stderr* "call write-string trouble\n")))))
+      
+      (define (call-cwos) 
+	(do ((i 0 (+ i 1)))
+	    ((= i ssize/2))
+	  (cwos))))
+    (begin
+      (define (wos)
+	(with-output-to-string
+	  (lambda ()
+	    (write-char #\a)
+	    (write-char #\b)
+	    (flush-output-port (current-output-port))
+	    (unless (string=? (get-output-string (current-output-port)) "ab")
+	      (format *stderr* "write-char trouble\n")))))
+      
+      (define (call-wos) 
+	(do ((i 0 (+ i 1)))
+	    ((= i ssize))
+	  (wos)))
+      
+      (define (cwos)
+	(call-with-output-string
+	 (lambda (p)
+	   (write-string "asdf" p)
+	   (flush-output-port p)
+	   (unless (string=? (get-output-string p) "asdf")
+	     (format *stderr* "call write-string trouble\n")))))
+      
+      (define (call-cwos) 
+	(do ((i 0 (+ i 1)))
+	    ((= i ssize))
+	  (cwos)))))
+
+(define (wof)
+  (with-output-to-file "/dev/null"
+    (lambda ()
+      (write-byte 100)
+      (write-byte 101))))
+
+(define (call-wof) 
+  (do ((i 0 (+ i 1)))
+      ((= i 10))
+    (wof)))
+
+(define (cwof)
+  (call-with-output-file "/dev/null"
+    (lambda (p)
+      (newline p))))
+
+(define (call-cwof) 
+  (do ((i 0 (+ i 1)))
+      ((= i 10))
+    (cwof)))
+
+(define (op1)
+  (let ((port (open-input-string "(+ 1 2)")))
+    (unless (input-port? port)
+      (format *stderr* "op1 trouble\n"))
+    (unless (char=? (peek-char port) #\()
+      (format *stderr "op1 peek-char trouble\n"))
+    (unless (equal? (read port) '(+ 1 2))
+      (format *stderr* "op1 trouble\n"))
+    (close-input-port port)))
+
+(define (call-op1) 
+  (do ((i 0 (+ i 1)))
+      ((= i ssize))
+    (op1)))
+
+(define (op2)
+  (let ((port (open-output-string)))
+    (unless (output-port? port)
+      (format *stderr* "op2 trouble\n"))
+    (display "(+ 1 2)" port)
+    (newline port)
+    (flush-output-port port)
+    (unless (string=? (get-output-string port) "(+ 1 2)\n")
+      (format *stderr* "op2 trouble: ~S\n" (get-output-string port)))
+    (close-output-port port)))
+
+(define (call-op2) 
+  (do ((i 0 (+ i 1)))
+      ((= i ssize))
+    (op2)))
+
+(define (op3)
+  (let ((port (open-input-file "t923.scm")))
+    (unless (char=? (peek-char port) #\a)
+      (format *stderr "op3 peek-char trouble\n"))
+    (unless (string=? (read-line port) "asdf")
+      (format *stderr* "op3 trouble\n"))
+    (unless (string=? (read-line port) "fdsa")
+      (format *stderr* "op3 2 trouble\n"))
+    (unless (= (port-position port) 10)
+      (format *stderr* "op3 pos: ~S~%" (port-position port)))
+    (unless (= (port-line-number port) 3) ; 1-based??
+      (format *stderr* "op3 line: ~S~%" (port-line-number port)))
+    (close-input-port port)))
+
+(define (call-op3) 
+  (do ((i 0 (+ i 1)))
+      ((= i fsize))
+    (op3)))
+
+(define (op4)
+  (let ((port (open-output-file "/dev/null")))
+    (write "asdf" port)
+    (close-output-port port)))
+
+(define (call-op4) 
+  (do ((i 0 (+ i 1)))
+      ((= i 10))
+    (op4)))
+
+#|
+(define (funcs)
+  (let ((ip (open-input-function
+	     (lambda (choice)
+	       (case choice
+		 ((read peek-char) #\?)
+		 ((char-ready?) #f)
+		 ((read-char) #\a)
+		 ((read-line) "a line"))))))
+    (unless (string=? (read-line ip) "a line")
+      (format *stderr* "input-function trouble\n"))
+    (close-input-port ip))
+  (let* ((str ())
+	 (op (open-output-function
+	      (lambda (c)
+		(set! str (cons c str))))))
+    (display #\a op)
+    (close-output-port op)
+    (unless (equal? str '(97))
+      (format *stderr* "output-function trouble: ~S\n" str))))
+
+(define (call-funcs) 
+  (do ((i 0 (+ i 1)))
+      ((= i fsize))
+    (funcs)))
+|#
+
+(call-with-output-file "t923.scm"
+  (lambda (p)
+    (display "asdf" p)
+    (newline p)))
+
+(call-wis)
+(call-cwis)
+(call-wif)
+(call-cwif)
+(call-wos)
+(call-cwos)
+(call-wof)
+(call-cwof)
+
+(when (or (> (*s7* 'major-version) 10) 
+	  (and (= (*s7* 'major-version) 10) (>= (*s7* 'minor-version) 9)))
+  (call-new-wis)
+  (call-new-cwis)
+  (call-new-wos)
+  (call-new-cwos))
+
+(call-with-output-file "t923.scm"
+  (lambda (p)
+    (display "asdf\n" p)
+    (display "fdsa" p)
+    (newline p)))
+
+(call-op1)
+(call-op2)
+(call-op3)
+(call-op4)
+
+;(call-funcs)
+
+;(when (> (*s7* 'profile) 0) (show-profile 200))
+(exit)
+
+;; this is dominated by fopen, fwrite, and fclose -- mallocs everywhere!, so I multiplied the string ports by 5
diff --git a/s7/tools/titer.scm b/s7/tools/titer.scm
new file mode 100644
index 0000000..45dabaa
--- /dev/null
+++ b/s7/tools/titer.scm
@@ -0,0 +1,101 @@
+;; iteration tests
+
+(set! (*s7* 'heap-size) (* 4 1024000))
+
+(let ((with-blocks #f))
+  (when with-blocks
+    (load "s7test-block.so" (sublet (curlet) (cons 'init_func 'block_init)))) ; load calls init_func if possible
+  
+  (define-constant (find-if-a iter)
+    (case (type-of (iterate iter)) ; op_tc_case
+      ((string?) #t)
+      ((eof-object?) #f)
+      (else (find-if-a iter))))
+  
+  (define-constant (find-if-b iter)
+    (call-with-exit
+     (lambda (return)
+       (for-each (lambda (arg)
+		   (if (string? arg) (return #t)))
+		 iter)
+       #f)))
+  
+  (define-constant (find-if-c iter)
+    (do ((obj (iterate iter) (iterate iter)))
+	((or (string? obj) (eof-object? obj))
+	 (string? obj))))
+  
+  (define-constant (find-if-d iter)
+    (do ((i 0 (+ i 1)))
+	((= i 1)
+	 (not (iterator-at-end? iter)))
+      (do ()
+	  ((or (string? (iterate iter)) (iterator-at-end? iter))))))
+  
+  (define (itest)
+    (for-each
+     (lambda (size)
+       (format *stderr* "~D: " size)
+       (let ((a (let ((lst (make-list size #f)))
+		  (list (find-if-a (make-iterator lst))
+			(find-if-b (make-iterator lst))
+			(find-if-c (make-iterator lst))
+			(find-if-d (make-iterator lst)))))
+	     (b (let ((str (make-string size #\space)))
+		  (list (find-if-a (make-iterator str))
+			(find-if-b (make-iterator str))
+			(find-if-c (make-iterator str))
+			(find-if-d (make-iterator str)))))
+	     (c (let ((vc (make-vector size #f)))
+		  (list (find-if-a (make-iterator vc))
+			(find-if-b (make-iterator vc))
+			(find-if-c (make-iterator vc))
+			(find-if-d (make-iterator vc)))))
+	     (d (let ((fv (make-float-vector size 1.0)))
+		  (list (find-if-a (make-iterator fv))
+			(find-if-b (make-iterator fv))
+			(find-if-c (make-iterator fv))
+			(find-if-d (make-iterator fv)))))
+	     (e (let ((iv (make-int-vector size 0)))
+		  (list (find-if-a (make-iterator iv))
+			(find-if-b (make-iterator iv))
+			(find-if-c (make-iterator iv))
+			(find-if-d (make-iterator iv)))))
+	     (f (let ((ht (let ((ht1 (make-hash-table size)))
+			    (do ((i 0 (+ i 1)))
+				((= i size) ht1)
+			      (hash-table-set! ht1 i i))))
+		      (p (cons #f #f)))
+		  (list (find-if-a (make-iterator ht p))
+			(find-if-b (make-iterator ht p))
+			(find-if-c (make-iterator ht p))
+			(find-if-d (make-iterator ht p)))))
+	     (g (let ((lt (apply inlet (make-list (* 2 size) 'abc)))
+		      (p (cons #f #f)))
+		  (list (find-if-a (make-iterator lt p))
+			(find-if-b (make-iterator lt p))
+			(find-if-c (make-iterator lt p))
+			(find-if-d (make-iterator lt p)))))
+	     (h (and with-blocks
+		     (let ((blk (make-block size)))
+		       (list (find-if-a (make-iterator blk))
+			     (find-if-b (make-iterator blk))
+			     (find-if-c (make-iterator blk))
+			     (find-if-d (make-iterator blk)))))))
+	 
+	 (if (not (equal? a '(#f #f #f #f))) (format *stderr* "a: ~A " a))
+	 (if (not (equal? b '(#f #f #f #f))) (format *stderr* "b: ~A " b))
+	 (if (not (equal? c '(#f #f #f #f))) (format *stderr* "c: ~A " c))
+	 (if (not (equal? d '(#f #f #f #f))) (format *stderr* "d: ~A " d))
+	 (if (not (equal? e '(#f #f #f #f))) (format *stderr* "e: ~A " e))
+	 (if (not (equal? f '(#f #f #f #f))) (format *stderr* "f: ~A " f))
+	 (if (not (equal? g '(#f #f #f #f))) (format *stderr* "g: ~A " g))
+	 (if (and with-blocks (not (equal? h '(#f #f #f #f)))) (format *stderr* "h: ~A " h))
+	 ))
+     (list 1 10 100 1000 10000 100000 1000000)))
+  
+  (itest)
+
+  (when (> (*s7* 'profile) 0)
+    (show-profile 200))
+  (exit))
diff --git a/s7/tools/tlamb.scm b/s7/tools/tlamb.scm
new file mode 100644
index 0000000..ee8faa7
--- /dev/null
+++ b/s7/tools/tlamb.scm
@@ -0,0 +1,357 @@
+(set! (*s7* 'heap-size) 1024000)
+
+(define size 1000000)
+
+;;; -------- [416] --------
+(define (f1 x) (x 123))           ; op_closure_a for (x 123)
+
+;(display (f1 (lambda (y) (+ y 1)))) (newline)
+
+(define (f1-test)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (f1 (lambda (y) (+ y 1)))))   ; op_lambda_unchecked -> make_closure_unchecked, op_simple_do_step -> op_closure_p
+
+(f1-test)
+
+
+;;; -------- [467] --------
+(define (f2 x)                    ; 465 if define-constant, 675 if both are define-constant
+  (define (f2_1 y) (+ y 1))       ; define_funchecked + make_funclet, op_safe_closure_s
+  (f2_1 x))
+
+;(display (f2 123)) (newline)
+
+(define (f2-test)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (f2 123)))                    ; op_closure_a from op_safe_dotimes_step_o
+
+(f2-test)
+
+
+;;; -------- [110] --------
+(define f3 (let ()                
+	     (define (f3_1 y) (+ y 1))
+	     (lambda (x)
+	       (f3_1 x))))        ; fx_safe_closure_s_to_add1 [s_to_sc]
+
+;(display (f3 123)) (newline)
+
+(define (f3-test)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (f3 123)))                    ; op_safe_closure_a_o from op_safe_dotimes_step_o
+
+(f3-test)
+
+;;; f1 could be faster, treat (lambda...) as a one-time evaluation (but where to save == lamlet? it's a do-loop: save locally)
+
+
+;;; -------- [82] --------
+(define-constant (f4_1 y) (+ y 1)) ; fx_safe_closure_s_to_add1
+(define-constant (f4 x) (f4_1 x)) ; faster than f3 because of the define-constant (allows opt cases), 110 if define
+                                  ;   has_fx f4, whereas not has_fx f3
+;(display (f4 123)) (newline)
+
+(define (f4-test)
+  (do ((i 0 (+ i 1)))            ; opt_dotimes opt_p_fx_any
+      ((= i size))
+    (f4 123)))                   ; fx_safe_closure_a_a -> safe_closure_add1_c [y=c etc] -> add1_c or inner body using s->val
+
+(f4-test)
+
+
+;;; -------- [237] --------
+(define (f5 x) ((lambda (y) (+ y 1)) x))
+
+;(display (f5 123)) (newline)
+
+(define (f5-test)
+  (do ((i 0 (+ i 1)))            ; op_safe_dotimes_step_o -> op_f_a [op_safe_sc] -- this could be optimized [op_f_fx_a?], caddar(sc->code) is fxable
+      ((= i size))
+    (f5 123)))                   ; op_closure_a_o
+
+(f5-test)
+
+
+;;; -------- [216] --------
+(define f6 (let ((f6_1 (lambda (y) (+ y 1)))) ; use letrec (f7) or define (f3) 2x faster??
+	     (lambda (x)
+	       (f6_1 x))))       ; op_closure_s_o
+
+;(display (f6 123)) (newline)
+
+(define (f6-test)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (f6 123)))                   ; op_closure_a_o
+
+(f6-test)
+
+
+;;; -------- [110] --------
+(define f7 (letrec ((f7_1 (lambda (y) (+ y 1)))) ; 110?!? letrec* same,  fx_safe_closure_s_to_add1
+	     (lambda (x)
+	       (f7_1 x))))       ; op_safe_closure_a_o via letrec_setup_closures
+
+;(display (f7 123)) (newline)
+
+(define (f7-test)
+  (do ((i 0 (+ i 1)))            ; op_safe_dotimes_step_o
+      ((= i size))
+    (f7 123)))
+
+(f7-test)
+
+
+
+;;; -------- [61] --------
+(define-constant (f8 x) (+ x 1)) ; the obvious case... 97 if define rather than define-constant
+
+;(display (f8 123)) (newline)
+
+(define (f8-test)
+  (do ((i 0 (+ i 1)))            ; opt_dotimes opt_p_fx_any
+      ((= i size))
+    (f8 123)))                   ; fx_safe_closure_a_to_sc
+
+(f8-test)
+
+
+
+;;; -------- [375] --------
+(define (f9 x)
+  (let ((f9_1 (lambda (y) (+ y 1)))) ; faster than define (f2)??  make_closure_unchecked
+    (f9_1 x)))
+
+;(display (f9 123)) (newline)
+
+(define (f9-test)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (f9 123)))
+
+(f9-test)
+
+
+
+;;; -------- [140] --------
+(define (f10 x) (f10_1 x))  ; call before definition, 134 if define-constant
+(define (f10_1 y) (+ y 1))  ; fx_safe_closure_s_to_add1
+                           
+;(display (f10 123)) (newline)
+
+(define (f10-test)
+  (do ((i 0 (+ i 1))) 
+      ((= i size))
+    (f10 123)))             ; op_closure_a_o [safe_closure_a_o if in the correct order, f3]
+
+(f10-test)
+
+
+
+;;; -------- [614] --------
+(define-macro (f11_1 y) `(+ ,y 1)) ; 97 if expansion
+(define (f11 x) (f11_1 x))
+                           
+;(display (f11 123)) (newline)
+
+(define (f11-test)
+  (do ((i 0 (+ i 1))) 
+      ((= i size))
+    (f11 123)))
+
+(f11-test)
+
+
+
+;;; -------- [43] --------
+(define-macro (f12_1 y) `(+ ,y 1))
+(define-macro (f12 x) `(f12_1 ,x))
+                           
+;(display (f12 123)) (newline)
+
+(define (f12-test)
+  (do ((i 0 (+ i 1))) 
+      ((= i size))
+    (f12 123)))
+
+(f12-test)
+
+
+
+;;; -------- [18] --------
+(define-expansion (f13_1 y) `(+ ,y 1))
+(define-expansion (f13 x) `(f13_1 ,x))   ; perhaps f4 expanded to fx of body?
+                           
+;(display (f13 123)) (newline)
+
+(define (f13-test)
+  (do ((i 0 (+ i 1))) 
+      ((= i size))
+    (f13 123)))         ; opt_dotimes opt_i_ii_cc add_i_ii, no eval
+
+(f13-test)
+
+
+
+;;; -------- [174] --------
+(define* (f14_1 (y 0)) (+ y 1))
+(define* (f14 (x 0)) (f14_1 x))
+                           
+;(display (f14 123)) (newline)
+
+(define (f14-test)      ; why 2x slower than f4, f4 (define case) uses fx_safe_closure_s_to_add1 = less eval + g_add_x1 + fx_t
+  (do ((i 0 (+ i 1))) 
+      ((= i size))
+    (f14 123)))         ; op_safe_closure_star_a1
+
+(f14-test)
+
+
+
+;;; -------- [209] --------
+(define f15 (letrec ((f15_1 (lambda (y) (+ y 1)))
+		     (f15_2 (lambda (y) (* y 2))))
+	     (lambda (x)
+	       (f15_2 (f15_1 x)))))
+
+;(display (f15 61)) (newline)
+
+(define (f15-test)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (f15 61)))
+
+(f15-test)
+
+
+
+;;; -------- [715] --------
+(define (f16 f1 f2) (f2 (f1 61)))
+
+;(display (f16 (lambda (y) (+ y 1)) (lambda (y) (* y 2)))) (newline)
+
+(define (f16-test)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (f16 (lambda (y) (+ y 1)) (lambda (y) (* y 2)))))
+
+(f16-test)
+
+
+
+;;; -------- [342] --------
+(define (f16_1 y) (+ y 1))
+(define (f16_2 y) (* y 2))
+
+;(display (f16 f16_1 f16_2)) (newline)
+
+(define (f17-test)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (f16 f16_1 f16_2)))
+
+(f17-test)
+
+
+;;; -------- [313] --------
+(define (f18 . args)           ; [346] -> 318 (safe_thunk) but tmisc up 10 6341 if op_safe_thunk_any -> 313 (fx_is_null_t)
+  (if (null? args) 1 0))       ; fx_is_null_t if safe_thunk_any
+
+(define (dof18)
+  (do ((sum 0)                 ; op_dox_step_o
+       (i 0 (+ i 1)))          ; fx_add_t1
+      ((= i size) sum)         ; fx_num_eq_ti
+    (set! sum (+ sum (f18))))) ; op_safe_c_sp + op_safe_thunk_any
+
+(unless (= (dof18) size) (format *stderr* "dof18: ~S~%" (dof18)))
+	    
+
+;;; -------- [449] --------
+(define (f19 . args)     ; [449] => 310 if (define (g arg)...)
+  (+ (car args) 1))      ; eval:fx_c_opsq_c_any -> car add_x1 (eval)
+
+(define (dof19)
+  (do ((sum 0)           ; op_dox_step_o
+       (i 0 (+ i 1)))    ; fx_add_t1 -> g_add_x1
+      ((= i size) sum)   ; fx_num_eq_ti
+    (set! sum (+ sum (f19 i))))) ; op_any_closure_sym via set_symbol_p+safe_set
+
+(unless (= (dof19) (/ (* size (+ size 1)) 2)) (format *stderr* "dof19: ~S~%" (dof19)))
+
+
+;;; -------- [520] --------
+(define (f20 a . b)
+  (+ a (car b)))         ; fx_c_s_opsq -> g_add_2 + g_car
+
+(define (dof20)          ;[618 -> 609 -> 520] op_any_closure_a_sym
+  (do ((sum 0)           ; op_dox_step_o
+       (i 0 (+ i 1)))    ; fx_add_t1
+      ((= i size) sum)   ; fx_num_eq_ti
+    (set! sum (+ sum (f20 i 1)))))
+
+(unless (= (dof20) (/ (* size (+ size 1)) 2)) (format *stderr* "dof20: ~S~%" (dof20)))
+
+
+;;; --------------------------------
+(define (f31 x)
+  (define (f32 y) (+ y 1))
+  (- (f32 x) 1))
+
+(define (g31)
+  (let loop ((z size))
+    (if (positive? (f31 z))
+	(loop (- z 1)))))
+
+(g31) ; 760
+
+
+(define (f33 x)
+  (let ((f34 (lambda (y) (+ y 1))))
+    (- (f34 x) 1)))
+
+(define (g32)
+  (let loop ((z size))
+    (if (positive? (f33 z))
+	(loop (- z 1)))))
+
+(g32) ; 667
+
+
+(define-constant (f36 y) (+ y 1))
+(define-constant (f35 x) (- (f36 x) 1))
+
+(define (g33)
+  (let loop ((z size))
+    (if (positive? (f35 z))
+	(loop (- z 1)))))
+
+(g33) ; 255 -> 242 g_sub_xi -> 225 fx_sub_a1
+
+
+(define (f38 y) (+ y 1))
+(define (f37 x) (- (f38 x) 1))
+
+(define (g34)
+  (let loop ((z size))
+    (if (positive? (f37 z))
+	(loop (- z 1)))))
+
+(g34) ; 348
+
+
+(define-constant (f310 y) (- y 1))
+(define-constant (f39 x) (+ (f310 x) 1))
+
+(define (g35)
+  (let loop ((z (- size)))
+    (if (negative? (f39 z))
+	(loop (+ z 1)))))
+
+(g35) ; 229 [fx_add_a1]
+
+
+
+(exit)
diff --git a/s7/tools/tleft.scm b/s7/tools/tleft.scm
new file mode 100644
index 0000000..52f11b6
--- /dev/null
+++ b/s7/tools/tleft.scm
@@ -0,0 +1,463 @@
+(define tc-size 1500000)
+(define rc-size 10000)
+(define case-size 1000000)
+
+
+(set! (*s7* 'heap-size) 512000)
+
+;;; why no fx_tree? or tentative? sub_t1|s1, fx_lt|geq|leq_si, fb|fx_num_eq_s0, fx_s
+;;; no other fb's
+;;; cond/let cases
+
+
+;;; --------------------------------------------------------------------------------
+;OP_TC_WHEN_LA and unless cases
+
+(define (f1 x)     ; now op_tc_when_la
+  (when (> x 0)    ; fx_gt_ti
+    (f1 (- x 1)))) ; fx_subtract_t1
+
+(f1 tc-size)  ; safe_closure_a_o[checked] op_if_a_p
+
+(define (f2 x)
+  (unless (<= x 0) ; fx_leq_ti 
+    (f2 (- x 1)))) ; fx_subtract_t1 
+
+(f2 tc-size)  ; safe_closure_a_o[checked] op_if_a_r
+
+;;; --------------------------------------------------------------------------------
+;OP_TC_WHEN_L3A and unless cases
+
+(define (f11 x y z)                 ; now op_tc_when_l3a
+  (when (> x 0)                     ; fx_gt_ti
+    (f11 (- x 1) (- y 2) (+ z 1)))) ; op_safe_closure_3a fx_add_v1 [subtract]
+
+(f11 tc-size 2 3) 
+
+(define (f12 x y z)
+  (unless (<= x 0)                  ; fx_leq_ti
+    (f12 (- x 1) y z)))             ; op_safe_closure_agg fx_subtract_t1 fx_u fx_v
+
+(f12 tc-size 1 2)
+
+;;; --------------------------------------------------------------------------------
+;OP_TC_IF_A_Z_IF_A_Z_L3A and reverse
+
+(define (f3 x y z)
+  (if (<= x 0)                      ; fx_leq_ti
+      y
+      (if (= y 0)                   ; fx_num_eq_u0
+	  x
+	  (f3 (- x 1) (- y 1) z)))) ; fx_subtract_t|u1 fx_v
+
+(f3 tc-size (* 2 tc-size) 0) ; safe_closure_3a[checked] if_a_a_p[leq] if_b_a_p[=] -- b_a_p leq case?
+
+(define (f4 x y z)
+  (if (<= x 0)
+      y
+      (if (> y 0)
+	  (f4 (- x 1) (- y 1) z)
+	  x)))
+
+(f4 tc-size (* 2 tc-size) 0) ; safe_closure_3a[checked] if_a_a_p[leq] if_a_p_a[gt]
+
+;;; --------------------------------------------------------------------------------
+;OP_TC_IF_A_LA_IF_A_Z[_Z] -- already handled:
+
+(define (f5 x)        ; op_tc_if_a_la_z
+  (if (>= x 0)        ; opt_b_ii_sc_geq_0
+      (f5 (- x 1))    ; opt_i_ii_sc_sub
+      (if (< x 0)
+	  x
+	  'oops!)))
+
+(f5 tc-size) 
+
+;;; --------------------------------------------------------------------------------
+;OP_TC_AND_A_OR_A_L3A and OP_TC_OR_A_AND_A_L3A
+
+(define (f6 x y z)                   ; now op_tc_and_a_or_a_l3a (also op_tc_or_a_and_a_l3a)
+  (and (> x 0)                       ; fx_gt_ti
+       (or (= y 0)                   ; fx_num_eq_u0
+	   (f6 (- x 1) (- y 1) 0)))) ; fx_subtract_t|u1
+
+(f6 tc-size (* 2 tc-size) 0)
+
+(define (f7 x y z)
+  (or (<= x 0)
+       (and (> y 0)
+	    (f7 (- x 1) (- y 1) 0))))
+
+(f7 tc-size (* 2 tc-size) 0)
+
+;;; --------------------------------------------------------------------------------
+;OP_TC_IF_A_Z_IF_A_Z_IF_A_Z_LA 
+
+(define (f7 x)
+  (if (= x 0)
+      x
+      (if (< x 0)
+	  'oops
+	  (if (= x 0)
+	      'oops
+	      (f7 (- x 1))))))
+
+(f7 tc-size) ; op_safe_closure_3a[checked] if_a_a_p[fx_lt_si] if_b_a_p[fb_num_eq_s0]
+
+;;; --------------------------------------------------------------------------------
+;OP_TC_COND_A_Z_L3A
+
+(define (f8 x y z)
+  (cond ((= x 0) 0)                     ; fx_num_eq_t0
+	(else (f8 (- x 1) (- y 1) z)))) ; fx_subtract_t|u1 fx_v
+
+(f8 tc-size tc-size 0) ; op_safe_closure_3a
+
+;;; --------------------------------------------------------------------------------
+;OP_TC_CASE_LAA
+
+(define (f9 x y)
+  (case x
+    ((0) (= y 0))
+    ((1) (* x y))
+    (else (f9 (- x 1) (+ y 1))))) ; fx_subtract_t1 fx_add_u1
+
+(f9 tc-size 0)
+
+;;; --------------------------------------------------------------------------------
+;OP_TC_LET_IF_A_Z_L3A
+
+(define (f10 x y z)
+  (let ((a (+ x y z)))       ; fx_c_tuv_direct  let_a_p_old
+    (if (= a 0)              ; fx_num_eq_t0  if_a_a_p
+	x                    ; fx_o?
+	(f10 (- x 1) y z)))) ; op_safe_closure_agg  fx_subtract_s1 + fx_o
+
+(f10 tc-size (/ tc-size 10) (/ tc-size 10))
+
+;;; --------------------------------------------------------------------------------
+;OP_RECUR_IF_A_A_opLAA_LAAq OP_RECUR_IF_A_opLAA_LAAq_A 
+
+(define (rc1 x y)
+  (if (<= y 0)
+      x
+      (+ (rc1 (+ x 1) (- y 1))
+	 (rc1 (- x 1) (- y 1)))))
+
+(define (trc1)
+  (do ((i 0 (+ i 1)))
+      ((= i rc-size))
+    (rc1 0 6)))
+
+(trc1)
+
+(define (rc1-rev x y)
+  (if (> y 0)
+      (+ (rc1 (+ x 1) (- y 1))
+	 (rc1 (- x 1) (- y 1)))
+      x))
+
+(define (trc1r)
+  (do ((i 0 (+ i 1)))
+      ((= i rc-size))
+    (rc1-rev 0 6)))
+
+(trc1r)
+
+;;; --------------------------------------------------------------------------------
+;OP_RECUR_IF_A_A_opL3A_L3Aq OP_RECUR_IF_A_opL3A_L3Aq_A
+
+(define (rc2 x y z)
+  (if (<= z 0)
+      (+ x y)
+      (+ (rc2 (+ x 1) (+ y 1) (- z 1))
+	 (rc2 (- x 1) (- y 1) (- z 1)))))
+
+(define (trc2)
+  (do ((i 0 (+ i 1)))
+      ((= i rc-size))
+    (rc2 0 0 5)))
+
+(trc2)
+
+(define (rc2-rev x y z)
+  (if (> z 0)
+      (+ (rc2 (+ x 1) (+ y 1) (- z 1))
+	 (rc2 (- x 1) (- y 1) (- z 1)))
+      (+ x y)))
+
+(define (trc2r)
+  (do ((i 0 (+ i 1)))
+      ((= i rc-size))
+    (rc2-rev 0 0 5)))
+
+(trc2r)
+
+;;; --------------------------------------------------------------------------------
+;;; OP_RECUR_IF_A_A_IF_A_A_opL3A_L3Aq?, 
+
+;OP_RECUR_OR_A_AND_A_opLA(AA)q?
+
+(define (rc3 lst) ; does this pattern ever happen? maybe opA_LAq is more likely
+  (or (null? lst)
+      (and (symbol? (car lst))
+	   (null? (rc3 (cdr lst))))))
+
+(define (trc3)
+  (let ((lst (make-list 100 'a)))
+    (do ((i 0 (+ i 1)))
+	((= i rc-size))
+      (rc3 lst))))
+
+(trc3)
+
+
+;;; --------------------------------------------------------------------------------
+
+(define (tcase1)       ; opt_case, numbers_are_eqv
+  (do ((i 0 (+ i 1)))
+      ((= i case-size))
+    (case i
+      ((0) 0)
+      ((1) 1)
+      ((2) 2)
+      (else 3))))
+
+(tcase1)
+
+(define (case2 i) ; case_a_i_s_a, uses t_lookup
+  (case i
+    ((0) 0)
+    ((1) 1)
+    ((2) 2)
+    (else 3)))
+
+(define (tcase2)
+  (do ((i 0 (+ i 1)))
+      ((= i case-size))
+    (case2 i)))
+
+(tcase2)
+
+(define (case3 x lst)        ; case_a_i_s_a
+  (case x                    ;   t_lookup
+    ((0) (pair? lst))        ; fx_is_pair_u
+    ((1) (pair? (cdr lst)))  ; fx_is_pair_cdr_u
+    (else (null? lst))))     ; fx_is_null_u
+
+(define (tcase3)
+  (do ((i 0 (+ i 1)))        ; op_simple_do_step -> safe_closure_aa_o
+      ((= i case-size))
+    (case3 i '(1 2))))       ; fx_t fx_q
+
+(tcase3)
+
+(define (tcase3-1)
+  (do ((i 0 (+ i 1)))                ; op_simple_do_step -> safe_closure_aa_o, g_add_x1
+      ((= i case-size))              ; g_num_eq_2
+    (case3 (remainder i 3) '(1 2)))) ; modulo_p_pi via fx_c_ti_direct(80400 check_do), fx_q
+
+(tcase3-1)
+
+(define (case4 x) ; case a_e_s_a
+  (case (remainder x 5)
+    ((a) 0)
+    ((b) 1)
+    ((c) 2)
+    ((d) 3)
+    (else 4)))
+
+(define (tcase4)
+  (do ((i 0 (+ i 1)))
+      ((= i case-size))
+    (case4 i)))
+
+(tcase4)
+
+(define sym-selector
+  (let ((syms '(a b c d e)))
+    (lambda (x)
+      (syms (remainder x 5))))) ; list-ref is slower
+
+(define (case5 x) ; case p_e_s
+  (case (sym-selector x)
+    ((a) 0)
+    ((b) 1)
+    ((c) 2)
+    ((d) 3)
+    (else 4)))
+
+(define (tcase5)
+  (do ((i 0 (+ i 1)))
+      ((= i case-size))
+    (case5 i)))
+
+(tcase5)
+
+(define (int-selector x)
+  (remainder x 5))
+
+(define (case6 x) ; case p_i_s
+  (case (int-selector x)
+    ((1) 0)
+    ((2) 1)
+    ((3) 2)
+    ((4) 3)
+    (else 4)))
+
+(define (tcase6)
+  (do ((i 0 (+ i 1)))
+      ((= i case-size))
+    (case6 i)))
+
+(tcase6)
+
+(define (any-selector x)
+  (if (zero? (remainder x 3)) #\a))
+
+(define (case7 x) ; case p_g_s
+  (case (any-selector x)
+    ((1/2) 0)
+    ((#\a) 1)
+    ((#<unspecified>) 2)
+    ((#f) 3)
+    (else 4)))
+
+(define (tcase7)
+  (do ((i 0 (+ i 1)))
+      ((= i case-size))
+    (case7 i)))
+
+(tcase7)
+
+(define (case8 x) ; case a_g_s_a
+  (case (even? x)
+    ((1/2) 0)
+    ((#\a) 1)
+    ((#<unspecified>) 2)
+    ((#f) 3)
+    (else 4)))
+
+(define (tcase8)
+  (do ((i 0 (+ i 1)))
+      ((= i case-size))
+    (case8 i)))
+
+(tcase8)
+
+(define (case9 x) ; case a_e_g
+  (case (even? x)
+    ((#t) (display x #f) (not x))
+    ((#f) (write x #f) (integer? x))
+    (else 'oops)))
+
+(define (tcase9)
+  (do ((i 0 (+ i 1)))
+      ((= i case-size))
+    (case9 i)))
+
+(tcase9)
+
+(define (case10 x) ; case a_g_g
+  (case (even? x)
+    ((#t) (display x #f) (not x))
+    ((1/2) (write x #f) (integer? x))
+    ((1 2 3) 0)
+    (else 'oops)))
+
+(define (tcase10)
+  (do ((i 0 (+ i 1)))
+      ((= i case-size))
+    (case10 i)))
+
+(tcase10)
+
+(define (case11 x) ; case a_s_g
+  (case (remainder x 5)
+    ((a) 0)
+    ((b) (display x #f) 1)
+    ((c) (+ 1 2))
+    ((d) 3)
+    (else 4)))
+
+(define (tcase11)
+  (do ((i 0 (+ i 1)))
+      ((= i case-size))
+    (case11 i)))
+
+(tcase11)
+
+(define (case12 x) ; case p_g_g
+  (case (any-selector x)
+    ((#t) (display x #f) (not x))
+    ((1/2) (write x #f) (integer? x))
+    ((1 2 3) 0)
+    (else 'oops)))
+
+(define (tcase12)
+  (do ((i 0 (+ i 1)))
+      ((= i case-size))
+    (case12 i)))
+
+(tcase12)
+
+(define (case13 x) ; case p_e_g
+  (case (sym-selector x)
+    ((a) 0)
+    ((b) (display x #f) 32)
+    ((c) 2)
+    ((d) 3)
+    (else 4)))
+
+(define (tcase13)
+  (do ((i 0 (+ i 1)))
+      ((= i case-size))
+    (case13 i)))
+
+(tcase13)
+
+(define (case14 x) ; a_g_s
+  (case x
+    ((1 2 3) 0)
+    ((4 5) 1)
+    ((6) 2)
+    ((7 8 9) 3)
+    ((10) 4)))
+
+(define (tcase14)
+  (do ((i 0 (+ i 1)))
+      ((= i case-size))
+    (case14 i)))
+
+(tcase14)
+
+(define (case15 x) ; case a_e_s
+  (case (remainder x 5)
+    ((a) 0)
+    ((b) 1)
+    ((c) 2)
+    ((d) 3)))
+
+(define (tcase15)
+  (do ((i 0 (+ i 1)))
+      ((= i case-size))
+    (case15 i)))
+
+(tcase15)
+
+(define (case16 x) ; case a_s_g_a
+  (case (remainder x 5)
+    ((a) 0)
+    ((b) (display x #f) 1)
+    ((c) (+ 1 2))
+    ((d) 3)
+    (else 4)))
+
+(define (tcase16)
+  (do ((i 0 (+ i 1)))
+      ((= i case-size))
+    (case16 i)))
+
+(tcase16)
+
+(exit)
diff --git a/s7/tools/tlet.scm b/s7/tools/tlet.scm
new file mode 100644
index 0000000..dbbbc15
--- /dev/null
+++ b/s7/tools/tlet.scm
@@ -0,0 +1,374 @@
+(define size 1000000)
+(set! (*s7* 'safety) -1)
+(set! (*s7* 'heap-size) (* 4 1024000))
+
+(define symbols (make-vector size 'a symbol?))
+(define e (inlet))
+
+(define (make-symbols)
+  (do ((e1 e)
+       (syms symbols)
+       (i 0 (+ i 1)))
+      ((= i size))
+    (varlet e1 (vector-set! syms i (symbol "a-" (number->string i))) i)))
+(make-symbols)
+
+(define (add)
+  (let ((sum 0)
+	(e1 e))
+    (for-each
+     (lambda (x)
+       (set! sum (+ sum (let-ref e1 x))))
+     symbols)
+    sum))
+
+(define (subtract)
+  (let ((sum 0)
+	(e1 e))
+    (for-each
+     (lambda (x)
+       (set! sum (- sum (let-ref e1 x))))
+     (reverse! symbols))
+    sum))
+
+(define (whatever)
+  (let ((sum 0))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (set! sum (+ sum (let-ref e (vector-ref symbols (random i))))))
+    sum))
+
+(format *stderr* "~A ~A ~A ~A~%" (/ (- (* size size) size) 2) (add) (subtract) (whatever))
+
+(define (in-e)
+  (with-let (sublet e :symbols symbols :size size)
+    (let ((sum1 0.0)
+	  (sum2 0.0)
+	  (sum3 0.0)
+	  (inc 0.0))
+      (do ((i 0 (#_+ i 1))) ; these #_'s make this much faster despite random->g_random rather than random_i_7i -- why? c_function_is_ok! lookup do_step1 eval [global]
+	  ((#_= i size))
+	(set! inc (#_symbol->value (#_vector-ref symbols i)))
+	(set! sum1 (#_+ sum1 inc))
+	(set! sum2 (#_- sum2 inc))
+	(set! sum3 (#_+ sum3 (#_symbol->value (#_vector-ref symbols (#_random i))))))
+      (format *stderr* "~A ~A ~A ~A~%" (/ (- (* size size) size) 2) sum1 sum2 sum3))))
+(in-e)
+
+#|
+without the with-let vs with it (without is slower!):
+total: 55.001
+ 98.000    (0.000      98.000)         s7.c:fx_c_opssq_s
+ 65.000    (0.000      65.000)         s7.c:fx_c_s_opsq
+ 50.000    (0.000      50.000)         s7.c:fx_c_as
+ 34.715    (0.000      34.715)         s7.c:g_random_1
+ 14.000    (0.000      14.000)         s7.c:s7_symbol_local_value
+ 14.000    (32.000     46.000)         s7.c:g_symbol_to_value
+-10.000    (10.000     0.000)          s7.c:fx_unsafe_s
+-17.000    (17.000     0.000)          s7.c:fx_c_a
+-42.000    (42.000     0.000)          s7.c:s7_symbol_value
+-48.000    (48.000     0.000)          s7.c:fx_c_opssq
+-49.000    (49.000     0.000)          s7.c:fx_c_s_opaq
+-54.715    (54.715     0.000)          s7.c:g_random
+|#
+
+(define (with-biglet)
+  (let ((biglet (inlet)))
+    (do ((i 0 (+ i 1)))
+	((= i 1000))
+      (varlet biglet (symbol "a" (number->string i)) (let ((local-i i)) (lambda (x) (+ x local-i)))))
+    (display ((with-let biglet a10) 1)) 
+    (newline)
+    (do ((i 0 (+ i 1)))
+	((= i 100000))
+      ((with-let biglet a9) i))))
+(with-biglet)
+
+
+;;; --------------------------------------------------------------------------------
+(define include-let #t)
+(define include-let* #t)
+(define include-letrec #t)
+(define include-letrec* #t)
+(define include-with-let #t)
+(define include-let-temporarily #t)
+(define include-named-let #t)
+(define include-named-let* #t)
+
+(set! size 100000)
+
+(when include-let
+  (define (f31 a)
+    (let ((x 21)
+	  (y (+ a 1))
+	  (z (lambda () 21))
+	  (xx (* a 2))
+	  (yy (- a 1))
+	  (zz (lambda () 22)))
+      (+ x y (z) xx yy (zz))))
+  (define (test31)
+    (unless (= (f31 5) 84) (format *stderr* "(f31 5): ~S (expected ~S)~%" (f31 5) 84))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (f31 i)))
+  (test31)
+
+  (define (f32 a)
+    (let ((x (+ a 1)))
+      (* x 2)))
+  (define (test32)
+    (unless (= (f32 5) 12) (format *stderr* "(f32 5): ~S (expected ~S)~%" (f32 5) 12))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (f32 i)))
+  (test32)
+
+  (define (f33 a)
+    (let ((x (+ a 1)))
+      (let ((y (+ x 1)))
+	(let ((z (+ x y)))
+	  (+ x y z)))))
+  (define (test33)
+    (unless (= (f33 5) 26) (format *stderr* "(f33 5): ~S (expected ~S)~%" (f33 5) 26))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (f33 i)))
+  (test33)
+  )
+
+(when include-let*
+  (define (f41 a)
+    (let* ((x 21)
+	   (y (+ a 1))
+	   (z (lambda () 21))
+	   (xx (* a 2))
+	   (yy (- a 1))
+	   (zz (lambda () 22)))
+      (+ x y (z) xx yy (zz))))
+  (define (test41)
+    (unless (= (f41 5) 84) (format *stderr* "(f41 5): ~S (expected ~S)~%" (f41 5) 84))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (f41 i)))
+  (test41)
+
+  (define (f42 a)
+    (let ((x (+ a 1)))
+      (* x 2)))
+  (define (test42)
+    (unless (= (f42 5) 12) (format *stderr* "(f42 5): ~S (expected ~S)~%" (f42 5) 12))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (f42 i)))
+  (test42)
+  )
+
+(when include-letrec
+  (define (f11 a)
+    (letrec ((x 21)
+	     (y (+ a 1))
+	     (z (lambda () 21))
+	     (xx (* a 2))
+	     (yy (- a 1))
+	     (zz (lambda () 22)))
+      (+ x y (z) xx yy (zz))))
+  (define (test11)
+    (unless (= (f11 5) 84) (format *stderr* "(f11 5): ~S (expected ~S)~%" (f11 5) 84))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (f11 i)))
+  (test11)
+
+  (define (f12 a)
+    (letrec ((x (+ a 1)))
+      (* x 2)))
+  (define (test12)
+    (unless (= (f12 5) 12) (format *stderr* "(f12 5): ~S (expected ~S)~%" (f12 5) 12))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (f12 i)))
+  (test12)
+  )
+
+(when include-letrec*
+  (define (f21 a)
+    (letrec* ((x 21)
+	      (y (+ a 1))
+	      (z (lambda () 21))
+	      (xx (* a 2))
+	      (yy (- a 1))
+	      (zz (lambda () 22)))
+      (+ x y (z) xx yy (zz))))
+  (define (test21)
+    (unless (= (f21 5) 84) (format *stderr* "(f21 5): ~S (expected ~S)~%" (f21 5) 84))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (f21 i)))
+  (test21)
+
+  (define (f22 a)
+    (letrec* ((x (+ a 1)))
+      (* x 2)))
+  (define (test22)
+    (unless (= (f22 5) 12) (format *stderr* "(f22 5): ~S (expected ~S)~%" (f22 5) 12))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (f22 i)))
+  (test22)
+  )
+
+(when include-with-let
+  (define (f51 a)
+    (with-let (inlet 'x 21
+		     'y (+ a 1)
+                     'z (lambda () 21)
+		     'xx (* a 2)
+		     'yy (- a 1)
+		     'zz (lambda () 22))
+    (#_+ x y (z) xx yy (zz))))
+  (define (test51)
+    (unless (= (f51 5) 84) (format *stderr* "(f51 5): ~S (expected ~S)~%" (f51 5) 84))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (f51 i)))
+  (test51)
+
+  (define (f52 a)
+    (with-let (inlet 'x (+ a 1))
+      (#_* x 2)))
+  (define (test52)
+    (unless (= (f52 5) 12) (format *stderr* "(f52 5): ~S (expected ~S)~%" (f52 5) 12))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (f52 i)))
+  (test52)
+  )
+
+(when include-let-temporarily
+  (let ((x #f)
+	(y #f)
+	(z #f)
+	(xx #f)
+	(yy #f)
+	(zz #f))
+    (define (f61 a)
+      (let-temporarily ((x 21)
+			(y (+ a 1))
+			(z (lambda () 21))
+			(xx (* a 2))
+			(yy (- a 1))
+			(zz (lambda () 22)))
+	(+ x y (z) xx yy (zz))))
+    (define (test61)
+      (unless (= (f61 5) 84) (format *stderr* "(f61 5): ~S (expected ~S)~%" (f61 5) 84))
+      (when (or x y z xx yy zz) (format *stderr* "let-temporary f61, all should be #f: ~S ~S ~S ~S ~S ~S~%" x y z xx yy zz))
+      (do ((i 0 (+ i 1)))
+	  ((= i size))
+	(f61 i)))
+    (test61)
+    
+    (define (f62 a)
+      (let-temporarily ((x (+ a 1)))
+	(* x 2)))
+    (define (test62)
+      (unless (= (f62 5) 12) (format *stderr* "(f62 5): ~S (expected ~S)~%" (f62 5) 12))
+      (do ((i 0 (+ i 1)))
+	  ((= i size))
+	(f62 i)))
+    (test62)
+    ))
+
+(when include-named-let
+  (define (f71 a)
+    (let loop ((x 21)
+	       (y (+ a 1))
+	       (z (lambda () 21))
+	       (xx (* a 2))
+	       (yy (- a 1))
+	       (zz (lambda () 22)))
+      (if (= x 21)
+	  (loop (- x 1) y z xx yy zz)
+	  (+ x y (z) xx yy (zz)))))
+  (define (test71)
+    (unless (= (f71 5) 83) (format *stderr* "(f71 5): ~S (expected ~S)~%" (f71 5) 83))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (f71 i)))
+  (test71)
+
+  (define (f72 a)
+    (let loop ((x (+ a 1)))
+      (if (> x a)
+	  (loop (- x 1))
+	  (* x 2))))
+  (define (test72)
+    (unless (= (f72 5) 10) (format *stderr* "(f72 5): ~S (expected ~S)~%" (f72 5) 10))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (f72 i)))
+  (test72)
+  )
+
+(when include-named-let*
+  (define (f81 a)
+    (let* loop ((x 21)
+	       (y (+ a 1))
+	       (z (lambda () 21))
+	       (xx (* a 2))
+	       (yy (- a 1))
+	       (zz (lambda () 22)))
+      (if (= x 21)
+	  (loop (- x 1) y z xx yy zz)
+	  (+ x y (z) xx yy (zz)))))
+  (define (test81)
+    (unless (= (f81 5) 83) (format *stderr* "(f81 5): ~S (expected ~S)~%" (f81 5) 83))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (f81 i)))
+  (test81)
+
+  (define (f82 a)
+    (let* loop ((x (+ a 1)))
+      (if (> x a)
+	  (loop (- x 1))
+	  (* x 2))))
+  (define (test82)
+    (unless (= (f82 5) 10) (format *stderr* "(f82 5): ~S (expected ~S)~%" (f82 5) 10))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (f82 i)))
+  (test82)
+  )
+
+(let ()
+  (define (f1)
+    (do ((i 0 (+ i 1)))
+	((= i 100000))
+      (unless (eq? (let-ref (unlet) :abs) #_abs) ; 758 g_unlet 740!! -> 5 (opt_p_unlet_ref)
+	(display "oops\n"))))
+  (f1)
+  
+  (define (f2)
+    (do ((i 0 (+ i 1)))
+	((= i 100000))
+      (unless (eq? ((unlet) :abs) #_abs) ; 792 unlet 740, eval 23 -> 8 (opt_p_unlet_ref) -> 7 direct
+	(display "oops\n"))))
+  (f2)
+  
+  (define (f3)
+    (do ((i 0 (+ i 1)))
+	((= i 100000))
+      (unless (eq? (let-ref (rootlet) :abs) #_abs) ; 13 goes through rootlet -> 5 direct
+	(display "oops\n"))))
+  (f3)
+  
+  (define (f4)
+    (do ((i 0 (+ i 1)))
+	((= i 100000))
+      (unless (eq? ((rootlet) :abs) #_abs) ; 47 -> 8 direct
+	(display "oops\n"))))
+  (f4))
+
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(exit)
diff --git a/s7/tools/tlist.scm b/s7/tools/tlist.scm
new file mode 100644
index 0000000..656a899
--- /dev/null
+++ b/s7/tools/tlist.scm
@@ -0,0 +1,252 @@
+;;; list timing tests
+
+(set! (*s7* 'heap-size) 512000)
+
+(define count 150000)
+
+
+(define (cxr tries)
+  (let* ((iv (make-list 28))
+	 (v (list '((1)) '(1 2) '((1 . 2)) '(1 2 . 3) '(((1))) '(1 (2)) '((1 2)) '(((1 . 2))) '(1 2 3)
+		  '(1 2 3 . 4) '(1 (2 . 3)) '((1 2 . 3)) '((((1)))) '(1 ((2))) '((1 (2))) '(((1 2))) '(1 2 (3))
+		  '(1 2 3 4) '(1 (2 3)) '((1 2 3)) '((((1 . 2)))) '(1 ((2 . 3))) '((1 (2 . 3))) 
+		  '(((1 2 . 3))) '(1 2 (3 . 4)) '(1 2 3 4 . 5) '(1 (2 3 . 4)) '((1 2 3 . 4))))
+	(tmp (list-tail v 10))
+	(tmpiv (list-tail iv 10))
+	(tmp1 (list-tail tmp 10))
+	(tmpiv1 (list-tail tmpiv 10)))
+    (do ((i 0 (+ i 1)))
+	((= i tries) iv)
+      (set-car! iv (caar (car v)))
+      (set-car! (cdr iv) (cadr (cadr v)))
+      (set-car! (cddr iv) (cdar (caddr v)))
+      (list-set! iv 3 (cddr (cadddr v)))
+      (list-set! iv 4 (caaar (list-ref v 4)))
+      (list-set! iv 5 (caadr (list-ref v 5)))
+      (list-set! iv 6 (cadar (list-ref v 6)))
+      (list-set! iv 7 (cdaar (list-ref v 7)))
+      (list-set! iv 8 (caddr (list-ref v 8)))
+      (list-set! iv 9 (cdddr (list-ref v 9)))
+      (set-car! tmpiv (cdadr (car tmp)))
+      (set-car! (cdr tmpiv) (cddar (cadr tmp)))
+      (set-car! (cddr tmpiv) (caaaar (caddr tmp)))
+      (list-set! tmpiv 3 (caaadr (cadddr tmp)))
+      (list-set! tmpiv 4 (caadar (list-ref tmp 4)))
+      (list-set! tmpiv 5 (cadaar (list-ref tmp 5)))
+      (list-set! tmpiv 6 (caaddr (list-ref tmp 6)))
+      (list-set! tmpiv 7 (cadddr (list-ref tmp 7)))
+      (list-set! tmpiv 8 (cadadr (list-ref tmp 8)))
+      (list-set! tmpiv 9 (caddar (list-ref tmp 9)))
+      (set-car! tmpiv1 (cdaaar (car tmp1)))
+      (set-car! (cdr tmpiv1) (cdaadr (cadr tmp1)))
+      (set-car! (cddr tmpiv1) (cdadar (caddr tmp1)))
+      (list-set! tmpiv1 3 (cddaar (cadddr tmp1)))
+      (list-set! tmpiv1 4 (cdaddr (list-ref tmp1 4)))
+      (list-set! tmpiv1 5 (cddddr (list-ref tmp1 5)))
+      (list-set! tmpiv1 6 (cddadr (list-ref tmp1 6)))
+      (list-set! tmpiv1 7 (cdddar (list-ref tmp1 7))))))
+
+(let ((val (cxr (* count 2))))
+  (unless (equal? val '(1 2 2 3 1 2 2 2 3 4 3 3 1 2 2 2 3 4 3 3 2 3 3 3 4 5 4 4))
+    (format *stderr* "cxr: ~S~%?" val)))
+
+(define (cxr-implicit tries)
+  (let* ((iv (list 1 2 2 3 1 2 2 2 3 4 3 3 1 2 2 2 3 4 3 3 2 3 3 3 4 5 4 4))
+	 (v (list '((1)) '(1 2) '((1 . 2)) '(1 2 . 3) '(((1))) '(1 (2)) '((1 2)) '(((1 . 2))) '(1 2 3)
+                   '(1 2 3 . 4) '(1 (2 . 3)) '((1 2 . 3)) '((((1)))) '(1 ((2))) '((1 (2))) '(((1 2))) '(1 2 (3))
+                   '(1 2 3 4) '(1 (2 3)) '((1 2 3)) '((((1 . 2)))) '(1 ((2 . 3))) '((1 (2 . 3))) 
+                   '(((1 2 . 3))) '(1 2 (3 . 4)) '(1 2 3 4 . 5) '(1 (2 3 . 4)) '((1 2 3 . 4))))
+	 (tmp (list-tail v 10))
+	 (L1 (cadr v))
+	 (L4 (list-ref v 4))
+	 (L5 (list-ref v 5))
+	 (L6 (list-ref v 6))
+	 (L8 (list-ref v 8))
+	 (L12 (caddr tmp))
+	 (L13 (cadddr tmp))
+	 (L14 (list-ref tmp 4))
+	 (L15 (list-ref tmp 5))
+	 (L16 (list-ref tmp 6))
+	 (L17 (list-ref tmp 7))
+	 (L18 (list-ref tmp 8))
+	 (L19 (list-ref tmp 9)))
+    (do ((i 0 (+ i 1)))
+	((= i tries) iv)
+      (set-car! iv ((car v) 0 0))
+      (set-car! (cdr iv) (L1 1))
+      (list-set! iv 4 (L4 0 0 0))
+      (list-set! iv 5 (L5 1 0))
+      (list-set! iv 6 (L6 0 1))
+      (list-set! iv 8 (L8 2))
+      (list-set! iv 12 (L12 0 0 0 0))
+      (list-set! iv 13 (L13 1 0 0))
+      (list-set! iv 14 (L14 0 1 0))
+      (list-set! iv 15 (L15 0 0 1))
+      (list-set! iv 16 (L16 2 0))
+      (list-set! iv 17 (L17 3))
+      (list-set! iv 18 (L18 1 1))
+      (list-set! iv 19 (L19 0 2)))))
+
+(let ((val (cxr-implicit (/ count 4))))
+  (unless (equal? val (list 1 2 2 3 1 2 2 2 3 4 3 3 1 2 2 2 3 4 3 3 2 3 3 3 4 5 4 4))
+    (format *stderr* "cxr: ~S~%?" val)))
+
+
+(define (obj->list tries)
+  (let ((str "asdffdsa")
+	(v #(0 1 2 3 4 5 6 7 8 9))
+	(r (random-state 12344321))
+	(rl ()))
+    (do ((i 0 (+ i 1)))
+	((= i tries))
+      (set! str (list->string (string->list str)))
+      (set! v (list->vector (vector->list v)))
+      (set! r (apply random-state (random-state->list r))))
+    (unless (equal? str "asdffdsa")
+      (format *stderr* "str: ~S~%" str))
+    (unless (equal? v #(0 1 2 3 4 5 6 7 8 9))
+      (format *stderr* "v: ~S~%" v))
+    (unless (equal? r (random-state 12344321))
+      (format *stderr* "r: ~S~%" r))))
+
+(unless (or (provided? 'gmp) (provided? 'pure-s7))
+  (obj->list count))
+
+
+(define (lst tries)
+  (let ((L (make-list 10))
+	(L1 (cons 0 0)))
+    (do ((i 0 (+ i 1)))
+	((= i tries))
+      (do ((k 0 (+ k 1))
+	   (val L (cdr val)))
+	  ((= k 10))
+	(list-set! L k (* k 2))
+	(unless (= (list-ref L k) (* k 2))
+	  (format *stderr* "Lref: ~S ~S~%" (list-ref L k) (* k 2)))
+	(unless (equal? (list-tail L k) val)
+	  (format *stderr* "Ltail: ~S ~S ~S~%" (list-tail L k) val k))
+	(set-car! L1 (car val))
+	(set-cdr! L1 (proper-list? L))
+	(unless (equal? (list 0 0 0) (make-list 3 0))
+	  (format *stderr* "list/make-list trouble: ~S ~S\n" (list 0 0 0) (make-list 3 0)))))))
+
+(lst count)
+
+
+(define (trees tries)
+  (let ((lists (list (list 1 2 3)
+		     (cons 1 2)
+		     (list 1)
+		     (list)
+		     (list (list 1 2) (list 3 4))
+		     (list (list 1 2) 3)
+		     '(1 . 2)
+		     '(a b c)
+		     '((a) b (c))
+		     '((1 2) (3 4))
+		     '((1 2 3) (4 5 6) (7 8 9))
+		     '(((1) (2) (3)) ((4) (5) (6)) ((7) (8) (9)))
+		     '((((1 123) (2 124) (3 125) (4 126)) ((5) (6) (7) (8)) ((9) (10) (11) (12)) ((13) (14) (15) (16)))
+		       (((21 127) (22 128) (23 129) (24 130)) ((25) (26) (27) (28)) ((29) (30) (31) (32)) ((33) (34) (35) (36)))
+		       (((41 131) (42 132) (43 133) (44 134)) ((45) (46) (47) (48)) ((49) (50) (51) (52)) ((53) (54) (55) (56)))
+		       (((61 135) (62 136) (63 137) (64 138)) ((65) (66) (67) (68)) ((69) (70) (71) (72)) ((73) (74) (75) (76)))
+		       321)))
+	(v (make-list 6)))
+    (do ((i 0 (+ i 1)))
+	((= i tries))
+      (set-car! v (tree-leaves lists))
+      (list-set! v 1 (tree-memq 'c lists))
+      (list-set! v 2 (tree-count 1 lists))
+      (list-set! v 3 (tree-cyclic? lists))
+      (list-set! v 4 (tree-set-memq '(d b e) lists))
+      (list-set! v 5 (length lists)))
+    (unless (equal? v '(125 #t 10 #f #t 13))
+      (format *stderr* "trees: ~S~%" v))))
+    
+(trees (/ count 10))
+
+
+(define (look tries)
+  (let ((alist '((a . 0) (b . 1) (c . 2) (d . 3)))
+	(mlist '(a b c d))
+	(v (make-list 6))
+	(L '(0 1 2 3 4))
+	(L1 ()))
+    (do ((i 0 (+ i 1)))
+	((= i tries))
+      (set! L1 (reverse L))
+      (set! L1 (reverse! L1))
+      (set! L1 (sort! L >))
+      (set! L1 (fill! L 0))
+      (set! L1 (copy L))
+      (set-car! v (assq 'd alist))
+      (list-set! v 1 (assv 'd alist))
+      (list-set! v 2 (assoc 'd alist))
+      (list-set! v 3 (memq 'd mlist))
+      (list-set! v 4 (memv 'd mlist))
+      (list-set! v 5 (member 'd mlist)))
+    (unless (equal? v '((d . 3) (d . 3) (d . 3) (d) (d) (d)))
+      (format *stderr* "look: ~S~%" v))))
+
+(look count)
+
+
+
+(define c?r
+  (let ((body ()))
+    (define (X-marks-the-spot accessor tree)
+      (if (eq? tree 'X)
+	  accessor
+	  (and (pair? tree)
+	       (or (X-marks-the-spot (cons 'car accessor) (car tree))
+		   (X-marks-the-spot (cons 'cdr accessor) (cdr tree))))))
+    (define (extend-path f)
+      (set! body (list f body)))
+    (lambda (path)
+      (set! body 'lst)
+      (for-each extend-path (reverse (X-marks-the-spot () path)))
+      body)))
+
+(define (find-X tries)
+  (let ((val ()))
+    (do ((i 0 (+ i 1)))
+	((= i tries))
+      (set! val (c?r '(0 (1 (2 (3 (4 (5 (6 (7 (X))))))))))))
+    (unless (equal? val '(car (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr lst))))))))))))))))))
+      (format *stderr* "find-X: ~S~%" val))))
+
+(find-X count)
+
+
+(define (cons-r a b n) 
+  (if (= n 0)
+      (cons a b)
+      (cons (cons-r (+ a 1) (+ b 1) (- n 1))
+	    (cons-r (- a 1) (- b 1) (- n 1)))))
+
+(define (cons-test tries)
+  (do ((i 0 (+ i 1)))
+      ((= i tries))
+    (cons-r 0 0 6)))
+
+(cons-test (/ count 10))
+
+
+(define (list-r a b n) 
+  (if (= n 0)
+      (list a b) 
+      (cons (list-r (+ a 1) (+ b 1) (- n 1)) 
+	    (list-r (- a 1) (- b 1) (- n 1)))))
+
+(define (list-test tries)
+  (do ((i 0 (+ i 1)))
+      ((= i tries))
+    (list-r 0 0 6)))
+
+(list-test (/ count 10))
+
+
+
+(exit)
+
diff --git a/s7/tools/tload.scm b/s7/tools/tload.scm
new file mode 100644
index 0000000..f0ed7af
--- /dev/null
+++ b/s7/tools/tload.scm
@@ -0,0 +1,248 @@
+;; shared library loader timing test
+
+(call-with-output-file "add1.c"
+  (lambda (oport)
+    (format oport "
+#include <stdlib.h>
+#include \"s7.h\"
+static s7_pointer add1(s7_scheme *sc, s7_pointer args)
+{
+  if (s7_is_integer(s7_car(args)))
+    return(s7_make_integer(sc, 1 + s7_integer(s7_car(args))));
+  return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"add1\", 4), 0, s7_car(args), 
+                                 s7_make_string_wrapper_with_length(sc, \"an integer\", 10)));
+}
+void add1_init(s7_scheme *sc);
+void add1_init(s7_scheme *sc)
+{
+  s7_define_function(sc, \"add1\", add1, 1, 0, false, \"(add1 int) adds 1 to int\");
+}
+")))
+
+(system "gcc -fpic -c add1.c")
+(system "gcc -shared -Wl,-soname,libadd1.so -o libadd1.so add1.o -lm -lc")
+(load "libadd1.so" (inlet 'init_func 'add1_init))
+
+(display (add1 2)) (newline)
+
+;;; --------------------------------------------------------------------------------
+
+(call-with-output-file "tlib.c"
+  (lambda (oport)
+    (format oport "
+#include <stdio.h>
+#include <stdlib.h>
+#include \"s7.h\"
+static s7_pointer a_function(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_car(args));
+}
+s7_pointer tlib_init(s7_scheme *sc, s7_pointer args);
+s7_pointer tlib_init(s7_scheme *sc, s7_pointer args)
+{
+  s7_define_function(sc, \"a-function\", a_function, 1, 0, true, NULL);
+  return(s7_cons(sc, s7_car(args), s7_nil(sc)));
+}
+")))
+
+(system "gcc -fPIC -c tlib.c")
+(system "gcc tlib.o -shared -o tlib.so -ldl -lm -Wl,-export-dynamic")
+
+(define tinit (load "tlib.so" (inlet 'init_func 'tlib_init 'init_args (list 1 2 3))))
+(display (apply a-function tinit)) (newline)
+
+;;; --------------------------------------------------------------------------------
+
+(unless (file-exists? "s7test-block.so")
+  (system "gcc -fPIC -c s7test-block.c -I. -g -O2")
+  (system "gcc s7test-block.o -shared -o s7test-block.so -ldl -lm -Wl,-export-dynamic"))
+
+(load "s7test-block.so" (sublet (curlet) (cons 'init_func 'block_init)))
+
+
+(define (f)
+  (do ((i 0 (+ i 1)))
+      ((= i 20000))
+    (let ()
+      (load "libadd1.so" (inlet 'init_func 'add1_init))
+      (load "tlib.so" (inlet 'init_func 'tlib_init 'init_args (list 1 2 3)))
+      (load "s7test-block.so" (sublet (curlet) (cons 'init_func 'block_init)))
+      (block-release-methods))))
+(f)
+
+;;; --------------------------------------------------------------------------------
+
+(require libc.scm)
+(require libm.scm)
+(require libgsl.scm)
+(require libgdbm.scm)
+(require libdl.scm)
+(require libutf8proc.scm)
+
+(define username (getenv "USER"))
+
+(define (g)
+  (do ((i 0 (+ i 1)))
+      ((= i 3))
+    (load (append "/home/" username "/cl/libc_s7.so") (inlet 'init_func 'libc_s7_init))
+    (load (append "/home/" username "/cl/libm_s7.so") (inlet 'init_func 'libm_s7_init))
+    (load (append "/home/" username "/cl/libgsl_s7.so") (inlet 'init_func 'libgsl_s7_init))
+    (load (append "/home/" username "/cl/libgdbm_s7.so") (inlet 'init_func 'libgdbm_s7_init))
+    (load (append "/home/" username "/cl/libdl_s7.so") (inlet 'init_func 'libdl_s7_init))))
+(g)
+
+;;; --------------------------------------------------------------------------------
+
+(call-with-output-file "dax1.c"
+  (lambda (oport)
+    (format oport "
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+
+#include \"s7.h\"
+typedef struct {
+  s7_double x;
+  s7_pointer data;
+} dax;
+
+static int dax_type_tag = 0;
+
+static s7_pointer dax_to_string(s7_scheme *sc, s7_pointer args)
+{
+  char *data_str, *str;
+  s7_pointer result;
+  int data_str_len;
+  dax *o = (dax *)s7_c_object_value(s7_car(args));
+  data_str = s7_object_to_c_string(sc, o->data);
+  data_str_len = strlen(data_str);
+  str = (char *)calloc(data_str_len + 32, sizeof(char));
+  snprintf(str, data_str_len + 32, \"<dax %.3f %s>\", o->x, data_str);
+  free(data_str);
+  result = s7_make_string(sc, str);
+  free(str);
+  return(result);
+}
+
+static s7_pointer free_dax(s7_scheme *sc, s7_pointer obj)
+{
+  free(s7_c_object_value(obj));
+  return(NULL);
+}
+
+static s7_pointer mark_dax(s7_scheme *sc, s7_pointer obj)
+{
+  dax *o;
+  o = (dax *)s7_c_object_value(obj);
+  s7_mark(o->data);
+  return(NULL);
+}
+
+static s7_pointer make_dax(s7_scheme *sc, s7_pointer args)
+{
+  dax *o;
+  o = (dax *)malloc(sizeof(dax));
+  o->x = s7_real(s7_car(args));
+  if (s7_cdr(args) != s7_nil(sc))
+    o->data = s7_cadr(args);
+  else o->data = s7_nil(sc);
+  return(s7_make_c_object(sc, dax_type_tag, (void *)o));
+}
+
+static s7_pointer is_dax(s7_scheme *sc, s7_pointer args)
+{
+  return(s7_make_boolean(sc, 
+			 s7_is_c_object(s7_car(args)) &&
+			 s7_c_object_type(s7_car(args)) == dax_type_tag));
+}
+
+static s7_pointer dax_x(s7_scheme *sc, s7_pointer args)
+{
+  dax *o;
+  o = (dax *)s7_c_object_value(s7_car(args));
+  return(s7_make_real(sc, o->x));
+}
+
+static s7_pointer set_dax_x(s7_scheme *sc, s7_pointer args)
+{
+  dax *o;
+  o = (dax *)s7_c_object_value(s7_car(args));
+  o->x = s7_real(s7_cadr(args));
+  return(s7_cadr(args));
+}
+
+static s7_pointer dax_data(s7_scheme *sc, s7_pointer args)
+{
+  dax *o;
+  o = (dax *)s7_c_object_value(s7_car(args));
+  return(o->data);
+}
+
+static s7_pointer set_dax_data(s7_scheme *sc, s7_pointer args)
+{
+  dax *o;
+  o = (dax *)s7_c_object_value(s7_car(args));
+  o->data = s7_cadr(args);
+  return(o->data);
+}
+
+static s7_pointer dax_is_equal(s7_scheme *sc, s7_pointer args) 
+{
+  s7_pointer p1, p2;
+  dax *d1, *d2;
+  p1 = s7_car(args);
+  p2 = s7_cadr(args);
+  if (p1 == p2) 
+    return(s7_t(sc));
+  if ((!s7_is_c_object(p2)) ||
+      (s7_c_object_type(p2) != dax_type_tag))
+    return(s7_f(sc));
+  d1 = (dax *)s7_c_object_value(p1);
+  d2 = (dax *)s7_c_object_value(p2);
+  return(s7_make_boolean(sc,
+			 (d1->x == d2->x) &&
+			 (s7_is_equal(sc, d1->data, d2->data))));
+}
+
+static s7_pointer make_and_free(s7_scheme *sc, s7_pointer args)
+{
+  s7_scheme *s7;
+  s7 = s7_init();
+  
+  dax_type_tag = s7_make_c_type(s7, \"dax\");
+  s7_c_type_set_gc_free(s7, dax_type_tag, free_dax);
+  s7_c_type_set_gc_mark(s7, dax_type_tag, mark_dax);
+  s7_c_type_set_is_equal(s7, dax_type_tag, dax_is_equal);
+  s7_c_type_set_to_string(s7, dax_type_tag, dax_to_string);
+  
+  s7_define_function(s7, \"make-dax\", make_dax, 2, 0, false, \"(make-dax x data) makes a new dax\");
+  s7_define_function(s7, \"dax?\", is_dax, 1, 0, false, \"(dax? anything) returns #t if its argument is a dax object\");
+  
+  s7_define_variable(s7, \"dax-x\", 
+		     s7_dilambda(s7, \"dax-x\", dax_x, 1, 0, set_dax_x, 2, 0, \"dax x field\"));
+  
+  s7_define_variable(s7, \"dax-data\", 
+		     s7_dilambda(s7, \"dax-data\", dax_data, 1, 0, set_dax_data, 2, 0, \"dax data field\"));
+  
+  s7_free(s7);
+  return(s7_f(sc));
+}
+
+void dax_init(s7_scheme *sc);
+void dax_init(s7_scheme *sc)
+{
+  s7_define_function(sc, \"dax\", make_and_free, 0, 0, false, NULL);
+}
+")))
+
+(system "gcc -fpic dax1.c -c dax1.c")
+(system "gcc dax1.o -shared -o dax1.so -ldl -lm -Wl,-export-dynamic")
+
+(load "dax1.so" (inlet 'init_func 'dax_init))
+(do ((i 0 (+ i 1)))
+    ((= i 200))
+  (dax))
+
+
+(exit)
diff --git a/s7/tools/tmac.scm b/s7/tools/tmac.scm
new file mode 100644
index 0000000..a29a80b
--- /dev/null
+++ b/s7/tools/tmac.scm
@@ -0,0 +1,170 @@
+(set! (*s7* 'heap-size) 1024000)
+
+(define size 500000)
+
+(define-macro (m2 a b) `(+ ,a ,@b 1))
+(define (f2)
+  (let ((x 2)
+	(y 0))
+    (do ((j 0 (+ j 1)))
+	((= j 1))
+      (do ((i 0 (+ i 1)))
+	  ((= i size))
+	(set! y (m2 x (x x)))
+	(if (not (= y (+ (* 3 x) 1)))
+	    (format *stderr* "y: ~A~%" y))))))
+(f2)
+
+
+(define (f2d)
+  (let ((x 2)
+	(y 0)
+	(size2 50000))
+    (do ((j 0 (+ j 1)))
+	((= j 1))
+      (do ((i 0 (+ i 1)))
+	  ((= i size2))
+	(set! y ((macro (a b) `(+ ,a ,@b 1)) x (x x)))
+	(if (not (= y (+ (* 3 x) 1)))
+	    (format *stderr* "y: ~A~%" y))))))
+(f2d)
+
+
+(define-expansion (m3 a b) `(+ ,a ,@b 1))
+(define (f3)
+  (let ((x 2)
+	(y 0))
+    (do ((j 0 (+ j 1)))
+	((= j 1))
+      (do ((i 0 (+ i 1)))
+	  ((= i size))
+	(set! y (m3 x (x x)))
+	(if (not (= y (+ (* 3 x) 1)))
+	    (format *stderr* "y: ~A~%" y))))))
+(f3)
+
+
+(define (f4 m) (+ 2 (m 3)))
+(define (f4-test mx)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (f4 mx)))
+
+(define-macro (m4 a) `(+ ,a 1))
+(f4-test m4)
+
+(define-macro (m5 a . b) `(+ ,a ,@b))
+(f4-test m5)
+
+(define-macro* (m6 (a 21)) `(+ ,a 1))
+(f4-test m6)
+
+(define (f5-test)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (m5 1 3 4 5)))
+(f5-test)
+
+(define-macro (m61 a b) (cons '+ (cons a b)))
+(define (f61-test mx)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (mx 1 (3 4 5))))
+(f61-test m61)
+
+(define (f7-test mx)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (mx 1 ())))
+(f7-test m61)
+
+(define (f8-test mx)
+  (let loop ((ctr size))
+    (mx 1 3 4 5)
+    (if (= ctr 0)
+	0
+	(loop (- ctr 1)))))
+(f8-test m5)
+
+
+(define-macro (trace f)
+  (let ((old-f (gensym)))
+    `(define ,f 
+       (let ((,old-f ,f))
+	 (apply lambda 'args 
+		`((format #f "(~S ~{~S~^ ~}) -> " ',',f args)
+		  (let ((val (apply ,,old-f args))) 
+		    (format #f "~S~%" val) 
+		    val)))))))
+
+(define (trace-test)
+  (let loop ((count 0))
+    (if (< count 30000) ; not 'when for old snd timings
+	(let ((f1 (lambda (x y z) (+ x y z))))
+	  (trace f1) ; op_macro_d I think
+	  (f1 count count count)
+	  (loop (+ count 1))))))
+
+(trace-test)
+
+
+;;; recursive macros
+
+(let ()
+  (define-macro (m1 a b)
+    `(if (> ,a 0)
+	 (m1 (- ,a 1) (+ ,b 1))
+	 (+ ,a ,b)))
+
+  (define (test-m1)
+    (do ((i 0 (+ i 1)))
+	((= i 10000))
+      (m1 3 0)))
+  
+  (test-m1))
+
+
+(let ((m2 (macro (a b)
+	    `(if (> ,a 0)
+		 (m2 (- ,a 1) (+ ,b 1)) ; m2 ok so named macro let is not needed
+		 (+ ,a ,b)))))
+
+  (define (test-m2)
+    (do ((i 0 (+ i 1)))
+	((= i 10000))
+      (m2 3 0)))
+  
+  (test-m2))
+
+
+#|
+;; undefined m3
+(let ((m3 (lambda (a b)
+	    (if (> a 0)
+		 (m3 (- a 1) (+ b 1)) ; m3 undefined so we need letrec/named let etc
+		 (+ a b)))))
+
+  ;(display (m3 3 0)) (newline)
+  #f)
+|#
+
+
+(let ()
+  (define-macro (tak x y z)           ; [1992], expansion is same (1980) even if declared globally, functional tak is [7]
+    `(if (not (< ,y ,x))
+	 ,z
+	 (tak (tak (- ,x 1) ,y ,z)
+              (tak (- ,y 1) ,z ,x)
+              (tak (- ,z 1) ,x ,y))))
+  
+  (define (test-tak)
+    (do ((i 0 (+ i 1)))
+	((= i 200))
+      (tak 6 4 2)))
+  
+  (test-tak))
+
+
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(exit)
diff --git a/s7/tools/tmap-hash.scm b/s7/tools/tmap-hash.scm
new file mode 100644
index 0000000..7e3278f
--- /dev/null
+++ b/s7/tools/tmap-hash.scm
@@ -0,0 +1,542 @@
+;;; hash map timings
+
+(define debugging (provided? 'debugging))
+
+(define chars-upper "#$%&'()*+,-.0123456789:<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_`abcdefghijklmnopqrstuvwxyz{|}��������������������������������������������������������������������������������������������")
+(define chars-lower "abcdefghijklmnopqrstuvwxyz-?=") ; more schemish?
+
+(define ok 1000000)
+(define bad 10000)
+
+(define (make-strings chr)
+  (let* ((num-keys 10000)
+	 (keys (make-vector num-keys))
+	 (num-chars (length chr)))
+    (do ((i 0 (+ i 1)))
+	((= i num-keys)
+	 keys)
+      (let* ((len (+ 4 (random 12)))
+	     (str (make-string len)))
+	(do ((j 0 (+ j 1)))
+	    ((= j len))
+	  (string-set! str j (string-ref chr (random num-chars))))
+	(vector-set! keys i str)))))
+
+
+(define (ref-int) ; [92, 28 in fx_random_i, 17 in hash_int]
+  (let ((H (make-hash-table 1024)))
+    (do ((i 0 (+ i 1))
+	 (int (random 10000) (random 10000)))
+	((= i ok))
+      (unless (hash-table-ref H int)
+	(hash-table-set! H int int)))
+    (when debugging (format *stderr* "ref-int: (~A ~{~A~^ ~})~%"
+			    (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max))))) ; ref-int: (6384 10000 0 0 1)
+
+;(ref-int)
+
+
+(define (ref-rat) ; [4821, 4546 hash_equal_ratio] this is a worst case -- 0..1 mostly and default-hash-table-float-epsilon constrains our options
+  (let ((H (make-hash-table 1024)))
+    (let ((rats (let ((V (make-vector 10000)))
+		  (do ((i 0 (+ i 1)))
+		      ((= i 10000) V)
+		    (vector-set! V i (/ (+ (random 99) 1) (+ 1 (random 99))))))))
+      (do ((i 0 (+ i 1))
+	   (rat (vector-ref rats (random 10000)) (vector-ref rats (random 10000))))
+	  ((= i bad))
+	(unless (hash-table-ref H rat)
+	  (hash-table-set! H rat rat)))
+      (when debugging (format *stderr* "ref-rat: (~A ~{~A~^ ~})~%"
+			      (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max)))))) ; ref-rat: (16308 36 9 31 2128)
+
+;(ref-rat)
+
+
+(define (ref-rat1) ; [288, 73 eval]
+  (let ((H (make-hash-table 1024)))
+    (let ((rats (let ((V (make-vector 10000)))
+		  (do ((i 0 (+ i 1)))
+		      ((= i 10000) V)
+		    (vector-set! V i (/ (+ (random 99999) 1) (+ 1 (random 99))))))))
+      (do ((i 0 (+ i 1))
+	   (rat (vector-ref rats (random 10000)) (vector-ref rats (random 10000))))
+	  ((= i ok))
+	(unless (hash-table-ref H rat)
+	  (hash-table-set! H rat rat)))
+      (when debugging (format *stderr* "ref-rat1: (~A ~{~A~^ ~})~%"
+			      (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max)))))) ; ref-rat1: (12516 1849 637 1382 14)
+
+;(ref-rat1)
+
+
+(define (ref-float) ; [320, 73 eval, 72 hash_float]
+  (let ((H (make-hash-table 1024)))
+    (let ((floats (let ((V (make-vector 10000)))
+		    (do ((i 0 (+ i 1)))
+			((= i 10000) V)
+		      (vector-set! V i (random 1000.0))))))
+      (do ((i 0 (+ i 1))
+	   (float (vector-ref floats (random 10000)) (vector-ref floats (random 10000))))
+	  ((= i ok))
+	(unless (hash-table-ref H float)
+	  (hash-table-set! H float float)))
+      (when debugging (format *stderr* "ref-float: (~A ~{~A~^ ~})~%"
+			      (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max)))))) ; ref-float: (15384 2 2 996 21)
+
+;(ref-float)
+
+
+(define (ref-complex) ; [1133, 945 in hash_float]
+  (let ((H (make-hash-table 1024)))
+    (let ((cs (let ((V (make-vector 10000)))
+		(do ((i 0 (+ i 1)))
+		    ((= i 10000) V)
+		  (vector-set! V i (complex (random 1000.0) (random 1000.0)))))))
+      (do ((i 0 (+ i 1))
+	   (c (vector-ref cs (random 10000)) (vector-ref cs (random 10000))))
+	  ((= i ok))
+	(unless (hash-table-ref H c)
+	  (hash-table-set! H c c)))
+      (when debugging (format *stderr* "ref-complex: (~A ~{~A~^ ~})~%"
+			      (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max)))))) ; ref-complex: (16374 0 0 10 1065), (14685 199 202 1298 25)
+
+;(ref-complex)
+
+
+(define (ref-string) ; [356 (counting make-strings), 74 eval, 62 for hash_string]
+  (let ((H (make-hash-table 1024 string=?))
+	(strings (make-strings chars-lower)))
+    (do ((i 0 (+ i 1))
+	 (str (vector-ref strings (random 10000)) (vector-ref strings (random 10000))))
+	((= i ok))
+      (unless (hash-table-ref H str)
+	(hash-table-set! H str str)))
+    (when debugging (format *stderr* "ref-string: (~A ~{~A~^ ~})~%"
+			    (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max))))) ; ref-string: (12795 1412 686 1491 18)
+
+;(ref-string)
+
+
+(define (ref-string1) ; [349, 74 eval, 53 hash_string]
+  (let ((H (make-hash-table 1024 string=?))
+	(strings (make-strings chars-upper)))
+    (do ((i 0 (+ i 1))
+	 (str (vector-ref strings (random 10000)) (vector-ref strings (random 10000))))
+	((= i ok))
+      (unless (hash-table-ref H str)
+	(hash-table-set! H str str)))
+    (when debugging (format *stderr* "ref-string1: (~A ~{~A~^ ~})~%"
+			    (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max))))) ; ref-string1: (9114 5128 1663 479 6)
+
+;(ref-string1)
+
+
+(define (ref-string2) ; [3915, 3400 hash_string, 80+73 number_to_string]
+  (let ((H (make-hash-table 1024 string=?)))
+    (do ((i 0 (+ i 1))
+	 (str (string-append "w" (number->string (random 10000))) (string-append "w" (number->string (random 10000)))))
+	((= i bad))
+      (unless (hash-table-ref H str)
+	(hash-table-set! H str str)))
+    (when debugging (format *stderr* "ref-string2: (~A ~{~A~^ ~})~%"
+			    (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max))))) ; ref-string2: (16374 1 0 9 1111)
+
+;(ref-string2)
+
+
+(define (ref-string3) ; [344, 73 eval]
+  (let* ((syms (symbol-table))
+	 (len (length syms))  ; ca 675
+	 (strs (make-vector len)))
+    (do ((i 0 (+ i 1)))
+	((= i len))
+      (vector-set! strs i (symbol->string (vector-ref syms i))))
+    (let ((H (make-hash-table 1024)))
+      (do ((i 0 (+ i 1))
+	   (str (vector-ref strs (random len)) (vector-ref strs (random len))))
+	  ((= i ok))
+	(unless (hash-table-ref H str)
+	  (hash-table-set! H str 1)))
+      (when debugging (format *stderr* "ref-string3: (~A ~{~A~^ ~})~%"
+			      (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max)))))) ; ref-string3: (785 112 47 80 26): (675 786 111 48 79 26)
+
+;(ref-string3)
+
+
+(define (ref-ci-string) ; [856, 586 hash_ci_string]
+  (let ((H (make-hash-table 1024 string-ci=?))
+	(strings (make-strings chars-lower)))
+    (do ((i 0 (+ i 1))
+	 (str (vector-ref strings (random 10000)) (vector-ref strings (random 10000))))
+	((= i ok))
+      (unless (hash-table-ref H str)
+	(hash-table-set! H str str)))
+    (when debugging (format *stderr* "ref-ci-string: (~A ~{~A~^ ~})~%"
+			    (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max))))) ; ref-ci-string: (16036 0 0 348 42)
+
+;(ref-ci-string)
+
+
+(define (ref-sym) ; [288, 74 eval]
+  (let ((H (make-hash-table 1024))
+	(syms (let ((V (make-vector 10000))
+		    (strs (make-strings chars-lower)))
+		(do ((i 0 (+ i 1)))
+		    ((= i 10000) V)
+		  (vector-set! V i (string->symbol (vector-ref strs i)))))))
+    (do ((i 0 (+ i 1))
+	 (sym (vector-ref syms (random 10000)) (vector-ref syms (random 10000))))
+	((= i ok))
+      (unless (hash-table-ref H sym)
+	(hash-table-set! H sym sym)))
+    (when debugging (format *stderr* "ref-sym: (~A ~{~A~^ ~})~%"
+			    (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max))))) ; ref-sym: (6412 9945 27 0 2)
+
+;(ref-sym)
+
+
+(define (ref-sym1) ; [266, 73 eval]
+  (let* ((st (symbol-table))
+	 (len (length st)))
+    (let ((H (make-hash-table 1024)))
+      (do ((i 0 (+ i 1))
+	   (sym (vector-ref st (random len)) (vector-ref st (random len))))
+	  ((= i ok))
+	(unless (hash-table-ref H sym)
+	  (hash-table-set! H sym 1)))
+      (when debugging (format *stderr* "ref-sym1: (~A ~{~A~^ ~})~%"
+			      (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max)))))) ; ref-sym1: (493 409 111 11 3)
+
+;(ref-sym1)
+
+
+(define (ref-pair) ; [4574, 2936 in pair_equal, 803 integer_equal, 634 hash_equal_any] -> [2495, 1570 pair_equal] -> [659, 172 pair_equal, 76 hash_map_pair]
+  (let ((H (make-hash-table 1024)))
+    (let ((lsts (let ((V (make-vector 10000)))
+		  (do ((i 0 (+ i 1)))
+		      ((= i 10000) V)
+		    (vector-set! V i (cons (random 1000) (random 1000)))))))
+    (do ((i 0 (+ i 1))
+	 (p (vector-ref lsts (random 10000)) (vector-ref lsts (random 10000))))
+	((= i ok))
+      (unless (hash-table-ref H p)
+	(hash-table-set! H p p)))
+    (when debugging (format *stderr* "ref-pair: (~A ~{~A~^ ~})~%"
+			    (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max))))))
+    ;; ref-pair: (16284 0 0 100 100): (10000 16185 2 2 195 100): (9953 14600 212 177 1395 21)
+
+;(ref-pair)
+
+
+(define (ref-pair1) ; [812, 274 hash_map_pair, 150 pair_equal]
+  (let ((H (make-hash-table 1024)))
+    (let ((lsts (let ((V (make-vector 10000)))
+		  (do ((i 0 (+ i 1)))
+		      ((= i 10000) V)
+		    (vector-set! V i (make-list (random 100) (random 1000)))))))
+      (do ((i 0 (+ i 1))
+	   (p (vector-ref lsts (random 10000)) (vector-ref lsts (random 10000))))
+	  ((= i ok))
+	(unless (hash-table-ref H p)
+	  (hash-table-set! H p p)))
+      (when debugging (format *stderr* "ref-pair1: (~A ~{~A~^ ~})~%"
+			      (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max)))))) ; ref-pair1: (9404 9039 5561 1529 255 5)
+
+;(ref-pair1)
+
+
+(define (ref-iv) ; [442]
+  (let ((H (make-hash-table 1024)))
+    (let ((ivs (let ((V (make-vector 10000)))
+		 (do ((i 0 (+ i 1)))
+		     ((= i 10000) V)
+		   (vector-set! V i (make-int-vector (random 100) (random 1000)))))))
+      (do ((i 0 (+ i 1))
+	   (p (vector-ref ivs (random 10000)) (vector-ref ivs (random 10000))))
+	  ((= i ok))
+	(unless (hash-table-ref H p)
+	  (hash-table-set! H p p)))
+      (when debugging (format *stderr* "ref-iv: (~A ~{~A~^ ~})~%"
+			      (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max)))))) ; ref-iv: (9407 14335 121 210 1718 12)
+
+;(ref-iv)
+
+
+(define (ref-bv) ; [616]
+  (let ((H (make-hash-table 1024)))
+    (let ((bvs (let ((V (make-vector 10000)))
+		 (do ((i 0 (+ i 1)))
+		     ((= i 10000) V)
+		   (vector-set! V i (make-byte-vector (random 100) (random 250)))))))
+      (do ((i 0 (+ i 1))
+	   (p (vector-ref bvs (random 10000)) (vector-ref bvs (random 10000))))
+	  ((= i ok))
+	(unless (hash-table-ref H p)
+	  (hash-table-set! H p p)))
+      (when debugging (format *stderr* "ref-bv: (~A ~{~A~^ ~})~%"
+			      (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max)))))) ; ref-bv: (8156 15794 11 8 571 25)
+
+;(ref-bv)
+
+
+(define (ref-v) ; [614]
+  (let ((H (make-hash-table 1024)))
+    (let ((vs (let ((V (make-vector 10000)))
+		 (do ((i 0 (+ i 1)))
+		     ((= i 10000) V)
+		   (vector-set! V i (make-vector (random 100) (random 1000)))))))
+      (do ((i 0 (+ i 1))
+	   (p (vector-ref vs (random 10000)) (vector-ref vs (random 10000))))
+	  ((= i ok))
+	(unless (hash-table-ref H p)
+	  (hash-table-set! H p p)))
+      (when debugging (format *stderr* "ref-v: (~A ~{~A~^ ~})~%"
+			      (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max)))))) ; ref-v: (9433 14334 111 229 1710 13)
+
+;(ref-v)
+
+
+(define (ref-fv) ; [446]
+  (let ((H (make-hash-table 1024)))
+    (let ((floats (let ((V (make-vector 10000)))
+		    (do ((i 0 (+ i 1)))
+			((= i 10000) V)
+		      (vector-set! V i (make-float-vector (random 100) (random 1000.0)))))))
+      (do ((i 0 (+ i 1))
+	   (float (vector-ref floats (random 10000)) (vector-ref floats (random 10000))))
+	  ((= i ok))
+	(unless (hash-table-ref H float)
+	  (hash-table-set! H float float)))
+      (when debugging (format *stderr* "ref-fv: (~A ~{~A~^ ~})~%"
+			      (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max)))))) ; ref-fv: (9895 14340 113 172 1759 14)
+
+;(ref-fv)
+
+
+(define (ref-let) ; [452, 167 let_equal_1, 65 simple_inlet] -- let_equal checks outlet chains! called from hash_equal_any
+  (let ((H (make-hash-table 1024)))
+    (do ((i 0 (+ i 1))
+	 (p (inlet 'a (random 10000)) (inlet 'a (random 10000))))
+	((= i ok))
+      (unless (hash-table-ref H p)
+	(hash-table-set! H p p)))
+    (when debugging (format *stderr* "ref-let: (~A ~{~A~^ ~})~%"
+			    (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max))))) ; ref-let: (6384 10000 0 0 1)
+
+;(ref-let)
+
+
+(define (ref-let1) ; [1153, 626 let_equal_1]
+  (let ((H (make-hash-table 1024)))
+    (let ((lets (let ((V (make-vector 10000)))
+		  (do ((i 0 (+ i 1)))
+		      ((= i 10000) V)
+		    (vector-set! V i (inlet 'a (random 1000) 'b (random 1000)))))))
+      (do ((i 0 (+ i 1))
+	   (p (vector-ref lets (random 10000)) (vector-ref lets (random 10000))))
+	  ((= i ok))
+	(unless (hash-table-ref H p)
+	  (hash-table-set! H p p)))
+      (when debugging (format *stderr* "ref-let1: (~A ~{~A~^ ~})~%"
+			      (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max)))))) ; ref-let1: (14573 208 204 1399 19)
+
+;(ref-let1)
+
+
+(define (ref-char) ; [114, 26 g_random_i, 12 hash_char, 12 integer_to_char]
+  (let ((H (make-hash-table 256 char=?)))
+    (do ((i 0 (+ i 1))
+	 (c (integer->char (random 256)) (integer->char (random 256))))
+	((= i ok))
+      (unless (hash-table-ref H c)
+	(hash-table-set! H c c)))
+    (when debugging (format *stderr* "ref-char: (~A ~{~A~^ ~})~%"
+			    (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max))))) ; (768 256 0 0 1)
+
+;(ref-char)
+
+
+(define (ref-hash) ;[525] slow if hash has > 2 entries
+  (let ((H (make-hash-table 1024)))
+    (let ((tabs (let ((V (make-vector 10000)))
+		  (do ((i 0 (+ i 1)))
+		      ((= i 10000) V)
+		    (vector-set! V i (hash-table 'a (random 10000)))))))
+    (do ((i 0 (+ i 1))
+	 (p (vector-ref tabs (random 10000)) (vector-ref tabs (random 10000))))
+	((= i ok))
+      (unless (hash-table-ref H p)
+	(hash-table-set! H p p)))
+    (when debugging (format *stderr* "ref-hash: (~A ~{~A~^ ~})~%"
+			    (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max)))))) ; ref-hash: (16383 0 0 1 6317): (6350 10034 6350 0 0 1)
+
+;(ref-hash)
+
+
+(define (ref-hash1) ; [555]
+  (let ((H (make-hash-table 1024)))
+    (let ((tabs (let ((V (make-vector 10000)))
+		  (do ((i 0 (+ i 1)))
+		      ((= i 10000) V)
+		    (vector-set! V i (hash-table 'a (random 10000) 'b (random 10000)))))))
+    (do ((i 0 (+ i 1))
+	 (p (vector-ref tabs (random 10000)) (vector-ref tabs (random 10000))))
+	((= i ok))
+      (unless (hash-table-ref H p)
+	(hash-table-set! H p p)))
+    (when debugging (format *stderr* "ref-hash1: (~A ~{~A~^ ~})~%"
+			    (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max)))))) ; ref-hash1: (16383 0 0 1 6282): (10000 9135 5105 1657 487 8)
+
+;(ref-hash1)
+
+
+(define (ref-c-pointer) ; [352]
+  (let ((H (make-hash-table 1024)))
+    (let ((ptrs (let ((V (make-vector 10000)))
+		  (do ((i 0 (+ i 1)))
+		      ((= i 10000) V)
+		    (vector-set! V i (c-pointer (random 4000000)))))))
+    (do ((i 0 (+ i 1))
+	 (p (vector-ref ptrs (random 10000)) (vector-ref ptrs (random 10000))))
+	((= i ok))
+      (unless (hash-table-ref H p)
+	(hash-table-set! H p p)))
+    (when debugging (format *stderr* "ref-c-pointer: (~A ~{~A~^ ~})~%"
+			    (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max)))))) ; ref-c-pointer: (12794 778 962 1850 10): (9994 9033 5222 1696 433 6)
+
+;(ref-c-pointer)
+
+
+(define (ref-iterator) ; [2882, 887 vector_equal, 705 iterator_equal 216 hash_equal_any]
+  (let ((H (make-hash-table 1024)))
+    (let ((ptrs (let ((V (make-vector 10000)))
+		  (do ((i 0 (+ i 1)))
+		      ((= i 10000) V)
+		    (vector-set! V i (make-iterator (case (modulo i 6)
+						      ((0) (make-list (+ (random 100) 1) (random 10000)))
+						      ((1) (vector (random 100) (random 100) (random 100)))
+						      ((2) (float-vector (random 100) (random 100) (random 100)))
+						      ((3) (int-vector (random 100) (random 100) (random 100)))
+						      ((4) (byte-vector (random 100) (random 100) (random 100)))
+						      ((5) (string (integer->char (+ (random 50) 32)) 
+								   (integer->char (+ (random 50) 32)) 
+								   (integer->char (+ (random 50) 32)))))))))))
+    (do ((i 0 (+ i 1))
+	 (p (vector-ref ptrs (random 10000)) (vector-ref ptrs (random 10000))))
+	((= i ok))
+      (unless (hash-table-ref H p)
+	(hash-table-set! H p p)))
+    (when debugging (format *stderr* "ref-iterator: (~A ~{~A~^ ~})~%"
+			    (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max)))))) ; ref-iterator: (9982 13546 2146 395 297 87)
+
+;(ref-iterator)
+
+
+(define (ref-undefined) ; [25262, 9641 undefined_equal, 9393 strcmp, 5065 hash_equal_any (3 hash_map_undefined)]
+                        ; [ 2040, 1666 hash_equal_any, 76 eval (18 hash_map_undefined]
+                        ; [  450, 76 eval, 71 hash_equal_any (24 hash_map_undefined]
+  (let ((H (make-hash-table 1024))
+	(strings (let ((strs (make-strings chars-lower))
+		       (V (make-vector 10000)))
+		   (do ((i 0 (+ i 1)))
+		       ((= i 10000) V)
+		     (vector-set! V i (eval-string (string-append "#a" (vector-ref strs i)))))))) ;slightly faster than with-input-from-string + read
+    (do ((i 0 (+ i 1))
+	 (str (vector-ref strings (random 10000)) (vector-ref strings (random 10000))))
+	((= i ok))
+      (unless (hash-table-ref H str)
+	(hash-table-set! H str str)))
+    (when debugging (format *stderr* "ref-undefined: (~A ~{~A~^ ~})~%"
+			    (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max))))) ; ref-undefined: (10000 16372 0 0 12 862): (9999 15542 3 5 834 2443)
+
+;(ref-undefined)
+
+
+(define (ref-c-func) ; [2004, 1271 hash_equal_any, 411 eq_equal, 73 eval]
+                     ; [340]
+  (let* ((st (symbol-table))
+	 (len (length st)))
+    (let ((H (make-hash-table 1024))
+	  (fncs (let ((V (make-vector len #f))
+		      (i 0))
+		  (for-each (lambda (sym)
+			      (let ((f (symbol->value sym)))
+				(when (procedure? f)
+				  (vector-set! V i f)
+				  (set! i (+ i 1)))))
+			    st)
+		  (set! len i)
+		  V)))
+      (do ((i 0 (+ i 1))
+	   (f (vector-ref fncs (random len)) (vector-ref fncs (random len))))
+	  ((= i ok))
+	(unless (hash-table-ref H f)
+	  (hash-table-set! H f 1)))
+      (when debugging (format *stderr* "ref-c-func: (~A ~{~A~^ ~})~%"
+			      (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max)))))) ; ref-c-func: (442 632 342 50 0 2)
+
+;(ref-c-func)
+
+
+(when (provided? 'gmp)
+  (define (ref-big-int) ; [1170]
+    (let ((H (make-hash-table 1024)))
+      (do ((i 0 (+ i 1))
+	   (int (+ 1000000000000000000000000 (random (bignum 10000))) (+ 1000000000000000000000000 (random (bignum 10000)))))
+	  ((= i ok))
+	(unless (hash-table-ref H int)
+	  (hash-table-set! H int int)))
+      (when debugging (format *stderr* "ref-big-int: (~A ~{~A~^ ~})~%"
+			      (hash-table-entries H) ((object->let H) 'stats:0|1|2|n|max))))) ; ref-big-int: (10000 6384 10000 0 0 1)
+
+  ;(ref-big-int)
+  )
+
+
+
+(define (all-cases)
+  (ref-int)
+  (ref-rat)
+  (ref-rat1)
+  (ref-float)
+  (ref-complex)
+  (ref-string)
+  (ref-string1)
+  (ref-string2)
+  (ref-string3)
+  (ref-ci-string)
+  (ref-sym1)
+  (ref-sym)
+  (ref-pair)
+  (ref-pair1)
+  (ref-iv)
+  (ref-bv)
+  (ref-fv)
+  (ref-v)
+  (ref-let)
+  (ref-let1)
+  (ref-char)
+  (ref-hash)
+  (ref-hash1)
+  (ref-c-pointer)
+  (ref-iterator)
+  (ref-undefined)
+  (ref-c-func)
+  (when (provided? 'gmp)
+    (ref-big-int))
+  )
+
+(all-cases)
+
+#|
+
+all-cases 4.1 secs
+24.0: 584
+23.0: 665
+22.0: 606
+21.0: 472
+20.9  498
+|#
+
+(exit)
diff --git a/s7/tools/tmap.scm b/s7/tools/tmap.scm
new file mode 100644
index 0000000..c996c98
--- /dev/null
+++ b/s7/tools/tmap.scm
@@ -0,0 +1,681 @@
+;;; sequence tests
+
+(set! (*s7* 'heap-size) (* 3 1024000))
+
+(define (less-than a b)
+  (or (< a b) (> b a)))
+
+(define (less-than-2 a b)
+  (if (not (real? a)) (display "oops"))
+  (cond ((< a b) #t) (#t #f)))
+
+(define (char-less-than a b) 
+  (cond ((char<? a b) #t) (else #f)))
+
+
+(define (fv-tst len)
+  (let ((fv (make-float-vector len)))
+    (if (not (= (length fv) len))
+	(format *stderr* "float-vector length ~A: ~A~%" fv (length fv)))
+    (fill! fv 0.0)
+    (let ((fv-orig (copy fv)))
+      (do ((i 0 (+ i 1)))
+	  ((= i len))
+	(float-vector-set! fv i (- (random 1000.0) 500.0)))
+      (do ((i 0 (+ i 1)))
+	  ((= i len))
+	(set! (fv i) (- (random 1000.0) 500.0)))
+      (let ((fv-ran (copy fv))
+	    (fv-ran1 (copy fv)))
+	(sort! fv <)
+	(do ((i 1 (+ i 1)))
+	    ((= i len))
+	  (if (> (float-vector-ref fv (- i 1)) (float-vector-ref fv i))
+	      (display "oops")))
+	(do ((i 1 (+ i 1)))
+	    ((= i len))
+	  (if (> (fv (- i 1)) (fv i))
+	      (display "oops")))
+	(sort! fv-ran (lambda (a b) (< a b)))
+	(if (not (equivalent? fv fv-ran))
+	    (format *stderr* "float-vector closure not equal~%"))
+	(sort! fv-ran1 less-than)
+	(if (not (equivalent? fv fv-ran1))
+	    (format *stderr* "float-vector cond closure not equal~%")))
+
+      (let ((fv-copy (copy fv)))
+	(reverse! fv)
+	(if (and (not (equivalent? fv-copy fv))
+		 (equivalent? fv fv-orig))
+	    (format *stderr* "float-vector reverse!: ~A ~A~%" fv fv-orig))
+	(reverse! fv)
+	(if (not (equivalent? fv-copy fv))
+	    (format *stderr* "float-vector reverse! twice: ~A ~A~%" fv fv-copy))
+	(let ((fv1 (apply float-vector (make-list len 1.0))))
+	  (if (not (and (= (length fv1) len)
+			(= (fv1 (- len 1)) 1.0)))
+	      (format *stderr* "float-vector apply: ~A ~A~%" len (fv (- len 1)))))
+	))))
+
+(define (iv-tst len)
+  (let ((fv (make-int-vector len)))
+    (if (not (= (length fv) len))
+	(format *stderr* "int-vector length ~A: ~A~%" fv (length fv)))
+    (fill! fv 0)
+    (let ((fv-orig (copy fv)))
+      (do ((i 0 (+ i 1)))
+	  ((= i len))
+	(int-vector-set! fv i (- (random 1000000) 500000)))
+      (do ((i 0 (+ i 1)))
+	  ((= i len))
+	(set! (fv i) (- (random 1000000) 500000)))
+      (let ((fv-ran (copy fv))
+	    (fv-ran1 (copy fv)))
+	(sort! fv <)
+	(do ((i 1 (+ i 1)))
+	    ((= i len))
+	  (if (> (int-vector-ref fv (- i 1)) (int-vector-ref fv i))
+	      (display "oops")))
+	(do ((i 1 (+ i 1)))
+	    ((= i len))
+	  (if (> (fv (- i 1)) (fv i))
+	      (display "oops")))
+	(sort! fv-ran (lambda (a b) (< a b)))
+	(if (not (equal? fv fv-ran))
+	    (format *stderr* "int-vector closure not equal~%"))
+	(sort! fv-ran1 less-than)
+	(if (not (equal? fv fv-ran1))
+	    (format *stderr* "int-vector cond closure not equal~%")))
+	
+      (let ((fv-copy (copy fv)))
+	(reverse! fv)
+	(if (and (not (equal? fv-copy fv))
+		 (equal? fv fv-orig))
+	    (format *stderr* "int-vector reverse!: ~A ~A~%" fv fv-orig))
+	(reverse! fv)
+	(if (not (equal? fv-copy fv))
+	    (format *stderr* "int-vector reverse! twice: ~A ~A~%" fv fv-copy))
+	))))
+
+(define (v-tst len)
+  (let ((fv (make-vector len)))
+    (if (not (= (length fv) len))
+	(format *stderr* "vector length ~A: ~A~%" fv (length fv)))
+    (fill! fv 0)
+    (let ((fv-orig (copy fv)))
+      (do ((i 0 (+ i 1)))
+	  ((= i len))
+	(vector-set! fv i (- (random 1000000) 500000)))
+      (do ((i 0 (+ i 1)))
+	  ((= i len))
+	(set! (fv i) (- (random 1000000) 500000)))
+      (let ((fv-ran (copy fv))
+	    (fv-ran1 (copy fv)))
+	(sort! fv <)
+	(do ((i 1 (+ i 1)))
+	    ((= i len))
+	  (if (> (vector-ref fv (- i 1)) (vector-ref fv i))
+	      (display "oops")))
+	(do ((i 1 (+ i 1)))
+	    ((= i len))
+	  (if (> (fv (- i 1)) (fv i))
+	      (display "oops")))
+	(sort! fv-ran (lambda (a b) (< a b)))
+	(if (not (equal? fv fv-ran))
+	    (format *stderr* "vector closure not equal~%"))
+	(sort! fv-ran1 less-than-2)
+	(if (not (equal? fv fv-ran1))
+	    (format *stderr* "vector cond closure not equal~%")))
+	
+      (let ((fv-copy (copy fv)))
+	(reverse! fv)
+	(if (and (not (equal? fv-copy fv))
+		 (equal? fv fv-orig))
+	    (format *stderr* "vector reverse!: ~A ~A~%" fv fv-orig))
+	(reverse! fv)
+	(if (not (equal? fv-copy fv))
+	    (format *stderr* "vector reverse! twice: ~A ~A~%" fv fv-copy))
+	(let ((fv1 (apply vector (make-list len 1))))
+	  (if (not (and (= (length fv1) len)
+			(= (fv1 (- len 1)) 1)))
+	      (format *stderr* "vector apply: ~A ~A~%" len (fv (- len 1)))))
+	))))
+
+(define (s-tst len)
+  (let ((fv (make-string len)))
+    (if (not (= (length fv) len))
+	(format *stderr* "string length ~A: ~A~%" fv (length fv)))
+    (fill! fv #\a)
+    (let ((fv-orig (copy fv)))
+      (do ((i 0 (+ i 1)))
+	  ((= i len))
+	(string-set! fv i (integer->char (+ 20 (random 100)))))
+      (do ((i 0 (+ i 1)))
+	  ((= i len))
+	(set! (fv i) (integer->char (+ 20 (random 100)))))
+      (let ((fv-ran (copy fv))
+	    (fv-ran1 (copy fv)))
+	(sort! fv char<?)
+	(do ((i 1 (+ i 1)))
+	    ((= i len))
+	  (if (char>? (string-ref fv (- i 1)) (string-ref fv i))
+	      (display "oops")))
+	(do ((i 1 (+ i 1)))
+	    ((= i len))
+	  (if (char>? (fv (- i 1)) (fv i))
+	      (display "oops")))
+	(sort! fv-ran (lambda (a b) (char<? a b)))
+	(if (not (string=? fv fv-ran))
+	    (format *stderr* "string closure not equal~%"))
+	(sort! fv-ran1 char-less-than)
+	(if (not (string=? fv fv-ran))
+	    (format *stderr* "string cond closure not equal~%")))
+
+      (let ((fv-copy (copy fv)))
+	(reverse! fv)
+	(if (and (not (string=? fv-copy fv))
+		 (string=? fv fv-orig))
+	    (format *stderr* "string reverse!: ~A ~A~%" fv fv-orig))
+	(reverse! fv)
+	(if (not (string=? fv-copy fv))
+	    (format *stderr* "string reverse! twice: ~A ~A~%" fv fv-copy))
+	(let ((fv1 (apply string (make-list len #\a))))
+	  (if (not (and (= (length fv1) len)
+			(char=? (fv1 (- len 1)) #\a)))
+	      (format *stderr* "string apply: ~A ~A~%" len (fv (- len 1)))))
+	))))
+
+(define (p-tst len)
+  (let ((fv (make-list len)))
+    (if (not (= (length fv) len))
+	(format *stderr* "list length ~A: ~A~%" fv (length fv)))
+    (fill! fv 0)
+    (let ((fv-orig (copy fv)))
+      (do ((p fv (cdr p)))
+	  ((null? p))
+	(set-car! p (- (random 100000) 50000)))
+      (let ((fv-ran (copy fv)))
+	(set! fv (sort! fv <))
+	(call-with-exit
+	 (lambda (quit)
+	   (let ((p0 (car fv)))
+	     (for-each
+	      (lambda (p1)
+		(when (> p0 p1)
+		  (format *stderr* "list: ~A > ~A~%" (car p0) (car p1))
+		  (quit))
+		(set! p0 p1))
+	      (cdr fv)))))
+	(set! fv-ran (sort! fv-ran (lambda (a b) (< a b))))
+	(if (not (equal? fv fv-ran))
+	    (format *stderr* "pair closure not equal~%")))
+	
+      (let ((fv-copy (copy fv)))
+	(set! fv (reverse! fv))
+	(if (and (not (equal? fv-copy fv))
+		 (equal? fv fv-orig))
+	    (format *stderr* "list reverse!: ~A ~A~%" fv fv-orig))
+	(set! fv (reverse! fv))
+	(if (not (equal? fv-copy fv))
+	    (format *stderr* "list reverse! twice: ~A ~A~%" fv fv-copy))
+	))))
+
+(define (e-tst len)
+  (let ((ht (make-hash-table len))
+	(lst (make-list len)))
+    (do ((i 0 (+ i 1)))
+	((= i len))
+      (list-set! lst i i))
+    (do ((i 0 (+ i 1)))
+	((= i len))
+      (if (not (= (list-ref lst i) i)) (display "oops")))
+    (do ((i 0 (+ i 1)))
+	((= i len))
+      (set! (lst i) i))
+    (do ((i 0 (+ i 1)))
+	((= i len))
+      (if (not (= (lst i) i)) (display "oops")))
+    (do ((i 0 (+ i 1)))
+	((= i len))
+      (hash-table-set! ht i i))
+    (do ((i 0 (+ i 1)))
+	((= i len))
+      (if (not (= (hash-table-ref ht i) i)) (display "oops")))
+    (do ((i 0 (+ i 1)))
+	((= i len))
+      (set! (ht i) i))
+    (do ((i 0 (+ i 1)))
+	((= i len))
+      (if (not (= (ht i) i)) (display "oops")))))
+
+
+(define (test-it)
+  (for-each
+   (lambda (b p)
+     (do ((k 0 (+ k 1)))
+	 ((= k 1000))
+       (fv-tst b)
+       (iv-tst b)
+       (v-tst b)
+       (s-tst b)
+       (p-tst b)
+       (e-tst b))
+     (do ((i 0 (+ i 1)))
+	 ((= i p))
+       (format *stderr* "~D " (expt b i))
+       (fv-tst (expt b i))
+       (iv-tst (expt b i))
+       (v-tst (expt b i))
+       (s-tst (expt b i))
+       (p-tst (expt b i))))
+   '(2 3 4 7 10)
+   '(12 4 3 6 6)))
+
+(test-it)
+
+(newline *stderr*)
+
+(let ((size 1000000))
+  (define (fe1 x) (if (not (char=? x #\1)) (display x)))
+  (define (fe2) (for-each fe1 (make-string size #\1)))
+  (define (fe20) (for-each char-upcase (make-string size #\1)))
+  (fe2) (fe20)
+  
+  (define (fe3 x) (if (not (char=? x #\1)) (display x)))
+  (define (fe4) (for-each fe3 (make-list size #\1)))
+  (define (fe40) (for-each char? (make-list size #\1)))
+  (fe4) (fe40)
+  
+  (define (fe5 x) (if (not (char=? x #\1)) (display x)))
+  (define (fe6) (for-each fe5 (make-vector size #\1)))
+  (define (fe60) (for-each char-alphabetic? (make-vector size #\1)))
+  (fe6) (fe60)
+  
+  (define (fe7 x) (if (not (= x 1)) (display x)))
+  (define (fe8) (for-each fe7 (make-int-vector size 1)))
+  (define (fe80) (for-each abs (make-int-vector size 1)))
+  (fe8) (fe80)
+  
+  (define (fe9 x) (if (not (= x 1.0)) (display x)))
+  (define (fe10) (for-each fe9 (make-float-vector size 1.0)))
+  (define (fe100) (for-each real? (make-float-vector size 1.0)))
+  (fe10) (fe100)
+  
+  (define (fe11 p) (if (member 1 (make-list p 2) >) (display "oops")))
+  (fe11 size)
+  (fe11 1)
+  (define (less a b) (> a b))
+  (define (fe12 p) (if (member 1 (make-list p 2) less) (display "oops")))
+  (fe12 size)
+  (fe12 1)
+  (define (fe13 p) (if (member 1 (make-list p 2) (lambda (a b) (cond ((> a b) #t) (#t #f)))) (display "oops")))
+  (fe13 size)
+  (fe13 1))
+
+
+;;; --------------------------------------------------------------------------------
+;;; this is a revision of some code posted in comp.lang.lisp by melzzzzz for euler project 512
+
+;;; using int-vector is better for the largest cases
+(define (make-boolean-vector n) (make-vector n #f))
+(define boolean-vector-ref vector-ref)
+(define-expansion (boolean-vector-set! v j) `(vector-set! ,v ,j #t))
+
+(define (odd-get n)
+  (let* ((visited-range (+ (ash n -1) 1))
+	 (visited (make-boolean-vector visited-range))
+	 (sqrt-n (+ (floor (sqrt n)) 1)))
+    (do ((i 3 (+ i 2)))
+	((>= i sqrt-n))
+      (unless (boolean-vector-ref visited (ash i -1))
+	(do ((j (ash (* i i) -1) (+ j i)))
+	    ((>= j visited-range))
+	  (boolean-vector-set! visited j))))
+    (let ((rc (make-int-vector (+ n 1)))
+	  (rcp 0)
+	  (lim (+ n 1)))
+      (do ((i 3 (+ i 2)))
+	  ((= i lim) (copy rc (make-int-vector rcp)))
+	(unless (boolean-vector-ref visited (ash i -1))
+	  (int-vector-set! rc rcp i)
+	  (set! rcp (+ rcp 1)))))))
+
+(define (getr n)
+  (let* ((odd-bound (ash (+ n 1) -1))
+	 (prime-list (odd-get n))
+	 (result (make-int-vector odd-bound))
+	 (n2 (/ n 2))) ; this optimization suggested by "Peter" (in comp.lang.lisp)
+    (do ((i 0 (+ i 1)))
+	((= i odd-bound))
+      (int-vector-set! result i (+ (* 2 i) 1)))
+
+    (for-each (lambda (prime)
+		(do ((j (ash prime -1) (+ j prime)))
+		    ((>= j n2))
+		  (int-vector-set! result j (* (quotient (int-vector-ref result j) prime) (- prime 1)))))
+	      prime-list)
+
+   (let ((sum 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i odd-bound) sum)
+	(set! sum (+ sum (int-vector-ref result i)))))))
+
+(let ((r (getr 100)))
+  (unless (= r 2007)
+    (display r)
+    (newline)))
+
+(let ((r (getr 500000)))
+  (unless (= r 50660660193)
+    (display r)
+    (newline)))
+
+;;; (getr 5000000)    5066059769259     .5 
+;;; (getr 50000000)   506605921933035    6 
+;;; (getr 500000000)  50660591862310323  67 (32M, mutable_do)
+
+;;; --------------------------------------------------------------------------------
+;;; some coverage cases
+
+(define fsize 200000)
+
+(define (f1 lst)
+  (for-each (lambda (p)
+	      (if (integer? p)
+		  (display 'oops)))
+	    lst))
+
+(define lst (make-list fsize ()))
+(f1 lst)
+
+(define (f2 v)
+  (for-each (lambda (p)
+	      (if (integer? p)
+		  (display 'oops)))
+	    v))
+
+(define fv (make-float-vector fsize 1.0))
+(f2 fv)
+
+(define (f3 v)
+  (for-each (lambda (p)
+	      (if (pair? p)
+		  (display 'oops)))
+	    v))
+
+(define iv (make-int-vector fsize 1))
+(f3 iv)
+
+(define (f4 v)
+  (for-each (lambda (p)
+	      (if (integer? p)
+		  (display 'oops)))
+	    v))
+
+(define nv (make-vector fsize "abc"))
+(f4 nv)
+
+(define (f5 lst)
+  (for-each (lambda (p)
+	      (if (integer? p)
+		  (throw 'oops p)))
+	    lst))
+(f5 lst)
+
+(define (f11 lst)
+  (map (lambda (p)
+	 (if (integer? p)
+	     (display 'oops)))
+       lst))
+(f11 lst)
+
+(define (f12 v)
+  (map (lambda (p)
+	 (if (integer? p)
+	     (display 'oops)))
+       v))
+(f12 fv)
+
+(define (f13 v)
+  (map (lambda (p)
+	 (if (pair? p)
+	     (display 'oops)))
+       v))
+(f13 iv)
+
+(define (f14 v)
+  (map (lambda (p)
+	 (if (integer? p)
+	     (display 'oops)))
+       v))
+(f14 nv)
+
+(define (f15 lst)
+  (map (lambda (p)
+	 (if (integer? p)
+	     (throw 'oops p)))
+       lst))
+(f15 lst)
+
+
+
+(define gsize 1000000)
+
+(define (g1 lst)
+  (for-each (lambda* (p)
+	      (if (integer? p)
+		  (display 'oops)))
+	    lst))
+
+(define glst (make-list gsize ()))
+(g1 glst)
+
+(define (g2 v)
+  (for-each (lambda* (p)
+	      (if (integer? p)
+		  (display 'oops)))
+	    v))
+
+(define gfv (make-float-vector gsize 1.0))
+(g2 gfv)
+
+(define (g3 v)
+  (for-each (lambda* (p)
+	      (if (pair? p)
+		  (display 'oops)))
+	    v))
+
+(define giv (make-int-vector gsize 1))
+(g3 giv)
+
+(define (g4 v)
+  (for-each (lambda* (p)
+	      (if (integer? p)
+		  (display 'oops)))
+	    v))
+
+(define gv (make-vector gsize ()))
+(g4 gv)
+
+(define (g5 lst)
+  (for-each (lambda* (p)
+	      (if (integer? p)
+		  (throw 'oops p)))
+	    lst))
+(g5 glst)
+
+(define (g11 lst)
+  (map (lambda* (p)
+	 (if (integer? p)
+	     (display 'oops)
+             0))
+       lst))
+(g11 glst)
+
+(define (g12 v)
+  (map (lambda* (p)
+	 (if (integer? p)
+	     (display 'oops)
+             0))
+       v))
+(g12 gfv)
+
+(define (g13 v)
+  (map (lambda* (p)
+	 (if (pair? p)
+	     (display 'oops)
+             0))
+       v))
+(g13 giv)
+
+(define (g14 v)
+  (map (lambda* (p)
+	 (if (integer? p)
+	     (display 'oops)
+             0))
+       v))
+(g14 gv)
+
+(define (g15 lst)
+  (map (lambda* (p)
+	 (if (integer? p)
+	     (throw 'oops p)
+             0))
+       lst))
+(g15 glst)
+
+(define (g6 lst)
+  (for-each (lambda (p)
+	      (if (integer? p)
+		  (display 'oops))
+	      (if (pair? p)
+		  (display 'oops)))
+	    lst))
+(g6 gv)
+
+(define (g61 lst)
+  (for-each (lambda (p)
+	      (for-each (lambda (q)
+			  (if (integer? q)
+			      (display 'oops)))
+			p))
+	    lst))
+
+(define glst1 (make-list 100 (make-list 100 #\a)))
+(g61 glst1)
+
+(define (g16 lst)
+  (map (lambda (p)
+	 (map (lambda (q)
+		(if (integer? q)
+		    (display 'oops)
+		    0))
+	      p))
+       lst))
+(g16 glst1)
+
+(define fstr (make-string gsize #\a))
+(define (f7 str)
+  (for-each (lambda (p)
+	      (if (not (char? p))
+		  (display 'oops)))
+	    str))
+(f7 fstr)
+
+(define (f17 str)
+  (map (lambda (p)
+	 (if (not (char? p))
+	     (display 'oops)
+	     p))
+       str))
+(f17 fstr)
+
+
+(define (f21 lst)
+  (for-each (lambda (p q)
+	      (unless (eq? p q)
+		(display 'oops)))
+	    lst lst))
+(f21 lst)
+
+
+(define (f22 v)
+  (for-each (lambda (p q)
+	      (if (not (= p q))
+		  (display 'oops)))
+	    v v))
+(f22 fv)
+
+
+(define (f23 str)
+  (for-each (lambda (p q)
+	      (if (not (char=? p q))
+		  (display 'oops)))
+	    str str))
+(f23 fstr)
+
+
+(define (f24 v)
+  (for-each (lambda (p q)
+	      (unless (string=? p q)
+		(display 'oops)))
+	    v v))
+(f24 nv)
+
+;; if float-vector arg and only ref is in opt_d context, no need for make_real
+;;   i.e. 2 args even cell_opt outer, is ref b_dd or equivalent?
+
+
+(define hsize 75000)
+(define (f25 v)
+  (do ((i 0 (+ i 1)))
+      ((= i hsize))
+    (for-each (lambda (p)
+		(unless (positive? p)
+		  (display 'oops)))
+	      v)))
+
+(define fgv (make-float-vector 100 1.0))
+(f25 fgv)
+
+
+(define (f26 v1 v2)
+  (for-each (lambda (p q)
+	      (if (not (= p q))
+		  (display 'oops))) ;(format *stderr* "f2: ~S ~S~%" p q)))
+	    v1 v2))
+(f26 fv iv)
+
+(define (f27 lst v)
+  (for-each (lambda (p q)
+	      (if (equal? p q)
+		  (display 'oops))) ;(format *stderr* "f1: ~S ~S~%" p q)))
+	    lst v))
+(f27 lst nv)
+
+(define (f28)
+  (do ((p lst (cdr p))
+       (i 0 (+ i 1)))
+      ((null? p))
+    (set-car! p i))
+  (map + lst lst))
+(f28)
+
+(define (f29)
+  (let ((str (make-string 100 #\a)))
+    (set! (str 50) #\b)
+    (do ((i 0 (+ i 1)))
+	((= i 30000))
+      (map char->integer str))))
+(f29)
+
+(define (f30)
+  (do ((i 0 (+ i 1)))
+      ((= i 30))
+    (map pair? lst)))
+(f30)
+
+(newline)
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(exit)
diff --git a/s7/tools/tmat.scm b/s7/tools/tmat.scm
new file mode 100755
index 0000000..25450e3
--- /dev/null
+++ b/s7/tools/tmat.scm
@@ -0,0 +1,268 @@
+;; timing test for generalized ref/set!
+
+(define invert-matrix
+  (let ((+documentation+ "(invert-matrix matrix b (zero 1.0e-7)) inverts 'matrix'"))
+    (lambda* (matrix b (zero 1.0e-7))
+      ;; translated from Numerical Recipes (gaussj)
+      (call-with-exit
+       (lambda (return)
+	 (let ((n (vector-dimension matrix 0)))
+	   (let ((cols (make-int-vector n))
+		 (rows (make-int-vector n))
+		 (pivots (make-int-vector n)))
+	     (do ((i 0 (+ i 1))
+		  (col 0 0)
+		  (row 0 0))
+		 ((= i n))
+	       (do ((biggest 0.0)
+		    (j 0 (+ j 1)))
+		   ((= j n)
+		    (if (< biggest zero) 
+			(return #f)))
+		 (if (not (= (pivots j) 1))
+		     (do ((k 0 (+ k 1)))
+			 ((= k n))
+		       (if (= (pivots k) 0)
+			   (let ((val (abs (matrix j k))))
+			     (when (> val biggest)
+			       (set! col k)
+			       (set! row j)
+			       (set! biggest val)))
+			   (if (> (pivots k) 1)
+			       (return #f))))))
+	       (set! (pivots col) (+ (pivots col) 1))
+	       (if (not (= row col))
+		   (let ((temp (if (sequence? b) (b row) 0.0)))
+		     (when (sequence? b)
+		       (set! (b row) (b col))
+		       (set! (b col) temp))
+		     (do ((k 0 (+ k 1)))
+			 ((= k n))
+		       (set! temp (matrix row k))
+		       (set! (matrix row k) (matrix col k))
+		       (set! (matrix col k) temp))))
+	       (set! (cols i) col)
+	       (set! (rows i) row)
+	       ;; round-off troubles here
+	       (if (< (abs (matrix col col)) zero)
+		   (return #f))
+	       (let ((inverse-pivot (/ 1.0 (matrix col col))))
+		 (set! (matrix col col) 1.0)
+		 (do ((k 0 (+ k 1)))
+		     ((= k n))
+		   (set! (matrix col k) (* inverse-pivot (matrix col k))))
+		 (if b (set! (b col) (* inverse-pivot (b col)))))
+	       (do ((k 0 (+ k 1)))
+		   ((= k n))
+		 (if (not (= k col))
+		     (let ((scl (matrix k col)))
+		       (set! (matrix k col) 0.0)
+		       (do ((m 0 (+ 1 m)))
+			   ((= m n))
+			 (set! (matrix k m) (- (matrix k m) (* scl (matrix col m)))))
+		       (if b (set! (b k) (- (b k) (* scl (b col)))))))))
+	     (do ((i (- n 1) (- i 1)))
+		 ((< i 0))
+	       (if (not (= (rows i) (cols i)))
+		   (do ((k 0 (+ k 1)))
+		       ((= k n))
+		     (let ((temp (matrix k (rows i))))
+		       (set! (matrix k (rows i)) (matrix k (cols i)))
+		       (set! (matrix k (cols i)) temp)))))
+	     (list matrix b))))))))
+
+
+(define (matrix-multiply A B)
+  (let ((size (vector-dimension A 0)))
+    (do ((C (make-float-vector (list size size)))
+         (i 0 (+ i 1)))
+	((= i size) C)
+      (do ((j 0 (+ j 1)))
+	  ((= j size))
+	(do ((sum 0.0)
+             (k 0 (+ k 1)))
+	    ((= k size)
+             (set! (C i j) sum))
+	  (set! sum (+ sum (* (A i k) (B k j)))))))))
+
+
+;;; Rosetta scheme code + changes
+(define (square-matrix mat)
+  (matrix-multiply mat mat))
+
+(define (matrix-exp mat pow)
+  (cond ((= pow 0)
+	 (let ((m (copy mat)))
+	   (fill! m 0.0)
+	   (let ((size (car (vector-dimensions mat))))
+	     (do ((i 0 (+ i 1)))
+		 ((= i size) m)
+	       (set! (m i i) 1.0)))))
+	  
+	  ((= pow 1) 
+	   mat)
+
+	  ((negative? pow)
+	   (let ((im (invert-matrix (matrix-exp mat (abs pow)))))
+	     (and (pair? im)
+		  (car im))))
+
+	  ((even? pow)
+	   (square-matrix (matrix-exp mat (ash pow -1))))
+	  
+	  (else
+	   (matrix-multiply mat (matrix-exp mat (- pow 1))))))
+
+(define (testm)
+  (do ((i 0 (+ i 1)))
+      ((= i 10000))
+    (let ((v (make-float-vector '(4 4)))
+	  (pow (+ 1 (random 10))))
+      (do ((k 0 (+ k 1)))
+	  ((= k 4))
+	(do ((n 0 (+ n 1)))
+	    ((= n 4))
+	  (set! (v k n) (- (random 50.0) 100.0))))
+      (let ((mn (matrix-exp (copy v) (- pow))))
+	(if mn
+	    (let* ((m1 (matrix-multiply mn (matrix-exp (copy v) pow)))
+		   (mx1 (m1 0 0))
+		   (mx0 0.0))
+	      (do ((k 1 (+ k 1)))
+		  ((= k 4))
+		(if (> (abs (- (m1 k k) 1.0)) (abs (- mx1 1.0)))
+		    (set! mx1 (m1 k k))))
+	      (do ((k 0 (+ k 1)))
+		  ((= k 4))
+		(do ((n 0 (+ n 1)))
+		    ((= n 4))
+		  (unless (= k n)
+		    (set! mx0 (max mx0 (abs (m1 k n)))))))))))))
+  
+(testm)
+
+;;; --------------------------------------------------------------------------------
+
+(define flarray #r2d((0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20) 
+		     (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20)
+		     (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20)
+		     (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20)
+		     (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20)
+		     (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20)
+		     (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20)))
+
+(define tfl #r2d((0 0 0 0 0 0 0) (1 1 1 1 1 1 1) (2 2 2 2 2 2 2) (3 3 3 3 3 3 3) 
+		 (4 4 4 4 4 4 4) (5 5 5 5 5 5 5) (6 6 6 6 6 6 6) (7 7 7 7 7 7 7) 
+		 (8 8 8 8 8 8 8) (9 9 9 9 9 9 9) (10 10 10 10 10 10 10) (11 11 11 11 11 11 11)
+		 (12 12 12 12 12 12 12) (13 13 13 13 13 13 13) (14 14 14 14 14 14 14) (15 15 15 15 15 15 15)
+		 (16 16 16 16 16 16 16) (17 17 17 17 17 17 17) (18 18 18 18 18 18 18) (19 19 19 19 19 19 19) (20 20 20 20 20 20 20)))
+
+(define narray #2d((0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20) 
+		     (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20)
+		     (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20)
+		     (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20)
+		     (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20)
+		     (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20)
+		     (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20)))
+
+(define tna #2d((0 0 0 0 0 0 0) (1 1 1 1 1 1 1) (2 2 2 2 2 2 2) (3 3 3 3 3 3 3) 
+		 (4 4 4 4 4 4 4) (5 5 5 5 5 5 5) (6 6 6 6 6 6 6) (7 7 7 7 7 7 7) 
+		 (8 8 8 8 8 8 8) (9 9 9 9 9 9 9) (10 10 10 10 10 10 10) (11 11 11 11 11 11 11)
+		 (12 12 12 12 12 12 12) (13 13 13 13 13 13 13) (14 14 14 14 14 14 14) (15 15 15 15 15 15 15)
+		 (16 16 16 16 16 16 16) (17 17 17 17 17 17 17) (18 18 18 18 18 18 18) (19 19 19 19 19 19 19) (20 20 20 20 20 20 20)))
+
+(define tries 10000)
+(set! (*s7* 'print-length) 123123)
+
+(define (matrix-transpose mat)
+  (let* ((dims (vector-dimensions mat))
+	 (new-mat (make-vector (reverse dims)))
+	 (end1 (car dims))
+	 (end2 (cadr dims)))
+    (do ((i 0 (+ i 1)))
+	((= i end1) new-mat)
+      (do ((j 0 (+ j 1)))
+	  ((= j end2))
+	(set! (new-mat j i) (mat i j))))))
+
+(unless (equal? (matrix-transpose narray) tna)
+  (format *stderr* "tna: ~S~%" (matrix-transpose narray)))
+
+(define (test-transpose)
+  (do ((i 0 (+ i 1)))
+      ((= i  tries))
+    (matrix-transpose narray)))
+
+(test-transpose)
+
+
+(define (matrix-transpose1 mat)
+  (let* ((dims (vector-dimensions mat))
+	 (new-mat (make-vector (reverse dims)))
+	 (end1 (car dims))
+	 (end2 (cadr dims)))
+    (do ((i 0 (+ i 1)))
+	((= i end1) new-mat)
+      (do ((j 0 (+ j 1)))
+	  ((= j end2))
+	(vector-set! new-mat j i (vector-ref mat i j))))))
+
+(unless (equal? (matrix-transpose1 narray) tna)
+  (format *stderr* "tna1: ~S~%" (matrix-transpose1 narray)))
+
+(define (test-transpose1)
+  (do ((i 0 (+ i 1)))
+      ((= i tries))
+    (matrix-transpose1 narray)))
+
+(test-transpose1)
+
+
+(define (float-matrix-transpose mat)
+  (let* ((dims (vector-dimensions mat))
+	 (new-mat (make-float-vector (reverse dims)))
+	 (end1 (car dims))
+	 (end2 (cadr dims)))
+    (do ((i 0 (+ i 1)))
+	((= i end1) new-mat)
+      (do ((j 0 (+ j 1)))
+	  ((= j end2))
+	(set! (new-mat j i) (mat i j))))))
+
+(unless (equal? (float-matrix-transpose flarray) tfl)
+  (format *stderr* "tfl: ~S~%" (float-matrix-transpose flarray)))
+
+(define (test-float-transpose)
+  (do ((i 0 (+ i 1)))
+      ((= i tries))
+    (float-matrix-transpose flarray)))
+
+(test-float-transpose)
+
+
+(define (float-matrix-transpose1 mat)
+  (let* ((dims (vector-dimensions mat))
+	 (new-mat (make-float-vector (reverse dims)))
+	 (end1 (car dims))
+	 (end2 (cadr dims)))
+    (do ((i 0 (+ i 1)))
+	((= i end1) new-mat)
+      (do ((j 0 (+ j 1)))
+	  ((= j end2))
+	(float-vector-set! new-mat j i (float-vector-ref mat i j))))))
+
+(unless (equal? (float-matrix-transpose1 flarray) tfl)
+  (format *stderr* "tfl1: ~S~%" (float-matrix-transpose1 flarray)))
+
+(define (test-float-transpose1)
+  (do ((i 0 (+ i 1)))
+      ((= i tries))
+    (float-matrix-transpose1 flarray)))
+
+(test-float-transpose1)
+
+
+
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(exit)
diff --git a/s7/tools/tmisc.scm b/s7/tools/tmisc.scm
new file mode 100644
index 0000000..b72006e
--- /dev/null
+++ b/s7/tools/tmisc.scm
@@ -0,0 +1,635 @@
+(set! (*s7* 'heap-size) (* 2 1024000))
+
+;;; -------- for-each and map --------
+
+(define (fe-test size)
+  (let ((str (make-string size #\a)))
+    (for-each char-alphabetic? str)
+    (for-each (lambda (c) (char-alphabetic? c)) str))
+
+  (let ((byt (make-byte-vector size 10)))
+    (for-each abs byt)
+    (for-each (lambda (b) (abs b)) byt))
+
+  (let ((byt (make-int-vector size 10)))
+    (for-each abs byt)
+    (for-each (lambda (b) (abs b)) byt))
+
+  (let ((byt (make-float-vector size 10)))
+    (for-each abs byt)
+    (for-each (lambda (b) (abs b)) byt))
+
+  (let ((byt (make-vector size 10)))
+    (for-each abs byt)
+    (for-each (lambda (b) (abs b)) byt))
+
+  (let ((lst (make-list size 10)))
+    (for-each abs lst)
+    (for-each (lambda (b) (abs b)) lst))
+
+  (when (defined? 'make-block)
+    (let ((byt (make-block size 10)))
+      (for-each abs byt)
+      (for-each (lambda (b) (abs b)) byt)))
+  )
+
+(fe-test 3000000)
+
+(define (map-test size)
+  (let* ((str (make-string size #\a))
+	 (result (apply string (map (lambda (c) #\b) str))))
+    (unless (string=? result (make-string size #\b))
+      (format *stderr* "map string failed\n")))
+
+  (let* ((str (make-byte-vector size 10))
+	 (result (apply byte-vector (map (lambda (c) 11) str))))
+    (unless (equal? result (make-byte-vector size 11))
+      (format *stderr* "map byte-vector failed\n")))
+
+  (let* ((str (make-int-vector size 10))
+	 (result (apply int-vector (map (lambda (c) 11) str))))
+    (unless (equal? result (make-int-vector size 11))
+      (format *stderr* "map int-vector failed\n")))
+
+  (let* ((str (make-float-vector size 10))
+	 (result (apply float-vector (map (lambda (c) 11) str))))
+    (unless (equal? result (make-float-vector size 11))
+      (format *stderr* "map float-vector failed\n")))
+
+  (let* ((str (make-vector size 10))
+	 (result (apply vector (map (lambda (c) 11) str))))
+    (unless (equal? result (make-vector size 11))
+      (format *stderr* "map vector failed\n"))))
+
+(map-test 500000)
+
+
+(define size 500000)
+
+;;; -------- let-temporarily --------
+(define (w1 x)
+  (let ((y x))
+    (do ((j 0 (+ j 1)))
+	((= j 1))
+      (do ((i 0 (+ i 1)))
+	  ((= i size))
+	(let-temporarily ((y 32))
+	  (unless (= y 32)
+	    (format *stderr* "temp y: ~A~%" y)))
+	(unless (= y x)
+	  (format *stderr* "y: ~A~%" y))))))
+
+(define-constant (w2)
+  (let ((x 1))
+    (let ((y (let-temporarily ((x 32))
+	       (+ x 1))))
+      (+ x y))))
+
+(define-constant (w3)
+  (let ((x 1)
+	(y 2))
+    (let ((z (let-temporarily ((x 6) (y 7))
+	       (+ x y))))
+      (+ x y z))))
+
+(define (w4)
+  (let ((y (let-temporarily (((*s7* 'print-length) 32))
+	     (*s7* 'print-length))))
+    (+ y 1)))
+
+(define (wtest)
+  (w1 3)
+  (unless (= (w2) 34) (format *stderr* "w2 got ~S~%" (w2)))
+  (unless (= (w3) 16) (format *stderr* "w3 got ~S~%" (w3)))
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (w2)
+    (w3)))
+
+
+;;; -------- implicit/generalized set! --------
+
+(define (fs1)
+  (let-temporarily (((*s7* 'print-length) 8))
+    123))
+
+(define (fs2)
+  (let ((x 32)) 
+    (set! ((curlet) 'x) 3)
+    x))
+
+(define (fs3)
+  (set! (with-let (curlet) (*s7* 'print-length)) 16)
+  (*s7* 'print-length))
+
+(define (fs4)
+  (let ((e (inlet :v (vector 1 2))))
+    (set! (with-let e (v 0)) 'a)
+    (e 'v)))
+
+(define (fs5)
+  (let ((v (vector (inlet 'a 0))))
+    (set! (v 0 'a) 32)
+    ((v 0) 'a)))
+
+(define (fs6)
+  (let ((e (inlet 'x (inlet 'b 2))))
+    (set! (e 'x 'b) 32)
+    ((e 'x) 'b)))
+
+(define (fs7)
+  (let ((L (list (list 1 2)))) 
+    (set! (L 0 0) 3)
+    L))
+
+(define (fs8)
+  (let ((H (hash-table 'a (hash-table 'b 2))))
+    (set! (H 'a 'b) 32)
+    ((H 'a) 'b)))
+
+(define (fs9)
+  (let ((v (vector 1 2)))
+    (let-temporarily (((v 1) 32))
+      (v 1))))
+
+(define fs10
+  (let ((val 0))
+    (let ((fs (dilambda (lambda () val) (lambda (v) (set! val v)))))
+      (lambda ()
+	(set! (fs) 32)
+	(fs)))))
+
+    
+(define (tf)
+  (do ((i 0 (+ i 1)))
+      ((= i 150000))
+    (fs1)
+    (fs2)
+    (fs3)
+    (fs4)
+    (fs5)
+    (fs6)
+    (fs7)
+    (fs8)
+    (fs9)
+    (fs10)
+    ))
+
+(tf)
+
+
+;;; -------- => --------
+(define-constant (f1)
+  (cond (-2 => abs)))
+
+(define-constant (x+1 x) 
+  (+ x 1))
+
+(define-constant (f2)
+  (cond (32 => x+1)))
+
+(define* (x+y x (y 2))
+  (+ x y))
+
+(define-constant (f3 z)
+  (cond ((if z 1 3) => x+y)))
+
+(define-constant (f4)
+  (cond ((random 1) => "asdf")))
+
+(define (xs)
+  (values 1 2 3))
+
+(define-constant (f5)
+  (do ((i 0 (+ i 1))) ((xs) => +)))
+
+(define-constant (f6 x)
+  (case x ((1) 2) (else => abs)))
+
+(define (ftest)
+  (unless (= (f1) 2) (format *stderr* "f1 got ~S~%" (f1)))
+  (unless (= (f2) 33) (format *stderr* "f2 got ~S~%" (f2)))
+  (unless (= (f3 #t) 3) (format *stderr* "(f3 #t) got ~S~%" (f3 #t)))
+  (unless (= (f3 #f) 5) (format *stderr* "(f3 #f) got ~S~%" (f3 #f)))
+  (unless (char=? (f4) #\a) (format *stderr* "(f4) got ~S~%" (f4)))
+  (unless (= (f5) 6) (format *stderr* "(f5) got ~S~%" (f5)))
+  (unless (= (f6 -2) 2) (format *stderr* "(f6 -2) got ~S~%" (f6 -2)))
+
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (f1)
+    (f2)
+    (f3 #t)
+    (f4)
+    (f5)
+    (f6 -2)))
+
+(ftest)
+(wtest)
+
+
+;;; -------- typers --------
+(let ()
+  (define (10-or-12? val)
+    (and (integer? val) ; hmmm -- this is faster than (memv val '(10 12))
+	 (or (= val 10) 
+	     (= val 12))))
+  
+  (define (symbol-or-integer? key)
+    (or (symbol? key)
+	(integer? key)))
+  
+  (define (a? k1 k2) (eq? k1 k2))
+  (define (a->int key) 0)
+  
+  (define h0 (make-hash-table 8 #f (cons #t integer?)))
+  (define h1 (make-hash-table 8 #f (cons #t 10-or-12?)))
+  (define h2 (make-hash-table 8 #f (cons symbol? integer?)))
+  (define h3 (make-hash-table 8 #f (cons symbol-or-integer? 10-or-12?)))
+  (define h4 (make-hash-table 8 (cons a? a->int) (cons symbol? integer?)))
+  (define h5 (make-hash-table 8 char=? (cons char? integer?)))
+  
+  (define v0 (make-vector 3 'x symbol?))
+  (define v1 (make-vector 3 10 10-or-12?))
+  
+  (define e0 (let ((a 10))
+	       (set! (setter 'a) integer?)
+	       (curlet)))
+  
+  (define e1 (let ((a 10))
+	       (set! (setter 'a) (lambda (s v)
+				   (if (10-or-12? v)
+				       v
+				       (error 'wrong-type-arg "~S is not 10 or 12?" v))))
+	       (curlet)))
+  
+  (define (test tests)
+    (do ((i 0 (+ i 1)))
+	((= i tests))
+      (set! (h0 'a) 123)
+      (set! (h1 'a) 10)
+      (set! (h2 'a) 123)
+      (set! (h3 'a) 12)
+      (set! (h4 'a) 0)
+      (set! (h5 #\a) 123)
+      (set! (v0 0) 'a)
+      (set! (v1 0) 12)
+      (set! (e0 'a) 12)
+      (set! (e1 'a) 12)))
+  
+  (test 100000))
+
+
+;;; typer optimization tests
+
+(define typer-size 1000000)
+
+;; -------- int-vector
+(define (iv1) ; 77.9 -> 59.0 (no make-integer)
+  (let ((v (make-vector typer-size 1 integer?))
+	(sum 0))
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (set! sum (+ sum (vector-ref v i))))
+    (unless (= sum typer-size) (format *stderr* "sum: ~D~%" sum))))
+
+(define (iv2) ; 77.9 -> 59.0 (no make-integer)
+  (let ((v (make-int-vector typer-size 1))
+	(sum 0))
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (set! sum (+ sum (int-vector-ref v i)))) ; but TODO: this still makes integers (not safe stepper?! in opt_dotimes)
+    (unless (= sum typer-size) (format *stderr* "sum: ~D~%" sum))))
+
+(define (iv3) ; 201.6 -- twice as slow as h1 because mark_vector is slow, 196.2 if new mark_vector_1
+  (let ((v (make-vector typer-size 1))
+	(sum 0))
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (set! sum (+ sum (vector-ref v i))))
+    (unless (= sum typer-size) (format *stderr* "sum: ~D~%" sum))))
+
+(define (ih1) ; 112.7 -- fails i_7pi_ok
+  (let ((h (make-hash-table 8 #f (cons symbol? integer?)))
+	(sum 0))
+    (hash-table-set! h 'a 1)
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (set! sum (+ sum (hash-table-ref h 'a)))) ; this is independent of i...
+    (unless (= sum typer-size) (format *stderr* "sum: ~D~%" sum))))
+
+(define (iv4) ; 29.6
+  (let ((v (make-vector typer-size 1 integer?))) ; this creates an int-vector! so iv4 == iv7
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (if (= (vector-ref v i) 0)
+	  (display "oops")))))
+
+(define (iv5) ; 29.6
+  (let ((v (make-int-vector typer-size 1)))
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (if (= (int-vector-ref v i) 0)
+	  (display "oops")))))
+
+(define (iv6) ; 44.6
+  (let ((v (make-vector typer-size 1)))
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (if (= (vector-ref v i) 0)
+	  (display "oops")))))
+
+(define (iv7) ; 29.6
+  (let ((v (make-int-vector typer-size 1)))
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (if (= (vector-ref v i) 0) ; opt_i_7pi_ss + opt_b_ii_fc_eq, opt_dotimes and opt_i_pi_ss_ivref which is direct
+	  (display "oops")))))
+
+
+;; -------- float-vector
+(define (fv1) ; 113.6 -> 97.2 via d_7pi_ok -> 85.2
+  (let ((v (make-vector typer-size 1.0 float?))
+	(sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (set! sum (+ sum (vector-ref v i))))
+    (unless (= sum typer-size) (format *stderr* "sum: ~D~%" sum))))
+
+(define (fv2) ; 93.2 -> 85.2 opt_float_any_nv removed -> 66 (no make-integer)
+  (let ((v (make-float-vector typer-size 1.0))
+	(sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (set! sum (+ sum (float-vector-ref v i))))  ; float_vector_ref_d_pi_direct, but TODO: this still makes integers (not safe stepper?! in opt_dotimes)
+    (unless (= sum typer-size) (format *stderr* "sum: ~D~%" sum))))
+
+(define (fv3) ; 197.8 192.3
+  (let ((v (make-vector typer-size 1.0))
+	(sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (set! sum (+ sum (vector-ref v i))))
+    (unless (= sum typer-size) (format *stderr* "sum: ~D~%" sum))))
+
+(define (fh1) ; 108.9
+  (let ((h (make-hash-table 8 #f (cons symbol? float?)))
+	(sum 0.0))
+    (hash-table-set! h 'a 1.0)
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (set! sum (+ sum (hash-table-ref h 'a)))) ; this is independent of i...
+    (unless (= sum typer-size) (format *stderr* "sum: ~D~%" sum))))
+
+(define (fv4) ; 77.8 -> 40.75 via d_7pi_ok
+  (let ((v (make-vector typer-size 1.0 float?))) ; this creates a float-vector! so v4 == v7
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (if (= (vector-ref v i) 0.0)
+	  (display "oops")))))
+
+(define (fv5) ; 40.75
+  (let ((v (make-float-vector typer-size 1.0)))
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (if (= (float-vector-ref v i) 0.0) ; opt_d_7pi_ss_fvref_direct + num_eq_b_dd
+	  (display "oops")))))
+
+(define (fv6) ; 57.75
+  (let ((v (make-vector typer-size 1.0)))
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (if (= (vector-ref v i) 0.0)
+	  (display "oops")))))
+
+(define (fv7) ; 77.8 -> 40.75 via d_7pi_ok
+  (let ((v (make-float-vector typer-size 1.0)))
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (if (= (vector-ref v i) 0.0)
+	  (display "oops")))))
+
+
+;; -------- byte-vector
+(define (bv1) ; 77.9 -> 58.7 (no make-integer)
+  (let ((v (make-vector typer-size 1 byte?))
+	(sum 0))
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (set! sum (+ sum (vector-ref v i))))
+    (unless (= sum typer-size) (format *stderr* "sum: ~D~%" sum))))
+
+(define (bv2) ; 77.9 -> 58.7 (no make-integer)
+  (let ((v (make-byte-vector typer-size 1))
+	(sum 0))
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (set! sum (+ sum (byte-vector-ref v i))))
+    (unless (= sum typer-size) (format *stderr* "sum: ~D~%" sum))))
+
+(define (bv3) ; 201.9
+  (let ((v (make-vector typer-size 1))
+	(sum 0))
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (set! sum (+ sum (vector-ref v i))))
+    (unless (= sum typer-size) (format *stderr* "sum: ~D~%" sum))))
+
+(define (bh1) ; 112.9
+  (let ((h (make-hash-table 8 #f (cons symbol? byte?)))
+	(sum 0))
+    (hash-table-set! h 'a 1)
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (set! sum (+ sum (hash-table-ref h 'a)))) ; this is independent of i...
+    (unless (= sum typer-size) (format *stderr* "sum: ~D~%" sum))))
+
+(define (bv4) ; 51.6 -> 29.7
+  (let ((v (make-vector typer-size 1 byte?)))
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (if (= (vector-ref v i) 0)
+	  (display "oops")))))
+
+(define (bv5) ; 72.6 -> 29.7 opt_arg_type
+  (let ((v (make-byte-vector typer-size 1)))
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (if (= (byte-vector-ref v i) 0)
+	  (display "oops")))))
+
+(define (bv6) ; 44.8
+  (let ((v (make-vector typer-size 1)))
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (if (= (vector-ref v i) 0)
+	  (display "oops")))))
+
+(define (bv7) ; 51.6 -> 29.7
+  (let ((v (make-byte-vector typer-size 1)))
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (if (= (vector-ref v i) 0)
+	  (display "oops")))))
+
+(define (bv8) ; 53.6
+  (let ((v (make-byte-vector typer-size 1))
+	(typer-size/2 (/ typer-size 2)))
+    (do ((i (- typer-size/2) (+ i 1)))
+	((= i typer-size/2))
+      (if (= (vector-ref v (+ i typer-size/2)) 0)
+	  (display "oops")))))
+
+(define (bv9) ; 68.9
+  (let ((v (make-vector typer-size 1))
+	(typer-size/2 (/ typer-size 2)))
+    (set! (vector-typer v) integer?)
+    (do ((i (- typer-size/2) (+ i 1)))
+	((= i typer-size/2))
+      (if (= (vector-ref v (+ i typer-size/2)) 0)
+	  (display "oops")))))
+
+
+;; -------- string?
+
+(define (sv1) ; 41.6 -> 31.6, opt_p_c -> opt_b_pp_fc_char_eq
+  (let ((v (make-string typer-size #\a)))
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (if (char=? (string-ref v i) #\b) ; opt_b_pp_ff_char_eq + opt_p_pi_ss_sref_direct in opt_dotimes
+	  (display "oops")))))
+
+(define (sv2) ; 74.9 [uses opt_b_pp_fc_char_eq, string_ref_p_pp+string_ref_1 (typer ignored?), opt_p_pi_sc for (unchanging) vector-ref]
+  (let ((v (make-vector 1 (make-string typer-size #\a) string?)))
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (if (char=? (string-ref (vector-ref v 0) i) #\b)
+	  (display "oops")))))
+
+(define (sv3) ; 58.0 via opt_b_pp_ff opt_p_pi_ss_vref_direct string_eq_b_unchecked [so it sees the typer?] -> 53.0 (fc case)
+  (let ((v (make-vector typer-size "a" string?)))
+    (do ((i 0 (+ i 1)))
+	((= i typer-size))
+      (if (string=? (vector-ref v i) "b")
+	  (display "oops")))))
+
+(define (try-all) ; 2046  1924(opt_dotimes)
+  (iv1) (iv2) (iv3) (iv4) (iv5) (iv6) (iv7)
+  (ih1)
+  (fv1) (fv2) (fv3) (fv4) (fv5) (fv6) (fv7)
+  (fh1)
+  (bv1) (bv2) (bv3) (bv4) (bv5) (bv6) (bv7) (bv8) (bv9)
+  (bh1)
+  (sv1) (sv2) (sv3)
+  )
+
+(try-all)
+
+
+
+;;; -------- built-ins via #_ --------
+
+(define (u0)
+  (do ((i 0 (+ i 1)))
+      ((= i 100000) (#_list))
+    (#_list)))
+
+(unless (null? (u0)) (format *stderr* "u0: ~S~%" (u0)))
+
+(define (u1)
+  (do ((i 0 (+ i 1)))
+      ((= i 1000000) (#_length "asdfghjklijk"))
+    (#_length "asdfghjklijk")))
+
+(unless (eqv? (u1) 12) (format *stderr* "u1: ~S~%" (u1)))
+
+(define (u2)
+  (let ((str "asdfghjklijk"))
+    (do ((i 0 (+ i 1)))
+	((= i 100000) (#_char-position #\h str))
+      (#_char-position #\h str))))
+
+(unless (eqv? (u2) 5) (format *stderr* "u2: ~S~%" (u2)))
+
+(define (u3)
+  (do ((i 0 (+ i 1)))
+      ((= i 1000000) (#_+ i (* -2 i) i))
+    (#_+ i (* -2 i) i)))
+
+(unless (eqv? (u3) 0) (format *stderr* "u3: ~S~%" (u3)))
+
+
+;;; -------- methods --------
+
+(unless (provided? 'pure-s7)
+
+  (define (m5 str)
+    (let ((L (openlet (inlet :length (lambda (s) (+ 2 (#_string-length str)))))))
+      (do ((i 0 (+ i 1)))
+	  ((= i 1000000) (length L))
+	(length L))))
+  
+  (unless (eqv? (m5 "asdfghjklijk") 14) (format *stderr* "m5: ~S~%" (m5 "asdfghjklijk")))
+  
+  (define (m6 str)
+    (let ((L (openlet (inlet :str str :length (lambda (s) (+ 2 (#_string-length s)))))))
+      (do ((i 0 (+ i 1)))
+	  ((= i 1000000) (with-let L (length str)))
+	(with-let L
+	  (length str)))))
+  
+  (unless (eqv? (m6 "asdfghjklijk") 14) (format *stderr* "m6: ~S~%" (m6 "asdfghjklijk"))))
+
+(define (m7)
+  (let ((L (openlet (inlet :+ (lambda (x y) (#_+ x y 1))))))
+    (do ((i 0 (+ i 1)))
+	((= i 500000) ((L :+) 2 3))
+      ((L :+) 2 3))))
+
+(unless (eqv? (m7) 6) (format *stderr* "m7: ~S~%" (m7)))
+
+(define (m8)
+  (let ((L (openlet (inlet :+ (lambda args (apply #_+ 1 args))))))
+    (do ((i 0 (+ i 1)))
+	((= i 500000) (with-let L (+ 2 3)))
+      (with-let L (+ 2 3)))))
+
+(unless (eqv? (m8) 6) (format *stderr* "m8: ~S~%" (m8)))
+
+
+;;; -------- unlet --------
+;;; incrementally set all globals to 42 -- check that unlet exprs return the same results
+
+(when (zero? (*s7* 'profile))
+  (let* ((syms (symbol-table))
+	 (num-syms (length syms))
+	 (orig-x (*s7* 'print-length)))
+    
+    (define (unlet-test i)
+      (with-let (unlet)
+	(catch #t
+	  (lambda ()
+	    (eval `(define ,(syms i) 42))
+	    (when (procedure? (symbol->value (syms i) (rootlet)))
+	      (with-let (unlet)
+		(eval `(set! ,(syms i) 42) (rootlet)))))
+	  (lambda (type info)
+	    #f)))
+      
+      (with-let (unlet)
+	(do ((k 0 (+ k 1)))
+	    ((= k 1000))
+	  (catch #t
+	    (lambda ()
+	      (let ((x (+ k (*s7* 'print-length))))
+		(unless (eqv? x (+ k orig-x))
+		  (format *stderr* "sym: ~S, x: ~S, orig: ~S~%" (syms i) x (+ k orig-x)))))
+	    (lambda (type info)
+	      (format *stderr* "sym: ~S, error: ~S~%" (syms i) (apply format #f info)))))))
+
+    (do ((i 0 (#_+ i 1))) ; "do" is not a procedure (see above) so it's not in danger here
+	((#_= i num-syms))
+      (unlet-test i))))
+
+
+(#_exit) ; we just clobbered exit above
diff --git a/s7/tools/tmock.scm b/s7/tools/tmock.scm
new file mode 100644
index 0000000..24ccc8c
--- /dev/null
+++ b/s7/tools/tmock.scm
@@ -0,0 +1,174 @@
+;;; mock data (method call) timing test
+
+(set! (*s7* 'heap-size) 2048000)
+(load "mockery.scm")
+
+(define mock-number (*mock-number* 'mock-number))
+(define mock-string (*mock-string* 'mock-string))
+(define make-mock-vector (*mock-vector* 'make-mock-vector))
+(define make-mock-hash-table (*mock-hash-table* 'make-mock-hash-table))
+
+
+(define dolph-1
+  (let ((+documentation+ "(dolph-1 n gamma) produces a Dolph-Chebyshev FFT data window of 'n' points using 'gamma' as the window parameter."))
+    (lambda (N gamma)
+      (let ((vals (make-vector N)))
+	(let ((alpha (cosh (/ (acosh (expt 10.0 gamma)) N))))
+	  (do ((den (/ 1.0 (cosh (* N (acosh alpha)))))
+	       (freq (/ pi N))
+	       (mult -1 (- mult))
+	       (i 0 (+ i 1))
+	       (phase (* -0.5 pi)))
+	      ((= i N))
+	    (set! (vals i) (* mult den (cos (* N (acos (* alpha (cos phase)))))))
+	    (set! phase (+ phase freq))))
+	;; now take the DFT
+	(let ((pk 0.0)
+	      (w (make-vector N)))
+	  (do ((i 0 (+ i 1))
+	       (sum 0.0 0.0))
+	      ((= i N))
+	    (do ((k 0 (+ k 1))
+		 (pii (* pi 0+2.0i)))
+		((= k N))
+	      (set! sum (+ sum (* (vals k) (exp (/ (* pii k i) N))))))
+	    (set! (w i) (magnitude sum))
+	    (set! pk (max pk (w i))))
+	  ;; scale to 1.0 (it's usually pretty close already, that is pk is close to 1.0)
+	  (do ((i 0 (+ i 1)))
+	      ((= i N))
+	    (set! (w i) (/ (w i) pk)))
+	  w)))))
+
+(display (dolph-1 (expt 2 8) 0.5)) (newline)
+(display (dolph-1 (mock-number (expt 2 8)) (mock-number 0.5))) (newline)
+
+
+(define src-duration
+  (let ((+documentation+ "(src-duration envelope) returns the new duration of a sound after using 'envelope' for time-varying sampling-rate conversion"))
+    (lambda (e)
+      (let ((len (- (length e) 2)))
+	(do ((all-x (- (e len) (e 0))) ; last x - first x
+	     (dur 0.0)
+	     (i 0 (+ i 2)))
+	    ((>= i len) dur)
+	  (let ((area (let ((x0 (e i))
+			    (x1 (e (+ i 2)))
+			    (y0 (e (+ i 1))) ; 1/x x points
+			    (y1 (e (+ i 3))))
+			(if (< (abs (real-part (- y0 y1))) .0001)
+			    (/ (- x1 x0) (* y0 all-x))
+			    (/ (* (log (/ y1 y0)) 
+				  (- x1 x0)) 
+			       (* (- y1 y0) all-x))))))
+	    (set! dur (+ dur (abs area)))))))))
+
+(display (src-duration (float-vector 0 1  .1 1  .2 .6  .5 .9  1 .5))) (newline)
+(display (src-duration (apply vector (map mock-number '(0 1  .1 1  .2 .6  .5 .9  1 .5))))) (newline)
+
+
+(define* (cfft data n (dir 1))
+  (if (not n) (set! n (length data)))
+  (do ((i 0 (+ i 1))
+       (j 0))
+      ((= i n))
+    (if (> j i)
+	(let ((temp (data j)))
+	  (set! (data j) (data i))
+	  (set! (data i) temp)))
+    (do ((m (/ n 2) (/ m 2)))
+	((or (< m 2) (< j m))
+	 (set! j (+ j m)))
+      (set! j (- j m))))
+  
+  (let ((ipow (floor (log n 2)))
+	(prev 1))
+    (do ((lg 0 (+ lg 1))
+	 (mmax 2 (* mmax 2))
+	 (pow (/ n 2) (/ pow 2))
+	 (theta (complex 0.0 (* pi dir)) (* theta 0.5)))
+	((= lg ipow))
+      (let ((wpc (exp theta))
+	    (wc 1.0))
+	(do ((ii 0 (+ ii 1)))
+	    ((= ii prev))
+	  (do ((jj 0 (+ jj 1))
+	       (i ii (+ i mmax))
+	       (j (+ ii prev) (+ j mmax)))
+	      ((>= jj pow))
+	    (let ((tc (* wc (data j))))
+	      (set! (data j) (- (data i) tc))
+	      (set! (data i) (+ (data i) tc))))
+	  (set! wc (* wc wpc)))
+	(set! prev mmax))))
+  
+  data)
+
+(define cfft-size 1024)
+(define cfft-data (make-vector cfft-size 0.0))
+(do ((i 1 (+ i 1))
+     (j (- cfft-size 1) (- j 1)))
+    ((= i (/ cfft-size 2)))
+  (set! (cfft-data i) (complex (- 1.0 (random 2.0)) (- 1.0 (random 2.0))))
+  (set! (cfft-data j) (complex (real-part (cfft-data i)) (- (imag-part (cfft-data i))))))
+(define cfft-mdata (copy cfft-data))
+
+(display (cfft cfft-data cfft-size)) (newline)
+
+(let ((mockdata (make-mock-vector cfft-size)))
+  (do ((i 0 (+ i 1)))
+      ((= i cfft-size))
+    (set! (mockdata i) (mock-number (cfft-mdata i))))
+  (display (cfft mockdata cfft-size)) (newline))
+
+
+(when (provided? 'pure-s7)
+  (define (string-length str)
+    (if (string? str)
+	(length str)
+	(if (openlet? str)
+	    ((let-ref str 'string-length) str)
+	    (error 'wrong-type-arg "string-length argument should be a string: ~A" str)))))
+
+(define (palindrome? str)
+  (or (< (string-length str) 2)
+      (and (char=? (string-ref str 0)
+		   (string-ref str (- (string-length str) 1)))
+	   (palindrome? (substring str 1 (- (string-length str) 1))))))
+
+(display (palindrome? "abcdefgfedcba")) (newline)
+(display (palindrome? (mock-string "abcdefgfedcba"))) (newline)
+
+
+(let ()
+  (define (walk p counts)
+    (if (pair? p)
+	(begin
+	  (walk (car p) counts)
+	  (if (pair? (cdr p))
+	      (walk (cdr p) counts)))
+	(hash-table-set! counts p (+ (or (hash-table-ref counts p) 0) 1))))
+  
+  (define (lint-reader counts)
+    (let ((port (open-input-file "lint.scm")))
+      (do ((expr (read port) (read port)))
+	  ((eof-object? expr)
+	   (close-input-port port)
+	   counts)
+	(walk expr counts))))
+  
+  (define (sort-counts counts)
+    (let ((len (hash-table-entries counts)))
+      (do ((v (make-vector len))
+	   (h (make-iterator counts))
+	   (i 0 (+ i 1)))
+	  ((= i len)
+	   (sort! v (lambda (e1 e2) (> (cdr e1) (cdr e2))))
+	   v)
+	(vector-set! v i (iterate h)))))
+  
+  (display (sort-counts (lint-reader (make-hash-table)))) (newline)
+  (display (sort-counts (lint-reader (make-mock-hash-table)))) (newline))
+
+
+(exit)
diff --git a/s7/tools/tmv.scm b/s7/tools/tmv.scm
new file mode 100644
index 0000000..b2dd9b2
--- /dev/null
+++ b/s7/tools/tmv.scm
@@ -0,0 +1,442 @@
+;;; multiple-values timing tests
+
+#|
+(define (ok? otst ola oexp)
+  (let ((result (catch #t ola
+		       (lambda (type info)
+			 (if (not (eq? oexp 'error))
+			     (begin (apply format #t info) (newline)))
+			 'error))))
+    (if (not (equal? result oexp))
+	(format #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) otst result oexp))))
+
+(define-macro (test tst expected) `(ok? ',tst (#_let () (define (_s7_) ,tst)) ,expected))
+|#
+
+
+;;; -------- multiple values from tmisc --------
+(define (mv1)
+  (+ (values 1 2 3)))
+(define (mv2)
+  (+ 1 (values 2 3)))
+(define (mv3)
+  (+ (values 1 2) 3))
+(define (mv4 x)
+  (+ x (values x x)))
+(define (mv5 x)
+  (+ (values x x) x))
+(define (mv-clo1 x y)
+  (+ x y))
+(define (mv6 x)
+  (mv-clo1 (values x 1)))
+(define (mv-clo2 . args)
+  (apply + args))
+(define (mv7 x)
+  (mv-clo2 (values x 1)))
+(define (mv8)
+  (+ (values 1 2 3) (values 3 -2 -1)))
+(define (mv9)
+  (+ 1 (values 2 3 4) -4))
+(define (mv11)
+  (+ 1 (values -1 2 4)))
+(define (mv12 x y)
+  (+ x y (values 2 3 4)))
+
+;;; pair_sym: (mv-clo (values x 1)), h_c_aa: (values x 1), splice_eval_args2 ([i] 1), eval_arg2->apply mv-clo! (loop below is safe_dotimes_step_p
+;;;   not enough args for mv-clo1? 
+;;; mv-clo2: closure_s_p -> pair_sym ->h_c_aa etc as above!
+;;;   perhaps apply_[safe_]closure?
+
+(define (mvtest)
+  (unless (= (mv1) 6) (format *stderr* "mv1: ~S~%" (mv1)))
+  (unless (= (mv2) 6) (format *stderr* "mv2: ~S~%" (mv2)))
+  (unless (= (mv3) 6) (format *stderr* "mv3: ~S~%" (mv3)))
+  (unless (= (mv4 2) 6) (format *stderr* "(mv4 2): ~S~%" (mv4 2)))
+  (unless (= (mv5 2) 6) (format *stderr* "(mv5 2): ~S~%" (mv5 2)))
+  (unless (= (mv6 5) 6) (format *stderr* "(mv6 5): ~S~%" (mv6 5)))
+  (unless (= (mv7 5) 6) (format *stderr* "(mv7 5): ~S~%" (mv7 5)))
+  (unless (= (mv8) 6) (format *stderr* "mv8: ~S~%" (mv8))) ; op_safe_c_pp_3|6_mv
+  (unless (= (mv9) 6) (format *stderr* "mv9: ~S~%" (mv9))) ; op_safe_c_3p_2|3_mv
+  (unless (= (mv11) 6) (format *stderr* "mv11: ~S~%" (mv11)))
+  (unless (= (mv12 -1 -2) 6) (format *stderr* "(mv12 -1 -2): ~S~%" (mv12 -1 -2)))
+  (do ((i 0 (+ i 1)))
+      ((= i 100000))
+    (mv1)
+    (mv2)
+    (mv3)
+    (mv4 i)
+    (mv5 i)
+    (mv6 i)
+    (mv7 i)
+    (mv8)
+    (mv9)
+    (mv11)
+    (mv12 -2 -1)
+    ))
+
+;(mvtest) ; [642] -> [578] -> [562] -> [492]
+
+
+(define len 1000000)
+
+(define (f0) ; 45 opt_dotimes values_p
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (unless (eq? (values) #<unspecified>)
+      (display "oops\n"))))
+;(f0)
+
+(define (f01) ; 40 opt_dotimes values_p_p
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (unless (= (values i) i)
+      (display "oops\n"))))
+;(f01)
+
+(define (f1 x) (+ x 1))
+(define (f02) ; 87 eval + fx_safe_closure_s_to_add1 -> 49 opt_dotimes + fx... (using cdr)??
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (f1 i)))
+;(f02)
+
+(define (f021) ; 129 opt_dotimes fx_safe_closure_a_to_sc (using car)
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (unless (= (f1 (abs i)) (+ i 1))
+      (display "oops\n"))))
+;(f021)
+
+(define (f0211) ; 95 using car
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (f1 (abs i))))
+;(f0211)
+
+(define (sum-1 n)
+  (let loop ((i n) (sum 0))
+    (if (< i 0)
+        sum
+        (loop (- i 1) (+ i sum)))))
+
+(define (f0212) ; 1435 op_tc_if_a_z_laa int+bool_optimize on every call!
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (unless (= (f1 (sum-1 3)) 7) ;(+ (+ 3 2 1) 1)
+      (display (f1 (sum-1 3))))))
+;(f0212)
+
+(define (f2) ; 179 op_c_s+list->fn_proc->eval+op_safe_closure_p_a! -> 119 if safe -> values_p_p, need to use opt1_con in op_set_s_c
+             ;   eval=op_safe_closure_a_to_sc -- fx is called by eval! op_safe_dotimes->step_o
+             ; -> 81 opt_dotimes using car as above
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (f1 (values i))))
+;(f2)
+
+(define (f022) ; 115 opt_dotimes fx_safe_closure_a_to_sc (using car)
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (unless (= (f1 (values i)) (+ i 1))
+      (display "oops\n"))))
+;(f022)
+
+(define (f3 x) (values x 1))
+(define (f4) ; 221 splice-in-values+eval+gc op_c_aa+op_closure_s_o: op_c_aa_unprotected if symbol\constant args? or better op_c_sc but is it worth an op?
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (f3 i)))
+;(f4)
+
+(define (f5 x y) (+ x y))
+
+(define (f6) ; 659 eval+gc+splice+add_p_pp  op_c_aa+closure_s_o->eval_args et al!  op_safe_closure_p?
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (f5 (f3 i))))
+;(f6)
+
+(define (f7) ; 394 same calls as above, op_c_aa as before
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (+ 1 (f3 i))))
+;(f7)
+
+(define (f8 . args) (apply + args))
+(define (f9) ; 1114 same as above
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (f8 (f3 i) (f3 (+ i 1)))))
+;(f9)
+;(display (f8 (f3 2) (f3 3))) (newline) ; 7
+
+(define (f10) ; 319 same as above
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (+ 1 (values i 1))))
+;(f10)
+
+(define (f11) ; 984
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (unless (= (+ 1 (values 2 (f3 i) 4)) (+ 8 i))
+      (display "oops\n"))))
+;(f11)
+
+#|
+291,046,404  s7.c:eval.isra.0 [/home/bil/motif-snd/repl]
+153,803,537  s7.c:add_p_pp [/home/bil/motif-snd/repl]
+ 95,000,606  s7.c:op_any_c_np_mv [/home/bil/motif-snd/repl]
+ 95,000,000  s7.c:splice_in_values [/home/bil/motif-snd/repl]
+ 93,751,344  s7.c:gc.isra.0 [/home/bil/motif-snd/repl]
+ 68,000,006  s7.c:op_any_c_np [/home/bil/motif-snd/repl]
+ 57,000,000  s7.c:g_add [/home/bil/motif-snd/repl]
+ 45,000,000  s7.c:copy_proper_list.part.0 [/home/bil/motif-snd/repl]
+ 23,000,583  /usr/include/x86_64-linux-gnu/bits/string_fortified.h:eval.isra.0
+ 16,000,000  s7.c:g_num_eq_2 [/home/bil/motif-snd/repl]
+|#
+
+(define (faddc) ; [607] -> [508 (no pair_append)] -> [384]
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (unless (= (+ (values 1 2 3) 4) 10)
+      (display "faddc oops\n" *stderr*))))
+
+;(faddc)
+
+
+(define (fadds) ; [620] -> [523] -> [396]
+  (let ((arg 4))
+    (do ((i 0 (+ i 1)))
+	((= i len))
+      (unless (= (+ (values 1 2 3) arg) 10)
+	(display "fadds oops\n" *stderr*)))))
+
+;(fadds)
+
+
+;(let () (define (func) (do ((x 0.0 (+ x 0.1)) (i 0 (+ i 1))) ((>= x 0.1) (#_with-baffle (inlet (values 1 2) (symbol? x)))))) (func)) */
+
+(define (fadda) ; [626] -> [554] -> [415]
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (unless (= (+ (values 1 2 3) (if (integer? i) 4 0)) 10) ; safe_c_pa_mv
+      (display "fadda oops\n" *stderr*))))
+
+;(fadda)
+
+
+(define (fadd1) ; [834] -> [736 (no pair_append)] -> [718]
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (unless (= (+ (values i (+ i 1) (+ i 2)) 4) (+ 7 (* i 3)))
+      (display "fadd1 oops\n" *stderr*))))
+
+;(fadd1)
+
+
+(define (fadda6) ; [1127 gc copy_proper_list make_list op_safe_c_pa_mv fx_c_opcsq_c] -> [1041] -> [1010]
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (unless (= (+ (values i (+ i 1) 2 3 4 5) (* 2 3)) (+ (* 2 i) 21)) ; op_safe_c_pa_mv > 3 mv vals
+      (display "fadda6 oops\n" *stderr*))))
+
+;(fadda6)
+
+
+(define (fadds6) ; [1010 after] -> [990]
+  (let ((three 3))
+    (do ((i 0 (+ i 1)))
+	((= i len))
+      (unless (= (+ (values i (+ i 1) 2 3 4 5) three) (+ (* 2 i) 18))
+	(display "fadds6 oops\n" *stderr*)))))
+
+;(fadds6)
+
+
+(define (faddc6) ; [997 after] -> [978]
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (unless (= (+ (values i (+ i 1) 2 3 4 5) 3) (+ (* 2 i) 18))
+      (display "faddc6 oops\n" *stderr*))))
+
+;(faddc6)
+
+
+(define (fadd2-mv) (values 1 2 3))
+(define (fadd2) ; [649] -> [550 (no pair_append)] -> [546 if no goto] -> [425]
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (unless (= (+ (fadd2-mv) 4) 10)
+      (display "fadd2 oops\n" *stderr*)))) ; op_c_na calls make_list (op_c_nc?) [op_safe_c_pc_mv? so the make_list can be side-stepped?]
+
+;(fadd2)
+
+
+(define (faddc0) ; [509] -> [504 plist_4 (lose for extra if, gain in gc)] -> [383]
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (unless (= (+ 4 (values 1 2 3)) 10) ; safe_c_cp -> safe_c_sp_mv which uses cons(args, value)
+      (display "faddc0 oops\n" *stderr*))))
+
+;(faddc0)
+
+
+(define (fadds02) ; [422 plist_3] -> [409] -> [357 aa->nc]
+  (let ((four 4))
+    (do ((i 0 (+ i 1)))
+	((= i len))
+      (unless (= (+ four (values 1 2)) 7) ; to sp_mv
+	(display "fadds02 oops\n" *stderr*)))))
+
+;(fadds02)
+
+
+(define (fadds0) ; [522] -> [516 plist_4 -- still has make_list] -> [395]
+  (let ((four 4))
+    (do ((i 0 (+ i 1)))
+	((= i len))
+      (unless (= (+ four (values 1 2 3)) 10) ; to sp_mv
+	(display "fadds0 oops\n" *stderr*)))))
+
+;(fadds0)
+
+
+(define (fadda0) ; [559] -> [552 plist_4] -> [431]
+  (let ((four 2))
+    (do ((i 0 (+ i 1)))
+	((= i len))
+      (unless (= (+ (* 2 four) (values 1 2 3)) 10) ; also goes to sp_mv
+	(display "fadda0 oops\n" *stderr*)))))
+
+;(fadda0)
+
+
+(define (strv) 
+  ;; [611 op_safe_c_p -> op_c_p_mv? (copied)] -> [525 (uncopied -- buggy)] -> 
+  ;; [679 if safe_list_is_possible (no cancellation)] -> [547 if direct safe_list] ->
+  ;; [567 checked safe_list used direct] -> [574 if in_use set] -> [563 if no goto apply]
+  ;; [540 if plist] -> [434]
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (unless (string=? (string (values #\a #\b #\c)) "abc")
+      (display "strv oops\n" *stderr*))))
+
+;(strv)
+
+
+(define (faddssp2) ; [485] -> [478 if plist] -> [456] -> [403 aa->nc]
+  (let ((four 4))
+    (do ((i 0 (+ i 1)))
+	((= i len))
+      (unless (= (+ four four (values 1 2)) 11)
+	(display "faddssp2 oops\n" *stderr*)))))
+
+;(faddssp2)
+
+
+(define (faddssp3) ; [573] -> [454]
+  (let ((four 4))
+    (do ((i 0 (+ i 1)))
+	((= i len))
+      (unless (= (+ four four (values 1 2 3)) 14)
+	(display "faddssp3 oops\n" *stderr*)))))
+
+;(faddssp3)
+
+
+(define (faddp) ; [662] -> [653]
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (unless (= (apply (values + '(1 2))) 3) ; op_c_p_mv + op_c_aa
+      (display "faddp oops\n" *stderr*))))
+
+;(faddp)
+
+
+(define (faddap) ; [524] -> [506]
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (unless (= (apply + (values 5 '(1 2))) 8) ; op_c_ap_mv + op_c_aa
+      (display "faddap oops\n" *stderr*))))
+
+;(faddap)
+
+
+(define (faddpp) ; [625] -> [519 aa->nc]
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (unless (= (+ (values 1 2) (values 3 4)) 10) ; op_safe_c_pp_3|6_mv, also (+ (values 1 2 3) (values 3 -2 -1))
+      (display "faddpp oops\n" *stderr*))))
+
+;(faddpp)
+
+
+(define (fadd3p) ; [784] -> [676 no make_list op_c_nc]
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (unless (= (+ 1 (values 2 3 4) -4) 6) ; op_safe_c_3p_2|3_mv
+      (display "fadd3p oops\n" *stderr*))))
+
+;(fadd3p)
+
+
+(define (faddnp) ; [964]
+  (do ((i 0 (+ i 1)))
+      ((= i len))
+    (unless (= (apply (values + 1 2) '(3)) 6) ; op_any_c_mv (and op_c_na)
+      (display "faddnp oops\n" *stderr*))))
+
+;(faddnp)
+
+
+
+(define (all-tests)
+  (mvtest)
+
+  (f0)
+  (f01)
+  (f02)
+  (f021)
+  (f0211)
+  (f0212)
+  (f2)
+  (f022)
+  (f4)
+  (f6)
+  (f7)
+  (f9)
+  (f10)
+  (f11)
+
+  (faddc)
+  (fadds)
+  (fadda)
+  (fadd1)
+  (fadd2)
+  (faddc6)
+  (fadds6)
+  (fadda6)
+  (faddc0)
+  (fadds02)
+  (fadds0)
+  (fadda0)
+  (strv)
+  (faddssp2)
+  (faddssp3)
+  (faddp)
+  (faddap)
+  (faddpp)
+  (fadd3p)
+  (faddnp)
+  )
+
+(all-tests)
+
+#|
+(when (provided? 'debugging)
+  (display ((*s7* 'memory-usage) 'safe-lists))
+  (newline))
+|#
+
+(exit)
diff --git a/s7/tools/tnum.scm b/s7/tools/tnum.scm
new file mode 100644
index 0000000..b36f685
--- /dev/null
+++ b/s7/tools/tnum.scm
@@ -0,0 +1,686 @@
+;;; a first stab at a numerics timing test
+(set! (*s7* 'heap-size) (* 6 1024000))
+
+(define dolph-1
+  (let ((+documentation+ "(dolph-1 n gamma) produces a Dolph-Chebyshev FFT data window of 'n' points using 'gamma' as the window parameter."))
+    (lambda (N gamma)
+      (let ((vals (make-vector N)))
+	(let ((alpha (cosh (/ (acosh (expt 10.0 gamma)) N))))
+	  (do ((den (/ 1.0 (cosh (* N (acosh alpha)))))
+	       (freq (/ pi N))
+	       (mult -1 (- mult))
+	       (i 0 (+ i 1))
+	       (phase (* -0.5 pi)))
+	      ((= i N))
+	    (set! (vals i) (* mult den (cos (* N (acos (* alpha (cos phase)))))))
+	    (set! phase (+ phase freq))))
+	;; now take the DFT
+	(let ((pk 0.0)
+	      (w (make-vector N))
+	      (c (/ (* 2.0 0+1.0i pi) N)))
+	  (do ((i 0 (+ i 1))
+	       (sum 0.0 0.0))
+	      ((= i N))
+	    (do ((k 0 (+ k 1))
+		 (cin (* c i)))
+		((= k N))
+	      (set! sum (+ sum (* (vals k) (exp (* cin k))))))
+	    (set! pk (max pk (vector-set! w i (magnitude sum)))))
+	  ;; scale to 1.0 (it's usually pretty close already, that is pk is close to 1.0)
+	  (do ((i 0 (+ i 1)))
+	      ((= i N))
+	    (vector-set! w i (/ (vector-ref w i) pk)))
+	  w)))))
+
+(dolph-1 (expt 2 10) 0.5)
+
+
+(define src-duration
+  (let ((+documentation+ "(src-duration envelope) returns the new duration of a sound after using 'envelope' for time-varying sampling-rate conversion"))
+    (lambda (e)
+      (let ((len (- (length e) 2)))
+	(do ((all-x (- (e len) (e 0))) ; last x - first x
+	     (dur 0.0)
+	     (i 0 (+ i 2)))
+	    ((>= i len) dur)
+	  (let ((area (let ((x0 (e i))
+			    (x1 (e (+ i 2)))
+			    (y0 (e (+ i 1))) ; 1/x x points
+			    (y1 (e (+ i 3))))
+			(if (< (abs (real-part (- y0 y1))) .0001)
+			    (/ (- x1 x0) (* y0 all-x))
+			    (/ (* (log (/ y1 y0)) 
+				  (- x1 x0)) 
+			       (* (- y1 y0) all-x))))))
+	    (set! dur (+ dur (abs area)))))))))
+
+
+(define (src-test)
+  (src-duration (do ((env (make-float-vector 7000))
+		     (i 0 (+ i 2)))
+		    ((= i 7000) env)
+		  (set! (env i) i)
+		  (set! (env (+ i 1)) (+ .1 (random 1.0))))))
+(src-test)
+
+
+(define invert-matrix
+  (let ((+documentation+ "(invert-matrix matrix b (zero 1.0e-7)) inverts 'matrix'"))
+    (lambda* (matrix b (zero 1.0e-7))
+      ;; translated from Numerical Recipes (gaussj)
+      (call-with-exit
+       (lambda (return)
+	 (let ((n (car (vector-dimensions matrix))))
+	   (let ((cols (make-int-vector n))
+		 (rows (make-int-vector n))
+		 (pivots (make-int-vector n)))
+	     (do ((i 0 (+ i 1))
+		  (col 0 0)
+		  (row 0 0))
+		 ((= i n))
+	       (do ((biggest 0.0)
+		    (j 0 (+ j 1)))
+		   ((= j n)
+		    (if (< biggest zero) 
+			(return #f))) ; this can be fooled (floats...): (invert-matrix (subvector (float-vector 1 2 3 3 2 1 4 5 6) 0 9 (list 3 3)))
+		 (if (not (= (pivots j) 1))
+		     (do ((k 0 (+ k 1)))
+			 ((= k n))
+		       (if (= (pivots k) 0)
+			   (let ((val (abs (matrix j k))))
+			     (when (> val biggest)
+			       (set! col k)
+			       (set! row j)
+			       (set! biggest val)))
+			   (if (> (pivots k) 1)
+			       (return #f))))))
+	       (set! (pivots col) (+ (pivots col) 1))
+	       (if (not (= row col))
+		   (let ((temp (if (sequence? b) (b row) 0.0)))
+		     (when (sequence? b)
+		       (set! (b row) (b col))
+		       (set! (b col) temp))
+		     (do ((k 0 (+ k 1)))
+			 ((= k n))
+		       (set! temp (matrix row k))
+		       (set! (matrix row k) (matrix col k))
+		       (set! (matrix col k) temp))))
+	       (set! (cols i) col)
+	       (set! (rows i) row)
+	       ;; round-off troubles here
+	       (if (< (abs (matrix col col)) zero)
+		   (return #f))
+	       (let ((inverse-pivot (/ 1.0 (matrix col col))))
+		 (set! (matrix col col) 1.0)
+		 (do ((k 0 (+ k 1)))
+		     ((= k n))
+		   (set! (matrix col k) (* inverse-pivot (matrix col k))))
+		 (if b (set! (b col) (* inverse-pivot (b col)))))
+	       (do ((k 0 (+ k 1)))
+		   ((= k n))
+		 (if (not (= k col))
+		     (let ((scl (matrix k col)))
+		       (set! (matrix k col) 0.0)
+		       (do ((m 0 (+ 1 m)))
+			   ((= m n))
+			 (set! (matrix k m) (- (matrix k m) (* scl (matrix col m)))))
+		       (if b (set! (b k) (- (b k) (* scl (b col)))))))))
+	     (do ((i (- n 1) (- i 1)))
+		 ((< i 0))
+	       (if (not (= (rows i) (cols i)))
+		   (do ((k 0 (+ k 1)))
+		       ((= k n))
+		     (let ((temp (matrix k (rows i))))
+		       (set! (matrix k (rows i)) (matrix k (cols i)))
+		       (set! (matrix k (cols i)) temp)))))
+	     (list matrix b))))))))
+
+(define (matrix-solve A b)
+  (cond ((invert-matrix A b) => cadr) (else #f)))
+
+(define (invert-test)
+  (matrix-solve (do ((A (make-float-vector '(100 100)))
+		     (i 0 (+ i 1)))
+		    ((= i 100) A)
+		  (do ((j 0 (+ j 1)))
+		      ((= j 100))
+		    (set! (A i j) (random 1.0))))
+		(do ((b (make-float-vector 100))
+		     (i 0 (+ i 1)))
+		    ((= i 100) b)
+		  (set! (b i) (random 1.0)))))
+(invert-test)
+
+
+(define* (cfft data n (dir 1)) ; complex data
+  (unless n (set! n (length data)))
+  (do ((i 0 (+ i 1))
+       (j 0))
+      ((= i n))
+    (if (> j i)
+	(let ((temp (data j)))
+	  (set! (data j) (data i))
+	  (set! (data i) temp)))
+    (do ((m (/ n 2) (/ m 2)))
+        ((not (<= 2 m j))
+         (set! j (+ j m)))
+     (set! j (- j m))))
+  (do ((ipow (floor (log n 2)))
+       (prev 1)
+       (lg 0 (+ lg 1))
+       (mmax 2 (* mmax 2))
+       (pow (/ n 2) (/ pow 2))
+       (theta (complex 0.0 (* pi dir)) (* theta 0.5)))
+      ((= lg ipow))
+    (do ((wpc (exp theta))
+         (wc 1.0)
+         (ii 0 (+ ii 1)))
+	((= ii prev)
+	 (set! prev mmax))
+      (do ((i ii (+ i mmax))
+           (j (+ ii prev) (+ j mmax))
+	   (tc 0.0)
+	   (jj 0 (+ jj 1)))
+          ((>= jj pow)
+	   (set! wc (* wc wpc)))
+        (set! tc (* wc (data j)))
+	(set! (data j) (- (data i) tc))
+	(set! (data i) (+ (data i) tc)))))
+  data)
+
+(define (cfft-test)
+  (let* ((size (expt 2 16))
+	 (data (make-vector size)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (set! (data i) (complex (- 1.0 (random 2.0)) (- 1.0 (random 2.0)))))
+    (cfft data size)))
+
+(cfft-test)
+
+
+;; these Bessel functions are from Numerical Recipes
+(define (bes-j0-1 x)				;returns J0(x) for any real x
+  (if (< (abs x) 8.0)
+      (let ((y (* x x)))
+	(let ((ans1 (+ 57568490574.0000 (* y (- (* y (+ 651619640.7 (* y (- (* y (+ 77392.33017 (* y -184.9052456))) 11214424.18)))) 13362590354.0))))
+	      (ans2 (+ 57568490411.0 
+		       (* y (+ 1029532985.0 
+			       (* y (+ 9494680.718
+				       (* y (+ 59272.64853
+					       (* y (+ 267.8532712 y)))))))))))
+	  (/ ans1 ans2)))
+      (let* ((ax (abs x))
+	     (z (/ 8.0 ax))
+	     (y (* z z)))
+	(let ((xx (- ax 0.785398164))
+	      (ans1 (+ 1.0 (* y (- (* y (+ 2.734510407e-05 (* y (- (* y 2.093887211e-07) 2.073370639e-06)))) 0.001098628627))))
+	      (ans2 (- (* y (+ 0.0001 (* y (- (* y (+ 7.621095160999999e-07 (* y -9.34945152e-08))) 6.911147651000001e-06)))) 0.0156)))
+	  (* (sqrt (/ 0.636619772 ax))
+	     (- (* ans1 (cos xx))
+		(* z (sin xx) ans2)))))))
+
+(define bes-j1-1 
+  (let ((signum (lambda (x) (if (= x 0.0) 0 (if (< x 0.0) -1 1)))))
+    (lambda (x)				;returns J1(x) for any real x
+      (if (< (abs x) 8.0)
+	  (let ((y (* x x)))
+	    (let ((ans1 (* x (+ 72362614232.0000 (* y (- (* y (+ 242396853.1 (* y (- (* y (+ 15704.4826 (* y -30.16036606))) 2972611.439)))) 7895059235.0)))))
+		  (ans2 (+ 144725228442.0 
+			   (* y (+ 2300535178.0 
+				   (* y (+ 18583304.74
+					   (* y (+ 99447.43394
+						   (* y (+ 376.9991397 y)))))))))))
+	      (/ ans1 ans2)))
+	  (let* ((ax (abs x))
+		 (z (/ 8.0 ax))
+		 (y (* z z)))
+	    (let ((xx (- ax 2.356194491))
+		  (ans1 (+ 1.0 (* y (+ 0.00183105 (* y (- (* y (+ 2.457520174e-06 (* y -2.40337019e-07))) 3.516396496e-05))))))
+		  (ans2 (+ 0.0469 (* y (- (* y (+ 8.449199096000001e-06 (* y (- (* y 1.05787412e-07) 8.8228987e-07)))) 0.0002002690873)))))
+	      (* (signum x)
+		 (sqrt (/ 0.636619772 ax))
+		 (- (* ans1 (cos xx))
+		    (* z (sin xx) ans2)))))))))
+
+(define (bes-jn nn x)
+  (let ((besn (let ((n (abs nn)))
+		(cond ((= n 0) (bes-j0-1 x))
+		      ((= n 1) (bes-j1-1 x))
+		      ((= x 0.0) 0.0)
+		      (else
+		       (let ((iacc 40)
+			     (ans 0.0000)
+			     (bigno 1.0e10)
+			     (bigni 1.0e-10))
+			 (if (> (abs x) n)
+			     (do ((tox (/ 2.0 (abs x)))
+				  (bjm (bes-j0-1 (abs x)))
+				  (bj (bes-j1-1 (abs x)))
+				  (j 1 (+ j 1))
+				  (bjp 0.0))
+				 ((= j n) (set! ans bj))
+			       (set! bjp (- (* j tox bj) bjm))
+			       (set! bjm bj)
+			       (set! bj bjp))
+			     (let ((tox (/ 2.0 (abs x)))
+				   (m (* 2 (floor (/ (+ n (sqrt (* iacc n))) 2))))
+				   (jsum 0)
+				   (bjm 0.0000)
+				   (sum 0.0000)
+				   (bjp 0.0000)
+				   (bj 1.0000))
+			       (do ((j m (- j 1)))
+				   ((= j 0))
+				 (set! bjm (- (* j tox bj) bjp))
+				 (set! bjp bj)
+				 (set! bj bjm)
+				 (when (> (abs bj) bigno)
+				   (set! bj (* bj bigni))
+				   (set! bjp (* bjp bigni))
+				   (set! ans (* ans bigni))
+				   (set! sum (* sum bigni)))
+				 (if (not (= 0 jsum))
+				     (set! sum (+ sum bj)))
+				 (set! jsum (- 1 jsum))
+				 (if (= j n) (set! ans bjp)))
+			       (set! ans (/ ans (- (* 2.0 sum) bj)))))
+			 (if (and (< x 0.0) (odd? n))
+			     (- ans)
+			     ans)))))))
+    (if (and (< nn 0)
+	     (odd? nn))
+	(- besn)
+	besn)))
+
+(define (bes-i0 x)
+  (if (< (abs x) 3.75)
+      (let ((y (expt (/ x 3.75) 2)))
+	(+ 1.0
+	   (* y (+ 3.5156229
+		   (* y (+ 3.0899424
+			   (* y (+ 1.2067492
+				   (* y (+ 0.2659732
+					   (* y (+ 0.360768e-1
+						   (* y 0.45813e-2)))))))))))))
+      (let* ((ax (abs x))
+	     (y (/ 3.75 ax)))
+	(* (/ (exp ax) (sqrt ax))
+	   (+ 0.3989 (* y (+ 0.0133 
+			     (* y (+ 0.0023 
+				     (* y (- (* y (+ 0.0092 
+						     (* y (- (* y (+ 0.02635537 
+								     (* y (- (* y 0.00392377) 0.01647633)))) 
+							     0.02057706)))) 
+					     0.0016)))))))))))
+
+(define (bes-i1 x)				;I1(x)
+  (if (< (abs x) 3.75)
+      (let ((y (expt (/ x 3.75) 2)))
+	(* x (+ 0.5
+		(* y (+ 0.87890594
+			(* y (+ 0.51498869
+				(* y (+ 0.15084934
+					(* y (+ 0.2658733e-1
+						(* y (+ 0.301532e-2
+							(* y 0.32411e-3))))))))))))))
+      (let ((ax (abs x)))
+	(let ((ans2 (let* ((y (/ 3.75 ax))
+			   (ans1 (+ 0.02282967 (* y (- (* y (+ 0.01787654 (* y -0.00420059))) 0.02895312)))))
+		      (+ 0.39894228 (* y (- (* y (- (* y (+ 0.00163801 (* y (- (* y ans1) 0.01031555)))) 0.00362018)) 0.03988024)))))
+	      (sign (if (< x 0.0) -1.0 1.0)))
+	  (/ (* (exp ax) ans2 sign) (sqrt ax))))))
+
+(define (bes-in n x)
+  (cond ((= n 0) (bes-i0 x))
+	((= n 1) (bes-i1 x))
+	((= x 0.0) 0.0)
+	(else
+	 (let ((bigno 1.0e10)
+	       (bigni 1.0e-10)
+	       (ans 0.0000)
+	       (tox (/ 2.0 (abs x)))
+	       (bip 0.0000)
+	       (bi 1.0000)
+	       (m (* 2 (+ n (truncate (sqrt (* 40 n)))))) ; iacc=40
+	       (bim 0.0000))
+	   (do ((j m (- j 1)))
+	       ((= j 0))
+	     (set! bim (+ bip (* j tox bi)))
+	     (set! bip bi)
+	     (set! bi bim)
+	     (when (> (abs bi) bigno)
+	       (set! ans (* ans bigni))
+	       (set! bi (* bi bigni))
+	       (set! bip (* bip bigni)))
+	     (if (= j n) (set! ans bip)))
+	   (if (and (< x 0.0) (odd? n))
+	       (set! ans (- ans)))
+	   (* ans (/ (bes-i0 x) bi))))))
+
+
+(define (fm-complex-component freq-we-want wc wm a b interp using-sine)
+  (let ((sum 0.0)
+	(mxa (ceiling (* 7 a)))
+	(mxb (ceiling (* 7 b))))
+    (do ((k (- mxa) (+ k 1)))
+	((>= k mxa))
+      (do ((bes-ja (bes-jn k a))
+	   (freqwc (- freq-we-want wc (* k wm)))
+	   (j (- mxb) (+ j 1)))
+	  ((>= j mxb))
+	(if (< (abs (- freqwc (* j wm))) 0.1)
+	    (set! sum (+ sum (* bes-ja
+				(bes-in (abs j) b)
+				(expt 0.0+1.0i j)))))))
+    (list sum
+	  (+ (* (- 1.0 interp) (real-part sum))
+	     (* interp (imag-part sum))))))
+
+(define (fm-cascade-component freq-we-want wc wm1 a wm2 b)
+  (let ((sum 0.0)
+	(mxa (ceiling (* 7 a)))
+	(mxb (ceiling (* 7 b))))
+    (do ((k (- mxa) (+ k 1)))
+	((>= k mxa))
+      (do ((bes-ja (bes-jn k a))
+	   (freqwc (- freq-we-want wc (* k wm1)))
+	   (j (- mxb) (+ j 1)))
+	  ((>= j mxb))
+	(if (< (abs (- freqwc (* j wm2))) 0.1)
+	    (set! sum (+ sum (* bes-ja (bes-jn j (* k b))))))))
+    sum))
+
+(define (test-fm-components)
+  (do ((i 0.0 (+ i .1)))
+      ((>= i 3.0))
+    (do ((k 1.0 (+ k 1.0)))
+	((>= k 10.0))
+      (fm-complex-component 1200 1000 100 i k 0.0 #f)
+      (fm-cascade-component 1200 1000 100 i 50 k))))
+
+(test-fm-components)
+
+
+(define (pisum)             ; from Julia microbenchmarks
+  (let ((sum 0.0))
+    (do ((j 0 (+ j 1)))
+	((= j 500)
+	 sum)
+      (set! sum 0.0)
+      (do ((k 1 (+ k 1)))
+	  ((> k 10000))
+	(set! sum (+ sum (/ (* k k))))))))
+
+(define (quicksort a lo hi) ; from Julia microbenchmarks (slightly optimized for s7)
+  (do ((i lo)
+       (j hi hi))
+      ((>= i hi))
+    (do ((t (a 0))
+	 (pivot (a (floor (/ (+ lo hi) 2)))))
+	((> i j))
+      (set! i (do ((k i (+ k 1)))
+		  ((>= (a k) pivot) k)))
+      (set! j (do ((k j (- k 1)))
+		  ((<= (a k) pivot) k)))
+      (when (<= i j)
+	(set! t (a i))
+	(set! (a i) (a j))
+	(set! (a j) t)
+	(set! i (+ i 1))
+	(set! j (- j 1))))
+    (if (< lo j)
+	(quicksort a lo j))
+    (set! lo i)))
+
+(define (jtests)
+  (let-temporarily (((*s7* 'equivalent-float-epsilon) 1e-12))
+    (unless (equivalent? (pisum) 1.6448340718480652)
+      (format *stderr* "pisum: ~S~%" (pisum))))
+
+  (do ((n 0 (+ n 1)) ; Julia original only runs it once!
+       (a (make-float-vector 5000) (make-float-vector 5000)))
+      ((= n 10))
+    (do ((i 0 (+ i 1)))
+	((= i 5000))
+      (set! (a i) (random 5000.0)))
+    (quicksort a 0 4999)
+    (when (zero? n)
+      ;; make sure it worked...
+      (do ((i 1 (+ i 1)))
+	  ((= i 5000))
+	(if (< (a i) (a (- i 1)))
+	    (display "."))))))
+
+(jtests)
+
+
+(define (mean v)
+  (let ((len (length v))
+	(sum 0))
+    (do ((i 0 (+ i 1)))
+	((= i len)
+	 (/ sum len))
+      (set! sum (+ sum (v i))))))
+
+(define (medium v)
+  (let ((len (length v)))
+    (quicksort v 0 (- len 1))
+    (if (odd? len)
+	(v (ceiling (/ len 2)))
+	(/ (+ (v (/ len 2)) (v (+ (/ len 2) 1))) 2))))
+
+(define (mtests)
+  (let ((v (make-float-vector 5000)))
+    (do ((n 0 (+ n 1)))
+	((= n 10))
+      (do ((i 0 (+ i 1)))
+	  ((= i 5000))
+	(set! (v i) (- (random 2.0) 1.0)))
+      (mean v) 
+      (medium v))))
+
+(mtests)
+
+
+(define (gammln xx)			;Ln(gamma(xx)), xx>0 
+  (let* ((stp 2.5066282746310005)
+	 (x xx)
+	 (tmp (+ x 5.5))
+	 (tmp1 (- tmp (* (+ x 0.5) (log tmp))))
+	 (ser (+ 1.000000000190015
+		 (/ 76.18009172947146 (+ x 1.0))
+		 (/ -86.50532032941677 (+ x 2.0))
+		 (/ 24.01409824083091 (+ x 3.0))
+		 (/ -1.231739572450155 (+ x 4))
+		 (/ 0.1208650973866179e-2 (+ x 5.0))
+		 (/ -0.5395239384953e-5 (+ x 6.0)))))
+    (- (log (/ (* stp ser) x)) tmp1)))
+
+(define (gser a x)			;P(a,x) evaluated as series, also Ln(gamma)
+  (if (< x 0.0) 
+      (format #f "~F is less than 0" x)
+      (if (= x 0.0) 
+	  0.0
+	  (let* ((gln (gammln a))
+		 (itmax 100)
+		 (eps 3.0e-7)
+		 (ap a)
+		 (sum (/ 1.0 a))
+		 (del sum))
+	    (do ((n 1 (+ n 1)))
+		((or (> n itmax)
+		     (< (abs del) (* (abs sum) eps)))
+		 (* sum (exp (- (* a (log x)) x gln))))
+	      (set! ap (+ ap 1))
+	      (set! del (* del (/ x ap)))
+	      (set! sum (+ sum del)))))))
+
+(define (gcf a x)			;Q(a,x) evaluated as continued fraction
+  (call-with-exit
+   (lambda (return)
+     (let ((itmax 100)
+	   (eps 3.0e-7)
+	   (gln (gammln a))
+	   (gold 0.0)			;previous value of g, tested for convergence
+	   (a0 1.0)
+	   (a1 x)
+	   (b0 0.0)
+	   (b1 1.0)			;setting up continued fraction
+	   (fac 1.0)
+	   (ana 0.0) (g 0.0) (anf 0.0))
+       (do ((n 1 (+ n 1)))
+	   ((> n itmax) 
+	    (* g (exp (- (* a (log x)) x gln))))
+	 (set! ana (- n a))
+	 (set! a0 (* fac (+ a1 (* a0 ana))))
+	 (set! b0 (* fac (+ b1 (* b0 ana))))
+	 (set! anf (* fac n))
+	 (set! a1 (+ (* x a0) (* anf a1)))
+	 (set! b1 (+ (* x b0) (* anf b1)))
+	 (unless (= 0.0 a1)		;renormalize?
+	   (set! fac (/ 1.0 a1))
+	   (set! g (* b1 fac))
+	   (if (< (abs (/ (- g gold) g)) eps)
+	       (return (* g (exp (- (* a (log x)) x gln)))))))))))
+	 
+(define (gammp a x)			; incomplete gamma function P(a,x)
+  (if (or (<= a 0.0) 
+	  (< x 0.0))
+      (format #f "Invalid argument to gammp: ~F" (if (<= 0.0 a) a x))
+      (if (< x (+ a 1.0))
+	  (gser a x)			;use series
+	  (- 1.0 (gcf a x)))))		;use continued fraction
+  
+(define (erf x)			        ; error function erf(x)
+  (if (< x 0.0)
+      (- (gammp 0.5 (* x x)))
+      (gammp 0.5 (* x x))))
+
+(define (gammq a x)                     ;incomplete gamma function Q(a,x) = 1 - P(a,x)
+  (- 1.0 (gammp a x)))
+
+(define (erfc x)                        ;complementary error function erfc(x)
+  (if (< x 0.0)
+      (+ 1.0 (gammp 0.5 (* x x)))
+      (gammq 0.5 (* x x))))
+
+(define (test-erf)
+  (let-temporarily (((*s7* 'equivalent-float-epsilon) 1e-12))
+    (unless (equivalent? (erf 0) 0.0) (format *stderr* "erf 0: ~S~%" (erf 0)))
+    (unless (equivalent? (erf 1) 0.8427007900291826) (format *stderr* "erf 1: ~S~%" (erf 1)))
+    (unless (equivalent? (erfc 1) 0.15729920997081737) (format *stderr* "erfc 1: ~S~%" (erfc 1)))
+    (unless (equivalent? (erf 0.5) 0.5204998760683841) (format *stderr* "erf 0.5: ~S~%" (erf 0.5)))
+    (unless (equivalent? (erf 2) 0.9953222650189529) (format *stderr* "erf 2: ~S~%" (erf 2)))
+    (unless (equivalent? (erf 0.35) 0.3793820529938486) (format *stderr* "erf 0.35: ~S~%" (erf 0.35)))
+
+    (do ((i 0 (+ i 1))
+	 (x 0.0 (+ x .001)))
+	((= i 3000))
+      (unless (equivalent? (+ (erf x) (erfc x)) 1.0)
+	(format *stderr* "erf: ~S trouble\n" x)))))
+
+(test-erf)
+
+
+(define show-digits-of-pi-starting-at-digit
+  ;; piqpr8.c
+  ;;    This program implements the BBP algorithm to generate a few hexadecimal
+  ;;    digits beginning immediately after a given position id, or in other words
+  ;;    beginning at position id + 1.  On most systems using IEEE 64-bit floating-
+  ;;    point arithmetic, this code works correctly so long as d is less than
+  ;;    approximately 1.18 x 10^7.  If 80-bit arithmetic can be employed, this limit
+  ;;    is significantly higher.  Whatever arithmetic is used, results for a given
+  ;;    position id can be checked by repeating with id-1 or id+1, and verifying 
+  ;;    that the hex digits perfectly overlap with an offset of one, except possibly
+  ;;    for a few trailing digits.  The resulting fractions are typically accurate 
+  ;;    to at least 11 decimal digits, and to at least 9 hex digits.  
+  ;;  David H. Bailey     2006-09-08
+
+  (let ((ihex (lambda (x nhx chx)
+		;; This returns, in chx, the first nhx hex digits of the fraction of x.
+		(do ((y (abs x))
+		     (hx "0123456789ABCDEF")
+		     (i 0 (+ i 1)))
+		    ((= i nhx) chx)
+		  (set! y (* 16.0 (- y (floor y))))
+		  (set! (chx i) (hx (floor y))))))
+	(series (lambda (m id)
+		  ;; This routine evaluates the series sum_k 16^(id-k)/(8*k+m) using the modular exponentiation technique.
+		  (let ((expm (let ((ntp 25))
+				(let ((tp1 0)
+				      (tp (make-vector ntp)))
+				  (lambda (p ak)
+				    ;; expm = 16^p mod ak.  This routine uses the left-to-right binary exponentiation scheme.
+				    ;; If this is the first call to expm, fill the power of two table tp.
+				    (when (= tp1 0)
+				      (set! tp1 1)
+				      (set! (tp 0) 1.0)
+				      (do ((i 1 (+ i 1)))
+					  ((= i ntp))
+					(set! (tp i) (* 2.0 (tp (- i 1))))))
+				    
+				    (if (= ak 1.0)
+					0.0
+					(let ((pl -1))
+					  ;;  Find the greatest power of two less than or equal to p.
+					  (do ((i 0 (+ i 1)))
+					      ((or (not (= pl -1)) 
+						   (= i ntp)))
+					    (if (> (tp i) p)
+						(set! pl i)))
+					  
+					  (if (= pl -1) (set! pl ntp))
+					  (let ((pt (tp (- pl 1)))
+						(p1 p)
+						(r 1.0))
+					    ;;  Perform binary exponentiation algorithm modulo ak.
+					    
+					    (do ((j 1 (+ j 1)))
+						((> j pl) r)
+					      (when (>= p1 pt)
+						(set! r (* 16.0 r))
+						(set! r (- r (* ak (floor (/ r ak)))))
+						(set! p1 (- p1 pt)))
+					      (set! pt (* 0.5 pt))
+					      (when (>= pt 1.0)
+						(set! r (* r r))
+						(set! r (- r (* ak (floor (/ r ak))))))))))))))
+			(eps 1e-17)
+			(s 0.0))
+		    (do ((k 0 (+ k 1)))
+			((= k id))
+		      (let* ((ak (+ (* 8 k) m))
+			     (t (expm (- id k) ak)))
+			(set! s (+ s (/ t ak)))
+			(set! s (- s (floor s)))))
+		    
+		    ;; Compute a few terms where k >= id.
+		    (do ((happy #f)
+			 (k id (+ k 1)))
+			((or (> k (+ id 100)) happy) s)
+		      (let ((t (/ (expt 16.0 (- id k)) (+ (* 8 k) m))))
+			(set! happy (< t eps))
+			(set! s (+ s t))
+			(set! s (- s (floor s)))))))))
+    (lambda (id)  
+      ;; id is the digit position.  Digits generated follow immediately after id.
+      (let ((chx (make-string 10 #\space))
+	    (pid (let ((s1 (series 1 id))
+		       (s2 (series 4 id))
+		       (s3 (series 5 id))
+		       (s4 (series 6 id)))
+		   (- (+ (* 4.0 s1) (* -2.0 s2)) s3 s4))))
+	(ihex (- (+ 1.0 pid) (floor pid)) 10 chx)
+	chx))))
+
+(define (test-digits)
+  (do ((i 0 (+ i 1)))
+      ((= i 5))
+    (show-digits-of-pi-starting-at-digit (* i 1000))))
+
+(test-digits)
+
+
+(exit)
+
diff --git a/s7/tools/tobj.scm b/s7/tools/tobj.scm
new file mode 100644
index 0000000..f5fa75d
--- /dev/null
+++ b/s7/tools/tobj.scm
@@ -0,0 +1,234 @@
+;;; c-object timing tests using s7test blocks
+
+(define size 200000)
+
+(load "s7test-block.so" (sublet (curlet) (cons 'init_func 'block_init)))
+
+
+(define (f1 b)
+  (b 0)) ; op_implicit_c_object_ref_a and g_block_ref -> s7_c_object_type|value, op_unknown_a
+
+(define (ft1)
+  (let ((b (block 1 2 3)))
+    (f1 b)))
+
+(unless (= (ft1) 1) (format *stderr* "(f1 b): ~S~%" (ft1)))
+
+(define (ftest1)
+  (let ((b (block 1 2 3)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (f1 b))))
+
+(ftest1)
+
+
+(define (f2 b)
+  (block-ref b 0)) ; g_block_ref etc
+
+(define (ft2)
+  (let ((b (block 1 2 3)))
+    (f2 b)))
+
+(unless (= (ft2) 1) (format *stderr* "(f2 b): ~S~%" (ft2)))
+
+(define (ftest2)
+  (let ((b (block 1 2 3)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (f2 b))))
+
+(ftest2)
+
+
+(define (f3 b val)
+  (set! (b 0) val)) ; g_block_set [set_pair + set_pair_p_3 etc]
+
+(define (ft3)
+  (let ((b (block 1 2 3)))
+    (f3 b 32)
+    (b 0)))
+
+(unless (= (ft3) 32) (format *stderr* "(f3 b 32): ~S~%" (ft3)))
+
+(define (ftest3)
+  (let ((b (block 1 2 3)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (f3 b i))))
+
+(ftest3)
+
+
+(define (ftest4)
+  (let ((b (make-block 100))
+	(b1 #f)
+	(b2 #f))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (fill! b 1.0)                     ; g_block_fill 
+      (set! b (reverse! b))             ; g_block_reverse_in_place
+      (unless (= (length b) 100)        ; c_object_length_to_int? -> g_block_length
+	(format *stderr* "oops"))
+      (set! b1 (copy b))                ; g_block_copy, g_make_block?
+      (unless (and (equal? b b1)        ; g_blocks_are_equal
+		   (equivalent? b b1))  ; g_blocks_are_equivalent, vector_equivalent?? + s7_make_float_vector_wrapper
+	(format *stderr* "oops"))
+      (set! b2 (append b b1))           ; g_block_append
+      (unless (and (c-object? b2)
+		   (= (length b2) 200))
+	(format *stderr* "oops")))))
+
+(ftest4)
+
+
+(define (ftest5)
+  (let ((b (make-block 10))
+	(b1 (make-block 10)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (do ((j 0 (+ j 1)))
+	  ((= j 10))
+	(set! (b1 j) (b j)))))) ; (?) block_set_d_7pid block_ref_d_7pi
+
+(ftest5)
+
+
+(define (ftest6)
+  (let ((b (make-block 10))
+	(b1 (make-block 10)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (do ((j 0 (+ j 1)))
+	  ((= j 10))
+	(block-set! b1 j (block-ref b j))))))
+
+(ftest6)
+
+
+(define (ftest7)
+  (let ((b (make-block 10)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (do ((j 0 (+ j 1)))
+	  ((= j 10))
+	(set! (b j) (* 2.0 (b j)))))))
+
+(ftest7)
+
+      
+(define (f8 b x)
+  (b x)) 
+
+(define (ftest8)
+  (let ((b (block 1 2 3)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (f8 b 2))))
+
+(ftest8)
+
+
+(define (ftest9)
+  (let ((b (make-block 10)))
+    (do ((i 0 (+ i 1)))
+	((= i (/ size 10)))
+      (map abs b))))
+
+(ftest9)
+
+
+(define (ftest10)
+  (let ((b (make-block 10)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (let-temporarily (((b 0) (* i 2.0)))
+	(unless (= (b 0) (* i 2.0))
+	  (display 'oops *stderr*))))))
+
+(ftest10)
+
+
+(define (ftest11)
+  (let* ((b (make-block 10))
+	 (iter (make-iterator b)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (do ((j 0 (+ j 1)))
+	  ((= j 10))
+	(iterate iter)))))
+
+(ftest11)
+
+
+(define (ftest12)
+  (let ((b (make-block 10)))
+    (do ((i 0 (+ i 1)))
+	((= i (/ size 10)))
+      ;(sort! b >)             ; needs sort! method (s7.h does not try to export g_sort)
+      (object->let b)
+      (object->string b))))
+
+(ftest12) 
+
+
+(define f13
+  (let ((L (list 0)))
+    (lambda (b)
+      (apply b L))))      ; apply_c_object
+
+(define (ftest13)
+  (let ((b (block 1 2 3)))
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (f13 b))))
+
+(ftest13)
+
+
+(define (randomize-block uv)
+  (let* ((len (length uv))
+	 (v (copy uv))
+	 (nv (make-block len))
+	 (min-i 0))
+    (fill! nv +nan.0)
+    (do ((i 0 (+ i 1))
+	 (r (random len) (random len)))
+	((= i len))
+      (if (nan? (block-ref v r))
+	  (do ((k min-i (+ k 1)))
+	      ((or (= k len)
+		   (not (nan? (block-ref v k))))
+	       (if (= k len)
+		   (format *stderr* "can't find a value for ~S!\n" r)
+		   (begin
+		     (set! min-i (+ k 1))
+		     (block-set! nv i (block-ref v k))
+		     (block-set! v k +nan.0)))))
+	  (begin
+	    (block-set! nv i (block-ref v r))
+	    (block-set! v r +nan.0))))
+    nv))
+
+;(display (randomize-block (block 1 2 3 4 5 6))) (newline)
+
+(define (rtest)
+  (let ((v (make-block 100000)))
+    (do ((i 0 (+ i 1)))
+	((= i 100000))
+      (block-set! v i i))
+    (randomize-block v)))
+
+(rtest)
+
+
+(define (fload) ; check s7_make_c_type et al
+  (do ((i 0 (+ i 1)))
+      ((= i 2000))
+    (load "s7test-block.so" (sublet (curlet) (cons 'init_func 'block_init)))))
+
+(fload)
+
+
+
+(exit)
diff --git a/s7/tools/tpeak.scm b/s7/tools/tpeak.scm
new file mode 100644
index 0000000..a4801c4
--- /dev/null
+++ b/s7/tools/tpeak.scm
@@ -0,0 +1,362 @@
+(set! (*s7* 'heap-size) 512000)
+
+(unless (provided? 'snd-peak-phases.scm) 
+  (load "low-primes.scm")
+  (load "peak-phases.scm"))
+
+(define (get-best choice n)
+  (let ((val (vector-ref (case choice 
+			   ((:all) noid-min-peak-phases)
+			   ((:odd) nodd-min-peak-phases)
+			   ((:even) neven-min-peak-phases)
+			   (else primoid-min-peak-phases))
+			 (cond ((<= n 128) (- n 1))
+			       ((= n 256) 128)
+			       ((= n 512) 129)
+			       ((= n 1024) 130)
+			       (else 131)))))
+    (let ((a-val (vector-ref val 1))
+	  (a-len (length val)))
+      (do ((k 3 (+ k 1)))
+	  ((= k a-len)
+	   a-val)
+	(when (and (real? (vector-ref val k))
+		   (< (vector-ref val k) a-val))
+	  (set! a-val (vector-ref val k)))))))
+
+(define (write-best-cases)
+  (let ((file (open-output-file "best.data" "w")))
+    (for-each
+     (lambda (choice)
+       (format file "  static mus_float_t ~A_mins[128] = {" (keyword->symbol choice))
+       (do ((i 1 (+ i 1)))
+	   ((= i 128))
+	 (format file "~1,4F, " (get-best choice i)))
+       (format file "~1,4F};~%~%" (get-best choice 128)))
+     '(:all :odd :prime :even))
+
+    (format file "  static mus_float_t min_8[4] = {")
+    (for-each
+     (lambda (choice)
+       (format file "~1,4F, " (get-best choice 256)))
+     '(:all :odd :even))
+    (format file "~1,4F};~%" (get-best :prime 256))
+
+    (format file "  static mus_float_t min_9[4] = {")
+    (for-each
+     (lambda (choice)
+       (format file "~1,4F, " (get-best choice 512)))
+     '(:all :odd :even))
+    (format file "~1,4F};~%" (get-best :prime 512))
+
+    (format file "  static mus_float_t min_10[4] = {")
+    (for-each
+     (lambda (choice)
+       (format file "~1,4F, " (get-best choice 1024)))
+     '(:all :odd :even))
+    (format file "~1,4F};~%" (get-best :prime 1024))
+
+    (format file "  static mus_float_t min_11[4] = {")
+    (for-each
+     (lambda (choice)
+       (format file "~1,4F, " (get-best choice 2048)))
+     '(:all :odd :even))
+    (format file "~1,4F};~%" (get-best :prime 2048))
+
+    (close-output-port file)))
+
+(define (min-peak choice n)
+  (let* ((val (vector-ref (case choice 
+			    ((:all) noid-min-peak-phases)
+			    ((:odd) nodd-min-peak-phases)
+			    ((:even) neven-min-peak-phases)
+			    (else primoid-min-peak-phases))
+			  (cond ((<= n 128) (- n 1))
+				((assv n '((256 . 128) (512 . 129) (1024 . 130))) => cdr)
+				(else 131))))
+	 (a-val (vector-ref val 1))
+	 (a-len (length val))
+	 (v #f)
+	 (len 0))
+    (do ((k 2 (+ k 1)))
+	((>= k a-len)
+	 a-val)
+      (set! v (vector-ref val k))
+      (cond ((float-vector? v)
+	     (set! len (length v))
+	     (if (not (= n len))
+		 (let-temporarily ((*s7* 'print-length) 4)
+		   (format () "~A ~D[~D]: vector length = ~D (~A ~A)~%" 
+			   choice n k 
+			   len
+			   (float-vector-ref val (- k 1))
+			   v)))
+	     (do ((i 0 (+ i 1)))
+		 ((= i len))
+	       (if (> (abs (float-vector-ref v i)) 2.0)
+		   (format () "~A ~D[~D][~D]: needs mod: ~A~%" choice n k i (float-vector-ref v i)))))
+	    
+	    ((real? v)
+	     (set! a-val (min a-val v)))
+	    
+	    (else
+	     (format () "~A ~D[~D]: bad entry: ~A (a-len: ~A)~%" choice n k v a-len))))))
+
+(define (get-worst-overall choice choices)
+  (let ((diffs (make-vector 116))
+	(total 0.0)
+	(this 0.0)
+	(last 0.0)
+	(next 0.0)
+	(choice-list ())
+	(first (get-best choice 11)))
+    (set! this first)
+    (set! next (get-best choice 12))
+    (do ((i 12 (+ i 1)))
+	((= i 128))
+      (set! last this)
+      (set! this next)
+      (set! next (get-best choice (+ i 1)))
+      (set! (diffs (- i 12)) (cons i (- this (* 0.5 (+ last next)))))
+      (set! total (+ total (abs (- this last)))))
+    (sort! diffs (lambda (a b)
+		   (> (cdr a) (cdr b))))
+    (do ((i (- choices 1) (- i 1)))
+	((< i 0))
+      (set! choice-list (cons (diffs i) choice-list)))
+
+    (list choice-list (- (+ total first) this)))) ; first to this would be a straight line
+
+
+(define (get-worst-jump choice choices)
+  (let ((start 40))
+    (let ((+diffs (make-vector (- 128 start) #f))
+	  (-diffs (make-vector (- 128 start) #f))
+	  (last 0.0)
+	  (+choice-list ())
+	  (-choice-list ())
+	  (this (get-best choice (- start 1))))
+      (do ((i start (+ i 1)))
+	  ((= i 128))
+	(set! last this)
+	(set! this (get-best choice i))
+	(set! (+diffs (- i start)) (cons i (- this last)))
+	(set! (-diffs (- i start)) (cons i (- last this))))
+      (sort! +diffs (lambda (a b)
+		      (> (cdr a) (cdr b))))
+      (sort! -diffs (lambda (a b)
+		      (> (cdr a) (cdr b))))
+      (do ((i (- choices 1) (- i 1)))
+	  ((< i 0))
+	(set! +choice-list (cons (+diffs i) +choice-list))
+	(set! -choice-list (cons (-diffs i) -choice-list)))
+      (list +choice-list -choice-list))))
+  
+  
+(define (base-case)
+  (let ((all-lgs (list (list 1.0 :all 256 120.0) (list 1.0 :all 256 120.0) (list 1.0 :all 256 120.0) (list 1.0 :all 256 120.0)))
+	(odd-lgs (list (list 1.0 :all 256 120.0) (list 1.0 :all 256 120.0) (list 1.0 :all 256 120.0) (list 1.0 :all 256 120.0)))
+	(even-lgs (list (list 1.0 :all 256 120.0) (list 1.0 :all 256 120.0) (list 1.0 :all 256 120.0) (list 1.0 :all 256 120.0)))
+	(prime-lgs (list (list 1.0 :all 256 120.0) (list 1.0 :all 256 120.0) (list 1.0 :all 256 120.0) (list 1.0 :all 256 120.0)))
+	(sum 0.0)
+	(even-sqrts 0)
+	(odd-sqrts 0)
+	(all-sqrts 0)
+	(prime-sqrts 0)
+	(all-dist 0.0)
+	(odd-dist 0.0)
+	(even-dist 0.0)
+	(prime-dist 0.0)
+	(all-under 0.0)
+	(odd-under 0.0)
+	(even-under 0.0)
+	(prime-under 0.0)
+					;(upper-limit 0.504)
+	(escape #\escape))
+    (let ((red-text (format #f "~C[31m" escape))
+	  (normal-text (format #f "~C[0m" escape))
+	  (bold-text (format #f "~C[1m" escape))
+	  (unbold-text (format #f "~C[22m" escape)))
+      
+      (do ((i 2 (+ i 1)))
+	  ((> i 128))
+	(for-each
+	 (lambda (choice)
+	   (let* ((mn (min-peak choice i))
+		  (lg (log mn i)))
+	     (case choice 
+	       ((:all)
+		(if (< mn (sqrt i)) (set! all-sqrts (+ all-sqrts 1)))
+		(set! all-lgs (cons (list lg choice i mn) all-lgs)))
+
+	       ((:odd)
+		(if (< mn (sqrt i)) (set! odd-sqrts (+ odd-sqrts 1)))
+		(set! odd-lgs (cons (list lg choice i mn) odd-lgs)))
+
+	       ((:prime)
+		(if (< mn (sqrt i)) (set! prime-sqrts (+ prime-sqrts 1)))
+		(set! prime-lgs (cons (list lg choice i mn) prime-lgs)))
+
+	       ((:even)
+		(if (< mn (sqrt i)) (set! even-sqrts (+ even-sqrts 1)))
+		(set! even-lgs (cons (list lg choice i mn) even-lgs))))
+	     
+	     (set! sum (+ sum mn))
+	     (when (> i 6)
+	       (if (> mn (sqrt i))
+		   (case choice
+		     ((:all) (set! all-dist (+ all-dist (- mn (sqrt i)))))
+		     ((:odd) (set! odd-dist (+ odd-dist (- mn (sqrt i)))))
+		     ((:even) (set! even-dist (+ even-dist (- mn (sqrt i)))))
+		     (else (set! prime-dist (+ prime-dist (- mn (sqrt i))))))
+		   (case choice
+		     ((:all) (set! all-under (+ all-under (- (sqrt i) mn))))
+		     ((:odd) (set! odd-under (+ odd-under (- (sqrt i) mn))))
+		     ((:even) (set! even-under (+ even-under (- (sqrt i) mn))))
+		     (else (set! prime-under (+ prime-under (- (sqrt i) mn)))))))
+	     ))
+	 '(:all :odd :prime :even)))
+      
+      (format () "~%sum: ~A, sqrts: ~A ~A ~A ~A (~1,4F)~%~%" sum all-sqrts odd-sqrts prime-sqrts even-sqrts (+ all-dist odd-dist))
+      
+      (for-each ; pick up the top four as well
+       (lambda (i)
+	 (for-each
+	  (lambda (choice)
+	    (let* ((mn (min-peak choice i))
+		   (lg (and (number? mn) (log mn i))))
+	      (if mn
+		  (case choice
+		    ((:all)
+		     (if (< mn (sqrt i)) (set! all-sqrts (+ all-sqrts 1)))
+		     (set! all-lgs (cons (list lg choice i mn) all-lgs)))
+
+		    ((:odd)
+		     (if (< mn (sqrt i)) (set! odd-sqrts (+ odd-sqrts 1)))
+		     (set! odd-lgs (cons (list lg choice i mn) odd-lgs)))
+
+		    ((:prime)
+		     (if (< mn (sqrt i)) (set! prime-sqrts (+ prime-sqrts 1)))
+		     (set! prime-lgs (cons (list lg choice i mn) prime-lgs)))
+
+		    ((:even)
+		     (if (< mn (sqrt i)) (set! even-sqrts (+ even-sqrts 1)))
+		     (set! even-lgs (cons (list lg choice i mn) even-lgs))))
+		  (format () "no min? ~A ~A~%" choice i))))
+	  '(:all :odd :prime :even)))
+       '(256 512 1024 2048))
+      
+      (set! all-lgs (sort! all-lgs (lambda (a b) (< (car a) (car b)))))
+      (set! odd-lgs (sort! odd-lgs (lambda (a b) (< (car a) (car b)))))
+      (set! even-lgs (sort! even-lgs (lambda (a b) (< (car a) (car b)))))
+      (set! prime-lgs (sort! prime-lgs (lambda (a b) (< (car a) (car b)))))
+      
+      (for-each
+       (lambda (lst name)
+	 (let ((last 0))
+	   (do ((n (- (length lst) 1) (- n 1)))
+	       ((and (> (caddr (list-ref lst n)) 20)
+		     (<= (caddr (list-ref lst n)) 128))
+		(set! last n)))
+	   (format () "    ~A ~1,4F (~A) to ~1,4F (~A), dist: ~1,4F, ~1,4F~%" 
+		   name
+		   (caar lst) (caddar lst) 
+		   (car (list-ref lst last)) (caddr (list-ref lst last))
+		   (case name 
+		     ((all) all-dist)
+		     ((odd) odd-dist)
+		     ((even) even-dist)
+		     (else prime-dist))
+		   (case name
+		     ((all) all-under)
+		     ((odd) odd-under)
+		     ((even) even-under)
+		     (else prime-under)))))
+       (list all-lgs odd-lgs even-lgs prime-lgs)
+       '(all odd even prime))
+      
+      (format () "~%")
+      (format () "~A~96,'-T~A~%" red-text normal-text)
+      (format () "~A~12Tall~37Todd~62Teven~86Tprime~A~%" bold-text unbold-text)
+      (format () "~A~96,'-T~A~%" red-text normal-text)
+      
+      (do ((i 0 (+ i 1)))
+	  ((= i 131))
+	(let* ((all (list-ref all-lgs i)) ; '(exp :all n peak)
+	       (odd (list-ref odd-lgs i))
+	       (even (list-ref even-lgs i))
+	       (prime (list-ref prime-lgs i))
+	       (bold-all (<= (car all) 0.5))
+	       (bold-odd (<= (car odd) 0.5)))
+	  (format () (if bold-all
+			 (if bold-odd
+			     "~A~D~11T~1,3F~20T~1,4F~A~33T| ~A~D~45T~1,3F~53T~1,4F~A~67T| ~D~74T~1,3F~82T~1,4F~91T| ~D~99T~1,3F~107T~1,4F~%"
+			     "~A~D~11T~1,3F~20T~1,4F~A~33T| ~*~D~41T~1,3F~49T~1,4F~*~58T| ~D~65T~1,3F~73T~1,4F~82T| ~D~90T~1,3F~98T~1,4F~%")
+			 (if bold-odd
+			     "~*~D~7T~1,3F~16T~1,4F~*~24T| ~A~D~36T~1,3F~44T~1,4F~A~58T| ~D~65T~1,3F~73T~1,4F~82T| ~D~90T~1,3F~98T~1,4F~%"
+			     "~*~D~7T~1,3F~16T~1,4F~*~24T| ~*~D~32T~1,3F~40T~1,4F~*~49T| ~D~56T~1,3F~64T~1,4F~73T| ~D~81T~1,3F~89T~1,4F~%"))
+		  bold-text
+		  (caddr all) (cadddr all) (car all)
+		  unbold-text      
+		  bold-text
+		  (caddr odd) (cadddr odd) (car odd)
+		  unbold-text
+		  (caddr even) (cadddr even) (car even)
+		  (caddr prime) (cadddr prime) (car prime)
+		  )))))
+  
+  (write-best-cases)
+  
+  (for-each
+   (lambda (choice)
+     (let* ((data (get-worst-overall choice 7))
+	    (choices (car data))
+	    (total (cadr data)))
+       (format () "~%~A ~,2F:~14T" choice total)
+       (do ((i 0 (+ i 1)))
+	   ((= i 7))
+	 (format () "(~A ~,2F)~A " 
+		 (car (list-ref choices i)) 
+		 (cdr (list-ref choices i))
+		 (if (>= (car (list-ref choices i)) 100) "" " ")))))
+   '(:all :odd :even :prime))
+  (format () "~%~%")
+  )
+
+
+(define (checks)
+  ;; now check for stupid mistakes...
+  
+  (let ((previous-version (if (file-exists? "/home/bil/cl_copy/peak-phases.scm")
+			      "/home/bil/cl_copy/peak-phases.scm"
+			      "/home/bil/dist/snd/peak-phases.scm")))
+    (let ((alls (make-vector 129))
+	  (odds (make-vector 129))
+	  (evens (make-vector 129))
+	  (primes (make-vector 129)))
+      (do ((i 2 (+ i 1)))
+	  ((> i 128))
+	(vector-set! alls i (min-peak :all i))
+	(vector-set! odds i (min-peak :odd i))
+	(vector-set! evens i (min-peak :even i))
+	(vector-set! primes i (min-peak :prime i)))
+
+      (load previous-version)
+      (do ((i 2 (+ i 1)))
+	  ((> i 128))
+	(let ((old-all (min-peak :all i))
+	      (old-odd (min-peak :odd i))
+	      (old-even (min-peak :even i))
+	      (old-prime (min-peak :prime i)))
+	  (if (< old-all (vector-ref alls i)) (format () ":all ~D: ~A to ~A~%" i old-all (alls i)))
+	  (if (< old-odd (vector-ref odds i)) (format () ":odd ~D: ~A to ~A~%" i old-odd (odds i)))
+	  (if (< old-even (vector-ref evens i)) (format () ":even ~D: ~A to ~A~%" i old-even (evens i)))
+	  (if (< old-prime (vector-ref primes i)) (format () ":prime ~D: ~A to ~A~%" i old-prime (primes i))))))))
+
+
+(base-case)
+(checks)
+
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(exit)
diff --git a/s7/tools/trclo.scm b/s7/tools/trclo.scm
new file mode 100644
index 0000000..d627a78
--- /dev/null
+++ b/s7/tools/trclo.scm
@@ -0,0 +1,459 @@
+;;; tletr
+
+;;; --------------------------------------------------------------------------------
+;;; or/and
+
+(define big-list (make-list 10000 1))
+
+(define (and-1 lst)
+  (let loop ((x lst))
+    (and (pair? x)
+	 (or (symbol? (car x))
+	     (loop (cdr x))))))
+
+(define (and-2 lst)
+  (let loop ((x lst))
+    (or (null? x)
+	(and (integer? (car x))
+	     (loop (cdr x))))))
+
+(define (and-3 lst)
+  (let loop ((x lst) (count 10000))
+    (and (positive? count)
+	 (or (null? x)
+	     (loop (cdr x) (- count 1))))))
+
+(define (and-4 lst)
+  (let loop ((x lst) (count 10000))
+    (or (null? x)
+	(and (positive? count)
+	     (loop (cdr x) (- count 1))))))
+
+(define (and*-1 lst)
+  (let* loop ((x lst))
+    (and (pair? x)
+	 (or (symbol? (car x))
+	     (loop (cdr x))))))
+
+(define (and-f)
+  (if (and-1 big-list) (format () "and-1 returned #t\n"))
+  ;(if (and*-1 big-list) (format () "and*-1 returned #t\n"))
+  (if (not (and-2 big-list)) (format () "and-2 returned #f\n"))
+  (if (and-3 big-list) (format () "and-3 returned #t\n"))
+  (if (not (and-4 big-list)) (format () "and-4 returned #f\n")))
+
+
+;;; --------
+
+(define (pand-1 x)             ; rclo_and_a_or_a_la
+  (and (pair? x)
+       (or (symbol? (car x))
+	   (pand-1 (cdr x)))))
+
+(define (dpand-1 lst)
+  (define (dpand-11 x)
+    (and (pair? x)
+	 (or (symbol? (car x))
+	     (dpand-11 (cdr x)))))
+  (dpand-11 lst))
+
+(define (pand-2 x)             ; rclo_or_a_and_a_la
+  (or (null? x)
+      (and (integer? (car x))
+	   (pand-2 (cdr x)))))
+
+(define (pand-3 x count)
+  (and (positive? count)
+       (or (null? x)
+	   (pand-3 (cdr x) (- count 1)))))
+
+(define (pand-4 x count)
+  (or (null? x)
+      (and (positive? count)
+	   (pand-4 (cdr x) (- count 1)))))
+
+(define (pand-f)
+  (if (pand-1 big-list) (format () "pand-1 returned #t\n"))
+  (if (dpand-1 big-list) (format () "dpand-1 returned #t\n"))
+  (if (not (pand-2 big-list)) (format () "pand-2 returned #f\n"))
+  (if (pand-3 big-list 10000) (format () "pand-3 returned #t\n"))
+  (if (not (pand-4 big-list 10000)) (format () "pand-4 returned #f\n")))
+
+
+;;; --------------------------------------------------------------------------------
+;;; if
+
+(define (sum-1 n)
+  (let loop ((i n) (sum 0))
+    (if (< i 0)
+        sum
+        (loop (- i 1) (+ i sum)))))
+
+(define (sum*-1 n)
+  (let* loop ((i n) (sum 0))
+    (if (< i 0)
+        sum
+        (loop (- i 1) (+ i sum)))))
+
+(define (sum-2 n)
+  (let loop ((i n) (sum 0.0))
+    (if (< i 0.0)
+        sum
+        (loop (- i 1.0) (+ i sum)))))
+
+(define (esum-2 n)
+  (let loop ((i n) (sum 0))
+    (if (< i 0.0)
+        sum
+        (loop (- i 1.0) (+ i sum)))))
+
+(define (sum-3 n)
+  (let loop ((i n) (sum 0))
+    (if (>= i 0)
+        (loop (- i 1) (+ i sum))
+        sum)))
+
+(define (sum-4 n)
+  (let loop ((i n) (sum 0.0))
+    (if (>= i 0.0)
+        (loop (- i 1.0) (+ i sum))
+        sum)))
+
+(define (sum-5 n)
+  (let loop ((i n) (sum 0))
+    (if (< i -1)
+	-2
+	(if (< i 0)
+	    sum
+	    (loop (- i 1) (+ sum i))))))
+
+(define big-str (make-string 10000 #\b))
+
+(define (sum-6 str)
+  (let loop ((i (- (length str) 1)))
+    (if (< i 0)
+	#f
+	(if (char=? (string-ref str i) #\a)
+	    #\?
+	    (loop (- i 1))))))
+
+(define (llet-1 x y)             ; rclo_let_if_a_laa
+  (let loop ((x x) (y y))
+    (let ((z (+ x y)))
+      (if (< z 0)
+	  z
+	  (loop (- x 1) (- y 1))))))
+
+(define (sum-f)
+  (let ((n (sum-1 10000)))
+    (if (not (= n 50005000))
+	(format () ";sum1: ~A~%" n)))
+#|
+  (let ((n (sum*-1 10000)))
+    (if (not (= n 50005000))
+	(format () ";sum*-1: ~A~%" n)))
+|#
+  (let ((result (sum-2 10000.0)))
+    (if (not (equal? result 50005000.0))
+	(format () ";sum-2: ~A~%" result)))
+#|
+  (let ((result (esum-2 10000)))
+    (if (or (not (float? result))
+	    (not (equal? result 50005000.0)))
+	(format () ";esum-2: ~A~%" result)))
+|#
+  (let ((n (sum-3 10000)))
+    (if (not (= n 50005000))
+	(format () ";sum-3: ~A~%" n)))
+
+  (let ((result (sum-4 10000.0)))
+    (if (not (equal? result 50005000.0))
+	(format () ";sum-4: ~A~%" result)))
+
+  (let ((result (sum-5 10000)))
+    (if (not (= result 50005000))
+	(format () ";sum-5: ~A~%" n)))
+
+  (let ((result (sum-6 big-str)))
+    (if result
+	(format () ";sum-6: ~A~%" result)))
+
+  (let ((result (llet-1 10000 10001)))
+    (if (not (= result -1))
+	(format () ";llet-1: ~A~%" result))))
+
+;;; --------
+
+(define (psum-1 i sum)
+  (if (< i 0)
+      sum
+      (psum-1 (- i 1) (+ i sum))))
+
+(define (dpsum-1 n s)
+  (define* (dpsum-11 i sum)
+    (if (< i 0)
+	sum
+	(dpsum-11 (- i 1) (+ i sum))))
+  (dpsum-11 n s))
+
+(define (npsum-1 i sum)
+  (if (not (< i 0))
+      (psum-1 (- i 1) (+ i sum))
+      sum))
+
+(define (psum-2 i sum)
+  (if (< i 0.0)
+      sum
+      (psum-2 (- i 1.0) (+ i sum))))
+
+(define dpsum-2 
+  (lambda (i sum)
+    (if (< i 0.0)
+	sum
+	(dpsum-2 (- i 1.0) (+ i sum)))))
+
+(define (psum-3 i sum)
+  (if (>= i 0)
+      (psum-3 (- i 1) (+ i sum))
+      sum))
+
+(define (psum-4 i sum)
+  (if (>= i 0.0)
+      (psum-4 (- i 1.0) (+ i sum))
+      sum))
+
+(define (psum-5 i sum)
+  (if (< i -1)
+      -2
+      (if (< i 0)
+	  sum
+	  (psum-5 (- i 1) (+ sum i)))))
+
+(define (psum-6 i)
+  (if (< i 0)
+      #f
+      (if (char=? (string-ref big-str i) #\a)
+	  #\?
+	  (psum-6 (- i 1)))))
+
+(define (psum-7 L)
+  (if (null? (cdr L))
+      (car L)
+      (psum-7 (cdr L))))
+
+(define (psum-8 L)
+  (if (pair? (cdr L))
+      (psum-8 (cdr L))
+      (car L)))
+
+(define (psum-9 L)
+  (letrec ((p9 (lambda (x)
+		 (if (pair? (cdr x))
+		     (p9 (cdr x))
+		     (car x)))))
+    (p9 L)))
+
+(define (plet-1 x y)             ; rclo_let_if_a_laa
+  (let ((z (+ x y)))
+    (if (< z 0)
+	z
+	(plet-1 (- x 1) (- y 1)))))
+
+
+(define (psum-f)
+  (let ((n (psum-1 10000 0)))
+    (if (not (= n 50005000))
+	(format () ";psum-1: ~A~%" n)))
+#|
+  (let ((n (dpsum-1 10000 0)))
+    (if (not (= n 50005000))
+	(format () ";dpsum-1: ~A~%" n)))
+|#
+  (let ((n (npsum-1 10000 0)))
+    (if (not (= n 50005000))
+	(format () ";npsum-1: ~A~%" n)))
+
+  (let ((result (psum-2 10000.0 0.0)))
+    (if (not (equal? result 50005000.0))
+	(format () ";psum-2: ~A~%" result)))
+
+  (let ((result (dpsum-2 10000.0 0.0)))
+    (if (not (equal? result 50005000.0))
+	(format () ";dpsum-2: ~A~%" result)))
+
+  (let ((n (psum-3 10000 0)))
+    (if (not (= n 50005000))
+	(format () ";psum-3: ~A~%" n)))
+
+  (let ((result (psum-4 10000.0 0.0)))
+    (if (not (equal? result 50005000.0))
+	(format () ";psum-4: ~A~%" result)))
+
+  (let ((result (psum-5 10000 0)))
+    (if (not (= result 50005000))
+	(format () ";psum-5: ~A~%" result)))
+
+  (let ((result (psum-6 9999)))
+    (if result
+	(format () ";psum-6: ~A~%" result)))
+
+  (let-temporarily (((big-list 9999) 2))
+    (let ((result (psum-7 big-list)))
+      (if (not (= result 2))
+	  (format () ";psum-7: ~A~%" result)))
+
+    (let ((result (psum-8 big-list)))
+      (if (not (= result 2))
+	  (format () ";psum-8: ~A~%" result)))
+
+    (let ((result (psum-9 big-list)))
+      (if (not (= result 2))
+	  (format () ";psum-9: ~A~%" result))))
+
+  (let ((result (plet-1 10000 10001)))
+    (if (not (= result -1))
+	(format () ";plet-1: ~A~%" result))))
+
+;;; --------
+
+(define when-size 3000)
+
+(define (when1 fv z)
+  (let ((x (vector-ref fv 0)))
+    (when (< x when-size)
+      (vector-set! fv 0 z)
+      (when1 fv (+ z 1)))))
+
+(define (unless1 fv z)
+  (let ((x (vector-ref fv 0)))
+    (unless (>= x when-size)
+      (vector-set! fv 0 z)
+      (unless1 fv (+ z 1)))))
+
+(define (when2 fv z)
+  (let ((x (vector-ref fv 0)))
+    (when (< x z)
+      (vector-set! fv 0 (+ x 1))
+      (when2 fv z))))
+
+(define (unless2 fv z)
+  (let ((x (vector-ref fv 0)))
+    (unless (>= x z)
+      (vector-set! fv 0 (+ x 1))
+      (unless2 fv z))))
+
+(define (when3 fv z)
+  (let ((x (vector-ref fv 0)))
+    (when (< x z)
+      (vector-set! fv 0 (+ x 1))
+      (vector-set! fv 0 (+ x 1))
+      (when3 fv z))))
+
+(define (when-f)
+  (when1 (vector 0) 0)
+  (unless1 (vector 0) 0)
+  (when2 (vector 0) when-size)
+  (unless2 (vector 0) when-size)
+  (when3 (vector 0) when-size))
+
+;;; --------
+
+(define (cond1 x y)
+  (cond ((null? x) y)
+	((null? y) #f)
+	(else (cond1 (cdr x) (cdr y)))))
+
+(define (cond2 x y)
+  (cond ((null? x) y)
+	(else (cond2 (cdr x) y))))
+
+(define (cond3 x)
+  (cond ((null? x) 0)
+	(else (cond3 (cdr x)))))
+
+(define (cond4 x y)
+  (cond ((null? x) 0)
+	((null? y) (cond4 (cdr x) y))
+	(else (cond4 (cdr x) (cdr y)))))
+
+(define (cond5 lst res)
+  (cond ((null? lst) (reverse res))
+	((eqv? (car lst) 1) (cond5 (cdr lst) res))
+	((eqv? (car lst) 2) (cond5 (cdr lst) res))
+	(#t (cond5 (cdr lst) (cons (car lst) res)))))
+
+(define (lcond1 x y)
+  (let ((z (+ x y)))
+    (cond ((= z 0) pi)
+	  ((< z 0) 'oops)
+	  (else (lcond1 (- x 1) (- y 1))))))
+
+(define (lcond2 x)
+  (let ((z (+ x 1)))
+    (cond ((= z 0) pi)
+	  ((< z 0) 'oops)
+	  (else (lcond2 (- x 1))))))
+
+  (display (lcond2 5000)) (newline)
+
+(define (lcond3 x y)
+  (let ((z (+ x y)))
+    (cond ((= z 0) pi)
+	  ((< z 0) (lcond3 (+ x 1) y))
+	  (else (lcond3 (- x 1) y)))))
+
+(define (lcond4 x y z)
+  (let ((a (+ x y z)))
+    (cond ((= z 0) pi)
+	  (else (lcond4 x (- y 1) (- z 1))))))
+
+(define (cond-f)
+  (cond1 big-list big-list)
+  (cond2 big-list big-list)
+  (cond3 big-list)
+  (cond4 big-list big-list)
+  (do ((i 0 (+ i 1))) ((= i 1000)) (cond5 '(1 3 2 5 4 3 1) ()))
+  (lcond1 5000 5000)
+  (lcond2 5000)
+  (lcond3 5000 5000)
+  (lcond4 5000 5000 5000))
+  
+;;; --------------------------------------------------------------------------------
+
+;;; from bug-guile
+(define (fdot . lst)
+  (let lp2 ((i 0) (s 0) (lst lst))
+    (if (and (pair? lst)
+	     (< i 64))
+        (lp2 (+ i 1) 
+	     (if (car lst) 
+                 (logior (ash 1 i) s) 
+                 s) 
+             (cdr lst))
+        s)))
+
+(unless (= (fdot #f #t #t #f #f #t #f) 38) (format *stderr* "fdot: ~S~%" (fdot #f #t #t #f #f #t #f)))
+
+(define (test-fdot)
+  (do ((i 0 (+ i 1)))
+      ((= i 10000))
+    (fdot #f #t #t #f #f #t #f #f)))
+
+;;; --------------------------------------------------------------------------------
+(define (tests)
+  (do ((i 0 (+ i 1)))
+      ((= i 100))
+    (sum-f)
+    (and-f)
+    (psum-f)
+    (pand-f)
+    (when-f)
+    (cond-f)
+    ))
+(test-fdot)
+
+(tests)
+
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(exit)
diff --git a/s7/tools/tread.scm b/s7/tools/tread.scm
new file mode 100644
index 0000000..6d2b760
--- /dev/null
+++ b/s7/tools/tread.scm
@@ -0,0 +1,129 @@
+(load "write.scm")
+(load "s7test-block.so" (sublet (curlet) (cons 'init_func 'block_init)))
+
+(set! (*s7* 'print-length) 8) ; :readable should ignore this
+(set! (*s7* 'default-hash-table-length) 4)
+;(set! (*s7* 'heap-size) (* 10 1024000))
+
+(define (all-copy v1 v2)
+  (do ((i 0 (+ i 1)))
+      ((= i 7))
+    (vector-set! v2 i (copy (vector-ref v1 i)))))
+
+(define (tester)
+  (let ((base-vector (vector (make-list 3 #f)
+			     (make-vector 3 #f)
+			     (make-cycle #f)
+			     (hash-table 'a 1 'b 2 'c 3)
+			     (inlet 'a 1 'b 2 'c 3)
+			     (make-iterator (make-list 3 #f))
+			     (c-pointer 1 (make-list 3 #f)))))
+    (do ((baddies 0)
+	 (size 3 (+ size 1)))
+	((= size 4))
+      (format *stderr* "~%-------- ~D --------~%" size)
+      
+      (do ((tries (* 2000 (expt 3 size)))
+	   (k 0 (+ k 1)))
+	  ((or (= k tries)
+	       (> baddies 1)))
+	
+	(let ((cp-lst (make-list 3 #f))
+	      (it-lst (make-list 3 #f)))
+	  (let ((bases (make-vector 7))
+		(sets ())
+		(b1 0)
+		(b2 0))
+	    (all-copy base-vector bases)
+	    (do ((i 0 (+ i 1))
+		 (r1 (random 7) (random 7))
+		 (r2 (random 7) (random 7))
+		 (loc (random 3) (random 3)))
+		((= i size))
+	      (set! b1 (bases r1))
+	      (set! b2 (bases r2))
+	      (case (type-of b1)
+		((pair?)
+		 (if (> (random 10) 3)
+		     (begin
+		       (set! (b1 loc) b2)
+		       (set! sets (cons (list r1 loc r2) sets)))
+		     (begin
+		       (set-cdr! (cddr b1) (case loc ((0) b1) ((1) (cdr b1)) (else (cddr b1))))
+		       (set! sets (cons (list r1 (+ loc 3) r2) sets)))))
+		
+		((vector?)
+		 (set! (b1 loc) b2)
+		 (set! sets (cons (list r1 loc r2) sets)))
+		
+		((c-object?)
+		 (set! (b1 0) b2)
+		 (set! sets (cons (list r1 0 r2) sets)))
+		
+		((hash-table? let?)
+		 (let ((key (#(a b c) loc)))
+		   (set! (b1 key) b2)
+		   (set! sets (cons (list r1 key r2) sets))))
+		
+		((c-pointer?)
+		 (set! (cp-lst loc) b2)
+		 (set! sets (cons (list r1 loc r2) sets)))
+		
+		((iterator?)
+		 (set! (it-lst loc) b2)
+		 (set! sets (cons (list r1 loc r2) sets)))))
+	    
+	    (let ((bi 0))
+	      (for-each 
+	       (lambda (x)
+		 (let ((str (object->string x :readable)))
+		   (unless (equal? x (eval-string str))
+		     (set! baddies (+ baddies 1))
+		     (format *stderr* "x: ~S~%" x)
+		     (format *stderr* "ex: ~S~%" (eval-string str))
+		     (format *stderr* "sets: ~S~%" (reverse sets))
+		     (format *stderr* "str: ~S~%" str)
+		     (pretty-print (with-input-from-string str read) *stderr* 0)
+		     (format *stderr* "~%~%")
+		     
+		     (format *stderr* "
+                     (let ((p (make-list 3 #f))
+                           (v (make-vector 3 #f))
+                           (cy (make-cycle #f))
+                           (h (hash-table 'a 1 'b 2 'c 3))
+                           (e (inlet 'a 1 'b 2 'c 3))
+                           (it (make-iterator (make-list 3 #f)))
+                           (cp (c-pointer 1 (make-list 3 #f))))
+                           ")
+		     (for-each
+		      (lambda (set)
+			(cond ((and (zero? (car set))
+				    (> (cadr set) 2))
+			       (format *stderr* "  (set-cdr! (list-tail p 2) ~A)~%" 
+				       (#("p" "(cdr p)" "(cddr p)") (- (cadr set) 3))))
+			      ((< (car set) 5)
+			       (format *stderr* "  (set! (~A ~A) ~A)~%" 
+				       (#(p v cy h e) (car set))
+				       (case (car set) 
+					 ((0 1) (cadr set))
+					 ((2) 0)
+					 ((3) (format #f "~W" (cadr set)))
+					 ((4) (symbol->keyword (cadr set))))
+				       (#(p v cy h e it cp) (caddr set))))
+			      ((= (car set) 5)
+			       (format *stderr* "  (set! ((iterator-sequence it) ~A) ~A)~%" 
+				       (cadr set) 
+				       (#(p v cy h e it cp) (caddr set))))
+			      (else (format *stderr* "  (set! (((object->let cp) 'c-type) ~A) ~A)~%" 
+					    (cadr set)
+					    (#(p v cy h e it cp) (caddr set))))))
+		      sets)
+		     (format *stderr* "  ~A)~%" (#(p v cy h e it cp) bi)))
+		   (set! bi (+ bi 1))))
+	       bases))))))))
+
+(tester)
+
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(exit)
diff --git a/s7/tools/trec.scm b/s7/tools/trec.scm
new file mode 100644
index 0000000..bfa509e
--- /dev/null
+++ b/s7/tools/trec.scm
@@ -0,0 +1,332 @@
+(set! (*s7* 'heap-size) (* 4 1024000))
+
+(if (not (defined? 'unless))
+    (define-macro (unless test . body)
+      `(if (not ,test) (begin ,@body))))
+
+(define (fib n)
+  (if (<= n 2)
+      1
+      (+ (fib (- n 1))
+         (fib (- n 2)))))
+
+(let ((f32 (fib 32)))
+  (unless (= f32 2178309) ;3524578)
+    (format *stderr* "fib ~A~%" f32)))
+
+
+(define (fibr n)
+  (if (> n 2)
+      (+ (fibr (- n 1))
+         (fibr (- n 2)))
+      1))
+
+(let ((f32 (fibr 32)))
+  (unless (= f32 2178309) ;3524578)
+    (format *stderr* "fibr ~A~%" f32)))
+
+
+(define (fibc n)
+  (cond ((< n 1) n) ; dumb buts hits oprec_cond_a_a_a_a_opla_laq
+	((< n 2) n)
+	(else (+ (fibc (- n 1))
+		 (fibc (- n 2))))))
+
+(let ((f32 (fibc 32)))
+  (unless (= f32 2178309) ;3524578)
+    (format *stderr* "fibc ~A~%" f32)))
+
+
+(define (tfib n a b) ; tail-call version, a=1 b=1 initially
+   (if (= n 0)
+       a
+       (if (= n 1)
+           b
+           (tfib (- n 1) b (+ a b)))))
+
+;;; overflow at (tfib 92): (tfib 92) 12200160415121877000.0, (tfib 91) 7540113804746346429 [this numbering is off-by-1]
+;;;                              93: 12200160415121876738          92: 7540113804746346429 http://www.maths.surrey.ac.uk/hosted-sites/R.Knott/Fibonacci/fibtable.html
+
+(define (dfib Z)             ; do-loop equivalent to tfib
+  (do ((a 1 b)
+       (b 1 (+ a b))
+       (n Z (- n 1)))
+      ((< n 2)
+       (if (= n 0) a b))))
+
+(define (dofib n)            ; another do-loop (maybe slightly slower than tfib)
+  (if (< n 2)
+      1
+      (do ((a 1)
+	   (b 1)
+	   (c 0)
+	   (i 1 (+ i 1)))
+	  ((= i n) b)
+	(set! c b)
+	(set! b (+ a b))
+	(set! a c))))
+
+(unless (= (dfib 91) 7540113804746346429)
+  (format *stderr* "(dfib 91): ~D~%" (dfib 91)))
+(unless (= (dofib 91) 7540113804746346429)
+  (format *stderr* "(dofib 91): ~D~%" (dofib 91)))
+(unless (= (tfib 91 1 1) 7540113804746346429)
+  (format *stderr* "(tfib 91 1 1): ~D~%" (tfib 91)))
+
+(define size 10000)
+
+(define (test1)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (dfib 91)))
+
+(define (test2)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (dofib 91)))
+
+(define (test3)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (tfib 91 1 1)))
+
+(test1)
+(test2)
+(test3)
+
+
+(define* (tfib* n (a 1) (b 1)) ; tail-call version using lambda*
+   (if (= n 0)
+       a
+       (if (= n 1)
+           b
+           (tfib* (- n 1) b (+ a b)))))
+
+(define (test31)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (tfib* 91)))
+
+(test31)
+
+
+(define (trib n)
+  (if (< n 3)
+      1
+      (+ (trib (- n 1))
+         (trib (- n 2))
+         (trib (- n 3)))))
+
+(let ((f32 (trib 26)))
+  (unless (= f32 3311233)
+    (format *stderr* "trib ~A~%" f32)))
+
+;; tc is much faster:
+(define* (ttrib n (a 1) (b 1) (c 1))
+  (if (= n 0)
+      a
+      (if (= n 1)
+	  b
+	  (if (= n 2)
+	      c
+	      (ttrib (- n 1) b c (+ a b c))))))
+
+(let ((f32 (ttrib 26)))
+  (unless (= f32 3311233)
+    (format *stderr* "ttrib ~A~%" f32)))
+
+
+(define* (tribc n (a 1) (b 1) (c 1))
+  (case n
+    ((0) a)
+    ((1) b)
+    ((2) c)
+    (else (tribc (- n 1) b c (+ a b c)))))
+
+(let ((f32 (tribc 26)))
+  (unless (= f32 3311233)
+    (format *stderr* "tribc ~A~%" f32)))
+
+
+(define all-coins '(50 25 10 5 1)) 
+
+(define (cc amount kinds-of-coins) 
+  (cond ((= amount 0) 1) 
+        ((or (< amount 0) (null? kinds-of-coins)) 0) 
+        (else (+ (cc amount (cdr kinds-of-coins)) 
+                 (cc (- amount (car kinds-of-coins)) kinds-of-coins))))) 
+
+(define (count-change amount) 
+  (cc amount all-coins)) 
+
+(let ((coins (count-change 400)))
+  (unless (= coins 26517)
+    (format *stderr* "cc ~A~%" coins)))
+
+(define (add lst)
+  (let loop ((p lst)
+	     (sum 0))
+    (if (null? p)
+	sum
+	(loop (cdr p) (+ sum (car p))))))
+
+(define big-list (make-list 10000 1))
+
+(define (more-add)
+  (let ((lst big-list))
+    (do ((i 0 (+ i 1)))
+	((= i 1000))
+      (add lst))))
+(more-add)
+
+(define (adder lst)
+  (letrec ((add1 (lambda (L sum)
+		   (if (pair? L)
+		       (add1 (cdr L) (+ sum (car L)))
+		       sum))))
+    (add1 lst 0)))
+
+(define (more-adder)
+  (do ((lst big-list)
+       (i 0 (+ i 1)))
+      ((= i 1000))
+    (adder big-list)))
+
+(more-adder)
+
+(define (got-symbol lst)
+  (and (pair? lst)
+       (or (symbol? (car lst))
+	   (got-symbol (cdr lst)))))
+
+(define (more-symbol)
+  (let ((lst big-list))
+    (do ((i 0 (+ i 1)))
+	((= i 1000))
+      (got-symbol lst))))
+(more-symbol)
+
+(set! big-list #f)
+
+;;; add local-slot do cases to s7test
+
+(define (ack m n)
+  (cond ((= m 0) (+ n 1))
+        ((= n 0) (ack (- m 1) 1))
+        (else (ack (- m 1) (ack m (- n 1))))))
+
+(let ((n (ack 3 8)))
+  (unless (= n 2045)
+    (format *stderr* "ack ~A~%" n)))
+
+(define (tree-eq? a b)
+  (if (not (pair? a))
+      (eq? a b)
+      (and (pair? b)
+	   (tree-eq? (car a) (car b))
+	   (tree-eq? (cdr a) (cdr b)))))
+
+(define tree '((a b) (c d e) (f) () (g h i j) (k (l m (n o)) p) (q ((r) s) (((t (u) v) w) x) y) z))
+(define (more-eq)
+  (do ((i 0 (+ i 1)))
+      ((= i 100000))
+    (tree-eq? tree tree)))
+(more-eq)
+
+
+(define (counts x)
+  (cond ((= x 0) 0)
+	(else (+ 1 (counts (- x 1))))))
+
+(define (more-counts)
+  (do ((i 0 (+ i 1)))
+      ((= i 1000) (counts 1000))
+    (counts 1000)))
+
+(let ((result (more-counts)))
+  (unless (= result 1000)
+    (format *stderr* "counts ~A~%" result)))
+
+
+(define (counts1 x)
+  (if (= x 0) 0
+      (+ 1 (counts1 (- x 1)))))
+
+(define (more-counts1)
+  (do ((i 0 (+ i 1)))
+      ((= i 1000) (counts1 1000))
+    (counts1 1000)))
+
+(let ((result (more-counts1)))
+  (unless (= result 1000)
+    (format *stderr* "counts1 ~A~%" result)))
+
+
+(define (counts2 x)
+  (if (> x 0)
+      (+ 1 (counts2 (- x 1)))
+      0))
+
+(define (more-counts2)
+  (do ((i 0 (+ i 1)))
+      ((= i 1000) (counts2 1000))
+    (counts2 1000)))
+
+(let ((result (more-counts2)))
+  (unless (= result 1000)
+    (format *stderr* "counts2 ~A~%" result)))
+
+
+(define (counts3 x y)
+  (cond ((= x 0) y)
+	(else (+ 1 (counts3 (- x 1) (+ y 1))))))
+
+(define (more-counts3)
+  (do ((i 0 (+ i 1)))
+      ((= i 1000) (counts3 1000 0))
+    (counts3 1000 0)))
+
+(let ((result (more-counts3)))
+  (unless (= result 2000)
+    (format *stderr* "counts3 ~A~%" result)))
+
+
+(define (counts4 x y)
+  (cond ((= x 0) y)
+	((negative? x) 0)
+	(else (+ 1 (counts4 (- x 1) (+ y 1))))))
+
+(define (more-counts4)
+  (do ((i 0 (+ i 1)))
+      ((= i 500) (counts4 1000 0))
+    (counts4 1000 0)))
+
+(let ((result (more-counts4)))
+  (unless (= result 2000)
+    (format *stderr* "counts4 ~A~%" result)))
+
+
+(define (counts5 x)
+  (if (<= x 0)
+      0
+      (+ 1 (counts5 (- x 1)) (counts5 (- x 2)))))
+
+(let ((result (counts5 30)))
+  (unless (= result 2178308)
+    (format *stderr* "counts5 ~A~%" result)))
+
+
+(define (counts6 x)
+  (if (> x 0)
+      (+ 1 (counts6 (- x 1)) (counts6 (- x 2)))
+      0))
+
+(let ((result (counts6 30)))
+  (unless (= result 2178308)
+    (format *stderr* "counts6 ~A~%" result)))
+
+
+
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(exit)
diff --git a/s7/tools/tref.scm b/s7/tools/tref.scm
new file mode 100644
index 0000000..37b074b
--- /dev/null
+++ b/s7/tools/tref.scm
@@ -0,0 +1,232 @@
+(define tries 10)
+
+(define (ft3)
+  (let ((size 100000))
+    (let ((v (make-float-vector size)))
+      (do ((i 0 (+ i 1)))
+	  ((= i tries))
+	(do ((j 0 (+ j 1)))
+	    ((= j size))
+	  (set! (v j) (+ (v j) 1.0))))
+      v)))
+
+(let ((v (ft3)))
+  (if (not (equal? v (make-float-vector 100000 tries)))
+      (format *stderr* "ft3: ~A~%" v)))
+
+(define (ft31)
+  (let ((size 100000))
+    (let ((v (make-float-vector size)))
+      (do ((i 0 (+ i 1)))
+	  ((= i tries))
+	(do ((j 0 (+ j 1)))
+	    ((= j size))
+	  (float-vector-set! v j (+ (float-vector-ref v j) 1.0))))
+      v)))
+
+(let ((v (ft31)))
+  (if (not (equal? v (make-float-vector 100000 tries)))
+      (format *stderr* "ft31: ~A~%" v)))
+
+
+(define (ft4)
+  (let ((size 100000))
+    (let ((v (make-int-vector size)))
+      (do ((i 0 (+ i 1)))
+	  ((= i tries))
+	(do ((j 0 (+ j 1)))
+	    ((= j size))
+	  (set! (v j) (+ (v j) 1))))
+      v)))
+
+(let ((v (ft4)))
+  (if (not (equal? v (make-int-vector 100000 tries)))
+      (format *stderr* "ft4: ~A~%" v)))
+
+(define (ft41)
+  (let ((size 100000))
+    (let ((v (make-int-vector size)))
+      (do ((i 0 (+ i 1)))
+	  ((= i tries))
+	(do ((j 0 (+ j 1)))
+	    ((= j size))
+	  (int-vector-set! v j (+ (int-vector-ref v j) 1))))
+      v)))
+
+(let ((v (ft41)))
+  (if (not (equal? v (make-int-vector 100000 tries)))
+      (format *stderr* "ft41: ~A~%" v)))
+
+
+(define (ft5)
+  (let ((size 100000))
+    (let ((v (make-string size #\a)))
+      (do ((i 0 (+ i 1)))
+	  ((= i tries))
+	(do ((j 0 (+ j 1)))
+	    ((= j size))
+	  (set! (v j) (v j))))
+      v)))
+
+(let ((v (ft5)))
+  (if (not (equal? v (make-string 100000 #\a)))
+      (format *stderr* "ft5: ~A~%" v)))
+
+(define (ft51)
+  (let ((size 100000))
+    (let ((v (make-string size #\a)))
+      (do ((i 0 (+ i 1)))
+	  ((= i tries))
+	(do ((j 0 (+ j 1)))
+	    ((= j size))
+	  (string-set! v j (string-ref v j))))
+      v)))
+
+(let ((v (ft51)))
+  (if (not (equal? v (make-string 100000 #\a)))
+      (format *stderr* "ft51: ~A~%" v)))
+
+
+(define (ft6)
+  (let ((size 100000))
+    (let ((v (make-vector size #\a)))
+      (do ((i 0 (+ i 1)))
+	  ((= i tries))
+	(do ((j 0 (+ j 1)))
+	    ((= j size))
+	  (set! (v j) (integer->char (+ (char->integer (v j)) 1)))))
+      v)))
+
+(let ((v (ft6)))
+  (if (not (equal? v (make-vector 100000 (integer->char (+ (char->integer #\a) tries)))))
+      (format *stderr* "ft6: ~A~%" v)))
+
+(define (ft61)
+  (let ((size 100000))
+    (let ((v (make-vector size #\a)))
+      (do ((i 0 (+ i 1)))
+	  ((= i tries))
+	(do ((j 0 (+ j 1)))
+	    ((= j size))
+	  (vector-set! v j (integer->char (+ (char->integer (vector-ref v j)) 1)))))
+      v)))
+
+(let ((v (ft61)))
+  (if (not (equal? v (make-vector 100000 (integer->char (+ (char->integer #\a) tries)))))
+      (format *stderr* "ft61: ~A~%" v)))
+
+(define (ft62)
+  (let ((size 100000))
+    (let ((v (make-int-vector size 1)))
+      (do ((i 0 (+ i 1)))
+	  ((= i tries))
+	(do ((j 0 (+ j 1))) ; -> copy via opt_do_very_simple
+	    ((= j size))
+	  (vector-set! v j (vector-ref v j))))
+      v)))
+
+(let ((v (ft62)))
+  (if (not (equal? v (make-int-vector 100000 1)))
+      (format *stderr* "ft62: ~A~%" v)))
+
+(define (ft63)
+  (let ((size 100000))
+    (let ((v (make-float-vector size 1.0)))
+      (do ((i 0 (+ i 1)))
+	  ((= i tries))
+	(do ((j 0 (+ j 1))) ; same as above
+	    ((= j size))
+	  (vector-set! v j (vector-ref v j))))
+      v)))
+
+(let ((v (ft63)))
+  (if (not (equal? v (make-float-vector 100000 1.0)))
+      (format *stderr* "ft63: ~A~%" v)))
+
+
+(define (ft7)
+  (let ((size 400))
+    (let ((v (make-list size 0)))
+      (do ((i 0 (+ i 1)))
+	  ((= i (* 10 tries)))
+	(do ((j 0 (+ j 1)))
+	    ((= j size))
+	  (set! (v j) (+ (v j) 1))))
+      v)))
+
+(let ((v (ft7)))
+  (if (not (equal? v (make-list 400 (* 10 tries))))
+      (format *stderr* "ft7: ~A~%" v)))
+
+(define (ft71)
+  (let ((size 400))
+    (let ((v (make-list size 0)))
+      (do ((i 0 (+ i 1)))
+	  ((= i (* 10 tries)))
+	(do ((p v (cdr p)))
+	    ((null? p))
+	  (set-car! p (+ (car p) 1))))
+      v)))
+
+(let ((v (ft71)))
+  (if (not (equal? v (make-list 400 (* 10 tries))))
+      (format *stderr* "ft71: ~A~%" v)))
+
+
+(define (ft8)
+  (let ((size 100000))
+    (let ((v (make-hash-table))
+	  (c #\a))
+      (do ((i 0 (+ i 1)))
+	  ((= i tries))
+	(do ((j 0 (+ j 1)))
+	    ((= j size))
+	  (set! (v j) c)))
+      v)))
+
+(ft8)
+
+(define (ft81)
+  (let ((size 100000))
+    (let ((v (make-hash-table))
+	  (c #\a))
+      (do ((i 0 (+ i 1)))
+	  ((= i tries))
+	(do ((j 0 (+ j 1)))
+	    ((= j size))
+	  (hash-table-set! v j c)))
+      v)))
+
+(ft81)
+
+
+(define (ft9)
+  (let ((size 100000))
+    (let ((v (inlet 'a 1))
+	  (c #\a))
+      (do ((i 0 (+ i 1)))
+	  ((= i tries))
+	(do ((j 0 (+ j 1)))
+	    ((= j size))
+	  (set! (v 'a) c)))
+      v)))
+
+(ft9)
+
+(define (ft91)
+  (let ((size 100000))
+    (let ((v (inlet 'a 1))
+	  (c #\a))
+      (do ((i 0 (+ i 1)))
+	  ((= i tries))
+	(do ((j 0 (+ j 1)))
+	    ((= j size))
+	  (let-set! v 'a c)))
+      v)))
+
+(ft91)
+
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(exit)
+
diff --git a/s7/tools/tset.scm b/s7/tools/tset.scm
new file mode 100644
index 0000000..1685623
--- /dev/null
+++ b/s7/tools/tset.scm
@@ -0,0 +1,163 @@
+(define size 1000000)
+
+(define (f1)
+  (let ((x 0))
+    (set! (setter 'x) integer?)
+    (do ((i 0 (+ i 1)))
+	((= i size) x)
+      (set! x (+ x 1)))))
+
+(unless (= (f1) size) (format *stderr* "f1: ~S~%" (f1)))
+
+
+(define (f1a)
+  (let ((x 0.0))
+    (set! (setter 'x) float?)
+    (do ((i 0 (+ i 1)))
+	((= i size) x)
+      (set! x (+ x 1.0)))))
+
+(unless (= (f1a) size) (format *stderr* "f1a: ~S~%" (f1a)))
+
+
+(define (f1b)
+  (let ((x 'a))
+    (set! (setter 'x) symbol?)
+    (do ((i 0 (+ i 1)))
+	((= i size) x)
+      (set! x 'b)))) ;(string->symbol "b") -- ok ;(if (symbol? x) 'b 'a))))) -- needs support in opt_arg_type
+
+(f1b)
+
+
+(define (f2)
+  (let ((x 0))
+    (set! (setter 'x) rational?)
+    (do ((j 0 (+ j 1)))
+	((= j 100000) x)
+      (do ((i 1 (+ i 1)))
+	  ((= i 10))
+	(set! x (+ x (/ i))))))) ;if (/ i) and size (or > 100) -> 14.392725722864782 -- ratio overflows bignum
+
+(unless (= (f2) 17822500/63) (format *stderr* "f2: ~S~%" (f2)))
+
+
+(define (f3)
+  (let ((x 128))
+    (set! (setter 'x) (lambda (s v) 
+			(if (and (integer? v)
+				 (<= 0 v 128))
+			    v
+			    (error 'wrong-type-arg "(set! ~A ~S) but ~S should be an integer between 0 and 128" s v v))))
+    (do ((i 0 (+ i 1)))
+	((= i size) x)
+      (set! x (modulo (+ x 1) 128)))))
+  
+(f3)
+
+
+(define (f4 x) 
+  (let ((y x)) 
+    (set! (setter 'y) integer?)
+    (set! y (+ y 1))))
+
+(define (f4-test)
+  (do ((i 0 (+ i 1)))
+      ((= i size))
+    (f4 i)))
+
+(f4-test)
+
+
+(require stuff.scm)
+
+(define (f5 x)
+  (typed-let ((y x integer?))
+    (set! y (+ y 1))))
+
+(define (f5-test)
+  (do ((i 0 (+ i 1)))
+      ((= i (/ size 10)))
+    (f5 i)))
+
+(f5-test)
+
+
+(define (f6 x)
+  (typed-let ((y x (lambda (s v) 
+		     (if (integer? v) 
+			 v 
+			 (error 'wrong-type-arg "~S is not an integer" v)))))
+    (set! y (+ y 1))))
+
+(define (f6-test)
+  (do ((i 0 (+ i 1)))
+      ((= i (/ size 10)))
+    (f6 i)))
+
+(f6-test)
+
+
+;;; --------------------------------------------------------------------------------
+
+(require reactive.scm)
+
+(define (t)
+  (let ((x 0))
+    (do ((i 0 (+ i 1)))
+	((= i 500))
+      (let ((a 1))
+	(reactive-set! x (* 2 a))
+	(set! a 2)
+	(if (not (= x 4))
+	    (format *stderr* "x: ~D ~D~%" x a)))
+      (let ((a 1))
+	(reactive-set! a (* 2 x))
+	(set! x 2)
+	(if (not (= a 4))
+	    (format *stderr* "a: ~D ~D~%" a x)))
+      (let ((a 3))
+	(set! a 2))
+      (if (not (= x 2))
+	  (format *stderr* "x: ~D~%" x))
+      (let ((a 1))
+	(do ((k 0 (+ k 1)))
+	    ((= k 1))
+	  (let ((b 2))
+	    (do ((j 0 (+ j 1)))
+		((= j 10))
+	      (let ((c 3))
+		(reactive-set! x (+ a b c))
+		(set! c 2)
+		(if (not (= x 5))
+		    (format *stderr* "set: ~S ~S ~S ~S~%" x a b c))))
+	    (set! b 3)
+	    (if (not (= x 6))
+		(format *stderr* "set: ~S ~S ~S~%" x a b))))
+	(set! a 4)
+	(if (not (= x 9))
+	    (format *stderr* "set: ~S ~S~%" x a)))
+      (reactive-let ((y (* x 2))
+		     (z (+ (* x 3) 1)))
+	(set! x 1)
+	(if (or (not (= y 2))
+		(not (= z 4)))
+	    (format *stderr* "let: ~D ~D ~D~%" x y z)))
+      (reactive-let* ((y (* x 2))
+		      (z (+ (* x 3) y)))
+	(set! x 1)
+	(if (or (not (= y 2))
+		(not (= z 5)))
+	    (format *stderr* "let*: ~D ~D ~D~%" x y z)))
+      
+      (if (zero? (remainder i 9)) (gc)))))  ; [6572:6 6533:8 6514:9 6518:10 6546:12]
+
+(t)
+
+;;; --------------------------------------------------------------------------------
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(exit)
+
+
+;; 3097 if initial heap=64k (3270 if 128k), 3036 if 32k
diff --git a/s7/tools/tshoot.scm b/s7/tools/tshoot.scm
new file mode 100644
index 0000000..8beb135
--- /dev/null
+++ b/s7/tools/tshoot.scm
@@ -0,0 +1,473 @@
+;;; various standard benchmarks 
+;;; --------------------------------------------------------------------------------
+
+(when (provided? 'pure-s7)
+  (define (string-length str)
+    (if (string? str)
+	(length str)
+	(if (openlet? str)
+	    ((let-ref str 'string-length) str)
+	    (error 'wrong-type-arg "string-length argument should be a string: ~A" str)))))
+
+(set! (*s7* 'heap-size) 512000)
+
+(define (fannkuch n)
+  (call-with-exit
+   (lambda (return)
+     (let ((perm (make-int-vector n))
+	   (perm1 (make-int-vector n))
+	   (count (make-int-vector n))
+	   (subs (make-vector n))
+	   (subs1 (make-vector n))
+	   (maxFlipsCount 0)
+	   (checksum 0)
+	   (r n)
+	   (perm0 0))
+       
+       (do ((i 0 (+ i 1)))
+	   ((= i n))
+	 (int-vector-set! perm1 i i)
+	 (vector-set! subs i (subvector perm 0 (+ i 1)))
+	 (vector-set! subs1 i (subvector perm1 1 (+ i 1))))
+       
+       (do ((permCount #t (not permCount)))
+	   (#f)
+	 (do ()
+	     ((= r 1))
+	   (int-vector-set! count (- r 1) r)
+	   (set! r (- r 1)))
+	 (copy perm1 perm)
+	 
+	 (do ((flipsCount 0 (+ flipsCount 1))
+	      (k (int-vector-ref perm 0) (int-vector-ref perm 0)))
+	     ((= k 0)
+	      (set! maxFlipsCount (max maxFlipsCount flipsCount))
+	      (if permCount 
+		  (set! checksum (+ checksum flipsCount)) 
+		  (set! checksum (- checksum flipsCount))))
+	   (reverse! (vector-ref subs k)))
+	 
+	 (do ((done #f))
+	     (done)
+	   (when (= r n)
+	     (return (cons checksum maxFlipsCount)))
+	   
+	   (set! perm0 (int-vector-ref perm1 0))
+	   (copy (vector-ref subs1 r) perm1)
+	   (int-vector-set! perm1 r perm0)
+
+	   (if (positive? (int-vector-set! count r (- (int-vector-ref count r) 1)))
+	       (set! done #t)
+	       (set! r (+ r 1)))))))))
+
+;; (fannkuch 7): (228 . 16), 8: (1616 . 22), 9: (8629 . 30), 10: (73196 . 38), 11: (556355 . 51), 12: (3968050 . 65)
+(fannkuch 8)
+(display (fannkuch 8)) (newline)
+
+;;; --------------------------------------------------------------------------------
+
+(define (wc)
+  (let ((nw 0)
+	(nc 0)
+	(port (open-input-file "/home/bil/test/scheme/bench/src/bib")))
+    (do ((newk 0 0)
+	 (str (read-line port) (read-line port))
+	 (nl 0 (+ nl 1)))
+	((eof-object? str)
+	 (close-input-port port)
+	 (list nl (+ nw nl) nc))
+      (set! nc (+ nc 1 (string-length str)))
+      (do ((k (char-position #\space str) (char-position #\space str (+ k 1))))
+	  ((not k))
+	(if (not (= k newk))
+	    (set! nw (+ nw 1)))
+	(set! newk (+ k 1))))))
+
+(wc) (wc)
+(display (wc)) (newline) ; '(31102 851820 4460056)
+
+;;; --------------------------------------------------------------------------------
+
+(define (cat)
+  (let ((inport (open-input-file "/home/bil/cl/s7test.scm"))
+	(outport (open-output-file "/dev/null"))) 
+    (catch #t
+      (lambda ()
+	(do () (#f) 
+	  (write-string (read-line inport #t) outport)))
+      (lambda args
+	(close-input-port inport)
+	(close-output-port outport)))))
+
+(do ((i 0 (+ i 1)))
+    ((= i 12))
+  (cat))
+
+;;; --------------------------------------------------------------------------------
+
+(define (string-cat n)
+  (let ((s "abcdef"))
+    (do ((i 0 (+ i 1)))
+	((= i 100) 
+	 (string-length s))
+      (set! s "abcdef")
+      (do ()
+	  ((> (string-length s) n))
+	(set! s (string-append "123" s "456" s "789"))
+	(set! s (string-append
+		 (substring s (quotient (string-length s) 2))
+		 (substring s 0 (+ 1 (quotient (string-length s) 2)))))))))
+
+(display (string-cat 500000)) (newline) ; 524278
+
+;;; --------------------------------------------------------------------------------
+
+(define mbrot
+  (let ()
+    (define (count cr ci)
+      (let ((max-count 64)
+	    (radius^2 16.0)
+	    (tzr 0.0)
+	    (zr cr)
+	    (zi ci))
+	(do ((zr^2 (* zr zr) (* zr zr))
+	     (zi^2 (* zi zi) (* zi zi))
+	     (c 0 (+ c 1)))
+	    ((or (= c max-count)
+		 (> (+ zr^2 zi^2) radius^2))
+	     c)
+	  (set! tzr (+ (- zr^2 zi^2) cr))
+	  (set! zi (+ (* 2.0 zr zi) ci))
+	  (set! zr tzr))))
+
+    (define (mb matrix r i step n)
+      (do ((x 0 (+ x 1)))
+	  ((= x n))
+	(do ((y 0 (+ y 1)))
+	    ((= y n))
+	  (vector-set! matrix x y (count (+ r (* step x)) (+ i (* step y)))))))
+
+    (lambda (n)
+      (let ((matrix (make-vector (list n n))))
+	(mb matrix -1.0 -0.5 0.005 n)
+	(if (not (= (matrix 0 0) 5))
+	    (format () ";mbrot: ~A~%" n))))))
+
+(mbrot 140)
+
+;;; --------------------------------------------------------------------------------
+
+;;; this one is not very good
+
+(define binary-tree
+  (let ()
+    (define (item-check tree)
+      (if (not (car tree))
+	  1
+	  (+ 1 (item-check (car tree)) (item-check (cdr tree)))))
+    
+    (define (bottom-up-tree depth)
+      (if (zero? depth)
+	  (cons #f #f)
+	  (cons (bottom-up-tree (- depth 1)) 
+		(bottom-up-tree (- depth 1)))))
+    
+    (lambda (N)
+      (let* ((min-depth 4)
+	     (max-depth (max (+ min-depth 2) N))
+	     (stretch-depth (+ max-depth 1))
+	     (stretch-tree (bottom-up-tree stretch-depth)))
+	(format *stderr* "stretch tree of depth ~D~30Tcheck: ~D~%" stretch-depth (item-check stretch-tree))
+	(let ((long-lived-tree (bottom-up-tree max-depth)))
+	  (do ((depth min-depth (+ depth 2)))
+	      ((> depth max-depth))
+	    (let ((iterations (expt 2 (- (+ max-depth min-depth) depth))))
+	      (do ((i 0 (+ i 1))
+		   (check 0 (+ check (item-check (bottom-up-tree depth)))))
+		  ((= i iterations)
+		   (format *stderr* "~D~9Ttrees of depth ~D~30Tcheck: ~D~%" iterations depth check)))))
+	  (format *stderr* "long lived tree of depth ~D~30Tcheck: ~D~%" max-depth (item-check long-lived-tree)))))))
+
+;(binary-tree 21)
+(binary-tree 14)
+
+;;; stretch      tree of  depth 22	 check: 8388607
+;;; 2097152	 trees of depth 4	 check: 65011712
+;;; 524288	 trees of depth 6	 check: 66584576
+;;; 131072	 trees of depth 8	 check: 66977792
+;;; 32768	 trees of depth 10	 check: 67076096
+;;; 8192	 trees of depth 12	 check: 67100672
+;;; 2048	 trees of depth 14	 check: 67106816
+;;; 512	         trees of depth 16	 check: 67108352
+;;; 128	         trees of depth 18	 check: 67108736
+;;; 32	         trees of depth 20	 check: 67108832
+;;; long lived   tree of  depth 21	 check: 4194303
+
+;;; --------------------------------------------------------------------------------
+
+(define collatz
+  (let ()
+    (define (collatz-count-until-1 n)
+      (do ((count 0 (+ count 1)))
+	  ((= n 1)
+	   count)
+	(if (logbit? n 0)
+	    (set! n (+ (* 3 n) 1))
+	    (set! n (ash n -1)))))
+    (lambda (N)
+      (let ((len 0)
+	    (num 0)
+	    (cur 0))
+	(do ((i 1 (+ i 1)))
+	    ((= i N)) ; 300000))
+	  (set! cur (collatz-count-until-1 i))
+	  (when (< len cur)
+	    (set! len cur)
+	    (set! num i)))
+	(format *stderr* "Maximum stopping distance ~D, starting number ~D\n" len num)))))
+
+;; (collatz 300000)
+;; Maximum stopping distance 442, starting number 230631
+;; .45 secs
+
+(collatz 40000)
+
+;;; --------------------------------------------------------------------------------
+
+(define prime?                         ; from exobrain.se
+  (let ((increments (list 4 2 4 2 4 6 2 6)))
+    (set-cdr! (list-tail increments 7) increments)
+    (lambda (z)
+      (or (memq z '(2 3 5 7))          ; memv...
+	  (and (odd? z)
+	       (positive? (remainder z 3))	  
+	       (positive? (remainder z 5))	  
+	       (positive? (remainder z 7))
+	       (do ((L increments)
+		    (lim (sqrt z))
+		    (divisor 11 (+ divisor (car L))))
+		   ((or (zero? (remainder z divisor))
+			(>= divisor lim))
+		    (> divisor lim))
+		 (set! L (cdr L))))))))
+
+(let ()
+  (define (count-primes limit)          ; for limit=10M 9.2 secs 664579, 1M .36 secs 78497 (+1 for 1?)
+    (let ((primes 1))
+      (when (even? limit) 
+	(set! limit (+ limit 1)))
+      (do ((i 3 (+ i 2)))
+	  ((= i limit)
+	   primes)
+	(if (prime? i)
+	    (set! primes (+ primes 1))))))
+  (display (count-primes 300000)) (newline)) ; 100000: 9592, 200000: 17984, 300000: 25997
+
+;;; --------------------------------------------------------------------------------
+;;;
+;;; spectral-norm, based on code by Anthony Borla (Computer Benchmarks Game)
+
+(let ((weights #f))
+
+  (define (mulAv n v av)
+    (fill! av 0.0)
+    (do ((i 0 (+ i 1)))
+	((= i n))
+      (do ((j 0 (+ j 1)))
+          ((= j n))
+	(float-vector-set! av i (+ (float-vector-ref av i) 
+				   (/ (float-vector-ref v j)
+				      (+ i (float-vector-ref weights (+ i j)))))))))
+
+  (define (mulAtV n v atv)
+    (fill! atv 0.0)
+    (do ((i 0 (+ i 1)))
+	((= i n))
+      (do ((j 0 (+ j 1)))
+          ((= j n))
+	(float-vector-set! atv i (+ (float-vector-ref atv i) 
+				    (/ (float-vector-ref v j)
+				       (+ j (float-vector-ref weights (+ i j)))))))))
+
+  (define (mulAtAv n v atav)
+    (let ((u (make-float-vector n 0.0)))
+      (mulAv n v u)
+      (mulAtV n u atav)))
+  
+  (define (spectral-norm n)
+    (let ((u (make-float-vector n 1.0))
+          (v (make-float-vector n 0.0))
+          (vBv 0.0) (vV 0.0))
+      
+      (set! weights (make-float-vector (* 2 n)))
+      (do ((i 0 (+ i 1)))
+	  ((= i (* 2 n)))
+	(float-vector-set! weights i (+ (* 0.5 i (+ i 1)) 1.0)))
+      
+      (do ((i 0 (+ i 1)))
+          ((= i 10))
+	(mulAtAv n u v)
+	(mulAtAv n v u))
+      
+      (do ((i 0 (+ i 1)))
+          ((= i n))
+	(set! vBv (+ vBv (* (float-vector-ref u i) (float-vector-ref v i))))
+	(set! vV (+ vV (* (float-vector-ref v i) (float-vector-ref v i)))))
+      
+      (sqrt (/ vBv vV))))
+
+  (display (spectral-norm 300)) ; (spectral-norm 4000) takes about 6.8 seconds, 5500: 12.8, 8000: 29.5
+  (newline))
+
+;;; --------------------------------------------------------------------------------
+;;;
+;;; from Joe Marshall (not a "standard benchmark", but interesting)
+
+(let ()
+  (define (palindrome? str)
+    (or (< (string-length str) 2)
+	(and (char=? (string-ref str 0)
+		     (string-ref str (- (string-length str) 1)))
+	     (palindrome? (substring str 1 (- (string-length str) 1))))))
+
+  (define (pal-test)
+    (do ((i 0 (+ i 1)))
+	((= i 50000))
+      (palindrome? "abcdefgfedcba")
+      (palindrome? "abcdefxfedcba")
+      (palindrome? "")
+      (palindrome? "abcdefghedcba")))
+
+  (pal-test))
+
+;;; this is 5-6 times faster:
+;;; (define (palindrome? str) (string=? str (reverse str)))
+
+;;; --------------------------------------------------------------------------------
+
+;;; nbody (from nbody.gcc)
+
+(define-constant solar_mass (* 4 pi pi))
+(define-constant days_per_year 365.24)
+
+(define planet-x    (dilambda (lambda (p) (float-vector-ref p 0)) (lambda (p val) (float-vector-set! p 0 val))))
+(define planet-y    (dilambda (lambda (p) (float-vector-ref p 1)) (lambda (p val) (float-vector-set! p 1 val))))
+(define planet-z    (dilambda (lambda (p) (float-vector-ref p 2)) (lambda (p val) (float-vector-set! p 2 val))))
+(define planet-vx   (dilambda (lambda (p) (float-vector-ref p 3)) (lambda (p val) (float-vector-set! p 3 val))))
+(define planet-vy   (dilambda (lambda (p) (float-vector-ref p 4)) (lambda (p val) (float-vector-set! p 4 val))))
+(define planet-vz   (dilambda (lambda (p) (float-vector-ref p 5)) (lambda (p val) (float-vector-set! p 5 val))))
+(define planet-mass (dilambda (lambda (p) (float-vector-ref p 6)) (lambda (p val) (float-vector-set! p 6 val))))
+
+(define (advance nbodies bodies dt)
+  (do ((i 0 (+ i 1)))
+      ((= i nbodies))
+    (let ((b (vector-ref bodies i)))
+      (do ((j (+ i 1) (+ j 1)))
+	  ((= j nbodies))
+	(let* ((b2 (vector-ref bodies j))
+	       (dx (- (planet-x b) (planet-x b2)))
+	       (dy (- (planet-y b) (planet-y b2)))
+	       (dz (- (planet-z b) (planet-z b2)))
+	       (distance (sqrt (+ (* dx dx) (* dy dy) (* dz dz))))
+	       (mag (/ dt (* distance distance distance))))
+	  (set! (planet-vx b) (- (planet-vx b) (* dx (planet-mass b2) mag)))
+	  (set! (planet-vy b) (- (planet-vy b) (* dy (planet-mass b2) mag)))
+	  (set! (planet-vz b) (- (planet-vz b) (* dz (planet-mass b2) mag)))
+	  (set! (planet-vx b2) (+ (planet-vx b2) (* dx (planet-mass b) mag)))
+	  (set! (planet-vy b2) (+ (planet-vy b2) (* dy (planet-mass b) mag)))
+	  (set! (planet-vz b2) (+ (planet-vz b2) (* dz (planet-mass b) mag)))))))
+  (do ((i 0 (+ i 1)))
+      ((= i nbodies))
+    (let ((b (vector-ref bodies i)))
+      (set! (planet-x b) (+ (planet-x b) (* dt (planet-vx b))))
+      (set! (planet-y b) (+ (planet-y b) (* dt (planet-vy b))))
+      (set! (planet-z b) (+ (planet-z b) (* dt (planet-vz b)))))))
+
+(define (energy nbodies bodies)
+  (let ((e 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i nbodies))
+      (let ((b (vector-ref bodies i)))
+	(set! e (+ e (* 0.5 (planet-mass b)
+			(+ (* (planet-vx b) (planet-vx b))
+			   (* (planet-vy b) (planet-vy b))
+			   (* (planet-vz b) (planet-vz b))))))
+	(do ((j (+ i 1) (+ j 1)))
+	    ((= j nbodies))
+	  (let* ((b2 (vector-ref bodies j))
+		 (dx (- (planet-x b) (planet-x b2)))
+		 (dy (- (planet-y b) (planet-y b2)))
+		 (dz (- (planet-z b) (planet-z b2)))
+		 (distance (sqrt (+ (* dx dx) (* dy dy) (* dz dz)))))
+	    (set! e (- e (/ (* (planet-mass b) (planet-mass b2)) distance)))))))
+    e))
+
+(define (offset_momentum nbodies bodies)
+  (let ((px 0.0)
+	(py 0.0)
+	(pz 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i nbodies))
+      (let ((b (vector-ref bodies i)))
+	(set! px (+ px (* (planet-vx b) (planet-mass b))))
+	(set! py (+ py (* (planet-vy b) (planet-mass b))))
+	(set! pz (+ pz (* (planet-vz b) (planet-mass b))))))
+    (let ((b (vector-ref bodies 0)))
+      (set! (planet-vx b) (/ (- px) solar_mass))
+      (set! (planet-vy b) (/ (- py) solar_mass))
+      (set! (planet-vz b) (/ (- pz) solar_mass)))))
+
+(define-constant NBODIES 5)
+
+(define bodies (vector
+		 (float-vector 0  0  0  0  0  0  solar_mass) ; sun
+
+		 (float-vector 4.84143144246472090e+00 
+			       -1.16032004402742839e+00 
+			       -1.03622044471123109e-01 
+			       (* 1.66007664274403694e-03 days_per_year)
+			       (* 7.69901118419740425e-03 days_per_year)
+			       (* -6.90460016972063023e-05 days_per_year)
+			       (* 9.54791938424326609e-04 solar_mass)) ; jupiter
+
+		 (float-vector 8.34336671824457987e+00 
+			       4.12479856412430479e+00 
+			       -4.03523417114321381e-01 
+			       (* -2.76742510726862411e-03 days_per_year)
+			       (* 4.99852801234917238e-03 days_per_year)
+			       (* 2.30417297573763929e-05 days_per_year)
+			       (* 2.85885980666130812e-04 solar_mass)) ; saturn
+		 
+		 (float-vector 1.28943695621391310e+01 
+			       -1.51111514016986312e+01 
+			       -2.23307578892655734e-01 
+			       (* 2.96460137564761618e-03 days_per_year)
+			       (* 2.37847173959480950e-03 days_per_year)
+			       (* -2.96589568540237556e-05 days_per_year)
+			       (* 4.36624404335156298e-05 solar_mass)) ; uranus
+
+		 (float-vector 1.53796971148509165e+01 
+			       -2.59193146099879641e+01 
+			       1.79258772950371181e-01 
+			       (* 2.68067772490389322e-03 days_per_year)
+			       (* 1.62824170038242295e-03 days_per_year)
+			       (* -9.51592254519715870e-05 days_per_year)
+			       (* 5.15138902046611451e-05 solar_mass)))) ; neptune
+
+(define (main n)
+  (offset_momentum NBODIES bodies)
+  (format () "~,9F~%" (energy NBODIES bodies))
+  (do ((i 0 (+ i 1)))
+      ((= i n))
+    (advance NBODIES bodies 0.01))
+  (format () "~,9F~%" (energy NBODIES bodies)))
+
+(main 6000)
+
+;;; 1000_out: -0.169075164 -0.169087605
+
+
+;;; --------------------------------------------------------------------------------
+(when (> (*s7* 'profile) 0)
+  (show-profile 100))
+(exit)
diff --git a/s7/tools/tsort.scm b/s7/tools/tsort.scm
new file mode 100644
index 0000000..bc01966
--- /dev/null
+++ b/s7/tools/tsort.scm
@@ -0,0 +1,189 @@
+;(set! (*s7* 'heap-size) 1024000)
+(let ((size 100000))
+
+  (define (less a b)
+    (< a b))
+  (define (car-less a b)
+    (< (car a) (car b)))
+  (define (cadr-less a b)
+    (< (cadr a) (cadr b)))
+  (define (all-less a b)
+    (and (< a b)
+	 (<= a b)))
+  (define (closure-less a b)
+    (and (< a b)
+	 (= (abs (+ (* 2 (- 3)) 1)) 5))) ; force optimizer to give up!
+  (define (begin-less a b)
+    (if (and (< a b) (> a b)) (display "oops"))
+    (< a b))
+  
+  (define (check-numbers vc)
+    (do ((j 1 (+ j 1)))
+	((= j size))
+      (if (> (vector-ref vc (- j 1)) (vector-ref vc j))
+	  (format *stderr* "~A > ~A?~%" (vector-ref vc (- j 1)) (vector-ref vc j)))))
+	 
+  (define (check-chars vc)
+    (do ((j 1 (+ j 1)))
+	((= j size))
+      (if (char>? (vector-ref vc (- j 1)) (vector-ref vc j))
+	  (format *stderr* "~A > ~A?~%" (vector-ref vc (- j 1)) (vector-ref vc j)))))
+    
+  (define (check-strings vc)
+    (do ((j 1 (+ j 1)))
+	((= j size))
+      (if (string>? (vector-ref vc (- j 1)) (vector-ref vc j))
+	  (format *stderr* "~A > ~A?~%" (vector-ref vc (- j 1)) (vector-ref vc j)))))
+
+  (define (check-car vc)
+    (do ((j 1 (+ j 1)))
+	((= j size))
+      (if (> (car (vector-ref vc (- j 1))) (car (vector-ref vc j)))
+	  (format *stderr* "~A > ~A?~%" (car (vector-ref vc (- j 1))) (car (vector-ref vc j))))))
+  
+  (define (check-cdr vc)
+    (do ((j 1 (+ j 1)))
+	((= j size))
+      (if (> (cdr (vector-ref vc (- j 1))) (cdr (vector-ref vc j)))
+	  (format *stderr* "~A > ~A?~%" (cdr (vector-ref vc (- j 1))) (cdr (vector-ref vc j))))))
+  
+  (define (check-cadr vc)
+    (do ((j 1 (+ j 1)))
+	((= j size))
+      (if (> (cadr (vector-ref vc (- j 1))) (cadr (vector-ref vc j)))
+	  (format *stderr* "~A > ~A?~%" (cadr (vector-ref vc (- j 1))) (cadr (vector-ref vc j))))))
+	 
+  (define (vfill-n v x)
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (vector-set! v i (random x))))
+  
+  (define (vfill-s v)
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (vector-set! v i (string (integer->char (random 256)) (integer->char (random 256))))))
+
+  (define (vfill-c v)
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (vector-set! v i (integer->char (random 256)))))
+  
+  (define (vfill-p v)
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (vector-set! v i (cons (random 1.0) (random 100000)))))
+
+  (define (vfill-r v)
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (vector-set! v i (list 0.0 (random 100000)))))
+
+  (define (vfill-v v)
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (vector-set! v i (symbol "a" (number->string i)))))
+
+  (define (run-sort)
+    (let ((v (make-vector size)))
+      (vfill-n v 1.0)
+      (let ((vc (copy v)))
+	(sort! vc <)
+	(check-numbers vc))
+      (let ((vc (copy v)))
+	(sort! vc less)
+	(check-numbers vc))
+      (let ((vc (copy v)))
+	(sort! vc all-less)
+	(check-numbers vc))
+      (let ((vc (copy v)))
+	(sort! vc begin-less)
+	(check-numbers vc))
+      (let ((vc (copy v)))
+	(sort! vc closure-less)
+	(check-numbers vc))
+      (sort! v (lambda (a b) (< a b)))
+      (check-numbers v))
+    
+    (let ((v (make-float-vector size)))
+      (vfill-n v 100.0)
+      (let ((vc (copy v)))
+	(sort! vc <)
+	(check-numbers vc))
+      (let ((vc (copy v)))
+	(sort! vc less)
+	(check-numbers vc))
+      (let ((vc (copy v)))
+	(sort! vc all-less)
+	(check-numbers vc))
+      (let ((vc (copy v)))
+	(sort! vc begin-less)
+	(check-numbers vc))
+      (let ((vc (copy v)))
+	(sort! vc closure-less)
+	(check-numbers vc))
+      (sort! v (lambda (a b) (< a b)))
+      (check-numbers v))
+    
+    (let ((v (make-int-vector size)))
+      (vfill-n v 10000000)
+      (let ((vc (copy v)))
+	(sort! vc <)
+	(check-numbers vc))
+      (let ((vc (copy v)))
+	(sort! vc less)
+	(check-numbers vc))
+      (let ((vc (copy v)))
+	(sort! vc all-less)
+	(check-numbers vc))
+      (let ((vc (copy v)))
+	(sort! vc begin-less)
+	(check-numbers vc))
+      (let ((vc (copy v)))
+	(sort! vc closure-less)
+	(check-numbers vc))
+      (sort! v (lambda (a b) (< a b)))
+      (check-numbers v))
+    
+    (let ((v (make-vector size)))
+      (vfill-s v)
+      (let ((vc (copy v)))
+	(sort! vc string<?)
+	(check-strings vc))
+      (sort! v (lambda (a b) (string<? a b)))
+      (check-strings v)
+      
+      (vfill-c v)
+      (let ((vc (copy v)))
+	(sort! vc char<?)
+	(check-chars vc))
+      (sort! v (lambda (a b) (char<? a b)))
+      (check-chars v)
+      
+      (vfill-p v)
+      (let ((vc (copy v)))
+	(sort! vc (lambda (a b) (< (car a) (car b))))
+	(check-car vc))
+      (let ((vc (copy v)))
+	(sort! vc car-less)
+	(check-car vc))
+      (sort! v (lambda (a b) (< (cdr a) (cdr b))))
+      (check-cdr v)
+      
+      (vfill-r v)
+      (let ((vc (copy v)))
+	(sort! vc (lambda (a b) (< (cadr a) (cadr b))))
+	(check-cadr vc))
+      (let ((vc (copy v)))
+	(sort! vc cadr-less)
+	(check-cadr vc))
+      
+      (let ((v (make-vector size)))
+	(vfill-v v)
+	(sort! v (lambda (a b) (string<? (symbol->string a) (symbol->string b)))))
+      ))
+  
+  (run-sort))
+
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(exit)
diff --git a/s7/tools/tstar.scm b/s7/tools/tstar.scm
new file mode 100644
index 0000000..3c14673
--- /dev/null
+++ b/s7/tools/tstar.scm
@@ -0,0 +1,168 @@
+(set! (*s7* 'heap-size) 512000)
+
+(let ()
+  (define size 1000000)
+
+
+  (define-constant (f1)
+    (let-temporarily (((*s7* 'openlets) #f))
+      (*s7* 'openlets)))
+  (define (f11)
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (f1)))
+  
+  (f11)
+  
+
+  (define-constant (f2 x)
+    (set! (*s7* 'safety) 1)
+    (+ x 1)
+    (set! (*s7* 'safety) 0))
+  
+  (define (f21)
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (f2 i)))
+  
+  (f21) ; 707 -> 386 -> 357
+  
+
+  (define-constant (f3 x)
+    (+ (*s7* 'safety) (*s7* 'print-length)))
+  
+  (define (f31)
+    (do ((i 0 (+ i 1)))
+	((= i size))
+      (f3 i)))
+
+  (f31) ; 211 -> 180(print-length)
+
+
+  (define (f6)
+    (let ((obj (openlet (inlet 'value -1 
+			       'abs (lambda (x)
+				      (let-temporarily (((*s7* 'openlets) #f))
+					(abs (x 'value))))))))
+      (do ((i 0 (+ i 1)))
+	  ((= i size))
+	(abs obj))))
+
+  (f6) ; 628! -> 425
+
+
+  (define (f7)
+    (let ((obj (openlet (inlet 'value -1 
+			       'abs (lambda (x) 
+				      (magnitude (x 'value)))))))
+      (do ((i 0 (+ i 1)))
+	  ((= i size))
+	(abs obj)))) ; eval -> apply_c_function -> magnitude_p_p -> s7_let_ref + method_or_bust etc [50]
+  (f7) ; 360 -> 342 [find_and_apply_method/apply_method_closure]
+  
+  
+  (define (f12)
+    (let ((obj -1))
+      (do ((i 0 (+ i 1)))
+	  ((= i size))
+	(abs obj))))
+  (f12) ; 17: 10-20 times faster than f1, opt_dotimes -> opt_i_i_s_abs
+
+  
+  (define (f13)
+    (let ((obj (openlet (let ((value -1))
+			  (define (abs x) (magnitude value))
+			  (curlet)))))
+      (do ((i 0 (+ i 1)))
+	  ((= i size))
+	(abs obj)))) ; eval -> apply_c_function -> magnitude_p_p -> method_or_bust etc g_abs find_method_with_let
+  (f13) ; not much faster 314
+  
+  
+  (define (f14)
+    (let ((obj -1))
+      (do ((i 0 (+ i 1)))
+	  ((= i size))
+	(magnitude obj))))
+  (f14) ; 38
+  
+  ;;abs obj -> abs_method: still need find_method->eval and g_abs (saves 2+~15 of 360!), might preset method = 14 -> 10%?
+  
+  
+  (define (f15)
+    (let ((obj (openlet (sublet (inlet 'abs (lambda (x) (magnitude (x 'value))))
+			  'value -1))))
+      (do ((i 0 (+ i 1)))
+	  ((= i size))
+	(abs obj)))) ; eval -> apply_c_function -> magnitude_p_p -> s7_let_ref + method_or_bust etc
+  (f15) ; 360
+  
+  
+  (define-constant (f8 x)
+    (if (let? x)
+	((let-ref x 'f82) x)
+	(+ x 1)))
+  
+  (define (f81)
+    (let ((obj (openlet (inlet 'value -1 
+			       'f82 (lambda (x)
+				     (+ (x 'value) 1))))))
+      (do ((i 0 (+ i 1)))
+	  ((= i size))
+	(f8 obj))))
+  
+  (f81) ; 505
+  
+  
+  (define f9 (dilambda
+	      (lambda (x)
+		(if (let? x)
+		    ((let-ref x 'f9) x)
+		    (+ x 1)))
+	      (lambda (x y)
+		(if (let? x)
+		    ((let-ref x 'set-f9) x y)
+		    'oops))))
+  
+  (define (f91)
+    (let ((obj (openlet (inlet 'value -1 
+			       'f9 (lambda (x)
+				     (+ (x 'value) 1))
+			       'set-f9 (lambda (x y)
+					 (set! (x 'value) y))))))
+      (display (f9 obj)) (newline) ; 0
+      (set! (f9 obj) 32)
+      (display (f9 obj)) (newline) ; 32
+      
+      (do ((i 0 (+ i 1)))
+	  ((= i size))
+	(set! (f9 obj) i))))
+  
+  (f91) ; 1142
+  
+  
+  (define (f10)
+    (let ((obj (openlet (inlet 'value -1 
+			       'abs (lambda (x) 
+				      (magnitude (x 'value)))
+			       'set-abs (lambda (x y)
+					  (set! (x 'value) y))))))
+      (set! (setter abs)
+	    (lambda (x y)
+	      (if (let? x)
+		  ((let-ref x 'set-abs) x y)
+		  'oops)))
+      (display (abs obj)) (newline) ; 1
+      (set! (abs obj) 32)
+      (display (abs obj)) (newline) ; 32
+      
+      (do ((i 0 (+ i 1)))
+	  ((= i size))
+	(set! (abs obj) i))))
+  
+  (f10) ; 1142
+)
+
+(set! (setter abs) #f)
+
+(exit)
diff --git a/s7/tools/tvect.scm b/s7/tools/tvect.scm
new file mode 100644
index 0000000..03e808a
--- /dev/null
+++ b/s7/tools/tvect.scm
@@ -0,0 +1,857 @@
+;;; vector timing tests
+
+(set! (*s7* 'heap-size) (* 2 1024000))
+(set! (*s7* 'safety) -1)
+
+;;; --------------------------------
+
+(define (max+loc vect)
+  (let ((len (length vect))
+	(mx 0.0)
+	(loc 0))
+    (do ((i 0 (+ i 1)))
+	((= i len)
+	 (list mx loc))
+      (when (> (abs (vect i)) mx)
+	(set! mx (vect i))
+	(set! loc i)))))
+
+(define (test-max tests)
+  (let ((v (make-float-vector 1024)))
+    (do ((i 0 (+ i 1)))
+	((= i 1024))
+      (set! (v i) (- 1024 i))) ;(- (random 100.0) 50.0))) -- this makes this timing test unrepeatable
+
+    (display (max+loc v)) (newline)
+
+    (do ((i 0 (+ i 1)))
+	((= i tests))
+      (max+loc v))))
+
+(test-max 10000)
+
+;;; --------------------------------
+
+(define size 300000)
+(define size/10 (/ size 10))
+
+
+(define (f1)
+  (let ((v (make-vector size 1))
+	(sum 0))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (set! sum (+ sum (floor (vector-ref v i)))))))
+
+(unless (= (f1) size)
+  (format *stderr* "f1: ~S~%" (f1)))
+
+
+(define (f2)
+  (let ((v (make-int-vector size 1))
+	(sum 0))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (set! sum (+ sum (int-vector-ref v i))))))
+
+(unless (= (f2) size)
+  (format *stderr* "f2: ~S~%" (f2)))
+
+
+(define (f3)
+  (let ((v (make-byte-vector size 1))
+	(sum 0))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (set! sum (+ sum (byte-vector-ref v i))))))
+
+(unless (= (f3) size)
+  (format *stderr* "f3: ~S~%" (f3)))
+
+
+(define (f4)
+  (let ((v (make-float-vector size 1.0))
+	(sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (set! sum (+ sum (float-vector-ref v i))))))
+
+(unless (= (f4) size)
+  (format *stderr* "f4: ~S~%" (f4)))
+
+
+(define (f5)
+  (let ((v (make-vector size 1 integer?))
+	(sum 0))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (set! sum (+ sum (vector-ref v i))))))
+
+(unless (= (f5) size)
+  (format *stderr* "f5: ~S~%" (f5)))
+
+
+(define (f6)
+  (let ((v (make-vector size #t boolean?))
+	(sum 0))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (if (vector-ref v i) (set! sum (+ sum 1))))))
+
+(unless (= (f6) size)
+  (format *stderr* "f6: ~S~%" (f6)))
+
+
+;;; --------------------------------
+(define (f11)
+  (let ((v (make-vector (list 10 size/10) 1))
+	(sum 0))
+    (do ((k 0 (+ k 1)))
+	((= k 10) sum)
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(set! sum (+ sum (round (vector-ref v k i))))))))
+
+(unless (= (f11) size)
+  (format *stderr* "f11: ~S~%" (f11)))
+
+
+(define (f12)
+  (let ((v (make-int-vector (list 10 size/10) 1))
+	(sum 0))
+    (do ((k 0 (+ k 1)))
+	((= k 10) sum)
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(set! sum (+ sum (int-vector-ref v k i)))))))
+
+(unless (= (f12) size)
+  (format *stderr* "f12: ~S~%" (f12)))
+
+
+(define (f13)
+  (let ((v (make-byte-vector (list 10 size/10) 1))
+	(sum 0))
+    (do ((k 0 (+ k 1)))
+	((= k 10) sum)
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(set! sum (+ sum (byte-vector-ref v k i)))))))
+
+(unless (= (f13) size)
+  (format *stderr* "f13: ~S~%" (f13)))
+
+
+(define (f14)
+  (let ((v (make-float-vector (list 10 size/10) 1.0))
+	(sum 0.0))
+    (do ((k 0 (+ k 1)))
+	((= k 10) sum)
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(set! sum (+ sum (float-vector-ref v k i)))))))
+
+(unless (= (f14) size)
+  (format *stderr* "f14: ~S~%" (f14)))
+
+
+(define (f15)
+  (let ((v (make-vector (list 10 size/10) 1 integer?))
+	(sum 0))
+    (do ((k 0 (+ k 1)))
+	((= k 10) sum)
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(set! sum (+ sum (vector-ref v k i)))))))
+
+(unless (= (f15) size)
+  (format *stderr* "f15: ~S~%" (f15)))
+
+
+(define (f16)
+  (let ((v (make-vector (list 10 size/10) 'a symbol?))
+	(sum 0))
+    (do ((k 0 (+ k 1)))
+	((= k 10) sum)
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(if (eq? 'a (vector-ref v k i)) (set! sum (+ sum 1)))))))
+
+(unless (= (f16) size)
+  (format *stderr* "f16: ~S~%" (f15)))
+
+
+
+;;; --------------------------------------------------------------------------------
+
+(define (g1)
+  (let ((v (make-vector size 1))
+	(sum 0))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (set! sum (+ sum (ceiling (v i)))))))
+
+(unless (= (g1) size)
+  (format *stderr* "g1: ~S~%" (g1)))
+
+
+(define (g2)
+  (let ((v (make-int-vector size 1))
+	(sum 0))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (set! sum (+ sum (v i))))))
+
+(unless (= (g2) size)
+  (format *stderr* "g2: ~S~%" (g2)))
+
+
+(define (g3)
+  (let ((v (make-byte-vector size 1))
+	(sum 0))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (set! sum (+ sum (v i))))))
+
+(unless (= (g3) size)
+  (format *stderr* "g3: ~S~%" (g3)))
+
+
+(define (g4)
+  (let ((v (make-float-vector size 1.0))
+	(sum 0.0))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (set! sum (+ sum (v i))))))
+
+(unless (= (g4) size)
+  (format *stderr* "g4: ~S~%" (g4)))
+
+
+(define (g5)
+  (let ((v (make-vector size 1 integer?))
+	(sum 0))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (set! sum (+ sum (v i))))))
+
+(unless (= (g5) size)
+  (format *stderr* "g5: ~S~%" (g5)))
+
+
+(define (g6)
+  (let ((v (make-vector size 0+i complex?))
+	(sum 0))
+    (do ((i 0 (+ i 1)))
+	((= i size) sum)
+      (if (zero? (real-part (vector-ref v i))) ; faster is (imag-part...)
+	  (set! sum (+ sum 1))))))
+
+(unless (= (g6) size)
+  (format *stderr* "g6: ~S~%" (g6)))
+
+
+;;; --------------------------------
+
+(define (g11)
+  (let ((v (make-vector (list 10 size/10) 1))
+	(sum 0))
+    (do ((k 0 (+ k 1)))
+	((= k 10) sum)
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(set! sum (+ sum (floor (v k i))))))))
+
+(unless (= (g11) size)
+  (format *stderr* "g11: ~S~%" (g11)))
+
+
+(define (g12)
+  (let ((v (make-int-vector (list 10 size/10) 1))
+	(sum 0))
+    (do ((k 0 (+ k 1)))
+	((= k 10) sum)
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(set! sum (+ sum (v k i)))))))
+
+(unless (= (g12) size)
+  (format *stderr* "g12: ~S~%" (g12)))
+
+
+(define (g13)
+  (let ((v (make-byte-vector (list 10 size/10) 1))
+	(sum 0))
+    (do ((k 0 (+ k 1)))
+	((= k 10) sum)
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(set! sum (+ sum (v k i)))))))
+
+(unless (= (g13) size)
+  (format *stderr* "g13: ~S~%" (g13)))
+
+
+(define (g14)
+  (let ((v (make-float-vector (list 10 size/10) 1.0))
+	(sum 0.0))
+    (do ((k 0 (+ k 1)))
+	((= k 10) sum)
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(set! sum (+ sum (v k i)))))))
+
+(unless (= (g14) size)
+  (format *stderr* "g14: ~S~%" (g14)))
+
+
+(define (g15)
+  (let ((v (make-vector (list 10 size/10) 1 integer?))
+	(sum 0))
+    (do ((k 0 (+ k 1)))
+	((= k 10) sum)
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(set! sum (+ sum (v k i)))))))
+
+(unless (= (g15) size)
+  (format *stderr* "g15: ~S~%" (g15)))
+
+
+(define (g16)
+  (let ((v (make-vector (list 10 size/10) #\a char?))
+	(sum 0))
+    (do ((k 0 (+ k 1)))
+	((= k 10) sum)
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(if (char=? (vector-ref v k i) #\a) 
+	    (set! sum (+ sum 1)))))))
+
+(unless (= (g16) size)
+  (format *stderr* "g16: ~S~%" (g16)))
+
+
+;;; --------------------------------------------------------------------------------
+
+(define (h1)
+  (let ((v (make-vector size)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (vector-ref v 0))
+      (vector-set! v i 2))))
+
+(unless (= (h1) 2)
+  (format *stderr* "h1: ~S~%" (h1)))
+
+
+(define (h2)
+  (let ((v (make-int-vector size)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (int-vector-ref v 0))
+      (int-vector-set! v i 2))))
+
+(unless (= (h2) 2)
+  (format *stderr* "h2: ~S~%" (h2)))
+
+
+(define (h3)
+  (let ((v (make-byte-vector size)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (byte-vector-ref v 0))
+      (byte-vector-set! v i 2))))
+
+(unless (= (h3) 2)
+  (format *stderr* "h3: ~S~%" (h3)))
+
+
+(define (h4)
+  (let ((v (make-float-vector size)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (float-vector-ref v 0))
+      (float-vector-set! v i 2.0))))
+
+(unless (= (h4) 2.0)
+  (format *stderr* "h4: ~S~%" (h4)))
+
+
+(define (h5)
+  (let ((v (make-vector size 1 integer?)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (vector-ref v 0))
+      (vector-set! v i 2))))
+
+(unless (= (h5) 2)
+  (format *stderr* "h5: ~S~%" (h5)))
+
+
+(define (h6)
+  (let ((v (make-vector size #(1 0) vector?)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (vector-ref v 0 0))
+      (vector-set! v i #(2 3)))))
+
+(unless (= (h6) 2)
+  (format *stderr* "h6: ~S~%" (h6)))
+
+
+(define (h7)
+  (let ((v (make-vector size)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (vector-ref v 0))
+      (values (vector-set! v i 2)))))
+
+(unless (= (h7) 2)
+  (format *stderr* "h7: ~S~%" (h7)))
+
+
+;;; --------------------------------
+
+(define (h11)
+  (let ((v (make-vector (list 10 size/10))))
+    (do ((k 0 (+ k 1)))
+	((= k 10) (vector-ref v 0 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(vector-set! v k i 2)))))
+
+(unless (= (h11) 2)
+  (format *stderr* "h11: ~S~%" (h11)))
+
+
+(define (h12)
+  (let ((v (make-int-vector (list 10 size/10))))
+    (do ((k 0 (+ k 1)))
+	((= k 10) (int-vector-ref v 0 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(int-vector-set! v k i 2)))))
+
+(unless (= (h12) 2)
+  (format *stderr* "h12: ~S~%" (h12)))
+
+
+(define (h13)
+  (let ((v (make-byte-vector (list 10 size/10))))
+    (do ((k 0 (+ k 1)))
+	((= k 10) (byte-vector-ref v 0 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(byte-vector-set! v k i 2)))))
+
+(unless (= (h13) 2)
+  (format *stderr* "h13: ~S~%" (h13)))
+
+
+(define (h14)
+  (let ((v (make-float-vector (list 10 size/10))))
+    (do ((k 0 (+ k 1)))
+	((= k 10) (float-vector-ref v 0 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(float-vector-set! v k i 2.0)))))
+
+(unless (= (h14) 2.0)
+  (format *stderr* "h14: ~S~%" (h14)))
+
+
+(define (h15)
+  (let ((v (make-vector (list 10 size/10) 1 integer?)))
+    (do ((k 0 (+ k 1)))
+	((= k 10) (vector-ref v 0 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(vector-set! v k i 2))))) ; this calls int-vector-set!
+
+(unless (= (h15) 2)
+  (format *stderr* "h15: ~S~%" (h15)))
+
+
+(define (h16)
+  (let ((v (make-vector (list 10 size/10) :a keyword?)))
+    (do ((k 0 (+ k 1)))
+	((= k 10) (vector-ref v 0 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(vector-set! v k i :b)))))
+
+(unless (eq? (h16) :b)
+  (format *stderr* "h16: ~S~%" (h16)))
+
+
+(define (h17)
+  (let ((v (make-vector (list 10 size/10))))
+    (do ((k 0 (+ k 1)))
+	((= k 10) (vector-ref v 0 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(values (vector-set! v k i 2))))))
+
+(unless (= (h17) 2)
+  (format *stderr* "h17: ~S~%" (h17)))
+
+
+;;; --------------------------------------------------------------------------------
+
+
+(define (j1)
+  (let ((v (make-vector size)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (v 0))
+      (set! (v i) 2))))
+
+(unless (= (j1) 2)
+  (format *stderr* "j1: ~S~%" (j1)))
+
+
+(define (j2)
+  (let ((v (make-int-vector size)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (v 0))
+      (set! (v i) 2))))
+
+(unless (= (j2) 2)
+  (format *stderr* "j2: ~S~%" (j2)))
+
+
+(define (j3)
+  (let ((v (make-byte-vector size)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (v 0))
+      (set! (v i) 2))))
+
+(unless (= (j3) 2)
+  (format *stderr* "j3: ~S~%" (j3)))
+
+
+(define (j4)
+  (let ((v (make-float-vector size)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (v 0))
+      (set! (v i) 2.0))))
+
+(unless (= (j4) 2.0)
+  (format *stderr* "j4: ~S~%" (j4)))
+
+
+(define (j5)
+  (let ((v (make-vector size 1 integer?)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (v 0))
+      (set! (v i) 2))))
+
+(unless (= (j5) 2)
+  (format *stderr* "j5: ~S~%" (j5)))
+
+
+(define (j6)
+  (let ((v (make-vector size)))
+    (do ((i 0 (+ i 1)))
+	((= i size) (v 0))
+      (values (set! (v i) 2)))))
+
+(unless (= (j6) 2)
+  (format *stderr* "j6: ~S~%" (j6)))
+
+;;; --------------------------------
+
+(define (j11)
+  (let ((v (make-vector (list 10 size/10))))
+    (do ((k 0 (+ k 1)))
+	((= k 10) (v 0 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(set! (v k i) 21)))))
+
+(unless (= (j11) 21)
+  (format *stderr* "j11: ~S~%" (j11)))
+
+(define (j12)
+  (let ((v (make-int-vector (list 10 size/10))))
+    (do ((k 0 (+ k 1)))
+	((= k 10) (v 0 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(set! (v k i) 22)))))
+
+(unless (= (j12) 22)
+  (format *stderr* "j12: ~S~%" (j12)))
+
+
+(define (j13)
+  (let ((v (make-byte-vector (list 10 size/10))))
+    (do ((k 0 (+ k 1)))
+	((= k 10) (v 0 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(set! (v k i) 23)))))
+
+(unless (= (j13) 23)
+  (format *stderr* "j13: ~S~%" (j13)))
+
+
+(define (j14)
+  (let ((v (make-float-vector (list 10 size/10))))
+    (do ((k 0 (+ k 1)))
+	((= k 10) (v 0 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(set! (v k i) 2.0)))))
+
+(unless (= (j14) 2.0)
+  (format *stderr* "j14: ~S~%" (j14)))
+
+
+(define (j15)
+  (let ((v (make-vector (list 10 size/10) 1 integer?)))
+    (do ((k 0 (+ k 1)))
+	((= k 10) (v 0 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(set! (v k i) 24)))))
+
+(unless (= (j15) 24)
+  (format *stderr* "j15: ~S~%" (j15)))
+
+
+(define (j16)
+  (let ((v (make-vector (list 10 size/10))))
+    (do ((k 0 (+ k 1)))
+	((= k 10) (v 0 0))
+      (do ((i 0 (+ i 1)))
+	  ((= i size/10))
+	(values (set! (v k i) 2))))))
+
+(unless (= (j16) 2)
+  (format *stderr* "j16: ~S~%" (j16)))
+
+
+;;; --------------------------------------------------------------------------------
+
+(define ssize/10 30000)
+(define ssize/10.0 (* 1.0 ssize/10))
+
+(define (h111)
+  (let ((v (make-vector (list 10 ssize/10))))
+    (do ((k 0 (+ k 1)))
+	((= k 10) v)
+      (do ((i 0 (+ i 1)))
+	  ((= i ssize/10))
+	(vector-set! v k i (+ i (* k ssize/10)))))))
+
+(define (sum-h111)
+  (let ((sum 0)
+	(v (h111)))
+    (do ((k 0 (+ k 1)))
+	((= k 10) sum) ; (n-1) * (n/2) since we're starting at 0
+      (do ((i 0 (+ i 1)))
+	  ((= i ssize/10))
+	(set! sum (+ sum (floor (vector-ref v k i))))))))
+    
+(unless (= (sum-h111) 44999850000)
+  (format *stderr* "h111: ~S~%" (sum-h111)))
+
+
+(define (h121)
+  (let ((v (make-int-vector (list 10 ssize/10))))
+    (do ((k 0 (+ k 1)))
+	((= k 10) v)
+      (do ((i 0 (+ i 1)))
+	  ((= i ssize/10))
+	(int-vector-set! v k i (+ i (* k ssize/10)))))))
+
+(define (sum-h121)
+  (let ((sum 0)
+	(v (h121)))
+    (do ((k 0 (+ k 1)))
+	((= k 10) sum)
+      (do ((i 0 (+ i 1)))
+	  ((= i ssize/10))
+	(set! sum (+ sum (int-vector-ref v k i)))))))
+
+(unless (= (sum-h121) 44999850000)
+  (format *stderr* "h121: ~S~%" (sum-h121)))
+
+
+(define (h131)
+  (let ((v (make-byte-vector (list 10 ssize/10))))
+    (do ((k 0 (+ k 1)))
+	((= k 10) v)
+      (do ((i 0 (+ i 1)))
+	  ((= i ssize/10))
+	(byte-vector-set! v k i (modulo (+ i (* k ssize/10)) 256))))))
+
+(define (sum-h131)
+  (let ((sum 0)
+	(v (h131)))
+    (do ((k 0 (+ k 1)))
+	((= k 10) sum)
+      (do ((i 0 (+ i 1)))
+	  ((= i ssize/10))
+	(set! sum (+ sum (byte-vector-ref v k i)))))))
+
+(unless (= (sum-h131) 38246416)
+  (format *stderr* "h131: ~S~%" (sum-h131)))
+
+
+(define (h141)
+  (let ((v (make-float-vector (list 10 ssize/10))))
+    (do ((k 0 (+ k 1)))
+	((= k 10) v)
+      (do ((i 0 (+ i 1)))
+	  ((= i ssize/10))
+	(float-vector-set! v k i (+ i (* k ssize/10.0)))))))
+
+(define (sum-h141)
+  (let ((sum 0.0)
+	(v (h141)))
+    (do ((k 0 (+ k 1)))
+	((= k 10) sum)
+      (do ((i 0 (+ i 1)))
+	  ((= i ssize/10))
+	(set! sum (+ sum (float-vector-ref v k i)))))))
+
+(unless (= (sum-h141) 44999850000.0)
+  (format *stderr* "h141: ~S~%" (sum-h141)))
+
+
+;;; --------------------------------------------------------------------------------
+
+(define size3 50)
+
+(define (h1111)
+  (let ((v (make-vector (list size3 size3 size3))))
+    (do ((k 0 (+ k 1)))
+	((= k size3) v)
+      (do ((i 0 (+ i 1)))
+	  ((= i size3))
+	(do ((k3 (* k size3 size3))
+	     (i3 (* i size3))
+	     (n 0 (+ n 1)))
+	    ((= n size3))
+	  (vector-set! v k i n (+ i3 k3 n)))))))
+
+(define (sum-h1111)
+  (let ((sum 0)
+	(v (h1111)))
+    (do ((k 0 (+ k 1)))
+	((= k size3) sum) 
+      (do ((i 0 (+ i 1)))
+	  ((= i size3))
+	(do ((n 0 (+ n 1)))
+	    ((= n size3))
+	  (set! sum (+ sum (floor (vector-ref v k i n)))))))))
+
+(unless (= (sum-h1111) 7812437500)
+  (format *stderr* "h1111: ~S~%" (sum-h1111)))
+
+
+(define (i1111)
+  (let ((v (make-int-vector (list size3 size3 size3))))
+    (do ((k 0 (+ k 1)))
+	((= k size3) v)
+      (do ((i 0 (+ i 1)))
+	  ((= i size3))
+	(do ((k3 (* k size3 size3))
+	     (i3 (* i size3))
+	     (n 0 (+ n 1)))
+	    ((= n size3))
+	  (int-vector-set! v k i n (+ i3 k3 n)))))))
+
+(define (sum-i1111)
+  (let ((sum 0)
+	(v (i1111)))
+    (do ((k 0 (+ k 1)))
+	((= k size3) sum) 
+      (do ((i 0 (+ i 1)))
+	  ((= i size3))
+	(do ((n 0 (+ n 1)))
+	    ((= n size3))
+	  (set! sum (+ sum (int-vector-ref v k i n))))))))
+
+(unless (= (sum-i1111) 7812437500)
+  (format *stderr* "i1111: ~S~%" (sum-i1111)))
+
+
+(define (f1111)
+  (let ((v (make-float-vector (list size3 size3 size3))))
+    (do ((k 0 (+ k 1)))
+	((= k size3) v)
+      (do ((i 0 (+ i 1)))
+	  ((= i size3))
+	(do ((k3 (* k size3 size3))
+	     (i3 (* i size3))
+	     (n 0 (+ n 1)))
+	    ((= n size3))
+	  (float-vector-set! v k i n (+ 0.0 i3 k3 n)))))))
+
+(define (sum-f1111)
+  (let ((sum 0.0)
+	(v (f1111)))
+    (do ((k 0 (+ k 1)))
+	((= k size3) sum) 
+      (do ((i 0 (+ i 1)))
+	  ((= i size3))
+	(do ((n 0 (+ n 1)))
+	    ((= n size3))
+	  (set! sum (+ sum (float-vector-ref v k i n))))))))
+
+(unless (= (sum-f1111) 7812437500.0)
+  (format *stderr* "f1111: ~S~%" (sum-f1111)))
+
+(define (vcop a b n)
+  (do ((i (- n 1) (- i 1)))
+      ((< i 0) b)
+    (vector-set! b i (vector-ref a i)))
+  (do ((i 0 (+ i 1)))
+      ((= i n) a)
+    (vector-set! a i (vector-ref b i))))
+
+(define (tvcop)
+  (do ((k 0 (+ k 1)))
+      ((= k 1000))
+    (vcop (make-vector 1000 1) (make-vector 1000 0) 1000)))
+
+(tvcop)
+
+;;; --------------------------------------------------------------------------------
+
+(define (randomize-vector uv)
+  (let* ((len (length uv))
+	 (v (copy uv))
+	 (unset (vector :unset))
+	 (nv (make-vector len unset))
+	 (min-i 0))
+    (do ((i 0 (+ i 1))
+	 (r (random len) (random len)))
+	((= i len))
+      (if (eq? (vector-ref v r) unset)
+	  (do ((k min-i (+ k 1)))
+	      ((or (= k len)
+		   (not (eq? (vector-ref v k) unset)))
+	       (if (= k len)
+		   (format *stderr* "can't find a value for ~S!\n" r)
+		   (begin
+		     (set! min-i (+ k 1))
+		     (vector-set! nv i (vector-ref v k))
+		     (vector-set! v k unset)))))
+	  (begin
+	    (vector-set! nv i (vector-ref v r))
+	    (vector-set! v r unset))))
+    nv))
+
+(define (rtest)
+  (let ((v (make-vector 100000)))
+    (do ((i 0 (+ i 1)))
+	((= i 100000))
+      (vector-set! v i i))
+    (randomize-vector v)))
+
+(rtest)
+
+
+;;; --------------------------------------------------------------------------------
+
+(when (> (*s7* 'profile) 0)
+  (show-profile 200))
+(exit)
+
diff --git a/s7/tools/valcall.scm b/s7/tools/valcall.scm
new file mode 100644
index 0000000..79c7749
--- /dev/null
+++ b/s7/tools/valcall.scm
@@ -0,0 +1,149 @@
+;;; reset names: back-to-v-10
+
+(define file-names '(("make-index.scm" . "v-index")
+		     ("tmac.scm" . "v-mac")
+		     ("tpeak.scm" . "v-peak")
+		     ("tvect.scm" . "v-vect")
+		     ("teq.scm" . "v-eq")
+		     ("tfft.scm" . "v-fft")
+		     ("tref.scm" . "v-ref")
+		     ("tauto.scm" . "v-auto")
+		     ("s7test.scm" . "v-test")
+		     ("tcopy.scm" . "v-cop")
+		     ("lt.scm" . "v-lt")
+		     ("tform.scm" . "v-form")
+		     ("tread.scm" . "v-read")
+		     ("tmap.scm" . "v-map")
+		     ("tmat.scm" . "v-mat")
+		     ("tmisc.scm" . "v-misc")
+		     ("titer.scm" . "v-iter")
+		     ("tsort.scm" . "v-sort")
+		     ("tlet.scm" . "v-let")
+		     ("thash.scm" . "v-hash")
+		     ("tmap-hash.scm" . "v-map-hash")
+		     ("tgen.scm" . "v-gen")
+		     ("tall.scm" . "v-all")
+		     ("snd-test.scm" . "v-call")
+		     ("full-snd-test.scm" . "v-sg")
+		     ("dup.scm" . "v-dup")
+		     ("tset.scm" . "v-set")
+		     ("trec.scm" . "v-rec")
+		     ("tclo.scm" . "v-clo")
+		     ("tbig.scm" . "v-big")
+		     ("tshoot.scm" . "v-shoot")
+		     ("fbench.scm" . "v-fb")
+		     ("trclo.scm" . "v-rclo")
+		     ("tcase.scm" . "v-case")
+		     ("test-all.scm" . "v-b")
+		     ("tio.scm" . "v-io")
+		     ("tgc.scm" . "v-gc")
+		     ("tnum.scm" . "v-num")
+		     ("tmock.scm" . "v-mock")
+		     ("concordance.scm" . "v-str")
+		     ("tgsl.scm" . "v-gsl")
+		     ("tlist.scm" . "v-list")
+		     ("tload.scm" . "v-load")
+		     ("cb.scm" . "v-cb")
+		     ("tari.scm" . "v-ari")
+		     ("texit.scm" . "v-exit")
+		     ("tleft.scm" . "v-left")
+		     ("tobj.scm" . "v-obj")
+		     ("timp.scm" . "v-imp")
+		     ("tlamb.scm" . "v-lamb")
+		     ("thook.scm" . "v-hook")
+		     ("tstar.scm" . "v-star")
+		     ("tmv.scm" . "v-mv")
+		     ))
+
+(define (last-callg)
+  (let ((name (system "ls callg*" #t)))
+    (let ((len (length name)))
+      (do ((i 0 (+ i 1)))
+	  ((or (= i len)
+	       (char-whitespace? (name i)))
+	   (substring name 0 i))))))
+
+(define (next-file f)
+  (let ((name (system (format #f "ls -t ~A*" f) #t)))
+    (let ((len (length name)))
+      (do ((i 0 (+ i 1)))
+	  ((or (= i len)
+	       (and (char-numeric? (name i))
+		    (char-numeric? (name (+ i 1)))))
+	   (+ 1 (string->number (substring name i (+ i 2)))))))))
+
+(define (call-valgrind)
+  (for-each
+   (lambda (caller+file)
+     (system "rm callg*")
+     (format *stderr* "~%~NC~%~NC ~A ~NC~%~NC~%" 40 #\- 16 #\- (cadr caller+file) 16 #\- 40 #\-)
+     (system (format #f "valgrind --tool=callgrind ./~A ~A" (car caller+file) (cadr caller+file)))
+
+     (let ((outfile (cdr (assoc (cadr caller+file) file-names))))
+       (let ((next (next-file outfile)))
+	 (system (format #f "callgrind_annotate --auto=yes --show-percs=no --threshold=100 ~A > ~A~D" (last-callg) outfile next))
+	 (format *stderr* "~NC ~A~D -> ~A~D: ~NC~%" 8 #\space outfile (- next 1) outfile next 8 #\space)
+	 (system (format #f "./snd compare-calls.scm -e '(compare-calls \"~A~D\" \"~A~D\")'" outfile (- next 1) outfile next)))))
+
+   (list (list "repl" "tpeak.scm")
+	 (list "repl" "tref.scm")
+	 (list "snd -noinit" "make-index.scm")
+	 (list "repl" "tmock.scm")
+	 (list "repl" "tvect.scm")
+	 (list "repl" "tauto.scm")
+	 (list "repl" "texit.scm")
+	 (list "repl" "s7test.scm")
+	 (list "repl" "lt.scm")
+	 (list "repl" "dup.scm")
+	 (list "repl" "thook.scm")
+	 (list "repl" "tread.scm")
+	 (list "repl" "tcopy.scm")
+	 (list "repl" "titer.scm")
+	 (list "repl" "trclo.scm")
+	 (list "repl" "tmat.scm")
+	 (list "repl" "tload.scm")
+	 (list "repl" "fbench.scm")
+	 (list "repl" "tsort.scm")
+	 (list "repl" "tio.scm")
+	 (list "repl" "tobj.scm")
+	 (list "repl" "teq.scm")
+	 (list "repl" "tmac.scm")
+	 (list "repl" "tclo.scm")
+	 (list "repl" "tcase.scm")
+	 (list "repl" "tlet.scm")
+	 (list "repl" "tfft.scm")
+	 (list "repl" "tstar.scm")
+	 (list "repl" "tmap.scm")
+	 (list "repl" "tshoot.scm")
+	 (list "repl" "tform.scm")
+	 (list "repl" "concordance.scm")
+	 (list "repl" "tnum.scm")
+	 (list "repl" "tgsl.scm")
+	 (reader-cond ((not (provided? 'gmp)) (list "repl" "tari.scm")))
+	 (list "repl" "tlist.scm")
+	 (list "repl" "tset.scm")
+	 (list "repl" "trec.scm")
+	 (list "repl" "tleft.scm")
+	 (list "repl" "tmisc.scm")
+	 (list "repl" "tlamb.scm")
+	 (list "repl" "tgc.scm")
+	 (list "repl" "thash.scm")
+	 (list "repl" "cb.scm")
+	 (list "repl" "tmap-hash.scm")
+	 (list "snd -noinit" "tgen.scm")    ; repl here + cload sndlib was slower
+	 (list "snd -noinit" "tall.scm")
+	 (list "repl" "timp.scm")
+	 (list "repl" "tmv.scm")
+	 (list "snd -l" "snd-test.scm")
+	 (list "snd -l" "full-snd-test.scm")
+	 (list "repl" "tbig.scm")
+	 )))
+
+(call-valgrind)
+
+(when (file-exists? "test.table")
+  (system "mv test.table old-test.table"))
+(load "compare-calls.scm")
+(combine-latest)
+
+(exit)
diff --git a/s7/utf8-tests.scm b/s7/utf8-tests.scm
new file mode 100644
index 0000000..30f1a97
--- /dev/null
+++ b/s7/utf8-tests.scm
@@ -0,0 +1,135 @@
+;;; utf8proc->s7 tests
+
+(load "libutf8proc.scm")
+
+(when (defined? '*libutf8proc*)
+  
+  (with-let *libutf8proc*
+
+    ;; --------------------------------
+    ;; these are from the libutf8proc test directory
+    
+    (define (print-property c)
+      (format *stderr* "  category = ~S~% charwidth = ~D~%~A~%"
+	      (utf8proc_category_string c)
+	      (utf8proc_charwidth c)
+	      (utf8proc_get_property c)))
+    
+    (do ((c 1 (+ c 1)))
+	((= c #x110000))
+      (let ((l (utf8proc_tolower c))
+	    (u (utf8proc_toupper c)))
+	(unless (or (= l c)
+		    (utf8proc_codepoint_valid l))
+	  (format *stderr* "~X: invalid tolower~%" c))
+	(unless (or (= u c)
+		    (utf8proc_codepoint_valid u))
+	  (format *stderr* "~X: invalid toupper~%" c))
+	))
+    
+    (do ((c 0 (+ c 1)))
+	((or (= c #xd800)
+	     (and (not (utf8proc_codepoint_valid c))
+		  (not (format *stderr* "~X: codepoint invalid~%" c))))))
+    
+    (do ((c #xd800 (+ c 1)))
+	((or (= c #xe000)
+	     (and (utf8proc_codepoint_valid c)
+		  (not (format *stderr* "~X: codepoint valid?~%" c))))))
+    
+    (do ((c #xe000 (+ c 1)))
+	((or (= c #x110000)
+	     (and (not (utf8proc_codepoint_valid c))
+		  (not (format *stderr* "~X: codepoint invalid~%" c))))))
+    
+    (do ((c #x110000 (+ c 1)))
+	((or (= c #x110010)
+	     (and (utf8proc_codepoint_valid c)
+		  (not (format *stderr* "~X: codepoint valid?~%" c))))))
+    
+    ;; (print-property #xbb)
+    
+    (do ((c 1 (+ c 1)))
+	((= c #x110000))
+      (let ((cat ((utf8proc_get_property c) 'category))
+	    (w (utf8proc_charwidth c)))
+	(if (and (or (= cat UTF8PROC_CATEGORY_MN) (= cat UTF8PROC_CATEGORY_ME))
+		 (positive? w))
+	    (format *stderr* "nonzero width ~D for combining char ~X~%" w c))
+	(if (and (zero? w)
+		 (or (and (>= cat UTF8PROC_CATEGORY_LU) (<= cat UTF8PROC_CATEGORY_LO))
+		     (and (>= cat UTF8PROC_CATEGORY_ND) (<= cat UTF8PROC_CATEGORY_SC))
+		     (and (>= cat UTF8PROC_CATEGORY_SO) (<= cat UTF8PROC_CATEGORY_ZS))))
+	    (format *stderr* "zero width for symbol-like char ~X~%" c))))
+    ;; --------------------------------
+
+    (define s '("élan ‘quote’")) ; example from Norman Gray
+    (display s)       ; ("élan â\x80;\x98;quoteâ\x80;\x99;") -- this is due to write's slashify_table choices: now displays ("élan ‘quote’")
+    (newline)
+    (display (car s)) ; élan ‘quote’
+    (newline)
+    
+    (define b (string->byte-vector (car s)))
+    (format #t "~{~X ~}" b) ;c3 a9 6c 61 6e 20 e2 80 98 71 75 6f 74 65 e2 80 99 
+    (newline)
+    
+    
+    (define p (utf8proc_map (car s) UTF8PROC_NULLTERM)) ; is this doing anything useful (besides error checking)?
+    (display (car p))       ; élan ‘quote’
+    (newline)
+    
+    (define p1 (utf8proc_map "(\"élan ‘quote’\")" UTF8PROC_NULLTERM))
+    (display (car p1))      ; ("élan ‘quote’")
+    (newline)
+    
+    (define b1 (string->byte-vector (car p1)))
+    (format #t "~{~X ~}" b1) ;28 22 c3 a9 6c 61 6e 20 e2 80 98 71 75 6f 74 65 e2 80 99 22 29
+    (newline)
+    
+    (define s1 (with-output-to-string (lambda () (display s))))
+    (display s1) (newline)  ; ("élan ‘quote’")
+    (define p2 (utf8proc_map s1 UTF8PROC_NULLTERM))
+    (if (integer? (cdr p2))
+	(display (utf8proc_errmsg (cdr p2))) ; "Invalid UTF-8 string" or "unknown error" -- what is the problem here?
+	(display (car p2)))
+    (newline)
+    
+    (let ((len (cdr p1))
+	  (p1c (copy (car p1))))
+      (do ((n (utf8proc_iterate p1c len) (utf8proc_iterate p1c len)))
+	  ((<= (car n) 0)) ; (cdr n) is the codepoint as an integer
+	(display (substring p1c 0 (car n))) (display #\space) ; ( " é l a n   ‘ q u o t e ’ " )
+	(set! p1c (substring p1c (car n)))
+	(set! len (- len (car n))))
+      (newline))
+    
+    (let ((e1 (utf8proc_encode_char #x00E9))) ; unicode code-point to utf-8 -> (cons utf-8-string length-thereof)
+      (format #t "#x~{~X~}" (string->byte-vector (car e1))) ; #xc3a9
+      (newline)
+      (display (car e1))      ; é
+      (newline))
+
+    (let ((e1 (utf8proc_encode_char #x018b)))
+      (format #t "#x~{~X~}" (string->byte-vector (car e1)))
+      (newline)
+      (display (car e1))      ; latin cap D with top bar
+      (newline))
+
+    (let ((e1 (utf8proc_encode_char #x0238)))
+      (format #t "#x~{~X~}" (string->byte-vector (car e1)))
+      (newline)
+      (display (car e1))      ; latin small db digraph
+      (newline))
+
+    (let ((e1 (utf8proc_encode_char #x1e00)))
+      (format #t "#x~{~X~}" (string->byte-vector (car e1)))
+      (newline)
+      (display (car e1))      ; latin cap A ring below
+      (newline))
+
+    (display (string->symbol "élan ‘quote’"))
+    (newline)
+    (display (symbol->string (symbol "élan ‘quote’")))
+    (newline)
+    
+  ))
diff --git a/s7/write.scm b/s7/write.scm
new file mode 100644
index 0000000..20cdad5
--- /dev/null
+++ b/s7/write.scm
@@ -0,0 +1,743 @@
+(provide 'write.scm)
+
+;;; -------------------------------- pretty-print --------------------------------
+
+(define pretty-print  ; (lambda* (obj (port (current-output-port)) (column 0))
+
+  (let ((*pretty-print-length* 100)
+	(*pretty-print-spacing* 2)
+	(*pretty-print-float-format* "~,4F")
+	(*pretty-print-left-margin* 0)
+	(*pretty-print-cycles* #t)) ; if this is #f, you're guaranteeing that there won't be any circular structures
+    ;; e.g. (let-temporarily ((((outlet (funclet pretty-print)) '*pretty-print-cycles*) #f)) ...)
+    (define pretty-print-1
+      (letrec ((messy-number (lambda (z)
+			       (if (real? z)
+				   (if (or (nan? z)
+					   (infinite? z))
+				       (object->string z)
+				       (if (= z pi)
+					   (copy "pi")
+					   (format #f *pretty-print-float-format* z)))
+				   (format #f "~A~A~Ai"
+					   (messy-number (real-part z))
+					   (if (negative? (imag-part z)) "-" "+")
+					   (messy-number (abs (imag-part z)))))))
+
+	       (any-keyword? (lambda (lst)
+			       (and (pair? lst)
+				    (or (keyword? (car lst))
+					(any-keyword? (cdr lst))))))
+
+	       (any-let-or-hash-table? (lambda (sequence)
+					 (and (pair? sequence)
+					      (or (let? (car sequence))
+						  (hash-table? (car sequence))
+						  (any-let-or-hash-table? (cdr sequence)))))))
+	(let ((newlines 0))
+
+	  (define (spaces port n)
+	    (set! newlines (+ newlines 1))
+	    (format port "~%~NC" (+ n *pretty-print-left-margin*) #\space))
+
+	  (define (stacked-list port lst col)
+	    (do ((p lst (cdr p))
+		 (added 0 0))
+		((not (pair? p)))
+	      (let ((obj (car p)))
+		(if (not (eq? p lst))
+		    (spaces port col))
+		(let ((len (length (object->string obj))))
+		  (when (and (keyword? obj)
+			     (pair? (cdr p)))
+		    (write obj port)
+		    (write-char #\space port)
+		    (set! added (+ 1 len))
+		    (set! p (cdr p))
+		    (set! obj (car p))) ; pair? cdr p above
+
+		  (cond ((or (hash-table? obj)
+			     (let? obj))
+			 (pretty-print-1 obj port col))
+
+			((and (pair? obj)
+			      (pair? (cdr obj))
+			      (null? (cddr obj))
+			      (> len (/ *pretty-print-length* 2)))
+			 (if (eq? (car obj) 'quote)
+			     (write-char #\' port)
+			     (begin
+			       (write-char #\( port)
+			       (pretty-print-1 (car obj) port col)
+			       (spaces port (+ col 1))))
+			 (pretty-print-1 (cadr obj) port (+ col 1))
+			 (if (not (eq? (car obj) 'quote))
+			     (write-char #\) port)))
+
+			(else
+			 (pretty-print-1 obj port (+ col added))))))))
+
+	  (define (stacked-split-list port lst col)
+	    (if (not (pair? lst))
+		(write lst port)
+		(do ((p lst (cdr p)))
+		    ((not (pair? p)))
+		  (if (not (eq? p lst)) (spaces port col))
+		  (if (pair? (car p))
+		      (begin
+			(format port "(~S " (caar p))
+			(if (and (pair? (cdar p))
+				 (symbol? (caar p)))
+			    (pretty-print-1 (cadar p) port (+ col (length (symbol->string (caar p))) 2))
+			    (write (cdar p) port))
+			(write-char #\) port))
+		      (write (car p) port))))) ; pretty-print? (it's always a symbol)
+
+	  (let ((writers
+		 (let ((h (make-hash-table)))
+
+		   ;; -------- quote
+		   (define (w-quote obj port column)
+		     (if (not (pair? (cdr obj))) ; (quote) or (quote . 1)
+			 (write obj port)
+			 (begin
+			   (write-char #\' port)
+			   (pretty-print-1 (cadr obj) port column))))
+		   (hash-table-set! h 'quote w-quote) ; what about #_quote?
+
+		   ;; -------- define
+		   (define (w-define obj port column)
+		     (if (not (pair? (cdr obj)))
+			 (write obj port)
+			 (begin
+			   (format port "(~A ~A " (car obj) (cadr obj))
+			   (if (pair? (cadr obj))
+			       (begin
+				 (spaces port (+ column *pretty-print-spacing*))
+				 (stacked-list port (cddr obj) (+ column *pretty-print-spacing*)))
+			       (if (pair? (cddr obj))
+				   (let ((str (object->string (caddr obj))))
+				     (if (> (length str) 60)
+					 (begin
+					   (spaces port (+ column *pretty-print-spacing*))
+					   (pretty-print-1 (caddr obj) port (+ column *pretty-print-spacing*)))
+					 (write (caddr obj) port)))
+				   (write (cddr obj) port)))
+			   (write-char #\) port))))
+		   (hash-table-set! h 'define w-define)
+
+		   ;; -------- if
+		   (define (w-if obj port column if-str)
+		     (let ((objstr (object->string obj))
+			   (ifcol (+ column 4)))
+		       (if (< (length objstr) 40)
+			   (display objstr port)
+			   (begin
+			     (format port "(~A " if-str)
+			     (pretty-print-1 (cadr obj) port ifcol)
+			     (when (pair? (cddr obj)) ; might be a messed-up if
+			       (spaces port ifcol)
+			       (pretty-print-1 (caddr obj) port ifcol)
+			       (when (pair? (cdddr obj))
+				 (spaces port ifcol)
+				 (pretty-print-1 (cadddr obj) port ifcol)))
+			     (write-char #\) port)))))
+		   (hash-table-set! h 'if (lambda (obj port col) (w-if obj port col "if")))
+		   (hash-table-set! h #_if (lambda (obj port col) (w-if obj port col "#_if")))
+
+		   ;; -------- when unless
+		   (define (w-when obj port column str)
+		     (let ((objstr (object->string obj)))
+		       (if (< (length objstr) 40)
+			   (display objstr port)
+			   (begin
+			     (format port "(~A " str)
+			     (pretty-print-1 (cadr obj) port (+ column (+ 2 (string-length str)))) ;(if (eq? (car obj) 'when) 6 8)))
+			     (spaces port (+ column *pretty-print-spacing*))
+			     (when (pair? (cddr obj))
+			       (stacked-list port (cddr obj) (+ column *pretty-print-spacing*)))
+			     (write-char #\) port)))))
+		   (hash-table-set! h 'when (lambda (obj port col) (w-when obj port col "when")))
+		   (hash-table-set! h 'unless (lambda (obj port col) (w-when obj port col "unless")))
+		   (hash-table-set! h #_when (lambda (obj port col) (w-when obj port col "#_when")))
+		   (hash-table-set! h #_unless (lambda (obj port col) (w-when obj port col "#_unless")))
+
+		   ;; -------- let let* letrec letrec*
+		   (define (w-let obj port column let-str)
+		     (if (not (and (pair? (cdr obj))
+				   (pair? (cddr obj))))
+			 (write obj port)
+			 (begin
+			   (let ((head-len (length let-str)))
+			     (if (symbol? (cadr obj))
+				 (begin
+				   (format port "(~A ~A (" let-str (cadr obj))
+				   (if (pair? (cddr obj))
+				       (if (pair? (caddr obj)) ; (let x () ...)
+					   (stacked-split-list port (caddr obj) (+ column head-len (length (symbol->string (cadr obj))) 4))
+					   (if (not (null? (caddr obj)))
+					       (write (caddr obj) port))) ; () is already being written
+				       (if (not (null? (cddr obj)))
+					   (format port " . ~S" (cddr obj)))))
+				 (begin
+				   (format port "(~A (" let-str)
+				   (if (pair? (cadr obj))
+				       (stacked-split-list port (cadr obj) (+ column head-len 3))))))
+			   (write-char #\) port)
+			   (spaces port (+ column *pretty-print-spacing*))
+			   (if (pair? ((if (symbol? (cadr obj)) cdddr cddr) obj))
+			       (stacked-list port ((if (symbol? (cadr obj)) cdddr cddr) obj) (+ column *pretty-print-spacing*)))
+			   (write-char #\) port))))
+		   (for-each
+		    (lambda (f str)
+		      (hash-table-set! h f (lambda (obj port col) (w-let obj port col str))))
+		    (list 'let 'let* 'letrec 'letrec* #_let #_let* #_letrec #_letrec*)
+		    (list "let" "let*" "letrec" "letrec" "#_let" "#_let*" "#_letrec" "#_letrec*"))
+
+		   ;; -------- set!
+		   (define (w-set obj port column set-str)
+		     (let ((str (object->string obj)))
+
+		       (if (<= (length str) 60)
+			   (display str port)
+			   (let ((settee (object->string (cadr obj))))
+			     (format port "(~A ~A" set-str settee)
+			     (if (pair? (cddr obj))
+				 (if (> (length settee) 20)
+				     (begin
+				       (spaces port (+ column 6))
+				       (pretty-print-1 (caddr obj) port (+ column 6)))
+				     (begin
+				       (write-char #\space port)
+				       (pretty-print-1 (caddr obj) port (+ column 7 (length settee))))))
+			     (write-char #\) port)))))
+		   (hash-table-set! h 'set! (lambda (obj port col) (w-set obj port col "set!")))
+		   (hash-table-set! h #_set! (lambda (obj port col) (w-set obj port col "#_set!")))
+
+		   ;; -------- cond
+		   (define (w-cond obj port column cond-str)
+		     (format port "(~A " cond-str)
+		     (do ((lst (cdr obj) (cdr lst)))
+			 ((not (pair? lst)))
+		       (if (not (eq? lst (cdr obj)))
+			   (spaces port (+ column 6)))
+		       (if (not (pair? (car lst)))
+			   (write (car lst) port)
+			   (let ((has=> (and (pair? (cdar lst))
+					     (eq? (cadar lst) '=>))))
+			     (let ((extras (and (pair? (cdar lst))
+						(pair? (cddar lst))
+						(or (not has=>)
+						    (pair? (cdddar lst)))))
+				   (too-long (> (length (object->string (cdar lst))) 50)))
+			       (write-char #\( port)
+			       (let ((oldlines newlines))
+				 (pretty-print-1 (caar lst) port (+ column 7))
+				 (if (or extras
+					 (not (= oldlines newlines))
+					 too-long)
+				     (spaces port (+ column 7))
+				     (if (and (pair? (cdar lst))
+					      (or (not has=>)
+						  (= oldlines newlines)))
+					 (write-char #\space port)))
+				 (if (and (pair? (cdar lst))
+					  (not extras)
+					  (not too-long))
+				     (begin
+				       (write (cadar lst) port)
+				       (when (and has=>
+						  (pair? (cddar lst)))
+					 (write-char #\space port)
+					 (write (caddar lst) port)))
+				     (if (not (null? (cdar lst)))
+					 (stacked-list port (cdar lst) (+ column 7)))))
+			       (write-char #\) port)))))
+		     (write-char #\) port))
+		   (hash-table-set! h 'cond (lambda (obj port col) (w-cond obj port col "cond")))
+		   (hash-table-set! h #_cond (lambda (obj port col) (w-cond obj port col "#_cond")))
+
+		   ;; -------- and or
+		   (define (w-and obj port column and-str)
+		     (if (> (length (object->string obj)) 40)
+			 (begin
+			   (format port "(~A " and-str)
+			   (stacked-list port (cdr obj) (+ column *pretty-print-spacing* (length (symbol->string (car obj)))))
+			   (write-char #\) port))
+			 (write obj port)))
+		   (hash-table-set! h 'and (lambda (obj port col) (w-and obj port col "and")))
+		   (hash-table-set! h 'or (lambda (obj port col) (w-and obj port col "or")))
+		   (hash-table-set! h #_and (lambda (obj port col) (w-and obj port col "#_and")))
+		   (hash-table-set! h #_or (lambda (obj port col) (w-and obj port col "#_or")))
+
+		   ;; -------- case
+		   (define (w-case obj port column case-str)
+		     (if (not (and (pair? (cdr obj))
+				   (pair? (cddr obj))))
+			 (write obj port)
+			 (begin
+			   (format port "(~A ~A" case-str (cadr obj)) ; send out the selector
+			   (for-each
+			    (lambda (lst)
+			      (spaces port (+ column *pretty-print-spacing*))
+			      (if (not (pair? lst))
+				  (write lst port)
+				  (begin
+				    (write-char #\( port)
+				    (if (not (pair? (car lst)))
+					(write (car lst) port)
+					(let ((len (length (car lst))))
+					  (if (< len 6)
+					      (write (car lst) port)
+					      (let ((p (car lst)))
+						(write-char #\( port)
+						(do ((i 0 (+ i 6)))
+						    ((>= i len))
+						  (do ((j 0 (+ j 1)))
+						      ((or (= j 6) (null? p)) (if (pair? p) (spaces port (+ column 4))))
+						    (write (car p) port)
+						    (set! p (cdr p))
+						    (if (pair? p)
+							(write-char #\space port))))
+						(write-char #\) port)))))
+				    (if (not (null? (cdr lst)))
+					(if (and (pair? (cdr lst))
+						 (or (and (null? (cddr lst))
+							  (< (length (object->string (cadr lst))) 60))
+						     (and (eq? (cadr lst) '=>)
+							  (null? (cdddr lst))
+							  (< (length (object->string (caddr lst))) 60))))
+					    (begin
+					      (write-char #\space port)
+					      (write (cadr lst) port)
+					      (when (and (eq? (cadr lst) '=>)
+							 (pair? (cddr lst)))
+						(write-char #\space port)
+						(write (caddr lst) port)))
+					    (begin
+					      (spaces port (+ column 3))
+					      (stacked-list port (cdr lst) (+ column 3)))))
+				    (write-char #\) port))))
+			    (cddr obj))
+			   (write-char #\) port))))
+		   (hash-table-set! h 'case (lambda (obj port col) (w-case obj port col "case")))
+		   (hash-table-set! h #_case (lambda (obj port col) (w-case obj port col "#_case")))
+
+		   ;; -------- map for-each
+		   (define (w-map obj port column map-str)
+		     (let* ((objstr (object->string obj))
+			    (strlen (length objstr)))
+		       (if (< (+ column strlen) *pretty-print-length*)
+			   (display objstr port)
+			   (begin
+			     (format port "(~A" map-str)
+			     (when (pair? (cdr obj))
+			       (write-char #\space port)
+			       (stacked-list port (cdr obj) (+ column *pretty-print-spacing*)))
+			     (write-char #\) port)))))
+		   (hash-table-set! h 'map (lambda (obj port col) (w-map obj port col "map")))
+		   (hash-table-set! h 'for-each (lambda (obj port col) (w-map obj port col "for-each")))
+		   (hash-table-set! h #_map (lambda (obj port col) (w-map obj port col "#_map")))
+		   (hash-table-set! h #_for-each (lambda (obj port col) (w-map obj port col "#_for-each")))
+
+		   ;; -------- do
+		   (define (w-do obj port column do-str)
+		     (if (not (pair? (cdr obj)))
+			 (write obj port)
+			 (begin
+			   (format port "(~A " do-str)
+			   (if (list? (cadr obj))
+			       (write-char #\( port)
+			       (display (cadr obj) port))
+			   (if (pair? (cadr obj))
+			       (stacked-list port (cadr obj) (+ column 5)))
+			   (if (list? (cadr obj))
+			       (write-char #\) port))
+			   (when (pair? (cddr obj))
+			     (spaces port (+ column 4))
+			     (let ((end (caddr obj)))
+			       (if (< (length (object->string end)) (- *pretty-print-length* column))
+				   (write end port)
+				   (begin
+				     (write-char #\( port)
+				     (pretty-print-1 (car end) port (+ column 4))
+				     (spaces port (+ column 5))
+				     (stacked-list port (cdr end) (+ column 5))
+				     (write-char #\) port))))
+			     (when (pair? (cdddr obj))
+			       (spaces port (+ column *pretty-print-spacing*))
+			       (stacked-list port (cdddr obj) (+ column *pretty-print-spacing*))))
+			   (write-char #\) port))))
+		   (hash-table-set! h 'do (lambda (obj port col) (w-do obj port col "do")))
+		   (hash-table-set! h #_do (lambda (obj port col) (w-do obj port col "#_do")))
+
+		   ;; -------- begin etc
+		   (define (w-begin obj port column begin-str)
+		     (format port "(~A" begin-str)
+		     (when (pair? (cdr obj))
+		       (spaces port (+ column *pretty-print-spacing*))
+		       (stacked-list port (cdr obj) (+ column *pretty-print-spacing*)))
+		     (write-char #\) port))
+		   (for-each
+		    (lambda (f str)
+		      (hash-table-set! h f (lambda (obj port col) (w-begin obj port col str))))
+		    (list 'begin 'call-with-exit 'call/cc 'call-with-current-continuation 'with-baffle
+			  'with-output-to-string 'call-with-output-string 'hash-table 'inlet
+			  #_begin #_call-with-exit #_call/cc #_call-with-current-continuation #_with-baffle
+			  #_with-output-to-string #_call-with-output-string #_hash-table #_inlet)
+		    (list "begin" "call-with-exit" "call/cc" "call-with-current-continuation" "with-baffle"
+			  "with-output-to-string" "call-with-output-string" "hash-table" "inlet"
+			  "#_begin" "#_call-with-exit" "#_call/cc" "#_call-with-current-continuation" "#_with-baffle"
+			  "#_with-output-to-string" "#_call-with-output-string" "#_hash-table" "#_inlet"))
+
+		   ;; -------- dynamic-wind call-with-values
+		   (define (w-dynwind obj port column str)
+		     (format port "(~A" str)
+		     (spaces port (+ column *pretty-print-spacing*))
+		     (stacked-list port (cdr obj) (+ column *pretty-print-spacing*))
+		     (write-char #\) port))
+		   (hash-table-set! h 'dynamic-wind (lambda (obj port col) (w-dynwind obj port col "dynamic-wind")))
+		   (hash-table-set! h 'call-with-values (lambda (obj port col) (w-dynwind obj port col "call-with-values")))
+		   (hash-table-set! h #_dynamic-wind (lambda (obj port col) (w-dynwind obj port col "#_dynamic-wind")))
+		   ;(hash-table-set! h #_call-with-values (lambda (obj port col) (w-dynwind obj port col "#_call-with-values")))
+
+		   ;; -------- lambda etc
+		   (define (w-lambda obj port column str)
+		     (if (not (and (pair? (cdr obj))
+				   (pair? (cddr obj))))
+			 (write obj port)
+			 (begin
+			   (format port "(~A " str)
+			   (pretty-print-1 (cadr obj) port (+ column *pretty-print-spacing* (length str)))
+			   (spaces port (+ column *pretty-print-spacing*))
+			   (stacked-list port (cddr obj) (+ column *pretty-print-spacing*))
+			   (write-char #\) port))))
+		   (for-each
+		    (lambda (f str)
+		      (hash-table-set! h f (lambda (obj port col) (w-lambda obj port col str))))
+		    (list 'lambda 'lambda* 'define* 'define-macro 'define-macro* 'define-bacro 'define-bacro* 'with-let 
+			  'call-with-input-string 'call-with-input-file 'call-with-output-file 'with-input-from-file 
+			  'with-input-from-string 'with-output-to-file 'let-temporarily
+			  #_lambda #_lambda* #_define* #_define-macro #_define-macro* #_define-bacro #_define-bacro* #_with-let 
+			  #_call-with-input-string #_call-with-input-file #_call-with-output-file #_with-input-from-file 
+			  #_with-input-from-string #_with-output-to-file #_let-temporarily)
+		    (list "lambda" "lambda*" "define*" "define-macro" "define-macro*" "define-bacro" "define-bacro*" "with-let" 
+			  "call-with-input-string" "call-with-input-file" "call-with-output-file" "with-input-from-file" 
+			  "with-input-from-string" "with-output-to-file" "let-temporarily"
+			  "#_lambda" "#_lambda*" "#_define*" "#_define-macro" "#_define-macro*" "#_define-bacro" "#_define-bacro*" "#_with-let" 
+			  "#_call-with-input-string" "#_call-with-input-file" "#_call-with-output-file" "#_with-input-from-file" 
+			  "#_with-input-from-string" "#_with-output-to-file" "#_let-temporarily"))
+
+		   ;; -------- catch
+		   (define (w-catch obj port column str)
+		     (if (not (pair? (cdr obj))) ; (catch) or (catch . 1)
+			 (write obj port)
+			 (begin
+			   (format port "(~A ~S" str (cadr obj))
+			   (spaces port (+ column *pretty-print-spacing*))
+			   (stacked-list port (cddr obj) (+ column *pretty-print-spacing*))
+			   (write-char #\) port))))
+		   (hash-table-set! h 'catch (lambda (obj port col) (w-catch obj port col "catch")))
+		   (hash-table-set! h #_catch (lambda (obj port col) (w-catch obj port col "#_catch")))
+
+		   h)))
+
+	    ;; pretty-print-1
+	    (lambda (obj port column)
+
+	      (cond ((number? obj)
+		     (if (rational? obj)
+			 (write obj port)
+			 (display (messy-number obj) port)))
+
+		    ((or (int-vector? obj)
+			 (float-vector? obj))
+		     (if (> (vector-rank obj) 1)
+			 (write obj port)
+			 (let* ((objstr (object->string obj))
+				(strlen (length objstr)))
+			   (if (< (+ column strlen) *pretty-print-length*)
+			       (display objstr port)
+			       (let ((name-len (if (int-vector? obj) 10 12)))
+				 (display (if (int-vector? obj) "(int-vector " "(float-vector ") port)
+				 (set! column (+ column 2))
+				 (if (< (- *pretty-print-length* column) 30)
+				     (spaces port column)
+				     (set! column (+ column name-len)))
+				 (do ((len (min (length obj) (*s7* 'print-length)))
+				      (col column)
+				      (i 0 (+ i 1)))
+				     ((= i len)
+				      (if (> len (*s7* 'print-length))
+					  (write-string " ...)" port)
+					  (write-char #\) port)))
+				   (let* ((numstr (number->string (obj i)))
+					  (numlen (length numstr)))
+				     (if (not (= col column))
+					 (if (> (+ col numlen) *pretty-print-length*)
+					     (begin
+					       (spaces port column)
+					       (set! col column))
+					     (display #\space port)))
+				     (display numstr port)
+				     (set! col (+ col numlen 1)))))))))
+
+		    ((and *pretty-print-cycles*
+			  (pair? (cyclic-sequences obj)))
+		     (format port "~W" obj))
+
+		    ((hash-table? obj)
+		     (display "(hash-table" port)
+		     (for-each (lambda (field)
+				 (let ((symstr (object->string (car field))))
+				   (spaces port (+ column 2))
+				   (format port "'~A " symstr)
+				   (pretty-print-1 (cdr field) port (+ column 4 (length symstr)))))
+			       obj)
+		     (write-char #\) port))
+
+		    ((let? obj)
+		     (if (and (openlet? obj)
+			      (defined? 'pretty-print obj #t))  ; #t = locally defined
+			 ((obj 'pretty-print) obj port column)
+			 (begin
+			   (display "(inlet" port)
+			   (for-each (lambda (field)
+				       (let ((symstr (symbol->string (car field))))
+					 (spaces port (+ column 2))
+					 (format port ":~A " symstr)
+					 (pretty-print-1 (cdr field) port (+ column 4 (length symstr)))))
+				     obj)
+			   (write-char #\) port))))
+
+		    ((vector? obj)
+		     (if (> (vector-rank obj) 1)
+			 (write obj port)
+			 (let* ((objstr (object->string obj))
+				(strlen (length objstr)))
+			   (if (< (+ column strlen) *pretty-print-length*)
+			       (display objstr port)
+			       (begin
+				 (display "(vector " port)
+				 (set! column (+ column 2))
+				 (if (< (- *pretty-print-length* column) 30)
+				     (spaces port column)
+				     (set! column (+ column 6)))
+				 (do ((len (min (length obj) (*s7* 'print-length)))
+				      (col column)
+				      (i 0 (+ i 1)))
+				     ((= i len)
+				      (if (> len (*s7* 'print-length))
+					  (write-string " ...)" port)
+					  (write-char #\) port)))
+				   (let ((olen (length (object->string (obj i)))))
+				     (if (not (= col column))
+					 (if (> (+ col olen) *pretty-print-length*)
+					     (begin
+					       (spaces port column)
+					       (set! col column))
+					     (display #\space port)))
+				     (pretty-print-1 (obj i) port col)
+				     (set! col (+ col olen 1)))))))))
+
+		    ((not (pair? obj))
+		     (write obj port))
+
+		    ((hash-table-ref writers (car obj))
+		     => (lambda (f) (f obj port column)))
+
+		    ((any-let-or-hash-table? obj)
+		     (let ((first #t))
+		       (write-char #\( port)
+		       (for-each (lambda (p)
+				   (if first (set! first #f) (spaces port (+ column 4)))
+				   (pretty-print-1 p port (+ column 4)))
+				 obj)
+		       (write-char #\) port)))
+
+		    (else
+		     (let* ((objstr (object->string obj))
+			    (strlen (length objstr)))
+		       (if (< (+ column strlen) *pretty-print-length*)
+			   (display objstr port)
+
+			   ;; (format port "~A~A" (cond ((pair-line-number obj) => (lambda (line) (format #f "[~D] " line))) (else "")) objstr)
+			   ;; the other case is above (writers)
+			   ;;    (lambda (f) (format port "[~D]" line) (f obj port column))
+			   ;;    with column check, line check etc
+			   ;; so, the pp/profile hook only needs two calls
+			   ;; (lambda (f obj port column) (f obj port column))
+			   ;; and here (lambda (f obj port column) (f=display obj=objstr port)?
+
+			   (let ((lstlen (length obj)))
+
+			     (cond ((or (infinite? lstlen)
+					(not (positive? lstlen)))
+				    (display objstr port))
+
+				   ((and (symbol? (car obj))
+					 (> (length (symbol->string (car obj))) 12)
+					 (pair? (cdr obj))
+					 (pair? (cadr obj))
+					 (memq (caadr obj) '(lambda lambda* let let* cond case letrec)))
+				    (write-char #\( port)
+				    (pretty-print-1 (car obj) port column)
+				    (spaces port (+ column 2))
+				    (stacked-list port (cdr obj) (+ column 2))
+				    (write-char #\) port))
+
+				   ((= lstlen 1)
+				    (if (pair? (car obj))
+					(begin
+					  (write-char #\( port)
+					  (pretty-print-1 (car obj) port (+ column 1))
+					  (write-char #\) port))
+					(display objstr port)))
+
+				   ((and (pair? (car obj))
+					 (memq (caar obj) '(lambda lambda* let let* letrec letrec* cond if case)))
+				    (write-char #\( port)
+				    (pretty-print-1 (car obj) port column)
+				    (spaces port (+ column 1))
+				    (if (and (memq (caar obj) '(cond if case))
+					     (do ((p (cdr obj) (cdr p)))
+						 ((or (null? p)
+						      (pair? (car p)))
+						  (null? p))))
+					(do ((p (cdr obj) (cdr p)))
+					    ((null? p))
+					  (display (car p) port)
+					  (if (pair? (cdr p))
+					      (write-char #\space port)))
+					(stacked-list port (cdr obj) (+ column 1)))
+				    (write-char #\) port))
+
+				   (else
+				    (let* ((carstr (object->string (car obj)))
+					   (carstrlen (length carstr)))
+				      (if (eq? (car obj) 'quote)
+					  (write-char #\' port)
+					  (format port "(~A" carstr))
+				      (if (any-keyword? (cdr obj))
+					  (begin
+					    (spaces port (+ column *pretty-print-spacing*))
+					    (stacked-list port (cdr obj) (+ column *pretty-print-spacing*)))
+					  (let ((line-start (+ column *pretty-print-spacing*
+							       (if (> carstrlen 16) 0 carstrlen))))
+					    (case lstlen
+					      ((2)
+					       (write-char #\space port)
+					       (pretty-print-1 (cadr obj) port line-start))
+
+					      ((3)
+					       (write-char #\space port)
+					       (stacked-list port (cdr obj) line-start))
+
+					      (else
+					       (do ((obj-start line-start)
+						    (lst (cdr obj) (cdr lst)))
+						   ((null? lst))
+						 (let* ((str (object->string (car lst)))
+							(strlen1 (length str)))
+						   (if (and (> strlen1 (- *pretty-print-length* obj-start))
+							    (not (eq? lst (cdr obj))))
+						       (begin
+							 (set! obj-start (+ line-start 1 strlen1))
+							 (spaces port line-start)
+							 (pretty-print-1 (car lst) port line-start))
+						       (let ((at-line-start (= line-start obj-start)))
+							 (set! obj-start (+ obj-start 1 strlen1))
+							 (if (> strlen1 40)
+							     (begin
+							       (if at-line-start
+								   (write-char #\space port)
+								   (spaces port line-start))
+							       (pretty-print-1 (car lst) port line-start))
+							     (begin
+							       (write-char #\space port)
+							       (display str port)))))))))))
+				      (if (not (eq? (car obj) 'quote))
+					  (write-char #\) port)))))))))))))))
+
+    ;; pretty-print
+    (lambda* (obj (port (current-output-port)) (column 0))
+      (let ((old-port port))
+	(if (boolean? old-port)
+	    (set! port (open-output-string)))
+	(pretty-print-1 obj port column)
+	(flush-output-port port)
+	(if (not (boolean? old-port))
+	    (values)
+	    (let ((str (get-output-string port)))
+	      (close-output-port port)
+	      (if (eq? old-port #t)
+		  (display str))
+	      str))))))
+
+(define (pp obj)
+  (call-with-output-string
+   (lambda (p)
+     ((if (keyword? obj) display pretty-print) obj p))))
+
+#|
+(define (pretty-print-all)
+  (let ((st (symbol-table)))
+    (for-each
+     (lambda (sym)
+       (if (defined? sym)
+	   (let ((val (symbol->value sym)))
+	     (let ((source (and (procedure? val)
+				(procedure-source val))))
+	       (if (pair? source)
+		   (format *stderr* "~<sym~> ~<val~>:~%~<(pp source)~>~%~%"))))))
+     st)))
+
+(define-macro (fully-macroexpand form)
+  (define (expand form)
+    ;; walk form looking for macros, expand any that are found -- see stuff.scm for a newer version
+    (if (pair? form)
+	(if (and (symbol? (car form))
+		 (macro? (symbol->value (car form))))
+	    (expand (apply macroexpand (list form)))
+	    (cons (expand (car form))
+		  (expand (cdr form))))
+	form))
+  `(pretty-print ',(expand form)))
+
+(define* (pp-sequence seq)
+  (let ((iter (make-iterator seq))
+	(strs ())
+	(plen (*s7* 'print-length)))
+    (do ((i 0 (+ i 1))
+	 (entry (iterate iter) (iterate iter)))
+	((or (= i plen)
+	     (eof-object? entry))
+	 (if (not (eof-object? entry))
+	     (apply string-append (append (reverse! strs) (list "...")))
+	     (apply string-append (reverse! strs))))
+      (set! strs (cons (format #f "~S " entry) strs)))))
+
+
+;;; pretty-print method:
+(let ((v (openlet (inlet 'value #(0 1 2 3)
+			 'pretty-print (lambda (obj port column)
+					 (display "#(... 2 ...)" port))))))
+  (pretty-print (list 1 v 3)))
+
+;;; local pretty-print settings:
+(let ((v (openlet (inlet 'value (* pi 1000)
+			 'pretty-print (lambda (obj port column)
+					 (let-temporarily ((((funclet pretty-print) '*pretty-print-float-format*) "~E"))
+					   (pretty-print (obj 'value) port column)))))))
+  (pretty-print (list (* pi 1000) v)))
+
+;;; or simpler:
+(let ((v (* 1000 pi)))
+  (let-temporarily ((((funclet pretty-print) '*pretty-print-float-format*) "~E"))
+    (pretty-print v))
+  (newline)
+  (pretty-print v))
+
+;;; :readable in pretty-print? couldn't this be (pretty-print (with-input-from-string (object->string obj :readable) read))?
+
+|#